From 7bf531bf3d936d8ae9e77327c397f24933272c11 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 15 Feb 2018 10:33:12 -0700 Subject: [PATCH 0001/1072] placed the GFDL MOM6 cap as a starting point in the new nuopc_driver/ directory --- config_src/nuopc_driver/mom_cap.F90 | 2160 +++++++++++++++++++++++++++ 1 file changed, 2160 insertions(+) create mode 100644 config_src/nuopc_driver/mom_cap.F90 diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 new file mode 100644 index 0000000000..308ee918aa --- /dev/null +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -0,0 +1,2160 @@ +!> +!! @mainpage MOM NUOPC Cap +!! @author Fei Liu (fei.liu@gmail.com) +!! @date 5/10/13 Original documentation +!! @author Rocky Dunlap (rocky.dunlap@noaa.gov) +!! @date 1/12/17 Moved to doxygen +!! +!! @tableofcontents +!! +!! @section Overview Overview +!! +!! **This MOM cap has been tested with MOM5 and MOM6.** +!! +!! This document describes the MOM "cap", which is a small software layer that is +!! required when the [MOM ocean model] (http://mom-ocean.org/web) +!! is used in [National Unified Operation Prediction Capability] +!! (http://www.earthsystemcog.org/projects/nuopc) (NUOPC) coupled systems. +!! The NUOPC Layer is a software layer built on top of the [Earth System Modeling +!! Framework] (https://www.earthsystemcog.org/projects/esmf) (ESMF). +!! ESMF is a high-performance modeling framework that provides +!! data structures, interfaces, and operations suited for building coupled models +!! from a set of components. NUOPC refines the capabilities of ESMF by providing +!! a more precise definition of what it means for a model to be a component and +!! how components should interact and share data in a coupled system. The NUOPC +!! Layer software is designed to work with typical high-performance models in the +!! Earth sciences domain, most of which are written in Fortran and are based on a +!! distributed memory model of parallelism (MPI). +!! A NUOPC "cap" is a Fortran module that serves as the interface to a model +!! when it's used in a NUOPC-based coupled system. +!! The term "cap" is used because it is a small software layer that sits on top +!! of model code, making calls into it and exposing model data structures in a +!! standard way. For more information about creating NUOPC caps in general, please +!! see the [Building a NUOPC Model] +!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_howtodoc/) +!! how-to document. +!! +!! The MOM cap package includes the cap itself (mom_cap.F90, a Fortran module), a +!! set of time utilities (time_utils.F90) for converting between ESMF and FMS +!! time types, and two makefiles. Also included are self-describing dependency +!! makefile fragments (mom.mk and mom.mk.template), although these can be generated +!! by the makefiles for specific installations of the MOM cap. +!! +!! @subsection CapSubroutines Cap Subroutines +!! +!! The MOM cap Fortran module contains a set of subroutines that are required +!! by NUOPC. These subroutines are called by the NUOPC infrastructure according +!! to a predefined calling sequence. Some subroutines are called during +!! initialization of the coupled system, some during the run of the coupled +!! system, and some during finalization of the coupled system. The initialization +!! sequence is the most complex and is governed by the NUOPC technical rules. +!! Details about the initialization sequence can be found in the [NUOPC Reference Manual] +!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html#SECTION00034000000000000000). +!! +!! A particularly important part of the NUOPC intialization sequence is to establish +!! field connections between models. Simply put, a field connection is established +!! when a field output by one model can be consumed by another. As an example, the +!! MOM model is able to accept a precipitation rate when coupled to an atmosphere +!! model. In this case a field connection will be established between the precipitation +!! rate exported from the atmosphere and the precipitation rate imported into the +!! MOM model. Because models may uses different variable names for physical +!! quantities, NUOPC relies on a set of standard names and a built-in, extensible +!! standard name dictionary to match fields between models. More information about +!! the use of standard names can be found in the [NUOPC Reference Manual] +!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html#SECTION00032000000000000000). +!! +!! Two key initialization phases that appear in every NUOPC cap, including this MOM +!! cap are the field "advertise" and field "realize" phases. *Advertise* is a special +!! NUOPC term that refers to a model participating in a coupled system +!! providing a list of standard names of required import fields and available export +!! fields. In other words, each model will advertise to the other models which physical fields +!! it needs and which fields it can provide when coupled. NUOPC compares all of the advertised +!! standard names and creates a set of unidirectional links, each from one export field +!! in a model to one import field in another model. When these connections have been established, +!! all models in the coupled system need to provide a description of their geographic +!! grid (e.g., lat-lon, tri-polar, cubed sphere, etc.) and allocate their connected +!! fields on that grid. In NUOPC terms, this is refered to as *realizing* a set of +!! fields. NUOPC relies on ESMF data types for this, such as the [ESMF_Grid] +!! (http://www.earthsystemmodeling.org/esmf_releases/public/last/ESMF_refdoc/node5.html#SECTION05080000000000000000) +!! type, which describes logically rectangular grids and the [ESMF_Field] +!! (http://www.earthsystemmodeling.org/esmf_releases/public/last/ESMF_refdoc/node5.html#SECTION05030000000000000000) +!! type, which wraps a models data arrays and provides basic metadata. Because ESMF supports +!! interpolation between different grids (sometimes called "regridding" or "grid remapping"), +!! it is not necessary that models share a grid. As you will see below +!! the *advertise* and *realize* phases each have a subroutine in the HYCOM cap. +!! +!! The following table summarizes the NUOPC-required subroutines that appear in the +!! MOM cap. The "Phase" column says whether the subroutine is called during the +!! initialization, run, or finalize part of the coupled system run. +!! +!! Phase | MOM Cap Subroutine | Description +!! ---------|--------------------------------------------------------------------|------------------------------------------------------------- +!! Init | [InitializeP0] (@ref mom_cap_mod::initializep0) | Sets the Initialize Phase Definition (IPD) version to use +!! Init | [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) | Advertises standard names of import and export fields +!! Init | [InitializeRealize] (@ref mom_cap_mod::initializerealize) | Creates an ESMF_Grid for the MOM grid as well as ESMF_Fields for import and export fields +!! Run | [ModelAdvance] (@ref mom_cap_mod::modeladvance) | Advances the model by a timestep +!! Final | [Finalize] (@ref mom_cap_mod::ocean_model_finalize) | Cleans up +!! +!! @section UnderlyingModelInterfaces Underlying Model Interfaces +!! +!! +!! @subsection DomainCreation Domain Creation +!! +!! The MOM tripolar grid is represented as a 2D `ESMF_Grid` and coupling fields are placed +!! on this grid. Calls related to creating the grid are located in the [InitializeRealize] +!! (@ref mom_cap_mod::initializerealize) subroutine, which is called by the NUOPC infrastructure +!! during the intialization sequence. +!! +!! The cap determines parameters for setting up the grid by calling subroutines in the +!! `mpp_domains_mod` module. The global domain size is determined by calling `mpp_get_global_domain()`. +!! A check is in place to ensure that there is only a single tile in the domain (the +!! cap is currently limited to one tile; multi-tile mosaics are not supported). The +!! decomposition across processors is determined via calls to `mpp_get_compute_domains()` +!! (to retrieve decomposition block indices) and `mpp_get_pelist()` (to determine how +!! blocks are assigned to processors). +!! +!! The grid is created in several steps: +!! - an `ESMF_DELayout` is created based on the pelist from MOM +!! - an `ESMF_DistGrid` is created over the global index space. Connections are set +!! up so that the index space is periodic in the first dimension and has a +!! fold at the top for the bipole. The decompostion blocks are also passed in +!! along with the `ESMF_DELayout` mentioned above. +!! - an `ESMF_Grid` is then created by passing in the above `ESMF_DistGrid`. +!! +!! Masks, areas, center (tlat, tlon), and corner (ulat, ulon) coordinates are then added to the `ESMF_Grid` +!! by retrieving those fields from MOM with calls to `ocean_model_data_get()`. +!! +!! @subsection Initialization Initialization +!! +!! During the [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) phase, calls are +!! made to MOM's native initialization subroutines, including `fms_init()`, `constants_init()`, +!! `field_manager_init()`, `diag_manager_init()`, and `set_calendar_type()`. The MPI communicator +!! is pulled in through the ESMF VM object for the MOM component. The dt and start time are set +!! from parameters from the incoming ESMF clock with calls to `set_time()` and `set_date().` +!! +!! +!! @subsection Run Run +!! +!! The [ModelAdvance] (@ref mom_cap_mod::modeladvance) subroutine is called by the NUOPC +!! infrastructure when it's time for MOM to advance in time. During this subroutine, there is a +!! call into the MOM update routine: +!! +!! call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_sfc, Time, Time_step_coupled) +!! +!! Prior to this call, the cap performs a few steps: +!! - the `Time` and `Time_step_coupled` parameters, which are based on FMS types, are derived from the incoming ESMF clock +!! - there are calls to two stubs: `ice_ocn_bnd_from_data()` and `external_coupler_sbc_before()` - these are currently +!! inactive, but may be modified to read in import data from file or from an external coupler +!! - diagnostics are optionally written to files `field_ocn_import_*`, one for each import field +!! - import fields are prepared: +!! - the sign is reversed on `mean_evap_rate` and `mean_sensi_heat_flux` +!! - momentum flux vectors are rotated to internal grid +!! - optionally, a call is made to `ocean_model_restart()` at the interval `restart_interval` +!! +!! After the call to `update_ocean_model()`, the cap performs these steps: +!! - the `ocean_mask` export is set to match that of the internal MOM mask +!! - the `freezing_melting_potential` export is converted from J m-2 to W m-2 by dividing by the coupling interval +!! - vector rotations are applied to the `ocean_current_zonal` and `ocean_current_merid` exports, back to lat-lon grid +!! - diagnostics are optionally written to files `field_ocn_export_*`, one for each export field +!! - a call is made to `external_coupler_sbc_after()` to update exports from an external coupler (currently an inactive stub) +!! - calls are made to `dumpMomInternal()` to write files `field_ocn_internal_*` for all internal fields (both import and export) +!! +!! @subsubsection VectorRotations Vector Rotations +!! +!! Vector rotations are applied to incoming momentum fluxes (from regular lat-lon to tripolar grid) and +!! outgoing ocean currents (from tripolar to regular lat-lon). The rotation angles are provided +!! from the native MOM grid by a call to `get_ocean_grid(Ocean_grid)`. +!! The cosine and sine of the rotation angle are: +!! +!! Ocean_grid%cos_rot(i,j) +!! Ocean_grid%sin_rot(i,j) +!! +!! The rotation of momentum flux from regular lat-lon to tripolar is: +!! \f[ +!! \begin{bmatrix} +!! \tau_x' \\ +!! \tau_y' +!! \end{bmatrix} = +!! \begin{bmatrix} +!! cos \theta & sin \theta \\ +!! -sin \theta & cos \theta +!! \end{bmatrix} * +!! \begin{bmatrix} +!! \tau_x \\ +!! \tau_y +!! \end{bmatrix} +!! \f] +!! +!! The rotation of ocean current from tripolar to regular lat-lon is: +!! \f[ +!! \begin{bmatrix} +!! u' \\ +!! v' +!! \end{bmatrix} = +!! \begin{bmatrix} +!! cos \theta & -sin \theta \\ +!! sin \theta & cos \theta +!! \end{bmatrix} * +!! \begin{bmatrix} +!! u \\ +!! v +!! \end{bmatrix} +!! \f] +!! @subsection Finalization Finalization +!! +!! NUOPC infrastructure calls [ocean_model_finalize] (@ref mom_cap_mod::ocean_model_finalize) +!! at the end of the run. This subroutine is a hook to call into MOM's native shutdown +!! procedures: +!! +!! call ocean_model_end (Ocean_sfc, Ocean_State, Time) +!! call diag_manager_end(Time ) +!! call field_manager_end +!! call fms_io_exit +!! call fms_end +!! +!! @section ModelFields Model Fields +!! +!! The following tables list the import and export fields currently set up in the MOM cap. +!! +!! @subsection ImportFields Import Fields +!! +!! Standard Name | Units | Model Variable | Description | Notes +!! ----------------------------------|------------|-----------------|-----------------------------------------------|-------------------------------------- +!! inst_pres_height_surface | Pa | p | pressure of overlying sea ice and atmosphere | | +!! mass_of_overlying_sea_ice | kg | mi | mass of overlying sea ice | | +!! mean_calving_heat_flx | W m-2 | calving_hflx | heat flux, relative to 0C, of frozen land water into ocean | | +!! mean_calving_rate | kg m-2 s-1 | calving | mass flux of frozen runoff | | +!! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | sign reversed (- evap) +!! mean_fprec_rate | kg m-2 s-1 | fprec | mass flux of frozen precip | | +!! mean_merid_moment_flx | Pa | v_flux | j-directed wind stress into ocean | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar +!! mean_net_lw_flx | W m-2 | lw_flux | long wave radiation | | +!! mean_net_sw_ir_dif_flx | W m-2 | sw_flux_nir_dif | diffuse near IR shortwave radiation | | +!! mean_net_sw_ir_dir_flx | W m-2 | sw_flux_nir_dir | direct near IR shortwave radiation | | +!! mean_net_sw_vis_dif_flx | W m-2 | sw_flux_vis_dif | diffuse visible shortware radiation | | +!! mean_net_sw_vis_dir_flx | W m-2 | sw_flux_vis_dir | direct visible shortware radiation | | +!! mean_prec_rate | kg m-2 s-1 | lprec | mass flux of liquid precip | | +!! mean_runoff_heat_flx | W m-2 | runoff_hflx | heat flux, relative to 0C, of liquid land water into ocean | | +!! mean_runoff_rate | kg m-2 s-1 | runoff | mass flux of liquid runoff | | +!! mean_salt_rate | kg m-2 s-1 | salt_flux | salt flux | | +!! mean_sensi_heat_flx | W m-2 | t_flux | sensible heat flux into ocean | sign reversed (- sensi) +!! mean_zonal_moment_flx | Pa | u_flux | j-directed wind stress into ocean | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar +!! +!! +!! @subsection ExportField Export Fields +!! +!! Export fields are populated from the `ocean_sfc` parameter (type `ocean_public_type`) +!! after the call to `update_ocean_model()`. +!! +!! Standard Name | Units | Model Variable | Description | Notes +!! ----------------------------------|------------|-----------------|-------------------------------------------|--------------------------------------------------------------------- +!! freezing_melting_potential | W m-2 | frazil | accumulated heating from frazil formation | cap converts model units (J m-2) to (W m-2) for export +!! ocean_mask | | | ocean mask | | +!! ocn_current_merid | m s-1 | v_surf | j-directed surface velocity on u-cell | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon +!! ocn_current_zonal | m s-1 | u_surf | i-directed surface velocity on u-cell | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon +!! s_surf | psu | s_surf | sea surface salinity on t-cell | | +!! sea_lev | m | sea_lev | sea level | model computation is eta_t + patm/(rho0*grav) - eta_geoid - eta_tide +!! sea_surface_temperature | K | t_surf | sea surface temperature on t-cell | | +!! +!! @subsection MemoryManagement Memory Management +!! +!! The MOM cap has an internal state type with pointers to three +!! types defined by MOM. There is also a small wrapper derived type +!! required to associate an internal state instance +!! with the ESMF/NUOPC component: +!! +!! type ocean_internalstate_type +!! type(ocean_public_type), pointer :: ocean_public_type_ptr +!! type(ocean_state_type), pointer :: ocean_state_type_ptr +!! type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr +!! end type +!! +!! type ocean_internalstate_wrapper +!! type(ocean_internalstate_type), pointer :: ptr +!! end type +!! +!! The member of type `ocean_public_type` stores ocean surface fields used during the coupling. +!! The member of type `ocean_state_type` is required by the ocean driver, +!! although its internals are private (not to be used by the coupling directly). +!! This type is passed to the ocean init and update routines +!! so that it can maintain state there if desired. +!! The member of type `ice_ocean_boundary_type` is populated by this cap +!! with incoming coupling fields from other components. These three derived types are allocated during the +!! [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) phase. Also during that +!! phase, the `ice_ocean_boundary` type members are all allocated using bounds retrieved +!! from `mpp_get_compute_domain()`. +!! +!! During the [InitializeRealize] (@ref mom_cap_mod::initializerealize) phase, +!! `ESMF_Field`s are created for each of the coupling fields in the `ice_ocean_boundary` +!! and `ocean_public_type` members of the internal state. These fields directly reference into the members of +!! the `ice_ocean_boundary` and `ocean_public_type` so that memory-to-memory copies are not required to move +!! data from the cap's import and export states to the memory areas used internally +!! by MOM. +!! +!! @subsection IO I/O +!! +!! The cap can optionally output coupling fields for diagnostic purposes if the ESMF attribute +!! "DumpFields" has been set to "true". In this case the cap will write out NetCDF files +!! with names "field_ocn_import_.nc" and "field_ocn_export_.nc". +!! Additionally, calls will be made to the cap subroutine [dumpMomInternal] +!! (@ref mom_cap_mod::dumpmominternal) to write out model internal fields to files +!! named "field_ocn_internal_.nc". In all cases these NetCDF files will +!! contain a time series of field data. +!! +!! @section BuildingAndInstalling Building and Installing +!! +!! There are two makefiles included with the MOM cap, makefile and makefile.nuopc. +!! The makefile.nuopc file is intended to be used within another build system, such +!! as the NEMSAppBuilder. The regular makefile can be used generally for building +!! and installing the cap. Two variables must be customized at the top: +!! - `INSTALLDIR` - where to copy the cap library and dependent libraries +!! - `NEMSMOMDIR` - location of the MOM library and FMS library +!! +!! To install run: +!! $ make install +!! +!! A makefile fragment, mom.mk, will also be copied into the directory. The fragment +!! defines several variables that can be used by another build system to include the +!! MOM cap and its dependencies. +!! +!! @subsection Dependencies Dependencies +!! +!! The MOM cap is dependent on the MOM library itself (lib_ocean.a) and the FMS +!! library (lib_FMS.a). +!! +!! @section RuntimeConfiguration Runtime Configuration +!! +!! At runtime, the MOM cap can be configured with several options provided +!! as ESMF attributes. Attributes can be set in the cap by the NUOPC Driver +!! above this cap, or in some systems (e.g., NEMS) attributes are set by +!! reading in from a configuration file. The available attributes are: +!! +!! * `DumpFields` - when set to "true", write out diagnostic NetCDF files for import/export/internal fields +!! * `ProfileMemory` - when set to "true", write out memory usage information to the ESMF log files; this +!! information is written when entering and leaving the [ModelAdvance] +!! (@ref mom_cap_mod::modeladvance) subroutine and before and after the call to +!! `update_ocean_model()`. +!! * `OceanSolo` - when set to "true", this option indicates that MOM is being run +!! uncoupled; in this case the vector rotations and other data manipulations +!! on import fields are skipped +!! * `restart_interval` - integer number of seconds indicating the interval at +!! which to call `ocean_model_restart()`; no restarts written if set to 0 +!! * `GridAttachArea` - when set to "true", this option indicates that MOM grid attaches cell area +!! using internal values computed in MOM. The default value is "false", grid cell area will +!! be computed in ESMF. +!! +!! +!! @section Repository +!! The MOM NUOPC cap is maintained in a GitHub repository: +!! https://github.com/feiliuesmf/nems_mom_cap +!! +!! @section References +!! +!! - [MOM Home Page] (http://mom-ocean.org/web) +!! +!! +module mom_cap_mod + use constants_mod, only: constants_init + use data_override_mod, only: data_override_init, data_override + use diag_manager_mod, only: diag_manager_init, diag_manager_end + use field_manager_mod, only: field_manager_init, field_manager_end + use fms_mod, only: fms_init, fms_end, open_namelist_file, check_nml_error + use fms_mod, only: close_file, file_exist, uppercase + use fms_io_mod, only: fms_io_exit + use mpp_domains_mod, only: domain2d, mpp_get_compute_domain, mpp_get_compute_domains + use mpp_domains_mod, only: mpp_get_ntile_count, mpp_get_pelist, mpp_get_global_domain + use mpp_domains_mod, only: mpp_get_domain_npes, mpp_global_field + use mpp_io_mod, only: mpp_open, MPP_RDONLY, MPP_ASCII, MPP_OVERWR, MPP_APPEND, mpp_close, MPP_SINGLE + use mpp_mod, only: input_nml_file, mpp_error, FATAL, NOTE, mpp_pe, mpp_npes, mpp_set_current_pelist + use mpp_mod, only: stdlog, stdout, mpp_root_pe, mpp_clock_id + use mpp_mod, only: mpp_clock_begin, mpp_clock_end, MPP_CLOCK_SYNC + use mpp_mod, only: MPP_CLOCK_DETAILED, CLOCK_COMPONENT, MAXPES + use time_interp_external_mod, only: time_interp_external_init + use time_manager_mod, only: set_calendar_type, time_type, increment_date + use time_manager_mod, only: set_time, set_date, get_time, get_date, month_name + use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR + use time_manager_mod, only: operator( <= ), operator( < ), operator( >= ) + use time_manager_mod, only: operator( + ), operator( - ), operator( / ) + use time_manager_mod, only: operator( * ), operator( /= ), operator( > ) + use time_manager_mod, only: date_to_string + use time_manager_mod, only: fms_get_calendar_type => get_calendar_type + + use ocean_model_mod, only: ocean_model_restart, ocean_public_type, ocean_state_type + use ocean_model_mod, only: ocean_model_data_get + use ocean_model_mod, only: ocean_model_init , update_ocean_model, ocean_model_end, get_ocean_grid +#ifdef MOM6_CAP + use ocean_model_mod, only: ice_ocean_boundary_type + use MOM_grid, only: ocean_grid_type +#else + use ocean_types_mod, only: ice_ocean_boundary_type, ocean_grid_type +#endif + + use ESMF + use NUOPC + use NUOPC_Model, & + model_routine_SS => SetServices, & + model_label_Advance => label_Advance, & + model_label_Finalize => label_Finalize + + use time_utils_mod + + implicit none + private + public SetServices + + type ocean_internalstate_type + type(ocean_public_type), pointer :: ocean_public_type_ptr + type(ocean_state_type), pointer :: ocean_state_type_ptr + type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr + type(ocean_grid_type), pointer :: ocean_grid_ptr + end type + + type ocean_internalstate_wrapper + type(ocean_internalstate_type), pointer :: ptr + end type + + type fld_list_type + character(len=64) :: stdname + character(len=64) :: shortname + character(len=64) :: transferOffer + logical :: assoc ! is the farrayPtr associated with internal data + real(ESMF_KIND_R8), dimension(:,:), pointer :: farrayPtr + end type fld_list_type + + integer,parameter :: fldsMax = 100 + integer :: fldsToOcn_num = 0 + type (fld_list_type) :: fldsToOcn(fldsMax) + integer :: fldsFrOcn_num = 0 + type (fld_list_type) :: fldsFrOcn(fldsMax) + + integer :: import_slice = 1 + integer :: export_slice = 1 + character(len=256) :: tmpstr + integer :: dbrc + + type(ESMF_Grid), save :: mom_grid_i + logical :: write_diagnostics = .true. + logical :: profile_memory = .true. + logical :: ocean_solo = .true. + logical :: grid_attach_area = .false. + integer(ESMF_KIND_I8) :: restart_interval + + contains + !----------------------------------------------------------------------- + !------------------- Solo Ocean code starts here ----------------------- + !----------------------------------------------------------------------- + + !> NUOPC SetService method is the only public entry point. + !! SetServices registers all of the user-provided subroutines + !! in the module with the NUOPC layer. + !! + !! @param gcomp an ESMF_GridComp object + !! @param rc return code + subroutine SetServices(gcomp, rc) + + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + character(len=*),parameter :: subname='(mom_cap:SetServices)' + + rc = ESMF_SUCCESS + + ! the NUOPC model component will register the generic methods + call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! switching to IPD versions + call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + userRoutine=InitializeP0, phase=0, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! set entry point for methods that require specific implementation + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv01p1"/), userRoutine=InitializeAdvertise, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv01p3"/), userRoutine=InitializeRealize, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! attach specializing method(s) + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & + specRoutine=ModelAdvance, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & + specRoutine=ocean_model_finalize, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end subroutine SetServices + + !----------------------------------------------------------------------------- + + !> First initialize subroutine called by NUOPC. The purpose + !! is to set which version of the Initialize Phase Definition (IPD) + !! to use. + !! + !! For this MOM cap, we are using IPDv01. + !! + !! @param gcomp an ESMF_GridComp object + !! @param importState an ESMF_State object for import fields + !! @param exportState an ESMF_State object for export fields + !! @param clock an ESMF_Clock object + !! @param rc return code + subroutine InitializeP0(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=10) :: value + + rc = ESMF_SUCCESS + + ! Switch to IPDv01 by filtering all other phaseMap entries + call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, & + acceptStringList=(/"IPDv01p"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_AttributeGet(gcomp, name="DumpFields", value=value, defaultValue="true", & + convention="NUOPC", purpose="Instance", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write_diagnostics=(trim(value)=="true") + call ESMF_LogWrite('MOM_CAP:DumpFields = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + + call ESMF_AttributeGet(gcomp, name="ProfileMemory", value=value, defaultValue="true", & + convention="NUOPC", purpose="Instance", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + profile_memory=(trim(value)/="false") + call ESMF_LogWrite('MOM_CAP:ProfileMemory = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + + call ESMF_AttributeGet(gcomp, name="OceanSolo", value=value, defaultValue="false", & + convention="NUOPC", purpose="Instance", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ocean_solo=(trim(value)=="true") + call ESMF_LogWrite('MOM_CAP:OceanSolo = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + + ! Retrieve restart_interval in (seconds) + ! A restart_interval value of 0 means no restart will be written. + call ESMF_AttributeGet(gcomp, name="restart_interval", value=value, defaultValue="0", & + convention="NUOPC", purpose="Instance", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + restart_interval = ESMF_UtilString2Int(value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if(restart_interval < 0) then + call ESMF_LogSetError(ESMF_RC_NOT_VALID, & + msg="MOM_CAP: OCN attribute: restart_interval cannot be negative.", & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + endif + call ESMF_LogWrite('MOM_CAP:restart_interval = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + + call ESMF_AttributeGet(gcomp, name="GridAttachArea", value=value, defaultValue="false", & + convention="NUOPC", purpose="Instance", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + grid_attach_area=(trim(value)=="true") + call ESMF_LogWrite('MOM_CAP:GridAttachArea = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + + end subroutine + + !----------------------------------------------------------------------------- + + !> Called by NUOPC to advertise import and export fields. "Advertise" + !! simply means that the standard names of all import and export + !! fields are supplied. The NUOPC layer uses these to match fields + !! between components in the coupled system. + !! + !! @param gcomp an ESMF_GridComp object + !! @param importState an ESMF_State object for import fields + !! @param exportState an ESMF_State object for export fields + !! @param clock an ESMF_Clock object + !! @param rc return code + subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + type(ESMF_VM) :: vm + type(ESMF_Time) :: MyTime + type(ESMF_TimeInterval) :: TINT + + type (ocean_public_type), pointer :: Ocean_sfc => NULL() + type (ocean_state_type), pointer :: Ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + + type(time_type) :: Run_len ! length of experiment + type(time_type) :: Time + type(time_type) :: Time_restart + type(time_type) :: DT + integer :: DT_OCEAN + integer :: isc,iec,jsc,jec + integer :: dt_cpld = 86400 + integer :: year=0, month=0, day=0, hour=0, minute=0, second=0 + integer :: mpi_comm_mom + + type(ESMF_Grid) :: gridIn + type(ESMF_Grid) :: gridOut + + integer :: npet, npet_x, npet_y + character(len=*),parameter :: subname='(mom_cap:InitializeAdvertise)' + + rc = ESMF_SUCCESS + + allocate(Ice_ocean_boundary) + !allocate(Ocean_state) ! ocean_model_init allocate this pointer + allocate(Ocean_sfc) + allocate(ocean_internalstate%ptr) + ocean_internalstate%ptr%ice_ocean_boundary_type_ptr => Ice_ocean_boundary + ocean_internalstate%ptr%ocean_public_type_ptr => Ocean_sfc + ocean_internalstate%ptr%ocean_state_type_ptr => Ocean_state + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_VMGet(VM, mpiCommunicator=mpi_comm_mom, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(CLOCK, currTIME=MyTime, TimeStep=TINT, RC=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_TimeGet (MyTime, & + YY=YEAR, MM=MONTH, DD=DAY, & + H=HOUR, M =MINUTE, S =SECOND, & + RC=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + CALL ESMF_TimeIntervalGet(TINT, S=DT_OCEAN, RC=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call fms_init(mpi_comm_mom) + call constants_init + call field_manager_init + call set_calendar_type (JULIAN ) + call diag_manager_init + ! this ocean connector will be driven at set interval + dt_cpld = DT_OCEAN + DT = set_time (DT_OCEAN, 0) + Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) + + Ocean_sfc%is_ocean_pe = .true. + call ocean_model_init(Ocean_sfc, Ocean_state, Time, Time) + call data_override_init(Ocean_domain_in = Ocean_sfc%domain) + call mpp_get_compute_domain(Ocean_sfc%domain, isc, iec, jsc, jec) + + allocate ( Ice_ocean_boundary% u_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% v_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% t_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% q_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% salt_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% lw_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_vis_dir (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_vis_dif (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_nir_dir (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_nir_dif (isc:iec,jsc:jec), & + Ice_ocean_boundary% lprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% fprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% runoff (isc:iec,jsc:jec), & + Ice_ocean_boundary% calving (isc:iec,jsc:jec), & + Ice_ocean_boundary% runoff_hflx (isc:iec,jsc:jec), & + Ice_ocean_boundary% calving_hflx (isc:iec,jsc:jec), & + Ice_ocean_boundary% mi (isc:iec,jsc:jec), & + Ice_ocean_boundary% p (isc:iec,jsc:jec)) + + Ice_ocean_boundary%u_flux = 0.0 + Ice_ocean_boundary%v_flux = 0.0 + Ice_ocean_boundary%t_flux = 0.0 + Ice_ocean_boundary%q_flux = 0.0 + Ice_ocean_boundary%salt_flux = 0.0 + Ice_ocean_boundary%lw_flux = 0.0 + Ice_ocean_boundary%sw_flux_vis_dir = 0.0 + Ice_ocean_boundary%sw_flux_vis_dif = 0.0 + Ice_ocean_boundary%sw_flux_nir_dir = 0.0 + Ice_ocean_boundary%sw_flux_nir_dif = 0.0 + Ice_ocean_boundary%lprec = 0.0 + Ice_ocean_boundary%fprec = 0.0 + Ice_ocean_boundary%runoff = 0.0 + Ice_ocean_boundary%calving = 0.0 + Ice_ocean_boundary%runoff_hflx = 0.0 + Ice_ocean_boundary%calving_hflx = 0.0 + Ice_ocean_boundary%mi = 0.0 + Ice_ocean_boundary%p = 0.0 + + call external_coupler_sbc_init(Ocean_sfc%domain, dt_cpld, Run_len) + + ocean_internalstate%ptr%ocean_state_type_ptr => Ocean_state + call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call MOM_FieldsSetup(ice_ocean_boundary, ocean_sfc) + + call MOM_AdvertiseFields(importState, fldsToOcn_num, fldsToOcn, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call MOM_AdvertiseFields(exportState, fldsFrOcn_num, fldsFrOcn, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + +#ifdef MOM6_CAP + ! When running mom6 solo, the rotation angles are not computed internally + ! in MOM6. We need to + ! calculate cos and sin of rotational angle for MOM6; the values + ! are stored in ocean_internalstate%ptr%ocean_grid_ptr%cos_rot and sin_rot + ! The rotation angles are retrieved during run time to rotate incoming + ! and outgoing vectors + ! + call calculate_rot_angle(Ocean_state, ocean_sfc, & + ocean_internalstate%ptr%ocean_grid_ptr) +#endif + + write(*,*) '----- MOM initialization phase Advertise completed' + + end subroutine InitializeAdvertise + + !----------------------------------------------------------------------------- + + !> Called by NUOPC to realize import and export fields. "Realizing" a field + !! means that its grid has been defined and an ESMF_Field object has been + !! created and put into the import or export State. + !! + !! @param gcomp an ESMF_GridComp object + !! @param importState an ESMF_State object for import fields + !! @param exportState an ESMF_State object for export fields + !! @param clock an ESMF_Clock object + !! @param rc return code + subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! Local Variables + type(ESMF_VM) :: vm + type(ESMF_Grid) :: gridIn + type(ESMF_Grid) :: gridOut + type(ESMF_DeLayout) :: delayout + type(ESMF_Distgrid) :: Distgrid + type(ESMF_DistGridConnection), allocatable :: connectionList(:) + type (ocean_public_type), pointer :: Ocean_sfc => NULL() + type (ocean_state_type), pointer :: Ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + integer :: npet, ntiles + integer :: nxg, nyg, cnt + integer :: isc,iec,jsc,jec + integer, allocatable :: xb(:),xe(:),yb(:),ye(:),pe(:) + integer, allocatable :: deBlockList(:,:,:), & + petMap(:),deLabelList(:), & + indexList(:) + integer :: ioff, joff + integer :: i, j, n, i1, j1, n1, icount + integer :: lbnd1,ubnd1,lbnd2,ubnd2 + integer :: lbnd3,ubnd3,lbnd4,ubnd4 + integer :: nblocks_tot + logical :: found + real(ESMF_KIND_R8), allocatable :: ofld(:,:), gfld(:,:) + real(ESMF_KIND_R8), pointer :: t_surf(:,:) + integer(ESMF_KIND_I4), pointer :: dataPtr_mask(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_area(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_xcen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ycen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_xcor(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ycor(:,:) + type(ESMF_Field) :: field_t_surf + character(len=*),parameter :: subname='(mom_cap:InitializeRealize)' + + rc = ESMF_SUCCESS + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr + Ocean_sfc => ocean_internalstate%ptr%ocean_public_type_ptr + Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_VMGet(vm, petCount=npet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !--------------------------------- + ! global mom grid size + !--------------------------------- + + call mpp_get_global_domain(Ocean_sfc%domain, xsize=nxg, ysize=nyg) + write(tmpstr,'(a,2i6)') subname//' nxg,nyg = ',nxg,nyg + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + !--------------------------------- + ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total + !--------------------------------- + + ntiles=mpp_get_ntile_count(Ocean_sfc%domain) ! this is tiles on this pe + if (ntiles /= 1) then + rc = ESMF_FAILURE + call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR, rc=dbrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + ntiles=mpp_get_domain_npes(Ocean_sfc%domain) + write(tmpstr,'(a,1i6)') subname//' ntiles = ',ntiles + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + !--------------------------------- + ! get start and end indices of each tile and their PET + !--------------------------------- + + allocate(xb(ntiles),xe(ntiles),yb(ntiles),ye(ntiles),pe(ntiles)) + call mpp_get_compute_domains(Ocean_sfc%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye) + call mpp_get_pelist(Ocean_sfc%domain, pe) + do n = 1,ntiles + write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + enddo + + !--------------------------------- + ! create delayout and distgrid + !--------------------------------- + + allocate(deBlockList(2,2,ntiles)) + allocate(petMap(ntiles)) + allocate(deLabelList(ntiles)) + + do n = 1, ntiles + deLabelList(n) = n + deBlockList(1,1,n) = xb(n) + deBlockList(1,2,n) = xe(n) + deBlockList(2,1,n) = yb(n) + deBlockList(2,2,n) = ye(n) + petMap(n) = pe(n) + ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side + enddo + + delayout = ESMF_DELayoutCreate(petMap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + allocate(connectionList(2)) + ! bipolar boundary condition at top row: nyg + call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & + tileIndexB=1, positionVector=(/nxg+1, 2*nyg+1/), & + orientationVector=(/-1, -2/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ! periodic boundary condition along first dimension + call ESMF_DistGridConnectionSet(connectionList(2), tileIndexA=1, & + tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nxg,nyg/), & +! indexflag = ESMF_INDEX_DELOCAL, & + deBlockList=deBlockList, & +! deLabelList=deLabelList, & + delayout=delayout, & + connectionList=connectionList, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + deallocate(xb,xe,yb,ye,pe) + deallocate(connectionList) + deallocate(deLabelList) + deallocate(deBlockList) + deallocate(petMap) + + call ESMF_DistGridGet(distgrid=distgrid, localDE=0, elementCount=cnt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + allocate(indexList(cnt)) + write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(tmpstr,'(a,4i8)') subname//' distgrid list= ',& + indexList(1),indexList(cnt),minval(indexList), maxval(indexList) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + deallocate(IndexList) + + !--------------------------------- + ! create grid + !--------------------------------- + + gridIn = ESMF_GridCreate(distgrid=distgrid, & + gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & + coordSys = ESMF_COORDSYS_SPH_DEG, & + rc = rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + mom_grid_i = gridIn + + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! Attach area to the Grid optionally. By default the cell areas are computed. + if(grid_attach_area) then + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + call ESMF_GridGetCoord(gridIn, coordDim=1, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_xcen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridGetCoord(gridIn, coordDim=2, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_ycen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridGetCoord(gridIn, coordDim=1, & + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=dataPtr_xcor, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridGetCoord(gridIn, coordDim=2, & + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=dataPtr_ycor, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_MASK, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_mask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if(grid_attach_area) then + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_area, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + !--------------------------------- + ! load up area, mask, center and corner values + ! area, mask, and centers should be same size in mom and esmf grid + ! corner points may not be, need to offset corner points by 1 in i and j + ! for esmf and also need to "make up" j=1 values. use wraparound in i + !--------------------------------- + + call mpp_get_compute_domain(Ocean_sfc%domain, isc, iec, jsc, jec) + + lbnd1 = lbound(dataPtr_mask,1) + ubnd1 = ubound(dataPtr_mask,1) + lbnd2 = lbound(dataPtr_mask,2) + ubnd2 = ubound(dataPtr_mask,2) + + lbnd3 = lbound(dataPtr_xcor,1) + ubnd3 = ubound(dataPtr_xcor,1) + lbnd4 = lbound(dataPtr_xcor,2) + ubnd4 = ubound(dataPtr_xcor,2) + + write(tmpstr,*) subname//' iscjsc = ',isc,iec,jsc,jec + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' lbub12 = ',lbnd1,ubnd1,lbnd2,ubnd2 + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' lbub34 = ',lbnd3,ubnd3,lbnd4,ubnd4 + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + if (iec-isc /= ubnd1-lbnd1 .or. jec-jsc /= ubnd2-lbnd2) then + rc=ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": fld and grid do not have the same size.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + + allocate(ofld(isc:iec,jsc:jec)) + allocate(gfld(nxg,nyg)) + + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'mask', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld mask = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld mask = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_mask(i,j) = nint(ofld(i1,j1)) + enddo + enddo + + if(grid_attach_area) then + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'area', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld area = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld area = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_area(i,j) = ofld(i1,j1) + enddo + enddo + endif + + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'tlon', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld xt = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld xt = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_xcen(i,j) = ofld(i1,j1) + dataPtr_xcen(i,j) = mod(dataPtr_xcen(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) + enddo + enddo + + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'tlat', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld yt = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld yt = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_ycen(i,j) = ofld(i1,j1) + enddo + enddo + +#ifdef MOM5_CAP + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'ulon', ofld, isc, jsc) +#endif + +#ifdef MOM6_CAP + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'geoLonBu', ofld, isc, jsc) +#endif + write(tmpstr,*) subname//' ofld xu = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld xu = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd4, ubnd4 + do i = lbnd3, ubnd3 + j1 = j - lbnd4 + jsc - 1 + i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 + if (j1 == 0) then + dataPtr_xcor(i,j) = 2*gfld(i1,1) - gfld(i1,2) +! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) > 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) - 360. +! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) < 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) + 360. + elseif (j1 >= 1 .and. j1 <= nyg) then + dataPtr_xcor(i,j) = gfld(i1,j1) + else + rc=ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": error in xu j1.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + dataPtr_xcor(i,j) = mod(dataPtr_xcor(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) + ! write(tmpstr,*) subname//' ijfld xu = ',i,i1,j,j1,dataPtr_xcor(i,j) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + enddo + enddo + +! The corner latitude values are treated differently because MOM5 runs on B-Grid while +! MOM6 runs on C-Grid. +#ifdef MOM5_CAP + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'ulat', ofld, isc, jsc) +#endif + +#ifdef MOM6_CAP + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'geoLatBu', ofld, isc, jsc) +#endif + + write(tmpstr,*) subname//' ofld yu = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld yu = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd4, ubnd4 + do i = lbnd3, ubnd3 + j1 = j - lbnd4 + jsc - 1 + i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 + if (j1 == 0) then + dataPtr_ycor(i,j) = 2*gfld(i1,1) - gfld(i1,2) + elseif (j1 >= 1 .and. j1 <= nyg) then + dataPtr_ycor(i,j) = gfld(i1,j1) + else + rc=ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": error in yu j1.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + ! write(tmpstr,*) subname//' ijfld yu = ',i,i1,j,j1,dataPtr_ycor(i,j) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + enddo + enddo + + write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + if(grid_attach_area) then + write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + endif + + write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' ycen = ',minval(dataPtr_ycen),maxval(dataPtr_ycen) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' xcor = ',minval(dataPtr_xcor),maxval(dataPtr_xcor) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + deallocate(gfld) + + gridOut = gridIn ! for now out same as in + + !--------------------------------- + ! realize fields on grid + !--------------------------------- + + call MOM_RealizeFields(importState, gridIn , fldsToOcn_num, fldsToOcn, "Ocn import", rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call MOM_RealizeFields(exportState, gridOut, fldsFrOcn_num, fldsFrOcn, "Ocn export", rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_StateGet(exportState, itemSearch="sea_surface_temperature", itemCount=icount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! Do sst initialization if it's part of export state + if(icount /= 0) then + call ESMF_StateGet(exportState, itemName='sea_surface_temperature', field=field_t_surf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_FieldGet(field_t_surf, localDe=0, farrayPtr=t_surf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'mask', ofld, isc, jsc) + + lbnd1 = lbound(t_surf,1) + ubnd1 = ubound(t_surf,1) + lbnd2 = lbound(t_surf,2) + ubnd2 = ubound(t_surf,2) + + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + if (ofld(i1,j1) == 0.) t_surf(i,j) = 0.0 + enddo + enddo + + deallocate(ofld) + endif + + call NUOPC_Write(exportState, fileNamePrefix='init_field_ocn_export_', & + timeslice=1, relaxedFlag=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + write(*,*) '----- MOM initialization phase Realize completed' + + end subroutine InitializeRealize + + !> Called by NUOPC to advance the model a single timestep. + !! + !! @param gcomp an ESMF_GridComp object + !! @param rc return code + subroutine ModelAdvance(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_State) :: importState, exportState + type(ESMF_Time) :: currTime + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Time) :: startTime + type(ESMF_TimeInterval) :: time_elapsed + integer(ESMF_KIND_I8) :: n_interval, time_elapsed_sec + character(len=64) :: timestamp + + type (ocean_public_type), pointer :: Ocean_sfc => NULL() + type (ocean_state_type), pointer :: Ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + + ! define some time types + type(time_type) :: Time + type(time_type) :: Time_step_coupled + type(time_type) :: Time_restart_current + + integer :: dth, dtm, dts, dt_cpld = 86400 + integer :: isc,iec,jsc,jec,lbnd1,ubnd1,lbnd2,ubnd2 + integer :: i,j,i1,j1 + real(ESMF_KIND_R8), allocatable :: ofld(:,:), ocz(:,:), ocm(:,:) + real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) + integer :: nc + real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_mmmf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_mzmf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ocz(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ocm(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) + type(ocean_grid_type), pointer :: Ocean_grid + character(240) :: msgString + character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' + + rc = ESMF_SUCCESS + if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") + + ! query the Component for its clock, importState and exportState + call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & + exportState=exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr + Ocean_sfc => ocean_internalstate%ptr%ocean_public_type_ptr + Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + + ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep + + call ESMF_ClockPrint(clock, options="currTime", & + preString="------>Advancing OCN from: ", unit=msgString, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(clock, startTime=startTime, currTime=currTime, & + timeStep=timeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_TimePrint(currTime + timeStep, & + preString="--------------------------------> to: ", & + unit=msgString, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_TimeIntervalGet(timeStep, h=dth, m=dtm, s=dts, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Time = esmf2fms_time(currTime) + Time_step_coupled = esmf2fms_time(timeStep) + dt_cpld = dth*3600+dtm*60+dts + + call ice_ocn_bnd_from_data(Ice_ocean_boundary, Time, Time_step_coupled) + + call external_coupler_sbc_before(Ice_ocean_boundary, Ocean_sfc, nc, dt_cpld ) + + if(write_diagnostics) then + call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', & + timeslice=import_slice, relaxedFlag=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + import_slice = import_slice + 1 + endif + + ! rotate the lat/lon wind vector (CW) onto local tripolar coordinate system + + call mpp_get_compute_domain(Ocean_sfc%domain, isc, iec, jsc, jec) + + if(.not. ocean_solo) then + call State_getFldPtr(exportState,'ocean_mask',dataPtr_mask,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr_mask,1) + ubnd1 = ubound(dataPtr_mask,1) + lbnd2 = lbound(dataPtr_mask,2) + ubnd2 = ubound(dataPtr_mask,2) + +#ifdef MOM5_CAP + call get_ocean_grid(Ocean_grid) +#endif +#ifdef MOM6_CAP + Ocean_grid => ocean_internalstate%ptr%ocean_grid_ptr +#endif + + call State_getFldPtr(importState,'mean_zonal_moment_flx',dataPtr_mzmf,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,'mean_merid_moment_flx',dataPtr_mmmf,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,'mean_evap_rate',dataPtr_evap,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,'mean_sensi_heat_flx',dataPtr_sensi,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + dataPtr_evap = - dataPtr_evap + dataPtr_sensi = - dataPtr_sensi + + allocate(mzmf(lbnd1:ubnd1,lbnd2:ubnd2)) + allocate(mmmf(lbnd1:ubnd1,lbnd2:ubnd2)) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc ! work around local vs global indexing + i1 = i - lbnd1 + isc + mzmf(i,j) = Ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & + + Ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) + mmmf(i,j) = Ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & + - Ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) + enddo + enddo + dataPtr_mzmf = mzmf + dataPtr_mmmf = mmmf + deallocate(mzmf, mmmf) + endif ! not ocean_solo + + !Optionally write restart files when currTime-startTime is integer multiples of restart_interval + if(restart_interval > 0 ) then + time_elapsed = currTime - startTime + call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + n_interval = time_elapsed_sec / restart_interval + if((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then + time_restart_current = esmf2fms_time(currTime) + timestamp = date_to_string(time_restart_current) + call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=dbrc) + write(*,*) 'calling ocean_model_restart' + call ocean_model_restart(Ocean_state, timestamp) + endif + endif + + if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") + call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_sfc, Time, Time_step_coupled) + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") + + if(.not. ocean_solo) then + allocate(ofld(isc:iec,jsc:jec)) + + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'mask', ofld, isc, jsc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_mask(i,j) = nint(ofld(i1,j1)) + enddo + enddo + deallocate(ofld) + + ! Now rotate ocn current from tripolar grid back to lat/lon grid (CCW) + allocate(ocz(lbnd1:ubnd1,lbnd2:ubnd2)) + allocate(ocm(lbnd1:ubnd1,lbnd2:ubnd2)) + + call State_getFldPtr(exportState,'ocn_current_zonal',dataPtr_ocz,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'ocn_current_merid',dataPtr_ocm,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling + + ocz = dataPtr_ocz + ocm = dataPtr_ocm + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc ! work around local vs global indexing + i1 = i - lbnd1 + isc + dataPtr_ocz(i,j) = Ocean_grid%cos_rot(i1,j1)*ocz(i,j) & + - Ocean_grid%sin_rot(i1,j1)*ocm(i,j) + dataPtr_ocm(i,j) = Ocean_grid%cos_rot(i1,j1)*ocm(i,j) & + + Ocean_grid%sin_rot(i1,j1)*ocz(i,j) + enddo + enddo + deallocate(ocz, ocm) + endif ! not ocean_solo + + call ESMF_LogWrite("Before writing diagnostics", ESMF_LOGMSG_INFO, rc=rc) + if(write_diagnostics) then + call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & + timeslice=export_slice, relaxedFlag=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + export_slice = export_slice + 1 + endif + + call ESMF_LogWrite("Before calling sbc forcing", ESMF_LOGMSG_INFO, rc=rc) + call external_coupler_sbc_after(Ice_ocean_boundary, Ocean_sfc, nc, dt_cpld ) + + call ESMF_LogWrite("Before dumpMomInternal", ESMF_LOGMSG_INFO, rc=rc) + !write(*,*) 'MOM: --- run phase called ---' + call dumpMomInternal(mom_grid_i, import_slice, "mean_zonal_moment_flx", "will provide", Ice_ocean_boundary%u_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_merid_moment_flx", "will provide", Ice_ocean_boundary%v_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_sensi_heat_flx" , "will provide", Ice_ocean_boundary%t_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_evap_rate" , "will provide", Ice_ocean_boundary%q_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_salt_rate" , "will provide", Ice_ocean_boundary%salt_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_lw_flx" , "will provide", Ice_ocean_boundary%lw_flux ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dir_flx", "will provide", Ice_ocean_boundary%sw_flux_vis_dir) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dif_flx", "will provide", Ice_ocean_boundary%sw_flux_vis_dif) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dir_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dir) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dif_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dif) + call dumpMomInternal(mom_grid_i, import_slice, "mean_prec_rate" , "will provide", Ice_ocean_boundary%lprec ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_fprec_rate" , "will provide", Ice_ocean_boundary%fprec ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_rate" , "will provide", Ice_ocean_boundary%runoff ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_rate" , "will provide", Ice_ocean_boundary%calving) + call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_heat_flx" , "will provide", Ice_ocean_boundary%runoff_hflx ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_heat_flx", "will provide", Ice_ocean_boundary%calving_hflx) + call dumpMomInternal(mom_grid_i, import_slice, "inst_pres_height_surface" , "will provide", Ice_ocean_boundary%p ) + call dumpMomInternal(mom_grid_i, import_slice, "mass_of_overlying_sea_ice", "will provide", Ice_ocean_boundary%mi) + +!--------- export fields ------------- + + call dumpMomInternal(mom_grid_i, export_slice, "ocean_mask", "will provide", dataPtr_mask) + call dumpMomInternal(mom_grid_i, export_slice, "sea_surface_temperature", "will provide", Ocean_sfc%t_surf) + call dumpMomInternal(mom_grid_i, export_slice, "s_surf" , "will provide", Ocean_sfc%s_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_zonal", "will provide", Ocean_sfc%u_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_merid", "will provide", Ocean_sfc%v_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "sea_lev" , "will provide", Ocean_sfc%sea_lev) + + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") + end subroutine ModelAdvance + + !> Called by NUOPC at the end of the run to clean up. + !! + !! @param gcomp an ESMF_GridComp object + !! @param rc return code + subroutine ocean_model_finalize(gcomp, rc) + + ! input arguments + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type (ocean_public_type), pointer :: Ocean_sfc + type (ocean_state_type), pointer :: Ocean_state + type(ocean_internalstate_wrapper) :: ocean_internalstate + type(TIME_TYPE) :: Time + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currTime + character(len=64) :: timestamp + character(len=*),parameter :: subname='(mom_cap:ocean_model_finalize)' + + write(*,*) 'MOM: --- finalize called ---' + rc = ESMF_SUCCESS + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Ocean_sfc => ocean_internalstate%ptr%ocean_public_type_ptr + Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + + call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(clock, currTime=currTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + Time = esmf2fms_time(currTime) + + call ocean_model_end (Ocean_sfc, Ocean_State, Time) + call diag_manager_end(Time ) + call field_manager_end + + call fms_io_exit + call fms_end + + write(*,*) 'MOM: --- completed ---' + + end subroutine ocean_model_finalize + +!==================================================================== +! get forcing data from data_overide + subroutine ice_ocn_bnd_from_data(x, Time, Time_step_coupled) + + type (ice_ocean_boundary_type) :: x + type(Time_type), intent(in) :: Time, Time_step_coupled + + type(Time_type) :: Time_next + character(len=*),parameter :: subname='(mom_cap:ice_ocn_bnd_from_data)' + + Time_next = Time + Time_step_coupled + + !call data_override('OCN', 't_flux', x%t_flux , Time_next) + !call data_override('OCN', 'u_flux', x%u_flux , Time_next) + !call data_override('OCN', 'v_flux', x%v_flux , Time_next) + !call data_override('OCN', 'q_flux', x%q_flux , Time_next) + !call data_override('OCN', 'salt_flux', x%salt_flux , Time_next) + !call data_override('OCN', 'lw_flux', x%lw_flux , Time_next) + !call data_override('OCN', 'sw_flux_vis_dir', x%sw_flux_vis_dir, Time_next) + !call data_override('OCN', 'sw_flux_vis_dif', x%sw_flux_vis_dif, Time_next) + !call data_override('OCN', 'sw_flux_nir_dir', x%sw_flux_nir_dir, Time_next) + !call data_override('OCN', 'sw_flux_nir_dif', x%sw_flux_nir_dif, Time_next) + !call data_override('OCN', 'lprec', x%lprec , Time_next) + !call data_override('OCN', 'fprec', x%fprec , Time_next) + !call data_override('OCN', 'runoff', x%runoff , Time_next) + !call data_override('OCN', 'calving', x%calving , Time_next) + !call data_override('OCN', 'p', x%p , Time_next) + + end subroutine ice_ocn_bnd_from_data + + +!----------------------------------------------------------------------------------------- +! +! Subroutines for enabling coupling to external programs through a third party coupler +! such as OASIS/PRISM. +! If no external coupler then these will mostly be dummy routines. +! These routines can also serve as spots to call other user defined routines +!----------------------------------------------------------------------------------------- + +!----------------------------------------------------------------------------------------- + +! Dummy subroutines. + + subroutine external_coupler_mpi_init(mom_local_communicator, external_initialization) + implicit none + integer, intent(out) :: mom_local_communicator + logical, intent(out) :: external_initialization + external_initialization = .false. + mom_local_communicator = -100 ! Is there mpp_undefined parameter corresponding to MPI_UNDEFINED? + ! probably wouldn't need logical flag. + return + end subroutine external_coupler_mpi_init + +!----------------------------------------------------------------------------------------- + subroutine external_coupler_sbc_init(Dom, dt_cpld, Run_len) + implicit none + type(domain2d) :: Dom + integer :: dt_cpld + type(time_type) :: Run_len + return + end subroutine external_coupler_sbc_init + + subroutine external_coupler_sbc_before(Ice_ocean_boundary, Ocean_sfc, nsteps, dt_cpld ) + implicit none + type (ice_ocean_boundary_type), intent(INOUT) :: Ice_ocean_boundary + type (ocean_public_type) , intent(INOUT) :: Ocean_sfc + integer , intent(IN) :: nsteps, dt_cpld + return + end subroutine external_coupler_sbc_before + + + subroutine external_coupler_sbc_after(Ice_ocean_boundary, Ocean_sfc, nsteps, dt_cpld ) + type (ice_ocean_boundary_type) :: Ice_ocean_boundary + type (ocean_public_type) :: Ocean_sfc + integer :: nsteps, dt_cpld + return + end subroutine external_coupler_sbc_after + + subroutine external_coupler_restart( dt_cpld, num_cpld_calls ) + implicit none + integer, intent(in) :: dt_cpld, num_cpld_calls + return + end subroutine external_coupler_restart + + subroutine external_coupler_exit + return + end subroutine external_coupler_exit + +!----------------------------------------------------------------------------------------- + subroutine external_coupler_mpi_exit(mom_local_communicator, external_initialization) + implicit none + integer, intent(in) :: mom_local_communicator + logical, intent(in) :: external_initialization + return + end subroutine external_coupler_mpi_exit +!----------------------------------------------------------------------------------------- + subroutine writeSliceFields(state, filename_prefix, slice, rc) + type(ESMF_State) :: state + character(len=*) :: filename_prefix + integer :: slice + integer, intent(out), optional :: rc + + integer :: n, nfields + type(ESMF_Field) :: field + type(ESMF_StateItem_Flag) :: itemType + character(len=40) :: fileName + character(len=64),allocatable :: fieldNameList(:) + character(len=*),parameter :: subname='(mom_cap:writeSliceFields)' + + if (present(rc)) rc = ESMF_SUCCESS + + if (ESMF_IO_PIO_PRESENT .and. & + (ESMF_IO_NETCDF_PRESENT .or. ESMF_IO_PNETCDF_PRESENT)) then + + call ESMF_StateGet(state, itemCount=nfields, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + allocate(fieldNameList(nfields)) + call ESMF_StateGet(state, itemNameList=fieldNameList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + do n=1, size(fieldNameList) + call ESMF_StateGet(state, itemName=fieldNameList(n), & + itemType=itemType, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (itemType /= ESMF_STATEITEM_NOTFOUND) then + ! field is available in the state + call ESMF_StateGet(state, itemName=fieldNameList(n), field=field, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ! -> output to file + write (fileName,"(A)") & + filename_prefix//trim(fieldNameList(n))//".nc" + call ESMF_FieldWrite(field, fileName=trim(fileName), & + timeslice=slice, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + endif + enddo + + deallocate(fieldNameList) + + endif + + + end subroutine writeSliceFields + + !----------------------------------------------------------------------------- + + subroutine State_GetFldPtr(ST, fldname, fldptr, rc) + type(ESMF_State), intent(in) :: ST + character(len=*), intent(in) :: fldname + real(ESMF_KIND_R8), pointer, intent(in) :: fldptr(:,:) + integer, intent(out), optional :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrc + character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' + + call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (present(rc)) rc = lrc + + end subroutine State_GetFldPtr + + !----------------------------------------------------------------------------- + subroutine MOM_AdvertiseFields(state, nfields, field_defs, rc) + + type(ESMF_State), intent(inout) :: state + integer,intent(in) :: nfields + type(fld_list_type), intent(inout) :: field_defs(:) + integer, intent(inout) :: rc + + integer :: i + character(len=*),parameter :: subname='(mom_cap:MOM_AdvertiseFields)' + + rc = ESMF_SUCCESS + + do i = 1, nfields + + call NUOPC_Advertise(state, & + standardName=field_defs(i)%stdname, & + name=field_defs(i)%shortname, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + enddo + + end subroutine MOM_AdvertiseFields + + !----------------------------------------------------------------------------- + + subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) + + type(ESMF_State), intent(inout) :: state + type(ESMF_Grid), intent(in) :: grid + integer, intent(in) :: nfields + type(fld_list_type), intent(inout) :: field_defs(:) + character(len=*), intent(in) :: tag + integer, intent(inout) :: rc + + integer :: i + type(ESMF_Field) :: field + integer :: npet, nx, ny, pet, elb(2), eub(2), clb(2), cub(2), tlb(2), tub(2) + type(ESMF_VM) :: vm + character(len=*),parameter :: subname='(mom_cap:MOM_RealizeFields)' + + rc = ESMF_SUCCESS + + do i = 1, nfields + + if (field_defs(i)%assoc) then + write(tmpstr, *) subname, tag, ' Field ', field_defs(i)%shortname, ':', & + lbound(field_defs(i)%farrayPtr,1), ubound(field_defs(i)%farrayPtr,1), & + lbound(field_defs(i)%farrayPtr,2), ubound(field_defs(i)%farrayPtr,2) + call ESMF_LogWrite(tmpstr, ESMF_LOGMSG_INFO, rc=dbrc) + field = ESMF_FieldCreate(grid=grid, & + farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & +! farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + if (NUOPC_IsConnected(state, fieldName=field_defs(i)%shortname)) then + call NUOPC_Realize(state, field=field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite(subname // tag // " Field "// field_defs(i)%stdname // " is connected.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=dbrc) +! call ESMF_FieldPrint(field=field, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out + else + call ESMF_LogWrite(subname // tag // " Field "// field_defs(i)%stdname // " is not connected.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=dbrc) + ! TODO: Initialize the value in the pointer to 0 after proper restart is setup + !if(associated(field_defs(i)%farrayPtr) ) field_defs(i)%farrayPtr = 0.0 + ! remove a not connected Field from State + call ESMF_StateRemove(state, (/field_defs(i)%shortname/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + enddo + + end subroutine MOM_RealizeFields + + !----------------------------------------------------------------------------- + + subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_sfc) + type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary + type(ocean_public_type), intent(in) :: Ocean_sfc + character(len=*),parameter :: subname='(mom_cap:MOM_FieldsSetup)' + + !!! fld_list_add(num, fldlist, stdname, transferOffer, data(optional), shortname(optional)) + +!--------- import fields ------------- + +! tcraig, don't point directly into mom data YET (last field is optional in interface) +! instead, create space for the field when it's "realized". + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx", "will provide", data=Ice_ocean_boundary%u_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx", "will provide", data=Ice_ocean_boundary%v_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide", data=Ice_ocean_boundary%t_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide", data=Ice_ocean_boundary%q_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide", data=Ice_ocean_boundary%salt_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide", data=Ice_ocean_boundary%lw_flux ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dir) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dif) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_nir_dir) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_nir_dif) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide", data=Ice_ocean_boundary%lprec ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide", data=Ice_ocean_boundary%fprec ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide", data=Ice_ocean_boundary%runoff ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide", data=Ice_ocean_boundary%calving) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide", data=Ice_ocean_boundary%runoff_hflx ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx", "will provide", data=Ice_ocean_boundary%calving_hflx) + call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide", data=Ice_ocean_boundary%p ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice", "will provide", data=Ice_ocean_boundary%mi) + +!--------- export fields ------------- + + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask", "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature", "will provide", data=Ocean_sfc%t_surf) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide", data=Ocean_sfc%s_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal", "will provide", data=Ocean_sfc%u_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid", "will provide", data=Ocean_sfc%v_surf ) +! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir", "will provide") +! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir", "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=Ocean_sfc%sea_lev) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=Ocean_sfc%frazil) + + end subroutine MOM_FieldsSetup + + !----------------------------------------------------------------------------- + + subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) + ! ---------------------------------------------- + ! Set up a list of field information + ! ---------------------------------------------- + integer, intent(inout) :: num + type(fld_list_type), intent(inout) :: fldlist(:) + character(len=*), intent(in) :: stdname + character(len=*), intent(in) :: transferOffer + real(ESMF_KIND_R8), dimension(:,:), optional, target :: data + character(len=*), intent(in),optional :: shortname + + ! local variables + integer :: rc + character(len=*), parameter :: subname='(mom_cap:fld_list_add)' + + ! fill in the new entry + + num = num + 1 + if (num > fldsMax) then + call ESMF_LogWrite(trim(subname)//": ERROR num gt fldsMax "//trim(stdname), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) + return + endif + + fldlist(num)%stdname = trim(stdname) + if (present(shortname)) then + fldlist(num)%shortname = trim(shortname) + else + fldlist(num)%shortname = trim(stdname) + endif + fldlist(num)%transferOffer = trim(transferOffer) + if (present(data)) then + fldlist(num)%assoc = .true. + fldlist(num)%farrayPtr => data + else + fldlist(num)%assoc = .false. + endif + + end subroutine fld_list_add + + subroutine dumpMomInternal(grid, slice, stdname, nop, farray) + + type(ESMF_Grid) :: grid + integer, intent(in) :: slice + character(len=*) :: stdname + character(len=*) :: nop + real(ESMF_KIND_R8), dimension(:,:), target :: farray + + type(ESMF_Field) :: field + real(ESMF_KIND_R8), dimension(:,:), pointer :: f2d + integer :: rc + +#ifdef MOM6_CAP + return +#endif + + if(.not. write_diagnostics) return ! nop in production mode + if(ocean_solo) return ! do not dump internal fields in ocean solo mode + + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, & + indexflag=ESMF_INDEX_DELOCAL, & + name=stdname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_FieldGet(field, farrayPtr=f2d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + f2d(:,:) = farray(:,:) + + call ESMF_FieldWrite(field, fileName='field_ocn_internal_'//trim(stdname)//'.nc', & + timeslice=slice, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_FieldDestroy(field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end subroutine + +#ifdef MOM6_CAP + subroutine calculate_rot_angle(OS, OSFC, OG) + type(ocean_state_type), intent(in) :: OS + type(ocean_public_type), intent(in) :: OSFC + type(ocean_grid_type), pointer :: OG + + integer :: i,j,ishift,jshift,ilb,iub,jlb,jub + real :: angle, lon_scale + type(ocean_grid_type), pointer :: G + + call get_ocean_grid(OS, G) + + !print *, 'lbound: ', lbound(G%geoLatT), lbound(G%geoLonT), lbound(G%sin_rot) + !print *, 'ubound: ', ubound(G%geoLatT), ubound(G%geoLonT), ubound(G%sin_rot) + + !print *, minval(G%geoLatT), maxval(G%geoLatT) + !print *, minval(G%geoLonT), maxval(G%geoLonT) + !print *, G%isc, G%jsc, G%iec, G%jec + + ! + ! The bounds isc:iec goes from 5-104, isc-ishift:iec-ishift goes from 1:100 + ! + call mpp_get_compute_domain(OSFC%Domain, ilb, iub, jlb, jub) + ishift = ilb-G%isc + jshift = jlb-G%jsc + !print *, 'ilb, iub, jlb, jub', ilb, iub, jlb, jub, ishift, jshift + !print *, 'sizes', iub-ilb, jub-jlb, G%iec-G%isc, G%jec-G%jsc + allocate(OG) + allocate(OG%sin_rot(ilb:iub, jlb:jub)) + allocate(OG%cos_rot(ilb:iub, jlb:jub)) + + ! loop 5-104 + do j=G%jsc,G%jec ; do i=G%isc,G%iec + lon_scale = cos((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J-1 ) + & + G%geoLatBu(I-1,J) + G%geoLatBu(I,J)) * atan(1.0)/180) + angle = atan2((G%geoLonBu(I-1,J) + G%geoLonBu(I,J) - & + G%geoLonBu(I-1,J-1) - G%geoLonBu(I,J-1))*lon_scale, & + G%geoLatBu(I-1,J) + G%geoLatBu(I,J) - & + G%geoLatBu(I-1,J-1) - G%geoLatBu(I,J-1) ) + OG%sin_rot(i+ishift,j+jshift) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean + OG%cos_rot(i+ishift,j+jshift) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) + enddo ; enddo + !print *, minval(OG%sin_rot), maxval(OG%sin_rot) + !print *, minval(OG%cos_rot), maxval(OG%cos_rot) + + end subroutine +#endif + + +end module mom_cap_mod From 5374582b323cde6ffc908d7eeb9fc52c5aad955a Mon Sep 17 00:00:00 2001 From: apcraig Date: Thu, 15 Feb 2018 19:00:49 -0700 Subject: [PATCH 0002/1072] update mom cap from NEMS --- config_src/coupled_driver/ocean_model_MOM.F90 | 38 +++++ config_src/nuopc_driver/time_utils.F90 | 161 ++++++++++++++++++ 2 files changed, 199 insertions(+) create mode 100644 config_src/nuopc_driver/time_utils.F90 diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index c72c816b38..a020db3af9 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -75,6 +75,7 @@ module ocean_model_mod implicit none ; private 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 @@ -1162,6 +1163,26 @@ subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc) array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('btfHeat') array2D(isc:,jsc:) = 0 + case('tlat') + array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) + case('tlon') + array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) + case('ulat') + array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) + case('ulon') + array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) + case('vlat') + array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) + case('vlon') + array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) + case('geoLatBu') + array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) + case('geoLonBu') + array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) + case('cos_rot') + array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 + 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,'get_ocean_grid_data2D: unknown argument name='//name) end select @@ -1210,4 +1231,21 @@ subroutine ocean_public_type_chksum(id, timestep, ocn) end subroutine ocean_public_type_chksum +!####################################################################### +! +! +! +! Obtain the ocean grid. +! +! + subroutine get_ocean_grid(OS, Gridp) + type(ocean_state_type) :: OS + type(ocean_grid_type) , pointer :: Gridp + + Gridp => OS%grid + return + + end subroutine get_ocean_grid +! NAME="get_ocean_grid" + end module ocean_model_mod diff --git a/config_src/nuopc_driver/time_utils.F90 b/config_src/nuopc_driver/time_utils.F90 new file mode 100644 index 0000000000..52889e3252 --- /dev/null +++ b/config_src/nuopc_driver/time_utils.F90 @@ -0,0 +1,161 @@ +module time_utils_mod + + use fms_mod, only: uppercase + use mpp_mod, only: mpp_error, FATAL + use time_manager_mod, only: time_type, set_time, set_date, get_date + use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR + use time_manager_mod, only: fms_get_calendar_type => get_calendar_type + use ESMF + + implicit none + private + + !-------------------- interface blocks --------------------- + interface fms2esmf_cal + module procedure fms2esmf_cal_c + module procedure fms2esmf_cal_i + end interface fms2esmf_cal + interface esmf2fms_time + module procedure esmf2fms_time_t + module procedure esmf2fms_timestep + end interface esmf2fms_time + + public fms2esmf_cal + public esmf2fms_time + public fms2esmf_time + public string_to_date + + contains + + !-------------------- module code --------------------- + + function fms2esmf_cal_c(calendar) +! ! Return Value: + type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_c +! ! Arguments: + character(len=*), intent(in) :: calendar + + select case( uppercase(trim(calendar)) ) + case( 'GREGORIAN' ) + fms2esmf_cal_c = ESMF_CALKIND_GREGORIAN + case( 'JULIAN' ) + fms2esmf_cal_c = ESMF_CALKIND_JULIAN + case( 'NOLEAP' ) + fms2esmf_cal_c = ESMF_CALKIND_NOLEAP + case( 'THIRTY_DAY' ) + fms2esmf_cal_c = ESMF_CALKIND_360DAY + case( 'NO_CALENDAR' ) + fms2esmf_cal_c = ESMF_CALKIND_NOCALENDAR + case default + call mpp_error(FATAL, & + 'ocean_solo: ocean_solo_nml entry calendar must be one of GREGORIAN|JULIAN|NOLEAP|THIRTY_DAY|NO_CALENDAR.' ) + end select + end function fms2esmf_cal_c + + function fms2esmf_cal_i(calendar) +! ! Return Value: + type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_i +! ! Arguments: + integer, intent(in) :: calendar + + select case(calendar) + case(THIRTY_DAY_MONTHS) + fms2esmf_cal_i = ESMF_CALKIND_360DAY + case(GREGORIAN) + fms2esmf_cal_i = ESMF_CALKIND_GREGORIAN + case(JULIAN) + fms2esmf_cal_i = ESMF_CALKIND_JULIAN + case(NOLEAP) + fms2esmf_cal_i = ESMF_CALKIND_NOLEAP + case(NO_CALENDAR) + fms2esmf_cal_i = ESMF_CALKIND_NOCALENDAR + end select + end function fms2esmf_cal_i + + function esmf2fms_time_t(time) + ! Return Value + type(Time_type) :: esmf2fms_time_t + ! Input Arguments + type(ESMF_Time), intent(in) :: time + ! Local Variables + integer :: yy, mm, dd, h, m, s + type(ESMF_CALKIND_FLAG) :: calkind + + integer :: rc + + call ESMF_TimeGet(time, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, & + calkindflag=calkind, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + esmf2fms_time_t = Set_date(yy, mm, dd, h, m, s) + + end function esmf2fms_time_t + + function esmf2fms_timestep(timestep) + ! Return Value + type(Time_type) :: esmf2fms_timestep + ! Input Arguments + type(ESMF_TimeInterval), intent(in):: timestep + ! Local Variables + integer :: s + type(ESMF_CALKIND_FLAG) :: calkind + + integer :: rc + + call ESMF_TimeIntervalGet(timestep, s=s, calkindflag=calkind, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + esmf2fms_timestep = set_time(s, 0) + + end function esmf2fms_timestep + + function fms2esmf_time(time, calkind) + ! Return Value + type(ESMF_Time) :: fms2esmf_time + ! Input Arguments + type(Time_type), intent(in) :: time + type(ESMF_CALKIND_FLAG), intent(in), optional :: calkind + ! Local Variables + integer :: yy, mm, d, h, m, s + type(ESMF_CALKIND_FLAG) :: l_calkind + + integer :: rc + + if(present(calkind)) then + l_calkind = calkind + else + l_calkind = fms2esmf_cal(fms_get_calendar_type()) + endif + + call get_date(time, yy, mm, d, h, m, s) + + call ESMF_TimeSet(fms2esmf_time, yy=yy, mm=mm, d=d, h=h, m=m, s=s, & + calkindflag=l_calkind, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end function fms2esmf_time + + function string_to_date(string, rc) + character(len=15), intent(in) :: string + integer, intent(out), optional :: rc + type(time_type) :: string_to_date + + integer :: yr,mon,day,hr,min,sec + + if(present(rc)) rc = ESMF_SUCCESS + + read(string, '(I4.4,I2.2,I2.2,".",I2.2,I2.2,I2.2)') yr, mon, day, hr, min, sec + string_to_date = set_date(yr, mon, day, hr, min, sec) + + end function string_to_date + +end module time_utils_mod From 2cfa6314a17e6859bce6ad0f2b81a6882e0e39ba Mon Sep 17 00:00:00 2001 From: apcraig Date: Fri, 16 Feb 2018 13:30:09 -0700 Subject: [PATCH 0003/1072] update mom_cap for cesm --- config_src/nuopc_driver/mom_cap.F90 | 101 +++++++++++++++++++++++++--- 1 file changed, 93 insertions(+), 8 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 308ee918aa..56c4b5cd35 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -522,6 +522,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc character(len=10) :: value + character(len=*),parameter :: subname='(mom_cap:InitializeP0)' rc = ESMF_SUCCESS @@ -692,7 +693,12 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) Ocean_sfc%is_ocean_pe = .true. call ocean_model_init(Ocean_sfc, Ocean_state, Time, Time) - call data_override_init(Ocean_domain_in = Ocean_sfc%domain) + +!tcx tcraig This results in errors in CESM with help from Alper +! FATAL error "MPP_OPEN: error in OPEN for data_table" +! The subroutine data_override_init shouldn't be called because ALLOW_FLUX_ADJUSTMENTS is set to FALSE +!tcx call data_override_init(Ocean_domain_in = Ocean_sfc%domain) + call mpp_get_compute_domain(Ocean_sfc%domain, isc, iec, jsc, jec) allocate ( Ice_ocean_boundary% u_flux (isc:iec,jsc:jec), & @@ -1300,12 +1306,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) deallocate(ofld) endif - call NUOPC_Write(exportState, fileNamePrefix='init_field_ocn_export_', & - timeslice=1, relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out +! tcraig, turn this off for now, have issues with overwriting failures +! call NUOPC_Write(exportState, fileNamePrefix='init_field_ocn_export_', & +! timeslice=1, relaxedFlag=.true., rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out write(*,*) '----- MOM initialization phase Realize completed' @@ -1617,6 +1624,7 @@ subroutine ModelAdvance(gcomp, rc) call dumpMomInternal(mom_grid_i, export_slice, "sea_lev" , "will provide", Ocean_sfc%sea_lev) if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") + end subroutine ModelAdvance !> Called by NUOPC at the end of the run to clean up. @@ -1832,7 +1840,6 @@ subroutine writeSliceFields(state, filename_prefix, slice, rc) endif - end subroutine writeSliceFields !----------------------------------------------------------------------------- @@ -1975,10 +1982,86 @@ end subroutine MOM_RealizeFields subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_sfc) type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary type(ocean_public_type), intent(in) :: Ocean_sfc + +#ifdef CESMCOUPLED +! type (shr_nuopc_fldList_Type) :: fldsList +#endif + character(len=*),parameter :: subname='(mom_cap:MOM_FieldsSetup)' !!! fld_list_add(num, fldlist, stdname, transferOffer, data(optional), shortname(optional)) +#ifdef CESMCOUPLED + +! WARNING tcx tcraig +! tcraig this is just a starting point, the fields are not complete or correct here + + !-------------------------------- + ! create import fields list + !-------------------------------- + +! call shr_nuopc_fldList_Zero(fldsList, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + +! call shr_nuopc_fldList_fromflds(fldsList, flds_x2o, flds_x2o_map, "will provide", subname//":flds_x2o", rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + +! call shr_nuopc_fldList_Add(fldsList, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + ! convert to fldsToOcn + + !-------------------------------- + ! create export fields list + !-------------------------------- + +! call shr_nuopc_fldList_Zero(fldsList, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + +! call shr_nuopc_fldList_fromflds(fldsList, flds_o2x, flds_o2x_map, "will provide", subname//":flds_o2x", rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + +! call shr_nuopc_fldList_Add(fldsList, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + +! WARNING tcx tcraig +! tcraig this is just a starting point, the fields are not complete or correct here +! tcraig we will need to figure out whether to adjust the mediator coupling fields for mom or vv or a bit of both + + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide", data=Ice_ocean_boundary%u_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide", data=Ice_ocean_boundary%v_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide", data=Ice_ocean_boundary%t_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide", data=Ice_ocean_boundary%q_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_salt" , "will provide", data=Ice_ocean_boundary%salt_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwdn" , "will provide", data=Ice_ocean_boundary%lw_flux ) +! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dir) +! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dif) +! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swidr", "will provide", data=Ice_ocean_boundary%sw_flux_nir_dir) +! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swidf", "will provide", data=Ice_ocean_boundary%sw_flux_nir_dif) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rain" , "will provide", data=Ice_ocean_boundary%lprec ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_snow" , "will provide", data=Ice_ocean_boundary%fprec ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide", data=Ice_ocean_boundary%runoff ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_meltw", "will provide", data=Ice_ocean_boundary%calving) +! call fld_list_add(fldsToOcn_num, fldsToOcn, "runoff_heat_flux" , "will provide", data=Ice_ocean_boundary%runoff_hflx ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_melth", "will provide", data=Ice_ocean_boundary%calving_hflx) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide", data=Ice_ocean_boundary%p ) +! call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice", "will provide", data=Ice_ocean_boundary%mi) + +!--------- export fields ------------- + + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask", "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t", "will provide", data=Ocean_sfc%t_surf) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide", data=Ocean_sfc%s_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u", "will provide", data=Ocean_sfc%u_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v", "will provide", data=Ocean_sfc%v_surf ) +! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir", "will provide") +! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir", "will provide") +! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=Ocean_sfc%sea_lev) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide", data=Ocean_sfc%frazil) + + +#else !--------- import fields ------------- ! tcraig, don't point directly into mom data YET (last field is optional in interface) @@ -2014,6 +2097,8 @@ subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_sfc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=Ocean_sfc%sea_lev) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=Ocean_sfc%frazil) +#endif + end subroutine MOM_FieldsSetup !----------------------------------------------------------------------------- From ebccf60af7ed275dfbe17645fdb86e8fca067f47 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Sun, 4 Mar 2018 13:46:06 -0900 Subject: [PATCH 0004/1072] Resolving merge --- src/core/MOM_open_boundary.F90 | 59 +++++++++++++++++----------------- 1 file changed, 29 insertions(+), 30 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index dfc4dce29b..c9eee7cdda 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -18,7 +18,7 @@ module MOM_open_boundary use MOM_restart, only : register_restart_field, MOM_restart_CS use MOM_obsolete_params, only : obsolete_logical, obsolete_int, obsolete_real, obsolete_char use MOM_string_functions, only : extract_word, remove_spaces -use MOM_tracer_registry, only : tracer_registry_type +use MOM_tracer_registry, only : tracer_type, tracer_registry_type, tracer_name_lookup use MOM_variables, only : thermo_var_ptrs use time_interp_external_mod, only : init_external_field, time_interp_external use time_interp_external_mod, only : time_interp_external_init @@ -86,7 +86,7 @@ module MOM_open_boundary real, dimension(:,:,:), pointer :: t => NULL() !< tracer concentration array real :: OBC_inflow_conc = 0.0 !< tracer concentration for generic inflows character(len=32) :: name !< tracer name used for error messages - type(vardesc), pointer :: vd => NULL() !< metadata describing the tracer + type(tracer_type), pointer :: Tr => NULL() !< metadata describing the tracer real, dimension(:,:,:), pointer :: tres => NULL() !< tracer reservoir array logical :: is_initialized !< reservoir values have been set when True end type OBC_segment_tracer_type @@ -2441,21 +2441,22 @@ subroutine segment_tracer_registry_init(param_file, segment) end subroutine segment_tracer_registry_init -subroutine register_segment_tracer(tr_desc, param_file, GV, segment, tr_desc_ptr, & +subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, & OBC_scalar, OBC_array) - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(vardesc), intent(in) :: tr_desc !< metadata about the tracer - type(param_file_type), intent(in) :: param_file !< file to parse for model parameter values - type(OBC_segment_type), intent(inout) :: segment !< current segment data structure - type(vardesc), target, optional :: tr_desc_ptr !< A target that can be used to set a pointer to the - !! stored value of tr%tr_desc. This target must be - !! an enduring part of the control structure, - !! because the tracer registry will use this memory, - !! but it also means that any updates to this - !! structure in the calling module will be - !! available subsequently to the tracer registry. - real, optional :: OBC_scalar !< If present, use scalar value for segment tracer inflow concentration. - logical, optional :: OBC_array !< If true, use array values for segment tracer inflow concentration. + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(tracer_type), target :: tr_ptr !< A target that can be used to set a pointer to the + !! stored value of tr. This target must be + !! an enduring part of the control structure, + !! because the tracer registry will use this memory, + !! but it also means that any updates to this + !! structure in the calling module will be + !! available subsequently to the tracer registry. + type(param_file_type), intent(in) :: param_file !< file to parse for model parameter values + type(OBC_segment_type), intent(inout) :: segment !< current segment data structure + real, optional :: OBC_scalar !< If present, use scalar value for segment tracer + !! inflow concentration. + logical, optional :: OBC_array !< If true, use array values for segment tracer + !! inflow concentration. ! Local variables @@ -2464,7 +2465,6 @@ subroutine register_segment_tracer(tr_desc, param_file, GV, segment, tr_desc_ptr integer :: IsdB, IedB, JsdB, JedB character(len=256) :: mesg ! Message for error messages. -! if (.not. associated(segment%tr_Reg)) call segment_tracer_registry_init(param_file, segment) call segment_tracer_registry_init(param_file, segment) if (segment%tr_Reg%ntseg>=MAX_FIELDS_) then @@ -2480,13 +2480,8 @@ subroutine register_segment_tracer(tr_desc, param_file, GV, segment, tr_desc_ptr IsdB = segment%HI%IsdB ; IedB = segment%HI%IedB JsdB = segment%HI%JsdB ; JedB = segment%HI%JedB - if (present(tr_desc_ptr)) then - segment%tr_Reg%Tr(ntseg)%vd => tr_desc_ptr - else - allocate(segment%tr_Reg%Tr(ntseg)%vd) ; segment%tr_Reg%Tr(ntseg)%vd = tr_desc - endif - - call query_vardesc(segment%tr_Reg%Tr(ntseg)%vd, name=segment%tr_Reg%Tr(ntseg)%name) + segment%tr_Reg%Tr(ntseg)%Tr => tr_ptr + segment%tr_Reg%Tr(ntseg)%name = tr_ptr%name if (segment%tr_Reg%locked) call MOM_error(FATAL, & "MOM register_tracer was called for variable "//trim(segment%tr_Reg%Tr(ntseg)%name)//& @@ -2522,18 +2517,18 @@ subroutine segment_tracer_registry_end(Reg) endif end subroutine segment_tracer_registry_end -subroutine register_temp_salt_segments(GV, OBC, tv, vd_T, vd_S, param_file) +subroutine register_temp_salt_segments(GV, OBC, tr_Reg, param_file) type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(ocean_OBC_type), pointer :: OBC !< Open boundary structure - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - type(vardesc), intent(in) :: vd_T !< Temperature descriptor - type(vardesc), intent(in) :: vd_S !< Salinity descriptor + type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry type(param_file_type), intent(in) :: param_file !< file to parse for model parameter values ! Local variables integer :: isd, ied, IsdB, IedB, jsd, jed, JsdB, JedB, nz, nf integer :: i, j, k, n + character(len=32) :: name type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list + type(tracer_type), pointer :: tr_ptr if (.not. associated(OBC)) return @@ -2544,9 +2539,13 @@ subroutine register_temp_salt_segments(GV, OBC, tv, vd_T, vd_S, param_file) if (associated(segment%tr_Reg)) & call MOM_error(FATAL,"register_temp_salt_segments: tracer array was previously allocated") - call register_segment_tracer(vd_T, param_file, GV, segment, & + name = 'Heat' + call tracer_name_lookup(tr_Reg, tr_ptr, name) + call register_segment_tracer(tr_ptr, param_file, GV, segment, & OBC_array=segment%temp_segment_data_exists) - call register_segment_tracer(vd_S, param_file, GV, segment, & + name = 'Salt' + call tracer_name_lookup(tr_Reg, tr_ptr, name) + call register_segment_tracer(tr_ptr, param_file, GV, segment, & OBC_array=segment%salt_segment_data_exists) enddo From 71ff26ba73f886348240027fb0843854fa887a8e Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 9 Mar 2018 10:18:56 -0700 Subject: [PATCH 0005/1072] Changed multi-word names from camelCase to snake_case --- src/parameterizations/vertical/MOM_cvmix_shear.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/vertical/MOM_cvmix_shear.F90 b/src/parameterizations/vertical/MOM_cvmix_shear.F90 index 460dde7c47..7704069d78 100644 --- a/src/parameterizations/vertical/MOM_cvmix_shear.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_shear.F90 @@ -25,10 +25,10 @@ module MOM_cvmix_shear #include -public Calculate_cvmix_shear, cvmix_shear_init, cvmix_shear_is_used +public calculate_cvmix_shear, cvmix_shear_init, cvmix_shear_is_used !> Control structure including parameters for CVMix interior shear schemes. -type, public :: CVMix_shear_CS +type, public :: cvmix_shear_cs logical :: use_LMD94, use_PP81 !< Flags for various schemes real :: Ri_zero !< LMD94 critical Richardson number real :: Nu_zero !< LMD94 maximum interior diffusivity @@ -36,14 +36,14 @@ module MOM_cvmix_shear real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency (1/s2) real, allocatable, dimension(:,:,:) :: S2 !< Squared shear frequency (1/s2) character(10) :: Mix_Scheme !< Mixing scheme name (string) -end type CVMix_shear_CS +end type cvmix_shear_cs character(len=40) :: mdl = "MOM_CVMix_shear" !< This module's name. contains !> Subroutine for calculating (internal) diffusivity -subroutine Calculate_cvmix_shear(u_H, v_H, h, tv, KH, & +subroutine calculate_cvmix_shear(u_H, v_H, h, tv, KH, & KM, G, GV, CS ) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. @@ -55,7 +55,7 @@ subroutine Calculate_cvmix_shear(u_H, v_H, h, tv, KH, & !! (not layer!) in m2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: KM !< The vertical viscosity at each interface !! (not layer!) in m2 s-1. - type(CVMix_shear_CS), pointer :: CS !< The control structure returned by a previous call to + type(cvmix_shear_cs), pointer :: CS !< The control structure returned by a previous call to !! CVMix_shear_init. ! Local variables integer :: i, j, k, kk, km1 @@ -120,7 +120,7 @@ subroutine Calculate_cvmix_shear(u_H, v_H, h, tv, KH, & enddo enddo -end subroutine Calculate_cvmix_shear +end subroutine calculate_cvmix_shear !> Initialized the cvmix internal shear mixing routine. @@ -133,7 +133,7 @@ logical function cvmix_shear_init(Time, G, GV, param_file, diag, CS) type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. - type(CVMix_shear_CS), pointer :: CS !< This module's control structure. + type(cvmix_shear_cs), pointer :: CS !< This module's control structure. ! Local variables integer :: NumberTrue=0 logical :: use_JHL From d30900b261966137cd2f4e6bf73208ae1228ddde Mon Sep 17 00:00:00 2001 From: apcraig Date: Fri, 9 Mar 2018 17:20:16 -0700 Subject: [PATCH 0006/1072] update mom6 nuopc cap --- .../coupled_driver/MOM_surface_forcing.F90 | 53 + config_src/coupled_driver/ocean_model_MOM.F90 | 4 +- config_src/nuopc_driver/mom_cap.F90 | 622 +++-- config_src/nuopc_driver/mom_cap.F90.00 | 2245 +++++++++++++++ config_src/nuopc_driver/mom_cap.F90.02 | 2432 +++++++++++++++++ config_src/nuopc_driver/mom_cap_methods.F90 | 500 ++++ config_src/nuopc_driver/ocn_comp_nuopc.F90.01 | 0 config_src/nuopc_driver/ocn_comp_nuopc.F90.02 | 2218 +++++++++++++++ 8 files changed, 7858 insertions(+), 216 deletions(-) create mode 100644 config_src/nuopc_driver/mom_cap.F90.00 create mode 100644 config_src/nuopc_driver/mom_cap.F90.02 create mode 100644 config_src/nuopc_driver/mom_cap_methods.F90 create mode 100644 config_src/nuopc_driver/ocn_comp_nuopc.F90.01 create mode 100644 config_src/nuopc_driver/ocn_comp_nuopc.F90.02 diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index a9fcd00844..13eb003e1d 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -44,6 +44,7 @@ module MOM_surface_forcing #include +public IOB_allocate public convert_IOB_to_fluxes public surface_forcing_init public ice_ocn_bnd_type_chksum @@ -188,6 +189,58 @@ module MOM_surface_forcing contains +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% u_flux (isc:iec,jsc:jec), & + IOB% v_flux (isc:iec,jsc:jec), & + IOB% t_flux (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% runoff (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%u_flux = 0.0 + IOB%v_flux = 0.0 + IOB%t_flux = 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%runoff = 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 + + subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, & sfc_state, restore_salt, restore_temp) type(ice_ocean_boundary_type), & diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index a020db3af9..21269cb551 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -1184,7 +1184,7 @@ 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,'get_ocean_grid_data2D: unknown argument name='//name) + call MOM_error(FATAL,'ocean_model_data2D_get: unknown argument name='//name) end select @@ -1203,7 +1203,7 @@ subroutine ocean_model_data1D_get(OS,Ocean, name, value) case('c_p') value = OS%C_p case default - call MOM_error(FATAL,'get_ocean_grid_data1D: unknown argument name='//name) + call MOM_error(FATAL,'ocean_model_data1D_get: unknown argument name='//name) end select diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 56c4b5cd35..6b8d2f5795 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -139,7 +139,7 @@ !! infrastructure when it's time for MOM to advance in time. During this subroutine, there is a !! call into the MOM update routine: !! -!! call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_sfc, Time, Time_step_coupled) +!! call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_public, Time, Time_step_coupled) !! !! Prior to this call, the cap performs a few steps: !! - the `Time` and `Time_step_coupled` parameters, which are based on FMS types, are derived from the incoming ESMF clock @@ -166,8 +166,8 @@ !! from the native MOM grid by a call to `get_ocean_grid(Ocean_grid)`. !! The cosine and sine of the rotation angle are: !! -!! Ocean_grid%cos_rot(i,j) -!! Ocean_grid%sin_rot(i,j) +!! ocean_grid%cos_rot(i,j) +!! ocean_grid%sin_rot(i,j) !! !! The rotation of momentum flux from regular lat-lon to tripolar is: !! \f[ @@ -206,7 +206,7 @@ !! at the end of the run. This subroutine is a hook to call into MOM's native shutdown !! procedures: !! -!! call ocean_model_end (Ocean_sfc, Ocean_State, Time) +!! call ocean_model_end (ocean_public, ocean_State, Time) !! call diag_manager_end(Time ) !! call field_manager_end !! call fms_io_exit @@ -242,7 +242,7 @@ !! !! @subsection ExportField Export Fields !! -!! Export fields are populated from the `ocean_sfc` parameter (type `ocean_public_type`) +!! Export fields are populated from the `ocean_public` parameter (type `ocean_public_type`) !! after the call to `update_ocean_model()`. !! !! Standard Name | Units | Model Variable | Description | Notes @@ -377,16 +377,37 @@ module mom_cap_mod use time_manager_mod, only: operator( * ), operator( /= ), operator( > ) use time_manager_mod, only: date_to_string use time_manager_mod, only: fms_get_calendar_type => get_calendar_type - + use MOM_domains, only: MOM_infra_init, num_pes, root_pe, pe_here + +!#ifdef CESMCOUPLED +! use ocn_comp_nuopc, only: ocean_public_type, ocean_state_type +! use ocn_comp_nuopc, only: update_ocean_model, ocean_model_init +! use ocn_comp_nuopc, only: ocn_export, get_ocean_grid, ocean_model_data_get +! use ocn_comp_nuopc, only: ocean_model_end, ocean_model_init_sfc +!#else use ocean_model_mod, only: ocean_model_restart, ocean_public_type, ocean_state_type use ocean_model_mod, only: ocean_model_data_get use ocean_model_mod, only: ocean_model_init , update_ocean_model, ocean_model_end, get_ocean_grid + use MOM_surface_forcing, only: IOB_allocate +!#endif + use MOM_file_parser, only: get_param, log_version, param_file_type, close_param_file + use MOM_get_input, only: Get_MOM_Input, directories + use MOM_domains, only: pass_var #ifdef MOM6_CAP use ocean_model_mod, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type #else use ocean_types_mod, only: ice_ocean_boundary_type, ocean_grid_type #endif +#ifdef CESMCOUPLED + use mom_cap_methods, only: ocn_export, ocn_import + use shr_nuopc_flds_mod, only: flds_scalar_name + use shr_nuopc_flds_mod, only: flds_x2o, flds_o2x, flds_x2o_map, flds_o2x_map + use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_SetScalarField, shr_nuopc_fldList_type + use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Advertise, shr_nuopc_fldList_Realize + use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Zero, shr_nuopc_fldList_Add + use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_fromflds +#endif use ESMF use NUOPC @@ -405,13 +426,16 @@ module mom_cap_mod type(ocean_public_type), pointer :: ocean_public_type_ptr type(ocean_state_type), pointer :: ocean_state_type_ptr type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr - type(ocean_grid_type), pointer :: ocean_grid_ptr end type type ocean_internalstate_wrapper type(ocean_internalstate_type), pointer :: ptr end type +#ifdef CESMCOUPLED + type (shr_nuopc_fldList_Type) :: fldsToOcn + type (shr_nuopc_fldList_Type) :: fldsFrOcn +#else type fld_list_type character(len=64) :: stdname character(len=64) :: shortname @@ -425,18 +449,22 @@ module mom_cap_mod type (fld_list_type) :: fldsToOcn(fldsMax) integer :: fldsFrOcn_num = 0 type (fld_list_type) :: fldsFrOcn(fldsMax) +#endif integer :: import_slice = 1 integer :: export_slice = 1 character(len=256) :: tmpstr integer :: dbrc - type(ESMF_Grid), save :: mom_grid_i + type(ESMF_Grid) :: mom_grid_i logical :: write_diagnostics = .true. logical :: profile_memory = .true. logical :: ocean_solo = .true. logical :: grid_attach_area = .false. integer(ESMF_KIND_I8) :: restart_interval + logical :: sw_decomp + real(ESMF_KIND_R8) :: c1, c2, c3, c4 + character(len=*),parameter :: u_file_u = __FILE__ contains !----------------------------------------------------------------------- @@ -533,7 +561,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - call ESMF_AttributeGet(gcomp, name="DumpFields", value=value, defaultValue="true", & + call ESMF_AttributeGet(gcomp, name="DumpFields", value=value, defaultValue="false", & convention="NUOPC", purpose="Instance", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -617,10 +645,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) type(ESMF_Time) :: MyTime type(ESMF_TimeInterval) :: TINT - type (ocean_public_type), pointer :: Ocean_sfc => NULL() - type (ocean_state_type), pointer :: Ocean_state => NULL() + type (ocean_public_type), pointer :: ocean_public => NULL() + type (ocean_state_type), pointer :: ocean_state => NULL() type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() type(ocean_internalstate_wrapper) :: ocean_internalstate + type(ocean_grid_type), pointer :: ocean_grid => NULL() type(time_type) :: Run_len ! length of experiment type(time_type) :: Time @@ -631,22 +660,25 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: dt_cpld = 86400 integer :: year=0, month=0, day=0, hour=0, minute=0, second=0 integer :: mpi_comm_mom + integer :: npes, pe0, i type(ESMF_Grid) :: gridIn type(ESMF_Grid) :: gridOut - + type(param_file_type) :: param_file !< A structure to parse for run-time parameters + type(directories) :: dirs_tmp !< A structure containing several relevant directory paths + character(len=384) :: pointer_filename integer :: npet, npet_x, npet_y character(len=*),parameter :: subname='(mom_cap:InitializeAdvertise)' rc = ESMF_SUCCESS allocate(Ice_ocean_boundary) - !allocate(Ocean_state) ! ocean_model_init allocate this pointer - allocate(Ocean_sfc) + !allocate(ocean_state) ! ocean_model_init allocate this pointer + allocate(ocean_public) allocate(ocean_internalstate%ptr) ocean_internalstate%ptr%ice_ocean_boundary_type_ptr => Ice_ocean_boundary - ocean_internalstate%ptr%ocean_public_type_ptr => Ocean_sfc - ocean_internalstate%ptr%ocean_state_type_ptr => Ocean_state + ocean_internalstate%ptr%ocean_public_type_ptr => ocean_public + ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state call ESMF_VMGetCurrent(vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -669,7 +701,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_TimeGet (MyTime, & YY=YEAR, MM=MONTH, DD=DAY, & H=HOUR, M =MINUTE, S =SECOND, & - RC=rc ) + RC=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -681,6 +713,89 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out +#ifdef XXCESMCOUPLEDXX + + ! Initialize MOM6 comm + call MOM_infra_init(mpi_comm_mom) + call set_calendar_type(NOLEAP) !TODO: confirm this + Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) + +! tcx, todo, first coupling period +! ! Compute time_in: time at the beginning of the first ocn coupling interval +! call ESMF_ClockGet(EClock, TimeStep=ocn_cpl_interval, rc=rc) +! if (runtype /= "continue") then +! ! In startup runs, take the one ocn coupling interval lag into account to +! ! compute the initial ocn time. (time_in = time_init + ocn_cpl_interval) +! time_in_ESMF = ESMF_TimeInc(current_time, ocn_cpl_interval) +! else +! time_in_ESMF = current_time +! endif +! call ESMF_TimeGet(time_in_ESMF, yy=year, mm=month, dd=day, h=hour, m=minute, s=seconds, rc=rc) +! time_in = set_date(year, month, day, hour, minute, seconds, err_msg=err_msg) + +! tcx, todo, restart +! if (runtype == "initial") then ! startup (new run) - 'n' is needed below since we don't +! ! specify input_filename in input.nml + call ocean_model_init(ocean_public, ocean_state, time, time, input_restart_file = 'n') +! else ! hybrid or branch or continuos runs +! ! output path root +! call seq_infodata_GetData( glb%infodata, outPathRoot=restartpath ) +! ! read name of restart file in the pointer file +! nu = shr_file_getUnit() +! restart_pointer_file = trim(glb%pointer_filename) +! if (is_root_pe()) write(glb%stdout,*) 'Reading ocn pointer file: ',restart_pointer_file +! open(nu, file=restart_pointer_file, form='formatted', status='unknown') +! read(nu,'(a)') restartfile +! close(nu) +! !restartfile = trim(restartpath) // trim(restartfile) +! if (is_root_pe()) write(glb%stdout,*) 'Reading restart file: ',trim(restartfile) +! !endif +! call shr_file_freeUnit(nu) +! call ocean_model_init(glb%ocean_public, glb%ocn_state, time_init, time_in, input_restart_file=trim(restartfile)) +! endif + + npes = num_pes() + pe0 = root_pe() + + ocean_public%is_ocean_pe = .true. + allocate(ocean_public%pelist(npes)) + ocean_public%pelist(:) = (/(i,i=pe0,pe0+npes)/) + + ! This include declares and sets the variable "version". + ! read useful runtime params + call get_MOM_Input(param_file, dirs_tmp, check_params=.false.) + !call log_version(param_file, subname, version, "") + call get_param(param_file, subname, "POINTER_FILENAME", pointer_filename, & + "Name of the ascii file that contains the path and filename of" // & + " the latest restart file.", default='rpointer.ocn') + call get_param(param_file, subname, "SW_DECOMP", sw_decomp, & + "If True, read coeffs c1, c2, c3 and c4 and decompose" // & + "the net shortwave radiation (SW) into four components:\n" // & + "visible, direct shortwave = c1 * SW \n" // & + "visible, diffuse shortwave = c2 * SW \n" // & + "near-IR, direct shortwave = c3 * SW \n" // & + "near-IR, diffuse shortwave = c4 * SW", default=.true.) + if (sw_decomp) then + call get_param(param_file, subname, "SW_c1", c1, & + "Coeff. used to convert net shortwave rad. into \n"//& + "visible, direct shortwave.", units="nondim", default=0.285) + call get_param(param_file, subname, "SW_c2", c2, & + "Coeff. used to convert net shortwave rad. into \n"//& + "visible, diffuse shortwave.", units="nondim", default=0.285) + call get_param(param_file, subname, "SW_c3", c3, & + "Coeff. used to convert net shortwave rad. into \n"//& + "near-IR, direct shortwave.", units="nondim", default=0.215) + call get_param(param_file, subname, "SW_c4", c4, & + "Coeff. used to convert net shortwave rad. into \n"//& + "near-IR, diffuse shortwave.", units="nondim", default=0.215) + else + c1 = 0.0; c2 = 0.0; c3 = 0.0; c4 = 0.0 + endif + + ! Initialize ocn_state%state out of sight + call ocean_model_init_sfc(ocean_state, ocean_public) + +#else call fms_init(mpi_comm_mom) call constants_init call field_manager_init @@ -691,16 +806,18 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) DT = set_time (DT_OCEAN, 0) Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) - Ocean_sfc%is_ocean_pe = .true. - call ocean_model_init(Ocean_sfc, Ocean_state, Time, Time) + ocean_public%is_ocean_pe = .true. + call ocean_model_init(ocean_public, ocean_state, Time, Time) !tcx tcraig This results in errors in CESM with help from Alper ! FATAL error "MPP_OPEN: error in OPEN for data_table" ! The subroutine data_override_init shouldn't be called because ALLOW_FLUX_ADJUSTMENTS is set to FALSE -!tcx call data_override_init(Ocean_domain_in = Ocean_sfc%domain) +!tcx call data_override_init(ocean_domain_in = ocean_public%domain) - call mpp_get_compute_domain(Ocean_sfc%domain, isc, iec, jsc, jec) + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + call IOB_allocate(ice_ocean_boundary, isc, iec, jsc, jec) +#if (1 == 0) allocate ( Ice_ocean_boundary% u_flux (isc:iec,jsc:jec), & Ice_ocean_boundary% v_flux (isc:iec,jsc:jec), & Ice_ocean_boundary% t_flux (isc:iec,jsc:jec), & @@ -738,18 +855,28 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) Ice_ocean_boundary%calving_hflx = 0.0 Ice_ocean_boundary%mi = 0.0 Ice_ocean_boundary%p = 0.0 +#endif + +#endif - call external_coupler_sbc_init(Ocean_sfc%domain, dt_cpld, Run_len) + call external_coupler_sbc_init(ocean_public%domain, dt_cpld, Run_len) - ocean_internalstate%ptr%ocean_state_type_ptr => Ocean_state + ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call MOM_FieldsSetup(ice_ocean_boundary, ocean_sfc) + call MOM_FieldsSetup(ice_ocean_boundary, ocean_public) +#ifdef CESMCOUPLED + call shr_nuopc_fldList_Advertise(importState, fldsToOcn, subname//':MOM6Import', rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call shr_nuopc_fldList_Advertise(exportState, fldsFrOcn, subname//':MOM6Export', rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return +#else call MOM_AdvertiseFields(importState, fldsToOcn_num, fldsToOcn, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -760,8 +887,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out +#endif -#ifdef MOM6_CAP +!#ifdef MOM6_CAP ! When running mom6 solo, the rotation angles are not computed internally ! in MOM6. We need to ! calculate cos and sin of rotational angle for MOM6; the values @@ -769,9 +897,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! The rotation angles are retrieved during run time to rotate incoming ! and outgoing vectors ! - call calculate_rot_angle(Ocean_state, ocean_sfc, & - ocean_internalstate%ptr%ocean_grid_ptr) -#endif +! call calculate_rot_angle(ocean_state, ocean_public) +!#endif +! tcraig, this is handled fine internally and if not, then later call this +! call initialize_grid_rotation_angle(ocean_grid, PF) write(*,*) '----- MOM initialization phase Advertise completed' @@ -801,8 +930,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) type(ESMF_DeLayout) :: delayout type(ESMF_Distgrid) :: Distgrid type(ESMF_DistGridConnection), allocatable :: connectionList(:) - type (ocean_public_type), pointer :: Ocean_sfc => NULL() - type (ocean_state_type), pointer :: Ocean_state => NULL() + type (ocean_public_type), pointer :: ocean_public => NULL() + type (ocean_state_type), pointer :: ocean_state => NULL() type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() type(ocean_internalstate_wrapper) :: ocean_internalstate integer :: npet, ntiles @@ -838,8 +967,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) return ! bail out Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr - Ocean_sfc => ocean_internalstate%ptr%ocean_public_type_ptr - Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr call ESMF_VMGetCurrent(vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -857,7 +986,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! global mom grid size !--------------------------------- - call mpp_get_global_domain(Ocean_sfc%domain, xsize=nxg, ysize=nyg) + call mpp_get_global_domain(ocean_public%domain, xsize=nxg, ysize=nyg) write(tmpstr,'(a,2i6)') subname//' nxg,nyg = ',nxg,nyg call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) @@ -865,7 +994,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total !--------------------------------- - ntiles=mpp_get_ntile_count(Ocean_sfc%domain) ! this is tiles on this pe + ntiles=mpp_get_ntile_count(ocean_public%domain) ! this is tiles on this pe if (ntiles /= 1) then rc = ESMF_FAILURE call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR, rc=dbrc) @@ -874,7 +1003,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out endif - ntiles=mpp_get_domain_npes(Ocean_sfc%domain) + ntiles=mpp_get_domain_npes(ocean_public%domain) write(tmpstr,'(a,1i6)') subname//' ntiles = ',ntiles call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) @@ -883,8 +1012,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !--------------------------------- allocate(xb(ntiles),xe(ntiles),yb(ntiles),ye(ntiles),pe(ntiles)) - call mpp_get_compute_domains(Ocean_sfc%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye) - call mpp_get_pelist(Ocean_sfc%domain, pe) + call mpp_get_compute_domains(ocean_public%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye) + call mpp_get_pelist(ocean_public%domain, pe) do n = 1,ntiles write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) @@ -1069,7 +1198,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! for esmf and also need to "make up" j=1 values. use wraparound in i !--------------------------------- - call mpp_get_compute_domain(Ocean_sfc%domain, isc, iec, jsc, jec) + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) lbnd1 = lbound(dataPtr_mask,1) ubnd1 = ubound(dataPtr_mask,1) @@ -1101,10 +1230,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) allocate(ofld(isc:iec,jsc:jec)) allocate(gfld(nxg,nyg)) - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'mask', ofld, isc, jsc) + call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) write(tmpstr,*) subname//' ofld mask = ',minval(ofld),maxval(ofld) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld mask = ',minval(gfld),maxval(gfld) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) do j = lbnd2, ubnd2 @@ -1116,10 +1245,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) enddo if(grid_attach_area) then - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'area', ofld, isc, jsc) + call ocean_model_data_get(ocean_state, ocean_public, 'area', ofld, isc, jsc) write(tmpstr,*) subname//' ofld area = ',minval(ofld),maxval(ofld) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld area = ',minval(gfld),maxval(gfld) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) do j = lbnd2, ubnd2 @@ -1131,10 +1260,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) enddo endif - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'tlon', ofld, isc, jsc) + call ocean_model_data_get(ocean_state, ocean_public, 'tlon', ofld, isc, jsc) write(tmpstr,*) subname//' ofld xt = ',minval(ofld),maxval(ofld) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld xt = ',minval(gfld),maxval(gfld) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) do j = lbnd2, ubnd2 @@ -1146,10 +1275,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) enddo enddo - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'tlat', ofld, isc, jsc) + call ocean_model_data_get(ocean_state, ocean_public, 'tlat', ofld, isc, jsc) write(tmpstr,*) subname//' ofld yt = ',minval(ofld),maxval(ofld) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld yt = ',minval(gfld),maxval(gfld) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) do j = lbnd2, ubnd2 @@ -1161,15 +1290,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) enddo #ifdef MOM5_CAP - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'ulon', ofld, isc, jsc) + call ocean_model_data_get(ocean_state, ocean_public, 'ulon', ofld, isc, jsc) #endif #ifdef MOM6_CAP - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'geoLonBu', ofld, isc, jsc) + call ocean_model_data_get(ocean_state, ocean_public, 'geoLonBu', ofld, isc, jsc) #endif write(tmpstr,*) subname//' ofld xu = ',minval(ofld),maxval(ofld) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld xu = ',minval(gfld),maxval(gfld) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) do j = lbnd4, ubnd4 @@ -1198,16 +1327,16 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! The corner latitude values are treated differently because MOM5 runs on B-Grid while ! MOM6 runs on C-Grid. #ifdef MOM5_CAP - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'ulat', ofld, isc, jsc) + call ocean_model_data_get(ocean_state, ocean_public, 'ulat', ofld, isc, jsc) #endif #ifdef MOM6_CAP - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'geoLatBu', ofld, isc, jsc) + call ocean_model_data_get(ocean_state, ocean_public, 'geoLatBu', ofld, isc, jsc) #endif write(tmpstr,*) subname//' ofld yu = ',minval(ofld),maxval(ofld) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld yu = ',minval(gfld),maxval(gfld) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) do j = lbnd4, ubnd4 @@ -1258,6 +1387,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! realize fields on grid !--------------------------------- +#ifdef CESMCOUPLED + call shr_nuopc_fldList_Realize(importState, grid=gridIn, fldlist=fldsToOcn, tag=subname//':MOM6Import', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call shr_nuopc_fldList_Realize(exportState, grid=gridOut, fldlist=fldsFrOcn, tag=subname//':MOM6Export', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return +#else call MOM_RealizeFields(importState, gridIn , fldsToOcn_num, fldsToOcn, "Ocn import", rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1268,6 +1404,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out +#endif call ESMF_StateGet(exportState, itemSearch="sea_surface_temperature", itemCount=icount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1288,7 +1425,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'mask', ofld, isc, jsc) + call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) lbnd1 = lbound(t_surf,1) ubnd1 = ubound(t_surf,1) @@ -1336,8 +1473,8 @@ subroutine ModelAdvance(gcomp, rc) integer(ESMF_KIND_I8) :: n_interval, time_elapsed_sec character(len=64) :: timestamp - type (ocean_public_type), pointer :: Ocean_sfc => NULL() - type (ocean_state_type), pointer :: Ocean_state => NULL() + type (ocean_public_type), pointer :: ocean_public => NULL() + type (ocean_state_type), pointer :: ocean_state => NULL() type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() type(ocean_internalstate_wrapper) :: ocean_internalstate @@ -1349,9 +1486,13 @@ subroutine ModelAdvance(gcomp, rc) integer :: dth, dtm, dts, dt_cpld = 86400 integer :: isc,iec,jsc,jec,lbnd1,ubnd1,lbnd2,ubnd2 integer :: i,j,i1,j1 + integer :: nc +#ifdef CESMCOUPLED + ! in ocn_import, ocn_export + +#else real(ESMF_KIND_R8), allocatable :: ofld(:,:), ocz(:,:), ocm(:,:) real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) - integer :: nc real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_mmmf(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_mzmf(:,:) @@ -1360,7 +1501,8 @@ subroutine ModelAdvance(gcomp, rc) real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) - type(ocean_grid_type), pointer :: Ocean_grid +#endif + type(ocean_grid_type), pointer :: ocean_grid character(240) :: msgString character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' @@ -1382,8 +1524,8 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr - Ocean_sfc => ocean_internalstate%ptr%ocean_public_type_ptr - Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep @@ -1431,7 +1573,7 @@ subroutine ModelAdvance(gcomp, rc) call ice_ocn_bnd_from_data(Ice_ocean_boundary, Time, Time_step_coupled) - call external_coupler_sbc_before(Ice_ocean_boundary, Ocean_sfc, nc, dt_cpld ) + call external_coupler_sbc_before(Ice_ocean_boundary, ocean_public, nc, dt_cpld ) if(write_diagnostics) then call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', & @@ -1445,9 +1587,20 @@ subroutine ModelAdvance(gcomp, rc) ! rotate the lat/lon wind vector (CW) onto local tripolar coordinate system - call mpp_get_compute_domain(Ocean_sfc%domain, isc, iec, jsc, jec) + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) if(.not. ocean_solo) then + +!#ifdef MOM5_CAP + call get_ocean_grid(ocean_state, ocean_grid) +!#endif +!#ifdef MOM6_CAP +! ocean_grid => ocean_internalstate%ptr%ocean_grid_ptr +!#endif + +#ifdef CESMCOUPLED + call ocn_import(ocean_public, ocean_grid, importState, ice_ocean_boundary) +#else call State_getFldPtr(exportState,'ocean_mask',dataPtr_mask,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1459,13 +1612,6 @@ subroutine ModelAdvance(gcomp, rc) lbnd2 = lbound(dataPtr_mask,2) ubnd2 = ubound(dataPtr_mask,2) -#ifdef MOM5_CAP - call get_ocean_grid(Ocean_grid) -#endif -#ifdef MOM6_CAP - Ocean_grid => ocean_internalstate%ptr%ocean_grid_ptr -#endif - call State_getFldPtr(importState,'mean_zonal_moment_flx',dataPtr_mzmf,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1496,17 +1642,21 @@ subroutine ModelAdvance(gcomp, rc) do i = lbnd1, ubnd1 j1 = j - lbnd2 + jsc ! work around local vs global indexing i1 = i - lbnd1 + isc - mzmf(i,j) = Ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - + Ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) - mmmf(i,j) = Ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - - Ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) + mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & + + ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) + mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & + - ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) enddo enddo dataPtr_mzmf = mzmf dataPtr_mmmf = mmmf deallocate(mzmf, mmmf) +#endif endif ! not ocean_solo +#ifdef XXCESMCOUPLEDXX + ! tcx todo +#else !Optionally write restart files when currTime-startTime is integer multiples of restart_interval if(restart_interval > 0 ) then time_elapsed = currTime - startTime @@ -1521,18 +1671,82 @@ subroutine ModelAdvance(gcomp, rc) timestamp = date_to_string(time_restart_current) call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=dbrc) write(*,*) 'calling ocean_model_restart' - call ocean_model_restart(Ocean_state, timestamp) + call ocean_model_restart(ocean_state, timestamp) endif endif +#endif if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") - call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_sfc, Time, Time_step_coupled) +#ifdef XXCESMCOUPLEDXX + call update_ocean_model(ImportState, ocean_state, ocean_public, Time, Time_step_coupled, & + sw_decomp, c1, c2, c3, c4) +#else + call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled) +#endif if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") if(.not. ocean_solo) then + +!#ifdef MOM5_CAP + call get_ocean_grid(ocean_state, ocean_grid) +!#endif +!#ifdef MOM6_CAP +! ocean_grid => ocean_internalstate%ptr%ocean_grid_ptr +!#endif + +#ifdef CESMCOUPLED + call ocn_export(ocean_public, ocean_grid, exportState) +#else allocate(ofld(isc:iec,jsc:jec)) - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'mask', ofld, isc, jsc) + call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_mask(i,j) = nint(ofld(i1,j1)) + enddo + enddo + deallocate(ofld) + + ! Now rotate ocn current from tripolar grid back to lat/lon grid (CCW) + allocate(ocz(lbnd1:ubnd1,lbnd2:ubnd2)) + allocate(ocm(lbnd1:ubnd1,lbnd2:ubnd2)) + + call State_getFldPtr(exportState,'ocn_current_zonal',dataPtr_ocz,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'ocn_current_merid',dataPtr_ocm,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling + + ocz = dataPtr_ocz + ocm = dataPtr_ocm + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc ! work around local vs global indexing + i1 = i - lbnd1 + isc + dataPtr_ocz(i,j) = ocean_grid%cos_rot(i1,j1)*ocz(i,j) & + - ocean_grid%sin_rot(i1,j1)*ocm(i,j) + dataPtr_ocm(i,j) = ocean_grid%cos_rot(i1,j1)*ocm(i,j) & + + ocean_grid%sin_rot(i1,j1)*ocz(i,j) + enddo + enddo + deallocate(ocz, ocm) + endif ! not ocean_solo + + call ESMF_LogWrite("Before writing diagnostics", dataPtr_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 j1 = j - lbnd2 + jsc @@ -1570,16 +1784,16 @@ subroutine ModelAdvance(gcomp, rc) do i = lbnd1, ubnd1 j1 = j - lbnd2 + jsc ! work around local vs global indexing i1 = i - lbnd1 + isc - dataPtr_ocz(i,j) = Ocean_grid%cos_rot(i1,j1)*ocz(i,j) & - - Ocean_grid%sin_rot(i1,j1)*ocm(i,j) - dataPtr_ocm(i,j) = Ocean_grid%cos_rot(i1,j1)*ocm(i,j) & - + Ocean_grid%sin_rot(i1,j1)*ocz(i,j) + dataPtr_ocz(i,j) = ocean_grid%cos_rot(i1,j1)*ocz(i,j) & + - ocean_grid%sin_rot(i1,j1)*ocm(i,j) + dataPtr_ocm(i,j) = ocean_grid%cos_rot(i1,j1)*ocm(i,j) & + + ocean_grid%sin_rot(i1,j1)*ocz(i,j) enddo enddo deallocate(ocz, ocm) endif ! not ocean_solo - call ESMF_LogWrite("Before writing diagnostics", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(, rc=rc) if(write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & timeslice=export_slice, relaxedFlag=.true., rc=rc) @@ -1588,10 +1802,11 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out export_slice = export_slice + 1 - endif +#endif + endif ! not ocean solo call ESMF_LogWrite("Before calling sbc forcing", ESMF_LOGMSG_INFO, rc=rc) - call external_coupler_sbc_after(Ice_ocean_boundary, Ocean_sfc, nc, dt_cpld ) + call external_coupler_sbc_after(Ice_ocean_boundary, ocean_public, nc, dt_cpld ) call ESMF_LogWrite("Before dumpMomInternal", ESMF_LOGMSG_INFO, rc=rc) !write(*,*) 'MOM: --- run phase called ---' @@ -1616,12 +1831,12 @@ subroutine ModelAdvance(gcomp, rc) !--------- export fields ------------- - call dumpMomInternal(mom_grid_i, export_slice, "ocean_mask", "will provide", dataPtr_mask) - call dumpMomInternal(mom_grid_i, export_slice, "sea_surface_temperature", "will provide", Ocean_sfc%t_surf) - call dumpMomInternal(mom_grid_i, export_slice, "s_surf" , "will provide", Ocean_sfc%s_surf ) - call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_zonal", "will provide", Ocean_sfc%u_surf ) - call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_merid", "will provide", Ocean_sfc%v_surf ) - call dumpMomInternal(mom_grid_i, export_slice, "sea_lev" , "will provide", Ocean_sfc%sea_lev) +! call dumpMomInternal(mom_grid_i, export_slice, "ocean_mask", "will provide", dataPtr_mask) + call dumpMomInternal(mom_grid_i, export_slice, "sea_surface_temperature", "will provide", ocean_public%t_surf) + call dumpMomInternal(mom_grid_i, export_slice, "s_surf" , "will provide", ocean_public%s_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_zonal", "will provide", ocean_public%u_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_merid", "will provide", ocean_public%v_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "sea_lev" , "will provide", ocean_public%sea_lev) if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") @@ -1638,8 +1853,8 @@ subroutine ocean_model_finalize(gcomp, rc) integer, intent(out) :: rc ! local variables - type (ocean_public_type), pointer :: Ocean_sfc - type (ocean_state_type), pointer :: Ocean_state + type (ocean_public_type), pointer :: ocean_public + type (ocean_state_type), pointer :: ocean_state type(ocean_internalstate_wrapper) :: ocean_internalstate type(TIME_TYPE) :: Time type(ESMF_Clock) :: clock @@ -1656,8 +1871,8 @@ subroutine ocean_model_finalize(gcomp, rc) file=__FILE__)) & return ! bail out - Ocean_sfc => ocean_internalstate%ptr%ocean_public_type_ptr - Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1672,7 +1887,7 @@ subroutine ocean_model_finalize(gcomp, rc) return ! bail out Time = esmf2fms_time(currTime) - call ocean_model_end (Ocean_sfc, Ocean_State, Time) + call ocean_model_end (ocean_public, ocean_State, Time) call diag_manager_end(Time ) call field_manager_end @@ -1745,18 +1960,18 @@ subroutine external_coupler_sbc_init(Dom, dt_cpld, Run_len) return end subroutine external_coupler_sbc_init - subroutine external_coupler_sbc_before(Ice_ocean_boundary, Ocean_sfc, nsteps, dt_cpld ) + subroutine external_coupler_sbc_before(Ice_ocean_boundary, ocean_public, nsteps, dt_cpld ) implicit none type (ice_ocean_boundary_type), intent(INOUT) :: Ice_ocean_boundary - type (ocean_public_type) , intent(INOUT) :: Ocean_sfc + type (ocean_public_type) , intent(INOUT) :: ocean_public integer , intent(IN) :: nsteps, dt_cpld return end subroutine external_coupler_sbc_before - subroutine external_coupler_sbc_after(Ice_ocean_boundary, Ocean_sfc, nsteps, dt_cpld ) + subroutine external_coupler_sbc_after(Ice_ocean_boundary, ocean_public, nsteps, dt_cpld ) type (ice_ocean_boundary_type) :: Ice_ocean_boundary - type (ocean_public_type) :: Ocean_sfc + type (ocean_public_type) :: ocean_public integer :: nsteps, dt_cpld return end subroutine external_coupler_sbc_after @@ -1870,6 +2085,7 @@ subroutine State_GetFldPtr(ST, fldname, fldptr, rc) end subroutine State_GetFldPtr +#ifndef CESMCOUPLED !----------------------------------------------------------------------------- subroutine MOM_AdvertiseFields(state, nfields, field_defs, rc) @@ -1919,46 +2135,63 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) do i = 1, nfields - if (field_defs(i)%assoc) then - write(tmpstr, *) subname, tag, ' Field ', field_defs(i)%shortname, ':', & - lbound(field_defs(i)%farrayPtr,1), ubound(field_defs(i)%farrayPtr,1), & - lbound(field_defs(i)%farrayPtr,2), ubound(field_defs(i)%farrayPtr,2) - call ESMF_LogWrite(tmpstr, ESMF_LOGMSG_INFO, rc=dbrc) - field = ESMF_FieldCreate(grid=grid, & - farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & -! farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - if (NUOPC_IsConnected(state, fieldName=field_defs(i)%shortname)) then + + if (field_defs(i)%shortname == flds_scalar_name) then + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected on root pe.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=dbrc) + call shr_nuopc_fldList_SetScalarField(field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + elseif (field_defs(i)%assoc) then + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected and associated.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=dbrc) + write(tmpstr,'(a,4i12)') subname//trim(tag)//' Field '//trim(field_defs(i)%shortname)//':', & + lbound(field_defs(i)%farrayPtr,1), ubound(field_defs(i)%farrayPtr,1), & + lbound(field_defs(i)%farrayPtr,2), ubound(field_defs(i)%farrayPtr,2) + call ESMF_LogWrite(tmpstr, ESMF_LOGMSG_INFO, rc=dbrc) + field = ESMF_FieldCreate(grid=grid, & + farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & +! farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=dbrc) + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + call NUOPC_Realize(state, field=field, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call ESMF_LogWrite(subname // tag // " Field "// field_defs(i)%stdname // " is connected.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=dbrc) ! call ESMF_FieldPrint(field=field, rc=rc) ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & ! line=__LINE__, & ! file=__FILE__)) & ! return ! bail out else - call ESMF_LogWrite(subname // tag // " Field "// field_defs(i)%stdname // " is not connected.", & + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is not connected.", & ESMF_LOGMSG_INFO, & line=__LINE__, & file=__FILE__, & @@ -1976,17 +2209,14 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) enddo end subroutine MOM_RealizeFields - +#endif !----------------------------------------------------------------------------- - subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_sfc) + subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_public) type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary - type(ocean_public_type), intent(in) :: Ocean_sfc - -#ifdef CESMCOUPLED -! type (shr_nuopc_fldList_Type) :: fldsList -#endif + type(ocean_public_type), intent(in) :: ocean_public + integer :: rc character(len=*),parameter :: subname='(mom_cap:MOM_FieldsSetup)' !!! fld_list_add(num, fldlist, stdname, transferOffer, data(optional), shortname(optional)) @@ -2000,14 +2230,14 @@ subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_sfc) ! create import fields list !-------------------------------- -! call shr_nuopc_fldList_Zero(fldsList, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call shr_nuopc_fldList_Zero(fldsToOcn, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return -! call shr_nuopc_fldList_fromflds(fldsList, flds_x2o, flds_x2o_map, "will provide", subname//":flds_x2o", rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call shr_nuopc_fldList_fromflds(fldsToOcn, flds_x2o, flds_x2o_map, "will provide", subname//":flds_x2o", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return -! call shr_nuopc_fldList_Add(fldsList, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call shr_nuopc_fldList_Add(fldsToOcn, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return ! convert to fldsToOcn @@ -2015,51 +2245,14 @@ subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_sfc) ! create export fields list !-------------------------------- -! call shr_nuopc_fldList_Zero(fldsList, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - -! call shr_nuopc_fldList_fromflds(fldsList, flds_o2x, flds_o2x_map, "will provide", subname//":flds_o2x", rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - -! call shr_nuopc_fldList_Add(fldsList, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - -! WARNING tcx tcraig -! tcraig this is just a starting point, the fields are not complete or correct here -! tcraig we will need to figure out whether to adjust the mediator coupling fields for mom or vv or a bit of both - - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide", data=Ice_ocean_boundary%u_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide", data=Ice_ocean_boundary%v_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide", data=Ice_ocean_boundary%t_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide", data=Ice_ocean_boundary%q_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_salt" , "will provide", data=Ice_ocean_boundary%salt_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwdn" , "will provide", data=Ice_ocean_boundary%lw_flux ) -! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dir) -! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dif) -! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swidr", "will provide", data=Ice_ocean_boundary%sw_flux_nir_dir) -! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swidf", "will provide", data=Ice_ocean_boundary%sw_flux_nir_dif) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rain" , "will provide", data=Ice_ocean_boundary%lprec ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_snow" , "will provide", data=Ice_ocean_boundary%fprec ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide", data=Ice_ocean_boundary%runoff ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_meltw", "will provide", data=Ice_ocean_boundary%calving) -! call fld_list_add(fldsToOcn_num, fldsToOcn, "runoff_heat_flux" , "will provide", data=Ice_ocean_boundary%runoff_hflx ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_melth", "will provide", data=Ice_ocean_boundary%calving_hflx) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide", data=Ice_ocean_boundary%p ) -! call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice", "will provide", data=Ice_ocean_boundary%mi) + call shr_nuopc_fldList_Zero(fldsFrOcn, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return -!--------- export fields ------------- - - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask", "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t", "will provide", data=Ocean_sfc%t_surf) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide", data=Ocean_sfc%s_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u", "will provide", data=Ocean_sfc%u_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v", "will provide", data=Ocean_sfc%v_surf ) -! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir", "will provide") -! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir", "will provide") -! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=Ocean_sfc%sea_lev) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide", data=Ocean_sfc%frazil) + call shr_nuopc_fldList_fromflds(fldsFrOcn, flds_o2x, flds_o2x_map, "will provide", subname//":flds_o2x", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call shr_nuopc_fldList_Add(fldsFrOcn, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return #else !--------- import fields ------------- @@ -2088,21 +2281,21 @@ subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_sfc) !--------- export fields ------------- call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask", "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature", "will provide", data=Ocean_sfc%t_surf) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide", data=Ocean_sfc%s_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal", "will provide", data=Ocean_sfc%u_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid", "will provide", data=Ocean_sfc%v_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature", "will provide", data=ocean_public%t_surf) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide", data=ocean_public%s_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal", "will provide", data=ocean_public%u_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid", "will provide", data=ocean_public%v_surf ) ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir", "will provide") ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir", "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=Ocean_sfc%sea_lev) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=Ocean_sfc%frazil) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=ocean_public%sea_lev) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=ocean_public%frazil) #endif end subroutine MOM_FieldsSetup !----------------------------------------------------------------------------- - +#ifndef CESMCOUPLED subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) ! ---------------------------------------------- ! Set up a list of field information @@ -2142,6 +2335,7 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) endif end subroutine fld_list_add +#endif subroutine dumpMomInternal(grid, slice, stdname, nop, farray) @@ -2193,53 +2387,53 @@ subroutine dumpMomInternal(grid, slice, stdname, nop, farray) end subroutine +#if (1 == 0) #ifdef MOM6_CAP - subroutine calculate_rot_angle(OS, OSFC, OG) + subroutine calculate_rot_angle(OS, OSFC) type(ocean_state_type), intent(in) :: OS type(ocean_public_type), intent(in) :: OSFC - type(ocean_grid_type), pointer :: OG integer :: i,j,ishift,jshift,ilb,iub,jlb,jub real :: angle, lon_scale - type(ocean_grid_type), pointer :: G + type(ocean_grid_type), pointer :: grid - call get_ocean_grid(OS, G) + call get_ocean_grid(OS, grid) - !print *, 'lbound: ', lbound(G%geoLatT), lbound(G%geoLonT), lbound(G%sin_rot) - !print *, 'ubound: ', ubound(G%geoLatT), ubound(G%geoLonT), ubound(G%sin_rot) + !print *, 'lbound: ', lbound(grid%geoLatT), lbound(grid%geoLonT), lbound(grid%sin_rot) + !print *, 'ubound: ', ubound(grid%geoLatT), ubound(grid%geoLonT), ubound(grid%sin_rot) - !print *, minval(G%geoLatT), maxval(G%geoLatT) - !print *, minval(G%geoLonT), maxval(G%geoLonT) - !print *, G%isc, G%jsc, G%iec, G%jec + !print *, minval(grid%geoLatT), maxval(grid%geoLatT) + !print *, minval(grid%geoLonT), maxval(grid%geoLonT) + !print *, grid%isc, grid%jsc, grid%iec, grid%jec ! ! The bounds isc:iec goes from 5-104, isc-ishift:iec-ishift goes from 1:100 ! call mpp_get_compute_domain(OSFC%Domain, ilb, iub, jlb, jub) - ishift = ilb-G%isc - jshift = jlb-G%jsc + ishift = ilb-grid%isc + jshift = jlb-grid%jsc !print *, 'ilb, iub, jlb, jub', ilb, iub, jlb, jub, ishift, jshift - !print *, 'sizes', iub-ilb, jub-jlb, G%iec-G%isc, G%jec-G%jsc - allocate(OG) - allocate(OG%sin_rot(ilb:iub, jlb:jub)) - allocate(OG%cos_rot(ilb:iub, jlb:jub)) + !print *, 'sizes', iub-ilb, jub-jlb, grid%iec-grid%isc, grid%jec-grid%jsc +! allocate(grid%sin_rot(ilb:iub, jlb:jub)) +! allocate(grid%cos_rot(ilb:iub, jlb:jub)) ! loop 5-104 - do j=G%jsc,G%jec ; do i=G%isc,G%iec - lon_scale = cos((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J-1 ) + & - G%geoLatBu(I-1,J) + G%geoLatBu(I,J)) * atan(1.0)/180) - angle = atan2((G%geoLonBu(I-1,J) + G%geoLonBu(I,J) - & - G%geoLonBu(I-1,J-1) - G%geoLonBu(I,J-1))*lon_scale, & - G%geoLatBu(I-1,J) + G%geoLatBu(I,J) - & - G%geoLatBu(I-1,J-1) - G%geoLatBu(I,J-1) ) - OG%sin_rot(i+ishift,j+jshift) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean - OG%cos_rot(i+ishift,j+jshift) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) + do j=grid%jsc,grid%jec ; do i=grid%isc,grid%iec + lon_scale = cos((grid%geoLatBu(I-1,J-1) + grid%geoLatBu(I,J-1 ) + & + grid%geoLatBu(I-1,J) + grid%geoLatBu(I,J)) * atan(1.0)/180) + angle = atan2((grid%geoLonBu(I-1,J) + grid%geoLonBu(I,J) - & + grid%geoLonBu(I-1,J-1) - grid%geoLonBu(I,J-1))*lon_scale, & + grid%geoLatBu(I-1,J) + grid%geoLatBu(I,J) - & + grid%geoLatBu(I-1,J-1) - grid%geoLatBu(I,J-1) ) + grid%sin_rot(i+ishift,j+jshift) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean + grid%cos_rot(i+ishift,j+jshift) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) enddo ; enddo - !print *, minval(OG%sin_rot), maxval(OG%sin_rot) - !print *, minval(OG%cos_rot), maxval(OG%cos_rot) + !print *, minval(grid%sin_rot), maxval(grid%sin_rot) + !print *, minval(grid%cos_rot), maxval(grid%cos_rot) end subroutine #endif +#endif end module mom_cap_mod diff --git a/config_src/nuopc_driver/mom_cap.F90.00 b/config_src/nuopc_driver/mom_cap.F90.00 new file mode 100644 index 0000000000..56c4b5cd35 --- /dev/null +++ b/config_src/nuopc_driver/mom_cap.F90.00 @@ -0,0 +1,2245 @@ +!> +!! @mainpage MOM NUOPC Cap +!! @author Fei Liu (fei.liu@gmail.com) +!! @date 5/10/13 Original documentation +!! @author Rocky Dunlap (rocky.dunlap@noaa.gov) +!! @date 1/12/17 Moved to doxygen +!! +!! @tableofcontents +!! +!! @section Overview Overview +!! +!! **This MOM cap has been tested with MOM5 and MOM6.** +!! +!! This document describes the MOM "cap", which is a small software layer that is +!! required when the [MOM ocean model] (http://mom-ocean.org/web) +!! is used in [National Unified Operation Prediction Capability] +!! (http://www.earthsystemcog.org/projects/nuopc) (NUOPC) coupled systems. +!! The NUOPC Layer is a software layer built on top of the [Earth System Modeling +!! Framework] (https://www.earthsystemcog.org/projects/esmf) (ESMF). +!! ESMF is a high-performance modeling framework that provides +!! data structures, interfaces, and operations suited for building coupled models +!! from a set of components. NUOPC refines the capabilities of ESMF by providing +!! a more precise definition of what it means for a model to be a component and +!! how components should interact and share data in a coupled system. The NUOPC +!! Layer software is designed to work with typical high-performance models in the +!! Earth sciences domain, most of which are written in Fortran and are based on a +!! distributed memory model of parallelism (MPI). +!! A NUOPC "cap" is a Fortran module that serves as the interface to a model +!! when it's used in a NUOPC-based coupled system. +!! The term "cap" is used because it is a small software layer that sits on top +!! of model code, making calls into it and exposing model data structures in a +!! standard way. For more information about creating NUOPC caps in general, please +!! see the [Building a NUOPC Model] +!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_howtodoc/) +!! how-to document. +!! +!! The MOM cap package includes the cap itself (mom_cap.F90, a Fortran module), a +!! set of time utilities (time_utils.F90) for converting between ESMF and FMS +!! time types, and two makefiles. Also included are self-describing dependency +!! makefile fragments (mom.mk and mom.mk.template), although these can be generated +!! by the makefiles for specific installations of the MOM cap. +!! +!! @subsection CapSubroutines Cap Subroutines +!! +!! The MOM cap Fortran module contains a set of subroutines that are required +!! by NUOPC. These subroutines are called by the NUOPC infrastructure according +!! to a predefined calling sequence. Some subroutines are called during +!! initialization of the coupled system, some during the run of the coupled +!! system, and some during finalization of the coupled system. The initialization +!! sequence is the most complex and is governed by the NUOPC technical rules. +!! Details about the initialization sequence can be found in the [NUOPC Reference Manual] +!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html#SECTION00034000000000000000). +!! +!! A particularly important part of the NUOPC intialization sequence is to establish +!! field connections between models. Simply put, a field connection is established +!! when a field output by one model can be consumed by another. As an example, the +!! MOM model is able to accept a precipitation rate when coupled to an atmosphere +!! model. In this case a field connection will be established between the precipitation +!! rate exported from the atmosphere and the precipitation rate imported into the +!! MOM model. Because models may uses different variable names for physical +!! quantities, NUOPC relies on a set of standard names and a built-in, extensible +!! standard name dictionary to match fields between models. More information about +!! the use of standard names can be found in the [NUOPC Reference Manual] +!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html#SECTION00032000000000000000). +!! +!! Two key initialization phases that appear in every NUOPC cap, including this MOM +!! cap are the field "advertise" and field "realize" phases. *Advertise* is a special +!! NUOPC term that refers to a model participating in a coupled system +!! providing a list of standard names of required import fields and available export +!! fields. In other words, each model will advertise to the other models which physical fields +!! it needs and which fields it can provide when coupled. NUOPC compares all of the advertised +!! standard names and creates a set of unidirectional links, each from one export field +!! in a model to one import field in another model. When these connections have been established, +!! all models in the coupled system need to provide a description of their geographic +!! grid (e.g., lat-lon, tri-polar, cubed sphere, etc.) and allocate their connected +!! fields on that grid. In NUOPC terms, this is refered to as *realizing* a set of +!! fields. NUOPC relies on ESMF data types for this, such as the [ESMF_Grid] +!! (http://www.earthsystemmodeling.org/esmf_releases/public/last/ESMF_refdoc/node5.html#SECTION05080000000000000000) +!! type, which describes logically rectangular grids and the [ESMF_Field] +!! (http://www.earthsystemmodeling.org/esmf_releases/public/last/ESMF_refdoc/node5.html#SECTION05030000000000000000) +!! type, which wraps a models data arrays and provides basic metadata. Because ESMF supports +!! interpolation between different grids (sometimes called "regridding" or "grid remapping"), +!! it is not necessary that models share a grid. As you will see below +!! the *advertise* and *realize* phases each have a subroutine in the HYCOM cap. +!! +!! The following table summarizes the NUOPC-required subroutines that appear in the +!! MOM cap. The "Phase" column says whether the subroutine is called during the +!! initialization, run, or finalize part of the coupled system run. +!! +!! Phase | MOM Cap Subroutine | Description +!! ---------|--------------------------------------------------------------------|------------------------------------------------------------- +!! Init | [InitializeP0] (@ref mom_cap_mod::initializep0) | Sets the Initialize Phase Definition (IPD) version to use +!! Init | [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) | Advertises standard names of import and export fields +!! Init | [InitializeRealize] (@ref mom_cap_mod::initializerealize) | Creates an ESMF_Grid for the MOM grid as well as ESMF_Fields for import and export fields +!! Run | [ModelAdvance] (@ref mom_cap_mod::modeladvance) | Advances the model by a timestep +!! Final | [Finalize] (@ref mom_cap_mod::ocean_model_finalize) | Cleans up +!! +!! @section UnderlyingModelInterfaces Underlying Model Interfaces +!! +!! +!! @subsection DomainCreation Domain Creation +!! +!! The MOM tripolar grid is represented as a 2D `ESMF_Grid` and coupling fields are placed +!! on this grid. Calls related to creating the grid are located in the [InitializeRealize] +!! (@ref mom_cap_mod::initializerealize) subroutine, which is called by the NUOPC infrastructure +!! during the intialization sequence. +!! +!! The cap determines parameters for setting up the grid by calling subroutines in the +!! `mpp_domains_mod` module. The global domain size is determined by calling `mpp_get_global_domain()`. +!! A check is in place to ensure that there is only a single tile in the domain (the +!! cap is currently limited to one tile; multi-tile mosaics are not supported). The +!! decomposition across processors is determined via calls to `mpp_get_compute_domains()` +!! (to retrieve decomposition block indices) and `mpp_get_pelist()` (to determine how +!! blocks are assigned to processors). +!! +!! The grid is created in several steps: +!! - an `ESMF_DELayout` is created based on the pelist from MOM +!! - an `ESMF_DistGrid` is created over the global index space. Connections are set +!! up so that the index space is periodic in the first dimension and has a +!! fold at the top for the bipole. The decompostion blocks are also passed in +!! along with the `ESMF_DELayout` mentioned above. +!! - an `ESMF_Grid` is then created by passing in the above `ESMF_DistGrid`. +!! +!! Masks, areas, center (tlat, tlon), and corner (ulat, ulon) coordinates are then added to the `ESMF_Grid` +!! by retrieving those fields from MOM with calls to `ocean_model_data_get()`. +!! +!! @subsection Initialization Initialization +!! +!! During the [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) phase, calls are +!! made to MOM's native initialization subroutines, including `fms_init()`, `constants_init()`, +!! `field_manager_init()`, `diag_manager_init()`, and `set_calendar_type()`. The MPI communicator +!! is pulled in through the ESMF VM object for the MOM component. The dt and start time are set +!! from parameters from the incoming ESMF clock with calls to `set_time()` and `set_date().` +!! +!! +!! @subsection Run Run +!! +!! The [ModelAdvance] (@ref mom_cap_mod::modeladvance) subroutine is called by the NUOPC +!! infrastructure when it's time for MOM to advance in time. During this subroutine, there is a +!! call into the MOM update routine: +!! +!! call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_sfc, Time, Time_step_coupled) +!! +!! Prior to this call, the cap performs a few steps: +!! - the `Time` and `Time_step_coupled` parameters, which are based on FMS types, are derived from the incoming ESMF clock +!! - there are calls to two stubs: `ice_ocn_bnd_from_data()` and `external_coupler_sbc_before()` - these are currently +!! inactive, but may be modified to read in import data from file or from an external coupler +!! - diagnostics are optionally written to files `field_ocn_import_*`, one for each import field +!! - import fields are prepared: +!! - the sign is reversed on `mean_evap_rate` and `mean_sensi_heat_flux` +!! - momentum flux vectors are rotated to internal grid +!! - optionally, a call is made to `ocean_model_restart()` at the interval `restart_interval` +!! +!! After the call to `update_ocean_model()`, the cap performs these steps: +!! - the `ocean_mask` export is set to match that of the internal MOM mask +!! - the `freezing_melting_potential` export is converted from J m-2 to W m-2 by dividing by the coupling interval +!! - vector rotations are applied to the `ocean_current_zonal` and `ocean_current_merid` exports, back to lat-lon grid +!! - diagnostics are optionally written to files `field_ocn_export_*`, one for each export field +!! - a call is made to `external_coupler_sbc_after()` to update exports from an external coupler (currently an inactive stub) +!! - calls are made to `dumpMomInternal()` to write files `field_ocn_internal_*` for all internal fields (both import and export) +!! +!! @subsubsection VectorRotations Vector Rotations +!! +!! Vector rotations are applied to incoming momentum fluxes (from regular lat-lon to tripolar grid) and +!! outgoing ocean currents (from tripolar to regular lat-lon). The rotation angles are provided +!! from the native MOM grid by a call to `get_ocean_grid(Ocean_grid)`. +!! The cosine and sine of the rotation angle are: +!! +!! Ocean_grid%cos_rot(i,j) +!! Ocean_grid%sin_rot(i,j) +!! +!! The rotation of momentum flux from regular lat-lon to tripolar is: +!! \f[ +!! \begin{bmatrix} +!! \tau_x' \\ +!! \tau_y' +!! \end{bmatrix} = +!! \begin{bmatrix} +!! cos \theta & sin \theta \\ +!! -sin \theta & cos \theta +!! \end{bmatrix} * +!! \begin{bmatrix} +!! \tau_x \\ +!! \tau_y +!! \end{bmatrix} +!! \f] +!! +!! The rotation of ocean current from tripolar to regular lat-lon is: +!! \f[ +!! \begin{bmatrix} +!! u' \\ +!! v' +!! \end{bmatrix} = +!! \begin{bmatrix} +!! cos \theta & -sin \theta \\ +!! sin \theta & cos \theta +!! \end{bmatrix} * +!! \begin{bmatrix} +!! u \\ +!! v +!! \end{bmatrix} +!! \f] +!! @subsection Finalization Finalization +!! +!! NUOPC infrastructure calls [ocean_model_finalize] (@ref mom_cap_mod::ocean_model_finalize) +!! at the end of the run. This subroutine is a hook to call into MOM's native shutdown +!! procedures: +!! +!! call ocean_model_end (Ocean_sfc, Ocean_State, Time) +!! call diag_manager_end(Time ) +!! call field_manager_end +!! call fms_io_exit +!! call fms_end +!! +!! @section ModelFields Model Fields +!! +!! The following tables list the import and export fields currently set up in the MOM cap. +!! +!! @subsection ImportFields Import Fields +!! +!! Standard Name | Units | Model Variable | Description | Notes +!! ----------------------------------|------------|-----------------|-----------------------------------------------|-------------------------------------- +!! inst_pres_height_surface | Pa | p | pressure of overlying sea ice and atmosphere | | +!! mass_of_overlying_sea_ice | kg | mi | mass of overlying sea ice | | +!! mean_calving_heat_flx | W m-2 | calving_hflx | heat flux, relative to 0C, of frozen land water into ocean | | +!! mean_calving_rate | kg m-2 s-1 | calving | mass flux of frozen runoff | | +!! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | sign reversed (- evap) +!! mean_fprec_rate | kg m-2 s-1 | fprec | mass flux of frozen precip | | +!! mean_merid_moment_flx | Pa | v_flux | j-directed wind stress into ocean | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar +!! mean_net_lw_flx | W m-2 | lw_flux | long wave radiation | | +!! mean_net_sw_ir_dif_flx | W m-2 | sw_flux_nir_dif | diffuse near IR shortwave radiation | | +!! mean_net_sw_ir_dir_flx | W m-2 | sw_flux_nir_dir | direct near IR shortwave radiation | | +!! mean_net_sw_vis_dif_flx | W m-2 | sw_flux_vis_dif | diffuse visible shortware radiation | | +!! mean_net_sw_vis_dir_flx | W m-2 | sw_flux_vis_dir | direct visible shortware radiation | | +!! mean_prec_rate | kg m-2 s-1 | lprec | mass flux of liquid precip | | +!! mean_runoff_heat_flx | W m-2 | runoff_hflx | heat flux, relative to 0C, of liquid land water into ocean | | +!! mean_runoff_rate | kg m-2 s-1 | runoff | mass flux of liquid runoff | | +!! mean_salt_rate | kg m-2 s-1 | salt_flux | salt flux | | +!! mean_sensi_heat_flx | W m-2 | t_flux | sensible heat flux into ocean | sign reversed (- sensi) +!! mean_zonal_moment_flx | Pa | u_flux | j-directed wind stress into ocean | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar +!! +!! +!! @subsection ExportField Export Fields +!! +!! Export fields are populated from the `ocean_sfc` parameter (type `ocean_public_type`) +!! after the call to `update_ocean_model()`. +!! +!! Standard Name | Units | Model Variable | Description | Notes +!! ----------------------------------|------------|-----------------|-------------------------------------------|--------------------------------------------------------------------- +!! freezing_melting_potential | W m-2 | frazil | accumulated heating from frazil formation | cap converts model units (J m-2) to (W m-2) for export +!! ocean_mask | | | ocean mask | | +!! ocn_current_merid | m s-1 | v_surf | j-directed surface velocity on u-cell | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon +!! ocn_current_zonal | m s-1 | u_surf | i-directed surface velocity on u-cell | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon +!! s_surf | psu | s_surf | sea surface salinity on t-cell | | +!! sea_lev | m | sea_lev | sea level | model computation is eta_t + patm/(rho0*grav) - eta_geoid - eta_tide +!! sea_surface_temperature | K | t_surf | sea surface temperature on t-cell | | +!! +!! @subsection MemoryManagement Memory Management +!! +!! The MOM cap has an internal state type with pointers to three +!! types defined by MOM. There is also a small wrapper derived type +!! required to associate an internal state instance +!! with the ESMF/NUOPC component: +!! +!! type ocean_internalstate_type +!! type(ocean_public_type), pointer :: ocean_public_type_ptr +!! type(ocean_state_type), pointer :: ocean_state_type_ptr +!! type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr +!! end type +!! +!! type ocean_internalstate_wrapper +!! type(ocean_internalstate_type), pointer :: ptr +!! end type +!! +!! The member of type `ocean_public_type` stores ocean surface fields used during the coupling. +!! The member of type `ocean_state_type` is required by the ocean driver, +!! although its internals are private (not to be used by the coupling directly). +!! This type is passed to the ocean init and update routines +!! so that it can maintain state there if desired. +!! The member of type `ice_ocean_boundary_type` is populated by this cap +!! with incoming coupling fields from other components. These three derived types are allocated during the +!! [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) phase. Also during that +!! phase, the `ice_ocean_boundary` type members are all allocated using bounds retrieved +!! from `mpp_get_compute_domain()`. +!! +!! During the [InitializeRealize] (@ref mom_cap_mod::initializerealize) phase, +!! `ESMF_Field`s are created for each of the coupling fields in the `ice_ocean_boundary` +!! and `ocean_public_type` members of the internal state. These fields directly reference into the members of +!! the `ice_ocean_boundary` and `ocean_public_type` so that memory-to-memory copies are not required to move +!! data from the cap's import and export states to the memory areas used internally +!! by MOM. +!! +!! @subsection IO I/O +!! +!! The cap can optionally output coupling fields for diagnostic purposes if the ESMF attribute +!! "DumpFields" has been set to "true". In this case the cap will write out NetCDF files +!! with names "field_ocn_import_.nc" and "field_ocn_export_.nc". +!! Additionally, calls will be made to the cap subroutine [dumpMomInternal] +!! (@ref mom_cap_mod::dumpmominternal) to write out model internal fields to files +!! named "field_ocn_internal_.nc". In all cases these NetCDF files will +!! contain a time series of field data. +!! +!! @section BuildingAndInstalling Building and Installing +!! +!! There are two makefiles included with the MOM cap, makefile and makefile.nuopc. +!! The makefile.nuopc file is intended to be used within another build system, such +!! as the NEMSAppBuilder. The regular makefile can be used generally for building +!! and installing the cap. Two variables must be customized at the top: +!! - `INSTALLDIR` - where to copy the cap library and dependent libraries +!! - `NEMSMOMDIR` - location of the MOM library and FMS library +!! +!! To install run: +!! $ make install +!! +!! A makefile fragment, mom.mk, will also be copied into the directory. The fragment +!! defines several variables that can be used by another build system to include the +!! MOM cap and its dependencies. +!! +!! @subsection Dependencies Dependencies +!! +!! The MOM cap is dependent on the MOM library itself (lib_ocean.a) and the FMS +!! library (lib_FMS.a). +!! +!! @section RuntimeConfiguration Runtime Configuration +!! +!! At runtime, the MOM cap can be configured with several options provided +!! as ESMF attributes. Attributes can be set in the cap by the NUOPC Driver +!! above this cap, or in some systems (e.g., NEMS) attributes are set by +!! reading in from a configuration file. The available attributes are: +!! +!! * `DumpFields` - when set to "true", write out diagnostic NetCDF files for import/export/internal fields +!! * `ProfileMemory` - when set to "true", write out memory usage information to the ESMF log files; this +!! information is written when entering and leaving the [ModelAdvance] +!! (@ref mom_cap_mod::modeladvance) subroutine and before and after the call to +!! `update_ocean_model()`. +!! * `OceanSolo` - when set to "true", this option indicates that MOM is being run +!! uncoupled; in this case the vector rotations and other data manipulations +!! on import fields are skipped +!! * `restart_interval` - integer number of seconds indicating the interval at +!! which to call `ocean_model_restart()`; no restarts written if set to 0 +!! * `GridAttachArea` - when set to "true", this option indicates that MOM grid attaches cell area +!! using internal values computed in MOM. The default value is "false", grid cell area will +!! be computed in ESMF. +!! +!! +!! @section Repository +!! The MOM NUOPC cap is maintained in a GitHub repository: +!! https://github.com/feiliuesmf/nems_mom_cap +!! +!! @section References +!! +!! - [MOM Home Page] (http://mom-ocean.org/web) +!! +!! +module mom_cap_mod + use constants_mod, only: constants_init + use data_override_mod, only: data_override_init, data_override + use diag_manager_mod, only: diag_manager_init, diag_manager_end + use field_manager_mod, only: field_manager_init, field_manager_end + use fms_mod, only: fms_init, fms_end, open_namelist_file, check_nml_error + use fms_mod, only: close_file, file_exist, uppercase + use fms_io_mod, only: fms_io_exit + use mpp_domains_mod, only: domain2d, mpp_get_compute_domain, mpp_get_compute_domains + use mpp_domains_mod, only: mpp_get_ntile_count, mpp_get_pelist, mpp_get_global_domain + use mpp_domains_mod, only: mpp_get_domain_npes, mpp_global_field + use mpp_io_mod, only: mpp_open, MPP_RDONLY, MPP_ASCII, MPP_OVERWR, MPP_APPEND, mpp_close, MPP_SINGLE + use mpp_mod, only: input_nml_file, mpp_error, FATAL, NOTE, mpp_pe, mpp_npes, mpp_set_current_pelist + use mpp_mod, only: stdlog, stdout, mpp_root_pe, mpp_clock_id + use mpp_mod, only: mpp_clock_begin, mpp_clock_end, MPP_CLOCK_SYNC + use mpp_mod, only: MPP_CLOCK_DETAILED, CLOCK_COMPONENT, MAXPES + use time_interp_external_mod, only: time_interp_external_init + use time_manager_mod, only: set_calendar_type, time_type, increment_date + use time_manager_mod, only: set_time, set_date, get_time, get_date, month_name + use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR + use time_manager_mod, only: operator( <= ), operator( < ), operator( >= ) + use time_manager_mod, only: operator( + ), operator( - ), operator( / ) + use time_manager_mod, only: operator( * ), operator( /= ), operator( > ) + use time_manager_mod, only: date_to_string + use time_manager_mod, only: fms_get_calendar_type => get_calendar_type + + use ocean_model_mod, only: ocean_model_restart, ocean_public_type, ocean_state_type + use ocean_model_mod, only: ocean_model_data_get + use ocean_model_mod, only: ocean_model_init , update_ocean_model, ocean_model_end, get_ocean_grid +#ifdef MOM6_CAP + use ocean_model_mod, only: ice_ocean_boundary_type + use MOM_grid, only: ocean_grid_type +#else + use ocean_types_mod, only: ice_ocean_boundary_type, ocean_grid_type +#endif + + use ESMF + use NUOPC + use NUOPC_Model, & + model_routine_SS => SetServices, & + model_label_Advance => label_Advance, & + model_label_Finalize => label_Finalize + + use time_utils_mod + + implicit none + private + public SetServices + + type ocean_internalstate_type + type(ocean_public_type), pointer :: ocean_public_type_ptr + type(ocean_state_type), pointer :: ocean_state_type_ptr + type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr + type(ocean_grid_type), pointer :: ocean_grid_ptr + end type + + type ocean_internalstate_wrapper + type(ocean_internalstate_type), pointer :: ptr + end type + + type fld_list_type + character(len=64) :: stdname + character(len=64) :: shortname + character(len=64) :: transferOffer + logical :: assoc ! is the farrayPtr associated with internal data + real(ESMF_KIND_R8), dimension(:,:), pointer :: farrayPtr + end type fld_list_type + + integer,parameter :: fldsMax = 100 + integer :: fldsToOcn_num = 0 + type (fld_list_type) :: fldsToOcn(fldsMax) + integer :: fldsFrOcn_num = 0 + type (fld_list_type) :: fldsFrOcn(fldsMax) + + integer :: import_slice = 1 + integer :: export_slice = 1 + character(len=256) :: tmpstr + integer :: dbrc + + type(ESMF_Grid), save :: mom_grid_i + logical :: write_diagnostics = .true. + logical :: profile_memory = .true. + logical :: ocean_solo = .true. + logical :: grid_attach_area = .false. + integer(ESMF_KIND_I8) :: restart_interval + + contains + !----------------------------------------------------------------------- + !------------------- Solo Ocean code starts here ----------------------- + !----------------------------------------------------------------------- + + !> NUOPC SetService method is the only public entry point. + !! SetServices registers all of the user-provided subroutines + !! in the module with the NUOPC layer. + !! + !! @param gcomp an ESMF_GridComp object + !! @param rc return code + subroutine SetServices(gcomp, rc) + + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + character(len=*),parameter :: subname='(mom_cap:SetServices)' + + rc = ESMF_SUCCESS + + ! the NUOPC model component will register the generic methods + call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! switching to IPD versions + call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + userRoutine=InitializeP0, phase=0, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! set entry point for methods that require specific implementation + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv01p1"/), userRoutine=InitializeAdvertise, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv01p3"/), userRoutine=InitializeRealize, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! attach specializing method(s) + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & + specRoutine=ModelAdvance, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & + specRoutine=ocean_model_finalize, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end subroutine SetServices + + !----------------------------------------------------------------------------- + + !> First initialize subroutine called by NUOPC. The purpose + !! is to set which version of the Initialize Phase Definition (IPD) + !! to use. + !! + !! For this MOM cap, we are using IPDv01. + !! + !! @param gcomp an ESMF_GridComp object + !! @param importState an ESMF_State object for import fields + !! @param exportState an ESMF_State object for export fields + !! @param clock an ESMF_Clock object + !! @param rc return code + subroutine InitializeP0(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=10) :: value + character(len=*),parameter :: subname='(mom_cap:InitializeP0)' + + rc = ESMF_SUCCESS + + ! Switch to IPDv01 by filtering all other phaseMap entries + call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, & + acceptStringList=(/"IPDv01p"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_AttributeGet(gcomp, name="DumpFields", value=value, defaultValue="true", & + convention="NUOPC", purpose="Instance", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write_diagnostics=(trim(value)=="true") + call ESMF_LogWrite('MOM_CAP:DumpFields = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + + call ESMF_AttributeGet(gcomp, name="ProfileMemory", value=value, defaultValue="true", & + convention="NUOPC", purpose="Instance", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + profile_memory=(trim(value)/="false") + call ESMF_LogWrite('MOM_CAP:ProfileMemory = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + + call ESMF_AttributeGet(gcomp, name="OceanSolo", value=value, defaultValue="false", & + convention="NUOPC", purpose="Instance", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ocean_solo=(trim(value)=="true") + call ESMF_LogWrite('MOM_CAP:OceanSolo = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + + ! Retrieve restart_interval in (seconds) + ! A restart_interval value of 0 means no restart will be written. + call ESMF_AttributeGet(gcomp, name="restart_interval", value=value, defaultValue="0", & + convention="NUOPC", purpose="Instance", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + restart_interval = ESMF_UtilString2Int(value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if(restart_interval < 0) then + call ESMF_LogSetError(ESMF_RC_NOT_VALID, & + msg="MOM_CAP: OCN attribute: restart_interval cannot be negative.", & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + endif + call ESMF_LogWrite('MOM_CAP:restart_interval = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + + call ESMF_AttributeGet(gcomp, name="GridAttachArea", value=value, defaultValue="false", & + convention="NUOPC", purpose="Instance", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + grid_attach_area=(trim(value)=="true") + call ESMF_LogWrite('MOM_CAP:GridAttachArea = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + + end subroutine + + !----------------------------------------------------------------------------- + + !> Called by NUOPC to advertise import and export fields. "Advertise" + !! simply means that the standard names of all import and export + !! fields are supplied. The NUOPC layer uses these to match fields + !! between components in the coupled system. + !! + !! @param gcomp an ESMF_GridComp object + !! @param importState an ESMF_State object for import fields + !! @param exportState an ESMF_State object for export fields + !! @param clock an ESMF_Clock object + !! @param rc return code + subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + type(ESMF_VM) :: vm + type(ESMF_Time) :: MyTime + type(ESMF_TimeInterval) :: TINT + + type (ocean_public_type), pointer :: Ocean_sfc => NULL() + type (ocean_state_type), pointer :: Ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + + type(time_type) :: Run_len ! length of experiment + type(time_type) :: Time + type(time_type) :: Time_restart + type(time_type) :: DT + integer :: DT_OCEAN + integer :: isc,iec,jsc,jec + integer :: dt_cpld = 86400 + integer :: year=0, month=0, day=0, hour=0, minute=0, second=0 + integer :: mpi_comm_mom + + type(ESMF_Grid) :: gridIn + type(ESMF_Grid) :: gridOut + + integer :: npet, npet_x, npet_y + character(len=*),parameter :: subname='(mom_cap:InitializeAdvertise)' + + rc = ESMF_SUCCESS + + allocate(Ice_ocean_boundary) + !allocate(Ocean_state) ! ocean_model_init allocate this pointer + allocate(Ocean_sfc) + allocate(ocean_internalstate%ptr) + ocean_internalstate%ptr%ice_ocean_boundary_type_ptr => Ice_ocean_boundary + ocean_internalstate%ptr%ocean_public_type_ptr => Ocean_sfc + ocean_internalstate%ptr%ocean_state_type_ptr => Ocean_state + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_VMGet(VM, mpiCommunicator=mpi_comm_mom, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(CLOCK, currTIME=MyTime, TimeStep=TINT, RC=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_TimeGet (MyTime, & + YY=YEAR, MM=MONTH, DD=DAY, & + H=HOUR, M =MINUTE, S =SECOND, & + RC=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + CALL ESMF_TimeIntervalGet(TINT, S=DT_OCEAN, RC=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call fms_init(mpi_comm_mom) + call constants_init + call field_manager_init + call set_calendar_type (JULIAN ) + call diag_manager_init + ! this ocean connector will be driven at set interval + dt_cpld = DT_OCEAN + DT = set_time (DT_OCEAN, 0) + Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) + + Ocean_sfc%is_ocean_pe = .true. + call ocean_model_init(Ocean_sfc, Ocean_state, Time, Time) + +!tcx tcraig This results in errors in CESM with help from Alper +! FATAL error "MPP_OPEN: error in OPEN for data_table" +! The subroutine data_override_init shouldn't be called because ALLOW_FLUX_ADJUSTMENTS is set to FALSE +!tcx call data_override_init(Ocean_domain_in = Ocean_sfc%domain) + + call mpp_get_compute_domain(Ocean_sfc%domain, isc, iec, jsc, jec) + + allocate ( Ice_ocean_boundary% u_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% v_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% t_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% q_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% salt_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% lw_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_vis_dir (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_vis_dif (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_nir_dir (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_nir_dif (isc:iec,jsc:jec), & + Ice_ocean_boundary% lprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% fprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% runoff (isc:iec,jsc:jec), & + Ice_ocean_boundary% calving (isc:iec,jsc:jec), & + Ice_ocean_boundary% runoff_hflx (isc:iec,jsc:jec), & + Ice_ocean_boundary% calving_hflx (isc:iec,jsc:jec), & + Ice_ocean_boundary% mi (isc:iec,jsc:jec), & + Ice_ocean_boundary% p (isc:iec,jsc:jec)) + + Ice_ocean_boundary%u_flux = 0.0 + Ice_ocean_boundary%v_flux = 0.0 + Ice_ocean_boundary%t_flux = 0.0 + Ice_ocean_boundary%q_flux = 0.0 + Ice_ocean_boundary%salt_flux = 0.0 + Ice_ocean_boundary%lw_flux = 0.0 + Ice_ocean_boundary%sw_flux_vis_dir = 0.0 + Ice_ocean_boundary%sw_flux_vis_dif = 0.0 + Ice_ocean_boundary%sw_flux_nir_dir = 0.0 + Ice_ocean_boundary%sw_flux_nir_dif = 0.0 + Ice_ocean_boundary%lprec = 0.0 + Ice_ocean_boundary%fprec = 0.0 + Ice_ocean_boundary%runoff = 0.0 + Ice_ocean_boundary%calving = 0.0 + Ice_ocean_boundary%runoff_hflx = 0.0 + Ice_ocean_boundary%calving_hflx = 0.0 + Ice_ocean_boundary%mi = 0.0 + Ice_ocean_boundary%p = 0.0 + + call external_coupler_sbc_init(Ocean_sfc%domain, dt_cpld, Run_len) + + ocean_internalstate%ptr%ocean_state_type_ptr => Ocean_state + call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call MOM_FieldsSetup(ice_ocean_boundary, ocean_sfc) + + call MOM_AdvertiseFields(importState, fldsToOcn_num, fldsToOcn, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call MOM_AdvertiseFields(exportState, fldsFrOcn_num, fldsFrOcn, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + +#ifdef MOM6_CAP + ! When running mom6 solo, the rotation angles are not computed internally + ! in MOM6. We need to + ! calculate cos and sin of rotational angle for MOM6; the values + ! are stored in ocean_internalstate%ptr%ocean_grid_ptr%cos_rot and sin_rot + ! The rotation angles are retrieved during run time to rotate incoming + ! and outgoing vectors + ! + call calculate_rot_angle(Ocean_state, ocean_sfc, & + ocean_internalstate%ptr%ocean_grid_ptr) +#endif + + write(*,*) '----- MOM initialization phase Advertise completed' + + end subroutine InitializeAdvertise + + !----------------------------------------------------------------------------- + + !> Called by NUOPC to realize import and export fields. "Realizing" a field + !! means that its grid has been defined and an ESMF_Field object has been + !! created and put into the import or export State. + !! + !! @param gcomp an ESMF_GridComp object + !! @param importState an ESMF_State object for import fields + !! @param exportState an ESMF_State object for export fields + !! @param clock an ESMF_Clock object + !! @param rc return code + subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! Local Variables + type(ESMF_VM) :: vm + type(ESMF_Grid) :: gridIn + type(ESMF_Grid) :: gridOut + type(ESMF_DeLayout) :: delayout + type(ESMF_Distgrid) :: Distgrid + type(ESMF_DistGridConnection), allocatable :: connectionList(:) + type (ocean_public_type), pointer :: Ocean_sfc => NULL() + type (ocean_state_type), pointer :: Ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + integer :: npet, ntiles + integer :: nxg, nyg, cnt + integer :: isc,iec,jsc,jec + integer, allocatable :: xb(:),xe(:),yb(:),ye(:),pe(:) + integer, allocatable :: deBlockList(:,:,:), & + petMap(:),deLabelList(:), & + indexList(:) + integer :: ioff, joff + integer :: i, j, n, i1, j1, n1, icount + integer :: lbnd1,ubnd1,lbnd2,ubnd2 + integer :: lbnd3,ubnd3,lbnd4,ubnd4 + integer :: nblocks_tot + logical :: found + real(ESMF_KIND_R8), allocatable :: ofld(:,:), gfld(:,:) + real(ESMF_KIND_R8), pointer :: t_surf(:,:) + integer(ESMF_KIND_I4), pointer :: dataPtr_mask(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_area(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_xcen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ycen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_xcor(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ycor(:,:) + type(ESMF_Field) :: field_t_surf + character(len=*),parameter :: subname='(mom_cap:InitializeRealize)' + + rc = ESMF_SUCCESS + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr + Ocean_sfc => ocean_internalstate%ptr%ocean_public_type_ptr + Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_VMGet(vm, petCount=npet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !--------------------------------- + ! global mom grid size + !--------------------------------- + + call mpp_get_global_domain(Ocean_sfc%domain, xsize=nxg, ysize=nyg) + write(tmpstr,'(a,2i6)') subname//' nxg,nyg = ',nxg,nyg + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + !--------------------------------- + ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total + !--------------------------------- + + ntiles=mpp_get_ntile_count(Ocean_sfc%domain) ! this is tiles on this pe + if (ntiles /= 1) then + rc = ESMF_FAILURE + call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR, rc=dbrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + ntiles=mpp_get_domain_npes(Ocean_sfc%domain) + write(tmpstr,'(a,1i6)') subname//' ntiles = ',ntiles + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + !--------------------------------- + ! get start and end indices of each tile and their PET + !--------------------------------- + + allocate(xb(ntiles),xe(ntiles),yb(ntiles),ye(ntiles),pe(ntiles)) + call mpp_get_compute_domains(Ocean_sfc%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye) + call mpp_get_pelist(Ocean_sfc%domain, pe) + do n = 1,ntiles + write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + enddo + + !--------------------------------- + ! create delayout and distgrid + !--------------------------------- + + allocate(deBlockList(2,2,ntiles)) + allocate(petMap(ntiles)) + allocate(deLabelList(ntiles)) + + do n = 1, ntiles + deLabelList(n) = n + deBlockList(1,1,n) = xb(n) + deBlockList(1,2,n) = xe(n) + deBlockList(2,1,n) = yb(n) + deBlockList(2,2,n) = ye(n) + petMap(n) = pe(n) + ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side + enddo + + delayout = ESMF_DELayoutCreate(petMap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + allocate(connectionList(2)) + ! bipolar boundary condition at top row: nyg + call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & + tileIndexB=1, positionVector=(/nxg+1, 2*nyg+1/), & + orientationVector=(/-1, -2/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ! periodic boundary condition along first dimension + call ESMF_DistGridConnectionSet(connectionList(2), tileIndexA=1, & + tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nxg,nyg/), & +! indexflag = ESMF_INDEX_DELOCAL, & + deBlockList=deBlockList, & +! deLabelList=deLabelList, & + delayout=delayout, & + connectionList=connectionList, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + deallocate(xb,xe,yb,ye,pe) + deallocate(connectionList) + deallocate(deLabelList) + deallocate(deBlockList) + deallocate(petMap) + + call ESMF_DistGridGet(distgrid=distgrid, localDE=0, elementCount=cnt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + allocate(indexList(cnt)) + write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(tmpstr,'(a,4i8)') subname//' distgrid list= ',& + indexList(1),indexList(cnt),minval(indexList), maxval(indexList) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + deallocate(IndexList) + + !--------------------------------- + ! create grid + !--------------------------------- + + gridIn = ESMF_GridCreate(distgrid=distgrid, & + gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & + coordSys = ESMF_COORDSYS_SPH_DEG, & + rc = rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + mom_grid_i = gridIn + + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! Attach area to the Grid optionally. By default the cell areas are computed. + if(grid_attach_area) then + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + call ESMF_GridGetCoord(gridIn, coordDim=1, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_xcen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridGetCoord(gridIn, coordDim=2, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_ycen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridGetCoord(gridIn, coordDim=1, & + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=dataPtr_xcor, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridGetCoord(gridIn, coordDim=2, & + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=dataPtr_ycor, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_MASK, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_mask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if(grid_attach_area) then + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_area, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + !--------------------------------- + ! load up area, mask, center and corner values + ! area, mask, and centers should be same size in mom and esmf grid + ! corner points may not be, need to offset corner points by 1 in i and j + ! for esmf and also need to "make up" j=1 values. use wraparound in i + !--------------------------------- + + call mpp_get_compute_domain(Ocean_sfc%domain, isc, iec, jsc, jec) + + lbnd1 = lbound(dataPtr_mask,1) + ubnd1 = ubound(dataPtr_mask,1) + lbnd2 = lbound(dataPtr_mask,2) + ubnd2 = ubound(dataPtr_mask,2) + + lbnd3 = lbound(dataPtr_xcor,1) + ubnd3 = ubound(dataPtr_xcor,1) + lbnd4 = lbound(dataPtr_xcor,2) + ubnd4 = ubound(dataPtr_xcor,2) + + write(tmpstr,*) subname//' iscjsc = ',isc,iec,jsc,jec + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' lbub12 = ',lbnd1,ubnd1,lbnd2,ubnd2 + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' lbub34 = ',lbnd3,ubnd3,lbnd4,ubnd4 + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + if (iec-isc /= ubnd1-lbnd1 .or. jec-jsc /= ubnd2-lbnd2) then + rc=ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": fld and grid do not have the same size.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + + allocate(ofld(isc:iec,jsc:jec)) + allocate(gfld(nxg,nyg)) + + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'mask', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld mask = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld mask = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_mask(i,j) = nint(ofld(i1,j1)) + enddo + enddo + + if(grid_attach_area) then + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'area', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld area = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld area = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_area(i,j) = ofld(i1,j1) + enddo + enddo + endif + + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'tlon', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld xt = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld xt = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_xcen(i,j) = ofld(i1,j1) + dataPtr_xcen(i,j) = mod(dataPtr_xcen(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) + enddo + enddo + + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'tlat', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld yt = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld yt = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_ycen(i,j) = ofld(i1,j1) + enddo + enddo + +#ifdef MOM5_CAP + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'ulon', ofld, isc, jsc) +#endif + +#ifdef MOM6_CAP + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'geoLonBu', ofld, isc, jsc) +#endif + write(tmpstr,*) subname//' ofld xu = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld xu = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd4, ubnd4 + do i = lbnd3, ubnd3 + j1 = j - lbnd4 + jsc - 1 + i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 + if (j1 == 0) then + dataPtr_xcor(i,j) = 2*gfld(i1,1) - gfld(i1,2) +! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) > 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) - 360. +! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) < 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) + 360. + elseif (j1 >= 1 .and. j1 <= nyg) then + dataPtr_xcor(i,j) = gfld(i1,j1) + else + rc=ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": error in xu j1.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + dataPtr_xcor(i,j) = mod(dataPtr_xcor(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) + ! write(tmpstr,*) subname//' ijfld xu = ',i,i1,j,j1,dataPtr_xcor(i,j) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + enddo + enddo + +! The corner latitude values are treated differently because MOM5 runs on B-Grid while +! MOM6 runs on C-Grid. +#ifdef MOM5_CAP + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'ulat', ofld, isc, jsc) +#endif + +#ifdef MOM6_CAP + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'geoLatBu', ofld, isc, jsc) +#endif + + write(tmpstr,*) subname//' ofld yu = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_sfc%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld yu = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd4, ubnd4 + do i = lbnd3, ubnd3 + j1 = j - lbnd4 + jsc - 1 + i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 + if (j1 == 0) then + dataPtr_ycor(i,j) = 2*gfld(i1,1) - gfld(i1,2) + elseif (j1 >= 1 .and. j1 <= nyg) then + dataPtr_ycor(i,j) = gfld(i1,j1) + else + rc=ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": error in yu j1.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + ! write(tmpstr,*) subname//' ijfld yu = ',i,i1,j,j1,dataPtr_ycor(i,j) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + enddo + enddo + + write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + if(grid_attach_area) then + write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + endif + + write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' ycen = ',minval(dataPtr_ycen),maxval(dataPtr_ycen) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' xcor = ',minval(dataPtr_xcor),maxval(dataPtr_xcor) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + deallocate(gfld) + + gridOut = gridIn ! for now out same as in + + !--------------------------------- + ! realize fields on grid + !--------------------------------- + + call MOM_RealizeFields(importState, gridIn , fldsToOcn_num, fldsToOcn, "Ocn import", rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call MOM_RealizeFields(exportState, gridOut, fldsFrOcn_num, fldsFrOcn, "Ocn export", rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_StateGet(exportState, itemSearch="sea_surface_temperature", itemCount=icount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! Do sst initialization if it's part of export state + if(icount /= 0) then + call ESMF_StateGet(exportState, itemName='sea_surface_temperature', field=field_t_surf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_FieldGet(field_t_surf, localDe=0, farrayPtr=t_surf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'mask', ofld, isc, jsc) + + lbnd1 = lbound(t_surf,1) + ubnd1 = ubound(t_surf,1) + lbnd2 = lbound(t_surf,2) + ubnd2 = ubound(t_surf,2) + + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + if (ofld(i1,j1) == 0.) t_surf(i,j) = 0.0 + enddo + enddo + + deallocate(ofld) + endif + +! tcraig, turn this off for now, have issues with overwriting failures +! call NUOPC_Write(exportState, fileNamePrefix='init_field_ocn_export_', & +! timeslice=1, relaxedFlag=.true., rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out + + write(*,*) '----- MOM initialization phase Realize completed' + + end subroutine InitializeRealize + + !> Called by NUOPC to advance the model a single timestep. + !! + !! @param gcomp an ESMF_GridComp object + !! @param rc return code + subroutine ModelAdvance(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_State) :: importState, exportState + type(ESMF_Time) :: currTime + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Time) :: startTime + type(ESMF_TimeInterval) :: time_elapsed + integer(ESMF_KIND_I8) :: n_interval, time_elapsed_sec + character(len=64) :: timestamp + + type (ocean_public_type), pointer :: Ocean_sfc => NULL() + type (ocean_state_type), pointer :: Ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + + ! define some time types + type(time_type) :: Time + type(time_type) :: Time_step_coupled + type(time_type) :: Time_restart_current + + integer :: dth, dtm, dts, dt_cpld = 86400 + integer :: isc,iec,jsc,jec,lbnd1,ubnd1,lbnd2,ubnd2 + integer :: i,j,i1,j1 + real(ESMF_KIND_R8), allocatable :: ofld(:,:), ocz(:,:), ocm(:,:) + real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) + integer :: nc + real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_mmmf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_mzmf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ocz(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ocm(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) + type(ocean_grid_type), pointer :: Ocean_grid + character(240) :: msgString + character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' + + rc = ESMF_SUCCESS + if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") + + ! query the Component for its clock, importState and exportState + call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & + exportState=exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr + Ocean_sfc => ocean_internalstate%ptr%ocean_public_type_ptr + Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + + ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep + + call ESMF_ClockPrint(clock, options="currTime", & + preString="------>Advancing OCN from: ", unit=msgString, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(clock, startTime=startTime, currTime=currTime, & + timeStep=timeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_TimePrint(currTime + timeStep, & + preString="--------------------------------> to: ", & + unit=msgString, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_TimeIntervalGet(timeStep, h=dth, m=dtm, s=dts, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Time = esmf2fms_time(currTime) + Time_step_coupled = esmf2fms_time(timeStep) + dt_cpld = dth*3600+dtm*60+dts + + call ice_ocn_bnd_from_data(Ice_ocean_boundary, Time, Time_step_coupled) + + call external_coupler_sbc_before(Ice_ocean_boundary, Ocean_sfc, nc, dt_cpld ) + + if(write_diagnostics) then + call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', & + timeslice=import_slice, relaxedFlag=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + import_slice = import_slice + 1 + endif + + ! rotate the lat/lon wind vector (CW) onto local tripolar coordinate system + + call mpp_get_compute_domain(Ocean_sfc%domain, isc, iec, jsc, jec) + + if(.not. ocean_solo) then + call State_getFldPtr(exportState,'ocean_mask',dataPtr_mask,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr_mask,1) + ubnd1 = ubound(dataPtr_mask,1) + lbnd2 = lbound(dataPtr_mask,2) + ubnd2 = ubound(dataPtr_mask,2) + +#ifdef MOM5_CAP + call get_ocean_grid(Ocean_grid) +#endif +#ifdef MOM6_CAP + Ocean_grid => ocean_internalstate%ptr%ocean_grid_ptr +#endif + + call State_getFldPtr(importState,'mean_zonal_moment_flx',dataPtr_mzmf,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,'mean_merid_moment_flx',dataPtr_mmmf,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,'mean_evap_rate',dataPtr_evap,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,'mean_sensi_heat_flx',dataPtr_sensi,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + dataPtr_evap = - dataPtr_evap + dataPtr_sensi = - dataPtr_sensi + + allocate(mzmf(lbnd1:ubnd1,lbnd2:ubnd2)) + allocate(mmmf(lbnd1:ubnd1,lbnd2:ubnd2)) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc ! work around local vs global indexing + i1 = i - lbnd1 + isc + mzmf(i,j) = Ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & + + Ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) + mmmf(i,j) = Ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & + - Ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) + enddo + enddo + dataPtr_mzmf = mzmf + dataPtr_mmmf = mmmf + deallocate(mzmf, mmmf) + endif ! not ocean_solo + + !Optionally write restart files when currTime-startTime is integer multiples of restart_interval + if(restart_interval > 0 ) then + time_elapsed = currTime - startTime + call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + n_interval = time_elapsed_sec / restart_interval + if((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then + time_restart_current = esmf2fms_time(currTime) + timestamp = date_to_string(time_restart_current) + call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=dbrc) + write(*,*) 'calling ocean_model_restart' + call ocean_model_restart(Ocean_state, timestamp) + endif + endif + + if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") + call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_sfc, Time, Time_step_coupled) + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") + + if(.not. ocean_solo) then + allocate(ofld(isc:iec,jsc:jec)) + + call ocean_model_data_get(Ocean_state, Ocean_sfc, 'mask', ofld, isc, jsc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_mask(i,j) = nint(ofld(i1,j1)) + enddo + enddo + deallocate(ofld) + + ! Now rotate ocn current from tripolar grid back to lat/lon grid (CCW) + allocate(ocz(lbnd1:ubnd1,lbnd2:ubnd2)) + allocate(ocm(lbnd1:ubnd1,lbnd2:ubnd2)) + + call State_getFldPtr(exportState,'ocn_current_zonal',dataPtr_ocz,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'ocn_current_merid',dataPtr_ocm,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling + + ocz = dataPtr_ocz + ocm = dataPtr_ocm + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc ! work around local vs global indexing + i1 = i - lbnd1 + isc + dataPtr_ocz(i,j) = Ocean_grid%cos_rot(i1,j1)*ocz(i,j) & + - Ocean_grid%sin_rot(i1,j1)*ocm(i,j) + dataPtr_ocm(i,j) = Ocean_grid%cos_rot(i1,j1)*ocm(i,j) & + + Ocean_grid%sin_rot(i1,j1)*ocz(i,j) + enddo + enddo + deallocate(ocz, ocm) + endif ! not ocean_solo + + call ESMF_LogWrite("Before writing diagnostics", ESMF_LOGMSG_INFO, rc=rc) + if(write_diagnostics) then + call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & + timeslice=export_slice, relaxedFlag=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + export_slice = export_slice + 1 + endif + + call ESMF_LogWrite("Before calling sbc forcing", ESMF_LOGMSG_INFO, rc=rc) + call external_coupler_sbc_after(Ice_ocean_boundary, Ocean_sfc, nc, dt_cpld ) + + call ESMF_LogWrite("Before dumpMomInternal", ESMF_LOGMSG_INFO, rc=rc) + !write(*,*) 'MOM: --- run phase called ---' + call dumpMomInternal(mom_grid_i, import_slice, "mean_zonal_moment_flx", "will provide", Ice_ocean_boundary%u_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_merid_moment_flx", "will provide", Ice_ocean_boundary%v_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_sensi_heat_flx" , "will provide", Ice_ocean_boundary%t_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_evap_rate" , "will provide", Ice_ocean_boundary%q_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_salt_rate" , "will provide", Ice_ocean_boundary%salt_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_lw_flx" , "will provide", Ice_ocean_boundary%lw_flux ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dir_flx", "will provide", Ice_ocean_boundary%sw_flux_vis_dir) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dif_flx", "will provide", Ice_ocean_boundary%sw_flux_vis_dif) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dir_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dir) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dif_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dif) + call dumpMomInternal(mom_grid_i, import_slice, "mean_prec_rate" , "will provide", Ice_ocean_boundary%lprec ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_fprec_rate" , "will provide", Ice_ocean_boundary%fprec ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_rate" , "will provide", Ice_ocean_boundary%runoff ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_rate" , "will provide", Ice_ocean_boundary%calving) + call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_heat_flx" , "will provide", Ice_ocean_boundary%runoff_hflx ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_heat_flx", "will provide", Ice_ocean_boundary%calving_hflx) + call dumpMomInternal(mom_grid_i, import_slice, "inst_pres_height_surface" , "will provide", Ice_ocean_boundary%p ) + call dumpMomInternal(mom_grid_i, import_slice, "mass_of_overlying_sea_ice", "will provide", Ice_ocean_boundary%mi) + +!--------- export fields ------------- + + call dumpMomInternal(mom_grid_i, export_slice, "ocean_mask", "will provide", dataPtr_mask) + call dumpMomInternal(mom_grid_i, export_slice, "sea_surface_temperature", "will provide", Ocean_sfc%t_surf) + call dumpMomInternal(mom_grid_i, export_slice, "s_surf" , "will provide", Ocean_sfc%s_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_zonal", "will provide", Ocean_sfc%u_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_merid", "will provide", Ocean_sfc%v_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "sea_lev" , "will provide", Ocean_sfc%sea_lev) + + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") + + end subroutine ModelAdvance + + !> Called by NUOPC at the end of the run to clean up. + !! + !! @param gcomp an ESMF_GridComp object + !! @param rc return code + subroutine ocean_model_finalize(gcomp, rc) + + ! input arguments + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type (ocean_public_type), pointer :: Ocean_sfc + type (ocean_state_type), pointer :: Ocean_state + type(ocean_internalstate_wrapper) :: ocean_internalstate + type(TIME_TYPE) :: Time + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currTime + character(len=64) :: timestamp + character(len=*),parameter :: subname='(mom_cap:ocean_model_finalize)' + + write(*,*) 'MOM: --- finalize called ---' + rc = ESMF_SUCCESS + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Ocean_sfc => ocean_internalstate%ptr%ocean_public_type_ptr + Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + + call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(clock, currTime=currTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + Time = esmf2fms_time(currTime) + + call ocean_model_end (Ocean_sfc, Ocean_State, Time) + call diag_manager_end(Time ) + call field_manager_end + + call fms_io_exit + call fms_end + + write(*,*) 'MOM: --- completed ---' + + end subroutine ocean_model_finalize + +!==================================================================== +! get forcing data from data_overide + subroutine ice_ocn_bnd_from_data(x, Time, Time_step_coupled) + + type (ice_ocean_boundary_type) :: x + type(Time_type), intent(in) :: Time, Time_step_coupled + + type(Time_type) :: Time_next + character(len=*),parameter :: subname='(mom_cap:ice_ocn_bnd_from_data)' + + Time_next = Time + Time_step_coupled + + !call data_override('OCN', 't_flux', x%t_flux , Time_next) + !call data_override('OCN', 'u_flux', x%u_flux , Time_next) + !call data_override('OCN', 'v_flux', x%v_flux , Time_next) + !call data_override('OCN', 'q_flux', x%q_flux , Time_next) + !call data_override('OCN', 'salt_flux', x%salt_flux , Time_next) + !call data_override('OCN', 'lw_flux', x%lw_flux , Time_next) + !call data_override('OCN', 'sw_flux_vis_dir', x%sw_flux_vis_dir, Time_next) + !call data_override('OCN', 'sw_flux_vis_dif', x%sw_flux_vis_dif, Time_next) + !call data_override('OCN', 'sw_flux_nir_dir', x%sw_flux_nir_dir, Time_next) + !call data_override('OCN', 'sw_flux_nir_dif', x%sw_flux_nir_dif, Time_next) + !call data_override('OCN', 'lprec', x%lprec , Time_next) + !call data_override('OCN', 'fprec', x%fprec , Time_next) + !call data_override('OCN', 'runoff', x%runoff , Time_next) + !call data_override('OCN', 'calving', x%calving , Time_next) + !call data_override('OCN', 'p', x%p , Time_next) + + end subroutine ice_ocn_bnd_from_data + + +!----------------------------------------------------------------------------------------- +! +! Subroutines for enabling coupling to external programs through a third party coupler +! such as OASIS/PRISM. +! If no external coupler then these will mostly be dummy routines. +! These routines can also serve as spots to call other user defined routines +!----------------------------------------------------------------------------------------- + +!----------------------------------------------------------------------------------------- + +! Dummy subroutines. + + subroutine external_coupler_mpi_init(mom_local_communicator, external_initialization) + implicit none + integer, intent(out) :: mom_local_communicator + logical, intent(out) :: external_initialization + external_initialization = .false. + mom_local_communicator = -100 ! Is there mpp_undefined parameter corresponding to MPI_UNDEFINED? + ! probably wouldn't need logical flag. + return + end subroutine external_coupler_mpi_init + +!----------------------------------------------------------------------------------------- + subroutine external_coupler_sbc_init(Dom, dt_cpld, Run_len) + implicit none + type(domain2d) :: Dom + integer :: dt_cpld + type(time_type) :: Run_len + return + end subroutine external_coupler_sbc_init + + subroutine external_coupler_sbc_before(Ice_ocean_boundary, Ocean_sfc, nsteps, dt_cpld ) + implicit none + type (ice_ocean_boundary_type), intent(INOUT) :: Ice_ocean_boundary + type (ocean_public_type) , intent(INOUT) :: Ocean_sfc + integer , intent(IN) :: nsteps, dt_cpld + return + end subroutine external_coupler_sbc_before + + + subroutine external_coupler_sbc_after(Ice_ocean_boundary, Ocean_sfc, nsteps, dt_cpld ) + type (ice_ocean_boundary_type) :: Ice_ocean_boundary + type (ocean_public_type) :: Ocean_sfc + integer :: nsteps, dt_cpld + return + end subroutine external_coupler_sbc_after + + subroutine external_coupler_restart( dt_cpld, num_cpld_calls ) + implicit none + integer, intent(in) :: dt_cpld, num_cpld_calls + return + end subroutine external_coupler_restart + + subroutine external_coupler_exit + return + end subroutine external_coupler_exit + +!----------------------------------------------------------------------------------------- + subroutine external_coupler_mpi_exit(mom_local_communicator, external_initialization) + implicit none + integer, intent(in) :: mom_local_communicator + logical, intent(in) :: external_initialization + return + end subroutine external_coupler_mpi_exit +!----------------------------------------------------------------------------------------- + subroutine writeSliceFields(state, filename_prefix, slice, rc) + type(ESMF_State) :: state + character(len=*) :: filename_prefix + integer :: slice + integer, intent(out), optional :: rc + + integer :: n, nfields + type(ESMF_Field) :: field + type(ESMF_StateItem_Flag) :: itemType + character(len=40) :: fileName + character(len=64),allocatable :: fieldNameList(:) + character(len=*),parameter :: subname='(mom_cap:writeSliceFields)' + + if (present(rc)) rc = ESMF_SUCCESS + + if (ESMF_IO_PIO_PRESENT .and. & + (ESMF_IO_NETCDF_PRESENT .or. ESMF_IO_PNETCDF_PRESENT)) then + + call ESMF_StateGet(state, itemCount=nfields, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + allocate(fieldNameList(nfields)) + call ESMF_StateGet(state, itemNameList=fieldNameList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + do n=1, size(fieldNameList) + call ESMF_StateGet(state, itemName=fieldNameList(n), & + itemType=itemType, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (itemType /= ESMF_STATEITEM_NOTFOUND) then + ! field is available in the state + call ESMF_StateGet(state, itemName=fieldNameList(n), field=field, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ! -> output to file + write (fileName,"(A)") & + filename_prefix//trim(fieldNameList(n))//".nc" + call ESMF_FieldWrite(field, fileName=trim(fileName), & + timeslice=slice, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + endif + enddo + + deallocate(fieldNameList) + + endif + + end subroutine writeSliceFields + + !----------------------------------------------------------------------------- + + subroutine State_GetFldPtr(ST, fldname, fldptr, rc) + type(ESMF_State), intent(in) :: ST + character(len=*), intent(in) :: fldname + real(ESMF_KIND_R8), pointer, intent(in) :: fldptr(:,:) + integer, intent(out), optional :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrc + character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' + + call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (present(rc)) rc = lrc + + end subroutine State_GetFldPtr + + !----------------------------------------------------------------------------- + subroutine MOM_AdvertiseFields(state, nfields, field_defs, rc) + + type(ESMF_State), intent(inout) :: state + integer,intent(in) :: nfields + type(fld_list_type), intent(inout) :: field_defs(:) + integer, intent(inout) :: rc + + integer :: i + character(len=*),parameter :: subname='(mom_cap:MOM_AdvertiseFields)' + + rc = ESMF_SUCCESS + + do i = 1, nfields + + call NUOPC_Advertise(state, & + standardName=field_defs(i)%stdname, & + name=field_defs(i)%shortname, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + enddo + + end subroutine MOM_AdvertiseFields + + !----------------------------------------------------------------------------- + + subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) + + type(ESMF_State), intent(inout) :: state + type(ESMF_Grid), intent(in) :: grid + integer, intent(in) :: nfields + type(fld_list_type), intent(inout) :: field_defs(:) + character(len=*), intent(in) :: tag + integer, intent(inout) :: rc + + integer :: i + type(ESMF_Field) :: field + integer :: npet, nx, ny, pet, elb(2), eub(2), clb(2), cub(2), tlb(2), tub(2) + type(ESMF_VM) :: vm + character(len=*),parameter :: subname='(mom_cap:MOM_RealizeFields)' + + rc = ESMF_SUCCESS + + do i = 1, nfields + + if (field_defs(i)%assoc) then + write(tmpstr, *) subname, tag, ' Field ', field_defs(i)%shortname, ':', & + lbound(field_defs(i)%farrayPtr,1), ubound(field_defs(i)%farrayPtr,1), & + lbound(field_defs(i)%farrayPtr,2), ubound(field_defs(i)%farrayPtr,2) + call ESMF_LogWrite(tmpstr, ESMF_LOGMSG_INFO, rc=dbrc) + field = ESMF_FieldCreate(grid=grid, & + farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & +! farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + if (NUOPC_IsConnected(state, fieldName=field_defs(i)%shortname)) then + call NUOPC_Realize(state, field=field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite(subname // tag // " Field "// field_defs(i)%stdname // " is connected.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=dbrc) +! call ESMF_FieldPrint(field=field, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out + else + call ESMF_LogWrite(subname // tag // " Field "// field_defs(i)%stdname // " is not connected.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=dbrc) + ! TODO: Initialize the value in the pointer to 0 after proper restart is setup + !if(associated(field_defs(i)%farrayPtr) ) field_defs(i)%farrayPtr = 0.0 + ! remove a not connected Field from State + call ESMF_StateRemove(state, (/field_defs(i)%shortname/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + enddo + + end subroutine MOM_RealizeFields + + !----------------------------------------------------------------------------- + + subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_sfc) + type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary + type(ocean_public_type), intent(in) :: Ocean_sfc + +#ifdef CESMCOUPLED +! type (shr_nuopc_fldList_Type) :: fldsList +#endif + + character(len=*),parameter :: subname='(mom_cap:MOM_FieldsSetup)' + + !!! fld_list_add(num, fldlist, stdname, transferOffer, data(optional), shortname(optional)) + +#ifdef CESMCOUPLED + +! WARNING tcx tcraig +! tcraig this is just a starting point, the fields are not complete or correct here + + !-------------------------------- + ! create import fields list + !-------------------------------- + +! call shr_nuopc_fldList_Zero(fldsList, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + +! call shr_nuopc_fldList_fromflds(fldsList, flds_x2o, flds_x2o_map, "will provide", subname//":flds_x2o", rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + +! call shr_nuopc_fldList_Add(fldsList, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + ! convert to fldsToOcn + + !-------------------------------- + ! create export fields list + !-------------------------------- + +! call shr_nuopc_fldList_Zero(fldsList, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + +! call shr_nuopc_fldList_fromflds(fldsList, flds_o2x, flds_o2x_map, "will provide", subname//":flds_o2x", rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + +! call shr_nuopc_fldList_Add(fldsList, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + +! WARNING tcx tcraig +! tcraig this is just a starting point, the fields are not complete or correct here +! tcraig we will need to figure out whether to adjust the mediator coupling fields for mom or vv or a bit of both + + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide", data=Ice_ocean_boundary%u_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide", data=Ice_ocean_boundary%v_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide", data=Ice_ocean_boundary%t_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide", data=Ice_ocean_boundary%q_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_salt" , "will provide", data=Ice_ocean_boundary%salt_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwdn" , "will provide", data=Ice_ocean_boundary%lw_flux ) +! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dir) +! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dif) +! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swidr", "will provide", data=Ice_ocean_boundary%sw_flux_nir_dir) +! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swidf", "will provide", data=Ice_ocean_boundary%sw_flux_nir_dif) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rain" , "will provide", data=Ice_ocean_boundary%lprec ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_snow" , "will provide", data=Ice_ocean_boundary%fprec ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide", data=Ice_ocean_boundary%runoff ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_meltw", "will provide", data=Ice_ocean_boundary%calving) +! call fld_list_add(fldsToOcn_num, fldsToOcn, "runoff_heat_flux" , "will provide", data=Ice_ocean_boundary%runoff_hflx ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_melth", "will provide", data=Ice_ocean_boundary%calving_hflx) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide", data=Ice_ocean_boundary%p ) +! call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice", "will provide", data=Ice_ocean_boundary%mi) + +!--------- export fields ------------- + + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask", "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t", "will provide", data=Ocean_sfc%t_surf) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide", data=Ocean_sfc%s_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u", "will provide", data=Ocean_sfc%u_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v", "will provide", data=Ocean_sfc%v_surf ) +! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir", "will provide") +! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir", "will provide") +! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=Ocean_sfc%sea_lev) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide", data=Ocean_sfc%frazil) + + +#else +!--------- import fields ------------- + +! tcraig, don't point directly into mom data YET (last field is optional in interface) +! instead, create space for the field when it's "realized". + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx", "will provide", data=Ice_ocean_boundary%u_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx", "will provide", data=Ice_ocean_boundary%v_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide", data=Ice_ocean_boundary%t_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide", data=Ice_ocean_boundary%q_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide", data=Ice_ocean_boundary%salt_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide", data=Ice_ocean_boundary%lw_flux ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dir) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dif) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_nir_dir) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_nir_dif) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide", data=Ice_ocean_boundary%lprec ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide", data=Ice_ocean_boundary%fprec ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide", data=Ice_ocean_boundary%runoff ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide", data=Ice_ocean_boundary%calving) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide", data=Ice_ocean_boundary%runoff_hflx ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx", "will provide", data=Ice_ocean_boundary%calving_hflx) + call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide", data=Ice_ocean_boundary%p ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice", "will provide", data=Ice_ocean_boundary%mi) + +!--------- export fields ------------- + + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask", "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature", "will provide", data=Ocean_sfc%t_surf) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide", data=Ocean_sfc%s_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal", "will provide", data=Ocean_sfc%u_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid", "will provide", data=Ocean_sfc%v_surf ) +! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir", "will provide") +! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir", "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=Ocean_sfc%sea_lev) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=Ocean_sfc%frazil) + +#endif + + end subroutine MOM_FieldsSetup + + !----------------------------------------------------------------------------- + + subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) + ! ---------------------------------------------- + ! Set up a list of field information + ! ---------------------------------------------- + integer, intent(inout) :: num + type(fld_list_type), intent(inout) :: fldlist(:) + character(len=*), intent(in) :: stdname + character(len=*), intent(in) :: transferOffer + real(ESMF_KIND_R8), dimension(:,:), optional, target :: data + character(len=*), intent(in),optional :: shortname + + ! local variables + integer :: rc + character(len=*), parameter :: subname='(mom_cap:fld_list_add)' + + ! fill in the new entry + + num = num + 1 + if (num > fldsMax) then + call ESMF_LogWrite(trim(subname)//": ERROR num gt fldsMax "//trim(stdname), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) + return + endif + + fldlist(num)%stdname = trim(stdname) + if (present(shortname)) then + fldlist(num)%shortname = trim(shortname) + else + fldlist(num)%shortname = trim(stdname) + endif + fldlist(num)%transferOffer = trim(transferOffer) + if (present(data)) then + fldlist(num)%assoc = .true. + fldlist(num)%farrayPtr => data + else + fldlist(num)%assoc = .false. + endif + + end subroutine fld_list_add + + subroutine dumpMomInternal(grid, slice, stdname, nop, farray) + + type(ESMF_Grid) :: grid + integer, intent(in) :: slice + character(len=*) :: stdname + character(len=*) :: nop + real(ESMF_KIND_R8), dimension(:,:), target :: farray + + type(ESMF_Field) :: field + real(ESMF_KIND_R8), dimension(:,:), pointer :: f2d + integer :: rc + +#ifdef MOM6_CAP + return +#endif + + if(.not. write_diagnostics) return ! nop in production mode + if(ocean_solo) return ! do not dump internal fields in ocean solo mode + + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, & + indexflag=ESMF_INDEX_DELOCAL, & + name=stdname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_FieldGet(field, farrayPtr=f2d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + f2d(:,:) = farray(:,:) + + call ESMF_FieldWrite(field, fileName='field_ocn_internal_'//trim(stdname)//'.nc', & + timeslice=slice, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_FieldDestroy(field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end subroutine + +#ifdef MOM6_CAP + subroutine calculate_rot_angle(OS, OSFC, OG) + type(ocean_state_type), intent(in) :: OS + type(ocean_public_type), intent(in) :: OSFC + type(ocean_grid_type), pointer :: OG + + integer :: i,j,ishift,jshift,ilb,iub,jlb,jub + real :: angle, lon_scale + type(ocean_grid_type), pointer :: G + + call get_ocean_grid(OS, G) + + !print *, 'lbound: ', lbound(G%geoLatT), lbound(G%geoLonT), lbound(G%sin_rot) + !print *, 'ubound: ', ubound(G%geoLatT), ubound(G%geoLonT), ubound(G%sin_rot) + + !print *, minval(G%geoLatT), maxval(G%geoLatT) + !print *, minval(G%geoLonT), maxval(G%geoLonT) + !print *, G%isc, G%jsc, G%iec, G%jec + + ! + ! The bounds isc:iec goes from 5-104, isc-ishift:iec-ishift goes from 1:100 + ! + call mpp_get_compute_domain(OSFC%Domain, ilb, iub, jlb, jub) + ishift = ilb-G%isc + jshift = jlb-G%jsc + !print *, 'ilb, iub, jlb, jub', ilb, iub, jlb, jub, ishift, jshift + !print *, 'sizes', iub-ilb, jub-jlb, G%iec-G%isc, G%jec-G%jsc + allocate(OG) + allocate(OG%sin_rot(ilb:iub, jlb:jub)) + allocate(OG%cos_rot(ilb:iub, jlb:jub)) + + ! loop 5-104 + do j=G%jsc,G%jec ; do i=G%isc,G%iec + lon_scale = cos((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J-1 ) + & + G%geoLatBu(I-1,J) + G%geoLatBu(I,J)) * atan(1.0)/180) + angle = atan2((G%geoLonBu(I-1,J) + G%geoLonBu(I,J) - & + G%geoLonBu(I-1,J-1) - G%geoLonBu(I,J-1))*lon_scale, & + G%geoLatBu(I-1,J) + G%geoLatBu(I,J) - & + G%geoLatBu(I-1,J-1) - G%geoLatBu(I,J-1) ) + OG%sin_rot(i+ishift,j+jshift) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean + OG%cos_rot(i+ishift,j+jshift) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) + enddo ; enddo + !print *, minval(OG%sin_rot), maxval(OG%sin_rot) + !print *, minval(OG%cos_rot), maxval(OG%cos_rot) + + end subroutine +#endif + + +end module mom_cap_mod diff --git a/config_src/nuopc_driver/mom_cap.F90.02 b/config_src/nuopc_driver/mom_cap.F90.02 new file mode 100644 index 0000000000..632825be2d --- /dev/null +++ b/config_src/nuopc_driver/mom_cap.F90.02 @@ -0,0 +1,2432 @@ +!> +!! @mainpage MOM NUOPC Cap +!! @author Fei Liu (fei.liu@gmail.com) +!! @date 5/10/13 Original documentation +!! @author Rocky Dunlap (rocky.dunlap@noaa.gov) +!! @date 1/12/17 Moved to doxygen +!! +!! @tableofcontents +!! +!! @section Overview Overview +!! +!! **This MOM cap has been tested with MOM5 and MOM6.** +!! +!! This document describes the MOM "cap", which is a small software layer that is +!! required when the [MOM ocean model] (http://mom-ocean.org/web) +!! is used in [National Unified Operation Prediction Capability] +!! (http://www.earthsystemcog.org/projects/nuopc) (NUOPC) coupled systems. +!! The NUOPC Layer is a software layer built on top of the [Earth System Modeling +!! Framework] (https://www.earthsystemcog.org/projects/esmf) (ESMF). +!! ESMF is a high-performance modeling framework that provides +!! data structures, interfaces, and operations suited for building coupled models +!! from a set of components. NUOPC refines the capabilities of ESMF by providing +!! a more precise definition of what it means for a model to be a component and +!! how components should interact and share data in a coupled system. The NUOPC +!! Layer software is designed to work with typical high-performance models in the +!! Earth sciences domain, most of which are written in Fortran and are based on a +!! distributed memory model of parallelism (MPI). +!! A NUOPC "cap" is a Fortran module that serves as the interface to a model +!! when it's used in a NUOPC-based coupled system. +!! The term "cap" is used because it is a small software layer that sits on top +!! of model code, making calls into it and exposing model data structures in a +!! standard way. For more information about creating NUOPC caps in general, please +!! see the [Building a NUOPC Model] +!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_howtodoc/) +!! how-to document. +!! +!! The MOM cap package includes the cap itself (mom_cap.F90, a Fortran module), a +!! set of time utilities (time_utils.F90) for converting between ESMF and FMS +!! time types, and two makefiles. Also included are self-describing dependency +!! makefile fragments (mom.mk and mom.mk.template), although these can be generated +!! by the makefiles for specific installations of the MOM cap. +!! +!! @subsection CapSubroutines Cap Subroutines +!! +!! The MOM cap Fortran module contains a set of subroutines that are required +!! by NUOPC. These subroutines are called by the NUOPC infrastructure according +!! to a predefined calling sequence. Some subroutines are called during +!! initialization of the coupled system, some during the run of the coupled +!! system, and some during finalization of the coupled system. The initialization +!! sequence is the most complex and is governed by the NUOPC technical rules. +!! Details about the initialization sequence can be found in the [NUOPC Reference Manual] +!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html#SECTION00034000000000000000). +!! +!! A particularly important part of the NUOPC intialization sequence is to establish +!! field connections between models. Simply put, a field connection is established +!! when a field output by one model can be consumed by another. As an example, the +!! MOM model is able to accept a precipitation rate when coupled to an atmosphere +!! model. In this case a field connection will be established between the precipitation +!! rate exported from the atmosphere and the precipitation rate imported into the +!! MOM model. Because models may uses different variable names for physical +!! quantities, NUOPC relies on a set of standard names and a built-in, extensible +!! standard name dictionary to match fields between models. More information about +!! the use of standard names can be found in the [NUOPC Reference Manual] +!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html#SECTION00032000000000000000). +!! +!! Two key initialization phases that appear in every NUOPC cap, including this MOM +!! cap are the field "advertise" and field "realize" phases. *Advertise* is a special +!! NUOPC term that refers to a model participating in a coupled system +!! providing a list of standard names of required import fields and available export +!! fields. In other words, each model will advertise to the other models which physical fields +!! it needs and which fields it can provide when coupled. NUOPC compares all of the advertised +!! standard names and creates a set of unidirectional links, each from one export field +!! in a model to one import field in another model. When these connections have been established, +!! all models in the coupled system need to provide a description of their geographic +!! grid (e.g., lat-lon, tri-polar, cubed sphere, etc.) and allocate their connected +!! fields on that grid. In NUOPC terms, this is refered to as *realizing* a set of +!! fields. NUOPC relies on ESMF data types for this, such as the [ESMF_Grid] +!! (http://www.earthsystemmodeling.org/esmf_releases/public/last/ESMF_refdoc/node5.html#SECTION05080000000000000000) +!! type, which describes logically rectangular grids and the [ESMF_Field] +!! (http://www.earthsystemmodeling.org/esmf_releases/public/last/ESMF_refdoc/node5.html#SECTION05030000000000000000) +!! type, which wraps a models data arrays and provides basic metadata. Because ESMF supports +!! interpolation between different grids (sometimes called "regridding" or "grid remapping"), +!! it is not necessary that models share a grid. As you will see below +!! the *advertise* and *realize* phases each have a subroutine in the HYCOM cap. +!! +!! The following table summarizes the NUOPC-required subroutines that appear in the +!! MOM cap. The "Phase" column says whether the subroutine is called during the +!! initialization, run, or finalize part of the coupled system run. +!! +!! Phase | MOM Cap Subroutine | Description +!! ---------|--------------------------------------------------------------------|------------------------------------------------------------- +!! Init | [InitializeP0] (@ref mom_cap_mod::initializep0) | Sets the Initialize Phase Definition (IPD) version to use +!! Init | [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) | Advertises standard names of import and export fields +!! Init | [InitializeRealize] (@ref mom_cap_mod::initializerealize) | Creates an ESMF_Grid for the MOM grid as well as ESMF_Fields for import and export fields +!! Run | [ModelAdvance] (@ref mom_cap_mod::modeladvance) | Advances the model by a timestep +!! Final | [Finalize] (@ref mom_cap_mod::ocean_model_finalize) | Cleans up +!! +!! @section UnderlyingModelInterfaces Underlying Model Interfaces +!! +!! +!! @subsection DomainCreation Domain Creation +!! +!! The MOM tripolar grid is represented as a 2D `ESMF_Grid` and coupling fields are placed +!! on this grid. Calls related to creating the grid are located in the [InitializeRealize] +!! (@ref mom_cap_mod::initializerealize) subroutine, which is called by the NUOPC infrastructure +!! during the intialization sequence. +!! +!! The cap determines parameters for setting up the grid by calling subroutines in the +!! `mpp_domains_mod` module. The global domain size is determined by calling `mpp_get_global_domain()`. +!! A check is in place to ensure that there is only a single tile in the domain (the +!! cap is currently limited to one tile; multi-tile mosaics are not supported). The +!! decomposition across processors is determined via calls to `mpp_get_compute_domains()` +!! (to retrieve decomposition block indices) and `mpp_get_pelist()` (to determine how +!! blocks are assigned to processors). +!! +!! The grid is created in several steps: +!! - an `ESMF_DELayout` is created based on the pelist from MOM +!! - an `ESMF_DistGrid` is created over the global index space. Connections are set +!! up so that the index space is periodic in the first dimension and has a +!! fold at the top for the bipole. The decompostion blocks are also passed in +!! along with the `ESMF_DELayout` mentioned above. +!! - an `ESMF_Grid` is then created by passing in the above `ESMF_DistGrid`. +!! +!! Masks, areas, center (tlat, tlon), and corner (ulat, ulon) coordinates are then added to the `ESMF_Grid` +!! by retrieving those fields from MOM with calls to `ocean_model_data_get()`. +!! +!! @subsection Initialization Initialization +!! +!! During the [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) phase, calls are +!! made to MOM's native initialization subroutines, including `fms_init()`, `constants_init()`, +!! `field_manager_init()`, `diag_manager_init()`, and `set_calendar_type()`. The MPI communicator +!! is pulled in through the ESMF VM object for the MOM component. The dt and start time are set +!! from parameters from the incoming ESMF clock with calls to `set_time()` and `set_date().` +!! +!! +!! @subsection Run Run +!! +!! The [ModelAdvance] (@ref mom_cap_mod::modeladvance) subroutine is called by the NUOPC +!! infrastructure when it's time for MOM to advance in time. During this subroutine, there is a +!! call into the MOM update routine: +!! +!! call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_public, Time, Time_step_coupled) +!! +!! Prior to this call, the cap performs a few steps: +!! - the `Time` and `Time_step_coupled` parameters, which are based on FMS types, are derived from the incoming ESMF clock +!! - there are calls to two stubs: `ice_ocn_bnd_from_data()` and `external_coupler_sbc_before()` - these are currently +!! inactive, but may be modified to read in import data from file or from an external coupler +!! - diagnostics are optionally written to files `field_ocn_import_*`, one for each import field +!! - import fields are prepared: +!! - the sign is reversed on `mean_evap_rate` and `mean_sensi_heat_flux` +!! - momentum flux vectors are rotated to internal grid +!! - optionally, a call is made to `ocean_model_restart()` at the interval `restart_interval` +!! +!! After the call to `update_ocean_model()`, the cap performs these steps: +!! - the `ocean_mask` export is set to match that of the internal MOM mask +!! - the `freezing_melting_potential` export is converted from J m-2 to W m-2 by dividing by the coupling interval +!! - vector rotations are applied to the `ocean_current_zonal` and `ocean_current_merid` exports, back to lat-lon grid +!! - diagnostics are optionally written to files `field_ocn_export_*`, one for each export field +!! - a call is made to `external_coupler_sbc_after()` to update exports from an external coupler (currently an inactive stub) +!! - calls are made to `dumpMomInternal()` to write files `field_ocn_internal_*` for all internal fields (both import and export) +!! +!! @subsubsection VectorRotations Vector Rotations +!! +!! Vector rotations are applied to incoming momentum fluxes (from regular lat-lon to tripolar grid) and +!! outgoing ocean currents (from tripolar to regular lat-lon). The rotation angles are provided +!! from the native MOM grid by a call to `get_ocean_grid(Ocean_grid)`. +!! The cosine and sine of the rotation angle are: +!! +!! Ocean_grid%cos_rot(i,j) +!! Ocean_grid%sin_rot(i,j) +!! +!! The rotation of momentum flux from regular lat-lon to tripolar is: +!! \f[ +!! \begin{bmatrix} +!! \tau_x' \\ +!! \tau_y' +!! \end{bmatrix} = +!! \begin{bmatrix} +!! cos \theta & sin \theta \\ +!! -sin \theta & cos \theta +!! \end{bmatrix} * +!! \begin{bmatrix} +!! \tau_x \\ +!! \tau_y +!! \end{bmatrix} +!! \f] +!! +!! The rotation of ocean current from tripolar to regular lat-lon is: +!! \f[ +!! \begin{bmatrix} +!! u' \\ +!! v' +!! \end{bmatrix} = +!! \begin{bmatrix} +!! cos \theta & -sin \theta \\ +!! sin \theta & cos \theta +!! \end{bmatrix} * +!! \begin{bmatrix} +!! u \\ +!! v +!! \end{bmatrix} +!! \f] +!! @subsection Finalization Finalization +!! +!! NUOPC infrastructure calls [ocean_model_finalize] (@ref mom_cap_mod::ocean_model_finalize) +!! at the end of the run. This subroutine is a hook to call into MOM's native shutdown +!! procedures: +!! +!! call ocean_model_end (Ocean_public, Ocean_State, Time) +!! call diag_manager_end(Time ) +!! call field_manager_end +!! call fms_io_exit +!! call fms_end +!! +!! @section ModelFields Model Fields +!! +!! The following tables list the import and export fields currently set up in the MOM cap. +!! +!! @subsection ImportFields Import Fields +!! +!! Standard Name | Units | Model Variable | Description | Notes +!! ----------------------------------|------------|-----------------|-----------------------------------------------|-------------------------------------- +!! inst_pres_height_surface | Pa | p | pressure of overlying sea ice and atmosphere | | +!! mass_of_overlying_sea_ice | kg | mi | mass of overlying sea ice | | +!! mean_calving_heat_flx | W m-2 | calving_hflx | heat flux, relative to 0C, of frozen land water into ocean | | +!! mean_calving_rate | kg m-2 s-1 | calving | mass flux of frozen runoff | | +!! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | sign reversed (- evap) +!! mean_fprec_rate | kg m-2 s-1 | fprec | mass flux of frozen precip | | +!! mean_merid_moment_flx | Pa | v_flux | j-directed wind stress into ocean | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar +!! mean_net_lw_flx | W m-2 | lw_flux | long wave radiation | | +!! mean_net_sw_ir_dif_flx | W m-2 | sw_flux_nir_dif | diffuse near IR shortwave radiation | | +!! mean_net_sw_ir_dir_flx | W m-2 | sw_flux_nir_dir | direct near IR shortwave radiation | | +!! mean_net_sw_vis_dif_flx | W m-2 | sw_flux_vis_dif | diffuse visible shortware radiation | | +!! mean_net_sw_vis_dir_flx | W m-2 | sw_flux_vis_dir | direct visible shortware radiation | | +!! mean_prec_rate | kg m-2 s-1 | lprec | mass flux of liquid precip | | +!! mean_runoff_heat_flx | W m-2 | runoff_hflx | heat flux, relative to 0C, of liquid land water into ocean | | +!! mean_runoff_rate | kg m-2 s-1 | runoff | mass flux of liquid runoff | | +!! mean_salt_rate | kg m-2 s-1 | salt_flux | salt flux | | +!! mean_sensi_heat_flx | W m-2 | t_flux | sensible heat flux into ocean | sign reversed (- sensi) +!! mean_zonal_moment_flx | Pa | u_flux | j-directed wind stress into ocean | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar +!! +!! +!! @subsection ExportField Export Fields +!! +!! Export fields are populated from the `ocean_public` parameter (type `ocean_public_type`) +!! after the call to `update_ocean_model()`. +!! +!! Standard Name | Units | Model Variable | Description | Notes +!! ----------------------------------|------------|-----------------|-------------------------------------------|--------------------------------------------------------------------- +!! freezing_melting_potential | W m-2 | frazil | accumulated heating from frazil formation | cap converts model units (J m-2) to (W m-2) for export +!! ocean_mask | | | ocean mask | | +!! ocn_current_merid | m s-1 | v_surf | j-directed surface velocity on u-cell | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon +!! ocn_current_zonal | m s-1 | u_surf | i-directed surface velocity on u-cell | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon +!! s_surf | psu | s_surf | sea surface salinity on t-cell | | +!! sea_lev | m | sea_lev | sea level | model computation is eta_t + patm/(rho0*grav) - eta_geoid - eta_tide +!! sea_surface_temperature | K | t_surf | sea surface temperature on t-cell | | +!! +!! @subsection MemoryManagement Memory Management +!! +!! The MOM cap has an internal state type with pointers to three +!! types defined by MOM. There is also a small wrapper derived type +!! required to associate an internal state instance +!! with the ESMF/NUOPC component: +!! +!! type ocean_internalstate_type +!! type(ocean_public_type), pointer :: ocean_public_type_ptr +!! type(ocean_state_type), pointer :: ocean_state_type_ptr +!! type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr +!! end type +!! +!! type ocean_internalstate_wrapper +!! type(ocean_internalstate_type), pointer :: ptr +!! end type +!! +!! The member of type `ocean_public_type` stores ocean surface fields used during the coupling. +!! The member of type `ocean_state_type` is required by the ocean driver, +!! although its internals are private (not to be used by the coupling directly). +!! This type is passed to the ocean init and update routines +!! so that it can maintain state there if desired. +!! The member of type `ice_ocean_boundary_type` is populated by this cap +!! with incoming coupling fields from other components. These three derived types are allocated during the +!! [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) phase. Also during that +!! phase, the `ice_ocean_boundary` type members are all allocated using bounds retrieved +!! from `mpp_get_compute_domain()`. +!! +!! During the [InitializeRealize] (@ref mom_cap_mod::initializerealize) phase, +!! `ESMF_Field`s are created for each of the coupling fields in the `ice_ocean_boundary` +!! and `ocean_public_type` members of the internal state. These fields directly reference into the members of +!! the `ice_ocean_boundary` and `ocean_public_type` so that memory-to-memory copies are not required to move +!! data from the cap's import and export states to the memory areas used internally +!! by MOM. +!! +!! @subsection IO I/O +!! +!! The cap can optionally output coupling fields for diagnostic purposes if the ESMF attribute +!! "DumpFields" has been set to "true". In this case the cap will write out NetCDF files +!! with names "field_ocn_import_.nc" and "field_ocn_export_.nc". +!! Additionally, calls will be made to the cap subroutine [dumpMomInternal] +!! (@ref mom_cap_mod::dumpmominternal) to write out model internal fields to files +!! named "field_ocn_internal_.nc". In all cases these NetCDF files will +!! contain a time series of field data. +!! +!! @section BuildingAndInstalling Building and Installing +!! +!! There are two makefiles included with the MOM cap, makefile and makefile.nuopc. +!! The makefile.nuopc file is intended to be used within another build system, such +!! as the NEMSAppBuilder. The regular makefile can be used generally for building +!! and installing the cap. Two variables must be customized at the top: +!! - `INSTALLDIR` - where to copy the cap library and dependent libraries +!! - `NEMSMOMDIR` - location of the MOM library and FMS library +!! +!! To install run: +!! $ make install +!! +!! A makefile fragment, mom.mk, will also be copied into the directory. The fragment +!! defines several variables that can be used by another build system to include the +!! MOM cap and its dependencies. +!! +!! @subsection Dependencies Dependencies +!! +!! The MOM cap is dependent on the MOM library itself (lib_ocean.a) and the FMS +!! library (lib_FMS.a). +!! +!! @section RuntimeConfiguration Runtime Configuration +!! +!! At runtime, the MOM cap can be configured with several options provided +!! as ESMF attributes. Attributes can be set in the cap by the NUOPC Driver +!! above this cap, or in some systems (e.g., NEMS) attributes are set by +!! reading in from a configuration file. The available attributes are: +!! +!! * `DumpFields` - when set to "true", write out diagnostic NetCDF files for import/export/internal fields +!! * `ProfileMemory` - when set to "true", write out memory usage information to the ESMF log files; this +!! information is written when entering and leaving the [ModelAdvance] +!! (@ref mom_cap_mod::modeladvance) subroutine and before and after the call to +!! `update_ocean_model()`. +!! * `OceanSolo` - when set to "true", this option indicates that MOM is being run +!! uncoupled; in this case the vector rotations and other data manipulations +!! on import fields are skipped +!! * `restart_interval` - integer number of seconds indicating the interval at +!! which to call `ocean_model_restart()`; no restarts written if set to 0 +!! * `GridAttachArea` - when set to "true", this option indicates that MOM grid attaches cell area +!! using internal values computed in MOM. The default value is "false", grid cell area will +!! be computed in ESMF. +!! +!! +!! @section Repository +!! The MOM NUOPC cap is maintained in a GitHub repository: +!! https://github.com/feiliuesmf/nems_mom_cap +!! +!! @section References +!! +!! - [MOM Home Page] (http://mom-ocean.org/web) +!! +!! +module mom_cap_mod + use constants_mod, only: constants_init + use data_override_mod, only: data_override_init, data_override + use diag_manager_mod, only: diag_manager_init, diag_manager_end + use field_manager_mod, only: field_manager_init, field_manager_end + use fms_mod, only: fms_init, fms_end, open_namelist_file, check_nml_error + use fms_mod, only: close_file, file_exist, uppercase + use fms_io_mod, only: fms_io_exit + use mpp_domains_mod, only: domain2d, mpp_get_compute_domain, mpp_get_compute_domains + use mpp_domains_mod, only: mpp_get_ntile_count, mpp_get_pelist, mpp_get_global_domain + use mpp_domains_mod, only: mpp_get_domain_npes, mpp_global_field + use mpp_io_mod, only: mpp_open, MPP_RDONLY, MPP_ASCII, MPP_OVERWR, MPP_APPEND, mpp_close, MPP_SINGLE + use mpp_mod, only: input_nml_file, mpp_error, FATAL, NOTE, mpp_pe, mpp_npes, mpp_set_current_pelist + use mpp_mod, only: stdlog, stdout, mpp_root_pe, mpp_clock_id + use mpp_mod, only: mpp_clock_begin, mpp_clock_end, MPP_CLOCK_SYNC + use mpp_mod, only: MPP_CLOCK_DETAILED, CLOCK_COMPONENT, MAXPES + use time_interp_external_mod, only: time_interp_external_init + use time_manager_mod, only: set_calendar_type, time_type, increment_date + use time_manager_mod, only: set_time, set_date, get_time, get_date, month_name + use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR + use time_manager_mod, only: operator( <= ), operator( < ), operator( >= ) + use time_manager_mod, only: operator( + ), operator( - ), operator( / ) + use time_manager_mod, only: operator( * ), operator( /= ), operator( > ) + use time_manager_mod, only: date_to_string + use time_manager_mod, only: fms_get_calendar_type => get_calendar_type + use MOM_domains, only: MOM_infra_init, num_pes, root_pe, pe_here + +#ifdef CESMCOUPLED + use ocn_comp_nuopc, only: ocean_public_type, ocean_state_type + use ocn_comp_nuopc, only: update_ocean_model, ocean_model_init + use ocn_comp_nuopc, only: ocn_export, get_ocean_grid, ocean_model_data_get + use ocn_comp_nuopc, only: ocean_model_end, ocean_model_init_sfc +#else + use ocean_model_mod, only: ocean_model_restart, ocean_public_type, ocean_state_type + use ocean_model_mod, only: ocean_model_data_get + use ocean_model_mod, only: ocean_model_init , update_ocean_model, ocean_model_end, get_ocean_grid +#endif + use MOM_file_parser, only: get_param, log_version, param_file_type, close_param_file + use MOM_get_input, only: Get_MOM_Input, directories + use MOM_domains, only: pass_var +#ifdef MOM6_CAP + use ocean_model_mod, only: ice_ocean_boundary_type + use MOM_grid, only: ocean_grid_type +#else + use ocean_types_mod, only: ice_ocean_boundary_type, ocean_grid_type +#endif +#ifdef CESMCOUPLED + use shr_nuopc_flds_mod, only: flds_scalar_name + use shr_nuopc_flds_mod, only: flds_x2o, flds_o2x, flds_x2o_map, flds_o2x_map + use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_SetScalarField, shr_nuopc_fldList_type + use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Advertise, shr_nuopc_fldList_Realize + use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Zero, shr_nuopc_fldList_Add + use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_fromflds +#endif + + use ESMF + use NUOPC + use NUOPC_Model, & + model_routine_SS => SetServices, & + model_label_Advance => label_Advance, & + model_label_Finalize => label_Finalize + + use time_utils_mod + + implicit none + private + public SetServices + + type ocean_internalstate_type + type(ocean_public_type), pointer :: ocean_public_type_ptr + type(ocean_state_type), pointer :: ocean_state_type_ptr + type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr + type(ocean_grid_type), pointer :: ocean_grid_ptr + end type + + type ocean_internalstate_wrapper + type(ocean_internalstate_type), pointer :: ptr + end type + +#ifdef CESMCOUPLED + type (shr_nuopc_fldList_Type) :: fldsToOcn + type (shr_nuopc_fldList_Type) :: fldsFrOcn +#else + type fld_list_type + character(len=64) :: stdname + character(len=64) :: shortname + character(len=64) :: transferOffer + logical :: assoc ! is the farrayPtr associated with internal data + real(ESMF_KIND_R8), dimension(:,:), pointer :: farrayPtr + end type fld_list_type + + integer,parameter :: fldsMax = 100 + integer :: fldsToOcn_num = 0 + type (fld_list_type) :: fldsToOcn(fldsMax) + integer :: fldsFrOcn_num = 0 + type (fld_list_type) :: fldsFrOcn(fldsMax) +#endif + + integer :: import_slice = 1 + integer :: export_slice = 1 + character(len=256) :: tmpstr + integer :: dbrc + + type(ESMF_Grid) :: mom_grid_i + logical :: write_diagnostics = .true. + logical :: profile_memory = .true. + logical :: ocean_solo = .true. + logical :: grid_attach_area = .false. + integer(ESMF_KIND_I8) :: restart_interval + logical :: sw_decomp + real(ESMF_KIND_R8) :: c1, c2, c3, c4 + character(len=*),parameter :: u_file_u = __FILE__ + + contains + !----------------------------------------------------------------------- + !------------------- Solo Ocean code starts here ----------------------- + !----------------------------------------------------------------------- + + !> NUOPC SetService method is the only public entry point. + !! SetServices registers all of the user-provided subroutines + !! in the module with the NUOPC layer. + !! + !! @param gcomp an ESMF_GridComp object + !! @param rc return code + subroutine SetServices(gcomp, rc) + + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + character(len=*),parameter :: subname='(mom_cap:SetServices)' + + rc = ESMF_SUCCESS + + ! the NUOPC model component will register the generic methods + call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! switching to IPD versions + call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + userRoutine=InitializeP0, phase=0, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! set entry point for methods that require specific implementation + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv01p1"/), userRoutine=InitializeAdvertise, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv01p3"/), userRoutine=InitializeRealize, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! attach specializing method(s) + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & + specRoutine=ModelAdvance, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & + specRoutine=ocean_model_finalize, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end subroutine SetServices + + !----------------------------------------------------------------------------- + + !> First initialize subroutine called by NUOPC. The purpose + !! is to set which version of the Initialize Phase Definition (IPD) + !! to use. + !! + !! For this MOM cap, we are using IPDv01. + !! + !! @param gcomp an ESMF_GridComp object + !! @param importState an ESMF_State object for import fields + !! @param exportState an ESMF_State object for export fields + !! @param clock an ESMF_Clock object + !! @param rc return code + subroutine InitializeP0(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + character(len=10) :: value + character(len=*),parameter :: subname='(mom_cap:InitializeP0)' + + rc = ESMF_SUCCESS + + ! Switch to IPDv01 by filtering all other phaseMap entries + call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, & + acceptStringList=(/"IPDv01p"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_AttributeGet(gcomp, name="DumpFields", value=value, defaultValue="false", & + convention="NUOPC", purpose="Instance", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write_diagnostics=(trim(value)=="true") + call ESMF_LogWrite('MOM_CAP:DumpFields = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + + call ESMF_AttributeGet(gcomp, name="ProfileMemory", value=value, defaultValue="true", & + convention="NUOPC", purpose="Instance", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + profile_memory=(trim(value)/="false") + call ESMF_LogWrite('MOM_CAP:ProfileMemory = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + + call ESMF_AttributeGet(gcomp, name="OceanSolo", value=value, defaultValue="false", & + convention="NUOPC", purpose="Instance", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ocean_solo=(trim(value)=="true") + call ESMF_LogWrite('MOM_CAP:OceanSolo = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + + ! Retrieve restart_interval in (seconds) + ! A restart_interval value of 0 means no restart will be written. + call ESMF_AttributeGet(gcomp, name="restart_interval", value=value, defaultValue="0", & + convention="NUOPC", purpose="Instance", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + restart_interval = ESMF_UtilString2Int(value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if(restart_interval < 0) then + call ESMF_LogSetError(ESMF_RC_NOT_VALID, & + msg="MOM_CAP: OCN attribute: restart_interval cannot be negative.", & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + endif + call ESMF_LogWrite('MOM_CAP:restart_interval = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + + call ESMF_AttributeGet(gcomp, name="GridAttachArea", value=value, defaultValue="false", & + convention="NUOPC", purpose="Instance", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + grid_attach_area=(trim(value)=="true") + call ESMF_LogWrite('MOM_CAP:GridAttachArea = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + + end subroutine + + !----------------------------------------------------------------------------- + + !> Called by NUOPC to advertise import and export fields. "Advertise" + !! simply means that the standard names of all import and export + !! fields are supplied. The NUOPC layer uses these to match fields + !! between components in the coupled system. + !! + !! @param gcomp an ESMF_GridComp object + !! @param importState an ESMF_State object for import fields + !! @param exportState an ESMF_State object for export fields + !! @param clock an ESMF_Clock object + !! @param rc return code + subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + type(ESMF_VM) :: vm + type(ESMF_Time) :: MyTime + type(ESMF_TimeInterval) :: TINT + + type (ocean_public_type), pointer :: Ocean_public => NULL() + type (ocean_state_type), pointer :: Ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + + type(time_type) :: Run_len ! length of experiment + type(time_type) :: Time + type(time_type) :: Time_restart + type(time_type) :: DT + integer :: DT_OCEAN + integer :: isc,iec,jsc,jec + integer :: dt_cpld = 86400 + integer :: year=0, month=0, day=0, hour=0, minute=0, second=0 + integer :: mpi_comm_mom + integer :: npes, pe0, i + + type(ESMF_Grid) :: gridIn + type(ESMF_Grid) :: gridOut + type(param_file_type) :: param_file !< A structure to parse for run-time parameters + type(directories) :: dirs_tmp !< A structure containing several relevant directory paths + character(len=384) :: pointer_filename + integer :: npet, npet_x, npet_y + character(len=*),parameter :: subname='(mom_cap:InitializeAdvertise)' + + rc = ESMF_SUCCESS + + allocate(Ice_ocean_boundary) + !allocate(Ocean_state) ! ocean_model_init allocate this pointer + allocate(Ocean_public) + allocate(ocean_internalstate%ptr) + ocean_internalstate%ptr%ice_ocean_boundary_type_ptr => Ice_ocean_boundary + ocean_internalstate%ptr%ocean_public_type_ptr => Ocean_public + ocean_internalstate%ptr%ocean_state_type_ptr => Ocean_state + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_VMGet(VM, mpiCommunicator=mpi_comm_mom, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(CLOCK, currTIME=MyTime, TimeStep=TINT, RC=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_TimeGet (MyTime, & + YY=YEAR, MM=MONTH, DD=DAY, & + H=HOUR, M =MINUTE, S =SECOND, & + RC=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + CALL ESMF_TimeIntervalGet(TINT, S=DT_OCEAN, RC=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + +#ifdef CESMCOUPLED + + ! Initialize MOM6 comm + call MOM_infra_init(mpi_comm_mom) + call set_calendar_type(NOLEAP) !TODO: confirm this + Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) + +! tcx, todo, first coupling period +! ! Compute time_in: time at the beginning of the first ocn coupling interval +! call ESMF_ClockGet(EClock, TimeStep=ocn_cpl_interval, rc=rc) +! if (runtype /= "continue") then +! ! In startup runs, take the one ocn coupling interval lag into account to +! ! compute the initial ocn time. (time_in = time_init + ocn_cpl_interval) +! time_in_ESMF = ESMF_TimeInc(current_time, ocn_cpl_interval) +! else +! time_in_ESMF = current_time +! endif +! call ESMF_TimeGet(time_in_ESMF, yy=year, mm=month, dd=day, h=hour, m=minute, s=seconds, rc=rc) +! time_in = set_date(year, month, day, hour, minute, seconds, err_msg=err_msg) + +! tcx, todo, restart +! if (runtype == "initial") then ! startup (new run) - 'n' is needed below since we don't +! ! specify input_filename in input.nml + call ocean_model_init(ocean_public, ocean_state, time, time, input_restart_file = 'n') +! else ! hybrid or branch or continuos runs +! ! output path root +! call seq_infodata_GetData( glb%infodata, outPathRoot=restartpath ) +! ! read name of restart file in the pointer file +! nu = shr_file_getUnit() +! restart_pointer_file = trim(glb%pointer_filename) +! if (is_root_pe()) write(glb%stdout,*) 'Reading ocn pointer file: ',restart_pointer_file +! open(nu, file=restart_pointer_file, form='formatted', status='unknown') +! read(nu,'(a)') restartfile +! close(nu) +! !restartfile = trim(restartpath) // trim(restartfile) +! if (is_root_pe()) write(glb%stdout,*) 'Reading restart file: ',trim(restartfile) +! !endif +! call shr_file_freeUnit(nu) +! call ocean_model_init(glb%ocean_public, glb%ocn_state, time_init, time_in, input_restart_file=trim(restartfile)) +! endif + + npes = num_pes() + pe0 = root_pe() + + Ocean_public%is_ocean_pe = .true. + allocate(ocean_public%pelist(npes)) + ocean_public%pelist(:) = (/(i,i=pe0,pe0+npes)/) + + ! This include declares and sets the variable "version". + ! read useful runtime params + call get_MOM_Input(param_file, dirs_tmp, check_params=.false.) + !call log_version(param_file, subname, version, "") + call get_param(param_file, subname, "POINTER_FILENAME", pointer_filename, & + "Name of the ascii file that contains the path and filename of" // & + " the latest restart file.", default='rpointer.ocn') + call get_param(param_file, subname, "SW_DECOMP", sw_decomp, & + "If True, read coeffs c1, c2, c3 and c4 and decompose" // & + "the net shortwave radiation (SW) into four components:\n" // & + "visible, direct shortwave = c1 * SW \n" // & + "visible, diffuse shortwave = c2 * SW \n" // & + "near-IR, direct shortwave = c3 * SW \n" // & + "near-IR, diffuse shortwave = c4 * SW", default=.true.) + if (sw_decomp) then + call get_param(param_file, subname, "SW_c1", c1, & + "Coeff. used to convert net shortwave rad. into \n"//& + "visible, direct shortwave.", units="nondim", default=0.285) + call get_param(param_file, subname, "SW_c2", c2, & + "Coeff. used to convert net shortwave rad. into \n"//& + "visible, diffuse shortwave.", units="nondim", default=0.285) + call get_param(param_file, subname, "SW_c3", c3, & + "Coeff. used to convert net shortwave rad. into \n"//& + "near-IR, direct shortwave.", units="nondim", default=0.215) + call get_param(param_file, subname, "SW_c4", c4, & + "Coeff. used to convert net shortwave rad. into \n"//& + "near-IR, diffuse shortwave.", units="nondim", default=0.215) + else + c1 = 0.0; c2 = 0.0; c3 = 0.0; c4 = 0.0 + endif + + ! Initialize ocn_state%state out of sight + call ocean_model_init_sfc(ocean_state, ocean_public) + +#else + call fms_init(mpi_comm_mom) + call constants_init + call field_manager_init + call set_calendar_type (JULIAN ) + call diag_manager_init + ! this ocean connector will be driven at set interval + dt_cpld = DT_OCEAN + DT = set_time (DT_OCEAN, 0) + Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) + + Ocean_public%is_ocean_pe = .true. + call ocean_model_init(Ocean_public, Ocean_state, Time, Time) + +!tcx tcraig This results in errors in CESM with help from Alper +! FATAL error "MPP_OPEN: error in OPEN for data_table" +! The subroutine data_override_init shouldn't be called because ALLOW_FLUX_ADJUSTMENTS is set to FALSE +!tcx call data_override_init(Ocean_domain_in = Ocean_public%domain) + + call mpp_get_compute_domain(Ocean_public%domain, isc, iec, jsc, jec) + + allocate ( Ice_ocean_boundary% u_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% v_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% t_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% q_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% salt_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% lw_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_vis_dir (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_vis_dif (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_nir_dir (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_nir_dif (isc:iec,jsc:jec), & + Ice_ocean_boundary% lprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% fprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% runoff (isc:iec,jsc:jec), & + Ice_ocean_boundary% calving (isc:iec,jsc:jec), & + Ice_ocean_boundary% runoff_hflx (isc:iec,jsc:jec), & + Ice_ocean_boundary% calving_hflx (isc:iec,jsc:jec), & + Ice_ocean_boundary% mi (isc:iec,jsc:jec), & + Ice_ocean_boundary% p (isc:iec,jsc:jec)) + + Ice_ocean_boundary%u_flux = 0.0 + Ice_ocean_boundary%v_flux = 0.0 + Ice_ocean_boundary%t_flux = 0.0 + Ice_ocean_boundary%q_flux = 0.0 + Ice_ocean_boundary%salt_flux = 0.0 + Ice_ocean_boundary%lw_flux = 0.0 + Ice_ocean_boundary%sw_flux_vis_dir = 0.0 + Ice_ocean_boundary%sw_flux_vis_dif = 0.0 + Ice_ocean_boundary%sw_flux_nir_dir = 0.0 + Ice_ocean_boundary%sw_flux_nir_dif = 0.0 + Ice_ocean_boundary%lprec = 0.0 + Ice_ocean_boundary%fprec = 0.0 + Ice_ocean_boundary%runoff = 0.0 + Ice_ocean_boundary%calving = 0.0 + Ice_ocean_boundary%runoff_hflx = 0.0 + Ice_ocean_boundary%calving_hflx = 0.0 + Ice_ocean_boundary%mi = 0.0 + Ice_ocean_boundary%p = 0.0 +#endif + + call external_coupler_sbc_init(Ocean_public%domain, dt_cpld, Run_len) + + ocean_internalstate%ptr%ocean_state_type_ptr => Ocean_state + call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call MOM_FieldsSetup(ice_ocean_boundary, ocean_public) + +#ifdef CESMCOUPLED + call shr_nuopc_fldList_Advertise(importState, fldsToOcn, subname//':MOM6Import', rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call shr_nuopc_fldList_Advertise(exportState, fldsFrOcn, subname//':MOM6Export', rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return +#else + call MOM_AdvertiseFields(importState, fldsToOcn_num, fldsToOcn, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call MOM_AdvertiseFields(exportState, fldsFrOcn_num, fldsFrOcn, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +#endif + +#ifdef MOM6_CAP + ! When running mom6 solo, the rotation angles are not computed internally + ! in MOM6. We need to + ! calculate cos and sin of rotational angle for MOM6; the values + ! are stored in ocean_internalstate%ptr%ocean_grid_ptr%cos_rot and sin_rot + ! The rotation angles are retrieved during run time to rotate incoming + ! and outgoing vectors + ! + call calculate_rot_angle(Ocean_state, ocean_public, & + ocean_internalstate%ptr%ocean_grid_ptr) +#endif + + write(*,*) '----- MOM initialization phase Advertise completed' + + end subroutine InitializeAdvertise + + !----------------------------------------------------------------------------- + + !> Called by NUOPC to realize import and export fields. "Realizing" a field + !! means that its grid has been defined and an ESMF_Field object has been + !! created and put into the import or export State. + !! + !! @param gcomp an ESMF_GridComp object + !! @param importState an ESMF_State object for import fields + !! @param exportState an ESMF_State object for export fields + !! @param clock an ESMF_Clock object + !! @param rc return code + subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! Local Variables + type(ESMF_VM) :: vm + type(ESMF_Grid) :: gridIn + type(ESMF_Grid) :: gridOut + type(ESMF_DeLayout) :: delayout + type(ESMF_Distgrid) :: Distgrid + type(ESMF_DistGridConnection), allocatable :: connectionList(:) + type (ocean_public_type), pointer :: Ocean_public => NULL() + type (ocean_state_type), pointer :: Ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + integer :: npet, ntiles + integer :: nxg, nyg, cnt + integer :: isc,iec,jsc,jec + integer, allocatable :: xb(:),xe(:),yb(:),ye(:),pe(:) + integer, allocatable :: deBlockList(:,:,:), & + petMap(:),deLabelList(:), & + indexList(:) + integer :: ioff, joff + integer :: i, j, n, i1, j1, n1, icount + integer :: lbnd1,ubnd1,lbnd2,ubnd2 + integer :: lbnd3,ubnd3,lbnd4,ubnd4 + integer :: nblocks_tot + logical :: found + real(ESMF_KIND_R8), allocatable :: ofld(:,:), gfld(:,:) + real(ESMF_KIND_R8), pointer :: t_surf(:,:) + integer(ESMF_KIND_I4), pointer :: dataPtr_mask(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_area(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_xcen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ycen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_xcor(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ycor(:,:) + type(ESMF_Field) :: field_t_surf + character(len=*),parameter :: subname='(mom_cap:InitializeRealize)' + + rc = ESMF_SUCCESS + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr + Ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_VMGet(vm, petCount=npet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !--------------------------------- + ! global mom grid size + !--------------------------------- + + call mpp_get_global_domain(Ocean_public%domain, xsize=nxg, ysize=nyg) + write(tmpstr,'(a,2i6)') subname//' nxg,nyg = ',nxg,nyg + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + !--------------------------------- + ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total + !--------------------------------- + + ntiles=mpp_get_ntile_count(Ocean_public%domain) ! this is tiles on this pe + if (ntiles /= 1) then + rc = ESMF_FAILURE + call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR, rc=dbrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + ntiles=mpp_get_domain_npes(Ocean_public%domain) + write(tmpstr,'(a,1i6)') subname//' ntiles = ',ntiles + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + !--------------------------------- + ! get start and end indices of each tile and their PET + !--------------------------------- + + allocate(xb(ntiles),xe(ntiles),yb(ntiles),ye(ntiles),pe(ntiles)) + call mpp_get_compute_domains(Ocean_public%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye) + call mpp_get_pelist(Ocean_public%domain, pe) + do n = 1,ntiles + write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + enddo + + !--------------------------------- + ! create delayout and distgrid + !--------------------------------- + + allocate(deBlockList(2,2,ntiles)) + allocate(petMap(ntiles)) + allocate(deLabelList(ntiles)) + + do n = 1, ntiles + deLabelList(n) = n + deBlockList(1,1,n) = xb(n) + deBlockList(1,2,n) = xe(n) + deBlockList(2,1,n) = yb(n) + deBlockList(2,2,n) = ye(n) + petMap(n) = pe(n) + ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side + enddo + + delayout = ESMF_DELayoutCreate(petMap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + allocate(connectionList(2)) + ! bipolar boundary condition at top row: nyg + call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & + tileIndexB=1, positionVector=(/nxg+1, 2*nyg+1/), & + orientationVector=(/-1, -2/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ! periodic boundary condition along first dimension + call ESMF_DistGridConnectionSet(connectionList(2), tileIndexA=1, & + tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nxg,nyg/), & +! indexflag = ESMF_INDEX_DELOCAL, & + deBlockList=deBlockList, & +! deLabelList=deLabelList, & + delayout=delayout, & + connectionList=connectionList, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + deallocate(xb,xe,yb,ye,pe) + deallocate(connectionList) + deallocate(deLabelList) + deallocate(deBlockList) + deallocate(petMap) + + call ESMF_DistGridGet(distgrid=distgrid, localDE=0, elementCount=cnt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + allocate(indexList(cnt)) + write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(tmpstr,'(a,4i8)') subname//' distgrid list= ',& + indexList(1),indexList(cnt),minval(indexList), maxval(indexList) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + deallocate(IndexList) + + !--------------------------------- + ! create grid + !--------------------------------- + + gridIn = ESMF_GridCreate(distgrid=distgrid, & + gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & + coordSys = ESMF_COORDSYS_SPH_DEG, & + rc = rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + mom_grid_i = gridIn + + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! Attach area to the Grid optionally. By default the cell areas are computed. + if(grid_attach_area) then + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + call ESMF_GridGetCoord(gridIn, coordDim=1, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_xcen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridGetCoord(gridIn, coordDim=2, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_ycen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridGetCoord(gridIn, coordDim=1, & + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=dataPtr_xcor, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridGetCoord(gridIn, coordDim=2, & + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=dataPtr_ycor, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_MASK, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_mask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if(grid_attach_area) then + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_area, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + !--------------------------------- + ! load up area, mask, center and corner values + ! area, mask, and centers should be same size in mom and esmf grid + ! corner points may not be, need to offset corner points by 1 in i and j + ! for esmf and also need to "make up" j=1 values. use wraparound in i + !--------------------------------- + + call mpp_get_compute_domain(Ocean_public%domain, isc, iec, jsc, jec) + + lbnd1 = lbound(dataPtr_mask,1) + ubnd1 = ubound(dataPtr_mask,1) + lbnd2 = lbound(dataPtr_mask,2) + ubnd2 = ubound(dataPtr_mask,2) + + lbnd3 = lbound(dataPtr_xcor,1) + ubnd3 = ubound(dataPtr_xcor,1) + lbnd4 = lbound(dataPtr_xcor,2) + ubnd4 = ubound(dataPtr_xcor,2) + + write(tmpstr,*) subname//' iscjsc = ',isc,iec,jsc,jec + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' lbub12 = ',lbnd1,ubnd1,lbnd2,ubnd2 + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' lbub34 = ',lbnd3,ubnd3,lbnd4,ubnd4 + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + if (iec-isc /= ubnd1-lbnd1 .or. jec-jsc /= ubnd2-lbnd2) then + rc=ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": fld and grid do not have the same size.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + + allocate(ofld(isc:iec,jsc:jec)) + allocate(gfld(nxg,nyg)) + + call ocean_model_data_get(Ocean_state, Ocean_public, 'mask', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld mask = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_public%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld mask = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_mask(i,j) = nint(ofld(i1,j1)) + enddo + enddo + + if(grid_attach_area) then + call ocean_model_data_get(Ocean_state, Ocean_public, 'area', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld area = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_public%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld area = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_area(i,j) = ofld(i1,j1) + enddo + enddo + endif + + call ocean_model_data_get(Ocean_state, Ocean_public, 'tlon', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld xt = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_public%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld xt = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_xcen(i,j) = ofld(i1,j1) + dataPtr_xcen(i,j) = mod(dataPtr_xcen(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) + enddo + enddo + + call ocean_model_data_get(Ocean_state, Ocean_public, 'tlat', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld yt = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_public%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld yt = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_ycen(i,j) = ofld(i1,j1) + enddo + enddo + +#ifdef MOM5_CAP + call ocean_model_data_get(Ocean_state, Ocean_public, 'ulon', ofld, isc, jsc) +#endif + +#ifdef MOM6_CAP + call ocean_model_data_get(Ocean_state, Ocean_public, 'geoLonBu', ofld, isc, jsc) +#endif + write(tmpstr,*) subname//' ofld xu = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_public%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld xu = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd4, ubnd4 + do i = lbnd3, ubnd3 + j1 = j - lbnd4 + jsc - 1 + i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 + if (j1 == 0) then + dataPtr_xcor(i,j) = 2*gfld(i1,1) - gfld(i1,2) +! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) > 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) - 360. +! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) < 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) + 360. + elseif (j1 >= 1 .and. j1 <= nyg) then + dataPtr_xcor(i,j) = gfld(i1,j1) + else + rc=ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": error in xu j1.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + dataPtr_xcor(i,j) = mod(dataPtr_xcor(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) + ! write(tmpstr,*) subname//' ijfld xu = ',i,i1,j,j1,dataPtr_xcor(i,j) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + enddo + enddo + +! The corner latitude values are treated differently because MOM5 runs on B-Grid while +! MOM6 runs on C-Grid. +#ifdef MOM5_CAP + call ocean_model_data_get(Ocean_state, Ocean_public, 'ulat', ofld, isc, jsc) +#endif + +#ifdef MOM6_CAP + call ocean_model_data_get(Ocean_state, Ocean_public, 'geoLatBu', ofld, isc, jsc) +#endif + + write(tmpstr,*) subname//' ofld yu = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call mpp_global_field(Ocean_public%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld yu = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + do j = lbnd4, ubnd4 + do i = lbnd3, ubnd3 + j1 = j - lbnd4 + jsc - 1 + i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 + if (j1 == 0) then + dataPtr_ycor(i,j) = 2*gfld(i1,1) - gfld(i1,2) + elseif (j1 >= 1 .and. j1 <= nyg) then + dataPtr_ycor(i,j) = gfld(i1,j1) + else + rc=ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": error in yu j1.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + ! write(tmpstr,*) subname//' ijfld yu = ',i,i1,j,j1,dataPtr_ycor(i,j) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + enddo + enddo + + write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + if(grid_attach_area) then + write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + endif + + write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' ycen = ',minval(dataPtr_ycen),maxval(dataPtr_ycen) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' xcor = ',minval(dataPtr_xcor),maxval(dataPtr_xcor) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + deallocate(gfld) + + gridOut = gridIn ! for now out same as in + + !--------------------------------- + ! realize fields on grid + !--------------------------------- + +#ifdef CESMCOUPLED + call shr_nuopc_fldList_Realize(importState, grid=gridIn, fldlist=fldsToOcn, tag=subname//':MOM6Import', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call shr_nuopc_fldList_Realize(exportState, grid=gridOut, fldlist=fldsFrOcn, tag=subname//':MOM6Export', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return +#else + call MOM_RealizeFields(importState, gridIn , fldsToOcn_num, fldsToOcn, "Ocn import", rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call MOM_RealizeFields(exportState, gridOut, fldsFrOcn_num, fldsFrOcn, "Ocn export", rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +#endif + + call ESMF_StateGet(exportState, itemSearch="sea_surface_temperature", itemCount=icount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! Do sst initialization if it's part of export state + if(icount /= 0) then + call ESMF_StateGet(exportState, itemName='sea_surface_temperature', field=field_t_surf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_FieldGet(field_t_surf, localDe=0, farrayPtr=t_surf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ocean_model_data_get(Ocean_state, Ocean_public, 'mask', ofld, isc, jsc) + + lbnd1 = lbound(t_surf,1) + ubnd1 = ubound(t_surf,1) + lbnd2 = lbound(t_surf,2) + ubnd2 = ubound(t_surf,2) + + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + if (ofld(i1,j1) == 0.) t_surf(i,j) = 0.0 + enddo + enddo + + deallocate(ofld) + endif + +! tcraig, turn this off for now, have issues with overwriting failures +! call NUOPC_Write(exportState, fileNamePrefix='init_field_ocn_export_', & +! timeslice=1, relaxedFlag=.true., rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out + + write(*,*) '----- MOM initialization phase Realize completed' + + end subroutine InitializeRealize + + !> Called by NUOPC to advance the model a single timestep. + !! + !! @param gcomp an ESMF_GridComp object + !! @param rc return code + subroutine ModelAdvance(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_State) :: importState, exportState + type(ESMF_Time) :: currTime + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Time) :: startTime + type(ESMF_TimeInterval) :: time_elapsed + integer(ESMF_KIND_I8) :: n_interval, time_elapsed_sec + character(len=64) :: timestamp + + type (ocean_public_type), pointer :: Ocean_public => NULL() + type (ocean_state_type), pointer :: Ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + + ! define some time types + type(time_type) :: Time + type(time_type) :: Time_step_coupled + type(time_type) :: Time_restart_current + + integer :: dth, dtm, dts, dt_cpld = 86400 + integer :: isc,iec,jsc,jec,lbnd1,ubnd1,lbnd2,ubnd2 + integer :: i,j,i1,j1 + integer :: nc +#ifdef CESMCOUPLED + ! in ocn_import, ocn_export + +#else + real(ESMF_KIND_R8), allocatable :: ofld(:,:), ocz(:,:), ocm(:,:) + real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_mmmf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_mzmf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ocz(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ocm(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) +#endif + type(ocean_grid_type), pointer :: Ocean_grid + character(240) :: msgString + character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' + + rc = ESMF_SUCCESS + if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") + + ! query the Component for its clock, importState and exportState + call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & + exportState=exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr + Ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + + ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep + + call ESMF_ClockPrint(clock, options="currTime", & + preString="------>Advancing OCN from: ", unit=msgString, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(clock, startTime=startTime, currTime=currTime, & + timeStep=timeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_TimePrint(currTime + timeStep, & + preString="--------------------------------> to: ", & + unit=msgString, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_TimeIntervalGet(timeStep, h=dth, m=dtm, s=dts, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Time = esmf2fms_time(currTime) + Time_step_coupled = esmf2fms_time(timeStep) + dt_cpld = dth*3600+dtm*60+dts + + call ice_ocn_bnd_from_data(Ice_ocean_boundary, Time, Time_step_coupled) + + call external_coupler_sbc_before(Ice_ocean_boundary, Ocean_public, nc, dt_cpld ) + + if(write_diagnostics) then + call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', & + timeslice=import_slice, relaxedFlag=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + import_slice = import_slice + 1 + endif + + ! rotate the lat/lon wind vector (CW) onto local tripolar coordinate system + + call mpp_get_compute_domain(Ocean_public%domain, isc, iec, jsc, jec) + + if(.not. ocean_solo) then + +#ifdef MOM5_CAP + call get_ocean_grid(Ocean_grid) +#endif +#ifdef MOM6_CAP + Ocean_grid => ocean_internalstate%ptr%ocean_grid_ptr +#endif + +#ifdef CESMCOUPLED + ! unpacked in update_ocean_ +#else + call State_getFldPtr(exportState,'ocean_mask',dataPtr_mask,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr_mask,1) + ubnd1 = ubound(dataPtr_mask,1) + lbnd2 = lbound(dataPtr_mask,2) + ubnd2 = ubound(dataPtr_mask,2) + + call State_getFldPtr(importState,'mean_zonal_moment_flx',dataPtr_mzmf,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,'mean_merid_moment_flx',dataPtr_mmmf,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,'mean_evap_rate',dataPtr_evap,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,'mean_sensi_heat_flx',dataPtr_sensi,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + dataPtr_evap = - dataPtr_evap + dataPtr_sensi = - dataPtr_sensi + + allocate(mzmf(lbnd1:ubnd1,lbnd2:ubnd2)) + allocate(mmmf(lbnd1:ubnd1,lbnd2:ubnd2)) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc ! work around local vs global indexing + i1 = i - lbnd1 + isc + mzmf(i,j) = Ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & + + Ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) + mmmf(i,j) = Ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & + - Ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) + enddo + enddo + dataPtr_mzmf = mzmf + dataPtr_mmmf = mmmf + deallocate(mzmf, mmmf) +#endif + endif ! not ocean_solo + +#ifdef CESMCOUPLED + ! tcx todo +#else + !Optionally write restart files when currTime-startTime is integer multiples of restart_interval + if(restart_interval > 0 ) then + time_elapsed = currTime - startTime + call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + n_interval = time_elapsed_sec / restart_interval + if((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then + time_restart_current = esmf2fms_time(currTime) + timestamp = date_to_string(time_restart_current) + call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=dbrc) + write(*,*) 'calling ocean_model_restart' + call ocean_model_restart(Ocean_state, timestamp) + endif + endif +#endif + + if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") +#ifdef CESMCOUPLED + call update_ocean_model(ImportState, Ocean_state, Ocean_public, Time, Time_step_coupled, & + sw_decomp, c1, c2, c3, c4) +#else + call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_public, Time, Time_step_coupled) +#endif + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") + + if(.not. ocean_solo) then + +#ifdef MOM5_CAP + call get_ocean_grid(Ocean_grid) +#endif +#ifdef MOM6_CAP + Ocean_grid => ocean_internalstate%ptr%ocean_grid_ptr +#endif + +#ifdef CESMCOUPLED + call ocn_export(ocean_public, ocean_grid, exportState) +#else + allocate(ofld(isc:iec,jsc:jec)) + + call ocean_model_data_get(Ocean_state, Ocean_public, 'mask', ofld, isc, jsc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_mask(i,j) = nint(ofld(i1,j1)) + enddo + enddo + deallocate(ofld) + + ! Now rotate ocn current from tripolar grid back to lat/lon grid (CCW) + allocate(ocz(lbnd1:ubnd1,lbnd2:ubnd2)) + allocate(ocm(lbnd1:ubnd1,lbnd2:ubnd2)) + + call State_getFldPtr(exportState,'ocn_current_zonal',dataPtr_ocz,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'ocn_current_merid',dataPtr_ocm,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling + + ocz = dataPtr_ocz + ocm = dataPtr_ocm + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc ! work around local vs global indexing + i1 = i - lbnd1 + isc + dataPtr_ocz(i,j) = Ocean_grid%cos_rot(i1,j1)*ocz(i,j) & + - Ocean_grid%sin_rot(i1,j1)*ocm(i,j) + dataPtr_ocm(i,j) = Ocean_grid%cos_rot(i1,j1)*ocm(i,j) & + + Ocean_grid%sin_rot(i1,j1)*ocz(i,j) + enddo + enddo + deallocate(ocz, ocm) + endif ! not ocean_solo + + call ESMF_LogWrite("Before writing diagnostics", dataPtr_model_data_get(Ocean_state, Ocean_public, 'mask', ofld, isc, jsc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_mask(i,j) = nint(ofld(i1,j1)) + enddo + enddo + deallocate(ofld) + + ! Now rotate ocn current from tripolar grid back to lat/lon grid (CCW) + allocate(ocz(lbnd1:ubnd1,lbnd2:ubnd2)) + allocate(ocm(lbnd1:ubnd1,lbnd2:ubnd2)) + + call State_getFldPtr(exportState,'ocn_current_zonal',dataPtr_ocz,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'ocn_current_merid',dataPtr_ocm,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling + + ocz = dataPtr_ocz + ocm = dataPtr_ocm + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc ! work around local vs global indexing + i1 = i - lbnd1 + isc + dataPtr_ocz(i,j) = Ocean_grid%cos_rot(i1,j1)*ocz(i,j) & + - Ocean_grid%sin_rot(i1,j1)*ocm(i,j) + dataPtr_ocm(i,j) = Ocean_grid%cos_rot(i1,j1)*ocm(i,j) & + + Ocean_grid%sin_rot(i1,j1)*ocz(i,j) + enddo + enddo + deallocate(ocz, ocm) + endif ! not ocean_solo + + call ESMF_LogWrite(, rc=rc) + if(write_diagnostics) then + call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & + timeslice=export_slice, relaxedFlag=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + export_slice = export_slice + 1 +#endif + endif ! not ocean solo + + call ESMF_LogWrite("Before calling sbc forcing", ESMF_LOGMSG_INFO, rc=rc) + call external_coupler_sbc_after(Ice_ocean_boundary, Ocean_public, nc, dt_cpld ) + + call ESMF_LogWrite("Before dumpMomInternal", ESMF_LOGMSG_INFO, rc=rc) + !write(*,*) 'MOM: --- run phase called ---' + call dumpMomInternal(mom_grid_i, import_slice, "mean_zonal_moment_flx", "will provide", Ice_ocean_boundary%u_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_merid_moment_flx", "will provide", Ice_ocean_boundary%v_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_sensi_heat_flx" , "will provide", Ice_ocean_boundary%t_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_evap_rate" , "will provide", Ice_ocean_boundary%q_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_salt_rate" , "will provide", Ice_ocean_boundary%salt_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_lw_flx" , "will provide", Ice_ocean_boundary%lw_flux ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dir_flx", "will provide", Ice_ocean_boundary%sw_flux_vis_dir) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dif_flx", "will provide", Ice_ocean_boundary%sw_flux_vis_dif) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dir_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dir) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dif_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dif) + call dumpMomInternal(mom_grid_i, import_slice, "mean_prec_rate" , "will provide", Ice_ocean_boundary%lprec ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_fprec_rate" , "will provide", Ice_ocean_boundary%fprec ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_rate" , "will provide", Ice_ocean_boundary%runoff ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_rate" , "will provide", Ice_ocean_boundary%calving) + call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_heat_flx" , "will provide", Ice_ocean_boundary%runoff_hflx ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_heat_flx", "will provide", Ice_ocean_boundary%calving_hflx) + call dumpMomInternal(mom_grid_i, import_slice, "inst_pres_height_surface" , "will provide", Ice_ocean_boundary%p ) + call dumpMomInternal(mom_grid_i, import_slice, "mass_of_overlying_sea_ice", "will provide", Ice_ocean_boundary%mi) + +!--------- export fields ------------- + +! call dumpMomInternal(mom_grid_i, export_slice, "ocean_mask", "will provide", dataPtr_mask) + call dumpMomInternal(mom_grid_i, export_slice, "sea_surface_temperature", "will provide", Ocean_public%t_surf) + call dumpMomInternal(mom_grid_i, export_slice, "s_surf" , "will provide", Ocean_public%s_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_zonal", "will provide", Ocean_public%u_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_merid", "will provide", Ocean_public%v_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "sea_lev" , "will provide", Ocean_public%sea_lev) + + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") + + end subroutine ModelAdvance + + !> Called by NUOPC at the end of the run to clean up. + !! + !! @param gcomp an ESMF_GridComp object + !! @param rc return code + subroutine ocean_model_finalize(gcomp, rc) + + ! input arguments + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type (ocean_public_type), pointer :: Ocean_public + type (ocean_state_type), pointer :: Ocean_state + type(ocean_internalstate_wrapper) :: ocean_internalstate + type(TIME_TYPE) :: Time + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currTime + character(len=64) :: timestamp + character(len=*),parameter :: subname='(mom_cap:ocean_model_finalize)' + + write(*,*) 'MOM: --- finalize called ---' + rc = ESMF_SUCCESS + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + + call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(clock, currTime=currTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + Time = esmf2fms_time(currTime) + + call ocean_model_end (Ocean_public, Ocean_State, Time) + call diag_manager_end(Time ) + call field_manager_end + + call fms_io_exit + call fms_end + + write(*,*) 'MOM: --- completed ---' + + end subroutine ocean_model_finalize + +!==================================================================== +! get forcing data from data_overide + subroutine ice_ocn_bnd_from_data(x, Time, Time_step_coupled) + + type (ice_ocean_boundary_type) :: x + type(Time_type), intent(in) :: Time, Time_step_coupled + + type(Time_type) :: Time_next + character(len=*),parameter :: subname='(mom_cap:ice_ocn_bnd_from_data)' + + Time_next = Time + Time_step_coupled + + !call data_override('OCN', 't_flux', x%t_flux , Time_next) + !call data_override('OCN', 'u_flux', x%u_flux , Time_next) + !call data_override('OCN', 'v_flux', x%v_flux , Time_next) + !call data_override('OCN', 'q_flux', x%q_flux , Time_next) + !call data_override('OCN', 'salt_flux', x%salt_flux , Time_next) + !call data_override('OCN', 'lw_flux', x%lw_flux , Time_next) + !call data_override('OCN', 'sw_flux_vis_dir', x%sw_flux_vis_dir, Time_next) + !call data_override('OCN', 'sw_flux_vis_dif', x%sw_flux_vis_dif, Time_next) + !call data_override('OCN', 'sw_flux_nir_dir', x%sw_flux_nir_dir, Time_next) + !call data_override('OCN', 'sw_flux_nir_dif', x%sw_flux_nir_dif, Time_next) + !call data_override('OCN', 'lprec', x%lprec , Time_next) + !call data_override('OCN', 'fprec', x%fprec , Time_next) + !call data_override('OCN', 'runoff', x%runoff , Time_next) + !call data_override('OCN', 'calving', x%calving , Time_next) + !call data_override('OCN', 'p', x%p , Time_next) + + end subroutine ice_ocn_bnd_from_data + + +!----------------------------------------------------------------------------------------- +! +! Subroutines for enabling coupling to external programs through a third party coupler +! such as OASIS/PRISM. +! If no external coupler then these will mostly be dummy routines. +! These routines can also serve as spots to call other user defined routines +!----------------------------------------------------------------------------------------- + +!----------------------------------------------------------------------------------------- + +! Dummy subroutines. + + subroutine external_coupler_mpi_init(mom_local_communicator, external_initialization) + implicit none + integer, intent(out) :: mom_local_communicator + logical, intent(out) :: external_initialization + external_initialization = .false. + mom_local_communicator = -100 ! Is there mpp_undefined parameter corresponding to MPI_UNDEFINED? + ! probably wouldn't need logical flag. + return + end subroutine external_coupler_mpi_init + +!----------------------------------------------------------------------------------------- + subroutine external_coupler_sbc_init(Dom, dt_cpld, Run_len) + implicit none + type(domain2d) :: Dom + integer :: dt_cpld + type(time_type) :: Run_len + return + end subroutine external_coupler_sbc_init + + subroutine external_coupler_sbc_before(Ice_ocean_boundary, Ocean_public, nsteps, dt_cpld ) + implicit none + type (ice_ocean_boundary_type), intent(INOUT) :: Ice_ocean_boundary + type (ocean_public_type) , intent(INOUT) :: Ocean_public + integer , intent(IN) :: nsteps, dt_cpld + return + end subroutine external_coupler_sbc_before + + + subroutine external_coupler_sbc_after(Ice_ocean_boundary, Ocean_public, nsteps, dt_cpld ) + type (ice_ocean_boundary_type) :: Ice_ocean_boundary + type (ocean_public_type) :: Ocean_public + integer :: nsteps, dt_cpld + return + end subroutine external_coupler_sbc_after + + subroutine external_coupler_restart( dt_cpld, num_cpld_calls ) + implicit none + integer, intent(in) :: dt_cpld, num_cpld_calls + return + end subroutine external_coupler_restart + + subroutine external_coupler_exit + return + end subroutine external_coupler_exit + +!----------------------------------------------------------------------------------------- + subroutine external_coupler_mpi_exit(mom_local_communicator, external_initialization) + implicit none + integer, intent(in) :: mom_local_communicator + logical, intent(in) :: external_initialization + return + end subroutine external_coupler_mpi_exit +!----------------------------------------------------------------------------------------- + subroutine writeSliceFields(state, filename_prefix, slice, rc) + type(ESMF_State) :: state + character(len=*) :: filename_prefix + integer :: slice + integer, intent(out), optional :: rc + + integer :: n, nfields + type(ESMF_Field) :: field + type(ESMF_StateItem_Flag) :: itemType + character(len=40) :: fileName + character(len=64),allocatable :: fieldNameList(:) + character(len=*),parameter :: subname='(mom_cap:writeSliceFields)' + + if (present(rc)) rc = ESMF_SUCCESS + + if (ESMF_IO_PIO_PRESENT .and. & + (ESMF_IO_NETCDF_PRESENT .or. ESMF_IO_PNETCDF_PRESENT)) then + + call ESMF_StateGet(state, itemCount=nfields, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + allocate(fieldNameList(nfields)) + call ESMF_StateGet(state, itemNameList=fieldNameList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + do n=1, size(fieldNameList) + call ESMF_StateGet(state, itemName=fieldNameList(n), & + itemType=itemType, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (itemType /= ESMF_STATEITEM_NOTFOUND) then + ! field is available in the state + call ESMF_StateGet(state, itemName=fieldNameList(n), field=field, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ! -> output to file + write (fileName,"(A)") & + filename_prefix//trim(fieldNameList(n))//".nc" + call ESMF_FieldWrite(field, fileName=trim(fileName), & + timeslice=slice, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + endif + enddo + + deallocate(fieldNameList) + + endif + + end subroutine writeSliceFields + + !----------------------------------------------------------------------------- + + subroutine State_GetFldPtr(ST, fldname, fldptr, rc) + type(ESMF_State), intent(in) :: ST + character(len=*), intent(in) :: fldname + real(ESMF_KIND_R8), pointer, intent(in) :: fldptr(:,:) + integer, intent(out), optional :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrc + character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' + + call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (present(rc)) rc = lrc + + end subroutine State_GetFldPtr + +#ifndef CESMCOUPLED + !----------------------------------------------------------------------------- + subroutine MOM_AdvertiseFields(state, nfields, field_defs, rc) + + type(ESMF_State), intent(inout) :: state + integer,intent(in) :: nfields + type(fld_list_type), intent(inout) :: field_defs(:) + integer, intent(inout) :: rc + + integer :: i + character(len=*),parameter :: subname='(mom_cap:MOM_AdvertiseFields)' + + rc = ESMF_SUCCESS + + do i = 1, nfields + + call NUOPC_Advertise(state, & + standardName=field_defs(i)%stdname, & + name=field_defs(i)%shortname, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + enddo + + end subroutine MOM_AdvertiseFields + + !----------------------------------------------------------------------------- + + subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) + + type(ESMF_State), intent(inout) :: state + type(ESMF_Grid), intent(in) :: grid + integer, intent(in) :: nfields + type(fld_list_type), intent(inout) :: field_defs(:) + character(len=*), intent(in) :: tag + integer, intent(inout) :: rc + + integer :: i + type(ESMF_Field) :: field + integer :: npet, nx, ny, pet, elb(2), eub(2), clb(2), cub(2), tlb(2), tub(2) + type(ESMF_VM) :: vm + character(len=*),parameter :: subname='(mom_cap:MOM_RealizeFields)' + + rc = ESMF_SUCCESS + + do i = 1, nfields + + if (NUOPC_IsConnected(state, fieldName=field_defs(i)%shortname)) then + + if (field_defs(i)%shortname == flds_scalar_name) then + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected on root pe.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=dbrc) + call shr_nuopc_fldList_SetScalarField(field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + elseif (field_defs(i)%assoc) then + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected and associated.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=dbrc) + write(tmpstr,'(a,4i12)') subname//trim(tag)//' Field '//trim(field_defs(i)%shortname)//':', & + lbound(field_defs(i)%farrayPtr,1), ubound(field_defs(i)%farrayPtr,1), & + lbound(field_defs(i)%farrayPtr,2), ubound(field_defs(i)%farrayPtr,2) + call ESMF_LogWrite(tmpstr, ESMF_LOGMSG_INFO, rc=dbrc) + field = ESMF_FieldCreate(grid=grid, & + farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & +! farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=dbrc) + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + call NUOPC_Realize(state, field=field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +! call ESMF_FieldPrint(field=field, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out + else + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is not connected.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=dbrc) + ! TODO: Initialize the value in the pointer to 0 after proper restart is setup + !if(associated(field_defs(i)%farrayPtr) ) field_defs(i)%farrayPtr = 0.0 + ! remove a not connected Field from State + call ESMF_StateRemove(state, (/field_defs(i)%shortname/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + enddo + + end subroutine MOM_RealizeFields +#endif + !----------------------------------------------------------------------------- + + subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_public) + type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary + type(ocean_public_type), intent(in) :: Ocean_public + + integer :: rc + character(len=*),parameter :: subname='(mom_cap:MOM_FieldsSetup)' + + !!! fld_list_add(num, fldlist, stdname, transferOffer, data(optional), shortname(optional)) + +#ifdef CESMCOUPLED + +! WARNING tcx tcraig +! tcraig this is just a starting point, the fields are not complete or correct here + + !-------------------------------- + ! create import fields list + !-------------------------------- + + call shr_nuopc_fldList_Zero(fldsToOcn, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call shr_nuopc_fldList_fromflds(fldsToOcn, flds_x2o, flds_x2o_map, "will provide", subname//":flds_x2o", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call shr_nuopc_fldList_Add(fldsToOcn, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + ! convert to fldsToOcn + + !-------------------------------- + ! create export fields list + !-------------------------------- + + call shr_nuopc_fldList_Zero(fldsFrOcn, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call shr_nuopc_fldList_fromflds(fldsFrOcn, flds_o2x, flds_o2x_map, "will provide", subname//":flds_o2x", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call shr_nuopc_fldList_Add(fldsFrOcn, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + +#else +!--------- import fields ------------- + +! tcraig, don't point directly into mom data YET (last field is optional in interface) +! instead, create space for the field when it's "realized". + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx", "will provide", data=Ice_ocean_boundary%u_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx", "will provide", data=Ice_ocean_boundary%v_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide", data=Ice_ocean_boundary%t_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide", data=Ice_ocean_boundary%q_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide", data=Ice_ocean_boundary%salt_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide", data=Ice_ocean_boundary%lw_flux ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dir) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dif) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_nir_dir) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_nir_dif) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide", data=Ice_ocean_boundary%lprec ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide", data=Ice_ocean_boundary%fprec ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide", data=Ice_ocean_boundary%runoff ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide", data=Ice_ocean_boundary%calving) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide", data=Ice_ocean_boundary%runoff_hflx ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx", "will provide", data=Ice_ocean_boundary%calving_hflx) + call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide", data=Ice_ocean_boundary%p ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice", "will provide", data=Ice_ocean_boundary%mi) + +!--------- export fields ------------- + + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask", "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature", "will provide", data=Ocean_public%t_surf) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide", data=Ocean_public%s_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal", "will provide", data=Ocean_public%u_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid", "will provide", data=Ocean_public%v_surf ) +! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir", "will provide") +! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir", "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=Ocean_public%sea_lev) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=Ocean_public%frazil) + +#endif + + end subroutine MOM_FieldsSetup + + !----------------------------------------------------------------------------- +#ifndef CESMCOUPLED + subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) + ! ---------------------------------------------- + ! Set up a list of field information + ! ---------------------------------------------- + integer, intent(inout) :: num + type(fld_list_type), intent(inout) :: fldlist(:) + character(len=*), intent(in) :: stdname + character(len=*), intent(in) :: transferOffer + real(ESMF_KIND_R8), dimension(:,:), optional, target :: data + character(len=*), intent(in),optional :: shortname + + ! local variables + integer :: rc + character(len=*), parameter :: subname='(mom_cap:fld_list_add)' + + ! fill in the new entry + + num = num + 1 + if (num > fldsMax) then + call ESMF_LogWrite(trim(subname)//": ERROR num gt fldsMax "//trim(stdname), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) + return + endif + + fldlist(num)%stdname = trim(stdname) + if (present(shortname)) then + fldlist(num)%shortname = trim(shortname) + else + fldlist(num)%shortname = trim(stdname) + endif + fldlist(num)%transferOffer = trim(transferOffer) + if (present(data)) then + fldlist(num)%assoc = .true. + fldlist(num)%farrayPtr => data + else + fldlist(num)%assoc = .false. + endif + + end subroutine fld_list_add +#endif + + subroutine dumpMomInternal(grid, slice, stdname, nop, farray) + + type(ESMF_Grid) :: grid + integer, intent(in) :: slice + character(len=*) :: stdname + character(len=*) :: nop + real(ESMF_KIND_R8), dimension(:,:), target :: farray + + type(ESMF_Field) :: field + real(ESMF_KIND_R8), dimension(:,:), pointer :: f2d + integer :: rc + +#ifdef MOM6_CAP + return +#endif + + if(.not. write_diagnostics) return ! nop in production mode + if(ocean_solo) return ! do not dump internal fields in ocean solo mode + + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, & + indexflag=ESMF_INDEX_DELOCAL, & + name=stdname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_FieldGet(field, farrayPtr=f2d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + f2d(:,:) = farray(:,:) + + call ESMF_FieldWrite(field, fileName='field_ocn_internal_'//trim(stdname)//'.nc', & + timeslice=slice, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_FieldDestroy(field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end subroutine + +#ifdef MOM6_CAP + subroutine calculate_rot_angle(OS, OSFC, OG) + type(ocean_state_type), intent(in) :: OS + type(ocean_public_type), intent(in) :: OSFC + type(ocean_grid_type), pointer :: OG + + integer :: i,j,ishift,jshift,ilb,iub,jlb,jub + real :: angle, lon_scale + type(ocean_grid_type), pointer :: G + + call get_ocean_grid(OS, G) + + !print *, 'lbound: ', lbound(G%geoLatT), lbound(G%geoLonT), lbound(G%sin_rot) + !print *, 'ubound: ', ubound(G%geoLatT), ubound(G%geoLonT), ubound(G%sin_rot) + + !print *, minval(G%geoLatT), maxval(G%geoLatT) + !print *, minval(G%geoLonT), maxval(G%geoLonT) + !print *, G%isc, G%jsc, G%iec, G%jec + + ! + ! The bounds isc:iec goes from 5-104, isc-ishift:iec-ishift goes from 1:100 + ! + call mpp_get_compute_domain(OSFC%Domain, ilb, iub, jlb, jub) + ishift = ilb-G%isc + jshift = jlb-G%jsc + !print *, 'ilb, iub, jlb, jub', ilb, iub, jlb, jub, ishift, jshift + !print *, 'sizes', iub-ilb, jub-jlb, G%iec-G%isc, G%jec-G%jsc + allocate(OG) + allocate(OG%sin_rot(ilb:iub, jlb:jub)) + allocate(OG%cos_rot(ilb:iub, jlb:jub)) + + ! loop 5-104 + do j=G%jsc,G%jec ; do i=G%isc,G%iec + lon_scale = cos((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J-1 ) + & + G%geoLatBu(I-1,J) + G%geoLatBu(I,J)) * atan(1.0)/180) + angle = atan2((G%geoLonBu(I-1,J) + G%geoLonBu(I,J) - & + G%geoLonBu(I-1,J-1) - G%geoLonBu(I,J-1))*lon_scale, & + G%geoLatBu(I-1,J) + G%geoLatBu(I,J) - & + G%geoLatBu(I-1,J-1) - G%geoLatBu(I,J-1) ) + OG%sin_rot(i+ishift,j+jshift) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean + OG%cos_rot(i+ishift,j+jshift) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) + enddo ; enddo + !print *, minval(OG%sin_rot), maxval(OG%sin_rot) + !print *, minval(OG%cos_rot), maxval(OG%cos_rot) + + end subroutine +#endif + + +end module mom_cap_mod diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 new file mode 100644 index 0000000000..cb851f530f --- /dev/null +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -0,0 +1,500 @@ +!> This is the main driver for MOM6 in CIME +module mom_cap_methods + +! This file is part of MOM6. See LICENSE.md for the license. + +! mct modules +use ESMF +use perf_mod, only: t_startf, t_stopf +use ocean_model_mod, only: ocean_public_type, ocean_state_type +use ocean_model_mod, only: ice_ocean_boundary_type +use MOM_grid, only: ocean_grid_type +use MOM_domains, only: pass_var +use mpp_domains_mod, only: mpp_get_compute_domain + +! By default make data private +implicit none; private + +! Public member functions +public :: ocn_export +public :: ocn_import + +integer :: rc,dbrc +character(len=1024) :: tmpstr + +!--------------------------- +contains +!--------------------------- + +!> Maps outgoing ocean data to ESMF State +!! See \ref section_ocn_export for a summary of the data +!! that is transferred from MOM6 to MCT. +subroutine ocn_export(ocean_public, grid, exportState) + type(ocean_public_type), intent(in) :: ocean_public !< Ocean surface state + type(ocean_grid_type), intent(in) :: grid !< Ocean model grid + type(ESMF_State), intent(inout) :: exportState !< outgoing data + ! Local variables + real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo + integer :: i, j, i1, j1, isc, iec, jsc, jec !< Grid indices + integer :: lbnd1, lbnd2, ubnd1, ubnd2 + real :: slp_L, slp_R, slp_C, slope, u_min, u_max + real(ESMF_KIND_R8), pointer :: dataPtr_omask(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_t(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_s(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_u(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_v(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_q(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fswpen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_roce_16O(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_roce_HDO(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fco2_ocn(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fdms_ocn(:,:) + + character(len=*),parameter :: subname = '(ocn_export)' + + call State_getFldPtr(exportState,"So_omask", dataPtr_omask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_t", dataPtr_t, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_s", dataPtr_s, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_u", dataPtr_u, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_v", dataPtr_v, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"Fioo_q", dataPtr_q, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_dhdx", dataPtr_dhdx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_dhdy", dataPtr_dhdy, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_bldepth", dataPtr_bldepth, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_fswpen", dataPtr_fswpen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +! call State_getFldPtr(exportState,"So_roce_16O", dataPtr_roce_16O, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out +! call State_getFldPtr(exportState,"So_roce_HDO", dataPtr_roce_HDO, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out +! call State_getFldPtr(exportState,"Faoo_fco2_ocn", dataPtr_fco2_ocn, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out +! call State_getFldPtr(exportState,"Faoo_fdms_ocn", dataPtr_fdms_ocn, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out + + lbnd1 = lbound(dataPtr_t,1) + ubnd1 = ubound(dataPtr_t,1) + lbnd2 = lbound(dataPtr_t,2) + ubnd2 = ubound(dataPtr_t,2) + + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + +!tcx + write(tmpstr,'(a,6i8)') subname//'tcx1',lbnd1,ubnd1,lbnd2,ubnd2 + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(tmpstr,'(a,6i8)') subname//'tcx2',isc,iec,jsc,jec + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(tmpstr,'(a,6i8)') subname//'tcx3',lbound(ssh,1),ubound(ssh,1),lbound(ssh,2),ubound(ssh,2) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(tmpstr,'(a,6i8)') subname//'tcx4',lbound(ocean_public%sea_lev,1),ubound(ocean_public%sea_lev,1),lbound(ocean_public%sea_lev,2),ubound(ocean_public%sea_lev,2) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(tmpstr,'(a,6i8)') subname//'tcx5',lbound(grid%mask2dT,1),ubound(grid%mask2dT,1),lbound(grid%mask2dT,2),ubound(grid%mask2dT,2) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + ! Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. + ! The mask comes from "grid" that uses the usual MOM domain that has halos + ! and does not use global indexing. + do j = jsc, jec + j1 = j + lbnd2 - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + ! surface temperature in Kelvin + dataPtr_t(i1,j1) = ocean_public%t_surf(i,j) * grid%mask2dT(i,j) + dataPtr_s(i1,j1) = ocean_public%s_surf(i,j) * grid%mask2dT(i,j) + dataPtr_u(i1,j1) = (grid%cos_rot(i,j) * ocean_public%u_surf(i,j) & + - grid%sin_rot(i,j) * ocean_public%v_surf(i,j)) * grid%mask2dT(i,j) + dataPtr_v(i1,j1) = (grid%cos_rot(i,j) * ocean_public%v_surf(i,j) & + + grid%sin_rot(i,j) * ocean_public%u_surf(i,j)) * grid%mask2dT(i,j) + ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain + ! in order to update halos. i.e. does not use global indexing. + ssh(i,j) = ocean_public%sea_lev(i,j) + end do + end do + + ! Update halo of ssh so we can calculate gradients + call pass_var(ssh, grid%domain) + + ! d/dx ssh + do j=jsc, jec + j1 = j + lbnd2 - jsc + do i=isc,iec + i1 = i + lbnd1 - isc + ! This is a simple second-order difference + !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) + if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(I,j) + if (grid%mask2dCu(I+1,j)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + if ( (slp_L * slp_R) > 0.0 ) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + dataPtr_dhdx(i1,j1) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) dataPtr_dhdx(i1,j1) = 0.0 + end do + end do + + ! d/dy ssh + do j=jsc, jec + j1 = j + lbnd2 - jsc + do i=isc,iec + i1 = i + lbnd1 - isc + ! This is a simple second-order difference + !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) + if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. + slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,J) + if (grid%mask2dCv(i,J+1)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R + if ((slp_L * slp_R) > 0.0) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + dataPtr_dhdy(i1,j1) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) dataPtr_dhdy(i1,j1) = 0.0 + end do + end do + +end subroutine ocn_export + + +!> 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. +subroutine ocn_import(ocean_public, grid, importState, ice_ocean_boundary) + type(ocean_public_type), intent(in) :: ocean_public !< Ocean surface state + type(ocean_grid_type), intent(in) :: grid !< Ocean model grid + type(ESMF_State), intent(inout) :: importState !< incoming data + type(ice_ocean_boundary_type), intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing + + integer :: i, j, i1, j1, isc, iec, jsc, jec !< Grid indices + real(ESMF_KIND_R8) :: c1,c2,c3,c4 + integer :: lbnd1, lbnd2, ubnd1, ubnd2 + + real(ESMF_KIND_R8), pointer :: dataPtr_p(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ifrac(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_duu10n(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_co2prog(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_co2diag(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lamult(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ustokes(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_vstokes(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_taux(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_tauy(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_sen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lat(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_osalt(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lwdn(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lwup(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_swnet(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_rofl(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_rofi(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_meltw(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_melth(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_iosalt(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_prec(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_rain(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_snow(:,:) + + character(len=*),parameter :: subname = '(ocn_import)' + + call State_getFldPtr(importState,'Sa_pslv', dataPtr_p,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,'Si_ifrac', dataPtr_ifrac,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"So_duu10n", dataPtr_duu10n, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +! call State_getFldPtr(importState,"Sa_co2prog", dataPtr_co2prog, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out +! call State_getFldPtr(importState,"Sa_co2diag", dataPtr_co2diag, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out + call State_getFldPtr(importState,"Sw_lamult", dataPtr_lamult, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Sw_ustokes", dataPtr_ustokes, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Sw_vstokes", dataPtr_vstokes, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_taux" , dataPtr_taux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_tauy" , dataPtr_tauy, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_sen" , dataPtr_sen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_lat" , dataPtr_lat, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_evap" , dataPtr_evap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_salt" , dataPtr_osalt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_lwdn" , dataPtr_lwdn, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_lwup" , dataPtr_lwup, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_swnet", dataPtr_swnet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_rofl" , dataPtr_rofl, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_rofi" , dataPtr_rofi, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_meltw", dataPtr_meltw, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_melth", dataPtr_melth, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_salt" , dataPtr_iosalt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_prec" , dataPtr_prec, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_rain" , dataPtr_rain, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_snow" , dataPtr_snow, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr_p,1) + ubnd1 = ubound(dataPtr_p,1) + lbnd2 = lbound(dataPtr_p,2) + ubnd2 = ubound(dataPtr_p,2) + + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + +!tcx +! write(tmpstr,'(a,6i8)') subname//'tcx1',lbnd1,ubnd1,lbnd2,ubnd2 +! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) +! write(tmpstr,'(a,6i8)') subname//'tcx2',isc,iec,jsc,jec +! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) +! write(tmpstr,'(a,6i8)') subname//'tcx3',i,j,i1,j1 +! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) +! write(tmpstr,'(a,6i8)') subname//'tcx4',lbound(ice_ocean_boundary%p,1),ubound(ice_ocean_boundary%p,1),lbound(ice_ocean_boundary%p,2),ubound(ice_ocean_boundary%p,2) +! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) +! write(tmpstr,'(a,6i8)') subname//'tcx5',lbound(grid%mask2dT,1),ubound(grid%mask2dT,1),lbound(grid%mask2dT,2),ubound(grid%mask2dT,2) +! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + do j = jsc,jec + do i = isc,iec + i1 = i + lbnd1 - isc + j1 = j + lbnd2 - jsc + + ice_ocean_boundary%p(i,j) = GRID%mask2dT(i,j) * dataPtr_p(i1,j1) + + ice_ocean_boundary%u_flux(i,j) = (GRID%cos_rot(i1,j1)*dataPtr_taux(i1,j1) + & + GRID%sin_rot(i1,j1)*dataPtr_tauy(i1,j1)) + ice_ocean_boundary%v_flux(i,j) = (GRID%cos_rot(i1,j1)*dataPtr_tauy(i1,j1) + & + GRID%sin_rot(i1,j1)*dataPtr_taux(i1,j1)) + + ice_ocean_boundary%t_flux(i,j) = dataPtr_sen(i1,j1) * GRID%mask2dT(i,j) + ice_ocean_boundary%q_flux(i,j) = dataPtr_evap(i1,j1) * GRID%mask2dT(i,j) +! ice_ocean_boundary%latent(i,j) = dataPtr_lat(i1,j1) * GRID%mask2dT(i,j) + ice_ocean_boundary%lw_flux(i,j) = (dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1)) * GRID%mask2dT(i,j) + +! tcx TO DO c1-c4 + c1 = 0.25_ESMF_KIND_R8 + c2 = 0.25_ESMF_KIND_R8 + c3 = 0.25_ESMF_KIND_R8 + c4 = 0.25_ESMF_KIND_R8 + ice_ocean_boundary%sw_flux_vis_dir(i,j) = GRID%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c1 + ice_ocean_boundary%sw_flux_vis_dif(i,j) = GRID%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c2 + ice_ocean_boundary%sw_flux_nir_dir(i,j) = GRID%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c3 + ice_ocean_boundary%sw_flux_nir_dif(i,j) = GRID%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c4 + +! ice_ocean_boundary%sw(i,j) = ice_ocean_boundary%sw_flux_vis_dir(i,j) + ice_ocean_boundary%sw_flux_vis_dif(i,j) + & +! ice_ocean_boundary%sw_flux_nir_dir(i,j) + ice_ocean_boundary%sw_flux_nir_dif(i,j) + + ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) * GRID%mask2dT(i,j) + ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) * GRID%mask2dT(i,j) + ice_ocean_boundary%runoff(i,j) = (dataPtr_rofl(i1,j1)+dataPtr_rofi(i1,j1)) * GRID%mask2dT(i,j) + ice_ocean_boundary%runoff_hflx(i,j) = 0.0 * GRID%mask2dT(i,j) + ice_ocean_boundary%calving(i,j) = 0.0 * GRID%mask2dT(i,j) + ice_ocean_boundary%calving_hflx(i,j) = 0.0 * GRID%mask2dT(i,j) + ice_ocean_boundary%salt_flux(i,j) = GRID%mask2dT(i,j)*dataPtr_iosalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j) = GRID%mask2dT(i,j)*(dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j)) + + ice_ocean_boundary%ustar_berg(i,j) = 0.0 * GRID%mask2dT(i,j) + ice_ocean_boundary%area_berg(i,j) = 0.0 * GRID%mask2dT(i,j) + ice_ocean_boundary%mass_berg(i,j) = 0.0 * GRID%mask2dT(i,j) + ice_ocean_boundary%mi(i,j) = 0.0 * GRID%mask2dT(i,j) + + enddo + enddo + +end subroutine ocn_import + + + !----------------------------------------------------------------------------- + + subroutine State_GetFldPtr(ST, fldname, fldptr, rc) + type(ESMF_State), intent(in) :: ST + character(len=*), intent(in) :: fldname + real(ESMF_KIND_R8), pointer, intent(in) :: fldptr(:,:) + integer, intent(out), optional :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrc + character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' + + call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (present(rc)) rc = lrc + + end subroutine State_GetFldPtr + +end module mom_cap_methods diff --git a/config_src/nuopc_driver/ocn_comp_nuopc.F90.01 b/config_src/nuopc_driver/ocn_comp_nuopc.F90.01 new file mode 100644 index 0000000000..e69de29bb2 diff --git a/config_src/nuopc_driver/ocn_comp_nuopc.F90.02 b/config_src/nuopc_driver/ocn_comp_nuopc.F90.02 new file mode 100644 index 0000000000..5b7b394c0c --- /dev/null +++ b/config_src/nuopc_driver/ocn_comp_nuopc.F90.02 @@ -0,0 +1,2218 @@ +!> This is the main driver for MOM6 in CIME +module ocn_comp_nuopc + +! This file is part of MOM6. See LICENSE.md for the license. + +! mct modules +use ESMF +use perf_mod, only: t_startf, t_stopf +use shr_kind_mod, only: shr_kind_r8 +use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit, shr_file_setIO, & + shr_file_getLogUnit, shr_file_getLogLevel, & + shr_file_setLogUnit, shr_file_setLogLevel + +! MOM6 modules +use MOM_coms, only : reproducing_sum +use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end +use MOM_cpu_clock, only : CLOCK_SUBCOMPONENT +use MOM, only: initialize_MOM, step_MOM, MOM_control_struct, MOM_end +use MOM, only: calculate_surface_state, allocate_surface_state +use MOM, only: finish_MOM_initialization, step_offline +use MOM_forcing_type, only: forcing, forcing_diags, register_forcing_type_diags +use MOM_forcing_type, only: allocate_forcing_type, deallocate_forcing_type +use MOM_forcing_type, only: mech_forcing_diags, forcing_accumulate, forcing_diagnostics +use MOM_forcing_type, only: mech_forcing, allocate_mech_forcing, copy_back_forcing_fields +use MOM_forcing_type, only: set_net_mass_forcing, set_derived_forcing_fields +use MOM_forcing_type, only: copy_common_forcing_fields +use MOM_restart, only: save_restart +use MOM_domains, only: MOM_infra_init, num_pes, root_pe, pe_here +use MOM_domains, only: pass_vector, BGRID_NE, CGRID_NE, To_All +use MOM_domains, only: pass_var, AGRID, fill_symmetric_edges +use MOM_grid, only: ocean_grid_type, get_global_grid_size +use MOM_verticalGrid, only: verticalGrid_type +use MOM_variables, only: surface +use MOM_error_handler, only: MOM_error, FATAL, is_root_pe, WARNING +use MOM_error_handler, only: callTree_enter, callTree_leave +use MOM_time_manager, only: time_type, set_date, set_time, set_calendar_type, NOLEAP, get_date +use MOM_time_manager, only: operator(+), operator(-), operator(*), operator(/) +use MOM_time_manager, only: operator(/=), operator(>), get_time +use MOM_file_parser, only: get_param, log_version, param_file_type, close_param_file +use MOM_get_input, only: Get_MOM_Input, directories +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_diag_mediator, only: safe_alloc_ptr +use MOM_ice_shelf, only: initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS +use MOM_ice_shelf, only: ice_shelf_end, ice_shelf_save_restart +use MOM_sum_output, only: MOM_sum_output_init, sum_output_CS +use MOM_sum_output, only: write_energy, accumulate_net_input +use MOM_string_functions, only: uppercase +use MOM_constants, only: CELSIUS_KELVIN_OFFSET, hlf, hlv +use MOM_EOS, only: gsw_sp_from_sr, gsw_pt_from_ct +use user_revise_forcing, only : user_alter_forcing, user_revise_forcing_init +use user_revise_forcing, only : user_revise_forcing_CS +use MOM_restart, only : restart_init, MOM_restart_CS +use MOM_restart, only : restart_init_end, save_restart, restore_state +use data_override_mod, only : data_override_init, data_override +use MOM_io, only : slasher, write_version_number +use MOM_spatial_means, only : adjust_area_mean_to_zero + +! FMS modules +use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain, mpp_get_data_domain +use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain +use time_interp_external_mod, only : init_external_field, time_interp_external +use time_interp_external_mod, only : time_interp_external_init +use fms_mod, only : read_data + +! GFDL coupler modules +use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type +use coupler_types_mod, only : coupler_type_spawn +use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data + +! By default make data private +implicit none; private + +#include + +! Public member functions +public :: ocean_model_init +public :: ocean_model_init_sfc +public :: update_ocean_model +public :: ocn_export +public :: ocean_model_data_get +public :: get_ocean_grid +public :: ocean_model_end + +interface ocean_model_data_get + module procedure ocean_model_data1D_get + module procedure ocean_model_data2D_get +end interface + +! Flag for debugging +logical, parameter :: debug=.true. + +!> 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. + 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. + + integer :: stagger = -999 !< The staggering relative to the tracer points + !! of the two velocity components. Valid entries + !! include AGRID, BGRID_NE, CGRID_NE, BGRID_SW, and CGRID_SW, + !! corresponding to the community-standard Arakawa notation. + !! (These are named integers taken from mpp_parameter_mod.) + !! Following MOM, this is BGRID_NE by default when the ocean + !! is initialized, but here it is set to -999 so that a + !! global max across ocean and non-ocean processors can be + !! used to determine its value. + real, pointer, dimension(:,:) :: & + t_surf => NULL(), & !< SST on t-cell (degrees Kelvin) + s_surf => NULL(), & !< SSS on t-cell (psu) + u_surf => NULL(), & !< i-velocity at the locations indicated by stagger, m/s. + v_surf => NULL(), & !< j-velocity at the locations indicated by stagger, m/s. + sea_lev => NULL(), & !< Sea level in m after correction for surface pressure, + !! i.e. dzt(1) + eta_t + patm/rho0/grav (m) + frazil =>NULL(), & !< Accumulated heating (in Joules/m^2) from frazil + !! formation in the ocean. + area => NULL() !< cell area of the ocean surface, in m2. + 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. + integer, dimension(2) :: axes = 0 !< Axis numbers that are available + ! for I/O using this surface data. +end type ocean_public_type + +!> Contains pointers to the forcing fields which may be used to drive MOM. +!! All fluxes are positive downward. +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 + 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 :: 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 + !! structure does not limit the water that can be + !! frozen out of the ocean and the ice-ocean heat + !! fluxes are treated explicitly. + logical :: use_limited_P_SSH !< 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. The default is true. + 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. + gust => NULL(), & !< spatially varying unresolved background + !! 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) + real :: cd_tides !< drag coefficient that applies to the tides (nondimensional) + real :: utide !< constant tidal velocity to use if read_tideamp + !! is false, in 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 :: 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. + logical :: allow_flux_adjustments !< If true, use data_override to obtain flux adjustments + 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 :: 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) + 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 + 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 + 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 + 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 + !### 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 +end type surface_forcing_CS + +!> Contains information about the ocean state, although it is not necessary that +!! this is implemented with all models. This type is private, and can therefore vary +!! between different ocean models. +type, public :: ocean_state_type ; private + 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. + type(time_type) :: energysavedays !< The interval between writing the energies + !! and other integral quantities of the run. + type(time_type) :: write_energy_time !< The next time to write to the energy file. + 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 :: 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 + !! restore sst to a specified value. + real :: press_to_z !< A conversion factor between pressure and ocean + !! depth in m, usually 1/(rho_0*g), in m Pa-1. + real :: C_p !< The heat capacity of seawater, in J K-1 kg-1. + type(directories) :: dirs !< A structure containing several relevant directory paths. + type(mech_forcing) :: forces!< A structure with the driving mechanical forces + type(forcing) :: fluxes !< A structure containing pointers to + !! the 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) :: 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(MOM_control_struct), pointer :: MOM_CSp => NULL() + type(surface_forcing_CS), pointer :: forcing_CSp => NULL() + type(sum_output_CS), pointer :: sum_output_CSp => NULL() +end type ocean_state_type + +integer :: id_clock_forcing +integer :: rc + +contains + + +!> Initializes the ocean model, including registering fields +!! for restarts and reading restart files if appropriate. +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). + 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. + type(time_type), intent(in) :: Time_init !< The start time for the coupled model's calendar + type(time_type), intent(in) :: Time_in !< The time at which to initialize the ocean model. + 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, 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 :: Time_unit !< The time unit in seconds for ENERGYSAVEDAYS. + real :: Rho0 !< The Boussinesq ocean density, in kg m-3. + real :: G_Earth !< The gravitational acceleration in m s-2. + !! This include declares and sets the variable "version". +#include "version_variable.h" + character(len=40) :: mdl = "ocean_model_init" !< This module's name. + character(len=48) :: stagger + integer :: secs, days + type(param_file_type) :: param_file !< A structure to parse for run-time parameters + logical :: offline_tracer_mode + + call callTree_enter("ocean_model_init(), ocn_comp_nuopc.F90") + if (associated(OS)) then + call MOM_error(WARNING, "ocean_model_init called with an associated "// & + "ocean_state_type structure. Model is already initialized.") + return + endif + allocate(OS) + + OS%is_ocean_pe = Ocean_sfc%is_ocean_pe + if (.not.OS%is_ocean_pe) return + + OS%Time = Time_in + call initialize_MOM(OS%Time, param_file, OS%dirs, OS%MOM_CSp, Time_in, & + offline_tracer_mode=offline_tracer_mode, input_restart_file=input_restart_file) + OS%grid => OS%MOM_CSp%G ; OS%GV => OS%MOM_CSp%GV + OS%C_p = OS%MOM_CSp%tv%C_p + OS%fluxes%C_p = OS%MOM_CSp%tv%C_p + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "RESTART_CONTROL", OS%Restart_control, & + "An integer whose bits encode which restart files are \n"//& + "written. Add 2 (bit 1) for a time-stamped file, and odd \n"//& + "(bit 0) for a non-time-stamped file. A restart file \n"//& + "will be saved at the end of the run segment for any \n"//& + "non-negative value.", default=1) + call get_param(param_file, mdl, "TIMEUNIT", Time_unit, & + "The time unit for ENERGYSAVEDAYS.", & + units="s", default=86400.0) + call get_param(param_file, mdl, "ENERGYSAVEDAYS",OS%energysavedays, & + "The interval in units of TIMEUNIT between saves of the \n"//& + "energies of the run and other globally summed diagnostics.", & + default=set_time(0,days=1), timeunit=Time_unit) + + call get_param(param_file, 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', '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.") ; 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"//& + "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"//& + "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"//& + "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, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) + + 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, & + "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 \n"//& + "below berg are set to zero. Not applied for negative \n"//& + " values.", units="non-dim", default=-1.0) + endif + + OS%press_to_z = 1.0/(Rho0*G_Earth) + + ! 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%state, OS%grid, OS%MOM_CSp%use_temperature, & + do_integrals=.true., gas_fields_ocn=gas_fields_ocn) + + call surface_forcing_init(Time_in, OS%grid, param_file, OS%MOM_CSp%diag, & + OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) + + if (OS%use_ice_shelf) then + call initialize_ice_shelf(param_file, OS%grid, OS%Time, OS%ice_shelf_CSp, & + OS%MOM_CSp%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.) + endif + + call MOM_sum_output_init(OS%grid, param_file, OS%dirs%output_directory, & + OS%MOM_CSp%ntrunc, Time_init, OS%sum_output_CSp) + + ! This call has been moved into the first call to update_ocean_model. +! call write_energy(OS%MOM_CSp%u, OS%MOM_CSp%v, OS%MOM_CSp%h, OS%MOM_CSp%tv, & +! OS%Time, 0, OS%grid, OS%GV, OS%sum_output_CSp, OS%MOM_CSp%tracer_flow_CSp) + + ! write_energy_time is the next integral multiple of energysavedays. + OS%write_energy_time = Time_init + OS%energysavedays * & + (1 + (OS%Time - Time_init) / OS%energysavedays) + + if (ASSOCIATED(OS%grid%Domain%maskmap)) then + call initialize_ocean_public_type(OS%grid%Domain%mpp_domain, Ocean_sfc, & + OS%MOM_CSp%diag, maskmap=OS%grid%Domain%maskmap, & + gas_fields_ocn=gas_fields_ocn) + else + call initialize_ocean_public_type(OS%grid%Domain%mpp_domain, Ocean_sfc, & + OS%MOM_CSp%diag, gas_fields_ocn=gas_fields_ocn) + endif + + ! 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 calculate_surface_state(OS%state, OS%MOM_CSp%u, & + OS%MOM_CSp%v, OS%MOM_CSp%h, OS%MOM_CSp%ave_ssh,& + OS%grid, OS%GV, OS%MOM_CSp) + + call convert_state_to_ocean_type(OS%state, Ocean_sfc, OS%grid, & + OS%MOM_CSp%use_conT_absS) + endif + + call close_param_file(param_file) + call diag_mediator_close_registration(OS%MOM_CSp%diag) + +! if (is_root_pe()) & +! write(glb%stdout,'(/12x,a/)') '======== COMPLETED MOM INITIALIZATION ========' + + call callTree_leave("ocean_model_init(") +end subroutine ocean_model_init + +!> 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 + type(ocean_public_type), intent(inout) :: Ocean_sfc + + integer :: is, ie, js, je + + is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec + call coupler_type_spawn(Ocean_sfc%fields, OS%state%tr_fields, & + (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) + + call calculate_surface_state(OS%state, OS%MOM_CSp%u, & + OS%MOM_CSp%v, OS%MOM_CSp%h, OS%MOM_CSp%ave_ssh,& + OS%grid, OS%GV, OS%MOM_CSp) + + call convert_state_to_ocean_type(OS%state, Ocean_sfc, OS%grid, & + OS%MOM_CSp%use_conT_absS) + +end subroutine ocean_model_init_sfc + +!> Initializes surface forcing: get relevant parameters and allocate arrays. +subroutine surface_forcing_init(Time, G, 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(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 + + ! 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_nuopc" ! This module's name. + character(len=48) :: stagger + character(len=240) :: basin_file + integer :: i, j, isd, ied, jsd, jed + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + + if (associated(CS)) then + call MOM_error(WARNING, "surface_forcing_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + + id_clock_forcing=cpu_clock_id('Ocean surface forcing', grain=CLOCK_SUBCOMPONENT) + call cpu_clock_begin(id_clock_forcing) + + CS%diag => diag + + call write_version_number (version) + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mdl, version, "") + + call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, & + "The directory in which all input files are found.", & + default=".") + CS%inputdir = slasher(CS%inputdir) + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + "If true, Temperature and salinity are used as state \n"//& + "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"//& + "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, & + "The latent heat of fusion.", units="J/kg", default=hlf) + 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"//& + "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"//& + "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"//& + "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"//& + "by the ocean (including restoring) to zero.", 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"//& + "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"//& + "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"//& + "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 \n"//& + "staggering of the input wind stress field. Valid \n"//& + "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 + elseif (uppercase(stagger(1:1)) == 'C') then ; CS%wind_stagger = CGRID_NE + else ; call MOM_error(FATAL,"surface_forcing_init: WIND_STAGGER = "// & + trim(stagger)//" is invalid.") ; endif + call get_param(param_file, mdl, "WIND_STRESS_MULTIPLIER", CS%wind_stress_multiplier, & + "A factor multiplying the wind-stress given to the ocean by the\n"//& + "coupler. This is used for testing and should be =1.0 for any\n"//& + "production runs.", default=1.0) + + if (restore_salt) then + call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & + "The constant that relates the restoring surface fluxes \n"//& + "to the relative surface anomalies (akin to a piston \n"//& + "velocity). Note the non-MKS units.", units="m day-1", & + fail_if_missing=.true.) + call get_param(param_file, mdl, "SALT_RESTORE_FILE", CS%salt_restore_file, & + "A file in which to find the surface salinity to use for restoring.", & + default="salt_restore.nc") + call get_param(param_file, mdl, "SALT_RESTORE_VARIABLE", CS%salt_restore_var_name, & + "The name of the surface salinity variable to read from "//& + "SALT_RESTORE_FILE for restoring salinity.", & + default="salt") +! Convert CS%Flux_const from m day-1 to m s-1. + CS%Flux_const = CS%Flux_const / 86400.0 + + call get_param(param_file, mdl, "SRESTORE_AS_SFLUX", CS%salt_restore_as_sflux, & + "If true, the restoring of salinity is applied as a salt \n"//& + "flux instead of as a freshwater flux.", default=.false.) + call get_param(param_file, 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"//& + "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"//& + "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'.", & + default="basin.nc") + 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) + 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 + 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"//& + "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, & + "A file in which to find the surface temperature to use for restoring.", & + default="temp_restore.nc") + call get_param(param_file, mdl, "SST_RESTORE_VARIABLE", CS%temp_restore_var_name, & + "The name of the surface temperature variable to read from "//& + "SST_RESTORE_FILE for restoring sst.", & + default="temp") +! Convert CS%Flux_const from m day-1 to m s-1. + CS%Flux_const = CS%Flux_const / 86400.0 + + call get_param(param_file, mdl, "MAX_DELTA_TRESTORE", CS%max_delta_trestore, & + "The maximum sst difference used in restoring terms.", & + units="degC ", default=999.0) + + endif + +! 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. + call get_param(param_file, mdl, "CD_TIDES", CS%cd_tides, & + "The drag coefficient that applies to the tides.", & + units="nondim", default=1.0e-4) + call get_param(param_file, mdl, "READ_TIDEAMP", CS%read_TIDEAMP, & + "If true, read a file (given by TIDEAMP_FILE) containing \n"//& + "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) + if (CS%read_TIDEAMP) then + call get_param(param_file, mdl, "TIDEAMP_FILE", TideAmp_file, & + "The path to the file containing the spatially varying \n"//& + "tidal amplitudes with INT_TIDE_DISSIPATION.", & + default="tideamp.nc") + CS%utide=0.0 + else + call get_param(param_file, mdl, "UTIDE", CS%utide, & + "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & + units="m s-1", default=0.0) + endif + + call safe_alloc_ptr(CS%TKE_tidal,isd,ied,jsd,jed) + call safe_alloc_ptr(CS%ustar_tidal,isd,ied,jsd,jed) + + 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) + 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) + CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + enddo ; enddo + else + do j=jsd,jed; do i=isd,ied + utide=CS%utide + CS%TKE_tidal(i,j) = CS%Rho0*CS%cd_tides*(utide*utide*utide) + CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + enddo ; enddo + endif + + call time_interp_external_init + +! Optionally read a x-y gustiness field in place of a global +! constant. + + call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & + "If true, use a 2-dimensional gustiness supplied from \n"//& + "an input file", default=.false.) + call get_param(param_file, 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"//& + "variable gustiness.") + + 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 + endif + +! 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"//& + "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"//& + "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"//& + "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"//& + "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"//& + "as seen by MOM6.", default=.false.) + call register_forcing_type_diags(Time, diag, CS%use_temperature, CS%handles, & + use_berg_fluxes=iceberg_flux_diags) + + call get_param(param_file, mdl, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, & + "If true, allows flux adjustments to specified via the \n"//& + "data_table using the component name 'OCN'.", default=.false.) + if (CS%allow_flux_adjustments) then + call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) + endif + + 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) + 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) + endif ; endif + + ! Set up any restart fields associated with the forcing. + call restart_init(param_file, CS%restart_CSp, "MOM_forcing.res") +!### call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & +!### CS%restart_CSp) + call restart_init_end(CS%restart_CSp) + + if (associated(CS%restart_CSp)) then + call Get_MOM_Input(dirs=dirs) + + new_sim = .false. + if ((dirs%input_filename(1:1) == 'n') .and. & + (LEN_TRIM(dirs%input_filename) == 1)) new_sim = .true. + if (.not.new_sim) then + call restore_state(dirs%input_filename, dirs%restart_input_dir, Time_frc, & + G, CS%restart_CSp) + endif + endif + +!### call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) + + call user_revise_forcing_init(param_file, CS%urf_CS) + + call cpu_clock_end(id_clock_forcing) +end subroutine surface_forcing_init + +!> Initializes domain and state variables contained in the ocean public 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(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 + integer :: xsz, ysz, layout(2) + integer :: isc, iec, jsc, jec + + call mpp_get_layout(input_domain,layout) + call mpp_get_global_domain(input_domain, xsize=xsz, ysize=ysz) + if(PRESENT(maskmap)) then + call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain, maskmap=maskmap) + else + call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain) + endif + call mpp_get_compute_domain(Ocean_sfc%Domain, isc, iec, jsc, jec) + + allocate ( Ocean_sfc%t_surf (isc:iec,jsc:jec), & + Ocean_sfc%s_surf (isc:iec,jsc:jec), & + Ocean_sfc%u_surf (isc:iec,jsc:jec), & + Ocean_sfc%v_surf (isc:iec,jsc:jec), & + Ocean_sfc%sea_lev(isc:iec,jsc:jec), & + Ocean_sfc%area (isc:iec,jsc:jec), & + Ocean_sfc%frazil (isc:iec,jsc:jec)) + + Ocean_sfc%t_surf = 0.0 ! time averaged sst (Kelvin) passed to atmosphere/ice model + Ocean_sfc%s_surf = 0.0 ! time averaged sss (psu) passed to atmosphere/ice models + Ocean_sfc%u_surf = 0.0 ! time averaged u-current (m/sec) passed to atmosphere/ice models + Ocean_sfc%v_surf = 0.0 ! time averaged v-current (m/sec) passed to atmosphere/ice models + Ocean_sfc%sea_lev = 0.0 ! time averaged thickness of top model grid cell (m) plus patm/rho0/grav + Ocean_sfc%frazil = 0.0 ! time accumulated frazil (J/m^2) passed to ice model + Ocean_sfc%area = 0.0 + Ocean_sfc%axes = diag%axesT1%handles !diag axes to be used by coupler tracer flux diagnostics + + if (present(gas_fields_ocn)) then + call coupler_type_spawn(gas_fields_ocn, Ocean_sfc%fields, (/isc,isc,iec,iec/), & + (/jsc,jsc,jec,jec/), suffix = '_ocn', as_needed=.true.) + endif + +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, use_conT_absS, & + 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 + logical, intent(in) :: use_conT_absS !< If true, , the prognostics + !! T&S are the conservative temperature + real, optional, intent(in) :: patm(:,:) !< Atmospheric pressure. + real, optional, intent(in) :: press_to_z !< Factor to tranform atmospheric + !! pressure to z? + + ! 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 mpp_get_compute_domain(Ocean_sfc%Domain, isc_bnd, iec_bnd, & + jsc_bnd, jec_bnd) + if (present(patm)) then + ! Check that the inidicies in patm are (isc_bnd:iec_bnd,jsc_bnd:jec_bnd). + if (.not.present(press_to_z)) call MOM_error(FATAL, & + 'convert_state_to_ocean_type: press_to_z must be present if patm is.') + endif + + i0 = is - isc_bnd ; j0 = js - jsc_bnd + !If directed convert the surface T&S + !from conservative T to potential T and + !from absolute (reference) salinity to practical salinity + ! + if(use_conT_absS) then + 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%t_surf(i,j) = gsw_pt_from_ct(state%SSS(i+i0,j+j0),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%s_surf(i,j) = 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) + 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) + Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + enddo ; enddo + + 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)) + 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)) + 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) + enddo ; enddo + else + write(val_str, '(I8)') Ocean_sfc%stagger + call MOM_error(FATAL, "convert_state_to_ocean_type: "//& + "Ocean_sfc%stagger has the unrecognized value of "//trim(val_str)) + endif + + if (coupler_type_initialized(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) + endif + +end subroutine convert_state_to_ocean_type + +!> Returns pointers to objects within ocean_state_type +subroutine get_state_pointers(OS, grid, surf) + type(ocean_state_type), pointer :: OS !< Ocean state type + type(ocean_grid_type), optional, pointer :: grid !< Ocean grid + type(surface), optional, pointer :: surf !< Ocean surface state + + if (present(grid)) grid => OS%grid + if (present(surf)) surf=> OS%state + +end subroutine get_state_pointers + +!> Maps outgoing ocean data to MCT buffer. +!! See \ref section_ocn_export for a summary of the data +!! that is transferred from MOM6 to MCT. +subroutine ocn_export(ocn_public, grid, exportState) + type(ocean_public_type), intent(in) :: ocn_public !< Ocean surface state + type(ocean_grid_type), intent(in) :: grid !< Ocean model grid + type(ESMF_State), intent(inout) :: exportState !< outgoing data + ! Local variables + real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo + integer :: i, j, i1, j1, n, ig, jg !< Grid indices + integer :: lbnd1, lbnd2, ubnd1, ubnd2 + real :: slp_L, slp_R, slp_C, slope, u_min, u_max + real(ESMF_KIND_R8), pointer :: dataPtr_omask(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_t(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_s(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_u(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_v(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_q(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fswpen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_roce_16O(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_roce_HDO(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fco2_ocn(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fdms_ocn(:,:) + + call State_getFldPtr(exportState,"So_omask", dataPtr_omask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_t", dataPtr_t, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_s", dataPtr_s, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_u", dataPtr_u, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_v", dataPtr_v, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"Fioo_q", dataPtr_q, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_dhdx", dataPtr_dhdx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_dhdy", dataPtr_dhdy, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_bldepth", dataPtr_bldepth, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_fswpen", dataPtr_fswpen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +! call State_getFldPtr(exportState,"So_roce_16O", dataPtr_roce_16O, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out +! call State_getFldPtr(exportState,"So_roce_HDO", dataPtr_roce_HDO, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out +! call State_getFldPtr(exportState,"Faoo_fco2_ocn", dataPtr_fco2_ocn, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out +! call State_getFldPtr(exportState,"Faoo_fdms_ocn", dataPtr_fdms_ocn, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out + + lbnd1 = lbound(dataPtr_t,1) + ubnd1 = ubound(dataPtr_t,1) + lbnd2 = lbound(dataPtr_t,2) + ubnd2 = ubound(dataPtr_t,2) + + ! Copy from ocn_public to exportstate. ocn_public uses global indexing with no halos. + ! The mask comes from "grid" that uses the usual MOM domain that has halos + ! and does not use global indexing. + do j=grid%jsc, grid%jec + jg = j + grid%jdg_offset + j1 = j + lbnd2 - grid%jsc + do i=grid%isc,grid%iec + ig = i + grid%idg_offset + i1 = i + lbnd1 - grid%isc + ! surface temperature in Kelvin + dataPtr_t(i1,j1) = ocn_public%t_surf(ig,jg) * grid%mask2dT(i,j) + dataPtr_s(i1,j1) = ocn_public%s_surf(ig,jg) * grid%mask2dT(i,j) + dataPtr_u(i1,j1) = ocn_public%u_surf(ig,jg) * grid%mask2dT(i,j) + dataPtr_v(i1,j1) = ocn_public%v_surf(ig,jg) * grid%mask2dT(i,j) + ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain + ! in order to update halos. i.e. does not use global indexing. + ssh(i,j) = ocn_public%sea_lev(ig,jg) + end do + end do + + ! Update halo of ssh so we can calculate gradients + call pass_var(ssh, grid%domain) + + ! d/dx ssh + do j=grid%jsc, grid%jec + j1 = j + lbnd2 - grid%jsc + do i=grid%isc,grid%iec + i1 = i + lbnd1 - grid%isc + ! This is a simple second-order difference + !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) + if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(I,j) + if (grid%mask2dCu(I+1,j)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + if ( (slp_L * slp_R) > 0.0 ) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + dataPtr_dhdx(i1,j1) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) dataPtr_dhdx(i1,j1) = 0.0 + end do + end do + + ! d/dy ssh + do j=grid%jsc, grid%jec + j1 = j + lbnd2 - grid%jsc + do i=grid%isc,grid%iec + i1 = i + lbnd1 - grid%isc + ! This is a simple second-order difference + !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) + if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. + slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,J) + if (grid%mask2dCv(i,J+1)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R + if ((slp_L * slp_R) > 0.0) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + dataPtr_dhdy(i1,j1) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) dataPtr_dhdy(i1,j1) = 0.0 + end do + end do + +end subroutine ocn_export + + +!> Saves restart fields associated with the 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(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 + 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 + +!> 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. +subroutine update_ocean_model(ImportState, OS, Ocean_sfc, time_start_update, & + Ocean_coupling_time_step, sw_decomp, & + c1, c2, c3, c4) + type(ESMF_State), intent(in) :: ImportState + type(ocean_state_type), pointer :: OS !< Structure containing the internal ocean state + type(ocean_public_type), intent(inout) :: Ocean_sfc !< Structure containing all the publicly + !! visible ocean surface fields after a coupling time step + type(time_type), intent(in) :: time_start_update !< Time at the beginning of the update step + type(time_type), intent(in) :: Ocean_coupling_time_step !< Amount of time over which to + !! advance the ocean + logical, intent(in) :: sw_decomp !< controls if shortwave is + !!decomposed into four components + real(kind=8), intent(in), optional :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition + + ! 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. + real :: weight !< Flux accumulation weight + real :: time_step !< The time step of a call to step_MOM in seconds. + integer :: secs, days + integer :: is, ie, js, je + + call callTree_enter("update_ocean_model(), ocn_comp_nuopc.F90") + call get_time(Ocean_coupling_time_step, secs, days) + time_step = 86400.0*real(days) + real(secs) + + if (time_start_update /= OS%Time) then + call MOM_error(WARNING, "update_ocean_model: internal clock does not "//& + "agree with time_start_update argument.") + endif + + if (.not.associated(OS)) then + call MOM_error(FATAL, "update_ocean_model called with an unassociated "// & + "ocean_state_type structure. ocean_model_init must be "// & + "called first to allocate this structure.") + return + endif + + ! This is benign but not necessary if ocean_model_init_sfc was called or if + ! OS%state%tr_fields was spawnded in ocean_model_init. Consider removing it. + is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec + call coupler_type_spawn(Ocean_sfc%fields, OS%state%tr_fields, & + (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) + + weight = 1.0 + + if (OS%fluxes%fluxes_used) then + ! GMM, is enable_averaging needed now? + call enable_averaging(time_step, OS%Time + Ocean_coupling_time_step, OS%MOM_CSp%diag) + call ocn_import(OS%forces, OS%fluxes, OS%Time, OS%grid, OS%forcing_CSp, OS%state, ImportState, sw_decomp, & + c1, c2, c3, c4, 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 + + ! Add ice shelf fluxes + if (OS%use_ice_shelf) then + call shelf_calc_flux(OS%State, OS%forces, OS%fluxes, OS%Time, time_step, OS%Ice_shelf_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%fluxes,OS%use_ice_shelf,OS%density_iceberg,OS%kv_iceberg, OS%latent_heat_fusion, OS%State, time_step, OS%berg_area_threshold) + !endif + + ! Indicate that there are new unused fluxes. + OS%fluxes%fluxes_used = .false. + OS%fluxes%dt_buoy_accum = time_step + 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 ocn_import(OS%forces, OS%flux_tmp, OS%Time, OS%grid, OS%forcing_CSp, & + OS%state, ImportState, sw_decomp, c1, c2, c3, c4, & + OS%restore_salinity,OS%restore_temp) + + if (OS%use_ice_shelf) then + call shelf_calc_flux(OS%State, OS%forces, OS%flux_tmp, OS%Time, time_step, OS%Ice_shelf_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%State, time_step, 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) + ! 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. + 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 + endif + + call set_derived_forcing_fields(OS%forces, OS%fluxes, OS%grid, OS%GV%Rho0) + call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid) + + if (OS%nstep==0) then + call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%fluxes) + + call write_energy(OS%MOM_CSp%u, OS%MOM_CSp%v, OS%MOM_CSp%h, OS%MOM_CSp%tv, & + OS%Time, 0, OS%grid, OS%GV, OS%sum_output_CSp, & + OS%MOM_CSp%tracer_flow_CSp) + endif + + call disable_averaging(OS%MOM_CSp%diag) + Master_time = OS%Time ; Time1 = OS%Time + + if(OS%MOM_Csp%offline_tracer_mode) then + call step_offline(OS%forces, OS%fluxes, OS%state, Time1, time_step, OS%MOM_CSp) + else + call step_MOM(OS%forces, OS%fluxes, OS%state, Time1, time_step, OS%MOM_CSp) + endif + + OS%Time = Master_time + Ocean_coupling_time_step + OS%nstep = OS%nstep + 1 + + call enable_averaging(time_step, OS%Time, OS%MOM_CSp%diag) + call mech_forcing_diags(OS%forces, OS%fluxes, time_step, OS%grid, & + OS%MOM_CSp%diag, OS%forcing_CSp%handles) + call disable_averaging(OS%MOM_CSp%diag) + + if (OS%fluxes%fluxes_used) then + call enable_averaging(OS%fluxes%dt_buoy_accum, OS%Time, OS%MOM_CSp%diag) + call forcing_diagnostics(OS%fluxes, OS%state, OS%fluxes%dt_buoy_accum, & + OS%grid, OS%MOM_CSp%diag, OS%forcing_CSp%handles) + call accumulate_net_input(OS%fluxes, OS%state, OS%fluxes%dt_buoy_accum, & + OS%grid, OS%sum_output_CSp) + call disable_averaging(OS%MOM_CSp%diag) + endif + +! See if it is time to write out the energy. + if ((OS%Time + ((Ocean_coupling_time_step)/2) > OS%write_energy_time) .and. & + (OS%MOM_CSp%t_dyn_rel_adv==0.0)) then + call write_energy(OS%MOM_CSp%u, OS%MOM_CSp%v, OS%MOM_CSp%h, OS%MOM_CSp%tv, & + OS%Time, OS%nstep, OS%grid, OS%GV, OS%sum_output_CSp, & + OS%MOM_CSp%tracer_flow_CSp) + OS%write_energy_time = OS%write_energy_time + OS%energysavedays + endif + +! Translate state into Ocean. +! call convert_state_to_ocean_type(OS%state, Ocean_sfc, OS%grid, & +! Ice_ocean_boundary%p, OS%press_to_z) + call convert_state_to_ocean_type(OS%state, Ocean_sfc, OS%grid, & + OS%MOM_CSp%use_conT_absS) + + call callTree_leave("update_ocean_model()") +end subroutine update_ocean_model + +!> 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. +subroutine ocn_import(forces, fluxes, Time, G, CS, state, ImportState, sw_decomp, & + c1, c2, c3, c4, restore_salt, restore_temp) + type(mech_forcing), intent(inout) :: forces !< Driving mechanical forces + type(forcing), intent(inout) :: fluxes !< Surface fluxes + type(time_type), intent(in) :: Time !< Model time + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid + type(surface_forcing_CS), pointer :: CS !< control structure returned by + !! a previous call to surface_forcing_init + type(surface), intent(in) :: state !< control structure to ocean + !! surface state fields. + type(ESMF_State), intent(in) :: ImportState !< fluxes from top level + logical, intent(in) :: sw_decomp !< controls if shortwave is + !!decomposed into four components + real(kind=8), intent(in), optional :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition + logical, optional, intent(in) :: restore_salt, restore_temp !< Controls if salt and temp are + !! restored + + ! 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) + + real, dimension(SZI_(G),SZJ_(G)) :: & + taux_at_h, & ! Zonal wind stresses at h points (Pa) + tauy_at_h, & ! Meridional wind stresses at h points (Pa) + 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 + + 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, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0, i1, j1 + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer + integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd + integer :: lbnd1, lbnd2, ubnd1, ubnd2 + + 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(ESMF_KIND_R8), pointer :: dataPtr_p(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ifrac(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_duu10n(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_co2prog(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_co2diag(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lamult(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ustokes(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_vstokes(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_taux(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_tauy(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_sen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lat(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_osalt(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lwdn(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lwup(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_swnet(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_rofl(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_rofi(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_meltw(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_melth(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_iosalt(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_prec(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_rain(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_snow(:,:) + + call cpu_clock_begin(id_clock_forcing) + + 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 + + C_p = fluxes%C_p + Irho0 = 1.0/CS%Rho0 + open_ocn_mask(:,:) = 1.0 + pme_adj(:,:) = 0.0 + fluxes%vPrecGlobalAdj = 0.0 + fluxes%vPrecGlobalScl = 0.0 + fluxes%saltFluxGlobalAdj = 0.0 + fluxes%saltFluxGlobalScl = 0.0 + fluxes%netFWGlobalAdj = 0.0 + fluxes%netFWGlobalScl = 0.0 + + restore_salinity = .false. + if (present(restore_salt)) restore_salinity = restore_salt + restore_sst = .false. + if (present(restore_temp)) restore_sst = restore_temp + + ! if true, allocation and initialization + if (fluxes%dt_buoy_accum < 0) then + call allocate_forcing_type(G, fluxes, water=.true., heat=.true., & + ustar=.true., press=.true.) + call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., & + press=.true.) + call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%sw_nir_dir,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%sw_nir_dif,isd,ied,jsd,jed) + + call safe_alloc_ptr(forces%p_surf,isd,ied,jsd,jed) + call safe_alloc_ptr(forces%p_surf_full,isd,ied,jsd,jed) + call safe_alloc_ptr(forces%p_surf_SSH,isd,ied,jsd,jed) + + call safe_alloc_ptr(fluxes%salt_flux,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%salt_flux_in,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) + + call safe_alloc_ptr(fluxes%TKE_tidal,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%ustar_tidal,isd,ied,jsd,jed) + + if (CS%allow_flux_adjustments) then + call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) + endif + + do j=js-2,je+2 ; do i=is-2,ie+2 + fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) + fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) + enddo; enddo + + 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) + endif + + if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) + + fluxes%dt_buoy_accum = 0.0 + endif ! endif for allocation and initialization + + if (CS%allow_flux_adjustments) then + fluxes%heat_added(:,:)=0.0 + fluxes%salt_flux_added(:,:)=0.0 + endif + + 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) + enddo ; enddo + CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) + endif ! endif for allocation and initialization + + do j=js,je ; do i=is,ie + fluxes%salt_flux(i,j) = 0.0 + fluxes%vprec(i,j) = 0.0 + enddo ; enddo + + ! Salinity restoring logic + if (restore_salinity) then + call time_interp_external(CS%id_srestore,Time,data_restore) + ! open_ocn_mask indicates where to restore salinity (1 means restore, 0 does not) + open_ocn_mask(:,:) = 1.0 + if (CS%mask_srestore_under_ice) then ! Do not restore under sea-ice + do j=js,je ; do i=is,ie + if (state%SST(i,j) .le. -0.0539*state%SSS(i,j)) open_ocn_mask(i,j)=0.0 + enddo; enddo + endif + if (CS%salt_restore_as_sflux) then + do j=js,je ; do i=is,ie + delta_sss = data_restore(i,j)- 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 + enddo; enddo + if (CS%adjust_net_srestore_to_zero) then + if (CS%adjust_net_srestore_by_scaling) then + call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) + fluxes%saltFluxGlobalAdj = 0. + else + work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) + fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf + fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj + endif + endif + fluxes%salt_flux_added(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) ! Diagnostic + else + do j=js,je ; do i=is,ie + if (G%mask2dT(i,j) > 0.5) then + delta_sss = 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))* & + (CS%Rho0*CS%Flux_const) * & + delta_sss / (0.5*(state%SSS(i,j) + data_restore(i,j))) + endif + enddo; enddo + if (CS%adjust_net_srestore_to_zero) then + if (CS%adjust_net_srestore_by_scaling) then + call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) + fluxes%vPrecGlobalAdj = 0. + else + work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) + fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf + do j=js,je ; do i=is,ie + fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) + enddo; enddo + endif + endif + endif + endif + + ! SST restoring logic + if (restore_sst) then + call time_interp_external(CS%id_trestore,Time,data_restore) + do j=js,je ; do i=is,ie + delta_sst = data_restore(i,j)- 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 + enddo; enddo + endif + + ! GMM, CIME uses AGRID. All the BGRID_NE code can be cleaned later + wind_stagger = AGRID + + 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 + endif + if (wind_stagger == AGRID) then + ! This is necessary to fill in the halo points. + taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 + endif + + call State_getFldPtr(importState,'Sa_pslv', dataPtr_p,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,'Si_ifrac', dataPtr_ifrac,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"So_duu10n", dataPtr_duu10n, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +! call State_getFldPtr(importState,"Sa_co2prog", dataPtr_co2prog, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out +! call State_getFldPtr(importState,"Sa_co2diag", dataPtr_co2diag, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out + call State_getFldPtr(importState,"Sw_lamult", dataPtr_lamult, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Sw_ustokes", dataPtr_ustokes, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Sw_vstokes", dataPtr_vstokes, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_taux" , dataPtr_taux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_tauy" , dataPtr_tauy, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_sen" , dataPtr_sen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_lat" , dataPtr_lat, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_evap" , dataPtr_evap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_salt" , dataPtr_osalt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_lwdn" , dataPtr_lwdn, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_lwup" , dataPtr_lwup, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_swnet", dataPtr_swnet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_rofl" , dataPtr_rofl, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_rofi" , dataPtr_rofi, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_meltw", dataPtr_meltw, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_melth", dataPtr_melth, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_salt" , dataPtr_iosalt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_prec" , dataPtr_prec, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_rain" , dataPtr_rain, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_snow" , dataPtr_snow, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr_p,1) + ubnd1 = ubound(dataPtr_p,1) + lbnd2 = lbound(dataPtr_p,2) + ubnd2 = ubound(dataPtr_p,2) + + do j=js,je ; do i=is,ie + i1 = i + lbnd1 - is + j1 = j + lbnd2 - js + + if (wind_stagger == BGRID_NE) then + taux_at_q(i,j) = dataPtr_taux(i1,j1) * CS%wind_stress_multiplier + tauy_at_q(i,j) = dataPtr_tauy(i1,j1) * CS%wind_stress_multiplier + ! GMM, cime uses AGRID + elseif (wind_stagger == AGRID) then + taux_at_h(i,j) = dataPtr_taux(i1,j1) * CS%wind_stress_multiplier + tauy_at_h(i,j) = dataPtr_tauy(i1,j1) * CS%wind_stress_multiplier + else ! C-grid wind stresses. + forces%taux(I,j) = dataPtr_taux(i1,j1) * CS%wind_stress_multiplier + forces%tauy(i,J) = dataPtr_tauy(i1,j1) * CS%wind_stress_multiplier + endif + + ! liquid precipitation (rain) + if (ASSOCIATED(fluxes%lprec)) & + fluxes%lprec(i,j) = dataPtr_rain(i1,j1) * G%mask2dT(i,j) + + ! frozen precipitation (snow) + if (ASSOCIATED(fluxes%fprec)) & + fluxes%fprec(i,j) = dataPtr_snow(i1,j1) * G%mask2dT(i,j) + + ! evaporation + if (ASSOCIATED(fluxes%evap)) & + fluxes%evap(i,j) = dataPtr_evap(i1,j1) * G%mask2dT(i,j) + + ! river runoff flux + if (ASSOCIATED(fluxes%lrunoff)) & + fluxes%lrunoff(i,j) = dataPtr_rofl(i1,j1) * G%mask2dT(i,j) + + ! ice runoff flux + if (ASSOCIATED(fluxes%frunoff)) & + fluxes%frunoff(i,j) = dataPtr_rofi(i1,j1) * G%mask2dT(i,j) + + ! 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) = 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) + + ! longwave radiation, sum up and down (W/m2) + if (ASSOCIATED(fluxes%LW)) & + fluxes%LW(i,j) = (dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1)) * G%mask2dT(i,j) + + ! sensible heat flux (W/m2) + if (ASSOCIATED(fluxes%sens)) & + fluxes%sens(i,j) = dataPtr_sen(i1,j1) * G%mask2dT(i,j) + + ! latent heat flux (W/m^2) + if (ASSOCIATED(fluxes%latent)) & + fluxes%latent(i,j) = dataPtr_lat(i1,j1) * G%mask2dT(i,j) + + if (sw_decomp) then + ! Use runtime coefficients to decompose net short-wave heat flux into 4 components + ! 1) visible, direct shortwave (W/m2) + if (ASSOCIATED(fluxes%sw_vis_dir)) & + fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c1 + ! 2) visible, diffuse shortwave (W/m2) + if (ASSOCIATED(fluxes%sw_vis_dif)) & + fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c2 + ! 3) near-IR, direct shortwave (W/m2) + if (ASSOCIATED(fluxes%sw_nir_dir)) & + fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c3 + ! 4) near-IR, diffuse shortwave (W/m2) + if (ASSOCIATED(fluxes%sw_nir_dif)) & + fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c4 + + 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) + else + call MOM_error(FATAL,"fill_data_ice_ocean_bnd: this option has not been implemented yet."// & + "Shortwave must be decomposed using coeffs. c1, c2, c3, c4."); + endif + + ! applied surface pressure from atmosphere and cryosphere + ! sea-level pressure (Pa) + if (ASSOCIATED(forces%p_surf_full) .and. ASSOCIATED(forces%p_surf)) then + forces%p_surf_full(i,j) = G%mask2dT(i,j) * dataPtr_p(i1,j1) + if (CS%max_p_surf >= 0.0) then + forces%p_surf(i,j) = MIN(forces%p_surf_full(i,j),CS%max_p_surf) + else + forces%p_surf(i,j) = forces%p_surf_full(i,j) + endif + + if (CS%use_limited_P_SSH) then + forces%p_surf_SSH(i,j) = forces%p_surf(i,j) + else + forces%p_surf_SSH(i,j) = forces%p_surf_full(i,j) + endif + + endif + + ! salt flux + ! more salt restoring logic + if (ASSOCIATED(fluxes%salt_flux)) & + fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(dataPtr_osalt(i1,j1) + fluxes%salt_flux(i,j)) + + if (ASSOCIATED(fluxes%salt_flux_in)) & + fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*dataPtr_iosalt(i1,j1) + + enddo ; enddo + ! ############################ END OF MCT to MOM ############################## + + ! adjust the NET fresh-water flux to zero, if flagged + if (CS%adjust_net_fresh_water_to_zero) then + do j=js,je ; do i=is,ie + net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(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 + 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) + enddo ; enddo + + if (CS%adjust_net_fresh_water_by_scaling) then + call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) + do j=js,je ; do i=is,ie + fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)) * G%mask2dT(i,j) + enddo; enddo + else + fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf + do j=js,je ; do i=is,ie + fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%netFWGlobalAdj ) * G%mask2dT(i,j) + enddo; enddo + endif + + endif + + ! surface momentum stress related fields as function of staggering + 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) + + do j=js,je ; do I=Isq,Ieq + forces%taux(I,j) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & + forces%taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + & + G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) + enddo ; enddo + + do J=Jsq,Jeq ; do i=is,ie + forces%tauy(i,J) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & + forces%tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + & + G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) + enddo ; enddo + + ! ustar is required for the bulk mixed layer formulation. The background value + ! of 0.02 Pa is a relatively small value intended to give reasonable behavior + ! in regions of very weak winds. + + do j=js,je ; do i=is,ie + tau_mag = 0.0 ; gustiness = CS%gust_const + if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then + tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & + G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & + (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & + G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & + ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) + if (CS%read_gust_2d) gustiness = CS%gust(i,j) + endif + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) + enddo ; enddo + + elseif (wind_stagger == AGRID) then + call pass_vector(taux_at_h, tauy_at_h, G%Domain,stagger=AGRID) + + do j=js,je ; do I=Isq,Ieq + forces%taux(I,j) = 0.0 + if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & + forces%taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + & + G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & + (G%mask2dT(i,j) + G%mask2dT(i+1,j)) + enddo ; enddo + + do J=Jsq,Jeq ; do i=is,ie + forces%tauy(i,J) = 0.0 + if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & + forces%tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + & + G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & + (G%mask2dT(i,j) + G%mask2dT(i,j+1)) + enddo ; enddo + + do j=js,je ; do i=is,ie + gustiness = CS%gust_const + if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & + sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) + enddo ; enddo + + 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) + + do j=js,je ; do i=is,ie + taux2 = 0.0 + if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & + taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + & + G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) + + tauy2 = 0.0 + if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & + tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + & + G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) + + if (CS%read_gust_2d) then + forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) + else + forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) + endif + enddo ; enddo + + endif ! endif for wind related fields + + + ! sea ice related fields + if (CS%rigid_sea_ice) then + ! The commented out code here and in the following lines is the correct + ! version, but the incorrect version is being retained temporarily to avoid + ! changing answers. + call pass_var(forces%p_surf_full, G%Domain) + I_GEarth = 1.0 / G%G_Earth + Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) + do I=isd,ied-1 ; do j=jsd,jed + mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth + mass_eff = 0.0 + if (mass_ice > CS%rigid_sea_ice_mass) then + mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & + (mass_ice + CS%rigid_sea_ice_mass) + endif + ! CAUTION: with both rigid_sea_ice and ice shelves, we will need to make this + ! a maximum for the second call. + forces%rigidity_ice_u(I,j) = Kv_rho_ice * mass_eff + enddo ; enddo + do i=isd,ied ; do J=jsd,jed-1 + mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i,j+1)) * I_GEarth + mass_eff = 0.0 + if (mass_ice > CS%rigid_sea_ice_mass) then + mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & + (mass_ice + CS%rigid_sea_ice_mass) + endif + forces%rigidity_ice_v(i,J) = Kv_rho_ice * mass_eff + enddo ; enddo + endif + + if (CS%allow_flux_adjustments) then + ! Apply adjustments to fluxes + call apply_flux_adjustments(G, CS, Time, forces, fluxes) + endif + + ! Allow for user-written code to alter fluxes after all the above + call user_alter_forcing(state, fluxes, Time, G, CS%urf_CS) + + call cpu_clock_end(id_clock_forcing) + +end subroutine ocn_import + +!> Adds 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) +subroutine apply_flux_adjustments(G, CS, Time, forces, 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(mech_forcing), intent(inout) :: forces !< Driving mechanical forces + type(forcing), optional, 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) + + integer :: isc, iec, jsc, jec, i, j + real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau + logical :: overrode_x, overrode_y, overrode_h + + 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) + + 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 + + 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) + + + tempx_at_h(:,:) = 0.0 ; tempy_at_h(:,:) = 0.0 + ! Either reads data or leaves contents unchanged + overrode_x = .false. ; overrode_y = .false. + call data_override('OCN', 'taux_adj', tempx_at_h(isc:iec,jsc:jec), Time, override=overrode_x) + call data_override('OCN', 'tauy_adj', tempy_at_h(isc:iec,jsc:jec), Time, override=overrode_y) + + if (overrode_x .or. overrode_y) then + if (.not. (overrode_x .and. overrode_y)) call MOM_error(FATAL,"apply_flux_adjustments: "//& + "Both taux_adj and tauy_adj must be specified, or neither, in data_table") + + ! Rotate winds + call pass_vector(tempx_at_h, tempy_at_h, G%Domain, To_All, AGRID) + do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 + dLonDx = G%geoLonCu(I,j) - G%geoLonCu(I-1,j) + dLonDy = G%geoLonCv(i,J) - G%geoLonCv(i,J-1) + rDlon = sqrt( dLonDx * dLonDx + dLonDy * dLonDy ) + if (rDlon > 0.) rDlon = 1. / rDlon + cosA = dLonDx * rDlon + sinA = dLonDy * rDlon + zonal_tau = tempx_at_h(i,j) + merid_tau = tempy_at_h(i,j) + tempx_at_h(i,j) = cosA * zonal_tau - sinA * merid_tau + tempy_at_h(i,j) = sinA * zonal_tau + cosA * merid_tau + enddo ; enddo + + ! Average to C-grid locations + do j=G%jsc,G%jec ; do I=G%isc-1,G%iec + forces%taux(I,j) = forces%taux(I,j) + 0.5 * ( tempx_at_h(i,j) + tempx_at_h(i+1,j) ) + enddo ; enddo + + do J=G%jsc-1,G%jec ; do i=G%isc,G%iec + forces%tauy(i,J) = forces%tauy(i,J) + 0.5 * ( tempy_at_h(i,j) + tempy_at_h(i,j+1) ) + enddo ; enddo + endif ! overrode_x .or. overrode_y + +end subroutine apply_flux_adjustments + +!> Terminates the model run, saving the ocean state in a +!! restart file 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. + + !if (debug .and. is_root_pe()) write(glb%stdout,*)'Here 1' + !GMM call save_restart(Ocean_state, Time) + call diag_mediator_end(Time, Ocean_state%MOM_CSp%diag) + call MOM_end(Ocean_state%MOM_CSp) + if (Ocean_state%use_ice_shelf) call ice_shelf_end(Ocean_state%Ice_shelf_CSp) + !if (debug .and. is_root_pe()) write(glb%stdout,*)'Here 2' + +end subroutine ocean_model_end + + !----------------------------------------------------------------------------- + + subroutine State_GetFldPtr(ST, fldname, fldptr, rc) + type(ESMF_State), intent(in) :: ST + character(len=*), intent(in) :: fldname + real(ESMF_KIND_R8), pointer, intent(in) :: fldptr(:,:) + integer, intent(out), optional :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrc + character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' + + call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (present(rc)) rc = lrc + + end subroutine State_GetFldPtr + +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 + + integer :: g_isc, g_iec, g_jsc, g_jec,g_isd, g_ied, g_jsd, g_jed, i, j + + if (.not.associated(OS)) return + if (.not.OS%is_ocean_pe) return + +! The problem is %areaT is on MOM domain but Ice_Ocean_Boundary%... is on mpp domain. +! We want to return the MOM data on the mpp (compute) domain +! Get MOM domain extents + call mpp_get_compute_domain(OS%grid%Domain%mpp_domain, g_isc, g_iec, g_jsc, g_jec) + call mpp_get_data_domain (OS%grid%Domain%mpp_domain, g_isd, g_ied, g_jsd, g_jed) + + g_isc = g_isc-g_isd+1 ; g_iec = g_iec-g_isd+1 ; g_jsc = g_jsc-g_jsd+1 ; g_jec = g_jec-g_jsd+1 + + + select case(name) + case('area') + array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) + case('mask') + array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) +!OR same result +! do j=g_jsc,g_jec; do i=g_isc,g_iec +! array2D(isc+i-g_isc,jsc+j-g_jsc) = OS%grid%mask2dT(i,j) +! enddo; enddo + case('t_surf') + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + case('t_pme') + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + case('t_runoff') + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + case('t_calving') + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + case('btfHeat') + array2D(isc:,jsc:) = 0 + case('tlat') + array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) + case('tlon') + array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) + case('ulat') + array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) + case('ulon') + array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) + case('vlat') + array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) + case('vlon') + array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) + case('geoLatBu') + array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) + case('geoLonBu') + array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) + case('cos_rot') + array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 + 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,'get_ocean_data_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 + + if (.not.associated(OS)) return + if (.not.OS%is_ocean_pe) return + + select case(name) + case('c_p') + value = OS%C_p + case default + call MOM_error(FATAL,'get_ocean_data_data1D: unknown argument name='//name) + end select + + +end subroutine ocean_model_data1D_get + +!####################################################################### +! +! +! +! Obtain the ocean grid. +! +! + subroutine get_ocean_grid(OS, Gridp) + type(ocean_state_type) :: OS + type(ocean_grid_type) , pointer :: Gridp + + Gridp => OS%grid + return + + end subroutine get_ocean_grid +! NAME="get_ocean_grid" + +end module ocn_comp_nuopc From c6327d69cb7001de76eb21f970023eca9a9f87b3 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 12 Mar 2018 14:06:25 -0600 Subject: [PATCH 0007/1072] Copy OBLdepth from KPP into visc%MLD and Hml --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 91b3c343e0..0c1b3d1256 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -635,6 +635,14 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, Kd_salt, visc%Kv_turb, CS%KPP_NLTheat, CS%KPP_NLTscalar) !$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,Kd_heat) + ! If visc%MLD exists, copy the KPP BLD into it + if (associated(visc%MLD)) then + call pass_var(CS%KPP_CSp%OBLdepth, G%domain, halo=1) + visc%MLD(:,:) = CS%KPP_CSp%OBLdepth(:,:) + Hml(:,:) = CS%KPP_CSp%OBLdepth(:,:) + endif + + if (.not. CS%KPPisPassive) then !$OMP do do k=1,nz+1 ; do j=js,je ; do i=is,ie From dca5736441c39253a0052903779a1a841126565a Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 12 Mar 2018 15:25:34 -0600 Subject: [PATCH 0008/1072] Add comments for adding additonal CVMix components and clean module --- .../vertical/MOM_set_diffusivity.F90 | 83 +++++-------------- 1 file changed, 22 insertions(+), 61 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 15cbd6bb1c..2af9b8ef79 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -2,28 +2,6 @@ module MOM_set_diffusivity ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, September 1997 - June 2007 * -!* * -!* This file contains the subroutines that sets the diapycnal * -!* diffusivity, perhaps adding up pieces that are calculated in other * -!* files and passed in via the vertvisc type argument. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, buoy, ustar, T, S, Kd, ea, eb, etc. * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE use MOM_diag_mediator, only : diag_ctrl, time_type @@ -41,12 +19,11 @@ module MOM_set_diffusivity use MOM_intrinsic_functions, only : invcosh use MOM_io, only : slasher, vardesc, var_desc, MOM_read_data use MOM_kappa_shear, only : calculate_kappa_shear, kappa_shear_init, Kappa_shear_CS -use MOM_cvmix_shear, only : calculate_cvmix_shear, cvmix_shear_init, cvmix_shear_CS +use MOM_cvmix_shear, only : calculate_cvmix_shear, cvmix_shear_init, cvmix_shear_cs use MOM_string_functions, only : uppercase use MOM_thickness_diffuse, only : vert_fill_TS use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d -use MOM_verticalGrid, only : verticalGrid_type - +use MOM_verticalGrid, only : verticalGrid_type use user_change_diffusivity, only : user_change_diff, user_change_diff_init use user_change_diffusivity, only : user_change_diff_end, user_change_diff_CS @@ -244,11 +221,9 @@ module MOM_set_diffusivity logical :: user_change_diff ! If true, call user-defined code to change diffusivity. logical :: useKappaShear ! If true, use the kappa_shear module to find the ! shear-driven diapycnal diffusivity. - - logical :: useCVmix ! If true, use one of the CVMix modules to find + logical :: use_cvmix_shear ! If true, use one of the CVMix modules to find ! shear-driven diapycnal diffusivity. - - logical :: double_diffusion ! If true, enable double-diffusive mixing. + logical :: double_diffusion ! If true, enable double-diffusive mixing. logical :: simple_TKE_to_Kd ! If true, uses a simple estimate of Kd/TKE that ! does not rely on a layer-formulation. real :: Max_Rrho_salt_fingers ! max density ratio for salt fingering @@ -266,7 +241,7 @@ module MOM_set_diffusivity type(user_change_diff_CS), pointer :: user_change_diff_CSp => NULL() type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() type(Kappa_shear_CS), pointer :: kappaShear_CSp => NULL() - type(CVMix_shear_CS), pointer :: CVMix_Shear_CSp => NULL() + type(cvmix_shear_cs), pointer :: cvmix_shear_csp => NULL() type(int_tide_CS), pointer :: int_tide_CSp => NULL() integer :: id_TKE_itidal = -1 @@ -380,22 +355,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & optional, intent(out) :: Kd_int !< Diapycnal diffusivity at each interface !! (m2/sec). -! Arguments: -! (in) u - zonal velocity (m/s) -! (in) v - meridional velocity (m/s) -! (in) h - Layer thickness (m or kg/m2) -! (in) tv - structure with pointers to thermodynamic fields -! (in) fluxes - structure of surface fluxes that may be used -! (in) visc - structure containing vertical viscosities, bottom boundary -! layer properies, and related fields -! (in) dt - time increment (sec) -! (in) G - ocean grid structure -! (in) GV - The ocean's vertical grid structure. -! (in) CS - module control structure -! (in) j - meridional index upon which to work -! (out) Kd - diapycnal diffusivity of each layer (m2/sec) -! (out,opt) Kd_int - diapycnal diffusivity at each interface (m2/sec) - + ! local variables real, dimension(SZI_(G)) :: & depth, & ! distance from surface of an interface (meter) N2_bot ! bottom squared buoyancy frequency (1/s2) @@ -580,9 +540,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb",G%HI) endif if (showCallTree) call callTree_waypoint("done with calculate_kappa_shear (set_diffusivity)") - elseif (CS%useCVMix) then + elseif (CS%use_cvmix_shear) then !NOTE{BGR}: this needs to be cleaned up. It works in 1D case, but has not been tested outside. - call calculate_cvmix_shear(u_h, v_h, h, tv, visc%Kd_turb, visc%Kv_turb,G,GV,CS%CVMix_shear_CSp) + call calculate_cvmix_shear(u_h, v_h, h, tv, visc%Kd_turb, visc%Kv_turb,G,GV,CS%cvmix_shear_csp) elseif (associated(visc%Kv_turb)) then visc%Kv_turb(:,:,:) = 0. ! needed if calculate_kappa_shear is not enabled endif @@ -674,6 +634,10 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & Kd(i,j,k) = max(CS%Kd_min, Kd_sfc(i,j) * & ((abs_sin * invcosh(N_2Omega/abs_sin)) * I_x30)*N02_N2) enddo ; enddo + ! GMM, CVMix "internal" bg mixing can go here + !elseif (CS%use_cvmix_internal??) then + + else do k=1,nz ; do i=is,ie Kd(i,j,k) = Kd_sfc(i,j) @@ -708,7 +672,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif ! Add the input turbulent diffusivity. - if (CS%useKappaShear .or. CS%useCVMix) then + if (CS%useKappaShear .or. CS%use_cvmix_shear) then if (present(Kd_int)) then do K=2,nz ; do i=is,ie Kd_int(i,j,K) = visc%Kd_turb(i,j,K) + 0.5*(Kd(i,j,k-1) + Kd(i,j,k)) @@ -834,6 +798,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & T_f, S_f, dd%Kd_user) endif + ! GMM, post diags... if (CS%id_Kd_layer > 0) call post_data(CS%id_Kd_layer, Kd, CS%diag) num_z_diags = 0 @@ -2533,6 +2498,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) end subroutine set_density_ratios +!> Initialized the set_diffusivity module subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp, int_tide_CSp) type(time_type), intent(in) :: Time type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -2547,21 +2513,14 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp type(int_tide_CS), pointer :: int_tide_CSp !< pointer to the internal tides control !! structure (BDM) -! Arguments: -! (in) Time - current model time -! (in) G - ocean grid structure -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - structure indicating open file to parse for params -! (in) diag - structure used to regulate diagnostic output -! (in/out) CS - pointer set to point to the module control structure -! (in) diag_to_Z_CSp - pointer to the Z-diagnostics control structure -! (in) int_tide_CSp - pointer to the internal tides control structure (BDM) - + ! local variables real :: decay_length, utide, zbot, hamp type(vardesc) :: vd logical :: read_tideamp, ML_use_omega + ! This include declares and sets the variable "version". #include "version_variable.h" + character(len=40) :: mdl = "MOM_set_diffusivity" ! This module's name. character(len=20) :: tmpstr character(len=200) :: filename, tideamp_file, h2_file, Niku_TKE_input_file @@ -3131,6 +3090,8 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp endif endif + + ! GMM, the following should be moved to the DD module call get_param(param_file, mdl, "DOUBLE_DIFFUSION", CS%double_diffusion, & "If true, increase diffusivitives for temperature or salt \n"//& "based on double-diffusive paramaterization from MOM4/KPP.", & @@ -3181,9 +3142,9 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp CS%useKappaShear = kappa_shear_init(Time, G, GV, param_file, CS%diag, CS%kappaShear_CSp) if (CS%useKappaShear) & id_clock_kappaShear = cpu_clock_id('(Ocean kappa_shear)', grain=CLOCK_MODULE) - CS%useCVMix = CVMix_shear_init(Time, G, GV, param_file, CS%diag, CS%CVMix_shear_CSp) - + ! CVMix shear-driven mixing + CS%use_cvmix_shear = cvmix_shear_init(Time, G, GV, param_file, CS%diag, CS%cvmix_shear_csp) end subroutine set_diffusivity_init From 97152b1c4bd12f85a067377f75c68677558101bc Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 12 Mar 2018 15:26:05 -0600 Subject: [PATCH 0009/1072] Adding first version of convection calls via CVMix --- .../vertical/MOM_cvmix_conv.F90 | 245 ++++++++++++++++++ .../vertical/MOM_diabatic_driver.F90 | 26 +- 2 files changed, 259 insertions(+), 12 deletions(-) create mode 100644 src/parameterizations/vertical/MOM_cvmix_conv.F90 diff --git a/src/parameterizations/vertical/MOM_cvmix_conv.F90 b/src/parameterizations/vertical/MOM_cvmix_conv.F90 new file mode 100644 index 0000000000..7da68faa49 --- /dev/null +++ b/src/parameterizations/vertical/MOM_cvmix_conv.F90 @@ -0,0 +1,245 @@ +!> Interface to CVMix convection scheme. +module MOM_cvmix_conv + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field +use MOM_diag_mediator, only : post_data +use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE +use MOM_file_parser, only : openParameterBlock, closeParameterBlock +use MOM_debugging, only : hchksum +use MOM_grid, only : ocean_grid_type +use MOM_verticalGrid, only : verticalGrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use cvmix_convection, only : cvmix_init_conv, cvmix_coeffs_conv +use cvmix_kpp, only : CVmix_kpp_compute_kOBL_depth +implicit none ; private + +#include + +public cvmix_conv_init, calculate_cvmix_conv, cvmix_conv_end + +!> Control structure including parameters for CVMix convection. +type, public :: cvmix_conv_cs + + ! Parameters + real :: kd_conv !< diffusivity constant used in convective regime (m2/s) + real :: kv_conv !< viscosity constant used in convective regime (m2/s) + real :: bv_sqr_conv !< Threshold for squared buoyancy frequency + !! needed to trigger Brunt-Vaisala parameterization (1/s^2) + real :: min_thickness !< Minimum thickness allowed (m) + logical :: debug !< If true, turn on debugging + + ! Daignostic handles and pointers + type(diag_ctrl), pointer :: diag => NULL() + integer :: id_N2 = -1, id_kd_conv = -1, id_kv_conv = -1 + + ! Diagnostics arrays + real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency (1/s2) + real, allocatable, dimension(:,:,:) :: kd_conv_3d !< Diffusivity added by convection (m2/s) + real, allocatable, dimension(:,:,:) :: kv_conv_3d !< Viscosity added by convection (m2/s) + +end type cvmix_conv_cs + +character(len=40) :: mdl = "MOM_cvmix_conv" !< This module's name. + +contains + +!> Initialized the cvmix convection mixing routine. +logical function cvmix_conv_init(Time, G, GV, param_file, diag, CS) + + type(time_type), intent(in) :: Time !< The current time. + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle + type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. + type(cvmix_conv_cs), pointer :: CS !< This module's control structure. + + ! Local variables + real :: prandtl_turb + +! This include declares and sets the variable "version". +#include "version_variable.h" + + if (associated(CS)) then + call MOM_error(WARNING, "cvmix_conv_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + + ! Read parameters + call log_version(param_file, mdl, version, & + "Parameterization of enhanced mixing due to convection via CVMix") + call get_param(param_file, mdl, "USE_CVMIX_CONVECTION", cvmix_conv_init, & + "If true, turns on the enhanced mixing due to convection \n"// & + "via CVMix. This scheme increases diapycnal diffs./viscs. \n"// & + " at statically unstable interfaces. Relevant parameters are \n"// & + "contained in the CVMIX_CONVECTION% parameter block.", & + default=.false.) + + if (.not. cvmix_conv_init) return + + call get_param(param_file, mdl, "PRANDTL_TURB", Prandtl_turb, & + "The turbulent Prandtl number applied to shear/conv. \n"//& + "instabilities.", units="nondim", default=1.0, do_not_log=.true.) + + call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) + + call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, default=0.001, do_not_log=.True.) + + call openParameterBlock(param_file,'CVMIX_CONVECTION') + + call get_param(param_file, mdl, 'KD_CONV', CS%kd_conv, & + "Diffusivity used in convective regime. Corresponding viscosity \n" // & + "(KV_CONV) will be set to KD_CONV * PRANDTL_TURB.", & + units='m2/s', default=1.00) + + call get_param(param_file, mdl, 'BV_SQR_CONV', CS%bv_sqr_conv, & + "Threshold for squared buoyancy frequency needed to trigger \n" // & + "Brunt-Vaisala parameterization.", & + units='1/s^2', default=0.0) + + call closeParameterBlock(param_file) + + ! set kv_conv based on kd_conv and Prandtl_turb + CS%kv_conv = CS%kd_conv * Prandtl_turb + + ! Register diagnostics + CS%diag => diag + CS%id_N2 = register_diag_field('ocean_model', 'conv_N2', diag%axesTi, Time, & + 'Square of Brunt-Vaisala frequency used by MOM_cvmix_conv module', '1/s2') + if (CS%id_N2 > 0) allocate( CS%N2( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) + CS%id_kd_conv = register_diag_field('ocean_model', 'conv_kd', diag%axesTi, Time, & + 'Additional diffusivity added by MOM_cvmix_conv module', 'm2/s') + if (CS%id_kd_conv > 0) allocate( CS%kd_conv_3d( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) + CS%id_kv_conv = register_diag_field('ocean_model', 'conv_kv', diag%axesTi, Time, & + 'Additional viscosity added by MOM_cvmix_conv module', 'm2/s') + if (CS%id_kv_conv > 0) allocate( CS%kv_conv_3d( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) + + if (CS%id_N2 > 0) CS%N2(:,:,:) = 0. + if (CS%id_kd_conv > 0) CS%kd_conv_3d(:,:,:) = 0. + if (CS%id_kv_conv > 0) CS%kv_conv_3d(:,:,:) = 0. + + call cvmix_init_conv(convect_diff=CS%kd_conv, & + convect_visc=CS%kv_conv, & + lBruntVaisala=.true., & + BVsqr_convect=CS%bv_sqr_conv) + +end function cvmix_conv_init + +!> Subroutine for calculating enhanced diffusivity/viscosity +!! due to convection via CVMix +subroutine calculate_cvmix_conv(h, tv, G, GV, hbl, CS) + + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. + real, dimension(SZI_(G),SZJ_(G)) intent(in) :: hbl!< Depth of ocean boundary layer (m) + type(cvmix_conv_cs), pointer(inout) :: CS !< The control structure returned by a previous call to + !! CVMix_conv_init. + + ! local variables + real, dimension(SZK_(G)) :: rho_lwr !< Adiabatic Water Density, this is a dummy + !! variable since here convection is always + !! computed based on Brunt Vaisala. + real, dimension(SZK_(G)) :: rho_1d !< water density in a column, this is also + !! a dummy variable, same reason as above. + real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) + real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m) + real :: kOBL !< level (+fraction) of OBL extent + real :: pref, g_o_rho0, rhok, , rhokm1, dz, dh, hcorr + integer :: i, j, k + + g_o_rho0 = GV%g_Earth / GV%Rho0 + + ! initialize dummy variables + rho_lwr(:) = 0.0; rho_1d(:) = 0.0 + + do j = G%jsc, G%jec + do i = G%isc, G%iec + + ! set N2 to zero at the top- and bottom-most interfaces + CS%N2(i,j,1) = 0. + CS%N2(i,j,G%ke+1) =0. + + ! skip calling at land points + if (G%mask2dT(i,j)==0.) cycle + + pRef = 0. + ! Compute Brunt-Vaisala frequency (static stability) on interfaces + do k=2,G%ke + + ! pRef is pressure at interface between k and km1. + pRef = pRef + GV%H_to_Pa * h(i,j,k) + call calculate_density(tv%t(i,j,k), tv%s(i,j,k), pref, rhok, tv%eqn_of_state) + call calculate_density(tv%t(i,j,k-1), tv%s(i,j,k-1), pref, rhokm1, tv%eqn_of_state) + + dz = ((0.5*(h(i,j,k-1) + h(i,j,k))+GV%H_subroundoff)*GV%H_to_m) + CS%N2(i,j,k) = g_o_rho0 * (rhok - rhokm1) / dz ! Can be negative + + enddo + + iFaceHeight(1) = 0.0 ! BBL is all relative to the surface + hcorr = 0.0 + ! compute heights at cell center and interfaces + do k=1,G%ke + dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) + hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 + dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness + cellHeight(k) = iFaceHeight(k) - 0.5 * dh + iFaceHeight(k+1) = iFaceHeight(k) - dh + enddo + + kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl) + + call cvmix_coeffs_conv(Mdiff_out = CS%kv_conv_3d(i,j,:), & + Tdiff_out = CS%kd_conv_3d(i,j,:), & + Nsqr = CS%N2(i,j,:), & + dens = rho_1d(:), & + dens_lwr = rho_lwr(:), & + nlev = G%ke, & + max_nlev = G%ke, & + OBL_ind = kOBL) + + enddo + enddo + + if (CS%debug) then + call hchksum(CS%N2, "CVMix convection: N2",G%HI,haloshift=0) + call hchksum(CS%kd_conv_3d, "CVMix convection: kd_conv_3d",G%HI,haloshift=0) + call hchksum(CS%kv_conv_3d, "CVMix convection: kv_conv_3d",G%HI,haloshift=0) + endif + + ! send diagnostics to post_data + if (CS%id_N2 > 0) call post_data(CS%id_N2, CS%N2, CS%diag) + if (CS%id_kd_conv > 0) call post_data(CS%id_kd_conv, CS%kd_conv_3d, CS%diag) + if (CS%id_kv_conv > 0) call post_data(CS%id_kv_conv, CS%kv_conv_3d, CS%diag) + +end subroutine calculate_cvmix_conv + +! GMM, not sure if we need the code below - DELETE???? +!!logical function cvmix_conv_is_used(param_file) +! Reads the parameter "USE_CVMIX_CONVECTION" and returns state. +! This function allows other modules to know whether this parameterization will +! be used without needing to duplicate the log entry. +!! type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters +!! call get_param(param_file, mdl, "USE_CVMIX_CONVECTION", kappa_shear_is_used, & +!! default=.false., do_not_log = .true.) +!!end function cvmix_conv_is_used + +!> Clear pointers and dealocate memory +subroutine cvmix_conv_end(CS) + type(cvmix_conv_cs), pointer :: CS ! Control structure + + if (CS%id_N2 > 0) deallocate(CS%N2, CS%diag) + if (CS%id_kd_conv > 0) deallocate(CS%kd_conv_3d, CS%diag) + if (CS%id_kv_conv > 0) deallocate(CS%kv_conv_3d, CS%diag) + deallocate(CS) + +end subroutine cvmix_conv_end + + +end module MOM_cvmix_conv diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 0c1b3d1256..56824059a3 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -22,8 +22,8 @@ module MOM_diabatic_driver use MOM_diag_to_Z, only : diag_to_Z_CS, register_Zint_diag, calc_Zint_diags use MOM_diapyc_energy_req, only : diapyc_energy_req_init, diapyc_energy_req_end use MOM_diapyc_energy_req, only : diapyc_energy_req_calc, diapyc_energy_req_test, diapyc_energy_req_CS -use MOM_diffConvection, only : diffConvection_CS, diffConvection_init -use MOM_diffConvection, only : diffConvection_calculate, diffConvection_end +use MOM_cvmix_conv, only : cvmix_conv_init, cvmix_conv_cs +use MOM_cvmix_conv, only : cvmix_conv_end, calculate_cvmix_conv use MOM_domains, only : pass_var, To_West, To_South, To_All, Omit_Corners use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_energetic_PBL, only : energetic_PBL, energetic_PBL_init @@ -90,6 +90,8 @@ module MOM_diabatic_driver !! shear-driven diapycnal diffusivity. logical :: use_cvmix_shear !< If true, use the CVMix module to find the !! shear-driven diapycnal diffusivity. + logical :: use_cvmix_conv !< If true, use the CVMix module to get enhanced + !! mixing due to convection. logical :: use_sponge !< If true, sponges may be applied anywhere in the !! domain. The exact location and properties of !! those sponges are set by calls to @@ -149,8 +151,6 @@ module MOM_diabatic_driver logical :: useKPP !< use CVmix/KPP diffusivities and non-local transport logical :: salt_reject_below_ML !< If true, add salt below mixed layer (layer mode only) logical :: KPPisPassive !< If true, KPP is in passive mode, not changing answers. - logical :: useConvection !< If true, calculate large diffusivities when column - !! is statically unstable. logical :: debug !< If true, write verbose checksums for debugging purposes. logical :: debugConservation !< If true, monitor conservation and extrema. logical :: tracer_tridiag !< If true, use tracer_vertdiff instead of tridiagTS for @@ -220,7 +220,7 @@ module MOM_diabatic_driver type(optics_type), pointer :: optics => NULL() type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() type(KPP_CS), pointer :: KPP_CSp => NULL() - type(diffConvection_CS), pointer :: Conv_CSp => NULL() + type(cvmix_conv_cs), pointer :: cvmix_conv_csp => NULL() type(diapyc_energy_req_CS), pointer :: diapyc_en_rec_CSp => NULL() type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass @@ -674,9 +674,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G endif ! endif for KPP - ! Check for static instabilities and increase Kd_int where unstable - if (CS%useConvection) call diffConvection_calculate(CS%Conv_CSp, & - G, GV, h, tv%T, tv%S, tv%eqn_of_state, Kd_int) + ! Add diffusivity due to convection (computed via CVMix) + if (CS%use_cvmix_conv) & + call calculate_cvmix_conv(h, tv, G, GV, Hml, CS%cvmix_conv_csp) if (CS%useKPP) then @@ -2332,9 +2332,9 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, endif - ! CS%useConvection is set to True IF convection will be used, otherwise False. - ! CS%Conv_CSp is allocated by diffConvection_init() - CS%useConvection = diffConvection_init(param_file, G, diag, Time, CS%Conv_CSp) + ! CS%use_cvmix_conv is set to True if CVMix convection will be used, otherwise + ! False. + CS%use_cvmix_conv = cvmix_conv_init(Time, G, GV, param_file, diag, CS%cvmix_conv_csp) call entrain_diffusive_init(Time, G, GV, param_file, diag, CS%entrain_diffusive_CSp) @@ -2422,7 +2422,9 @@ subroutine diabatic_driver_end(CS) deallocate( CS%KPP_NLTscalar ) call KPP_end(CS%KPP_CSp) endif - if (CS%useConvection) call diffConvection_end(CS%Conv_CSp) + + if (CS%use_cvmix_conv) call cvmix_conv_end(CS%cvmix_conv_csp) + if (CS%use_energetic_PBL) & call energetic_PBL_end(CS%energetic_PBL_CSp) if (CS%debug_energy_req) & From c99e94ba2bfee186b4f9abe056882345239a71fa Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 12 Mar 2018 15:26:55 -0600 Subject: [PATCH 0010/1072] Updates visc%Kd_turb and visc%Kv_turb after convection is applied --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 56824059a3..bfe9c3a662 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -675,9 +675,16 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G endif ! endif for KPP ! Add diffusivity due to convection (computed via CVMix) - if (CS%use_cvmix_conv) & + if (CS%use_cvmix_conv) then call calculate_cvmix_conv(h, tv, G, GV, Hml, CS%cvmix_conv_csp) + do k=1,nz ; do j=js,je ; do i=is,ie + visc%Kd_turb(i,j,k) = visc%Kd_turb(i,j,k) + CS%cvmix_conv_csp%kd_conv_3d(i,j,k) + visc%Kv_turb(i,j,k) = visc%Kv_turb(i,j,k) + CS%cvmix_conv_csp%kv_conv_3d(i,j,k) + enddo ; enddo ; enddo + + endif + if (CS%useKPP) then call cpu_clock_begin(id_clock_kpp) From fc00e77aa83471c017a24825b0f909a42cf2a55c Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 13 Mar 2018 09:11:32 -0600 Subject: [PATCH 0011/1072] Added function to copy KPP surface boundary layer depth into BLD --- src/parameterizations/vertical/MOM_KPP.F90 | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index df64bb7b21..87ce532a28 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -32,6 +32,7 @@ module MOM_KPP public :: KPP_end public :: KPP_NonLocalTransport_temp public :: KPP_NonLocalTransport_saln +public :: KPP_get_BLD ! Enumerated constants integer, private, parameter :: NLT_SHAPE_CVMIX = 0 !< Use the CVmix profile @@ -936,7 +937,18 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & end subroutine KPP_calculate - +!> Copies KPP surface boundary layer depth into BLD +subroutine KPP_get_BLD(CS, BLD, G) + type(KPP_CS), pointer :: CS !< Control structure for + !! this module + type(ocean_grid_type), intent(in) :: G !< Grid structure + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: BLD!< bnd. layer depth (m) + ! Local variables + integer :: i,j + do j = G%jsc, G%jec ; do i = G%isc, G%iec + BLD(i,j) = CS%OBLdepth(i,j) + enddo ; enddo +end subroutine KPP_get_BLD !> Apply KPP non-local transport of surface fluxes for temperature. subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, & From 7f6d8f13bcc8305efe5ac1c39ddd6117dc4495f1 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 13 Mar 2018 09:12:20 -0600 Subject: [PATCH 0012/1072] Added call to KPP_get_BLD --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index bfe9c3a662..bba8f657f2 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -47,7 +47,7 @@ module MOM_diabatic_driver use MOM_internal_tides, only : propagate_int_tide use MOM_internal_tides, only : internal_tides_init, internal_tides_end, int_tide_CS use MOM_kappa_shear, only : kappa_shear_is_used -use MOM_KPP, only : KPP_CS, KPP_init, KPP_calculate, KPP_end +use MOM_KPP, only : KPP_CS, KPP_init, KPP_calculate, KPP_end, KPP_get_BLD use MOM_KPP, only : KPP_NonLocalTransport_temp, KPP_NonLocalTransport_saln use MOM_opacity, only : opacity_init, set_opacity, opacity_end, opacity_CS use MOM_regularize_layers, only : regularize_layers, regularize_layers_init, regularize_layers_CS @@ -637,9 +637,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G ! If visc%MLD exists, copy the KPP BLD into it if (associated(visc%MLD)) then - call pass_var(CS%KPP_CSp%OBLdepth, G%domain, halo=1) - visc%MLD(:,:) = CS%KPP_CSp%OBLdepth(:,:) - Hml(:,:) = CS%KPP_CSp%OBLdepth(:,:) + call KPP_get_BLD(CS%KPP_CSp, visc%MLD(:,:), G) + call pass_var(visc%MLD, G%domain, halo=1) + Hml(:,:) = visc%MLD(:,:) endif From e84f706de2f32036b2786a8cebc43a700d699771 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 13 Mar 2018 09:12:56 -0600 Subject: [PATCH 0013/1072] Fix array allocattion/dealocation * TODO: I am not sure if visc/diff due to convection is being added properly into the total visc./diff. This needs to be checked! --- .../vertical/MOM_cvmix_conv.F90 | 58 ++++++++++--------- 1 file changed, 30 insertions(+), 28 deletions(-) diff --git a/src/parameterizations/vertical/MOM_cvmix_conv.F90 b/src/parameterizations/vertical/MOM_cvmix_conv.F90 index 7da68faa49..5fab297910 100644 --- a/src/parameterizations/vertical/MOM_cvmix_conv.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_conv.F90 @@ -5,6 +5,8 @@ module MOM_cvmix_conv use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field use MOM_diag_mediator, only : post_data +use MOM_EOS, only : calculate_density +use MOM_variables, only : thermo_var_ptrs use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE use MOM_file_parser, only : openParameterBlock, closeParameterBlock use MOM_debugging, only : hchksum @@ -13,6 +15,7 @@ module MOM_cvmix_conv use MOM_file_parser, only : get_param, log_version, param_file_type use cvmix_convection, only : cvmix_init_conv, cvmix_coeffs_conv use cvmix_kpp, only : CVmix_kpp_compute_kOBL_depth + implicit none ; private #include @@ -105,21 +108,19 @@ logical function cvmix_conv_init(Time, G, GV, param_file, diag, CS) ! set kv_conv based on kd_conv and Prandtl_turb CS%kv_conv = CS%kd_conv * Prandtl_turb + ! allocate arrays and set them to zero + allocate(CS%N2(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%N2(:,:,:) = 0. + allocate(CS%kd_conv_3d(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%kd_conv_3d(:,:,:) = 0. + allocate(CS%kv_conv_3d(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%kv_conv_3d(:,:,:) = 0. + ! Register diagnostics CS%diag => diag CS%id_N2 = register_diag_field('ocean_model', 'conv_N2', diag%axesTi, Time, & 'Square of Brunt-Vaisala frequency used by MOM_cvmix_conv module', '1/s2') - if (CS%id_N2 > 0) allocate( CS%N2( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) CS%id_kd_conv = register_diag_field('ocean_model', 'conv_kd', diag%axesTi, Time, & 'Additional diffusivity added by MOM_cvmix_conv module', 'm2/s') - if (CS%id_kd_conv > 0) allocate( CS%kd_conv_3d( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) CS%id_kv_conv = register_diag_field('ocean_model', 'conv_kv', diag%axesTi, Time, & 'Additional viscosity added by MOM_cvmix_conv module', 'm2/s') - if (CS%id_kv_conv > 0) allocate( CS%kv_conv_3d( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) - - if (CS%id_N2 > 0) CS%N2(:,:,:) = 0. - if (CS%id_kd_conv > 0) CS%kd_conv_3d(:,:,:) = 0. - if (CS%id_kv_conv > 0) CS%kv_conv_3d(:,:,:) = 0. call cvmix_init_conv(convect_diff=CS%kd_conv, & convect_visc=CS%kv_conv, & @@ -136,8 +137,9 @@ subroutine calculate_cvmix_conv(h, tv, G, GV, hbl, CS) type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. - real, dimension(SZI_(G),SZJ_(G)) intent(in) :: hbl!< Depth of ocean boundary layer (m) - type(cvmix_conv_cs), pointer(inout) :: CS !< The control structure returned by a previous call to + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hbl!< Depth of ocean boundary layer (m) + !type(cvmix_conv_cs), intent(inout) :: CS !< The control structure returned by a previous call to + type(cvmix_conv_cs), pointer :: CS !< The control structure returned by a previous call to !! CVMix_conv_init. ! local variables @@ -148,8 +150,8 @@ subroutine calculate_cvmix_conv(h, tv, G, GV, hbl, CS) !! a dummy variable, same reason as above. real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m) - real :: kOBL !< level (+fraction) of OBL extent - real :: pref, g_o_rho0, rhok, , rhokm1, dz, dh, hcorr + integer :: kOBL !< level of OBL extent + real :: pref, g_o_rho0, rhok, rhokm1, dz, dh, hcorr integer :: i, j, k g_o_rho0 = GV%g_Earth / GV%Rho0 @@ -162,10 +164,10 @@ subroutine calculate_cvmix_conv(h, tv, G, GV, hbl, CS) ! set N2 to zero at the top- and bottom-most interfaces CS%N2(i,j,1) = 0. - CS%N2(i,j,G%ke+1) =0. + CS%N2(i,j,G%ke+1) = 0. ! skip calling at land points - if (G%mask2dT(i,j)==0.) cycle + !if (G%mask2dT(i,j) == 0.) cycle pRef = 0. ! Compute Brunt-Vaisala frequency (static stability) on interfaces @@ -193,24 +195,24 @@ subroutine calculate_cvmix_conv(h, tv, G, GV, hbl, CS) iFaceHeight(k+1) = iFaceHeight(k) - dh enddo - kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl) + kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl(i,j)) - call cvmix_coeffs_conv(Mdiff_out = CS%kv_conv_3d(i,j,:), & - Tdiff_out = CS%kd_conv_3d(i,j,:), & - Nsqr = CS%N2(i,j,:), & - dens = rho_1d(:), & - dens_lwr = rho_lwr(:), & - nlev = G%ke, & - max_nlev = G%ke, & - OBL_ind = kOBL) + call cvmix_coeffs_conv(Mdiff_out=CS%kv_conv_3d(i,j,:), & + Tdiff_out=CS%kd_conv_3d(i,j,:), & + Nsqr=CS%N2(i,j,:), & + dens=rho_1d(:), & + dens_lwr=rho_lwr(:), & + nlev=G%ke, & + max_nlev=G%ke, & + OBL_ind=kOBL) enddo enddo if (CS%debug) then - call hchksum(CS%N2, "CVMix convection: N2",G%HI,haloshift=0) - call hchksum(CS%kd_conv_3d, "CVMix convection: kd_conv_3d",G%HI,haloshift=0) - call hchksum(CS%kv_conv_3d, "CVMix convection: kv_conv_3d",G%HI,haloshift=0) + call hchksum(CS%N2, "MOM_cvmix_conv: N2",G%HI,haloshift=0) + call hchksum(CS%kd_conv_3d, "MOM_cvmix_conv: kd_conv_3d",G%HI,haloshift=0) + call hchksum(CS%kv_conv_3d, "MOM_cvmix_conv: kv_conv_3d",G%HI,haloshift=0) endif ! send diagnostics to post_data @@ -234,9 +236,9 @@ end subroutine calculate_cvmix_conv subroutine cvmix_conv_end(CS) type(cvmix_conv_cs), pointer :: CS ! Control structure - if (CS%id_N2 > 0) deallocate(CS%N2, CS%diag) - if (CS%id_kd_conv > 0) deallocate(CS%kd_conv_3d, CS%diag) - if (CS%id_kv_conv > 0) deallocate(CS%kv_conv_3d, CS%diag) + deallocate(CS%N2, CS%diag) + deallocate(CS%kd_conv_3d, CS%diag) + deallocate(CS%kv_conv_3d, CS%diag) deallocate(CS) end subroutine cvmix_conv_end From a209b7a8a02a61201f3c505ae48e904c2f26d2a5 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 13 Mar 2018 10:36:59 -0600 Subject: [PATCH 0014/1072] Added a call to diabatic_driver_end --- src/core/MOM.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 60ce1d9c99..bcf6516505 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2900,6 +2900,8 @@ subroutine MOM_end(CS) call tracer_registry_end(CS%tracer_Reg) call tracer_flow_control_end(CS%tracer_flow_CSp) + if (associated(CS%diabatic_CSp)) call diabatic_driver_end(CS%diabatic_CSp) + if (CS%offline_tracer_mode) call offline_transport_end(CS%offline_CSp) DEALLOC_(CS%uhtr) ; DEALLOC_(CS%vhtr) From f12702c58a54393473dbb18890b4a03d128efe94 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 13 Mar 2018 10:40:51 -0600 Subject: [PATCH 0015/1072] Dealocate memory via cvmix_shear_end and changed some var names to snake_case convention --- src/parameterizations/vertical/MOM_cvmix_shear.F90 | 14 ++++++++++++-- .../vertical/MOM_diabatic_driver.F90 | 6 +++--- .../vertical/MOM_set_diffusivity.F90 | 7 ++++++- 3 files changed, 21 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/vertical/MOM_cvmix_shear.F90 b/src/parameterizations/vertical/MOM_cvmix_shear.F90 index 7704069d78..487b1cbf6f 100644 --- a/src/parameterizations/vertical/MOM_cvmix_shear.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_shear.F90 @@ -25,7 +25,7 @@ module MOM_cvmix_shear #include -public calculate_cvmix_shear, cvmix_shear_init, cvmix_shear_is_used +public calculate_cvmix_shear, cvmix_shear_init, cvmix_shear_is_used, cvmix_shear_end !> Control structure including parameters for CVMix interior shear schemes. type, public :: cvmix_shear_cs @@ -38,7 +38,7 @@ module MOM_cvmix_shear character(10) :: Mix_Scheme !< Mixing scheme name (string) end type cvmix_shear_cs -character(len=40) :: mdl = "MOM_CVMix_shear" !< This module's name. +character(len=40) :: mdl = "MOM_cvmix_shear" !< This module's name. contains @@ -213,4 +213,14 @@ logical function cvmix_shear_is_used(param_file) cvmix_shear_is_used = (LMD94 .or. PP81) end function cvmix_shear_is_used +!> Clear pointers and dealocate memory +subroutine cvmix_shear_end(CS) + type(cvmix_shear_cs), pointer :: CS ! Control structure + + deallocate(CS%N2, CS%diag) + deallocate(CS%S2, CS%diag) + deallocate(CS) + +end subroutine cvmix_shear_end + end module MOM_cvmix_shear diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index bba8f657f2..aa4f9f072e 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -9,7 +9,7 @@ module MOM_diabatic_driver use MOM_checksum_packages, only : MOM_state_chksum, MOM_state_stats use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE -use MOM_CVMix_shear, only : CVMix_shear_is_used +use MOM_CVMix_shear, only : cvmix_shear_is_used use MOM_diabatic_aux, only : diabatic_aux_init, diabatic_aux_end, diabatic_aux_CS use MOM_diabatic_aux, only : make_frazil, adjust_salt, insert_brine, differential_diffuse_T_S, triDiagTS use MOM_diabatic_aux, only : find_uv_at_h, diagnoseMLDbyDensityDifference, applyBoundaryFluxesInOut @@ -522,7 +522,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G if (CS%debug) then call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) endif - if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then + if (CS%use_kappa_shear .or. CS%use_cvmix_shear) then if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eaml, ebml) if (CS%debug) then @@ -1920,7 +1920,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, "If true, apply parameterization of double-diffusion.", & default=.false. ) CS%use_kappa_shear = kappa_shear_is_used(param_file) - CS%use_CVMix_shear = cvmix_shear_is_used(param_file) + CS%use_cvmix_shear = cvmix_shear_is_used(param_file) if (CS%bulkmixedlayer) then call get_param(param_file, mod, "ML_MIX_FIRST", CS%ML_mix_first, & "The fraction of the mixed layer mixing that is applied \n"//& diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 2af9b8ef79..345f602902 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -20,6 +20,7 @@ module MOM_set_diffusivity use MOM_io, only : slasher, vardesc, var_desc, MOM_read_data use MOM_kappa_shear, only : calculate_kappa_shear, kappa_shear_init, Kappa_shear_CS use MOM_cvmix_shear, only : calculate_cvmix_shear, cvmix_shear_init, cvmix_shear_cs +use MOM_cvmix_shear, only : cvmix_shear_end use MOM_string_functions, only : uppercase use MOM_thickness_diffuse, only : vert_fill_TS use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d @@ -3148,12 +3149,16 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp end subroutine set_diffusivity_init +!> Clear pointers and dealocate memory subroutine set_diffusivity_end(CS) - type(set_diffusivity_CS), pointer :: CS + type(set_diffusivity_CS), pointer :: CS !< Control structure for this module if (CS%user_change_diff) & call user_change_diff_end(CS%user_change_diff_CSp) + if (CS%use_cvmix_shear) & + call cvmix_shear_end(CS%cvmix_shear_csp) + if (associated(CS)) deallocate(CS) end subroutine set_diffusivity_end From a77d1143b6e848f541dbdcb129519ed70b80f3f5 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 13 Mar 2018 14:12:54 -0600 Subject: [PATCH 0016/1072] Fixed a bug in the deallocate call --- src/parameterizations/vertical/MOM_cvmix_conv.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_cvmix_conv.F90 b/src/parameterizations/vertical/MOM_cvmix_conv.F90 index 5fab297910..792f0deb1b 100644 --- a/src/parameterizations/vertical/MOM_cvmix_conv.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_conv.F90 @@ -236,9 +236,9 @@ end subroutine calculate_cvmix_conv subroutine cvmix_conv_end(CS) type(cvmix_conv_cs), pointer :: CS ! Control structure - deallocate(CS%N2, CS%diag) - deallocate(CS%kd_conv_3d, CS%diag) - deallocate(CS%kv_conv_3d, CS%diag) + deallocate(CS%N2) + deallocate(CS%kd_conv_3d) + deallocate(CS%kv_conv_3d) deallocate(CS) end subroutine cvmix_conv_end From afd8f591c562667c19e67b70022b988f6c3659ca Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 13 Mar 2018 14:35:14 -0600 Subject: [PATCH 0017/1072] Fixed a bug in the deallocate call --- .../vertical/MOM_cvmix_shear.F90 | 35 ++++++++++++++++--- 1 file changed, 31 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/vertical/MOM_cvmix_shear.F90 b/src/parameterizations/vertical/MOM_cvmix_shear.F90 index 487b1cbf6f..4a91524c76 100644 --- a/src/parameterizations/vertical/MOM_cvmix_shear.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_shear.F90 @@ -35,14 +35,21 @@ module MOM_cvmix_shear real :: KPP_exp !< real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency (1/s2) real, allocatable, dimension(:,:,:) :: S2 !< Squared shear frequency (1/s2) + real, allocatable, dimension(:,:,:) :: ri_grad !< Gradient Richardson number + real, allocatable, dimension(:,:,:) :: km !< vertical viscosity at interface (m2/s) + real, allocatable, dimension(:,:,:) :: kh !< vertical diffusivity at interface (m2/s) character(10) :: Mix_Scheme !< Mixing scheme name (string) + ! Daignostic handles and pointers + type(diag_ctrl), pointer :: diag => NULL() + integer :: id_N2 = -1, id_S2 = -1, id_ri_grad = -1, id_km = -1, id_kh = -1 + end type cvmix_shear_cs character(len=40) :: mdl = "MOM_cvmix_shear" !< This module's name. contains -!> Subroutine for calculating (internal) diffusivity +!> Subroutine for calculating (internal) vertical diffusivities/viscosities subroutine calculate_cvmix_shear(u_H, v_H, h, tv, KH, & KM, G, GV, CS ) type(ocean_grid_type), intent(in) :: G !< Grid structure. @@ -51,7 +58,7 @@ subroutine calculate_cvmix_shear(u_H, v_H, h, tv, KH, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: v_H !< Initial meridional velocity on T points, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: KH !< The vertical viscosity at each interface + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: KH !< The vertical diffusivity at each interface !! (not layer!) in m2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: KM !< The vertical viscosity at each interface !! (not layer!) in m2 s-1. @@ -196,6 +203,23 @@ logical function cvmix_shear_init(Time, G, GV, param_file, diag, CS) ! Allocation and initialization allocate( CS%N2( SZI_(G), SZJ_(G), SZK_(G)+1 ) );CS%N2(:,:,:) = 0. allocate( CS%S2( SZI_(G), SZJ_(G), SZK_(G)+1 ) );CS%S2(:,:,:) = 0. + !Initialize w/ large Richardson value + allocate( CS%ri_grad( SZI_(G), SZJ_(G), SZK_(G)+1 ) );CS%ri_grad(:,:,:) = 1.e8 + + ! Register diagnostics + CS%diag => diag + CS%id_N2 = register_diag_field('ocean_model', 'shear_N2', diag%axesTi, Time, & + 'Square of Brunt-Vaisala frequency used by MOM_cvmix_shear module', '1/s2') + CS%id_S2 = register_diag_field('ocean_model', 'shear_S2', diag%axesTi, Time, & + 'Square of vertical shear used by MOM_cvmix_shear module','1/s2') + CS%id_ri_grad = register_diag_field('ocean_model', 'shear_ri_grad', diag%axesTi, Time, & + 'Gradient Richarson number used by MOM_cvmix_shear module','nondim') + CS%id_kh = register_diag_field('ocean_model', 'shear_KH', diag%axesTi, Time, & + 'Vertical diffusivity added by MOM_cvmix_shear module', 'm2/s') + if (CS%id_kh > 0) allocate(CS%kh(SZI_(G), SZJ_(G), SZK_(G)+1)) + CS%id_km = register_diag_field('ocean_model', 'shear_KM', diag%axesTi, Time, & + 'Vertical viscosity added by MOM_cvmix_shear module', 'm2/s') + if (CS%id_km > 0) allocate(CS%km(SZI_(G), SZJ_(G), SZK_(G)+1)) end function cvmix_shear_init @@ -217,8 +241,11 @@ end function cvmix_shear_is_used subroutine cvmix_shear_end(CS) type(cvmix_shear_cs), pointer :: CS ! Control structure - deallocate(CS%N2, CS%diag) - deallocate(CS%S2, CS%diag) + deallocate(CS%N2) + deallocate(CS%S2) + deallocate(CS%ri_grad) + if (CS%id_kh > 0) deallocate(CS%kh, CS%diag) + if (CS%id_km > 0) deallocate(CS%km, CS%diag) deallocate(CS) end subroutine cvmix_shear_end From 1d850a60845c582e78a4899a3179f7e54bcb6fe4 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 14 Mar 2018 16:56:05 -0600 Subject: [PATCH 0018/1072] Changed hbl to an optional pointer; do not apply mixing due to convection within the boundary layer --- .../vertical/MOM_cvmix_conv.F90 | 28 +++++++++++++++++-- 1 file changed, 25 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_cvmix_conv.F90 b/src/parameterizations/vertical/MOM_cvmix_conv.F90 index 792f0deb1b..49ec101b44 100644 --- a/src/parameterizations/vertical/MOM_cvmix_conv.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_conv.F90 @@ -60,6 +60,7 @@ logical function cvmix_conv_init(Time, G, GV, param_file, diag, CS) ! Local variables real :: prandtl_turb + logical :: useEPBL ! This include declares and sets the variable "version". #include "version_variable.h" @@ -83,6 +84,17 @@ logical function cvmix_conv_init(Time, G, GV, param_file, diag, CS) if (.not. cvmix_conv_init) return + call get_param(param_file, mdl, "ENERGETICS_SFC_PBL", useEPBL, default=.false., & + do_not_log=.true.) + + ! Warn user if EPBL is being used, since in this case mixing due to convection will + ! be aplied in the boundary layer + if (useEPBL) then + call MOM_error(WARNING, 'MOM_cvmix_conv_init: '// & + 'CVMix convection may not be properly applied when ENERGETICS_SFC_PBL = True'//& + 'as convective mixing might occur in the boundary layer.') + endif + call get_param(param_file, mdl, "PRANDTL_TURB", Prandtl_turb, & "The turbulent Prandtl number applied to shear/conv. \n"//& "instabilities.", units="nondim", default=1.0, do_not_log=.true.) @@ -131,16 +143,15 @@ end function cvmix_conv_init !> Subroutine for calculating enhanced diffusivity/viscosity !! due to convection via CVMix -subroutine calculate_cvmix_conv(h, tv, G, GV, hbl, CS) +subroutine calculate_cvmix_conv(h, tv, G, GV, CS, hbl) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hbl!< Depth of ocean boundary layer (m) - !type(cvmix_conv_cs), intent(inout) :: CS !< The control structure returned by a previous call to type(cvmix_conv_cs), pointer :: CS !< The control structure returned by a previous call to !! CVMix_conv_init. + real, dimension(:,:), optional, pointer :: hbl!< Depth of ocean boundary layer (m) ! local variables real, dimension(SZK_(G)) :: rho_lwr !< Adiabatic Water Density, this is a dummy @@ -159,6 +170,11 @@ subroutine calculate_cvmix_conv(h, tv, G, GV, hbl, CS) ! initialize dummy variables rho_lwr(:) = 0.0; rho_1d(:) = 0.0 + if (.not. associated(hbl)) then + allocate(hbl(SZI_(G), SZJ_(G))); + hbl(:,:) = 0.0 + endif + do j = G%jsc, G%jec do i = G%isc, G%iec @@ -206,6 +222,12 @@ subroutine calculate_cvmix_conv(h, tv, G, GV, hbl, CS) max_nlev=G%ke, & OBL_ind=kOBL) + ! Do not apply mixing due to convection within the boundary layer + do k=1,NINT(hbl(i,j)) + CS%kv_conv_3d(i,j,k) = 0.0 + CS%kd_conv_3d(i,j,k) = 0.0 + enddo + enddo enddo From c78ac9a64cfda3034bec438a880a72c18baba9be Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 15 Mar 2018 10:12:24 -0600 Subject: [PATCH 0019/1072] Add the new module MOM_cvmix_tidal --- .../vertical/MOM_cvmix_tidal.F90 | 91 +++++++++++++++++++ 1 file changed, 91 insertions(+) create mode 100644 src/parameterizations/vertical/MOM_cvmix_tidal.F90 diff --git a/src/parameterizations/vertical/MOM_cvmix_tidal.F90 b/src/parameterizations/vertical/MOM_cvmix_tidal.F90 new file mode 100644 index 0000000000..50f64edc49 --- /dev/null +++ b/src/parameterizations/vertical/MOM_cvmix_tidal.F90 @@ -0,0 +1,91 @@ +!> Interface to CVMix tidal mixing scheme. +module MOM_cvmix_tidal + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field +use MOM_diag_mediator, only : post_data +use MOM_EOS, only : calculate_density +use MOM_variables, only : thermo_var_ptrs +use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE +use MOM_file_parser, only : openParameterBlock, closeParameterBlock +use MOM_debugging, only : hchksum +use MOM_grid, only : ocean_grid_type +use MOM_verticalGrid, only : verticalGrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use cvmix_kpp, only : CVmix_kpp_compute_kOBL_depth + +implicit none ; private + +#include + +logical :: debug = is_root_pe .and. .true. + +public cvmix_tidal_init +public calculate_cvmix_tidal +public cvmix_tidal_end + +!> Control structure including parameters for CVMix tidal mixing. +type, public :: cvmix_tidal_cs + + ! Parameters + real :: kd_conv !< diffusivity constant used in convective regime (m2/s) + +end type cvmix_tidal_cs + +character(len=40) :: mdl = "MOM_cvmix_tidal" !< This module's name. + +contains + +!> Initialize the cvmix tidal mixing routine. +logical function cvmix_tidal_init(Time, G, GV, param_file, diag, CS) + + type(time_type), intent(in) :: Time !< The current time. + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle + type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. + type(cvmix_tidal_cs), pointer :: CS !< This module's control structure. + + ! Local variables + +! This include declares and sets the variable "version". +#include "version_variable.h" + + if (associated(CS)) then + call MOM_error(WARNING, "cvmix_tidal_init called when control structure "// & + "is already associated.") + return + endif + allocate(CS) + + ! Read parameters + call log_version(param_file, mdl, version, & + "Parameterization of enhanced mixing due to convection via CVMix") + call get_param(param_file, mdl, "USE_CVMIX_TIDAL", cvmix_tidal_init, & + "If true, turns on tidal mixing scheme via CVMix\n", & + default=.false.) + + if (.not. cvmix_conv_init) return + + call closeParameterBlock(param_file) + +end function cvmix_tidal_init + + +!> .... +subroutine calculate_cvmix_tidal() + continue +end subroutine calculate_cvmix_tidal + + +!> Clear pointers and deallocate memory +subroutine cvmix_tidal_end(CS) + type(cvmix_tidal_cs), pointer :: CS ! This module's control structure + + !TODO deallocate all the dynamically allocated members here ... + deallocate(CS) +end subroutine cvmix_tidal_end + + +end module MOM_cvmix_tidal From ba2a0a4a547e490f6f3d01f5937811b8ed4c088b Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 15 Mar 2018 11:17:45 -0600 Subject: [PATCH 0020/1072] Added function cvmix_conv_is_used and register restart fields. This function allows other modules to know whether this parameterization will be used without needing to duplicate the log entry. This commit also registers restart fields when only USE_CVMIX_CONVECTION is used (i.e., all other parame- terizations associated with vertical mixing are not enabled). --- .../vertical/MOM_cvmix_conv.F90 | 20 +++++++++---------- .../vertical/MOM_set_viscosity.F90 | 14 +++++++------ 2 files changed, 18 insertions(+), 16 deletions(-) diff --git a/src/parameterizations/vertical/MOM_cvmix_conv.F90 b/src/parameterizations/vertical/MOM_cvmix_conv.F90 index 49ec101b44..88dece60fb 100644 --- a/src/parameterizations/vertical/MOM_cvmix_conv.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_conv.F90 @@ -20,7 +20,7 @@ module MOM_cvmix_conv #include -public cvmix_conv_init, calculate_cvmix_conv, cvmix_conv_end +public cvmix_conv_init, calculate_cvmix_conv, cvmix_conv_end, cvmix_conv_is_used !> Control structure including parameters for CVMix convection. type, public :: cvmix_conv_cs @@ -244,15 +244,15 @@ subroutine calculate_cvmix_conv(h, tv, G, GV, CS, hbl) end subroutine calculate_cvmix_conv -! GMM, not sure if we need the code below - DELETE???? -!!logical function cvmix_conv_is_used(param_file) -! Reads the parameter "USE_CVMIX_CONVECTION" and returns state. -! This function allows other modules to know whether this parameterization will -! be used without needing to duplicate the log entry. -!! type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters -!! call get_param(param_file, mdl, "USE_CVMIX_CONVECTION", kappa_shear_is_used, & -!! default=.false., do_not_log = .true.) -!!end function cvmix_conv_is_used +!> Reads the parameter "USE_CVMIX_CONVECTION" and returns state. +!! This function allows other modules to know whether this parameterization will +!! be used without needing to duplicate the log entry. +logical function cvmix_conv_is_used(param_file) + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + call get_param(param_file, mdl, "USE_CVMIX_CONVECTION", cvmix_conv_is_used, & + default=.false., do_not_log = .true.) + +end function cvmix_conv_is_used !> Clear pointers and dealocate memory subroutine cvmix_conv_end(CS) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 394b17dbd2..60c96fbb37 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -44,7 +44,8 @@ module MOM_set_visc use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type use MOM_kappa_shear, only : kappa_shear_is_used -use MOM_CVMix_shear, only : CVMix_shear_is_used +use MOM_cvmix_shear, only : cvmix_shear_is_used +use MOM_cvmix_conv, only : cvmix_conv_is_used use MOM_io, only : vardesc, var_desc use MOM_restart, only : register_restart_field, MOM_restart_CS use MOM_variables, only : thermo_var_ptrs @@ -1783,18 +1784,19 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) ! (in) restart_CS - A pointer to the restart control structure. type(vardesc) :: vd logical :: use_kappa_shear, adiabatic, useKPP, useEPBL - logical :: use_CVMix, MLE_use_PBL_MLD + logical :: use_cvmix_shear, MLE_use_PBL_MLD, use_cvmix_conv integer :: isd, ied, jsd, jed, nz character(len=40) :: mdl = "MOM_set_visc" ! This module's name. isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke call get_param(param_file, mdl, "ADIABATIC", adiabatic, default=.false., & do_not_log=.true.) - use_kappa_shear = .false. ; use_CVMix = .false. ; - useKPP = .false. ; useEPBL = .false. + use_kappa_shear = .false. ; use_cvmix_shear = .false. ; + useKPP = .false. ; useEPBL = .false. ; use_cvmix_conv = .false. ; if (.not.adiabatic) then use_kappa_shear = kappa_shear_is_used(param_file) - use_CVMix = CVMix_shear_is_used(param_file) + use_cvmix_shear = cvmix_shear_is_used(param_file) + use_cvmix_conv = cvmix_conv_is_used(param_file) call get_param(param_file, mdl, "USE_KPP", useKPP, & "If true, turns on the [CVmix] KPP scheme of Large et al., 1984,\n"// & "to calculate diffusivities and non-local transport in the OBL.", & @@ -1805,7 +1807,7 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) "in the surface boundary layer.", default=.false., do_not_log=.true.) endif - if (use_kappa_shear .or. useKPP .or. useEPBL .or. use_CVMix) then + if (use_kappa_shear .or. useKPP .or. useEPBL .or. use_cvmix_shear .or. use_cvmix_conv) then allocate(visc%Kd_turb(isd:ied,jsd:jed,nz+1)) ; visc%Kd_turb(:,:,:) = 0.0 allocate(visc%TKE_turb(isd:ied,jsd:jed,nz+1)) ; visc%TKE_turb(:,:,:) = 0.0 allocate(visc%Kv_turb(isd:ied,jsd:jed,nz+1)) ; visc%Kv_turb(:,:,:) = 0.0 From 941bfb6e29f3525e81c9ba081286bd138bf2ced2 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 15 Mar 2018 11:22:47 -0600 Subject: [PATCH 0021/1072] Updated mixing coeff. due to convection Vertical diff. is updated via Kd_int, but I could not find an equivalent for viscosity. I am also updating visc%Kv_turb and visc%Kv_turb, but I am not sure if this is correct. Further checking is needed! --- .../vertical/MOM_diabatic_driver.F90 | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index aa4f9f072e..cc0e9e7501 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -635,14 +635,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, Kd_salt, visc%Kv_turb, CS%KPP_NLTheat, CS%KPP_NLTscalar) !$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,Kd_heat) - ! If visc%MLD exists, copy the KPP BLD into it - if (associated(visc%MLD)) then - call KPP_get_BLD(CS%KPP_CSp, visc%MLD(:,:), G) - call pass_var(visc%MLD, G%domain, halo=1) - Hml(:,:) = visc%MLD(:,:) + if (associated(Hml)) then + call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G) + call pass_var(Hml, G%domain, halo=1) endif - if (.not. CS%KPPisPassive) then !$OMP do do k=1,nz+1 ; do j=js,je ; do i=is,ie @@ -676,12 +673,16 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G ! Add diffusivity due to convection (computed via CVMix) if (CS%use_cvmix_conv) then - call calculate_cvmix_conv(h, tv, G, GV, Hml, CS%cvmix_conv_csp) + call calculate_cvmix_conv(h, tv, G, GV, CS%cvmix_conv_csp, Hml) + !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! do k=1,nz ; do j=js,je ; do i=is,ie - visc%Kd_turb(i,j,k) = visc%Kd_turb(i,j,k) + CS%cvmix_conv_csp%kd_conv_3d(i,j,k) + Kd_int(i,j,k) = Kd_int(i,j,k) + CS%cvmix_conv_csp%kd_conv_3d(i,j,k) + ! GMM, I am not sure if Kv_turb is the right place to add kv_conv_3d visc%Kv_turb(i,j,k) = visc%Kv_turb(i,j,k) + CS%cvmix_conv_csp%kv_conv_3d(i,j,k) + visc%Kd_turb(i,j,k) = visc%Kd_turb(i,j,k) + CS%cvmix_conv_csp%kd_conv_3d(i,j,k) enddo ; enddo ; enddo + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! endif From bb7917a7ee842d01c99c8ffe077a6c3a97a05c83 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 15 Mar 2018 13:29:27 -0600 Subject: [PATCH 0022/1072] comment out call ocn_domain_mct to avoid uninitialized vars for now. more comprehensive cleanup is to come. --- config_src/mct_driver/ocn_comp_mct.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index d97cb96a40..a24dd03fd9 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -580,7 +580,7 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) if (debug .and. root_pe().eq.pe_here()) print *, "calling ocn_domain_mct" call ocn_domain_mct(lsize, MOM_MCT_gsmap, MOM_MCT_dom) - call ocn_domain_mct(lsize*km, MOM_MCT_gsmap3d, MOM_MCT_dom3d) !TODO: this is not used + !call ocn_domain_mct(lsize*km, MOM_MCT_gsmap3d, MOM_MCT_dom3d) !TODO: this is not used ! Inialize mct attribute vectors From c2dea888902aa4f17251c034c2794f73351b031a Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Fri, 16 Mar 2018 10:36:42 -0600 Subject: [PATCH 0023/1072] update diabatic driver for MOM_cvmix_tidal module --- .../vertical/MOM_cvmix_tidal.F90 | 50 +++++++++++++++---- .../vertical/MOM_diabatic_driver.F90 | 15 ++++++ 2 files changed, 56 insertions(+), 9 deletions(-) diff --git a/src/parameterizations/vertical/MOM_cvmix_tidal.F90 b/src/parameterizations/vertical/MOM_cvmix_tidal.F90 index 50f64edc49..855e36c754 100644 --- a/src/parameterizations/vertical/MOM_cvmix_tidal.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_tidal.F90 @@ -8,28 +8,31 @@ module MOM_cvmix_tidal use MOM_EOS, only : calculate_density use MOM_variables, only : thermo_var_ptrs use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE -use MOM_file_parser, only : openParameterBlock, closeParameterBlock use MOM_debugging, only : hchksum use MOM_grid, only : ocean_grid_type use MOM_verticalGrid, only : verticalGrid_type +use MOM_file_parser, only : openParameterBlock, closeParameterBlock use MOM_file_parser, only : get_param, log_version, param_file_type -use cvmix_kpp, only : CVmix_kpp_compute_kOBL_depth +use cvmix_tidal, only : cvmix_init_tidal implicit none ; private #include -logical :: debug = is_root_pe .and. .true. - public cvmix_tidal_init public calculate_cvmix_tidal public cvmix_tidal_end !> Control structure including parameters for CVMix tidal mixing. type, public :: cvmix_tidal_cs + logical :: debug = .true. ! Parameters - real :: kd_conv !< diffusivity constant used in convective regime (m2/s) + real :: local_mixing_frac !< fraction of wave energy dissipated locally. + real :: mixing_efficiency !< The efficiency that mechanical energy dissipation translates into mixing + !! that can be parameterized by a diffusivity acting on vertical stratification. + real :: vert_decay_scale !< zeta in the Simmons paper (to compute the vertical deposition function). [m] + real :: tidal_max_coef !< maximum allowable tidel diffusivity. [m^2/s] end type cvmix_tidal_cs @@ -59,16 +62,45 @@ logical function cvmix_tidal_init(Time, G, GV, param_file, diag, CS) endif allocate(CS) + CS%debug = CS%debug.and.is_root_pe() + ! Read parameters call log_version(param_file, mdl, version, & - "Parameterization of enhanced mixing due to convection via CVMix") + "Parameterization of tidal mixing via CVMix") call get_param(param_file, mdl, "USE_CVMIX_TIDAL", cvmix_tidal_init, & - "If true, turns on tidal mixing scheme via CVMix\n", & + "If true, turns on tidal mixing scheme via CVMix", & default=.false.) + call openParameterBlock(param_file,'CVMIX_TIDAL') + call get_param(param_file, mdl, "LOCAL_MIXING_FRAC", CS%local_mixing_frac, & + "Fraction of wave energy dissipated locally.", & + units="nondim", default=0.33) + call get_param(param_file, mdl, "MIXING_EFFICIENCY", CS%mixing_efficiency, & + "Gamma in Simmons, 2004", & + units="nondim", default=0.20) + !TODO: make sure GAMMA_ITIDES (same as LOCAL_MIXING_FRAC + call get_param(param_file, mdl, "VERTICAL_DECAY_SCALE", CS%vert_decay_scale, & + "zeta in Simmons, 2004. Used to compute the vertical deposition function", & + units="m", default=500.0) + !TODO: make sure int_tide_decay scale (same as VERTICAL_DECAY_SCALE is removed from code). + call get_param(param_file, mdl, "TIDAL_MAX_COEF", CS%tidal_max_coef, & + "largest acceptable value for tidal diffusivity", & + units="m^2/s", default=100e-4) ! the default is 50e-4 in CVMIX, 100e-4 in POP. + call closeParameterBlock(param_file) + + if (.not. cvmix_tidal_init) return + + if (CS%debug) print *, __FILE__, __LINE__, cvmix_tidal_init + + ! Set up CVMix + call cvmix_init_tidal(mix_scheme = 'Simmons', & + efficiency = cs%mixing_efficiency, & + vertical_decay_scale = cs%vert_decay_scale, & + max_coefficient = cs%tidal_max_coef, & + local_mixing_frac = cs%local_mixing_frac, & + depth_cutoff = 0.0) + - if (.not. cvmix_conv_init) return - call closeParameterBlock(param_file) end function cvmix_tidal_init diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 91b3c343e0..15c9a415c7 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -26,6 +26,8 @@ module MOM_diabatic_driver use MOM_diffConvection, only : diffConvection_calculate, diffConvection_end use MOM_domains, only : pass_var, To_West, To_South, To_All, Omit_Corners use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type +use MOM_cvmix_tidal, only : cvmix_tidal_init, cvmix_tidal_cs +use MOM_cvmix_tidal, only : calculate_cvmix_tidal, cvmix_tidal_end use MOM_energetic_PBL, only : energetic_PBL, energetic_PBL_init use MOM_energetic_PBL, only : energetic_PBL_end, energetic_PBL_CS use MOM_energetic_PBL, only : energetic_PBL_get_MLD @@ -90,6 +92,8 @@ module MOM_diabatic_driver !! shear-driven diapycnal diffusivity. logical :: use_cvmix_shear !< If true, use the CVMix module to find the !! shear-driven diapycnal diffusivity. + logical :: use_cvmix_tidal !< If true, use the CVMix module to compute the + !! tidal mixing diffusivity. logical :: use_sponge !< If true, sponges may be applied anywhere in the !! domain. The exact location and properties of !! those sponges are set by calls to @@ -220,6 +224,7 @@ module MOM_diabatic_driver type(optics_type), pointer :: optics => NULL() type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() type(KPP_CS), pointer :: KPP_CSp => NULL() + type(cvmix_tidal_cs), pointer :: cvmix_tidal_csp => NULL() type(diffConvection_CS), pointer :: Conv_CSp => NULL() type(diapyc_energy_req_CS), pointer :: diapyc_en_rec_CSp => NULL() @@ -666,6 +671,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G endif ! endif for KPP + ! Add diffusivity due to tidal mixing (computed via CVMix) + if (CS%use_cvmix_tidal) then + continue !TODO + end if + ! Check for static instabilities and increase Kd_int where unstable if (CS%useConvection) call diffConvection_calculate(CS%Conv_CSp, & G, GV, h, tv%T, tv%S, tv%eqn_of_state, Kd_int) @@ -2323,6 +2333,8 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, allocate(CS%frazil_heat_diag(isd:ied,jsd:jed,nz) ) ; CS%frazil_heat_diag(:,:,:) = 0. endif + ! CS%use_cvmix_tidal is set to True if CVMix tidal mixing will be used, otherwise false. + CS%use_cvmix_tidal = cvmix_tidal_init(Time, G, GV, param_file, diag, CS%cvmix_tidal_csp) ! CS%useConvection is set to True IF convection will be used, otherwise False. ! CS%Conv_CSp is allocated by diffConvection_init() @@ -2414,6 +2426,9 @@ subroutine diabatic_driver_end(CS) deallocate( CS%KPP_NLTscalar ) call KPP_end(CS%KPP_CSp) endif + + if (CS%use_cvmix_tidal) call cvmix_tidal_end(CS%cvmix_tidal_csp) + if (CS%useConvection) call diffConvection_end(CS%Conv_CSp) if (CS%use_energetic_PBL) & call energetic_PBL_end(CS%energetic_PBL_CSp) From 95406ff08c712121637af746513e76d300ce398f Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Fri, 16 Mar 2018 15:56:53 -0600 Subject: [PATCH 0024/1072] Rename MOM_cvmix_tidal module as MOM_tidal_mixing (for now) --- .../vertical/MOM_diabatic_driver.F90 | 19 ++++--- ...M_cvmix_tidal.F90 => MOM_tidal_mixing.F90} | 52 +++++++++++-------- 2 files changed, 38 insertions(+), 33 deletions(-) rename src/parameterizations/vertical/{MOM_cvmix_tidal.F90 => MOM_tidal_mixing.F90} (72%) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 15c9a415c7..8ccbe3fc11 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -26,8 +26,8 @@ module MOM_diabatic_driver use MOM_diffConvection, only : diffConvection_calculate, diffConvection_end use MOM_domains, only : pass_var, To_West, To_South, To_All, Omit_Corners use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type -use MOM_cvmix_tidal, only : cvmix_tidal_init, cvmix_tidal_cs -use MOM_cvmix_tidal, only : calculate_cvmix_tidal, cvmix_tidal_end +use MOM_tidal_mixing, only : tidal_mixing_init, tidal_mixing_cs +use MOM_tidal_mixing, only : calculate_cvmix_tidal, tidal_mixing_end use MOM_energetic_PBL, only : energetic_PBL, energetic_PBL_init use MOM_energetic_PBL, only : energetic_PBL_end, energetic_PBL_CS use MOM_energetic_PBL, only : energetic_PBL_get_MLD @@ -92,8 +92,7 @@ module MOM_diabatic_driver !! shear-driven diapycnal diffusivity. logical :: use_cvmix_shear !< If true, use the CVMix module to find the !! shear-driven diapycnal diffusivity. - logical :: use_cvmix_tidal !< If true, use the CVMix module to compute the - !! tidal mixing diffusivity. + logical :: use_tidal_mixing !< If true, activate tidal mixing diffusivity. logical :: use_sponge !< If true, sponges may be applied anywhere in the !! domain. The exact location and properties of !! those sponges are set by calls to @@ -224,7 +223,7 @@ module MOM_diabatic_driver type(optics_type), pointer :: optics => NULL() type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() type(KPP_CS), pointer :: KPP_CSp => NULL() - type(cvmix_tidal_cs), pointer :: cvmix_tidal_csp => NULL() + type(tidal_mixing_cs), pointer :: tidal_mixing_csp => NULL() type(diffConvection_CS), pointer :: Conv_CSp => NULL() type(diapyc_energy_req_CS), pointer :: diapyc_en_rec_CSp => NULL() @@ -671,8 +670,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G endif ! endif for KPP - ! Add diffusivity due to tidal mixing (computed via CVMix) - if (CS%use_cvmix_tidal) then + ! Add diffusivity due to tidal mixing + if (CS%use_tidal_mixing) then continue !TODO end if @@ -2333,8 +2332,8 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, allocate(CS%frazil_heat_diag(isd:ied,jsd:jed,nz) ) ; CS%frazil_heat_diag(:,:,:) = 0. endif - ! CS%use_cvmix_tidal is set to True if CVMix tidal mixing will be used, otherwise false. - CS%use_cvmix_tidal = cvmix_tidal_init(Time, G, GV, param_file, diag, CS%cvmix_tidal_csp) + ! CS%use_tidal_mixing is set to True tidal mixing will be activated, otherwise false. + CS%use_tidal_mixing = tidal_mixing_init(Time, G, GV, param_file, diag, CS%tidal_mixing_CSp) ! CS%useConvection is set to True IF convection will be used, otherwise False. ! CS%Conv_CSp is allocated by diffConvection_init() @@ -2427,7 +2426,7 @@ subroutine diabatic_driver_end(CS) call KPP_end(CS%KPP_CSp) endif - if (CS%use_cvmix_tidal) call cvmix_tidal_end(CS%cvmix_tidal_csp) + if (CS%use_tidal_mixing) call tidal_mixing_end(CS%tidal_mixing_CSp) if (CS%useConvection) call diffConvection_end(CS%Conv_CSp) if (CS%use_energetic_PBL) & diff --git a/src/parameterizations/vertical/MOM_cvmix_tidal.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 similarity index 72% rename from src/parameterizations/vertical/MOM_cvmix_tidal.F90 rename to src/parameterizations/vertical/MOM_tidal_mixing.F90 index 855e36c754..d136759ac5 100644 --- a/src/parameterizations/vertical/MOM_cvmix_tidal.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -1,5 +1,5 @@ -!> Interface to CVMix tidal mixing scheme. -module MOM_cvmix_tidal +!> Interface to vertical tidal mixing schemes including CVMix tidal mixing. +module MOM_tidal_mixing ! This file is part of MOM6. See LICENSE.md for the license. @@ -19,12 +19,12 @@ module MOM_cvmix_tidal #include -public cvmix_tidal_init +public tidal_mixing_init public calculate_cvmix_tidal -public cvmix_tidal_end +public tidal_mixing_end -!> Control structure including parameters for CVMix tidal mixing. -type, public :: cvmix_tidal_cs +!> Control structure including parameters for tidal mixing. +type, public :: tidal_mixing_cs logical :: debug = .true. ! Parameters @@ -34,21 +34,20 @@ module MOM_cvmix_tidal real :: vert_decay_scale !< zeta in the Simmons paper (to compute the vertical deposition function). [m] real :: tidal_max_coef !< maximum allowable tidel diffusivity. [m^2/s] -end type cvmix_tidal_cs +end type tidal_mixing_cs -character(len=40) :: mdl = "MOM_cvmix_tidal" !< This module's name. +character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name. contains -!> Initialize the cvmix tidal mixing routine. -logical function cvmix_tidal_init(Time, G, GV, param_file, diag, CS) +logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current time. type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. - type(cvmix_tidal_cs), pointer :: CS !< This module's control structure. + type(tidal_mixing_cs), pointer :: CS !< This module's control structure. ! Local variables @@ -56,7 +55,7 @@ logical function cvmix_tidal_init(Time, G, GV, param_file, diag, CS) #include "version_variable.h" if (associated(CS)) then - call MOM_error(WARNING, "cvmix_tidal_init called when control structure "// & + call MOM_error(WARNING, "tidal_mixing_init called when control structure "// & "is already associated.") return endif @@ -66,11 +65,18 @@ logical function cvmix_tidal_init(Time, G, GV, param_file, diag, CS) ! Read parameters call log_version(param_file, mdl, version, & - "Parameterization of tidal mixing via CVMix") - call get_param(param_file, mdl, "USE_CVMIX_TIDAL", cvmix_tidal_init, & + "Vertical Tidal Mixing Parameterization") + !call get_param(param_file, mdl, "INT_TIDE_DISSIPATION", CS%Int_tide_dissipation, & + ! "If true, use an internal tidal dissipation scheme to \n"//& + ! "drive diapycnal mixing, along the lines of St. Laurent \n"//& + ! "et al. (2002) and Simmons et al. (2004).", default=.false.) + if (.not. tidal_mixing_init) return + + + call get_param(param_file, mdl, "USE_CVMIX_TIDAL", tidal_mixing_init, & "If true, turns on tidal mixing scheme via CVMix", & default=.false.) - call openParameterBlock(param_file,'CVMIX_TIDAL') + !call openParameterBlock(param_file,'CVMIX_TIDAL') call get_param(param_file, mdl, "LOCAL_MIXING_FRAC", CS%local_mixing_frac, & "Fraction of wave energy dissipated locally.", & units="nondim", default=0.33) @@ -85,11 +91,10 @@ logical function cvmix_tidal_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "TIDAL_MAX_COEF", CS%tidal_max_coef, & "largest acceptable value for tidal diffusivity", & units="m^2/s", default=100e-4) ! the default is 50e-4 in CVMIX, 100e-4 in POP. - call closeParameterBlock(param_file) + !call closeParameterBlock(param_file) - if (.not. cvmix_tidal_init) return - if (CS%debug) print *, __FILE__, __LINE__, cvmix_tidal_init + if (CS%debug) print *, __FILE__, __LINE__, tidal_mixing_init ! Set up CVMix call cvmix_init_tidal(mix_scheme = 'Simmons', & @@ -99,10 +104,11 @@ logical function cvmix_tidal_init(Time, G, GV, param_file, diag, CS) local_mixing_frac = cs%local_mixing_frac, & depth_cutoff = 0.0) + ! TODO: read in energy -end function cvmix_tidal_init +end function tidal_mixing_init !> .... @@ -112,12 +118,12 @@ end subroutine calculate_cvmix_tidal !> Clear pointers and deallocate memory -subroutine cvmix_tidal_end(CS) - type(cvmix_tidal_cs), pointer :: CS ! This module's control structure +subroutine tidal_mixing_end(CS) + type(tidal_mixing_cs), pointer :: CS ! This module's control structure !TODO deallocate all the dynamically allocated members here ... deallocate(CS) -end subroutine cvmix_tidal_end +end subroutine tidal_mixing_end -end module MOM_cvmix_tidal +end module MOM_tidal_mixing From 76546aae265ef8a164e7427f032f97875c781944 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Fri, 16 Mar 2018 17:26:04 -0600 Subject: [PATCH 0025/1072] Move tidal mixing initialization to MOM_tidal_mixing --- .../vertical/MOM_diabatic_driver.F90 | 3 +- .../vertical/MOM_set_diffusivity.F90 | 351 +------------- .../vertical/MOM_tidal_mixing.F90 | 446 ++++++++++++++++-- 3 files changed, 408 insertions(+), 392 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 8ccbe3fc11..fe1fe5deaa 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -2332,7 +2332,8 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, allocate(CS%frazil_heat_diag(isd:ied,jsd:jed,nz) ) ; CS%frazil_heat_diag(:,:,:) = 0. endif - ! CS%use_tidal_mixing is set to True tidal mixing will be activated, otherwise false. + ! CS%use_tidal_mixing is set to True if an internal tidal dissipation scheme + ! is to be used to drive diapycnal mixing. CS%use_tidal_mixing = tidal_mixing_init(Time, G, GV, param_file, diag, CS%tidal_mixing_CSp) ! CS%useConvection is set to True IF convection will be used, otherwise False. diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 15cbd6bb1c..d38b446770 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -27,7 +27,7 @@ module MOM_set_diffusivity use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE use MOM_diag_mediator, only : diag_ctrl, time_type -use MOM_diag_mediator, only : safe_alloc_ptr, post_data, register_diag_field +use MOM_diag_mediator, only : post_data, register_diag_field use MOM_diag_to_Z, only : diag_to_Z_CS, register_Zint_diag, calc_Zint_diags use MOM_debugging, only : hchksum, uvchksum use MOM_EOS, only : calculate_density, calculate_density_derivs @@ -150,48 +150,6 @@ module MOM_set_diffusivity type(diag_ctrl), pointer :: diag ! structure to regulate diagn output timing - real :: Int_tide_decay_scale ! decay scale for internal wave TKE (meter) - real :: Mu_itides ! efficiency for conversion of dissipation - ! to potential energy (nondimensional) - real :: Gamma_itides ! fraction of local dissipation (nondimensional) - real :: Gamma_lee ! fraction of local dissipation for lee waves - ! (Nikurashin's energy input) (nondimensional) - real :: Decay_scale_factor_lee ! Scaling factor for the decay scale of lee - ! wave energy dissipation (nondimensional) - real :: min_zbot_itides ! minimum depth for internal tide conversion (meter) - logical :: Int_tide_dissipation ! Internal tide conversion (from barotropic) with - ! the schemes of St Laurent et al (2002)/ - ! Simmons et al (2004) - logical :: Lowmode_itidal_dissipation ! Internal tide conversion (from low modes) with - ! the schemes of St Laurent et al (2002)/ - ! Simmons et al (2004) !BDM - integer :: Int_tide_profile ! A coded integer indicating the vertical profile - ! for dissipation of the internal waves. Schemes that - ! are currently encoded are St Laurent et al (2002) and - ! Polzin (2009). - real :: Nu_Polzin ! The non-dimensional constant used in Polzin form of - ! the vertical scale of decay of tidal dissipation - real :: Nbotref_Polzin ! Reference value for the buoyancy frequency at the - ! ocean bottom used in Polzin formulation of the - ! vertical scale of decay of tidal dissipation (1/s) - real :: Polzin_decay_scale_factor ! Scaling factor for the decay length scale - ! of the tidal dissipation profile in Polzin - ! (nondimensional) - real :: Polzin_decay_scale_max_factor ! The decay length scale of tidal - ! dissipation profile in Polzin formulation should not - ! exceed Polzin_decay_scale_max_factor * depth of the - ! ocean (nondimensional). - real :: Polzin_min_decay_scale ! minimum decay scale of the tidal dissipation - ! profile in Polzin formulation (meter) - logical :: Lee_wave_dissipation ! Enable lee-wave driven mixing, following - ! Nikurashin (2010), with a vertical energy - ! deposition profile specified by Lee_wave_profile. - ! St Laurent et al (2002) or - ! Simmons et al (2004) scheme - integer :: Lee_wave_profile ! A coded integer indicating the vertical profile - ! for dissipation of the lee waves. Schemes that are - ! currently encoded are St Laurent et al (2002) and - ! Polzin (2009). logical :: limit_dissipation ! If enabled, dissipation is limited to be larger ! than the following: real :: dissip_min ! Minimum dissipation (W/m3) @@ -203,10 +161,6 @@ module MOM_set_diffusivity real :: TKE_itide_max ! maximum internal tide conversion (W m-2) ! available to mix above the BBL real :: omega ! Earth's rotation frequency (s-1) - real :: utide ! constant tidal amplitude (m s-1) used if - ! tidal amplitude file is not present - real :: kappa_itides ! topographic wavenumber and non-dimensional scaling - real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height logical :: ML_radiation ! allow a fraction of TKE available from wind work ! to penetrate below mixed layer base with a vertical ! decay scale determined by the minimum of @@ -255,13 +209,6 @@ module MOM_set_diffusivity real :: Max_salt_diff_salt_fingers ! max salt diffusivity for salt fingers (m2/s) real :: Kv_molecular ! molecular visc for double diff convect (m2/s) - real, pointer, dimension(:,:) :: TKE_Niku => NULL() - real, pointer, dimension(:,:) :: TKE_itidal => NULL() - real, pointer, dimension(:,:) :: Nb => NULL() - real, pointer, dimension(:,:) :: mask_itidal => NULL() - real, pointer, dimension(:,:) :: h2 => NULL() - real, pointer, dimension(:,:) :: tideamp => NULL() ! RMS tidal amplitude (m/s) - character(len=200) :: inputdir type(user_change_diff_CS), pointer :: user_change_diff_CSp => NULL() type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() @@ -269,8 +216,6 @@ module MOM_set_diffusivity type(CVMix_shear_CS), pointer :: CVMix_Shear_CSp => NULL() type(int_tide_CS), pointer :: int_tide_CSp => NULL() - integer :: id_TKE_itidal = -1 - integer :: id_TKE_leewave = -1 integer :: id_maxTKE = -1 integer :: id_TKE_to_Kd = -1 @@ -340,11 +285,6 @@ module MOM_set_diffusivity end type diffusivity_diags -character*(20), parameter :: STLAURENT_PROFILE_STRING = "STLAURENT_02" -character*(20), parameter :: POLZIN_PROFILE_STRING = "POLZIN_09" -integer, parameter :: STLAURENT_02 = 1 -integer, parameter :: POLZIN_09 = 2 - ! Clocks integer :: id_clock_kappaShear @@ -2557,19 +2497,15 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp ! (in) diag_to_Z_CSp - pointer to the Z-diagnostics control structure ! (in) int_tide_CSp - pointer to the internal tides control structure (BDM) - real :: decay_length, utide, zbot, hamp + real :: decay_length type(vardesc) :: vd - logical :: read_tideamp, ML_use_omega + logical :: ML_use_omega ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_set_diffusivity" ! This module's name. - character(len=20) :: tmpstr character(len=200) :: filename, tideamp_file, h2_file, Niku_TKE_input_file real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data real :: omega_frac_dflt - integer :: i, j, is, ie, js, je - integer :: isd, ied, jsd, jed - if (associated(CS)) then call MOM_error(WARNING, "diabatic_entrain_init called with an associated "// & "control structure.") @@ -2577,9 +2513,6 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp endif allocate(CS) - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - CS%diag => diag if (associated(int_tide_CSp)) CS%int_tide_CSp => int_tide_CSp if (associated(diag_to_Z_CSp)) CS%diag_to_Z_CSp => diag_to_Z_CSp @@ -2823,90 +2756,6 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", default=.false.) - call get_param(param_file, mdl, "INT_TIDE_DISSIPATION", CS%Int_tide_dissipation, & - "If true, use an internal tidal dissipation scheme to \n"//& - "drive diapycnal mixing, along the lines of St. Laurent \n"//& - "et al. (2002) and Simmons et al. (2004).", default=.false.) - if (CS%Int_tide_dissipation) then - call get_param(param_file, mdl, "INT_TIDE_PROFILE", tmpstr, & - "INT_TIDE_PROFILE selects the vertical profile of energy \n"//& - "dissipation with INT_TIDE_DISSIPATION. Valid values are:\n"//& - "\t STLAURENT_02 - Use the St. Laurent et al exponential \n"//& - "\t decay profile.\n"//& - "\t POLZIN_09 - Use the Polzin WKB-streched algebraic \n"//& - "\t decay profile.", & - default=STLAURENT_PROFILE_STRING) - tmpstr = uppercase(tmpstr) - select case (tmpstr) - case (STLAURENT_PROFILE_STRING) ; CS%int_tide_profile = STLAURENT_02 - case (POLZIN_PROFILE_STRING) ; CS%int_tide_profile = POLZIN_09 - case default - call MOM_error(FATAL, "set_diffusivity_init: Unrecognized setting "// & - "#define INT_TIDE_PROFILE "//trim(tmpstr)//" found in input file.") - end select - endif - - call get_param(param_file, mdl, "LEE_WAVE_DISSIPATION", CS%Lee_wave_dissipation, & - "If true, use an lee wave driven dissipation scheme to \n"//& - "drive diapycnal mixing, along the lines of Nikurashin \n"//& - "(2010) and using the St. Laurent et al. (2002) \n"//& - "and Simmons et al. (2004) vertical profile", default=.false.) - if (CS%lee_wave_dissipation) then - call get_param(param_file, mdl, "LEE_WAVE_PROFILE", tmpstr, & - "LEE_WAVE_PROFILE selects the vertical profile of energy \n"//& - "dissipation with LEE_WAVE_DISSIPATION. Valid values are:\n"//& - "\t STLAURENT_02 - Use the St. Laurent et al exponential \n"//& - "\t decay profile.\n"//& - "\t POLZIN_09 - Use the Polzin WKB-streched algebraic \n"//& - "\t decay profile.", & - default=STLAURENT_PROFILE_STRING) - tmpstr = uppercase(tmpstr) - select case (tmpstr) - case (STLAURENT_PROFILE_STRING) ; CS%lee_wave_profile = STLAURENT_02 - case (POLZIN_PROFILE_STRING) ; CS%lee_wave_profile = POLZIN_09 - case default - call MOM_error(FATAL, "set_diffusivity_init: Unrecognized setting "// & - "#define LEE_WAVE_PROFILE "//trim(tmpstr)//" found in input file.") - end select - endif - - call get_param(param_file, mdl, "INT_TIDE_LOWMODE_DISSIPATION", CS%Lowmode_itidal_dissipation, & - "If true, consider mixing due to breaking low modes that \n"//& - "have been remotely generated; as with itidal drag on the \n"//& - "barotropic tide, use an internal tidal dissipation scheme to \n"//& - "drive diapycnal mixing, along the lines of St. Laurent \n"//& - "et al. (2002) and Simmons et al. (2004).", default=.false.) - - if ((CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09)) .or. & - (CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09))) then - call get_param(param_file, mdl, "NU_POLZIN", CS%Nu_Polzin, & - "When the Polzin decay profile is used, this is a \n"//& - "non-dimensional constant in the expression for the \n"//& - "vertical scale of decay for the tidal energy dissipation.", & - units="nondim", default=0.0697) - call get_param(param_file, mdl, "NBOTREF_POLZIN", CS%Nbotref_Polzin, & - "When the Polzin decay profile is used, this is the \n"//& - "Rreference value of the buoyancy frequency at the ocean \n"//& - "bottom in the Polzin formulation for the vertical \n"//& - "scale of decay for the tidal energy dissipation.", & - units="s-1", default=9.61e-4) - call get_param(param_file, mdl, "POLZIN_DECAY_SCALE_FACTOR", & - CS%Polzin_decay_scale_factor, & - "When the Polzin decay profile is used, this is a \n"//& - "scale factor for the vertical scale of decay of the tidal \n"//& - "energy dissipation.", default=1.0, units="nondim") - call get_param(param_file, mdl, "POLZIN_SCALE_MAX_FACTOR", & - CS%Polzin_decay_scale_max_factor, & - "When the Polzin decay profile is used, this is a factor \n"//& - "to limit the vertical scale of decay of the tidal \n"//& - "energy dissipation to POLZIN_DECAY_SCALE_MAX_FACTOR \n"//& - "times the depth of the ocean.", units="nondim", default=1.0) - call get_param(param_file, mdl, "POLZIN_MIN_DECAY_SCALE", CS%Polzin_min_decay_scale, & - "When the Polzin decay profile is used, this is the \n"//& - "minimum vertical decay scale for the vertical profile\n"//& - "of internal tide dissipation with the Polzin (2009) formulation", & - units="m", default=0.0) - endif call get_param(param_file, mdl, "USER_CHANGE_DIFFUSIVITY", CS%user_change_diff, & "If true, call user-defined code to change the diffusivity.", & default=.false.) @@ -2934,203 +2783,9 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp if (CS%FluxRi_max > 0.0) & CS%dissip_N2 = CS%dissip_Kd_min * GV%Rho0 / CS%FluxRi_max - if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation) then - call get_param(param_file, mdl, "INT_TIDE_DECAY_SCALE", CS%Int_tide_decay_scale, & - "The decay scale away from the bottom for tidal TKE with \n"//& - "the new coding when INT_TIDE_DISSIPATION is used.", & - units="m", default=0.0) - call get_param(param_file, mdl, "MU_ITIDES", CS%Mu_itides, & - "A dimensionless turbulent mixing efficiency used with \n"//& - "INT_TIDE_DISSIPATION, often 0.2.", units="nondim", default=0.2) - call get_param(param_file, mdl, "GAMMA_ITIDES", CS%Gamma_itides, & - "The fraction of the internal tidal energy that is \n"//& - "dissipated locally with INT_TIDE_DISSIPATION. \n"//& - "THIS NAME COULD BE BETTER.", & - units="nondim", default=0.3333) - call get_param(param_file, mdl, "MIN_ZBOT_ITIDES", CS%min_zbot_itides, & - "Turn off internal tidal dissipation when the total \n"//& - "ocean depth is less than this value.", units="m", default=0.0) - - call safe_alloc_ptr(CS%Nb,isd,ied,jsd,jed) - call safe_alloc_ptr(CS%h2,isd,ied,jsd,jed) - call safe_alloc_ptr(CS%TKE_itidal,isd,ied,jsd,jed) - call safe_alloc_ptr(CS%mask_itidal,isd,ied,jsd,jed) ; CS%mask_itidal(:,:) = 1.0 - - call get_param(param_file, mdl, "KAPPA_ITIDES", CS%kappa_itides, & - "A topographic wavenumber used with INT_TIDE_DISSIPATION. \n"//& - "The default is 2pi/10 km, as in St.Laurent et al. 2002.", & - units="m-1", default=8.e-4*atan(1.0)) - - call get_param(param_file, mdl, "UTIDE", CS%utide, & - "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & - units="m s-1", default=0.0) - call safe_alloc_ptr(CS%tideamp,is,ie,js,je) ; CS%tideamp(:,:) = CS%utide - - call get_param(param_file, mdl, "KAPPA_H2_FACTOR", CS%kappa_h2_factor, & - "A scaling factor for the roughness amplitude with n"//& - "INT_TIDE_DISSIPATION.", units="nondim", default=1.0) - call get_param(param_file, mdl, "TKE_ITIDE_MAX", CS%TKE_itide_max, & - "The maximum internal tide energy source availble to mix \n"//& - "above the bottom boundary layer with INT_TIDE_DISSIPATION.", & - units="W m-2", default=1.0e3) - - call get_param(param_file, mdl, "READ_TIDEAMP", read_tideamp, & - "If true, read a file (given by TIDEAMP_FILE) containing \n"//& - "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) - if (read_tideamp) then - call get_param(param_file, mdl, "TIDEAMP_FILE", tideamp_file, & - "The path to the file containing the spatially varying \n"//& - "tidal amplitudes with INT_TIDE_DISSIPATION.", default="tideamp.nc") - filename = trim(CS%inputdir) // trim(tideamp_file) - call log_param(param_file, mdl, "INPUTDIR/TIDEAMP_FILE", filename) - call MOM_read_data(filename, 'tideamp', CS%tideamp, G%domain, timelevel=1) - endif - - call get_param(param_file, mdl, "H2_FILE", h2_file, & - "The path to the file containing the sub-grid-scale \n"//& - "topographic roughness amplitude with INT_TIDE_DISSIPATION.", & - fail_if_missing=.true.) - filename = trim(CS%inputdir) // trim(h2_file) - call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) - call MOM_read_data(filename, 'h2', CS%h2, G%domain, timelevel=1) - - do j=js,je ; do i=is,ie - if (G%bathyT(i,j) < CS%min_zbot_itides) CS%mask_itidal(i,j) = 0.0 - CS%tideamp(i,j) = CS%tideamp(i,j) * CS%mask_itidal(i,j) * G%mask2dT(i,j) - - ! Restrict rms topo to 10 percent of column depth. - zbot = G%bathyT(i,j) - hamp = sqrt(CS%h2(i,j)) - hamp = min(0.1*zbot,hamp) - CS%h2(i,j) = hamp*hamp - - utide = CS%tideamp(i,j) - ! Compute the fixed part of internal tidal forcing; units are [kg s-2] here. - CS%TKE_itidal(i,j) = 0.5*CS%kappa_h2_factor*GV%Rho0*& - CS%kappa_itides*CS%h2(i,j)*utide*utide - enddo; enddo - - endif - CS%id_Kd_layer = register_diag_field('ocean_model', 'Kd_layer', diag%axesTL, Time, & 'Diapycnal diffusivity of layers (as set)', 'm2 s-1') - if (CS%Lee_wave_dissipation) then - - call get_param(param_file, mdl, "NIKURASHIN_TKE_INPUT_FILE",Niku_TKE_input_file, & - "The path to the file containing the TKE input from lee \n"//& - "wave driven mixing. Used with LEE_WAVE_DISSIPATION.", & - fail_if_missing=.true.) - call get_param(param_file, mdl, "NIKURASHIN_SCALE",Niku_scale, & - "A non-dimensional factor by which to scale the lee-wave \n"//& - "driven TKE input. Used with LEE_WAVE_DISSIPATION.", & - units="nondim", default=1.0) - - filename = trim(CS%inputdir) // trim(Niku_TKE_input_file) - call log_param(param_file, mdl, "INPUTDIR/NIKURASHIN_TKE_INPUT_FILE", & - filename) - call safe_alloc_ptr(CS%TKE_Niku,is,ie,js,je); CS%TKE_Niku(:,:) = 0.0 - call MOM_read_data(filename, 'TKE_input', CS%TKE_Niku, G%domain, timelevel=1 ) ! ??? timelevel -aja - CS%TKE_Niku(:,:) = Niku_scale * CS%TKE_Niku(:,:) - - call get_param(param_file, mdl, "GAMMA_NIKURASHIN",CS%Gamma_lee, & - "The fraction of the lee wave energy that is dissipated \n"//& - "locally with LEE_WAVE_DISSIPATION.", units="nondim", & - default=0.3333) - call get_param(param_file, mdl, "DECAY_SCALE_FACTOR_LEE",CS%Decay_scale_factor_lee, & - "Scaling for the vertical decay scaleof the local \n"//& - "dissipation of lee waves dissipation.", units="nondim", & - default=1.0) - - CS%id_TKE_leewave = register_diag_field('ocean_model','TKE_leewave',diag%axesT1,Time, & - 'Lee wave Driven Turbulent Kinetic Energy', 'W m-2') - CS%id_Kd_Niku = register_diag_field('ocean_model','Kd_Nikurashin',diag%axesTi,Time, & - 'Lee Wave Driven Diffusivity', 'm2 s-1') - else - CS%Decay_scale_factor_lee = -9.e99 ! This should never be used if CS%Lee_wave_dissipation = False - endif - - if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. & - CS%Lowmode_itidal_dissipation) then - - CS%id_TKE_itidal = register_diag_field('ocean_model','TKE_itidal',diag%axesT1,Time, & - 'Internal Tide Driven Turbulent Kinetic Energy', 'W m-2') - CS%id_maxTKE = register_diag_field('ocean_model','maxTKE',diag%axesTL,Time, & - 'Maximum layer TKE', 'm3 s-3') - CS%id_TKE_to_Kd = register_diag_field('ocean_model','TKE_to_Kd',diag%axesTL,Time, & - 'Convert TKE to Kd', 's2 m') - - CS%id_Nb = register_diag_field('ocean_model','Nb',diag%axesT1,Time, & - 'Bottom Buoyancy Frequency', 's-1') - - CS%id_Kd_itidal = register_diag_field('ocean_model','Kd_itides',diag%axesTi,Time, & - 'Internal Tide Driven Diffusivity', 'm2 s-1') - - CS%id_Kd_lowmode = register_diag_field('ocean_model','Kd_lowmode',diag%axesTi,Time, & - 'Internal Tide Driven Diffusivity (from propagating low modes)', 'm2 s-1') - - CS%id_Fl_itidal = register_diag_field('ocean_model','Fl_itides',diag%axesTi,Time, & - 'Vertical flux of tidal turbulent dissipation', 'm3 s-3') - - CS%id_Fl_lowmode = register_diag_field('ocean_model','Fl_lowmode',diag%axesTi,Time, & - 'Vertical flux of tidal turbulent dissipation (from propagating low modes)', 'm3 s-3') - - CS%id_Polzin_decay_scale = register_diag_field('ocean_model','Polzin_decay_scale',diag%axesT1,Time, & - 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', 'm') - - CS%id_Polzin_decay_scale_scaled = register_diag_field('ocean_model','Polzin_decay_scale_scaled',diag%axesT1,Time, & - 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme, scaled by N2_bot/N2_meanz', 'm') - - CS%id_N2_bot = register_diag_field('ocean_model','N2_b',diag%axesT1,Time, & - 'Bottom Buoyancy frequency squared', 's-2') - - CS%id_N2_meanz = register_diag_field('ocean_model','N2_meanz',diag%axesT1,Time, & - 'Buoyancy frequency squared averaged over the water column', 's-2') - - CS%id_Kd_Work = register_diag_field('ocean_model','Kd_Work',diag%axesTL,Time, & - 'Work done by Diapycnal Mixing', 'W m-2') - - CS%id_Kd_Itidal_Work = register_diag_field('ocean_model','Kd_Itidal_Work',diag%axesTL,Time, & - 'Work done by Internal Tide Diapycnal Mixing', 'W m-2') - - CS%id_Kd_Niku_Work = register_diag_field('ocean_model','Kd_Nikurashin_Work',diag%axesTL,Time, & - 'Work done by Nikurashin Lee Wave Drag Scheme', 'W m-2') - - CS%id_Kd_Lowmode_Work = register_diag_field('ocean_model','Kd_Lowmode_Work',diag%axesTL,Time, & - 'Work done by Internal Tide Diapycnal Mixing (low modes)', 'W m-2') - - CS%id_N2 = register_diag_field('ocean_model','N2',diag%axesTi,Time, & - 'Buoyancy frequency squared', 's-2', cmor_field_name='obvfsq', & - cmor_long_name='Square of seawater buoyancy frequency',& - cmor_standard_name='square_of_brunt_vaisala_frequency_in_sea_water') - - if (CS%user_change_diff) & - CS%id_Kd_user = register_diag_field('ocean_model','Kd_user',diag%axesTi,Time, & - 'User-specified Extra Diffusivity', 'm2 s-1') - - if (associated(diag_to_Z_CSp)) then - vd = var_desc("N2", "s-2",& - "Buoyancy frequency, interpolated to z", z_grid='z') - CS%id_N2_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - vd = var_desc("Kd_itides","m2 s-1", & - "Internal Tide Driven Diffusivity, interpolated to z", z_grid='z') - CS%id_Kd_itidal_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - if (CS%Lee_wave_dissipation) then - vd = var_desc("Kd_Nikurashin", "m2 s-1", & - "Lee Wave Driven Diffusivity, interpolated to z", z_grid='z') - CS%id_Kd_Niku_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - endif - if (CS%Lowmode_itidal_dissipation) then - vd = var_desc("Kd_lowmode","m2 s-1", & - "Internal Tide Driven Diffusivity (from low modes), interpolated to z",& - z_grid='z') - CS%id_Kd_lowmode_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - endif - if (CS%user_change_diff) & - CS%id_Kd_user_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - endif - endif - call get_param(param_file, mdl, "DOUBLE_DIFFUSION", CS%double_diffusion, & "If true, increase diffusivitives for temperature or salt \n"//& "based on double-diffusive paramaterization from MOM4/KPP.", & diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index d136759ac5..a33e15fe6b 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -4,7 +4,7 @@ module MOM_tidal_mixing ! This file is part of MOM6. See LICENSE.md for the license. use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field -use MOM_diag_mediator, only : post_data +use MOM_diag_mediator, only : safe_alloc_ptr, post_data use MOM_EOS, only : calculate_density use MOM_variables, only : thermo_var_ptrs use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE @@ -28,15 +28,81 @@ module MOM_tidal_mixing logical :: debug = .true. ! Parameters - real :: local_mixing_frac !< fraction of wave energy dissipated locally. - real :: mixing_efficiency !< The efficiency that mechanical energy dissipation translates into mixing - !! that can be parameterized by a diffusivity acting on vertical stratification. - real :: vert_decay_scale !< zeta in the Simmons paper (to compute the vertical deposition function). [m] - real :: tidal_max_coef !< maximum allowable tidel diffusivity. [m^2/s] + logical :: int_tide_dissipation ! Internal tide conversion (from barotropic) with + ! the schemes of St Laurent et al (2002)/ + ! Simmons et al (2004) + integer :: Int_tide_profile ! A coded integer indicating the vertical profile + ! for dissipation of the internal waves. Schemes that + ! are currently encoded are St Laurent et al (2002) and + ! Polzin (2009). + logical :: Lee_wave_dissipation ! Enable lee-wave driven mixing, following + ! Nikurashin (2010), with a vertical energy + ! deposition profile specified by Lee_wave_profile. + ! St Laurent et al (2002) or + ! Simmons et al (2004) scheme + integer :: Lee_wave_profile ! A coded integer indicating the vertical profile + ! for dissipation of the lee waves. Schemes that are + ! currently encoded are St Laurent et al (2002) and + ! Polzin (2009). + real :: Int_tide_decay_scale ! decay scale for internal wave TKE (meter) + real :: Mu_itides ! efficiency for conversion of dissipation + ! to potential energy (nondimensional) + real :: Gamma_itides ! fraction of local dissipation (nondimensional) + real :: Gamma_lee ! fraction of local dissipation for lee waves + ! (Nikurashin's energy input) (nondimensional) + real :: Decay_scale_factor_lee ! Scaling factor for the decay scale of lee + ! wave energy dissipation (nondimensional) + real :: min_zbot_itides ! minimum depth for internal tide conversion (meter) + logical :: Lowmode_itidal_dissipation ! Internal tide conversion (from low modes) with + ! the schemes of St Laurent et al (2002)/ + ! Simmons et al (2004) !BDM + real :: Nu_Polzin ! The non-dimensional constant used in Polzin form of + ! the vertical scale of decay of tidal dissipation + real :: Nbotref_Polzin ! Reference value for the buoyancy frequency at the + ! ocean bottom used in Polzin formulation of the + ! vertical scale of decay of tidal dissipation (1/s) + real :: Polzin_decay_scale_factor ! Scaling factor for the decay length scale + ! of the tidal dissipation profile in Polzin + ! (nondimensional) + real :: Polzin_decay_scale_max_factor ! The decay length scale of tidal + ! dissipation profile in Polzin formulation should not + ! exceed Polzin_decay_scale_max_factor * depth of the + ! ocean (nondimensional). + real :: Polzin_min_decay_scale ! minimum decay scale of the tidal dissipation + ! profile in Polzin formulation (meter) + real :: TKE_itide_max ! maximum internal tide conversion (W m-2) + ! available to mix above the BBL + real :: utide ! constant tidal amplitude (m s-1) used if + ! tidal amplitude file is not present + real :: kappa_itides ! topographic wavenumber and non-dimensional scaling + real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height + + + !real :: local_mixing_frac !< fraction of wave energy dissipated locally. + !real :: mixing_efficiency !< The efficiency that mechanical energy dissipation translates into mixing + ! !! that can be parameterized by a diffusivity acting on vertical stratification. + !real :: vert_decay_scale !< zeta in the Simmons paper (to compute the vertical deposition function). [m] + !real :: tidal_max_coef !< maximum allowable tidel diffusivity. [m^2/s] + + real, pointer, dimension(:,:) :: TKE_Niku => NULL() + real, pointer, dimension(:,:) :: TKE_itidal => NULL() + real, pointer, dimension(:,:) :: Nb => NULL() + real, pointer, dimension(:,:) :: mask_itidal => NULL() + real, pointer, dimension(:,:) :: h2 => NULL() + real, pointer, dimension(:,:) :: tideamp => NULL() ! RMS tidal amplitude (m/s) + + + integer :: id_TKE_itidal = -1 + integer :: id_TKE_leewave = -1 end type tidal_mixing_cs -character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name. +character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name. +character*(20), parameter :: STLAURENT_PROFILE_STRING = "STLAURENT_02" +character*(20), parameter :: POLZIN_PROFILE_STRING = "POLZIN_09" +integer, parameter :: STLAURENT_02 = 1 +integer, parameter :: POLZIN_09 = 2 + contains @@ -50,6 +116,15 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) type(tidal_mixing_cs), pointer :: CS !< This module's control structure. ! Local variables + logical :: read_tideamp + character(len=40) :: mdl = "MOM_set_diffusivity" ! This module's name. + character(len=20) :: tmpstr + character(len=200) :: filename, tideamp_file, h2_file, Niku_TKE_input_file + real :: utide, zbot, hamp + real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed + ! This include declares and sets the variable "version". #include "version_variable.h" @@ -63,48 +138,333 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) CS%debug = CS%debug.and.is_root_pe() + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + ! Read parameters call log_version(param_file, mdl, version, & "Vertical Tidal Mixing Parameterization") - !call get_param(param_file, mdl, "INT_TIDE_DISSIPATION", CS%Int_tide_dissipation, & - ! "If true, use an internal tidal dissipation scheme to \n"//& - ! "drive diapycnal mixing, along the lines of St. Laurent \n"//& - ! "et al. (2002) and Simmons et al. (2004).", default=.false.) + call get_param(param_file, mdl, "INT_TIDE_DISSIPATION", CS%int_tide_dissipation, & + "If true, use an internal tidal dissipation scheme to \n"//& + "drive diapycnal mixing, along the lines of St. Laurent \n"//& + "et al. (2002) and Simmons et al. (2004).", default=.false.) + + tidal_mixing_init = CS%int_tide_dissipation if (.not. tidal_mixing_init) return + if (CS%int_tide_dissipation) then + call get_param(param_file, mdl, "INT_TIDE_PROFILE", tmpstr, & + "INT_TIDE_PROFILE selects the vertical profile of energy \n"//& + "dissipation with INT_TIDE_DISSIPATION. Valid values are:\n"//& + "\t STLAURENT_02 - Use the St. Laurent et al exponential \n"//& + "\t decay profile.\n"//& + "\t POLZIN_09 - Use the Polzin WKB-streched algebraic \n"//& + "\t decay profile.", & + default=STLAURENT_PROFILE_STRING) + tmpstr = uppercase(tmpstr) + select case (tmpstr) + case (STLAURENT_PROFILE_STRING) ; CS%int_tide_profile = STLAURENT_02 + case (POLZIN_PROFILE_STRING) ; CS%int_tide_profile = POLZIN_09 + case default + call MOM_error(FATAL, "set_diffusivity_init: Unrecognized setting "// & + "#define INT_TIDE_PROFILE "//trim(tmpstr)//" found in input file.") + end select + endif + + call get_param(param_file, mdl, "LEE_WAVE_DISSIPATION", CS%Lee_wave_dissipation, & + "If true, use an lee wave driven dissipation scheme to \n"//& + "drive diapycnal mixing, along the lines of Nikurashin \n"//& + "(2010) and using the St. Laurent et al. (2002) \n"//& + "and Simmons et al. (2004) vertical profile", default=.false.) + if (CS%lee_wave_dissipation) then + call get_param(param_file, mdl, "LEE_WAVE_PROFILE", tmpstr, & + "LEE_WAVE_PROFILE selects the vertical profile of energy \n"//& + "dissipation with LEE_WAVE_DISSIPATION. Valid values are:\n"//& + "\t STLAURENT_02 - Use the St. Laurent et al exponential \n"//& + "\t decay profile.\n"//& + "\t POLZIN_09 - Use the Polzin WKB-streched algebraic \n"//& + "\t decay profile.", & + default=STLAURENT_PROFILE_STRING) + tmpstr = uppercase(tmpstr) + select case (tmpstr) + case (STLAURENT_PROFILE_STRING) ; CS%lee_wave_profile = STLAURENT_02 + case (POLZIN_PROFILE_STRING) ; CS%lee_wave_profile = POLZIN_09 + case default + call MOM_error(FATAL, "set_diffusivity_init: Unrecognized setting "// & + "#define LEE_WAVE_PROFILE "//trim(tmpstr)//" found in input file.") + end select + endif + + call get_param(param_file, mdl, "INT_TIDE_LOWMODE_DISSIPATION", CS%Lowmode_itidal_dissipation, & + "If true, consider mixing due to breaking low modes that \n"//& + "have been remotely generated; as with itidal drag on the \n"//& + "barotropic tide, use an internal tidal dissipation scheme to \n"//& + "drive diapycnal mixing, along the lines of St. Laurent \n"//& + "et al. (2002) and Simmons et al. (2004).", default=.false.) + + if ((CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09)) .or. & + (CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09))) then + call get_param(param_file, mdl, "NU_POLZIN", CS%Nu_Polzin, & + "When the Polzin decay profile is used, this is a \n"//& + "non-dimensional constant in the expression for the \n"//& + "vertical scale of decay for the tidal energy dissipation.", & + units="nondim", default=0.0697) + call get_param(param_file, mdl, "NBOTREF_POLZIN", CS%Nbotref_Polzin, & + "When the Polzin decay profile is used, this is the \n"//& + "Rreference value of the buoyancy frequency at the ocean \n"//& + "bottom in the Polzin formulation for the vertical \n"//& + "scale of decay for the tidal energy dissipation.", & + units="s-1", default=9.61e-4) + call get_param(param_file, mdl, "POLZIN_DECAY_SCALE_FACTOR", & + CS%Polzin_decay_scale_factor, & + "When the Polzin decay profile is used, this is a \n"//& + "scale factor for the vertical scale of decay of the tidal \n"//& + "energy dissipation.", default=1.0, units="nondim") + call get_param(param_file, mdl, "POLZIN_SCALE_MAX_FACTOR", & + CS%Polzin_decay_scale_max_factor, & + "When the Polzin decay profile is used, this is a factor \n"//& + "to limit the vertical scale of decay of the tidal \n"//& + "energy dissipation to POLZIN_DECAY_SCALE_MAX_FACTOR \n"//& + "times the depth of the ocean.", units="nondim", default=1.0) + call get_param(param_file, mdl, "POLZIN_MIN_DECAY_SCALE", CS%Polzin_min_decay_scale, & + "When the Polzin decay profile is used, this is the \n"//& + "minimum vertical decay scale for the vertical profile\n"//& + "of internal tide dissipation with the Polzin (2009) formulation", & + units="m", default=0.0) + endif + + if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation) then + call get_param(param_file, mdl, "INT_TIDE_DECAY_SCALE", CS%Int_tide_decay_scale, & + "The decay scale away from the bottom for tidal TKE with \n"//& + "the new coding when INT_TIDE_DISSIPATION is used.", & + units="m", default=0.0) + call get_param(param_file, mdl, "MU_ITIDES", CS%Mu_itides, & + "A dimensionless turbulent mixing efficiency used with \n"//& + "INT_TIDE_DISSIPATION, often 0.2.", units="nondim", default=0.2) + call get_param(param_file, mdl, "GAMMA_ITIDES", CS%Gamma_itides, & + "The fraction of the internal tidal energy that is \n"//& + "dissipated locally with INT_TIDE_DISSIPATION. \n"//& + "THIS NAME COULD BE BETTER.", & + units="nondim", default=0.3333) + call get_param(param_file, mdl, "MIN_ZBOT_ITIDES", CS%min_zbot_itides, & + "Turn off internal tidal dissipation when the total \n"//& + "ocean depth is less than this value.", units="m", default=0.0) + + call safe_alloc_ptr(CS%Nb,isd,ied,jsd,jed) + call safe_alloc_ptr(CS%h2,isd,ied,jsd,jed) + call safe_alloc_ptr(CS%TKE_itidal,isd,ied,jsd,jed) + call safe_alloc_ptr(CS%mask_itidal,isd,ied,jsd,jed) ; CS%mask_itidal(:,:) = 1.0 + + call get_param(param_file, mdl, "KAPPA_ITIDES", CS%kappa_itides, & + "A topographic wavenumber used with INT_TIDE_DISSIPATION. \n"//& + "The default is 2pi/10 km, as in St.Laurent et al. 2002.", & + units="m-1", default=8.e-4*atan(1.0)) + + call get_param(param_file, mdl, "UTIDE", CS%utide, & + "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & + units="m s-1", default=0.0) + call safe_alloc_ptr(CS%tideamp,is,ie,js,je) ; CS%tideamp(:,:) = CS%utide + + call get_param(param_file, mdl, "KAPPA_H2_FACTOR", CS%kappa_h2_factor, & + "A scaling factor for the roughness amplitude with n"//& + "INT_TIDE_DISSIPATION.", units="nondim", default=1.0) + call get_param(param_file, mdl, "TKE_ITIDE_MAX", CS%TKE_itide_max, & + "The maximum internal tide energy source availble to mix \n"//& + "above the bottom boundary layer with INT_TIDE_DISSIPATION.", & + units="W m-2", default=1.0e3) + + call get_param(param_file, mdl, "READ_TIDEAMP", read_tideamp, & + "If true, read a file (given by TIDEAMP_FILE) containing \n"//& + "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) + if (read_tideamp) then + call get_param(param_file, mdl, "TIDEAMP_FILE", tideamp_file, & + "The path to the file containing the spatially varying \n"//& + "tidal amplitudes with INT_TIDE_DISSIPATION.", default="tideamp.nc") + filename = trim(CS%inputdir) // trim(tideamp_file) + call log_param(param_file, mdl, "INPUTDIR/TIDEAMP_FILE", filename) + call MOM_read_data(filename, 'tideamp', CS%tideamp, G%domain, timelevel=1) + endif + + call get_param(param_file, mdl, "H2_FILE", h2_file, & + "The path to the file containing the sub-grid-scale \n"//& + "topographic roughness amplitude with INT_TIDE_DISSIPATION.", & + fail_if_missing=.true.) + filename = trim(CS%inputdir) // trim(h2_file) + call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) + call MOM_read_data(filename, 'h2', CS%h2, G%domain, timelevel=1) + + do j=js,je ; do i=is,ie + if (G%bathyT(i,j) < CS%min_zbot_itides) CS%mask_itidal(i,j) = 0.0 + CS%tideamp(i,j) = CS%tideamp(i,j) * CS%mask_itidal(i,j) * G%mask2dT(i,j) + + ! Restrict rms topo to 10 percent of column depth. + zbot = G%bathyT(i,j) + hamp = sqrt(CS%h2(i,j)) + hamp = min(0.1*zbot,hamp) + CS%h2(i,j) = hamp*hamp + + utide = CS%tideamp(i,j) + ! Compute the fixed part of internal tidal forcing; units are [kg s-2] here. + CS%TKE_itidal(i,j) = 0.5*CS%kappa_h2_factor*GV%Rho0*& + CS%kappa_itides*CS%h2(i,j)*utide*utide + enddo; enddo + + endif + + if (CS%Lee_wave_dissipation) then + + call get_param(param_file, mdl, "NIKURASHIN_TKE_INPUT_FILE",Niku_TKE_input_file, & + "The path to the file containing the TKE input from lee \n"//& + "wave driven mixing. Used with LEE_WAVE_DISSIPATION.", & + fail_if_missing=.true.) + call get_param(param_file, mdl, "NIKURASHIN_SCALE",Niku_scale, & + "A non-dimensional factor by which to scale the lee-wave \n"//& + "driven TKE input. Used with LEE_WAVE_DISSIPATION.", & + units="nondim", default=1.0) + + filename = trim(CS%inputdir) // trim(Niku_TKE_input_file) + call log_param(param_file, mdl, "INPUTDIR/NIKURASHIN_TKE_INPUT_FILE", & + filename) + call safe_alloc_ptr(CS%TKE_Niku,is,ie,js,je); CS%TKE_Niku(:,:) = 0.0 + call MOM_read_data(filename, 'TKE_input', CS%TKE_Niku, G%domain, timelevel=1 ) ! ??? timelevel -aja + CS%TKE_Niku(:,:) = Niku_scale * CS%TKE_Niku(:,:) + + call get_param(param_file, mdl, "GAMMA_NIKURASHIN",CS%Gamma_lee, & + "The fraction of the lee wave energy that is dissipated \n"//& + "locally with LEE_WAVE_DISSIPATION.", units="nondim", & + default=0.3333) + call get_param(param_file, mdl, "DECAY_SCALE_FACTOR_LEE",CS%Decay_scale_factor_lee, & + "Scaling for the vertical decay scaleof the local \n"//& + "dissipation of lee waves dissipation.", units="nondim", & + default=1.0) + + CS%id_TKE_leewave = register_diag_field('ocean_model','TKE_leewave',diag%axesT1,Time, & + 'Lee wave Driven Turbulent Kinetic Energy', 'W m-2') + CS%id_Kd_Niku = register_diag_field('ocean_model','Kd_Nikurashin',diag%axesTi,Time, & + 'Lee Wave Driven Diffusivity', 'm2 s-1') + else + CS%Decay_scale_factor_lee = -9.e99 ! This should never be used if CS%Lee_wave_dissipation = False + endif + + + if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. & + CS%Lowmode_itidal_dissipation) then + + CS%id_TKE_itidal = register_diag_field('ocean_model','TKE_itidal',diag%axesT1,Time, & + 'Internal Tide Driven Turbulent Kinetic Energy', 'W m-2') + CS%id_maxTKE = register_diag_field('ocean_model','maxTKE',diag%axesTL,Time, & + 'Maximum layer TKE', 'm3 s-3') + CS%id_TKE_to_Kd = register_diag_field('ocean_model','TKE_to_Kd',diag%axesTL,Time, & + 'Convert TKE to Kd', 's2 m') + + CS%id_Nb = register_diag_field('ocean_model','Nb',diag%axesT1,Time, & + 'Bottom Buoyancy Frequency', 's-1') + + CS%id_Kd_itidal = register_diag_field('ocean_model','Kd_itides',diag%axesTi,Time, & + 'Internal Tide Driven Diffusivity', 'm2 s-1') + + CS%id_Kd_lowmode = register_diag_field('ocean_model','Kd_lowmode',diag%axesTi,Time, & + 'Internal Tide Driven Diffusivity (from propagating low modes)', 'm2 s-1') + + CS%id_Fl_itidal = register_diag_field('ocean_model','Fl_itides',diag%axesTi,Time, & + 'Vertical flux of tidal turbulent dissipation', 'm3 s-3') + + CS%id_Fl_lowmode = register_diag_field('ocean_model','Fl_lowmode',diag%axesTi,Time, & + 'Vertical flux of tidal turbulent dissipation (from propagating low modes)', 'm3 s-3') + + CS%id_Polzin_decay_scale = register_diag_field('ocean_model','Polzin_decay_scale',diag%axesT1,Time, & + 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', 'm') + + CS%id_Polzin_decay_scale_scaled = register_diag_field('ocean_model','Polzin_decay_scale_scaled',diag%axesT1,Time, & + 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme, scaled by N2_bot/N2_meanz', 'm') + + CS%id_N2_bot = register_diag_field('ocean_model','N2_b',diag%axesT1,Time, & + 'Bottom Buoyancy frequency squared', 's-2') + + CS%id_N2_meanz = register_diag_field('ocean_model','N2_meanz',diag%axesT1,Time, & + 'Buoyancy frequency squared averaged over the water column', 's-2') + + CS%id_Kd_Work = register_diag_field('ocean_model','Kd_Work',diag%axesTL,Time, & + 'Work done by Diapycnal Mixing', 'W m-2') + + CS%id_Kd_Itidal_Work = register_diag_field('ocean_model','Kd_Itidal_Work',diag%axesTL,Time, & + 'Work done by Internal Tide Diapycnal Mixing', 'W m-2') + + CS%id_Kd_Niku_Work = register_diag_field('ocean_model','Kd_Nikurashin_Work',diag%axesTL,Time, & + 'Work done by Nikurashin Lee Wave Drag Scheme', 'W m-2') + + CS%id_Kd_Lowmode_Work = register_diag_field('ocean_model','Kd_Lowmode_Work',diag%axesTL,Time, & + 'Work done by Internal Tide Diapycnal Mixing (low modes)', 'W m-2') + + CS%id_N2 = register_diag_field('ocean_model','N2',diag%axesTi,Time, & + 'Buoyancy frequency squared', 's-2', cmor_field_name='obvfsq', & + cmor_long_name='Square of seawater buoyancy frequency',& + cmor_standard_name='square_of_brunt_vaisala_frequency_in_sea_water') + + if (CS%user_change_diff) & + CS%id_Kd_user = register_diag_field('ocean_model','Kd_user',diag%axesTi,Time, & + 'User-specified Extra Diffusivity', 'm2 s-1') + + if (associated(diag_to_Z_CSp)) then + vd = var_desc("N2", "s-2",& + "Buoyancy frequency, interpolated to z", z_grid='z') + CS%id_N2_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + vd = var_desc("Kd_itides","m2 s-1", & + "Internal Tide Driven Diffusivity, interpolated to z", z_grid='z') + CS%id_Kd_itidal_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + if (CS%Lee_wave_dissipation) then + vd = var_desc("Kd_Nikurashin", "m2 s-1", & + "Lee Wave Driven Diffusivity, interpolated to z", z_grid='z') + CS%id_Kd_Niku_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + endif + if (CS%Lowmode_itidal_dissipation) then + vd = var_desc("Kd_lowmode","m2 s-1", & + "Internal Tide Driven Diffusivity (from low modes), interpolated to z",& + z_grid='z') + CS%id_Kd_lowmode_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + endif + if (CS%user_change_diff) & + CS%id_Kd_user_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + endif + endif + + + + + + + !call get_param(param_file, mdl, "USE_CVMIX_TIDAL", tidal_mixing_init, & + ! "If true, turns on tidal mixing scheme via CVMix", & + ! default=.false.) + !!call openParameterBlock(param_file,'CVMIX_TIDAL') + !call get_param(param_file, mdl, "LOCAL_MIXING_FRAC", CS%local_mixing_frac, & + ! "Fraction of wave energy dissipated locally.", & + ! units="nondim", default=0.33) + !call get_param(param_file, mdl, "MIXING_EFFICIENCY", CS%mixing_efficiency, & + ! "Gamma in Simmons, 2004", & + ! units="nondim", default=0.20) + !!TODO: make sure GAMMA_ITIDES (same as LOCAL_MIXING_FRAC + !call get_param(param_file, mdl, "VERTICAL_DECAY_SCALE", CS%vert_decay_scale, & + ! "zeta in Simmons, 2004. Used to compute the vertical deposition function", & + ! units="m", default=500.0) + !!TODO: make sure int_tide_decay scale (same as VERTICAL_DECAY_SCALE is removed from code). + !call get_param(param_file, mdl, "TIDAL_MAX_COEF", CS%tidal_max_coef, & + ! "largest acceptable value for tidal diffusivity", & + ! units="m^2/s", default=100e-4) ! the default is 50e-4 in CVMIX, 100e-4 in POP. + !!call closeParameterBlock(param_file) + + + !if (CS%debug) print *, __FILE__, __LINE__, tidal_mixing_init - call get_param(param_file, mdl, "USE_CVMIX_TIDAL", tidal_mixing_init, & - "If true, turns on tidal mixing scheme via CVMix", & - default=.false.) - !call openParameterBlock(param_file,'CVMIX_TIDAL') - call get_param(param_file, mdl, "LOCAL_MIXING_FRAC", CS%local_mixing_frac, & - "Fraction of wave energy dissipated locally.", & - units="nondim", default=0.33) - call get_param(param_file, mdl, "MIXING_EFFICIENCY", CS%mixing_efficiency, & - "Gamma in Simmons, 2004", & - units="nondim", default=0.20) - !TODO: make sure GAMMA_ITIDES (same as LOCAL_MIXING_FRAC - call get_param(param_file, mdl, "VERTICAL_DECAY_SCALE", CS%vert_decay_scale, & - "zeta in Simmons, 2004. Used to compute the vertical deposition function", & - units="m", default=500.0) - !TODO: make sure int_tide_decay scale (same as VERTICAL_DECAY_SCALE is removed from code). - call get_param(param_file, mdl, "TIDAL_MAX_COEF", CS%tidal_max_coef, & - "largest acceptable value for tidal diffusivity", & - units="m^2/s", default=100e-4) ! the default is 50e-4 in CVMIX, 100e-4 in POP. - !call closeParameterBlock(param_file) - - - if (CS%debug) print *, __FILE__, __LINE__, tidal_mixing_init - - ! Set up CVMix - call cvmix_init_tidal(mix_scheme = 'Simmons', & - efficiency = cs%mixing_efficiency, & - vertical_decay_scale = cs%vert_decay_scale, & - max_coefficient = cs%tidal_max_coef, & - local_mixing_frac = cs%local_mixing_frac, & - depth_cutoff = 0.0) - - ! TODO: read in energy + !! Set up CVMix + !call cvmix_init_tidal(mix_scheme = 'Simmons', & + ! efficiency = cs%mixing_efficiency, & + ! vertical_decay_scale = cs%vert_decay_scale, & + ! max_coefficient = cs%tidal_max_coef, & + ! local_mixing_frac = cs%local_mixing_frac, & + ! depth_cutoff = 0.0) + ! + !! TODO: read in energy From c34ab63b37b3c006fb3f922357902e3758e230ff Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Mon, 19 Mar 2018 09:23:41 -0600 Subject: [PATCH 0026/1072] Move diags back from MOM_tidal_mixing to MOM_set_diffusivity (for now) --- .../vertical/MOM_diabatic_driver.F90 | 2 +- .../vertical/MOM_set_diffusivity.F90 | 131 +++++++++++++++-- .../vertical/MOM_tidal_mixing.F90 | 133 +++--------------- 3 files changed, 135 insertions(+), 131 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index fe1fe5deaa..75499c96f0 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -2354,7 +2354,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, endif ! initialize module for setting diffusivities - call set_diffusivity_init(Time, G, GV, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, CS%int_tide_CSp) + call set_diffusivity_init(Time, G, GV, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, CS%int_tide_CSp, CS%tidal_mixing_CSp) ! set up the clocks for this module diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index d38b446770..385653faea 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -38,11 +38,11 @@ module MOM_set_diffusivity use MOM_forcing_type, only : forcing, optics_type use MOM_grid, only : ocean_grid_type use MOM_internal_tides, only : int_tide_CS, get_lowmode_loss +use MOM_tidal_mixing, only : tidal_mixing_CS use MOM_intrinsic_functions, only : invcosh use MOM_io, only : slasher, vardesc, var_desc, MOM_read_data use MOM_kappa_shear, only : calculate_kappa_shear, kappa_shear_init, Kappa_shear_CS use MOM_cvmix_shear, only : calculate_cvmix_shear, cvmix_shear_init, cvmix_shear_CS -use MOM_string_functions, only : uppercase use MOM_thickness_diffuse, only : vert_fill_TS use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d use MOM_verticalGrid, only : verticalGrid_type @@ -215,7 +215,10 @@ module MOM_set_diffusivity type(Kappa_shear_CS), pointer :: kappaShear_CSp => NULL() type(CVMix_shear_CS), pointer :: CVMix_Shear_CSp => NULL() type(int_tide_CS), pointer :: int_tide_CSp => NULL() + type(tidal_mixing_cs), pointer :: tm_csp => NULL() + integer :: id_TKE_itidal = -1 + integer :: id_TKE_leewave = -1 integer :: id_maxTKE = -1 integer :: id_TKE_to_Kd = -1 @@ -392,6 +395,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & real :: kappa_fill ! diffusivity used to fill massless layers real :: dt_fill ! timestep used to fill massless layers + type(tidal_mixing_cs), pointer :: tm_csp + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed showCallTree = callTree_showQuery() @@ -407,6 +412,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & Omega2 = CS%Omega*CS%Omega I_2Omega = 0.5/CS%Omega epsilon = 1.e-10 + tm_csp => CS%tm_csp use_EOS = associated(tv%eqn_of_state) @@ -686,12 +692,12 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int) ! Add the Nikurashin and / or tidal bottom-driven mixing - if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) & + if (tm_csp%Int_tide_dissipation .or. tm_csp%Lee_wave_dissipation .or. tm_csp%Lowmode_itidal_dissipation) & call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, maxTKE, G, GV, CS, & dd, N2_lay, Kd, Kd_int) - ! This adds the diffusion sustained by the energy extracted from the flow - ! by the bottom drag. + This adds the diffusion sustained by the energy extracted from the flow + by the bottom drag. if (CS%bottomdraglaw .and. (CS%BBL_effic>0.0)) then if (CS%use_LOTW_BBL_diffusivity) then call add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, G, GV, CS, & @@ -777,10 +783,10 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%id_Kd_layer > 0) call post_data(CS%id_Kd_layer, Kd, CS%diag) num_z_diags = 0 - if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then + if (tm_csp%Int_tide_dissipation .or. tm_csp%Lee_wave_dissipation .or. tm_csp%Lowmode_itidal_dissipation) then if (CS%id_TKE_itidal > 0) call post_data(CS%id_TKE_itidal, dd%TKE_itidal_used, CS%diag) - if (CS%id_TKE_leewave > 0) call post_data(CS%id_TKE_leewave, CS%TKE_Niku, CS%diag) - if (CS%id_Nb > 0) call post_data(CS%id_Nb, CS%Nb, CS%diag) + if (CS%id_TKE_leewave > 0) call post_data(CS%id_TKE_leewave, tm_csp%TKE_Niku, CS%diag) + if (CS%id_Nb > 0) call post_data(CS%id_Nb, tm_csp%Nb, CS%diag) if (CS%id_N2 > 0) call post_data(CS%id_N2, dd%N2_3d, CS%diag) if (CS%id_N2_bot > 0) call post_data(CS%id_N2_bot, dd%N2_bot, CS%diag) if (CS%id_N2_meanz > 0) call post_data(CS%id_N2_meanz,dd%N2_meanz,CS%diag) @@ -1114,10 +1120,12 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & logical :: do_i(SZI_(G)), do_any integer :: i, k, is, ie, nz + type(tidal_mixing_cs), pointer :: tm_csp is = G%isc ; ie = G%iec ; nz = G%ke G_Rho0 = GV%g_Earth / GV%Rho0 H_neglect = GV%H_subroundoff + tm_csp => CS%tm_csp ! Find the (limited) density jump across each interface. do i=is,ie @@ -1168,8 +1176,8 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz) do_i(i) = (G%mask2dT(i,j) > 0.5) - if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation) then - h_amp(i) = sqrt(CS%h2(i,j)) ! for computing Nb + if (tm_csp%Int_tide_dissipation .or. tm_csp%Lee_wave_dissipation) then + h_amp(i) = sqrt(tm_csp%h2(i,j)) ! for computing Nb else h_amp(i) = 0.0 endif @@ -2473,7 +2481,8 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) end subroutine set_density_ratios -subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp, int_tide_CSp) +subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp, int_tide_CSp, & + tm_CSp) type(time_type), intent(in) :: Time type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -2486,6 +2495,8 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp !! structure. type(int_tide_CS), pointer :: int_tide_CSp !< pointer to the internal tides control !! structure (BDM) + type(tidal_mixing_cs), pointer :: tm_csp !< pointer to tidal mixing control + !! structure ! Arguments: ! (in) Time - current model time @@ -2503,9 +2514,10 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_set_diffusivity" ! This module's name. - character(len=200) :: filename, tideamp_file, h2_file, Niku_TKE_input_file - real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data real :: omega_frac_dflt + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed + if (associated(CS)) then call MOM_error(WARNING, "diabatic_entrain_init called with an associated "// & "control structure.") @@ -2513,8 +2525,12 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp endif allocate(CS) + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + CS%diag => diag if (associated(int_tide_CSp)) CS%int_tide_CSp => int_tide_CSp + if (associated(tm_csp)) CS%tm_csp => tm_csp if (associated(diag_to_Z_CSp)) CS%diag_to_Z_CSp => diag_to_Z_CSp ! These default values always need to be set. @@ -2783,9 +2799,98 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp if (CS%FluxRi_max > 0.0) & CS%dissip_N2 = CS%dissip_Kd_min * GV%Rho0 / CS%FluxRi_max + if (tm_csp%Lee_wave_dissipation) then + CS%id_TKE_leewave = register_diag_field('ocean_model','TKE_leewave',diag%axesT1,Time, & + 'Lee wave Driven Turbulent Kinetic Energy', 'W m-2') + CS%id_Kd_Niku = register_diag_field('ocean_model','Kd_Nikurashin',diag%axesTi,Time, & + 'Lee Wave Driven Diffusivity', 'm2 s-1') + endif + CS%id_Kd_layer = register_diag_field('ocean_model', 'Kd_layer', diag%axesTL, Time, & 'Diapycnal diffusivity of layers (as set)', 'm2 s-1') + + if (tm_csp%Int_tide_dissipation .or. tm_csp%Lee_wave_dissipation .or. & + tm_csp%Lowmode_itidal_dissipation) then + + CS%id_TKE_itidal = register_diag_field('ocean_model','TKE_itidal',diag%axesT1,Time, & + 'Internal Tide Driven Turbulent Kinetic Energy', 'W m-2') + CS%id_maxTKE = register_diag_field('ocean_model','maxTKE',diag%axesTL,Time, & + 'Maximum layer TKE', 'm3 s-3') + CS%id_TKE_to_Kd = register_diag_field('ocean_model','TKE_to_Kd',diag%axesTL,Time, & + 'Convert TKE to Kd', 's2 m') + + CS%id_Nb = register_diag_field('ocean_model','Nb',diag%axesT1,Time, & + 'Bottom Buoyancy Frequency', 's-1') + + CS%id_Kd_itidal = register_diag_field('ocean_model','Kd_itides',diag%axesTi,Time, & + 'Internal Tide Driven Diffusivity', 'm2 s-1') + + CS%id_Kd_lowmode = register_diag_field('ocean_model','Kd_lowmode',diag%axesTi,Time, & + 'Internal Tide Driven Diffusivity (from propagating low modes)', 'm2 s-1') + + CS%id_Fl_itidal = register_diag_field('ocean_model','Fl_itides',diag%axesTi,Time, & + 'Vertical flux of tidal turbulent dissipation', 'm3 s-3') + + CS%id_Fl_lowmode = register_diag_field('ocean_model','Fl_lowmode',diag%axesTi,Time, & + 'Vertical flux of tidal turbulent dissipation (from propagating low modes)', 'm3 s-3') + + CS%id_Polzin_decay_scale = register_diag_field('ocean_model','Polzin_decay_scale',diag%axesT1,Time, & + 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', 'm') + + CS%id_Polzin_decay_scale_scaled = register_diag_field('ocean_model','Polzin_decay_scale_scaled',diag%axesT1,Time, & + 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme, scaled by N2_bot/N2_meanz', 'm') + + CS%id_N2_bot = register_diag_field('ocean_model','N2_b',diag%axesT1,Time, & + 'Bottom Buoyancy frequency squared', 's-2') + + CS%id_N2_meanz = register_diag_field('ocean_model','N2_meanz',diag%axesT1,Time, & + 'Buoyancy frequency squared averaged over the water column', 's-2') + + CS%id_Kd_Work = register_diag_field('ocean_model','Kd_Work',diag%axesTL,Time, & + 'Work done by Diapycnal Mixing', 'W m-2') + + CS%id_Kd_Itidal_Work = register_diag_field('ocean_model','Kd_Itidal_Work',diag%axesTL,Time, & + 'Work done by Internal Tide Diapycnal Mixing', 'W m-2') + + CS%id_Kd_Niku_Work = register_diag_field('ocean_model','Kd_Nikurashin_Work',diag%axesTL,Time, & + 'Work done by Nikurashin Lee Wave Drag Scheme', 'W m-2') + + CS%id_Kd_Lowmode_Work = register_diag_field('ocean_model','Kd_Lowmode_Work',diag%axesTL,Time, & + 'Work done by Internal Tide Diapycnal Mixing (low modes)', 'W m-2') + + CS%id_N2 = register_diag_field('ocean_model','N2',diag%axesTi,Time, & + 'Buoyancy frequency squared', 's-2', cmor_field_name='obvfsq', & + cmor_long_name='Square of seawater buoyancy frequency',& + cmor_standard_name='square_of_brunt_vaisala_frequency_in_sea_water') + + if (CS%user_change_diff) & + CS%id_Kd_user = register_diag_field('ocean_model','Kd_user',diag%axesTi,Time, & + 'User-specified Extra Diffusivity', 'm2 s-1') + + if (associated(diag_to_Z_CSp)) then + vd = var_desc("N2", "s-2",& + "Buoyancy frequency, interpolated to z", z_grid='z') + CS%id_N2_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + vd = var_desc("Kd_itides","m2 s-1", & + "Internal Tide Driven Diffusivity, interpolated to z", z_grid='z') + CS%id_Kd_itidal_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + if (tm_csp%Lee_wave_dissipation) then + vd = var_desc("Kd_Nikurashin", "m2 s-1", & + "Lee Wave Driven Diffusivity, interpolated to z", z_grid='z') + CS%id_Kd_Niku_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + endif + if (tm_csp%Lowmode_itidal_dissipation) then + vd = var_desc("Kd_lowmode","m2 s-1", & + "Internal Tide Driven Diffusivity (from low modes), interpolated to z",& + z_grid='z') + CS%id_Kd_lowmode_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + endif + if (CS%user_change_diff) & + CS%id_Kd_user_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + endif + endif + call get_param(param_file, mdl, "DOUBLE_DIFFUSION", CS%double_diffusion, & "If true, increase diffusivitives for temperature or salt \n"//& "based on double-diffusive paramaterization from MOM4/KPP.", & @@ -2823,7 +2928,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp endif endif - if (CS%Int_tide_dissipation .and. CS%Bryan_Lewis_diffusivity) & + if (tm_csp%Int_tide_dissipation .and. CS%Bryan_Lewis_diffusivity) & call MOM_error(FATAL,"MOM_Set_Diffusivity: "// & "Bryan-Lewis and internal tidal dissipation are both enabled. Choose one.") if (CS%Henyey_IGW_background .and. CS%Kd_tanh_lat_fn) call MOM_error(FATAL, & diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index a33e15fe6b..4bd9d52956 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -3,17 +3,19 @@ module MOM_tidal_mixing ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field -use MOM_diag_mediator, only : safe_alloc_ptr, post_data -use MOM_EOS, only : calculate_density -use MOM_variables, only : thermo_var_ptrs -use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE -use MOM_debugging, only : hchksum -use MOM_grid, only : ocean_grid_type -use MOM_verticalGrid, only : verticalGrid_type -use MOM_file_parser, only : openParameterBlock, closeParameterBlock -use MOM_file_parser, only : get_param, log_version, param_file_type -use cvmix_tidal, only : cvmix_init_tidal +use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field +use MOM_diag_mediator, only : safe_alloc_ptr, post_data +use MOM_EOS, only : calculate_density +use MOM_variables, only : thermo_var_ptrs +use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE +use MOM_debugging, only : hchksum +use MOM_grid, only : ocean_grid_type +use MOM_verticalGrid, only : verticalGrid_type +use MOM_file_parser, only : openParameterBlock, closeParameterBlock +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_string_functions, only : uppercase +use MOM_io, only : slasher, MOM_read_data +use cvmix_tidal, only : cvmix_init_tidal implicit none ; private @@ -76,6 +78,7 @@ module MOM_tidal_mixing ! tidal amplitude file is not present real :: kappa_itides ! topographic wavenumber and non-dimensional scaling real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height + character(len=200) :: inputdir !real :: local_mixing_frac !< fraction of wave energy dissipated locally. @@ -91,10 +94,6 @@ module MOM_tidal_mixing real, pointer, dimension(:,:) :: h2 => NULL() real, pointer, dimension(:,:) :: tideamp => NULL() ! RMS tidal amplitude (m/s) - - integer :: id_TKE_itidal = -1 - integer :: id_TKE_leewave = -1 - end type tidal_mixing_cs character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name. @@ -103,7 +102,6 @@ module MOM_tidal_mixing integer, parameter :: STLAURENT_02 = 1 integer, parameter :: POLZIN_09 = 2 - contains logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) @@ -117,7 +115,6 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) ! Local variables logical :: read_tideamp - character(len=40) :: mdl = "MOM_set_diffusivity" ! This module's name. character(len=20) :: tmpstr character(len=200) :: filename, tideamp_file, h2_file, Niku_TKE_input_file real :: utide, zbot, hamp @@ -125,7 +122,6 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed - ! This include declares and sets the variable "version". #include "version_variable.h" @@ -144,14 +140,12 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) ! Read parameters call log_version(param_file, mdl, version, & "Vertical Tidal Mixing Parameterization") + call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, default=".",do_not_log=.true.) + CS%inputdir = slasher(CS%inputdir) call get_param(param_file, mdl, "INT_TIDE_DISSIPATION", CS%int_tide_dissipation, & "If true, use an internal tidal dissipation scheme to \n"//& "drive diapycnal mixing, along the lines of St. Laurent \n"//& "et al. (2002) and Simmons et al. (2004).", default=.false.) - - tidal_mixing_init = CS%int_tide_dissipation - if (.not. tidal_mixing_init) return - if (CS%int_tide_dissipation) then call get_param(param_file, mdl, "INT_TIDE_PROFILE", tmpstr, & "INT_TIDE_PROFILE selects the vertical profile of energy \n"//& @@ -337,102 +331,9 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) "Scaling for the vertical decay scaleof the local \n"//& "dissipation of lee waves dissipation.", units="nondim", & default=1.0) - - CS%id_TKE_leewave = register_diag_field('ocean_model','TKE_leewave',diag%axesT1,Time, & - 'Lee wave Driven Turbulent Kinetic Energy', 'W m-2') - CS%id_Kd_Niku = register_diag_field('ocean_model','Kd_Nikurashin',diag%axesTi,Time, & - 'Lee Wave Driven Diffusivity', 'm2 s-1') else CS%Decay_scale_factor_lee = -9.e99 ! This should never be used if CS%Lee_wave_dissipation = False endif - - - if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. & - CS%Lowmode_itidal_dissipation) then - - CS%id_TKE_itidal = register_diag_field('ocean_model','TKE_itidal',diag%axesT1,Time, & - 'Internal Tide Driven Turbulent Kinetic Energy', 'W m-2') - CS%id_maxTKE = register_diag_field('ocean_model','maxTKE',diag%axesTL,Time, & - 'Maximum layer TKE', 'm3 s-3') - CS%id_TKE_to_Kd = register_diag_field('ocean_model','TKE_to_Kd',diag%axesTL,Time, & - 'Convert TKE to Kd', 's2 m') - - CS%id_Nb = register_diag_field('ocean_model','Nb',diag%axesT1,Time, & - 'Bottom Buoyancy Frequency', 's-1') - - CS%id_Kd_itidal = register_diag_field('ocean_model','Kd_itides',diag%axesTi,Time, & - 'Internal Tide Driven Diffusivity', 'm2 s-1') - - CS%id_Kd_lowmode = register_diag_field('ocean_model','Kd_lowmode',diag%axesTi,Time, & - 'Internal Tide Driven Diffusivity (from propagating low modes)', 'm2 s-1') - - CS%id_Fl_itidal = register_diag_field('ocean_model','Fl_itides',diag%axesTi,Time, & - 'Vertical flux of tidal turbulent dissipation', 'm3 s-3') - - CS%id_Fl_lowmode = register_diag_field('ocean_model','Fl_lowmode',diag%axesTi,Time, & - 'Vertical flux of tidal turbulent dissipation (from propagating low modes)', 'm3 s-3') - - CS%id_Polzin_decay_scale = register_diag_field('ocean_model','Polzin_decay_scale',diag%axesT1,Time, & - 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', 'm') - - CS%id_Polzin_decay_scale_scaled = register_diag_field('ocean_model','Polzin_decay_scale_scaled',diag%axesT1,Time, & - 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme, scaled by N2_bot/N2_meanz', 'm') - - CS%id_N2_bot = register_diag_field('ocean_model','N2_b',diag%axesT1,Time, & - 'Bottom Buoyancy frequency squared', 's-2') - - CS%id_N2_meanz = register_diag_field('ocean_model','N2_meanz',diag%axesT1,Time, & - 'Buoyancy frequency squared averaged over the water column', 's-2') - - CS%id_Kd_Work = register_diag_field('ocean_model','Kd_Work',diag%axesTL,Time, & - 'Work done by Diapycnal Mixing', 'W m-2') - - CS%id_Kd_Itidal_Work = register_diag_field('ocean_model','Kd_Itidal_Work',diag%axesTL,Time, & - 'Work done by Internal Tide Diapycnal Mixing', 'W m-2') - - CS%id_Kd_Niku_Work = register_diag_field('ocean_model','Kd_Nikurashin_Work',diag%axesTL,Time, & - 'Work done by Nikurashin Lee Wave Drag Scheme', 'W m-2') - - CS%id_Kd_Lowmode_Work = register_diag_field('ocean_model','Kd_Lowmode_Work',diag%axesTL,Time, & - 'Work done by Internal Tide Diapycnal Mixing (low modes)', 'W m-2') - - CS%id_N2 = register_diag_field('ocean_model','N2',diag%axesTi,Time, & - 'Buoyancy frequency squared', 's-2', cmor_field_name='obvfsq', & - cmor_long_name='Square of seawater buoyancy frequency',& - cmor_standard_name='square_of_brunt_vaisala_frequency_in_sea_water') - - if (CS%user_change_diff) & - CS%id_Kd_user = register_diag_field('ocean_model','Kd_user',diag%axesTi,Time, & - 'User-specified Extra Diffusivity', 'm2 s-1') - - if (associated(diag_to_Z_CSp)) then - vd = var_desc("N2", "s-2",& - "Buoyancy frequency, interpolated to z", z_grid='z') - CS%id_N2_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - vd = var_desc("Kd_itides","m2 s-1", & - "Internal Tide Driven Diffusivity, interpolated to z", z_grid='z') - CS%id_Kd_itidal_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - if (CS%Lee_wave_dissipation) then - vd = var_desc("Kd_Nikurashin", "m2 s-1", & - "Lee Wave Driven Diffusivity, interpolated to z", z_grid='z') - CS%id_Kd_Niku_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - endif - if (CS%Lowmode_itidal_dissipation) then - vd = var_desc("Kd_lowmode","m2 s-1", & - "Internal Tide Driven Diffusivity (from low modes), interpolated to z",& - z_grid='z') - CS%id_Kd_lowmode_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - endif - if (CS%user_change_diff) & - CS%id_Kd_user_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - endif - endif - - - - - - !call get_param(param_file, mdl, "USE_CVMIX_TIDAL", tidal_mixing_init, & ! "If true, turns on tidal mixing scheme via CVMix", & ! default=.false.) @@ -466,8 +367,6 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) ! !! TODO: read in energy - - end function tidal_mixing_init From 22902decedb4e9f311b75c6b0656f7d41adf0839 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Mon, 19 Mar 2018 13:06:56 -0600 Subject: [PATCH 0027/1072] Mv add_int_tide_diffusivity to tidal_mixing module --- .../vertical/MOM_set_diffusivity.F90 | 515 ++---------------- .../vertical/MOM_tidal_mixing.F90 | 419 ++++++++++++++ 2 files changed, 474 insertions(+), 460 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 385653faea..245f4a55fe 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -38,7 +38,8 @@ module MOM_set_diffusivity use MOM_forcing_type, only : forcing, optics_type use MOM_grid, only : ocean_grid_type use MOM_internal_tides, only : int_tide_CS, get_lowmode_loss -use MOM_tidal_mixing, only : tidal_mixing_CS +use MOM_tidal_mixing, only : tidal_mixing_CS, add_int_tide_diffusivity +use MOM_tidal_mixing, only : tidal_mixing_diags use MOM_intrinsic_functions, only : invcosh use MOM_io, only : slasher, vardesc, var_desc, MOM_read_data use MOM_kappa_shear, only : calculate_kappa_shear, kappa_shear_init, Kappa_shear_CS @@ -259,19 +260,9 @@ module MOM_set_diffusivity type diffusivity_diags real, pointer, dimension(:,:,:) :: & N2_3d => NULL(),& ! squared buoyancy frequency at interfaces (1/s2) - Kd_itidal => NULL(),& ! internal tide diffusivity at interfaces (m2/s) - Fl_itidal => NULL(),& ! vertical flux of tidal turbulent dissipation (m3/s3) - Kd_lowmode => NULL(),& ! internal tide diffusivity at interfaces - ! due to propagating low modes (m2/s) (BDM) - Fl_lowmode => NULL(),& ! vertical flux of tidal turbulent dissipation - ! due to propagating low modes (m3/s3) (BDM) - Kd_Niku => NULL(),& ! lee-wave diffusivity at interfaces (m2/s) Kd_user => NULL(),& ! user-added diffusivity at interfaces (m2/s) Kd_BBL => NULL(),& ! BBL diffusivity at interfaces (m2/s) Kd_work => NULL(),& ! layer integrated work by diapycnal mixing (W/m2) - Kd_Niku_work => NULL(),& ! layer integrated work by lee-wave driven mixing (W/m2) - Kd_Itidal_Work => NULL(),& ! layer integrated work by int tide driven mixing (W/m2) - Kd_Lowmode_Work=> NULL(),& ! layer integrated work by low mode driven mixing (W/m2) BDM maxTKE => NULL(),& ! energy required to entrain to h_max (m3/s3) TKE_to_Kd => NULL(),& ! conversion rate (~1.0 / (G_Earth + dRho_lay)) ! between TKE dissipated within a layer and Kd @@ -279,13 +270,6 @@ module MOM_set_diffusivity KT_extra => NULL(),& ! double diffusion diffusivity for temp (m2/s) KS_extra => NULL() ! double diffusion diffusivity for saln (m2/s) - real, pointer, dimension(:,:) :: & - TKE_itidal_used => NULL(),& ! internal tide TKE input at ocean bottom (W/m2) - N2_bot => NULL(),& ! bottom squared buoyancy frequency (1/s2) - N2_meanz => NULL(),& ! vertically averaged buoyancy frequency (1/s2) - Polzin_decay_scale_scaled => NULL(),& ! vertical scale of decay for tidal dissipation - Polzin_decay_scale => NULL() ! vertical decay scale for tidal diss with Polzin (meter) - end type diffusivity_diags ! Clocks @@ -345,7 +329,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & real, dimension(SZI_(G), SZJ_(G)) :: & Kd_sfc ! surface value of the diffusivity (m2/s) - type(diffusivity_diags) :: dd ! structure w/ arrays of pointers to avail diags + type(diffusivity_diags) :: dd ! structure w/ arrays of pointers to avail diags + type(tidal_mixing_diags) :: tm_dd real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & T_f, S_f ! temperature and salinity (deg C and ppt); @@ -428,35 +413,35 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif if ((CS%id_Kd_itidal > 0) .or. (CS%id_Kd_itidal_z > 0) .or. & (CS%id_Kd_Itidal_work > 0)) then - allocate(dd%Kd_itidal(isd:ied,jsd:jed,nz+1)) ; dd%Kd_itidal(:,:,:) = 0.0 + allocate(tm_dd%Kd_itidal(isd:ied,jsd:jed,nz+1)) ; tm_dd%Kd_itidal(:,:,:) = 0.0 endif if ((CS%id_Kd_lowmode > 0) .or. (CS%id_Kd_lowmode_z > 0) .or. & (CS%id_Kd_lowmode_work > 0)) then - allocate(dd%Kd_lowmode(isd:ied,jsd:jed,nz+1)) ; dd%Kd_lowmode(:,:,:) = 0.0 + allocate(tm_dd%Kd_lowmode(isd:ied,jsd:jed,nz+1)) ; tm_dd%Kd_lowmode(:,:,:) = 0.0 endif if ( (CS%id_Fl_itidal > 0) ) then - allocate(dd%Fl_itidal(isd:ied,jsd:jed,nz+1)) ; dd%Fl_itidal(:,:,:) = 0.0 + allocate(tm_dd%Fl_itidal(isd:ied,jsd:jed,nz+1)) ; tm_dd%Fl_itidal(:,:,:) = 0.0 endif if ( (CS%id_Fl_lowmode > 0) ) then - allocate(dd%Fl_lowmode(isd:ied,jsd:jed,nz+1)) ; dd%Fl_lowmode(:,:,:) = 0.0 + allocate(tm_dd%Fl_lowmode(isd:ied,jsd:jed,nz+1)) ; tm_dd%Fl_lowmode(:,:,:) = 0.0 endif if ( (CS%id_Polzin_decay_scale > 0) ) then - allocate(dd%Polzin_decay_scale(isd:ied,jsd:jed)) - dd%Polzin_decay_scale(:,:) = 0.0 + allocate(tm_dd%Polzin_decay_scale(isd:ied,jsd:jed)) + tm_dd%Polzin_decay_scale(:,:) = 0.0 endif if ( (CS%id_Polzin_decay_scale_scaled > 0) ) then - allocate(dd%Polzin_decay_scale_scaled(isd:ied,jsd:jed)) - dd%Polzin_decay_scale_scaled(:,:) = 0.0 + allocate(tm_dd%Polzin_decay_scale_scaled(isd:ied,jsd:jed)) + tm_dd%Polzin_decay_scale_scaled(:,:) = 0.0 endif if ( (CS%id_N2_bot > 0) ) then - allocate(dd%N2_bot(isd:ied,jsd:jed)) ; dd%N2_bot(:,:) = 0.0 + allocate(tm_dd%N2_bot(isd:ied,jsd:jed)) ; tm_dd%N2_bot(:,:) = 0.0 endif if ( (CS%id_N2_meanz > 0) ) then - allocate(dd%N2_meanz(isd:ied,jsd:jed)) ; dd%N2_meanz(:,:) = 0.0 + allocate(tm_dd%N2_meanz(isd:ied,jsd:jed)) ; tm_dd%N2_meanz(:,:) = 0.0 endif if ((CS%id_Kd_Niku > 0) .or. (CS%id_Kd_Niku_z > 0) .or. & (CS%id_Kd_Niku_work > 0)) then - allocate(dd%Kd_Niku(isd:ied,jsd:jed,nz+1)) ; dd%Kd_Niku(:,:,:) = 0.0 + allocate(tm_dd%Kd_Niku(isd:ied,jsd:jed,nz+1)) ; tm_dd%Kd_Niku(:,:,:) = 0.0 endif if ((CS%id_Kd_user > 0) .or. (CS%id_Kd_user_z > 0)) then allocate(dd%Kd_user(isd:ied,jsd:jed,nz+1)) ; dd%Kd_user(:,:,:) = 0.0 @@ -465,18 +450,18 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & allocate(dd%Kd_work(isd:ied,jsd:jed,nz)) ; dd%Kd_work(:,:,:) = 0.0 endif if (CS%id_Kd_Niku_work > 0) then - allocate(dd%Kd_Niku_work(isd:ied,jsd:jed,nz)) ; dd%Kd_Niku_work(:,:,:) = 0.0 + allocate(tm_dd%Kd_Niku_work(isd:ied,jsd:jed,nz)) ; tm_dd%Kd_Niku_work(:,:,:) = 0.0 endif if (CS%id_Kd_Itidal_work > 0) then - allocate(dd%Kd_Itidal_work(isd:ied,jsd:jed,nz)) - dd%Kd_Itidal_work(:,:,:) = 0.0 + allocate(tm_dd%Kd_Itidal_work(isd:ied,jsd:jed,nz)) + tm_dd%Kd_Itidal_work(:,:,:) = 0.0 endif if (CS%id_Kd_Lowmode_Work > 0) then - allocate(dd%Kd_Lowmode_Work(isd:ied,jsd:jed,nz)) - dd%Kd_Lowmode_Work(:,:,:) = 0.0 + allocate(tm_dd%Kd_Lowmode_Work(isd:ied,jsd:jed,nz)) + tm_dd%Kd_Lowmode_Work(:,:,:) = 0.0 endif if (CS%id_TKE_itidal > 0) then - allocate(dd%TKE_Itidal_used(isd:ied,jsd:jed)) ; dd%TKE_Itidal_used(:,:) = 0. + allocate(tm_dd%TKE_Itidal_used(isd:ied,jsd:jed)) ; tm_dd%TKE_Itidal_used(:,:) = 0. endif if (CS%id_maxTKE > 0) then allocate(dd%maxTKE(isd:ied,jsd:jed,nz)) ; dd%maxTKE(:,:,:) = 0.0 @@ -693,11 +678,11 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! Add the Nikurashin and / or tidal bottom-driven mixing if (tm_csp%Int_tide_dissipation .or. tm_csp%Lee_wave_dissipation .or. tm_csp%Lowmode_itidal_dissipation) & - call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, maxTKE, G, GV, CS, & - dd, N2_lay, Kd, Kd_int) + call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, maxTKE, G, GV, CS%tm_csp, & + tm_dd, N2_lay, Kd, Kd_int, CS%Kd_max) - This adds the diffusion sustained by the energy extracted from the flow - by the bottom drag. + ! This adds the diffusion sustained by the energy extracted from the flow + ! by the bottom drag. if (CS%bottomdraglaw .and. (CS%BBL_effic>0.0)) then if (CS%use_LOTW_BBL_diffusivity) then call add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, G, GV, CS, & @@ -784,49 +769,49 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & num_z_diags = 0 if (tm_csp%Int_tide_dissipation .or. tm_csp%Lee_wave_dissipation .or. tm_csp%Lowmode_itidal_dissipation) then - if (CS%id_TKE_itidal > 0) call post_data(CS%id_TKE_itidal, dd%TKE_itidal_used, CS%diag) + if (CS%id_TKE_itidal > 0) call post_data(CS%id_TKE_itidal, tm_dd%TKE_itidal_used, CS%diag) if (CS%id_TKE_leewave > 0) call post_data(CS%id_TKE_leewave, tm_csp%TKE_Niku, CS%diag) if (CS%id_Nb > 0) call post_data(CS%id_Nb, tm_csp%Nb, CS%diag) if (CS%id_N2 > 0) call post_data(CS%id_N2, dd%N2_3d, CS%diag) - if (CS%id_N2_bot > 0) call post_data(CS%id_N2_bot, dd%N2_bot, CS%diag) - if (CS%id_N2_meanz > 0) call post_data(CS%id_N2_meanz,dd%N2_meanz,CS%diag) - - if (CS%id_Fl_itidal > 0) call post_data(CS%id_Fl_itidal, dd%Fl_itidal, CS%diag) - if (CS%id_Kd_itidal > 0) call post_data(CS%id_Kd_itidal, dd%Kd_itidal, CS%diag) - if (CS%id_Kd_Niku > 0) call post_data(CS%id_Kd_Niku, dd%Kd_Niku, CS%diag) - if (CS%id_Kd_lowmode> 0) call post_data(CS%id_Kd_lowmode, dd%Kd_lowmode, CS%diag) - if (CS%id_Fl_lowmode> 0) call post_data(CS%id_Fl_lowmode, dd%Fl_lowmode, CS%diag) + if (CS%id_N2_bot > 0) call post_data(CS%id_N2_bot, tm_dd%N2_bot, CS%diag) + if (CS%id_N2_meanz > 0) call post_data(CS%id_N2_meanz,tm_dd%N2_meanz,CS%diag) + + if (CS%id_Fl_itidal > 0) call post_data(CS%id_Fl_itidal, tm_dd%Fl_itidal, CS%diag) + if (CS%id_Kd_itidal > 0) call post_data(CS%id_Kd_itidal, tm_dd%Kd_itidal, CS%diag) + if (CS%id_Kd_Niku > 0) call post_data(CS%id_Kd_Niku, tm_dd%Kd_Niku, CS%diag) + if (CS%id_Kd_lowmode> 0) call post_data(CS%id_Kd_lowmode, tm_dd%Kd_lowmode, CS%diag) + if (CS%id_Fl_lowmode> 0) call post_data(CS%id_Fl_lowmode, tm_dd%Fl_lowmode, CS%diag) if (CS%id_Kd_user > 0) call post_data(CS%id_Kd_user, dd%Kd_user, CS%diag) if (CS%id_Kd_Work > 0) call post_data(CS%id_Kd_Work, dd%Kd_Work, CS%diag) if (CS%id_Kd_Itidal_Work > 0) & - call post_data(CS%id_Kd_Itidal_Work, dd%Kd_Itidal_Work, CS%diag) - if (CS%id_Kd_Niku_Work > 0) call post_data(CS%id_Kd_Niku_Work, dd%Kd_Niku_Work, CS%diag) + call post_data(CS%id_Kd_Itidal_Work, tm_dd%Kd_Itidal_Work, CS%diag) + if (CS%id_Kd_Niku_Work > 0) call post_data(CS%id_Kd_Niku_Work, tm_dd%Kd_Niku_Work, CS%diag) if (CS%id_Kd_Lowmode_Work > 0) & - call post_data(CS%id_Kd_Lowmode_Work, dd%Kd_Lowmode_Work, CS%diag) + call post_data(CS%id_Kd_Lowmode_Work, tm_dd%Kd_Lowmode_Work, CS%diag) if (CS%id_maxTKE > 0) call post_data(CS%id_maxTKE, dd%maxTKE, CS%diag) if (CS%id_TKE_to_Kd > 0) call post_data(CS%id_TKE_to_Kd, dd%TKE_to_Kd, CS%diag) if (CS%id_Polzin_decay_scale > 0 ) & - call post_data(CS%id_Polzin_decay_scale, dd%Polzin_decay_scale, CS%diag) + call post_data(CS%id_Polzin_decay_scale, tm_dd%Polzin_decay_scale, CS%diag) if (CS%id_Polzin_decay_scale_scaled > 0 ) & - call post_data(CS%id_Polzin_decay_scale_scaled, dd%Polzin_decay_scale_scaled, CS%diag) + call post_data(CS%id_Polzin_decay_scale_scaled, tm_dd%Polzin_decay_scale_scaled, CS%diag) if (CS%id_Kd_itidal_z > 0) then num_z_diags = num_z_diags + 1 z_ids(num_z_diags) = CS%id_Kd_itidal_z - z_ptrs(num_z_diags)%p => dd%Kd_itidal + z_ptrs(num_z_diags)%p => tm_dd%Kd_itidal endif if (CS%id_Kd_Niku_z > 0) then num_z_diags = num_z_diags + 1 z_ids(num_z_diags) = CS%id_Kd_Niku_z - z_ptrs(num_z_diags)%p => dd%Kd_Niku + z_ptrs(num_z_diags)%p => tm_dd%Kd_Niku endif if (CS%id_Kd_lowmode_z > 0) then num_z_diags = num_z_diags + 1 z_ids(num_z_diags) = CS%id_Kd_lowmode_z - z_ptrs(num_z_diags)%p => dd%Kd_lowmode + z_ptrs(num_z_diags)%p => tm_dd%Kd_lowmode endif if (CS%id_N2_z > 0) then @@ -869,21 +854,21 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call calc_Zint_diags(h, z_ptrs, z_ids, num_z_diags, G, GV, CS%diag_to_Z_CSp) if (associated(dd%N2_3d)) deallocate(dd%N2_3d) - if (associated(dd%Kd_itidal)) deallocate(dd%Kd_itidal) - if (associated(dd%Kd_lowmode)) deallocate(dd%Kd_lowmode) - if (associated(dd%Fl_itidal)) deallocate(dd%Fl_itidal) - if (associated(dd%Fl_lowmode)) deallocate(dd%Fl_lowmode) - if (associated(dd%Polzin_decay_scale)) deallocate(dd%Polzin_decay_scale) - if (associated(dd%Polzin_decay_scale_scaled)) deallocate(dd%Polzin_decay_scale_scaled) - if (associated(dd%N2_bot)) deallocate(dd%N2_bot) - if (associated(dd%N2_meanz)) deallocate(dd%N2_meanz) + if (associated(tm_dd%Kd_itidal)) deallocate(tm_dd%Kd_itidal) + if (associated(tm_dd%Kd_lowmode)) deallocate(tm_dd%Kd_lowmode) + if (associated(tm_dd%Fl_itidal)) deallocate(tm_dd%Fl_itidal) + if (associated(tm_dd%Fl_lowmode)) deallocate(tm_dd%Fl_lowmode) + if (associated(tm_dd%Polzin_decay_scale)) deallocate(tm_dd%Polzin_decay_scale) + if (associated(tm_dd%Polzin_decay_scale_scaled)) deallocate(tm_dd%Polzin_decay_scale_scaled) + if (associated(tm_dd%N2_bot)) deallocate(tm_dd%N2_bot) + if (associated(tm_dd%N2_meanz)) deallocate(tm_dd%N2_meanz) if (associated(dd%Kd_work)) deallocate(dd%Kd_work) if (associated(dd%Kd_user)) deallocate(dd%Kd_user) - if (associated(dd%Kd_Niku)) deallocate(dd%Kd_Niku) - if (associated(dd%Kd_Niku_work)) deallocate(dd%Kd_Niku_work) - if (associated(dd%Kd_Itidal_Work)) deallocate(dd%Kd_Itidal_Work) - if (associated(dd%Kd_Lowmode_Work)) deallocate(dd%Kd_Lowmode_Work) - if (associated(dd%TKE_itidal_used)) deallocate(dd%TKE_itidal_used) + if (associated(tm_dd%Kd_Niku)) deallocate(tm_dd%Kd_Niku) + if (associated(tm_dd%Kd_Niku_work)) deallocate(tm_dd%Kd_Niku_work) + if (associated(tm_dd%Kd_Itidal_Work)) deallocate(tm_dd%Kd_Itidal_Work) + if (associated(tm_dd%Kd_Lowmode_Work)) deallocate(tm_dd%Kd_Lowmode_Work) + if (associated(tm_dd%TKE_itidal_used)) deallocate(tm_dd%TKE_itidal_used) if (associated(dd%maxTKE)) deallocate(dd%maxTKE) if (associated(dd%TKE_to_Kd)) deallocate(dd%TKE_to_Kd) if (associated(dd%KT_extra)) deallocate(dd%KT_extra) @@ -1840,396 +1825,6 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int) end subroutine add_MLrad_diffusivity - !> This subroutine adds the effect of internal-tide-driven mixing to the layer diffusivities. - !! The mechanisms considered are (1) local dissipation of internal waves generated by the - !! barotropic flow ("itidal"), (2) local dissipation of internal waves generated by the propagating - !! low modes (rays) of the internal tide ("lowmode"), and (3) local dissipation of internal lee waves. - !! Will eventually need to add diffusivity due to other wave-breaking processes (e.g. Bottom friction, - !! Froude-number-depending breaking, PSI, etc.). -subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & - dd, N2_lay, Kd, Kd_int ) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZI_(G)), intent(in) :: N2_bot - real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay - integer, intent(in) :: j - real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd, max_TKE - type(set_diffusivity_CS), pointer :: CS - type(diffusivity_diags), intent(inout) :: dd - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int - - ! This subroutine adds the effect of internal-tide-driven mixing to the layer diffusivities. - ! The mechanisms considered are (1) local dissipation of internal waves generated by the - ! barotropic flow ("itidal"), (2) local dissipation of internal waves generated by the propagating - ! low modes (rays) of the internal tide ("lowmode"), and (3) local dissipation of internal lee waves. - ! Will eventually need to add diffusivity due to other wave-breaking processes (e.g. Bottom friction, - ! Froude-number-depending breaking, PSI, etc.). - - real, dimension(SZI_(G)) :: & - htot, & ! total thickness above or below a layer, or the - ! integrated thickness in the BBL (meter) - htot_WKB, & ! distance from top to bottom (meter) WKB scaled - TKE_itidal_bot, & ! internal tide TKE at ocean bottom (m3/s3) - TKE_Niku_bot, & ! lee-wave TKE at ocean bottom (m3/s3) - TKE_lowmode_bot, & ! internal tide TKE at ocean bottom lost from all remote low modes (m3/s3) (BDM) - Inv_int, & ! inverse of TKE decay for int tide over the depth of the ocean (nondim) - Inv_int_lee, & ! inverse of TKE decay for lee waves over the depth of the ocean (nondim) - Inv_int_low, & ! inverse of TKE decay for low modes over the depth of the ocean (nondim) (BDM) - z0_Polzin, & ! TKE decay scale in Polzin formulation (meter) - z0_Polzin_scaled, & ! TKE decay scale in Polzin formulation (meter) - ! multiplied by N2_bot/N2_meanz to be coherent with the WKB scaled z - ! z*=int(N2/N2_bot) * N2_bot/N2_meanz = int(N2/N2_meanz) - ! z0_Polzin_scaled = z0_Polzin * N2_bot/N2_meanz - N2_meanz, & ! vertically averaged squared buoyancy frequency (1/s2) for WKB scaling - TKE_itidal_rem, & ! remaining internal tide TKE (from barotropic source) - TKE_Niku_rem, & ! remaining lee-wave TKE - TKE_lowmode_rem, & ! remaining internal tide TKE (from propagating low mode source) (BDM) - TKE_frac_top, & ! fraction of bottom TKE that should appear at top of a layer (nondim) - TKE_frac_top_lee, & ! fraction of bottom TKE that should appear at top of a layer (nondim) - TKE_frac_top_lowmode, & - ! fraction of bottom TKE that should appear at top of a layer (nondim) (BDM) - z_from_bot, & ! distance from bottom (meter) - z_from_bot_WKB ! distance from bottom (meter), WKB scaled - - real :: I_rho0 ! 1 / RHO0, (m3/kg) - real :: Kd_add ! diffusivity to add in a layer (m2/sec) - real :: TKE_itide_lay ! internal tide TKE imparted to a layer (from barotropic) (m3/s3) - real :: TKE_Niku_lay ! lee-wave TKE imparted to a layer (m3/s3) - real :: TKE_lowmode_lay ! internal tide TKE imparted to a layer (from low mode) (m3/s3) (BDM) - real :: frac_used ! fraction of TKE that can be used in a layer (nondim) - real :: Izeta ! inverse of TKE decay scale (1/meter) - real :: Izeta_lee ! inverse of TKE decay scale for lee waves (1/meter) - real :: z0_psl ! temporary variable with units of meter - real :: TKE_lowmode_tot ! TKE from all low modes (W/m2) (BDM) - - - logical :: use_Polzin, use_Simmons - integer :: i, k, is, ie, nz - integer :: a, fr, m - is = G%isc ; ie = G%iec ; nz = G%ke - - if (.not.(CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation)) return - - do i=is,ie ; htot(i) = 0.0 ; Inv_int(i) = 0.0 ; Inv_int_lee(i) = 0.0 ; Inv_int_low(i) = 0.0 ;enddo - do k=1,nz ; do i=is,ie - htot(i) = htot(i) + GV%H_to_m*h(i,j,k) - enddo ; enddo - - I_Rho0 = 1.0/GV%Rho0 - - use_Polzin = ((CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09)) .or. & - (CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09)) .or. & - (CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == POLZIN_09))) - use_Simmons = ((CS%Int_tide_dissipation .and. (CS%int_tide_profile == STLAURENT_02)) .or. & - (CS%lee_wave_dissipation .and. (CS%lee_wave_profile == STLAURENT_02)) .or. & - (CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == STLAURENT_02))) - - ! Calculate parameters for vertical structure of dissipation - ! Simmons: - if ( use_Simmons ) then - Izeta = 1.0 / max(CS%Int_tide_decay_scale, GV%H_subroundoff*GV%H_to_m) - Izeta_lee = 1.0 / max(CS%Int_tide_decay_scale*CS%Decay_scale_factor_lee, & - GV%H_subroundoff*GV%H_to_m) - do i=is,ie - CS%Nb(i,j) = sqrt(N2_bot(i)) - if (associated(dd%N2_bot)) dd%N2_bot(i,j) = N2_bot(i) - if ( CS%Int_tide_dissipation ) then - if (Izeta*htot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule. - Inv_int(i) = 1.0 / (1.0 - exp(-Izeta*htot(i))) - endif - endif - if ( CS%Lee_wave_dissipation ) then - if (Izeta_lee*htot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule. - Inv_int_lee(i) = 1.0 / (1.0 - exp(-Izeta_lee*htot(i))) - endif - endif - if ( CS%Lowmode_itidal_dissipation) then - if (Izeta*htot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule. - Inv_int_low(i) = 1.0 / (1.0 - exp(-Izeta*htot(i))) - endif - endif - z_from_bot(i) = GV%H_to_m*h(i,j,nz) - enddo - endif ! Simmons - - ! Polzin: - if ( use_Polzin ) then - ! WKB scaling of the vertical coordinate - do i=is,ie ; N2_meanz(i)=0.0 ; enddo - do k=1,nz ; do i=is,ie - N2_meanz(i) = N2_meanz(i) + N2_lay(i,k)*GV%H_to_m*h(i,j,k) - enddo ; enddo - do i=is,ie - N2_meanz(i) = N2_meanz(i) / (htot(i) + GV%H_subroundoff*GV%H_to_m) - if (associated(dd%N2_meanz)) dd%N2_meanz(i,j) = N2_meanz(i) - enddo - - ! WKB scaled z*(z=H) z* at the surface using the modified Polzin WKB scaling - do i=is,ie ; htot_WKB(i) = htot(i) ; enddo -! do i=is,ie ; htot_WKB(i) = 0.0 ; enddo -! do k=1,nz ; do i=is,ie -! htot_WKB(i) = htot_WKB(i) + GV%H_to_m*h(i,j,k)*N2_lay(i,k) / N2_meanz(i) -! enddo ; enddo - ! htot_WKB(i) = htot(i) ! Nearly equivalent and simpler - - do i=is,ie - CS%Nb(i,j) = sqrt(N2_bot(i)) - if ((CS%tideamp(i,j) > 0.0) .and. & - (CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14) ) then - z0_polzin(i) = CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & - CS%Nbotref_Polzin**2 * CS%tideamp(i,j) / & - ( CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 ) - if (z0_polzin(i) < CS%Polzin_min_decay_scale) & - z0_polzin(i) = CS%Polzin_min_decay_scale - if (N2_meanz(i) > 1.0e-14 ) then - z0_polzin_scaled(i) = z0_polzin(i)*CS%Nb(i,j)**2 / N2_meanz(i) - else - z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) - endif - if (z0_polzin_scaled(i) > (CS%Polzin_decay_scale_max_factor * htot(i)) ) & - z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) - else - z0_polzin(i) = CS%Polzin_decay_scale_max_factor * htot(i) - z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) - endif - - if (associated(dd%Polzin_decay_scale)) & - dd%Polzin_decay_scale(i,j) = z0_polzin(i) - if (associated(dd%Polzin_decay_scale_scaled)) & - dd%Polzin_decay_scale_scaled(i,j) = z0_polzin_scaled(i) - if (associated(dd%N2_bot)) dd%N2_bot(i,j) = CS%Nb(i,j)*CS%Nb(i,j) - - if ( CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then - ! For the Polzin formulation, this if loop prevents the vertical - ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14) then - Inv_int(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1 - endif - endif - if ( CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09) ) then - ! For the Polzin formulation, this if loop prevents the vertical - ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14) then - Inv_int_lee(i) = ( z0_polzin_scaled(i)*CS%Decay_scale_factor_lee / htot_WKB(i) ) + 1 - endif - endif - if ( CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then - ! For the Polzin formulation, this if loop prevents the vertical - ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14) then - Inv_int_low(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1 - endif - endif - - z_from_bot(i) = GV%H_to_m*h(i,j,nz) - ! Use the new formulation for WKB scaling. N2 is referenced to its - ! vertical mean. - if (N2_meanz(i) > 1.0e-14 ) then - z_from_bot_WKB(i) = GV%H_to_m*h(i,j,nz)*N2_lay(i,nz) / N2_meanz(i) - else ; z_from_bot_WKB(i) = 0 ; endif - enddo - endif ! Polzin - - ! Calculate/get dissipation values at bottom - ! Both Polzin and Simmons: - do i=is,ie - ! Dissipation of locally trapped internal tide (non-propagating high modes) - TKE_itidal_bot(i) = min(CS%TKE_itidal(i,j)*CS%Nb(i,j),CS%TKE_itide_max) - if (associated(dd%TKE_itidal_used)) & - dd%TKE_itidal_used(i,j) = TKE_itidal_bot(i) - TKE_itidal_bot(i) = (I_rho0 * CS%Mu_itides * CS%Gamma_itides) * TKE_itidal_bot(i) - ! Dissipation of locally trapped lee waves - TKE_Niku_bot(i) = 0.0 - if (CS%Lee_wave_dissipation) then - TKE_Niku_bot(i) = (I_rho0 * CS%Mu_itides * CS%Gamma_lee) * CS%TKE_Niku(i,j) - endif - ! Dissipation of propagating internal tide (baroclinic low modes; rays) (BDM) - TKE_lowmode_tot = 0.0 - TKE_lowmode_bot(i) = 0.0 - if (CS%Lowmode_itidal_dissipation) then - ! get loss rate due to wave drag on low modes (already multiplied by q) - call get_lowmode_loss(i,j,G,CS%int_tide_CSp,"WaveDrag",TKE_lowmode_tot) - TKE_lowmode_bot(i) = CS%Mu_itides * I_rho0 * TKE_lowmode_tot - endif - ! Vertical energy flux at bottom - TKE_itidal_rem(i) = Inv_int(i) * TKE_itidal_bot(i) - TKE_Niku_rem(i) = Inv_int_lee(i) * TKE_Niku_bot(i) - TKE_lowmode_rem(i) = Inv_int_low(i) * TKE_lowmode_bot(i) - - if (associated(dd%Fl_itidal)) dd%Fl_itidal(i,j,nz) = TKE_itidal_rem(i) !why is this here? BDM - enddo - - ! Estimate the work that would be done by mixing in each layer. - ! Simmons: - if ( use_Simmons ) then - do k=nz-1,2,-1 ; do i=is,ie - if (max_TKE(i,k) <= 0.0) cycle - z_from_bot(i) = z_from_bot(i) + GV%H_to_m*h(i,j,k) - - ! Fraction of bottom flux predicted to reach top of this layer - TKE_frac_top(i) = Inv_int(i) * exp(-Izeta * z_from_bot(i)) - TKE_frac_top_lee(i) = Inv_int_lee(i) * exp(-Izeta_lee * z_from_bot(i)) - TKE_frac_top_lowmode(i) = Inv_int_low(i) * exp(-Izeta * z_from_bot(i)) - - ! Actual influx at bottom of layer minus predicted outflux at top of layer to give - ! predicted power expended - TKE_itide_lay = TKE_itidal_rem(i) - TKE_itidal_bot(i) * TKE_frac_top(i) - TKE_Niku_lay = TKE_Niku_rem(i) - TKE_Niku_bot(i) * TKE_frac_top_lee(i) - TKE_lowmode_lay = TKE_lowmode_rem(i) - TKE_lowmode_bot(i)* TKE_frac_top_lowmode(i) - - ! Actual power expended may be less than predicted if stratification is weak; adjust - if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > max_TKE(i,k)) then - frac_used = max_TKE(i,k) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) - TKE_itide_lay = frac_used * TKE_itide_lay - TKE_Niku_lay = frac_used * TKE_Niku_lay - TKE_lowmode_lay = frac_used * TKE_lowmode_lay - endif - - ! Calculate vertical flux available to bottom of layer above - TKE_itidal_rem(i) = TKE_itidal_rem(i) - TKE_itide_lay - TKE_Niku_rem(i) = TKE_Niku_rem(i) - TKE_Niku_lay - TKE_lowmode_rem(i) = TKE_lowmode_rem(i) - TKE_lowmode_lay - - ! Convert power to diffusivity - Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) - - if (CS%Kd_max >= 0.0) Kd_add = min(Kd_add, CS%Kd_max) - Kd(i,j,k) = Kd(i,j,k) + Kd_add - - if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_add - endif - - ! diagnostics - if (associated(dd%Kd_itidal)) then - ! If at layers, dd%Kd_itidal is just TKE_to_Kd(i,k) * TKE_itide_lay - ! The following sets the interface diagnostics. - Kd_add = TKE_to_Kd(i,k) * TKE_itide_lay - if (CS%Kd_max >= 0.0) Kd_add = min(Kd_add, CS%Kd_max) - if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add - if (k= 0.0) Kd_add = min(Kd_add, CS%Kd_max) - if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add - if (k= 0.0) Kd_add = min(Kd_add, CS%Kd_max) - if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add - if (k 1.0e-14 ) then - z_from_bot_WKB(i) = z_from_bot_WKB(i) + GV%H_to_m*h(i,j,k)*N2_lay(i,k)/N2_meanz(i) - else ; z_from_bot_WKB(i) = 0 ; endif - - ! Fraction of bottom flux predicted to reach top of this layer - TKE_frac_top(i) = ( Inv_int(i) * z0_polzin_scaled(i) ) / & - ( z0_polzin_scaled(i) + z_from_bot_WKB(i) ) - z0_psl = z0_polzin_scaled(i)*CS%Decay_scale_factor_lee - TKE_frac_top_lee(i) = (Inv_int_lee(i) * z0_psl) / (z0_psl + z_from_bot_WKB(i)) - TKE_frac_top_lowmode(i) = ( Inv_int_low(i) * z0_polzin_scaled(i) ) / & - ( z0_polzin_scaled(i) + z_from_bot_WKB(i) ) - - ! Actual influx at bottom of layer minus predicted outflux at top of layer to give - ! predicted power expended - TKE_itide_lay = TKE_itidal_rem(i) - TKE_itidal_bot(i) *TKE_frac_top(i) - TKE_Niku_lay = TKE_Niku_rem(i) - TKE_Niku_bot(i) * TKE_frac_top_lee(i) - TKE_lowmode_lay = TKE_lowmode_rem(i) - TKE_lowmode_bot(i)*TKE_frac_top_lowmode(i) - - ! Actual power expended may be less than predicted if stratification is weak; adjust - if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > max_TKE(i,k)) then - frac_used = max_TKE(i,k) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) - TKE_itide_lay = frac_used * TKE_itide_lay - TKE_Niku_lay = frac_used * TKE_Niku_lay - TKE_lowmode_lay = frac_used * TKE_lowmode_lay - endif - - ! Calculate vertical flux available to bottom of layer above - TKE_itidal_rem(i) = TKE_itidal_rem(i) - TKE_itide_lay - TKE_Niku_rem(i) = TKE_Niku_rem(i) - TKE_Niku_lay - TKE_lowmode_rem(i) = TKE_lowmode_rem(i) - TKE_lowmode_lay - - ! Convert power to diffusivity - Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) - - if (CS%Kd_max >= 0.0) Kd_add = min(Kd_add, CS%Kd_max) - Kd(i,j,k) = Kd(i,j,k) + Kd_add - - if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_add - endif - - ! diagnostics - if (associated(dd%Kd_itidal)) then - ! If at layers, this is just dd%Kd_itidal(i,j,K) = TKE_to_Kd(i,k) * TKE_itide_lay - ! The following sets the interface diagnostics. - Kd_add = TKE_to_Kd(i,k) * TKE_itide_lay - if (CS%Kd_max >= 0.0) Kd_add = min(Kd_add, CS%Kd_max) - if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add - if (k= 0.0) Kd_add = min(Kd_add, CS%Kd_max) - if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add - if (k= 0.0) Kd_add = min(Kd_add, CS%Kd_max) - if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add - if (k This subroutine calculates several properties related to bottom !! boundary layer turbulence. subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 4bd9d52956..c329040f1c 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -23,6 +23,7 @@ module MOM_tidal_mixing public tidal_mixing_init public calculate_cvmix_tidal +public add_int_tide_diffusivity public tidal_mixing_end !> Control structure including parameters for tidal mixing. @@ -96,6 +97,28 @@ module MOM_tidal_mixing end type tidal_mixing_cs +type, public :: tidal_mixing_diags + real, pointer, dimension(:,:,:) :: & + Kd_itidal => NULL(),& ! internal tide diffusivity at interfaces (m2/s) + Fl_itidal => NULL(),& ! vertical flux of tidal turbulent dissipation (m3/s3) + Kd_lowmode => NULL(),& ! internal tide diffusivity at interfaces + ! due to propagating low modes (m2/s) (BDM) + Fl_lowmode => NULL(),& ! vertical flux of tidal turbulent dissipation + ! due to propagating low modes (m3/s3) (BDM) + Kd_Niku => NULL(),& ! lee-wave diffusivity at interfaces (m2/s) + Kd_Niku_work => NULL(),& ! layer integrated work by lee-wave driven mixing (W/m2) + Kd_Itidal_Work => NULL(),& ! layer integrated work by int tide driven mixing (W/m2) + Kd_Lowmode_Work=> NULL() ! layer integrated work by low mode driven mixing (W/m2) BDM + + real, pointer, dimension(:,:) :: & + TKE_itidal_used => NULL(),& ! internal tide TKE input at ocean bottom (W/m2) + N2_bot => NULL(),& ! bottom squared buoyancy frequency (1/s2) + N2_meanz => NULL(),& ! vertically averaged buoyancy frequency (1/s2) + Polzin_decay_scale_scaled => NULL(),& ! vertical scale of decay for tidal dissipation + Polzin_decay_scale => NULL() ! vertical decay scale for tidal diss with Polzin (meter) + +end type + character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name. character*(20), parameter :: STLAURENT_PROFILE_STRING = "STLAURENT_02" character*(20), parameter :: POLZIN_PROFILE_STRING = "POLZIN_09" @@ -369,6 +392,402 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) end function tidal_mixing_init + !> This subroutine adds the effect of internal-tide-driven mixing to the layer diffusivities. + !! The mechanisms considered are (1) local dissipation of internal waves generated by the + !! barotropic flow ("itidal"), (2) local dissipation of internal waves generated by the propagating + !! low modes (rays) of the internal tide ("lowmode"), and (3) local dissipation of internal lee waves. + !! Will eventually need to add diffusivity due to other wave-breaking processes (e.g. Bottom friction, + !! Froude-number-depending breaking, PSI, etc.). +subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & + dd, N2_lay, Kd, Kd_int, Kd_max) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G)), intent(in) :: N2_bot + real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay + integer, intent(in) :: j + real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd, max_TKE + type(tidal_mixing_cs), pointer :: CS + type(tidal_mixing_diags), intent(inout) :: dd + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int + real, intent(inout) :: Kd_max + + + ! This subroutine adds the effect of internal-tide-driven mixing to the layer diffusivities. + ! The mechanisms considered are (1) local dissipation of internal waves generated by the + ! barotropic flow ("itidal"), (2) local dissipation of internal waves generated by the propagating + ! low modes (rays) of the internal tide ("lowmode"), and (3) local dissipation of internal lee waves. + ! Will eventually need to add diffusivity due to other wave-breaking processes (e.g. Bottom friction, + ! Froude-number-depending breaking, PSI, etc.). + + real, dimension(SZI_(G)) :: & + htot, & ! total thickness above or below a layer, or the + ! integrated thickness in the BBL (meter) + htot_WKB, & ! distance from top to bottom (meter) WKB scaled + TKE_itidal_bot, & ! internal tide TKE at ocean bottom (m3/s3) + TKE_Niku_bot, & ! lee-wave TKE at ocean bottom (m3/s3) + TKE_lowmode_bot, & ! internal tide TKE at ocean bottom lost from all remote low modes (m3/s3) (BDM) + Inv_int, & ! inverse of TKE decay for int tide over the depth of the ocean (nondim) + Inv_int_lee, & ! inverse of TKE decay for lee waves over the depth of the ocean (nondim) + Inv_int_low, & ! inverse of TKE decay for low modes over the depth of the ocean (nondim) (BDM) + z0_Polzin, & ! TKE decay scale in Polzin formulation (meter) + z0_Polzin_scaled, & ! TKE decay scale in Polzin formulation (meter) + ! multiplied by N2_bot/N2_meanz to be coherent with the WKB scaled z + ! z*=int(N2/N2_bot) * N2_bot/N2_meanz = int(N2/N2_meanz) + ! z0_Polzin_scaled = z0_Polzin * N2_bot/N2_meanz + N2_meanz, & ! vertically averaged squared buoyancy frequency (1/s2) for WKB scaling + TKE_itidal_rem, & ! remaining internal tide TKE (from barotropic source) + TKE_Niku_rem, & ! remaining lee-wave TKE + TKE_lowmode_rem, & ! remaining internal tide TKE (from propagating low mode source) (BDM) + TKE_frac_top, & ! fraction of bottom TKE that should appear at top of a layer (nondim) + TKE_frac_top_lee, & ! fraction of bottom TKE that should appear at top of a layer (nondim) + TKE_frac_top_lowmode, & + ! fraction of bottom TKE that should appear at top of a layer (nondim) (BDM) + z_from_bot, & ! distance from bottom (meter) + z_from_bot_WKB ! distance from bottom (meter), WKB scaled + + real :: I_rho0 ! 1 / RHO0, (m3/kg) + real :: Kd_add ! diffusivity to add in a layer (m2/sec) + real :: TKE_itide_lay ! internal tide TKE imparted to a layer (from barotropic) (m3/s3) + real :: TKE_Niku_lay ! lee-wave TKE imparted to a layer (m3/s3) + real :: TKE_lowmode_lay ! internal tide TKE imparted to a layer (from low mode) (m3/s3) (BDM) + real :: frac_used ! fraction of TKE that can be used in a layer (nondim) + real :: Izeta ! inverse of TKE decay scale (1/meter) + real :: Izeta_lee ! inverse of TKE decay scale for lee waves (1/meter) + real :: z0_psl ! temporary variable with units of meter + real :: TKE_lowmode_tot ! TKE from all low modes (W/m2) (BDM) + + logical :: use_Polzin, use_Simmons + integer :: i, k, is, ie, nz + integer :: a, fr, m + is = G%isc ; ie = G%iec ; nz = G%ke + + if (.not.(CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation)) return + + do i=is,ie ; htot(i) = 0.0 ; Inv_int(i) = 0.0 ; Inv_int_lee(i) = 0.0 ; Inv_int_low(i) = 0.0 ;enddo + do k=1,nz ; do i=is,ie + htot(i) = htot(i) + GV%H_to_m*h(i,j,k) + enddo ; enddo + + I_Rho0 = 1.0/GV%Rho0 + + use_Polzin = ((CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09)) .or. & + (CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09)) .or. & + (CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == POLZIN_09))) + use_Simmons = ((CS%Int_tide_dissipation .and. (CS%int_tide_profile == STLAURENT_02)) .or. & + (CS%lee_wave_dissipation .and. (CS%lee_wave_profile == STLAURENT_02)) .or. & + (CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == STLAURENT_02))) + + ! Calculate parameters for vertical structure of dissipation + ! Simmons: + if ( use_Simmons ) then + Izeta = 1.0 / max(CS%Int_tide_decay_scale, GV%H_subroundoff*GV%H_to_m) + Izeta_lee = 1.0 / max(CS%Int_tide_decay_scale*CS%Decay_scale_factor_lee, & + GV%H_subroundoff*GV%H_to_m) + do i=is,ie + CS%Nb(i,j) = sqrt(N2_bot(i)) + if (associated(dd%N2_bot)) dd%N2_bot(i,j) = N2_bot(i) + if ( CS%Int_tide_dissipation ) then + if (Izeta*htot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule. + Inv_int(i) = 1.0 / (1.0 - exp(-Izeta*htot(i))) + endif + endif + if ( CS%Lee_wave_dissipation ) then + if (Izeta_lee*htot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule. + Inv_int_lee(i) = 1.0 / (1.0 - exp(-Izeta_lee*htot(i))) + endif + endif + if ( CS%Lowmode_itidal_dissipation) then + if (Izeta*htot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule. + Inv_int_low(i) = 1.0 / (1.0 - exp(-Izeta*htot(i))) + endif + endif + z_from_bot(i) = GV%H_to_m*h(i,j,nz) + enddo + endif ! Simmons + + ! Polzin: + if ( use_Polzin ) then + ! WKB scaling of the vertical coordinate + do i=is,ie ; N2_meanz(i)=0.0 ; enddo + do k=1,nz ; do i=is,ie + N2_meanz(i) = N2_meanz(i) + N2_lay(i,k)*GV%H_to_m*h(i,j,k) + enddo ; enddo + do i=is,ie + N2_meanz(i) = N2_meanz(i) / (htot(i) + GV%H_subroundoff*GV%H_to_m) + if (associated(dd%N2_meanz)) dd%N2_meanz(i,j) = N2_meanz(i) + enddo + + ! WKB scaled z*(z=H) z* at the surface using the modified Polzin WKB scaling + do i=is,ie ; htot_WKB(i) = htot(i) ; enddo +! do i=is,ie ; htot_WKB(i) = 0.0 ; enddo +! do k=1,nz ; do i=is,ie +! htot_WKB(i) = htot_WKB(i) + GV%H_to_m*h(i,j,k)*N2_lay(i,k) / N2_meanz(i) +! enddo ; enddo + ! htot_WKB(i) = htot(i) ! Nearly equivalent and simpler + + do i=is,ie + CS%Nb(i,j) = sqrt(N2_bot(i)) + if ((CS%tideamp(i,j) > 0.0) .and. & + (CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14) ) then + z0_polzin(i) = CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & + CS%Nbotref_Polzin**2 * CS%tideamp(i,j) / & + ( CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 ) + if (z0_polzin(i) < CS%Polzin_min_decay_scale) & + z0_polzin(i) = CS%Polzin_min_decay_scale + if (N2_meanz(i) > 1.0e-14 ) then + z0_polzin_scaled(i) = z0_polzin(i)*CS%Nb(i,j)**2 / N2_meanz(i) + else + z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) + endif + if (z0_polzin_scaled(i) > (CS%Polzin_decay_scale_max_factor * htot(i)) ) & + z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) + else + z0_polzin(i) = CS%Polzin_decay_scale_max_factor * htot(i) + z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) + endif + + if (associated(dd%Polzin_decay_scale)) & + dd%Polzin_decay_scale(i,j) = z0_polzin(i) + if (associated(dd%Polzin_decay_scale_scaled)) & + dd%Polzin_decay_scale_scaled(i,j) = z0_polzin_scaled(i) + if (associated(dd%N2_bot)) dd%N2_bot(i,j) = CS%Nb(i,j)*CS%Nb(i,j) + + if ( CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then + ! For the Polzin formulation, this if loop prevents the vertical + ! flux of energy dissipation from having NaN values + if (htot_WKB(i) > 1.0e-14) then + Inv_int(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1 + endif + endif + if ( CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09) ) then + ! For the Polzin formulation, this if loop prevents the vertical + ! flux of energy dissipation from having NaN values + if (htot_WKB(i) > 1.0e-14) then + Inv_int_lee(i) = ( z0_polzin_scaled(i)*CS%Decay_scale_factor_lee / htot_WKB(i) ) + 1 + endif + endif + if ( CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then + ! For the Polzin formulation, this if loop prevents the vertical + ! flux of energy dissipation from having NaN values + if (htot_WKB(i) > 1.0e-14) then + Inv_int_low(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1 + endif + endif + + z_from_bot(i) = GV%H_to_m*h(i,j,nz) + ! Use the new formulation for WKB scaling. N2 is referenced to its + ! vertical mean. + if (N2_meanz(i) > 1.0e-14 ) then + z_from_bot_WKB(i) = GV%H_to_m*h(i,j,nz)*N2_lay(i,nz) / N2_meanz(i) + else ; z_from_bot_WKB(i) = 0 ; endif + enddo + endif ! Polzin + + ! Calculate/get dissipation values at bottom + ! Both Polzin and Simmons: + do i=is,ie + ! Dissipation of locally trapped internal tide (non-propagating high modes) + TKE_itidal_bot(i) = min(CS%TKE_itidal(i,j)*CS%Nb(i,j),CS%TKE_itide_max) + if (associated(dd%TKE_itidal_used)) & + dd%TKE_itidal_used(i,j) = TKE_itidal_bot(i) + TKE_itidal_bot(i) = (I_rho0 * CS%Mu_itides * CS%Gamma_itides) * TKE_itidal_bot(i) + ! Dissipation of locally trapped lee waves + TKE_Niku_bot(i) = 0.0 + if (CS%Lee_wave_dissipation) then + TKE_Niku_bot(i) = (I_rho0 * CS%Mu_itides * CS%Gamma_lee) * CS%TKE_Niku(i,j) + endif + ! Dissipation of propagating internal tide (baroclinic low modes; rays) (BDM) + TKE_lowmode_tot = 0.0 + TKE_lowmode_bot(i) = 0.0 + if (CS%Lowmode_itidal_dissipation) then + ! get loss rate due to wave drag on low modes (already multiplied by q) + + ! TODO: uncomment the following call and fix it + !call get_lowmode_loss(i,j,G,CS%int_tide_CSp,"WaveDrag",TKE_lowmode_tot) + print *, "========", __FILE__, __LINE__ + call MOM_error(FATAL,"this block not supported yet. (aa)") + + TKE_lowmode_bot(i) = CS%Mu_itides * I_rho0 * TKE_lowmode_tot + endif + ! Vertical energy flux at bottom + TKE_itidal_rem(i) = Inv_int(i) * TKE_itidal_bot(i) + TKE_Niku_rem(i) = Inv_int_lee(i) * TKE_Niku_bot(i) + TKE_lowmode_rem(i) = Inv_int_low(i) * TKE_lowmode_bot(i) + + if (associated(dd%Fl_itidal)) dd%Fl_itidal(i,j,nz) = TKE_itidal_rem(i) !why is this here? BDM + enddo + + ! Estimate the work that would be done by mixing in each layer. + ! Simmons: + if ( use_Simmons ) then + do k=nz-1,2,-1 ; do i=is,ie + if (max_TKE(i,k) <= 0.0) cycle + z_from_bot(i) = z_from_bot(i) + GV%H_to_m*h(i,j,k) + + ! Fraction of bottom flux predicted to reach top of this layer + TKE_frac_top(i) = Inv_int(i) * exp(-Izeta * z_from_bot(i)) + TKE_frac_top_lee(i) = Inv_int_lee(i) * exp(-Izeta_lee * z_from_bot(i)) + TKE_frac_top_lowmode(i) = Inv_int_low(i) * exp(-Izeta * z_from_bot(i)) + + ! Actual influx at bottom of layer minus predicted outflux at top of layer to give + ! predicted power expended + TKE_itide_lay = TKE_itidal_rem(i) - TKE_itidal_bot(i) * TKE_frac_top(i) + TKE_Niku_lay = TKE_Niku_rem(i) - TKE_Niku_bot(i) * TKE_frac_top_lee(i) + TKE_lowmode_lay = TKE_lowmode_rem(i) - TKE_lowmode_bot(i)* TKE_frac_top_lowmode(i) + + ! Actual power expended may be less than predicted if stratification is weak; adjust + if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > max_TKE(i,k)) then + frac_used = max_TKE(i,k) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) + TKE_itide_lay = frac_used * TKE_itide_lay + TKE_Niku_lay = frac_used * TKE_Niku_lay + TKE_lowmode_lay = frac_used * TKE_lowmode_lay + endif + + ! Calculate vertical flux available to bottom of layer above + TKE_itidal_rem(i) = TKE_itidal_rem(i) - TKE_itide_lay + TKE_Niku_rem(i) = TKE_Niku_rem(i) - TKE_Niku_lay + TKE_lowmode_rem(i) = TKE_lowmode_rem(i) - TKE_lowmode_lay + + ! Convert power to diffusivity + Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) + + if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) + Kd(i,j,k) = Kd(i,j,k) + Kd_add + + if (present(Kd_int)) then + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_add + endif + + ! diagnostics + if (associated(dd%Kd_itidal)) then + ! If at layers, dd%Kd_itidal is just TKE_to_Kd(i,k) * TKE_itide_lay + ! The following sets the interface diagnostics. + Kd_add = TKE_to_Kd(i,k) * TKE_itide_lay + if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) + if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add + if (k= 0.0) Kd_add = min(Kd_add, Kd_max) + if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add + if (k= 0.0) Kd_add = min(Kd_add, Kd_max) + if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add + if (k 1.0e-14 ) then + z_from_bot_WKB(i) = z_from_bot_WKB(i) + GV%H_to_m*h(i,j,k)*N2_lay(i,k)/N2_meanz(i) + else ; z_from_bot_WKB(i) = 0 ; endif + + ! Fraction of bottom flux predicted to reach top of this layer + TKE_frac_top(i) = ( Inv_int(i) * z0_polzin_scaled(i) ) / & + ( z0_polzin_scaled(i) + z_from_bot_WKB(i) ) + z0_psl = z0_polzin_scaled(i)*CS%Decay_scale_factor_lee + TKE_frac_top_lee(i) = (Inv_int_lee(i) * z0_psl) / (z0_psl + z_from_bot_WKB(i)) + TKE_frac_top_lowmode(i) = ( Inv_int_low(i) * z0_polzin_scaled(i) ) / & + ( z0_polzin_scaled(i) + z_from_bot_WKB(i) ) + + ! Actual influx at bottom of layer minus predicted outflux at top of layer to give + ! predicted power expended + TKE_itide_lay = TKE_itidal_rem(i) - TKE_itidal_bot(i) *TKE_frac_top(i) + TKE_Niku_lay = TKE_Niku_rem(i) - TKE_Niku_bot(i) * TKE_frac_top_lee(i) + TKE_lowmode_lay = TKE_lowmode_rem(i) - TKE_lowmode_bot(i)*TKE_frac_top_lowmode(i) + + ! Actual power expended may be less than predicted if stratification is weak; adjust + if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > max_TKE(i,k)) then + frac_used = max_TKE(i,k) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) + TKE_itide_lay = frac_used * TKE_itide_lay + TKE_Niku_lay = frac_used * TKE_Niku_lay + TKE_lowmode_lay = frac_used * TKE_lowmode_lay + endif + + ! Calculate vertical flux available to bottom of layer above + TKE_itidal_rem(i) = TKE_itidal_rem(i) - TKE_itide_lay + TKE_Niku_rem(i) = TKE_Niku_rem(i) - TKE_Niku_lay + TKE_lowmode_rem(i) = TKE_lowmode_rem(i) - TKE_lowmode_lay + + ! Convert power to diffusivity + Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) + + if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) + Kd(i,j,k) = Kd(i,j,k) + Kd_add + + if (present(Kd_int)) then + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_add + endif + + ! diagnostics + if (associated(dd%Kd_itidal)) then + ! If at layers, this is just dd%Kd_itidal(i,j,K) = TKE_to_Kd(i,k) * TKE_itide_lay + ! The following sets the interface diagnostics. + Kd_add = TKE_to_Kd(i,k) * TKE_itide_lay + if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) + if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add + if (k= 0.0) Kd_add = min(Kd_add, Kd_max) + if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add + if (k= 0.0) Kd_add = min(Kd_add, Kd_max) + if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add + if (k .... subroutine calculate_cvmix_tidal() From 0bb899a570004a68fbbfda578f6516aa5c4958f8 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Mon, 19 Mar 2018 13:50:20 -0600 Subject: [PATCH 0028/1072] uncomment cvmix_init_tidal --- .../vertical/MOM_tidal_mixing.F90 | 69 ++++++++----------- 1 file changed, 29 insertions(+), 40 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index c329040f1c..0201dd3476 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -81,12 +81,7 @@ module MOM_tidal_mixing real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height character(len=200) :: inputdir - - !real :: local_mixing_frac !< fraction of wave energy dissipated locally. - !real :: mixing_efficiency !< The efficiency that mechanical energy dissipation translates into mixing - ! !! that can be parameterized by a diffusivity acting on vertical stratification. - !real :: vert_decay_scale !< zeta in the Simmons paper (to compute the vertical deposition function). [m] - !real :: tidal_max_coef !< maximum allowable tidel diffusivity. [m^2/s] + real :: tidal_max_coef !< maximum allowable tidal diffusivity. [m^2/s] real, pointer, dimension(:,:) :: TKE_Niku => NULL() real, pointer, dimension(:,:) :: TKE_itidal => NULL() @@ -254,7 +249,8 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "INT_TIDE_DECAY_SCALE", CS%Int_tide_decay_scale, & "The decay scale away from the bottom for tidal TKE with \n"//& "the new coding when INT_TIDE_DISSIPATION is used.", & - units="m", default=0.0) + !units="m", default=0.0) + units="m", default=500.0) ! TODO: confirm this new default call get_param(param_file, mdl, "MU_ITIDES", CS%Mu_itides, & "A dimensionless turbulent mixing efficiency used with \n"//& "INT_TIDE_DISSIPATION, often 0.2.", units="nondim", default=0.2) @@ -357,38 +353,30 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) else CS%Decay_scale_factor_lee = -9.e99 ! This should never be used if CS%Lee_wave_dissipation = False endif - !call get_param(param_file, mdl, "USE_CVMIX_TIDAL", tidal_mixing_init, & - ! "If true, turns on tidal mixing scheme via CVMix", & - ! default=.false.) - !!call openParameterBlock(param_file,'CVMIX_TIDAL') - !call get_param(param_file, mdl, "LOCAL_MIXING_FRAC", CS%local_mixing_frac, & - ! "Fraction of wave energy dissipated locally.", & - ! units="nondim", default=0.33) - !call get_param(param_file, mdl, "MIXING_EFFICIENCY", CS%mixing_efficiency, & - ! "Gamma in Simmons, 2004", & - ! units="nondim", default=0.20) - !!TODO: make sure GAMMA_ITIDES (same as LOCAL_MIXING_FRAC - !call get_param(param_file, mdl, "VERTICAL_DECAY_SCALE", CS%vert_decay_scale, & - ! "zeta in Simmons, 2004. Used to compute the vertical deposition function", & - ! units="m", default=500.0) - !!TODO: make sure int_tide_decay scale (same as VERTICAL_DECAY_SCALE is removed from code). - !call get_param(param_file, mdl, "TIDAL_MAX_COEF", CS%tidal_max_coef, & - ! "largest acceptable value for tidal diffusivity", & - ! units="m^2/s", default=100e-4) ! the default is 50e-4 in CVMIX, 100e-4 in POP. - !!call closeParameterBlock(param_file) - - - !if (CS%debug) print *, __FILE__, __LINE__, tidal_mixing_init - - !! Set up CVMix - !call cvmix_init_tidal(mix_scheme = 'Simmons', & - ! efficiency = cs%mixing_efficiency, & - ! vertical_decay_scale = cs%vert_decay_scale, & - ! max_coefficient = cs%tidal_max_coef, & - ! local_mixing_frac = cs%local_mixing_frac, & - ! depth_cutoff = 0.0) - ! - !! TODO: read in energy + + call get_param(param_file, mdl, "USE_CVMIX_TIDAL", tidal_mixing_init, & + "If true, turns on tidal mixing scheme via CVMix", & + default=.false.) + + if (tidal_mixing_init) then + + ! Read in CVMix params + call openParameterBlock(param_file,'CVMIX_TIDAL') + call get_param(param_file, mdl, "TIDAL_MAX_COEF", CS%tidal_max_coef, & + "largest acceptable value for tidal diffusivity", & + units="m^2/s", default=100e-4) ! the default is 50e-4 in CVMIX, 100e-4 in POP. + call closeParameterBlock(param_file) + + + ! Set up CVMix + call cvmix_init_tidal(mix_scheme = 'Simmons', & + efficiency = CS%Mu_itides, & + vertical_decay_scale = cs%int_tide_decay_scale, & + max_coefficient = cs%tidal_max_coef, & + local_mixing_frac = cs%Gamma_itides, & + depth_cutoff = 0.0) + + endif ! cvmix on end function tidal_mixing_init @@ -789,7 +777,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, end subroutine add_int_tide_diffusivity -!> .... + +!TODO: subroutine calculate_cvmix_tidal() continue end subroutine calculate_cvmix_tidal From 53004ec665089d2fab707ced506d7501da62ffd0 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 19 Mar 2018 16:35:05 -0600 Subject: [PATCH 0029/1072] Deleted module MOM_diffConvection This module was not being used and convection is now applied via MOM_cvmix_conv. --- .../vertical/MOM_diffConvection.F90 | 163 ------------------ 1 file changed, 163 deletions(-) delete mode 100644 src/parameterizations/vertical/MOM_diffConvection.F90 diff --git a/src/parameterizations/vertical/MOM_diffConvection.F90 b/src/parameterizations/vertical/MOM_diffConvection.F90 deleted file mode 100644 index b63dbe4472..0000000000 --- a/src/parameterizations/vertical/MOM_diffConvection.F90 +++ /dev/null @@ -1,163 +0,0 @@ -module MOM_diffConvection - -! This file is part of MOM6. See LICENSE.md for the license. - -use MOM_diag_mediator, only : time_type, diag_ctrl, safe_alloc_ptr, post_data -use MOM_diag_mediator, only : query_averaging_enabled, register_diag_field -use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_PE -use MOM_EOS, only : EOS_type, calculate_density -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_file_parser, only : openParameterBlock, closeParameterBlock -use MOM_grid, only : ocean_grid_type, isPointInCell -use MOM_verticalGrid, only : verticalGrid_type - -implicit none ; private - -#include "MOM_memory.h" - -public :: diffConvection_init, diffConvection_calculate, diffConvection_end - -! Control structure for containing KPP parameters/data -type, public :: diffConvection_CS ; private - - ! Parameters - real :: Kd_convection ! The value of diffusivity to add at statically unstable interfaces (m2/s) - logical :: debug ! If true, turn on debugging - logical :: passiveMode ! If true, make the motions but go nowhere - - ! Daignostic handles and pointers - type(diag_ctrl), pointer :: diag => NULL() - integer :: id_N2 = -1, id_Kd_conv = -1 - - ! Diagnostics arrays - real, allocatable, dimension(:,:,:) :: N2 ! Brunt-Vaisala frequency (1/s2) - real, allocatable, dimension(:,:,:) :: Kd_conv ! Diffusivity added by convection (m2/s) - -end type diffConvection_CS - -! Module data used for debugging only -logical, parameter :: verbose = .False. - -contains - -logical function diffConvection_init(paramFile, G, diag, Time, CS) -!< Initialize the CVmix KPP module and set up diagnostics -!! Returns True if module is to be used, otherwise returns False. - -! Arguments - type(param_file_type), intent(in) :: paramFile !< File parser - type(ocean_grid_type), intent(in) :: G !< Ocean grid - type(diag_ctrl), target, intent(in) :: diag !< Diagnostics - type(time_type), intent(in) :: Time !< Time - type(diffConvection_CS), pointer :: CS !< Control structure -! Local variables -#include "version_variable.h" - character(len=40) :: mdl = 'MOM_diffConvection' ! This module's name. - - if (associated(CS)) call MOM_error(FATAL, 'MOM_diffConvection, diffConvection_init: '// & - 'Control structure has already been initialized') - allocate(CS) - -! Read parameters - call log_version(paramFile, mdl, version, & - 'This module implements enhanced diffusivity as a\n' // & - 'function of static stability, N^2.') - call get_param(paramFile, mdl, "USE_CONVECTION", diffConvection_init, & - "If true, turns on the diffusive convection scheme that\n"// & - "increases diapycnal diffusivities at statically unstable\n"// & - "interfaces. Relevant parameters are contained in the\n"// & - "CONVECTION% parameter block.", & - default=.false.) - - call openParameterBlock(paramFile,'CONVECTION') - call get_param(paramFile, mdl, 'PASSIVE', CS%passiveMode, & - 'If True, puts KPP into a passive-diagnostic mode.', & - default=.False.) - call get_param(paramFile, mdl, 'KD_CONV', CS%Kd_convection, & - 'DIffusivity used in statically unstable regions of column.', & - units='m2/s', default=1.00) - call closeParameterBlock(paramFile) - call get_param(paramFile, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) - -! Forego remainder of initialization if not using this scheme - if (.not. diffConvection_init) return - -! Register diagnostics - CS%diag => diag - CS%id_N2 = register_diag_field('ocean_model', 'Conv_N2', diag%axesTi, Time, & - 'Square of Brunt-Vaisala frequency used by diffConvection module', '1/s2') - if (CS%id_N2 > 0) allocate( CS%N2( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) - CS%id_Kd_conv = register_diag_field('ocean_model', 'Conv_Kd', diag%axesTi, Time, & - 'Additional diffusivity added by diffConvection module', 'm2/s') - if (CS%id_Kd_conv > 0) allocate( CS%Kd_conv( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) - - if (CS%id_N2 > 0) CS%N2(:,:,:) = 0. - if (CS%id_Kd_conv > 0) CS%Kd_conv(:,:,:) = 0. - -end function diffConvection_init - - -subroutine diffConvection_calculate(CS, G, GV, h, Temp, Salt, EOS, Kd_int) -!< Calculates diffusivity and non-local transport for KPP parameterization - -! Arguments - type(diffConvection_CS), pointer :: CS !< Control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< Pot. temperature (degrees C) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< Salinity (ppt) - type(EOS_type), pointer :: EOS !< Equation of state - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kd_int !< (in) Vertical diffusivity on interfaces (m2/s) - !! (out) Modified vertical diffusivity (m2/s) -! Local variables - integer :: i, j, k - real, dimension( G%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces (1/s2) - real, dimension( G%ke+1 ) :: Kd_1d ! Vertical diffusivity at interfaces (m2/s) - real :: GoRho, pRef, rhoK, rhoKm1 - - GoRho = GV%g_Earth / GV%Rho0 - - N2_1d( 1 ) = 0. - N2_1d( G%ke+1 ) = 0. - Kd_1d( 1 ) = 0. - Kd_1d( G%ke+1 ) = 0. - do j=G%jsc,G%jec ; do i=G%isc,G%iec - ! This k-loop calculates external quantities independent of any iterations - ! Start at bottom of top level - pRef = 0. ! Ignore atmospheric pressure - do K = 2, G%ke - ! Pressure at interface K is incremented by mass of level above - pRef = pRef + GV%g_Earth * GV%Rho0 * h(i,j,k-1) * GV%H_to_m ! Boussinesq approximation!!!! ????? - ! Compute Brunt-Vaisala frequency (static stability) on interfaces - call calculate_density(Temp(i,j,k), Salt(i,j,k), pRef, rhoK, EOS) - call calculate_density(Temp(i,j,k-1), Salt(i,j,k-1), pRef, rhoKm1, EOS) - N2_1d(K) = GoRho * (rhoK - rhoKm1) / & - (0.5*(h(i,j,k-1) + h(i,j,k)) + GV%H_subroundoff) ! Can be negative - Kd_1d(K) = 0. - if (N2_1d(K) < 0.) Kd_1d(K) = CS%Kd_convection - enddo ! k - - if (.not. CS%passiveMode) Kd_int(i,j,:) = Kd_int(i,j,:) + Kd_1d(:) - - if (CS%id_N2 > 0) CS%N2(i,j,:) = N2_1d(:) - if (CS%id_Kd_conv > 0) CS%Kd_conv(i,j,:) = Kd_1d(:) - - enddo ; enddo ! j - - if (CS%id_N2 > 0) call post_data(CS%id_N2, CS%N2, CS%diag) - if (CS%id_Kd_conv > 0) call post_data(CS%id_Kd_conv, CS%Kd_conv, CS%diag) - -end subroutine diffConvection_calculate - - -subroutine diffConvection_end(CS) -! Clear pointers, dealocate memory - type(diffConvection_CS), pointer :: CS ! Control structure - - if (CS%id_N2 > 0) deallocate(CS%N2, CS%diag) - if (CS%id_Kd_conv > 0) deallocate(CS%Kd_conv, CS%diag) - deallocate(CS) -end subroutine diffConvection_end - -end module MOM_diffConvection From a101e49ae3a0b319577fc4aa159832726103559f Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 20 Mar 2018 16:02:21 -0600 Subject: [PATCH 0030/1072] Reduced the numbers of characters in a line --- src/parameterizations/vertical/MOM_cvmix_conv.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_cvmix_conv.F90 b/src/parameterizations/vertical/MOM_cvmix_conv.F90 index 88dece60fb..721c35faa2 100644 --- a/src/parameterizations/vertical/MOM_cvmix_conv.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_conv.F90 @@ -149,8 +149,8 @@ subroutine calculate_cvmix_conv(h, tv, G, GV, CS, hbl) type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. - type(cvmix_conv_cs), pointer :: CS !< The control structure returned by a previous call to - !! CVMix_conv_init. + type(cvmix_conv_cs), pointer :: CS !< The control structure returned + !! by a previous call to CVMix_conv_init. real, dimension(:,:), optional, pointer :: hbl!< Depth of ocean boundary layer (m) ! local variables From 83089ff18e4d2de1240fdf48fb4926c9cff49c63 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 21 Mar 2018 10:44:30 -0600 Subject: [PATCH 0031/1072] Updated CVMix --- pkg/CVMix-src | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/CVMix-src b/pkg/CVMix-src index d83f582714..66857c94be 160000 --- a/pkg/CVMix-src +++ b/pkg/CVMix-src @@ -1 +1 @@ -Subproject commit d83f582714e7f0f98d20efd8fac8fab01fa3bfe6 +Subproject commit 66857c94bed214c32ccb5791010c6611ac5ae270 From 1116f49ce2192620e3b303e27e4bc8f08090cc42 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 21 Mar 2018 18:10:35 -0600 Subject: [PATCH 0032/1072] Fixed a problem in cvmix_init_bkgnd_BryanLewis_low --- pkg/CVMix-src | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/CVMix-src b/pkg/CVMix-src index 66857c94be..c3a711e4e4 160000 --- a/pkg/CVMix-src +++ b/pkg/CVMix-src @@ -1 +1 @@ -Subproject commit 66857c94bed214c32ccb5791010c6611ac5ae270 +Subproject commit c3a711e4e45f5ebcdc528f8ac690ad9a843375e9 From 1be0248846dfaa38c1152fb870ba618f6ef48232 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 21 Mar 2018 18:29:31 -0600 Subject: [PATCH 0033/1072] Added first version of MOM_bkgnd_mixing * everything related to setting background mixing that was previously in MOM_set_diffusivity, has been moved to this new module * Bryan and Lewis background mixing is now applied via CVMix --- .../vertical/MOM_bkgnd_mixing.F90 | 603 ++++++++++++++++++ 1 file changed, 603 insertions(+) create mode 100644 src/parameterizations/vertical/MOM_bkgnd_mixing.F90 diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 new file mode 100644 index 0000000000..3ad9dfd638 --- /dev/null +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -0,0 +1,603 @@ +!> Interface to background mixing schemes, including the Bryan and Lewis (1979) +!! which is applied via CVMix. + +module MOM_bkgnd_mixing + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field +use MOM_diag_mediator, only : post_data +use MOM_EOS, only : calculate_density, calculate_density_derivs +use MOM_variables, only : thermo_var_ptrs +use MOM_forcing_type, only : forcing +use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE +use MOM_file_parser, only : openParameterBlock, closeParameterBlock +use MOM_debugging, only : hchksum +use MOM_grid, only : ocean_grid_type +use MOM_verticalGrid, only : verticalGrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use cvmix_background, only : cvmix_init_bkgnd, cvmix_coeffs_bkgnd +use MOM_intrinsic_functions, only : invcosh + +implicit none ; private + +#include + +public bkgnd_mixing_init, bkgnd_mixing_end, calculate_bkgnd_mixing + +!> Control structure including parameters for this module. +type, public :: bkgnd_mixing_cs + + ! Parameters + real :: Kd_Bryan_Lewis_deep !< The abyssal value of a Bryan-Lewis diffusivity profile + !! (m2/s) + real :: Kd_Bryan_Lewis_surface !< "The surface value of a Bryan-Lewis diffusivity profile + !! (m2/s) + real :: Bryan_Lewis_depth_cent !< The depth about which the transition in the Bryan-Lewis + !! is centered (m) + real :: Bryan_Lewis_width_trans!< The width of the transition in the Bryan-Lewis profile (m) + real :: Kd_min !< minimum diapycnal diffusivity (m2/s) + real :: Kd !< interior diapycnal diffusivity (m2/s) + real :: N0_2Omega !< ratio of the typical Buoyancy frequency to + !! twice the Earth's rotation period, used with the + !! Henyey scaling from the mixing + real :: prandtl_turb !< Turbulent Prandtl number + real :: Kd_tanh_lat_scale !< A nondimensional scaling for the range of + !! diffusivities with Kd_tanh_lat_fn. Valid values + !! are in the range of -2 to 2; 0.4 reproduces CM2M. + real :: Kdml !< mixed layer diapycnal diffusivity (m2/s) + !! when bulkmixedlayer==.false. + real :: Hmix !< mixed layer thickness (meter) when + !! bulkmixedlayer==.false. + logical :: Kd_tanh_lat_fn !< If true, use the tanh dependence of Kd_sfc on + !! latitude, like GFDL CM2.1/CM2M. There is no + !! physical justification for this form, and it can + !! not be used with Henyey_IGW_background. + logical :: Bryan_Lewis_diffusivity!< If true, background vertical diffusivity + !! uses Bryan-Lewis (1979) like tanh profile. + logical :: Henyey_IGW_background !< If true, use a simplified variant of the + !! Henyey et al, JGR (1986) latitudinal scaling for the background diapycnal diffusivity, + !! which gives a marked decrease in the diffusivity near the equator. The simplification + !! here is to assume that the in-situ stratification is the same as the reference stratificaiton. + logical :: Henyey_IGW_background_new !< same as Henyey_IGW_background + !! but incorporate the effect of stratification on TKE dissipation, + !! e = f/f_0 * acosh(N/f) / acosh(N_0/f_0) * e_0 + !! where e is the TKE dissipation, and N_0 and f_0 + !! are the reference buoyancy frequency and inertial frequencies respectively. + !! e_0 is the reference dissipation at (N_0,f_0). In the previous version, N=N_0. + !! Additionally, the squared inverse relationship between diapycnal diffusivities + !! and stratification is included: + !! + !! kd = e/N^2 + !! + !! where kd is the diapycnal diffusivity. This approach assumes that work done + !! against gravity is uniformly distributed throughout the column. Whereas, kd=kd_0*e, + !! as in the original version, concentrates buoyancy work in regions of strong stratification. + logical :: bulkmixedlayer !< If true, a refined bulk mixed layer scheme is used + logical :: debug !< If true, turn on debugging in this module + ! Daignostic handles and pointers + type(diag_ctrl), pointer :: diag => NULL() + integer :: id_kd_bkgnd = -1, id_kv_bkgnd = -1 + + ! Diagnostics arrays + real, allocatable, dimension(:,:,:) :: kd_bkgnd !< Background diffusivity (m2/s) + real, allocatable, dimension(:,:,:) :: kv_bkgnd !< Background viscosity (m2/s) + +end type bkgnd_mixing_cs + +character(len=40) :: mdl = "MOM_bkgnd_mixing" !< This module's name. + +contains + +!> Initialize the background mixing routine. +subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) + + type(time_type), intent(in) :: Time !< The current time. + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle + type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. + type(bkgnd_mixing_cs), pointer :: CS !< This module's control structure. + + ! Local variables + +! This include declares and sets the variable "version". +#include "version_variable.h" + + if (associated(CS)) then + call MOM_error(WARNING, "bkgnd_mixing_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + + ! Read parameters + call log_version(param_file, mdl, version, & + "Adding static vertical background mixing coefficients") + + call get_param(param_file, mdl, "KD", CS%Kd, & + "The background diapycnal diffusivity of density in the \n"//& + "interior. Zero or the molecular value, ~1e-7 m2 s-1, \n"//& + "may be used.", units="m2 s-1", fail_if_missing=.true.) + + call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, & + "The minimum diapycnal diffusivity.", & + units="m2 s-1", default=0.01*CS%Kd) + + ! The following is needed to set one of the choices of vertical background mixing + call get_param(param_file, mdl, "BULKMIXEDLAYER", CS%bulkmixedlayer, & + do_not_log=.true.) + if (CS%bulkmixedlayer) then + ! Check that Kdml is not set when using bulk mixed layer + call get_param(param_file, mdl, "KDML", CS%Kdml, default=-1.) + if (CS%Kdml>0.) call MOM_error(FATAL, & + "bkgnd_mixing_init: KDML cannot be set when using"// & + "bulk mixed layer.") + CS%Kdml = CS%Kd ! This is not used with a bulk mixed layer, but also + ! cannot be a NaN. + else + call get_param(param_file, mdl, "KDML", CS%Kdml, & + "If BULKMIXEDLAYER is false, KDML is the elevated \n"//& + "diapycnal diffusivity in the topmost HMIX of fluid. \n"//& + "KDML is only used if BULKMIXEDLAYER is false.", & + units="m2 s-1", default=CS%Kd) + call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & + "The prescribed depth over which the near-surface \n"//& + "viscosity and diffusivity are elevated when the bulk \n"//& + "mixed layer is not used.", units="m", fail_if_missing=.true.) + endif + + + call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) + + call get_param(param_file, mdl, "PRANDTL_TURB", CS%prandtl_turb, & + units="nondim", default=1.0, do_not_log=.true.) + + call openParameterBlock(param_file,'MOM_BACKGROUND_MIXING') + + call get_param(param_file, mdl, "BRYAN_LEWIS_DIFFUSIVITY", & + CS%Bryan_Lewis_diffusivity, & + "If true, use a Bryan & Lewis (JGR 1979) like tanh \n"//& + "profile of background diapycnal diffusivity with depth. \n"//& + "This is done via CVMix.", default=.false.) + + if (CS%Bryan_Lewis_diffusivity) then + + call get_param(param_file, mdl, "KD_BRYAN_LEWIS_DEEP", & + CS%Kd_Bryan_Lewis_deep, & + "The abyssal value of a Bryan-Lewis diffusivity profile.", & + units="m2 s-1", fail_if_missing=.true.) + + call get_param(param_file, mdl, "KD_BRYAN_LEWIS_SURFACE", & + CS%Kd_Bryan_Lewis_surface, & + "The surface value of a Bryan-Lewis diffusivity profile.", & + units="m2 s-1", fail_if_missing=.true.) + + call get_param(param_file, mdl, "BRYAN_LEWIS_DEPTH_CENT", & + CS%Bryan_Lewis_depth_cent, & + "The depth about which the transition in the Bryan-Lewis.", & + units="m", fail_if_missing=.true.) + + call get_param(param_file, mdl, "BRYAN_LEWIS_WIDTH_TRANS", & + CS%Bryan_Lewis_width_trans, & + "The width of the transition in the Bryan-Lewis.",& + units="m", fail_if_missing=.true.) + + endif ! CS%Bryan_Lewis_diffusivity + + call get_param(param_file, mdl, "HENYEY_IGW_BACKGROUND", & + CS%Henyey_IGW_background, & + "If true, use a latitude-dependent scaling for the near \n"//& + "surface background diffusivity, as described in \n"//& + "Harrison & Hallberg, JPO 2008.", default=.false.) + + call get_param(param_file, mdl, "HENYEY_IGW_BACKGROUND_NEW", & + CS%Henyey_IGW_background_new, & + "If true, use a better latitude-dependent scaling for the\n"//& + "background diffusivity, as described in \n"//& + "Harrison & Hallberg, JPO 2008.", default=.false.) + + if (CS%Henyey_IGW_background .and. CS%Henyey_IGW_background_new) & + call MOM_error(FATAL, "set_diffusivity_init: HENYEY_IGW_BACKGROUND and \n"//& + "HENYEY_IGW_BACKGROUND_NEW are mutually exclusive. Set only one or none.") + + if (CS%Henyey_IGW_background) & + call get_param(param_file, mdl, "HENYEY_N0_2OMEGA", CS%N0_2Omega, & + "The ratio of the typical Buoyancy frequency to twice \n"//& + "the Earth's rotation period, used with the Henyey \n"//& + "scaling from the mixing.", units="nondim", default=20.0) + + call get_param(param_file, mdl, "KD_TANH_LAT_FN", & + CS%Kd_tanh_lat_fn, & + "If true, use a tanh dependence of Kd_sfc on latitude, \n"//& + "like CM2.1/CM2M. There is no physical justification \n"//& + "for this form, and it can not be used with \n"//& + "HENYEY_IGW_BACKGROUND.", default=.false.) + + if (CS%Kd_tanh_lat_fn) & + call get_param(param_file, mdl, "KD_TANH_LAT_SCALE", & + CS%Kd_tanh_lat_scale, & + "A nondimensional scaling for the range ofdiffusivities \n"//& + "with KD_TANH_LAT_FN. Valid values are in the range of \n"//& + "-2 to 2; 0.4 reproduces CM2M.", units="nondim", default=0.0) + + if (CS%Henyey_IGW_background .and. CS%Kd_tanh_lat_fn) call MOM_error(FATAL, & + "MOM_bkgnd_mixing: KD_TANH_LAT_FN can not be used with HENYEY_IGW_BACKGROUND.") + + call closeParameterBlock(param_file) + + ! allocate arrays and set them to zero + allocate(CS%kd_bkgnd(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%kd_bkgnd(:,:,:) = 0. + allocate(CS%kv_bkgnd(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%kv_bkgnd(:,:,:) = 0. + + ! Register diagnostics + CS%diag => diag + CS%id_kd_bkgnd = register_diag_field('ocean_model', 'bkgnd_kd', diag%axesTi, Time, & + 'Background diffusivity added by MOM_bkgnd_mixing module', 'm2/s') + CS%id_kv_bkgnd = register_diag_field('ocean_model', 'bkgnd_kv', diag%axesTi, Time, & + 'Background viscosity added by MOM_bkgnd_mixing module', 'm2/s') + +end subroutine bkgnd_mixing_init + +!> Subroutine for calculating vertical background diffusivities/viscosities +subroutine calculate_bkgnd_mixing(h, tv, T_f, S_f, fluxes, G, GV, CS) + + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_f!< temperature (deg C), after massless + !! layers filled vertically by diffusion. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_f!< salinity, after massless + !! layers filled vertically by diffusion. + type(forcing), intent(in) :: fluxes !< Structure of surface fluxes that may be + !! used. + type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by + !! a previous call to bkgnd_mixing_init. + + ! local variables + real, dimension(SZI_(G), SZJ_(G)) :: Kd_sfc !< surface value of the diffusivity (m2/s) + real, dimension(SZI_(G)) :: & + depth_i, & !< distance from surface of an interface (meter) + N2_bot !< bottom squared buoyancy frequency (1/s2) + real, dimension(SZI_(G),SZK_(G)+1) :: & + N2_int, & !< squared buoyancy frequency associated at interfaces (1/s2) + dRho_int !< locally ref potential density difference across interfaces (in s-2) smg: or kg/m3? + real, dimension(SZI_(G),SZK_(G)) :: & + N2_lay !< squared buoyancy frequency associated with layers (1/s2) + + real, dimension(SZK_(G)) :: depth_k !< distance from surface of an interface (meter) + real :: I_x30 !< 2/acos(2) = 1/(sin(30 deg) * acosh(1/sin(30 deg))) + real :: deg_to_rad !< factor converting degrees to radians, pi/180. + real :: abs_sin !< absolute value of sine of latitude (nondim) + real :: depth_c !< depth of the center of a layer (meter) + real :: I_Hmix !< inverse of fixed mixed layer thickness (1/m) + real :: epsilon + real :: I_2Omega !< 1/(2 Omega) (sec) + real :: N_2Omega + real :: N02_N2 + integer :: i, j, k, is, ie, js, je, nz + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + + ! set some parameters + deg_to_rad = atan(1.0)/45.0 ! = PI/180 + epsilon = 1.e-10 + + if (CS%Bryan_Lewis_diffusivity) then +!$OMP parallel do default(none) shared(is,ie,js,je,nz, CS) +!$OMP private(cvmix_init_bkgnd,cvmix_coeffs_bkgnd) + + ! Bryan & Lewis is computed via CVMix + do j=js,je; do i=is,ie + + depth_k(:) = 0.0 + do k=1,nz + depth_k(k) = depth_k(k) + GV%H_to_m*h(i,j,k) + enddo + + call cvmix_init_bkgnd(max_nlev=nz, & + zw = depth_k(:), & !< interface depth, must be positive. + bl1 = CS%Kd_Bryan_Lewis_deep, & + bl2 = CS%Kd_Bryan_Lewis_surface, & + bl3 = 1.0/CS%Bryan_Lewis_depth_cent , & + bl4 = CS%Bryan_Lewis_width_trans, & + prandtl = CS%prandtl_turb) + + call cvmix_coeffs_bkgnd(Mdiff_out=CS%kv_bkgnd(i,j,:), & + Tdiff_out=CS%kd_bkgnd(i,j,:), & + nlev=nz, & + max_nlev=nz) + enddo; enddo + else +!$OMP parallel do default(none) shared(is,ie,js,je,CS,Kd_sfc) + do j=js,je ; do i=is,ie + Kd_sfc(i,j) = CS%Kd + enddo ; enddo + endif + + if (CS%Henyey_IGW_background) then + I_x30 = 2.0 / invcosh(CS%N0_2Omega*2.0) ! This is evaluated at 30 deg. +!$OMP parallel do default(none) +!shared(is,ie,js,je,Kd_sfc,CS,G,deg_to_rad,epsilon,I_x30) & +!$OMP private(abs_sin) + do j=js,je ; do i=is,ie + abs_sin = abs(sin(G%geoLatT(i,j)*deg_to_rad)) + Kd_sfc(i,j) = max(CS%Kd_min, Kd_sfc(i,j) * & + ((abs_sin * invcosh(CS%N0_2Omega/max(epsilon,abs_sin))) * I_x30) ) + enddo ; enddo + elseif (CS%Kd_tanh_lat_fn) then +!$OMP parallel do default(none) shared(is,ie,js,je,Kd_sfc,CS,G) + do j=js,je ; do i=is,ie + ! The transition latitude and latitude range are hard-scaled here, since + ! this is not really intended for wide-spread use, but rather for + ! comparison with CM2M / CM2.1 settings. + Kd_sfc(i,j) = max(CS%Kd_min, Kd_sfc(i,j) * (1.0 + & + CS%Kd_tanh_lat_scale * 0.5*tanh((abs(G%geoLatT(i,j)) - 35.0)/5.0) )) + enddo ; enddo + endif + +!$OMP parallel do default(none) +!shared(is,ie,js,je,nz,G,GV,CS,h,tv,T_f,S_f,fluxes,dd, & +!$OMP +!Kd,Kd_sfc,epsilon,deg_to_rad,I_2Omega,visc, & +!$OMP Kd_int,dt,u,v,Omega2) & +!$OMP +!private(dRho_int,I_trans,atan_fn_sfc,I_atan_fn,atan_fn_lay, & +!$OMP I_Hmix,depth_c,depth,N2_lay, N2_int, +!N2_bot, & +!$OMP I_x30,abs_sin,N_2Omega,N02_N2,KT_extra, +!KS_extra, & +!$OMP TKE_to_Kd,maxTKE,dissip,kb) + do j=js,je + ! Set up variables related to the stratification. + call find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, dRho_int, N2_lay, N2_int, N2_bot) + !if (associated(dd%N2_3d)) then + ! do K=1,nz+1 ; do i=is,ie ; dd%N2_3d(i,j,K) = N2_int(i,K) ; enddo ; enddo + !endif + + ! Set up the background diffusivity. + if ((.not. CS%Bryan_Lewis_diffusivity) .and. (.not.CS%bulkmixedlayer) .and. & + (CS%Kd/= CS%Kdml)) then + + I_Hmix = 1.0 / CS%Hmix + do i=is,ie ; depth_i(i) = 0.0 ; enddo + do k=1,nz ; do i=is,ie + depth_c = depth_i(i) + 0.5*GV%H_to_m*h(i,j,k) + + if (depth_c <= CS%Hmix) then ; CS%kd_bkgnd(i,j,k) = CS%Kdml + elseif (depth_c >= 2.0*CS%Hmix) then ; CS%kd_bkgnd(i,j,k) = Kd_sfc(i,j) + else + CS%kd_bkgnd(i,j,k) = ((Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & + (2.0*CS%Kdml - Kd_sfc(i,j)) + endif + + depth_i(i) = depth_i(i) + GV%H_to_m*h(i,j,k) + enddo ; enddo + elseif (CS%Henyey_IGW_background_new) then + I_x30 = 2.0 / invcosh(CS%N0_2Omega*2.0) ! This is evaluated at 30 deg. + do k=1,nz ; do i=is,ie + abs_sin = max(epsilon,abs(sin(G%geoLatT(i,j)*deg_to_rad))) + N_2Omega = max(abs_sin,sqrt(N2_lay(i,k))*I_2Omega) + N02_N2 = (CS%N0_2Omega/N_2Omega)**2 + CS%kd_bkgnd(i,j,k) = max(CS%Kd_min, Kd_sfc(i,j) * & + ((abs_sin * invcosh(N_2Omega/abs_sin)) * I_x30)*N02_N2) + enddo ; enddo + + else + do k=1,nz ; do i=is,ie + CS%kd_bkgnd(i,j,k) = Kd_sfc(i,j) + enddo ; enddo + endif + enddo ! j-loop + + if (CS%debug) then + call hchksum(Kd_sfc,"Kd_sfc",G%HI,haloshift=0) + call hchksum(CS%kd_bkgnd, "MOM_bkgnd_mixing: kd_bkgnd",G%HI,haloshift=0) + call hchksum(CS%kv_bkgnd, "MOM_bkgnd_mixing: kv_bkgnd",G%HI,haloshift=0) + endif + + ! send diagnostics to post_data + if (CS%id_kd_bkgnd > 0) call post_data(CS%id_kd_bkgnd, CS%kd_bkgnd, CS%diag) + if (CS%id_kv_bkgnd > 0) call post_data(CS%id_kv_bkgnd, CS%kv_bkgnd, CS%diag) + +end subroutine calculate_bkgnd_mixing + + +!> Computes N2 +subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, dRho_int, & + N2_lay, N2_int, N2_bot) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + type(thermo_var_ptrs), intent(in) :: tv + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_f, S_f + type(forcing), intent(in) :: fluxes + integer, intent(in) :: j + real, dimension(SZI_(G),SZK_(G)+1), intent(out) :: dRho_int, N2_int + real, dimension(SZI_(G),SZK_(G)), intent(out) :: N2_lay + real, dimension(SZI_(G)), intent(out) :: N2_bot + + real, dimension(SZI_(G),SZK_(G)+1) :: & + dRho_int_unfilt, & ! unfiltered density differences across interfaces + dRho_dT, & ! partial derivative of density wrt temp (kg m-3 degC-1) + dRho_dS ! partial derivative of density wrt saln (kg m-3 PPT-1) + + real, dimension(SZI_(G)) :: & + pres, & ! pressure at each interface (Pa) + Temp_int, & ! temperature at each interface (degC) + Salin_int, & ! salinity at each interface (PPT) + drho_bot, & + h_amp, & + hb, & + z_from_bot + + real :: Rml_base ! density of the deepest variable density layer + real :: dz_int ! thickness associated with an interface (meter) + real :: G_Rho0 ! gravitation acceleration divided by Bouss reference density (m4 s-2 kg-1) + real :: H_neglect ! negligibly small thickness, in the same units as h. + + logical :: do_i(SZI_(G)), do_any + integer :: i, k, is, ie, nz + + is = G%isc ; ie = G%iec ; nz = G%ke + G_Rho0 = GV%g_Earth / GV%Rho0 + H_neglect = GV%H_subroundoff + + ! Find the (limited) density jump across each interface. + do i=is,ie + dRho_int(i,1) = 0.0 ; dRho_int(i,nz+1) = 0.0 + dRho_int_unfilt(i,1) = 0.0 ; dRho_int_unfilt(i,nz+1) = 0.0 + enddo + if (associated(tv%eqn_of_state)) then + if (associated(fluxes%p_surf)) then + do i=is,ie ; pres(i) = fluxes%p_surf(i,j) ; enddo + else + do i=is,ie ; pres(i) = 0.0 ; enddo + endif + do K=2,nz + do i=is,ie + pres(i) = pres(i) + GV%H_to_Pa*h(i,j,k-1) + Temp_Int(i) = 0.5 * (T_f(i,j,k) + T_f(i,j,k-1)) + Salin_Int(i) = 0.5 * (S_f(i,j,k) + S_f(i,j,k-1)) + enddo + call calculate_density_derivs(Temp_int, Salin_int, pres, & + dRho_dT(:,K), dRho_dS(:,K), is, ie-is+1, tv%eqn_of_state) + do i=is,ie + dRho_int(i,K) = max(dRho_dT(i,K)*(T_f(i,j,k) - T_f(i,j,k-1)) + & + dRho_dS(i,K)*(S_f(i,j,k) - S_f(i,j,k-1)), 0.0) + dRho_int_unfilt(i,K) = max(dRho_dT(i,K)*(tv%T(i,j,k) - tv%T(i,j,k-1)) + & + dRho_dS(i,K)*(tv%S(i,j,k) - tv%S(i,j,k-1)), 0.0) + enddo + enddo + else + do K=2,nz ; do i=is,ie + dRho_int(i,K) = GV%Rlay(k) - GV%Rlay(k-1) + enddo ; enddo + endif + + ! Set the buoyancy frequencies. + do k=1,nz ; do i=is,ie + N2_lay(i,k) = G_Rho0 * 0.5*(dRho_int(i,K) + dRho_int(i,K+1)) / & + (GV%H_to_m*(h(i,j,k) + H_neglect)) + enddo ; enddo + do i=is,ie ; N2_int(i,1) = 0.0 ; N2_int(i,nz+1) = 0.0 ; enddo + do K=2,nz ; do i=is,ie + N2_int(i,K) = G_Rho0 * dRho_int(i,K) / & + (0.5*GV%H_to_m*(h(i,j,k-1) + h(i,j,k) + H_neglect)) + enddo ; enddo + + ! Find the bottom boundary layer stratification, and use this in the deepest layers. + do i=is,ie + hb(i) = 0.0 ; dRho_bot(i) = 0.0 + z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz) + do_i(i) = (G%mask2dT(i,j) > 0.5) + h_amp(i) = 0.0 + enddo + + do k=nz,2,-1 + do_any = .false. + do i=is,ie ; if (do_i(i)) then + dz_int = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j,k-1)) + z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above + + hb(i) = hb(i) + dz_int + dRho_bot(i) = dRho_bot(i) + dRho_int(i,K) + + if (z_from_bot(i) > h_amp(i)) then + if (k>2) then + ! Always include at least one full layer. + hb(i) = hb(i) + 0.5*GV%H_to_m*(h(i,j,k-1) + h(i,j,k-2)) + dRho_bot(i) = dRho_bot(i) + dRho_int(i,K-1) + endif + do_i(i) = .false. + else + do_any = .true. + endif + endif ; enddo + if (.not.do_any) exit + enddo + + do i=is,ie + if (hb(i) > 0.0) then + N2_bot(i) = (G_Rho0 * dRho_bot(i)) / hb(i) + else ; N2_bot(i) = 0.0 ; endif + z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz) + do_i(i) = (G%mask2dT(i,j) > 0.5) + enddo + + do k=nz,2,-1 + do_any = .false. + do i=is,ie ; if (do_i(i)) then + dz_int = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j,k-1)) + z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above + + N2_int(i,K) = N2_bot(i) + if (k>2) N2_lay(i,k-1) = N2_bot(i) + + if (z_from_bot(i) > h_amp(i)) then + if (k>2) N2_int(i,K-1) = N2_bot(i) + do_i(i) = .false. + else + do_any = .true. + endif + endif ; enddo + if (.not.do_any) exit + enddo + do i=is,ie + if (hb(i) > 0.0) then + N2_bot(i) = (G_Rho0 * dRho_bot(i)) / hb(i) + else ; N2_bot(i) = 0.0 ; endif + z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz) + do_i(i) = (G%mask2dT(i,j) > 0.5) + enddo + + do k=nz,2,-1 + do_any = .false. + do i=is,ie ; if (do_i(i)) then + dz_int = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j,k-1)) + z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above + + N2_int(i,K) = N2_bot(i) + if (k>2) N2_lay(i,k-1) = N2_bot(i) + + if (z_from_bot(i) > h_amp(i)) then + if (k>2) N2_int(i,K-1) = N2_bot(i) + do_i(i) = .false. + else + do_any = .true. + endif + endif ; enddo + if (.not.do_any) exit + enddo + + if (associated(tv%eqn_of_state)) then + do K=1,nz+1 ; do i=is,ie + dRho_int(i,K) = dRho_int_unfilt(i,K) + enddo ; enddo + endif + +end subroutine find_N2 + +!> Reads the parameter "USE_CVMIX_BACKGROUND" and returns state. +!! This function allows other modules to know whether this parameterization will +!! be used without needing to duplicate the log entry. +logical function cvmix_bkgnd_is_used(param_file) + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + call get_param(param_file, mdl, "USE_CVMIX_BACKGROUND", cvmix_bkgnd_is_used, & + default=.false., do_not_log = .true.) + +end function cvmix_bkgnd_is_used + +!> Clear pointers and dealocate memory +subroutine bkgnd_mixing_end(CS) + type(bkgnd_mixing_cs), pointer :: CS ! Control structure + + deallocate(CS%kd_bkgnd) + deallocate(CS%kv_bkgnd) + deallocate(CS) + +end subroutine bkgnd_mixing_end + + +end module MOM_bkgnd_mixing From 08db85c6c925cf4605b0a6aeb03701f553bf0bae Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 21 Mar 2018 18:32:50 -0600 Subject: [PATCH 0034/1072] Deleted code that has been moved to MOM_bkgnd_mixing.F90 --- .../vertical/MOM_set_diffusivity.F90 | 414 +----------------- 1 file changed, 24 insertions(+), 390 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 345f602902..fe07edea8a 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -21,6 +21,8 @@ module MOM_set_diffusivity use MOM_kappa_shear, only : calculate_kappa_shear, kappa_shear_init, Kappa_shear_CS use MOM_cvmix_shear, only : calculate_cvmix_shear, cvmix_shear_init, cvmix_shear_cs use MOM_cvmix_shear, only : cvmix_shear_end +use MOM_bkgnd_mixing, only : calculate_bkgnd_mixing, bkgnd_mixing_init, bkgnd_mixing_cs +use MOM_bkgnd_mixing, only : bkgnd_mixing_end use MOM_string_functions, only : uppercase use MOM_thickness_diffuse, only : vert_fill_TS use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d @@ -48,44 +50,6 @@ module MOM_set_diffusivity ! large enough that N2 > omega2. The full expression for ! the Flux Richardson number is usually ! FLUX_RI_MAX*N2/(N2+OMEGA2). The default is 0.2. - logical :: Henyey_IGW_background ! If true, use a simplified variant of the - ! Henyey et al, JGR (1986) latitudinal scaling for - ! the background diapycnal diffusivity, which gives - ! a marked decrease in the diffusivity near the - ! equator. The simplification here is to assume - ! that the in-situ stratification is the same as - ! the reference stratificaiton. - logical :: Henyey_IGW_background_new ! same as Henyey_IGW_background - ! but incorporate the effect of - ! stratification on TKE dissipation, - ! - ! e = f/f_0 * acosh(N/f) / acosh(N_0/f_0) * e_0 - ! - ! where e is the TKE dissipation, and N_0 and f_0 are the - ! reference buoyancy frequency and inertial frequencies respectively. - ! e_0 is the reference dissipation at (N_0,f_0). In the - ! previous version, N=N_0. - ! - ! Additionally, the squared inverse relationship between - ! diapycnal diffusivities and stratification is included - ! - ! kd = e/N^2 - ! - ! where kd is the diapycnal diffusivity. - ! This approach assumes that work done - ! against gravity is uniformly distributed - ! throughout the column. Whereas, kd=kd_0*e, - ! as in the original version, concentrates buoyancy - ! work in regions of strong stratification. - - logical :: Kd_tanh_lat_fn ! If true, use the tanh dependence of Kd_sfc on - ! latitude, like GFDL CM2.1/CM2M. There is no physical - ! justification for this form, and it can not be - ! used with Henyey_IGW_background. - real :: Kd_tanh_lat_scale ! A nondimensional scaling for the range of - ! diffusivities with Kd_tanh_lat_fn. Valid values - ! are in the range of -2 to 2; 0.4 reproduces CM2M. - logical :: bottomdraglaw ! If true, the bottom stress is calculated with a ! drag law c_drag*|u|*u. logical :: BBL_mixing_as_max ! If true, take the maximum of the diffusivity @@ -111,21 +75,6 @@ module MOM_set_diffusivity ! when bulkmixedlayer==.false. real :: Hmix ! mixed layer thickness (meter) when ! bulkmixedlayer==.false. - - logical :: Bryan_Lewis_diffusivity ! If true, background vertical diffusivity - ! uses Bryan-Lewis (1979) like tanh profile. - real :: Kd_Bryan_Lewis_deep ! abyssal value of Bryan-Lewis profile (m2/s) - real :: Kd_Bryan_Lewis_surface ! surface value of Bryan-Lewis profile (m2/s) - real :: Bryan_Lewis_depth_cent ! center of transition depth in Bryan-Lewis (meter) - real :: Bryan_Lewis_width_trans ! width of transition for Bryan-Lewis (meter) - - real :: N0_2Omega ! ratio of the typical Buoyancy frequency to - ! twice the Earth's rotation period, used with the - ! Henyey scaling from the mixing - real :: N2_FLOOR_IOMEGA2 ! floor applied to N2(k) scaled by Omega^2 - ! If =0., N2(k) is positive definite - ! If =1., N2(k) > Omega^2 everywhere - type(diag_ctrl), pointer :: diag ! structure to regulate diagn output timing real :: Int_tide_decay_scale ! decay scale for internal wave TKE (meter) @@ -243,6 +192,7 @@ module MOM_set_diffusivity type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() type(Kappa_shear_CS), pointer :: kappaShear_CSp => NULL() type(cvmix_shear_cs), pointer :: cvmix_shear_csp => NULL() + type(bkgnd_mixing_cs), pointer :: bkgnd_mixing_csp => NULL() type(int_tide_CS), pointer :: int_tide_CSp => NULL() integer :: id_TKE_itidal = -1 @@ -358,10 +308,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! local variables real, dimension(SZI_(G)) :: & - depth, & ! distance from surface of an interface (meter) N2_bot ! bottom squared buoyancy frequency (1/s2) - real, dimension(SZI_(G), SZJ_(G)) :: & - Kd_sfc ! surface value of the diffusivity (m2/s) type(diffusivity_diags) :: dd ! structure w/ arrays of pointers to avail diags @@ -382,22 +329,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & KT_extra, & ! double difusion diffusivity on temperature (m2/sec) KS_extra ! double difusion diffusivity on salinity (m2/sec) - real :: I_trans ! inverse of the transitional for Bryan-Lewis (1/m) - real :: depth_c ! depth of the center of a layer (meter) - real :: I_Hmix ! inverse of fixed mixed layer thickness (1/m) real :: I_Rho0 ! inverse of Boussinesq density (m3/kg) - real :: I_x30 ! 2/acos(2) = 1/(sin(30 deg) * acosh(1/sin(30 deg))) - real :: abs_sin ! absolute value of sine of latitude (nondim) - real :: atan_fn_sfc ! surface value of Bryan-Lewis profile (nondim) - real :: atan_fn_lay ! value of Bryan-Lewis profile in layer middle (nondim) - real :: I_atan_fn ! inverse of change in Bryan-Lewis profile from surface to infinite depth (nondim) - real :: deg_to_rad ! factor converting degrees to radians, pi/180. real :: dissip ! local variable for dissipation calculations (W/m3) real :: Omega2 ! squared absolute rotation rate (1/s2) - real :: I_2Omega ! 1/(2 Omega) (sec) - real :: N_2Omega - real :: N02_N2 - real :: epsilon logical :: use_EOS ! If true, compute density from T/S using equation of state. type(p3d) :: z_ptrs(6) ! pointers to diagns to be interpolated into depth space @@ -424,10 +358,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & I_Rho0 = 1.0/GV%Rho0 kappa_fill = 1.e-3 ! m2 s-1 dt_fill = 7200. - deg_to_rad = atan(1.0)/45.0 ! = PI/180 Omega2 = CS%Omega*CS%Omega - I_2Omega = 0.5/CS%Omega - epsilon = 1.e-10 use_EOS = associated(tv%eqn_of_state) @@ -548,42 +479,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & visc%Kv_turb(:,:,:) = 0. ! needed if calculate_kappa_shear is not enabled endif -! Calculate the diffusivity, Kd, for each layer. This would be -! the appropriate place to add a depth-dependent parameterization or -! another explicit parameterization of Kd. + ! Calculate the diffusivity, Kd, for each layer. This would be + ! the appropriate place to add a depth-dependent parameterization or + ! another explicit parameterization of Kd. - if (CS%Bryan_Lewis_diffusivity) then -!$OMP parallel do default(none) shared(is,ie,js,je,CS,Kd_sfc) - do j=js,je ; do i=is,ie - Kd_sfc(i,j) = CS%Kd_Bryan_Lewis_surface - enddo ; enddo - else -!$OMP parallel do default(none) shared(is,ie,js,je,CS,Kd_sfc) - do j=js,je ; do i=is,ie - Kd_sfc(i,j) = CS%Kd - enddo ; enddo - endif - if (CS%Henyey_IGW_background) then - I_x30 = 2.0 / invcosh(CS%N0_2Omega*2.0) ! This is evaluated at 30 deg. -!$OMP parallel do default(none) shared(is,ie,js,je,Kd_sfc,CS,G,deg_to_rad,epsilon,I_x30) & -!$OMP private(abs_sin) - do j=js,je ; do i=is,ie - abs_sin = abs(sin(G%geoLatT(i,j)*deg_to_rad)) - Kd_sfc(i,j) = max(CS%Kd_min, Kd_sfc(i,j) * & - ((abs_sin * invcosh(CS%N0_2Omega/max(epsilon,abs_sin))) * I_x30) ) - enddo ; enddo - elseif (CS%Kd_tanh_lat_fn) then -!$OMP parallel do default(none) shared(is,ie,js,je,Kd_sfc,CS,G) - do j=js,je ; do i=is,ie - ! The transition latitude and latitude range are hard-scaled here, since - ! this is not really intended for wide-spread use, but rather for - ! comparison with CM2M / CM2.1 settings. - Kd_sfc(i,j) = max(CS%Kd_min, Kd_sfc(i,j) * (1.0 + & - CS%Kd_tanh_lat_scale * 0.5*tanh((abs(G%geoLatT(i,j)) - 35.0)/5.0) )) - enddo ; enddo - endif + ! GMM, call MOM_bkgnd_mixing_calc here + call calculate_bkgnd_mixing(h, tv, T_f, S_f, fluxes, G, GV, CS%bkgnd_mixing_csp) + +! GMM, fix OMP calls below - if (CS%debug) call hchksum(Kd_sfc,"Kd_sfc",G%HI,haloshift=0) !$OMP parallel do default(none) shared(is,ie,js,je,nz,G,GV,CS,h,tv,T_f,S_f,fluxes,dd, & !$OMP Kd,Kd_sfc,epsilon,deg_to_rad,I_2Omega,visc, & !$OMP Kd_int,dt,u,v,Omega2) & @@ -592,59 +496,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & !$OMP I_x30,abs_sin,N_2Omega,N02_N2,KT_extra, KS_extra, & !$OMP TKE_to_Kd,maxTKE,dissip,kb) do j=js,je - ! Set up variables related to the stratification. - call find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, N2_lay, N2_int, N2_bot) - if (associated(dd%N2_3d)) then - do K=1,nz+1 ; do i=is,ie ; dd%N2_3d(i,j,K) = N2_int(i,K) ; enddo ; enddo - endif - - ! Set up the background diffusivity. - if (CS%Bryan_Lewis_diffusivity) then - I_trans = 1.0 / CS%Bryan_Lewis_width_trans - atan_fn_sfc = atan(CS%Bryan_Lewis_depth_cent*I_trans) - I_atan_fn = 1.0 / (2.0*atan(1.0) + atan_fn_sfc) - do i=is,ie ; depth(i) = 0.0 ; enddo - do k=1,nz ; do i=is,ie - atan_fn_lay = atan((CS%Bryan_Lewis_depth_cent - & - (depth(i)+0.5*GV%H_to_m*h(i,j,k)))*I_trans) - Kd(i,j,k) = Kd_sfc(i,j) + (CS%Kd_Bryan_Lewis_deep - Kd_sfc(i,j)) * & - (atan_fn_sfc - atan_fn_lay) * I_atan_fn - depth(i) = depth(i) + GV%H_to_m*h(i,j,k) - enddo ; enddo - elseif ((.not.CS%bulkmixedlayer) .and. (CS%Kd /= CS%Kdml)) then - I_Hmix = 1.0 / CS%Hmix - do i=is,ie ; depth(i) = 0.0 ; enddo - do k=1,nz ; do i=is,ie - depth_c = depth(i) + 0.5*GV%H_to_m*h(i,j,k) - - if (depth_c <= CS%Hmix) then ; Kd(i,j,k) = CS%Kdml - elseif (depth_c >= 2.0*CS%Hmix) then ; Kd(i,j,k) = Kd_sfc(i,j) - else - Kd(i,j,k) = ((Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & - (2.0*CS%Kdml - Kd_sfc(i,j)) - endif - - depth(i) = depth(i) + GV%H_to_m*h(i,j,k) - enddo ; enddo - elseif (CS%Henyey_IGW_background_new) then - I_x30 = 2.0 / invcosh(CS%N0_2Omega*2.0) ! This is evaluated at 30 deg. - do k=1,nz ; do i=is,ie - abs_sin = max(epsilon,abs(sin(G%geoLatT(i,j)*deg_to_rad))) - N_2Omega = max(abs_sin,sqrt(N2_lay(i,k))*I_2Omega) - N02_N2 = (CS%N0_2Omega/N_2Omega)**2 - Kd(i,j,k) = max(CS%Kd_min, Kd_sfc(i,j) * & - ((abs_sin * invcosh(N_2Omega/abs_sin)) * I_x30)*N02_N2) - enddo ; enddo - ! GMM, CVMix "internal" bg mixing can go here - !elseif (CS%use_cvmix_internal??) then - - - else - do k=1,nz ; do i=is,ie - Kd(i,j,k) = Kd_sfc(i,j) - enddo ; enddo - endif + ! Add vertical background diffusivities and viscosities + do k=1,nz ; do i=is,ie + ! diffusivities + Kd(i,j,k) = Kd(i,j,k) + 0.5*(CS%bkgnd_mixing_csp%kd_bkgnd(i,j,K) + CS%bkgnd_mixing_csp%kd_bkgnd(i,j,K+1)) + ! viscosities + ! GMM, will this be done here? + enddo ; enddo + ! GMM, the following will go into the MOM_cvmix_double_diffusion module if (CS%double_diffusion) then call double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, KT_extra, KS_extra) do K=2,nz ; do i=is,ie @@ -1105,159 +965,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & end subroutine find_TKE_to_Kd -subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & - N2_lay, N2_int, N2_bot) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(in) :: tv - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_f, S_f - type(forcing), intent(in) :: fluxes - integer, intent(in) :: j - type(set_diffusivity_CS), pointer :: CS - real, dimension(SZI_(G),SZK_(G)+1), intent(out) :: dRho_int, N2_int - real, dimension(SZI_(G),SZK_(G)), intent(out) :: N2_lay - real, dimension(SZI_(G)), intent(out) :: N2_bot - - real, dimension(SZI_(G),SZK_(G)+1) :: & - dRho_int_unfilt, & ! unfiltered density differences across interfaces - dRho_dT, & ! partial derivative of density wrt temp (kg m-3 degC-1) - dRho_dS ! partial derivative of density wrt saln (kg m-3 PPT-1) - - real, dimension(SZI_(G)) :: & - pres, & ! pressure at each interface (Pa) - Temp_int, & ! temperature at each interface (degC) - Salin_int, & ! salinity at each interface (PPT) - drho_bot, & - h_amp, & - hb, & - z_from_bot - - real :: Rml_base ! density of the deepest variable density layer - real :: dz_int ! thickness associated with an interface (meter) - real :: G_Rho0 ! gravitation acceleration divided by Bouss reference density (m4 s-2 kg-1) - real :: H_neglect ! negligibly small thickness, in the same units as h. - - logical :: do_i(SZI_(G)), do_any - integer :: i, k, is, ie, nz - - is = G%isc ; ie = G%iec ; nz = G%ke - G_Rho0 = GV%g_Earth / GV%Rho0 - H_neglect = GV%H_subroundoff - - ! Find the (limited) density jump across each interface. - do i=is,ie - dRho_int(i,1) = 0.0 ; dRho_int(i,nz+1) = 0.0 - dRho_int_unfilt(i,1) = 0.0 ; dRho_int_unfilt(i,nz+1) = 0.0 - enddo - if (associated(tv%eqn_of_state)) then - if (associated(fluxes%p_surf)) then - do i=is,ie ; pres(i) = fluxes%p_surf(i,j) ; enddo - else - do i=is,ie ; pres(i) = 0.0 ; enddo - endif - do K=2,nz - do i=is,ie - pres(i) = pres(i) + GV%H_to_Pa*h(i,j,k-1) - Temp_Int(i) = 0.5 * (T_f(i,j,k) + T_f(i,j,k-1)) - Salin_Int(i) = 0.5 * (S_f(i,j,k) + S_f(i,j,k-1)) - enddo - call calculate_density_derivs(Temp_int, Salin_int, pres, & - dRho_dT(:,K), dRho_dS(:,K), is, ie-is+1, tv%eqn_of_state) - do i=is,ie - dRho_int(i,K) = max(dRho_dT(i,K)*(T_f(i,j,k) - T_f(i,j,k-1)) + & - dRho_dS(i,K)*(S_f(i,j,k) - S_f(i,j,k-1)), 0.0) - dRho_int_unfilt(i,K) = max(dRho_dT(i,K)*(tv%T(i,j,k) - tv%T(i,j,k-1)) + & - dRho_dS(i,K)*(tv%S(i,j,k) - tv%S(i,j,k-1)), 0.0) - enddo - enddo - else - do K=2,nz ; do i=is,ie - dRho_int(i,K) = GV%Rlay(k) - GV%Rlay(k-1) - enddo ; enddo - endif - - ! Set the buoyancy frequencies. - do k=1,nz ; do i=is,ie - N2_lay(i,k) = G_Rho0 * 0.5*(dRho_int(i,K) + dRho_int(i,K+1)) / & - (GV%H_to_m*(h(i,j,k) + H_neglect)) - enddo ; enddo - do i=is,ie ; N2_int(i,1) = 0.0 ; N2_int(i,nz+1) = 0.0 ; enddo - do K=2,nz ; do i=is,ie - N2_int(i,K) = G_Rho0 * dRho_int(i,K) / & - (0.5*GV%H_to_m*(h(i,j,k-1) + h(i,j,k) + H_neglect)) - enddo ; enddo - - ! Find the bottom boundary layer stratification, and use this in the deepest layers. - do i=is,ie - hb(i) = 0.0 ; dRho_bot(i) = 0.0 - z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz) - do_i(i) = (G%mask2dT(i,j) > 0.5) - - if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation) then - h_amp(i) = sqrt(CS%h2(i,j)) ! for computing Nb - else - h_amp(i) = 0.0 - endif - enddo - - do k=nz,2,-1 - do_any = .false. - do i=is,ie ; if (do_i(i)) then - dz_int = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j,k-1)) - z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above - - hb(i) = hb(i) + dz_int - dRho_bot(i) = dRho_bot(i) + dRho_int(i,K) - - if (z_from_bot(i) > h_amp(i)) then - if (k>2) then - ! Always include at least one full layer. - hb(i) = hb(i) + 0.5*GV%H_to_m*(h(i,j,k-1) + h(i,j,k-2)) - dRho_bot(i) = dRho_bot(i) + dRho_int(i,K-1) - endif - do_i(i) = .false. - else - do_any = .true. - endif - endif ; enddo - if (.not.do_any) exit - enddo - - do i=is,ie - if (hb(i) > 0.0) then - N2_bot(i) = (G_Rho0 * dRho_bot(i)) / hb(i) - else ; N2_bot(i) = 0.0 ; endif - z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz) - do_i(i) = (G%mask2dT(i,j) > 0.5) - enddo - - do k=nz,2,-1 - do_any = .false. - do i=is,ie ; if (do_i(i)) then - dz_int = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j,k-1)) - z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above - - N2_int(i,K) = N2_bot(i) - if (k>2) N2_lay(i,k-1) = N2_bot(i) - - if (z_from_bot(i) > h_amp(i)) then - if (k>2) N2_int(i,K-1) = N2_bot(i) - do_i(i) = .false. - else - do_any = .true. - endif - endif ; enddo - if (.not.do_any) exit - enddo - - if (associated(tv%eqn_of_state)) then - do K=1,nz+1 ; do i=is,ie - dRho_int(i,K) = dRho_int_unfilt(i,K) - enddo ; enddo - endif - -end subroutine find_N2 +! GMM, the following will be moved to a new module !> This subroutine sets the additional diffusivities of temperature and !! salinity due to double diffusion, using the same functional form as is @@ -2248,6 +1956,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, endif ! Polzin end subroutine add_int_tide_diffusivity + !> This subroutine calculates several properties related to bottom !! boundary layer turbulence. subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) @@ -2666,79 +2375,8 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp "for an isopycnal layer-formulation.", & default=.false.) - call get_param(param_file, mdl, "BRYAN_LEWIS_DIFFUSIVITY", & - CS%Bryan_Lewis_diffusivity, & - "If true, use a Bryan & Lewis (JGR 1979) like tanh \n"//& - "profile of background diapycnal diffusivity with depth.", & - default=.false.) - if (CS%Bryan_Lewis_diffusivity) then - call get_param(param_file, mdl, "KD_BRYAN_LEWIS_DEEP", & - CS%Kd_Bryan_Lewis_deep, & - "The abyssal value of a Bryan-Lewis diffusivity profile. \n"//& - "KD_BRYAN_LEWIS_DEEP is only used if \n"//& - "BRYAN_LEWIS_DIFFUSIVITY is true.", units="m2 s-1", & - fail_if_missing=.true.) - call get_param(param_file, mdl, "KD_BRYAN_LEWIS_SURFACE", & - CS%Kd_Bryan_Lewis_surface, & - "The surface value of a Bryan-Lewis diffusivity profile. \n"//& - "KD_BRYAN_LEWIS_SURFACE is only used if \n"//& - "BRYAN_LEWIS_DIFFUSIVITY is true.", units="m2 s-1", & - fail_if_missing=.true.) - call get_param(param_file, mdl, "BRYAN_LEWIS_DEPTH_CENT", & - CS%Bryan_Lewis_depth_cent, & - "The depth about which the transition in the Bryan-Lewis \n"//& - "profile is centered. BRYAN_LEWIS_DEPTH_CENT is only \n"//& - "used if BRYAN_LEWIS_DIFFUSIVITY is true.", units="m", & - fail_if_missing=.true.) - call get_param(param_file, mdl, "BRYAN_LEWIS_WIDTH_TRANS", & - CS%Bryan_Lewis_width_trans, & - "The width of the transition in the Bryan-Lewis \n"//& - "profile. BRYAN_LEWIS_WIDTH_TRANS is only \n"//& - "used if BRYAN_LEWIS_DIFFUSIVITY is true.", units="m", & - fail_if_missing=.true.) - endif - - call get_param(param_file, mdl, "HENYEY_IGW_BACKGROUND", & - CS%Henyey_IGW_background, & - "If true, use a latitude-dependent scaling for the near \n"//& - "surface background diffusivity, as described in \n"//& - "Harrison & Hallberg, JPO 2008.", default=.false.) - call get_param(param_file, mdl, "HENYEY_IGW_BACKGROUND_NEW", & - CS%Henyey_IGW_background_new, & - "If true, use a better latitude-dependent scaling for the\n"//& - "background diffusivity, as described in \n"//& - "Harrison & Hallberg, JPO 2008.", default=.false.) - if (CS%Henyey_IGW_background .and. CS%Henyey_IGW_background_new) call MOM_error(FATAL, & - "set_diffusivity_init: HENYEY_IGW_BACKGROUND and HENYEY_IGW_BACKGROUND_NEW "// & - "are mutually exclusive. Set only one or none.") - if (CS%Henyey_IGW_background) & - call get_param(param_file, mdl, "HENYEY_N0_2OMEGA", CS%N0_2Omega, & - "The ratio of the typical Buoyancy frequency to twice \n"//& - "the Earth's rotation period, used with the Henyey \n"//& - "scaling from the mixing.", units="nondim", default=20.0) - call get_param(param_file, mdl, "N2_FLOOR_IOMEGA2", CS%N2_FLOOR_IOMEGA2, & - "The floor applied to N2(k) scaled by Omega^2:\n"//& - "\tIf =0., N2(k) is simply positive definite.\n"//& - "\tIf =1., N2(k) > Omega^2 everywhere.", units="nondim", & - default=1.0) - - call get_param(param_file, mdl, "KD_TANH_LAT_FN", & - CS%Kd_tanh_lat_fn, & - "If true, use a tanh dependence of Kd_sfc on latitude, \n"//& - "like CM2.1/CM2M. There is no physical justification \n"//& - "for this form, and it can not be used with \n"//& - "HENYEY_IGW_BACKGROUND.", default=.false.) - if (CS%Kd_tanh_lat_fn) & - call get_param(param_file, mdl, "KD_TANH_LAT_SCALE", & - CS%Kd_tanh_lat_scale, & - "A nondimensional scaling for the range ofdiffusivities \n"//& - "with KD_TANH_LAT_FN. Valid values are in the range of \n"//& - "-2 to 2; 0.4 reproduces CM2M.", units="nondim", default=0.0) - - call get_param(param_file, mdl, "KV", CS%Kv, & - "The background kinematic viscosity in the interior. \n"//& - "The molecular value, ~1e-6 m2 s-1, may be used.", & - units="m2 s-1", fail_if_missing=.true.) + ! set params releted to the background mixing + call bkgnd_mixing_init(Time, G, GV, param_file, CS%diag, CS%bkgnd_mixing_csp) call get_param(param_file, mdl, "KD", CS%Kd, & "The background diapycnal diffusivity of density in the \n"//& @@ -3130,12 +2768,6 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp endif endif - if (CS%Int_tide_dissipation .and. CS%Bryan_Lewis_diffusivity) & - call MOM_error(FATAL,"MOM_Set_Diffusivity: "// & - "Bryan-Lewis and internal tidal dissipation are both enabled. Choose one.") - if (CS%Henyey_IGW_background .and. CS%Kd_tanh_lat_fn) call MOM_error(FATAL, & - "Set_diffusivity: KD_TANH_LAT_FN can not be used with HENYEY_IGW_BACKGROUND.") - if (CS%user_change_diff) then call user_change_diff_init(Time, G, param_file, diag, CS%user_change_diff_CSp) endif @@ -3153,6 +2785,8 @@ end subroutine set_diffusivity_init subroutine set_diffusivity_end(CS) type(set_diffusivity_CS), pointer :: CS !< Control structure for this module + call bkgnd_mixing_end(CS%bkgnd_mixing_csp) + if (CS%user_change_diff) & call user_change_diff_end(CS%user_change_diff_CSp) From 8ef5a1b93d03957b895221ac4db08bbb0025e7d9 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 23 Mar 2018 15:06:41 -0600 Subject: [PATCH 0035/1072] Renamed Bryan&Lewis coeffs and added a 3D array for depth --- .../vertical/MOM_bkgnd_mixing.F90 | 104 +++++++++--------- 1 file changed, 53 insertions(+), 51 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 3ad9dfd638..e561b75a3e 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -11,6 +11,7 @@ module MOM_bkgnd_mixing use MOM_variables, only : thermo_var_ptrs use MOM_forcing_type, only : forcing use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE +use MOM_error_handler, only : is_root_pe use MOM_file_parser, only : openParameterBlock, closeParameterBlock use MOM_debugging, only : hchksum use MOM_grid, only : ocean_grid_type @@ -29,13 +30,14 @@ module MOM_bkgnd_mixing type, public :: bkgnd_mixing_cs ! Parameters - real :: Kd_Bryan_Lewis_deep !< The abyssal value of a Bryan-Lewis diffusivity profile - !! (m2/s) - real :: Kd_Bryan_Lewis_surface !< "The surface value of a Bryan-Lewis diffusivity profile - !! (m2/s) - real :: Bryan_Lewis_depth_cent !< The depth about which the transition in the Bryan-Lewis - !! is centered (m) - real :: Bryan_Lewis_width_trans!< The width of the transition in the Bryan-Lewis profile (m) + real :: Bryan_Lewis_c1 !< The vertical diffusivity values for Bryan-Lewis profile + !! at |z|=D (m2/s) + real :: Bryan_Lewis_c2 !< The amplitude of variation in diffusivity for the + !! Bryan-Lewis diffusivity profile (m2/s) + real :: Bryan_Lewis_c3 !< The inverse length scale for transition region in the + !! Bryan-Lewis diffusivity profile (1/m) + real :: Bryan_Lewis_c4 !< The depth where diffusivity is Bryan_Lewis_bl1 in the + !! Bryan-Lewis profile (m) real :: Kd_min !< minimum diapycnal diffusivity (m2/s) real :: Kd !< interior diapycnal diffusivity (m2/s) real :: N0_2Omega !< ratio of the typical Buoyancy frequency to @@ -153,7 +155,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "PRANDTL_TURB", CS%prandtl_turb, & units="nondim", default=1.0, do_not_log=.true.) - call openParameterBlock(param_file,'MOM_BACKGROUND_MIXING') +! call openParameterBlock(param_file,'MOM_BACKGROUND_MIXING') call get_param(param_file, mdl, "BRYAN_LEWIS_DIFFUSIVITY", & CS%Bryan_Lewis_diffusivity, & @@ -163,24 +165,24 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) if (CS%Bryan_Lewis_diffusivity) then - call get_param(param_file, mdl, "KD_BRYAN_LEWIS_DEEP", & - CS%Kd_Bryan_Lewis_deep, & - "The abyssal value of a Bryan-Lewis diffusivity profile.", & + call get_param(param_file, mdl, "BRYAN_LEWIS_C1", & + CS%Bryan_Lewis_c1, & + "The vertical diffusivity values for Bryan-Lewis profile at |z|=D.", & units="m2 s-1", fail_if_missing=.true.) - call get_param(param_file, mdl, "KD_BRYAN_LEWIS_SURFACE", & - CS%Kd_Bryan_Lewis_surface, & - "The surface value of a Bryan-Lewis diffusivity profile.", & + call get_param(param_file, mdl, "BRYAN_LEWIS_C2", & + CS%Bryan_Lewis_c2, & + "The amplitude of variation in diffusivity for the Bryan-Lewis profile", & units="m2 s-1", fail_if_missing=.true.) - call get_param(param_file, mdl, "BRYAN_LEWIS_DEPTH_CENT", & - CS%Bryan_Lewis_depth_cent, & - "The depth about which the transition in the Bryan-Lewis.", & - units="m", fail_if_missing=.true.) + call get_param(param_file, mdl, "BRYAN_LEWIS_C3", & + CS%Bryan_Lewis_c3, & + "The inverse length scale for transition region in the Bryan-Lewis profile", & + units="m-1", fail_if_missing=.true.) - call get_param(param_file, mdl, "BRYAN_LEWIS_WIDTH_TRANS", & - CS%Bryan_Lewis_width_trans, & - "The width of the transition in the Bryan-Lewis.",& + call get_param(param_file, mdl, "BRYAN_LEWIS_C4", & + CS%Bryan_Lewis_c4, & + "The depth where diffusivity is BRYAN_LEWIS_C1 in the Bryan-Lewis profile",& units="m", fail_if_missing=.true.) endif ! CS%Bryan_Lewis_diffusivity @@ -224,7 +226,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) if (CS%Henyey_IGW_background .and. CS%Kd_tanh_lat_fn) call MOM_error(FATAL, & "MOM_bkgnd_mixing: KD_TANH_LAT_FN can not be used with HENYEY_IGW_BACKGROUND.") - call closeParameterBlock(param_file) +! call closeParameterBlock(param_file) ! allocate arrays and set them to zero allocate(CS%kd_bkgnd(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%kd_bkgnd(:,:,:) = 0. @@ -232,9 +234,9 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) ! Register diagnostics CS%diag => diag - CS%id_kd_bkgnd = register_diag_field('ocean_model', 'bkgnd_kd', diag%axesTi, Time, & + CS%id_kd_bkgnd = register_diag_field('ocean_model', 'Kd_bkgnd', diag%axesTi, Time, & 'Background diffusivity added by MOM_bkgnd_mixing module', 'm2/s') - CS%id_kv_bkgnd = register_diag_field('ocean_model', 'bkgnd_kv', diag%axesTi, Time, & + CS%id_kv_bkgnd = register_diag_field('ocean_model', 'Kv_bkgnd', diag%axesTi, Time, & 'Background viscosity added by MOM_bkgnd_mixing module', 'm2/s') end subroutine bkgnd_mixing_init @@ -256,6 +258,7 @@ subroutine calculate_bkgnd_mixing(h, tv, T_f, S_f, fluxes, G, GV, CS) !! a previous call to bkgnd_mixing_init. ! local variables + real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: depth_3d !< distance from surface of an interface (m) real, dimension(SZI_(G), SZJ_(G)) :: Kd_sfc !< surface value of the diffusivity (m2/s) real, dimension(SZI_(G)) :: & depth_i, & !< distance from surface of an interface (meter) @@ -284,32 +287,7 @@ subroutine calculate_bkgnd_mixing(h, tv, T_f, S_f, fluxes, G, GV, CS) deg_to_rad = atan(1.0)/45.0 ! = PI/180 epsilon = 1.e-10 - if (CS%Bryan_Lewis_diffusivity) then -!$OMP parallel do default(none) shared(is,ie,js,je,nz, CS) -!$OMP private(cvmix_init_bkgnd,cvmix_coeffs_bkgnd) - - ! Bryan & Lewis is computed via CVMix - do j=js,je; do i=is,ie - - depth_k(:) = 0.0 - do k=1,nz - depth_k(k) = depth_k(k) + GV%H_to_m*h(i,j,k) - enddo - - call cvmix_init_bkgnd(max_nlev=nz, & - zw = depth_k(:), & !< interface depth, must be positive. - bl1 = CS%Kd_Bryan_Lewis_deep, & - bl2 = CS%Kd_Bryan_Lewis_surface, & - bl3 = 1.0/CS%Bryan_Lewis_depth_cent , & - bl4 = CS%Bryan_Lewis_width_trans, & - prandtl = CS%prandtl_turb) - - call cvmix_coeffs_bkgnd(Mdiff_out=CS%kv_bkgnd(i,j,:), & - Tdiff_out=CS%kd_bkgnd(i,j,:), & - nlev=nz, & - max_nlev=nz) - enddo; enddo - else + if (.not. CS%Bryan_Lewis_diffusivity) then !$OMP parallel do default(none) shared(is,ie,js,je,CS,Kd_sfc) do j=js,je ; do i=is,ie Kd_sfc(i,j) = CS%Kd @@ -349,6 +327,8 @@ subroutine calculate_bkgnd_mixing(h, tv, T_f, S_f, fluxes, G, GV, CS) !$OMP I_x30,abs_sin,N_2Omega,N02_N2,KT_extra, !KS_extra, & !$OMP TKE_to_Kd,maxTKE,dissip,kb) + + depth_3d(:,:,:) = 0.0 do j=js,je ! Set up variables related to the stratification. call find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, dRho_int, N2_lay, N2_int, N2_bot) @@ -357,7 +337,29 @@ subroutine calculate_bkgnd_mixing(h, tv, T_f, S_f, fluxes, G, GV, CS) !endif ! Set up the background diffusivity. - if ((.not. CS%Bryan_Lewis_diffusivity) .and. (.not.CS%bulkmixedlayer) .and. & + if (CS%Bryan_Lewis_diffusivity) then + + do i=is,ie + !depth_k(:) = 0.0 + do k=2,nz+1 + depth_3d(i,j,k) = depth_3d(i,j,k-1) + GV%H_to_m*h(i,j,k-1) + enddo + ! if (is_root_pe()) write(*,*)'depth_3d(i,j,:)',depth_3d(i,j,:) + + call cvmix_init_bkgnd(max_nlev=nz, & + zw = depth_3d(i,j,:), & !< interface depth, must bepositive. + bl1 = CS%Bryan_Lewis_c1, & + bl2 = CS%Bryan_Lewis_c2, & + bl3 = CS%Bryan_Lewis_c3, & + bl4 = CS%Bryan_Lewis_c4, & + prandtl = CS%prandtl_turb) + + call cvmix_coeffs_bkgnd(Mdiff_out=CS%kv_bkgnd(i,j,:), & + Tdiff_out=CS%kd_bkgnd(i,j,:), & + nlev=nz, & + max_nlev=nz) + enddo + elseif ((.not. CS%Bryan_Lewis_diffusivity) .and. (.not.CS%bulkmixedlayer) .and. & (CS%Kd/= CS%Kdml)) then I_Hmix = 1.0 / CS%Hmix From 4e8dd5a9bacbc47988d2fd99b50defc00580948e Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 23 Mar 2018 15:07:41 -0600 Subject: [PATCH 0036/1072] Added a if statement to check if Int_tide_dissipation and Bryan_Lewis are used at the same time. --- src/parameterizations/vertical/MOM_set_diffusivity.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index fe07edea8a..c127ad9a72 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -2772,6 +2772,10 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp call user_change_diff_init(Time, G, param_file, diag, CS%user_change_diff_CSp) endif + if (CS%Int_tide_dissipation .and. CS%bkgnd_mixing_csp%Bryan_Lewis_diffusivity) & + call MOM_error(FATAL,"MOM_Set_Diffusivity: "// & + "Bryan-Lewis and internal tidal dissipation are both enabled. Choose one.") + CS%useKappaShear = kappa_shear_init(Time, G, GV, param_file, CS%diag, CS%kappaShear_CSp) if (CS%useKappaShear) & id_clock_kappaShear = cpu_clock_id('(Ocean kappa_shear)', grain=CLOCK_MODULE) From f361002d10567ba00cdc27aec84d95adbd563acc Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Mon, 26 Mar 2018 09:41:56 -0600 Subject: [PATCH 0037/1072] Read in tidal energy dissipation --- .../vertical/MOM_tidal_mixing.F90 | 183 +++++++++++++----- 1 file changed, 130 insertions(+), 53 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 0201dd3476..9ccec3c141 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -31,57 +31,69 @@ module MOM_tidal_mixing logical :: debug = .true. ! Parameters - logical :: int_tide_dissipation ! Internal tide conversion (from barotropic) with - ! the schemes of St Laurent et al (2002)/ - ! Simmons et al (2004) + logical :: int_tide_dissipation ! Internal tide conversion (from barotropic) with + ! the schemes of St Laurent et al (2002)/ + ! Simmons et al (2004) + integer :: Int_tide_profile ! A coded integer indicating the vertical profile ! for dissipation of the internal waves. Schemes that ! are currently encoded are St Laurent et al (2002) and ! Polzin (2009). logical :: Lee_wave_dissipation ! Enable lee-wave driven mixing, following - ! Nikurashin (2010), with a vertical energy - ! deposition profile specified by Lee_wave_profile. - ! St Laurent et al (2002) or - ! Simmons et al (2004) scheme + ! Nikurashin (2010), with a vertical energy + ! deposition profile specified by Lee_wave_profile. + ! St Laurent et al (2002) or + ! Simmons et al (2004) scheme + integer :: Lee_wave_profile ! A coded integer indicating the vertical profile ! for dissipation of the lee waves. Schemes that are ! currently encoded are St Laurent et al (2002) and ! Polzin (2009). real :: Int_tide_decay_scale ! decay scale for internal wave TKE (meter) - real :: Mu_itides ! efficiency for conversion of dissipation - ! to potential energy (nondimensional) - real :: Gamma_itides ! fraction of local dissipation (nondimensional) - real :: Gamma_lee ! fraction of local dissipation for lee waves - ! (Nikurashin's energy input) (nondimensional) + + real :: Mu_itides ! efficiency for conversion of dissipation + ! to potential energy (nondimensional) + + real :: Gamma_itides ! fraction of local dissipation (nondimensional) + + real :: Gamma_lee ! fraction of local dissipation for lee waves + ! (Nikurashin's energy input) (nondimensional) real :: Decay_scale_factor_lee ! Scaling factor for the decay scale of lee - ! wave energy dissipation (nondimensional) - real :: min_zbot_itides ! minimum depth for internal tide conversion (meter) + ! wave energy dissipation (nondimensional) + + real :: min_zbot_itides ! minimum depth for internal tide conversion (meter) logical :: Lowmode_itidal_dissipation ! Internal tide conversion (from low modes) with - ! the schemes of St Laurent et al (2002)/ - ! Simmons et al (2004) !BDM - real :: Nu_Polzin ! The non-dimensional constant used in Polzin form of - ! the vertical scale of decay of tidal dissipation - real :: Nbotref_Polzin ! Reference value for the buoyancy frequency at the - ! ocean bottom used in Polzin formulation of the - ! vertical scale of decay of tidal dissipation (1/s) + ! the schemes of St Laurent et al (2002)/ + ! Simmons et al (2004) !BDM + + real :: Nu_Polzin ! The non-dimensional constant used in Polzin form of + ! the vertical scale of decay of tidal dissipation + + real :: Nbotref_Polzin ! Reference value for the buoyancy frequency at the + ! ocean bottom used in Polzin formulation of the + ! vertical scale of decay of tidal dissipation (1/s) real :: Polzin_decay_scale_factor ! Scaling factor for the decay length scale - ! of the tidal dissipation profile in Polzin - ! (nondimensional) + ! of the tidal dissipation profile in Polzin + ! (nondimensional) real :: Polzin_decay_scale_max_factor ! The decay length scale of tidal - ! dissipation profile in Polzin formulation should not - ! exceed Polzin_decay_scale_max_factor * depth of the - ! ocean (nondimensional). + ! dissipation profile in Polzin formulation should not + ! exceed Polzin_decay_scale_max_factor * depth of the + ! ocean (nondimensional). real :: Polzin_min_decay_scale ! minimum decay scale of the tidal dissipation - ! profile in Polzin formulation (meter) + ! profile in Polzin formulation (meter) + real :: TKE_itide_max ! maximum internal tide conversion (W m-2) ! available to mix above the BBL + real :: utide ! constant tidal amplitude (m s-1) used if - ! tidal amplitude file is not present real :: kappa_itides ! topographic wavenumber and non-dimensional scaling real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height character(len=200) :: inputdir - real :: tidal_max_coef !< maximum allowable tidal diffusivity. [m^2/s] + logical :: use_cvmix_tidal ! true if cvmix is to be used for determining diffusivity + ! due to tidal mixing + + real :: tidal_max_coef ! maximum allowable tidal diffusivity. [m^2/s] real, pointer, dimension(:,:) :: TKE_Niku => NULL() real, pointer, dimension(:,:) :: TKE_itidal => NULL() @@ -89,6 +101,7 @@ module MOM_tidal_mixing real, pointer, dimension(:,:) :: mask_itidal => NULL() real, pointer, dimension(:,:) :: h2 => NULL() real, pointer, dimension(:,:) :: tideamp => NULL() ! RMS tidal amplitude (m/s) + real, pointer, dimension(:,:) :: tidal_energy_flux_2d => NULL() end type tidal_mixing_cs @@ -117,8 +130,12 @@ module MOM_tidal_mixing character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name. character*(20), parameter :: STLAURENT_PROFILE_STRING = "STLAURENT_02" character*(20), parameter :: POLZIN_PROFILE_STRING = "POLZIN_09" +character*(20), parameter :: SIMMONS_PROFILE_STRING = "Simmons" +character*(20), parameter :: SCHMITTNER_PROFILE_STRING = "Schmittner" integer, parameter :: STLAURENT_02 = 1 integer, parameter :: POLZIN_09 = 2 +integer, parameter :: SIMMONS_04 = 3 +integer, parameter :: SCHMITTNER = 4 contains @@ -133,7 +150,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) ! Local variables logical :: read_tideamp - character(len=20) :: tmpstr + character(len=20) :: tmpstr, int_tide_profile_str character(len=200) :: filename, tideamp_file, h2_file, Niku_TKE_input_file real :: utide, zbot, hamp real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data @@ -158,6 +175,10 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) ! Read parameters call log_version(param_file, mdl, version, & "Vertical Tidal Mixing Parameterization") + call get_param(param_file, mdl, "USE_CVMIX_TIDAL", CS%use_cvmix_tidal, & + "If true, turns on tidal mixing scheme via CVMix", & + default=.false.) + call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, default=".",do_not_log=.true.) CS%inputdir = slasher(CS%inputdir) call get_param(param_file, mdl, "INT_TIDE_DISSIPATION", CS%int_tide_dissipation, & @@ -165,7 +186,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) "drive diapycnal mixing, along the lines of St. Laurent \n"//& "et al. (2002) and Simmons et al. (2004).", default=.false.) if (CS%int_tide_dissipation) then - call get_param(param_file, mdl, "INT_TIDE_PROFILE", tmpstr, & + call get_param(param_file, mdl, "INT_TIDE_PROFILE", int_tide_profile_str, & "INT_TIDE_PROFILE selects the vertical profile of energy \n"//& "dissipation with INT_TIDE_DISSIPATION. Valid values are:\n"//& "\t STLAURENT_02 - Use the St. Laurent et al exponential \n"//& @@ -173,13 +194,16 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) "\t POLZIN_09 - Use the Polzin WKB-streched algebraic \n"//& "\t decay profile.", & default=STLAURENT_PROFILE_STRING) - tmpstr = uppercase(tmpstr) - select case (tmpstr) - case (STLAURENT_PROFILE_STRING) ; CS%int_tide_profile = STLAURENT_02 - case (POLZIN_PROFILE_STRING) ; CS%int_tide_profile = POLZIN_09 + ! TODO: list the newly available profile selections + int_tide_profile_str = uppercase(int_tide_profile_str) + select case (int_tide_profile_str) + case (STLAURENT_PROFILE_STRING) ; CS%int_tide_profile = STLAURENT_02 + case (POLZIN_PROFILE_STRING) ; CS%int_tide_profile = POLZIN_09 + case (SIMMONS_PROFILE_STRING) ; CS%int_tide_profile = SIMMONS_04 + case (SCHMITTNER_PROFILE_STRING) ; CS%int_tide_profile = SCHMITTNER case default - call MOM_error(FATAL, "set_diffusivity_init: Unrecognized setting "// & - "#define INT_TIDE_PROFILE "//trim(tmpstr)//" found in input file.") + call MOM_error(FATAL, "tidal_mixing_init: Unrecognized setting "// & + "#define INT_TIDE_PROFILE "//trim(int_tide_profile_str)//" found in input file.") end select endif @@ -202,7 +226,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) case (STLAURENT_PROFILE_STRING) ; CS%lee_wave_profile = STLAURENT_02 case (POLZIN_PROFILE_STRING) ; CS%lee_wave_profile = POLZIN_09 case default - call MOM_error(FATAL, "set_diffusivity_init: Unrecognized setting "// & + call MOM_error(FATAL, "tidal_mixing_init: Unrecognized setting "// & "#define LEE_WAVE_PROFILE "//trim(tmpstr)//" found in input file.") end select endif @@ -301,7 +325,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "H2_FILE", h2_file, & "The path to the file containing the sub-grid-scale \n"//& "topographic roughness amplitude with INT_TIDE_DISSIPATION.", & - fail_if_missing=.true.) + fail_if_missing=(.not.CS%use_cvmix_tidal)) filename = trim(CS%inputdir) // trim(h2_file) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) call MOM_read_data(filename, 'h2', CS%h2, G%domain, timelevel=1) @@ -354,32 +378,82 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) CS%Decay_scale_factor_lee = -9.e99 ! This should never be used if CS%Lee_wave_dissipation = False endif - call get_param(param_file, mdl, "USE_CVMIX_TIDAL", tidal_mixing_init, & - "If true, turns on tidal mixing scheme via CVMix", & - default=.false.) - - if (tidal_mixing_init) then + if (CS%use_cvmix_tidal) then ! Read in CVMix params call openParameterBlock(param_file,'CVMIX_TIDAL') call get_param(param_file, mdl, "TIDAL_MAX_COEF", CS%tidal_max_coef, & "largest acceptable value for tidal diffusivity", & - units="m^2/s", default=100e-4) ! the default is 50e-4 in CVMIX, 100e-4 in POP. - call closeParameterBlock(param_file) + units="m^2/s", default=100e-4, & ! the default is 50e-4 in CVMIX, 100e-4 in POP. + fail_if_missing=.true.) + ! Check if the chosen tidal mixing scheme is available in CVMix + select case (int_tide_profile_str) + case (SIMMONS_PROFILE_STRING) ; continue + case (SCHMITTNER_PROFILE_STRING) ; continue + case default + call MOM_error(FATAL, "tidal_mixing_init: Tidal mixing scheme"// & + " "//trim(int_tide_profile_str)//" unavailable in CVMix") + end select + + ! TODO: check parameter consistency. (see POP::tidal_mixing.F90::tidal_check) ! Set up CVMix - call cvmix_init_tidal(mix_scheme = 'Simmons', & + call cvmix_init_tidal(mix_scheme = int_tide_profile_str, & efficiency = CS%Mu_itides, & - vertical_decay_scale = cs%int_tide_decay_scale, & - max_coefficient = cs%tidal_max_coef, & - local_mixing_frac = cs%Gamma_itides, & - depth_cutoff = 0.0) - - endif ! cvmix on + vertical_decay_scale = CS%int_tide_decay_scale, & + max_coefficient = CS%tidal_max_coef, & + local_mixing_frac = CS%Gamma_itides, & + depth_cutoff = CS%min_zbot_itides) + ! TODO: provide ltidal_Schmittner_socn as paramater to + ! cvmix_init_tidal + + + call read_tidal_energy(G,param_file,CS) + + call closeParameterBlock(param_file) + + endif ! cvmix on end function tidal_mixing_init + +! TODO: move this subroutine to MOM_internal_tide_input module (?) +subroutine read_tidal_energy(G, param_file, CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle + type(tidal_mixing_cs), pointer :: CS + ! local + character(len=20) :: tidal_energy_type + character(len=200) :: tidal_energy_file + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + + call get_param(param_file, mdl, "TIDAL_ENERGY_FILE",tidal_energy_file, & + "The path to the file containing tidal energy \n"//& + "dissipation. Used with CVMix tidal mixing schemes.", & + fail_if_missing=.true.) + call get_param(param_file, mdl, "TIDAL_ENERGY_TYPE",tidal_energy_type, & + "The type of input tidal energy flux dataset.",& + fail_if_missing=.true.) + ! TODO: list all available tidal energy types here + + + call safe_alloc_ptr(CS%tidal_energy_flux_2d,isd,ied,jsd,jed) + + select case (uppercase(tidal_energy_type(1:4))) + case ('JAYN') ! Jayne 2009 input tidal energy flux + call MOM_read_data(tidal_energy_file,'wave_dissipation',CS%tidal_energy_flux_2d, G%domain) + case default + call MOM_error(FATAL, "read_tidal_energy: Unknown tidal energy file type.") + ! TODO: add more tidal energy file types, e.g., Arbic, ER03, GN13, LGM0, etc. + ! see POP::tidal_mixing.F90 + end select + +end subroutine read_tidal_energy + + !> This subroutine adds the effect of internal-tide-driven mixing to the layer diffusivities. !! The mechanisms considered are (1) local dissipation of internal waves generated by the !! barotropic flow ("itidal"), (2) local dissipation of internal waves generated by the propagating @@ -790,6 +864,9 @@ subroutine tidal_mixing_end(CS) !TODO deallocate all the dynamically allocated members here ... deallocate(CS) + deallocate(CS%tidal_energy_flux_2d) + + ! TODO: check why ptrs allocated with MOM_safe_alloc are not deallocated? end subroutine tidal_mixing_end From 3fcdb4cd035fd98f437b44ee3bc6ded6c011712e Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Mon, 26 Mar 2018 09:43:06 -0600 Subject: [PATCH 0038/1072] Update to new CVMix tag with tidal mixing changes --- pkg/CVMix-src | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/CVMix-src b/pkg/CVMix-src index d83f582714..c150093f81 160000 --- a/pkg/CVMix-src +++ b/pkg/CVMix-src @@ -1 +1 @@ -Subproject commit d83f582714e7f0f98d20efd8fac8fab01fa3bfe6 +Subproject commit c150093f810026ff614b8e7db8355a672750ed75 From 7a81871673fa0458bf367dbbf991de84e0d52aaf Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 26 Mar 2018 13:47:12 -0600 Subject: [PATCH 0039/1072] Re-structured MOM_bkgnd_mixing * Moved find_N2 back to MOM_set_diffusivity * Added a new func. in MOM_bkgnd_mixing (sfc_bkgnd_mixing) * Modified calculate_bkgnd_mixing These changes *do not* change answers for ocean_only/global_ALE/z --- .../vertical/MOM_bkgnd_mixing.F90 | 404 ++++++------------ .../vertical/MOM_set_diffusivity.F90 | 196 ++++++++- 2 files changed, 304 insertions(+), 296 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index e561b75a3e..ba7711586c 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -24,7 +24,10 @@ module MOM_bkgnd_mixing #include -public bkgnd_mixing_init, bkgnd_mixing_end, calculate_bkgnd_mixing +public bkgnd_mixing_init +public bkgnd_mixing_end +public calculate_bkgnd_mixing +public sfc_bkgnd_mixing !> Control structure including parameters for this module. type, public :: bkgnd_mixing_cs @@ -81,6 +84,7 @@ module MOM_bkgnd_mixing type(diag_ctrl), pointer :: diag => NULL() integer :: id_kd_bkgnd = -1, id_kv_bkgnd = -1 + real, allocatable, dimension(:,:) :: Kd_sfc !< surface value of the diffusivity (m2/s) ! Diagnostics arrays real, allocatable, dimension(:,:,:) :: kd_bkgnd !< Background diffusivity (m2/s) real, allocatable, dimension(:,:,:) :: kv_bkgnd !< Background viscosity (m2/s) @@ -149,7 +153,6 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) "mixed layer is not used.", units="m", fail_if_missing=.true.) endif - call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) call get_param(param_file, mdl, "PRANDTL_TURB", CS%prandtl_turb, & @@ -231,6 +234,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) ! allocate arrays and set them to zero allocate(CS%kd_bkgnd(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%kd_bkgnd(:,:,:) = 0. allocate(CS%kv_bkgnd(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%kv_bkgnd(:,:,:) = 0. + allocate(CS%Kd_sfc(SZI_(G), SZJ_(G))); CS%Kd_sfc(:,:) = 0. ! Register diagnostics CS%diag => diag @@ -241,56 +245,30 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) end subroutine bkgnd_mixing_init -!> Subroutine for calculating vertical background diffusivities/viscosities -subroutine calculate_bkgnd_mixing(h, tv, T_f, S_f, fluxes, G, GV, CS) +!> Get surface vertical background diffusivities/viscosities. +subroutine sfc_bkgnd_mixing(G, CS) type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_f!< temperature (deg C), after massless - !! layers filled vertically by diffusion. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_f!< salinity, after massless - !! layers filled vertically by diffusion. - type(forcing), intent(in) :: fluxes !< Structure of surface fluxes that may be - !! used. - type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by + type(bkgnd_mixing_cs), pointer, intent(inout) :: CS !< The control structure returned by !! a previous call to bkgnd_mixing_init. - ! local variables - real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: depth_3d !< distance from surface of an interface (m) - real, dimension(SZI_(G), SZJ_(G)) :: Kd_sfc !< surface value of the diffusivity (m2/s) - real, dimension(SZI_(G)) :: & - depth_i, & !< distance from surface of an interface (meter) - N2_bot !< bottom squared buoyancy frequency (1/s2) - real, dimension(SZI_(G),SZK_(G)+1) :: & - N2_int, & !< squared buoyancy frequency associated at interfaces (1/s2) - dRho_int !< locally ref potential density difference across interfaces (in s-2) smg: or kg/m3? - real, dimension(SZI_(G),SZK_(G)) :: & - N2_lay !< squared buoyancy frequency associated with layers (1/s2) - - real, dimension(SZK_(G)) :: depth_k !< distance from surface of an interface (meter) real :: I_x30 !< 2/acos(2) = 1/(sin(30 deg) * acosh(1/sin(30 deg))) real :: deg_to_rad !< factor converting degrees to radians, pi/180. real :: abs_sin !< absolute value of sine of latitude (nondim) - real :: depth_c !< depth of the center of a layer (meter) - real :: I_Hmix !< inverse of fixed mixed layer thickness (1/m) real :: epsilon - real :: I_2Omega !< 1/(2 Omega) (sec) - real :: N_2Omega - real :: N02_N2 - integer :: i, j, k, is, ie, js, je, nz + integer :: i, j, k, is, ie, js, je - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ! set some parameters deg_to_rad = atan(1.0)/45.0 ! = PI/180 epsilon = 1.e-10 + if (.not. CS%Bryan_Lewis_diffusivity) then !$OMP parallel do default(none) shared(is,ie,js,je,CS,Kd_sfc) do j=js,je ; do i=is,ie - Kd_sfc(i,j) = CS%Kd + CS%Kd_sfc(i,j) = CS%Kd enddo ; enddo endif @@ -301,7 +279,7 @@ subroutine calculate_bkgnd_mixing(h, tv, T_f, S_f, fluxes, G, GV, CS) !$OMP private(abs_sin) do j=js,je ; do i=is,ie abs_sin = abs(sin(G%geoLatT(i,j)*deg_to_rad)) - Kd_sfc(i,j) = max(CS%Kd_min, Kd_sfc(i,j) * & + CS%Kd_sfc(i,j) = max(CS%Kd_min, CS%Kd_sfc(i,j) * & ((abs_sin * invcosh(CS%N0_2Omega/max(epsilon,abs_sin))) * I_x30) ) enddo ; enddo elseif (CS%Kd_tanh_lat_fn) then @@ -310,276 +288,132 @@ subroutine calculate_bkgnd_mixing(h, tv, T_f, S_f, fluxes, G, GV, CS) ! The transition latitude and latitude range are hard-scaled here, since ! this is not really intended for wide-spread use, but rather for ! comparison with CM2M / CM2.1 settings. - Kd_sfc(i,j) = max(CS%Kd_min, Kd_sfc(i,j) * (1.0 + & + CS%Kd_sfc(i,j) = max(CS%Kd_min, CS%Kd_sfc(i,j) * (1.0 + & CS%Kd_tanh_lat_scale * 0.5*tanh((abs(G%geoLatT(i,j)) - 35.0)/5.0) )) enddo ; enddo endif -!$OMP parallel do default(none) -!shared(is,ie,js,je,nz,G,GV,CS,h,tv,T_f,S_f,fluxes,dd, & -!$OMP -!Kd,Kd_sfc,epsilon,deg_to_rad,I_2Omega,visc, & -!$OMP Kd_int,dt,u,v,Omega2) & -!$OMP -!private(dRho_int,I_trans,atan_fn_sfc,I_atan_fn,atan_fn_lay, & -!$OMP I_Hmix,depth_c,depth,N2_lay, N2_int, -!N2_bot, & -!$OMP I_x30,abs_sin,N_2Omega,N02_N2,KT_extra, -!KS_extra, & -!$OMP TKE_to_Kd,maxTKE,dissip,kb) - - depth_3d(:,:,:) = 0.0 - do j=js,je - ! Set up variables related to the stratification. - call find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, dRho_int, N2_lay, N2_int, N2_bot) - !if (associated(dd%N2_3d)) then - ! do K=1,nz+1 ; do i=is,ie ; dd%N2_3d(i,j,K) = N2_int(i,K) ; enddo ; enddo - !endif - - ! Set up the background diffusivity. - if (CS%Bryan_Lewis_diffusivity) then - - do i=is,ie - !depth_k(:) = 0.0 - do k=2,nz+1 - depth_3d(i,j,k) = depth_3d(i,j,k-1) + GV%H_to_m*h(i,j,k-1) - enddo - ! if (is_root_pe()) write(*,*)'depth_3d(i,j,:)',depth_3d(i,j,:) - - call cvmix_init_bkgnd(max_nlev=nz, & - zw = depth_3d(i,j,:), & !< interface depth, must bepositive. - bl1 = CS%Bryan_Lewis_c1, & - bl2 = CS%Bryan_Lewis_c2, & - bl3 = CS%Bryan_Lewis_c3, & - bl4 = CS%Bryan_Lewis_c4, & - prandtl = CS%prandtl_turb) - - call cvmix_coeffs_bkgnd(Mdiff_out=CS%kv_bkgnd(i,j,:), & - Tdiff_out=CS%kd_bkgnd(i,j,:), & - nlev=nz, & - max_nlev=nz) - enddo - elseif ((.not. CS%Bryan_Lewis_diffusivity) .and. (.not.CS%bulkmixedlayer) .and. & - (CS%Kd/= CS%Kdml)) then - - I_Hmix = 1.0 / CS%Hmix - do i=is,ie ; depth_i(i) = 0.0 ; enddo - do k=1,nz ; do i=is,ie - depth_c = depth_i(i) + 0.5*GV%H_to_m*h(i,j,k) - - if (depth_c <= CS%Hmix) then ; CS%kd_bkgnd(i,j,k) = CS%Kdml - elseif (depth_c >= 2.0*CS%Hmix) then ; CS%kd_bkgnd(i,j,k) = Kd_sfc(i,j) - else - CS%kd_bkgnd(i,j,k) = ((Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & - (2.0*CS%Kdml - Kd_sfc(i,j)) - endif - - depth_i(i) = depth_i(i) + GV%H_to_m*h(i,j,k) - enddo ; enddo - elseif (CS%Henyey_IGW_background_new) then - I_x30 = 2.0 / invcosh(CS%N0_2Omega*2.0) ! This is evaluated at 30 deg. - do k=1,nz ; do i=is,ie - abs_sin = max(epsilon,abs(sin(G%geoLatT(i,j)*deg_to_rad))) - N_2Omega = max(abs_sin,sqrt(N2_lay(i,k))*I_2Omega) - N02_N2 = (CS%N0_2Omega/N_2Omega)**2 - CS%kd_bkgnd(i,j,k) = max(CS%Kd_min, Kd_sfc(i,j) * & - ((abs_sin * invcosh(N_2Omega/abs_sin)) * I_x30)*N02_N2) - enddo ; enddo - - else - do k=1,nz ; do i=is,ie - CS%kd_bkgnd(i,j,k) = Kd_sfc(i,j) - enddo ; enddo - endif - enddo ! j-loop - - if (CS%debug) then - call hchksum(Kd_sfc,"Kd_sfc",G%HI,haloshift=0) - call hchksum(CS%kd_bkgnd, "MOM_bkgnd_mixing: kd_bkgnd",G%HI,haloshift=0) - call hchksum(CS%kv_bkgnd, "MOM_bkgnd_mixing: kv_bkgnd",G%HI,haloshift=0) - endif + if (CS%debug) call hchksum(CS%Kd_sfc,"After sfc_bkgnd_mixing: Kd_sfc",G%HI,haloshift=0) - ! send diagnostics to post_data - if (CS%id_kd_bkgnd > 0) call post_data(CS%id_kd_bkgnd, CS%kd_bkgnd, CS%diag) - if (CS%id_kv_bkgnd > 0) call post_data(CS%id_kv_bkgnd, CS%kv_bkgnd, CS%diag) +end subroutine sfc_bkgnd_mixing -end subroutine calculate_bkgnd_mixing +!> Calculates the vertical background diffusivities/viscosities +subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd, j, G, GV, CS) -!> Computes N2 -subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, dRho_int, & - N2_lay, N2_int, N2_bot) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(in) :: tv - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_f, S_f - type(forcing), intent(in) :: fluxes + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. + real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay!< squared buoyancy frequency associated + !! with layers (1/s2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd !< Diapycnal diffusivity of each layer (m2/sec). integer, intent(in) :: j - real, dimension(SZI_(G),SZK_(G)+1), intent(out) :: dRho_int, N2_int - real, dimension(SZI_(G),SZK_(G)), intent(out) :: N2_lay - real, dimension(SZI_(G)), intent(out) :: N2_bot - - real, dimension(SZI_(G),SZK_(G)+1) :: & - dRho_int_unfilt, & ! unfiltered density differences across interfaces - dRho_dT, & ! partial derivative of density wrt temp (kg m-3 degC-1) - dRho_dS ! partial derivative of density wrt saln (kg m-3 PPT-1) + type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by + !! a previous call to bkgnd_mixing_init. + ! local variables + real, dimension(SZI_(G), SZK_(G)+1) :: depth_2d !< distance from surface of an interface (m) real, dimension(SZI_(G)) :: & - pres, & ! pressure at each interface (Pa) - Temp_int, & ! temperature at each interface (degC) - Salin_int, & ! salinity at each interface (PPT) - drho_bot, & - h_amp, & - hb, & - z_from_bot - - real :: Rml_base ! density of the deepest variable density layer - real :: dz_int ! thickness associated with an interface (meter) - real :: G_Rho0 ! gravitation acceleration divided by Bouss reference density (m4 s-2 kg-1) - real :: H_neglect ! negligibly small thickness, in the same units as h. - - logical :: do_i(SZI_(G)), do_any - integer :: i, k, is, ie, nz - - is = G%isc ; ie = G%iec ; nz = G%ke - G_Rho0 = GV%g_Earth / GV%Rho0 - H_neglect = GV%H_subroundoff - - ! Find the (limited) density jump across each interface. - do i=is,ie - dRho_int(i,1) = 0.0 ; dRho_int(i,nz+1) = 0.0 - dRho_int_unfilt(i,1) = 0.0 ; dRho_int_unfilt(i,nz+1) = 0.0 - enddo - if (associated(tv%eqn_of_state)) then - if (associated(fluxes%p_surf)) then - do i=is,ie ; pres(i) = fluxes%p_surf(i,j) ; enddo - else - do i=is,ie ; pres(i) = 0.0 ; enddo - endif - do K=2,nz - do i=is,ie - pres(i) = pres(i) + GV%H_to_Pa*h(i,j,k-1) - Temp_Int(i) = 0.5 * (T_f(i,j,k) + T_f(i,j,k-1)) - Salin_Int(i) = 0.5 * (S_f(i,j,k) + S_f(i,j,k-1)) + depth !< distance from surface of an interface (meter) + real :: depth_c !< depth of the center of a layer (meter) + real :: I_Hmix !< inverse of fixed mixed layer thickness (1/m) + real :: I_2Omega !< 1/(2 Omega) (sec) + real :: N_2Omega + real :: N02_N2 + real :: I_x30 !< 2/acos(2) = 1/(sin(30 deg) * acosh(1/sin(30 deg))) + real :: deg_to_rad !< factor converting degrees to radians, pi/180. + real :: abs_sin !< absolute value of sine of latitude (nondim) + real :: epsilon + integer :: i, k, is, ie, js, je, nz + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + + ! set some parameters + deg_to_rad = atan(1.0)/45.0 ! = PI/180 + epsilon = 1.e-10 + + depth_2d(:,:) = 0.0 + ! Set up the background diffusivity. + if (CS%Bryan_Lewis_diffusivity) then + + do i=is,ie + do k=2,nz+1 + depth_2d(i,k) = depth_2d(i,k-1) + GV%H_to_m*h(i,j,k-1) enddo - call calculate_density_derivs(Temp_int, Salin_int, pres, & - dRho_dT(:,K), dRho_dS(:,K), is, ie-is+1, tv%eqn_of_state) - do i=is,ie - dRho_int(i,K) = max(dRho_dT(i,K)*(T_f(i,j,k) - T_f(i,j,k-1)) + & - dRho_dS(i,K)*(S_f(i,j,k) - S_f(i,j,k-1)), 0.0) - dRho_int_unfilt(i,K) = max(dRho_dT(i,K)*(tv%T(i,j,k) - tv%T(i,j,k-1)) + & - dRho_dS(i,K)*(tv%S(i,j,k) - tv%S(i,j,k-1)), 0.0) + ! if (is_root_pe()) write(*,*)'depth_3d(i,j,:)',depth_3d(i,j,:) + + call cvmix_init_bkgnd(max_nlev=nz, & + zw = depth_2d(i,:), & !< interface depth, must bepositive. + bl1 = CS%Bryan_Lewis_c1, & + bl2 = CS%Bryan_Lewis_c2, & + bl3 = CS%Bryan_Lewis_c3, & + bl4 = CS%Bryan_Lewis_c4, & + prandtl = CS%prandtl_turb) + + call cvmix_coeffs_bkgnd(Mdiff_out=CS%kv_bkgnd(i,j,:), & + Tdiff_out=CS%kd_bkgnd(i,j,:), & + nlev=nz, & + max_nlev=nz) + + do k=1,nz + ! Update Kd + Kd(i,j,k) = Kd(i,j,k) + 0.5*(CS%kd_bkgnd(i,j,K) + CS%kd_bkgnd(i,j,K+1)) + ! ######## CHECK ############### + ! GMM, we could update Kv here????? + ! Kv(i,j,k) = Kv(i,j,k) + 0.5*(CS%bkgnd_mixing_csp%kv_bkgnd(i,j,K) + & + ! CS%bkgnd_mixing_csp%kv_bkgnd(i,j,K+1)) enddo enddo - else - do K=2,nz ; do i=is,ie - dRho_int(i,K) = GV%Rlay(k) - GV%Rlay(k-1) - enddo ; enddo - endif - ! Set the buoyancy frequencies. - do k=1,nz ; do i=is,ie - N2_lay(i,k) = G_Rho0 * 0.5*(dRho_int(i,K) + dRho_int(i,K+1)) / & - (GV%H_to_m*(h(i,j,k) + H_neglect)) - enddo ; enddo - do i=is,ie ; N2_int(i,1) = 0.0 ; N2_int(i,nz+1) = 0.0 ; enddo - do K=2,nz ; do i=is,ie - N2_int(i,K) = G_Rho0 * dRho_int(i,K) / & - (0.5*GV%H_to_m*(h(i,j,k-1) + h(i,j,k) + H_neglect)) - enddo ; enddo - - ! Find the bottom boundary layer stratification, and use this in the deepest layers. - do i=is,ie - hb(i) = 0.0 ; dRho_bot(i) = 0.0 - z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz) - do_i(i) = (G%mask2dT(i,j) > 0.5) - h_amp(i) = 0.0 - enddo - - do k=nz,2,-1 - do_any = .false. - do i=is,ie ; if (do_i(i)) then - dz_int = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j,k-1)) - z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above - - hb(i) = hb(i) + dz_int - dRho_bot(i) = dRho_bot(i) + dRho_int(i,K) - - if (z_from_bot(i) > h_amp(i)) then - if (k>2) then - ! Always include at least one full layer. - hb(i) = hb(i) + 0.5*GV%H_to_m*(h(i,j,k-1) + h(i,j,k-2)) - dRho_bot(i) = dRho_bot(i) + dRho_int(i,K-1) - endif - do_i(i) = .false. + elseif ((.not. CS%Bryan_Lewis_diffusivity) .and. (.not.CS%bulkmixedlayer) .and. & + (CS%Kd/= CS%Kdml)) then + I_Hmix = 1.0 / CS%Hmix + do i=is,ie ; depth(i) = 0.0 ; enddo + do k=1,nz ; do i=is,ie + depth_c = depth(i) + 0.5*GV%H_to_m*h(i,j,k) + if (depth_c <= CS%Hmix) then ; CS%kd_bkgnd(i,j,k) = CS%Kdml + elseif (depth_c >= 2.0*CS%Hmix) then ; CS%kd_bkgnd(i,j,k) = CS%Kd_sfc(i,j) else - do_any = .true. + Kd(i,j,k) = ((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & + (2.0*CS%Kdml - CS%Kd_sfc(i,j)) endif - endif ; enddo - if (.not.do_any) exit - enddo - - do i=is,ie - if (hb(i) > 0.0) then - N2_bot(i) = (G_Rho0 * dRho_bot(i)) / hb(i) - else ; N2_bot(i) = 0.0 ; endif - z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz) - do_i(i) = (G%mask2dT(i,j) > 0.5) - enddo - - do k=nz,2,-1 - do_any = .false. - do i=is,ie ; if (do_i(i)) then - dz_int = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j,k-1)) - z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above - - N2_int(i,K) = N2_bot(i) - if (k>2) N2_lay(i,k-1) = N2_bot(i) - - if (z_from_bot(i) > h_amp(i)) then - if (k>2) N2_int(i,K-1) = N2_bot(i) - do_i(i) = .false. - else - do_any = .true. - endif - endif ; enddo - if (.not.do_any) exit - enddo - do i=is,ie - if (hb(i) > 0.0) then - N2_bot(i) = (G_Rho0 * dRho_bot(i)) / hb(i) - else ; N2_bot(i) = 0.0 ; endif - z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz) - do_i(i) = (G%mask2dT(i,j) > 0.5) - enddo - - do k=nz,2,-1 - do_any = .false. - do i=is,ie ; if (do_i(i)) then - dz_int = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j,k-1)) - z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above - - N2_int(i,K) = N2_bot(i) - if (k>2) N2_lay(i,k-1) = N2_bot(i) - - if (z_from_bot(i) > h_amp(i)) then - if (k>2) N2_int(i,K-1) = N2_bot(i) - do_i(i) = .false. - else - do_any = .true. - endif - endif ; enddo - if (.not.do_any) exit - enddo - if (associated(tv%eqn_of_state)) then - do K=1,nz+1 ; do i=is,ie - dRho_int(i,K) = dRho_int_unfilt(i,K) + depth(i) = depth(i) + GV%H_to_m*h(i,j,k) + enddo ; enddo + + elseif (CS%Henyey_IGW_background_new) then + I_x30 = 2.0 / invcosh(CS%N0_2Omega*2.0) ! This is evaluated at 30 deg. + do k=1,nz ; do i=is,ie + abs_sin = max(epsilon,abs(sin(G%geoLatT(i,j)*deg_to_rad))) + N_2Omega = max(abs_sin,sqrt(N2_lay(i,k))*I_2Omega) + N02_N2 = (CS%N0_2Omega/N_2Omega)**2 + Kd(i,j,k) = max(CS%Kd_min, CS%Kd_sfc(i,j) * & + ((abs_sin * invcosh(N_2Omega/abs_sin)) * I_x30)*N02_N2) + enddo ; enddo + + else + do k=1,nz ; do i=is,ie + Kd(i,j,k) = CS%Kd_sfc(i,j) enddo ; enddo endif -end subroutine find_N2 + ! Update CS%kd_bkgnd + ! GMM, we could update CS%kv_bkgnd here????? + if (.not. CS%Bryan_Lewis_diffusivity) then + do i=is,ie + CS%kd_bkgnd(i,j,1) = 0.0 + CS%kd_bkgnd(i,j,nz+1) = 0.0 + do k=2,nz + ! Update CS%kd_bkgnd + CS%kd_bkgnd(i,j,k) = CS%kd_bkgnd(i,j,k) + 0.5*(Kd(i,j,K-1) + Kd(i,j,K)) + ! ######## CHECK ############### + ! GMM, we could update CS%kv_bkgnd here????? + enddo + enddo + endif + +end subroutine calculate_bkgnd_mixing !> Reads the parameter "USE_CVMIX_BACKGROUND" and returns state. !! This function allows other modules to know whether this parameterization will diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index c127ad9a72..81babcd2bd 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -22,7 +22,7 @@ module MOM_set_diffusivity use MOM_cvmix_shear, only : calculate_cvmix_shear, cvmix_shear_init, cvmix_shear_cs use MOM_cvmix_shear, only : cvmix_shear_end use MOM_bkgnd_mixing, only : calculate_bkgnd_mixing, bkgnd_mixing_init, bkgnd_mixing_cs -use MOM_bkgnd_mixing, only : bkgnd_mixing_end +use MOM_bkgnd_mixing, only : bkgnd_mixing_end, sfc_bkgnd_mixing use MOM_string_functions, only : uppercase use MOM_thickness_diffuse, only : vert_fill_TS use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d @@ -483,8 +483,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! the appropriate place to add a depth-dependent parameterization or ! another explicit parameterization of Kd. - ! GMM, call MOM_bkgnd_mixing_calc here - call calculate_bkgnd_mixing(h, tv, T_f, S_f, fluxes, G, GV, CS%bkgnd_mixing_csp) + ! set surface diffusivities (CS%bkgnd_mixing_csp%Kd_sfc) + call sfc_bkgnd_mixing(G, CS%bkgnd_mixing_csp) ! GMM, fix OMP calls below @@ -496,13 +496,16 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & !$OMP I_x30,abs_sin,N_2Omega,N02_N2,KT_extra, KS_extra, & !$OMP TKE_to_Kd,maxTKE,dissip,kb) do j=js,je - ! Add vertical background diffusivities and viscosities - do k=1,nz ; do i=is,ie - ! diffusivities - Kd(i,j,k) = Kd(i,j,k) + 0.5*(CS%bkgnd_mixing_csp%kd_bkgnd(i,j,K) + CS%bkgnd_mixing_csp%kd_bkgnd(i,j,K+1)) - ! viscosities - ! GMM, will this be done here? - enddo ; enddo + + ! Set up variables related to the stratification. + call find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, N2_lay, N2_int, N2_bot) + + if (associated(dd%N2_3d)) then + do K=1,nz+1 ; do i=is,ie ; dd%N2_3d(i,j,K) = N2_int(i,K) ; enddo ; enddo + endif + + ! add background mixing + call calculate_bkgnd_mixing(h, tv, N2_lay, Kd, j, G, GV, CS%bkgnd_mixing_csp) ! GMM, the following will go into the MOM_cvmix_double_diffusion module if (CS%double_diffusion) then @@ -624,21 +627,38 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & enddo ! j-loop if (CS%debug) then - call hchksum(Kd,"BBL Kd",G%HI,haloshift=0) + call hchksum(Kd ,"Kd",G%HI,haloshift=0) + + !!if (associated(CS%bkgnd_mixing_csp%kd_bkgnd)) & + !1 call hchksum(CS%bkgnd_mixing_csp%kd_bkgnd, "kd_bkgnd",G%HI,haloshift=0) + + !!if (associated(CS%bkgnd_mixing_csp%kv_bkgnd)) & + !! call hchksum(CS%bkgnd_mixing_csp%kv_bkgnd, "kv_bkgnd",G%HI,haloshift=0) + if (CS%useKappaShear) call hchksum(visc%Kd_turb,"Turbulent Kd",G%HI,haloshift=0) + if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then call uvchksum("BBL Kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, & G%HI, 0, symmetric=.true.) endif + if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) then call uvchksum("BBL bbl_thick_[uv]", visc%bbl_thick_u, & visc%bbl_thick_v, G%HI, 0, symmetric=.true.) endif + if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) then call uvchksum("Ray_[uv]", visc%Ray_u, visc%Ray_v, G%HI, 0, symmetric=.true.) endif + endif + ! send bkgnd_mixing diagnostics to post_data + if (CS%bkgnd_mixing_csp%id_kd_bkgnd > 0) & + call post_data(CS%bkgnd_mixing_csp%id_kd_bkgnd, CS%bkgnd_mixing_csp%kd_bkgnd, CS%bkgnd_mixing_csp%diag) + if (CS%bkgnd_mixing_csp%id_kv_bkgnd > 0) & + call post_data(CS%bkgnd_mixing_csp%id_kv_bkgnd, CS%bkgnd_mixing_csp%kv_bkgnd, CS%bkgnd_mixing_csp%diag) + if (CS%Kd_add > 0.0) then if (present(Kd_int)) then !$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_int,CS,Kd) @@ -965,6 +985,160 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & end subroutine find_TKE_to_Kd +subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & + N2_lay, N2_int, N2_bot) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + type(thermo_var_ptrs), intent(in) :: tv + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_f, S_f + type(forcing), intent(in) :: fluxes + integer, intent(in) :: j + type(set_diffusivity_CS), pointer :: CS + real, dimension(SZI_(G),SZK_(G)+1), intent(out) :: dRho_int, N2_int + real, dimension(SZI_(G),SZK_(G)), intent(out) :: N2_lay + real, dimension(SZI_(G)), intent(out) :: N2_bot + + real, dimension(SZI_(G),SZK_(G)+1) :: & + dRho_int_unfilt, & ! unfiltered density differences across interfaces + dRho_dT, & ! partial derivative of density wrt temp (kg m-3 degC-1) + dRho_dS ! partial derivative of density wrt saln (kg m-3 PPT-1) + + real, dimension(SZI_(G)) :: & + pres, & ! pressure at each interface (Pa) + Temp_int, & ! temperature at each interface (degC) + Salin_int, & ! salinity at each interface (PPT) + drho_bot, & + h_amp, & + hb, & + z_from_bot + + real :: Rml_base ! density of the deepest variable density layer + real :: dz_int ! thickness associated with an interface (meter) + real :: G_Rho0 ! gravitation acceleration divided by Bouss reference density (m4 s-2 kg-1) + real :: H_neglect ! negligibly small thickness, in the same units as h. + + logical :: do_i(SZI_(G)), do_any + integer :: i, k, is, ie, nz + + is = G%isc ; ie = G%iec ; nz = G%ke + G_Rho0 = GV%g_Earth / GV%Rho0 + H_neglect = GV%H_subroundoff + + ! Find the (limited) density jump across each interface. + do i=is,ie + dRho_int(i,1) = 0.0 ; dRho_int(i,nz+1) = 0.0 + dRho_int_unfilt(i,1) = 0.0 ; dRho_int_unfilt(i,nz+1) = 0.0 + enddo + if (associated(tv%eqn_of_state)) then + if (associated(fluxes%p_surf)) then + do i=is,ie ; pres(i) = fluxes%p_surf(i,j) ; enddo + else + do i=is,ie ; pres(i) = 0.0 ; enddo + endif + do K=2,nz + do i=is,ie + pres(i) = pres(i) + GV%H_to_Pa*h(i,j,k-1) + Temp_Int(i) = 0.5 * (T_f(i,j,k) + T_f(i,j,k-1)) + Salin_Int(i) = 0.5 * (S_f(i,j,k) + S_f(i,j,k-1)) + enddo + call calculate_density_derivs(Temp_int, Salin_int, pres, & + dRho_dT(:,K), dRho_dS(:,K), is, ie-is+1, tv%eqn_of_state) + do i=is,ie + dRho_int(i,K) = max(dRho_dT(i,K)*(T_f(i,j,k) - T_f(i,j,k-1)) + & + dRho_dS(i,K)*(S_f(i,j,k) - S_f(i,j,k-1)), 0.0) + dRho_int_unfilt(i,K) = max(dRho_dT(i,K)*(tv%T(i,j,k) - tv%T(i,j,k-1)) + & + dRho_dS(i,K)*(tv%S(i,j,k) - tv%S(i,j,k-1)), 0.0) + enddo + enddo + else + do K=2,nz ; do i=is,ie + dRho_int(i,K) = GV%Rlay(k) - GV%Rlay(k-1) + enddo ; enddo + endif + + ! Set the buoyancy frequencies. + do k=1,nz ; do i=is,ie + N2_lay(i,k) = G_Rho0 * 0.5*(dRho_int(i,K) + dRho_int(i,K+1)) / & + (GV%H_to_m*(h(i,j,k) + H_neglect)) + enddo ; enddo + do i=is,ie ; N2_int(i,1) = 0.0 ; N2_int(i,nz+1) = 0.0 ; enddo + do K=2,nz ; do i=is,ie + N2_int(i,K) = G_Rho0 * dRho_int(i,K) / & + (0.5*GV%H_to_m*(h(i,j,k-1) + h(i,j,k) + H_neglect)) + enddo ; enddo + + ! Find the bottom boundary layer stratification, and use this in the deepest layers. + do i=is,ie + hb(i) = 0.0 ; dRho_bot(i) = 0.0 + z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz) + do_i(i) = (G%mask2dT(i,j) > 0.5) + + if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation) then + h_amp(i) = sqrt(CS%h2(i,j)) ! for computing Nb + else + h_amp(i) = 0.0 + endif + enddo + + do k=nz,2,-1 + do_any = .false. + do i=is,ie ; if (do_i(i)) then + dz_int = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j,k-1)) + z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above + + hb(i) = hb(i) + dz_int + dRho_bot(i) = dRho_bot(i) + dRho_int(i,K) + + if (z_from_bot(i) > h_amp(i)) then + if (k>2) then + ! Always include at least one full layer. + hb(i) = hb(i) + 0.5*GV%H_to_m*(h(i,j,k-1) + h(i,j,k-2)) + dRho_bot(i) = dRho_bot(i) + dRho_int(i,K-1) + endif + do_i(i) = .false. + else + do_any = .true. + endif + endif ; enddo + if (.not.do_any) exit + enddo + + do i=is,ie + if (hb(i) > 0.0) then + N2_bot(i) = (G_Rho0 * dRho_bot(i)) / hb(i) + else ; N2_bot(i) = 0.0 ; endif + z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz) + do_i(i) = (G%mask2dT(i,j) > 0.5) + enddo + + do k=nz,2,-1 + do_any = .false. + do i=is,ie ; if (do_i(i)) then + dz_int = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j,k-1)) + z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above + + N2_int(i,K) = N2_bot(i) + if (k>2) N2_lay(i,k-1) = N2_bot(i) + + if (z_from_bot(i) > h_amp(i)) then + if (k>2) N2_int(i,K-1) = N2_bot(i) + do_i(i) = .false. + else + do_any = .true. + endif + endif ; enddo + if (.not.do_any) exit + enddo + + if (associated(tv%eqn_of_state)) then + do K=1,nz+1 ; do i=is,ie + dRho_int(i,K) = dRho_int_unfilt(i,K) + enddo ; enddo + endif + +end subroutine find_N2 + ! GMM, the following will be moved to a new module !> This subroutine sets the additional diffusivities of temperature and From fdc7962b557dbb2215295aa8cb875bc15c4af8ec Mon Sep 17 00:00:00 2001 From: Anthony Craig Date: Mon, 26 Mar 2018 16:25:31 -0600 Subject: [PATCH 0040/1072] updates for cesm-nuopc-cmeps-mom6-nems_cap configuration --- config_src/mct_driver/ocn_comp_mct.F90 | 2 +- config_src/nuopc_driver/mom_cap.F90 | 290 ++++++++++---------- config_src/nuopc_driver/mom_cap_methods.F90 | 195 +++++++++---- 3 files changed, 280 insertions(+), 207 deletions(-) diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 75a5457598..28888b40fe 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -602,7 +602,7 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) if (debug .and. root_pe().eq.pe_here()) print *, "calling ocn_domain_mct" call ocn_domain_mct(lsize, MOM_MCT_gsmap, MOM_MCT_dom) - call ocn_domain_mct(lsize*km, MOM_MCT_gsmap3d, MOM_MCT_dom3d) !TODO: this is not used +! call ocn_domain_mct(lsize*km, MOM_MCT_gsmap3d, MOM_MCT_dom3d) !TODO: this is not used ! Inialize mct attribute vectors diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 6b8d2f5795..19c397f72f 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -413,6 +413,7 @@ module mom_cap_mod use NUOPC use NUOPC_Model, & model_routine_SS => SetServices, & + model_label_DataInitialize => label_DataInitialize, & model_label_Advance => label_Advance, & model_label_Finalize => label_Finalize @@ -514,13 +515,24 @@ subroutine SetServices(gcomp, rc) file=__FILE__)) & return ! bail out + !------------------ ! attach specializing method(s) + !------------------ + + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_DataInitialize, & + specRoutine=DataInitialize, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & specRoutine=ModelAdvance, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & specRoutine=ocean_model_finalize, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -567,7 +579,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - write_diagnostics=(trim(value)=="true") +! write_diagnostics=(trim(value)=="true") call ESMF_LogWrite('MOM_CAP:DumpFields = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) call ESMF_AttributeGet(gcomp, name="ProfileMemory", value=value, defaultValue="true", & @@ -713,89 +725,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out -#ifdef XXCESMCOUPLEDXX - - ! Initialize MOM6 comm - call MOM_infra_init(mpi_comm_mom) - call set_calendar_type(NOLEAP) !TODO: confirm this - Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) - -! tcx, todo, first coupling period -! ! Compute time_in: time at the beginning of the first ocn coupling interval -! call ESMF_ClockGet(EClock, TimeStep=ocn_cpl_interval, rc=rc) -! if (runtype /= "continue") then -! ! In startup runs, take the one ocn coupling interval lag into account to -! ! compute the initial ocn time. (time_in = time_init + ocn_cpl_interval) -! time_in_ESMF = ESMF_TimeInc(current_time, ocn_cpl_interval) -! else -! time_in_ESMF = current_time -! endif -! call ESMF_TimeGet(time_in_ESMF, yy=year, mm=month, dd=day, h=hour, m=minute, s=seconds, rc=rc) -! time_in = set_date(year, month, day, hour, minute, seconds, err_msg=err_msg) - -! tcx, todo, restart -! if (runtype == "initial") then ! startup (new run) - 'n' is needed below since we don't -! ! specify input_filename in input.nml - call ocean_model_init(ocean_public, ocean_state, time, time, input_restart_file = 'n') -! else ! hybrid or branch or continuos runs -! ! output path root -! call seq_infodata_GetData( glb%infodata, outPathRoot=restartpath ) -! ! read name of restart file in the pointer file -! nu = shr_file_getUnit() -! restart_pointer_file = trim(glb%pointer_filename) -! if (is_root_pe()) write(glb%stdout,*) 'Reading ocn pointer file: ',restart_pointer_file -! open(nu, file=restart_pointer_file, form='formatted', status='unknown') -! read(nu,'(a)') restartfile -! close(nu) -! !restartfile = trim(restartpath) // trim(restartfile) -! if (is_root_pe()) write(glb%stdout,*) 'Reading restart file: ',trim(restartfile) -! !endif -! call shr_file_freeUnit(nu) -! call ocean_model_init(glb%ocean_public, glb%ocn_state, time_init, time_in, input_restart_file=trim(restartfile)) -! endif - - npes = num_pes() - pe0 = root_pe() - - ocean_public%is_ocean_pe = .true. - allocate(ocean_public%pelist(npes)) - ocean_public%pelist(:) = (/(i,i=pe0,pe0+npes)/) - - ! This include declares and sets the variable "version". - ! read useful runtime params - call get_MOM_Input(param_file, dirs_tmp, check_params=.false.) - !call log_version(param_file, subname, version, "") - call get_param(param_file, subname, "POINTER_FILENAME", pointer_filename, & - "Name of the ascii file that contains the path and filename of" // & - " the latest restart file.", default='rpointer.ocn') - call get_param(param_file, subname, "SW_DECOMP", sw_decomp, & - "If True, read coeffs c1, c2, c3 and c4 and decompose" // & - "the net shortwave radiation (SW) into four components:\n" // & - "visible, direct shortwave = c1 * SW \n" // & - "visible, diffuse shortwave = c2 * SW \n" // & - "near-IR, direct shortwave = c3 * SW \n" // & - "near-IR, diffuse shortwave = c4 * SW", default=.true.) - if (sw_decomp) then - call get_param(param_file, subname, "SW_c1", c1, & - "Coeff. used to convert net shortwave rad. into \n"//& - "visible, direct shortwave.", units="nondim", default=0.285) - call get_param(param_file, subname, "SW_c2", c2, & - "Coeff. used to convert net shortwave rad. into \n"//& - "visible, diffuse shortwave.", units="nondim", default=0.285) - call get_param(param_file, subname, "SW_c3", c3, & - "Coeff. used to convert net shortwave rad. into \n"//& - "near-IR, direct shortwave.", units="nondim", default=0.215) - call get_param(param_file, subname, "SW_c4", c4, & - "Coeff. used to convert net shortwave rad. into \n"//& - "near-IR, diffuse shortwave.", units="nondim", default=0.215) - else - c1 = 0.0; c2 = 0.0; c3 = 0.0; c4 = 0.0 - endif - - ! Initialize ocn_state%state out of sight - call ocean_model_init_sfc(ocean_state, ocean_public) - -#else call fms_init(mpi_comm_mom) call constants_init call field_manager_init @@ -817,48 +746,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) call IOB_allocate(ice_ocean_boundary, isc, iec, jsc, jec) -#if (1 == 0) - allocate ( Ice_ocean_boundary% u_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% v_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% t_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% q_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% salt_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% lw_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_vis_dir (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_vis_dif (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_nir_dir (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_nir_dif (isc:iec,jsc:jec), & - Ice_ocean_boundary% lprec (isc:iec,jsc:jec), & - Ice_ocean_boundary% fprec (isc:iec,jsc:jec), & - Ice_ocean_boundary% runoff (isc:iec,jsc:jec), & - Ice_ocean_boundary% calving (isc:iec,jsc:jec), & - Ice_ocean_boundary% runoff_hflx (isc:iec,jsc:jec), & - Ice_ocean_boundary% calving_hflx (isc:iec,jsc:jec), & - Ice_ocean_boundary% mi (isc:iec,jsc:jec), & - Ice_ocean_boundary% p (isc:iec,jsc:jec)) - - Ice_ocean_boundary%u_flux = 0.0 - Ice_ocean_boundary%v_flux = 0.0 - Ice_ocean_boundary%t_flux = 0.0 - Ice_ocean_boundary%q_flux = 0.0 - Ice_ocean_boundary%salt_flux = 0.0 - Ice_ocean_boundary%lw_flux = 0.0 - Ice_ocean_boundary%sw_flux_vis_dir = 0.0 - Ice_ocean_boundary%sw_flux_vis_dif = 0.0 - Ice_ocean_boundary%sw_flux_nir_dir = 0.0 - Ice_ocean_boundary%sw_flux_nir_dif = 0.0 - Ice_ocean_boundary%lprec = 0.0 - Ice_ocean_boundary%fprec = 0.0 - Ice_ocean_boundary%runoff = 0.0 - Ice_ocean_boundary%calving = 0.0 - Ice_ocean_boundary%runoff_hflx = 0.0 - Ice_ocean_boundary%calving_hflx = 0.0 - Ice_ocean_boundary%mi = 0.0 - Ice_ocean_boundary%p = 0.0 -#endif - -#endif - call external_coupler_sbc_init(ocean_public%domain, dt_cpld, Run_len) ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state @@ -1455,6 +1342,101 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end subroutine InitializeRealize + !----------------------------------------------------------------------------- + + subroutine DataInitialize(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_State) :: importState, exportState + type (ocean_public_type), pointer :: ocean_public => NULL() + type (ocean_state_type), pointer :: ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + type(ocean_grid_type), pointer :: ocean_grid + character(240) :: msgString + integer :: fieldCount, n + type(ESMF_Field) :: field + character(len=64),allocatable :: fieldNameList(:) + character(len=*),parameter :: subname='(mom_cap:DataInitialize)' + + ! query the Component for its clock, importState and exportState + call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, exportState=exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr + ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + call get_ocean_grid(ocean_state, ocean_grid) + +!tcx ---------- + return +!tcx ---------- + + call ocn_export(ocean_public, ocean_grid, exportState) + + call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + allocate(fieldNameList(fieldCount)) + call ESMF_StateGet(exportState, itemNameList=fieldNameList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + do n=1, fieldCount + call ESMF_StateGet(exportState, itemName=fieldNameList(n), field=field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call NUOPC_SetAttribute(field, name="Updated", value="true", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end do + deallocate(fieldNameList) + + ! check whether all Fields in the exportState are "Updated" + if (NUOPC_IsUpdated(exportState)) then + call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) + + call ESMF_LogWrite("MOM6 - Initialize-Data-Dependency SATISFIED!!!", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + + if(write_diagnostics) then + call NUOPC_Write(exportState, fileNamePrefix='field_init_ocn_export_', & + timeslice=import_slice, relaxedFlag=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + end subroutine DataInitialize + + !----------------------------------------------------------------------------- !> Called by NUOPC to advance the model a single timestep. !! !! @param gcomp an ESMF_GridComp object @@ -1535,7 +1517,7 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(subname//trim(msgString), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1555,7 +1537,7 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1589,8 +1571,21 @@ subroutine ModelAdvance(gcomp, rc) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + write(msgString,'(A,L3)') 'ocean_solo=',ocean_solo + call ESMF_LogWrite(trim(subname)//trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if(.not. ocean_solo) then + call ESMF_LogWrite(subname//' tcx in not ocean_solo', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + !#ifdef MOM5_CAP call get_ocean_grid(ocean_state, ocean_grid) !#endif @@ -1599,6 +1594,11 @@ subroutine ModelAdvance(gcomp, rc) !#endif #ifdef CESMCOUPLED + call ESMF_LogWrite(subname//' tcx call ocn_import', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out call ocn_import(ocean_public, ocean_grid, importState, ice_ocean_boundary) #else call State_getFldPtr(exportState,'ocean_mask',dataPtr_mask,rc=rc) @@ -1654,9 +1654,6 @@ subroutine ModelAdvance(gcomp, rc) #endif endif ! not ocean_solo -#ifdef XXCESMCOUPLEDXX - ! tcx todo -#else !Optionally write restart files when currTime-startTime is integer multiples of restart_interval if(restart_interval > 0 ) then time_elapsed = currTime - startTime @@ -1674,15 +1671,9 @@ subroutine ModelAdvance(gcomp, rc) call ocean_model_restart(ocean_state, timestamp) endif endif -#endif if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") -#ifdef XXCESMCOUPLEDXX - call update_ocean_model(ImportState, ocean_state, ocean_public, Time, Time_step_coupled, & - sw_decomp, c1, c2, c3, c4) -#else call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled) -#endif if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") if(.not. ocean_solo) then @@ -1695,6 +1686,11 @@ subroutine ModelAdvance(gcomp, rc) !#endif #ifdef CESMCOUPLED + call ESMF_LogWrite(subname//' tcx call ocn_export', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out call ocn_export(ocean_public, ocean_grid, exportState) #else allocate(ofld(isc:iec,jsc:jec)) @@ -1791,9 +1787,8 @@ subroutine ModelAdvance(gcomp, rc) enddo enddo deallocate(ocz, ocm) - endif ! not ocean_solo - call ESMF_LogWrite(, rc=rc) +#endif if(write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & timeslice=export_slice, relaxedFlag=.true., rc=rc) @@ -1802,8 +1797,9 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out export_slice = export_slice + 1 -#endif - endif ! not ocean solo + endif + + endif ! not ocean_solo call ESMF_LogWrite("Before calling sbc forcing", ESMF_LOGMSG_INFO, rc=rc) call external_coupler_sbc_after(Ice_ocean_boundary, ocean_public, nc, dt_cpld ) @@ -2226,9 +2222,9 @@ subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_public) ! WARNING tcx tcraig ! tcraig this is just a starting point, the fields are not complete or correct here - !-------------------------------- - ! create import fields list - !-------------------------------- + !-------------------------------- + ! create import fields list + !-------------------------------- call shr_nuopc_fldList_Zero(fldsToOcn, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return @@ -2241,9 +2237,9 @@ subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_public) ! convert to fldsToOcn - !-------------------------------- - ! create export fields list - !-------------------------------- + !-------------------------------- + ! create export fields list + !-------------------------------- call shr_nuopc_fldList_Zero(fldsFrOcn, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index cb851f530f..8d571bb335 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -20,6 +20,7 @@ module mom_cap_methods public :: ocn_import integer :: rc,dbrc +integer :: import_cnt = 0 character(len=1024) :: tmpstr !--------------------------- @@ -35,7 +36,7 @@ subroutine ocn_export(ocean_public, grid, exportState) type(ESMF_State), intent(inout) :: exportState !< outgoing data ! Local variables real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo - integer :: i, j, i1, j1, isc, iec, jsc, jec !< Grid indices + integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices integer :: lbnd1, lbnd2, ubnd1, ubnd2 real :: slp_L, slp_R, slp_C, slope, u_min, u_max real(ESMF_KIND_R8), pointer :: dataPtr_omask(:,:) @@ -60,11 +61,13 @@ subroutine ocn_export(ocean_public, grid, exportState) line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,"So_t", dataPtr_t, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,"So_s", dataPtr_s, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -126,6 +129,7 @@ subroutine ocn_export(ocean_public, grid, exportState) ! file=__FILE__)) & ! return ! bail out + lbnd1 = lbound(dataPtr_t,1) ubnd1 = ubound(dataPtr_t,1) lbnd2 = lbound(dataPtr_t,2) @@ -134,37 +138,52 @@ subroutine ocn_export(ocean_public, grid, exportState) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) !tcx - write(tmpstr,'(a,6i8)') subname//'tcx1',lbnd1,ubnd1,lbnd2,ubnd2 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - write(tmpstr,'(a,6i8)') subname//'tcx2',isc,iec,jsc,jec - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - write(tmpstr,'(a,6i8)') subname//'tcx3',lbound(ssh,1),ubound(ssh,1),lbound(ssh,2),ubound(ssh,2) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - write(tmpstr,'(a,6i8)') subname//'tcx4',lbound(ocean_public%sea_lev,1),ubound(ocean_public%sea_lev,1),lbound(ocean_public%sea_lev,2),ubound(ocean_public%sea_lev,2) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - write(tmpstr,'(a,6i8)') subname//'tcx5',lbound(grid%mask2dT,1),ubound(grid%mask2dT,1),lbound(grid%mask2dT,2),ubound(grid%mask2dT,2) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) +! write(tmpstr,'(a,6i8)') subname//'tcx1',lbnd1,ubnd1,lbnd2,ubnd2 +! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) +! write(tmpstr,'(a,6i8)') subname//'tcx2',isc,iec,jsc,jec +! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) +! write(tmpstr,'(a,6i8)') subname//'tcx3',lbound(ssh,1),ubound(ssh,1),lbound(ssh,2),ubound(ssh,2) +! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) +! write(tmpstr,'(a,6i8)') subname//'tcx4',lbound(ocean_public%sea_lev,1),ubound(ocean_public%sea_lev,1),lbound(ocean_public%sea_lev,2),ubound(ocean_public%sea_lev,2) +! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) +! write(tmpstr,'(a,6i8)') subname//'tcx5',lbound(grid%mask2dT,1),ubound(grid%mask2dT,1),lbound(grid%mask2dT,2),ubound(grid%mask2dT,2) +! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) +! write(tmpstr,'(a,6i8)') subname//'tcx6',grid%isd,grid%ied,grid%jsd,grid%jed +! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) +! write(tmpstr,'(a,6i8)') subname//'tcx7',grid%isc,grid%iec,grid%jsc,grid%jec +! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) +! write(tmpstr,'(a,6i8)') subname//'tcx8',grid%idg_offset, grid%jdg_offset +! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) +! write(tmpstr,'(a,6i8)') subname//'tcx9',lbound(dataPtr_omask,1),ubound(dataPtr_omask,1),lbound(dataPtr_omask,2),ubound(dataPtr_omask,2) +! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) ! Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. ! The mask comes from "grid" that uses the usual MOM domain that has halos ! and does not use global indexing. do j = jsc, jec j1 = j + lbnd2 - jsc + jg = j + grid%jsc - jsc do i = isc, iec i1 = i + lbnd1 - isc + ig = i + grid%jsc - isc ! surface temperature in Kelvin - dataPtr_t(i1,j1) = ocean_public%t_surf(i,j) * grid%mask2dT(i,j) - dataPtr_s(i1,j1) = ocean_public%s_surf(i,j) * grid%mask2dT(i,j) - dataPtr_u(i1,j1) = (grid%cos_rot(i,j) * ocean_public%u_surf(i,j) & - - grid%sin_rot(i,j) * ocean_public%v_surf(i,j)) * grid%mask2dT(i,j) - dataPtr_v(i1,j1) = (grid%cos_rot(i,j) * ocean_public%v_surf(i,j) & - + grid%sin_rot(i,j) * ocean_public%u_surf(i,j)) * grid%mask2dT(i,j) + dataPtr_omask(i1,j1) = grid%mask2dT(ig,jg) + dataPtr_t(i1,j1) = ocean_public%t_surf(i,j) * grid%mask2dT(ig,jg) + dataPtr_s(i1,j1) = ocean_public%s_surf(i,j) * grid%mask2dT(ig,jg) + dataPtr_u(i1,j1) = ocean_public%u_surf(i,j) * grid%mask2dT(ig,jg) + dataPtr_v(i1,j1) = ocean_public%v_surf(i,j) * grid%mask2dT(ig,jg) +! dataPtr_u(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%u_surf(i,j) & +! - grid%sin_rot(ig,jg) * ocean_public%v_surf(i,j)) * grid%mask2dT(ig,jg) +! dataPtr_v(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%v_surf(i,j) & +! + grid%sin_rot(ig,jg) * ocean_public%u_surf(i,j)) * grid%mask2dT(ig,jg) ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain ! in order to update halos. i.e. does not use global indexing. - ssh(i,j) = ocean_public%sea_lev(i,j) +! ssh(i,j) = ocean_public%sea_lev(i,j) + ssh = 0. end do end do +#if (1 == 0) ! Update halo of ssh so we can calculate gradients call pass_var(ssh, grid%domain) @@ -174,7 +193,7 @@ subroutine ocn_export(ocean_public, grid, exportState) do i=isc,iec i1 = i + lbnd1 - isc ! This is a simple second-order difference - !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) + !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(ig,jg) ! This is a PLM slope which might be less prone to the A-grid null mode slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. @@ -192,8 +211,8 @@ subroutine ocn_export(ocean_public, grid, exportState) ! larger extreme values. slope = 0.0 end if - dataPtr_dhdx(i1,j1) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) dataPtr_dhdx(i1,j1) = 0.0 + dataPtr_dhdx(i1,j1) = slope * grid%IdxT(i,j) * grid%mask2dT(ig,jg) + if (grid%mask2dT(ig,jg)==0.) dataPtr_dhdx(i1,j1) = 0.0 end do end do @@ -203,7 +222,7 @@ subroutine ocn_export(ocean_public, grid, exportState) do i=isc,iec i1 = i + lbnd1 - isc ! This is a simple second-order difference - !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) + !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(ig,jg) ! This is a PLM slope which might be less prone to the A-grid null mode slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. @@ -222,10 +241,11 @@ subroutine ocn_export(ocean_public, grid, exportState) ! larger extreme values. slope = 0.0 end if - dataPtr_dhdy(i1,j1) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) dataPtr_dhdy(i1,j1) = 0.0 + dataPtr_dhdy(i1,j1) = slope * grid%IdyT(i,j) * grid%mask2dT(ig,jg) + if (grid%mask2dT(ig,jg)==0.) dataPtr_dhdy(i1,j1) = 0.0 end do end do +#endif end subroutine ocn_export @@ -242,7 +262,7 @@ subroutine ocn_import(ocean_public, grid, importState, ice_ocean_boundary) type(ESMF_State), intent(inout) :: importState !< incoming data type(ice_ocean_boundary_type), intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing - integer :: i, j, i1, j1, isc, iec, jsc, jec !< Grid indices + integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices real(ESMF_KIND_R8) :: c1,c2,c3,c4 integer :: lbnd1, lbnd2, ubnd1, ubnd2 @@ -262,6 +282,10 @@ subroutine ocn_import(ocean_public, grid, importState, ice_ocean_boundary) real(ESMF_KIND_R8), pointer :: dataPtr_osalt(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_lwdn(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_lwup(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_swvdr(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_swvdf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_swndr(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_swndf(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_swnet(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_rofl(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_rofi(:,:) @@ -274,11 +298,14 @@ subroutine ocn_import(ocean_public, grid, importState, ice_ocean_boundary) character(len=*),parameter :: subname = '(ocn_import)' + import_cnt = import_cnt + 1 + call State_getFldPtr(importState,'Sa_pslv', dataPtr_p,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(importState,'Si_ifrac', dataPtr_ifrac,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -314,7 +341,27 @@ subroutine ocn_import(ocean_public, grid, importState, ice_ocean_boundary) line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Foxx_taux" , dataPtr_taux, rc=rc) + call State_getFldPtr(importState,"Foxx_swndr" , dataPtr_swndr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_swndf" , dataPtr_swndf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_swvdr" , dataPtr_swvdr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_swvdf" , dataPtr_swvdf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_taux" , dataPtr_taux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -419,49 +466,79 @@ subroutine ocn_import(ocean_public, grid, importState, ice_ocean_boundary) ! write(tmpstr,'(a,6i8)') subname//'tcx5',lbound(grid%mask2dT,1),ubound(grid%mask2dT,1),lbound(grid%mask2dT,2),ubound(grid%mask2dT,2) ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - do j = jsc,jec - do i = isc,iec +! write(tmpstr,'(a,i8)') subname//' tcx import_cnt ',import_cnt +! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + do j = jsc, jec + j1 = j + lbnd2 - jsc + jg = j + grid%jsc - jsc + do i = isc, iec i1 = i + lbnd1 - isc - j1 = j + lbnd2 - jsc + ig = i + grid%jsc - isc + +! ice_ocean_boundary%p(i,j) = 0.0_ESMF_KIND_R8 + +! ice_ocean_boundary%u_flux(i,j) = 0.0_ESMF_KIND_R8 +! ice_ocean_boundary%v_flux(i,j) = 0.0_ESMF_KIND_R8 + +! ice_ocean_boundary%t_flux(i,j) = 0.0_ESMF_KIND_R8 +! ice_ocean_boundary%q_flux(i,j) = 0.0_ESMF_KIND_R8 +! ice_ocean_boundary%lw_flux(i,j) = 0.0_ESMF_KIND_R8 + +! ice_ocean_boundary%sw_flux_vis_dir(i,j) = 0.0_ESMF_KIND_R8 +! ice_ocean_boundary%sw_flux_vis_dif(i,j) = 0.0_ESMF_KIND_R8 +! ice_ocean_boundary%sw_flux_nir_dir(i,j) = 0.0_ESMF_KIND_R8 +! ice_ocean_boundary%sw_flux_nir_dif(i,j) = 0.0_ESMF_KIND_R8 - ice_ocean_boundary%p(i,j) = GRID%mask2dT(i,j) * dataPtr_p(i1,j1) +! ice_ocean_boundary%lprec(i,j) = 0.0_ESMF_KIND_R8 +! ice_ocean_boundary%fprec(i,j) = 0.0_ESMF_KIND_R8 +! ice_ocean_boundary%runoff(i,j) = 0.0_ESMF_KIND_R8 - ice_ocean_boundary%u_flux(i,j) = (GRID%cos_rot(i1,j1)*dataPtr_taux(i1,j1) + & - GRID%sin_rot(i1,j1)*dataPtr_tauy(i1,j1)) - ice_ocean_boundary%v_flux(i,j) = (GRID%cos_rot(i1,j1)*dataPtr_tauy(i1,j1) + & - GRID%sin_rot(i1,j1)*dataPtr_taux(i1,j1)) +! ice_ocean_boundary%runoff_hflx(i,j) = 0.0 * GRID%mask2dT(ig,jg) +! ice_ocean_boundary%calving(i,j) = 0.0 * GRID%mask2dT(ig,jg) +! ice_ocean_boundary%calving_hflx(i,j) = 0.0 * GRID%mask2dT(ig,jg) - ice_ocean_boundary%t_flux(i,j) = dataPtr_sen(i1,j1) * GRID%mask2dT(i,j) - ice_ocean_boundary%q_flux(i,j) = dataPtr_evap(i1,j1) * GRID%mask2dT(i,j) -! ice_ocean_boundary%latent(i,j) = dataPtr_lat(i1,j1) * GRID%mask2dT(i,j) - ice_ocean_boundary%lw_flux(i,j) = (dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1)) * GRID%mask2dT(i,j) +! ice_ocean_boundary%ustar_berg(i,j) = 0.0 * GRID%mask2dT(ig,jg) +! ice_ocean_boundary%area_berg(i,j) = 0.0 * GRID%mask2dT(ig,jg) +! ice_ocean_boundary%mass_berg(i,j) = 0.0 * GRID%mask2dT(ig,jg) +! ice_ocean_boundary%mi(i,j) = 0.0 * GRID%mask2dT(ig,jg) + +if (import_cnt > 2) then + +! ice_ocean_boundary%p(i,j) = GRID%mask2dT(ig,jg) * dataPtr_p(i1,j1) + ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) * GRID%mask2dT(ig,jg) +! ice_ocean_boundary%u_flux(i,j) = (GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + & +! GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1)) +! ice_ocean_boundary%v_flux(i,j) = (GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + & +! GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1)) + + ice_ocean_boundary%t_flux(i,j) = -dataPtr_sen(i1,j1) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) * GRID%mask2dT(ig,jg) +!! ice_ocean_boundary%latent(i,j) = dataPtr_lat(i1,j1) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%lw_flux(i,j) = (dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1)) * GRID%mask2dT(ig,jg) ! tcx TO DO c1-c4 - c1 = 0.25_ESMF_KIND_R8 - c2 = 0.25_ESMF_KIND_R8 - c3 = 0.25_ESMF_KIND_R8 - c4 = 0.25_ESMF_KIND_R8 - ice_ocean_boundary%sw_flux_vis_dir(i,j) = GRID%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c1 - ice_ocean_boundary%sw_flux_vis_dif(i,j) = GRID%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c2 - ice_ocean_boundary%sw_flux_nir_dir(i,j) = GRID%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c3 - ice_ocean_boundary%sw_flux_nir_dif(i,j) = GRID%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c4 +! c1 = 0.25_ESMF_KIND_R8 +! c2 = 0.25_ESMF_KIND_R8 +! c3 = 0.25_ESMF_KIND_R8 +! c4 = 0.25_ESMF_KIND_R8 + ice_ocean_boundary%sw_flux_vis_dir(i,j) = GRID%mask2dT(ig,jg) * dataPtr_swvdr(i1,j1) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = GRID%mask2dT(ig,jg) * dataPtr_swvdf(i1,j1) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = GRID%mask2dT(ig,jg) * dataPtr_swndf(i1,j1) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = GRID%mask2dT(ig,jg) * dataPtr_swndf(i1,j1) ! ice_ocean_boundary%sw(i,j) = ice_ocean_boundary%sw_flux_vis_dir(i,j) + ice_ocean_boundary%sw_flux_vis_dif(i,j) + & ! ice_ocean_boundary%sw_flux_nir_dir(i,j) + ice_ocean_boundary%sw_flux_nir_dif(i,j) - ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) * GRID%mask2dT(i,j) - ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) * GRID%mask2dT(i,j) - ice_ocean_boundary%runoff(i,j) = (dataPtr_rofl(i1,j1)+dataPtr_rofi(i1,j1)) * GRID%mask2dT(i,j) - ice_ocean_boundary%runoff_hflx(i,j) = 0.0 * GRID%mask2dT(i,j) - ice_ocean_boundary%calving(i,j) = 0.0 * GRID%mask2dT(i,j) - ice_ocean_boundary%calving_hflx(i,j) = 0.0 * GRID%mask2dT(i,j) - ice_ocean_boundary%salt_flux(i,j) = GRID%mask2dT(i,j)*dataPtr_iosalt(i1,j1) - ice_ocean_boundary%salt_flux(i,j) = GRID%mask2dT(i,j)*(dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j)) - - ice_ocean_boundary%ustar_berg(i,j) = 0.0 * GRID%mask2dT(i,j) - ice_ocean_boundary%area_berg(i,j) = 0.0 * GRID%mask2dT(i,j) - ice_ocean_boundary%mass_berg(i,j) = 0.0 * GRID%mask2dT(i,j) - ice_ocean_boundary%mi(i,j) = 0.0 * GRID%mask2dT(i,j) + ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) * GRID%mask2dT(ig,jg) +! ice_ocean_boundary%runoff(i,j) = (dataPtr_rofl(i1,j1)+dataPtr_rofi(i1,j1)) * GRID%mask2dT(ig,jg) + +! ice_ocean_boundary%salt_flux(i,j) = GRID%mask2dT(ig,jg)*dataPtr_iosalt(i1,j1) +! ice_ocean_boundary%salt_flux(i,j) = GRID%mask2dT(ig,jg)*(dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j)) + +endif enddo enddo From d1cee89cd36465405b9784759eade77724ea6f56 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 27 Mar 2018 11:14:35 -0600 Subject: [PATCH 0041/1072] Add timestep initializations to calculate_cvmix_tidal --- .../vertical/MOM_diabatic_driver.F90 | 11 +- .../vertical/MOM_tidal_mixing.F90 | 113 +++++++++++++++--- 2 files changed, 103 insertions(+), 21 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 75499c96f0..3c2794726b 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -585,6 +585,12 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G endif call cpu_clock_begin(id_clock_set_diffusivity) + + ! Add tidal diffusivity + if (CS%use_tidal_mixing) then + call calculate_cvmix_tidal(h,G,GV,CS%tidal_mixing_CSp) + end if + ! Sets: Kd, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S ! Also changes: visc%Kd_turb, visc%TKE_turb (not clear that TKE_turb is used as input ????) ! And sets visc%Kv_turb @@ -670,11 +676,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G endif ! endif for KPP - ! Add diffusivity due to tidal mixing - if (CS%use_tidal_mixing) then - continue !TODO - end if - ! Check for static instabilities and increase Kd_int where unstable if (CS%useConvection) call diffConvection_calculate(CS%Conv_CSp, & G, GV, h, tv%T, tv%S, tv%eqn_of_state, Kd_int) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 9ccec3c141..c661aa4234 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -15,7 +15,8 @@ module MOM_tidal_mixing use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_string_functions, only : uppercase use MOM_io, only : slasher, MOM_read_data -use cvmix_tidal, only : cvmix_init_tidal +use cvmix_tidal, only : cvmix_init_tidal, cvmix_compute_Simmons_invariant +use cvmix_tidal, only : cvmix_compute_socn_tidal_invariant implicit none ; private @@ -94,6 +95,7 @@ module MOM_tidal_mixing ! due to tidal mixing real :: tidal_max_coef ! maximum allowable tidal diffusivity. [m^2/s] + real :: min_thickness ! Minimum thickness allowed [m] real, pointer, dimension(:,:) :: TKE_Niku => NULL() real, pointer, dimension(:,:) :: TKE_itidal => NULL() @@ -101,7 +103,11 @@ module MOM_tidal_mixing real, pointer, dimension(:,:) :: mask_itidal => NULL() real, pointer, dimension(:,:) :: h2 => NULL() real, pointer, dimension(:,:) :: tideamp => NULL() ! RMS tidal amplitude (m/s) - real, pointer, dimension(:,:) :: tidal_energy_flux_2d => NULL() + + real, allocatable, dimension(:,:) :: tidal_qe_2d ! q*E(x,y) + real, allocatable, dimension(:,:) :: Simmons_coeff + real, allocatable, dimension(:,:,:) :: vert_dep !< vertical deposition needed for Simmons + !! tidal mixing. end type tidal_mixing_cs @@ -146,7 +152,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. - type(tidal_mixing_cs), pointer :: CS !< This module's control structure. + type(tidal_mixing_cs), pointer :: CS !< This module's control structure. ! Local variables logical :: read_tideamp @@ -386,6 +392,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) "largest acceptable value for tidal diffusivity", & units="m^2/s", default=100e-4, & ! the default is 50e-4 in CVMIX, 100e-4 in POP. fail_if_missing=.true.) + call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, default=0.001, do_not_log=.True.) ! Check if the chosen tidal mixing scheme is available in CVMix select case (int_tide_profile_str) @@ -408,7 +415,6 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) ! TODO: provide ltidal_Schmittner_socn as paramater to ! cvmix_init_tidal - call read_tidal_energy(G,param_file,CS) call closeParameterBlock(param_file) @@ -418,6 +424,75 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) end function tidal_mixing_init +subroutine calculate_cvmix_tidal(h, G, GV, CS) + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + type(tidal_mixing_cs), pointer :: CS !< This module's control structure. + + ! local + logical, parameter :: init_every_tstep = .true. + real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) + real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m) + integer :: i, j, k, is, ie, js, je + integer :: isd, ied, jsd, jed + real :: dh, hcorr + real, parameter :: rho_fw = 1000.0 ! fresh water density [kg/m^3] ! TODO: when coupled, get this from CESM (SHR_CONST_RHOFW) + + ! TODO: check if this initialization block is necessary at every timestep. if not, + ! run this during model initialization only. + if (init_every_tstep) then + + select case (CS%int_tide_profile) + case (SIMMONS_04) + if (.not.allocated(CS%Simmons_coeff)) allocate(CS%Simmons_coeff(isd:ied,jsd:jed)) + if (.not.allocated(CS%vert_dep)) allocate(CS%vert_dep(isd:ied,jsd:jed,SZK_(G)+1)) + ! TODO: no need to declare the above arrays as 2d and 3d, if they are to be computed at every timestep. + ! Instead, compute them and pass them to cvmix_coeffs_tidal_low when needed as a scalar + ! (Simmons_coeff), and as a 1d array (vert_dep). + + do j=js,je ; do i=is,ie + iFaceHeight = 0.0 ! BBL is all relative to the surface + hcorr = 0.0 + do k=1,G%ke + ! cell center and cell bottom in meters (negative values in the ocean) + dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) + hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 + dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness + cellHeight(k) = iFaceHeight(k) - 0.5 * dh + iFaceHeight(k+1) = iFaceHeight(k) - dh + enddo + ! Note: CVMix zw_iface (height of interfaces in column) and zt_cntr + ! (height of cell centers in column) variables are negative in the ocean. + + if (G%mask2dT(i,j)<1) return + + call cvmix_compute_Simmons_invariant( nlev = G%ke, & + energy_flux = CS%tidal_qe_2d(i,j), & + rho = rho_fw, & + SimmonsCoeff = CS%Simmons_coeff(i,j), & + VertDep = CS%vert_dep(i,j,:), & + zw = iFaceHeight, & + zt = cellHeight ) + + ! Since we pass tidal_qe_2d=(CS%Gamma_itides)*tidal_energy_flux_2d, and not tidal_energy_flux_2d in + ! above subroutine call, we divide Simmons_coeff by CS%Gamma_itides as a corrective step: + CS%Simmons_coeff = CS%Simmons_coeff / CS%Gamma_itides + + ! TODO: check if cvmix_compute_socn_tidal_invariant call is necessary here for Simmons. + + enddo ; enddo + ! TODO: case (SCHMITTNER) + case default + call MOM_error(FATAL, "tidal_mixing_init: The selected"// & + " INT_TIDE_PROFILE is unavailable in CVMix") + end select + endif + +end subroutine calculate_cvmix_tidal + + ! TODO: move this subroutine to MOM_internal_tide_input module (?) subroutine read_tidal_energy(G, param_file, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -427,6 +502,7 @@ subroutine read_tidal_energy(G, param_file, CS) character(len=20) :: tidal_energy_type character(len=200) :: tidal_energy_file integer :: i, j, is, ie, js, je, isd, ied, jsd, jed + real, allocatable, dimension(:,:) :: tidal_energy_flux_2d ! input tidal energy flux at T-grid points (W/m^2) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -439,21 +515,32 @@ subroutine read_tidal_energy(G, param_file, CS) fail_if_missing=.true.) ! TODO: list all available tidal energy types here - - call safe_alloc_ptr(CS%tidal_energy_flux_2d,isd,ied,jsd,jed) + if (.not. allocated(CS%tidal_qe_2d)) allocate(CS%tidal_qe_2d(isd:ied,jsd:jed)) + allocate(tidal_energy_flux_2d(isd:ied,jsd:jed)) select case (uppercase(tidal_energy_type(1:4))) case ('JAYN') ! Jayne 2009 input tidal energy flux - call MOM_read_data(tidal_energy_file,'wave_dissipation',CS%tidal_energy_flux_2d, G%domain) + call MOM_read_data(tidal_energy_file,'wave_dissipation',tidal_energy_flux_2d, G%domain) + CS%tidal_qe_2d = (CS%Gamma_itides) * tidal_energy_flux_2d case default call MOM_error(FATAL, "read_tidal_energy: Unknown tidal energy file type.") ! TODO: add more tidal energy file types, e.g., Arbic, ER03, GN13, LGM0, etc. - ! see POP::tidal_mixing.F90 + ! see POP::tidal_mixing.F90 end select - + + deallocate(tidal_energy_flux_2d) + end subroutine read_tidal_energy +!subroutine prep_CVMix_data(G,GV,CVMix_vars,CVMix_params) +! type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure +! type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure +! +!end subroutine prep_CVMix_Data + + + !> This subroutine adds the effect of internal-tide-driven mixing to the layer diffusivities. !! The mechanisms considered are (1) local dissipation of internal waves generated by the !! barotropic flow ("itidal"), (2) local dissipation of internal waves generated by the propagating @@ -852,19 +939,13 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, end subroutine add_int_tide_diffusivity -!TODO: -subroutine calculate_cvmix_tidal() - continue -end subroutine calculate_cvmix_tidal - - !> Clear pointers and deallocate memory subroutine tidal_mixing_end(CS) type(tidal_mixing_cs), pointer :: CS ! This module's control structure !TODO deallocate all the dynamically allocated members here ... + deallocate(CS%tidal_qe_2d) deallocate(CS) - deallocate(CS%tidal_energy_flux_2d) ! TODO: check why ptrs allocated with MOM_safe_alloc are not deallocated? end subroutine tidal_mixing_end From e99229249b8ef967fd060c51a0b7fda8ee07fa3f Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 28 Mar 2018 17:23:21 -0600 Subject: [PATCH 0042/1072] Added calculate_cvmix_tidal interface --- .../vertical/MOM_diabatic_driver.F90 | 7 +- .../vertical/MOM_set_diffusivity.F90 | 7 +- .../vertical/MOM_tidal_mixing.F90 | 225 ++++++++++-------- 3 files changed, 132 insertions(+), 107 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 3c2794726b..62757dff71 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -27,7 +27,7 @@ module MOM_diabatic_driver use MOM_domains, only : pass_var, To_West, To_South, To_All, Omit_Corners use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_tidal_mixing, only : tidal_mixing_init, tidal_mixing_cs -use MOM_tidal_mixing, only : calculate_cvmix_tidal, tidal_mixing_end +use MOM_tidal_mixing, only : tidal_mixing_end use MOM_energetic_PBL, only : energetic_PBL, energetic_PBL_init use MOM_energetic_PBL, only : energetic_PBL_end, energetic_PBL_CS use MOM_energetic_PBL, only : energetic_PBL_get_MLD @@ -586,11 +586,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G call cpu_clock_begin(id_clock_set_diffusivity) - ! Add tidal diffusivity - if (CS%use_tidal_mixing) then - call calculate_cvmix_tidal(h,G,GV,CS%tidal_mixing_CSp) - end if - ! Sets: Kd, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S ! Also changes: visc%Kd_turb, visc%TKE_turb (not clear that TKE_turb is used as input ????) ! And sets visc%Kv_turb diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 245f4a55fe..79a984b0b7 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -38,7 +38,7 @@ module MOM_set_diffusivity use MOM_forcing_type, only : forcing, optics_type use MOM_grid, only : ocean_grid_type use MOM_internal_tides, only : int_tide_CS, get_lowmode_loss -use MOM_tidal_mixing, only : tidal_mixing_CS, add_int_tide_diffusivity +use MOM_tidal_mixing, only : tidal_mixing_CS, calculate_tidal_mixing use MOM_tidal_mixing, only : tidal_mixing_diags use MOM_intrinsic_functions, only : invcosh use MOM_io, only : slasher, vardesc, var_desc, MOM_read_data @@ -677,9 +677,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int) ! Add the Nikurashin and / or tidal bottom-driven mixing - if (tm_csp%Int_tide_dissipation .or. tm_csp%Lee_wave_dissipation .or. tm_csp%Lowmode_itidal_dissipation) & - call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, maxTKE, G, GV, CS%tm_csp, & - tm_dd, N2_lay, Kd, Kd_int, CS%Kd_max) + call calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, maxTKE, G, GV, CS%tm_csp, & + tm_dd, N2_lay, N2_int, Kd, Kd_int, CS%Kd_max) ! This adds the diffusion sustained by the energy extracted from the flow ! by the bottom drag. diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index c661aa4234..88936940d0 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -16,15 +16,16 @@ module MOM_tidal_mixing use MOM_string_functions, only : uppercase use MOM_io, only : slasher, MOM_read_data use cvmix_tidal, only : cvmix_init_tidal, cvmix_compute_Simmons_invariant -use cvmix_tidal, only : cvmix_compute_socn_tidal_invariant +use cvmix_tidal, only : cvmix_coeffs_tidal, cvmix_tidal_params_type +use cvmix_kinds_and_types, only : cvmix_global_params_type +use cvmix_put_get, only : cvmix_put implicit none ; private #include public tidal_mixing_init -public calculate_cvmix_tidal -public add_int_tide_diffusivity +public calculate_tidal_mixing public tidal_mixing_end !> Control structure including parameters for tidal mixing. @@ -105,9 +106,9 @@ module MOM_tidal_mixing real, pointer, dimension(:,:) :: tideamp => NULL() ! RMS tidal amplitude (m/s) real, allocatable, dimension(:,:) :: tidal_qe_2d ! q*E(x,y) - real, allocatable, dimension(:,:) :: Simmons_coeff - real, allocatable, dimension(:,:,:) :: vert_dep !< vertical deposition needed for Simmons - !! tidal mixing. + + type(cvmix_tidal_params_type) :: cvmix_tidal_params + type(cvmix_global_params_type) :: cvmix_glb_params ! to pass Prandtl number only end type tidal_mixing_cs @@ -158,7 +159,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) logical :: read_tideamp character(len=20) :: tmpstr, int_tide_profile_str character(len=200) :: filename, tideamp_file, h2_file, Niku_TKE_input_file - real :: utide, zbot, hamp + real :: utide, zbot, hamp, prandtl real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -392,7 +393,12 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) "largest acceptable value for tidal diffusivity", & units="m^2/s", default=100e-4, & ! the default is 50e-4 in CVMIX, 100e-4 in POP. fail_if_missing=.true.) - call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, default=0.001, do_not_log=.True.) + call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, default=0.001, & + do_not_log=.True.) + call get_param(param_file, mdl, "PRANDTL_TURB", prandtl,units="nondim", default=1.0, & + do_not_log=.true.) + call cvmix_put(CS%cvmix_glb_params,'Prandtl',prandtl) + ! Check if the chosen tidal mixing scheme is available in CVMix select case (int_tide_profile_str) @@ -406,14 +412,13 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) ! TODO: check parameter consistency. (see POP::tidal_mixing.F90::tidal_check) ! Set up CVMix - call cvmix_init_tidal(mix_scheme = int_tide_profile_str, & - efficiency = CS%Mu_itides, & - vertical_decay_scale = CS%int_tide_decay_scale, & - max_coefficient = CS%tidal_max_coef, & - local_mixing_frac = CS%Gamma_itides, & - depth_cutoff = CS%min_zbot_itides) - ! TODO: provide ltidal_Schmittner_socn as paramater to - ! cvmix_init_tidal + call cvmix_init_tidal(CVmix_tidal_params_user = CS%cvmix_tidal_params, & + mix_scheme = int_tide_profile_str, & + efficiency = CS%Mu_itides, & + vertical_decay_scale = CS%int_tide_decay_scale, & + max_coefficient = CS%tidal_max_coef, & + local_mixing_frac = CS%Gamma_itides, & + depth_cutoff = CS%min_zbot_itides) call read_tidal_energy(G,param_file,CS) @@ -424,34 +429,59 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) end function tidal_mixing_init -subroutine calculate_cvmix_tidal(h, G, GV, CS) - type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure +subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & + dd, N2_lay, N2_int, Kd, Kd_int, Kd_max) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G)), intent(in) :: N2_bot + real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay + real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: N2_int + integer, intent(in) :: j + real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd, max_TKE + type(tidal_mixing_cs), pointer :: CS + type(tidal_mixing_diags), intent(inout) :: dd + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int + real, intent(inout) :: Kd_max + + if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then + if (CS%use_cvmix_tidal) then + call calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd_int) + else + call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS,dd, & + N2_lay, Kd, Kd_int, Kd_max) + endif + endif +end subroutine + + +subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd_int) + integer, intent(in) :: j + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(tidal_mixing_cs), pointer :: CS !< This module's control structure. + real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: N2_int real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). - type(tidal_mixing_cs), pointer :: CS !< This module's control structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int ! local logical, parameter :: init_every_tstep = .true. + real, dimension(SZK_(G)+1) :: Kd_tidal !< tidal diffusivity [m2/s] + real, dimension(SZK_(G)+1) :: Kv_tidal !< tidal viscosity [m2/s] + real, dimension(SZK_(G)+1) :: vert_dep !< vertical deposition needed for Simmons tidal mixing. real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m) - integer :: i, j, k, is, ie, js, je + integer :: i, k, is, ie, js, je integer :: isd, ied, jsd, jed - real :: dh, hcorr + real :: dh, hcorr, Simmons_coeff real, parameter :: rho_fw = 1000.0 ! fresh water density [kg/m^3] ! TODO: when coupled, get this from CESM (SHR_CONST_RHOFW) - ! TODO: check if this initialization block is necessary at every timestep. if not, - ! run this during model initialization only. if (init_every_tstep) then select case (CS%int_tide_profile) case (SIMMONS_04) - if (.not.allocated(CS%Simmons_coeff)) allocate(CS%Simmons_coeff(isd:ied,jsd:jed)) - if (.not.allocated(CS%vert_dep)) allocate(CS%vert_dep(isd:ied,jsd:jed,SZK_(G)+1)) - ! TODO: no need to declare the above arrays as 2d and 3d, if they are to be computed at every timestep. - ! Instead, compute them and pass them to cvmix_coeffs_tidal_low when needed as a scalar - ! (Simmons_coeff), and as a 1d array (vert_dep). - - do j=js,je ; do i=is,ie + do i=is,ie iFaceHeight = 0.0 ! BBL is all relative to the surface hcorr = 0.0 do k=1,G%ke @@ -463,26 +493,35 @@ subroutine calculate_cvmix_tidal(h, G, GV, CS) cellHeight(k) = iFaceHeight(k) - 0.5 * dh iFaceHeight(k+1) = iFaceHeight(k) - dh enddo - ! Note: CVMix zw_iface (height of interfaces in column) and zt_cntr - ! (height of cell centers in column) variables are negative in the ocean. if (G%mask2dT(i,j)<1) return - call cvmix_compute_Simmons_invariant( nlev = G%ke, & - energy_flux = CS%tidal_qe_2d(i,j), & - rho = rho_fw, & - SimmonsCoeff = CS%Simmons_coeff(i,j), & - VertDep = CS%vert_dep(i,j,:), & - zw = iFaceHeight, & - zt = cellHeight ) + call cvmix_compute_Simmons_invariant( nlev = G%ke, & + energy_flux = CS%tidal_qe_2d(i,j), & + rho = rho_fw, & + SimmonsCoeff = Simmons_coeff, & + VertDep = vert_dep, & + zw = iFaceHeight, & + zt = cellHeight, & + CVmix_tidal_params_user = CS%cvmix_tidal_params) ! Since we pass tidal_qe_2d=(CS%Gamma_itides)*tidal_energy_flux_2d, and not tidal_energy_flux_2d in ! above subroutine call, we divide Simmons_coeff by CS%Gamma_itides as a corrective step: - CS%Simmons_coeff = CS%Simmons_coeff / CS%Gamma_itides + Simmons_coeff = Simmons_coeff / CS%Gamma_itides - ! TODO: check if cvmix_compute_socn_tidal_invariant call is necessary here for Simmons. - enddo ; enddo + call cvmix_coeffs_tidal( Mdiff_out = Kv_tidal, & + Tdiff_out = Kd_tidal, & + Nsqr = N2_int(i,:), & + OceanDepth = iFaceHeight(G%ke+1), & + SimmonsCoeff = Simmons_coeff, & + vert_dep = vert_dep, & + nlev = G%ke, & + max_nlev = G%ke, & + CVmix_params = CS%cvmix_glb_params, & + CVmix_tidal_params_user = CS%cvmix_tidal_params) + + enddo ! TODO: case (SCHMITTNER) case default call MOM_error(FATAL, "tidal_mixing_init: The selected"// & @@ -493,60 +532,12 @@ subroutine calculate_cvmix_tidal(h, G, GV, CS) end subroutine calculate_cvmix_tidal -! TODO: move this subroutine to MOM_internal_tide_input module (?) -subroutine read_tidal_energy(G, param_file, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle - type(tidal_mixing_cs), pointer :: CS - ! local - character(len=20) :: tidal_energy_type - character(len=200) :: tidal_energy_file - integer :: i, j, is, ie, js, je, isd, ied, jsd, jed - real, allocatable, dimension(:,:) :: tidal_energy_flux_2d ! input tidal energy flux at T-grid points (W/m^2) - - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - - call get_param(param_file, mdl, "TIDAL_ENERGY_FILE",tidal_energy_file, & - "The path to the file containing tidal energy \n"//& - "dissipation. Used with CVMix tidal mixing schemes.", & - fail_if_missing=.true.) - call get_param(param_file, mdl, "TIDAL_ENERGY_TYPE",tidal_energy_type, & - "The type of input tidal energy flux dataset.",& - fail_if_missing=.true.) - ! TODO: list all available tidal energy types here - - if (.not. allocated(CS%tidal_qe_2d)) allocate(CS%tidal_qe_2d(isd:ied,jsd:jed)) - allocate(tidal_energy_flux_2d(isd:ied,jsd:jed)) - - select case (uppercase(tidal_energy_type(1:4))) - case ('JAYN') ! Jayne 2009 input tidal energy flux - call MOM_read_data(tidal_energy_file,'wave_dissipation',tidal_energy_flux_2d, G%domain) - CS%tidal_qe_2d = (CS%Gamma_itides) * tidal_energy_flux_2d - case default - call MOM_error(FATAL, "read_tidal_energy: Unknown tidal energy file type.") - ! TODO: add more tidal energy file types, e.g., Arbic, ER03, GN13, LGM0, etc. - ! see POP::tidal_mixing.F90 - end select - - deallocate(tidal_energy_flux_2d) - -end subroutine read_tidal_energy - - -!subroutine prep_CVMix_data(G,GV,CVMix_vars,CVMix_params) -! type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure -! type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure -! -!end subroutine prep_CVMix_Data - - - - !> This subroutine adds the effect of internal-tide-driven mixing to the layer diffusivities. - !! The mechanisms considered are (1) local dissipation of internal waves generated by the - !! barotropic flow ("itidal"), (2) local dissipation of internal waves generated by the propagating - !! low modes (rays) of the internal tide ("lowmode"), and (3) local dissipation of internal lee waves. - !! Will eventually need to add diffusivity due to other wave-breaking processes (e.g. Bottom friction, - !! Froude-number-depending breaking, PSI, etc.). +!> This subroutine adds the effect of internal-tide-driven mixing to the layer diffusivities. +!! The mechanisms considered are (1) local dissipation of internal waves generated by the +!! barotropic flow ("itidal"), (2) local dissipation of internal waves generated by the propagating +!! low modes (rays) of the internal tide ("lowmode"), and (3) local dissipation of internal lee waves. +!! Will eventually need to add diffusivity due to other wave-breaking processes (e.g. Bottom friction, +!! Froude-number-depending breaking, PSI, etc.). subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & dd, N2_lay, Kd, Kd_int, Kd_max) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -939,6 +930,46 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, end subroutine add_int_tide_diffusivity +! TODO: move this subroutine to MOM_internal_tide_input module (?) +subroutine read_tidal_energy(G, param_file, CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle + type(tidal_mixing_cs), pointer :: CS + ! local + character(len=20) :: tidal_energy_type + character(len=200) :: tidal_energy_file + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed + real, allocatable, dimension(:,:) :: tidal_energy_flux_2d ! input tidal energy flux at T-grid points (W/m^2) + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + + call get_param(param_file, mdl, "TIDAL_ENERGY_FILE",tidal_energy_file, & + "The path to the file containing tidal energy \n"//& + "dissipation. Used with CVMix tidal mixing schemes.", & + fail_if_missing=.true.) + call get_param(param_file, mdl, "TIDAL_ENERGY_TYPE",tidal_energy_type, & + "The type of input tidal energy flux dataset.",& + fail_if_missing=.true.) + ! TODO: list all available tidal energy types here + + if (.not. allocated(CS%tidal_qe_2d)) allocate(CS%tidal_qe_2d(isd:ied,jsd:jed)) + allocate(tidal_energy_flux_2d(isd:ied,jsd:jed)) + + select case (uppercase(tidal_energy_type(1:4))) + case ('JAYN') ! Jayne 2009 input tidal energy flux + call MOM_read_data(tidal_energy_file,'wave_dissipation',tidal_energy_flux_2d, G%domain) + CS%tidal_qe_2d = (CS%Gamma_itides) * tidal_energy_flux_2d + case default + call MOM_error(FATAL, "read_tidal_energy: Unknown tidal energy file type.") + ! TODO: add more tidal energy file types, e.g., Arbic, ER03, GN13, LGM0, etc. + ! see POP::tidal_mixing.F90 + end select + + deallocate(tidal_energy_flux_2d) + +end subroutine read_tidal_energy + + !> Clear pointers and deallocate memory subroutine tidal_mixing_end(CS) type(tidal_mixing_cs), pointer :: CS ! This module's control structure From 4cac1e17d9024b42d475264d1526ceeefeac6cca Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 30 Mar 2018 09:49:11 -0600 Subject: [PATCH 0043/1072] Renamed variables (KH to kd; KM to kv) and added diagnostics --- .../vertical/MOM_cvmix_shear.F90 | 68 +++++++++++-------- 1 file changed, 41 insertions(+), 27 deletions(-) diff --git a/src/parameterizations/vertical/MOM_cvmix_shear.F90 b/src/parameterizations/vertical/MOM_cvmix_shear.F90 index 4a91524c76..b99382974d 100644 --- a/src/parameterizations/vertical/MOM_cvmix_shear.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_shear.F90 @@ -36,12 +36,12 @@ module MOM_cvmix_shear real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency (1/s2) real, allocatable, dimension(:,:,:) :: S2 !< Squared shear frequency (1/s2) real, allocatable, dimension(:,:,:) :: ri_grad !< Gradient Richardson number - real, allocatable, dimension(:,:,:) :: km !< vertical viscosity at interface (m2/s) - real, allocatable, dimension(:,:,:) :: kh !< vertical diffusivity at interface (m2/s) +! real, allocatable, dimension(:,:,:) :: kv !< vertical viscosity at interface (m2/s) +! real, allocatable, dimension(:,:,:) :: kd !< vertical diffusivity at interface (m2/s) character(10) :: Mix_Scheme !< Mixing scheme name (string) ! Daignostic handles and pointers type(diag_ctrl), pointer :: diag => NULL() - integer :: id_N2 = -1, id_S2 = -1, id_ri_grad = -1, id_km = -1, id_kh = -1 + integer :: id_N2 = -1, id_S2 = -1, id_ri_grad = -1, id_kv = -1, id_kd = -1 end type cvmix_shear_cs @@ -50,17 +50,17 @@ module MOM_cvmix_shear contains !> Subroutine for calculating (internal) vertical diffusivities/viscosities -subroutine calculate_cvmix_shear(u_H, v_H, h, tv, KH, & - KM, G, GV, CS ) +subroutine calculate_cvmix_shear(u_H, v_H, h, tv, kd, & + kv, G, GV, CS ) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: u_H !< Initial zonal velocity on T points, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: v_H !< Initial meridional velocity on T points, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: KH !< The vertical diffusivity at each interface + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface !! (not layer!) in m2 s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: KM !< The vertical viscosity at each interface + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface !! (not layer!) in m2 s-1. type(cvmix_shear_cs), pointer :: CS !< The control structure returned by a previous call to !! CVMix_shear_init. @@ -116,17 +116,30 @@ subroutine calculate_cvmix_shear(u_H, v_H, h, tv, KH, & N2 = DRHO/DZ S2 = (DU*DU+DV*DV)/(DZ*DZ) Ri_Grad(k) = max(0.,N2)/max(S2,1.e-16) + + ! fill 3d arrays, if user asks for diagsnostics + if (CS%id_N2 > 0) CS%N2(i,j,k) = N2 + if (CS%id_S2 > 0) CS%S2(i,j,k) = S2 + if (CS%id_ri_grad > 0) CS%ri_grad(i,j,k) = Ri_Grad(k) + enddo ! Call to CVMix wrapper for computing interior mixing coefficients. - call cvmix_coeffs_shear(Mdiff_out=KM(i,j,:), & - Tdiff_out=KH(i,j,:), & + call cvmix_coeffs_shear(Mdiff_out=kv(i,j,:), & + Tdiff_out=kd(i,j,:), & RICH=Ri_Grad, & nlev=G%ke, & max_nlev=G%ke) enddo enddo + ! write diagnostics + if (CS%id_kd > 0) call post_data(CS%id_kd,kd, CS%diag) + if (CS%id_kv > 0) call post_data(CS%id_kv,kv, CS%diag) + if (CS%id_N2 > 0) call post_data(CS%id_N2,CS%N2, CS%diag) + if (CS%id_S2 > 0) call post_data(CS%id_S2,CS%S2, CS%diag) + if (CS%id_ri_grad > 0) call post_data(CS%id_ri_grad,CS%ri_grad, CS%diag) + end subroutine calculate_cvmix_shear @@ -200,26 +213,29 @@ logical function cvmix_shear_init(Time, G, GV, param_file, diag, CS) KPP_nu_zero=CS%Nu_Zero, & KPP_Ri_zero=CS%Ri_zero, & KPP_exp=CS%KPP_exp) - ! Allocation and initialization - allocate( CS%N2( SZI_(G), SZJ_(G), SZK_(G)+1 ) );CS%N2(:,:,:) = 0. - allocate( CS%S2( SZI_(G), SZJ_(G), SZK_(G)+1 ) );CS%S2(:,:,:) = 0. - !Initialize w/ large Richardson value - allocate( CS%ri_grad( SZI_(G), SZJ_(G), SZK_(G)+1 ) );CS%ri_grad(:,:,:) = 1.e8 - ! Register diagnostics + ! Register diagnostics; allocation and initialization CS%diag => diag - CS%id_N2 = register_diag_field('ocean_model', 'shear_N2', diag%axesTi, Time, & + + CS%id_N2 = register_diag_field('ocean_model', 'N2_shear', diag%axesTi, Time, & 'Square of Brunt-Vaisala frequency used by MOM_cvmix_shear module', '1/s2') - CS%id_S2 = register_diag_field('ocean_model', 'shear_S2', diag%axesTi, Time, & + if (CS%id_N2 > 0) & + allocate( CS%N2( SZI_(G), SZJ_(G), SZK_(G)+1 ) );CS%N2(:,:,:) = 0. + + CS%id_S2 = register_diag_field('ocean_model', 'S2_shear', diag%axesTi, Time, & 'Square of vertical shear used by MOM_cvmix_shear module','1/s2') - CS%id_ri_grad = register_diag_field('ocean_model', 'shear_ri_grad', diag%axesTi, Time, & + if (CS%id_S2 > 0) & + allocate( CS%S2( SZI_(G), SZJ_(G), SZK_(G)+1 ) );CS%S2(:,:,:) = 0. + + CS%id_ri_grad = register_diag_field('ocean_model', 'ri_grad_shear', diag%axesTi, Time, & 'Gradient Richarson number used by MOM_cvmix_shear module','nondim') - CS%id_kh = register_diag_field('ocean_model', 'shear_KH', diag%axesTi, Time, & + if (CS%id_ri_grad > 0) & !Initialize w/ large Richardson value + allocate( CS%ri_grad( SZI_(G), SZJ_(G), SZK_(G)+1 ));CS%ri_grad(:,:,:) = 1.e8 + + CS%id_kd = register_diag_field('ocean_model', 'kd_shear', diag%axesTi, Time, & 'Vertical diffusivity added by MOM_cvmix_shear module', 'm2/s') - if (CS%id_kh > 0) allocate(CS%kh(SZI_(G), SZJ_(G), SZK_(G)+1)) - CS%id_km = register_diag_field('ocean_model', 'shear_KM', diag%axesTi, Time, & + CS%id_kv = register_diag_field('ocean_model', 'kv_shear', diag%axesTi, Time, & 'Vertical viscosity added by MOM_cvmix_shear module', 'm2/s') - if (CS%id_km > 0) allocate(CS%km(SZI_(G), SZJ_(G), SZK_(G)+1)) end function cvmix_shear_init @@ -241,11 +257,9 @@ end function cvmix_shear_is_used subroutine cvmix_shear_end(CS) type(cvmix_shear_cs), pointer :: CS ! Control structure - deallocate(CS%N2) - deallocate(CS%S2) - deallocate(CS%ri_grad) - if (CS%id_kh > 0) deallocate(CS%kh, CS%diag) - if (CS%id_km > 0) deallocate(CS%km, CS%diag) + if (CS%id_N2 > 0) deallocate(CS%N2) + if (CS%id_S2 > 0) deallocate(CS%S2) + if (CS%id_ri_grad > 0) deallocate(CS%ri_grad) deallocate(CS) end subroutine cvmix_shear_end From 69ab99895da933072fd3b9d9d0d7f2df751c8481 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 30 Mar 2018 10:18:16 -0600 Subject: [PATCH 0044/1072] Added a unique Prandtl # for convection and background --- .../vertical/MOM_bkgnd_mixing.F90 | 11 +++++++---- .../vertical/MOM_cvmix_conv.F90 | 17 +++++++++-------- 2 files changed, 16 insertions(+), 12 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index ba7711586c..d249cec5a8 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -46,7 +46,8 @@ module MOM_bkgnd_mixing real :: N0_2Omega !< ratio of the typical Buoyancy frequency to !! twice the Earth's rotation period, used with the !! Henyey scaling from the mixing - real :: prandtl_turb !< Turbulent Prandtl number + real :: prandtl_bkgnd !< Turbulent Prandtl number used to convert + !! vertical background diffusivity into viscosity real :: Kd_tanh_lat_scale !< A nondimensional scaling for the range of !! diffusivities with Kd_tanh_lat_fn. Valid values !! are in the range of -2 to 2; 0.4 reproduces CM2M. @@ -155,8 +156,10 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) - call get_param(param_file, mdl, "PRANDTL_TURB", CS%prandtl_turb, & - units="nondim", default=1.0, do_not_log=.true.) + call get_param(param_file, mdl, "PRANDTL_BKGND", CS%prandtl_bkgnd, & + "Turbulent Prandtl number used to convert vertical \n"//& + "background diffusivities into viscosities.", & + units="nondim", default=1.0) ! call openParameterBlock(param_file,'MOM_BACKGROUND_MIXING') @@ -349,7 +352,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd, j, G, GV, CS) bl2 = CS%Bryan_Lewis_c2, & bl3 = CS%Bryan_Lewis_c3, & bl4 = CS%Bryan_Lewis_c4, & - prandtl = CS%prandtl_turb) + prandtl = CS%prandtl_bkgnd) call cvmix_coeffs_bkgnd(Mdiff_out=CS%kv_bkgnd(i,j,:), & Tdiff_out=CS%kd_bkgnd(i,j,:), & diff --git a/src/parameterizations/vertical/MOM_cvmix_conv.F90 b/src/parameterizations/vertical/MOM_cvmix_conv.F90 index 721c35faa2..38ea8e6851 100644 --- a/src/parameterizations/vertical/MOM_cvmix_conv.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_conv.F90 @@ -59,8 +59,8 @@ logical function cvmix_conv_init(Time, G, GV, param_file, diag, CS) type(cvmix_conv_cs), pointer :: CS !< This module's control structure. ! Local variables - real :: prandtl_turb - logical :: useEPBL + real :: prandtl_conv !< Turbulent Prandtl number used in convective instabilities. + logical :: useEPBL !< If True, use the ePBL boundary layer scheme. ! This include declares and sets the variable "version". #include "version_variable.h" @@ -95,16 +95,17 @@ logical function cvmix_conv_init(Time, G, GV, param_file, diag, CS) 'as convective mixing might occur in the boundary layer.') endif - call get_param(param_file, mdl, "PRANDTL_TURB", Prandtl_turb, & - "The turbulent Prandtl number applied to shear/conv. \n"//& - "instabilities.", units="nondim", default=1.0, do_not_log=.true.) - call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, default=0.001, do_not_log=.True.) call openParameterBlock(param_file,'CVMIX_CONVECTION') + call get_param(param_file, mdl, "PRANDTL_CONV", prandtl_conv, & + "The turbulent Prandtl number applied to convective \n"//& + "instabilities (i.e., used to convert KD_CONV into KV_CONV)", & + units="nondim", default=1.0) + call get_param(param_file, mdl, 'KD_CONV', CS%kd_conv, & "Diffusivity used in convective regime. Corresponding viscosity \n" // & "(KV_CONV) will be set to KD_CONV * PRANDTL_TURB.", & @@ -117,8 +118,8 @@ logical function cvmix_conv_init(Time, G, GV, param_file, diag, CS) call closeParameterBlock(param_file) - ! set kv_conv based on kd_conv and Prandtl_turb - CS%kv_conv = CS%kd_conv * Prandtl_turb + ! set kv_conv based on kd_conv and prandtl_conv + CS%kv_conv = CS%kd_conv * prandtl_conv ! allocate arrays and set them to zero allocate(CS%N2(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%N2(:,:,:) = 0. From 7376f49c32d7afd8dc2557e695233d1ef29b5b2a Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Fri, 30 Mar 2018 10:19:26 -0600 Subject: [PATCH 0045/1072] update Kd --- .../vertical/MOM_tidal_mixing.F90 | 60 ++++++++++--------- 1 file changed, 32 insertions(+), 28 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 88936940d0..bb29d3ae66 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -447,7 +447,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then if (CS%use_cvmix_tidal) then - call calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd_int) + call calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) else call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS,dd, & N2_lay, Kd, Kd_int, Kd_max) @@ -456,14 +456,14 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & end subroutine -subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd_int) - integer, intent(in) :: j - type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(tidal_mixing_cs), pointer :: CS !< This module's control structure. - real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: N2_int - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int +subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) + integer, intent(in) :: j + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(tidal_mixing_cs), pointer :: CS !< This module's control structure. + real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: N2_int + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd ! local logical, parameter :: init_every_tstep = .true. @@ -496,13 +496,13 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd_int) if (G%mask2dT(i,j)<1) return - call cvmix_compute_Simmons_invariant( nlev = G%ke, & - energy_flux = CS%tidal_qe_2d(i,j), & - rho = rho_fw, & - SimmonsCoeff = Simmons_coeff, & - VertDep = vert_dep, & - zw = iFaceHeight, & - zt = cellHeight, & + call cvmix_compute_Simmons_invariant( nlev = G%ke, & + energy_flux = CS%tidal_qe_2d(i,j), & + rho = rho_fw, & + SimmonsCoeff = Simmons_coeff, & + VertDep = vert_dep, & + zw = iFaceHeight, & + zt = cellHeight, & CVmix_tidal_params_user = CS%cvmix_tidal_params) ! Since we pass tidal_qe_2d=(CS%Gamma_itides)*tidal_energy_flux_2d, and not tidal_energy_flux_2d in @@ -521,6 +521,10 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd_int) CVmix_params = CS%cvmix_glb_params, & CVmix_tidal_params_user = CS%cvmix_tidal_params) + do k=1,G%ke + Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_tidal(k) + Kd_tidal(k+1) ) + !TODO: Kv(i,j,k) = ???????????? + enddo enddo ! TODO: case (SCHMITTNER) case default @@ -540,18 +544,18 @@ end subroutine calculate_cvmix_tidal !! Froude-number-depending breaking, PSI, etc.). subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & dd, N2_lay, Kd, Kd_int, Kd_max) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZI_(G)), intent(in) :: N2_bot - real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay - integer, intent(in) :: j - real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd, max_TKE - type(tidal_mixing_cs), pointer :: CS - type(tidal_mixing_diags), intent(inout) :: dd - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G)), intent(in) :: N2_bot + real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay + integer, intent(in) :: j + real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd, max_TKE + type(tidal_mixing_cs), pointer :: CS + type(tidal_mixing_diags), intent(inout) :: dd + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int - real, intent(inout) :: Kd_max + real, intent(inout) :: Kd_max ! This subroutine adds the effect of internal-tide-driven mixing to the layer diffusivities. @@ -975,7 +979,7 @@ subroutine tidal_mixing_end(CS) type(tidal_mixing_cs), pointer :: CS ! This module's control structure !TODO deallocate all the dynamically allocated members here ... - deallocate(CS%tidal_qe_2d) + if (allocated(CS%tidal_qe_2d)) deallocate(CS%tidal_qe_2d) deallocate(CS) ! TODO: check why ptrs allocated with MOM_safe_alloc are not deallocated? From 6a2e864f3732e7eafcb2f51b25ac7696ad5fffcd Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 30 Mar 2018 10:49:33 -0600 Subject: [PATCH 0046/1072] Replaced Kd_turb -> Kd_shear and Kv_turb -> Kv_shear --- src/core/MOM_variables.F90 | 10 +++---- .../vertical/MOM_diabatic_driver.F90 | 24 ++++++++--------- .../vertical/MOM_kappa_shear.F90 | 6 ++--- .../vertical/MOM_set_diffusivity.F90 | 26 +++++++++---------- .../vertical/MOM_set_viscosity.F90 | 16 ++++++------ 5 files changed, 41 insertions(+), 41 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index f0f3437f4b..4b85111a21 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -173,7 +173,7 @@ module MOM_variables !! coefficients, and related fields. type, public :: vertvisc_type real :: Prandtl_turb !< The Prandtl number for the turbulent diffusion - !! that is captured in Kd_turb. + !! that is captured in Kd_shear. real, pointer, dimension(:,:) :: & bbl_thick_u => NULL(), & !< The bottom boundary layer thickness at the !! u-points, in m. @@ -224,10 +224,10 @@ module MOM_variables ! Kd_extra_S is positive for salt fingering; Kd_extra_T ! is positive for double diffusive convection. These ! are only allocated if DOUBLE_DIFFUSION is true. - Kd_turb => NULL(), &!< The turbulent diapycnal diffusivity at the interfaces - !! between each layer, in m2 s-1. - Kv_turb => NULL(), &!< The turbulent vertical viscosity at the interfaces - !! between each layer, in m2 s-1. + Kd_shear => NULL(), &!< The shear-driven turbulent diapycnal diffusivity + !! at the interfaces between each layer, in m2 s-1. + Kv_shear => NULL(), &!< The shear-driven turbulent vertical viscosity + !! at the interfaces between each layer, in m2 s-1. TKE_turb => NULL() !< The turbulent kinetic energy per unit mass defined !! at the interfaces between each layer, in m2 s-2. end type vertvisc_type diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index cc0e9e7501..de8c01ac7f 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -582,8 +582,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G call cpu_clock_begin(id_clock_set_diffusivity) ! Sets: Kd, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S - ! Also changes: visc%Kd_turb, visc%TKE_turb (not clear that TKE_turb is used as input ????) - ! And sets visc%Kv_turb + ! Also changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ???? + ! And sets visc%Kv_shear call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, CS%set_diff_CSp, Kd, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -632,7 +632,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G !$OMP end parallel call KPP_calculate(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, & - fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, Kd_salt, visc%Kv_turb, CS%KPP_NLTheat, CS%KPP_NLTscalar) + fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar) !$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,Kd_heat) if (associated(Hml)) then @@ -678,9 +678,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! do k=1,nz ; do j=js,je ; do i=is,ie Kd_int(i,j,k) = Kd_int(i,j,k) + CS%cvmix_conv_csp%kd_conv_3d(i,j,k) - ! GMM, I am not sure if Kv_turb is the right place to add kv_conv_3d - visc%Kv_turb(i,j,k) = visc%Kv_turb(i,j,k) + CS%cvmix_conv_csp%kv_conv_3d(i,j,k) - visc%Kd_turb(i,j,k) = visc%Kd_turb(i,j,k) + CS%cvmix_conv_csp%kd_conv_3d(i,j,k) + ! GMM, I am not sure if Kv_shear is the right place to add kv_conv_3d + visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + CS%cvmix_conv_csp%kv_conv_3d(i,j,k) + visc%Kd_shear(i,j,k) = visc%Kd_shear(i,j,k) + CS%cvmix_conv_csp%kd_conv_3d(i,j,k) enddo ; enddo ; enddo !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -829,10 +829,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G if (CS%ePBL_is_additive) then Kd_add_here = Kd_ePBL(i,j,K) - visc%Kv_turb(i,j,K) = visc%Kv_turb(i,j,K) + Kd_ePBL(i,j,K) + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) else - Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_turb(i,j,K), 0.0) - visc%Kv_turb(i,j,K) = max(visc%Kv_turb(i,j,K), Kd_ePBL(i,j,K)) + Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) + visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) endif Ent_int = Kd_add_here * (GV%m_to_H**2 * dt) / & (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) @@ -1365,9 +1365,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G call create_group_pass(CS%pass_hold_eb_ea, eb, G%Domain, dir_flag, halo=1) call create_group_pass(CS%pass_hold_eb_ea, ea, G%Domain, dir_flag, halo=1) call do_group_pass(CS%pass_hold_eb_ea, G%Domain) - ! visc%Kv_turb is not in the group pass because it has larger vertical extent. - if (associated(visc%Kv_turb)) & - call pass_var(visc%Kv_turb, G%Domain, To_All+Omit_Corners, halo=1) + ! visc%Kv_shear is not in the group pass because it has larger vertical extent. + if (associated(visc%Kv_shear)) & + call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) call cpu_clock_end(id_clock_pass) if (.not. CS%useALEalgorithm) then diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index ce32e25b49..6794d7b45b 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -71,7 +71,7 @@ module MOM_kappa_shear real :: TKE_bg ! The background level of TKE, in m2 s-2. real :: kappa_0 ! The background diapycnal diffusivity, in m2 s-1. real :: kappa_tol_err ! The fractional error in kappa that is tolerated. - real :: Prandtl_turb ! Prandtl number used to convert Kd_turb into viscosity. + real :: Prandtl_turb ! Prandtl number used to convert Kd_shear into viscosity. integer :: nkml ! The number of layers in the mixed layer, as ! treated in this routine. If the pieces of the ! mixed layer are not to be treated collectively, @@ -130,7 +130,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & intent(inout) :: kv_io !< The vertical viscosity at each interface !! (not layer!) in m2 s-1. This discards any !! previous value i.e. intent(out) and simply - !! sets Kv = Prandtl * Kd_turb + !! sets Kv = Prandtl * Kd_shear real, intent(in) :: dt !< Time increment, in s. type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous !! call to kappa_shear_init. @@ -156,7 +156,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & ! the iteration toward convergence. ! (in/out) kv_io - The vertical viscosity at each interface ! (not layer!) in m2 s-1. This discards any previous value -! i.e. intent(out) and simply sets Kv = Prandtl * Kd_turb +! i.e. intent(out) and simply sets Kv = Prandtl * Kd_shear ! (in) dt - Time increment, in s. ! (in) G - The ocean's grid structure. ! (in) GV - The ocean's vertical grid structure. diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 81babcd2bd..a672faecc1 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -461,22 +461,22 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call hchksum(v_h, "before calc_KS v_h",G%HI) endif call cpu_clock_begin(id_clock_kappaShear) - ! Changes: visc%Kd_turb, visc%TKE_turb (not clear that TKE_turb is used as input ????) - ! Sets visc%Kv_turb - call calculate_kappa_shear(u_h, v_h, h, tv, fluxes%p_surf, visc%Kd_turb, visc%TKE_turb, & - visc%Kv_turb, dt, G, GV, CS%kappaShear_CSp) + ! Changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ????) + ! Sets visc%Kv_shear + call calculate_kappa_shear(u_h, v_h, h, tv, fluxes%p_surf, visc%Kd_shear, visc%TKE_turb, & + visc%Kv_shear, dt, G, GV, CS%kappaShear_CSp) call cpu_clock_end(id_clock_kappaShear) if (CS%debug) then - call hchksum(visc%Kd_turb, "after calc_KS visc%Kd_turb",G%HI) - call hchksum(visc%Kv_turb, "after calc_KS visc%Kv_turb",G%HI) + call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear",G%HI) + call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear",G%HI) call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb",G%HI) endif if (showCallTree) call callTree_waypoint("done with calculate_kappa_shear (set_diffusivity)") elseif (CS%use_cvmix_shear) then !NOTE{BGR}: this needs to be cleaned up. It works in 1D case, but has not been tested outside. - call calculate_cvmix_shear(u_h, v_h, h, tv, visc%Kd_turb, visc%Kv_turb,G,GV,CS%cvmix_shear_csp) - elseif (associated(visc%Kv_turb)) then - visc%Kv_turb(:,:,:) = 0. ! needed if calculate_kappa_shear is not enabled + call calculate_cvmix_shear(u_h, v_h, h, tv, visc%Kd_shear, visc%Kv_shear,G,GV,CS%cvmix_shear_csp) + elseif (associated(visc%Kv_shear)) then + visc%Kv_shear(:,:,:) = 0. ! needed if calculate_kappa_shear is not enabled endif ! Calculate the diffusivity, Kd, for each layer. This would be @@ -539,15 +539,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%useKappaShear .or. CS%use_cvmix_shear) then if (present(Kd_int)) then do K=2,nz ; do i=is,ie - Kd_int(i,j,K) = visc%Kd_turb(i,j,K) + 0.5*(Kd(i,j,k-1) + Kd(i,j,k)) + Kd_int(i,j,K) = visc%Kd_shear(i,j,K) + 0.5*(Kd(i,j,k-1) + Kd(i,j,k)) enddo ; enddo do i=is,ie - Kd_int(i,j,1) = visc%Kd_turb(i,j,1) ! This isn't actually used. It could be 0. + Kd_int(i,j,1) = visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. Kd_int(i,j,nz+1) = 0.0 enddo endif do k=1,nz ; do i=is,ie - Kd(i,j,k) = Kd(i,j,k) + 0.5*(visc%Kd_turb(i,j,K) + visc%Kd_turb(i,j,K+1)) + Kd(i,j,k) = Kd(i,j,k) + 0.5*(visc%Kd_shear(i,j,K) + visc%Kd_shear(i,j,K+1)) enddo ; enddo else if (present(Kd_int)) then @@ -635,7 +635,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & !!if (associated(CS%bkgnd_mixing_csp%kv_bkgnd)) & !! call hchksum(CS%bkgnd_mixing_csp%kv_bkgnd, "kv_bkgnd",G%HI,haloshift=0) - if (CS%useKappaShear) call hchksum(visc%Kd_turb,"Turbulent Kd",G%HI,haloshift=0) + if (CS%useKappaShear) call hchksum(visc%Kd_shear,"Turbulent Kd",G%HI,haloshift=0) if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then call uvchksum("BBL Kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, & diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 60c96fbb37..8ab4bafb75 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1808,20 +1808,20 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) endif if (use_kappa_shear .or. useKPP .or. useEPBL .or. use_cvmix_shear .or. use_cvmix_conv) then - allocate(visc%Kd_turb(isd:ied,jsd:jed,nz+1)) ; visc%Kd_turb(:,:,:) = 0.0 + allocate(visc%Kd_shear(isd:ied,jsd:jed,nz+1)) ; visc%Kd_shear(:,:,:) = 0.0 allocate(visc%TKE_turb(isd:ied,jsd:jed,nz+1)) ; visc%TKE_turb(:,:,:) = 0.0 - allocate(visc%Kv_turb(isd:ied,jsd:jed,nz+1)) ; visc%Kv_turb(:,:,:) = 0.0 + allocate(visc%Kv_shear(isd:ied,jsd:jed,nz+1)) ; visc%Kv_shear(:,:,:) = 0.0 - vd = var_desc("Kd_turb","m2 s-1","Turbulent diffusivity at interfaces", & + vd = var_desc("Kd_shear","m2 s-1","Shear-driven turbulent diffusivity at interfaces", & hor_grid='h', z_grid='i') - call register_restart_field(visc%Kd_turb, vd, .false., restart_CS) + call register_restart_field(visc%Kd_shear, vd, .false., restart_CS) vd = var_desc("TKE_turb","m2 s-2","Turbulent kinetic energy per unit mass at interfaces", & hor_grid='h', z_grid='i') call register_restart_field(visc%TKE_turb, vd, .false., restart_CS) - vd = var_desc("Kv_turb","m2 s-1","Turbulent viscosity at interfaces", & + vd = var_desc("Kv_shear","m2 s-1","Shear-driven turbulent viscosity at interfaces", & hor_grid='h', z_grid='i') - call register_restart_field(visc%Kv_turb, vd, .false., restart_CS) + call register_restart_field(visc%Kv_shear, vd, .false., restart_CS) endif ! visc%MLD is used to communicate the state of the (e)PBL to the rest of the model @@ -2092,9 +2092,9 @@ subroutine set_visc_end(visc, CS) if (CS%dynamic_viscous_ML) then deallocate(visc%nkml_visc_u) ; deallocate(visc%nkml_visc_v) endif - if (associated(visc%Kd_turb)) deallocate(visc%Kd_turb) + if (associated(visc%Kd_shear)) deallocate(visc%Kd_shear) if (associated(visc%TKE_turb)) deallocate(visc%TKE_turb) - if (associated(visc%Kv_turb)) deallocate(visc%Kv_turb) + if (associated(visc%Kv_shear)) deallocate(visc%Kv_shear) if (associated(visc%ustar_bbl)) deallocate(visc%ustar_bbl) if (associated(visc%TKE_bbl)) deallocate(visc%TKE_bbl) if (associated(visc%taux_shelf)) deallocate(visc%taux_shelf) From 644f200d9ac682c0348a60f800acec0e65ce0b2f Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 30 Mar 2018 11:05:41 -0600 Subject: [PATCH 0047/1072] Replaced Kv_turb -> Kv_shear --- .../vertical/MOM_vert_friction.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index fee1fb456a..ff14a698ed 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1094,21 +1094,21 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif endif ; enddo - if (associated(visc%Kv_turb)) then - ! BGR/ Add factor of 2. * the averaged Kv_turb. + if (associated(visc%Kv_shear)) then + ! BGR/ Add factor of 2. * the averaged Kv_shear. ! this is needed to reproduce the analytical solution to ! a simple diffusion problem, likely due to h_shear being ! equal to 2 x \delta z if (work_on_u) then do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = (2.*0.5)*(visc%Kv_turb(i,j,k) + visc%Kv_turb(i+1,j,k)) + Kv_add(i,K) = (2.*0.5)*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i+1,j,k)) endif ; enddo ; enddo if (do_OBCs) then do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_turb(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_turb(i+1,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i+1,j,k) ; enddo endif endif ; enddo endif @@ -1117,14 +1117,14 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = (2.*0.5)*(visc%Kv_turb(i,j,k) + visc%Kv_turb(i,j+1,k)) + Kv_add(i,K) = (2.*0.5)*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i,j+1,k)) endif ; enddo ; enddo if (do_OBCs) then do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_turb(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_turb(i,j+1,k) ; enddo + do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j+1,k) ; enddo endif endif ; enddo endif From 80c33a469bfb5111e3f2a8182ab504d10fa8bce0 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 30 Mar 2018 11:10:49 -0600 Subject: [PATCH 0048/1072] Replaced Kv_turb -> Kv_shear --- src/core/MOM.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index bcf6516505..22dbb86b15 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1448,7 +1448,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & real, dimension(:,:), pointer :: shelf_area type(MOM_restart_CS), pointer :: restart_CSp_tmp => NULL() type(group_pass_type) :: tmp_pass_uv_T_S_h, pass_uv_T_S_h - type(group_pass_type) :: tmp_pass_Kv_turb + ! GMM, the following *is not* used. Should we delete it? + type(group_pass_type) :: tmp_pass_Kv_shear real :: default_val ! default value for a parameter logical :: write_geom_files ! If true, write out the grid geometry files. @@ -2288,8 +2289,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call do_group_pass(pass_uv_T_S_h, G%Domain) - if (associated(CS%visc%Kv_turb)) & - call pass_var(CS%visc%Kv_turb, G%Domain, To_All+Omit_Corners, halo=1) + if (associated(CS%visc%Kv_shear)) & + call pass_var(CS%visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) call cpu_clock_end(id_clock_pass_init) From a3155d6e9e41fd05803a0b72d722e06ee7e6bfc6 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Fri, 30 Mar 2018 18:53:39 -0600 Subject: [PATCH 0049/1072] Add tidal parameter consistency checks. --- .../vertical/MOM_tidal_mixing.F90 | 89 ++++++++++++------- 1 file changed, 57 insertions(+), 32 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index bb29d3ae66..56ff3a3419 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -13,7 +13,7 @@ module MOM_tidal_mixing use MOM_verticalGrid, only : verticalGrid_type use MOM_file_parser, only : openParameterBlock, closeParameterBlock use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_string_functions, only : uppercase +use MOM_string_functions, only : uppercase, lowercase use MOM_io, only : slasher, MOM_read_data use cvmix_tidal, only : cvmix_init_tidal, cvmix_compute_Simmons_invariant use cvmix_tidal, only : cvmix_coeffs_tidal, cvmix_tidal_params_type @@ -137,8 +137,8 @@ module MOM_tidal_mixing character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name. character*(20), parameter :: STLAURENT_PROFILE_STRING = "STLAURENT_02" character*(20), parameter :: POLZIN_PROFILE_STRING = "POLZIN_09" -character*(20), parameter :: SIMMONS_PROFILE_STRING = "Simmons" -character*(20), parameter :: SCHMITTNER_PROFILE_STRING = "Schmittner" +character*(20), parameter :: SIMMONS_PROFILE_STRING = "SIMMONS" +character*(20), parameter :: SCHMITTNER_PROFILE_STRING = "SCHMITTNER" integer, parameter :: STLAURENT_02 = 1 integer, parameter :: POLZIN_09 = 2 integer, parameter :: SIMMONS_04 = 3 @@ -158,7 +158,9 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) ! Local variables logical :: read_tideamp character(len=20) :: tmpstr, int_tide_profile_str - character(len=200) :: filename, tideamp_file, h2_file, Niku_TKE_input_file + character(len=20) :: default_profile_string, tidal_energy_type + character(len=200) :: filename, h2_file, Niku_TKE_input_file + character(len=200) :: tidal_energy_file, tideamp_file real :: utide, zbot, hamp, prandtl real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data integer :: i, j, is, ie, js, je @@ -183,7 +185,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) call log_version(param_file, mdl, version, & "Vertical Tidal Mixing Parameterization") call get_param(param_file, mdl, "USE_CVMIX_TIDAL", CS%use_cvmix_tidal, & - "If true, turns on tidal mixing scheme via CVMix", & + "If true, turns on tidal mixing via CVMix", & default=.false.) call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, default=".",do_not_log=.true.) @@ -191,8 +193,10 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "INT_TIDE_DISSIPATION", CS%int_tide_dissipation, & "If true, use an internal tidal dissipation scheme to \n"//& "drive diapycnal mixing, along the lines of St. Laurent \n"//& - "et al. (2002) and Simmons et al. (2004).", default=.false.) + "et al. (2002) and Simmons et al. (2004).", default=CS%use_cvmix_tidal) if (CS%int_tide_dissipation) then + default_profile_string = STLAURENT_PROFILE_STRING + if (CS%use_cvmix_tidal) default_profile_string = SIMMONS_PROFILE_STRING call get_param(param_file, mdl, "INT_TIDE_PROFILE", int_tide_profile_str, & "INT_TIDE_PROFILE selects the vertical profile of energy \n"//& "dissipation with INT_TIDE_DISSIPATION. Valid values are:\n"//& @@ -200,7 +204,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) "\t decay profile.\n"//& "\t POLZIN_09 - Use the Polzin WKB-streched algebraic \n"//& "\t decay profile.", & - default=STLAURENT_PROFILE_STRING) + default=default_profile_string) ! TODO: list the newly available profile selections int_tide_profile_str = uppercase(int_tide_profile_str) select case (int_tide_profile_str) @@ -212,6 +216,24 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) call MOM_error(FATAL, "tidal_mixing_init: Unrecognized setting "// & "#define INT_TIDE_PROFILE "//trim(int_tide_profile_str)//" found in input file.") end select + + ! Check profile consistency + if (CS%use_cvmix_tidal .and. (CS%int_tide_profile.eq.STLAURENT_02 .or. & + CS%int_tide_profile.eq.POLZIN_09)) then + call MOM_error(FATAL, "tidal_mixing_init: Tidal mixing profile"// & + " "//trim(int_tide_profile_str)//" unavailable in CVMix. Available "//& + "profiles in CVMix are "//trim(SIMMONS_PROFILE_STRING)//" and "//& + trim(SCHMITTNER_PROFILE_STRING)//".") + else if (.not.CS%use_cvmix_tidal .and. (CS%int_tide_profile.eq.SIMMONS_04.or. & + CS%int_tide_profile.eq.SCHMITTNER)) then + call MOM_error(FATAL, "tidal_mixing_init: Tidal mixing profiles "// & + trim(SIMMONS_PROFILE_STRING)//" and "//trim(SCHMITTNER_PROFILE_STRING)//& + " are available only when USE_CVMIX_TIDAL is True.") + endif + + else if (CS%use_cvmix_tidal) then + call MOM_error(FATAL, "tidal_mixing_init: Cannot set INT_TIDE_DISSIPATION to False "// & + "when USE_CVMIX_TIDAL is set to True.") endif call get_param(param_file, mdl, "LEE_WAVE_DISSIPATION", CS%Lee_wave_dissipation, & @@ -220,6 +242,10 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) "(2010) and using the St. Laurent et al. (2002) \n"//& "and Simmons et al. (2004) vertical profile", default=.false.) if (CS%lee_wave_dissipation) then + if (CS%use_cvmix_tidal) then + call MOM_error(FATAL, "tidal_mixing_init: Lee wave driven dissipation scheme cannot "// & + "be used when CVMix tidal mixing scheme is active.") + end if call get_param(param_file, mdl, "LEE_WAVE_PROFILE", tmpstr, & "LEE_WAVE_PROFILE selects the vertical profile of energy \n"//& "dissipation with LEE_WAVE_DISSIPATION. Valid values are:\n"//& @@ -247,6 +273,10 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) if ((CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09)) .or. & (CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09))) then + if (CS%use_cvmix_tidal) then + call MOM_error(FATAL, "tidal_mixing_init: Polzin scheme cannot "// & + "be used when CVMix tidal mixing scheme is active.") + end if call get_param(param_file, mdl, "NU_POLZIN", CS%Nu_Polzin, & "When the Polzin decay profile is used, this is a \n"//& "non-dimensional constant in the expression for the \n"//& @@ -321,6 +351,10 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) "If true, read a file (given by TIDEAMP_FILE) containing \n"//& "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) if (read_tideamp) then + if (CS%use_cvmix_tidal) then + call MOM_error(FATAL, "tidal_mixing_init: Tidal amplitude files are "// & + "not compatible with CVMix tidal mixing. ") + end if call get_param(param_file, mdl, "TIDEAMP_FILE", tideamp_file, & "The path to the file containing the spatially varying \n"//& "tidal amplitudes with INT_TIDE_DISSIPATION.", default="tideamp.nc") @@ -388,26 +422,26 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) if (CS%use_cvmix_tidal) then ! Read in CVMix params - call openParameterBlock(param_file,'CVMIX_TIDAL') + !call openParameterBlock(param_file,'CVMIX_TIDAL') call get_param(param_file, mdl, "TIDAL_MAX_COEF", CS%tidal_max_coef, & "largest acceptable value for tidal diffusivity", & - units="m^2/s", default=100e-4, & ! the default is 50e-4 in CVMIX, 100e-4 in POP. - fail_if_missing=.true.) + units="m^2/s", default=50e-4) ! the default is 50e-4 in CVMIX, 100e-4 in POP. + call get_param(param_file, mdl, "TIDAL_ENERGY_FILE",tidal_energy_file, & + "The path to the file containing tidal energy \n"//& + "dissipation. Used with CVMix tidal mixing schemes.", & + fail_if_missing=.true.) + call get_param(param_file, mdl, "TIDAL_ENERGY_TYPE",tidal_energy_type, & + "The type of input tidal energy flux dataset.",& + fail_if_missing=.true.) + ! TODO: list all available tidal energy types here call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, default=0.001, & do_not_log=.True.) call get_param(param_file, mdl, "PRANDTL_TURB", prandtl,units="nondim", default=1.0, & do_not_log=.true.) call cvmix_put(CS%cvmix_glb_params,'Prandtl',prandtl) + int_tide_profile_str = lowercase(int_tide_profile_str) - ! Check if the chosen tidal mixing scheme is available in CVMix - select case (int_tide_profile_str) - case (SIMMONS_PROFILE_STRING) ; continue - case (SCHMITTNER_PROFILE_STRING) ; continue - case default - call MOM_error(FATAL, "tidal_mixing_init: Tidal mixing scheme"// & - " "//trim(int_tide_profile_str)//" unavailable in CVMix") - end select ! TODO: check parameter consistency. (see POP::tidal_mixing.F90::tidal_check) @@ -420,9 +454,9 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) local_mixing_frac = CS%Gamma_itides, & depth_cutoff = CS%min_zbot_itides) - call read_tidal_energy(G,param_file,CS) + call read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS) - call closeParameterBlock(param_file) + !call closeParameterBlock(param_file) endif ! cvmix on @@ -935,26 +969,17 @@ end subroutine add_int_tide_diffusivity ! TODO: move this subroutine to MOM_internal_tide_input module (?) -subroutine read_tidal_energy(G, param_file, CS) +subroutine read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle + character(len=20), intent(in) :: tidal_energy_type + character(len=200), intent(in) :: tidal_energy_file type(tidal_mixing_cs), pointer :: CS ! local - character(len=20) :: tidal_energy_type - character(len=200) :: tidal_energy_file integer :: i, j, is, ie, js, je, isd, ied, jsd, jed real, allocatable, dimension(:,:) :: tidal_energy_flux_2d ! input tidal energy flux at T-grid points (W/m^2) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - call get_param(param_file, mdl, "TIDAL_ENERGY_FILE",tidal_energy_file, & - "The path to the file containing tidal energy \n"//& - "dissipation. Used with CVMix tidal mixing schemes.", & - fail_if_missing=.true.) - call get_param(param_file, mdl, "TIDAL_ENERGY_TYPE",tidal_energy_type, & - "The type of input tidal energy flux dataset.",& - fail_if_missing=.true.) - ! TODO: list all available tidal energy types here if (.not. allocated(CS%tidal_qe_2d)) allocate(CS%tidal_qe_2d(isd:ied,jsd:jed)) allocate(tidal_energy_flux_2d(isd:ied,jsd:jed)) From 2430f6e90cadf24e874247aaa96c6979fec51d14 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Sun, 1 Apr 2018 14:32:51 -0600 Subject: [PATCH 0050/1072] correct tidal energy file dir --- src/parameterizations/vertical/MOM_tidal_mixing.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 56ff3a3419..e391bcb337 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -430,6 +430,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) "The path to the file containing tidal energy \n"//& "dissipation. Used with CVMix tidal mixing schemes.", & fail_if_missing=.true.) + tidal_energy_file = trim(CS%inputdir) // trim(tidal_energy_file) call get_param(param_file, mdl, "TIDAL_ENERGY_TYPE",tidal_energy_type, & "The type of input tidal energy flux dataset.",& fail_if_missing=.true.) From 89778884c66181d9654e1754131623706806b9bb Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Mon, 2 Apr 2018 16:31:43 -0600 Subject: [PATCH 0051/1072] Move tidal diagnostics to MOM_tidal_mixing module --- .../vertical/MOM_diabatic_driver.F90 | 2 +- .../vertical/MOM_set_diffusivity.F90 | 201 +--------- .../vertical/MOM_tidal_mixing.F90 | 344 +++++++++++++++--- 3 files changed, 312 insertions(+), 235 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 62757dff71..fc07783750 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -2330,7 +2330,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, ! CS%use_tidal_mixing is set to True if an internal tidal dissipation scheme ! is to be used to drive diapycnal mixing. - CS%use_tidal_mixing = tidal_mixing_init(Time, G, GV, param_file, diag, CS%tidal_mixing_CSp) + CS%use_tidal_mixing = tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, CS%tidal_mixing_CSp) ! CS%useConvection is set to True IF convection will be used, otherwise False. ! CS%Conv_CSp is allocated by diffConvection_init() diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 79a984b0b7..077bec1144 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -39,7 +39,7 @@ module MOM_set_diffusivity use MOM_grid, only : ocean_grid_type use MOM_internal_tides, only : int_tide_CS, get_lowmode_loss use MOM_tidal_mixing, only : tidal_mixing_CS, calculate_tidal_mixing -use MOM_tidal_mixing, only : tidal_mixing_diags +use MOM_tidal_mixing, only : setup_tidal_diagnostics, post_tidal_diagnostics use MOM_intrinsic_functions, only : invcosh use MOM_io, only : slasher, vardesc, var_desc, MOM_read_data use MOM_kappa_shear, only : calculate_kappa_shear, kappa_shear_init, Kappa_shear_CS @@ -218,37 +218,18 @@ module MOM_set_diffusivity type(int_tide_CS), pointer :: int_tide_CSp => NULL() type(tidal_mixing_cs), pointer :: tm_csp => NULL() - integer :: id_TKE_itidal = -1 - integer :: id_TKE_leewave = -1 integer :: id_maxTKE = -1 integer :: id_TKE_to_Kd = -1 - integer :: id_Kd_itidal = -1 - integer :: id_Kd_Niku = -1 - integer :: id_Kd_lowmode = -1 integer :: id_Kd_user = -1 integer :: id_Kd_layer = -1 integer :: id_Kd_BBL = -1 integer :: id_Kd_BBL_z = -1 - integer :: id_Kd_itidal_z = -1 - integer :: id_Kd_Niku_z = -1 - integer :: id_Kd_lowmode_z = -1 integer :: id_Kd_user_z = -1 integer :: id_Kd_Work = -1 - integer :: id_Kd_Itidal_Work = -1 - integer :: id_Kd_Niku_Work = -1 - integer :: id_Kd_Lowmode_Work= -1 - integer :: id_Fl_itidal = -1 - integer :: id_Fl_lowmode = -1 - integer :: id_Polzin_decay_scale = -1 - integer :: id_Polzin_decay_scale_scaled = -1 - - integer :: id_Nb = -1 integer :: id_N2 = -1 integer :: id_N2_z = -1 - integer :: id_N2_bot = -1 - integer :: id_N2_meanz = -1 integer :: id_KT_extra = -1 integer :: id_KS_extra = -1 @@ -330,7 +311,6 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & Kd_sfc ! surface value of the diffusivity (m2/s) type(diffusivity_diags) :: dd ! structure w/ arrays of pointers to avail diags - type(tidal_mixing_diags) :: tm_dd real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & T_f, S_f ! temperature and salinity (deg C and ppt); @@ -411,58 +391,12 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if ((CS%id_N2 > 0) .or. (CS%id_N2_z > 0)) then allocate(dd%N2_3d(isd:ied,jsd:jed,nz+1)) ; dd%N2_3d(:,:,:) = 0.0 endif - if ((CS%id_Kd_itidal > 0) .or. (CS%id_Kd_itidal_z > 0) .or. & - (CS%id_Kd_Itidal_work > 0)) then - allocate(tm_dd%Kd_itidal(isd:ied,jsd:jed,nz+1)) ; tm_dd%Kd_itidal(:,:,:) = 0.0 - endif - if ((CS%id_Kd_lowmode > 0) .or. (CS%id_Kd_lowmode_z > 0) .or. & - (CS%id_Kd_lowmode_work > 0)) then - allocate(tm_dd%Kd_lowmode(isd:ied,jsd:jed,nz+1)) ; tm_dd%Kd_lowmode(:,:,:) = 0.0 - endif - if ( (CS%id_Fl_itidal > 0) ) then - allocate(tm_dd%Fl_itidal(isd:ied,jsd:jed,nz+1)) ; tm_dd%Fl_itidal(:,:,:) = 0.0 - endif - if ( (CS%id_Fl_lowmode > 0) ) then - allocate(tm_dd%Fl_lowmode(isd:ied,jsd:jed,nz+1)) ; tm_dd%Fl_lowmode(:,:,:) = 0.0 - endif - if ( (CS%id_Polzin_decay_scale > 0) ) then - allocate(tm_dd%Polzin_decay_scale(isd:ied,jsd:jed)) - tm_dd%Polzin_decay_scale(:,:) = 0.0 - endif - if ( (CS%id_Polzin_decay_scale_scaled > 0) ) then - allocate(tm_dd%Polzin_decay_scale_scaled(isd:ied,jsd:jed)) - tm_dd%Polzin_decay_scale_scaled(:,:) = 0.0 - endif - if ( (CS%id_N2_bot > 0) ) then - allocate(tm_dd%N2_bot(isd:ied,jsd:jed)) ; tm_dd%N2_bot(:,:) = 0.0 - endif - if ( (CS%id_N2_meanz > 0) ) then - allocate(tm_dd%N2_meanz(isd:ied,jsd:jed)) ; tm_dd%N2_meanz(:,:) = 0.0 - endif - if ((CS%id_Kd_Niku > 0) .or. (CS%id_Kd_Niku_z > 0) .or. & - (CS%id_Kd_Niku_work > 0)) then - allocate(tm_dd%Kd_Niku(isd:ied,jsd:jed,nz+1)) ; tm_dd%Kd_Niku(:,:,:) = 0.0 - endif if ((CS%id_Kd_user > 0) .or. (CS%id_Kd_user_z > 0)) then allocate(dd%Kd_user(isd:ied,jsd:jed,nz+1)) ; dd%Kd_user(:,:,:) = 0.0 endif if (CS%id_Kd_work > 0) then allocate(dd%Kd_work(isd:ied,jsd:jed,nz)) ; dd%Kd_work(:,:,:) = 0.0 endif - if (CS%id_Kd_Niku_work > 0) then - allocate(tm_dd%Kd_Niku_work(isd:ied,jsd:jed,nz)) ; tm_dd%Kd_Niku_work(:,:,:) = 0.0 - endif - if (CS%id_Kd_Itidal_work > 0) then - allocate(tm_dd%Kd_Itidal_work(isd:ied,jsd:jed,nz)) - tm_dd%Kd_Itidal_work(:,:,:) = 0.0 - endif - if (CS%id_Kd_Lowmode_Work > 0) then - allocate(tm_dd%Kd_Lowmode_Work(isd:ied,jsd:jed,nz)) - tm_dd%Kd_Lowmode_Work(:,:,:) = 0.0 - endif - if (CS%id_TKE_itidal > 0) then - allocate(tm_dd%TKE_Itidal_used(isd:ied,jsd:jed)) ; tm_dd%TKE_Itidal_used(:,:) = 0. - endif if (CS%id_maxTKE > 0) then allocate(dd%maxTKE(isd:ied,jsd:jed,nz)) ; dd%maxTKE(:,:,:) = 0.0 endif @@ -479,6 +413,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & allocate(dd%Kd_BBL(isd:ied,jsd:jed,nz+1)) ; dd%Kd_BBL(:,:,:) = 0.0 endif + ! set up arrays for tidal mixing diagnostics + call setup_tidal_diagnostics(G,tm_csp) + ! Smooth the properties through massless layers. if (use_EOS) then if (CS%debug) then @@ -678,7 +615,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! Add the Nikurashin and / or tidal bottom-driven mixing call calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, maxTKE, G, GV, CS%tm_csp, & - tm_dd, N2_lay, N2_int, Kd, Kd_int, CS%Kd_max) + N2_lay, N2_int, Kd, Kd_int, CS%Kd_max) ! This adds the diffusion sustained by the energy extracted from the flow ! by the bottom drag. @@ -767,51 +704,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%id_Kd_layer > 0) call post_data(CS%id_Kd_layer, Kd, CS%diag) num_z_diags = 0 - if (tm_csp%Int_tide_dissipation .or. tm_csp%Lee_wave_dissipation .or. tm_csp%Lowmode_itidal_dissipation) then - if (CS%id_TKE_itidal > 0) call post_data(CS%id_TKE_itidal, tm_dd%TKE_itidal_used, CS%diag) - if (CS%id_TKE_leewave > 0) call post_data(CS%id_TKE_leewave, tm_csp%TKE_Niku, CS%diag) - if (CS%id_Nb > 0) call post_data(CS%id_Nb, tm_csp%Nb, CS%diag) - if (CS%id_N2 > 0) call post_data(CS%id_N2, dd%N2_3d, CS%diag) - if (CS%id_N2_bot > 0) call post_data(CS%id_N2_bot, tm_dd%N2_bot, CS%diag) - if (CS%id_N2_meanz > 0) call post_data(CS%id_N2_meanz,tm_dd%N2_meanz,CS%diag) - - if (CS%id_Fl_itidal > 0) call post_data(CS%id_Fl_itidal, tm_dd%Fl_itidal, CS%diag) - if (CS%id_Kd_itidal > 0) call post_data(CS%id_Kd_itidal, tm_dd%Kd_itidal, CS%diag) - if (CS%id_Kd_Niku > 0) call post_data(CS%id_Kd_Niku, tm_dd%Kd_Niku, CS%diag) - if (CS%id_Kd_lowmode> 0) call post_data(CS%id_Kd_lowmode, tm_dd%Kd_lowmode, CS%diag) - if (CS%id_Fl_lowmode> 0) call post_data(CS%id_Fl_lowmode, tm_dd%Fl_lowmode, CS%diag) - if (CS%id_Kd_user > 0) call post_data(CS%id_Kd_user, dd%Kd_user, CS%diag) - if (CS%id_Kd_Work > 0) call post_data(CS%id_Kd_Work, dd%Kd_Work, CS%diag) - if (CS%id_Kd_Itidal_Work > 0) & - call post_data(CS%id_Kd_Itidal_Work, tm_dd%Kd_Itidal_Work, CS%diag) - if (CS%id_Kd_Niku_Work > 0) call post_data(CS%id_Kd_Niku_Work, tm_dd%Kd_Niku_Work, CS%diag) - if (CS%id_Kd_Lowmode_Work > 0) & - call post_data(CS%id_Kd_Lowmode_Work, tm_dd%Kd_Lowmode_Work, CS%diag) - if (CS%id_maxTKE > 0) call post_data(CS%id_maxTKE, dd%maxTKE, CS%diag) - if (CS%id_TKE_to_Kd > 0) call post_data(CS%id_TKE_to_Kd, dd%TKE_to_Kd, CS%diag) - - if (CS%id_Polzin_decay_scale > 0 ) & - call post_data(CS%id_Polzin_decay_scale, tm_dd%Polzin_decay_scale, CS%diag) - if (CS%id_Polzin_decay_scale_scaled > 0 ) & - call post_data(CS%id_Polzin_decay_scale_scaled, tm_dd%Polzin_decay_scale_scaled, CS%diag) - - if (CS%id_Kd_itidal_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Kd_itidal_z - z_ptrs(num_z_diags)%p => tm_dd%Kd_itidal - endif - if (CS%id_Kd_Niku_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Kd_Niku_z - z_ptrs(num_z_diags)%p => tm_dd%Kd_Niku - endif + call post_tidal_diagnostics(G,GV,h,tm_csp) - if (CS%id_Kd_lowmode_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Kd_lowmode_z - z_ptrs(num_z_diags)%p => tm_dd%Kd_lowmode - endif + if (tm_csp%Int_tide_dissipation .or. tm_csp%Lee_wave_dissipation .or. tm_csp%Lowmode_itidal_dissipation) then + if (CS%id_N2 > 0) call post_data(CS%id_N2, dd%N2_3d, CS%diag) + if (CS%id_Kd_user > 0) call post_data(CS%id_Kd_user, dd%Kd_user, CS%diag) + if (CS%id_Kd_Work > 0) call post_data(CS%id_Kd_Work, dd%Kd_Work, CS%diag) + if (CS%id_maxTKE > 0) call post_data(CS%id_maxTKE, dd%maxTKE, CS%diag) + if (CS%id_TKE_to_Kd > 0) call post_data(CS%id_TKE_to_Kd, dd%TKE_to_Kd, CS%diag) if (CS%id_N2_z > 0) then num_z_diags = num_z_diags + 1 @@ -853,21 +754,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call calc_Zint_diags(h, z_ptrs, z_ids, num_z_diags, G, GV, CS%diag_to_Z_CSp) if (associated(dd%N2_3d)) deallocate(dd%N2_3d) - if (associated(tm_dd%Kd_itidal)) deallocate(tm_dd%Kd_itidal) - if (associated(tm_dd%Kd_lowmode)) deallocate(tm_dd%Kd_lowmode) - if (associated(tm_dd%Fl_itidal)) deallocate(tm_dd%Fl_itidal) - if (associated(tm_dd%Fl_lowmode)) deallocate(tm_dd%Fl_lowmode) - if (associated(tm_dd%Polzin_decay_scale)) deallocate(tm_dd%Polzin_decay_scale) - if (associated(tm_dd%Polzin_decay_scale_scaled)) deallocate(tm_dd%Polzin_decay_scale_scaled) - if (associated(tm_dd%N2_bot)) deallocate(tm_dd%N2_bot) - if (associated(tm_dd%N2_meanz)) deallocate(tm_dd%N2_meanz) if (associated(dd%Kd_work)) deallocate(dd%Kd_work) if (associated(dd%Kd_user)) deallocate(dd%Kd_user) - if (associated(tm_dd%Kd_Niku)) deallocate(tm_dd%Kd_Niku) - if (associated(tm_dd%Kd_Niku_work)) deallocate(tm_dd%Kd_Niku_work) - if (associated(tm_dd%Kd_Itidal_Work)) deallocate(tm_dd%Kd_Itidal_Work) - if (associated(tm_dd%Kd_Lowmode_Work)) deallocate(tm_dd%Kd_Lowmode_Work) - if (associated(tm_dd%TKE_itidal_used)) deallocate(tm_dd%TKE_itidal_used) if (associated(dd%maxTKE)) deallocate(dd%maxTKE) if (associated(dd%TKE_to_Kd)) deallocate(dd%TKE_to_Kd) if (associated(dd%KT_extra)) deallocate(dd%KT_extra) @@ -2393,13 +2281,6 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp if (CS%FluxRi_max > 0.0) & CS%dissip_N2 = CS%dissip_Kd_min * GV%Rho0 / CS%FluxRi_max - if (tm_csp%Lee_wave_dissipation) then - CS%id_TKE_leewave = register_diag_field('ocean_model','TKE_leewave',diag%axesT1,Time, & - 'Lee wave Driven Turbulent Kinetic Energy', 'W m-2') - CS%id_Kd_Niku = register_diag_field('ocean_model','Kd_Nikurashin',diag%axesTi,Time, & - 'Lee Wave Driven Diffusivity', 'm2 s-1') - endif - CS%id_Kd_layer = register_diag_field('ocean_model', 'Kd_layer', diag%axesTL, Time, & 'Diapycnal diffusivity of layers (as set)', 'm2 s-1') @@ -2407,52 +2288,12 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp if (tm_csp%Int_tide_dissipation .or. tm_csp%Lee_wave_dissipation .or. & tm_csp%Lowmode_itidal_dissipation) then - CS%id_TKE_itidal = register_diag_field('ocean_model','TKE_itidal',diag%axesT1,Time, & - 'Internal Tide Driven Turbulent Kinetic Energy', 'W m-2') + CS%id_Kd_Work = register_diag_field('ocean_model','Kd_Work',diag%axesTL,Time, & + 'Work done by Diapycnal Mixing', 'W m-2') CS%id_maxTKE = register_diag_field('ocean_model','maxTKE',diag%axesTL,Time, & 'Maximum layer TKE', 'm3 s-3') CS%id_TKE_to_Kd = register_diag_field('ocean_model','TKE_to_Kd',diag%axesTL,Time, & 'Convert TKE to Kd', 's2 m') - - CS%id_Nb = register_diag_field('ocean_model','Nb',diag%axesT1,Time, & - 'Bottom Buoyancy Frequency', 's-1') - - CS%id_Kd_itidal = register_diag_field('ocean_model','Kd_itides',diag%axesTi,Time, & - 'Internal Tide Driven Diffusivity', 'm2 s-1') - - CS%id_Kd_lowmode = register_diag_field('ocean_model','Kd_lowmode',diag%axesTi,Time, & - 'Internal Tide Driven Diffusivity (from propagating low modes)', 'm2 s-1') - - CS%id_Fl_itidal = register_diag_field('ocean_model','Fl_itides',diag%axesTi,Time, & - 'Vertical flux of tidal turbulent dissipation', 'm3 s-3') - - CS%id_Fl_lowmode = register_diag_field('ocean_model','Fl_lowmode',diag%axesTi,Time, & - 'Vertical flux of tidal turbulent dissipation (from propagating low modes)', 'm3 s-3') - - CS%id_Polzin_decay_scale = register_diag_field('ocean_model','Polzin_decay_scale',diag%axesT1,Time, & - 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', 'm') - - CS%id_Polzin_decay_scale_scaled = register_diag_field('ocean_model','Polzin_decay_scale_scaled',diag%axesT1,Time, & - 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme, scaled by N2_bot/N2_meanz', 'm') - - CS%id_N2_bot = register_diag_field('ocean_model','N2_b',diag%axesT1,Time, & - 'Bottom Buoyancy frequency squared', 's-2') - - CS%id_N2_meanz = register_diag_field('ocean_model','N2_meanz',diag%axesT1,Time, & - 'Buoyancy frequency squared averaged over the water column', 's-2') - - CS%id_Kd_Work = register_diag_field('ocean_model','Kd_Work',diag%axesTL,Time, & - 'Work done by Diapycnal Mixing', 'W m-2') - - CS%id_Kd_Itidal_Work = register_diag_field('ocean_model','Kd_Itidal_Work',diag%axesTL,Time, & - 'Work done by Internal Tide Diapycnal Mixing', 'W m-2') - - CS%id_Kd_Niku_Work = register_diag_field('ocean_model','Kd_Nikurashin_Work',diag%axesTL,Time, & - 'Work done by Nikurashin Lee Wave Drag Scheme', 'W m-2') - - CS%id_Kd_Lowmode_Work = register_diag_field('ocean_model','Kd_Lowmode_Work',diag%axesTL,Time, & - 'Work done by Internal Tide Diapycnal Mixing (low modes)', 'W m-2') - CS%id_N2 = register_diag_field('ocean_model','N2',diag%axesTi,Time, & 'Buoyancy frequency squared', 's-2', cmor_field_name='obvfsq', & cmor_long_name='Square of seawater buoyancy frequency',& @@ -2466,20 +2307,6 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp vd = var_desc("N2", "s-2",& "Buoyancy frequency, interpolated to z", z_grid='z') CS%id_N2_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - vd = var_desc("Kd_itides","m2 s-1", & - "Internal Tide Driven Diffusivity, interpolated to z", z_grid='z') - CS%id_Kd_itidal_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - if (tm_csp%Lee_wave_dissipation) then - vd = var_desc("Kd_Nikurashin", "m2 s-1", & - "Lee Wave Driven Diffusivity, interpolated to z", z_grid='z') - CS%id_Kd_Niku_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - endif - if (tm_csp%Lowmode_itidal_dissipation) then - vd = var_desc("Kd_lowmode","m2 s-1", & - "Internal Tide Driven Diffusivity (from low modes), interpolated to z",& - z_grid='z') - CS%id_Kd_lowmode_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - endif if (CS%user_change_diff) & CS%id_Kd_user_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) endif diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index e391bcb337..c6c5d302ba 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -5,8 +5,10 @@ module MOM_tidal_mixing use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field use MOM_diag_mediator, only : safe_alloc_ptr, post_data +use MOM_diag_to_Z, only : diag_to_Z_CS, register_Zint_diag +use MOM_diag_to_Z, only : calc_Zint_diags use MOM_EOS, only : calculate_density -use MOM_variables, only : thermo_var_ptrs +use MOM_variables, only : thermo_var_ptrs, p3d use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE use MOM_debugging, only : hchksum use MOM_grid, only : ocean_grid_type @@ -14,7 +16,7 @@ module MOM_tidal_mixing use MOM_file_parser, only : openParameterBlock, closeParameterBlock use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_string_functions, only : uppercase, lowercase -use MOM_io, only : slasher, MOM_read_data +use MOM_io, only : slasher, MOM_read_data, vardesc, var_desc use cvmix_tidal, only : cvmix_init_tidal, cvmix_compute_Simmons_invariant use cvmix_tidal, only : cvmix_coeffs_tidal, cvmix_tidal_params_type use cvmix_kinds_and_types, only : cvmix_global_params_type @@ -25,10 +27,34 @@ module MOM_tidal_mixing #include public tidal_mixing_init +public setup_tidal_diagnostics public calculate_tidal_mixing +public post_tidal_diagnostics public tidal_mixing_end -!> Control structure including parameters for tidal mixing. +!> Control structure for tidal mixing diagnostics +type, public :: tidal_mixing_diags + real, pointer, dimension(:,:,:) :: & + Kd_itidal => NULL(),& ! internal tide diffusivity at interfaces (m2/s) + Fl_itidal => NULL(),& ! vertical flux of tidal turbulent dissipation (m3/s3) + Kd_lowmode => NULL(),& ! internal tide diffusivity at interfaces + ! due to propagating low modes (m2/s) (BDM) + Fl_lowmode => NULL(),& ! vertical flux of tidal turbulent dissipation + ! due to propagating low modes (m3/s3) (BDM) + Kd_Niku => NULL(),& ! lee-wave diffusivity at interfaces (m2/s) + Kd_Niku_work => NULL(),& ! layer integrated work by lee-wave driven mixing (W/m2) + Kd_Itidal_Work => NULL(),& ! layer integrated work by int tide driven mixing (W/m2) + Kd_Lowmode_Work=> NULL() ! layer integrated work by low mode driven mixing (W/m2) BDM + + real, pointer, dimension(:,:) :: & + TKE_itidal_used => NULL(),& ! internal tide TKE input at ocean bottom (W/m2) + N2_bot => NULL(),& ! bottom squared buoyancy frequency (1/s2) + N2_meanz => NULL(),& ! vertically averaged buoyancy frequency (1/s2) + Polzin_decay_scale_scaled => NULL(),& ! vertical scale of decay for tidal dissipation + Polzin_decay_scale => NULL() ! vertical decay scale for tidal diss with Polzin (meter) +end type + +!> Control structure for tidal mixing module. type, public :: tidal_mixing_cs logical :: debug = .true. @@ -95,50 +121,54 @@ module MOM_tidal_mixing logical :: use_cvmix_tidal ! true if cvmix is to be used for determining diffusivity ! due to tidal mixing - real :: tidal_max_coef ! maximum allowable tidal diffusivity. [m^2/s] real :: min_thickness ! Minimum thickness allowed [m] - real, pointer, dimension(:,:) :: TKE_Niku => NULL() - real, pointer, dimension(:,:) :: TKE_itidal => NULL() - real, pointer, dimension(:,:) :: Nb => NULL() - real, pointer, dimension(:,:) :: mask_itidal => NULL() - real, pointer, dimension(:,:) :: h2 => NULL() - real, pointer, dimension(:,:) :: tideamp => NULL() ! RMS tidal amplitude (m/s) - - real, allocatable, dimension(:,:) :: tidal_qe_2d ! q*E(x,y) - + ! CVMix-specific parameters type(cvmix_tidal_params_type) :: cvmix_tidal_params - type(cvmix_global_params_type) :: cvmix_glb_params ! to pass Prandtl number only + type(cvmix_global_params_type) :: cvmix_glb_params ! for Prandtl number only + real :: tidal_max_coef ! maximum allowable tidal diffusivity. [m^2/s] + + ! Data containers + real, pointer, dimension(:,:) :: TKE_Niku => NULL() + real, pointer, dimension(:,:) :: TKE_itidal => NULL() + real, pointer, dimension(:,:) :: Nb => NULL() + real, pointer, dimension(:,:) :: mask_itidal => NULL() + real, pointer, dimension(:,:) :: h2 => NULL() + real, pointer, dimension(:,:) :: tideamp => NULL() ! RMS tidal amplitude (m/s) + real, allocatable,dimension(:,:) :: tidal_qe_2d ! q*E(x,y) + + ! Diagnostics + type(diag_ctrl), pointer :: diag => NULL() ! structure to regulate diagn output timing + type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() + type(tidal_mixing_diags), pointer :: dd => NULL() + + ! Diagnostic identifiers + integer :: id_TKE_itidal = -1 + integer :: id_TKE_leewave = -1 + integer :: id_Kd_itidal = -1 + integer :: id_Kd_Niku = -1 + integer :: id_Kd_lowmode = -1 + integer :: id_Kd_itidal_z = -1 + integer :: id_Kd_Niku_z = -1 + integer :: id_Kd_lowmode_z = -1 + integer :: id_Kd_Itidal_Work = -1 + integer :: id_Kd_Niku_Work = -1 + integer :: id_Kd_Lowmode_Work = -1 + integer :: id_Nb = -1 + integer :: id_N2_bot = -1 + integer :: id_N2_meanz = -1 + integer :: id_Fl_itidal = -1 + integer :: id_Fl_lowmode = -1 + integer :: id_Polzin_decay_scale = -1 + integer :: id_Polzin_decay_scale_scaled = -1 end type tidal_mixing_cs -type, public :: tidal_mixing_diags - real, pointer, dimension(:,:,:) :: & - Kd_itidal => NULL(),& ! internal tide diffusivity at interfaces (m2/s) - Fl_itidal => NULL(),& ! vertical flux of tidal turbulent dissipation (m3/s3) - Kd_lowmode => NULL(),& ! internal tide diffusivity at interfaces - ! due to propagating low modes (m2/s) (BDM) - Fl_lowmode => NULL(),& ! vertical flux of tidal turbulent dissipation - ! due to propagating low modes (m3/s3) (BDM) - Kd_Niku => NULL(),& ! lee-wave diffusivity at interfaces (m2/s) - Kd_Niku_work => NULL(),& ! layer integrated work by lee-wave driven mixing (W/m2) - Kd_Itidal_Work => NULL(),& ! layer integrated work by int tide driven mixing (W/m2) - Kd_Lowmode_Work=> NULL() ! layer integrated work by low mode driven mixing (W/m2) BDM - - real, pointer, dimension(:,:) :: & - TKE_itidal_used => NULL(),& ! internal tide TKE input at ocean bottom (W/m2) - N2_bot => NULL(),& ! bottom squared buoyancy frequency (1/s2) - N2_meanz => NULL(),& ! vertically averaged buoyancy frequency (1/s2) - Polzin_decay_scale_scaled => NULL(),& ! vertical scale of decay for tidal dissipation - Polzin_decay_scale => NULL() ! vertical decay scale for tidal diss with Polzin (meter) - -end type - character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name. -character*(20), parameter :: STLAURENT_PROFILE_STRING = "STLAURENT_02" -character*(20), parameter :: POLZIN_PROFILE_STRING = "POLZIN_09" -character*(20), parameter :: SIMMONS_PROFILE_STRING = "SIMMONS" -character*(20), parameter :: SCHMITTNER_PROFILE_STRING = "SCHMITTNER" +character*(20), parameter :: STLAURENT_PROFILE_STRING = "STLAURENT_02" +character*(20), parameter :: POLZIN_PROFILE_STRING = "POLZIN_09" +character*(20), parameter :: SIMMONS_PROFILE_STRING = "SIMMONS" +character*(20), parameter :: SCHMITTNER_PROFILE_STRING = "SCHMITTNER" integer, parameter :: STLAURENT_02 = 1 integer, parameter :: POLZIN_09 = 2 integer, parameter :: SIMMONS_04 = 3 @@ -146,13 +176,15 @@ module MOM_tidal_mixing contains -logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) +!> Initializes internal tidal dissipation scheme for diapycnal mixing +logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, CS) type(time_type), intent(in) :: Time !< The current time. type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. + type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< pointer to the Z-diagnostics control type(tidal_mixing_cs), pointer :: CS !< This module's control structure. ! Local variables @@ -161,6 +193,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) character(len=20) :: default_profile_string, tidal_energy_type character(len=200) :: filename, h2_file, Niku_TKE_input_file character(len=200) :: tidal_energy_file, tideamp_file + type(vardesc) :: vd real :: utide, zbot, hamp, prandtl real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data integer :: i, j, is, ie, js, je @@ -175,12 +208,16 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) return endif allocate(CS) + allocate(CS%dd) CS%debug = CS%debug.and.is_root_pe() is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + CS%diag => diag + if (associated(diag_to_Z_CSp)) CS%diag_to_Z_CSp => diag_to_Z_CSp + ! Read parameters call log_version(param_file, mdl, version, & "Vertical Tidal Mixing Parameterization") @@ -419,6 +456,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) CS%Decay_scale_factor_lee = -9.e99 ! This should never be used if CS%Lee_wave_dissipation = False endif + ! Configure CVMix if (CS%use_cvmix_tidal) then ! Read in CVMix params @@ -461,11 +499,82 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, CS) endif ! cvmix on + ! Register Diagnostics fields + + if (CS%Lee_wave_dissipation) then + CS%id_TKE_leewave = register_diag_field('ocean_model','TKE_leewave',diag%axesT1,Time, & + 'Lee wave Driven Turbulent Kinetic Energy', 'W m-2') + CS%id_Kd_Niku = register_diag_field('ocean_model','Kd_Nikurashin',diag%axesTi,Time, & + 'Lee Wave Driven Diffusivity', 'm2 s-1') + endif + + if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. & + CS%Lowmode_itidal_dissipation) then + + CS%id_TKE_itidal = register_diag_field('ocean_model','TKE_itidal',diag%axesT1,Time, & + 'Internal Tide Driven Turbulent Kinetic Energy', 'W m-2') + CS%id_Nb = register_diag_field('ocean_model','Nb',diag%axesT1,Time, & + 'Bottom Buoyancy Frequency', 's-1') + + CS%id_Kd_itidal = register_diag_field('ocean_model','Kd_itides',diag%axesTi,Time, & + 'Internal Tide Driven Diffusivity', 'm2 s-1') + + CS%id_Kd_lowmode = register_diag_field('ocean_model','Kd_lowmode',diag%axesTi,Time, & + 'Internal Tide Driven Diffusivity (from propagating low modes)', 'm2 s-1') + + CS%id_Fl_itidal = register_diag_field('ocean_model','Fl_itides',diag%axesTi,Time, & + 'Vertical flux of tidal turbulent dissipation', 'm3 s-3') + + CS%id_Fl_lowmode = register_diag_field('ocean_model','Fl_lowmode',diag%axesTi,Time, & + 'Vertical flux of tidal turbulent dissipation (from propagating low modes)', 'm3 s-3') + + CS%id_Polzin_decay_scale = register_diag_field('ocean_model','Polzin_decay_scale',diag%axesT1,Time, & + 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', 'm') + + CS%id_Polzin_decay_scale_scaled = register_diag_field('ocean_model','Polzin_decay_scale_scaled',diag%axesT1,Time, & + 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme, scaled by N2_bot/N2_meanz', 'm') + + CS%id_N2_bot = register_diag_field('ocean_model','N2_b',diag%axesT1,Time, & + 'Bottom Buoyancy frequency squared', 's-2') + + CS%id_N2_meanz = register_diag_field('ocean_model','N2_meanz',diag%axesT1,Time, & + 'Buoyancy frequency squared averaged over the water column', 's-2') + + CS%id_Kd_Itidal_Work = register_diag_field('ocean_model','Kd_Itidal_Work',diag%axesTL,Time, & + 'Work done by Internal Tide Diapycnal Mixing', 'W m-2') + + CS%id_Kd_Niku_Work = register_diag_field('ocean_model','Kd_Nikurashin_Work',diag%axesTL,Time, & + 'Work done by Nikurashin Lee Wave Drag Scheme', 'W m-2') + + CS%id_Kd_Lowmode_Work = register_diag_field('ocean_model','Kd_Lowmode_Work',diag%axesTL,Time, & + 'Work done by Internal Tide Diapycnal Mixing (low modes)', 'W m-2') + + if (associated(CS%diag_to_Z_CSp)) then + vd = var_desc("Kd_itides","m2 s-1", & + "Internal Tide Driven Diffusivity, interpolated to z", z_grid='z') + CS%id_Kd_itidal_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + if (CS%Lee_wave_dissipation) then + vd = var_desc("Kd_Nikurashin", "m2 s-1", & + "Lee Wave Driven Diffusivity, interpolated to z", z_grid='z') + CS%id_Kd_Niku_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + endif + if (CS%Lowmode_itidal_dissipation) then + vd = var_desc("Kd_lowmode","m2 s-1", & + "Internal Tide Driven Diffusivity (from low modes), interpolated to z",& + z_grid='z') + CS%id_Kd_lowmode_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + endif + endif + + endif end function tidal_mixing_init +!> Depending on whether or not CVMix is active, calls the associated subroutine to compute internal +!! tidal dissipation and to add the effect of internal-tide-driven mixing to the layer or interface +!! diffusivities. subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & - dd, N2_lay, N2_int, Kd, Kd_int, Kd_max) + N2_lay, N2_int, Kd, Kd_int, Kd_max) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) @@ -475,7 +584,6 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & integer, intent(in) :: j real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd, max_TKE type(tidal_mixing_cs), pointer :: CS - type(tidal_mixing_diags), intent(inout) :: dd real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int real, intent(inout) :: Kd_max @@ -484,13 +592,15 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & if (CS%use_cvmix_tidal) then call calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) else - call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS,dd, & + call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & N2_lay, Kd, Kd_int, Kd_max) endif endif end subroutine +!> Calls the CVMix routines to compute tidal dissipation and to add the effect of internal-tide-driven +!! mixing to the interface diffusivities. subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) integer, intent(in) :: j type(ocean_grid_type), intent(in) :: G !< Grid structure. @@ -578,7 +688,7 @@ end subroutine calculate_cvmix_tidal !! Will eventually need to add diffusivity due to other wave-breaking processes (e.g. Bottom friction, !! Froude-number-depending breaking, PSI, etc.). subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & - dd, N2_lay, Kd, Kd_int, Kd_max) + N2_lay, Kd, Kd_int, Kd_max) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) @@ -587,12 +697,10 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, integer, intent(in) :: j real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd, max_TKE type(tidal_mixing_cs), pointer :: CS - type(tidal_mixing_diags), intent(inout) :: dd real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int real, intent(inout) :: Kd_max - ! This subroutine adds the effect of internal-tide-driven mixing to the layer diffusivities. ! The mechanisms considered are (1) local dissipation of internal waves generated by the ! barotropic flow ("itidal"), (2) local dissipation of internal waves generated by the propagating @@ -640,7 +748,10 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, logical :: use_Polzin, use_Simmons integer :: i, k, is, ie, nz integer :: a, fr, m + type(tidal_mixing_diags), pointer :: dd + is = G%isc ; ie = G%iec ; nz = G%ke + dd => CS%dd if (.not.(CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation)) return @@ -968,6 +1079,144 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, end subroutine add_int_tide_diffusivity +!> Sets up diagnostics arrays for tidal mixing. +subroutine setup_tidal_diagnostics(G,CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(tidal_mixing_cs), pointer :: CS + + ! local + integer :: isd, ied, jsd, jed, nz + type(tidal_mixing_diags), pointer :: dd + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed; nz = G%ke + dd => CS%dd + + if ((CS%id_Kd_itidal > 0) .or. (CS%id_Kd_itidal_z > 0) .or. & + (CS%id_Kd_Itidal_work > 0)) then + allocate(dd%Kd_itidal(isd:ied,jsd:jed,nz+1)) ; dd%Kd_itidal(:,:,:) = 0.0 + endif + if ((CS%id_Kd_lowmode > 0) .or. (CS%id_Kd_lowmode_z > 0) .or. & + (CS%id_Kd_lowmode_work > 0)) then + allocate(dd%Kd_lowmode(isd:ied,jsd:jed,nz+1)) ; dd%Kd_lowmode(:,:,:) = 0.0 + endif + if ( (CS%id_Fl_itidal > 0) ) then + allocate(dd%Fl_itidal(isd:ied,jsd:jed,nz+1)) ; dd%Fl_itidal(:,:,:) = 0.0 + endif + if ( (CS%id_Fl_lowmode > 0) ) then + allocate(dd%Fl_lowmode(isd:ied,jsd:jed,nz+1)) ; dd%Fl_lowmode(:,:,:) = 0.0 + endif + if ( (CS%id_Polzin_decay_scale > 0) ) then + allocate(dd%Polzin_decay_scale(isd:ied,jsd:jed)) + dd%Polzin_decay_scale(:,:) = 0.0 + endif + if ( (CS%id_N2_bot > 0) ) then + allocate(dd%N2_bot(isd:ied,jsd:jed)) ; dd%N2_bot(:,:) = 0.0 + endif + if ( (CS%id_N2_meanz > 0) ) then + allocate(dd%N2_meanz(isd:ied,jsd:jed)) ; dd%N2_meanz(:,:) = 0.0 + endif + if ( (CS%id_Polzin_decay_scale_scaled > 0) ) then + allocate(dd%Polzin_decay_scale_scaled(isd:ied,jsd:jed)) + dd%Polzin_decay_scale_scaled(:,:) = 0.0 + endif + if ((CS%id_Kd_Niku > 0) .or. (CS%id_Kd_Niku_z > 0) .or. & + (CS%id_Kd_Niku_work > 0)) then + allocate(dd%Kd_Niku(isd:ied,jsd:jed,nz+1)) ; dd%Kd_Niku(:,:,:) = 0.0 + endif + if (CS%id_Kd_Niku_work > 0) then + allocate(dd%Kd_Niku_work(isd:ied,jsd:jed,nz)) ; dd%Kd_Niku_work(:,:,:) = 0.0 + endif + if (CS%id_Kd_Itidal_work > 0) then + allocate(dd%Kd_Itidal_work(isd:ied,jsd:jed,nz)) + dd%Kd_Itidal_work(:,:,:) = 0.0 + endif + if (CS%id_Kd_Lowmode_Work > 0) then + allocate(dd%Kd_Lowmode_Work(isd:ied,jsd:jed,nz)) + dd%Kd_Lowmode_Work(:,:,:) = 0.0 + endif + if (CS%id_TKE_itidal > 0) then + allocate(dd%TKE_Itidal_used(isd:ied,jsd:jed)) ; dd%TKE_Itidal_used(:,:) = 0. + endif +end subroutine setup_tidal_diagnostics + +subroutine post_tidal_diagnostics(G,GV,h,CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + type(tidal_mixing_cs), pointer :: CS + + ! local + integer :: num_z_diags + integer :: z_ids(6) ! id numbers of diagns to be interpolated to depth space + type(p3d) :: z_ptrs(6) ! pointers to diagns to be interpolated into depth space + type(tidal_mixing_diags), pointer :: dd + + num_z_diags = 0 + dd => CS%dd + + if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then + if (CS%id_TKE_itidal > 0) call post_data(CS%id_TKE_itidal, dd%TKE_itidal_used, CS%diag) + if (CS%id_TKE_leewave > 0) call post_data(CS%id_TKE_leewave, CS%TKE_Niku, CS%diag) + if (CS%id_Nb > 0) call post_data(CS%id_Nb, CS%Nb, CS%diag) + if (CS%id_N2_bot > 0) call post_data(CS%id_N2_bot, dd%N2_bot, CS%diag) + if (CS%id_N2_meanz > 0) call post_data(CS%id_N2_meanz,dd%N2_meanz,CS%diag) + + if (CS%id_Fl_itidal > 0) call post_data(CS%id_Fl_itidal, dd%Fl_itidal, CS%diag) + if (CS%id_Kd_itidal > 0) call post_data(CS%id_Kd_itidal, dd%Kd_itidal, CS%diag) + if (CS%id_Kd_Niku > 0) call post_data(CS%id_Kd_Niku, dd%Kd_Niku, CS%diag) + if (CS%id_Kd_lowmode> 0) call post_data(CS%id_Kd_lowmode, dd%Kd_lowmode, CS%diag) + if (CS%id_Fl_lowmode> 0) call post_data(CS%id_Fl_lowmode, dd%Fl_lowmode, CS%diag) + + if (CS%id_Kd_Itidal_Work > 0) & + call post_data(CS%id_Kd_Itidal_Work, dd%Kd_Itidal_Work, CS%diag) + if (CS%id_Kd_Niku_Work > 0) call post_data(CS%id_Kd_Niku_Work, dd%Kd_Niku_Work, CS%diag) + if (CS%id_Kd_Lowmode_Work > 0) & + call post_data(CS%id_Kd_Lowmode_Work, dd%Kd_Lowmode_Work, CS%diag) + + if (CS%id_Polzin_decay_scale > 0 ) & + call post_data(CS%id_Polzin_decay_scale, dd%Polzin_decay_scale, CS%diag) + if (CS%id_Polzin_decay_scale_scaled > 0 ) & + call post_data(CS%id_Polzin_decay_scale_scaled, dd%Polzin_decay_scale_scaled, CS%diag) + + if (CS%id_Kd_itidal_z > 0) then + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_Kd_itidal_z + z_ptrs(num_z_diags)%p => dd%Kd_itidal + endif + + if (CS%id_Kd_Niku_z > 0) then + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_Kd_Niku_z + z_ptrs(num_z_diags)%p => dd%Kd_Niku + endif + + if (CS%id_Kd_lowmode_z > 0) then + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_Kd_lowmode_z + z_ptrs(num_z_diags)%p => dd%Kd_lowmode + endif + + endif + + if (num_z_diags > 0) & + call calc_Zint_diags(h, z_ptrs, z_ids, num_z_diags, G, GV, CS%diag_to_Z_CSp) + + if (associated(dd%Kd_itidal)) deallocate(dd%Kd_itidal) + if (associated(dd%Kd_lowmode)) deallocate(dd%Kd_lowmode) + if (associated(dd%Fl_itidal)) deallocate(dd%Fl_itidal) + if (associated(dd%Fl_lowmode)) deallocate(dd%Fl_lowmode) + if (associated(dd%Polzin_decay_scale)) deallocate(dd%Polzin_decay_scale) + if (associated(dd%Polzin_decay_scale_scaled)) deallocate(dd%Polzin_decay_scale_scaled) + if (associated(dd%N2_bot)) deallocate(dd%N2_bot) + if (associated(dd%N2_meanz)) deallocate(dd%N2_meanz) + if (associated(dd%Kd_Niku)) deallocate(dd%Kd_Niku) + if (associated(dd%Kd_Niku_work)) deallocate(dd%Kd_Niku_work) + if (associated(dd%Kd_Itidal_Work)) deallocate(dd%Kd_Itidal_Work) + if (associated(dd%Kd_Lowmode_Work)) deallocate(dd%Kd_Lowmode_Work) + if (associated(dd%TKE_itidal_used)) deallocate(dd%TKE_itidal_used) + +end subroutine post_tidal_diagnostics ! TODO: move this subroutine to MOM_internal_tide_input module (?) subroutine read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS) @@ -1006,6 +1255,7 @@ subroutine tidal_mixing_end(CS) !TODO deallocate all the dynamically allocated members here ... if (allocated(CS%tidal_qe_2d)) deallocate(CS%tidal_qe_2d) + deallocate(CS%dd) deallocate(CS) ! TODO: check why ptrs allocated with MOM_safe_alloc are not deallocated? From 801a86a06a978af6ddde612f5d1b3aab6d8b2cf5 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 2 Apr 2018 16:38:41 -0600 Subject: [PATCH 0052/1072] Added variable Kv_slow in visc type --- src/core/MOM_variables.F90 | 3 +++ src/parameterizations/vertical/MOM_set_viscosity.F90 | 1 + 2 files changed, 4 insertions(+) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 4b85111a21..f7fa45f12c 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -228,6 +228,9 @@ module MOM_variables !! at the interfaces between each layer, in m2 s-1. Kv_shear => NULL(), &!< The shear-driven turbulent vertical viscosity !! at the interfaces between each layer, in m2 s-1. + Kv_slow => NULL(), &!< The turbulent vertical viscosity component due to + !! "slow" processes (e.g., tidal, background, + !! convection etc). TKE_turb => NULL() !< The turbulent kinetic energy per unit mass defined !! at the interfaces between each layer, in m2 s-2. end type vertvisc_type diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 8ab4bafb75..19f956f1b1 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1811,6 +1811,7 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) allocate(visc%Kd_shear(isd:ied,jsd:jed,nz+1)) ; visc%Kd_shear(:,:,:) = 0.0 allocate(visc%TKE_turb(isd:ied,jsd:jed,nz+1)) ; visc%TKE_turb(:,:,:) = 0.0 allocate(visc%Kv_shear(isd:ied,jsd:jed,nz+1)) ; visc%Kv_shear(:,:,:) = 0.0 + ! GMM, allocate visc%Kv_slow here? vd = var_desc("Kd_shear","m2 s-1","Shear-driven turbulent diffusivity at interfaces", & hor_grid='h', z_grid='i') From e54429028de1f94833c81c1f27abb1e27cdf5747 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 3 Apr 2018 09:13:38 -0600 Subject: [PATCH 0053/1072] Allocated/deallocate visc%Kv_slow --- src/parameterizations/vertical/MOM_set_viscosity.F90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 19f956f1b1..e38d484714 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1811,7 +1811,7 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) allocate(visc%Kd_shear(isd:ied,jsd:jed,nz+1)) ; visc%Kd_shear(:,:,:) = 0.0 allocate(visc%TKE_turb(isd:ied,jsd:jed,nz+1)) ; visc%TKE_turb(:,:,:) = 0.0 allocate(visc%Kv_shear(isd:ied,jsd:jed,nz+1)) ; visc%Kv_shear(:,:,:) = 0.0 - ! GMM, allocate visc%Kv_slow here? + allocate(visc%Kv_slow(isd:ied,jsd:jed,nz+1)) ; visc%Kv_slow(:,:,:) = 0.0 vd = var_desc("Kd_shear","m2 s-1","Shear-driven turbulent diffusivity at interfaces", & hor_grid='h', z_grid='i') @@ -1823,6 +1823,10 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) vd = var_desc("Kv_shear","m2 s-1","Shear-driven turbulent viscosity at interfaces", & hor_grid='h', z_grid='i') call register_restart_field(visc%Kv_shear, vd, .false., restart_CS) + vd = var_desc("Kv_slow","m2 s-1","Vertical turbulent viscosity at interfaces due to slow" & + " processes", hor_grid='h', z_grid='i') + call register_restart_field(visc%Kv_slow, vd, .false., restart_CS) + endif ! visc%MLD is used to communicate the state of the (e)PBL to the rest of the model @@ -2094,6 +2098,7 @@ subroutine set_visc_end(visc, CS) deallocate(visc%nkml_visc_u) ; deallocate(visc%nkml_visc_v) endif if (associated(visc%Kd_shear)) deallocate(visc%Kd_shear) + if (associated(visc%Kv_slow)) deallocate(visc%Kv_slow) if (associated(visc%TKE_turb)) deallocate(visc%TKE_turb) if (associated(visc%Kv_shear)) deallocate(visc%Kv_shear) if (associated(visc%ustar_bbl)) deallocate(visc%ustar_bbl) From 105094f2affebdaeffbd914486c53c00c1da5d20 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 3 Apr 2018 09:15:12 -0600 Subject: [PATCH 0054/1072] Add viscosities due to convection into visc%Kv_slow --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index de8c01ac7f..c1ae3fe7e7 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -671,16 +671,14 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G endif ! endif for KPP - ! Add diffusivity due to convection (computed via CVMix) + ! Add vertical diff./visc. due to convection (computed via CVMix) if (CS%use_cvmix_conv) then call calculate_cvmix_conv(h, tv, G, GV, CS%cvmix_conv_csp, Hml) !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! do k=1,nz ; do j=js,je ; do i=is,ie Kd_int(i,j,k) = Kd_int(i,j,k) + CS%cvmix_conv_csp%kd_conv_3d(i,j,k) - ! GMM, I am not sure if Kv_shear is the right place to add kv_conv_3d - visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + CS%cvmix_conv_csp%kv_conv_3d(i,j,k) - visc%Kd_shear(i,j,k) = visc%Kd_shear(i,j,k) + CS%cvmix_conv_csp%kd_conv_3d(i,j,k) + visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%cvmix_conv_csp%kv_conv_3d(i,j,k) enddo ; enddo ; enddo !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From 37ca38fdcdfb845484631700c7355237c5568167 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 3 Apr 2018 09:55:16 -0600 Subject: [PATCH 0055/1072] Renamed kd_bkgnd_3d -> kd_bkgnd; kv_bkgnd_3d -> kv_bkgnd --- .../vertical/MOM_cvmix_conv.F90 | 28 +++++++++---------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/src/parameterizations/vertical/MOM_cvmix_conv.F90 b/src/parameterizations/vertical/MOM_cvmix_conv.F90 index 38ea8e6851..ea50bd1a16 100644 --- a/src/parameterizations/vertical/MOM_cvmix_conv.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_conv.F90 @@ -39,8 +39,8 @@ module MOM_cvmix_conv ! Diagnostics arrays real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency (1/s2) - real, allocatable, dimension(:,:,:) :: kd_conv_3d !< Diffusivity added by convection (m2/s) - real, allocatable, dimension(:,:,:) :: kv_conv_3d !< Viscosity added by convection (m2/s) + real, allocatable, dimension(:,:,:) :: kd_conv !< Diffusivity added by convection (m2/s) + real, allocatable, dimension(:,:,:) :: kv_conv !< Viscosity added by convection (m2/s) end type cvmix_conv_cs @@ -123,8 +123,8 @@ logical function cvmix_conv_init(Time, G, GV, param_file, diag, CS) ! allocate arrays and set them to zero allocate(CS%N2(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%N2(:,:,:) = 0. - allocate(CS%kd_conv_3d(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%kd_conv_3d(:,:,:) = 0. - allocate(CS%kv_conv_3d(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%kv_conv_3d(:,:,:) = 0. + allocate(CS%kd_conv(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%kd_conv(:,:,:) = 0. + allocate(CS%kv_conv(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%kv_conv(:,:,:) = 0. ! Register diagnostics CS%diag => diag @@ -214,8 +214,8 @@ subroutine calculate_cvmix_conv(h, tv, G, GV, CS, hbl) kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl(i,j)) - call cvmix_coeffs_conv(Mdiff_out=CS%kv_conv_3d(i,j,:), & - Tdiff_out=CS%kd_conv_3d(i,j,:), & + call cvmix_coeffs_conv(Mdiff_out=CS%kv_conv(i,j,:), & + Tdiff_out=CS%kd_conv(i,j,:), & Nsqr=CS%N2(i,j,:), & dens=rho_1d(:), & dens_lwr=rho_lwr(:), & @@ -225,8 +225,8 @@ subroutine calculate_cvmix_conv(h, tv, G, GV, CS, hbl) ! Do not apply mixing due to convection within the boundary layer do k=1,NINT(hbl(i,j)) - CS%kv_conv_3d(i,j,k) = 0.0 - CS%kd_conv_3d(i,j,k) = 0.0 + CS%kv_conv(i,j,k) = 0.0 + CS%kd_conv(i,j,k) = 0.0 enddo enddo @@ -234,14 +234,14 @@ subroutine calculate_cvmix_conv(h, tv, G, GV, CS, hbl) if (CS%debug) then call hchksum(CS%N2, "MOM_cvmix_conv: N2",G%HI,haloshift=0) - call hchksum(CS%kd_conv_3d, "MOM_cvmix_conv: kd_conv_3d",G%HI,haloshift=0) - call hchksum(CS%kv_conv_3d, "MOM_cvmix_conv: kv_conv_3d",G%HI,haloshift=0) + call hchksum(CS%kd_conv, "MOM_cvmix_conv: kd_conv",G%HI,haloshift=0) + call hchksum(CS%kv_conv, "MOM_cvmix_conv: kv_conv",G%HI,haloshift=0) endif ! send diagnostics to post_data if (CS%id_N2 > 0) call post_data(CS%id_N2, CS%N2, CS%diag) - if (CS%id_kd_conv > 0) call post_data(CS%id_kd_conv, CS%kd_conv_3d, CS%diag) - if (CS%id_kv_conv > 0) call post_data(CS%id_kv_conv, CS%kv_conv_3d, CS%diag) + if (CS%id_kd_conv > 0) call post_data(CS%id_kd_conv, CS%kd_conv, CS%diag) + if (CS%id_kv_conv > 0) call post_data(CS%id_kv_conv, CS%kv_conv, CS%diag) end subroutine calculate_cvmix_conv @@ -260,8 +260,8 @@ subroutine cvmix_conv_end(CS) type(cvmix_conv_cs), pointer :: CS ! Control structure deallocate(CS%N2) - deallocate(CS%kd_conv_3d) - deallocate(CS%kv_conv_3d) + deallocate(CS%kd_conv) + deallocate(CS%kv_conv) deallocate(CS) end subroutine cvmix_conv_end From a2498a115a4596387b378d1edcd2efe54a59f510 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 3 Apr 2018 10:26:10 -0600 Subject: [PATCH 0056/1072] Changed name in register_diag_field kd_shear -> kd_shear_cvmix; kv_shear -> kv_shear_cvmix --- src/parameterizations/vertical/MOM_cvmix_shear.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_cvmix_shear.F90 b/src/parameterizations/vertical/MOM_cvmix_shear.F90 index b99382974d..345522126b 100644 --- a/src/parameterizations/vertical/MOM_cvmix_shear.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_shear.F90 @@ -232,9 +232,9 @@ logical function cvmix_shear_init(Time, G, GV, param_file, diag, CS) if (CS%id_ri_grad > 0) & !Initialize w/ large Richardson value allocate( CS%ri_grad( SZI_(G), SZJ_(G), SZK_(G)+1 ));CS%ri_grad(:,:,:) = 1.e8 - CS%id_kd = register_diag_field('ocean_model', 'kd_shear', diag%axesTi, Time, & + CS%id_kd = register_diag_field('ocean_model', 'kd_shear_cvmix', diag%axesTi, Time, & 'Vertical diffusivity added by MOM_cvmix_shear module', 'm2/s') - CS%id_kv = register_diag_field('ocean_model', 'kv_shear', diag%axesTi, Time, & + CS%id_kv = register_diag_field('ocean_model', 'kv_shear_cvmix', diag%axesTi, Time, & 'Vertical viscosity added by MOM_cvmix_shear module', 'm2/s') end function cvmix_shear_init From c1acec8033095e17a16487f50f6fef036333aedd Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 3 Apr 2018 10:28:12 -0600 Subject: [PATCH 0057/1072] Add vertical background viscosity into visc%Kv_slow --- .../vertical/MOM_bkgnd_mixing.F90 | 56 ++++++++++--------- .../vertical/MOM_diabatic_driver.F90 | 4 +- .../vertical/MOM_set_diffusivity.F90 | 2 +- .../vertical/MOM_set_viscosity.F90 | 4 +- 4 files changed, 36 insertions(+), 30 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index d249cec5a8..2e4bba1110 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -18,6 +18,7 @@ module MOM_bkgnd_mixing use MOM_verticalGrid, only : verticalGrid_type use MOM_file_parser, only : get_param, log_version, param_file_type use cvmix_background, only : cvmix_init_bkgnd, cvmix_coeffs_bkgnd +use MOM_variables, only : vertvisc_type use MOM_intrinsic_functions, only : invcosh implicit none ; private @@ -302,23 +303,26 @@ end subroutine sfc_bkgnd_mixing !> Calculates the vertical background diffusivities/viscosities -subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd, j, G, GV, CS) +subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd, visc, j, G, GV, CS) - type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay!< squared buoyancy frequency associated - !! with layers (1/s2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd !< Diapycnal diffusivity of each layer (m2/sec). - integer, intent(in) :: j - type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by - !! a previous call to bkgnd_mixing_init. + !! with layers (1/s2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd !< Diapycnal diffusivity of each layer (m2/sec). + type(vertvisc_type), intent(inout) :: visc!< Structure containing vertical viscosities, + !! bottom boundary layer properies, and related + !! fields. + integer, intent(in) :: j !< Meridional grid indice. + type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by + !! a previous call to bkgnd_mixing_init. ! local variables - real, dimension(SZI_(G), SZK_(G)+1) :: depth_2d !< distance from surface of an interface (m) + real, dimension(SZI_(G), SZK_(G)+1) :: depth_2d !< distance from surface of an interface (m) real, dimension(SZI_(G)) :: & - depth !< distance from surface of an interface (meter) + depth !< distance from surface of an interface (meter) real :: depth_c !< depth of the center of a layer (meter) real :: I_Hmix !< inverse of fixed mixed layer thickness (1/m) real :: I_2Omega !< 1/(2 Omega) (sec) @@ -359,15 +363,11 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd, j, G, GV, CS) nlev=nz, & max_nlev=nz) - do k=1,nz ! Update Kd + do k=1,nz Kd(i,j,k) = Kd(i,j,k) + 0.5*(CS%kd_bkgnd(i,j,K) + CS%kd_bkgnd(i,j,K+1)) - ! ######## CHECK ############### - ! GMM, we could update Kv here????? - ! Kv(i,j,k) = Kv(i,j,k) + 0.5*(CS%bkgnd_mixing_csp%kv_bkgnd(i,j,K) + & - ! CS%bkgnd_mixing_csp%kv_bkgnd(i,j,K+1)) enddo - enddo + enddo ! i loop elseif ((.not. CS%Bryan_Lewis_diffusivity) .and. (.not.CS%bulkmixedlayer) .and. & (CS%Kd/= CS%Kdml)) then @@ -401,17 +401,23 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd, j, G, GV, CS) enddo ; enddo endif - ! Update CS%kd_bkgnd - ! GMM, we could update CS%kv_bkgnd here????? + ! Update CS%kd_bkgnd and CS%kv_bkgnd for diagnostic purposes if (.not. CS%Bryan_Lewis_diffusivity) then do i=is,ie - CS%kd_bkgnd(i,j,1) = 0.0 - CS%kd_bkgnd(i,j,nz+1) = 0.0 + CS%kd_bkgnd(i,j,1) = 0.0; CS%kv_bkgnd(i,j,1) = 0.0 + CS%kd_bkgnd(i,j,nz+1) = 0.0; CS%kv_bkgnd(i,j,nz+1) = 0.0 do k=2,nz - ! Update CS%kd_bkgnd CS%kd_bkgnd(i,j,k) = CS%kd_bkgnd(i,j,k) + 0.5*(Kd(i,j,K-1) + Kd(i,j,K)) - ! ######## CHECK ############### - ! GMM, we could update CS%kv_bkgnd here????? + CS%kv_bkgnd(i,j,k) = CS%kd_bkgnd(i,j,k) * CS%prandtl_bkgnd + enddo + enddo + endif + + ! Update visc%Kv_slow, if associated + if (associated(visc%Kv_slow)) then + do i=is,ie + do k=1,nz+1 + visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%kv_bkgnd(i,j,k) enddo enddo endif diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index c1ae3fe7e7..25c2464b56 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -677,8 +677,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,k) = Kd_int(i,j,k) + CS%cvmix_conv_csp%kd_conv_3d(i,j,k) - visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%cvmix_conv_csp%kv_conv_3d(i,j,k) + Kd_int(i,j,k) = Kd_int(i,j,k) + CS%cvmix_conv_csp%kd_conv(i,j,k) + visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%cvmix_conv_csp%kv_conv(i,j,k) enddo ; enddo ; enddo !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index a672faecc1..a66a94334b 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -505,7 +505,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif ! add background mixing - call calculate_bkgnd_mixing(h, tv, N2_lay, Kd, j, G, GV, CS%bkgnd_mixing_csp) + call calculate_bkgnd_mixing(h, tv, N2_lay, Kd, visc, j, G, GV, CS%bkgnd_mixing_csp) ! GMM, the following will go into the MOM_cvmix_double_diffusion module if (CS%double_diffusion) then diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index e38d484714..3df3e7b780 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1823,8 +1823,8 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) vd = var_desc("Kv_shear","m2 s-1","Shear-driven turbulent viscosity at interfaces", & hor_grid='h', z_grid='i') call register_restart_field(visc%Kv_shear, vd, .false., restart_CS) - vd = var_desc("Kv_slow","m2 s-1","Vertical turbulent viscosity at interfaces due to slow" & - " processes", hor_grid='h', z_grid='i') + vd = var_desc("Kv_slow","m2 s-1","Vertical turbulent viscosity at interfaces due \n" // & + " to slow processes", hor_grid='h', z_grid='i') call register_restart_field(visc%Kv_slow, vd, .false., restart_CS) endif From 648018e4afa58b13fa22b736daeb9c163de6e0bb Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 3 Apr 2018 10:29:04 -0600 Subject: [PATCH 0058/1072] Rename kv_conv -> kv_conv_const; kd_conv -> kd_conv_const --- src/parameterizations/vertical/MOM_cvmix_conv.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/vertical/MOM_cvmix_conv.F90 b/src/parameterizations/vertical/MOM_cvmix_conv.F90 index ea50bd1a16..55e7d55d6e 100644 --- a/src/parameterizations/vertical/MOM_cvmix_conv.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_conv.F90 @@ -26,8 +26,8 @@ module MOM_cvmix_conv type, public :: cvmix_conv_cs ! Parameters - real :: kd_conv !< diffusivity constant used in convective regime (m2/s) - real :: kv_conv !< viscosity constant used in convective regime (m2/s) + real :: kd_conv_const !< diffusivity constant used in convective regime (m2/s) + real :: kv_conv_const !< viscosity constant used in convective regime (m2/s) real :: bv_sqr_conv !< Threshold for squared buoyancy frequency !! needed to trigger Brunt-Vaisala parameterization (1/s^2) real :: min_thickness !< Minimum thickness allowed (m) @@ -106,7 +106,7 @@ logical function cvmix_conv_init(Time, G, GV, param_file, diag, CS) "instabilities (i.e., used to convert KD_CONV into KV_CONV)", & units="nondim", default=1.0) - call get_param(param_file, mdl, 'KD_CONV', CS%kd_conv, & + call get_param(param_file, mdl, 'KD_CONV', CS%kd_conv_const, & "Diffusivity used in convective regime. Corresponding viscosity \n" // & "(KV_CONV) will be set to KD_CONV * PRANDTL_TURB.", & units='m2/s', default=1.00) @@ -118,8 +118,8 @@ logical function cvmix_conv_init(Time, G, GV, param_file, diag, CS) call closeParameterBlock(param_file) - ! set kv_conv based on kd_conv and prandtl_conv - CS%kv_conv = CS%kd_conv * prandtl_conv + ! set kv_conv_const based on kd_conv_const and prandtl_conv + CS%kv_conv_const = CS%kd_conv_const * prandtl_conv ! allocate arrays and set them to zero allocate(CS%N2(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%N2(:,:,:) = 0. @@ -135,8 +135,8 @@ logical function cvmix_conv_init(Time, G, GV, param_file, diag, CS) CS%id_kv_conv = register_diag_field('ocean_model', 'conv_kv', diag%axesTi, Time, & 'Additional viscosity added by MOM_cvmix_conv module', 'm2/s') - call cvmix_init_conv(convect_diff=CS%kd_conv, & - convect_visc=CS%kv_conv, & + call cvmix_init_conv(convect_diff=CS%kd_conv_const, & + convect_visc=CS%kv_conv_const, & lBruntVaisala=.true., & BVsqr_convect=CS%bv_sqr_conv) From ea813b8f3e1e7e69478aa7068256388bf2a893b0 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 3 Apr 2018 11:21:37 -0600 Subject: [PATCH 0059/1072] add tidal diagnostics for cvmix --- .../vertical/MOM_tidal_mixing.F90 | 184 +++++++++++------- 1 file changed, 117 insertions(+), 67 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index c6c5d302ba..7b2977f48c 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -32,26 +32,30 @@ module MOM_tidal_mixing public post_tidal_diagnostics public tidal_mixing_end -!> Control structure for tidal mixing diagnostics +!> Containers for tidal mixing diagnostics type, public :: tidal_mixing_diags real, pointer, dimension(:,:,:) :: & - Kd_itidal => NULL(),& ! internal tide diffusivity at interfaces (m2/s) - Fl_itidal => NULL(),& ! vertical flux of tidal turbulent dissipation (m3/s3) - Kd_lowmode => NULL(),& ! internal tide diffusivity at interfaces - ! due to propagating low modes (m2/s) (BDM) - Fl_lowmode => NULL(),& ! vertical flux of tidal turbulent dissipation - ! due to propagating low modes (m3/s3) (BDM) - Kd_Niku => NULL(),& ! lee-wave diffusivity at interfaces (m2/s) - Kd_Niku_work => NULL(),& ! layer integrated work by lee-wave driven mixing (W/m2) - Kd_Itidal_Work => NULL(),& ! layer integrated work by int tide driven mixing (W/m2) - Kd_Lowmode_Work=> NULL() ! layer integrated work by low mode driven mixing (W/m2) BDM + Kd_itidal => NULL(),& ! internal tide diffusivity at interfaces (m2/s) + Fl_itidal => NULL(),& ! vertical flux of tidal turbulent dissipation (m3/s3) + Kd_lowmode => NULL(),& ! internal tide diffusivity at interfaces + ! due to propagating low modes (m2/s) (BDM) + Fl_lowmode => NULL(),& ! vertical flux of tidal turbulent dissipation + ! due to propagating low modes (m3/s3) (BDM) + Kd_Niku => NULL(),& ! lee-wave diffusivity at interfaces (m2/s) + Kd_Niku_work => NULL(),& ! layer integrated work by lee-wave driven mixing (W/m2) + Kd_Itidal_Work => NULL(),& ! layer integrated work by int tide driven mixing (W/m2) + Kd_Lowmode_Work => NULL(),& ! layer integrated work by low mode driven mixing (W/m2) BDM + N2_int => NULL(),& + vert_dep_3d => NULL() real, pointer, dimension(:,:) :: & TKE_itidal_used => NULL(),& ! internal tide TKE input at ocean bottom (W/m2) N2_bot => NULL(),& ! bottom squared buoyancy frequency (1/s2) N2_meanz => NULL(),& ! vertically averaged buoyancy frequency (1/s2) Polzin_decay_scale_scaled => NULL(),& ! vertical scale of decay for tidal dissipation - Polzin_decay_scale => NULL() ! vertical decay scale for tidal diss with Polzin (meter) + Polzin_decay_scale => NULL(),& ! vertical decay scale for tidal diss with Polzin (meter) + Simmons_coeff_2d => NULL() + end type !> Control structure for tidal mixing module. @@ -161,6 +165,9 @@ module MOM_tidal_mixing integer :: id_Fl_lowmode = -1 integer :: id_Polzin_decay_scale = -1 integer :: id_Polzin_decay_scale_scaled = -1 + integer :: id_N2_int = -1 + integer :: id_Simmons_coeff = -1 + integer :: id_vert_dep = -1 end type tidal_mixing_cs @@ -567,6 +574,18 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, endif endif + + ! CVMix tidal diagnostics + if (CS%use_cvmix_tidal) then + + CS%id_N2_int = register_diag_field('ocean_model','N2_int',diag%axesT1,Time, & + 'Bouyancy frequency squared, at interfaces', 's-2') + CS%id_Simmons_coeff = register_diag_field('ocean_model','Simmons_coeff',diag%axesTi,Time, & + 'time-invariant portion of the tidal mixing coefficient using the Simmons', '') + CS%id_vert_dep = register_diag_field('ocean_model','vert_dep',diag%axesTi,Time, & + 'vertical deposition function needed for Simmons et al tidal mixing', '') + endif + end function tidal_mixing_init @@ -611,7 +630,6 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd ! local - logical, parameter :: init_every_tstep = .true. real, dimension(SZK_(G)+1) :: Kd_tidal !< tidal diffusivity [m2/s] real, dimension(SZK_(G)+1) :: Kv_tidal !< tidal viscosity [m2/s] real, dimension(SZK_(G)+1) :: vert_dep !< vertical deposition needed for Simmons tidal mixing. @@ -621,62 +639,77 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) integer :: isd, ied, jsd, jed real :: dh, hcorr, Simmons_coeff real, parameter :: rho_fw = 1000.0 ! fresh water density [kg/m^3] ! TODO: when coupled, get this from CESM (SHR_CONST_RHOFW) + type(tidal_mixing_diags), pointer :: dd - if (init_every_tstep) then - - select case (CS%int_tide_profile) - case (SIMMONS_04) - do i=is,ie - iFaceHeight = 0.0 ! BBL is all relative to the surface - hcorr = 0.0 - do k=1,G%ke - ! cell center and cell bottom in meters (negative values in the ocean) - dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment - dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) - hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 - dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness - cellHeight(k) = iFaceHeight(k) - 0.5 * dh - iFaceHeight(k+1) = iFaceHeight(k) - dh - enddo - - if (G%mask2dT(i,j)<1) return - - call cvmix_compute_Simmons_invariant( nlev = G%ke, & - energy_flux = CS%tidal_qe_2d(i,j), & - rho = rho_fw, & - SimmonsCoeff = Simmons_coeff, & - VertDep = vert_dep, & - zw = iFaceHeight, & - zt = cellHeight, & - CVmix_tidal_params_user = CS%cvmix_tidal_params) - - ! Since we pass tidal_qe_2d=(CS%Gamma_itides)*tidal_energy_flux_2d, and not tidal_energy_flux_2d in - ! above subroutine call, we divide Simmons_coeff by CS%Gamma_itides as a corrective step: - Simmons_coeff = Simmons_coeff / CS%Gamma_itides - - - call cvmix_coeffs_tidal( Mdiff_out = Kv_tidal, & - Tdiff_out = Kd_tidal, & - Nsqr = N2_int(i,:), & - OceanDepth = iFaceHeight(G%ke+1), & - SimmonsCoeff = Simmons_coeff, & - vert_dep = vert_dep, & - nlev = G%ke, & - max_nlev = G%ke, & - CVmix_params = CS%cvmix_glb_params, & - CVmix_tidal_params_user = CS%cvmix_tidal_params) - - do k=1,G%ke - Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_tidal(k) + Kd_tidal(k+1) ) - !TODO: Kv(i,j,k) = ???????????? - enddo + dd => CS%dd + + select case (CS%int_tide_profile) + case (SIMMONS_04) + do i=is,ie + iFaceHeight = 0.0 ! BBL is all relative to the surface + hcorr = 0.0 + do k=1,G%ke + ! cell center and cell bottom in meters (negative values in the ocean) + dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) + hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 + dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness + cellHeight(k) = iFaceHeight(k) - 0.5 * dh + iFaceHeight(k+1) = iFaceHeight(k) - dh enddo - ! TODO: case (SCHMITTNER) - case default - call MOM_error(FATAL, "tidal_mixing_init: The selected"// & - " INT_TIDE_PROFILE is unavailable in CVMix") - end select - endif + + if (G%mask2dT(i,j)<1) return + + call cvmix_compute_Simmons_invariant( nlev = G%ke, & + energy_flux = CS%tidal_qe_2d(i,j), & + rho = rho_fw, & + SimmonsCoeff = Simmons_coeff, & + VertDep = vert_dep, & + zw = iFaceHeight, & + zt = cellHeight, & + CVmix_tidal_params_user = CS%cvmix_tidal_params) + + ! Since we pass tidal_qe_2d=(CS%Gamma_itides)*tidal_energy_flux_2d, and not tidal_energy_flux_2d in + ! above subroutine call, we divide Simmons_coeff by CS%Gamma_itides as a corrective step: + Simmons_coeff = Simmons_coeff / CS%Gamma_itides + + + call cvmix_coeffs_tidal( Mdiff_out = Kv_tidal, & + Tdiff_out = Kd_tidal, & + Nsqr = N2_int(i,:), & + OceanDepth = iFaceHeight(G%ke+1), & + SimmonsCoeff = Simmons_coeff, & + vert_dep = vert_dep, & + nlev = G%ke, & + max_nlev = G%ke, & + CVmix_params = CS%cvmix_glb_params, & + CVmix_tidal_params_user = CS%cvmix_tidal_params) + + do k=1,G%ke + Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_tidal(k) + Kd_tidal(k+1) ) + !TODO: Kv(i,j,k) = ???????????? + enddo + + ! diagnostics + if (associated(dd%Kd_itidal)) then + dd%Kd_itidal(i,j,:) = Kd_tidal(:) + endif + if (associated(dd%N2_int)) then + dd%N2_int(i,j,:) = N2_int(i,:) + endif + if (associated(dd%Simmons_coeff_2d)) then + dd%Simmons_coeff_2d(i,j) = Simmons_coeff + endif + if (associated(dd%vert_dep_3d)) then + dd%vert_dep_3d(i,j,:) = vert_dep(:) + endif + + enddo + ! TODO: case (SCHMITTNER) + case default + call MOM_error(FATAL, "tidal_mixing_init: The selected"// & + " INT_TIDE_PROFILE is unavailable in CVMix") + end select end subroutine calculate_cvmix_tidal @@ -1137,6 +1170,16 @@ subroutine setup_tidal_diagnostics(G,CS) if (CS%id_TKE_itidal > 0) then allocate(dd%TKE_Itidal_used(isd:ied,jsd:jed)) ; dd%TKE_Itidal_used(:,:) = 0. endif + ! additional diags for CVMix + if (CS%id_N2_int > 0) then + allocate(dd%N2_int(isd:ied,jsd:jed,nz+1)) ; dd%N2_int(:,:,:) = 0.0 + endif + if (CS%id_Simmons_coeff > 0) then + allocate(dd%Simmons_coeff_2d(isd:ied,jsd:jed)) ; dd%Simmons_coeff_2d(:,:) = 0.0 + endif + if (CS%id_vert_dep > 0) then + allocate(dd%vert_dep_3d(isd:ied,jsd:jed,nz+1)) ; dd%vert_dep_3d(:,:,:) = 0.0 + endif end subroutine setup_tidal_diagnostics subroutine post_tidal_diagnostics(G,GV,h,CS) @@ -1168,6 +1211,10 @@ subroutine post_tidal_diagnostics(G,GV,h,CS) if (CS%id_Kd_lowmode> 0) call post_data(CS%id_Kd_lowmode, dd%Kd_lowmode, CS%diag) if (CS%id_Fl_lowmode> 0) call post_data(CS%id_Fl_lowmode, dd%Fl_lowmode, CS%diag) + if (CS%id_N2_int> 0) call post_data(CS%id_N2_int, dd%N2_int, CS%diag) + if (CS%id_vert_dep> 0) call post_data(CS%id_vert_dep, dd%vert_dep_3d, CS%diag) + if (CS%id_Simmons_coeff> 0) call post_data(CS%id_Simmons_coeff, dd%Simmons_coeff_2d, CS%diag) + if (CS%id_Kd_Itidal_Work > 0) & call post_data(CS%id_Kd_Itidal_Work, dd%Kd_Itidal_Work, CS%diag) if (CS%id_Kd_Niku_Work > 0) call post_data(CS%id_Kd_Niku_Work, dd%Kd_Niku_Work, CS%diag) @@ -1215,6 +1262,9 @@ subroutine post_tidal_diagnostics(G,GV,h,CS) if (associated(dd%Kd_Itidal_Work)) deallocate(dd%Kd_Itidal_Work) if (associated(dd%Kd_Lowmode_Work)) deallocate(dd%Kd_Lowmode_Work) if (associated(dd%TKE_itidal_used)) deallocate(dd%TKE_itidal_used) + if (associated(dd%N2_int)) deallocate(dd%N2_int) + if (associated(dd%vert_dep_3d)) deallocate(dd%vert_dep_3d) + if (associated(dd%Simmons_coeff_2d)) deallocate(dd%Simmons_coeff_2d) end subroutine post_tidal_diagnostics From 1218973de6e7e167c1e0545a1d6685acdf195653 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 3 Apr 2018 13:46:17 -0600 Subject: [PATCH 0060/1072] Raname variables Kd -> kd_lay; visc%Kv_slow - > kv --- .../vertical/MOM_bkgnd_mixing.F90 | 31 +++++++++---------- .../vertical/MOM_set_diffusivity.F90 | 8 +---- 2 files changed, 15 insertions(+), 24 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 2e4bba1110..763b3665d4 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -303,7 +303,7 @@ end subroutine sfc_bkgnd_mixing !> Calculates the vertical background diffusivities/viscosities -subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd, visc, j, G, GV, CS) +subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. @@ -311,10 +311,9 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd, visc, j, G, GV, CS) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay!< squared buoyancy frequency associated !! with layers (1/s2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd !< Diapycnal diffusivity of each layer (m2/sec). - type(vertvisc_type), intent(inout) :: visc!< Structure containing vertical viscosities, - !! bottom boundary layer properies, and related - !! fields. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: kd_lay!< Diapycnal diffusivity of each layer m2 s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The "slow" vertical viscosity at each interface + !! (not layer!) in m2 s-1. integer, intent(in) :: j !< Meridional grid indice. type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by !! a previous call to bkgnd_mixing_init. @@ -365,7 +364,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd, visc, j, G, GV, CS) ! Update Kd do k=1,nz - Kd(i,j,k) = Kd(i,j,k) + 0.5*(CS%kd_bkgnd(i,j,K) + CS%kd_bkgnd(i,j,K+1)) + kd_lay(i,j,k) = kd_lay(i,j,k) + 0.5*(CS%kd_bkgnd(i,j,K) + CS%kd_bkgnd(i,j,K+1)) enddo enddo ! i loop @@ -378,7 +377,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd, visc, j, G, GV, CS) if (depth_c <= CS%Hmix) then ; CS%kd_bkgnd(i,j,k) = CS%Kdml elseif (depth_c >= 2.0*CS%Hmix) then ; CS%kd_bkgnd(i,j,k) = CS%Kd_sfc(i,j) else - Kd(i,j,k) = ((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & + kd_lay(i,j,k) = ((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & (2.0*CS%Kdml - CS%Kd_sfc(i,j)) endif @@ -391,13 +390,13 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd, visc, j, G, GV, CS) abs_sin = max(epsilon,abs(sin(G%geoLatT(i,j)*deg_to_rad))) N_2Omega = max(abs_sin,sqrt(N2_lay(i,k))*I_2Omega) N02_N2 = (CS%N0_2Omega/N_2Omega)**2 - Kd(i,j,k) = max(CS%Kd_min, CS%Kd_sfc(i,j) * & + kd_lay(i,j,k) = max(CS%Kd_min, CS%Kd_sfc(i,j) * & ((abs_sin * invcosh(N_2Omega/abs_sin)) * I_x30)*N02_N2) enddo ; enddo else do k=1,nz ; do i=is,ie - Kd(i,j,k) = CS%Kd_sfc(i,j) + kd_lay(i,j,k) = CS%Kd_sfc(i,j) enddo ; enddo endif @@ -407,20 +406,18 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd, visc, j, G, GV, CS) CS%kd_bkgnd(i,j,1) = 0.0; CS%kv_bkgnd(i,j,1) = 0.0 CS%kd_bkgnd(i,j,nz+1) = 0.0; CS%kv_bkgnd(i,j,nz+1) = 0.0 do k=2,nz - CS%kd_bkgnd(i,j,k) = CS%kd_bkgnd(i,j,k) + 0.5*(Kd(i,j,K-1) + Kd(i,j,K)) + CS%kd_bkgnd(i,j,k) = CS%kd_bkgnd(i,j,k) + 0.5*(kd_lay(i,j,K-1) + kd_lay(i,j,K)) CS%kv_bkgnd(i,j,k) = CS%kd_bkgnd(i,j,k) * CS%prandtl_bkgnd enddo enddo endif - ! Update visc%Kv_slow, if associated - if (associated(visc%Kv_slow)) then - do i=is,ie - do k=1,nz+1 - visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%kv_bkgnd(i,j,k) - enddo + ! Update kv + do i=is,ie + do k=1,nz+1 + kv(i,j,k) = kv(i,j,k) + CS%kv_bkgnd(i,j,k) enddo - endif + enddo end subroutine calculate_bkgnd_mixing diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index a66a94334b..08c438bf24 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -505,7 +505,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif ! add background mixing - call calculate_bkgnd_mixing(h, tv, N2_lay, Kd, visc, j, G, GV, CS%bkgnd_mixing_csp) + call calculate_bkgnd_mixing(h, tv, N2_lay, Kd, visc%Kv_slow, j, G, GV, CS%bkgnd_mixing_csp) ! GMM, the following will go into the MOM_cvmix_double_diffusion module if (CS%double_diffusion) then @@ -629,12 +629,6 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%debug) then call hchksum(Kd ,"Kd",G%HI,haloshift=0) - !!if (associated(CS%bkgnd_mixing_csp%kd_bkgnd)) & - !1 call hchksum(CS%bkgnd_mixing_csp%kd_bkgnd, "kd_bkgnd",G%HI,haloshift=0) - - !!if (associated(CS%bkgnd_mixing_csp%kv_bkgnd)) & - !! call hchksum(CS%bkgnd_mixing_csp%kv_bkgnd, "kv_bkgnd",G%HI,haloshift=0) - if (CS%useKappaShear) call hchksum(visc%Kd_shear,"Turbulent Kd",G%HI,haloshift=0) if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then From 0ce9980a4c69aba51a1d08c63458a6d2cb77fd96 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 4 Apr 2018 14:06:37 -0600 Subject: [PATCH 0061/1072] By pass reading BULKMIXEDLAYER via get_param BULKMIXEDLAYER is not always defined in MOM_input (e.g., in CM2G63L), so adding new code where get_param is used to determine if BULKMIXEDLAYER is used won't always work. To by pass that the following is now used: CS%bulkmixedlayer = (GV%nkml > 0) --- src/parameterizations/vertical/MOM_bkgnd_mixing.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 763b3665d4..91f20e4ab2 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -133,8 +133,10 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) units="m2 s-1", default=0.01*CS%Kd) ! The following is needed to set one of the choices of vertical background mixing - call get_param(param_file, mdl, "BULKMIXEDLAYER", CS%bulkmixedlayer, & - do_not_log=.true.) + + ! BULKMIXEDLAYER is not always defined (e.g., CM2G63L), so the following by pass + ! the need to include BULKMIXEDLAYER in MOM_input + CS%bulkmixedlayer = (GV%nkml > 0) if (CS%bulkmixedlayer) then ! Check that Kdml is not set when using bulk mixed layer call get_param(param_file, mdl, "KDML", CS%Kdml, default=-1.) From 36f7a0652120552c523a0dde6353343e9dc509bf Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 4 Apr 2018 15:17:52 -0600 Subject: [PATCH 0062/1072] Changed kv to a pointer since it might not always be associated --- src/parameterizations/vertical/MOM_bkgnd_mixing.F90 | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 91f20e4ab2..14c6c3412e 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -314,7 +314,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, CS) real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay!< squared buoyancy frequency associated !! with layers (1/s2) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: kd_lay!< Diapycnal diffusivity of each layer m2 s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The "slow" vertical viscosity at each interface + real, dimension(:,:,:), pointer :: kv !< The "slow" vertical viscosity at each interface !! (not layer!) in m2 s-1. integer, intent(in) :: j !< Meridional grid indice. type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by @@ -415,11 +415,13 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, CS) endif ! Update kv - do i=is,ie - do k=1,nz+1 - kv(i,j,k) = kv(i,j,k) + CS%kv_bkgnd(i,j,k) + if (associated(kv)) then + do i=is,ie + do k=1,nz+1 + kv(i,j,k) = kv(i,j,k) + CS%kv_bkgnd(i,j,k) + enddo enddo - enddo + endif end subroutine calculate_bkgnd_mixing From 4dde6037bb65e7301948d9008283c9d36b3602b0 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 4 Apr 2018 15:19:53 -0600 Subject: [PATCH 0063/1072] Avoided a possible seg. fault in set_diffusivity_end --- src/parameterizations/vertical/MOM_set_diffusivity.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 08c438bf24..eb12eb23d6 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -2957,6 +2957,8 @@ end subroutine set_diffusivity_init subroutine set_diffusivity_end(CS) type(set_diffusivity_CS), pointer :: CS !< Control structure for this module + if (.not.associated(CS)) return + call bkgnd_mixing_end(CS%bkgnd_mixing_csp) if (CS%user_change_diff) & From 3e7cab88e3211bb559a74ca8b8f00b15527ff242 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 5 Apr 2018 14:50:39 -0600 Subject: [PATCH 0064/1072] debug calculate_cvmix_tidal --- .../vertical/MOM_tidal_mixing.F90 | 114 ++++++++++-------- 1 file changed, 62 insertions(+), 52 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 7b2977f48c..d1b1492edf 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -10,6 +10,7 @@ module MOM_tidal_mixing use MOM_EOS, only : calculate_density use MOM_variables, only : thermo_var_ptrs, p3d use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE +use MOM_coms, only : PE_here use MOM_debugging, only : hchksum use MOM_grid, only : ocean_grid_type use MOM_verticalGrid, only : verticalGrid_type @@ -508,53 +509,64 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, ! Register Diagnostics fields - if (CS%Lee_wave_dissipation) then - CS%id_TKE_leewave = register_diag_field('ocean_model','TKE_leewave',diag%axesT1,Time, & - 'Lee wave Driven Turbulent Kinetic Energy', 'W m-2') - CS%id_Kd_Niku = register_diag_field('ocean_model','Kd_Nikurashin',diag%axesTi,Time, & - 'Lee Wave Driven Diffusivity', 'm2 s-1') - endif - if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. & CS%Lowmode_itidal_dissipation) then - CS%id_TKE_itidal = register_diag_field('ocean_model','TKE_itidal',diag%axesT1,Time, & - 'Internal Tide Driven Turbulent Kinetic Energy', 'W m-2') - CS%id_Nb = register_diag_field('ocean_model','Nb',diag%axesT1,Time, & - 'Bottom Buoyancy Frequency', 's-1') - CS%id_Kd_itidal = register_diag_field('ocean_model','Kd_itides',diag%axesTi,Time, & 'Internal Tide Driven Diffusivity', 'm2 s-1') - CS%id_Kd_lowmode = register_diag_field('ocean_model','Kd_lowmode',diag%axesTi,Time, & - 'Internal Tide Driven Diffusivity (from propagating low modes)', 'm2 s-1') + if (CS%use_cvmix_tidal) then + CS%id_N2_int = register_diag_field('ocean_model','N2_int',diag%axesTi,Time, & + 'Bouyancy frequency squared, at interfaces', 's-2') + ! TODO: add units + CS%id_Simmons_coeff = register_diag_field('ocean_model','Simmons_coeff',diag%axesT1,Time, & + 'time-invariant portion of the tidal mixing coefficient using the Simmons', '') + CS%id_vert_dep = register_diag_field('ocean_model','vert_dep',diag%axesTi,Time, & + 'vertical deposition function needed for Simmons et al tidal mixing', '') + + else + CS%id_TKE_itidal = register_diag_field('ocean_model','TKE_itidal',diag%axesT1,Time, & + 'Internal Tide Driven Turbulent Kinetic Energy', 'W m-2') + CS%id_Nb = register_diag_field('ocean_model','Nb',diag%axesT1,Time, & + 'Bottom Buoyancy Frequency', 's-1') - CS%id_Fl_itidal = register_diag_field('ocean_model','Fl_itides',diag%axesTi,Time, & - 'Vertical flux of tidal turbulent dissipation', 'm3 s-3') + CS%id_Kd_lowmode = register_diag_field('ocean_model','Kd_lowmode',diag%axesTi,Time, & + 'Internal Tide Driven Diffusivity (from propagating low modes)', 'm2 s-1') - CS%id_Fl_lowmode = register_diag_field('ocean_model','Fl_lowmode',diag%axesTi,Time, & - 'Vertical flux of tidal turbulent dissipation (from propagating low modes)', 'm3 s-3') + CS%id_Fl_itidal = register_diag_field('ocean_model','Fl_itides',diag%axesTi,Time, & + 'Vertical flux of tidal turbulent dissipation', 'm3 s-3') - CS%id_Polzin_decay_scale = register_diag_field('ocean_model','Polzin_decay_scale',diag%axesT1,Time, & - 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', 'm') + CS%id_Fl_lowmode = register_diag_field('ocean_model','Fl_lowmode',diag%axesTi,Time, & + 'Vertical flux of tidal turbulent dissipation (from propagating low modes)', 'm3 s-3') - CS%id_Polzin_decay_scale_scaled = register_diag_field('ocean_model','Polzin_decay_scale_scaled',diag%axesT1,Time, & - 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme, scaled by N2_bot/N2_meanz', 'm') + CS%id_Polzin_decay_scale = register_diag_field('ocean_model','Polzin_decay_scale',diag%axesT1,Time, & + 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', 'm') - CS%id_N2_bot = register_diag_field('ocean_model','N2_b',diag%axesT1,Time, & - 'Bottom Buoyancy frequency squared', 's-2') + CS%id_Polzin_decay_scale_scaled = register_diag_field('ocean_model','Polzin_decay_scale_scaled',diag%axesT1,Time, & + 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme, scaled by N2_bot/N2_meanz', 'm') - CS%id_N2_meanz = register_diag_field('ocean_model','N2_meanz',diag%axesT1,Time, & - 'Buoyancy frequency squared averaged over the water column', 's-2') + CS%id_N2_bot = register_diag_field('ocean_model','N2_b',diag%axesT1,Time, & + 'Bottom Buoyancy frequency squared', 's-2') - CS%id_Kd_Itidal_Work = register_diag_field('ocean_model','Kd_Itidal_Work',diag%axesTL,Time, & - 'Work done by Internal Tide Diapycnal Mixing', 'W m-2') + CS%id_N2_meanz = register_diag_field('ocean_model','N2_meanz',diag%axesT1,Time, & + 'Buoyancy frequency squared averaged over the water column', 's-2') - CS%id_Kd_Niku_Work = register_diag_field('ocean_model','Kd_Nikurashin_Work',diag%axesTL,Time, & - 'Work done by Nikurashin Lee Wave Drag Scheme', 'W m-2') + CS%id_Kd_Itidal_Work = register_diag_field('ocean_model','Kd_Itidal_Work',diag%axesTL,Time, & + 'Work done by Internal Tide Diapycnal Mixing', 'W m-2') - CS%id_Kd_Lowmode_Work = register_diag_field('ocean_model','Kd_Lowmode_Work',diag%axesTL,Time, & - 'Work done by Internal Tide Diapycnal Mixing (low modes)', 'W m-2') + CS%id_Kd_Niku_Work = register_diag_field('ocean_model','Kd_Nikurashin_Work',diag%axesTL,Time, & + 'Work done by Nikurashin Lee Wave Drag Scheme', 'W m-2') + + CS%id_Kd_Lowmode_Work = register_diag_field('ocean_model','Kd_Lowmode_Work',diag%axesTL,Time, & + 'Work done by Internal Tide Diapycnal Mixing (low modes)', 'W m-2') + + if (CS%Lee_wave_dissipation) then + CS%id_TKE_leewave = register_diag_field('ocean_model','TKE_leewave',diag%axesT1,Time, & + 'Lee wave Driven Turbulent Kinetic Energy', 'W m-2') + CS%id_Kd_Niku = register_diag_field('ocean_model','Kd_Nikurashin',diag%axesTi,Time, & + 'Lee Wave Driven Diffusivity', 'm2 s-1') + endif + endif ! S%use_cvmix_tidal if (associated(CS%diag_to_Z_CSp)) then vd = var_desc("Kd_itides","m2 s-1", & @@ -575,17 +587,6 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, endif - ! CVMix tidal diagnostics - if (CS%use_cvmix_tidal) then - - CS%id_N2_int = register_diag_field('ocean_model','N2_int',diag%axesT1,Time, & - 'Bouyancy frequency squared, at interfaces', 's-2') - CS%id_Simmons_coeff = register_diag_field('ocean_model','Simmons_coeff',diag%axesTi,Time, & - 'time-invariant portion of the tidal mixing coefficient using the Simmons', '') - CS%id_vert_dep = register_diag_field('ocean_model','vert_dep',diag%axesTi,Time, & - 'vertical deposition function needed for Simmons et al tidal mixing', '') - endif - end function tidal_mixing_init @@ -635,17 +636,20 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) real, dimension(SZK_(G)+1) :: vert_dep !< vertical deposition needed for Simmons tidal mixing. real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m) - integer :: i, k, is, ie, js, je - integer :: isd, ied, jsd, jed + integer :: i, k, is, ie real :: dh, hcorr, Simmons_coeff real, parameter :: rho_fw = 1000.0 ! fresh water density [kg/m^3] ! TODO: when coupled, get this from CESM (SHR_CONST_RHOFW) type(tidal_mixing_diags), pointer :: dd + is = G%isc ; ie = G%iec dd => CS%dd select case (CS%int_tide_profile) case (SIMMONS_04) do i=is,ie + + if (G%mask2dT(i,j)<1) cycle + iFaceHeight = 0.0 ! BBL is all relative to the surface hcorr = 0.0 do k=1,G%ke @@ -658,8 +662,6 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) iFaceHeight(k+1) = iFaceHeight(k) - dh enddo - if (G%mask2dT(i,j)<1) return - call cvmix_compute_Simmons_invariant( nlev = G%ke, & energy_flux = CS%tidal_qe_2d(i,j), & rho = rho_fw, & @@ -677,7 +679,7 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) call cvmix_coeffs_tidal( Mdiff_out = Kv_tidal, & Tdiff_out = Kd_tidal, & Nsqr = N2_int(i,:), & - OceanDepth = iFaceHeight(G%ke+1), & + OceanDepth = -iFaceHeight(G%ke+1),& SimmonsCoeff = Simmons_coeff, & vert_dep = vert_dep, & nlev = G%ke, & @@ -704,7 +706,17 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) dd%vert_dep_3d(i,j,:) = vert_dep(:) endif - enddo + if (CS%debug) then + if (all(dd%Kd_itidal(i,j,:).eq.0.0) .and. .not. & + (all(dd%vert_dep_3d(i,j,:).eq.0.0) .or. & + all(dd%N2_int(i,j,:).eq.0.0) .or. & + Simmons_coeff.eq.0.0 ) )then + print *, "debug1 all zeros for ", i, j, iFaceHeight(G%ke+1) + endif + endif + + enddo ! i=is,ie + ! TODO: case (SCHMITTNER) case default call MOM_error(FATAL, "tidal_mixing_init: The selected"// & @@ -1275,12 +1287,11 @@ subroutine read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS) character(len=200), intent(in) :: tidal_energy_file type(tidal_mixing_cs), pointer :: CS ! local - integer :: i, j, is, ie, js, je, isd, ied, jsd, jed + integer :: isd, ied, jsd, jed real, allocatable, dimension(:,:) :: tidal_energy_flux_2d ! input tidal energy flux at T-grid points (W/m^2) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - if (.not. allocated(CS%tidal_qe_2d)) allocate(CS%tidal_qe_2d(isd:ied,jsd:jed)) allocate(tidal_energy_flux_2d(isd:ied,jsd:jed)) @@ -1308,7 +1319,6 @@ subroutine tidal_mixing_end(CS) deallocate(CS%dd) deallocate(CS) - ! TODO: check why ptrs allocated with MOM_safe_alloc are not deallocated? end subroutine tidal_mixing_end From 696462c509df7349de39459cc3b011f3378bfaf2 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 5 Apr 2018 14:53:21 -0600 Subject: [PATCH 0065/1072] MOM_tidal_mixing. cleaanup --- src/parameterizations/vertical/MOM_tidal_mixing.F90 | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index d1b1492edf..37944d9f2d 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -10,7 +10,6 @@ module MOM_tidal_mixing use MOM_EOS, only : calculate_density use MOM_variables, only : thermo_var_ptrs, p3d use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE -use MOM_coms, only : PE_here use MOM_debugging, only : hchksum use MOM_grid, only : ocean_grid_type use MOM_verticalGrid, only : verticalGrid_type @@ -706,16 +705,6 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) dd%vert_dep_3d(i,j,:) = vert_dep(:) endif - if (CS%debug) then - if (all(dd%Kd_itidal(i,j,:).eq.0.0) .and. .not. & - (all(dd%vert_dep_3d(i,j,:).eq.0.0) .or. & - all(dd%N2_int(i,j,:).eq.0.0) .or. & - Simmons_coeff.eq.0.0 ) )then - print *, "debug1 all zeros for ", i, j, iFaceHeight(G%ke+1) - endif - endif - - enddo ! i=is,ie ! TODO: case (SCHMITTNER) case default From bf322c84eb1d9399472222e3b643e0f0e2a73769 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 5 Apr 2018 17:29:57 -0600 Subject: [PATCH 0066/1072] add tidal mixing-specific prandtl number --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 4 +--- src/parameterizations/vertical/MOM_tidal_mixing.F90 | 10 +++++++--- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 37092616ac..70412a716b 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -585,7 +585,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G endif call cpu_clock_begin(id_clock_set_diffusivity) - ! Sets: Kd, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S ! Also changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ???? ! And sets visc%Kv_shear @@ -2342,8 +2341,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, allocate(CS%frazil_heat_diag(isd:ied,jsd:jed,nz) ) ; CS%frazil_heat_diag(:,:,:) = 0. endif - ! CS%use_tidal_mixing is set to True if an internal tidal dissipation scheme - ! is to be used to drive diapycnal mixing. + ! CS%use_tidal_mixing is set to True if an internal tidal dissipation scheme is to be used. CS%use_tidal_mixing = tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, CS%tidal_mixing_CSp) ! CS%use_cvmix_conv is set to True if CVMix convection will be used, otherwise diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 6e1c12180e..a59af01afb 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -201,7 +201,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, character(len=200) :: filename, h2_file, Niku_TKE_input_file character(len=200) :: tidal_energy_file, tideamp_file type(vardesc) :: vd - real :: utide, zbot, hamp, prandtl + real :: utide, zbot, hamp, prandtl_tidal real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -482,9 +482,12 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, ! TODO: list all available tidal energy types here call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, default=0.001, & do_not_log=.True.) - call get_param(param_file, mdl, "PRANDTL_TURB", prandtl,units="nondim", default=1.0, & + call get_param(param_file, mdl, "PRANDTL_TIDAL", prandtl_tidal, & + "Prandtl number used by CVMix tidal mixing schemes \n"//& + "to convert vertical diffusivities into viscosities.", & + units="nondim", default=1.0, & do_not_log=.true.) - call cvmix_put(CS%cvmix_glb_params,'Prandtl',prandtl) + call cvmix_put(CS%cvmix_glb_params,'Prandtl',prandtl_tidal) int_tide_profile_str = lowercase(int_tide_profile_str) @@ -672,6 +675,7 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) ! Since we pass tidal_qe_2d=(CS%Gamma_itides)*tidal_energy_flux_2d, and not tidal_energy_flux_2d in ! above subroutine call, we divide Simmons_coeff by CS%Gamma_itides as a corrective step: + ! TODO: (CS%Gamma_itides)*tidal_energy_flux_2d is unnecessary, directly use tidal_energy_flux_2d Simmons_coeff = Simmons_coeff / CS%Gamma_itides From 99ca9a71878c38255dac041d0b833db4e0065c56 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 10 Apr 2018 12:54:25 -0600 Subject: [PATCH 0067/1072] Adding option to smooth Ri using a 1-2-1 filter --- .../vertical/MOM_cvmix_shear.F90 | 45 +++++++++++++------ 1 file changed, 31 insertions(+), 14 deletions(-) diff --git a/src/parameterizations/vertical/MOM_cvmix_shear.F90 b/src/parameterizations/vertical/MOM_cvmix_shear.F90 index 345522126b..062282f596 100644 --- a/src/parameterizations/vertical/MOM_cvmix_shear.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_shear.F90 @@ -30,9 +30,11 @@ module MOM_cvmix_shear !> Control structure including parameters for CVMix interior shear schemes. type, public :: cvmix_shear_cs logical :: use_LMD94, use_PP81 !< Flags for various schemes + logical :: smooth_ri !< If true, smooth Ri using a 1-2-1 filter real :: Ri_zero !< LMD94 critical Richardson number real :: Nu_zero !< LMD94 maximum interior diffusivity - real :: KPP_exp !< + real :: KPP_exp !< Exponent of unitless factor of diff. + !! for KPP internal shear mixing scheme. real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency (1/s2) real, allocatable, dimension(:,:,:) :: S2 !< Squared shear frequency (1/s2) real, allocatable, dimension(:,:,:) :: ri_grad !< Gradient Richardson number @@ -52,22 +54,22 @@ module MOM_cvmix_shear !> Subroutine for calculating (internal) vertical diffusivities/viscosities subroutine calculate_cvmix_shear(u_H, v_H, h, tv, kd, & kv, G, GV, CS ) - type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: u_H !< Initial zonal velocity on T points, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: v_H !< Initial meridional velocity on T points, in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface - !! (not layer!) in m2 s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface - !! (not layer!) in m2 s-1. - type(cvmix_shear_cs), pointer :: CS !< The control structure returned by a previous call to - !! CVMix_shear_init. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface + !! (not layer!) in m2 s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface + !! (not layer!) in m2 s-1. + type(cvmix_shear_cs), pointer :: CS !< The control structure returned by a previous call to + !! CVMix_shear_init. ! Local variables integer :: i, j, k, kk, km1 - real :: gorho - real :: pref, DU, DV, DRHO, DZ, N2, S2 + real :: GoRho + real :: pref, DU, DV, DRHO, DZ, N2, S2, dummy real, dimension(2*(G%ke)) :: pres_1d, temp_1d, salt_1d, rho_1d real, dimension(G%ke+1) :: Ri_Grad !< Gradient Richardson number @@ -120,10 +122,21 @@ subroutine calculate_cvmix_shear(u_H, v_H, h, tv, kd, & ! fill 3d arrays, if user asks for diagsnostics if (CS%id_N2 > 0) CS%N2(i,j,k) = N2 if (CS%id_S2 > 0) CS%S2(i,j,k) = S2 - if (CS%id_ri_grad > 0) CS%ri_grad(i,j,k) = Ri_Grad(k) enddo + ! vertically smooth Ri with 1-2-1 weighting + if (CS%smooth_ri) then + dummy = 0.25 * Ri_grad(1) + Ri_grad(G%ke+1) = Ri_grad(G%ke) + do k = 1, G%ke + Ri_Grad(k) = dummy + 0.5 * Ri_Grad(k) + 0.25 * Ri_grad(k+1) + dummy = 0.25 * Ri_grad(k) + enddo + endif + + if (CS%id_ri_grad > 0) CS%ri_grad(i,j,:) = Ri_Grad(:) + ! Call to CVMix wrapper for computing interior mixing coefficients. call cvmix_coeffs_shear(Mdiff_out=kv(i,j,:), & Tdiff_out=kd(i,j,:), & @@ -209,6 +222,10 @@ logical function cvmix_shear_init(Time, G, GV, param_file, diag, CS) "Exponent of unitless factor of diffusivities,"// & " for KPP internal shear mixing scheme." & ,units="nondim", default=3.0) + call get_param(param_file, mdl, "SMOOTH_RI", CS%smooth_ri, & + "If true, vertically smooth the Richardson"// & + "number by applying a 1-2-1 filter once.", & + default = .false.) call cvmix_init_shear(mix_scheme=CS%mix_scheme, & KPP_nu_zero=CS%Nu_Zero, & KPP_Ri_zero=CS%Ri_zero, & From b14213a020730dab9592669e5d681e39f362ebd0 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 12 Apr 2018 16:45:55 -0600 Subject: [PATCH 0068/1072] Fill Ri_grad in vanished layers with adjacent value, just when Ri smooth is enabled --- .../vertical/MOM_cvmix_shear.F90 | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/vertical/MOM_cvmix_shear.F90 b/src/parameterizations/vertical/MOM_cvmix_shear.F90 index 062282f596..dacb02fe59 100644 --- a/src/parameterizations/vertical/MOM_cvmix_shear.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_shear.F90 @@ -38,8 +38,6 @@ module MOM_cvmix_shear real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency (1/s2) real, allocatable, dimension(:,:,:) :: S2 !< Squared shear frequency (1/s2) real, allocatable, dimension(:,:,:) :: ri_grad !< Gradient Richardson number -! real, allocatable, dimension(:,:,:) :: kv !< vertical viscosity at interface (m2/s) -! real, allocatable, dimension(:,:,:) :: kd !< vertical diffusivity at interface (m2/s) character(10) :: Mix_Scheme !< Mixing scheme name (string) ! Daignostic handles and pointers type(diag_ctrl), pointer :: diag => NULL() @@ -72,7 +70,8 @@ subroutine calculate_cvmix_shear(u_H, v_H, h, tv, kd, & real :: pref, DU, DV, DRHO, DZ, N2, S2, dummy real, dimension(2*(G%ke)) :: pres_1d, temp_1d, salt_1d, rho_1d real, dimension(G%ke+1) :: Ri_Grad !< Gradient Richardson number - + real, parameter :: epsln = 1.e-10 !< Threshold to identify + !! vanished layers ! some constants GoRho = GV%g_Earth / GV%Rho0 @@ -125,8 +124,17 @@ subroutine calculate_cvmix_shear(u_H, v_H, h, tv, kd, & enddo - ! vertically smooth Ri with 1-2-1 weighting + Ri_grad(G%ke+1) = Ri_grad(G%ke) + if (CS%smooth_ri) then + ! 1) fill Ri_grad in vanished layers with adjacent value + do k = 2, G%ke + if (h(i,j,k) .le. epsln) Ri_grad(k) = Ri_grad(k-1) + enddo + + Ri_grad(G%ke+1) = Ri_grad(G%ke) + + ! 2) vertically smooth Ri with 1-2-1 filter dummy = 0.25 * Ri_grad(1) Ri_grad(G%ke+1) = Ri_grad(G%ke) do k = 1, G%ke From c4f1f553c06d16172be35a09e02f0c50953aeb5b Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 12 Apr 2018 17:02:31 -0600 Subject: [PATCH 0069/1072] Update CVMix --- pkg/CVMix-src | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/CVMix-src b/pkg/CVMix-src index 653d7c39f5..534fc38e75 160000 --- a/pkg/CVMix-src +++ b/pkg/CVMix-src @@ -1 +1 @@ -Subproject commit 653d7c39f50047c9d79c1b15caffe5631dad8bbb +Subproject commit 534fc38e759fcb8a2563fa0dc4c0bbf81f758db9 From 0c363ae6d8d7b6fd32bfd0ba128513730d6431e0 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 13 Apr 2018 08:39:58 -0600 Subject: [PATCH 0070/1072] Always allocate CS%OBLdepth since other modules may need to know OBLdepth --- src/parameterizations/vertical/MOM_KPP.F90 | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 87ce532a28..baa33e2ffa 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -370,8 +370,9 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) CS%id_Vsurf = register_diag_field('ocean_model', 'KPP_Vsurf', diag%axesCv1, Time, & 'j-component flow of surface layer (10% of OBL depth) as passed to [CVmix] KPP', 'm/s') - if (CS%id_OBLdepth > 0) allocate( CS%OBLdepth( SZI_(G), SZJ_(G) ) ) - if (CS%id_OBLdepth > 0) CS%OBLdepth(:,:) = 0. + ! CS%OBLdepth should always be allocated, since it may used by other modules + allocate( CS%OBLdepth( SZI_(G), SZJ_(G) ) ); CS%OBLdepth(:,:) = 0. + if (CS%id_BulkDrho > 0) allocate( CS%dRho( SZI_(G), SZJ_(G), SZK_(G) ) ) if (CS%id_BulkDrho > 0) CS%dRho(:,:,:) = 0. if (CS%id_BulkUz2 > 0) allocate( CS%Uz2( SZI_(G), SZJ_(G), SZK_(G) ) ) @@ -864,7 +865,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & endif ! Copy 1d data into 3d diagnostic arrays - if (CS%id_OBLdepth > 0) CS%OBLdepth(i,j) = OBLdepth_0d + CS%OBLdepth(i,j) = OBLdepth_0d if (CS%id_BulkDrho > 0) CS%dRho(i,j,:) = deltaRho(:) if (CS%id_BulkUz2 > 0) CS%Uz2(i,j,:) = deltaU2(:) if (CS%id_BulkRi > 0) CS%BulkRi(i,j,:) = BulkRi_1d(:) @@ -942,7 +943,7 @@ subroutine KPP_get_BLD(CS, BLD, G) type(KPP_CS), pointer :: CS !< Control structure for !! this module type(ocean_grid_type), intent(in) :: G !< Grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: BLD!< bnd. layer depth (m) + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: BLD!< bnd. layer depth (m) ! Local variables integer :: i,j do j = G%jsc, G%jec ; do i = G%isc, G%iec From 8a4a5edd39d568e8286a1c1dbf92e72c79fa37a6 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Fri, 13 Apr 2018 11:44:24 -0600 Subject: [PATCH 0071/1072] distinguish profiles and cvmix schemes --- .../vertical/MOM_tidal_mixing.F90 | 106 +++++++++--------- 1 file changed, 56 insertions(+), 50 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index a59af01afb..c6d522fa93 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -34,6 +34,7 @@ module MOM_tidal_mixing !> Containers for tidal mixing diagnostics type, public :: tidal_mixing_diags + ! TODO: private real, pointer, dimension(:,:,:) :: & Kd_itidal => NULL(),& ! internal tide diffusivity at interfaces (m2/s) Fl_itidal => NULL(),& ! vertical flux of tidal turbulent dissipation (m3/s3) @@ -61,6 +62,7 @@ module MOM_tidal_mixing !> Control structure for tidal mixing module. type, public :: tidal_mixing_cs logical :: debug = .true. + ! TODO: private ! Parameters logical :: int_tide_dissipation ! Internal tide conversion (from barotropic) with @@ -128,9 +130,10 @@ module MOM_tidal_mixing real :: min_thickness ! Minimum thickness allowed [m] ! CVMix-specific parameters + integer :: cvmix_tidal_scheme = -1 ! 1 for Simmons, 2 for Schmittner type(cvmix_tidal_params_type) :: cvmix_tidal_params - type(cvmix_global_params_type) :: cvmix_glb_params ! for Prandtl number only - real :: tidal_max_coef ! maximum allowable tidal diffusivity. [m^2/s] + type(cvmix_global_params_type) :: cvmix_glb_params ! for Prandtl number only + real :: tidal_max_coef ! maximum allowable tidal diffusivity. [m^2/s] ! Data containers real, pointer, dimension(:,:) :: TKE_Niku => NULL() @@ -139,7 +142,7 @@ module MOM_tidal_mixing real, pointer, dimension(:,:) :: mask_itidal => NULL() real, pointer, dimension(:,:) :: h2 => NULL() real, pointer, dimension(:,:) :: tideamp => NULL() ! RMS tidal amplitude (m/s) - real, allocatable,dimension(:,:) :: tidal_qe_2d ! q*E(x,y) + real, allocatable,dimension(:,:) :: tidal_qe_2d ! q*E(x,y) ! TODO: make this E(x,y) only ! Diagnostics type(diag_ctrl), pointer :: diag => NULL() ! structure to regulate diagn output timing @@ -174,12 +177,12 @@ module MOM_tidal_mixing character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name. character*(20), parameter :: STLAURENT_PROFILE_STRING = "STLAURENT_02" character*(20), parameter :: POLZIN_PROFILE_STRING = "POLZIN_09" -character*(20), parameter :: SIMMONS_PROFILE_STRING = "SIMMONS" -character*(20), parameter :: SCHMITTNER_PROFILE_STRING = "SCHMITTNER" integer, parameter :: STLAURENT_02 = 1 integer, parameter :: POLZIN_09 = 2 -integer, parameter :: SIMMONS_04 = 3 -integer, parameter :: SCHMITTNER = 4 +character*(20), parameter :: SIMMONS_SCHEME_STRING = "SIMMONS" +character*(20), parameter :: SCHMITTNER_SCHEME_STRING = "SCHMITTNER" +integer, parameter :: SIMMONS_04 = 1 +integer, parameter :: SCHMITTNER = 2 contains @@ -197,7 +200,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, ! Local variables logical :: read_tideamp character(len=20) :: tmpstr, int_tide_profile_str - character(len=20) :: default_profile_string, tidal_energy_type + character(len=20) :: cvmix_tidal_scheme_str, tidal_energy_type character(len=200) :: filename, h2_file, Niku_TKE_input_file character(len=200) :: tidal_energy_file, tideamp_file type(vardesc) :: vd @@ -239,40 +242,47 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, "drive diapycnal mixing, along the lines of St. Laurent \n"//& "et al. (2002) and Simmons et al. (2004).", default=CS%use_cvmix_tidal) if (CS%int_tide_dissipation) then - default_profile_string = STLAURENT_PROFILE_STRING - if (CS%use_cvmix_tidal) default_profile_string = SIMMONS_PROFILE_STRING - call get_param(param_file, mdl, "INT_TIDE_PROFILE", int_tide_profile_str, & - "INT_TIDE_PROFILE selects the vertical profile of energy \n"//& - "dissipation with INT_TIDE_DISSIPATION. Valid values are:\n"//& - "\t STLAURENT_02 - Use the St. Laurent et al exponential \n"//& - "\t decay profile.\n"//& - "\t POLZIN_09 - Use the Polzin WKB-streched algebraic \n"//& - "\t decay profile.", & - default=default_profile_string) - ! TODO: list the newly available profile selections - int_tide_profile_str = uppercase(int_tide_profile_str) - select case (int_tide_profile_str) - case (STLAURENT_PROFILE_STRING) ; CS%int_tide_profile = STLAURENT_02 - case (POLZIN_PROFILE_STRING) ; CS%int_tide_profile = POLZIN_09 - case (SIMMONS_PROFILE_STRING) ; CS%int_tide_profile = SIMMONS_04 - case (SCHMITTNER_PROFILE_STRING) ; CS%int_tide_profile = SCHMITTNER - case default - call MOM_error(FATAL, "tidal_mixing_init: Unrecognized setting "// & - "#define INT_TIDE_PROFILE "//trim(int_tide_profile_str)//" found in input file.") - end select - ! Check profile consistency - if (CS%use_cvmix_tidal .and. (CS%int_tide_profile.eq.STLAURENT_02 .or. & - CS%int_tide_profile.eq.POLZIN_09)) then - call MOM_error(FATAL, "tidal_mixing_init: Tidal mixing profile"// & - " "//trim(int_tide_profile_str)//" unavailable in CVMix. Available "//& - "profiles in CVMix are "//trim(SIMMONS_PROFILE_STRING)//" and "//& - trim(SCHMITTNER_PROFILE_STRING)//".") - else if (.not.CS%use_cvmix_tidal .and. (CS%int_tide_profile.eq.SIMMONS_04.or. & - CS%int_tide_profile.eq.SCHMITTNER)) then - call MOM_error(FATAL, "tidal_mixing_init: Tidal mixing profiles "// & - trim(SIMMONS_PROFILE_STRING)//" and "//trim(SCHMITTNER_PROFILE_STRING)//& - " are available only when USE_CVMIX_TIDAL is True.") + ! Read in CVMix tidal scheme if CVMix tidal mixing is on + if (CS%use_cvmix_tidal) then + call get_param(param_file, mdl, "CVMIX_TIDAL_SCHEME", cvmix_tidal_scheme_str, & + "CVMIX_TIDAL_SCHEME selects the CVMix tidal mixing\n"//& + "scheme with INT_TIDE_DISSIPATION. Valid values are:\n"//& + "\t SIMMONS - Use the Simmons et al (2004) tidal \n"//& + "\t mixing scheme.\n"//& + "\t SCHMITTNER - Use the Schmittner et al (2014) tidal \n"//& + "\t mixing scheme.", & + default=SIMMONS_SCHEME_STRING) + cvmix_tidal_scheme_str = uppercase(cvmix_tidal_scheme_str) + + select case (cvmix_tidal_scheme_str) + case (SIMMONS_SCHEME_STRING) ; CS%cvmix_tidal_scheme = SIMMONS_04 + case (SCHMITTNER_SCHEME_STRING) ; CS%cvmix_tidal_scheme = SCHMITTNER + case default + call MOM_error(FATAL, "tidal_mixing_init: Unrecognized setting "// & + "#define CVMIX_TIDAL_SCHEME "//trim(cvmix_tidal_scheme_str)//" found in input file.") + end select + endif ! CS%use_cvmix_tidal + + ! Read in vertical profile of tidal energy dissipation + if ( CS%cvmix_tidal_scheme.eq.SCHMITTNER .or. .not. CS%use_cvmix_tidal) then + call get_param(param_file, mdl, "INT_TIDE_PROFILE", int_tide_profile_str, & + "INT_TIDE_PROFILE selects the vertical profile of energy \n"//& + "dissipation with INT_TIDE_DISSIPATION. Valid values are:\n"//& + "\t STLAURENT_02 - Use the St. Laurent et al exponential \n"//& + "\t decay profile.\n"//& + "\t POLZIN_09 - Use the Polzin WKB-streched algebraic \n"//& + "\t decay profile.", & + default=STLAURENT_PROFILE_STRING) + int_tide_profile_str = uppercase(int_tide_profile_str) + + select case (int_tide_profile_str) + case (STLAURENT_PROFILE_STRING) ; CS%int_tide_profile = STLAURENT_02 + case (POLZIN_PROFILE_STRING) ; CS%int_tide_profile = POLZIN_09 + case default + call MOM_error(FATAL, "tidal_mixing_init: Unrecognized setting "// & + "#define INT_TIDE_PROFILE "//trim(int_tide_profile_str)//" found in input file.") + end select endif else if (CS%use_cvmix_tidal) then @@ -317,10 +327,6 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, if ((CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09)) .or. & (CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09))) then - if (CS%use_cvmix_tidal) then - call MOM_error(FATAL, "tidal_mixing_init: Polzin scheme cannot "// & - "be used when CVMix tidal mixing scheme is active.") - end if call get_param(param_file, mdl, "NU_POLZIN", CS%Nu_Polzin, & "When the Polzin decay profile is used, this is a \n"//& "non-dimensional constant in the expression for the \n"//& @@ -489,14 +495,14 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, do_not_log=.true.) call cvmix_put(CS%cvmix_glb_params,'Prandtl',prandtl_tidal) - int_tide_profile_str = lowercase(int_tide_profile_str) + cvmix_tidal_scheme_str = lowercase(cvmix_tidal_scheme_str) ! TODO: check parameter consistency. (see POP::tidal_mixing.F90::tidal_check) ! Set up CVMix call cvmix_init_tidal(CVmix_tidal_params_user = CS%cvmix_tidal_params, & - mix_scheme = int_tide_profile_str, & + mix_scheme = cvmix_tidal_scheme_str, & efficiency = CS%Mu_itides, & vertical_decay_scale = CS%int_tide_decay_scale, & max_coefficient = CS%tidal_max_coef, & @@ -646,7 +652,7 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) is = G%isc ; ie = G%iec dd => CS%dd - select case (CS%int_tide_profile) + select case (CS%cvmix_tidal_scheme) case (SIMMONS_04) do i=is,ie @@ -713,8 +719,8 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) ! TODO: case (SCHMITTNER) case default - call MOM_error(FATAL, "tidal_mixing_init: The selected"// & - " INT_TIDE_PROFILE is unavailable in CVMix") + call MOM_error(FATAL, "tidal_mixing_init: Unrecognized setting "// & + "#define CVMIX_TIDAL_SCHEME found in input file.") end select end subroutine calculate_cvmix_tidal From 93d7a07bccfa43b82532d01921fb79dbd0286100 Mon Sep 17 00:00:00 2001 From: mvertens Date: Fri, 13 Apr 2018 13:16:24 -0600 Subject: [PATCH 0072/1072] changes to mom cap to be compatible with nuopcB_180413 --- .../nuopc_driver/{ => backup}/mom_cap.F90.00 | 0 .../nuopc_driver/{ => backup}/mom_cap.F90.02 | 0 .../{ => backup}/ocn_comp_nuopc.F90.02 | 0 config_src/nuopc_driver/mom_cap.F90 | 127 +++++++++--------- config_src/nuopc_driver/ocn_comp_nuopc.F90.01 | 0 5 files changed, 60 insertions(+), 67 deletions(-) rename config_src/nuopc_driver/{ => backup}/mom_cap.F90.00 (100%) rename config_src/nuopc_driver/{ => backup}/mom_cap.F90.02 (100%) rename config_src/nuopc_driver/{ => backup}/ocn_comp_nuopc.F90.02 (100%) delete mode 100644 config_src/nuopc_driver/ocn_comp_nuopc.F90.01 diff --git a/config_src/nuopc_driver/mom_cap.F90.00 b/config_src/nuopc_driver/backup/mom_cap.F90.00 similarity index 100% rename from config_src/nuopc_driver/mom_cap.F90.00 rename to config_src/nuopc_driver/backup/mom_cap.F90.00 diff --git a/config_src/nuopc_driver/mom_cap.F90.02 b/config_src/nuopc_driver/backup/mom_cap.F90.02 similarity index 100% rename from config_src/nuopc_driver/mom_cap.F90.02 rename to config_src/nuopc_driver/backup/mom_cap.F90.02 diff --git a/config_src/nuopc_driver/ocn_comp_nuopc.F90.02 b/config_src/nuopc_driver/backup/ocn_comp_nuopc.F90.02 similarity index 100% rename from config_src/nuopc_driver/ocn_comp_nuopc.F90.02 rename to config_src/nuopc_driver/backup/ocn_comp_nuopc.F90.02 diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 19c397f72f..dec075d96f 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -401,12 +401,15 @@ module mom_cap_mod #endif #ifdef CESMCOUPLED use mom_cap_methods, only: ocn_export, ocn_import - use shr_nuopc_flds_mod, only: flds_scalar_name - use shr_nuopc_flds_mod, only: flds_x2o, flds_o2x, flds_x2o_map, flds_o2x_map - use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_SetScalarField, shr_nuopc_fldList_type - use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Advertise, shr_nuopc_fldList_Realize - use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Zero, shr_nuopc_fldList_Add - use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_fromflds + use esmFlds, only: flds_scalar_name, flds_scalar_num + use esmFlds, only: fldListFr, fldListTo, compocn, compname + use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Realize + use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Concat + use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Getnumflds + use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Getfldinfo + use shr_nuopc_methods_mod, only: shr_nuopc_methods_State_SetScalar + use shr_nuopc_methods_mod, only: shr_nuopc_methods_State_GetScalar + use shr_nuopc_methods_mod, only: shr_nuopc_methods_State_Diagnose #endif use ESMF @@ -434,8 +437,8 @@ module mom_cap_mod end type #ifdef CESMCOUPLED - type (shr_nuopc_fldList_Type) :: fldsToOcn - type (shr_nuopc_fldList_Type) :: fldsFrOcn + character(len=4096) :: flds_o2x = '' + character(len=4096) :: flds_x2o = '' #else type fld_list_type character(len=64) :: stdname @@ -465,7 +468,8 @@ module mom_cap_mod integer(ESMF_KIND_I8) :: restart_interval logical :: sw_decomp real(ESMF_KIND_R8) :: c1, c2, c3, c4 - character(len=*),parameter :: u_file_u = __FILE__ + character(len=*),parameter :: u_file_u = & + __FILE__ contains !----------------------------------------------------------------------- @@ -680,6 +684,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) type(directories) :: dirs_tmp !< A structure containing several relevant directory paths character(len=384) :: pointer_filename integer :: npet, npet_x, npet_y + integer :: n,nflds + logical :: activefld + character(80) :: stdname, shortname character(len=*),parameter :: subname='(mom_cap:InitializeAdvertise)' rc = ESMF_SUCCESS @@ -755,20 +762,41 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out - call MOM_FieldsSetup(ice_ocean_boundary, ocean_public) - #ifdef CESMCOUPLED - call shr_nuopc_fldList_Advertise(importState, fldsToOcn, subname//':MOM6Import', rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + ! WARNING tcx tcraig + ! tcraig this is just a starting point, the fields are not complete or correct here + + ! create import and export field list needed by data models + call shr_nuopc_fldList_Concat(fldListFr(compocn), fldListTo(compocn), flds_o2x, flds_x2o, flds_scalar_name) + + ! advertise import and export fields + nflds = shr_nuopc_fldList_Getnumflds(fldListFr(compocn)) + do n = 1,nflds + call shr_nuopc_fldList_Getfldinfo(fldListFr(compocn), n, activefld, stdname, shortname) + if (activefld) then + call NUOPC_Advertise(exportState, standardName=stdname, shortname=shortname, name=shortname, & + TransferOfferGeomObject='will provide', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if + call ESMF_LogWrite(subname//':Fr_'//trim(compname(compocn))//': '//trim(shortname), ESMF_LOGMSG_INFO) + end do - call shr_nuopc_fldList_Advertise(exportState, fldsFrOcn, subname//':MOM6Export', rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + nflds = shr_nuopc_fldList_Getnumflds(fldListTo(compocn)) + do n = 1,nflds + call shr_nuopc_fldList_Getfldinfo(fldListTo(compocn), n, activefld, stdname, shortname) + if (activefld) then + call NUOPC_Advertise(importState, standardName=stdname, shortname=shortname, name=shortname, & + TransferOfferGeomObject='will provide', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_file_u)) return + end if + call ESMF_LogWrite(subname//':To_'//trim(compname(compocn))//': '//trim(shortname), ESMF_LOGMSG_INFO) + end do #else + call MOM_FieldsSetup(ice_ocean_boundary, ocean_public) + call MOM_AdvertiseFields(importState, fldsToOcn_num, fldsToOcn, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_file_u)) return ! bail out + call MOM_AdvertiseFields(exportState, fldsFrOcn_num, fldsFrOcn, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1275,11 +1303,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !--------------------------------- #ifdef CESMCOUPLED - call shr_nuopc_fldList_Realize(importState, grid=gridIn, fldlist=fldsToOcn, tag=subname//':MOM6Import', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call shr_nuopc_fldList_Realize(importState, fldListTo(compocn), flds_scalar_name, flds_scalar_num, & + grid=gridIn, tag=subname//':MOM6Import', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call shr_nuopc_fldList_Realize(exportState, grid=gridOut, fldlist=fldsFrOcn, tag=subname//':MOM6Export', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call shr_nuopc_fldList_Realize(exportState, fldListFr(compocn), flds_scalar_name, flds_scalar_num, & + grid=gridOut, tag=subname//':MOM6Export', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return #else call MOM_RealizeFields(importState, gridIn , fldsToOcn_num, fldsToOcn, "Ocn import", rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -2205,7 +2235,7 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) enddo end subroutine MOM_RealizeFields -#endif + !----------------------------------------------------------------------------- subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_public) @@ -2215,46 +2245,11 @@ subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_public) integer :: rc character(len=*),parameter :: subname='(mom_cap:MOM_FieldsSetup)' - !!! fld_list_add(num, fldlist, stdname, transferOffer, data(optional), shortname(optional)) - -#ifdef CESMCOUPLED - -! WARNING tcx tcraig -! tcraig this is just a starting point, the fields are not complete or correct here + ! fld_list_add(num, fldlist, stdname, transferOffer, data(optional), shortname(optional)) - !-------------------------------- - ! create import fields list - !-------------------------------- - - call shr_nuopc_fldList_Zero(fldsToOcn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - call shr_nuopc_fldList_fromflds(fldsToOcn, flds_x2o, flds_x2o_map, "will provide", subname//":flds_x2o", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - call shr_nuopc_fldList_Add(fldsToOcn, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - ! convert to fldsToOcn - - !-------------------------------- - ! create export fields list - !-------------------------------- - - call shr_nuopc_fldList_Zero(fldsFrOcn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - call shr_nuopc_fldList_fromflds(fldsFrOcn, flds_o2x, flds_o2x_map, "will provide", subname//":flds_o2x", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - call shr_nuopc_fldList_Add(fldsFrOcn, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - -#else -!--------- import fields ------------- - -! tcraig, don't point directly into mom data YET (last field is optional in interface) -! instead, create space for the field when it's "realized". + !--------- import fields ------------- + ! tcraig, don't point directly into mom data YET (last field is optional in interface) + ! instead, create space for the field when it's "realized". call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx", "will provide", data=Ice_ocean_boundary%u_flux) call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx", "will provide", data=Ice_ocean_boundary%v_flux) call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide", data=Ice_ocean_boundary%t_flux) @@ -2274,7 +2269,7 @@ subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_public) call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide", data=Ice_ocean_boundary%p ) call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice", "will provide", data=Ice_ocean_boundary%mi) -!--------- export fields ------------- + !--------- export fields ------------- call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask", "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature", "will provide", data=ocean_public%t_surf) @@ -2286,12 +2281,10 @@ subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_public) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=ocean_public%sea_lev) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=ocean_public%frazil) -#endif - end subroutine MOM_FieldsSetup !----------------------------------------------------------------------------- -#ifndef CESMCOUPLED + subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) ! ---------------------------------------------- ! Set up a list of field information diff --git a/config_src/nuopc_driver/ocn_comp_nuopc.F90.01 b/config_src/nuopc_driver/ocn_comp_nuopc.F90.01 deleted file mode 100644 index e69de29bb2..0000000000 From 60f7d665a6952225a074a58347ad9e7c2700742f Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 13 Apr 2018 14:32:56 -0600 Subject: [PATCH 0073/1072] Initialize visc%Kv_slow and update halos --- src/core/MOM.F90 | 3 +++ src/parameterizations/vertical/MOM_set_viscosity.F90 | 4 +++- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 22dbb86b15..cfbb0c101f 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2292,6 +2292,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (associated(CS%visc%Kv_shear)) & call pass_var(CS%visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) + if (associated(CS%visc%Kv_slow)) & + call pass_var(CS%visc%Kv_slow, G%Domain, To_All+Omit_Corners, halo=1) + call cpu_clock_end(id_clock_pass_init) call register_obsolete_diagnostics(param_file, CS%diag) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 3df3e7b780..18eb80f280 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1811,7 +1811,9 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) allocate(visc%Kd_shear(isd:ied,jsd:jed,nz+1)) ; visc%Kd_shear(:,:,:) = 0.0 allocate(visc%TKE_turb(isd:ied,jsd:jed,nz+1)) ; visc%TKE_turb(:,:,:) = 0.0 allocate(visc%Kv_shear(isd:ied,jsd:jed,nz+1)) ; visc%Kv_shear(:,:,:) = 0.0 - allocate(visc%Kv_slow(isd:ied,jsd:jed,nz+1)) ; visc%Kv_slow(:,:,:) = 0.0 + + ! MOM_bkgnd_mixing is always used, so always allocate visc%Kv_slow. GMM + allocate(visc%Kv_slow(isd:ied,jsd:jed,nz+1)) ; visc%Kv_slow(:,:,:) = 0.0 vd = var_desc("Kd_shear","m2 s-1","Shear-driven turbulent diffusivity at interfaces", & hor_grid='h', z_grid='i') From fcf0542fbb6adc7bb1ccf072dc4089dd597d8eda Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Fri, 13 Apr 2018 15:49:07 -0800 Subject: [PATCH 0074/1072] Baby steps on getting tangential velocity OBCs. - Doesn't do anything yet. --- src/core/MOM_open_boundary.F90 | 29 +++++++++++++++++++++++++---- 1 file changed, 25 insertions(+), 4 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 58d52bbbe5..369febbb2b 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -145,6 +145,8 @@ module MOM_open_boundary !! for normal velocity real, pointer, dimension(:,:,:) :: nudged_normal_vel=>NULL() !< The layer velocity normal to the OB segment !! that values should be nudged towards (m s-1). + real, pointer, dimension(:,:,:) :: nudged_tangential_vel=>NULL() !< The layer velocity tangential to the OB segment + !! that values should be nudged towards (m s-1). type(segment_tracer_registry_type), pointer :: tr_Reg=> NULL()!< A pointer to the tracer registry for the segment. type(hor_index_type) :: HI !< Horizontal index ranges real :: Tr_InvLscale3_out !< An effective inverse length scale cubed (m-3) @@ -581,9 +583,17 @@ subroutine initialize_segment_data(G, OBC, PF) siz2(3)=siz(3) if (segment%is_E_or_W) then - allocate(segment%field(m)%buffer_src(IsdB:IedB,jsd:jed,siz2(3))) + if (segment%field(m)%name == 'V') then + allocate(segment%field(m)%buffer_src(IsdB:IedB,JsdB:JedB,siz2(3))) + else + allocate(segment%field(m)%buffer_src(IsdB:IedB,jsd:jed,siz2(3))) + endif else - allocate(segment%field(m)%buffer_src(isd:ied,JsdB:JedB,siz2(3))) + if (segment%field(m)%name == 'V') then + allocate(segment%field(m)%buffer_src(IsdB:IedB,JsdB:JedB,siz2(3))) + else + allocate(segment%field(m)%buffer_src(isd:ied,JsdB:JedB,siz2(3))) + endif endif segment%field(m)%buffer_src(:,:,:)=0.0 segment%field(m)%fid = init_external_field(trim(filename),& @@ -592,9 +602,17 @@ subroutine initialize_segment_data(G, OBC, PF) fieldname = 'dz_'//trim(fieldname) call field_size(filename,fieldname,siz,no_domain=.true.) if (segment%is_E_or_W) then - allocate(segment%field(m)%dz_src(IsdB:IedB,jsd:jed,siz(3))) + if (segment%field(m)%name == 'V') then + allocate(segment%field(m)%dz_src(IsdB:IedB,JsdB:JedB,siz(3))) + else + allocate(segment%field(m)%dz_src(IsdB:IedB,jsd:jed,siz(3))) + endif else - allocate(segment%field(m)%dz_src(isd:ied,JsdB:JedB,siz(3))) + if (segment%field(m)%name == 'V') then + allocate(segment%field(m)%dz_src(IsdB:IedB,JsdB:JedB,siz(3))) + else + allocate(segment%field(m)%dz_src(isd:ied,JsdB:JedB,siz(3))) + endif endif segment%field(m)%dz_src(:,:,:)=0.0 segment%field(m)%nk_src=siz(3) @@ -1892,6 +1910,7 @@ subroutine allocate_OBC_segment_data(OBC, segment) allocate(segment%normal_trans(IsdB:IedB,jsd:jed,OBC%ke)); segment%normal_trans(:,:,:)=0.0 if (segment%nudged) then allocate(segment%nudged_normal_vel(IsdB:IedB,jsd:jed,OBC%ke)); segment%nudged_normal_vel(:,:,:)=0.0 + allocate(segment%nudged_tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_vel(:,:,:)=0.0 endif if (segment%oblique) then allocate(segment%grad_normal(JsdB:JedB,2,OBC%ke)); segment%grad_normal(:,:,:) = 0.0 @@ -1913,6 +1932,7 @@ subroutine allocate_OBC_segment_data(OBC, segment) allocate(segment%normal_trans(isd:ied,JsdB:JedB,OBC%ke)); segment%normal_trans(:,:,:)=0.0 if (segment%nudged) then allocate(segment%nudged_normal_vel(isd:ied,JsdB:JedB,OBC%ke)); segment%nudged_normal_vel(:,:,:)=0.0 + allocate(segment%nudged_tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_vel(:,:,:)=0.0 endif if (segment%oblique) then allocate(segment%grad_normal(IsdB:IedB,2,OBC%ke)); segment%grad_normal(:,:,:) = 0.0 @@ -1940,6 +1960,7 @@ subroutine deallocate_OBC_segment_data(OBC, segment) if (associated (segment%normal_vel_bt)) deallocate(segment%normal_vel_bt) if (associated (segment%normal_trans)) deallocate(segment%normal_trans) if (associated (segment%nudged_normal_vel)) deallocate(segment%nudged_normal_vel) + if (associated (segment%nudged_tangential_vel)) deallocate(segment%nudged_tangential_vel) if (associated (segment%tr_Reg)) call segment_tracer_registry_end(segment%tr_Reg) From d774e5f05ce348ae388c10304757df6150d76314 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 16 Apr 2018 09:10:19 -0600 Subject: [PATCH 0075/1072] Add "slow" vertical viscosity in vertvisc_coef --- .../vertical/MOM_vert_friction.F90 | 37 +++++++++++++++++++ 1 file changed, 37 insertions(+) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index ff14a698ed..5154e92c33 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1134,6 +1134,43 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif endif + ! add "slow" varying vertical viscosity (e.g., from background, tidal etc) + if (associated(visc%Kv_slow)) then + if (work_on_u) then + do K=2,nz ; do i=is,ie ; if (do_i(i)) then + Kv_add(i,K) = Kv_add(i,K) + 0.5 * (visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k)) + endif ; enddo ; enddo + if (do_OBCs) then + do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then + if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + visc%Kv_slow(i,j,k) ; enddo + elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + visc%Kv_slow(i+1,j,k) ; enddo + endif + endif ; enddo + endif + do K=2,nz ; do i=is,ie ; if (do_i(i)) then + a(i,K) = a(i,K) + Kv_add(i,K) + endif ; enddo ; enddo + else + do K=2,nz ; do i=is,ie ; if (do_i(i)) then + Kv_add(i,K) = Kv_add(i,K) + 0.5*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j+1,k)) + endif ; enddo ; enddo + if (do_OBCs) then + do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then + if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + visc%Kv_slow(i,j,k) ; enddo + elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + visc%Kv_slow(i,j+1,k) ; enddo + endif + endif ; enddo + endif + do K=2,nz ; do i=is,ie ; if (do_i(i)) then + a(i,K) = a(i,K) + Kv_add(i,K) + endif ; enddo ; enddo + endif + endif + do K=nz,2,-1 ; do i=is,ie ; if (do_i(i)) then ! botfn determines when a point is within the influence of the bottom ! boundary layer, going from 1 at the bottom to 0 in the interior. From fd23f9117335d0542312f932e2fc241fbab25058 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 16 Apr 2018 11:28:19 -0600 Subject: [PATCH 0076/1072] Set visc%Kv_slow to zero in diabatic --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 70412a716b..8e45d26688 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -378,6 +378,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect*h_neglect Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 + ! visc%Kv_slow must be set to zero + visc%Kv_slow(:,:,:) = 0.0 if (nz == 1) return showCallTree = callTree_showQuery() From 1488b78945b2789b79bb6c7d0589e08674f897bd Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 16 Apr 2018 11:29:00 -0600 Subject: [PATCH 0077/1072] Add option to save Kv_slow and Kv --- .../vertical/MOM_vert_friction.F90 | 46 ++++++++++++++++++- 1 file changed, 45 insertions(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 5154e92c33..e391780253 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -2,7 +2,7 @@ module MOM_vert_friction ! This file is part of MOM6. See LICENSE.md for the license. - +use MOM_domains, only : pass_var use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl use MOM_debugging, only : uvchksum, hchksum @@ -116,6 +116,7 @@ module MOM_vert_friction integer :: id_du_dt_visc = -1, id_dv_dt_visc = -1, id_au_vv = -1, id_av_vv = -1 integer :: id_h_u = -1, id_h_v = -1, id_hML_u = -1 , id_hML_v = -1 integer :: id_Ray_u = -1, id_Ray_v = -1, id_taux_bot = -1, id_tauy_bot = -1 + integer :: id_Kv_slow = -1, id_Kv = -1 !>@} type(PointAccel_CS), pointer :: PointAccel_CSp => NULL() @@ -583,6 +584,10 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! based on harmonic mean thicknesses, in m or kg m-2. h_ml ! The mixed layer depth, in m or kg m-2. real, allocatable, dimension(:,:) :: hML_u, hML_v + real, allocatable, dimension(:,:,:) :: Kv_h !< Total vertical viscosity at h-points + real :: av_h !< v-drag coefficient at h-points, in m s-1 + real :: au_h !< u-drag coefficient at h-points, in m s-1 + real :: dh !< average thickness between layers k and k+1, in m or kg m-2. real :: zcol(SZI_(G)) ! The height of an interface at h-points, in m or kg m-2. real :: botfn ! A function which goes from 1 at the bottom to 0 much more ! than Hbbl into the interior. @@ -615,6 +620,10 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) I_Hbbl(:) = 1.0 / (CS%Hbbl * GV%m_to_H + h_neglect) I_valBL = 0.0 ; if (CS%harm_BL_val > 0.0) I_valBL = 1.0 / CS%harm_BL_val + if (CS%id_Kv > 0) then + allocate(Kv_h(SZI_(G), SZJ_(G), SZK_(G)+1)) ; Kv_h(:,:,:) = 0.0 + endif + if (CS%debug .or. (CS%id_hML_u > 0)) then allocate(hML_u(G%IsdB:G%IedB,G%jsd:G%jed)) ; hML_u(:,:) = 0.0 endif @@ -955,6 +964,29 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) endif enddo ! end of v-point j loop + ! Total Kv at h points + if (CS%id_Kv > 0) then + do j = js, je + do i = is, ie + ! set surface and bottom values to zero + Kv_h(i,j,1) = 0.0; Kv_h(i,j,nz+1) = 0.0 + do k=2,nz + av_h = 0.5 * (CS%a_v(i,J,k) + CS%a_v(i,J+1,k)) + au_h = 0.5 * (CS%a_u(I,J,k) + CS%a_u(I+1,j,k)) + dh = 0.5 * (h(i,j,K)+h(i,j,K+1)) + if (dh .le. h_neglect) then + Kv_h(i,j,k) = 0.0 + else + Kv_h(i,j,k) = sqrt(av_h**2 + au_h**2) * dh + if (Kv_h(i,j,k) .lt. 0.0) Kv_h(i,j,k) = 0.0 + endif + enddo + enddo + enddo + ! update halos + call pass_var(Kv_h, G%Domain) + endif + if (CS%debug) then call uvchksum("vertvisc_coef h_[uv]", CS%h_u, & CS%h_v, G%HI,haloshift=0, scale=GV%H_to_m) @@ -966,6 +998,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) endif ! Offer diagnostic fields for averaging. + if (CS%id_Kv_slow > 0) call post_data(CS%id_Kv_slow, visc%Kv_slow, CS%diag) + if (CS%id_Kv > 0) call post_data(CS%id_Kv, Kv_h, CS%diag) if (CS%id_au_vv > 0) call post_data(CS%id_au_vv, CS%a_u, CS%diag) if (CS%id_av_vv > 0) call post_data(CS%id_av_vv, CS%a_v, CS%diag) if (CS%id_h_u > 0) call post_data(CS%id_h_u, CS%h_u, CS%diag) @@ -1660,17 +1694,27 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & ALLOC_(CS%a_v(isd:ied,JsdB:JedB,nz+1)) ; CS%a_v(:,:,:) = 0.0 ALLOC_(CS%h_v(isd:ied,JsdB:JedB,nz)) ; CS%h_v(:,:,:) = 0.0 + CS%id_Kv_slow = register_diag_field('ocean_model', 'Kv_slow', diag%axesTi, Time, & + 'Slow varying vertical viscosity', 'm2 s-1') + + CS%id_Kv = register_diag_field('ocean_model', 'Kv', diag%axesTi, Time, & + 'Total vertical viscosity', 'm2 s-1') + CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, & 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1') + CS%id_av_vv = register_diag_field('ocean_model', 'av_visc', diag%axesCvi, Time, & 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1') CS%id_h_u = register_diag_field('ocean_model', 'Hu_visc', diag%axesCuL, Time, & 'Thickness at Zonal Velocity Points for Viscosity', thickness_units) + CS%id_h_v = register_diag_field('ocean_model', 'Hv_visc', diag%axesCvL, Time, & 'Thickness at Meridional Velocity Points for Viscosity', thickness_units) + CS%id_hML_u = register_diag_field('ocean_model', 'HMLu_visc', diag%axesCu1, Time, & 'Mixed Layer Thickness at Zonal Velocity Points for Viscosity', thickness_units) + CS%id_hML_v = register_diag_field('ocean_model', 'HMLv_visc', diag%axesCv1, Time, & 'Mixed Layer Thickness at Meridional Velocity Points for Viscosity', thickness_units) From 69c2c96f9812d74d43c8da2421c88e3c5eb9d05f Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 16 Apr 2018 11:34:39 -0600 Subject: [PATCH 0078/1072] Remove trailing space --- src/parameterizations/vertical/MOM_tidal_mixing.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index a59af01afb..2b3ffb00df 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -1127,7 +1127,7 @@ subroutine setup_tidal_diagnostics(G,CS) integer :: isd, ied, jsd, jed, nz type(tidal_mixing_diags), pointer :: dd - isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed; nz = G%ke + isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed; nz = G%ke dd => CS%dd if ((CS%id_Kd_itidal > 0) .or. (CS%id_Kd_itidal_z > 0) .or. & From d5be1f8c9b0ba118ab9a5e41c8e4fd88148c0cce Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 16 Apr 2018 13:15:56 -0600 Subject: [PATCH 0079/1072] Attempt to add diag. for total vertical visc. * I believe there is something wrong (halo updates?) with the way this is being done. It needs to be fixed! --- .../vertical/MOM_vert_friction.F90 | 48 ++++++++++--------- 1 file changed, 26 insertions(+), 22 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index e391780253..d90748b820 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -2,7 +2,7 @@ module MOM_vert_friction ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_domains, only : pass_var +use MOM_domains, only : pass_var, To_All, Omit_corners use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl use MOM_debugging, only : uvchksum, hchksum @@ -585,8 +585,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) h_ml ! The mixed layer depth, in m or kg m-2. real, allocatable, dimension(:,:) :: hML_u, hML_v real, allocatable, dimension(:,:,:) :: Kv_h !< Total vertical viscosity at h-points - real :: av_h !< v-drag coefficient at h-points, in m s-1 - real :: au_h !< u-drag coefficient at h-points, in m s-1 + real, dimension(SZI_(G),SZJ_(G)) :: av_h, & !< v-drag coefficient at h-points, in m s-1 + au_h !< u-drag coefficient at h-points, in m s-1 real :: dh !< average thickness between layers k and k+1, in m or kg m-2. real :: zcol(SZI_(G)) ! The height of an interface at h-points, in m or kg m-2. real :: botfn ! A function which goes from 1 at the bottom to 0 much more @@ -966,25 +966,29 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! Total Kv at h points if (CS%id_Kv > 0) then - do j = js, je - do i = is, ie - ! set surface and bottom values to zero - Kv_h(i,j,1) = 0.0; Kv_h(i,j,nz+1) = 0.0 - do k=2,nz - av_h = 0.5 * (CS%a_v(i,J,k) + CS%a_v(i,J+1,k)) - au_h = 0.5 * (CS%a_u(I,J,k) + CS%a_u(I+1,j,k)) - dh = 0.5 * (h(i,j,K)+h(i,j,K+1)) - if (dh .le. h_neglect) then - Kv_h(i,j,k) = 0.0 - else - Kv_h(i,j,k) = sqrt(av_h**2 + au_h**2) * dh - if (Kv_h(i,j,k) .lt. 0.0) Kv_h(i,j,k) = 0.0 - endif - enddo - enddo - enddo - ! update halos - call pass_var(Kv_h, G%Domain) + !$OMP parallel do default(shared) + do k=2,nz + ! set surface and bottom values to zero + Kv_h(i,j,1) = 0.0; Kv_h(i,j,nz+1) = 0.0 + do j=js,je ; do I=is-1,ie + au_h(I,j) = CS%a_u(I,J,k) + enddo ; enddo + do J=js-1,je ; do i=is,ie + av_h(i,J) = CS%a_v(i,J,k) + enddo ; enddo + do j = js, je; do i = is, ie + dh = 0.5 * (h(i,j,K)+h(i,j,K+1)) + if (dh .le. h_neglect) then + Kv_h(i,j,k) = 0.0 + else + Kv_h(i,j,k) = sqrt((0.5 * (au_h(I,j)+au_h(I-1,j)))**2 + & + (0.5 * (av_h(i,J) + av_h(i,J-1)))**2) * dh + if (Kv_h(i,j,k) .lt. 0.0) Kv_h(i,j,k) = 0.0 + endif + enddo ; enddo + enddo ! k + ! update halos + call pass_var(Kv_h, G%Domain, To_All+Omit_Corners, halo=1) endif if (CS%debug) then From 82c9eec90b8714fc323f55a499fe809e2df62a66 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Mon, 16 Apr 2018 13:40:14 -0700 Subject: [PATCH 0080/1072] Replace bitcount.c with Fortran equivalent bitcount.c has been replaced by an equivalent function written in Fortran. The transfer intrinisic is used to store the memory layout of a given real number (x) in its equivalently-sized integer representation (y). The intrinsic BTEST is then used to count the number of bits set to 1. Note that the Fortran standard dictates that the loop bounds should go from 0, BIT_SIZE(y)-1 --- src/framework/MOM_checksums.F90 | 40 ++++++++++++++++++++++----------- src/framework/bitcount.c | 25 --------------------- 2 files changed, 27 insertions(+), 38 deletions(-) delete mode 100644 src/framework/bitcount.c diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index 237def4826..26ee96b399 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -188,13 +188,12 @@ subroutine chksum_h_2d(array, mesg, HI, haloshift, omit_corners, scale) endif contains - integer function subchk(array, HI, di, dj, scale) type(hor_index_type), intent(in) :: HI real, dimension(HI%isd:,HI%jsd:), intent(in) :: array integer, intent(in) :: di, dj real, intent(in) :: scale - integer :: bitcount, i, j, bc + integer :: i, j, bc subchk = 0 do j=HI%jsc+dj,HI%jec+dj; do i=HI%isc+di,HI%iec+di bc = bitcount(abs(scale*array(i,j))) @@ -378,7 +377,7 @@ integer function subchk(array, HI, di, dj, scale) real, dimension(HI%IsdB:,HI%JsdB:), intent(in) :: array integer, intent(in) :: di, dj real, intent(in) :: scale - integer :: bitcount, i, j, bc + integer :: i, j, bc subchk = 0 ! This line deliberately uses the h-point computational domain. do J=HI%jsc+dj,HI%jec+dj; do I=HI%isc+di,HI%iec+di @@ -562,7 +561,7 @@ integer function subchk(array, HI, di, dj, scale) real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: array integer, intent(in) :: di, dj real, intent(in) :: scale - integer :: bitcount, i, j, bc + integer :: i, j, bc subchk = 0 ! This line deliberately uses the h-point computational domain. do j=HI%jsc+dj,HI%jec+dj; do I=HI%isc+di,HI%iec+di @@ -705,7 +704,7 @@ integer function subchk(array, HI, di, dj, scale) real, dimension(HI%isd:,HI%JsdB:), intent(in) :: array integer, intent(in) :: di, dj real, intent(in) :: scale - integer :: bitcount, i, j, bc + integer :: i, j, bc subchk = 0 ! This line deliberately uses the h-point computational domain. do J=HI%jsc+dj,HI%jec+dj; do i=HI%isc+di,HI%iec+di @@ -831,7 +830,7 @@ integer function subchk(array, HI, di, dj, scale) real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: array integer, intent(in) :: di, dj real, intent(in) :: scale - integer :: bitcount, i, j, k, bc + integer :: i, j, k, bc subchk = 0 do k=LBOUND(array,3),UBOUND(array,3) ; do j=HI%jsc+dj,HI%jec+dj ; do i=HI%isc+di,HI%iec+di bc = bitcount(abs(scale*array(i,j,k))) @@ -971,7 +970,7 @@ integer function subchk(array, HI, di, dj, scale) real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array integer, intent(in) :: di, dj real, intent(in) :: scale - integer :: bitcount, i, j, k, bc + integer :: i, j, k, bc subchk = 0 ! This line deliberately uses the h-point computational domain. do k=LBOUND(array,3),UBOUND(array,3) ; do J=HI%jsc+dj,HI%jec+dj ; do I=HI%isc+di,HI%iec+di @@ -1114,7 +1113,7 @@ integer function subchk(array, HI, di, dj, scale) real, dimension(HI%IsdB:,HI%jsd:,:), intent(in) :: array integer, intent(in) :: di, dj real, intent(in) :: scale - integer :: bitcount, i, j, k, bc + integer :: i, j, k, bc subchk = 0 ! This line deliberately uses the h-point computational domain. do k=LBOUND(array,3),UBOUND(array,3) ; do j=HI%jsc+dj,HI%jec+dj ; do I=HI%isc+di,HI%iec+di @@ -1164,7 +1163,7 @@ integer function chksum_general_3d( array, scale_factor, istart, iend, jstart, j integer, optional :: jend !< Ending index in the j-direction integer, optional :: kstart !< Starting index in the k-direction integer, optional :: kend !< Ending index in the k-direction - integer :: bitcount, i, j, k, bc, is, ie, js, je, ks, ke + integer :: i, j, k, bc, is, ie, js, je, ks, ke real :: scale ! By default do not scale @@ -1329,7 +1328,7 @@ integer function subchk(array, HI, di, dj, scale) real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: array integer, intent(in) :: di, dj real, intent(in) :: scale - integer :: bitcount, i, j, k, bc + integer :: i, j, k, bc subchk = 0 ! This line deliberately uses the h-point computational domain. do k=LBOUND(array,3),UBOUND(array,3) ; do J=HI%jsc+dj,HI%jec+dj ; do i=HI%isc+di,HI%iec+di @@ -1384,7 +1383,6 @@ subroutine chksum1d(array, mesg, start_i, end_i, compare_PEs) !! and list the root_PE value (default true) integer :: is, ie, i, bc, sum1, sum_bc - integer :: bitcount real :: sum real, allocatable :: sum_here(:) logical :: compare @@ -1440,7 +1438,6 @@ subroutine chksum2d(array, mesg) real, dimension(:,:) :: array character(len=*) :: mesg - integer :: bitcount integer :: xs,xe,ys,ye,i,j,sum1,bc real :: sum @@ -1469,7 +1466,6 @@ subroutine chksum3d(array, mesg) real, dimension(:,:,:) :: array character(len=*) :: mesg - integer :: bitcount integer :: xs,xe,ys,ye,zs,ze,i,j,k, bc,sum1 real :: sum @@ -1661,6 +1657,24 @@ subroutine chksum_error(signal, message) call MOM_error(signal, message) end subroutine chksum_error +!> Does a bitcount of a number by first casting to an integer and then using BTEST +!! to check bit by bit +integer function bitcount( x ) + real :: x !< Number to be bitcount + + ! Local variables + integer(kind(x)) :: y !< Store the integer representation of the memory used by x + integer :: bit + + bitcount = 0 + y = transfer(x,y) + + ! Fortran standard says that bit indexing start at 0 + do bit = 0, bit_size(y)-1 + if (BTEST(y,bit)) bitcount = bitcount+1 + enddo + +end function bitcount ! ===================================================================== end module MOM_checksums diff --git a/src/framework/bitcount.c b/src/framework/bitcount.c deleted file mode 100644 index 58637b2f6c..0000000000 --- a/src/framework/bitcount.c +++ /dev/null @@ -1,25 +0,0 @@ -#include -#include -#include -#include -#include -/* bitcount : count 1 bits in x */ -int bitcount_(double *x) -{ -int b; -unsigned long *y; -double z; - -z = *x; -y = (unsigned long *) &z; -for (b = 0; *y !=0; *y >>= 1) - if (*y & 01) - b++; -return b; -} - -/* wrapper for IBM system */ -int bitcount(double *x) -{ - return bitcount_(x); -} From 20cc62b8ce8787870714a1658efab0df3923bd65 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 17 Apr 2018 13:10:15 -0600 Subject: [PATCH 0081/1072] add capability to read ER03 energy file --- .../vertical/MOM_tidal_mixing.F90 | 101 ++++++++++++++++-- 1 file changed, 92 insertions(+), 9 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index c6d522fa93..e8b383365d 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -132,8 +132,9 @@ module MOM_tidal_mixing ! CVMix-specific parameters integer :: cvmix_tidal_scheme = -1 ! 1 for Simmons, 2 for Schmittner type(cvmix_tidal_params_type) :: cvmix_tidal_params - type(cvmix_global_params_type) :: cvmix_glb_params ! for Prandtl number only - real :: tidal_max_coef ! maximum allowable tidal diffusivity. [m^2/s] + type(cvmix_global_params_type) :: cvmix_glb_params ! for Prandtl number only + real :: tidal_max_coef ! maximum allowable tidal diffusivity. [m^2/s] + real :: tidal_diss_lim_tc ! dissipation limit for tidal-energy-constituent data ! Data containers real, pointer, dimension(:,:) :: TKE_Niku => NULL() @@ -477,6 +478,10 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, call get_param(param_file, mdl, "TIDAL_MAX_COEF", CS%tidal_max_coef, & "largest acceptable value for tidal diffusivity", & units="m^2/s", default=50e-4) ! the default is 50e-4 in CVMIX, 100e-4 in POP. + call get_param(param_file, mdl, "TIDAL_DISS_LIM_TC", CS%tidal_diss_lim_tc, & + "Min allowable depth for dissipation for tidal-energy-constituent data. \n"//& + "No dissipation contribution is applied above TIDAL_DISS_LIM_TC.", & + units="m", default=0.0) call get_param(param_file, mdl, "TIDAL_ENERGY_FILE",tidal_energy_file, & "The path to the file containing tidal energy \n"//& "dissipation. Used with CVMix tidal mixing schemes.", & @@ -1133,7 +1138,7 @@ subroutine setup_tidal_diagnostics(G,CS) integer :: isd, ied, jsd, jed, nz type(tidal_mixing_diags), pointer :: dd - isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed; nz = G%ke + isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed; nz = G%ke dd => CS%dd if ((CS%id_Kd_itidal > 0) .or. (CS%id_Kd_itidal_z > 0) .or. & @@ -1293,23 +1298,101 @@ subroutine read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed if (.not. allocated(CS%tidal_qe_2d)) allocate(CS%tidal_qe_2d(isd:ied,jsd:jed)) - allocate(tidal_energy_flux_2d(isd:ied,jsd:jed)) select case (uppercase(tidal_energy_type(1:4))) - case ('JAYN') ! Jayne 2009 input tidal energy flux + case ('JAYN') ! Jayne 2009 + allocate(tidal_energy_flux_2d(isd:ied,jsd:jed)) call MOM_read_data(tidal_energy_file,'wave_dissipation',tidal_energy_flux_2d, G%domain) CS%tidal_qe_2d = (CS%Gamma_itides) * tidal_energy_flux_2d + deallocate(tidal_energy_flux_2d) + case ('ER03') ! Egbert & Ray 2003 + call read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) case default call MOM_error(FATAL, "read_tidal_energy: Unknown tidal energy file type.") - ! TODO: add more tidal energy file types, e.g., Arbic, ER03, GN13, LGM0, etc. - ! see POP::tidal_mixing.F90 end select - deallocate(tidal_energy_flux_2d) - end subroutine read_tidal_energy +subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + character(len=20), intent(in) :: tidal_energy_type + character(len=200), intent(in) :: tidal_energy_file + type(tidal_mixing_cs), pointer :: CS + + ! local + integer :: k, isd, ied, jsd, jed, nz + real, parameter :: p33 = 1.0/3.0 + real, dimension(SZK_(G)) :: & + z_t, & ! depth from surface to midpoint of input layer + z_w ! depth from surface to top of input layer + real, dimension(SZI_(G),SZJ_(G)) :: & + tidal_qk1, & ! qk1 coefficient used in Schmittner & Egbert + tidal_qo1 ! qo1 coefficient used in Schmittner & Egbert + real, allocatable, dimension(:,:,:) :: & + tc_m2, & ! input lunar semidiurnal tidal energy flux [W/m^2] + tc_s2, & ! input solar semidiurnal tidal energy flux [W/m^2] + tc_k1, & ! input lunar diurnal tidal energy flux [W/m^2] + tc_o1, & ! input lunar diurnal tidal energy flux [W/m^2] + tidal_qe_3d ! sum_tc(q_tc*TC(x,y,z)) = q*E(x,y,z) + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke + + allocate(tc_m2(isd:ied,jsd:jed,nz), & + tc_s2(isd:ied,jsd:jed,nz), & + tc_k1(isd:ied,jsd:jed,nz), & + tc_o1(isd:ied,jsd:jed,nz), & + tidal_qe_3d(isd:ied,jsd:jed,nz) ) + + ! read in tidal constituents + ! (NOTE: input z coordinates may differ from the model coordinates, which is fine.) + call MOM_read_data(tidal_energy_file, 'M2', tc_m2, G%domain) + call MOM_read_data(tidal_energy_file, 'S2', tc_s2, G%domain) + call MOM_read_data(tidal_energy_file, 'K1', tc_k1, G%domain) + call MOM_read_data(tidal_energy_file, 'O1', tc_o1, G%domain) + call MOM_read_data(tidal_energy_file, 'z_t', z_t) + call MOM_read_data(tidal_energy_file, 'z_w', z_w) + + ! form tidal_qe_3d from weighted tidal constituents + tidal_qe_3d = 0.0 + + where (abs(G%geoLatT(:,:)) < 30.0) + tidal_qk1(:,:) = p33 + tidal_qo1(:,:) = p33 + elsewhere + tidal_qk1(:,:) = 1.0 + tidal_qo1(:,:) = 1.0 + endwhere + + do k=1,nz + where (z_t(k) <= G%bathyT(:,:) .and. z_w(k) > CS%tidal_diss_lim_tc) + tidal_qe_3d(:,:,k) = p33*tc_m2(:,:,k) + p33*tc_s2(:,:,k) + & + tidal_qk1*tc_k1(:,:,k) + tidal_qo1*tc_o1(:,:,k) + endwhere + enddo + + ! test if qE is positive + if (any(tidal_qe_3d<0)) then + call MOM_error(FATAL, "read_tidal_constituents: Negative tidal_qe_3d terms.") + endif + + ! collapse 3D q*E to 2D q*E + CS%tidal_qe_2d = 0.0 + do k=1,nz + where (z_t(k) <= G%bathyT(:,:)) + CS%tidal_qe_2d(:,:) = CS%tidal_qe_2d(:,:) + tidal_qe_3d(:,:,k) + endwhere + enddo + + deallocate(tc_m2) + deallocate(tc_s2) + deallocate(tc_k1) + deallocate(tc_o1) + deallocate(tidal_qe_3d) + +end subroutine read_tidal_constituents + + !> Clear pointers and deallocate memory subroutine tidal_mixing_end(CS) type(tidal_mixing_cs), pointer :: CS ! This module's control structure From dcfb722cb334d80d47ece603e6725dd3b30f17bd Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 17 Apr 2018 13:18:22 -0600 Subject: [PATCH 0082/1072] Bug fix in MOM_bkgnd_mixing The background vertical diff was being added to itself, which is wrong and was leading to a increase in kd_bkgnd over time. This commit fixes this problem. --- src/parameterizations/vertical/MOM_bkgnd_mixing.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 14c6c3412e..2c55f4b1c5 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -408,7 +408,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, CS) CS%kd_bkgnd(i,j,1) = 0.0; CS%kv_bkgnd(i,j,1) = 0.0 CS%kd_bkgnd(i,j,nz+1) = 0.0; CS%kv_bkgnd(i,j,nz+1) = 0.0 do k=2,nz - CS%kd_bkgnd(i,j,k) = CS%kd_bkgnd(i,j,k) + 0.5*(kd_lay(i,j,K-1) + kd_lay(i,j,K)) + CS%kd_bkgnd(i,j,k) = 0.5*(kd_lay(i,j,K-1) + kd_lay(i,j,K)) CS%kv_bkgnd(i,j,k) = CS%kd_bkgnd(i,j,k) * CS%prandtl_bkgnd enddo enddo From d09e8099f8bef3d7912e525522e17f43b020261d Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 17 Apr 2018 13:20:48 -0600 Subject: [PATCH 0083/1072] Add option to diagnose Kv at u and v points Total vertical viscosity can now be diagnosed at u and v points. --- .../vertical/MOM_vert_friction.F90 | 66 +++++++++---------- 1 file changed, 30 insertions(+), 36 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index d90748b820..95773908aa 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -116,7 +116,7 @@ module MOM_vert_friction integer :: id_du_dt_visc = -1, id_dv_dt_visc = -1, id_au_vv = -1, id_av_vv = -1 integer :: id_h_u = -1, id_h_v = -1, id_hML_u = -1 , id_hML_v = -1 integer :: id_Ray_u = -1, id_Ray_v = -1, id_taux_bot = -1, id_tauy_bot = -1 - integer :: id_Kv_slow = -1, id_Kv = -1 + integer :: id_Kv_slow = -1, id_Kv_u = -1, id_Kv_v = -1 !>@} type(PointAccel_CS), pointer :: PointAccel_CSp => NULL() @@ -584,10 +584,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! based on harmonic mean thicknesses, in m or kg m-2. h_ml ! The mixed layer depth, in m or kg m-2. real, allocatable, dimension(:,:) :: hML_u, hML_v - real, allocatable, dimension(:,:,:) :: Kv_h !< Total vertical viscosity at h-points - real, dimension(SZI_(G),SZJ_(G)) :: av_h, & !< v-drag coefficient at h-points, in m s-1 - au_h !< u-drag coefficient at h-points, in m s-1 - real :: dh !< average thickness between layers k and k+1, in m or kg m-2. + real, allocatable, dimension(:,:,:) :: Kv_v, & !< Total vertical viscosity at u-points + Kv_u !< Total vertical viscosity at v-points real :: zcol(SZI_(G)) ! The height of an interface at h-points, in m or kg m-2. real :: botfn ! A function which goes from 1 at the bottom to 0 much more ! than Hbbl into the interior. @@ -620,8 +618,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) I_Hbbl(:) = 1.0 / (CS%Hbbl * GV%m_to_H + h_neglect) I_valBL = 0.0 ; if (CS%harm_BL_val > 0.0) I_valBL = 1.0 / CS%harm_BL_val - if (CS%id_Kv > 0) then - allocate(Kv_h(SZI_(G), SZJ_(G), SZK_(G)+1)) ; Kv_h(:,:,:) = 0.0 + if (CS%id_Kv_u > 0) then + allocate(Kv_u(G%IsdB:G%IedB,G%jsd:G%jed,G%ke)) ; Kv_u(:,:,:) = 0.0 + endif + + if (CS%id_Kv_v > 0) then + allocate(Kv_v(G%isd:G%ied,G%JsdB:G%JedB,G%ke)) ; Kv_v(:,:,:) = 0.0 endif if (CS%debug .or. (CS%id_hML_u > 0)) then @@ -799,6 +801,13 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) CS%h_u(I,j,k) = hvel(I,k) ; enddo ; enddo endif + ! Diagnose total Kv at u-points + if (CS%id_Kv_u > 0) then + do k=1,nz ; do I=Isq,Ieq + if (do_i(I)) Kv_u(I,j,k) = 0.5 * (CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k) + enddo ; enddo + endif + enddo @@ -962,34 +971,15 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) CS%a_v(i,J,K) = a(i,K) ; enddo ; enddo do k=1,nz ; do i=is,ie ; if (do_i(i)) CS%h_v(i,J,k) = hvel(i,k) ; enddo ; enddo endif - enddo ! end of v-point j loop - ! Total Kv at h points - if (CS%id_Kv > 0) then - !$OMP parallel do default(shared) - do k=2,nz - ! set surface and bottom values to zero - Kv_h(i,j,1) = 0.0; Kv_h(i,j,nz+1) = 0.0 - do j=js,je ; do I=is-1,ie - au_h(I,j) = CS%a_u(I,J,k) - enddo ; enddo - do J=js-1,je ; do i=is,ie - av_h(i,J) = CS%a_v(i,J,k) + ! Diagnose total Kv at v-points + if (CS%id_Kv_v > 0) then + do k=1,nz ; do i=is,ie + if (do_i(I)) Kv_v(i,J,k) = 0.5 * (CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k) enddo ; enddo - do j = js, je; do i = is, ie - dh = 0.5 * (h(i,j,K)+h(i,j,K+1)) - if (dh .le. h_neglect) then - Kv_h(i,j,k) = 0.0 - else - Kv_h(i,j,k) = sqrt((0.5 * (au_h(I,j)+au_h(I-1,j)))**2 + & - (0.5 * (av_h(i,J) + av_h(i,J-1)))**2) * dh - if (Kv_h(i,j,k) .lt. 0.0) Kv_h(i,j,k) = 0.0 - endif - enddo ; enddo - enddo ! k - ! update halos - call pass_var(Kv_h, G%Domain, To_All+Omit_Corners, halo=1) - endif + endif + + enddo ! end of v-point j loop if (CS%debug) then call uvchksum("vertvisc_coef h_[uv]", CS%h_u, & @@ -1003,7 +993,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! Offer diagnostic fields for averaging. if (CS%id_Kv_slow > 0) call post_data(CS%id_Kv_slow, visc%Kv_slow, CS%diag) - if (CS%id_Kv > 0) call post_data(CS%id_Kv, Kv_h, CS%diag) + if (CS%id_Kv_u > 0) call post_data(CS%id_Kv_u, Kv_u, CS%diag) + if (CS%id_Kv_v > 0) call post_data(CS%id_Kv_v, Kv_v, CS%diag) if (CS%id_au_vv > 0) call post_data(CS%id_au_vv, CS%a_u, CS%diag) if (CS%id_av_vv > 0) call post_data(CS%id_av_vv, CS%a_v, CS%diag) if (CS%id_h_u > 0) call post_data(CS%id_h_u, CS%h_u, CS%diag) @@ -1701,8 +1692,11 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & CS%id_Kv_slow = register_diag_field('ocean_model', 'Kv_slow', diag%axesTi, Time, & 'Slow varying vertical viscosity', 'm2 s-1') - CS%id_Kv = register_diag_field('ocean_model', 'Kv', diag%axesTi, Time, & - 'Total vertical viscosity', 'm2 s-1') + CS%id_Kv_u = register_diag_field('ocean_model', 'Kv_u', diag%axesCuL, Time, & + 'Total vertical viscosity at u-points', 'm2 s-1') + + CS%id_Kv_v = register_diag_field('ocean_model', 'Kv_v', diag%axesCvL, Time, & + 'Total vertical viscosity at v-points', 'm2 s-1') CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, & 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1') From f13294011be66669d5413096057ca0ea67f429be Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 17 Apr 2018 14:52:02 -0600 Subject: [PATCH 0084/1072] add call to compute_Schmittner_invariant --- .../vertical/MOM_tidal_mixing.F90 | 54 +++++++++++++++++-- 1 file changed, 49 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index e8b383365d..2d8415d162 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -19,6 +19,7 @@ module MOM_tidal_mixing use MOM_io, only : slasher, MOM_read_data, vardesc, var_desc use cvmix_tidal, only : cvmix_init_tidal, cvmix_compute_Simmons_invariant use cvmix_tidal, only : cvmix_coeffs_tidal, cvmix_tidal_params_type +use cvmix_tidal, only : cvmix_compute_Schmittner_invariant use cvmix_kinds_and_types, only : cvmix_global_params_type use cvmix_put_get, only : cvmix_put @@ -182,7 +183,7 @@ module MOM_tidal_mixing integer, parameter :: POLZIN_09 = 2 character*(20), parameter :: SIMMONS_SCHEME_STRING = "SIMMONS" character*(20), parameter :: SCHMITTNER_SCHEME_STRING = "SCHMITTNER" -integer, parameter :: SIMMONS_04 = 1 +integer, parameter :: SIMMONS = 1 integer, parameter :: SCHMITTNER = 2 contains @@ -257,7 +258,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, cvmix_tidal_scheme_str = uppercase(cvmix_tidal_scheme_str) select case (cvmix_tidal_scheme_str) - case (SIMMONS_SCHEME_STRING) ; CS%cvmix_tidal_scheme = SIMMONS_04 + case (SIMMONS_SCHEME_STRING) ; CS%cvmix_tidal_scheme = SIMMONS case (SCHMITTNER_SCHEME_STRING) ; CS%cvmix_tidal_scheme = SCHMITTNER case default call MOM_error(FATAL, "tidal_mixing_init: Unrecognized setting "// & @@ -646,9 +647,12 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) ! local real, dimension(SZK_(G)+1) :: Kd_tidal !< tidal diffusivity [m2/s] real, dimension(SZK_(G)+1) :: Kv_tidal !< tidal viscosity [m2/s] - real, dimension(SZK_(G)+1) :: vert_dep !< vertical deposition needed for Simmons tidal mixing. + real, dimension(SZK_(G)+1) :: vert_dep !< vertical deposition real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m) + + real, allocatable, dimension(:,:) :: exp_hab_zetar + integer :: i, k, is, ie real :: dh, hcorr, Simmons_coeff real, parameter :: rho_fw = 1000.0 ! fresh water density [kg/m^3] ! TODO: when coupled, get this from CESM (SHR_CONST_RHOFW) @@ -658,7 +662,7 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) dd => CS%dd select case (CS%cvmix_tidal_scheme) - case (SIMMONS_04) + case (SIMMONS) do i=is,ie if (G%mask2dT(i,j)<1) cycle @@ -722,7 +726,47 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) enddo ! i=is,ie - ! TODO: case (SCHMITTNER) + case (SCHMITTNER) + + allocate(exp_hab_zetar(G%ke+1,G%ke+1)) + + do i=is,ie + + if (G%mask2dT(i,j)<1) cycle + + iFaceHeight = 0.0 ! BBL is all relative to the surface + hcorr = 0.0 + do k=1,G%ke + ! cell center and cell bottom in meters (negative values in the ocean) + dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) + hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 + dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness + cellHeight(k) = iFaceHeight(k) - 0.5 * dh + iFaceHeight(k+1) = iFaceHeight(k) - dh + enddo + + ! form the time-invariant part of Schmittner coefficient term + call cvmix_compute_Schmittner_invariant(nlev = G%ke, & + VertDep = vert_dep, & + rho = rho_fw, & + exp_hab_zetar = exp_hab_zetar, & + zw = iFaceHeight, & + CVmix_tidal_params_user = CS%cvmix_tidal_params) + + ! form the Schmittner coefficient that is based on 3D q*E, which is formed from + ! summing q_i*TidalConstituent_i over the number of constituents. + !call cvmix_compute_SchmittnerCoeff( nlev = G%ke, & + ! energy_flux = , & + ! rho = rho_fw, & + ! SchmittnerCoeff = , & + ! exp_hab_zetar = , & + ! CVmix_tidal_params_user = CS%cvmix_tidal_params) + + enddo ! i=is,ie + + deallocate(exp_hab_zetar) + case default call MOM_error(FATAL, "tidal_mixing_init: Unrecognized setting "// & "#define CVMIX_TIDAL_SCHEME found in input file.") From 01578c5a6e111c10f1760f15230e1b4100aedb04 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 17 Apr 2018 16:11:01 -0600 Subject: [PATCH 0085/1072] fix tidal_mixing_init return --- src/parameterizations/vertical/MOM_tidal_mixing.F90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index a59af01afb..d6fecf00e6 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -238,6 +238,11 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, "If true, use an internal tidal dissipation scheme to \n"//& "drive diapycnal mixing, along the lines of St. Laurent \n"//& "et al. (2002) and Simmons et al. (2004).", default=CS%use_cvmix_tidal) + + ! return if tidal mixing is inactive + tidal_mixing_init = CS%int_tide_dissipation + if (.not. tidal_mixing_init) return + if (CS%int_tide_dissipation) then default_profile_string = STLAURENT_PROFILE_STRING if (CS%use_cvmix_tidal) default_profile_string = SIMMONS_PROFILE_STRING From 901c3016270f60a77b25e0001513e5aea8cd9569 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 17 Apr 2018 16:16:19 -0600 Subject: [PATCH 0086/1072] Add option to post diags for bkgnd_mixing --- .../vertical/MOM_set_diffusivity.F90 | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index a1f10519e6..7f192d65d9 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -512,12 +512,6 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif - ! send bkgnd_mixing diagnostics to post_data - if (CS%bkgnd_mixing_csp%id_kd_bkgnd > 0) & - call post_data(CS%bkgnd_mixing_csp%id_kd_bkgnd, CS%bkgnd_mixing_csp%kd_bkgnd, CS%bkgnd_mixing_csp%diag) - if (CS%bkgnd_mixing_csp%id_kv_bkgnd > 0) & - call post_data(CS%bkgnd_mixing_csp%id_kv_bkgnd, CS%bkgnd_mixing_csp%kv_bkgnd, CS%bkgnd_mixing_csp%diag) - if (CS%Kd_add > 0.0) then if (present(Kd_int)) then !$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_int,CS,Kd) @@ -538,7 +532,12 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & T_f, S_f, dd%Kd_user) endif - ! GMM, post diags... + ! post diagnostics + if (CS%bkgnd_mixing_csp%id_kd_bkgnd > 0) & + call post_data(CS%bkgnd_mixing_csp%id_kd_bkgnd, CS%bkgnd_mixing_csp%kd_bkgnd, CS%bkgnd_mixing_csp%diag) + if (CS%bkgnd_mixing_csp%id_kv_bkgnd > 0) & + call post_data(CS%bkgnd_mixing_csp%id_kv_bkgnd, CS%bkgnd_mixing_csp%kv_bkgnd, CS%bkgnd_mixing_csp%diag) + if (CS%id_Kd_layer > 0) call post_data(CS%id_Kd_layer, Kd, CS%diag) num_z_diags = 0 From a0358fbbaf7044ac5526f6dad8a054fa69e910bb Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 17 Apr 2018 16:52:26 -0600 Subject: [PATCH 0087/1072] Fix bug in MOM_cvmix_conv --- src/parameterizations/vertical/MOM_cvmix_conv.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_cvmix_conv.F90 b/src/parameterizations/vertical/MOM_cvmix_conv.F90 index 55e7d55d6e..956d0c0de3 100644 --- a/src/parameterizations/vertical/MOM_cvmix_conv.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_conv.F90 @@ -212,6 +212,7 @@ subroutine calculate_cvmix_conv(h, tv, G, GV, CS, hbl) iFaceHeight(k+1) = iFaceHeight(k) - dh enddo + ! gets index of the level and interface above hbl kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl(i,j)) call cvmix_coeffs_conv(Mdiff_out=CS%kv_conv(i,j,:), & @@ -224,7 +225,7 @@ subroutine calculate_cvmix_conv(h, tv, G, GV, CS, hbl) OBL_ind=kOBL) ! Do not apply mixing due to convection within the boundary layer - do k=1,NINT(hbl(i,j)) + do k=1,kOBL CS%kv_conv(i,j,k) = 0.0 CS%kd_conv(i,j,k) = 0.0 enddo From 9d6cb46774e83f8eaf2616771c9a70ef5713fa88 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 17 Apr 2018 16:54:55 -0600 Subject: [PATCH 0088/1072] Rename variable in register_diag_field Variable names are now consistent with what is used in other modules. --- src/parameterizations/vertical/MOM_cvmix_conv.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_cvmix_conv.F90 b/src/parameterizations/vertical/MOM_cvmix_conv.F90 index 956d0c0de3..b385880d7a 100644 --- a/src/parameterizations/vertical/MOM_cvmix_conv.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_conv.F90 @@ -128,11 +128,11 @@ logical function cvmix_conv_init(Time, G, GV, param_file, diag, CS) ! Register diagnostics CS%diag => diag - CS%id_N2 = register_diag_field('ocean_model', 'conv_N2', diag%axesTi, Time, & + CS%id_N2 = register_diag_field('ocean_model', 'N2_conv', diag%axesTi, Time, & 'Square of Brunt-Vaisala frequency used by MOM_cvmix_conv module', '1/s2') - CS%id_kd_conv = register_diag_field('ocean_model', 'conv_kd', diag%axesTi, Time, & + CS%id_kd_conv = register_diag_field('ocean_model', 'kd_conv', diag%axesTi, Time, & 'Additional diffusivity added by MOM_cvmix_conv module', 'm2/s') - CS%id_kv_conv = register_diag_field('ocean_model', 'conv_kv', diag%axesTi, Time, & + CS%id_kv_conv = register_diag_field('ocean_model', 'kv_conv', diag%axesTi, Time, & 'Additional viscosity added by MOM_cvmix_conv module', 'm2/s') call cvmix_init_conv(convect_diff=CS%kd_conv_const, & From caf1d1efc6672d40c0d6a389075fc5b785a71045 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 18 Apr 2018 09:20:00 -0600 Subject: [PATCH 0089/1072] Fixes bug and renames variables --- src/parameterizations/vertical/MOM_cvmix_conv.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/vertical/MOM_cvmix_conv.F90 b/src/parameterizations/vertical/MOM_cvmix_conv.F90 index 55e7d55d6e..2be06ee14b 100644 --- a/src/parameterizations/vertical/MOM_cvmix_conv.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_conv.F90 @@ -128,11 +128,11 @@ logical function cvmix_conv_init(Time, G, GV, param_file, diag, CS) ! Register diagnostics CS%diag => diag - CS%id_N2 = register_diag_field('ocean_model', 'conv_N2', diag%axesTi, Time, & + CS%id_N2 = register_diag_field('ocean_model', 'N2_conv', diag%axesTi, Time, & 'Square of Brunt-Vaisala frequency used by MOM_cvmix_conv module', '1/s2') - CS%id_kd_conv = register_diag_field('ocean_model', 'conv_kd', diag%axesTi, Time, & + CS%id_kd_conv = register_diag_field('ocean_model', 'kd_conv', diag%axesTi, Time, & 'Additional diffusivity added by MOM_cvmix_conv module', 'm2/s') - CS%id_kv_conv = register_diag_field('ocean_model', 'conv_kv', diag%axesTi, Time, & + CS%id_kv_conv = register_diag_field('ocean_model', 'kv_conv', diag%axesTi, Time, & 'Additional viscosity added by MOM_cvmix_conv module', 'm2/s') call cvmix_init_conv(convect_diff=CS%kd_conv_const, & @@ -224,7 +224,7 @@ subroutine calculate_cvmix_conv(h, tv, G, GV, CS, hbl) OBL_ind=kOBL) ! Do not apply mixing due to convection within the boundary layer - do k=1,NINT(hbl(i,j)) + do k=1,kOBL CS%kv_conv(i,j,k) = 0.0 CS%kd_conv(i,j,k) = 0.0 enddo From 69bf4fa5cd54e223042c00efe93819dadb2e37dd Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 18 Apr 2018 09:28:47 -0600 Subject: [PATCH 0090/1072] Updates CVMix --- pkg/CVMix-src | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/CVMix-src b/pkg/CVMix-src index 653d7c39f5..534fc38e75 160000 --- a/pkg/CVMix-src +++ b/pkg/CVMix-src @@ -1 +1 @@ -Subproject commit 653d7c39f50047c9d79c1b15caffe5631dad8bbb +Subproject commit 534fc38e759fcb8a2563fa0dc4c0bbf81f758db9 From d07120cd1d1e0d03c5ef572286e266cf55157db2 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 18 Apr 2018 09:45:43 -0600 Subject: [PATCH 0091/1072] Remove trailing space --- src/parameterizations/vertical/MOM_tidal_mixing.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index d6fecf00e6..53945e1c6b 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -1132,7 +1132,7 @@ subroutine setup_tidal_diagnostics(G,CS) integer :: isd, ied, jsd, jed, nz type(tidal_mixing_diags), pointer :: dd - isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed; nz = G%ke + isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed; nz = G%ke dd => CS%dd if ((CS%id_Kd_itidal > 0) .or. (CS%id_Kd_itidal_z > 0) .or. & From 5640daf24bfc95cf53ee8f5f1657ed441cc144f3 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 18 Apr 2018 10:35:37 -0600 Subject: [PATCH 0092/1072] Attempt to fix deallocating unallocated arrays * This was caught by Travis, which uses gfortran. It does not happen with intel. --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 70412a716b..7f1df76192 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -2425,13 +2425,13 @@ subroutine diabatic_driver_end(CS) call entrain_diffusive_end(CS%entrain_diffusive_CSp) call set_diffusivity_end(CS%set_diff_CSp) if (CS%useKPP) then - deallocate( CS%KPP_buoy_flux ) - deallocate( CS%KPP_temp_flux ) - deallocate( CS%KPP_salt_flux ) + if (allocated(CS%KPP_buoy_flux)) deallocate( CS%KPP_buoy_flux ) + if (allocated(CS%KPP_temp_flux)) deallocate( CS%KPP_temp_flux ) + if (allocated(CS%KPP_salt_flux)) deallocate( CS%KPP_salt_flux ) endif if (CS%useKPP) then - deallocate( CS%KPP_NLTheat ) - deallocate( CS%KPP_NLTscalar ) + if (allocated(CS%KPP_NLTheat)) deallocate( CS%KPP_NLTheat ) + if (allocated(CS%KPP_NLTscalar)) deallocate( CS%KPP_NLTscalar ) call KPP_end(CS%KPP_CSp) endif From dabe31bec06d8242066d701ea9110a40b88630a5 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 18 Apr 2018 10:38:53 -0600 Subject: [PATCH 0093/1072] Update CVMix --- pkg/CVMix-src | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/CVMix-src b/pkg/CVMix-src index 653d7c39f5..534fc38e75 160000 --- a/pkg/CVMix-src +++ b/pkg/CVMix-src @@ -1 +1 @@ -Subproject commit 653d7c39f50047c9d79c1b15caffe5631dad8bbb +Subproject commit 534fc38e759fcb8a2563fa0dc4c0bbf81f758db9 From dc82c48cec30cbf712d309fdb9e7f9da36240589 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 18 Apr 2018 10:54:31 -0600 Subject: [PATCH 0094/1072] Return call if CS is not allocated --- src/parameterizations/vertical/MOM_KPP.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 87ce532a28..6376358fea 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -1073,7 +1073,10 @@ end subroutine KPP_NonLocalTransport_saln subroutine KPP_end(CS) type(KPP_CS), pointer :: CS !< Control structure + if (.not.associated(CS)) return + deallocate(CS) + end subroutine KPP_end !> \namespace mom_kpp From dde5a5975b9504247ccf4a59c76965585b0fe048 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 18 Apr 2018 11:09:11 -0600 Subject: [PATCH 0095/1072] Commenting out deallocation of KPP related arrays --- .../vertical/MOM_diabatic_driver.F90 | 23 +++++++++++-------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 7f1df76192..07cfb558cd 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -2424,16 +2424,19 @@ subroutine diabatic_driver_end(CS) call entrain_diffusive_end(CS%entrain_diffusive_CSp) call set_diffusivity_end(CS%set_diff_CSp) - if (CS%useKPP) then - if (allocated(CS%KPP_buoy_flux)) deallocate( CS%KPP_buoy_flux ) - if (allocated(CS%KPP_temp_flux)) deallocate( CS%KPP_temp_flux ) - if (allocated(CS%KPP_salt_flux)) deallocate( CS%KPP_salt_flux ) - endif - if (CS%useKPP) then - if (allocated(CS%KPP_NLTheat)) deallocate( CS%KPP_NLTheat ) - if (allocated(CS%KPP_NLTscalar)) deallocate( CS%KPP_NLTscalar ) - call KPP_end(CS%KPP_CSp) - endif + + ! GMM, commeting the following because it fails on Travis (gfortran) + + ! if (CS%useKPP) then + ! if (allocated(CS%KPP_buoy_flux)) deallocate( CS%KPP_buoy_flux ) + ! if (allocated(CS%KPP_temp_flux)) deallocate( CS%KPP_temp_flux ) + ! if (allocated(CS%KPP_salt_flux)) deallocate( CS%KPP_salt_flux ) + ! endif + ! if (CS%useKPP) then + ! if (allocated(CS%KPP_NLTheat)) deallocate( CS%KPP_NLTheat ) + ! if (allocated(CS%KPP_NLTscalar)) deallocate( CS%KPP_NLTscalar ) + ! call KPP_end(CS%KPP_CSp) + ! endif if (CS%use_tidal_mixing) call tidal_mixing_end(CS%tidal_mixing_CSp) From 43b796865e271cbcf5260c45535b40c0c29df176 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 18 Apr 2018 11:34:38 -0600 Subject: [PATCH 0096/1072] Commenting out call to diabatic_driver_end in MOM.F90 --- src/core/MOM.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 22dbb86b15..a6da3b5333 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2901,7 +2901,7 @@ subroutine MOM_end(CS) call tracer_registry_end(CS%tracer_Reg) call tracer_flow_control_end(CS%tracer_flow_CSp) - if (associated(CS%diabatic_CSp)) call diabatic_driver_end(CS%diabatic_CSp) + !if (associated(CS%diabatic_CSp)) call diabatic_driver_end(CS%diabatic_CSp) if (CS%offline_tracer_mode) call offline_transport_end(CS%offline_CSp) From 1ed491920169100981ec7f1ca9d6cc4fd2c6ece6 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 18 Apr 2018 11:14:17 -0800 Subject: [PATCH 0097/1072] *Enable reading of tangential velocity OBC fields. - Changes answers for CCS1, fixes this bug: At line 2205 of file //import/c1/AKWATERS/kate/ESMG/ESMG-configs/src/MOM6/src/core/MOM_open_boundary.F90 Fortran runtime error: Array bound mismatch for dimension 2 of array 'segment' (129/128) - Note, the vertical remapping is only happening at q-points internal to the segment at this time. --- src/core/MOM_open_boundary.F90 | 346 ++++++++++++++++++++++----------- 1 file changed, 233 insertions(+), 113 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 369febbb2b..35b442c816 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -589,7 +589,7 @@ subroutine initialize_segment_data(G, OBC, PF) allocate(segment%field(m)%buffer_src(IsdB:IedB,jsd:jed,siz2(3))) endif else - if (segment%field(m)%name == 'V') then + if (segment%field(m)%name == 'U') then allocate(segment%field(m)%buffer_src(IsdB:IedB,JsdB:JedB,siz2(3))) else allocate(segment%field(m)%buffer_src(isd:ied,JsdB:JedB,siz2(3))) @@ -608,7 +608,7 @@ subroutine initialize_segment_data(G, OBC, PF) allocate(segment%field(m)%dz_src(IsdB:IedB,jsd:jed,siz(3))) endif else - if (segment%field(m)%name == 'V') then + if (segment%field(m)%name == 'U') then allocate(segment%field(m)%dz_src(IsdB:IedB,JsdB:JedB,siz(3))) else allocate(segment%field(m)%dz_src(isd:ied,JsdB:JedB,siz(3))) @@ -2077,7 +2077,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) real, dimension(:,:), pointer :: seg_vel => NULL() ! pointer to segment velocity array real, dimension(:,:), pointer :: seg_trans => NULL() ! pointer to segment transport array real, dimension(:,:,:), allocatable :: tmp_buffer - integer :: subsample_factor + real, dimension(:), allocatable :: h_stack integer :: is_obc2, js_obc2 is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -2087,11 +2087,6 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (.not. associated(OBC)) return - if (OBC%brushcutter_mode) then - subsample_factor = 2 - else - subsample_factor = 1 - endif do n = 1, OBC%number_of_segments segment => OBC%segment(n) @@ -2104,16 +2099,6 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) js_obc = max(segment%js_obc,jsd-1) je_obc = min(segment%je_obc,jed) - if (OBC%brushcutter_mode) then - if (segment%is_E_or_W) then - nj_seg=nj_seg-1 - js_obc=js_obc+1 - else - ni_seg=ni_seg-1 - is_obc=is_obc+1 - endif - endif - ! Calculate auxiliary fields at staggered locations. ! Segment indices are on q points: ! @@ -2158,6 +2143,8 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) enddo endif + allocate(h_stack(G%ke)) + h_stack(:) = 0.0 do m = 1,segment%num_fields if (segment%field(m)%fid > 0) then siz(1)=size(segment%field(m)%buffer_src,1) @@ -2166,115 +2153,284 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (.not.associated(segment%field(m)%buffer_dst)) then if (siz(3) /= segment%field(m)%nk_src) call MOM_error(FATAL,'nk_src inconsistency') if (segment%field(m)%nk_src > 1) then - if (OBC%brushcutter_mode) then - allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) - else - if (segment%is_E_or_W) then + if (segment%is_E_or_W) then + if (segment%field(m)%name == 'V') then + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) + else allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc+1:je_obc,G%ke)) + endif + if (segment%field(m)%name == 'U') then + allocate(segment%field(m)%bt_vel(is_obc:ie_obc,js_obc+1:je_obc)) + segment%field(m)%bt_vel(:,:)=0.0 + endif + else + if (segment%field(m)%name == 'U') then + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) else allocate(segment%field(m)%buffer_dst(is_obc+1:ie_obc,js_obc:je_obc,G%ke)) endif + if (segment%field(m)%name == 'V') then + allocate(segment%field(m)%bt_vel(is_obc+1:ie_obc,js_obc:je_obc)) + segment%field(m)%bt_vel(:,:)=0.0 + endif endif else - if (OBC%brushcutter_mode) then - allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,1)) - else - if (segment%is_E_or_W) then + if (segment%is_E_or_W) then + if (segment%field(m)%name == 'V') then + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,1)) + else allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc+1:je_obc,1)) + endif + if (segment%field(m)%name == 'U') then + allocate(segment%field(m)%bt_vel(is_obc:ie_obc,js_obc+1:je_obc)) + segment%field(m)%bt_vel(:,:)=0.0 + endif + else + if (segment%field(m)%name == 'U') then + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,1)) else allocate(segment%field(m)%buffer_dst(is_obc+1:ie_obc,js_obc:je_obc,1)) endif + if (segment%field(m)%name == 'V') then + allocate(segment%field(m)%bt_vel(is_obc+1:ie_obc,js_obc:je_obc)) + segment%field(m)%bt_vel(:,:)=0.0 + endif endif endif segment%field(m)%buffer_dst(:,:,:)=0.0 - if (trim(segment%field(m)%name) == 'U' .or. trim(segment%field(m)%name) == 'V') then - allocate(segment%field(m)%bt_vel(is_obc:ie_obc,js_obc:je_obc)) - segment%field(m)%bt_vel(:,:)=0.0 - endif endif ! read source data interpolated to the current model time if (siz(1)==1) then - allocate(tmp_buffer(1,(nj_seg+1)*subsample_factor-1,segment%field(m)%nk_src)) ! segment data is currrently on supergrid + if (OBC%brushcutter_mode) then + allocate(tmp_buffer(1,nj_seg*2-1,segment%field(m)%nk_src)) ! segment data is currrently on supergrid + else + allocate(tmp_buffer(1,nj_seg,segment%field(m)%nk_src)) ! segment data is currrently on supergrid + endif else - allocate(tmp_buffer((ni_seg+1)*subsample_factor-1,1,segment%field(m)%nk_src)) ! segment data is currrently on supergrid + if (OBC%brushcutter_mode) then + allocate(tmp_buffer(ni_seg*2-1,1,segment%field(m)%nk_src)) ! segment data is currrently on supergrid + else + allocate(tmp_buffer(ni_seg,1,segment%field(m)%nk_src)) ! segment data is currrently on supergrid + endif endif call time_interp_external(segment%field(m)%fid,Time, tmp_buffer) if (OBC%brushcutter_mode) then - if (siz(1)==1) then - segment%field(m)%buffer_src(is_obc,:,:)=tmp_buffer(1,2*(js_obc+G%jdg_offset)-1:2*(je_obc+G%jdg_offset)-1:2,:) + if (segment%is_E_or_W) then + if (segment%field(m)%name == 'V') then + segment%field(m)%buffer_src(is_obc,:,:)=tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset)+1:2,:) + else + segment%field(m)%buffer_src(is_obc,:,:)=tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset):2,:) + endif else - segment%field(m)%buffer_src(:,js_obc,:)=tmp_buffer(2*(is_obc+G%idg_offset)-1:2*(ie_obc+G%idg_offset)-1:2,1,:) + if (segment%field(m)%name == 'U') then + segment%field(m)%buffer_src(:,js_obc,:)=tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset)+1:2,1,:) + else + segment%field(m)%buffer_src(:,js_obc,:)=tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset):2,1,:) + endif endif else - if (siz(1)==1) then - segment%field(m)%buffer_src(is_obc,:,:)=tmp_buffer(1,js_obc+G%jdg_offset+1:je_obc+G%jdg_offset,:) + if (segment%is_E_or_W) then + if (segment%field(m)%name == 'V') then + segment%field(m)%buffer_src(is_obc,:,:)=tmp_buffer(1,js_obc+G%jdg_offset+1:je_obc+G%jdg_offset+1,:) + else + segment%field(m)%buffer_src(is_obc,:,:)=tmp_buffer(1,js_obc+G%jdg_offset+1:je_obc+G%jdg_offset,:) + endif else - segment%field(m)%buffer_src(:,js_obc,:)=tmp_buffer(is_obc+G%idg_offset+1:ie_obc+G%idg_offset,1,:) + if (segment%field(m)%name == 'U') then + segment%field(m)%buffer_src(:,js_obc,:)=tmp_buffer(is_obc+G%idg_offset+1:ie_obc+G%idg_offset+1,1,:) + else + segment%field(m)%buffer_src(:,js_obc,:)=tmp_buffer(is_obc+G%idg_offset+1:ie_obc+G%idg_offset,1,:) + endif endif endif if (segment%field(m)%nk_src > 1) then call time_interp_external(segment%field(m)%fid_dz,Time, tmp_buffer) if (OBC%brushcutter_mode) then - if (siz(1)==1) then - segment%field(m)%dz_src(is_obc,:,:)=tmp_buffer(1,2*(js_obc+G%jdg_offset)-1:2*(je_obc+G%jdg_offset)-1:2,:) + if (segment%is_E_or_W) then + if (segment%field(m)%name == 'V') then + segment%field(m)%dz_src(is_obc,:,:)=tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset)+1:2,:) + else + segment%field(m)%dz_src(is_obc,:,:)=tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset):2,:) + endif else - segment%field(m)%dz_src(:,js_obc,:)=tmp_buffer(2*(is_obc+G%idg_offset)-1:2*(ie_obc+G%idg_offset)-1:2,1,:) + if (segment%field(m)%name == 'U') then + segment%field(m)%dz_src(:,js_obc,:)=tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset)+1:2,1,:) + else + segment%field(m)%dz_src(:,js_obc,:)=tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset):2,1,:) + endif endif else - if (siz(1)==1) then - segment%field(m)%dz_src(is_obc,:,:)=tmp_buffer(1,js_obc+G%jdg_offset+1:je_obc+G%jdg_offset,:) + if (segment%is_E_or_W) then + if (segment%field(m)%name == 'V') then + segment%field(m)%dz_src(is_obc,:,:)=tmp_buffer(1,js_obc+G%jdg_offset+1:je_obc+G%jdg_offset+1,:) + else + segment%field(m)%dz_src(is_obc,:,:)=tmp_buffer(1,js_obc+G%jdg_offset+1:je_obc+G%jdg_offset,:) + endif else - segment%field(m)%dz_src(:,js_obc,:)=tmp_buffer(is_obc+G%idg_offset+1:ie_obc+G%idg_offset,1,:) + if (segment%field(m)%name == 'U') then + segment%field(m)%dz_src(:,js_obc,:)=tmp_buffer(is_obc+G%idg_offset+1:ie_obc+G%idg_offset+1,1,:) + else + segment%field(m)%dz_src(:,js_obc,:)=tmp_buffer(is_obc+G%idg_offset+1:ie_obc+G%idg_offset,1,:) + endif endif endif if (segment%is_E_or_W) then ishift=1 if (segment%direction == OBC_DIRECTION_E) ishift=0 - do j=js_obc+1,je_obc - I=is_obc - ! Using the h remapping approach - ! Pretty sure we need to check for source/target grid consistency here - segment%field(m)%buffer_dst(I,j,:)=0.0 ! initialize remap destination buffer - if (G%mask2dCu(I,j)>0.) then - call remapping_core_h(OBC%remap_CS, & - segment%field(m)%nk_src,segment%field(m)%dz_src(I,j,:), & - segment%field(m)%buffer_src(I,j,:), & - G%ke, h(i+ishift,j,:), segment%field(m)%buffer_dst(I,j,:)) - endif - enddo + I=is_obc + if (segment%field(m)%name == 'V') then + ! Only do q points within the segment + do J=js_obc+1,je_obc-1 + ! Using the h remapping approach + ! Pretty sure we need to check for source/target grid consistency here + segment%field(m)%buffer_dst(I,J,:)=0.0 ! initialize remap destination buffer + if (G%mask2dCu(I,j)>0. .and. G%mask2dCu(I,j+1)>0.) then + h_stack(:) = 0.5*(h(i+ishift,j,:) + h(i+ishift,j+1,:)) + call remapping_core_h(OBC%remap_CS, & + segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & + segment%field(m)%buffer_src(I,J,:), & + G%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) + else if (G%mask2dCu(I,j)>0.) then + h_stack(:) = h(i+ishift,j,:) + call remapping_core_h(OBC%remap_CS, & + segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & + segment%field(m)%buffer_src(I,J,:), & + G%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) + else if (G%mask2dCu(I,j+1)>0.) then + h_stack(:) = h(i+ishift,j+1,:) + call remapping_core_h(OBC%remap_CS, & + segment%field(m)%nk_src,segment%field(m)%dz_src(I,j,:), & + segment%field(m)%buffer_src(I,J,:), & + G%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) + endif + enddo + else + do j=js_obc+1,je_obc + ! Using the h remapping approach + ! Pretty sure we need to check for source/target grid consistency here + segment%field(m)%buffer_dst(I,j,:)=0.0 ! initialize remap destination buffer + if (G%mask2dCu(I,j)>0.) then + call remapping_core_h(OBC%remap_CS, & + segment%field(m)%nk_src,segment%field(m)%dz_src(I,j,:), & + segment%field(m)%buffer_src(I,j,:), & + G%ke, h(i+ishift,j,:), segment%field(m)%buffer_dst(I,j,:)) + endif + enddo + endif else jshift=1 if (segment%direction == OBC_DIRECTION_N) jshift=0 - do i=is_obc+1,ie_obc - J=js_obc + J=js_obc + if (segment%field(m)%name == 'U') then + ! Only do q points within the segment + do I=is_obc+1,ie_obc-1 + segment%field(m)%buffer_dst(I,J,:)=0.0 ! initialize remap destination buffer + if (G%mask2dCv(i,J)>0. .and. G%mask2dCv(i+1,J)>0.) then ! Using the h remapping approach ! Pretty sure we need to check for source/target grid consistency here - segment%field(m)%buffer_dst(i,J,:)=0.0 ! initialize remap destination buffer - if (G%mask2dCv(i,J)>0.) then - call remapping_core_h(OBC%remap_CS, & - segment%field(m)%nk_src,segment%field(m)%dz_src(i,J,:), & - segment%field(m)%buffer_src(i,J,:), & - G%ke, h(i,j+jshift,:), segment%field(m)%buffer_dst(i,J,:)) - endif - enddo + h_stack(:) = 0.5*(h(i,j+jshift,:) + h(i+1,j+jshift,:)) + call remapping_core_h(OBC%remap_CS, & + segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & + segment%field(m)%buffer_src(I,J,:), & + G%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) + else if (G%mask2dCv(i,J)>0.) then + h_stack(:) = h(i,j+jshift,:) + call remapping_core_h(OBC%remap_CS, & + segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & + segment%field(m)%buffer_src(I,J,:), & + G%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) + else if (G%mask2dCv(i+1,J)>0.) then + h_stack(:) = h(i+1,j+jshift,:) + call remapping_core_h(OBC%remap_CS, & + segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & + segment%field(m)%buffer_src(I,J,:), & + G%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) + endif + enddo + else + do i=is_obc+1,ie_obc + ! Using the h remapping approach + ! Pretty sure we need to check for source/target grid consistency here + segment%field(m)%buffer_dst(i,J,:)=0.0 ! initialize remap destination buffer + if (G%mask2dCv(i,J)>0.) then + call remapping_core_h(OBC%remap_CS, & + segment%field(m)%nk_src,segment%field(m)%dz_src(i,J,:), & + segment%field(m)%buffer_src(i,J,:), & + G%ke, h(i,j+jshift,:), segment%field(m)%buffer_dst(i,J,:)) + endif + enddo + endif endif else ! 2d data segment%field(m)%buffer_dst(:,:,1)=segment%field(m)%buffer_src(:,:,1) ! initialize remap destination buffer endif deallocate(tmp_buffer) - else ! fid <= 0 + else ! fid <= 0 (Uniform value) if (.not. ASSOCIATED(segment%field(m)%buffer_dst)) then - allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) + if (segment%is_E_or_W) then + if (segment%field(m)%name == 'V') then + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) + allocate(segment%field(m)%bt_vel(is_obc:ie_obc,js_obc:je_obc)) + else if (segment%field(m)%name == 'U') then + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc+1:je_obc,G%ke)) + allocate(segment%field(m)%bt_vel(is_obc:ie_obc,js_obc+1:je_obc)) + else + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc+1:je_obc,G%ke)) + endif + else + if (segment%field(m)%name == 'U') then + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) + allocate(segment%field(m)%bt_vel(is_obc:ie_obc,js_obc:je_obc)) + else if (segment%field(m)%name == 'V') then + allocate(segment%field(m)%buffer_dst(is_obc+1:ie_obc,js_obc:je_obc,G%ke)) + allocate(segment%field(m)%bt_vel(is_obc+1:ie_obc,js_obc:je_obc)) + else + allocate(segment%field(m)%buffer_dst(is_obc+1:ie_obc,js_obc:je_obc,G%ke)) + endif + endif segment%field(m)%buffer_dst(:,:,:)=segment%field(m)%value if (trim(segment%field(m)%name) == 'U' .or. trim(segment%field(m)%name) == 'V') then - allocate(segment%field(m)%bt_vel(is_obc:ie_obc,js_obc:je_obc)) segment%field(m)%bt_vel(:,:)=segment%field(m)%value endif endif endif + if (trim(segment%field(m)%name) == 'U' .or. trim(segment%field(m)%name) == 'V') then + if (segment%field(m)%fid>0) then ! calculate external BT velocity and transport if needed + if (trim(segment%field(m)%name) == 'U' .and. segment%is_E_or_W) then + I=is_obc + do j=js_obc+1,je_obc + segment%normal_trans_bt(I,j) = 0.0 + do k=1,G%ke + segment%normal_vel(I,j,k) = segment%field(m)%buffer_dst(I,j,k) + segment%normal_trans(I,j,k) = segment%field(m)%buffer_dst(I,j,k)*segment%h(I,j,k) * & + G%dyCu(I,j) + segment%normal_trans_bt(I,j)= segment%normal_trans_bt(I,j)+segment%normal_trans(I,j,k) + enddo + segment%normal_vel_bt(I,j) = segment%normal_trans_bt(I,j)/(max(segment%Htot(I,j),1.e-12) * & + G%dyCu(I,j)) + if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(I,j,:) = segment%normal_vel(I,j,:) + enddo + elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_N_or_S) then + J=js_obc + do i=is_obc+1,ie_obc + segment%normal_trans_bt(i,J) = 0.0 + do k=1,G%ke + segment%normal_vel(i,J,k) = segment%field(m)%buffer_dst(i,J,k) + segment%normal_trans(i,J,k) = segment%field(m)%buffer_dst(i,J,k)*segment%h(i,J,k) * & + G%dxCv(i,J) + segment%normal_trans_bt(i,J)= segment%normal_trans_bt(i,J)+segment%normal_trans(i,J,k) + enddo + segment%normal_vel_bt(i,J) = segment%normal_trans_bt(i,J)/(max(segment%Htot(i,J),1.e-12) * & + G%dxCv(i,J)) + if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(i,J,:) = segment%normal_vel(i,J,:) + enddo + endif + endif + endif + ! from this point on, data are entirely on segments - will ! write all segment loops as 2d loops. if (segment%is_E_or_W) then @@ -2292,42 +2448,6 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) js_obc2 = js_obc+1 endif - if (trim(segment%field(m)%name) == 'U' .or. trim(segment%field(m)%name) == 'V') then - if (segment%field(m)%fid>0) then ! calculate external BT velocity and transport if needed - if (trim(segment%field(m)%name) == 'U' .and. segment%is_E_or_W) then - do j=js_obc2,je_obc - do i=is_obc2,ie_obc - segment%normal_trans_bt(i,j) = 0.0 - do k=1,G%ke - segment%normal_vel(i,j,k) = segment%field(m)%buffer_dst(i,j,k) - segment%normal_trans(i,j,k) = segment%field(m)%buffer_dst(i,j,k)*segment%h(i,j,k) * & - G%dyCu(I,j) - segment%normal_trans_bt(i,j)= segment%normal_trans_bt(i,j)+segment%normal_trans(i,j,k) - enddo - segment%normal_vel_bt(i,j) = segment%normal_trans_bt(i,j)/(max(segment%Htot(i,j),1.e-12) * & - G%dyCu(I,j)) - if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(i,j,:) = segment%normal_vel(i,j,:) - enddo - enddo - elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_N_or_S) then - do j=js_obc2,je_obc - do i=is_obc2,ie_obc - segment%normal_trans_bt(i,j) = 0.0 - do k=1,G%ke - segment%normal_vel(i,j,k) = segment%field(m)%buffer_dst(i,j,k) - segment%normal_trans(i,j,k) = segment%field(m)%buffer_dst(i,j,k)*segment%h(i,j,k) * & - G%dxCv(i,J) - segment%normal_trans_bt(i,j)= segment%normal_trans_bt(i,j)+segment%normal_trans(i,j,k) - enddo - segment%normal_vel_bt(i,j) = segment%normal_trans_bt(i,j)/(max(segment%Htot(i,j),1.e-12) * & - G%dxCv(i,J)) - if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(i,j,:) = segment%normal_vel(i,j,:) - enddo - enddo - endif - endif - endif - if (trim(segment%field(m)%name) == 'SSH') then do j=js_obc2,je_obc do i=is_obc2,ie_obc @@ -2338,13 +2458,12 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (trim(segment%field(m)%name) == 'TEMP') then if (associated(segment%field(m)%buffer_dst)) then - do k=1,nz; do j=js_obc2, je_obc;do i=is_obc2,ie_obc + do k=1,nz; do j=js_obc2, je_obc; do i=is_obc2,ie_obc segment%tr_Reg%Tr(1)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k) -! if the tracer reservoir has not yet been initialized, then set to external value. -! Am using negative values here, which will not work for temperature in degC. enddo; enddo; enddo if (.not. segment%tr_Reg%Tr(1)%is_initialized) then - do k=1,nz; do j=js_obc2, je_obc;do i=is_obc2,ie_obc + ! if the tracer reservoir has not yet been initialized, then set to external value. + do k=1,nz; do j=js_obc2, je_obc; do i=is_obc2,ie_obc segment%tr_Reg%Tr(1)%tres(i,j,k) = segment%tr_Reg%Tr(1)%t(i,j,k) enddo; enddo; enddo segment%tr_Reg%Tr(1)%is_initialized=.true. @@ -2354,12 +2473,12 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) endif elseif (trim(segment%field(m)%name) == 'SALT') then if (associated(segment%field(m)%buffer_dst)) then - do k=1,nz; do j=js_obc2, je_obc;do i=is_obc2,ie_obc + do k=1,nz; do j=js_obc2, je_obc; do i=is_obc2,ie_obc segment%tr_Reg%Tr(2)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k) enddo; enddo; enddo if (.not. segment%tr_Reg%Tr(1)%is_initialized) then - !if the tracer reservoir has not yet been initialized, then set to external value - do k=1,nz; do j=js_obc2, je_obc;do i=is_obc2,ie_obc + !if the tracer reservoir has not yet been initialized, then set to external value. + do k=1,nz; do j=js_obc2, je_obc; do i=is_obc2,ie_obc segment%tr_Reg%Tr(2)%tres(i,j,k) = segment%tr_Reg%Tr(2)%t(i,j,k) enddo; enddo; enddo segment%tr_Reg%Tr(1)%is_initialized=.true. @@ -2369,7 +2488,8 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) endif endif - enddo + enddo ! end field loop + deallocate(h_stack) enddo ! end segment loop From 5153869be08a7ef4ecbd862bf255c2dca2764191 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 18 Apr 2018 19:47:25 -0600 Subject: [PATCH 0098/1072] initialize boolean control vars in tidal mixing mod --- .../vertical/MOM_set_diffusivity.F90 | 3 ++- .../vertical/MOM_tidal_mixing.F90 | 18 +++++++++++------- 2 files changed, 13 insertions(+), 8 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index a1f10519e6..77061d530e 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -886,7 +886,8 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz) do_i(i) = (G%mask2dT(i,j) > 0.5) - if (CS%tm_csp%Int_tide_dissipation .or. CS%tm_csp%Lee_wave_dissipation) then + if ( (CS%tm_csp%Int_tide_dissipation .or. CS%tm_csp%Lee_wave_dissipation) .and. & + .not. CS%tm_csp%use_cvmix_tidal ) then h_amp(i) = sqrt(CS%tm_csp%h2(i,j)) ! for computing Nb else h_amp(i) = 0.0 diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 53945e1c6b..dcca7d5fb5 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -63,15 +63,15 @@ module MOM_tidal_mixing logical :: debug = .true. ! Parameters - logical :: int_tide_dissipation ! Internal tide conversion (from barotropic) with - ! the schemes of St Laurent et al (2002)/ + logical :: int_tide_dissipation = .false. ! Internal tide conversion (from barotropic) + ! with the schemes of St Laurent et al (2002)/ ! Simmons et al (2004) integer :: Int_tide_profile ! A coded integer indicating the vertical profile ! for dissipation of the internal waves. Schemes that ! are currently encoded are St Laurent et al (2002) and ! Polzin (2009). - logical :: Lee_wave_dissipation ! Enable lee-wave driven mixing, following + logical :: Lee_wave_dissipation = .false. ! Enable lee-wave driven mixing, following ! Nikurashin (2010), with a vertical energy ! deposition profile specified by Lee_wave_profile. ! St Laurent et al (2002) or @@ -94,8 +94,8 @@ module MOM_tidal_mixing ! wave energy dissipation (nondimensional) real :: min_zbot_itides ! minimum depth for internal tide conversion (meter) - logical :: Lowmode_itidal_dissipation ! Internal tide conversion (from low modes) with - ! the schemes of St Laurent et al (2002)/ + logical :: Lowmode_itidal_dissipation = .false. ! Internal tide conversion (from low modes) + ! with the schemes of St Laurent et al (2002)/ ! Simmons et al (2004) !BDM real :: Nu_Polzin ! The non-dimensional constant used in Polzin form of @@ -122,8 +122,8 @@ module MOM_tidal_mixing real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height character(len=200) :: inputdir - logical :: use_cvmix_tidal ! true if cvmix is to be used for determining diffusivity - ! due to tidal mixing + logical :: use_cvmix_tidal = .false. ! true if cvmix is to be used for determining + ! diffusivity due to tidal mixing real :: min_thickness ! Minimum thickness allowed [m] @@ -372,6 +372,10 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, call get_param(param_file, mdl, "MIN_ZBOT_ITIDES", CS%min_zbot_itides, & "Turn off internal tidal dissipation when the total \n"//& "ocean depth is less than this value.", units="m", default=0.0) + endif + + if ( (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation) .and. & + .not. CS%use_cvmix_tidal) then call safe_alloc_ptr(CS%Nb,isd,ied,jsd,jed) call safe_alloc_ptr(CS%h2,isd,ied,jsd,jed) From 78656bbb545f01cd0a2d71af95ec7072ffea89f7 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 19 Apr 2018 08:49:47 -0600 Subject: [PATCH 0099/1072] Add missing halo update for visc%Kv_slow --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 8e45d26688..eea1eba16a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1372,6 +1372,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G ! visc%Kv_shear is not in the group pass because it has larger vertical extent. if (associated(visc%Kv_shear)) & call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) + if (associated(visc%Kv_slow)) & + call pass_var(visc%Kv_slow, G%Domain, To_All+Omit_Corners, halo=1) + call cpu_clock_end(id_clock_pass) if (.not. CS%useALEalgorithm) then From 3385857b6fe19e7c7e35a0370914cdc339c131fa Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 19 Apr 2018 08:55:22 -0600 Subject: [PATCH 0100/1072] Initialize Kd, Kd_int and Kv_slow using interior values specified by user --- src/parameterizations/vertical/MOM_set_diffusivity.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 7f192d65d9..b9905977d5 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -276,6 +276,12 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call MOM_error(FATAL, "set_diffusivity: visc%Kd_extra_T and "//& "visc%Kd_extra_S must be associated when DOUBLE_DIFFUSION is true.") + ! Set Kd, Kd_int and Kv_slow to constant values. + ! If nothing else is specified, this will be the value used. + Kd(:,:,:) = CS%Kd + Kd_int(:,:,:) = CS%Kd + visc%Kv_slow(:,:,:) = CS%Kv + ! Set up arrays for diagnostics. if ((CS%id_N2 > 0) .or. (CS%id_N2_z > 0)) then From 191b5be35ca028a2aa0608f9202048c5a4a22ca3 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 19 Apr 2018 08:56:19 -0600 Subject: [PATCH 0101/1072] Add a factor of 2 when adding Kv_slow into Kv_add --- .../vertical/MOM_vert_friction.F90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 95773908aa..973f256915 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1165,16 +1165,17 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m ! add "slow" varying vertical viscosity (e.g., from background, tidal etc) if (associated(visc%Kv_slow)) then + ! GMM/ A factor of 2 is also needed here, see comment above from BGR. if (work_on_u) then do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = Kv_add(i,K) + 0.5 * (visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k)) + Kv_add(i,K) = Kv_add(i,K) + 1.0 * (visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k)) endif ; enddo ; enddo if (do_OBCs) then do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + visc%Kv_slow(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + visc%Kv_slow(i+1,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i+1,j,k) ; enddo endif endif ; enddo endif @@ -1183,14 +1184,14 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = Kv_add(i,K) + 0.5*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j+1,k)) + Kv_add(i,K) = Kv_add(i,K) + 1.0*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j+1,k)) endif ; enddo ; enddo if (do_OBCs) then do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + visc%Kv_slow(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + visc%Kv_slow(i,j+1,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j+1,k) ; enddo endif endif ; enddo endif From 2800524c2280b3c3dc68ff75687cb28568ed993b Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 19 Apr 2018 09:12:28 -0600 Subject: [PATCH 0102/1072] Uncomment calls to deallocate KPP related arrays --- src/core/MOM.F90 | 2 +- .../vertical/MOM_diabatic_driver.F90 | 22 +++++++++---------- 2 files changed, 11 insertions(+), 13 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index a6da3b5333..22dbb86b15 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2901,7 +2901,7 @@ subroutine MOM_end(CS) call tracer_registry_end(CS%tracer_Reg) call tracer_flow_control_end(CS%tracer_flow_CSp) - !if (associated(CS%diabatic_CSp)) call diabatic_driver_end(CS%diabatic_CSp) + if (associated(CS%diabatic_CSp)) call diabatic_driver_end(CS%diabatic_CSp) if (CS%offline_tracer_mode) call offline_transport_end(CS%offline_CSp) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 07cfb558cd..be8dafc10b 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -2425,18 +2425,16 @@ subroutine diabatic_driver_end(CS) call entrain_diffusive_end(CS%entrain_diffusive_CSp) call set_diffusivity_end(CS%set_diff_CSp) - ! GMM, commeting the following because it fails on Travis (gfortran) - - ! if (CS%useKPP) then - ! if (allocated(CS%KPP_buoy_flux)) deallocate( CS%KPP_buoy_flux ) - ! if (allocated(CS%KPP_temp_flux)) deallocate( CS%KPP_temp_flux ) - ! if (allocated(CS%KPP_salt_flux)) deallocate( CS%KPP_salt_flux ) - ! endif - ! if (CS%useKPP) then - ! if (allocated(CS%KPP_NLTheat)) deallocate( CS%KPP_NLTheat ) - ! if (allocated(CS%KPP_NLTscalar)) deallocate( CS%KPP_NLTscalar ) - ! call KPP_end(CS%KPP_CSp) - ! endif + if (CS%useKPP) then + deallocate( CS%KPP_buoy_flux ) + deallocate( CS%KPP_temp_flux ) + deallocate( CS%KPP_salt_flux ) + endif + if (CS%useKPP) then + deallocate( CS%KPP_NLTheat ) + deallocate( CS%KPP_NLTscalar ) + call KPP_end(CS%KPP_CSp) + endif if (CS%use_tidal_mixing) call tidal_mixing_end(CS%tidal_mixing_CSp) From 0e4dce5cd3feed3298ae85663bdbfe147dd35f0a Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 19 Apr 2018 10:00:09 -0600 Subject: [PATCH 0103/1072] add cvmix_compute_SchmittnerCoeff --- .../vertical/MOM_tidal_mixing.F90 | 81 ++++++++++--------- 1 file changed, 45 insertions(+), 36 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 2d8415d162..26d0bb3584 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -19,7 +19,7 @@ module MOM_tidal_mixing use MOM_io, only : slasher, MOM_read_data, vardesc, var_desc use cvmix_tidal, only : cvmix_init_tidal, cvmix_compute_Simmons_invariant use cvmix_tidal, only : cvmix_coeffs_tidal, cvmix_tidal_params_type -use cvmix_tidal, only : cvmix_compute_Schmittner_invariant +use cvmix_tidal, only : cvmix_compute_Schmittner_invariant, cvmix_compute_SchmittnerCoeff use cvmix_kinds_and_types, only : cvmix_global_params_type use cvmix_put_get, only : cvmix_put @@ -138,13 +138,14 @@ module MOM_tidal_mixing real :: tidal_diss_lim_tc ! dissipation limit for tidal-energy-constituent data ! Data containers - real, pointer, dimension(:,:) :: TKE_Niku => NULL() - real, pointer, dimension(:,:) :: TKE_itidal => NULL() - real, pointer, dimension(:,:) :: Nb => NULL() - real, pointer, dimension(:,:) :: mask_itidal => NULL() - real, pointer, dimension(:,:) :: h2 => NULL() - real, pointer, dimension(:,:) :: tideamp => NULL() ! RMS tidal amplitude (m/s) - real, allocatable,dimension(:,:) :: tidal_qe_2d ! q*E(x,y) ! TODO: make this E(x,y) only + real, pointer, dimension(:,:) :: TKE_Niku => NULL() + real, pointer, dimension(:,:) :: TKE_itidal => NULL() + real, pointer, dimension(:,:) :: Nb => NULL() + real, pointer, dimension(:,:) :: mask_itidal => NULL() + real, pointer, dimension(:,:) :: h2 => NULL() + real, pointer, dimension(:,:) :: tideamp => NULL() ! RMS tidal amplitude (m/s) + real, allocatable ,dimension(:,:) :: tidal_qe_2d ! q*E(x,y) ! TODO: make this E(x,y) only + real, allocatable ,dimension(:,:,:) :: tidal_qe_3d_in ! q*E(x,y) ! TODO: make this E(x,y) only ! Diagnostics type(diag_ctrl), pointer :: diag => NULL() ! structure to regulate diagn output timing @@ -243,6 +244,11 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, "If true, use an internal tidal dissipation scheme to \n"//& "drive diapycnal mixing, along the lines of St. Laurent \n"//& "et al. (2002) and Simmons et al. (2004).", default=CS%use_cvmix_tidal) + + ! check if tidal mixing is active + tidal_mixing_init = CS%int_tide_dissipation + if (.not. tidal_mixing_init) return + if (CS%int_tide_dissipation) then ! Read in CVMix tidal scheme if CVMix tidal mixing is on @@ -651,6 +657,7 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m) + real, allocatable, dimension(:) :: Schmittner_coeff real, allocatable, dimension(:,:) :: exp_hab_zetar integer :: i, k, is, ie @@ -728,7 +735,11 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) case (SCHMITTNER) + ! TODO: correct exp_hab_zetar shapes in cvmix_compute_Schmittner_invariant + ! and cvmix_compute_SchmittnerCoeff low subroutines + allocate(exp_hab_zetar(G%ke+1,G%ke+1)) + allocate(Schmittner_coeff(G%ke)) do i=is,ie @@ -756,12 +767,12 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) ! form the Schmittner coefficient that is based on 3D q*E, which is formed from ! summing q_i*TidalConstituent_i over the number of constituents. - !call cvmix_compute_SchmittnerCoeff( nlev = G%ke, & - ! energy_flux = , & - ! rho = rho_fw, & - ! SchmittnerCoeff = , & - ! exp_hab_zetar = , & - ! CVmix_tidal_params_user = CS%cvmix_tidal_params) + call cvmix_compute_SchmittnerCoeff( nlev = G%ke, & + energy_flux = CS%tidal_qe_3d_in(i,j,:), & ! todo!!!: vertical interpolation + rho = rho_fw, & + SchmittnerCoeff = Schmittner_coeff, & + exp_hab_zetar = exp_hab_zetar, & + CVmix_tidal_params_user = CS%cvmix_tidal_params) enddo ! i=is,ie @@ -1336,20 +1347,20 @@ subroutine read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS) character(len=200), intent(in) :: tidal_energy_file type(tidal_mixing_cs), pointer :: CS ! local - integer :: isd, ied, jsd, jed + integer :: isd, ied, jsd, jed, nz real, allocatable, dimension(:,:) :: tidal_energy_flux_2d ! input tidal energy flux at T-grid points (W/m^2) - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - - if (.not. allocated(CS%tidal_qe_2d)) allocate(CS%tidal_qe_2d(isd:ied,jsd:jed)) + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke select case (uppercase(tidal_energy_type(1:4))) case ('JAYN') ! Jayne 2009 + if (.not. allocated(CS%tidal_qe_2d)) allocate(CS%tidal_qe_2d(isd:ied,jsd:jed)) allocate(tidal_energy_flux_2d(isd:ied,jsd:jed)) call MOM_read_data(tidal_energy_file,'wave_dissipation',tidal_energy_flux_2d, G%domain) CS%tidal_qe_2d = (CS%Gamma_itides) * tidal_energy_flux_2d deallocate(tidal_energy_flux_2d) case ('ER03') ! Egbert & Ray 2003 + if (.not. allocated(CS%tidal_qe_3d_in)) allocate(CS%tidal_qe_3d_in(isd:ied,jsd:jed,nz)) call read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) case default call MOM_error(FATAL, "read_tidal_energy: Unknown tidal energy file type.") @@ -1377,16 +1388,14 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) tc_m2, & ! input lunar semidiurnal tidal energy flux [W/m^2] tc_s2, & ! input solar semidiurnal tidal energy flux [W/m^2] tc_k1, & ! input lunar diurnal tidal energy flux [W/m^2] - tc_o1, & ! input lunar diurnal tidal energy flux [W/m^2] - tidal_qe_3d ! sum_tc(q_tc*TC(x,y,z)) = q*E(x,y,z) + tc_o1 ! input lunar diurnal tidal energy flux [W/m^2] isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke allocate(tc_m2(isd:ied,jsd:jed,nz), & tc_s2(isd:ied,jsd:jed,nz), & tc_k1(isd:ied,jsd:jed,nz), & - tc_o1(isd:ied,jsd:jed,nz), & - tidal_qe_3d(isd:ied,jsd:jed,nz) ) + tc_o1(isd:ied,jsd:jed,nz) ) ! read in tidal constituents ! (NOTE: input z coordinates may differ from the model coordinates, which is fine.) @@ -1397,8 +1406,8 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) call MOM_read_data(tidal_energy_file, 'z_t', z_t) call MOM_read_data(tidal_energy_file, 'z_w', z_w) - ! form tidal_qe_3d from weighted tidal constituents - tidal_qe_3d = 0.0 + ! form tidal_qe_3d_in from weighted tidal constituents + CS%tidal_qe_3d_in = 0.0 where (abs(G%geoLatT(:,:)) < 30.0) tidal_qk1(:,:) = p33 @@ -1410,29 +1419,28 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) do k=1,nz where (z_t(k) <= G%bathyT(:,:) .and. z_w(k) > CS%tidal_diss_lim_tc) - tidal_qe_3d(:,:,k) = p33*tc_m2(:,:,k) + p33*tc_s2(:,:,k) + & + CS%tidal_qe_3d_in(:,:,k) = p33*tc_m2(:,:,k) + p33*tc_s2(:,:,k) + & tidal_qk1*tc_k1(:,:,k) + tidal_qo1*tc_o1(:,:,k) endwhere enddo ! test if qE is positive - if (any(tidal_qe_3d<0)) then - call MOM_error(FATAL, "read_tidal_constituents: Negative tidal_qe_3d terms.") + if (any(CS%tidal_qe_3d_in<0)) then + call MOM_error(FATAL, "read_tidal_constituents: Negative tidal_qe_3d_in terms.") endif - ! collapse 3D q*E to 2D q*E - CS%tidal_qe_2d = 0.0 - do k=1,nz - where (z_t(k) <= G%bathyT(:,:)) - CS%tidal_qe_2d(:,:) = CS%tidal_qe_2d(:,:) + tidal_qe_3d(:,:,k) - endwhere - enddo + !! collapse 3D q*E to 2D q*E + !CS%tidal_qe_2d = 0.0 + !do k=1,nz + ! where (z_t(k) <= G%bathyT(:,:)) + ! CS%tidal_qe_2d(:,:) = CS%tidal_qe_2d(:,:) + CS%tidal_qe_3d_in(:,:,k) + ! endwhere + !enddo deallocate(tc_m2) deallocate(tc_s2) deallocate(tc_k1) deallocate(tc_o1) - deallocate(tidal_qe_3d) end subroutine read_tidal_constituents @@ -1442,7 +1450,8 @@ subroutine tidal_mixing_end(CS) type(tidal_mixing_cs), pointer :: CS ! This module's control structure !TODO deallocate all the dynamically allocated members here ... - if (allocated(CS%tidal_qe_2d)) deallocate(CS%tidal_qe_2d) + if (allocated(CS%tidal_qe_2d)) deallocate(CS%tidal_qe_2d) + if (allocated(CS%tidal_qe_3d_in)) deallocate(CS%tidal_qe_3d_in) deallocate(CS%dd) deallocate(CS) From 65527d6d08c9f9c9813df9e008d0d4bb8572ce6a Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 19 Apr 2018 14:34:26 -0600 Subject: [PATCH 0104/1072] Set useKPP = .false. (default) and comment call to diag_grid_storage_end --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index be8dafc10b..a17c74b888 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -151,7 +151,7 @@ module MOM_diabatic_driver real :: evap_CFL_limit = 0.8 !< The largest fraction of a layer that can be !! evaporated in one time-step (non-dim). - logical :: useKPP !< use CVmix/KPP diffusivities and non-local transport + logical :: useKPP = .false. !< use CVmix/KPP diffusivities and non-local transport logical :: salt_reject_below_ML !< If true, add salt below mixed layer (layer mode only) logical :: KPPisPassive !< If true, KPP is in passive mode, not changing answers. logical :: debug !< If true, write verbose checksums for debugging purposes. @@ -2450,9 +2450,15 @@ subroutine diabatic_driver_end(CS) deallocate(CS%optics) endif - call diag_grid_storage_end(CS%diag_grids_prev) + ! GMM, the following is commented out because arrays in + ! CS%diag_grids_prev are neither pointers or allocatables + ! and, therefore, cannot be deallocated. + + !call diag_grid_storage_end(CS%diag_grids_prev) + if (associated(CS)) deallocate(CS) + end subroutine diabatic_driver_end From e90fbe9443dc45dd5b9d885658a853a619bb7172 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 19 Apr 2018 14:35:08 -0600 Subject: [PATCH 0105/1072] Return if CS is not associated --- src/parameterizations/vertical/MOM_tidal_mixing.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index dcca7d5fb5..90c6bcac88 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -1317,6 +1317,8 @@ end subroutine read_tidal_energy subroutine tidal_mixing_end(CS) type(tidal_mixing_cs), pointer :: CS ! This module's control structure + if (.not.associated(CS)) return + !TODO deallocate all the dynamically allocated members here ... if (allocated(CS%tidal_qe_2d)) deallocate(CS%tidal_qe_2d) deallocate(CS%dd) From 2d07aa05f51acd021c33ac3362a40d7beb0f0b77 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 19 Apr 2018 17:39:09 -0400 Subject: [PATCH 0106/1072] Removed unused module use statements from MOM.F90 Removed a number of unused module use statements and the unused variable missing Removed CS%missing from MOM.F90. Also shortened some variable names and cleaned up the spacing on the comments describing the MOM_control_struct. All answers are bitwise identical. --- src/core/MOM.F90 | 210 ++++++++++++++++++++++------------------------- 1 file changed, 98 insertions(+), 112 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 1fd75a71ef..61324733a6 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2,7 +2,6 @@ module MOM ! This file is part of MOM6. See LICENSE.md for the license. - ! Infrastructure modules use MOM_debugging, only : MOM_debugging_init, hchksum, uvchksum use MOM_checksum_packages, only : MOM_thermo_chksum, MOM_state_chksum @@ -10,7 +9,6 @@ module MOM use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_COMPONENT, CLOCK_SUBCOMPONENT use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE -use MOM_coms, only : reproducing_sum use MOM_coord_initialization, only : MOM_initialize_coord use MOM_diag_mediator, only : diag_mediator_init, enable_averaging use MOM_diag_mediator, only : diag_mediator_infrastructure_init @@ -41,7 +39,7 @@ module MOM use MOM_obsolete_params, only : find_obsolete_params use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, is_new_run, MOM_restart_CS -use MOM_spatial_means, only : global_area_mean, global_area_integral, global_mass_integral +use MOM_spatial_means, only : global_mass_integral use MOM_state_initialization, only : MOM_initialize_state use MOM_time_manager, only : time_type, set_time, time_type_to_real, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) @@ -54,8 +52,6 @@ module MOM use MOM_ALE, only : ALE_getCoordinate, ALE_getCoordinateUnits, ALE_writeCoordinateFile use MOM_ALE, only : ALE_updateVerticalGridType, ALE_remap_init_conds, ALE_register_diags use MOM_boundary_update, only : call_OBC_register, OBC_register_end, update_OBC_CS -use MOM_continuity, only : continuity, continuity_init, continuity_CS, continuity_stencil -use MOM_CoriolisAdv, only : CorAdCalc, CoriolisAdv_init, CoriolisAdv_CS use MOM_diabatic_driver, only : diabatic, diabatic_driver_init, diabatic_CS use MOM_diabatic_driver, only : adiabatic, adiabatic_driver_init, diabatic_driver_end use MOM_diagnostics, only : calculate_diagnostic_fields, MOM_diagnostics_init @@ -76,12 +72,10 @@ module MOM use MOM_dynamics_unsplit_RK2, only : MOM_dyn_unsplit_RK2_CS use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid use MOM_EOS, only : EOS_init, calculate_density -use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct use MOM_debugging, only : check_redundant use MOM_grid, only : ocean_grid_type, set_first_direction use MOM_grid, only : MOM_grid_init, MOM_grid_end use MOM_hor_index, only : hor_index_type, hor_index_init -use MOM_hor_visc, only : horizontal_viscosity, hor_visc_init use MOM_interface_heights, only : find_eta use MOM_lateral_mixing_coeffs, only : calc_slope_functions, VarMix_init use MOM_lateral_mixing_coeffs, only : calc_resoln_function, VarMix_CS @@ -89,12 +83,10 @@ module MOM use MOM_MEKE_types, only : MEKE_type use MOM_mixed_layer_restrat, only : mixedlayer_restrat, mixedlayer_restrat_init, mixedlayer_restrat_CS use MOM_mixed_layer_restrat, only : mixedlayer_restrat_register_restarts -use MOM_neutral_diffusion, only : neutral_diffusion_CS use MOM_obsolete_diagnostics, only : register_obsolete_diagnostics use MOM_open_boundary, only : ocean_OBC_type, OBC_registry_type use MOM_open_boundary, only : register_temp_salt_segments use MOM_open_boundary, only : open_boundary_register_restarts -use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_init use MOM_set_visc, only : set_visc_register_restarts, set_visc_CS use MOM_sponge, only : init_sponge_diags, sponge_CS @@ -102,7 +94,6 @@ module MOM use MOM_sum_output, only : MOM_sum_output_init, sum_output_CS use MOM_ALE_sponge, only : init_ALE_sponge_diags, ALE_sponge_CS use MOM_thickness_diffuse, only : thickness_diffuse, thickness_diffuse_init, thickness_diffuse_CS -use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS use MOM_tracer_advect, only : advect_tracer, tracer_advect_init use MOM_tracer_advect, only : tracer_advect_end, tracer_advect_CS use MOM_tracer_hor_diff, only : tracer_hordiff, tracer_hor_diff_init @@ -119,8 +110,6 @@ module MOM use MOM_variables, only : surface, allocate_surface_state, deallocate_surface_state use MOM_variables, only : thermo_var_ptrs, vertvisc_type use MOM_variables, only : accel_diag_ptrs, cont_diag_ptrs, ocean_internal_state -use MOM_vert_friction, only : vertvisc, vertvisc_remnant -use MOM_vert_friction, only : vertvisc_limit_vel, vertvisc_init use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd use MOM_verticalGrid, only : get_thickness_units, get_flux_units, get_tr_flux_units use MOM_wave_interface, only : wave_parameters_CS, waves_end @@ -135,7 +124,6 @@ module MOM use MOM_offline_main, only : offline_advection_layer, offline_transport_end use MOM_ALE, only : ale_offline_tracer_final, ALE_main_offline - implicit none ; private #include @@ -152,28 +140,28 @@ module MOM !! the state of the ocean. type, public :: MOM_control_struct ; private real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: & - h, & !< layer thickness (m or kg/m2 (H)) - T, & !< potential temperature (degrees C) - S !< salinity (ppt) + h, & !< layer thickness (m or kg/m2 (H)) + T, & !< potential temperature (degrees C) + S !< salinity (ppt) real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - u, & !< zonal velocity component (m/s) - uh, & !< uh = u * h * dy at u grid points (m3/s or kg/s) - uhtr !< accumulated zonal thickness fluxes to advect tracers (m3 or kg) + u, & !< zonal velocity component (m/s) + uh, & !< uh = u * h * dy at u grid points (m3/s or kg/s) + uhtr !< accumulated zonal thickness fluxes to advect tracers (m3 or kg) real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - v, & !< meridional velocity (m/s) - vh, & !< vh = v * h * dx at v grid points (m3/s or kg/s) - vhtr !< accumulated meridional thickness fluxes to advect tracers (m3 or kg) + v, & !< meridional velocity (m/s) + vh, & !< vh = v * h * dx at v grid points (m3/s or kg/s) + vhtr !< accumulated meridional thickness fluxes to advect tracers (m3 or kg) real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - ssh_rint, & !< A running time integral of the sea surface height, in s m. - ave_ssh_ibc, & !< time-averaged (over a forcing time step) sea surface height - !! with a correction for the inverse barometer (meter) - eta_av_bc !< free surface height or column mass time averaged over the last - !! baroclinic dynamics time step (m or kg/m2) + ssh_rint, & !< A running time integral of the sea surface height, in s m. + ave_ssh_ibc, & !< time-averaged (over a forcing time step) sea surface height + !! with a correction for the inverse barometer (meter) + eta_av_bc !< free surface height or column mass time averaged over the last + !! baroclinic dynamics time step (m or kg/m2) real, pointer, dimension(:,:) :: & - Hml => NULL() !< active mixed layer depth, in m + Hml => NULL() !< active mixed layer depth, in m real :: time_in_cycle !< The running time of the current time-stepping cycle - !! in calls that step the dynamics, and also the length of the - !! time integral of ssh_rint, in s. + !! in calls that step the dynamics, and also the length of + !! the time integral of ssh_rint, in s. type(ocean_grid_type) :: G !< structure containing metrics and grid info type(verticalGrid_type), pointer :: & @@ -196,11 +184,11 @@ module MOM integer :: ndyn_per_adv = 0 !< Number of calls to dynamics since the last call to advection !! Must be saved if thermo spans coupling? - type(diag_ctrl) :: diag !< structure to regulate diagnostic output timing - type(vertvisc_type) :: visc !< structure containing vertical viscosities, - !! bottom drag viscosities, and related fields - type(MEKE_type), pointer :: MEKE => NULL() !< structure containing fields - !! related to the Mesoscale Eddy Kinetic Energy + type(diag_ctrl) :: diag !< structure to regulate diagnostic output timing + type(vertvisc_type) :: visc !< structure containing vertical viscosities, + !! bottom drag viscosities, and related fields + type(MEKE_type), pointer :: MEKE => NULL() !< structure containing fields + !! related to the Mesoscale Eddy Kinetic Energy logical :: adiabatic !< If true, there are no diapycnal mass fluxes, and no calls !! to routines to calculate or apply diapycnal fluxes. @@ -250,54 +238,52 @@ module MOM type(time_type) :: Z_diag_time !< next time to compute Z-space diagnostics real, pointer, dimension(:,:,:) :: & - h_pre_dyn => NULL(), & !< The thickness before the transports, in H. - T_pre_dyn => NULL(), & !< Temperature before the transports, in degC. - S_pre_dyn => NULL() !< Salinity before the transports, in psu. - type(accel_diag_ptrs) :: ADp !< structure containing pointers to accelerations, - !! for derived diagnostics (e.g., energy budgets) - type(cont_diag_ptrs) :: CDp !< structure containing pointers to continuity equation - !! terms, for derived diagnostics (e.g., energy budgets) + h_pre_dyn => NULL(), & !< The thickness before the transports, in H. + T_pre_dyn => NULL(), & !< Temperature before the transports, in degC. + S_pre_dyn => NULL() !< Salinity before the transports, in psu. + type(accel_diag_ptrs) :: ADp !< structure containing pointers to accelerations, + !! for derived diagnostics (e.g., energy budgets) + type(cont_diag_ptrs) :: CDp !< structure containing pointers to continuity equation + !! terms, for derived diagnostics (e.g., energy budgets) real, pointer, dimension(:,:,:) :: & - u_prev => NULL(), & !< previous value of u stored for diagnostics - v_prev => NULL() !< previous value of v stored for diagnostics - - logical :: interp_p_surf !< If true, linearly interpolate surface pressure - !! over the coupling time step, using specified value - !! at the end of the coupling step. False by default. - logical :: p_surf_prev_set !< If true, p_surf_prev has been properly set from - !! a previous time-step or the ocean restart file. - !! This is only valid when interp_p_surf is true. + u_prev => NULL(), & !< previous value of u stored for diagnostics + v_prev => NULL() !< previous value of v stored for diagnostics + + logical :: interp_p_surf !< If true, linearly interpolate surface pressure + !! over the coupling time step, using specified value + !! at the end of the coupling step. False by default. + logical :: p_surf_prev_set !< If true, p_surf_prev has been properly set from + !! a previous time-step or the ocean restart file. + !! This is only valid when interp_p_surf is true. real, pointer, dimension(:,:) :: & - p_surf_prev => NULL(), & !< surface pressure (Pa) at end previous call to step_MOM - p_surf_begin => NULL(), & !< surface pressure (Pa) at start of step_MOM_dyn_... - p_surf_end => NULL() !< surface pressure (Pa) at end of step_MOM_dyn_... - - ! Not needed in CS? - real :: missing=-1.0e34 !< missing data value for masked fields + p_surf_prev => NULL(), & !< surface pressure (Pa) at end previous call to step_MOM + p_surf_begin => NULL(), & !< surface pressure (Pa) at start of step_MOM_dyn_... + p_surf_end => NULL() !< surface pressure (Pa) at end of step_MOM_dyn_... ! Variables needed to reach between start and finish phases of initialization - logical :: write_IC !< If true, then the initial conditions will be written to file - character(len=120) :: IC_file !< A file into which the initial conditions are - !! written in a new run if SAVE_INITIAL_CONDS is true. + logical :: write_IC !< If true, then the initial conditions will be written to file + character(len=120) :: IC_file !< A file into which the initial conditions are + !! written in a new run if SAVE_INITIAL_CONDS is true. - logical :: calc_rho_for_sea_lev !< If true, calculate rho to convert pressure to sea level + logical :: calc_rho_for_sea_lev !< If true, calculate rho to convert pressure to sea level ! These elements are used to control the calculation and error checking of the surface state - real :: Hmix !< Diagnostic mixed layer thickness over which to - !! average surface tracer properties (in meter) when - !! bulk mixed layer is not used, or a negative value - !! if a bulk mixed layer is being used. - real :: Hmix_UV !< Depth scale over which to average surface flow to - !! feedback to the coupler/driver (m) when - !! bulk mixed layer is not used, or a negative value - !! if a bulk mixed layer is being used. - logical :: check_bad_surface_vals !< If true, scan surface state for ridiculous values. - real :: bad_val_ssh_max !< Maximum SSH before triggering bad value message - real :: bad_val_sst_max !< Maximum SST before triggering bad value message - real :: bad_val_sst_min !< Minimum SST before triggering bad value message - real :: bad_val_sss_max !< Maximum SSS before triggering bad value message - real :: bad_val_column_thickness!< Minimum column thickness before triggering bad value message - + real :: Hmix !< Diagnostic mixed layer thickness over which to + !! average surface tracer properties (in meter) when + !! bulk mixed layer is not used, or a negative value + !! if a bulk mixed layer is being used. + real :: Hmix_UV !< Depth scale over which to average surface flow to + !! feedback to the coupler/driver (m) when + !! bulk mixed layer is not used, or a negative value + !! if a bulk mixed layer is being used. + logical :: check_bad_sfc_vals !< If true, scan surface state for ridiculous values. + real :: bad_val_ssh_max !< Maximum SSH before triggering bad value message + real :: bad_val_sst_max !< Maximum SST before triggering bad value message + real :: bad_val_sst_min !< Minimum SST before triggering bad value message + real :: bad_val_sss_max !< Maximum SSS before triggering bad value message + real :: bad_vol_col_thick !< Minimum column thickness before triggering bad value message + + ! Structures and handles used for diagnostics. type(MOM_diag_IDs) :: IDs type(transport_diag_IDs) :: transport_IDs type(surface_diag_IDs) :: sfc_IDs @@ -363,7 +349,6 @@ module MOM contains - !> This subroutine orchestrates the time stepping of MOM. The adiabatic !! dynamics are stepped by calls to one of the step_MOM_dyn_...routines. !! The action of lateral processes on tracers occur in calls to @@ -371,26 +356,26 @@ module MOM !! occur inside of diabatic. subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Waves, & do_dynamics, do_thermodynamics, start_cycle, end_cycle, cycle_length) - type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(forcing), intent(inout) :: fluxes !< pointers to forcing fields - type(surface), intent(inout) :: sfc_state !< surface ocean state - type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - real, intent(in) :: time_interval !< time interval covered by this run segment, in s. - type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM - type(Wave_parameters_CS), pointer, optional, intent(in) :: & - Waves !< point CS with waves - logical, optional, intent(in) :: do_dynamics !< Present and false, do not do updates due - !! to the dynamics. - logical, optional, intent(in) :: do_thermodynamics !< Present and false, do not do updates due - !! to the thermodynamics or remapping. - logical, optional, intent(in) :: start_cycle !< This indicates whether this call is to be - !! treated as the first call to step_MOM in a - !! time-stepping cycle; missing is like true. - logical, optional, intent(in) :: end_cycle !< This indicates whether this call is to be - !! treated as the last call to step_MOM in a - !! time-stepping cycle; missing is like true. - real, optional, intent(in) :: cycle_length !< The amount of time in a coupled time - !! stepping cycle, in s. + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + type(forcing), intent(inout) :: fluxes !< pointers to forcing fields + type(surface), intent(inout) :: sfc_state !< surface ocean state + type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type + real, intent(in) :: time_interval !< time interval covered by this run segment, in s. + type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM + type(Wave_parameters_CS), pointer, & + optional, intent(in) :: Waves !< An optional pointer to a wave proptery CS + logical, optional, intent(in) :: do_dynamics !< Present and false, do not do updates due + !! to the dynamics. + logical, optional, intent(in) :: do_thermodynamics !< Present and false, do not do updates due + !! to the thermodynamics or remapping. + logical, optional, intent(in) :: start_cycle !< This indicates whether this call is to be + !! treated as the first call to step_MOM in a + !! time-stepping cycle; missing is like true. + logical, optional, intent(in) :: end_cycle !< This indicates whether this call is to be + !! treated as the last call to step_MOM in a + !! time-stepping cycle; missing is like true. + real, optional, intent(in) :: cycle_length !< The amount of time in a coupled time + !! stepping cycle, in s. ! local type(ocean_grid_type), pointer :: G ! pointer to a structure containing @@ -568,6 +553,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa ! Set the local time to the end of the time step. Time_local = Time_start + set_time(int(floor(CS%rel_time+0.5))) + !### Update_Stokes_Drift must be behind a do_dyn or a do_thermo test. if (CS%UseWaves) then ! Update wave information, which is presently kept static over each call to step_mom !bgr 3/15/18: Need to enable_averaging here to enable output of Stokes drift from the @@ -727,6 +713,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa ! Diagnostics that require the complete state to be up-to-date can be calculated. call enable_averaging(CS%t_dyn_rel_diag, Time_local, CS%diag) + !### This is the one place where fluxes might used if do_thermo=.false. Is this correct? call calculate_diagnostic_fields(u, v, h, CS%uh, CS%vh, CS%tv, CS%ADp, & CS%CDp, fluxes, CS%t_dyn_rel_diag, CS%diag_pre_sync,& G, GV, CS%diagnostics_CSp) @@ -1232,12 +1219,12 @@ end subroutine step_MOM_thermo !! the work is very preliminary. Some more detail about this capability along with some of the subroutines !! called here can be found in tracers/MOM_offline_control.F90 subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS) - type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - type(forcing), intent(inout) :: fluxes !< pointers to forcing fields - type(surface), intent(inout) :: sfc_state !< surface ocean state - type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - real, intent(in) :: time_interval !< time interval - type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM + type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces + type(forcing), intent(inout) :: fluxes !< pointers to forcing fields + type(surface), intent(inout) :: sfc_state !< surface ocean state + type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type + real, intent(in) :: time_interval !< time interval + type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM ! Local pointers type(ocean_grid_type), pointer :: G => NULL() ! Pointer to a structure containing @@ -1762,11 +1749,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "updates, with even numbers (or 0) used for x- first \n"//& "and odd numbers used for y-first.", default=0) - call get_param(param_file, "MOM", "CHECK_BAD_SURFACE_VALS", & - CS%check_bad_surface_vals, & + call get_param(param_file, "MOM", "CHECK_BAD_SURFACE_VALS", CS%check_bad_sfc_vals, & "If true, check the surface state for ridiculous values.", & default=.false.) - if (CS%check_bad_surface_vals) then + if (CS%check_bad_sfc_vals) then call get_param(param_file, "MOM", "BAD_VAL_SSH_MAX", CS%bad_val_ssh_max, & "The value of SSH above which a bad value message is \n"//& "triggered, if CHECK_BAD_SURFACE_VALS is true.", units="m", & @@ -1783,10 +1769,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "The value of SST below which a bad value message is \n"//& "triggered, if CHECK_BAD_SURFACE_VALS is true.", & units="deg C", default=-2.1) - call get_param(param_file, "MOM", "BAD_VAL_COLUMN_THICKNESS", CS%bad_val_column_thickness, & - "The value of column thickness below which a bad value message is \n"//& - "triggered, if CHECK_BAD_SURFACE_VALS is true.", units="m", & - default=0.0) + call get_param(param_file, "MOM", "BAD_VAL_COLUMN_THICKNESS", CS%bad_vol_col_thick, & + "The value of column thickness below which a bad value message is \n"//& + "triggered, if CHECK_BAD_SURFACE_VALS is true.", units="m", & + default=0.0) endif call get_param(param_file, "MOM", "SAVE_INITIAL_CONDS", save_IC, & @@ -2793,14 +2779,14 @@ subroutine extract_surface_state(CS, sfc_state) call call_tracer_surface_state(sfc_state, h, G, CS%tracer_flow_CSp) endif - if (CS%check_bad_surface_vals) then + if (CS%check_bad_sfc_vals) then numberOfErrors=0 ! count number of errors do j=js,je; do i=is,ie if (G%mask2dT(i,j)>0.) then localError = sfc_state%sea_lev(i,j)<=-G%bathyT(i,j) & .or. sfc_state%sea_lev(i,j)>= CS%bad_val_ssh_max & .or. sfc_state%sea_lev(i,j)<=-CS%bad_val_ssh_max & - .or. sfc_state%sea_lev(i,j)+G%bathyT(i,j) < CS%bad_val_column_thickness + .or. sfc_state%sea_lev(i,j)+G%bathyT(i,j) < CS%bad_vol_col_thick if (use_temperature) localError = localError & .or. sfc_state%SSS(i,j)<0. & .or. sfc_state%SSS(i,j)>=CS%bad_val_sss_max & From 4671c0775d9c8388ece1e2a326ad77877d0e4b4e Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 19 Apr 2018 17:35:06 -0600 Subject: [PATCH 0107/1072] Comment call diabatic_driver_end to check if Travis still fails --- src/core/MOM.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 22dbb86b15..7fd0cb53a8 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2901,7 +2901,8 @@ subroutine MOM_end(CS) call tracer_registry_end(CS%tracer_Reg) call tracer_flow_control_end(CS%tracer_flow_CSp) - if (associated(CS%diabatic_CSp)) call diabatic_driver_end(CS%diabatic_CSp) + ! GMM, following call fails on Travis + !if (associated(CS%diabatic_CSp)) call diabatic_driver_end(CS%diabatic_CSp) if (CS%offline_tracer_mode) call offline_transport_end(CS%offline_CSp) From 9f4ce3a8bf794b1437d31680c869d7093efe1f21 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 19 Apr 2018 17:57:50 -0600 Subject: [PATCH 0108/1072] Un-comment call diabatic_driver_end --- src/core/MOM.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 7fd0cb53a8..22dbb86b15 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2901,8 +2901,7 @@ subroutine MOM_end(CS) call tracer_registry_end(CS%tracer_Reg) call tracer_flow_control_end(CS%tracer_flow_CSp) - ! GMM, following call fails on Travis - !if (associated(CS%diabatic_CSp)) call diabatic_driver_end(CS%diabatic_CSp) + if (associated(CS%diabatic_CSp)) call diabatic_driver_end(CS%diabatic_CSp) if (CS%offline_tracer_mode) call offline_transport_end(CS%offline_CSp) From 9703e7c55d370bf16defdb9f70b3126ff262f96d Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 19 Apr 2018 18:16:41 -0600 Subject: [PATCH 0109/1072] remap tidal energy from input coord to model coord --- .../vertical/MOM_tidal_mixing.F90 | 89 ++++++++++++------- 1 file changed, 57 insertions(+), 32 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 4066f71c17..8ca8ecfffb 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -3,25 +3,26 @@ module MOM_tidal_mixing ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field -use MOM_diag_mediator, only : safe_alloc_ptr, post_data -use MOM_diag_to_Z, only : diag_to_Z_CS, register_Zint_diag -use MOM_diag_to_Z, only : calc_Zint_diags -use MOM_EOS, only : calculate_density -use MOM_variables, only : thermo_var_ptrs, p3d -use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE -use MOM_debugging, only : hchksum -use MOM_grid, only : ocean_grid_type -use MOM_verticalGrid, only : verticalGrid_type -use MOM_file_parser, only : openParameterBlock, closeParameterBlock -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_string_functions, only : uppercase, lowercase -use MOM_io, only : slasher, MOM_read_data, vardesc, var_desc -use cvmix_tidal, only : cvmix_init_tidal, cvmix_compute_Simmons_invariant -use cvmix_tidal, only : cvmix_coeffs_tidal, cvmix_tidal_params_type -use cvmix_tidal, only : cvmix_compute_Schmittner_invariant, cvmix_compute_SchmittnerCoeff -use cvmix_kinds_and_types, only : cvmix_global_params_type -use cvmix_put_get, only : cvmix_put +use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field +use MOM_diag_mediator, only : safe_alloc_ptr, post_data +use MOM_diag_to_Z, only : diag_to_Z_CS, register_Zint_diag +use MOM_diag_to_Z, only : calc_Zint_diags +use MOM_EOS, only : calculate_density +use MOM_variables, only : thermo_var_ptrs, p3d +use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE +use MOM_debugging, only : hchksum +use MOM_grid, only : ocean_grid_type +use MOM_verticalGrid, only : verticalGrid_type +use MOM_remapping, only : remapping_CS, initialize_remapping, remapping_core_h +use MOM_file_parser, only : openParameterBlock, closeParameterBlock +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_string_functions, only : uppercase, lowercase +use MOM_io, only : slasher, MOM_read_data, vardesc, var_desc +use cvmix_tidal, only : cvmix_init_tidal, cvmix_compute_Simmons_invariant +use cvmix_tidal, only : cvmix_coeffs_tidal, cvmix_tidal_params_type +use cvmix_tidal, only : cvmix_compute_Schmittner_invariant, cvmix_compute_SchmittnerCoeff +use cvmix_kinds_and_types, only : cvmix_global_params_type +use cvmix_put_get, only : cvmix_put implicit none ; private @@ -136,6 +137,7 @@ module MOM_tidal_mixing type(cvmix_global_params_type) :: cvmix_glb_params ! for Prandtl number only real :: tidal_max_coef ! maximum allowable tidal diffusivity. [m^2/s] real :: tidal_diss_lim_tc ! dissipation limit for tidal-energy-constituent data + type(remapping_CS) :: remap_cs ! Data containers real, pointer, dimension(:,:) :: TKE_Niku => NULL() @@ -144,8 +146,9 @@ module MOM_tidal_mixing real, pointer, dimension(:,:) :: mask_itidal => NULL() real, pointer, dimension(:,:) :: h2 => NULL() real, pointer, dimension(:,:) :: tideamp => NULL() ! RMS tidal amplitude (m/s) - real, allocatable ,dimension(:,:) :: tidal_qe_2d ! q*E(x,y) ! TODO: make this E(x,y) only - real, allocatable ,dimension(:,:,:) :: tidal_qe_3d_in ! q*E(x,y) ! TODO: make this E(x,y) only + real, allocatable, dimension(:) :: h_src ! tidal constituent input layer thickness + real, allocatable ,dimension(:,:) :: tidal_qe_2d ! q*E(x,y) ! TODO: make this E(x,y) only + real, allocatable ,dimension(:,:,:) :: tidal_qe_3d_in ! q*E(x,y) ! Diagnostics type(diag_ctrl), pointer :: diag => NULL() ! structure to regulate diagn output timing @@ -660,13 +663,15 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) real, dimension(SZK_(G)+1) :: vert_dep !< vertical deposition real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m) - - real, allocatable, dimension(:) :: Schmittner_coeff + real, dimension(SZK_(G)) :: tidal_qe_md !< Tidal dissipation energy interpolated from 3d input to model coordinates + real, dimension(SZK_(G)) :: Schmittner_coeff + real, dimension(SZK_(G)) :: h_m !< Cell thickness [m] real, allocatable, dimension(:,:) :: exp_hab_zetar integer :: i, k, is, ie real :: dh, hcorr, Simmons_coeff real, parameter :: rho_fw = 1000.0 ! fresh water density [kg/m^3] ! TODO: when coupled, get this from CESM (SHR_CONST_RHOFW) + real :: h_neglect, h_neglect_edge type(tidal_mixing_diags), pointer :: dd is = G%isc ; ie = G%iec @@ -743,7 +748,12 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) ! and cvmix_compute_SchmittnerCoeff low subroutines allocate(exp_hab_zetar(G%ke+1,G%ke+1)) - allocate(Schmittner_coeff(G%ke)) + if (GV%Boussinesq) then + h_neglect = GV%m_to_H*1.0e-30 ; h_neglect_edge = GV%m_to_H*1.0e-10 + else + h_neglect = GV%kg_m2_to_H*1.0e-30 ; h_neglect_edge = GV%kg_m2_to_H*1.0e-10 + endif + do i=is,ie @@ -751,9 +761,10 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) iFaceHeight = 0.0 ! BBL is all relative to the surface hcorr = 0.0 + h_m = h(i,j,:)*GV%H_to_m do k=1,G%ke ! cell center and cell bottom in meters (negative values in the ocean) - dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = h_m(k) ! Nominal thickness to use for increment dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness @@ -769,10 +780,14 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) zw = iFaceHeight, & CVmix_tidal_params_user = CS%cvmix_tidal_params) + ! remap from input z coordinate to model coordinate: + tidal_qe_md = 0.0 + call remapping_core_h(CS%remap_cs, G%ke, CS%h_src, CS%tidal_qe_3d_in(i,j,:), G%ke, h_m, tidal_qe_md) + ! form the Schmittner coefficient that is based on 3D q*E, which is formed from ! summing q_i*TidalConstituent_i over the number of constituents. call cvmix_compute_SchmittnerCoeff( nlev = G%ke, & - energy_flux = CS%tidal_qe_3d_in(i,j,:), & ! todo!!!: vertical interpolation + energy_flux = tidal_qe_md(:), & rho = rho_fw, & SchmittnerCoeff = Schmittner_coeff, & exp_hab_zetar = exp_hab_zetar, & @@ -1364,7 +1379,6 @@ subroutine read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS) CS%tidal_qe_2d = (CS%Gamma_itides) * tidal_energy_flux_2d deallocate(tidal_energy_flux_2d) case ('ER03') ! Egbert & Ray 2003 - if (.not. allocated(CS%tidal_qe_3d_in)) allocate(CS%tidal_qe_3d_in(isd:ied,jsd:jed,nz)) call read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) case default call MOM_error(FATAL, "read_tidal_energy: Unknown tidal energy file type.") @@ -1383,8 +1397,8 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) integer :: k, isd, ied, jsd, jed, nz real, parameter :: p33 = 1.0/3.0 real, dimension(SZK_(G)) :: & - z_t, & ! depth from surface to midpoint of input layer - z_w ! depth from surface to top of input layer + z_t, & ! depth from surface to midpoint of input layer [cm] + z_w ! depth from surface to top of input layer [cm] real, dimension(SZI_(G),SZJ_(G)) :: & tidal_qk1, & ! qk1 coefficient used in Schmittner & Egbert tidal_qo1 ! qo1 coefficient used in Schmittner & Egbert @@ -1396,13 +1410,17 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke + ! allocate CS variables associated with 3d tidal energy dissipation + if (.not. allocated(CS%tidal_qe_3d_in)) allocate(CS%tidal_qe_3d_in(isd:ied,jsd:jed,nz)) + if (.not. allocated(CS%h_src)) allocate(CS%h_src(nz)) + + ! allocate local variables allocate(tc_m2(isd:ied,jsd:jed,nz), & tc_s2(isd:ied,jsd:jed,nz), & tc_k1(isd:ied,jsd:jed,nz), & tc_o1(isd:ied,jsd:jed,nz) ) ! read in tidal constituents - ! (NOTE: input z coordinates may differ from the model coordinates, which is fine.) call MOM_read_data(tidal_energy_file, 'M2', tc_m2, G%domain) call MOM_read_data(tidal_energy_file, 'S2', tc_s2, G%domain) call MOM_read_data(tidal_energy_file, 'K1', tc_k1, G%domain) @@ -1410,8 +1428,6 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) call MOM_read_data(tidal_energy_file, 'z_t', z_t) call MOM_read_data(tidal_energy_file, 'z_w', z_w) - ! form tidal_qe_3d_in from weighted tidal constituents - CS%tidal_qe_3d_in = 0.0 where (abs(G%geoLatT(:,:)) < 30.0) tidal_qk1(:,:) = p33 @@ -1421,7 +1437,11 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) tidal_qo1(:,:) = 1.0 endwhere + CS%tidal_qe_3d_in = 0.0 do k=1,nz + ! input cell thickness + CS%h_src(k) = (z_t(k)-z_w(k))*2.0 *1e-2 + ! form tidal_qe_3d_in from weighted tidal constituents where (z_t(k) <= G%bathyT(:,:) .and. z_w(k) > CS%tidal_diss_lim_tc) CS%tidal_qe_3d_in(:,:,k) = p33*tc_m2(:,:,k) + p33*tc_s2(:,:,k) + & tidal_qk1*tc_k1(:,:,k) + tidal_qo1*tc_o1(:,:,k) @@ -1441,6 +1461,10 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) ! endwhere !enddo + ! initialize input remapping: + call initialize_remapping(CS%remap_cs, remapping_scheme="PPM_IH4", & + boundary_extrapolation=.false., check_remapping=CS%debug) + deallocate(tc_m2) deallocate(tc_s2) deallocate(tc_k1) @@ -1456,6 +1480,7 @@ subroutine tidal_mixing_end(CS) !TODO deallocate all the dynamically allocated members here ... if (allocated(CS%tidal_qe_2d)) deallocate(CS%tidal_qe_2d) if (allocated(CS%tidal_qe_3d_in)) deallocate(CS%tidal_qe_3d_in) + if (allocated(CS%h_src)) deallocate(CS%h_src) deallocate(CS%dd) deallocate(CS) From e0a23287c41b057ec4ff6b497d3710a2fcfe74a2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 20 Apr 2018 09:17:01 -0400 Subject: [PATCH 0110/1072] (*+) Corrected a bug setting rigidity from icebergs The code augmenting the rigidity due to icebergs used a mismatch of the minimum and maximum berg masses in the two directions. This has been corrected to use the minimum in both directions. Also, a double divide by a constant in setting the iceberg mass source due to frazil was changed to multiplication by the reciprocal of their product. Two new optional arguments, update_dyn and update_thermo, were added to update_ocean_model, although they are not yet used, and the initial comments describing update_ocean_model were partially cleaned up. All solutions in test cases are bitwise identical, but there can be answer changes if the icebergs are used and ICEBERGS_APPLY_RIGID_BOUNDARY is true. --- config_src/coupled_driver/ocean_model_MOM.F90 | 82 +++++++++---------- 1 file changed, 40 insertions(+), 42 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 1198509462..332a1dd7b4 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -449,38 +449,27 @@ end subroutine ocean_model_init !! 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) 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. -! This subroutine 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. - -! Arguments: Ice_ocean_boundary - A structure containing the various forcing -! fields coming from the ice. It is intent in. -! (inout) Ocean_state - A structure containing the internal ocean state. -! (out) Ocean_sfc - A structure containing all the publicly visible ocean -! surface fields after a coupling time step. -! (in) time_start_update - The time at the beginning of the update step. -! (in) Ocean_coupling_time_step - The amount of time over which to advance -! the ocean. - -! Note: although several types are declared intent(inout), this is to allow for -! the possibility of halo updates and to keep previously allocated memory. -! In practice, Ice_ocean_boundary is intent in, Ocean_state is private to -! this module and intent inout, and Ocean_sfc is intent out. + 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. + 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. + 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 @@ -499,6 +488,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & type(time_type) :: Time2 ! A temporary time. logical :: thermo_does_span_coupling ! If true, thermodynamic forcing spans ! multiple dynamic timesteps. + logical :: do_dyn, do_thermo logical :: step_thermo ! If true, take a thermodynamic step. integer :: secs, days integer :: is, ie, js, je @@ -518,6 +508,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 @@ -581,7 +574,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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%time,ocean_coupling_time_step,OS%waves) + call Update_Surface_Waves(OS%grid, OS%GV, OS%time, ocean_coupling_time_step, OS%waves) endif if (OS%nstep==0) then @@ -708,7 +701,9 @@ subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, density_ice, ! Arguments: ! (in) fluxes - A structure of surface fluxes that may be used. ! (in) G - The ocean's grid structure. - real :: fraz ! refreezing rate in kg m-2 s-1 + real :: fraz ! refreezing rate in kg m-2 s-1 + real :: I_dt_LHF ! The inverse of the timestep times the latent heat of fusion, in kg J-1 s-1. + real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed @@ -733,6 +728,8 @@ subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, density_ice, forces%rigidity_ice_v(:,:) = 0. endif + kv_rho_ice = kv_ice / density_ice + do j=jsd,jed ; do i=isd,ied if (G%areaT(i,j) > 0.0) & fluxes%frac_shelf_h(i,j) = fluxes%frac_shelf_h(i,j) + fluxes%area_berg(i,j) @@ -742,26 +739,27 @@ subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, density_ice, forces%frac_shelf_u(I,j) = 0.0 if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%dxdy_u(I,j) > 0.0)) & forces%frac_shelf_u(I,j) = forces%frac_shelf_u(I,j) + & - (((fluxes%area_berg(i,j)*G%areaT(i,j)) + (fluxes%area_berg(i+1,j)*G%areaT(i+1,j))) / & + (((fluxes%area_berg(i,j)*G%areaT(i,j)) + & + (fluxes%area_berg(i+1,j)*G%areaT(i+1,j))) / & (G%areaT(i,j) + G%areaT(i+1,j)) ) - !### Either the min here or the max below must be wrong, but is either right? -RWH - forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) +((kv_ice / density_ice) * & - min(fluxes%mass_berg(i,j), fluxes%mass_berg(i+1,j))) + forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + kv_rho_ice * & + min(fluxes%mass_berg(i,j), fluxes%mass_berg(i+1,j)) enddo ; enddo do J=jsd,jed-1 ; do i=isd,ied forces%frac_shelf_v(i,J) = 0.0 if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%dxdy_v(i,J) > 0.0)) & forces%frac_shelf_v(i,J) = forces%frac_shelf_v(i,J) + & - (((fluxes%area_berg(i,j)*G%areaT(i,j)) + (fluxes%area_berg(i,j+1)*G%areaT(i,j+1))) / & + (((fluxes%area_berg(i,j)*G%areaT(i,j)) + & + (fluxes%area_berg(i,j+1)*G%areaT(i,j+1))) / & (G%areaT(i,j) + G%areaT(i,j+1)) ) - !### Either the max here or the min above must be wrong, but is either right? -RWH - forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) +((kv_ice / density_ice) * & - max(fluxes%mass_berg(i,j), fluxes%mass_berg(i,j+1))) + forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + kv_rho_ice * & + min(fluxes%mass_berg(i,j), fluxes%mass_berg(i,j+1)) enddo ; enddo call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) !Zero'ing out other fluxes under the tabular icebergs if (berg_area_threshold >= 0.) then + I_dt_LHF = 1.0 / (time_step * latent_heat_fusion) do j=jsd,jed ; do i=isd,ied if (fluxes%frac_shelf_h(i,j) > berg_area_threshold) then !Only applying for ice shelf covering most of cell @@ -775,7 +773,7 @@ subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, density_ice, ! control structure for diagnostic purposes. if (associated(sfc_state%frazil)) then - fraz = sfc_state%frazil(i,j) / time_step / latent_heat_fusion + fraz = sfc_state%frazil(i,j) * I_dt_LHF if (associated(fluxes%evap)) fluxes%evap(i,j) = fluxes%evap(i,j) - fraz !CS%lprec(i,j)=CS%lprec(i,j) - fraz sfc_state%frazil(i,j) = 0.0 From 165a5eb6696bce7b0c35ed28495173157c7854cc Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 20 Apr 2018 08:46:31 -0600 Subject: [PATCH 0111/1072] Comment call diabatic_driver_end --- src/core/MOM.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 22dbb86b15..5eff86cdcd 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2901,7 +2901,8 @@ subroutine MOM_end(CS) call tracer_registry_end(CS%tracer_Reg) call tracer_flow_control_end(CS%tracer_flow_CSp) - if (associated(CS%diabatic_CSp)) call diabatic_driver_end(CS%diabatic_CSp) + ! GMM, the following is commented because it fails on Travis. + !if (associated(CS%diabatic_CSp)) call diabatic_driver_end(CS%diabatic_CSp) if (CS%offline_tracer_mode) call offline_transport_end(CS%offline_CSp) From 8e0debd7356d7fef7780b8d11a84780cfe12e12b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 21 Apr 2018 11:34:39 -0400 Subject: [PATCH 0112/1072] Corrected openMP calls in MOM_KPP.F90 MOM_KPP.F90 would not compile if openMP is used, due to oversights in a recent update. This has now been fixed. All answers are bitwise identical. --- src/parameterizations/vertical/MOM_KPP.F90 | 21 +++++---------------- 1 file changed, 5 insertions(+), 16 deletions(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 26dc241dd6..db1cc9835e 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -621,20 +621,9 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & if (CS%id_Kd_in > 0) call post_data(CS%id_Kd_in, Kt, CS%diag) -!$OMP parallel do default(none) shared(G,GV,CS,EOS,uStar,Temp,Salt,u,v,h,GoRho, & -!$OMP buoyFlux, nonLocalTransHeat, & -!$OMP nonLocalTransScalar,Kt,Ks,Kv) & -!$OMP firstprivate(nonLocalTrans) & -!$OMP private(Coriolis,surfFricVel,SLdepth_0d,hTot,surfTemp, & -!$OMP surfHtemp,surfSalt,surfHsalt,surfU, & -!$OMP surfHu,surfV,surfHv,iFaceHeight, & -!$OMP pRef,km1,cellHeight,Uk,Vk,deltaU2, & -!$OMP rho1,rhoK,rhoKm1,deltaRho,N2_1d,N_1d,delH, & -!$OMP surfBuoyFlux,Ws_1d,Vt2_1d,BulkRi_1d, & -!$OMP OBLdepth_0d,zBottomMinusOffset,Kdiffusivity, & -!$OMP Kviscosity,sigma,kOBL,kk,pres_1D,Temp_1D, & -!$OMP Salt_1D,rho_1D,surfBuoyFlux2,ksfc,dh,hcorr) - + !$OMP parallel do default(private) firstprivate(nonLocalTrans) & + !$OMP shared(G,GV,CS,EOS,uStar,Temp,Salt,u,v,h,GoRho,Waves,& + !$OMP buoyFlux,nonLocalTransHeat,nonLocalTransScalar,Kt,Ks,Kv) ! loop over horizontal points on processor do j = G%jsc, G%jec do i = G%isc, G%iec @@ -1211,7 +1200,7 @@ subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, & dtracer(:,:,:) = 0.0 -!$OMP parallel do default(none) shared(G,GV,dtracer,nonLocalTrans,h,surfFlux,CS,scalar,dt) + !$OMP parallel do default(shared) do k = 1, G%ke do j = G%jsc, G%jec do i = G%isc, G%iec @@ -1269,7 +1258,7 @@ subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, dtracer(:,:,:) = 0.0 -!$OMP parallel do default(none) shared(G,GV,dtracer,nonLocalTrans,h,surfFlux,CS,scalar,dt) + !$OMP parallel do default(shared) do k = 1, G%ke do j = G%jsc, G%jec do i = G%isc, G%iec From 17a28a64f42b51345de6da5d46dacb2a865765f8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 21 Apr 2018 11:35:20 -0400 Subject: [PATCH 0113/1072] Corrected openMP calls in vertvisc MOM_vert_friction.F90 would not compile if openMP is used, due to oversights in a recent update. This has now been fixed. Also compacted some logically connected loops. All answers are bitwise identical. --- .../vertical/MOM_vert_friction.F90 | 80 +++++-------------- 1 file changed, 21 insertions(+), 59 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 2bb0b30206..92b661c1bc 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -162,7 +162,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & real, optional, intent(out), dimension(SZI_(G),SZJB_(G)) :: tauy_bot type(wave_parameters_CS), pointer, optional :: Waves !< Container for wave/Stokes information - ! Fields from fluxes used in this subroutine: + ! Fields from forces used in this subroutine: ! taux: Zonal wind stress in Pa. ! tauy: Meridional wind stress in Pa. @@ -229,29 +229,17 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & do k=1,nz ; do i=Isq,Ieq ; Ray(i,k) = 0.0 ; enddo ; enddo - ! Update the zonal velocity component using a modification of a standard ! tridagonal solver. ! When mixing down Eulerian current + Stokes drift add before calling solver - if (DoStokesMixing ) then - do j=G%jsc,G%jec - do I=Isq,Ieq - if (G%mask2dCu(I,j) > 0) then - do k=1,nz - u(i,j,k) = u(i,j,k) + Waves%Us_x(i,j,k) - enddo - endif - enddo - enddo - endif + if (DoStokesMixing) then ; do k=1,nz ; do j=G%jsc,G%jec ; do I=Isq,Ieq + if (G%mask2dCu(I,j) > 0) u(I,j,k) = u(I,j,k) + Waves%Us_x(I,j,k) + enddo ; enddo ; enddo ; endif -!$OMP parallel do default(none) shared(G,Isq,Ieq,ADp,nz,u,CS,dt_Rho0,fluxes,h, & -!$OMP h_neglect,Hmix,I_Hmix,visc,dt_m_to_H, & -!$OMP Idt,taux_bot,Rho0) & -!$OMP firstprivate(Ray) & -!$OMP private(do_i,surface_stress,zDS,stress,h_a,hfr, & -!$OMP b_denom_1,b1,d1,c1) + !$OMP parallel do default(shared) firstprivate(Ray) & + !$OMP private(do_i,surface_stress,zDS,stress,h_a,hfr, & + !$OMP b_denom_1,b1,d1,c1) do j=G%jsc,G%jec do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo @@ -345,38 +333,20 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & enddo ! end u-component j loop ! When mixing down Eulerian current + Stokes drift subtract after calling solver - if (DoStokesMixing ) then - do j=G%jsc,G%jec - do I=Isq,Ieq - if (G%mask2dCu(I,j) > 0) then - do k=1,nz - u(i,j,k) = u(i,j,k) - Waves%Us_x(i,j,k) - enddo - endif - enddo - enddo - endif + if (DoStokesMixing) then ; do k=1,nz ; do j=G%jsc,G%jec ; do I=Isq,Ieq + if (G%mask2dCu(I,j) > 0) u(I,j,k) = u(I,j,k) - Waves%Us_x(I,j,k) + enddo ; enddo ; enddo ; endif ! Now work on the meridional velocity component. ! When mixing down Eulerian current + Stokes drift add before calling solver - if (DoStokesMixing ) then - do j=Jsq,Jeq - do I=Is,Ie - if (G%mask2dCv(I,j) > 0) then - do k=1,nz - v(i,j,k) = v(i,j,k) + Waves%Us_y(i,j,k) - enddo - endif - enddo - enddo - endif - -!$OMP parallel do default(none) shared(G,Jsq,Jeq,ADp,nz,v,CS,dt_Rho0,fluxes,h, & -!$OMP Hmix,I_Hmix,visc,dt_m_to_H,Idt,Rho0, & -!$OMP tauy_bot,is,ie) & -!$OMP firstprivate(Ray) & -!$OMP private(do_i,surface_stress,zDS,stress,h_a,hfr, & -!$OMP b_denom_1,b1,d1,c1) + if (DoStokesMixing) then ; do k=1,nz ; do j=Jsq,Jeq ; do I=Is,Ie + if (G%mask2dCv(I,j) > 0) & + v(i,j,k) = v(i,j,k) + Waves%Us_y(i,j,k) + enddo ; enddo ; enddo ; endif + + !$OMP parallel do default(shared) firstprivate(Ray) & + !$OMP private(do_i,surface_stress,zDS,stress,h_a,hfr, & + !$OMP b_denom_1,b1,d1,c1) do J=Jsq,Jeq do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0) ; enddo @@ -444,17 +414,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & enddo ! end of v-component J loop ! When mixing down Eulerian current + Stokes drift subtract after calling solver - if (DoStokesMixing ) then - do j=Jsq,Jeq - do I=Is,Ie - if (G%mask2dCv(I,j) > 0) then - do k=1,nz - v(i,j,k) = v(i,j,k) - Waves%Us_y(i,j,k) - enddo - endif - enddo - enddo - endif + if (DoStokesMixing) then ; do k=1,nz ; do J=Jsq,Jeq ; do i=Is,Ie + if (G%mask2dCv(i,J) > 0) v(i,J,k) = v(i,J,k) - Waves%Us_y(i,J,k) + enddo ; enddo ; enddo ; endif call vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, CS) From 5312ee1edbbd6036e789fe05bd9a7d46d94e961d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 21 Apr 2018 11:35:50 -0400 Subject: [PATCH 0114/1072] Reordered initialize_ALE_sponge_fixed declarations Reordered argument declarations for initialize_ALE_sponge_fixed to avoid errors that can arise in size declarations with some compilers. All answers are bitwise identical. --- src/parameterizations/vertical/MOM_ALE_sponge.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index e7fe81dbd8..e42601d51b 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -115,11 +115,11 @@ module MOM_ALE_sponge subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_data) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). + integer, intent(in) :: nz_data !< The total number of sponge input layers (in). real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time, in s-1 (in). type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for model parameter values (in). type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control structure for this module (in/out). real, dimension(SZI_(G),SZJ_(G),nz_data), intent(in) :: data_h !< The thicknesses of the sponge input layers. (in). - integer, intent(in) :: nz_data !< The total number of sponge input layers (in). ! This include declares and sets the variable "version". From 1efd1f9ce6542925daed783ccc52236b34f79230 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 21 Apr 2018 11:36:39 -0400 Subject: [PATCH 0115/1072] +Add optional arg salt to allocate_forcing_type Added optional salt argument to allocate_forcing_type to cause fluxes%salt_flux to be allocated and initialized to 0. All answers are bitwise identical. --- src/core/MOM_forcing_type.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 26e64daaa8..7ac8b79f84 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -2496,7 +2496,7 @@ end subroutine forcing_diagnostics !> Conditionally allocate fields within the forcing type -subroutine allocate_forcing_type(G, fluxes, water, heat, ustar, press, shelf, iceberg) +subroutine allocate_forcing_type(G, fluxes, water, heat, ustar, press, shelf, iceberg, salt) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(forcing), intent(inout) :: fluxes !< Forcing fields structure logical, optional, intent(in) :: water !< If present and true, allocate water fluxes @@ -2505,6 +2505,7 @@ subroutine allocate_forcing_type(G, fluxes, water, heat, ustar, press, shelf, ic logical, optional, intent(in) :: press !< If present and true, allocate p_surf and related fields logical, optional, intent(in) :: shelf !< If present and true, allocate fluxes for ice-shelf logical, optional, intent(in) :: iceberg !< If present and true, allocate fluxes for icebergs + logical, optional, intent(in) :: salt !< If present and true, allocate salt fluxes ! Local variables integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -2535,6 +2536,8 @@ subroutine allocate_forcing_type(G, fluxes, water, heat, ustar, press, shelf, ic call myAlloc(fluxes%latent_fprec_diag,isd,ied,jsd,jed, heat) call myAlloc(fluxes%latent_frunoff_diag,isd,ied,jsd,jed, heat) + call myAlloc(fluxes%salt_flux,isd,ied,jsd,jed, salt) + if (present(heat) .and. present(water)) then ; if (heat .and. water) then call myAlloc(fluxes%heat_content_cond,isd,ied,jsd,jed, .true.) call myAlloc(fluxes%heat_content_lprec,isd,ied,jsd,jed, .true.) From 5579d26d89e30402202c0cc40792120a2e1ad105 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 21 Apr 2018 11:37:27 -0400 Subject: [PATCH 0116/1072] +Allow DTBT recalculation interval to span steps Added code to recalculate DTBT at a regular interval that may span forcing timesteps. Also added DTBT to the list of fields saved in the restart files. With this change, there is one fewer argument to step_MOM_dynamics, and there is one additional argument to barotropic_init and initialize_dyn_split_RK2. All answers are bitwise identical. --- src/core/MOM.F90 | 61 +++++++++++++++---------- src/core/MOM_barotropic.F90 | 70 ++++++++++++++++++----------- src/core/MOM_dynamics_split_RK2.F90 | 6 ++- 3 files changed, 86 insertions(+), 51 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 61324733a6..ba4ff2c5a6 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -43,7 +43,7 @@ module MOM use MOM_state_initialization, only : MOM_initialize_state use MOM_time_manager, only : time_type, set_time, time_type_to_real, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) -use MOM_time_manager, only : increment_date +use MOM_time_manager, only : operator(>=), increment_date use MOM_unit_tests, only : unit_tests use coupler_types_mod, only : coupler_type_send_data, coupler_1d_bc_type, coupler_type_spawn @@ -203,7 +203,6 @@ module MOM !! This is intended for running MOM6 in offline tracer mode type(time_type), pointer :: Time !< pointer to ocean clock - real :: rel_time = 0.0 !< relative time (sec) since start of current execution real :: dt !< (baroclinic) dynamics time step (seconds) real :: dt_therm !< thermodynamics time step (seconds) logical :: thermo_spans_coupling !< If true, thermodynamic and tracer time @@ -230,8 +229,8 @@ module MOM !! recalculation of the barotropic time step. If !! this is negative, it is never calculated, and !! if it is 0, it is calculated every step. - real :: dtbt_reset_time !< The last time (as indicated by CS%rel_time) when - !! DTBT was last calculated (sec) + type(time_type) :: dtbt_reset_interval !< A time_time representation of dtbt_reset_period. + type(time_type) :: dtbt_reset_time !< The next time DTBT should be calculated. type(time_type) :: Z_diag_interval !< amount of time between calculating Z-space diagnostics @@ -398,6 +397,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa real :: bbl_time_int ! The amount of time over which the calculated BBL ! properties will apply, for use in diagnostics, or 0 ! if it is not to be calculated anew (sec). + real :: rel_time = 0.0 ! relative time since start of this call (sec). logical :: calc_dtbt ! Indicates whether the dynamically adjusted ! barotropic time step needs to be updated. @@ -500,8 +500,6 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa call cpu_clock_end(id_clock_pass) endif - CS%rel_time = 0.0 - if (cycle_start) then if (ASSOCIATED(CS%tv%frazil)) CS%tv%frazil(:,:) = 0.0 if (ASSOCIATED(CS%tv%salt_deficit)) CS%tv%salt_deficit(:,:) = 0.0 @@ -546,12 +544,13 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa endif call cpu_clock_end(id_clock_other) + rel_time = 0.0 do n=1,n_max - CS%rel_time = CS%rel_time + dt ! The relative time at the end of the step. + rel_time = rel_time + dt ! The relative time at the end of the step. ! Set the universally visible time to the middle of the time step. - CS%Time = Time_start + set_time(int(floor(0.5 + CS%rel_time - 0.5*dt))) + CS%Time = Time_start + set_time(int(floor(0.5 + rel_time - 0.5*dt))) ! Set the local time to the end of the time step. - Time_local = Time_start + set_time(int(floor(CS%rel_time+0.5))) + Time_local = Time_start + set_time(int(floor(rel_time+0.5))) !### Update_Stokes_Drift must be behind a do_dyn or a do_thermo test. if (CS%UseWaves) then @@ -600,7 +599,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa if (showCallTree) call callTree_waypoint("finished diabatic_first (step_MOM)") if (dtdia > dt) & ! Reset CS%Time to its previous value. - CS%Time = Time_start + set_time(int(floor(0.5 + CS%rel_time - 0.5*dt))) + CS%Time = Time_start + set_time(int(floor(0.5 + rel_time - 0.5*dt))) endif ! end of block "(CS%diabatic_first .and. (CS%t_dyn_rel_adv==0.0))" if (do_dyn) then @@ -650,7 +649,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa call step_MOM_dynamics(forces, CS%p_surf_begin, CS%p_surf_end, dt, & dt_therm_here, bbl_time_int, CS, & - Time_local, CS%rel_time, n, WAVES=Waves) + Time_local, n, WAVES=Waves) !=========================================================================== ! This is the start of the tracer advection part of the algorithm. @@ -689,7 +688,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa CS%t_dyn_rel_thermo = 0.0 if (dtdia > dt) & ! Reset CS%Time to its previous value. - CS%Time = Time_start + set_time(int(floor(0.5 + CS%rel_time - 0.5*dt))) + CS%Time = Time_start + set_time(int(floor(0.5 + rel_time - 0.5*dt))) endif if (do_dyn) then @@ -796,7 +795,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa end subroutine step_MOM subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & - bbl_time_int, CS, Time_local, rel_time, dyn_call, WAVES) + bbl_time_int, CS, Time_local, dyn_call, WAVES) type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to the surface !! pressure at the beginning of this dynamic @@ -812,8 +811,6 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & !! in s, or zero not to update the properties. type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM type(time_type), intent(in) :: Time_local !< Starting time of a segment, as a time type - real, intent(in) :: rel_time !< Relative time since the start of the current - !! time-stepping cycle, in s. integer, intent(in) :: dyn_call !< A count of the calls to step_MOM_dynamics !! within this forcing timestep. type(wave_parameters_CS), pointer, intent(in), optional :: & @@ -829,8 +826,8 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & v, & ! v : meridional velocity component (m/s) h ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) - logical :: calc_dtbt ! Indicates whether the dynamically adjusted - ! barotropic time step needs to be updated. + logical :: calc_dtbt ! Indicates whether the dynamically adjusted + ! barotropic time step needs to be updated. logical :: showCallTree integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz @@ -882,11 +879,13 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & ! basically the stacked shallow water equations with viscosity. calc_dtbt = .false. - if ((CS%dtbt_reset_period >= 0.0) .and. & - ((dyn_call==1) .or. (CS%dtbt_reset_period == 0.0) .or. & - (rel_time >= CS%dtbt_reset_time + 0.999*CS%dtbt_reset_period))) then - calc_dtbt = .true. - CS%dtbt_reset_time = rel_time + if (CS%dtbt_reset_period == 0.0) calc_dtbt = .true. + if (CS%dtbt_reset_period > 0.0) then + if (Time_local >= CS%dtbt_reset_time) then + calc_dtbt = .true. + CS%dtbt_reset_time = CS%dtbt_reset_time + CS%dtbt_reset_interval + endif + if (dyn_call==1) then ; calc_dtbt = .true. ; endif endif call step_MOM_dyn_split_RK2(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, & @@ -1483,6 +1482,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! of having the data domain on each processor start at 1. logical :: bathy_at_vel ! If true, also define bathymetric fields at the ! the velocity points. + logical :: calc_dtbt ! Indicates whether the dynamically adjusted barotropic + ! time step needs to be updated before it is used. logical :: debug_truncations ! If true, turn on diagnostics useful for debugging truncations. integer :: first_direction ! An integer that indicates which direction is to be ! updated first in directionally split parts of the @@ -1686,7 +1687,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (CS%split) then call get_param(param_file, "MOM", "DTBT", dtbt, default=-0.98) default_val = CS%dt_therm ; if (dtbt > 0.0) default_val = -1.0 - CS%dtbt_reset_period = -1.0 ; CS%dtbt_reset_time = 0.0 + CS%dtbt_reset_period = -1.0 call get_param(param_file, "MOM", "DTBT_RESET_PERIOD", CS%dtbt_reset_period, & "The period between recalculations of DTBT (if DTBT <= 0). \n"//& "If DTBT_RESET_PERIOD is negative, DTBT is set based \n"//& @@ -2194,7 +2195,19 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & G, GV, param_file, diag, CS%dyn_split_RK2_CSp, restart_CSp, & CS%dt, CS%ADp, CS%CDp, MOM_internal_state, CS%VarMix, CS%MEKE, & CS%OBC, CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, & - CS%visc, dirs, CS%ntrunc) + CS%visc, dirs, CS%ntrunc, calc_dtbt=calc_dtbt) + if (CS%dtbt_reset_period > 0.0) then + CS%dtbt_reset_interval = set_time(int(floor(CS%dtbt_reset_period))) + ! Set dtbt_reset_time to be the next even multiple of dtbt_reset_interval. + CS%dtbt_reset_time = Time_init + CS%dtbt_reset_interval * & + ((Time - Time_init) / CS%dtbt_reset_interval) + if ((CS%dtbt_reset_time > Time) .and. calc_dtbt) then + ! Back up dtbt_reset_time one interval to force dtbt to be calculated, + ! because the restart was not aligned with the interval to recalculate + ! dtbt, and dtbt was not read from a restart file. + CS%dtbt_reset_time = CS%dtbt_reset_time - CS%dtbt_reset_interval + endif + endif elseif (CS%use_RK2) then call initialize_dyn_unsplit_RK2(CS%u, CS%v, CS%h, Time, G, GV, & param_file, diag, CS%dyn_unsplit_RK2_CSp, restart_CSp, & diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 67103b5d0e..ac95185d54 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -3799,26 +3799,34 @@ end subroutine bt_mass_source !! barotropic calculation and initializes any barotropic fields that have not !! already been initialized. subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & - restart_CS, BT_cont, tides_CSp) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, intent(in), dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u !< The zonal velocity, in m s-1. - real, intent(in), dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v !< The meridional velocity, in m s-1. - real, intent(in), dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h !< Layer thicknesses, in H (usually m or kg m-2). - real, intent(in), dimension(SZI_(G),SZJ_(G)) :: eta !< Free surface height or column mass anomaly, in - !! m or kg m-2. - type(time_type), target, intent(in) :: Time !< The current model time. - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. - type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic - !! output. - type(barotropic_CS), pointer :: CS !< A pointer to the control structure for this module - !! that is set in register_barotropic_restarts. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. - type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe the - !! effective open face areas as a function of - !! barotropic flow. - type(tidal_forcing_CS), optional, pointer :: tides_CSp !< A pointer to the control structure of the tide - !! module. + restart_CS, calc_dtbt, BT_cont, tides_CSp) + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: u !< The zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: v !< The meridional velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: eta !< Free surface height or column mass anomaly, in + !! m or kg m-2. + type(time_type), target, intent(in) :: Time !< The current model time. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. + type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic + !! output. + type(barotropic_CS), pointer :: CS !< A pointer to the control structure for this module + !! that is set in register_barotropic_restarts. + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + logical, intent(out) :: calc_dtbt !< If true, the barotropic time step must + !! be recalculated before stepping. + type(BT_cont_type), optional, & + pointer :: BT_cont !< A structure with elements that describe the + !! effective open face areas as a function of + !! barotropic flow. + type(tidal_forcing_CS), optional, & + pointer :: tides_CSp !< A pointer to the control structure of the + !! tide module. ! This include declares and sets the variable "version". #include "version_variable.h" @@ -3828,7 +3836,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & real :: gtot_estimate ! Summing GV%g_prime gives an upper-bound estimate for pbce. real :: SSH_extra ! An estimate of how much higher SSH might get, for use ! in calculating the safe external wave speed. - real :: dtbt_input + real :: dtbt_input, dtbt_tmp real :: wave_drag_scale ! A scaling factor for the barotropic linear wave drag ! piston velocities. character(len=200) :: inputdir ! The directory in which to find input files. @@ -4082,7 +4090,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & "gravity waves) to 1 (for a backward Euler treatment). \n"//& "In practice, BEBT must be greater than about 0.05.", & units="nondim", default=0.1) - call get_param(param_file, mdl, "DTBT", CS%dtbt, & + call get_param(param_file, mdl, "DTBT", dtbt_input, & "The barotropic time step, in s. DTBT is only used with \n"//& "the split explicit time stepping. To set the time step \n"//& "automatically based the maximum stable value use 0, or \n"//& @@ -4239,13 +4247,22 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & endif endif + CS%dtbt_fraction = 0.98 ; if (dtbt_input < 0.0) CS%dtbt_fraction = -dtbt_input + + dtbt_tmp = -1.0 + if (query_initialized(CS%dtbt, "DTBT", restart_CS)) dtbt_tmp = CS%dtbt + ! Estimate the maximum stable barotropic time step. - dtbt_input = CS%dtbt - CS%dtbt_fraction = 0.98 ; if (CS%dtbt < 0.0) CS%dtbt_fraction = -CS%dtbt gtot_estimate = 0.0 do k=1,G%ke ; gtot_estimate = gtot_estimate + GV%g_prime(K) ; enddo call set_dtbt(G, GV, CS, gtot_est = gtot_estimate, SSH_add = SSH_extra) - if (dtbt_input > 0.0) CS%dtbt = dtbt_input + + if (dtbt_input > 0.0) then + CS%dtbt = dtbt_input + elseif (dtbt_tmp > 0.0) then + CS%dtbt = dtbt_tmp + endif + if ((dtbt_tmp > 0.0) .and. (dtbt_input > 0.0)) calc_dtbt = .false. call log_param(param_file, mdl, "DTBT as used", CS%dtbt) call log_param(param_file, mdl, "estimated maximum DTBT", CS%dtbt_max) @@ -4525,6 +4542,9 @@ subroutine register_barotropic_restarts(HI, GV, param_file, CS, restart_CS) call register_restart_field(CS%uhbt_IC, vd(2), .false., restart_CS) call register_restart_field(CS%vhbt_IC, vd(3), .false., restart_CS) + call register_restart_field(CS%dtbt, "DTBT", .false., restart_CS, & + longname="Barotropic timestep", units="seconds") + end subroutine register_barotropic_restarts end module MOM_barotropic diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index e7ec5971b0..6735e35063 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -914,7 +914,7 @@ end subroutine register_restarts_dyn_split_RK2 subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_file, & diag, CS, restart_CS, dt, Accel_diag, Cont_diag, MIS, & VarMix, MEKE, OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & - visc, dirs, ntrunc) + visc, dirs, ntrunc, calc_dtbt) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity (m/s) @@ -942,6 +942,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil type(directories), intent(in) :: dirs !< contains directory paths integer, target, intent(inout) :: ntrunc !< A target for the variable that records the number of times !! the velocity is truncated (this should be 0). + logical, intent(out) :: calc_dtbt !< If true, recalculate the barotropic time step real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_tmp character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. @@ -1074,7 +1075,8 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil do j=js,je ; do i=is,ie ; eta(i,j) = CS%eta(i,j) ; enddo ; enddo call barotropic_init(u, v, h, CS%eta, Time, G, GV, param_file, diag, & - CS%barotropic_CSp, restart_CS, CS%BT_cont, CS%tides_CSp) + CS%barotropic_CSp, restart_CS, calc_dtbt, CS%BT_cont, & + CS%tides_CSp) if (.not. query_initialized(CS%diffu,"diffu",restart_CS) .or. & .not. query_initialized(CS%diffv,"diffv",restart_CS)) & From a680bf74bc51f904598751f7a3231d069f5d7899 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 23 Apr 2018 05:51:13 -0400 Subject: [PATCH 0117/1072] (*)Do not recalculate DTBT every coupled timestep Eliminated the requirement to recalculate DTBT every coupled timestep. By default, this still happens, but explicitly setting DTBT_RESET_PERIOD to be longer than the coupled timestep now results in less frequent updates to DTBT. Also modified the log_param documentation of DTBT_RESET_PERIOD to reflect this new behavior. This could change answers, but it just happens that the values of DTBT are not changed with the existing suite of test cases. The MOM_parameter_doc files are altered by this change. --- src/core/MOM.F90 | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index ba4ff2c5a6..c85777188f 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -649,7 +649,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa call step_MOM_dynamics(forces, CS%p_surf_begin, CS%p_surf_end, dt, & dt_therm_here, bbl_time_int, CS, & - Time_local, n, WAVES=Waves) + Time_local, WAVES=Waves) !=========================================================================== ! This is the start of the tracer advection part of the algorithm. @@ -795,7 +795,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa end subroutine step_MOM subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & - bbl_time_int, CS, Time_local, dyn_call, WAVES) + bbl_time_int, CS, Time_local, WAVES) type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to the surface !! pressure at the beginning of this dynamic @@ -811,8 +811,6 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & !! in s, or zero not to update the properties. type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM type(time_type), intent(in) :: Time_local !< Starting time of a segment, as a time type - integer, intent(in) :: dyn_call !< A count of the calls to step_MOM_dynamics - !! within this forcing timestep. type(wave_parameters_CS), pointer, intent(in), optional :: & WAVES ! 0.0)) endif From a268e5f22d54972a45429fde3289e6859e786554 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 23 Apr 2018 10:09:08 -0400 Subject: [PATCH 0118/1072] Removed white space in a blank line --- src/core/MOM_barotropic.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index ac95185d54..5b5ab92869 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -4248,7 +4248,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & endif CS%dtbt_fraction = 0.98 ; if (dtbt_input < 0.0) CS%dtbt_fraction = -dtbt_input - + dtbt_tmp = -1.0 if (query_initialized(CS%dtbt, "DTBT", restart_CS)) dtbt_tmp = CS%dtbt From 648f31b85a975969e877c0b4b6da2ed8c0e5db43 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 23 Apr 2018 09:24:34 -0600 Subject: [PATCH 0119/1072] Replace cvmix with CVMix --- .../MOM_state_initialization.F90 | 6 +- ...{MOM_cvmix_conv.F90 => MOM_CVMix_conv.F90} | 74 +++++----- ...OM_cvmix_shear.F90 => MOM_CVMix_shear.F90} | 70 ++++----- src/parameterizations/vertical/MOM_KPP.F90 | 138 +++++++++--------- .../vertical/MOM_bkgnd_mixing.F90 | 14 +- .../vertical/MOM_diabatic_driver.F90 | 32 ++-- .../vertical/MOM_set_diffusivity.F90 | 24 +-- .../vertical/MOM_set_viscosity.F90 | 18 +-- .../vertical/MOM_tidal_mixing.F90 | 74 +++++----- src/user/SCM_CVmix_tests.F90 | 72 ++++----- 10 files changed, 261 insertions(+), 261 deletions(-) rename src/parameterizations/vertical/{MOM_cvmix_conv.F90 => MOM_CVMix_conv.F90} (82%) rename src/parameterizations/vertical/{MOM_cvmix_shear.F90 => MOM_CVMix_shear.F90} (84%) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 7bb99a8d24..858713002b 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -77,7 +77,7 @@ module MOM_state_initialization use Rossby_front_2d_initialization, only : Rossby_front_initialize_temperature_salinity use Rossby_front_2d_initialization, only : Rossby_front_initialize_velocity use SCM_idealized_hurricane, only : SCM_idealized_hurricane_TS_init -use SCM_CVmix_tests, only: SCM_CVmix_tests_TS_init +use SCM_CVMix_tests, only: SCM_CVMix_tests_TS_init use dyed_channel_initialization, only : dyed_channel_set_OBC_tracer_data use dyed_obcs_initialization, only : dyed_obcs_set_OBC_data use supercritical_initialization, only : supercritical_set_OBC_data @@ -336,7 +336,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & " \t dumbbell - sloshing channel ICs. \n"//& " \t rossby_front - a mixed layer front in thermal wind balance.\n"//& " \t SCM_ideal_hurr - used in the SCM idealized hurricane test.\n"//& - " \t SCM_CVmix_tests - used in the SCM CVmix tests.\n"//& + " \t SCM_CVMix_tests - used in the SCM CVMix tests.\n"//& " \t USER - call a user modified routine.", & fail_if_missing=new_sim, do_not_log=just_read) ! " \t baroclinic_zone - an analytic baroclinic zone. \n"//& @@ -369,7 +369,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & tv%S, h, G, GV, PF, eos, just_read_params=just_read) case ("SCM_ideal_hurr"); call SCM_idealized_hurricane_TS_init ( tv%T, & tv%S, h, G, GV, PF, just_read_params=just_read) - case ("SCM_CVmix_tests"); call SCM_CVmix_tests_TS_init (tv%T, & + case ("SCM_CVMix_tests"); call SCM_CVMix_tests_TS_init (tv%T, & tv%S, h, G, GV, PF, just_read_params=just_read) case ("dense"); call dense_water_initialize_TS(G, GV, PF, eos, tv%T, tv%S, & h, just_read_params=just_read) diff --git a/src/parameterizations/vertical/MOM_cvmix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 similarity index 82% rename from src/parameterizations/vertical/MOM_cvmix_conv.F90 rename to src/parameterizations/vertical/MOM_CVMix_conv.F90 index 2be06ee14b..4b422ccf9a 100644 --- a/src/parameterizations/vertical/MOM_cvmix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -1,5 +1,5 @@ !> Interface to CVMix convection scheme. -module MOM_cvmix_conv +module MOM_CVMix_conv ! This file is part of MOM6. See LICENSE.md for the license. @@ -13,17 +13,17 @@ module MOM_cvmix_conv use MOM_grid, only : ocean_grid_type use MOM_verticalGrid, only : verticalGrid_type use MOM_file_parser, only : get_param, log_version, param_file_type -use cvmix_convection, only : cvmix_init_conv, cvmix_coeffs_conv -use cvmix_kpp, only : CVmix_kpp_compute_kOBL_depth +use CVMix_convection, only : CVMix_init_conv, CVMix_coeffs_conv +use CVMix_kpp, only : CVMix_kpp_compute_kOBL_depth implicit none ; private #include -public cvmix_conv_init, calculate_cvmix_conv, cvmix_conv_end, cvmix_conv_is_used +public CVMix_conv_init, calculate_CVMix_conv, CVMix_conv_end, CVMix_conv_is_used !> Control structure including parameters for CVMix convection. -type, public :: cvmix_conv_cs +type, public :: CVMix_conv_cs ! Parameters real :: kd_conv_const !< diffusivity constant used in convective regime (m2/s) @@ -42,21 +42,21 @@ module MOM_cvmix_conv real, allocatable, dimension(:,:,:) :: kd_conv !< Diffusivity added by convection (m2/s) real, allocatable, dimension(:,:,:) :: kv_conv !< Viscosity added by convection (m2/s) -end type cvmix_conv_cs +end type CVMix_conv_cs -character(len=40) :: mdl = "MOM_cvmix_conv" !< This module's name. +character(len=40) :: mdl = "MOM_CVMix_conv" !< This module's name. contains -!> Initialized the cvmix convection mixing routine. -logical function cvmix_conv_init(Time, G, GV, param_file, diag, CS) +!> Initialized the CVMix convection mixing routine. +logical function CVMix_conv_init(Time, G, GV, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current time. type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. - type(cvmix_conv_cs), pointer :: CS !< This module's control structure. + type(CVMix_conv_cs), pointer :: CS !< This module's control structure. ! Local variables real :: prandtl_conv !< Turbulent Prandtl number used in convective instabilities. @@ -66,7 +66,7 @@ logical function cvmix_conv_init(Time, G, GV, param_file, diag, CS) #include "version_variable.h" if (associated(CS)) then - call MOM_error(WARNING, "cvmix_conv_init called with an associated "// & + call MOM_error(WARNING, "CVMix_conv_init called with an associated "// & "control structure.") return endif @@ -75,14 +75,14 @@ logical function cvmix_conv_init(Time, G, GV, param_file, diag, CS) ! Read parameters call log_version(param_file, mdl, version, & "Parameterization of enhanced mixing due to convection via CVMix") - call get_param(param_file, mdl, "USE_CVMIX_CONVECTION", cvmix_conv_init, & + call get_param(param_file, mdl, "USE_CVMix_CONVECTION", CVMix_conv_init, & "If true, turns on the enhanced mixing due to convection \n"// & "via CVMix. This scheme increases diapycnal diffs./viscs. \n"// & " at statically unstable interfaces. Relevant parameters are \n"// & - "contained in the CVMIX_CONVECTION% parameter block.", & + "contained in the CVMix_CONVECTION% parameter block.", & default=.false.) - if (.not. cvmix_conv_init) return + if (.not. CVMix_conv_init) return call get_param(param_file, mdl, "ENERGETICS_SFC_PBL", useEPBL, default=.false., & do_not_log=.true.) @@ -90,7 +90,7 @@ logical function cvmix_conv_init(Time, G, GV, param_file, diag, CS) ! Warn user if EPBL is being used, since in this case mixing due to convection will ! be aplied in the boundary layer if (useEPBL) then - call MOM_error(WARNING, 'MOM_cvmix_conv_init: '// & + call MOM_error(WARNING, 'MOM_CVMix_conv_init: '// & 'CVMix convection may not be properly applied when ENERGETICS_SFC_PBL = True'//& 'as convective mixing might occur in the boundary layer.') endif @@ -99,7 +99,7 @@ logical function cvmix_conv_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, default=0.001, do_not_log=.True.) - call openParameterBlock(param_file,'CVMIX_CONVECTION') + call openParameterBlock(param_file,'CVMix_CONVECTION') call get_param(param_file, mdl, "PRANDTL_CONV", prandtl_conv, & "The turbulent Prandtl number applied to convective \n"//& @@ -129,28 +129,28 @@ logical function cvmix_conv_init(Time, G, GV, param_file, diag, CS) ! Register diagnostics CS%diag => diag CS%id_N2 = register_diag_field('ocean_model', 'N2_conv', diag%axesTi, Time, & - 'Square of Brunt-Vaisala frequency used by MOM_cvmix_conv module', '1/s2') + 'Square of Brunt-Vaisala frequency used by MOM_CVMix_conv module', '1/s2') CS%id_kd_conv = register_diag_field('ocean_model', 'kd_conv', diag%axesTi, Time, & - 'Additional diffusivity added by MOM_cvmix_conv module', 'm2/s') + 'Additional diffusivity added by MOM_CVMix_conv module', 'm2/s') CS%id_kv_conv = register_diag_field('ocean_model', 'kv_conv', diag%axesTi, Time, & - 'Additional viscosity added by MOM_cvmix_conv module', 'm2/s') + 'Additional viscosity added by MOM_CVMix_conv module', 'm2/s') - call cvmix_init_conv(convect_diff=CS%kd_conv_const, & + call CVMix_init_conv(convect_diff=CS%kd_conv_const, & convect_visc=CS%kv_conv_const, & lBruntVaisala=.true., & BVsqr_convect=CS%bv_sqr_conv) -end function cvmix_conv_init +end function CVMix_conv_init !> Subroutine for calculating enhanced diffusivity/viscosity !! due to convection via CVMix -subroutine calculate_cvmix_conv(h, tv, G, GV, CS, hbl) +subroutine calculate_CVMix_conv(h, tv, G, GV, CS, hbl) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. - type(cvmix_conv_cs), pointer :: CS !< The control structure returned + type(CVMix_conv_cs), pointer :: CS !< The control structure returned !! by a previous call to CVMix_conv_init. real, dimension(:,:), optional, pointer :: hbl!< Depth of ocean boundary layer (m) @@ -212,9 +212,9 @@ subroutine calculate_cvmix_conv(h, tv, G, GV, CS, hbl) iFaceHeight(k+1) = iFaceHeight(k) - dh enddo - kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl(i,j)) + kOBL = CVMix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl(i,j)) - call cvmix_coeffs_conv(Mdiff_out=CS%kv_conv(i,j,:), & + call CVMix_coeffs_conv(Mdiff_out=CS%kv_conv(i,j,:), & Tdiff_out=CS%kd_conv(i,j,:), & Nsqr=CS%N2(i,j,:), & dens=rho_1d(:), & @@ -233,9 +233,9 @@ subroutine calculate_cvmix_conv(h, tv, G, GV, CS, hbl) enddo if (CS%debug) then - call hchksum(CS%N2, "MOM_cvmix_conv: N2",G%HI,haloshift=0) - call hchksum(CS%kd_conv, "MOM_cvmix_conv: kd_conv",G%HI,haloshift=0) - call hchksum(CS%kv_conv, "MOM_cvmix_conv: kv_conv",G%HI,haloshift=0) + call hchksum(CS%N2, "MOM_CVMix_conv: N2",G%HI,haloshift=0) + call hchksum(CS%kd_conv, "MOM_CVMix_conv: kd_conv",G%HI,haloshift=0) + call hchksum(CS%kv_conv, "MOM_CVMix_conv: kv_conv",G%HI,haloshift=0) endif ! send diagnostics to post_data @@ -243,28 +243,28 @@ subroutine calculate_cvmix_conv(h, tv, G, GV, CS, hbl) if (CS%id_kd_conv > 0) call post_data(CS%id_kd_conv, CS%kd_conv, CS%diag) if (CS%id_kv_conv > 0) call post_data(CS%id_kv_conv, CS%kv_conv, CS%diag) -end subroutine calculate_cvmix_conv +end subroutine calculate_CVMix_conv -!> Reads the parameter "USE_CVMIX_CONVECTION" and returns state. +!> Reads the parameter "USE_CVMix_CONVECTION" and returns state. !! This function allows other modules to know whether this parameterization will !! be used without needing to duplicate the log entry. -logical function cvmix_conv_is_used(param_file) +logical function CVMix_conv_is_used(param_file) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - call get_param(param_file, mdl, "USE_CVMIX_CONVECTION", cvmix_conv_is_used, & + call get_param(param_file, mdl, "USE_CVMix_CONVECTION", CVMix_conv_is_used, & default=.false., do_not_log = .true.) -end function cvmix_conv_is_used +end function CVMix_conv_is_used !> Clear pointers and dealocate memory -subroutine cvmix_conv_end(CS) - type(cvmix_conv_cs), pointer :: CS ! Control structure +subroutine CVMix_conv_end(CS) + type(CVMix_conv_cs), pointer :: CS ! Control structure deallocate(CS%N2) deallocate(CS%kd_conv) deallocate(CS%kv_conv) deallocate(CS) -end subroutine cvmix_conv_end +end subroutine CVMix_conv_end -end module MOM_cvmix_conv +end module MOM_CVMix_conv diff --git a/src/parameterizations/vertical/MOM_cvmix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 similarity index 84% rename from src/parameterizations/vertical/MOM_cvmix_shear.F90 rename to src/parameterizations/vertical/MOM_CVMix_shear.F90 index 345522126b..f99a0d4dcb 100644 --- a/src/parameterizations/vertical/MOM_cvmix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -1,10 +1,10 @@ !> Interface to CVMix interior shear schemes -module MOM_cvmix_shear +module MOM_CVMix_shear ! This file is part of MOM6. See LICENSE.md for the license. !--------------------------------------------------- -! module MOM_cvmix_shear +! module MOM_CVMix_shear ! Author: Brandon Reichl ! Date: Aug 31, 2016 ! Purpose: Interface to CVMix interior shear schemes @@ -19,16 +19,16 @@ module MOM_cvmix_shear use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, EOS_type -use cvmix_shear, only : cvmix_init_shear, cvmix_coeffs_shear +use CVMix_shear, only : CVMix_init_shear, CVMix_coeffs_shear use MOM_kappa_shear, only : kappa_shear_is_used implicit none ; private #include -public calculate_cvmix_shear, cvmix_shear_init, cvmix_shear_is_used, cvmix_shear_end +public calculate_CVMix_shear, CVMix_shear_init, CVMix_shear_is_used, CVMix_shear_end !> Control structure including parameters for CVMix interior shear schemes. -type, public :: cvmix_shear_cs +type, public :: CVMix_shear_cs logical :: use_LMD94, use_PP81 !< Flags for various schemes real :: Ri_zero !< LMD94 critical Richardson number real :: Nu_zero !< LMD94 maximum interior diffusivity @@ -43,14 +43,14 @@ module MOM_cvmix_shear type(diag_ctrl), pointer :: diag => NULL() integer :: id_N2 = -1, id_S2 = -1, id_ri_grad = -1, id_kv = -1, id_kd = -1 -end type cvmix_shear_cs +end type CVMix_shear_cs -character(len=40) :: mdl = "MOM_cvmix_shear" !< This module's name. +character(len=40) :: mdl = "MOM_CVMix_shear" !< This module's name. contains !> Subroutine for calculating (internal) vertical diffusivities/viscosities -subroutine calculate_cvmix_shear(u_H, v_H, h, tv, kd, & +subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & kv, G, GV, CS ) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. @@ -62,7 +62,7 @@ subroutine calculate_cvmix_shear(u_H, v_H, h, tv, kd, & !! (not layer!) in m2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface !! (not layer!) in m2 s-1. - type(cvmix_shear_cs), pointer :: CS !< The control structure returned by a previous call to + type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous call to !! CVMix_shear_init. ! Local variables integer :: i, j, k, kk, km1 @@ -125,7 +125,7 @@ subroutine calculate_cvmix_shear(u_H, v_H, h, tv, kd, & enddo ! Call to CVMix wrapper for computing interior mixing coefficients. - call cvmix_coeffs_shear(Mdiff_out=kv(i,j,:), & + call CVMix_coeffs_shear(Mdiff_out=kv(i,j,:), & Tdiff_out=kd(i,j,:), & RICH=Ri_Grad, & nlev=G%ke, & @@ -140,20 +140,20 @@ subroutine calculate_cvmix_shear(u_H, v_H, h, tv, kd, & if (CS%id_S2 > 0) call post_data(CS%id_S2,CS%S2, CS%diag) if (CS%id_ri_grad > 0) call post_data(CS%id_ri_grad,CS%ri_grad, CS%diag) -end subroutine calculate_cvmix_shear +end subroutine calculate_CVMix_shear -!> Initialized the cvmix internal shear mixing routine. +!> Initialized the CVMix internal shear mixing routine. !! \note *This is where we test to make sure multiple internal shear !! mixing routines (including JHL) are not enabled at the same time. -!! (returns) cvmix_shear_init - True if module is to be used, False otherwise -logical function cvmix_shear_init(Time, G, GV, param_file, diag, CS) +!! (returns) CVMix_shear_init - True if module is to be used, False otherwise +logical function CVMix_shear_init(Time, G, GV, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current time. type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. - type(cvmix_shear_cs), pointer :: CS !< This module's control structure. + type(CVMix_shear_cs), pointer :: CS !< This module's control structure. ! Local variables integer :: NumberTrue=0 logical :: use_JHL @@ -161,7 +161,7 @@ logical function cvmix_shear_init(Time, G, GV, param_file, diag, CS) #include "version_variable.h" if (associated(CS)) then - call MOM_error(WARNING, "cvmix_shear_init called with an associated "// & + call MOM_error(WARNING, "CVMix_shear_init called with an associated "// & "control structure.") return endif @@ -189,14 +189,14 @@ logical function cvmix_shear_init(Time, G, GV, param_file, diag, CS) ! After testing for interior schemes, make sure only 0 or 1 are enabled. ! Otherwise, warn user and kill job. if ((NumberTrue).gt.1) then - call MOM_error(FATAL, 'MOM_cvmix_shear_init: '// & + call MOM_error(FATAL, 'MOM_CVMix_shear_init: '// & 'Multiple shear driven internal mixing schemes selected,'//& ' please disable all but one scheme to proceed.') endif - cvmix_shear_init=(CS%use_PP81.or.CS%use_LMD94) + CVMix_shear_init=(CS%use_PP81.or.CS%use_LMD94) ! Forego remainder of initialization if not using this scheme - if (.not. cvmix_shear_init) return + if (.not. CVMix_shear_init) return call get_param(param_file, mdl, "NU_ZERO", CS%Nu_Zero, & "Leading coefficient in KPP shear mixing.", & units="nondim", default=5.e-3) @@ -209,7 +209,7 @@ logical function cvmix_shear_init(Time, G, GV, param_file, diag, CS) "Exponent of unitless factor of diffusivities,"// & " for KPP internal shear mixing scheme." & ,units="nondim", default=3.0) - call cvmix_init_shear(mix_scheme=CS%mix_scheme, & + call CVMix_init_shear(mix_scheme=CS%mix_scheme, & KPP_nu_zero=CS%Nu_Zero, & KPP_Ri_zero=CS%Ri_zero, & KPP_exp=CS%KPP_exp) @@ -218,31 +218,31 @@ logical function cvmix_shear_init(Time, G, GV, param_file, diag, CS) CS%diag => diag CS%id_N2 = register_diag_field('ocean_model', 'N2_shear', diag%axesTi, Time, & - 'Square of Brunt-Vaisala frequency used by MOM_cvmix_shear module', '1/s2') + 'Square of Brunt-Vaisala frequency used by MOM_CVMix_shear module', '1/s2') if (CS%id_N2 > 0) & allocate( CS%N2( SZI_(G), SZJ_(G), SZK_(G)+1 ) );CS%N2(:,:,:) = 0. CS%id_S2 = register_diag_field('ocean_model', 'S2_shear', diag%axesTi, Time, & - 'Square of vertical shear used by MOM_cvmix_shear module','1/s2') + 'Square of vertical shear used by MOM_CVMix_shear module','1/s2') if (CS%id_S2 > 0) & allocate( CS%S2( SZI_(G), SZJ_(G), SZK_(G)+1 ) );CS%S2(:,:,:) = 0. CS%id_ri_grad = register_diag_field('ocean_model', 'ri_grad_shear', diag%axesTi, Time, & - 'Gradient Richarson number used by MOM_cvmix_shear module','nondim') + 'Gradient Richarson number used by MOM_CVMix_shear module','nondim') if (CS%id_ri_grad > 0) & !Initialize w/ large Richardson value allocate( CS%ri_grad( SZI_(G), SZJ_(G), SZK_(G)+1 ));CS%ri_grad(:,:,:) = 1.e8 - CS%id_kd = register_diag_field('ocean_model', 'kd_shear_cvmix', diag%axesTi, Time, & - 'Vertical diffusivity added by MOM_cvmix_shear module', 'm2/s') - CS%id_kv = register_diag_field('ocean_model', 'kv_shear_cvmix', diag%axesTi, Time, & - 'Vertical viscosity added by MOM_cvmix_shear module', 'm2/s') + CS%id_kd = register_diag_field('ocean_model', 'kd_shear_CVMix', diag%axesTi, Time, & + 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s') + CS%id_kv = register_diag_field('ocean_model', 'kv_shear_CVMix', diag%axesTi, Time, & + 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s') -end function cvmix_shear_init +end function CVMix_shear_init !> Reads the parameters "LMD94" and "PP81" and returns state. !! This function allows other modules to know whether this parameterization will !! be used without needing to duplicate the log entry. -logical function cvmix_shear_is_used(param_file) +logical function CVMix_shear_is_used(param_file) type(param_file_type), intent(in) :: param_file !< Run-time parameter files handle. ! Local variables logical :: LMD94, PP81 @@ -250,18 +250,18 @@ logical function cvmix_shear_is_used(param_file) default=.false., do_not_log = .true.) call get_param(param_file, mdl, "Use_PP81", PP81, & default=.false., do_not_log = .true.) - cvmix_shear_is_used = (LMD94 .or. PP81) -end function cvmix_shear_is_used + CVMix_shear_is_used = (LMD94 .or. PP81) +end function CVMix_shear_is_used !> Clear pointers and dealocate memory -subroutine cvmix_shear_end(CS) - type(cvmix_shear_cs), pointer :: CS ! Control structure +subroutine CVMix_shear_end(CS) + type(CVMix_shear_cs), pointer :: CS ! Control structure if (CS%id_N2 > 0) deallocate(CS%N2) if (CS%id_S2 > 0) deallocate(CS%S2) if (CS%id_ri_grad > 0) deallocate(CS%ri_grad) deallocate(CS) -end subroutine cvmix_shear_end +end subroutine CVMix_shear_end -end module MOM_cvmix_shear +end module MOM_CVMix_shear diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 6376358fea..697cc26125 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -14,14 +14,14 @@ module MOM_KPP use MOM_grid, only : ocean_grid_type, isPointInCell use MOM_verticalGrid, only : verticalGrid_type -use CVmix_kpp, only : CVmix_init_kpp, CVmix_put_kpp, CVmix_get_kpp_real -use CVmix_kpp, only : CVmix_coeffs_kpp -use CVmix_kpp, only : CVmix_kpp_compute_OBL_depth -use CVmix_kpp, only : CVmix_kpp_compute_turbulent_scales -use CVmix_kpp, only : CVmix_kpp_compute_bulk_Richardson -use CVmix_kpp, only : CVmix_kpp_compute_unresolved_shear -use CVmix_kpp, only : CVmix_kpp_params_type -use CVmix_kpp, only : CVmix_kpp_compute_kOBL_depth +use CVMix_kpp, only : CVMix_init_kpp, CVMix_put_kpp, CVMix_get_kpp_real +use CVMix_kpp, only : CVMix_coeffs_kpp +use CVMix_kpp, only : CVMix_kpp_compute_OBL_depth +use CVMix_kpp, only : CVMix_kpp_compute_turbulent_scales +use CVMix_kpp, only : CVMix_kpp_compute_bulk_Richardson +use CVMix_kpp, only : CVMix_kpp_compute_unresolved_shear +use CVMix_kpp, only : CVMix_kpp_params_type +use CVMix_kpp, only : CVMix_kpp_compute_kOBL_depth implicit none ; private @@ -35,7 +35,7 @@ module MOM_KPP public :: KPP_get_BLD ! Enumerated constants -integer, private, parameter :: NLT_SHAPE_CVMIX = 0 !< Use the CVmix profile +integer, private, parameter :: NLT_SHAPE_CVMix = 0 !< Use the CVMix profile integer, private, parameter :: NLT_SHAPE_LINEAR = 1 !< Linear, \f$ G(\sigma) = 1-\sigma \f$ integer, private, parameter :: NLT_SHAPE_PARABOLIC = 2 !< Parabolic, \f$ G(\sigma) = (1-\sigma)^2 \f$ integer, private, parameter :: NLT_SHAPE_CUBIC = 3 !< Cubic, \f$ G(\sigma) = 1 + (2\sigma-3) \sigma^2\f$ @@ -79,8 +79,8 @@ module MOM_KPP ! smg: obsolete above integer :: SW_METHOD ! CVmix parameters - type(CVmix_kpp_params_type), pointer :: KPP_params => NULL() + !> CVMix parameters + type(CVMix_kpp_params_type), pointer :: KPP_params => NULL() ! Diagnostic handles and pointers type(diag_ctrl), pointer :: diag => NULL() @@ -128,7 +128,7 @@ module MOM_KPP contains -!> Initialize the CVmix KPP module and set up diagnostics +!> Initialize the CVMix KPP module and set up diagnostics !! Returns True if KPP is to be used, False otherwise. logical function KPP_init(paramFile, G, diag, Time, CS, passive) @@ -151,10 +151,10 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) allocate(CS) ! Read parameters - call log_version(paramFile, mdl, version, 'This is the MOM wrapper to CVmix:KPP\n' // & - 'See http://code.google.com/p/cvmix/') + call log_version(paramFile, mdl, version, 'This is the MOM wrapper to CVMix:KPP\n' // & + 'See http://cvmix.github.io/') call get_param(paramFile, mdl, "USE_KPP", KPP_init, & - "If true, turns on the [CVmix] KPP scheme of Large et al., 1994,\n"// & + "If true, turns on the [CVMix] KPP scheme of Large et al., 1994,\n"// & "to calculate diffusivities and non-local transport in the OBL.", & default=.false.) ! Forego remainder of initialization if not using this scheme @@ -238,14 +238,14 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) call get_param(paramFile, mdl, 'NLT_SHAPE', string, & 'MOM6 method to set nonlocal transport profile.\n'// & 'Over-rides the result from CVMix. Allowed values are: \n'// & - '\t CVMIX - Uses the profiles from CVmix specified by MATCH_TECHNIQUE\n'//& + '\t CVMix - Uses the profiles from CVMix specified by MATCH_TECHNIQUE\n'//& '\t LINEAR - A linear profile, 1-sigma\n'// & '\t PARABOLIC - A parablic profile, (1-sigma)^2\n'// & '\t CUBIC - A cubic profile, (1-sigma)^2(1+2*sigma)\n'// & '\t CUBIC_LMD - The original KPP profile', & - default='CVMIX') + default='CVMix') select case ( trim(string) ) - case ("CVMIX") ; CS%NLT_shape = NLT_SHAPE_CVMIX + case ("CVMix") ; CS%NLT_shape = NLT_SHAPE_CVMix case ("LINEAR") ; CS%NLT_shape = NLT_SHAPE_LINEAR case ("PARABOLIC") ; CS%NLT_shape = NLT_SHAPE_PARABOLIC case ("CUBIC") ; CS%NLT_shape = NLT_SHAPE_CUBIC @@ -263,7 +263,7 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) default='SimpleShapes') if (CS%MatchTechnique.eq.'ParabolicNonLocal') then ! This forces Cs2 (Cs in non-local computation) to equal 1 for parabolic non-local option. - ! May be used during CVmix initialization. + ! May be used during CVMix initialization. Cs_is_one=.true. endif call get_param(paramFile, mdl, 'KPP_ZERO_DIFFUSIVITY', CS%KPPzeroDiffusivity, & @@ -287,7 +287,7 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) case default ; call MOM_error(FATAL,"KPP_init: "// & "Unrecognized KPP_SHORTWAVE_METHOD option"//trim(string)) end select - call get_param(paramFile, mdl, 'CVMIX_ZERO_H_WORK_AROUND', CS%min_thickness, & + call get_param(paramFile, mdl, 'CVMix_ZERO_H_WORK_AROUND', CS%min_thickness, & 'A minimum thickness used to avoid division by small numbers in the vicinity\n'// & 'of vanished layers. This is independent of MIN_THICKNESS used in other parts of MOM.', & units='m', default=0.) @@ -295,7 +295,7 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) call closeParameterBlock(paramFile) call get_param(paramFile, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) - call CVmix_init_kpp( Ri_crit=CS%Ri_crit, & + call CVMix_init_kpp( Ri_crit=CS%Ri_crit, & minOBLdepth=CS%minOBLdepth, & minVtsqr=CS%minVtsqr, & vonKarman=CS%vonKarman, & @@ -306,69 +306,69 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) MatchTechnique=CS%MatchTechnique, & lenhanced_diff=CS%enhance_diffusion,& lnonzero_surf_nonlocal=Cs_is_one ,& - CVmix_kpp_params_user=CS%KPP_params ) + CVMix_kpp_params_user=CS%KPP_params ) ! Register diagnostics CS%diag => diag CS%id_OBLdepth = register_diag_field('ocean_model', 'KPP_OBLdepth', diag%axesT1, Time, & - 'Thickness of the surface Ocean Boundary Layer calculated by [CVmix] KPP', 'meter', & + 'Thickness of the surface Ocean Boundary Layer calculated by [CVMix] KPP', 'meter', & cmor_field_name='oml', cmor_long_name='ocean_mixed_layer_thickness_defined_by_mixing_scheme', & cmor_units='m', cmor_standard_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme') ! CMOR names are placeholders; must be modified by time period ! for CMOR compliance. Diag manager will be used for omlmax and ! omldamax. CS%id_BulkDrho = register_diag_field('ocean_model', 'KPP_BulkDrho', diag%axesTL, Time, & - 'Bulk difference in density used in Bulk Richardson number, as used by [CVmix] KPP', 'kg/m3') + 'Bulk difference in density used in Bulk Richardson number, as used by [CVMix] KPP', 'kg/m3') CS%id_BulkUz2 = register_diag_field('ocean_model', 'KPP_BulkUz2', diag%axesTL, Time, & - 'Square of bulk difference in resolved velocity used in Bulk Richardson number via [CVmix] KPP', 'm2/s2') + 'Square of bulk difference in resolved velocity used in Bulk Richardson number via [CVMix] KPP', 'm2/s2') CS%id_BulkRi = register_diag_field('ocean_model', 'KPP_BulkRi', diag%axesTL, Time, & - 'Bulk Richardson number used to find the OBL depth used by [CVmix] KPP', 'nondim') + 'Bulk Richardson number used to find the OBL depth used by [CVMix] KPP', 'nondim') CS%id_Sigma = register_diag_field('ocean_model', 'KPP_sigma', diag%axesTi, Time, & - 'Sigma coordinate used by [CVmix] KPP', 'nondim') + 'Sigma coordinate used by [CVMix] KPP', 'nondim') CS%id_Ws = register_diag_field('ocean_model', 'KPP_Ws', diag%axesTL, Time, & - 'Turbulent vertical velocity scale for scalars used by [CVmix] KPP', 'm/s') + 'Turbulent vertical velocity scale for scalars used by [CVMix] KPP', 'm/s') CS%id_N = register_diag_field('ocean_model', 'KPP_N', diag%axesTi, Time, & - '(Adjusted) Brunt-Vaisala frequency used by [CVmix] KPP', '1/s') + '(Adjusted) Brunt-Vaisala frequency used by [CVMix] KPP', '1/s') CS%id_N2 = register_diag_field('ocean_model', 'KPP_N2', diag%axesTi, Time, & - 'Square of Brunt-Vaisala frequency used by [CVmix] KPP', '1/s2') + 'Square of Brunt-Vaisala frequency used by [CVMix] KPP', '1/s2') CS%id_Vt2 = register_diag_field('ocean_model', 'KPP_Vt2', diag%axesTL, Time, & - 'Unresolved shear turbulence used by [CVmix] KPP', 'm2/s2') + 'Unresolved shear turbulence used by [CVMix] KPP', 'm2/s2') CS%id_uStar = register_diag_field('ocean_model', 'KPP_uStar', diag%axesT1, Time, & - 'Friction velocity, u*, as used by [CVmix] KPP', 'm/s') + 'Friction velocity, u*, as used by [CVMix] KPP', 'm/s') CS%id_buoyFlux = register_diag_field('ocean_model', 'KPP_buoyFlux', diag%axesTi, Time, & - 'Surface (and penetrating) buoyancy flux, as used by [CVmix] KPP', 'm2/s3') + 'Surface (and penetrating) buoyancy flux, as used by [CVMix] KPP', 'm2/s3') CS%id_QminusSW = register_diag_field('ocean_model', 'KPP_QminusSW', diag%axesT1, Time, & - 'Net temperature flux ignoring short-wave, as used by [CVmix] KPP', 'K m/s') + 'Net temperature flux ignoring short-wave, as used by [CVMix] KPP', 'K m/s') CS%id_netS = register_diag_field('ocean_model', 'KPP_netSalt', diag%axesT1, Time, & - 'Effective net surface salt flux, as used by [CVmix] KPP', 'ppt m/s') + 'Effective net surface salt flux, as used by [CVMix] KPP', 'ppt m/s') CS%id_Kt_KPP = register_diag_field('ocean_model', 'KPP_Kheat', diag%axesTi, Time, & - 'Heat diffusivity due to KPP, as calculated by [CVmix] KPP', 'm2/s') + 'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') CS%id_Kd_in = register_diag_field('ocean_model', 'KPP_Kd_in', diag%axesTi, Time, & 'Diffusivity passed to KPP', 'm2/s') CS%id_Ks_KPP = register_diag_field('ocean_model', 'KPP_Ksalt', diag%axesTi, Time, & - 'Salt diffusivity due to KPP, as calculated by [CVmix] KPP', 'm2/s') + 'Salt diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') CS%id_Kv_KPP = register_diag_field('ocean_model', 'KPP_Kv', diag%axesTi, Time, & - 'Vertical viscosity due to KPP, as calculated by [CVmix] KPP', 'm2/s') + 'Vertical viscosity due to KPP, as calculated by [CVMix] KPP', 'm2/s') CS%id_NLTt = register_diag_field('ocean_model', 'KPP_NLtransport_heat', diag%axesTi, Time, & - 'Non-local transport (Cs*G(sigma)) for heat, as calculated by [CVmix] KPP', 'nondim') + 'Non-local transport (Cs*G(sigma)) for heat, as calculated by [CVMix] KPP', 'nondim') CS%id_NLTs = register_diag_field('ocean_model', 'KPP_NLtransport_salt', diag%axesTi, Time, & - 'Non-local tranpsort (Cs*G(sigma)) for scalars, as calculated by [CVmix] KPP', 'nondim') + 'Non-local tranpsort (Cs*G(sigma)) for scalars, as calculated by [CVMix] KPP', 'nondim') CS%id_NLT_dTdt = register_diag_field('ocean_model', 'KPP_NLT_dTdt', diag%axesTL, Time, & - 'Temperature tendency due to non-local transport of heat, as calculated by [CVmix] KPP', 'K/s') + 'Temperature tendency due to non-local transport of heat, as calculated by [CVMix] KPP', 'K/s') CS%id_NLT_dSdt = register_diag_field('ocean_model', 'KPP_NLT_dSdt', diag%axesTL, Time, & - 'Salinity tendency due to non-local transport of salt, as calculated by [CVmix] KPP', 'ppt/s') + 'Salinity tendency due to non-local transport of salt, as calculated by [CVMix] KPP', 'ppt/s') CS%id_NLT_temp_budget = register_diag_field('ocean_model', 'KPP_NLT_temp_budget', diag%axesTL, Time, & - 'Heat content change due to non-local transport, as calculated by [CVmix] KPP', 'W/m^2') + 'Heat content change due to non-local transport, as calculated by [CVMix] KPP', 'W/m^2') CS%id_NLT_saln_budget = register_diag_field('ocean_model', 'KPP_NLT_saln_budget', diag%axesTL, Time, & - 'Salt content change due to non-local transport, as calculated by [CVmix] KPP', 'kg/(sec*m^2)') + 'Salt content change due to non-local transport, as calculated by [CVMix] KPP', 'kg/(sec*m^2)') CS%id_Tsurf = register_diag_field('ocean_model', 'KPP_Tsurf', diag%axesT1, Time, & - 'Temperature of surface layer (10% of OBL depth) as passed to [CVmix] KPP', 'C') + 'Temperature of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'C') CS%id_Ssurf = register_diag_field('ocean_model', 'KPP_Ssurf', diag%axesT1, Time, & - 'Salinity of surface layer (10% of OBL depth) as passed to [CVmix] KPP', 'ppt') + 'Salinity of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'ppt') CS%id_Usurf = register_diag_field('ocean_model', 'KPP_Usurf', diag%axesCu1, Time, & - 'i-component flow of surface layer (10% of OBL depth) as passed to [CVmix] KPP', 'm/s') + 'i-component flow of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'm/s') CS%id_Vsurf = register_diag_field('ocean_model', 'KPP_Vsurf', diag%axesCv1, Time, & - 'j-component flow of surface layer (10% of OBL depth) as passed to [CVmix] KPP', 'm/s') + 'j-component flow of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'm/s') if (CS%id_OBLdepth > 0) allocate( CS%OBLdepth( SZI_(G), SZJ_(G) ) ) if (CS%id_OBLdepth > 0) CS%OBLdepth(:,:) = 0. @@ -623,19 +623,19 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & N_1d(G%ke+1 ) = 0.0 ! turbulent velocity scales w_s and w_m computed at the cell centers. - ! Note that if sigma > CS%surf_layer_ext, then CVmix_kpp_compute_turbulent_scales + ! Note that if sigma > CS%surf_layer_ext, then CVMix_kpp_compute_turbulent_scales ! computes w_s and w_m velocity scale at sigma=CS%surf_layer_ext. So we only pass ! sigma=CS%surf_layer_ext for this calculation. - call CVmix_kpp_compute_turbulent_scales( & + call CVMix_kpp_compute_turbulent_scales( & CS%surf_layer_ext, & ! (in) Normalized surface layer depth; sigma = CS%surf_layer_ext -cellHeight, & ! (in) Assume here that OBL depth (m) = -cellHeight(k) surfBuoyFlux2, & ! (in) Buoyancy flux at surface (m2/s3) surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) w_s=Ws_1d, & ! (out) Turbulent velocity scale profile (m/s) - CVmix_kpp_params_user=CS%KPP_params ) + CVMix_kpp_params_user=CS%KPP_params ) ! Calculate Bulk Richardson number from eq (21) of LMD94 - BulkRi_1d = CVmix_kpp_compute_bulk_Richardson( & + BulkRi_1d = CVMix_kpp_compute_bulk_Richardson( & cellHeight(1:G%ke), & ! Depth of cell center (m) GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) (1/s) deltaU2, & ! Square of resolved velocity difference (m2/s2) @@ -646,7 +646,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit ! h to Monin-Obukov (default is false, ie. not used) - call CVmix_kpp_compute_OBL_depth( & + call CVMix_kpp_compute_OBL_depth( & BulkRi_1d, & ! (in) Bulk Richardson number iFaceHeight, & ! (in) Height of interfaces (m) OBLdepth_0d, & ! (out) OBL depth (m) @@ -655,7 +655,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) Coriolis=Coriolis, & ! (in) Coriolis parameter (1/s) - CVmix_kpp_params_user=CS%KPP_params ) ! KPP parameters + CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters ! A hack to avoid KPP reaching the bottom. It was needed during development ! because KPP was unable to handle vanishingly small layers near the bottom. @@ -668,7 +668,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & if(CS%fixedOBLdepth) OBLdepth_0d = CS%fixedOBLdepth_value OBLdepth_0d = max( OBLdepth_0d, -iFaceHeight(2) ) ! no shallower than top layer OBLdepth_0d = min( OBLdepth_0d, -iFaceHeight(G%ke+1) ) ! no deeper than bottom - kOBL = CVmix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) + kOBL = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) !************************************************************************* ! smg: remove code below @@ -708,7 +708,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & enddo - BulkRi_1d = CVmix_kpp_compute_bulk_Richardson( & + BulkRi_1d = CVMix_kpp_compute_bulk_Richardson( & cellHeight(1:G%ke), & ! Depth of cell center (m) GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) (1/s) deltaU2, & ! Square of resolved velocity difference (m2/s2) @@ -718,7 +718,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit ! h to Monin-Obukov (default is false, ie. not used) - call CVmix_kpp_compute_OBL_depth( & + call CVMix_kpp_compute_OBL_depth( & BulkRi_1d, & ! (in) Bulk Richardson number iFaceHeight, & ! (in) Height of interfaces (m) OBLdepth_0d, & ! (out) OBL depth (m) @@ -727,19 +727,19 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) Coriolis=Coriolis, & ! (in) Coriolis parameter (1/s) - CVmix_kpp_params_user=CS%KPP_params ) ! KPP parameters + CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters if (CS%deepOBLoffset>0.) then zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) OBLdepth_0d = min( OBLdepth_0d, -zBottomMinusOffset ) - kOBL = CVmix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) + kOBL = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) endif ! apply some constraints on OBLdepth if(CS%fixedOBLdepth) OBLdepth_0d = CS%fixedOBLdepth_value OBLdepth_0d = max( OBLdepth_0d, -iFaceHeight(2) ) ! no shallower than top layer OBLdepth_0d = min( OBLdepth_0d, -iFaceHeight(G%ke+1) ) ! no deep than bottom - kOBL = CVmix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) + kOBL = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) endif ! endif for "correction" step @@ -771,7 +771,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & Kviscosity(:)=Kv(i,j,:) endif - call cvmix_coeffs_kpp(Kviscosity, & ! (inout) Total viscosity (m2/s) + call CVMix_coeffs_kpp(Kviscosity, & ! (inout) Total viscosity (m2/s) Kdiffusivity(:,1), & ! (inout) Total heat diffusivity (m2/s) Kdiffusivity(:,2), & ! (inout) Total salt diffusivity (m2/s) iFaceHeight, & ! (in) Height of interfaces (m) @@ -787,7 +787,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) G%ke, & ! (in) Number of levels to compute coeffs for G%ke, & ! (in) Number of levels in array shape - CVmix_kpp_params_user=CS%KPP_params ) + CVMix_kpp_params_user=CS%KPP_params ) ! Over-write CVMix NLT shape function with one of the following choices. @@ -842,24 +842,24 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & ! recompute wscale for diagnostics, now that we in fact know boundary layer depth if (CS%id_Ws > 0) then - call CVmix_kpp_compute_turbulent_scales( & + call CVMix_kpp_compute_turbulent_scales( & -CellHeight/OBLdepth_0d, & ! (in) Normalized boundary layer coordinate OBLdepth_0d, & ! (in) OBL depth (m) surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) w_s=Ws_1d, & ! (out) Turbulent velocity scale profile (m/s) - CVmix_kpp_params_user=CS%KPP_params & ! KPP parameters + CVMix_kpp_params_user=CS%KPP_params & ! KPP parameters ) CS%Ws(i,j,:) = Ws_1d(:) endif ! compute unresolved squared velocity for diagnostics if (CS%id_Vt2 > 0) then - Vt2_1d(:) = CVmix_kpp_compute_unresolved_shear( & + Vt2_1d(:) = CVMix_kpp_compute_unresolved_shear( & cellHeight(1:G%ke), & ! Depth of cell center (m) ws_cntr=Ws_1d, & ! Turbulent velocity scale profile, at centers (m/s) N_iface=N_1d, & ! Buoyancy frequency at interface (1/s) - CVmix_kpp_params_user=CS%KPP_params ) ! KPP parameters + CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters CS%Vt2(i,j,:) = Vt2_1d(:) endif @@ -1084,11 +1084,11 @@ end subroutine KPP_end !! \section section_KPP The K-Profile Parameterization !! !! The K-Profile Parameterization (KPP) of Large et al., 1994, (http://dx.doi.org/10.1029/94RG01872) is -!! implemented via the Community Vertical Mixing package, [CVmix](https://code.google.com/p/cvmix), +!! implemented via the Community Vertical Mixing package, [CVMix](http://cvmix.github.io/), !! which is called directly by this module. !! !! The formulation and implementation of KPP is described in great detail in the -!! [CVMix manual](https://cvmix.googlecode.com/svn/trunk/manual/cvmix.pdf) (written by our own Stephen Griffies). +!! [CVMix manual](https://github.com/CVMix/CVMix-description/raw/master/cvmix.pdf) (written by our own Stephen Griffies). !! !! \subsection section_KPP_nutshell KPP in a nutshell !! @@ -1109,7 +1109,7 @@ end subroutine KPP_end !! In our implementation of KPP, we allow the shape functions used for \f$ K \f$ and for the non-local transport !! to be chosen independently. !! -!! [google_thread_NLT]: https://groups.google.com/forum/#!msg/cvmix-dev/i6rF-eHOtKI/Ti8BeyksrhAJ "Extreme values of non-local transport" +!! [google_thread_NLT]: https://groups.google.com/forum/#!msg/CVMix-dev/i6rF-eHOtKI/Ti8BeyksrhAJ "Extreme values of non-local transport" !! !! The particular shape function most widely used in the atmospheric community is !! \f[ G(\sigma) = \sigma (1-\sigma)^2 \f] diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 14c6c3412e..e9441d36e5 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -17,7 +17,7 @@ module MOM_bkgnd_mixing use MOM_grid, only : ocean_grid_type use MOM_verticalGrid, only : verticalGrid_type use MOM_file_parser, only : get_param, log_version, param_file_type -use cvmix_background, only : cvmix_init_bkgnd, cvmix_coeffs_bkgnd +use CVMix_background, only : CVMix_init_bkgnd, CVMix_coeffs_bkgnd use MOM_variables, only : vertvisc_type use MOM_intrinsic_functions, only : invcosh @@ -351,7 +351,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, CS) enddo ! if (is_root_pe()) write(*,*)'depth_3d(i,j,:)',depth_3d(i,j,:) - call cvmix_init_bkgnd(max_nlev=nz, & + call CVMix_init_bkgnd(max_nlev=nz, & zw = depth_2d(i,:), & !< interface depth, must bepositive. bl1 = CS%Bryan_Lewis_c1, & bl2 = CS%Bryan_Lewis_c2, & @@ -359,7 +359,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, CS) bl4 = CS%Bryan_Lewis_c4, & prandtl = CS%prandtl_bkgnd) - call cvmix_coeffs_bkgnd(Mdiff_out=CS%kv_bkgnd(i,j,:), & + call CVMix_coeffs_bkgnd(Mdiff_out=CS%kv_bkgnd(i,j,:), & Tdiff_out=CS%kd_bkgnd(i,j,:), & nlev=nz, & max_nlev=nz) @@ -425,15 +425,15 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, CS) end subroutine calculate_bkgnd_mixing -!> Reads the parameter "USE_CVMIX_BACKGROUND" and returns state. +!> Reads the parameter "USE_CVMix_BACKGROUND" and returns state. !! This function allows other modules to know whether this parameterization will !! be used without needing to duplicate the log entry. -logical function cvmix_bkgnd_is_used(param_file) +logical function CVMix_bkgnd_is_used(param_file) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - call get_param(param_file, mdl, "USE_CVMIX_BACKGROUND", cvmix_bkgnd_is_used, & + call get_param(param_file, mdl, "USE_CVMix_BACKGROUND", CVMix_bkgnd_is_used, & default=.false., do_not_log = .true.) -end function cvmix_bkgnd_is_used +end function CVMix_bkgnd_is_used !> Clear pointers and dealocate memory subroutine bkgnd_mixing_end(CS) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index a17c74b888..02b9896ab7 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -9,7 +9,7 @@ module MOM_diabatic_driver use MOM_checksum_packages, only : MOM_state_chksum, MOM_state_stats use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE -use MOM_CVMix_shear, only : cvmix_shear_is_used +use MOM_CVMix_shear, only : CVMix_shear_is_used use MOM_diabatic_aux, only : diabatic_aux_init, diabatic_aux_end, diabatic_aux_CS use MOM_diabatic_aux, only : make_frazil, adjust_salt, insert_brine, differential_diffuse_T_S, triDiagTS use MOM_diabatic_aux, only : find_uv_at_h, diagnoseMLDbyDensityDifference, applyBoundaryFluxesInOut @@ -22,8 +22,8 @@ module MOM_diabatic_driver use MOM_diag_to_Z, only : diag_to_Z_CS, register_Zint_diag, calc_Zint_diags use MOM_diapyc_energy_req, only : diapyc_energy_req_init, diapyc_energy_req_end use MOM_diapyc_energy_req, only : diapyc_energy_req_calc, diapyc_energy_req_test, diapyc_energy_req_CS -use MOM_cvmix_conv, only : cvmix_conv_init, cvmix_conv_cs -use MOM_cvmix_conv, only : cvmix_conv_end, calculate_cvmix_conv +use MOM_CVMix_conv, only : CVMix_conv_init, CVMix_conv_cs +use MOM_CVMix_conv, only : CVMix_conv_end, calculate_CVMix_conv use MOM_domains, only : pass_var, To_West, To_South, To_All, Omit_Corners use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_tidal_mixing, only : tidal_mixing_init, tidal_mixing_cs @@ -90,10 +90,10 @@ module MOM_diabatic_driver !! in the surface boundary layer. logical :: use_kappa_shear !< If true, use the kappa_shear module to find the !! shear-driven diapycnal diffusivity. - logical :: use_cvmix_shear !< If true, use the CVMix module to find the + logical :: use_CVMix_shear !< If true, use the CVMix module to find the !! shear-driven diapycnal diffusivity. logical :: use_tidal_mixing !< If true, activate tidal mixing diffusivity. - logical :: use_cvmix_conv !< If true, use the CVMix module to get enhanced + logical :: use_CVMix_conv !< If true, use the CVMix module to get enhanced !! mixing due to convection. logical :: use_sponge !< If true, sponges may be applied anywhere in the !! domain. The exact location and properties of @@ -151,7 +151,7 @@ module MOM_diabatic_driver real :: evap_CFL_limit = 0.8 !< The largest fraction of a layer that can be !! evaporated in one time-step (non-dim). - logical :: useKPP = .false. !< use CVmix/KPP diffusivities and non-local transport + logical :: useKPP = .false. !< use CVMix/KPP diffusivities and non-local transport logical :: salt_reject_below_ML !< If true, add salt below mixed layer (layer mode only) logical :: KPPisPassive !< If true, KPP is in passive mode, not changing answers. logical :: debug !< If true, write verbose checksums for debugging purposes. @@ -224,7 +224,7 @@ module MOM_diabatic_driver type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() type(KPP_CS), pointer :: KPP_CSp => NULL() type(tidal_mixing_cs), pointer :: tidal_mixing_csp => NULL() - type(cvmix_conv_cs), pointer :: cvmix_conv_csp => NULL() + type(CVMix_conv_cs), pointer :: CVMix_conv_csp => NULL() type(diapyc_energy_req_CS), pointer :: diapyc_en_rec_CSp => NULL() type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass @@ -526,7 +526,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G if (CS%debug) then call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) endif - if (CS%use_kappa_shear .or. CS%use_cvmix_shear) then + if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eaml, ebml) if (CS%debug) then @@ -676,13 +676,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G endif ! endif for KPP ! Add vertical diff./visc. due to convection (computed via CVMix) - if (CS%use_cvmix_conv) then - call calculate_cvmix_conv(h, tv, G, GV, CS%cvmix_conv_csp, Hml) + if (CS%use_CVMix_conv) then + call calculate_CVMix_conv(h, tv, G, GV, CS%CVMix_conv_csp, Hml) !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,k) = Kd_int(i,j,k) + CS%cvmix_conv_csp%kd_conv(i,j,k) - visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%cvmix_conv_csp%kv_conv(i,j,k) + Kd_int(i,j,k) = Kd_int(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) + visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) enddo ; enddo ; enddo !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -1923,7 +1923,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, "If true, apply parameterization of double-diffusion.", & default=.false. ) CS%use_kappa_shear = kappa_shear_is_used(param_file) - CS%use_cvmix_shear = cvmix_shear_is_used(param_file) + CS%use_CVMix_shear = CVMix_shear_is_used(param_file) if (CS%bulkmixedlayer) then call get_param(param_file, mod, "ML_MIX_FIRST", CS%ML_mix_first, & "The fraction of the mixed layer mixing that is applied \n"//& @@ -2344,9 +2344,9 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, ! CS%use_tidal_mixing is set to True if an internal tidal dissipation scheme is to be used. CS%use_tidal_mixing = tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, CS%tidal_mixing_CSp) - ! CS%use_cvmix_conv is set to True if CVMix convection will be used, otherwise + ! CS%use_CVMix_conv is set to True if CVMix convection will be used, otherwise ! False. - CS%use_cvmix_conv = cvmix_conv_init(Time, G, GV, param_file, diag, CS%cvmix_conv_csp) + CS%use_CVMix_conv = CVMix_conv_init(Time, G, GV, param_file, diag, CS%CVMix_conv_csp) call entrain_diffusive_init(Time, G, GV, param_file, diag, CS%entrain_diffusive_CSp) @@ -2438,7 +2438,7 @@ subroutine diabatic_driver_end(CS) if (CS%use_tidal_mixing) call tidal_mixing_end(CS%tidal_mixing_CSp) - if (CS%use_cvmix_conv) call cvmix_conv_end(CS%cvmix_conv_csp) + if (CS%use_CVMix_conv) call CVMix_conv_end(CS%CVMix_conv_csp) if (CS%use_energetic_PBL) & call energetic_PBL_end(CS%energetic_PBL_CSp) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 77061d530e..da5fcfd03a 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -21,8 +21,8 @@ module MOM_set_diffusivity use MOM_intrinsic_functions, only : invcosh use MOM_io, only : slasher, vardesc, var_desc, MOM_read_data use MOM_kappa_shear, only : calculate_kappa_shear, kappa_shear_init, Kappa_shear_CS -use MOM_cvmix_shear, only : calculate_cvmix_shear, cvmix_shear_init, cvmix_shear_cs -use MOM_cvmix_shear, only : cvmix_shear_end +use MOM_CVMix_shear, only : calculate_CVMix_shear, CVMix_shear_init, CVMix_shear_cs +use MOM_CVMix_shear, only : CVMix_shear_end use MOM_bkgnd_mixing, only : calculate_bkgnd_mixing, bkgnd_mixing_init, bkgnd_mixing_cs use MOM_bkgnd_mixing, only : bkgnd_mixing_end, sfc_bkgnd_mixing use MOM_string_functions, only : uppercase @@ -127,7 +127,7 @@ module MOM_set_diffusivity logical :: user_change_diff ! If true, call user-defined code to change diffusivity. logical :: useKappaShear ! If true, use the kappa_shear module to find the ! shear-driven diapycnal diffusivity. - logical :: use_cvmix_shear ! If true, use one of the CVMix modules to find + logical :: use_CVMix_shear ! If true, use one of the CVMix modules to find ! shear-driven diapycnal diffusivity. logical :: double_diffusion ! If true, enable double-diffusive mixing. logical :: simple_TKE_to_Kd ! If true, uses a simple estimate of Kd/TKE that @@ -140,7 +140,7 @@ module MOM_set_diffusivity type(user_change_diff_CS), pointer :: user_change_diff_CSp => NULL() type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() type(Kappa_shear_CS), pointer :: kappaShear_CSp => NULL() - type(cvmix_shear_cs), pointer :: cvmix_shear_csp => NULL() + type(CVMix_shear_cs), pointer :: CVMix_shear_csp => NULL() type(bkgnd_mixing_cs), pointer :: bkgnd_mixing_csp => NULL() type(int_tide_CS), pointer :: int_tide_CSp => NULL() type(tidal_mixing_cs), pointer :: tm_csp => NULL() @@ -338,9 +338,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb",G%HI) endif if (showCallTree) call callTree_waypoint("done with calculate_kappa_shear (set_diffusivity)") - elseif (CS%use_cvmix_shear) then + elseif (CS%use_CVMix_shear) then !NOTE{BGR}: this needs to be cleaned up. It works in 1D case, but has not been tested outside. - call calculate_cvmix_shear(u_h, v_h, h, tv, visc%Kd_shear, visc%Kv_shear,G,GV,CS%cvmix_shear_csp) + call calculate_CVMix_shear(u_h, v_h, h, tv, visc%Kd_shear, visc%Kv_shear,G,GV,CS%CVMix_shear_csp) elseif (associated(visc%Kv_shear)) then visc%Kv_shear(:,:,:) = 0. ! needed if calculate_kappa_shear is not enabled endif @@ -373,7 +373,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! add background mixing call calculate_bkgnd_mixing(h, tv, N2_lay, Kd, visc%Kv_slow, j, G, GV, CS%bkgnd_mixing_csp) - ! GMM, the following will go into the MOM_cvmix_double_diffusion module + ! GMM, the following will go into the MOM_CVMix_double_diffusion module if (CS%double_diffusion) then call double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, KT_extra, KS_extra) do K=2,nz ; do i=is,ie @@ -402,7 +402,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif ! Add the input turbulent diffusivity. - if (CS%useKappaShear .or. CS%use_cvmix_shear) then + if (CS%useKappaShear .or. CS%use_CVMix_shear) then if (present(Kd_int)) then do K=2,nz ; do i=is,ie Kd_int(i,j,K) = visc%Kd_shear(i,j,K) + 0.5*(Kd(i,j,k-1) + Kd(i,j,k)) @@ -887,7 +887,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & do_i(i) = (G%mask2dT(i,j) > 0.5) if ( (CS%tm_csp%Int_tide_dissipation .or. CS%tm_csp%Lee_wave_dissipation) .and. & - .not. CS%tm_csp%use_cvmix_tidal ) then + .not. CS%tm_csp%use_CVMix_tidal ) then h_amp(i) = sqrt(CS%tm_csp%h2(i,j)) ! for computing Nb else h_amp(i) = 0.0 @@ -2127,7 +2127,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp id_clock_kappaShear = cpu_clock_id('(Ocean kappa_shear)', grain=CLOCK_MODULE) ! CVMix shear-driven mixing - CS%use_cvmix_shear = cvmix_shear_init(Time, G, GV, param_file, CS%diag, CS%cvmix_shear_csp) + CS%use_CVMix_shear = CVMix_shear_init(Time, G, GV, param_file, CS%diag, CS%CVMix_shear_csp) end subroutine set_diffusivity_init @@ -2142,8 +2142,8 @@ subroutine set_diffusivity_end(CS) if (CS%user_change_diff) & call user_change_diff_end(CS%user_change_diff_CSp) - if (CS%use_cvmix_shear) & - call cvmix_shear_end(CS%cvmix_shear_csp) + if (CS%use_CVMix_shear) & + call CVMix_shear_end(CS%CVMix_shear_csp) if (associated(CS)) deallocate(CS) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 3df3e7b780..90401313dc 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -44,8 +44,8 @@ module MOM_set_visc use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type use MOM_kappa_shear, only : kappa_shear_is_used -use MOM_cvmix_shear, only : cvmix_shear_is_used -use MOM_cvmix_conv, only : cvmix_conv_is_used +use MOM_CVMix_shear, only : CVMix_shear_is_used +use MOM_CVMix_conv, only : CVMix_conv_is_used use MOM_io, only : vardesc, var_desc use MOM_restart, only : register_restart_field, MOM_restart_CS use MOM_variables, only : thermo_var_ptrs @@ -1784,21 +1784,21 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) ! (in) restart_CS - A pointer to the restart control structure. type(vardesc) :: vd logical :: use_kappa_shear, adiabatic, useKPP, useEPBL - logical :: use_cvmix_shear, MLE_use_PBL_MLD, use_cvmix_conv + logical :: use_CVMix_shear, MLE_use_PBL_MLD, use_CVMix_conv integer :: isd, ied, jsd, jed, nz character(len=40) :: mdl = "MOM_set_visc" ! This module's name. isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke call get_param(param_file, mdl, "ADIABATIC", adiabatic, default=.false., & do_not_log=.true.) - use_kappa_shear = .false. ; use_cvmix_shear = .false. ; - useKPP = .false. ; useEPBL = .false. ; use_cvmix_conv = .false. ; + use_kappa_shear = .false. ; use_CVMix_shear = .false. ; + useKPP = .false. ; useEPBL = .false. ; use_CVMix_conv = .false. ; if (.not.adiabatic) then use_kappa_shear = kappa_shear_is_used(param_file) - use_cvmix_shear = cvmix_shear_is_used(param_file) - use_cvmix_conv = cvmix_conv_is_used(param_file) + use_CVMix_shear = CVMix_shear_is_used(param_file) + use_CVMix_conv = CVMix_conv_is_used(param_file) call get_param(param_file, mdl, "USE_KPP", useKPP, & - "If true, turns on the [CVmix] KPP scheme of Large et al., 1984,\n"// & + "If true, turns on the [CVMix] KPP scheme of Large et al., 1984,\n"// & "to calculate diffusivities and non-local transport in the OBL.", & default=.false., do_not_log=.true.) call get_param(param_file, mdl, "ENERGETICS_SFC_PBL", useEPBL, & @@ -1807,7 +1807,7 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) "in the surface boundary layer.", default=.false., do_not_log=.true.) endif - if (use_kappa_shear .or. useKPP .or. useEPBL .or. use_cvmix_shear .or. use_cvmix_conv) then + if (use_kappa_shear .or. useKPP .or. useEPBL .or. use_CVMix_shear .or. use_CVMix_conv) then allocate(visc%Kd_shear(isd:ied,jsd:jed,nz+1)) ; visc%Kd_shear(:,:,:) = 0.0 allocate(visc%TKE_turb(isd:ied,jsd:jed,nz+1)) ; visc%TKE_turb(:,:,:) = 0.0 allocate(visc%Kv_shear(isd:ied,jsd:jed,nz+1)) ; visc%Kv_shear(:,:,:) = 0.0 diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 90c6bcac88..5524ef074a 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -17,10 +17,10 @@ module MOM_tidal_mixing use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_string_functions, only : uppercase, lowercase use MOM_io, only : slasher, MOM_read_data, vardesc, var_desc -use cvmix_tidal, only : cvmix_init_tidal, cvmix_compute_Simmons_invariant -use cvmix_tidal, only : cvmix_coeffs_tidal, cvmix_tidal_params_type -use cvmix_kinds_and_types, only : cvmix_global_params_type -use cvmix_put_get, only : cvmix_put +use CVMix_tidal, only : CVMix_init_tidal, CVMix_compute_Simmons_invariant +use CVMix_tidal, only : CVMix_coeffs_tidal, CVMix_tidal_params_type +use CVMix_kinds_and_types, only : CVMix_global_params_type +use CVMix_put_get, only : CVMix_put implicit none ; private @@ -122,14 +122,14 @@ module MOM_tidal_mixing real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height character(len=200) :: inputdir - logical :: use_cvmix_tidal = .false. ! true if cvmix is to be used for determining + logical :: use_CVMix_tidal = .false. ! true if CVMix is to be used for determining ! diffusivity due to tidal mixing real :: min_thickness ! Minimum thickness allowed [m] ! CVMix-specific parameters - type(cvmix_tidal_params_type) :: cvmix_tidal_params - type(cvmix_global_params_type) :: cvmix_glb_params ! for Prandtl number only + type(CVMix_tidal_params_type) :: CVMix_tidal_params + type(CVMix_global_params_type) :: CVMix_glb_params ! for Prandtl number only real :: tidal_max_coef ! maximum allowable tidal diffusivity. [m^2/s] ! Data containers @@ -228,7 +228,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, ! Read parameters call log_version(param_file, mdl, version, & "Vertical Tidal Mixing Parameterization") - call get_param(param_file, mdl, "USE_CVMIX_TIDAL", CS%use_cvmix_tidal, & + call get_param(param_file, mdl, "USE_CVMix_TIDAL", CS%use_CVMix_tidal, & "If true, turns on tidal mixing via CVMix", & default=.false.) @@ -237,7 +237,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, call get_param(param_file, mdl, "INT_TIDE_DISSIPATION", CS%int_tide_dissipation, & "If true, use an internal tidal dissipation scheme to \n"//& "drive diapycnal mixing, along the lines of St. Laurent \n"//& - "et al. (2002) and Simmons et al. (2004).", default=CS%use_cvmix_tidal) + "et al. (2002) and Simmons et al. (2004).", default=CS%use_CVMix_tidal) ! return if tidal mixing is inactive tidal_mixing_init = CS%int_tide_dissipation @@ -245,7 +245,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, if (CS%int_tide_dissipation) then default_profile_string = STLAURENT_PROFILE_STRING - if (CS%use_cvmix_tidal) default_profile_string = SIMMONS_PROFILE_STRING + if (CS%use_CVMix_tidal) default_profile_string = SIMMONS_PROFILE_STRING call get_param(param_file, mdl, "INT_TIDE_PROFILE", int_tide_profile_str, & "INT_TIDE_PROFILE selects the vertical profile of energy \n"//& "dissipation with INT_TIDE_DISSIPATION. Valid values are:\n"//& @@ -267,22 +267,22 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, end select ! Check profile consistency - if (CS%use_cvmix_tidal .and. (CS%int_tide_profile.eq.STLAURENT_02 .or. & + if (CS%use_CVMix_tidal .and. (CS%int_tide_profile.eq.STLAURENT_02 .or. & CS%int_tide_profile.eq.POLZIN_09)) then call MOM_error(FATAL, "tidal_mixing_init: Tidal mixing profile"// & " "//trim(int_tide_profile_str)//" unavailable in CVMix. Available "//& "profiles in CVMix are "//trim(SIMMONS_PROFILE_STRING)//" and "//& trim(SCHMITTNER_PROFILE_STRING)//".") - else if (.not.CS%use_cvmix_tidal .and. (CS%int_tide_profile.eq.SIMMONS_04.or. & + else if (.not.CS%use_CVMix_tidal .and. (CS%int_tide_profile.eq.SIMMONS_04.or. & CS%int_tide_profile.eq.SCHMITTNER)) then call MOM_error(FATAL, "tidal_mixing_init: Tidal mixing profiles "// & trim(SIMMONS_PROFILE_STRING)//" and "//trim(SCHMITTNER_PROFILE_STRING)//& - " are available only when USE_CVMIX_TIDAL is True.") + " are available only when USE_CVMix_TIDAL is True.") endif - else if (CS%use_cvmix_tidal) then + else if (CS%use_CVMix_tidal) then call MOM_error(FATAL, "tidal_mixing_init: Cannot set INT_TIDE_DISSIPATION to False "// & - "when USE_CVMIX_TIDAL is set to True.") + "when USE_CVMix_TIDAL is set to True.") endif call get_param(param_file, mdl, "LEE_WAVE_DISSIPATION", CS%Lee_wave_dissipation, & @@ -291,7 +291,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, "(2010) and using the St. Laurent et al. (2002) \n"//& "and Simmons et al. (2004) vertical profile", default=.false.) if (CS%lee_wave_dissipation) then - if (CS%use_cvmix_tidal) then + if (CS%use_CVMix_tidal) then call MOM_error(FATAL, "tidal_mixing_init: Lee wave driven dissipation scheme cannot "// & "be used when CVMix tidal mixing scheme is active.") end if @@ -322,7 +322,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, if ((CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09)) .or. & (CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09))) then - if (CS%use_cvmix_tidal) then + if (CS%use_CVMix_tidal) then call MOM_error(FATAL, "tidal_mixing_init: Polzin scheme cannot "// & "be used when CVMix tidal mixing scheme is active.") end if @@ -375,7 +375,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, endif if ( (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation) .and. & - .not. CS%use_cvmix_tidal) then + .not. CS%use_CVMix_tidal) then call safe_alloc_ptr(CS%Nb,isd,ied,jsd,jed) call safe_alloc_ptr(CS%h2,isd,ied,jsd,jed) @@ -404,7 +404,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, "If true, read a file (given by TIDEAMP_FILE) containing \n"//& "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) if (read_tideamp) then - if (CS%use_cvmix_tidal) then + if (CS%use_CVMix_tidal) then call MOM_error(FATAL, "tidal_mixing_init: Tidal amplitude files are "// & "not compatible with CVMix tidal mixing. ") end if @@ -419,7 +419,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, call get_param(param_file, mdl, "H2_FILE", h2_file, & "The path to the file containing the sub-grid-scale \n"//& "topographic roughness amplitude with INT_TIDE_DISSIPATION.", & - fail_if_missing=(.not.CS%use_cvmix_tidal)) + fail_if_missing=(.not.CS%use_CVMix_tidal)) filename = trim(CS%inputdir) // trim(h2_file) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) call MOM_read_data(filename, 'h2', CS%h2, G%domain, timelevel=1) @@ -473,13 +473,13 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, endif ! Configure CVMix - if (CS%use_cvmix_tidal) then + if (CS%use_CVMix_tidal) then ! Read in CVMix params - !call openParameterBlock(param_file,'CVMIX_TIDAL') + !call openParameterBlock(param_file,'CVMix_TIDAL') call get_param(param_file, mdl, "TIDAL_MAX_COEF", CS%tidal_max_coef, & "largest acceptable value for tidal diffusivity", & - units="m^2/s", default=50e-4) ! the default is 50e-4 in CVMIX, 100e-4 in POP. + units="m^2/s", default=50e-4) ! the default is 50e-4 in CVMix, 100e-4 in POP. call get_param(param_file, mdl, "TIDAL_ENERGY_FILE",tidal_energy_file, & "The path to the file containing tidal energy \n"//& "dissipation. Used with CVMix tidal mixing schemes.", & @@ -496,7 +496,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, "to convert vertical diffusivities into viscosities.", & units="nondim", default=1.0, & do_not_log=.true.) - call cvmix_put(CS%cvmix_glb_params,'Prandtl',prandtl_tidal) + call CVMix_put(CS%CVMix_glb_params,'Prandtl',prandtl_tidal) int_tide_profile_str = lowercase(int_tide_profile_str) @@ -504,7 +504,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, ! TODO: check parameter consistency. (see POP::tidal_mixing.F90::tidal_check) ! Set up CVMix - call cvmix_init_tidal(CVmix_tidal_params_user = CS%cvmix_tidal_params, & + call CVMix_init_tidal(CVMix_tidal_params_user = CS%CVMix_tidal_params, & mix_scheme = int_tide_profile_str, & efficiency = CS%Mu_itides, & vertical_decay_scale = CS%int_tide_decay_scale, & @@ -516,7 +516,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, !call closeParameterBlock(param_file) - endif ! cvmix on + endif ! CVMix on ! Register Diagnostics fields @@ -526,7 +526,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, CS%id_Kd_itidal = register_diag_field('ocean_model','Kd_itides',diag%axesTi,Time, & 'Internal Tide Driven Diffusivity', 'm2 s-1') - if (CS%use_cvmix_tidal) then + if (CS%use_CVMix_tidal) then CS%id_N2_int = register_diag_field('ocean_model','N2_int',diag%axesTi,Time, & 'Bouyancy frequency squared, at interfaces', 's-2') ! TODO: add units @@ -577,7 +577,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, CS%id_Kd_Niku = register_diag_field('ocean_model','Kd_Nikurashin',diag%axesTi,Time, & 'Lee Wave Driven Diffusivity', 'm2 s-1') endif - endif ! S%use_cvmix_tidal + endif ! S%use_CVMix_tidal if (associated(CS%diag_to_Z_CSp)) then vd = var_desc("Kd_itides","m2 s-1", & @@ -620,8 +620,8 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & real, intent(inout) :: Kd_max if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then - if (CS%use_cvmix_tidal) then - call calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) + if (CS%use_CVMix_tidal) then + call calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd) else call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & N2_lay, Kd, Kd_int, Kd_max) @@ -632,7 +632,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & !> Calls the CVMix routines to compute tidal dissipation and to add the effect of internal-tide-driven !! mixing to the interface diffusivities. -subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) +subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd) integer, intent(in) :: j type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -673,14 +673,14 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) iFaceHeight(k+1) = iFaceHeight(k) - dh enddo - call cvmix_compute_Simmons_invariant( nlev = G%ke, & + call CVMix_compute_Simmons_invariant( nlev = G%ke, & energy_flux = CS%tidal_qe_2d(i,j), & rho = rho_fw, & SimmonsCoeff = Simmons_coeff, & VertDep = vert_dep, & zw = iFaceHeight, & zt = cellHeight, & - CVmix_tidal_params_user = CS%cvmix_tidal_params) + CVMix_tidal_params_user = CS%CVMix_tidal_params) ! Since we pass tidal_qe_2d=(CS%Gamma_itides)*tidal_energy_flux_2d, and not tidal_energy_flux_2d in ! above subroutine call, we divide Simmons_coeff by CS%Gamma_itides as a corrective step: @@ -688,7 +688,7 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) Simmons_coeff = Simmons_coeff / CS%Gamma_itides - call cvmix_coeffs_tidal( Mdiff_out = Kv_tidal, & + call CVMix_coeffs_tidal( Mdiff_out = Kv_tidal, & Tdiff_out = Kd_tidal, & Nsqr = N2_int(i,:), & OceanDepth = -iFaceHeight(G%ke+1),& @@ -696,8 +696,8 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) vert_dep = vert_dep, & nlev = G%ke, & max_nlev = G%ke, & - CVmix_params = CS%cvmix_glb_params, & - CVmix_tidal_params_user = CS%cvmix_tidal_params) + CVMix_params = CS%CVMix_glb_params, & + CVMix_tidal_params_user = CS%CVMix_tidal_params) do k=1,G%ke Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_tidal(k) + Kd_tidal(k+1) ) @@ -726,7 +726,7 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) " INT_TIDE_PROFILE is unavailable in CVMix") end select -end subroutine calculate_cvmix_tidal +end subroutine calculate_CVMix_tidal !> This subroutine adds the effect of internal-tide-driven mixing to the layer diffusivities. diff --git a/src/user/SCM_CVmix_tests.F90 b/src/user/SCM_CVmix_tests.F90 index 74437a688f..8f9298d3c2 100644 --- a/src/user/SCM_CVmix_tests.F90 +++ b/src/user/SCM_CVmix_tests.F90 @@ -1,6 +1,6 @@ -!> Initial conditions and forcing for the single column model (SCM) CVmix +!> Initial conditions and forcing for the single column model (SCM) CVMix !! test set. -module SCM_CVmix_tests +module SCM_CVMix_tests ! This file is part of MOM6. See LICENSE.md for the license. @@ -17,14 +17,14 @@ module SCM_CVmix_tests #include -public SCM_CVmix_tests_TS_init -public SCM_CVmix_tests_surface_forcing_init -public SCM_CVmix_tests_wind_forcing -public SCM_CVmix_tests_buoyancy_forcing -public SCM_CVmix_tests_CS +public SCM_CVMix_tests_TS_init +public SCM_CVMix_tests_surface_forcing_init +public SCM_CVMix_tests_wind_forcing +public SCM_CVMix_tests_buoyancy_forcing +public SCM_CVMix_tests_CS !> Container for surface forcing parameters -type SCM_CVmix_tests_CS ; +type SCM_CVMix_tests_CS ; private logical :: UseWindStress !< True to use wind stress logical :: UseHeatFlux !< True to use heat flux @@ -41,12 +41,12 @@ module SCM_CVmix_tests ! This include declares and sets the variable "version". #include "version_variable.h" -character(len=40) :: mdl = "SCM_CVmix_tests" ! This module's name. +character(len=40) :: mdl = "SCM_CVMix_tests" ! This module's name. contains -!> Initializes temperature and salinity for the SCM CVmix test example -subroutine SCM_CVmix_tests_TS_init(T, S, h, G, GV, param_file, just_read_params) +!> Initializes temperature and salinity for the SCM CVMix test example +subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, param_file, just_read_params) real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(out) :: T !< Potential temperature (degC) real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(out) :: S !< Salinity (psu) real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(in) :: h !< Layer thickness (m or Pa) @@ -117,20 +117,20 @@ subroutine SCM_CVmix_tests_TS_init(T, S, h, G, GV, param_file, just_read_params) enddo ! k enddo ; enddo -end subroutine SCM_CVmix_tests_TS_init +end subroutine SCM_CVMix_tests_TS_init -!> Initializes surface forcing for the CVmix test case suite -subroutine SCM_CVmix_tests_surface_forcing_init(Time, G, param_file, CS) +!> Initializes surface forcing for the CVMix test case suite +subroutine SCM_CVMix_tests_surface_forcing_init(Time, G, param_file, CS) type(time_type), intent(in) :: Time !< Time type(ocean_grid_type), intent(in) :: G !< Grid structure type(param_file_type), intent(in) :: param_file !< Input parameter structure - type(SCM_CVmix_tests_CS), pointer :: CS !< Parameter container + type(SCM_CVMix_tests_CS), pointer :: CS !< Parameter container ! This include declares and sets the variable "version". #include "version_variable.h" if (associated(CS)) then - call MOM_error(FATAL, "SCM_CVmix_tests_surface_forcing_init called with an associated "// & + call MOM_error(FATAL, "SCM_CVMix_tests_surface_forcing_init called with an associated "// & "control structure.") return endif @@ -140,57 +140,57 @@ subroutine SCM_CVmix_tests_surface_forcing_init(Time, G, param_file, CS) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "SCM_USE_WIND_STRESS", & CS%UseWindStress, "Wind Stress switch "// & - "used in the SCM CVmix surface forcing.", & + "used in the SCM CVMix surface forcing.", & units='', default=.false.) call get_param(param_file, mdl, "SCM_USE_HEAT_FLUX", & CS%UseHeatFlux, "Heat flux switch "// & - "used in the SCM CVmix test surface forcing.", & + "used in the SCM CVMix test surface forcing.", & units='', default=.false.) call get_param(param_file, mdl, "SCM_USE_EVAPORATION", & CS%UseEvaporation, "Evaporation switch "// & - "used in the SCM CVmix test surface forcing.", & + "used in the SCM CVMix test surface forcing.", & units='', default=.false.) call get_param(param_file, mdl, "SCM_USE_DIURNAL_SW", & CS%UseDiurnalSW, "Diurnal sw radation switch "// & - "used in the SCM CVmix test surface forcing.", & + "used in the SCM CVMix test surface forcing.", & units='', default=.false.) if (CS%UseWindStress) then call get_param(param_file, mdl, "SCM_TAU_X", & CS%tau_x, "Constant X-dir wind stress "// & - "used in the SCM CVmix test surface forcing.", & + "used in the SCM CVMix test surface forcing.", & units='N/m2', fail_if_missing=.true.) call get_param(param_file, mdl, "SCM_TAU_Y", & CS%tau_y, "Constant y-dir wind stress "// & - "used in the SCM CVmix test surface forcing.", & + "used in the SCM CVMix test surface forcing.", & units='N/m2', fail_if_missing=.true.) endif if (CS%UseHeatFlux) then call get_param(param_file, mdl, "SCM_HEAT_FLUX", & CS%surf_HF, "Constant surface heat flux "// & - "used in the SCM CVmix test surface forcing.", & + "used in the SCM CVMix test surface forcing.", & units='m K/s', fail_if_missing=.true.) endif if (CS%UseEvaporation) then call get_param(param_file, mdl, "SCM_EVAPORATION", & CS%surf_evap, "Constant surface evaporation "// & - "used in the SCM CVmix test surface forcing.", & + "used in the SCM CVMix test surface forcing.", & units='m/s', fail_if_missing=.true.) endif if (CS%UseDiurnalSW) then call get_param(param_file, mdl, "SCM_DIURNAL_SW_MAX", & CS%Max_sw, "Maximum diurnal sw radiation "// & - "used in the SCM CVmix test surface forcing.", & + "used in the SCM CVMix test surface forcing.", & units='m K/s', fail_if_missing=.true.) endif -end subroutine SCM_CVmix_tests_surface_forcing_init +end subroutine SCM_CVMix_tests_surface_forcing_init -subroutine SCM_CVmix_tests_wind_forcing(state, forces, day, G, CS) +subroutine SCM_CVMix_tests_wind_forcing(state, forces, day, G, CS) type(surface), intent(in) :: state !< Surface state structure type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(time_type), intent(in) :: day !< Time in days type(ocean_grid_type), intent(inout) :: G !< Grid structure - type(SCM_CVmix_tests_CS), pointer :: CS !< Container for SCM parameters + type(SCM_CVMix_tests_CS), pointer :: CS !< Container for SCM parameters ! Local variables integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -212,15 +212,15 @@ subroutine SCM_CVmix_tests_wind_forcing(state, forces, day, G, CS) forces%ustar(i,j) = sqrt( mag_tau / CS%Rho0 ) enddo ; enddo ; endif -end subroutine SCM_CVmix_tests_wind_forcing +end subroutine SCM_CVMix_tests_wind_forcing -subroutine SCM_CVmix_tests_buoyancy_forcing(state, fluxes, day, G, CS) +subroutine SCM_CVMix_tests_buoyancy_forcing(state, fluxes, day, G, CS) type(surface), intent(in) :: state !< Surface state structure type(forcing), intent(inout) :: fluxes !< Surface fluxes structure type(time_type), intent(in) :: day !< Time in days (seconds?) type(ocean_grid_type), intent(inout) :: G !< Grid structure - type(SCM_CVmix_tests_CS), pointer :: CS !< Container for SCM parameters + type(SCM_CVMix_tests_CS), pointer :: CS !< Container for SCM parameters ! Local variables integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq @@ -236,7 +236,7 @@ subroutine SCM_CVmix_tests_buoyancy_forcing(state, fluxes, day, G, CS) IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB if (CS%UseHeatFlux) then - ! Note CVmix test inputs give Heat flux in [m K/s] + ! Note CVMix test inputs give Heat flux in [m K/s] ! therefore must convert to W/m2 by multiplying ! by Rho0*Cp do J=Jsq,Jeq ; do i=is,ie @@ -246,7 +246,7 @@ subroutine SCM_CVmix_tests_buoyancy_forcing(state, fluxes, day, G, CS) if (CS%UseEvaporation) then do J=Jsq,Jeq ; do i=is,ie - ! Note CVmix test inputs give evaporation in m/s + ! Note CVMix test inputs give evaporation in m/s ! This therefore must be converted to mass flux ! by multiplying by density fluxes%evap(i,J) = CS%surf_evap * CS%Rho0 @@ -255,7 +255,7 @@ subroutine SCM_CVmix_tests_buoyancy_forcing(state, fluxes, day, G, CS) if (CS%UseDiurnalSW) then do J=Jsq,Jeq ; do i=is,ie - ! Note CVmix test inputs give max sw rad in [m K/s] + ! Note CVMix test inputs give max sw rad in [m K/s] ! therefore must convert to W/m2 by multiplying ! by Rho0*Cp ! Note diurnal cycle peaks at Noon. @@ -264,6 +264,6 @@ subroutine SCM_CVmix_tests_buoyancy_forcing(state, fluxes, day, G, CS) enddo; enddo endif -end subroutine SCM_CVmix_tests_buoyancy_forcing +end subroutine SCM_CVMix_tests_buoyancy_forcing -end module SCM_CVmix_tests +end module SCM_CVMix_tests From 02cf0fa4cc45cbf032211bcea93427d892a878df Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 23 Apr 2018 15:04:14 -0400 Subject: [PATCH 0120/1072] +Pass p_surf to calculate_diagnostic_fields Changed the interfaces to calculate_diagnostic_fields and calculate_vertical_integrals pass in a pointer to p_surf rather than the forcing type. This way, the p_surf field can come from either the forcing or the mech_forcing type, as appropriate. Also cleaned up the dOxygenized argument descriptions in MOM_diagnostics.F90. All answers are bitwise identical. --- src/core/MOM.F90 | 8 +- src/diagnostics/MOM_diagnostics.F90 | 122 ++++++++++++---------------- 2 files changed, 57 insertions(+), 73 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c85777188f..1d129c4ff3 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -419,6 +419,8 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa u, & ! u : zonal velocity component (m/s) v, & ! v : meridional velocity component (m/s) h ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) + real, pointer, dimension(:,:) :: & + p_surf => NULL() ! A pointer to the ocean surface pressure, in Pa. real :: I_wt_ssh type(time_type) :: Time_local, end_time_thermo, Time_temp @@ -472,6 +474,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa ntstep = MAX(1,MIN(n_max,floor(CS%dt_therm/dt + 0.001))) dt_therm = dt*ntstep endif + if (associated(forces%p_surf)) p_surf => forces%p_surf else n_max = 1 if ((time_interval > CS%dt_therm) .and. (CS%dt_therm > 0.0)) & @@ -480,6 +483,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa dt = time_interval / real(n_max) dt_therm = dt ; ntstep = 1 thermo_does_span_coupling = .true. ! This is never used in this case? + if (associated(fluxes%p_surf)) p_surf => fluxes%p_surf endif if (do_dyn) then @@ -712,9 +716,8 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa ! Diagnostics that require the complete state to be up-to-date can be calculated. call enable_averaging(CS%t_dyn_rel_diag, Time_local, CS%diag) - !### This is the one place where fluxes might used if do_thermo=.false. Is this correct? call calculate_diagnostic_fields(u, v, h, CS%uh, CS%vh, CS%tv, CS%ADp, & - CS%CDp, fluxes, CS%t_dyn_rel_diag, CS%diag_pre_sync,& + CS%CDp, p_surf, CS%t_dyn_rel_diag, CS%diag_pre_sync,& G, GV, CS%diagnostics_CSp) call post_tracer_diagnostics(CS%Tracer_reg, h, CS%diag_pre_sync, CS%diag, G, GV, CS%t_dyn_rel_diag) call diag_copy_diag_to_storage(CS%diag_pre_sync, h, CS%diag) @@ -726,6 +729,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa if (Time_local + set_time(int(0.5*dt_therm)) > CS%Z_diag_time) then call enable_averaging(real(time_type_to_real(CS%Z_diag_interval)), & CS%Z_diag_time, CS%diag) + !### This is the one place where fluxes might used if do_thermo=.false. Is this correct? call calculate_Z_diag_fields(u, v, h, ssh, fluxes%frac_shelf_h, & G, GV, CS%diag_to_Z_CSp) CS%Z_diag_time = CS%Z_diag_time + CS%Z_diag_interval diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 1ea31011cb..94a23d5233 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -39,7 +39,6 @@ module MOM_diagnostics use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_version, param_file_type -use MOM_forcing_type, only : forcing use MOM_grid, only : ocean_grid_type use MOM_interface_heights, only : find_eta use MOM_spatial_means, only : global_area_mean, global_layer_mean @@ -189,43 +188,38 @@ module MOM_diagnostics contains !> Diagnostics not more naturally calculated elsewhere are computed here. -subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, fluxes, & +subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & dt, diag_pre_sync, G, GV, CS, eta_bt) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid - !! structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, - !! in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H - !! (usually m or kg m-2). - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uh !< Transport through zonal faces - !! = u*h*dy, m3/s(Bouss) - !! kg/s(non-Bouss). - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh !< transport through meridional - !! faces = v*h*dx, m3/s(Bouss) - !! kg/s(non-Bouss). - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to - !! various thermodynamic - !! variables. - type(accel_diag_ptrs), intent(in) :: ADp !< structure with pointers to - !! accelerations in momentum - !! equation. - type(cont_diag_ptrs), intent(in) :: CDp !< structure with pointers to - !! terms in continuity equation. - type(forcing), intent(in) :: fluxes !< A structure containing the - !! surface fluxes. - real, intent(in) :: dt !< The time difference in s since - !! the last call to this - !! subroutine. - - type(diag_grid_storage), intent(in) :: diag_pre_sync - !< Target grids from previous - !! timestep - type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by - !! a previous call to - !! diagnostics_init. - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< An optional barotropic + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: u !< The zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: v !< The meridional velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: uh !< Transport through zonal faces = u*h*dy, + !! in H m2 s-1, i.e. m3/s(Bouss) or kg/s(non-Bouss). + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: vh !< Transport through meridional faces = v*h*dx, + !! in H m2 s-1, i.e. m3/s(Bouss) or kg/s(non-Bouss). + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables. + type(accel_diag_ptrs), intent(in) :: ADp !< structure with pointers to + !! accelerations in momentum equation. + type(cont_diag_ptrs), intent(in) :: CDp !< structure with pointers to + !! terms in continuity equation. + real, dimension(:,:), pointer :: p_surf !< A pointer to the surface pressure, in Pa. + !! If p_surf is not associated, it is the same + !! as setting the surface pressure to 0. + real, intent(in) :: dt !< The time difference in s since the last + !! call to this subroutine. + type(diag_grid_storage), intent(in) :: diag_pre_sync !< Target grids from previous timestep + type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by a + !! previous call to diagnostics_init. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(in) :: eta_bt !< An optional barotropic !! variable that gives the "correct" free surface height (Boussinesq) or total water column !! mass per unit area (non-Boussinesq). This is used to dilate the layer thicknesses when !! calculating interface heights, in m or kg m-2. @@ -349,9 +343,9 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, fluxes, & endif else ! thkcello = dp/(rho*g) for non-Boussinesq do j=js,je - if(ASSOCIATED(fluxes%p_surf)) then ! Pressure loading at top of surface layer (Pa) + if(ASSOCIATED(p_surf)) then ! Pressure loading at top of surface layer (Pa) do i=is,ie - pressure_1d(i) = fluxes%p_surf(i,j) + pressure_1d(i) = p_surf(i,j) enddo else do i=is,ie @@ -459,7 +453,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, fluxes, & call post_data_1d_k(CS%id_salt_layer_ave, salt_layer_ave, CS%diag) endif - call calculate_vertical_integrals(h, tv, fluxes, G, GV, CS) + call calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) if ((CS%id_Rml > 0) .or. (CS%id_Rcv > 0) .or. ASSOCIATED(CS%h_Rlay) .or. & ASSOCIATED(CS%uh_Rlay) .or. ASSOCIATED(CS%vh_Rlay) .or. & @@ -760,34 +754,21 @@ subroutine find_weights(Rlist, R_in, k, nz, wt, wt_p) end subroutine find_weights -!> Subroutine calculates vertical integrals of several tracers, along +!> This subroutine calculates vertical integrals of several tracers, along !! with the mass-weight of these tracers, the total column mass, and the !! carefully calculated column height. -subroutine calculate_vertical_integrals(h, tv, fluxes, G, GV, CS) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid - !! structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H - !! (usually m or kg m-2). - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various - !! thermodynamic variables. - type(forcing), intent(in) :: fluxes !< A structure containing the - !! surface fluxes. - type(diagnostics_CS), intent(inout) :: CS !< A control structure returned - !! by a previous call to - !! diagnostics_init. - -! Subroutine calculates vertical integrals of several tracers, along -! with the mass-weight of these tracers, the total column mass, and the -! carefully calculated column height. - -! Arguments: -! (in) h - layer thickness: metre (Bouss) or kg/ m2 (non-Bouss) -! (in) tv - structure pointing to thermodynamic variables -! (in) fluxes - a structure containing the surface fluxes. -! (in) G - ocean grid structure -! (in) GV - The ocean's vertical grid structure. -! (in) CS - control structure returned by a previous call to diagnostics_init +subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables. + real, dimension(:,:), pointer :: p_surf !< A pointer to the surface pressure, in Pa. + !! If p_surf is not associated, it is the same + !! as setting the surface pressure to 0. + type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by a + !! previous call to diagnostics_init. real, dimension(SZI_(G), SZJ_(G)) :: & z_top, & ! Height of the top of a layer or the ocean, in m. @@ -875,13 +856,12 @@ subroutine calculate_vertical_integrals(h, tv, fluxes, G, GV, CS) if (CS%id_pbo > 0) then do j=js,je ; do i=is,ie ; btm_pres(i,j) = 0.0 ; enddo ; enddo ! 'pbo' is defined as the sea water pressure at the sea floor - ! pbo = (mass * g) + pso - ! where pso is the sea water pressure at sea water surface - ! note that pso is equivalent to fluxes%p_surf + ! pbo = (mass * g) + p_surf + ! where p_surf is the sea water pressure at sea water surface. do j=js,je ; do i=is,ie btm_pres(i,j) = mass(i,j) * GV%g_Earth - if (ASSOCIATED(fluxes%p_surf)) then - btm_pres(i,j) = btm_pres(i,j) + fluxes%p_surf(i,j) + if (ASSOCIATED(p_surf)) then + btm_pres(i,j) = btm_pres(i,j) + p_surf(i,j) endif enddo ; enddo call post_data(CS%id_pbo, btm_pres, CS%diag) From 57dcc60306c2e89dd47b1c9cb4f3ebdf19624c28 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 23 Apr 2018 15:43:18 -0400 Subject: [PATCH 0121/1072] Cleaned up Waves-related interfaces Cleaned up the interface declarations for the Waves-related arguments, including the elimination of the incompatible pointer and intent(in) modifiers and using consistent case for the Waves types. All answers are bitwise identical. --- src/core/MOM.F90 | 33 +++++++++++++++++++-------------- 1 file changed, 19 insertions(+), 14 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 1d129c4ff3..32f79a430e 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -361,8 +361,8 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type real, intent(in) :: time_interval !< time interval covered by this run segment, in s. type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM - type(Wave_parameters_CS), pointer, & - optional, intent(in) :: Waves !< An optional pointer to a wave proptery CS + type(Wave_parameters_CS), & + optional, pointer :: Waves !< An optional pointer to a wave proptery CS logical, optional, intent(in) :: do_dynamics !< Present and false, do not do updates due !! to the dynamics. logical, optional, intent(in) :: do_thermodynamics !< Present and false, do not do updates due @@ -596,7 +596,8 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa end_time_thermo = Time_local + set_time(int(floor(dtdia-dt+0.5))) ! Apply diabatic forcing, do mixing, and regrid. - call step_MOM_thermo(CS, G, GV, u, v, h, CS%tv, fluxes, dtdia, end_time_thermo, .true., WAVES=Waves) + call step_MOM_thermo(CS, G, GV, u, v, h, CS%tv, fluxes, dtdia, & + end_time_thermo, .true., Waves=Waves) ! The diabatic processes are now ahead of the dynamics by dtdia. CS%t_dyn_rel_thermo = -dtdia @@ -607,9 +608,9 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa endif ! end of block "(CS%diabatic_first .and. (CS%t_dyn_rel_adv==0.0))" if (do_dyn) then - ! Store pre-dynamics grids for proper diagnostic remapping for transports or advective tendencies - ! If there are more dynamics steps per advective steps (i.e DT_THERM /= DT), this needs to be the - ! stored at the first call + ! Store pre-dynamics grids for proper diagnostic remapping for transports + ! or advective tendencies. If there are more dynamics steps per advective + ! steps (i.e DT_THERM /= DT), this needs to be stored at the first call. if (CS%ndyn_per_adv == 0 .and. CS%t_dyn_rel_adv == 0.) then call diag_copy_diag_to_storage(CS%diag_pre_dyn, h, CS%diag) CS%ndyn_per_adv = CS%ndyn_per_adv + 1 @@ -653,7 +654,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa call step_MOM_dynamics(forces, CS%p_surf_begin, CS%p_surf_end, dt, & dt_therm_here, bbl_time_int, CS, & - Time_local, WAVES=Waves) + Time_local, Waves=Waves) !=========================================================================== ! This is the start of the tracer advection part of the algorithm. @@ -688,7 +689,8 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa if (dtdia > dt) CS%Time = CS%Time - set_time(int(floor(0.5*(dtdia-dt) + 0.5))) ! Apply diabatic forcing, do mixing, and regrid. - call step_MOM_thermo(CS, G, GV, u, v, h, CS%tv, fluxes, dtdia, Time_local, .false., WAVES=waves) + call step_MOM_thermo(CS, G, GV, u, v, h, CS%tv, fluxes, dtdia, & + Time_local, .false., Waves=Waves) CS%t_dyn_rel_thermo = 0.0 if (dtdia > dt) & ! Reset CS%Time to its previous value. @@ -799,7 +801,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa end subroutine step_MOM subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & - bbl_time_int, CS, Time_local, WAVES) + bbl_time_int, CS, Time_local, Waves) type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to the surface !! pressure at the beginning of this dynamic @@ -815,8 +817,9 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & !! in s, or zero not to update the properties. type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM type(time_type), intent(in) :: Time_local !< Starting time of a segment, as a time type - type(wave_parameters_CS), pointer, intent(in), optional :: & - WAVES ! MOM_step_thermo orchestrates the thermodynamic time stepping and vertical !! remapping, via calls to diabatic (or adiabatic) and ALE_main. -subroutine step_MOM_thermo(CS, G, GV, u, v, h, tv, fluxes, dtdia, Time_end_thermo, update_BBL,waves) +subroutine step_MOM_thermo(CS, G, GV, u, v, h, tv, fluxes, dtdia, & + Time_end_thermo, update_BBL, Waves) type(MOM_control_struct), intent(inout) :: CS !< Master MOM control structure type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(inout) :: GV !< ocean vertical grid structure @@ -1062,8 +1066,9 @@ subroutine step_MOM_thermo(CS, G, GV, u, v, h, tv, fluxes, dtdia, Time_end_therm real, intent(in) :: dtdia !< The time interval over which to advance, in s type(time_type), intent(in) :: Time_end_thermo !< End of averaging interval for thermo diags logical, intent(in) :: update_BBL !< If true, calculate the bottom boundary layer properties. - type(wave_parameters_CS), pointer, optional, intent(in) :: & - WAVES ! Date: Mon, 23 Apr 2018 17:39:05 -0400 Subject: [PATCH 0122/1072] Fixed conflicting intent and pointer attributes Fixed about 20 instances where both intent and pointer attributes were given to arguments, in violation of the F90 coding standard. (I do not know why the compilers have not been complaining.) Also cleaned up or dOxyGenized several argument lists. All answers are bitwise identical. --- src/ALE/MOM_ALE.F90 | 29 ++++++----- src/core/MOM_open_boundary.F90 | 8 +-- src/framework/MOM_diag_mediator.F90 | 30 ++++------- src/framework/MOM_diag_remap.F90 | 4 +- src/ice_shelf/MOM_ice_shelf.F90 | 16 +++--- .../MOM_tracer_initialization_from_Z.F90 | 41 ++++++--------- .../vertical/MOM_ALE_sponge.F90 | 34 ++++++------ .../vertical/MOM_diabatic_driver.F90 | 25 ++++----- src/tracer/MOM_offline_aux.F90 | 49 +++++++++-------- src/tracer/MOM_offline_main.F90 | 52 +++++++++---------- 10 files changed, 140 insertions(+), 148 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index fac9f07715..34ad978cd2 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -624,18 +624,23 @@ end subroutine ALE_build_grid !> For a state-based coordinate, accelerate the process of regridding by !! repeatedly applying the grid calculation algorithm subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n, u, v, Reg, dt, dzRegrid, initial) - type(ALE_CS), pointer, intent(in) :: CS !< ALE control structure - type(ocean_grid_type), intent(inout) :: G !< Ocean grid - type(verticalGrid_type), intent(in) :: GV !< Vertical grid - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Original thicknesses - type(thermo_var_ptrs), intent(inout) :: tv !< Thermo vars (T/S/EOS) - integer, intent(in) :: n !< Number of times to regrid - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< Meridional velocity - type(tracer_registry_type), pointer, optional, intent(in) :: Reg !< Tracer registry to remap onto new grid - real, intent(in), optional :: dt !< Model timestep to provide a timescale for regridding - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout), optional :: dzRegrid !< Final change in interface positions - logical, intent(in), optional :: initial !< Whether we're being called from an initialization routine (and expect diagnostics to work) + type(ALE_CS), pointer :: CS !< ALE control structure + type(ocean_grid_type), intent(inout) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Vertical grid + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h !< Original thicknesses + type(thermo_var_ptrs), intent(inout) :: tv !< Thermo vars (T/S/EOS) + integer, intent(in) :: n !< Number of times to regrid + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: u !< Zonal velocity + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(inout) :: v !< Meridional velocity + type(tracer_registry_type), & + optional, pointer :: Reg !< Tracer registry to remap onto new grid + real, optional, intent(in) :: dt !< Model timestep to provide a timescale for regridding + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & + optional, intent(inout) :: dzRegrid !< Final change in interface positions + logical, optional, intent(in) :: initial !< Whether we're being called from an initialization routine (and expect diagnostics to work) ! Local variables integer :: i, j, k, nz diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 58d52bbbe5..1ce73e4c1c 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -2859,10 +2859,10 @@ end subroutine flood_fill2 !> Register OBC segment data for restarts subroutine open_boundary_register_restarts(HI, GV, OBC_CS,restart_CSp) - type(hor_index_type), intent(in) :: HI !< Horizontal indices - type(verticalGrid_type), pointer, intent(in) :: GV !< Container for vertical grid information - type(ocean_OBC_type), pointer, intent(inout) :: OBC_CS !< OBC data structure - type(MOM_restart_CS), pointer, intent(inout) :: restart_CSp !< Restart structure + type(hor_index_type), intent(in) :: HI !< Horizontal indices + type(verticalGrid_type), pointer :: GV !< Container for vertical grid information + type(ocean_OBC_type), pointer :: OBC_CS !< OBC data structure, data intent(inout) + type(MOM_restart_CS), pointer :: restart_CSp !< Restart structure, data intent(inout) ! Local variables type(vardesc) :: vd diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 6094a5286a..cd378cff09 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -2286,16 +2286,13 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir) end subroutine diag_mediator_init +!> Set pointers to the default state fields used to remap diagnostics. subroutine diag_set_state_ptrs(h, T, S, eqn_of_state, diag_cs) - - real, dimension(:,:,:), target, intent(in) :: h, T, S - type(EOS_type), pointer, intent(in) :: eqn_of_state !< Equation of state structure - type(diag_ctrl), intent(inout) :: diag_cs - - ! (inout) diag_cs - diag mediator control structure - ! (in) h - a pointer to model thickness - ! (in) T - a pointer to model temperature - ! (in) S - a pointer to model salinity + real, dimension(:,:,:), target, intent(in ) :: h !< the model thickness array + real, dimension(:,:,:), target, intent(in ) :: T !< the model temperature array + real, dimension(:,:,:), target, intent(in ) :: S !< the model salinity array + type(EOS_type), target, intent(in ) :: eqn_of_state !< Equation of state structure + type(diag_ctrl), intent(inout) :: diag_cs !< diag mediator control structure ! Keep pointers to h, T, S needed for the diagnostic remapping diag_cs%h => h @@ -2520,17 +2517,12 @@ subroutine initialize_diag_type(diag) end subroutine initialize_diag_type -! Make a new diagnostic. Either use memory which is in the array of 'primary' -! diagnostics, or if that is in use, insert it to the list of secondary diags. +!> Make a new diagnostic. Either use memory which is in the array of 'primary' +!! diagnostics, or if that is in use, insert it to the list of secondary diags. subroutine alloc_diag_with_id(diag_id, diag_cs, diag) - integer, intent(in) :: diag_id - type(diag_ctrl), target, intent(inout) :: diag_cs - type(diag_type), pointer, intent(out) :: diag - - ! Arguments: - ! (in) diag_id - new id for the diag. - ! (inout) diag_cs - structure used to regulate diagnostic output - ! (inout) diag - structure representing a diagnostic + integer, intent(in ) :: diag_id !< id for the diagnostic + type(diag_ctrl), target, intent(inout) :: diag_cs !< structure used to regulate diagnostic output + type(diag_type), pointer :: diag !< structure representing a diagnostic (inout) type(diag_type), pointer :: tmp diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 03bb65feb9..9ba8988d0f 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -223,10 +223,10 @@ function diag_remap_axes_configured(remap_cs) !! target grid whenever T/S change. subroutine diag_remap_update(remap_cs, G, GV, h, T, S, eqn_of_state) type(diag_remap_ctrl), intent(inout) :: remap_cs !< Diagnostic coordinate control structure - type(ocean_grid_type), pointer :: G !< The ocean's grid type + type(ocean_grid_type), pointer :: G !< The ocean's grid type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(:, :, :), intent(in) :: h, T, S !< New thickness, T and S - type(EOS_type), pointer, intent(in) :: eqn_of_state !< A pointer to the equation of state + type(EOS_type), pointer :: eqn_of_state !< A pointer to the equation of state ! Local variables real, dimension(remap_cs%nz + 1) :: zInterfaces diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index e8821e4c87..ae92454a2a 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -2198,10 +2198,10 @@ end subroutine ice_shelf_save_restart subroutine ice_shelf_advect(CS, time_step, melt_rate, Time) - type(ice_shelf_CS), pointer :: CS - real, intent(in) :: time_step - real,pointer,dimension(:,:),intent(in) :: melt_rate - type(time_type) :: Time + type(ice_shelf_CS), pointer :: CS + real, intent(in) :: time_step + real, dimension(:,:), pointer :: melt_rate + type(time_type), intent(in) :: Time ! time_step: time step in sec ! melt_rate: basal melt rate in kg/m^2/s @@ -6040,10 +6040,10 @@ end subroutine solo_time_step !!! OVS !!! subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) - type(ice_shelf_CS), pointer :: CS - real, intent(in) :: time_step - real,pointer,dimension(:,:),intent(in) :: melt_rate - type(time_type) :: Time + type(ice_shelf_CS), pointer :: CS + real, intent(in) :: time_step + real, dimension(:,:), pointer :: melt_rate + type(time_type), intent(in) :: Time ! time_step: time step in sec ! melt_rate: basal melt rate in kg/m^2/s diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 86a92c9b90..71156c27b8 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -38,29 +38,24 @@ module MOM_tracer_initialization_from_Z contains +!> MOM_initialize_tracer_from_Z initializes a tracer from a z-space data file. subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, & - src_var_unit_conversion, src_var_record, & - homogenize, useALEremapping, remappingScheme, src_var_gridspec ) + src_var_unit_conversion, src_var_record, homogenize, & + useALEremapping, remappingScheme, src_var_gridspec ) -! Arguments: -! (in) h - Layer thickness, in m. -! (inout) tr - pointer to array containing field to be initialized. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. - - type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure. - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure. + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thickness, in m. - real, dimension(:,:,:), pointer, intent(inout) :: tr !< Pointer to array to be initialized - type(param_file_type), intent(in) :: PF !< parameter file - character(len=*), intent(in) :: src_file, src_var_nam !< source filename and variable name on disk - real, optional, intent(in) :: src_var_unit_conversion !< optional multiplicative unit conversion - integer, optional, intent(in) :: src_var_record !< record to read for multiple time-level files - logical, optional, intent(in) :: homogenize !< optionally homogenize to mean value - logical, optional, intent(in) :: useALEremapping !< to remap or not (optional) - character(len=*), optional, intent(in) :: remappingScheme !< remapping scheme to use. - character(len=*), optional, intent(in) :: src_var_gridspec ! Not implemented yet. + intent(in) :: h !< Layer thickness, in m. + real, dimension(:,:,:), pointer :: tr !< Pointer to array to be initialized + type(param_file_type), intent(in) :: PF !< parameter file + character(len=*), intent(in) :: src_file, src_var_nam !< source filename and variable name on disk + real, optional, intent(in) :: src_var_unit_conversion !< optional multiplicative unit conversion + integer, optional, intent(in) :: src_var_record !< record to read for multiple time-level files + logical, optional, intent(in) :: homogenize !< optionally homogenize to mean value + logical, optional, intent(in) :: useALEremapping !< to remap or not (optional) + character(len=*), optional, intent(in) :: remappingScheme !< remapping scheme to use. + character(len=*), optional, intent(in) :: src_var_gridspec ! Not implemented yet. real :: land_fill = 0.0 character(len=200) :: inputdir ! The directory where NetCDF input files are. @@ -204,16 +199,10 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, endif enddo ; enddo ; enddo - call callTree_leave(trim(mdl)//'()') call cpu_clock_end(id_clock_routine) - end subroutine MOM_initialize_tracer_from_Z - - - - end module MOM_tracer_initialization_from_Z diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index e42601d51b..f615e988cf 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -764,21 +764,22 @@ end subroutine set_up_ALE_sponge_vel_field_varying !> This subroutine applies damping to the layers thicknesses, temp, salt and a variety of tracers for every column where there is damping. subroutine apply_ALE_sponge(h, dt, G, CS, Time) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure (in). - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness, in m (in) - real, intent(in) :: dt !< The amount of time covered by this call, in s (in). - type(ALE_sponge_CS), pointer :: CS ! A temporary array for h at u pts - real :: hv(SZI_(G), SZJB_(G), SZK_(G)) !> A temporary array for h at v pts - real, allocatable, dimension(:,:,:) :: sp_val !> A temporary array for fields - real, allocatable, dimension(:,:,:) :: mask_z !> A temporary array for field mask at h pts + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure (in). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: h !< Layer thickness, in m (in) + real, intent(in) :: dt !< The amount of time covered by this call, in s (in). + type(ALE_sponge_CS), pointer :: CS ! CS%opacity_CSp @@ -1556,13 +1556,14 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, & !> Routine called for adiabatic physics subroutine adiabatic(h, tv, fluxes, dt, G, GV, CS) - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness (m for Bouss or kg/m2 for non-Bouss) - type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields - type(forcing), intent(inout) :: fluxes !< boundary fluxes - real, intent(in) :: dt !< time step (seconds) - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(diabatic_CS), pointer :: CS !< module control structure + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: h !< thickness (m for Bouss or kg/m2 for non-Bouss) + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields + type(forcing), intent(inout) :: fluxes !< boundary fluxes + real, intent(in) :: dt !< time step (seconds) + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(diabatic_CS), pointer :: CS !< module control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: zeros ! An array of zeros. diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 3ee727f430..7d00d06284 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -598,27 +598,34 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ uhtr, vhtr, temp_mean, salt_mean, mld, Kd, fluxes, ridx_sum, ridx_snap, read_mld, read_sw, & read_ts_uvh, do_ale_in) - type(ocean_grid_type), pointer, intent(inout) :: G !< Horizontal grid type - type(verticalGrid_type), pointer, intent(in ) :: GV !< Vertical grid type - integer, intent(in ) :: nk_input !< Number of levels in input file - character(len=*), intent(in ) :: mean_file !< Name of file with averages fields - character(len=*), intent(in ) :: sum_file !< Name of file with summed fields - character(len=*), intent(in ) :: snap_file !< Name of file with snapshot fields - character(len=*), intent(in ) :: surf_file !< Name of file with surface fields - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Zonal mass fluxes - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Meridional mass fluxes - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_end !< End of timestep layer thickness - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: temp_mean !< Averaged temperature - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: salt_mean !< Averaged salinity - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: mld !< Averaged mixed layer depth - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1),intent(inout) :: Kd !< Averaged mixed layer depth - type(forcing), intent(inout) :: fluxes !< Fields with surface fluxes - integer, intent(in ) :: ridx_sum !< Read index for sum, mean, and surf files - integer, intent(in ) :: ridx_snap !< Read index for snapshot file - logical, intent(in ) :: read_mld !< True if reading in MLD - logical, intent(in ) :: read_sw !< True if reading in radiative fluxes - logical, intent(in ) :: read_ts_uvh !< True if reading in uh, vh, and h - logical, optional, intent(in ) :: do_ale_in !< True if using ALE algorithms + type(ocean_grid_type), intent(inout) :: G !< Horizontal grid type + type(verticalGrid_type), intent(in ) :: GV !< Vertical grid type + integer, intent(in ) :: nk_input !< Number of levels in input file + character(len=*), intent(in ) :: mean_file !< Name of file with averages fields + character(len=*), intent(in ) :: sum_file !< Name of file with summed fields + character(len=*), intent(in ) :: snap_file !< Name of file with snapshot fields + character(len=*), intent(in ) :: surf_file !< Name of file with surface fields + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: uhtr !< Zonal mass fluxes + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(inout) :: vhtr !< Meridional mass fluxes + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: h_end !< End of timestep layer thickness + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: temp_mean !< Averaged temperature + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: salt_mean !< Averaged salinity + real, dimension(SZI_(G),SZJ_(G)), & + intent(inout) :: mld !< Averaged mixed layer depth + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & + intent(inout) :: Kd !< Diapycnal diffusivities at interfaces + type(forcing), intent(inout) :: fluxes !< Fields with surface fluxes + integer, intent(in ) :: ridx_sum !< Read index for sum, mean, and surf files + integer, intent(in ) :: ridx_snap !< Read index for snapshot file + logical, intent(in ) :: read_mld !< True if reading in MLD + logical, intent(in ) :: read_sw !< True if reading in radiative fluxes + logical, intent(in ) :: read_ts_uvh !< True if reading in uh, vh, and h + logical, optional, intent(in ) :: do_ale_in !< True if using ALE algorithms logical :: do_ale integer :: i, j, k, is, ie, js, je, nz diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index bd173a80c9..eed7039fe4 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -802,7 +802,7 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, type(forcing), intent(inout) :: fluxes !< pointers to forcing fields type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type real, intent(in) :: time_interval !< Offline transport time interval - type(offline_transport_CS), pointer :: CS !< control structure from initialize_MOM + type(offline_transport_CS), pointer :: CS !< Control structure for offline module real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: h_pre !< layer thicknesses before advection real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: eatr !< Entrainment from layer above real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: ebtr !< Entrainment from layer below @@ -1061,9 +1061,9 @@ end subroutine update_offline_fields !> Initialize additional diagnostics required for offline tracer transport subroutine register_diags_offline_transport(Time, diag, CS) - type(offline_transport_CS), pointer :: CS !< control structure for MOM - type(time_type), intent(in) :: Time !< current model time - type(diag_ctrl) :: diag + type(offline_transport_CS), pointer :: CS !< Control structure for offline module + type(time_type), intent(in) :: Time !< current model time + type(diag_ctrl), intent(in) :: diag ! U-cell fields CS%id_uhr = register_diag_field('ocean_model', 'uhr', diag%axesCuL, Time, & @@ -1148,19 +1148,19 @@ end subroutine post_offline_convergence_diags !> Extracts members of the offline main control structure. All arguments are optional except !! the control structure itself -subroutine extract_offline_main(CS, uhtr, vhtr, eatr, ebtr, h_end, accumulated_time, dt_offline, dt_offline_vertical, & - skip_diffusion) - type(offline_transport_CS), target, intent(in ) :: CS !< Offline control structure +subroutine extract_offline_main(CS, uhtr, vhtr, eatr, ebtr, h_end, accumulated_time, & + dt_offline, dt_offline_vertical, skip_diffusion) + type(offline_transport_CS), target, intent(in ) :: CS !< Offline control structure ! Returned optional arguments - real, dimension(:,:,:), pointer, optional, intent( out) :: uhtr - real, dimension(:,:,:), pointer, optional, intent( out) :: vhtr - real, dimension(:,:,:), pointer, optional, intent( out) :: eatr - real, dimension(:,:,:), pointer, optional, intent( out) :: ebtr - real, dimension(:,:,:), pointer, optional, intent( out) :: h_end - integer, pointer, optional, intent( out) :: accumulated_time - integer, optional, intent( out) :: dt_offline - integer, optional, intent( out) :: dt_offline_vertical - logical, optional, intent( out) :: skip_diffusion + real, dimension(:,:,:), optional, pointer :: uhtr !< Remaining zonal mass transport + real, dimension(:,:,:), optional, pointer :: vhtr !< Remaining meridional mass transport + real, dimension(:,:,:), optional, pointer :: eatr + real, dimension(:,:,:), optional, pointer :: ebtr + real, dimension(:,:,:), optional, pointer :: h_end + integer, optional, pointer :: accumulated_time + integer, optional, intent( out) :: dt_offline + integer, optional, intent( out) :: dt_offline_vertical + logical, optional, intent( out) :: skip_diffusion ! Pointers to 3d members if (present(uhtr)) uhtr => CS%uhtr @@ -1183,7 +1183,7 @@ end subroutine extract_offline_main !! are optional except for the CS itself subroutine insert_offline_main(CS, ALE_CSp, diabatic_CSp, diag, OBC, tracer_adv_CSp, & tracer_flow_CSp, tracer_Reg, tv, G, GV, x_before_y, debug) - type(offline_transport_CS), intent(inout) :: CS + type(offline_transport_CS), intent(inout) :: CS !< Offline control structure ! Inserted optional arguments type(ALE_CS), target, optional, intent(in ) :: ALE_CSp type(diabatic_CS), target, optional, intent(in ) :: diabatic_CSp @@ -1193,8 +1193,8 @@ subroutine insert_offline_main(CS, ALE_CSp, diabatic_CSp, diag, OBC, tracer_adv_ type(tracer_flow_control_CS), target, optional, intent(in ) :: tracer_flow_CSp type(tracer_registry_type), target, optional, intent(in ) :: tracer_Reg type(thermo_var_ptrs), target, optional, intent(in ) :: tv - type(ocean_grid_type), target, optional, intent(in ) :: G - type(verticalGrid_type), target, optional, intent(in ) :: GV + type(ocean_grid_type), target, optional, intent(in ) :: G !< ocean grid structure + type(verticalGrid_type), target, optional, intent(in ) :: GV !< ocean vertical grid structure logical, optional, intent(in ) :: x_before_y logical, optional, intent(in ) :: debug @@ -1218,11 +1218,11 @@ end subroutine insert_offline_main ! run time parameters from MOM_input subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) - type(param_file_type), intent(in) :: param_file - type(offline_transport_CS), pointer, intent(inout) :: CS - type(diabatic_CS), pointer, intent(in) :: diabatic_CSp - type(ocean_grid_type), pointer, intent(in) :: G - type(verticalGrid_type), pointer, intent(in) :: GV + type(param_file_type), intent(in) :: param_file + type(offline_transport_CS), pointer :: CS !< Offline control structure + type(diabatic_CS), intent(in) :: diabatic_CSp + type(ocean_grid_type), target, intent(in) :: G !< ocean grid structure + type(verticalGrid_type), target, intent(in) :: GV !< ocean vertical grid structure character(len=40) :: mdl = "offline_transport" character(len=20) :: redistribute_method @@ -1387,7 +1387,7 @@ end subroutine offline_transport_init !> Coordinates the allocation and reading in all time levels of uh, vh, hend, temp, and salt from files. Used !! when read_all_ts_uvh subroutine read_all_input(CS) - type(offline_transport_CS), pointer, intent(inout) :: CS + type(offline_transport_CS), intent(inout) :: CS !< Control structure for offline module integer :: is, ie, js, je, isd, ied, jsd, jed, nz, t, ntime integer :: IsdB, IedB, JsdB, JedB @@ -1427,7 +1427,7 @@ end subroutine read_all_input !> Deallocates (if necessary) arrays within the offline control structure subroutine offline_transport_end(CS) - type(offline_transport_CS), pointer, intent(inout) :: CS + type(offline_transport_CS), pointer :: CS !< Control structure for offline module ! Explicitly allocate all allocatable arrays deallocate(CS%uhtr) From 07c1114fa3d90457c9462564eddd95a484ba01a1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 23 Apr 2018 18:38:27 -0400 Subject: [PATCH 0123/1072] +Added optional argument reset_therm to step_MOM Added an optional argument to step_MOM to control whether to reset the running sums of thermodynamic quantities, like frazil. If this argument is not provided, the results are identical to what occurs now. Also did some minor restructuring of step_MOM and changed the case of some intrinsic functions. All answers are bitwise identical. --- src/core/MOM.F90 | 73 +++++++++++++++++++++++++++--------------------- 1 file changed, 41 insertions(+), 32 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 32f79a430e..3c81f5b9da 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -162,6 +162,8 @@ module MOM real :: time_in_cycle !< The running time of the current time-stepping cycle !! in calls that step the dynamics, and also the length of !! the time integral of ssh_rint, in s. + real :: time_in_thermo_cycle !< The running time of the current time-stepping + !! cycle in calls that step the thermodynamics, in s. type(ocean_grid_type) :: G !< structure containing metrics and grid info type(verticalGrid_type), pointer :: & @@ -353,8 +355,9 @@ module MOM !! The action of lateral processes on tracers occur in calls to !! advect_tracer and tracer_hordiff. Vertical mixing and possibly remapping !! occur inside of diabatic. -subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Waves, & - do_dynamics, do_thermodynamics, start_cycle, end_cycle, cycle_length) +subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & + Waves, do_dynamics, do_thermodynamics, start_cycle, & + end_cycle, cycle_length, reset_therm) type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(forcing), intent(inout) :: fluxes !< pointers to forcing fields type(surface), intent(inout) :: sfc_state !< surface ocean state @@ -375,6 +378,9 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa !! time-stepping cycle; missing is like true. real, optional, intent(in) :: cycle_length !< The amount of time in a coupled time !! stepping cycle, in s. + logical, optional, intent(in) :: reset_therm !< This indicates whether the running sums of + !! thermodynamic quantities should be reset. + !! If missing, this is like start_cycle. ! local type(ocean_grid_type), pointer :: G ! pointer to a structure containing @@ -411,6 +417,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa ! a stepping cycle (whatever that may mean). logical :: cycle_end ! If true, do calculations and diagnostics that are only done at ! the end of a stepping cycle (whatever that may mean). + logical :: therm_reset ! If true, reset running sums of thermodynamic quantities. real :: cycle_time ! The length of the coupled time-stepping cycle, in s. real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: & ssh ! sea surface height, which may be based on eta_av (meter) @@ -441,6 +448,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa cycle_start = .true. ; if (present(start_cycle)) cycle_start = start_cycle cycle_end = .true. ; if (present(end_cycle)) cycle_end = end_cycle cycle_time = time_interval ; if (present(cycle_length)) cycle_time = cycle_length + therm_reset = cycle_start ; if (present(reset_therm)) therm_reset = reset_therm call cpu_clock_begin(id_clock_ocean) call cpu_clock_begin(id_clock_other) @@ -454,11 +462,9 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa ! First determine the time step that is consistent with this call and an ! integer fraction of time_interval. - if (do_dyn) then n_max = 1 if (time_interval > CS%dt) n_max = ceiling(time_interval/CS%dt - 0.001) - dt = time_interval / real(n_max) thermo_does_span_coupling = (CS%thermo_spans_coupling .and. & (CS%dt_therm > 1.5*cycle_time)) @@ -474,27 +480,16 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa ntstep = MAX(1,MIN(n_max,floor(CS%dt_therm/dt + 0.001))) dt_therm = dt*ntstep endif - if (associated(forces%p_surf)) p_surf => forces%p_surf - else - n_max = 1 - if ((time_interval > CS%dt_therm) .and. (CS%dt_therm > 0.0)) & - n_max = ceiling(time_interval/CS%dt_therm - 0.001) - dt = time_interval / real(n_max) - dt_therm = dt ; ntstep = 1 - thermo_does_span_coupling = .true. ! This is never used in this case? - if (associated(fluxes%p_surf)) p_surf => fluxes%p_surf - endif - - if (do_dyn) then - if (.not.ASSOCIATED(forces%p_surf)) CS%interp_p_surf = .false. + if (associated(forces%p_surf)) p_surf => forces%p_surf + if (.not.associated(forces%p_surf)) CS%interp_p_surf = .false. - !---------- Initiate group halo pass + !---------- Initiate group halo pass of the forcing fields call cpu_clock_begin(id_clock_pass) call create_group_pass(pass_tau_ustar_psurf, forces%taux, forces%tauy, G%Domain) - if (ASSOCIATED(forces%ustar)) & + if (associated(forces%ustar)) & call create_group_pass(pass_tau_ustar_psurf, forces%ustar, G%Domain) - if (ASSOCIATED(forces%p_surf)) & + if (associated(forces%p_surf)) & call create_group_pass(pass_tau_ustar_psurf, forces%p_surf, G%Domain) if (G%nonblocking_updates) then call start_group_pass(pass_tau_ustar_psurf, G%Domain) @@ -502,14 +497,26 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa call do_group_pass(pass_tau_ustar_psurf, G%Domain) endif call cpu_clock_end(id_clock_pass) + else + ! This step only updates the thermodynamics so setting timesteps is simpler. + n_max = 1 + if ((time_interval > CS%dt_therm) .and. (CS%dt_therm > 0.0)) & + n_max = ceiling(time_interval/CS%dt_therm - 0.001) + + dt = time_interval / real(n_max) + dt_therm = dt ; ntstep = 1 + if (associated(fluxes%p_surf)) p_surf => fluxes%p_surf endif - if (cycle_start) then - if (ASSOCIATED(CS%tv%frazil)) CS%tv%frazil(:,:) = 0.0 - if (ASSOCIATED(CS%tv%salt_deficit)) CS%tv%salt_deficit(:,:) = 0.0 - if (ASSOCIATED(CS%tv%TempxPmE)) CS%tv%TempxPmE(:,:) = 0.0 - if (ASSOCIATED(CS%tv%internal_heat)) CS%tv%internal_heat(:,:) = 0.0 + if (therm_reset) then + CS%time_in_thermo_cycle = 0.0 + if (associated(CS%tv%frazil)) CS%tv%frazil(:,:) = 0.0 + if (associated(CS%tv%salt_deficit)) CS%tv%salt_deficit(:,:) = 0.0 + if (associated(CS%tv%TempxPmE)) CS%tv%TempxPmE(:,:) = 0.0 + if (associated(CS%tv%internal_heat)) CS%tv%internal_heat(:,:) = 0.0 + endif + if (cycle_start) then CS%time_in_cycle = 0.0 do j=js,je ; do i=is,ie ; CS%ssh_rint(i,j) = 0.0 ; enddo ; enddo @@ -526,8 +533,8 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa call complete_group_pass(pass_tau_ustar_psurf, G%Domain, clock=id_clock_pass) if (CS%interp_p_surf) then - if (.not.ASSOCIATED(CS%p_surf_end)) allocate(CS%p_surf_end(isd:ied,jsd:jed)) - if (.not.ASSOCIATED(CS%p_surf_begin)) allocate(CS%p_surf_begin(isd:ied,jsd:jed)) + if (.not.associated(CS%p_surf_end)) allocate(CS%p_surf_end(isd:ied,jsd:jed)) + if (.not.associated(CS%p_surf_begin)) allocate(CS%p_surf_begin(isd:ied,jsd:jed)) if (.not.CS%p_surf_prev_set) then do j=jsd,jed ; do i=isd,ied CS%p_surf_prev(i,j) = forces%p_surf(i,j) @@ -598,6 +605,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa ! Apply diabatic forcing, do mixing, and regrid. call step_MOM_thermo(CS, G, GV, u, v, h, CS%tv, fluxes, dtdia, & end_time_thermo, .true., Waves=Waves) + CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia ! The diabatic processes are now ahead of the dynamics by dtdia. CS%t_dyn_rel_thermo = -dtdia @@ -691,6 +699,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa ! Apply diabatic forcing, do mixing, and regrid. call step_MOM_thermo(CS, G, GV, u, v, h, CS%tv, fluxes, dtdia, & Time_local, .false., Waves=Waves) + CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia CS%t_dyn_rel_thermo = 0.0 if (dtdia > dt) & ! Reset CS%Time to its previous value. @@ -776,8 +785,8 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, Wa ! Do diagnostics that only occur at the end of a complete forcing step. if (cycle_end) then call cpu_clock_begin(id_clock_diagnostics) - call enable_averaging(CS%time_in_cycle, Time_local, CS%diag) - call post_surface_diagnostics(CS%sfc_IDs, G, GV, CS%diag, CS%time_in_cycle, & + call enable_averaging(CS%time_in_thermo_cycle, Time_local, CS%diag) + call post_surface_diagnostics(CS%sfc_IDs, G, GV, CS%diag, CS%time_in_thermo_cycle, & sfc_state, CS%tv, ssh, CS%ave_ssh_ibc) call disable_averaging(CS%diag) call cpu_clock_end(id_clock_diagnostics) @@ -1983,7 +1992,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ALLOC_(CS%ssh_rint(isd:ied,jsd:jed)) ; CS%ssh_rint(:,:) = 0.0 ALLOC_(CS%ave_ssh_ibc(isd:ied,jsd:jed)) ; CS%ave_ssh_ibc(:,:) = 0.0 ALLOC_(CS%eta_av_bc(isd:ied,jsd:jed)) ; CS%eta_av_bc(:,:) = 0.0 - CS%time_in_cycle = 0.0 + CS%time_in_cycle = 0.0 ; CS%time_in_thermo_cycle = 0.0 ! Use the Wright equation of state by default, unless otherwise specified ! Note: this line and the following block ought to be in a separate @@ -2539,8 +2548,8 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, ssh, p_atm, use_EOS) integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - if (present(p_atm)) then ; if (ASSOCIATED(p_atm)) then - calc_rho = ASSOCIATED(tv%eqn_of_state) + if (present(p_atm)) then ; if (associated(p_atm)) then + calc_rho = associated(tv%eqn_of_state) if (present(use_EOS) .and. calc_rho) calc_rho = use_EOS ! Correct the output sea surface height for the contribution from the ! atmospheric pressure From 93f242f69f1221bd6fb22065f94de036232d41b6 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 24 Apr 2018 13:57:25 -0600 Subject: [PATCH 0124/1072] call cvmix_coeffs_tidal_schmittner --- .../vertical/MOM_tidal_mixing.F90 | 29 +++++++++++++++---- 1 file changed, 23 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 8ca8ecfffb..ae958a02ed 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -21,6 +21,7 @@ module MOM_tidal_mixing use cvmix_tidal, only : cvmix_init_tidal, cvmix_compute_Simmons_invariant use cvmix_tidal, only : cvmix_coeffs_tidal, cvmix_tidal_params_type use cvmix_tidal, only : cvmix_compute_Schmittner_invariant, cvmix_compute_SchmittnerCoeff +use cvmix_tidal, only : cvmix_coeffs_tidal_schmittner use cvmix_kinds_and_types, only : cvmix_global_params_type use cvmix_put_get, only : cvmix_put @@ -36,7 +37,7 @@ module MOM_tidal_mixing !> Containers for tidal mixing diagnostics type, public :: tidal_mixing_diags - ! TODO: private + private real, pointer, dimension(:,:,:) :: & Kd_itidal => NULL(),& ! internal tide diffusivity at interfaces (m2/s) Fl_itidal => NULL(),& ! vertical flux of tidal turbulent dissipation (m3/s3) @@ -662,6 +663,7 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) real, dimension(SZK_(G)+1) :: Kv_tidal !< tidal viscosity [m2/s] real, dimension(SZK_(G)+1) :: vert_dep !< vertical deposition real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) + real, dimension(SZK_(G)+1) :: SchmittnerSocn real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m) real, dimension(SZK_(G)) :: tidal_qe_md !< Tidal dissipation energy interpolated from 3d input to model coordinates real, dimension(SZK_(G)) :: Schmittner_coeff @@ -772,6 +774,8 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) iFaceHeight(k+1) = iFaceHeight(k) - dh enddo + SchmittnerSocn = 0.0 ! TODO: compute this + ! form the time-invariant part of Schmittner coefficient term call cvmix_compute_Schmittner_invariant(nlev = G%ke, & VertDep = vert_dep, & @@ -786,11 +790,24 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) ! form the Schmittner coefficient that is based on 3D q*E, which is formed from ! summing q_i*TidalConstituent_i over the number of constituents. - call cvmix_compute_SchmittnerCoeff( nlev = G%ke, & - energy_flux = tidal_qe_md(:), & - rho = rho_fw, & - SchmittnerCoeff = Schmittner_coeff, & - exp_hab_zetar = exp_hab_zetar, & + call cvmix_compute_SchmittnerCoeff( nlev = G%ke, & + energy_flux = tidal_qe_md(:), & + rho = rho_fw, & + SchmittnerCoeff = Schmittner_coeff, & + exp_hab_zetar = exp_hab_zetar, & + CVmix_tidal_params_user = CS%cvmix_tidal_params) + + + call cvmix_coeffs_tidal_schmittner( Mdiff_out = Kv_tidal, & + Tdiff_out = Kd_tidal, & + Nsqr = N2_int(i,:), & + OceanDepth = -iFaceHeight(G%ke+1), & + vert_dep = vert_dep, & + nlev = G%ke, & + max_nlev = G%ke, & + SchmittnerCoeff = Schmittner_coeff, & + SchmittnerSouthernOcean = SchmittnerSocn, & + CVmix_params = CS%cvmix_glb_params, & CVmix_tidal_params_user = CS%cvmix_tidal_params) enddo ! i=is,ie From bb3ab5bdc6ebbac17d1d56716e3c50c98f905784 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Thu, 26 Apr 2018 09:55:31 -0400 Subject: [PATCH 0125/1072] Fixes openmp directives in diffusivity modules - The reorganization of set_diffusivity() left some OMP directives out of date. - This now compiles with gfortran -fopenmp --- src/parameterizations/vertical/MOM_bkgnd_mixing.F90 | 10 +++++----- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 2 +- src/parameterizations/vertical/MOM_set_diffusivity.F90 | 8 ++++---- 3 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index e9441d36e5..61c212db8b 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -272,7 +272,7 @@ subroutine sfc_bkgnd_mixing(G, CS) if (.not. CS%Bryan_Lewis_diffusivity) then -!$OMP parallel do default(none) shared(is,ie,js,je,CS,Kd_sfc) +!$OMP parallel do default(none) shared(is,ie,js,je,CS) do j=js,je ; do i=is,ie CS%Kd_sfc(i,j) = CS%Kd enddo ; enddo @@ -280,16 +280,16 @@ subroutine sfc_bkgnd_mixing(G, CS) if (CS%Henyey_IGW_background) then I_x30 = 2.0 / invcosh(CS%N0_2Omega*2.0) ! This is evaluated at 30 deg. -!$OMP parallel do default(none) -!shared(is,ie,js,je,Kd_sfc,CS,G,deg_to_rad,epsilon,I_x30) & -!$OMP private(abs_sin) +!$OMP parallel do default(none) & +!$OMP shared(is,ie,js,je,CS,G,deg_to_rad,epsilon,I_x30) & +!$OMP private(abs_sin) do j=js,je ; do i=is,ie abs_sin = abs(sin(G%geoLatT(i,j)*deg_to_rad)) CS%Kd_sfc(i,j) = max(CS%Kd_min, CS%Kd_sfc(i,j) * & ((abs_sin * invcosh(CS%N0_2Omega/max(epsilon,abs_sin))) * I_x30) ) enddo ; enddo elseif (CS%Kd_tanh_lat_fn) then -!$OMP parallel do default(none) shared(is,ie,js,je,Kd_sfc,CS,G) +!$OMP parallel do default(none) shared(is,ie,js,je,CS,G) do j=js,je ; do i=is,ie ! The transition latitude and latitude range are hard-scaled here, since ! this is not really intended for wide-spread use, but rather for diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index b033f8bdfd..d10c17b416 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -640,7 +640,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G call KPP_calculate(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, & fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, & CS%KPP_NLTscalar, Waves=Waves) -!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,Kd_heat) +!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,G,Kd_heat,Hml) if (associated(Hml)) then call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 2e9eaca122..d41d85307e 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -355,11 +355,11 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! GMM, fix OMP calls below !$OMP parallel do default(none) shared(is,ie,js,je,nz,G,GV,CS,h,tv,T_f,S_f,fluxes,dd, & -!$OMP Kd,Kd_sfc,epsilon,deg_to_rad,I_2Omega,visc, & +!$OMP Kd,visc, & !$OMP Kd_int,dt,u,v,Omega2) & -!$OMP private(dRho_int,I_trans,atan_fn_sfc,I_atan_fn,atan_fn_lay, & -!$OMP I_Hmix,depth_c,depth,N2_lay, N2_int, N2_bot, & -!$OMP I_x30,abs_sin,N_2Omega,N02_N2,KT_extra, KS_extra, & +!$OMP private(dRho_int, & +!$OMP N2_lay, N2_int, N2_bot, & +!$OMP KT_extra, KS_extra, & !$OMP TKE_to_Kd,maxTKE,dissip,kb) do j=js,je From afd6c068f2a1e79d9851131f4bff4b4faaec0f02 Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Thu, 26 Apr 2018 11:34:04 -0400 Subject: [PATCH 0126/1072] update MOM6_DA_hooks submodule --- pkg/MOM6_DA_hooks | 2 +- src/ocean_data_assim/MOM_oda_driver.F90 | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/pkg/MOM6_DA_hooks b/pkg/MOM6_DA_hooks index 3f4010d24e..6d8834ca8c 160000 --- a/pkg/MOM6_DA_hooks +++ b/pkg/MOM6_DA_hooks @@ -1 +1 @@ -Subproject commit 3f4010d24e61b9336f4ebb499e049477e47661a1 +Subproject commit 6d8834ca8cf399f1a0d202239d72919907f6cd74 diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 3799de245e..d473e19daf 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -38,11 +38,11 @@ module MOM_oda_driver_mod use time_manager_mod, only : get_date, get_time, operator(>=),operator(/=),operator(==),operator(<) use constants_mod, only : radius, epsln ! ODA Modules - use oda_types_mod, only : grid_type, ocean_profile_type, ocean_control_struct - use oda_core_mod, only : oda_core_init, get_profiles + use ocean_da_types_mod, only : grid_type, ocean_profile_type, ocean_control_struct + use ocean_da_core_mod, only : ocean_da_core_init, get_profiles !use eakf_oda_mod, only : ensemble_filter - use write_ocean_data_mod, only : open_profile_file - use write_ocean_data_mod, only : write_profile,close_profile_file + use write_ocean_obs_mod, only : open_profile_file + use write_ocean_obs_mod, only : write_profile,close_profile_file use kdtree, only : kd_root !# JEDI ! MOM Modules use MOM_io, only : slasher, MOM_read_data @@ -314,7 +314,7 @@ subroutine init_oda(Time, G, GV, CS) global2D_old = global2D end do - call oda_core_init(CS%mpp_domain, T_grid, CS%Profiles, Time) + call ocean_da_core_init(CS%mpp_domain, T_grid, CS%Profiles, Time) CS%Time=Time !! switch back to ensemble member pelist From 98fba0b58f2cb50b4ca5d552fb3dfde8f1160b79 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Thu, 26 Apr 2018 14:09:26 -0400 Subject: [PATCH 0127/1072] gitlab: New build stages to test compiling without libraries - New jobs build ocean_only and ice_ocean_SIS2 without the libfms.a step. This will help detect namespace collisions that the library approach does not complain about. --- .gitlab-ci.yml | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index ac662a0303..17abc9b0e3 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -51,6 +51,30 @@ gnu:repro: - time make -f MRS/Makefile.build MOM6_SRC=../ static_gnu -s -j - time tar zvcf $CACHE_DIR/build-gnu-repro-$CI_PIPELINE_ID.tgz `find build/gnu -name MOM6` +gnu:ocean-only-nolibs: + stage: builds + tags: + - ncrc4 + script: + - time tar zxf $CACHE_DIR/tests_$CI_PIPELINE_ID.tgz && cd tests + - make -f MRS/Makefile.build build/gnu/env && cd build/gnu + # mkdir -p build/gnu/repro/symmetric_dynamic/ocean_only && cd build/gnu/repro/symmetric_dynamic/ocean_only + - ../../MOM6-examples/src/mkmf/bin/list_paths -l ../../../config_src/{solo_driver,dynamic_symmetric} ../../../src ../../MOM6-examples/src/FMS + - ../../MOM6-examples/src/mkmf/bin/mkmf -t ../../MOM6-examples/src/mkmf/templates/ncrc-gnu.mk -p MOM6 -c"-Duse_libMPI -Duse_netCDF" path_names + - time (source ./env ; make NETCDF=3 REPRO=1 MOM6 -s -j) + +gnu:ice-ocean-nolibs: + stage: builds + tags: + - ncrc4 + script: + - time tar zxf $CACHE_DIR/tests_$CI_PIPELINE_ID.tgz && cd tests + - make -f MRS/Makefile.build build/gnu/env && cd build/gnu + # mkdir -p build/gnu/repro/symmetric_dynamic/ocean_only && cd build/gnu/repro/symmetric_dynamic/ocean_only + - ../../MOM6-examples/src/mkmf/bin/list_paths -l ../../../config_src/{coupled_driver,dynamic} ../../../src ../../MOM6-examples/src/{FMS,coupler,SIS2,icebergs,ice_ocean_extras,land_null,atmos_null} + - ../../MOM6-examples/src/mkmf/bin/mkmf -t ../../MOM6-examples/src/mkmf/templates/ncrc-gnu.mk -p MOM6 -c"-Duse_libMPI -Duse_netCDF -D_USE_LEGACY_LAND_ -Duse_AM3_physics" path_names + - time (source ./env ; make NETCDF=3 REPRO=1 MOM6 -s -j) + intel:repro: stage: builds tags: From b0fec2f4a3c3f9b6c095821dd659982d9cb24a0d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 26 Apr 2018 14:54:49 -0400 Subject: [PATCH 0128/1072] Replaced ASSOCIATED() with associated() Replaced instances where ASSOCIATED(), ALLOCATED(), ALLOCATE() and DEALLOCATE() were written in all capital letters with their lowercase counterparts, to avoid confusion with CPP macros and for greater code standardization. All answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 68 ++--- config_src/coupled_driver/ocean_model_MOM.F90 | 2 +- .../ice_solo_driver/user_surface_forcing.F90 | 2 +- config_src/mct_driver/ocn_comp_mct.F90 | 50 ++-- .../solo_driver/MESO_surface_forcing.F90 | 2 +- .../solo_driver/Neverland_surface_forcing.F90 | 2 +- .../solo_driver/user_surface_forcing.F90 | 2 +- src/core/MOM_CoriolisAdv.F90 | 16 +- src/core/MOM_PressureForce_Montgomery.F90 | 8 +- src/core/MOM_forcing_type.F90 | 258 +++++++++--------- src/core/MOM_open_boundary.F90 | 2 +- src/diagnostics/MOM_PointAccel.F90 | 48 ++-- src/diagnostics/MOM_diag_to_Z.F90 | 6 +- src/diagnostics/MOM_diagnostics.F90 | 146 +++++----- src/diagnostics/MOM_sum_output.F90 | 26 +- src/framework/MOM_horizontal_regridding.F90 | 6 +- src/framework/MOM_restart.F90 | 62 ++--- src/framework/MOM_safe_alloc.F90 | 14 +- src/ice_shelf/MOM_ice_shelf.F90 | 68 ++--- src/initialization/MOM_grid_initialize.F90 | 2 +- .../MOM_state_initialization.F90 | 2 +- src/ocean_data_assim/MOM_oda_driver.F90 | 4 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 46 ++-- .../lateral/MOM_thickness_diffuse.F90 | 22 +- .../vertical/MOM_bulk_mixed_layer.F90 | 44 +-- .../vertical/MOM_diabatic_aux.F90 | 16 +- .../vertical/MOM_diabatic_driver.F90 | 44 +-- .../vertical/MOM_energetic_PBL.F90 | 4 +- .../vertical/MOM_entrain_diffusive.F90 | 8 +- .../vertical/MOM_geothermal.F90 | 2 +- .../vertical/MOM_opacity.F90 | 12 +- .../vertical/MOM_regularize_layers.F90 | 2 +- .../vertical/MOM_set_diffusivity.F90 | 8 +- .../vertical/MOM_vert_friction.F90 | 12 +- src/tracer/MOM_generic_tracer.F90 | 2 +- src/tracer/MOM_neutral_diffusion.F90 | 2 +- src/tracer/MOM_offline_aux.F90 | 4 +- src/tracer/MOM_tracer_diabatic.F90 | 2 +- src/user/BFB_surface_forcing.F90 | 2 +- src/user/MOM_wave_interface.F90 | 54 ++-- src/user/dumbbell_surface_forcing.F90 | 2 +- 41 files changed, 542 insertions(+), 542 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 6b0fedc336..370cc9ad99 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -451,80 +451,80 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, do j=js,je ; do i=is,ie 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 + 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 elseif (wind_stagger == AGRID) then - if (ASSOCIATED(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (ASSOCIATED(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier else ! C-grid wind stresses. - if (ASSOCIATED(IOB%u_flux)) forces%taux(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (ASSOCIATED(IOB%v_flux)) forces%tauy(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%u_flux)) forces%taux(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%v_flux)) forces%tauy(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier endif - if (ASSOCIATED(IOB%lprec)) & + if (associated(IOB%lprec)) & fluxes%lprec(i,j) = IOB%lprec(i-i0,j-j0) * G%mask2dT(i,j) - if (ASSOCIATED(IOB%fprec)) & + if (associated(IOB%fprec)) & fluxes%fprec(i,j) = IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j) - if (ASSOCIATED(IOB%q_flux)) & + if (associated(IOB%q_flux)) & fluxes%evap(i,j) = - IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) - if (ASSOCIATED(IOB%runoff)) & + if (associated(IOB%runoff)) & fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) - if (ASSOCIATED(IOB%calving)) & + if (associated(IOB%calving)) & fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) - 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)))) & + 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)) & + if (associated(IOB%ustar_berg)) & fluxes%ustar_berg(i,j) = IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) - if (ASSOCIATED(IOB%area_berg)) & + 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)) & + if (associated(IOB%mass_berg)) & fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) - if (ASSOCIATED(IOB%runoff_hflx)) & + if (associated(IOB%runoff_hflx)) & fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) - if (ASSOCIATED(IOB%calving_hflx)) & + if (associated(IOB%calving_hflx)) & fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) - if (ASSOCIATED(IOB%lw_flux)) & + if (associated(IOB%lw_flux)) & fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) - if (ASSOCIATED(IOB%t_flux)) & + if (associated(IOB%t_flux)) & fluxes%sens(i,j) = - IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) fluxes%latent(i,j) = 0.0 - if (ASSOCIATED(IOB%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 - if (ASSOCIATED(IOB%calving)) then + if (associated(IOB%calving)) then fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion endif - if (ASSOCIATED(IOB%q_flux)) then + if (associated(IOB%q_flux)) then fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor endif fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) - if (ASSOCIATED(IOB%sw_flux_vis_dir)) & + 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)) & + 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)) & + 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)) & + 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) @@ -532,7 +532,7 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, enddo ; enddo ! more salt restoring logic - if (ASSOCIATED(IOB%salt_flux)) then + 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) ) @@ -563,7 +563,7 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, ! 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 - if (ASSOCIATED(IOB%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & + 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) @@ -584,7 +584,7 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, endif ! applied surface pressure from atmosphere and cryosphere - if (ASSOCIATED(IOB%p)) then + 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) @@ -1228,11 +1228,11 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) 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)) & + if (associated(iobt%ustar_berg)) & write(outunit,100) 'iobt%ustar_berg ', mpp_chksum( iobt%ustar_berg ) - if (ASSOCIATED(iobt%area_berg)) & + if (associated(iobt%area_berg)) & write(outunit,100) 'iobt%area_berg ', mpp_chksum( iobt%area_berg ) - if (ASSOCIATED(iobt%mass_berg)) & + if (associated(iobt%mass_berg)) & write(outunit,100) 'iobt%mass_berg ', mpp_chksum( iobt%mass_berg ) 100 FORMAT(" CHECKSUM::",A20," = ",Z20) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 332a1dd7b4..d153a2f04c 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -402,7 +402,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) call MOM_wave_interface_init_lite(param_file) endif - if (ASSOCIATED(OS%grid%Domain%maskmap)) then + 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, & gas_fields_ocn=gas_fields_ocn) diff --git a/config_src/ice_solo_driver/user_surface_forcing.F90 b/config_src/ice_solo_driver/user_surface_forcing.F90 index 1139070560..098931351c 100644 --- a/config_src/ice_solo_driver/user_surface_forcing.F90 +++ b/config_src/ice_solo_driver/user_surface_forcing.F90 @@ -293,7 +293,7 @@ subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) ! MOM_diag_mediator, but is here so as to be completely transparent. real, pointer :: ptr(:,:) integer :: isd, ied, jsd, jed - if (.not.ASSOCIATED(ptr)) then + if (.not.associated(ptr)) then allocate(ptr(isd:ied,jsd:jed)) ptr(:,:) = 0.0 endif diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index a24dd03fd9..35217b5c8e 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -890,7 +890,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i 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 + 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, & gas_fields_ocn=gas_fields_ocn) @@ -2050,70 +2050,70 @@ subroutine ocn_import(forces, fluxes, Time, G, CS, state, x2o_o, ind, sw_decomp, endif ! liquid precipitation (rain) - if (ASSOCIATED(fluxes%lprec)) & + if (associated(fluxes%lprec)) & fluxes%lprec(i,j) = x2o_o(ind%x2o_Faxa_rain,k) * G%mask2dT(i,j) ! frozen precipitation (snow) - if (ASSOCIATED(fluxes%fprec)) & + if (associated(fluxes%fprec)) & fluxes%fprec(i,j) = x2o_o(ind%x2o_Faxa_snow,k) * G%mask2dT(i,j) ! evaporation - if (ASSOCIATED(fluxes%evap)) & + if (associated(fluxes%evap)) & fluxes%evap(i,j) = x2o_o(ind%x2o_Foxx_evap,k) * G%mask2dT(i,j) ! river runoff flux - if (ASSOCIATED(fluxes%lrunoff)) & + if (associated(fluxes%lrunoff)) & fluxes%lrunoff(i,j) = x2o_o(ind%x2o_Foxx_rofl,k) * G%mask2dT(i,j) ! ice runoff flux - if (ASSOCIATED(fluxes%frunoff)) & + if (associated(fluxes%frunoff)) & fluxes%frunoff(i,j) = x2o_o(ind%x2o_Foxx_rofi,k) * G%mask2dT(i,j) ! 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)))) & + !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)) & + !if (associated(IOB%ustar_berg)) & ! fluxes%ustar_berg(i,j) = IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) - !if (ASSOCIATED(IOB%area_berg)) & + !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)) & + !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)) & + if (associated(fluxes%heat_content_lrunoff)) & fluxes%heat_content_lrunoff(i,j) = 0.0 * G%mask2dT(i,j) - if (ASSOCIATED(fluxes%heat_content_frunoff)) & + if (associated(fluxes%heat_content_frunoff)) & fluxes%heat_content_frunoff(i,j) = 0.0 * G%mask2dT(i,j) ! longwave radiation, sum up and down (W/m2) - if (ASSOCIATED(fluxes%LW)) & + if (associated(fluxes%LW)) & fluxes%LW(i,j) = (x2o_o(ind%x2o_Faxa_lwdn,k) + x2o_o(ind%x2o_Foxx_lwup,k)) * G%mask2dT(i,j) ! sensible heat flux (W/m2) - if (ASSOCIATED(fluxes%sens)) & + if (associated(fluxes%sens)) & fluxes%sens(i,j) = x2o_o(ind%x2o_Foxx_sen,k) * G%mask2dT(i,j) ! latent heat flux (W/m^2) - if (ASSOCIATED(fluxes%latent)) & + if (associated(fluxes%latent)) & fluxes%latent(i,j) = x2o_o(ind%x2o_Foxx_lat,k) * G%mask2dT(i,j) if (sw_decomp) then ! Use runtime coefficients to decompose net short-wave heat flux into 4 components ! 1) visible, direct shortwave (W/m2) - if (ASSOCIATED(fluxes%sw_vis_dir)) & + if (associated(fluxes%sw_vis_dir)) & fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * x2o_o(ind%x2o_Foxx_swnet,k)*c1 ! 2) visible, diffuse shortwave (W/m2) - if (ASSOCIATED(fluxes%sw_vis_dif)) & + if (associated(fluxes%sw_vis_dif)) & fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * x2o_o(ind%x2o_Foxx_swnet,k)*c2 ! 3) near-IR, direct shortwave (W/m2) - if (ASSOCIATED(fluxes%sw_nir_dir)) & + if (associated(fluxes%sw_nir_dir)) & fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * x2o_o(ind%x2o_Foxx_swnet,k)*c3 ! 4) near-IR, diffuse shortwave (W/m2) - if (ASSOCIATED(fluxes%sw_nir_dif)) & + if (associated(fluxes%sw_nir_dif)) & fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * x2o_o(ind%x2o_Foxx_swnet,k)*c4 fluxes%sw(i,j) = fluxes%sw_vis_dir(i,j) + fluxes%sw_vis_dif(i,j) + & @@ -2125,7 +2125,7 @@ subroutine ocn_import(forces, fluxes, Time, G, CS, state, x2o_o, ind, sw_decomp, ! applied surface pressure from atmosphere and cryosphere ! sea-level pressure (Pa) - if (ASSOCIATED(forces%p_surf_full) .and. ASSOCIATED(forces%p_surf)) then + if (associated(forces%p_surf_full) .and. associated(forces%p_surf)) then forces%p_surf_full(i,j) = G%mask2dT(i,j) * x2o_o(ind%x2o_Sa_pslv,k) if (CS%max_p_surf >= 0.0) then forces%p_surf(i,j) = MIN(forces%p_surf_full(i,j),CS%max_p_surf) @@ -2143,10 +2143,10 @@ subroutine ocn_import(forces, fluxes, Time, G, CS, state, x2o_o, ind, sw_decomp, ! salt flux ! more salt restoring logic - if (ASSOCIATED(fluxes%salt_flux)) & + if (associated(fluxes%salt_flux)) & fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(x2o_o(ind%x2o_Fioi_salt,k) + fluxes%salt_flux(i,j)) - if (ASSOCIATED(fluxes%salt_flux_in)) & + if (associated(fluxes%salt_flux_in)) & fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*x2o_o(ind%x2o_Fioi_salt,k) enddo ; enddo @@ -2164,7 +2164,7 @@ subroutine ocn_import(forces, fluxes, Time, G, CS, state, x2o_o, ind, sw_decomp, ! 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 - if (ASSOCIATED(fluxes%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & + 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) diff --git a/config_src/solo_driver/MESO_surface_forcing.F90 b/config_src/solo_driver/MESO_surface_forcing.F90 index 86dd23eb06..513358932e 100644 --- a/config_src/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/solo_driver/MESO_surface_forcing.F90 @@ -329,7 +329,7 @@ subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) ! MOM_diag_mediator, but is here so as to be completely transparent. real, pointer :: ptr(:,:) integer :: isd, ied, jsd, jed - if (.not.ASSOCIATED(ptr)) then + if (.not.associated(ptr)) then allocate(ptr(isd:ied,jsd:jed)) ptr(:,:) = 0.0 endif diff --git a/config_src/solo_driver/Neverland_surface_forcing.F90 b/config_src/solo_driver/Neverland_surface_forcing.F90 index 9b020d4fc1..588fa5fde8 100644 --- a/config_src/solo_driver/Neverland_surface_forcing.F90 +++ b/config_src/solo_driver/Neverland_surface_forcing.F90 @@ -211,7 +211,7 @@ end subroutine Neverland_buoyancy_forcing subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) real, pointer :: ptr(:,:) integer :: isd, ied, jsd, jed - if (.not.ASSOCIATED(ptr)) then + if (.not.associated(ptr)) then allocate(ptr(isd:ied,jsd:jed)) ptr(:,:) = 0.0 endif diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90 index 61084cb3f6..3127101cb4 100644 --- a/config_src/solo_driver/user_surface_forcing.F90 +++ b/config_src/solo_driver/user_surface_forcing.F90 @@ -296,7 +296,7 @@ subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) ! MOM_diag_mediator, but is here so as to be completely transparent. real, pointer :: ptr(:,:) integer :: isd, ied, jsd, jed - if (.not.ASSOCIATED(ptr)) then + if (.not.associated(ptr)) then allocate(ptr(isd:ied,jsd:jed)) ptr(:,:) = 0.0 endif diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index c32352acb1..b1916d838a 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -411,7 +411,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) if (CS%id_rv > 0) RV(I,J,k) = relative_vorticity if (CS%id_PV > 0) PV(I,J,k) = q(I,J) - if (ASSOCIATED(AD%rv_x_v) .or. ASSOCIATED(AD%rv_x_u)) & + if (associated(AD%rv_x_v) .or. associated(AD%rv_x_u)) & q2(I,J) = relative_vorticity * Ih enddo ; enddo @@ -642,7 +642,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) ! Term - d(KE)/dx. do j=js,je ; do I=Isq,Ieq CAu(I,j,k) = CAu(I,j,k) - KEx(I,j) - if (ASSOCIATED(AD%gradKEu)) AD%gradKEu(I,j,k) = -KEx(I,j) + if (associated(AD%gradKEu)) AD%gradKEu(I,j,k) = -KEx(I,j) enddo ; enddo @@ -748,13 +748,13 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) ! Term - d(KE)/dy. do J=Jsq,Jeq ; do i=is,ie CAv(i,J,k) = CAv(i,J,k) - KEy(i,J) - if (ASSOCIATED(AD%gradKEv)) AD%gradKEv(i,J,k) = -KEy(i,J) + if (associated(AD%gradKEv)) AD%gradKEv(i,J,k) = -KEy(i,J) enddo ; enddo - if (ASSOCIATED(AD%rv_x_u) .or. ASSOCIATED(AD%rv_x_v)) then + if (associated(AD%rv_x_u) .or. associated(AD%rv_x_v)) then ! Calculate the Coriolis-like acceleration due to relative vorticity. if (CS%Coriolis_Scheme == SADOURNY75_ENERGY) then - if (ASSOCIATED(AD%rv_x_u)) then + if (associated(AD%rv_x_u)) then do J=Jsq,Jeq ; do i=is,ie AD%rv_x_u(i,J,k) = - 0.25* & (q2(I-1,j)*(uh(I-1,j,k) + uh(I-1,j+1,k)) + & @@ -762,7 +762,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) enddo ; enddo endif - if (ASSOCIATED(AD%rv_x_v)) then + if (associated(AD%rv_x_v)) then do j=js,je ; do I=Isq,Ieq AD%rv_x_v(I,j,k) = 0.25 * & (q2(I,j) * (vh(i+1,J,k) + vh(i,J,k)) + & @@ -770,7 +770,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) enddo ; enddo endif else - if (ASSOCIATED(AD%rv_x_u)) then + if (associated(AD%rv_x_u)) then do J=Jsq,Jeq ; do i=is,ie AD%rv_x_u(i,J,k) = -G%IdyCv(i,J) * C1_12 * & ((q2(I,J) + q2(I-1,J) + q2(I-1,J-1)) * uh(I-1,j,k) + & @@ -780,7 +780,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) enddo ; enddo endif - if (ASSOCIATED(AD%rv_x_v)) then + if (associated(AD%rv_x_v)) then do j=js,je ; do I=Isq,Ieq AD%rv_x_v(I,j,k) = G%IdxCu(I,j) * C1_12 * & ((q2(I+1,J) + q2(I,J) + q2(I,J-1)) * vh(i+1,J,k) + & diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index d47692f2bc..147f264cc3 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -328,14 +328,14 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, ((dp_star(i,j) * dp_star(i+1,j) + (p(i,j,K) * dp_star(i+1,j) + & p(i+1,j,K) * dp_star(i,j))) / (dp_star(i,j) + dp_star(i+1,j)))) PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) + PFu_bc - if (ASSOCIATED(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc + if (associated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc enddo ; enddo do J=Jsq,Jeq ; do i=is,ie PFv_bc = (alpha_star(i,j+1,k) - alpha_star(i,j,k)) * (G%IdyCv(i,J) * & ((dp_star(i,j) * dp_star(i,j+1) + (p(i,j,K) * dp_star(i,j+1) + & p(i,j+1,K) * dp_star(i,j))) / (dp_star(i,j) + dp_star(i,j+1)))) PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) + PFv_bc - if (ASSOCIATED(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc + if (associated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc enddo ; enddo enddo ! k-loop else ! .not. use_EOS @@ -568,14 +568,14 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ((h_star(i,j) * h_star(i+1,j) - (e(i,j,K) * h_star(i+1,j) + & e(i+1,j,K) * h_star(i,j))) / (h_star(i,j) + h_star(i+1,j)))) PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) + PFu_bc - if (ASSOCIATED(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc + if (associated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc enddo ; enddo do J=Jsq,Jeq ; do i=is,ie PFv_bc = -1.0*(rho_star(i,j+1,k) - rho_star(i,j,k)) * (G%IdyCv(i,J) * & ((h_star(i,j) * h_star(i,j+1) - (e(i,j,K) * h_star(i,j+1) + & e(i,j+1,K) * h_star(i,j))) / (h_star(i,j) + h_star(i,j+1)))) PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) + PFv_bc - if (ASSOCIATED(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc + if (associated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc enddo ; enddo enddo ! k-loop else ! .not. use_EOS diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 7ac8b79f84..2d94984d4e 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -409,26 +409,26 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, "mismatch in the number of bands of shortwave radiation in MOM_forcing_type extract_fluxes.") endif - if (.not.ASSOCIATED(fluxes%sw)) call MOM_error(FATAL, & + if (.not.associated(fluxes%sw)) call MOM_error(FATAL, & "MOM_forcing_type extractFluxes1d: fluxes%sw is not associated.") - if (.not.ASSOCIATED(fluxes%lw)) call MOM_error(FATAL, & + if (.not.associated(fluxes%lw)) call MOM_error(FATAL, & "MOM_forcing_type extractFluxes1d: fluxes%lw is not associated.") - if (.not.ASSOCIATED(fluxes%latent)) call MOM_error(FATAL, & + if (.not.associated(fluxes%latent)) call MOM_error(FATAL, & "MOM_forcing_type extractFluxes1d: fluxes%latent is not associated.") - if (.not.ASSOCIATED(fluxes%sens)) call MOM_error(FATAL, & + if (.not.associated(fluxes%sens)) call MOM_error(FATAL, & "MOM_forcing_type extractFluxes1d: fluxes%sens is not associated.") - if (.not.ASSOCIATED(fluxes%evap)) call MOM_error(FATAL, & + if (.not.associated(fluxes%evap)) call MOM_error(FATAL, & "MOM_forcing_type extractFluxes1d: No evaporation defined.") - if (.not.ASSOCIATED(fluxes%vprec)) call MOM_error(FATAL, & + if (.not.associated(fluxes%vprec)) call MOM_error(FATAL, & "MOM_forcing_type extractFluxes1d: fluxes%vprec not defined.") - if ((.not.ASSOCIATED(fluxes%lprec)) .or. & - (.not.ASSOCIATED(fluxes%fprec))) call MOM_error(FATAL, & + if ((.not.associated(fluxes%lprec)) .or. & + (.not.associated(fluxes%fprec))) call MOM_error(FATAL, & "MOM_forcing_type extractFluxes1d: No precipitation defined.") do i=is,ie ; htot(i) = h(i,1) ; enddo @@ -486,7 +486,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! total salt mass ocean+ice, the sea ice model must lose mass when salt mass ! is added to the ocean, which may still need to be coded. Not that the units ! of netMassInOut are still kg_m2, so no conversion to H should occur yet. - if (.not.GV%Boussinesq .and. ASSOCIATED(fluxes%salt_flux)) then + if (.not.GV%Boussinesq .and. associated(fluxes%salt_flux)) then netMassInOut(i) = netMassInOut(i) + dt * (scale * fluxes%salt_flux(i,j)) if (do_NMIOr) netMassInOut_rate(i) = netMassInOut_rate(i) + (scale * fluxes%salt_flux(i,j)) endif @@ -500,7 +500,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! which case heat_content_evap is computed in MOM_diabatic_driver.F90 if(fluxes%evap(i,j) < 0.0) then netMassOut(i) = netMassOut(i) + fluxes%evap(i,j) - ! if(ASSOCIATED(fluxes%heat_content_cond)) fluxes%heat_content_cond(i,j) = 0.0 !??? --AJA + ! if(associated(fluxes%heat_content_cond)) fluxes%heat_content_cond(i,j) = 0.0 !??? --AJA endif ! lprec < 0 means sea ice formation taking water from the ocean. @@ -529,7 +529,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, if (do_NHR) net_heat_rate(i) = scale * J_m2_to_H * & ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)) ) ! Add heat flux from surface damping (restoring) (K * H) or flux adjustments. - if (ASSOCIATED(fluxes%heat_added)) then + if (associated(fluxes%heat_added)) then net_heat(i) = net_heat(i) + (scale * (dt * J_m2_to_H)) * fluxes%heat_added(i,j) if (do_NHR) net_heat_rate(i) = net_heat_rate(i) + (scale * (J_m2_to_H)) * fluxes%heat_added(i,j) endif @@ -545,7 +545,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, !if (do_NHR) net_heat_rate(i) = (net_heat_rate(i) + (scale*(J_m2_to_H)) * fluxes%heat_content_lrunoff(i,j)) - & ! (GV%kg_m2_to_H * (scale)) * fluxes%lrunoff(i,j) * T(i,1) !}BGR - if (calculate_diags .and. ASSOCIATED(tv%TempxPmE)) then + if (calculate_diags .and. associated(tv%TempxPmE)) then tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + (scale * dt) * & (I_Cp*fluxes%heat_content_lrunoff(i,j) - fluxes%lrunoff(i,j)*T(i,1)) endif @@ -562,7 +562,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! if (do_NHR) net_heat_rate(i) = net_heat_rate(i) + (scale*(J_m2_to_H)) * fluxes%heat_content_frunoff(i,j) - & ! (GV%kg_m2_to_H * (scale)) * fluxes%frunoff(i,j) * T(i,1) !}BGR - if (calculate_diags .and. ASSOCIATED(tv%TempxPmE)) then + if (calculate_diags .and. associated(tv%TempxPmE)) then tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + (scale * dt) * & (I_Cp*fluxes%heat_content_frunoff(i,j) - fluxes%frunoff(i,j)*T(i,1)) endif @@ -577,7 +577,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! one layer of the upper ocean in the case of very thin layers. ! When evap, lprec, or vprec > 0, then we know their heat content here ! via settings from inside of the appropriate config_src driver files. -! if (ASSOCIATED(fluxes%heat_content_lprec)) then +! if (associated(fluxes%heat_content_lprec)) then ! net_heat(i) = net_heat(i) + scale * dt * J_m2_to_H * & ! (fluxes%heat_content_lprec(i,j) + (fluxes%heat_content_fprec(i,j) + & ! (fluxes%heat_content_lrunoff(i,j) + (fluxes%heat_content_frunoff(i,j) + & @@ -613,7 +613,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! Convert salt_flux from kg (salt)/(m^2 * s) to ! Boussinesq: (ppt * m) ! non-Bouss: (g/m^2) - if (ASSOCIATED(fluxes%salt_flux)) then + if (associated(fluxes%salt_flux)) then Net_salt(i) = (scale * dt * (1000.0 * fluxes%salt_flux(i,j))) * GV%kg_m2_to_H !Repeat above code for 'rate' term if (do_NSR) Net_salt_rate(i) = (scale * 1. * (1000.0 * fluxes%salt_flux(i,j))) * GV%kg_m2_to_H @@ -623,13 +623,13 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, if (calculate_diags) then ! Store Net_salt for unknown reason? - if (ASSOCIATED(fluxes%salt_flux)) then + if (associated(fluxes%salt_flux)) then if (calculate_diags) fluxes%netSalt(i,j) = Net_salt(i) endif ! Initialize heat_content_massin that is diagnosed in mixedlayer_convection or ! applyBoundaryFluxes such that the meaning is as the sum of all incoming components. - if (ASSOCIATED(fluxes%heat_content_massin)) then + if (associated(fluxes%heat_content_massin)) then if (aggregate_FW_forcing) then if (netMassInOut(i) > 0.0) then ! net is "in" fluxes%heat_content_massin(i,j) = -fluxes%C_p * netMassOut(i) * T(i,1) * GV%H_to_kg_m2 / dt @@ -643,7 +643,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! Initialize heat_content_massout that is diagnosed in mixedlayer_convection or ! applyBoundaryFluxes such that the meaning is as the sum of all outgoing components. - if (ASSOCIATED(fluxes%heat_content_massout)) then + if (associated(fluxes%heat_content_massout)) then if (aggregate_FW_forcing) then if (netMassInOut(i) > 0.0) then ! net is "in" fluxes%heat_content_massout(i,j) = fluxes%C_p * netMassOut(i) * T(i,1) * GV%H_to_kg_m2 / dt @@ -662,7 +662,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! fluxes%lprec < 0 means ocean loses mass via sea ice formation. As we do not yet know ! the layer at which this mass is removed, we cannot compute it heat content. We must ! wait until MOM_diabatic_driver.F90. - if (ASSOCIATED(fluxes%heat_content_lprec)) then + if (associated(fluxes%heat_content_lprec)) then if (fluxes%lprec(i,j) > 0.0) then fluxes%heat_content_lprec(i,j) = fluxes%C_p*fluxes%lprec(i,j)*T(i,1) else @@ -673,7 +673,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! fprec SHOULD enter ocean at 0degC if atmos model does not provide fprec heat content. ! However, we need to adjust netHeat above to reflect the difference between 0decC and SST ! and until we do so fprec is treated like lprec and enters at SST. -AJA - if (ASSOCIATED(fluxes%heat_content_fprec)) then + if (associated(fluxes%heat_content_fprec)) then if (fluxes%fprec(i,j) > 0.0) then fluxes%heat_content_fprec(i,j) = fluxes%C_p*fluxes%fprec(i,j)*T(i,1) else @@ -684,7 +684,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! virtual precip associated with salinity restoring ! vprec > 0 means add water to ocean, assumed to be at SST ! vprec < 0 means remove water from ocean; set heat_content_vprec in MOM_diabatic_driver.F90 - if (ASSOCIATED(fluxes%heat_content_vprec)) then + if (associated(fluxes%heat_content_vprec)) then if (fluxes%vprec(i,j) > 0.0) then fluxes%heat_content_vprec(i,j) = fluxes%C_p*fluxes%vprec(i,j)*T(i,1) else @@ -698,7 +698,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! compute fluxes%heat_content_massout at the relevant point inside MOM_diabatic_driver.F90. ! fluxes%evap > 0 means ocean gains moisture via condensation. ! Condensation is assumed to drop into the ocean at the SST, just like lprec. - if (ASSOCIATED(fluxes%heat_content_cond)) then + if (associated(fluxes%heat_content_cond)) then if (fluxes%evap(i,j) > 0.0) then fluxes%heat_content_cond(i,j) = fluxes%C_p*fluxes%evap(i,j)*T(i,1) else @@ -708,14 +708,14 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! Liquid runoff enters ocean at SST if land model does not provide runoff heat content. if (.not. useRiverHeatContent) then - if (ASSOCIATED(fluxes%lrunoff) .and. ASSOCIATED(fluxes%heat_content_lrunoff)) then + if (associated(fluxes%lrunoff) .and. associated(fluxes%heat_content_lrunoff)) then fluxes%heat_content_lrunoff(i,j) = fluxes%C_p*fluxes%lrunoff(i,j)*T(i,1) endif endif ! Icebergs enter ocean at SST if land model does not provide calving heat content. if (.not. useCalvingHeatContent) then - if (ASSOCIATED(fluxes%frunoff) .and. ASSOCIATED(fluxes%heat_content_frunoff)) then + if (associated(fluxes%frunoff) .and. associated(fluxes%heat_content_frunoff)) then fluxes%heat_content_frunoff(i,j) = fluxes%C_p*fluxes%frunoff(i,j)*T(i,1) endif endif @@ -1984,11 +1984,11 @@ subroutine mech_forcing_diags(forces, fluxes, dt, G, diag, handles) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec if (query_averaging_enabled(diag)) then - if ((handles%id_taux > 0) .and. ASSOCIATED(forces%taux)) & + if ((handles%id_taux > 0) .and. associated(forces%taux)) & call post_data(handles%id_taux, forces%taux, diag) - if ((handles%id_tauy > 0) .and. ASSOCIATED(forces%tauy)) & + if ((handles%id_tauy > 0) .and. associated(forces%tauy)) & call post_data(handles%id_tauy, forces%tauy, diag) - if ((handles%id_ustar > 0) .and. ASSOCIATED(fluxes%ustar)) & + if ((handles%id_ustar > 0) .and. associated(fluxes%ustar)) & call post_data(handles%id_ustar, fluxes%ustar, diag) if (handles%id_ustar_berg > 0) & call post_data(handles%id_ustar_berg, fluxes%ustar_berg, diag) @@ -2041,13 +2041,13 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (handles%id_prcme > 0 .or. handles%id_total_prcme > 0 .or. handles%id_prcme_ga > 0) then do j=js,je ; do i=is,ie res(i,j) = 0.0 - if (ASSOCIATED(fluxes%lprec)) res(i,j) = res(i,j)+fluxes%lprec(i,j) - if (ASSOCIATED(fluxes%fprec)) res(i,j) = res(i,j)+fluxes%fprec(i,j) + if (associated(fluxes%lprec)) res(i,j) = res(i,j)+fluxes%lprec(i,j) + if (associated(fluxes%fprec)) res(i,j) = res(i,j)+fluxes%fprec(i,j) ! fluxes%cond is not needed because it is derived from %evap > 0 - if (ASSOCIATED(fluxes%evap)) res(i,j) = res(i,j)+fluxes%evap(i,j) - if (ASSOCIATED(fluxes%lrunoff)) res(i,j) = res(i,j)+fluxes%lrunoff(i,j) - if (ASSOCIATED(fluxes%frunoff)) res(i,j) = res(i,j)+fluxes%frunoff(i,j) - if (ASSOCIATED(fluxes%vprec)) res(i,j) = res(i,j)+fluxes%vprec(i,j) + if (associated(fluxes%evap)) res(i,j) = res(i,j)+fluxes%evap(i,j) + if (associated(fluxes%lrunoff)) res(i,j) = res(i,j)+fluxes%lrunoff(i,j) + if (associated(fluxes%frunoff)) res(i,j) = res(i,j)+fluxes%frunoff(i,j) + if (associated(fluxes%vprec)) res(i,j) = res(i,j)+fluxes%vprec(i,j) enddo ; enddo call post_data(handles%id_prcme, res, diag) if(handles%id_total_prcme > 0) then @@ -2093,18 +2093,18 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if(handles%id_massin_flux > 0) call post_data(handles%id_massin_flux,fluxes%netMassIn,diag) - if ((handles%id_evap > 0) .and. ASSOCIATED(fluxes%evap)) & + if ((handles%id_evap > 0) .and. associated(fluxes%evap)) & call post_data(handles%id_evap, fluxes%evap, diag) - if ((handles%id_total_evap > 0) .and. ASSOCIATED(fluxes%evap)) then + if ((handles%id_total_evap > 0) .and. associated(fluxes%evap)) then total_transport = global_area_integral(fluxes%evap,G) call post_data(handles%id_total_evap, total_transport, diag) endif - if ((handles%id_evap_ga > 0) .and. ASSOCIATED(fluxes%evap)) then + if ((handles%id_evap_ga > 0) .and. associated(fluxes%evap)) then ave_flux = global_area_mean(fluxes%evap,G) call post_data(handles%id_evap_ga, ave_flux, diag) endif - if (ASSOCIATED(fluxes%lprec) .and. ASSOCIATED(fluxes%fprec)) then + if (associated(fluxes%lprec) .and. associated(fluxes%fprec)) then do j=js,je ; do i=is,ie res(i,j) = fluxes%lprec(i,j) + fluxes%fprec(i,j) enddo ; enddo @@ -2119,7 +2119,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) endif endif - if (ASSOCIATED(fluxes%lprec)) then + if (associated(fluxes%lprec)) then if (handles%id_lprec > 0) call post_data(handles%id_lprec, fluxes%lprec, diag) if (handles%id_total_lprec > 0) then total_transport = global_area_integral(fluxes%lprec,G) @@ -2131,7 +2131,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) endif endif - if (ASSOCIATED(fluxes%fprec)) then + if (associated(fluxes%fprec)) then if (handles%id_fprec > 0) call post_data(handles%id_fprec, fluxes%fprec, diag) if (handles%id_total_fprec > 0) then total_transport = global_area_integral(fluxes%fprec,G) @@ -2143,7 +2143,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) endif endif - if (ASSOCIATED(fluxes%vprec)) then + if (associated(fluxes%vprec)) then if (handles%id_vprec > 0) call post_data(handles%id_vprec, fluxes%vprec, diag) if (handles%id_total_vprec > 0) then total_transport = global_area_integral(fluxes%vprec,G) @@ -2155,7 +2155,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) endif endif - if (ASSOCIATED(fluxes%lrunoff)) then + if (associated(fluxes%lrunoff)) then if (handles%id_lrunoff > 0) call post_data(handles%id_lrunoff, fluxes%lrunoff, diag) if (handles%id_total_lrunoff > 0) then total_transport = global_area_integral(fluxes%lrunoff,G) @@ -2163,7 +2163,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) endif endif - if (ASSOCIATED(fluxes%frunoff)) then + if (associated(fluxes%frunoff)) then if (handles%id_frunoff > 0) call post_data(handles%id_frunoff, fluxes%frunoff, diag) if (handles%id_total_frunoff > 0) then total_transport = global_area_integral(fluxes%frunoff,G) @@ -2173,58 +2173,58 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) ! post diagnostics for boundary heat fluxes ==================================== - if ((handles%id_heat_content_lrunoff > 0) .and. ASSOCIATED(fluxes%heat_content_lrunoff)) & + if ((handles%id_heat_content_lrunoff > 0) .and. associated(fluxes%heat_content_lrunoff)) & call post_data(handles%id_heat_content_lrunoff, fluxes%heat_content_lrunoff, diag) - if ((handles%id_total_heat_content_lrunoff > 0) .and. ASSOCIATED(fluxes%heat_content_lrunoff)) then + if ((handles%id_total_heat_content_lrunoff > 0) .and. associated(fluxes%heat_content_lrunoff)) then total_transport = global_area_integral(fluxes%heat_content_lrunoff,G) call post_data(handles%id_total_heat_content_lrunoff, total_transport, diag) endif - if ((handles%id_heat_content_frunoff > 0) .and. ASSOCIATED(fluxes%heat_content_frunoff)) & + if ((handles%id_heat_content_frunoff > 0) .and. associated(fluxes%heat_content_frunoff)) & call post_data(handles%id_heat_content_frunoff, fluxes%heat_content_frunoff, diag) - if ((handles%id_total_heat_content_frunoff > 0) .and. ASSOCIATED(fluxes%heat_content_frunoff)) then + if ((handles%id_total_heat_content_frunoff > 0) .and. associated(fluxes%heat_content_frunoff)) then total_transport = global_area_integral(fluxes%heat_content_frunoff,G) call post_data(handles%id_total_heat_content_frunoff, total_transport, diag) endif - if ((handles%id_heat_content_lprec > 0) .and. ASSOCIATED(fluxes%heat_content_lprec)) & + if ((handles%id_heat_content_lprec > 0) .and. associated(fluxes%heat_content_lprec)) & call post_data(handles%id_heat_content_lprec, fluxes%heat_content_lprec, diag) - if ((handles%id_total_heat_content_lprec > 0) .and. ASSOCIATED(fluxes%heat_content_lprec)) then + if ((handles%id_total_heat_content_lprec > 0) .and. associated(fluxes%heat_content_lprec)) then total_transport = global_area_integral(fluxes%heat_content_lprec,G) call post_data(handles%id_total_heat_content_lprec, total_transport, diag) endif - if ((handles%id_heat_content_fprec > 0) .and. ASSOCIATED(fluxes%heat_content_fprec)) & + if ((handles%id_heat_content_fprec > 0) .and. associated(fluxes%heat_content_fprec)) & call post_data(handles%id_heat_content_fprec, fluxes%heat_content_fprec, diag) - if ((handles%id_total_heat_content_fprec > 0) .and. ASSOCIATED(fluxes%heat_content_fprec)) then + if ((handles%id_total_heat_content_fprec > 0) .and. associated(fluxes%heat_content_fprec)) then total_transport = global_area_integral(fluxes%heat_content_fprec,G) call post_data(handles%id_total_heat_content_fprec, total_transport, diag) endif - if ((handles%id_heat_content_vprec > 0) .and. ASSOCIATED(fluxes%heat_content_vprec)) & + if ((handles%id_heat_content_vprec > 0) .and. associated(fluxes%heat_content_vprec)) & call post_data(handles%id_heat_content_vprec, fluxes%heat_content_vprec, diag) - if ((handles%id_total_heat_content_vprec > 0) .and. ASSOCIATED(fluxes%heat_content_vprec)) then + if ((handles%id_total_heat_content_vprec > 0) .and. associated(fluxes%heat_content_vprec)) then total_transport = global_area_integral(fluxes%heat_content_vprec,G) call post_data(handles%id_total_heat_content_vprec, total_transport, diag) endif - if ((handles%id_heat_content_cond > 0) .and. ASSOCIATED(fluxes%heat_content_cond)) & + if ((handles%id_heat_content_cond > 0) .and. associated(fluxes%heat_content_cond)) & call post_data(handles%id_heat_content_cond, fluxes%heat_content_cond, diag) - if ((handles%id_total_heat_content_cond > 0) .and. ASSOCIATED(fluxes%heat_content_cond)) then + if ((handles%id_total_heat_content_cond > 0) .and. associated(fluxes%heat_content_cond)) then total_transport = global_area_integral(fluxes%heat_content_cond,G) call post_data(handles%id_total_heat_content_cond, total_transport, diag) endif - if ((handles%id_heat_content_massout > 0) .and. ASSOCIATED(fluxes%heat_content_massout)) & + if ((handles%id_heat_content_massout > 0) .and. associated(fluxes%heat_content_massout)) & call post_data(handles%id_heat_content_massout, fluxes%heat_content_massout, diag) - if ((handles%id_total_heat_content_massout > 0) .and. ASSOCIATED(fluxes%heat_content_massout)) then + if ((handles%id_total_heat_content_massout > 0) .and. associated(fluxes%heat_content_massout)) then total_transport = global_area_integral(fluxes%heat_content_massout,G) call post_data(handles%id_total_heat_content_massout, total_transport, diag) endif - if ((handles%id_heat_content_massin > 0) .and. ASSOCIATED(fluxes%heat_content_massin)) & + if ((handles%id_heat_content_massin > 0) .and. associated(fluxes%heat_content_massin)) & call post_data(handles%id_heat_content_massin, fluxes%heat_content_massin, diag) - if ((handles%id_total_heat_content_massin > 0) .and. ASSOCIATED(fluxes%heat_content_massin)) then + if ((handles%id_total_heat_content_massin > 0) .and. associated(fluxes%heat_content_massin)) then total_transport = global_area_integral(fluxes%heat_content_massin,G) call post_data(handles%id_total_heat_content_massin, total_transport, diag) endif @@ -2232,10 +2232,10 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (handles%id_net_heat_coupler > 0 .or. handles%id_total_net_heat_coupler > 0 .or. handles%id_net_heat_coupler_ga > 0. ) then do j=js,je ; do i=is,ie res(i,j) = 0.0 - if (ASSOCIATED(fluxes%LW)) res(i,j) = res(i,j) + fluxes%LW(i,j) - if (ASSOCIATED(fluxes%latent)) res(i,j) = res(i,j) + fluxes%latent(i,j) - if (ASSOCIATED(fluxes%sens)) res(i,j) = res(i,j) + fluxes%sens(i,j) - if (ASSOCIATED(fluxes%SW)) res(i,j) = res(i,j) + fluxes%SW(i,j) + if (associated(fluxes%LW)) res(i,j) = res(i,j) + fluxes%LW(i,j) + if (associated(fluxes%latent)) res(i,j) = res(i,j) + fluxes%latent(i,j) + if (associated(fluxes%sens)) res(i,j) = res(i,j) + fluxes%sens(i,j) + if (associated(fluxes%SW)) res(i,j) = res(i,j) + fluxes%SW(i,j) enddo ; enddo call post_data(handles%id_net_heat_coupler, res, diag) if(handles%id_total_net_heat_coupler > 0) then @@ -2251,23 +2251,23 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (handles%id_net_heat_surface > 0 .or. handles%id_total_net_heat_surface > 0 .or. handles%id_net_heat_surface_ga > 0. ) then do j=js,je ; do i=is,ie res(i,j) = 0.0 - if (ASSOCIATED(fluxes%LW)) res(i,j) = res(i,j) + fluxes%LW(i,j) - if (ASSOCIATED(fluxes%latent)) res(i,j) = res(i,j) + fluxes%latent(i,j) - if (ASSOCIATED(fluxes%sens)) res(i,j) = res(i,j) + fluxes%sens(i,j) - if (ASSOCIATED(fluxes%SW)) res(i,j) = res(i,j) + fluxes%SW(i,j) - if (ASSOCIATED(sfc_state%frazil)) res(i,j) = res(i,j) + sfc_state%frazil(i,j) * I_dt - ! if (ASSOCIATED(sfc_state%TempXpme)) then + if (associated(fluxes%LW)) res(i,j) = res(i,j) + fluxes%LW(i,j) + if (associated(fluxes%latent)) res(i,j) = res(i,j) + fluxes%latent(i,j) + if (associated(fluxes%sens)) res(i,j) = res(i,j) + fluxes%sens(i,j) + if (associated(fluxes%SW)) res(i,j) = res(i,j) + fluxes%SW(i,j) + if (associated(sfc_state%frazil)) res(i,j) = res(i,j) + sfc_state%frazil(i,j) * I_dt + ! if (associated(sfc_state%TempXpme)) then ! res(i,j) = res(i,j) + sfc_state%TempXpme(i,j) * fluxes%C_p * I_dt ! else - if (ASSOCIATED(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) - if (ASSOCIATED(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) - if (ASSOCIATED(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) - if (ASSOCIATED(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) - if (ASSOCIATED(fluxes%heat_content_vprec)) res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j) - if (ASSOCIATED(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) - if (ASSOCIATED(fluxes%heat_content_massout)) res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j) + if (associated(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) + if (associated(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) + if (associated(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) + if (associated(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) + if (associated(fluxes%heat_content_vprec)) res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j) + if (associated(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) + if (associated(fluxes%heat_content_massout)) res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j) ! endif - if (ASSOCIATED(fluxes%heat_added)) res(i,j) = res(i,j) + fluxes%heat_added(i,j) + if (associated(fluxes%heat_added)) res(i,j) = res(i,j) + fluxes%heat_added(i,j) enddo ; enddo call post_data(handles%id_net_heat_surface, res, diag) @@ -2284,16 +2284,16 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (handles%id_heat_content_surfwater > 0 .or. handles%id_total_heat_content_surfwater > 0) then do j=js,je ; do i=is,ie res(i,j) = 0.0 - ! if (ASSOCIATED(sfc_state%TempXpme)) then + ! if (associated(sfc_state%TempXpme)) then ! res(i,j) = res(i,j) + sfc_state%TempXpme(i,j) * fluxes%C_p * I_dt ! else - if (ASSOCIATED(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) - if (ASSOCIATED(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) - if (ASSOCIATED(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) - if (ASSOCIATED(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) - if (ASSOCIATED(fluxes%heat_content_vprec)) res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j) - if (ASSOCIATED(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) - if (ASSOCIATED(fluxes%heat_content_massout)) res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j) + if (associated(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) + if (associated(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) + if (associated(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) + if (associated(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) + if (associated(fluxes%heat_content_vprec)) res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j) + if (associated(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) + if (associated(fluxes%heat_content_massout)) res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j) ! endif enddo ; enddo call post_data(handles%id_heat_content_surfwater, res, diag) @@ -2307,8 +2307,8 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (handles%id_hfrunoffds > 0) then do j=js,je ; do i=is,ie res(i,j) = 0.0 - if(ASSOCIATED(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) - if(ASSOCIATED(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) + if(associated(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) + if(associated(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) enddo ; enddo call post_data(handles%id_hfrunoffds, res, diag) endif @@ -2317,23 +2317,23 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (handles%id_hfrainds > 0) then do j=js,je ; do i=is,ie res(i,j) = 0.0 - if(ASSOCIATED(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) - if(ASSOCIATED(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) - if(ASSOCIATED(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) + if(associated(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) + if(associated(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) + if(associated(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) enddo ; enddo call post_data(handles%id_hfrainds, res, diag) endif - if ((handles%id_LwLatSens > 0) .and. ASSOCIATED(fluxes%lw) .and. & - ASSOCIATED(fluxes%latent) .and. ASSOCIATED(fluxes%sens)) then + if ((handles%id_LwLatSens > 0) .and. associated(fluxes%lw) .and. & + associated(fluxes%latent) .and. associated(fluxes%sens)) then do j=js,je ; do i=is,ie res(i,j) = (fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j) enddo ; enddo call post_data(handles%id_LwLatSens, res, diag) endif - if ((handles%id_total_LwLatSens > 0) .and. ASSOCIATED(fluxes%lw) .and. & - ASSOCIATED(fluxes%latent) .and. ASSOCIATED(fluxes%sens)) then + if ((handles%id_total_LwLatSens > 0) .and. associated(fluxes%lw) .and. & + associated(fluxes%latent) .and. associated(fluxes%sens)) then do j=js,je ; do i=is,ie res(i,j) = (fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j) enddo ; enddo @@ -2341,8 +2341,8 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) call post_data(handles%id_total_LwLatSens, total_transport, diag) endif - if ((handles%id_LwLatSens_ga > 0) .and. ASSOCIATED(fluxes%lw) .and. & - ASSOCIATED(fluxes%latent) .and. ASSOCIATED(fluxes%sens)) then + if ((handles%id_LwLatSens_ga > 0) .and. associated(fluxes%lw) .and. & + associated(fluxes%latent) .and. associated(fluxes%sens)) then do j=js,je ; do i=is,ie res(i,j) = (fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j) enddo ; enddo @@ -2350,91 +2350,91 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) call post_data(handles%id_LwLatSens_ga, ave_flux, diag) endif - if ((handles%id_sw > 0) .and. ASSOCIATED(fluxes%sw)) then + if ((handles%id_sw > 0) .and. associated(fluxes%sw)) then call post_data(handles%id_sw, fluxes%sw, diag) endif - if ((handles%id_sw_vis > 0) .and. ASSOCIATED(fluxes%sw_vis_dir) .and. & - ASSOCIATED(fluxes%sw_vis_dif)) then + if ((handles%id_sw_vis > 0) .and. associated(fluxes%sw_vis_dir) .and. & + associated(fluxes%sw_vis_dif)) then call post_data(handles%id_sw_vis, fluxes%sw_vis_dir+fluxes%sw_vis_dif, diag) endif - if ((handles%id_sw_nir > 0) .and. ASSOCIATED(fluxes%sw_nir_dir) .and. & - ASSOCIATED(fluxes%sw_nir_dif)) then + if ((handles%id_sw_nir > 0) .and. associated(fluxes%sw_nir_dir) .and. & + associated(fluxes%sw_nir_dif)) then call post_data(handles%id_sw_nir, fluxes%sw_nir_dir+fluxes%sw_nir_dif, diag) endif - if ((handles%id_total_sw > 0) .and. ASSOCIATED(fluxes%sw)) then + if ((handles%id_total_sw > 0) .and. associated(fluxes%sw)) then total_transport = global_area_integral(fluxes%sw,G) call post_data(handles%id_total_sw, total_transport, diag) endif - if ((handles%id_sw_ga > 0) .and. ASSOCIATED(fluxes%sw)) then + if ((handles%id_sw_ga > 0) .and. associated(fluxes%sw)) then ave_flux = global_area_mean(fluxes%sw,G) call post_data(handles%id_sw_ga, ave_flux, diag) endif - if ((handles%id_lw > 0) .and. ASSOCIATED(fluxes%lw)) then + if ((handles%id_lw > 0) .and. associated(fluxes%lw)) then call post_data(handles%id_lw, fluxes%lw, diag) endif - if ((handles%id_total_lw > 0) .and. ASSOCIATED(fluxes%lw)) then + if ((handles%id_total_lw > 0) .and. associated(fluxes%lw)) then total_transport = global_area_integral(fluxes%lw,G) call post_data(handles%id_total_lw, total_transport, diag) endif - if ((handles%id_lw_ga > 0) .and. ASSOCIATED(fluxes%lw)) then + if ((handles%id_lw_ga > 0) .and. associated(fluxes%lw)) then ave_flux = global_area_mean(fluxes%lw,G) call post_data(handles%id_lw_ga, ave_flux, diag) endif - if ((handles%id_lat > 0) .and. ASSOCIATED(fluxes%latent)) then + if ((handles%id_lat > 0) .and. associated(fluxes%latent)) then call post_data(handles%id_lat, fluxes%latent, diag) endif - if ((handles%id_total_lat > 0) .and. ASSOCIATED(fluxes%latent)) then + if ((handles%id_total_lat > 0) .and. associated(fluxes%latent)) then total_transport = global_area_integral(fluxes%latent,G) call post_data(handles%id_total_lat, total_transport, diag) endif - if ((handles%id_lat_ga > 0) .and. ASSOCIATED(fluxes%latent)) then + if ((handles%id_lat_ga > 0) .and. associated(fluxes%latent)) then ave_flux = global_area_mean(fluxes%latent,G) call post_data(handles%id_lat_ga, ave_flux, diag) endif - if ((handles%id_lat_evap > 0) .and. ASSOCIATED(fluxes%latent_evap_diag)) then + if ((handles%id_lat_evap > 0) .and. associated(fluxes%latent_evap_diag)) then call post_data(handles%id_lat_evap, fluxes%latent_evap_diag, diag) endif - if ((handles%id_total_lat_evap > 0) .and. ASSOCIATED(fluxes%latent_evap_diag)) then + if ((handles%id_total_lat_evap > 0) .and. associated(fluxes%latent_evap_diag)) then total_transport = global_area_integral(fluxes%latent_evap_diag,G) call post_data(handles%id_total_lat_evap, total_transport, diag) endif - if ((handles%id_lat_fprec > 0) .and. ASSOCIATED(fluxes%latent_fprec_diag)) then + if ((handles%id_lat_fprec > 0) .and. associated(fluxes%latent_fprec_diag)) then call post_data(handles%id_lat_fprec, fluxes%latent_fprec_diag, diag) endif - if ((handles%id_total_lat_fprec > 0) .and. ASSOCIATED(fluxes%latent_fprec_diag)) then + if ((handles%id_total_lat_fprec > 0) .and. associated(fluxes%latent_fprec_diag)) then total_transport = global_area_integral(fluxes%latent_fprec_diag,G) call post_data(handles%id_total_lat_fprec, total_transport, diag) endif - if ((handles%id_lat_frunoff > 0) .and. ASSOCIATED(fluxes%latent_frunoff_diag)) then + if ((handles%id_lat_frunoff > 0) .and. associated(fluxes%latent_frunoff_diag)) then call post_data(handles%id_lat_frunoff, fluxes%latent_frunoff_diag, diag) endif - if(handles%id_total_lat_frunoff > 0 .and. ASSOCIATED(fluxes%latent_frunoff_diag)) then + if(handles%id_total_lat_frunoff > 0 .and. associated(fluxes%latent_frunoff_diag)) then total_transport = global_area_integral(fluxes%latent_frunoff_diag,G) call post_data(handles%id_total_lat_frunoff, total_transport, diag) endif - if ((handles%id_sens > 0) .and. ASSOCIATED(fluxes%sens)) then + if ((handles%id_sens > 0) .and. associated(fluxes%sens)) then call post_data(handles%id_sens, fluxes%sens, diag) endif - if ((handles%id_total_sens > 0) .and. ASSOCIATED(fluxes%sens)) then + if ((handles%id_total_sens > 0) .and. associated(fluxes%sens)) then total_transport = global_area_integral(fluxes%sens,G) call post_data(handles%id_total_sens, total_transport, diag) endif - if ((handles%id_sens_ga > 0) .and. ASSOCIATED(fluxes%sens)) then + if ((handles%id_sens_ga > 0) .and. associated(fluxes%sens)) then ave_flux = global_area_mean(fluxes%sens,G) call post_data(handles%id_sens_ga, ave_flux, diag) endif - if ((handles%id_heat_added > 0) .and. ASSOCIATED(fluxes%heat_added)) then + if ((handles%id_heat_added > 0) .and. associated(fluxes%heat_added)) then call post_data(handles%id_heat_added, fluxes%heat_added, diag) endif - if ((handles%id_total_heat_added > 0) .and. ASSOCIATED(fluxes%heat_added)) then + if ((handles%id_total_heat_added > 0) .and. associated(fluxes%heat_added)) then total_transport = global_area_integral(fluxes%heat_added,G) call post_data(handles%id_total_heat_added, total_transport, diag) endif @@ -2442,23 +2442,23 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) ! post the diagnostics for boundary salt fluxes ========================== - if ((handles%id_saltflux > 0) .and. ASSOCIATED(fluxes%salt_flux)) & + if ((handles%id_saltflux > 0) .and. associated(fluxes%salt_flux)) & call post_data(handles%id_saltflux, fluxes%salt_flux, diag) - if ((handles%id_total_saltflux > 0) .and. ASSOCIATED(fluxes%salt_flux)) then + if ((handles%id_total_saltflux > 0) .and. associated(fluxes%salt_flux)) then total_transport = ppt2mks*global_area_integral(fluxes%salt_flux,G) call post_data(handles%id_total_saltflux, total_transport, diag) endif - if ((handles%id_saltFluxAdded > 0) .and. ASSOCIATED(fluxes%salt_flux_added)) & + if ((handles%id_saltFluxAdded > 0) .and. associated(fluxes%salt_flux_added)) & call post_data(handles%id_saltFluxAdded, fluxes%salt_flux_added, diag) - if ((handles%id_total_saltFluxAdded > 0) .and. ASSOCIATED(fluxes%salt_flux_added)) then + if ((handles%id_total_saltFluxAdded > 0) .and. associated(fluxes%salt_flux_added)) then total_transport = ppt2mks*global_area_integral(fluxes%salt_flux_added,G) call post_data(handles%id_total_saltFluxAdded, total_transport, diag) endif - if (handles%id_saltFluxIn > 0 .and. ASSOCIATED(fluxes%salt_flux_in)) & + if (handles%id_saltFluxIn > 0 .and. associated(fluxes%salt_flux_in)) & call post_data(handles%id_saltFluxIn, fluxes%salt_flux_in, diag) - if ((handles%id_total_saltFluxIn > 0) .and. ASSOCIATED(fluxes%salt_flux_in)) then + if ((handles%id_total_saltFluxIn > 0) .and. associated(fluxes%salt_flux_in)) then total_transport = ppt2mks*global_area_integral(fluxes%salt_flux_in,G) call post_data(handles%id_total_saltFluxIn, total_transport, diag) endif @@ -2479,13 +2479,13 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) ! remaining boundary terms ================================================== - if ((handles%id_psurf > 0) .and. ASSOCIATED(fluxes%p_surf)) & + if ((handles%id_psurf > 0) .and. associated(fluxes%p_surf)) & call post_data(handles%id_psurf, fluxes%p_surf, diag) - if ((handles%id_TKE_tidal > 0) .and. ASSOCIATED(fluxes%TKE_tidal)) & + if ((handles%id_TKE_tidal > 0) .and. associated(fluxes%TKE_tidal)) & call post_data(handles%id_TKE_tidal, fluxes%TKE_tidal, diag) - if ((handles%id_buoy > 0) .and. ASSOCIATED(fluxes%buoy)) & + if ((handles%id_buoy > 0) .and. associated(fluxes%buoy)) & call post_data(handles%id_buoy, fluxes%buoy, diag) @@ -2606,7 +2606,7 @@ subroutine myAlloc(array, is, ie, js, je, flag) logical, optional, intent(in) :: flag !< Flag to indicate to allocate if (present(flag)) then ; if (flag) then ; if (.not.associated(array)) then - ALLOCATE(array(is:ie,js:je)) ; array(is:ie,js:je) = 0.0 + allocate(array(is:ie,js:je)) ; array(is:ie,js:je) = 0.0 endif ; endif ; endif end subroutine myAlloc diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index f4b5c8c1bb..6b59addd0b 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -2368,7 +2368,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) endif deallocate(tmp_buffer) else ! fid <= 0 (Uniform value) - if (.not. ASSOCIATED(segment%field(m)%buffer_dst)) then + if (.not. associated(segment%field(m)%buffer_dst)) then if (segment%is_E_or_W) then if (segment%field(m)%name == 'V') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 26b4263a2e..37d3433330 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -229,17 +229,17 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, & write(file,'(/,"diffu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%diffu(I,j,k)); enddo - if (ASSOCIATED(ADp%gradKEu)) then + if (associated(ADp%gradKEu)) then write(file,'(/,"KEu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (dt*ADp%gradKEu(I,j,k)); enddo endif - if (ASSOCIATED(ADp%rv_x_v)) then + if (associated(ADp%rv_x_v)) then write(file,'(/,"Coru: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & dt*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k)); enddo endif - if (ASSOCIATED(ADp%du_dt_visc)) then + if (associated(ADp%du_dt_visc)) then write(file,'(/,"ubv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (um(I,j,k)-dt*ADp%du_dt_visc(I,j,k)); enddo @@ -247,7 +247,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, & do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (dt*ADp%du_dt_visc(I,j,k)); enddo endif - if (ASSOCIATED(ADp%du_other)) then + if (associated(ADp%du_other)) then write(file,'(/,"du_other: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (ADp%du_other(I,j,k)); enddo @@ -262,7 +262,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, & endif write(file,'(/,"Stress: ",ES10.3)') str - if (ASSOCIATED(CS%u_accel_bt)) then + if (associated(CS%u_accel_bt)) then write(file,'("dubt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (dt*CS%u_accel_bt(I,j,k)) ; enddo @@ -294,13 +294,13 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, & write(file,'(/,"e+: ",$)') write(file,'(ES10.3," ",$)') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K) ; enddo - if (ASSOCIATED(CS%T)) then + if (associated(CS%T)) then write(file,'(/,"T-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i,j,k); enddo write(file,'(/,"T+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i+1,j,k); enddo endif - if (ASSOCIATED(CS%S)) then + if (associated(CS%S)) then write(file,'(/,"S-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%S(i,j,k); enddo write(file,'(/,"S+: ",$)') @@ -395,27 +395,27 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, & do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & (dt*ADp%diffu(I,j,k)*Inorm(k)); enddo - if (ASSOCIATED(ADp%gradKEu)) then + if (associated(ADp%gradKEu)) then write(file,'(/,"KEu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & (dt*ADp%gradKEu(I,j,k)*Inorm(k)); enddo endif - if (ASSOCIATED(ADp%rv_x_v)) then + if (associated(ADp%rv_x_v)) then write(file,'(/,"Coru: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & dt*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k))*Inorm(k); enddo endif - if (ASSOCIATED(ADp%du_dt_visc)) then + if (associated(ADp%du_dt_visc)) then write(file,'(/,"duv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & (dt*ADp%du_dt_visc(I,j,k))*Inorm(k); enddo endif - if (ASSOCIATED(ADp%du_other)) then + if (associated(ADp%du_other)) then write(file,'(/,"du_other: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & (ADp%du_other(I,j,k))*Inorm(k); enddo endif - if (ASSOCIATED(CS%u_accel_bt)) then + if (associated(CS%u_accel_bt)) then write(file,'(/,"dubt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & (dt*CS%u_accel_bt(I,j,k)*Inorm(k)) ; enddo @@ -586,17 +586,17 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, & write(file,'(/,"diffv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%diffv(i,J,k)); enddo - if (ASSOCIATED(ADp%gradKEv)) then + if (associated(ADp%gradKEv)) then write(file,'(/,"KEv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (dt*ADp%gradKEv(i,J,k)); enddo endif - if (ASSOCIATED(ADp%rv_x_u)) then + if (associated(ADp%rv_x_u)) then write(file,'(/,"Corv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & dt*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k)); enddo endif - if (ASSOCIATED(ADp%dv_dt_visc)) then + if (associated(ADp%dv_dt_visc)) then write(file,'(/,"vbv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (vm(i,J,k)-dt*ADp%dv_dt_visc(i,J,k)); enddo @@ -605,7 +605,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, & do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (dt*ADp%dv_dt_visc(i,J,k)); enddo endif - if (ASSOCIATED(ADp%dv_other)) then + if (associated(ADp%dv_other)) then write(file,'(/,"dv_other: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (ADp%dv_other(i,J,k)); enddo @@ -620,7 +620,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, & endif write(file,'(/,"Stress: ",ES10.3)') str - if (ASSOCIATED(CS%v_accel_bt)) then + if (associated(CS%v_accel_bt)) then write(file,'("dvbt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (dt*CS%v_accel_bt(i,J,k)) ; enddo @@ -651,13 +651,13 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, & write(file,'(/,"e+: ",$)') write(file,'(ES10.3," ",$)') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo - if (ASSOCIATED(CS%T)) then + if (associated(CS%T)) then write(file,'(/,"T-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i,j,k); enddo write(file,'(/,"T+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i,j+1,k); enddo endif - if (ASSOCIATED(CS%S)) then + if (associated(CS%S)) then write(file,'(/,"S-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%S(i,j,k); enddo write(file,'(/,"S+: ",$)') @@ -748,27 +748,27 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, & do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & (dt*ADp%diffv(i,J,k)*Inorm(k)); enddo - if (ASSOCIATED(ADp%gradKEu)) then + if (associated(ADp%gradKEu)) then write(file,'(/,"KEv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & (dt*ADp%gradKEv(i,J,k)*Inorm(k)); enddo endif - if (ASSOCIATED(ADp%rv_x_u)) then + if (associated(ADp%rv_x_u)) then write(file,'(/,"Corv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & dt*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k))*Inorm(k); enddo endif - if (ASSOCIATED(ADp%dv_dt_visc)) then + if (associated(ADp%dv_dt_visc)) then write(file,'(/,"dvv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & (dt*ADp%dv_dt_visc(i,J,k)*Inorm(k)); enddo endif - if (ASSOCIATED(ADp%dv_other)) then + if (associated(ADp%dv_other)) then write(file,'(/,"dv_other: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & (ADp%dv_other(i,J,k)*Inorm(k)); enddo endif - if (ASSOCIATED(CS%v_accel_bt)) then + if (associated(CS%v_accel_bt)) then write(file,'(/,"dvbt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & (dt*CS%v_accel_bt(i,J,k)*Inorm(k)) ; enddo diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index 43f39c4e16..5dd78e8eee 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -1257,9 +1257,9 @@ subroutine MOM_diag_to_Z_end(CS) type(diag_to_Z_CS), pointer :: CS integer :: m - if (ASSOCIATED(CS%u_z)) deallocate(CS%u_z) - if (ASSOCIATED(CS%v_z)) deallocate(CS%v_z) - if (ASSOCIATED(CS%Z_int)) deallocate(CS%Z_int) + if (associated(CS%u_z)) deallocate(CS%u_z) + if (associated(CS%v_z)) deallocate(CS%v_z) + if (associated(CS%Z_int)) deallocate(CS%Z_int) do m=1,CS%num_tr_used ; deallocate(CS%tr_z(m)%p) ; enddo deallocate(CS) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 94a23d5233..097a0e13b3 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -293,13 +293,13 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_h > 0) call post_data(CS%id_h, h, CS%diag) - if (ASSOCIATED(CS%e)) then + if (associated(CS%e)) then call find_eta(h, tv, GV%g_Earth, G, GV, CS%e, eta_bt) if (CS%id_e > 0) call post_data(CS%id_e, CS%e, CS%diag) endif - if (ASSOCIATED(CS%e_D)) then - if (ASSOCIATED(CS%e)) then + if (associated(CS%e_D)) then + if (associated(CS%e)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie CS%e_D(i,j,k) = CS%e(i,j,k) + G%bathyT(i,j) enddo ; enddo ; enddo @@ -343,7 +343,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif else ! thkcello = dp/(rho*g) for non-Boussinesq do j=js,je - if(ASSOCIATED(p_surf)) then ! Pressure loading at top of surface layer (Pa) + if(associated(p_surf)) then ! Pressure loading at top of surface layer (Pa) do i=is,ie pressure_1d(i) = p_surf(i,j) enddo @@ -455,9 +455,9 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & call calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) - if ((CS%id_Rml > 0) .or. (CS%id_Rcv > 0) .or. ASSOCIATED(CS%h_Rlay) .or. & - ASSOCIATED(CS%uh_Rlay) .or. ASSOCIATED(CS%vh_Rlay) .or. & - ASSOCIATED(CS%uhGM_Rlay) .or. ASSOCIATED(CS%vhGM_Rlay)) then + if ((CS%id_Rml > 0) .or. (CS%id_Rcv > 0) .or. associated(CS%h_Rlay) .or. & + associated(CS%uh_Rlay) .or. associated(CS%vh_Rlay) .or. & + associated(CS%uhGM_Rlay) .or. associated(CS%vhGM_Rlay)) then if (associated(tv%eqn_of_state)) then pressure_1d(:) = tv%P_Ref @@ -474,7 +474,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_Rml > 0) call post_data(CS%id_Rml, Rcv, CS%diag) if (CS%id_Rcv > 0) call post_data(CS%id_Rcv, Rcv, CS%diag) - if (ASSOCIATED(CS%h_Rlay)) then + if (associated(CS%h_Rlay)) then k_list = nz/2 !$OMP parallel do default(none) shared(is,ie,js,je,nz,nkmb,CS,Rcv,h,GV) & !$OMP private(wt,wt_p) firstprivate(k_list) @@ -495,7 +495,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_h_Rlay > 0) call post_data(CS%id_h_Rlay, CS%h_Rlay, CS%diag) endif - if (ASSOCIATED(CS%uh_Rlay)) then + if (associated(CS%uh_Rlay)) then k_list = nz/2 !$OMP parallel do default(none) shared(Isq,Ieq,js,je,nz,nkmb,Rcv,CS,GV,uh) & !$OMP private(wt,wt_p) firstprivate(k_list) @@ -517,7 +517,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_uh_Rlay > 0) call post_data(CS%id_uh_Rlay, CS%uh_Rlay, CS%diag) endif - if (ASSOCIATED(CS%vh_Rlay)) then + if (associated(CS%vh_Rlay)) then k_list = nz/2 !$OMP parallel do default(none) shared(Jsq,Jeq,is,ie,nz,nkmb,Rcv,CS,GV,vh) & !$OMP private(wt,wt_p) firstprivate(k_list) @@ -538,7 +538,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_vh_Rlay > 0) call post_data(CS%id_vh_Rlay, CS%vh_Rlay, CS%diag) endif - if (ASSOCIATED(CS%uhGM_Rlay) .and. ASSOCIATED(CDp%uhGM)) then + if (associated(CS%uhGM_Rlay) .and. associated(CDp%uhGM)) then k_list = nz/2 !$OMP parallel do default(none) shared(Isq,Ieq,js,je,nz,nkmb,Rcv,CDP,CS,GV) & !$OMP private(wt,wt_p) firstprivate(k_list) @@ -559,7 +559,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_uh_Rlay > 0) call post_data(CS%id_uhGM_Rlay, CS%uhGM_Rlay, CS%diag) endif - if (ASSOCIATED(CS%vhGM_Rlay) .and. ASSOCIATED(CDp%vhGM)) then + if (associated(CS%vhGM_Rlay) .and. associated(CDp%vhGM)) then k_list = nz/2 !$OMP parallel do default(none) shared(is,ie,Jsq,Jeq,nz,nkmb,CS,CDp,Rcv,GV) & !$OMP private(wt,wt_p) firstprivate(k_list) @@ -860,7 +860,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) ! where p_surf is the sea water pressure at sea water surface. do j=js,je ; do i=is,ie btm_pres(i,j) = mass(i,j) * GV%g_Earth - if (ASSOCIATED(p_surf)) then + if (associated(p_surf)) then btm_pres(i,j) = btm_pres(i,j) + p_surf(i,j) endif enddo ; enddo @@ -920,7 +920,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) KE_u(I,j) = 0.0 ; KE_v(i,J) = 0.0 enddo ; enddo - if (ASSOCIATED(CS%KE)) then + if (associated(CS%KE)) then do k=1,nz ; do j=js,je ; do i=is,ie CS%KE(i,j,k) = ((u(I,j,k)*u(I,j,k) + u(I-1,j,k)*u(I-1,j,k)) + & (v(i,J,k)*v(i,J,k) + v(i,J-1,k)*v(i,J-1,k)))*0.25 @@ -932,14 +932,14 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) endif if(.not.G%symmetric) then - if(ASSOCIATED(CS%dKE_dt) .OR. ASSOCIATED(CS%PE_to_KE) .OR. ASSOCIATED(CS%KE_CorAdv) .OR. & - ASSOCIATED(CS%KE_adv) .OR. ASSOCIATED(CS%KE_visc) .OR. ASSOCIATED(CS%KE_horvisc).OR. & - ASSOCIATED(CS%KE_dia) ) then + if(associated(CS%dKE_dt) .OR. associated(CS%PE_to_KE) .OR. associated(CS%KE_CorAdv) .OR. & + associated(CS%KE_adv) .OR. associated(CS%KE_visc) .OR. associated(CS%KE_horvisc).OR. & + associated(CS%KE_dia) ) then call create_group_pass(CS%pass_KE_uv, KE_u, KE_v, G%Domain, To_North+To_East) endif endif - if (ASSOCIATED(CS%dKE_dt)) then + if (associated(CS%dKE_dt)) then do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*CS%du_dt(I,j,k) @@ -960,7 +960,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) if (CS%id_dKEdt > 0) call post_data(CS%id_dKEdt, CS%dKE_dt, CS%diag) endif - if (ASSOCIATED(CS%PE_to_KE)) then + if (associated(CS%PE_to_KE)) then do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*ADp%PFu(I,j,k) @@ -978,7 +978,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) if (CS%id_PE_to_KE > 0) call post_data(CS%id_PE_to_KE, CS%PE_to_KE, CS%diag) endif - if (ASSOCIATED(CS%KE_CorAdv)) then + if (associated(CS%KE_CorAdv)) then do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*ADp%CAu(I,j,k) @@ -1000,7 +1000,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) if (CS%id_KE_Coradv > 0) call post_data(CS%id_KE_Coradv, CS%KE_Coradv, CS%diag) endif - if (ASSOCIATED(CS%KE_adv)) then + if (associated(CS%KE_adv)) then do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*ADp%gradKEu(I,j,k) @@ -1022,7 +1022,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) if (CS%id_KE_adv > 0) call post_data(CS%id_KE_adv, CS%KE_adv, CS%diag) endif - if (ASSOCIATED(CS%KE_visc)) then + if (associated(CS%KE_visc)) then do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_visc(I,j,k) @@ -1040,7 +1040,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) if (CS%id_KE_visc > 0) call post_data(CS%id_KE_visc, CS%KE_visc, CS%diag) endif - if (ASSOCIATED(CS%KE_horvisc)) then + if (associated(CS%KE_horvisc)) then do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*ADp%diffu(I,j,k) @@ -1058,7 +1058,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) if (CS%id_KE_horvisc > 0) call post_data(CS%id_KE_horvisc, CS%KE_horvisc, CS%diag) endif - if (ASSOCIATED(CS%KE_dia)) then + if (associated(CS%KE_dia)) then do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_dia(I,j,k) @@ -1216,7 +1216,7 @@ subroutine post_surface_diagnostics(IDs, G, GV, diag, dt_int, sfc_state, tv, & endif ! post time-averaged rate of frazil formation - if (ASSOCIATED(tv%frazil) .and. (IDs%id_fraz > 0)) then + if (associated(tv%frazil) .and. (IDs%id_fraz > 0)) then do j=js,je ; do i=is,ie work_2d(i,j) = tv%frazil(i,j) * I_time_int enddo ; enddo @@ -1224,7 +1224,7 @@ subroutine post_surface_diagnostics(IDs, G, GV, diag, dt_int, sfc_state, tv, & endif ! post time-averaged salt deficit - if (ASSOCIATED(tv%salt_deficit) .and. (IDs%id_salt_deficit > 0)) then + if (associated(tv%salt_deficit) .and. (IDs%id_salt_deficit > 0)) then do j=js,je ; do i=is,ie work_2d(i,j) = tv%salt_deficit(i,j) * I_time_int enddo ; enddo @@ -1232,7 +1232,7 @@ subroutine post_surface_diagnostics(IDs, G, GV, diag, dt_int, sfc_state, tv, & endif ! post temperature of P-E+R - if (ASSOCIATED(tv%TempxPmE) .and. (IDs%id_Heat_PmE > 0)) then + if (associated(tv%TempxPmE) .and. (IDs%id_Heat_PmE > 0)) then do j=js,je ; do i=is,ie work_2d(i,j) = tv%TempxPmE(i,j) * (tv%C_p * I_time_int) enddo ; enddo @@ -1240,7 +1240,7 @@ subroutine post_surface_diagnostics(IDs, G, GV, diag, dt_int, sfc_state, tv, & endif ! post geothermal heating or internal heat source/sinks - if (ASSOCIATED(tv%internal_heat) .and. (IDs%id_intern_heat > 0)) then + if (associated(tv%internal_heat) .and. (IDs%id_intern_heat > 0)) then do j=js,je ; do i=is,ie work_2d(i,j) = tv%internal_heat(i,j) * (tv%C_p * I_time_int) enddo ; enddo @@ -1449,7 +1449,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, param_file, diag, CS allocate(CS) CS%diag => diag - use_temperature = ASSOCIATED(tv%T) + use_temperature = associated(tv%T) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version) @@ -1558,21 +1558,21 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, param_file, diag, CS CS%id_du_dt = register_diag_field('ocean_model', 'dudt', diag%axesCuL, Time, & 'Zonal Acceleration', 'm s-2') - if ((CS%id_du_dt>0) .and. .not.ASSOCIATED(CS%du_dt)) then + if ((CS%id_du_dt>0) .and. .not.associated(CS%du_dt)) then call safe_alloc_ptr(CS%du_dt,IsdB,IedB,jsd,jed,nz) call register_time_deriv(MIS%u, CS%du_dt, CS) endif CS%id_dv_dt = register_diag_field('ocean_model', 'dvdt', diag%axesCvL, Time, & 'Meridional Acceleration', 'm s-2') - if ((CS%id_dv_dt>0) .and. .not.ASSOCIATED(CS%dv_dt)) then + if ((CS%id_dv_dt>0) .and. .not.associated(CS%dv_dt)) then call safe_alloc_ptr(CS%dv_dt,isd,ied,JsdB,JedB,nz) call register_time_deriv(MIS%v, CS%dv_dt, CS) endif CS%id_dh_dt = register_diag_field('ocean_model', 'dhdt', diag%axesTL, Time, & 'Thickness tendency', trim(thickness_units)//" s-1", v_extensive = .true.) - if ((CS%id_dh_dt>0) .and. .not.ASSOCIATED(CS%dh_dt)) then + if ((CS%id_dh_dt>0) .and. .not.associated(CS%dh_dt)) then call safe_alloc_ptr(CS%dh_dt,isd,ied,jsd,jed,nz) call register_time_deriv(MIS%h, CS%dh_dt, CS) endif @@ -1757,7 +1757,7 @@ subroutine register_surface_diags(Time, G, IDs, diag, tv) IDs%id_sssabs = register_diag_field('ocean_model', 'absSSS', diag%axesT1, Time, & 'Sea Surface Absolute Salinity', 'g kg-1') endif - if (ASSOCIATED(tv%frazil)) then + if (associated(tv%frazil)) then IDs%id_fraz = register_diag_field('ocean_model', 'frazil', diag%axesT1, Time, & 'Heat from frazil formation', 'W m-2', cmor_field_name='hfsifrazil', & cmor_standard_name='heat_flux_into_sea_water_due_to_frazil_ice_formation', & @@ -2016,44 +2016,44 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - if (ASSOCIATED(CS%dKE_dt) .or. ASSOCIATED(CS%PE_to_KE) .or. & - ASSOCIATED(CS%KE_CorAdv) .or. ASSOCIATED(CS%KE_adv) .or. & - ASSOCIATED(CS%KE_visc) .or. ASSOCIATED(CS%KE_horvisc) .or. & - ASSOCIATED(CS%KE_dia)) & + if (associated(CS%dKE_dt) .or. associated(CS%PE_to_KE) .or. & + associated(CS%KE_CorAdv) .or. associated(CS%KE_adv) .or. & + associated(CS%KE_visc) .or. associated(CS%KE_horvisc) .or. & + associated(CS%KE_dia)) & call safe_alloc_ptr(CS%KE,isd,ied,jsd,jed,nz) - if (ASSOCIATED(CS%dKE_dt)) then - if (.not.ASSOCIATED(CS%du_dt)) then + if (associated(CS%dKE_dt)) then + if (.not.associated(CS%du_dt)) then call safe_alloc_ptr(CS%du_dt,IsdB,IedB,jsd,jed,nz) call register_time_deriv(MIS%u, CS%du_dt, CS) endif - if (.not.ASSOCIATED(CS%dv_dt)) then + if (.not.associated(CS%dv_dt)) then call safe_alloc_ptr(CS%dv_dt,isd,ied,JsdB,JedB,nz) call register_time_deriv(MIS%v, CS%dv_dt, CS) endif - if (.not.ASSOCIATED(CS%dh_dt)) then + if (.not.associated(CS%dh_dt)) then call safe_alloc_ptr(CS%dh_dt,isd,ied,jsd,jed,nz) call register_time_deriv(MIS%h, CS%dh_dt, CS) endif endif - if (ASSOCIATED(CS%KE_adv)) then + if (associated(CS%KE_adv)) then call safe_alloc_ptr(ADp%gradKEu,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%gradKEv,isd,ied,JsdB,JedB,nz) endif - if (ASSOCIATED(CS%KE_visc)) then + if (associated(CS%KE_visc)) then call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) endif - if (ASSOCIATED(CS%KE_dia)) then + if (associated(CS%KE_dia)) then call safe_alloc_ptr(ADp%du_dt_dia,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%dv_dt_dia,isd,ied,JsdB,JedB,nz) endif - if (ASSOCIATED(CS%uhGM_Rlay)) call safe_alloc_ptr(CDp%uhGM,IsdB,IedB,jsd,jed,nz) - if (ASSOCIATED(CS%vhGM_Rlay)) call safe_alloc_ptr(CDp%vhGM,isd,ied,JsdB,JedB,nz) + if (associated(CS%uhGM_Rlay)) call safe_alloc_ptr(CDp%uhGM,IsdB,IedB,jsd,jed,nz) + if (associated(CS%vhGM_Rlay)) call safe_alloc_ptr(CDp%vhGM,isd,ied,JsdB,JedB,nz) end subroutine set_dependent_diagnostics @@ -2062,33 +2062,33 @@ subroutine MOM_diagnostics_end(CS, ADp) type(accel_diag_ptrs), intent(inout) :: ADp integer :: m - if (ASSOCIATED(CS%e)) deallocate(CS%e) - if (ASSOCIATED(CS%e_D)) deallocate(CS%e_D) - if (ASSOCIATED(CS%KE)) deallocate(CS%KE) - if (ASSOCIATED(CS%dKE_dt)) deallocate(CS%dKE_dt) - if (ASSOCIATED(CS%PE_to_KE)) deallocate(CS%PE_to_KE) - if (ASSOCIATED(CS%KE_Coradv)) deallocate(CS%KE_Coradv) - if (ASSOCIATED(CS%KE_adv)) deallocate(CS%KE_adv) - if (ASSOCIATED(CS%KE_visc)) deallocate(CS%KE_visc) - if (ASSOCIATED(CS%KE_horvisc)) deallocate(CS%KE_horvisc) - if (ASSOCIATED(CS%KE_dia)) deallocate(CS%KE_dia) - if (ASSOCIATED(CS%dv_dt)) deallocate(CS%dv_dt) - if (ASSOCIATED(CS%dh_dt)) deallocate(CS%dh_dt) - if (ASSOCIATED(CS%du_dt)) deallocate(CS%du_dt) - if (ASSOCIATED(CS%h_Rlay)) deallocate(CS%h_Rlay) - if (ASSOCIATED(CS%uh_Rlay)) deallocate(CS%uh_Rlay) - if (ASSOCIATED(CS%vh_Rlay)) deallocate(CS%vh_Rlay) - if (ASSOCIATED(CS%uhGM_Rlay)) deallocate(CS%uhGM_Rlay) - if (ASSOCIATED(CS%vhGM_Rlay)) deallocate(CS%vhGM_Rlay) - - if (ASSOCIATED(ADp%gradKEu)) deallocate(ADp%gradKEu) - if (ASSOCIATED(ADp%gradKEu)) deallocate(ADp%gradKEu) - if (ASSOCIATED(ADp%du_dt_visc)) deallocate(ADp%du_dt_visc) - if (ASSOCIATED(ADp%dv_dt_visc)) deallocate(ADp%dv_dt_visc) - if (ASSOCIATED(ADp%du_dt_dia)) deallocate(ADp%du_dt_dia) - if (ASSOCIATED(ADp%dv_dt_dia)) deallocate(ADp%dv_dt_dia) - if (ASSOCIATED(ADp%du_other)) deallocate(ADp%du_other) - if (ASSOCIATED(ADp%dv_other)) deallocate(ADp%dv_other) + if (associated(CS%e)) deallocate(CS%e) + if (associated(CS%e_D)) deallocate(CS%e_D) + if (associated(CS%KE)) deallocate(CS%KE) + if (associated(CS%dKE_dt)) deallocate(CS%dKE_dt) + if (associated(CS%PE_to_KE)) deallocate(CS%PE_to_KE) + if (associated(CS%KE_Coradv)) deallocate(CS%KE_Coradv) + if (associated(CS%KE_adv)) deallocate(CS%KE_adv) + if (associated(CS%KE_visc)) deallocate(CS%KE_visc) + if (associated(CS%KE_horvisc)) deallocate(CS%KE_horvisc) + if (associated(CS%KE_dia)) deallocate(CS%KE_dia) + if (associated(CS%dv_dt)) deallocate(CS%dv_dt) + if (associated(CS%dh_dt)) deallocate(CS%dh_dt) + if (associated(CS%du_dt)) deallocate(CS%du_dt) + if (associated(CS%h_Rlay)) deallocate(CS%h_Rlay) + if (associated(CS%uh_Rlay)) deallocate(CS%uh_Rlay) + if (associated(CS%vh_Rlay)) deallocate(CS%vh_Rlay) + if (associated(CS%uhGM_Rlay)) deallocate(CS%uhGM_Rlay) + if (associated(CS%vhGM_Rlay)) deallocate(CS%vhGM_Rlay) + + if (associated(ADp%gradKEu)) deallocate(ADp%gradKEu) + if (associated(ADp%gradKEu)) deallocate(ADp%gradKEu) + if (associated(ADp%du_dt_visc)) deallocate(ADp%du_dt_visc) + if (associated(ADp%dv_dt_visc)) deallocate(ADp%dv_dt_visc) + if (associated(ADp%du_dt_dia)) deallocate(ADp%du_dt_dia) + if (associated(ADp%dv_dt_dia)) deallocate(ADp%dv_dt_dia) + if (associated(ADp%du_other)) deallocate(ADp%du_other) + if (associated(ADp%dv_other)) deallocate(ADp%dv_other) do m=1,CS%num_time_deriv ; deallocate(CS%prev_val(m)%p) ; enddo diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index aff6a36713..18de7c2902 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -993,8 +993,8 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) C_p = fluxes%C_p FW_in(:,:) = 0.0 ; FW_input = 0.0 - if (ASSOCIATED(fluxes%evap)) then - if (ASSOCIATED(fluxes%lprec) .and. ASSOCIATED(fluxes%fprec)) then + if (associated(fluxes%evap)) then + if (associated(fluxes%lprec) .and. associated(fluxes%fprec)) then do j=js,je ; do i=is,ie FW_in(i,j) = dt*G%areaT(i,j)*(fluxes%evap(i,j) + & (((fluxes%lprec(i,j) + fluxes%vprec(i,j)) + fluxes%lrunoff(i,j)) + & @@ -1009,14 +1009,14 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) salt_in(:,:) = 0.0 ; heat_in(:,:) = 0.0 if (CS%use_temperature) then - if (ASSOCIATED(fluxes%sw)) then ; do j=js,je ; do i=is,ie + if (associated(fluxes%sw)) then ; do j=js,je ; do i=is,ie heat_in(i,j) = heat_in(i,j) + dt*G%areaT(i,j) * (fluxes%sw(i,j) + & (fluxes%lw(i,j) + (fluxes%latent(i,j) + fluxes%sens(i,j)))) enddo ; enddo ; endif ! smg: new code ! include heat content from water transport across ocean surface -! if (ASSOCIATED(fluxes%heat_content_lprec)) then ; do j=js,je ; do i=is,ie +! if (associated(fluxes%heat_content_lprec)) then ; do j=js,je ; do i=is,ie ! heat_in(i,j) = heat_in(i,j) + dt*G%areaT(i,j) * & ! (fluxes%heat_content_lprec(i,j) + (fluxes%heat_content_fprec(i,j) & ! + (fluxes%heat_content_lrunoff(i,j) + (fluxes%heat_content_frunoff(i,j) & @@ -1025,11 +1025,11 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) ! enddo ; enddo ; endif ! smg: old code - if (ASSOCIATED(sfc_state%TempxPmE)) then + if (associated(sfc_state%TempxPmE)) then do j=js,je ; do i=is,ie heat_in(i,j) = heat_in(i,j) + (C_p * G%areaT(i,j)) * sfc_state%TempxPmE(i,j) enddo ; enddo - elseif (ASSOCIATED(fluxes%evap)) then + elseif (associated(fluxes%evap)) then do j=js,je ; do i=is,ie heat_in(i,j) = heat_in(i,j) + (C_p * sfc_state%SST(i,j)) * FW_in(i,j) enddo ; enddo @@ -1037,30 +1037,30 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) ! The following heat sources may or may not be used. - if (ASSOCIATED(sfc_state%internal_heat)) then + if (associated(sfc_state%internal_heat)) then do j=js,je ; do i=is,ie heat_in(i,j) = heat_in(i,j) + (C_p * G%areaT(i,j)) * & sfc_state%internal_heat(i,j) enddo ; enddo endif - if (ASSOCIATED(sfc_state%frazil)) then ; do j=js,je ; do i=is,ie + if (associated(sfc_state%frazil)) then ; do j=js,je ; do i=is,ie heat_in(i,j) = heat_in(i,j) + G%areaT(i,j) * sfc_state%frazil(i,j) enddo ; enddo ; endif - if (ASSOCIATED(fluxes%heat_added)) then ; do j=js,je ; do i=is,ie + if (associated(fluxes%heat_added)) then ; do j=js,je ; do i=is,ie heat_in(i,j) = heat_in(i,j) + dt*G%areaT(i,j)*fluxes%heat_added(i,j) enddo ; enddo ; endif -! if (ASSOCIATED(sfc_state%sw_lost)) then ; do j=js,je ; do i=is,ie +! if (associated(sfc_state%sw_lost)) then ; do j=js,je ; do i=is,ie ! heat_in(i,j) = heat_in(i,j) - G%areaT(i,j) * sfc_state%sw_lost(i,j) ! enddo ; enddo ; endif - if (ASSOCIATED(fluxes%salt_flux)) then ; do j=js,je ; do i=is,ie + if (associated(fluxes%salt_flux)) then ; do j=js,je ; do i=is,ie ! convert salt_flux from kg (salt)/(m^2 s) to ppt * (m/s). salt_in(i,j) = dt*G%areaT(i,j)*(1000.0*fluxes%salt_flux(i,j)) enddo ; enddo ; endif endif - if ((CS%use_temperature) .or. ASSOCIATED(fluxes%lprec) .or. & - ASSOCIATED(fluxes%evap)) then + if ((CS%use_temperature) .or. associated(fluxes%lprec) .or. & + associated(fluxes%evap)) then FW_input = reproducing_sum(FW_in, EFP_sum=FW_in_EFP) heat_input = reproducing_sum(heat_in, EFP_sum=heat_in_EFP) salt_input = reproducing_sum(salt_in, EFP_sum=salt_in_EFP) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 7abd7a10db..1d692cf393 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -315,9 +315,9 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, id_clock_read = cpu_clock_id('(Initialize tracer from Z) read', grain=CLOCK_LOOP) - if (ALLOCATED(tr_z)) deallocate(tr_z) - if (ALLOCATED(mask_z)) deallocate(mask_z) - if (ALLOCATED(z_edges_in)) deallocate(z_edges_in) + if (allocated(tr_z)) deallocate(tr_z) + if (allocated(mask_z)) deallocate(mask_z) + if (allocated(z_edges_in)) deallocate(z_edges_in) PI_180=atan(1.0)/45. diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index adf6bac926..d397dede55 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -485,7 +485,7 @@ function query_initialized_0d(f_ptr, CS) result(query_initialized) query_initialized = .false. n = CS%novars+1 do m=1,CS%novars - if (ASSOCIATED(CS%var_ptr0d(m)%p,f_ptr)) then + if (associated(CS%var_ptr0d(m)%p,f_ptr)) then if (CS%restart_field(m)%initialized) query_initialized = .true. n = m ; exit endif @@ -514,7 +514,7 @@ function query_initialized_1d(f_ptr, CS) result(query_initialized) query_initialized = .false. n = CS%novars+1 do m=1,CS%novars - if (ASSOCIATED(CS%var_ptr1d(m)%p,f_ptr)) then + if (associated(CS%var_ptr1d(m)%p,f_ptr)) then if (CS%restart_field(m)%initialized) query_initialized = .true. n = m ; exit endif @@ -543,7 +543,7 @@ function query_initialized_2d(f_ptr, CS) result(query_initialized) query_initialized = .false. n = CS%novars+1 do m=1,CS%novars - if (ASSOCIATED(CS%var_ptr2d(m)%p,f_ptr)) then + if (associated(CS%var_ptr2d(m)%p,f_ptr)) then if (CS%restart_field(m)%initialized) query_initialized = .true. n = m ; exit endif @@ -572,7 +572,7 @@ function query_initialized_3d(f_ptr, CS) result(query_initialized) query_initialized = .false. n = CS%novars+1 do m=1,CS%novars - if (ASSOCIATED(CS%var_ptr3d(m)%p,f_ptr)) then + if (associated(CS%var_ptr3d(m)%p,f_ptr)) then if (CS%restart_field(m)%initialized) query_initialized = .true. n = m ; exit endif @@ -601,7 +601,7 @@ function query_initialized_4d(f_ptr, CS) result(query_initialized) query_initialized = .false. n = CS%novars+1 do m=1,CS%novars - if (ASSOCIATED(CS%var_ptr4d(m)%p,f_ptr)) then + if (associated(CS%var_ptr4d(m)%p,f_ptr)) then if (CS%restart_field(m)%initialized) query_initialized = .true. n = m ; exit endif @@ -632,7 +632,7 @@ function query_initialized_0d_name(f_ptr, name, CS) result(query_initialized) query_initialized = .false. n = CS%novars+1 do m=1,CS%novars - if (ASSOCIATED(CS%var_ptr0d(m)%p,f_ptr)) then + if (associated(CS%var_ptr0d(m)%p,f_ptr)) then if (CS%restart_field(m)%initialized) query_initialized = .true. n = m ; exit endif @@ -669,7 +669,7 @@ function query_initialized_1d_name(f_ptr, name, CS) result(query_initialized) query_initialized = .false. n = CS%novars+1 do m=1,CS%novars - if (ASSOCIATED(CS%var_ptr1d(m)%p,f_ptr)) then + if (associated(CS%var_ptr1d(m)%p,f_ptr)) then if (CS%restart_field(m)%initialized) query_initialized = .true. n = m ; exit endif @@ -706,7 +706,7 @@ function query_initialized_2d_name(f_ptr, name, CS) result(query_initialized) query_initialized = .false. n = CS%novars+1 do m=1,CS%novars - if (ASSOCIATED(CS%var_ptr2d(m)%p,f_ptr)) then + if (associated(CS%var_ptr2d(m)%p,f_ptr)) then if (CS%restart_field(m)%initialized) query_initialized = .true. n = m ; exit endif @@ -743,7 +743,7 @@ function query_initialized_3d_name(f_ptr, name, CS) result(query_initialized) query_initialized = .false. n = CS%novars+1 do m=1,CS%novars - if (ASSOCIATED(CS%var_ptr3d(m)%p,f_ptr)) then + if (associated(CS%var_ptr3d(m)%p,f_ptr)) then if (CS%restart_field(m)%initialized) query_initialized = .true. n = m ; exit endif @@ -780,7 +780,7 @@ function query_initialized_4d_name(f_ptr, name, CS) result(query_initialized) query_initialized = .false. n = CS%novars+1 do m=1,CS%novars - if (ASSOCIATED(CS%var_ptr4d(m)%p,f_ptr)) then + if (associated(CS%var_ptr4d(m)%p,f_ptr)) then if (CS%restart_field(m)%initialized) query_initialized = .true. n = m ; exit endif @@ -956,15 +956,15 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV) !Prepare the checksum of the restart fields to be written to restart files call get_checksum_loop_ranges(G, pos, isL, ieL, jsL, jeL) do m=start_var,next_var-1 - if (ASSOCIATED(CS%var_ptr3d(m)%p)) then + if (associated(CS%var_ptr3d(m)%p)) then check_val(m-start_var+1,1) = mpp_chksum(CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:)) - elseif (ASSOCIATED(CS%var_ptr2d(m)%p)) then + elseif (associated(CS%var_ptr2d(m)%p)) then check_val(m-start_var+1,1) = mpp_chksum(CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL)) - elseif (ASSOCIATED(CS%var_ptr4d(m)%p)) then + elseif (associated(CS%var_ptr4d(m)%p)) then check_val(m-start_var+1,1) = mpp_chksum(CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:)) - elseif (ASSOCIATED(CS%var_ptr1d(m)%p)) then + elseif (associated(CS%var_ptr1d(m)%p)) then check_val(m-start_var+1,1) = mpp_chksum(CS%var_ptr1d(m)%p) - elseif (ASSOCIATED(CS%var_ptr0d(m)%p)) then + elseif (associated(CS%var_ptr0d(m)%p)) then check_val(m-start_var+1,1) = mpp_chksum(CS%var_ptr0d(m)%p) endif enddo @@ -979,19 +979,19 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV) do m=start_var,next_var-1 - if (ASSOCIATED(CS%var_ptr3d(m)%p)) then + if (associated(CS%var_ptr3d(m)%p)) then call write_field(unit,fields(m-start_var+1), G%Domain%mpp_domain, & CS%var_ptr3d(m)%p, restart_time) - elseif (ASSOCIATED(CS%var_ptr2d(m)%p)) then + elseif (associated(CS%var_ptr2d(m)%p)) then call write_field(unit,fields(m-start_var+1), G%Domain%mpp_domain, & CS%var_ptr2d(m)%p, restart_time) - elseif (ASSOCIATED(CS%var_ptr4d(m)%p)) then + elseif (associated(CS%var_ptr4d(m)%p)) then call write_field(unit,fields(m-start_var+1), G%Domain%mpp_domain, & CS%var_ptr4d(m)%p, restart_time) - elseif (ASSOCIATED(CS%var_ptr1d(m)%p)) then + elseif (associated(CS%var_ptr1d(m)%p)) then call write_field(unit, fields(m-start_var+1), CS%var_ptr1d(m)%p, & restart_time) - elseif (ASSOCIATED(CS%var_ptr0d(m)%p)) then + elseif (associated(CS%var_ptr0d(m)%p)) then call write_field(unit, fields(m-start_var+1), CS%var_ptr0d(m)%p, & restart_time) endif @@ -1154,41 +1154,41 @@ subroutine restore_state(filename, directory, day, G, CS) endif if (.NOT. CS%checksum_required ) is_there_a_checksum = .false. ! Do not need to do data checksumming. - if (ASSOCIATED(CS%var_ptr1d(m)%p)) then + if (associated(CS%var_ptr1d(m)%p)) then ! Read a 1d array, which should be invariant to domain decomposition. call read_data(unit_path(n), varname, CS%var_ptr1d(m)%p, & no_domain=.true., timelevel=1) if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr1d(m)%p) - elseif (ASSOCIATED(CS%var_ptr0d(m)%p)) then ! Read a scalar... + elseif (associated(CS%var_ptr0d(m)%p)) then ! Read a scalar... call read_data(unit_path(n), varname, CS%var_ptr0d(m)%p, & no_domain=.true., timelevel=1) if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr0d(m)%p) - elseif ((pos == 0) .and. ASSOCIATED(CS%var_ptr2d(m)%p)) then ! Read a non-decomposed 2d array. + elseif ((pos == 0) .and. associated(CS%var_ptr2d(m)%p)) then ! Read a non-decomposed 2d array. ! Probably should query the field type to make sure that the sizes are right. call read_data(unit_path(n), varname, CS%var_ptr2d(m)%p, & no_domain=.true., timelevel=1) if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL)) - elseif ((pos == 0) .and. ASSOCIATED(CS%var_ptr3d(m)%p)) then ! Read a non-decomposed 3d array. + elseif ((pos == 0) .and. associated(CS%var_ptr3d(m)%p)) then ! Read a non-decomposed 3d array. ! Probably should query the field type to make sure that the sizes are right. call read_data(unit_path(n), varname, CS%var_ptr3d(m)%p, & no_domain=.true., timelevel=1) if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:)) - elseif ((pos == 0) .and. ASSOCIATED(CS%var_ptr4d(m)%p)) then ! Read a non-decomposed 4d array. + elseif ((pos == 0) .and. associated(CS%var_ptr4d(m)%p)) then ! Read a non-decomposed 4d array. ! Probably should query the field type to make sure that the sizes are right. call read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, & no_domain=.true., timelevel=1) if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:)) elseif (unit_is_global(n) .or. G%Domain%use_io_layout) then - if (ASSOCIATED(CS%var_ptr3d(m)%p)) then + if (associated(CS%var_ptr3d(m)%p)) then ! Read 3d array... Time level 1 is always used. call MOM_read_data(unit_path(n), varname, CS%var_ptr3d(m)%p, & G%Domain, 1, position=pos) if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:)) - elseif (ASSOCIATED(CS%var_ptr2d(m)%p)) then ! Read 2d array... + elseif (associated(CS%var_ptr2d(m)%p)) then ! Read 2d array... call MOM_read_data(unit_path(n), varname, CS%var_ptr2d(m)%p, & G%Domain, 1, position=pos) if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL)) - elseif (ASSOCIATED(CS%var_ptr4d(m)%p)) then ! Read 4d array... + elseif (associated(CS%var_ptr4d(m)%p)) then ! Read 4d array... call MOM_read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, & G%Domain, 1, position=pos) if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:)) @@ -1235,7 +1235,7 @@ subroutine restore_state(filename, directory, day, G, CS) exit endif - if (ASSOCIATED(CS%var_ptr3d(m)%p)) then + if (associated(CS%var_ptr3d(m)%p)) then if (ntime == 0) then call read_field(unit(n), fields(i), & CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:)) @@ -1243,7 +1243,7 @@ subroutine restore_state(filename, directory, day, G, CS) call read_field(unit(n), fields(i), & CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:), 1) endif - elseif (ASSOCIATED(CS%var_ptr2d(m)%p)) then + elseif (associated(CS%var_ptr2d(m)%p)) then if (ntime == 0) then call read_field(unit(n), fields(i), & CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL)) @@ -1251,7 +1251,7 @@ subroutine restore_state(filename, directory, day, G, CS) call read_field(unit(n), fields(i), & CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL), 1) endif - elseif (ASSOCIATED(CS%var_ptr4d(m)%p)) then + elseif (associated(CS%var_ptr4d(m)%p)) then if (ntime == 0) then call read_field(unit(n), fields(i), & CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:)) diff --git a/src/framework/MOM_safe_alloc.F90 b/src/framework/MOM_safe_alloc.F90 index 491d4563b6..196a6b40e6 100644 --- a/src/framework/MOM_safe_alloc.F90 +++ b/src/framework/MOM_safe_alloc.F90 @@ -38,7 +38,7 @@ subroutine safe_alloc_ptr_1d(ptr, i1, i2) real, pointer :: ptr(:) integer, intent(in) :: i1 integer, optional, intent(in) :: i2 - if (.not.ASSOCIATED(ptr)) then + if (.not.associated(ptr)) then if (present(i2)) then allocate(ptr(i1:i2)) else @@ -51,7 +51,7 @@ end subroutine safe_alloc_ptr_1d subroutine safe_alloc_ptr_2d_2arg(ptr, ni, nj) real, pointer :: ptr(:,:) integer, intent(in) :: ni, nj - if (.not.ASSOCIATED(ptr)) then + if (.not.associated(ptr)) then allocate(ptr(ni,nj)) ptr(:,:) = 0.0 endif @@ -60,7 +60,7 @@ end subroutine safe_alloc_ptr_2d_2arg subroutine safe_alloc_ptr_3d_2arg(ptr, ni, nj, nk) real, pointer :: ptr(:,:,:) integer, intent(in) :: ni, nj, nk - if (.not.ASSOCIATED(ptr)) then + if (.not.associated(ptr)) then allocate(ptr(ni,nj,nk)) ptr(:,:,:) = 0.0 endif @@ -69,7 +69,7 @@ end subroutine safe_alloc_ptr_3d_2arg subroutine safe_alloc_ptr_2d(ptr, is, ie, js, je) real, pointer :: ptr(:,:) integer, intent(in) :: is, ie, js, je - if (.not.ASSOCIATED(ptr)) then + if (.not.associated(ptr)) then allocate(ptr(is:ie,js:je)) ptr(:,:) = 0.0 endif @@ -78,7 +78,7 @@ end subroutine safe_alloc_ptr_2d subroutine safe_alloc_ptr_3d(ptr, is, ie, js, je, nk) real, pointer :: ptr(:,:,:) integer, intent(in) :: is, ie, js, je, nk - if (.not.ASSOCIATED(ptr)) then + if (.not.associated(ptr)) then allocate(ptr(is:ie,js:je,nk)) ptr(:,:,:) = 0.0 endif @@ -87,7 +87,7 @@ end subroutine safe_alloc_ptr_3d subroutine safe_alloc_allocatable_2d(ptr, is, ie, js, je) real, allocatable :: ptr(:,:) integer, intent(in) :: is, ie, js, je - if (.not.ALLOCATED(ptr)) then + if (.not.allocated(ptr)) then allocate(ptr(is:ie,js:je)) ptr(:,:) = 0.0 endif @@ -96,7 +96,7 @@ end subroutine safe_alloc_allocatable_2d subroutine safe_alloc_allocatable_3d(ptr, is, ie, js, je, nk) real, allocatable :: ptr(:,:,:) integer, intent(in) :: is, ie, js, je, nk - if (.not.ALLOCATED(ptr)) then + if (.not.allocated(ptr)) then allocate(ptr(is:ie,js:je,nk)) ptr(:,:,:) = 0.0 endif diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index ae92454a2a..efa74e561e 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -447,8 +447,8 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) CS%salt_flux(:,:) = 0.0; CS%t_flux(:,:) = 0.0 CS%tfreeze(:,:) = 0.0 ! define Sbdry to avoid Run-Time Check Failure, when melt is not computed. - ALLOCATE ( haline_driving(G%ied,G%jed) ); haline_driving(:,:) = 0.0 - ALLOCATE ( Sbdry(G%ied,G%jed) ); Sbdry(:,:) = state%sss(:,:) + allocate( haline_driving(G%ied,G%jed) ); haline_driving(:,:) = 0.0 + allocate( Sbdry(G%ied,G%jed) ); Sbdry(:,:) = state%sss(:,:) !update time CS%Time = Time @@ -774,7 +774,7 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) enddo ! j-loop ! mass flux (kg/s), part of ISOMIP diags. - ALLOCATE ( mass_flux(G%ied,G%jed) ); mass_flux(:,:) = 0.0 + allocate( mass_flux(G%ied,G%jed) ); mass_flux(:,:) = 0.0 mass_flux = (CS%lprec) * CS%area_shelf_h if (CS%shelf_mass_is_dynamic) then @@ -2343,23 +2343,23 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed rhoi = CS%density_ice rhow = CS%density_ocean_avg - ALLOCATE (TAUDX (isdq:iedq,jsdq:jedq) ) ; TAUDX(:,:)=0 - ALLOCATE (TAUDY (isdq:iedq,jsdq:jedq) ) ; TAUDY(:,:)=0 - ALLOCATE (u_prev_iterate (isdq:iedq,jsdq:jedq) ) - ALLOCATE (v_prev_iterate (isdq:iedq,jsdq:jedq) ) - ALLOCATE (u_bdry_cont (isdq:iedq,jsdq:jedq) ) ; u_bdry_cont(:,:)=0 - ALLOCATE (v_bdry_cont (isdq:iedq,jsdq:jedq) ) ; v_bdry_cont(:,:)=0 - ALLOCATE (Au (isdq:iedq,jsdq:jedq) ) ; Au(:,:)=0 - ALLOCATE (Av (isdq:iedq,jsdq:jedq) ) ; Av(:,:)=0 - ALLOCATE (err_u (isdq:iedq,jsdq:jedq) ) - ALLOCATE (err_v (isdq:iedq,jsdq:jedq) ) - ALLOCATE (u_last (isdq:iedq,jsdq:jedq) ) - ALLOCATE (v_last (isdq:iedq,jsdq:jedq) ) + allocate(TAUDX (isdq:iedq,jsdq:jedq) ) ; TAUDX(:,:)=0 + allocate(TAUDY (isdq:iedq,jsdq:jedq) ) ; TAUDY(:,:)=0 + allocate(u_prev_iterate (isdq:iedq,jsdq:jedq) ) + allocate(v_prev_iterate (isdq:iedq,jsdq:jedq) ) + allocate(u_bdry_cont (isdq:iedq,jsdq:jedq) ) ; u_bdry_cont(:,:)=0 + allocate(v_bdry_cont (isdq:iedq,jsdq:jedq) ) ; v_bdry_cont(:,:)=0 + allocate(Au (isdq:iedq,jsdq:jedq) ) ; Au(:,:)=0 + allocate(Av (isdq:iedq,jsdq:jedq) ) ; Av(:,:)=0 + allocate(err_u (isdq:iedq,jsdq:jedq) ) + allocate(err_v (isdq:iedq,jsdq:jedq) ) + allocate(u_last (isdq:iedq,jsdq:jedq) ) + allocate(v_last (isdq:iedq,jsdq:jedq) ) ! need to make these conditional on GL interpolation - ALLOCATE (float_cond (G%isd:G%ied,G%jsd:G%jed)) ; float_cond(:,:)=0 - ALLOCATE (H_node (G%isdB:G%iedB,G%jsdB:G%jedB)) ; H_node(:,:)=0 - ALLOCATE (Phisub (nsub,nsub,2,2,2,2)) ; Phisub = 0.0 + allocate(float_cond (G%isd:G%ied,G%jsd:G%jed)) ; float_cond(:,:)=0 + allocate(H_node (G%isdB:G%iedB,G%jsdB:G%jedB)) ; H_node(:,:)=0 + allocate(Phisub (nsub,nsub,2,2,2,2)) ; Phisub = 0.0 geolonq => G%geoLonBu ; geolatq => G%geoLatBu @@ -2654,21 +2654,21 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) !write (procnum,'(I1)') mpp_pe() !write (numproc,'(I1)') mpp_npes() - DEALLOCATE (TAUDX) - DEALLOCATE (TAUDY) - DEALLOCATE (u_prev_iterate) - DEALLOCATE (v_prev_iterate) - DEALLOCATE (u_bdry_cont) - DEALLOCATE (v_bdry_cont) - DEALLOCATE (Au) - DEALLOCATE (Av) - DEALLOCATE (err_u) - DEALLOCATE (err_v) - DEALLOCATE (u_last) - DEALLOCATE (v_last) - DEALLOCATE (H_node) - DEALLOCATE (float_cond) - DEALLOCATE (Phisub) + deallocate (TAUDX) + deallocate (TAUDY) + deallocate (u_prev_iterate) + deallocate (v_prev_iterate) + deallocate (u_bdry_cont) + deallocate (v_bdry_cont) + deallocate (Au) + deallocate (Av) + deallocate (err_u) + deallocate (err_v) + deallocate (u_last) + deallocate (v_last) + deallocate (H_node) + deallocate (float_cond) + deallocate (Phisub) end subroutine ice_shelf_solve_outer @@ -3758,7 +3758,7 @@ subroutine shelf_advance_front (CS, flux_enter) if(is_root_pe() .and. (iter_count.gt.1)) print *, iter_count, "MAX ITERATIONS,ADVANCE FRONT" - if (associated(flux_enter_replace)) DEALLOCATE(flux_enter_replace) + if (associated(flux_enter_replace)) deallocate(flux_enter_replace) end subroutine shelf_advance_front diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 2609c4980d..7709af5d0e 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -278,7 +278,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) global_indices(3) = 1+SGdom%njhalo global_indices(4) = SGdom%njglobal+SGdom%njhalo exni(:) = 2*exni(:) ; exnj(:) = 2*exnj(:) - if(ASSOCIATED(G%domain%maskmap)) then + if(associated(G%domain%maskmap)) then call MOM_define_domain(global_indices, SGdom%layout, SGdom%mpp_domain, & xflags=G%domain%X_FLAGS, yflags=G%domain%Y_FLAGS, & xhalo=SGdom%nihalo, yhalo=SGdom%njhalo, & diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 219a6b33fa..4ef3af5949 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -196,7 +196,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & "The directory in which input files are found.", default=".") inputdir = slasher(inputdir) - use_temperature = ASSOCIATED(tv%T) + use_temperature = associated(tv%T) useALE = associated(ALE_CSp) use_EOS = associated(tv%eqn_of_state) use_OBC = associated(OBC) diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index d473e19daf..d322e115c9 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -341,8 +341,8 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) ! return if not time for analysis if (Time < CS%Time) return - if (.not. ASSOCIATED(CS%Grid)) call MOM_ERROR(FATAL,'ODA_CS ensemble horizontal grid not associated') - if (.not. ASSOCIATED(CS%GV)) call MOM_ERROR(FATAL,'ODA_CS ensemble vertical grid not associated') + if (.not. associated(CS%Grid)) call MOM_ERROR(FATAL,'ODA_CS ensemble horizontal grid not associated') + if (.not. associated(CS%GV)) call MOM_ERROR(FATAL,'ODA_CS ensemble vertical grid not associated') !! switch to global pelist call set_current_pelist(CS%filter_pelist) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 226f40f59b..fbc78f3bdd 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -146,13 +146,13 @@ subroutine calc_resoln_function(h, tv, G, GV, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - if (.not. ASSOCIATED(CS)) call MOM_error(FATAL, "calc_resoln_function:"// & + if (.not. associated(CS)) call MOM_error(FATAL, "calc_resoln_function:"// & "Module must be initialized before it is used.") if (CS%calculate_cg1) then - if (.not. ASSOCIATED(CS%cg1)) call MOM_error(FATAL, & + if (.not. associated(CS%cg1)) call MOM_error(FATAL, & "calc_resoln_function: %cg1 is not associated with Resoln_scaled_Kh.") if (CS%khth_use_ebt_struct) then - if (.not. ASSOCIATED(CS%ebt_struct)) call MOM_error(FATAL, & + if (.not. associated(CS%ebt_struct)) call MOM_error(FATAL, & "calc_resoln_function: %ebt_struct is not associated with RESOLN_USE_EBT.") if (CS%Resoln_use_ebt) then ! Both resolution fn and vertical structure are using EBT @@ -174,7 +174,7 @@ subroutine calc_resoln_function(h, tv, G, GV, CS) ! Calculate and store the ratio between deformation radius and grid-spacing ! at h-points (non-dimensional). if (CS%calculate_rd_dx) then - if (.not. ASSOCIATED(CS%Rd_dx_h)) call MOM_error(FATAL, & + if (.not. associated(CS%Rd_dx_h)) call MOM_error(FATAL, & "calc_resoln_function: %Rd_dx_h is not associated with calculate_rd_dx.") !$OMP parallel default(none) shared(is,ie,js,je,CS) !$OMP do @@ -190,29 +190,29 @@ subroutine calc_resoln_function(h, tv, G, GV, CS) if (.not. CS%calculate_res_fns) return - if (.not. ASSOCIATED(CS%Res_fn_h)) call MOM_error(FATAL, & + if (.not. associated(CS%Res_fn_h)) call MOM_error(FATAL, & "calc_resoln_function: %Res_fn_h is not associated with Resoln_scaled_Kh.") - if (.not. ASSOCIATED(CS%Res_fn_q)) call MOM_error(FATAL, & + if (.not. associated(CS%Res_fn_q)) call MOM_error(FATAL, & "calc_resoln_function: %Res_fn_q is not associated with Resoln_scaled_Kh.") - if (.not. ASSOCIATED(CS%Res_fn_u)) call MOM_error(FATAL, & + if (.not. associated(CS%Res_fn_u)) call MOM_error(FATAL, & "calc_resoln_function: %Res_fn_u is not associated with Resoln_scaled_Kh.") - if (.not. ASSOCIATED(CS%Res_fn_v)) call MOM_error(FATAL, & + if (.not. associated(CS%Res_fn_v)) call MOM_error(FATAL, & "calc_resoln_function: %Res_fn_v is not associated with Resoln_scaled_Kh.") - if (.not. ASSOCIATED(CS%f2_dx2_h)) call MOM_error(FATAL, & + if (.not. associated(CS%f2_dx2_h)) call MOM_error(FATAL, & "calc_resoln_function: %f2_dx2_h is not associated with Resoln_scaled_Kh.") - if (.not. ASSOCIATED(CS%f2_dx2_q)) call MOM_error(FATAL, & + if (.not. associated(CS%f2_dx2_q)) call MOM_error(FATAL, & "calc_resoln_function: %f2_dx2_q is not associated with Resoln_scaled_Kh.") - if (.not. ASSOCIATED(CS%f2_dx2_u)) call MOM_error(FATAL, & + if (.not. associated(CS%f2_dx2_u)) call MOM_error(FATAL, & "calc_resoln_function: %f2_dx2_u is not associated with Resoln_scaled_Kh.") - if (.not. ASSOCIATED(CS%f2_dx2_v)) call MOM_error(FATAL, & + if (.not. associated(CS%f2_dx2_v)) call MOM_error(FATAL, & "calc_resoln_function: %f2_dx2_v is not associated with Resoln_scaled_Kh.") - if (.not. ASSOCIATED(CS%beta_dx2_h)) call MOM_error(FATAL, & + if (.not. associated(CS%beta_dx2_h)) call MOM_error(FATAL, & "calc_resoln_function: %beta_dx2_h is not associated with Resoln_scaled_Kh.") - if (.not. ASSOCIATED(CS%beta_dx2_q)) call MOM_error(FATAL, & + if (.not. associated(CS%beta_dx2_q)) call MOM_error(FATAL, & "calc_resoln_function: %beta_dx2_q is not associated with Resoln_scaled_Kh.") - if (.not. ASSOCIATED(CS%beta_dx2_u)) call MOM_error(FATAL, & + if (.not. associated(CS%beta_dx2_u)) call MOM_error(FATAL, & "calc_resoln_function: %beta_dx2_u is not associated with Resoln_scaled_Kh.") - if (.not. ASSOCIATED(CS%beta_dx2_v)) call MOM_error(FATAL, & + if (.not. associated(CS%beta_dx2_v)) call MOM_error(FATAL, & "calc_resoln_function: %beta_dx2_v is not associated with Resoln_scaled_Kh.") ! Do this calculation on the extent used in MOM_hor_visc.F90, and @@ -389,7 +389,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS) real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: N2_u ! Square of Brunt-Vaisala freq at u-points real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: N2_v ! Square of Brunt-Vaisala freq at u-points - if (.not. ASSOCIATED(CS)) call MOM_error(FATAL, "MOM_lateral_mixing_coeffs.F90, calc_slope_functions:"//& + if (.not. associated(CS)) call MOM_error(FATAL, "MOM_lateral_mixing_coeffs.F90, calc_slope_functions:"//& "Module must be initialized before it is used.") if (CS%calculate_Eady_growth_rate) then @@ -444,12 +444,12 @@ subroutine calc_Visbeck_coeffs(h, e, slope_x, slope_y, N2_u, N2_v, G, GV, CS) real :: S2_u(SZIB_(G), SZJ_(G)) real :: S2_v(SZI_(G), SZJB_(G)) - if (.not. ASSOCIATED(CS)) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. associated(CS)) call MOM_error(FATAL, "calc_slope_function:"// & "Module must be initialized before it is used.") if (.not. CS%calculate_Eady_growth_rate) return - if (.not. ASSOCIATED(CS%SN_u)) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. associated(CS%SN_u)) call MOM_error(FATAL, "calc_slope_function:"// & "%SN_u is not associated with use_variable_mixing.") - if (.not. ASSOCIATED(CS%SN_v)) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. associated(CS%SN_v)) call MOM_error(FATAL, "calc_slope_function:"// & "%SN_v is not associated with use_variable_mixing.") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -606,12 +606,12 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) real :: SN_u_local(SZIB_(G), SZJ_(G),SZK_(G)) real :: SN_v_local(SZI_(G), SZJB_(G),SZK_(G)) - if (.not. ASSOCIATED(CS)) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. associated(CS)) call MOM_error(FATAL, "calc_slope_function:"// & "Module must be initialized before it is used.") if (.not. CS%calculate_Eady_growth_rate) return - if (.not. ASSOCIATED(CS%SN_u)) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. associated(CS%SN_u)) call MOM_error(FATAL, "calc_slope_function:"// & "%SN_u is not associated with use_variable_mixing.") - if (.not. ASSOCIATED(CS%SN_v)) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. associated(CS%SN_v)) call MOM_error(FATAL, "calc_slope_function:"// & "%SN_v is not associated with use_variable_mixing.") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 170b803c64..0a4f444240 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -122,7 +122,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS real :: KH_u_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities (m2/sec) real :: KH_v_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities (m2/sec) - if (.not. ASSOCIATED(CS)) call MOM_error(FATAL, "MOM_thickness_diffuse:"// & + if (.not. associated(CS)) call MOM_error(FATAL, "MOM_thickness_diffuse:"// & "Module must be initialized before it is used.") if ((.not.CS%thickness_diffuse) .or. & @@ -133,14 +133,14 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H if (associated(MEKE)) then - if (ASSOCIATED(MEKE%GM_src)) then + if (associated(MEKE%GM_src)) then do j=js,je ; do i=is,ie ; MEKE%GM_src(i,j) = 0. ; enddo ; enddo endif endif use_VarMix = .false. ; Resoln_scaled = .false. ; use_stored_slopes = .false. khth_use_ebt_struct = .false. - if (Associated(VarMix)) then + if (associated(VarMix)) then use_VarMix = VarMix%use_variable_mixing .and. (CS%KHTH_Slope_Cff > 0.) Resoln_scaled = VarMix%Resoln_scaled_KhTh use_stored_slopes = VarMix%use_stored_slopes @@ -312,8 +312,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS int_slope_u, int_slope_v) endif - if (associated(MEKE) .AND. ASSOCIATED(VarMix)) then - if (ASSOCIATED(MEKE%Rd_dx_h) .and. ASSOCIATED(VarMix%Rd_dx_h)) then + if (associated(MEKE) .AND. associated(VarMix)) then + if (associated(MEKE%Rd_dx_h) .and. associated(VarMix%Rd_dx_h)) then !$OMP parallel do default(none) shared(is,ie,js,je,MEKE,VarMix) do j=js,je ; do i=is,ie MEKE%Rd_dx_h(i,j) = VarMix%Rd_dx_h(i,j) @@ -367,11 +367,11 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS do k=1,nz do j=js,je ; do I=is-1,ie uhtr(I,j,k) = uhtr(I,j,k) + uhD(I,j,k)*dt - if (ASSOCIATED(CDp%uhGM)) CDp%uhGM(I,j,k) = uhD(I,j,k) + if (associated(CDp%uhGM)) CDp%uhGM(I,j,k) = uhD(I,j,k) enddo ; enddo do J=js-1,je ; do i=is,ie vhtr(i,J,k) = vhtr(i,J,k) + vhD(i,J,k)*dt - if (ASSOCIATED(CDp%vhGM)) CDp%vhGM(i,J,k) = vhD(i,J,k) + if (associated(CDp%vhGM)) CDp%vhGM(i,J,k) = vhD(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie h(i,j,k) = h(i,j,k) - dt * G%IareaT(i,j) * & @@ -529,8 +529,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV nk_linear = max(GV%nkml, 1) find_work = .false. - if (associated(MEKE)) find_work = ASSOCIATED(MEKE%GM_src) - find_work = (ASSOCIATED(CS%GMwork) .or. find_work) + if (associated(MEKE)) find_work = associated(MEKE%GM_src) + find_work = (associated(CS%GMwork) .or. find_work) if (use_EOS) then call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth, dt, T, S, G, GV, 1) @@ -1130,8 +1130,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Note that the units of Work_v and Work_u are W, while Work_h is W m-2. Work_h = 0.5 * G%IareaT(i,j) * & ((Work_u(I-1,j) + Work_u(I,j)) + (Work_v(i,J-1) + Work_v(i,J))) - if (ASSOCIATED(CS%GMwork)) CS%GMwork(i,j) = Work_h - if (associated(MEKE)) then ; if (ASSOCIATED(MEKE%GM_src)) then + if (associated(CS%GMwork)) CS%GMwork(i,j) = Work_h + if (associated(MEKE)) then ; if (associated(MEKE%GM_src)) then MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + Work_h endif ; endif enddo ; enddo ; endif diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 7b2b39f242..c2631cff36 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -441,10 +441,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & "Module must be initialized before it is used.") if (GV%nkml < 1) return - if (.not. ASSOCIATED(tv%eqn_of_state)) call MOM_error(FATAL, & + if (.not. associated(tv%eqn_of_state)) call MOM_error(FATAL, & "MOM_mixed_layer: Temperature, salinity and an equation of state "//& "must now be used.") - if (.NOT. ASSOCIATED(fluxes%ustar)) call MOM_error(FATAL, & + if (.NOT. associated(fluxes%ustar)) call MOM_error(FATAL, & "MOM_mixed_layer: No surface TKE fluxes (ustar) defined in mixedlayer!") nkmb = CS%nkml+CS%nkbl @@ -503,13 +503,13 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & CS%diag_TKE_conv_decay(i,j) = 0.0 ; CS%diag_TKE_conv_s2(i,j) = 0.0 enddo ; enddo endif - if (ALLOCATED(CS%diag_PE_detrain)) then + if (allocated(CS%diag_PE_detrain)) then !$OMP do do j=js,je ; do i=is,ie CS%diag_PE_detrain(i,j) = 0.0 enddo ; enddo endif - if (ALLOCATED(CS%diag_PE_detrain2)) then + if (allocated(CS%diag_PE_detrain2)) then !$OMP do do j=js,je ; do i=is,ie CS%diag_PE_detrain2(i,j) = 0.0 @@ -674,10 +674,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & T(i,0) = T(i,1) ; S(i,0) = S(i,1) ; R0(i,0) = R0(i,1) ; Rcv(i,0) = Rcv(i,1) h(i,0) = htot(i) endif ; enddo - if (write_diags .and. ALLOCATED(CS%ML_depth)) then ; do i=is,ie + if (write_diags .and. allocated(CS%ML_depth)) then ; do i=is,ie CS%ML_depth(i,j) = h(i,0) * GV%H_to_m enddo ; endif - if (ASSOCIATED(Hml)) then ; do i=is,ie + if (associated(Hml)) then ; do i=is,ie Hml(i,j) = G%mask2dT(i,j) * (h(i,0) * GV%H_to_m) enddo ; endif @@ -1221,10 +1221,10 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & (dRcv_dT(i)*(Net_heat(i) + Pen_absorbed) - & dRcv_dS(i) * (netMassIn(i) * S(i,1) - Net_salt(i))) Conv_En(i) = 0.0 ; dKE_FC(i) = 0.0 - if(ASSOCIATED(fluxes%heat_content_massin)) & + if(associated(fluxes%heat_content_massin)) & fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) & + T_precip * netMassIn(i) * GV%H_to_kg_m2 * fluxes%C_p * Idt - if (ASSOCIATED(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & + if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & T_precip * netMassIn(i) * GV%H_to_kg_m2 endif ; enddo @@ -1274,10 +1274,10 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! heat_content_massout = heat_content_massout - T(i,k)*h_evap*GV%H_to_kg_m2*fluxes%C_p*Idt ! by uncommenting the lines here. ! we will also then completely remove TempXpme from the model. - if(ASSOCIATED(fluxes%heat_content_massout)) & + if(associated(fluxes%heat_content_massout)) & fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) & - T(i,k)*h_evap*GV%H_to_kg_m2 * fluxes%C_p * Idt - if (ASSOCIATED(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) - & + if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) - & T(i,k)*h_evap*GV%H_to_kg_m2 endif @@ -3006,7 +3006,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, h(i,0) = h(i,0) - (h_ml_to_h1 + h_ml_to_h2) - if (ALLOCATED(CS%diag_PE_detrain) .or. ALLOCATED(CS%diag_PE_detrain2)) then + if (allocated(CS%diag_PE_detrain) .or. allocated(CS%diag_PE_detrain2)) then R0_det = R0_to_bl*Ihdet s1en = G_2 * Idt_H2 * ( ((R0(i,kb2)-R0(i,kb1))*h1*h2 + & h_det_to_h2*( (R0(i,kb1)-R0_det)*h1 + (R0(i,kb2)-R0_det)*h2 ) + & @@ -3014,10 +3014,10 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, (R0_det-R0(i,0))*h_det_to_h2 ) + & h_det_to_h1*h_ml_to_h1*(R0_det-R0(i,0))) - 2.0*GV%Rho0*dPE_extrap ) - if (ALLOCATED(CS%diag_PE_detrain)) & + if (allocated(CS%diag_PE_detrain)) & CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + s1en - if (ALLOCATED(CS%diag_PE_detrain2)) CS%diag_PE_detrain2(i,j) = & + if (allocated(CS%diag_PE_detrain2)) CS%diag_PE_detrain2(i,j) = & CS%diag_PE_detrain2(i,j) + s1en + Idt_H2*Rho0xG*dPE_extrap endif @@ -3215,9 +3215,9 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, h(i,kb1) = stays + h_to_bl h(i,kb2) = h1_to_h2 h(i,k0) = h(i,k0) + (h1_to_k0 + h2) - if (ALLOCATED(CS%diag_PE_detrain)) & + if (allocated(CS%diag_PE_detrain)) & CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + Idt_H2*dPE_merge - if (ALLOCATED(CS%diag_PE_detrain2)) CS%diag_PE_detrain2(i,j) = & + if (allocated(CS%diag_PE_detrain2)) CS%diag_PE_detrain2(i,j) = & CS%diag_PE_detrain2(i,j) + Idt_H2*(dPE_det+Rho0xG*dPE_extrap) else ! Not mergeable_bl. ! There is no further detrainment from the buffer layers, and the @@ -3291,9 +3291,9 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, h(i,kb1) = stays + h_to_bl h(i,kb2) = h(i,kb2) + h1_to_h2 - if (ALLOCATED(CS%diag_PE_detrain)) & + if (allocated(CS%diag_PE_detrain)) & CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + Idt_H2*dPE_det - if (ALLOCATED(CS%diag_PE_detrain2)) CS%diag_PE_detrain2(i,j) = & + if (allocated(CS%diag_PE_detrain2)) CS%diag_PE_detrain2(i,j) = & CS%diag_PE_detrain2(i,j) + Idt_H2*(dPE_det+Rho0xG*dPE_extrap) endif endif ! End of detrainment... @@ -3412,10 +3412,10 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e CS%diag_TKE_conv_s2(i,j) = CS%diag_TKE_conv_s2(i,j) + & g_H2_2Rho0dt * h(i,k) * h(i,nkmb) * & (R0(i,nkmb) - R0(i,k)) - if (ALLOCATED(CS%diag_PE_detrain)) & + if (allocated(CS%diag_PE_detrain)) & CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + & g_H2_2dt * h(i,k) * h(i,nkmb) * (R0(i,nkmb) - R0(i,k)) - if (ALLOCATED(CS%diag_PE_detrain2)) & + if (allocated(CS%diag_PE_detrain2)) & CS%diag_PE_detrain2(i,j) = CS%diag_PE_detrain2(i,j) + & g_H2_2dt * h(i,k) * h(i,nkmb) * (R0(i,nkmb) - R0(i,k)) @@ -3462,7 +3462,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e d_eb(i,nkmb) = d_eb(i,nkmb) - detrain(i) d_ea(i,nkmb) = d_ea(i,nkmb) + detrain(i) - if (ALLOCATED(CS%diag_PE_detrain)) CS%diag_PE_detrain(i,j) = & + if (allocated(CS%diag_PE_detrain)) CS%diag_PE_detrain(i,j) = & CS%diag_PE_detrain(i,j) + g_H2_2dt * detrain(i)* & (h(i,0) + h(i,nkmb)) * (R0(i,nkmb) - R0(i,0)) x1 = R0(i,0) @@ -3542,7 +3542,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e detrain(i) = h(i,nkmb)*(Rcv(i,nkmb) - RcvTgt(k)) / & (RcvTgt(k+1) - RcvTgt(k)) - if (ALLOCATED(CS%diag_PE_detrain)) CS%diag_PE_detrain(i,j) = & + if (allocated(CS%diag_PE_detrain)) CS%diag_PE_detrain(i,j) = & CS%diag_PE_detrain(i,j) - g_H2_2dt * detrain(i) * & (h(i,nkmb)-detrain(i)) * (RcvTgt(k+1) - RcvTgt(k)) * dR0_dRcv @@ -3591,7 +3591,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e h(i,k+1) = h(i,k+1) + detrain(i) h(i,nkmb) = h(i,nkmb) - detrain(i) - if (ALLOCATED(CS%diag_PE_detrain)) CS%diag_PE_detrain(i,j) = & + if (allocated(CS%diag_PE_detrain)) CS%diag_PE_detrain(i,j) = & CS%diag_PE_detrain(i,j) - g_H2_2dt * detrain(i) * dR0_dRcv * & (h(i,nkmb)-detrain(i)) * (RcvTgt(k+1) - Rcv(i,nkmb) + dRml) endif diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 9588ac3a5c..52338fcb40 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -456,7 +456,7 @@ subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - if (.not.ASSOCIATED(fluxes%salt_flux)) return + if (.not.associated(fluxes%salt_flux)) return p_ref_cv(:) = tv%P_ref @@ -861,7 +861,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke ! Only apply forcing if fluxes%sw is associated. - if (.not.ASSOCIATED(fluxes%sw)) return + if (.not.associated(fluxes%sw)) return #define _OLD_ALG_ nsw = optics%nbands @@ -1043,13 +1043,13 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & dTemp = dTemp + dThickness*Temp_in ! Diagnostics of heat content associated with mass fluxes - if (ASSOCIATED(fluxes%heat_content_massin)) & + if (associated(fluxes%heat_content_massin)) & fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) + & T2d(i,k) * max(0.,dThickness) * GV%H_to_kg_m2 * fluxes%C_p * Idt - if (ASSOCIATED(fluxes%heat_content_massout)) & + if (associated(fluxes%heat_content_massout)) & fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) + & T2d(i,k) * min(0.,dThickness) * GV%H_to_kg_m2 * fluxes%C_p * Idt - if (ASSOCIATED(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & + if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & T2d(i,k) * dThickness * GV%H_to_kg_m2 ! Determine the energetics of river mixing before updating the state. @@ -1123,13 +1123,13 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & dTemp = dTemp + dThickness*T2d(i,k) ! Diagnostics of heat content associated with mass fluxes - if (ASSOCIATED(fluxes%heat_content_massin)) & + if (associated(fluxes%heat_content_massin)) & fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) + & tv%T(i,j,k) * max(0.,dThickness) * GV%H_to_kg_m2 * fluxes%C_p * Idt - if (ASSOCIATED(fluxes%heat_content_massout)) & + if (associated(fluxes%heat_content_massout)) & fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) + & tv%T(i,j,k) * min(0.,dThickness) * GV%H_to_kg_m2 * fluxes%C_p * Idt - if (ASSOCIATED(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & + if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & tv%T(i,j,k) * dThickness * GV%H_to_kg_m2 !NOTE tv%T should be T2d diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 6b99d566bb..24ebb3ebd1 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -425,7 +425,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G ! Frazil formation keeps the temperature above the freezing point. ! make_frazil is deliberately called at both the beginning and at ! the end of the diabatic processes. - if (ASSOCIATED(tv%T) .AND. ASSOCIATED(tv%frazil)) then + if (associated(tv%T) .AND. associated(tv%frazil)) then ! For frazil diagnostic, the first call covers the first half of the time step call enable_averaging(0.5*dt, Time_end - set_time(int(floor(0.5*dt+0.5))), CS%diag) if(CS%frazil_tendency_diag) then @@ -434,7 +434,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G enddo ; enddo ; enddo endif - if (ASSOCIATED(fluxes%p_surf_full)) then + if (associated(fluxes%p_surf_full)) then call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) else call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) @@ -513,7 +513,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G ! from this limitation, in which case we can let salinity=0 and still ! have salt conserved with SIS2 ice. So for SIS2, we can run with ! BOUND_SALINITY=False in MOM.F90. - if (ASSOCIATED(tv%S) .and. ASSOCIATED(tv%salt_deficit)) & + if (associated(tv%S) .and. associated(tv%salt_deficit)) & call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) call cpu_clock_end(id_clock_mixedlayer) if (CS%debug) then @@ -934,7 +934,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G ! This is a very long block. if (CS%bulkmixedlayer) then - if (ASSOCIATED(tv%T)) then + if (associated(tv%T)) then call cpu_clock_begin(id_clock_tridiag) ! Temperature and salinity (as state variables) are treated ! differently from other tracers to insure massless layers that @@ -1017,7 +1017,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G endif ! massless_match_targets call cpu_clock_end(id_clock_tridiag) - endif ! endif for ASSOCIATED(T) + endif ! endif for associated(T) if (CS%debugConservation) call MOM_state_stats('BML tridiag', u, v, h, tv%T, tv%S, G) if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then @@ -1064,7 +1064,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G ! from this limitation, in which case we can let salinity=0 and still ! have salt conserved with SIS2 ice. So for SIS2, we can run with ! BOUND_SALINITY=False in MOM.F90. - if (ASSOCIATED(tv%S) .and. ASSOCIATED(tv%salt_deficit)) & + if (associated(tv%S) .and. associated(tv%salt_deficit)) & call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) call cpu_clock_end(id_clock_mixedlayer) @@ -1076,7 +1076,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G ! calculate change in temperature & salinity due to dia-coordinate surface diffusion - if (ASSOCIATED(tv%T)) then + if (associated(tv%T)) then if (CS%debug) then call hchksum(ea, "before triDiagTS ea ",G%HI,haloshift=0, scale=GV%H_to_m) @@ -1090,7 +1090,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G ! from this limitation, in which case we can let salinity=0 and still ! have salt conserved with SIS2 ice. So for SIS2, we can run with ! BOUND_SALINITY=False in MOM.F90. - if (ASSOCIATED(tv%S) .and. ASSOCIATED(tv%salt_deficit)) & + if (associated(tv%S) .and. associated(tv%salt_deficit)) & call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) if(CS%diabatic_diff_tendency_diag) then @@ -1120,7 +1120,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G call cpu_clock_end(id_clock_tridiag) if (showCallTree) call callTree_waypoint("done with triDiagTS (diabatic)") - endif ! endif corresponding to if (ASSOCIATED(tv%T)) + endif ! endif corresponding to if (associated(tv%T)) if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G) @@ -1294,7 +1294,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G call apply_ALE_sponge(h, dt, G, CS%ALE_sponge_CSp, CS%Time) else ! Layer mode sponge - if (CS%bulkmixedlayer .and. ASSOCIATED(tv%eqn_of_state)) then + if (CS%bulkmixedlayer .and. associated(tv%eqn_of_state)) then do i=is,ie ; p_ref_cv(i) = tv%P_Ref ; enddo !$OMP parallel do default(shared) do j=js,je @@ -1315,7 +1315,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G ! Save the diapycnal mass fluxes as a diagnostic field. - if (ASSOCIATED(CDp%diapyc_vel)) then + if (associated(CDp%diapyc_vel)) then !$OMP parallel do default(shared) do j=js,je do K=2,nz ; do i=is,ie @@ -1389,14 +1389,14 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) do j=js,je do I=Isq,Ieq - if (ASSOCIATED(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,1) = u(I,j,1) + if (associated(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,1) = u(I,j,1) hval = (hold(i,j,1) + hold(i+1,j,1)) + (ea(i,j,1) + ea(i+1,j,1)) + h_neglect b1(I) = 1.0 / (hval + (eb(i,j,1) + eb(i+1,j,1))) d1(I) = hval * b1(I) u(I,j,1) = b1(I) * (hval * u(I,j,1)) enddo do k=2,nz ; do I=Isq,Ieq - if (ASSOCIATED(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,k) = u(I,j,k) + if (associated(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,k) = u(I,j,k) c1(I,k) = (eb(i,j,k-1)+eb(i+1,j,k-1)) * b1(I) eaval = ea(i,j,k) + ea(i+1,j,k) hval = hold(i,j,k) + hold(i+1,j,k) + h_neglect @@ -1406,10 +1406,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G enddo ; enddo do k=nz-1,1,-1 ; do I=Isq,Ieq u(I,j,k) = u(I,j,k) + c1(I,k+1)*u(I,j,k+1) - if (ASSOCIATED(ADp%du_dt_dia)) & + if (associated(ADp%du_dt_dia)) & ADp%du_dt_dia(I,j,k) = (u(I,j,k) - ADp%du_dt_dia(I,j,k)) * Idt enddo ; enddo - if (ASSOCIATED(ADp%du_dt_dia)) then + if (associated(ADp%du_dt_dia)) then do I=Isq,Ieq ADp%du_dt_dia(I,j,nz) = (u(I,j,nz)-ADp%du_dt_dia(I,j,nz)) * Idt enddo @@ -1421,14 +1421,14 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) do J=Jsq,Jeq do i=is,ie - if (ASSOCIATED(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,1) = v(i,J,1) + if (associated(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,1) = v(i,J,1) hval = (hold(i,j,1) + hold(i,j+1,1)) + (ea(i,j,1) + ea(i,j+1,1)) + h_neglect b1(i) = 1.0 / (hval + (eb(i,j,1) + eb(i,j+1,1))) d1(I) = hval * b1(I) v(i,J,1) = b1(i) * (hval * v(i,J,1)) enddo do k=2,nz ; do i=is,ie - if (ASSOCIATED(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,k) = v(i,J,k) + if (associated(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,k) = v(i,J,k) c1(i,k) = (eb(i,j,k-1)+eb(i,j+1,k-1)) * b1(i) eaval = ea(i,j,k) + ea(i,j+1,k) hval = hold(i,j,k) + hold(i,j+1,k) + h_neglect @@ -1438,10 +1438,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G enddo ; enddo do k=nz-1,1,-1 ; do i=is,ie v(i,J,k) = v(i,J,k) + c1(i,k+1)*v(i,J,k+1) - if (ASSOCIATED(ADp%dv_dt_dia)) & + if (associated(ADp%dv_dt_dia)) & ADp%dv_dt_dia(i,J,k) = (v(i,J,k) - ADp%dv_dt_dia(i,J,k)) * Idt enddo ; enddo - if (ASSOCIATED(ADp%dv_dt_dia)) then + if (associated(ADp%dv_dt_dia)) then do i=is,ie ADp%dv_dt_dia(i,J,nz) = (v(i,J,nz)-ADp%dv_dt_dia(i,J,nz)) * Idt enddo @@ -1457,7 +1457,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G ! Frazil formation keeps temperature above the freezing point. ! make_frazil is deliberately called at both the beginning and at ! the end of the diabatic processes. - if (ASSOCIATED(tv%T) .AND. ASSOCIATED(tv%frazil)) then + if (associated(tv%T) .AND. associated(tv%frazil)) then call enable_averaging(0.5*dt, Time_end, CS%diag) if(CS%frazil_tendency_diag) then do k=1,nz ; do j=js,je ; do i=is,ie @@ -1465,7 +1465,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G enddo ; enddo ; enddo endif - if (ASSOCIATED(fluxes%p_surf_full)) then + if (associated(fluxes%p_surf_full)) then call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) else call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) @@ -2412,7 +2412,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, endif endif CS%nsw = 0 - if (ASSOCIATED(CS%optics)) CS%nsw = CS%optics%nbands + if (associated(CS%optics)) CS%nsw = CS%optics%nbands ! Initialize the diagnostic grid storage call diag_grid_storage_init(CS%diag_grids_prev, G, diag) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index b6a1e94075..d7ea7007c6 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -561,10 +561,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & if (.not. associated(CS)) call MOM_error(FATAL, "energetic_PBL: "//& "Module must be initialized before it is used.") - if (.not. ASSOCIATED(tv%eqn_of_state)) call MOM_error(FATAL, & + if (.not. associated(tv%eqn_of_state)) call MOM_error(FATAL, & "energetic_PBL: Temperature, salinity and an equation of state "//& "must now be used.") - if (.NOT. ASSOCIATED(fluxes%ustar)) call MOM_error(FATAL, & + if (.NOT. associated(fluxes%ustar)) call MOM_error(FATAL, & "energetic_PBL: No surface TKE fluxes (ustar) defined in mixedlayer!") if (present(dT_expected) .or. present(dS_expected)) debug = .true. diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 3da47e51e6..1852e87c48 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -284,9 +284,9 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & if (.not.(present(Kd_Lay) .or. present(Kd_int))) call MOM_error(FATAL, & "MOM_entrain_diffusive: Either Kd_Lay or Kd_int must be present in call.") - if ((.not.CS%bulkmixedlayer .and. .not.ASSOCIATED(fluxes%buoy)) .and. & - (ASSOCIATED(fluxes%lprec) .or. ASSOCIATED(fluxes%evap) .or. & - ASSOCIATED(fluxes%sens) .or. ASSOCIATED(fluxes%sw))) then + if ((.not.CS%bulkmixedlayer .and. .not.associated(fluxes%buoy)) .and. & + (associated(fluxes%lprec) .or. associated(fluxes%evap) .or. & + associated(fluxes%sens) .or. associated(fluxes%sw))) then if (is_root_pe()) call MOM_error(NOTE, "Calculate_Entrainment: & &The code to handle evaporation and precipitation without & &a bulk mixed layer has not been implemented.") @@ -454,7 +454,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & maxF(i,1) = 0.0 htot(i) = h(i,j,1) - Angstrom enddo - if (ASSOCIATED(fluxes%buoy)) then ; do i=is,ie + if (associated(fluxes%buoy)) then ; do i=is,ie maxF(i,1) = (dt*fluxes%buoy(i,j)) / GV%g_prime(2) enddo ; endif endif diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 06e327b69e..bfad193803 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -171,7 +171,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS) H_neglect = GV%H_subroundoff p_ref(:) = tv%P_Ref - if (.not.ASSOCIATED(tv%T)) call MOM_error(FATAL, "MOM geothermal: "//& + if (.not.associated(tv%T)) call MOM_error(FATAL, "MOM geothermal: "//& "Geothermal heating can only be applied if T & S are state variables.") ! do i=is,ie ; do j=js,je diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index c1e8181224..502f05e3e1 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -624,9 +624,9 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) "Cannot use a single_exp opacity scheme with nbands!=1.") endif endif - if (.not.ASSOCIATED(optics%min_wavelength_band)) & + if (.not.associated(optics%min_wavelength_band)) & allocate(optics%min_wavelength_band(optics%nbands)) - if (.not.ASSOCIATED(optics%max_wavelength_band)) & + if (.not.associated(optics%max_wavelength_band)) & allocate(optics%max_wavelength_band(optics%nbands)) if (CS%opacity_scheme == MANIZZA_05) then @@ -648,9 +648,9 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) "The value to use for opacity over land. The default is \n"//& "10 m-1 - a value for muddy water.", units="m-1", default=10.0) - if (.not.ASSOCIATED(optics%opacity_band)) & + if (.not.associated(optics%opacity_band)) & allocate(optics%opacity_band(optics%nbands,isd:ied,jsd:jed,nz)) - if (.not.ASSOCIATED(optics%sw_pen_band)) & + if (.not.associated(optics%sw_pen_band)) & allocate(optics%sw_pen_band(optics%nbands,isd:ied,jsd:jed)) allocate(CS%id_opacity(optics%nbands)) ; CS%id_opacity(:) = -1 @@ -681,8 +681,8 @@ subroutine opacity_end(CS, optics) if (associated(CS)) deallocate(CS) if (present(optics)) then ; if (associated(optics)) then - if (ASSOCIATED(optics%opacity_band)) deallocate(optics%opacity_band) - if (ASSOCIATED(optics%sw_pen_band)) deallocate(optics%sw_pen_band) + if (associated(optics%opacity_band)) deallocate(optics%opacity_band) + if (associated(optics%sw_pen_band)) deallocate(optics%sw_pen_band) endif ; endif end subroutine opacity_end diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 950c3f5f34..b4b21d9e6b 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -277,7 +277,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) if (GV%nkml<1) return nkmb = GV%nk_rho_varies ; nkml = GV%nkml - if (.not.ASSOCIATED(tv%eqn_of_state)) call MOM_error(FATAL, & + if (.not.associated(tv%eqn_of_state)) call MOM_error(FATAL, & "MOM_regularize_layers: This module now requires the use of temperature and "//& "an equation of state.") diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index d41d85307e..6b1c219508 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1139,7 +1139,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ! to be relatively small and is discarded. do i=is,ie ustar_h = visc%ustar_BBL(i,j) - if (ASSOCIATED(fluxes%ustar_tidal)) & + if (associated(fluxes%ustar_tidal)) & ustar_h = ustar_h + fluxes%ustar_tidal(i,j) absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) @@ -1154,7 +1154,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & exp(-I2decay(i)*(GV%H_to_m*h(i,j,nz))) ) * & visc%TKE_BBL(i,j) - if (ASSOCIATED(fluxes%TKE_tidal)) & + if (associated(fluxes%TKE_tidal)) & TKE(i) = TKE(i) + fluxes%TKE_tidal(i,j) * I_Rho0 * & (CS%BBL_effic * exp(-I2decay(i)*(GV%H_to_m*h(i,j,nz)))) @@ -1354,7 +1354,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ustar2 = ustar**2 ! In add_drag_diffusivity(), fluxes%ustar_tidal is added in. This might be double counting ! since ustar_BBL should already include all contributions to u*? -AJA - if (ASSOCIATED(fluxes%ustar_tidal)) ustar = ustar + fluxes%ustar_tidal(i,j) + if (associated(fluxes%ustar_tidal)) ustar = ustar + fluxes%ustar_tidal(i,j) ! The maximum decay scale should be something of order 200 m. We use the smaller of u*/f and ! (IMax_decay)^-1 as the decay scale. If ustar = 0, this is land so this value doesn't matter. @@ -1367,7 +1367,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & TKE_column = cdrag_sqrt * visc%TKE_BBL(i,j) ! Add in tidal dissipation energy at the bottom, in m3 s-3. ! Note that TKE_tidal is in W m-2. - if (ASSOCIATED(fluxes%TKE_tidal)) TKE_column = TKE_column + fluxes%TKE_tidal(i,j) * I_Rho0 + if (associated(fluxes%TKE_tidal)) TKE_column = TKE_column + fluxes%TKE_tidal(i,j) * I_Rho0 TKE_column = CS%BBL_effic * TKE_column ! Only use a fraction of the mechanical dissipation for mixing. TKE_remaining = TKE_column diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 5569355ba0..4fc0c276df 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -243,7 +243,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & do j=G%jsc,G%jec do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo - if (ASSOCIATED(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq + if (associated(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq ADp%du_dt_visc(I,j,k) = u(I,j,k) enddo ; enddo ; endif @@ -314,11 +314,11 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & u(I,j,k) = u(I,j,k) + c1(I,k+1) * u(I,j,k+1) endif ; enddo ; enddo ! i and k loops - if (ASSOCIATED(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq + if (associated(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq ADp%du_dt_visc(I,j,k) = (u(I,j,k) - ADp%du_dt_visc(I,j,k))*Idt enddo ; enddo ; endif - if (ASSOCIATED(visc%taux_shelf)) then ; do I=Isq,Ieq + if (associated(visc%taux_shelf)) then ; do I=Isq,Ieq visc%taux_shelf(I,j) = -Rho0*CS%a1_shelf_u(I,j)*u(I,j,1) ! - u_shelf? enddo ; endif @@ -350,7 +350,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & do J=Jsq,Jeq do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0) ; enddo - if (ASSOCIATED(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie + if (associated(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie ADp%dv_dt_visc(i,J,k) = v(i,J,k) enddo ; enddo ; endif @@ -395,11 +395,11 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & v(i,J,k) = v(i,J,k) + c1(i,k+1) * v(i,J,k+1) endif ; enddo ; enddo ! i and k loops - if (ASSOCIATED(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie + if (associated(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie ADp%dv_dt_visc(i,J,k) = (v(i,J,k) - ADp%dv_dt_visc(i,J,k))*Idt enddo ; enddo ; endif - if (ASSOCIATED(visc%tauy_shelf)) then ; do i=is,ie + if (associated(visc%tauy_shelf)) then ; do i=is,ie visc%tauy_shelf(i,J) = -Rho0*CS%a1_shelf_v(i,J)*v(i,J,1) ! - v_shelf? enddo ; endif diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 36e73b9ee2..34f83ccba6 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -493,7 +493,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, ! g_tracer=>CS%g_tracer_list do - if(_ALLOCATED(g_tracer%trunoff)) then + if(_allocated(g_tracer%trunoff)) then call g_tracer_get_alias(g_tracer,g_tracer_name) call g_tracer_get_pointer(g_tracer,g_tracer_name,'stf', stf_array) call g_tracer_get_pointer(g_tracer,g_tracer_name,'trunoff',trunoff_array) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 7b421a7ca8..5fb99a448b 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -1933,7 +1933,7 @@ logical function ndiff_unit_tests_discontinuous(verbose) allocate(EOS) call EOS_manual_init(EOS, form_of_EOS = EOS_LINEAR, dRho_dT = -1., dRho_dS = 2.) ! Unit tests for refine_nondim_position - ALLOCATE(CS%ndiff_aux_CS) + allocate(CS%ndiff_aux_CS) call set_ndiff_aux_params(CS%ndiff_aux_CS, deg = 1, max_iter = 10, drho_tol = 0., xtol = 0., EOS = EOS) ! Tests using Newton's method ndiff_unit_tests_discontinuous = ndiff_unit_tests_discontinuous .or. (test_rnp(0.5,refine_nondim_position( & diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 7d00d06284..39c8385029 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -668,11 +668,11 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ ! This block makes sure that the fluxes control structure, which may not be used in the solo_driver, ! contains netMassIn and netMassOut which is necessary for the applyTracerBoundaryFluxesInOut routine if (do_ale) then - if (.not. ASSOCIATED(fluxes%netMassOut)) then + if (.not. associated(fluxes%netMassOut)) then allocate(fluxes%netMassOut(G%isd:G%ied,G%jsd:G%jed)) fluxes%netMassOut(:,:) = 0.0 endif - if (.not. ASSOCIATED(fluxes%netMassIn)) then + if (.not. associated(fluxes%netMassIn)) then allocate(fluxes%netMassIn(G%isd:G%ied,G%jsd:G%jed)) fluxes%netMassIn(:,:) = 0.0 endif diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index 02f44e44dd..e68ff0df9e 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -260,7 +260,7 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke ! If no freshwater fluxes, nothing needs to be done in this routine - if ( (.not. ASSOCIATED(fluxes%netMassIn)) .or. (.not. ASSOCIATED(fluxes%netMassOut)) ) return + if ( (.not. associated(fluxes%netMassIn)) .or. (.not. associated(fluxes%netMassOut)) ) return in_flux(:,:) = 0.0 ; out_flux(:,:) = 0.0 if(present(in_flux_optional)) then diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 50f81c8a94..7aa2943ff0 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -225,7 +225,7 @@ subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) ! MOM_diag_mediator, but is here so as to be completely transparent. real, pointer :: ptr(:,:) integer :: isd, ied, jsd, jed - if (.not.ASSOCIATED(ptr)) then + if (.not.associated(ptr)) then allocate(ptr(isd:ied,jsd:jed)) ptr(:,:) = 0.0 endif diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 12f2d6d8ff..ac83add05c 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -304,11 +304,11 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) " Make sure this is consistnet w/ WAVENUMBERS, STOKES_X, and \n"// & " STOKES_Y, there are no safety checks in the code.", & units='', default=1) - ALLOCATE ( CS%WaveNum_Cen(1:NumBands) ) ; CS%WaveNum_Cen(:)=0.0 - ALLOCATE ( CS%PrescribedSurfStkX(1:NumBands)) ; CS%PrescribedSurfStkX(:) = 0.0 - ALLOCATE ( CS%PrescribedSurfStkY(1:NumBands)) ; CS%PrescribedSurfStkY(:) = 0.0 - ALLOCATE ( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,1:NumBands)) ; CS%STKx0(:,:,:) = 0.0 - ALLOCATE ( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,1:NumBands)) ; CS%STKy0(:,:,:) = 0.0 + allocate( CS%WaveNum_Cen(1:NumBands) ) ; CS%WaveNum_Cen(:)=0.0 + allocate( CS%PrescribedSurfStkX(1:NumBands)) ; CS%PrescribedSurfStkX(:) = 0.0 + allocate( CS%PrescribedSurfStkY(1:NumBands)) ; CS%PrescribedSurfStkY(:) = 0.0 + allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,1:NumBands)) ; CS%STKx0(:,:,:) = 0.0 + allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,1:NumBands)) ; CS%STKy0(:,:,:) = 0.0 partitionmode=0 call get_param(param_file,mdl,"SURFBAND_WAVENUMBERS",CS%WaveNum_Cen, & "Central wavenumbers for surface Stokes drift bands.",units='rad/m', & @@ -352,17 +352,17 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) ! 2. Allocate and initialize ! Stokes drift ! Profiles - ALLOCATE (CS%Us_x(G%isdB:G%IedB,G%jsd:G%jed,G%ke)) ; CS%Us_x(:,:,:) = 0.0 - ALLOCATE (CS%Us_y(G%isd:G%Ied,G%jsdB:G%jedB,G%ke)) ; CS%Us_y(:,:,:) = 0.0 + allocate(CS%Us_x(G%isdB:G%IedB,G%jsd:G%jed,G%ke)) ; CS%Us_x(:,:,:) = 0.0 + allocate(CS%Us_y(G%isd:G%Ied,G%jsdB:G%jedB,G%ke)) ; CS%Us_y(:,:,:) = 0.0 ! Surface Values - ALLOCATE (CS%US0_x(G%isdB:G%iedB,G%jsd:G%jed)) ; CS%US0_x(:,:) = 0.0 - ALLOCATE (CS%US0_y(G%isd:G%ied,G%jsdB:G%jedB)) ; CS%US0_y(:,:) = 0.0 + allocate(CS%US0_x(G%isdB:G%iedB,G%jsd:G%jed)) ; CS%US0_x(:,:) = 0.0 + allocate(CS%US0_y(G%isd:G%ied,G%jsdB:G%jedB)) ; CS%US0_y(:,:) = 0.0 ! Langmuir number - ALLOCATE (CS%LangNum(G%isc:G%iec,G%jsc:G%jec)) ; CS%LangNum(:,:) = 0.0 + allocate(CS%LangNum(G%isc:G%iec,G%jsc:G%jec)) ; CS%LangNum(:,:) = 0.0 if (CS%StokesMixing) then ! Viscosity for Stokes drift - ALLOCATE (CS%KvS(G%isd:G%Ied,G%jsd:G%jed,G%ke)) ; CS%KvS(:,:,:) = 0.0 + allocate(CS%KvS(G%isd:G%Ied,G%jsd:G%jed,G%ke)) ; CS%KvS(:,:,:) = 0.0 endif ! @@ -721,7 +721,7 @@ subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) " in file "//trim(SurfBandFileName)//" in MOM_wave_interace.") endif ! Allocating size of wavenumber bins - ALLOCATE ( CS%WaveNum_Cen(1:id) ) ; CS%WaveNum_Cen(:)=0.0 + allocate( CS%WaveNum_Cen(1:id) ) ; CS%WaveNum_Cen(:)=0.0 elseif (rcode_fr.eq.0) then ! frequencies found: PartitionMode=1 @@ -743,15 +743,15 @@ subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) " in file "//trim(SurfBandFileName)//" in MOM_wave_interace.") endif ! Allocating size of frequency bins - ALLOCATE ( CS%Freq_Cen(1:id) ) ; CS%Freq_Cen(:)=0.0 - ALLOCATE ( CS%WaveNum_Cen(1:id) ) ; CS%WaveNum_Cen(:)=0.0 + allocate( CS%Freq_Cen(1:id) ) ; CS%Freq_Cen(:)=0.0 + allocate( CS%WaveNum_Cen(1:id) ) ; CS%WaveNum_Cen(:)=0.0 endif ! Allocating size of wavenumber bins - ALLOCATE ( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,1:id)) ; CS%STKx0(:,:,:) = 0.0 - ALLOCATE ( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,1:id)) ; CS%STKy0(:,:,:) = 0.0 + allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,1:id)) ; CS%STKx0(:,:,:) = 0.0 + allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,1:id)) ; CS%STKy0(:,:,:) = 0.0 ! Reading wavenumber bins/Frequencies @@ -1280,18 +1280,18 @@ subroutine Waves_end(CS) !/ type(wave_parameters_CS), pointer :: CS !< Control structure !/ - if (allocated(CS%WaveNum_Cen)) then; DEALLOCATE( CS%WaveNum_Cen ); endif - if (allocated(CS%Freq_Cen)) DEALLOCATE( CS%Freq_Cen ) - if (allocated(CS%Us_x)) DEALLOCATE( CS%Us_x ) - if (allocated(CS%Us_y)) DEALLOCATE( CS%Us_y ) - if (allocated(CS%LangNum)) DEALLOCATE( CS%LangNum ) - if (allocated(CS%STKx0)) DEALLOCATE( CS%STKx0 ) - if (allocated(CS%STKy0)) DEALLOCATE( CS%STKy0 ) - if (allocated(CS%KvS)) DEALLOCATE( CS%KvS ) - if (allocated(CS%Us0_y)) DEALLOCATE( CS%Us0_y ) - if (allocated(CS%Us0_x)) DEALLOCATE( CS%Us0_x ) + if (allocated(CS%WaveNum_Cen)) then; deallocate( CS%WaveNum_Cen ); endif + if (allocated(CS%Freq_Cen)) deallocate( CS%Freq_Cen ) + if (allocated(CS%Us_x)) deallocate( CS%Us_x ) + if (allocated(CS%Us_y)) deallocate( CS%Us_y ) + if (allocated(CS%LangNum)) deallocate( CS%LangNum ) + if (allocated(CS%STKx0)) deallocate( CS%STKx0 ) + if (allocated(CS%STKy0)) deallocate( CS%STKy0 ) + if (allocated(CS%KvS)) deallocate( CS%KvS ) + if (allocated(CS%Us0_y)) deallocate( CS%Us0_y ) + if (allocated(CS%Us0_x)) deallocate( CS%Us0_x ) !/ - DEALLOCATE( CS ) + deallocate( CS ) !/ return end subroutine Waves_end diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index f49202f919..80376e67c9 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -244,7 +244,7 @@ subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) ! MOM_diag_mediator, but is here so as to be completely transparent. real, pointer :: ptr(:,:) integer :: isd, ied, jsd, jed - if (.not.ASSOCIATED(ptr)) then + if (.not.associated(ptr)) then allocate(ptr(isd:ied,jsd:jed)) ptr(:,:) = 0.0 endif From b0745c89306ee53335958382b86f02ef0cac5f88 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 26 Apr 2018 18:20:41 -0400 Subject: [PATCH 0129/1072] Doxygenized comments in MOM_PressureForce.F90 --- src/core/MOM_PressureForce.F90 | 32 ++++++++++++++++++++------------ 1 file changed, 20 insertions(+), 12 deletions(-) diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index 7f67757d3e..62bd140255 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -44,18 +44,26 @@ module MOM_PressureForce !> A thin layer between the model and the Boussinesq and non-Boussinesq pressure force routines. subroutine PressureForce(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, pbce, eta) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv - type(PressureForce_CS), pointer :: CS - type(ALE_CS), pointer :: ALE_CSp - real, dimension(:,:), optional, pointer :: p_atm - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce - real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta - + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: PFu !< Zonal pressure force acceleration (m/s2) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(out) :: PFv !< Meridional pressure force acceleration (m/s2) + type(PressureForce_CS), pointer :: CS !< Pressure force control structure + type(ALE_CS), pointer :: ALE_CSp !< ALE control structure + real, dimension(:,:), & + optional, pointer :: p_atm !< The pressure at the ice-ocean or + !! atmosphere-ocean interface in Pa. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + optional, intent(out) :: pbce !< The baroclinic pressure anomaly in each layer + !! due to eta anomalies, in m2 s-2 H-1. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(out) :: eta !< The bottom mass used to calculate PFu and PFv, + !! in H, with any tidal contributions. if (CS%Analytic_FV_PGF .and. CS%blocked_AFV) then if (GV%Boussinesq) then From 9781d53e198ed95069d98065deb689da77cd4121 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 26 Apr 2018 18:20:56 -0400 Subject: [PATCH 0130/1072] Doxygenized comments in MOM_barotropic.F90 --- src/core/MOM_barotropic.F90 | 88 +++++++++++++++++++++---------------- 1 file changed, 50 insertions(+), 38 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 5b5ab92869..a21fbf39f1 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -2304,10 +2304,10 @@ subroutine set_dtbt(G, GV, CS, eta, pbce, BT_cont, gtot_est, SSH_add) ! (See Hallberg, J Comp Phys 1997 for a discussion.) real, dimension(SZIBS_(G),SZJ_(G)) :: & Datu ! Basin depth at u-velocity grid points times the y-grid - ! spacing, in m2. + ! spacing, in H m. real, dimension(SZI_(G),SZJBS_(G)) :: & Datv ! Basin depth at v-velocity grid points times the x-grid - ! spacing, in m2. + ! spacing, in H m. real :: det_de ! The partial derivative due to self-attraction and loading ! of the reference geopotential with the sea surface height. ! This is typically ~0.09 or less. @@ -2421,16 +2421,20 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, !! in determining the transport. logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate !! transports. - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points. - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points, in H m. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points, in H m. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used !! for a dynamic estimate of the face areas at !! u-points. type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: BTCL_v !< Structure of information used !! for a dynamic estimate of the face areas at !! v-points. - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: uhbt0 - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vhbt0 + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: uhbt0 !< A correction to the zonal transport so that + !! the barotropic functions agree with the sum + !! of the layer transpotts, in H m2 s-1. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vhbt0 !< A correction to the meridional transport so that + !! the barotropic functions agree with the sum + !! of the layer transpotts, in H m2 s-1. ! Local variables real :: vel_prev ! The previous velocity in m s-1. @@ -2687,8 +2691,8 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co integer, intent(in) :: halo !< The extra halo size to use here. logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate !! transports. - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points. - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at u points. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points, in H m. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points, in H m. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used !! for a dynamic estimate of the face areas at !! u-points. @@ -3148,7 +3152,10 @@ end subroutine btcalc !> The function find_uhbt determines the zonal transport for a given velocity. function find_uhbt(u, BTC) result(uhbt) real, intent(in) :: u !< The local zonal velocity, in m s-1 - type(local_BT_cont_u_type), intent(in) :: BTC + type(local_BT_cont_u_type), intent(in) :: BTC !< A structure containing various fields that + !! allow the barotropic transports to be calculated consistently + !! with the layers' continuity equations. + real :: uhbt !< The result if (u == 0.0) then @@ -3259,7 +3266,9 @@ end function uhbt_to_ubt !> The function find_vhbt determines the meridional transport for a given velocity. function find_vhbt(v, BTC) result(vhbt) real, intent(in) :: v !< The local meridional velocity, in m s-1 - type(local_BT_cont_v_type), intent(in) :: BTC + type(local_BT_cont_v_type), intent(in) :: BTC !< A structure containing various fields that + !! allow the barotropic transports to be calculated consistently + !! with the layers' continuity equations. real :: vhbt !< The result if (v == 0.0) then @@ -3592,15 +3601,18 @@ end subroutine adjust_local_BT_cont_types !> This subroutine uses the BTCL types to find typical or maximum face !! areas, which can then be used for finding wave speeds, etc. subroutine BT_cont_to_face_areas(BT_cont, Datu, Datv, G, MS, halo, maximize) - type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the - !! barotropic solver. - type(memory_size_type), intent(in) :: MS !< A type that describes the memory - !! sizes of the argument arrays. - real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), intent(out) :: Datu - real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), intent(out) :: Datv - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - integer, optional, intent(in) :: halo !< The extra halo size to use here. - logical, optional, intent(in) :: maximize + type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the + !! barotropic solver. + type(memory_size_type), intent(in) :: MS !< A type that describes the memory + !! sizes of the argument arrays. + real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), & + intent(out) :: Datu !< The effective zonal face area, in H m. + real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), & + intent(out) :: Datv !< The effective meridional face area, in H m. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + integer, optional, intent(in) :: halo !< The extra halo size to use here. + logical, optional, intent(in) :: maximize !< If present and true, find the + !! maximum face area for any velocity. ! Local variables logical :: find_max @@ -3629,8 +3641,9 @@ subroutine BT_cont_to_face_areas(BT_cont, Datu, Datv, G, MS, halo, maximize) end subroutine BT_cont_to_face_areas +!> Swap the values of two real variables subroutine swap(a,b) - real, intent(inout) :: a, b + real, intent(inout) :: a, b !< The varaibles to be swapped. real :: tmp tmp = a ; a = b ; b = tmp end subroutine swap @@ -3638,24 +3651,22 @@ end subroutine swap !> This subroutine determines the open face areas of cells for calculating !! the barotropic transport. subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) - type(memory_size_type), intent(in) :: MS + type(memory_size_type), intent(in) :: MS ! (in) MS - A type that describes the memory sizes of the argument arrays. - real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), intent(out) :: Datu !< The open zonal face area, - !! in H m (m2 or kg m-1). - real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), intent(out) :: Datv !< The open meridional face area, - !! in H m (m2 or kg m-1). - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(barotropic_CS), pointer :: CS !< The control structure returned by a previous - !! call to barotropic_init. - real, dimension(MS%isdw:MS%iedw,MS%jsdw:MS%jedw), optional, intent(in) :: eta !< The barotropic free surface - !! height anomaly or column mass - !! anomaly, in H (m or kg m-2). - integer, optional, intent(in) :: halo !< The halo size to use, default = 1. - real, optional, intent(in) :: add_max !< A value to add to the maximum - !! depth (used to overestimate the - !! external wave speed) in m. - + real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), & + intent(out) :: Datu !< The open zonal face area, in H m (m2 or kg m-1). + real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), & + intent(out) :: Datv !< The open meridional face area, in H m (m2 or kg m-1). + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(barotropic_CS), pointer :: CS !< The control structure returned by a previous + !! call to barotropic_init. + real, dimension(MS%isdw:MS%iedw,MS%jsdw:MS%jedw), & + optional, intent(in) :: eta !< The barotropic free surface height anomaly + !! or column mass anomaly, in H (m or kg m-2). + integer, optional, intent(in) :: halo !< The halo size to use, default = 1. + real, optional, intent(in) :: add_max !< A value to add to the maximum depth (used + !! to overestimate the external wave speed) in m. ! Local variables real :: H1, H2 ! Temporary total thicknesses, in m or kg m-2. @@ -3832,7 +3843,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & #include "version_variable.h" ! Local variables character(len=40) :: mdl = "MOM_barotropic" ! This module's name. - real :: Datu(SZIBS_(G),SZJ_(G)), Datv(SZI_(G),SZJBS_(G)) + real :: Datu(SZIBS_(G),SZJ_(G)) ! Zonal open face area in H m. + real :: Datv(SZI_(G),SZJBS_(G)) ! Meridional open face area in H m. real :: gtot_estimate ! Summing GV%g_prime gives an upper-bound estimate for pbce. real :: SSH_extra ! An estimate of how much higher SSH might get, for use ! in calculating the safe external wave speed. From ea1e4fe2bc067b12be618b79cfa76d363e8a3241 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 26 Apr 2018 18:22:49 -0400 Subject: [PATCH 0131/1072] (*)Corrected array syntax in explicit loops Corrected two assignment that dangerously use array syntax inside of explicit do-loops, which would lead to an order NI^2*NJ^2 operation that should have been an NI*NJ operation unless the compiler detects and avoids it. Answers are unchanged in the MOM6_examples test cases, but might be corrected in other cases. --- src/user/MOM_wave_interface.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index ac83add05c..90d44f7c7c 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -612,7 +612,7 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) Bottom = Bottom - GV%H_to_m * (h(ii,jj,kk)+h(ii,jjm1,kk))/2. call DHH85_mid(CS,GV,ustar(ii,jj),Midpoint,US) ! Putting into x-direction for now - CS%US_x(:,:,kk) = US + CS%US_x(ii,jj,kk) = US enddo enddo enddo @@ -626,7 +626,7 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) Bottom = Bottom - GV%H_to_m * (h(ii,jj,kk)+h(ii,jjm1,kk))/2. call DHH85_mid(CS,GV,ustar(ii,jj),Midpoint,US) ! Putting into x-direction for now - CS%US_y(:,:,kk) = 0.0 + CS%US_y(ii,jj,kk) = 0.0 !### Note that =0 should be =US - RWH enddo enddo enddo From 078d7a31562f8afea1d95e0b20039c9b67e43a5b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 26 Apr 2018 18:24:18 -0400 Subject: [PATCH 0132/1072] (*?)Moved Update_Stokes_Drift to top of step_MOM Moved the calls to Update_Stokes_Drift outside of the timestepping loop and used ustar from the appropriate forcing structure. Answers are unchanged in the MOM6_examples test cases. --- src/core/MOM.F90 | 56 ++++++++++++++++++++++++++---------------------- 1 file changed, 30 insertions(+), 26 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index fe6f7073e6..f3b89e0c2e 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -515,6 +515,8 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & dt = time_interval / real(n_max) dt_therm = dt ; ntstep = 1 if (associated(fluxes%p_surf)) p_surf => fluxes%p_surf + + if (CS%UseWaves) call pass_var(fluxes%ustar, G%Domain, clock=id_clock_pass) endif if (therm_reset) then @@ -553,6 +555,16 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & else CS%p_surf_end => forces%p_surf endif + + if (CS%UseWaves) then + ! Update wave information, which is presently kept static over each call to step_mom + call enable_averaging(time_interval, Time_start + set_time(int(floor(time_interval+0.5))), CS%diag) + call Update_Stokes_Drift(G, GV, Waves, h, forces%ustar) + call disable_averaging(CS%diag) + endif + else ! not do_dyn. + if (CS%UseWaves) & ! Diagnostics are not enabled in this call. + call Update_Stokes_Drift(G, GV, Waves, h, fluxes%ustar) endif if (CS%debug) then @@ -572,16 +584,6 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ! Set the local time to the end of the time step. Time_local = Time_start + set_time(int(floor(rel_time+0.5))) - !### Update_Stokes_Drift must be behind a do_dyn or a do_thermo test. - if (CS%UseWaves) then - ! Update wave information, which is presently kept static over each call to step_mom - !bgr 3/15/18: Need to enable_averaging here to enable output of Stokes drift from the - ! update_stokes_drift routine. Other options? - call enable_averaging(dt, Time_local, CS%diag) - call Update_Stokes_Drift(G, GV, Waves, h, forces%ustar) - call disable_averaging(CS%diag) - endif - if (showCallTree) call callTree_enter("DT cycles (step_MOM) n=",n) !=========================================================================== @@ -603,13 +605,15 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & dtdia = dt*min(ntstep,n_max-(n-1)) endif - ! If necessary, temporarily reset CS%Time to the center of the period covered - ! by the call to step_MOM_thermo, noting that they begin at the same time. - if (dtdia > dt) CS%Time = CS%Time + set_time(int(floor(0.5*(dtdia-dt) + 0.5))) - - ! The end-time of the diagnostic interval needs to be set ahead if there - ! are multiple dynamic time steps worth of thermodynamics applied here. - end_time_thermo = Time_local + set_time(int(floor(dtdia-dt+0.5))) + end_time_thermo = Time_local + if (dtdia > dt) then + ! If necessary, temporarily reset CS%Time to the center of the period covered + ! by the call to step_MOM_thermo, noting that they begin at the same time. + CS%Time = CS%Time + set_time(int(floor(0.5*(dtdia-dt) + 0.5))) + ! The end-time of the diagnostic interval needs to be set ahead if there + ! are multiple dynamic time steps worth of thermodynamics applied here. + end_time_thermo = Time_local + set_time(int(floor(dtdia-dt+0.5))) + endif ! Apply diabatic forcing, do mixing, and regrid. call step_MOM_thermo(CS, G, GV, u, v, h, CS%tv, fluxes, dtdia, & @@ -843,7 +847,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & !! bottom boundary layer properties will apply, !! in s, or zero not to update the properties. type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM - type(time_type), intent(in) :: Time_local !< Starting time of a segment, as a time type + type(time_type), intent(in) :: Time_local !< End time of a segment, as a time type type(wave_parameters_CS), & optional, pointer :: Waves !< Container for wave related parameters; the !! fields in Waves are intent(in) here. @@ -877,7 +881,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if ((CS%t_dyn_rel_adv == 0.0) .and. CS%thickness_diffuse .and. CS%thickness_diffuse_first) then - call enable_averaging(dt_thermo,Time_local+set_time(int(floor(dt_thermo-dt+0.5))), CS%diag) + call enable_averaging(dt_thermo, Time_local+set_time(int(floor(dt_thermo-dt+0.5))), CS%diag) call cpu_clock_begin(id_clock_thick_diff) if (associated(CS%VarMix)) & call calc_slope_functions(h, CS%tv, dt, G, GV, CS%VarMix) @@ -896,7 +900,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & ! The bottom boundary layer properties need to be recalculated. if (bbl_time_int > 0.0) then call enable_averaging(bbl_time_int, & - Time_local+set_time(int(bbl_time_int-dt+0.5)), CS%diag) + Time_local + set_time(int(bbl_time_int-dt+0.5)), CS%diag) ! Calculate the BBL properties and store them inside visc (u,h). call cpu_clock_begin(id_clock_BBL_visc) call set_viscous_BBL(CS%u, CS%v, CS%h, CS%tv, CS%visc, G, GV, & @@ -913,7 +917,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & calc_dtbt = .false. if (CS%dtbt_reset_period == 0.0) calc_dtbt = .true. if (CS%dtbt_reset_period > 0.0) then - if (Time_local >= CS%dtbt_reset_time) then + if (Time_local >= CS%dtbt_reset_time) then !### Change >= to > here. calc_dtbt = .true. CS%dtbt_reset_time = CS%dtbt_reset_time + CS%dtbt_reset_interval endif @@ -1348,7 +1352,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS ! Perform offline diffusion if requested if (.not. skip_diffusion) then if (associated(CS%VarMix)) then - call pass_var(CS%h,G%Domain) + call pass_var(CS%h, G%Domain) call calc_resoln_function(CS%h, CS%tv, G, GV, CS%VarMix) call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, CS%VarMix) endif @@ -1373,7 +1377,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS ! Perform offline diffusion if requested if (.not. skip_diffusion) then if (associated(CS%VarMix)) then - call pass_var(CS%h,G%Domain) + call pass_var(CS%h, G%Domain) call calc_resoln_function(CS%h, CS%tv, G, GV, CS%VarMix) call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, CS%VarMix) endif @@ -1429,9 +1433,9 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call extract_surface_state(CS, sfc_state) call disable_averaging(CS%diag) - call pass_var(CS%tv%T,G%Domain) - call pass_var(CS%tv%S,G%Domain) - call pass_var(CS%h,G%Domain) + call pass_var(CS%tv%T, G%Domain) + call pass_var(CS%tv%S, G%Domain) + call pass_var(CS%h, G%Domain) fluxes%fluxes_used = .true. From c04f455a153947dd4a9a14448e41e3293ee9810e Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 26 Apr 2018 17:03:16 -0600 Subject: [PATCH 0133/1072] add diagnostics for schmittner --- .../vertical/MOM_tidal_mixing.F90 | 74 ++++++++++++++----- 1 file changed, 54 insertions(+), 20 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index ae958a02ed..c0dd6e1796 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -39,18 +39,19 @@ module MOM_tidal_mixing type, public :: tidal_mixing_diags private real, pointer, dimension(:,:,:) :: & - Kd_itidal => NULL(),& ! internal tide diffusivity at interfaces (m2/s) - Fl_itidal => NULL(),& ! vertical flux of tidal turbulent dissipation (m3/s3) - Kd_lowmode => NULL(),& ! internal tide diffusivity at interfaces - ! due to propagating low modes (m2/s) (BDM) - Fl_lowmode => NULL(),& ! vertical flux of tidal turbulent dissipation - ! due to propagating low modes (m3/s3) (BDM) - Kd_Niku => NULL(),& ! lee-wave diffusivity at interfaces (m2/s) - Kd_Niku_work => NULL(),& ! layer integrated work by lee-wave driven mixing (W/m2) - Kd_Itidal_Work => NULL(),& ! layer integrated work by int tide driven mixing (W/m2) - Kd_Lowmode_Work => NULL(),& ! layer integrated work by low mode driven mixing (W/m2) BDM - N2_int => NULL(),& - vert_dep_3d => NULL() + Kd_itidal => NULL(),& ! internal tide diffusivity at interfaces (m2/s) + Fl_itidal => NULL(),& ! vertical flux of tidal turbulent dissipation (m3/s3) + Kd_lowmode => NULL(),& ! internal tide diffusivity at interfaces + ! due to propagating low modes (m2/s) (BDM) + Fl_lowmode => NULL(),& ! vertical flux of tidal turbulent dissipation + ! due to propagating low modes (m3/s3) (BDM) + Kd_Niku => NULL(),& ! lee-wave diffusivity at interfaces (m2/s) + Kd_Niku_work => NULL(),& ! layer integrated work by lee-wave driven mixing (W/m2) + Kd_Itidal_Work => NULL(),& ! layer integrated work by int tide driven mixing (W/m2) + Kd_Lowmode_Work => NULL(),& ! layer integrated work by low mode driven mixing (W/m2) BDM + N2_int => NULL(),& + vert_dep_3d => NULL(),& + Schmittner_coeff_3d => NULL() real, pointer, dimension(:,:) :: & TKE_itidal_used => NULL(),& ! internal tide TKE input at ocean bottom (W/m2) @@ -177,6 +178,7 @@ module MOM_tidal_mixing integer :: id_Polzin_decay_scale_scaled = -1 integer :: id_N2_int = -1 integer :: id_Simmons_coeff = -1 + integer :: id_Schmittner_coeff = -1 integer :: id_vert_dep = -1 end type tidal_mixing_cs @@ -501,11 +503,6 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, "The path to the file containing tidal energy \n"//& "dissipation. Used with CVMix tidal mixing schemes.", & fail_if_missing=.true.) - tidal_energy_file = trim(CS%inputdir) // trim(tidal_energy_file) - call get_param(param_file, mdl, "TIDAL_ENERGY_TYPE",tidal_energy_type, & - "The type of input tidal energy flux dataset.",& - fail_if_missing=.true.) - ! TODO: list all available tidal energy types here call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, default=0.001, & do_not_log=.True.) call get_param(param_file, mdl, "PRANDTL_TIDAL", prandtl_tidal, & @@ -515,11 +512,22 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, do_not_log=.true.) call cvmix_put(CS%cvmix_glb_params,'Prandtl',prandtl_tidal) + tidal_energy_file = trim(CS%inputdir) // trim(tidal_energy_file) + call get_param(param_file, mdl, "TIDAL_ENERGY_TYPE",tidal_energy_type, & + "The type of input tidal energy flux dataset. Valid values are"//& + "\t Jayne\n"//& + "\t ER03 \n",& + fail_if_missing=.true.) + ! Check whether tidal energy input format and CVMix tidal mixing scheme are consistent + if ( .not. ( & + (uppercase(tidal_energy_type(1:4)).eq.'JAYN' .and. CS%cvmix_tidal_scheme.eq.SIMMONS).or. & + (uppercase(tidal_energy_type(1:4)).eq.'ER03' .and. CS%cvmix_tidal_scheme.eq.SCHMITTNER) ) )then + call MOM_error(FATAL, "tidal_mixing_init: Tidal energy file type ("//& + trim(tidal_energy_type)//") is incompatible with CVMix tidal "//& + " mixing scheme: "//trim(cvmix_tidal_scheme_str) ) + endif cvmix_tidal_scheme_str = lowercase(cvmix_tidal_scheme_str) - - ! TODO: check parameter consistency. (see POP::tidal_mixing.F90::tidal_check) - ! Set up CVMix call cvmix_init_tidal(CVmix_tidal_params_user = CS%cvmix_tidal_params, & mix_scheme = cvmix_tidal_scheme_str, & @@ -549,6 +557,8 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, ! TODO: add units CS%id_Simmons_coeff = register_diag_field('ocean_model','Simmons_coeff',diag%axesT1,Time, & 'time-invariant portion of the tidal mixing coefficient using the Simmons', '') + CS%id_Schmittner_coeff = register_diag_field('ocean_model','Schmittner_coeff',diag%axesTi,Time, & + 'time-invariant portion of the tidal mixing coefficient using the Schmittner', '') CS%id_vert_dep = register_diag_field('ocean_model','vert_dep',diag%axesTi,Time, & 'vertical deposition function needed for Simmons et al tidal mixing', '') @@ -810,6 +820,25 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) CVmix_params = CS%cvmix_glb_params, & CVmix_tidal_params_user = CS%cvmix_tidal_params) + do k=1,G%ke + Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_tidal(k) + Kd_tidal(k+1) ) + !TODO: Kv(i,j,k) = ???????????? + enddo + + ! diagnostics + ! diagnostics + if (associated(dd%Kd_itidal)) then + dd%Kd_itidal(i,j,:) = Kd_tidal(:) + endif + if (associated(dd%N2_int)) then + dd%N2_int(i,j,:) = N2_int(i,:) + endif + if (associated(dd%Schmittner_coeff_3d)) then + dd%Schmittner_coeff_3d(i,j,:) = Schmittner_coeff(:) + endif + if (associated(dd%vert_dep_3d)) then + dd%vert_dep_3d(i,j,:) = vert_dep(:) + endif enddo ! i=is,ie deallocate(exp_hab_zetar) @@ -1288,6 +1317,9 @@ subroutine setup_tidal_diagnostics(G,CS) if (CS%id_vert_dep > 0) then allocate(dd%vert_dep_3d(isd:ied,jsd:jed,nz+1)) ; dd%vert_dep_3d(:,:,:) = 0.0 endif + if (CS%id_Schmittner_coeff > 0) then + allocate(dd%Schmittner_coeff_3d(isd:ied,jsd:jed,nz)) ; dd%Schmittner_coeff_3d(:,:,:) = 0.0 + endif end subroutine setup_tidal_diagnostics subroutine post_tidal_diagnostics(G,GV,h,CS) @@ -1322,6 +1354,7 @@ subroutine post_tidal_diagnostics(G,GV,h,CS) if (CS%id_N2_int> 0) call post_data(CS%id_N2_int, dd%N2_int, CS%diag) if (CS%id_vert_dep> 0) call post_data(CS%id_vert_dep, dd%vert_dep_3d, CS%diag) if (CS%id_Simmons_coeff> 0) call post_data(CS%id_Simmons_coeff, dd%Simmons_coeff_2d, CS%diag) + if (CS%id_Schmittner_coeff> 0) call post_data(CS%id_Schmittner_coeff, dd%Schmittner_coeff_3d, CS%diag) if (CS%id_Kd_Itidal_Work > 0) & call post_data(CS%id_Kd_Itidal_Work, dd%Kd_Itidal_Work, CS%diag) @@ -1373,6 +1406,7 @@ subroutine post_tidal_diagnostics(G,GV,h,CS) if (associated(dd%N2_int)) deallocate(dd%N2_int) if (associated(dd%vert_dep_3d)) deallocate(dd%vert_dep_3d) if (associated(dd%Simmons_coeff_2d)) deallocate(dd%Simmons_coeff_2d) + if (associated(dd%Schmittner_coeff_3d)) deallocate(dd%Schmittner_coeff_3d) end subroutine post_tidal_diagnostics From 49a8a482d28571a653c1adb83b1dab81a41522d0 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Thu, 26 Apr 2018 21:50:45 -0800 Subject: [PATCH 0134/1072] Start of oblique tweaks. --- src/core/MOM_open_boundary.F90 | 139 +++++++++++++++++---------------- 1 file changed, 72 insertions(+), 67 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 35b442c816..b08be83b15 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -143,6 +143,8 @@ module MOM_open_boundary !! segment (m s-1) real, pointer, dimension(:,:,:) :: rx_normal=>NULL() !< The rx_old_u value for radiation coeff !! for normal velocity + real, pointer, dimension(:,:,:) :: ry_normal=>NULL() !< The tangential value for radiation coeff + !! for normal velocity real, pointer, dimension(:,:,:) :: nudged_normal_vel=>NULL() !< The layer velocity normal to the OB segment !! that values should be nudged towards (m s-1). real, pointer, dimension(:,:,:) :: nudged_tangential_vel=>NULL() !< The layer velocity tangential to the OB segment @@ -1411,7 +1413,24 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do k=1,G%ke J=segment%HI%JsdB do i=segment%HI%isd,segment%HI%ied - segment%rx_normal(i,J,k) = OBC%ry_normal(i,J,k) + segment%ry_normal(i,J,k) = OBC%ry_normal(i,J,k) + enddo + enddo + endif + if (segment%is_E_or_W .and. segment%oblique) then + do k=1,G%ke + I=segment%HI%IsdB + do j=segment%HI%jsd,segment%HI%jed + segment%rx_normal(I,j,k) = OBC%rx_normal(I,j,k) + segment%ry_normal(I,j,k) = OBC%ry_normal(I,j,k) + enddo + enddo + elseif (segment%is_N_or_S .and. segment%oblique) then + do k=1,G%ke + J=segment%HI%JsdB + do i=segment%HI%isd,segment%HI%ied + segment%rx_normal(i,J,k) = OBC%rx_normal(i,J,k) + segment%ry_normal(i,J,k) = OBC%ry_normal(i,J,k) enddo enddo endif @@ -1444,15 +1463,15 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) elseif (segment%oblique) then dhdt = u_old(I-1,j,k)-u_new(I-1,j,k) !old-new dhdx = u_new(I-1,j,k)-u_new(I-2,j,k) !in new time backward sasha for I-1 - if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then - dhdy = segment%grad_normal(J-1,1,k) - elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then - dhdy = 0.0 - else - dhdy = segment%grad_normal(J,1,k) - endif + if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then + ry_new = min(segment%grad_normal(J-1,1,k), rx_max) + elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then + ry_new = 0.0 + else + ry_new = min(segment%grad_normal(J,1,k), rx_max) + endif if (dhdt*dhdx < 0.0) dhdt = 0.0 - Cx = min(dhdt*dhdx,rx_max) ! default to normal radiation + Cx = dhdt*dhdx cff = max(dhdx*dhdx + dhdy*dhdy, eps) Cy = min(cff,max(dhdt*dhdy,-cff)) segment%normal_vel(I,j,k) = ((cff*u_new(I,j,k) + Cx*u_new(I-1,j,k)) - & @@ -1494,23 +1513,17 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) elseif (segment%oblique) then dhdt = u_old(I+1,j,k)-u_new(I+1,j,k) !old-new dhdx = u_new(I+1,j,k)-u_new(I+2,j,k) !in new time forward sasha for I+1 -! if (segment%oblique) then - if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then - dhdy = segment%grad_normal(J-1,1,k) - elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then - dhdy = 0.0 - else - dhdy = segment%grad_normal(J,1,k) - endif -! endif + if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then + dhdy = segment%grad_normal(J-1,1,k) + elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then + dhdy = 0.0 + else + dhdy = segment%grad_normal(J,1,k) + endif if (dhdt*dhdx < 0.0) dhdt = 0.0 - Cx = min(dhdt*dhdx,rx_max) ! default to normal flow only -! Cy = 0. - cff = max(dhdx*dhdx, eps) -! if (segment%oblique) then - cff = max(dhdx*dhdx + dhdy*dhdy, eps) - Cy = min(cff,max(dhdt*dhdy,-cff)) -! endif + Cx = dhdt*dhdx + cff = max(dhdx*dhdx + dhdy*dhdy, eps) + Cy = min(cff,max(dhdt*dhdy,-cff)) segment%normal_vel(I,j,k) = ((cff*u_new(I,j,k) + Cx*u_new(I+1,j,k)) - & (max(Cy,0.0)*segment%grad_normal(J-1,2,k) + min(Cy,0.0)*segment%grad_normal(J,2,k))) / (cff + Cx) elseif (segment%gradient) then @@ -1538,35 +1551,30 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) dhdy = v_new(i,J-1,k)-v_new(i,J-2,k) !in new time backward sasha for J-1 ry_new = 0.0 if (dhdt*dhdy > 0.0) ry_new = min( (dhdt/dhdy), ry_max) - ry_avg = (1.0-gamma_v)*segment%rx_normal(I,j,k) + gamma_v*ry_new - segment%rx_normal(i,J,k) = ry_avg + ry_avg = (1.0-gamma_v)*segment%ry_normal(I,j,k) + gamma_v*ry_new + segment%ry_normal(i,J,k) = ry_avg ! The new boundary value is interpolated between future interior ! value, v_new(J-1) and past boundary value but with barotropic ! accelerations, v_new(J). segment%normal_vel(i,J,k) = (v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) / (1.0+ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability - OBC%ry_normal(i,J,k) = segment%rx_normal(i,J,k) + OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) elseif (segment%oblique) then dhdt = v_old(i,J-1,k)-v_new(i,J-1,k) !old-new dhdy = v_new(i,J-1,k)-v_new(i,J-2,k) !in new time backward sasha for J-1 -! if (segment%oblique) then - if (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) > 0.0) then - dhdx = segment%grad_normal(I-1,1,k) - elseif (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) == 0.0) then - dhdx = 0.0 - else - dhdx = segment%grad_normal(I,1,k) - endif -! endif + segment%ry_normal(i,J,k) = ry_avg + if (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) > 0.0) then + dhdx = segment%grad_normal(I-1,1,k) + elseif (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) == 0.0) then + dhdx = 0.0 + else + dhdx = segment%grad_normal(I,1,k) + endif if (dhdt*dhdy < 0.0) dhdt = 0.0 - Cy = min(dhdt*dhdy,rx_max) ! default to normal flow only -! Cx = 0 - cff = max(dhdy*dhdy, eps) -! if (segment%oblique) then - cff = max(dhdx*dhdx + dhdy*dhdy, eps) - Cx = min(cff,max(dhdt*dhdx,-cff)) -! endif + Cy = dhdt*dhdy + cff = max(dhdx*dhdx + dhdy*dhdy, eps) + Cx = min(cff,max(dhdt*dhdx,-cff)) segment%normal_vel(i,J,k) = ((cff*v_new(i,J,k) + Cy*v_new(i,J-1,k)) - & (max(Cx,0.0)*segment%grad_normal(I-1,2,k) + min(Cx,0.0)*segment%grad_normal(I,2,k))) / (cff + Cy) elseif (segment%gradient) then @@ -1595,35 +1603,29 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) dhdy = v_new(i,J+1,k)-v_new(i,J+2,k) !in new time backward sasha for J-1 ry_new = 0.0 if (dhdt*dhdy > 0.0) ry_new = min( (dhdt/dhdy), ry_max) - ry_avg = (1.0-gamma_v)*segment%rx_normal(I,j,k) + gamma_v*ry_new - segment%rx_normal(i,J,k) = ry_avg + ry_avg = (1.0-gamma_v)*segment%ry_normal(I,j,k) + gamma_v*ry_new + segment%ry_normal(i,J,k) = ry_avg ! The new boundary value is interpolated between future interior ! value, v_new(J+1) and past boundary value but with barotropic ! accelerations, v_new(J). segment%normal_vel(i,J,k) = (v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) / (1.0+ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability - OBC%ry_normal(i,J,k) = segment%rx_normal(i,J,k) + OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) elseif (segment%oblique) then dhdt = v_old(i,J+1,k)-v_new(i,J+1,k) !old-new dhdy = v_new(i,J+1,k)-v_new(i,J+2,k) !in new time backward sasha for J-1 -! if (segment%oblique) then - if (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) > 0.0) then - dhdx = segment%grad_normal(I-1,1,k) - elseif (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) == 0.0) then - dhdx = 0.0 - else - dhdx = segment%grad_normal(I,1,k) - endif -! endif + if (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) > 0.0) then + dhdx = segment%grad_normal(I-1,1,k) + elseif (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) == 0.0) then + dhdx = 0.0 + else + dhdx = segment%grad_normal(I,1,k) + endif if (dhdt*dhdy < 0.0) dhdt = 0.0 - Cy = min(dhdt*dhdy,rx_max) ! default to normal flow only -! Cx = 0 - cff = max(dhdy*dhdy, eps) -! if (segment%oblique) then - cff = max(dhdx*dhdx + dhdy*dhdy, eps) - Cx = min(cff,max(dhdt*dhdx,-cff)) -! endif + Cy = dhdt*dhdy + cff = max(dhdx*dhdx + dhdy*dhdy, eps) + Cx = min(cff,max(dhdt*dhdx,-cff)) segment%normal_vel(i,J,k) = ((cff*v_new(i,J,k) + Cy*v_new(i,J+1,k)) - & (max(Cx,0.0)*segment%grad_normal(I-1,2,k) + min(Cx,0.0)*segment%grad_normal(I,2,k))) / (cff + Cy) elseif (segment%gradient) then @@ -1903,7 +1905,7 @@ subroutine allocate_OBC_segment_data(OBC, segment) allocate(segment%eta(IsdB:IedB,jsd:jed)); segment%eta(:,:)=0.0 allocate(segment%normal_trans_bt(IsdB:IedB,jsd:jed)); segment%normal_trans_bt(:,:)=0.0 if (segment%radiation) then - allocate(segment%rx_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%rx_normal(:,:,:)=0.0 + allocate(segment%rx_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%rx_normal(:,:,:)=0.0 endif allocate(segment%normal_vel(IsdB:IedB,jsd:jed,OBC%ke)); segment%normal_vel(:,:,:)=0.0 allocate(segment%normal_vel_bt(IsdB:IedB,jsd:jed)); segment%normal_vel_bt(:,:)=0.0 @@ -1913,7 +1915,8 @@ subroutine allocate_OBC_segment_data(OBC, segment) allocate(segment%nudged_tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_vel(:,:,:)=0.0 endif if (segment%oblique) then - allocate(segment%grad_normal(JsdB:JedB,2,OBC%ke)); segment%grad_normal(:,:,:) = 0.0 + allocate(segment%grad_normal(JsdB:JedB,2,OBC%ke)); segment%grad_normal(:,:,:) = 0.0 + allocate(segment%ry_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%ry_normal(:,:,:)=0.0 endif endif @@ -1925,7 +1928,7 @@ subroutine allocate_OBC_segment_data(OBC, segment) allocate(segment%eta(isd:ied,JsdB:JedB)); segment%eta(:,:)=0.0 allocate(segment%normal_trans_bt(isd:ied,JsdB:JedB)); segment%normal_trans_bt(:,:)=0.0 if (segment%radiation) then - allocate(segment%rx_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%rx_normal(:,:,:)=0.0 + allocate(segment%ry_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%ry_normal(:,:,:)=0.0 endif allocate(segment%normal_vel(isd:ied,JsdB:JedB,OBC%ke)); segment%normal_vel(:,:,:)=0.0 allocate(segment%normal_vel_bt(isd:ied,JsdB:JedB)); segment%normal_vel_bt(:,:)=0.0 @@ -1935,7 +1938,8 @@ subroutine allocate_OBC_segment_data(OBC, segment) allocate(segment%nudged_tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_vel(:,:,:)=0.0 endif if (segment%oblique) then - allocate(segment%grad_normal(IsdB:IedB,2,OBC%ke)); segment%grad_normal(:,:,:) = 0.0 + allocate(segment%grad_normal(IsdB:IedB,2,OBC%ke)); segment%grad_normal(:,:,:) = 0.0 + allocate(segment%rx_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%rx_normal(:,:,:)=0.0 endif endif @@ -1956,6 +1960,7 @@ subroutine deallocate_OBC_segment_data(OBC, segment) if (associated (segment%eta)) deallocate(segment%eta) if (associated (segment%normal_trans_bt)) deallocate(segment%normal_trans_bt) if (associated (segment%rx_normal)) deallocate(segment%rx_normal) + if (associated (segment%ry_normal)) deallocate(segment%ry_normal) if (associated (segment%normal_vel)) deallocate(segment%normal_vel) if (associated (segment%normal_vel_bt)) deallocate(segment%normal_vel_bt) if (associated (segment%normal_trans)) deallocate(segment%normal_trans) From e20bc914b9b49ec6b343a298d20acf558b59c135 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 27 Apr 2018 15:00:27 -0400 Subject: [PATCH 0135/1072] +Added initialized element to mech_forcing type Added a new logical element, initialized, to the mech_forcing type that can be used to indicate whether it has been initialized and its arrays allocated. All answers are bitwise identical. --- src/core/MOM_forcing_type.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 2d94984d4e..cb2bd96a1c 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -203,6 +203,9 @@ module MOM_forcing_type !< enabled, and is exactly 0 away from shelves or on land. rigidity_ice_u => NULL(), & !< Depth-integrated lateral viscosity of ice rigidity_ice_v => NULL() !< shelves or sea ice at u- or v-points (m3/s) + + logical :: initialized = .false. !< This indicates whether the appropriate + !! arrays have been initialized. end type mech_forcing !> Structure that defines the id handles for the forcing type From dbc5fa6369d536feb9ea5938e811b57919338571 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 27 Apr 2018 15:00:47 -0400 Subject: [PATCH 0136/1072] +Created convert_IOB_to_forces Separated convert_IOB_to_forces out from convert_IOB_to_fluxes, and added calls to both in the coupled_driver version of ocean_model_MOM. Also separated apply_force_adjustments out from apply_flux_adjustments; both are inside of MOM_surface_forcing.F90 and are not publicly visibility. There is a new public interface, and one of the arguments has been removed from convert_IOB_to_fluxes, but all answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 246 +++++++++++------- config_src/coupled_driver/ocean_model_MOM.F90 | 10 +- 2 files changed, 160 insertions(+), 96 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 370cc9ad99..6c2978022d 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -44,7 +44,7 @@ module MOM_surface_forcing #include -public convert_IOB_to_fluxes +public convert_IOB_to_fluxes, convert_IOB_to_forces public surface_forcing_init public ice_ocn_bnd_type_chksum public forcing_save_restart @@ -189,12 +189,14 @@ module MOM_surface_forcing contains -subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, & +!> 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, CS, & sfc_state, restore_salt, restore_temp) type(ice_ocean_boundary_type), & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive !! the ocean in a coupled model - type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(forcing), intent(inout) :: fluxes !< A structure containing pointers to !! all possible mass, heat or salt flux forcing fields. !! Unused fields have NULL ptrs. @@ -206,34 +208,11 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, !! previous call to surface_forcing_init. type(surface), intent(in) :: sfc_state !< A structure containing fields that describe the !! surface state of the ocean. - logical, optional, intent(in) :: restore_salt, restore_temp - -! This subroutine translates the Ice_ocean_boundary_type into a -! MOM forcing type, including changes of units, sign conventions, -! and puting the fields into arrays with MOM-standard halos. - -! Arguments: -! IOB ice-ocean boundary type w/ fluxes to drive ocean in a coupled model -! (out) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) index_bounds - the i- and j- size of the arrays in IOB. -! (in) Time - The time of the fluxes, used for interpolating the salinity -! to the right time, when it is being restored. -! (in) G - The ocean's grid structure. -! (in) CS - A pointer to the control structure returned by a previous -! call to surface_forcing_init. -! (in) state - A structure containing fields that describe the -! surface state of the ocean. -! (in) restore_salt - if true, salinity is restored to a target value. -! (in) restore_temp - if true, temperature is restored to a target value. + 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. - 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) real, dimension(SZI_(G),SZJ_(G)) :: & - taux_at_h, & ! Zonal wind stresses at h points (Pa) - tauy_at_h, & ! Meridional wind stresses at h points (Pa) 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) @@ -247,16 +226,6 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, ! sum, used with units of m2 or (kg/s) open_ocn_mask ! a binary field indicating where ice is present based on frazil criteria - 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 @@ -282,7 +251,6 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 C_p = fluxes%C_p - Irho0 = 1.0/CS%Rho0 open_ocn_mask(:,:) = 1.0 pme_adj(:,:) = 0.0 fluxes%vPrecGlobalAdj = 0.0 @@ -302,8 +270,6 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, if (fluxes%dt_buoy_accum < 0) then call allocate_forcing_type(G, fluxes, water=.true., heat=.true., & ustar=.true., press=.true.) - call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., & - press=.true.) call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) @@ -330,14 +296,6 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) enddo; enddo - 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) - endif - if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) fluxes%dt_buoy_accum = 0.0 @@ -353,8 +311,8 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, if (CS%allow_flux_adjustments) then - fluxes%heat_added(:,:)=0.0 - fluxes%salt_flux_added(:,:)=0.0 + fluxes%heat_added(:,:)=0.0 + fluxes%salt_flux_added(:,:)=0.0 endif ! allocation and initialization on first call to this routine @@ -433,34 +391,11 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, enddo; enddo endif - wind_stagger = CS%wind_stagger - 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 - endif - if (wind_stagger == AGRID) then - ! This is necessary to fill in the halo points. - taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 - endif - ! obtain fluxes from IOB; note the staggering of indices i0 = is - isc_bnd ; j0 = js - jsc_bnd do j=js,je ; do i=is,ie - 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 - elseif (wind_stagger == AGRID) then - if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - else ! C-grid wind stresses. - if (associated(IOB%u_flux)) forces%taux(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) forces%tauy(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - endif - if (associated(IOB%lprec)) & fluxes%lprec(i,j) = IOB%lprec(i-i0,j-j0) * G%mask2dT(i,j) @@ -583,6 +518,90 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, 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) + endif + + ! Allow for user-written code to alter fluxes after all the above + call user_alter_forcing(sfc_state, fluxes, Time, G, CS%urf_CS) + + call cpu_clock_end(id_clock_forcing) + +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. +subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) + type(ice_ocean_boundary_type), & + target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive + !! the ocean in a coupled model + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + 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 + type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a + !! previous call to surface_forcing_init. + + + 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) + + real, dimension(SZI_(G),SZJ_(G)) :: & + 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 + i0 = is - isc_bnd ; j0 = js - jsc_bnd + + 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 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) + endif + + forces%initialized = .true. + endif + ! applied surface pressure from atmosphere and cryosphere if (associated(IOB%p)) then if (CS%max_p_surf >= 0.0) then @@ -603,6 +622,32 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, endif endif + wind_stagger = CS%wind_stagger + 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 + endif + if (wind_stagger == AGRID) then + ! This is necessary to fill in the halo points. + taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 + endif + + ! obtain fluxes from IOB; note the staggering of indices + do j=js,je ; do i=is,ie + 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 + elseif (wind_stagger == AGRID) then + if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + else ! C-grid wind stresses. + if (associated(IOB%u_flux)) forces%taux(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%v_flux)) forces%tauy(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + endif + enddo ; enddo + ! surface momentum stress related fields as function of staggering if (wind_stagger == BGRID_NE) then if (G%symmetric) & @@ -725,41 +770,34 @@ subroutine convert_IOB_to_fluxes(IOB, forces, fluxes, index_bounds, Time, G, CS, enddo ; enddo 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, forces, fluxes) + ! Apply adjustments to forces + call apply_force_adjustments(G, CS, Time, forces) endif - ! Allow for user-written code to alter fluxes after all the above - call user_alter_forcing(sfc_state, fluxes, Time, G, CS%urf_CS) +!### ! Allow for user-written code to alter fluxes after all the above +!### call user_alter_mech_forcing(forces, Time, G, CS%urf_CS) call cpu_clock_end(id_clock_forcing) -end subroutine convert_IOB_to_fluxes +end subroutine convert_IOB_to_forces -!> 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) -subroutine apply_flux_adjustments(G, CS, Time, forces, fluxes) +!! - 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(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces 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) 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 @@ -786,6 +824,28 @@ subroutine apply_flux_adjustments(G, CS, Time, forces, fluxes) fluxes%vprec(i,j) = fluxes%vprec(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) enddo ; enddo ; endif 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: +!! - taux_adj (Zonal wind stress delta, positive to the east, in Pa) +!! - tauy_adj (Meridional wind stress delta, positive to the north, in Pa) +subroutine apply_force_adjustments(G, CS, Time, forces) + 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(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) + + integer :: isc, iec, jsc, jec, i, j + real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau + logical :: overrode_x, overrode_y + + isc = G%isc; iec = G%iec ; jsc = G%jsc; jec = G%jec tempx_at_h(:,:) = 0.0 ; tempy_at_h(:,:) = 0.0 ! Either reads data or leaves contents unchanged @@ -822,7 +882,7 @@ subroutine apply_flux_adjustments(G, CS, Time, forces, fluxes) enddo ; enddo endif ! overrode_x .or. overrode_y -end subroutine apply_flux_adjustments +end subroutine apply_force_adjustments subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & filename_suffix) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index d153a2f04c..60dbe18210 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -39,7 +39,7 @@ module ocean_model_mod 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 : ice_ocn_bnd_type_chksum +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(>) @@ -525,8 +525,10 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (OS%fluxes%fluxes_used) then call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) ! Needed to allow diagnostics in convert_IOB - call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%forces, OS%fluxes, index_bnds, OS%Time, & + call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity,OS%restore_temp) + call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time, & + OS%grid, OS%forcing_CSp) ! Add ice shelf fluxes if (OS%use_ice_shelf) then @@ -550,8 +552,10 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%fluxes%dt_buoy_accum = dt_coupling else OS%flux_tmp%C_p = OS%fluxes%C_p - call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%forces, OS%flux_tmp, index_bnds, OS%Time, & + call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity,OS%restore_temp) + call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time, & + OS%grid, OS%forcing_CSp) if (OS%use_ice_shelf) then call shelf_calc_flux(OS%sfc_state, OS%forces, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) endif From 8ca33b0eef418d705a5657bffd8dc4ebca83009f Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Fri, 27 Apr 2018 11:20:49 -0800 Subject: [PATCH 0137/1072] Fix allocate bug on road to time-filtering OBLIQUE. --- src/core/MOM_open_boundary.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index b08be83b15..2317fbc146 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1916,6 +1916,7 @@ subroutine allocate_OBC_segment_data(OBC, segment) endif if (segment%oblique) then allocate(segment%grad_normal(JsdB:JedB,2,OBC%ke)); segment%grad_normal(:,:,:) = 0.0 + allocate(segment%rx_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%rx_normal(:,:,:)=0.0 allocate(segment%ry_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%ry_normal(:,:,:)=0.0 endif endif @@ -1940,6 +1941,7 @@ subroutine allocate_OBC_segment_data(OBC, segment) if (segment%oblique) then allocate(segment%grad_normal(IsdB:IedB,2,OBC%ke)); segment%grad_normal(:,:,:) = 0.0 allocate(segment%rx_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%rx_normal(:,:,:)=0.0 + allocate(segment%ry_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%ry_normal(:,:,:)=0.0 endif endif @@ -3024,7 +3026,7 @@ subroutine open_boundary_register_restarts(HI, GV, OBC_CS,restart_CSp) ! This implementation uses 3D arrays solely for restarts. We need ! to be able to add 2D ( x,z or y,z ) data to restarts to avoid using ! so much memory and disk space. *** - if (OBC_CS%radiation_BCs_exist_globally) then + if (OBC_CS%radiation_BCs_exist_globally .or. OBC_CS%oblique_BCs_exist_globally) then allocate(OBC_CS%rx_normal(HI%isdB:HI%iedB,HI%jsd:HI%jed,GV%ke)) OBC_CS%rx_normal(:,:,:) = 0.0 vd = var_desc("rx_normal","m s-1", "Normal Phase Speed for EW OBCs",'u','L') From dd27db84c8c30c35dfe60b67aa1735762555c36d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 27 Apr 2018 18:46:11 -0400 Subject: [PATCH 0138/1072] Restricted halo updates in MOM_surface_forcing Restricted the halo widths to their minimum required extents or commented out halo updates that do not appear to be needed at all. All answers are bitwise identical in the MOM6 test cases. --- .../coupled_driver/MOM_surface_forcing.F90 | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 6c2978022d..da9b9ef9af 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -14,6 +14,7 @@ module MOM_surface_forcing use MOM_domains, only : pass_vector, pass_var, fill_symmetric_edges use MOM_domains, only : global_field_sum, BITWISE_EXACT_SUM use MOM_domains, only : AGRID, BGRID_NE, CGRID_NE, To_All +use MOM_domains, only : To_North, To_East, Omit_Corners use MOM_error_handler, only : MOM_error, WARNING, FATAL, is_root_pe, MOM_mesg use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_forcing_type, only : forcing, mech_forcing, copy_common_forcing_fields @@ -652,7 +653,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, 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 @@ -689,7 +690,8 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, 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 @@ -717,7 +719,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, 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 @@ -807,7 +809,7 @@ subroutine apply_flux_adjustments(G, CS, Time, fluxes) 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 - if (overrode_h) call pass_var(fluxes%heat_added, G%Domain) + ! 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) @@ -815,7 +817,7 @@ subroutine apply_flux_adjustments(G, CS, Time, fluxes) 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 - if (overrode_h) call pass_var(fluxes%salt_flux_added, G%Domain) + ! Not needed? ! if (overrode_h) 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) @@ -823,7 +825,7 @@ subroutine apply_flux_adjustments(G, CS, Time, fluxes) 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 - if (overrode_h) call pass_var(fluxes%vprec, G%Domain) + ! 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 @@ -858,7 +860,7 @@ subroutine apply_force_adjustments(G, CS, Time, forces) "Both taux_adj and tauy_adj must be specified, or neither, in data_table") ! Rotate winds - call pass_vector(tempx_at_h, tempy_at_h, G%Domain, To_All, AGRID) + call pass_vector(tempx_at_h, tempy_at_h, G%Domain, To_All, AGRID, halo=1) do j=jsc-1,jec+1 ; do i=isc-1,iec+1 dLonDx = G%geoLonCu(I,j) - G%geoLonCu(I-1,j) dLonDy = G%geoLonCv(i,J) - G%geoLonCv(i,J-1) From 8c66d1fa244620b28da4785fe7b1f1ea192623d2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 28 Apr 2018 07:15:24 -0400 Subject: [PATCH 0139/1072] +Add opt arg skip_pres to copy_common_forcing_fields Added a new optional argument, skip_pres, to copy_common_forcing_fields, to specifiy that the surface pressure fields need not be copied. Also added or fixed dOxygenized comments in MOM_forcing_type.F90. All answers are bitwise identical. --- src/core/MOM_forcing_type.F90 | 52 ++++++++++++++++++++--------------- 1 file changed, 30 insertions(+), 22 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index cb2bd96a1c..08e534c693 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -808,8 +808,8 @@ subroutine calculateBuoyancyFlux1d(G, GV, fluxes, optics, h, Temp, Salt, tv, j, real, dimension(SZI_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoyancy flux (m^2/s^3) real, dimension(SZI_(G)), intent(inout) :: netHeatMinusSW !< surf Heat flux (K H/s) real, dimension(SZI_(G)), intent(inout) :: netSalt !< surf salt flux (ppt H/s) - logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating - !! diagnostics inside extractFluxes1d() + logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating + !! diagnostics inside extractFluxes1d() ! local variables integer :: nsw, start, npts, k real, parameter :: dt = 1. ! to return a rate from extractFluxes1d @@ -1722,12 +1722,14 @@ end subroutine register_forcing_type_diags !> Accumulate the forcing over time steps subroutine forcing_accumulate(flux_tmp, forces, fluxes, dt, G, wt2) - type(forcing), intent(in) :: flux_tmp + type(forcing), intent(in) :: flux_tmp !< A temporary structure with current + !!thermodynamic forcing fields type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - type(forcing), intent(inout) :: fluxes + type(forcing), intent(inout) :: fluxes !< A structure containing time-averaged + !! thermodynamic forcing fields real, intent(in) :: dt !< The elapsed time since the last call to this subroutine, in s type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, intent(out) :: wt2 + real, intent(out) :: wt2 !< The relative weight of the new fluxes ! This subroutine copies mechancal forcing from flux_tmp to fluxes and ! stores the time-weighted averages of the various buoyancy fluxes in fluxes, @@ -1847,37 +1849,43 @@ end subroutine forcing_accumulate !> This subroutine copies the computational domains of common forcing fields !! from a mech_forcing type to a (thermodynamic) forcing type. -subroutine copy_common_forcing_fields(forces, fluxes, G) +subroutine copy_common_forcing_fields(forces, fluxes, G, skip_pres) type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(ocean_grid_type), intent(in) :: G !< grid type + logical, optional, intent(in) :: skip_pres !< If present and true, do not copy pressure fields. real :: taux2, tauy2 ! Squared wind stress components, in Pa^2. + logical :: do_pres integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + do_pres = .true. ; if (present(skip_pres)) do_pres = .not.skip_pres + if (associated(forces%ustar) .and. associated(fluxes%ustar)) then do j=js,je ; do i=is,ie fluxes%ustar(i,j) = forces%ustar(i,j) enddo ; enddo endif - if (associated(forces%p_surf) .and. associated(fluxes%p_surf)) then - do j=js,je ; do i=is,ie - fluxes%p_surf(i,j) = forces%p_surf(i,j) - enddo ; enddo - endif + if (do_pres) then + if (associated(forces%p_surf) .and. associated(fluxes%p_surf)) then + do j=js,je ; do i=is,ie + fluxes%p_surf(i,j) = forces%p_surf(i,j) + enddo ; enddo + endif - if (associated(forces%p_surf_full) .and. associated(fluxes%p_surf_full)) then - do j=js,je ; do i=is,ie - fluxes%p_surf_full(i,j) = forces%p_surf_full(i,j) - enddo ; enddo - endif + if (associated(forces%p_surf_full) .and. associated(fluxes%p_surf_full)) then + do j=js,je ; do i=is,ie + fluxes%p_surf_full(i,j) = forces%p_surf_full(i,j) + enddo ; enddo + endif - if (associated(forces%p_surf_SSH, forces%p_surf_full)) then - fluxes%p_surf_SSH => fluxes%p_surf_full - elseif (associated(forces%p_surf_SSH, forces%p_surf)) then - fluxes%p_surf_SSH => fluxes%p_surf + if (associated(forces%p_surf_SSH, forces%p_surf_full)) then + fluxes%p_surf_SSH => fluxes%p_surf_full + elseif (associated(forces%p_surf_SSH, forces%p_surf)) then + fluxes%p_surf_SSH => fluxes%p_surf + endif endif end subroutine copy_common_forcing_fields @@ -2013,7 +2021,7 @@ end subroutine mech_forcing_diags !> Offer buoyancy forcing fields for diagnostics for those !! fields registered as part of register_forcing_type_diags. subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) - type(forcing), intent(in) :: fluxes !< flux type + type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields type(surface), intent(in) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. real, intent(in) :: dt !< time step @@ -2501,7 +2509,7 @@ end subroutine forcing_diagnostics !> Conditionally allocate fields within the forcing type subroutine allocate_forcing_type(G, fluxes, water, heat, ustar, press, shelf, iceberg, salt) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(forcing), intent(inout) :: fluxes !< Forcing fields structure + type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields logical, optional, intent(in) :: water !< If present and true, allocate water fluxes logical, optional, intent(in) :: heat !< If present and true, allocate heat fluxes logical, optional, intent(in) :: ustar !< If present and true, allocate ustar and related fields From 438de7c6f54d4919fc2e999a9849f2eadc6bf5b9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 28 Apr 2018 07:16:33 -0400 Subject: [PATCH 0140/1072] Set fluxes%p_surf directly from IOB Moved identical calls to convert_IOB_to_forces outside of a logical test, and set the surface pressure fields in fluxes directly from the IOB type. All answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 32 +++++++++++++++---- config_src/coupled_driver/ocean_model_MOM.F90 | 18 +++++------ 2 files changed, 35 insertions(+), 15 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index da9b9ef9af..7de381f8c0 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -17,7 +17,7 @@ module MOM_surface_forcing use MOM_domains, only : To_North, To_East, Omit_Corners use MOM_error_handler, only : MOM_error, WARNING, FATAL, is_root_pe, MOM_mesg use MOM_file_parser, only : get_param, log_version, param_file_type -use MOM_forcing_type, only : forcing, mech_forcing, copy_common_forcing_fields +use MOM_forcing_type, only : forcing, mech_forcing use MOM_forcing_type, only : forcing_diags, mech_forcing_diags, register_forcing_type_diags use MOM_forcing_type, only : allocate_forcing_type, deallocate_forcing_type use MOM_forcing_type, only : allocate_mech_forcing, deallocate_mech_forcing @@ -279,6 +279,11 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, 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) @@ -467,6 +472,21 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & enddo ; enddo + ! 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 + endif + ! more salt restoring logic if (associated(IOB%salt_flux)) then do j=js,je ; do i=is,ie @@ -594,6 +614,11 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) 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%use_limited_P_SSH) then + forces%p_surf_SSH => forces%p_surf + else + forces%p_surf_SSH => forces%p_surf_full + endif if (CS%rigid_sea_ice) then call safe_alloc_ptr(forces%rigidity_ice_u,IsdB,IedB,jsd,jed) @@ -616,11 +641,6 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) forces%p_surf(i,j) = forces%p_surf_full(i,j) enddo ; enddo endif - if (CS%use_limited_P_SSH) then - forces%p_surf_SSH => forces%p_surf - else - forces%p_surf_SSH => forces%p_surf_full - endif endif wind_stagger = CS%wind_stagger diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 60dbe18210..1937e92177 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -523,12 +523,12 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & weight = 1.0 + call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time, & + OS%grid, OS%forcing_CSp) + if (OS%fluxes%fluxes_used) then - call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) ! Needed to allow diagnostics in convert_IOB call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity,OS%restore_temp) - call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp) ! Add ice shelf fluxes if (OS%use_ice_shelf) then @@ -542,9 +542,10 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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) + call copy_common_forcing_fields(OS%forces, OS%fluxes, OS%grid, skip_pres=.true.) #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. @@ -554,14 +555,13 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%flux_tmp%C_p = OS%fluxes%C_p call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity,OS%restore_temp) - call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp) + if (OS%use_ice_shelf) then call shelf_calc_flux(OS%sfc_state, OS%forces, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) endif 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, & + ! 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 @@ -589,7 +589,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call disable_averaging(OS%diag) Master_time = OS%Time ; Time1 = OS%Time - if(OS%offline_tracer_mode) then + if (OS%offline_tracer_mode) then call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) 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) From 45442d5bcbaf1564a989c48e1d718a7c66a0b567 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Sun, 29 Apr 2018 10:15:45 -0800 Subject: [PATCH 0141/1072] Cleaning up last min/max on OBLIQUE --- src/core/MOM_open_boundary.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 2317fbc146..1595ae42f7 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1464,11 +1464,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) dhdt = u_old(I-1,j,k)-u_new(I-1,j,k) !old-new dhdx = u_new(I-1,j,k)-u_new(I-2,j,k) !in new time backward sasha for I-1 if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then - ry_new = min(segment%grad_normal(J-1,1,k), rx_max) + ry_new = segment%grad_normal(J-1,1,k) elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then ry_new = 0.0 else - ry_new = min(segment%grad_normal(J,1,k), rx_max) + ry_new = segment%grad_normal(J,1,k) endif if (dhdt*dhdx < 0.0) dhdt = 0.0 Cx = dhdt*dhdx From 3760246e4c82136725face71aa841d38df4a2d8e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 30 Apr 2018 11:05:26 -0400 Subject: [PATCH 0142/1072] Remove fluxes arg from finish_MOM_initialization Removed unused argument fluxes from finish_MOM_initialization. All answers are bitwise identical, but a public interface has changed. --- config_src/coupled_driver/ocean_model_MOM.F90 | 3 +-- config_src/mct_driver/ocn_comp_mct.F90 | 3 +-- config_src/solo_driver/MOM_driver.F90 | 2 +- src/core/MOM.F90 | 3 +-- 4 files changed, 4 insertions(+), 7 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 1937e92177..80440f4d4e 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -582,8 +582,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & endif if (OS%nstep==0) then - call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%fluxes, & - OS%restart_CSp) + call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%restart_CSp) endif call disable_averaging(OS%diag) diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 35217b5c8e..dea8cc4c10 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -1769,8 +1769,7 @@ subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, & call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid) if (OS%nstep==0) then - call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%fluxes, & - OS%restart_CSp) + call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, S%restart_CSp) endif call disable_averaging(OS%diag) diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index c2ac628909..1bc713d106 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -496,7 +496,7 @@ program MOM_main endif if (ns==1) then - call finish_MOM_initialization(Time, dirs, MOM_CSp, fluxes, restart_CSp) + call finish_MOM_initialization(Time, dirs, MOM_CSp, restart_CSp) endif ! This call steps the model over a time dt_forcing. diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index f3b89e0c2e..d27239e9c3 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2403,11 +2403,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & end subroutine initialize_MOM !> This subroutine finishes initializing MOM and writes out the initial conditions. -subroutine finish_MOM_initialization(Time, dirs, CS, fluxes, restart_CSp) +subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) type(time_type), intent(in) :: Time !< model time, used in this routine type(directories), intent(in) :: dirs !< structure with directory paths type(MOM_control_struct), pointer :: CS !< pointer to MOM control structure - type(forcing), intent(inout) :: fluxes !< pointers to forcing fields type(MOM_restart_CS), pointer :: restart_CSp !< pointer to the restart control !! structure that will be used for MOM. ! Local variables From 4eef7579e48a941d4681d1125ad2b4d8a84baeae Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 30 Apr 2018 18:02:34 -0400 Subject: [PATCH 0143/1072] (*)Corrected bugs setting rigidity from iceshelves The code setting the rigidity due to ice shelves used a mismatch of the minimum and maximum ice shelf masses in the two directions. This has been corrected to use the minimum in both directions. Also, when the ice shelves are used, the penetrating portions of the shortwave are being erroneously zeroed out everywhere. All solutions in the existing MOM6_examples test cases are bitwise identical, but there will likely be answer changes if ICE_SHELF is true. --- src/ice_shelf/MOM_ice_shelf.F90 | 62 ++++++++++++++++----------------- 1 file changed, 31 insertions(+), 31 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index efa74e561e..abed2f8534 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -347,9 +347,8 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) type(surface), intent(inout) :: state !< structure containing fields that !!describe the surface state of the ocean type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(forcing), intent(inout) :: fluxes !< structure containing pointers to - !!any possible forcing fields. - !!Unused fields have NULL ptrs. + type(forcing), intent(inout) :: fluxes !< structure containing pointers to any possible + !! thermodynanamic or mass-flux forcing fields. type(time_type), intent(in) :: Time !< Start time of the fluxes. real, intent(in) :: time_step !< Length of time over which !! these fluxes will be applied, in s. @@ -952,39 +951,33 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) real, dimension(:,:), allocatable, target :: last_area_shelf_h !< Ice shelf area ! at at previous time (Time-dt), m^2 + real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1. real, parameter :: rho_fw = 1000.0 ! fresh water density integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed Irho0 = 1.0 / CS%Rho0 + kv_rho_ice = CS%kv_ice / CS%density_ice ! Determine ustar and the square magnitude of the velocity in the ! bottom boundary layer. Together these give the TKE source and ! vertical decay scale. if (CS%shelf_mass_is_dynamic) then - do j=jsd,jed ; do i=isd,ied - if (G%areaT(i,j) > 0.0) & - fluxes%frac_shelf_h(i,j) = CS%area_shelf_h(i,j) / G%areaT(i,j) - enddo ; enddo - !do I=isd,ied-1 ; do j=isd,jed - do j=jsd,jed ; do i=isd,ied-1 ! ### changed stride order; i->ied-1? + do j=jsd,jed ; do I=isd,ied-1 forces%frac_shelf_u(I,j) = 0.0 if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%dxdy_u(I,j) > 0.0)) & forces%frac_shelf_u(I,j) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i+1,j)) / & (G%areaT(i,j) + G%areaT(i+1,j))) - !### Either the min here or the max below must be wrong, but is either right? -RWH - forces%rigidity_ice_u(I,j) = (CS%kv_ice / CS%density_ice) * & + forces%rigidity_ice_u(I,j) = kv_rho_ice * & min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) enddo ; enddo - do j=jsd,jed-1 ; do i=isd,ied ! ### change stride order; j->jed-1? - !do i=isd,ied ; do J=isd,jed-1 + do J=jsd,jed-1 ; do i=isd,ied forces%frac_shelf_v(i,J) = 0.0 if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%dxdy_v(i,J) > 0.0)) & forces%frac_shelf_v(i,J) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i,j+1)) / & (G%areaT(i,j) + G%areaT(i,j+1))) - !### Either the max here or the min above must be wrong, but is either right? -RWH - forces%rigidity_ice_v(i,J) = (CS%kv_ice / CS%density_ice) * & - max(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) + forces%rigidity_ice_v(i,J) = kv_rho_ice * & + min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) enddo ; enddo call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) else @@ -992,13 +985,13 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) ! in the ice shelf cavity: MJH do j=jsd,jed ; do i=isd,ied-1 ! changed stride - forces%rigidity_ice_u(I,j) = (CS%kv_ice / CS%density_ice) * & + forces%rigidity_ice_u(I,j) = kv_rho_ice * & min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) enddo ; enddo do j=jsd,jed-1 ; do i=isd,ied ! changed stride - forces%rigidity_ice_v(i,J) = (CS%kv_ice / CS%density_ice) * & - max(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) + forces%rigidity_ice_v(i,J) = kv_rho_ice * & + min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) enddo ; enddo endif @@ -1019,10 +1012,13 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) call pass_vector(state%taux_shelf, state%tauy_shelf, G%domain, TO_ALL, CGRID_NE) endif - if (associated(fluxes%sw_vis_dir)) fluxes%sw_vis_dir = 0.0 - if (associated(fluxes%sw_vis_dif)) fluxes%sw_vis_dif = 0.0 - if (associated(fluxes%sw_nir_dir)) fluxes%sw_nir_dir = 0.0 - if (associated(fluxes%sw_nir_dif)) fluxes%sw_nir_dif = 0.0 + + if (CS%shelf_mass_is_dynamic) then + do j=jsd,jed ; do i=isd,ied + if (G%areaT(i,j) > 0.0) & + fluxes%frac_shelf_h(i,j) = CS%area_shelf_h(i,j) * G%IareaT(i,j) + enddo ; enddo + endif do j=G%jsc,G%jec ; do i=G%isc,G%iec frac_area = fluxes%frac_shelf_h(i,j) @@ -1045,11 +1041,15 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) !fluxes%ustar(i,j) = MAX(CS%ustar_bg, sqrt(Irho0 * sqrt(taux2 + tauy2))) if (associated(fluxes%sw)) fluxes%sw(i,j) = 0.0 + if (associated(fluxes%sw_vis_dir)) fluxes%sw_vis_dir(i,j) = 0.0 + if (associated(fluxes%sw_vis_dif)) fluxes%sw_vis_dif(i,j) = 0.0 + if (associated(fluxes%sw_nir_dir)) fluxes%sw_nir_dir(i,j) = 0.0 + if (associated(fluxes%sw_nir_dif)) fluxes%sw_nir_dif(i,j) = 0.0 if (associated(fluxes%lw)) fluxes%lw(i,j) = 0.0 if (associated(fluxes%latent)) fluxes%latent(i,j) = 0.0 if (associated(fluxes%evap)) fluxes%evap(i,j) = 0.0 if (associated(fluxes%lprec)) then - if (CS%lprec(i,j) > 0.0 ) then + if (CS%lprec(i,j) > 0.0) then fluxes%lprec(i,j) = frac_area*CS%lprec(i,j)*CS%flux_factor else fluxes%lprec(i,j) = 0.0 @@ -1061,8 +1061,7 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) if (associated(fluxes%sens)) fluxes%sens(i,j) = -frac_area*CS%t_flux(i,j)*CS%flux_factor if (associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = frac_area * CS%salt_flux(i,j)*CS%flux_factor if (associated(fluxes%p_surf)) fluxes%p_surf(i,j) = frac_area * CS%g_Earth * CS%mass_shelf(i,j) - ! Same for IOB%p - if (associated(fluxes%p_surf_full) ) fluxes%p_surf_full(i,j) = & + if (associated(fluxes%p_surf_full)) fluxes%p_surf_full(i,j) = & frac_area * CS%g_Earth * CS%mass_shelf(i,j) endif @@ -1136,7 +1135,7 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) delta_mass_shelf = 0.0 endif else ! ice shelf mass does not change - delta_mass_shelf = 0.0 + delta_mass_shelf = 0.0 endif call mpp_sum(mean_melt_flux) @@ -1165,15 +1164,16 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) ! If the shelf mass is changing, the forces%rigidity_ice_[uv] needs to be ! updated here. + kv_rho_ice = CS%kv_ice / CS%density_ice if (CS%shelf_mass_is_dynamic) then do j=G%jsc,G%jec ; do i=G%isc-1,G%iec - forces%rigidity_ice_u(I,j) = (CS%kv_ice / CS%density_ice) * & - max(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) + forces%rigidity_ice_u(I,j) = kv_rho_ice * & + min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) enddo ; enddo do j=G%jsc-1,G%jec ; do i=G%isc,G%iec - forces%rigidity_ice_v(i,J) = (CS%kv_ice / CS%density_ice) * & - max(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) + forces%rigidity_ice_v(i,J) = kv_rho_ice * & + min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) enddo ; enddo endif From 0c5fab30cde0bbb7acd0f71109f70ef3a14dd001 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 30 Apr 2018 18:12:09 -0400 Subject: [PATCH 0144/1072] (+)Added Ocn_fluxes_used arg to update_ocean_model Added an optional argument, Ocn_fluxes_used, to update_ocean_model to indicate that the cumulative thermodynamic fluxes from the ocean, like frazil, have been used by the ice, and hence the running sum should be reset. Also refactored add_berg_flux_to_shelf to collect updates to the terms in forces and fluxes. Also added Waves arguments to more of the step_MOM calls, and a new (and as-yet untested) variant of the step_MOM call for when the call to update_ocean_model indicats the dynamics or thermodynamics are not to be advanced. All answers in the test cases are bitwise identical. --- config_src/coupled_driver/ocean_model_MOM.F90 | 61 +++++++++++++------ 1 file changed, 41 insertions(+), 20 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 80440f4d4e..db59637ca6 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -450,7 +450,7 @@ end subroutine ocean_model_init !! 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, & - update_dyn, update_thermo) + 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. @@ -469,6 +469,9 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & !! 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. type(time_type) :: Master_time ! This allows step_MOM to temporarily change ! the time that is seen by internal modules. @@ -488,7 +491,8 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & type(time_type) :: Time2 ! A temporary time. logical :: thermo_does_span_coupling ! If true, thermodynamic forcing spans ! multiple dynamic timesteps. - logical :: do_dyn, do_thermo + 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 @@ -528,7 +532,8 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (OS%fluxes%fluxes_used) then call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity,OS%restore_temp) + OS%grid, OS%forcing_CSp, OS%sfc_state, & + OS%restore_salinity, OS%restore_temp) ! Add ice shelf fluxes if (OS%use_ice_shelf) then @@ -590,6 +595,13 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (OS%offline_tracer_mode) then 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) + !### What to do with these? , start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) + 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 @@ -615,16 +627,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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, & - do_dynamics=.false., do_thermodynamics=.true., & + 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, & - do_dynamics=.true., do_thermodynamics=.false., & + 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, & - do_dynamics=.true., do_thermodynamics=.false., & + Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) step_thermo = .false. @@ -641,7 +653,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! 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, & - do_dynamics=.false., do_thermodynamics=.true., & + Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) endif endif @@ -692,7 +704,8 @@ subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, density_ice, latent_heat_fusion, sfc_state, time_step, berg_area_threshold) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(forcing), intent(inout) :: fluxes + type(forcing), intent(inout) :: fluxes !< A structure with pointers to themodynamic, + !! tracer and mass exchange forcing fields type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. logical, intent(in) :: use_ice_shelf !< If true, this configuration uses ice shelves. @@ -715,29 +728,23 @@ subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, density_ice, !the ocean model. This routine is taken from the add_shelf_flux subroutine !within the ice shelf model. - if (.not. (((associated(fluxes%frac_shelf_h) .and. associated(forces%frac_shelf_u)) & - .and.(associated(forces%frac_shelf_v) .and. associated(fluxes%ustar_shelf)))& - .and.(associated(forces%rigidity_ice_u) .and. associated(forces%rigidity_ice_v)))) return - if (.not.(associated(fluxes%area_berg) .and. associated(fluxes%ustar_berg) .and. & associated(fluxes%mass_berg) ) ) return + if (.not.(associated(forces%frac_shelf_u) .and. associated(forces%frac_shelf_v) .and. & + associated(forces%rigidity_ice_u) .and. associated(forces%rigidity_ice_v)) ) return + + if (.not.(associated(fluxes%frac_shelf_h) .and. associated(fluxes%ustar_shelf)) ) return + + ! This section sets or augments the values of fields in forces. if (.not. use_ice_shelf) then - fluxes%frac_shelf_h(:,:) = 0. forces%frac_shelf_u(:,:) = 0. forces%frac_shelf_v(:,:) = 0. - fluxes%ustar_shelf(:,:) = 0. forces%rigidity_ice_u(:,:) = 0. forces%rigidity_ice_v(:,:) = 0. endif kv_rho_ice = kv_ice / density_ice - - do j=jsd,jed ; do i=isd,ied - if (G%areaT(i,j) > 0.0) & - fluxes%frac_shelf_h(i,j) = fluxes%frac_shelf_h(i,j) + fluxes%area_berg(i,j) - fluxes%ustar_shelf(i,j) = fluxes%ustar_shelf(i,j) + fluxes%ustar_berg(i,j) - enddo ; enddo do j=jsd,jed ; do I=isd,ied-1 forces%frac_shelf_u(I,j) = 0.0 if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%dxdy_u(I,j) > 0.0)) & @@ -760,6 +767,20 @@ subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, density_ice, enddo ; enddo call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) + ! The remaining code sets or augments the values of fields in fluxes. + + if (.not.(associated(fluxes%area_berg) .and. associated(fluxes%ustar_berg) .and. & + associated(fluxes%mass_berg) ) ) return + if (.not. use_ice_shelf) then + fluxes%frac_shelf_h(:,:) = 0. + fluxes%ustar_shelf(:,:) = 0. + endif + do j=jsd,jed ; do i=isd,ied + if (G%areaT(i,j) > 0.0) & + fluxes%frac_shelf_h(i,j) = fluxes%frac_shelf_h(i,j) + fluxes%area_berg(i,j) + fluxes%ustar_shelf(i,j) = fluxes%ustar_shelf(i,j) + fluxes%ustar_berg(i,j) + enddo ; enddo + !Zero'ing out other fluxes under the tabular icebergs if (berg_area_threshold >= 0.) then I_dt_LHF = 1.0 / (time_step * latent_heat_fusion) From d6bf3e13d676ba39cd26b74fdcd3e16de9957379 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Tue, 1 May 2018 06:54:23 -0800 Subject: [PATCH 0145/1072] Added OBC_COMPUTED_VORTICITY option. - Helps with dumbbell cases, uses external tangential flow. --- src/core/MOM_CoriolisAdv.F90 | 14 ++++++ src/core/MOM_open_boundary.F90 | 68 ++++++++++++++++++++++++------ src/user/Kelvin_initialization.F90 | 5 +++ 3 files changed, 75 insertions(+), 12 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index c32352acb1..44449bbd2d 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -290,6 +290,13 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) if (OBC%freeslip_vorticity) then ; do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB dudy(I,J) = 0. enddo ; endif + if (OBC%computed_vorticity) then ; do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB + if (OBC%segment(n)%direction == OBC_DIRECTION_N) then + dudy(I,J) = 2.0*(OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%dxCu(I,j) + else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) + dudy(I,J) = 2.0*(u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%dxCu(I,j+1) + endif + enddo ; endif ! Project thicknesses across OBC points with a no-gradient condition. do i = max(Isq-1,OBC%segment(n)%HI%isd), min(Ieq+2,OBC%segment(n)%HI%ied) @@ -316,6 +323,13 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) if (OBC%freeslip_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB dvdx(I,J) = 0. enddo ; endif + if (OBC%computed_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB + if (OBC%segment(n)%direction == OBC_DIRECTION_E) then + dvdx(I,J) = 2.0*(OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%dyCv(i,J) + else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) + dvdx(I,J) = 2.0*(v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%dyCv(i+1,J) + endif + enddo ; endif ! Project thicknesses across OBC points with a no-gradient condition. do j = max(Jsq-1,OBC%segment(n)%HI%jsd), min(Jeq+2,OBC%segment(n)%HI%jed) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 2317fbc146..b017aadd55 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -107,7 +107,9 @@ module MOM_open_boundary !! If False, a gradient condition is applied. logical :: oblique !< Oblique waves supported at radiation boundary. logical :: nudged !< Optional supplement to radiation boundary. - logical :: specified !< Boundary fixed to external value. + logical :: nudged_tan !< Optional supplement to nudge tangential velocity. + logical :: specified !< Boundary normal velocity fixed to external value. + logical :: specified_tan !< Boundary tangential velocity fixed to external value. logical :: open !< Boundary is open for continuity solver. logical :: gradient !< Zero gradient at boundary. logical :: values_needed !< Whether or not external OBC fields are needed. @@ -132,6 +134,8 @@ module MOM_open_boundary real, pointer, dimension(:,:,:) :: h=>NULL() !< The cell thickness (m) at OBC-points. real, pointer, dimension(:,:,:) :: normal_vel=>NULL() !< The layer velocity normal to the OB !! segment (m s-1). + real, pointer, dimension(:,:,:) :: tangential_vel=>NULL() !< The layer velocity tangential to the + !! OB segment (m s-1). real, pointer, dimension(:,:,:) :: normal_trans=>NULL() !< The layer transport normal to the OB !! segment (m3 s-1). real, pointer, dimension(:,:) :: normal_vel_bt=>NULL() !< The barotropic velocity normal to @@ -188,6 +192,8 @@ module MOM_open_boundary logical :: zero_vorticity = .false. !< If True, sets relative vorticity to zero on open boundaries. logical :: freeslip_vorticity = .false. !< If True, sets normal gradient of tangential velocity to zero !! in the relative vorticity on open boundaries. + logical :: computed_vorticity = .false. !< If True, uses external data for tangential velocity + !! in the relative vorticity on open boundaries. logical :: zero_strain = .false. !< If True, sets strain to zero on open boundaries. logical :: freeslip_strain = .false. !< If True, sets normal gradient of tangential velocity to zero !! in the strain on open boundaries. @@ -299,9 +305,14 @@ subroutine open_boundary_config(G, param_file, OBC) "If true, sets the normal gradient of tangential velocity to\n"// & "zero in the relative vorticity on open boundaries. This cannot\n"// & "be true if OBC_ZERO_VORTICITY is True.", default=.false.) - if (OBC%zero_vorticity .and. OBC%freeslip_vorticity) call MOM_error(FATAL, & - "MOM_open_boundary.F90, open_boundary_config: "//& - "Only one of OBC_ZERO_VORTICITY and OBC_FREESLIP_VORTICITY can be True at once.") + call get_param(param_file, mdl, "OBC_COMPUTED_VORTICITY", OBC%computed_vorticity, & + "If true, uses the external values of tangential velocity\n"// & + "in the relative vorticity on open boundaries. This cannot\n"// & + "be true if OBC_ZERO_VORTICITY or OBC_FREESLIP_VORTICITY is True.", default=.false.) + if (OBC%zero_vorticity .and. OBC%freeslip_vorticity .and. OBC%computed_vorticity) & + call MOM_error(FATAL, "MOM_open_boundary.F90, open_boundary_config:\n"//& + "Only one of OBC_ZERO_VORTICITY, OBC_FREESLIP_VORTICITY and OBC_COMPUTED_VORTICITY\n"//& + "can be True at once.") call get_param(param_file, mdl, "OBC_ZERO_STRAIN", OBC%zero_strain, & "If true, sets the strain used in the stress tensor to zero on open boundaries.", & default=.false.) @@ -344,7 +355,9 @@ subroutine open_boundary_config(G, param_file, OBC) OBC%segment(l)%radiation = .false. OBC%segment(l)%oblique = .false. OBC%segment(l)%nudged = .false. + OBC%segment(l)%nudged_tan = .false. OBC%segment(l)%specified = .false. + OBC%segment(l)%specified_tan = .false. OBC%segment(l)%open = .false. OBC%segment(l)%gradient = .false. OBC%segment(l)%values_needed = .false. @@ -770,6 +783,8 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF) elseif (trim(action_str(a_loop)) == 'SIMPLE') then OBC%segment(l_seg)%specified = .true. OBC%specified_u_BCs_exist_globally = .true. ! This avoids deallocation + elseif (trim(action_str(a_loop)) == 'SIMPLE_TAN') then + OBC%segment(l_seg)%specified_tan = .true. else call MOM_error(FATAL, "MOM_open_boundary.F90, setup_u_point_obc: "//& "String '"//trim(action_str(a_loop))//"' not understood.") @@ -871,6 +886,8 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF) elseif (trim(action_str(a_loop)) == 'SIMPLE') then OBC%segment(l_seg)%specified = .true. OBC%specified_v_BCs_exist_globally = .true. ! This avoids deallocation + elseif (trim(action_str(a_loop)) == 'SIMPLE_TAN') then + OBC%segment(l_seg)%specified_tan = .true. else call MOM_error(FATAL, "MOM_open_boundary.F90, setup_v_point_obc: "//& "String '"//trim(action_str(a_loop))//"' not understood.") @@ -1464,11 +1481,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) dhdt = u_old(I-1,j,k)-u_new(I-1,j,k) !old-new dhdx = u_new(I-1,j,k)-u_new(I-2,j,k) !in new time backward sasha for I-1 if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then - ry_new = min(segment%grad_normal(J-1,1,k), rx_max) + ry_new = segment%grad_normal(J-1,1,k) elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then ry_new = 0.0 else - ry_new = min(segment%grad_normal(J,1,k), rx_max) + ry_new = segment%grad_normal(J,1,k) endif if (dhdt*dhdx < 0.0) dhdt = 0.0 Cx = dhdt*dhdx @@ -1912,6 +1929,11 @@ subroutine allocate_OBC_segment_data(OBC, segment) allocate(segment%normal_trans(IsdB:IedB,jsd:jed,OBC%ke)); segment%normal_trans(:,:,:)=0.0 if (segment%nudged) then allocate(segment%nudged_normal_vel(IsdB:IedB,jsd:jed,OBC%ke)); segment%nudged_normal_vel(:,:,:)=0.0 + endif + if (OBC%computed_vorticity .or. segment%nudged_tan .or. segment%specified_tan) then + allocate(segment%tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_vel(:,:,:)=0.0 + endif + if (segment%nudged_tan) then allocate(segment%nudged_tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_vel(:,:,:)=0.0 endif if (segment%oblique) then @@ -1936,6 +1958,11 @@ subroutine allocate_OBC_segment_data(OBC, segment) allocate(segment%normal_trans(isd:ied,JsdB:JedB,OBC%ke)); segment%normal_trans(:,:,:)=0.0 if (segment%nudged) then allocate(segment%nudged_normal_vel(isd:ied,JsdB:JedB,OBC%ke)); segment%nudged_normal_vel(:,:,:)=0.0 + endif + if (OBC%computed_vorticity .or. segment%nudged_tan .or. segment%specified_tan) then + allocate(segment%tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_vel(:,:,:)=0.0 + endif + if (segment%nudged_tan) then allocate(segment%nudged_tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_vel(:,:,:)=0.0 endif if (segment%oblique) then @@ -1967,6 +1994,7 @@ subroutine deallocate_OBC_segment_data(OBC, segment) if (associated (segment%normal_vel_bt)) deallocate(segment%normal_vel_bt) if (associated (segment%normal_trans)) deallocate(segment%normal_trans) if (associated (segment%nudged_normal_vel)) deallocate(segment%nudged_normal_vel) + if (associated (segment%tangential_vel)) deallocate(segment%tangential_vel) if (associated (segment%nudged_tangential_vel)) deallocate(segment%nudged_tangential_vel) if (associated (segment%tr_Reg)) call segment_tracer_registry_end(segment%tr_Reg) @@ -2288,8 +2316,8 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (segment%direction == OBC_DIRECTION_E) ishift=0 I=is_obc if (segment%field(m)%name == 'V') then - ! Only do q points within the segment - do J=js_obc+1,je_obc-1 + ! Do q points for the whole segment + do J=js_obc,je_obc ! Using the h remapping approach ! Pretty sure we need to check for source/target grid consistency here segment%field(m)%buffer_dst(I,J,:)=0.0 ! initialize remap destination buffer @@ -2331,8 +2359,8 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (segment%direction == OBC_DIRECTION_N) jshift=0 J=js_obc if (segment%field(m)%name == 'U') then - ! Only do q points within the segment - do I=is_obc+1,ie_obc-1 + ! Do q points for the whole segment + do I=is_obc,ie_obc segment%field(m)%buffer_dst(I,J,:)=0.0 ! initialize remap destination buffer if (G%mask2dCv(i,J)>0. .and. G%mask2dCv(i+1,J)>0.) then ! Using the h remapping approach @@ -2342,13 +2370,13 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & segment%field(m)%buffer_src(I,J,:), & G%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) - else if (G%mask2dCv(i,J)>0.) then + elseif (G%mask2dCv(i,J)>0.) then h_stack(:) = h(i,j+jshift,:) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & segment%field(m)%buffer_src(I,J,:), & G%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) - else if (G%mask2dCv(i+1,J)>0.) then + elseif (G%mask2dCv(i+1,J)>0.) then h_stack(:) = h(i+1,j+jshift,:) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & @@ -2434,6 +2462,22 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) G%dxCv(i,J)) if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(i,J,:) = segment%normal_vel(i,J,:) enddo + elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_E_or_W .and. associated(segment%tangential_vel)) then + I=is_obc + do J=js_obc+1,je_obc-1 + do k=1,G%ke + segment%tangential_vel(I,J,k) = segment%field(m)%buffer_dst(I,J,k) + enddo + if (associated(segment%nudged_tangential_vel)) segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) + enddo + elseif (trim(segment%field(m)%name) == 'U' .and. segment%is_N_or_S .and. associated(segment%tangential_vel)) then + J=js_obc + do I=is_obc+1,ie_obc-1 + do k=1,G%ke + segment%tangential_vel(I,J,k) = segment%field(m)%buffer_dst(I,J,k) + enddo + if (associated(segment%nudged_tangential_vel)) segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) + enddo endif endif endif diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 3b249864e4..63d61bea35 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -211,6 +211,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) if (segment%direction == OBC_DIRECTION_W) then IsdB = segment%HI%IsdB ; IedB = segment%HI%IedB jsd = segment%HI%jsd ; jed = segment%HI%jed + JsdB = segment%HI%JsdB ; JedB = segment%HI%JedB do j=jsd,jed ; do I=IsdB,IedB x1 = 1000. * G%geoLonCu(I,j) y1 = 1000. * G%geoLatCu(I,j) @@ -242,6 +243,10 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) endif endif enddo ; enddo +! if (allocated(segment%tangential_vel)) then +! do J=JsdB,JedB ; do I=IsdB,IedB +! enddo ; enddo +! endif else isd = segment%HI%isd ; ied = segment%HI%ied JsdB = segment%HI%JsdB ; JedB = segment%HI%JedB From 4cc6eab3039335631a708b644740b898ca605866 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 1 May 2018 13:13:25 -0400 Subject: [PATCH 0146/1072] (+)Added iceberg elements to mech_forcing type Added the new elements area_berg and mass_berg to the mech_forcing type, since these may be updated at different points in the algorithm than the fluxes type. All answers are bitwise identical. --- src/core/MOM_forcing_type.F90 | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 08e534c693..e092c2a5ab 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -194,6 +194,10 @@ module MOM_forcing_type !! This may point to p_surf or to p_surf_full. net_mass_src => NULL(), & !< The net mass source to the ocean, in kg m-2 s-1. + ! iceberg related inputs + area_berg => NULL(), & !< area of ocean surface covered by icebergs (m2/m2) + mass_berg => NULL(), & !< mass of icebergs (kg/m2) + ! land ice-shelf related inputs frac_shelf_u => NULL(), & !< Fractional ice shelf coverage of u-cells, nondimensional !! from 0 to 1. This is only associated if ice shelves are @@ -2605,6 +2609,10 @@ subroutine allocate_mech_forcing(G, forces, stress, ustar, shelf, press, iceberg call myAlloc(forces%frac_shelf_u,IsdB,IedB,jsd,jed, shelf) call myAlloc(forces%frac_shelf_v,isd,ied,JsdB,JedB, shelf) + !These fields should only on allocated when iceberg area is being passed through the coupler. + call myAlloc(forces%area_berg,isd,ied,jsd,jed, iceberg) + call myAlloc(forces%mass_berg,isd,ied,jsd,jed, iceberg) + end subroutine allocate_mech_forcing !> Allocates and zeroes-out array. @@ -2678,13 +2686,15 @@ subroutine deallocate_mech_forcing(forces) if (associated(forces%taux)) deallocate(forces%taux) if (associated(forces%tauy)) deallocate(forces%tauy) if (associated(forces%ustar)) deallocate(forces%ustar) - if (associated(forces%p_surf)) deallocate(forces%p_surf) - if (associated(forces%p_surf_full)) deallocate(forces%p_surf_full) + if (associated(forces%p_surf)) deallocate(forces%p_surf) + if (associated(forces%p_surf_full)) deallocate(forces%p_surf_full) if (associated(forces%net_mass_src)) deallocate(forces%net_mass_src) if (associated(forces%rigidity_ice_u)) deallocate(forces%rigidity_ice_u) if (associated(forces%rigidity_ice_v)) deallocate(forces%rigidity_ice_v) if (associated(forces%frac_shelf_u)) deallocate(forces%frac_shelf_u) if (associated(forces%frac_shelf_v)) deallocate(forces%frac_shelf_v) + if (associated(forces%area_berg)) deallocate(forces%area_berg) + if (associated(forces%mass_berg)) deallocate(forces%mass_berg) end subroutine deallocate_mech_forcing From 0faaf96679f02949de7a67619fe42b5f53ed62d2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 1 May 2018 13:13:50 -0400 Subject: [PATCH 0147/1072] Corrected index capitialization Corrected the capitalization of the indices in several arrays, to follow the MOM6 convention of lowercase indices at tracer points and capital indices at vorticity points. All answers are bitwise identical. --- src/core/MOM_barotropic.F90 | 4 ++-- src/parameterizations/vertical/MOM_set_viscosity.F90 | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index a21fbf39f1..b5401191e0 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1422,7 +1422,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & (CS%ice_strength_length**2 * dtbt) ! Units of dyn_coef: m2 s-2 H-1 - dyn_coef_eta(I,j) = min(dyn_coef_max, ice_strength * GV%H_to_m) + dyn_coef_eta(i,j) = min(dyn_coef_max, ice_strength * GV%H_to_m) enddo ; enddo ; endif endif @@ -1627,7 +1627,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & if (CS%dynamic_psurf) then !GOMP do do j=jsv-1,jev+1 ; do i=isv-1,iev+1 - p_surf_dyn(i,j) = dyn_coef_eta(I,j) * (eta_pred(i,j) - eta(i,j)) + p_surf_dyn(i,j) = dyn_coef_eta(i,j) * (eta_pred(i,j) - eta(i,j)) enddo ; enddo endif endif diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 90401313dc..5148be3379 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1617,12 +1617,12 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) do_any_shelf = .false. if (associated(forces%frac_shelf_v)) then - do I=Is,Ie + do i=is,ie if (forces%frac_shelf_v(i,J)*G%mask2dCv(i,J) == 0.0) then - do_i(I) = .false. + do_i(i) = .false. visc%tbl_thick_shelf_v(i,J) = 0.0 ; visc%kv_tbl_shelf_v(i,J) = 0.0 else - do_i(I) = .true. ; do_any_shelf = .true. + do_i(i) = .true. ; do_any_shelf = .true. endif enddo endif From 6570af397fe70bbb024a59146ee9d70582988ef5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 1 May 2018 13:14:28 -0400 Subject: [PATCH 0148/1072] Consolidated duplicate code setting rigidity_ice. Restructured add_shelf_flux to reduce the number of redundant expressions setting rigidity_ice_[uv], and to only set rigidity_ice_[uv] and frac_shelf_[uv] at the symmetric-grid velocity points, as these are the only values that are actually used. All answers are identical in the existing MOM6 test cases, but it is possible that these changes are not being adequately tested. --- src/ice_shelf/MOM_ice_shelf.F90 | 280 ++++++++------------------------ 1 file changed, 65 insertions(+), 215 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index abed2f8534..72ee1e2360 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -958,42 +958,35 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed Irho0 = 1.0 / CS%Rho0 - kv_rho_ice = CS%kv_ice / CS%density_ice ! Determine ustar and the square magnitude of the velocity in the ! bottom boundary layer. Together these give the TKE source and ! vertical decay scale. if (CS%shelf_mass_is_dynamic) then do j=jsd,jed ; do I=isd,ied-1 forces%frac_shelf_u(I,j) = 0.0 - if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%dxdy_u(I,j) > 0.0)) & + if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%areaCu(I,j) > 0.0)) & forces%frac_shelf_u(I,j) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i+1,j)) / & (G%areaT(i,j) + G%areaT(i+1,j))) - forces%rigidity_ice_u(I,j) = kv_rho_ice * & - min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) enddo ; enddo do J=jsd,jed-1 ; do i=isd,ied forces%frac_shelf_v(i,J) = 0.0 - if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%dxdy_v(i,J) > 0.0)) & + if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%areaCv(i,J) > 0.0)) & forces%frac_shelf_v(i,J) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i,j+1)) / & (G%areaT(i,j) + G%areaT(i,j+1))) - forces%rigidity_ice_v(i,J) = kv_rho_ice * & - min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) enddo ; enddo call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) - else - ! This is needed because rigidity is potentially modified in the coupler. Reset - ! in the ice shelf cavity: MJH + endif - do j=jsd,jed ; do i=isd,ied-1 ! changed stride - forces%rigidity_ice_u(I,j) = kv_rho_ice * & + ! For various reasons, forces%rigidity_ice_[uv] is always updated here. + kv_rho_ice = CS%kv_ice / CS%density_ice + do j=js,je ; do I=is-1,ie + forces%rigidity_ice_u(I,j) = kv_rho_ice * & min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) - enddo ; enddo - - do j=jsd,jed-1 ; do i=isd,ied ! changed stride - forces%rigidity_ice_v(i,J) = kv_rho_ice * & + enddo ; enddo + do J=js-1,je ; do i=is,ie + forces%rigidity_ice_v(i,J) = kv_rho_ice * & min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) - enddo ; enddo - endif + enddo ; enddo if (CS%debug) then if (associated(state%taux_shelf)) then @@ -1011,7 +1004,24 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) if (associated(state%taux_shelf) .and. associated(state%tauy_shelf)) then call pass_vector(state%taux_shelf, state%tauy_shelf, G%domain, TO_ALL, CGRID_NE) endif - + ! GMM: melting is computed using ustar_shelf (and not ustar), which has already + ! been passed, I so believe we do not need to update fluxes%ustar. +! do j=js,je ; do i=is,ie ; if (fluxes%frac_shelf_h(i,j) > 0.0) then + ! ### THIS SHOULD BE AN AREA WEIGHTED AVERAGE OF THE ustar_shelf POINTS. + ! taux2 = 0.0 ; tauy2 = 0.0 + ! asu1 = forces%frac_shelf_u(I-1,j) * G%areaCu(I-1,j) + ! asu2 = forces%frac_shelf_u(I,j) * G%areaCu(I,j) + ! asv1 = forces%frac_shelf_v(i,J-1) * G%areaCv(i,J-1) + ! asv2 = forces%frac_shelf_v(i,J) * G%areaCv(i,J) + ! if ((asu1 + asu2 > 0.0) .and. associated(state%taux_shelf)) & + ! taux2 = (asu1 * state%taux_shelf(I-1,j)**2 + & + ! asu2 * state%taux_shelf(I,j)**2 ) / (asu1 + asu2) + ! if ((asv1 + asv2 > 0.0) .and. associated(state%tauy_shelf)) & + ! tauy2 = (asv1 * state%tauy_shelf(i,J-1)**2 + & + ! asv2 * state%tauy_shelf(i,J)**2 ) / (asv1 + asv2) + + !fluxes%ustar(i,j) = MAX(CS%ustar_bg, sqrt(Irho0 * sqrt(taux2 + tauy2))) +! endif ; enddo ; enddo if (CS%shelf_mass_is_dynamic) then do j=jsd,jed ; do i=isd,ied @@ -1020,52 +1030,36 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) enddo ; enddo endif - do j=G%jsc,G%jec ; do i=G%isc,G%iec + do j=js,je ; do i=is,ie ; if (fluxes%frac_shelf_h(i,j) > 0.0) then frac_area = fluxes%frac_shelf_h(i,j) - if (frac_area > 0.0) then - ! ### THIS SHOULD BE AN AREA WEIGHTED AVERAGE OF THE ustar_shelf POINTS. - taux2 = 0.0 ; tauy2 = 0.0 - asu1 = forces%frac_shelf_u(i-1,j) * (G%areaT(i-1,j) + G%areaT(i,j)) ! G%dxdy_u(i-1,j) - asu2 = forces%frac_shelf_u(i,j) * (G%areaT(i,j) + G%areaT(i+1,j)) ! G%dxdy_u(i,j) - asv1 = forces%frac_shelf_v(i,j-1) * (G%areaT(i,j-1) + G%areaT(i,j)) ! G%dxdy_v(i,j-1) - asv2 = forces%frac_shelf_v(i,j) * (G%areaT(i,j) + G%areaT(i,j+1)) ! G%dxdy_v(i,j) - if ((asu1 + asu2 > 0.0) .and. associated(state%taux_shelf)) & - taux2 = (asu1 * state%taux_shelf(i-1,j)**2 + & - asu2 * state%taux_shelf(i,j)**2 ) / (asu1 + asu2) - if ((asv1 + asv2 > 0.0) .and. associated(state%tauy_shelf)) & - tauy2 = (asv1 * state%tauy_shelf(i,j-1)**2 + & - asv2 * state%tauy_shelf(i,j)**2 ) / (asv1 + asv2) - - ! GMM: melting is computed using ustar_shelf (and not ustar), which has already - ! been passed, so believe we do not need to update fluxes%ustar. - !fluxes%ustar(i,j) = MAX(CS%ustar_bg, sqrt(Irho0 * sqrt(taux2 + tauy2))) - - if (associated(fluxes%sw)) fluxes%sw(i,j) = 0.0 - if (associated(fluxes%sw_vis_dir)) fluxes%sw_vis_dir(i,j) = 0.0 - if (associated(fluxes%sw_vis_dif)) fluxes%sw_vis_dif(i,j) = 0.0 - if (associated(fluxes%sw_nir_dir)) fluxes%sw_nir_dir(i,j) = 0.0 - if (associated(fluxes%sw_nir_dif)) fluxes%sw_nir_dif(i,j) = 0.0 - if (associated(fluxes%lw)) fluxes%lw(i,j) = 0.0 - if (associated(fluxes%latent)) fluxes%latent(i,j) = 0.0 - if (associated(fluxes%evap)) fluxes%evap(i,j) = 0.0 - if (associated(fluxes%lprec)) then - if (CS%lprec(i,j) > 0.0) then - fluxes%lprec(i,j) = frac_area*CS%lprec(i,j)*CS%flux_factor - else - fluxes%lprec(i,j) = 0.0 - fluxes%evap(i,j) = frac_area*CS%lprec(i,j)*CS%flux_factor - endif + if (associated(fluxes%sw)) fluxes%sw(i,j) = 0.0 + if (associated(fluxes%sw_vis_dir)) fluxes%sw_vis_dir(i,j) = 0.0 + if (associated(fluxes%sw_vis_dif)) fluxes%sw_vis_dif(i,j) = 0.0 + if (associated(fluxes%sw_nir_dir)) fluxes%sw_nir_dir(i,j) = 0.0 + if (associated(fluxes%sw_nir_dif)) fluxes%sw_nir_dif(i,j) = 0.0 + if (associated(fluxes%lw)) fluxes%lw(i,j) = 0.0 + if (associated(fluxes%latent)) fluxes%latent(i,j) = 0.0 + if (associated(fluxes%evap)) fluxes%evap(i,j) = 0.0 + if (associated(fluxes%lprec)) then + if (CS%lprec(i,j) > 0.0) then + fluxes%lprec(i,j) = frac_area*CS%lprec(i,j)*CS%flux_factor + else + fluxes%lprec(i,j) = 0.0 + fluxes%evap(i,j) = frac_area*CS%lprec(i,j)*CS%flux_factor endif + endif - if (associated(fluxes%sens)) fluxes%sens(i,j) = -frac_area*CS%t_flux(i,j)*CS%flux_factor - if (associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = frac_area * CS%salt_flux(i,j)*CS%flux_factor - if (associated(fluxes%p_surf)) fluxes%p_surf(i,j) = frac_area * CS%g_Earth * CS%mass_shelf(i,j) - if (associated(fluxes%p_surf_full)) fluxes%p_surf_full(i,j) = & - frac_area * CS%g_Earth * CS%mass_shelf(i,j) + if (associated(fluxes%sens)) & + fluxes%sens(i,j) = -frac_area*CS%t_flux(i,j)*CS%flux_factor + if (associated(fluxes%salt_flux)) & + fluxes%salt_flux(i,j) = frac_area * CS%salt_flux(i,j)*CS%flux_factor + if (associated(fluxes%p_surf)) & + fluxes%p_surf(i,j) = frac_area * CS%g_Earth * CS%mass_shelf(i,j) + if (associated(fluxes%p_surf_full)) & + fluxes%p_surf_full(i,j) = frac_area * CS%g_Earth * CS%mass_shelf(i,j) - endif - enddo ; enddo + endif ; enddo ; enddo ! keep sea level constant by removing mass in the sponge ! region (via virtual precip, vprec). Apply additional @@ -1074,6 +1068,8 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) ! This is needed for some of the ISOMIP+ experiments. if (CS%constant_sea_level) then + !### This code has lots of problems with hard coded constants and the use of + !### of non-reproducing sums. I needs to be refactored. -RWH if (.not. associated(fluxes%salt_flux)) allocate(fluxes%salt_flux(ie,je)) if (.not. associated(fluxes%vprec)) allocate(fluxes%vprec(ie,je)) @@ -1157,26 +1153,10 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) if (CS%DEBUG) then if (is_root_pe()) write(*,*)'Mean melt flux (kg/(m^2 s)),dt',mean_melt_flux,CS%time_step call MOM_forcing_chksum("After constant sea level", fluxes, G, haloshift=0) - endif + endif endif!constant_sea_level - ! If the shelf mass is changing, the forces%rigidity_ice_[uv] needs to be - ! updated here. - - kv_rho_ice = CS%kv_ice / CS%density_ice - if (CS%shelf_mass_is_dynamic) then - do j=G%jsc,G%jec ; do i=G%isc-1,G%iec - forces%rigidity_ice_u(I,j) = kv_rho_ice * & - min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) - enddo ; enddo - - do j=G%jsc-1,G%jec ; do i=G%isc,G%iec - forces%rigidity_ice_v(i,J) = kv_rho_ice * & - min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) - enddo ; enddo - endif - end subroutine add_shelf_flux @@ -1197,6 +1177,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl type(vardesc) :: vd type(dyn_horgrid_type), pointer :: dG => NULL() real :: cdrag, drag_bg_vel + real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1. logical :: new_sim, save_IC, var_force !This include declares and sets the variable "version". #include "version_variable.h" @@ -1806,22 +1787,21 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl endif if (present(forces) .and. .not. CS%solo_ice_sheet) then - do j=jsd,jed ; do i=isd,ied-1 + kv_rho_ice = CS%kv_ice / CS%density_ice + do j=js,je ; do i=is-1,ie forces%frac_shelf_u(I,j) = 0.0 - if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%dxdy_u(I,j) > 0.0)) & + if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%areaCu(I,j) > 0.0)) & forces%frac_shelf_u(I,j) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i+1,j)) / & (G%areaT(i,j) + G%areaT(i+1,j))) - forces%rigidity_ice_u(I,j) = (CS%kv_ice / CS%density_ice) * & + forces%rigidity_ice_u(I,j) = kv_rho_ice * & min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) enddo ; enddo - - - do j=jsd,jed-1 ; do i=isd,ied + do j=js-1,je ; do i=is,ie forces%frac_shelf_v(i,J) = 0.0 - if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%dxdy_v(i,J) > 0.0)) & + if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%areaCv(i,J) > 0.0)) & forces%frac_shelf_v(i,J) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i,j+1)) / & (G%areaT(i,j) + G%areaT(i,j+1))) - forces%rigidity_ice_v(i,J) = (CS%kv_ice / CS%density_ice) * & + forces%rigidity_ice_v(i,J) = kv_rho_ice * & min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) enddo ; enddo endif @@ -6770,134 +6750,4 @@ end subroutine ice_shelf_advect_temp_y !! Holland, David M., and Adrian Jenkins. Modeling thermodynamic ice-ocean interactions at the base of an ice shelf. !! Journal of Physical Oceanography 29.8 (1999): 1787-1800. - - -! GMM, I am putting all the commented functions below - -! subroutine add_shelf_flux_IOB(CS, state, forces, fluxes) -! ! type(ice_ocean_boundary_type), intent(inout) :: IOB -! type(ice_shelf_CS), intent(in) :: CS -! type(surface), intent(inout) :: state -! type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces -! type(forcing), intent(inout) :: fluxes - -! ! Arguments: -! ! (in) fluxes - A structure of surface fluxes that may be used. -! ! (in) visc - A structure containing vertical viscosities, bottom boundary -! ! layer properies, and related fields. -! ! (in) G - The ocean's grid structure. -! ! (in) CS - This module's control structure. -! !need to use visc variables -! !time step therm v. dynamic? -! real :: Irho0 ! The inverse of the mean density in m3 kg-1. -! real :: frac_area ! The fractional area covered by the ice shelf, nondim. -! real :: taux2, tauy2 ! The squared surface stresses, in Pa. -! real :: asu1, asu2 ! Ocean areas covered by ice shelves at neighboring u- -! real :: asv1, asv2 ! and v-points, in m2. -! integer :: i, j, is, ie, js, je, isd, ied, jsd, jed -! type(ocean_grid_type), pointer :: G - -! G=>CS%grid -! is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec -! isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed - -! Irho0 = 1.0 / CS%Rho0 -! ! Determine ustar and the square magnitude of the velocity in the -! ! bottom boundary layer. Together these give the TKE source and -! ! vertical decay scale. -! if (CS%shelf_mass_is_dynamic) then -! do j=jsd,jed ; do i=isd,ied -! if (G%areaT(i,j) > 0.0) & -! fluxes%frac_shelf_h(i,j) = CS%area_shelf_h(i,j) / G%areaT(i,j) -! enddo ; enddo -! !do I=isd,ied-1 ; do j=isd,jed -! do j=jsd,jed ; do i=isd,ied-1 ! ### changed stride order; i->ied-1? -! forces%frac_shelf_u(I,j) = 0.0 -! if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%dxdy_u(I,j) > 0.0)) & -! forces%frac_shelf_u(I,j) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i+1,j)) / & -! (G%areaT(i,j) + G%areaT(i+1,j))) -! forces%rigidity_ice_u(I,j) = (CS%kv_ice / CS%density_ice) * & -! min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) -! enddo ; enddo -! do j=jsd,jed-1 ; do i=isd,ied ! ### change stride order; j->jed-1? -! !do i=isd,ied ; do J=isd,jed-1 -! forces%frac_shelf_v(i,J) = 0.0 -! if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%dxdy_v(i,J) > 0.0)) & -! forces%frac_shelf_v(i,J) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i,j+1)) / & -! (G%areaT(i,j) + G%areaT(i,j+1))) -! forces%rigidity_ice_v(i,J) = (CS%kv_ice / CS%density_ice) * & -! min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) -! enddo ; enddo -! call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) -! endif - -! if (CS%debug) then -! if (associated(state%taux_shelf)) then -! call uchksum(state%taux_shelf, "taux_shelf", G%HI, haloshift=0) -! endif -! if (associated(state%tauy_shelf)) then -! call vchksum(state%tauy_shelf, "tauy_shelf", G%HI, haloshift=0) -! endif -! endif - -! if (associated(state%taux_shelf) .and. associated(state%tauy_shelf)) then -! call pass_vector(state%taux_shelf, state%tauy_shelf, G%domain, TO_ALL, CGRID_NE) -! endif - -! do j=G%jsc,G%jec ; do i=G%isc,G%iec -! frac_area = fluxes%frac_shelf_h(i,j) -! if (frac_area > 0.0) then -! ! ### THIS SHOULD BE AN AREA WEIGHTED AVERAGE OF THE ustar_shelf POINTS. -! taux2 = 0.0 ; tauy2 = 0.0 -! asu1 = forces%frac_shelf_u(i-1,j) * (G%areaT(i-1,j) + G%areaT(i,j)) ! G%dxdy_u(i-1,j) -! asu2 = forces%frac_shelf_u(i,j) * (G%areaT(i,j) + G%areaT(i+1,j)) ! G%dxdy_u(i,j) -! asv1 = forces%frac_shelf_v(i,j-1) * (G%areaT(i,j-1) + G%areaT(i,j)) ! G%dxdy_v(i,j-1) -! asv2 = forces%frac_shelf_v(i,j) * (G%areaT(i,j) + G%areaT(i,j+1)) ! G%dxdy_v(i,j) -! if ((asu1 + asu2 > 0.0) .and. associated(state%taux_shelf)) & -! taux2 = (asu1 * state%taux_shelf(i-1,j)**2 + & -! asu2 * state%taux_shelf(i,j)**2 ) / (asu1 + asu2) -! if ((asv1 + asv2 > 0.0) .and. associated(state%tauy_shelf)) & -! tauy2 = (asv1 * state%tauy_shelf(i,j-1)**2 + & -! asv2 * state%tauy_shelf(i,j)**2 ) / (asv1 + asv2) -! fluxes%ustar_shelf(i,j) = MAX(CS%ustar_bg, sqrt(Irho0 * sqrt(taux2 + tauy2))) - -! if (CS%lprec(i,j) > 0.0) then -! fluxes%lprec(i,j) = fluxes%lprec(i,j) + frac_area*CS%lprec(i,j) -! ! Same for IOB%lprec -! else -! fluxes%evap(i,j) = fluxes%evap(i,j) + frac_area*CS%lprec(i,j) -! ! Same for -1*IOB%q_flux -! endif -! fluxes%sens(i,j) = fluxes%sens(i,j) - frac_area*CS%t_flux(i,j) -! ! Same for -1*IOB%t_flux -! ! fluxes%salt_flux(i,j) = fluxes%salt_flux(i,j) + frac_area * CS%salt_flux(i,j) -! ! ! Same for IOB%salt_flux. -! fluxes%p_surf(i,j) = fluxes%p_surf(i,j) + & -! frac_area * CS%g_Earth * CS%mass_shelf(i,j) -! ! Same for IOB%p -! if (associated(fluxes%p_surf_full)) fluxes%p_surf_full(i,j) = & -! fluxes%p_surf_full(i,j) + frac_area * CS%g_Earth * CS%mass_shelf(i,j) -! endif -! enddo ; enddo - -! if (CS%debug) then -! call hchksum(fluxes%ustar_shelf, "ustar_shelf", G%HI, haloshift=0) -! endif - -! ! If the shelf mass is changing, the forces%rigidity_ice_[uv] needs to be -! ! updated here. - -! if (CS%shelf_mass_is_dynamic) then -! do j=G%jsc,G%jec ; do i=G%isc-1,G%iec -! forces%rigidity_ice_u(I,j) = (CS%kv_ice / CS%density_ice) * & -! min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) -! enddo ; enddo - -! do j=G%jsc-1,G%jec ; do i=G%isc,G%iec -! forces%rigidity_ice_v(i,J) = (CS%kv_ice / CS%density_ice) * & -! min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) -! enddo ; enddo -! endif -! end subroutine add_shelf_flux_IOB - end module MOM_ice_shelf From e7ffe07f07743bed95eb97b26b6b41f72efb4612 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 1 May 2018 13:14:54 -0400 Subject: [PATCH 0149/1072] Store iceberg properties in forces Added code storing aggregate iceberg properties in the mech_forcing type from the Ice_ocean_boundary type. Also reduced the index range over which rigidity_ice_[uv] is set due to sea-ice to the range that is actually used. All answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 31 +++++++++----- config_src/coupled_driver/ocean_model_MOM.F90 | 40 +++++++++---------- 2 files changed, 39 insertions(+), 32 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 7de381f8c0..f832e76a8d 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -307,6 +307,12 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, 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, & @@ -417,11 +423,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & if (associated(IOB%calving)) & fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) - 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) = IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) @@ -628,6 +629,11 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, 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.) + + ! applied surface pressure from atmosphere and cryosphere if (associated(IOB%p)) then if (CS%max_p_surf >= 0.0) then @@ -657,6 +663,12 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, 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 (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 @@ -764,13 +776,10 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) ! sea ice related fields if (CS%rigid_sea_ice) then - ! The commented out code here and in the following lines is the correct - ! version, but the incorrect version is being retained temporarily to avoid - ! changing answers. - call pass_var(forces%p_surf_full, G%Domain) + call pass_var(forces%p_surf_full, G%Domain, halo=1) I_GEarth = 1.0 / G%G_Earth Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) - do I=isd,ied-1 ; do j=jsd,jed + do I=is-1,ie ; do j=js,je mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth mass_eff = 0.0 if (mass_ice > CS%rigid_sea_ice_mass) then @@ -781,7 +790,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) ! a maximum for the second call. forces%rigidity_ice_u(I,j) = Kv_rho_ice * mass_eff enddo ; enddo - do i=isd,ied ; do J=jsd,jed-1 + do i=is,ie ; do J=js-1,je mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i,j+1)) * I_GEarth mass_eff = 0.0 if (mass_ice > CS%rigid_sea_ice_mass) then diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index db59637ca6..5fd45f7ea4 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -24,10 +24,12 @@ module ocean_model_mod 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_vector, AGRID, BGRID_NE, CGRID_NE +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 @@ -59,10 +61,8 @@ module ocean_model_mod 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 MOM_forcing_type, only : allocate_forcing_type use fms_mod, only : stdout use mpp_mod, only : mpp_chksum -use MOM_domains, only : pass_var, pass_vector, TO_ALL, CGRID_NE, BGRID_NE 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 @@ -540,7 +540,6 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call shelf_calc_flux(OS%sfc_state, OS%forces, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) endif 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) @@ -565,7 +564,6 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call shelf_calc_flux(OS%sfc_state, OS%forces, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) endif 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 @@ -728,43 +726,43 @@ subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, density_ice, !the ocean model. This routine is taken from the add_shelf_flux subroutine !within the ice shelf model. - if (.not.(associated(fluxes%area_berg) .and. associated(fluxes%ustar_berg) .and. & - associated(fluxes%mass_berg) ) ) return + if (.not.(associated(forces%area_berg) .and. associated(forces%mass_berg) ) ) return if (.not.(associated(forces%frac_shelf_u) .and. associated(forces%frac_shelf_v) .and. & associated(forces%rigidity_ice_u) .and. associated(forces%rigidity_ice_v)) ) return + if (.not.(associated(fluxes%area_berg) .and. associated(fluxes%ustar_berg) .and. & + associated(fluxes%mass_berg) ) ) return if (.not.(associated(fluxes%frac_shelf_h) .and. associated(fluxes%ustar_shelf)) ) return ! This section sets or augments the values of fields in forces. if (.not. use_ice_shelf) then - forces%frac_shelf_u(:,:) = 0. - forces%frac_shelf_v(:,:) = 0. - forces%rigidity_ice_u(:,:) = 0. - forces%rigidity_ice_v(:,:) = 0. + forces%frac_shelf_u(:,:) = 0.0 ; forces%frac_shelf_v(:,:) = 0.0 + forces%rigidity_ice_u(:,:) = 0.0 ; forces%rigidity_ice_v(:,:) = 0.0 endif + call pass_var(forces%area_berg, G%domain, TO_ALL+Omit_corners, halo=1, complete=.false.) + call pass_var(forces%mass_berg, G%domain, TO_ALL+Omit_corners, halo=1, complete=.true.) kv_rho_ice = kv_ice / density_ice - do j=jsd,jed ; do I=isd,ied-1 - forces%frac_shelf_u(I,j) = 0.0 + do j=js,je ; do I=is-1,ie if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%dxdy_u(I,j) > 0.0)) & forces%frac_shelf_u(I,j) = forces%frac_shelf_u(I,j) + & - (((fluxes%area_berg(i,j)*G%areaT(i,j)) + & - (fluxes%area_berg(i+1,j)*G%areaT(i+1,j))) / & + (((forces%area_berg(i,j)*G%areaT(i,j)) + & + (forces%area_berg(i+1,j)*G%areaT(i+1,j))) / & (G%areaT(i,j) + G%areaT(i+1,j)) ) forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + kv_rho_ice * & - min(fluxes%mass_berg(i,j), fluxes%mass_berg(i+1,j)) + min(forces%mass_berg(i,j), forces%mass_berg(i+1,j)) enddo ; enddo - do J=jsd,jed-1 ; do i=isd,ied - forces%frac_shelf_v(i,J) = 0.0 + do J=js-1,je ; do i=is,ie if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%dxdy_v(i,J) > 0.0)) & forces%frac_shelf_v(i,J) = forces%frac_shelf_v(i,J) + & - (((fluxes%area_berg(i,j)*G%areaT(i,j)) + & - (fluxes%area_berg(i,j+1)*G%areaT(i,j+1))) / & + (((forces%area_berg(i,j)*G%areaT(i,j)) + & + (forces%area_berg(i,j+1)*G%areaT(i,j+1))) / & (G%areaT(i,j) + G%areaT(i,j+1)) ) forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + kv_rho_ice * & - min(fluxes%mass_berg(i,j), fluxes%mass_berg(i,j+1)) + min(forces%mass_berg(i,j), forces%mass_berg(i,j+1)) enddo ; enddo + !### This halo update may be unnecessary. Test it. -RWH call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) ! The remaining code sets or augments the values of fields in fluxes. From 17c4ffa8f967c210d992e3991e001f0d11f90ac1 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Tue, 1 May 2018 11:30:59 -0800 Subject: [PATCH 0150/1072] Added OBC_COMPUTED_STRAIN option. - slight improvement to dumbbell. --- src/core/MOM_open_boundary.F90 | 21 ++++++++++++++----- .../lateral/MOM_hor_visc.F90 | 14 ++++++++++++- 2 files changed, 29 insertions(+), 6 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index b017aadd55..1a4a60024c 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -197,6 +197,8 @@ module MOM_open_boundary logical :: zero_strain = .false. !< If True, sets strain to zero on open boundaries. logical :: freeslip_strain = .false. !< If True, sets normal gradient of tangential velocity to zero !! in the strain on open boundaries. + logical :: computed_strain = .false. !< If True, uses external data for tangential velocity to compute + !! normal gradient in the strain on open boundaries. logical :: zero_biharmonic = .false. !< If True, zeros the Laplacian of flow on open boundaries for !! use in the biharmonic viscosity term. logical :: brushcutter_mode = .false. !< If True, read data on supergrid. @@ -309,7 +311,9 @@ subroutine open_boundary_config(G, param_file, OBC) "If true, uses the external values of tangential velocity\n"// & "in the relative vorticity on open boundaries. This cannot\n"// & "be true if OBC_ZERO_VORTICITY or OBC_FREESLIP_VORTICITY is True.", default=.false.) - if (OBC%zero_vorticity .and. OBC%freeslip_vorticity .and. OBC%computed_vorticity) & + if ((OBC%zero_vorticity .and. OBC%freeslip_vorticity) .or. & + (OBC%zero_vorticity .and. OBC%computed_vorticity) .or. & + (OBC%freeslip_vorticity .and. OBC%computed_vorticity)) & call MOM_error(FATAL, "MOM_open_boundary.F90, open_boundary_config:\n"//& "Only one of OBC_ZERO_VORTICITY, OBC_FREESLIP_VORTICITY and OBC_COMPUTED_VORTICITY\n"//& "can be True at once.") @@ -319,10 +323,17 @@ subroutine open_boundary_config(G, param_file, OBC) call get_param(param_file, mdl, "OBC_FREESLIP_STRAIN", OBC%freeslip_strain, & "If true, sets the normal gradient of tangential velocity to\n"// & "zero in the strain use in the stress tensor on open boundaries. This cannot\n"// & - "be true if OBC_ZERO_STRAIN is True.", default=.false.) - if (OBC%zero_strain .and. OBC%freeslip_strain) call MOM_error(FATAL, & - "MOM_open_boundary.F90, open_boundary_config: "//& - "Only one of OBC_ZERO_STRAIN and OBC_FREESLIP_STRAIN can be True at once.") + "be true if OBC_ZERO_STRAIN or OBC_COMPUTED_STRAIN is True.", default=.false.) + call get_param(param_file, mdl, "OBC_COMPUTED_STRAIN", OBC%computed_strain, & + "If true, sets the normal gradient of tangential velocity to\n"// & + "zero in the strain use in the stress tensor on open boundaries. This cannot\n"// & + "be true if OBC_ZERO_STRAIN or OBC_FREESLIP_STRAIN is True.", default=.false.) + if ((OBC%zero_strain .and. OBC%freeslip_strain) .or. & + (OBC%zero_strain .and. OBC%computed_strain) .or. & + (OBC%freeslip_strain .and. OBC%computed_strain)) & + call MOM_error(FATAL, "MOM_open_boundary.F90, open_boundary_config:\n"//& + "Only one of OBC_ZERO_STRAIN, OBC_FREESLIP_STRAIN and OBC_COMPUTED_STRAIN\n"//& + "can be True at once.") call get_param(param_file, mdl, "OBC_ZERO_BIHARMONIC", OBC%zero_biharmonic, & "If true, zeros the Laplacian of flow on open boundaries in the biharmonic\n"//& "viscosity term.", default=.false.) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 0e02cefba2..85bb438f8f 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -443,13 +443,19 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, ! thicknesses on open boundaries. if (apply_OBC) then ; do n=1,OBC%number_of_segments J = OBC%segment(n)%HI%JsdB ; I = OBC%segment(n)%HI%IsdB - if (OBC%zero_strain .or. OBC%freeslip_strain) then + if (OBC%zero_strain .or. OBC%freeslip_strain .or. OBC%computed_strain) then if (OBC%segment(n)%is_N_or_S .and. (J >= js-2) .and. (J <= Jeq+1)) then do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB if (OBC%zero_strain) then dvdx(I,J) = 0. ; dudy(I,J) = 0. elseif (OBC%freeslip_strain) then dudy(I,J) = 0. + elseif (OBC%computed_strain) then + if (OBC%segment(n)%direction == OBC_DIRECTION_N) then + dudy(I,J) = CS%DX_dyBu(I,J)*(OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%IdxCu(I,j) + else + dudy(I,J) = CS%DX_dyBu(I,J)*(u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdxCu(I,j+1) + endif endif enddo elseif (OBC%segment(n)%is_E_or_W .and. (I >= is-2) .and. (I <= Ieq+1)) then @@ -458,6 +464,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, dvdx(I,J) = 0. ; dudy(I,J) = 0. elseif (OBC%freeslip_strain) then dvdx(I,J) = 0. + elseif (OBC%computed_strain) then + if (OBC%segment(n)%direction == OBC_DIRECTION_E) then + dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)*(OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%IdyCv(i,J) + else + dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)*(v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdyCv(i+1,J) + endif endif enddo endif From 9ca0b159b9c90a3dc29237517b1cc55b03923098 Mon Sep 17 00:00:00 2001 From: matthew harrison Date: Wed, 2 May 2018 13:27:45 -0400 Subject: [PATCH 0151/1072] ensure that new_sponges logical is set properly --- .../vertical/MOM_ALE_sponge.F90 | 19 +++++-------------- 1 file changed, 5 insertions(+), 14 deletions(-) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index e42601d51b..9eac0285e8 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -21,7 +21,7 @@ module MOM_ALE_sponge use MOM_time_manager, only : time_type, init_external_field, get_external_field_size, time_interp_external_init use MOM_remapping, only : remapping_cs, remapping_core_h, initialize_remapping use MOM_horizontal_regridding, only : horiz_interp_and_extrap_tracer - +use mpp_mod, only : mpp_pe ! GMM - Planned extension: Support for time varying sponge targets. implicit none ; private @@ -166,6 +166,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ "PPM reconstruction will also be used within boundary cells.", & default=.false., do_not_log=.true.) + CS%new_sponges = .false. CS%nz = G%ke CS%isc = G%isc ; CS%iec = G%iec ; CS%jsc = G%jsc ; CS%jec = G%jec CS%isd = G%isd ; CS%ied = G%ied ; CS%jsd = G%jsd ; CS%jed = G%jed @@ -178,13 +179,10 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ CS%num_col = CS%num_col + 1 enddo ; enddo - if (CS%num_col > 0) then - allocate(CS%Iresttime_col(CS%num_col)) ; CS%Iresttime_col = 0.0 allocate(CS%col_i(CS%num_col)) ; CS%col_i = 0 allocate(CS%col_j(CS%num_col)) ; CS%col_j = 0 - ! pass indices, restoring time to the CS structure col = 1 do j=G%jsc,G%jec ; do i=G%isc,G%iec @@ -194,16 +192,12 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ col = col +1 endif enddo ; enddo - ! same for total number of arbritary layers and correspondent data CS%nz_data = nz_data allocate(CS%Ref_h%p(CS%nz_data,CS%num_col)) do col=1,CS%num_col ; do K=1,CS%nz_data CS%Ref_h%p(K,col) = data_h(CS%col_i(col),CS%col_j(col),K) enddo; enddo - CS%new_sponges = .false. - - endif total_sponge_cols = CS%num_col @@ -354,6 +348,7 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) "PPM reconstruction will also be used within boundary cells.", & default=.false., do_not_log=.true.) + CS%new_sponges = .true. CS%nz = G%ke CS%isc = G%isc ; CS%iec = G%iec ; CS%jsc = G%jsc ; CS%jec = G%jec CS%isd = G%isd ; CS%ied = G%ied ; CS%jsd = G%jsd ; CS%jed = G%jed @@ -368,11 +363,9 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) if (CS%num_col > 0) then - allocate(CS%Iresttime_col(CS%num_col)) ; CS%Iresttime_col = 0.0 allocate(CS%col_i(CS%num_col)) ; CS%col_i = 0 allocate(CS%col_j(CS%num_col)) ; CS%col_j = 0 - ! pass indices, restoring time to the CS structure col = 1 do j=G%jsc,G%jec ; do i=G%isc,G%iec @@ -382,9 +375,6 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) col = col +1 endif enddo ; enddo - - CS%new_sponges = .true. - endif total_sponge_cols = CS%num_col @@ -821,7 +811,8 @@ subroutine apply_ALE_sponge(h, dt, G, CS, Time) deallocate(sp_val, mask_z) enddo - else + else + print *,'CS%nz_data= ',mpp_pe(),CS%nz_data nz_data = CS%nz_data endif From 968597521a676ad8cf8f83109e74fe6a6b8c089a Mon Sep 17 00:00:00 2001 From: matthew harrison Date: Wed, 2 May 2018 13:34:58 -0400 Subject: [PATCH 0152/1072] cleanup --- src/parameterizations/vertical/MOM_ALE_sponge.F90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 9eac0285e8..99ca06bb66 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -21,7 +21,6 @@ module MOM_ALE_sponge use MOM_time_manager, only : time_type, init_external_field, get_external_field_size, time_interp_external_init use MOM_remapping, only : remapping_cs, remapping_core_h, initialize_remapping use MOM_horizontal_regridding, only : horiz_interp_and_extrap_tracer -use mpp_mod, only : mpp_pe ! GMM - Planned extension: Support for time varying sponge targets. implicit none ; private @@ -811,8 +810,7 @@ subroutine apply_ALE_sponge(h, dt, G, CS, Time) deallocate(sp_val, mask_z) enddo - else - print *,'CS%nz_data= ',mpp_pe(),CS%nz_data + else nz_data = CS%nz_data endif From 75b6ee0369f521a625836938f5a1886b79279a5a Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 2 May 2018 09:38:39 -0800 Subject: [PATCH 0153/1072] Fix indexing? --- src/core/MOM_open_boundary.F90 | 73 ++++++++++++++++++++++++---------- 1 file changed, 51 insertions(+), 22 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 1a4a60024c..7f9e1ecaab 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -136,6 +136,8 @@ module MOM_open_boundary !! segment (m s-1). real, pointer, dimension(:,:,:) :: tangential_vel=>NULL() !< The layer velocity tangential to the !! OB segment (m s-1). + real, pointer, dimension(:,:,:) :: tangential_grad=>NULL() !< The gradient of the velocity tangential + !! to the OB segment (m s-1). real, pointer, dimension(:,:,:) :: normal_trans=>NULL() !< The layer transport normal to the OB !! segment (m3 s-1). real, pointer, dimension(:,:) :: normal_vel_bt=>NULL() !< The barotropic velocity normal to @@ -194,11 +196,15 @@ module MOM_open_boundary !! in the relative vorticity on open boundaries. logical :: computed_vorticity = .false. !< If True, uses external data for tangential velocity !! in the relative vorticity on open boundaries. + logical :: imported_vorticity = .false. !< If True, uses external data for tangential velocity + !! gradients in the relative vorticity on open boundaries. logical :: zero_strain = .false. !< If True, sets strain to zero on open boundaries. logical :: freeslip_strain = .false. !< If True, sets normal gradient of tangential velocity to zero !! in the strain on open boundaries. logical :: computed_strain = .false. !< If True, uses external data for tangential velocity to compute !! normal gradient in the strain on open boundaries. + logical :: imported_strain = .false. !< If True, uses external data for tangential velocity gradients + !! to compute strain on open boundaries. logical :: zero_biharmonic = .false. !< If True, zeros the Laplacian of flow on open boundaries for !! use in the biharmonic viscosity term. logical :: brushcutter_mode = .false. !< If True, read data on supergrid. @@ -306,34 +312,48 @@ subroutine open_boundary_config(G, param_file, OBC) call get_param(param_file, mdl, "OBC_FREESLIP_VORTICITY", OBC%freeslip_vorticity, & "If true, sets the normal gradient of tangential velocity to\n"// & "zero in the relative vorticity on open boundaries. This cannot\n"// & - "be true if OBC_ZERO_VORTICITY is True.", default=.false.) + "be true if another OBC_XXX_VORTICITY option is True.", default=.false.) call get_param(param_file, mdl, "OBC_COMPUTED_VORTICITY", OBC%computed_vorticity, & "If true, uses the external values of tangential velocity\n"// & "in the relative vorticity on open boundaries. This cannot\n"// & - "be true if OBC_ZERO_VORTICITY or OBC_FREESLIP_VORTICITY is True.", default=.false.) + "be true if another OBC_XXX_VORTICITY option is True.", default=.false.) + call get_param(param_file, mdl, "OBC_IMPORTED_VORTICITY", OBC%imported_vorticity, & + "If true, uses the external values of tangential velocity\n"// & + "in the relative vorticity on open boundaries. This cannot\n"// & + "be true if another OBC_XXX_VORTICITY option is True.", default=.false.) if ((OBC%zero_vorticity .and. OBC%freeslip_vorticity) .or. & (OBC%zero_vorticity .and. OBC%computed_vorticity) .or. & - (OBC%freeslip_vorticity .and. OBC%computed_vorticity)) & + (OBC%zero_vorticity .and. OBC%imported_vorticity) .or. & + (OBC%freeslip_vorticity .and. OBC%computed_vorticity) .or. & + (OBC%freeslip_vorticity .and. OBC%imported_vorticity) .or. & + (OBC%computed_vorticity .and. OBC%imported_vorticity)) & call MOM_error(FATAL, "MOM_open_boundary.F90, open_boundary_config:\n"//& - "Only one of OBC_ZERO_VORTICITY, OBC_FREESLIP_VORTICITY and OBC_COMPUTED_VORTICITY\n"//& - "can be True at once.") + "Only one of OBC_ZERO_VORTICITY, OBC_FREESLIP_VORTICITY, OBC_COMPUTED_VORTICITY\n"//& + "and OBC_IMPORTED_VORTICITY can be True at once.") call get_param(param_file, mdl, "OBC_ZERO_STRAIN", OBC%zero_strain, & "If true, sets the strain used in the stress tensor to zero on open boundaries.", & default=.false.) call get_param(param_file, mdl, "OBC_FREESLIP_STRAIN", OBC%freeslip_strain, & "If true, sets the normal gradient of tangential velocity to\n"// & "zero in the strain use in the stress tensor on open boundaries. This cannot\n"// & - "be true if OBC_ZERO_STRAIN or OBC_COMPUTED_STRAIN is True.", default=.false.) + "be true if another OBC_XXX_STRAIN option is True.", default=.false.) call get_param(param_file, mdl, "OBC_COMPUTED_STRAIN", OBC%computed_strain, & "If true, sets the normal gradient of tangential velocity to\n"// & "zero in the strain use in the stress tensor on open boundaries. This cannot\n"// & - "be true if OBC_ZERO_STRAIN or OBC_FREESLIP_STRAIN is True.", default=.false.) + "be true if another OBC_XXX_STRAIN option is True.", default=.false.) + call get_param(param_file, mdl, "OBC_IMPORTED_STRAIN", OBC%imported_strain, & + "If true, sets the normal gradient of tangential velocity to\n"// & + "zero in the strain use in the stress tensor on open boundaries. This cannot\n"// & + "be true if another OBC_XXX_STRAIN option is True.", default=.false.) if ((OBC%zero_strain .and. OBC%freeslip_strain) .or. & (OBC%zero_strain .and. OBC%computed_strain) .or. & - (OBC%freeslip_strain .and. OBC%computed_strain)) & + (OBC%zero_strain .and. OBC%imported_strain) .or. & + (OBC%freeslip_strain .and. OBC%computed_strain) .or. & + (OBC%freeslip_strain .and. OBC%imported_strain) .or. & + (OBC%computed_strain .and. OBC%imported_strain)) & call MOM_error(FATAL, "MOM_open_boundary.F90, open_boundary_config:\n"//& - "Only one of OBC_ZERO_STRAIN, OBC_FREESLIP_STRAIN and OBC_COMPUTED_STRAIN\n"//& - "can be True at once.") + "Only one of OBC_ZERO_STRAIN, OBC_FREESLIP_STRAIN, OBC_COMPUTED_STRAIN\n"//& + "and OBC_IMPORTED_STRAIN can be True at once.") call get_param(param_file, mdl, "OBC_ZERO_BIHARMONIC", OBC%zero_biharmonic, & "If true, zeros the Laplacian of flow on open boundaries in the biharmonic\n"//& "viscosity term.", default=.false.) @@ -1941,12 +1961,16 @@ subroutine allocate_OBC_segment_data(OBC, segment) if (segment%nudged) then allocate(segment%nudged_normal_vel(IsdB:IedB,jsd:jed,OBC%ke)); segment%nudged_normal_vel(:,:,:)=0.0 endif - if (OBC%computed_vorticity .or. segment%nudged_tan .or. segment%specified_tan) then + if (OBC%computed_vorticity .or. segment%nudged_tan .or. segment%specified_tan .or. & + OBC%computed_strain) then allocate(segment%tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_vel(:,:,:)=0.0 endif if (segment%nudged_tan) then allocate(segment%nudged_tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_vel(:,:,:)=0.0 endif + if (OBC%imported_vorticity .or. OBC%imported_strain) then + allocate(segment%tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_grad(:,:,:)=0.0 + endif if (segment%oblique) then allocate(segment%grad_normal(JsdB:JedB,2,OBC%ke)); segment%grad_normal(:,:,:) = 0.0 allocate(segment%rx_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%rx_normal(:,:,:)=0.0 @@ -1970,12 +1994,16 @@ subroutine allocate_OBC_segment_data(OBC, segment) if (segment%nudged) then allocate(segment%nudged_normal_vel(isd:ied,JsdB:JedB,OBC%ke)); segment%nudged_normal_vel(:,:,:)=0.0 endif - if (OBC%computed_vorticity .or. segment%nudged_tan .or. segment%specified_tan) then + if (OBC%computed_vorticity .or. segment%nudged_tan .or. segment%specified_tan .or. & + OBC%computed_strain) then allocate(segment%tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_vel(:,:,:)=0.0 endif if (segment%nudged_tan) then allocate(segment%nudged_tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_vel(:,:,:)=0.0 endif + if (OBC%imported_vorticity .or. OBC%imported_strain) then + allocate(segment%tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_grad(:,:,:)=0.0 + endif if (segment%oblique) then allocate(segment%grad_normal(IsdB:IedB,2,OBC%ke)); segment%grad_normal(:,:,:) = 0.0 allocate(segment%rx_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%rx_normal(:,:,:)=0.0 @@ -2007,6 +2035,7 @@ subroutine deallocate_OBC_segment_data(OBC, segment) if (associated (segment%nudged_normal_vel)) deallocate(segment%nudged_normal_vel) if (associated (segment%tangential_vel)) deallocate(segment%tangential_vel) if (associated (segment%nudged_tangential_vel)) deallocate(segment%nudged_tangential_vel) + if (associated (segment%tangential_grad)) deallocate(segment%tangential_grad) if (associated (segment%tr_Reg)) call segment_tracer_registry_end(segment%tr_Reg) @@ -2140,10 +2169,10 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) ni_seg = segment%ie_obc-segment%is_obc+1 nj_seg = segment%je_obc-segment%js_obc+1 - is_obc = max(segment%is_obc,isd-1) - ie_obc = min(segment%ie_obc,ied) - js_obc = max(segment%js_obc,jsd-1) - je_obc = min(segment%je_obc,jed) + is_obc = max(segment%is_obc,isd+1) + ie_obc = min(segment%ie_obc,ied-1) + js_obc = max(segment%js_obc,jsd+1) + je_obc = min(segment%je_obc,jed-1) ! Calculate auxiliary fields at staggered locations. ! Segment indices are on q points: @@ -2200,7 +2229,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (siz(3) /= segment%field(m)%nk_src) call MOM_error(FATAL,'nk_src inconsistency') if (segment%field(m)%nk_src > 1) then if (segment%is_E_or_W) then - if (segment%field(m)%name == 'V') then + if (segment%field(m)%name == 'V' .or. segment%field(m)%name == 'DVDX') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) else allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc+1:je_obc,G%ke)) @@ -2210,7 +2239,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) segment%field(m)%bt_vel(:,:)=0.0 endif else - if (segment%field(m)%name == 'U') then + if (segment%field(m)%name == 'U' .or. segment%field(m)%name == 'DUDY') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) else allocate(segment%field(m)%buffer_dst(is_obc+1:ie_obc,js_obc:je_obc,G%ke)) @@ -2222,7 +2251,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) endif else if (segment%is_E_or_W) then - if (segment%field(m)%name == 'V') then + if (segment%field(m)%name == 'V' .or. segment%field(m)%name == 'DVDX') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,1)) else allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc+1:je_obc,1)) @@ -2232,7 +2261,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) segment%field(m)%bt_vel(:,:)=0.0 endif else - if (segment%field(m)%name == 'U') then + if (segment%field(m)%name == 'U' .or. segment%field(m)%name == 'DUDY') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,1)) else allocate(segment%field(m)%buffer_dst(is_obc+1:ie_obc,js_obc:je_obc,1)) @@ -2263,13 +2292,13 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) call time_interp_external(segment%field(m)%fid,Time, tmp_buffer) if (OBC%brushcutter_mode) then if (segment%is_E_or_W) then - if (segment%field(m)%name == 'V') then + if (segment%field(m)%name == 'V' .or. segment%field(m)%name == 'DVDX') then segment%field(m)%buffer_src(is_obc,:,:)=tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset)+1:2,:) else segment%field(m)%buffer_src(is_obc,:,:)=tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset):2,:) endif else - if (segment%field(m)%name == 'U') then + if (segment%field(m)%name == 'U' .or. segment%field(m)%name == 'DUDY') then segment%field(m)%buffer_src(:,js_obc,:)=tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset)+1:2,1,:) else segment%field(m)%buffer_src(:,js_obc,:)=tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset):2,1,:) From 85ea88e95112fac91e1752d27e35b536b0e9add0 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 2 May 2018 10:40:39 -0800 Subject: [PATCH 0154/1072] Better fix to array-bounds trouble --- src/core/MOM_open_boundary.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 7f9e1ecaab..32b9f6d197 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -2169,10 +2169,10 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) ni_seg = segment%ie_obc-segment%is_obc+1 nj_seg = segment%je_obc-segment%js_obc+1 - is_obc = max(segment%is_obc,isd+1) - ie_obc = min(segment%ie_obc,ied-1) - js_obc = max(segment%js_obc,jsd+1) - je_obc = min(segment%je_obc,jed-1) + is_obc = max(segment%is_obc,isd-1) + ie_obc = min(segment%ie_obc,ied) + js_obc = max(segment%js_obc,jsd-1) + je_obc = min(segment%je_obc,jed) ! Calculate auxiliary fields at staggered locations. ! Segment indices are on q points: @@ -2357,7 +2357,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) I=is_obc if (segment%field(m)%name == 'V') then ! Do q points for the whole segment - do J=js_obc,je_obc + do J=max(js_obc,jsd),min(je_obc,jed-1) ! Using the h remapping approach ! Pretty sure we need to check for source/target grid consistency here segment%field(m)%buffer_dst(I,J,:)=0.0 ! initialize remap destination buffer @@ -2400,7 +2400,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) J=js_obc if (segment%field(m)%name == 'U') then ! Do q points for the whole segment - do I=is_obc,ie_obc + do I=max(is_obc,isd),min(ie_obc,ied-1) segment%field(m)%buffer_dst(I,J,:)=0.0 ! initialize remap destination buffer if (G%mask2dCv(i,J)>0. .and. G%mask2dCv(i+1,J)>0.) then ! Using the h remapping approach From 8eba1c94c6753d4ec52278a5b824692fb1ebc88b Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 2 May 2018 11:22:57 -0800 Subject: [PATCH 0155/1072] Fix MATT's trailing space. --- src/parameterizations/vertical/MOM_ALE_sponge.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 99ca06bb66..cff8b6e372 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -347,7 +347,7 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) "PPM reconstruction will also be used within boundary cells.", & default=.false., do_not_log=.true.) - CS%new_sponges = .true. + CS%new_sponges = .true. CS%nz = G%ke CS%isc = G%isc ; CS%iec = G%iec ; CS%jsc = G%jsc ; CS%jec = G%jec CS%isd = G%isd ; CS%ied = G%ied ; CS%jsd = G%jsd ; CS%jed = G%jed From 05a2e5985425c7bccdf406786c0094525e0a7f2b Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 2 May 2018 14:53:02 -0600 Subject: [PATCH 0156/1072] debug 3d tidal energy remapping --- .../vertical/MOM_tidal_mixing.F90 | 101 +++++++++++++----- 1 file changed, 73 insertions(+), 28 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index c0dd6e1796..37b187878d 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -17,7 +17,7 @@ module MOM_tidal_mixing use MOM_file_parser, only : openParameterBlock, closeParameterBlock use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_string_functions, only : uppercase, lowercase -use MOM_io, only : slasher, MOM_read_data, vardesc, var_desc +use MOM_io, only : slasher, MOM_read_data, vardesc, var_desc, field_size use cvmix_tidal, only : cvmix_init_tidal, cvmix_compute_Simmons_invariant use cvmix_tidal, only : cvmix_coeffs_tidal, cvmix_tidal_params_type use cvmix_tidal, only : cvmix_compute_Schmittner_invariant, cvmix_compute_SchmittnerCoeff @@ -51,7 +51,8 @@ module MOM_tidal_mixing Kd_Lowmode_Work => NULL(),& ! layer integrated work by low mode driven mixing (W/m2) BDM N2_int => NULL(),& vert_dep_3d => NULL(),& - Schmittner_coeff_3d => NULL() + Schmittner_coeff_3d => NULL(),& + tidal_qe_md => NULL() real, pointer, dimension(:,:) :: & TKE_itidal_used => NULL(),& ! internal tide TKE input at ocean bottom (W/m2) @@ -147,8 +148,8 @@ module MOM_tidal_mixing real, pointer, dimension(:,:) :: Nb => NULL() real, pointer, dimension(:,:) :: mask_itidal => NULL() real, pointer, dimension(:,:) :: h2 => NULL() - real, pointer, dimension(:,:) :: tideamp => NULL() ! RMS tidal amplitude (m/s) - real, allocatable, dimension(:) :: h_src ! tidal constituent input layer thickness + real, pointer, dimension(:,:) :: tideamp => NULL() !< RMS tidal amplitude [m/s] + real, allocatable, dimension(:) :: h_src !< tidal constituent input layer thickness [m] real, allocatable ,dimension(:,:) :: tidal_qe_2d ! q*E(x,y) ! TODO: make this E(x,y) only real, allocatable ,dimension(:,:,:) :: tidal_qe_3d_in ! q*E(x,y) @@ -179,6 +180,7 @@ module MOM_tidal_mixing integer :: id_N2_int = -1 integer :: id_Simmons_coeff = -1 integer :: id_Schmittner_coeff = -1 + integer :: id_tidal_qe_md = -1 integer :: id_vert_dep = -1 end type tidal_mixing_cs @@ -557,8 +559,10 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, ! TODO: add units CS%id_Simmons_coeff = register_diag_field('ocean_model','Simmons_coeff',diag%axesT1,Time, & 'time-invariant portion of the tidal mixing coefficient using the Simmons', '') - CS%id_Schmittner_coeff = register_diag_field('ocean_model','Schmittner_coeff',diag%axesTi,Time, & + CS%id_Schmittner_coeff = register_diag_field('ocean_model','Schmittner_coeff',diag%axesTL,Time, & 'time-invariant portion of the tidal mixing coefficient using the Schmittner', '') + CS%id_tidal_qe_md = register_diag_field('ocean_model','tidal_qe_md',diag%axesTL,Time, & + 'input tidal energy dissipated locally interpolated to model vertical coordinates', '') CS%id_vert_dep = register_diag_field('ocean_model','vert_dep',diag%axesTi,Time, & 'vertical deposition function needed for Simmons et al tidal mixing', '') @@ -673,7 +677,7 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) real, dimension(SZK_(G)+1) :: Kv_tidal !< tidal viscosity [m2/s] real, dimension(SZK_(G)+1) :: vert_dep !< vertical deposition real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) - real, dimension(SZK_(G)+1) :: SchmittnerSocn + real, dimension(SZK_(G)+1) :: SchmittnerSocn real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m) real, dimension(SZK_(G)) :: tidal_qe_md !< Tidal dissipation energy interpolated from 3d input to model coordinates real, dimension(SZK_(G)) :: Schmittner_coeff @@ -796,7 +800,8 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) ! remap from input z coordinate to model coordinate: tidal_qe_md = 0.0 - call remapping_core_h(CS%remap_cs, G%ke, CS%h_src, CS%tidal_qe_3d_in(i,j,:), G%ke, h_m, tidal_qe_md) + call remapping_core_h(CS%remap_cs, size(CS%h_src), CS%h_src, CS%tidal_qe_3d_in(i,j,:), & + G%ke, h_m, tidal_qe_md) ! form the Schmittner coefficient that is based on 3D q*E, which is formed from ! summing q_i*TidalConstituent_i over the number of constituents. @@ -811,7 +816,7 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) call cvmix_coeffs_tidal_schmittner( Mdiff_out = Kv_tidal, & Tdiff_out = Kd_tidal, & Nsqr = N2_int(i,:), & - OceanDepth = -iFaceHeight(G%ke+1), & + OceanDepth = -iFaceHeight(G%ke+1), & vert_dep = vert_dep, & nlev = G%ke, & max_nlev = G%ke, & @@ -825,7 +830,6 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) !TODO: Kv(i,j,k) = ???????????? enddo - ! diagnostics ! diagnostics if (associated(dd%Kd_itidal)) then dd%Kd_itidal(i,j,:) = Kd_tidal(:) @@ -836,6 +840,9 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) if (associated(dd%Schmittner_coeff_3d)) then dd%Schmittner_coeff_3d(i,j,:) = Schmittner_coeff(:) endif + if (associated(dd%tidal_qe_md)) then + dd%tidal_qe_md(i,j,:) = tidal_qe_md(:) + endif if (associated(dd%vert_dep_3d)) then dd%vert_dep_3d(i,j,:) = vert_dep(:) endif @@ -1312,14 +1319,29 @@ subroutine setup_tidal_diagnostics(G,CS) allocate(dd%N2_int(isd:ied,jsd:jed,nz+1)) ; dd%N2_int(:,:,:) = 0.0 endif if (CS%id_Simmons_coeff > 0) then + if (CS%cvmix_tidal_scheme .ne. SIMMONS) then + call MOM_error(FATAL, "setup_tidal_diagnostics: Simmons_coeff diagnostics is available "//& + "only when cvmix_tidal_scheme is Simmons") + endif allocate(dd%Simmons_coeff_2d(isd:ied,jsd:jed)) ; dd%Simmons_coeff_2d(:,:) = 0.0 endif if (CS%id_vert_dep > 0) then allocate(dd%vert_dep_3d(isd:ied,jsd:jed,nz+1)) ; dd%vert_dep_3d(:,:,:) = 0.0 endif if (CS%id_Schmittner_coeff > 0) then + if (CS%cvmix_tidal_scheme .ne. SCHMITTNER) then + call MOM_error(FATAL, "setup_tidal_diagnostics: Schmittner_coeff diagnostics is available "//& + "only when cvmix_tidal_scheme is Schmittner.") + endif allocate(dd%Schmittner_coeff_3d(isd:ied,jsd:jed,nz)) ; dd%Schmittner_coeff_3d(:,:,:) = 0.0 endif + if (CS%id_tidal_qe_md > 0) then + if (CS%cvmix_tidal_scheme .ne. SCHMITTNER) then + call MOM_error(FATAL, "setup_tidal_diagnostics: tidal_qe_md diagnostics is available "//& + "only when cvmix_tidal_scheme is Schmittner.") + endif + allocate(dd%tidal_qe_md(isd:ied,jsd:jed,nz)) ; dd%tidal_qe_md(:,:,:) = 0.0 + endif end subroutine setup_tidal_diagnostics subroutine post_tidal_diagnostics(G,GV,h,CS) @@ -1355,6 +1377,7 @@ subroutine post_tidal_diagnostics(G,GV,h,CS) if (CS%id_vert_dep> 0) call post_data(CS%id_vert_dep, dd%vert_dep_3d, CS%diag) if (CS%id_Simmons_coeff> 0) call post_data(CS%id_Simmons_coeff, dd%Simmons_coeff_2d, CS%diag) if (CS%id_Schmittner_coeff> 0) call post_data(CS%id_Schmittner_coeff, dd%Schmittner_coeff_3d, CS%diag) + if (CS%id_tidal_qe_md> 0) call post_data(CS%id_tidal_qe_md, dd%tidal_qe_md, CS%diag) if (CS%id_Kd_Itidal_Work > 0) & call post_data(CS%id_Kd_Itidal_Work, dd%Kd_Itidal_Work, CS%diag) @@ -1407,6 +1430,7 @@ subroutine post_tidal_diagnostics(G,GV,h,CS) if (associated(dd%vert_dep_3d)) deallocate(dd%vert_dep_3d) if (associated(dd%Simmons_coeff_2d)) deallocate(dd%Simmons_coeff_2d) if (associated(dd%Schmittner_coeff_3d)) deallocate(dd%Schmittner_coeff_3d) + if (associated(dd%tidal_qe_md)) deallocate(dd%tidal_qe_md) end subroutine post_tidal_diagnostics @@ -1445,31 +1469,36 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) type(tidal_mixing_cs), pointer :: CS ! local - integer :: k, isd, ied, jsd, jed, nz - real, parameter :: p33 = 1.0/3.0 - real, dimension(SZK_(G)) :: & - z_t, & ! depth from surface to midpoint of input layer [cm] - z_w ! depth from surface to top of input layer [cm] + integer :: k, isd, ied, jsd, jed, i,j + integer, dimension(4) :: nz_in + real, parameter :: p33 = 1.0/3.0 real, dimension(SZI_(G),SZJ_(G)) :: & tidal_qk1, & ! qk1 coefficient used in Schmittner & Egbert tidal_qo1 ! qo1 coefficient used in Schmittner & Egbert + real, allocatable, dimension(:) :: & + z_t, & ! depth from surface to midpoint of input layer [cm] + z_w ! depth from surface to top of input layer [cm] real, allocatable, dimension(:,:,:) :: & tc_m2, & ! input lunar semidiurnal tidal energy flux [W/m^2] tc_s2, & ! input solar semidiurnal tidal energy flux [W/m^2] tc_k1, & ! input lunar diurnal tidal energy flux [W/m^2] tc_o1 ! input lunar diurnal tidal energy flux [W/m^2] - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - ! allocate CS variables associated with 3d tidal energy dissipation - if (.not. allocated(CS%tidal_qe_3d_in)) allocate(CS%tidal_qe_3d_in(isd:ied,jsd:jed,nz)) - if (.not. allocated(CS%h_src)) allocate(CS%h_src(nz)) + ! get number of input levels: + call field_size(tidal_energy_file, 'z_t',nz_in) ! allocate local variables - allocate(tc_m2(isd:ied,jsd:jed,nz), & - tc_s2(isd:ied,jsd:jed,nz), & - tc_k1(isd:ied,jsd:jed,nz), & - tc_o1(isd:ied,jsd:jed,nz) ) + allocate(z_t(nz_in(1)), z_w(nz_in(1)) ) + allocate(tc_m2(isd:ied,jsd:jed,nz_in(1)), & + tc_s2(isd:ied,jsd:jed,nz_in(1)), & + tc_k1(isd:ied,jsd:jed,nz_in(1)), & + tc_o1(isd:ied,jsd:jed,nz_in(1)) ) + + ! allocate CS variables associated with 3d tidal energy dissipation + if (.not. allocated(CS%tidal_qe_3d_in)) allocate(CS%tidal_qe_3d_in(isd:ied,jsd:jed,nz_in(1))) + if (.not. allocated(CS%h_src)) allocate(CS%h_src(nz_in(1))) ! read in tidal constituents call MOM_read_data(tidal_energy_file, 'M2', tc_m2, G%domain) @@ -1479,7 +1508,6 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) call MOM_read_data(tidal_energy_file, 'z_t', z_t) call MOM_read_data(tidal_energy_file, 'z_w', z_w) - where (abs(G%geoLatT(:,:)) < 30.0) tidal_qk1(:,:) = p33 tidal_qo1(:,:) = p33 @@ -1489,37 +1517,54 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) endwhere CS%tidal_qe_3d_in = 0.0 - do k=1,nz + do k=1,nz_in(1) ! input cell thickness CS%h_src(k) = (z_t(k)-z_w(k))*2.0 *1e-2 ! form tidal_qe_3d_in from weighted tidal constituents - where (z_t(k) <= G%bathyT(:,:) .and. z_w(k) > CS%tidal_diss_lim_tc) + where ( (z_t(k)*1e-2) <= G%bathyT(:,:) .and. (z_w(k)*1e-2) > CS%tidal_diss_lim_tc) CS%tidal_qe_3d_in(:,:,k) = p33*tc_m2(:,:,k) + p33*tc_s2(:,:,k) + & tidal_qk1*tc_k1(:,:,k) + tidal_qo1*tc_o1(:,:,k) endwhere enddo + !open(unit=1905,file="out_1905.txt",access="APPEND") + !do j=G%jsd,G%jed + ! do i=isd,ied + ! if ( i+G%idg_offset .eq. 90 .and. j+G%jdg_offset .eq. 126) then + ! print *, "-------------------------------------------" + ! do k=50,nz_in(1) + ! write(1905,*) i,j,k + ! write(1905,*) CS%tidal_qe_3d_in(i,j,k), tc_m2(i,j,k) + ! write(1905,*) z_t(k), G%bathyT(i,j), z_w(k),CS%tidal_diss_lim_tc + ! end do + ! endif + ! enddo + !enddo + !close(1905) + ! test if qE is positive - if (any(CS%tidal_qe_3d_in<0)) then + if (any(CS%tidal_qe_3d_in<0.0)) then call MOM_error(FATAL, "read_tidal_constituents: Negative tidal_qe_3d_in terms.") endif !! collapse 3D q*E to 2D q*E !CS%tidal_qe_2d = 0.0 - !do k=1,nz + !do k=1,nz_in(1) ! where (z_t(k) <= G%bathyT(:,:)) ! CS%tidal_qe_2d(:,:) = CS%tidal_qe_2d(:,:) + CS%tidal_qe_3d_in(:,:,k) ! endwhere !enddo ! initialize input remapping: - call initialize_remapping(CS%remap_cs, remapping_scheme="PPM_IH4", & + call initialize_remapping(CS%remap_cs, remapping_scheme="PLM", & boundary_extrapolation=.false., check_remapping=CS%debug) deallocate(tc_m2) deallocate(tc_s2) deallocate(tc_k1) deallocate(tc_o1) + deallocate(z_t) + deallocate(z_w) end subroutine read_tidal_constituents From ef4cd0beddb8364010ea457221f51a6233a831d3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 2 May 2018 17:15:38 -0400 Subject: [PATCH 0157/1072] +Added ice_rigidity pointer in ice_ocean_bdry_type Added a pointer element, ice_rigidity, to the ice_ocean_boundary_type in config_src/coupled_dirver, that can be used to provide information about the rigidity (resistence to differential vertical ocean motions) of the sea-ice pack or other ice outside of the ocean component. Also moved the call to reset forces%rigidity_ice_[uv] from MOM_ice_shelf to convert_IOB_to_forces, to enable the rigidity to be accumulated across multiple flavors of ice. As this new field is not yet used, all answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 123 +++++++++++------- config_src/coupled_driver/ocean_model_MOM.F90 | 49 +++---- config_src/mct_driver/ocn_comp_mct.F90 | 10 +- src/ice_shelf/MOM_ice_shelf.F90 | 19 +-- 4 files changed, 116 insertions(+), 85 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index f832e76a8d..00ef5ae2be 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -129,13 +129,15 @@ module MOM_surface_forcing 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 name 'mask' + ! 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 name 'mask' + ! 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. @@ -153,37 +155,40 @@ module MOM_surface_forcing ! 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(:,:) :: 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(:,:) :: 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) - integer :: xtype ! 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(:,:) :: 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(:,:) :: 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 @@ -308,9 +313,9 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & 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)))) & + 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. & @@ -397,10 +402,11 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & if (restore_sst) then call time_interp_external(CS%id_trestore,Time,data_restore) 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%trestore_mask(i,j) * (CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2 - enddo; enddo + 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%trestore_mask(i,j) * & + (CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2 + enddo ; enddo endif @@ -577,6 +583,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) 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) @@ -632,7 +639,14 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) 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 + 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 if (associated(IOB%p)) then @@ -669,6 +683,9 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) 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 @@ -679,6 +696,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) if (associated(IOB%u_flux)) forces%taux(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier if (associated(IOB%v_flux)) forces%tauy(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier endif + enddo ; enddo ! surface momentum stress related fields as function of staggering @@ -773,8 +791,19 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, 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 - ! sea ice related fields if (CS%rigid_sea_ice) then call pass_var(forces%p_surf_full, G%Domain, halo=1) I_GEarth = 1.0 / G%G_Earth @@ -786,9 +815,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & (mass_ice + CS%rigid_sea_ice_mass) endif - ! CAUTION: with both rigid_sea_ice and ice shelves, we will need to make this - ! a maximum for the second call. - forces%rigidity_ice_u(I,j) = Kv_rho_ice * mass_eff + forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + Kv_rho_ice * mass_eff enddo ; enddo do i=is,ie ; do J=js-1,je mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i,j+1)) * I_GEarth @@ -797,7 +824,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & (mass_ice + CS%rigid_sea_ice_mass) endif - forces%rigidity_ice_v(i,J) = Kv_rho_ice * mass_eff + forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + Kv_rho_ice * mass_eff enddo ; enddo endif @@ -1320,11 +1347,11 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) 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/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 5fd45f7ea4..8fb5b14dbe 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -686,32 +686,21 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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 append to -! the any restart file name as a prefix. -! -! subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, density_ice, kv_ice, & latent_heat_fusion, sfc_state, time_step, berg_area_threshold) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(forcing), intent(inout) :: fluxes !< A structure with pointers to themodynamic, !! tracer and mass exchange forcing fields type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. logical, intent(in) :: use_ice_shelf !< If true, this configuration uses ice shelves. - real, intent(in) :: kv_ice !< The viscosity of ice, in m2 s-1. - real, intent(in) :: density_ice !< A typical density of ice, in kg m-3. - real, intent(in) :: latent_heat_fusion !< The latent heat of fusion, in J kg-1. - real, intent(in) :: time_step !< The coupling time step, in s. - real, intent(in) :: berg_area_threshold !< Area threshold for zeroing fluxes below iceberg + real, intent(in) :: kv_ice !< The viscosity of ice, in m2 s-1. + real, intent(in) :: density_ice !< A typical density of ice, in kg m-3. + real, intent(in) :: latent_heat_fusion !< The latent heat of fusion, in J kg-1. + real, intent(in) :: time_step !< The coupling time step, in s. + real, intent(in) :: berg_area_threshold !< Area threshold for zeroing fluxes below iceberg ! Arguments: ! (in) fluxes - A structure of surface fluxes that may be used. ! (in) G - The ocean's grid structure. @@ -773,11 +762,10 @@ subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, density_ice, fluxes%frac_shelf_h(:,:) = 0. fluxes%ustar_shelf(:,:) = 0. endif - do j=jsd,jed ; do i=isd,ied - if (G%areaT(i,j) > 0.0) & - fluxes%frac_shelf_h(i,j) = fluxes%frac_shelf_h(i,j) + fluxes%area_berg(i,j) - fluxes%ustar_shelf(i,j) = fluxes%ustar_shelf(i,j) + fluxes%ustar_berg(i,j) - enddo ; enddo + do j=jsd,jed ; do i=isd,ied ; if (G%areaT(i,j) > 0.0) then + fluxes%frac_shelf_h(i,j) = fluxes%frac_shelf_h(i,j) + fluxes%area_berg(i,j) + fluxes%ustar_shelf(i,j) = fluxes%ustar_shelf(i,j) + fluxes%ustar_berg(i,j) + endif ; enddo ; enddo !Zero'ing out other fluxes under the tabular icebergs if (berg_area_threshold >= 0.) then @@ -811,9 +799,22 @@ subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, density_ice, end subroutine add_berg_flux_to_shelf +!======================================================================= +! +! +! +! 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) - type(ocean_state_type), pointer :: OS - character(len=*), intent(in), optional :: timestamp + type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the + !! internal ocean state being saved to a restart file + character(len=*), intent(in), optional :: timestamp !< An optional timestamp string that should be + !! prepended to the file name. (Currently this is unused.) if (.not.MOM_state_is_synchronized(OS%MOM_CSp)) & call MOM_error(WARNING, "End of MOM_main reached with inconsistent "//& diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index dea8cc4c10..398ae829a4 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -1941,9 +1941,11 @@ subroutine ocn_import(forces, fluxes, Time, G, CS, state, x2o_o, ind, sw_decomp, endif ! endif for allocation and initialization if (CS%allow_flux_adjustments) then - fluxes%heat_added(:,:)=0.0 - fluxes%salt_flux_added(:,:)=0.0 + fluxes%heat_added(:,:)=0.0 + fluxes%salt_flux_added(:,:)=0.0 endif + if (associated(forces%rigidity_ice_u)) forces%rigidity_ice_u(:,:) = 0.0 + if (associated(forces%rigidity_ice_v)) forces%rigidity_ice_v(:,:) = 0.0 if (CS%area_surf < 0.0) then do j=js,je ; do i=is,ie @@ -2292,7 +2294,7 @@ subroutine ocn_import(forces, fluxes, Time, G, CS, state, x2o_o, ind, sw_decomp, endif ! CAUTION: with both rigid_sea_ice and ice shelves, we will need to make this ! a maximum for the second call. - forces%rigidity_ice_u(I,j) = Kv_rho_ice * mass_eff + forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + Kv_rho_ice * mass_eff enddo ; enddo do i=isd,ied ; do J=jsd,jed-1 mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i,j+1)) * I_GEarth @@ -2301,7 +2303,7 @@ subroutine ocn_import(forces, fluxes, Time, G, CS, state, x2o_o, ind, sw_decomp, mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & (mass_ice + CS%rigid_sea_ice_mass) endif - forces%rigidity_ice_v(i,J) = Kv_rho_ice * mass_eff + forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + Kv_rho_ice * mass_eff enddo ; enddo endif diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 72ee1e2360..f835bfcf95 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -977,15 +977,16 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) endif - ! For various reasons, forces%rigidity_ice_[uv] is always updated here. + ! For various reasons, forces%rigidity_ice_[uv] is always updated here, and + ! it has been zeroed out where IOB is translated to forces. kv_rho_ice = CS%kv_ice / CS%density_ice do j=js,je ; do I=is-1,ie - forces%rigidity_ice_u(I,j) = kv_rho_ice * & - min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) + forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + & + kv_rho_ice * min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) enddo ; enddo do J=js-1,je ; do i=is,ie - forces%rigidity_ice_v(i,J) = kv_rho_ice * & - min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) + forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + & + kv_rho_ice * min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) enddo ; enddo if (CS%debug) then @@ -1793,16 +1794,16 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%areaCu(I,j) > 0.0)) & forces%frac_shelf_u(I,j) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i+1,j)) / & (G%areaT(i,j) + G%areaT(i+1,j))) - forces%rigidity_ice_u(I,j) = kv_rho_ice * & - min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) + forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + & + kv_rho_ice * min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) enddo ; enddo do j=js-1,je ; do i=is,ie forces%frac_shelf_v(i,J) = 0.0 if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%areaCv(i,J) > 0.0)) & forces%frac_shelf_v(i,J) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i,j+1)) / & (G%areaT(i,j) + G%areaT(i,j+1))) - forces%rigidity_ice_v(i,J) = kv_rho_ice * & - min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) + forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + & + kv_rho_ice * min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) enddo ; enddo endif From 9ce97ef0519246ffa826217df223793e69f5d4f4 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 2 May 2018 16:58:47 -0600 Subject: [PATCH 0158/1072] use unmodified CVMix_compute_Schmittner_invariant interface --- src/parameterizations/vertical/MOM_tidal_mixing.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 11effe5dca..9321d3f68c 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -797,10 +797,14 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd) ! form the time-invariant part of Schmittner coefficient term call CVMix_compute_Schmittner_invariant(nlev = G%ke, & VertDep = vert_dep, & + efficiency = CS%Mu_itides, & rho = rho_fw, & exp_hab_zetar = exp_hab_zetar, & zw = iFaceHeight, & CVmix_tidal_params_user = CS%CVMix_tidal_params) + !TODO: in above call, there is no need to pass efficiency, since it gets + ! passed via CVMix_init_tidal and stored in CVMix_tidal_params. Change + ! CVMix API to prevent this redundancy. ! remap from input z coordinate to model coordinate: tidal_qe_md = 0.0 From 7d1a50cc1eb6fa2d009203458b4bbefe432e286e Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 2 May 2018 19:13:29 -0800 Subject: [PATCH 0159/1072] Adding "specified" option to vorticity and strain. --- src/core/MOM_CoriolisAdv.F90 | 16 ++++- src/core/MOM_open_boundary.F90 | 62 ++++++++++++------- .../lateral/MOM_hor_visc.F90 | 16 ++++- 3 files changed, 69 insertions(+), 25 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 44449bbd2d..99dfdaa568 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -297,6 +297,13 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) dudy(I,J) = 2.0*(u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%dxCu(I,j+1) endif enddo ; endif + if (OBC%specified_vorticity) then ; do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB + if (OBC%segment(n)%direction == OBC_DIRECTION_N) then + dudy(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j)*G%dyBu(I,J) + else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) + dudy(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j+1)*G%dyBu(I,J) + endif + enddo ; endif ! Project thicknesses across OBC points with a no-gradient condition. do i = max(Isq-1,OBC%segment(n)%HI%isd), min(Ieq+2,OBC%segment(n)%HI%ied) @@ -323,13 +330,20 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) if (OBC%freeslip_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB dvdx(I,J) = 0. enddo ; endif - if (OBC%computed_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB + if (OBC%specified_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB if (OBC%segment(n)%direction == OBC_DIRECTION_E) then dvdx(I,J) = 2.0*(OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%dyCv(i,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) dvdx(I,J) = 2.0*(v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%dyCv(i+1,J) endif enddo ; endif + if (OBC%specified_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB + if (OBC%segment(n)%direction == OBC_DIRECTION_E) then + dvdx(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i,J)*G%dxBu(I,J) + else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) + dvdx(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i+1,J)*G%dxBu(I,J) + endif + enddo ; endif ! Project thicknesses across OBC points with a no-gradient condition. do j = max(Jsq-1,OBC%segment(n)%HI%jsd), min(Jeq+2,OBC%segment(n)%HI%jed) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 32b9f6d197..fc78abf62f 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -196,14 +196,14 @@ module MOM_open_boundary !! in the relative vorticity on open boundaries. logical :: computed_vorticity = .false. !< If True, uses external data for tangential velocity !! in the relative vorticity on open boundaries. - logical :: imported_vorticity = .false. !< If True, uses external data for tangential velocity + logical :: specified_vorticity = .false. !< If True, uses external data for tangential velocity !! gradients in the relative vorticity on open boundaries. logical :: zero_strain = .false. !< If True, sets strain to zero on open boundaries. logical :: freeslip_strain = .false. !< If True, sets normal gradient of tangential velocity to zero !! in the strain on open boundaries. logical :: computed_strain = .false. !< If True, uses external data for tangential velocity to compute !! normal gradient in the strain on open boundaries. - logical :: imported_strain = .false. !< If True, uses external data for tangential velocity gradients + logical :: specified_strain = .false. !< If True, uses external data for tangential velocity gradients !! to compute strain on open boundaries. logical :: zero_biharmonic = .false. !< If True, zeros the Laplacian of flow on open boundaries for !! use in the biharmonic viscosity term. @@ -317,16 +317,16 @@ subroutine open_boundary_config(G, param_file, OBC) "If true, uses the external values of tangential velocity\n"// & "in the relative vorticity on open boundaries. This cannot\n"// & "be true if another OBC_XXX_VORTICITY option is True.", default=.false.) - call get_param(param_file, mdl, "OBC_IMPORTED_VORTICITY", OBC%imported_vorticity, & + call get_param(param_file, mdl, "OBC_SPECIFIED_VORTICITY", OBC%specified_vorticity, & "If true, uses the external values of tangential velocity\n"// & "in the relative vorticity on open boundaries. This cannot\n"// & "be true if another OBC_XXX_VORTICITY option is True.", default=.false.) if ((OBC%zero_vorticity .and. OBC%freeslip_vorticity) .or. & (OBC%zero_vorticity .and. OBC%computed_vorticity) .or. & - (OBC%zero_vorticity .and. OBC%imported_vorticity) .or. & + (OBC%zero_vorticity .and. OBC%specified_vorticity) .or. & (OBC%freeslip_vorticity .and. OBC%computed_vorticity) .or. & - (OBC%freeslip_vorticity .and. OBC%imported_vorticity) .or. & - (OBC%computed_vorticity .and. OBC%imported_vorticity)) & + (OBC%freeslip_vorticity .and. OBC%specified_vorticity) .or. & + (OBC%computed_vorticity .and. OBC%specified_vorticity)) & call MOM_error(FATAL, "MOM_open_boundary.F90, open_boundary_config:\n"//& "Only one of OBC_ZERO_VORTICITY, OBC_FREESLIP_VORTICITY, OBC_COMPUTED_VORTICITY\n"//& "and OBC_IMPORTED_VORTICITY can be True at once.") @@ -341,16 +341,16 @@ subroutine open_boundary_config(G, param_file, OBC) "If true, sets the normal gradient of tangential velocity to\n"// & "zero in the strain use in the stress tensor on open boundaries. This cannot\n"// & "be true if another OBC_XXX_STRAIN option is True.", default=.false.) - call get_param(param_file, mdl, "OBC_IMPORTED_STRAIN", OBC%imported_strain, & + call get_param(param_file, mdl, "OBC_SPECIFIED_STRAIN", OBC%specified_strain, & "If true, sets the normal gradient of tangential velocity to\n"// & "zero in the strain use in the stress tensor on open boundaries. This cannot\n"// & "be true if another OBC_XXX_STRAIN option is True.", default=.false.) if ((OBC%zero_strain .and. OBC%freeslip_strain) .or. & (OBC%zero_strain .and. OBC%computed_strain) .or. & - (OBC%zero_strain .and. OBC%imported_strain) .or. & + (OBC%zero_strain .and. OBC%specified_strain) .or. & (OBC%freeslip_strain .and. OBC%computed_strain) .or. & - (OBC%freeslip_strain .and. OBC%imported_strain) .or. & - (OBC%computed_strain .and. OBC%imported_strain)) & + (OBC%freeslip_strain .and. OBC%specified_strain) .or. & + (OBC%computed_strain .and. OBC%specified_strain)) & call MOM_error(FATAL, "MOM_open_boundary.F90, open_boundary_config:\n"//& "Only one of OBC_ZERO_STRAIN, OBC_FREESLIP_STRAIN, OBC_COMPUTED_STRAIN\n"//& "and OBC_IMPORTED_STRAIN can be True at once.") @@ -1968,7 +1968,7 @@ subroutine allocate_OBC_segment_data(OBC, segment) if (segment%nudged_tan) then allocate(segment%nudged_tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_vel(:,:,:)=0.0 endif - if (OBC%imported_vorticity .or. OBC%imported_strain) then + if (OBC%specified_vorticity .or. OBC%specified_strain) then allocate(segment%tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_grad(:,:,:)=0.0 endif if (segment%oblique) then @@ -2001,7 +2001,7 @@ subroutine allocate_OBC_segment_data(OBC, segment) if (segment%nudged_tan) then allocate(segment%nudged_tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_vel(:,:,:)=0.0 endif - if (OBC%imported_vorticity .or. OBC%imported_strain) then + if (OBC%specified_vorticity .or. OBC%specified_strain) then allocate(segment%tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_grad(:,:,:)=0.0 endif if (segment%oblique) then @@ -2306,13 +2306,13 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) endif else if (segment%is_E_or_W) then - if (segment%field(m)%name == 'V') then + if (segment%field(m)%name == 'V' .or. segment%field(m)%name == 'DVDX') then segment%field(m)%buffer_src(is_obc,:,:)=tmp_buffer(1,js_obc+G%jdg_offset+1:je_obc+G%jdg_offset+1,:) else segment%field(m)%buffer_src(is_obc,:,:)=tmp_buffer(1,js_obc+G%jdg_offset+1:je_obc+G%jdg_offset,:) endif else - if (segment%field(m)%name == 'U') then + if (segment%field(m)%name == 'U' .or. segment%field(m)%name == 'DUDY') then segment%field(m)%buffer_src(:,js_obc,:)=tmp_buffer(is_obc+G%idg_offset+1:ie_obc+G%idg_offset+1,1,:) else segment%field(m)%buffer_src(:,js_obc,:)=tmp_buffer(is_obc+G%idg_offset+1:ie_obc+G%idg_offset,1,:) @@ -2323,13 +2323,13 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) call time_interp_external(segment%field(m)%fid_dz,Time, tmp_buffer) if (OBC%brushcutter_mode) then if (segment%is_E_or_W) then - if (segment%field(m)%name == 'V') then + if (segment%field(m)%name == 'V' .or. segment%field(m)%name == 'DVDX') then segment%field(m)%dz_src(is_obc,:,:)=tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset)+1:2,:) else segment%field(m)%dz_src(is_obc,:,:)=tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset):2,:) endif else - if (segment%field(m)%name == 'U') then + if (segment%field(m)%name == 'U' .or. segment%field(m)%name == 'DUDY') then segment%field(m)%dz_src(:,js_obc,:)=tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset)+1:2,1,:) else segment%field(m)%dz_src(:,js_obc,:)=tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset):2,1,:) @@ -2337,13 +2337,13 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) endif else if (segment%is_E_or_W) then - if (segment%field(m)%name == 'V') then + if (segment%field(m)%name == 'V' .or. segment%field(m)%name == 'DVDX') then segment%field(m)%dz_src(is_obc,:,:)=tmp_buffer(1,js_obc+G%jdg_offset+1:je_obc+G%jdg_offset+1,:) else segment%field(m)%dz_src(is_obc,:,:)=tmp_buffer(1,js_obc+G%jdg_offset+1:je_obc+G%jdg_offset,:) endif else - if (segment%field(m)%name == 'U') then + if (segment%field(m)%name == 'U' .or. segment%field(m)%name == 'DUDY') then segment%field(m)%dz_src(:,js_obc,:)=tmp_buffer(is_obc+G%idg_offset+1:ie_obc+G%idg_offset+1,1,:) else segment%field(m)%dz_src(:,js_obc,:)=tmp_buffer(is_obc+G%idg_offset+1:ie_obc+G%idg_offset,1,:) @@ -2355,7 +2355,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) ishift=1 if (segment%direction == OBC_DIRECTION_E) ishift=0 I=is_obc - if (segment%field(m)%name == 'V') then + if (segment%field(m)%name == 'V' .or. segment%field(m)%name == 'DVDX') then ! Do q points for the whole segment do J=max(js_obc,jsd),min(je_obc,jed-1) ! Using the h remapping approach @@ -2398,7 +2398,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) jshift=1 if (segment%direction == OBC_DIRECTION_N) jshift=0 J=js_obc - if (segment%field(m)%name == 'U') then + if (segment%field(m)%name == 'U' .or. segment%field(m)%name == 'DUDY') then ! Do q points for the whole segment do I=max(is_obc,isd),min(ie_obc,ied-1) segment%field(m)%buffer_dst(I,J,:)=0.0 ! initialize remap destination buffer @@ -2451,6 +2451,8 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) else if (segment%field(m)%name == 'U') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc+1:je_obc,G%ke)) allocate(segment%field(m)%bt_vel(is_obc:ie_obc,js_obc+1:je_obc)) + else if (segment%field(m)%name == 'DVDX') then + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) else allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc+1:je_obc,G%ke)) endif @@ -2461,6 +2463,8 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) else if (segment%field(m)%name == 'V') then allocate(segment%field(m)%buffer_dst(is_obc+1:ie_obc,js_obc:je_obc,G%ke)) allocate(segment%field(m)%bt_vel(is_obc+1:ie_obc,js_obc:je_obc)) + else if (segment%field(m)%name == 'DUDY') then + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) else allocate(segment%field(m)%buffer_dst(is_obc+1:ie_obc,js_obc:je_obc,G%ke)) endif @@ -2504,7 +2508,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) enddo elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_E_or_W .and. associated(segment%tangential_vel)) then I=is_obc - do J=js_obc+1,je_obc-1 + do J=js_obc,je_obc do k=1,G%ke segment%tangential_vel(I,J,k) = segment%field(m)%buffer_dst(I,J,k) enddo @@ -2512,12 +2516,26 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) enddo elseif (trim(segment%field(m)%name) == 'U' .and. segment%is_N_or_S .and. associated(segment%tangential_vel)) then J=js_obc - do I=is_obc+1,ie_obc-1 + do I=is_obc,ie_obc do k=1,G%ke segment%tangential_vel(I,J,k) = segment%field(m)%buffer_dst(I,J,k) enddo if (associated(segment%nudged_tangential_vel)) segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) enddo + elseif (trim(segment%field(m)%name) == 'DVDX' .and. segment%is_E_or_W .and. associated(segment%tangential_grad)) then + I=is_obc + do J=js_obc,je_obc + do k=1,G%ke + segment%tangential_grad(I,J,k) = segment%field(m)%buffer_dst(I,J,k) + enddo + enddo + elseif (trim(segment%field(m)%name) == 'DUDY' .and. segment%is_N_or_S .and. associated(segment%tangential_grad)) then + J=js_obc + do I=is_obc,ie_obc + do k=1,G%ke + segment%tangential_grad(I,J,k) = segment%field(m)%buffer_dst(I,J,k) + enddo + enddo endif endif endif diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 85bb438f8f..5a7dbf7208 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -452,9 +452,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, dudy(I,J) = 0. elseif (OBC%computed_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = CS%DX_dyBu(I,J)*(OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%IdxCu(I,j) + dudy(I,J) = 2.0*CS%DX_dyBu(I,J)*(OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%IdxCu(I,j) else - dudy(I,J) = CS%DX_dyBu(I,J)*(u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdxCu(I,j+1) + dudy(I,J) = 2.0*CS%DX_dyBu(I,J)*(u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdxCu(I,j+1) + endif + elseif (OBC%specified_strain) then + if (OBC%segment(n)%direction == OBC_DIRECTION_N) then + dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j)*G%dxBu(I,J) + else + dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j+1)*G%dxBu(I,J) endif endif enddo @@ -470,6 +476,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, else dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)*(v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdyCv(i+1,J) endif + elseif (OBC%specified_strain) then + if (OBC%segment(n)%direction == OBC_DIRECTION_E) then + dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i,J)*G%dxBu(I,J) + else + dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i+1,J)*G%dxBu(I,J) + endif endif enddo endif From a1c5679ffcbadf9041c18ff7787ed71d563564de Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 3 May 2018 05:32:40 -0400 Subject: [PATCH 0160/1072] +Create module MOM_marine_ice Created a new module, MOM_marine_ice, to set dynamic properties for the ocean due to icebergs and sea-ice. The existing subroutine add_berg_flux_to_sHelf has been moved into this new module, and there are also an init routine and a control structure for this routine. All answers are bitwise identical. --- config_src/coupled_driver/ocean_model_MOM.F90 | 118 +----------- src/ice_shelf/MOM_marine_ice.F90 | 170 ++++++++++++++++++ 2 files changed, 174 insertions(+), 114 deletions(-) create mode 100644 src/ice_shelf/MOM_marine_ice.F90 diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 8fb5b14dbe..99d8ea7903 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -38,6 +38,7 @@ module ocean_model_mod 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 : add_berg_flux_to_shelf, 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 @@ -210,6 +211,9 @@ module ocean_model_mod 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 :: & @@ -388,8 +392,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) 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, shelf=.true.) endif @@ -687,118 +689,6 @@ end subroutine update_ocean_model ! NAME="update_ocean_model" -subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, density_ice, kv_ice, & - latent_heat_fusion, sfc_state, time_step, berg_area_threshold) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(forcing), intent(inout) :: fluxes !< A structure with pointers to themodynamic, - !! tracer and mass exchange forcing fields - type(surface), intent(inout) :: sfc_state !< A structure containing fields that - !! describe the surface state of the ocean. - logical, intent(in) :: use_ice_shelf !< If true, this configuration uses ice shelves. - real, intent(in) :: kv_ice !< The viscosity of ice, in m2 s-1. - real, intent(in) :: density_ice !< A typical density of ice, in kg m-3. - real, intent(in) :: latent_heat_fusion !< The latent heat of fusion, in J kg-1. - real, intent(in) :: time_step !< The coupling time step, in s. - real, intent(in) :: berg_area_threshold !< Area threshold for zeroing fluxes below iceberg -! Arguments: -! (in) fluxes - A structure of surface fluxes that may be used. -! (in) G - The ocean's grid structure. - real :: fraz ! refreezing rate in kg m-2 s-1 - real :: I_dt_LHF ! The inverse of the timestep times the latent heat of fusion, in kg J-1 s-1. - real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1. - integer :: i, j, is, ie, js, je, isd, ied, jsd, jed - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed - !This routine adds iceberg data to the ice shelf data (if ice shelf is used) - !which can then be used to change the top of ocean boundary condition used in - !the ocean model. This routine is taken from the add_shelf_flux subroutine - !within the ice shelf model. - - if (.not.(associated(forces%area_berg) .and. associated(forces%mass_berg) ) ) return - - if (.not.(associated(forces%frac_shelf_u) .and. associated(forces%frac_shelf_v) .and. & - associated(forces%rigidity_ice_u) .and. associated(forces%rigidity_ice_v)) ) return - - if (.not.(associated(fluxes%area_berg) .and. associated(fluxes%ustar_berg) .and. & - associated(fluxes%mass_berg) ) ) return - if (.not.(associated(fluxes%frac_shelf_h) .and. associated(fluxes%ustar_shelf)) ) return - - ! This section sets or augments the values of fields in forces. - if (.not. use_ice_shelf) then - forces%frac_shelf_u(:,:) = 0.0 ; forces%frac_shelf_v(:,:) = 0.0 - forces%rigidity_ice_u(:,:) = 0.0 ; forces%rigidity_ice_v(:,:) = 0.0 - endif - - call pass_var(forces%area_berg, G%domain, TO_ALL+Omit_corners, halo=1, complete=.false.) - call pass_var(forces%mass_berg, G%domain, TO_ALL+Omit_corners, halo=1, complete=.true.) - kv_rho_ice = kv_ice / density_ice - do j=js,je ; do I=is-1,ie - if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%dxdy_u(I,j) > 0.0)) & - forces%frac_shelf_u(I,j) = forces%frac_shelf_u(I,j) + & - (((forces%area_berg(i,j)*G%areaT(i,j)) + & - (forces%area_berg(i+1,j)*G%areaT(i+1,j))) / & - (G%areaT(i,j) + G%areaT(i+1,j)) ) - forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + kv_rho_ice * & - min(forces%mass_berg(i,j), forces%mass_berg(i+1,j)) - enddo ; enddo - do J=js-1,je ; do i=is,ie - if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%dxdy_v(i,J) > 0.0)) & - forces%frac_shelf_v(i,J) = forces%frac_shelf_v(i,J) + & - (((forces%area_berg(i,j)*G%areaT(i,j)) + & - (forces%area_berg(i,j+1)*G%areaT(i,j+1))) / & - (G%areaT(i,j) + G%areaT(i,j+1)) ) - forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + kv_rho_ice * & - min(forces%mass_berg(i,j), forces%mass_berg(i,j+1)) - enddo ; enddo - !### This halo update may be unnecessary. Test it. -RWH - call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) - - ! The remaining code sets or augments the values of fields in fluxes. - - if (.not.(associated(fluxes%area_berg) .and. associated(fluxes%ustar_berg) .and. & - associated(fluxes%mass_berg) ) ) return - if (.not. use_ice_shelf) then - fluxes%frac_shelf_h(:,:) = 0. - fluxes%ustar_shelf(:,:) = 0. - endif - do j=jsd,jed ; do i=isd,ied ; if (G%areaT(i,j) > 0.0) then - fluxes%frac_shelf_h(i,j) = fluxes%frac_shelf_h(i,j) + fluxes%area_berg(i,j) - fluxes%ustar_shelf(i,j) = fluxes%ustar_shelf(i,j) + fluxes%ustar_berg(i,j) - endif ; enddo ; enddo - - !Zero'ing out other fluxes under the tabular icebergs - if (berg_area_threshold >= 0.) then - I_dt_LHF = 1.0 / (time_step * latent_heat_fusion) - do j=jsd,jed ; do i=isd,ied - if (fluxes%frac_shelf_h(i,j) > berg_area_threshold) then !Only applying for ice shelf covering most of cell - - if (associated(fluxes%sw)) fluxes%sw(i,j) = 0.0 - if (associated(fluxes%lw)) fluxes%lw(i,j) = 0.0 - if (associated(fluxes%latent)) fluxes%latent(i,j) = 0.0 - if (associated(fluxes%evap)) fluxes%evap(i,j) = 0.0 - - ! Add frazil formation diagnosed by the ocean model (J m-2) in the - ! form of surface layer evaporation (kg m-2 s-1). Update lprec in the - ! control structure for diagnostic purposes. - - if (associated(sfc_state%frazil)) then - fraz = sfc_state%frazil(i,j) * I_dt_LHF - if (associated(fluxes%evap)) fluxes%evap(i,j) = fluxes%evap(i,j) - fraz - !CS%lprec(i,j)=CS%lprec(i,j) - fraz - sfc_state%frazil(i,j) = 0.0 - endif - - !Alon: Should these be set to zero too? - if (associated(fluxes%sens)) fluxes%sens(i,j) = 0.0 - if (associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = 0.0 - if (associated(fluxes%lprec)) fluxes%lprec(i,j) = 0.0 - endif - enddo ; enddo - endif - -end subroutine add_berg_flux_to_shelf - !======================================================================= ! ! diff --git a/src/ice_shelf/MOM_marine_ice.F90 b/src/ice_shelf/MOM_marine_ice.F90 new file mode 100644 index 0000000000..a31afc38d3 --- /dev/null +++ b/src/ice_shelf/MOM_marine_ice.F90 @@ -0,0 +1,170 @@ +!> Routines incorporating the effects of marine ice (sea-ice and icebergs) into +!! the ocean model dynamics and thermodynamics. +module MOM_marine_ice + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : post_data, query_averaging_enabled, diag_ctrl +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 +use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_forcing_type, only : allocate_forcing_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_grid, only : ocean_grid_type +use MOM_time_manager, only : time_type +use MOM_variables, only : surface + +implicit none ; private + +#include + +public add_berg_flux_to_shelf, marine_ice_init + +!> Control structure for MOM_marine_ice +type, public :: marine_ice_CS ; private + type(time_type), pointer :: Time !< A pointer to the ocean model's clock. + type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the timing of diagnostic output. +end type marine_ice_CS + +contains + +!> add_berg_flux_to_shelf adds rigidity and ice-area coverage due to icebergs +!! to the forces type fields, and adds ice-areal coverage and modifies various +!! thermodynamic fluxes due to the presence of icebergs. +subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, density_ice, kv_ice, & + latent_heat_fusion, sfc_state, time_step, berg_area_threshold) + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + type(forcing), intent(inout) :: fluxes !< A structure with pointers to themodynamic, + !! tracer and mass exchange forcing fields + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + logical, intent(in) :: use_ice_shelf !< If true, this configuration uses ice shelves. + real, intent(in) :: kv_ice !< The viscosity of ice, in m2 s-1. + real, intent(in) :: density_ice !< A typical density of ice, in kg m-3. + real, intent(in) :: latent_heat_fusion !< The latent heat of fusion, in J kg-1. + real, intent(in) :: time_step !< The coupling time step, in s. + real, intent(in) :: berg_area_threshold !< Area threshold for zeroing fluxes below iceberg +! Arguments: +! (in) fluxes - A structure of surface fluxes that may be used. +! (in) G - The ocean's grid structure. + real :: fraz ! refreezing rate in kg m-2 s-1 + real :: I_dt_LHF ! The inverse of the timestep times the latent heat of fusion, in kg J-1 s-1. + real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1. + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed + !This routine adds iceberg data to the ice shelf data (if ice shelf is used) + !which can then be used to change the top of ocean boundary condition used in + !the ocean model. This routine is taken from the add_shelf_flux subroutine + !within the ice shelf model. + + if (.not.(associated(forces%area_berg) .and. associated(forces%mass_berg) ) ) return + + if (.not.(associated(forces%frac_shelf_u) .and. associated(forces%frac_shelf_v) .and. & + associated(forces%rigidity_ice_u) .and. associated(forces%rigidity_ice_v)) ) return + + if (.not.(associated(fluxes%area_berg) .and. associated(fluxes%ustar_berg) .and. & + associated(fluxes%mass_berg) ) ) return + if (.not.(associated(fluxes%frac_shelf_h) .and. associated(fluxes%ustar_shelf)) ) return + + ! This section sets or augments the values of fields in forces. + if (.not. use_ice_shelf) then + forces%frac_shelf_u(:,:) = 0.0 ; forces%frac_shelf_v(:,:) = 0.0 + forces%rigidity_ice_u(:,:) = 0.0 ; forces%rigidity_ice_v(:,:) = 0.0 + endif + + call pass_var(forces%area_berg, G%domain, TO_ALL+Omit_corners, halo=1, complete=.false.) + call pass_var(forces%mass_berg, G%domain, TO_ALL+Omit_corners, halo=1, complete=.true.) + kv_rho_ice = kv_ice / density_ice + do j=js,je ; do I=is-1,ie + if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%dxdy_u(I,j) > 0.0)) & + forces%frac_shelf_u(I,j) = forces%frac_shelf_u(I,j) + & + (((forces%area_berg(i,j)*G%areaT(i,j)) + & + (forces%area_berg(i+1,j)*G%areaT(i+1,j))) / & + (G%areaT(i,j) + G%areaT(i+1,j)) ) + forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + kv_rho_ice * & + min(forces%mass_berg(i,j), forces%mass_berg(i+1,j)) + enddo ; enddo + do J=js-1,je ; do i=is,ie + if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%dxdy_v(i,J) > 0.0)) & + forces%frac_shelf_v(i,J) = forces%frac_shelf_v(i,J) + & + (((forces%area_berg(i,j)*G%areaT(i,j)) + & + (forces%area_berg(i,j+1)*G%areaT(i,j+1))) / & + (G%areaT(i,j) + G%areaT(i,j+1)) ) + forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + kv_rho_ice * & + min(forces%mass_berg(i,j), forces%mass_berg(i,j+1)) + enddo ; enddo + !### This halo update may be unnecessary. Test it. -RWH + call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) + + ! The remaining code sets or augments the values of fields in fluxes. + + if (.not.(associated(fluxes%area_berg) .and. associated(fluxes%ustar_berg) .and. & + associated(fluxes%mass_berg) ) ) return + if (.not. use_ice_shelf) then + fluxes%frac_shelf_h(:,:) = 0. + fluxes%ustar_shelf(:,:) = 0. + endif + do j=jsd,jed ; do i=isd,ied ; if (G%areaT(i,j) > 0.0) then + fluxes%frac_shelf_h(i,j) = fluxes%frac_shelf_h(i,j) + fluxes%area_berg(i,j) + fluxes%ustar_shelf(i,j) = fluxes%ustar_shelf(i,j) + fluxes%ustar_berg(i,j) + endif ; enddo ; enddo + + !Zero'ing out other fluxes under the tabular icebergs + if (berg_area_threshold >= 0.) then + I_dt_LHF = 1.0 / (time_step * latent_heat_fusion) + do j=jsd,jed ; do i=isd,ied + if (fluxes%frac_shelf_h(i,j) > berg_area_threshold) then !Only applying for ice shelf covering most of cell + + if (associated(fluxes%sw)) fluxes%sw(i,j) = 0.0 + if (associated(fluxes%lw)) fluxes%lw(i,j) = 0.0 + if (associated(fluxes%latent)) fluxes%latent(i,j) = 0.0 + if (associated(fluxes%evap)) fluxes%evap(i,j) = 0.0 + + ! Add frazil formation diagnosed by the ocean model (J m-2) in the + ! form of surface layer evaporation (kg m-2 s-1). Update lprec in the + ! control structure for diagnostic purposes. + + if (associated(sfc_state%frazil)) then + fraz = sfc_state%frazil(i,j) * I_dt_LHF + if (associated(fluxes%evap)) fluxes%evap(i,j) = fluxes%evap(i,j) - fraz + !CS%lprec(i,j)=CS%lprec(i,j) - fraz + sfc_state%frazil(i,j) = 0.0 + endif + + !Alon: Should these be set to zero too? + if (associated(fluxes%sens)) fluxes%sens(i,j) = 0.0 + if (associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = 0.0 + if (associated(fluxes%lprec)) fluxes%lprec(i,j) = 0.0 + endif + enddo ; enddo + endif + +end subroutine add_berg_flux_to_shelf + +!> Initialize control structure for MOM_marine_ice +subroutine marine_ice_init(Time, G, param_file, diag, CS) + type(time_type), target, intent(in) :: Time !< Current model time + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(param_file_type), intent(in) :: param_file !< Runtime parameter handles + type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure + type(marine_ice_CS), pointer :: CS !< Control structure for MOM_marine_ice +! This include declares and sets the variable "version". +#include "version_variable.h" + character(len=40) :: mdl = "MOM_marine_ice" ! This module's name. + + if (associated(CS)) then + call MOM_error(WARNING, "marine_ice_init called with an "// & + "associated control structure.") + return + else ; allocate(CS) ; endif + + ! Write all relevant parameters to the model log. + call log_version(mdl, version) + +end subroutine marine_ice_init + +end module MOM_marine_ice From 04bd7b6332728cc7d16313c4b260767da56e3186 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 3 May 2018 11:09:04 -0400 Subject: [PATCH 0161/1072] Nullify local pointer variables & pointer elements All pointers should be set to null when declared. This has now been done for all pointers in MOM.F90 and MOM_PressureForce_Mongomery.F90. No answers change. --- src/core/MOM.F90 | 67 ++++++++++++----------- src/core/MOM_PressureForce_Montgomery.F90 | 22 ++++---- 2 files changed, 46 insertions(+), 43 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index d27239e9c3..a43a252e0a 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -160,7 +160,7 @@ module MOM !! with a correction for the inverse barometer (meter) eta_av_bc !< free surface height or column mass time averaged over the last !! baroclinic dynamics time step (m or kg/m2) - real, pointer, dimension(:,:) :: & + real, dimension(:,:), pointer :: & Hml => NULL() !< active mixed layer depth, in m real :: time_in_cycle !< The running time of the current time-stepping cycle !! in calls that step the dynamics, and also the length of @@ -241,7 +241,7 @@ module MOM type(time_type) :: Z_diag_interval !< amount of time between calculating Z-space diagnostics type(time_type) :: Z_diag_time !< next time to compute Z-space diagnostics - real, pointer, dimension(:,:,:) :: & + real, dimension(:,:,:), pointer :: & h_pre_dyn => NULL(), & !< The thickness before the transports, in H. T_pre_dyn => NULL(), & !< Temperature before the transports, in degC. S_pre_dyn => NULL() !< Salinity before the transports, in psu. @@ -249,7 +249,7 @@ module MOM !! for derived diagnostics (e.g., energy budgets) type(cont_diag_ptrs) :: CDp !< structure containing pointers to continuity equation !! terms, for derived diagnostics (e.g., energy budgets) - real, pointer, dimension(:,:,:) :: & + real, dimension(:,:,:), pointer :: & u_prev => NULL(), & !< previous value of u stored for diagnostics v_prev => NULL() !< previous value of v stored for diagnostics @@ -259,7 +259,7 @@ module MOM logical :: p_surf_prev_set !< If true, p_surf_prev has been properly set from !! a previous time-step or the ocean restart file. !! This is only valid when interp_p_surf is true. - real, pointer, dimension(:,:) :: & + real, dimension(:,:), pointer :: & p_surf_prev => NULL(), & !< surface pressure (Pa) at end previous call to step_MOM p_surf_begin => NULL(), & !< surface pressure (Pa) at start of step_MOM_dyn_... p_surf_end => NULL() !< surface pressure (Pa) at end of step_MOM_dyn_... @@ -368,7 +368,8 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & Waves, do_dynamics, do_thermodynamics, start_cycle, & end_cycle, cycle_length, reset_therm) type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(forcing), intent(inout) :: fluxes !< pointers to forcing fields + type(forcing), intent(inout) :: fluxes !< A structure with pointers to themodynamic, + !! tracer and mass exchange forcing fields type(surface), intent(inout) :: sfc_state !< surface ocean state type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type real, intent(in) :: time_interval !< time interval covered by this run segment, in s. @@ -392,8 +393,8 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & !! If missing, this is like start_cycle. ! local - type(ocean_grid_type), pointer :: G ! pointer to a structure containing - ! metrics and related information + type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing + ! metrics and related information type(verticalGrid_type), pointer :: GV => NULL() integer :: ntstep ! time steps between tracer updates or diabatic forcing @@ -431,11 +432,11 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: & ssh ! sea surface height, which may be based on eta_av (meter) - real, pointer, dimension(:,:,:) :: & - u, & ! u : zonal velocity component (m/s) - v, & ! v : meridional velocity component (m/s) - h ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) - real, pointer, dimension(:,:) :: & + real, dimension(:,:,:), pointer :: & + u => NULL(), & ! u : zonal velocity component (m/s) + v => NULL(), & ! v : meridional velocity component (m/s) + h => NULL() ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) + real, dimension(:,:), pointer :: & p_surf => NULL() ! A pointer to the ocean surface pressure, in Pa. real :: I_wt_ssh @@ -850,17 +851,17 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & type(time_type), intent(in) :: Time_local !< End time of a segment, as a time type type(wave_parameters_CS), & optional, pointer :: Waves !< Container for wave related parameters; the - !! fields in Waves are intent(in) here. + !! fields in Waves are intent in here. ! local - type(ocean_grid_type), pointer :: G ! pointer to a structure containing - ! metrics and related information - type(verticalGrid_type), pointer :: GV => NULL() + type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing + ! metrics and related information + type(verticalGrid_type), pointer :: GV => NULL() type(MOM_diag_IDs), pointer :: IDs => NULL() ! A structure with the diagnostic IDs. - real, pointer, dimension(:,:,:) :: & - u, & ! u : zonal velocity component (m/s) - v, & ! v : meridional velocity component (m/s) - h ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) + real, dimension(:,:,:), pointer :: & + u => NULL(), & ! u : zonal velocity component (m/s) + v => NULL(), & ! v : meridional velocity component (m/s) + h => NULL() ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) logical :: calc_dtbt ! Indicates whether the dynamically adjusted ! barotropic time step needs to be updated. @@ -1099,7 +1100,7 @@ subroutine step_MOM_thermo(CS, G, GV, u, v, h, tv, fluxes, dtdia, & logical, intent(in) :: update_BBL !< If true, calculate the bottom boundary layer properties. type(wave_parameters_CS), & optional, pointer :: Waves !< Container for wave related parameters; - !! the fields in Waves are intent(in) here. + !! the fields in Waves are intent in here. logical :: use_ice_shelf ! Needed for selecting the right ALE interface. logical :: showCallTree @@ -1279,15 +1280,15 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS logical :: skip_diffusion integer :: id_eta_diff_end - integer, pointer :: accumulated_time + integer, pointer :: accumulated_time => NULL() integer :: i,j,k integer :: is, ie, js, je, isd, ied, jsd, jed ! 3D pointers - real, dimension(:,:,:), pointer :: & - uhtr, vhtr, & - eatr, ebtr, & - h_end + real, dimension(:,:,:), pointer :: & + uhtr => NULL(), vhtr => NULL(), & + eatr => NULL(), ebtr => NULL(), & + h_end => NULL() ! 2D Array for diagnostics real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_pre, eta_end @@ -1472,7 +1473,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & type(hor_index_type) :: HI ! A hor_index_type for array extents type(verticalGrid_type), pointer :: GV => NULL() type(dyn_horgrid_type), pointer :: dG => NULL() - type(diag_ctrl), pointer :: diag + type(diag_ctrl), pointer :: diag => NULL() character(len=4), parameter :: vers_num = 'v2.0' @@ -1488,7 +1489,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & real, allocatable, dimension(:,:) :: eta ! free surface height (m) or bottom press (Pa) real, allocatable, dimension(:,:) :: area_shelf_h ! area occupied by ice shelf real, dimension(:,:), allocatable, target :: frac_shelf_h ! fraction of total area occupied by ice shelf - real, dimension(:,:), pointer :: shelf_area + real, dimension(:,:), pointer :: shelf_area => NULL() type(MOM_restart_CS), pointer :: restart_CSp_tmp => NULL() type(group_pass_type) :: tmp_pass_uv_T_S_h, pass_uv_T_S_h ! GMM, the following *is not* used. Should we delete it? @@ -2617,11 +2618,11 @@ subroutine extract_surface_state(CS, sfc_state) real :: hu, hv type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing ! metrics and related information - type(verticalGrid_type), pointer :: GV => NULL() - real, pointer, dimension(:,:,:) :: & - u, & ! u : zonal velocity component (m/s) - v, & ! v : meridional velocity component (m/s) - h ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) + type(verticalGrid_type), pointer :: GV => NULL() + real, dimension(:,:,:), pointer :: & + u => NULL(), & ! u : zonal velocity component (m/s) + v => NULL(), & ! v : meridional velocity component (m/s) + h => NULL() ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) real :: depth(SZI_(CS%G)) ! distance from the surface (meter) real :: depth_ml ! depth over which to average to ! determine mixed layer properties (meter) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 147f264cc3..a343bca4d1 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -31,12 +31,12 @@ module MOM_PressureForce_Mont real :: GFS_scale !< Ratio between gravity applied to top interface !! and the gravitational acceleration of the planet. !! Usually this ratio is 1. - type(time_type), pointer :: Time ! A pointer to the ocean model's clock. - type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the - ! timing of diagnostic output. - real, pointer :: PFu_bc(:,:,:) => NULL() ! Accelerations due to pressure - real, pointer :: PFv_bc(:,:,:) => NULL() ! gradients deriving from density - ! gradients within layers, m s-2. + type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate + !! the timing of diagnostic output. + real, pointer :: PFu_bc(:,:,:) => NULL() !< Accelerations due to pressure + real, pointer :: PFv_bc(:,:,:) => NULL() !< gradients deriving from density + !! gradients within layers, m s-2. integer :: id_PFu_bc = -1, id_PFv_bc = -1, id_e_tidal = -1 type(tidal_forcing_CS), pointer :: tides_CSp => NULL() end type PressureForce_Mont_CS @@ -63,12 +63,14 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration due to pressure gradients !! (equal to -dM/dy) in m/s2. type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF - real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean or + real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean in Pa. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure anomaly in + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + optional, intent(out) :: pbce !< The baroclinic pressure anomaly in !! each layer due to free surface height anomalies, !! in m2 s-2 H-1. - real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< Free surface height, in m. + real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< Free surface height, in m. + ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & M, & ! The Montgomery potential, M = (p/rho + gz) , in m2 s-2. @@ -902,7 +904,7 @@ end subroutine PressureForce_Mont_init !> Deallocates the Montgomery-potential form of PGF control structure subroutine PressureForce_Mont_end(CS) - type(PressureForce_Mont_CS), pointer :: CS + type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF if (associated(CS)) deallocate(CS) end subroutine PressureForce_Mont_end From 213ce037030a75d8b38909c247e7b0947b634993 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 3 May 2018 11:09:59 -0400 Subject: [PATCH 0162/1072] dOxyGenized comments describing barotropic_CS dOxyGenized comments describing barotropic_CS, and cleaned up the argument descriptions for set_dtbt and btcalc. All answers are bitwise identical. --- src/core/MOM_barotropic.F90 | 390 ++++++++++++++++++------------------ 1 file changed, 199 insertions(+), 191 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index b5401191e0..49d786191d 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -162,172 +162,172 @@ module MOM_barotropic ! frhatu and frhatv are the fraction of the total column thickness ! interpolated to u or v grid points in each layer, nondimensional. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & - IDatu, & ! Inverse of the basin depth at u grid points, in m-1. - lin_drag_u, & ! A spatially varying linear drag coefficient acting - ! on the zonal barotropic flow, in H s-1. - uhbt_IC, & ! The barotropic solver's estimate of the zonal - ! transport as the initial condition for the next call - ! to btstep, in H m2 s-1. - ubt_IC, & ! The barotropic solver's estimate of the zonal velocity - ! that will be the initial condition for the next call - ! to btstep, in m s-1. - ubtav ! The barotropic zonal velocity averaged over the - ! baroclinic time step, m s-1. + IDatu, & !< Inverse of the basin depth at u grid points, in m-1. + lin_drag_u, & !< A spatially varying linear drag coefficient acting + !! on the zonal barotropic flow, in H s-1. + uhbt_IC, & !< The barotropic solver's estimate of the zonal + !! transport as the initial condition for the next call + !! to btstep, in H m2 s-1. + ubt_IC, & !< The barotropic solver's estimate of the zonal velocity + !! that will be the initial condition for the next call + !! to btstep, in m s-1. + ubtav !< The barotropic zonal velocity averaged over the + !! baroclinic time step, m s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - IDatv, & ! Inverse of the basin depth at v grid points, in m-1. - lin_drag_v, & ! A spatially varying linear drag coefficient acting - ! on the zonal barotropic flow, in H s-1. - vhbt_IC, & ! The barotropic solver's estimate of the zonal - ! transport as the initla condition for the next call - ! to btstep, in H m2 s-1. - vbt_IC, & ! The barotropic solver's estimate of the zonal velocity - ! that will be the initial condition for the next call - ! to btstep, in m s-1. - vbtav ! The barotropic meridional velocity averaged over the - ! baroclinic time step, m s-1. + IDatv, & !< Inverse of the basin depth at v grid points, in m-1. + lin_drag_v, & !< A spatially varying linear drag coefficient acting + !! on the zonal barotropic flow, in H s-1. + vhbt_IC, & !< The barotropic solver's estimate of the zonal + !! transport as the initla condition for the next call + !! to btstep, in H m2 s-1. + vbt_IC, & !< The barotropic solver's estimate of the zonal velocity + !! that will be the initial condition for the next call + !! to btstep, in m s-1. + vbtav !< The barotropic meridional velocity averaged over the + !! baroclinic time step, m s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - eta_cor, & ! The difference between the free surface height from - ! the barotropic calculation and the sum of the layer - ! thicknesses. This difference is imposed as a forcing - ! term in the barotropic calculation over a baroclinic - ! timestep, in H (m or kg m-2). - eta_cor_bound ! A limit on the rate at which eta_cor can be applied - ! while avoiding instability, in units of H s-1. This - ! is only used if CS%bound_BT_corr is true. + eta_cor, & !< The difference between the free surface height from + !! the barotropic calculation and the sum of the layer + !! thicknesses. This difference is imposed as a forcing + !! term in the barotropic calculation over a baroclinic + !! timestep, in H (m or kg m-2). + eta_cor_bound !< A limit on the rate at which eta_cor can be applied + !! while avoiding instability, in units of H s-1. This + !! is only used if CS%bound_BT_corr is true. real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: & - ua_polarity, & ! Test vector components for checking grid polarity. - va_polarity, & ! Test vector components for checking grid polarity. - bathyT ! A copy of bathyT (ocean bottom depth) with wide halos. + ua_polarity, & !< Test vector components for checking grid polarity. + va_polarity, & !< Test vector components for checking grid polarity. + bathyT !< A copy of bathyT (ocean bottom depth) with wide halos. real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: & - IareaT ! This is a copy of G%IareaT with wide halos, but will - ! still utilize the macro IareaT when referenced, m-2. + IareaT !< This is a copy of G%IareaT with wide halos, but will + !! still utilize the macro IareaT when referenced, m-2. real ALLOCABLE_, dimension(NIMEMBW_,NJMEMW_) :: & - D_u_Cor, & ! A simply averaged depth at u points, in m. - dy_Cu, & ! A copy of G%dy_Cu with wide halos, in m. - IdxCu ! A copy of G%IdxCu with wide halos, in m-1. + D_u_Cor, & !< A simply averaged depth at u points, in m. + dy_Cu, & !< A copy of G%dy_Cu with wide halos, in m. + IdxCu !< A copy of G%IdxCu with wide halos, in m-1. real ALLOCABLE_, dimension(NIMEMW_,NJMEMBW_) :: & - D_v_Cor, & ! A simply averaged depth at v points, in m. - dx_Cv, & ! A copy of G%dx_Cv with wide halos, in m. - IdyCv ! A copy of G%IdyCv with wide halos, in m-1. + D_v_Cor, & !< A simply averaged depth at v points, in m. + dx_Cv, & !< A copy of G%dx_Cv with wide halos, in m. + IdyCv !< A copy of G%IdyCv with wide halos, in m-1. real ALLOCABLE_, dimension(NIMEMBW_,NJMEMBW_) :: & - q_D ! f / D at PV points, in m-1 s-1. + q_D !< f / D at PV points, in m-1 s-1. - real, pointer, dimension(:,:,:) :: frhatu1 => NULL(), frhatv1 => NULL() ! Predictor values. + real, dimension(:,:,:), pointer :: frhatu1 => NULL(), frhatv1 => NULL() ! Predictor values. type(BT_OBC_type) :: BT_OBC !< A structure with all of this module's fields !! for applying open boundary conditions. - real :: Rho0 ! The density used in the Boussinesq - ! approximation, in kg m-3. - real :: dtbt ! The barotropic time step, in s. - real :: dtbt_fraction ! The fraction of the maximum time-step that - ! should used. The default is 0.98. - real :: dtbt_max ! The maximum stable barotropic time step, in s. - real :: dt_bt_filter ! The time-scale over which the barotropic mode - ! solutions are filtered, in s. This can never - ! be taken to be longer than 2*dt. The default, 0, - ! applies no filtering. - integer :: nstep_last = 0 ! The number of barotropic timesteps per baroclinic - ! time step the last time btstep was called. - real :: bebt ! A nondimensional number, from 0 to 1, that - ! determines the gravity wave time stepping scheme. - ! 0.0 gives a forward-backward scheme, while 1.0 - ! give backward Euler. In practice, bebt should be - ! of order 0.2 or greater. - logical :: split ! If true, use the split time stepping scheme. - logical :: bound_BT_corr ! If true, the magnitude of the fake mass source - ! in the barotropic equation that drives the two - ! estimates of the free surface height toward each - ! other is bounded to avoid driving corrective - ! velocities that exceed MAXCFL_BT_CONT. - logical :: gradual_BT_ICs ! If true, adjust the initial conditions for the - ! barotropic solver to the values from the layered - ! solution over a whole timestep instead of - ! instantly. This is a decent approximation to the - ! inclusion of sum(u dh_dt) while also correcting - ! for truncation errors. - logical :: Sadourny ! If true, the Coriolis terms are discretized - ! with Sadourny's energy conserving scheme, - ! otherwise the Arakawa & Hsu scheme is used. If - ! the deformation radius is not resolved Sadourny's - ! scheme should probably be used. - logical :: Nonlinear_continuity ! If true, the barotropic continuity equation - ! uses the full ocean thickness for transport. - integer :: Nonlin_cont_update_period ! The number of barotropic time steps - ! between updates to the face area, or 0 only to - ! update at the start of a call to btstep. The - ! default is 1. - logical :: BT_project_velocity ! If true, step the barotropic velocity first - ! and project out the velocity tendancy by 1+BEBT - ! when calculating the transport. The default - ! (false) is to use a predictor continuity step to - ! find the pressure field, and then do a corrector - ! continuity step using a weighted average of the - ! old and new velocities, with weights of (1-BEBT) - ! and BEBT. - logical :: dynamic_psurf ! If true, add a dynamic pressure due to a viscous - ! ice shelf, for instance. - real :: Dmin_dyn_psurf ! The minimum depth to use in limiting the size - ! of the dynamic surface pressure for stability, - ! in m. - real :: ice_strength_length ! The length scale at which the damping rate - ! due to the ice strength should be the same as if - ! a Laplacian were applied, in m. - real :: const_dyn_psurf ! The constant that scales the dynamic surface - ! pressure, nondim. Stable values are < ~1.0. - ! The default is 0.9. - logical :: tides ! If true, apply tidal momentum forcing. - real :: G_extra ! A nondimensional factor by which gtot is enhanced. - integer :: hvel_scheme ! An integer indicating how the thicknesses at - ! velocity points are calculated. Valid values are - ! given by the parameters defined below: - ! HARMONIC, ARITHMETIC, HYBRID, and FROM_BT_CONT - logical :: strong_drag ! If true, use a stronger estimate of the retarding - ! effects of strong bottom drag. - logical :: linear_wave_drag ! If true, apply a linear drag to the barotropic - ! velocities, using rates set by lin_drag_u & _v - ! divided by the depth of the ocean. - logical :: linearized_BT_PV ! If true, the PV and interface thicknesses used - ! in the barotropic Coriolis calculation is time - ! invariant and linearized. - logical :: use_wide_halos ! If true, use wide halos and march in during the - ! barotropic time stepping for efficiency. - logical :: clip_velocity ! If true, limit any velocity components that are - ! are large enough for a CFL number to exceed - ! CFL_trunc. This should only be used as a - ! desperate debugging measure. - logical :: debug ! If true, write verbose checksums for debugging purposes. - logical :: debug_bt ! If true, write verbose checksums for debugging purposes. + real :: Rho0 !< The density used in the Boussinesq + !! approximation, in kg m-3. + real :: dtbt !< The barotropic time step, in s. + real :: dtbt_fraction !< The fraction of the maximum time-step that + !! should used. The default is 0.98. + real :: dtbt_max !< The maximum stable barotropic time step, in s. + real :: dt_bt_filter !< The time-scale over which the barotropic mode + !! solutions are filtered, in s. This can never + !! be taken to be longer than 2*dt. The default, 0, + !! applies no filtering. + integer :: nstep_last = 0 !< The number of barotropic timesteps per baroclinic + !! time step the last time btstep was called. + real :: bebt !< A nondimensional number, from 0 to 1, that + !! determines the gravity wave time stepping scheme. + !! 0.0 gives a forward-backward scheme, while 1.0 + !! give backward Euler. In practice, bebt should be + !! of order 0.2 or greater. + logical :: split !< If true, use the split time stepping scheme. + logical :: bound_BT_corr !< If true, the magnitude of the fake mass source + !! in the barotropic equation that drives the two + !! estimates of the free surface height toward each + !! other is bounded to avoid driving corrective + !! velocities that exceed MAXCFL_BT_CONT. + logical :: gradual_BT_ICs !< If true, adjust the initial conditions for the + !! barotropic solver to the values from the layered + !! solution over a whole timestep instead of + !! instantly. This is a decent approximation to the + !! inclusion of sum(u dh_dt) while also correcting + !! for truncation errors. + logical :: Sadourny !< If true, the Coriolis terms are discretized + !! with Sadourny's energy conserving scheme, + !! otherwise the Arakawa & Hsu scheme is used. If + !! the deformation radius is not resolved Sadourny's + !! scheme should probably be used. + logical :: Nonlinear_continuity !< If true, the barotropic continuity equation + !! uses the full ocean thickness for transport. + integer :: Nonlin_cont_update_period !< The number of barotropic time steps + !! between updates to the face area, or 0 only to + !! update at the start of a call to btstep. The + !! default is 1. + logical :: BT_project_velocity !< If true, step the barotropic velocity first + !! and project out the velocity tendancy by 1+BEBT + !! when calculating the transport. The default + !! (false) is to use a predictor continuity step to + !! find the pressure field, and then do a corrector + !! continuity step using a weighted average of the + !! old and new velocities, with weights of (1-BEBT) + !! and BEBT. + logical :: dynamic_psurf !< If true, add a dynamic pressure due to a viscous + !! ice shelf, for instance. + real :: Dmin_dyn_psurf !< The minimum depth to use in limiting the size + !! of the dynamic surface pressure for stability, + !! in m. + real :: ice_strength_length !< The length scale at which the damping rate + !! due to the ice strength should be the same as if + !! a Laplacian were applied, in m. + real :: const_dyn_psurf !< The constant that scales the dynamic surface + !! pressure, nondim. Stable values are < ~1.0. + !! The default is 0.9. + logical :: tides !< If true, apply tidal momentum forcing. + real :: G_extra !< A nondimensional factor by which gtot is enhanced. + integer :: hvel_scheme !< An integer indicating how the thicknesses at + !! velocity points are calculated. Valid values are + !! given by the parameters defined below: + !! HARMONIC, ARITHMETIC, HYBRID, and FROM_BT_CONT + logical :: strong_drag !< If true, use a stronger estimate of the retarding + !! effects of strong bottom drag. + logical :: linear_wave_drag !< If true, apply a linear drag to the barotropic + !! velocities, using rates set by lin_drag_u & _v + !! divided by the depth of the ocean. + logical :: linearized_BT_PV !< If true, the PV and interface thicknesses used + !! in the barotropic Coriolis calculation is time + !! invariant and linearized. + logical :: use_wide_halos !< If true, use wide halos and march in during the + !! barotropic time stepping for efficiency. + logical :: clip_velocity !< If true, limit any velocity components that are + !! are large enough for a CFL number to exceed + !! CFL_trunc. This should only be used as a + !! desperate debugging measure. + logical :: debug !< If true, write verbose checksums for debugging purposes. + logical :: debug_bt !< If true, write verbose checksums for debugging purposes. real :: vel_underflow !< Velocity components smaller than vel_underflow !! are set to 0, in m s-1. - real :: maxvel ! Velocity components greater than maxvel are - ! truncated to maxvel, in m s-1. - real :: CFL_trunc ! If clip_velocity is true, velocity components will - ! be truncated when they are large enough that the - ! corresponding CFL number exceeds this value, nondim. - real :: maxCFL_BT_cont ! The maximum permitted CFL number associated with the - ! barotropic accelerations from the summed velocities - ! times the time-derivatives of thicknesses. The - ! default is 0.1, and there will probably be real - ! problems if this were set close to 1. - logical :: BT_cont_bounds ! If true, use the BT_cont_type variables to set - ! limits on the magnitude of the corrective mass - ! fluxes. - logical :: visc_rem_u_uh0 ! If true, use the viscous remnants when estimating - ! the barotropic velocities that were used to - ! calculate uh0 and vh0. False is probably the - ! better choice. - logical :: adjust_BT_cont ! If true, adjust the curve fit to the BT_cont type - ! that is used by the barotropic solver to match the - ! transport about which the flow is being linearized. + real :: maxvel !< Velocity components greater than maxvel are + !! truncated to maxvel, in m s-1. + real :: CFL_trunc !< If clip_velocity is true, velocity components will + !! be truncated when they are large enough that the + !! corresponding CFL number exceeds this value, nondim. + real :: maxCFL_BT_cont !< The maximum permitted CFL number associated with the + !! barotropic accelerations from the summed velocities + !! times the time-derivatives of thicknesses. The + !! default is 0.1, and there will probably be real + !! problems if this were set close to 1. + logical :: BT_cont_bounds !< If true, use the BT_cont_type variables to set + !! limits on the magnitude of the corrective mass + !! fluxes. + logical :: visc_rem_u_uh0 !< If true, use the viscous remnants when estimating + !! the barotropic velocities that were used to + !! calculate uh0 and vh0. False is probably the + !! better choice. + logical :: adjust_BT_cont !< If true, adjust the curve fit to the BT_cont type + !! that is used by the barotropic solver to match the + !! transport about which the flow is being linearized. logical :: use_old_coriolis_bracket_bug !< If True, use an order of operations !! that is not bitwise rotationally symmetric in the !! meridional Coriolis term of the barotropic solver. - type(time_type), pointer :: Time ! A pointer to the ocean model's clock. - type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the - ! timing of diagnostic output. + type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate + !! the timing of diagnostic output. type(MOM_domain_type), pointer :: BT_Domain => NULL() - type(hor_index_type), pointer :: debug_BT_HI ! debugging copy of horizontal index_type + type(hor_index_type), pointer :: debug_BT_HI => NULL() !< debugging copy of horizontal index_type type(tidal_forcing_CS), pointer :: tides_CSp => NULL() logical :: module_is_initialized = .false. @@ -448,21 +448,25 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & !! viscosity is applied, in the zonal direction. Nondimensional !! between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: visc_rem_v !< Ditto for meridional direction. - real, dimension(SZI_(G),SZJ_(G)), intent(out), optional :: etaav !< The free surface height or column mass + real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: etaav !< The free surface height or column mass !! averaged over the barotropic integration, in m or kg m-2. - type(ocean_OBC_type), pointer, optional :: OBC !< The open boundary condition structure. - type(BT_cont_type), pointer, optional :: BT_cont !< A structure with elements that describe + type(ocean_OBC_type), optional, pointer :: OBC !< The open boundary condition structure. + type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe !! the effective open face areas as a function of barotropic !! flow. - real, dimension(:,:), pointer, optional :: eta_PF_start !< The eta field consistent with the pressure + real, dimension(:,:), optional, pointer :: eta_PF_start !< The eta field consistent with the pressure !! gradient at the start of the barotropic stepping, in m or !! kg m-2. - real, dimension(:,:), pointer, optional :: taux_bot !< The zonal bottom frictional stress from + real, dimension(:,:), optional, pointer :: taux_bot !< The zonal bottom frictional stress from !! ocean to the seafloor, in Pa. - real, dimension(:,:), pointer, optional :: tauy_bot !< The meridional bottom frictional stress + real, dimension(:,:), optional, pointer :: tauy_bot !< The meridional bottom frictional stress !! from ocean to the seafloor, in Pa. - real, dimension(:,:,:), pointer, optional :: uh0, u_uh0 - real, dimension(:,:,:), pointer, optional :: vh0, v_vh0 + real, dimension(:,:,:), optional, pointer :: uh0 !< The zonal layer transports at reference + !! velocities, in H m s-1. + real, dimension(:,:,:), optional, pointer :: u_uh0 !< The velocities used to calculate uh0, in m s-1 + real, dimension(:,:,:), optional, pointer :: vh0 !< The zonal layer transports at reference + !! velocities, in H m s-1. + real, dimension(:,:,:), optional, pointer :: v_vh0 !< The velocities used to calculate vh0, in m s-1 ! Local variables real :: ubt_Cor(SZIB_(G),SZJ_(G)) ! The barotropic velocities that had been @@ -554,7 +558,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & eta, & ! The barotropic free surface height anomaly or column mass ! anomaly, in H (m or kg m-2) eta_pred ! A predictor value of eta, in H (m or kg m-2) like eta. - real, pointer, dimension(:,:) :: & + real, dimension(:,:), pointer :: & eta_PF_BT ! A pointer to the eta array (either eta or eta_pred) that ! determines the barotropic pressure force, in H (m or kg m-2) real, dimension(SZIW_(CS),SZJW_(CS)) :: & @@ -2277,22 +2281,24 @@ end subroutine btstep !> This subroutine automatically determines an optimal value for dtbt based !! on some state of the ocean. subroutine set_dtbt(G, GV, CS, eta, pbce, BT_cont, gtot_est, SSH_add) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(barotropic_CS), pointer :: CS !< Barotropic control structure. - real, dimension(SZI_(G),SZJ_(G)), intent(in), optional :: eta !< The barotropic free surface height - !! anomaly or column mass anomaly, in H. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in), optional :: pbce !< The baroclinic pressure anomaly in each - !! layer due to free surface height - !! anomalies, in m2 H-1 s-2. - type(BT_cont_type), pointer, optional :: BT_cont !< A structure with elements that describe - !! the effective open face areas as a - !! function of barotropic flow. - real, intent(in), optional :: gtot_est !< An estimate of the total gravitational - !! acceleration, in m s-2. - real, intent(in), optional :: SSH_add !< An additional contribution to SSH to - !! provide a margin of error when - !! calculating the external wave speed, in m. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(barotropic_CS), pointer :: CS !< Barotropic control structure. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(in) :: eta !< The barotropic free surface height + !! anomaly or column mass anomaly, in H. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + optional, intent(in) :: pbce !< The baroclinic pressure anomaly in each + !! layer due to free surface height + !! anomalies, in m2 H-1 s-2. + type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe + !! the effective open face areas as a + !! function of barotropic flow. + real, optional, intent(in) :: gtot_est !< An estimate of the total gravitational + !! acceleration, in m s-2. + real, optional, intent(in) :: SSH_add !< An additional contribution to SSH to + !! provide a margin of error when + !! calculating the external wave speed, in m. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & @@ -2881,22 +2887,25 @@ end subroutine destroy_BT_OBC !! that will drive the barotropic estimate of the free surface height toward the !! baroclinic estimate. subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). - type(barotropic_CS), pointer :: CS !< The control structure returned by a previous - !! call to barotropic_init. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in), optional :: h_u !< The specified thicknesses at u-points, - !! in m or kg m-2. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in), optional :: h_v !< The specified thicknesses at v-points, - !! in m or kg m-2. - logical, intent(in), optional :: may_use_default !< An optional logical argument - !! to indicate that the default velocity point - !! thickesses may be used for this particular - !! calculation, even though the setting of - !! CS%hvel_scheme would usually require that h_u - !! and h_v be passed in. - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundary control structure. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + type(barotropic_CS), pointer :: CS !< The control structure returned by a previous + !! call to barotropic_init. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(in) :: h_u !< The specified thicknesses at u-points, + !! in m or kg m-2. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(in) :: h_v !< The specified thicknesses at v-points, + !! in m or kg m-2. + logical, optional, intent(in) :: may_use_default !< An optional logical argument + !! to indicate that the default velocity point + !! thickesses may be used for this particular + !! calculation, even though the setting of + !! CS%hvel_scheme would usually require that h_u + !! and h_v be passed in. + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundary control structure. ! Local variables ! All of these variables are in the same units as h - usually m or kg m-2. @@ -3651,8 +3660,7 @@ end subroutine swap !> This subroutine determines the open face areas of cells for calculating !! the barotropic transport. subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) - type(memory_size_type), intent(in) :: MS -! (in) MS - A type that describes the memory sizes of the argument arrays. + type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the argument arrays. real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), & intent(out) :: Datu !< The open zonal face area, in H m (m2 or kg m-1). real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), & From 073b223631627a877e24f384bd2d5b70dc85f692 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 3 May 2018 11:10:15 -0400 Subject: [PATCH 0163/1072] Added dOxyGen comments in MOM_checksum_packages All arguments in MOM_checksum_packages are now described in dOxyGen comments. --- src/core/MOM_checksum_packages.F90 | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index f1f0ed9733..e7f84ed944 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -49,8 +49,9 @@ subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, haloshift, symmet real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: vh !< Volume flux through meridional !! faces = v*h*dx, in m3 s-1. - integer, optional, intent(in) :: haloshift - logical, optional, intent(in) :: symmetric + integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). + logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric + !! computationoal domain. ! This subroutine writes out chksums for the model's basic state variables. ! Arguments: mesg - A message that appears on the chksum lines. ! (in) u - Zonal velocity, in m s-1. @@ -87,8 +88,9 @@ subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, haloshift, symmetric) intent(in) :: v !< Meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). - integer, optional, intent(in) :: haloshift - logical, optional, intent(in) :: symmetric + integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). + logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric + !! computationoal domain. ! This subroutine writes out chksums for the model's basic state variables. ! Arguments: mesg - A message that appears on the chksum lines. ! (in) u - Zonal velocity, in m s-1. @@ -118,7 +120,7 @@ subroutine MOM_thermo_chksum(mesg, tv, G, haloshift) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - integer, optional, intent(in) :: haloshift + integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). ! This subroutine writes out chksums for the model's thermodynamic state ! variables. ! Arguments: mesg - A message that appears on the chksum lines. @@ -144,8 +146,9 @@ subroutine MOM_surface_chksum(mesg, sfc, G, haloshift, symmetric) !! structure shared with the calling routine; !! data in this structure is intent out. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - integer, optional, intent(in) :: haloshift - logical, optional, intent(in) :: symmetric + integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). + logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric + !! computationoal domain. ! This subroutine writes out chksums for the model's thermodynamic state ! variables. ! Arguments: mesg - A message that appears on the chksum lines. @@ -204,7 +207,8 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, pbce, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(in) :: v_accel_bt !< The meridional acceleration from terms in !! the barotropic solver,in m s-2. - logical, optional, intent(in) :: symmetric + logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric + !! computationoal domain. ! This subroutine writes out chksums for the model's accelerations. ! Arguments: mesg - A message that appears on the chksum lines. @@ -262,11 +266,9 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi intent(in) :: Temp !< Temperature in degree C. real, pointer, dimension(:,:,:), & intent(in) :: Salt !< Salinity, in ppt. - - logical, optional, intent(in) :: allowChange !< do not flag an error - !! if the statistics change. - logical, optional, & - intent(in) :: permitDiminishing !< do not flag error + logical, optional, intent(in) :: allowChange !< do not flag an error + !! if the statistics change. + logical, optional, intent(in) :: permitDiminishing !< do not flag error !!if the extrema are diminishing. ! This subroutine monitors statistics for the model's state variables. ! Arguments: mesg - A message that appears on the chksum lines. From 75b205c80e41dd0b1729e22f83b7bbdcb7b82853 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 3 May 2018 11:11:01 -0400 Subject: [PATCH 0164/1072] Cleaned up argument descriptions in MOM_continuity Cleaned up the argument descriptions in the MOM_continuity and MOM_continuity_PPM modules, so a grep can now clearly show that all arguments have dOxyGen comments. All answers are bitwise identical. --- src/core/MOM_continuity.F90 | 70 +++++--- src/core/MOM_continuity_PPM.F90 | 290 +++++++++++++++++--------------- 2 files changed, 197 insertions(+), 163 deletions(-) diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index f4c3bb6d66..121bbfbdb0 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -41,44 +41,62 @@ module MOM_continuity subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, & visc_rem_u, visc_rem_v, u_cor, v_cor, & uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) - type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure. - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity, in m/s. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity, in m/s. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: hin !< Initial layer thickness, in m or kg/m2. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Final layer thickness, in m or kg/m2. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uh !< Volume flux through zonal faces = - !! u*h*dy, in m3/s. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vh !< Volume flux through meridional faces = - !! v*h*dx, in m3/s. - real, intent(in) :: dt !< Time increment, in s. - type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. - real, dimension(SZIB_(G),SZJ_(G)), intent(in), optional :: uhbt !< The vertically summed volume - !! flux through zonal faces, in m3/s. - real, dimension(SZI_(G),SZJB_(G)), intent(in), optional :: vhbt !< The vertically summed volume - !! flux through meridional faces, in m3/s. - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundaries control structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in), optional :: visc_rem_u !< Both the fraction of + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: u !< Zonal velocity, in m/s. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: v !< Meridional velocity, in m/s. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: hin !< Initial layer thickness, in m or kg/m2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: h !< Final layer thickness, in m or kg/m2. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: uh !< Volume flux through zonal faces = + !! u*h*dy, in m3/s. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(out) :: vh !< Volume flux through meridional faces = + !! v*h*dx, in m3/s. + real, intent(in) :: dt !< Time increment, in s. + type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. + real, dimension(SZIB_(G),SZJ_(G)), & + optional, intent(in) :: uhbt !< The vertically summed volume + !! flux through zonal faces, in m3/s. + real, dimension(SZI_(G),SZJB_(G)), & + optional, intent(in) :: vhbt !< The vertically summed volume + !! flux through meridional faces, in m3/s. + type(ocean_OBC_type), & + optional, pointer :: OBC !< Open boundaries control structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(in) :: visc_rem_u !< Both the fraction of !! zonal momentum that remains after a time-step of viscosity, and the fraction of a time-step's !! worth of a barotropic acceleration that a layer experiences after viscosity is applied. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in), optional :: visc_rem_v !< Both the fraction of + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(in) :: visc_rem_v !< Both the fraction of !! meridional momentum that remains after a time-step of viscosity, and the fraction of a time-step's !! worth of a barotropic acceleration that a layer experiences after viscosity is applied. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out), optional :: u_cor !< The zonal velocities that + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(out) :: u_cor !< The zonal velocities that !! give uhbt as the depth-integrated transport, in m/s. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out), optional :: v_cor !< The meridional velocities that + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(out) :: v_cor !< The meridional velocities that !! give vhbt as the depth-integrated transport, in m/s. - real, dimension(SZIB_(G),SZJ_(G)), intent(in), optional :: uhbt_aux !< A second summed zonal + real, dimension(SZIB_(G),SZJ_(G)), & + optional, intent(in) :: uhbt_aux !< A second summed zonal !! volume flux in m3/s. - real, dimension(SZI_(G),SZJB_(G)), intent(in), optional :: vhbt_aux !< A second summed meridional + real, dimension(SZI_(G),SZJB_(G)), & + optional, intent(in) :: vhbt_aux !< A second summed meridional !! volume flux in m3/s. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout), optional :: u_cor_aux !< The zonal velocities + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(inout) :: u_cor_aux !< The zonal velocities !! that give uhbt_aux as the depth-integrated transport, in m/s. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout), optional :: v_cor_aux !< The meridional velocities + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(inout) :: v_cor_aux !< The meridional velocities !! that give vhbt_aux as the depth-integrated transport, in m/s. - type(BT_cont_type), pointer, optional :: BT_cont !< A structure with elements + type(BT_cont_type), & + optional, pointer :: BT_cont !< A structure with elements !! that describe the effective open face areas as a function of barotropic flow. if (present(visc_rem_u) .neqv. present(visc_rem_v)) call MOM_error(FATAL, & diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index cfab905b28..bd0c7bbcd7 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -77,45 +77,59 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, ! In the following documentation, H is used for the units of thickness (usually m or kg m-2.) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(continuity_PPM_CS), pointer :: CS !< Module's control structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity, in m s-1. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity, in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: hin !< Initial layer thickness, in H. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Final layer thickness, in H. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uh !< Zonal volume flux, - !! u*h*dy, H m2 s-1. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vh !< Meridional volume flux, - !! v*h*dx, H m2 s-1. - real, intent(in) :: dt !< Time increment in s. - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - real, dimension(SZIB_(G),SZJ_(G)), intent(in), optional :: uhbt - !< The summed volume flux through zonal faces, H m2 s-1. - real, dimension(SZI_(G),SZJB_(G)), intent(in), optional :: vhbt - !< The summed volume flux through meridional faces, H m2 s-1. - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundaries control structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in), optional :: visc_rem_u - !< The fraction of zonal momentum originally in a layer that remains after a time-step - !! of viscosity, and the fraction of a time-step's worth of a barotropic acceleration that - !! a layer experiences after viscosity is applied. - !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in), optional :: visc_rem_v - !< The fraction of meridional momentum originally in a layer that remains after a time-step - !! of viscosity, and the fraction of a time-step's worth of a barotropic acceleration that - !! a layer experiences after viscosity is applied. - !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out), optional :: u_cor - !< The zonal velocities that give uhbt as the depth-integrated transport, in m s-1. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out), optional :: v_cor - !< The meridional velocities that give vhbt as the depth-integrated transport, in m s-1. - real, dimension(SZIB_(G),SZJ_(G)), intent(in), optional :: uhbt_aux - !< A second set of summed volume fluxes through zonal faces, in H m2 s-1. - real, dimension(SZI_(G),SZJB_(G)), intent(in), optional :: vhbt_aux - !< A second set of summed volume fluxes through meridional faces, in H m2 s-1. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out), optional :: u_cor_aux - !< The zonal velocities that give uhbt_aux as the depth-integrated transports, in m s-1. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out), optional :: v_cor_aux - !< The meridional velocities that give vhbt_aux as the depth-integrated transports, in m s-1. - type(BT_cont_type), pointer, optional :: BT_cont !< A structure with - !! elements that describe the effective open face areas as a function of barotropic flow. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: u !< Zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: v !< Meridional velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: hin !< Initial layer thickness, in H. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: h !< Final layer thickness, in H. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: uh !< Zonal volume flux, u*h*dy, H m2 s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(out) :: vh !< Meridional volume flux, v*h*dx, H m2 s-1. + real, intent(in) :: dt !< Time increment in s. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + real, dimension(SZIB_(G),SZJ_(G)), & + optional, intent(in) :: uhbt !< The summed volume flux through zonal faces, H m2 s-1. + real, dimension(SZI_(G),SZJB_(G)), & + optional, intent(in) :: vhbt !< The summed volume flux through meridional faces, H m2 s-1. + type(ocean_OBC_type), & + optional, pointer :: OBC !< Open boundaries control structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(in) :: visc_rem_u !< The fraction of zonal momentum originally + !! in a layer that remains after a time-step of viscosity, and the + !! fraction of a time-step's worth of a barotropic acceleration that + !! a layer experiences after viscosity is applied. + !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(in) :: visc_rem_v !< The fraction of meridional momentum originally + !! in a layer that remains after a time-step of viscosity, and the + !! fraction of a time-step's worth of a barotropic acceleration that + !! a layer experiences after viscosity is applied. + !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(out) :: u_cor !< The zonal velocities that give uhbt as the + !! depth-integrated transport, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(out) :: v_cor !< The meridional velocities that give vhbt as the + !! depth-integrated transport, in m s-1. + real, dimension(SZIB_(G),SZJ_(G)), & + optional, intent(in) :: uhbt_aux !< A second set of summed volume fluxes + !! through zonal faces, in H m2 s-1. + real, dimension(SZI_(G),SZJB_(G)), & + optional, intent(in) :: vhbt_aux !< A second set of summed volume fluxes + !! through meridional faces, in H m2 s-1. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(out) :: u_cor_aux !< The zonal velocities that give uhbt_aux + !! as the depth-integrated transports, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(out) :: v_cor_aux !< The meridional velocities that give + !! vhbt_aux as the depth-integrated transports, in m s-1. + type(BT_cont_type), & + optional, pointer :: BT_cont !< A structure with elements that describe + !! the effective open face areas as a function of barotropic flow. ! Local variables real :: h_min ! The minimum layer thickness, in H. h_min could be 0. @@ -207,35 +221,39 @@ end subroutine continuity_PPM !> Calculates the mass or volume fluxes through the zonal faces, and other related quantities. subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & visc_rem_u, u_cor, uhbt_aux, u_cor_aux, BT_cont) - type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity, in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to - !! calculate fluxes, in H. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uh !< Volume flux through zonal - !! faces = u*h*dy, H m2 s-1. - real, intent(in) :: dt !< Time increment in s. - type(continuity_PPM_CS), pointer :: CS !< This module's control structure. - type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundaries control structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in), optional :: visc_rem_u !< - !! The fraction of zonal momentum originally in a layer that remains after a time-step - !! of viscosity, and the fraction of a time-step's worth of a barotropic acceleration that - !! a layer experiences after viscosity is applied. - !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZIB_(G),SZJ_(G)), intent(in), optional :: uhbt - !< The summed volume flux through zonal faces, H m2 s-1. - real, dimension(SZIB_(G),SZJ_(G)), intent(in), optional :: uhbt_aux - !< A second set of summed volume fluxes through zonal faces, in H m2 s-1. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out), optional :: u_cor - !< The zonal velocitiess (u with a barotropic correction) - !! that give uhbt as the depth-integrated transport, m s-1. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out), optional :: u_cor_aux - !< The zonal velocities (u with a barotropic correction) - !! that give uhbt_aux as the depth-integrated transports, in m s-1. - type(BT_cont_type), pointer, optional :: BT_cont !< - !< A structure with elements that describe the effective - !! open face areas as a function of barotropic flow. + type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: u !< Zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_in !< Layer thickness used to calculate fluxes, in H. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: uh !< Volume flux through zonal faces = u*h*dy, H m2 s-1. + real, intent(in) :: dt !< Time increment in s. + type(continuity_PPM_CS), pointer :: CS !< This module's control structure. + type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. + type(ocean_OBC_type), & + optional, pointer :: OBC !< Open boundaries control structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(in) :: visc_rem_u !< The fraction of zonal momentum + !! originally in a layer that remains after a time-step of viscosity, + !! and the fraction of a time-step's worth of a barotropic acceleration that + !! a layer experiences after viscosity is applied. Non-dimensional + !! between 0 (at the bottom) and 1 (far above the bottom). + real, dimension(SZIB_(G),SZJ_(G)), & + optional, intent(in) :: uhbt !< The summed volume flux through zonal faces, H m2 s-1. + real, dimension(SZIB_(G),SZJ_(G)), & + optional, intent(in) :: uhbt_aux !< A second set of summed volume fluxes through + !! zonal faces, in H m2 s-1. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(out) :: u_cor !< The zonal velocitiess (u with a barotropic correction) + !! that give uhbt as the depth-integrated transport, m s-1. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(out) :: u_cor_aux !< The zonal velocities (u with a barotropic correction) + !! that give uhbt_aux as the depth-integrated transports, in m s-1. + type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe the effective + !! open face areas as a function of barotropic flow. + ! Local variables real, dimension(SZIB_(G),SZK_(G)) :: duhdu ! Partial derivative of uh with u, in H m. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_L, h_R ! Left and right face thicknesses, in H. @@ -532,7 +550,7 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, & logical, dimension(SZIB_(G)), intent(in) :: do_I !< Which i values to work on. logical, intent(in) :: vol_CFL !< If true, rescale the !! ratio of face areas to the cell areas when estimating the CFL number. - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. real :: curv_3 ! A measure of the thickness curvature over a grid length, @@ -599,20 +617,17 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, & !! in H. real, intent(in) :: dt !< Time increment in s. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. - logical, intent(in) :: vol_CFL !< - !! If true, rescale the ratio of face areas to the cell - !! areas when estimating the CFL number. - logical, intent(in) :: marginal !< - !! If true, report the marginal face thicknesses; otherwise - !! report transport-averaged thicknesses. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in), optional :: visc_rem_u !< - !! Both the fraction of the momentum originally in a - !! layer that remains after a time-step of viscosity, - !! and the fraction of a time-step's worth of a - !! barotropic acceleration that a layer experiences - !! after viscosity is applied. Non-dimensional between - !! 0 (at the bottom) and 1 (far above the bottom). - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundaries control structure. + logical, intent(in) :: vol_CFL !< If true, rescale the ratio + !! of face areas to the cell areas when estimating the CFL number. + logical, intent(in) :: marginal !< If true, report the + !! marginal face thicknesses; otherwise report transport-averaged thicknesses. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(in) :: visc_rem_u !< Both the fraction of + !! the momentum originally in a layer that remains after a time-step of + !! viscosity, and the fraction of a time-step's worth of a barotropic + !! acceleration that a layer experiences after viscosity is applied. + !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. @@ -713,7 +728,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & !! barotropic acceleration that a layer experiences !! after viscosity is applied. Non-dimensional between !! 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZIB_(G)), intent(in), optional :: uhbt !< + real, dimension(SZIB_(G)), optional, intent(in) :: uhbt !< !! The summed volume flux through zonal faces, H m2 s-1. real, dimension(SZIB_(G)), intent(in) :: du_max_CFL !< Maximum acceptable !! value of du, in m s-1. @@ -732,12 +747,12 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & integer, intent(in) :: ieh !< End of index range. logical, dimension(SZIB_(G)), intent(in) :: do_I_in !< !! A logical flag indicating which I values to work on. - logical, intent(in), optional :: full_precision !< + logical, optional, intent(in) :: full_precision !< !! A flag indicating how carefully to iterate. The !! default is .true. (more accurate). - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout), optional :: uh_3d !< + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), optional, intent(inout) :: uh_3d !< !! Volume flux through zonal faces = u*h*dy, H m2 s-1. - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZIB_(G),SZK_(G)) :: & uh_aux, & ! An auxiliary zonal volume flux, in H m s-1. @@ -1039,28 +1054,33 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & real, intent(in) :: dt !< Time increment in s. type(continuity_PPM_CS), pointer :: CS !< This module's control structure. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. - type(ocean_OBC_type), pointer, optional :: OBC !< + type(ocean_OBC_type), optional, pointer :: OBC !< !! This open boundary condition type specifies whether, where, !! and what open boundary conditions are used. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in), optional :: visc_rem_v !< + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(in) :: visc_rem_v !< !! Both the fraction of the momentum originally in a !! layer that remains after a time-step of viscosity, !! and the fraction of a time-step's worth of a !! barotropic acceleration that a layer experiences !! after viscosity is applied. Nondimensional between !! 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZI_(G),SZJB_(G)), intent(in), optional :: vhbt !< + real, dimension(SZI_(G),SZJB_(G)), & + optional, intent(in) :: vhbt !< !! The summed volume flux through meridional faces, H m2 s-1. - real, dimension(SZI_(G),SZJB_(G)), intent(in), optional :: vhbt_aux !< + real, dimension(SZI_(G),SZJB_(G)), & + optional, intent(in) :: vhbt_aux !< !! A second set of summed volume fluxes through meridional !! faces, in H m2 s-1. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out), optional :: v_cor !< + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(out) :: v_cor !< !! The meridional velocitiess (v with a barotropic correction) !! that give vhbt as the depth-integrated transport, m s-1. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out), optional :: v_cor_aux !< + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(out) :: v_cor_aux !< !! The meridional velocities (v with a barotropic correction) !! that give vhbt_aux as the depth-integrated transports, in m s-1. - type(BT_cont_type), pointer, optional :: BT_cont !< + type(BT_cont_type), optional, pointer :: BT_cont !< !! A structure with elements that describe the effective ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & @@ -1362,7 +1382,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, & logical, dimension(SZI_(G)), intent(in) :: do_I !< Which i values to work on. logical, intent(in) :: vol_CFL !< If true, rescale the !! ratio of face areas to the cell areas when estimating the CFL number. - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. real :: curv_3 ! A measure of the thickness curvature over a grid length, @@ -1436,14 +1456,14 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & logical, intent(in) :: marginal !< !! If true, report the marginal face thicknesses; otherwise !! report transport-averaged thicknesses. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in), optional :: visc_rem_v !< + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), optional, intent(in) :: visc_rem_v !< !! Both the fraction of the momentum originally in a !! layer that remains after a time-step of viscosity, !! and the fraction of a time-step's worth of a !! barotropic acceleration that a layer experiences !! after viscosity is applied. Non-dimensional between !! 0 (at the bottom) and 1 (far above the bottom). - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. @@ -1530,46 +1550,42 @@ end subroutine merid_face_thickness subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0, & dv, dv_max_CFL, dv_min_CFL, dt, G, CS, visc_rem, & j, ish, ieh, do_I_in, full_precision, vh_3d, OBC) - type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity, in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to - !! calculate fluxes, in H. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the - !! reconstruction, in H. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the - !! reconstruction, in H. - real, dimension(SZI_(G),SZK_(G)), intent(in) :: visc_rem !< - !! Both the fraction of the momentum originally in a - !! layer that remains after a time-step of viscosity, - !! and the fraction of a time-step's worth of a - !! barotropic acceleration that a layer experiences - !! after viscosity is applied. Non-dimensional between - !! 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZI_(G)), intent(in), optional :: vhbt !< - !! The summed volume flux through meridional faces, H m2 s-1. - real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value - !! of dv, in m s-1. - real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value - !! of dv, in m s-1. - real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< - !! The summed transport with 0 adjustment, in H m2 s-1. - real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< - !! The partial derivative of dv_err with dv at 0 adjustment, in H m. - real, dimension(SZI_(G)), intent(out) :: dv !< - !! The barotropic velocity adjustment, in m s-1. - real, intent(in) :: dt !< Time increment in s. - type(continuity_PPM_CS), pointer :: CS !< This module's control structure. - integer, intent(in) :: j !< Spatial index. - integer, intent(in) :: ish !< Start of index range. - integer, intent(in) :: ieh !< End of index range. - logical, dimension(SZI_(G)), intent(in) :: do_I_in !< - !! A logical flag indicating which I values to work on. - logical, intent(in), optional :: full_precision !< - !! full_precision - A flag indicating how carefully to iterate. The - !! default is .true. (more accurate). - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout), optional :: vh_3d !< - !! Volume flux through meridional faces = v*h*dx, H m2 s-1. - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundaries control structure. + type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: v !< Meridional velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_in !< Layer thickness used to calculate fluxes, in H. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& + intent(in) :: h_L !< Left thickness in the reconstruction, in H. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_R !< Right thickness in the reconstruction, in H. + real, dimension(SZI_(G),SZK_(G)), & + intent(in) :: visc_rem !< Both the fraction of the momentum originally + !! in a layer that remains after a time-step of viscosity, and the + !! fraction of a time-step's worth of a barotropic acceleration that + !! a layer experiences after viscosity is applied. Non-dimensional + !! between 0 (at the bottom) and 1 (far above the bottom). + real, dimension(SZI_(G)), & + optional, intent(in) :: vhbt !< The summed volume flux through meridional faces, H m2 s-1. + real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv, in m s-1. + real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv, in m s-1. + real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< The summed transport with 0 adjustment, in H m2 s-1. + real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< The partial derivative of dv_err with + !! dv at 0 adjustment, in H m. + real, dimension(SZI_(G)), intent(out) :: dv !< The barotropic velocity adjustment, in m s-1. + real, intent(in) :: dt !< Time increment in s. + type(continuity_PPM_CS), pointer :: CS !< This module's control structure. + integer, intent(in) :: j !< Spatial index. + integer, intent(in) :: ish !< Start of index range. + integer, intent(in) :: ieh !< End of index range. + logical, dimension(SZI_(G)), & + intent(in) :: do_I_in !< A flag indicating which I values to work on. + logical, optional, intent(in) :: full_precision !< A flag indicating + !! how carefully to iterate. The default is .true. (more accurate). + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(inout) :: vh_3d !< Volume flux through + !! meridional faces = v*h*dx, H m2 s-1. + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & vh_aux, & ! An auxiliary meridional volume flux, in H m s-1. From 705471f8afbd9969d99088cdff610f4a4e18cbbe Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 3 May 2018 11:11:29 -0400 Subject: [PATCH 0165/1072] Added dOxyGen comments for set_first_direction --- src/core/MOM_grid.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 86aa5bddb7..c65504041b 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -434,9 +434,10 @@ logical function isPointInCell(G, i, j, x, y) endif end function isPointInCell +!> Store an integer indicating which direction to work on first. subroutine set_first_direction(G, y_first) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - integer, intent(in) :: y_first + integer, intent(in) :: y_first !< The first direction to store G%first_direction = y_first end subroutine set_first_direction From d3ea8c91770f74475d7b6f4f941de75f3d8d4e41 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 3 May 2018 11:11:45 -0400 Subject: [PATCH 0166/1072] Added dOxyGen comments for calc_isoneutral_slopes --- src/core/MOM_isopycnal_slopes.F90 | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index bb96f82fe4..f6aafaef63 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -24,13 +24,14 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface heights (m) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - real, intent(in) :: dt_kappa_smooth + real, intent(in) :: dt_kappa_smooth !< A vertical diffusive smoothing timescale, in s. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: slope_x !< Isopycnal slope in i-direction (nondim) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: slope_y !< Isopycnal slope in j-direction (nondim) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: N2_u !< Brunt-Vaisala frequency squared at u-points (s-2) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: N2_v !< Brunt-Vaisala frequency squared at u-points (s-2) - optional :: N2_u, N2_v - integer, optional, intent(in) :: halo !< Halo width over which to compute + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), & + optional, intent(inout) :: N2_u !< Brunt-Vaisala frequency squared at u-points (s-2) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), & + optional, intent(inout) :: N2_v !< Brunt-Vaisala frequency squared at u-points (s-2) + integer, optional, intent(in) :: halo !< Halo width over which to compute ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & T, & ! The temperature (or density) in C, with the values in From afb4318ca33f0ec72a9102d6a725660def7dc1f0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 3 May 2018 11:12:02 -0400 Subject: [PATCH 0167/1072] Added dOxyGen comments in MOM_open_boundary Added dOxyGen comments or intent declarations for several arguments to parse_segment_str, setup_[uv]_point_obc and register_segment_tracer. Also reversed the order of the optional and intent qualifiers for several arguments, to follow the pattern elsewhere in MOM6. All answers are bitise identical. --- src/core/MOM_open_boundary.F90 | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 6b59addd0b..41893d8dd5 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -699,7 +699,7 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF) type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure character(len=*), intent(in) :: segment_str !< A string in form of "I=%,J=%:%,string" integer, intent(in) :: l_seg !< which segment is this? - type(param_file_type), intent(in) :: PF + type(param_file_type), intent(in) :: PF !< Parameter file handle ! Local variables integer :: I_obc, Js_obc, Je_obc ! Position of segment in global index space integer :: j, a_loop @@ -800,7 +800,7 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF) type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure character(len=*), intent(in) :: segment_str !< A string in form of "J=%,I=%:%,string" integer, intent(in) :: l_seg !< which segment is this? - type(param_file_type), intent(in) :: PF + type(param_file_type), intent(in) :: PF !< Parameter file handle ! Local variables integer :: J_obc, Is_obc, Ie_obc ! Position of segment in global index space integer :: i, a_loop @@ -990,13 +990,14 @@ end subroutine parse_segment_str !> Parse an OBC_SEGMENT_%%%_DATA string subroutine parse_segment_data_str(segment_str, var, value, filenam, fieldnam, fields, num_fields, debug ) character(len=*), intent(in) :: segment_str !< A string in form of "VAR1=file:foo1.nc(varnam1),VAR2=file:foo2.nc(varnam2),..." - character(len=*), intent(in), optional :: var !< The name of the variable for which parameters are needed - character(len=*), intent(out), optional :: filenam !< The name of the input file if using "file" method - character(len=*), intent(out), optional :: fieldnam !< The name of the variable in the input file if using "file" method - real, intent(out), optional :: value !< A constant value if using the "value" method - character(len=*), dimension(MAX_OBC_FIELDS), intent(out), optional :: fields !< List of fieldnames for each segment - integer, intent(out), optional :: num_fields - logical, intent(in), optional :: debug + character(len=*), optional, intent(in) :: var !< The name of the variable for which parameters are needed + character(len=*), optional, intent(out) :: filenam !< The name of the input file if using "file" method + character(len=*), optional, intent(out) :: fieldnam !< The name of the variable in the input file if using "file" method + real, optional, intent(out) :: value !< A constant value if using the "value" method + character(len=*), dimension(MAX_OBC_FIELDS), & + optional, intent(out) :: fields !< List of fieldnames for each segment + integer, optional, intent(out) :: num_fields !< The number of fields in the segment data + logical, optional, intent(in) :: debug !< If present and true, write verbose debugging messages ! Local variables character(len=128) :: word1, word2, word3, method integer :: lword, nfields, n, m, orient @@ -1077,7 +1078,7 @@ subroutine parse_segment_param_real(segment_str, var, param_value, debug ) character(len=*), intent(in) :: segment_str !< A string in form of "VAR1=file:foo1.nc(varnam1),VAR2=file:foo2.nc(varnam2),..." character(len=*), intent(in) :: var !< The name of the variable for which parameters are needed real, intent(out) :: param_value !< The value of the parameter - logical, intent(in), optional :: debug + logical, optional, intent(in) :: debug !< If present and true, write verbose debugging messages ! Local variables character(len=128) :: word1, word2, word3, method integer :: lword, nfields, n, m, orient @@ -2621,9 +2622,9 @@ subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, & !! available subsequently to the tracer registry. type(param_file_type), intent(in) :: param_file !< file to parse for model parameter values type(OBC_segment_type), intent(inout) :: segment !< current segment data structure - real, optional :: OBC_scalar !< If present, use scalar value for segment tracer + real, optional, intent(in) :: OBC_scalar !< If present, use scalar value for segment tracer !! inflow concentration. - logical, optional :: OBC_array !< If true, use array values for segment tracer + logical, optional, intent(in) :: OBC_array !< If true, use array values for segment tracer !! inflow concentration. From 187a40aa40ef84abd3842727e55504fd015ade92 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 3 May 2018 11:12:46 -0400 Subject: [PATCH 0168/1072] Added dOxyGen comments for alloc_BT_cont_type Added dOxyGen comments for MOM_thermovar_chksum and alloc_BT_cont_type, and eliminated some unused variables and inapplicable comments. All answers are bitwise identical. --- src/core/MOM_variables.F90 | 31 +++++++++++-------------------- 1 file changed, 11 insertions(+), 20 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index f7fa45f12c..7425906de4 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -359,9 +359,10 @@ end subroutine deallocate_surface_state !> alloc_BT_cont_type allocates the arrays contained within a BT_cont_type and !! initializes them to 0. subroutine alloc_BT_cont_type(BT_cont, G, alloc_faces) - type(BT_cont_type), pointer :: BT_cont + type(BT_cont_type), pointer :: BT_cont !< The BT_cont_type whose elements will be allocated type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - logical, optional, intent(in) :: alloc_faces + logical, optional, intent(in) :: alloc_faces !< If present and true, allocate + !! memory for effective face thicknesses. integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -416,33 +417,23 @@ end subroutine dealloc_BT_cont_type !> MOM_thermovar_chksum does diagnostic checksums on various elements of a !! thermo_var_ptrs type for debugging. subroutine MOM_thermovar_chksum(mesg, tv, G) - character(len=*), intent(in) :: mesg - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure -! This subroutine writes out chksums for the model's basic state variables. -! Arguments: mesg - A message that appears on the chksum lines. -! (in) u - Zonal velocity, in m s-1. -! (in) v - Meridional velocity, in m s-1. -! (in) h - Layer thickness, in m. -! (in) uh - Volume flux through zonal faces = u*h*dy, m3 s-1. -! (in) vh - Volume flux through meridional faces = v*h*dx, in m3 s-1. -! (in) G - The ocean's grid structure. - integer :: is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + character(len=*), intent(in) :: mesg !< A message that appears in the checksum lines + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure ! Note that for the chksum calls to be useful for reproducing across PE ! counts, there must be no redundant points, so all variables use is..ie ! and js...je as their extent. if (associated(tv%T)) & - call hchksum(tv%T, mesg//" tv%T",G%HI) + call hchksum(tv%T, mesg//" tv%T", G%HI) if (associated(tv%S)) & - call hchksum(tv%S, mesg//" tv%S",G%HI) + call hchksum(tv%S, mesg//" tv%S", G%HI) if (associated(tv%frazil)) & - call hchksum(tv%frazil, mesg//" tv%frazil",G%HI) + call hchksum(tv%frazil, mesg//" tv%frazil", G%HI) if (associated(tv%salt_deficit)) & - call hchksum(tv%salt_deficit, mesg//" tv%salt_deficit",G%HI) + call hchksum(tv%salt_deficit, mesg//" tv%salt_deficit", G%HI) if (associated(tv%TempxPmE)) & - call hchksum(tv%TempxPmE, mesg//" tv%TempxPmE",G%HI) + call hchksum(tv%TempxPmE, mesg//" tv%TempxPmE", G%HI) end subroutine MOM_thermovar_chksum end module MOM_variables From 6f7f67bc8bb4412ebee35447666c5e61a687bfdc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 3 May 2018 11:13:07 -0400 Subject: [PATCH 0169/1072] dOxyGenized the vertical_grid_type Added dOxyGen comments for elements of the verticalGrid_type and the arguments to verticalGridInit. All answers are bitwise identical. --- src/core/MOM_verticalGrid.F90 | 80 +++++++++++++++++------------------ 1 file changed, 40 insertions(+), 40 deletions(-) diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index a57bd1f61f..c03a811400 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -16,50 +16,50 @@ module MOM_verticalGrid type, public :: verticalGrid_type ! Commonly used parameters - integer :: ke ! The number of layers/levels in the vertical - real :: max_depth ! The maximum depth of the ocean in meters. - real :: g_Earth ! The gravitational acceleration in m s-2. - real :: Rho0 ! The density used in the Boussinesq approximation or - ! nominal density used to convert depths into mass - ! units, in kg m-3. + integer :: ke !< The number of layers/levels in the vertical + real :: max_depth !< The maximum depth of the ocean in meters. + real :: g_Earth !< The gravitational acceleration in m s-2. + real :: Rho0 !< The density used in the Boussinesq approximation or + !! nominal density used to convert depths into mass + !! units, in kg m-3. ! Vertical coordinate descriptions for diagnostics and I/O character(len=40) :: & - zAxisUnits, & ! The units that vertical coordinates are written in - zAxisLongName ! Coordinate name to appear in files, - ! e.g. "Target Potential Density" or "Height" - real ALLOCABLE_, dimension(NKMEM_) :: sLayer ! Coordinate values of layer centers - real ALLOCABLE_, dimension(NK_INTERFACE_) :: sInterface ! Coordinate values on interfaces - integer :: direction = 1 ! Direction defaults to 1, positive up. + zAxisUnits, & !< The units that vertical coordinates are written in + zAxisLongName !< Coordinate name to appear in files, + !! e.g. "Target Potential Density" or "Height" + real ALLOCABLE_, dimension(NKMEM_) :: sLayer !< Coordinate values of layer centers + real ALLOCABLE_, dimension(NK_INTERFACE_) :: sInterface !< Coordinate values on interfaces + integer :: direction = 1 !< Direction defaults to 1, positive up. ! The following variables give information about the vertical grid. - logical :: Boussinesq ! If true, make the Boussinesq approximation. - real :: Angstrom ! A one-Angstrom thickness in the model's thickness - ! units. (This replaces the old macro EPSILON.) - real :: Angstrom_z ! A one-Angstrom thickness in m. - real :: H_subroundoff ! A thickness that is so small that it can be added to - ! a thickness of Angstrom or larger without changing it - ! at the bit level, in thickness units. If Angstrom is - ! 0 or exceedingly small, this is negligible compared to - ! a thickness of 1e-17 m. + logical :: Boussinesq !< If true, make the Boussinesq approximation. + real :: Angstrom !< A one-Angstrom thickness in the model's thickness + !! units. (This replaces the old macro EPSILON.) + real :: Angstrom_z !< A one-Angstrom thickness in m. + real :: H_subroundoff !< A thickness that is so small that it can be added to + !! a thickness of Angstrom or larger without changing it + !! at the bit level, in thickness units. If Angstrom is + !! 0 or exceedingly small, this is negligible compared to + !! a thickness of 1e-17 m. real ALLOCABLE_, dimension(NK_INTERFACE_) :: & - g_prime, & ! The reduced gravity at each interface, in m s-2. - Rlay ! The target coordinate value (potential density) in - ! in each layer in kg m-3. - integer :: nkml = 0 ! The number of layers at the top that should be treated - ! as parts of a homogenous region. - integer :: nk_rho_varies = 0 ! The number of layers at the top where the - ! density does not track any target density. - real :: H_to_kg_m2 ! A constant that translates thicknesses from the units - ! of thickness to kg m-2. - real :: kg_m2_to_H ! A constant that translates thicknesses from kg m-2 to - ! the units of thickness. - real :: m_to_H ! A constant that translates distances in m to the - ! units of thickness. - real :: H_to_m ! A constant that translates distances in the units of - ! thickness to m. - real :: H_to_Pa ! A constant that translates the units of thickness to - ! to pressure in Pa. + g_prime, & !< The reduced gravity at each interface, in m s-2. + Rlay !< The target coordinate value (potential density) in + !! in each layer in kg m-3. + integer :: nkml = 0 !< The number of layers at the top that should be treated + !! as parts of a homogenous region. + integer :: nk_rho_varies = 0 !< The number of layers at the top where the + !! density does not track any target density. + real :: H_to_kg_m2 !< A constant that translates thicknesses from the units + !! of thickness to kg m-2. + real :: kg_m2_to_H !< A constant that translates thicknesses from kg m-2 to + !! the units of thickness. + real :: m_to_H !< A constant that translates distances in m to the + !! units of thickness. + real :: H_to_m !< A constant that translates distances in the units of + !! thickness to m. + real :: H_to_Pa !< A constant that translates the units of thickness to + !! to pressure in Pa. end type verticalGrid_type contains @@ -68,8 +68,8 @@ module MOM_verticalGrid subroutine verticalGridInit( param_file, GV ) ! This routine initializes the verticalGrid_type structure (GV). ! All memory is allocated but not necessarily set to meaningful values until later. - type(param_file_type), intent(in) :: param_file ! Parameter file handle/type - type(verticalGrid_type), pointer :: GV ! The container for vertical grid data + type(param_file_type), intent(in) :: param_file !< Parameter file handle/type + type(verticalGrid_type), pointer :: GV !< The container for vertical grid data ! This include declares and sets the variable "version". #include "version_variable.h" integer :: nk, H_power From 688aaeff8786c05b5995a8bc5698a0d5603c50cf Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 3 May 2018 11:13:26 -0400 Subject: [PATCH 0170/1072] Declared intents for arguments in MOM_checksums Added intent declarations for the arguments to several functions in MOM_checksums. All answers are bitwise identical. --- src/framework/MOM_checksums.F90 | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index 26ee96b399..b6f2a1c334 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -1155,14 +1155,14 @@ end subroutine chksum_u_3d !---chksum_general interface routines !> Return the bitcount of an arbitrarily sized 3d array integer function chksum_general_3d( array, scale_factor, istart, iend, jstart, jend, kstart, kend ) result(subchk) - real, dimension(:,:,:) :: array !< Array to be checksummed - real, optional :: scale_factor !< Factor to scale array by before checksum - integer, optional :: istart !< Starting index in the i-direction - integer, optional :: iend !< Ending index in the i-direction - integer, optional :: jstart !< Starting index in the j-direction - integer, optional :: jend !< Ending index in the j-direction - integer, optional :: kstart !< Starting index in the k-direction - integer, optional :: kend !< Ending index in the k-direction + real, dimension(:,:,:), intent(in) :: array !< Array to be checksummed + real, optional, intent(in) :: scale_factor !< Factor to scale array by before checksum + integer, optional, intent(in) :: istart !< Starting index in the i-direction + integer, optional, intent(in) :: iend !< Ending index in the i-direction + integer, optional, intent(in) :: jstart !< Starting index in the j-direction + integer, optional, intent(in) :: jend !< Ending index in the j-direction + integer, optional, intent(in) :: kstart !< Starting index in the k-direction + integer, optional, intent(in) :: kend !< Ending index in the k-direction integer :: i, j, k, bc, is, ie, js, je, ks, ke real :: scale @@ -1192,11 +1192,11 @@ end function chksum_general_3d !> Return the bitcount of an arbitrarily sized 2d array by promotion to a 3d array integer function chksum_general_2d( array_2d, scale_factor, istart, iend, jstart, jend ) real, dimension(:,:) :: array_2d !< Array to be checksummed - real, optional :: scale_factor !< Factor to scale array by before checksum - integer, optional :: istart !< Starting index in the i-direction - integer, optional :: iend !< Ending index in the i-direction - integer, optional :: jstart !< Starting index in the j-direction - integer, optional :: jend !< Ending index in the j-direction + real, optional, intent(in) :: scale_factor !< Factor to scale array by before checksum + integer, optional, intent(in) :: istart !< Starting index in the i-direction + integer, optional, intent(in) :: iend !< Ending index in the i-direction + integer, optional, intent(in) :: jstart !< Starting index in the j-direction + integer, optional, intent(in) :: jend !< Ending index in the j-direction integer :: is, ie, js, je real, dimension(:,:,:), allocatable :: array_3d !< Promotion from 2d to 3d array @@ -1512,8 +1512,8 @@ end function is_NaN_0d !> This function returns .true. if any element of x is a NaN, and .false. otherwise. function is_NaN_1d(x, skip_mpp) real, dimension(:), intent(in) :: x !< The array to be checked for NaNs. + logical, optional, intent(in) :: skip_mpp !< If true, only check this array only on the local PE (default false). logical :: is_NaN_1d - logical, optional :: skip_mpp !< If true, only check this array only on the local PE (default false). integer :: i, n logical :: call_mpp From 7b17fe7a205d8fa967676e08c9f492ca7c60188b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 3 May 2018 12:10:29 -0400 Subject: [PATCH 0171/1072] +Moved iceberg parameters to marine_ice_CS Moved the parameters related to the icebergs into the control structure for for the MOM_marine_ice module, and changed the arguments to add_berg_flux_to_shelf to replace parameter arguments with a control structure argument. All answers are bitwise identical, although a public interface has changed. --- config_src/coupled_driver/ocean_model_MOM.F90 | 62 +++++++------------ src/ice_shelf/MOM_marine_ice.F90 | 46 +++++++++----- 2 files changed, 52 insertions(+), 56 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 99d8ea7903..b003014ee4 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -142,27 +142,20 @@ module ocean_model_mod type, public :: ocean_state_type ; private ! 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. + 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 :: use_waves = .false.! If true use wave coupling. - - ! Many of the following variables do not appear to belong here. -RWH - 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) + 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 @@ -361,22 +354,9 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) 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 \n"//& - "below berg are set to zero. Not applied for negative \n"//& - " values.", units="non-dim", default=-1.0) - endif - OS%press_to_z = 1.0/(Rho0*G_Earth) ! Consider using a run-time flag to determine whether to do the diagnostic @@ -391,15 +371,16 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) 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 + 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.) + 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,param_file,OS%Waves,OS%diag) + call MOM_wave_interface_init(OS%Time, OS%grid, OS%GV, param_file, OS%Waves, OS%diag) else call MOM_wave_interface_init_lite(param_file) endif @@ -541,10 +522,9 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (OS%use_ice_shelf) then call shelf_calc_flux(OS%sfc_state, OS%forces, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) endif - if (OS%icebergs_apply_rigid_boundary) then + if (OS%icebergs_alter_ocean) then 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) + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif ! Fields that exist in both the forcing and mech_forcing types must be copied. @@ -565,9 +545,9 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (OS%use_ice_shelf) then call shelf_calc_flux(OS%sfc_state, OS%forces, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) endif - if (OS%icebergs_apply_rigid_boundary) then - 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) + if (OS%icebergs_alter_ocean) then + call add_berg_flux_to_shelf(OS%grid, OS%forces, OS%flux_tmp, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, dt_coupling, OS%grid, weight) diff --git a/src/ice_shelf/MOM_marine_ice.F90 b/src/ice_shelf/MOM_marine_ice.F90 index a31afc38d3..26738ee944 100644 --- a/src/ice_shelf/MOM_marine_ice.F90 +++ b/src/ice_shelf/MOM_marine_ice.F90 @@ -4,6 +4,7 @@ module MOM_marine_ice ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_constants, only : hlf use MOM_diag_mediator, only : post_data, query_averaging_enabled, diag_ctrl use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE use MOM_domains, only : TO_ALL, Omit_Corners @@ -24,6 +25,13 @@ module MOM_marine_ice !> Control structure for MOM_marine_ice type, public :: marine_ice_CS ; private + 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(time_type), pointer :: Time !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the timing of diagnostic output. end type marine_ice_CS @@ -33,8 +41,8 @@ module MOM_marine_ice !> add_berg_flux_to_shelf adds rigidity and ice-area coverage due to icebergs !! to the forces type fields, and adds ice-areal coverage and modifies various !! thermodynamic fluxes due to the presence of icebergs. -subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, density_ice, kv_ice, & - latent_heat_fusion, sfc_state, time_step, berg_area_threshold) +subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, sfc_state, & + time_step, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(forcing), intent(inout) :: fluxes !< A structure with pointers to themodynamic, @@ -42,14 +50,9 @@ subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, density_ice, type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. logical, intent(in) :: use_ice_shelf !< If true, this configuration uses ice shelves. - real, intent(in) :: kv_ice !< The viscosity of ice, in m2 s-1. - real, intent(in) :: density_ice !< A typical density of ice, in kg m-3. - real, intent(in) :: latent_heat_fusion !< The latent heat of fusion, in J kg-1. real, intent(in) :: time_step !< The coupling time step, in s. - real, intent(in) :: berg_area_threshold !< Area threshold for zeroing fluxes below iceberg -! Arguments: -! (in) fluxes - A structure of surface fluxes that may be used. -! (in) G - The ocean's grid structure. + type(marine_ice_CS), pointer :: CS !< Pointer to the control structure for MOM_marine_ice + real :: fraz ! refreezing rate in kg m-2 s-1 real :: I_dt_LHF ! The inverse of the timestep times the latent heat of fusion, in kg J-1 s-1. real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1. @@ -61,6 +64,8 @@ subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, density_ice, !the ocean model. This routine is taken from the add_shelf_flux subroutine !within the ice shelf model. + if (.not.associated(CS)) return + if (.not.(associated(forces%area_berg) .and. associated(forces%mass_berg) ) ) return if (.not.(associated(forces%frac_shelf_u) .and. associated(forces%frac_shelf_v) .and. & @@ -73,12 +78,11 @@ subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, density_ice, ! This section sets or augments the values of fields in forces. if (.not. use_ice_shelf) then forces%frac_shelf_u(:,:) = 0.0 ; forces%frac_shelf_v(:,:) = 0.0 - forces%rigidity_ice_u(:,:) = 0.0 ; forces%rigidity_ice_v(:,:) = 0.0 endif call pass_var(forces%area_berg, G%domain, TO_ALL+Omit_corners, halo=1, complete=.false.) call pass_var(forces%mass_berg, G%domain, TO_ALL+Omit_corners, halo=1, complete=.true.) - kv_rho_ice = kv_ice / density_ice + kv_rho_ice = CS%kv_iceberg / CS%density_iceberg do j=js,je ; do I=is-1,ie if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%dxdy_u(I,j) > 0.0)) & forces%frac_shelf_u(I,j) = forces%frac_shelf_u(I,j) + & @@ -114,10 +118,11 @@ subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, density_ice, endif ; enddo ; enddo !Zero'ing out other fluxes under the tabular icebergs - if (berg_area_threshold >= 0.) then - I_dt_LHF = 1.0 / (time_step * latent_heat_fusion) + if (CS%berg_area_threshold >= 0.) then + I_dt_LHF = 1.0 / (time_step * CS%latent_heat_fusion) do j=jsd,jed ; do i=isd,ied - if (fluxes%frac_shelf_h(i,j) > berg_area_threshold) then !Only applying for ice shelf covering most of cell + if (fluxes%frac_shelf_h(i,j) > CS%berg_area_threshold) then + ! Only applying for ice shelf covering most of cell. if (associated(fluxes%sw)) fluxes%sw(i,j) = 0.0 if (associated(fluxes%lw)) fluxes%lw(i,j) = 0.0 @@ -151,7 +156,7 @@ subroutine marine_ice_init(Time, G, param_file, diag, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(param_file_type), intent(in) :: param_file !< Runtime parameter handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure - type(marine_ice_CS), pointer :: CS !< Control structure for MOM_marine_ice + type(marine_ice_CS), pointer :: CS !< Pointer to the control structure for MOM_marine_ice ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_marine_ice" ! This module's name. @@ -165,6 +170,17 @@ subroutine marine_ice_init(Time, G, param_file, diag, CS) ! Write all relevant parameters to the model log. call log_version(mdl, version) + call get_param(param_file, mdl, "KV_ICEBERG", CS%kv_iceberg, & + "The viscosity of the icebergs", units="m2 s-1",default=1.0e10) + call get_param(param_file, mdl, "DENSITY_ICEBERGS", CS%density_iceberg, & + "A typical density of icebergs.", units="kg m-3", default=917.0) + call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & + "The latent heat of fusion.", units="J/kg", default=hlf) + call get_param(param_file, mdl, "BERG_AREA_THRESHOLD", CS%berg_area_threshold, & + "Fraction of grid cell which iceberg must occupy, so that fluxes \n"//& + "below berg are set to zero. Not applied for negative \n"//& + "values.", units="non-dim", default=-1.0) + end subroutine marine_ice_init end module MOM_marine_ice From 327df246b61d712e906e6ba99200bb1738ba6f8a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 3 May 2018 13:37:38 -0400 Subject: [PATCH 0172/1072] +Created iceberg_forces and iceberg_fluxes Split add_berg_flux_to_shelf into two new subroutines, iceberg_forces and iceberg_fluxes, that work on updating the mech_forcing and forcing types, respectively. All answers are bitwise identical. --- config_src/coupled_driver/ocean_model_MOM.F90 | 14 ++++-- src/ice_shelf/MOM_marine_ice.F90 | 48 +++++++++++++------ 2 files changed, 43 insertions(+), 19 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index b003014ee4..8bf16012f4 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -38,7 +38,7 @@ module ocean_model_mod 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 : add_berg_flux_to_shelf, marine_ice_init, marine_ice_CS +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 @@ -523,8 +523,10 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call shelf_calc_flux(OS%sfc_state, OS%forces, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) endif if (OS%icebergs_alter_ocean) then - call add_berg_flux_to_shelf(OS%grid, OS%forces, OS%fluxes, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + call iceberg_fluxes(OS%grid, OS%fluxes, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif ! Fields that exist in both the forcing and mech_forcing types must be copied. @@ -546,8 +548,10 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call shelf_calc_flux(OS%sfc_state, OS%forces, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) endif if (OS%icebergs_alter_ocean) then - call add_berg_flux_to_shelf(OS%grid, OS%forces, OS%flux_tmp, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + call iceberg_fluxes(OS%grid, OS%flux_tmp, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, dt_coupling, OS%grid, weight) diff --git a/src/ice_shelf/MOM_marine_ice.F90 b/src/ice_shelf/MOM_marine_ice.F90 index 26738ee944..342198b4ca 100644 --- a/src/ice_shelf/MOM_marine_ice.F90 +++ b/src/ice_shelf/MOM_marine_ice.F90 @@ -21,7 +21,7 @@ module MOM_marine_ice #include -public add_berg_flux_to_shelf, marine_ice_init +public iceberg_forces, iceberg_fluxes, marine_ice_init !> Control structure for MOM_marine_ice type, public :: marine_ice_CS ; private @@ -41,24 +41,19 @@ module MOM_marine_ice !> add_berg_flux_to_shelf adds rigidity and ice-area coverage due to icebergs !! to the forces type fields, and adds ice-areal coverage and modifies various !! thermodynamic fluxes due to the presence of icebergs. -subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, sfc_state, & +subroutine iceberg_forces(G, forces, use_ice_shelf, sfc_state, & time_step, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(forcing), intent(inout) :: fluxes !< A structure with pointers to themodynamic, - !! tracer and mass exchange forcing fields type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. logical, intent(in) :: use_ice_shelf !< If true, this configuration uses ice shelves. real, intent(in) :: time_step !< The coupling time step, in s. type(marine_ice_CS), pointer :: CS !< Pointer to the control structure for MOM_marine_ice - real :: fraz ! refreezing rate in kg m-2 s-1 - real :: I_dt_LHF ! The inverse of the timestep times the latent heat of fusion, in kg J-1 s-1. real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1. - integer :: i, j, is, ie, js, je, isd, ied, jsd, jed + integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed !This routine adds iceberg data to the ice shelf data (if ice shelf is used) !which can then be used to change the top of ocean boundary condition used in !the ocean model. This routine is taken from the add_shelf_flux subroutine @@ -71,10 +66,6 @@ subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, sfc_state, & if (.not.(associated(forces%frac_shelf_u) .and. associated(forces%frac_shelf_v) .and. & associated(forces%rigidity_ice_u) .and. associated(forces%rigidity_ice_v)) ) return - if (.not.(associated(fluxes%area_berg) .and. associated(fluxes%ustar_berg) .and. & - associated(fluxes%mass_berg) ) ) return - if (.not.(associated(fluxes%frac_shelf_h) .and. associated(fluxes%ustar_shelf)) ) return - ! This section sets or augments the values of fields in forces. if (.not. use_ice_shelf) then forces%frac_shelf_u(:,:) = 0.0 ; forces%frac_shelf_v(:,:) = 0.0 @@ -104,7 +95,36 @@ subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, sfc_state, & !### This halo update may be unnecessary. Test it. -RWH call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) - ! The remaining code sets or augments the values of fields in fluxes. +end subroutine iceberg_forces + +!> iceberg_fluxes adds ice-area-coverage and modifies various +!! thermodynamic fluxes due to the presence of icebergs. +subroutine iceberg_fluxes(G, fluxes, use_ice_shelf, sfc_state, & + time_step, CS) + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(forcing), intent(inout) :: fluxes !< A structure with pointers to themodynamic, + !! tracer and mass exchange forcing fields + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + logical, intent(in) :: use_ice_shelf !< If true, this configuration uses ice shelves. + real, intent(in) :: time_step !< The coupling time step, in s. + type(marine_ice_CS), pointer :: CS !< Pointer to the control structure for MOM_marine_ice + + real :: fraz ! refreezing rate in kg m-2 s-1 + real :: I_dt_LHF ! The inverse of the timestep times the latent heat of fusion, in kg J-1 s-1. + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed + !This routine adds iceberg data to the ice shelf data (if ice shelf is used) + !which can then be used to change the top of ocean boundary condition used in + !the ocean model. This routine is taken from the add_shelf_flux subroutine + !within the ice shelf model. + + if (.not.associated(CS)) return + if (.not.(associated(fluxes%area_berg) .and. associated(fluxes%ustar_berg) .and. & + associated(fluxes%mass_berg) ) ) return + if (.not.(associated(fluxes%frac_shelf_h) .and. associated(fluxes%ustar_shelf)) ) return + if (.not.(associated(fluxes%area_berg) .and. associated(fluxes%ustar_berg) .and. & associated(fluxes%mass_berg) ) ) return @@ -148,7 +168,7 @@ subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, sfc_state, & enddo ; enddo endif -end subroutine add_berg_flux_to_shelf +end subroutine iceberg_fluxes !> Initialize control structure for MOM_marine_ice subroutine marine_ice_init(Time, G, param_file, diag, CS) From e28065b049cd7173cf47c49882ff7e5fbda33761 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 3 May 2018 18:22:04 -0400 Subject: [PATCH 0173/1072] Specified argument intent in MOM_checksums.F90 Specified the intent for a number of subroutine arguments in MOM_checksums.F90 where this had been omitted. All answers are bitwise identical. --- src/framework/MOM_checksums.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index b6f2a1c334..9f738f6322 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -1191,7 +1191,7 @@ end function chksum_general_3d !> Return the bitcount of an arbitrarily sized 2d array by promotion to a 3d array integer function chksum_general_2d( array_2d, scale_factor, istart, iend, jstart, jend ) - real, dimension(:,:) :: array_2d !< Array to be checksummed + real, dimension(:,:), intent(in) :: array_2d !< Array to be checksummed real, optional, intent(in) :: scale_factor !< Factor to scale array by before checksum integer, optional, intent(in) :: istart !< Starting index in the i-direction integer, optional, intent(in) :: iend !< Ending index in the i-direction @@ -1210,11 +1210,11 @@ end function chksum_general_2d !> Return the bitcount of an arbitrarily sized 1d array by promotion to a 3d array integer function chksum_general_1d( array_1d, scale_factor, istart, iend ) - real, dimension(:) :: array_1d !< Array to be checksummed - real, optional :: scale_factor !< Factor to scale array by before checksum - integer, optional :: istart !< Starting index in the i-direction - integer, optional :: iend !< Ending index in the i-direction - integer :: is, ie, js, je + real, dimension(:), intent(in) :: array_1d !< Array to be checksummed + real, optional, intent(in) :: scale_factor !< Factor to scale array by before checksum + integer, optional, intent(in) :: istart !< Starting index in the i-direction + integer, optional, intent(in) :: iend !< Ending index in the i-direction + integer :: is, ie real, dimension(:,:,:), allocatable :: array_3d !< Promotion from 2d to 3d array is = LBOUND(array_1d,1) ; ie = UBOUND(array_1d,1) From 86c022751c8bae5187c90f5f4909ea914c7f861c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 3 May 2018 18:22:28 -0400 Subject: [PATCH 0174/1072] Specified argument intent in MOM_string_functions.F90 Specified the intent for a number of subroutine arguments in MOM_string_functions.F90 where this had been omitted. All answers are bitwise identical. --- src/framework/MOM_string_functions.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/framework/MOM_string_functions.F90 b/src/framework/MOM_string_functions.F90 index c0f3ba2b28..aa9b11bda6 100644 --- a/src/framework/MOM_string_functions.F90 +++ b/src/framework/MOM_string_functions.F90 @@ -149,7 +149,9 @@ function left_reals(r,sep) ! Arguments character(len=1320) :: left_reals real, intent(in) :: r(:) - character(len=*), optional :: sep + character(len=*), optional, intent(in) :: sep !< The separator between + !! successive values, by default it is ', '. + ! Local variables integer :: j, n, b, ns logical :: doWrite From e92d76cebfa40cf08814db566f2a68d66f3ccb31 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 3 May 2018 18:23:15 -0400 Subject: [PATCH 0175/1072] dOxyGenized MOM_document.F90 Added dOxyGen comments for all routines and arguments in MOM_document.F90. All answers are bitwise identical. --- src/framework/MOM_document.F90 | 262 ++++++++++++++++++++++----------- 1 file changed, 177 insertions(+), 85 deletions(-) diff --git a/src/framework/MOM_document.F90 b/src/framework/MOM_document.F90 index a61c20cf5a..144e10c15d 100644 --- a/src/framework/MOM_document.F90 +++ b/src/framework/MOM_document.F90 @@ -28,6 +28,7 @@ module MOM_document integer, parameter :: mLen = 1240 ! Length of interface/message strings +!> A structure that controls where the documentation occurs, its veborsity and formatting. type, public :: doc_type ; private integer :: unitAll = -1 ! The open unit number for docFileBase + .all. integer :: unitShort = -1 ! The open unit number for docFileBase + .short. @@ -60,9 +61,13 @@ module MOM_document ! ---------------------------------------------------------------------- +!> This subroutine handles parameter documentation with no value. subroutine doc_param_none(doc, varname, desc, units) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varname, desc, units + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varname !< The name of the parameter being documented + character(len=*), intent(in) :: desc !< A description of the parameter being documented + character(len=*), intent(in) :: units !< The units of the parameter being documented ! This subroutine handles parameter documentation with no value. integer :: numspc character(len=mLen) :: mesg @@ -80,14 +85,18 @@ subroutine doc_param_none(doc, varname, desc, units) endif end subroutine doc_param_none +!> This subroutine handles parameter documentation for logicals. subroutine doc_param_logical(doc, varname, desc, units, val, default, & layoutParam, debuggingParam) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varname, desc, units - logical, intent(in) :: val - logical, optional, intent(in) :: default - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varname !< The name of the parameter being documented + character(len=*), intent(in) :: desc !< A description of the parameter being documented + character(len=*), intent(in) :: units !< The units of the parameter being documented + logical, intent(in) :: val !< The value of this parameter + logical, optional, intent(in) :: default !< The default value of this parameter + logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter. + logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. ! This subroutine handles parameter documentation for logicals. character(len=mLen) :: mesg logical :: equalsDefault @@ -118,14 +127,18 @@ subroutine doc_param_logical(doc, varname, desc, units, val, default, & endif end subroutine doc_param_logical +!> This subroutine handles parameter documentation for arrays of logicals. subroutine doc_param_logical_array(doc, varname, desc, units, vals, default, & layoutParam, debuggingParam) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varname, desc, units - logical, intent(in) :: vals(:) - logical, optional, intent(in) :: default - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varname !< The name of the parameter being documented + character(len=*), intent(in) :: desc !< A description of the parameter being documented + character(len=*), intent(in) :: units !< The units of the parameter being documented + logical, intent(in) :: vals(:) !< The array of values to record + logical, optional, intent(in) :: default !< The default value of this parameter + logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter. + logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. ! This subroutine handles parameter documentation for arrays of logicals. integer :: i character(len=mLen) :: mesg @@ -164,14 +177,18 @@ subroutine doc_param_logical_array(doc, varname, desc, units, vals, default, & endif end subroutine doc_param_logical_array +!> This subroutine handles parameter documentation for integers. subroutine doc_param_int(doc, varname, desc, units, val, default, & layoutParam, debuggingParam) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varname, desc, units - integer, intent(in) :: val - integer, optional, intent(in) :: default - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varname !< The name of the parameter being documented + character(len=*), intent(in) :: desc !< A description of the parameter being documented + character(len=*), intent(in) :: units !< The units of the parameter being documented + integer, intent(in) :: val !< The value of this parameter + integer, optional, intent(in) :: default !< The default value of this parameter + logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter. + logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. ! This subroutine handles parameter documentation for integers. character(len=mLen) :: mesg character(len=doc%commentColumn) :: valstring @@ -196,14 +213,18 @@ subroutine doc_param_int(doc, varname, desc, units, val, default, & endif end subroutine doc_param_int +!> This subroutine handles parameter documentation for arrays of integers. subroutine doc_param_int_array(doc, varname, desc, units, vals, default, & layoutParam, debuggingParam) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varname, desc, units - integer, intent(in) :: vals(:) - integer, optional, intent(in) :: default - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varname !< The name of the parameter being documented + character(len=*), intent(in) :: desc !< A description of the parameter being documented + character(len=*), intent(in) :: units !< The units of the parameter being documented + integer, intent(in) :: vals(:) !< The array of values to record + integer, optional, intent(in) :: default !< The default value of this parameter + logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter. + logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. ! This subroutine handles parameter documentation for arrays of integers. integer :: i character(len=mLen) :: mesg @@ -235,12 +256,16 @@ subroutine doc_param_int_array(doc, varname, desc, units, vals, default, & end subroutine doc_param_int_array +!> This subroutine handles parameter documentation for reals. subroutine doc_param_real(doc, varname, desc, units, val, default, debuggingParam) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varname, desc, units - real, intent(in) :: val - real, optional, intent(in) :: default - logical, optional, intent(in) :: debuggingParam + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varname !< The name of the parameter being documented + character(len=*), intent(in) :: desc !< A description of the parameter being documented + character(len=*), intent(in) :: units !< The units of the parameter being documented + real, intent(in) :: val !< The value of this parameter + real, optional, intent(in) :: default !< The default value of this parameter + logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. ! This subroutine handles parameter documentation for reals. character(len=mLen) :: mesg character(len=doc%commentColumn) :: valstring @@ -265,12 +290,16 @@ subroutine doc_param_real(doc, varname, desc, units, val, default, debuggingPara endif end subroutine doc_param_real +!> This subroutine handles parameter documentation for arrays of reals. subroutine doc_param_real_array(doc, varname, desc, units, vals, default, debuggingParam) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varname, desc, units - real, intent(in) :: vals(:) - real, optional, intent(in) :: default - logical, optional, intent(in) :: debuggingParam + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varname !< The name of the parameter being documented + character(len=*), intent(in) :: desc !< A description of the parameter being documented + character(len=*), intent(in) :: units !< The units of the parameter being documented + real, intent(in) :: vals(:) !< The array of values to record + real, optional, intent(in) :: default !< The default value of this parameter + logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. ! This subroutine handles parameter documentation for arrays of reals. integer :: i character(len=mLen) :: mesg @@ -299,14 +328,19 @@ subroutine doc_param_real_array(doc, varname, desc, units, vals, default, debugg end subroutine doc_param_real_array +!> This subroutine handles parameter documentation for character strings. subroutine doc_param_char(doc, varname, desc, units, val, default, & layoutParam, debuggingParam) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varname, desc, units - character(len=*), intent(in) :: val - character(len=*), optional, intent(in) :: default - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varname !< The name of the parameter being documented + character(len=*), intent(in) :: desc !< A description of the parameter being documented + character(len=*), intent(in) :: units !< The units of the parameter being documented + character(len=*), intent(in) :: val !< The value of the parameter + character(len=*), & + optional, intent(in) :: default !< The default value of this parameter + logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter. + logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. ! This subroutine handles parameter documentation for character strings. character(len=mLen) :: mesg logical :: equalsDefault @@ -330,10 +364,12 @@ subroutine doc_param_char(doc, varname, desc, units, val, default, & end subroutine doc_param_char +!> This subroutine handles documentation for opening a parameter block. subroutine doc_openBlock(doc, blockName, desc) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: blockName - character(len=*), optional, intent(in) :: desc + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: blockName !< The name of the parameter block being opened + character(len=*), optional, intent(in) :: desc !< A description of the parameter block being opened ! This subroutine handles documentation for opening a parameter block. character(len=mLen) :: mesg character(len=doc%commentColumn) :: valstring @@ -353,9 +389,11 @@ subroutine doc_openBlock(doc, blockName, desc) doc%blockPrefix = trim(doc%blockPrefix)//trim(blockName)//'%' end subroutine doc_openBlock +!> This subroutine handles documentation for closing a parameter block. subroutine doc_closeBlock(doc, blockName) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: blockName + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: blockName !< The name of the parameter block being closed ! This subroutine handles documentation for closing a parameter block. character(len=mLen) :: mesg character(len=doc%commentColumn) :: valstring @@ -377,14 +415,18 @@ subroutine doc_closeBlock(doc, blockName) endif end subroutine doc_closeBlock +!> This subroutine handles parameter documentation for time-type variables. subroutine doc_param_time(doc, varname, desc, units, val, default, & layoutParam, debuggingParam) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varname, desc, units - type(time_type), intent(in) :: val - type(time_type), optional, intent(in) :: default - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varname !< The name of the parameter being documented + character(len=*), intent(in) :: desc !< A description of the parameter being documented + character(len=*), intent(in) :: units !< The units of the parameter being documented + type(time_type), intent(in) :: val !< The value of the parameter + type(time_type), optional, intent(in) :: default !< The default value of this parameter + logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter. + logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. ! This subroutine handles parameter documentation for time-type variables. ! ### This needs to be written properly! integer :: numspc @@ -407,14 +449,17 @@ subroutine doc_param_time(doc, varname, desc, units, val, default, & end subroutine doc_param_time +!> This subroutine writes out the message and description to the documetation files. subroutine writeMessageAndDesc(doc, vmesg, desc, valueWasDefault, indent, & layoutParam, debuggingParam) - type(doc_type), intent(in) :: doc - character(len=*), intent(in) :: vmesg, desc - logical, optional, intent(in) :: valueWasDefault - integer, optional, intent(in) :: indent - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + type(doc_type), intent(in) :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: vmesg !< A message with the parameter name, units, and default value. + character(len=*), intent(in) :: desc !< A description of the parameter being documented + logical, optional, intent(in) :: valueWasDefault !< If true, this parameter has its default value + integer, optional, intent(in) :: indent !< An amount by which to indent this message + logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter. + logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter. character(len=mLen) :: mesg integer :: start_ind = 1, end_ind, indnt, tab, len_tab, len_nl logical :: all, short, layout, debug @@ -472,8 +517,9 @@ end subroutine writeMessageAndDesc ! ---------------------------------------------------------------------- +!> This function returns a string with a real formatted like '(G)' function real_string(val) - real, intent(in) :: val + real, intent(in) :: val !< The value being written into a string character(len=32) :: real_string ! This function returns a string with a real formatted like '(G)' integer :: len, ind @@ -523,10 +569,14 @@ function real_string(val) real_string = adjustl(real_string) end function real_string -function real_array_string(vals,sep) - character(len=1320) :: real_array_string - real, intent(in) :: vals(:) - character(len=*), optional :: sep +!> Returns a character string of a comma-separated, compact formatted, reals +!> e.g. "1., 2., 5*3., 5.E2", that give the list of values. +function real_array_string(vals, sep) + character(len=1320) :: real_array_string !< The output string listing vals + real, intent(in) :: vals(:) !< The array of values to record + character(len=*), & + optional, intent(in) :: sep !< The separator between successive values, + !! by default it is ', '. ! Returns a character string of a comma-separated, compact formatted, reals ! e.g. "1., 2., 5*3., 5.E2" ! Local variables @@ -562,9 +612,10 @@ function real_array_string(vals,sep) enddo end function real_array_string +!> This function tests whether a real value is encoded in a string. function testFormattedFloatIsReal(str, val) - character(len=*), intent(in) :: str - real, intent(in) :: val + character(len=*), intent(in) :: str !< The string that match val + real, intent(in) :: val !< The value being tested logical :: testFormattedFloatIsReal ! Local variables real :: scannedVal @@ -577,25 +628,31 @@ function testFormattedFloatIsReal(str, val) endif end function testFormattedFloatIsReal +!> This function returns a string with an integer formatted like '(I)' function int_string(val) - integer, intent(in) :: val + integer, intent(in) :: val !< The value being written into a string character(len=24) :: int_string ! This function returns a string with an integer formatted like '(I)' write(int_string, '(i24)') val int_string = adjustl(int_string) end function int_string +!> This function returns a string with an logical formatted like '(L)' function logical_string(val) - logical, intent(in) :: val + logical, intent(in) :: val !< The value being written into a string character(len=24) :: logical_string ! This function returns a string with an logical formatted like '(L)' write(logical_string, '(l24)') val logical_string = adjustl(logical_string) end function logical_string +!> This function returns a string for formatted parameter assignment function define_string(doc,varName,valString,units) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varName, valString, units + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varName !< The name of the parameter being documented + character(len=*), intent(in) :: valString !< A string containing the value of the parameter + character(len=*), intent(in) :: units !< The units of the parameter being documented character(len=mLen) :: define_string ! This function returns a string for formatted parameter assignment integer :: numSpaces @@ -610,9 +667,12 @@ function define_string(doc,varName,valString,units) if (len_trim(units) > 0) define_string = trim(define_string)//" ["//trim(units)//"]" end function define_string +!> This function returns a string for formatted false logicals function undef_string(doc,varName,units) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varName, units + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varName !< The name of the parameter being documented + character(len=*), intent(in) :: units !< The units of the parameter being documented character(len=mLen) :: undef_string ! This function returns a string for formatted false logicals integer :: numSpaces @@ -630,9 +690,12 @@ end function undef_string ! ---------------------------------------------------------------------- +!> This subroutine handles the module documentation subroutine doc_module(doc, modname, desc) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: modname, desc + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: modname !< The name of the module being documented + character(len=*), intent(in) :: desc !< A description of the module being documented ! This subroutine handles the module documentation character(len=mLen) :: mesg @@ -646,18 +709,26 @@ subroutine doc_module(doc, modname, desc) endif end subroutine doc_module +!> This subroutine handles the subroutine documentation subroutine doc_subroutine(doc, modname, subname, desc) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: modname, subname, desc + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: modname !< The name of the module being documented + character(len=*), intent(in) :: subname !< The name of the subroutine being documented + character(len=*), intent(in) :: desc !< A description of the subroutine being documented ! This subroutine handles the subroutine documentation if (.not. (is_root_pe() .and. associated(doc))) return call open_doc_file(doc) end subroutine doc_subroutine +!> This subroutine handles the function documentation subroutine doc_function(doc, modname, fnname, desc) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: modname, fnname, desc + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: modname !< The name of the module being documented + character(len=*), intent(in) :: fnname !< The name of the function being documented + character(len=*), intent(in) :: desc !< A description of the function being documented ! This subroutine handles the function documentation if (.not. (is_root_pe() .and. associated(doc))) return call open_doc_file(doc) @@ -667,9 +738,18 @@ end subroutine doc_function ! ---------------------------------------------------------------------- subroutine doc_init(docFileBase, doc, minimal, complete, layout, debugging) - character(len=*), intent(in) :: docFileBase - type(doc_type), pointer :: doc - logical, optional, intent(in) :: minimal, complete, layout, debugging + character(len=*), intent(in) :: docFileBase !< The base file name for this set of parameters, + !! for example MOM_parameter_doc + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + logical, optional, intent(in) :: minimal !< If present and true, write out the files (.short) documenting + !! those parameters that do not take on their default values. + logical, optional, intent(in) :: complete !< If present and true, write out the (.all) files documenting all + !! parameters + logical, optional, intent(in) :: layout !< If present and true, write out the (.layout) files documenting + !! the layout parameters + logical, optional, intent(in) :: debugging !< If present and true, write out the (.debugging) files documenting + !! the debugging parameters ! Arguments: docFileBase - The name of the doc file. ! (inout) doc - The doc_type to populate. @@ -685,8 +765,12 @@ subroutine doc_init(docFileBase, doc, minimal, complete, layout, debugging) end subroutine doc_init +!< This subroutine allocates and populates a structure that controls where the +!! documentation occurs and its formatting, and opens up the files controlled +!! by this structure subroutine open_doc_file(doc) - type(doc_type), pointer :: doc + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting logical :: opened, new_file integer :: ios @@ -781,6 +865,7 @@ subroutine open_doc_file(doc) end subroutine open_doc_file +! Find an unused unit number, returning >0 if found, and triggering a FATAL error if not. function find_unused_unit_number() ! Find an unused unit number. ! Returns >0 if found. FATAL if not. @@ -794,8 +879,11 @@ function find_unused_unit_number() "doc_init failed to find an unused unit number.") end function find_unused_unit_number +!< This subroutine closes the the files controlled by doc, and sets flags in +!! doc to indicate that parameterization is no longer permitted. subroutine doc_end(doc) - type(doc_type), pointer :: doc + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting type(link_msg), pointer :: this, next if (.not.associated(doc)) return @@ -832,9 +920,13 @@ end subroutine doc_end ! ----------------------------------------------------------------------------- +!> Returns true if documentation has already been written function mesgHasBeenDocumented(doc,varName,mesg) - type(doc_type), pointer :: doc - character(len=*), intent(in) :: varName, mesg + type(doc_type), pointer :: doc !< A pointer to a structure that controls where the + !! documentation occurs and its formatting + character(len=*), intent(in) :: varName !< The name of the parameter being documented + character(len=*), intent(in) :: mesg !< A message with parameter values, defaults, and descriptions + !! to compare with the message that was written previously logical :: mesgHasBeenDocumented ! Returns true if documentation has already been written type(link_msg), pointer :: newLink, this, last From db4aa4cd3a78e5ada4c017fa0986a78c931ec8a3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 3 May 2018 18:23:30 -0400 Subject: [PATCH 0176/1072] dOxyGenized MOM_error_handler.F90 Added dOxyGen comments for all routines and arguments in MOM_error_handler.F90. Also added intents for several arguments where it had been omitted. All answers are bitwise identical. --- src/framework/MOM_error_handler.F90 | 34 +++++++++++++++++++---------- 1 file changed, 22 insertions(+), 12 deletions(-) diff --git a/src/framework/MOM_error_handler.F90 b/src/framework/MOM_error_handler.F90 index 48edffc1f6..e1a85b52c4 100644 --- a/src/framework/MOM_error_handler.F90 +++ b/src/framework/MOM_error_handler.F90 @@ -46,6 +46,7 @@ module MOM_error_handler contains +!> This returns .true. if the current PE is the root PE. function is_root_pe() ! This returns .true. if the current PE is the root PE. logical :: is_root_pe @@ -54,10 +55,12 @@ function is_root_pe() return end function is_root_pe +!> This provides a convenient interface for writing an informative comment. subroutine MOM_mesg(message, verb, all_print) - character(len=*), intent(in) :: message - integer, optional, intent(in) :: verb - logical, optional, intent(in) :: all_print + character(len=*), intent(in) :: message !< A message to write out + integer, optional, intent(in) :: verb !< A level of verbosity for this message + logical, optional, intent(in) :: all_print !< If present and true, any PEs are + !! able to write this message. ! This provides a convenient interface for writing an informative comment. integer :: verb_msg logical :: write_msg @@ -70,10 +73,13 @@ subroutine MOM_mesg(message, verb, all_print) end subroutine MOM_mesg +!> This provides a convenient interface for writing an mpp_error message +!! with run-time filter based on a verbosity. subroutine MOM_error(level, message, all_print) - integer, intent(in) :: level - character(len=*), intent(in) :: message - logical, optional, intent(in) :: all_print + integer, intent(in) :: level !< The verbosity level of this message + character(len=*), intent(in) :: message !< A message to write out + logical, optional, intent(in) :: all_print !< If present and true, any PEs are + !! able to write this message. ! This provides a convenient interface for writing an mpp_error message ! with run-time filter based on a verbosity. logical :: write_msg @@ -93,8 +99,9 @@ subroutine MOM_error(level, message, all_print) end select end subroutine MOM_error +!> This subroutine sets the level of verbosity filtering MOM error messages subroutine MOM_set_verbosity(verb) - integer, intent(in) :: verb + integer, intent(in) :: verb !< A level of verbosity to set character(len=80) :: msg if (verb>0 .and. verb<10) then verbosity=verb @@ -104,13 +111,16 @@ subroutine MOM_set_verbosity(verb) endif end subroutine MOM_set_verbosity +!> This subroutine gets the level of verbosity filtering MOM error messages function MOM_get_verbosity() integer :: MOM_get_verbosity MOM_get_verbosity = verbosity end function MOM_get_verbosity +!> This tests whether the level of verbosity filtering MOM error messages is +!! sufficient to write a message of verbosity level verb function MOM_verbose_enough(verb) - integer, intent(in) :: verb + integer, intent(in) :: verb !< A level of verbosity to test logical :: MOM_verbose_enough MOM_verbose_enough = (verbosity >= verb) end function MOM_verbose_enough @@ -124,8 +134,8 @@ end function callTree_showQuery !> Writes a message about entering a subroutine if call tree reporting is active subroutine callTree_enter(mesg,n) - character(len=*) :: mesg !< Message to write - integer, optional :: n !< An optional integer to write at end of message + character(len=*), intent(in) :: mesg !< Message to write + integer, optional, intent(in) :: n !< An optional integer to write at end of message ! Local variables character(len=8) :: nAsString callTreeIndentLevel = callTreeIndentLevel + 1 @@ -155,8 +165,8 @@ end subroutine callTree_leave !> Writes a message about reaching a milestone if call tree reporting is active subroutine callTree_waypoint(mesg,n) - character(len=*) :: mesg !< Message to write - integer, optional :: n !< An optional integer to write at end of message + character(len=*), intent(in) :: mesg !< Message to write + integer, optional, intent(in) :: n !< An optional integer to write at end of message ! Local variables character(len=8) :: nAsString if (callTreeIndentLevel<0) write(0,*) 'callTree_waypoint: error callTreeIndentLevel=',callTreeIndentLevel,trim(mesg) From 180832ffa6288bc1883d69fd2533dd9c4b6d8f0e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 3 May 2018 18:23:59 -0400 Subject: [PATCH 0177/1072] Partially dOxyGenized MOM_horizontal_regridding.F90 Added dOxyGen comments for several routines and and their arguments in MOM_horizontal_regridding.F90, however much more needs to be done to bring the code in this file into alignment with MOM6 standards. All answers are bitwise identical. --- src/framework/MOM_horizontal_regridding.F90 | 66 ++++++++++++++------- 1 file changed, 44 insertions(+), 22 deletions(-) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 1d692cf393..db65a9504c 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -91,6 +91,11 @@ subroutine myStats(array, missing, is, ie, js, je, k, mesg) endif end subroutine myStats + +!> Use ICE-9 algorithm to populate points (fill=1) with +!! valid data (good=1). If no information is available, +!! Then use a previous guess (prev). Optionally (smooth) +!! blend the filled points to achieve a more desirable result. subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug,debug) ! !# Use ICE-9 algorithm to populate points (fill=1) with @@ -105,19 +110,29 @@ subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug ! use MOM_coms, only : sum_across_PEs - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: aout - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: good !< Valid data mask for incoming array - !! (1==good data; 0==missing data). - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: fill !< Same shape array of points which need - !! filling (1==please fill;0==leave - !! it alone). - real, dimension(SZI_(G),SZJ_(G)), optional, & - intent(in) :: prev !< First guess where isolated holes exist. - logical, intent(in), optional :: smooth - integer, intent(in), optional :: num_pass - real, intent(in), optional :: relc,crit - logical, intent(in), optional :: keep_bug, debug + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + real, dimension(SZI_(G),SZJ_(G)), & + intent(inout) :: aout !< The array with missing values to fill + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: good !< Valid data mask for incoming array + !! (1==good data; 0==missing data). + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: fill !< Same shape array of points which need + !! filling (1==please fill;0==leave + !! it alone). + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(in) :: prev !< First guess where isolated holes exist. + logical, optional, intent(in) :: smooth !< If present and true, apply a number of + !! Laplacian smoothing passes to the interpolated data + integer, optional, intent(in) :: num_pass !< The maximum number of smoothing passes + !! to apply. + real, optional, intent(in) :: relc !< A nondimensional relaxation coefficient for + !! the smoothing passes. + real, optional, intent(in) :: crit !< A minimal value for changes in the array + !! at which point the smoothing is stopped. + logical, optional, intent(in) :: keep_bug !< Use an algorithm with a bug that dates + !! to the "sienna" code release. + logical, optional, intent(in) :: debug !< If true, write verbose debugging messages. real, dimension(SZI_(G),SZJ_(G)) :: b,r @@ -229,9 +244,12 @@ subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug do j=js,je do i=is,ie if (fill(i,j) .eq. 1) then - east=max(good(i+1,j),fill(i+1,j));west=max(good(i-1,j),fill(i-1,j)) - north=max(good(i,j+1),fill(i,j+1));south=max(good(i,j-1),fill(i,j-1)) - r(i,j) = relax_coeff*(south*aout(i,j-1)+north*aout(i,j+1)+west*aout(i-1,j)+east*aout(i+1,j) - (south+north+west+east)*aout(i,j)) + east=max(good(i+1,j),fill(i+1,j)) ; west=max(good(i-1,j),fill(i-1,j)) + north=max(good(i,j+1),fill(i,j+1)) ; south=max(good(i,j-1),fill(i,j-1)) + !### Appropriate parentheses should be added here, but they will change answers. + r(i,j) = relax_coeff*(south*aout(i,j-1)+north*aout(i,j+1) + & + west*aout(i-1,j)+east*aout(i+1,j) - & + (south+north+west+east)*aout(i,j)) else r(i,j) = 0. endif @@ -273,9 +291,11 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, !! local model grid and native vertical levels. real, allocatable, dimension(:) :: z_in !< Cell grid values for input data. real, allocatable, dimension(:) :: z_edges_in !< Cell grid edge values for input data. - real, intent(out) :: missing_value - logical, intent(in) :: reentrant_x, tripolar_n - logical, intent(in), optional :: homogenize + real, intent(out) :: missing_value !< The missing value in the returned array. + logical, intent(in) :: reentrant_x !< If true, this grid is reentrant in the x-direction + logical, intent(in) :: tripolar_n !< If true, this is a northern tripolar grid + logical, optional, intent(in) :: homogenize !< If present and true, horizontally homogenize data + !! to produce perfectly "flat" initial conditions real, dimension(:,:), allocatable :: tr_in,tr_inp !< A 2-d array for holding input data on !! native horizontal grid and extended grid @@ -587,9 +607,11 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t !! local model grid and native vertical levels. real, allocatable, dimension(:) :: z_in !< Cell grid values for input data. real, allocatable, dimension(:) :: z_edges_in !< Cell grid edge values for input data. - real, intent(out) :: missing_value - logical, intent(in) :: reentrant_x, tripolar_n - logical, intent(in), optional :: homogenize + real, intent(out) :: missing_value !< The missing value in the returned array. + logical, intent(in) :: reentrant_x !< If true, this grid is reentrant in the x-direction + logical, intent(in) :: tripolar_n !< If true, this is a northern tripolar grid + logical, optional, intent(in) :: homogenize !< If present and true, horizontally homogenize data + !! to produce perfectly "flat" initial conditions real, dimension(:,:), allocatable :: tr_in,tr_inp !< A 2-d array for holding input data on !! native horizontal grid and extended grid From 825e9bb4162d181dadf07652e2fe2ec9d30ff004 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 3 May 2018 18:25:14 -0400 Subject: [PATCH 0178/1072] Specified argument intent in MOM_tracer_hor_diff.F90 Specified the intent for a number of subroutine arguments in MOM_tracer_hor_diff.F90 where this had been omitted, and added dOxyGen comments for other arguments. All answers are bitwise identical. --- src/tracer/MOM_tracer_hor_diff.F90 | 40 +++++++++++++++++------------- 1 file changed, 23 insertions(+), 17 deletions(-) diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index f7fd35d721..491803c4e5 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -87,24 +87,30 @@ module MOM_tracer_hor_diff !! Multiple iterations are used (if necessary) so that there is no limit !! on the acceptable time increment. subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_flag, read_khdt_x, read_khdt_y) - type(ocean_grid_type), intent(inout) :: G !< Grid type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg m-2) - real, intent(in) :: dt !< time step (seconds) - type(MEKE_type), pointer :: MEKE !< MEKE type - type(VarMix_CS), pointer :: VarMix !< Variable mixing type - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(tracer_hor_diff_CS), pointer :: CS !< module control structure - type(tracer_registry_type), pointer :: Reg !< registered tracers - type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available - !! thermodynamic fields, including potential temp and - !! salinity or mixed layer density. Absent fields have - !! NULL ptrs, and these may (probably will) point to - !! some of the same arrays as Tr does. tv is required - !! for epipycnal mixing between mixed layer and the interior. + type(ocean_grid_type), intent(inout) :: G !< Grid type + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thickness (m or kg m-2) + real, intent(in) :: dt !< time step (seconds) + type(MEKE_type), pointer :: MEKE !< MEKE type + type(VarMix_CS), pointer :: VarMix !< Variable mixing type + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(tracer_hor_diff_CS), pointer :: CS !< module control structure + type(tracer_registry_type), pointer :: Reg !< registered tracers + type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available + !! thermodynamic fields, including potential temp and + !! salinity or mixed layer density. Absent fields have + !! NULL ptrs, and these may (probably will) point to + !! some of the same arrays as Tr does. tv is required + !! for epipycnal mixing between mixed layer and the interior. ! Optional inputs for offline tracer transport - logical, optional :: do_online_flag - real, dimension(SZIB_(G),SZJ_(G)), optional, intent(in) :: read_khdt_x - real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: read_khdt_y + logical, optional, intent(in) :: do_online_flag !< If present and true, do online + !! tracer transport with stored velcities. + real, dimension(SZIB_(G),SZJ_(G)), & + optional, intent(in) :: read_khdt_x !< If present, these are the zonal + !! diffusivities from previous run. + real, dimension(SZI_(G),SZJB_(G)), & + optional, intent(in) :: read_khdt_y !< If present, these are the meridional + !! diffusivities from previous run. real, dimension(SZI_(G),SZJ_(G)) :: & From 86818dd49e6fe969a110098d6c787f47406ee8c2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 3 May 2018 18:25:39 -0400 Subject: [PATCH 0179/1072] dOxyGenized arguments in MOM_energetic_PBL.F90 Added dOxyGen comments for several recently added arguments in MOM_energetic_PBL.F90 where they had been omitted. All answers are bitwise identical. --- src/parameterizations/vertical/MOM_energetic_PBL.F90 | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index d7ea7007c6..541caccf97 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -266,8 +266,15 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & !! diagnostics will be written. The default !! is .true. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(out) :: dT_expected, dS_expected - type(wave_parameters_CS), pointer, optional :: Waves ! Date: Thu, 3 May 2018 18:25:57 -0400 Subject: [PATCH 0180/1072] dOxyGenized arguments in MOM_opacity.F90 Added dOxyGen comments for several recently added arguments in MOM_opacity.F90 where they had been omitted. Also shortened some openMP directives. All answers are bitwise identical. --- .../vertical/MOM_opacity.F90 | 67 +++++++++---------- 1 file changed, 31 insertions(+), 36 deletions(-) diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 502f05e3e1..a573f522e4 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -100,14 +100,15 @@ module MOM_opacity contains subroutine set_opacity(optics, fluxes, G, GV, CS) - type(optics_type), intent(inout) :: optics - type(forcing), intent(in) :: fluxes !< A structure containing pointers to any - !! possible forcing fields. Unused fields - !! have NULL ptrs. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(opacity_CS), pointer :: CS !< The control structure earlier set up by - !! opacity_init. + type(optics_type), intent(inout) :: optics !< An optics structure that has values + !! set based on the opacities. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to any + !! possible forcing fields. Unused fields + !! have NULL ptrs. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(opacity_CS), pointer :: CS !< The control structure earlier set up by + !! opacity_init. ! Arguments: (inout) opacity - The inverse of the vertical absorption decay ! scale for penetrating shortwave radiation, in m-1. @@ -147,21 +148,20 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) ! Make sure there is no division by 0. inv_sw_pen_scale = 1.0 / max(CS%pen_sw_scale, 0.1*GV%Angstrom_z, & GV%H_to_m*GV%H_subroundoff) -!$OMP parallel default(none) shared(is,ie,js,je,nz,optics,inv_sw_pen_scale,fluxes,CS,Inv_nbands,GV) if ( CS%Opacity_scheme == DOUBLE_EXP ) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie optics%opacity_band(1,i,j,k) = inv_sw_pen_scale optics%opacity_band(2,i,j,k) = 1.0 / max(CS%pen_sw_scale_2nd, & 0.1*GV%Angstrom_z,GV%H_to_m*GV%H_subroundoff) enddo ; enddo ; enddo if (.not.associated(fluxes%sw) .or. (CS%pen_SW_scale <= 0.0)) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ; do n=1,optics%nbands optics%sw_pen_band(n,i,j) = 0.0 enddo ; enddo ; enddo else -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ; optics%sw_pen_band(1,i,j) = (CS%SW_1st_EXP_RATIO) * fluxes%sw(i,j) optics%sw_pen_band(2,i,j) = (1.-CS%SW_1st_EXP_RATIO) * fluxes%sw(i,j) @@ -172,22 +172,21 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) optics%opacity_band(n,i,j,k) = inv_sw_pen_scale enddo ; enddo ; enddo ; enddo if (.not.associated(fluxes%sw) .or. (CS%pen_SW_scale <= 0.0)) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ; do n=1,optics%nbands optics%sw_pen_band(n,i,j) = 0.0 enddo ; enddo ; enddo else -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ; do n=1,optics%nbands optics%sw_pen_band(n,i,j) = CS%pen_SW_frac * Inv_nbands * fluxes%sw(i,j) enddo ; enddo ; enddo endif endif -!$OMP end parallel endif if (query_averaging_enabled(CS%diag)) then if (CS%id_sw_pen > 0) then -!$OMP parallel do default(none) shared(is,ie,js,je,Pen_SW_tot,optics) + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie Pen_SW_tot(i,j) = 0.0 do n=1,optics%nbands @@ -198,7 +197,7 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) endif if (CS%id_sw_vis_pen > 0) then if (CS%opacity_scheme == MANIZZA_05) then -!$OMP parallel do default(none) shared(is,ie,js,je,Pen_SW_tot,optics) + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie Pen_SW_tot(i,j) = 0.0 do n=1,min(optics%nbands,2) @@ -206,7 +205,7 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) enddo enddo ; enddo else -!$OMP parallel do default(none) shared(is,ie,js,je,Pen_SW_tot,optics) + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie Pen_SW_tot(i,j) = 0.0 do n=1,optics%nbands @@ -217,7 +216,7 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) call post_data(CS%id_sw_vis_pen, Pen_SW_tot, CS%diag) endif do n=1,optics%nbands ; if (CS%id_opacity(n) > 0) then -!$OMP parallel do default(none) shared(nz,is,ie,js,je,tmp,optics,n) + !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie tmp(i,j,k) = optics%opacity_band(n,i,j,k) enddo ; enddo ; enddo @@ -229,21 +228,16 @@ end subroutine set_opacity subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) - type(optics_type), intent(inout) :: optics - type(forcing), intent(in) :: fluxes !< A structure containing pointers to any - !! possible forcing fields. Unused fields - !! have NULL ptrs. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(opacity_CS), pointer :: CS !< The control structure. + type(optics_type), intent(inout) :: optics !< An optics structure that has values + !! set based on the opacities. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to any + !! possible forcing fields. Unused fields + !! have NULL ptrs. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(opacity_CS), pointer :: CS !< The control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in), optional :: chl_in !< A 3-d field of chlorophyll A, - !! in mg m-3. -! Arguments: fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (out) opacity - The inverse of the vertical absorption decay -! scale for penetrating shortwave radiation, in m-1. -! (in) G - The ocean's grid structure. -! (in) chl_in - A 3-d field of chlorophyll A, in mg m-3. + optional, intent(in) :: chl_in !< A 3-d field of chlorophyll A, + !! in mg m-3. real :: chl_data(SZI_(G),SZJ_(G)) ! The chlorophyll A concentrations in ! a layer, in mg/m^3. @@ -476,7 +470,8 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) target, intent(in) :: tracer_flow type(opacity_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module. - type(optics_type), pointer :: optics + type(optics_type), pointer :: optics !< An optics structure that has parameters + !! set and arrays allocated here. ! Arguments: Time - The current model time. ! (in) G - The ocean's grid structure. ! (in) param_file - A structure indicating the open file to parse for @@ -674,8 +669,8 @@ end subroutine opacity_init subroutine opacity_end(CS, optics) - type(opacity_CS), pointer :: CS - type(optics_type), pointer, optional :: optics + type(opacity_CS), pointer :: CS !< An opacity control structure that should be deallocated. + type(optics_type), optional, pointer :: optics !< An optics type structure that should be deallocated. if (associated(CS%id_opacity)) deallocate(CS%id_opacity) if (associated(CS)) deallocate(CS) From 6cbfe0af9be8571d8b8891ad6b53c57943520331 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 3 May 2018 18:26:25 -0400 Subject: [PATCH 0181/1072] Partially dOxyGenized MOM_ice_shelf.F90 Added dOxyGen comments for several routines and and their arguments in MOM_ice_shelf.F90, however much more needs to be done to bring the code in this file into alignment with MOM6 standards, and much of it is essentially untested. All answers are bitwise identical. --- src/ice_shelf/MOM_ice_shelf.F90 | 105 +++++++++++++++----------------- 1 file changed, 48 insertions(+), 57 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index f835bfcf95..4004801a02 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -410,7 +410,7 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) character(4) :: stepnum character(2) :: procnum - type(ocean_grid_type), pointer :: G + type(ocean_grid_type), pointer :: G => NULL() real, parameter :: c2_3 = 2.0/3.0 integer :: i, j, is, ie, js, je, ied, jed, it1, it3, iters_vel_solve real, parameter :: rho_fw = 1000.0 ! fresh water density @@ -863,10 +863,10 @@ end subroutine shelf_calc_flux !> Changes the thickness (mass) of the ice shelf based on sub-ice-shelf melting subroutine change_thickness_using_melt(CS,G,time_step, fluxes) - type(ocean_grid_type), intent(inout) :: G - type(ice_shelf_CS), intent(inout) :: CS - real, intent(in) :: time_step - type(forcing), intent(inout) :: fluxes + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(ice_shelf_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + real, intent(in) :: time_step + type(forcing), intent(inout) :: fluxes ! locals integer :: i, j @@ -1166,7 +1166,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(ocean_grid_type), pointer :: ocn_grid type(time_type), intent(inout) :: Time - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure type(diag_ctrl), target, intent(in) :: diag type(forcing), optional, intent(inout) :: fluxes type(mech_forcing), optional, intent(inout) :: forces @@ -1954,10 +1954,10 @@ end subroutine initialize_ice_shelf !> Initializes shelf mass based on three options (file, zero and user) subroutine initialize_shelf_mass(G, param_file, CS, new_sim) - type(ocean_grid_type), intent(in) :: G + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(ice_shelf_CS), pointer :: CS - logical, optional :: new_sim + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + logical, optional, intent(in) :: new_sim !< If present and false, this run is being restarted integer :: i, j, is, ie, js, je logical :: read_shelf_area, new_sim_2 @@ -1967,11 +1967,7 @@ subroutine initialize_shelf_mass(G, param_file, CS, new_sim) character(len=40) :: mdl = "MOM_ice_shelf" is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - if (.not. present(new_sim)) then - new_sim_2 = .true. - else - new_sim_2 = .false. - endif + new_sim_2 = .true. ; if (present(new_sim)) new_sim_2 = new_sim call get_param(param_file, mdl, "ICE_SHELF_CONFIG", config, & "A string that specifies how the ice shelf is \n"//& @@ -2043,8 +2039,8 @@ end subroutine initialize_shelf_mass !> Updates the ice shelf mass using data from a file. subroutine update_shelf_mass(G, CS, Time, fluxes) - type(ocean_grid_type), intent(inout) :: G - type(ice_shelf_CS), pointer :: CS + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure type(time_type), intent(in) :: Time type(forcing), intent(inout) :: fluxes @@ -2052,12 +2048,6 @@ subroutine update_shelf_mass(G, CS, Time, fluxes) integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - ! first, zero out fluxes applied during previous time step - do j=js,je; do i=is,ie - - - enddo; enddo - call time_interp_external(CS%id_read_mass, Time, CS%mass_shelf) do j=js,je ; do i=is,ie @@ -2105,7 +2095,7 @@ subroutine update_shelf_mass(G, CS, Time, fluxes) end subroutine update_shelf_mass subroutine initialize_diagnostic_fields (CS, FE, Time) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure integer :: FE type(time_type), intent(in) :: Time @@ -2179,7 +2169,7 @@ end subroutine ice_shelf_save_restart subroutine ice_shelf_advect(CS, time_step, melt_rate, Time) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, intent(in) :: time_step real, dimension(:,:), pointer :: melt_rate type(time_type), intent(in) :: Time @@ -2296,7 +2286,7 @@ subroutine ice_shelf_advect(CS, time_step, melt_rate, Time) end subroutine ice_shelf_advect subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u, v integer, intent(in) :: FE integer, intent(out) :: iters @@ -2654,7 +2644,7 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) end subroutine ice_shelf_solve_outer subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE, conv_flag, iters, time, Phi, Phisub) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u, v real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(in) :: taudx, taudy, H_node real, dimension(:,:),intent(in) :: float_cond @@ -3100,7 +3090,7 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE end subroutine ice_shelf_solve_inner subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_enter) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, intent(in) :: time_step real, dimension(:,:), intent(in) :: h0 real, dimension(:,:), intent(inout) :: h_after_uflux @@ -3339,7 +3329,7 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ end subroutine ice_shelf_advect_thickness_x subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_vflux, flux_enter) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, intent(in) :: time_step real, dimension(:,:), intent(in) :: h_after_uflux real, dimension(:,:), intent(inout) :: h_after_vflux @@ -3552,7 +3542,7 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v end subroutine ice_shelf_advect_thickness_y subroutine shelf_advance_front (CS, flux_enter) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(:,:,:), intent(inout) :: flux_enter ! in this subroutine we go through the computational cells only and, if they are empty or partial cells, @@ -3745,7 +3735,7 @@ end subroutine shelf_advance_front !> Apply a very simple calving law using a minimum thickness rule subroutine ice_shelf_min_thickness_calve (CS, h_shelf, area_shelf_h,hmask) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(:,:), intent(inout) :: h_shelf, area_shelf_h, hmask type(ocean_grid_type), pointer :: G integer :: i,j @@ -3767,7 +3757,7 @@ subroutine ice_shelf_min_thickness_calve (CS, h_shelf, area_shelf_h,hmask) end subroutine ice_shelf_min_thickness_calve subroutine calve_to_mask (CS, h_shelf, area_shelf_h, hmask, calve_mask) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(:,:), intent(inout) :: h_shelf, area_shelf_h, hmask, calve_mask type(ocean_grid_type), pointer :: G @@ -3790,7 +3780,7 @@ subroutine calve_to_mask (CS, h_shelf, area_shelf_h, hmask, calve_mask) end subroutine calve_to_mask subroutine calc_shelf_driving_stress (CS, TAUD_X, TAUD_Y, OD, FE) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(:,:), intent(in) :: OD real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: TAUD_X, TAUD_Y integer, intent(in) :: FE @@ -4030,9 +4020,9 @@ end subroutine calc_shelf_driving_stress subroutine init_boundary_values (CS, time, input_flux, input_thick, new_sim) type(time_type), intent(in) :: Time - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, intent(in) :: input_flux, input_thick - logical, optional :: new_sim + logical, optional, intent(in) :: new_sim !< If present and false, this run is being restarted ! this will be a per-setup function. the boundary values of thickness and velocity ! (and possibly other variables) will be updated in this function @@ -4504,7 +4494,7 @@ end subroutine CG_action_subgrid_basal_bilinear subroutine matrix_diagonal_triangle (CS, u_diagonal, v_diagonal) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension (:,:), intent(inout) :: u_diagonal, v_diagonal ! returns the diagonal entries of the matrix for a Jacobi preconditioning @@ -4664,7 +4654,7 @@ end subroutine matrix_diagonal_triangle subroutine matrix_diagonal_bilinear(CS, float_cond, H_node, dens_ratio, Phisub, u_diagonal, v_diagonal) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension (NILIMB_SYM_,NJLIMB_SYM_), intent(in) :: H_node real :: dens_ratio real, dimension (:,:), intent(in) :: float_cond @@ -4845,7 +4835,7 @@ end subroutine CG_diagonal_subgrid_basal_bilinear subroutine apply_boundary_values_triangle (CS, time, u_boundary_contr, v_boundary_contr) type(time_type), intent(in) :: Time - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension (:,:), intent(inout) :: u_boundary_contr, v_boundary_contr ! this will be a per-setup function. the boundary values of thickness and velocity @@ -5023,7 +5013,7 @@ subroutine apply_boundary_values_bilinear (CS, time, Phisub, H_node, float_cond, type(time_type), intent(in) :: Time real, dimension (:,:,:,:,:,:),pointer:: Phisub - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension (NILIMB_SYM_,NJLIMB_SYM_), intent (in) :: H_node real, dimension (:,:), intent (in) :: float_cond real :: dens_ratio @@ -5199,7 +5189,7 @@ subroutine apply_boundary_values_bilinear (CS, time, Phisub, H_node, float_cond, end subroutine apply_boundary_values_bilinear subroutine calc_shelf_visc_triangular (CS,u,v) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(:,:), intent(inout) :: u, v ! update DEPTH_INTEGRATED viscosity, based on horizontal strain rates - this is for triangle FEM solve so there is @@ -5282,7 +5272,7 @@ subroutine calc_shelf_visc_triangular (CS,u,v) end subroutine calc_shelf_visc_triangular subroutine calc_shelf_visc_bilinear (CS, u, v) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u, v ! update DEPTH_INTEGRATED viscosity, based on horizontal strain rates - this is for triangle FEM solve so there is @@ -5345,7 +5335,7 @@ subroutine calc_shelf_visc_bilinear (CS, u, v) end subroutine calc_shelf_visc_bilinear subroutine update_OD_ffrac (CS, ocean_mass, counter, nstep_velocity, time_step, velocity_update_time_step) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(CS%grid%isd:,CS%grid%jsd:) :: ocean_mass integer,intent(in) :: counter integer,intent(in) :: nstep_velocity @@ -5396,7 +5386,7 @@ subroutine update_OD_ffrac (CS, ocean_mass, counter, nstep_velocity, time_step, end subroutine update_OD_ffrac subroutine update_OD_ffrac_uncoupled (CS) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), pointer :: G integer :: i, j, iters, isd, ied, jsd, jed @@ -5567,7 +5557,7 @@ end subroutine bilinear_shape_functions_subgrid subroutine update_velocity_masks (CS) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure ! sets masks for velocity solve ! ignores the fact that their might be ice-free cells - this only considers the computational boundary @@ -5576,7 +5566,7 @@ subroutine update_velocity_masks (CS) integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq, giec, gjec, gisc, gjsc, isc, jsc, iec, jec, k integer :: i_off, j_off - type(ocean_grid_type), pointer :: G + type(ocean_grid_type), pointer :: G => NULL() real, dimension(:,:), pointer :: umask, vmask, u_face_mask, v_face_mask, hmask, u_face_mask_boundary, v_face_mask_boundary G => CS%grid @@ -5729,11 +5719,12 @@ end subroutine update_velocity_masks subroutine interpolate_H_to_B (CS, h_shelf, hmask, H_node) - type(ice_shelf_CS), pointer :: CS - real, dimension (:,:), intent(in) :: h_shelf, hmask - real, dimension (NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: H_node + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + real, dimension(:,:), intent(in) :: h_shelf, hmask + real, dimension(NILIMB_SYM_,NJLIMB_SYM_), & + intent(inout) :: H_node - type(ocean_grid_type), pointer :: G + type(ocean_grid_type), pointer :: G => NULL() integer :: i, j, isc, iec, jsc, jec, num_h, k, l real :: summ @@ -5769,7 +5760,7 @@ end subroutine interpolate_H_to_B !> Deallocates all memory associated with this module subroutine ice_shelf_end(CS) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure if (.not.associated(CS)) return @@ -5887,13 +5878,13 @@ end subroutine savearray2 subroutine solo_time_step (CS, time_step, n, Time, min_time_step_in) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real,intent(in) :: time_step integer, intent(inout) :: n type(time_type) :: Time real,optional,intent(in) :: min_time_step_in - type(ocean_grid_type), pointer :: G + type(ocean_grid_type), pointer :: G => NULL() integer :: is, iec, js, jec, i, j, ki, kj, iters real :: ratio, min_ratio, time_step_remain, local_u_max, & local_v_max, time_step_int, min_time_step,spy,dumtimeprint @@ -6021,7 +6012,7 @@ end subroutine solo_time_step !!! OVS !!! subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, intent(in) :: time_step real, dimension(:,:), pointer :: melt_rate type(time_type), intent(in) :: Time @@ -6063,7 +6054,7 @@ subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) ! o--- (3) ---o ! - type(ocean_grid_type), pointer :: G + type(ocean_grid_type), pointer :: G => NULL() real, dimension(size(CS%h_shelf,1),size(CS%h_shelf,2)) :: th_after_uflux, th_after_vflux, TH real, dimension(size(CS%h_shelf,1),size(CS%h_shelf,2),4) :: flux_enter integer :: isd, ied, jsd, jed, i, j, isc, iec, jsc, jec @@ -6172,7 +6163,7 @@ end subroutine ice_shelf_temp subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, intent(in) :: time_step real, dimension(:,:), intent(in) :: h0 real, dimension(:,:), intent(inout) :: h_after_uflux @@ -6199,7 +6190,7 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter integer :: isym, i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied integer :: i_off, j_off logical :: at_east_bdry, at_west_bdry, one_off_west_bdry, one_off_east_bdry - type(ocean_grid_type), pointer :: G + type(ocean_grid_type), pointer :: G => NULL() real, dimension(-2:2) :: stencil real, dimension(:,:), pointer :: hmask, u_face_mask, u_flux_boundary_values,u_boundary_values,t_boundary real :: u_face, & ! positive if out @@ -6425,7 +6416,7 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter end subroutine ice_shelf_advect_temp_x subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, flux_enter) - type(ice_shelf_CS), pointer :: CS + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, intent(in) :: time_step real, dimension(:,:), intent(in) :: h_after_uflux real, dimension(:,:), intent(inout) :: h_after_vflux @@ -6452,7 +6443,7 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, integer :: isym, i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied integer :: i_off, j_off logical :: at_north_bdry, at_south_bdry, one_off_west_bdry, one_off_east_bdry - type(ocean_grid_type), pointer :: G + type(ocean_grid_type), pointer :: G => NULL() real, dimension(-2:2) :: stencil real, dimension(:,:), pointer :: hmask, v_face_mask, v_flux_boundary_values,t_boundary,v_boundary_values real :: v_face, & ! positive if out From ce06a5d82dfa12b6d29afac3b0c88da11d5b5f50 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 3 May 2018 18:30:04 -0400 Subject: [PATCH 0182/1072] Standardized argument attribute order Replaced (intent, optional) declarations with (optional, intent), and similarly for (pointer, intent) across numerous files. This will help to filter to ensure that intents or a pointer status are specified for all arguments. All answers are bitwise identical. --- config_src/coupled_driver/ocean_model_MOM.F90 | 11 +- .../ice_solo_driver/atmos_ocean_fluxes.F90 | 24 ++-- config_src/ice_solo_driver/coupler_types.F90 | 12 +- config_src/mct_driver/ocn_comp_mct.F90 | 32 ++--- config_src/solo_driver/atmos_ocean_fluxes.F90 | 24 ++-- config_src/solo_driver/coupler_types.F90 | 12 +- src/core/MOM_continuity_PPM.F90 | 4 +- src/core/MOM_dynamics_unsplit.F90 | 68 +++++----- src/framework/MOM_get_input.F90 | 2 +- src/initialization/midas_vertmap.F90 | 39 +++--- .../lateral/MOM_hor_visc.F90 | 2 +- src/parameterizations/vertical/MOM_KPP.F90 | 6 +- .../vertical/MOM_bulk_mixed_layer.F90 | 12 +- .../vertical/MOM_diabatic_aux.F90 | 4 +- .../vertical/MOM_diabatic_driver.F90 | 5 +- .../vertical/MOM_entrain_diffusive.F90 | 116 ++++++++---------- .../vertical/MOM_vert_friction.F90 | 11 +- src/tracer/MOM_OCMIP2_CO2calc.F90 | 2 +- src/tracer/MOM_generic_tracer.F90 | 2 +- src/tracer/MOM_tracer_advect.F90 | 38 +++--- 20 files changed, 211 insertions(+), 215 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 8bf16012f4..1f5cc53989 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -685,9 +685,9 @@ end subroutine update_ocean_model ! ! subroutine ocean_model_restart(OS, timestamp) - type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the + type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the !! internal ocean state being saved to a restart file - character(len=*), intent(in), optional :: timestamp !< An optional timestamp string that should be + character(len=*), optional, intent(in) :: timestamp !< An optional timestamp string that should be !! prepended to the file name. (Currently this is unused.) if (.not.MOM_state_is_synchronized(OS%MOM_CSp)) & @@ -800,10 +800,11 @@ end subroutine ocean_model_save_restart subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, & gas_fields_ocn) - type(domain2D), intent(in) :: input_domain + type(domain2D), intent(in) :: input_domain type(ocean_public_type), intent(inout) :: Ocean_sfc - type(diag_ctrl), intent(in) :: diag - logical, intent(in), optional :: maskmap(:,:) + type(diag_ctrl), intent(in) :: diag + logical, dimension(:,:), & + optional, intent(in) :: maskmap 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 diff --git a/config_src/ice_solo_driver/atmos_ocean_fluxes.F90 b/config_src/ice_solo_driver/atmos_ocean_fluxes.F90 index 66b2463ae7..5494954398 100644 --- a/config_src/ice_solo_driver/atmos_ocean_fluxes.F90 +++ b/config_src/ice_solo_driver/atmos_ocean_fluxes.F90 @@ -10,21 +10,23 @@ module atmos_ocean_fluxes_mod contains +!> This subroutine duplicates an interface used by the FMS coupler, but only +!! returns a value of -1. None of the arguments are used for anything. function aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index, & param, flag, ice_restart_file, ocean_restart_file, & units, caller, verbosity) result (coupler_index) - character(len=*), intent(in) :: name - character(len=*), intent(in) :: flux_type - character(len=*), intent(in) :: implementation - integer, intent(in), optional :: atm_tr_index - real, intent(in), dimension(:), optional :: param - logical, intent(in), dimension(:), optional :: flag - character(len=*), intent(in), optional :: ice_restart_file - character(len=*), intent(in), optional :: ocean_restart_file - character(len=*), intent(in), optional :: units - character(len=*), intent(in), optional :: caller - integer, intent(in), optional :: verbosity + character(len=*), intent(in) :: name !< An unused argument + character(len=*), intent(in) :: flux_type !< An unused argument + character(len=*), intent(in) :: implementation !< An unused argument + integer, optional, intent(in) :: atm_tr_index !< An unused argument + real, dimension(:), optional, intent(in) :: param !< An unused argument + logical, dimension(:), optional, intent(in) :: flag !< An unused argument + character(len=*), optional, intent(in) :: ice_restart_file !< An unused argument + character(len=*), optional, intent(in) :: ocean_restart_file !< An unused argument + character(len=*), optional, intent(in) :: units !< An unused argument + character(len=*), optional, intent(in) :: caller !< An unused argument + integer, optional, intent(in) :: verbosity !< An unused argument ! None of these arguments are used for anything. diff --git a/config_src/ice_solo_driver/coupler_types.F90 b/config_src/ice_solo_driver/coupler_types.F90 index bc4a941b04..a57d2dd37e 100644 --- a/config_src/ice_solo_driver/coupler_types.F90 +++ b/config_src/ice_solo_driver/coupler_types.F90 @@ -294,7 +294,7 @@ subroutine coupler_type_copy_1d_2d(var_in, var_out, is, ie, js, je, & character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_1d_2d):' @@ -343,7 +343,7 @@ subroutine coupler_type_copy_1d_3d(var_in, var_out, is, ie, js, je, kd, & character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_1d_3d):' @@ -386,7 +386,7 @@ subroutine coupler_type_copy_2d_2d(var_in, var_out, is, ie, js, je, & character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_2d_2d):' @@ -435,7 +435,7 @@ subroutine coupler_type_copy_2d_3d(var_in, var_out, is, ie, js, je, kd, & character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_2d_3d):' @@ -478,7 +478,7 @@ subroutine coupler_type_copy_3d_2d(var_in, var_out, is, ie, js, je, & character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_3d_2d):' @@ -527,7 +527,7 @@ subroutine coupler_type_copy_3d_3d(var_in, var_out, is, ie, js, je, kd, & character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_3d_3d):' diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 398ae829a4..354e309ed9 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -1675,7 +1675,7 @@ subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, & type(cpl_indices), intent(inout) :: ind !< Structure with MCT attribute vectors and indices logical, intent(in) :: sw_decomp !< controls if shortwave is !!decomposed into four components - real(kind=8), intent(in), optional :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition + real(kind=8), optional, intent(in) :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition ! local variables type(time_type) :: Master_time !< This allows step_MOM to temporarily change @@ -1812,21 +1812,21 @@ end subroutine update_ocean_model !! the future. subroutine ocn_import(forces, fluxes, Time, G, CS, state, x2o_o, ind, sw_decomp, & c1, c2, c3, c4, restore_salt, restore_temp) - type(mech_forcing), intent(inout) :: forces !< Driving mechanical forces - type(forcing), intent(inout) :: fluxes !< Surface fluxes - type(time_type), intent(in) :: Time !< Model time - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid - type(surface_forcing_CS), pointer :: CS !< control structure returned by - !! a previous call to surface_forcing_init - type(surface), intent(in) :: state !< control structure to ocean - !! surface state fields. - real(kind=8), intent(in) :: x2o_o(:,:)!< Fluxes from coupler to ocean, computed by ocean - type(cpl_indices), intent(inout) :: ind !< Structure with MCT attribute vectors and indices - logical, intent(in) :: sw_decomp !< controls if shortwave is - !!decomposed into four components - real(kind=8), intent(in), optional :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition - logical, optional, intent(in) :: restore_salt, restore_temp !< Controls if salt and temp are - !! restored + type(mech_forcing), intent(inout) :: forces !< Driving mechanical forces + type(forcing), intent(inout) :: fluxes !< Surface fluxes + type(time_type), intent(in) :: Time !< Model time + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid + type(surface_forcing_CS), pointer :: CS !< control structure returned by + !! a previous call to surface_forcing_init + type(surface), intent(in) :: state !< control structure to ocean + !! surface state fields. + real(kind=8), intent(in) :: x2o_o(:,:)!< Fluxes from coupler to ocean, computed by ocean + type(cpl_indices), intent(inout) :: ind !< Structure with MCT attribute vectors and indices + logical, intent(in) :: sw_decomp !< controls if shortwave is + !!decomposed into four components + real(kind=8), optional, intent(in) :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition + logical, optional, intent(in) :: restore_salt, restore_temp !< Controls if salt and temp are + !! restored ! local variables real, dimension(SZIB_(G),SZJB_(G)) :: & diff --git a/config_src/solo_driver/atmos_ocean_fluxes.F90 b/config_src/solo_driver/atmos_ocean_fluxes.F90 index 66b2463ae7..5494954398 100644 --- a/config_src/solo_driver/atmos_ocean_fluxes.F90 +++ b/config_src/solo_driver/atmos_ocean_fluxes.F90 @@ -10,21 +10,23 @@ module atmos_ocean_fluxes_mod contains +!> This subroutine duplicates an interface used by the FMS coupler, but only +!! returns a value of -1. None of the arguments are used for anything. function aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index, & param, flag, ice_restart_file, ocean_restart_file, & units, caller, verbosity) result (coupler_index) - character(len=*), intent(in) :: name - character(len=*), intent(in) :: flux_type - character(len=*), intent(in) :: implementation - integer, intent(in), optional :: atm_tr_index - real, intent(in), dimension(:), optional :: param - logical, intent(in), dimension(:), optional :: flag - character(len=*), intent(in), optional :: ice_restart_file - character(len=*), intent(in), optional :: ocean_restart_file - character(len=*), intent(in), optional :: units - character(len=*), intent(in), optional :: caller - integer, intent(in), optional :: verbosity + character(len=*), intent(in) :: name !< An unused argument + character(len=*), intent(in) :: flux_type !< An unused argument + character(len=*), intent(in) :: implementation !< An unused argument + integer, optional, intent(in) :: atm_tr_index !< An unused argument + real, dimension(:), optional, intent(in) :: param !< An unused argument + logical, dimension(:), optional, intent(in) :: flag !< An unused argument + character(len=*), optional, intent(in) :: ice_restart_file !< An unused argument + character(len=*), optional, intent(in) :: ocean_restart_file !< An unused argument + character(len=*), optional, intent(in) :: units !< An unused argument + character(len=*), optional, intent(in) :: caller !< An unused argument + integer, optional, intent(in) :: verbosity !< An unused argument ! None of these arguments are used for anything. diff --git a/config_src/solo_driver/coupler_types.F90 b/config_src/solo_driver/coupler_types.F90 index 819eac6de7..0de045fa02 100644 --- a/config_src/solo_driver/coupler_types.F90 +++ b/config_src/solo_driver/coupler_types.F90 @@ -294,7 +294,7 @@ subroutine coupler_type_copy_1d_2d(var_in, var_out, is, ie, js, je, & character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_1d_2d):' @@ -343,7 +343,7 @@ subroutine coupler_type_copy_1d_3d(var_in, var_out, is, ie, js, je, kd, & character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_1d_3d):' @@ -386,7 +386,7 @@ subroutine coupler_type_copy_2d_2d(var_in, var_out, is, ie, js, je, & character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_2d_2d):' @@ -435,7 +435,7 @@ subroutine coupler_type_copy_2d_3d(var_in, var_out, is, ie, js, je, kd, & character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_2d_3d):' @@ -478,7 +478,7 @@ subroutine coupler_type_copy_3d_2d(var_in, var_out, is, ie, js, je, & character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_3d_2d):' @@ -527,7 +527,7 @@ subroutine coupler_type_copy_3d_3d(var_in, var_out, is, ie, js, je, kd, & character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), intent(in), optional :: suffix !< optional suffix to make the name identifier unique + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique character(len=256), parameter :: error_header = & '==>Error from coupler_types_mod (coupler_type_copy_3d_3d):' diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index bd0c7bbcd7..9ea47bd37b 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -1889,7 +1889,7 @@ subroutine PPM_reconstruction_x(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_ logical, optional, intent(in) :: simple_2nd !< If true, use the !! arithmetic mean thicknesses as the default edge values !! for a simple 2nd order scheme. - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables with useful mnemonic names. real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slopes. @@ -2028,7 +2028,7 @@ subroutine PPM_reconstruction_y(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_ logical, optional, intent(in) :: simple_2nd !< If true, use the !! arithmetic mean thicknesses as the default edge values !! for a simple 2nd order scheme. - type(ocean_OBC_type), pointer, optional :: OBC !< Open boundaries control structure. + type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables with useful mnemonic names. real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slopes. diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index d4e64ef019..aa97b01915 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -166,49 +166,51 @@ module MOM_dynamics_unsplit subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, uh, vh, uhtr, vhtr, eta_av, G, GV, CS, & VarMix, MEKE, Waves) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: u !< The zonal velocity, in m s-1. + intent(inout) :: u !< The zonal velocity, in m s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: v !< The meridional velocity, in m s-1. + intent(inout) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thicknesses, in H. - !! (usually m or kg m-2). - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various - !! thermodynamic variables. - type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical + intent(inout) :: h !< Layer thicknesses, in H. + !! (usually m or kg m-2). + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables. + type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical !! viscosities, bottom drag viscosities, and related fields. - type(time_type), intent(in) :: Time_local !< The model time at the end - !! of the time step. - real, intent(in) :: dt !< The dynamics time step, in s. - type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to the + type(time_type), intent(in) :: Time_local !< The model time at the end + !! of the time step. + real, intent(in) :: dt !< The dynamics time step, in s. + type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces + real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to the !! surface pressure at the beginning of this dynamic step, in Pa. - real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the + real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the !! surface pressure at the end of this dynamic step, in Pa. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: uh !< The zonal volume or mass transport, - !! in m3 s-1 or kg s-1. + intent(inout) :: uh !< The zonal volume or mass transport, + !! in m3 s-1 or kg s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: vh !< The meridional volume or mass - !! transport, in m3 s-1 or kg s-1. + intent(inout) :: vh !< The meridional volume or mass + !! transport, in m3 s-1 or kg s-1. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: uhtr !< he accumulated zonal volume or mass - !! transport since the last tracer advection, in m3 or kg. + intent(inout) :: uhtr !< he accumulated zonal volume or mass + !! transport since the last tracer advection, in m3 or kg. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: vhtr !< The accumulated meridional volume or - !! mass transport since the last tracer advection, in m3 or kg. - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height or - !! column mass, in m or kg m-2. - type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by - !! initialize_dyn_unsplit. - type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with fields - !! that specify the spatially variable viscosities. - type(MEKE_type), pointer :: MEKE !< A pointer to a structure containing - !! fields related to the Mesoscale Eddy Kinetic Energy. - type(wave_parameters_CS), pointer, optional :: Waves !< A pointer to a structure containing - !! fields related to the surface wave conditions + intent(inout) :: vhtr !< The accumulated meridional volume or + !! mass transport since the last tracer advection, in m3 or kg. + real, dimension(SZI_(G),SZJ_(G)), & + intent(out) :: eta_av !< The time-mean free surface height or + !! column mass, in m or kg m-2. + type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by + !! initialize_dyn_unsplit. + type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with fields + !! that specify the spatially variable viscosities. + type(MEKE_type), pointer :: MEKE !< A pointer to a structure containing + !! fields related to the Mesoscale Eddy Kinetic Energy. + type(wave_parameters_CS), & + optional, pointer :: Waves !< A pointer to a structure containing + !! fields related to the surface wave conditions ! Arguments: u - The input and output zonal velocity, in m s-1. ! (inout) v - The input and output meridional velocity, in m s-1. diff --git a/src/framework/MOM_get_input.F90 b/src/framework/MOM_get_input.F90 index 2687579750..de75e9713b 100644 --- a/src/framework/MOM_get_input.F90 +++ b/src/framework/MOM_get_input.F90 @@ -38,7 +38,7 @@ subroutine get_MOM_input(param_file, dirs, check_params, default_input_filename, character(len=*), optional, intent(in) :: default_input_filename !< If present, is the value assumed for !! input_filename if input_filename is not listed !! in the namelist MOM_input_nml. - integer, intent(in), optional :: ensemble_num !< The ensemble id of the current member + integer, optional, intent(in) :: ensemble_num !< The ensemble id of the current member ! Local variables integer, parameter :: npf = 5 ! Maximum number of parameter files character(len=240) :: & diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index c1ba6793b8..7cdc440f62 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -227,8 +227,8 @@ function tracer_z_init(tr_in,z_edges,e,nkml,nkbl,land_fill,wet,nlay,nlevs,debug, real, intent(in) :: land_fill real, dimension(size(tr_in,1),size(tr_in,2)), intent(in) :: wet real, dimension(size(tr_in,1),size(tr_in,2)), optional, intent(in) ::nlevs -logical, intent(in), optional :: debug -integer, intent(in), optional :: i_debug, j_debug +logical, optional, intent(in) :: debug +integer, optional, intent(in) :: i_debug, j_debug real, dimension(size(tr_in,1),size(tr_in,2),nlay) :: tr real, dimension(size(tr_in,3)) :: tr_1d @@ -397,7 +397,7 @@ function bisect_fast(a, x, lo, hi) result(bi_r) real, dimension(:,:), intent(in) :: a real, dimension(:), intent(in) :: x -integer, dimension(size(a,1)), intent(in), optional :: lo,hi +integer, dimension(size(a,1)), optional, intent(in) :: lo,hi integer, dimension(size(a,1),size(x,1)) :: bi_r integer :: mid,num_x,num_a,i @@ -494,7 +494,7 @@ subroutine determine_temperature(temp,salt,R,p_ref,niter,land_fill,h,k_start,eos integer, intent(in) :: k_start real, intent(in) :: land_fill real, dimension(:,:,:), intent(in) :: h -type(eos_type), pointer, intent(in) :: eos +type(eos_type), pointer :: eos real(kind=8), dimension(size(temp,1),size(temp,3)) :: T,S,dT,dS,rho,hin real(kind=8), dimension(size(temp,1),size(temp,3)) :: drho_dT,drho_dS @@ -689,7 +689,8 @@ function find_limited_slope(val, e, k) result(slope) real, dimension(:), intent(in) :: val real, dimension(:), intent(in) :: e integer, intent(in) :: k -real :: slope,amx,bmx,amn,bmn,cmn,dmn +real :: slope +real :: amx,bmx,amn,bmn,cmn,dmn real :: d1, d2 @@ -719,8 +720,6 @@ function find_limited_slope(val, e, k) result(slope) end function find_limited_slope - - function find_interfaces(rho,zin,Rb,depth,nlevs,nkml,nkbl,hml,debug) result(zi) ! (in) rho : potential density in z-space (kg m-3) ! (in) zin : levels (m) @@ -731,15 +730,20 @@ function find_interfaces(rho,zin,Rb,depth,nlevs,nkml,nkbl,hml,debug) result(zi) ! (in) nkbl : number of buffer layer pieces ! (in) hml : mixed layer depth -real, dimension(:,:,:), intent(in) :: rho -real, dimension(size(rho,3)), intent(in) :: zin +real, dimension(:,:,:), & + intent(in) :: rho +real, dimension(size(rho,3)), & + intent(in) :: zin real, dimension(:), intent(in) :: Rb -real, dimension(size(rho,1),size(rho,2)), intent(in) :: depth -real, dimension(size(rho,1),size(rho,2)), optional, intent(in) ::nlevs -logical, optional, intent(in) :: debug +real, dimension(size(rho,1),size(rho,2)), & + intent(in) :: depth +real, dimension(size(rho,1),size(rho,2)), & + optional, intent(in) ::nlevs +logical, optional, intent(in) :: debug +integer, optional, intent(in) :: nkml +integer, optional, intent(in) :: nkbl +real, optional, intent(in) :: hml real, dimension(size(rho,1),size(rho,2),size(Rb,1)) :: zi -integer, intent(in), optional :: nkml, nkbl -real, intent(in), optional :: hml real, dimension(size(rho,1),size(rho,3)) :: rho_ real, dimension(size(rho,1)) :: depth_ @@ -758,8 +762,7 @@ function find_interfaces(rho,zin,Rb,depth,nlevs,nkml,nkbl,hml,debug) result(zi) nlay=size(Rb)-1 -zi=0.0 - +zi(:,:,:) = 0.0 if (PRESENT(debug)) debug_=debug @@ -949,8 +952,6 @@ subroutine smooth_heights(zi,fill,bad,sor,niter,cyclic_x, tripolar_n) mp = fill_boundaries(zi,cyclic_x,tripolar_n) end do - - return end subroutine smooth_heights @@ -1010,6 +1011,4 @@ function fill_boundaries_real(m,cyclic_x,tripolar_n) result(mp) end function fill_boundaries_real - - end module midas_vertmap diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 0e02cefba2..6abcc45cff 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -237,7 +237,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, !! specify the spatially variable viscosities type(hor_visc_CS), pointer :: CS !< Pontrol structure returned by a previous !! call to hor_visc_init. - type(ocean_OBC_type), pointer, optional :: OBC !< Pointer to an open boundary condition type + type(ocean_OBC_type), optional, pointer :: OBC !< Pointer to an open boundary condition type ! Arguments: ! (in) u - zonal velocity (m/s) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 7da817c906..f279415649 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -169,8 +169,8 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive, Waves) type(diag_ctrl), target, intent(in) :: diag !< Diagnostics type(time_type), intent(in) :: Time !< Time type(KPP_CS), pointer :: CS !< Control structure - logical, optional, intent(out) :: passive !< Copy of %passiveMode - type(wave_parameters_CS), pointer, optional :: Waves ! This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. -subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, GV, CS, WAVES) +subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, CS, WAVES) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity (m/s) @@ -270,7 +271,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G real, intent(in) :: dt !< time increment (seconds) type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure - type(Wave_parameters_CS), pointer, optional :: Waves !< Surface gravity waves + type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & ea, & ! amount of fluid entrained from the layer above within diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 1852e87c48..c225edac13 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -1513,7 +1513,10 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & end subroutine determine_dSkb - +!> Given an entrainment from below for layer kb, determine a consistent +!! entrainment from above, such that dSkb * ea_kb = dSkbp1 * F_kb. The input +!! value of ea_kb is both the maximum value that can be obtained and the first +!! guess of the iterations. Ideally ea_kb should be an under-estimate subroutine F_kb_to_ea_kb(h_bl, Sref, Ent_bl, I_dSkbp1, F_kb, kmb, i, & G, GV, CS, ea_kb, tol_in) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -1525,10 +1528,6 @@ subroutine F_kb_to_ea_kb(h_bl, Sref, Ent_bl, I_dSkbp1, F_kb, kmb, i, & real, dimension(SZI_(G)), intent(inout) :: ea_kb real, optional, intent(in) :: tol_in - ! Given an entrainment from below for layer kb, determine a consistent - ! entrainment from above, such that dSkb * ea_kb = dSkbp1 * F_kb. The input - ! value of ea_kb is both the maximum value that can be obtained and the first - ! guess of the iterations. Also, make sure that ea_kb is an under-estimate real :: max_ea, min_ea real :: err, err_min, err_max real :: derr_dea @@ -1630,6 +1629,9 @@ subroutine F_kb_to_ea_kb(h_bl, Sref, Ent_bl, I_dSkbp1, F_kb, kmb, i, & end subroutine F_kb_to_ea_kb +!> This subroutine determines the entrainment from above by the top interior +!! layer (labeled kb elsewhere) given an entrainment by the layer below it, +!! constrained to be within the provided bounds. subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & min_eakb, max_eakb, kmb, is, ie, do_i, G, GV, CS, Ent, & error, err_min_eakb0, err_max_eakb0, F_kb, dFdfm_kb) @@ -1667,19 +1669,19 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & real, dimension(SZI_(G)), intent(inout) :: Ent !< The entrainment rate of the uppermost !! interior layer, in H. The input value !! is the first guess. - real, dimension(SZI_(G)), intent(out), optional :: error !< The error (locally defined in this + real, dimension(SZI_(G)), optional, intent(out) :: error !< The error (locally defined in this !! routine) associated with the returned !! solution. - real, dimension(SZI_(G)), intent(in), optional :: err_min_eakb0, err_max_eakb0 !< The errors + real, dimension(SZI_(G)), optional, intent(in) :: err_min_eakb0, err_max_eakb0 !< The errors !! (locally defined) associated with !! min_eakb and max_eakb when ea_kbp1 !! = 0, returned from a previous call !! to this routine. - real, dimension(SZI_(G)), intent(out), optional :: F_kb !< The entrainment from below by the + real, dimension(SZI_(G)), optional, intent(out) :: F_kb !< The entrainment from below by the !! uppermost interior layer !! corresponding to the returned !! value of Ent, in H. - real, dimension(SZI_(G)), intent(out), optional :: dFdfm_kb !< The partial derivative of F_kb with + real, dimension(SZI_(G)), optional, intent(out) :: dFdfm_kb !< The partial derivative of F_kb with !! ea_kbp1, nondim. ! Arguments: h_bl - Layer thickness, with the top interior layer at k-index @@ -1868,71 +1870,49 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & end subroutine determine_Ea_kb +!> Maximize F = ent*ds_kb*I_dSkbp1 in the range min_ent < ent < max_ent. subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & kmb, is, ie, G, GV, CS, maxF, ent_maxF, do_i_in, & F_lim_maxent, F_thresh) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: h_bl !< Layer thickness, in m or kg m-2 - !! (abbreviated as H below). + intent(in) :: h_bl !< Layer thickness, in m or kg m-2 + !! (abbreviated as H below). real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: Sref !< Reference potential density (in kg m-3?). + intent(in) :: Sref !< Reference potential density (in kg m-3?). real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: Ent_bl !< The average entrainment upward and - !! downward across each interface around - !! the buffer layers, in H. - real, dimension(SZI_(G)), intent(in) :: I_dSkbp1 !< The inverse of the difference in - !! reference potential density across the - !! base of the uppermost interior layer, - !! in units of m3 kg-1. - real, dimension(SZI_(G)), intent(in) :: min_ent_in !< The minimum value of ent to search, - !! in H. - real, dimension(SZI_(G)), intent(in) :: max_ent_in !< The maximum value of ent to search, - !! in H. - integer, intent(in) :: kmb - integer, intent(in) :: is, ie !< The range of i-indices to work on. - type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. - real, dimension(SZI_(G)), intent(out) :: maxF !< The maximum value of F - !! = ent*ds_kb*I_dSkbp1 found in the range - !! min_ent < ent < max_ent, in H. - real, dimension(SZI_(G)), intent(out), & - optional :: ent_maxF !< The value of ent at that maximum, in H. - logical, dimension(SZI_(G)), intent(in), & - optional :: do_i_in !< A logical array indicating which columns - !! to work on. - real, dimension(SZI_(G)), intent(out), & - optional :: F_lim_maxent !< If present, do not apply the limit in - !! finding the maximum value, but return the - !! limited value at ent=max_ent_in in this - !! array, in H. - real, dimension(SZI_(G)), intent(in), & - optional :: F_thresh !< If F_thresh is present, return the first - !! value found that has F > F_thresh, or - !! the maximum. - -! Arguments: h_bl - Layer thickness, in m or kg m-2 (abbreviated as H below). -! (in) Sref - Reference potential density (in kg m-3?) -! (in) Ent_bl - The average entrainment upward and downward across -! each interface around the buffer layers, in H. -! (in) I_dSkbp1 - The inverse of the difference in reference potential -! density across the base of the uppermost interior layer, -! in units of m3 kg-1. -! (in) min_ent_in - The minimum value of ent to search, in H. -! (in) max_ent_in - The maximum value of ent to search, in H. -! (in) is, ie - The range of i-indices to work on. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - This module's control structure. -! (out) maxF - The maximum value of F = ent*ds_kb*I_dSkbp1 found in the -! range min_ent < ent < max_ent, in H. -! (out,opt) ent_maxF - The value of ent at that maximum, in H. -! (in, opt) do_i_in - A logical array indicating which columns to work on. -! (out,opt) F_lim_maxent - If present, do not apply the limit in finding the -! maximum value, but return the limited value at -! ent=max_ent_in in this array, in H. -! (in, opt) F_thresh - If F_thresh is present, return the first value found -! that has F > F_thresh, or the maximum. + intent(in) :: Ent_bl !< The average entrainment upward and + !! downward across each interface around + !! the buffer layers, in H. + real, dimension(SZI_(G)), intent(in) :: I_dSkbp1 !< The inverse of the difference in + !! reference potential density across the + !! base of the uppermost interior layer, + !! in units of m3 kg-1. + real, dimension(SZI_(G)), intent(in) :: min_ent_in !< The minimum value of ent to search, + !! in H. + real, dimension(SZI_(G)), intent(in) :: max_ent_in !< The maximum value of ent to search, + !! in H. + integer, intent(in) :: kmb + integer, intent(in) :: is, ie !< The range of i-indices to work on. + type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. + real, dimension(SZI_(G)), intent(out) :: maxF !< The maximum value of F + !! = ent*ds_kb*I_dSkbp1 found in the range + !! min_ent < ent < max_ent, in H. + real, dimension(SZI_(G)), & + optional, intent(out) :: ent_maxF !< The value of ent at that maximum, in H. + logical, dimension(SZI_(G)), & + optional, intent(in) :: do_i_in !< A logical array indicating which columns + !! to work on. + real, dimension(SZI_(G)), & + optional, intent(out) :: F_lim_maxent !< If present, do not apply the limit in + !! finding the maximum value, but return the + !! limited value at ent=max_ent_in in this + !! array, in H. + real, dimension(SZI_(G)), & + optional, intent(in) :: F_thresh !< If F_thresh is present, return the first + !! value found that has F > F_thresh, or + !! the maximum. ! Maximize F = ent*ds_kb*I_dSkbp1 in the range min_ent < ent < max_ent. ! ds_kb may itself be limited to positive values in determine_dSkb, which gives diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 4fc0c276df..4226e4fa8c 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -156,11 +156,12 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & !! equations for diagnostics type(cont_diag_ptrs), intent(inout) :: CDp !< Continuity equation terms type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure - !> Zonal bottom stress from ocean to rock in Pa - real, optional, intent(out), dimension(SZIB_(G),SZJ_(G)) :: taux_bot - !> Meridional bottom stress from ocean to rock in Pa - real, optional, intent(out), dimension(SZI_(G),SZJB_(G)) :: tauy_bot - type(wave_parameters_CS), pointer, optional :: Waves !< Container for wave/Stokes information + real, dimension(SZIB_(G),SZJ_(G)), & + optional, intent(out) :: taux_bot !< Zonal bottom stress from ocean to rock in Pa + real, dimension(SZI_(G),SZJB_(G)), & + optional, intent(out) :: tauy_bot !< Meridional bottom stress from ocean to rock in Pa + type(wave_parameters_CS), & + optional, pointer :: Waves !< Container for wave/Stokes information ! Fields from forces used in this subroutine: ! taux: Zonal wind stress in Pa. diff --git a/src/tracer/MOM_OCMIP2_CO2calc.F90 b/src/tracer/MOM_OCMIP2_CO2calc.F90 index 0f3d16abd1..896c70713e 100644 --- a/src/tracer/MOM_OCMIP2_CO2calc.F90 +++ b/src/tracer/MOM_OCMIP2_CO2calc.F90 @@ -127,7 +127,7 @@ subroutine MOM_ocmip2_co2calc(dope_vec, mask, & real, dimension(dope_vec%isd:dope_vec%ied,dope_vec%jsd:dope_vec%jed), & intent(inout) :: htotal real, dimension(dope_vec%isd:dope_vec%ied,dope_vec%jsd:dope_vec%jed), & - intent(out), optional :: alpha, & + optional, intent(out) :: alpha, & pCO2surf, & co2star, & co3_ion diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 34f83ccba6..24fa3023c5 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -775,7 +775,7 @@ end subroutine MOM_generic_tracer_surface_state !ALL PE subroutine on Ocean! Due to otpm design the fluxes should be initialized like this on ALL PE's! subroutine MOM_generic_flux_init(verbosity) - integer, intent(in), optional :: verbosity !< A 0-9 integer indicating a level of verbosity. + integer, optional, intent(in) :: verbosity !< A 0-9 integer indicating a level of verbosity. integer :: ind character(len=fm_string_len) :: g_tracer_name,longname, package,units,old_package,file_in,file_out diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index db54e599c6..405c7e87d0 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -47,21 +47,29 @@ module MOM_tracer_advect !! monotonic, conservative, weakly diffusive scheme. subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & h_prev_opt, max_iter_in, x_first_in, uhr_out, vhr_out, h_out) - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_end !< layer thickness after advection (m or kg m-2) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uhtr !< accumulated volume/mass flux through zonal face (m3 or kg) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhtr !< accumulated volume/mass flux through merid face (m3 or kg) - type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used - real, intent(in) :: dt !< time increment (seconds) - type(tracer_advect_CS), pointer :: CS !< control structure for module - type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional :: h_prev_opt !< layer thickness before advection (m or kg m-2) - integer, optional :: max_iter_in - logical, optional :: x_first_in - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: uhr_out !< accumulated volume/mass flux through zonal face (m3 or kg) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), optional, intent(out) :: vhr_out !< accumulated volume/mass flux through merid face (m3 or kg) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional :: h_out !< layer thickness before advection (m or kg m-2) + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_end !< layer thickness after advection (m or kg m-2) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: uhtr !< accumulated volume/mass flux through zonal face (m3 or kg) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: vhtr !< accumulated volume/mass flux through merid face (m3 or kg) + type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used + real, intent(in) :: dt !< time increment (seconds) + type(tracer_advect_CS), pointer :: CS !< control structure for module + type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + optional, intent(in) :: h_prev_opt !< layer thickness before advection (m or kg m-2) + integer, optional, intent(in) :: max_iter_in !< The maximum number of iterations + logical, optional, intent(in) :: x_first_in !< If present, indicate whether to update + !! first in the x- or y-direction. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(out) :: uhr_out !< accumulated volume/mass flux through zonal face (m3 or kg) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(out) :: vhr_out !< accumulated volume/mass flux through merid face (m3 or kg) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + optional, intent(out) :: h_out !< layer thickness before advection (m or kg m-2) type(tracer_type) :: Tr(MAX_FIELDS_) ! The array of registered tracers real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & From 30cd987f9d1d7f87a173e212537e1252d8c74569 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 4 May 2018 11:41:28 -0400 Subject: [PATCH 0183/1072] Added dOxyGen comments in MOM_regridding.F90 Added comments describing some of the arguments in MOM_regridding.F90 and split excessively long lines. All answers are bitwise identical. --- src/ALE/MOM_regridding.F90 | 182 +++++++++++++++++++++---------------- 1 file changed, 102 insertions(+), 80 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 482909892b..d4fe0a0c38 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -41,7 +41,7 @@ module MOM_regridding !> This array is set by function setCoordinateResolution() !! It contains the "resolution" or delta coordinate of the target - !! coorindate. It has the units of the target coordiante, e.g. + !! coorindate. It has the units of the target coordinate, e.g. !! meters for z*, non-dimensional for sigma, etc. real, dimension(:), allocatable :: coordinateResolution @@ -530,7 +530,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, if (coordinateMode(coord_mode) == REGRIDDING_ADAPTIVE) then call get_param(param_file, mod, "ADAPT_TIME_RATIO", adaptTimeRatio, & - "Ratio of ALE timestep to grid timescale.", units="s", default=1e-1) + "Ratio of ALE timestep to grid timescale.", units="s", default=1e-1) !### Should the units be "nondim"? call get_param(param_file, mod, "ADAPT_ZOOM_DEPTH", adaptZoom, & "Depth of near-surface zooming region.", units="m", default=200.0) call get_param(param_file, mod, "ADAPT_ZOOM_COEFF", adaptZoomCoeff, & @@ -756,8 +756,7 @@ subroutine end_regridding(CS) end subroutine end_regridding !------------------------------------------------------------------------------ -! Dispatching regridding routine: regridding & remapping -!------------------------------------------------------------------------------ +!> Dispatching regridding routine for orchestrating regridding & remapping subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, frac_shelf_h, conv_adjust) !------------------------------------------------------------------------------ ! This routine takes care of (1) building a new grid and (2) remapping between @@ -781,12 +780,13 @@ subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, frac_ type(regridding_CS), intent(in) :: CS !< Regridding control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the last time step + real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after + !! the last time step type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamical variables (T, S, ...) real, dimension(SZI_(G),SZJ_(G), CS%nk), intent(inout) :: h_new !< New 3D grid consistent with target coordinate real, dimension(SZI_(G),SZJ_(G), CS%nk+1), intent(inout) :: dzInterface !< The change in position of each interface - real, dimension(:,:), optional, pointer :: frac_shelf_h !< Fractional ice shelf coverage - logical, optional, intent(in ) :: conv_adjust ! If true, do convective adjustment + real, dimension(:,:), optional, pointer :: frac_shelf_h !< Fractional ice shelf coverage + logical, optional, intent(in ) :: conv_adjust !< If true, do convective adjustment ! Local variables real :: trickGnuCompiler logical :: use_ice_shelf @@ -1107,12 +1107,12 @@ end subroutine filtered_grid_motion subroutine build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h) ! Arguments - type(regridding_CS), intent(in) :: CS !< Regridding control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H - real, dimension(SZI_(G),SZJ_(G), CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth in H. - real, dimension(:,:), optional, pointer :: frac_shelf_h !< Fractional ice shelf coverage. + type(regridding_CS), intent(in) :: CS !< Regridding control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H + real, dimension(SZI_(G),SZJ_(G), CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth in H. + real, dimension(:,:), optional, pointer :: frac_shelf_h !< Fractional ice shelf coverage. ! Local variables integer :: i, j, k integer :: nz @@ -1197,7 +1197,7 @@ end subroutine build_zstar_grid !------------------------------------------------------------------------------ ! Build sigma grid -!------------------------------------------------------------------------------ +!> This routine builds a grid based on terrain-following coordinates. subroutine build_sigma_grid( CS, G, GV, h, dzInterface ) !------------------------------------------------------------------------------ ! This routine builds a grid based on terrain-following coordinates. @@ -1207,11 +1207,11 @@ subroutine build_sigma_grid( CS, G, GV, h, dzInterface ) !------------------------------------------------------------------------------ ! Arguments - type(regridding_CS), intent(in) :: CS !< Regridding control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H - real, dimension(SZI_(G),SZJ_(G), CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth in H. + type(regridding_CS), intent(in) :: CS !< Regridding control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H + real, dimension(SZI_(G),SZJ_(G), CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth in H. ! Local variables integer :: i, j, k @@ -1275,6 +1275,7 @@ end subroutine build_sigma_grid !------------------------------------------------------------------------------ ! Build grid based on target interface densities !------------------------------------------------------------------------------ +!> This routine builds a new grid based on a given set of target interface densities. subroutine build_rho_grid( G, GV, h, tv, dzInterface, remapCS, CS ) !------------------------------------------------------------------------------ ! This routine builds a new grid based on a given set of target interface @@ -1405,13 +1406,13 @@ end subroutine build_rho_grid !! hybrid isopycnic-Cartesian coordinates, Ocean Modelling 37, 55-88. !! http://dx.doi.org/10.1016/S1463-5003(01)00012-9 } subroutine build_grid_HyCOM1( G, GV, h, tv, h_new, dzInterface, CS ) - type(ocean_grid_type), intent(in) :: G !< Grid structure - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Existing model thickness, in H units - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - type(regridding_CS), intent(in) :: CS !< Regridding control structure - real, dimension(SZI_(G),SZJ_(G),CS%nk), intent(inout) :: h_new !< New layer thicknesses (H units) - real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< Changes in interface position + type(ocean_grid_type), intent(in) :: G !< Grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Existing model thickness, in H units + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure + type(regridding_CS), intent(in) :: CS !< Regridding control structure + real, dimension(SZI_(G),SZJ_(G),CS%nk), intent(inout) :: h_new !< New layer thicknesses (H units) + real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< Changes in interface position ! Local variables real, dimension(SZK_(GV)+1) :: z_col ! Source interface positions relative to the surface in H units (m or kg m-2) @@ -1471,14 +1472,17 @@ subroutine build_grid_HyCOM1( G, GV, h, tv, h_new, dzInterface, CS ) end subroutine build_grid_HyCOM1 +!> This subroutine builds an adaptive grid that follows density surfaces where +!! possible, subject to constraints on the smoothness of interface heights. subroutine build_grid_adaptive(G, GV, h, tv, dzInterface, remapCS, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: dzInterface - type(remapping_CS), intent(in) :: remapCS - type(regridding_CS), intent(in) :: CS + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: dzInterface !< The change in interface depth in H + type(remapping_CS), intent(in) :: remapCS !< The remapping control structure + type(regridding_CS), intent(in) :: CS !< Regridding control structure ! local variables integer :: i, j, k, nz ! indices and dimension lengths @@ -1535,7 +1539,7 @@ end subroutine build_grid_adaptive !! shallow topography, this will tend to give a uniform sigma-like coordinate. !! For sufficiently shallow water, a minimum grid spacing is used to avoid !! certain instabilities. -subroutine build_grid_SLight( G, GV, h, tv, dzInterface, CS ) +subroutine build_grid_SLight(G, GV, h, tv, dzInterface, CS) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Existing model thickness, in H units @@ -1637,9 +1641,11 @@ subroutine adjust_interface_motion( CS, nk, h_old, dz_int ) endif do k = min(CS%nk,nk),2,-1 h_new = h_old(k) + ( dz_int(k) - dz_int(k+1) ) - if (h_new Achieve convective adjustment by swapping layers subroutine convective_adjustment(G, GV, h, tv) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) + type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables !------------------------------------------------------------------------------ ! Check each water column to see whether it is stratified. If not, sort the ! layers by successive swappings of water masses (bubble sort algorithm) !------------------------------------------------------------------------------ - ! Arguments - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables - ! Local variables integer :: i, j, k real :: T0, T1 ! temperatures @@ -1867,17 +1871,21 @@ end subroutine convective_adjustment !------------------------------------------------------------------------------ -! Return uniform resolution vector based on coordiante mode -!------------------------------------------------------------------------------ +!> Return a uniform resolution vector in the units of the coordinata function uniformResolution(nk,coordMode,maxDepth,rhoLight,rhoHeavy) !------------------------------------------------------------------------------ ! Calculate a vector of uniform resolution in the units of the coordinate !------------------------------------------------------------------------------ ! Arguments - integer, intent(in) :: nk - character(len=*), intent(in) :: coordMode - real, intent(in) :: maxDepth, rhoLight, rhoHeavy - real :: uniformResolution(nk) + integer, intent(in) :: nk !< Number of cells in source grid + character(len=*), intent(in) :: coordMode !< A string indicating the coordinate mode. + !! See the documenttion for regrid_consts + !! for the recognized values. + real, intent(in) :: maxDepth !< The range of the grid values in some modes + real, intent(in) :: rhoLight !< The minimum value of the grid in RHO mode + real, intent(in) :: rhoHeavy !< The maximum value of the grid in RHO mode + + real :: uniformResolution(nk) !< The returned uniform resolution grid. ! Local variables integer :: scheme @@ -1903,9 +1911,13 @@ function uniformResolution(nk,coordMode,maxDepth,rhoLight,rhoHeavy) end function uniformResolution +!> Initialize the coordinate resolutions by calling the appropriate initialization +!! routine for the specified coordinate mode. subroutine initCoord(CS, coord_mode) - type(regridding_CS), intent(inout) :: CS - character(len=*), intent(in) :: coord_mode + type(regridding_CS), intent(inout) :: CS !< Regridding control structure + character(len=*), intent(in) :: coord_mode !< A string indicating the coordinate mode. + !! See the documenttion for regrid_consts + !! for the recognized values. select case (coordinateMode(coord_mode)) case (REGRIDDING_ZSTAR) @@ -1926,11 +1938,10 @@ subroutine initCoord(CS, coord_mode) end subroutine initCoord !------------------------------------------------------------------------------ -! Set the fixed resolution data -!------------------------------------------------------------------------------ +!> Set the fixed resolution data subroutine setCoordinateResolution( dz, CS ) - real, dimension(:), intent(in) :: dz - type(regridding_CS), intent(inout) :: CS + real, dimension(:), intent(in) :: dz !< A vector of vertical grid spacings + type(regridding_CS), intent(inout) :: CS !< Regridding control structure if (size(dz)/=CS%nk) call MOM_error( FATAL, & 'setCoordinateResolution: inconsistent number of levels' ) @@ -2036,10 +2047,9 @@ end subroutine set_regrid_max_thickness !------------------------------------------------------------------------------ -! Query the fixed resolution data -!------------------------------------------------------------------------------ +!> Query the fixed resolution data function getCoordinateResolution( CS ) - type(regridding_CS), intent(in) :: CS + type(regridding_CS), intent(in) :: CS !< Regridding control structure real, dimension(CS%nk) :: getCoordinateResolution getCoordinateResolution(:) = CS%coordinateResolution(:) @@ -2075,10 +2085,9 @@ function getCoordinateInterfaces( CS ) end function getCoordinateInterfaces !------------------------------------------------------------------------------ -! Query the target coordinate units -!------------------------------------------------------------------------------ +!> Query the target coordinate units function getCoordinateUnits( CS ) - type(regridding_CS), intent(in) :: CS + type(regridding_CS), intent(in) :: CS !< Regridding control structure character(len=20) :: getCoordinateUnits select case ( CS%regridding_scheme ) @@ -2100,10 +2109,9 @@ function getCoordinateUnits( CS ) end function getCoordinateUnits !------------------------------------------------------------------------------ -! Query the short name of the coordinate -!------------------------------------------------------------------------------ +!> Query the short name of the coordinate function getCoordinateShortName( CS ) - type(regridding_CS), intent(in) :: CS + type(regridding_CS), intent(in) :: CS !< Regridding control structure character(len=20) :: getCoordinateShortName select case ( CS%regridding_scheme ) @@ -2149,14 +2157,25 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri real, optional, intent(in) :: compress_fraction !< Fraction of compressibility to add to potential density real, optional, intent(in) :: dz_min_surface !< The fixed resolution in the topmost SLight_nkml_min layers (m) integer, optional, intent(in) :: nz_fixed_surface !< The number of fixed-thickess layers at the top of the model - real, optional, intent(in) :: Rho_ml_avg_depth !< Averaging depth over which to determine mixed layer potential density (m) - real, optional, intent(in) :: nlay_ML_to_interior !< Number of layers to offset the mixed layer density to find resolved stratification (nondim) + real, optional, intent(in) :: Rho_ml_avg_depth !< Averaging depth over which to determine mixed layer potential + !! density (m) + real, optional, intent(in) :: nlay_ML_to_interior !< Number of layers to offset the mixed layer density to find + !! resolved stratification (nondim) logical, optional, intent(in) :: fix_haloclines !< Detect regions with much weaker stratification in the coordinate - real, optional, intent(in) :: halocline_filt_len !< Length scale over which to filter T & S when looking for spuriously unstable water mass profiles (m) - real, optional, intent(in) :: halocline_strat_tol !< Value of the stratification ratio that defines a problematic halocline region. - logical, optional, intent(in) :: integrate_downward_for_e !< If true, integrate for interface positions downward from the top. - real, optional, intent(in) :: adaptTimeRatio, adaptZoom, adaptZoomCoeff, adaptBuoyCoeff, adaptAlpha - logical, optional, intent(in) :: adaptDoMin + real, optional, intent(in) :: halocline_filt_len !< Length scale over which to filter T & S when looking for + !! spuriously unstable water mass profiles (m) + real, optional, intent(in) :: halocline_strat_tol !< Value of the stratification ratio that defines a problematic + !! halocline region. + logical, optional, intent(in) :: integrate_downward_for_e !< If true, integrate for interface positions downward + !! from the top. + real, optional, intent(in) :: adaptTimeRatio !< Ratio of the ALE timestep to the grid timescale, ND. + real, optional, intent(in) :: adaptZoom !< Depth of near-surface zooming region, in m. + real, optional, intent(in) :: adaptZoomCoeff !< Coefficient of near-surface zooming diffusivity, ND. + real, optional, intent(in) :: adaptBuoyCoeff !< Coefficient of buoyancy diffusivity, ND. + real, optional, intent(in) :: adaptAlpha !< Scaling factor on optimization tendency, ND. + logical, optional, intent(in) :: adaptDoMin !< If true, make a HyCOM-like mixed layer by + !! preventing interfaces from being shallower than + !! the depths specified by the regridding coordinate. if (present(interp_scheme)) call set_interp_scheme(CS%interp_CS, interp_scheme) if (present(boundary_extrapolation)) call set_interp_extrap(CS%interp_CS, boundary_extrapolation) @@ -2186,7 +2205,8 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri if (present(min_thickness)) call set_sigma_params(CS%sigma_CS, min_thickness=min_thickness) case (REGRIDDING_RHO) if (present(min_thickness)) call set_rho_params(CS%rho_CS, min_thickness=min_thickness) - if (present(integrate_downward_for_e)) call set_rho_params(CS%rho_CS, integrate_downward_for_e=integrate_downward_for_e) + if (present(integrate_downward_for_e)) & + call set_rho_params(CS%rho_CS, integrate_downward_for_e=integrate_downward_for_e) if (associated(CS%rho_CS) .and. (present(interp_scheme) .or. present(boundary_extrapolation))) & call set_rho_params(CS%rho_CS, interp_CS=CS%interp_CS) case (REGRIDDING_HYCOM1) @@ -2223,35 +2243,37 @@ integer function get_regrid_size(CS) end function get_regrid_size +!> This returns a copy of the zlike_CS stored in the regridding control structure. function get_zlike_CS(CS) - type(regridding_CS), intent(in) :: CS + type(regridding_CS), intent(in) :: CS !< Regridding control structure type(zlike_CS) :: get_zlike_CS get_zlike_CS = CS%zlike_CS end function get_zlike_CS +!> This returns a copy of the sigma_CS stored in the regridding control structure. function get_sigma_CS(CS) - type(regridding_CS), intent(in) :: CS + type(regridding_CS), intent(in) :: CS !< Regridding control structure type(sigma_CS) :: get_sigma_CS get_sigma_CS = CS%sigma_CS end function get_sigma_CS +!> This returns a copy of the rho_CS stored in the regridding control structure. function get_rho_CS(CS) - type(regridding_CS), intent(in) :: CS + type(regridding_CS), intent(in) :: CS !< Regridding control structure type(rho_CS) :: get_rho_CS get_rho_CS = CS%rho_CS end function get_rho_CS !------------------------------------------------------------------------------ -! Return coordinate-derived thicknesses for fixed coordinate systems -!------------------------------------------------------------------------------ +!> Return coordinate-derived thicknesses for fixed coordinate systems function getStaticThickness( CS, SSH, depth ) - type(regridding_CS), intent(in) :: CS - real, intent(in) :: SSH - real, intent(in) :: depth - real, dimension(CS%nk) :: getStaticThickness + type(regridding_CS), intent(in) :: CS !< Regridding control structure + real, intent(in) :: SSH !< The sea surface height, in the same units as depth + real, intent(in) :: depth !< The maximum depth of the grid, perhaps in m. + real, dimension(CS%nk) :: getStaticThickness !< The returned thicknesses in the units of depth ! Local integer :: k real :: z, dz From ceb6100515ceb1b0d4891b4a0cac6f003b9fc108 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 4 May 2018 11:42:17 -0400 Subject: [PATCH 0184/1072] Added dOxyGen comments in MOM_shared_initialization.F90 Added comments describing some of the subroutines and arguments in MOM_shared_initialization.F90 and split excessively long lines. All answers are bitwise identical. --- .../MOM_shared_initialization.F90 | 49 +++++++++++-------- 1 file changed, 29 insertions(+), 20 deletions(-) diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 8bb7a290ee..b150b8c4ad 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -265,7 +265,8 @@ subroutine apply_topography_edits_from_file(D, G, param_file) j = jg(n) - G%jsd_global + 2 if (i>=G%isc .and. i<=G%iec .and. j>=G%jsc .and. j<=G%jec) then if (new_depth(n)/=0.) then - write(*,'(a,3i5,f8.2,a,f8.2,2i4)') 'Ocean topography edit: ',n,ig(n),jg(n),D(i,j),'->',abs(new_depth(n)),i,j + write(*,'(a,3i5,f8.2,a,f8.2,2i4)') & + 'Ocean topography edit: ',n,ig(n),jg(n),D(i,j),'->',abs(new_depth(n)),i,j D(i,j) = abs(new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) else call MOM_error(FATAL, ' apply_topography_edits_from_file: '//& @@ -445,13 +446,12 @@ end subroutine limit_topography ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- +!> This subroutine sets up the Coriolis parameter for a sphere subroutine set_rotation_planetary(f, G, param_file) - type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid - real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent(out) :: f - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters -! Arguments: f - Coriolis parameter (vertical component) in s^-1 -! (in) G - grid type -! (in) param_file - parameter file type + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid + real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & + intent(out) :: f !< Coriolis parameter (vertical component) in s^-1 + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! This subroutine sets up the Coriolis parameter for a sphere character(len=30) :: mdl = "set_rotation_planetary" ! This subroutine's name. @@ -474,13 +474,12 @@ end subroutine set_rotation_planetary ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- +!> This subroutine sets up the Coriolis parameter for a beta-plane or f-plane subroutine set_rotation_beta_plane(f, G, param_file) - type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid - real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent(out) :: f - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters -! Arguments: f - Coriolis parameter (vertical component) in s^-1 -! (in) G - grid type -! (in) param_file - parameter file type + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid + real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & + intent(out) :: f !< Coriolis parameter (vertical component) in s^-1 + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! This subroutine sets up the Coriolis parameter for a beta-plane integer :: I, J @@ -546,10 +545,13 @@ subroutine initialize_grid_rotation_angle(G, PF) end subroutine initialize_grid_rotation_angle ! ----------------------------------------------------------------------------- +!> This subroutine sets the open face lengths at selected points to restrict +!! passages to their observed widths based on a named set of sizes. subroutine reset_face_lengths_named(G, param_file, name) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - character(len=*), intent(in) :: name + character(len=*), intent(in) :: name !< The name for the set of face lengths. Only "global_1deg" + !! is currently implemented. ! This subroutine sets the open face lengths at selected points to restrict ! passages to their observed widths. @@ -671,6 +673,8 @@ end subroutine reset_face_lengths_named ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- +!> This subroutine sets the open face lengths at selected points to restrict +!! passages to their observed widths from a arrays read from a file. subroutine reset_face_lengths_file(G, param_file) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters @@ -738,6 +742,8 @@ end subroutine reset_face_lengths_file ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- +!> This subroutine sets the open face lengths at selected points to restrict +!! passages to their observed widths from a list read from a file. subroutine reset_face_lengths_list(G, param_file) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters @@ -915,7 +921,8 @@ subroutine reset_face_lengths_list(G, param_file) write(*,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCu=0 at ",lat,lon," (",& u_lat(1,npt), u_lat(2,npt), u_lon(1,npt), u_lon(2,npt),") so grid metric is unmodified." else - write(*,'(A,2F8.2,A,4F8.2,A5,F9.2,A1)') "read_face_lengths_list : Modifying dy_Cu gridpoint at ",lat,lon," (",& + write(*,'(A,2F8.2,A,4F8.2,A5,F9.2,A1)') & + "read_face_lengths_list : Modifying dy_Cu gridpoint at ",lat,lon," (",& u_lat(1,npt), u_lat(2,npt), u_lon(1,npt), u_lon(2,npt),") to ",G%dy_Cu(I,j),"m" endif endif @@ -943,7 +950,8 @@ subroutine reset_face_lengths_list(G, param_file) write(*,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCv=0 at ",lat,lon," (",& v_lat(1,npt), v_lat(2,npt), v_lon(1,npt), v_lon(2,npt),") so grid metric is unmodified." else - write(*,'(A,2F8.2,A,4F8.2,A5,F9.2,A1)') "read_face_lengths_list : Modifying dx_Cv gridpoint at ",lat,lon," (",& + write(*,'(A,2F8.2,A,4F8.2,A5,F9.2,A1)') & + "read_face_lengths_list : Modifying dx_Cv gridpoint at ",lat,lon," (",& v_lat(1,npt), v_lat(2,npt), v_lon(1,npt), v_lon(2,npt),") to ",G%dx_Cv(I,j),"m" endif endif @@ -965,11 +973,12 @@ end subroutine reset_face_lengths_list ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- +!> This subroutine reads and counts the non-blank lines in the face length list file, after removing comments. subroutine read_face_length_list(iounit, filename, num_lines, lines) - integer, intent(in) :: iounit - character(len=*), intent(in) :: filename - integer, intent(out) :: num_lines - character(len=120), dimension(:), pointer :: lines + integer, intent(in) :: iounit !< An open I/O unit number for the file + character(len=*), intent(in) :: filename !< The name of the face-length file to read + integer, intent(out) :: num_lines !< The number of non-blank lines in the file + character(len=120), dimension(:), pointer :: lines !< The non-blank lines, after removing comments ! This subroutine reads and counts the non-blank lines in the face length ! list file, after removing comments. From c36fa494e8d932a578d4520e01727e65d0d9d6cd Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 4 May 2018 13:27:09 -0400 Subject: [PATCH 0185/1072] Shortened excesively long lines Split lines exceeding 120 characters in 55 source files to promote readability and compliance with MOM6 code standards. All answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 2 +- config_src/coupled_driver/ocean_model_MOM.F90 | 2 +- config_src/solo_driver/coupler_types.F90 | 87 ++++--- src/ALE/MOM_ALE.F90 | 52 ++-- src/ALE/MOM_remapping.F90 | 43 ++-- src/ALE/coord_adapt.F90 | 17 +- src/ALE/coord_zlike.F90 | 6 +- src/core/MOM_PressureForce_Montgomery.F90 | 20 +- src/core/MOM_barotropic.F90 | 12 +- src/core/MOM_checksum_packages.F90 | 2 +- src/core/MOM_continuity_PPM.F90 | 4 +- src/core/MOM_dynamics_split_RK2.F90 | 172 ++++++++------ src/core/MOM_forcing_type.F90 | 223 +++++++++--------- src/core/MOM_grid.F90 | 9 +- src/core/MOM_isopycnal_slopes.F90 | 32 +-- src/core/MOM_open_boundary.F90 | 69 +++--- src/core/MOM_variables.F90 | 3 +- src/diagnostics/MOM_diagnostics.F90 | 13 +- src/diagnostics/MOM_sum_output.F90 | 28 +-- src/diagnostics/MOM_wave_speed.F90 | 62 ++--- src/equation_of_state/MOM_EOS.F90 | 74 +++--- src/equation_of_state/MOM_EOS_TEOS10.F90 | 8 +- src/framework/MOM_checksums.F90 | 33 ++- src/framework/MOM_diag_manager_wrapper.F90 | 27 ++- src/framework/MOM_diag_mediator.F90 | 218 ++++++++++------- src/framework/MOM_document.F90 | 2 +- src/framework/MOM_io.F90 | 31 +-- src/ice_shelf/MOM_ice_shelf.F90 | 175 ++++++++------ src/ice_shelf/shelf_triangular_FEstuff.F90 | 16 +- .../MOM_state_initialization.F90 | 108 ++++----- src/ocean_data_assim/MOM_oda_driver.F90 | 18 +- src/parameterizations/lateral/MOM_MEKE.F90 | 8 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 14 +- .../lateral/MOM_mixed_layer_restrat.F90 | 18 +- .../lateral/MOM_thickness_diffuse.F90 | 54 +++-- .../vertical/MOM_ALE_sponge.F90 | 80 ++++--- src/parameterizations/vertical/MOM_KPP.F90 | 76 +++--- .../vertical/MOM_diabatic_aux.F90 | 12 +- .../vertical/MOM_diabatic_driver.F90 | 107 +++++---- .../vertical/MOM_diapyc_energy_req.F90 | 6 +- .../vertical/MOM_tidal_mixing.F90 | 10 +- src/tracer/ISOMIP_tracer.F90 | 23 +- src/tracer/MOM_generic_tracer.F90 | 61 ++--- src/tracer/MOM_neutral_diffusion.F90 | 109 +++++---- src/tracer/MOM_neutral_diffusion_aux.F90 | 10 +- src/tracer/MOM_tracer_diabatic.F90 | 53 +++-- src/tracer/MOM_tracer_registry.F90 | 23 +- src/tracer/boundary_impulse_tracer.F90 | 36 +-- src/user/BFB_initialization.F90 | 16 +- src/user/ISOMIP_initialization.F90 | 4 +- src/user/MOM_wave_interface.F90 | 32 +-- src/user/Neverland_initialization.F90 | 18 +- src/user/dumbbell_initialization.F90 | 5 +- src/user/dumbbell_surface_forcing.F90 | 16 +- src/user/seamount_initialization.F90 | 5 +- 55 files changed, 1369 insertions(+), 995 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 00ef5ae2be..ce699b1397 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -632,7 +632,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) 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%initialized = .true. endif diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 1f5cc53989..af4dddbadb 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -585,7 +585,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & Waves=OS%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, & reset_therm=Ocn_fluxes_used) !### What to do with these? , start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) - + 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 diff --git a/config_src/solo_driver/coupler_types.F90 b/config_src/solo_driver/coupler_types.F90 index 0de045fa02..ba4ce0d3fa 100644 --- a/config_src/solo_driver/coupler_types.F90 +++ b/config_src/solo_driver/coupler_types.F90 @@ -68,7 +68,8 @@ module coupler_types_mod type, public :: coupler_3d_bc_type integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_3d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary condition fields + type(coupler_3d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary + !! condition fields logical :: set = .false. !< If true, this type has been initialized integer :: isd, isc, iec, ied !< The i-direction data and computational domain index ranges for this type integer :: jsd, jsc, jec, jed !< The j-direction data and computational domain index ranges for this type @@ -115,7 +116,8 @@ module coupler_types_mod type, public :: coupler_2d_bc_type integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_2d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary condition fields + type(coupler_2d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary + !! condition fields logical :: set = .false. !< If true, this type has been initialized integer :: isd, isc, iec, ied !< The i-direction data and computational domain index ranges for this type integer :: jsd, jsc, jec, jed !< The j-direction data and computational domain index ranges for this type @@ -156,7 +158,8 @@ module coupler_types_mod type, public :: coupler_1d_bc_type integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_1d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary condition fields + type(coupler_1d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary + !! condition fields logical :: set = .false. !< If true, this type has been initialized end type coupler_1d_bc_type @@ -291,7 +294,8 @@ subroutine coupler_type_copy_1d_2d(var_in, var_out, is, ie, js, je, & integer, intent(in) :: ie !< upper bound of first dimension integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then + !! don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique @@ -340,7 +344,8 @@ subroutine coupler_type_copy_1d_3d(var_in, var_out, is, ie, js, je, kd, & integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then + !! don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique @@ -383,7 +388,8 @@ subroutine coupler_type_copy_2d_2d(var_in, var_out, is, ie, js, je, & integer, intent(in) :: ie !< upper bound of first dimension integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique @@ -432,7 +438,8 @@ subroutine coupler_type_copy_2d_3d(var_in, var_out, is, ie, js, je, kd, & integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique @@ -475,7 +482,8 @@ subroutine coupler_type_copy_3d_2d(var_in, var_out, is, ie, js, je, & integer, intent(in) :: ie !< upper bound of first dimension integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique @@ -524,7 +532,8 @@ subroutine coupler_type_copy_3d_3d(var_in, var_out, is, ie, js, je, kd, & integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique @@ -1174,8 +1183,10 @@ subroutine CT_copy_data_2d(var_in, var, halo_size, bc_index, field_index, & !! that is being copied integer, optional, intent(in) :: field_index !< The index of the field in the !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this copy. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this copy. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this copy. logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose !! value of pass_through ice matches this logical :: copy_bc @@ -1249,8 +1260,10 @@ subroutine CT_copy_data_3d(var_in, var, halo_size, bc_index, field_index, & !! that is being copied integer, optional, intent(in) :: field_index !< The index of the field in the !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this copy. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this copy. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this copy. logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose !! value of pass_through ice matches this logical :: copy_bc @@ -1329,8 +1342,10 @@ subroutine CT_copy_data_2d_3d(var_in, var, halo_size, bc_index, field_index, & !! that is being copied integer, optional, intent(in) :: field_index !< The index of the field in the !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this copy. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this copy. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this copy. logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose !! value of pass_through ice matches this integer, optional, intent(in) :: ind3_start !< The starting value of the 3rd @@ -1563,8 +1578,10 @@ subroutine CT_rescale_data_2d(var, scale, halo_size, bc_index, field_index, & !! that is being copied integer, optional, intent(in) :: field_index !< The index of the field in the !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this copy. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this copy. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this copy. logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose !! value of pass_through ice matches this logical :: do_bc @@ -1640,8 +1657,10 @@ subroutine CT_rescale_data_3d(var, scale, halo_size, bc_index, field_index, & !! that is being copied integer, optional, intent(in) :: field_index !< The index of the field in the !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this copy. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this copy. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this copy. logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose !! value of pass_through ice matches this logical :: do_bc @@ -1718,8 +1737,10 @@ subroutine CT_increment_data_2d_2d(var_in, var, halo_size, bc_index, field_index !! boundary condition that is being copied real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this increment. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this increment. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this increment. logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose !! value of pass_through ice matches this @@ -1802,8 +1823,10 @@ subroutine CT_increment_data_3d_3d(var_in, var, halo_size, bc_index, field_index !! boundary condition that is being copied real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this increment. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this increment. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this increment. logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose !! value of pass_through ice matches this @@ -1893,8 +1916,10 @@ subroutine CT_increment_data_2d_3d(var_in, weights, var, halo_size, bc_index, fi !! boundary condition that is being copied real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this increment. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this increment. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this increment. logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose !! value of pass_through ice matches this @@ -1946,7 +1971,8 @@ subroutine CT_increment_data_2d_3d(var_in, weights, var, halo_size, bc_index, fi elseif ((1+var_in%ied-var_in%isd) == size(weights,1)) then iow = 1 + (var_in%isc - var_in%isd) - var%isc else - call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the i-size of a computational or data domain.") + call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the i-size "//& + "of a computational or data domain.") endif if ((1+var%jec-var%jsc) == size(weights,2)) then jow = 1 - var%jsc @@ -1955,7 +1981,8 @@ subroutine CT_increment_data_2d_3d(var_in, weights, var, halo_size, bc_index, fi elseif ((1+var_in%jed-var_in%jsd) == size(weights,2)) then jow = 1 + (var_in%jsc - var_in%jsd) - var%jsc else - call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the j-size of a computational or data domain.") + call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the j-size "//& + "of a computational or data domain.") endif io1 = var_in%isc - var%isc ; jo1 = var_in%jsc - var%jsc ; kow = 1 - var_in%ks @@ -2720,7 +2747,8 @@ end subroutine CT_set_data_3d !> This routine registers the diagnostics of a coupler_2d_bc_type. subroutine CT_set_diags_2d(var, diag_name, axes, time) type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure for which to register diagnostics - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field @@ -2746,7 +2774,8 @@ end subroutine CT_set_diags_2d !> This routine registers the diagnostics of a coupler_3d_bc_type. subroutine CT_set_diags_3d(var, diag_name, axes, time) type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure for which to register diagnostics - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 34ad978cd2..c39dbec562 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -295,7 +295,8 @@ end subroutine ALE_end subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt, frac_shelf_h) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after last time step (m or Pa) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the + !! last time step (m or Pa) real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity field (m/s) real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< Meridional velocity field (m/s) type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure @@ -381,7 +382,8 @@ end subroutine ALE_main subroutine ALE_main_offline( G, GV, h, tv, Reg, CS, dt) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after last time step (m or Pa) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the + !! last time step (m or Pa) type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure type(tracer_registry_type), pointer :: Reg !< Tracer registry structure type(ALE_CS), pointer :: CS !< Regridding parameters and options @@ -514,7 +516,7 @@ end subroutine ALE_offline_inputs subroutine ALE_offline_tracer_final( G, GV, h, tv, h_target, Reg, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the !! last time step (m or Pa) type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h_target !< Current 3D grid obtained after @@ -556,9 +558,10 @@ end subroutine ALE_offline_tracer_final !> Check grid for negative thicknesses subroutine check_grid( G, GV, h, threshold ) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Current 3D grid obtained after the last time step (H units) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Current 3D grid obtained after the + !! last time step (H units) real, intent(in) :: threshold !< Value below which to flag issues (H units) ! Local variables integer :: i, j @@ -586,7 +589,8 @@ subroutine ALE_build_grid( G, GV, regridCS, remapCS, h, tv, debug, frac_shelf_h type(regridding_CS), intent(in) :: regridCS !< Regridding parameters and options type(remapping_CS), intent(in) :: remapCS !< Remapping parameters and options type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamical variable structure - real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the last time step (m or Pa) + real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the + !! last time step (m or Pa) logical, optional, intent(in) :: debug !< If true, show the call tree real, dimension(:,:), optional, pointer :: frac_shelf_h !< Fractional ice shelf coverage ! Local variables @@ -640,7 +644,8 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n, u, v, Reg, dt, dzRegrid, real, optional, intent(in) :: dt !< Model timestep to provide a timescale for regridding real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(inout) :: dzRegrid !< Final change in interface positions - logical, optional, intent(in) :: initial !< Whether we're being called from an initialization routine (and expect diagnostics to work) + logical, optional, intent(in) :: initial !< Whether we're being called from an initialization + !! routine (and expect diagnostics to work) ! Local variables integer :: i, j, k, nz @@ -707,18 +712,21 @@ end subroutine ALE_regrid_accelerated !! remap initiali conditions to the model grid. It is also called during a !! time step to update the state. subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, dxInterface, u, v, debug, dt) - type(remapping_CS), intent(in) :: CS_remapping !< Remapping control structure - type(ALE_CS), intent(in) :: CS_ALE !< ALE control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Thickness of source grid (m or Pa) - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Thickness of destination grid (m or Pa) - type(tracer_registry_type), pointer :: Reg !< Tracer registry structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1),optional, intent(in) :: dxInterface !< Change in interface position (Hm or Pa) - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), optional, intent(inout) :: u !< Zonal velocity component (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), optional, intent(inout) :: v !< Meridional velocity component (m/s) - logical, optional, intent(in) :: debug !< If true, show the call tree - real, optional, intent(in) :: dt !< time step for diagnostics + type(remapping_CS), intent(in) :: CS_remapping !< Remapping control structure + type(ALE_CS), intent(in) :: CS_ALE !< ALE control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Thickness of source grid (m or Pa) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Thickness of destination grid (m or Pa) + type(tracer_registry_type), pointer :: Reg !< Tracer registry structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & + optional, intent(in) :: dxInterface !< Change in interface position (Hm or Pa) + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + optional, intent(inout) :: u !< Zonal velocity component (m/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + optional, intent(inout) :: v !< Meridional velocity component (m/s) + logical, optional, intent(in) :: debug !< If true, show the call tree + real, optional, intent(in) :: dt !< time step for diagnostics ! Local variables integer :: i, j, k, m integer :: nz, ntr @@ -740,8 +748,8 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, ! If remap_uv_using_old_alg is .true. and u or v is requested, then we must have dxInterface. Otherwise, ! u and v can be remapped without dxInterface if ( .not. present(dxInterface) .and. (CS_ALE%remap_uv_using_old_alg .and. (present(u) .or. present(v))) ) then - call MOM_error(FATAL, "remap_all_state_vars: dxInterface must be present if using old algorithm and u/v are to"// & - "be remapped") + call MOM_error(FATAL, "remap_all_state_vars: dxInterface must be present if using old algorithm "// & + "and u/v are to be remapped") endif !### Try replacing both of these with GV%H_subroundoff diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index a7879ae063..dee2e20bd8 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -224,9 +224,11 @@ subroutine remapping_core_h(CS, n0, h0, u0, n1, h1, u1, h_neglect, h_neglect_ed .or. (u1minu0max) ) then write(0,*) 'iMethod = ',iMethod write(0,*) 'H: h0tot=',h0tot,'h1tot=',h1tot,'dh=',h1tot-h0tot,'h0err=',h0err,'h1err=',h1err - if (abs(h1tot-h0tot)>h0err+h1err) write(0,*) 'H non-conservation difference=',h1tot-h0tot,'allowed err=',h0err+h1err,' <-----!' + if (abs(h1tot-h0tot)>h0err+h1err) & + write(0,*) 'H non-conservation difference=',h1tot-h0tot,'allowed err=',h0err+h1err,' <-----!' write(0,*) 'UH: u0tot=',u0tot,'u1tot=',u1tot,'duh=',u1tot-u0tot,'u0err=',u0err,'u1err=',u1err,'uh_err=',uh_err - if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' + if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) & + write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' write(0,*) 'U: u0min=',u0min,'u1min=',u1min if (u1minh0err+h1err) & + write(0,*) 'H non-conservation difference=',h1tot-h0tot,'allowed err=',h0err+h1err,' <-----!' write(0,*) 'UH: u0tot=',u0tot,'u1tot=',u1tot,'duh=',u1tot-u0tot,'u0err=',u0err,'u1err=',u1err,'uh_err=',uh_err - if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' + if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) & + write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' write(0,*) 'U: u0min=',u0min,'u1min=',u1min if (u1minh0err+h2err) & + write(0,*) 'H non-conservation difference=',h2tot-h0tot,'allowed err=',h0err+h2err,' <-----!' + write(0,*) 'UH: u0tot=',u0tot,'u2tot=',u2tot,'duh=',u2tot-u0tot,'u0err=',u0err,'u2err=',u2err,& + 'adjustment err=',u02_err + if (abs(u2tot-u0tot)>u0err+u2err) & + write(0,*) 'U non-conservation difference=',u2tot-u0tot,'allowed err=',u0err+u2err,' <-----!' write(0,*) 'Sub-cells to target:' write(0,*) 'H: h2tot=',h2tot,'h1tot=',h1tot,'dh=',h1tot-h2tot,'h2err=',h2err,'h1err=',h1err - if (abs(h1tot-h2tot)>h2err+h1err) write(0,*) 'H non-conservation difference=',h1tot-h2tot,'allowed err=',h2err+h1err,' <-----!' + if (abs(h1tot-h2tot)>h2err+h1err) & + write(0,*) 'H non-conservation difference=',h1tot-h2tot,'allowed err=',h2err+h1err,' <-----!' write(0,*) 'UH: u2tot=',u2tot,'u1tot=',u1tot,'duh=',u1tot-u2tot,'u2err=',u2err,'u1err=',u1err,'uh_err=',uh_err - if (abs(u1tot-u2tot)>u2err+u1err) write(0,*) 'U non-conservation difference=',u1tot-u2tot,'allowed err=',u2err+u1err,' <-----!' + if (abs(u1tot-u2tot)>u2err+u1err) & + write(0,*) 'U non-conservation difference=',u1tot-u2tot,'allowed err=',u2err+u1err,' <-----!' write(0,*) 'Source to target:' write(0,*) 'H: h0tot=',h0tot,'h1tot=',h1tot,'dh=',h1tot-h0tot,'h0err=',h0err,'h1err=',h1err - if (abs(h1tot-h0tot)>h0err+h1err) write(0,*) 'H non-conservation difference=',h1tot-h0tot,'allowed err=',h0err+h1err,' <-----!' + if (abs(h1tot-h0tot)>h0err+h1err) & + write(0,*) 'H non-conservation difference=',h1tot-h0tot,'allowed err=',h0err+h1err,' <-----!' write(0,*) 'UH: u0tot=',u0tot,'u1tot=',u1tot,'duh=',u1tot-u0tot,'u0err=',u0err,'u1err=',u1err,'uh_err=',uh_err - if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' + if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) & + write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' write(0,*) 'U: u0min=',u0min,'u1min=',u1min,'u2min=',u2min if (u1min Clean up the coordinate control structure subroutine end_coord_adapt(CS) - type(adapt_CS), pointer :: CS + type(adapt_CS), pointer :: CS !< The control structure for this module ! nothing to do if (.not. associated(CS)) return @@ -74,7 +74,7 @@ end subroutine end_coord_adapt subroutine set_adapt_params(CS, adaptTimeRatio, adaptAlpha, adaptZoom, adaptZoomCoeff, & adaptBuoyCoeff, adaptDrho0, adaptDoMin) - type(adapt_CS), pointer :: CS + type(adapt_CS), pointer :: CS !< The control structure for this module real, optional, intent(in) :: adaptTimeRatio, adaptAlpha, adaptZoom, adaptZoomCoeff real, optional, intent(in) :: adaptBuoyCoeff, adaptDrho0 logical, optional, intent(in) :: adaptDoMin @@ -91,14 +91,17 @@ subroutine set_adapt_params(CS, adaptTimeRatio, adaptAlpha, adaptZoom, adaptZoom end subroutine set_adapt_params subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) - type(adapt_CS), intent(in) :: CS + type(adapt_CS), intent(in) :: CS !< The control structure for this module type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - integer, intent(in) :: i, j - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: zInt, tInt, sInt + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables + integer, intent(in) :: i, j !< The indices of the column to work on + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: zInt !< Interface heights, in H (m or kg m-2). + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: tInt !< Interface temperatures, in C + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: sInt !< Interface salinities, in psu real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZK_(GV)+1), intent(inout) :: zNext ! updated interface positions + real, dimension(SZK_(GV)+1), intent(inout) :: zNext !< updated interface positions ! Local variables integer :: k, nz diff --git a/src/ALE/coord_zlike.F90 b/src/ALE/coord_zlike.F90 index ca68aa7b0b..41fb61f6c3 100644 --- a/src/ALE/coord_zlike.F90 +++ b/src/ALE/coord_zlike.F90 @@ -66,8 +66,10 @@ subroutine build_zstar_column(CS, depth, total_thickness, zInterface, & real, intent(in) :: depth !< Depth of ocean bottom (positive in m or H) real, intent(in) :: total_thickness !< Column thickness (positive in the same units as depth) real, dimension(CS%nk+1), intent(inout) :: zInterface !< Absolute positions of interfaces - real, optional, intent(in) :: z_rigid_top !< The height of a rigid top (negative in the same units as depth) - real, optional, intent(in) :: eta_orig !< The actual original height of the top in the same units as depth + real, optional, intent(in) :: z_rigid_top !< The height of a rigid top (negative in the + !! same units as depth) + real, optional, intent(in) :: eta_orig !< The actual original height of the top in the + !! same units as depth real, optional, intent(in) :: zScale !< Scaling factor from the target coordinate resolution !! in m to desired units for zInterface, perhaps m_to_H ! Local variables diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index a343bca4d1..a30f8e9974 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -618,19 +618,21 @@ end subroutine PressureForce_Mont_Bouss !> Determines the partial derivative of the acceleration due !! to pressure forces with the free surface height. subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height, in H. - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, intent(in) :: g_Earth !< The gravitational acceleration, in m s-2. real, intent(in) :: Rho0 !< The "Boussinesq" ocean density, in kg m-3. real, intent(in) :: GFS_scale !< Ratio between gravity applied to top interface - !! and the gravitational acceleration of the planet. - !! Usually this ratio is 1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: pbce !< The baroclinic pressure anomaly in each layer due - !! to free surface height anomalies, in m2 H-1 s-2. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: rho_star !< The layer densities (maybe - !! compressibility compensated), times g/rho_0, in m s-2. + !! and the gravitational acceleration of the planet. + !! Usually this ratio is 1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(out) :: pbce !< The baroclinic pressure anomaly in each layer due + !! to free surface height anomalies, in m2 H-1 s-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + optional, intent(in) :: rho_star !< The layer densities (maybe compressibility + !! compensated), times g/rho_0, in m s-2. ! Local variables real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer ! thicknesses, in m-1. diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 49d786191d..63f271089e 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -2427,8 +2427,10 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, !! in determining the transport. logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate !! transports. - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points, in H m. - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points, in H m. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points, + !! in H m. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points, + !! in H m. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used !! for a dynamic estimate of the face areas at !! u-points. @@ -2697,8 +2699,10 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co integer, intent(in) :: halo !< The extra halo size to use here. logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate !! transports. - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points, in H m. - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points, in H m. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points, + !! in H m. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points, + !! in H m. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used !! for a dynamic estimate of the face areas at !! u-points. diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index e7f84ed944..c47b16989e 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -200,7 +200,7 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, pbce, real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: pbce !< The baroclinic pressure anomaly in each layer !! due to free surface height anomalies, in - !! m2 s-2 H-1. !! NULL. + !! m2 s-2 H-1. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: u_accel_bt !< The zonal acceleration from terms in the !! barotropic solver,in m s-2. diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 9ea47bd37b..c430179917 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -99,13 +99,13 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, optional, pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: visc_rem_u !< The fraction of zonal momentum originally - !! in a layer that remains after a time-step of viscosity, and the + !! in a layer that remains after a time-step of viscosity, and the !! fraction of a time-step's worth of a barotropic acceleration that !! a layer experiences after viscosity is applied. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(in) :: visc_rem_v !< The fraction of meridional momentum originally - !! in a layer that remains after a time-step of viscosity, and the + !! in a layer that remains after a time-step of viscosity, and the !! fraction of a time-step's worth of a barotropic acceleration that !! a layer experiences after viscosity is applied. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 6735e35063..9688ca2dcc 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -93,27 +93,34 @@ module MOM_dynamics_split_RK2 !! that were fed into the barotopic calculation, in m s-2. ! The following variables are only used with the split time stepping scheme. - real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta !< Instantaneous free surface height (in Boussinesq mode) - !! or column mass anomaly (in non-Boussinesq mode), - !! in units of H (m or kg m-2) - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_av !< layer x-velocity with vertical mean replaced by - !! time-mean barotropic velocity over a baroclinic timestep (m s-1) - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_av !< layer y-velocity with vertical mean replaced by - !! time-mean barotropic velocity over a baroclinic timestep (m s-1) - real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: h_av !< arithmetic mean of two successive layer thicknesses (m or kg m-2) - real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_PF !< instantaneous SSH used in calculating PFu and PFv (meter) - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt !< average x-volume or mass flux determined by barotropic solver - !! (m3 s-1 or kg s-1). uhbt should (roughly?) equal to vertical sum of uh. - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt !< average y-volume or mass flux determined by barotropic solver - !! (m3 s-1 or kg s-1). vhbt should (roughly?) equal to vertical sum of vh. - real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: pbce !< pbce times eta gives the baroclinic pressure anomaly in each layer due - !! to free surface height anomalies. pbce has units of m2 H-1 s-2. - - real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor (Pa) - real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor (Pa) - type(BT_cont_type), pointer :: BT_cont => NULL() !< A structure with elements that describe the - !! effective summed open face areas as a function - !! of barotropic flow. + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta !< Instantaneous free surface height (in Boussinesq + !! mode) or column mass anomaly (in non-Boussinesq + !! mode), in units of H (m or kg m-2) + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_av !< layer x-velocity with vertical mean replaced by + !! time-mean barotropic velocity over a baroclinic + !! timestep (m s-1) + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_av !< layer y-velocity with vertical mean replaced by + !! time-mean barotropic velocity over a baroclinic + !! timestep (m s-1) + real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: h_av !< arithmetic mean of two successive layer + !! thicknesses (m or kg m-2) + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_PF !< instantaneous SSH used in calculating PFu and + !! PFv (meter) + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt !< average x-volume or mass flux determined by the + !! barotropic solver (m3 s-1 or kg s-1). uhbt should + !! be (roughly?) equal to vertical sum of uh. + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt !< average y-volume or mass flux determined by the + !! barotropic solver (m3 s-1 or kg s-1). vhbt should + !! be (roughly?) equal to vertical sum of vh. + real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: pbce !< pbce times eta gives the baroclinic pressure + !! anomaly in each layer due to free surface height + !! anomalies. pbce has units of m2 H-1 s-2. + + real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor (Pa) + real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor (Pa) + type(BT_cont_type), pointer :: BT_cont => NULL() !< A structure with elements that describe the + !! effective summed open face areas as a function + !! of barotropic flow. ! This is to allow the previous, velocity-based coupling with between the ! baroclinic and barotropic modes. @@ -205,27 +212,39 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & Time_local, dt, forces, p_surf_begin, p_surf_end, & uh, vh, uhtr, vhtr, eta_av, & G, GV, CS, calc_dtbt, VarMix, MEKE) - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(inout) :: u !< zonal velocity (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(inout) :: v !< merid velocity (m/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< layer thickness (m or kg/m2) - type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic type - type(vertvisc_type), intent(inout) :: visc !< vertical visc, bottom drag, and related - type(time_type), intent(in) :: Time_local !< model time at end of time step - real, intent(in) :: dt !< time step (sec) - type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, dimension(:,:), pointer :: p_surf_begin !< surf pressure at start of this dynamic time step (Pa) - real, dimension(:,:), pointer :: p_surf_end !< surf pressure at end of this dynamic time step (Pa) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(inout) :: uh !< zonal volume/mass transport (m3/s or kg/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(inout) :: vh !< merid volume/mass transport (m3/s or kg/s) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< accumulatated zonal volume/mass transport since last tracer advection (m3 or kg) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< accumulatated merid volume/mass transport since last tracer advection (m3 or kg) - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< free surface height or column mass time averaged over time step (m or kg/m2) - type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure - logical, intent(in) :: calc_dtbt !< if true, recalculate barotropic time step - type(VarMix_CS), pointer :: VarMix !< specify the spatially varying viscosities - type(MEKE_type), pointer :: MEKE !< related to mesoscale eddy kinetic energy param + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + target, intent(inout) :: u !< zonal velocity (m/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + target, intent(inout) :: v !< merid velocity (m/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: h !< layer thickness (m or kg/m2) + type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic type + type(vertvisc_type), intent(inout) :: visc !< vertical visc, bottom drag, and related + type(time_type), intent(in) :: Time_local !< model time at end of time step + real, intent(in) :: dt !< time step (sec) + type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces + real, dimension(:,:), pointer :: p_surf_begin !< surf pressure at start of this dynamic + !! time step (Pa) + real, dimension(:,:), pointer :: p_surf_end !< surf pressure at end of this dynamic + !! time step (Pa) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + target, intent(inout) :: uh !< zonal volume/mass transport (m3/s or kg/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + target, intent(inout) :: vh !< merid volume/mass transport (m3/s or kg/s) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: uhtr !< accumulatated zonal volume/mass transport + !! since last tracer advection (m3 or kg) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(inout) :: vhtr !< accumulatated merid volume/mass transport + !! since last tracer advection (m3 or kg) + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< free surface height or column mass time + !! averaged over time step (m or kg/m2) + type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure + logical, intent(in) :: calc_dtbt !< if true, recalculate barotropic time step + type(VarMix_CS), pointer :: VarMix !< specify the spatially varying viscosities + type(MEKE_type), pointer :: MEKE !< related to mesoscale eddy kinetic energy param real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping. @@ -842,8 +861,10 @@ subroutine register_restarts_dyn_split_RK2(HI, GV, param_file, CS, restart_CS, u type(param_file_type), intent(in) :: param_file !< parameter file type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure type(MOM_restart_CS), pointer :: restart_CS !< restart control structure - real, dimension(SZIB_(HI),SZJ_(HI),SZK_(GV)), target, intent(inout) :: uh !< zonal volume/mass transport (m3/s or kg/s) - real, dimension(SZI_(HI),SZJB_(HI),SZK_(GV)), target, intent(inout) :: vh !< merid volume/mass transport (m3/s or kg/s) + real, dimension(SZIB_(HI),SZJ_(HI),SZK_(GV)), & + target, intent(inout) :: uh !< zonal volume/mass transport (m3/s or kg/s) + real, dimension(SZI_(HI),SZJB_(HI),SZK_(GV)), & + target, intent(inout) :: vh !< merid volume/mass transport (m3/s or kg/s) type(vardesc) :: vd character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. @@ -915,34 +936,41 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil diag, CS, restart_CS, dt, Accel_diag, Cont_diag, MIS, & VarMix, MEKE, OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & visc, dirs, ntrunc, calc_dtbt) - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< merid velocity (m/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness (m or kg/m2) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(inout) :: uh !< zonal volume/mass transport (m3 s-1 or kg s-1) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(inout) :: vh !< merid volume/mass transport (m3 s-1 or kg s-1) - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: eta !< free surface height or column mass (m or kg m-2) - type(time_type), target, intent(in) :: Time !< current model time - type(param_file_type), intent(in) :: param_file !< parameter file for parsing - type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics - type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure - type(MOM_restart_CS), pointer :: restart_CS !< restart control structure - real, intent(in) :: dt !< time step (sec) - type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< points to momentum equation terms for budget analysis - type(cont_diag_ptrs), target, intent(inout) :: Cont_diag !< points to terms in continuity equation - type(ocean_internal_state), intent(inout) :: MIS !< "MOM6 internal state" used to pass diagnostic pointers - type(VarMix_CS), pointer :: VarMix !< points to spatially variable viscosities - type(MEKE_type), pointer :: MEKE !< points to mesoscale eddy kinetic energy fields - type(ocean_OBC_type), pointer :: OBC !< points to OBC related fields - type(update_OBC_CS), pointer :: update_OBC_CSp !< points to OBC update related fields - type(ALE_CS), pointer :: ALE_CSp !< points to ALE control structure - type(set_visc_CS), pointer :: setVisc_CSp !< points to the set_visc control structure. - type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, bottom drag, and related - type(directories), intent(in) :: dirs !< contains directory paths - integer, target, intent(inout) :: ntrunc !< A target for the variable that records the number of times - !! the velocity is truncated (this should be 0). - logical, intent(out) :: calc_dtbt !< If true, recalculate the barotropic time step + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: u !< zonal velocity (m/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(inout) :: v !< merid velocity (m/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness (m or kg/m2) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + target, intent(inout) :: uh !< zonal volume/mass transport (m3 s-1 or kg s-1) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + target, intent(inout) :: vh !< merid volume/mass transport (m3 s-1 or kg s-1) + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: eta !< free surface height or column mass (m or kg m-2) + type(time_type), target, intent(in) :: Time !< current model time + type(param_file_type), intent(in) :: param_file !< parameter file for parsing + type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics + type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure + type(MOM_restart_CS), pointer :: restart_CS !< restart control structure + real, intent(in) :: dt !< time step (sec) + type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< points to momentum equation terms for + !! budget analysis + type(cont_diag_ptrs), target, intent(inout) :: Cont_diag !< points to terms in continuity equation + type(ocean_internal_state), intent(inout) :: MIS !< "MOM6 internal state" used to pass + !! diagnostic pointers + type(VarMix_CS), pointer :: VarMix !< points to spatially variable viscosities + type(MEKE_type), pointer :: MEKE !< points to mesoscale eddy kinetic energy fields + type(ocean_OBC_type), pointer :: OBC !< points to OBC related fields + type(update_OBC_CS), pointer :: update_OBC_CSp !< points to OBC update related fields + type(ALE_CS), pointer :: ALE_CSp !< points to ALE control structure + type(set_visc_CS), pointer :: setVisc_CSp !< points to the set_visc control structure. + type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, bottom drag, and related + type(directories), intent(in) :: dirs !< contains directory paths + integer, target, intent(inout) :: ntrunc !< A target for the variable that records + !! the number of times the velocity is + !! truncated (this should be 0). + logical, intent(out) :: calc_dtbt !< If true, recalculate the barotropic time step real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_tmp character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index e092c2a5ab..6a65c7e844 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -316,67 +316,73 @@ module MOM_forcing_type !! This routine multiplies fluxes by dt, so that the result is an accumulation of fluxes !! over a time step. subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & - DepthBeforeScalingFluxes, useRiverHeatContent, useCalvingHeatContent, & + FluxRescaleDepth, useRiverHeatContent, useCalvingHeatContent, & h, T, netMassInOut, netMassOut, net_heat, net_salt, pen_SW_bnd, tv, & - aggregate_FW_forcing, nonpenSW, netmassInOut_rate,net_Heat_Rate, & + aggregate_FW, nonpenSW, netmassInOut_rate,net_Heat_Rate, & net_salt_rate, pen_sw_bnd_Rate, skip_diags) - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(forcing), intent(inout) :: fluxes !< structure containing pointers to possible - !! forcing fields. NULL unused fields. - type(optics_type), pointer :: optics !< pointer to optics - integer, intent(in) :: nsw !< number of bands of penetrating SW - integer, intent(in) :: j !< j-index to work on - real, intent(in) :: dt !< time step in seconds - real, intent(in) :: DepthBeforeScalingFluxes !< min ocean depth before scale away fluxes (H) - logical, intent(in) :: useRiverHeatContent !< logical for river heat content - logical, intent(in) :: useCalvingHeatContent !< logical for calving heat content + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(forcing), intent(inout) :: fluxes !< structure containing pointers to possible + !! forcing fields. NULL unused fields. + type(optics_type), pointer :: optics !< pointer to optics + integer, intent(in) :: nsw !< number of bands of penetrating SW + integer, intent(in) :: j !< j-index to work on + real, intent(in) :: dt !< time step in seconds + real, intent(in) :: FluxRescaleDepth !< min ocean depth before scale away fluxes (H) + logical, intent(in) :: useRiverHeatContent !< logical for river heat content + logical, intent(in) :: useCalvingHeatContent !< logical for calving heat content real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: h !< layer thickness (in H units) + intent(in) :: h !< layer thickness (in H units) real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: T !< layer temperatures (deg C) - real, dimension(SZI_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux - !! (if Bouss) of water in/out of ocean over - !! a time step (H units) - real, dimension(SZI_(G)), intent(out) :: netMassOut !< net mass flux (non-Bouss) or volume flux - !! (if Bouss) of water leaving ocean surface - !! over a time step (H units). - !! netMassOut < 0 means mass leaves ocean. - real, dimension(SZI_(G)), intent(out) :: net_heat !< net heat at the surface accumulated over a - !! time step for coupler + restoring. - !! Exclude two terms from net_heat: - !! (1) downwelling (penetrative) SW, - !! (2) evaporation heat content, - !! (since do not yet know evap temperature). - !! Units of net_heat are (K * H). - real, dimension(SZI_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated - !! over a time step (ppt * H) - real, dimension(:,:), intent(out) :: pen_SW_bnd !< penetrating SW flux, split into bands. - !! Units are (deg K * H) and array size - !! nsw x SZI_(G), where nsw=number of SW bands - !! in pen_SW_bnd. This heat flux is not part - !! of net_heat. - type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available - !! thermodynamic fields. Used to keep - !! track of the heat flux associated with net - !! mass fluxes into the ocean. - logical, intent(in) :: aggregate_FW_forcing !< For determining how to aggregate forcing. - real, dimension(SZI_(G)), optional, intent(out) :: nonpenSW !< non-downwelling SW; use in net_heat. - !! Sum over SW bands when diagnosing nonpenSW. - !! Units are (K * H). - real, dimension(SZI_(G)), optional, intent(out) :: net_Heat_rate !< Rate of net surface heating in H K s-1. - real, dimension(SZI_(G)), optional, intent(out) :: net_salt_rate !< Surface salt flux into the ocean in ppt H s-1. - real, dimension(SZI_(G)), optional, intent(out) :: netmassInOut_rate !< Rate of net mass flux into the ocean in H s-1. - real, dimension(:,:), optional, intent(out) :: pen_sw_bnd_rate !< Rate of penetrative shortwave heating in degC H s-1. - logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating diagnostics + intent(in) :: T !< layer temperatures (deg C) + real, dimension(SZI_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux + !! (if Bouss) of water in/out of ocean over + !! a time step (H units) + real, dimension(SZI_(G)), intent(out) :: netMassOut !< net mass flux (non-Bouss) or volume flux + !! (if Bouss) of water leaving ocean surface + !! over a time step (H units). + !! netMassOut < 0 means mass leaves ocean. + real, dimension(SZI_(G)), intent(out) :: net_heat !< net heat at the surface accumulated over a + !! time step for coupler + restoring. + !! Exclude two terms from net_heat: + !! (1) downwelling (penetrative) SW, + !! (2) evaporation heat content, + !! (since do not yet know evap temperature). + !! Units of net_heat are (K * H). + real, dimension(SZI_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated + !! over a time step (ppt * H) + real, dimension(:,:), intent(out) :: pen_SW_bnd !< penetrating SW flux, split into bands. + !! Units are (deg K * H) and array size + !! nsw x SZI_(G), where nsw=number of SW bands + !! in pen_SW_bnd. This heat flux is not part + !! of net_heat. + type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available + !! thermodynamic fields. Used to keep + !! track of the heat flux associated with net + !! mass fluxes into the ocean. + logical, intent(in) :: aggregate_FW !< For determining how to aggregate forcing. + real, dimension(SZI_(G)), & + optional, intent(out) :: nonpenSW !< non-downwelling SW; use in net_heat. + !! Sum over SW bands when diagnosing nonpenSW. + !! Units are (K * H). + real, dimension(SZI_(G)), & + optional, intent(out) :: net_Heat_rate !< Rate of net surface heating in H K s-1. + real, dimension(SZI_(G)), & + optional, intent(out) :: net_salt_rate !< Surface salt flux into the ocean in ppt H s-1. + real, dimension(SZI_(G)), & + optional, intent(out) :: netmassInOut_rate !< Rate of net mass flux into the ocean in H s-1. + real, dimension(:,:), & + optional, intent(out) :: pen_sw_bnd_rate !< Rate of penetrative shortwave heating + !! in degC H s-1. + logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating diagnostics ! local real :: htot(SZI_(G)) ! total ocean depth (m for Bouss or kg/m^2 for non-Bouss) real :: Pen_sw_tot(SZI_(G)) ! sum across all bands of Pen_SW (K * H) real :: pen_sw_tot_rate(SZI_(G)) ! Similar but sum but as a rate (no dt in calculation) real :: Ih_limit ! inverse depth at which surface fluxes start to be limited (1/H) - real :: scale ! scale scales away fluxes if depth < DepthBeforeScalingFluxes + real :: scale ! scale scales away fluxes if depth < FluxRescaleDepth real :: J_m2_to_H ! converts J/m^2 to H units (m for Bouss and kg/m^2 for non-Bouss) real :: Irho0 ! 1.0 / Rho0 real :: I_Cp ! 1.0 / C_p @@ -400,7 +406,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, if (present(pen_sw_bnd_rate)) do_PSWBR = .true. !}BGR - Ih_limit = 1.0 / DepthBeforeScalingFluxes + Ih_limit = 1.0 / FluxRescaleDepth Irho0 = 1.0 / GV%Rho0 I_Cp = 1.0 / fluxes%C_p J_m2_to_H = 1.0 / (GV%H_to_kg_m2 * fluxes%C_p) @@ -637,11 +643,12 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! Initialize heat_content_massin that is diagnosed in mixedlayer_convection or ! applyBoundaryFluxes such that the meaning is as the sum of all incoming components. if (associated(fluxes%heat_content_massin)) then - if (aggregate_FW_forcing) then + if (aggregate_FW) then if (netMassInOut(i) > 0.0) then ! net is "in" fluxes%heat_content_massin(i,j) = -fluxes%C_p * netMassOut(i) * T(i,1) * GV%H_to_kg_m2 / dt else ! net is "out" - fluxes%heat_content_massin(i,j) = fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * T(i,1) * GV%H_to_kg_m2 / dt + fluxes%heat_content_massin(i,j) = fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * & + T(i,1) * GV%H_to_kg_m2 / dt endif else fluxes%heat_content_massin(i,j) = 0. @@ -651,11 +658,12 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! Initialize heat_content_massout that is diagnosed in mixedlayer_convection or ! applyBoundaryFluxes such that the meaning is as the sum of all outgoing components. if (associated(fluxes%heat_content_massout)) then - if (aggregate_FW_forcing) then + if (aggregate_FW) then if (netMassInOut(i) > 0.0) then ! net is "in" fluxes%heat_content_massout(i,j) = fluxes%C_p * netMassOut(i) * T(i,1) * GV%H_to_kg_m2 / dt else ! net is "out" - fluxes%heat_content_massout(i,j) = -fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * T(i,1) * GV%H_to_kg_m2 / dt + fluxes%heat_content_massout(i,j) = -fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * & + T(i,1) * GV%H_to_kg_m2 / dt endif else fluxes%heat_content_massout(i,j) = 0.0 @@ -737,58 +745,59 @@ end subroutine extractFluxes1d !> 2d wrapper for 1d extract fluxes from surface fluxes type. !! This subroutine extracts fluxes from the surface fluxes type. It multiplies the !! fluxes by dt, so that the result is an accumulation of the fluxes over a time step. -subroutine extractFluxes2d(G, GV, fluxes, optics, nsw, dt, & - DepthBeforeScalingFluxes, useRiverHeatContent, useCalvingHeatContent, & - h, T, netMassInOut, netMassOut, net_heat, Net_salt, Pen_SW_bnd, tv, & - aggregate_FW_forcing) - - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(forcing), intent(inout) :: fluxes !< structure containing pointers to forcing. - type(optics_type), pointer :: optics !< pointer to optics - integer, intent(in) :: nsw !< number of bands of penetrating SW - real, intent(in) :: dt !< time step in seconds - real, intent(in) :: DepthBeforeScalingFluxes !< min ocean depth before scale away fluxes (H) - logical, intent(in) :: useRiverHeatContent !< logical for river heat content - logical, intent(in) :: useCalvingHeatContent !< logical for calving heat content - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness (in H units) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T !< layer temperatures (deg C) - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux - !! (if Bouss) of water in/out of ocean over - !! a time step (H units) - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassOut !< net mass flux (non-Bouss) or volume flux - !! (if Bouss) of water leaving ocean surface - !! over a time step (H units). - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_heat !< net heat at the surface accumulated over a - !! time step associated with coupler + restore. - !! Exclude two terms from net_heat: - !! (1) downwelling (penetrative) SW, - !! (2) evaporation heat content, - !! (since do not yet know temperature of evap). - !! Units of net_heat are (K * H). - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated - !! over a time step (ppt * H) - real, dimension(:,:,:), intent(out) :: pen_SW_bnd !< penetrating shortwave flux, split into bands. - !! Units (deg K * H) & array size nsw x SZI_(G), - !! where nsw=number of SW bands in pen_SW_bnd. - !! This heat flux is not in net_heat. - type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available - !! thermodynamic fields. Here it is used to keep - !! track of the heat flux associated with net - !! mass fluxes into the ocean. - logical, intent(in) :: aggregate_FW_forcing !< For determining how to aggregate the forcing. - +subroutine extractFluxes2d(G, GV, fluxes, optics, nsw, dt, FluxRescaleDepth, & + useRiverHeatContent, useCalvingHeatContent, h, T, & + netMassInOut, netMassOut, net_heat, Net_salt, Pen_SW_bnd, tv, & + aggregate_FW) + + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(forcing), intent(inout) :: fluxes !< structure containing pointers to forcing. + type(optics_type), pointer :: optics !< pointer to optics + integer, intent(in) :: nsw !< number of bands of penetrating SW + real, intent(in) :: dt !< time step in seconds + real, intent(in) :: FluxRescaleDepth !< min ocean depth before scale away fluxes (H) + logical, intent(in) :: useRiverHeatContent !< logical for river heat content + logical, intent(in) :: useCalvingHeatContent !< logical for calving heat content + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< layer thickness (in H units) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: T !< layer temperatures (deg C) + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux + !! (if Bouss) of water in/out of ocean over + !! a time step (H units) + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassOut !< net mass flux (non-Bouss) or volume flux + !! (if Bouss) of water leaving ocean surface + !! over a time step (H units). + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_heat !< net heat at the surface accumulated over a + !! time step associated with coupler + restore. + !! Exclude two terms from net_heat: + !! (1) downwelling (penetrative) SW, + !! (2) evaporation heat content, + !! (since do not yet know temperature of evap). + !! Units of net_heat are (K * H). + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated + !! over a time step (ppt * H) + real, dimension(:,:,:), intent(out) :: pen_SW_bnd !< penetrating shortwave flux, split into bands. + !! Units (deg K * H) & array size nsw x SZI_(G), + !! where nsw=number of SW bands in pen_SW_bnd. + !! This heat flux is not in net_heat. + type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available + !! thermodynamic fields. Here it is used to keep + !! track of the heat flux associated with net + !! mass fluxes into the ocean. + logical, intent(in) :: aggregate_FW !< For determining how to aggregate the forcing. integer :: j -!$OMP parallel do default(none) shared(G, GV, fluxes, optics, nsw,dt,DepthBeforeScalingFluxes, & +!$OMP parallel do default(none) shared(G, GV, fluxes, optics, nsw,dt,FluxRescaleDepth, & !$OMP useRiverHeatContent, useCalvingHeatContent, & !$OMP h,T,netMassInOut,netMassOut,Net_heat,Net_salt,Pen_SW_bnd,tv, & -!$OMP aggregate_FW_forcing) +!$OMP aggregate_FW) do j=G%jsc, G%jec call extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & - DepthBeforeScalingFluxes, useRiverHeatContent, useCalvingHeatContent,& + FluxRescaleDepth, useRiverHeatContent, useCalvingHeatContent,& h(:,j,:), T(:,j,:), netMassInOut(:,j), netMassOut(:,j), & - net_heat(:,j), net_salt(:,j), pen_SW_bnd(:,:,j), tv, aggregate_FW_forcing) + net_heat(:,j), net_salt(:,j), pen_SW_bnd(:,:,j), tv, aggregate_FW) enddo end subroutine extractFluxes2d @@ -812,7 +821,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, fluxes, optics, h, Temp, Salt, tv, j, real, dimension(SZI_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoyancy flux (m^2/s^3) real, dimension(SZI_(G)), intent(inout) :: netHeatMinusSW !< surf Heat flux (K H/s) real, dimension(SZI_(G)), intent(inout) :: netSalt !< surf salt flux (ppt H/s) - logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating + logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating !! diagnostics inside extractFluxes1d() ! local variables integer :: nsw, start, npts, k @@ -900,7 +909,7 @@ subroutine calculateBuoyancyFlux2d(G, GV, fluxes, optics, h, Temp, Salt, tv, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoy flux (m^2/s^3) real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netHeatMinusSW !< surf temp flux (K H) real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netSalt !< surf salt flux (ppt H) - logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating + logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating !! diagnostics inside extractFluxes1d() ! local variables real, dimension( SZI_(G) ) :: netT ! net temperature flux (K m/s) @@ -1522,7 +1531,7 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use handles%id_total_net_heat_surface = register_scalar_field('ocean_model', & 'total_net_heat_surface', Time, diag, & - long_name='Area integrated surface heat flux from SW+LW+lat+sens+mass+frazil+restore or flux adjustments', & + long_name='Area integrated surface heat flux from SW+LW+lat+sens+mass+frazil+restore or flux adjustments', & units='W', & cmor_field_name='total_hfds', & cmor_standard_name='surface_downward_heat_flux_in_sea_water_area_integrated', & @@ -1609,7 +1618,7 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use handles%id_net_heat_surface_ga = register_scalar_field('ocean_model', & 'net_heat_surface_ga', Time, diag, & - long_name='Area averaged surface heat flux from SW+LW+lat+sens+mass+frazil+restore or flux adjustments', & + long_name='Area averaged surface heat flux from SW+LW+lat+sens+mass+frazil+restore or flux adjustments', & units='W m-2', & cmor_field_name='ave_hfds', & cmor_standard_name='surface_downward_heat_flux_in_sea_water_area_averaged', & @@ -2244,7 +2253,8 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) call post_data(handles%id_total_heat_content_massin, total_transport, diag) endif - if (handles%id_net_heat_coupler > 0 .or. handles%id_total_net_heat_coupler > 0 .or. handles%id_net_heat_coupler_ga > 0. ) then + if (handles%id_net_heat_coupler > 0 .or. handles%id_total_net_heat_coupler > 0 .or. & + handles%id_net_heat_coupler_ga > 0. ) then do j=js,je ; do i=is,ie res(i,j) = 0.0 if (associated(fluxes%LW)) res(i,j) = res(i,j) + fluxes%LW(i,j) @@ -2263,7 +2273,8 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) endif endif - if (handles%id_net_heat_surface > 0 .or. handles%id_total_net_heat_surface > 0 .or. handles%id_net_heat_surface_ga > 0. ) then + if (handles%id_net_heat_surface > 0 .or. handles%id_total_net_heat_surface > 0 .or. & + handles%id_net_heat_surface_ga > 0. ) then do j=js,je ; do i=is,ie res(i,j) = 0.0 if (associated(fluxes%LW)) res(i,j) = res(i,j) + fluxes%LW(i,j) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index c65504041b..75140c3d4f 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -569,18 +569,21 @@ end subroutine MOM_grid_end !! !! Grid metrics and their inverses are labelled according to their staggered location on a Arakawa C (or B) grid. !! - Metrics centered on h- or T-points are labelled T, e.g. dxT is the distance across the cell in the x-direction. -!! - Metrics centered on u-points are labelled Cu (C-grid u location). e.g. dyCu is the y-distance between two corners of a T-cell. +!! - Metrics centered on u-points are labelled Cu (C-grid u location). e.g. dyCu is the y-distance between +!! two corners of a T-cell. !! - Metrics centered on v-points are labelled Cv (C-grid v location). e.g. dyCv is the y-distance between two -points. !! - Metrics centered on q-points are labelled Bu (B-grid u,v location). e.g. areaBu is the area centered on a q-point. !! -!! \image html Grid_metrics.png "The labelling of distances (grid metrics) at various staggered location on an T-cell and around a q-point. +!! \image html Grid_metrics.png +!! "The labelling of distances (grid metrics) at various staggered location on an T-cell and around a q-point. !! !! Areas centered at T-, u-, v- and q- points are `areaT`, `areaCu`, `areaCv` and `areaBu` respectively. !! !! The reciprocal of metrics are pre-calculated and also stored in the ocean_grid_type with a I prepended to the name. !! For example, `1./areaT` is called `IareaT`, and `1./dyCv` is `IdyCv`. !! -!! Geographic latitude and longitude (or model coordinates if not on a sphere) are stored in `geoLatT`, `geoLonT` for T-points. +!! Geographic latitude and longitude (or model coordinates if not on a sphere) are stored in +!! `geoLatT`, `geoLonT` for T-points. !! u-, v- and q- point coordinates are follow same pattern of replacing T with Cu, Cv and Bu respectively. !! !! Each location also has a 2D mask indicating whether the entire column is land or ocean. diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index f6aafaef63..c677f3863c 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -23,14 +23,18 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface heights (m) - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - real, intent(in) :: dt_kappa_smooth !< A vertical diffusive smoothing timescale, in s. + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables + real, intent(in) :: dt_kappa_smooth !< A vertical diffusive smoothing + !! timescale, in s. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: slope_x !< Isopycnal slope in i-direction (nondim) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: slope_y !< Isopycnal slope in j-direction (nondim) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), & - optional, intent(inout) :: N2_u !< Brunt-Vaisala frequency squared at u-points (s-2) + optional, intent(inout) :: N2_u !< Brunt-Vaisala frequency squared at + !! interfaces between u-points (s-2) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), & - optional, intent(inout) :: N2_v !< Brunt-Vaisala frequency squared at u-points (s-2) + optional, intent(inout) :: N2_v !< Brunt-Vaisala frequency squared at + !! interfaces between u-points (s-2) integer, optional, intent(in) :: halo !< Halo width over which to compute ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & @@ -308,16 +312,16 @@ end subroutine calc_isoneutral_slopes !> Returns tracer arrays (nominally T and S) with massless layers filled with !! sensible values, by diffusing vertically with a small but constant diffusivity. subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Temperature (deg C) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Salinity (psu) - real, intent(in) :: kappa !< A vertical diffusivity to use for smoothing (m2 s-1) - real, intent(in) :: dt !< The time increment, in s. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature (deg C) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filed salinity (psu) - integer, optional, intent(in) :: halo_here !< Halo width over which to compute + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Temperature (deg C) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Salinity (psu) + real, intent(in) :: kappa !< A vertical diffusivity to use for smoothing (m2 s-1) + real, intent(in) :: dt !< The time increment, in s. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature (deg C) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filed salinity (psu) + integer, optional, intent(in) :: halo_here !< Halo width over which to compute ! Local variables real :: ent(SZI_(G),SZK_(G)+1) ! The diffusive entrainment (kappa*dt)/dz ! between layers in a timestep in m or kg m-2. diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 41893d8dd5..90ee212e93 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -905,7 +905,8 @@ subroutine parse_segment_str(ni_global, nj_global, segment_str, l, m, n, action_ integer, intent(out) :: n !< The value of J=n, if segment_str begins with I=, or the value of I=n character(len=*), intent(out) :: action_str(:) !< The "string" part of segment_str ! Local variables - character(len=24) :: word1, word2, m_word, n_word !< Words delineated by commas in a string in form of "I=%,J=%:%,string" + character(len=24) :: word1, word2, m_word, n_word !< Words delineated by commas in a string in form of + !! "I=%,J=%:%,string" integer :: l_max !< Either ni_global or nj_global, depending on whether segment_str begins with "I=" or "J=" integer :: mn_max !< Either nj_global or ni_global, depending on whether segment_str begins with "I=" or "J=" integer :: j @@ -989,15 +990,17 @@ end subroutine parse_segment_str !> Parse an OBC_SEGMENT_%%%_DATA string subroutine parse_segment_data_str(segment_str, var, value, filenam, fieldnam, fields, num_fields, debug ) - character(len=*), intent(in) :: segment_str !< A string in form of "VAR1=file:foo1.nc(varnam1),VAR2=file:foo2.nc(varnam2),..." - character(len=*), optional, intent(in) :: var !< The name of the variable for which parameters are needed - character(len=*), optional, intent(out) :: filenam !< The name of the input file if using "file" method - character(len=*), optional, intent(out) :: fieldnam !< The name of the variable in the input file if using "file" method - real, optional, intent(out) :: value !< A constant value if using the "value" method + character(len=*), intent(in) :: segment_str !< A string in form of + !! "VAR1=file:foo1.nc(varnam1),VAR2=file:foo2.nc(varnam2),..." + character(len=*), optional, intent(in) :: var !< The name of the variable for which parameters are needed + character(len=*), optional, intent(out) :: filenam !< The name of the input file if using "file" method + character(len=*), optional, intent(out) :: fieldnam !< The name of the variable in the input file if using + !! "file" method + real, optional, intent(out) :: value !< A constant value if using the "value" method character(len=*), dimension(MAX_OBC_FIELDS), & - optional, intent(out) :: fields !< List of fieldnames for each segment - integer, optional, intent(out) :: num_fields !< The number of fields in the segment data - logical, optional, intent(in) :: debug !< If present and true, write verbose debugging messages + optional, intent(out) :: fields !< List of fieldnames for each segment + integer, optional, intent(out) :: num_fields !< The number of fields in the segment data + logical, optional, intent(in) :: debug !< If present and true, write verbose debugging messages ! Local variables character(len=128) :: word1, word2, word3, method integer :: lword, nfields, n, m, orient @@ -1075,10 +1078,11 @@ end subroutine parse_segment_data_str !> Parse an OBC_SEGMENT_%%%_PARAMS string subroutine parse_segment_param_real(segment_str, var, param_value, debug ) - character(len=*), intent(in) :: segment_str !< A string in form of "VAR1=file:foo1.nc(varnam1),VAR2=file:foo2.nc(varnam2),..." - character(len=*), intent(in) :: var !< The name of the variable for which parameters are needed - real, intent(out) :: param_value !< The value of the parameter - logical, optional, intent(in) :: debug !< If present and true, write verbose debugging messages + character(len=*), intent(in) :: segment_str !< A string in form of + !! "VAR1=file:foo1.nc(varnam1),VAR2=file:foo2.nc(varnam2),..." + character(len=*), intent(in) :: var !< The name of the variable for which parameters are needed + real, intent(out) :: param_value !< The value of the parameter + logical, optional, intent(in) :: debug !< If present and true, write verbose debugging messages ! Local variables character(len=128) :: word1, word2, word3, method integer :: lword, nfields, n, m, orient @@ -1169,13 +1173,14 @@ subroutine open_boundary_init(G, param_file, OBC) end subroutine open_boundary_init -logical function open_boundary_query(OBC, apply_open_OBC, apply_specified_OBC, apply_Flather_OBC, apply_nudged_OBC, needs_ext_seg_data) - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - logical, optional, intent(in) :: apply_open_OBC !< If present, returns True if specified_*_BCs_exist_globally is true - logical, optional, intent(in) :: apply_specified_OBC !< If present, returns True if specified_*_BCs_exist_globally is true - logical, optional, intent(in) :: apply_Flather_OBC !< If present, returns True if Flather_*_BCs_exist_globally is true - logical, optional, intent(in) :: apply_nudged_OBC !< If present, returns True if nudged_*_BCs_exist_globally is true - logical, optional, intent(in) :: needs_ext_seg_data !< If present, returns True if external segment data needed +logical function open_boundary_query(OBC, apply_open_OBC, apply_specified_OBC, apply_Flather_OBC, & + apply_nudged_OBC, needs_ext_seg_data) + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + logical, optional, intent(in) :: apply_open_OBC !< Returns True if open_*_BCs_exist_globally is true + logical, optional, intent(in) :: apply_specified_OBC !< Returns True if specified_*_BCs_exist_globally is true + logical, optional, intent(in) :: apply_Flather_OBC !< Returns True if Flather_*_BCs_exist_globally is true + logical, optional, intent(in) :: apply_nudged_OBC !< Returns True if nudged_*_BCs_exist_globally is true + logical, optional, intent(in) :: needs_ext_seg_data !< Returns True if external segment data needed open_boundary_query = .false. if (.not. associated(OBC)) return if (present(apply_open_OBC)) open_boundary_query = OBC%open_u_BCs_exist_globally .or. & @@ -2219,15 +2224,19 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (OBC%brushcutter_mode) then if (segment%is_E_or_W) then if (segment%field(m)%name == 'V') then - segment%field(m)%buffer_src(is_obc,:,:)=tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset)+1:2,:) + segment%field(m)%buffer_src(is_obc,:,:) = & + tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset)+1:2,:) else - segment%field(m)%buffer_src(is_obc,:,:)=tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset):2,:) + segment%field(m)%buffer_src(is_obc,:,:) = & + tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset):2,:) endif else if (segment%field(m)%name == 'U') then - segment%field(m)%buffer_src(:,js_obc,:)=tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset)+1:2,1,:) + segment%field(m)%buffer_src(:,js_obc,:) = & + tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset)+1:2,1,:) else - segment%field(m)%buffer_src(:,js_obc,:)=tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset):2,1,:) + segment%field(m)%buffer_src(:,js_obc,:) = & + tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset):2,1,:) endif endif else @@ -2250,15 +2259,19 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (OBC%brushcutter_mode) then if (segment%is_E_or_W) then if (segment%field(m)%name == 'V') then - segment%field(m)%dz_src(is_obc,:,:)=tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset)+1:2,:) + segment%field(m)%dz_src(is_obc,:,:) = & + tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset)+1:2,:) else - segment%field(m)%dz_src(is_obc,:,:)=tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset):2,:) + segment%field(m)%dz_src(is_obc,:,:) = & + tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset):2,:) endif else if (segment%field(m)%name == 'U') then - segment%field(m)%dz_src(:,js_obc,:)=tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset)+1:2,1,:) + segment%field(m)%dz_src(:,js_obc,:) = & + tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset)+1:2,1,:) else - segment%field(m)%dz_src(:,js_obc,:)=tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset):2,1,:) + segment%field(m)%dz_src(:,js_obc,:) = & + tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset):2,1,:) endif endif else diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 7425906de4..09305eb9fb 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -281,7 +281,8 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(surface), intent(inout) :: sfc_state !< ocean surface state type to be allocated. logical, optional, intent(in) :: use_temperature !< If true, allocate the space for thermodynamic variables. - logical, optional, intent(in) :: do_integrals !< If true, allocate the space for vertically integrated fields. + logical, optional, intent(in) :: do_integrals !< If true, allocate the space for vertically + !! integrated fields. type(coupler_1d_bc_type), & optional, intent(in) :: gas_fields_ocn !< If present, this type describes the ocean !! ocean and surface-ice fields that will participate diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 097a0e13b3..6e557426c7 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -62,7 +62,8 @@ module MOM_diagnostics type, public :: diagnostics_CS ; private real :: mono_N2_column_fraction = 0. !< The lower fraction of water column over which N2 is limited as - !! monotonic for the purposes of calculating the equivalent barotropic wave speed. + !! monotonic for the purposes of calculating the equivalent + !! barotropic wave speed. real :: mono_N2_depth = -1. !< The depth below which N2 is limited as monotonic for the purposes of !! calculating the equivalent barotropic wave speed. (m) @@ -1307,7 +1308,8 @@ end subroutine post_surface_diagnostics !> This routine posts diagnostics of the transports, including the subgridscale !! contributions. -subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, diag, dt_trans, diag_to_Z_CSp, Reg) +subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, diag, dt_trans, & + diag_to_Z_CSp, Reg) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -1352,7 +1354,7 @@ subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, d call post_data(IDs%id_umo_2d, umo2d, diag) endif if (IDs%id_umo > 0) then - ! Convert to kg/s. Modifying the array for diagnostics is allowed here since it is set to zero immediately below + ! Convert to kg/s. do k=1,nz ; do j=js,je ; do I=is-1,ie umo(I,j,k) = uhtr(I,j,k) * H_to_kg_m2_dt enddo ; enddo ; enddo @@ -1366,7 +1368,7 @@ subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, d call post_data(IDs%id_vmo_2d, vmo2d, diag) endif if (IDs%id_vmo > 0) then - ! Convert to kg/s. Modifying the array for diagnostics is allowed here since it is set to zero immediately below + ! Convert to kg/s. do k=1,nz ; do J=js-1,je ; do i=is,ie vmo(i,J,k) = vhtr(i,J,k) * H_to_kg_m2_dt enddo ; enddo ; enddo @@ -1375,7 +1377,8 @@ subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, d if (IDs%id_uhtr > 0) call post_data(IDs%id_uhtr, uhtr, diag, alt_h = diag_pre_dyn%h_state) if (IDs%id_vhtr > 0) call post_data(IDs%id_vhtr, vhtr, diag, alt_h = diag_pre_dyn%h_state) - if (IDs%id_dynamics_h > 0 ) call post_data(IDs%id_dynamics_h, diag_pre_dyn%h_state, diag, alt_h = diag_pre_dyn%h_state) + if (IDs%id_dynamics_h > 0) call post_data(IDs%id_dynamics_h, diag_pre_dyn%h_state, diag, & + alt_h = diag_pre_dyn%h_state) ! Post the change in thicknesses if (IDs%id_dynamics_h_tendency > 0) then h_tend(:,:,:) = 0. diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 18de7c2902..a036509437 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -38,15 +38,15 @@ module MOM_sum_output !********+*********+*********+*********+*********+*********+*********+** use MOM_coms, only : sum_across_PEs, PE_here, root_PE, num_PEs, max_across_PEs -use MOM_coms, only : reproducing_sum -use MOM_coms, only : EFP_type, operator(+), operator(-), assignment(=), EFP_to_real, real_to_EFP +use MOM_coms, only : reproducing_sum, EFP_to_real, real_to_EFP +use MOM_coms, only : EFP_type, operator(+), operator(-), assignment(=) use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe, MOM_mesg use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_forcing_type, only : forcing use MOM_grid, only : ocean_grid_type use MOM_interface_heights, only : find_eta -use MOM_io, only : create_file, fieldtype, flush_file, open_file, reopen_file, get_filename_appendix -use MOM_io, only : file_exists, slasher, vardesc, var_desc, write_field +use MOM_io, only : create_file, fieldtype, flush_file, open_file, reopen_file +use MOM_io, only : file_exists, slasher, vardesc, var_desc, write_field, get_filename_appendix use MOM_io, only : APPEND_FILE, ASCII_FILE, SINGLE_FILE, WRITEONLY_FILE use MOM_open_boundary, only : ocean_OBC_type, OBC_segment_type use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S @@ -949,24 +949,18 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc endif end subroutine write_energy -!> This subroutine accumates the net input of volume, and perhaps later salt and -!! heat, through the ocean surface for use in diagnosing conservation. +!> This subroutine accumates the net input of volume, salt and heat, through +!! the ocean surface for use in diagnosing conservation. subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) - type(forcing), intent(in) :: fluxes !< A structure containing pointers to any possible forcing fields. Unused fields are unallocated. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to any possible + !! forcing fields. Unused fields are unallocated. type(surface), intent(in) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. real, intent(in) :: dt !< The amount of time over which to average, in s. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(Sum_output_CS), pointer :: CS !< The control structure returned by a previous call to MOM_sum_output_init. - -! This subroutine accumates the net input of volume, and perhaps later salt and -! heat, through the ocean surface for use in diagnosing conservation. -! Arguments: fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields are unallocated. -! (in) dt - The amount of time over which to average. -! (in) G - The ocean's grid structure. -! (in) CS - The control structure returned by a previous call to -! MOM_sum_output_init. + type(Sum_output_CS), pointer :: CS !< The control structure returned by a previous call + !! to MOM_sum_output_init. + real, dimension(SZI_(G),SZJ_(G)) :: & FW_in, & ! The net fresh water input, integrated over a timestep in kg. salt_in, & ! The total salt added by surface fluxes, integrated diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index fbd0ce2daa..6b0c90e55e 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -25,9 +25,9 @@ module MOM_wave_speed !! This parameter controls the default behavior of wave_speed() which !! can be overridden by optional arguments. real :: mono_N2_column_fraction = 0. !< The lower fraction of water column over which N2 is limited as - !! monotonic for the purposes of calculating the equivalent barotropic wave speed. - !! This parameter controls the default behavior of wave_speed() which - !! can be overridden by optional arguments. + !! monotonic for the purposes of calculating the equivalent barotropic + !! wave speed. This parameter controls the default behavior of + !! wave_speed() which can be overridden by optional arguments. real :: mono_N2_depth = -1. !< The depth below which N2 is limited as monotonic for the purposes of !! calculating the equivalent barotropic wave speed. (m) !! This parameter controls the default behavior of wave_speed() which @@ -42,23 +42,25 @@ module MOM_wave_speed !> Calculates the wave speed of the first baroclinic mode. subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & mono_N2_column_fraction, mono_N2_depth, modal_structure) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in units of H (m or kg/m2) - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: cg1 !< First mode internal wave speed (m/s) - type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed - logical, optional, intent(in) :: full_halos !< If true, do the calculation - !! over the entire computational domain. - logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent - !! barotropic mode instead of the first baroclinic mode. - real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction - !! of water column over which N2 is limited as monotonic - !! for the purposes of calculating vertical modal structure. - real, optional, intent(in) :: mono_N2_depth !< A depth below which N2 is limited as - !! monotonic for the purposes of calculating vertical modal structure. + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thickness in units of H (m or kg/m2) + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: cg1 !< First mode internal wave speed (m/s) + type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed + logical, optional, intent(in) :: full_halos !< If true, do the calculation + !! over the entire computational domain. + logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent + !! barotropic mode instead of the first baroclinic mode. + real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction + !! of water column over which N2 is limited as monotonic + !! for the purposes of calculating vertical modal structure. + real, optional, intent(in) :: mono_N2_depth !< A depth below which N2 is limited as + !! monotonic for the purposes of calculating vertical + !! modal structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - optional, intent(out) :: modal_structure !< Normalized model structure (non-dim) + optional, intent(out) :: modal_structure !< Normalized model structure (non-dim) ! Local variables real, dimension(SZK_(G)+1) :: & @@ -354,7 +356,8 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & do itt=1,max_itt lam_it(itt) = lam if (l_use_ebt_mode) then - ! This initialization of det,ddet imply Neumann boundary conditions so that first 3 rows of the matrix are + ! This initialization of det,ddet imply Neumann boundary conditions so that first 3 rows + ! of the matrix are ! / b(1)-lam igl(1) 0 0 0 ... \ ! | igu(2) b(2)-lam igl(2) 0 0 ... | ! | 0 igu(3) b(3)-lam igl(3) 0 ... | @@ -373,7 +376,8 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & ! | ... 0 igu(kc-1) b(kc-1)-lam igl(kc-1) | ! \ ... 0 0 igu(kc) b(kc)-lam / else - ! This initialization of det,ddet imply Dirichlet boundary conditions so that first 3 rows of the matrix are + ! This initialization of det,ddet imply Dirichlet boundary conditions so that first 3 rows + ! of the matrix are ! / b(2)-lam igl(2) 0 0 0 ... | ! | igu(3) b(3)-lam igl(3) 0 0 ... | ! | 0 igu43) b(4)-lam igl(4) 0 ... | @@ -1088,10 +1092,12 @@ subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_de type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent !! barotropic mode instead of the first baroclinic mode. - real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction of water column over which N2 is limited - !! as monotonic for the purposes of calculating vertical modal structure. + real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction of water column over + !! which N2 is limited as monotonic for the purposes of + !! calculating the vertical modal structure. real, optional, intent(in) :: mono_N2_depth !< The depth below which N2 is limited - !! as monotonic for the purposes of calculating vertical modal structure. + !! as monotonic for the purposes of calculating the + !! vertical modal structure. ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_wave_speed" ! This module's name. @@ -1116,10 +1122,12 @@ subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_ type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent !! barotropic mode instead of the first baroclinic mode. - real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction of water column over which N2 is limited - !! as monotonic for the purposes of calculating vertical modal structure. + real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction of water column over + !! which N2 is limited as monotonic for the purposes of + !! calculating the vertical modal structure. real, optional, intent(in) :: mono_N2_depth !< The depth below which N2 is limited - !! as monotonic for the purposes of calculating vertical modal structure. + !! as monotonic for the purposes of calculating the + !! vertical modal structure. if (.not.associated(CS)) call MOM_error(FATAL, & "wave_speed_set_param called with an associated control structure.") diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index e94f945c57..f504bf220b 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -274,7 +274,8 @@ end subroutine calculate_spec_vol_array subroutine calculate_TFreeze_scalar(S, pressure, T_fr, EOS) real, intent(in) :: S !< Salinity (PSU) real, intent(in) :: pressure !< Pressure (Pa) - real, intent(out) :: T_fr !< Freezing point potential temperature referenced to the surface (degC) + real, intent(out) :: T_fr !< Freezing point potential temperature referenced + !! to the surface (degC) type(EOS_type), pointer :: EOS !< Equation of state structure if (.not.associated(EOS)) call MOM_error(FATAL, & @@ -299,7 +300,8 @@ end subroutine calculate_TFreeze_scalar subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS) real, dimension(:), intent(in) :: S !< Salinity (PSU) real, dimension(:), intent(in) :: pressure !< Pressure (Pa) - real, dimension(:), intent(out) :: T_fr !< Freezing point potential temperature referenced to the surface (degC) + real, dimension(:), intent(out) :: T_fr !< Freezing point potential temperature referenced + !! to the surface (degC) integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), pointer :: EOS !< Equation of state structure @@ -327,8 +329,10 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface (degC) real, dimension(:), intent(in) :: S !< Salinity (PSU) real, dimension(:), intent(in) :: pressure !< Pressure (Pa) - real, dimension(:), intent(out) :: drho_dT !< The partial derivative of density with potential tempetature, in kg m-3 K-1. - real, dimension(:), intent(out) :: drho_dS !< The partial derivative of density with salinity, in kg m-3 psu-1. + real, dimension(:), intent(out) :: drho_dT !< The partial derivative of density with potential + !! temperature, in kg m-3 K-1. + real, dimension(:), intent(out) :: drho_dS !< The partial derivative of density with salinity, + !! in kg m-3 psu-1. integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), pointer :: EOS !< Equation of state structure @@ -338,8 +342,8 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_density_derivs_linear(T, S, pressure, drho_dT, drho_dS, EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS, & - start, npts) + call calculate_density_derivs_linear(T, S, pressure, drho_dT, drho_dS, EOS%Rho_T0_S0, & + EOS%dRho_dT, EOS%dRho_dS, start, npts) case (EOS_UNESCO) call calculate_density_derivs_unesco(T, S, pressure, drho_dT, drho_dS, start, npts) case (EOS_WRIGHT) @@ -355,13 +359,16 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star end subroutine calculate_density_derivs_array -!> Calls the appropriate subroutines to calculate density derivatives by promoting a scalar to a one-element array +!> Calls the appropriate subroutines to calculate density derivatives by promoting a scalar +!! to a one-element array subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS) real, intent(in) :: T !< Potential temperature referenced to the surface (degC) real, intent(in) :: S !< Salinity (PSU) real, intent(in) :: pressure !< Pressure (Pa) - real, intent(out) :: drho_dT !< The partial derivative of density with potential tempetature, in kg m-3 K-1. - real, intent(out) :: drho_dS !< The partial derivative of density with salinity, in kg m-3 psu-1. + real, intent(out) :: drho_dT !< The partial derivative of density with potential + !! temperature, in kg m-3 K-1. + real, intent(out) :: drho_dS !< The partial derivative of density with salinity, + !! in kg m-3 psu-1. type(EOS_type), pointer :: EOS !< Equation of state structure if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") @@ -382,8 +389,8 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS end subroutine calculate_density_derivs_scalar !> Calls the appropriate subroutine to calculate density second derivatives for 1-D array inputs. -subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, & - start, npts, EOS) +subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & + drho_dS_dP, drho_dT_dP, start, npts, EOS) real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface (degC) real, dimension(:), intent(in) :: S !< Salinity (PSU) real, dimension(:), intent(in) :: pressure !< Pressure (Pa) @@ -401,14 +408,14 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_density_second_derivs_linear(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP, start, npts) + call calculate_density_second_derivs_linear(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, start, npts) case (EOS_WRIGHT) - call calculate_density_second_derivs_wright(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP, start, npts) + call calculate_density_second_derivs_wright(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, start, npts) case (EOS_TEOS10) - call calculate_density_second_derivs_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP, start, npts) + call calculate_density_second_derivs_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, start, npts) case default call MOM_error(FATAL, & "calculate_density_derivs: EOS%form_of_EOS is not valid.") @@ -417,8 +424,8 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh end subroutine calculate_density_second_derivs_array !> Calls the appropriate subroutine to calculate density second derivatives for scalar nputs. -subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, & - EOS) +subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & + drho_dS_dP, drho_dT_dP, EOS) real, intent(in) :: T !< Potential temperature referenced to the surface (degC) real, intent(in) :: S !< Salinity (PSU) real, intent(in) :: pressure !< Pressure (Pa) @@ -434,14 +441,14 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_density_second_derivs_linear(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP) + call calculate_density_second_derivs_linear(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP) case (EOS_WRIGHT) - call calculate_density_second_derivs_wright(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP) + call calculate_density_second_derivs_wright(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP) case (EOS_TEOS10) - call calculate_density_second_derivs_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP) + call calculate_density_second_derivs_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP) case default call MOM_error(FATAL, & "calculate_density_derivs: EOS%form_of_EOS is not valid.") @@ -454,8 +461,10 @@ subroutine calculate_specific_vol_derivs(T, S, pressure, dSV_dT, dSV_dS, start, real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface (degC) real, dimension(:), intent(in) :: S !< Salinity (PSU) real, dimension(:), intent(in) :: pressure !< Pressure (Pa) - real, dimension(:), intent(out) :: dSV_dT !< The partial derivative of specific volume with potential temperature, in m3 kg-1 K-1. - real, dimension(:), intent(out) :: dSV_dS !< The partial derivative of specific volume with salinity, in m3 kg-1 / (g/kg). + real, dimension(:), intent(out) :: dSV_dT !< The partial derivative of specific volume with potential + !! temperature, in m3 kg-1 K-1. + real, dimension(:), intent(out) :: dSV_dS !< The partial derivative of specific volume with salinity, + !! in m3 kg-1 / (g/kg). integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), pointer :: EOS !< Equation of state structure @@ -771,7 +780,8 @@ subroutine EOS_init(param_file, EOS) units="deg C Pa-1", default=0.0) endif - if ((EOS%form_of_EOS == EOS_TEOS10 .OR. EOS%form_of_EOS == EOS_NEMO) .AND. EOS%form_of_TFreeze /= TFREEZE_TEOS10) then + if ((EOS%form_of_EOS == EOS_TEOS10 .OR. EOS%form_of_EOS == EOS_NEMO) .AND. & + EOS%form_of_TFreeze /= TFREEZE_TEOS10) then call MOM_error(FATAL, "interpret_eos_selection: EOS_TEOS10 or EOS_NEMO \n" //& "should only be used along with TFREEZE_FORM = TFREEZE_TEOS10 .") endif @@ -780,8 +790,8 @@ subroutine EOS_init(param_file, EOS) end subroutine EOS_init !> Manually initialized an EOS type (intended for unit testing of routines which need a specific EOS) -subroutine EOS_manual_init(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Compressible, Rho_T0_S0, drho_dT, & - dRho_dS, TFr_S0_P0, dTFr_dS, dTFr_dp) +subroutine EOS_manual_init(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Compressible, & + Rho_T0_S0, drho_dT, dRho_dS, TFr_S0_P0, dTFr_dS, dTFr_dp) type(EOS_type), pointer :: EOS integer, optional, intent(in ) :: form_of_EOS integer, optional, intent(in ) :: form_of_TFreeze @@ -2335,8 +2345,8 @@ subroutine convert_temp_salt_for_TEOS10(T, S, press, G, kd, mask_z, EOS) end subroutine convert_temp_salt_for_TEOS10 ! Extractor routine for the EOS type if the members need to be accessed outside this module -subroutine extract_member_EOS(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Compressible, Rho_T0_S0, drho_dT, & - dRho_dS, TFr_S0_P0, dTFr_dS, dTFr_dp) +subroutine extract_member_EOS(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Compressible, & + Rho_T0_S0, drho_dT, dRho_dS, TFr_S0_P0, dTFr_dS, dTFr_dp) type(EOS_type), pointer :: EOS integer, optional, intent(out) :: form_of_EOS integer, optional, intent(out) :: form_of_TFreeze diff --git a/src/equation_of_state/MOM_EOS_TEOS10.F90 b/src/equation_of_state/MOM_EOS_TEOS10.F90 index d6a211b6c3..f0811422d5 100644 --- a/src/equation_of_state/MOM_EOS_TEOS10.F90 +++ b/src/equation_of_state/MOM_EOS_TEOS10.F90 @@ -236,8 +236,8 @@ subroutine calculate_specvol_derivs_teos10(T, S, pressure, dSV_dT, dSV_dS, start end subroutine calculate_specvol_derivs_teos10 !> Calculate the 5 second derivatives of the equation of state for scalar inputs -subroutine calculate_density_second_derivs_scalar_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP) +subroutine calculate_density_second_derivs_scalar_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP) real, intent(in) :: T, S, pressure real, intent(out) :: drho_dS_dS !< Partial derivative of beta with respect to S real, intent(out) :: drho_dS_dT !< Partial derivative of beta with resepct to T @@ -264,8 +264,8 @@ subroutine calculate_density_second_derivs_scalar_teos10(T, S, pressure, drho_dS end subroutine calculate_density_second_derivs_scalar_teos10 !> Calculate the 5 second derivatives of the equation of state for scalar inputs -subroutine calculate_density_second_derivs_array_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP, start, npts) +subroutine calculate_density_second_derivs_array_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, start, npts) real, dimension(:), intent(in) :: T, S, pressure real, dimension(:), intent(out) :: drho_dS_dS !< Partial derivative of beta with respect to S real, dimension(:), intent(out) :: drho_dS_dT !< Partial derivative of beta with resepct to T diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index 9f738f6322..01678dce41 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -235,7 +235,8 @@ subroutine chksum_pair_B_2d(mesg, arrayA, arrayB, HI, haloshift, symmetric, omit character(len=*), intent(in) :: mesg !< Identifying messages type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%isd:,HI%jsd:), intent(in) :: arrayA, arrayB !< The arrays to be checksummed - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. @@ -261,7 +262,8 @@ subroutine chksum_pair_B_3d(mesg, arrayA, arrayB, HI, haloshift, symmetric, omit type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%IsdB:,HI%JsdB:, :), intent(in) :: arrayA, arrayB !< The arrays to be checksummed integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. @@ -425,7 +427,8 @@ subroutine chksum_uv_2d(mesg, arrayU, arrayV, HI, haloshift, symmetric, omit_cor real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: arrayU !< The u-component array to be checksummed real, dimension(HI%isd:,HI%JsdB:), intent(in) :: arrayV !< The v-component array to be checksummed integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for these arrays. @@ -445,7 +448,8 @@ subroutine chksum_uv_3d(mesg, arrayU, arrayV, HI, haloshift, symmetric, omit_cor real, dimension(HI%IsdB:,HI%jsd:,:), intent(in) :: arrayU !< The u-component array to be checksummed real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: arrayV !< The v-component array to be checksummed integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for these arrays. @@ -465,7 +469,8 @@ subroutine chksum_u_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: array !< The array to be checksummed character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. @@ -608,7 +613,8 @@ subroutine chksum_v_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal real, dimension(HI%isd:,HI%JsdB:), intent(in) :: array !< The array to be checksummed character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. @@ -874,7 +880,8 @@ subroutine chksum_B_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. @@ -1017,7 +1024,8 @@ subroutine chksum_u_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal real, dimension(HI%isdB:,HI%Jsd:,:), intent(in) :: array !< The array to be checksummed character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. @@ -1154,7 +1162,8 @@ end subroutine chksum_u_3d !---chksum_general interface routines !> Return the bitcount of an arbitrarily sized 3d array -integer function chksum_general_3d( array, scale_factor, istart, iend, jstart, jend, kstart, kend ) result(subchk) +integer function chksum_general_3d( array, scale_factor, istart, iend, jstart, jend, kstart, kend ) & + result(subchk) real, dimension(:,:,:), intent(in) :: array !< Array to be checksummed real, optional, intent(in) :: scale_factor !< Factor to scale array by before checksum integer, optional, intent(in) :: istart !< Starting index in the i-direction @@ -1232,7 +1241,8 @@ subroutine chksum_v_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. @@ -1512,7 +1522,8 @@ end function is_NaN_0d !> This function returns .true. if any element of x is a NaN, and .false. otherwise. function is_NaN_1d(x, skip_mpp) real, dimension(:), intent(in) :: x !< The array to be checked for NaNs. - logical, optional, intent(in) :: skip_mpp !< If true, only check this array only on the local PE (default false). + logical, optional, intent(in) :: skip_mpp !< If true, only check this array only + !! on the local PE (default false). logical :: is_NaN_1d integer :: i, n diff --git a/src/framework/MOM_diag_manager_wrapper.F90 b/src/framework/MOM_diag_manager_wrapper.F90 index 81e26634a7..0274617d32 100644 --- a/src/framework/MOM_diag_manager_wrapper.F90 +++ b/src/framework/MOM_diag_manager_wrapper.F90 @@ -19,20 +19,25 @@ module MOM_diag_manager_wrapper integer function register_diag_field_array_fms(module_name, field_name, axes, init_time, & long_name, units, missing_value, range, mask_variant, standard_name, & verbose, do_not_log, err_msg, interp_method, tile_count, area, volume) - character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or "ice_shelf_model" + character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or + !! "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field - integer, intent(in) :: axes(:) !< Container w/ up to 3 integer handles that indicates axes for this field + integer, intent(in) :: axes(:) !< Container w/ up to 3 integer handles that + !! indicates axes for this field type(time_type), intent(in) :: init_time !< Time at which a field is first available? character(len=*), optional, intent(in) :: long_name !< Long name of a field. character(len=*), optional, intent(in) :: units !< Units of a field. character(len=*), optional, intent(in) :: standard_name !< Standardized name associated with a field real, optional, intent(in) :: missing_value !< A value that indicates missing values. real, optional, intent(in) :: range(2) !< Valid range of a variable (not used in MOM?) - logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with post_data calls (not used in MOM?) + logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with + !! post_data calls (not used in MOM?) logical, optional, intent(in) :: verbose !< If true, FMS is verbose (not used in MOM?) logical, optional, intent(in) :: do_not_log !< If true, do not log something (not used in MOM?) - character(len=*), optional, intent(out):: err_msg !< String into which an error message might be placed (not used in MOM?) - character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not be interpolated as a scalar + character(len=*), optional, intent(out):: err_msg !< String into which an error message might be + !! placed (not used in MOM?) + character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not be + !! interpolated as a scalar integer, optional, intent(in) :: tile_count !< no clue (not used in MOM?) integer, optional, intent(in) :: area !< The FMS id of cell area integer, optional, intent(in) :: volume !< The FMS id of cell volume @@ -50,7 +55,8 @@ end function register_diag_field_array_fms integer function register_diag_field_scalar_fms(module_name, field_name, init_time, & long_name, units, missing_value, range, mask_variant, standard_name, & verbose, do_not_log, err_msg, interp_method, tile_count, area, volume) - character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or "ice_shelf_model" + character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" + !! or "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field type(time_type), intent(in) :: init_time !< Time at which a field is first available? character(len=*), optional, intent(in) :: long_name !< Long name of a field. @@ -58,11 +64,14 @@ integer function register_diag_field_scalar_fms(module_name, field_name, init_ti character(len=*), optional, intent(in) :: standard_name !< Standardized name associated with a field real, optional, intent(in) :: missing_value !< A value that indicates missing values. real, optional, intent(in) :: range(2) !< Valid range of a variable (not used in MOM?) - logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with post_data calls (not used in MOM?) + logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with + !! post_data calls (not used in MOM?) logical, optional, intent(in) :: verbose !< If true, FMS is verbose (not used in MOM?) logical, optional, intent(in) :: do_not_log !< If true, do not log something (not used in MOM?) - character(len=*), optional, intent(out):: err_msg !< String into which an error message might be placed (not used in MOM?) - character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not be interpolated as a scalar + character(len=*), optional, intent(out):: err_msg !< String into which an error message might + !! be placed (not used in MOM?) + character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not + !! be interpolated as a scalar integer, optional, intent(in) :: tile_count !< no clue (not used in MOM?) integer, optional, intent(in) :: area !< The FMS id of cell area (not used for scalars) integer, optional, intent(in) :: volume !< The FMS id of cell volume (not used for scalars) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index cd378cff09..e37e4bddff 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -78,9 +78,12 @@ module MOM_diag_mediator type(diag_ctrl), pointer :: diag_cs => null() !< Circular link back to the main diagnostics control structure !! (Used to avoid passing said structure into every possible call). ! ID's for cell_methods - character(len=9) :: x_cell_method = '' !< Default nature of data representation, if axes group includes x-direction. - character(len=9) :: y_cell_method = '' !< Default nature of data representation, if axes group includes y-direction. - character(len=9) :: v_cell_method = '' !< Default nature of data representation, if axes group includes vertical direction. + character(len=9) :: x_cell_method = '' !< Default nature of data representation, if axes group + !! includes x-direction. + character(len=9) :: y_cell_method = '' !< Default nature of data representation, if axes group + !! includes y-direction. + character(len=9) :: v_cell_method = '' !< Default nature of data representation, if axes group + !! includes vertical direction. ! For remapping integer :: nz = 0 !< Vertical dimension of diagnostic integer :: vertical_coordinate_number = 0 !< Index of the corresponding diag_remap_ctrl for this axis group @@ -90,18 +93,21 @@ module MOM_diag_mediator logical :: is_u_point = .false. !< If true, indicates that this axes group is for a u-point located field. logical :: is_v_point = .false. !< If true, indicates that this axes group is for a v-point located field. logical :: is_layer = .false. !< If true, indicates that this axes group is for a layer vertically-located field. - logical :: is_interface = .false. !< If true, indicates that this axes group is for an interface vertically-located field. - logical :: is_native = .true. !< If true, indicates that this axes group is for a native model grid. False for any other - !! grid. Used for rank>2. - logical :: needs_remapping = .false. !< If true, indicates that this axes group is for a intensive layer-located field - !! that must be remapped to these axes. Used for rank>2. - logical :: needs_interpolating = .false. !< If true, indicates that this axes group is for a sampled interface-located field - !! that must be interpolated to these axes. Used for rank>2. + logical :: is_interface = .false. !< If true, indicates that this axes group is for an interface + !! vertically-located field. + logical :: is_native = .true. !< If true, indicates that this axes group is for a native model grid. + !! False for any other grid. Used for rank>2. + logical :: needs_remapping = .false. !< If true, indicates that this axes group is for a intensive layer-located + !! field that must be remapped to these axes. Used for rank>2. + logical :: needs_interpolating = .false. !< If true, indicates that this axes group is for a sampled + !! interface-located field that must be interpolated to + !! these axes. Used for rank>2. ! For horizontally averaged diagnositcs (applies to 2d and 3d fields only) type(axes_grp), pointer :: xyave_axes => null() !< The associated 1d axes for horizontall area-averaged diagnostics ! ID's for cell_measures integer :: id_area = -1 !< The diag_manager id for area to be used for cell_measure of variables with this axes_grp. - integer :: id_volume = -1 !< The diag_manager id for volume to be used for cell_measure of variables with this axes_grp. + integer :: id_volume = -1 !< The diag_manager id for volume to be used for cell_measure of variables + !! with this axes_grp. ! For masking real, pointer, dimension(:,:) :: mask2d => null() !< Mask for 2d (x-y) axes real, pointer, dimension(:,:,:) :: mask3d => null() !< Mask for 3d axes @@ -133,7 +139,8 @@ module MOM_diag_mediator type(axes_grp), pointer :: axes => null() type(diag_type), pointer :: next => null() !< Pointer to the next diag. real :: conversion_factor = 0. !< A factor to multiply data by before posting to FMS, if non-zero. - logical :: v_extensive = .false. !< True for vertically extensive fields (vertically integrated). False for intensive (concentrations). + logical :: v_extensive = .false. !< True for vertically extensive fields (vertically integrated). + !! False for intensive (concentrations). end type diag_type !> The following data type a list of diagnostic fields an their variants, @@ -347,7 +354,8 @@ subroutine set_axes_info(G, GV, param_file, diag_cs, set_vertical) is_h_point=.true., is_layer=.true., is_native=.false., needs_remapping=.true., & xyave_axes=diag_cs%remap_axesZL(i)) - !! \note Remapping for B points is not yet implemented so needs_remapping is not provided for remap_axesBL + !! \note Remapping for B points is not yet implemented so needs_remapping is not + !! provided for remap_axesBL call define_axes_group(diag_cs, (/ id_xq, id_yq, id_zL /), diag_cs%remap_axesBL(i), & nz=nz, vertical_coordinate_number=i, & x_cell_method='point', y_cell_method='point', v_cell_method='mean', & @@ -584,21 +592,34 @@ subroutine define_axes_group(diag_cs, handles, axes, nz, vertical_coordinate_num type(axes_grp), intent(out) :: axes !< The group of 1D axes integer, optional, intent(in) :: nz !< Number of layers in this diagnostic grid integer, optional, intent(in) :: vertical_coordinate_number !< Index number for vertical coordinate - character(len=*), optional, intent(in) :: x_cell_method !< A x-direction cell method used to construct the "cell_methods" attribute in CF convention - character(len=*), optional, intent(in) :: y_cell_method !< A y-direction cell method used to construct the "cell_methods" attribute in CF convention - character(len=*), optional, intent(in) :: v_cell_method !< A vertical direction cell method used to construct the "cell_methods" attribute in CF convention - logical, optional, intent(in) :: is_h_point !< If true, indicates this axes group for h-point located fields - logical, optional, intent(in) :: is_q_point !< If true, indicates this axes group for q-point located fields - logical, optional, intent(in) :: is_u_point !< If true, indicates this axes group for u-point located fields - logical, optional, intent(in) :: is_v_point !< If true, indicates this axes group for v-point located fields - logical, optional, intent(in) :: is_layer !< If true, indicates that this axes group is for a layer vertically-located field. - logical, optional, intent(in) :: is_interface !< If true, indicates that this axes group is for an interface vertically-located field. - logical, optional, intent(in) :: is_native !< If true, indicates that this axes group is for a native model grid. False for any other grid. - logical, optional, intent(in) :: needs_remapping !< If true, indicates that this axes group is for a intensive layer-located field - !! that must be remapped to these axes. Used for rank>2. - logical, optional, intent(in) :: needs_interpolating !< If true, indicates that this axes group is for a sampled interface-located field - !! that must be interpolated to these axes. Used for rank>2. - type(axes_grp), optional, target :: xyave_axes !< The corresponding axes group for horizontally area-average diagnostics + character(len=*), optional, intent(in) :: x_cell_method !< A x-direction cell method used to construct the + !! "cell_methods" attribute in CF convention + character(len=*), optional, intent(in) :: y_cell_method !< A y-direction cell method used to construct the + !! "cell_methods" attribute in CF convention + character(len=*), optional, intent(in) :: v_cell_method !< A vertical direction cell method used to construct + !! the "cell_methods" attribute in CF convention + logical, optional, intent(in) :: is_h_point !< If true, indicates this axes group for h-point + !! located fields + logical, optional, intent(in) :: is_q_point !< If true, indicates this axes group for q-point + !! located fields + logical, optional, intent(in) :: is_u_point !< If true, indicates this axes group for + !! u-point located fields + logical, optional, intent(in) :: is_v_point !< If true, indicates this axes group for + !! v-point located fields + logical, optional, intent(in) :: is_layer !< If true, indicates that this axes group is + !! for a layer vertically-located field. + logical, optional, intent(in) :: is_interface !< If true, indicates that this axes group + !! is for an interface vertically-located field. + logical, optional, intent(in) :: is_native !< If true, indicates that this axes group is + !! for a native model grid. False for any other grid. + logical, optional, intent(in) :: needs_remapping !< If true, indicates that this axes group is + !! for a intensive layer-located field that must + !! be remapped to these axes. Used for rank>2. + logical, optional, intent(in) :: needs_interpolating !< If true, indicates that this axes group + !! is for a sampled interface-located field that must + !! be interpolated to these axes. Used for rank>2. + type(axes_grp), optional, target :: xyave_axes !< The corresponding axes group for horizontally + !! area-average diagnostics ! Local variables integer :: n @@ -1074,7 +1095,8 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) then ks = lbound(field,3) ; ke = ubound(field,3) allocate( locfield( lbound(field,1):ubound(field,1), lbound(field,2):ubound(field,2), ks:ke ) ) - ! locfield(:,:,:) = 0.0 ! Zeroing out this array would be a good idea, but it appears not to be necessary. + ! locfield(:,:,:) = 0.0 ! Zeroing out this array would be a good idea, but it appears + ! not to be necessary. isv_c = isv ; jsv_c = jsv if (diag%fms_xyave_diag_id>0) then staggered_in_x = diag%axes%is_u_point .or. diag%axes%is_q_point @@ -1258,39 +1280,50 @@ function get_diag_time_end(diag_cs) get_diag_time_end = diag_cs%time_end end function get_diag_time_end -!> Returns the "diag_mediator" handle for a group (native, CMOR, z-coord, ...) of diagnostics derived from one field. +!> Returns the "diag_mediator" handle for a group (native, CMOR, z-coord, ...) of diagnostics +!! derived from one field. integer function register_diag_field(module_name, field_name, axes, init_time, & long_name, units, missing_value, range, mask_variant, standard_name, & verbose, do_not_log, err_msg, interp_method, tile_count, cmor_field_name, & cmor_long_name, cmor_units, cmor_standard_name, cell_methods, & x_cell_method, y_cell_method, v_cell_method, conversion, v_extensive) - character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or "ice_shelf_model" + character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" + !! or "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field - type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that indicates axes for this field + type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that + !! indicates axes for this field type(time_type), intent(in) :: init_time !< Time at which a field is first available? character(len=*), optional, intent(in) :: long_name !< Long name of a field. character(len=*), optional, intent(in) :: units !< Units of a field. character(len=*), optional, intent(in) :: standard_name !< Standardized name associated with a field real, optional, intent(in) :: missing_value !< A value that indicates missing values. real, optional, intent(in) :: range(2) !< Valid range of a variable (not used in MOM?) - logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with post_data calls (not used in MOM?) + logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with + !! post_data calls (not used in MOM?) logical, optional, intent(in) :: verbose !< If true, FMS is verbose (not used in MOM?) logical, optional, intent(in) :: do_not_log !< If true, do not log something (not used in MOM?) - character(len=*), optional, intent(out):: err_msg !< String into which an error message might be placed (not used in MOM?) - character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not be interpolated as a scalar + character(len=*), optional, intent(out):: err_msg !< String into which an error message might be + !! placed (not used in MOM?) + character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not + !! be interpolated as a scalar integer, optional, intent(in) :: tile_count !< no clue (not used in MOM?) character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name of a field character(len=*), optional, intent(in) :: cmor_long_name !< CMOR long name of a field character(len=*), optional, intent(in) :: cmor_units !< CMOR units of a field character(len=*), optional, intent(in) :: cmor_standard_name !< CMOR standardized name associated with a field - character(len=*), optional, intent(in) :: cell_methods !< String to append as cell_methods attribute. Use '' to have no attribute. - !! If present, this overrides the default constructed from the default for + character(len=*), optional, intent(in) :: cell_methods !< String to append as cell_methods attribute. Use '' to + !! have no attribute. If present, this overrides the + !! default constructed from the default for !! each individual axis direction. - character(len=*), optional, intent(in) :: x_cell_method !< Specifies the cell method for the x-direction. Use '' have no method. - character(len=*), optional, intent(in) :: y_cell_method !< Specifies the cell method for the y-direction. Use '' have no method. - character(len=*), optional, intent(in) :: v_cell_method !< Specifies the cell method for the vertical direction. Use '' have no method. + character(len=*), optional, intent(in) :: x_cell_method !< Specifies the cell method for the x-direction. + !! Use '' have no method. + character(len=*), optional, intent(in) :: y_cell_method !< Specifies the cell method for the y-direction. + !! Use '' have no method. + character(len=*), optional, intent(in) :: v_cell_method !< Specifies the cell method for the vertical direction. + !! Use '' have no method. real, optional, intent(in) :: conversion !< A value to multiply data by before writing to file - logical, optional, intent(in) :: v_extensive !< True for vertically extensive fields (vertically integrated). Default/absent for intensive. + logical, optional, intent(in) :: v_extensive !< True for vertically extensive fields (vertically + !! integrated). Default/absent for intensive. ! Local variables real :: MOM_missing_value type(diag_ctrl), pointer :: diag_cs @@ -1378,31 +1411,40 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, integer, intent(inout) :: dm_id !< The diag_mediator ID for this diagnostic group character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field - type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that indicates axes for this field + type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that indicates axes + !! for this field type(time_type), intent(in) :: init_time !< Time at which a field is first available? character(len=*), optional, intent(in) :: long_name !< Long name of a field. character(len=*), optional, intent(in) :: units !< Units of a field. character(len=*), optional, intent(in) :: standard_name !< Standardized name associated with a field real, optional, intent(in) :: missing_value !< A value that indicates missing values. real, optional, intent(in) :: range(2) !< Valid range of a variable (not used in MOM?) - logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with post_data calls (not used in MOM?) + logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided + !! with post_data calls (not used in MOM?) logical, optional, intent(in) :: verbose !< If true, FMS is verbose (not used in MOM?) logical, optional, intent(in) :: do_not_log !< If true, do not log something (not used in MOM?) - character(len=*), optional, intent(out):: err_msg !< String into which an error message might be placed (not used in MOM?) - character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not be interpolated as a scalar + character(len=*), optional, intent(out):: err_msg !< String into which an error message might be + !! placed (not used in MOM?) + character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should + !! not be interpolated as a scalar integer, optional, intent(in) :: tile_count !< no clue (not used in MOM?) character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name of a field character(len=*), optional, intent(in) :: cmor_long_name !< CMOR long name of a field character(len=*), optional, intent(in) :: cmor_units !< CMOR units of a field character(len=*), optional, intent(in) :: cmor_standard_name !< CMOR standardized name associated with a field - character(len=*), optional, intent(in) :: cell_methods !< String to append as cell_methods attribute. Use '' to have no attribute. - !! If present, this overrides the default constructed from the default for - !! each individual axis direction. - character(len=*), optional, intent(in) :: x_cell_method !< Specifies the cell method for the x-direction. Use '' have no method. - character(len=*), optional, intent(in) :: y_cell_method !< Specifies the cell method for the y-direction. Use '' have no method. - character(len=*), optional, intent(in) :: v_cell_method !< Specifies the cell method for the vertical direction. Use '' have no method. + character(len=*), optional, intent(in) :: cell_methods !< String to append as cell_methods attribute. + !! Use '' to have no attribute. If present, this + !! overrides the default constructed from the default + !! for each individual axis direction. + character(len=*), optional, intent(in) :: x_cell_method !< Specifies the cell method for the x-direction. + !! Use '' have no method. + character(len=*), optional, intent(in) :: y_cell_method !< Specifies the cell method for the y-direction. + !! Use '' have no method. + character(len=*), optional, intent(in) :: v_cell_method !< Specifies the cell method for the vertical direction. + !! Use '' have no method. real, optional, intent(in) :: conversion !< A value to multiply data by before writing to file - logical, optional, intent(in) :: v_extensive !< True for vertically extensive fields (vertically integrated). Default/absent for intensive. + logical, optional, intent(in) :: v_extensive !< True for vertically extensive fields (vertically + !! integrated). Default/absent for intensive. ! Local variables real :: MOM_missing_value type(diag_ctrl), pointer :: diag_cs @@ -1462,9 +1504,9 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, ! For the CMOR variation of the above diagnostic if (present(cmor_field_name)) then ! Fallback values for strings set to "NULL" - posted_cmor_units = "not provided" ! - posted_cmor_standard_name = "not provided" ! Values might be able to be replaced with a CS%missing field? - posted_cmor_long_name = "not provided" ! + posted_cmor_units = "not provided" ! + posted_cmor_standard_name = "not provided" ! Values might be able to be replaced with a CS%missing field? + posted_cmor_long_name = "not provided" ! ! If attributes are present for MOM variable names, use them first for the register_diag_field ! call for CMOR verison of the variable @@ -1478,9 +1520,9 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, if (present(cmor_long_name)) posted_cmor_long_name = cmor_long_name fms_id = register_diag_field_expand_axes(module_name, cmor_field_name, axes, init_time, & - long_name=trim(posted_cmor_long_name), units=trim(posted_cmor_units), & - missing_value=MOM_missing_value, range=range, mask_variant=mask_variant, & - standard_name=trim(posted_cmor_standard_name), verbose=verbose, do_not_log=do_not_log, & + long_name=trim(posted_cmor_long_name), units=trim(posted_cmor_units), & + missing_value=MOM_missing_value, range=range, mask_variant=mask_variant, & + standard_name=trim(posted_cmor_standard_name), verbose=verbose, do_not_log=do_not_log, & err_msg=err_msg, interp_method=interp_method, tile_count=tile_count) call attach_cell_methods(fms_id, axes, cm_string, & cell_methods, x_cell_method, y_cell_method, v_cell_method, & @@ -1496,16 +1538,16 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, if (associated(axes%xyave_axes)) then fms_xyave_id = register_diag_field_expand_axes(module_name, trim(cmor_field_name)//'_xyave', & axes%xyave_axes, init_time, & - long_name=trim(posted_cmor_long_name), units=trim(posted_cmor_units), & - missing_value=MOM_missing_value, range=range, mask_variant=mask_variant, & - standard_name=trim(posted_cmor_standard_name), verbose=verbose, do_not_log=do_not_log, & + long_name=trim(posted_cmor_long_name), units=trim(posted_cmor_units), & + missing_value=MOM_missing_value, range=range, mask_variant=mask_variant, & + standard_name=trim(posted_cmor_standard_name), verbose=verbose, do_not_log=do_not_log, & err_msg=err_msg, interp_method=interp_method, tile_count=tile_count) call attach_cell_methods(fms_xyave_id, axes%xyave_axes, cm_string, & cell_methods, v_cell_method, v_extensive=v_extensive) if (is_root_pe() .and. diag_CS%available_diag_doc_unit > 0) then msg = 'native name is "'//trim(field_name)//'_xyave"' - call log_available_diag(fms_xyave_id>0, module_name, trim(cmor_field_name)//'_xyave', cm_string, & - msg, diag_CS, posted_cmor_long_name, posted_cmor_units, & + call log_available_diag(fms_xyave_id>0, module_name, trim(cmor_field_name)//'_xyave', & + cm_string, msg, diag_CS, posted_cmor_long_name, posted_cmor_units, & posted_cmor_standard_name) endif endif @@ -1522,25 +1564,31 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, end function register_diag_field_expand_cmor -!> Returns an FMS id from register_diag_field_fms (the diag_manager routine) after expanding axes (axes-group) -!! into handles and conditionally adding an FMS area_id for cell_measures. +!> Returns an FMS id from register_diag_field_fms (the diag_manager routine) after expanding axes +!! (axes-group) into handles and conditionally adding an FMS area_id for cell_measures. integer function register_diag_field_expand_axes(module_name, field_name, axes, init_time, & long_name, units, missing_value, range, mask_variant, standard_name, & verbose, do_not_log, err_msg, interp_method, tile_count) - character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or "ice_shelf_model" + character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" + !! or "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field - type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that indicates axes for this field + type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that indicates + !! axes for this field type(time_type), intent(in) :: init_time !< Time at which a field is first available? character(len=*), optional, intent(in) :: long_name !< Long name of a field. character(len=*), optional, intent(in) :: units !< Units of a field. character(len=*), optional, intent(in) :: standard_name !< Standardized name associated with a field real, optional, intent(in) :: missing_value !< A value that indicates missing values. real, optional, intent(in) :: range(2) !< Valid range of a variable (not used in MOM?) - logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with post_data calls (not used in MOM?) + logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided + !! with post_data calls (not used in MOM?) logical, optional, intent(in) :: verbose !< If true, FMS is verbose (not used in MOM?) - logical, optional, intent(in) :: do_not_log !< If true, do not log something (not used in MOM?) - character(len=*), optional, intent(out):: err_msg !< String into which an error message might be placed (not used in MOM?) - character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not be interpolated as a scalar + logical, optional, intent(in) :: do_not_log !< If true, do not log something + !! (not used in MOM?) + character(len=*), optional, intent(out):: err_msg !< String into which an error message might be + !! placed (not used in MOM?) + character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should + !! not be interpolated as a scalar integer, optional, intent(in) :: tile_count !< no clue (not used in MOM?) ! Local variables integer :: fms_id, area_id, volume_id @@ -1624,8 +1672,10 @@ subroutine add_diag_to_list(diag_cs, dm_id, fms_id, this_diag, axes, module_name integer, intent(inout) :: dm_id !< The diag_mediator ID for this diagnostic group integer, intent(in) :: fms_id !< The FMS diag_manager ID for this diagnostic type(diag_type), pointer :: this_diag !< This diagnostic - type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that indicates axes for this field - character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or "ice_shelf_model" + type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that + !! indicates axes for this field + character(len=*), intent(in) :: module_name !< Name of this module, usually + !! "ocean_model" or "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of diagnostic character(len=*), intent(in) :: msg !< Message for errors @@ -1645,15 +1695,21 @@ end subroutine add_diag_to_list subroutine attach_cell_methods(id, axes, ostring, cell_methods, & x_cell_method, y_cell_method, v_cell_method, v_extensive) integer, intent(in) :: id !< Handle to diagnostic - type(axes_grp), intent(in) :: axes !< Container w/ up to 3 integer handles that indicates axes for this field + type(axes_grp), intent(in) :: axes !< Container w/ up to 3 integer handles that indicates + !! axes for this field character(len=*), intent(out) :: ostring !< The cell_methods strings that would appear in the file - character(len=*), optional, intent(in) :: cell_methods !< String to append as cell_methods attribute. Use '' to have no attribute. - !! If present, this overrides the default constructed from the default for - !! each individual axis direction. - character(len=*), optional, intent(in) :: x_cell_method !< Specifies the cell method for the x-direction. Use '' have no method. - character(len=*), optional, intent(in) :: y_cell_method !< Specifies the cell method for the y-direction. Use '' have no method. - character(len=*), optional, intent(in) :: v_cell_method !< Specifies the cell method for the vertical direction. Use '' have no method. - logical, optional, intent(in) :: v_extensive !< True for vertically extensive fields (vertically integrated). Default/absent for intensive. + character(len=*), optional, intent(in) :: cell_methods !< String to append as cell_methods attribute. + !! Use '' to have no attribute. If present, this + !! overrides the default constructed from the default + !! for each individual axis direction. + character(len=*), optional, intent(in) :: x_cell_method !< Specifies the cell method for the x-direction. + !! Use '' have no method. + character(len=*), optional, intent(in) :: y_cell_method !< Specifies the cell method for the y-direction. + !! Use '' have no method. + character(len=*), optional, intent(in) :: v_cell_method !< Specifies the cell method for the vertical direction. + !! Use '' have no method. + logical, optional, intent(in) :: v_extensive !< True for vertically extensive fields + !! (vertically integrated). Default/absent for intensive. ! Local variables character(len=9) :: axis_name logical :: x_mean, y_mean, x_sum, y_sum diff --git a/src/framework/MOM_document.F90 b/src/framework/MOM_document.F90 index 144e10c15d..a6ca5db387 100644 --- a/src/framework/MOM_document.F90 +++ b/src/framework/MOM_document.F90 @@ -739,7 +739,7 @@ end subroutine doc_function subroutine doc_init(docFileBase, doc, minimal, complete, layout, debugging) character(len=*), intent(in) :: docFileBase !< The base file name for this set of parameters, - !! for example MOM_parameter_doc + !! for example MOM_parameter_doc type(doc_type), pointer :: doc !< A pointer to a structure that controls where the !! documentation occurs and its formatting logical, optional, intent(in) :: minimal !< If present and true, write out the files (.short) documenting diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index d708fcdf27..54ce188bb9 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -227,8 +227,9 @@ subroutine create_file(unit, filename, vars, novars, fields, threading, timeunit if ((use_layer .or. use_int) .and. .not.present(GV)) call MOM_error(FATAL, & "create_file: A vertical grid type is required to create a file with a vertical coordinate.") -! Specify all optional arguments to mpp_write_meta: name, units, longname, cartesian, calendar, sense, domain, data, min) -! Otherwise if optional arguments are added to mpp_write_meta the compiler may (and in case of GNU is) get confused and crash. +! Specify all optional arguments to mpp_write_meta: name, units, longname, cartesian, calendar, sense, +! domain, data, min). Otherwise if optional arguments are added to mpp_write_meta the compiler may +! (and in case of GNU does) get confused and crash. if (use_lath) & call mpp_write_meta(unit, axis_lath, name="lath", units=y_axis_units, longname="Latitude", & cartesian='Y', domain = y_domain, data=gridLatT(jsg:jeg)) @@ -635,19 +636,19 @@ end function var_desc !! All arguments are optional, except the vardesc type to be modified. subroutine modify_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, & cmor_field_name, cmor_units, cmor_longname, conversion, caller) - type(vardesc), intent(inout) :: vd !< vardesc type that is modified - character(len=*), optional, intent(in) :: name !< name of variable - character(len=*), optional, intent(in) :: units !< units of variable - character(len=*), optional, intent(in) :: longname !< long name of variable - character(len=*), optional, intent(in) :: hor_grid !< horizonal staggering of variable - character(len=*), optional, intent(in) :: z_grid !< vertical staggering of variable - character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1 - character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name - character(len=*), optional, intent(in) :: cmor_units !< CMOR physical dimensions of variable - character(len=*), optional, intent(in) :: cmor_longname !< CMOR long name - real , optional, intent(in) :: conversion !< for unit conversions, such as needed to - !! convert from intensive to extensive - character(len=*), optional, intent(in) :: caller !< calling routine? + type(vardesc), intent(inout) :: vd !< vardesc type that is modified + character(len=*), optional, intent(in) :: name !< name of variable + character(len=*), optional, intent(in) :: units !< units of variable + character(len=*), optional, intent(in) :: longname !< long name of variable + character(len=*), optional, intent(in) :: hor_grid !< horizonal staggering of variable + character(len=*), optional, intent(in) :: z_grid !< vertical staggering of variable + character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1 + character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name + character(len=*), optional, intent(in) :: cmor_units !< CMOR physical dimensions of variable + character(len=*), optional, intent(in) :: cmor_longname !< CMOR long name + real , optional, intent(in) :: conversion !< for unit conversions, such as needed + !! to convert from intensive to extensive + character(len=*), optional, intent(in) :: caller !< calling routine? character(len=120) :: cllr cllr = "mod_vardesc" diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 4004801a02..52436cf827 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -1,6 +1,6 @@ !> Implements the thermodynamic aspects of ocean / ice-shelf interactions, -! along with a crude placeholder for a later implementation of full -! ice shelf dynamics, all using the MOM framework and coding style. +!! along with a crude placeholder for a later implementation of full +!! ice shelf dynamics, all using the MOM framework and coding style. module MOM_ice_shelf ! This file is part of MOM6. See LICENSE.md for the license. @@ -150,7 +150,8 @@ module MOM_ice_shelf !!! OVS !!! t_boundary_values => NULL(), & - taub_beta_eff_bilinear => NULL(), & ! nonlinear part of "linearized" basal stress - exact form depends on basal law exponent + taub_beta_eff_bilinear => NULL(), & ! nonlinear part of "linearized" basal stress - + ! exact form depends on basal law exponent ! and/or whether flow is "hybridized" a la Goldberg 2011 taub_beta_eff_lower_tri => NULL(), & taub_beta_eff_upper_tri => NULL(), & @@ -233,7 +234,8 @@ module MOM_ice_shelf ! ~ once a day (maybe longer) because it will depend on ocean values ! that are averaged over this time interval, and the solve will begin ! to lose meaning if it is done too frequently - integer :: velocity_update_sub_counter ! there is no outer loop for the velocity solve; the counter will have to be stored + integer :: velocity_update_sub_counter ! there is no outer loop for the velocity solve; + ! the counter will have to be stored integer :: velocity_update_counter ! the "outer" timestep number integer :: nstep_velocity ! ~ (velocity_update_time_step / time_step) @@ -812,7 +814,8 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) CS%velocity_update_sub_counter = CS%velocity_update_sub_counter+1 if (CS%GL_couple .and. .not. CS%solo_ice_sheet) then - call update_OD_ffrac (CS, state%ocean_mass, CS%velocity_update_sub_counter, CS%nstep_velocity, CS%time_step, CS%velocity_update_time_step) + call update_OD_ffrac(CS, state%ocean_mass, CS%velocity_update_sub_counter, CS%nstep_velocity, & + CS%time_step, CS%velocity_update_time_step) else call update_OD_ffrac_uncoupled (CS) endif @@ -3192,8 +3195,8 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ ! i may not cover all the cases.. but i cover the realistic ones - if (at_west_bdry .AND. (hmask(i-1,j).eq.3)) then ! at western bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_west_bdry .AND. (hmask(i-1,j).eq.3)) then ! at western bdry but there is a + ! thickness bdry condition, and the stencil contains it stencil (-1) = CS%thickness_boundary_values(i-1,j) flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(-1) / dxdyh @@ -3240,8 +3243,8 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ if (u_face .lt. 0) then !flux is into cell - we need info from h(i+2), h(i+1) if available - if (at_east_bdry .AND. (hmask(i+1,j).eq.3)) then ! at eastern bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_east_bdry .AND. (hmask(i+1,j).eq.3)) then ! at eastern bdry but there is a + ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(1) / dxdyh @@ -3302,13 +3305,15 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ endif if ((i .eq. is) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i-1,j) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered hmask(i,j) = 2 elseif ((i .eq. ie) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i+1,j) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered hmask(i,j) = 2 @@ -3423,8 +3428,8 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v ! i may not cover all the cases.. but i cover the realistic ones - if (at_south_bdry .AND. (hmask(i,j-1).eq.3)) then ! at western bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_south_bdry .AND. (hmask(i,j-1).eq.3)) then ! at western bdry but there is a + ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(-1) / dxdyh elseif (hmask(i,j-1) * hmask(i,j-2) .eq. 1) then ! h(j-2) and h(j-1) are valid @@ -3471,8 +3476,8 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v if (v_face .lt. 0) then !flux is into cell - we need info from h(j+2), h(j+1) if available - if (at_north_bdry .AND. (hmask(i,j+1).eq.3)) then ! at eastern bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_north_bdry .AND. (hmask(i,j+1).eq.3)) then ! at eastern bdry but there is a + ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(1) / dxdyh elseif (hmask(i,j+1) * hmask(i,j+2) .eq. 1) then ! h(j+2) and h(j+1) are valid phi = slope_limiter (stencil(1)-stencil(2), stencil(0)-stencil(1)) @@ -3522,12 +3527,14 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v endif if ((j .eq. js) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i,j-1) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered hmask (i,j) = 2 elseif ((j .eq. je) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i,j+1) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered hmask (i,j) = 2 endif @@ -3809,7 +3816,8 @@ subroutine calc_shelf_driving_stress (CS, TAUD_X, TAUD_Y, OD, FE) real :: rho, rhow, sx, sy, neumann_val, dxh, dyh, dxdyh type(ocean_grid_type), pointer :: G - integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq, giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec + integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq + integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec integer :: i_off, j_off G => CS%grid @@ -3983,28 +3991,35 @@ subroutine calc_shelf_driving_stress (CS, TAUD_X, TAUD_Y, OD, FE) endif - if ((u_face_mask(i-1,j) .eq. 2) .OR. (hmask(i-1,j) .eq. 0) .OR. (hmask(i-1,j) .eq. 2) ) then ! left face of the cell is at a stress boundary - ! the depth-integrated longitudinal stress is equal to the difference of depth-integrated pressure on either side of the face + if ((u_face_mask(i-1,j) .eq. 2) .OR. (hmask(i-1,j) .eq. 0) .OR. (hmask(i-1,j) .eq. 2) ) then + ! left face of the cell is at a stress boundary + ! the depth-integrated longitudinal stress is equal to the difference of depth-integrated + ! pressure on either side of the face ! on the ice side, it is rho g h^2 / 2 ! on the ocean side, it is rhow g (delta OD)^2 / 2 - ! OD can be zero under the ice; but it is ASSUMED on the ice-free side of the face, topography elevation is not above the base of the - ! ice in the current cell - taud_x(i-1,j-1) = taud_x(i-1,j-1) - .5 * dyh * neumann_val ! note negative sign is due to direction of normal vector + ! OD can be zero under the ice; but it is ASSUMED on the ice-free side of the face, topography elevation + ! is not above the base of the ice in the current cell + + ! note negative sign due to direction of normal vector + taud_x(i-1,j-1) = taud_x(i-1,j-1) - .5 * dyh * neumann_val taud_x(i-1,j) = taud_x(i-1,j) - .5 * dyh * neumann_val endif - if ((u_face_mask(i,j) .eq. 2) .OR. (hmask(i+1,j) .eq. 0) .OR. (hmask(i+1,j) .eq. 2) ) then ! right face of the cell is at a stress boundary + if ((u_face_mask(i,j) .eq. 2) .OR. (hmask(i+1,j) .eq. 0) .OR. (hmask(i+1,j) .eq. 2) ) then + ! right face of the cell is at a stress boundary taud_x(i,j-1) = taud_x(i,j-1) + .5 * dyh * neumann_val taud_x(i,j) = taud_x(i,j) + .5 * dyh * neumann_val endif - if ((v_face_mask(i,j-1) .eq. 2) .OR. (hmask(i,j-1) .eq. 0) .OR. (hmask(i,j-1) .eq. 2) ) then ! south face of the cell is at a stress boundary + if ((v_face_mask(i,j-1) .eq. 2) .OR. (hmask(i,j-1) .eq. 0) .OR. (hmask(i,j-1) .eq. 2) ) then + ! south face of the cell is at a stress boundary taud_y(i-1,j-1) = taud_y(i-1,j-1) - .5 * dxh * neumann_val taud_y(i,j-1) = taud_y(i,j-1) - .5 * dxh * neumann_val endif - if ((v_face_mask(i,j) .eq. 2) .OR. (hmask(i,j+1) .eq. 0) .OR. (hmask(i,j+1) .eq. 2) ) then ! north face of the cell is at a stress boundary - taud_y(i-1,j) = taud_y(i-1,j) + .5 * dxh * neumann_val ! note negative sign is due to direction of normal vector + if ((v_face_mask(i,j) .eq. 2) .OR. (hmask(i,j+1) .eq. 0) .OR. (hmask(i,j+1) .eq. 2) ) then + ! north face of the cell is at a stress boundary + taud_y(i-1,j) = taud_y(i-1,j) + .5 * dxh * neumann_val ! note negative sign due to direction of normal vector taud_y(i,j) = taud_y(i,j) + .5 * dxh * neumann_val endif @@ -4037,7 +4052,8 @@ subroutine init_boundary_values (CS, time, input_flux, input_thick, new_sim) v_boundary_values, & u_face_mask, v_face_mask, hmask type(ocean_grid_type), pointer :: G - integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq, giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec + integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq + integer :: gjec, gisc, gjsc, cnt, isc, jsc, iec, jec integer :: i_off, j_off real :: A, n, ux, uy, vx, vy, eps_min, domain_width @@ -4399,7 +4415,8 @@ subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmas endif Ucontr(iphi,jphi) = Ucontr(iphi,jphi) + .25 * area * uq * xquad(ilq) * xquad(jlq) * beta(i,j) -! if((i.eq.27) .and. (j.eq.8) .and. (iphi.eq.1) .and. (jphi.eq.1)) print *, "grid", uq, .25 * area * uq * xquad(ilq) * xquad(jlq) +! if((i.eq.27) .and. (j.eq.8) .and. (iphi.eq.1) .and. (jphi.eq.1)) & +! print *, "grid", uq, .25 * area * uq * xquad(ilq) * xquad(jlq) !endif enddo ; enddo @@ -4416,7 +4433,8 @@ subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmas endif if (vmask (i-2+iphi,j-2+jphi) .eq. 1) then vret (i-2+iphi,j-2+jphi) = vret (i-2+iphi,j-2+jphi) + Vsubcontr (iphi,jphi) * beta(i,j) - !if ( (iphi.eq.1) .and. (jphi.eq.1)) print *, i,j, Usubcontr (iphi,jphi) * beta(i,j), " ", Ucontr(iphi,jphi) + !if ( (iphi.eq.1) .and. (jphi.eq.1)) 8 + ! print *, i,j, Usubcontr (iphi,jphi) * beta(i,j), " ", Ucontr(iphi,jphi) endif enddo ; enddo endif @@ -4470,8 +4488,8 @@ subroutine CG_action_subgrid_basal_bilinear (Phisub, H, U, V, DXDYH, D, dens_rat uq = 0 ; vq = 0 do k=1,2 do l=1,2 - !Ucontr (m,n) = Ucontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * Phisub(i,j,k,l,qx,qy) * U(k,l) - !Vcontr (m,n) = Vcontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * Phisub(i,j,k,l,qx,qy) * V(k,l) + !Ucontr(m,n) = Ucontr(m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * Phisub(i,j,k,l,qx,qy) * U(k,l) + !Vcontr(m,n) = Vcontr(m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * Phisub(i,j,k,l,qx,qy) * V(k,l) uq = uq + Phisub(i,j,k,l,qx,qy) * U(k,l) ; vq = vq + Phisub(i,j,k,l,qx,qy) * V(k,l) enddo enddo @@ -4479,7 +4497,8 @@ subroutine CG_action_subgrid_basal_bilinear (Phisub, H, U, V, DXDYH, D, dens_rat Ucontr (m,n) = Ucontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * uq Vcontr (m,n) = Vcontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * vq - ! if ((i_m .eq. 27) .and. (j_m .eq. 8) .and. (m.eq.1) .and. (n.eq.1)) print *, "in subgrid", uq, Phisub(i,j,m,n,qx,qy) + ! if ((i_m .eq. 27) .and. (j_m .eq. 8) .and. (m.eq.1) .and. (n.eq.1)) & + print *, "in subgrid", uq, Phisub(i,j,m,n,qx,qy) endif @@ -5009,7 +5028,8 @@ subroutine apply_boundary_values_triangle (CS, time, u_boundary_contr, v_boundar end subroutine apply_boundary_values_triangle -subroutine apply_boundary_values_bilinear (CS, time, Phisub, H_node, float_cond, dens_ratio, u_boundary_contr, v_boundary_contr) +subroutine apply_boundary_values_bilinear(CS, time, Phisub, H_node, float_cond, dens_ratio, & + u_boundary_contr, v_boundary_contr) type(time_type), intent(in) :: Time real, dimension (:,:,:,:,:,:),pointer:: Phisub @@ -5207,7 +5227,8 @@ subroutine calc_shelf_visc_triangular (CS,u,v) hmask type(ocean_grid_type), pointer :: G - integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq, giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js + integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed + integer :: iegq, jegq, giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js real :: A, n, ux, uy, vx, vy, eps_min, umid, vmid, unorm, C_basal_friction, n_basal_friction, dxh, dyh, dxdyh G => CS%grid @@ -5253,7 +5274,8 @@ subroutine calc_shelf_visc_triangular (CS,u,v) nu_lower(i,j) = A**(-1/n) * (ux**2+vy**2+ux*vy+0.25*(uy+vx)**2+eps_min**2) ** ((1-n)/(2*n)) * H(i,j) umid = 1./3 * (u(i-1,j-1)+u(i-1,j)+u(i,j-1)) vmid = 1./3 * (v(i-1,j-1)+v(i-1,j)+v(i,j-1)) - unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) ; beta_eff_lower (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) + unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) + beta_eff_lower (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) ux = (u(i,j)-u(i-1,j)) / dxh vx = (v(i,j)-v(i-1,j)) / dxh @@ -5263,7 +5285,8 @@ subroutine calc_shelf_visc_triangular (CS,u,v) nu_upper(i,j) = A**(-1/n) * (ux**2+vy**2+ux*vy+0.25*(uy+vx)**2+eps_min**2) ** ((1-n)/(2*n)) * H(i,j) umid = 1./3 * (u(i,j)+u(i-1,j)+u(i,j-1)) vmid = 1./3 * (v(i,j)+v(i-1,j)+v(i,j-1)) - unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) ; beta_eff_upper (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) + unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) + beta_eff_upper (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) endif enddo @@ -5288,7 +5311,8 @@ subroutine calc_shelf_visc_bilinear (CS, u, v) hmask type(ocean_grid_type), pointer :: G - integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq, giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js + integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq + integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js real :: A, n, ux, uy, vx, vy, eps_min, umid, vmid, unorm, C_basal_friction, n_basal_friction, dxh, dyh, dxdyh G => CS%grid @@ -5562,12 +5586,14 @@ subroutine update_velocity_masks (CS) ! sets masks for velocity solve ! ignores the fact that their might be ice-free cells - this only considers the computational boundary - ! !!!!IMPORTANT!!!! relies on thickness mask - assumed that this is called after hmask has been updated (and halo-updated) + ! !!!IMPORTANT!!! relies on thickness mask - assumed that this is called after hmask has been updated & halo-updated - integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq, giec, gjec, gisc, gjsc, isc, jsc, iec, jec, k + integer :: isym, i, j, k, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq + integer :: giec, gjec, gisc, gjsc, isc, jsc, iec, jec integer :: i_off, j_off type(ocean_grid_type), pointer :: G => NULL() - real, dimension(:,:), pointer :: umask, vmask, u_face_mask, v_face_mask, hmask, u_face_mask_boundary, v_face_mask_boundary + real, dimension(:,:), pointer :: umask, vmask, u_face_mask, v_face_mask, hmask + real, dimension(:,:), pointer :: u_face_mask_boundary, v_face_mask_boundary G => CS%grid isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec @@ -6027,7 +6053,8 @@ subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) ! t_after_uflux - an array containing the temperature after advection in u-direction ! t_after_vflux - similar ! -! This subroutine takes the velocity (on the Bgrid) and timesteps (HT)_t = - div (uHT) + (adot Tsurd -bdot Tbot) once and then calculates T=HT/H +! This subroutine takes the velocity (on the Bgrid) and timesteps +! (HT)_t = - div (uHT) + (adot Tsurd -bdot Tbot) once and then calculates T=HT/H ! ! The flux overflows are included here. That is because they will be used to advect 3D scalars ! into partial cells @@ -6271,8 +6298,8 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter ! i may not cover all the cases.. but i cover the realistic ones - if (at_west_bdry .AND. (hmask(i-1,j).eq.3)) then ! at western bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_west_bdry .AND. (hmask(i-1,j).eq.3)) then ! at western bdry but there is a + ! thickness bdry condition, and the stencil contains it stencil (-1) = CS%t_boundary_values(i-1,j)*CS%h_shelf(i-1,j) flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(-1) / dxdyh @@ -6322,8 +6349,8 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter if (u_face .lt. 0) then !flux is into cell - we need info from h(i+2), h(i+1) if available - if (at_east_bdry .AND. (hmask(i+1,j).eq.3)) then ! at eastern bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_east_bdry .AND. (hmask(i+1,j).eq.3)) then ! at eastern bdry but there is a + ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(1) / dxdyh @@ -6372,7 +6399,8 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter if (at_west_bdry .AND. (hmask(i-1,j) .EQ. 3)) then u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - flux_enter (i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * t_boundary(i-1,j)*CS%thickness_boundary_values(i+1,j) + flux_enter (i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * t_boundary(i-1,j)* & + CS%thickness_boundary_values(i+1,j) elseif (u_face_mask (i-1,j) .eq. 4.) then flux_enter (i,j,1) = G%dyT(i,j) * time_step * u_flux_boundary_values (i-1,j)*t_boundary(i-1,j) ! flux_enter (i,j,1) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*t_boundary (i-1,j) @@ -6381,7 +6409,8 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter if (at_east_bdry .AND. (hmask(i+1,j) .EQ. 3)) then u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) - flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * t_boundary(i+1,j)*CS%thickness_boundary_values(i+1,j) + flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * t_boundary(i+1,j)* & + CS%thickness_boundary_values(i+1,j) elseif (u_face_mask (i+1,j) .eq. 4.) then flux_enter (i,j,2) = G%dyT(i,j) * time_step * u_flux_boundary_values (i+1,j) * t_boundary(i+1,j) ! assume no flux bc for temp @@ -6389,14 +6418,14 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter endif ! if ((i .eq. is) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i-1,j) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered - + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered ! hmask(i,j) = 2 ! elseif ((i .eq. ie) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i+1,j) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered - + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered ! hmask(i,j) = 2 ! endif @@ -6500,7 +6529,8 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, if (v_face_mask (i,j-1) .eq. 4.) then - flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values (i,j-1) * t_boundary(i,j-1)/ dxdyh + flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values (i,j-1) * & + t_boundary(i,j-1)/ dxdyh ! assume no flux bc for temp ! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*t_boundary (i,j-1) / dxdyh @@ -6513,8 +6543,8 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, ! i may not cover all the cases.. but i cover the realistic ones - if (at_south_bdry .AND. (hmask(i,j-1).eq.3)) then ! at western bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_south_bdry .AND. (hmask(i,j-1).eq.3)) then ! at western bdry but there is a + ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(-1) / dxdyh elseif (hmask(i,j-1) * hmask(i,j-2) .eq. 1) then ! h(j-2) and h(j-1) are valid @@ -6564,8 +6594,8 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, if (v_face .lt. 0) then !flux is into cell - we need info from h(j+2), h(j+1) if available - if (at_north_bdry .AND. (hmask(i,j+1).eq.3)) then ! at eastern bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_north_bdry .AND. (hmask(i,j+1).eq.3)) then ! at eastern bdry but there is a + ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(1) / dxdyh elseif (hmask(i,j+1) * hmask(i,j+2) .eq. 1) then ! h(j+2) and h(j+1) are valid phi = slope_limiter (stencil(1)-stencil(2), stencil(0)-stencil(1)) @@ -6602,7 +6632,8 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, if (at_south_bdry .AND. (hmask(i,j-1) .EQ. 3)) then v_face = 0.5 * (CS%v_shelf(i-1,j-1) + CS%v_shelf(i,j-1)) - flux_enter (i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * t_boundary(i,j-1)*CS%thickness_boundary_values(i,j-1) + flux_enter (i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * t_boundary(i,j-1)* & + CS%thickness_boundary_values(i,j-1) elseif (v_face_mask(i,j-1) .eq. 4.) then flux_enter (i,j,3) = G%dxT(i,j) * time_step * v_flux_boundary_values (i,j-1)*t_boundary(i,j-1) ! assume no flux bc for temp @@ -6612,7 +6643,8 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, if (at_north_bdry .AND. (hmask(i,j+1) .EQ. 3)) then v_face = 0.5 * (CS%v_shelf(i-1,j) + CS%v_shelf(i,j)) - flux_enter (i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * t_boundary(i,j+1)*CS%thickness_boundary_values(i,j+1) + flux_enter (i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * t_boundary(i,j+1)* & + CS%thickness_boundary_values(i,j+1) elseif (v_face_mask(i,j+1) .eq. 4.) then flux_enter (i,j,4) = G%dxT(i,j) * time_step * v_flux_boundary_values (i,j+1)*t_boundary(i,j+1) ! assume no flux bc for temp @@ -6620,12 +6652,14 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, endif ! if ((j .eq. js) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i,j-1) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered ! hmask (i,j) = 2 ! elseif ((j .eq. je) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i,j+1) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered + ! this is solely for the purposes of keeping the mask consistent while advancing the + ! front without having to call pass_var - if cell is empty and cell to left is + ! ice-covered then this cell will become partly covered ! hmask (i,j) = 2 ! endif @@ -6674,7 +6708,8 @@ end subroutine ice_shelf_advect_temp_y !! calc_shelf_driving_stress - Determine the driving stresses using h_shelf, (water) column thickness, bathymetry !! - does not modify any permanent arrays !! init_boundary_values - -!! bilinear_shape_functions - shape function for FEM solve using (convex) quadrilateral elements and bilinear nodal basis +!! bilinear_shape_functions - shape function for FEM solve using (convex) quadrilateral elements and +!! bilinear nodal basis !! calc_shelf_visc_bilinear - Glen's law viscosity and nonlinear sliding law (called by ice_shelf_solve_outer) !! calc_shelf_visc_triangular - LET'S TAKE THIS OUT !! apply_boundary_values_bilinear - same as CG_action_bilinear, but input is zero except for dirichlet bdry conds diff --git a/src/ice_shelf/shelf_triangular_FEstuff.F90 b/src/ice_shelf/shelf_triangular_FEstuff.F90 index 72c0043ebf..6829774386 100644 --- a/src/ice_shelf/shelf_triangular_FEstuff.F90 +++ b/src/ice_shelf/shelf_triangular_FEstuff.F90 @@ -67,8 +67,8 @@ module shelf_triangular_FEstuff v_boundary_values => NULL(), & - taub_beta_eff_bilinear => NULL(), & ! nonlinear part of "linearized" basal stress - exact form depends on basal law exponent - ! and/or whether flow is "hybridized" a la Goldberg 2011 + taub_beta_eff_bilinear => NULL(), & ! nonlinear part of "linearized" basal stress - exact form depends on basal + ! law exponent and/or whether flow is "hybridized" a la Goldberg 2011 taub_beta_eff_lower_tri => NULL(), & taub_beta_eff_upper_tri => NULL(), & @@ -124,7 +124,8 @@ module shelf_triangular_FEstuff ! ~ once a day (maybe longer) because it will depend on ocean values ! that are averaged over this time interval, and the solve will begin ! to lose meaning if it is done too frequently - integer :: velocity_update_sub_counter ! there is no outer loop for the velocity solve; the counter will have to be stored + integer :: velocity_update_sub_counter ! there is no outer loop for the velocity solve; + ! the counter will have to be stored integer :: velocity_update_counter ! the "outer" timestep number integer :: nstep_velocity ! ~ (velocity_update_time_step / time_step) @@ -518,7 +519,8 @@ end subroutine matrix_diagonal_triangle !~ hmask !~ type(ocean_grid_type), pointer :: G - !~ integer :: 0, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq, giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js + !~ integer :: 0, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq + !~ integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js !~ real :: A, n, ux, uy, vx, vy, eps_min, umid, vmid, unorm, C_basal_friction, n_basal_friction, dxh, dyh, dxdyh !~ G => CS%grid @@ -558,7 +560,8 @@ end subroutine matrix_diagonal_triangle !~ nu_lower(i,j) = A**(-1/n) * (ux**2+vy**2+ux*vy.25*(uy+vx)**2+eps_min**2) ** ((1-n)/(2*n)) * H(i,j) !~ umid = 1./3 * (u(i-1,j-1)+u(i-1,j)+u(i,j-1)) !~ vmid = 1./3 * (v(i-1,j-1)+v(i-1,j)+v(i,j-1)) - !~ unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) ; beta_eff_lower (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) + !~ unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) + !~ beta_eff_lower (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) !~ ux = (u(i,j)-u(i-1,j)) / dxh !~ vx = (v(i,j)-v(i-1,j)) / dxh @@ -568,7 +571,8 @@ end subroutine matrix_diagonal_triangle !~ nu_upper(i,j) = A**(-1/n) * (ux**2+vy**2+ux*vy.25*(uy+vx)**2+eps_min**2) ** ((1-n)/(2*n)) * H(i,j) !~ umid = 1./3 * (u(i,j)+u(i-1,j)+u(i,j-1)) !~ vmid = 1./3 * (v(i,j)+v(i-1,j)+v(i,j-1)) - !~ unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) ; beta_eff_upper (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) + !~ unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) + !~ beta_eff_upper (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) !~ endif !~ enddo diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 4ef3af5949..b26e13b61e 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -268,8 +268,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & " \t USER - call a user modified routine.", & fail_if_missing=new_sim, do_not_log=just_read) select case (trim(config)) - case ("file"); call initialize_thickness_from_file(h, G, GV, PF, .false., just_read_params=just_read) - case ("thickness_file"); call initialize_thickness_from_file(h, G, GV, PF, .true., just_read_params=just_read) + case ("file") + call initialize_thickness_from_file(h, G, GV, PF, .false., just_read_params=just_read) + case ("thickness_file") + call initialize_thickness_from_file(h, G, GV, PF, .true., just_read_params=just_read) case ("coord") if (new_sim .and. useALE) then call ALE_initThicknessToCoord( ALE_CSp, G, GV, h ) @@ -469,7 +471,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & call get_param(PF, mdl, "DT", dt, "Timestep", fail_if_missing=.true.) - call ALE_regrid_accelerated(ALE_CSp, G, GV, h, tv, regrid_iterations, u, v, tracer_Reg, dt=dt, initial=.true.) + call ALE_regrid_accelerated(ALE_CSp, G, GV, h, tv, regrid_iterations, u, v, tracer_Reg, & + dt=dt, initial=.true.) endif endif ! This is the end of the block of code that might have initialized fields @@ -613,19 +616,11 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. -! Arguments: h - The thickness that is being initialized. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) file_has_thickness - If true, this file contains thicknesses; -! otherwise it contains interface heights. - ! This subroutine reads the layer thicknesses from file. real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) integer :: inconsistent = 0 logical :: correct_thickness - logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate + logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "initialize_thickness_from_file" ! This subroutine's name. character(len=200) :: filename, thickness_file, inputdir, mesg ! Strings for file/path integer :: i, j, k, is, ie, js, je, nz @@ -709,8 +704,8 @@ end subroutine initialize_thickness_from_file subroutine adjustEtaToFitBathymetry(G, GV, eta, h) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)+1), intent(inout) :: eta !< Interface heights, in m - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: eta !< Interface heights, in m + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H ! Local variables integer :: i, j, k, is, ie, js, je, nz, contractions, dilations real, parameter :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria (m) @@ -789,19 +784,13 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. -! Arguments: h - The thickness that is being initialized. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. - ! This subroutine initializes the layer thicknesses to be uniform. character(len=40) :: mdl = "initialize_thickness_uniform" ! This subroutine's name. real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! ! negative because it is positive upward. ! real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! ! positive upward, in m. ! - logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate + logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -864,7 +853,7 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) ! negative because it is positive upward. ! real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! ! positive upward, in m. ! - logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate + logical :: just_read ! If true, just read parameters but set nothing. character(len=200) :: filename, eta_file, inputdir ! Strings for file/path character(len=72) :: eta_var integer :: i, j, k, is, ie, js, je, nz @@ -937,7 +926,7 @@ end subroutine initialize_thickness_search subroutine convert_thickness(h, G, GV, tv) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Input eometric layer thicknesses (in H units), !! being converted to layer pressure !! thicknesses (also in H units). @@ -1016,7 +1005,7 @@ end subroutine convert_thickness subroutine depress_surface(h, G, GV, param_file, tv, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables @@ -1119,8 +1108,8 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) ! Local variables character(len=200) :: mdl = "trim_for_ice" real, dimension(SZI_(G),SZJ_(G)) :: p_surf ! Imposed pressure on ocean at surface (Pa) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: S_t, S_b, T_t, T_b ! Top and bottom edge values for reconstructions - ! of salinity and temperature within each layer. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: S_t, S_b ! Top and bottom edge values for reconstructions + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_t, T_b ! of salinity and temperature within each layer. character(len=200) :: inputdir, filename, p_surf_file, p_surf_var ! Strings for file/path real :: scale_factor, min_thickness integer :: i, j, k @@ -1264,8 +1253,10 @@ end subroutine cut_off_column_top ! ----------------------------------------------------------------------------- subroutine initialize_velocity_from_file(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZIB_(G),SZJ_(G), SZK_(G)), intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 - real, dimension(SZI_(G),SZJB_(G), SZK_(G)), intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1308,8 +1299,10 @@ end subroutine initialize_velocity_from_file ! ----------------------------------------------------------------------------- subroutine initialize_velocity_zero(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZIB_(G),SZJ_(G), SZK_(G)), intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 - real, dimension(SZI_(G),SZJB_(G), SZK_(G)), intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1346,8 +1339,10 @@ end subroutine initialize_velocity_zero ! ----------------------------------------------------------------------------- subroutine initialize_velocity_uniform(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZIB_(G),SZJ_(G), SZK_(G)), intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 - real, dimension(SZI_(G),SZJB_(G), SZK_(G)), intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1389,8 +1384,10 @@ end subroutine initialize_velocity_uniform ! ----------------------------------------------------------------------------- subroutine initialize_velocity_circular(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZIB_(G),SZJ_(G), SZK_(G)), intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 - real, dimension(SZI_(G),SZJB_(G), SZK_(G)), intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1451,8 +1448,8 @@ end subroutine initialize_velocity_circular ! ----------------------------------------------------------------------------- subroutine initialize_temp_salt_from_file(T, S, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< The potential temperature that is being initialized. - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< The salinity that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is being initialized. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. @@ -1516,7 +1513,8 @@ end subroutine initialize_temp_salt_from_file ! ----------------------------------------------------------------------------- subroutine initialize_temp_salt_from_profile(T, S, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T, S + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is being initialized. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. @@ -1571,11 +1569,8 @@ end subroutine initialize_temp_salt_from_profile subroutine initialize_temp_salt_fit(T, S, G, GV, param_file, eqn_of_state, P_Ref, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & - intent(out) :: T !< The potential temperature that is being - !! initialized. - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & - intent(out) :: S !< The salinity that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is being initialized. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(EOS_type), pointer :: eqn_of_state !< Integer that selects the equatio of state. @@ -1669,14 +1664,15 @@ end subroutine initialize_temp_salt_fit ! ----------------------------------------------------------------------------- subroutine initialize_temp_salt_linear(T, S, G, param_file, just_read_params) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T, S - type(param_file_type), intent(in) :: param_file !< A structure to parse for - !! run-time parameters - logical, optional, intent(in) :: just_read_params !< If present and true, - !! this call will only read - !! parameters without - !! changing h. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is being initialized. + type(param_file_type), intent(in) :: param_file !< A structure to parse for + !! run-time parameters + logical, optional, intent(in) :: just_read_params !< If present and true, + !! this call will only read + !! parameters without + !! changing h. ! This subroutine initializes linear profiles for T and S according to ! reference surface layer salinity and temperature and a specified range. @@ -2266,7 +2262,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) h1(i,j,k) = GV%m_to_H * (zTopOfCell - zBottomOfCell) zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo - h1(i,j,kd) = h1(i,j,kd) + GV%m_to_H * max(0., zTopOfCell + G%bathyT(i,j) ) ! In case data is shallower than model + h1(i,j,kd) = h1(i,j,kd) + GV%m_to_H * max(0., zTopOfCell + G%bathyT(i,j) ) + ! The max here is in case the data data is shallower than model endif ! mask2dT enddo ; enddo deallocate( tmp_mask_in ) @@ -2317,8 +2314,10 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) endif deallocate( dz_interface ) endif - call ALE_remap_scalar( remapCS, G, GV, nkd, h1, tmpT1dIn, h, tv%T, all_cells=remap_full_column, old_remap=remap_old_alg ) - call ALE_remap_scalar( remapCS, G, GV, nkd, h1, tmpS1dIn, h, tv%S, all_cells=remap_full_column, old_remap=remap_old_alg ) + call ALE_remap_scalar(remapCS, G, GV, nkd, h1, tmpT1dIn, h, tv%T, all_cells=remap_full_column, & + old_remap=remap_old_alg ) + call ALE_remap_scalar(remapCS, G, GV, nkd, h1, tmpS1dIn, h, tv%S, all_cells=remap_full_column, & + old_remap=remap_old_alg ) deallocate( h1 ) deallocate( tmpT1dIn ) deallocate( tmpS1dIn ) @@ -2452,7 +2451,8 @@ subroutine MOM_state_init_tests(G, GV, tv) S_t(k) = 35.-(0./500.)*e(k) S(k) = 35.+(0./500.)*z(k) S_b(k) = 35.-(0./500.)*e(k+1) - call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -GV%Rho0*GV%g_Earth*z(k), rho(k), tv%eqn_of_state) + call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -GV%Rho0*GV%g_Earth*z(k), & + rho(k), tv%eqn_of_state) P_tot = P_tot + GV%g_Earth * rho(k) * h(k) enddo diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index d322e115c9..f60e4ce013 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -259,13 +259,17 @@ subroutine init_oda(Time, G, GV, CS) call set_axes_info(CS%Grid,CS%GV,PF,CS%diag_cs,set_vertical=.true.) do n=1,CS%ensemble_size write(fldnam,'(a,i2.2)') 'temp_prior_',n - CS%Ocean_prior%id_t(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time,'ocean potential temperature','degC') + CS%Ocean_prior%id_t(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & + 'ocean potential temperature','degC') write(fldnam,'(a,i2.2)') 'salt_prior_',n - CS%Ocean_prior%id_s(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time,'ocean salinity','psu') + CS%Ocean_prior%id_s(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & + 'ocean salinity','psu') write(fldnam,'(a,i2.2)') 'temp_posterior_',n - CS%Ocean_posterior%id_t(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time,'ocean potential temperature','degC') + CS%Ocean_posterior%id_t(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & + 'ocean potential temperature','degC') write(fldnam,'(a,i2.2)') 'salt_posterior_',n - CS%Ocean_posterior%id_s(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time,'ocean salinity','psu') + CS%Ocean_posterior%id_s(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & + 'ocean salinity','psu') enddo call mpp_get_data_domain(CS%mpp_domain,isd,ied,jsd,jed) @@ -366,8 +370,10 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) CS%mpp_domain, CS%Ocean_prior%T(:,:,:,m), complete=.true.) call mpp_redistribute(CS%domains(m)%mpp_domain, S,& CS%mpp_domain, CS%Ocean_prior%S(:,:,:,m), complete=.true.) - if (CS%Ocean_prior%id_t(m)>0) used=send_data(CS%Ocean_prior%id_t(m), CS%Ocean_prior%T(isc:iec,jsc:jec,:,m), CS%Time) - if (CS%Ocean_prior%id_s(m)>0) used=send_data(CS%Ocean_prior%id_s(m), CS%Ocean_prior%S(isc:iec,jsc:jec,:,m), CS%Time) + if (CS%Ocean_prior%id_t(m)>0) & + used=send_data(CS%Ocean_prior%id_t(m), CS%Ocean_prior%T(isc:iec,jsc:jec,:,m), CS%Time) + if (CS%Ocean_prior%id_s(m)>0) & + used=send_data(CS%Ocean_prior%id_s(m), CS%Ocean_prior%S(isc:iec,jsc:jec,:,m), CS%Time) enddo deallocate(T,S) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 9ac56b03c6..10882aed75 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -1319,11 +1319,11 @@ end subroutine MEKE_end !! !! \subsection section_MEKE_references References !! -!! Jansen, M. F., A. J. Adcroft, R. Hallberg, and I. M. Held, 2015: Parameterization of eddy fluxes based on a mesoscale energy -!! budget. Ocean Modelling, 92, 28--41, http://doi.org/10.1016/j.ocemod.2015.05.007 . +!! Jansen, M. F., A. J. Adcroft, R. Hallberg, and I. M. Held, 2015: Parameterization of eddy fluxes based on a +!! mesoscale energy budget. Ocean Modelling, 92, 28--41, http://doi.org/10.1016/j.ocemod.2015.05.007 . !! -!! Marshall, D. P., and A. J. Adcroft, 2010: Parameterization of ocean eddies: Potential vorticity mixing, energetics and Arnold -!! first stability theorem. Ocean Modelling, 32, 188--204, http://doi.org/10.1016/j.ocemod.2010.02.001 . +!! Marshall, D. P., and A. J. Adcroft, 2010: Parameterization of ocean eddies: Potential vorticity mixing, energetics +!! and Arnold first stability theorem. Ocean Modelling, 32, 188--204, http://doi.org/10.1016/j.ocemod.2010.02.001 . end module MOM_MEKE diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index fbc78f3bdd..61555090ab 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1053,8 +1053,8 @@ end subroutine VarMix_init !! r(\Delta,L_d) = \frac{1}{1+(\alpha R)^p} !! \f] !! -!! The resolution function can be applied independently to thickness diffusion (module mom_thickness_diffuse), tracer diffusion (mom_tracer_hordiff) -!! lateral viscosity (mom_hor_visc). +!! The resolution function can be applied independently to thickness diffusion (module mom_thickness_diffuse), +!! tracer diffusion (mom_tracer_hordiff) lateral viscosity (mom_hor_visc). !! !! Robert Hallberg, 2013: Using a resolution function to regulate parameterizations of oceanic mesoscale eddy effects. !! Ocean Modelling, 71, pp 92-103. http://dx.doi.org/10.1016/j.ocemod.2013.08.007 @@ -1075,8 +1075,8 @@ end subroutine VarMix_init !! !! \section section_Vicbeck Visbeck diffusivity !! -!! This module also calculates factors used in setting the thickness diffusivity similar to a Visbeck et al., 1997, scheme. -!! The factors are combined in mom_thickness_diffuse::thickness_diffuse() but calculated in this module. +!! This module also calculates factors used in setting the thickness diffusivity similar to a Visbeck et al., 1997, +!! scheme. The factors are combined in mom_thickness_diffuse::thickness_diffuse() but calculated in this module. !! !! \f[ !! \kappa_h = \alpha_s L_s^2 S N @@ -1098,9 +1098,9 @@ end subroutine VarMix_init !! !! \section section_vertical_structure_khth Vertical structure function for KhTh !! -!! The thickness diffusivity can be prescribed a vertical distribution with the shape of the equivalent barotropic velocity mode. -!! The structure function is stored in the control structure for thie module (varmix_cs) but is calculated use subroutines in -!! mom_wave_speed. +!! The thickness diffusivity can be prescribed a vertical distribution with the shape of the equivalent barotropic +!! velocity mode. The structure function is stored in the control structure for thie module (varmix_cs) but is +!! calculated using subroutines in mom_wave_speed. !! !! | Symbol | Module parameter | !! | ------ | --------------- | diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 840a0c3373..ba76c208cc 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -93,7 +93,8 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment (sec) - real, dimension(:,:), pointer :: MLD !< Mixed layer depth provided by PBL scheme (H units) + real, dimension(:,:), pointer :: MLD !< Mixed layer depth provided by the + !! PBL scheme (H units) type(VarMix_CS), pointer :: VarMix !< Container for derived fields type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure @@ -119,7 +120,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment (sec) - real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by PBL scheme, in m (not H) + real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by the + !! PBL scheme, in m (not H) type(VarMix_CS), pointer :: VarMix !< Container for derived fields type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure ! Local variables @@ -215,7 +217,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo ! k-loop do i = is-1, ie+1 MLD_fast(i,j) = CS%MLE_MLD_stretch * MLD_fast(i,j) - if ((MLD_fast(i,j)==0.) .and. (deltaRhoAtK(i) + \alpha_{M} \kappa_{M} \right) r(\Delta x,L_d) !! \f] !! where \f$ S \f$ is the isoneutral slope magnitude, \f$ N \f$ is the square root of Brunt-Vaisala frequency, -!! \f$\kappa_{M}\f$ is the diffusivity calculated by the MEKE parameterization (mom_meke module) and \f$ r(\Delta x,L_d) \f$ is -!! a function of the local resolution (ratio of grid-spacing, \f$\Delta x\f$, to deformation radius, \f$L_d\f$). -!! The length \f$L_s\f$ is provided by the mom_lateral_mixing_coeffs module (enabled with -!! USE_VARIABLE_MIXING=True and the term \f$\f$ is the vertical average slope times Brunt-Vaisala frequency -!! prescribed by Visbeck et al., 1996. +!! \f$\kappa_{M}\f$ is the diffusivity calculated by the MEKE parameterization (mom_meke module) and +!! \f$ r(\Delta x,L_d) \f$ is a function of the local resolution (ratio of grid-spacing, \f$\Delta x\f$, +!! to deformation radius, \f$L_d\f$). The length \f$L_s\f$ is provided by the mom_lateral_mixing_coeffs module +!! (enabled with USE_VARIABLE_MIXING=True and the term \f$\f$ is the vertical average slope +!! times the Brunt-Vaisala frequency prescribed by Visbeck et al., 1996. !! !! The result of the above expression is subsequently bounded by minimum and maximum values, including an upper !! diffusivity consistent with numerical stability (\f$ \kappa_{cfl} \f$ is calculated internally). !! \f[ -!! \kappa_h \leftarrow \min{\left( \kappa_{max}, \kappa_{cfl}, \max{\left( \kappa_{min}, \kappa_h \right)} \right)} f(c_g,z) +!! \kappa_h \leftarrow \min{\left( \kappa_{max}, \kappa_{cfl}, \max{\left( \kappa_{min}, \kappa_h \right)} \right)} +!! f(c_g,z) !! \f] !! !! where \f$f(c_g,z)\f$ is a vertical structure function. !! \f$f(c_g,z)\f$ is calculated in module mom_lateral_mixing_coeffs. -!! If KHTH_USE_EBT_STRUCT=True then \f$f(c_g,z)\f$ is set to look like the equivalent barotropic modal velocity structure. -!! Otherwise \f$f(c_g,z)=1\f$ and the diffusivity is independent of depth. +!! If KHTH_USE_EBT_STRUCT=True then \f$f(c_g,z)\f$ is set to look like the equivalent barotropic +!! modal velocity structure. Otherwise \f$f(c_g,z)=1\f$ and the diffusivity is independent of depth. !! !! In order to calculate meaningful slopes in vanished layers, temporary copies of the thermodynamic variables !! are passed through a vertical smoother, function vert_fill_ts(): diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index f615e988cf..b95dac79e2 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -114,12 +114,14 @@ module MOM_ALE_sponge ! heights. subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_data) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). - integer, intent(in) :: nz_data !< The total number of sponge input layers (in). - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time, in s-1 (in). - type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for model parameter values (in). - type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control structure for this module (in/out). - real, dimension(SZI_(G),SZJ_(G),nz_data), intent(in) :: data_h !< The thicknesses of the sponge input layers. (in). + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). + integer, intent(in) :: nz_data !< The total number of sponge input layers (in). + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time, in s-1 (in). + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values (in). + type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module (in/out). + real, dimension(SZI_(G),SZJ_(G),nz_data), intent(in) :: data_h !< The thicknesses of the sponge input layers. ! This include declares and sets the variable "version". @@ -305,10 +307,12 @@ end subroutine initialize_ALE_sponge_fixed ! heights. subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time, in s-1 (in). - type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for model parameter values (in). - type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control structure for this module (in/out). + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time, in s-1 (in). + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse + !! for model parameter values (in). + type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module (in/out). @@ -483,10 +487,12 @@ end subroutine init_ALE_sponge_diags !> This subroutine stores the reference profile at h points for the variable ! whose address is given by f_ptr. subroutine set_up_ALE_sponge_field_fixed(sp_val, G, f_ptr, CS) - type(ocean_grid_type), intent(in) :: G !< Grid structure (in). - type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). - real, dimension(SZI_(G),SZJ_(G),CS%nz_data), intent(in) :: sp_val !< Field to be used in the sponge, it has arbritary number of layers (in). - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target, intent(in) :: f_ptr !< Pointer to the field to be damped (in). + type(ocean_grid_type), intent(in) :: G !< Grid structure + type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). + real, dimension(SZI_(G),SZJ_(G),CS%nz_data), & + intent(in) :: sp_val !< Field to be used in the sponge, it has arbritary number of layers. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + target, intent(in) :: f_ptr !< Pointer to the field to be damped integer :: j, k, col character(len=256) :: mesg ! String for error messages @@ -518,12 +524,13 @@ end subroutine set_up_ALE_sponge_field_fixed !> This subroutine stores the reference profile at h points for the variable ! whose address is given by filename and fieldname. subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr, CS) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: fieldname - type(time_type), intent(in) :: Time - type(ocean_grid_type), intent(in) :: G !< Grid structure (in). - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target, intent(in) :: f_ptr !< Pointer to the field to be damped (in). - type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: fieldname + type(time_type), intent(in) :: Time + type(ocean_grid_type), intent(in) :: G !< Grid structure (in). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + target, intent(in) :: f_ptr !< Pointer to the field to be damped (in). + type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). real, allocatable, dimension(:,:,:) :: sp_val !< Field to be used in the sponge real, allocatable, dimension(:,:,:) :: mask_z !< Field mask for the sponge data @@ -613,7 +620,8 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr, if (hsrc(k)>0.) nPoints = nPoints + 1 zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo - hsrc(nz_data) = hsrc(nz_data) + ( zTopOfCell + G%bathyT(CS%col_i(col),CS%col_j(col)) ) ! In case data is deeper than model + ! In case data is deeper than model + hsrc(nz_data) = hsrc(nz_data) + ( zTopOfCell + G%bathyT(CS%col_i(col),CS%col_j(col)) ) CS%Ref_val(CS%fldno)%h(1:nz_data,col) = 0. CS%Ref_val(CS%fldno)%p(1:nz_data,col) = -1.e24 CS%Ref_val(CS%fldno)%h(1:nz_data,col) = hsrc(1:nz_data) @@ -631,12 +639,14 @@ end subroutine set_up_ALE_sponge_field_varying !> This subroutine stores the reference profile at uand v points for the variable ! whose address is given by u_ptr and v_ptr. subroutine set_up_ALE_sponge_vel_field_fixed(u_val, v_val, G, u_ptr, v_ptr, CS) - type(ocean_grid_type), intent(in) :: G !< Grid structure (in). - type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). - real, dimension(SZIB_(G),SZJ_(G),CS%nz_data), intent(in) :: u_val !< u field to be used in the sponge, it has arbritary number of layers (in). - real, dimension(SZI_(G),SZJB_(G),CS%nz_data), intent(in) :: v_val !< u field to be used in the sponge, it has arbritary number of layers (in). - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(in) :: u_ptr !< u pointer to the field to be damped (in). - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(in) :: v_ptr !< v pointer to the field to be damped (in). + type(ocean_grid_type), intent(in) :: G !< Grid structure (in). + type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). + real, dimension(SZIB_(G),SZJ_(G),CS%nz_data), & + intent(in) :: u_val !< u field to be used in the sponge, it has arbritary number of layers. + real, dimension(SZI_(G),SZJB_(G),CS%nz_data), & + intent(in) :: v_val !< v field to be used in the sponge, it has arbritary number of layers. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(in) :: u_ptr !< u pointer to the field to be damped + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(in) :: v_ptr !< v pointer to the field to be damped integer :: j, k, col character(len=256) :: mesg ! String for error messages @@ -762,13 +772,15 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u,fieldname_u,filename_v end subroutine set_up_ALE_sponge_vel_field_varying -!> This subroutine applies damping to the layers thicknesses, temp, salt and a variety of tracers for every column where there is damping. +!> This subroutine applies damping to the layers thicknesses, temp, salt and a variety of tracers +!! for every column where there is damping. subroutine apply_ALE_sponge(h, dt, G, CS, Time) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure (in). real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Layer thickness, in m (in) real, intent(in) :: dt !< The amount of time covered by this call, in s (in). - type(ALE_sponge_CS), pointer :: CS !0) then do i=is,ie pRef_N2(i) = pRef_N2(i) + GV%g_Earth * GV%Rho0 * h(i,j,k) * GV%H_to_m ! Boussinesq approximation!!!! ????? - !### This should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k) ! This might change answers at roundoff. + !### This should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k) + !### This might change answers at roundoff. enddo call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_N2, rhoAtK, is, ie-is+1, tv%eqn_of_state) do i=is,ie @@ -750,7 +753,8 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia !### It looks to me like there is bad logic here. - RWH ! Use pressure at the bottom of the upper layer used in calculating d/dz rho pRef_N2(i) = pRef_N2(i) + GV%g_Earth * GV%Rho0 * h(i,j,k) * GV%H_to_m ! Boussinesq approximation!!!! ????? - !### This line should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k) ! This might change answers at roundoff. + !### This line should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k) + !### This might change answers at roundoff. endif if (d1(i)>0. .and. dK(i)-d1(i)>=dz_subML) then subMLN2(i,j) = GV%g_Earth/ GV%Rho0 * (rho1(i)-rhoAtK(i)) / (d1(i) - dK(i)) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index fa9f4eba35..17f363850f 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1681,15 +1681,19 @@ end subroutine diagnose_diabatic_diff_tendency !! in which case we distribute the flux into k > 1 layers. subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, & dt, G, GV, CS) - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< thickness after boundary flux application (m or kg/m2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: temp_old !< temperature prior to boundary flux application - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: saln_old !< salinity prior to boundary flux application (PPT) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old !< thickness prior to boundary flux application (m or kg/m2) - real, intent(in) :: dt !< time step (sec) - type(diabatic_CS), pointer :: CS !< module control structure + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< thickness after boundary flux application (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: temp_old !< temperature prior to boundary flux application + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: saln_old !< salinity prior to boundary flux application (PPT) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_old !< thickness prior to boundary flux application (m or kg/m2) + real, intent(in) :: dt !< time step (sec) + type(diabatic_CS), pointer :: CS !< module control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d real, dimension(SZI_(G),SZJ_(G)) :: work_2d @@ -1822,13 +1826,14 @@ end subroutine diagnose_frazil_tendency !! of the diabatic processes to be used. subroutine adiabatic_driver_init(Time, G, param_file, diag, CS, & tracer_flow_CSp, diag_to_Z_CSp) - type(time_type), intent(in) :: Time !< current model time - type(ocean_grid_type), intent(in) :: G !< model grid structure - type(param_file_type), intent(in) :: param_file !< the file to parse for parameter values - type(diag_ctrl), target, intent(inout) :: diag !< regulates diagnostic output - type(diabatic_CS), pointer :: CS !< module control structure - type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< points to control structure of tracer flow control module - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< pointer to Z-diagnostics control structure + type(time_type), intent(in) :: Time !< current model time + type(ocean_grid_type), intent(in) :: G !< model grid structure + type(param_file_type), intent(in) :: param_file !< the file to parse for parameter values + type(diag_ctrl), target, intent(inout) :: diag !< regulates diagnostic output + type(diabatic_CS), pointer :: CS !< module control structure + type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< pointer to control structure of the + !! tracer flow control module + type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< pointer to Z-diagnostics control structure ! This "include" declares and sets the variable "version". #include "version_variable.h" @@ -1865,7 +1870,8 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, !! to enable diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< pointers to terms in continuity equations type(diabatic_CS), pointer :: CS !< module control structure - type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< pointer to control structure of tracer flow control module + type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< pointer to control structure of the + !! tracer flow control module type(sponge_CS), pointer :: sponge_CSp !< pointer to the sponge module control structure type(ALE_sponge_CS), pointer :: ALE_sponge_CSp !< pointer to the ALE sponge module control structure type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< pointer to the Z-diagnostics control structure @@ -2203,54 +2209,54 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, CS%diabatic_diff_tendency_diag = .true. endif - CS%id_diabatic_diff_heat_tend = register_diag_field('ocean_model', & - 'diabatic_heat_tendency', diag%axesTL, Time, & - 'Diabatic diffusion heat tendency', & - 'W m-2',cmor_field_name='opottempdiff', & - cmor_standard_name= & - 'tendency_of_sea_water_potential_temperature_expressed_as_heat_content_due_to_parameterized_dianeutral_mixing',& - cmor_long_name = & - 'Tendency of sea water potential temperature expressed as heat content due to parameterized dianeutral mixing',& + CS%id_diabatic_diff_heat_tend = register_diag_field('ocean_model', & + 'diabatic_heat_tendency', diag%axesTL, Time, & + 'Diabatic diffusion heat tendency', & + 'W m-2',cmor_field_name='opottempdiff', & + cmor_standard_name='tendency_of_sea_water_potential_temperature_expressed_as_heat_content_'// & + 'due_to_parameterized_dianeutral_mixing', & + cmor_long_name='Tendency of sea water potential temperature expressed as heat content '// & + 'due to parameterized dianeutral mixing',& v_extensive=.true.) if (CS%id_diabatic_diff_heat_tend > 0) then CS%diabatic_diff_tendency_diag = .true. endif - CS%id_diabatic_diff_salt_tend = register_diag_field('ocean_model', & - 'diabatic_salt_tendency', diag%axesTL, Time, & - 'Diabatic diffusion of salt tendency', & - 'kg m-2 s-1',cmor_field_name='osaltdiff', & - cmor_standard_name= & - 'tendency_of_sea_water_salinity_expressed_as_salt_content_due_to_parameterized_dianeutral_mixing', & - cmor_long_name = & - 'Tendency of sea water salinity expressed as salt content due to parameterized dianeutral mixing', & + CS%id_diabatic_diff_salt_tend = register_diag_field('ocean_model', & + 'diabatic_salt_tendency', diag%axesTL, Time, & + 'Diabatic diffusion of salt tendency', & + 'kg m-2 s-1',cmor_field_name='osaltdiff', & + cmor_standard_name='tendency_of_sea_water_salinity_expressed_as_salt_content_'// & + 'due_to_parameterized_dianeutral_mixing', & + cmor_long_name='Tendency of sea water salinity expressed as salt content '// & + 'due to parameterized dianeutral mixing', & v_extensive=.true.) if (CS%id_diabatic_diff_salt_tend > 0) then CS%diabatic_diff_tendency_diag = .true. endif ! This diagnostic should equal to roundoff if all is working well. - CS%id_diabatic_diff_heat_tend_2d = register_diag_field('ocean_model', & - 'diabatic_heat_tendency_2d', diag%axesT1, Time, & - 'Depth integrated diabatic diffusion heat tendency', & - 'W m-2',cmor_field_name='opottempdiff_2d', & - cmor_standard_name= & - 'tendency_of_sea_water_potential_temperature_expressed_as_heat_content_due_to_parameterized_dianeutral_mixing_depth_integrated',& - cmor_long_name = & - 'Tendency of sea water potential temperature expressed as heat content due to parameterized dianeutral mixing depth integrated') + CS%id_diabatic_diff_heat_tend_2d = register_diag_field('ocean_model', & + 'diabatic_heat_tendency_2d', diag%axesT1, Time, & + 'Depth integrated diabatic diffusion heat tendency', & + 'W m-2',cmor_field_name='opottempdiff_2d', & + cmor_standard_name='tendency_of_sea_water_potential_temperature_expressed_as_heat_content_'//& + 'due_to_parameterized_dianeutral_mixing_depth_integrated', & + cmor_long_name='Tendency of sea water potential temperature expressed as heat content '//& + 'due to parameterized dianeutral mixing depth integrated') if (CS%id_diabatic_diff_heat_tend_2d > 0) then CS%diabatic_diff_tendency_diag = .true. endif ! This diagnostic should equal to roundoff if all is working well. - CS%id_diabatic_diff_salt_tend_2d = register_diag_field('ocean_model', & - 'diabatic_salt_tendency_2d', diag%axesT1, Time, & - 'Depth integrated diabatic diffusion salt tendency', & - 'kg m-2 s-1',cmor_field_name='osaltdiff_2d', & - cmor_standard_name= & - 'tendency_of_sea_water_salinity_expressed_as_salt_content_due_to_parameterized_dianeutral_mixing_depth_integrated',& - cmor_long_name = & - 'Tendency of sea water salinity expressed as salt content due to parameterized dianeutral mixing depth integrated') + CS%id_diabatic_diff_salt_tend_2d = register_diag_field('ocean_model', & + 'diabatic_salt_tendency_2d', diag%axesT1, Time, & + 'Depth integrated diabatic diffusion salt tendency', & + 'kg m-2 s-1',cmor_field_name='osaltdiff_2d', & + cmor_standard_name='tendency_of_sea_water_salinity_expressed_as_salt_content_'// & + 'due_to_parameterized_dianeutral_mixing_depth_integrated', & + cmor_long_name='Tendency of sea water salinity expressed as salt content '// & + 'due to parameterized dianeutral mixing depth integrated') if (CS%id_diabatic_diff_salt_tend_2d > 0) then CS%diabatic_diff_tendency_diag = .true. endif @@ -2369,7 +2375,8 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, endif ! initialize module for setting diffusivities - call set_diffusivity_init(Time, G, GV, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, CS%int_tide_CSp, CS%tidal_mixing_CSp) + call set_diffusivity_init(Time, G, GV, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, & + CS%int_tide_CSp, CS%tidal_mixing_CSp) ! set up the clocks for this module diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 7054a90ca4..afdebe4ae5 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -282,8 +282,10 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & do_print = .false. ; if (present(may_print) .and. present(CS)) do_print = may_print - dPEa_dKd(:) = 0.0 ; dPEa_dKd_est(:) = 0.0 ; dPEa_dKd_err(:) = 0.0 ; dPEa_dKd_err_norm(:) = 0.0 ; dPEa_dKd_trunc(:) = 0.0 - dPEb_dKd(:) = 0.0 ; dPEb_dKd_est(:) = 0.0 ; dPEb_dKd_err(:) = 0.0 ; dPEb_dKd_err_norm(:) = 0.0 ; dPEb_dKd_trunc(:) = 0.0 + dPEa_dKd(:) = 0.0 ; dPEa_dKd_est(:) = 0.0 ; dPEa_dKd_err(:) = 0.0 + dPEa_dKd_err_norm(:) = 0.0 ; dPEa_dKd_trunc(:) = 0.0 + dPEb_dKd(:) = 0.0 ; dPEb_dKd_est(:) = 0.0 ; dPEb_dKd_err(:) = 0.0 + dPEb_dKd_err_norm(:) = 0.0 ; dPEb_dKd_trunc(:) = 0.0 htot = 0.0 ; pres(1) = 0.0 ; Z_int(1) = 0.0 do k=1,nz diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 5524ef074a..9ecf1374ef 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -553,8 +553,10 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, CS%id_Polzin_decay_scale = register_diag_field('ocean_model','Polzin_decay_scale',diag%axesT1,Time, & 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', 'm') - CS%id_Polzin_decay_scale_scaled = register_diag_field('ocean_model','Polzin_decay_scale_scaled',diag%axesT1,Time, & - 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme, scaled by N2_bot/N2_meanz', 'm') + CS%id_Polzin_decay_scale_scaled = register_diag_field('ocean_model', & + 'Polzin_decay_scale_scaled',diag%axesT1,Time, & + 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme, '// & + 'scaled by N2_bot/N2_meanz', 'm') CS%id_N2_bot = register_diag_field('ocean_model','N2_b',diag%axesT1,Time, & 'Bottom Buoyancy frequency squared', 's-2') @@ -649,7 +651,8 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd) real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m) integer :: i, k, is, ie real :: dh, hcorr, Simmons_coeff - real, parameter :: rho_fw = 1000.0 ! fresh water density [kg/m^3] ! TODO: when coupled, get this from CESM (SHR_CONST_RHOFW) + real, parameter :: rho_fw = 1000.0 ! fresh water density [kg/m^3] + ! TODO: when coupled, get this from CESM (SHR_CONST_RHOFW) type(tidal_mixing_diags), pointer :: dd is = G%isc ; ie = G%iec @@ -1326,5 +1329,4 @@ subroutine tidal_mixing_end(CS) end subroutine tidal_mixing_end - end module MOM_tidal_mixing diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 80c2cc2c3c..d0163f2804 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -79,8 +79,10 @@ function register_ISOMIP_tracer(HI, GV, param_file, CS, tr_Reg, & restart_CS) type(hor_index_type), intent(in) :: HI ! This subroutine find the global min and max of either of all !! available tracer concentrations, or of a tracer that is being !! requested specifically, returning the number of tracers it has gone through. - function MOM_generic_tracer_min_max(ind_start, got_minmax, gmin, gmax, xgmin, ygmin, zgmin, xgmax, ygmax, zgmax , G, CS, names, units) + function MOM_generic_tracer_min_max(ind_start, got_minmax, gmin, gmax, xgmin, ygmin, zgmin, & + xgmax, ygmax, zgmax , G, CS, names, units) use mpp_utilities_mod, only: mpp_array_global_min_max - integer, intent(in) :: ind_start - logical, dimension(:), intent(out) :: got_minmax - real, dimension(:), intent(out) :: gmin !< Global minimum of each tracer, in kg - !! times concentration units. - real, dimension(:), intent(out) :: gmax !< Global maximum of each tracer, in kg - !! times concentration units. - real, dimension(:), intent(out) :: xgmin, ygmin, zgmin, xgmax, ygmax, zgmax - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. - character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. - character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated. - integer :: MOM_generic_tracer_min_max !< Return value, the - !! number of tracers done here. + integer, intent(in) :: ind_start + logical, dimension(:), intent(out) :: got_minmax + real, dimension(:), intent(out) :: gmin !< Global minimum of each tracer, in kg + !! times concentration units. + real, dimension(:), intent(out) :: gmax !< Global maximum of each tracer, in kg + !! times concentration units. + real, dimension(:), intent(out) :: xgmin, ygmin, zgmin, xgmax, ygmax, zgmax + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. + character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. + character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated. + integer :: MOM_generic_tracer_min_max !< Return value, the + !! number of tracers done here. ! Local variables type(g_tracer_type), pointer :: g_tracer, g_tracer_next @@ -709,7 +713,8 @@ function MOM_generic_tracer_min_max(ind_start, got_minmax, gmin, gmax, xgmin, yg call mpp_array_global_min_max(tr_ptr, grid_tmask,isd,jsd,isc,iec,jsc,jec,nk , gmin(m), gmax(m), & - G%geoLonT,G%geoLatT,geo_z,xgmin(m), ygmin(m), zgmin(m), xgmax(m), ygmax(m), zgmax(m)) + G%geoLonT,G%geoLatT,geo_z,xgmin(m), ygmin(m), zgmin(m), & + xgmax(m), ygmax(m), zgmax(m)) got_minmax(m) = .true. diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 5fb99a448b..17a39b290c 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -51,13 +51,17 @@ module MOM_neutral_diffusion ! Positions of neutral surfaces in both the u, v directions real, allocatable, dimension(:,:,:) :: uPoL ! Non-dimensional position with left layer uKoL-1, u-point real, allocatable, dimension(:,:,:) :: uPoR ! Non-dimensional position with right layer uKoR-1, u-point - integer, allocatable, dimension(:,:,:) :: uKoL ! Index of left interface corresponding to neutral surface, u-point - integer, allocatable, dimension(:,:,:) :: uKoR ! Index of right interface corresponding to neutral surface, u-point + integer, allocatable, dimension(:,:,:) :: uKoL ! Index of left interface corresponding to neutral surface, + ! at a u-point + integer, allocatable, dimension(:,:,:) :: uKoR ! Index of right interface corresponding to neutral surface, + ! at a u-point real, allocatable, dimension(:,:,:) :: uHeff ! Effective thickness at u-point (H units) real, allocatable, dimension(:,:,:) :: vPoL ! Non-dimensional position with left layer uKoL-1, v-point real, allocatable, dimension(:,:,:) :: vPoR ! Non-dimensional position with right layer uKoR-1, v-point - integer, allocatable, dimension(:,:,:) :: vKoL ! Index of left interface corresponding to neutral surface, v-point - integer, allocatable, dimension(:,:,:) :: vKoR ! Index of right interface corresponding to neutral surface, v-point + integer, allocatable, dimension(:,:,:) :: vKoL ! Index of left interface corresponding to neutral surface, + ! at a v-point + integer, allocatable, dimension(:,:,:) :: vKoR ! Index of right interface corresponding to neutral surface, + ! at a v-point real, allocatable, dimension(:,:,:) :: vHeff ! Effective thickness at v-point (H units) ! Coefficients of polynomial reconstructions for temperature and salinity real, allocatable, dimension(:,:,:,:) :: ppoly_coeffs_T !< Polynomial coefficients for temperature @@ -74,7 +78,8 @@ module MOM_neutral_diffusion real, allocatable, dimension(:,:,:,:) :: dRdT_i ! dRho/dT (kg/m3/degC) at top edge real, allocatable, dimension(:,:,:,:) :: dRdS_i ! dRho/dS (kg/m3/ppt) at top edge integer, allocatable, dimension(:,:) :: ns ! Number of interfacs in a column - logical, allocatable, dimension(:,:,:) :: stable_cell ! True if the cell is stably stratified wrt to the next cell + logical, allocatable, dimension(:,:,:) :: stable_cell ! True if the cell is stably stratified wrt + ! to the next cell type(diag_ctrl), pointer :: diag ! structure to regulate output integer :: id_uhEff_2d = -1 @@ -372,9 +377,10 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, h, T, S, CS) endif enddo ; enddo - ! Continuous reconstructions calculate hEff as the difference between the pressures of the neutral surfaces which - ! need to be reconverted to thickness units. The discontinuous version calculates hEff from the fraction of the - ! nondimensional fraction of the layer occupied by the + ! Continuous reconstructions calculate hEff as the difference between the pressures of the + ! neutral surfaces which need to be reconverted to thickness units. The discontinuous version + ! calculates hEff from the fraction of the nondimensional fraction of the layer occupied by + ! the... (Please finish this thought. -RWH) if (CS%continuous_reconstruction) then do k = 1, CS%nsurf-1 ; do j = G%jsc, G%jec ; do I = G%isc-1, G%iec if (G%mask2dCu(I,j) > 0.) CS%uhEff(I,j,k) = CS%uhEff(I,j,k) * pa_to_H @@ -408,7 +414,8 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (H units) real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Coef_x !< dt * Kh * dy / dx at u-points (m^2) real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Coef_y !< dt * Kh * dx / dy at u-points (m^2) - real, intent(in) :: dt !< Tracer time step * I_numitts (I_numitts in tracer_hordiff) + real, intent(in) :: dt !< Tracer time step * I_numitts + !! (I_numitts in tracer_hordiff) type(tracer_registry_type), pointer :: Reg !< Tracer registry type(neutral_diffusion_CS), pointer :: CS !< Neutral diffusion control structure @@ -799,8 +806,8 @@ end function fvlsq_slope !> Returns positions within left/right columns of combined interfaces using continuous reconstructions of T/S -subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdSl, Pr, Tr, Sr, dRdTr, dRdSr, PoL, & - PoR, KoL, KoR, hEff) +subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdSl, Pr, Tr, Sr, & + dRdTr, dRdSr, PoL, PoR, KoL, KoR, hEff) integer, intent(in) :: nk !< Number of levels real, dimension(nk+1), intent(in) :: Pl !< Left-column interface pressure (Pa) real, dimension(nk+1), intent(in) :: Tl !< Left-column interface potential temperature (degC) @@ -812,8 +819,10 @@ subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdS real, dimension(nk+1), intent(in) :: Sr !< Right-column interface salinity (ppt) real, dimension(nk+1), intent(in) :: dRdTr !< Left-column dRho/dT (kg/m3/degC) real, dimension(nk+1), intent(in) :: dRdSr !< Left-column dRho/dS (kg/m3/ppt) - real, dimension(2*nk+2), intent(inout) :: PoL !< Fractional position of neutral surface within layer KoL of left column - real, dimension(2*nk+2), intent(inout) :: PoR !< Fractional position of neutral surface within layer KoR of right column + real, dimension(2*nk+2), intent(inout) :: PoL !< Fractional position of neutral surface within + !! layer KoL of left column + real, dimension(2*nk+2), intent(inout) :: PoR !< Fractional position of neutral surface within + !! layer KoR of right column integer, dimension(2*nk+2), intent(inout) :: KoL !< Index of first left interface above neutral surface integer, dimension(2*nk+2), intent(inout) :: KoR !< Index of first right interface above neutral surface real, dimension(2*nk+1), intent(inout) :: hEff !< Effective thickness between two neutral surfaces (Pa) @@ -979,10 +988,10 @@ end subroutine find_neutral_surface_positions_continuous !> Higher order version of find_neutral_surface_positions. Returns positions within left/right columns !! of combined interfaces using intracell reconstructions of T/S -subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, & - Pres_l, hcol_l, Tl, Sl, dRdT_l, dRdS_l, stable_l, Pres_r, hcol_r, Tr, Sr, dRdT_r, dRdS_r, stable_r, & +subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, Pres_l, hcol_l, Tl, Sl, & + dRdT_l, dRdS_l, stable_l, Pres_r, hcol_r, Tr, Sr, dRdT_r, dRdS_r, stable_r, & PoL, PoR, KoL, KoR, hEff, ppoly_T_l, ppoly_S_l, ppoly_T_r, ppoly_S_r) - type(neutral_diffusion_CS) :: CS !< Neutral diffusion control structure + type(neutral_diffusion_CS), intent(inout) :: CS !< Neutral diffusion control structure integer, intent(in) :: nk !< Number of levels integer, intent(in) :: ns !< Number of neutral surfaces real, dimension(nk+1), intent(in) :: Pres_l !< Left-column interface pressure (Pa) @@ -1006,10 +1015,14 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, integer, dimension(4*nk), intent(inout) :: KoL !< Index of first left interface above neutral surface integer, dimension(4*nk), intent(inout) :: KoR !< Index of first right interface above neutral surface real, dimension(4*nk-1), intent(inout) :: hEff !< Effective thickness between two neutral surfaces (Pa) - real, dimension(nk,CS%deg+1), optional, intent(in) :: ppoly_T_l !< Left-column coefficients of T reconstruction - real, dimension(nk,CS%deg+1), optional, intent(in) :: ppoly_S_l !< Left-column coefficients of S reconstruction - real, dimension(nk,CS%deg+1), optional, intent(in) :: ppoly_T_r !< Right-column coefficients of T reconstruction - real, dimension(nk,CS%deg+1), optional, intent(in) :: ppoly_S_r !< Right-column coefficients of S reconstruction + real, dimension(nk,CS%deg+1), & + optional, intent(in) :: ppoly_T_l !< Left-column coefficients of T reconstruction + real, dimension(nk,CS%deg+1), & + optional, intent(in) :: ppoly_S_l !< Left-column coefficients of S reconstruction + real, dimension(nk,CS%deg+1), & + optional, intent(in) :: ppoly_T_r !< Right-column coefficients of T reconstruction + real, dimension(nk,CS%deg+1), & + optional, intent(in) :: ppoly_S_r !< Right-column coefficients of S reconstruction ! Local variables integer :: k_surface ! Index of neutral surface @@ -1063,10 +1076,11 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, ! Loop over each neutral surface, working from top to bottom neutral_surfaces: do k_surface = 1, ns ! Potential density difference, rho(kr) - rho(kl) - dRho = 0.5 * & - ( ( dRdT_r(kl_right,ki_right) + dRdT_l(kl_left,ki_left) ) * ( Tr(kl_right,ki_right) - Tl(kl_left,ki_left) ) & - + ( dRdS_r(kl_right,ki_right) + dRdS_l(kl_left,ki_left) ) * ( Sr(kl_right,ki_right) - Sl(kl_left,ki_left) ) ) - if (CS%debug) write(*,'(A,I2,A,E12.4,A,I2,A,I2,A,I2,A,I2)') "k_surface=",k_surface," dRho=",dRho, & + dRho = 0.5 * ( ( dRdT_r(kl_right,ki_right) + dRdT_l(kl_left,ki_left) ) * & + ( Tr(kl_right,ki_right) - Tl(kl_left,ki_left) ) & + + ( dRdS_r(kl_right,ki_right) + dRdS_l(kl_left,ki_left) ) * & + ( Sr(kl_right,ki_right) - Sl(kl_left,ki_left) ) ) + if (CS%debug) write(*,'(A,I2,A,E12.4,A,I2,A,I2,A,I2,A,I2)') "k_surface=",k_surface," dRho=",dRho, & "kl_left=",kl_left, " ki_left=",ki_left," kl_right=",kl_right, " ki_right=",ki_right ! Which column has the lighter surface for the current indexes, kr and kl if (.not. reached_bottom) then @@ -1077,7 +1091,8 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, searching_right_column = .true. searching_left_column = .false. else ! dRho == 0. - if ( ( kl_left == kl_left_0) .and. ( kl_right == kl_right_0 ) .and. (ki_left + ki_right == 2) ) then ! Still at surface + if ( ( kl_left == kl_left_0) .and. ( kl_right == kl_right_0 ) .and. & + (ki_left + ki_right == 2) ) then ! Still at surface searching_left_column = .true. searching_right_column = .false. else ! Not the surface so we simply change direction @@ -1103,7 +1118,7 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, call drho_at_pos(CS%ndiff_aux_CS, T_other, S_other, dRdT_other, dRdS_other, Pres_l(kl_left), & Pres_l(kl_left+1), ppoly_T_l(kl_left,:), ppoly_S_l(kl_left,:), lastP_left, dRhoTop) else - dRhoTop = calc_drho(Tl(kl_left,1), Sl(kl_left,1), dRdT_l(kl_left,1), dRdS_l(kl_left,1), T_other, S_other, & + dRhoTop = calc_drho(Tl(kl_left,1), Sl(kl_left,1), dRdT_l(kl_left,1), dRdS_l(kl_left,1), T_other, S_other, & dRdT_other, dRdS_other) endif ! Potential density difference, rho(kl) - rho(kl_right,ki_right) (will be positive) @@ -1123,8 +1138,9 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, KoR(k_surface) = kl_right ! Set position within the searched column - call search_other_column(dRhoTop, dRhoBot, Pres_l(kl_left), Pres_l(kl_left+1), lastP_left, lastK_left, kl_left, & - kl_left_0, ki_left, top_connected_l, bot_connected_l, PoL(k_surface), KoL(k_surface), search_layer) + call search_other_column(dRhoTop, dRhoBot, Pres_l(kl_left), Pres_l(kl_left+1), & + lastP_left, lastK_left, kl_left, kl_left_0, ki_left, & + top_connected_l, bot_connected_l, PoL(k_surface), KoL(k_surface), search_layer) if ( CS%refine_position .and. search_layer ) then min_bound = 0. @@ -1137,7 +1153,8 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, endif if (PoL(k_surface) == 0.) top_connected_l(KoL(k_surface)) = .true. if (PoL(k_surface) == 1.) bot_connected_l(KoL(k_surface)) = .true. - call increment_interface(nk, kl_right, ki_right, stable_r, reached_bottom, searching_right_column, searching_left_column) + call increment_interface(nk, kl_right, ki_right, stable_r, reached_bottom, & + searching_right_column, searching_left_column) elseif (searching_right_column) then if (CS%ref_pres>=0.) then @@ -1189,7 +1206,8 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, endif if (PoR(k_surface) == 0.) top_connected_r(KoR(k_surface)) = .true. if (PoR(k_surface) == 1.) bot_connected_r(KoR(k_surface)) = .true. - call increment_interface(nk, kl_left, ki_left, stable_l, reached_bottom, searching_left_column, searching_right_column) + call increment_interface(nk, kl_left, ki_left, stable_l, reached_bottom, & + searching_left_column, searching_right_column) else stop 'Else what?' @@ -1197,8 +1215,8 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, lastK_left = KoL(k_surface) ; lastP_left = PoL(k_surface) lastK_right = KoR(k_surface) ; lastP_right = PoR(k_surface) - if (CS%debug) write(*,'(A,I3,A,ES16.6,A,I2,A,ES16.6)') "KoL:", KoL(k_surface), " PoL:", PoL(k_surface), " KoR:", & - KoR(k_surface), " PoR:", PoR(k_surface) + if (CS%debug) write(*,'(A,I3,A,ES16.6,A,I2,A,ES16.6)') "KoL:", KoL(k_surface), " PoL:", PoL(k_surface), & + " KoR:", KoR(k_surface), " PoR:", PoR(k_surface) ! Effective thickness if (k_surface>1) then ! This is useful as a check to make sure that positions are monotonically increasing @@ -1364,7 +1382,7 @@ subroutine neutral_surface_flux(nk, nsurf, deg, hl, hr, Tl, Tr, PiL, PiR, KoL, K dT_bottom = T_right_bottom - T_left_bottom dT_ave = 0.5 * ( dT_top + dT_bottom ) dT_layer = T_right_layer - T_left_layer - if (signum(1.,dT_top) * signum(1.,dT_bottom) <= 0. .or. signum(1.,dT_ave) * signum(1.,dT_layer) <= 0. ) then + if (signum(1.,dT_top) * signum(1.,dT_bottom) <= 0. .or. signum(1.,dT_ave) * signum(1.,dT_layer) <= 0.) then dT_ave = 0. else dT_ave = dT_layer @@ -1372,10 +1390,12 @@ subroutine neutral_surface_flux(nk, nsurf, deg, hl, hr, Tl, Tr, PiL, PiR, KoL, K Flx(k_sublayer) = dT_ave * hEff(k_sublayer) else ! Discontinuous reconstruction ! Calculate tracer values on left and right side of the neutral surface - call neutral_surface_T_eval(nk, nsurf, k_sublayer, KoL, PiL, Tl, Tid_l, deg, iMethod, ppoly_r_coeffs_l, & - T_left_top, T_left_bottom, T_left_sub, T_left_top_int, T_left_bot_int, T_left_layer) - call neutral_surface_T_eval(nk, nsurf, k_sublayer, KoR, PiR, Tr, Tid_r, deg, iMethod, ppoly_r_coeffs_r, & - T_right_top, T_right_bottom, T_right_sub, T_right_top_int, T_right_bot_int, T_right_layer) + call neutral_surface_T_eval(nk, nsurf, k_sublayer, KoL, PiL, Tl, Tid_l, deg, iMethod, & + ppoly_r_coeffs_l, T_left_top, T_left_bottom, T_left_sub, & + T_left_top_int, T_left_bot_int, T_left_layer) + call neutral_surface_T_eval(nk, nsurf, k_sublayer, KoR, PiR, Tr, Tid_r, deg, iMethod, & + ppoly_r_coeffs_r, T_right_top, T_right_bottom, T_right_sub, & + T_right_top_int, T_right_bot_int, T_right_layer) dT_top = T_right_top - T_left_top dT_bottom = T_right_bottom - T_left_bottom @@ -2048,9 +2068,11 @@ logical function test_ifndp(verbose, rhoNeg, Pneg, rhoPos, Ppos, Ptrue, title) if (test_ifndp) stdunit = 0 ! In case of wrong results, write to error stream write(stdunit,'(a)') title if (test_ifndp) then - write(stdunit,'(4(x,a,f20.16),2(x,a,1pe22.15),x,a)') 'r1=',rhoNeg,'p1=',Pneg,'r2=',rhoPos,'p2=',Ppos,'pRet=',Pret,'pTrue=',Ptrue,'WRONG!' + write(stdunit,'(4(x,a,f20.16),2(x,a,1pe22.15),x,a)') & + 'r1=',rhoNeg,'p1=',Pneg,'r2=',rhoPos,'p2=',Ppos,'pRet=',Pret,'pTrue=',Ptrue,'WRONG!' else - write(stdunit,'(4(x,a,f20.16),2(x,a,1pe22.15))') 'r1=',rhoNeg,'p1=',Pneg,'r2=',rhoPos,'p2=',Ppos,'pRet=',Pret,'pTrue=',Ptrue + write(stdunit,'(4(x,a,f20.16),2(x,a,1pe22.15))') & + 'r1=',rhoNeg,'p1=',Pneg,'r2=',rhoPos,'p2=',Ppos,'pRet=',Pret,'pTrue=',Ptrue endif endif @@ -2079,10 +2101,12 @@ logical function test_data1d(verbose, nk, Po, Ptrue, title) do k = 1,nk if (Po(k) /= Ptrue(k)) then test_data1d = .true. - write(stdunit,'(a,i2,2(x,a,f20.16),x,a,1pe22.15,x,a)') 'k=',k,'Po=',Po(k),'Ptrue=',Ptrue(k),'err=',Po(k)-Ptrue(k),'WRONG!' + write(stdunit,'(a,i2,2(x,a,f20.16),x,a,1pe22.15,x,a)') & + 'k=',k,'Po=',Po(k),'Ptrue=',Ptrue(k),'err=',Po(k)-Ptrue(k),'WRONG!' else if (verbose) & - write(stdunit,'(a,i2,2(x,a,f20.16),x,a,1pe22.15)') 'k=',k,'Po=',Po(k),'Ptrue=',Ptrue(k),'err=',Po(k)-Ptrue(k) + write(stdunit,'(a,i2,2(x,a,f20.16),x,a,1pe22.15)') & + 'k=',k,'Po=',Po(k),'Ptrue=',Ptrue(k),'err=',Po(k)-Ptrue(k) endif enddo endif @@ -2122,7 +2146,8 @@ logical function test_data1di(verbose, nk, Po, Ptrue, title) end function test_data1di -!> Returns true if output of find_neutral_surface_positions() does not match correct values, and conditionally writes results to stream +!> Returns true if output of find_neutral_surface_positions() does not match correct values, +!! and conditionally writes results to stream logical function test_nsp(verbose, ns, KoL, KoR, pL, pR, hEff, KoL0, KoR0, pL0, pR0, hEff0, title) logical, intent(in) :: verbose !< If true, write results to stdout integer, intent(in) :: ns !< Number of surfaces diff --git a/src/tracer/MOM_neutral_diffusion_aux.F90 b/src/tracer/MOM_neutral_diffusion_aux.F90 index 09ed0c0e58..ca3435ded0 100644 --- a/src/tracer/MOM_neutral_diffusion_aux.F90 +++ b/src/tracer/MOM_neutral_diffusion_aux.F90 @@ -328,8 +328,10 @@ real function interpolate_for_nondim_position(dRhoNeg, Pneg, dRhoPos, Ppos) else ! dRhoPos - dRhoNeg < 0 interpolate_for_nondim_position = 0.5 endif - if ( interpolate_for_nondim_position < 0. ) stop 'interpolate_for_nondim_position: Houston, we have a problem! Pint < Pneg' - if ( interpolate_for_nondim_position > 1. ) stop 'interpolate_for_nondim_position: Houston, we have a problem! Pint > Ppos' + if ( interpolate_for_nondim_position < 0. ) & + stop 'interpolate_for_nondim_position: Houston, we have a problem! Pint < Pneg' + if ( interpolate_for_nondim_position > 1. ) & + stop 'interpolate_for_nondim_position: Houston, we have a problem! Pint > Ppos' end function interpolate_for_nondim_position !> Use root-finding methods to find where dRho = 0, based on the equation of state and the polynomial @@ -339,8 +341,8 @@ end function interpolate_for_nondim_position !! to see if it it diverges outside the interval. In that case (or in the case that second derivatives are not !! available), Brent's method is used following the implementation found at !! https://people.sc.fsu.edu/~jburkardt/f_src/brent/brent.f90 -real function refine_nondim_position(CS, T_ref, S_ref, alpha_ref, beta_ref, P_top, P_bot, ppoly_T, ppoly_S, drho_top, & - drho_bot, min_bound) +real function refine_nondim_position(CS, T_ref, S_ref, alpha_ref, beta_ref, P_top, P_bot, & + ppoly_T, ppoly_S, drho_top, drho_bot, min_bound) type(ndiff_aux_CS_type), intent(in) :: CS !< Control structure with parameters for this module real, intent(in) :: T_ref !< Temperature of the neutral surface at the searched from interface real, intent(in) :: S_ref !< Salinity of the neutral surface at the searched from interface diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index e68ff0df9e..f8762985c5 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -24,19 +24,24 @@ module MOM_tracer_diabatic subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & sfc_flux, btm_flux, btm_reservoir, sink_rate, convert_flux_in) - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< layer thickness before entrainment (m or kg m-2) - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: ea !< amount of fluid entrained from the layer above (units of h_work) - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: eb !< amount of fluid entrained from the layer below (units of h_work) - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: tr !< tracer concentration (in concentration units CU) - real, intent(in) :: dt !< amount of time covered by this call (seconds) - real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: sfc_flux !< surface flux of the tracer (in CU * kg m-2 s-1) - real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: btm_flux !< The (negative upward) bottom flux of the tracer, - !! in units of (CU * kg m-2 s-1) - real, dimension(SZI_(G),SZJ_(G)), optional,intent(inout) :: btm_reservoir !< amount of tracer in a bottom reservoir (units of CU kg m-2; formerly CU m) - real, optional,intent(in) :: sink_rate !< rate at which the tracer sinks, in m s-1 - logical, optional,intent(in) :: convert_flux_in !< True if the specified sfc_flux needs to be integrated in time + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< layer thickness before entrainment (m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: ea !< amount of fluid entrained from the layer + !! above (units of h_work) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: eb !< amount of fluid entrained from the layer + !! below (units of h_work) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: tr !< tracer concentration (in concentration units CU) + real, intent(in) :: dt !< amount of time covered by this call (seconds) + real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: sfc_flux !< surface flux of the tracer in units + !! of (CU * kg m-2 s-1) + real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: btm_flux !< The (negative upward) bottom flux of the + !! tracer, in units of (CU * kg m-2 s-1) + real, dimension(SZI_(G),SZJ_(G)), optional,intent(inout) :: btm_reservoir !< amount of tracer in a bottom reservoir + !! (units of CU kg m-2; formerly CU m) + real, optional,intent(in) :: sink_rate !< rate at which the tracer sinks, in m s-1 + logical, optional,intent(in) :: convert_flux_in !< True if the specified sfc_flux needs + !! to be integrated in time real :: sink_dist ! The distance the tracer sinks in a time step, in m or kg m-2. real, dimension(SZI_(G),SZJ_(G)) :: & @@ -227,10 +232,10 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness in H units real, intent(in ) :: evap_CFL_limit real, intent(in ) :: minimum_forcing_depth - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in ) :: in_flux_optional ! The total time-integrated amount of tracer! - ! that enters with freshwater - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: out_flux_optional ! The total time-integrated amount of tracer! - ! that leaves with freshwater + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in ) :: in_flux_optional !< The total time-integrated + !! amount of tracer that enters with freshwater + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: out_flux_optional ! The total time-integrated + !! amount of tracer that leaves with freshwater !< Optional flag to determine whether h should be updated logical, optional, intent(in) :: update_h_opt @@ -245,13 +250,13 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim netMassIn, & ! mass entering ocean surface (H units) over a time step netMassOut ! mass leaving ocean surface (H units) over a time step - real, dimension(SZI_(G), SZK_(G)) :: h2d, Tr2d - real, dimension(SZI_(G),SZJ_(G)) :: in_flux ! The total time-integrated amount of tracer! - ! that enters with freshwater - real, dimension(SZI_(G),SZJ_(G)) :: out_flux ! The total time-integrated amount of tracer! - ! that leaves with freshwater - real, dimension(SZI_(G)) :: in_flux_1d, out_flux_1d - real :: hGrounding(maxGroundings) + real, dimension(SZI_(G), SZK_(G)) :: h2d, Tr2d + real, dimension(SZI_(G),SZJ_(G)) :: in_flux ! The total time-integrated amount of tracer! + ! that enters with freshwater + real, dimension(SZI_(G),SZJ_(G)) :: out_flux ! The total time-integrated amount of tracer! + ! that leaves with freshwater + real, dimension(SZI_(G)) :: in_flux_1d, out_flux_1d + real :: hGrounding(maxGroundings) real :: Tr_in logical :: update_h integer :: i, j, is, ie, js, je, k, nz, n, nsw diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index b7a1e1a421..daa2062c81 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -158,10 +158,14 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit real, dimension(:,:,:), optional, pointer :: ad_y !< diagnostic y-advective flux (CONC m3/s or CONC*kg/s) real, dimension(:,:,:), optional, pointer :: df_x !< diagnostic x-diffusive flux (CONC m3/s or CONC*kg/s) real, dimension(:,:,:), optional, pointer :: df_y !< diagnostic y-diffusive flux (CONC m3/s or CONC*kg/s) - real, dimension(:,:), optional, pointer :: ad_2d_x !< vert sum of diagnostic x-advect flux (CONC m3/s or CONC*kg/s) - real, dimension(:,:), optional, pointer :: ad_2d_y !< vert sum of diagnostic y-advect flux (CONC m3/s or CONC*kg/s) - real, dimension(:,:), optional, pointer :: df_2d_x !< vert sum of diagnostic x-diffuse flux (CONC m3/s or CONC*kg/s) - real, dimension(:,:), optional, pointer :: df_2d_y !< vert sum of diagnostic y-diffuse flux (CONC m3/s or CONC*kg/s) + real, dimension(:,:), optional, pointer :: ad_2d_x !< vert sum of diagnostic x-advect flux + !! (CONC m3/s or CONC*kg/s) + real, dimension(:,:), optional, pointer :: ad_2d_y !< vert sum of diagnostic y-advect flux + !! (CONC m3/s or CONC*kg/s) + real, dimension(:,:), optional, pointer :: df_2d_x !< vert sum of diagnostic x-diffuse flux + !! (CONC m3/s or CONC*kg/s) + real, dimension(:,:), optional, pointer :: df_2d_y !< vert sum of diagnostic y-diffuse flux + !! (CONC m3/s or CONC*kg/s) real, dimension(:,:,:), optional, pointer :: advection_xy !< convergence of lateral advective tracer fluxes logical, optional, intent(in) :: registry_diags !< If present and true, use the registry for @@ -173,12 +177,15 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit character(len=*), optional, intent(in) :: flux_units !< The units for the fluxes of this tracer. real, optional, intent(in) :: flux_scale !< A scaling factor used to convert the fluxes !! of this tracer to its desired units. - character(len=*), optional, intent(in) :: convergence_units !< The units for the flux convergence of this tracer. + character(len=*), optional, intent(in) :: convergence_units !< The units for the flux convergence of + !! this tracer. real, optional, intent(in) :: convergence_scale !< A scaling factor used to convert the flux !! convergence of this tracer to its desired units. - character(len=*), optional, intent(in) :: cmor_tendprefix !< The CMOR name for the layer-integrated tendencies of this tracer. - integer, optional, intent(in) :: diag_form !< An integer (1 or 2, 1 by default) indicating the character - !! string template to use in labeling diagnostics + character(len=*), optional, intent(in) :: cmor_tendprefix !< The CMOR name for the layer-integrated + !! tendencies of this tracer. + integer, optional, intent(in) :: diag_form !< An integer (1 or 2, 1 by default) indicating the + !! character string template to use in + !! labeling diagnostics type(MOM_restart_CS), optional, pointer :: restart_CS !< A pointer to the restart control structure; !! this tracer will be registered for !! restarts if this argument is present diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 03cf06fdfa..ef8abe9bbf 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -67,12 +67,12 @@ module boundary_impulse_tracer !> Read in runtime options and add boundary impulse tracer to tracer registry function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in ) :: HI - type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure - type(param_file_type), intent(in ) :: param_file !< A structure to parse for run-time parameters - type(boundary_impulse_tracer_CS), pointer, intent(inout) :: CS - type(tracer_registry_type), pointer, intent(inout) :: tr_Reg - type(MOM_restart_CS), pointer, intent(inout) :: restart_CS + type(hor_index_type), intent(in ) :: HI + type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure + type(param_file_type), intent(in ) :: param_file !< A structure to parse for run-time parameters + type(boundary_impulse_tracer_CS), pointer :: CS + type(tracer_registry_type), pointer :: tr_Reg + type(MOM_restart_CS), pointer :: restart_CS ! This subroutine is used to register tracer fields and subroutines ! to be used with MOM. ! Arguments: HI - A horizontal index type structure. @@ -170,7 +170,8 @@ subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, type(boundary_impulse_tracer_CS), pointer,intent(inout) :: CS type(sponge_CS), pointer, intent(inout) :: sponge_CSp type(diag_to_Z_CS), pointer, intent(inout) :: diag_to_Z_CSp - type(thermo_var_ptrs), intent(in ) :: tv !< A structure pointing to various thermodynamic variables + type(thermo_var_ptrs), intent(in ) :: tv !< A structure pointing to various + !! thermodynamic variables ! This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:) ! and it sets up the tracer output. @@ -227,16 +228,17 @@ end subroutine initialize_boundary_impulse_tracer ! Apply source or sink at boundary and do vertical diffusion subroutine boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, tv, debug, & evap_CFL_limit, minimum_forcing_depth) - type(ocean_grid_type), intent(in ) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: h_old, h_new, ea, eb - type(forcing), intent(in ) :: fluxes - real, intent(in ) :: dt !< The amount of time covered by this call, in s - type(boundary_impulse_tracer_CS), pointer, intent(inout) :: CS - type(thermo_var_ptrs), intent(in ) :: tv !< A structure pointing to various thermodynamic variables - logical, intent(in ) :: debug - real, optional, intent(in ) :: evap_CFL_limit - real, optional, intent(in ) :: minimum_forcing_depth + type(ocean_grid_type), intent(in ) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: h_old, h_new, ea, eb + type(forcing), intent(in ) :: fluxes + real, intent(in ) :: dt !< The amount of time covered by this call, in s + type(boundary_impulse_tracer_CS), pointer :: CS + type(thermo_var_ptrs), intent(in ) :: tv !< A structure pointing to various + !! thermodynamic variables + logical, intent(in ) :: debug + real, optional, intent(in ) :: evap_CFL_limit + real, optional, intent(in ) :: minimum_forcing_depth ! This subroutine applies diapycnal diffusion and any other column ! tracer physics or chemistry to the tracers from this file. diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 2f84fc7dfa..8e6443ae4a 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -42,10 +42,11 @@ module BFB_initialization contains +!> This subroutine specifies the vertical coordinate in terms of temperature at the surface and at the bottom. +!! This case is set up in such a way that the temperature of the topmost layer is equal to the SST at the +!! southern edge of the domain. The temperatures are then converted to densities of the top and bottom layers +!! and linearly interpolated for the intermediate layers. subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) -! This subroutine specifies the vertical coordinate in terms of temperature at the surface and at the bottom. This case is set up in -! such a way that the temperature of the topmost layer is equal to the SST at the southern edge of the domain. The temperatures are -! then converted to densities of the top and bottom layers and linearly interpolated for the intermediate layers. real, dimension(NKMEM_), intent(out) :: Rlay, g_prime type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters @@ -83,9 +84,9 @@ subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) end subroutine BFB_set_coord +!> This subroutine sets up the sponges for the southern bouundary of the domain. Maximum damping occurs +!! within 2 degrees lat of the boundary. The damping linearly decreases northward over the next 2 degrees. subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, CSp, h) -! This subroutine sets up the sponges for the southern bouundary of the domain. Maximum damping occurs within 2 degrees lat of the -! boundary. The damping linearly decreases northward over the next 2 degrees. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure logical, intent(in) :: use_temperature type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables @@ -129,7 +130,10 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, "The longitudinal length of the domain.", units="degrees") nlat = slat + lenlat do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz) ; enddo -! do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz-1) ; enddo ! Use for meridional thickness profile initialization + + ! Use for meridional thickness profile initialization +! do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz-1) ; enddo + do i=is,ie; do j=js,je if (G%geoLatT(i,j) < slat+2.0) then ; damp = 1.0 elseif (G%geoLatT(i,j) < slat+4.0) then diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index c9b47d595f..b8d46798e4 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -218,7 +218,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par enddo enddo ; enddo - case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates + case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie eta1D(nz+1) = -1.0*G%bathyT(i,j) @@ -552,7 +552,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) enddo enddo ; enddo - case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates + case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates do j=js,je ; do i=is,ie eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 90d44f7c7c..ed7e726f8e 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -1125,12 +1125,12 @@ end subroutine DHH85_mid ! Do not use. subroutine StokesMixing(G, GV, DT, h, u, v, WAVES ) ! Arguments - type(ocean_grid_type), intent(in) :: G !< Ocean grid - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - real, intent(in) :: Dt !< Time step of MOM6 [s] for GOTM turbulence solver - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< Velocity i-component (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< Velocity j-component (m/s) + type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + real, intent(in) :: Dt !< Time step of MOM6 [s] for GOTM turbulence solver + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< Velocity i-component (m/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< Velocity j-component (m/s) type(Wave_parameters_CS), pointer :: Waves !< Surface wave related control structure. ! Local variables REAL :: dTauUp, dTauDn, DVel @@ -1200,13 +1200,13 @@ subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES) ! Work towards an explicit Coriolis Stokes method. ! perhaps not the best way forward, not accessed in the code. ! Arguments - type(ocean_grid_type), intent(in) :: G !< Ocean grid - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - real, intent(in) :: Dt !< Time step of MOM6 [s] for GOTM turbulence solver - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< Velocity i-component (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< Velocity j-component (m/s) - type(Wave_parameters_CS), pointer :: Waves !< Surface wave related control structure. + type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + real, intent(in) :: Dt !< Time step of MOM6 [s] for GOTM turbulence solver + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< Velocity i-component (m/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< Velocity j-component (m/s) + type(Wave_parameters_CS), pointer :: Waves !< Surface wave related control structure. ! Local variables REAL :: DVel @@ -1215,7 +1215,8 @@ subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES) do k = 1, G%ke do j = G%jscB, G%jecB do i = G%iscB, G%iecB - DVel = 0.25*(WAVES%us_y(i,j+1,k)+WAVES%us_y(i-1,j+1,k))*G%CoriolisBu(i,j+1) + 0.25*(WAVES%us_y(i,j,k)+WAVES%us_y(i-1,j,k))*G%CoriolisBu(i,j) + DVel = 0.25*(WAVES%us_y(i,j+1,k)+WAVES%us_y(i-1,j+1,k))*G%CoriolisBu(i,j+1) + & + 0.25*(WAVES%us_y(i,j,k)+WAVES%us_y(i-1,j,k))*G%CoriolisBu(i,j) u(i,j,k) = u(i,j,k)+DVEL*DT enddo enddo @@ -1224,7 +1225,8 @@ subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES) do k = 1, G%ke do j = G%jscB, G%jecB do i = G%iscB, G%iecB - DVel = 0.25*(WAVES%us_x(i+1,j,k)+WAVES%us_x(i+1,j-1,k))*G%CoriolisBu(i+1,j) + 0.25*(WAVES%us_x(i,j,k)+WAVES%us_x(i,j-1,k))*G%CoriolisBu(i,j) + DVel = 0.25*(WAVES%us_x(i+1,j,k)+WAVES%us_x(i+1,j-1,k))*G%CoriolisBu(i+1,j) + & + 0.25*(WAVES%us_x(i,j,k)+WAVES%us_x(i,j-1,k))*G%CoriolisBu(i,j) v(i,j,k) = v(i,j,k)-DVEL*DT enddo enddo diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index d22d7457ab..51c8ab7683 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -60,15 +60,15 @@ subroutine Neverland_initialize_topography(D, G, param_file, max_depth) ! This sets topography that has a reentrant channel to the south. D(i,j) = 1.0 - (1.2 * spike(x,0.2) + 1.2 * spike(x-1.0,0.2)) * spike(MIN(0.0,y-0.3),0.2) & !< South America - - 1.2 * spike(x-0.5,0.2) * spike(MIN(0.0,y-0.55),0.2) & !< Africa - - 1.1 * spike(y-1,0.12) - 1.1 * spike(y,0.12) & !< The great northern wall and Antarctica - - 1.2 * (spike(x,0.12) + spike(x-1,0.12)) * spike(MAX(0.0,y-0.06),0.12) & !< Antarctic Peninsula - - 0.1 * (cosbell(x,0.1) + cosbell(x-1,0.1)) & !< Drake Passage ridge - - 0.5 * cosbell(x-0.16,0.05) * (cosbell(y-0.18,0.13)**0.4) & !< Scotia Arc East - - 0.4 * (cosbell(x-0.09,0.08)**0.4) * cosbell(y-0.26,0.05) & !< Scotia Arc North - - 0.4 * (cosbell(x-0.08,0.08)**0.4) * cosbell(y-0.1,0.05) & !< Scotia Arc South - - nl_roughness_amp * cos(14*PI*x) * sin(14*PI*y) & !< roughness - - nl_roughness_amp * cos(20*PI*x) * cos(20*PI*y) !< roughness + - 1.2 * spike(x-0.5,0.2) * spike(MIN(0.0,y-0.55),0.2) & !< Africa + - 1.1 * spike(y-1,0.12) - 1.1 * spike(y,0.12) & !< The great northern wall and Antarctica + - 1.2 * (spike(x,0.12) + spike(x-1,0.12)) * spike(MAX(0.0,y-0.06),0.12) & !< Antarctic Peninsula + - 0.1 * (cosbell(x,0.1) + cosbell(x-1,0.1)) & !< Drake Passage ridge + - 0.5 * cosbell(x-0.16,0.05) * (cosbell(y-0.18,0.13)**0.4) & !< Scotia Arc East + - 0.4 * (cosbell(x-0.09,0.08)**0.4) * cosbell(y-0.26,0.05) & !< Scotia Arc North + - 0.4 * (cosbell(x-0.08,0.08)**0.4) * cosbell(y-0.1,0.05) & !< Scotia Arc South + - nl_roughness_amp * cos(14*PI*x) * sin(14*PI*y) & !< roughness + - nl_roughness_amp * cos(20*PI*x) * cos(20*PI*y) !< roughness if (D(i,j) < 0.0) D(i,j) = 0.0 D(i,j) = D(i,j) * max_depth diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index acf13d8fd8..88b80e84c6 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -95,7 +95,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param real :: delta_h real :: min_thickness, S_surf, S_range, S_ref, S_light, S_dense character(len=20) :: verticalCoordinate - logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate + logical :: just_read ! If true, just read parameters but set nothing. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -138,7 +138,8 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param ! Equating: S_surf - S_range * z/max_depth = S_light + (K-3/2)/(nz-1) * (S_dense - S_light) ! Equating: - S_range * z/max_depth = S_light - S_surf + (K-3/2)/(nz-1) * (S_dense - S_light) ! Equating: z/max_depth = - ( S_light - S_surf + (K-3/2)/(nz-1) * (S_dense - S_light) ) / S_range - e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * ( (real(K)-1.5) / real(nz-1) ) ) / S_range + e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * & + ( (real(K)-1.5) / real(nz-1) ) ) / S_range e0(K) = nint(2048.*e0(K))/2048. ! Force round numbers ... the above expression has irrational factors ... e0(K) = min(real(1-K)*GV%Angstrom_z, e0(K)) ! Bound by surface e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index 80376e67c9..2eeda73243 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -6,7 +6,7 @@ module dumbbell_surface_forcing !* * !* * !* This file contains subroutines for specifying surface dynamic * -!* forcing for the dumbbell case. * +!* forcing for the dumbbell case. * !* * !********+*********+*********+*********+*********+*********+*********+** use MOM_diag_mediator, only : post_data, query_averaging_enabled @@ -230,8 +230,10 @@ subroutine dumbbell_dynamic_forcing(state, fluxes, day, dt, G, CS) ! MODIFY THE CODE IN THE FOLLOWING LOOPS TO SET THE BUOYANCY FORCING TERMS. do j=js,je ; do i=is,ie - fluxes%p_surf(i,j) = CS%forcing_mask(i,j)* CS%slp_amplitude * G%mask2dT(i,j) * sin(deg_rad*(rdays/CS%slp_period)) - fluxes%p_surf_full(i,j) = CS%forcing_mask(i,j) * CS%slp_amplitude * G%mask2dT(i,j) * sin(deg_rad*(rdays/CS%slp_period)) + fluxes%p_surf(i,j) = CS%forcing_mask(i,j)* CS%slp_amplitude * & + G%mask2dT(i,j) * sin(deg_rad*(rdays/CS%slp_period)) + fluxes%p_surf_full(i,j) = CS%forcing_mask(i,j) * CS%slp_amplitude * & + G%mask2dT(i,j) * sin(deg_rad*(rdays/CS%slp_period)) enddo; enddo @@ -251,10 +253,10 @@ subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) end subroutine alloc_if_needed subroutine dumbbell_surface_forcing_init(Time, G, param_file, diag, CS) - type(time_type), intent(in) :: Time - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(in) :: diag + type(time_type), intent(in) :: Time + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(diag_ctrl), target, intent(in) :: diag type(dumbbell_surface_forcing_CS), pointer :: CS ! Arguments: Time - The current model time. ! (in) G - The ocean's grid structure. diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 8160a45002..790185d0ee 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -96,7 +96,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param real :: delta_h real :: min_thickness, S_surf, S_range, S_ref, S_light, S_dense character(len=20) :: verticalCoordinate - logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate + logical :: just_read ! If true, just read parameters but set nothing. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -139,7 +139,8 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param ! Equating: S_surf - S_range * z/max_depth = S_light + (K-3/2)/(nz-1) * (S_dense - S_light) ! Equating: - S_range * z/max_depth = S_light - S_surf + (K-3/2)/(nz-1) * (S_dense - S_light) ! Equating: z/max_depth = - ( S_light - S_surf + (K-3/2)/(nz-1) * (S_dense - S_light) ) / S_range - e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * ( (real(K)-1.5) / real(nz-1) ) ) / S_range + e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * & + ( (real(K)-1.5) / real(nz-1) ) ) / S_range e0(K) = nint(2048.*e0(K))/2048. ! Force round numbers ... the above expression has irrational factors ... e0(K) = min(real(1-K)*GV%Angstrom_z, e0(K)) ! Bound by surface e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom From 5f4e0308c3a9c328abd31ab513756e98255503d5 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Fri, 4 May 2018 17:21:00 -0400 Subject: [PATCH 0186/1072] Adding capability to bypass initializing a generic tracers - For some generic tracers we need to bypass initialization in MOM6 and leave it to the tracer package to initialize them. E.g., suppose MOM6 restart_flag='n', and we want to initialize some tracers to zero without providing a source file full of zeros for them. The user can then add the following switches to the field_tablefor cobalt to bypass initialize/restart them by MOM6, e.g., "namelists","ocean_mod","generic_cobalt" irr_mem_requires_src_info = f irr_mem_requires_restart = f / --- src/tracer/MOM_generic_tracer.F90 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 36e73b9ee2..dd81836464 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -308,7 +308,10 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, h, param_file, dia endif enddo; enddo ; enddo endif - + elseif(.not. g_tracer%requires_restart) then + !Do nothing for this tracer, it is initialized by the tracer package + call MOM_error(NOTE,"initialize_MOM_generic_tracer: "//& + "skip initialization of generic tracer "//trim(g_tracer_name)) else !Do it old way if the tracer is not registered to start from a specific source file. !This path should be deprecated if all generic tracers are required to start from specified sources. if (len_trim(CS%IC_file) > 0) then @@ -335,7 +338,8 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, h, param_file, dia endif else call MOM_error(FATAL,"initialize_MOM_generic_tracer: "//& - "check Generic Tracer IC filename "//trim(CS%IC_file)//".") + "check Generic Tracer IC filename "//trim(CS%IC_file)//& + " for tracer "//trim(g_tracer_name)) endif endif From 76a67781e5cc7efbb23853a74eb2457d6b49505f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 5 May 2018 08:44:36 -0400 Subject: [PATCH 0187/1072] Replaced 'if(' with 'if (' Replaced 'if(' with 'if (' and 'elseif(' with 'elseif (' throughout the MOM6 code base to follow MOM6 coding conventions. All answers are bitwise identical. --- config_src/coupled_driver/ocean_model_MOM.F90 | 2 +- src/core/MOM.F90 | 14 ++--- src/core/MOM_forcing_type.F90 | 58 +++++++++---------- src/diagnostics/MOM_diagnostics.F90 | 6 +- src/diagnostics/MOM_sum_output.F90 | 4 +- src/diagnostics/MOM_wave_speed.F90 | 16 ++--- src/diagnostics/MOM_wave_structure.F90 | 30 +++++----- src/equation_of_state/MOM_EOS_TEOS10.F90 | 4 +- src/equation_of_state/MOM_TFreeze.F90 | 2 +- src/framework/MOM_diag_mediator.F90 | 36 ++++++------ src/framework/MOM_io.F90 | 2 +- src/framework/MOM_restart.F90 | 10 ++-- src/ice_shelf/MOM_ice_shelf.F90 | 10 ++-- src/initialization/MOM_grid_initialize.F90 | 2 +- src/ocean_data_assim/MOM_oda_driver.F90 | 22 +++---- .../lateral/MOM_internal_tides.F90 | 26 ++++----- .../lateral/MOM_thickness_diffuse.F90 | 10 ++-- src/parameterizations/vertical/MOM_KPP.F90 | 6 +- .../vertical/MOM_bulk_mixed_layer.F90 | 34 +++++------ .../vertical/MOM_diabatic_aux.F90 | 10 ++-- .../vertical/MOM_diabatic_driver.F90 | 56 +++++++++--------- .../vertical/MOM_energetic_PBL.F90 | 2 +- .../vertical/MOM_opacity.F90 | 6 +- .../vertical/MOM_regularize_layers.F90 | 2 +- src/tracer/MOM_OCMIP2_CO2calc.F90 | 4 +- src/tracer/MOM_generic_tracer.F90 | 54 ++++++++--------- src/tracer/MOM_neutral_diffusion.F90 | 19 +++--- src/tracer/MOM_neutral_diffusion_aux.F90 | 2 +- src/tracer/MOM_offline_aux.F90 | 12 ++-- src/tracer/MOM_offline_main.F90 | 2 +- src/tracer/MOM_tracer_advect.F90 | 10 ++-- src/tracer/MOM_tracer_diabatic.F90 | 8 +-- src/tracer/boundary_impulse_tracer.F90 | 2 +- src/tracer/pseudo_salt_tracer.F90 | 2 +- 34 files changed, 243 insertions(+), 242 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index af4dddbadb..dca6b8a837 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -818,7 +818,7 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, call mpp_get_layout(input_domain,layout) call mpp_get_global_domain(input_domain, xsize=xsz, ysize=ysz) - if(PRESENT(maskmap)) then + if (PRESENT(maskmap)) then call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain, maskmap=maskmap) else call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index a43a252e0a..e13f52c854 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1308,7 +1308,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call enable_averaging(time_interval, Time_end, CS%diag) ! Check to see if this is the first iteration of the offline interval - if(accumulated_time==0) then + if (accumulated_time==0) then first_iter = .true. else ! This is probably unnecessary but is used to guard against unwanted behavior first_iter = .false. @@ -1323,17 +1323,17 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS ! Increment the amount of time elapsed since last read and check if it's time to roll around accumulated_time = mod(accumulated_time + int(time_interval), dt_offline) - if(accumulated_time==0) then + if (accumulated_time==0) then last_iter = .true. else last_iter = .false. endif - if(CS%use_ALE_algorithm) then + if (CS%use_ALE_algorithm) then ! If this is the first iteration in the offline timestep, then we need to read in fields and ! perform the main advection. if (first_iter) then - if(is_root_pe()) print *, "Reading in new offline fields" + if (is_root_pe()) print *, "Reading in new offline fields" ! Read in new transport and other fields ! call update_transport_from_files(G, GV, CS%offline_CSp, h_end, eatr, ebtr, uhtr, vhtr, & ! CS%tv%T, CS%tv%S, fluxes, CS%use_ALE_algorithm) @@ -1368,7 +1368,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS endif ! Last thing that needs to be done is the final ALE remapping - if(last_iter) then + if (last_iter) then if (CS%diabatic_first) then call offline_advection_ale(fluxes, Time_start, time_interval, CS%offline_CSp, id_clock_ALE, & CS%h, uhtr, vhtr, converged=adv_converged) @@ -1387,7 +1387,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS endif endif - if(is_root_pe()) print *, "Last iteration of offline interval" + if (is_root_pe()) print *, "Last iteration of offline interval" ! Apply freshwater fluxes out of the ocean call offline_fw_fluxes_out_ocean(G, GV, CS%offline_CSp, fluxes, CS%h) @@ -1408,7 +1408,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS ! Note that for the layer mode case, the calls to tracer sources and sinks is embedded in ! main_offline_advection_layer. Warning: this may not be appropriate for tracers that ! exchange with the atmosphere - if(time_interval .NE. dt_offline) then + if (time_interval .NE. dt_offline) then call MOM_error(FATAL, & "For offline tracer mode in a non-ALE configuration, dt_offline must equal time_interval") endif diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 6a65c7e844..7f590f6d5e 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -511,20 +511,20 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! evap > 0 means condensating water is added into ocean. ! evap < 0 means evaporation of water from the ocean, in ! which case heat_content_evap is computed in MOM_diabatic_driver.F90 - if(fluxes%evap(i,j) < 0.0) then + if (fluxes%evap(i,j) < 0.0) then netMassOut(i) = netMassOut(i) + fluxes%evap(i,j) - ! if(associated(fluxes%heat_content_cond)) fluxes%heat_content_cond(i,j) = 0.0 !??? --AJA + ! if (associated(fluxes%heat_content_cond)) fluxes%heat_content_cond(i,j) = 0.0 !??? --AJA endif ! lprec < 0 means sea ice formation taking water from the ocean. ! smg: we should split the ice melt/formation from the lprec - if(fluxes%lprec(i,j) < 0.0) then + if (fluxes%lprec(i,j) < 0.0) then netMassOut(i) = netMassOut(i) + fluxes%lprec(i,j) endif ! vprec < 0 means virtual evaporation arising from surface salinity restoring, ! in which case heat_content_vprec is computed in MOM_diabatic_driver.F90. - if(fluxes%vprec(i,j) < 0.0) then + if (fluxes%vprec(i,j) < 0.0) then netMassOut(i) = netMassOut(i) + fluxes%vprec(i,j) endif netMassOut(i) = dt * scale * netMassOut(i) @@ -2074,48 +2074,48 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%vprec)) res(i,j) = res(i,j)+fluxes%vprec(i,j) enddo ; enddo call post_data(handles%id_prcme, res, diag) - if(handles%id_total_prcme > 0) then + if (handles%id_total_prcme > 0) then total_transport = global_area_integral(res,G) call post_data(handles%id_total_prcme, total_transport, diag) endif - if(handles%id_prcme_ga > 0) then + if (handles%id_prcme_ga > 0) then ave_flux = global_area_mean(res,G) call post_data(handles%id_prcme_ga, ave_flux, diag) endif endif - if(handles%id_net_massout > 0 .or. handles%id_total_net_massout > 0) then + if (handles%id_net_massout > 0 .or. handles%id_total_net_massout > 0) then do j=js,je ; do i=is,ie res(i,j) = 0.0 - if(fluxes%lprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%lprec(i,j) - if(fluxes%vprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%vprec(i,j) - if(fluxes%evap(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) + if (fluxes%lprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%lprec(i,j) + if (fluxes%vprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%vprec(i,j) + if (fluxes%evap(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) enddo ; enddo call post_data(handles%id_net_massout, res, diag) - if(handles%id_total_net_massout > 0) then + if (handles%id_total_net_massout > 0) then total_transport = global_area_integral(res,G) call post_data(handles%id_total_net_massout, total_transport, diag) endif endif - if(handles%id_massout_flux > 0) call post_data(handles%id_massout_flux,fluxes%netMassOut,diag) + if (handles%id_massout_flux > 0) call post_data(handles%id_massout_flux,fluxes%netMassOut,diag) - if(handles%id_net_massin > 0 .or. handles%id_total_net_massin > 0) then + if (handles%id_net_massin > 0 .or. handles%id_total_net_massin > 0) then do j=js,je ; do i=is,ie res(i,j) = fluxes%fprec(i,j) + fluxes%lrunoff(i,j) + fluxes%frunoff(i,j) - if(fluxes%lprec(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%lprec(i,j) - if(fluxes%vprec(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%vprec(i,j) + if (fluxes%lprec(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%lprec(i,j) + if (fluxes%vprec(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%vprec(i,j) ! fluxes%cond is not needed because it is derived from %evap > 0 - if(fluxes%evap(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) + if (fluxes%evap(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) enddo ; enddo call post_data(handles%id_net_massin, res, diag) - if(handles%id_total_net_massin > 0) then + if (handles%id_total_net_massin > 0) then total_transport = global_area_integral(res,G) call post_data(handles%id_total_net_massin, total_transport, diag) endif endif - if(handles%id_massin_flux > 0) call post_data(handles%id_massin_flux,fluxes%netMassIn,diag) + if (handles%id_massin_flux > 0) call post_data(handles%id_massin_flux,fluxes%netMassIn,diag) if ((handles%id_evap > 0) .and. associated(fluxes%evap)) & call post_data(handles%id_evap, fluxes%evap, diag) @@ -2263,11 +2263,11 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%SW)) res(i,j) = res(i,j) + fluxes%SW(i,j) enddo ; enddo call post_data(handles%id_net_heat_coupler, res, diag) - if(handles%id_total_net_heat_coupler > 0) then + if (handles%id_total_net_heat_coupler > 0) then total_transport = global_area_integral(res,G) call post_data(handles%id_total_net_heat_coupler, total_transport, diag) endif - if(handles%id_net_heat_coupler_ga > 0) then + if (handles%id_net_heat_coupler_ga > 0) then ave_flux = global_area_mean(res,G) call post_data(handles%id_net_heat_coupler_ga, ave_flux, diag) endif @@ -2297,11 +2297,11 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) enddo ; enddo call post_data(handles%id_net_heat_surface, res, diag) - if(handles%id_total_net_heat_surface > 0) then + if (handles%id_total_net_heat_surface > 0) then total_transport = global_area_integral(res,G) call post_data(handles%id_total_net_heat_surface, total_transport, diag) endif - if(handles%id_net_heat_surface_ga > 0) then + if (handles%id_net_heat_surface_ga > 0) then ave_flux = global_area_mean(res,G) call post_data(handles%id_net_heat_surface_ga, ave_flux, diag) endif @@ -2323,7 +2323,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) ! endif enddo ; enddo call post_data(handles%id_heat_content_surfwater, res, diag) - if(handles%id_total_heat_content_surfwater > 0) then + if (handles%id_total_heat_content_surfwater > 0) then total_transport = global_area_integral(res,G) call post_data(handles%id_total_heat_content_surfwater, total_transport, diag) endif @@ -2333,8 +2333,8 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (handles%id_hfrunoffds > 0) then do j=js,je ; do i=is,ie res(i,j) = 0.0 - if(associated(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) - if(associated(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) + if (associated(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) + if (associated(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) enddo ; enddo call post_data(handles%id_hfrunoffds, res, diag) endif @@ -2343,9 +2343,9 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (handles%id_hfrainds > 0) then do j=js,je ; do i=is,ie res(i,j) = 0.0 - if(associated(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) - if(associated(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) - if(associated(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) + if (associated(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) + if (associated(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) + if (associated(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) enddo ; enddo call post_data(handles%id_hfrainds, res, diag) endif @@ -2439,7 +2439,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if ((handles%id_lat_frunoff > 0) .and. associated(fluxes%latent_frunoff_diag)) then call post_data(handles%id_lat_frunoff, fluxes%latent_frunoff_diag, diag) endif - if(handles%id_total_lat_frunoff > 0 .and. associated(fluxes%latent_frunoff_diag)) then + if (handles%id_total_lat_frunoff > 0 .and. associated(fluxes%latent_frunoff_diag)) then total_transport = global_area_integral(fluxes%latent_frunoff_diag,G) call post_data(handles%id_total_lat_frunoff, total_transport, diag) endif diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 6e557426c7..7add057e0e 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -344,7 +344,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif else ! thkcello = dp/(rho*g) for non-Boussinesq do j=js,je - if(associated(p_surf)) then ! Pressure loading at top of surface layer (Pa) + if (associated(p_surf)) then ! Pressure loading at top of surface layer (Pa) do i=is,ie pressure_1d(i) = p_surf(i,j) enddo @@ -932,8 +932,8 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) if (CS%id_KE > 0) call post_data(CS%id_KE, CS%KE, CS%diag) endif - if(.not.G%symmetric) then - if(associated(CS%dKE_dt) .OR. associated(CS%PE_to_KE) .OR. associated(CS%KE_CorAdv) .OR. & + if (.not.G%symmetric) then + if (associated(CS%dKE_dt) .OR. associated(CS%PE_to_KE) .OR. associated(CS%KE_CorAdv) .OR. & associated(CS%KE_adv) .OR. associated(CS%KE_visc) .OR. associated(CS%KE_horvisc).OR. & associated(CS%KE_dia) ) then call create_group_pass(CS%pass_KE_uv, KE_u, KE_v, G%Domain, To_North+To_East) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index a036509437..fd5bec139b 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -232,7 +232,7 @@ subroutine MOM_sum_output_init(G, param_file, directory, ntrnc, & !query fms_io if there is a filename_appendix (for ensemble runs) call get_filename_appendix(filename_appendix) - if(len_trim(filename_appendix) > 0) then + if (len_trim(filename_appendix) > 0) then energyfile = trim(energyfile) //'.'//trim(filename_appendix) end if @@ -881,7 +881,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc write(*,'(" Total ",a,": ",ES24.16,X,a)') & trim(Tr_names(m)), Tr_stocks(m), trim(Tr_units(m)) - if(Tr_minmax_got(m)) then + if (Tr_minmax_got(m)) then write(*,'(64X,"Global Min:",ES24.16,X,"at: (", f7.2,","f7.2,","f8.2,")" )') & Tr_min(m),Tr_min_x(m),Tr_min_y(m),Tr_min_z(m) write(*,'(64X,"Global Max:",ES24.16,X,"at: (", f7.2,","f7.2,","f8.2,")" )') & diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 6b0c90e55e..bb0c4395f7 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -849,8 +849,8 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) enddo ! print resutls (for debugging only) - !if(ig .eq. 83 .and. jg .eq. 2) then - ! if(nmodes>1)then + !if (ig .eq. 83 .and. jg .eq. 2) then + ! if (nmodes>1)then ! print *, "Results after finding first mode:" ! print *, "first guess at lam_1=", 1./speed2_tot ! print *, "final guess at lam_1=", lam_1 @@ -878,7 +878,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) ! set number of intervals within search range numint = nint((lamMax - lamMin)/lamInc) - !if(ig .eq. 144 .and. jg .eq. 5) then + !if (ig .eq. 144 .and. jg .eq. 5) then ! print *, 'Looking for other eigenvalues at', ig, jg ! print *, 'Wave_speed: lamMin=', lamMin ! print *, 'Wave_speed: cnMax=', 1/sqrt(lamMin) @@ -899,7 +899,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) xl = xr - lamInc call tridiag_det(a_diag(1:nrows),b_diag(1:nrows),c_diag(1:nrows), & nrows,xr,det_r,ddet_r) - !if(ig .eq. 83 .and. jg .eq. 2) then + !if (ig .eq. 83 .and. jg .eq. 2) then ! print *, "Move interval" ! print *, "iint=",iint ! print *, "@ xr=",xr @@ -911,7 +911,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) nrootsfound = nrootsfound + 1 xbl(nrootsfound) = xl xbr(nrootsfound) = xr - !if(ig .eq. 144 .and. jg .eq. 5) then + !if (ig .eq. 144 .and. jg .eq. 5) then ! print *, "Root located without subdivision!" ! print *, "between xbl=",xl,"and xbr=",xr !endif @@ -939,7 +939,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) nrootsfound = nrootsfound + 1 xbl(nrootsfound) = xl_sub xbr(nrootsfound) = xr - !if(ig .eq. 144 .and. jg .eq. 5) then + !if (ig .eq. 144 .and. jg .eq. 5) then ! print *, "Root located after subdiving",sub_it," times!" ! print *, "between xbl=",xl_sub,"and xbr=",xr !endif @@ -954,7 +954,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) call MOM_error(WARNING, "wave_speed: root not found "// & " after sub_it_max subdivisions of original"// & " interval.") - !if(ig .eq. 144 .and. jg .eq. 5) then + !if (ig .eq. 144 .and. jg .eq. 5) then !print *, "xbl=",xbl !print *, "xbr=",xbr !print *, "Wave_speed: kc=",kc @@ -979,7 +979,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) ! oops, lamMax not large enough - could add code to increase (BDM) ! set unfound modes to zero for now (BDM) cn(i,j,nrootsfound+2:nmodes) = 0.0 - !if(ig .eq. 83 .and. jg .eq. 2) then + !if (ig .eq. 83 .and. jg .eq. 2) then ! call MOM_error(WARNING, "wave_speed: not all modes found "// & ! " within search range: increase numint.") ! print *, "Increase lamMax at ig=",ig," jg=",jg diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 1db88cb804..3286cae5d8 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -272,10 +272,10 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) ! From this point, we can work on individual columns without causing memory ! to have page faults. - do i=is,ie ; if(cn(i,j)>0.0)then + do i=is,ie ; if (cn(i,j)>0.0)then !----for debugging, remove later---- ig = i + G%idg_offset ; jg = j + G%jdg_offset - !if(ig .eq. CS%int_tide_source_x .and. jg .eq. CS%int_tide_source_y) then + !if (ig .eq. CS%int_tide_source_x .and. jg .eq. CS%int_tide_source_y) then !----------------------------------- if (G%mask2dT(i,j) > 0.5) then @@ -423,10 +423,10 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) a_diag(row) = gprime(K)*(-Igu(K)) b_diag(row) = gprime(K)*(Igu(K)+Igl(K)) - lam_z(row) c_diag(row) = gprime(K)*(-Igl(K)) - if(isnan(lam_z(row)))then ; print *, "Wave_structure: lam_z(row) is NAN" ; endif - if(isnan(a_diag(row)))then ; print *, "Wave_structure: a(k) is NAN" ; endif - if(isnan(b_diag(row)))then ; print *, "Wave_structure: b(k) is NAN" ; endif - if(isnan(c_diag(row)))then ; print *, "Wave_structure: c(k) is NAN" ; endif + if (isnan(lam_z(row)))then ; print *, "Wave_structure: lam_z(row) is NAN" ; endif + if (isnan(a_diag(row)))then ; print *, "Wave_structure: a(k) is NAN" ; endif + if (isnan(b_diag(row)))then ; print *, "Wave_structure: b(k) is NAN" ; endif + if (isnan(c_diag(row)))then ; print *, "Wave_structure: c(k) is NAN" ; endif enddo ! Populate top row of tridiagonal matrix K=2 ; row = K-1 @@ -457,9 +457,9 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) ! Check to see if solver worked ig_stop = 0 ; jg_stop = 0 - if(isnan(sum(w_strct(1:kc+1))))then + if (isnan(sum(w_strct(1:kc+1))))then print *, "Wave_structure: w_strct has a NAN at ig=", ig, ", jg=", jg - if(iG%iec .or. jG%jec)then + if (iG%iec .or. jG%jec)then print *, "This is occuring at a halo point." endif ig_stop = ig ; jg_stop = jg @@ -534,7 +534,7 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) CS%num_intfaces(i,j) = nzm !----for debugging; delete later---- - !if(ig .eq. ig_stop .and. jg .eq. jg_stop) then + !if (ig .eq. ig_stop .and. jg .eq. jg_stop) then !print *, 'cn(ig,jg)=', cn(i,j) !print *, "e_guess=", e_guess(1:kc-1) !print *, "|e_guess|=", sqrt(sum(e_guess(1:kc-1)**2)) @@ -673,14 +673,14 @@ subroutine tridiag_solver(a,b,c,h,y,method,x) ! Check results - delete later !do j=1,nrow ; do i=1,nrow - ! if(i==j)then ; A_check(i,j) = b(i) - ! elseif(i==j+1)then ; A_check(i,j) = a(i) - ! elseif(i==j-1)then ; A_check(i,j) = c(i) + ! if (i==j)then ; A_check(i,j) = b(i) + ! elseif (i==j+1)then ; A_check(i,j) = a(i) + ! elseif (i==j-1)then ; A_check(i,j) = c(i) ! endif !enddo ; enddo !print *, 'A(2,1),A(2,2),A(1,2)=', A_check(2,1), A_check(2,2), A_check(1,2) !y_check = matmul(A_check,x) - !if(all(y_check .ne. y))then + !if (all(y_check .ne. y))then ! print *, "tridiag_solver: Uh oh, something's not right!" ! print *, "y=", y ! print *, "y_check=", y_check @@ -713,12 +713,12 @@ subroutine tridiag_solver(a,b,c,h,y,method,x) ! Forward sweep do k=2,nrow-1 beta = 1/(h(k)+alpha(k-1)*Q_prime+alpha(k)) - if(isnan(beta))then ; print *, "Tridiag_solver: beta is NAN" ; endif + if (isnan(beta))then ; print *, "Tridiag_solver: beta is NAN" ; endif q(k) = beta*alpha(k) y_prime(k) = beta*(y(k)+alpha(k-1)*y_prime(k-1)) Q_prime = beta*(h(k)+alpha(k-1)*Q_prime) enddo - if((h(nrow)+alpha(nrow-1)*Q_prime+alpha(nrow)) == 0.0)then + if ((h(nrow)+alpha(nrow-1)*Q_prime+alpha(nrow)) == 0.0)then call MOM_error(WARNING, "Tridiag_solver: this system is not stable; overriding beta(nrow).") beta = 1/(1e-15) ! place holder for unstable systems - delete later else diff --git a/src/equation_of_state/MOM_EOS_TEOS10.F90 b/src/equation_of_state/MOM_EOS_TEOS10.F90 index f0811422d5..cbe0d71889 100644 --- a/src/equation_of_state/MOM_EOS_TEOS10.F90 +++ b/src/equation_of_state/MOM_EOS_TEOS10.F90 @@ -195,7 +195,7 @@ subroutine calculate_density_derivs_scalar_teos10(T, S, pressure, drho_dT, drho_ zs = S !gsw_sr_from_sp(S) !Convert practical salinity to absolute salinity zt = T !gsw_ct_from_pt(S,T) !Convert potantial temp to conservative temp zp = pressure* Pa2db !Convert pressure from Pascal to decibar - if(S.lt.-1.0e-10) return !Can we assume safely that this is a missing value? + if (S.lt.-1.0e-10) return !Can we assume safely that this is a missing value? call gsw_rho_first_derivatives(zs, zt, zp, drho_dsa=drho_dS, drho_dct=drho_dT) end subroutine calculate_density_derivs_scalar_teos10 @@ -257,7 +257,7 @@ subroutine calculate_density_second_derivs_scalar_teos10(T, S, pressure, drho_dS zs = S !gsw_sr_from_sp(S) !Convert practical salinity to absolute salinity zt = T !gsw_ct_from_pt(S,T) !Convert potantial temp to conservative temp zp = pressure* Pa2db !Convert pressure from Pascal to decibar - if(S.lt.-1.0e-10) return !Can we assume safely that this is a missing value? + if (S.lt.-1.0e-10) return !Can we assume safely that this is a missing value? call gsw_rho_second_derivatives(zs, zt, zp, rho_sa_sa=drho_dS_dS, rho_sa_ct=drho_dS_dT, & rho_ct_ct=drho_dT_dT, rho_sa_p=drho_dS_dP, rho_ct_p=drho_dT_dP) diff --git a/src/equation_of_state/MOM_TFreeze.F90 b/src/equation_of_state/MOM_TFreeze.F90 index aef6b60ecb..eaee1ebb3e 100644 --- a/src/equation_of_state/MOM_TFreeze.F90 +++ b/src/equation_of_state/MOM_TFreeze.F90 @@ -205,7 +205,7 @@ subroutine calculate_TFreeze_teos10_array(S, pres, T_Fr, start, npts) zs = S(j) zp = pres(j)* Pa2db !Convert pressure from Pascal to decibar - if(S(j).lt.-1.0e-10) cycle !Can we assume safely that this is a missing value? + if (S(j).lt.-1.0e-10) cycle !Can we assume safely that this is a missing value? T_Fr(j) = gsw_ct_freezing_exact(zs,zp,saturation_fraction) enddo diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index e37e4bddff..aae2b9d9b1 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -242,7 +242,7 @@ subroutine set_axes_info(G, GV, param_file, diag_cs, set_vertical) set_vert = .true. ; if (present(set_vertical)) set_vert = set_vertical - if(G%symmetric) then + if (G%symmetric) then id_xq = diag_axis_init('xq', G%gridLonB(G%isgB:G%iegB), G%x_axis_units, 'x', & 'q point nominal longitude', Domain2=G%Domain%mpp_domain) id_yq = diag_axis_init('yq', G%gridLatB(G%jsgB:G%jegB), G%y_axis_units, 'y', & @@ -886,7 +886,7 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) 'post_data_2d_low is_stat: mask size mismatch: '//diag%debug_str) used = send_data(diag%fms_diag_id, locfield, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=mask) - !elseif(associated(diag%axes%mask2d)) then + !elseif (associated(diag%axes%mask2d)) then ! used = send_data(diag%fms_diag_id, locfield, & ! is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=diag%axes%mask2d) else @@ -900,7 +900,7 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & weight=diag_cs%time_int, rmask=mask) - elseif(associated(diag%axes%mask2d)) then + elseif (associated(diag%axes%mask2d)) then used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & weight=diag_cs%time_int, rmask=diag%axes%mask2d) @@ -939,7 +939,7 @@ subroutine post_data_3d(diag_field_id, field, diag_cs, is_static, mask, alt_h) logical :: staggered_in_x, staggered_in_y real, dimension(:,:,:), pointer :: h_diag - if(present(alt_h)) then + if (present(alt_h)) then h_diag => alt_h else h_diag => diag_cs%h @@ -1136,7 +1136,7 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) 'post_data_3d_low is_stat: mask size mismatch: '//diag%debug_str) used = send_data(diag%fms_diag_id, locfield, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=mask) - !elseif(associated(diag%axes%mask3d)) then + !elseif (associated(diag%axes%mask3d)) then ! used = send_data(diag_field_id, locfield, & ! is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=diag%axes%mask3d) else @@ -1150,7 +1150,7 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & weight=diag_cs%time_int, rmask=mask) - elseif(associated(diag%axes%mask3d)) then + elseif (associated(diag%axes%mask3d)) then call assert(size(locfield) == size(diag%axes%mask3d), & 'post_data_3d_low: mask3d size mismatch: '//diag%debug_str) used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & @@ -1333,7 +1333,7 @@ integer function register_diag_field(module_name, field_name, axes, init_time, & logical :: active MOM_missing_value = axes%diag_cs%missing_value - if(present(missing_value)) MOM_missing_value = missing_value + if (present(missing_value)) MOM_missing_value = missing_value diag_cs => axes%diag_cs dm_id = -1 @@ -1359,19 +1359,19 @@ integer function register_diag_field(module_name, field_name, axes, init_time, & remap_axes => null() if ((axes%id .eq. diag_cs%axesTL%id)) then remap_axes => diag_cs%remap_axesTL(i) - elseif(axes%id .eq. diag_cs%axesBL%id) then + elseif (axes%id .eq. diag_cs%axesBL%id) then remap_axes => diag_cs%remap_axesBL(i) - elseif(axes%id .eq. diag_cs%axesCuL%id ) then + elseif (axes%id .eq. diag_cs%axesCuL%id ) then remap_axes => diag_cs%remap_axesCuL(i) - elseif(axes%id .eq. diag_cs%axesCvL%id) then + elseif (axes%id .eq. diag_cs%axesCvL%id) then remap_axes => diag_cs%remap_axesCvL(i) - elseif(axes%id .eq. diag_cs%axesTi%id) then + elseif (axes%id .eq. diag_cs%axesTi%id) then remap_axes => diag_cs%remap_axesTi(i) - elseif(axes%id .eq. diag_cs%axesBi%id) then + elseif (axes%id .eq. diag_cs%axesBi%id) then remap_axes => diag_cs%remap_axesBi(i) - elseif(axes%id .eq. diag_cs%axesCui%id ) then + elseif (axes%id .eq. diag_cs%axesCui%id ) then remap_axes => diag_cs%remap_axesCui(i) - elseif(axes%id .eq. diag_cs%axesCvi%id) then + elseif (axes%id .eq. diag_cs%axesCvi%id) then remap_axes => diag_cs%remap_axesCvi(i) endif ! When the MOM_diag_to_Z module has been obsoleted we can assume remap_axes will @@ -1453,7 +1453,7 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, character(len=256) :: posted_cmor_units, posted_cmor_standard_name, posted_cmor_long_name, cm_string, msg MOM_missing_value = axes%diag_cs%missing_value - if(present(missing_value)) MOM_missing_value = missing_value + if (present(missing_value)) MOM_missing_value = missing_value register_diag_field_expand_cmor = .false. diag_cs => axes%diag_cs @@ -1848,7 +1848,7 @@ function register_scalar_field(module_name, field_name, init_time, diag_cs, & character(len=256) :: posted_cmor_units, posted_cmor_standard_name, posted_cmor_long_name MOM_missing_value = diag_cs%missing_value - if(present(missing_value)) MOM_missing_value = missing_value + if (present(missing_value)) MOM_missing_value = missing_value dm_id = -1 diag => null() @@ -1957,7 +1957,7 @@ function register_static_field(module_name, field_name, axes, & character(len=9) :: axis_name MOM_missing_value = axes%diag_cs%missing_value - if(present(missing_value)) MOM_missing_value = missing_value + if (present(missing_value)) MOM_missing_value = missing_value diag_cs => axes%diag_cs dm_id = -1 @@ -2520,7 +2520,7 @@ function i2s(a,n_in) integer :: i,n n=size(a) - if(present(n_in)) n = n_in + if (present(n_in)) n = n_in i2s = '' do i=1,n diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 54ce188bb9..e60a151ae7 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -323,7 +323,7 @@ subroutine create_file(unit, filename, vars, novars, fields, threading, timeunit end select pack = 1 - if(present(checksums)) then + if (present(checksums)) then call mpp_write_meta(unit, fields(k), axes(1:numaxes), vars(k)%name, vars(k)%units, & vars(k)%longname, pack = pack, checksum=checksums(k,:)) else diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index d397dede55..6944647008 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -914,9 +914,9 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV) !query fms_io if there is a filename_appendix (for ensemble runs) call get_filename_appendix(filename_appendix) - if(len_trim(filename_appendix) > 0) then + if (len_trim(filename_appendix) > 0) then length = len_trim(restartname) - if(restartname(length-2:length) == '.nc') then + if (restartname(length-2:length) == '.nc') then restartname = restartname(1:length-3)//'.'//trim(filename_appendix)//'.nc' else restartname = restartname(1:length) //'.'//trim(filename_appendix) @@ -1265,7 +1265,7 @@ subroutine restore_state(filename, directory, day, G, CS) endif endif - if(is_root_pe() .and. is_there_a_checksum .and. (checksum_file(1) /= checksum_data)) then + if (is_root_pe() .and. is_there_a_checksum .and. (checksum_file(1) /= checksum_data)) then write (mesg,'(a,Z16,a,Z16,a)') "Checksum of input field "// trim(varname)//" ",checksum_data,& " does not match value ", checksum_file(1), & " stored in "//trim(unit_path(n)//"." ) @@ -1447,9 +1447,9 @@ function open_restart_units(filename, directory, G, CS, units, file_paths, & !query fms_io if there is a filename_appendix (for ensemble runs) call get_filename_appendix(filename_appendix) - if(len_trim(filename_appendix) > 0) then + if (len_trim(filename_appendix) > 0) then length = len_trim(restartname) - if(restartname(length-2:length) == '.nc') then + if (restartname(length-2:length) == '.nc') then restartname = restartname(1:length-3)//'.'//trim(filename_appendix)//'.nc' else restartname = restartname(1:length) //'.'//trim(filename_appendix) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 52436cf827..e3bd9f23c2 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -3734,7 +3734,7 @@ subroutine shelf_advance_front (CS, flux_enter) call mpp_max(iter_count) - if(is_root_pe() .and. (iter_count.gt.1)) print *, iter_count, "MAX ITERATIONS,ADVANCE FRONT" + if (is_root_pe() .and. (iter_count.gt.1)) print *, iter_count, "MAX ITERATIONS,ADVANCE FRONT" if (associated(flux_enter_replace)) deallocate(flux_enter_replace) @@ -4415,7 +4415,7 @@ subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmas endif Ucontr(iphi,jphi) = Ucontr(iphi,jphi) + .25 * area * uq * xquad(ilq) * xquad(jlq) * beta(i,j) -! if((i.eq.27) .and. (j.eq.8) .and. (iphi.eq.1) .and. (jphi.eq.1)) & +! if ((i.eq.27) .and. (j.eq.8) .and. (iphi.eq.1) .and. (jphi.eq.1)) & ! print *, "grid", uq, .25 * area * uq * xquad(ilq) * xquad(jlq) !endif @@ -5852,7 +5852,7 @@ subroutine savearray2(fname,A,flag) OPEN(unit=fin,FILE=fname,STATUS='REPLACE',ACCESS='SEQUENTIAL',& ACTION='WRITE',IOSTAT=iock) -IF(M .gt. 1300) THEN +if (M .gt. 1300) THEN WRITE(fin) 'SECOND DIMENSION TOO LARGE' CLOSE(fin) RETURN @@ -5866,7 +5866,7 @@ subroutine savearray2(fname,A,flag) END DO - IF(i.eq.1) THEN + if (i.eq.1) THEN lh = LEN(TRIM(ln)) @@ -5893,7 +5893,7 @@ subroutine savearray2(fname,A,flag) WRITE(UNIT=fin,IOSTAT=iock,FMT=TRIM(FMT1)) TRIM(ln) - IF(iock .ne. 0) THEN + if (iock .ne. 0) THEN PRINT*,iock END IF END DO diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 7709af5d0e..eab249921e 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -278,7 +278,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) global_indices(3) = 1+SGdom%njhalo global_indices(4) = SGdom%njglobal+SGdom%njhalo exni(:) = 2*exni(:) ; exnj(:) = 2*exnj(:) - if(associated(G%domain%maskmap)) then + if (associated(G%domain%maskmap)) then call MOM_define_domain(global_indices, SGdom%layout, SGdom%mpp_domain, & xflags=G%domain%X_FLAGS, yflags=G%domain%Y_FLAGS, & xhalo=SGdom%nihalo, yhalo=SGdom%njhalo, & diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index f60e4ce013..37c46407af 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -208,7 +208,7 @@ subroutine init_oda(Time, G, GV, CS) allocate(CS%domains(CS%ensemble_size)) CS%domains(CS%ensemble_id)%mpp_domain => G%Domain%mpp_domain do n=1,CS%ensemble_size - if(.not. associated(CS%domains(n)%mpp_domain)) allocate(CS%domains(n)%mpp_domain) + if (.not. associated(CS%domains(n)%mpp_domain)) allocate(CS%domains(n)%mpp_domain) call set_root_pe(CS%ensemble_pelist(n,1)) call mpp_broadcast_domain(CS%domains(n)%mpp_domain) enddo @@ -248,7 +248,7 @@ subroutine init_oda(Time, G, GV, CS) call initialize_remapping(CS%remapCS,'PLM') call set_regrid_params(CS%regridCS, min_thickness=0.) call mpp_get_data_domain(G%Domain%mpp_domain,isd,ied,jsd,jed) - if(.not. associated(CS%h)) then + if (.not. associated(CS%h)) then allocate(CS%h(isd:ied,jsd:jed,CS%GV%ke)); CS%h(:,:,:)=0.0 ! assign thicknesses call ALE_initThicknessToCoord(CS%ALE_CS,G,CS%GV,CS%h) @@ -350,7 +350,7 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) !! switch to global pelist call set_current_pelist(CS%filter_pelist) - if(is_root_pe()) print *, 'Setting prior' + if (is_root_pe()) print *, 'Setting prior' isc=CS%Grid%isc;iec=CS%Grid%iec;jsc=CS%Grid%jsc;jec=CS%Grid%jec call mpp_get_compute_domain(CS%domains(CS%ensemble_id)%mpp_domain,is,ie,js,je) @@ -410,12 +410,12 @@ subroutine get_posterior_tracer(Time, CS, G, GV, h, tv, increment) !! switch to global pelist call set_current_pelist(CS%filter_pelist) - if(is_root_pe()) print *, 'Getting posterior' + if (is_root_pe()) print *, 'Getting posterior' get_inc = .true. - if(present(increment)) get_inc = increment + if (present(increment)) get_inc = increment - if(get_inc) then + if (get_inc) then allocate(Ocean_increment) call init_ocean_ensemble(Ocean_increment,CS%Grid,CS%GV,CS%ensemble_size) Ocean_increment%T = CS%Ocean_posterior%T - CS%Ocean_prior%T @@ -423,7 +423,7 @@ subroutine get_posterior_tracer(Time, CS, G, GV, h, tv, increment) endif isc=CS%Grid%isc;iec=CS%Grid%iec;jsc=CS%Grid%jsc;jec=CS%Grid%jec do m=1,CS%ensemble_size - if(get_inc) then + if (get_inc) then call mpp_redistribute(CS%mpp_domain, Ocean_increment%T(:,:,:,m), & CS%domains(m)%mpp_domain, CS%tv%T, complete=.true.) call mpp_redistribute(CS%mpp_domain, Ocean_increment%S(:,:,:,m), & @@ -436,14 +436,14 @@ subroutine get_posterior_tracer(Time, CS, G, GV, h, tv, increment) endif if (CS%Ocean_posterior%id_t(m)>0) then - if(get_inc) then + if (get_inc) then used=send_data(CS%Ocean_posterior%id_t(m), Ocean_increment%T(isc:iec,jsc:jec,:,m), CS%Time) else used=send_data(CS%Ocean_posterior%id_t(m), CS%Ocean_posterior%T(isc:iec,jsc:jec,:,m), CS%Time) endif endif if (CS%Ocean_posterior%id_s(m)>0) then - if(get_inc) then + if (get_inc) then used=send_data(CS%Ocean_posterior%id_s(m), Ocean_increment%S(isc:iec,jsc:jec,:,m), CS%Time) else used=send_data(CS%Ocean_posterior%id_s(m), CS%Ocean_posterior%S(isc:iec,jsc:jec,:,m), CS%Time) @@ -525,9 +525,9 @@ subroutine set_analysis_time(Time,CS) CS%Time=increment_time(CS%Time,CS%assim_frequency*3600) call get_date(Time, yr, mon, day, hr, min, sec) - if(pe() .eq. mpp_root_pe()) print *, 'Model Time: ', yr, mon, day, hr, min, sec + if (pe() .eq. mpp_root_pe()) print *, 'Model Time: ', yr, mon, day, hr, min, sec call get_date(CS%time, yr, mon, day, hr, min, sec) - if(pe() .eq. mpp_root_pe()) print *, 'Assimilation Time: ', yr, mon, day, hr, min, sec + if (pe() .eq. mpp_root_pe()) print *, 'Assimilation Time: ', yr, mon, day, hr, min, sec endif if (CS%Time < Time) then call MOM_error(FATAL, " set_analysis_time: " // & diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index fe91d988ac..c133df5d4e 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -324,7 +324,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & if (CS%En(i,j,a,fr,m)<0.0) then id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset CS%En(i,j,a,fr,m) = 0.0 - if(abs(CS%En(i,j,a,fr,m))>1.0)then! only print if large + if (abs(CS%En(i,j,a,fr,m))>1.0)then! only print if large print *, 'After propagation: En<0.0 at ig=', id_g, ', jg=', jd_g print *, 'En=',CS%En(i,j,a,fr,m) print *, 'Setting En to zero' @@ -440,7 +440,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & Ub(i,j,fr,m) = CS%wave_structure_CSp%Uavg_profile(i,j,nzm) Umax(i,j,fr,m) = maxval(CS%wave_structure_CSp%Uavg_profile(i,j,1:nzm)) !! for debugging print profile, etc. Delete later - !if(id_g .eq. 260 .and. & + !if (id_g .eq. 260 .and. & ! jd_g .eq. 50 .and. & ! tot_En_mode(i,j,1,1)>500.0) then ! print *, 'Profiles for mode ',m,' and frequency ',fr @@ -761,7 +761,7 @@ subroutine itidal_lowmode_loss(G, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, dt, ! do a=1,CS%nAngle ! frac_per_sector = En(i,j,a,fr,m)/En_tot ! TKE_loss(i,j,a,fr,m) = frac_per_sector*TKE_loss_tot - ! if(TKE_loss(i,j,a,fr,m)*dt <= En(i,j,a,fr,m))then + ! if (TKE_loss(i,j,a,fr,m)*dt <= En(i,j,a,fr,m))then ! En(i,j,a,fr,m) = En(i,j,a,fr,m) - TKE_loss(i,j,a,fr,m)*dt ! else ! call MOM_error(WARNING, "itidal_lowmode_loss: energy loss greater than avalable, "// & @@ -796,10 +796,10 @@ subroutine get_lowmode_loss(i,j,G,CS,mechanism,TKE_loss_sum) ! Arguments: ! (out) TKE_loss_sum - total energy loss rate due to specified mechanism, in W m-2. - if(mechanism == 'LeakDrag') TKE_loss_sum = CS%tot_leak_loss(i,j) ! not used for mixing yet - if(mechanism == 'QuadDrag') TKE_loss_sum = CS%tot_quad_loss(i,j) ! not used for mixing yet - if(mechanism == 'WaveDrag') TKE_loss_sum = CS%tot_itidal_loss(i,j) ! currently used for mixing - if(mechanism == 'Froude') TKE_loss_sum = CS%tot_Froude_loss(i,j) ! not used for mixing yet + if (mechanism == 'LeakDrag') TKE_loss_sum = CS%tot_leak_loss(i,j) ! not used for mixing yet + if (mechanism == 'QuadDrag') TKE_loss_sum = CS%tot_quad_loss(i,j) ! not used for mixing yet + if (mechanism == 'WaveDrag') TKE_loss_sum = CS%tot_itidal_loss(i,j) ! currently used for mixing + if (mechanism == 'Froude') TKE_loss_sum = CS%tot_Froude_loss(i,j) ! not used for mixing yet end subroutine get_lowmode_loss @@ -923,7 +923,7 @@ subroutine refract(En, cn, freq, dt, G, NAngle, use_PPMang) enddo; enddo ! Advect in angular space - if(.not.use_PPMang) then + if (.not.use_PPMang) then ! Use simple upwind do A=0,na ; do i=is,ie if (CFL_ang(i,j,A) > 0.0) then @@ -941,7 +941,7 @@ subroutine refract(En, cn, freq, dt, G, NAngle, use_PPMang) ! Update and copy back to En. do a=1,na ; do i=is,ie - !if(En2d(i,a)+(Flux_E(i,A-1)-Flux_E(i,A)) < 0.0)then ! for debugging + !if (En2d(i,a)+(Flux_E(i,A-1)-Flux_E(i,A)) < 0.0)then ! for debugging ! print *,"refract: OutFlux>Available" ; !stop !endif En(i,j,a) = En2d(i,a) + (Flux_E(i,A-1) - Flux_E(i,A)) @@ -1519,7 +1519,7 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) ! Update reflected energy (Jm-2) do j=jsh,jeh ; do i=ish,ieh !do a=1,CS%nAngle - ! if((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging + ! if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging ! print *,"propagate_x: OutFlux>Available" ; !stop ! endif !enddo @@ -1588,7 +1588,7 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) do j=jsh,jeh ; do i=ish,ieh Fdt_m(i,j,a) = dt*flux_y(i,J-1) ! south face influx (J) Fdt_p(i,j,a) = -dt*flux_y(i,J) ! north face influx (J) - !if((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging + !if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging ! print *,"propagate_y: OutFlux>Available prior to reflection" ; !stop ! print *,"flux_y_south=",flux_y(i,J-1) ! print *,"flux_y_north=",flux_y(i,J) @@ -1616,7 +1616,7 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) ! Update reflected energy (Jm-2) do j=jsh,jeh ; do i=ish,ieh !do a=1,CS%nAngle - ! if((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging + ! if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging ! print *,"propagate_y: OutFlux>Available" ; !stop ! endif !enddo @@ -2516,7 +2516,7 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS) G%domain, timelevel=1) ! replace NANs with null value do j=G%jsc,G%jec ; do i=G%isc,G%iec - if(is_NaN(CS%refl_angle(i,j))) CS%refl_angle(i,j) = CS%nullangle + if (is_NaN(CS%refl_angle(i,j))) CS%refl_angle(i,j) = CS%nullangle enddo ; enddo call pass_var(CS%refl_angle,G%domain) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index ea8c0b3f81..07fad7c421 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -342,12 +342,12 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS ! layer average of the interface diffusivities KH_u and KH_v do j=js,je ; do I=is-1,ie hu(I,j) = 2.0*h(i,j,k)*h(i+1,j,k)/(h(i,j,k)+h(i+1,j,k)+h_neglect) - if(hu(I,j) /= 0.0) hu(I,j) = 1.0 + if (hu(I,j) /= 0.0) hu(I,j) = 1.0 KH_u_lay(I,j) = 0.5*(KH_u(I,j,k)+KH_u(I,j,k+1)) enddo ; enddo do J=js-1,je ; do i=is,ie hv(i,J) = 2.0*h(i,j,k)*h(i,j+1,k)/(h(i,j,k)+h(i,j+1,k)+h_neglect) - if(hv(i,J) /= 0.0) hv(i,J) = 1.0 + if (hv(i,J) /= 0.0) hv(i,J) = 1.0 KH_v_lay(i,J) = 0.5*(KH_v(i,J,k)+KH_v(i,J,k+1)) enddo ; enddo ! diagnose diffusivity at T-point @@ -357,8 +357,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS / (hu(I-1,j)+hu(I,j)+hv(i,J-1)+hv(i,J)+h_neglect) enddo ; enddo enddo - if(CS%id_KH_t > 0) call post_data(CS%id_KH_t, KH_t, CS%diag) - if(CS%id_KH_t1 > 0) call post_data(CS%id_KH_t1, KH_t(:,:,1), CS%diag) + if (CS%id_KH_t > 0) call post_data(CS%id_KH_t, KH_t, CS%diag) + if (CS%id_KH_t1 > 0) call post_data(CS%id_KH_t1, KH_t(:,:,1), CS%diag) endif endif @@ -1830,7 +1830,7 @@ end subroutine thickness_diffuse_init !> Deallocate the thickness diffusion control structure subroutine thickness_diffuse_end(CS) type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion - if(associated(CS)) deallocate(CS) + if (associated(CS)) deallocate(CS) end subroutine thickness_diffuse_end !> \namespace mom_thickness_diffuse diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index f71cc83265..f309fff485 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -870,7 +870,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & endif ! apply some constraints on OBLdepth - if(CS%fixedOBLdepth) OBLdepth_0d = CS%fixedOBLdepth_value + if (CS%fixedOBLdepth) OBLdepth_0d = CS%fixedOBLdepth_value OBLdepth_0d = max( OBLdepth_0d, -iFaceHeight(2) ) ! no shallower than top layer OBLdepth_0d = min( OBLdepth_0d, -iFaceHeight(G%ke+1) ) ! no deeper than bottom kOBL = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) @@ -945,7 +945,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & ! endif ! ! apply some constraints on OBLdepth - ! if(CS%fixedOBLdepth) OBLdepth_0d = CS%fixedOBLdepth_value + ! if (CS%fixedOBLdepth) OBLdepth_0d = CS%fixedOBLdepth_value ! OBLdepth_0d = max( OBLdepth_0d, -iFaceHeight(2) ) ! no shallower than top layer ! OBLdepth_0d = min( OBLdepth_0d, -iFaceHeight(G%ke+1) ) ! no deep than bottom ! kOBL = CVmix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) @@ -1073,7 +1073,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & nonLocalTransScalar(i,j,:) = nonLocalTrans(:,2) ! saln ! set the KPP diffusivity and viscosity to zero for testing purposes - if(CS%KPPzeroDiffusivity) then + if (CS%KPPzeroDiffusivity) then Kdiffusivity(:,1) = 0.0 Kdiffusivity(:,2) = 0.0 Kviscosity(:) = 0.0 diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index c6c5a569bd..d80d5d04fc 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -548,7 +548,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & d_ea(i,k) = 0.0 ; d_eb(i,k) = 0.0 enddo ; enddo - if(id_clock_EOS>0) call cpu_clock_begin(id_clock_EOS) + if (id_clock_EOS>0) call cpu_clock_begin(id_clock_EOS) ! Calculate an estimate of the mid-mixed layer pressure (in Pa) do i=is,ie ; p_ref(i) = 0.0 ; enddo do k=1,CS%nkml ; do i=is,ie @@ -564,21 +564,21 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & call calculate_density(T(:,k), S(:,k), p_ref_cv, Rcv(:,k), is, & ie-is+1, tv%eqn_of_state) enddo - if(id_clock_EOS>0) call cpu_clock_end(id_clock_EOS) + if (id_clock_EOS>0) call cpu_clock_end(id_clock_EOS) if (CS%ML_resort) then - if(id_clock_resort>0) call cpu_clock_begin(id_clock_resort) + if (id_clock_resort>0) call cpu_clock_begin(id_clock_resort) if (CS%ML_presort_nz_conv_adj > 0) & call convective_adjustment(h(:,1:), u, v, R0(:,1:), Rcv(:,1:), T(:,1:), & S(:,1:), eps, d_eb, dKE_CA, cTKE, j, G, GV, CS, & CS%ML_presort_nz_conv_adj) call sort_ML(h(:,1:), R0(:,1:), eps, G, GV, CS, ksort) - if(id_clock_resort>0) call cpu_clock_end(id_clock_resort) + if (id_clock_resort>0) call cpu_clock_end(id_clock_resort) else do k=1,nz ; do i=is,ie ; ksort(i,k) = k ; enddo ; enddo - if(id_clock_adjustment>0) call cpu_clock_begin(id_clock_adjustment) + if (id_clock_adjustment>0) call cpu_clock_begin(id_clock_adjustment) ! Undergo instantaneous entrainment into the buffer layers and mixed layers ! to remove hydrostatic instabilities. Any water that is lighter than ! currently in the mixed or buffer layer is entrained. @@ -586,7 +586,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & S(:,1:), eps, d_eb, dKE_CA, cTKE, j, G, GV, CS) do i=is,ie ; h_CA(i) = h(i,1) ; enddo - if(id_clock_adjustment>0) call cpu_clock_end(id_clock_adjustment) + if (id_clock_adjustment>0) call cpu_clock_end(id_clock_adjustment) endif if (associated(fluxes%lrunoff) .and. CS%do_rivermix) then @@ -611,7 +611,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & endif - if(id_clock_conv>0) call cpu_clock_begin(id_clock_conv) + if (id_clock_conv>0) call cpu_clock_begin(id_clock_conv) ! The surface forcing is contained in the fluxes type. ! We aggregate the thermodynamic forcing for a time step into the following: @@ -635,7 +635,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & dKE_FC, j, ksort, G, GV, CS, tv, fluxes, dt, & aggregate_FW_forcing) - if(id_clock_conv>0) call cpu_clock_end(id_clock_conv) + if (id_clock_conv>0) call cpu_clock_end(id_clock_conv) ! Now the mixed layer undergoes mechanically forced entrainment. ! The mixed layer may entrain down to the Monin-Obukhov depth if the @@ -643,7 +643,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & ! First the TKE at the depth of free convection that is available ! to drive mixing is calculated. - if(id_clock_mech>0) call cpu_clock_begin(id_clock_mech) + if (id_clock_mech>0) call cpu_clock_begin(id_clock_mech) call find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, & TKE, TKE_river, Idecay_len_TKE, cMKE, dt, Idt_diag, & @@ -662,7 +662,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & if (CS%TKE_diagnostics) then ; do i=is,ie CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) - Idt_diag*TKE(i) enddo ; endif - if(id_clock_mech>0) call cpu_clock_end(id_clock_mech) + if (id_clock_mech>0) call cpu_clock_end(id_clock_mech) ! Calculate the homogeneous mixed layer properties and store them in layer 0. do i=is,ie ; if (htot(i) > 0.0) then @@ -692,10 +692,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & ! these unused layers (but not currently in the code). if (CS%ML_resort) then - if(id_clock_resort>0) call cpu_clock_begin(id_clock_resort) + if (id_clock_resort>0) call cpu_clock_begin(id_clock_resort) call resort_ML(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), GV%Rlay, eps, & d_ea, d_eb, ksort, G, GV, CS, dR0_dT, dR0_dS, dRcv_dT, dRcv_dS) - if(id_clock_resort>0) call cpu_clock_end(id_clock_resort) + if (id_clock_resort>0) call cpu_clock_end(id_clock_resort) endif if (CS%limit_det .or. (CS%id_Hsfc_max > 0) .or. (CS%id_Hsfc_min > 0)) then @@ -726,7 +726,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & ! Move water left in the former mixed layer into the buffer layer and ! from the buffer layer into the interior. These steps might best be ! treated in conjuction. - if(id_clock_detrain>0) call cpu_clock_begin(id_clock_detrain) + if (id_clock_detrain>0) call cpu_clock_begin(id_clock_detrain) if (CS%nkbl == 1) then call mixedlayer_detrain_1(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), & GV%Rlay, dt, dt__diag, d_ea, d_eb, j, G, GV, CS, & @@ -739,7 +739,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & ! This code only works with 1 or 2 buffer layers. call MOM_error(FATAL, "MOM_mixed_layer: CS%nkbl must be 1 or 2 for now.") endif - if(id_clock_detrain>0) call cpu_clock_end(id_clock_detrain) + if (id_clock_detrain>0) call cpu_clock_end(id_clock_detrain) if (CS%id_Hsfc_used > 0) then @@ -1221,7 +1221,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & (dRcv_dT(i)*(Net_heat(i) + Pen_absorbed) - & dRcv_dS(i) * (netMassIn(i) * S(i,1) - Net_salt(i))) Conv_En(i) = 0.0 ; dKE_FC(i) = 0.0 - if(associated(fluxes%heat_content_massin)) & + if (associated(fluxes%heat_content_massin)) & fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) & + T_precip * netMassIn(i) * GV%H_to_kg_m2 * fluxes%C_p * Idt if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & @@ -1274,7 +1274,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! heat_content_massout = heat_content_massout - T(i,k)*h_evap*GV%H_to_kg_m2*fluxes%C_p*Idt ! by uncommenting the lines here. ! we will also then completely remove TempXpme from the model. - if(associated(fluxes%heat_content_massout)) & + if (associated(fluxes%heat_content_massout)) & fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) & - T(i,k)*h_evap*GV%H_to_kg_m2 * fluxes%C_p * Idt if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) - & @@ -3868,7 +3868,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) if (CS%id_PE_detrain2 > 0) call safe_alloc_alloc(CS%diag_PE_detrain2, isd, ied, jsd, jed) if (CS%id_ML_depth > 0) call safe_alloc_alloc(CS%ML_depth, isd, ied, jsd, jed) - if(CS%allow_clocks_in_omp_loops) then + if (CS%allow_clocks_in_omp_loops) then id_clock_detrain = cpu_clock_id('(Ocean mixed layer detrain)', grain=CLOCK_ROUTINE) id_clock_mech = cpu_clock_id('(Ocean mixed layer mechanical entrainment)', grain=CLOCK_ROUTINE) id_clock_conv = cpu_clock_id('(Ocean mixed layer convection)', grain=CLOCK_ROUTINE) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index a4e7e47406..6eb3b854f4 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -1168,7 +1168,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & enddo ! k ! Check if trying to apply fluxes over land points - elseif((abs(netHeat(i))+abs(netSalt(i))+abs(netMassIn(i))+abs(netMassOut(i)))>0.) then + elseif ((abs(netHeat(i))+abs(netSalt(i))+abs(netMassIn(i))+abs(netMassOut(i)))>0.) then if (.not. CS%ignore_fluxes_over_land) then call forcing_SinglePointPrint(fluxes,G,i,j,'applyBoundaryFluxesInOut (land)') @@ -1203,7 +1203,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & ! Save temperature before increment with SW heating ! and initialize CS%penSWflux_diag to zero. - if(CS%id_penSW_diag > 0 .or. CS%id_penSWflux_diag > 0) then + if (CS%id_penSW_diag > 0 .or. CS%id_penSWflux_diag > 0) then do k=1,nz ; do i=is,ie CS%penSW_diag(i,j,k) = T2d(i,k) CS%penSWflux_diag(i,j,k) = 0.0 @@ -1235,7 +1235,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & ! Diagnose heating (W/m2) applied to a grid cell from SW penetration ! Also diagnose the penetrative SW heat flux at base of layer. - if(CS%id_penSW_diag > 0 .or. CS%id_penSWflux_diag > 0) then + if (CS%id_penSW_diag > 0 .or. CS%id_penSWflux_diag > 0) then ! convergence of SW into a layer do k=1,nz ; do i=is,ie @@ -1248,7 +1248,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & ! CS%penSWflux_diag(i,j,k=kbot+1) is zero, since assume no SW penetrates rock. ! CS%penSWflux_diag = rsdo and CS%penSW_diag = rsdoabsorb ! rsdoabsorb(k) = rsdo(k) - rsdo(k+1), so that rsdo(k) = rsdo(k+1) + rsdoabsorb(k) - if(CS%id_penSWflux_diag > 0) then + if (CS%id_penSWflux_diag > 0) then do k=nz,1,-1 ; do i=is,ie CS%penSWflux_diag(i,j,k) = CS%penSW_diag(i,j,k) + CS%penSWflux_diag(i,j,k+1) enddo ; enddo @@ -1257,7 +1257,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & endif ! Fill CS%nonpenSW_diag - if(CS%id_nonpenSW_diag > 0) then + if (CS%id_nonpenSW_diag > 0) then do i=is,ie CS%nonpenSW_diag(i,j) = nonpenSW(i) enddo diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 17f363850f..f28fe31a9b 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -429,7 +429,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (associated(tv%T) .AND. associated(tv%frazil)) then ! For frazil diagnostic, the first call covers the first half of the time step call enable_averaging(0.5*dt, Time_end - set_time(int(floor(0.5*dt+0.5))), CS%diag) - if(CS%frazil_tendency_diag) then + if (CS%frazil_tendency_diag) then do k=1,nz ; do j=js,je ; do i=is,ie temp_diag(i,j,k) = tv%T(i,j,k) enddo ; enddo ; enddo @@ -732,7 +732,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! increment heat and salt diffusivity. ! CS%useKPP==.true. already has extra_T and extra_S included - if(.not. CS%useKPP) then + if (.not. CS%useKPP) then do K=2,nz ; do j=js,je ; do i=is,ie Kd_heat(i,j,K) = Kd_heat(i,j,K) + visc%Kd_extra_T(i,j,K) Kd_salt(i,j,K) = Kd_salt(i,j,K) + visc%Kd_extra_S(i,j,K) @@ -787,7 +787,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif ! Save fields before boundary forcing is applied for tendency diagnostics - if(CS%boundary_forcing_tendency_diag) then + if (CS%boundary_forcing_tendency_diag) then do k=1,nz ; do j=js,je ; do i=is,ie h_diag(i,j,k) = h(i,j,k) temp_diag(i,j,k) = tv%T(i,j,k) @@ -868,7 +868,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! diagnose the tendencies due to boundary forcing ! At this point, the diagnostic grids have not been updated since the call to the boundary layer scheme ! so all tendency diagnostics need to be posted on h_diag, and grids rebuilt afterwards - if(CS%boundary_forcing_tendency_diag) then + if (CS%boundary_forcing_tendency_diag) then call diagnose_boundary_forcing_tendency(tv, h, temp_diag, saln_diag, h_diag, dt, G, GV, CS) if (CS%id_boundary_forcing_h > 0) call post_data(CS%id_boundary_forcing_h, h, CS%diag, alt_h = h_diag) endif @@ -1094,7 +1094,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (associated(tv%S) .and. associated(tv%salt_deficit)) & call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) - if(CS%diabatic_diff_tendency_diag) then + if (CS%diabatic_diff_tendency_diag) then do k=1,nz ; do j=js,je ; do i=is,ie temp_diag(i,j,k) = tv%T(i,j,k) saln_diag(i,j,k) = tv%S(i,j,k) @@ -1102,7 +1102,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif ! Changes T and S via the tridiagonal solver; no change to h - if(CS%tracer_tridiag) then + if (CS%tracer_tridiag) then call tracer_vertdiff(hold, ea, eb, dt, tv%T, G, GV) call tracer_vertdiff(hold, ea, eb, dt, tv%S, G, GV) else @@ -1113,7 +1113,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! Note: hold here refers to the thicknesses from before the dual-entraintment when using ! the bulk mixed layer scheme. Otherwise in ALE-mode, layer thicknesses will have changed ! In either case, tendencies should be posted on hold - if(CS%diabatic_diff_tendency_diag) then + if (CS%diabatic_diff_tendency_diag) then call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, CS) if (CS%id_diabatic_diff_h > 0) call post_data(CS%id_diabatic_diff_h, hold, CS%diag, alt_h = hold) endif @@ -1460,7 +1460,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! the end of the diabatic processes. if (associated(tv%T) .AND. associated(tv%frazil)) then call enable_averaging(0.5*dt, Time_end, CS%diag) - if(CS%frazil_tendency_diag) then + if (CS%frazil_tendency_diag) then do k=1,nz ; do j=js,je ; do i=is,ie temp_diag(i,j,k) = tv%T(i,j,k) enddo ; enddo ; enddo @@ -1622,19 +1622,19 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = (tv%T(i,j,k)-temp_old(i,j,k))*Idt enddo ; enddo ; enddo - if(CS%id_diabatic_diff_temp_tend > 0) then + if (CS%id_diabatic_diff_temp_tend > 0) then call post_data(CS%id_diabatic_diff_temp_tend, work_3d, CS%diag, alt_h = h) endif ! heat tendency - if(CS%id_diabatic_diff_heat_tend > 0 .or. CS%id_diabatic_diff_heat_tend_2d > 0) then + if (CS%id_diabatic_diff_heat_tend > 0 .or. CS%id_diabatic_diff_heat_tend_2d > 0) then do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = h(i,j,k) * GV%H_to_kg_m2 * tv%C_p * work_3d(i,j,k) enddo ; enddo ; enddo - if(CS%id_diabatic_diff_heat_tend > 0) then + if (CS%id_diabatic_diff_heat_tend > 0) then call post_data(CS%id_diabatic_diff_heat_tend, work_3d, CS%diag, alt_h = h) endif - if(CS%id_diabatic_diff_heat_tend_2d > 0) then + if (CS%id_diabatic_diff_heat_tend_2d > 0) then do j=js,je ; do i=is,ie work_2d(i,j) = 0.0 do k=1,nz @@ -1646,7 +1646,7 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, endif ! salinity tendency - if(CS%id_diabatic_diff_saln_tend > 0) then + if (CS%id_diabatic_diff_saln_tend > 0) then do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = (tv%S(i,j,k)-saln_old(i,j,k))*Idt enddo ; enddo ; enddo @@ -1654,14 +1654,14 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, endif ! salt tendency - if(CS%id_diabatic_diff_salt_tend > 0 .or. CS%id_diabatic_diff_salt_tend_2d > 0) then + if (CS%id_diabatic_diff_salt_tend > 0 .or. CS%id_diabatic_diff_salt_tend_2d > 0) then do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = h(i,j,k) * GV%H_to_kg_m2 * CS%ppt2mks * work_3d(i,j,k) enddo ; enddo ; enddo - if(CS%id_diabatic_diff_salt_tend > 0) then + if (CS%id_diabatic_diff_salt_tend > 0) then call post_data(CS%id_diabatic_diff_salt_tend, work_3d, CS%diag, alt_h = h) endif - if(CS%id_diabatic_diff_salt_tend_2d > 0) then + if (CS%id_diabatic_diff_salt_tend_2d > 0) then do j=js,je ; do i=is,ie work_2d(i,j) = 0.0 do k=1,nz @@ -1706,7 +1706,7 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, work_2d(:,:) = 0.0 ! Thickness tendency - if(CS%id_boundary_forcing_h_tendency > 0) then + if (CS%id_boundary_forcing_h_tendency > 0) then do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = (h(i,j,k) - h_old(i,j,k))*Idt enddo ; enddo ; enddo @@ -1714,7 +1714,7 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, endif ! temperature tendency - if(CS%id_boundary_forcing_temp_tend > 0) then + if (CS%id_boundary_forcing_temp_tend > 0) then do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = (tv%T(i,j,k)-temp_old(i,j,k))*Idt enddo ; enddo ; enddo @@ -1722,14 +1722,14 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, endif ! heat tendency - if(CS%id_boundary_forcing_heat_tend > 0 .or. CS%id_boundary_forcing_heat_tend_2d > 0) then + if (CS%id_boundary_forcing_heat_tend > 0 .or. CS%id_boundary_forcing_heat_tend_2d > 0) then do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = GV%H_to_kg_m2 * tv%C_p * Idt * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * temp_old(i,j,k)) enddo ; enddo ; enddo - if(CS%id_boundary_forcing_heat_tend > 0) then + if (CS%id_boundary_forcing_heat_tend > 0) then call post_data(CS%id_boundary_forcing_heat_tend, work_3d, CS%diag, alt_h = h_old) endif - if(CS%id_boundary_forcing_heat_tend_2d > 0) then + if (CS%id_boundary_forcing_heat_tend_2d > 0) then do j=js,je ; do i=is,ie work_2d(i,j) = 0.0 do k=1,nz @@ -1741,7 +1741,7 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, endif ! salinity tendency - if(CS%id_boundary_forcing_saln_tend > 0) then + if (CS%id_boundary_forcing_saln_tend > 0) then do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = (tv%S(i,j,k)-saln_old(i,j,k))*Idt enddo ; enddo ; enddo @@ -1749,14 +1749,14 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, endif ! salt tendency - if(CS%id_boundary_forcing_salt_tend > 0 .or. CS%id_boundary_forcing_salt_tend_2d > 0) then + if (CS%id_boundary_forcing_salt_tend > 0 .or. CS%id_boundary_forcing_salt_tend_2d > 0) then do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = GV%H_to_kg_m2 * CS%ppt2mks * Idt * (h(i,j,k) * tv%S(i,j,k) - h_old(i,j,k) * saln_old(i,j,k)) enddo ; enddo ; enddo - if(CS%id_boundary_forcing_salt_tend > 0) then + if (CS%id_boundary_forcing_salt_tend > 0) then call post_data(CS%id_boundary_forcing_salt_tend, work_3d, CS%diag, alt_h = h_old) endif - if(CS%id_boundary_forcing_salt_tend_2d > 0) then + if (CS%id_boundary_forcing_salt_tend_2d > 0) then do j=js,je ; do i=is,ie work_2d(i,j) = 0.0 do k=1,nz @@ -1807,7 +1807,7 @@ subroutine diagnose_frazil_tendency(tv, h, temp_old, dt, G, GV, CS) ! As a consistency check, we must have ! FRAZIL_HEAT_TENDENCY_2d = HFSIFRAZIL - if(CS%id_frazil_heat_tend_2d > 0) then + if (CS%id_frazil_heat_tend_2d > 0) then do j=js,je ; do i=is,ie work_2d(i,j) = 0.0 do k=1,nz @@ -1965,7 +1965,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_TEST", CS%int_tide_source_test, & "If true, apply an arbitrary generation site for internal tide testing", & default=.false.) - if(CS%int_tide_source_test)then + if (CS%int_tide_source_test)then call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & "X Location of generation site for internal tide", default=1.) call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & @@ -1978,7 +1978,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, ! GET UNIFORM MODE VELOCITY FOR TESTING (BDM) call get_param(param_file, mod, "UNIFORM_CG", CS%uniform_cg, & "If true, set cg = cg_test everywhere for test case", default=.false.) - if(CS%uniform_cg)then + if (CS%uniform_cg)then call get_param(param_file, mod, "CG_TEST", CS%cg_test, & "Uniform group velocity of internal tide for test case", default=1.) endif diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 541caccf97..2614b4a941 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -577,7 +577,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & h_neglect = GV%H_subroundoff - if(.not.CS%Use_MLD_Iteration) MAX_OBL_IT=1 + if (.not.CS%Use_MLD_Iteration) MAX_OBL_IT=1 C1_3 = 1.0 / 3.0 dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag IdtdR0 = 1.0 / (dt__diag * GV%Rho0) diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index a573f522e4..3fd52e456d 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -286,7 +286,7 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) associated(fluxes%sw_nir_dif)) chl_data(:,:) = 0.0 - if(present(chl_in)) then + if (present(chl_in)) then do j=js,je ; do i=is,ie ; chl_data(i,j) = chl_in(i,j,1) ; enddo ; enddo do k=1,nz; do j=js,je ; do i=is,ie if ((G%mask2dT(i,j) > 0.5) .and. (chl_in(i,j,k) < 0.0)) then @@ -312,7 +312,7 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) endif if (CS%id_chl > 0) then - if(present(chl_in)) then + if (present(chl_in)) then call post_data(CS%id_chl, chl_in(:,:,1), CS%diag) else call post_data(CS%id_chl, chl_data, CS%diag) @@ -368,7 +368,7 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) enddo enddo ; enddo case default - call MOM_error(FATAL, "opacity_from_chl: CS%opacity_scheme is not valid.") + call MOM_error(FATAL, "opacity_from_chl: CS%opacity_scheme is not valid.") end select !$OMP parallel do default(none) shared(nz,is,ie,js,je,CS,G,chl_in,optics,nbands) & diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index b4b21d9e6b..1e3a82dee4 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -1062,7 +1062,7 @@ subroutine regularize_layers_init(Time, G, param_file, diag, CS) Time, 'V-point filtered 2-layer thickness deficit ratio', 'nondim') #endif - if(CS%allow_clocks_in_omp_loops) then + if (CS%allow_clocks_in_omp_loops) then id_clock_EOS = cpu_clock_id('(Ocean regularize_layers EOS)', grain=CLOCK_ROUTINE) endif id_clock_pass = cpu_clock_id('(Ocean regularize_layers halo updates)', grain=CLOCK_ROUTINE) diff --git a/src/tracer/MOM_OCMIP2_CO2calc.F90 b/src/tracer/MOM_OCMIP2_CO2calc.F90 index 896c70713e..c3b46e785c 100644 --- a/src/tracer/MOM_OCMIP2_CO2calc.F90 +++ b/src/tracer/MOM_OCMIP2_CO2calc.F90 @@ -412,7 +412,7 @@ function drtsafe(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf, & bt, dic, ft, pt, sit, st, ta, x1, fl, df) call ta_iter_1(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf, & bt, dic, ft, pt, sit, st, ta, x2, fh, df) -if(fl .lt. 0.0) then +if (fl .lt. 0.0) then xl=x1 xh=x2 else @@ -453,7 +453,7 @@ function drtsafe(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf, & endif call ta_iter_1(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf, & bt, dic, ft, pt, sit, st, ta, drtsafe, f, df) - if(f .lt. 0.0) then + if (f .lt. 0.0) then xl=drtsafe fl=f else diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 85740c46cd..4954e14a46 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -178,7 +178,7 @@ function register_MOM_generic_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) !Get the tracer list call generic_tracer_get_list(CS%g_tracer_list) - if(.NOT. associated(CS%g_tracer_list)) call mpp_error(FATAL, trim(sub_name)//& + if (.NOT. associated(CS%g_tracer_list)) call mpp_error(FATAL, trim(sub_name)//& ": No tracer in the list.") ! For each tracer name get its T_prog index and get its fields @@ -205,7 +205,7 @@ function register_MOM_generic_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) !traverse the linked list till hit NULL call g_tracer_get_next(g_tracer, g_tracer_next) - if(.NOT. associated(g_tracer_next)) exit + if (.NOT. associated(g_tracer_next)) exit g_tracer=>g_tracer_next enddo @@ -260,13 +260,13 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, h, param_file, dia CS%diag=>diag !Get the tracer list - if(.NOT. associated(CS%g_tracer_list)) call mpp_error(FATAL, trim(sub_name)//& + if (.NOT. associated(CS%g_tracer_list)) call mpp_error(FATAL, trim(sub_name)//& ": No tracer in the list.") !For each tracer name get its fields g_tracer=>CS%g_tracer_list do - if(INDEX(CS%IC_file, '_NULL_') .ne. 0) then + if (INDEX(CS%IC_file, '_NULL_') .ne. 0) then call MOM_error(WARNING,"The name of the IC_file "//trim(CS%IC_file)//& " indicates no MOM initialization was asked for the generic tracers."//& "Bypassing the MOM initialization of ALL generic tracers!") @@ -279,7 +279,7 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, h, param_file, dia if (.not.restart .or. (CS%tracers_may_reinit .and. & .not.query_initialized(tr_ptr, g_tracer_name, CS%restart_CSp))) then - if(g_tracer%requires_src_info ) then + if (g_tracer%requires_src_info ) then call MOM_error(NOTE,"initialize_MOM_generic_tracer: "//& "initializing generic tracer "//trim(g_tracer_name)//& " using MOM_initialize_tracer_from_Z ") @@ -293,17 +293,17 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, h, param_file, dia !Check/apply the bounds for each g_tracer do k=1,nk ; do j=jsc,jec ; do i=isc,iec - if(tr_ptr(i,j,k) .ne. CS%tracer_land_val) then - if(tr_ptr(i,j,k) .lt. g_tracer%src_var_valid_min) tr_ptr(i,j,k) = g_tracer%src_var_valid_min + if (tr_ptr(i,j,k) .ne. CS%tracer_land_val) then + if (tr_ptr(i,j,k) .lt. g_tracer%src_var_valid_min) tr_ptr(i,j,k) = g_tracer%src_var_valid_min !Jasmin does not want to apply the maximum for now - !if(tr_ptr(i,j,k) .gt. g_tracer%src_var_valid_max) tr_ptr(i,j,k) = g_tracer%src_var_valid_max + !if (tr_ptr(i,j,k) .gt. g_tracer%src_var_valid_max) tr_ptr(i,j,k) = g_tracer%src_var_valid_max endif enddo; enddo ; enddo !jgj: Reset CASED to 0 below K=1 - if(trim(g_tracer_name) .eq. 'cased') then + if (trim(g_tracer_name) .eq. 'cased') then do k=2,nk ; do j=jsc,jec ; do i=isc,iec - if(tr_ptr(i,j,k) .ne. CS%tracer_land_val) then + if (tr_ptr(i,j,k) .ne. CS%tracer_land_val) then tr_ptr(i,j,k) = 0.0 endif enddo; enddo ; enddo @@ -343,7 +343,7 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, h, param_file, dia !traverse the linked list till hit NULL call g_tracer_get_next(g_tracer, g_tracer_next) - if(.NOT. associated(g_tracer_next)) exit + if (.NOT. associated(g_tracer_next)) exit g_tracer=>g_tracer_next enddo !! end section to re-initialize generic tracers @@ -376,7 +376,7 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, h, param_file, dia ! Register Z diagnostic output. !Get the tracer list - if(.NOT. associated(CS%g_tracer_list)) call mpp_error(FATAL, trim(sub_name)//& + if (.NOT. associated(CS%g_tracer_list)) call mpp_error(FATAL, trim(sub_name)//& ": No tracer in the list.") !For each tracer name get its fields g_tracer=>CS%g_tracer_list @@ -393,7 +393,7 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, h, param_file, dia !traverse the linked list till hit NULL call g_tracer_get_next(g_tracer, g_tracer_next) - if(.NOT. associated(g_tracer_next)) exit + if (.NOT. associated(g_tracer_next)) exit g_tracer=>g_tracer_next enddo @@ -401,16 +401,16 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, h, param_file, dia !For each special diagnostics name get its fields !Get the diag list call generic_tracer_get_diag_list(CS%g_diag_list) - if(associated(CS%g_diag_list)) then + if (associated(CS%g_diag_list)) then g_diag=>CS%g_diag_list do - if(g_diag%Z_diag .ne. 0) & + if (g_diag%Z_diag .ne. 0) & call register_Z_tracer(g_diag%field_ptr, trim(g_diag%name),g_diag%longname , g_diag%units, & day, G, diag_to_Z_CSp) !traverse the linked list till hit NULL g_diag=>g_diag%next - if(.NOT. associated(g_diag)) exit + if (.NOT. associated(g_diag)) exit enddo endif @@ -473,7 +473,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; nk = G%ke !Get the tracer list - if(.NOT. associated(CS%g_tracer_list)) call mpp_error(FATAL,& + if (.NOT. associated(CS%g_tracer_list)) call mpp_error(FATAL,& trim(sub_name)//": No tracer in the list.") #ifdef _USE_MOM6_DIAG @@ -493,7 +493,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, ! g_tracer=>CS%g_tracer_list do - if(_allocated(g_tracer%trunoff)) then + if (_allocated(g_tracer%trunoff)) then call g_tracer_get_alias(g_tracer,g_tracer_name) call g_tracer_get_pointer(g_tracer,g_tracer_name,'stf', stf_array) call g_tracer_get_pointer(g_tracer,g_tracer_name,'trunoff',trunoff_array) @@ -505,7 +505,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, !traverse the linked list till hit NULL call g_tracer_get_next(g_tracer, g_tracer_next) - if(.NOT. associated(g_tracer_next)) exit + if (.NOT. associated(g_tracer_next)) exit g_tracer=>g_tracer_next enddo @@ -553,7 +553,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, !traverse the linked list till hit NULL call g_tracer_get_next(g_tracer, g_tracer_next) - if(.NOT. associated(g_tracer_next)) exit + if (.NOT. associated(g_tracer_next)) exit g_tracer=>g_tracer_next enddo endif @@ -623,7 +623,7 @@ function MOM_generic_tracer_stock(h, stocks, G, GV, CS, names, units, stock_inde return endif ; endif - if(.NOT. associated(CS%g_tracer_list)) return ! No stocks. + if (.NOT. associated(CS%g_tracer_list)) return ! No stocks. m=1 ; g_tracer=>CS%g_tracer_list do @@ -642,7 +642,7 @@ function MOM_generic_tracer_stock(h, stocks, G, GV, CS, names, units, stock_inde !traverse the linked list till hit NULL call g_tracer_get_next(g_tracer, g_tracer_next) - if(.NOT. associated(g_tracer_next)) exit + if (.NOT. associated(g_tracer_next)) exit g_tracer=>g_tracer_next m = m+1 enddo @@ -688,7 +688,7 @@ function MOM_generic_tracer_min_max(ind_start, got_minmax, gmin, gmax, xgmin, yg MOM_generic_tracer_min_max = 0 if (.not.associated(CS)) return - if(.NOT. associated(CS%g_tracer_list)) return ! No stocks. + if (.NOT. associated(CS%g_tracer_list)) return ! No stocks. call g_tracer_get_common(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,grid_tmask=grid_tmask) @@ -721,7 +721,7 @@ function MOM_generic_tracer_min_max(ind_start, got_minmax, gmin, gmax, xgmin, yg !traverse the linked list till hit NULL call g_tracer_get_next(g_tracer, g_tracer_next) - if(.NOT. associated(g_tracer_next)) exit + if (.NOT. associated(g_tracer_next)) exit g_tracer=>g_tracer_next m = m+1 enddo @@ -768,7 +768,7 @@ subroutine MOM_generic_tracer_surface_state(state, h, G, CS) tau=1,sosga=sosga,model_time=get_diag_time_end(CS%diag)) !Output diagnostics via diag_manager for all tracers in this module -! if(.NOT. associated(CS%g_tracer_list)) call mpp_error(FATAL, trim(sub_name)//& +! if (.NOT. associated(CS%g_tracer_list)) call mpp_error(FATAL, trim(sub_name)//& ! "No tracer in the list.") ! call g_tracer_send_diag(CS%g_tracer_list, get_diag_time_end(CS%diag), tau=1) !Niki: The problem with calling diagnostic outputs here is that this subroutine is called every dt_cpld @@ -794,7 +794,7 @@ subroutine MOM_generic_flux_init(verbosity) endif call generic_tracer_get_list(g_tracer_list) - if(.NOT. associated(g_tracer_list)) then + if (.NOT. associated(g_tracer_list)) then call mpp_error(WARNING, trim(sub_name)// ": No generic tracer in the list.") return endif @@ -806,7 +806,7 @@ subroutine MOM_generic_flux_init(verbosity) !traverse the linked list till hit NULL call g_tracer_get_next(g_tracer, g_tracer_next) - if(.NOT. associated(g_tracer_next)) exit + if (.NOT. associated(g_tracer_next)) exit g_tracer=>g_tracer_next enddo diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 17a39b290c..9e68b543de 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -445,7 +445,7 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, CS) tracer => Reg%Tr(m) ! for diagnostics - if(tracer%id_dfxy_conc > 0 .or. tracer%id_dfxy_cont > 0 .or. tracer%id_dfxy_cont_2d > 0 .or. & + if (tracer%id_dfxy_conc > 0 .or. tracer%id_dfxy_cont > 0 .or. tracer%id_dfxy_cont_2d > 0 .or. & tracer%id_dfx_2d > 0 .or. tracer%id_dfy_2d > 0) then Idt = 1.0/dt tendency(:,:,:) = 0.0 @@ -498,7 +498,7 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, CS) ( G%IareaT(i,j) / ( h(i,j,k) + GV%H_subroundoff ) ) enddo - if(tracer%id_dfxy_conc > 0 .or. tracer%id_dfxy_cont > 0 .or. tracer%id_dfxy_cont_2d > 0 ) then + if (tracer%id_dfxy_conc > 0 .or. tracer%id_dfxy_cont > 0 .or. tracer%id_dfxy_cont_2d > 0 ) then do k = 1, GV%ke tendency(i,j,k) = dTracer(k) * G%IareaT(i,j) * Idt enddo @@ -509,7 +509,7 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, CS) ! Diagnose vertically summed zonal flux, giving zonal tracer transport from ndiff. ! Note sign corresponds to downgradient flux convention. - if(tracer%id_dfx_2d > 0) then + if (tracer%id_dfx_2d > 0) then do j = G%jsc,G%jec ; do I = G%isc-1,G%iec trans_x_2d(I,j) = 0. if (G%mask2dCu(I,j)>0.) then @@ -524,7 +524,7 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, CS) ! Diagnose vertically summed merid flux, giving meridional tracer transport from ndiff. ! Note sign corresponds to downgradient flux convention. - if(tracer%id_dfy_2d > 0) then + if (tracer%id_dfy_2d > 0) then do J = G%jsc-1,G%jec ; do i = G%isc,G%iec trans_y_2d(i,J) = 0. if (G%mask2dCv(i,J)>0.) then @@ -538,12 +538,12 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, CS) endif ! post tendency of tracer content - if(tracer%id_dfxy_cont > 0) then + if (tracer%id_dfxy_cont > 0) then call post_data(tracer%id_dfxy_cont, tendency(:,:,:), CS%diag) endif ! post depth summed tendency for tracer content - if(tracer%id_dfxy_cont_2d > 0) then + if (tracer%id_dfxy_cont_2d > 0) then tendency_2d(:,:) = 0. do j = G%jsc,G%jec ; do i = G%isc,G%iec do k = 1, GV%ke @@ -556,7 +556,7 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, CS) ! post tendency of tracer concentration; this step must be ! done after posting tracer content tendency, since we alter ! the tendency array. - if(tracer%id_dfxy_conc > 0) then + if (tracer%id_dfxy_conc > 0) then do k = 1, GV%ke ; do j = G%jsc,G%jec ; do i = G%isc,G%iec tendency(i,j,k) = tendency(i,j,k) / ( h(i,j,k) + GV%H_subroundoff ) enddo ; enddo ; enddo @@ -1045,8 +1045,9 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, Pres_l, hcol bot_connected_l(:) = .false. ; bot_connected_r(:) = .false. ! Check to make sure that polynomial reconstructions were passed if refine_pos defined) - if(CS%refine_position) then - if (.not. ( present(ppoly_T_l) .and. present(ppoly_S_l) .and. present(ppoly_T_r) .and. present(ppoly_S_r) )) & + if (CS%refine_position) then + if (.not. ( present(ppoly_T_l) .and. present(ppoly_S_l) .and. & + present(ppoly_T_r) .and. present(ppoly_S_r) ) ) & call MOM_error(FATAL, "fine_neutral_surface_positions_discontinuous: refine_pos is requested, but " //& "polynomial coefficients not available for T and S") endif diff --git a/src/tracer/MOM_neutral_diffusion_aux.F90 b/src/tracer/MOM_neutral_diffusion_aux.F90 index ca3435ded0..1ecfd7a25a 100644 --- a/src/tracer/MOM_neutral_diffusion_aux.F90 +++ b/src/tracer/MOM_neutral_diffusion_aux.F90 @@ -465,7 +465,7 @@ real function refine_nondim_position(CS, T_ref, S_ref, alpha_ref, beta_ref, P_to ! For the logic to find neutral surfaces to work properly, the function needs to converge to zero ! or a small negative value - if( (fb <= 0.) .and. (fb >= -CS%drho_tol) ) then + if ((fb <= 0.) .and. (fb >= -CS%drho_tol)) then refine_nondim_position = b exit endif diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 39c8385029..49332bf813 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -585,9 +585,9 @@ subroutine offline_add_diurnal_SW(fluxes, G, Time_start, Time_end) i2 = i+i_off ; j2 = j+j_off fluxes%sw(i2,j2) = fluxes%sw(i2,j2) * diurnal_factor fluxes%sw_vis_dir(i2,j2) = fluxes%sw_vis_dir(i2,j2) * diurnal_factor - fluxes%sw_vis_dif (i2,j2) = fluxes%sw_vis_dif (i2,j2) * diurnal_factor + fluxes%sw_vis_dif(i2,j2) = fluxes%sw_vis_dif(i2,j2) * diurnal_factor fluxes%sw_nir_dir(i2,j2) = fluxes%sw_nir_dir(i2,j2) * diurnal_factor - fluxes%sw_nir_dif (i2,j2) = fluxes%sw_nir_dif (i2,j2) * diurnal_factor + fluxes%sw_nir_dif(i2,j2) = fluxes%sw_nir_dif(i2,j2) * diurnal_factor enddo ; enddo end subroutine offline_add_diurnal_sw @@ -707,17 +707,17 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ call MOM_read_data(mean_file,'sw_nir',fluxes%sw_nir_dir, G%Domain, & timelevel=ridx_sum) fluxes%sw_vis_dir(:,:) = fluxes%sw_vis_dir(:,:)*0.5 - fluxes%sw_vis_dif (:,:) = fluxes%sw_vis_dir + fluxes%sw_vis_dif(:,:) = fluxes%sw_vis_dir fluxes%sw_nir_dir(:,:) = fluxes%sw_nir_dir(:,:)*0.5 - fluxes%sw_nir_dif (:,:) = fluxes%sw_nir_dir + fluxes%sw_nir_dif(:,:) = fluxes%sw_nir_dir fluxes%sw = fluxes%sw_vis_dir + fluxes%sw_vis_dif + fluxes%sw_nir_dir + fluxes%sw_nir_dif do j=js,je ; do i=is,ie if (G%mask2dT(i,j)<1.0) then fluxes%sw(i,j) = 0.0 fluxes%sw_vis_dir(i,j) = 0.0 fluxes%sw_nir_dir(i,j) = 0.0 - fluxes%sw_vis_dif (i,j) = 0.0 - fluxes%sw_nir_dif (i,j) = 0.0 + fluxes%sw_vis_dif(i,j) = 0.0 + fluxes%sw_nir_dif(i,j) = 0.0 endif enddo ; enddo call pass_var(fluxes%sw,G%Domain) diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index eed7039fe4..54c47792b6 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -299,7 +299,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo - if(CS%debug) then + if (CS%debug) then call hchksum(h_vol,"h_vol before advect",G%HI) call uvchksum("[uv]htr_sub before advect", uhtr_sub, vhtr_sub, G%HI) write(debug_msg, '(A,I4.4)') 'Before advect ', iter diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 405c7e87d0..efb0b6ceed 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -121,8 +121,8 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & max_iter = 2*INT(CEILING(dt/CS%dt)) + 1 - if(present(max_iter_in)) max_iter = max_iter_in - if(present(x_first_in)) x_first = x_first_in + if (present(max_iter_in)) max_iter = max_iter_in + if (present(x_first_in)) x_first = x_first_in call cpu_clock_begin(id_clock_pass) call create_group_pass(CS%pass_uhr_vhr_t_hprev, uhr, vhr, G%Domain) call create_group_pass(CS%pass_uhr_vhr_t_hprev, hprev, G%Domain) @@ -309,9 +309,9 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & enddo ! Iterations loop - if(present(uhr_out)) uhr_out(:,:,:) = uhr(:,:,:) - if(present(vhr_out)) vhr_out(:,:,:) = vhr(:,:,:) - if(present(h_out)) h_out(:,:,:) = hprev(:,:,:) + if (present(uhr_out)) uhr_out(:,:,:) = uhr(:,:,:) + if (present(vhr_out)) vhr_out(:,:,:) = vhr(:,:,:) + if (present(h_out)) h_out(:,:,:) = hprev(:,:,:) call cpu_clock_end(id_clock_advect) diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index f8762985c5..f61b5a6a5e 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -87,7 +87,7 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & !$OMP do do j=js,je; do i=is,ie ; sfc_src(i,j) = 0.0 ; btm_src(i,j) = 0.0 ; enddo; enddo if (present(sfc_flux)) then - if(convert_flux) then + if (convert_flux) then !$OMP do do j = js, je; do i = is,ie sfc_src(i,j) = (sfc_flux(i,j)*dt) * GV%kg_m2_to_H @@ -100,7 +100,7 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & endif endif if (present(btm_flux)) then - if(convert_flux) then + if (convert_flux) then !$OMP do do j = js, je; do i = is,ie btm_src(i,j) = (btm_flux(i,j)*dt) * GV%kg_m2_to_H @@ -268,12 +268,12 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim if ( (.not. associated(fluxes%netMassIn)) .or. (.not. associated(fluxes%netMassOut)) ) return in_flux(:,:) = 0.0 ; out_flux(:,:) = 0.0 - if(present(in_flux_optional)) then + if (present(in_flux_optional)) then do j=js,je ; do i=is,ie in_flux(i,j) = in_flux_optional(i,j) enddo; enddo endif - if(present(out_flux_optional)) then + if (present(out_flux_optional)) then do j=js,je ; do i=is,ie out_flux(i,j) = out_flux_optional(i,j) enddo ; enddo diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index ef8abe9bbf..b98d39e4d8 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -294,7 +294,7 @@ subroutine boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, ! Set surface conditions do m=1,1 - if(CS%remaining_source_time>0.0) then + if (CS%remaining_source_time>0.0) then do k=1,CS%nkml ; do j=js,je ; do i=is,ie CS%tr(i,j,k,m) = 1.0 enddo ; enddo ; enddo diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index 479de3d059..65cd122234 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -290,7 +290,7 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G CS%diff(i,j,k) = CS%ps(i,j,k)-tv%S(i,j,k) enddo ; enddo ; enddo - if(debug) then + if (debug) then call hchksum(tv%S,"salt post pseudo-salt vertdiff", G%HI) call hchksum(CS%ps,"pseudo_salt post pseudo-salt vertdiff", G%HI) endif From 562acf0b5eb3f5b13044bd42ae920020906add08 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 5 May 2018 09:57:17 -0400 Subject: [PATCH 0188/1072] Replaced '.ge.' with '>=' Replace the older Fortran syntax '.ge.', '.gt.', '.lt.', and '.le.' with the clearer and more succinct syntax '>=', '>', '<', and '<='. All answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 2 +- .../solo_driver/Neverland_surface_forcing.F90 | 26 +-- src/ALE/P1M_functions.F90 | 4 +- src/ALE/P3M_functions.F90 | 50 +++--- src/ALE/PPM_functions.F90 | 12 +- src/ALE/PQM_functions.F90 | 100 ++++++------ src/ALE/regrid_edge_values.F90 | 8 +- src/ALE/regrid_solvers.F90 | 4 +- src/equation_of_state/MOM_EOS.F90 | 2 +- src/equation_of_state/MOM_EOS_TEOS10.F90 | 4 +- src/equation_of_state/MOM_TFreeze.F90 | 2 +- src/framework/MOM_horizontal_regridding.F90 | 20 +-- src/ice_shelf/MOM_ice_shelf.F90 | 152 +++++++++--------- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 16 +- src/ice_shelf/user_shelf_init.F90 | 8 +- src/initialization/midas_vertmap.F90 | 2 +- .../vertical/MOM_CVMix_shear.F90 | 2 +- .../vertical/MOM_energetic_PBL.F90 | 8 +- src/tracer/MOM_OCMIP2_CO2calc.F90 | 10 +- src/tracer/MOM_generic_tracer.F90 | 6 +- src/user/MOM_wave_interface.F90 | 16 +- src/user/SCM_CVmix_tests.F90 | 4 +- src/user/SCM_idealized_hurricane.F90 | 16 +- src/user/dyed_channel_initialization.F90 | 2 +- src/user/dyed_obcs_initialization.F90 | 2 +- src/user/sloshing_initialization.F90 | 6 +- 26 files changed, 242 insertions(+), 242 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index ce699b1397..d6319558ec 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -352,7 +352,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & open_ocn_mask(:,:) = 1.0 if (CS%mask_srestore_under_ice) then ! Do not restore under sea-ice do j=js,je ; do i=is,ie - if (sfc_state%SST(i,j) .le. -0.0539*sfc_state%SSS(i,j)) open_ocn_mask(i,j)=0.0 + if (sfc_state%SST(i,j) <= -0.0539*sfc_state%SSS(i,j)) open_ocn_mask(i,j)=0.0 enddo; enddo endif if (CS%salt_restore_as_sflux) then diff --git a/config_src/solo_driver/Neverland_surface_forcing.F90 b/config_src/solo_driver/Neverland_surface_forcing.F90 index 588fa5fde8..972132ae6a 100644 --- a/config_src/solo_driver/Neverland_surface_forcing.F90 +++ b/config_src/solo_driver/Neverland_surface_forcing.F90 @@ -73,23 +73,23 @@ subroutine Neverland_wind_forcing(sfc_state, forces, day, G, CS) ! The i-loop extends to is-1 so that taux can be used later in the ! calculation of ustar - otherwise the lower bound would be Isq. - PI = 4.0*atan(1.0) - forces%taux(:,:) = 0.0 - tau_max = 0.2 - off = 0.02 + PI = 4.0*atan(1.0) + forces%taux(:,:) = 0.0 + tau_max = 0.2 + off = 0.02 do j=js,je ; do I=is-1,Ieq -! x=(G%geoLonT(i,j)-G%west_lon)/G%len_lon - y=(G%geoLatT(i,j)-G%south_lat)/G%len_lat -! forces%taux(I,j) = G%mask2dCu(I,j) * 0.0 +! x = (G%geoLonT(i,j)-G%west_lon)/G%len_lon + y = (G%geoLatT(i,j)-G%south_lat)/G%len_lat +! forces%taux(I,j) = G%mask2dCu(I,j) * 0.0 - if (y.le.0.29) then - forces%taux(I,j) = forces%taux(I,j) + tau_max * ( (1/0.29)*y - ( 1/(2*PI) )*sin( (2*PI*y) / 0.29 ) ) + if (y <= 0.29) then + forces%taux(I,j) = forces%taux(I,j) + tau_max * ( (1/0.29)*y - ( 1/(2*PI) )*sin( (2*PI*y) / 0.29 ) ) endif - if (y.gt.0.29 .and. y.le.(0.8-off)) then - forces%taux(I,j) = forces%taux(I,j) + tau_max *(0.35+0.65*cos(PI*(y-0.29)/(0.51-off)) ) + if ((y > 0.29) .and. (y <= (0.8-off))) then + forces%taux(I,j) = forces%taux(I,j) + tau_max *(0.35+0.65*cos(PI*(y-0.29)/(0.51-off)) ) endif - if (y.gt.(0.8-off) .and. y.le.(1-off) ) then - forces%taux(I,j) = forces%taux(I,j) + tau_max *( 1.5*( (y-1+off) - (0.1/PI)*sin(10.0*PI*(y-0.8+off)) ) ) + if ((y > (0.8-off)) .and. (y <= (1-off))) then + forces%taux(I,j) = forces%taux(I,j) + tau_max *( 1.5*( (y-1+off) - (0.1/PI)*sin(10.0*PI*(y-0.8+off)) ) ) endif enddo ; enddo diff --git a/src/ALE/P1M_functions.F90 b/src/ALE/P1M_functions.F90 index a7a7635800..14190bd3ea 100644 --- a/src/ALE/P1M_functions.F90 +++ b/src/ALE/P1M_functions.F90 @@ -145,7 +145,7 @@ subroutine P1M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients ) ! by using the edge value in the neighboring cell. u0_r = u0 + 0.5 * slope - if ( (u1 - u0) * (ppoly_E(2,1) - u0_r) .LT. 0.0 ) then + if ( (u1 - u0) * (ppoly_E(2,1) - u0_r) < 0.0 ) then slope = 2.0 * ( ppoly_E(2,1) - u0 ) end if @@ -173,7 +173,7 @@ subroutine P1M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients ) u0_l = u1 - 0.5 * slope - if ( (u1 - u0) * (u0_l - ppoly_E(N-1,2)) .LT. 0.0 ) then + if ( (u1 - u0) * (u0_l - ppoly_E(N-1,2)) < 0.0 ) then slope = 2.0 * ( u1 - ppoly_E(N-1,2) ) end if diff --git a/src/ALE/P3M_functions.F90 b/src/ALE/P3M_functions.F90 index ecc7136ead..7ea9f9283b 100644 --- a/src/ALE/P3M_functions.F90 +++ b/src/ALE/P3M_functions.F90 @@ -154,7 +154,7 @@ subroutine P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coefficients, h_neglect sigma_c = 2.0 * ( u_r - u_l ) / ( h_l + 2.0*h_c + h_r + hNeglect ) sigma_r = 2.0 * ( u_r - u_c ) / ( h_c + hNeglect ) - if ( (sigma_l * sigma_r) .GT. 0.0 ) then + if ( (sigma_l * sigma_r) > 0.0 ) then slope = sign( min(abs(sigma_l),abs(sigma_c),abs(sigma_r)), sigma_c ) else slope = 0.0 @@ -173,11 +173,11 @@ subroutine P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coefficients, h_neglect ! The edge slopes are limited from above by the respective ! one-sided slopes - if ( abs(u1_l) .GT. abs(sigma_l) ) then + if ( abs(u1_l) > abs(sigma_l) ) then u1_l = sigma_l end if - if ( abs(u1_r) .GT. abs(sigma_r) ) then + if ( abs(u1_r) > abs(sigma_r) ) then u1_r = sigma_r end if @@ -268,7 +268,7 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coeffici ! Limit the right slope by the PLM limited slope slope = 2.0 * ( u1 - u0 ) / ( h0 + hNeglect ) - if ( abs(u1_r) .GT. abs(slope) ) then + if ( abs(u1_r) > abs(slope) ) then u1_r = slope end if @@ -285,7 +285,7 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coeffici ! Check whether the edge values are monotonic. For example, if the left edge ! value is larger than the right edge value while the slope is positive, the ! edge values are inconsistent and we need to modify the left edge value - if ( (u0_r-u0_l) * slope .LT. 0.0 ) then + if ( (u0_r-u0_l) * slope < 0.0 ) then u0_l = u0_r u1_l = 0.0 u1_r = 0.0 @@ -328,7 +328,7 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coeffici ! Limit the left slope by the PLM limited slope slope = 2.0 * ( u1 - u0 ) / ( h1 + hNeglect ) - if ( abs(u1_l) .GT. abs(slope) ) then + if ( abs(u1_l) > abs(slope) ) then u1_l = slope end if @@ -345,7 +345,7 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coeffici ! Check whether the edge values are monotonic. For example, if the right edge ! value is smaller than the left edge value while the slope is positive, the ! edge values are inconsistent and we need to modify the right edge value - if ( (u0_r-u0_l) * slope .LT. 0.0 ) then + if ( (u0_r-u0_l) * slope < 0.0 ) then u0_r = u0_l u1_l = 0.0 u1_r = 0.0 @@ -461,19 +461,19 @@ integer function is_cubic_monotonic( ppoly_coefficients, k ) rho = b*b - 4.0*a*c - if ( rho .GE. 0.0 ) then - if ( abs(c) .GT. 1e-15 ) then + if ( rho >= 0.0 ) then + if ( abs(c) > 1e-15 ) then xi_0 = 0.5 * ( -b - sqrt( rho ) ) / c xi_1 = 0.5 * ( -b + sqrt( rho ) ) / c - else if ( abs(b) .GT. 1e-15 ) then + else if ( abs(b) > 1e-15 ) then xi_0 = - a / b xi_1 = - a / b end if ! If one of the roots of the first derivative lies in (0,1), ! the cubic is not monotonic. - if ( ( (xi_0 .GT. eps) .AND. (xi_0 .LT. 1.0-eps) ) .OR. & - ( (xi_1 .GT. eps) .AND. (xi_1 .LT. 1.0-eps) ) ) then + if ( ( (xi_0 > eps) .AND. (xi_0 < 1.0-eps) ) .OR. & + ( (xi_1 > eps) .AND. (xi_1 < 1.0-eps) ) ) then monotonic = 0 else monotonic = 1 @@ -547,11 +547,11 @@ subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r ! If the edge slopes are inconsistent w.r.t. the limited PLM slope, ! set them to zero - if ( u1_l*slope .LE. 0.0 ) then + if ( u1_l*slope <= 0.0 ) then u1_l = 0.0 end if - if ( u1_r*slope .LE. 0.0 ) then + if ( u1_r*slope <= 0.0 ) then u1_r = 0.0 end if @@ -569,7 +569,7 @@ subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r xi_ip = - a2 / (3.0 * a3) ! If the inflexion point lies in [0,1], change boolean value - if ( (xi_ip .GE. 0.0) .AND. (xi_ip .LE. 1.0) ) then + if ( (xi_ip >= 0.0) .AND. (xi_ip <= 1.0) ) then found_ip = 1 end if end if @@ -583,8 +583,8 @@ subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r slope_ip = a1 + 2.0*a2*xi_ip + 3.0*a3*xi_ip*xi_ip ! Check whether slope is consistent - if ( slope_ip*slope .LT. 0.0 ) then - if ( abs(sigma_l) .LT. abs(sigma_r) ) then + if ( slope_ip*slope < 0.0 ) then + if ( abs(sigma_l) < abs(sigma_r) ) then inflexion_l = 1 else inflexion_r = 1 @@ -602,17 +602,17 @@ subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r u1_l_tmp = 1.5*(u0_r-u0_l)/h - 0.5*u1_r u1_r_tmp = 3.0*(u0_r-u0_l)/h - 2.0*u1_l - if ( (u1_l_tmp*slope .LT. 0.0) .AND. (u1_r_tmp*slope .LT. 0.0) ) then + if ( (u1_l_tmp*slope < 0.0) .AND. (u1_r_tmp*slope < 0.0) ) then u1_l = 0.0 u1_r = 3.0 * (u0_r - u0_l) / h - else if (u1_l_tmp*slope .LT. 0.0) then + else if (u1_l_tmp*slope < 0.0) then u1_r = u1_r_tmp u1_l = 1.5*(u0_r - u0_l)/h - 0.5*u1_r - else if (u1_r_tmp*slope .LT. 0.0) then + else if (u1_r_tmp*slope < 0.0) then u1_l = u1_l_tmp u1_r = 3.0*(u0_r - u0_l)/h - 2.0*u1_l @@ -632,17 +632,17 @@ subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r u1_l_tmp = 3.0*(u0_r-u0_l)/h - 2.0*u1_r u1_r_tmp = 1.5*(u0_r-u0_l)/h - 0.5*u1_l - if ( (u1_l_tmp*slope .LT. 0.0) .AND. (u1_r_tmp*slope .LT. 0.0) ) then + if ( (u1_l_tmp*slope < 0.0) .AND. (u1_r_tmp*slope < 0.0) ) then u1_l = 3.0 * (u0_r - u0_l) / h u1_r = 0.0 - else if (u1_l_tmp*slope .LT. 0.0) then + else if (u1_l_tmp*slope < 0.0) then u1_r = u1_r_tmp u1_l = 3.0*(u0_r - u0_l)/h - 2.0*u1_r - else if (u1_r_tmp*slope .LT. 0.0) then + else if (u1_r_tmp*slope < 0.0) then u1_l = u1_l_tmp u1_r = 1.5*(u0_r - u0_l)/h - 0.5*u1_l @@ -656,11 +656,11 @@ subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r end if ! end treating case with inflexion point on the right - if ( abs(u1_l*h) .LT. eps ) then + if ( abs(u1_l*h) < eps ) then u1_l = 0.0 end if - if ( abs(u1_r*h) .LT. eps ) then + if ( abs(u1_r*h) < eps ) then u1_r = 0.0 end if diff --git a/src/ALE/PPM_functions.F90 b/src/ALE/PPM_functions.F90 index 4dd6699722..484e2e0d40 100644 --- a/src/ALE/PPM_functions.F90 +++ b/src/ALE/PPM_functions.F90 @@ -193,7 +193,7 @@ subroutine PPM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients, h_n ! Limit the right slope by the PLM limited slope slope = 2.0 * ( u1 - u0 ) - if ( abs(u1_r) .GT. abs(slope) ) then + if ( abs(u1_r) > abs(slope) ) then u1_r = slope end if @@ -210,11 +210,11 @@ subroutine PPM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients, h_n exp1 = (u0_r - u0_l) * (u0 - 0.5*(u0_l+u0_r)) exp2 = (u0_r - u0_l) * (u0_r - u0_l) / 6.0 - if ( exp1 .GT. exp2 ) then + if ( exp1 > exp2 ) then u0_l = 3.0 * u0 - 2.0 * u0_r end if - if ( exp1 .LT. -exp2 ) then + if ( exp1 < -exp2 ) then u0_r = 3.0 * u0 - 2.0 * u0_l end if @@ -246,7 +246,7 @@ subroutine PPM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients, h_n ! Limit the left slope by the PLM limited slope slope = 2.0 * ( u1 - u0 ) - if ( abs(u1_l) .GT. abs(slope) ) then + if ( abs(u1_l) > abs(slope) ) then u1_l = slope end if @@ -263,11 +263,11 @@ subroutine PPM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients, h_n exp1 = (u0_r - u0_l) * (u1 - 0.5*(u0_l+u0_r)) exp2 = (u0_r - u0_l) * (u0_r - u0_l) / 6.0 - if ( exp1 .GT. exp2 ) then + if ( exp1 > exp2 ) then u0_l = 3.0 * u1 - 2.0 * u0_r end if - if ( exp1 .LT. -exp2 ) then + if ( exp1 < -exp2 ) then u0_r = 3.0 * u1 - 2.0 * u0_l end if diff --git a/src/ALE/PQM_functions.F90 b/src/ALE/PQM_functions.F90 index 707cd9f40f..b91b52b437 100644 --- a/src/ALE/PQM_functions.F90 +++ b/src/ALE/PQM_functions.F90 @@ -141,7 +141,7 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) ! Loop on interior cells to apply the PQM limiter do k = 2,N-1 - !if ( h(k) .lt. 1.0 ) cycle + !if ( h(k) < 1.0 ) cycle inflexion_l = 0 inflexion_r = 0 @@ -166,7 +166,7 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) sigma_c = 2.0 * ( u_r - u_l ) / ( h_l + 2.0*h_c + h_r + hNeglect ) sigma_r = 2.0 * ( u_r - u_c ) / ( h_c + hNeglect ) - if ( (sigma_l * sigma_r) .GT. 0.0 ) then + if ( (sigma_l * sigma_r) > 0.0 ) then slope = sign( min(abs(sigma_l),abs(sigma_c),abs(sigma_r)), sigma_c ) else slope = 0.0 @@ -174,11 +174,11 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) ! If one of the slopes has the wrong sign compared with the ! limited PLM slope, it is set equal to the limited PLM slope - if ( u1_l*slope .le. 0.0 ) u1_l = slope - if ( u1_r*slope .le. 0.0 ) u1_r = slope + if ( u1_l*slope <= 0.0 ) u1_l = slope + if ( u1_r*slope <= 0.0 ) u1_r = slope ! Local extremum --> flatten - if ( (u0_r - u_c) * (u_c - u0_l) .le. 0.0) then + if ( (u0_r - u_c) * (u_c - u0_l) <= 0.0) then u0_l = u_c u0_r = u_c u1_l = 0.0 @@ -208,7 +208,7 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) rho = alpha2 * alpha2 - 4.0 * alpha1 * alpha3 ! Check whether inflexion points exist - if (( alpha1 .ne. 0.0 ) .and. ( rho .ge. 0.0 )) then + if (( alpha1 .ne. 0.0 ) .and. ( rho >= 0.0 )) then sqrt_rho = sqrt( rho ) @@ -216,18 +216,18 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) x2 = 0.5 * ( - alpha2 + sqrt_rho ) / alpha1 ! Check whether both inflexion points lie in [0,1] - if ( (x1 .GE. 0.0) .AND. (x1 .LE. 1.0) .AND. & - (x2 .GE. 0.0) .AND. (x2 .LE. 1.0) ) then + if ( (x1 >= 0.0) .AND. (x1 <= 1.0) .AND. & + (x2 >= 0.0) .AND. (x2 <= 1.0) ) then gradient1 = 4.0 * e * (x1**3) + 3.0 * d * (x1**2) + 2.0 * c * x1 + b gradient2 = 4.0 * e * (x2**3) + 3.0 * d * (x2**2) + 2.0 * c * x2 + b ! Check whether one of the gradients is inconsistent - if ( (gradient1 * slope .LT. 0.0) .OR. & - (gradient2 * slope .LT. 0.0) ) then + if ( (gradient1 * slope < 0.0) .OR. & + (gradient2 * slope < 0.0) ) then ! Decide where to collapse inflexion points ! (depends on one-sided slopes) - if ( abs(sigma_l) .LT. abs(sigma_r) ) then + if ( abs(sigma_l) < abs(sigma_r) ) then inflexion_l = 1 else inflexion_r = 1 @@ -236,15 +236,15 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) ! If both x1 and x2 do not lie in [0,1], check whether ! only x1 lies in [0,1] - else if ( (x1 .GE. 0.0) .AND. (x1 .LE. 1.0) ) then + else if ( (x1 >= 0.0) .AND. (x1 <= 1.0) ) then gradient1 = 4.0 * e * (x1**3) + 3.0 * d * (x1**2) + 2.0 * c * x1 + b ! Check whether the gradient is inconsistent - if ( gradient1 * slope .LT. 0.0 ) then + if ( gradient1 * slope < 0.0 ) then ! Decide where to collapse inflexion points ! (depends on one-sided slopes) - if ( abs(sigma_l) .LT. abs(sigma_r) ) then + if ( abs(sigma_l) < abs(sigma_r) ) then inflexion_l = 1 else inflexion_r = 1 @@ -252,15 +252,15 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) end if ! If x1 does not lie in [0,1], check whether x2 lies in [0,1] - else if ( (x2 .GE. 0.0) .AND. (x2 .LE. 1.0) ) then + else if ( (x2 >= 0.0) .AND. (x2 <= 1.0) ) then gradient2 = 4.0 * e * (x2**3) + 3.0 * d * (x2**2) + 2.0 * c * x2 + b ! Check whether the gradient is inconsistent - if ( gradient2 * slope .LT. 0.0 ) then + if ( gradient2 * slope < 0.0 ) then ! Decide where to collapse inflexion points ! (depends on one-sided slopes) - if ( abs(sigma_l) .LT. abs(sigma_r) ) then + if ( abs(sigma_l) < abs(sigma_r) ) then inflexion_l = 1 else inflexion_r = 1 @@ -276,15 +276,15 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) if (( alpha1 .eq. 0.0 ) .and. ( alpha2 .ne. 0.0 )) then x1 = - alpha3 / alpha2 - if ( (x1 .ge. 0.0) .AND. (x1 .le. 1.0) ) then + if ( (x1 >= 0.0) .AND. (x1 <= 1.0) ) then gradient1 = 4.0 * e * (x1**3) + 3.0 * d * (x1**2) + 2.0 * c * x1 + b ! Check whether the gradient is inconsistent - if ( gradient1 * slope .LT. 0.0 ) then + if ( gradient1 * slope < 0.0 ) then ! Decide where to collapse inflexion points ! (depends on one-sided slopes) - if ( abs(sigma_l) .LT. abs(sigma_r) ) then + if ( abs(sigma_l) < abs(sigma_r) ) then inflexion_l = 1 else inflexion_r = 1 @@ -309,13 +309,13 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) ! the inconsistent slope is set equal to zero and the opposite edge value ! and edge slope are modified in compliance with the fact that both ! inflexion points must still be located on the left edge - if ( u1_l * slope .LT. 0.0 ) then + if ( u1_l * slope < 0.0 ) then u1_l = 0.0 u0_r = 5.0 * u_c - 4.0 * u0_l u1_r = 20.0 * (u_c - u0_l) / ( h_c + hNeglect ) - else if ( u1_r * slope .LT. 0.0 ) then + else if ( u1_r * slope < 0.0 ) then u1_r = 0.0 u0_l = (5.0*u_c - 3.0*u0_r) / 2.0 @@ -334,13 +334,13 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) ! the inconsistent slope is set equal to zero and the opposite edge value ! and edge slope are modified in compliance with the fact that both ! inflexion points must still be located on the right edge - if ( u1_l * slope .LT. 0.0 ) then + if ( u1_l * slope < 0.0 ) then u1_l = 0.0 u0_r = ( 5.0 * u_c - 3.0 * u0_l ) / 2.0 u1_r = 10.0 * (u_c - u0_l) / (3.0 * h_c + hNeglect) - else if ( u1_r * slope .LT. 0.0 ) then + else if ( u1_r * slope < 0.0 ) then u1_r = 0.0 u0_l = 5.0 * u_c - 4.0 * u0_r @@ -427,7 +427,7 @@ subroutine PQM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients ) ! Limit the right slope by the PLM limited slope slope = 2.0 * ( u1 - u0 ) - if ( abs(u1_r) .GT. abs(slope) ) then + if ( abs(u1_r) > abs(slope) ) then u1_r = slope end if @@ -444,11 +444,11 @@ subroutine PQM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients ) exp1 = (u0_r - u0_l) * (u0 - 0.5*(u0_l+u0_r)) exp2 = (u0_r - u0_l) * (u0_r - u0_l) / 6.0 - if ( exp1 .GT. exp2 ) then + if ( exp1 > exp2 ) then u0_l = 3.0 * u0 - 2.0 * u0_r end if - if ( exp1 .LT. -exp2 ) then + if ( exp1 < -exp2 ) then u0_r = 3.0 * u0 - 2.0 * u0_l end if @@ -485,7 +485,7 @@ subroutine PQM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients ) ! Limit the left slope by the PLM limited slope slope = 2.0 * ( u1 - u0 ) - if ( abs(u1_l) .GT. abs(slope) ) then + if ( abs(u1_l) > abs(slope) ) then u1_l = slope end if @@ -502,11 +502,11 @@ subroutine PQM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients ) exp1 = (u0_r - u0_l) * (u1 - 0.5*(u0_l+u0_r)) exp2 = (u0_r - u0_l) * (u0_r - u0_l) / 6.0 - if ( exp1 .GT. exp2 ) then + if ( exp1 > exp2 ) then u0_l = 3.0 * u1 - 2.0 * u0_r end if - if ( exp1 .LT. -exp2 ) then + if ( exp1 < -exp2 ) then u0_r = 3.0 * u1 - 2.0 * u0_l end if @@ -626,7 +626,7 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coeff ! the PLM edge value. If so, keep it and compute left edge slope ! based on the rational function. If not, keep the PLM edge value and ! compute corresponding slope. - if ( abs(um-u0_l) .lt. abs(um-u_plm) ) then + if ( abs(um-u0_l) < abs(um-u_plm) ) then u1_l = 2.0 * ( br - ar*beta) u1_l = u1_l / (h0 + hNeglect) else @@ -651,22 +651,22 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coeff ! Check whether inflexion points exist. If so, transform the quartic ! so that both inflexion points coalesce on the left edge. - if (( alpha1 .ne. 0.0 ) .and. ( rho .ge. 0.0 )) then + if (( alpha1 .ne. 0.0 ) .and. ( rho >= 0.0 )) then sqrt_rho = sqrt( rho ) x1 = 0.5 * ( - alpha2 - sqrt_rho ) / alpha1 - if ( (x1 .gt. 0.0) .and. (x1 .lt. 1.0) ) then + if ( (x1 > 0.0) .and. (x1 < 1.0) ) then gradient1 = 4.0 * e * (x1**3) + 3.0 * d * (x1**2) + 2.0 * c * x1 + b - if ( gradient1 * slope .lt. 0.0 ) then + if ( gradient1 * slope < 0.0 ) then inflexion_l = 1 end if end if x2 = 0.5 * ( - alpha2 + sqrt_rho ) / alpha1 - if ( (x2 .gt. 0.0) .and. (x2 .lt. 1.0) ) then + if ( (x2 > 0.0) .and. (x2 < 1.0) ) then gradient2 = 4.0 * e * (x2**3) + 3.0 * d * (x2**2) + 2.0 * c * x2 + b - if ( gradient2 * slope .lt. 0.0 ) then + if ( gradient2 * slope < 0.0 ) then inflexion_l = 1 end if end if @@ -676,9 +676,9 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coeff if (( alpha1 .eq. 0.0 ) .and. ( alpha2 .ne. 0.0 )) then x1 = - alpha3 / alpha2 - if ( (x1 .ge. 0.0) .and. (x1 .le. 1.0) ) then + if ( (x1 >= 0.0) .and. (x1 <= 1.0) ) then gradient1 = 3.0 * d * (x1**2) + 2.0 * c * x1 + b - if ( gradient1 * slope .lt. 0.0 ) then + if ( gradient1 * slope < 0.0 ) then inflexion_l = 1 end if end if @@ -696,13 +696,13 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coeff ! the inconsistent slope is set equal to zero and the opposite edge value ! and edge slope are modified in compliance with the fact that both ! inflexion points must still be located on the left edge - if ( u1_l * slope .LT. 0.0 ) then + if ( u1_l * slope < 0.0 ) then u1_l = 0.0 u0_r = 5.0 * um - 4.0 * u0_l u1_r = 20.0 * (um - u0_l) / ( h0 + hNeglect ) - else if ( u1_r * slope .LT. 0.0 ) then + else if ( u1_r * slope < 0.0 ) then u1_r = 0.0 u0_l = (5.0*um - 3.0*u0_r) / 2.0 @@ -779,7 +779,7 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coeff ! the PLM edge value. If so, keep it and compute right edge slope ! based on the rational function. If not, keep the PLM edge value and ! compute corresponding slope. - if ( abs(um-u0_r) .lt. abs(um-u_plm) ) then + if ( abs(um-u0_r) < abs(um-u_plm) ) then u1_r = 2.0 * ( br - ar*beta ) / ( (1+beta)*(1+beta)*(1+beta) ) u1_r = u1_r / h1 else @@ -804,22 +804,22 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coeff ! Check whether inflexion points exist. If so, transform the quartic ! so that both inflexion points coalesce on the right edge. - if (( alpha1 .ne. 0.0 ) .and. ( rho .ge. 0.0 )) then + if (( alpha1 .ne. 0.0 ) .and. ( rho >= 0.0 )) then sqrt_rho = sqrt( rho ) x1 = 0.5 * ( - alpha2 - sqrt_rho ) / alpha1 - if ( (x1 .gt. 0.0) .and. (x1 .lt. 1.0) ) then + if ( (x1 > 0.0) .and. (x1 < 1.0) ) then gradient1 = 4.0 * e * (x1**3) + 3.0 * d * (x1**2) + 2.0 * c * x1 + b - if ( gradient1 * slope .lt. 0.0 ) then + if ( gradient1 * slope < 0.0 ) then inflexion_r = 1 end if end if x2 = 0.5 * ( - alpha2 + sqrt_rho ) / alpha1 - if ( (x2 .gt. 0.0) .and. (x2 .lt. 1.0) ) then + if ( (x2 > 0.0) .and. (x2 < 1.0) ) then gradient2 = 4.0 * e * (x2**3) + 3.0 * d * (x2**2) + 2.0 * c * x2 + b - if ( gradient2 * slope .lt. 0.0 ) then + if ( gradient2 * slope < 0.0 ) then inflexion_r = 1 end if end if @@ -829,9 +829,9 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coeff if (( alpha1 .eq. 0.0 ) .and. ( alpha2 .ne. 0.0 )) then x1 = - alpha3 / alpha2 - if ( (x1 .ge. 0.0) .and. (x1 .le. 1.0) ) then + if ( (x1 >= 0.0) .and. (x1 <= 1.0) ) then gradient1 = 3.0 * d * (x1**2) + 2.0 * c * x1 + b - if ( gradient1 * slope .lt. 0.0 ) then + if ( gradient1 * slope < 0.0 ) then inflexion_r = 1 end if end if @@ -849,13 +849,13 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coeff ! the inconsistent slope is set equal to zero and the opposite edge value ! and edge slope are modified in compliance with the fact that both ! inflexion points must still be located on the right edge - if ( u1_l * slope .lt. 0.0 ) then + if ( u1_l * slope < 0.0 ) then u1_l = 0.0 u0_r = ( 5.0 * um - 3.0 * u0_l ) / 2.0 u1_r = 10.0 * (um - u0_l) / (3.0 * h1) - else if ( u1_r * slope .lt. 0.0 ) then + else if ( u1_r * slope < 0.0 ) then u1_r = 0.0 u0_l = 5.0 * um - 4.0 * u0_r diff --git a/src/ALE/regrid_edge_values.F90 b/src/ALE/regrid_edge_values.F90 index fafb873a6c..d7e8ee54b5 100644 --- a/src/ALE/regrid_edge_values.F90 +++ b/src/ALE/regrid_edge_values.F90 @@ -118,7 +118,7 @@ subroutine bound_edge_values( N, h, u, edge_values, h_neglect ) sigma_c = 2.0 * ( u_r - u_l ) / ( h_l + 2.0*h_c + h_r + hNeglect ) sigma_r = 2.0 * ( u_r - u_c ) / ( h_c + hNeglect ) - if ( (sigma_l * sigma_r) .GT. 0.0 ) then + if ( (sigma_l * sigma_r) > 0.0 ) then slope = sign( min(abs(sigma_l),abs(sigma_c),abs(sigma_r)), sigma_c ) else slope = 0.0 @@ -130,11 +130,11 @@ subroutine bound_edge_values( N, h, u, edge_values, h_neglect ) ! JCP 2008 Eqs 19 and 20) slope = slope * h_c * 0.5 - if ( (u_l-u0_l)*(u0_l-u_c) .LT. 0.0 ) then + if ( (u_l-u0_l)*(u0_l-u_c) < 0.0 ) then u0_l = u_c - sign( min( abs(slope), abs(u0_l-u_c) ), slope ) end if - if ( (u_r-u0_r)*(u0_r-u_c) .LT. 0.0 ) then + if ( (u_r-u0_r)*(u0_r-u_c) < 0.0 ) then u0_r = u_c + sign( min( abs(slope), abs(u0_r-u_c) ), slope ) end if @@ -227,7 +227,7 @@ subroutine check_discontinuous_edge_values( N, u, edge_values ) ! Right cell average um_plus = u(k+1) - if ( (u0_plus - u0_minus)*(um_plus - um_minus) .LT. 0.0 ) then + if ( (u0_plus - u0_minus)*(um_plus - um_minus) < 0.0 ) then u0_avg = 0.5 * ( u0_minus + u0_plus ) u0_avg = max( min( u0_avg, max(um_minus, um_plus) ), min(um_minus, um_plus) ) edge_values(k,2) = u0_avg diff --git a/src/ALE/regrid_solvers.F90 b/src/ALE/regrid_solvers.F90 index b9e775b1ce..1fb85651cf 100644 --- a/src/ALE/regrid_solvers.F90 +++ b/src/ALE/regrid_solvers.F90 @@ -59,9 +59,9 @@ subroutine solve_linear_system( A, B, X, system_size ) ! entries of column i in rows below row i. Once a valid ! pivot is found (say in row k), rows i and k are swaped. k = i - do while ( ( .NOT. found_pivot ) .AND. ( k .LE. system_size ) ) + do while ( ( .NOT. found_pivot ) .AND. ( k <= system_size ) ) - if ( abs( A(k,i) ) .GT. eps ) then ! a valid pivot is found + if ( abs( A(k,i) ) > eps ) then ! a valid pivot is found found_pivot = .true. else ! Go to the next row to see ! if there is a valid pivot there diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index f504bf220b..f3747ff33b 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -2335,7 +2335,7 @@ subroutine convert_temp_salt_for_TEOS10(T, S, press, G, kd, mask_z, EOS) if ((EOS%form_of_EOS .ne. EOS_TEOS10) .and. (EOS%form_of_EOS .ne. EOS_NEMO)) return do k=1,kd ; do j=G%jsc,G%jec ; do i=G%isc,G%iec - if (mask_z(i,j,k) .ge. 1.0) then + if (mask_z(i,j,k) >= 1.0) then S(i,j,k) = gsw_sr_from_sp(S(i,j,k)) ! p=press(k)/10000. !convert pascal to dbar ! S(i,j,k) = gsw_sa_from_sp(S(i,j,k),p,G%geoLonT(i,j),G%geoLatT(i,j)) diff --git a/src/equation_of_state/MOM_EOS_TEOS10.F90 b/src/equation_of_state/MOM_EOS_TEOS10.F90 index cbe0d71889..ce940ca26f 100644 --- a/src/equation_of_state/MOM_EOS_TEOS10.F90 +++ b/src/equation_of_state/MOM_EOS_TEOS10.F90 @@ -195,7 +195,7 @@ subroutine calculate_density_derivs_scalar_teos10(T, S, pressure, drho_dT, drho_ zs = S !gsw_sr_from_sp(S) !Convert practical salinity to absolute salinity zt = T !gsw_ct_from_pt(S,T) !Convert potantial temp to conservative temp zp = pressure* Pa2db !Convert pressure from Pascal to decibar - if (S.lt.-1.0e-10) return !Can we assume safely that this is a missing value? + if (S < -1.0e-10) return !Can we assume safely that this is a missing value? call gsw_rho_first_derivatives(zs, zt, zp, drho_dsa=drho_dS, drho_dct=drho_dT) end subroutine calculate_density_derivs_scalar_teos10 @@ -257,7 +257,7 @@ subroutine calculate_density_second_derivs_scalar_teos10(T, S, pressure, drho_dS zs = S !gsw_sr_from_sp(S) !Convert practical salinity to absolute salinity zt = T !gsw_ct_from_pt(S,T) !Convert potantial temp to conservative temp zp = pressure* Pa2db !Convert pressure from Pascal to decibar - if (S.lt.-1.0e-10) return !Can we assume safely that this is a missing value? + if (S < -1.0e-10) return !Can we assume safely that this is a missing value? call gsw_rho_second_derivatives(zs, zt, zp, rho_sa_sa=drho_dS_dS, rho_sa_ct=drho_dS_dT, & rho_ct_ct=drho_dT_dT, rho_sa_p=drho_dS_dP, rho_ct_p=drho_dT_dP) diff --git a/src/equation_of_state/MOM_TFreeze.F90 b/src/equation_of_state/MOM_TFreeze.F90 index eaee1ebb3e..ddc0e215da 100644 --- a/src/equation_of_state/MOM_TFreeze.F90 +++ b/src/equation_of_state/MOM_TFreeze.F90 @@ -205,7 +205,7 @@ subroutine calculate_TFreeze_teos10_array(S, pres, T_Fr, start, npts) zs = S(j) zp = pres(j)* Pa2db !Convert pressure from Pascal to decibar - if (S(j).lt.-1.0e-10) cycle !Can we assume safely that this is a missing value? + if (S(j) < -1.0e-10) cycle !Can we assume safely that this is a missing value? T_Fr(j) = gsw_ct_freezing_exact(zs,zp,saturation_fraction) enddo diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index db65a9504c..8726ce6770 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -477,7 +477,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, if (add_np) then last_row(:)=tr_in(:,jd); pole=0.0;npole=0.0 do i=1,id - if (abs(tr_in(i,jd)-missing_value) .gt. abs(roundoff*missing_value)) then + if (abs(tr_in(i,jd)-missing_value) > abs(roundoff*missing_value)) then pole = pole+last_row(i) npole = npole+1.0 endif @@ -503,7 +503,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, do j=1,jdp do i=1,id - if (abs(tr_inp(i,j)-missing_value) .gt. abs(roundoff*missing_value)) then + if (abs(tr_inp(i,j)-missing_value) > abs(roundoff*missing_value)) then mask_in(i,j)=1.0 tr_inp(i,j) = tr_inp(i,j) * conversion else @@ -532,7 +532,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, mask_out=1.0 do j=js,je do i=is,ie - if (abs(tr_out(i,j)-missing_value) .lt. abs(roundoff*missing_value)) mask_out(i,j)=0. + if (abs(tr_out(i,j)-missing_value) < abs(roundoff*missing_value)) mask_out(i,j)=0. enddo enddo @@ -541,14 +541,14 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, nPoints = 0 ; varAvg = 0. do j=js,je do i=is,ie - if (mask_out(i,j) .lt. 1.0) then + if (mask_out(i,j) < 1.0) then tr_out(i,j)=missing_value else good(i,j)=1.0 nPoints = nPoints + 1 varAvg = varAvg + tr_out(i,j) endif - if (G%mask2dT(i,j) == 1.0 .and. z_edges_in(k) <= G%bathyT(i,j) .and. mask_out(i,j) .lt. 1.0) fill(i,j)=1.0 + if (G%mask2dT(i,j) == 1.0 .and. z_edges_in(k) <= G%bathyT(i,j) .and. mask_out(i,j) < 1.0) fill(i,j)=1.0 enddo enddo call pass_var(fill,G%Domain) @@ -750,7 +750,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t if (add_np) then last_row(:)=tr_in(:,jd); pole=0.0;npole=0.0 do i=1,id - if (abs(tr_in(i,jd)-missing_value) .gt. abs(roundoff*missing_value)) then + if (abs(tr_in(i,jd)-missing_value) > abs(roundoff*missing_value)) then pole = pole+last_row(i) npole = npole+1.0 endif @@ -776,7 +776,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t do j=1,jdp do i=1,id - if (abs(tr_inp(i,j)-missing_value) .gt. abs(roundoff*missing_value)) then + if (abs(tr_inp(i,j)-missing_value) > abs(roundoff*missing_value)) then mask_in(i,j)=1.0 tr_inp(i,j) = tr_inp(i,j) * conversion else @@ -805,7 +805,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t mask_out=1.0 do j=js,je do i=is,ie - if (abs(tr_out(i,j)-missing_value) .lt. abs(roundoff*missing_value)) mask_out(i,j)=0. + if (abs(tr_out(i,j)-missing_value) < abs(roundoff*missing_value)) mask_out(i,j)=0. enddo enddo @@ -814,14 +814,14 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t nPoints = 0 ; varAvg = 0. do j=js,je do i=is,ie - if (mask_out(i,j) .lt. 1.0) then + if (mask_out(i,j) < 1.0) then tr_out(i,j)=missing_value else good(i,j)=1.0 nPoints = nPoints + 1 varAvg = varAvg + tr_out(i,j) endif - if (G%mask2dT(i,j) == 1.0 .and. z_edges_in(k) <= G%bathyT(i,j) .and. mask_out(i,j) .lt. 1.0) fill(i,j)=1.0 + if (G%mask2dT(i,j) == 1.0 .and. z_edges_in(k) <= G%bathyT(i,j) .and. mask_out(i,j) < 1.0) fill(i,j)=1.0 enddo enddo call pass_var(fill,G%Domain) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index e3bd9f23c2..d26ca9961a 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -315,7 +315,7 @@ function slope_limiter (num, denom) if (denom .eq. 0) then slope_limiter = 0 - elseif (num*denom .le. 0) then + elseif (num*denom <= 0) then slope_limiter = 0 else r = num/denom @@ -885,7 +885,7 @@ subroutine change_thickness_using_melt(CS,G,time_step, fluxes) if (associated(fluxes%p_surf)) fluxes%p_surf(i,j) = 0.0 if (associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = 0.0 - if (CS%lprec(i,j) / CS%density_ice * time_step .lt. CS%h_shelf (i,j)) then + if (CS%lprec(i,j) / CS%density_ice * time_step < CS%h_shelf (i,j)) then CS%h_shelf (i,j) = CS%h_shelf (i,j) - CS%lprec(i,j) / CS%density_ice * time_step else ! the ice is about to melt away @@ -2120,7 +2120,7 @@ subroutine initialize_diagnostic_fields (CS, FE, Time) do j=jsd,jed do i=isd,ied OD = G%bathyT(i,j) - rhoi/rhow * h_shelf (i,j) - if (OD.ge.0) then + if (OD >= 0) then ! ice thickness does not take up whole ocean column -> floating OD_av (i,j) = OD float_frac(i,j) = 0. @@ -2374,12 +2374,12 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) do k=0,1 do l=0,1 if ((CS%hmask(i,j) .eq. 1) .and. & - (rhoi/rhow * H_node(i-1+k,j-1+l) - G%bathyT(i,j) .le. 0)) then + (rhoi/rhow * H_node(i-1+k,j-1+l) - G%bathyT(i,j) <= 0)) then nodefloat = nodefloat + 1 endif enddo enddo - if ((nodefloat .gt. 0) .and. (nodefloat .lt. 4)) then + if ((nodefloat > 0) .and. (nodefloat < 4)) then !print *,"nodefloat",nodefloat float_cond (i,j) = 1.0 CS%float_frac (i,j) = 1.0 @@ -2410,7 +2410,7 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) do j=jsd,jed do i=isd,ied - if (((i .gt. isd) .and. (j .gt. jsd)) .or. (isym .eq. 1)) then + if (((i > isd) .and. (j > jsd)) .or. (isym .eq. 1)) then X(:,:) = geolonq (i-1:i,j-1:j)*1000 Y(:,:) = geolatq (i-1:i,j-1:j)*1000 else @@ -2485,7 +2485,7 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) if (CS%vmask(i,j) .eq. 1) then err_tempv = MAX(ABS (Av(i,j) + v_bdry_cont(i,j) - TAUDY(i,j)), err_tempu) endif - if (err_tempv .ge. err_init) then + if (err_tempv >= err_init) then err_init = err_tempv endif enddo @@ -2575,7 +2575,7 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) if (CS%vmask(i,j) .eq. 1) then err_tempv = MAX(ABS (Av(i,j) + v_bdry_cont(i,j) - TAUDY(i,j)), err_tempu) endif - if (err_tempv .ge. err_max) then + if (err_tempv >= err_max) then err_max = err_tempv endif enddo @@ -2597,10 +2597,10 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) err_tempv = MAX(ABS (v_last(i,j)- v(i,j)), err_tempu) tempv = SQRT(v(i,j)**2+tempu**2) endif - if (err_tempv .ge. err_max) then + if (err_tempv >= err_max) then err_max = err_tempv endif - if (tempv .ge. max_vel) then + if (tempv >= max_vel) then max_vel = tempv endif enddo @@ -2617,7 +2617,7 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) if (is_root_pe()) print *,"nonlinear residual: ",err_max/err_init - if (err_max .le. CS%nonlinear_tolerance * err_init) then + if (err_max <= CS%nonlinear_tolerance * err_init) then if (is_root_pe()) & print *,"exiting nonlinear solve after ",iter," iterations" exit @@ -3050,7 +3050,7 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE ! print *,"|r|",dot_p1 ! endif - if (dot_p1 .le. CS%cg_tolerance * resid0) then + if (dot_p1 <= CS%cg_tolerance * resid0) then iters = iter conv_flag = 1 exit @@ -3144,15 +3144,15 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ i_off = G%idg_offset ; j_off = G%jdg_offset do j=jsd+1,jed-1 - if (((j+j_off) .le. G%domain%njglobal+G%domain%njhalo) .AND. & - ((j+j_off) .ge. G%domain%njhalo+1)) then ! based on mehmet's code - only if btw north & south boundaries + if (((j+j_off) <= G%domain%njglobal+G%domain%njhalo) .AND. & + ((j+j_off) >= G%domain%njhalo+1)) then ! based on mehmet's code - only if btw north & south boundaries stencil(:) = -1 ! if (i+i_off .eq. G%domain%nihalo+G%domain%nihalo) do i=is,ie - if (((i+i_off) .le. G%domain%niglobal+G%domain%nihalo) .AND. & - ((i+i_off) .ge. G%domain%nihalo+1)) then + if (((i+i_off) <= G%domain%niglobal+G%domain%nihalo) .AND. & + ((i+i_off) >= G%domain%nihalo+1)) then if (i+i_off .eq. G%domain%nihalo+1) then at_west_bdry=.true. @@ -3191,7 +3191,7 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ ! print *, j, u_face, stencil(-1) ! endif - if (u_face .gt. 0) then !flux is into cell - we need info from h(i-2), h(i-1) if available + if (u_face > 0) then !flux is into cell - we need info from h(i-2), h(i-1) if available ! i may not cover all the cases.. but i cover the realistic ones @@ -3213,7 +3213,7 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ endif - elseif (u_face .lt. 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available + elseif (u_face < 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available if (hmask(i-1,j) * hmask(i+1,j) .eq. 1) then ! h(i-1) and h(i+1) are both valid phi = slope_limiter (stencil(0)-stencil(1), stencil(-1)-stencil(0)) flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * & @@ -3241,7 +3241,7 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) - if (u_face .lt. 0) then !flux is into cell - we need info from h(i+2), h(i+1) if available + if (u_face < 0) then !flux is into cell - we need info from h(i+2), h(i+1) if available if (at_east_bdry .AND. (hmask(i+1,j).eq.3)) then ! at eastern bdry but there is a ! thickness bdry condition, and the stencil contains it @@ -3262,7 +3262,7 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ endif - elseif (u_face .gt. 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available + elseif (u_face > 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available if (hmask(i-1,j) * hmask(i+1,j) .eq. 1) then ! h(i-1) and h(i+1) are both valid @@ -3384,15 +3384,15 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v i_off = G%idg_offset ; j_off = G%jdg_offset do i=isd+2,ied-2 - if (((i+i_off) .le. G%domain%niglobal+G%domain%nihalo) .AND. & - ((i+i_off) .ge. G%domain%nihalo+1)) then ! based on mehmet's code - only if btw east & west boundaries + if (((i+i_off) <= G%domain%niglobal+G%domain%nihalo) .AND. & + ((i+i_off) >= G%domain%nihalo+1)) then ! based on mehmet's code - only if btw east & west boundaries stencil(:) = -1 do j=js,je - if (((j+j_off) .le. G%domain%njglobal+G%domain%njhalo) .AND. & - ((j+j_off) .ge. G%domain%njhalo+1)) then + if (((j+j_off) <= G%domain%njglobal+G%domain%njhalo) .AND. & + ((j+j_off) >= G%domain%njhalo+1)) then if (j+j_off .eq. G%domain%njhalo+1) then at_south_bdry=.true. @@ -3424,7 +3424,7 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v ! get u-velocity at center of left face v_face = 0.5 * (CS%v_shelf(i-1,j-1) + CS%v_shelf(i,j-1)) - if (v_face .gt. 0) then !flux is into cell - we need info from h(j-2), h(j-1) if available + if (v_face > 0) then !flux is into cell - we need info from h(j-2), h(j-1) if available ! i may not cover all the cases.. but i cover the realistic ones @@ -3444,7 +3444,7 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * stencil(-1) endif - elseif (v_face .lt. 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available + elseif (v_face < 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available if (hmask(i,j-1) * hmask(i,j+1) .eq. 1) then ! h(j-1) and h(j+1) are both valid phi = slope_limiter (stencil(0)-stencil(1), stencil(-1)-stencil(0)) @@ -3474,7 +3474,7 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v ! get u-velocity at center of right face v_face = 0.5 * (CS%v_shelf(i-1,j) + CS%v_shelf(i,j)) - if (v_face .lt. 0) then !flux is into cell - we need info from h(j+2), h(j+1) if available + if (v_face < 0) then !flux is into cell - we need info from h(j+2), h(j+1) if available if (at_north_bdry .AND. (hmask(i,j+1).eq.3)) then ! at eastern bdry but there is a ! thickness bdry condition, and the stencil contains it @@ -3489,7 +3489,7 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * stencil(1) endif - elseif (v_face .gt. 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available + elseif (v_face > 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available if (hmask(i,j-1) * hmask(i,j+1) .eq. 1) then ! h(j-1) and h(j+1) are both valid phi = slope_limiter (stencil(0)-stencil(-1), stencil(1)-stencil(0)) @@ -3616,33 +3616,33 @@ subroutine shelf_advance_front (CS, flux_enter) iter_flag = 0 - if (iter_count .gt. 0) then + if (iter_count > 0) then flux_enter (:,:,:) = flux_enter_replace(:,:,:) flux_enter_replace (:,:,:) = 0.0 endif iter_count = iter_count + 1 - ! if iter_count .ge. 3 then some halo updates need to be done... + ! if iter_count >= 3 then some halo updates need to be done... do j=jsc-1,jec+1 - if (((j+j_off) .le. G%domain%njglobal+G%domain%njhalo) .AND. & - ((j+j_off) .ge. G%domain%njhalo+1)) then + if (((j+j_off) <= G%domain%njglobal+G%domain%njhalo) .AND. & + ((j+j_off) >= G%domain%njhalo+1)) then do i=isc-1,iec+1 - if (((i+i_off) .le. G%domain%niglobal+G%domain%nihalo) .AND. & - ((i+i_off) .ge. G%domain%nihalo+1)) then + if (((i+i_off) <= G%domain%niglobal+G%domain%nihalo) .AND. & + ((i+i_off) >= G%domain%nihalo+1)) then ! first get reference thickness by averaging over cells that are fluxing into this cell n_flux = 0 h_reference = 0.0 tot_flux = 0.0 do k=1,2 - if (flux_enter(i,j,k) .gt. 0) then + if (flux_enter(i,j,k) > 0) then n_flux = n_flux + 1 h_reference = h_reference + h_shelf(i+2*k-3,j) tot_flux = tot_flux + flux_enter(i,j,k) @@ -3651,7 +3651,7 @@ subroutine shelf_advance_front (CS, flux_enter) enddo do k=1,2 - if (flux_enter(i,j,k+2) .gt. 0) then + if (flux_enter(i,j,k+2) > 0) then n_flux = n_flux + 1 h_reference = h_reference + h_shelf (i,j+2*k-3) tot_flux = tot_flux + flux_enter(i,j,k+2) @@ -3659,7 +3659,7 @@ subroutine shelf_advance_front (CS, flux_enter) endif enddo - if (n_flux .gt. 0) then + if (n_flux > 0) then dxdyh = G%areaT(i,j) h_reference = h_reference / real(n_flux) partial_vol = h_shelf (i,j) * area_shelf_h (i,j) + tot_flux @@ -3668,7 +3668,7 @@ subroutine shelf_advance_front (CS, flux_enter) hmask (i,j) = 1 h_shelf (i,j) = h_reference area_shelf_h(i,j) = dxdyh - elseif ((partial_vol / dxdyh) .lt. h_reference) then + elseif ((partial_vol / dxdyh) < h_reference) then hmask (i,j) = 2 ! mass_shelf (i,j) = partial_vol * rho area_shelf_h (i,j) = partial_vol / h_reference @@ -3734,7 +3734,7 @@ subroutine shelf_advance_front (CS, flux_enter) call mpp_max(iter_count) - if (is_root_pe() .and. (iter_count.gt.1)) print *, iter_count, "MAX ITERATIONS,ADVANCE FRONT" + if (is_root_pe() .and. (iter_count > 1)) print *, iter_count, "MAX ITERATIONS,ADVANCE FRONT" if (associated(flux_enter_replace)) deallocate(flux_enter_replace) @@ -3751,9 +3751,9 @@ subroutine ice_shelf_min_thickness_calve (CS, h_shelf, area_shelf_h,hmask) do j=G%jsd,G%jed do i=G%isd,G%ied -! if ((h_shelf(i,j) .lt. CS%min_thickness_simple_calve) .and. (hmask(i,j).eq.1) .and. & +! if ((h_shelf(i,j) < CS%min_thickness_simple_calve) .and. (hmask(i,j).eq.1) .and. & ! (CS%float_frac(i,j) .eq. 0.0)) then - if ((h_shelf(i,j) .lt. CS%min_thickness_simple_calve) .and. (area_shelf_h(i,j).gt. 0.)) then + if ((h_shelf(i,j) < CS%min_thickness_simple_calve) .and. (area_shelf_h(i,j) > 0.)) then h_shelf(i,j) = 0.0 area_shelf_h(i,j) = 0.0 hmask(i,j) = 0.0 @@ -4093,7 +4093,7 @@ subroutine init_boundary_values (CS, time, input_flux, input_thick, new_sim) endif if ((hmask(i,j) .eq. 0) .or. (hmask(i,j) .eq. 1) .or. (hmask(i,j) .eq. 2)) then - if ((i.le.iec).and.(i.ge.isc)) then + if ((i <= iec).and.(i >= isc)) then if (u_face_mask (i-1,j) .eq. 3) then u_boundary_values (i-1,j-1) = (1 - ((G%geoLatBu(i-1,j-1) - 0.5*CS%len_lat)*2./CS%len_lat)**2) * & 1.5 * input_flux / input_thick @@ -4483,7 +4483,7 @@ subroutine CG_action_subgrid_basal_bilinear (Phisub, H, U, V, DXDYH, D, dens_rat hloc = Phisub(i,j,1,1,qx,qy)*H(1,1)+Phisub(i,j,1,2,qx,qy)*H(1,2)+& Phisub(i,j,2,1,qx,qy)*H(2,1)+Phisub(i,j,2,2,qx,qy)*H(2,2) - if (dens_ratio * hloc - D .gt. 0) then + if (dens_ratio * hloc - D > 0) then !if (.true.) then uq = 0 ; vq = 0 do k=1,2 @@ -4835,7 +4835,7 @@ subroutine CG_diagonal_subgrid_basal_bilinear (Phisub, H, DXDYH, D, dens_ratio, hloc = Phisub(i,j,1,1,qx,qy)*H(1,1)+Phisub(i,j,1,2,qx,qy)*H(1,2)+& Phisub(i,j,2,1,qx,qy)*H(2,1)+Phisub(i,j,2,2,qx,qy)*H(2,2) - if (dens_ratio * hloc - D .gt. 0) then + if (dens_ratio * hloc - D > 0) then Ucontr (m,n) = Ucontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy)**2 Vcontr (m,n) = Vcontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy)**2 endif @@ -5393,7 +5393,7 @@ subroutine update_OD_ffrac (CS, ocean_mass, counter, nstep_velocity, time_step, do j=jsc,jec do i=isc,iec CS%float_frac(i,j) = 1.0 - (CS%float_frac_rt(i,j) / real(nstep_velocity)) -! if ((CS%float_frac(i,j) .gt. 0) .and. (CS%float_frac(i,j) .lt. 1)) then +! if ((CS%float_frac(i,j) > 0) .and. (CS%float_frac(i,j) < 1)) then ! print *,"PARTLY GROUNDED", CS%float_frac(i,j),i,j,mpp_pe() ! endif CS%OD_av(i,j) = CS%OD_rt(i,j) / real(nstep_velocity) @@ -5433,7 +5433,7 @@ subroutine update_OD_ffrac_uncoupled (CS) do j=jsd,jed do i=isd,ied OD = G%bathyT(i,j) - rhoi/rhow * h_shelf (i,j) - if (OD.ge.0) then + if (OD >= 0) then ! ice thickness does not take up whole ocean column -> floating OD_av (i,j) = OD float_frac(i,j) = 0. @@ -5700,7 +5700,7 @@ subroutine update_velocity_masks (CS) ! vmask (i-1:i,j) = 0. !endif - if (i .lt. G%ied) then + if (i < G%ied) then if ((hmask(i+1,j) .eq. 0) & .OR. (hmask(i+1,j) .eq. 2)) then !right boundary or adjacent to unfilled cell @@ -5708,21 +5708,21 @@ subroutine update_velocity_masks (CS) endif endif - if (i .gt. G%isd) then + if (i > G%isd) then if ((hmask(i-1,j) .eq. 0) .OR. (hmask(i-1,j) .eq. 2)) then !adjacent to unfilled cell u_face_mask (i-1,j) = 2. endif endif - if (j .gt. G%jsd) then + if (j > G%jsd) then if ((hmask(i,j-1) .eq. 0) .OR. (hmask(i,j-1) .eq. 2)) then !adjacent to unfilled cell v_face_mask (i,j-1) = 2. endif endif - if (j .lt. G%jed) then + if (j < G%jed) then if ((hmask(i,j+1) .eq. 0) .OR. (hmask(i,j+1) .eq. 2)) then !adjacent to unfilled cell v_face_mask (i,j) = 2. @@ -5774,7 +5774,7 @@ subroutine interpolate_H_to_B (CS, h_shelf, hmask, H_node) endif enddo enddo - if (num_h .gt. 0) then + if (num_h > 0) then H_node(i,j) = summ / num_h endif enddo @@ -5852,7 +5852,7 @@ subroutine savearray2(fname,A,flag) OPEN(unit=fin,FILE=fname,STATUS='REPLACE',ACCESS='SEQUENTIAL',& ACTION='WRITE',IOSTAT=iock) -if (M .gt. 1300) THEN +if (M > 1300) THEN WRITE(fin) 'SECOND DIMENSION TOO LARGE' CLOSE(fin) RETURN @@ -5940,7 +5940,7 @@ subroutine solo_time_step (CS, time_step, n, Time, min_time_step_in) ! dumtimeprint=time_type_to_real(Time)/spy if (is_root_pe()) print *, "TIME in ice shelf call, yrs: ", time_type_to_real(Time)/spy - do while (time_step_remain .gt. 0.0) + do while (time_step_remain > 0.0) min_ratio = 1.0e16 n=n+1 @@ -5972,7 +5972,7 @@ subroutine solo_time_step (CS, time_step, n, Time, min_time_step_in) time_step_int = min(CS%CFL_factor * min_ratio * (365*86400), time_step) - if (time_step_int .lt. min_time_step) then + if (time_step_int < min_time_step) then call MOM_error (FATAL, "MOM_ice_shelf:solo_time_step: abnormally small timestep") else if (is_root_pe()) then @@ -5980,7 +5980,7 @@ subroutine solo_time_step (CS, time_step, n, Time, min_time_step_in) endif endif - if (time_step_int .ge. time_step_remain) then + if (time_step_int >= time_step_remain) then time_step_int = time_step_remain time_step_remain = 0.0 else @@ -5999,7 +5999,7 @@ subroutine solo_time_step (CS, time_step, n, Time, min_time_step_in) ! if the last mini-timestep is a day or less, we cannot expect velocities to change by much. ! do not update them - if (time_step_int .gt. 1000) then + if (time_step_int > 1000) then call update_velocity_masks (CS) ! call savearray2 ("Umask"//"p"//trim(procnum)//"_"//trim(stepnum),CS%umask,CS%write_output_to_file) @@ -6108,7 +6108,7 @@ subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) do j=jsd,jed do i=isd,ied t_bd = CS%t_boundary_values(i,j) -! if (CS%hmask(i,j) .gt. 1) then +! if (CS%hmask(i,j) > 1) then if ((CS%hmask(i,j) .eq. 3) .or. (CS%hmask(i,j) .eq. -2)) then CS%t_shelf(i,j) = CS%t_boundary_values(i,j) endif @@ -6141,7 +6141,7 @@ subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) do j=jsd,jed do i=isd,ied ! if (CS%hmask(i,j) .eq. 1) then - if (CS%h_shelf(i,j) .gt. 0.0) then + if (CS%h_shelf(i,j) > 0.0) then CS%t_shelf (i,j) = th_after_vflux(i,j)/CS%h_shelf (i,j) else CS%t_shelf(i,j) = -10.0 @@ -6152,7 +6152,7 @@ subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) do j=jsd,jed do i=isd,ied t_bd = CS%t_boundary_values(i,j) -! if (CS%hmask(i,j) .gt. 1) then +! if (CS%hmask(i,j) > 1) then if ((CS%hmask(i,j) .eq. 3) .or. (CS%hmask(i,j) .eq. -2)) then CS%t_shelf(i,j) = t_bd ! CS%t_shelf(i,j) = -15.0 @@ -6163,7 +6163,7 @@ subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) do j=jsc,jec do i=isc,iec if ((CS%hmask(i,j) .eq. 1) .or. (CS%hmask(i,j) .eq. 2)) then - if (CS%h_shelf(i,j) .gt. 0.0) then + if (CS%h_shelf(i,j) > 0.0) then ! CS%t_shelf (i,j) = CS%t_shelf (i,j) + time_step*(adot*Tsurf -melt_rate (i,j)*Tbot(i,j))/CS%h_shelf (i,j) CS%t_shelf (i,j) = CS%t_shelf (i,j) + time_step*(adot*Tsurf -3/spy*Tbot(i,j))/CS%h_shelf (i,j) else @@ -6244,15 +6244,15 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter i_off = G%idg_offset ; j_off = G%jdg_offset do j=jsd+1,jed-1 - if (((j+j_off) .le. G%domain%njglobal+G%domain%njhalo) .AND. & - ((j+j_off) .ge. G%domain%njhalo+1)) then ! based on mehmet's code - only if btw north & south boundaries + if (((j+j_off) <= G%domain%njglobal+G%domain%njhalo) .AND. & + ((j+j_off) >= G%domain%njhalo+1)) then ! based on mehmet's code - only if btw north & south boundaries stencil(:) = -1 ! if (i+i_off .eq. G%domain%nihalo+G%domain%nihalo) do i=is,ie - if (((i+i_off) .le. G%domain%niglobal+G%domain%nihalo) .AND. & - ((i+i_off) .ge. G%domain%nihalo+1)) then + if (((i+i_off) <= G%domain%niglobal+G%domain%nihalo) .AND. & + ((i+i_off) >= G%domain%nihalo+1)) then if (i+i_off .eq. G%domain%nihalo+1) then at_west_bdry=.true. @@ -6294,7 +6294,7 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter ! print *, j, u_face, stencil(-1) ! endif - if (u_face .gt. 0) then !flux is into cell - we need info from h(i-2), h(i-1) if available + if (u_face > 0) then !flux is into cell - we need info from h(i-2), h(i-1) if available ! i may not cover all the cases.. but i cover the realistic ones @@ -6316,7 +6316,7 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter endif - elseif (u_face .lt. 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available + elseif (u_face < 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available if (hmask(i-1,j) * hmask(i+1,j) .eq. 1) then ! h(i-1) and h(i+1) are both valid phi = slope_limiter (stencil(0)-stencil(1), stencil(-1)-stencil(0)) flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * & @@ -6347,7 +6347,7 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) - if (u_face .lt. 0) then !flux is into cell - we need info from h(i+2), h(i+1) if available + if (u_face < 0) then !flux is into cell - we need info from h(i+2), h(i+1) if available if (at_east_bdry .AND. (hmask(i+1,j).eq.3)) then ! at eastern bdry but there is a ! thickness bdry condition, and the stencil contains it @@ -6368,7 +6368,7 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter endif - elseif (u_face .gt. 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available + elseif (u_face > 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available if (hmask(i-1,j) * hmask(i+1,j) .eq. 1) then ! h(i-1) and h(i+1) are both valid @@ -6497,15 +6497,15 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, i_off = G%idg_offset ; j_off = G%jdg_offset do i=isd+2,ied-2 - if (((i+i_off) .le. G%domain%niglobal+G%domain%nihalo) .AND. & - ((i+i_off) .ge. G%domain%nihalo+1)) then ! based on mehmet's code - only if btw east & west boundaries + if (((i+i_off) <= G%domain%niglobal+G%domain%nihalo) .AND. & + ((i+i_off) >= G%domain%nihalo+1)) then ! based on mehmet's code - only if btw east & west boundaries stencil(:) = -1 do j=js,je - if (((j+j_off) .le. G%domain%njglobal+G%domain%njhalo) .AND. & - ((j+j_off) .ge. G%domain%njhalo+1)) then + if (((j+j_off) <= G%domain%njglobal+G%domain%njhalo) .AND. & + ((j+j_off) >= G%domain%njhalo+1)) then if (j+j_off .eq. G%domain%njhalo+1) then at_south_bdry=.true. @@ -6539,7 +6539,7 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, ! get u-velocity at center of left face v_face = 0.5 * (CS%v_shelf(i-1,j-1) + CS%v_shelf(i,j-1)) - if (v_face .gt. 0) then !flux is into cell - we need info from h(j-2), h(j-1) if available + if (v_face > 0) then !flux is into cell - we need info from h(j-2), h(j-1) if available ! i may not cover all the cases.. but i cover the realistic ones @@ -6559,7 +6559,7 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * stencil(-1) endif - elseif (v_face .lt. 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available + elseif (v_face < 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available if (hmask(i,j-1) * hmask(i,j+1) .eq. 1) then ! h(j-1) and h(j+1) are both valid phi = slope_limiter (stencil(0)-stencil(1), stencil(-1)-stencil(0)) @@ -6592,7 +6592,7 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, ! get u-velocity at center of right face v_face = 0.5 * (CS%v_shelf(i-1,j) + CS%v_shelf(i,j)) - if (v_face .lt. 0) then !flux is into cell - we need info from h(j+2), h(j+1) if available + if (v_face < 0) then !flux is into cell - we need info from h(j+2), h(j+1) if available if (at_north_bdry .AND. (hmask(i,j+1).eq.3)) then ! at eastern bdry but there is a ! thickness bdry condition, and the stencil contains it @@ -6607,7 +6607,7 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * stencil(1) endif - elseif (v_face .gt. 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available + elseif (v_face > 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available if (hmask(i,j-1) * hmask(i,j+1) .eq. 1) then ! h(j-1) and h(j+1) are both valid phi = slope_limiter (stencil(0)-stencil(-1), stencil(1)-stencil(0)) diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index bc12e77679..9ce2f37032 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -108,10 +108,10 @@ subroutine initialize_ice_thickness_from_file (h_shelf, area_shelf_h, hmask, G, ! taper ice shelf in area where there is no sidestress - ! but do not interfere with hmask - if ((G%geoLonCv(i,j) .gt. len_sidestress).and. & - (len_sidestress .gt. 0.)) then + if ((G%geoLonCv(i,j) > len_sidestress).and. & + (len_sidestress > 0.)) then udh = exp (-(G%geoLonCv(i,j)-len_sidestress)/5.0) * h_shelf(i,j) - if (udh .le. 25.0) then + if (udh <= 25.0) then h_shelf(i,j) = 0.0 area_shelf_h (i,j) = 0.0 else @@ -121,11 +121,11 @@ subroutine initialize_ice_thickness_from_file (h_shelf, area_shelf_h, hmask, G, ! update thickness mask - if (area_shelf_h (i,j) .ge. G%areaT(i,j)) then + if (area_shelf_h (i,j) >= G%areaT(i,j)) then hmask(i,j) = 1. elseif (area_shelf_h (i,j) .eq. 0.0) then hmask(i,j) = 0. - elseif ((area_shelf_h(i,j) .gt. 0) .and. (area_shelf_h(i,j) .le. G%areaT(i,j))) then + elseif ((area_shelf_h(i,j) > 0) .and. (area_shelf_h(i,j) <= G%areaT(i,j))) then hmask(i,j) = 2. else call MOM_error(FATAL,mdl// " AREA IN CELL OUT OF RANGE") @@ -176,7 +176,7 @@ subroutine initialize_ice_thickness_channel (h_shelf, area_shelf_h, hmask, G, PF do i=G%isc,G%iec - if ((j.ge.jsc) .and. (j.le.jec)) then + if ((j >= jsc) .and. (j <= jec)) then if (G%geoLonCu(i-1,j) >= edge_pos) then ! Everything past the edge is open ocean. @@ -329,13 +329,13 @@ end subroutine initialize_ice_thickness_channel ! ! side boundaries: no flow ! if (G%jdg_offset+j .eq. gjsc+1) then !bot boundary -! if (len_stress .eq. 0. .OR. G%geoLonCv(i,j-1) .le. len_stress) then +! if (len_stress .eq. 0. .OR. G%geoLonCv(i,j-1) <= len_stress) then ! v_face_mask_boundary (i,j-1) = 0. ! else ! v_face_mask_boundary (i,j-1) = 1. ! endif ! elseif (G%jdg_offset+j .eq. gjec) then !top boundary -! if (len_stress .eq. 0. .OR. G%geoLonCv(i,j-1) .le. len_stress) then +! if (len_stress .eq. 0. .OR. G%geoLonCv(i,j-1) <= len_stress) then ! v_face_mask_boundary (i,j) = 0. ! else ! v_face_mask_boundary (i,j) = 1. diff --git a/src/ice_shelf/user_shelf_init.F90 b/src/ice_shelf/user_shelf_init.F90 index 24afa9026b..abe44044ea 100644 --- a/src/ice_shelf/user_shelf_init.F90 +++ b/src/ice_shelf/user_shelf_init.F90 @@ -31,7 +31,7 @@ module user_shelf_init !* subroutine. * !* * !* Forcing-related fields (taux, tauy, buoy, ustar, etc.) are set * -!* in MOM_surface_forcing.F90. * +!* in MOM_surface_forcing.F90. * !* * !* These variables are all set in the set of subroutines (in this * !* file) USER_initialize_bottom_depth, USER_initialize_thickness, * @@ -192,15 +192,15 @@ subroutine USER_update_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, C do j=G%jsd,G%jed ; - if (((j+G%jdg_offset) .le. G%domain%njglobal+G%domain%njhalo) .AND. & - ((j+G%jdg_offset) .ge. G%domain%njhalo+1)) then + if (((j+G%jdg_offset) <= G%domain%njglobal+G%domain%njhalo) .AND. & + ((j+G%jdg_offset) >= G%domain%njhalo+1)) then do i=G%isc,G%iec ! if (((i+G%idg_offset) <= G%domain%niglobal+G%domain%nihalo) .AND. & ! ((i+G%idg_offset) >= G%domain%nihalo+1)) then - if ((j.ge.G%jsc) .and. (j.le.G%jec)) then + if ((j >= G%jsc) .and. (j <= G%jec)) then if (new_sim) then ; if (G%geoLonCu(i-1,j) >= edge_pos) then ! Everything past the edge is open ocean. diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index 7cdc440f62..7225217b99 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -371,7 +371,7 @@ function tracer_z_init(tr_in,z_edges,e,nkml,nkbl,land_fill,wet,nlay,nlevs,debug, enddo ! k-loop do k=2,nlay ! simply fill vanished layers with adjacent value - if (e_1d(k)-e_1d(k+1) .le. epsln) tr(i,j,k)=tr(i,j,k-1) + if (e_1d(k)-e_1d(k+1) <= epsln) tr(i,j,k)=tr(i,j,k-1) enddo enddo i_loop diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index f99a0d4dcb..2635af7fb5 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -188,7 +188,7 @@ logical function CVMix_shear_init(Time, G, GV, param_file, diag, CS) if (use_JHL) NumberTrue = NumberTrue + 1 ! After testing for interior schemes, make sure only 0 or 1 are enabled. ! Otherwise, warn user and kill job. - if ((NumberTrue).gt.1) then + if ((NumberTrue) > 1) then call MOM_error(FATAL, 'MOM_CVMix_shear_init: '// & 'Multiple shear driven internal mixing schemes selected,'//& ' please disable all but one scheme to proceed.') diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 2614b4a941..78b4a81662 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -784,7 +784,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & sfc_connected(i) = .true. - if (CS%Mstar_Mode.gt.0) then + if (CS%Mstar_Mode > 0) then ! Note the value of mech_TKE(i) now must be iterated over, so it is moved here ! First solve for the TKE to PE length scale if (CS%MSTAR_MODE == CS%MLD_o_OBUKHOV) then @@ -1152,7 +1152,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & MKE_src = dMKE_max*(1.0 - exp(-Kddt_h_g0 * MKE2_Hharm)) - if (pe_chg_g0 .gt. 0.0) then + if (pe_chg_g0 > 0.0) then !Negative buoyancy (increases PE) N2_dissipation = 1.+CS%N2_DISSIPATION_SCALE_NEG else @@ -1988,7 +1988,7 @@ subroutine get_LA_windsea(ustar, hbl, GV, LA) real :: z0, z0i, r1, r2, r3, r4, tmp, us_sl, lasl_sqr_i real :: pi, u10 pi = 4.0*atan(1.0) - if (ustar .gt. 0.0) then + if (ustar > 0.0) then ! Computing u10 based on u_star and COARE 3.5 relationships call ust_2_u10_coare3p5(ustar*sqrt(GV%Rho0/1.225),U10,GV) ! surface Stokes drift @@ -2203,7 +2203,7 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) "at the edge of the boundary layer as a fraction of the \n"//& "boundary layer thickness. The default is 0.1.", & units="nondim", default=0.1) - if ( CS%USE_MLD_ITERATION .and. abs(CS%transLay_scale-0.5).ge.0.5) then + if ( CS%USE_MLD_ITERATION .and. abs(CS%transLay_scale-0.5) >= 0.5) then call MOM_error(FATAL, "If flag USE_MLD_ITERATION is true, then "// & "EPBL_TRANSITION should be greater than 0 and less than 1.") endif diff --git a/src/tracer/MOM_OCMIP2_CO2calc.F90 b/src/tracer/MOM_OCMIP2_CO2calc.F90 index c3b46e785c..b5187d5d1d 100644 --- a/src/tracer/MOM_OCMIP2_CO2calc.F90 +++ b/src/tracer/MOM_OCMIP2_CO2calc.F90 @@ -412,7 +412,7 @@ function drtsafe(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf, & bt, dic, ft, pt, sit, st, ta, x1, fl, df) call ta_iter_1(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf, & bt, dic, ft, pt, sit, st, ta, x2, fh, df) -if (fl .lt. 0.0) then +if (fl < 0.0) then xl=x1 xh=x2 else @@ -428,8 +428,8 @@ function drtsafe(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf, & call ta_iter_1(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf, & bt, dic, ft, pt, sit, st, ta, drtsafe, f, df) do j=1,maxit !{ - if (((drtsafe-xh)*df-f)*((drtsafe-xl)*df-f) .ge. 0.0 .or. & - abs(2.0*f) .gt. abs(dxold*df)) then + if (((drtsafe-xh)*df-f)*((drtsafe-xl)*df-f) >= 0.0 .or. & + abs(2.0*f) > abs(dxold*df)) then dxold=dx dx=0.5*(xh-xl) drtsafe=xl+dx @@ -447,13 +447,13 @@ function drtsafe(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf, & return endif end if - if (abs(dx) .lt. xacc) then + if (abs(dx) < xacc) then ! write (6,*) 'Exiting drtsafe at C on iteration ', j, ', ph = ', -log10(drtsafe) return endif call ta_iter_1(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf, & bt, dic, ft, pt, sit, st, ta, drtsafe, f, df) - if (f .lt. 0.0) then + if (f < 0.0) then xl=drtsafe fl=f else diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 4954e14a46..1e9f5577c3 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -294,9 +294,9 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, h, param_file, dia !Check/apply the bounds for each g_tracer do k=1,nk ; do j=jsc,jec ; do i=isc,iec if (tr_ptr(i,j,k) .ne. CS%tracer_land_val) then - if (tr_ptr(i,j,k) .lt. g_tracer%src_var_valid_min) tr_ptr(i,j,k) = g_tracer%src_var_valid_min + if (tr_ptr(i,j,k) < g_tracer%src_var_valid_min) tr_ptr(i,j,k) = g_tracer%src_var_valid_min !Jasmin does not want to apply the maximum for now - !if (tr_ptr(i,j,k) .gt. g_tracer%src_var_valid_max) tr_ptr(i,j,k) = g_tracer%src_var_valid_max + !if (tr_ptr(i,j,k) > g_tracer%src_var_valid_max) tr_ptr(i,j,k) = g_tracer%src_var_valid_max endif enddo; enddo ; enddo @@ -355,7 +355,7 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, h, param_file, dia grid_tmask(:,:,:) = 0.0 grid_kmt(:,:) = 0 do j = G%jsd, G%jed ; do i = G%isd, G%ied - if (G%mask2dT(i,j) .gt. 0) then + if (G%mask2dT(i,j) > 0) then grid_tmask(i,j,:) = 1.0 grid_kmt(i,j) = G%ke ! Tell the code that a layer thicker than 1m is the bottom layer. endif diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index ed7e726f8e..5cc38f8f24 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -793,7 +793,7 @@ subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) call pass_vector(temp_x, temp_y, G%Domain, To_All, AGRID) !Filter land values do j = G%jsd,G%jed ; do I = G%Isd,G%Ied - if (abs(temp_x(i,j)).gt.10. .or. abs(temp_y(i,j)).gt.10. ) then + if (abs(temp_x(i,j)) > 10. .or. abs(temp_y(i,j)) > 10.) then ! Assume land-mask and zero out temp_x(i,j)=0.0 temp_y(i,j)=0.0 @@ -857,7 +857,7 @@ subroutine get_Langmuir_Number( LA, G, GV, HBL, USTAR, I, J, & Top = Bottom MidPoint = Bottom + GV%H_to_m * h(kk)/2. Bottom = Bottom + GV%H_to_m * h(kk) - if (MidPoint.gt.DPT_LASL .and. kk.gt.1 .and. ContinueLoop) then + if (MidPoint > DPT_LASL .and. kk > 1 .and. ContinueLoop) then ShearDirection = atan2(V_H(1)-V_H(kk),U_H(1)-U_H(kk)) ContinueLoop = .false. endif @@ -944,7 +944,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US_SL, LA) real :: u10 - if (ustar .gt. 0.0) then + if (ustar > 0.0) then ! Computing u10 based on u_star and COARE 3.5 relationships call ust_2_u10_coare3p5(ustar*sqrt(GV%Rho0/1.225),U10,GV) ! surface Stokes drift @@ -1024,9 +1024,9 @@ subroutine Get_SL_Average_Prof( GV, AvgDepth, H, Profile, Average ) Top = Bottom MidPoint = Bottom - GV%H_to_m * h(kk)/2. Bottom = Bottom - GV%H_to_m * h(kk) - if (AvgDepth .lt. Bottom) then !Whole cell within H_LA + if (AvgDepth < Bottom) then !Whole cell within H_LA Sum = Sum + Profile(kk) * (GV%H_to_m * H(kk)) - elseif (AvgDepth .lt. top) then !partial cell within H_LA + elseif (AvgDepth < top) then !partial cell within H_LA Sum = Sum + Profile(kk) * (top-AvgDepth) endif enddo @@ -1101,7 +1101,7 @@ subroutine DHH85_mid(WAVES,GV, ust, zpt,US) Bnn = 1.0 Snn = 0.08 * (1.0 + 4.0 * WaveAge**3) Cnn = 1.7 - if (WA.lt. 1.) then + if (WA < 1.) then Cnn = Cnn - 6.0*log10(WA) endif !/ @@ -1147,7 +1147,7 @@ subroutine StokesMixing(G, GV, DT, h, u, v, WAVES ) dTauDn = 0.5*(WAVES%Kvs(i,j,k+1)+WAVES%Kvs(i+1,j,k+1))*& (waves%us_x(i,j,k)-waves%us_x(i,j,k+1))& /(GV%H_to_m *0.5*(h(i,j,k)+h(i,j,k+1)) ) - elseif (k.lt.G%ke-1) then + elseif (k < G%ke-1) then dTauUp = 0.5*(waves%Kvs(i,j,k)+waves%Kvs(i+1,j,k))*& (waves%us_x(i,j,k-1)-waves%us_x(i,j,k))& /(GV%H_to_m *0.5*(h(i,j,k-1)+h(i,j,k)) ) @@ -1174,7 +1174,7 @@ subroutine StokesMixing(G, GV, DT, h, u, v, WAVES ) dTauDn = 0.5*(waves%Kvs(i,j,k+1)+waves%Kvs(i,j+1,k+1))& *(waves%us_y(i,j,k)-waves%us_y(i,j,k+1))& /(GV%H_to_m *0.5*(h(i,j,k)+h(i,j,k+1)) ) - elseif (k.lt.G%ke-1) then + elseif (k < G%ke-1) then dTauUp = 0.5*(waves%Kvs(i,j,k)+waves%Kvs(i,j+1,k))*& (waves%us_y(i,j,k-1)-waves%us_y(i,j,k))& /(GV%H_to_m *0.5*(h(i,j,k-1)+h(i,j,k)) ) diff --git a/src/user/SCM_CVmix_tests.F90 b/src/user/SCM_CVmix_tests.F90 index 8795dab494..4a6802dc23 100644 --- a/src/user/SCM_CVmix_tests.F90 +++ b/src/user/SCM_CVmix_tests.F90 @@ -104,13 +104,13 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, param_file, just_read_params) eta(K+1) = eta(K) - h(i,j,k)*GV%H_to_m ! Interface below layer (in m) zC = 0.5*( eta(K) + eta(K+1) ) ! Z of middle of layer (in m) DZ = min(0., zC + UpperLayerTempMLD) - if (DZ.ge.0.0) then ! in Layer 1 + if (DZ >= 0.0) then ! in Layer 1 T(i,j,k) = UpperLayerTemp else ! in Layer 2 T(i,j,k) = LowerLayerTemp + LowerLayerdTdZ * DZ endif DZ = min(0., zC + UpperLayerSaltMLD) - if (DZ.ge.0.0) then ! in Layer 1 + if (DZ >= 0.0) then ! in Layer 1 S(i,j,k) = UpperLayerSalt else ! in Layer 2 S(i,j,k) = LowerLayerSalt + LowerLayerdSdZ * DZ diff --git a/src/user/SCM_idealized_hurricane.F90 b/src/user/SCM_idealized_hurricane.F90 index 85b76c4ac5..1afa1476df 100644 --- a/src/user/SCM_idealized_hurricane.F90 +++ b/src/user/SCM_idealized_hurricane.F90 @@ -228,9 +228,9 @@ subroutine SCM_idealized_hurricane_wind_forcing(state, forces, day, G, CS) ! Calculate U10 in the interior (inside of 10x radius of maximum wind), ! while adjusting U10 to 0 outside of 12x radius of maximum wind. ! Note that rho_a is set to 1.2 following generated wind for experiment - if (r/CS%r_max.gt.0.001 .AND. r/CS%r_max.lt.10.) then + if (r/CS%r_max > 0.001 .AND. r/CS%r_max < 10.) then U10 = sqrt( A*B*dp*exp(-A/rB)/(1.2*rB) + 0.25*(rkm*f)**2 ) - 0.5*rkm*f - elseif (r/CS%r_max.gt.10. .AND. r/CS%r_max.lt.12.) then + elseif (r/CS%r_max > 10. .AND. r/CS%r_max < 12.) then r=CS%r_max*10. if (BR_Bench) then rkm = r/1000. @@ -254,9 +254,9 @@ subroutine SCM_idealized_hurricane_wind_forcing(state, forces, day, G, CS) A1 = -A0 *(0.04*RSTR +0.05*CS%tran_speed+0.14) P1 = (6.88*RSTR -9.60*CS%tran_speed+85.31)*pie/180. ALPH = A0 - A1*cos( (TRANSDIR - ADIR ) - P1) - if (r/CS%r_max.gt.10. .AND. r/CS%r_max.lt.12.) then + if (r/CS%r_max > 10. .AND. r/CS%r_max < 12.) then ALPH = ALPH* (12. - r/CS%r_max)/2. - elseif (r/CS%r_max.gt.12.) then + elseif (r/CS%r_max > 12.) then ALPH = 0.0 endif ALPH = ALPH * Deg2Rad @@ -289,9 +289,9 @@ subroutine SCM_idealized_hurricane_wind_forcing(state, forces, day, G, CS) ! Add a simple drag coefficient as a function of U10 | !/----------------------------------------------------| du10=sqrt(du**2+dv**2) - if (du10.LT.11.) then + if (du10 < 11.) then Cd = 1.2e-3 - elseif (du10.LT.20.) then + elseif (du10 < 20.) then Cd = (0.49 + 0.065 * U10 )*0.001 else Cd = 0.0018 @@ -307,9 +307,9 @@ subroutine SCM_idealized_hurricane_wind_forcing(state, forces, day, G, CS) dU = U10*sin(Adir-pie-Alph) - Uocn + U_TS dV = U10*cos(Adir-Alph) - Vocn + V_TS du10=sqrt(du**2+dv**2) - if (du10.LT.11.) then + if (du10 < 11.) then Cd = 1.2e-3 - elseif (du10.LT.20.) then + elseif (du10 < 20.) then Cd = (0.49 + 0.065 * U10 )*0.001 else Cd = 0.0018 diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90 index cdfd1fc940..fb323d571b 100644 --- a/src/user/dyed_channel_initialization.F90 +++ b/src/user/dyed_channel_initialization.F90 @@ -103,7 +103,7 @@ subroutine dyed_channel_set_OBC_tracer_data(OBC, G, GV, param_file, tr_Reg) "should have a separate boundary segment.", default=0, & do_not_log=.true.) - if (OBC%number_of_segments .lt. ntr) then + if (OBC%number_of_segments < ntr) then call MOM_error(WARNING, "Error in dyed_obc segment setup") return !!! Need a better error message here endif diff --git a/src/user/dyed_obcs_initialization.F90 b/src/user/dyed_obcs_initialization.F90 index 559a9fe1a9..c4b213434f 100644 --- a/src/user/dyed_obcs_initialization.F90 +++ b/src/user/dyed_obcs_initialization.F90 @@ -55,7 +55,7 @@ subroutine dyed_obcs_set_OBC_data(OBC, G, GV, param_file, tr_Reg) "should have a separate boundary segment.", default=0, & do_not_log=.true.) - if (OBC%number_of_segments .lt. ntr) then + if (OBC%number_of_segments < ntr) then call MOM_error(WARNING, "Error in dyed_obc segment setup") return !!! Need a better error message here endif diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index 2ec735ef68..be64ef163e 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -115,9 +115,9 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param x = -z_unif(k) - if ( x .le. x1 ) then + if ( x <= x1 ) then t = y1*x/x1; - else if ( (x .gt. x1 ) .and. ( x .lt. x2 )) then + else if ( (x > x1 ) .and. ( x < x2 )) then t = y1 + (y2-y1) * (x-x1) / (x2-x1) else t = y2 + (1.0-y2) * (x-x2) / (1.0-x2) @@ -157,7 +157,7 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param ! are strictly positive do k = nz,1,-1 - if ( z_inter(k) .LT. (z_inter(k+1) + GV%Angstrom_Z) ) then + if ( z_inter(k) < (z_inter(k+1) + GV%Angstrom_Z) ) then z_inter(k) = z_inter(k+1) + GV%Angstrom_Z end if From f02deaefb9a9e71eacbe9187e784dad382421f3b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 5 May 2018 11:16:38 -0400 Subject: [PATCH 0189/1072] Replaced '.eq.' with '==' and '.ne.' with '/=' Replace the older Fortran syntax '.eq.', and '.ne.' with the clearer and more succinct syntax '==' and '/='. All answers are bitwise identical. --- config_src/solo_driver/coupler_types.F90 | 12 +- src/ALE/P1M_functions.F90 | 4 +- src/ALE/P3M_functions.F90 | 18 +- src/ALE/PQM_functions.F90 | 28 +- src/ALE/regrid_edge_values.F90 | 6 +- src/ALE/regrid_solvers.F90 | 2 +- src/core/MOM.F90 | 2 +- src/core/MOM_CoriolisAdv.F90 | 6 +- src/core/MOM_open_boundary.F90 | 2 +- src/diagnostics/MOM_wave_speed.F90 | 22 +- src/diagnostics/MOM_wave_structure.F90 | 6 +- src/equation_of_state/MOM_EOS.F90 | 2 +- src/framework/MOM_diag_mediator.F90 | 16 +- src/framework/MOM_horizontal_regridding.F90 | 50 +- src/ice_shelf/MOM_ice_shelf.F90 | 580 +++++++++--------- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 16 +- src/ice_shelf/shelf_triangular_FEstuff.F90 | 44 +- src/ice_shelf/user_shelf_init.F90 | 2 +- .../MOM_fixed_initialization.F90 | 2 +- src/initialization/midas_vertmap.F90 | 18 +- src/ocean_data_assim/MOM_oda_driver.F90 | 6 +- .../lateral/MOM_internal_tides.F90 | 12 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 4 +- src/parameterizations/vertical/MOM_KPP.F90 | 10 +- .../vertical/MOM_opacity.F90 | 4 +- .../vertical/MOM_tidal_mixing.F90 | 8 +- src/tracer/MOM_OCMIP2_CO2calc.F90 | 6 +- src/tracer/MOM_generic_tracer.F90 | 10 +- src/tracer/MOM_neutral_diffusion.F90 | 4 +- src/tracer/MOM_tracer_advect.F90 | 2 +- src/user/DOME2d_initialization.F90 | 8 +- src/user/DOME_initialization.F90 | 2 +- src/user/MOM_wave_interface.F90 | 32 +- src/user/adjustment_initialization.F90 | 8 +- src/user/dumbbell_initialization.F90 | 2 +- src/user/sloshing_initialization.F90 | 4 +- 36 files changed, 480 insertions(+), 480 deletions(-) diff --git a/config_src/solo_driver/coupler_types.F90 b/config_src/solo_driver/coupler_types.F90 index ba4ce0d3fa..99a74e085c 100644 --- a/config_src/solo_driver/coupler_types.F90 +++ b/config_src/solo_driver/coupler_types.F90 @@ -314,7 +314,7 @@ subroutine coupler_type_copy_1d_2d(var_in, var_out, is, ie, js, je, & if (var_in%num_bcs >= 0) & call CT_spawn_1d_2d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), suffix) - if ((var_out%num_bcs > 0) .and. (diag_name .ne. ' ')) & + if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & call CT_set_diags_2d(var_out, diag_name, axes, time) end subroutine coupler_type_copy_1d_2d @@ -365,7 +365,7 @@ subroutine coupler_type_copy_1d_3d(var_in, var_out, is, ie, js, je, kd, & if (var_in%num_bcs >= 0) & call CT_spawn_1d_3d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), (/1, kd/), suffix) - if ((var_out%num_bcs > 0) .and. (diag_name .ne. ' ')) & + if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & call CT_set_diags_3d(var_out, diag_name, axes, time) end subroutine coupler_type_copy_1d_3d @@ -408,7 +408,7 @@ subroutine coupler_type_copy_2d_2d(var_in, var_out, is, ie, js, je, & if (var_in%num_bcs >= 0) & call CT_spawn_2d_2d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), suffix) - if ((var_out%num_bcs > 0) .and. (diag_name .ne. ' ')) & + if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & call CT_set_diags_2d(var_out, diag_name, axes, time) end subroutine coupler_type_copy_2d_2d @@ -459,7 +459,7 @@ subroutine coupler_type_copy_2d_3d(var_in, var_out, is, ie, js, je, kd, & if (var_in%num_bcs >= 0) & call CT_spawn_2d_3d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), (/1, kd/), suffix) - if ((var_out%num_bcs > 0) .and. (diag_name .ne. ' ')) & + if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & call CT_set_diags_3d(var_out, diag_name, axes, time) end subroutine coupler_type_copy_2d_3d @@ -502,7 +502,7 @@ subroutine coupler_type_copy_3d_2d(var_in, var_out, is, ie, js, je, & if (var_in%num_bcs >= 0) & call CT_spawn_3d_2d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), suffix) - if ((var_out%num_bcs > 0) .and. (diag_name .ne. ' ')) & + if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & call CT_set_diags_2d(var_out, diag_name, axes, time) end subroutine coupler_type_copy_3d_2d @@ -553,7 +553,7 @@ subroutine coupler_type_copy_3d_3d(var_in, var_out, is, ie, js, je, kd, & if (var_in%num_bcs >= 0) & call CT_spawn_3d_3d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), (/1, kd/), suffix) - if ((var_out%num_bcs > 0) .and. (diag_name .ne. ' ')) & + if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & call CT_set_diags_3d(var_out, diag_name, axes, time) end subroutine coupler_type_copy_3d_3d diff --git a/src/ALE/P1M_functions.F90 b/src/ALE/P1M_functions.F90 index 14190bd3ea..aafaec2580 100644 --- a/src/ALE/P1M_functions.F90 +++ b/src/ALE/P1M_functions.F90 @@ -151,7 +151,7 @@ subroutine P1M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients ) ! Using the limited slope, the left edge value is reevaluated and ! the interpolant coefficients recomputed - if ( h0 .NE. 0.0 ) then + if ( h0 /= 0.0 ) then ppoly_E(1,1) = u0 - 0.5 * slope else ppoly_E(1,1) = u0 @@ -177,7 +177,7 @@ subroutine P1M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients ) slope = 2.0 * ( u1 - ppoly_E(N-1,2) ) end if - if ( h1 .NE. 0.0 ) then + if ( h1 /= 0.0 ) then ppoly_E(N,2) = u1 + 0.5 * slope else ppoly_E(N,2) = u1 diff --git a/src/ALE/P3M_functions.F90 b/src/ALE/P3M_functions.F90 index 7ea9f9283b..a532ca7003 100644 --- a/src/ALE/P3M_functions.F90 +++ b/src/ALE/P3M_functions.F90 @@ -133,7 +133,7 @@ subroutine P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coefficients, h_neglect u_c = u(k) h_c = h(k) - if ( k .EQ. 1 ) then + if ( k == 1 ) then h_l = h(k) u_l = u(k) else @@ -141,7 +141,7 @@ subroutine P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coefficients, h_neglect u_l = u(k-1) end if - if ( k .EQ. N ) then + if ( k == N ) then h_r = h(k) u_r = u(k) else @@ -190,7 +190,7 @@ subroutine P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coefficients, h_neglect ! If cubic is not monotonic, monotonize it by modifiying the ! edge slopes, store the new edge slopes and recompute the ! cubic coefficients - if ( monotonic .EQ. 0 ) then + if ( monotonic == 0 ) then call monotonize_cubic( h_c, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r ) end if @@ -301,7 +301,7 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coeffici call build_cubic_interpolant( h, i0, ppoly_E, ppoly_S, ppoly_coefficients ) monotonic = is_cubic_monotonic( ppoly_coefficients, i0 ) - if ( monotonic .EQ. 0 ) then + if ( monotonic == 0 ) then call monotonize_cubic( h0, u0_l, u0_r, 0.0, slope, slope, u1_l, u1_r ) ! Rebuild cubic after monotonization @@ -360,7 +360,7 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coeffici call build_cubic_interpolant( h, i1, ppoly_E, ppoly_S, ppoly_coefficients ) monotonic = is_cubic_monotonic( ppoly_coefficients, i1 ) - if ( monotonic .EQ. 0 ) then + if ( monotonic == 0 ) then call monotonize_cubic( h1, u0_l, u0_r, slope, 0.0, slope, u1_l, u1_r ) ! Rebuild cubic after monotonization @@ -564,7 +564,7 @@ subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r ! There is a possible root (and inflexion point) only if a3 is nonzero. ! When a3 is zero, the second derivative of the cubic is constant (the ! cubic degenerates into a parabola) and no inflexion point exists. - if ( a3 .NE. 0.0 ) then + if ( a3 /= 0.0 ) then ! Location of inflexion point xi_ip = - a2 / (3.0 * a3) @@ -579,7 +579,7 @@ subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r ! decide on which side we want to collapse the inflexion point. ! If the inflexion point lies on one of the edges, the cubic is ! guaranteed to be monotonic - if ( found_ip .EQ. 1 ) then + if ( found_ip == 1 ) then slope_ip = a1 + 2.0*a2*xi_ip + 3.0*a3*xi_ip*xi_ip ! Check whether slope is consistent @@ -597,7 +597,7 @@ subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r ! 'inflexion_l' and 'inflexion_r' are set to 0 and nothing is to be done. ! Move inflexion point on the left - if ( inflexion_l .EQ. 1 ) then + if ( inflexion_l == 1 ) then u1_l_tmp = 1.5*(u0_r-u0_l)/h - 0.5*u1_r u1_r_tmp = 3.0*(u0_r-u0_l)/h - 2.0*u1_l @@ -627,7 +627,7 @@ subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r end if ! end treating case with inflexion point on the left ! Move inflexion point on the right - if ( inflexion_r .EQ. 1 ) then + if ( inflexion_r == 1 ) then u1_l_tmp = 3.0*(u0_r-u0_l)/h - 2.0*u1_r u1_r_tmp = 1.5*(u0_r-u0_l)/h - 0.5*u1_l diff --git a/src/ALE/PQM_functions.F90 b/src/ALE/PQM_functions.F90 index b91b52b437..8d15e6dd98 100644 --- a/src/ALE/PQM_functions.F90 +++ b/src/ALE/PQM_functions.F90 @@ -191,7 +191,7 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) ! monotonic, edge slopes are consistent and the cell is not an extremum. ! We now need to check and encorce the monotonicity of the quartic within ! the cell - if ( (inflexion_l .EQ. 0) .AND. (inflexion_r .EQ. 0) ) then + if ( (inflexion_l == 0) .AND. (inflexion_r == 0) ) then a = u0_l b = h_c * u1_l @@ -208,7 +208,7 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) rho = alpha2 * alpha2 - 4.0 * alpha1 * alpha3 ! Check whether inflexion points exist - if (( alpha1 .ne. 0.0 ) .and. ( rho >= 0.0 )) then + if (( alpha1 /= 0.0 ) .and. ( rho >= 0.0 )) then sqrt_rho = sqrt( rho ) @@ -273,7 +273,7 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) ! If alpha1 is zero, the second derivative of the quartic reduces ! to a straight line - if (( alpha1 .eq. 0.0 ) .and. ( alpha2 .ne. 0.0 )) then + if (( alpha1 == 0.0 ) .and. ( alpha2 /= 0.0 )) then x1 = - alpha3 / alpha2 if ( (x1 >= 0.0) .AND. (x1 <= 1.0) ) then @@ -298,7 +298,7 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) end if ! end checking whether to shift inflexion points ! At this point, we know onto which edge to shift inflexion points - if ( inflexion_l .EQ. 1 ) then + if ( inflexion_l == 1 ) then ! We modify the edge slopes so that both inflexion points ! collapse onto the left edge @@ -323,7 +323,7 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) end if - else if ( inflexion_r .EQ. 1 ) then + else if ( inflexion_r == 1 ) then ! We modify the edge slopes so that both inflexion points ! collapse onto the right edge @@ -608,7 +608,7 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coeff ! Compute coefficient for rational function based on mean and right ! edge value and slope - if (u1_r.ne.0.) then ! HACK by AJA + if (u1_r /= 0.) then ! HACK by AJA beta = 2.0 * ( u0_r - um ) / ( (h0 + hNeglect)*u1_r) - 1.0 else beta = 0. @@ -651,7 +651,7 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coeff ! Check whether inflexion points exist. If so, transform the quartic ! so that both inflexion points coalesce on the left edge. - if (( alpha1 .ne. 0.0 ) .and. ( rho >= 0.0 )) then + if (( alpha1 /= 0.0 ) .and. ( rho >= 0.0 )) then sqrt_rho = sqrt( rho ) @@ -673,7 +673,7 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coeff end if - if (( alpha1 .eq. 0.0 ) .and. ( alpha2 .ne. 0.0 )) then + if (( alpha1 == 0.0 ) .and. ( alpha2 /= 0.0 )) then x1 = - alpha3 / alpha2 if ( (x1 >= 0.0) .and. (x1 <= 1.0) ) then @@ -685,7 +685,7 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coeff end if - if ( inflexion_l .eq. 1 ) then + if ( inflexion_l == 1 ) then ! We modify the edge slopes so that both inflexion points ! collapse onto the left edge @@ -757,7 +757,7 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coeff ! Compute coefficient for rational function based on mean and left ! edge value and slope - if (um-u0_l.ne.0.) then ! HACK by AJA + if (um-u0_l /= 0.) then ! HACK by AJA beta = 0.5*h1*u1_l / (um-u0_l) - 1.0 else beta = 0. @@ -766,7 +766,7 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coeff ar = u0_l ! Right edge value estimate based on rational function - if (1+beta.ne.0.) then ! HACK by AJA + if (1+beta /= 0.) then ! HACK by AJA u0_r = (ar + 2*br + beta*br ) / ((1+beta)*(1+beta)) else u0_r = um + 0.5 * slope ! PLM @@ -804,7 +804,7 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coeff ! Check whether inflexion points exist. If so, transform the quartic ! so that both inflexion points coalesce on the right edge. - if (( alpha1 .ne. 0.0 ) .and. ( rho >= 0.0 )) then + if (( alpha1 /= 0.0 ) .and. ( rho >= 0.0 )) then sqrt_rho = sqrt( rho ) @@ -826,7 +826,7 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coeff end if - if (( alpha1 .eq. 0.0 ) .and. ( alpha2 .ne. 0.0 )) then + if (( alpha1 == 0.0 ) .and. ( alpha2 /= 0.0 )) then x1 = - alpha3 / alpha2 if ( (x1 >= 0.0) .and. (x1 <= 1.0) ) then @@ -838,7 +838,7 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coeff end if - if ( inflexion_r .eq. 1 ) then + if ( inflexion_r == 1 ) then ! We modify the edge slopes so that both inflexion points ! collapse onto the right edge diff --git a/src/ALE/regrid_edge_values.F90 b/src/ALE/regrid_edge_values.F90 index d7e8ee54b5..1df7c6ec69 100644 --- a/src/ALE/regrid_edge_values.F90 +++ b/src/ALE/regrid_edge_values.F90 @@ -88,11 +88,11 @@ subroutine bound_edge_values( N, h, u, edge_values, h_neglect ) ! boundary cell and the right neighbor of the right boundary cell ! is assumed to be the same as the right boundary cell. This ! effectively makes boundary cells look like extrema. - if ( k .EQ. 1 ) then + if ( k == 1 ) then k0 = 1 k1 = 1 k2 = 2 - else if ( k .EQ. N ) then + else if ( k == N ) then k0 = N-1 k1 = N k2 = N @@ -179,7 +179,7 @@ subroutine average_discontinuous_edge_values( N, edge_values ) ! Edge value on the right of the edge u0_plus = edge_values(k+1,1) - if ( u0_minus .NE. u0_plus ) then + if ( u0_minus /= u0_plus ) then u0_avg = 0.5 * ( u0_minus + u0_plus ) edge_values(k,2) = u0_avg edge_values(k+1,1) = u0_avg diff --git a/src/ALE/regrid_solvers.F90 b/src/ALE/regrid_solvers.F90 index 1fb85651cf..1f15f97d1b 100644 --- a/src/ALE/regrid_solvers.F90 +++ b/src/ALE/regrid_solvers.F90 @@ -79,7 +79,7 @@ subroutine solve_linear_system( A, B, X, system_size ) ! If the pivot is in a row that is different than row i, that is if ! k is different than i, we need to swap those two rows - if ( k .NE. i ) then + if ( k /= i ) then do j = 1,system_size swap_a = A(i,j) A(i,j) = A(k,j) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index e13f52c854..ea22a1832a 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1408,7 +1408,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS ! Note that for the layer mode case, the calls to tracer sources and sinks is embedded in ! main_offline_advection_layer. Warning: this may not be appropriate for tracers that ! exchange with the atmosphere - if (time_interval .NE. dt_offline) then + if (time_interval /= dt_offline) then call MOM_error(FATAL, & "For offline tracer mode in a non-ALE configuration, dt_offline must equal time_interval") endif diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 4019752728..9d01f108d1 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -860,7 +860,7 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, CS) ! Calculate KE (Kinetic energy for use in the -grad(KE) acceleration term). - if (CS%KE_Scheme.eq.KE_ARAKAWA) then + if (CS%KE_Scheme == KE_ARAKAWA) then ! The following calculation of Kinetic energy includes the metric terms ! identified in Arakawa & Lamb 1982 as important for KE conservation. It ! also includes the possibility of partially-blocked tracer cell faces. @@ -871,7 +871,7 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, CS) +G%areaCv(i,J-1)*(v(i,J-1,k)*v(i,J-1,k)) ) & )*0.25*G%IareaT(i,j) enddo ; enddo - elseif (CS%KE_Scheme.eq.KE_SIMPLE_GUDONOV) then + elseif (CS%KE_Scheme == KE_SIMPLE_GUDONOV) then ! The following discretization of KE is based on the one-dimensinal Gudonov ! scheme which does not take into account any geometric factors do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -881,7 +881,7 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, CS) vm = 0.5*( v(i, J ,k) - ABS( v(i, J ,k) ) ) ; vm2 = vm*vm KE(i,j) = ( max(up2,um2) + max(vp2,vm2) ) *0.5 enddo ; enddo - elseif (CS%KE_Scheme.eq.KE_GUDONOV) then + elseif (CS%KE_Scheme == KE_GUDONOV) then ! The following discretization of KE is based on the one-dimensinal Gudonov ! scheme but has been adapted to take horizontal grid factors into account do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 9f5d79ef4e..91f9f6546b 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -303,7 +303,7 @@ subroutine open_boundary_config(G, param_file, OBC) call get_param(param_file, mdl, "NK", OBC%ke, & "The number of model layers", default=0, do_not_log=.true.) - if (config1 .ne. "none") OBC%user_BCs_set_globally = .true. + if (config1 /= "none") OBC%user_BCs_set_globally = .true. if (OBC%number_of_segments > 0) then call get_param(param_file, mdl, "OBC_ZERO_VORTICITY", OBC%zero_vorticity, & diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index bb0c4395f7..ec4a78fc7b 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -849,7 +849,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) enddo ! print resutls (for debugging only) - !if (ig .eq. 83 .and. jg .eq. 2) then + !if (ig == 83 .and. jg == 2) then ! if (nmodes>1)then ! print *, "Results after finding first mode:" ! print *, "first guess at lam_1=", 1./speed2_tot @@ -878,7 +878,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) ! set number of intervals within search range numint = nint((lamMax - lamMin)/lamInc) - !if (ig .eq. 144 .and. jg .eq. 5) then + !if (ig == 144 .and. jg == 5) then ! print *, 'Looking for other eigenvalues at', ig, jg ! print *, 'Wave_speed: lamMin=', lamMin ! print *, 'Wave_speed: cnMax=', 1/sqrt(lamMin) @@ -899,7 +899,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) xl = xr - lamInc call tridiag_det(a_diag(1:nrows),b_diag(1:nrows),c_diag(1:nrows), & nrows,xr,det_r,ddet_r) - !if (ig .eq. 83 .and. jg .eq. 2) then + !if (ig == 83 .and. jg == 2) then ! print *, "Move interval" ! print *, "iint=",iint ! print *, "@ xr=",xr @@ -911,7 +911,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) nrootsfound = nrootsfound + 1 xbl(nrootsfound) = xl xbr(nrootsfound) = xr - !if (ig .eq. 144 .and. jg .eq. 5) then + !if (ig == 144 .and. jg == 5) then ! print *, "Root located without subdivision!" ! print *, "between xbl=",xl,"and xbr=",xr !endif @@ -939,7 +939,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) nrootsfound = nrootsfound + 1 xbl(nrootsfound) = xl_sub xbr(nrootsfound) = xr - !if (ig .eq. 144 .and. jg .eq. 5) then + !if (ig == 144 .and. jg == 5) then ! print *, "Root located after subdiving",sub_it," times!" ! print *, "between xbl=",xl_sub,"and xbr=",xr !endif @@ -954,7 +954,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) call MOM_error(WARNING, "wave_speed: root not found "// & " after sub_it_max subdivisions of original"// & " interval.") - !if (ig .eq. 144 .and. jg .eq. 5) then + !if (ig == 144 .and. jg == 5) then !print *, "xbl=",xbl !print *, "xbr=",xbr !print *, "Wave_speed: kc=",kc @@ -979,7 +979,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) ! oops, lamMax not large enough - could add code to increase (BDM) ! set unfound modes to zero for now (BDM) cn(i,j,nrootsfound+2:nmodes) = 0.0 - !if (ig .eq. 83 .and. jg .eq. 2) then + !if (ig == 83 .and. jg == 2) then ! call MOM_error(WARNING, "wave_speed: not all modes found "// & ! " within search range: increase numint.") ! print *, "Increase lamMax at ig=",ig," jg=",jg @@ -1030,7 +1030,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) ! ----- Spot check - comment out later (BDM) ---------- !ig = G%idg_offset + i !jg = G%jdg_offset + j - !if (ig .eq. 83 .and. jg .eq. 2) then + !if (ig == 83 .and. jg == 2) then !! print *, "nmodes=",nmodes ! print *, "lam_1=",lam_1 ! print *, "lamMin=",lamMin @@ -1065,9 +1065,9 @@ subroutine tridiag_det(a,b,c,nrows,lam,det_out,ddet_out) real :: I_rescale ! inverse of rescale integer :: n ! row (layer interface) index - if (size(b) .ne. nrows) call MOM_error(WARNING, "Diagonal b must be same length as nrows.") - if (size(a) .ne. nrows) call MOM_error(WARNING, "Diagonal a must be same length as nrows.") - if (size(c) .ne. nrows) call MOM_error(WARNING, "Diagonal c must be same length as nrows.") + if (size(b) /= nrows) call MOM_error(WARNING, "Diagonal b must be same length as nrows.") + if (size(a) /= nrows) call MOM_error(WARNING, "Diagonal a must be same length as nrows.") + if (size(c) /= nrows) call MOM_error(WARNING, "Diagonal c must be same length as nrows.") I_rescale = 1.0/rescale diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 3286cae5d8..88f5bc06d5 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -275,7 +275,7 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) do i=is,ie ; if (cn(i,j)>0.0)then !----for debugging, remove later---- ig = i + G%idg_offset ; jg = j + G%jdg_offset - !if (ig .eq. CS%int_tide_source_x .and. jg .eq. CS%int_tide_source_y) then + !if (ig == CS%int_tide_source_x .and. jg == CS%int_tide_source_y) then !----------------------------------- if (G%mask2dT(i,j) > 0.5) then @@ -534,7 +534,7 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) CS%num_intfaces(i,j) = nzm !----for debugging; delete later---- - !if (ig .eq. ig_stop .and. jg .eq. jg_stop) then + !if (ig == ig_stop .and. jg == jg_stop) then !print *, 'cn(ig,jg)=', cn(i,j) !print *, "e_guess=", e_guess(1:kc-1) !print *, "|e_guess|=", sqrt(sum(e_guess(1:kc-1)**2)) @@ -680,7 +680,7 @@ subroutine tridiag_solver(a,b,c,h,y,method,x) !enddo ; enddo !print *, 'A(2,1),A(2,2),A(1,2)=', A_check(2,1), A_check(2,2), A_check(1,2) !y_check = matmul(A_check,x) - !if (all(y_check .ne. y))then + !if (all(y_check /= y))then ! print *, "tridiag_solver: Uh oh, something's not right!" ! print *, "y=", y ! print *, "y_check=", y_check diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index f3747ff33b..dc6a9869da 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -2332,7 +2332,7 @@ subroutine convert_temp_salt_for_TEOS10(T, S, press, G, kd, mask_z, EOS) if (.not.associated(EOS)) call MOM_error(FATAL, & "convert_temp_salt_to_TEOS10 called with an unassociated EOS_type EOS.") - if ((EOS%form_of_EOS .ne. EOS_TEOS10) .and. (EOS%form_of_EOS .ne. EOS_NEMO)) return + if ((EOS%form_of_EOS /= EOS_TEOS10) .and. (EOS%form_of_EOS /= EOS_NEMO)) return do k=1,kd ; do j=G%jsc,G%jec ; do i=G%isc,G%iec if (mask_z(i,j,k) >= 1.0) then diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index aae2b9d9b1..34bde56f02 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -1357,21 +1357,21 @@ integer function register_diag_field(module_name, field_name, axes, init_time, & ! Register diagnostics remapped to z vertical coordinate if (axes%rank == 3) then remap_axes => null() - if ((axes%id .eq. diag_cs%axesTL%id)) then + if ((axes%id == diag_cs%axesTL%id)) then remap_axes => diag_cs%remap_axesTL(i) - elseif (axes%id .eq. diag_cs%axesBL%id) then + elseif (axes%id == diag_cs%axesBL%id) then remap_axes => diag_cs%remap_axesBL(i) - elseif (axes%id .eq. diag_cs%axesCuL%id ) then + elseif (axes%id == diag_cs%axesCuL%id ) then remap_axes => diag_cs%remap_axesCuL(i) - elseif (axes%id .eq. diag_cs%axesCvL%id) then + elseif (axes%id == diag_cs%axesCvL%id) then remap_axes => diag_cs%remap_axesCvL(i) - elseif (axes%id .eq. diag_cs%axesTi%id) then + elseif (axes%id == diag_cs%axesTi%id) then remap_axes => diag_cs%remap_axesTi(i) - elseif (axes%id .eq. diag_cs%axesBi%id) then + elseif (axes%id == diag_cs%axesBi%id) then remap_axes => diag_cs%remap_axesBi(i) - elseif (axes%id .eq. diag_cs%axesCui%id ) then + elseif (axes%id == diag_cs%axesCui%id ) then remap_axes => diag_cs%remap_axesCui(i) - elseif (axes%id .eq. diag_cs%axesCvi%id) then + elseif (axes%id == diag_cs%axesCvi%id) then remap_axes => diag_cs%remap_axesCvi(i) endif ! When the MOM_diag_to_Z module has been obsoleted we can assume remap_axes will diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 8726ce6770..79e3ebb60d 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -191,15 +191,15 @@ subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug do j=js,je i_loop: do i=is,ie - if (good_(i,j) .eq. 1.0 .or. fill(i,j) .eq. 0.) cycle i_loop + if (good_(i,j) == 1.0 .or. fill(i,j) == 0.) cycle i_loop ge=good_(i+1,j);gw=good_(i-1,j) gn=good_(i,j+1);gs=good_(i,j-1) east=0.0;west=0.0;north=0.0;south=0.0 - if (ge.eq.1.0) east=aout(i+1,j)*ge - if (gw.eq.1.0) west=aout(i-1,j)*gw - if (gn.eq.1.0) north=aout(i,j+1)*gn - if (gs.eq.1.0) south=aout(i,j-1)*gs + if (ge == 1.0) east=aout(i+1,j)*ge + if (gw == 1.0) west=aout(i-1,j)*gw + if (gn == 1.0) north=aout(i,j+1)*gn + if (gs == 1.0) south=aout(i,j-1)*gs ngood = ge+gw+gn+gs if (ngood > 0.) then @@ -219,13 +219,13 @@ subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug if (nfill == nfill_prev .and. PRESENT(prev)) then do j=js,je do i=is,ie - if (fill_pts(i,j).eq.1.0) then + if (fill_pts(i,j) == 1.0) then aout(i,j)=prev(i,j) fill_pts(i,j)=0.0 endif enddo enddo - else if (nfill .eq. nfill_prev) then + else if (nfill == nfill_prev) then print *,& 'Unable to fill missing points using either data at the same vertical level from a connected basin'//& 'or using a point from a previous vertical level. Make sure that the original data has some valid'//& @@ -243,7 +243,7 @@ subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug call pass_var(aout,G%Domain) do j=js,je do i=is,ie - if (fill(i,j) .eq. 1) then + if (fill(i,j) == 1) then east=max(good(i+1,j),fill(i+1,j)) ; west=max(good(i-1,j),fill(i-1,j)) north=max(good(i,j+1),fill(i,j+1)) ; south=max(good(i,j-1),fill(i,j-1)) !### Appropriate parentheses should be added here, but they will change answers. @@ -264,7 +264,7 @@ subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug do j=js,je do i=is,ie - if (good_(i,j).eq.0.0 .and. fill_pts(i,j) .eq. 1.0) then + if (good_(i,j) == 0.0 .and. fill_pts(i,j) == 1.0) then print *,'in fill_miss, fill, good,i,j= ',fill_pts(i,j),good_(i,j),i,j call MOM_error(FATAL,"MOM_initialize: "// & "fill is true and good is false after fill_miss, how did this happen? ") @@ -348,40 +348,40 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, rcode = NF90_OPEN(filename, NF90_NOWRITE, ncid) - if (rcode .ne. 0) call MOM_error(FATAL,"error opening file "//trim(filename)//& + if (rcode /= 0) call MOM_error(FATAL,"error opening file "//trim(filename)//& " in hinterp_extrap") rcode = NF90_INQ_VARID(ncid, varnam, varid) - if (rcode .ne. 0) call MOM_error(FATAL,"error finding variable "//trim(varnam)//& + if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(varnam)//& " in file "//trim(filename)//" in hinterp_extrap") rcode = NF90_INQUIRE_VARIABLE(ncid, varid, ndims=ndims, dimids=dims) - if (rcode .ne. 0) call MOM_error(FATAL,'error inquiring dimensions hinterp_extrap') + if (rcode /= 0) call MOM_error(FATAL,'error inquiring dimensions hinterp_extrap') if (ndims < 3) call MOM_error(FATAL,"Variable "//trim(varnam)//" in file "// & trim(filename)//" has too few dimensions.") rcode = NF90_INQUIRE_DIMENSION(ncid, dims(1), dim_name(1), len=id) - if (rcode .ne. 0) call MOM_error(FATAL,"error reading dimension 1 data for "// & + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 1 data for "// & trim(varnam)//" in file "// trim(filename)//" in hinterp_extrap") rcode = NF90_INQ_VARID(ncid, dim_name(1), dim_id(1)) - if (rcode .ne. 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(1))//& + if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(1))//& " in file "//trim(filename)//" in hinterp_extrap") rcode = NF90_INQUIRE_DIMENSION(ncid, dims(2), dim_name(2), len=jd) - if (rcode .ne. 0) call MOM_error(FATAL,"error reading dimension 2 data for "// & + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 2 data for "// & trim(varnam)//" in file "// trim(filename)//" in hinterp_extrap") rcode = NF90_INQ_VARID(ncid, dim_name(2), dim_id(2)) - if (rcode .ne. 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(2))//& + if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(2))//& " in file "//trim(filename)//" in hinterp_extrap") rcode = NF90_INQUIRE_DIMENSION(ncid, dims(3), dim_name(3), len=kd) - if (rcode .ne. 0) call MOM_error(FATAL,"error reading dimension 3 data for "// & + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 3 data for "// & trim(varnam)//" in file "// trim(filename)//" in hinterp_extrap") rcode = NF90_INQ_VARID(ncid, dim_name(3), dim_id(3)) - if (rcode .ne. 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(3))//& + if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(3))//& " in file "//trim(filename)//" in hinterp_extrap") missing_value=0.0 rcode = NF90_GET_ATT(ncid, varid, "_FillValue", missing_value) - if (rcode .ne. 0) call MOM_error(FATAL,"error finding missing value for "//& + if (rcode /= 0) call MOM_error(FATAL,"error finding missing value for "//& trim(varnam)//" in file "// trim(filename)//" in hinterp_extrap") if (allocated(lon_in)) deallocate(lon_in) @@ -397,15 +397,15 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, start = 1; count = 1; count(1) = id rcode = NF90_GET_VAR(ncid, dim_id(1), lon_in, start, count) - if (rcode .ne. 0) call MOM_error(FATAL,"error reading dimension 1 values for var_name "// & + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 1 values for var_name "// & trim(varnam)//",dim_name "//trim(dim_name(1))//" in file "// trim(filename)//" in hinterp_extrap") start = 1; count = 1; count(1) = jd rcode = NF90_GET_VAR(ncid, dim_id(2), lat_in, start, count) - if (rcode .ne. 0) call MOM_error(FATAL,"error reading dimension 2 values for var_name "// & + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 2 values for var_name "// & trim(varnam)//",dim_name "//trim(dim_name(2))//" in file "// trim(filename)//" in hinterp_extrap") start = 1; count = 1; count(1) = kd rcode = NF90_GET_VAR(ncid, dim_id(3), z_in, start, count) - if (rcode .ne. 0) call MOM_error(FATAL,"error reading dimension 3 values for var_name "// & + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 3 values for var_name "// & trim(varnam//",dim_name "//trim(dim_name(3)))//" in file "// trim(filename)//" in hinterp_extrap") call cpu_clock_end(id_clock_read) @@ -470,7 +470,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, if (is_root_pe()) then start = 1; start(3) = k; count = 1; count(1) = id; count(2) = jd rcode = NF90_GET_VAR(ncid,varid, tr_in, start, count) - if (rcode .ne. 0) call MOM_error(FATAL,"hinterp_and_extract_from_Fie: "//& + if (rcode /= 0) call MOM_error(FATAL,"hinterp_and_extract_from_Fie: "//& "error reading level "//trim(laynum)//" of variable "//& trim(varnam)//" in file "// trim(filename)) @@ -982,7 +982,7 @@ subroutine smooth_heights(zi,fill,bad,sor,niter,cyclic_x, tripolar_n) do j=1,nj do i=1,ni - if (fill(i,j) .eq. 1) then + if (fill(i,j) == 1) then B(i,j,1)=1-nm(i+1,j);B(i,j,2)=1-nm(i-1,j) B(i,j,3)=1-nm(i,j+1);B(i,j,4)=1-nm(i,j-1) endif @@ -992,7 +992,7 @@ subroutine smooth_heights(zi,fill,bad,sor,niter,cyclic_x, tripolar_n) do n=1,niter do j=1,nj do i=1,ni - if (fill(i,j) .eq. 1) then + if (fill(i,j) == 1) then bsum = real(B(i,j,1)+B(i,j,2)+B(i,j,3)+B(i,j,4)) Isum = 1.0/bsum res(i,j)=Isum*(B(i,j,1)*mp(i+1,j)+B(i,j,2)*mp(i-1,j)+& diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index d26ca9961a..60f0c688d7 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -313,7 +313,7 @@ function slope_limiter (num, denom) real :: slope_limiter real :: r - if (denom .eq. 0) then + if (denom == 0) then slope_limiter = 0 elseif (num*denom <= 0) then slope_limiter = 0 @@ -820,7 +820,7 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) call update_OD_ffrac_uncoupled (CS) endif - if (CS%velocity_update_sub_counter .eq. CS%nstep_velocity) then + if (CS%velocity_update_sub_counter == CS%nstep_velocity) then if (is_root_pe()) write(*,*) "ABOUT TO CALL VELOCITY SOLVER" @@ -877,7 +877,7 @@ subroutine change_thickness_using_melt(CS,G,time_step, fluxes) do j=G%jsc,G%jec do i=G%isc,G%iec - if ((CS%hmask(i,j) .eq. 1) .or. (CS%hmask(i,j) .eq. 2)) then + if ((CS%hmask(i,j) == 1) .or. (CS%hmask(i,j) == 2)) then ! first, zero out fluxes applied during previous time step if (associated(fluxes%lprec)) fluxes%lprec(i,j) = 0.0 if (associated(fluxes%sens)) fluxes%sens(i,j) = 0.0 @@ -908,7 +908,7 @@ subroutine change_thickness_using_melt(CS,G,time_step, fluxes) do j=G%jsd,G%jed do i=G%isd,G%ied - if ((CS%hmask(i,j) .eq. 1) .or. (CS%hmask(i,j) .eq. 2)) then + if ((CS%hmask(i,j) == 1) .or. (CS%hmask(i,j) == 2)) then CS%mass_shelf(i,j) = CS%h_shelf(i,j)*CS%density_ice endif enddo @@ -1268,7 +1268,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call get_param(param_file, mdl, "GROUNDING_LINE_COUPLE", CS%GL_couple, & "THIS PARAMETER NEEDS A DESCRIPTION.", default=.false.) if (CS%GL_regularize) CS%GL_couple = .false. - if (CS%GL_regularize .and. (CS%n_sub_regularize.eq.0)) call MOM_error (FATAL, & + if (CS%GL_regularize .and. (CS%n_sub_regularize == 0)) call MOM_error (FATAL, & "GROUNDING_LINE_INTERP_SUBGRID_N must be a positive integer if GL regularization is used") endif call get_param(param_file, mdl, "SHELF_THERMO", CS%isthermo, & @@ -1667,7 +1667,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! next make sure mass is consistent with thickness do j=G%jsd,G%jed do i=G%isd,G%ied - if ((CS%hmask(i,j) .eq. 1) .or. (CS%hmask(i,j) .eq. 2)) then + if ((CS%hmask(i,j) == 1) .or. (CS%hmask(i,j) == 2)) then CS%mass_shelf(i,j) = CS%h_shelf(i,j)*CS%density_ice endif enddo @@ -1704,7 +1704,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! next make sure mass is consistent with thickness do j=G%jsd,G%jed do i=G%isd,G%ied - if ((CS%hmask(i,j) .eq. 1) .or. (CS%hmask(i,j) .eq. 2)) then + if ((CS%hmask(i,j) == 1) .or. (CS%hmask(i,j) == 2)) then CS%mass_shelf(i,j) = CS%h_shelf(i,j)*CS%density_ice endif enddo @@ -1729,11 +1729,11 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if (.not. G%symmetric) then do j=G%jsd,G%jed do i=G%isd,G%ied - if (((i+G%idg_offset) .eq. (G%domain%nihalo+1)).and.(CS%u_face_mask(i-1,j).eq.3)) then + if (((i+G%idg_offset) == (G%domain%nihalo+1)).and.(CS%u_face_mask(i-1,j) == 3)) then CS%u_shelf (i-1,j-1) = CS%u_boundary_values (i-1,j-1) CS%u_shelf (i-1,j) = CS%u_boundary_values (i-1,j) endif - if (((j+G%jdg_offset) .eq. (G%domain%njhalo+1)).and.(CS%v_face_mask(i,j-1).eq.3)) then + if (((j+G%jdg_offset) == (G%domain%njhalo+1)).and.(CS%v_face_mask(i,j-1) == 3)) then CS%u_shelf (i-1,j-1) = CS%u_boundary_values (i-1,j-1) CS%u_shelf (i,j-1) = CS%u_boundary_values (i,j-1) endif @@ -2240,7 +2240,7 @@ subroutine ice_shelf_advect(CS, time_step, melt_rate, Time) do j=jsd,jed do i=isd,ied thick_bd = CS%thickness_boundary_values(i,j) - if (thick_bd .ne. 0.0) then + if (thick_bd /= 0.0) then CS%h_shelf(i,j) = CS%thickness_boundary_values(i,j) endif enddo @@ -2262,7 +2262,7 @@ subroutine ice_shelf_advect(CS, time_step, melt_rate, Time) do j=jsd,jed do i=isd,ied - if (CS%hmask(i,j) .eq. 1) then + if (CS%hmask(i,j) == 1) then CS%h_shelf (i,j) = h_after_vflux(i,j) endif enddo @@ -2373,7 +2373,7 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) nodefloat = 0 do k=0,1 do l=0,1 - if ((CS%hmask(i,j) .eq. 1) .and. & + if ((CS%hmask(i,j) == 1) .and. & (rhoi/rhow * H_node(i-1+k,j-1+l) - G%bathyT(i,j) <= 0)) then nodefloat = nodefloat + 1 endif @@ -2404,13 +2404,13 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) isym=0 ! must prepare phi - if (FE .eq. 1) then + if (FE == 1) then allocate (Phi (isd:ied,jsd:jed,1:8,1:4)) ; Phi(:,:,:,:)=0 do j=jsd,jed do i=isd,ied - if (((i > isd) .and. (j > jsd)) .or. (isym .eq. 1)) then + if (((i > isd) .and. (j > jsd)) .or. (isym == 1)) then X(:,:) = geolonq (i-1:i,j-1:j)*1000 Y(:,:) = geolatq (i-1:i,j-1:j)*1000 else @@ -2427,7 +2427,7 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) enddo endif - if (FE .eq. 1) then + if (FE == 1) then call calc_shelf_visc_bilinear (CS, u, v) call pass_var (CS%ice_visc_bilinear, G%domain) @@ -2445,7 +2445,7 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) do j=G%jsd,G%jed do i=G%isd,G%ied - if (FE .eq. 1) then + if (FE == 1) then CS%taub_beta_eff_bilinear (i,j) = CS%taub_beta_eff_bilinear (i,j) * CS%float_frac (i,j) else CS%taub_beta_eff_upper_tri (i,j) = CS%taub_beta_eff_upper_tri (i,j) * CS%float_frac (i,j) @@ -2454,20 +2454,20 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) enddo enddo - if (FE .eq. 1) then + if (FE == 1) then call apply_boundary_values_bilinear (CS, time, Phisub, H_node, float_cond, & rhoi/rhow, u_bdry_cont, v_bdry_cont) - elseif (FE .eq. 2) then + elseif (FE == 2) then call apply_boundary_values_triangle (CS, time, u_bdry_cont, v_bdry_cont) endif Au(:,:) = 0.0 ; Av(:,:) = 0.0 - if (FE .eq. 1) then + if (FE == 1) then call CG_action_bilinear (Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, CS%hmask, H_node, & CS%ice_visc_bilinear, float_cond, G%bathyT, CS%taub_beta_eff_bilinear, G%areaT, & G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) - elseif (FE .eq. 2) then + elseif (FE == 2) then call CG_action_triangular (Au, Av, u, v, CS%umask, CS%vmask, CS%hmask, CS%ice_visc_upper_tri, & CS%ice_visc_lower_tri, CS%taub_beta_eff_upper_tri, CS%taub_beta_eff_lower_tri, & G%dxT, G%dyT, G%areaT, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, isym) @@ -2479,10 +2479,10 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) err_init = 0 ; err_tempu = 0; err_tempv = 0 do j=jsumstart,G%jecB do i=isumstart,G%iecB - if (CS%umask(i,j) .eq. 1) then + if (CS%umask(i,j) == 1) then err_tempu = ABS (Au(i,j) + u_bdry_cont(i,j) - TAUDX(i,j)) endif - if (CS%vmask(i,j) .eq. 1) then + if (CS%vmask(i,j) == 1) then err_tempv = MAX(ABS (Av(i,j) + v_bdry_cont(i,j) - TAUDY(i,j)), err_tempu) endif if (err_tempv >= err_init) then @@ -2513,7 +2513,7 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) if (is_root_pe()) print *,"linear solve done",iters," iterations" - if (FE .eq. 1) then + if (FE == 1) then call calc_shelf_visc_bilinear (CS,u,v) call pass_var (CS%ice_visc_bilinear, G%domain) call pass_var (CS%taub_beta_eff_bilinear, G%domain) @@ -2525,7 +2525,7 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) call pass_var (CS%taub_beta_eff_lower_tri, G%domain) endif - if (iter .eq. 1) then + if (iter == 1) then ! call savearray2 ("visc1",CS%ice_visc_bilinear,CS%write_output_to_file) endif @@ -2533,7 +2533,7 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) do j=G%jsd,G%jed do i=G%isd,G%ied - if (FE .eq. 1) then + if (FE == 1) then CS%taub_beta_eff_bilinear (i,j) = CS%taub_beta_eff_bilinear (i,j) * CS%float_frac (i,j) else CS%taub_beta_eff_upper_tri (i,j) = CS%taub_beta_eff_upper_tri (i,j) * CS%float_frac (i,j) @@ -2544,20 +2544,20 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) u_bdry_cont (:,:) = 0 ; v_bdry_cont (:,:) = 0 - if (FE .eq. 1) then + if (FE == 1) then call apply_boundary_values_bilinear (CS, time, Phisub, H_node, float_cond, & rhoi/rhow, u_bdry_cont, v_bdry_cont) - elseif (FE .eq. 2) then + elseif (FE == 2) then call apply_boundary_values_triangle (CS, time, u_bdry_cont, v_bdry_cont) endif Au(:,:) = 0 ; Av(:,:) = 0 - if (FE .eq. 1) then + if (FE == 1) then call CG_action_bilinear (Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, CS%hmask, H_node, & CS%ice_visc_bilinear, float_cond, G%bathyT, CS%taub_beta_eff_bilinear, G%areaT, G%isc-1, & G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) - elseif (FE .eq. 2) then + elseif (FE == 2) then call CG_action_triangular (Au, Av, u, v, CS%umask, CS%vmask, CS%hmask, CS%ice_visc_upper_tri, & CS%ice_visc_lower_tri, CS%taub_beta_eff_upper_tri, CS%taub_beta_eff_lower_tri, & G%dxT, G%dyT, G%areaT, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, isym) @@ -2565,14 +2565,14 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) err_max = 0 - if (CS%nonlin_solve_err_mode .eq. 1) then + if (CS%nonlin_solve_err_mode == 1) then do j=jsumstart,G%jecB do i=isumstart,G%iecB - if (CS%umask(i,j) .eq. 1) then + if (CS%umask(i,j) == 1) then err_tempu = ABS (Au(i,j) + u_bdry_cont(i,j) - TAUDX(i,j)) endif - if (CS%vmask(i,j) .eq. 1) then + if (CS%vmask(i,j) == 1) then err_tempv = MAX(ABS (Av(i,j) + v_bdry_cont(i,j) - TAUDY(i,j)), err_tempu) endif if (err_tempv >= err_max) then @@ -2583,17 +2583,17 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) call mpp_max (err_max) - elseif (CS%nonlin_solve_err_mode .eq. 2) then + elseif (CS%nonlin_solve_err_mode == 2) then max_vel = 0 ; tempu = 0 ; tempv = 0 do j=jsumstart,G%jecB do i=isumstart,G%iecB - if (CS%umask(i,j) .eq. 1) then + if (CS%umask(i,j) == 1) then err_tempu = ABS (u_last(i,j)-u(i,j)) tempu = u(i,j) endif - if (CS%vmask(i,j) .eq. 1) then + if (CS%vmask(i,j) == 1) then err_tempv = MAX(ABS (v_last(i,j)- v(i,j)), err_tempu) tempv = SQRT(v(i,j)**2+tempu**2) endif @@ -2730,20 +2730,20 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE jsumstart = JSUMSTART_INT_ endif - if (FE .eq. 1) then + if (FE == 1) then visc => CS%ice_visc_bilinear beta => CS%taub_beta_eff_bilinear - elseif (FE .eq. 2) then + elseif (FE == 2) then visc => CS%ice_visc_upper_tri visc_lo => CS%ice_visc_lower_tri beta => CS%taub_beta_eff_upper_tri beta_lo => CS%taub_beta_eff_lower_tri endif - if (FE .eq. 1) then + if (FE == 1) then call apply_boundary_values_bilinear (CS, time, Phisub, H_node, float_cond, & CS%density_ice/CS%density_ocean_avg, ubd, vbd) - elseif (FE .eq. 2) then + elseif (FE == 2) then call apply_boundary_values_triangle (CS, time, ubd, vbd) endif @@ -2754,11 +2754,11 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE call pass_vector(RHSu, RHSv, G%domain, TO_ALL, BGRID_NE) - if (FE .eq. 1) then + if (FE == 1) then call matrix_diagonal_bilinear(CS, float_cond, H_node, & CS%density_ice/CS%density_ocean_avg, Phisub, DIAGu, DIAGv) ! DIAGu(:,:) = 1 ; DIAGv(:,:) = 1 - elseif (FE .eq. 2) then + elseif (FE == 2) then call matrix_diagonal_triangle (CS, DIAGu, DIAGv) DIAGu(:,:) = 1 ; DIAGv(:,:) = 1 endif @@ -2767,11 +2767,11 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE - if (FE .eq. 1) then + if (FE == 1) then call CG_action_bilinear (Au, Av, u, v, Phi, Phisub, umask, vmask, hmask, & H_node, visc, float_cond, G%bathyT, beta, G%areaT, isc-1, iec+1, jsc-1, & jec+1, CS%density_ice/CS%density_ocean_avg) - elseif (FE .eq. 2) then + elseif (FE == 2) then call CG_action_triangular (Au, Av, u, v, umask, vmask, hmask, visc, visc_lo, & beta, beta_lo, G%dxT, G%dyT, G%areaT, isc-1, iec+1, jsc-1, jec+1, isym) endif @@ -2784,8 +2784,8 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE do j=jsumstart,jecq do i=isumstart,iecq - if (umask(i,j) .eq. 1) dot_p1 = dot_p1 + Ru(i,j)**2 - if (vmask(i,j) .eq. 1) dot_p1 = dot_p1 + Rv(i,j)**2 + if (umask(i,j) == 1) dot_p1 = dot_p1 + Ru(i,j)**2 + if (vmask(i,j) == 1) dot_p1 = dot_p1 + Rv(i,j)**2 enddo enddo @@ -2797,8 +2797,8 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE do j=JSUMSTART_INT_,jecq do i=ISUMSTART_INT_,iecq - if (umask(i,j) .eq. 1) sum_vec(i,j) = Ru(i,j)**2 - if (vmask(i,j) .eq. 1) sum_vec(i,j) = sum_vec(i,j) + Rv(i,j)**2 + if (umask(i,j) == 1) sum_vec(i,j) = Ru(i,j)**2 + if (vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + Rv(i,j)**2 enddo enddo @@ -2811,8 +2811,8 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE do j=jsdq,jedq do i=isdq,iedq - if (umask(i,j) .eq. 1) Zu(i,j) = Ru (i,j) / DIAGu (i,j) - if (vmask(i,j) .eq. 1) Zv(i,j) = Rv (i,j) / DIAGv (i,j) + if (umask(i,j) == 1) Zu(i,j) = Ru (i,j) / DIAGu (i,j) + if (vmask(i,j) == 1) Zv(i,j) = Rv (i,j) / DIAGv (i,j) enddo enddo @@ -2843,13 +2843,13 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE Au(:,:) = 0 ; Av(:,:) = 0 - if (FE .eq. 1) then + if (FE == 1) then call CG_action_bilinear (Au, Av, Du, Dv, Phi, Phisub, umask, vmask, hmask, & H_node, visc, float_cond, G%bathyT, beta, G%areaT, is, ie, js, & je, CS%density_ice/CS%density_ocean_avg) - elseif (FE .eq. 2) then + elseif (FE == 2) then call CG_action_triangular (Au, Av, Du, Dv, umask, vmask, hmask, visc, visc_lo, & beta, beta_lo, G%dxT, G%dyT, G%areaT, is, ie, js, je, isym) @@ -2865,11 +2865,11 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE dot_p1 = 0 ; dot_p2 = 0 do j=jsumstart,jecq do i=isumstart,iecq - if (umask(i,j) .eq. 1) then + if (umask(i,j) == 1) then dot_p1 = dot_p1 + Zu(i,j)*Ru(i,j) dot_p2 = dot_p2 + Du(i,j)*Au(i,j) endif - if (vmask(i,j) .eq. 1) then + if (vmask(i,j) == 1) then dot_p1 = dot_p1 + Zv(i,j)*Rv(i,j) dot_p2 = dot_p2 + Dv(i,j)*Av(i,j) endif @@ -2882,12 +2882,12 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE do j=jscq,jecq do i=iscq,iecq - if (umask(i,j) .eq. 1) sum_vec(i,j) = Zu(i,j) * Ru(i,j) - if (vmask(i,j) .eq. 1) sum_vec(i,j) = sum_vec(i,j) + & + if (umask(i,j) == 1) sum_vec(i,j) = Zu(i,j) * Ru(i,j) + if (vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + & Zv(i,j) * Rv(i,j) - if (umask(i,j) .eq. 1) sum_vec_2(i,j) = Du(i,j) * Au(i,j) - if (vmask(i,j) .eq. 1) sum_vec_2(i,j) = sum_vec_2(i,j) + & + if (umask(i,j) == 1) sum_vec_2(i,j) = Du(i,j) * Au(i,j) + if (vmask(i,j) == 1) sum_vec_2(i,j) = sum_vec_2(i,j) + & Dv(i,j) * Av(i,j) enddo enddo @@ -2910,17 +2910,17 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE do j=jsd,jed do i=isd,ied - if (umask(i,j) .eq. 1) u(i,j) = u(i,j) + alpha_k * Du(i,j) - if (vmask(i,j) .eq. 1) v(i,j) = v(i,j) + alpha_k * Dv(i,j) + if (umask(i,j) == 1) u(i,j) = u(i,j) + alpha_k * Du(i,j) + if (vmask(i,j) == 1) v(i,j) = v(i,j) + alpha_k * Dv(i,j) enddo enddo do j=jsd,jed do i=isd,ied - if (umask(i,j) .eq. 1) then + if (umask(i,j) == 1) then Ru_old(i,j) = Ru(i,j) ; Zu_old(i,j) = Zu(i,j) endif - if (vmask(i,j) .eq. 1) then + if (vmask(i,j) == 1) then Rv_old(i,j) = Rv(i,j) ; Zv_old(i,j) = Zv(i,j) endif enddo @@ -2931,18 +2931,18 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE do j=jsd,jed do i=isd,ied - if (umask(i,j) .eq. 1) Ru(i,j) = Ru(i,j) - alpha_k * Au(i,j) - if (vmask(i,j) .eq. 1) Rv(i,j) = Rv(i,j) - alpha_k * Av(i,j) + if (umask(i,j) == 1) Ru(i,j) = Ru(i,j) - alpha_k * Au(i,j) + if (vmask(i,j) == 1) Rv(i,j) = Rv(i,j) - alpha_k * Av(i,j) enddo enddo do j=jsdq,jedq do i=isdq,iedq - if (umask(i,j) .eq. 1) then + if (umask(i,j) == 1) then Zu(i,j) = Ru (i,j) / DIAGu (i,j) endif - if (vmask(i,j) .eq. 1) then + if (vmask(i,j) == 1) then Zv(i,j) = Rv (i,j) / DIAGv (i,j) endif enddo @@ -2956,11 +2956,11 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE dot_p1 = 0 ; dot_p2 = 0 do j=jsumstart,jecq do i=isumstart,iecq - if (umask(i,j) .eq. 1) then + if (umask(i,j) == 1) then dot_p1 = dot_p1 + Zu(i,j)*Ru(i,j) dot_p2 = dot_p2 + Zu_old(i,j)*Ru_old(i,j) endif - if (vmask(i,j) .eq. 1) then + if (vmask(i,j) == 1) then dot_p1 = dot_p1 + Zv(i,j)*Rv(i,j) dot_p2 = dot_p2 + Zv_old(i,j)*Rv_old(i,j) endif @@ -2975,12 +2975,12 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE do j=JSUMSTART_INT_,jecq do i=ISUMSTART_INT_,iecq - if (umask(i,j) .eq. 1) sum_vec(i,j) = Zu(i,j) * Ru(i,j) - if (vmask(i,j) .eq. 1) sum_vec(i,j) = sum_vec(i,j) + & + if (umask(i,j) == 1) sum_vec(i,j) = Zu(i,j) * Ru(i,j) + if (vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + & Zv(i,j) * Rv(i,j) - if (umask(i,j) .eq. 1) sum_vec_2(i,j) = Zu_old(i,j) * Ru_old(i,j) - if (vmask(i,j) .eq. 1) sum_vec_2(i,j) = sum_vec_2(i,j) + & + if (umask(i,j) == 1) sum_vec_2(i,j) = Zu_old(i,j) * Ru_old(i,j) + if (vmask(i,j) == 1) sum_vec_2(i,j) = sum_vec_2(i,j) + & Zv_old(i,j) * Rv_old(i,j) enddo enddo @@ -3002,8 +3002,8 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE do j=jsd,jed do i=isd,ied - if (umask(i,j) .eq. 1) Du(i,j) = Zu(i,j) + beta_k * Du(i,j) - if (vmask(i,j) .eq. 1) Dv(i,j) = Zv(i,j) + beta_k * Dv(i,j) + if (umask(i,j) == 1) Du(i,j) = Zu(i,j) + beta_k * Du(i,j) + if (vmask(i,j) == 1) Dv(i,j) = Zv(i,j) + beta_k * Dv(i,j) enddo enddo @@ -3015,10 +3015,10 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE do j=jsumstart,jecq do i=isumstart,iecq - if (umask(i,j) .eq. 1) then + if (umask(i,j) == 1) then dot_p1 = dot_p1 + Ru(i,j)**2 endif - if (vmask(i,j) .eq. 1) then + if (vmask(i,j) == 1) then dot_p1 = dot_p1 + Rv(i,j)**2 endif enddo @@ -3031,8 +3031,8 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE do j=JSUMSTART_INT_,jecq do i=ISUMSTART_INT_,iecq - if (umask(i,j) .eq. 1) sum_vec(i,j) = Ru(i,j)**2 - if (vmask(i,j) .eq. 1) sum_vec(i,j) = sum_vec(i,j) + Rv(i,j)**2 + if (umask(i,j) == 1) sum_vec(i,j) = Ru(i,j)**2 + if (vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + Rv(i,j)**2 enddo enddo @@ -3058,7 +3058,7 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE cg_halo = cg_halo - 1 - if (cg_halo .eq. 0) then + if (cg_halo == 0) then ! pass vectors call pass_vector(Du, Dv, G%domain, TO_ALL, BGRID_NE) call pass_vector(u, v, G%domain, TO_ALL, BGRID_NE) @@ -3070,15 +3070,15 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE do j=jsdq,jedq do i=isdq,iedq - if (umask(i,j) .eq. 3) then + if (umask(i,j) == 3) then u(i,j) = u_bdry(i,j) - elseif (umask(i,j) .eq. 0) then + elseif (umask(i,j) == 0) then u(i,j) = 0 endif - if (vmask(i,j) .eq. 3) then + if (vmask(i,j) == 3) then v(i,j) = v_bdry(i,j) - elseif (vmask(i,j) .eq. 0) then + elseif (vmask(i,j) == 0) then v(i,j) = 0 endif enddo @@ -3086,7 +3086,7 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE call pass_vector (u,v, G%domain, TO_ALL, BGRID_NE) - if (conv_flag .eq. 0) then + if (conv_flag == 0) then iters = CS%cg_max_iterations endif @@ -3148,25 +3148,25 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ ((j+j_off) >= G%domain%njhalo+1)) then ! based on mehmet's code - only if btw north & south boundaries stencil(:) = -1 -! if (i+i_off .eq. G%domain%nihalo+G%domain%nihalo) +! if (i+i_off == G%domain%nihalo+G%domain%nihalo) do i=is,ie if (((i+i_off) <= G%domain%niglobal+G%domain%nihalo) .AND. & ((i+i_off) >= G%domain%nihalo+1)) then - if (i+i_off .eq. G%domain%nihalo+1) then + if (i+i_off == G%domain%nihalo+1) then at_west_bdry=.true. else at_west_bdry=.false. endif - if (i+i_off .eq. G%domain%niglobal+G%domain%nihalo) then + if (i+i_off == G%domain%niglobal+G%domain%nihalo) then at_east_bdry=.true. else at_east_bdry=.false. endif - if (hmask(i,j) .eq. 1) then + if (hmask(i,j) == 1) then dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) @@ -3178,7 +3178,7 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ ! 1ST DO LEFT FACE - if (u_face_mask (i-1,j) .eq. 4.) then + if (u_face_mask (i-1,j) == 4.) then flux_diff_cell = flux_diff_cell + dyh * time_step * u_flux_boundary_values (i-1,j) / dxdyh @@ -3187,7 +3187,7 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ ! get u-velocity at center of left face u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - ! if (at_west_bdry .and. (i .eq. G%isc)) then + ! if (at_west_bdry .and. (i == G%isc)) then ! print *, j, u_face, stencil(-1) ! endif @@ -3195,12 +3195,12 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ ! i may not cover all the cases.. but i cover the realistic ones - if (at_west_bdry .AND. (hmask(i-1,j).eq.3)) then ! at western bdry but there is a + if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then ! at western bdry but there is a ! thickness bdry condition, and the stencil contains it stencil (-1) = CS%thickness_boundary_values(i-1,j) flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(-1) / dxdyh - elseif (hmask(i-1,j) * hmask(i-2,j) .eq. 1) then ! h(i-2) and h(i-1) are valid + elseif (hmask(i-1,j) * hmask(i-2,j) == 1) then ! h(i-2) and h(i-1) are valid phi = slope_limiter (stencil(-1)-stencil(-2), stencil(0)-stencil(-1)) flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh* time_step / dxdyh * & (stencil(-1) - phi * (stencil(-1)-stencil(0))/2) @@ -3214,7 +3214,7 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ endif elseif (u_face < 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available - if (hmask(i-1,j) * hmask(i+1,j) .eq. 1) then ! h(i-1) and h(i+1) are both valid + if (hmask(i-1,j) * hmask(i+1,j) == 1) then ! h(i-1) and h(i+1) are both valid phi = slope_limiter (stencil(0)-stencil(1), stencil(-1)-stencil(0)) flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * & (stencil(0) - phi * (stencil(0)-stencil(-1))/2) @@ -3222,7 +3222,7 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ else flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * stencil(0) - if ((hmask(i-1,j) .eq. 0) .OR. (hmask(i-1,j) .eq. 2)) then + if ((hmask(i-1,j) == 0) .OR. (hmask(i-1,j) == 2)) then flux_enter(i-1,j,2) = ABS(u_face) * dyh * time_step * stencil(0) endif endif @@ -3233,7 +3233,7 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ ! get u-velocity at center of right face - if (u_face_mask (i+1,j) .eq. 4.) then + if (u_face_mask (i+1,j) == 4.) then flux_diff_cell = flux_diff_cell + dyh * time_step * u_flux_boundary_values (i+1,j) / dxdyh @@ -3243,12 +3243,12 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ if (u_face < 0) then !flux is into cell - we need info from h(i+2), h(i+1) if available - if (at_east_bdry .AND. (hmask(i+1,j).eq.3)) then ! at eastern bdry but there is a + if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then ! at eastern bdry but there is a ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(1) / dxdyh - elseif (hmask(i+1,j) * hmask(i+2,j) .eq. 1) then ! h(i+2) and h(i+1) are valid + elseif (hmask(i+1,j) * hmask(i+2,j) == 1) then ! h(i+2) and h(i+1) are valid phi = slope_limiter (stencil(1)-stencil(2), stencil(0)-stencil(1)) flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step / dxdyh * & @@ -3264,7 +3264,7 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ elseif (u_face > 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available - if (hmask(i-1,j) * hmask(i+1,j) .eq. 1) then ! h(i-1) and h(i+1) are both valid + if (hmask(i-1,j) * hmask(i+1,j) == 1) then ! h(i-1) and h(i+1) are both valid phi = slope_limiter (stencil(0)-stencil(-1), stencil(1)-stencil(0)) flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * & @@ -3276,7 +3276,7 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * stencil(0) - if ((hmask(i+1,j) .eq. 0) .OR. (hmask(i+1,j) .eq. 2)) then + if ((hmask(i+1,j) == 0) .OR. (hmask(i+1,j) == 2)) then flux_enter(i+1,j,1) = ABS(u_face) * dyh * time_step * stencil(0) endif @@ -3288,29 +3288,29 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ endif - elseif ((hmask(i,j) .eq. 0) .OR. (hmask(i,j) .eq. 2)) then + elseif ((hmask(i,j) == 0) .OR. (hmask(i,j) == 2)) then - if (at_west_bdry .AND. (hmask(i-1,j) .EQ. 3)) then + if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) flux_enter (i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_boundary_values(i-1,j) - elseif (u_face_mask (i-1,j) .eq. 4.) then + elseif (u_face_mask (i-1,j) == 4.) then flux_enter (i,j,1) = G%dyT(i,j) * time_step * u_flux_boundary_values (i-1,j) endif - if (at_east_bdry .AND. (hmask(i+1,j) .EQ. 3)) then + if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_boundary_values(i+1,j) - elseif (u_face_mask (i+1,j) .eq. 4.) then + elseif (u_face_mask (i+1,j) == 4.) then flux_enter (i,j,2) = G%dyT(i,j) * time_step * u_flux_boundary_values (i+1,j) endif - if ((i .eq. is) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i-1,j) .eq. 1)) then + if ((i == is) .AND. (hmask(i,j) == 0) .AND. (hmask(i-1,j) == 1)) then ! this is solely for the purposes of keeping the mask consistent while advancing ! the front without having to call pass_var - if cell is empty and cell to left ! is ice-covered then this cell will become partly covered hmask(i,j) = 2 - elseif ((i .eq. ie) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i+1,j) .eq. 1)) then + elseif ((i == ie) .AND. (hmask(i,j) == 0) .AND. (hmask(i+1,j) == 1)) then ! this is solely for the purposes of keeping the mask consistent while advancing ! the front without having to call pass_var - if cell is empty and cell to left ! is ice-covered then this cell will become partly covered @@ -3394,19 +3394,19 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v if (((j+j_off) <= G%domain%njglobal+G%domain%njhalo) .AND. & ((j+j_off) >= G%domain%njhalo+1)) then - if (j+j_off .eq. G%domain%njhalo+1) then + if (j+j_off == G%domain%njhalo+1) then at_south_bdry=.true. else at_south_bdry=.false. endif - if (j+j_off .eq. G%domain%njglobal+G%domain%njhalo) then + if (j+j_off == G%domain%njglobal+G%domain%njhalo) then at_north_bdry=.true. else at_north_bdry=.false. endif - if (hmask(i,j) .eq. 1) then + if (hmask(i,j) == 1) then dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) h_after_vflux (i,j) = h_after_uflux (i,j) @@ -3415,7 +3415,7 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v ! 1ST DO south FACE - if (v_face_mask (i,j-1) .eq. 4.) then + if (v_face_mask (i,j-1) == 4.) then flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values (i,j-1) / dxdyh @@ -3428,11 +3428,11 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v ! i may not cover all the cases.. but i cover the realistic ones - if (at_south_bdry .AND. (hmask(i,j-1).eq.3)) then ! at western bdry but there is a + if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then ! at western bdry but there is a ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(-1) / dxdyh - elseif (hmask(i,j-1) * hmask(i,j-2) .eq. 1) then ! h(j-2) and h(j-1) are valid + elseif (hmask(i,j-1) * hmask(i,j-2) == 1) then ! h(j-2) and h(j-1) are valid phi = slope_limiter (stencil(-1)-stencil(-2), stencil(0)-stencil(-1)) flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * & @@ -3446,14 +3446,14 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v elseif (v_face < 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available - if (hmask(i,j-1) * hmask(i,j+1) .eq. 1) then ! h(j-1) and h(j+1) are both valid + if (hmask(i,j-1) * hmask(i,j+1) == 1) then ! h(j-1) and h(j+1) are both valid phi = slope_limiter (stencil(0)-stencil(1), stencil(-1)-stencil(0)) flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * & (stencil(0) - phi * (stencil(0)-stencil(-1))/2) else flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * stencil(0) - if ((hmask(i,j-1) .eq. 0) .OR. (hmask(i,j-1) .eq. 2)) then + if ((hmask(i,j-1) == 0) .OR. (hmask(i,j-1) == 2)) then flux_enter(i,j-1,4) = ABS(v_face) * dyh * time_step * stencil(0) endif @@ -3465,7 +3465,7 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v ! NEXT DO north FACE - if (v_face_mask(i,j+1) .eq. 4.) then + if (v_face_mask(i,j+1) == 4.) then flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values (i,j+1) / dxdyh @@ -3476,10 +3476,10 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v if (v_face < 0) then !flux is into cell - we need info from h(j+2), h(j+1) if available - if (at_north_bdry .AND. (hmask(i,j+1).eq.3)) then ! at eastern bdry but there is a + if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then ! at eastern bdry but there is a ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(1) / dxdyh - elseif (hmask(i,j+1) * hmask(i,j+2) .eq. 1) then ! h(j+2) and h(j+1) are valid + elseif (hmask(i,j+1) * hmask(i,j+2) == 1) then ! h(j+2) and h(j+1) are valid phi = slope_limiter (stencil(1)-stencil(2), stencil(0)-stencil(1)) flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * & (stencil(1) - phi * (stencil(1)-stencil(0))/2) @@ -3491,7 +3491,7 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v elseif (v_face > 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available - if (hmask(i,j-1) * hmask(i,j+1) .eq. 1) then ! h(j-1) and h(j+1) are both valid + if (hmask(i,j-1) * hmask(i,j+1) == 1) then ! h(j-1) and h(j+1) are both valid phi = slope_limiter (stencil(0)-stencil(-1), stencil(1)-stencil(0)) flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * & (stencil(0) - phi * (stencil(0)-stencil(1))/2) @@ -3499,7 +3499,7 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v ! (o.w. flux would most likely be out of cell) ! but h(j+2) is not flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * stencil(0) - if ((hmask(i,j+1) .eq. 0) .OR. (hmask(i,j+1) .eq. 2)) then + if ((hmask(i,j+1) == 0) .OR. (hmask(i,j+1) == 2)) then flux_enter(i,j+1,3) = ABS(v_face) * dxh * time_step * stencil(0) endif endif @@ -3510,28 +3510,28 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v h_after_vflux (i,j) = h_after_vflux (i,j) + flux_diff_cell - elseif ((hmask(i,j) .eq. 0) .OR. (hmask(i,j) .eq. 2)) then + elseif ((hmask(i,j) == 0) .OR. (hmask(i,j) == 2)) then - if (at_south_bdry .AND. (hmask(i,j-1) .EQ. 3)) then + if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then v_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i,j-1)) flux_enter (i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_boundary_values(i,j-1) - elseif (v_face_mask(i,j-1) .eq. 4.) then + elseif (v_face_mask(i,j-1) == 4.) then flux_enter (i,j,3) = G%dxT(i,j) * time_step * v_flux_boundary_values (i,j-1) endif - if (at_north_bdry .AND. (hmask(i,j+1) .EQ. 3)) then + if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then v_face = 0.5 * (CS%u_shelf(i-1,j) + CS%u_shelf(i,j)) flux_enter (i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_boundary_values(i,j+1) - elseif (v_face_mask(i,j+1) .eq. 4.) then + elseif (v_face_mask(i,j+1) == 4.) then flux_enter (i,j,4) = G%dxT(i,j) * time_step * v_flux_boundary_values (i,j+1) endif - if ((j .eq. js) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i,j-1) .eq. 1)) then + if ((j == js) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j-1) == 1)) then ! this is solely for the purposes of keeping the mask consistent while advancing ! the front without having to call pass_var - if cell is empty and cell to left ! is ice-covered then this cell will become partly covered hmask (i,j) = 2 - elseif ((j .eq. je) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i,j+1) .eq. 1)) then + elseif ((j == je) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j+1) == 1)) then ! this is solely for the purposes of keeping the mask consistent while advancing ! the front without having to call pass_var - if cell is empty and cell to left ! is ice-covered then this cell will become partly covered @@ -3612,7 +3612,7 @@ subroutine shelf_advance_front (CS, flux_enter) mapi(1) = -1 ; mapi(2) = 1 ; mapi(3:4) = 0 mapj(3) = -1 ; mapj(4) = 1 ; mapj(1:2) = 0 - do while (iter_flag .eq. 1) + do while (iter_flag == 1) iter_flag = 0 @@ -3664,7 +3664,7 @@ subroutine shelf_advance_front (CS, flux_enter) h_reference = h_reference / real(n_flux) partial_vol = h_shelf (i,j) * area_shelf_h (i,j) + tot_flux - if ((partial_vol / dxdyh) .eq. h_reference) then ! cell is exactly covered, no overflow + if ((partial_vol / dxdyh) == h_reference) then ! cell is exactly covered, no overflow hmask (i,j) = 1 h_shelf (i,j) = h_reference area_shelf_h(i,j) = dxdyh @@ -3689,33 +3689,33 @@ subroutine shelf_advance_front (CS, flux_enter) n_flux = 0 ; new_partial (:) = 0 do k=1,2 - if (u_face_mask (i-2+k,j) .eq. 2) then + if (u_face_mask (i-2+k,j) == 2) then n_flux = n_flux + 1 - elseif (hmask (i+2*k-3,j) .eq. 0) then + elseif (hmask (i+2*k-3,j) == 0) then n_flux = n_flux + 1 new_partial (k) = 1 endif enddo do k=1,2 - if (v_face_mask (i,j-2+k) .eq. 2) then + if (v_face_mask (i,j-2+k) == 2) then n_flux = n_flux + 1 - elseif (hmask (i,j+2*k-3) .eq. 0) then + elseif (hmask (i,j+2*k-3) == 0) then n_flux = n_flux + 1 new_partial (k+2) = 1 endif enddo - if (n_flux .eq. 0) then ! there is nowhere to put the extra ice! + if (n_flux == 0) then ! there is nowhere to put the extra ice! h_shelf(i,j) = h_reference + partial_vol / dxdyh else h_shelf(i,j) = h_reference do k=1,2 - if (new_partial(k) .eq. 1) & + if (new_partial(k) == 1) & flux_enter_replace (i+2*k-3,j,3-k) = partial_vol / real(n_flux) enddo do k=1,2 ! ### Combine these two loops? - if (new_partial(k+2) .eq. 1) & + if (new_partial(k+2) == 1) & flux_enter_replace(i,j+2*k-3,5-k) = partial_vol / real(n_flux) enddo endif @@ -3751,8 +3751,8 @@ subroutine ice_shelf_min_thickness_calve (CS, h_shelf, area_shelf_h,hmask) do j=G%jsd,G%jed do i=G%isd,G%ied -! if ((h_shelf(i,j) < CS%min_thickness_simple_calve) .and. (hmask(i,j).eq.1) .and. & -! (CS%float_frac(i,j) .eq. 0.0)) then +! if ((h_shelf(i,j) < CS%min_thickness_simple_calve) .and. (hmask(i,j) == 1) .and. & +! (CS%float_frac(i,j) == 0.0)) then if ((h_shelf(i,j) < CS%min_thickness_simple_calve) .and. (area_shelf_h(i,j) > 0.)) then h_shelf(i,j) = 0.0 area_shelf_h(i,j) = 0.0 @@ -3775,7 +3775,7 @@ subroutine calve_to_mask (CS, h_shelf, area_shelf_h, hmask, calve_mask) if (CS%calve_to_mask) then do j=G%jsc,G%jec do i=G%isc,G%iec - if ((calve_mask(i,j) .eq. 0.0) .and. (hmask(i,j) .ne. 0.0)) then + if ((calve_mask(i,j) == 0.0) .and. (hmask(i,j) /= 0.0)) then h_shelf(i,j) = 0.0 area_shelf_h(i,j) = 0.0 hmask(i,j) = 0.0 @@ -3874,35 +3874,35 @@ subroutine calc_shelf_driving_stress (CS, TAUD_X, TAUD_Y, OD, FE) dxdyh = G%areaT(i,j) ! print *,dxh," ",dyh," ",dxdyh - if (hmask(i,j) .eq. 1) then ! we are inside the global computational bdry, at an ice-filled cell + if (hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell ! calculate sx - if ((i+i_off) .eq. gisc) then ! at left computational bdry - if (hmask(i+1,j) .eq. 1) then + if ((i+i_off) == gisc) then ! at left computational bdry + if (hmask(i+1,j) == 1) then sx = (S(i+1,j)-S(i,j))/dxh else sx = 0 endif - elseif ((i+i_off) .eq. giec) then ! at right computational bdry - if (hmask(i-1,j) .eq. 1) then + elseif ((i+i_off) == giec) then ! at right computational bdry + if (hmask(i-1,j) == 1) then sx = (S(i,j)-S(i-1,j))/dxh else sx=0 endif else ! interior - if (hmask(i+1,j) .eq. 1) then + if (hmask(i+1,j) == 1) then cnt = cnt+1 sx = S(i+1,j) else sx = S(i,j) endif - if (hmask(i-1,j) .eq. 1) then + if (hmask(i-1,j) == 1) then cnt = cnt+1 sx = sx - S(i-1,j) else sx = sx - S(i,j) endif - if (cnt .eq. 0) then + if (cnt == 0) then sx=0 else sx = sx / (cnt * dxh) @@ -3912,32 +3912,32 @@ subroutine calc_shelf_driving_stress (CS, TAUD_X, TAUD_Y, OD, FE) cnt = 0 ! calculate sy, similarly - if ((j+j_off) .eq. gjsc) then ! at south computational bdry - if (hmask(i,j+1) .eq. 1) then + if ((j+j_off) == gjsc) then ! at south computational bdry + if (hmask(i,j+1) == 1) then sy = (S(i,j+1)-S(i,j))/dyh else sy = 0 endif - elseif ((j+j_off) .eq. gjec) then ! at nprth computational bdry - if (hmask(i,j-1) .eq. 1) then + elseif ((j+j_off) == gjec) then ! at nprth computational bdry + if (hmask(i,j-1) == 1) then sy = (S(i,j)-S(i,j-1))/dyh else sy = 0 endif else ! interior - if (hmask(i,j+1) .eq. 1) then + if (hmask(i,j+1) == 1) then cnt = cnt+1 sy = S(i,j+1) else sy = S(i,j) endif - if (hmask(i,j-1) .eq. 1) then + if (hmask(i,j-1) == 1) then cnt = cnt+1 sy = sy - S(i,j-1) else sy = sy - S(i,j) endif - if (cnt .eq. 0) then + if (cnt == 0) then sy=0 else sy = sy / (cnt * dyh) @@ -3945,7 +3945,7 @@ subroutine calc_shelf_driving_stress (CS, TAUD_X, TAUD_Y, OD, FE) endif - if (FE .eq. 1) then + if (FE == 1) then ! SW vertex taud_x (i-1,j-1) = taud_x (i-1,j-1) - .25 * rho * grav * H(i,j) * sx * dxdyh @@ -3984,14 +3984,14 @@ subroutine calc_shelf_driving_stress (CS, TAUD_X, TAUD_Y, OD, FE) endif - if (float_frac(i,j) .eq. 1) then + if (float_frac(i,j) == 1) then neumann_val = .5 * grav * (rho * H (i,j) ** 2 - rhow * D(i,j) ** 2) else neumann_val = .5 * grav * (1-rho/rhow) * rho * H(i,j) ** 2 endif - if ((u_face_mask(i-1,j) .eq. 2) .OR. (hmask(i-1,j) .eq. 0) .OR. (hmask(i-1,j) .eq. 2) ) then + if ((u_face_mask(i-1,j) == 2) .OR. (hmask(i-1,j) == 0) .OR. (hmask(i-1,j) == 2) ) then ! left face of the cell is at a stress boundary ! the depth-integrated longitudinal stress is equal to the difference of depth-integrated ! pressure on either side of the face @@ -4005,19 +4005,19 @@ subroutine calc_shelf_driving_stress (CS, TAUD_X, TAUD_Y, OD, FE) taud_x(i-1,j) = taud_x(i-1,j) - .5 * dyh * neumann_val endif - if ((u_face_mask(i,j) .eq. 2) .OR. (hmask(i+1,j) .eq. 0) .OR. (hmask(i+1,j) .eq. 2) ) then + if ((u_face_mask(i,j) == 2) .OR. (hmask(i+1,j) == 0) .OR. (hmask(i+1,j) == 2) ) then ! right face of the cell is at a stress boundary taud_x(i,j-1) = taud_x(i,j-1) + .5 * dyh * neumann_val taud_x(i,j) = taud_x(i,j) + .5 * dyh * neumann_val endif - if ((v_face_mask(i,j-1) .eq. 2) .OR. (hmask(i,j-1) .eq. 0) .OR. (hmask(i,j-1) .eq. 2) ) then + if ((v_face_mask(i,j-1) == 2) .OR. (hmask(i,j-1) == 0) .OR. (hmask(i,j-1) == 2) ) then ! south face of the cell is at a stress boundary taud_y(i-1,j-1) = taud_y(i-1,j-1) - .5 * dxh * neumann_val taud_y(i,j-1) = taud_y(i,j-1) - .5 * dxh * neumann_val endif - if ((v_face_mask(i,j) .eq. 2) .OR. (hmask(i,j+1) .eq. 0) .OR. (hmask(i,j+1) .eq. 2) ) then + if ((v_face_mask(i,j) == 2) .OR. (hmask(i,j+1) == 0) .OR. (hmask(i,j+1) == 2) ) then ! north face of the cell is at a stress boundary taud_y(i-1,j) = taud_y(i-1,j) + .5 * dxh * neumann_val ! note negative sign due to direction of normal vector taud_y(i,j) = taud_y(i,j) + .5 * dxh * neumann_val @@ -4084,17 +4084,17 @@ subroutine init_boundary_values (CS, time, input_flux, input_thick, new_sim) do j=jsd,jed do i=isd,ied -! if ((i .eq. 4) .AND. ((mpp_pe() .eq. 0) .or. (mpp_pe() .eq. 6))) then +! if ((i == 4) .AND. ((mpp_pe() == 0) .or. (mpp_pe() == 6))) then ! print *,hmask(i,j),i,j,mpp_pe() ! endif - if (hmask(i,j) .eq. 3) then + if (hmask(i,j) == 3) then thickness_boundary_values (i,j) = input_thick endif - if ((hmask(i,j) .eq. 0) .or. (hmask(i,j) .eq. 1) .or. (hmask(i,j) .eq. 2)) then + if ((hmask(i,j) == 0) .or. (hmask(i,j) == 1) .or. (hmask(i,j) == 2)) then if ((i <= iec).and.(i >= isc)) then - if (u_face_mask (i-1,j) .eq. 3) then + if (u_face_mask (i-1,j) == 3) then u_boundary_values (i-1,j-1) = (1 - ((G%geoLatBu(i-1,j-1) - 0.5*CS%len_lat)*2./CS%len_lat)**2) * & 1.5 * input_flux / input_thick u_boundary_values (i-1,j) = (1 - ((G%geoLatBu(i-1,j) - 0.5*CS%len_lat)*2./CS%len_lat)**2) * & @@ -4105,12 +4105,12 @@ subroutine init_boundary_values (CS, time, input_flux, input_thick, new_sim) if (.not.(new_sim)) then if (.not. G%symmetric) then - if (((i+i_off) .eq. (G%domain%nihalo+1)).and.(u_face_mask(i-1,j).eq.3)) then + if (((i+i_off) == (G%domain%nihalo+1)).and.(u_face_mask(i-1,j) == 3)) then CS%u_shelf (i-1,j-1) = u_boundary_values (i-1,j-1) CS%u_shelf (i-1,j) = u_boundary_values (i-1,j) ! print *, u_boundary_values (i-1,j) endif - if (((j+j_off) .eq. (G%domain%njhalo+1)).and.(v_face_mask(i,j-1).eq.3)) then + if (((j+j_off) == (G%domain%njhalo+1)).and.(v_face_mask(i,j-1) == 3)) then CS%u_shelf (i-1,j-1) = u_boundary_values (i-1,j-1) CS%u_shelf (i,j-1) = u_boundary_values (i,j-1) endif @@ -4145,14 +4145,14 @@ subroutine CG_action_triangular (uret, vret, u, v, umask, vmask, hmask, nu_upper do i=is,ie do j=js,je - if (hmask(i,j) .eq. 1) then ! this cell's vertices contain degrees of freedom + if (hmask(i,j) == 1) then ! this cell's vertices contain degrees of freedom ux = (u(i,j-1)-u(i-1,j-1))/dxh(i,j) vx = (v(i,j-1)-v(i-1,j-1))/dxh(i,j) uy = (u(i-1,j)-u(i-1,j-1))/dyh(i,j) vy = (v(i-1,j)-v(i-1,j-1))/dyh(i,j) - if (umask(i,j-1) .eq. 1) then ! this (bot right) is a degree of freedom node + if (umask(i,j-1) == 1) then ! this (bot right) is a degree of freedom node uret(i,j-1) = uret(i,j-1) + & .5 * dxdyh(i,j) * nu_lower (i,j) * ((4*ux+2*vy) * (1./dxh(i,j)) + (uy+vy) * (0./dyh(i,j))) @@ -4169,7 +4169,7 @@ subroutine CG_action_triangular (uret, vret, u, v, umask, vmask, hmask, nu_upper v(i-1,j) + v(i,j-1)) endif - if (umask(i-1,j) .eq. 1) then ! this (top left) is a degree of freedom node + if (umask(i-1,j) == 1) then ! this (top left) is a degree of freedom node uret(i-1,j) = uret(i-1,j) + & .5 * dxdyh(i,j) * nu_lower (i,j) * ((4*ux+2*vy) * (0./dxh(i,j)) + (uy+vy) * (1./dyh(i,j))) @@ -4186,7 +4186,7 @@ subroutine CG_action_triangular (uret, vret, u, v, umask, vmask, hmask, nu_upper v(i-1,j) + v(i,j-1)) endif - if (umask(i-1,j-1) .eq. 1) then ! this (bot left) is a degree of freedom node + if (umask(i-1,j-1) == 1) then ! this (bot left) is a degree of freedom node uret(i-1,j-1) = uret(i-1,j-1) + & .5 * dxdyh(i,j) * nu_upper (i,j) * ((4*ux+2*vy) * (-1./dxh(i,j)) + (uy+vy) * (-1./dyh(i,j))) @@ -4209,7 +4209,7 @@ subroutine CG_action_triangular (uret, vret, u, v, umask, vmask, hmask, nu_upper uy = (u(i,j)-u(i,j-1))/dyh(i,j) vy = (v(i,j)-v(i,j-1))/dyh(i,j) - if (umask(i,j-1) .eq. 1) then ! this (bot right) is a degree of freedom node + if (umask(i,j-1) == 1) then ! this (bot right) is a degree of freedom node uret(i,j-1) = uret(i,j-1) + & .5 * dxdyh(i,j) * nu_upper (i,j) * ((4*ux+2*vy) * (0./dxh(i,j)) + (uy+vy) * (-1./dyh(i,j))) @@ -4226,7 +4226,7 @@ subroutine CG_action_triangular (uret, vret, u, v, umask, vmask, hmask, nu_upper u(i-1,j) + u(i,j-1)) endif - if (umask(i-1,j) .eq. 1) then ! this (top left) is a degree of freedom node + if (umask(i-1,j) == 1) then ! this (top left) is a degree of freedom node uret(i-1,j) = uret(i-1,j) + & .5 * dxdyh(i,j) * nu_upper (i,j) * ((4*ux+2*vy) * (-1./dxh(i,j)) + (uy+vy) * (0./dyh(i,j))) @@ -4243,7 +4243,7 @@ subroutine CG_action_triangular (uret, vret, u, v, umask, vmask, hmask, nu_upper u(i-1,j) + u(i,j-1)) endif - if (umask(i,j) .eq. 1) then ! this (top right) is a degree of freedom node + if (umask(i,j) == 1) then ! this (top right) is a degree of freedom node uret(i,j) = uret(i,j) + & .5 * dxdyh(i,j) * nu_upper (i,j) * ((4*ux+2*vy) * (1./dxh(i,j)) + (uy+vy) * (1./dyh(i,j))) @@ -4297,7 +4297,7 @@ subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmas ! Phi (i,j,2*k-1,q) gives d(Phi_k)/dx at quadrature point q ! Phi (i,j,2*k,q) gives d(Phi_k)/dy at quadrature point q -! Phi_k is equal to 1 at vertex k, and 0 at vertex l .ne. k, and bilinear +! Phi_k is equal to 1 at vertex k, and 0 at vertex l /= k, and bilinear real :: ux, vx, uy, vy, uq, vq, area, basel integer :: iq, jq, iphi, jphi, i, j, ilq, jlq @@ -4307,7 +4307,7 @@ subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmas xquad(1) = .5 * (1-sqrt(1./3)) ; xquad(2) = .5 * (1+sqrt(1./3)) do j=js,je - do i=is,ie ; if (hmask(i,j) .eq. 1) then + do i=is,ie ; if (hmask(i,j) == 1) then ! dxh = G%dxh(i,j) ! dyh = G%dyh(i,j) ! @@ -4329,13 +4329,13 @@ subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmas do iq=1,2 ; do jq=1,2 - if (iq .eq. 2) then + if (iq == 2) then ilq = 2 else ilq = 1 endif - if (jq .eq. 2) then + if (jq == 2) then jlq = 2 else jlq = 1 @@ -4372,41 +4372,41 @@ subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmas v(i,j) * Phi(i,j,8,2*(jq-1)+iq) do iphi=1,2 ; do jphi=1,2 - if (umask (i-2+iphi,j-2+jphi) .eq. 1) then + if (umask (i-2+iphi,j-2+jphi) == 1) then uret (i-2+iphi,j-2+jphi) = uret (i-2+iphi,j-2+jphi) + & .25 * area * nu (i,j) * ((4*ux+2*vy) * Phi(i,j,2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & (uy+vx) * Phi(i,j,2*(2*(jphi-1)+iphi),2*(jq-1)+iq)) endif - if (vmask (i-2+iphi,j-2+jphi) .eq. 1) then + if (vmask (i-2+iphi,j-2+jphi) == 1) then vret (i-2+iphi,j-2+jphi) = vret (i-2+iphi,j-2+jphi) + & .25 * area * nu (i,j) * ((uy+vx) * Phi(i,j,2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & (4*vy+2*ux) * Phi(i,j,2*(2*(jphi-1)+iphi),2*(jq-1)+iq)) endif - if (iq .eq. iphi) then + if (iq == iphi) then ilq = 2 else ilq = 1 endif - if (jq .eq. jphi) then + if (jq == jphi) then jlq = 2 else jlq = 1 endif - if (float_cond(i,j) .eq. 0) then + if (float_cond(i,j) == 0) then - if (umask (i-2+iphi,j-2+jphi) .eq. 1) then + if (umask (i-2+iphi,j-2+jphi) == 1) then uret (i-2+iphi,j-2+jphi) = uret (i-2+iphi,j-2+jphi) + & .25 * beta(i,j) * area * uq * xquad(ilq) * xquad(jlq) endif - if (vmask (i-2+iphi,j-2+jphi) .eq. 1) then + if (vmask (i-2+iphi,j-2+jphi) == 1) then vret (i-2+iphi,j-2+jphi) = vret (i-2+iphi,j-2+jphi) + & .25 * beta(i,j) * area * vq * xquad(ilq) * xquad(jlq) @@ -4415,25 +4415,25 @@ subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmas endif Ucontr(iphi,jphi) = Ucontr(iphi,jphi) + .25 * area * uq * xquad(ilq) * xquad(jlq) * beta(i,j) -! if ((i.eq.27) .and. (j.eq.8) .and. (iphi.eq.1) .and. (jphi.eq.1)) & +! if ((i == 27) .and. (j == 8) .and. (iphi == 1) .and. (jphi == 1)) & ! print *, "grid", uq, .25 * area * uq * xquad(ilq) * xquad(jlq) !endif enddo ; enddo enddo ; enddo - if (float_cond(i,j) .eq. 1) then + if (float_cond(i,j) == 1) then Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = D(i,j) Ucell(:,:) = u(i-1:i,j-1:j) ; Vcell(:,:) = v(i-1:i,j-1:j) ; Hcell(:,:) = H_node(i-1:i,j-1:j) call CG_action_subgrid_basal_bilinear & (Phisub, Hcell, Ucell, Vcell, area, basel, dens_ratio, Usubcontr, Vsubcontr, i, j) do iphi=1,2 ; do jphi=1,2 - if (umask (i-2+iphi,j-2+jphi) .eq. 1) then + if (umask (i-2+iphi,j-2+jphi) == 1) then uret (i-2+iphi,j-2+jphi) = uret (i-2+iphi,j-2+jphi) + Usubcontr (iphi,jphi) * beta(i,j) endif - if (vmask (i-2+iphi,j-2+jphi) .eq. 1) then + if (vmask (i-2+iphi,j-2+jphi) == 1) then vret (i-2+iphi,j-2+jphi) = vret (i-2+iphi,j-2+jphi) + Vsubcontr (iphi,jphi) * beta(i,j) - !if ( (iphi.eq.1) .and. (jphi.eq.1)) 8 + !if ( (iphi == 1) .and. (jphi == 1)) 8 ! print *, i,j, Usubcontr (iphi,jphi) * beta(i,j), " ", Ucontr(iphi,jphi) endif enddo ; enddo @@ -4497,7 +4497,7 @@ subroutine CG_action_subgrid_basal_bilinear (Phisub, H, U, V, DXDYH, D, dens_rat Ucontr (m,n) = Ucontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * uq Vcontr (m,n) = Vcontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * vq - ! if ((i_m .eq. 27) .and. (j_m .eq. 8) .and. (m.eq.1) .and. (n.eq.1)) & + ! if ((i_m == 27) .and. (j_m == 8) .and. (m == 1) .and. (n == 1)) & print *, "in subgrid", uq, Phisub(i,j,m,n,qx,qy) endif @@ -4540,12 +4540,12 @@ subroutine matrix_diagonal_triangle (CS, u_diagonal, v_diagonal) nu_lower => CS%ice_visc_lower_tri ; nu_upper => CS%ice_visc_upper_tri beta_lower => CS%taub_beta_eff_lower_tri ; beta_upper => CS%taub_beta_eff_upper_tri - do i=isc-1,iec+1 ; do j=jsc-1,jec+1 ; if (hmask(i,j) .eq. 1) then + do i=isc-1,iec+1 ; do j=jsc-1,jec+1 ; if (hmask(i,j) == 1) then dxh = G%dxT(i,j) dyh = G%dyT(i,j) dxdyh = G%areaT(i,j) - if (umask (i,j-1) .eq. 1) then ! this (bot right) is a degree of freedom node + if (umask (i,j-1) == 1) then ! this (bot right) is a degree of freedom node ux = 1./dxh ; uy = 0./dyh vx = 0. ; vy = 0. @@ -4585,7 +4585,7 @@ subroutine matrix_diagonal_triangle (CS, u_diagonal, v_diagonal) endif - if (umask (i-1,j) .eq. 1) then ! this (top left) is a degree of freedom node + if (umask (i-1,j) == 1) then ! this (top left) is a degree of freedom node ux = 0./dxh ; uy = 1./dyh vx = 0. ; vy = 0. @@ -4625,7 +4625,7 @@ subroutine matrix_diagonal_triangle (CS, u_diagonal, v_diagonal) endif - if (umask (i-1,j-1) .eq. 1) then ! this (bot left) is a degree of freedom node + if (umask (i-1,j-1) == 1) then ! this (bot left) is a degree of freedom node ux = -1./dxh ; uy = -1./dyh vx = 0. ; vy = 0. @@ -4646,7 +4646,7 @@ subroutine matrix_diagonal_triangle (CS, u_diagonal, v_diagonal) beta_lower(i,j) * dxdyh * 1./24 endif - if (umask (i,j) .eq. 1) then ! this (top right) is a degree of freedom node + if (umask (i,j) == 1) then ! this (top right) is a degree of freedom node ux = 1./ dxh ; uy = 1./dyh vx = 0. ; vy = 0. @@ -4718,7 +4718,7 @@ subroutine matrix_diagonal_bilinear(CS, float_cond, H_node, dens_ratio, Phisub, ! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j ! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j - do j=jsc-1,jec+1 ; do i=isc-1,iec+1 ; if (hmask(i,j) .eq. 1) then + do j=jsc-1,jec+1 ; do i=isc-1,iec+1 ; if (hmask(i,j) == 1) then dxh = G%dxT(i,j) dyh = G%dyT(i,j) @@ -4742,19 +4742,19 @@ subroutine matrix_diagonal_bilinear(CS, float_cond, H_node, dens_ratio, Phisub, do iphi=1,2 ; do jphi=1,2 - if (iq .eq. iphi) then + if (iq == iphi) then ilq = 2 else ilq = 1 endif - if (jq .eq. jphi) then + if (jq == jphi) then jlq = 2 else jlq = 1 endif - if (umask (i-2+iphi,j-2+jphi) .eq. 1) then + if (umask (i-2+iphi,j-2+jphi) == 1) then ux = Phi (2*(2*(jphi-1)+iphi)-1, 2*(jq-1)+iq) uy = Phi (2*(2*(jphi-1)+iphi), 2*(jq-1)+iq) @@ -4767,14 +4767,14 @@ subroutine matrix_diagonal_bilinear(CS, float_cond, H_node, dens_ratio, Phisub, uq = xquad(ilq) * xquad(jlq) - if (float_cond(i,j) .eq. 0) then + if (float_cond(i,j) == 0) then u_diagonal (i-2+iphi,j-2+jphi) = u_diagonal (i-2+iphi,j-2+jphi) + & .25 * beta(i,j) * dxdyh * uq * xquad(ilq) * xquad(jlq) endif endif - if (vmask (i-2+iphi,j-2+jphi) .eq. 1) then + if (vmask (i-2+iphi,j-2+jphi) == 1) then vx = Phi (2*(2*(jphi-1)+iphi)-1, 2*(jq-1)+iq) vy = Phi (2*(2*(jphi-1)+iphi), 2*(jq-1)+iq) @@ -4787,7 +4787,7 @@ subroutine matrix_diagonal_bilinear(CS, float_cond, H_node, dens_ratio, Phisub, vq = xquad(ilq) * xquad(jlq) - if (float_cond(i,j) .eq. 0) then + if (float_cond(i,j) == 0) then v_diagonal (i-2+iphi,j-2+jphi) = v_diagonal (i-2+iphi,j-2+jphi) + & .25 * beta(i,j) * dxdyh * vq * xquad(ilq) * xquad(jlq) endif @@ -4795,13 +4795,13 @@ subroutine matrix_diagonal_bilinear(CS, float_cond, H_node, dens_ratio, Phisub, endif enddo ; enddo enddo ; enddo - if (float_cond(i,j) .eq. 1) then + if (float_cond(i,j) == 1) then Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%bathyT(i,j) Hcell(:,:) = H_node(i-1:i,j-1:j) call CG_diagonal_subgrid_basal_bilinear & (Phisub, Hcell, dxdyh, basel, dens_ratio, Usubcontr, Vsubcontr) do iphi=1,2 ; do jphi=1,2 - if (umask (i-2+iphi,j-2+jphi) .eq. 1) then + if (umask (i-2+iphi,j-2+jphi) == 1) then u_diagonal (i-2+iphi,j-2+jphi) = u_diagonal (i-2+iphi,j-2+jphi) + Usubcontr (iphi,jphi) * beta(i,j) v_diagonal (i-2+iphi,j-2+jphi) = v_diagonal (i-2+iphi,j-2+jphi) + Vsubcontr (iphi,jphi) * beta(i,j) endif @@ -4888,9 +4888,9 @@ subroutine apply_boundary_values_triangle (CS, time, u_boundary_contr, v_boundar domain_width = CS%len_lat - do i=isc-1,iec+1 ; do j=jsc-1,jec+1 ; if (hmask(i,j) .eq. 1) then + do i=isc-1,iec+1 ; do j=jsc-1,jec+1 ; if (hmask(i,j) == 1) then - if ((umask(i-1,j-1) .eq. 3) .OR. (umask(i,j-1) .eq. 3) .OR. (umask(i-1,j) .eq. 3)) then + if ((umask(i-1,j-1) == 3) .OR. (umask(i,j-1) == 3) .OR. (umask(i-1,j) == 3)) then dxh = G%dxT(i,j) dyh = G%dyT(i,j) @@ -4901,7 +4901,7 @@ subroutine apply_boundary_values_triangle (CS, time, u_boundary_contr, v_boundar uy = (u_boundary_values(i-1,j)-u_boundary_values(i-1,j-1))/dyh vy = (v_boundary_values(i-1,j)-v_boundary_values(i-1,j-1))/dyh - if (umask (i,j-1) .eq. 1) then ! this (bot right) is a degree of freedom node + if (umask (i,j-1) == 1) then ! this (bot right) is a degree of freedom node u_boundary_contr (i,j-1) = u_boundary_contr (i,j-1) + & .5 * dxdyh * nu_lower (i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (0./dyh)) @@ -4918,7 +4918,7 @@ subroutine apply_boundary_values_triangle (CS, time, u_boundary_contr, v_boundar v_boundary_values(i-1,j) + v_boundary_values(i,j-1)) endif - if (umask (i-1,j) .eq. 1) then ! this (top left) is a degree of freedom node + if (umask (i-1,j) == 1) then ! this (top left) is a degree of freedom node u_boundary_contr (i-1,j) = u_boundary_contr (i-1,j) + & .5 * dxdyh * nu_lower (i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (1./dyh)) @@ -4935,7 +4935,7 @@ subroutine apply_boundary_values_triangle (CS, time, u_boundary_contr, v_boundar v_boundary_values(i-1,j) + v_boundary_values(i,j-1)) endif - if (umask (i-1,j-1) .eq. 1) then ! this (bot left) is a degree of freedom node + if (umask (i-1,j-1) == 1) then ! this (bot left) is a degree of freedom node u_boundary_contr (i-1,j-1) = u_boundary_contr (i-1,j-1) + & .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (-1./dyh)) @@ -4954,7 +4954,7 @@ subroutine apply_boundary_values_triangle (CS, time, u_boundary_contr, v_boundar endif - if ((umask(i,j) .eq. 3) .OR. (umask(i,j-1) .eq. 3) .OR. (umask(i-1,j) .eq. 3)) then + if ((umask(i,j) == 3) .OR. (umask(i,j-1) == 3) .OR. (umask(i-1,j) == 3)) then dxh = G%dxT(i,j) dyh = G%dyT(i,j) @@ -4965,7 +4965,7 @@ subroutine apply_boundary_values_triangle (CS, time, u_boundary_contr, v_boundar uy = (u_boundary_values(i,j)-u_boundary_values(i,j-1))/dyh vy = (v_boundary_values(i,j)-v_boundary_values(i,j-1))/dyh - if (umask (i,j-1) .eq. 1) then ! this (bot right) is a degree of freedom node + if (umask (i,j-1) == 1) then ! this (bot right) is a degree of freedom node u_boundary_contr (i,j-1) = u_boundary_contr (i,j-1) + & .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (-1./dyh)) @@ -4984,7 +4984,7 @@ subroutine apply_boundary_values_triangle (CS, time, u_boundary_contr, v_boundar u_boundary_values(i,j-1)) endif - if (umask (i-1,j) .eq. 1) then ! this (top left) is a degree of freedom node + if (umask (i-1,j) == 1) then ! this (top left) is a degree of freedom node u_boundary_contr (i-1,j) = u_boundary_contr (i-1,j) + & .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (0./dyh)) @@ -5003,7 +5003,7 @@ subroutine apply_boundary_values_triangle (CS, time, u_boundary_contr, v_boundar u_boundary_values(i,j-1)) endif - if (umask (i,j) .eq. 1) then ! this (top right) is a degree of freedom node + if (umask (i,j) == 1) then ! this (top right) is a degree of freedom node u_boundary_contr (i,j) = u_boundary_contr (i,j) + & .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (1./dyh)) @@ -5081,13 +5081,13 @@ subroutine apply_boundary_values_bilinear(CS, time, Phisub, H_node, float_cond, ! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j ! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j - do j=jsc-1,jec+1 ; do i=isc-1,iec+1 ; if (hmask(i,j) .eq. 1) then + do j=jsc-1,jec+1 ; do i=isc-1,iec+1 ; if (hmask(i,j) == 1) then ! process this cell if any corners have umask set to non-dirichlet bdry. ! NOTE: vmask not considered, probably should be - if ((umask(i-1,j-1) .eq. 3) .OR. (umask(i,j-1) .eq. 3) .OR. & - (umask(i-1,j) .eq. 3) .OR. (umask(i,j) .eq. 3)) then + if ((umask(i-1,j-1) == 3) .OR. (umask(i,j-1) == 3) .OR. & + (umask(i-1,j) == 3) .OR. (umask(i,j) == 3)) then dxh = G%dxT(i,j) @@ -5144,40 +5144,40 @@ subroutine apply_boundary_values_bilinear(CS, time, Phisub, H_node, float_cond, do iphi=1,2 ; do jphi=1,2 - if (iq .eq. iphi) then + if (iq == iphi) then ilq = 2 else ilq = 1 endif - if (jq .eq. jphi) then + if (jq == jphi) then jlq = 2 else jlq = 1 endif - if (umask (i-2+iphi,j-2+jphi) .eq. 1) then + if (umask (i-2+iphi,j-2+jphi) == 1) then u_boundary_contr (i-2+iphi,j-2+jphi) = u_boundary_contr (i-2+iphi,j-2+jphi) + & .25 * dxdyh * nu (i,j) * ( (4*ux+2*vy) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & (uy+vx) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq) ) - if (float_cond(i,j) .eq. 0) then + if (float_cond(i,j) == 0) then u_boundary_contr (i-2+iphi,j-2+jphi) = u_boundary_contr (i-2+iphi,j-2+jphi) + & .25 * beta(i,j) * dxdyh * uq * xquad(ilq) * xquad(jlq) endif endif - if (vmask (i-2+iphi,j-2+jphi) .eq. 1) then + if (vmask (i-2+iphi,j-2+jphi) == 1) then v_boundary_contr (i-2+iphi,j-2+jphi) = v_boundary_contr (i-2+iphi,j-2+jphi) + & .25 * dxdyh * nu (i,j) * ( (uy+vx) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & (4*vy+2*ux) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq)) - if (float_cond(i,j) .eq. 0) then + if (float_cond(i,j) == 0) then v_boundary_contr (i-2+iphi,j-2+jphi) = v_boundary_contr (i-2+iphi,j-2+jphi) + & .25 * beta(i,j) * dxdyh * vq * xquad(ilq) * xquad(jlq) endif @@ -5186,18 +5186,18 @@ subroutine apply_boundary_values_bilinear(CS, time, Phisub, H_node, float_cond, enddo ; enddo enddo ; enddo - if (float_cond(i,j) .eq. 1) then + if (float_cond(i,j) == 1) then Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%bathyT(i,j) Ucell(:,:) = u_boundary_values(i-1:i,j-1:j) ; Vcell(:,:) = v_boundary_values(i-1:i,j-1:j) Hcell(:,:) = H_node(i-1:i,j-1:j) call CG_action_subgrid_basal_bilinear & (Phisub, Hcell, Ucell, Vcell, dxdyh, basel, dens_ratio, Usubcontr, Vsubcontr) do iphi=1,2 ; do jphi = 1,2 - if (umask (i-2+iphi,j-2+jphi) .eq. 1) then + if (umask (i-2+iphi,j-2+jphi) == 1) then u_boundary_contr (i-2+iphi,j-2+jphi) = u_boundary_contr (i-2+iphi,j-2+jphi) + & Usubcontr(iphi,jphi) * beta (i,j) endif - if (vmask (i-2+iphi,j-2+jphi) .eq. 1) then + if (vmask (i-2+iphi,j-2+jphi) == 1) then v_boundary_contr (i-2+iphi,j-2+jphi) = v_boundary_contr (i-2+iphi,j-2+jphi) + & Vsubcontr(iphi,jphi) * beta (i,j) endif @@ -5265,7 +5265,7 @@ subroutine calc_shelf_visc_triangular (CS,u,v) dyh = G%dyT(i,j) dxdyh = G%areaT(i,j) - if (hmask (i,j) .eq. 1) then + if (hmask (i,j) == 1) then ux = (u(i,j-1)-u(i-1,j-1)) / dxh vx = (v(i,j-1)-v(i-1,j-1)) / dxh uy = (u(i-1,j)-u(i-1,j-1)) / dyh @@ -5341,7 +5341,7 @@ subroutine calc_shelf_visc_bilinear (CS, u, v) dyh = G%dyT(i,j) dxdyh = G%areaT(i,j) - if (hmask (i,j) .eq. 1) then + if (hmask (i,j) == 1) then ux = (u(i,j) + u(i,j-1) - u(i-1,j) - u(i-1,j-1)) / (2*dxh) vx = (v(i,j) + v(i,j-1) - v(i-1,j) - v(i-1,j-1)) / (2*dxh) uy = (u(i,j) - u(i,j-1) + u(i-1,j) - u(i-1,j-1)) / (2*dyh) @@ -5388,7 +5388,7 @@ subroutine update_OD_ffrac (CS, ocean_mass, counter, nstep_velocity, time_step, enddo enddo - if (counter .eq. nstep_velocity) then + if (counter == nstep_velocity) then do j=jsc,jec do i=isc,iec @@ -5464,7 +5464,7 @@ subroutine bilinear_shape_functions (X, Y, Phi, area) ! ! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j ! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j -! Phi_i is equal to 1 at vertex i, and 0 at vertex k .ne. i, and bilinear +! Phi_i is equal to 1 at vertex i, and 0 at vertex k /= i, and bilinear ! ! This should be a one-off; once per nonlinear solve? once per lifetime? ! ... will all cells have the same shape and dimension? @@ -5487,13 +5487,13 @@ subroutine bilinear_shape_functions (X, Y, Phi, area) xnode = 2-mod(node,2) ; ynode = ceiling(REAL(node)/2) - if (ynode .eq. 1) then + if (ynode == 1) then yexp = 1-yquad(qpoint) else yexp = yquad(qpoint) endif - if (1 .eq. xnode) then + if (1 == xnode) then xexp = 1-xquad(qpoint) else xexp = xquad(qpoint) @@ -5556,12 +5556,12 @@ subroutine bilinear_shape_functions_subgrid (Phisub, nsub) do k=1,2 do l=1,2 val = 1.0 - if (k .eq. 1) then + if (k == 1) then val = val * (1.0-x) else val = val * x endif - if (l .eq. 1) then + if (l == 1) then val = val * (1.0-y) else val = val * y @@ -5633,7 +5633,7 @@ subroutine update_velocity_masks (CS) do j=js,G%jed do i=is,G%ied - if (hmask(i,j) .eq. 1) then + if (hmask(i,j) == 1) then umask(i-1:i,j-1:j) = 1. vmask(i-1:i,j-1:j) = 1. @@ -5690,40 +5690,40 @@ subroutine update_velocity_masks (CS) ! vmask (i-1,j-1:j) = 0. !endif - !if (j_off+j .eq. gjsc+1) then !bot boundary + !if (j_off+j == gjsc+1) then !bot boundary ! v_face_mask (i,j-1) = 0. ! umask (i-1:i,j-1) = 0. ! vmask (i-1:i,j-1) = 0. - !elseif (j_off+j .eq. gjec) then !top boundary + !elseif (j_off+j == gjec) then !top boundary ! v_face_mask (i,j) = 0. ! umask (i-1:i,j) = 0. ! vmask (i-1:i,j) = 0. !endif if (i < G%ied) then - if ((hmask(i+1,j) .eq. 0) & - .OR. (hmask(i+1,j) .eq. 2)) then + if ((hmask(i+1,j) == 0) & + .OR. (hmask(i+1,j) == 2)) then !right boundary or adjacent to unfilled cell u_face_mask (i,j) = 2. endif endif if (i > G%isd) then - if ((hmask(i-1,j) .eq. 0) .OR. (hmask(i-1,j) .eq. 2)) then + if ((hmask(i-1,j) == 0) .OR. (hmask(i-1,j) == 2)) then !adjacent to unfilled cell u_face_mask (i-1,j) = 2. endif endif if (j > G%jsd) then - if ((hmask(i,j-1) .eq. 0) .OR. (hmask(i,j-1) .eq. 2)) then + if ((hmask(i,j-1) == 0) .OR. (hmask(i,j-1) == 2)) then !adjacent to unfilled cell v_face_mask (i,j-1) = 2. endif endif if (j < G%jed) then - if ((hmask(i,j+1) .eq. 0) .OR. (hmask(i,j+1) .eq. 2)) then + if ((hmask(i,j+1) == 0) .OR. (hmask(i,j+1) == 2)) then !adjacent to unfilled cell v_face_mask (i,j) = 2. endif @@ -5768,7 +5768,7 @@ subroutine interpolate_H_to_B (CS, h_shelf, hmask, H_node) num_h = 0 do k=0,1 do l=0,1 - if (hmask (i+k,j+l) .eq. 1.0) then + if (hmask (i+k,j+l) == 1.0) then summ = summ + h_shelf (i+k,j+l) num_h = num_h + 1 endif @@ -5866,7 +5866,7 @@ subroutine savearray2(fname,A,flag) END DO - if (i.eq.1) THEN + if (i == 1) THEN lh = LEN(TRIM(ln)) @@ -5893,7 +5893,7 @@ subroutine savearray2(fname,A,flag) WRITE(UNIT=fin,IOSTAT=iock,FMT=TRIM(FMT1)) TRIM(ln) - if (iock .ne. 0) THEN + if (iock /= 0) THEN PRINT*,iock END IF END DO @@ -5949,7 +5949,7 @@ subroutine solo_time_step (CS, time_step, n, Time, min_time_step_in) local_u_max = 0 ; local_v_max = 0 - if (hmask (i,j) .eq. 1.0) then + if (hmask (i,j) == 1.0) then ! all 4 corners of the cell should have valid velocity values; otherwise something is wrong ! this is done by checking that umask and vmask are nonzero at all 4 corners do ki=1,2 ; do kj = 1,2 @@ -5991,7 +5991,7 @@ subroutine solo_time_step (CS, time_step, n, Time, min_time_step_in) call ice_shelf_advect (CS, time_step_int, CS%lprec, Time) - if (mpp_pe() .eq. 7) then + if (mpp_pe() == 7) then call savearray2 ("hmask",CS%hmask,CS%write_output_to_file) !!! OVS!!! ! call savearray2 ("tshelf",CS%t_shelf,CS%write_output_to_file) @@ -6109,7 +6109,7 @@ subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) do i=isd,ied t_bd = CS%t_boundary_values(i,j) ! if (CS%hmask(i,j) > 1) then - if ((CS%hmask(i,j) .eq. 3) .or. (CS%hmask(i,j) .eq. -2)) then + if ((CS%hmask(i,j) == 3) .or. (CS%hmask(i,j) == -2)) then CS%t_shelf(i,j) = CS%t_boundary_values(i,j) endif enddo @@ -6140,7 +6140,7 @@ subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) do j=jsd,jed do i=isd,ied -! if (CS%hmask(i,j) .eq. 1) then +! if (CS%hmask(i,j) == 1) then if (CS%h_shelf(i,j) > 0.0) then CS%t_shelf (i,j) = th_after_vflux(i,j)/CS%h_shelf (i,j) else @@ -6153,7 +6153,7 @@ subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) do i=isd,ied t_bd = CS%t_boundary_values(i,j) ! if (CS%hmask(i,j) > 1) then - if ((CS%hmask(i,j) .eq. 3) .or. (CS%hmask(i,j) .eq. -2)) then + if ((CS%hmask(i,j) == 3) .or. (CS%hmask(i,j) == -2)) then CS%t_shelf(i,j) = t_bd ! CS%t_shelf(i,j) = -15.0 endif @@ -6162,7 +6162,7 @@ subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) do j=jsc,jec do i=isc,iec - if ((CS%hmask(i,j) .eq. 1) .or. (CS%hmask(i,j) .eq. 2)) then + if ((CS%hmask(i,j) == 1) .or. (CS%hmask(i,j) == 2)) then if (CS%h_shelf(i,j) > 0.0) then ! CS%t_shelf (i,j) = CS%t_shelf (i,j) + time_step*(adot*Tsurf -melt_rate (i,j)*Tbot(i,j))/CS%h_shelf (i,j) CS%t_shelf (i,j) = CS%t_shelf (i,j) + time_step*(adot*Tsurf -3/spy*Tbot(i,j))/CS%h_shelf (i,j) @@ -6248,25 +6248,25 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter ((j+j_off) >= G%domain%njhalo+1)) then ! based on mehmet's code - only if btw north & south boundaries stencil(:) = -1 -! if (i+i_off .eq. G%domain%nihalo+G%domain%nihalo) +! if (i+i_off == G%domain%nihalo+G%domain%nihalo) do i=is,ie if (((i+i_off) <= G%domain%niglobal+G%domain%nihalo) .AND. & ((i+i_off) >= G%domain%nihalo+1)) then - if (i+i_off .eq. G%domain%nihalo+1) then + if (i+i_off == G%domain%nihalo+1) then at_west_bdry=.true. else at_west_bdry=.false. endif - if (i+i_off .eq. G%domain%niglobal+G%domain%nihalo) then + if (i+i_off == G%domain%niglobal+G%domain%nihalo) then at_east_bdry=.true. else at_east_bdry=.false. endif - if (hmask(i,j) .eq. 1) then + if (hmask(i,j) == 1) then dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) @@ -6278,7 +6278,7 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter ! 1ST DO LEFT FACE - if (u_face_mask (i-1,j) .eq. 4.) then + if (u_face_mask (i-1,j) == 4.) then flux_diff_cell = flux_diff_cell + dyh * time_step * u_flux_boundary_values (i-1,j) * & t_boundary(i-1,j) / dxdyh @@ -6290,7 +6290,7 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter ! get u-velocity at center of left face u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - ! if (at_west_bdry .and. (i .eq. G%isc)) then + ! if (at_west_bdry .and. (i == G%isc)) then ! print *, j, u_face, stencil(-1) ! endif @@ -6298,12 +6298,12 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter ! i may not cover all the cases.. but i cover the realistic ones - if (at_west_bdry .AND. (hmask(i-1,j).eq.3)) then ! at western bdry but there is a + if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then ! at western bdry but there is a ! thickness bdry condition, and the stencil contains it stencil (-1) = CS%t_boundary_values(i-1,j)*CS%h_shelf(i-1,j) flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(-1) / dxdyh - elseif (hmask(i-1,j) * hmask(i-2,j) .eq. 1) then ! h(i-2) and h(i-1) are valid + elseif (hmask(i-1,j) * hmask(i-2,j) == 1) then ! h(i-2) and h(i-1) are valid phi = slope_limiter (stencil(-1)-stencil(-2), stencil(0)-stencil(-1)) flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh* time_step / dxdyh * & (stencil(-1) - phi * (stencil(-1)-stencil(0))/2) @@ -6317,7 +6317,7 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter endif elseif (u_face < 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available - if (hmask(i-1,j) * hmask(i+1,j) .eq. 1) then ! h(i-1) and h(i+1) are both valid + if (hmask(i-1,j) * hmask(i+1,j) == 1) then ! h(i-1) and h(i+1) are both valid phi = slope_limiter (stencil(0)-stencil(1), stencil(-1)-stencil(0)) flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * & (stencil(0) - phi * (stencil(0)-stencil(-1))/2) @@ -6325,7 +6325,7 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter else flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * stencil(0) - if ((hmask(i-1,j) .eq. 0) .OR. (hmask(i-1,j) .eq. 2)) then + if ((hmask(i-1,j) == 0) .OR. (hmask(i-1,j) == 2)) then flux_enter(i-1,j,2) = ABS(u_face) * dyh * time_step * stencil(0) endif endif @@ -6336,7 +6336,7 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter ! get u-velocity at center of right face - if (u_face_mask (i+1,j) .eq. 4.) then + if (u_face_mask (i+1,j) == 4.) then flux_diff_cell = flux_diff_cell + dyh * time_step * u_flux_boundary_values (i+1,j) *& t_boundary(i+1,j)/ dxdyh @@ -6349,12 +6349,12 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter if (u_face < 0) then !flux is into cell - we need info from h(i+2), h(i+1) if available - if (at_east_bdry .AND. (hmask(i+1,j).eq.3)) then ! at eastern bdry but there is a + if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then ! at eastern bdry but there is a ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(1) / dxdyh - elseif (hmask(i+1,j) * hmask(i+2,j) .eq. 1) then ! h(i+2) and h(i+1) are valid + elseif (hmask(i+1,j) * hmask(i+2,j) == 1) then ! h(i+2) and h(i+1) are valid phi = slope_limiter (stencil(1)-stencil(2), stencil(0)-stencil(1)) flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step / dxdyh * & @@ -6370,7 +6370,7 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter elseif (u_face > 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available - if (hmask(i-1,j) * hmask(i+1,j) .eq. 1) then ! h(i-1) and h(i+1) are both valid + if (hmask(i-1,j) * hmask(i+1,j) == 1) then ! h(i-1) and h(i+1) are both valid phi = slope_limiter (stencil(0)-stencil(-1), stencil(1)-stencil(0)) flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * & @@ -6382,7 +6382,7 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * stencil(0) - if ((hmask(i+1,j) .eq. 0) .OR. (hmask(i+1,j) .eq. 2)) then + if ((hmask(i+1,j) == 0) .OR. (hmask(i+1,j) == 2)) then flux_enter(i+1,j,1) = ABS(u_face) * dyh * time_step * stencil(0) endif @@ -6395,34 +6395,34 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter endif - elseif ((hmask(i,j) .eq. 0) .OR. (hmask(i,j) .eq. 2)) then + elseif ((hmask(i,j) == 0) .OR. (hmask(i,j) == 2)) then - if (at_west_bdry .AND. (hmask(i-1,j) .EQ. 3)) then + if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) flux_enter (i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * t_boundary(i-1,j)* & CS%thickness_boundary_values(i+1,j) - elseif (u_face_mask (i-1,j) .eq. 4.) then + elseif (u_face_mask (i-1,j) == 4.) then flux_enter (i,j,1) = G%dyT(i,j) * time_step * u_flux_boundary_values (i-1,j)*t_boundary(i-1,j) ! flux_enter (i,j,1) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*t_boundary (i-1,j) ! assume no flux bc for temp endif - if (at_east_bdry .AND. (hmask(i+1,j) .EQ. 3)) then + if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * t_boundary(i+1,j)* & CS%thickness_boundary_values(i+1,j) - elseif (u_face_mask (i+1,j) .eq. 4.) then + elseif (u_face_mask (i+1,j) == 4.) then flux_enter (i,j,2) = G%dyT(i,j) * time_step * u_flux_boundary_values (i+1,j) * t_boundary(i+1,j) ! assume no flux bc for temp ! flux_enter (i,j,2) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*t_boundary (i+1,j) endif -! if ((i .eq. is) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i-1,j) .eq. 1)) then +! if ((i == is) .AND. (hmask(i,j) == 0) .AND. (hmask(i-1,j) == 1)) then ! this is solely for the purposes of keeping the mask consistent while advancing ! the front without having to call pass_var - if cell is empty and cell to left ! is ice-covered then this cell will become partly covered ! hmask(i,j) = 2 -! elseif ((i .eq. ie) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i+1,j) .eq. 1)) then +! elseif ((i == ie) .AND. (hmask(i,j) == 0) .AND. (hmask(i+1,j) == 1)) then ! this is solely for the purposes of keeping the mask consistent while advancing ! the front without having to call pass_var - if cell is empty and cell to left ! is ice-covered then this cell will become partly covered @@ -6507,18 +6507,18 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, if (((j+j_off) <= G%domain%njglobal+G%domain%njhalo) .AND. & ((j+j_off) >= G%domain%njhalo+1)) then - if (j+j_off .eq. G%domain%njhalo+1) then + if (j+j_off == G%domain%njhalo+1) then at_south_bdry=.true. else at_south_bdry=.false. endif - if (j+j_off .eq. G%domain%njglobal+G%domain%njhalo) then + if (j+j_off == G%domain%njglobal+G%domain%njhalo) then at_north_bdry=.true. else at_north_bdry=.false. endif - if (hmask(i,j) .eq. 1) then + if (hmask(i,j) == 1) then dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) h_after_vflux (i,j) = h_after_uflux (i,j) @@ -6527,7 +6527,7 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, ! 1ST DO south FACE - if (v_face_mask (i,j-1) .eq. 4.) then + if (v_face_mask (i,j-1) == 4.) then flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values (i,j-1) * & t_boundary(i,j-1)/ dxdyh @@ -6543,11 +6543,11 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, ! i may not cover all the cases.. but i cover the realistic ones - if (at_south_bdry .AND. (hmask(i,j-1).eq.3)) then ! at western bdry but there is a + if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then ! at western bdry but there is a ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(-1) / dxdyh - elseif (hmask(i,j-1) * hmask(i,j-2) .eq. 1) then ! h(j-2) and h(j-1) are valid + elseif (hmask(i,j-1) * hmask(i,j-2) == 1) then ! h(j-2) and h(j-1) are valid phi = slope_limiter (stencil(-1)-stencil(-2), stencil(0)-stencil(-1)) flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * & @@ -6561,14 +6561,14 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, elseif (v_face < 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available - if (hmask(i,j-1) * hmask(i,j+1) .eq. 1) then ! h(j-1) and h(j+1) are both valid + if (hmask(i,j-1) * hmask(i,j+1) == 1) then ! h(j-1) and h(j+1) are both valid phi = slope_limiter (stencil(0)-stencil(1), stencil(-1)-stencil(0)) flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * & (stencil(0) - phi * (stencil(0)-stencil(-1))/2) else flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * stencil(0) - if ((hmask(i,j-1) .eq. 0) .OR. (hmask(i,j-1) .eq. 2)) then + if ((hmask(i,j-1) == 0) .OR. (hmask(i,j-1) == 2)) then flux_enter(i,j-1,4) = ABS(v_face) * dyh * time_step * stencil(0) endif @@ -6580,7 +6580,7 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, ! NEXT DO north FACE - if (v_face_mask(i,j+1) .eq. 4.) then + if (v_face_mask(i,j+1) == 4.) then flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values (i,j+1) *& t_boundary(i,j+1)/ dxdyh @@ -6594,10 +6594,10 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, if (v_face < 0) then !flux is into cell - we need info from h(j+2), h(j+1) if available - if (at_north_bdry .AND. (hmask(i,j+1).eq.3)) then ! at eastern bdry but there is a + if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then ! at eastern bdry but there is a ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(1) / dxdyh - elseif (hmask(i,j+1) * hmask(i,j+2) .eq. 1) then ! h(j+2) and h(j+1) are valid + elseif (hmask(i,j+1) * hmask(i,j+2) == 1) then ! h(j+2) and h(j+1) are valid phi = slope_limiter (stencil(1)-stencil(2), stencil(0)-stencil(1)) flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * & (stencil(1) - phi * (stencil(1)-stencil(0))/2) @@ -6609,7 +6609,7 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, elseif (v_face > 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available - if (hmask(i,j-1) * hmask(i,j+1) .eq. 1) then ! h(j-1) and h(j+1) are both valid + if (hmask(i,j-1) * hmask(i,j+1) == 1) then ! h(j-1) and h(j+1) are both valid phi = slope_limiter (stencil(0)-stencil(-1), stencil(1)-stencil(0)) flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * & (stencil(0) - phi * (stencil(0)-stencil(1))/2) @@ -6617,7 +6617,7 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, ! (o.w. flux would most likely be out of cell) ! but h(j+2) is not flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * stencil(0) - if ((hmask(i,j+1) .eq. 0) .OR. (hmask(i,j+1) .eq. 2)) then + if ((hmask(i,j+1) == 0) .OR. (hmask(i,j+1) == 2)) then flux_enter(i,j+1,3) = ABS(v_face) * dxh * time_step * stencil(0) endif endif @@ -6628,35 +6628,35 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, h_after_vflux (i,j) = h_after_vflux (i,j) + flux_diff_cell - elseif ((hmask(i,j) .eq. 0) .OR. (hmask(i,j) .eq. 2)) then + elseif ((hmask(i,j) == 0) .OR. (hmask(i,j) == 2)) then - if (at_south_bdry .AND. (hmask(i,j-1) .EQ. 3)) then + if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then v_face = 0.5 * (CS%v_shelf(i-1,j-1) + CS%v_shelf(i,j-1)) flux_enter (i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * t_boundary(i,j-1)* & CS%thickness_boundary_values(i,j-1) - elseif (v_face_mask(i,j-1) .eq. 4.) then + elseif (v_face_mask(i,j-1) == 4.) then flux_enter (i,j,3) = G%dxT(i,j) * time_step * v_flux_boundary_values (i,j-1)*t_boundary(i,j-1) ! assume no flux bc for temp ! flux_enter (i,j,3) = G%dxh(i,j) * time_step * CS%v_shelf(i,j)*t_boundary (i,j-1) endif - if (at_north_bdry .AND. (hmask(i,j+1) .EQ. 3)) then + if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then v_face = 0.5 * (CS%v_shelf(i-1,j) + CS%v_shelf(i,j)) flux_enter (i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * t_boundary(i,j+1)* & CS%thickness_boundary_values(i,j+1) - elseif (v_face_mask(i,j+1) .eq. 4.) then + elseif (v_face_mask(i,j+1) == 4.) then flux_enter (i,j,4) = G%dxT(i,j) * time_step * v_flux_boundary_values (i,j+1)*t_boundary(i,j+1) ! assume no flux bc for temp ! flux_enter (i,j,4) = G%dxh(i,j) * time_step * CS%v_shelf(i,j)*t_boundary (i,j+1) endif -! if ((j .eq. js) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i,j-1) .eq. 1)) then +! if ((j == js) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j-1) == 1)) then ! this is solely for the purposes of keeping the mask consistent while advancing ! the front without having to call pass_var - if cell is empty and cell to left ! is ice-covered then this cell will become partly covered ! hmask (i,j) = 2 - ! elseif ((j .eq. je) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i,j+1) .eq. 1)) then + ! elseif ((j == je) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j+1) == 1)) then ! this is solely for the purposes of keeping the mask consistent while advancing the ! front without having to call pass_var - if cell is empty and cell to left is ! ice-covered then this cell will become partly covered diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 9ce2f37032..01202a013b 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -123,7 +123,7 @@ subroutine initialize_ice_thickness_from_file (h_shelf, area_shelf_h, hmask, G, if (area_shelf_h (i,j) >= G%areaT(i,j)) then hmask(i,j) = 1. - elseif (area_shelf_h (i,j) .eq. 0.0) then + elseif (area_shelf_h (i,j) == 0.0) then hmask(i,j) = 0. elseif ((area_shelf_h(i,j) > 0) .and. (area_shelf_h(i,j) <= G%areaT(i,j))) then hmask(i,j) = 2. @@ -209,7 +209,7 @@ subroutine initialize_ice_thickness_channel (h_shelf, area_shelf_h, hmask, G, PF endif endif - if ((i+G%idg_offset) .eq. G%domain%nihalo+1) then + if ((i+G%idg_offset) == G%domain%nihalo+1) then hmask(i-1,j) = 3.0 endif @@ -311,7 +311,7 @@ end subroutine initialize_ice_thickness_channel ! ! upstream boundary - set either dirichlet or flux condition -! if ((i+G%idg_offset) .eq. G%domain%nihalo+1) then +! if ((i+G%idg_offset) == G%domain%nihalo+1) then ! if (flux_bdry) then ! u_face_mask_boundary (i-1,j) = 4.0 ! u_flux_boundary_values (i-1,j) = input_flux @@ -328,14 +328,14 @@ end subroutine initialize_ice_thickness_channel ! ! side boundaries: no flow -! if (G%jdg_offset+j .eq. gjsc+1) then !bot boundary -! if (len_stress .eq. 0. .OR. G%geoLonCv(i,j-1) <= len_stress) then +! if (G%jdg_offset+j == gjsc+1) then !bot boundary +! if (len_stress == 0. .OR. G%geoLonCv(i,j-1) <= len_stress) then ! v_face_mask_boundary (i,j-1) = 0. ! else ! v_face_mask_boundary (i,j-1) = 1. ! endif -! elseif (G%jdg_offset+j .eq. gjec) then !top boundary -! if (len_stress .eq. 0. .OR. G%geoLonCv(i,j-1) <= len_stress) then +! elseif (G%jdg_offset+j == gjec) then !top boundary +! if (len_stress == 0. .OR. G%geoLonCv(i,j-1) <= len_stress) then ! v_face_mask_boundary (i,j) = 0. ! else ! v_face_mask_boundary (i,j) = 1. @@ -344,7 +344,7 @@ end subroutine initialize_ice_thickness_channel ! ! downstream boundary - CFBC -! if (i+G%idg_offset .eq. giec) then +! if (i+G%idg_offset == giec) then ! u_face_mask_boundary(i,j) = 2.0 ! endif diff --git a/src/ice_shelf/shelf_triangular_FEstuff.F90 b/src/ice_shelf/shelf_triangular_FEstuff.F90 index 6829774386..088ada5507 100644 --- a/src/ice_shelf/shelf_triangular_FEstuff.F90 +++ b/src/ice_shelf/shelf_triangular_FEstuff.F90 @@ -192,12 +192,12 @@ subroutine matrix_diagonal_triangle (CS, u_diagonal, v_diagonal) nu_lower => CS%ice_visc_lower_tri ; nu_upper => CS%ice_visc_upper_tri beta_lower => CS%taub_beta_eff_lower_tri ; beta_upper => CS%taub_beta_eff_upper_tri - do i=isc-1,iec+1 ; do j=jsc-1,jec+1 ; if (hmask(i,j) .eq. 1) then + do i=isc-1,iec+1 ; do j=jsc-1,jec+1 ; if (hmask(i,j) == 1) then dxh = G%dxT(i,j) dyh = G%dyT(i,j) dxdyh = G%areaT(i,j) - if (umask (i,j-1) .eq. 1) then ! this (bot right) is a degree of freedom node + if (umask (i,j-1) == 1) then ! this (bot right) is a degree of freedom node ux = 1./dxh ; uy = 0./dyh vx = 0. ; vy = 0. @@ -237,7 +237,7 @@ subroutine matrix_diagonal_triangle (CS, u_diagonal, v_diagonal) endif - if (umask (i-1,j) .eq. 1) then ! this (top left) is a degree of freedom node + if (umask (i-1,j) == 1) then ! this (top left) is a degree of freedom node ux = 0./dxh ; uy = 1./dyh vx = 0. ; vy = 0. @@ -277,7 +277,7 @@ subroutine matrix_diagonal_triangle (CS, u_diagonal, v_diagonal) endif - if (umask (i-1,j-1) .eq. 1) then ! this (bot left) is a degree of freedom node + if (umask (i-1,j-1) == 1) then ! this (bot left) is a degree of freedom node ux = -1./dxh ; uy = -1./dyh vx = 0. ; vy = 0. @@ -298,7 +298,7 @@ subroutine matrix_diagonal_triangle (CS, u_diagonal, v_diagonal) beta_lower(i,j) * dxdyh * 1./24 endif - if (umask (i,j) .eq. 1) then ! this (top right) is a degree of freedom node + if (umask (i,j) == 1) then ! this (top right) is a degree of freedom node ux = 1./ dxh ; uy = 1./dyh vx = 0. ; vy = 0. @@ -360,9 +360,9 @@ end subroutine matrix_diagonal_triangle !~ domain_width = CS%len_lat - !~ do i=isc-1,iec+1 ; do j=jsc-1,jec+1 ; if (hmask(i,j) .eq. 1) then + !~ do i=isc-1,iec+1 ; do j=jsc-1,jec+1 ; if (hmask(i,j) == 1) then - !~ if ((umask(i-1,j-1) .eq. 3) .OR. (umask(i,j-1) .eq. 3) .OR. (umask(i-1,j) .eq. 3)) then + !~ if ((umask(i-1,j-1) == 3) .OR. (umask(i,j-1) == 3) .OR. (umask(i-1,j) == 3)) then !~ dxh = G%dxh(i,j) !~ dyh = G%dyh(i,j) @@ -373,7 +373,7 @@ end subroutine matrix_diagonal_triangle !~ uy = (u_boundary_values(i-1,j)-u_boundary_values(i-1,j-1))/dyh !~ vy = (v_boundary_values(i-1,j)-v_boundary_values(i-1,j-1))/dyh - !~ if (umask (i,j-1) .eq. 1) then ! this (bot right) is a degree of freedom node + !~ if (umask (i,j-1) == 1) then ! this (bot right) is a degree of freedom node !~ u_boundary_contr (i,j-1) = u_boundary_contr (i,j-1) + & !~ .5 * dxdyh * nu_lower (i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (0./dyh)) @@ -390,7 +390,7 @@ end subroutine matrix_diagonal_triangle !~ v_boundary_values(i-1,j) + v_boundary_values(i,j-1)) !~ endif - !~ if (umask (i-1,j) .eq. 1) then ! this (top left) is a degree of freedom node + !~ if (umask (i-1,j) == 1) then ! this (top left) is a degree of freedom node !~ u_boundary_contr (i-1,j) = u_boundary_contr (i-1,j) + & !~ .5 * dxdyh * nu_lower (i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (1./dyh)) @@ -407,7 +407,7 @@ end subroutine matrix_diagonal_triangle !~ v_boundary_values(i-1,j) + v_boundary_values(i,j-1)) !~ endif - !~ if (umask (i-1,j-1) .eq. 1) then ! this (bot left) is a degree of freedom node + !~ if (umask (i-1,j-1) == 1) then ! this (bot left) is a degree of freedom node !~ u_boundary_contr (i-1,j-1) = u_boundary_contr (i-1,j-1) + & !~ .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (-1./dyh)) @@ -426,7 +426,7 @@ end subroutine matrix_diagonal_triangle !~ endif - !~ if ((umask(i,j) .eq. 3) .OR. (umask(i,j-1) .eq. 3) .OR. (umask(i-1,j) .eq. 3)) then + !~ if ((umask(i,j) == 3) .OR. (umask(i,j-1) == 3) .OR. (umask(i-1,j) == 3)) then !~ dxh = G%dxh(i,j) !~ dyh = G%dyh(i,j) @@ -437,7 +437,7 @@ end subroutine matrix_diagonal_triangle !~ uy = (u_boundary_values(i,j)-u_boundary_values(i,j-1))/dyh !~ vy = (v_boundary_values(i,j)-v_boundary_values(i,j-1))/dyh - !~ if (umask (i,j-1) .eq. 1) then ! this (bot right) is a degree of freedom node + !~ if (umask (i,j-1) == 1) then ! this (bot right) is a degree of freedom node !~ u_boundary_contr (i,j-1) = u_boundary_contr (i,j-1) + & !~ .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (-1./dyh)) @@ -456,7 +456,7 @@ end subroutine matrix_diagonal_triangle !~ u_boundary_values(i,j-1)) !~ endif - !~ if (umask (i-1,j) .eq. 1) then ! this (top left) is a degree of freedom node + !~ if (umask (i-1,j) == 1) then ! this (top left) is a degree of freedom node !~ u_boundary_contr (i-1,j) = u_boundary_contr (i-1,j) + & !~ .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (0./dyh)) @@ -475,7 +475,7 @@ end subroutine matrix_diagonal_triangle !~ u_boundary_values(i,j-1)) !~ endif - !~ if (umask (i,j) .eq. 1) then ! this (top right) is a degree of freedom node + !~ if (umask (i,j) == 1) then ! this (top right) is a degree of freedom node !~ u_boundary_contr (i,j) = u_boundary_contr (i,j) + & !~ .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (1./dyh)) @@ -551,7 +551,7 @@ end subroutine matrix_diagonal_triangle !~ dyh = G%dyh(i,j) !~ dxdyh = G%dxdyh(i,j) - !~ if (hmask (i,j) .eq. 1) then + !~ if (hmask (i,j) == 1) then !~ ux = (u(i,j-1)-u(i-1,j-1)) / dxh !~ vx = (v(i,j-1)-v(i-1,j-1)) / dxh !~ uy = (u(i-1,j)-u(i-1,j-1)) / dyh @@ -605,14 +605,14 @@ end subroutine matrix_diagonal_triangle !~ do i=is,ie !~ do j=js,je - !~ if (hmask(i,j) .eq. 1) then ! this cell's vertices contain degrees of freedom + !~ if (hmask(i,j) == 1) then ! this cell's vertices contain degrees of freedom !~ ux = (u(i,j-1)-u(i-1,j-1))/dxh(i,j) !~ vx = (v(i,j-1)-v(i-1,j-1))/dxh(i,j) !~ uy = (u(i-1,j)-u(i-1,j-1))/dyh(i,j) !~ vy = (v(i-1,j)-v(i-1,j-1))/dyh(i,j) - !~ if (umask(i,j-1) .eq. 1) then ! this (bot right) is a degree of freedom node + !~ if (umask(i,j-1) == 1) then ! this (bot right) is a degree of freedom node !~ uret(i,j-1) = uret(i,j-1) + & !~ .5 * dxdyh(i,j) * nu_lower (i,j) * ((4*ux+2*vy) * (1./dxh(i,j)) + (uy+vy) * (0./dyh(i,j))) @@ -629,7 +629,7 @@ end subroutine matrix_diagonal_triangle !~ v(i-1,j) + v(i,j-1)) !~ endif - !~ if (umask(i-1,j) .eq. 1) then ! this (top left) is a degree of freedom node + !~ if (umask(i-1,j) == 1) then ! this (top left) is a degree of freedom node !~ uret(i-1,j) = uret(i-1,j) + & !~ .5 * dxdyh(i,j) * nu_lower (i,j) * ((4*ux+2*vy) * (0./dxh(i,j)) + (uy+vy) * (1./dyh(i,j))) @@ -646,7 +646,7 @@ end subroutine matrix_diagonal_triangle !~ v(i-1,j) + v(i,j-1)) !~ endif - !~ if (umask(i-1,j-1) .eq. 1) then ! this (bot left) is a degree of freedom node + !~ if (umask(i-1,j-1) == 1) then ! this (bot left) is a degree of freedom node !~ uret(i-1,j-1) = uret(i-1,j-1) + & !~ .5 * dxdyh(i,j) * nu_upper (i,j) * ((4*ux+2*vy) * (-1./dxh(i,j)) + (uy+vy) * (-1./dyh(i,j))) @@ -669,7 +669,7 @@ end subroutine matrix_diagonal_triangle !~ uy = (u(i,j)-u(i,j-1))/dyh(i,j) !~ vy = (v(i,j)-v(i,j-1))/dyh(i,j) - !~ if (umask(i,j-1) .eq. 1) then ! this (bot right) is a degree of freedom node + !~ if (umask(i,j-1) == 1) then ! this (bot right) is a degree of freedom node !~ uret(i,j-1) = uret(i,j-1) + & !~ .5 * dxdyh(i,j) * nu_upper (i,j) * ((4*ux+2*vy) * (0./dxh(i,j)) + (uy+vy) * (-1./dyh(i,j))) @@ -686,7 +686,7 @@ end subroutine matrix_diagonal_triangle !~ u(i-1,j) + u(i,j-1)) !~ endif - !~ if (umask(i-1,j) .eq. 1) then ! this (top left) is a degree of freedom node + !~ if (umask(i-1,j) == 1) then ! this (top left) is a degree of freedom node !~ uret(i-1,j) = uret(i-1,j) + & !~ .5 * dxdyh(i,j) * nu_upper (i,j) * ((4*ux+2*vy) * (-1./dxh(i,j)) + (uy+vy) * (0./dyh(i,j))) @@ -703,7 +703,7 @@ end subroutine matrix_diagonal_triangle !~ u(i-1,j) + u(i,j-1)) !~ endif - !~ if (umask(i,j) .eq. 1) then ! this (top right) is a degree of freedom node + !~ if (umask(i,j) == 1) then ! this (top right) is a degree of freedom node !~ uret(i,j) = uret(i,j) + & !~ .5 * dxdyh(i,j) * nu_upper (i,j) * ((4*ux+2*vy) * (1./dxh(i,j)) + (uy+vy) * (1./dyh(i,j))) diff --git a/src/ice_shelf/user_shelf_init.F90 b/src/ice_shelf/user_shelf_init.F90 index abe44044ea..650d4a9e5f 100644 --- a/src/ice_shelf/user_shelf_init.F90 +++ b/src/ice_shelf/user_shelf_init.F90 @@ -232,7 +232,7 @@ subroutine USER_update_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, C endif ; endif ; endif - if ((i+G%idg_offset) .eq. G%domain%nihalo+1) then + if ((i+G%idg_offset) == G%domain%nihalo+1) then hmask(i-1,j) = 3.0 endif diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 7aff08540a..0275bfc205 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -241,7 +241,7 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) call log_param(PF, mdl, "!MAXIMUM_DEPTH", max_depth, & "The (diagnosed) maximum depth of the ocean.", units="m") endif - if (trim(config) .ne. "DOME") then + if (trim(config) /= "DOME") then call limit_topography(D, G, PF, max_depth) endif diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index 7225217b99..d8c30b345c 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -262,7 +262,7 @@ function tracer_z_init(tr_in,z_edges,e,nkml,nkbl,land_fill,wet,nlay,nlevs,debug, do j=1,ny i_loop: do i=1,nx - if (nlevs_data(i,j) .eq. 0 .or. wet(i,j) .eq. 0.) then + if (nlevs_data(i,j) == 0 .or. wet(i,j) == 0.) then tr(i,j,:) = land_fill cycle i_loop endif @@ -297,7 +297,7 @@ function tracer_z_init(tr_in,z_edges,e,nkml,nkbl,land_fill,wet,nlay,nlevs,debug, if (debug_) then if (PRESENT(i_debug)) then - if (i.eq.i_debug.and.j.eq.j_debug) then + if (i == i_debug.and.j == j_debug) then print *,'0001 k,k_top,k_bot,sum(wt),sum(z2-z1) = ',k,k_top,k_bot,sum(wt),sum(z2-z1) endif endif @@ -321,7 +321,7 @@ function tracer_z_init(tr_in,z_edges,e,nkml,nkbl,land_fill,wet,nlay,nlevs,debug, ! endif if (debug_) then if (PRESENT(i_debug)) then - if (i.eq.i_debug.and.j.eq.j_debug) then + if (i == i_debug.and.j == j_debug) then print *,'0002 k,k_top,k_bot,k_bot_prev,sl_tr = ',k,k_top,k_bot,k_bot_prev,sl_tr endif endif @@ -333,7 +333,7 @@ function tracer_z_init(tr_in,z_edges,e,nkml,nkbl,land_fill,wet,nlay,nlevs,debug, if (debug_) then if (PRESENT(i_debug)) then - if (i.eq.i_debug.and.j.eq.j_debug) then + if (i == i_debug.and.j == j_debug) then print *,'0003 k,tr = ',k,tr(i,j,k) endif endif @@ -357,7 +357,7 @@ function tracer_z_init(tr_in,z_edges,e,nkml,nkbl,land_fill,wet,nlay,nlevs,debug, if (debug_) then if (PRESENT(i_debug)) then - if (i.eq.i_debug.and.j.eq.j_debug) then + if (i == i_debug.and.j == j_debug) then print *,'0004 k,kz,nlevs,sl_tr,tr = ',k,kz,nlevs_data(i,j),sl_tr,tr(i,j,k) print *,'0005 k,kz,tr(kz),tr(kz-1),tr(kz+1) = ',k,kz,tr_1d(kz),tr_1d(kz-1),tr_1d(kz+1),z_edges(kz+2) endif @@ -792,7 +792,7 @@ function find_interfaces(rho,zin,Rb,depth,nlevs,nkml,nkbl,hml,debug) result(zi) if (dir == 1) then do k=2,nlevs_data(i,j)-1 if (rho_(i,k) - rho_(i,k-1) < 0.0 ) then - if (k.eq.2) then + if (k == 2) then rho_(i,k-1)=rho_(i,k)-epsln else drhodz = (rho_(i,k+1)-rho_(i,k-1))/(zin(k+1)-zin(k-1)) @@ -807,7 +807,7 @@ function find_interfaces(rho,zin,Rb,depth,nlevs,nkml,nkbl,hml,debug) result(zi) else do k=nlevs_data(i,j)-1,2,-1 if (rho_(i,k+1) - rho_(i,k) < 0.0) then - if (k .eq. nlevs_data(i,j)-1) then + if (k == nlevs_data(i,j)-1) then rho_(i,k+1)=rho_(i,k-1)+epsln else drhodz = (rho_(i,k+1)-rho_(i,k-1))/(zin(k+1)-zin(k-1)) @@ -922,7 +922,7 @@ subroutine smooth_heights(zi,fill,bad,sor,niter,cyclic_x, tripolar_n) do j=1,nj do i=1,ni - if (fill(i,j) .eq. 1) then + if (fill(i,j) == 1) then B(i,j,1)=1-nm(i+1,j);B(i,j,2)=1-nm(i-1,j) B(i,j,3)=1-nm(i,j+1);B(i,j,4)=1-nm(i,j-1) endif @@ -932,7 +932,7 @@ subroutine smooth_heights(zi,fill,bad,sor,niter,cyclic_x, tripolar_n) do n=1,niter do j=1,nj do i=1,ni - if (fill(i,j) .eq. 1) then + if (fill(i,j) == 1) then bsum = real(B(i,j,1)+B(i,j,2)+B(i,j,3)+B(i,j,4)) Isum = 1.0/bsum res(i,j)=Isum*(B(i,j,1)*mp(i+1,j)+B(i,j,2)*mp(i-1,j)+& diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 37c46407af..2672308fd7 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -310,7 +310,7 @@ subroutine init_oda(Time, G, GV, CS) T_grid%mask(i,j,k) = 1.0 end if end do; end do - if (k .eq. 1) then + if (k == 1) then T_grid%z(:,:,k) = global2D/2 else T_grid%z(:,:,k) = T_grid%z(:,:,k-1) + (global2D + global2D_old)/2 @@ -525,9 +525,9 @@ subroutine set_analysis_time(Time,CS) CS%Time=increment_time(CS%Time,CS%assim_frequency*3600) call get_date(Time, yr, mon, day, hr, min, sec) - if (pe() .eq. mpp_root_pe()) print *, 'Model Time: ', yr, mon, day, hr, min, sec + if (pe() == mpp_root_pe()) print *, 'Model Time: ', yr, mon, day, hr, min, sec call get_date(CS%time, yr, mon, day, hr, min, sec) - if (pe() .eq. mpp_root_pe()) print *, 'Assimilation Time: ', yr, mon, day, hr, min, sec + if (pe() == mpp_root_pe()) print *, 'Assimilation Time: ', yr, mon, day, hr, min, sec endif if (CS%Time < Time) then call MOM_error(FATAL, " set_analysis_time: " // & diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index c133df5d4e..7fcb842bee 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -440,8 +440,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & Ub(i,j,fr,m) = CS%wave_structure_CSp%Uavg_profile(i,j,nzm) Umax(i,j,fr,m) = maxval(CS%wave_structure_CSp%Uavg_profile(i,j,1:nzm)) !! for debugging print profile, etc. Delete later - !if (id_g .eq. 260 .and. & - ! jd_g .eq. 50 .and. & + !if (id_g == 260 .and. & + ! jd_g == 50 .and. & ! tot_En_mode(i,j,1,1)>500.0) then ! print *, 'Profiles for mode ',m,' and frequency ',fr ! print *, 'id_g=', id_g, 'jd_g=', jd_g @@ -661,7 +661,7 @@ subroutine sum_En(G, CS, En, label) En_sum = En_sum + tmpForSumming enddo En_sum_diff = En_sum - CS%En_sum - if (CS%En_sum .ne. 0.0) then + if (CS%En_sum /= 0.0) then En_sum_pdiff= (En_sum_diff/CS%En_sum)*100.0 else En_sum_pdiff= 0.0; @@ -1790,7 +1790,7 @@ subroutine reflect(En, NAngle, CS, G, LB) id_g = i + G%idg_offset ! redistribute energy in angular space if ray will hit boundary ! i.e., if energy is in a reflecting cell - if (angle_c(i,j) .ne. CS%nullangle) then + if (angle_c(i,j) /= CS%nullangle) then do a=1,NAngle if (En(i,j,a) > 0.0) then ! if ray is incident, keep specified boundary angle @@ -1818,7 +1818,7 @@ subroutine reflect(En, NAngle, CS, G, LB) endif a_r = nint(angle_r/Angle_size) + 1 do while (a_r > Nangle) ; a_r = a_r - Nangle ; enddo - if (a .ne. a_r) then + if (a /= a_r) then En_reflected(a_r) = part_refl(i,j)*En(i,j,a) En(i,j,a) = (1.0-part_refl(i,j))*En(i,j,a) endif @@ -2536,7 +2536,7 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS) do j=jsd,jed do i=isd,ied ! flag cells with partial reflection - if (CS%refl_angle(i,j) .ne. CS%nullangle .and. & + if (CS%refl_angle(i,j) /= CS%nullangle .and. & CS%refl_pref(i,j) < 1.0 .and. CS%refl_pref(i,j) > 0.0) then CS%refl_pref_logical(i,j) = .true. endif diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 61555090ab..532362f082 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -934,10 +934,10 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) "used which introduced potential restart issues. This flag will be \n"//& "deprecated in a future release.", default=.false.) if (CS%interpolate_Res_fn) then - if (CS%Res_coef_visc .ne. CS%Res_coef_khth) call MOM_error(FATAL, & + if (CS%Res_coef_visc /= CS%Res_coef_khth) call MOM_error(FATAL, & "MOM_lateral_mixing_coeffs.F90, VarMix_init:"//& "When INTERPOLATE_RES_FN=True, VISC_RES_FN_POWER must equal KH_RES_SCALE_COEF.") - if (CS%Res_fn_power_visc .ne. CS%Res_fn_power_khth) call MOM_error(FATAL, & + if (CS%Res_fn_power_visc /= CS%Res_fn_power_khth) call MOM_error(FATAL, & "MOM_lateral_mixing_coeffs.F90, VarMix_init:"//& "When INTERPOLATE_RES_FN=True, VISC_RES_FN_POWER must equal KH_RES_FN_POWER.") endif diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index f309fff485..08ed2fb130 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -303,7 +303,7 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive, Waves) '\t MatchBoth = match gradient for both diffusivity and NLT\n'// & '\t ParabolicNonLocal = sigma*(1-sigma)^2 for diffusivity; (1-sigma)^2 for NLT', & default='SimpleShapes') - if (CS%MatchTechnique.eq.'ParabolicNonLocal') then + if (CS%MatchTechnique == 'ParabolicNonLocal') then ! This forces Cs2 (Cs in non-local computation) to equal 1 for parabolic non-local option. ! May be used during CVMix initialization. Cs_is_one=.true. @@ -960,16 +960,16 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & ! LMD94 shape function, not matching is equivalent to matching to a zero diffusivity. !BGR/ Add option for use of surface buoyancy flux with total sw flux. - if (CS%SW_METHOD .eq. SW_METHOD_ALL_SW) then + if (CS%SW_METHOD == SW_METHOD_ALL_SW) then surfBuoyFlux = buoyFlux(i,j,1) - elseif (CS%SW_METHOD .eq. SW_METHOD_MXL_SW) then + elseif (CS%SW_METHOD == SW_METHOD_MXL_SW) then surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,int(kOBL)+1) ! We know the actual buoyancy flux into the OBL - elseif (CS%SW_METHOD .eq. SW_METHOD_LV1_SW) then + elseif (CS%SW_METHOD == SW_METHOD_LV1_SW) then surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,2) endif ! If option "MatchBoth" is selected in CVMix, MOM should be capable of matching. - if (.not. (CS%MatchTechnique.eq.'MatchBoth')) then + if (.not. (CS%MatchTechnique == 'MatchBoth')) then Kdiffusivity(:,:) = 0. ! Diffusivities for heat and salt (m2/s) Kviscosity(:) = 0. ! Viscosity (m2/s) else diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 3fd52e456d..4a14bc41ba 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -609,12 +609,12 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) "The number of bands of penetrating shortwave radiation.", & default=1) if (CS%Opacity_scheme == DOUBLE_EXP ) then - if (optics%nbands.ne.2) then + if (optics%nbands /= 2) then call MOM_error(FATAL, "set_opacity: "// & "Cannot use a double_exp opacity scheme with nbands!=2.") endif elseif (CS%Opacity_scheme == SINGLE_EXP ) then - if (optics%nbands.ne.1) then + if (optics%nbands /= 1) then call MOM_error(FATAL, "set_opacity: "// & "Cannot use a single_exp opacity scheme with nbands!=1.") endif diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 9ecf1374ef..b786f9c919 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -267,14 +267,14 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, end select ! Check profile consistency - if (CS%use_CVMix_tidal .and. (CS%int_tide_profile.eq.STLAURENT_02 .or. & - CS%int_tide_profile.eq.POLZIN_09)) then + if (CS%use_CVMix_tidal .and. (CS%int_tide_profile == STLAURENT_02 .or. & + CS%int_tide_profile == POLZIN_09)) then call MOM_error(FATAL, "tidal_mixing_init: Tidal mixing profile"// & " "//trim(int_tide_profile_str)//" unavailable in CVMix. Available "//& "profiles in CVMix are "//trim(SIMMONS_PROFILE_STRING)//" and "//& trim(SCHMITTNER_PROFILE_STRING)//".") - else if (.not.CS%use_CVMix_tidal .and. (CS%int_tide_profile.eq.SIMMONS_04.or. & - CS%int_tide_profile.eq.SCHMITTNER)) then + else if (.not.CS%use_CVMix_tidal .and. (CS%int_tide_profile == SIMMONS_04.or. & + CS%int_tide_profile == SCHMITTNER)) then call MOM_error(FATAL, "tidal_mixing_init: Tidal mixing profiles "// & trim(SIMMONS_PROFILE_STRING)//" and "//trim(SCHMITTNER_PROFILE_STRING)//& " are available only when USE_CVMix_TIDAL is True.") diff --git a/src/tracer/MOM_OCMIP2_CO2calc.F90 b/src/tracer/MOM_OCMIP2_CO2calc.F90 index b5187d5d1d..8c2809418d 100644 --- a/src/tracer/MOM_OCMIP2_CO2calc.F90 +++ b/src/tracer/MOM_OCMIP2_CO2calc.F90 @@ -336,7 +336,7 @@ subroutine MOM_ocmip2_co2calc(dope_vec, mask, & ! recommended (xacc of 10**-9 drops precision to 2 significant ! figures). ! - if (mask(i,j) .ne. 0.0) then !{ + if (mask(i,j) /= 0.0) then !{ htotal(i,j) = drtsafe(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, & ks, kf, bt, dic_in(i,j), ft, pt_in(i,j),& sit_in(i,j), st, ta_in(i,j), & @@ -433,7 +433,7 @@ function drtsafe(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf, & dxold=dx dx=0.5*(xh-xl) drtsafe=xl+dx - if (xl .eq. drtsafe) then + if (xl == drtsafe) then ! write (6,*) 'Exiting drtsafe at A on iteration ', j, ', ph = ', -log10(drtsafe) return endif @@ -442,7 +442,7 @@ function drtsafe(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf, & dx=f/df temp=drtsafe drtsafe=drtsafe-dx - if (temp .eq. drtsafe) then + if (temp == drtsafe) then ! write (6,*) 'Exiting drtsafe at B on iteration ', j, ', ph = ', -log10(drtsafe) return endif diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 1e9f5577c3..6ec168b499 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -266,7 +266,7 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, h, param_file, dia g_tracer=>CS%g_tracer_list do - if (INDEX(CS%IC_file, '_NULL_') .ne. 0) then + if (INDEX(CS%IC_file, '_NULL_') /= 0) then call MOM_error(WARNING,"The name of the IC_file "//trim(CS%IC_file)//& " indicates no MOM initialization was asked for the generic tracers."//& "Bypassing the MOM initialization of ALL generic tracers!") @@ -293,7 +293,7 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, h, param_file, dia !Check/apply the bounds for each g_tracer do k=1,nk ; do j=jsc,jec ; do i=isc,iec - if (tr_ptr(i,j,k) .ne. CS%tracer_land_val) then + if (tr_ptr(i,j,k) /= CS%tracer_land_val) then if (tr_ptr(i,j,k) < g_tracer%src_var_valid_min) tr_ptr(i,j,k) = g_tracer%src_var_valid_min !Jasmin does not want to apply the maximum for now !if (tr_ptr(i,j,k) > g_tracer%src_var_valid_max) tr_ptr(i,j,k) = g_tracer%src_var_valid_max @@ -301,9 +301,9 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, h, param_file, dia enddo; enddo ; enddo !jgj: Reset CASED to 0 below K=1 - if (trim(g_tracer_name) .eq. 'cased') then + if (trim(g_tracer_name) == 'cased') then do k=2,nk ; do j=jsc,jec ; do i=isc,iec - if (tr_ptr(i,j,k) .ne. CS%tracer_land_val) then + if (tr_ptr(i,j,k) /= CS%tracer_land_val) then tr_ptr(i,j,k) = 0.0 endif enddo; enddo ; enddo @@ -404,7 +404,7 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, h, param_file, dia if (associated(CS%g_diag_list)) then g_diag=>CS%g_diag_list do - if (g_diag%Z_diag .ne. 0) & + if (g_diag%Z_diag /= 0) & call register_Z_tracer(g_diag%field_ptr, trim(g_diag%name),g_diag%longname , g_diag%units, & day, G, diag_to_Z_CSp) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 9e68b543de..f5ce1f10e6 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -1448,7 +1448,7 @@ subroutine neutral_surface_T_eval(nk, ns, k_sub, Ks, Ps, T_mean, T_int, deg, iMe ks_top = k_sub ks_bot = k_sub + 1 - if ( Ks(ks_top) .ne. Ks(ks_bot) ) then + if ( Ks(ks_top) /= Ks(ks_bot) ) then call MOM_error(FATAL, "Neutral surfaces span more than one layer") endif kl = Ks(k_sub) @@ -2231,7 +2231,7 @@ logical function test_rnp(expected_pos, test_pos, title) if (test_rnp) then write(stdunit,'(A, f20.16, " .neq. ", f20.16, " <-- WRONG")') title, expected_pos, test_pos else - write(stdunit,'(A, f20.16, " .eq. ", f20.16)') title, expected_pos, test_pos + write(stdunit,'(A, f20.16, " == ", f20.16)') title, expected_pos, test_pos endif end function test_rnp !> Deallocates neutral_diffusion control structure diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index efb0b6ceed..1389365139 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -566,7 +566,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & segment%tr_Reg%Tr(m)%tres(I,j,k)= (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + & dt*(u_L_in*Tr(m)%t(I+ishift,j,k) - & u_L_out*segment%tr_Reg%Tr(m)%t(I,j,k))) -! if (j.eq.10 .and. segment%direction==OBC_DIRECTION_E .and. m==2 .and. k.eq.1) & +! if (j == 10 .and. segment%direction==OBC_DIRECTION_E .and. m==2 .and. k == 1) & ! print *,'tres=',segment%tr_Reg%Tr(m)%tres(I,j,k),& ! segment%tr_Reg%Tr(m)%t(I,j,k), fac1 endif diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 4186c2d34d..0e9a18ffad 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -309,7 +309,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, end select ! Modify salinity and temperature when z coordinates are used - if ( coordinateMode(verticalCoordinate) .eq. REGRIDDING_ZSTAR ) then + if ( coordinateMode(verticalCoordinate) == REGRIDDING_ZSTAR ) then index_bay_z = Nint ( dome2d_depth_bay * G%ke ) do j = G%jsc,G%jec ; do i = G%isc,G%iec x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon @@ -321,7 +321,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, endif ! Z initial conditions ! Modify salinity and temperature when sigma coordinates are used - if ( coordinateMode(verticalCoordinate) .eq. REGRIDDING_SIGMA ) then + if ( coordinateMode(verticalCoordinate) == REGRIDDING_SIGMA ) then do i = G%isc,G%iec ; do j = G%jsc,G%jec x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then @@ -333,8 +333,8 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, ! Modify temperature when rho coordinates are used T(G%isc:G%iec,G%jsc:G%jec,1:G%ke) = 0.0 - if (( coordinateMode(verticalCoordinate) .eq. REGRIDDING_RHO ) .or. & - ( coordinateMode(verticalCoordinate) .eq. REGRIDDING_LAYER )) then + if (( coordinateMode(verticalCoordinate) == REGRIDDING_RHO ) .or. & + ( coordinateMode(verticalCoordinate) == REGRIDDING_LAYER )) then do i = G%isc,G%iec ; do j = G%jsc,G%jec x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 3e6baf1f23..7d6d5644a9 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -279,7 +279,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg) Def_Rad = sqrt(D_edge*g_prime_tot) / (1.0e-4*1000.0) tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*Def_Rad) * GV%m_to_H - if (OBC%number_of_segments .ne. 1) then + if (OBC%number_of_segments /= 1) then print *, 'Error in DOME OBC segment setup' return !!! Need a better error message here endif diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 5cc38f8f24..c183b5b7a3 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -688,7 +688,7 @@ subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) varread1 = 'wavenumber' !Old method gives wavenumber varread2 = 'frequency' !New method gives frequency rcode_wn = NF90_OPEN(trim(SurfBandFileName), NF90_NOWRITE, ncid) - if (rcode_wn .ne. 0) then + if (rcode_wn /= 0) then call MOM_error(FATAL,"error opening file "//trim(SurfBandFileName)//& " in MOM_wave_interface.") endif @@ -696,49 +696,49 @@ subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) rcode_wn = NF90_INQ_VARID(ncid, varread1, varid_wn) rcode_fr = NF90_INQ_VARID(ncid, varread2, varid_fr) - if (rcode_wn .ne. 0 .and. rcode_fr .ne. 0) then + if (rcode_wn /= 0 .and. rcode_fr /= 0) then call MOM_error(FATAL,"error finding variable "//trim(varread1)//& " or "//trim(varread2)//" in file "//trim(SurfBandFileName)//" in MOM_wave_interface.") - elseif (rcode_wn.eq.0) then + elseif (rcode_wn == 0) then ! wavenumbers found: PartitionMode=0 rcode_wn = NF90_INQUIRE_VARIABLE(ncid, varid_wn, ndims=ndims, & dimids=dims) - if (rcode_wn .ne. 0) then + if (rcode_wn /= 0) then call MOM_error(FATAL, & 'error inquiring dimensions MOM_wave_interface.') endif rcode_wn = NF90_INQUIRE_DIMENSION(ncid, dims(1), dim_name(1), len=id) - if (rcode_wn .ne. 0) then + if (rcode_wn /= 0) then call MOM_error(FATAL,"error reading dimension 1 data for "// & trim(varread1)//" in file "// trim(SurfBandFileName)// & " in MOM_wave_interface.") endif rcode_wn = NF90_INQ_VARID(ncid, dim_name(1), dim_id(1)) - if (rcode_wn .ne. 0) then + if (rcode_wn /= 0) then call MOM_error(FATAL,"error finding variable "//trim(dim_name(1))//& " in file "//trim(SurfBandFileName)//" in MOM_wave_interace.") endif ! Allocating size of wavenumber bins allocate( CS%WaveNum_Cen(1:id) ) ; CS%WaveNum_Cen(:)=0.0 - elseif (rcode_fr.eq.0) then + elseif (rcode_fr == 0) then ! frequencies found: PartitionMode=1 rcode_fr = NF90_INQUIRE_VARIABLE(ncid, varid_fr, ndims=ndims, & dimids=dims) - if (rcode_fr .ne. 0) then + if (rcode_fr /= 0) then call MOM_error(FATAL,& 'error inquiring dimensions MOM_wave_interface.') endif rcode_fr = NF90_INQUIRE_DIMENSION(ncid, dims(1), dim_name(1), len=id) - if (rcode_fr .ne. 0) then + if (rcode_fr /= 0) then call MOM_error(FATAL,"error reading dimension 1 data for "// & trim(varread2)//" in file "// trim(SurfBandFileName)// & " in MOM_wave_interface.") endif rcode_fr = NF90_INQ_VARID(ncid, dim_name(1), dim_id(1)) - if (rcode_fr .ne. 0) then + if (rcode_fr /= 0) then call MOM_error(FATAL,"error finding variable "//trim(dim_name(1))//& " in file "//trim(SurfBandFileName)//" in MOM_wave_interace.") endif @@ -758,7 +758,7 @@ subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) start = 1; count = 1; count(1) = id if (PartitionMode==0) then rcode_wn = NF90_GET_VAR(ncid, dim_id(1), CS%WaveNum_Cen, start, count) - if (rcode_wn .ne. 0) then + if (rcode_wn /= 0) then call MOM_error(FATAL,& "error reading dimension 1 values for var_name "// & trim(varread1)//",dim_name "//trim(dim_name(1))// & @@ -767,7 +767,7 @@ subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) NUMBANDS = ID elseif (PartitionMode==1) then rcode_fr = NF90_GET_VAR(ncid, dim_id(1), CS%Freq_Cen, start, count) - if (rcode_fr .ne. 0) then + if (rcode_fr /= 0) then call MOM_error(FATAL,& "error reading dimension 1 values for var_name "// & trim(varread2)//",dim_name "//trim(dim_name(1))// & @@ -1142,7 +1142,7 @@ subroutine StokesMixing(G, GV, DT, h, u, v, WAVES ) do k = 1, G%ke do j = G%jscB, G%jecB do i = G%iscB, G%iecB - if (k.eq.1) then + if (k == 1) then dTauUp = 0. dTauDn = 0.5*(WAVES%Kvs(i,j,k+1)+WAVES%Kvs(i+1,j,k+1))*& (waves%us_x(i,j,k)-waves%us_x(i,j,k+1))& @@ -1154,7 +1154,7 @@ subroutine StokesMixing(G, GV, DT, h, u, v, WAVES ) dTauDn = 0.5*(waves%Kvs(i,j,k+1)+waves%Kvs(i+1,j,k+1))*& (waves%us_x(i,j,k)-waves%us_x(i,j,k+1))& /(GV%H_to_m *0.5*(h(i,j,k)+h(i,j,k+1)) ) - elseif (k.eq.G%ke) then + elseif (k == G%ke) then dTauUp = 0.5*(waves%Kvs(i,j,k)+waves%Kvs(i+1,j,k))*& (waves%us_x(i,j,k-1)-waves%us_x(i,j,k))& /(GV%H_to_m *0.5*(h(i,j,k-1)+h(i,j,k)) ) @@ -1169,7 +1169,7 @@ subroutine StokesMixing(G, GV, DT, h, u, v, WAVES ) do k = 1, G%ke do j = G%jscB, G%jecB do i = G%iscB, G%iecB - if (k.eq.1) then + if (k == 1) then dTauUp = 0. dTauDn = 0.5*(waves%Kvs(i,j,k+1)+waves%Kvs(i,j+1,k+1))& *(waves%us_y(i,j,k)-waves%us_y(i,j,k+1))& @@ -1181,7 +1181,7 @@ subroutine StokesMixing(G, GV, DT, h, u, v, WAVES ) dTauDn = 0.5*(waves%Kvs(i,j,k+1)+waves%Kvs(i,j+1,k+1))*& (waves%us_y(i,j,k)-waves%us_y(i,j,k+1))& /(GV%H_to_m *0.5*(h(i,j,k)+h(i,j,k+1)) ) - elseif (k.eq.G%ke) then + elseif (k == G%ke) then dTauUp = 0.5*(waves%Kvs(i,j,k)+waves%Kvs(i,j+1,k))*& (waves%us_y(i,j,k-1)-waves%us_y(i,j,k))& /(GV%H_to_m *0.5*(h(i,j,k-1)+h(i,j,k)) ) diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index 68975fc41f..c73c8a12e4 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -110,7 +110,7 @@ subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_par select case ( coordinateMode(verticalCoordinate) ) case ( REGRIDDING_LAYER, REGRIDDING_RHO ) - if (delta_S_strat.ne.0.) then + if (delta_S_strat /= 0.) then adjustment_delta = adjustment_deltaS / delta_S_strat * G%max_depth do k=1,nz+1 e0(k) = adjustment_delta-(G%max_depth+2*adjustment_delta) * (real(k-1) / real(nz)) @@ -128,7 +128,7 @@ subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_par end do target_values = target_values - 1000. do j=js,je ; do i=is,ie - if (front_wave_length.ne.0.) then + if (front_wave_length /= 0.) then y = ( 0.125 + G%geoLatT(i,j) / front_wave_length ) * ( 4. * acos(0.) ) yy = 2. * ( G%geoLatT(i,j) - 0.5 * G%len_lat ) / adjustment_width yy = min(1.0, yy); yy = max(-1.0, yy) @@ -142,7 +142,7 @@ subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_par x = x * acos( 0. ) delta_S = adjustment_deltaS * 0.5 * (1. - sin( x ) ) do k=2,nz - if (dSdz.ne.0.) then + if (dSdz /= 0.) then eta1D(k) = ( target_values(k) - ( S_ref + delta_S ) ) / dSdz else eta1D(k) = e0(k) - (0.5*adjustment_delta) * sin( x ) @@ -258,7 +258,7 @@ subroutine adjustment_initialize_temperature_salinity ( T, S, h, G, GV, param_fi do k=nz,1,-1 eta1d(k) = eta1d(k+1) + h(i,j,k)*GV%H_to_m enddo - if (front_wave_length.ne.0.) then + if (front_wave_length /= 0.) then y = ( 0.125 + G%geoLatT(i,j) / front_wave_length ) * ( 4. * acos(0.) ) yy = 2. * ( G%geoLatT(i,j) - 0.5 * G%len_lat ) / front_wave_length yy = min(1.0, yy); yy = max(-1.0, yy) diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 88b80e84c6..e2bc9b5869 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -344,7 +344,7 @@ subroutine dumbbell_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp S(i,j,k)=S_ref - 0.5*S_range enddo endif -! if (j.eq.G%jsc) print *,'i,Sponge S= ',i,S(i,1,1) +! if (j == G%jsc) print *,'i,Sponge S= ',i,S(i,1,1) enddo enddo diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index be64ef163e..06b1df3218 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -138,11 +138,11 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param x = G%geoLonT(i,j) / G%len_lon displ(k) = a0 * cos(acos(-1.0)*x) + weight_z; - if ( k .EQ. 1 ) then + if ( k == 1 ) then displ(k) = 0.0 end if - if ( k .EQ. nz+1 ) then + if ( k == nz+1 ) then displ(k) = 0.0 end if From e16fb148c65b59a749123c6c6cbb785478b766d2 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Sat, 5 May 2018 14:35:24 -0400 Subject: [PATCH 0190/1072] Cleaned up white space --- src/tracer/MOM_generic_tracer.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 30dde28696..59eb49107d 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -311,7 +311,7 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, h, param_file, dia elseif(.not. g_tracer%requires_restart) then !Do nothing for this tracer, it is initialized by the tracer package call MOM_error(NOTE,"initialize_MOM_generic_tracer: "//& - "skip initialization of generic tracer "//trim(g_tracer_name)) + "skip initialization of generic tracer "//trim(g_tracer_name)) else !Do it old way if the tracer is not registered to start from a specific source file. !This path should be deprecated if all generic tracers are required to start from specified sources. if (len_trim(CS%IC_file) > 0) then From 5e33043c10b799973c9700fa23a3839a8067167f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 6 May 2018 09:30:35 -0400 Subject: [PATCH 0191/1072] Added dOxyGen comments in ALE regridding code Added dOxyGen comments for all of the subroutines and their arguments in the PXM_functions and regrid_... modules in src/ALE. Also shortened the name of several variables. All answers are bitwise identical. --- src/ALE/P1M_functions.F90 | 38 +++---- src/ALE/P3M_functions.F90 | 149 +++++++++++++----------- src/ALE/PCM_functions.F90 | 21 ++-- src/ALE/PLM_functions.F90 | 70 ++++++------ src/ALE/PPM_functions.F90 | 57 +++++----- src/ALE/PQM_functions.F90 | 146 ++++++++++++------------ src/ALE/polynomial_functions.F90 | 87 +++++++------- src/ALE/regrid_edge_slopes.F90 | 32 +++--- src/ALE/regrid_edge_values.F90 | 190 ++++++++++++++----------------- src/ALE/regrid_interp.F90 | 24 ++-- src/ALE/regrid_solvers.F90 | 27 ++--- 11 files changed, 420 insertions(+), 421 deletions(-) diff --git a/src/ALE/P1M_functions.F90 b/src/ALE/P1M_functions.F90 index aafaec2580..8590a7297f 100644 --- a/src/ALE/P1M_functions.F90 +++ b/src/ALE/P1M_functions.F90 @@ -39,9 +39,8 @@ module P1M_functions !------------------------------------------------------------------------------ -! p1m interpolation -!------------------------------------------------------------------------------ -subroutine P1M_interpolation( N, h, u, ppoly_E, ppoly_coefficients, h_neglect ) +!> Linearly interpolate between edge values +subroutine P1M_interpolation( N, h, u, ppoly_E, ppoly_coef, h_neglect ) ! ------------------------------------------------------------------------------ ! Linearly interpolate between edge values. ! The resulting piecewise interpolant is stored in 'ppoly'. @@ -62,7 +61,7 @@ subroutine P1M_interpolation( N, h, u, ppoly_E, ppoly_coefficients, h_neglect ) real, dimension(:), intent(in) :: u !< cell average properties (size N) real, dimension(:,:), intent(inout) :: ppoly_E !< Potentially modified edge values, !! with the same units as u. - real, dimension(:,:), intent(inout) :: ppoly_coefficients !< Potentially modified + real, dimension(:,:), intent(inout) :: ppoly_coef !< Potentially modified !! piecewise polynomial coefficients, mainly !! with the same units as u. real, optional, intent(in) :: h_neglect !< A negligibly small width @@ -85,8 +84,8 @@ subroutine P1M_interpolation( N, h, u, ppoly_E, ppoly_coefficients, h_neglect ) u0_l = ppoly_E(k,1) u0_r = ppoly_E(k,2) - ppoly_coefficients(k,1) = u0_l - ppoly_coefficients(k,2) = u0_r - u0_l + ppoly_coef(k,1) = u0_l + ppoly_coef(k,2) = u0_r - u0_l end do ! end loop on interior cells @@ -94,9 +93,8 @@ end subroutine P1M_interpolation !------------------------------------------------------------------------------ -! p1m boundary extrapolation -! ----------------------------------------------------------------------------- -subroutine P1M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients ) +!> Interpolation by linear polynomials within boundary cells +subroutine P1M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef ) !------------------------------------------------------------------------------ ! Interpolation by linear polynomials within boundary cells. ! The left and right edge values in the left and right boundary cells, @@ -106,18 +104,20 @@ subroutine P1M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients ) ! h: thicknesses of grid cells ! u: cell averages to use in constructing piecewise polynomials ! ppoly_E : edge values of piecewise polynomials -! ppoly_coefficients : coefficients of piecewise polynomials +! ppoly_coef : coefficients of piecewise polynomials ! ! It is assumed that the size of the array 'u' is equal to the number of cells ! defining 'grid' and 'ppoly'. No consistency check is performed here. !------------------------------------------------------------------------------ ! Arguments - integer, intent(in) :: N ! Number of cells - real, dimension(:), intent(in) :: h ! cell widths (size N) - real, dimension(:), intent(in) :: u ! cell averages (size N) - real, dimension(:,:), intent(inout) :: ppoly_E - real, dimension(:,:), intent(inout) :: ppoly_coefficients + integer, intent(in) :: N !< Number of cells + real, dimension(:), intent(in) :: h !< cell widths (size N) + real, dimension(:), intent(in) :: u !< cell averages (size N) + real, dimension(:,:), intent(inout) :: ppoly_E !< edge values of piecewise polynomials, + !! with the same units as u. + real, dimension(:,:), intent(inout) :: ppoly_coef !< coefficients of piecewise polynomials, mainly + !! with the same units as u. ! Local variables real :: u0, u1 ! cell averages @@ -157,8 +157,8 @@ subroutine P1M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients ) ppoly_E(1,1) = u0 end if - ppoly_coefficients(1,1) = ppoly_E(1,1) - ppoly_coefficients(1,2) = ppoly_E(1,2) - ppoly_E(1,1) + ppoly_coef(1,1) = ppoly_E(1,1) + ppoly_coef(1,2) = ppoly_E(1,2) - ppoly_E(1,1) ! ------------------------------------------ ! Right edge value in the left boundary cell @@ -183,8 +183,8 @@ subroutine P1M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients ) ppoly_E(N,2) = u1 end if - ppoly_coefficients(N,1) = ppoly_E(N,1) - ppoly_coefficients(N,2) = ppoly_E(N,2) - ppoly_E(N,1) + ppoly_coef(N,1) = ppoly_E(N,1) + ppoly_coef(N,2) = ppoly_E(N,2) - ppoly_E(N,1) end subroutine P1M_boundary_extrapolation diff --git a/src/ALE/P3M_functions.F90 b/src/ALE/P3M_functions.F90 index a532ca7003..acc3e064ce 100644 --- a/src/ALE/P3M_functions.F90 +++ b/src/ALE/P3M_functions.F90 @@ -28,9 +28,9 @@ module P3M_functions contains !------------------------------------------------------------------------------ -! p3m interpolation -! ----------------------------------------------------------------------------- -subroutine P3M_interpolation( N, h, u, ppoly_E, ppoly_S, ppoly_coefficients, & +!> Set up a piecewise cubic cubic interpolation from cell averages and estimated +!! edge slopes and values +subroutine P3M_interpolation( N, h, u, ppoly_E, ppoly_S, ppoly_coef, & h_neglect ) !------------------------------------------------------------------------------ ! Cubic interpolation between edges. @@ -43,12 +43,15 @@ subroutine P3M_interpolation( N, h, u, ppoly_E, ppoly_S, ppoly_coefficients, & !------------------------------------------------------------------------------ ! Arguments - integer, intent(in) :: N ! Number of cells - real, dimension(:), intent(in) :: h ! cell widths (size N) - real, dimension(:), intent(in) :: u ! cell averages (size N) - real, dimension(:,:), intent(inout) :: ppoly_E !Edge value of polynomial - real, dimension(:,:), intent(inout) :: ppoly_S !Edge slope of polynomial - real, dimension(:,:), intent(inout) :: ppoly_coefficients !Coefficients of polynomial + integer, intent(in) :: N !< Number of cells + real, dimension(:), intent(in) :: h !< cell widths (size N) + real, dimension(:), intent(in) :: u !< cell averages (size N) + real, dimension(:,:), intent(inout) :: ppoly_E !< Edge value of polynomial, + !! with the same units as u. + real, dimension(:,:), intent(inout) :: ppoly_S !< Edge slope of polynomial, + !! in the units of u over the units of h. + real, dimension(:,:), intent(inout) :: ppoly_coef !< Coefficients of polynomial, mainly + !! with the same units as u. real, optional, intent(in) :: h_neglect !< A negligibly small width for the !! purpose of cell reconstructions !! in the same units as h. @@ -59,15 +62,15 @@ subroutine P3M_interpolation( N, h, u, ppoly_E, ppoly_S, ppoly_coefficients, & ! 'P3M_interpolation' first but we do that to provide an homogeneous ! interface. - call P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coefficients, h_neglect ) + call P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect ) end subroutine P3M_interpolation !------------------------------------------------------------------------------ -! p3m limiter -! ----------------------------------------------------------------------------- -subroutine P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coefficients, h_neglect ) +!> Adust a piecewise cubic reconstruction with a limiter that adjusts the edge +!! values and slopes +subroutine P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect ) !------------------------------------------------------------------------------ ! The p3m limiter operates as follows: ! @@ -82,12 +85,14 @@ subroutine P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coefficients, h_neglect !------------------------------------------------------------------------------ ! Arguments - integer, intent(in) :: N ! Number of cells - real, dimension(:), intent(in) :: h ! cell widths (size N) - real, dimension(:), intent(in) :: u ! cell averages (size N) - real, dimension(:,:), intent(inout) :: ppoly_E !Edge value of polynomial - real, dimension(:,:), intent(inout) :: ppoly_S !Edge slope of polynomial - real, dimension(:,:), intent(inout) :: ppoly_coefficients !Coefficients of polynomial + integer, intent(in) :: N !< Number of cells + real, dimension(:), intent(in) :: h !< cell widths (size N) + real, dimension(:), intent(in) :: u !< cell averages (size N) + real, dimension(:,:), intent(inout) :: ppoly_E !< Edge value of polynomial, + !! with the same units as u. + real, dimension(:,:), intent(inout) :: ppoly_S !< Edge slope of polynomial, + !! in the units of u over the units of h. + real, dimension(:,:), intent(inout) :: ppoly_coef !< Coefficients of polynomial real, optional, intent(in) :: h_neglect !< A negligibly small width for !! the purpose of cell reconstructions !! in the same units as h. @@ -182,10 +187,10 @@ subroutine P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coefficients, h_neglect end if ! Build cubic interpolant (compute the coefficients) - call build_cubic_interpolant( h, k, ppoly_E, ppoly_S, ppoly_coefficients ) + call build_cubic_interpolant( h, k, ppoly_E, ppoly_S, ppoly_coef ) ! Check whether cubic is monotonic - monotonic = is_cubic_monotonic( ppoly_coefficients, k ) + monotonic = is_cubic_monotonic( ppoly_coef, k ) ! If cubic is not monotonic, monotonize it by modifiying the ! edge slopes, store the new edge slopes and recompute the @@ -199,7 +204,7 @@ subroutine P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coefficients, h_neglect ppoly_S(k,2) = u1_r ! Recompute coefficients of cubic - call build_cubic_interpolant( h, k, ppoly_E, ppoly_S, ppoly_coefficients ) + call build_cubic_interpolant( h, k, ppoly_E, ppoly_S, ppoly_coef ) end do ! loop on cells @@ -207,9 +212,9 @@ end subroutine P3M_limiter !------------------------------------------------------------------------------ -! p3m boundary extrapolation -! ----------------------------------------------------------------------------- -subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coefficients, & +!> calculate the edge values and slopes at boundary cells as part of building a +!! piecewise peicewise cubic sub-grid scale profiles +subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coef, & h_neglect, h_neglect_edge ) !------------------------------------------------------------------------------ ! The following explanations apply to the left boundary cell. The same @@ -225,12 +230,15 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coeffici !------------------------------------------------------------------------------ ! Arguments - integer, intent(in) :: N ! Number of cells - real, dimension(:), intent(in) :: h ! cell widths (size N) - real, dimension(:), intent(in) :: u ! cell averages (size N) - real, dimension(:,:), intent(inout) :: ppoly_E !Edge value of polynomial - real, dimension(:,:), intent(inout) :: ppoly_S !Edge slope of polynomial - real, dimension(:,:), intent(inout) :: ppoly_coefficients !Coefficients of polynomial + integer, intent(in) :: N !< Number of cells + real, dimension(:), intent(in) :: h !< cell widths (size N) + real, dimension(:), intent(in) :: u !< cell averages (size N) + real, dimension(:,:), intent(inout) :: ppoly_E !< Edge value of polynomial, + !! with the same units as u. + real, dimension(:,:), intent(inout) :: ppoly_S !< Edge slope of polynomial, + !! in the units of u over the units of h. + real, dimension(:,:), intent(inout) :: ppoly_coef !< Coefficients of polynomial, mainly + !! with the same units as u. real, optional, intent(in) :: h_neglect !< A negligibly small width for the !! purpose of cell reconstructions !! in the same units as h. @@ -263,7 +271,7 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coeffici ! Compute the left edge slope in neighboring cell and express it in ! the global coordinate system - b = ppoly_coefficients(i1,2) + b = ppoly_coef(i1,2) u1_r = b / h1 ! derivative evaluated at xi = 0.0, expressed w.r.t. x ! Limit the right slope by the PLM limited slope @@ -298,8 +306,8 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coeffici ppoly_S(i0,2) = u1_r ! Store edge values and slope, build cubic and check monotonicity - call build_cubic_interpolant( h, i0, ppoly_E, ppoly_S, ppoly_coefficients ) - monotonic = is_cubic_monotonic( ppoly_coefficients, i0 ) + call build_cubic_interpolant( h, i0, ppoly_E, ppoly_S, ppoly_coef ) + monotonic = is_cubic_monotonic( ppoly_coef, i0 ) if ( monotonic == 0 ) then call monotonize_cubic( h0, u0_l, u0_r, 0.0, slope, slope, u1_l, u1_r ) @@ -307,7 +315,7 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coeffici ! Rebuild cubic after monotonization ppoly_S(i0,1) = u1_l ppoly_S(i0,2) = u1_r - call build_cubic_interpolant( h, i0, ppoly_E, ppoly_S, ppoly_coefficients ) + call build_cubic_interpolant( h, i0, ppoly_E, ppoly_S, ppoly_coef ) end if @@ -321,9 +329,9 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coeffici ! Compute the right edge slope in neighboring cell and express it in ! the global coordinate system - b = ppoly_coefficients(i0,2) - c = ppoly_coefficients(i0,3) - d = ppoly_coefficients(i0,4) + b = ppoly_coef(i0,2) + c = ppoly_coef(i0,3) + d = ppoly_coef(i0,4) u1_l = (b + 2*c + 3*d) / ( h0 + hNeglect ) ! derivative evaluated at xi = 1.0 ! Limit the left slope by the PLM limited slope @@ -357,8 +365,8 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coeffici ppoly_S(i1,1) = u1_l ppoly_S(i1,2) = u1_r - call build_cubic_interpolant( h, i1, ppoly_E, ppoly_S, ppoly_coefficients ) - monotonic = is_cubic_monotonic( ppoly_coefficients, i1 ) + call build_cubic_interpolant( h, i1, ppoly_E, ppoly_S, ppoly_coef ) + monotonic = is_cubic_monotonic( ppoly_coef, i1 ) if ( monotonic == 0 ) then call monotonize_cubic( h1, u0_l, u0_r, slope, 0.0, slope, u1_l, u1_r ) @@ -366,7 +374,7 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coeffici ! Rebuild cubic after monotonization ppoly_S(i1,1) = u1_l ppoly_S(i1,2) = u1_r - call build_cubic_interpolant( h, i1, ppoly_E, ppoly_S, ppoly_coefficients ) + call build_cubic_interpolant( h, i1, ppoly_E, ppoly_S, ppoly_coef ) end if @@ -374,9 +382,8 @@ end subroutine P3M_boundary_extrapolation !------------------------------------------------------------------------------ -! Build cubic interpolant in cell k -! ----------------------------------------------------------------------------- -subroutine build_cubic_interpolant( h, k, ppoly_E, ppoly_S, ppoly_coefficients ) +!> Build cubic interpolant in cell k +subroutine build_cubic_interpolant( h, k, ppoly_E, ppoly_S, ppoly_coef ) !------------------------------------------------------------------------------ ! Given edge values and edge slopes, compute coefficients of cubic in cell k. ! @@ -385,11 +392,14 @@ subroutine build_cubic_interpolant( h, k, ppoly_E, ppoly_S, ppoly_coefficients ) !------------------------------------------------------------------------------ ! Arguments - real, dimension(:), intent(in) :: h ! cell widths (size N) - integer, intent(in) :: k - real, dimension(:,:), intent(in) :: ppoly_E !Edge value of polynomial - real, dimension(:,:), intent(in) :: ppoly_S !Edge slope of polynomial - real, dimension(:,:), intent(inout) :: ppoly_coefficients !Coefficients of polynomial + real, dimension(:), intent(in) :: h !< cell widths (size N) + integer, intent(in) :: k !< The index of the cell to work on + real, dimension(:,:), intent(in) :: ppoly_E !< Edge value of polynomial, + !! with the same units as u. + real, dimension(:,:), intent(in) :: ppoly_S !< Edge slope of polynomial, + !! in the units of u over the units of h. + real, dimension(:,:), intent(inout) :: ppoly_coef !< Coefficients of polynomial, mainly + !! with the same units as u. ! Local variables real :: u0_l, u0_r ! edge values @@ -410,18 +420,17 @@ subroutine build_cubic_interpolant( h, k, ppoly_E, ppoly_S, ppoly_coefficients ) a2 = 3.0 * ( u0_r - u0_l ) - u1_r - 2.0 * u1_l a3 = u1_r + u1_l + 2.0 * ( u0_l - u0_r ) - ppoly_coefficients(k,1) = a0 - ppoly_coefficients(k,2) = a1 - ppoly_coefficients(k,3) = a2 - ppoly_coefficients(k,4) = a3 + ppoly_coef(k,1) = a0 + ppoly_coef(k,2) = a1 + ppoly_coef(k,3) = a2 + ppoly_coef(k,4) = a3 end subroutine build_cubic_interpolant !------------------------------------------------------------------------------ -! Check whether cubic is monotonic -! ----------------------------------------------------------------------------- -integer function is_cubic_monotonic( ppoly_coefficients, k ) +!> Check whether the cubic reconstruction in cell k is monotonic +integer function is_cubic_monotonic( ppoly_coef, k ) !------------------------------------------------------------------------------ ! This function checks whether the cubic curve in cell k is monotonic. ! If so, returns 1. Otherwise, returns 0. @@ -432,8 +441,8 @@ integer function is_cubic_monotonic( ppoly_coefficients, k ) !------------------------------------------------------------------------------ ! Arguments - real, dimension(:,:), intent(in) :: ppoly_coefficients - integer, intent(in) :: k + real, dimension(:,:), intent(in) :: ppoly_coef !< Coefficients of cubic polynomial + integer, intent(in) :: k !< The index of the cell to work on ! Local variables integer :: monotonic ! boolean indicating if monotonic or not @@ -447,10 +456,10 @@ integer function is_cubic_monotonic( ppoly_coefficients, k ) ! to be equal to 0 or 1, respectively eps = 1e-14 - a0 = ppoly_coefficients(k,1) - a1 = ppoly_coefficients(k,2) - a2 = ppoly_coefficients(k,3) - a3 = ppoly_coefficients(k,4) + a0 = ppoly_coef(k,1) + a1 = ppoly_coef(k,2) + a2 = ppoly_coef(k,3) + a3 = ppoly_coef(k,4) a = a1 b = 2.0 * a2 @@ -490,8 +499,7 @@ end function is_cubic_monotonic !------------------------------------------------------------------------------ -! Monotonize cubic curve -! ----------------------------------------------------------------------------- +!> Monotonize a cubic curve by modifying the edge slopes. subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r ) !------------------------------------------------------------------------------ ! This routine takes care of monotonizing a cubic on [0,1] by modifying the @@ -522,11 +530,14 @@ subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r !------------------------------------------------------------------------------ ! Arguments - real, intent(in) :: h ! cell width - real, intent(in) :: u0_l, u0_r ! edge values - real, intent(in) :: sigma_l, sigma_r ! left and right 2nd-order slopes - real, intent(in) :: slope ! limited PLM slope - real, intent(inout) :: u1_l, u1_r ! edge slopes + real, intent(in) :: h !< cell width + real, intent(in) :: u0_l !< left edge value + real, intent(in) :: u0_r !< right edge value + real, intent(in) :: sigma_l !< left 2nd-order slopes + real, intent(in) :: sigma_r !< right 2nd-order slopes + real, intent(in) :: slope !< limited PLM slope + real, intent(inout) :: u1_l !< left edge slopes + real, intent(inout) :: u1_r !< right edge slopes ! Local variables integer :: found_ip diff --git a/src/ALE/PCM_functions.F90 b/src/ALE/PCM_functions.F90 index b09f6e080e..bcb963faa6 100644 --- a/src/ALE/PCM_functions.F90 +++ b/src/ALE/PCM_functions.F90 @@ -19,9 +19,10 @@ module PCM_functions contains !------------------------------------------------------------------------------ -! pcm_reconstruction -!------------------------------------------------------------------------------ -subroutine PCM_reconstruction( N, u, ppoly_E, ppoly_coefficients ) +!> Reconstruction by constant polynomials within each cell. There is nothing to +!! do but this routine is provided to ensure a homogeneous interface +!! throughout the regridding toolbox. +subroutine PCM_reconstruction( N, u, ppoly_E, ppoly_coef ) !------------------------------------------------------------------------------ ! Reconstruction by constant polynomials within each cell. There is nothing to ! do but this routine is provided to ensure a homogeneous interface @@ -31,24 +32,26 @@ subroutine PCM_reconstruction( N, u, ppoly_E, ppoly_coefficients ) ! h: thicknesses of grid cells ! u: cell averages to use in constructing piecewise polynomials ! ppoly_E : edge values of piecewise polynomials -! ppoly_coefficients : coefficients of piecewise polynomials +! ppoly_coef : coefficients of piecewise polynomials ! ! It is assumed that the dimension of 'u' is equal to the number of cells ! defining 'grid' and 'ppoly'. No consistency check is performed. !------------------------------------------------------------------------------ ! Arguments - integer, intent(in) :: N ! Number of cells - real, dimension(:), intent(in) :: u ! cell averages - real, dimension(:,:), intent(inout) :: ppoly_E !Edge value of polynomial - real, dimension(:,:), intent(inout) :: ppoly_coefficients !Coefficients of polynomial + integer, intent(in) :: N !< Number of cells + real, dimension(:), intent(in) :: u !< cell averages + real, dimension(:,:), intent(inout) :: ppoly_E !< Edge value of polynomial, + !! with the same units as u. + real, dimension(:,:), intent(inout) :: ppoly_coef !< Coefficients of polynomial, + !! with the same units as u. ! Local variables integer :: k ! The coefficients of the piecewise constant polynomial are simply ! the cell averages. - ppoly_coefficients(:,1) = u(:) + ppoly_coef(:,1) = u(:) ! The edge values are equal to the cell average do k = 1,N diff --git a/src/ALE/PLM_functions.F90 b/src/ALE/PLM_functions.F90 index 83eea1518b..73f9206c21 100644 --- a/src/ALE/PLM_functions.F90 +++ b/src/ALE/PLM_functions.F90 @@ -21,9 +21,8 @@ module PLM_functions contains !------------------------------------------------------------------------------ -! PLM_reconstruction -! ----------------------------------------------------------------------------- -subroutine PLM_reconstruction( N, h, u, ppoly_E, ppoly_coefficients, h_neglect ) +!> Reconstruction by linear polynomials within each cell +subroutine PLM_reconstruction( N, h, u, ppoly_E, ppoly_coef, h_neglect ) !------------------------------------------------------------------------------ ! Reconstruction by linear polynomials within each cell. ! @@ -31,21 +30,23 @@ subroutine PLM_reconstruction( N, h, u, ppoly_E, ppoly_coefficients, h_neglect ) ! h: thicknesses of grid cells ! u: cell averages to use in constructing piecewise polynomials ! ppoly_E : edge values of piecewise polynomials -! ppoly_coefficients : coefficients of piecewise polynomials +! ppoly_coef : coefficients of piecewise polynomials ! ! It is assumed that the size of the array 'u' is equal to the number of cells ! defining 'grid' and 'ppoly'. No consistency check is performed here. !------------------------------------------------------------------------------ ! Arguments - integer, intent(in) :: N ! Number of cells - real, dimension(:), intent(in) :: h ! cell widths (size N) - real, dimension(:), intent(in) :: u ! cell averages (size N) - real, dimension(:,:), intent(inout) :: ppoly_E - real, dimension(:,:), intent(inout) :: ppoly_coefficients + integer, intent(in) :: N !< Number of cells + real, dimension(:), intent(in) :: h !< cell widths (size N) + real, dimension(:), intent(in) :: u !< cell averages (size N) + real, dimension(:,:), intent(inout) :: ppoly_E !< edge values of piecewise polynomials, + !! with the same units as u. + real, dimension(:,:), intent(inout) :: ppoly_coef !< coefficients of piecewise polynomials, mainly + !! with the same units as u. real, optional, intent(in) :: h_neglect !< A negligibly small width for - !! the purpose of cell reconstructions - !! in the same units as h + !! the purpose of cell reconstructions + !! in the same units as h ! Local variables integer :: k ! loop index @@ -171,8 +172,8 @@ subroutine PLM_reconstruction( N, h, u, ppoly_E, ppoly_coefficients, h_neglect ) ! Store and return edge values and polynomial coefficients. ppoly_E(1,1) = u(1) ppoly_E(1,2) = u(1) - ppoly_coefficients(1,1) = u(1) - ppoly_coefficients(1,2) = 0. + ppoly_coef(1,1) = u(1) + ppoly_coef(1,2) = 0. do k = 2, N-1 slope = sign( mslp(k), slp(k) ) u_l = u(k) - 0.5 * slope ! Left edge value of cell k @@ -194,28 +195,27 @@ subroutine PLM_reconstruction( N, h, u, ppoly_E, ppoly_coefficients, h_neglect ) ppoly_E(k,1) = u_l ppoly_E(k,2) = u_r - ppoly_coefficients(k,1) = u_l - ppoly_coefficients(k,2) = ( u_r - u_l ) + ppoly_coef(k,1) = u_l + ppoly_coef(k,2) = ( u_r - u_l ) ! Check to see if this evaluation of the polynomial at x=1 would be ! monotonic w.r.t. the next cell's edge value. If not, scale back! - edge = ppoly_coefficients(k,2) + ppoly_coefficients(k,1) + edge = ppoly_coef(k,2) + ppoly_coef(k,1) e_r = u(k+1) - 0.5 * sign( mslp(k+1), slp(k+1) ) if ( (edge-u(k))*(e_r-edge)<0.) then - ppoly_coefficients(k,2) = ppoly_coefficients(k,2) * almost_one + ppoly_coef(k,2) = ppoly_coef(k,2) * almost_one endif enddo ppoly_E(N,1) = u(N) ppoly_E(N,2) = u(N) - ppoly_coefficients(N,1) = u(N) - ppoly_coefficients(N,2) = 0. + ppoly_coef(N,1) = u(N) + ppoly_coef(N,2) = 0. end subroutine PLM_reconstruction !------------------------------------------------------------------------------ -! plm boundary extrapolation -! ----------------------------------------------------------------------------- -subroutine PLM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients, h_neglect ) +!> Reconstruction by linear polynomials within boundary cells +subroutine PLM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef, h_neglect ) !------------------------------------------------------------------------------ ! Reconstruction by linear polynomials within boundary cells. ! The left and right edge values in the left and right boundary cells, @@ -227,21 +227,23 @@ subroutine PLM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients, h_n ! h: thicknesses of grid cells ! u: cell averages to use in constructing piecewise polynomials ! ppoly_E : edge values of piecewise polynomials -! ppoly_coefficients : coefficients of piecewise polynomials +! ppoly_coef : coefficients of piecewise polynomials ! ! It is assumed that the size of the array 'u' is equal to the number of cells ! defining 'grid' and 'ppoly'. No consistency check is performed here. !------------------------------------------------------------------------------ ! Arguments - integer, intent(in) :: N ! Number of cells - real, dimension(:), intent(in) :: h ! cell widths (size N) - real, dimension(:), intent(in) :: u ! cell averages (size N) - real, dimension(:,:), intent(inout) :: ppoly_E - real, dimension(:,:), intent(inout) :: ppoly_coefficients + integer, intent(in) :: N !< Number of cells + real, dimension(:), intent(in) :: h !< cell widths (size N) + real, dimension(:), intent(in) :: u !< cell averages (size N) + real, dimension(:,:), intent(inout) :: ppoly_E !< edge values of piecewise polynomials, + !! with the same units as u. + real, dimension(:,:), intent(inout) :: ppoly_coef !< coefficients of piecewise polynomials, mainly + !! with the same units as u. real, optional, intent(in) :: h_neglect !< A negligibly small width for - !! the purpose of cell reconstructions - !! in the same units as h + !! the purpose of cell reconstructions + !! in the same units as h ! Local variables real :: u0, u1 ! cell averages @@ -270,8 +272,8 @@ subroutine PLM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients, h_n ppoly_E(1,1) = u0 - 0.5 * slope ppoly_E(1,2) = u0 + 0.5 * slope - ppoly_coefficients(1,1) = ppoly_E(1,1) - ppoly_coefficients(1,2) = ppoly_E(1,2) - ppoly_E(1,1) + ppoly_coef(1,1) = ppoly_E(1,1) + ppoly_coef(1,2) = ppoly_E(1,2) - ppoly_E(1,1) ! ------------------------------------------ ! Right edge value in the left boundary cell @@ -292,8 +294,8 @@ subroutine PLM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients, h_n ppoly_E(N,1) = u1 - 0.5 * slope ppoly_E(N,2) = u1 + 0.5 * slope - ppoly_coefficients(N,1) = ppoly_E(N,1) - ppoly_coefficients(N,2) = ppoly_E(N,2) - ppoly_E(N,1) + ppoly_coef(N,1) = ppoly_E(N,1) + ppoly_coef(N,2) = ppoly_E(N,2) - ppoly_E(N,1) end subroutine PLM_boundary_extrapolation diff --git a/src/ALE/PPM_functions.F90 b/src/ALE/PPM_functions.F90 index 484e2e0d40..d0eb8325ad 100644 --- a/src/ALE/PPM_functions.F90 +++ b/src/ALE/PPM_functions.F90 @@ -25,12 +25,14 @@ module PPM_functions contains !> Builds quadratic polynomials coefficients from cell mean and edge values. -subroutine PPM_reconstruction( N, h, u, ppoly_E, ppoly_coefficients, h_neglect) +subroutine PPM_reconstruction( N, h, u, ppoly_E, ppoly_coef, h_neglect) integer, intent(in) :: N !< Number of cells real, dimension(N), intent(in) :: h !< Cell widths real, dimension(N), intent(in) :: u !< Cell averages - real, dimension(N,2), intent(inout) :: ppoly_E !< Edge values - real, dimension(N,3), intent(inout) :: ppoly_coefficients !< Polynomial coefficients + real, dimension(N,2), intent(inout) :: ppoly_E !< Edge values, + !! with the same units as u. + real, dimension(N,3), intent(inout) :: ppoly_coef !< Polynomial coefficients, mainly + !! with the same units as u. real, optional, intent(in) :: h_neglect !< A negligibly small width !! in the same units as h. ! Local variables @@ -47,9 +49,9 @@ subroutine PPM_reconstruction( N, h, u, ppoly_E, ppoly_coefficients, h_neglect) edge_r = ppoly_E(k,2) ! Store polynomial coefficients - ppoly_coefficients(k,1) = edge_l - ppoly_coefficients(k,2) = 4.0 * ( u(k) - edge_l ) + 2.0 * ( u(k) - edge_r ) - ppoly_coefficients(k,3) = 3.0 * ( ( edge_r - u(k) ) + ( edge_l - u(k) ) ) + ppoly_coef(k,1) = edge_l + ppoly_coef(k,2) = 4.0 * ( u(k) - edge_l ) + 2.0 * ( u(k) - edge_r ) + ppoly_coef(k,3) = 3.0 * ( ( edge_r - u(k) ) + ( edge_l - u(k) ) ) enddo @@ -127,9 +129,8 @@ end subroutine PPM_limiter_standard !------------------------------------------------------------------------------ -! ppm boundary extrapolation -! ----------------------------------------------------------------------------- -subroutine PPM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients, h_neglect) +!> Reconstruction by parabolas within boundary cells +subroutine PPM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef, h_neglect) !------------------------------------------------------------------------------ ! Reconstruction by parabolas within boundary cells. ! @@ -148,21 +149,23 @@ subroutine PPM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients, h_n ! h: thicknesses of grid cells ! u: cell averages to use in constructing piecewise polynomials ! ppoly_E : edge values of piecewise polynomials -! ppoly_coefficients : coefficients of piecewise polynomials +! ppoly_coef : coefficients of piecewise polynomials ! ! It is assumed that the size of the array 'u' is equal to the number of cells ! defining 'grid' and 'ppoly'. No consistency check is performed here. !------------------------------------------------------------------------------ ! Arguments - integer, intent(in) :: N ! Number of cells - real, dimension(:), intent(in) :: h ! cell widths (size N) - real, dimension(:), intent(in) :: u ! cell averages (size N) - real, dimension(:,:), intent(inout) :: ppoly_E - real, dimension(:,:), intent(inout) :: ppoly_coefficients - real, optional, intent(in) :: h_neglect !< A negligibly small width for - !! the purpose of cell reconstructions - !! in the same units as h. + integer, intent(in) :: N !< Number of cells + real, dimension(:), intent(in) :: h !< cell widths (size N) + real, dimension(:), intent(in) :: u !< cell averages (size N) + real, dimension(:,:), intent(inout) :: ppoly_E !< edge values of piecewise polynomials, + !! with the same units as u. + real, dimension(:,:), intent(inout) :: ppoly_coef !< coefficients of piecewise polynomials, mainly + !! with the same units as u. + real, optional, intent(in) :: h_neglect !< A negligibly small width for + !! the purpose of cell reconstructions + !! in the same units as h. ! Local variables integer :: i0, i1 @@ -187,7 +190,7 @@ subroutine PPM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients, h_n ! Compute the left edge slope in neighboring cell and express it in ! the global coordinate system - b = ppoly_coefficients(i1,2) + b = ppoly_coef(i1,2) u1_r = b *((h0+hNeglect)/(h1+hNeglect)) ! derivative evaluated at xi = 0.0, ! expressed w.r.t. xi (local coord. system) @@ -225,9 +228,9 @@ subroutine PPM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients, h_n b = 6.0 * u0 - 4.0 * u0_l - 2.0 * u0_r c = 3.0 * ( u0_r + u0_l - 2.0 * u0 ) - ppoly_coefficients(i0,1) = a - ppoly_coefficients(i0,2) = b - ppoly_coefficients(i0,3) = c + ppoly_coef(i0,1) = a + ppoly_coef(i0,2) = b + ppoly_coef(i0,3) = c ! ----- Right boundary ----- i0 = N-1 @@ -239,8 +242,8 @@ subroutine PPM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients, h_n ! Compute the right edge slope in neighboring cell and express it in ! the global coordinate system - b = ppoly_coefficients(i0,2) - c = ppoly_coefficients(i0,3) + b = ppoly_coef(i0,2) + c = ppoly_coef(i0,3) u1_l = (b + 2*c) ! derivative evaluated at xi = 1.0 u1_l = u1_l * ((h1+hNeglect)/(h0+hNeglect)) @@ -278,9 +281,9 @@ subroutine PPM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients, h_n b = 6.0 * u1 - 4.0 * u0_l - 2.0 * u0_r c = 3.0 * ( u0_r + u0_l - 2.0 * u1 ) - ppoly_coefficients(i1,1) = a - ppoly_coefficients(i1,2) = b - ppoly_coefficients(i1,3) = c + ppoly_coef(i1,1) = a + ppoly_coef(i1,2) = b + ppoly_coef(i1,3) = c end subroutine PPM_boundary_extrapolation diff --git a/src/ALE/PQM_functions.F90 b/src/ALE/PQM_functions.F90 index 8d15e6dd98..6c89c7ac10 100644 --- a/src/ALE/PQM_functions.F90 +++ b/src/ALE/PQM_functions.F90 @@ -22,9 +22,8 @@ module PQM_functions contains !------------------------------------------------------------------------------ -! PQM_reconstruction -! ----------------------------------------------------------------------------- -subroutine PQM_reconstruction( N, h, u, ppoly_E, ppoly_S, ppoly_coefficients, h_neglect ) +!> PQM_reconstruction does reconstruction by quartic polynomials within each cell. +subroutine PQM_reconstruction( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect ) !------------------------------------------------------------------------------ ! Reconstruction by quartic polynomials within each cell. ! @@ -37,15 +36,18 @@ subroutine PQM_reconstruction( N, h, u, ppoly_E, ppoly_S, ppoly_coefficients, h_ !------------------------------------------------------------------------------ ! Arguments - integer, intent(in) :: N ! Number of cells - real, dimension(:), intent(in) :: h ! cell widths (size N) - real, dimension(:), intent(in) :: u ! cell averages (size N) - real, dimension(:,:), intent(inout) :: ppoly_E !Edge value of polynomial - real, dimension(:,:), intent(inout) :: ppoly_S !Edge slope of polynomial - real, dimension(:,:), intent(inout) :: ppoly_coefficients !Coefficients of polynomial - real, optional, intent(in) :: h_neglect !< A negligibly small width for - !! the purpose of cell reconstructions - !! in the same units as h + integer, intent(in) :: N !< Number of cells + real, dimension(:), intent(in) :: h !< cell widths (size N) + real, dimension(:), intent(in) :: u !< cell averages (size N) + real, dimension(:,:), intent(inout) :: ppoly_E !< Edge value of polynomial, + !! with the same units as u. + real, dimension(:,:), intent(inout) :: ppoly_S !< Edge slope of polynomial, + !! in the units of u over the units of h. + real, dimension(:,:), intent(inout) :: ppoly_coef !< Coefficients of polynomial, mainly + !! with the same units as u. + real, optional, intent(in) :: h_neglect !< A negligibly small width for + !! the purpose of cell reconstructions + !! in the same units as h ! Local variables integer :: k ! loop index @@ -75,11 +77,11 @@ subroutine PQM_reconstruction( N, h, u, ppoly_E, ppoly_S, ppoly_coefficients, h_ e = 30.0 * u(k) + 2.5*h_c*(u1_r - u1_l) - 15.0*(u0_l + u0_r) ! Store coefficients - ppoly_coefficients(k,1) = a - ppoly_coefficients(k,2) = b - ppoly_coefficients(k,3) = c - ppoly_coefficients(k,4) = d - ppoly_coefficients(k,5) = e + ppoly_coef(k,1) = a + ppoly_coef(k,2) = b + ppoly_coef(k,3) = c + ppoly_coef(k,4) = d + ppoly_coef(k,5) = e end do ! end loop on cells @@ -87,8 +89,7 @@ end subroutine PQM_reconstruction !------------------------------------------------------------------------------ -! Limit pqm -! ----------------------------------------------------------------------------- +!> Limit the piecewise quartic method reconstruction subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) !------------------------------------------------------------------------------ ! Standard PQM limiter (White & Adcroft, JCP 2008). @@ -369,9 +370,8 @@ end subroutine PQM_limiter !------------------------------------------------------------------------------ -! pqm boundary extrapolation -! ----------------------------------------------------------------------------- -subroutine PQM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients ) +!> piecewise quartic method boundary extrapolation +subroutine PQM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef ) !------------------------------------------------------------------------------ ! Reconstruction by parabolas within boundary cells. ! @@ -395,11 +395,13 @@ subroutine PQM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients ) !------------------------------------------------------------------------------ ! Arguments - integer, intent(in) :: N ! Number of cells - real, dimension(:), intent(in) :: h ! cell widths (size N) - real, dimension(:), intent(in) :: u ! cell averages (size N) - real, dimension(:,:), intent(inout) :: ppoly_E !Edge value of polynomial - real, dimension(:,:), intent(inout) :: ppoly_coefficients !Coefficients of polynomial + integer, intent(in) :: N !< Number of cells + real, dimension(:), intent(in) :: h !< cell widths (size N) + real, dimension(:), intent(in) :: u !< cell averages (size N) + real, dimension(:,:), intent(inout) :: ppoly_E !< Edge value of polynomial, + !! with the same units as u. + real, dimension(:,:), intent(inout) :: ppoly_coef !< Coefficients of polynomial, mainly + !! with the same units as u. ! Local variables integer :: i0, i1 @@ -421,7 +423,7 @@ subroutine PQM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients ) ! Compute the left edge slope in neighboring cell and express it in ! the global coordinate system - b = ppoly_coefficients(i1,2) + b = ppoly_coef(i1,2) u1_r = b *(h0/h1) ! derivative evaluated at xi = 0.0, ! expressed w.r.t. xi (local coord. system) @@ -460,11 +462,11 @@ subroutine PQM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients ) c = 3.0 * ( u0_r + u0_l - 2.0 * u0 ) ! The quartic is reduced to a parabola in the boundary cell - ppoly_coefficients(i0,1) = a - ppoly_coefficients(i0,2) = b - ppoly_coefficients(i0,3) = c - ppoly_coefficients(i0,4) = 0.0 - ppoly_coefficients(i0,5) = 0.0 + ppoly_coef(i0,1) = a + ppoly_coef(i0,2) = b + ppoly_coef(i0,3) = c + ppoly_coef(i0,4) = 0.0 + ppoly_coef(i0,5) = 0.0 ! ----- Right boundary ----- i0 = N-1 @@ -476,10 +478,10 @@ subroutine PQM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients ) ! Compute the right edge slope in neighboring cell and express it in ! the global coordinate system - b = ppoly_coefficients(i0,2) - c = ppoly_coefficients(i0,3) - d = ppoly_coefficients(i0,4) - e = ppoly_coefficients(i0,5) + b = ppoly_coef(i0,2) + c = ppoly_coef(i0,3) + d = ppoly_coef(i0,4) + e = ppoly_coef(i0,5) u1_l = (b + 2*c + 3*d + 4*e) ! derivative evaluated at xi = 1.0 u1_l = u1_l * (h1/h0) @@ -518,19 +520,18 @@ subroutine PQM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coefficients ) c = 3.0 * ( u0_r + u0_l - 2.0 * u1 ) ! The quartic is reduced to a parabola in the boundary cell - ppoly_coefficients(i1,1) = a - ppoly_coefficients(i1,2) = b - ppoly_coefficients(i1,3) = c - ppoly_coefficients(i1,4) = 0.0 - ppoly_coefficients(i1,5) = 0.0 + ppoly_coef(i1,1) = a + ppoly_coef(i1,2) = b + ppoly_coef(i1,3) = c + ppoly_coef(i1,4) = 0.0 + ppoly_coef(i1,5) = 0.0 end subroutine PQM_boundary_extrapolation !------------------------------------------------------------------------------ -! pqm boundary extrapolation using rational function -! ----------------------------------------------------------------------------- -subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coefficients, h_neglect ) +!> pqm boundary extrapolation using a rational function +subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect ) !------------------------------------------------------------------------------ ! Reconstruction by parabolas within boundary cells. ! @@ -554,15 +555,18 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coeff !------------------------------------------------------------------------------ ! Arguments - integer, intent(in) :: N ! Number of cells - real, dimension(:), intent(in) :: h ! cell widths (size N) - real, dimension(:), intent(in) :: u ! cell averages (size N) - real, dimension(:,:), intent(inout) :: ppoly_E !Edge value of polynomial - real, dimension(:,:), intent(inout) :: ppoly_S !Edge slope of polynomial - real, dimension(:,:), intent(inout) :: ppoly_coefficients !Coefficients of polynomial - real, optional, intent(in) :: h_neglect !< A negligibly small width for - !! the purpose of cell reconstructions - !! in the same units as h. + integer, intent(in) :: N !< Number of cells + real, dimension(:), intent(in) :: h !< cell widths (size N) + real, dimension(:), intent(in) :: u !< cell averages (size N) + real, dimension(:,:), intent(inout) :: ppoly_E !< Edge value of polynomial, + !! with the same units as u. + real, dimension(:,:), intent(inout) :: ppoly_S !< Edge slope of polynomial, + !! in the units of u over the units of h. + real, dimension(:,:), intent(inout) :: ppoly_coef !< Coefficients of polynomial, mainly + !! with the same units as u. + real, optional, intent(in) :: h_neglect !< A negligibly small width for + !! the purpose of cell reconstructions + !! in the same units as h. ! Local variables integer :: i0, i1 @@ -600,8 +604,8 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coeff ! The right edge value and slope of the boundary cell are taken to be the ! left edge value and slope of the adjacent cell - a = ppoly_coefficients(i1,1) - b = ppoly_coefficients(i1,2) + a = ppoly_coef(i1,1) + b = ppoly_coef(i1,2) u0_r = a ! edge value u1_r = b / (h1 + hNeglect) ! edge slope (w.r.t. global coord.) @@ -725,11 +729,11 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coeff e = 30.0 * um + 2.5*h0*(u1_r - u1_l) - 15.0*(u0_l + u0_r) ! Store coefficients - ppoly_coefficients(i0,1) = a - ppoly_coefficients(i0,2) = b - ppoly_coefficients(i0,3) = c - ppoly_coefficients(i0,4) = d - ppoly_coefficients(i0,5) = e + ppoly_coef(i0,1) = a + ppoly_coef(i0,2) = b + ppoly_coef(i0,3) = c + ppoly_coef(i0,4) = d + ppoly_coef(i0,5) = e ! ----- Right boundary (BOTTOM) ----- i0 = N-1 @@ -747,11 +751,11 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coeff ! The left edge value and slope of the boundary cell are taken to be the ! right edge value and slope of the adjacent cell - a = ppoly_coefficients(i0,1) - b = ppoly_coefficients(i0,2) - c = ppoly_coefficients(i0,3) - d = ppoly_coefficients(i0,4) - e = ppoly_coefficients(i0,5) + a = ppoly_coef(i0,1) + b = ppoly_coef(i0,2) + c = ppoly_coef(i0,3) + d = ppoly_coef(i0,4) + e = ppoly_coef(i0,5) u0_l = a + b + c + d + e ! edge value u1_l = (b + 2*c + 3*d + 4*e) / h0 ! edge slope (w.r.t. global coord.) @@ -877,11 +881,11 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coeff d = -60.0 * um + h1 *(6.0*u1_l - 4.0*u1_r) + 28.0*u0_r + 32.0*u0_l e = 30.0 * um + 2.5*h1*(u1_r - u1_l) - 15.0*(u0_l + u0_r) - ppoly_coefficients(i1,1) = a - ppoly_coefficients(i1,2) = b - ppoly_coefficients(i1,3) = c - ppoly_coefficients(i1,4) = d - ppoly_coefficients(i1,5) = e + ppoly_coef(i1,1) = a + ppoly_coef(i1,2) = b + ppoly_coef(i1,3) = c + ppoly_coef(i1,4) = d + ppoly_coef(i1,5) = e end subroutine PQM_boundary_extrapolation_v1 diff --git a/src/ALE/polynomial_functions.F90 b/src/ALE/polynomial_functions.F90 index b0d5d135d5..0cc4eb0b71 100644 --- a/src/ALE/polynomial_functions.F90 +++ b/src/ALE/polynomial_functions.F90 @@ -21,62 +21,58 @@ module polynomial_functions contains ! ----------------------------------------------------------------------------- -! Pointwise evaluation of a polynomial -! ----------------------------------------------------------------------------- -real function evaluation_polynomial( coefficients, nb_coefficients, x ) +!> Pointwise evaluation of a polynomial at x +real function evaluation_polynomial( coeff, ncoef, x ) + real, dimension(:), intent(in) :: coeff !< The coefficients of the polynomial + integer, intent(in) :: ncoef !< The number of polynomial coefficients + real, intent(in) :: x !< The position at which to evaluate the polynomial ! ----------------------------------------------------------------------------- ! The polynomial is defined by the coefficients contained in the ! array of the same name, as follows: C(1) + C(2)x + C(3)x^2 + C(4)x^3 + ... -! where C refers to the array 'coefficients'. -! The number of coefficients is given by nb_coefficients and x +! where C refers to the array 'coeff'. +! The number of coefficients is given by ncoef and x ! is the coordinate where the polynomial is to be evaluated. ! ! The function returns the value of the polynomial at x. ! ----------------------------------------------------------------------------- ! Arguments - real, dimension(:), intent(in) :: coefficients - integer, intent(in) :: nb_coefficients - real, intent(in) :: x ! Local variables - integer :: k - real :: f ! value of polynomial at x + integer :: k + real :: f ! value of polynomial at x f = 0.0 - do k = 1,nb_coefficients - f = f + coefficients(k) * ( x**(k-1) ) + do k = 1,ncoef + f = f + coeff(k) * ( x**(k-1) ) end do evaluation_polynomial = f end function evaluation_polynomial -!> Calculates the first derivative of a polynomial with coefficients as above -!! evaluated at a point x -real function first_derivative_polynomial( coefficients, nb_coefficients, x ) +!> Calculates the first derivative of a polynomial evaluated at a point x +real function first_derivative_polynomial( coeff, ncoef, x ) + real, dimension(:), intent(in) :: coeff !< The coefficients of the polynomial + integer, intent(in) :: ncoef !< The number of polynomial coefficients + real, intent(in) :: x !< The position at which to evaluate the derivative ! ----------------------------------------------------------------------------- ! The polynomial is defined by the coefficients contained in the ! array of the same name, as follows: C(1) + C(2)x + C(3)x^2 + C(4)x^3 + ... -! where C refers to the array 'coefficients'. -! The number of coefficients is given by nb_coefficients and x +! where C refers to the array 'coeff'. +! The number of coefficients is given by ncoef and x ! is the coordinate where the polynomial's derivative is to be evaluated. ! -! The function returns the value of the polynomial at x. +! The function returns the first derivative of the polynomial at x. ! ----------------------------------------------------------------------------- - ! Arguments - real, dimension(:), intent(in) :: coefficients - integer, intent(in) :: nb_coefficients - real, intent(in) :: x - ! Local variables integer :: k real :: f ! value of polynomial at x f = 0.0 - do k = 2,nb_coefficients - f = f + REAL(k-1)*coefficients(k) * ( x**(k-2) ) + do k = 2,ncoef + f = f + REAL(k-1)*coeff(k) * ( x**(k-2) ) end do first_derivative_polynomial = f @@ -84,48 +80,45 @@ real function first_derivative_polynomial( coefficients, nb_coefficients, x ) end function first_derivative_polynomial ! ----------------------------------------------------------------------------- -! Exact integration of polynomial of degree n -! ----------------------------------------------------------------------------- -real function integration_polynomial( xi0, xi1, C, n ) +!> Exact integration of polynomial of degree npoly +real function integration_polynomial( xi0, xi1, Coeff, npoly ) + real, intent(in) :: xi0 !< The lower bound of the integral + real, intent(in) :: xi1 !< The lower bound of the integral + real, dimension(:), intent(in) :: Coeff !< The coefficients of the polynomial + integer, intent(in) :: npoly !< The degree of the polynomial ! ----------------------------------------------------------------------------- -! Exact integration of a polynomial of degree n over the interval [xi0,xi1]. -! The array of coefficients (C) must be of size n+1, where n is the degree of -! the polynomial to integrate. +! Exact integration of a polynomial of degree npoly over the interval [xi0,xi1]. +! The array of coefficients (Coeff) must be of size npoly+1. ! ----------------------------------------------------------------------------- - ! Arguments - real, intent(in) :: xi0, xi1 - real, dimension(:), intent(in) :: C - integer, intent(in) :: n - ! Local variables integer :: k real :: integral integral = 0.0 - do k = 1,(n+1) - integral = integral + C(k) * (xi1**k - xi0**k) / real(k) + do k = 1,npoly+1 + integral = integral + Coeff(k) * (xi1**k - xi0**k) / real(k) end do ! !One non-answer-changing way of unrolling the above is: ! k=1 -! integral = integral + C(k) * (xi1**k - xi0**k) / real(k) -! if (n>=1) then +! integral = integral + Coeff(k) * (xi1**k - xi0**k) / real(k) +! if (npoly>=1) then ! k=2 -! integral = integral + C(k) * (xi1**k - xi0**k) / real(k) +! integral = integral + Coeff(k) * (xi1**k - xi0**k) / real(k) ! endif -! if (n>=2) then +! if (npoly>=2) then ! k=3 -! integral = integral + C(k) * (xi1**k - xi0**k) / real(k) +! integral = integral + Coeff(k) * (xi1**k - xi0**k) / real(k) ! endif -! if (n>=3) then +! if (npoly>=3) then ! k=4 -! integral = integral + C(k) * (xi1**k - xi0**k) / real(k) +! integral = integral + Coeff(k) * (xi1**k - xi0**k) / real(k) ! endif -! if (n>=4) then +! if (npoly>=4) then ! k=5 -! integral = integral + C(k) * (xi1**k - xi0**k) / real(k) +! integral = integral + Coeff(k) * (xi1**k - xi0**k) / real(k) ! endif ! integration_polynomial = integral diff --git a/src/ALE/regrid_edge_slopes.F90 b/src/ALE/regrid_edge_slopes.F90 index f8781aa937..e07f3c3bd5 100644 --- a/src/ALE/regrid_edge_slopes.F90 +++ b/src/ALE/regrid_edge_slopes.F90 @@ -32,6 +32,13 @@ module regrid_edge_slopes !------------------------------------------------------------------------------ !> Compute ih4 edge slopes (implicit third order accurate) subroutine edge_slopes_implicit_h3( N, h, u, edge_slopes, h_neglect ) + integer, intent(in) :: N !< Number of cells + real, dimension(:), intent(in) :: h !< cell widths (size N) + real, dimension(:), intent(in) :: u !< cell average properties (size N) + real, dimension(:,:), intent(inout) :: edge_slopes !< Returned edge slopes, with the + !! same units as u divided by the units of h. + real, optional, intent(in) :: h_neglect !< A negligibly small width + !! in the same units as h. ! ----------------------------------------------------------------------------- ! Compute edge slopes based on third-order implicit estimates. Note that ! the estimates are fourth-order accurate on uniform grids @@ -58,15 +65,6 @@ subroutine edge_slopes_implicit_h3( N, h, u, edge_slopes, h_neglect ) ! boundary conditions close the system. ! ----------------------------------------------------------------------------- - ! Arguments - integer, intent(in) :: N !< Number of cells - real, dimension(:), intent(in) :: h !< cell widths (size N) - real, dimension(:), intent(in) :: u !< cell average properties (size N) - real, dimension(:,:), intent(inout) :: edge_slopes !< Returned edge slopes, with the - !! same units as u divided by the units of h. - real, optional, intent(in) :: h_neglect !< A negligibly small width - !! in the same units as h. - ! Local variables integer :: i, j ! loop indexes real :: h0, h1 ! cell widths @@ -188,6 +186,13 @@ end subroutine edge_slopes_implicit_h3 !------------------------------------------------------------------------------ !> Compute ih5 edge values (implicit fifth order accurate) subroutine edge_slopes_implicit_h5( N, h, u, edge_slopes, h_neglect ) + integer, intent(in) :: N !< Number of cells + real, dimension(:), intent(in) :: h !< cell widths (size N) + real, dimension(:), intent(in) :: u !< cell average properties (size N) + real, dimension(:,:), intent(inout) :: edge_slopes !< Returned edge slopes, with the + !! same units as u divided by the units of h. + real, optional, intent(in) :: h_neglect !< A negligibly small width + !! in the same units as h. ! ----------------------------------------------------------------------------- ! Fifth-order implicit estimates of edge values are based on a four-cell, ! three-edge stencil. A tridiagonal system is set up and is based on @@ -221,15 +226,6 @@ subroutine edge_slopes_implicit_h5( N, h, u, edge_slopes, h_neglect ) ! on nonuniform meshes turned out to be intractable. ! ----------------------------------------------------------------------------- - ! Arguments - integer, intent(in) :: N !< Number of cells - real, dimension(:), intent(in) :: h !< cell widths (size N) - real, dimension(:), intent(in) :: u !< cell average properties (size N) - real, dimension(:,:), intent(inout) :: edge_slopes !< Returned edge slopes, with the - !! same units as u divided by the units of h. - real, optional, intent(in) :: h_neglect !< A negligibly small width - !! in the same units as h. - ! Local variables integer :: i, j, k ! loop indexes real :: h0, h1, h2, h3 ! cell widths diff --git a/src/ALE/regrid_edge_values.F90 b/src/ALE/regrid_edge_values.F90 index 1df7c6ec69..f9cdad794a 100644 --- a/src/ALE/regrid_edge_values.F90 +++ b/src/ALE/regrid_edge_values.F90 @@ -43,9 +43,15 @@ module regrid_edge_values contains !------------------------------------------------------------------------------ -! Bound edge values by neighboring cell averages -!------------------------------------------------------------------------------ -subroutine bound_edge_values( N, h, u, edge_values, h_neglect ) +!> Bound edge values by neighboring cell averages +subroutine bound_edge_values( N, h, u, edge_val, h_neglect ) + integer, intent(in) :: N !< Number of cells + real, dimension(:), intent(in) :: h !< cell widths (size N) + real, dimension(:), intent(in) :: u !< cell average properties (size N) + real, dimension(:,:), intent(inout) :: edge_val !< Potentially modified edge values, + !! with the same units as u. + real, optional, intent(in) :: h_neglect !< A negligibly small width + !! in the same units as h. ! ------------------------------------------------------------------------------ ! In this routine, we loop on all cells to bound their left and right ! edge values by the cell averages. That is, the left edge value must lie @@ -57,15 +63,6 @@ subroutine bound_edge_values( N, h, u, edge_values, h_neglect ) ! Therefore, boundary cells are treated as if they were local extrama. ! ------------------------------------------------------------------------------ - ! Arguments - integer, intent(in) :: N !< Number of cells - real, dimension(:), intent(in) :: h !< cell widths (size N) - real, dimension(:), intent(in) :: u !< cell average properties (size N) - real, dimension(:,:), intent(inout) :: edge_values !< Potentially modified edge values, - !! with the same units as u. - real, optional, intent(in) :: h_neglect !< A negligibly small width - !! in the same units as h. - ! Local variables integer :: k ! loop index integer :: k0, k1, k2 @@ -111,8 +108,8 @@ subroutine bound_edge_values( N, h, u, edge_values, h_neglect ) u_c = u(k1) u_r = u(k2) - u0_l = edge_values(k,1) - u0_r = edge_values(k,2) + u0_l = edge_val(k,1) + u0_r = edge_val(k,2) sigma_l = 2.0 * ( u_c - u_l ) / ( h_c + hNeglect ) sigma_c = 2.0 * ( u_r - u_l ) / ( h_l + 2.0*h_c + h_r + hNeglect ) @@ -143,8 +140,8 @@ subroutine bound_edge_values( N, h, u, edge_values, h_neglect ) u0_r = max( min( u0_r, max(u_r, u_c) ), min(u_r, u_c) ) ! Store edge values - edge_values(k,1) = u0_l - edge_values(k,2) = u0_r + edge_val(k,1) = u0_l + edge_val(k,2) = u0_r end do ! loop on interior edges @@ -152,18 +149,16 @@ end subroutine bound_edge_values !------------------------------------------------------------------------------ -! Average discontinuous edge values (systematically) -!------------------------------------------------------------------------------ -subroutine average_discontinuous_edge_values( N, edge_values ) +!> Replace discontinuous collocated edge values with their average +subroutine average_discontinuous_edge_values( N, edge_val ) + integer, intent(in) :: N !< Number of cells + real, dimension(:,:), intent(inout) :: edge_val !< Edge values that may be modified; + !! the second index size is 2. ! ------------------------------------------------------------------------------ ! For each interior edge, check whether the edge values are discontinuous. -! If so, compute the average and replace the edge values by the average.! +! If so, compute the average and replace the edge values by the average. ! ------------------------------------------------------------------------------ - ! Arguments - integer, intent(in) :: N ! Number of cells - real, dimension(:,:), intent(inout) :: edge_values - ! Local variables integer :: k ! loop index real :: u0_minus ! left value at given edge @@ -174,15 +169,15 @@ subroutine average_discontinuous_edge_values( N, edge_values ) do k = 1,N-1 ! Edge value on the left of the edge - u0_minus = edge_values(k,2) + u0_minus = edge_val(k,2) ! Edge value on the right of the edge - u0_plus = edge_values(k+1,1) + u0_plus = edge_val(k+1,1) if ( u0_minus /= u0_plus ) then u0_avg = 0.5 * ( u0_minus + u0_plus ) - edge_values(k,2) = u0_avg - edge_values(k+1,1) = u0_avg + edge_val(k,2) = u0_avg + edge_val(k+1,1) = u0_avg end if end do ! end loop on interior edges @@ -191,19 +186,16 @@ end subroutine average_discontinuous_edge_values !------------------------------------------------------------------------------ -! Check discontinuous edge values and take average is not monotonic -!------------------------------------------------------------------------------ -subroutine check_discontinuous_edge_values( N, u, edge_values ) +!> Check discontinuous edge values and replace them with their average if not monotonic +subroutine check_discontinuous_edge_values( N, u, edge_val ) + integer, intent(in) :: N !< Number of cells + real, dimension(:), intent(in) :: u !< cell averages (size N) + real, dimension(:,:), intent(inout) :: edge_val !< Cell edge values with the same units as u. ! ------------------------------------------------------------------------------ ! For each interior edge, check whether the edge values are discontinuous. ! If so and if they are not monotonic, replace each edge value by their average. ! ------------------------------------------------------------------------------ - ! Arguments - integer, intent(in) :: N ! Number of cells - real, dimension(:), intent(in) :: u ! cell averages (size N) - real, dimension(:,:), intent(inout) :: edge_values - ! Local variables integer :: k ! loop index real :: u0_minus ! left value at given edge @@ -216,10 +208,10 @@ subroutine check_discontinuous_edge_values( N, u, edge_values ) do k = 1,N-1 ! Edge value on the left of the edge - u0_minus = edge_values(k,2) + u0_minus = edge_val(k,2) ! Edge value on the right of the edge - u0_plus = edge_values(k+1,1) + u0_plus = edge_val(k+1,1) ! Left cell average um_minus = u(k) @@ -230,8 +222,8 @@ subroutine check_discontinuous_edge_values( N, u, edge_values ) if ( (u0_plus - u0_minus)*(um_plus - um_minus) < 0.0 ) then u0_avg = 0.5 * ( u0_minus + u0_plus ) u0_avg = max( min( u0_avg, max(um_minus, um_plus) ), min(um_minus, um_plus) ) - edge_values(k,2) = u0_avg - edge_values(k+1,1) = u0_avg + edge_val(k,2) = u0_avg + edge_val(k+1,1) = u0_avg end if end do ! end loop on interior edges @@ -241,7 +233,14 @@ end subroutine check_discontinuous_edge_values !------------------------------------------------------------------------------ !> Compute h2 edge values (explicit second order accurate) -subroutine edge_values_explicit_h2( N, h, u, edge_values, h_neglect ) +subroutine edge_values_explicit_h2( N, h, u, edge_val, h_neglect ) + integer, intent(in) :: N !< Number of cells + real, dimension(:), intent(in) :: h !< cell widths (size N) + real, dimension(:), intent(in) :: u !< cell average properties (size N) + real, dimension(:,:), intent(inout) :: edge_val !< Returned edge values, with the + !! same units as u; the second index size is 2. + real, optional, intent(in) :: h_neglect !< A negligibly small width + !! in the same units as h. ! ------------------------------------------------------------------------------ ! Compute edge values based on second-order explicit estimates. ! These estimates are based on a straight line spanning two cells and evaluated @@ -254,16 +253,7 @@ subroutine edge_values_explicit_h2( N, h, u, edge_values, h_neglect ) ! ! Boundary edge values are set to be equal to the boundary cell averages. ! ------------------------------------------------------------------------------ - - ! Arguments - integer, intent(in) :: N !< Number of cells - real, dimension(:), intent(in) :: h !< cell widths (size N) - real, dimension(:), intent(in) :: u !< cell average properties (size N) - real, dimension(:,:), intent(inout) :: edge_values !< Returned edge values, with the - !! same units as u; the second index size is 2. - real, optional, intent(in) :: h_neglect !< A negligibly small width - !! in the same units as h. - + ! Local variables integer :: k ! loop index real :: h0, h1 ! cell widths @@ -288,24 +278,31 @@ subroutine edge_values_explicit_h2( N, h, u, edge_values, h_neglect ) u1 = u(k) ! Compute left edge value - edge_values(k,1) = ( u0*h1 + u1*h0 ) / ( h0 + h1 ) + edge_val(k,1) = ( u0*h1 + u1*h0 ) / ( h0 + h1 ) ! Left edge value of the current cell is equal to right edge ! value of left cell - edge_values(k-1,2) = edge_values(k,1) + edge_val(k-1,2) = edge_val(k,1) end do ! end loop on interior cells ! Boundary edge values are simply equal to the boundary cell averages - edge_values(1,1) = u(1) - edge_values(N,2) = u(N) + edge_val(1,1) = u(1) + edge_val(N,2) = u(N) end subroutine edge_values_explicit_h2 !------------------------------------------------------------------------------ !> Compute h4 edge values (explicit fourth order accurate) -subroutine edge_values_explicit_h4( N, h, u, edge_values, h_neglect ) +subroutine edge_values_explicit_h4( N, h, u, edge_val, h_neglect ) + integer, intent(in) :: N !< Number of cells + real, dimension(:), intent(in) :: h !< cell widths (size N) + real, dimension(:), intent(in) :: u !< cell average properties (size N) + real, dimension(:,:), intent(inout) :: edge_val !< Returned edge values, with the + !! same units as u; the second index size is 2. + real, optional, intent(in) :: h_neglect !< A negligibly small width + !! in the same units as h. ! ----------------------------------------------------------------------------- ! Compute edge values based on fourth-order explicit estimates. ! These estimates are based on a cubic interpolant spanning four cells @@ -325,15 +322,6 @@ subroutine edge_values_explicit_h4( N, h, u, edge_values, h_neglect ) ! For this fourth-order scheme, at least four cells must exist. ! ----------------------------------------------------------------------------- - ! Arguments - integer, intent(in) :: N !< Number of cells - real, dimension(:), intent(in) :: h !< cell widths (size N) - real, dimension(:), intent(in) :: u !< cell average properties (size N) - real, dimension(:,:), intent(inout) :: edge_values !< Returned edge values, with the - !! same units as u; the second index size is 2. - real, optional, intent(in) :: h_neglect !< A negligibly small width - !! in the same units as h. - ! Local variables integer :: i, j real :: u0, u1, u2, u3 @@ -387,8 +375,8 @@ subroutine edge_values_explicit_h4( N, h, u, edge_values, h_neglect ) e = e / ( h0 + h1 + h2 + h3) - edge_values(i,1) = e - edge_values(i-1,2) = e + edge_val(i,1) = e + edge_val(i-1,2) = e #ifdef __DO_SAFETY_CHECKS__ if (e /= e) then @@ -422,14 +410,14 @@ subroutine edge_values_explicit_h4( N, h, u, edge_values, h_neglect ) call solve_linear_system( A, B, C, 4 ) ! First edge value - edge_values(1,1) = evaluation_polynomial( C, 4, x(1) ) + edge_val(1,1) = evaluation_polynomial( C, 4, x(1) ) ! Second edge value - edge_values(1,2) = evaluation_polynomial( C, 4, x(2) ) - edge_values(2,1) = edge_values(1,2) + edge_val(1,2) = evaluation_polynomial( C, 4, x(2) ) + edge_val(2,1) = edge_val(1,2) #ifdef __DO_SAFETY_CHECKS__ - if (edge_values(1,1) /= edge_values(1,1) .or. edge_values(1,2) /= edge_values(1,2)) then + if (edge_val(1,1) /= edge_val(1,1) .or. edge_val(1,2) /= edge_val(1,2)) then write(0,*) 'NaN in explicit_edge_h4 at k=',1 write(0,*) 'A=',A write(0,*) 'B=',B @@ -460,14 +448,14 @@ subroutine edge_values_explicit_h4( N, h, u, edge_values, h_neglect ) call solve_linear_system( A, B, C, 4 ) ! Last edge value - edge_values(N,2) = evaluation_polynomial( C, 4, x(5) ) + edge_val(N,2) = evaluation_polynomial( C, 4, x(5) ) ! Second to last edge value - edge_values(N,1) = evaluation_polynomial( C, 4, x(4) ) - edge_values(N-1,2) = edge_values(N,1) + edge_val(N,1) = evaluation_polynomial( C, 4, x(4) ) + edge_val(N-1,2) = edge_val(N,1) #ifdef __DO_SAFETY_CHECKS__ - if (edge_values(N,1) /= edge_values(N,1) .or. edge_values(N,2) /= edge_values(N,2)) then + if (edge_val(N,1) /= edge_val(N,1) .or. edge_val(N,2) /= edge_val(N,2)) then write(0,*) 'NaN in explicit_edge_h4 at k=',N write(0,*) 'A=' do i = 1,4 @@ -490,7 +478,14 @@ end subroutine edge_values_explicit_h4 !------------------------------------------------------------------------------ !> Compute ih4 edge values (implicit fourth order accurate) -subroutine edge_values_implicit_h4( N, h, u, edge_values, h_neglect ) +subroutine edge_values_implicit_h4( N, h, u, edge_val, h_neglect ) + integer, intent(in) :: N !< Number of cells + real, dimension(:), intent(in) :: h !< cell widths (size N) + real, dimension(:), intent(in) :: u !< cell average properties (size N) + real, dimension(:,:), intent(inout) :: edge_val !< Returned edge values, with the + !! same units as u; the second index size is 2. + real, optional, intent(in) :: h_neglect !< A negligibly small width + !! in the same units as h. ! ----------------------------------------------------------------------------- ! Compute edge values based on fourth-order implicit estimates. ! @@ -515,15 +510,6 @@ subroutine edge_values_implicit_h4( N, h, u, edge_values, h_neglect ) ! boundary conditions close the system. ! ----------------------------------------------------------------------------- - ! Arguments - integer, intent(in) :: N !< Number of cells - real, dimension(:), intent(in) :: h !< cell widths (size N) - real, dimension(:), intent(in) :: u !< cell average properties (size N) - real, dimension(:,:), intent(inout) :: edge_values !< Returned edge values, with the - !! same units as u; the second index size is 2. - real, optional, intent(in) :: h_neglect !< A negligibly small width - !! in the same units as h. - ! Local variables integer :: i, j ! loop indexes real :: h0, h1 ! cell widths @@ -627,18 +613,25 @@ subroutine edge_values_implicit_h4( N, h, u, edge_values, h_neglect ) call solve_tridiagonal_system( tri_l, tri_d, tri_u, tri_b, tri_x, N+1 ) do i = 2,N - edge_values(i,1) = tri_x(i) - edge_values(i-1,2) = tri_x(i) + edge_val(i,1) = tri_x(i) + edge_val(i-1,2) = tri_x(i) end do - edge_values(1,1) = tri_x(1) - edge_values(N,2) = tri_x(N+1) + edge_val(1,1) = tri_x(1) + edge_val(N,2) = tri_x(N+1) end subroutine edge_values_implicit_h4 !------------------------------------------------------------------------------ !> Compute ih6 edge values (implicit sixth order accurate) -subroutine edge_values_implicit_h6( N, h, u, edge_values, h_neglect ) +subroutine edge_values_implicit_h6( N, h, u, edge_val, h_neglect ) + integer, intent(in) :: N !< Number of cells + real, dimension(:), intent(in) :: h !< cell widths (size N) + real, dimension(:), intent(in) :: u !< cell average properties (size N) + real, dimension(:,:), intent(inout) :: edge_val !< Returned edge values, with the + !! same units as u; the second index size is 2. + real, optional, intent(in) :: h_neglect !< A negligibly small width + !! in the same units as h. ! ----------------------------------------------------------------------------- ! Sixth-order implicit estimates of edge values are based on a four-cell, ! three-edge stencil. A tridiagonal system is set up and is based on @@ -672,15 +665,6 @@ subroutine edge_values_implicit_h6( N, h, u, edge_values, h_neglect ) ! on nonuniform meshes turned out to be intractable. ! ----------------------------------------------------------------------------- - ! Arguments - integer, intent(in) :: N !< Number of cells - real, dimension(:), intent(in) :: h !< cell widths (size N) - real, dimension(:), intent(in) :: u !< cell average properties (size N) - real, dimension(:,:), intent(inout) :: edge_values !< Returned edge values, with the - !! same units as u; the second index size is 2. - real, optional, intent(in) :: h_neglect !< A negligibly small width - !! in the same units as h. - ! Local variables integer :: i, j, k ! loop indexes real :: h0, h1, h2, h3 ! cell widths @@ -1124,11 +1108,11 @@ subroutine edge_values_implicit_h6( N, h, u, edge_values, h_neglect ) call solve_tridiagonal_system( tri_l, tri_d, tri_u, tri_b, tri_x, N+1 ) do i = 2,N - edge_values(i,1) = tri_x(i) - edge_values(i-1,2) = tri_x(i) + edge_val(i,1) = tri_x(i) + edge_val(i-1,2) = tri_x(i) end do - edge_values(1,1) = tri_x(1) - edge_values(N,2) = tri_x(N+1) + edge_val(1,1) = tri_x(1) + edge_val(N,2) = tri_x(N+1) end subroutine edge_values_implicit_h6 diff --git a/src/ALE/regrid_interp.F90 b/src/ALE/regrid_interp.F90 index 6858e0cded..d9d2a19228 100644 --- a/src/ALE/regrid_interp.F90 +++ b/src/ALE/regrid_interp.F90 @@ -18,8 +18,7 @@ module regrid_interp implicit none ; private -type, public :: interp_CS_type - private +type, public :: interp_CS_type ; private !> The following parameter is only relevant when used with the target !! interface densities regridding scheme. It indicates which interpolation @@ -476,7 +475,9 @@ end function get_polynomial_coordinate !> Numeric value of interpolation_scheme corresponding to scheme name integer function interpolation_scheme(interp_scheme) - character(len=*), intent(in) :: interp_scheme !< Name of interpolation scheme + character(len=*), intent(in) :: interp_scheme !< Name of the interpolation scheme + !! Valid values include "P1M_H2", "P1M_H4", "P1M_IH2", "PLM", "PPM_H4", + !! "PPM_IH4", "P3M_IH4IH3", "P3M_IH6IH5", "PQM_IH4IH3", and "PQM_IH6IH5" select case ( uppercase(trim(interp_scheme)) ) case ("P1M_H2"); interpolation_scheme = INTERPOLATION_P1M_H2 @@ -494,18 +495,23 @@ integer function interpolation_scheme(interp_scheme) end select end function interpolation_scheme +!> Store the interpolation_scheme value in the interp_CS based on the input string. subroutine set_interp_scheme(CS, interp_scheme) - type(interp_CS_type), intent(inout) :: CS - character(len=*), intent(in) :: interp_scheme + type(interp_CS_type), intent(inout) :: CS !< A control structure for regrid_interp + character(len=*), intent(in) :: interp_scheme !< Name of the interpolation scheme + !! Valid values include "P1M_H2", "P1M_H4", "P1M_IH2", "PLM", "PPM_H4", + !! "PPM_IH4", "P3M_IH4IH3", "P3M_IH6IH5", "PQM_IH4IH3", and "PQM_IH6IH5" CS%interpolation_scheme = interpolation_scheme(interp_scheme) end subroutine set_interp_scheme -subroutine set_interp_extrap(CS, extrapolation) - type(interp_CS_type), intent(inout) :: CS - logical, intent(in) :: extrapolation +!> Store the boundary_extrapolation value in the interp_CS +subroutine set_interp_extrap(CS, extrap) + type(interp_CS_type), intent(inout) :: CS !< A control structure for regrid_interp + logical, intent(in) :: extrap !< Indicate whether high-order boundary + !! extrapolation should be used in boundary cells - CS%boundary_extrapolation = extrapolation + CS%boundary_extrapolation = extrap end subroutine set_interp_extrap end module regrid_interp diff --git a/src/ALE/regrid_solvers.F90 b/src/ALE/regrid_solvers.F90 index 1f15f97d1b..7e44039831 100644 --- a/src/ALE/regrid_solvers.F90 +++ b/src/ALE/regrid_solvers.F90 @@ -25,21 +25,18 @@ module regrid_solvers contains ! ----------------------------------------------------------------------------- -! Solve the linear system AX = B -! ----------------------------------------------------------------------------- +!> Solve the linear system AX = B by Gaussian elimination subroutine solve_linear_system( A, B, X, system_size ) + real, dimension(:,:), intent(inout) :: A !< The matrix being inverted + real, dimension(:), intent(inout) :: B !< system right-hand side + real, dimension(:), intent(inout) :: X !< solution vector + integer, intent(in) :: system_size !< The size of the system ! ----------------------------------------------------------------------------- ! This routine uses Gauss's algorithm to transform the system's original ! matrix into an upper triangular matrix. Back substitution yields the answer. ! The matrix A must be square and its size must be that of the vectors B and X. ! ----------------------------------------------------------------------------- - ! Arguments - real, dimension(:,:), intent(inout) :: A - real, dimension(:), intent(inout) :: B - real, dimension(:), intent(inout) :: X - integer :: system_size - ! Local variables integer :: i, j, k real, parameter :: eps = 0.0 ! Minimum pivot magnitude allowed @@ -127,18 +124,18 @@ end subroutine solve_linear_system ! ----------------------------------------------------------------------------- -! Solve the tridiagonal system AX = B -! ----------------------------------------------------------------------------- +!> Solve the tridiagonal system AX = B subroutine solve_tridiagonal_system( Al, Ad, Au, B, X, system_size ) + real, dimension(:), intent(inout) :: Ad !< Maxtix center diagonal + real, dimension(:), intent(inout) :: Al !< Matrix lower diagonal + real, dimension(:), intent(inout) :: Au !< Matrix upper diagonal + real, dimension(:), intent(inout) :: B !< system right-hand side + real, dimension(:), intent(inout) :: X !< solution vector + integer, intent(in) :: system_size !< The size of the system ! ----------------------------------------------------------------------------- ! This routine uses Thomas's algorithm to solve the tridiagonal system AX = B. ! (A is made up of lower, middle and upper diagonals) ! ----------------------------------------------------------------------------- - ! Arguments - real, dimension(:), intent(inout) :: Al, Ad, Au ! lo., mid. and up. diagonals - real, dimension(:), intent(inout) :: B ! system right-hand side - real, dimension(:), intent(inout) :: X ! solution vector - integer, intent(in) :: system_size ! Local variables integer :: k ! Loop index From 0de48ecc3f177f8e2f5768bf8376948d4ce61878 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 6 May 2018 12:33:23 -0400 Subject: [PATCH 0192/1072] Stacked common-extent loops in MOM_ALE Combined i- and j- loops with the same interior code on the same line. All answers are bitwise identical. --- src/ALE/MOM_ALE.F90 | 288 ++++++++++++++++++++------------------------ 1 file changed, 133 insertions(+), 155 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index c39dbec562..e4d297ddc8 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -361,12 +361,10 @@ subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt, frac_shelf_h) ! Override old grid with new one. The new grid 'h_new' is built in ! one of the 'build_...' routines above. -!$OMP parallel do default(none) shared(isc,iec,jsc,jec,nk,h,h_new,CS) - do k = 1,nk - do j = jsc-1,jec+1 ; do i = isc-1,iec+1 - h(i,j,k) = h_new(i,j,k) - enddo ; enddo - enddo + !$OMP parallel do default(shared) + do k = 1,nk ; do j = jsc-1,jec+1 ; do i = isc-1,iec+1 + h(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo if (CS%show_call_tree) call callTree_leave("ALE_main()") @@ -418,12 +416,10 @@ subroutine ALE_main_offline( G, GV, h, tv, Reg, CS, dt) ! Override old grid with new one. The new grid 'h_new' is built in ! one of the 'build_...' routines above. -!$OMP parallel do default(none) shared(isc,iec,jsc,jec,nk,h,h_new,CS) - do k = 1,nk - do j = jsc-1,jec+1 ; do i = isc-1,iec+1 - h(i,j,k) = h_new(i,j,k) - enddo ; enddo - enddo + !$OMP parallel do default(shared) + do k = 1,nk ; do j = jsc-1,jec+1 ; do i = isc-1,iec+1 + h(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo if (CS%show_call_tree) call callTree_leave("ALE_main()") if (CS%id_dzRegrid>0 .and. present(dt)) call post_data(CS%id_dzRegrid, dzRegrid, CS%diag) @@ -494,7 +490,7 @@ subroutine ALE_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug) endif call interpolate_column(nk, h(i,j,:), Kd(i,j,:), nk, h_new(i,j,:), 0., Kd(i,j,:)) endif - enddo ; enddo; + enddo ; enddo call ALE_remap_scalar(CS%remapCS, G, GV, nk, h, tv%T, h_new, tv%T) call ALE_remap_scalar(CS%remapCS, G, GV, nk, h, tv%S, h_new, tv%S) @@ -651,7 +647,7 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n, u, v, Reg, dt, dzRegrid, integer :: i, j, k, nz type(thermo_var_ptrs) :: tv_local ! local/intermediate temp/salt type(group_pass_type) :: pass_T_S_h ! group pass if the coordinate has a stencil - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_loc, h_orig ! A working copy of layer thickesses + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_loc, h_orig ! A working copy of layer thicknesses real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), target :: T, S ! local temporary state ! we have to keep track of the total dzInterface if for some reason ! we're using the old remapping algorithm for u/v @@ -778,33 +774,29 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, !$OMP parallel do default(shared) private(h1,h2,u_column,Tr) do m=1,ntr ! For each tracer Tr => Reg%Tr(m) - do j = G%jsc,G%jec - do i = G%isc,G%iec - if (G%mask2dT(i,j)>0.) then - ! Build the start and final grids - h1(:) = h_old(i,j,:) - h2(:) = h_new(i,j,:) - call remapping_core_h(CS_remapping, nz, h1, Tr%t(i,j,:), nz, h2, & - u_column, h_neglect, h_neglect_edge) - - ! Intermediate steps for tendency of tracer concentration and tracer content. - if (present(dt)) then - if (Tr%id_remap_conc>0) then - do k=1,GV%ke - work_conc(i,j,k) = (u_column(k) - Tr%t(i,j,k) ) * Idt - enddo - endif - if (Tr%id_remap_cont>0. .or. Tr%id_remap_cont_2d>0) then - do k=1,GV%ke - work_cont(i,j,k) = (u_column(k)*h2(k) - Tr%t(i,j,k)*h1(k)) * Idt - enddo - endif - endif - ! update tracer concentration - Tr%t(i,j,:) = u_column(:) + do j = G%jsc,G%jec ; do i = G%isc,G%iec ; if (G%mask2dT(i,j)>0.) then + ! Build the start and final grids + h1(:) = h_old(i,j,:) + h2(:) = h_new(i,j,:) + call remapping_core_h(CS_remapping, nz, h1, Tr%t(i,j,:), nz, h2, & + u_column, h_neglect, h_neglect_edge) + + ! Intermediate steps for tendency of tracer concentration and tracer content. + if (present(dt)) then + if (Tr%id_remap_conc>0) then + do k=1,GV%ke + work_conc(i,j,k) = (u_column(k) - Tr%t(i,j,k) ) * Idt + enddo + endif + if (Tr%id_remap_cont>0. .or. Tr%id_remap_cont_2d>0) then + do k=1,GV%ke + work_cont(i,j,k) = (u_column(k)*h2(k) - Tr%t(i,j,k)*h1(k)) * Idt + enddo endif - enddo ! i - enddo ! j + endif + ! update tracer concentration + Tr%t(i,j,:) = u_column(:) + endif ; enddo ; enddo ! tendency diagnostics. if (Tr%id_remap_conc > 0) then @@ -814,14 +806,12 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, call post_data(Tr%id_remap_cont, work_cont, CS_ALE%diag) endif if (Tr%id_remap_cont_2d > 0) then - do j = G%jsc,G%jec - do i = G%isc,G%iec - work_2d(i,j) = 0.0 - do k = 1,GV%ke - work_2d(i,j) = work_2d(i,j) + work_cont(i,j,k) - enddo + do j = G%jsc,G%jec ; do i = G%isc,G%iec + work_2d(i,j) = 0.0 + do k = 1,GV%ke + work_2d(i,j) = work_2d(i,j) + work_cont(i,j,k) enddo - enddo + enddo ; enddo call post_data(Tr%id_remap_cont_2d, work_2d, CS_ALE%diag) endif @@ -834,25 +824,21 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, ! Remap u velocity component if ( present(u) ) then !$OMP parallel do default(shared) private(h1,h2,dx,u_column) - do j = G%jsc,G%jec - do I = G%iscB,G%iecB - if (G%mask2dCu(I,j)>0.) then - ! Build the start and final grids - h1(:) = 0.5 * ( h_old(i,j,:) + h_old(i+1,j,:) ) - if (CS_ALE%remap_uv_using_old_alg) then - dx(:) = 0.5 * ( dxInterface(i,j,:) + dxInterface(i+1,j,:) ) - do k = 1, nz - h2(k) = max( 0., h1(k) + ( dx(k+1) - dx(k) ) ) - enddo - else - h2(:) = 0.5 * ( h_new(i,j,:) + h_new(i+1,j,:) ) - endif - call remapping_core_h(CS_remapping, nz, h1, u(I,j,:), nz, h2, & - u_column, h_neglect, h_neglect_edge) - u(I,j,:) = u_column(:) - endif - enddo - enddo + do j = G%jsc,G%jec ; do I = G%iscB,G%iecB ; if (G%mask2dCu(I,j)>0.) then + ! Build the start and final grids + h1(:) = 0.5 * ( h_old(i,j,:) + h_old(i+1,j,:) ) + if (CS_ALE%remap_uv_using_old_alg) then + dx(:) = 0.5 * ( dxInterface(i,j,:) + dxInterface(i+1,j,:) ) + do k = 1, nz + h2(k) = max( 0., h1(k) + ( dx(k+1) - dx(k) ) ) + enddo + else + h2(:) = 0.5 * ( h_new(i,j,:) + h_new(i+1,j,:) ) + endif + call remapping_core_h(CS_remapping, nz, h1, u(I,j,:), nz, h2, & + u_column, h_neglect, h_neglect_edge) + u(I,j,:) = u_column(:) + endif ; enddo ; enddo endif if (show_call_tree) call callTree_waypoint("u remapped (remap_all_state_vars)") @@ -860,25 +846,21 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, ! Remap v velocity component if ( present(v) ) then !$OMP parallel do default(shared) private(h1,h2,dx,u_column) - do J = G%jscB,G%jecB - do i = G%isc,G%iec - if (G%mask2dCv(i,j)>0.) then - ! Build the start and final grids - h1(:) = 0.5 * ( h_old(i,j,:) + h_old(i,j+1,:) ) - if (CS_ALE%remap_uv_using_old_alg) then - dx(:) = 0.5 * ( dxInterface(i,j,:) + dxInterface(i,j+1,:) ) - do k = 1, nz - h2(k) = max( 0., h1(k) + ( dx(k+1) - dx(k) ) ) - enddo - else - h2(:) = 0.5 * ( h_new(i,j,:) + h_new(i,j+1,:) ) - endif - call remapping_core_h(CS_remapping, nz, h1, v(i,J,:), nz, h2, & - u_column, h_neglect, h_neglect_edge) - v(i,J,:) = u_column(:) - endif - enddo - enddo + do J = G%jscB,G%jecB ; do i = G%isc,G%iec ; if (G%mask2dCv(i,j)>0.) then + ! Build the start and final grids + h1(:) = 0.5 * ( h_old(i,j,:) + h_old(i,j+1,:) ) + if (CS_ALE%remap_uv_using_old_alg) then + dx(:) = 0.5 * ( dxInterface(i,j,:) + dxInterface(i,j+1,:) ) + do k = 1, nz + h2(k) = max( 0., h1(k) + ( dx(k+1) - dx(k) ) ) + enddo + else + h2(:) = 0.5 * ( h_new(i,j,:) + h_new(i,j+1,:) ) + endif + call remapping_core_h(CS_remapping, nz, h1, v(i,J,:), nz, h2, & + u_column, h_neglect, h_neglect_edge) + v(i,J,:) = u_column(:) + endif ; enddo ; enddo endif if (CS_ALE%id_vert_remap_h > 0) call post_data(CS_ALE%id_vert_remap_h, h_old, CS_ALE%diag) @@ -996,38 +978,36 @@ subroutine pressure_gradient_plm( CS, S_t, S_b, T_t, T_b, G, GV, tv, h, bdry_ext ! Determine reconstruction within each column !$OMP parallel do default(shared) private(hTmp,ppol_E,ppol_coefs,tmp) - do j = G%jsc-1,G%jec+1 - do i = G%isc-1,G%iec+1 - ! Build current grid - hTmp(:) = h(i,j,:) - tmp(:) = tv%S(i,j,:) - ! Reconstruct salinity profile - ppol_E(:,:) = 0.0 - ppol_coefs(:,:) = 0.0 - call PLM_reconstruction( GV%ke, hTmp, tmp, ppol_E, ppol_coefs, h_neglect ) - if (bdry_extrap) call & - PLM_boundary_extrapolation( GV%ke, hTmp, tmp, ppol_E, ppol_coefs, h_neglect ) - - do k = 1,GV%ke - S_t(i,j,k) = ppol_E(k,1) - S_b(i,j,k) = ppol_E(k,2) - end do - - ! Reconstruct temperature profile - ppol_E(:,:) = 0.0 - ppol_coefs(:,:) = 0.0 - tmp(:) = tv%T(i,j,:) - call PLM_reconstruction( GV%ke, hTmp, tmp, ppol_E, ppol_coefs, h_neglect ) - if (bdry_extrap) call & - PLM_boundary_extrapolation( GV%ke, hTmp, tmp, ppol_E, ppol_coefs, h_neglect ) - - do k = 1,GV%ke - T_t(i,j,k) = ppol_E(k,1) - T_b(i,j,k) = ppol_E(k,2) - end do - - end do - end do + do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 + ! Build current grid + hTmp(:) = h(i,j,:) + tmp(:) = tv%S(i,j,:) + ! Reconstruct salinity profile + ppol_E(:,:) = 0.0 + ppol_coefs(:,:) = 0.0 + call PLM_reconstruction( GV%ke, hTmp, tmp, ppol_E, ppol_coefs, h_neglect ) + if (bdry_extrap) & + call PLM_boundary_extrapolation( GV%ke, hTmp, tmp, ppol_E, ppol_coefs, h_neglect ) + + do k = 1,GV%ke + S_t(i,j,k) = ppol_E(k,1) + S_b(i,j,k) = ppol_E(k,2) + enddo + + ! Reconstruct temperature profile + ppol_E(:,:) = 0.0 + ppol_coefs(:,:) = 0.0 + tmp(:) = tv%T(i,j,:) + call PLM_reconstruction( GV%ke, hTmp, tmp, ppol_E, ppol_coefs, h_neglect ) + if (bdry_extrap) & + call PLM_boundary_extrapolation( GV%ke, hTmp, tmp, ppol_E, ppol_coefs, h_neglect ) + + do k = 1,GV%ke + T_t(i,j,k) = ppol_E(k,1) + T_b(i,j,k) = ppol_E(k,2) + enddo + + enddo ; enddo end subroutine pressure_gradient_plm @@ -1074,44 +1054,42 @@ subroutine pressure_gradient_ppm( CS, S_t, S_b, T_t, T_b, G, GV, tv, h, bdry_ext ! Determine reconstruction within each column !$OMP parallel do default(shared) private(hTmp,tmp,ppol_E,ppol_coefs) - do j = G%jsc-1,G%jec+1 - do i = G%isc-1,G%iec+1 - - ! Build current grid - hTmp(:) = h(i,j,:) - tmp(:) = tv%S(i,j,:) - - ! Reconstruct salinity profile - ppol_E(:,:) = 0.0 - ppol_coefs(:,:) = 0.0 - !### Try to replace the following value of h_neglect with GV%H_subroundoff. - call edge_values_implicit_h4( GV%ke, hTmp, tmp, ppol_E, h_neglect=h_neglect_edge ) - call PPM_reconstruction( GV%ke, hTmp, tmp, ppol_E, ppol_coefs, h_neglect ) - if (bdry_extrap) call & - PPM_boundary_extrapolation( GV%ke, hTmp, tmp, ppol_E, ppol_coefs, h_neglect ) - - do k = 1,GV%ke - S_t(i,j,k) = ppol_E(k,1) - S_b(i,j,k) = ppol_E(k,2) - end do - - ! Reconstruct temperature profile - ppol_E(:,:) = 0.0 - ppol_coefs(:,:) = 0.0 - tmp(:) = tv%T(i,j,:) - !### Try to replace the following value of h_neglect with GV%H_subroundoff. - call edge_values_implicit_h4( GV%ke, hTmp, tmp, ppol_E, h_neglect=1.0e-10*GV%m_to_H ) - call PPM_reconstruction( GV%ke, hTmp, tmp, ppol_E, ppol_coefs, h_neglect ) - if (bdry_extrap) call & - PPM_boundary_extrapolation(GV%ke, hTmp, tmp, ppol_E, ppol_coefs, h_neglect ) - - do k = 1,GV%ke - T_t(i,j,k) = ppol_E(k,1) - T_b(i,j,k) = ppol_E(k,2) - end do - - end do - end do + do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 + + ! Build current grid + hTmp(:) = h(i,j,:) + tmp(:) = tv%S(i,j,:) + + ! Reconstruct salinity profile + ppol_E(:,:) = 0.0 + ppol_coefs(:,:) = 0.0 + !### Try to replace the following value of h_neglect with GV%H_subroundoff. + call edge_values_implicit_h4( GV%ke, hTmp, tmp, ppol_E, h_neglect=h_neglect_edge ) + call PPM_reconstruction( GV%ke, hTmp, tmp, ppol_E, ppol_coefs, h_neglect ) + if (bdry_extrap) & + call PPM_boundary_extrapolation( GV%ke, hTmp, tmp, ppol_E, ppol_coefs, h_neglect ) + + do k = 1,GV%ke + S_t(i,j,k) = ppol_E(k,1) + S_b(i,j,k) = ppol_E(k,2) + enddo + + ! Reconstruct temperature profile + ppol_E(:,:) = 0.0 + ppol_coefs(:,:) = 0.0 + tmp(:) = tv%T(i,j,:) + !### Try to replace the following value of h_neglect with GV%H_subroundoff. + call edge_values_implicit_h4( GV%ke, hTmp, tmp, ppol_E, h_neglect=1.0e-10*GV%m_to_H ) + call PPM_reconstruction( GV%ke, hTmp, tmp, ppol_E, ppol_coefs, h_neglect ) + if (bdry_extrap) & + call PPM_boundary_extrapolation(GV%ke, hTmp, tmp, ppol_E, ppol_coefs, h_neglect ) + + do k = 1,GV%ke + T_t(i,j,k) = ppol_E(k,1) + T_b(i,j,k) = ppol_E(k,2) + enddo + + enddo ; enddo end subroutine pressure_gradient_ppm From a9605fb8d88ddfe9608c1a5cf768db6561df07dd Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 6 May 2018 12:34:29 -0400 Subject: [PATCH 0193/1072] Shortened long variable names in MOM_remapping.F90 Renamed several ..._coeffients variables as ..._coef, for brevity of expressions. All answers are bitwise identical. --- src/ALE/MOM_remapping.F90 | 369 +++++++++++++++++++------------------- 1 file changed, 185 insertions(+), 184 deletions(-) diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index dee2e20bd8..10ba747d14 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -177,8 +177,7 @@ function isPosSumErrSignificant(n1, sum1, n2, sum2) endif end function isPosSumErrSignificant -!> Remaps column of values u0 on grid h0 to grid h1 -!! assuming the top edge is aligned. +!> Remaps column of values u0 on grid h0 to grid h1 assuming the top edge is aligned. subroutine remapping_core_h(CS, n0, h0, u0, n1, h1, u1, h_neglect, h_neglect_edge) type(remapping_CS), intent(in) :: CS !< Remapping control structure integer, intent(in) :: n0 !< Number of cells on source grid @@ -197,7 +196,7 @@ subroutine remapping_core_h(CS, n0, h0, u0, n1, h1, u1, h_neglect, h_neglect_ed integer :: iMethod real, dimension(n0,2) :: ppoly_r_E !Edge value of polynomial real, dimension(n0,2) :: ppoly_r_S !Edge slope of polynomial - real, dimension(n0,CS%degree+1) :: ppoly_r_coefficients !Coefficients of polynomial + real, dimension(n0,CS%degree+1) :: ppoly_r_coefs !Coefficients of polynomial integer :: k real :: eps, h0tot, h0err, h1tot, h1err, u0tot, u0err, u0min, u0max, u1tot, u1err, u1min, u1max, uh_err real :: hNeglect, hNeglect_edge @@ -205,14 +204,14 @@ subroutine remapping_core_h(CS, n0, h0, u0, n1, h1, u1, h_neglect, h_neglect_ed hNeglect = 1.0e-30 ; if (present(h_neglect)) hNeglect = h_neglect hNeglect_edge = 1.0e-10 ; if (present(h_neglect_edge)) hNeglect_edge = h_neglect_edge - call build_reconstructions_1d( CS, n0, h0, u0, ppoly_r_coefficients, ppoly_r_E, ppoly_r_S, iMethod, & + call build_reconstructions_1d( CS, n0, h0, u0, ppoly_r_coefs, ppoly_r_E, ppoly_r_S, iMethod, & hNeglect, hNeglect_edge ) if (CS%check_reconstruction) call check_reconstructions_1d(n0, h0, u0, CS%degree, & - CS%boundary_extrapolation, ppoly_r_coefficients, ppoly_r_E, ppoly_r_S) + CS%boundary_extrapolation, ppoly_r_coefs, ppoly_r_E, ppoly_r_S) - call remap_via_sub_cells( n0, h0, u0, ppoly_r_E, ppoly_r_coefficients, n1, h1, iMethod, & + call remap_via_sub_cells( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, n1, h1, iMethod, & CS%force_bounds_in_subcell, u1, uh_err ) if (CS%check_remapping) then @@ -245,7 +244,7 @@ subroutine remapping_core_h(CS, n0, h0, u0, n1, h1, u1, h_neglect, h_neglect_ed enddo write(0,'(a3,2a24)') 'k','u0','Polynomial coefficients' do k = 1, n0 - write(0,'(i3,1p6e24.16)') k,u0(k),ppoly_r_coefficients(k,:) + write(0,'(i3,1p6e24.16)') k,u0(k),ppoly_r_coefs(k,:) enddo call MOM_error( FATAL, 'MOM_remapping, remapping_core_h: '//& 'Remapping result is inconsistent!' ) @@ -275,7 +274,7 @@ subroutine remapping_core_w( CS, n0, h0, u0, n1, dx, u1, h_neglect, h_neglect_ed integer :: iMethod real, dimension(n0,2) :: ppoly_r_E !Edge value of polynomial real, dimension(n0,2) :: ppoly_r_S !Edge slope of polynomial - real, dimension(n0,CS%degree+1) :: ppoly_r_coefficients !Coefficients of polynomial + real, dimension(n0,CS%degree+1) :: ppoly_r_coefs !Coefficients of polynomial integer :: k real :: eps, h0tot, h0err, h1tot, h1err real :: u0tot, u0err, u0min, u0max, u1tot, u1err, u1min, u1max, uh_err @@ -285,11 +284,11 @@ subroutine remapping_core_w( CS, n0, h0, u0, n1, dx, u1, h_neglect, h_neglect_ed hNeglect = 1.0e-30 ; if (present(h_neglect)) hNeglect = h_neglect hNeglect_edge = 1.0e-10 ; if (present(h_neglect_edge)) hNeglect_edge = h_neglect_edge - call build_reconstructions_1d( CS, n0, h0, u0, ppoly_r_coefficients, ppoly_r_E, ppoly_r_S, iMethod,& + call build_reconstructions_1d( CS, n0, h0, u0, ppoly_r_coefs, ppoly_r_E, ppoly_r_S, iMethod,& hNeglect, hNeglect_edge ) if (CS%check_reconstruction) call check_reconstructions_1d(n0, h0, u0, CS%degree, & - CS%boundary_extrapolation, ppoly_r_coefficients, ppoly_r_E, ppoly_r_S) + CS%boundary_extrapolation, ppoly_r_coefs, ppoly_r_E, ppoly_r_S) ! This is a temporary step prior to switching to remapping_core_h() do k = 1, n1 @@ -299,9 +298,9 @@ subroutine remapping_core_w( CS, n0, h0, u0, n1, dx, u1, h_neglect, h_neglect_ed h1(k) = max( 0., dx(k+1) - dx(k) ) endif enddo - call remap_via_sub_cells( n0, h0, u0, ppoly_r_E, ppoly_r_coefficients, n1, h1, iMethod, & + call remap_via_sub_cells( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, n1, h1, iMethod, & CS%force_bounds_in_subcell,u1, uh_err ) -! call remapByDeltaZ( n0, h0, u0, ppoly_r_E, ppoly_r_coefficients, n1, dx, iMethod, u1, hNeglect ) +! call remapByDeltaZ( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, n1, dx, iMethod, u1, hNeglect ) ! call remapByProjection( n0, h0, u0, CS%ppoly_r, n1, h1, iMethod, u1, hNeglect ) if (CS%check_remapping) then @@ -334,7 +333,7 @@ subroutine remapping_core_w( CS, n0, h0, u0, n1, dx, u1, h_neglect, h_neglect_ed enddo write(0,'(a3,2a24)') 'k','u0','Polynomial coefficients' do k = 1, n0 - write(0,'(i3,1p6e24.16)') k,u0(k),ppoly_r_coefficients(k,:) + write(0,'(i3,1p6e24.16)') k,u0(k),ppoly_r_coefs(k,:) enddo call MOM_error( FATAL, 'MOM_remapping, remapping_core_w: '//& 'Remapping result is inconsistent!' ) @@ -345,15 +344,15 @@ subroutine remapping_core_w( CS, n0, h0, u0, n1, dx, u1, h_neglect, h_neglect_ed end subroutine remapping_core_w !> Creates polynomial reconstructions of u0 on the source grid h0. -subroutine build_reconstructions_1d( CS, n0, h0, u0, ppoly_r_coefficients, & +subroutine build_reconstructions_1d( CS, n0, h0, u0, ppoly_r_coefs, & ppoly_r_E, ppoly_r_S, iMethod, h_neglect, & h_neglect_edge ) - type(remapping_CS), intent(in) :: CS + type(remapping_CS), intent(in) :: CS !< Remapping control structure integer, intent(in) :: n0 !< Number of cells on source grid real, dimension(n0), intent(in) :: h0 !< Cell widths on source grid real, dimension(n0), intent(in) :: u0 !< Cell averages on source grid real, dimension(n0,CS%degree+1), & - intent(out) :: ppoly_r_coefficients !< Coefficients of polynomial + intent(out) :: ppoly_r_coefs !< Coefficients of polynomial real, dimension(n0,2), intent(out) :: ppoly_r_E !< Edge value of polynomial real, dimension(n0,2), intent(out) :: ppoly_r_S !< Edge slope of polynomial integer, intent(out) :: iMethod !< Integration method @@ -371,7 +370,7 @@ subroutine build_reconstructions_1d( CS, n0, h0, u0, ppoly_r_coefficients, & ! Reset polynomial ppoly_r_E(:,:) = 0.0 ppoly_r_S(:,:) = 0.0 - ppoly_r_coefficients(:,:) = 0.0 + ppoly_r_coefs(:,:) = 0.0 iMethod = -999 local_remapping_scheme = CS%remapping_scheme @@ -384,44 +383,44 @@ subroutine build_reconstructions_1d( CS, n0, h0, u0, ppoly_r_coefficients, & endif select case ( local_remapping_scheme ) case ( REMAPPING_PCM ) - call PCM_reconstruction( n0, u0, ppoly_r_E, ppoly_r_coefficients) + call PCM_reconstruction( n0, u0, ppoly_r_E, ppoly_r_coefs) iMethod = INTEGRATION_PCM case ( REMAPPING_PLM ) - call PLM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefficients, h_neglect ) + call PLM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect ) if ( CS%boundary_extrapolation ) then - call PLM_boundary_extrapolation( n0, h0, u0, ppoly_r_E, ppoly_r_coefficients, h_neglect) + call PLM_boundary_extrapolation( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect) end if iMethod = INTEGRATION_PLM case ( REMAPPING_PPM_H4 ) call edge_values_explicit_h4( n0, h0, u0, ppoly_r_E, h_neglect_edge ) - call PPM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefficients, h_neglect ) + call PPM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect ) if ( CS%boundary_extrapolation ) then - call PPM_boundary_extrapolation( n0, h0, u0, ppoly_r_E, ppoly_r_coefficients, h_neglect ) + call PPM_boundary_extrapolation( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect ) end if iMethod = INTEGRATION_PPM case ( REMAPPING_PPM_IH4 ) call edge_values_implicit_h4( n0, h0, u0, ppoly_r_E, h_neglect_edge ) - call PPM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefficients, h_neglect ) + call PPM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect ) if ( CS%boundary_extrapolation ) then - call PPM_boundary_extrapolation( n0, h0, u0, ppoly_r_E, ppoly_r_coefficients, h_neglect ) + call PPM_boundary_extrapolation( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect ) end if iMethod = INTEGRATION_PPM case ( REMAPPING_PQM_IH4IH3 ) call edge_values_implicit_h4( n0, h0, u0, ppoly_r_E, h_neglect_edge ) call edge_slopes_implicit_h3( n0, h0, u0, ppoly_r_S, h_neglect ) - call PQM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_S, ppoly_r_coefficients, h_neglect ) + call PQM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_S, ppoly_r_coefs, h_neglect ) if ( CS%boundary_extrapolation ) then call PQM_boundary_extrapolation_v1( n0, h0, u0, ppoly_r_E, ppoly_r_S, & - ppoly_r_coefficients, h_neglect ) + ppoly_r_coefs, h_neglect ) end if iMethod = INTEGRATION_PQM case ( REMAPPING_PQM_IH6IH5 ) call edge_values_implicit_h6( n0, h0, u0, ppoly_r_E, h_neglect_edge ) call edge_slopes_implicit_h5( n0, h0, u0, ppoly_r_S, h_neglect ) - call PQM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_S, ppoly_r_coefficients, h_neglect ) + call PQM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_S, ppoly_r_coefs, h_neglect ) if ( CS%boundary_extrapolation ) then call PQM_boundary_extrapolation_v1( n0, h0, u0, ppoly_r_E, ppoly_r_S, & - ppoly_r_coefficients, h_neglect ) + ppoly_r_coefs, h_neglect ) end if iMethod = INTEGRATION_PQM case default @@ -433,13 +432,13 @@ end subroutine build_reconstructions_1d !> Checks that edge values and reconstructions satisfy bounds subroutine check_reconstructions_1d(n0, h0, u0, deg, boundary_extrapolation, & - ppoly_r_coefficients, ppoly_r_E, ppoly_r_S) + ppoly_r_coefs, ppoly_r_E, ppoly_r_S) integer, intent(in) :: n0 !< Number of cells on source grid real, dimension(n0), intent(in) :: h0 !< Cell widths on source grid real, dimension(n0), intent(in) :: u0 !< Cell averages on source grid integer, intent(in) :: deg !< Degree of polynomial reconstruction logical, intent(in) :: boundary_extrapolation !< Extrapolate at boundaries if true - real, dimension(n0,deg+1),intent(out) :: ppoly_r_coefficients !< Coefficients of polynomial + real, dimension(n0,deg+1),intent(out) :: ppoly_r_coefs !< Coefficients of polynomial real, dimension(n0,2), intent(out) :: ppoly_r_E !< Edge value of polynomial real, dimension(n0,2), intent(out) :: ppoly_r_S !< Edge slope of polynomial ! Local variables @@ -490,11 +489,11 @@ subroutine check_reconstructions_1d(n0, h0, u0, deg, boundary_extrapolation, & endif endif if (problem_detected) then - write(0,'(a,1p9e24.16)') 'Polynomial coeffs:',ppoly_r_coefficients(i0,:) + write(0,'(a,1p9e24.16)') 'Polynomial coeffs:',ppoly_r_coefs(i0,:) write(0,'(3(a,1pe24.16,x))') 'u_l=',u_l,'u_c=',u_c,'u_r=',u_r write(0,'(a4,10a24)') 'i0','h0(i0)','u0(i0)','left edge','right edge','Polynomial coefficients' do n = 1, n0 - write(0,'(i4,1p10e24.16)') n,h0(n),u0(n),ppoly_r_E(n,1),ppoly_r_E(n,2),ppoly_r_coefficients(n,:) + write(0,'(i4,1p10e24.16)') n,h0(n),u0(n),ppoly_r_E(n,1),ppoly_r_E(n,2),ppoly_r_coefs(n,:) enddo call MOM_error(FATAL, 'MOM_remapping, check_reconstructions_1d: '// & 'Edge values or polynomial coefficients were inconsistent!') @@ -506,13 +505,13 @@ end subroutine check_reconstructions_1d !> Remaps column of n0 values u0 on grid h0 to grid h1 with n1 cells by calculating !! the n0+n1+1 sub-integrals of the intersection of h0 and h1, and the summing the !! appropriate integrals into the h1*u1 values. h0 and h1 must have the same units. -subroutine remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefficients, n1, h1, method, & +subroutine remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefs, n1, h1, method, & force_bounds_in_subcell, u1, uh_err, ah_sub, aisub_src, aiss, aise ) integer, intent(in) :: n0 !< Number of cells in source grid real, intent(in) :: h0(n0) !< Source grid widths (size n0) real, intent(in) :: u0(n0) !< Source cell averages (size n0) real, intent(in) :: ppoly0_E(n0,2) !< Edge value of polynomial - real, intent(in) :: ppoly0_coefficients(:,:) !< Coefficients of polynomial + real, intent(in) :: ppoly0_coefs(:,:) !< Coefficients of polynomial integer, intent(in) :: n1 !< Number of cells in target grid real, intent(in) :: h1(n1) !< Target grid widths (size n1) integer, intent(in) :: method !< Remapping scheme to use @@ -734,7 +733,7 @@ subroutine remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefficients, n1, h if (h0_eff(i0)>0.) then xb = dh0_eff / h0_eff(i0) ! This expression yields xa <= xb <= 1.0 xb = min(1., xb) ! This is only needed when the total target column is wider than the source column - u_sub(i_sub) = average_value_ppoly( n0, u0, ppoly0_E, ppoly0_coefficients, method, i0, xa, xb) + u_sub(i_sub) = average_value_ppoly( n0, u0, ppoly0_E, ppoly0_coefs, method, i0, xa, xb) else ! Vanished cell xb = 1. u_sub(i_sub) = u0(i0) @@ -745,7 +744,7 @@ subroutine remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefficients, n1, h write(0,*) 'xa,xb: ',xa,xb write(0,*) 'Edge values: ',ppoly0_E(i0,:),'mean',u0(i0) write(0,*) 'a_c: ',(u0(i0)-ppoly0_E(i0,1))+(u0(i0)-ppoly0_E(i0,2)) - write(0,*) 'Polynomial coeffs: ',ppoly0_coefficients(i0,:) + write(0,*) 'Polynomial coeffs: ',ppoly0_coefs(i0,:) write(0,*) 'Bounds min=',u0_min(i0),'max=',u0_max(i0) write(0,*) 'Average: ',u_sub(i_sub),'rel to min=',u_sub(i_sub)-u0_min(i0),'rel to max=',u_sub(i_sub)-u0_max(i0) call MOM_error( FATAL, 'MOM_remapping, remap_via_sub_cells: '//& @@ -878,7 +877,7 @@ subroutine remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefficients, n1, h enddo write(0,'(a3,2a24)') 'k','u0','Polynomial coefficients' do k = 1, n0 - write(0,'(i3,1p6e24.16)') k,u0(k),ppoly0_coefficients(k,:) + write(0,'(i3,1p6e24.16)') k,u0(k),ppoly0_coefs(k,:) enddo write(0,'(a3,3a24,a3,2a24)') 'k','Sub-cell h','Sub-cell u','Sub-cell hu','i0','xa','xb' xa = 0. @@ -917,11 +916,11 @@ end subroutine remap_via_sub_cells !> Returns the average value of a reconstruction within a single source cell, i0, !! between the non-dimensional positions xa and xb (xa<=xb) with dimensional !! separation dh. -real function average_value_ppoly( n0, u0, ppoly0_E, ppoly0_coefficients, method, i0, xa, xb) +real function average_value_ppoly( n0, u0, ppoly0_E, ppoly0_coefs, method, i0, xa, xb) integer, intent(in) :: n0 !< Number of cells in source grid real, intent(in) :: u0(:) !< Cell means - real, intent(in) :: ppoly0_E(:,:) !< Edge value of polynomial - real, intent(in) :: ppoly0_coefficients(:,:) !< Coefficients of polynomial + real, intent(in) :: ppoly0_E(:,:) !< Edge value of polynomial + real, intent(in) :: ppoly0_coefs(:,:) !< Coefficients of polynomial integer, intent(in) :: method !< Remapping scheme to use integer, intent(in) :: i0 !< Source cell index real, intent(in) :: xa !< Non-dimensional start position within source cell @@ -938,8 +937,8 @@ real function average_value_ppoly( n0, u0, ppoly0_E, ppoly0_coefficients, method u_ave = u0(i0) case ( INTEGRATION_PLM ) u_ave = ( & - ppoly0_coefficients(i0,1) & - + ppoly0_coefficients(i0,2) * 0.5 * ( xb + xa ) ) + ppoly0_coefs(i0,1) & + + ppoly0_coefs(i0,2) * 0.5 * ( xb + xa ) ) case ( INTEGRATION_PPM ) mx = 0.5 * ( xa + xb ) a_L = ppoly0_E(i0, 1) @@ -966,21 +965,21 @@ real function average_value_ppoly( n0, u0, ppoly0_E, ppoly0_coefficients, method xa2pxb2 = xa_2 + xb_2 xapxb = xa + xb u_ave = ( & - ppoly0_coefficients(i0,1) & - + ( ppoly0_coefficients(i0,2) * 0.5 * ( xapxb ) & - + ( ppoly0_coefficients(i0,3) * r_3 * ( xa2pxb2 + xa*xb ) & - + ( ppoly0_coefficients(i0,4) * 0.25* ( xa2pxb2 * xapxb ) & - + ppoly0_coefficients(i0,5) * 0.2 * ( ( xb*xb_2 + xa*xa_2 ) * xapxb + xa_2*xb_2 ) ) ) ) ) + ppoly0_coefs(i0,1) & + + ( ppoly0_coefs(i0,2) * 0.5 * ( xapxb ) & + + ( ppoly0_coefs(i0,3) * r_3 * ( xa2pxb2 + xa*xb ) & + + ( ppoly0_coefs(i0,4) * 0.25* ( xa2pxb2 * xapxb ) & + + ppoly0_coefs(i0,5) * 0.2 * ( ( xb*xb_2 + xa*xa_2 ) * xapxb + xa_2*xb_2 ) ) ) ) ) case default call MOM_error( FATAL,'The selected integration method is invalid' ) end select else ! dh == 0. select case ( method ) case ( INTEGRATION_PCM ) - u_ave = ppoly0_coefficients(i0,1) + u_ave = ppoly0_coefs(i0,1) case ( INTEGRATION_PLM ) - !u_ave = ppoly0_coefficients(i0,1) & - ! + xa * ppoly0_coefficients(i0,2) + !u_ave = ppoly0_coefs(i0,1) & + ! + xa * ppoly0_coefs(i0,2) a_L = ppoly0_E(i0, 1) a_R = ppoly0_E(i0, 2) Ya = 1. - xa @@ -990,9 +989,9 @@ real function average_value_ppoly( n0, u0, ppoly0_E, ppoly0_coefficients, method u_ave = a_R + Ya * ( a_L - a_R ) endif case ( INTEGRATION_PPM ) - !u_ave = ppoly0_coefficients(i0,1) & - ! + xa * ( ppoly0_coefficients(i0,2) & - ! + xa * ppoly0_coefficients(i0,3) ) + !u_ave = ppoly0_coefs(i0,1) & + ! + xa * ( ppoly0_coefs(i0,2) & + ! + xa * ppoly0_coefs(i0,3) ) a_L = ppoly0_E(i0, 1) a_R = ppoly0_E(i0, 2) u_c = u0(i0) @@ -1004,11 +1003,11 @@ real function average_value_ppoly( n0, u0, ppoly0_E, ppoly0_coefficients, method u_ave = a_R + Ya * ( ( a_L - a_R ) + a_c * xa ) endif case ( INTEGRATION_PQM ) - u_ave = ppoly0_coefficients(i0,1) & - + xa * ( ppoly0_coefficients(i0,2) & - + xa * ( ppoly0_coefficients(i0,3) & - + xa * ( ppoly0_coefficients(i0,4) & - + xa * ppoly0_coefficients(i0,5) ) ) ) + u_ave = ppoly0_coefs(i0,1) & + + xa * ( ppoly0_coefs(i0,2) & + + xa * ( ppoly0_coefs(i0,3) & + + xa * ( ppoly0_coefs(i0,4) & + + xa * ppoly0_coefs(i0,5) ) ) ) case default call MOM_error( FATAL,'The selected integration method is invalid' ) end select @@ -1086,13 +1085,13 @@ end subroutine measure_output_bounds !> Remaps column of values u0 on grid h0 to grid h1 by integrating !! over the projection of each h1 cell onto the h0 grid. -subroutine remapByProjection( n0, h0, u0, ppoly0_E, ppoly0_coefficients, & +subroutine remapByProjection( n0, h0, u0, ppoly0_E, ppoly0_coefs, & n1, h1, method, u1, h_neglect ) integer, intent(in) :: n0 !< Number of cells in source grid real, intent(in) :: h0(:) !< Source grid widths (size n0) real, intent(in) :: u0(:) !< Source cell averages (size n0) - real, intent(in) :: ppoly0_E(:,:) !< Edge value of polynomial - real, intent(in) :: ppoly0_coefficients(:,:) !< Coefficients of polynomial + real, intent(in) :: ppoly0_E(:,:) !< Edge value of polynomial + real, intent(in) :: ppoly0_coefs(:,:) !< Coefficients of polynomial integer, intent(in) :: n1 !< Number of cells in target grid real, intent(in) :: h1(:) !< Target grid widths (size n1) integer, intent(in) :: method !< Remapping scheme to use @@ -1117,7 +1116,7 @@ subroutine remapByProjection( n0, h0, u0, ppoly0_E, ppoly0_coefficients, & xL = xR xR = xL + h1(iTarget) - call integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefficients, method, & + call integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefs, method, & xL, xR, h1(iTarget), u1(iTarget), jStart, xStart, h_neglect ) end do ! end iTarget loop on target grid cells @@ -1134,19 +1133,20 @@ end subroutine remapByProjection !! where !! F(k) = dx1(k) qAverage !! and where qAverage is the average qOld in the region zOld(k) to zNew(k). -subroutine remapByDeltaZ( n0, h0, u0, ppoly0_E, ppoly0_coefficients, n1, dx1, & +subroutine remapByDeltaZ( n0, h0, u0, ppoly0_E, ppoly0_coefs, n1, dx1, & method, u1, h1, h_neglect ) - integer, intent(in) :: n0 !< Number of cells in source grid - real, intent(in) :: h0(:) !< Source grid widths (size n0) - real, intent(in) :: u0(:) !< Source cell averages (size n0) - real, intent(in) :: ppoly0_E(:,:) !< Edge value of polynomial - real, intent(in) :: ppoly0_coefficients(:,:) !< Coefficients of polynomial - integer, intent(in) :: n1 !< Number of cells in target grid - real, intent(in) :: dx1(:) !< Target grid edge positions (size n1+1) - integer :: method !< Remapping scheme to use - real, intent(out) :: u1(:) !< Target cell averages (size n1) - real, optional, intent(out) :: h1(:) !< Target grid widths (size n1) - real, optional, intent(in) :: h_neglect !< A negligibly small width for the + integer, intent(in) :: n0 !< Number of cells in source grid + real, dimension(:), intent(in) :: h0 !< Source grid sizes (size n0) + real, dimension(:), intent(in) :: u0 !< Source cell averages (size n0) + real, dimension(:,:), intent(in) :: ppoly0_E !< Edge value of polynomial + real, dimension(:,:), intent(in) :: ppoly0_coefs !< Coefficients of polynomial + integer, intent(in) :: n1 !< Number of cells in target grid + real, dimension(:), intent(in) :: dx1 !< Target grid edge positions (size n1+1) + integer, intent(in) :: method !< Remapping scheme to use + real, dimension(:), intent(out) :: u1 !< Target cell averages (size n1) + real, dimension(:), & + optional, intent(out) :: h1 !< Target grid widths (size n1) + real, optional, intent(in) :: h_neglect !< A negligibly small width for the !! purpose of cell reconstructions !! in the same units as h. ! Local variables @@ -1189,7 +1189,7 @@ subroutine remapByDeltaZ( n0, h0, u0, ppoly0_E, ppoly0_coefficients, n1, dx1, & ! hFlux is the positive width of the remapped volume hFlux = abs(dx1(iTarget+1)) - call integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefficients, method, & + call integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefs, method, & xL, xR, hFlux, uAve, jStart, xStart ) ! uAve is the average value of u, independent of sign of dx1 fluxR = dx1(iTarget+1)*uAve ! Includes sign of dx1 @@ -1212,22 +1212,23 @@ end subroutine remapByDeltaZ !> Integrate the reconstructed column profile over a single cell -subroutine integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefficients, method, & +subroutine integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefs, method, & xL, xR, hC, uAve, jStart, xStart, h_neglect ) - integer, intent(in) :: n0 !< Number of cells in source grid - real, intent(in) :: h0(:) !< Source grid sizes (size n0) - real, intent(in) :: u0(:) !< Source cell averages - real, intent(in) :: ppoly0_E(:,:) !< Edge value of polynomial - real, intent(in) :: ppoly0_coefficients(:,:) !< Coefficients of polynomial - integer, intent(in) :: method !< Remapping scheme to use - real, intent(in) :: xL, xR !< Left/right edges of target cell - real, intent(in) :: hC !< Cell width hC = xR - xL - real, intent(out) :: uAve !< Average value on target cell - integer, intent(inout) :: jStart !< The index of the cell to start searching from + integer, intent(in) :: n0 !< Number of cells in source grid + real, dimension(:), intent(in) :: h0 !< Source grid sizes (size n0) + real, dimension(:), intent(in) :: u0 !< Source cell averages + real, dimension(:,:), intent(in) :: ppoly0_E !< Edge value of polynomial + real, dimension(:,:), intent(in) :: ppoly0_coefs !< Coefficients of polynomial + integer, intent(in) :: method !< Remapping scheme to use + real, intent(in) :: xL !< Left edges of target cell + real, intent(in) :: xR !< Right edges of target cell + real, intent(in) :: hC !< Cell width hC = xR - xL + real, intent(out) :: uAve !< Average value on target cell + integer, intent(inout) :: jStart !< The index of the cell to start searching from !< On exit, contains index of last cell used - real, intent(inout) :: xStart !< The left edge position of cell jStart + real, intent(inout) :: xStart !< The left edge position of cell jStart !< On first entry should be 0. - real, optional, intent(in) :: h_neglect !< A negligibly small width for the + real, optional, intent(in) :: h_neglect !< A negligibly small width for the !! purpose of cell reconstructions !! in the same units as h. ! Local variables @@ -1302,20 +1303,20 @@ subroutine integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefficients, select case ( method ) case ( INTEGRATION_PCM ) - uAve = ppoly0_coefficients(jL,1) + uAve = ppoly0_coefs(jL,1) case ( INTEGRATION_PLM ) - uAve = ppoly0_coefficients(jL,1) & - + xi0 * ppoly0_coefficients(jL,2) + uAve = ppoly0_coefs(jL,1) & + + xi0 * ppoly0_coefs(jL,2) case ( INTEGRATION_PPM ) - uAve = ppoly0_coefficients(jL,1) & - + xi0 * ( ppoly0_coefficients(jL,2) & - + xi0 * ppoly0_coefficients(jL,3) ) + uAve = ppoly0_coefs(jL,1) & + + xi0 * ( ppoly0_coefs(jL,2) & + + xi0 * ppoly0_coefs(jL,3) ) case ( INTEGRATION_PQM ) - uAve = ppoly0_coefficients(jL,1) & - + xi0 * ( ppoly0_coefficients(jL,2) & - + xi0 * ( ppoly0_coefficients(jL,3) & - + xi0 * ( ppoly0_coefficients(jL,4) & - + xi0 * ppoly0_coefficients(jL,5) ) ) ) + uAve = ppoly0_coefs(jL,1) & + + xi0 * ( ppoly0_coefs(jL,2) & + + xi0 * ( ppoly0_coefs(jL,3) & + + xi0 * ( ppoly0_coefs(jL,4) & + + xi0 * ppoly0_coefs(jL,5) ) ) ) case default call MOM_error( FATAL,'The selected integration method is invalid' ) end select @@ -1371,27 +1372,27 @@ subroutine integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefficients, ! coordinates, hence: \int_xL^xR p(x) dx = h \int_xi0^xi1 p(xi) dxi select case ( method ) case ( INTEGRATION_PCM ) - q = ( xR - xL ) * ppoly0_coefficients(jL,1) + q = ( xR - xL ) * ppoly0_coefs(jL,1) case ( INTEGRATION_PLM ) - q = ( xR - xL ) * ( & - ppoly0_coefficients(jL,1) & - + ppoly0_coefficients(jL,2) * 0.5 * ( xi1 + xi0 ) ) + q = ( xR - xL ) * ( & + ppoly0_coefs(jL,1) & + + ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) ) case ( INTEGRATION_PPM ) - q = ( xR - xL ) * ( & - ppoly0_coefficients(jL,1) & - + ( ppoly0_coefficients(jL,2) * 0.5 * ( xi1 + xi0 ) & - + ppoly0_coefficients(jL,3) * r_3 * ( ( xi1*xi1 + xi0*xi0 ) + xi0*xi1 ) ) ) + q = ( xR - xL ) * ( & + ppoly0_coefs(jL,1) & + + ( ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) & + + ppoly0_coefs(jL,3) * r_3 * ( ( xi1*xi1 + xi0*xi0 ) + xi0*xi1 ) ) ) case ( INTEGRATION_PQM ) x0_2 = xi0*xi0 x1_2 = xi1*xi1 x02px12 = x0_2 + x1_2 x0px1 = xi1 + xi0 - q = ( xR - xL ) * ( & - ppoly0_coefficients(jL,1) & - + ( ppoly0_coefficients(jL,2) * 0.5 * ( xi1 + xi0 ) & - + ( ppoly0_coefficients(jL,3) * r_3 * ( x02px12 + xi0*xi1 ) & - + ppoly0_coefficients(jL,4) * 0.25* ( x02px12 * x0px1 ) & - + ppoly0_coefficients(jL,5) * 0.2 * ( ( xi1*x1_2 + xi0*x0_2 ) * x0px1 + x0_2*x1_2 ) ) ) ) + q = ( xR - xL ) * ( & + ppoly0_coefs(jL,1) & + + ( ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) & + + ( ppoly0_coefs(jL,3) * r_3 * ( x02px12 + xi0*xi1 ) & + + ppoly0_coefs(jL,4) * 0.25* ( x02px12 * x0px1 ) & + + ppoly0_coefs(jL,5) * 0.2 * ( ( xi1*x1_2 + xi0*x0_2 ) * x0px1 + x0_2*x1_2 ) ) ) ) case default call MOM_error( FATAL,'The selected integration method is invalid' ) end select @@ -1423,27 +1424,27 @@ subroutine integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefficients, select case ( method ) case ( INTEGRATION_PCM ) - q = q + ( x0jLr - xL ) * ppoly0_coefficients(jL,1) + q = q + ( x0jLr - xL ) * ppoly0_coefs(jL,1) case ( INTEGRATION_PLM ) - q = q + ( x0jLr - xL ) * ( & - ppoly0_coefficients(jL,1) & - + ppoly0_coefficients(jL,2) * 0.5 * ( xi1 + xi0 ) ) + q = q + ( x0jLr - xL ) * ( & + ppoly0_coefs(jL,1) & + + ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) ) case ( INTEGRATION_PPM ) - q = q + ( x0jLr - xL ) * ( & - ppoly0_coefficients(jL,1) & - + ( ppoly0_coefficients(jL,2) * 0.5 * ( xi1 + xi0 ) & - + ppoly0_coefficients(jL,3) * r_3 * ( ( xi1*xi1 + xi0*xi0 ) + xi0*xi1 ) ) ) + q = q + ( x0jLr - xL ) * ( & + ppoly0_coefs(jL,1) & + + ( ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) & + + ppoly0_coefs(jL,3) * r_3 * ( ( xi1*xi1 + xi0*xi0 ) + xi0*xi1 ) ) ) case ( INTEGRATION_PQM ) x0_2 = xi0*xi0 x1_2 = xi1*xi1 x02px12 = x0_2 + x1_2 x0px1 = xi1 + xi0 - q = q + ( x0jLr - xL ) * ( & - ppoly0_coefficients(jL,1) & - + ( ppoly0_coefficients(jL,2) * 0.5 * ( xi1 + xi0 ) & - + ( ppoly0_coefficients(jL,3) * r_3 * ( x02px12 + xi0*xi1 ) & - + ppoly0_coefficients(jL,4) * 0.25* ( x02px12 * x0px1 ) & - + ppoly0_coefficients(jL,5) * 0.2 * ( ( xi1*x1_2 + xi0*x0_2 ) * x0px1 + x0_2*x1_2 ) ) ) ) + q = q + ( x0jLr - xL ) * ( & + ppoly0_coefs(jL,1) & + + ( ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) & + + ( ppoly0_coefs(jL,3) * r_3 * ( x02px12 + xi0*xi1 ) & + + ppoly0_coefs(jL,4) * 0.25* ( x02px12 * x0px1 ) & + + ppoly0_coefs(jL,5) * 0.2 * ( ( xi1*x1_2 + xi0*x0_2 ) * x0px1 + x0_2*x1_2 ) ) ) ) case default call MOM_error( FATAL, 'The selected integration method is invalid' ) end select @@ -1468,27 +1469,27 @@ subroutine integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefficients, select case ( method ) case ( INTEGRATION_PCM ) - q = q + ( xR - x0jRl ) * ppoly0_coefficients(jR,1) + q = q + ( xR - x0jRl ) * ppoly0_coefs(jR,1) case ( INTEGRATION_PLM ) - q = q + ( xR - x0jRl ) * ( & - ppoly0_coefficients(jR,1) & - + ppoly0_coefficients(jR,2) * 0.5 * ( xi1 + xi0 ) ) + q = q + ( xR - x0jRl ) * ( & + ppoly0_coefs(jR,1) & + + ppoly0_coefs(jR,2) * 0.5 * ( xi1 + xi0 ) ) case ( INTEGRATION_PPM ) - q = q + ( xR - x0jRl ) * ( & - ppoly0_coefficients(jR,1) & - + ( ppoly0_coefficients(jR,2) * 0.5 * ( xi1 + xi0 ) & - + ppoly0_coefficients(jR,3) * r_3 * ( ( xi1*xi1 + xi0*xi0 ) + xi0*xi1 ) ) ) + q = q + ( xR - x0jRl ) * ( & + ppoly0_coefs(jR,1) & + + ( ppoly0_coefs(jR,2) * 0.5 * ( xi1 + xi0 ) & + + ppoly0_coefs(jR,3) * r_3 * ( ( xi1*xi1 + xi0*xi0 ) + xi0*xi1 ) ) ) case ( INTEGRATION_PQM ) x0_2 = xi0*xi0 x1_2 = xi1*xi1 x02px12 = x0_2 + x1_2 x0px1 = xi1 + xi0 - q = q + ( xR - x0jRl ) * ( & - ppoly0_coefficients(jR,1) & - + ( ppoly0_coefficients(jR,2) * 0.5 * ( xi1 + xi0 ) & - + ( ppoly0_coefficients(jR,3) * r_3 * ( x02px12 + xi0*xi1 ) & - + ppoly0_coefficients(jR,4) * 0.25* ( x02px12 * x0px1 ) & - + ppoly0_coefficients(jR,5) * 0.2 * ( ( xi1*x1_2 + xi0*x0_2 ) * x0px1 + x0_2*x1_2 ) ) ) ) + q = q + ( xR - x0jRl ) * ( & + ppoly0_coefs(jR,1) & + + ( ppoly0_coefs(jR,2) * 0.5 * ( xi1 + xi0 ) & + + ( ppoly0_coefs(jR,3) * r_3 * ( x02px12 + xi0*xi1 ) & + + ppoly0_coefs(jR,4) * 0.25* ( x02px12 * x0px1 ) & + + ppoly0_coefs(jR,5) * 0.2 * ( ( xi1*x1_2 + xi0*x0_2 ) * x0px1 + x0_2*x1_2 ) ) ) ) case default call MOM_error( FATAL,'The selected integration method is invalid' ) end select @@ -1498,7 +1499,7 @@ subroutine integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefficients, ! The cell average is the integrated value divided by the cell width #ifdef __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ if (hAct==0.) then - uAve = ppoly0_coefficients(jL,1) + uAve = ppoly0_coefs(jL,1) else uAve = q / hAct endif @@ -1613,7 +1614,7 @@ logical function remapping_unit_tests(verbose) data h1 /3*1./ ! 3 uniform layers with total depth of 3 data h2 /6*0.5/ ! 6 uniform layers with total depth of 3 type(remapping_CS) :: CS !< Remapping control structure - real, allocatable, dimension(:,:) :: ppoly0_E, ppoly0_S, ppoly0_coefficients + real, allocatable, dimension(:,:) :: ppoly0_E, ppoly0_S, ppoly0_coefs integer :: i real :: err, h_neglect, h_neglect_edge logical :: thisTest, v @@ -1660,17 +1661,17 @@ logical function remapping_unit_tests(verbose) thisTest = .false. allocate(ppoly0_E(n0,2)) allocate(ppoly0_S(n0,2)) - allocate(ppoly0_coefficients(n0,CS%degree+1)) + allocate(ppoly0_coefs(n0,CS%degree+1)) ppoly0_E(:,:) = 0.0 ppoly0_S(:,:) = 0.0 - ppoly0_coefficients(:,:) = 0.0 + ppoly0_coefs(:,:) = 0.0 call edge_values_explicit_h4( n0, h0, u0, ppoly0_E, h_neglect=1e-10 ) - call PPM_reconstruction( n0, h0, u0, ppoly0_E, ppoly0_coefficients, h_neglect ) - call PPM_boundary_extrapolation( n0, h0, u0, ppoly0_E, ppoly0_coefficients, h_neglect ) + call PPM_reconstruction( n0, h0, u0, ppoly0_E, ppoly0_coefs, h_neglect ) + call PPM_boundary_extrapolation( n0, h0, u0, ppoly0_E, ppoly0_coefs, h_neglect ) u1(:) = 0. - call remapByProjection( n0, h0, u0, ppoly0_E, ppoly0_coefficients, & + call remapByProjection( n0, h0, u0, ppoly0_E, ppoly0_coefs, & n1, h1, INTEGRATION_PPM, u1, h_neglect ) do i=1,n1 err=u1(i)-8.*(0.5*real(1+n1)-real(i)) @@ -1681,7 +1682,7 @@ logical function remapping_unit_tests(verbose) thisTest = .false. u1(:) = 0. - call remapByDeltaZ( n0, h0, u0, ppoly0_E, ppoly0_coefficients, & + call remapByDeltaZ( n0, h0, u0, ppoly0_E, ppoly0_coefs, & n1, x1-x0(1:n1+1), & INTEGRATION_PPM, u1, hn1, h_neglect ) if (verbose) write(*,*) 'h1 (by delta)' @@ -1698,7 +1699,7 @@ logical function remapping_unit_tests(verbose) call buildGridFromH(n2, h2, x2) dx2(1:n0+1) = x2(1:n0+1) - x0 dx2(n0+2:n2+1) = x2(n0+2:n2+1) - x0(n0+1) - call remapByDeltaZ( n0, h0, u0, ppoly0_E, ppoly0_coefficients, & + call remapByDeltaZ( n0, h0, u0, ppoly0_E, ppoly0_coefs, & n2, dx2, & INTEGRATION_PPM, u2, hn2, h_neglect ) if (verbose) write(*,*) 'h2' @@ -1715,7 +1716,7 @@ logical function remapping_unit_tests(verbose) if (verbose) write(*,*) 'Via sub-cells' thisTest = .false. - call remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefficients, & + call remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefs, & n2, h2, INTEGRATION_PPM, .false., u2, err ) if (verbose) call dumpGrid(n2,h2,x2,u2) @@ -1726,11 +1727,11 @@ logical function remapping_unit_tests(verbose) if (thisTest) write(*,*) 'remapping_unit_tests: Failed remap_via_sub_cells() 2' remapping_unit_tests = remapping_unit_tests .or. thisTest - call remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefficients, & + call remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefs, & 6, (/.125,.125,.125,.125,.125,.125/), INTEGRATION_PPM, .false., u2, err ) if (verbose) call dumpGrid(6,h2,x2,u2) - call remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefficients, & + call remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefs, & 3, (/2.25,1.5,1./), INTEGRATION_PPM, .false., u2, err ) if (verbose) call dumpGrid(3,h2,x2,u2) @@ -1738,63 +1739,63 @@ logical function remapping_unit_tests(verbose) write(*,*) '===== MOM_remapping: new remapping_unit_tests ==================' - deallocate(ppoly0_E, ppoly0_S, ppoly0_coefficients) - allocate(ppoly0_coefficients(5,6)) + deallocate(ppoly0_E, ppoly0_S, ppoly0_coefs) + allocate(ppoly0_coefs(5,6)) allocate(ppoly0_E(5,2)) allocate(ppoly0_S(5,2)) call PCM_reconstruction(3, (/1.,2.,4./), ppoly0_E(1:3,:), & - ppoly0_coefficients(1:3,:) ) + ppoly0_coefs(1:3,:) ) remapping_unit_tests = remapping_unit_tests .or. & test_answer(v, 3, ppoly0_E(:,1), (/1.,2.,4./), 'PCM: left edges') remapping_unit_tests = remapping_unit_tests .or. & test_answer(v, 3, ppoly0_E(:,2), (/1.,2.,4./), 'PCM: right edges') remapping_unit_tests = remapping_unit_tests .or. & - test_answer(v, 3, ppoly0_coefficients(:,1), (/1.,2.,4./), 'PCM: P0') + test_answer(v, 3, ppoly0_coefs(:,1), (/1.,2.,4./), 'PCM: P0') call PLM_reconstruction(3, (/1.,1.,1./), (/1.,3.,5./), ppoly0_E(1:3,:), & - ppoly0_coefficients(1:3,:), h_neglect ) + ppoly0_coefs(1:3,:), h_neglect ) remapping_unit_tests = remapping_unit_tests .or. & test_answer(v, 3, ppoly0_E(:,1), (/1.,2.,5./), 'Unlim PLM: left edges') remapping_unit_tests = remapping_unit_tests .or. & test_answer(v, 3, ppoly0_E(:,2), (/1.,4.,5./), 'Unlim PLM: right edges') remapping_unit_tests = remapping_unit_tests .or. & - test_answer(v, 3, ppoly0_coefficients(:,1), (/1.,2.,5./), 'Unlim PLM: P0') + test_answer(v, 3, ppoly0_coefs(:,1), (/1.,2.,5./), 'Unlim PLM: P0') remapping_unit_tests = remapping_unit_tests .or. & - test_answer(v, 3, ppoly0_coefficients(:,2), (/0.,2.,0./), 'Unlim PLM: P1') + test_answer(v, 3, ppoly0_coefs(:,2), (/0.,2.,0./), 'Unlim PLM: P1') call PLM_reconstruction(3, (/1.,1.,1./), (/1.,2.,7./), ppoly0_E(1:3,:), & - ppoly0_coefficients(1:3,:), h_neglect ) + ppoly0_coefs(1:3,:), h_neglect ) remapping_unit_tests = remapping_unit_tests .or. & test_answer(v, 3, ppoly0_E(:,1), (/1.,1.,7./), 'Left lim PLM: left edges') remapping_unit_tests = remapping_unit_tests .or. & test_answer(v, 3, ppoly0_E(:,2), (/1.,3.,7./), 'Left lim PLM: right edges') remapping_unit_tests = remapping_unit_tests .or. & - test_answer(v, 3, ppoly0_coefficients(:,1), (/1.,1.,7./), 'Left lim PLM: P0') + test_answer(v, 3, ppoly0_coefs(:,1), (/1.,1.,7./), 'Left lim PLM: P0') remapping_unit_tests = remapping_unit_tests .or. & - test_answer(v, 3, ppoly0_coefficients(:,2), (/0.,2.,0./), 'Left lim PLM: P1') + test_answer(v, 3, ppoly0_coefs(:,2), (/0.,2.,0./), 'Left lim PLM: P1') call PLM_reconstruction(3, (/1.,1.,1./), (/1.,6.,7./), ppoly0_E(1:3,:), & - ppoly0_coefficients(1:3,:), h_neglect ) + ppoly0_coefs(1:3,:), h_neglect ) remapping_unit_tests = remapping_unit_tests .or. & test_answer(v, 3, ppoly0_E(:,1), (/1.,5.,7./), 'Right lim PLM: left edges') remapping_unit_tests = remapping_unit_tests .or. & test_answer(v, 3, ppoly0_E(:,2), (/1.,7.,7./), 'Right lim PLM: right edges') remapping_unit_tests = remapping_unit_tests .or. & - test_answer(v, 3, ppoly0_coefficients(:,1), (/1.,5.,7./), 'Right lim PLM: P0') + test_answer(v, 3, ppoly0_coefs(:,1), (/1.,5.,7./), 'Right lim PLM: P0') remapping_unit_tests = remapping_unit_tests .or. & - test_answer(v, 3, ppoly0_coefficients(:,2), (/0.,2.,0./), 'Right lim PLM: P1') + test_answer(v, 3, ppoly0_coefs(:,2), (/0.,2.,0./), 'Right lim PLM: P1') call PLM_reconstruction(3, (/1.,2.,3./), (/1.,4.,9./), ppoly0_E(1:3,:), & - ppoly0_coefficients(1:3,:), h_neglect ) + ppoly0_coefs(1:3,:), h_neglect ) remapping_unit_tests = remapping_unit_tests .or. & test_answer(v, 3, ppoly0_E(:,1), (/1.,2.,9./), 'Non-uniform line PLM: left edges') remapping_unit_tests = remapping_unit_tests .or. & test_answer(v, 3, ppoly0_E(:,2), (/1.,6.,9./), 'Non-uniform line PLM: right edges') remapping_unit_tests = remapping_unit_tests .or. & - test_answer(v, 3, ppoly0_coefficients(:,1), (/1.,2.,9./), 'Non-uniform line PLM: P0') + test_answer(v, 3, ppoly0_coefs(:,1), (/1.,2.,9./), 'Non-uniform line PLM: P0') remapping_unit_tests = remapping_unit_tests .or. & - test_answer(v, 3, ppoly0_coefficients(:,2), (/0.,4.,0./), 'Non-uniform line PLM: P1') + test_answer(v, 3, ppoly0_coefs(:,2), (/0.,4.,0./), 'Non-uniform line PLM: P1') call edge_values_explicit_h4( 5, (/1.,1.,1.,1.,1./), (/1.,3.,5.,7.,9./), ppoly0_E, & h_neglect=1e-10 ) @@ -1804,13 +1805,13 @@ logical function remapping_unit_tests(verbose) ppoly0_E(:,1) = (/0.,2.,4.,6.,8./) ppoly0_E(:,2) = (/2.,4.,6.,8.,10./) call PPM_reconstruction(5, (/1.,1.,1.,1.,1./), (/1.,3.,5.,7.,9./), ppoly0_E(1:5,:), & - ppoly0_coefficients(1:5,:), h_neglect ) + ppoly0_coefs(1:5,:), h_neglect ) remapping_unit_tests = remapping_unit_tests .or. & - test_answer(v, 5, ppoly0_coefficients(:,1), (/1.,2.,4.,6.,9./), 'Line PPM: P0') + test_answer(v, 5, ppoly0_coefs(:,1), (/1.,2.,4.,6.,9./), 'Line PPM: P0') remapping_unit_tests = remapping_unit_tests .or. & - test_answer(v, 5, ppoly0_coefficients(:,2), (/0.,2.,2.,2.,0./), 'Line PPM: P1') + test_answer(v, 5, ppoly0_coefs(:,2), (/0.,2.,2.,2.,0./), 'Line PPM: P1') remapping_unit_tests = remapping_unit_tests .or. & - test_answer(v, 5, ppoly0_coefficients(:,3), (/0.,0.,0.,0.,0./), 'Line PPM: P2') + test_answer(v, 5, ppoly0_coefs(:,3), (/0.,0.,0.,0.,0./), 'Line PPM: P2') call edge_values_explicit_h4( 5, (/1.,1.,1.,1.,1./), (/1.,1.,7.,19.,37./), ppoly0_E, & h_neglect=1e-10 ) @@ -1820,46 +1821,46 @@ logical function remapping_unit_tests(verbose) ppoly0_E(:,1) = (/0.,0.,3.,12.,27./) ppoly0_E(:,2) = (/0.,3.,12.,27.,48./) call PPM_reconstruction(5, (/1.,1.,1.,1.,1./), (/0.,1.,7.,19.,37./), ppoly0_E(1:5,:), & - ppoly0_coefficients(1:5,:), h_neglect ) + ppoly0_coefs(1:5,:), h_neglect ) remapping_unit_tests = remapping_unit_tests .or. & test_answer(v, 5, ppoly0_E(:,1), (/0.,0.,3.,12.,37./), 'Parabola PPM: left edges') remapping_unit_tests = remapping_unit_tests .or. & test_answer(v, 5, ppoly0_E(:,2), (/0.,3.,12.,27.,37./), 'Parabola PPM: right edges') remapping_unit_tests = remapping_unit_tests .or. & - test_answer(v, 5, ppoly0_coefficients(:,1), (/0.,0.,3.,12.,37./), 'Parabola PPM: P0') + test_answer(v, 5, ppoly0_coefs(:,1), (/0.,0.,3.,12.,37./), 'Parabola PPM: P0') remapping_unit_tests = remapping_unit_tests .or. & - test_answer(v, 5, ppoly0_coefficients(:,2), (/0.,0.,6.,12.,0./), 'Parabola PPM: P1') + test_answer(v, 5, ppoly0_coefs(:,2), (/0.,0.,6.,12.,0./), 'Parabola PPM: P1') remapping_unit_tests = remapping_unit_tests .or. & - test_answer(v, 5, ppoly0_coefficients(:,3), (/0.,3.,3.,3.,0./), 'Parabola PPM: P2') + test_answer(v, 5, ppoly0_coefs(:,3), (/0.,3.,3.,3.,0./), 'Parabola PPM: P2') ppoly0_E(:,1) = (/0.,0.,6.,10.,15./) ppoly0_E(:,2) = (/0.,6.,12.,17.,15./) call PPM_reconstruction(5, (/1.,1.,1.,1.,1./), (/0.,5.,7.,16.,15./), ppoly0_E(1:5,:), & - ppoly0_coefficients(1:5,:), h_neglect ) + ppoly0_coefs(1:5,:), h_neglect ) remapping_unit_tests = remapping_unit_tests .or. & test_answer(v, 5, ppoly0_E(:,1), (/0.,3.,6.,16.,15./), 'Limits PPM: left edges') remapping_unit_tests = remapping_unit_tests .or. & test_answer(v, 5, ppoly0_E(:,2), (/0.,6.,9.,16.,15./), 'Limits PPM: right edges') remapping_unit_tests = remapping_unit_tests .or. & - test_answer(v, 5, ppoly0_coefficients(:,1), (/0.,3.,6.,16.,15./), 'Limits PPM: P0') + test_answer(v, 5, ppoly0_coefs(:,1), (/0.,3.,6.,16.,15./), 'Limits PPM: P0') remapping_unit_tests = remapping_unit_tests .or. & - test_answer(v, 5, ppoly0_coefficients(:,2), (/0.,6.,0.,0.,0./), 'Limits PPM: P1') + test_answer(v, 5, ppoly0_coefs(:,2), (/0.,6.,0.,0.,0./), 'Limits PPM: P1') remapping_unit_tests = remapping_unit_tests .or. & - test_answer(v, 5, ppoly0_coefficients(:,3), (/0.,-3.,3.,0.,0./), 'Limits PPM: P2') + test_answer(v, 5, ppoly0_coefs(:,3), (/0.,-3.,3.,0.,0./), 'Limits PPM: P2') call PLM_reconstruction(4, (/0.,1.,1.,0./), (/5.,4.,2.,1./), ppoly0_E(1:4,:), & - ppoly0_coefficients(1:4,:), h_neglect ) + ppoly0_coefs(1:4,:), h_neglect ) remapping_unit_tests = remapping_unit_tests .or. & test_answer(v, 4, ppoly0_E(1:4,1), (/5.,5.,3.,1./), 'PPM: left edges h=0110') remapping_unit_tests = remapping_unit_tests .or. & test_answer(v, 4, ppoly0_E(1:4,2), (/5.,3.,1.,1./), 'PPM: right edges h=0110') call remap_via_sub_cells( 4, (/0.,1.,1.,0./), (/5.,4.,2.,1./), ppoly0_E(1:4,:), & - ppoly0_coefficients(1:4,:), & + ppoly0_coefs(1:4,:), & 2, (/1.,1./), INTEGRATION_PLM, .false., u2, err ) remapping_unit_tests = remapping_unit_tests .or. & test_answer(v, 2, u2, (/4.,2./), 'PLM: remapped h=0110->h=11') - deallocate(ppoly0_E, ppoly0_S, ppoly0_coefficients) + deallocate(ppoly0_E, ppoly0_S, ppoly0_coefs) if (.not. remapping_unit_tests) write(*,*) 'Pass' From 380574ac754a1a49bb9b310819859abe418435db Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 6 May 2018 12:35:05 -0400 Subject: [PATCH 0194/1072] Added dOxyGen comments in coord_ code Added dOxyGen comments for all of the subroutines and their arguments in the coord_... modules in ALE. Also shortened the name of several variables. All answers are bitwise identical. --- src/ALE/MOM_regridding.F90 | 12 +++---- src/ALE/coord_adapt.F90 | 24 ++++++++----- src/ALE/coord_hycom.F90 | 17 ++++----- src/ALE/coord_rho.F90 | 61 +++++++++++++++++--------------- src/ALE/coord_sigma.F90 | 17 ++++----- src/ALE/coord_slight.F90 | 72 +++++++++++++++++++++++--------------- src/ALE/coord_zlike.F90 | 6 ++-- 7 files changed, 118 insertions(+), 91 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index d4fe0a0c38..1f3488a7bc 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -694,7 +694,7 @@ subroutine check_grid_def(filename, varname, expected_units, msg, ierr) integer :: i ierr = .false. - status = NF90_OPEN(trim(filename), NF90_NOWRITE, ncid); + status = NF90_OPEN(trim(filename), NF90_NOWRITE, ncid) if (status /= NF90_NOERR) then ierr = .true. msg = 'File not found: '//trim(filename) @@ -2149,19 +2149,19 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri adaptTimeRatio, adaptZoom, adaptZoomCoeff, adaptBuoyCoeff, adaptAlpha, adaptDoMin) type(regridding_CS), intent(inout) :: CS !< Regridding control structure logical, optional, intent(in) :: boundary_extrapolation !< Extrapolate in boundary cells - real, optional, intent(in) :: min_thickness !< Minimum thickness allowed when building the new grid (m) - real, optional, intent(in) :: old_grid_weight !< Weight given to old coordinate when time-filtering grid + real, optional, intent(in) :: min_thickness !< Minimum thickness allowed when building the new grid (m) + real, optional, intent(in) :: old_grid_weight !< Weight given to old coordinate when time-filtering grid character(len=*), optional, intent(in) :: interp_scheme !< Interpolation method for state-dependent coordinates real, optional, intent(in) :: depth_of_time_filter_shallow !< Depth to start cubic (H units) real, optional, intent(in) :: depth_of_time_filter_deep !< Depth to end cubic (H units) real, optional, intent(in) :: compress_fraction !< Fraction of compressibility to add to potential density - real, optional, intent(in) :: dz_min_surface !< The fixed resolution in the topmost SLight_nkml_min layers (m) - integer, optional, intent(in) :: nz_fixed_surface !< The number of fixed-thickess layers at the top of the model + real, optional, intent(in) :: dz_min_surface !< The fixed resolution in the topmost SLight_nkml_min layers (m) + integer, optional, intent(in) :: nz_fixed_surface !< The number of fixed-thickness layers at the top of the model real, optional, intent(in) :: Rho_ml_avg_depth !< Averaging depth over which to determine mixed layer potential !! density (m) real, optional, intent(in) :: nlay_ML_to_interior !< Number of layers to offset the mixed layer density to find !! resolved stratification (nondim) - logical, optional, intent(in) :: fix_haloclines !< Detect regions with much weaker stratification in the coordinate + logical, optional, intent(in) :: fix_haloclines !< Detect regions with much weaker stratification in the coordinate real, optional, intent(in) :: halocline_filt_len !< Length scale over which to filter T & S when looking for !! spuriously unstable water mass profiles (m) real, optional, intent(in) :: halocline_strat_tol !< Value of the stratification ratio that defines a problematic diff --git a/src/ALE/coord_adapt.F90 b/src/ALE/coord_adapt.F90 index 2e5b4156c8..b2ae0c6de4 100644 --- a/src/ALE/coord_adapt.F90 +++ b/src/ALE/coord_adapt.F90 @@ -12,8 +12,7 @@ module coord_adapt #include -type, public :: adapt_CS - private +type, public :: adapt_CS ; private !> Number of layers/levels integer :: nk @@ -51,8 +50,8 @@ module coord_adapt !> Initialise an adapt_CS with parameters subroutine init_coord_adapt(CS, nk, coordinateResolution) type(adapt_CS), pointer :: CS !< Unassociated pointer to hold the control structure - integer, intent(in) :: nk - real, dimension(:), intent(in) :: coordinateResolution + integer, intent(in) :: nk !< Number of layers in the grid + real, dimension(:), intent(in) :: coordinateResolution !< Nominal near-surface resolution (m) if (associated(CS)) call MOM_error(FATAL, "init_coord_adapt: CS already associated") allocate(CS) @@ -72,12 +71,21 @@ subroutine end_coord_adapt(CS) deallocate(CS) end subroutine end_coord_adapt +!> This subtroutine can be used to set the parameters for coord_adapt module subroutine set_adapt_params(CS, adaptTimeRatio, adaptAlpha, adaptZoom, adaptZoomCoeff, & - adaptBuoyCoeff, adaptDrho0, adaptDoMin) + adaptBuoyCoeff, adaptDrho0, adaptDoMin) type(adapt_CS), pointer :: CS !< The control structure for this module - real, optional, intent(in) :: adaptTimeRatio, adaptAlpha, adaptZoom, adaptZoomCoeff - real, optional, intent(in) :: adaptBuoyCoeff, adaptDrho0 - logical, optional, intent(in) :: adaptDoMin + real, optional, intent(in) :: adaptTimeRatio !< Ratio of optimisation and diffusion timescales + real, optional, intent(in) :: adaptAlpha !< Nondimensional coefficient determining + !! how much optimisation to apply + real, optional, intent(in) :: adaptZoom !< Near-surface zooming depth, in m + real, optional, intent(in) :: adaptZoomCoeff !< Near-surface zooming coefficient + real, optional, intent(in) :: adaptBuoyCoeff !< Stratification-dependent diffusion coefficient + real, optional, intent(in) :: adaptDrho0 !< Reference density difference for + !! stratification-dependent diffusion + logical, optional, intent(in) :: adaptDoMin !< If true, form a HYCOM1-like mixed layer by + !! preventing interfaces from becoming shallower than + !! the depths set by coordinateResolution if (.not. associated(CS)) call MOM_error(FATAL, "set_adapt_params: CS not associated") diff --git a/src/ALE/coord_hycom.F90 b/src/ALE/coord_hycom.F90 index 06da6db4b2..aad807b62d 100644 --- a/src/ALE/coord_hycom.F90 +++ b/src/ALE/coord_hycom.F90 @@ -10,8 +10,7 @@ module coord_hycom implicit none ; private !> Control structure containing required parameters for the HyCOM coordinate -type, public :: hycom_CS - private +type, public :: hycom_CS ; private !> Number of layers/levels in generated grid integer :: nk @@ -40,7 +39,7 @@ module coord_hycom subroutine init_coord_hycom(CS, nk, coordinateResolution, target_density, interp_CS) type(hycom_CS), pointer :: CS !< Unassociated pointer to hold the control structure integer, intent(in) :: nk !< Number of layers in generated grid - real, dimension(nk), intent(in) :: coordinateResolution !< Z-space thicknesses (m) + real, dimension(nk), intent(in) :: coordinateResolution !< Nominal near-surface resolution (m) real, dimension(nk+1),intent(in) :: target_density !< Interface target densities (kg/m3) type(interp_CS_type), intent(in) :: interp_CS !< Controls for interpolation @@ -55,8 +54,9 @@ subroutine init_coord_hycom(CS, nk, coordinateResolution, target_density, interp CS%interp_CS = interp_CS end subroutine init_coord_hycom +!> This subroutine deallocates memory in the control structure for the coord_hycom module subroutine end_coord_hycom(CS) - type(hycom_CS), pointer :: CS + type(hycom_CS), pointer :: CS !< Coordinate control structure ! nothing to do if (.not. associated(CS)) return @@ -67,11 +67,12 @@ subroutine end_coord_hycom(CS) deallocate(CS) end subroutine end_coord_hycom +!> This subroutine can be used to set the parameters for the coord_hycom module subroutine set_hycom_params(CS, max_interface_depths, max_layer_thickness, interp_CS) - type(hycom_CS), pointer :: CS - real, optional, dimension(:), intent(in) :: max_interface_depths - real, optional, dimension(:), intent(in) :: max_layer_thickness - type(interp_CS_type), optional, intent(in) :: interp_CS + type(hycom_CS), pointer :: CS !< Coordinate control structure + real, dimension(:), optional, intent(in) :: max_interface_depths !< Maximum depths of interfaces in m + real, dimension(:), optional, intent(in) :: max_layer_thickness !< Maximum thicknesses of layers in m + type(interp_CS_type), optional, intent(in) :: interp_CS !< Controls for interpolation if (.not. associated(CS)) call MOM_error(FATAL, "set_hycom_params: CS not associated") diff --git a/src/ALE/coord_rho.F90 b/src/ALE/coord_rho.F90 index bee6832f77..d3141cfd2d 100644 --- a/src/ALE/coord_rho.F90 +++ b/src/ALE/coord_rho.F90 @@ -11,23 +11,22 @@ module coord_rho implicit none ; private !> Control structure containing required parameters for the rho coordinate -type, public :: rho_CS - private +type, public :: rho_CS ; private !> Number of layers integer :: nk - !> Minimum thickness allowed for layers + !> Minimum thickness allowed for layers, in m real :: min_thickness = 0. - !> Reference pressure for density calculations + !> Reference pressure for density calculations, in Pa real :: ref_pressure !> If true, integrate for interface positions from the top downward. !! If false, integrate from the bottom upward, as does the rest of the model. logical :: integrate_downward_for_e = .false. - !> Nominal density of interfaces + !> Nominal density of interfaces, in kg m-3 real, allocatable, dimension(:) :: target_density !> Interpolation control structure @@ -46,10 +45,10 @@ module coord_rho !> Initialise a rho_CS with pointers to parameters subroutine init_coord_rho(CS, nk, ref_pressure, target_density, interp_CS) type(rho_CS), pointer :: CS !< Unassociated pointer to hold the control structure - integer, intent(in) :: nk - real, intent(in) :: ref_pressure - real, dimension(:), intent(in) :: target_density - type(interp_CS_type), intent(in) :: interp_CS + integer, intent(in) :: nk !< Number of layers in the grid + real, intent(in) :: ref_pressure !< Nominal density of interfaces in Pa + real, dimension(:), intent(in) :: target_density !< Nominal density of interfaces in kg m-3 + type(interp_CS_type), intent(in) :: interp_CS !< Controls for interpolation if (associated(CS)) call MOM_error(FATAL, "init_coord_rho: CS already associated!") allocate(CS) @@ -61,8 +60,9 @@ subroutine init_coord_rho(CS, nk, ref_pressure, target_density, interp_CS) CS%interp_CS = interp_CS end subroutine init_coord_rho +!> This subroutine deallocates memory in the control structure for the coord_rho module subroutine end_coord_rho(CS) - type(rho_CS), pointer :: CS + type(rho_CS), pointer :: CS !< Coordinate control structure ! nothing to do if (.not. associated(CS)) return @@ -70,11 +70,15 @@ subroutine end_coord_rho(CS) deallocate(CS) end subroutine end_coord_rho +!> This subroutine can be used to set the parameters for the coord_rho module subroutine set_rho_params(CS, min_thickness, integrate_downward_for_e, interp_CS) - type(rho_CS), pointer :: CS - real, optional, intent(in) :: min_thickness - logical, optional, intent(in) :: integrate_downward_for_e - type(interp_CS_type), optional, intent(in) :: interp_CS + type(rho_CS), pointer :: CS !< Coordinate control structure + real, optional, intent(in) :: min_thickness !< Minimum allowed thickness, in m + logical, optional, intent(in) :: integrate_downward_for_e !< If true, integrate for interface + !! positions from the top downward. If false, integrate + !! from the bottom upward, as does the rest of the model. + + type(interp_CS_type), optional, intent(in) :: interp_CS !< Controls for interpolation if (.not. associated(CS)) call MOM_error(FATAL, "set_rho_params: CS not associated") @@ -342,14 +346,13 @@ subroutine copy_finite_thicknesses(nk, h_in, threshold, nout, h_out, mapping) end subroutine copy_finite_thicknesses !------------------------------------------------------------------------------ -! Inflate vanished layers to finite (nonzero) width -!------------------------------------------------------------------------------ -subroutine old_inflate_layers_1d( minThickness, N, h ) +!> Inflate vanished layers to finite (nonzero) width +subroutine old_inflate_layers_1d( min_thickness, nk, h ) ! Argument - real, intent(in) :: minThickness - integer, intent(in) :: N - real, intent(inout) :: h(:) + real, intent(in) :: min_thickness !< Minimum allowed thickness, in m + integer, intent(in) :: nk !< Number of layers in the grid + real, dimension(:), intent(inout) :: h !< Layer thicknesses, in m ! Local variable integer :: k @@ -361,28 +364,28 @@ subroutine old_inflate_layers_1d( minThickness, N, h ) ! Count number of nonzero layers count_nonzero_layers = 0 - do k = 1,N - if ( h(k) > minThickness ) then + do k = 1,nk + if ( h(k) > min_thickness ) then count_nonzero_layers = count_nonzero_layers + 1 end if end do ! If all layer thicknesses are greater than the threshold, exit routine - if ( count_nonzero_layers == N ) return + if ( count_nonzero_layers == nk ) return ! If all thicknesses are zero, inflate them all and exit if ( count_nonzero_layers == 0 ) then - do k = 1,N - h(k) = minThickness + do k = 1,nk + h(k) = min_thickness end do return end if ! Inflate zero layers correction = 0.0 - do k = 1,N - if ( h(k) <= minThickness ) then - delta = minThickness - h(k) + do k = 1,nk + if ( h(k) <= min_thickness ) then + delta = min_thickness - h(k) correction = correction + delta h(k) = h(k) + delta end if @@ -391,7 +394,7 @@ subroutine old_inflate_layers_1d( minThickness, N, h ) ! Modify thicknesses of nonzero layers to ensure volume conservation maxThickness = h(1) k_found = 1 - do k = 1,N + do k = 1,nk if ( h(k) > maxThickness ) then maxThickness = h(k) k_found = k diff --git a/src/ALE/coord_sigma.F90 b/src/ALE/coord_sigma.F90 index 416ab757e2..bbb6312ba4 100644 --- a/src/ALE/coord_sigma.F90 +++ b/src/ALE/coord_sigma.F90 @@ -8,8 +8,7 @@ module coord_sigma implicit none ; private !> Control structure containing required parameters for the sigma coordinate -type, public :: sigma_CS - private +type, public :: sigma_CS ; private !> Number of levels integer :: nk @@ -28,8 +27,8 @@ module coord_sigma !> Initialise a sigma_CS with pointers to parameters subroutine init_coord_sigma(CS, nk, coordinateResolution) type(sigma_CS), pointer :: CS !< Unassociated pointer to hold the control structure - integer, intent(in) :: nk - real, dimension(:), intent(in) :: coordinateResolution + integer, intent(in) :: nk !< Number of layers in the grid + real, dimension(:), intent(in) :: coordinateResolution !< Nominal coordinate resolution (nondim) if (associated(CS)) call MOM_error(FATAL, "init_coord_sigma: CS already associated!") allocate(CS) @@ -39,8 +38,9 @@ subroutine init_coord_sigma(CS, nk, coordinateResolution) CS%coordinateResolution = coordinateResolution end subroutine init_coord_sigma +!> This subroutine deallocates memory in the control structure for the coord_sigma module subroutine end_coord_sigma(CS) - type(sigma_CS), pointer :: CS + type(sigma_CS), pointer :: CS !< Coordinate control structure ! nothing to do if (.not. associated(CS)) return @@ -48,9 +48,10 @@ subroutine end_coord_sigma(CS) deallocate(CS) end subroutine end_coord_sigma +!> This subroutine can be used to set the parameters for the coord_sigma module subroutine set_sigma_params(CS, min_thickness) - type(sigma_CS), pointer :: CS - real, optional, intent(in) :: min_thickness + type(sigma_CS), pointer :: CS !< Coordinate control structure + real, optional, intent(in) :: min_thickness !< Minimum allowed thickness, in m if (.not. associated(CS)) call MOM_error(FATAL, "set_sigma_params: CS not associated") @@ -63,7 +64,7 @@ subroutine build_sigma_column(CS, depth, totalThickness, zInterface) type(sigma_CS), intent(in) :: CS !< Coordinate control structure real, intent(in) :: depth !< Depth of ocean bottom (positive in m) real, intent(in) :: totalThickness !< Column thickness (positive in m) - real, dimension(CS%nk+1), intent(inout) :: zInterface !< Absolute positions of interfaces + real, dimension(CS%nk+1), intent(inout) :: zInterface !< Absolute positions of interfaces in m ! Local variables integer :: k diff --git a/src/ALE/coord_slight.F90 b/src/ALE/coord_slight.F90 index 93f5b9c393..ba0bdb0326 100644 --- a/src/ALE/coord_slight.F90 +++ b/src/ALE/coord_slight.F90 @@ -12,13 +12,12 @@ module coord_slight implicit none ; private !> Control structure containing required parameters for the SLight coordinate -type, public :: slight_CS - private +type, public :: slight_CS ; private !> Number of layers/levels integer :: nk - !> Minimum thickness allowed when building the new grid through regridding + !> Minimum thickness allowed when building the new grid through regridding (m) real :: min_thickness !> Reference pressure for potential density calculations (Pa) @@ -35,7 +34,7 @@ module coord_slight !> Number of layers to offset the mixed layer density to find resolved stratification (nondim) real :: nlay_ml_offset = 2.0 - !> The number of fixed-thickess layers at the top of the model + !> The number of fixed-thickness layers at the top of the model integer :: nz_fixed_surface = 2 !> The fixed resolution in the topmost SLight_nkml_min layers (m) @@ -49,16 +48,16 @@ module coord_slight !! unstable water mass profiles, in m. real :: halocline_filter_length = 2.0 - !> A value of the stratification ratio that defines a problematic halocline region. + !> A value of the stratification ratio that defines a problematic halocline region (nondim). real :: halocline_strat_tol = 0.25 - !> Nominal density of interfaces + !> Nominal density of interfaces, in kg m-3. real, allocatable, dimension(:) :: target_density - !> Maximum depths of interfaces + !> Maximum depths of interfaces, in m. real, allocatable, dimension(:) :: max_interface_depths - !> Maximum thicknesses of layers + !> Maximum thicknesses of layers, in m. real, allocatable, dimension(:) :: max_layer_thickness !> Interpolation control structure @@ -72,10 +71,10 @@ module coord_slight !> Initialise a slight_CS with pointers to parameters subroutine init_coord_slight(CS, nk, ref_pressure, target_density, interp_CS) type(slight_CS), pointer :: CS !< Unassociated pointer to hold the control structure - integer, intent(in) :: nk - real, intent(in) :: ref_pressure - real, dimension(:), intent(in) :: target_density - type(interp_CS_type), intent(in) :: interp_CS + integer, intent(in) :: nk !< Number of layers in the grid + real, intent(in) :: ref_pressure !< Nominal density of interfaces in Pa + real, dimension(:), intent(in) :: target_density !< Nominal density of interfaces in kg m-3 + type(interp_CS_type), intent(in) :: interp_CS !< Controls for interpolation if (associated(CS)) call MOM_error(FATAL, "init_coord_slight: CS already associated!") allocate(CS) @@ -87,8 +86,9 @@ subroutine init_coord_slight(CS, nk, ref_pressure, target_density, interp_CS) CS%interp_CS = interp_CS end subroutine init_coord_slight +!> This subroutine deallocates memory in the control structure for the coord_slight module subroutine end_coord_slight(CS) - type(slight_CS), pointer :: CS + type(slight_CS), pointer :: CS !< Coordinate control structure ! nothing to do if (.not. associated(CS)) return @@ -96,23 +96,37 @@ subroutine end_coord_slight(CS) deallocate(CS) end subroutine end_coord_slight +!> This subroutine can be used to set the parameters for the coord_slight module subroutine set_slight_params(CS, max_interface_depths, max_layer_thickness, & - min_thickness, compressibility_fraction, & - dz_ml_min, nz_fixed_surface, Rho_ML_avg_depth, nlay_ML_offset, fix_haloclines, & - halocline_filter_length, halocline_strat_tol, interp_CS) - type(slight_CS), pointer :: CS - real, optional, dimension(:), intent(in) :: max_interface_depths - real, optional, dimension(:), intent(in) :: max_layer_thickness - real, optional, intent(in) :: min_thickness - real, optional, intent(in) :: compressibility_fraction - real, optional, intent(in) :: dz_ml_min - integer, optional, intent(in) :: nz_fixed_surface - real, optional, intent(in) :: Rho_ML_avg_depth - real, optional, intent(in) :: nlay_ML_offset - logical, optional, intent(in) :: fix_haloclines - real, optional, intent(in) :: halocline_filter_length - real, optional, intent(in) :: halocline_strat_tol - type(interp_CS_type), optional, intent(in) :: interp_CS + min_thickness, compressibility_fraction, dz_ml_min, & + nz_fixed_surface, Rho_ML_avg_depth, nlay_ML_offset, fix_haloclines, & + halocline_filter_length, halocline_strat_tol, interp_CS) + type(slight_CS), pointer :: CS !< Coordinate control structure + real, dimension(:), & + optional, intent(in) :: max_interface_depths !< Maximum depths of interfaces in m + real, dimension(:), & + optional, intent(in) :: max_layer_thickness !< Maximum thicknesses of layers in m + real, optional, intent(in) :: min_thickness !< Minimum thickness allowed when building the + !! new grid through regridding, in m + real, optional, intent(in) :: compressibility_fraction !< Fraction (between 0 and 1) of + !! compressibility to add to potential density profiles when + !! interpolating for target grid positions. (nondim) + real, optional, intent(in) :: dz_ml_min !< The fixed resolution in the topmost + !! SLight_nkml_min layers (m) + integer, optional, intent(in) :: nz_fixed_surface !< The number of fixed-thickness layers at the + !! top of the model + real, optional, intent(in) :: Rho_ML_avg_depth !< Depth over which to average to determine + !! the mixed layer potential density (m) + real, optional, intent(in) :: nlay_ML_offset !< Number of layers to offset the mixed layer + !! density to find resolved stratification (nondim) + logical, optional, intent(in) :: fix_haloclines !< If true, detect regions with much weaker than + !! based on in-situ density, and use a stretched coordinate there. + real, optional, intent(in) :: halocline_filter_length !< A length scale over which to filter T & S + !! when looking for spuriously unstable water mass profiles, in m. + real, optional, intent(in) :: halocline_strat_tol !< A value of the stratification ratio that + !! defines a problematic halocline region (nondim). + type(interp_CS_type), & + optional, intent(in) :: interp_CS !< Controls for interpolation if (.not. associated(CS)) call MOM_error(FATAL, "set_slight_params: CS not associated") diff --git a/src/ALE/coord_zlike.F90 b/src/ALE/coord_zlike.F90 index 41fb61f6c3..7eafb5d5a6 100644 --- a/src/ALE/coord_zlike.F90 +++ b/src/ALE/coord_zlike.F90 @@ -28,8 +28,8 @@ module coord_zlike !> Initialise a zlike_CS with pointers to parameters subroutine init_coord_zlike(CS, nk, coordinateResolution) type(zlike_CS), pointer :: CS !< Unassociated pointer to hold the control structure - integer, intent(in) :: nk - real, dimension(:), intent(in) :: coordinateResolution + integer, intent(in) :: nk !< Number of levels in the grid + real, dimension(:), intent(in) :: coordinateResolution !< Target coordinate resolution, in m if (associated(CS)) call MOM_error(FATAL, "init_coord_zlike: CS already associated!") allocate(CS) @@ -52,7 +52,7 @@ end subroutine end_coord_zlike !> Set parameters in the zlike structure subroutine set_zlike_params(CS, min_thickness) type(zlike_CS), pointer :: CS !< Coordinate control structure - real, optional, intent(in) :: min_thickness !< Minimum allowed thickness + real, optional, intent(in) :: min_thickness !< Minimum allowed thickness, in m if (.not. associated(CS)) call MOM_error(FATAL, "set_zlike_params: CS not associated") From b224da434dab409765d82bd17e3aa478a46b75c9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 6 May 2018 13:55:50 -0400 Subject: [PATCH 0195/1072] Removed spaces between subroutine and arguments Changed 'call sub (...)' to 'call sub(...)' in several places. All answers are bitwise identical, and only white-space is changed. --- config_src/coupled_driver/MOM_surface_forcing.F90 | 2 +- src/core/MOM_PressureForce_analytic_FV.F90 | 10 +++++----- src/core/MOM_PressureForce_blocked_AFV.F90 | 4 ++-- src/diagnostics/MOM_sum_output.F90 | 2 +- src/equation_of_state/MOM_EOS.F90 | 10 +++++----- src/framework/MOM_horizontal_regridding.F90 | 4 ++-- src/tracer/MOM_offline_aux.F90 | 2 +- 7 files changed, 17 insertions(+), 17 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index d6319558ec..a76d37cd6e 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -1009,7 +1009,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res 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, "") diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 3f2ae7528a..672651ffb0 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -240,9 +240,9 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm ! of freedeom needed to know the linear profile). if ( use_ALE ) then if ( CS%Recon_Scheme == 1 ) then - call pressure_gradient_plm (ALE_CSp, S_t, S_b, T_t, T_b, G, GV, tv, h, CS%boundary_extrap) + call pressure_gradient_plm(ALE_CSp, S_t, S_b, T_t, T_b, G, GV, tv, h, CS%boundary_extrap) elseif ( CS%Recon_Scheme == 2) then - call pressure_gradient_ppm (ALE_CSp, S_t, S_b, T_t, T_b, G, GV, tv, h, CS%boundary_extrap) + call pressure_gradient_ppm(ALE_CSp, S_t, S_b, T_t, T_b, G, GV, tv, h, CS%boundary_extrap) endif endif @@ -253,7 +253,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm if (use_EOS) then if ( use_ALE ) then if ( CS%Recon_Scheme == 1 ) then - call int_spec_vol_dp_generic_plm ( T_t(:,:,k), T_b(:,:,k), & + call int_spec_vol_dp_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), p(:,:,K), p(:,:,K+1), & alpha_ref, dp_neglect, p(:,:,nz+1), G%HI, & tv%eqn_of_state, dza(:,:,k), intp_dza(:,:,k), & @@ -665,14 +665,14 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p ! where the layers are located. if ( use_ALE ) then if ( CS%Recon_Scheme == 1 ) then - call int_density_dz_generic_plm ( T_t(:,:,k), T_b(:,:,k), & + call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth, & dz_neglect, G%bathyT, G%HI, G%HI, & tv%eqn_of_state, dpa, intz_dpa, intx_dpa, inty_dpa, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then - call int_density_dz_generic_ppm ( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), & + call int_density_dz_generic_ppm( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), & tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth, & G%HI, G%HI, tv%eqn_of_state, dpa, intz_dpa, & diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 563972fcc5..1cad7d38c9 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -663,14 +663,14 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at ! where the layers are located. if ( use_ALE ) then if ( CS%Recon_Scheme == 1 ) then - call int_density_dz_generic_plm ( T_t(:,:,k), T_b(:,:,k), & + call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth, & dz_neglect, G%bathyT, G%HI, G%Block(n), & tv%eqn_of_state, dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then - call int_density_dz_generic_ppm ( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), & + call int_density_dz_generic_ppm( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), & tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth, & G%HI, G%Block(n), tv%eqn_of_state, dpa_bk, intz_dpa_bk, & diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index fd5bec139b..1dcaa2e516 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -223,7 +223,7 @@ subroutine MOM_sum_output_init(G, param_file, directory, ntrnc, & "The maximum velocity allowed before the velocity \n"//& "components are truncated.", units="m s-1", default=3.0e8) CS%max_Energy = 10.0 * maxvel**2 - call log_param (param_file, mdl, "MAX_ENERGY as used", CS%max_Energy) + call log_param(param_file, mdl, "MAX_ENERGY as used", CS%max_Energy) endif call get_param(param_file, mdl, "ENERGYFILE", energyfile, & diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index dc6a9869da..01167693f9 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -1680,10 +1680,10 @@ subroutine int_density_dz_generic_ppm (T, T_t, T_b, S, S_t, S_b, & S_node(9) = 0.5 * ( S_node(6) + S_node(8) ) S_node(7) = 0.5 * ( S_node(3) + S_node(4) ) - call calculate_density ( T_node, S_node, p_node, r_node, 1, 9, EOS ) + call calculate_density( T_node, S_node, p_node, r_node, 1, 9, EOS ) r_node = r_node - rho_ref - call compute_integral_quadratic ( x, y, r_node, intx_dpa(i-ioff,j-joff) ) + call compute_integral_quadratic( x, y, r_node, intx_dpa(i-ioff,j-joff) ) intx_dpa(i-ioff,j-joff) = intx_dpa(i-ioff,j-joff) * G_e @@ -1755,8 +1755,8 @@ subroutine compute_integral_quadratic ( x, y, f, integral ) do k = 1,9 ! Evaluate shape functions and gradients for isomorphism - call evaluate_shape_bilinear ( xi(k), eta(k), phiiso, & - dphiisodxi, dphiisodeta ) + call evaluate_shape_bilinear( xi(k), eta(k), phiiso, & + dphiisodxi, dphiisodeta ) ! Determine gradient of global coordinate at integration point dxdxi = 0.0 @@ -1775,7 +1775,7 @@ subroutine compute_integral_quadratic ( x, y, f, integral ) jacobian_k = dxdxi*dydeta - dydxi*dxdeta ! Evaluate shape functions for interpolation - call evaluate_shape_quadratic ( xi(k), eta(k), phi, dphidxi, dphideta ) + call evaluate_shape_quadratic( xi(k), eta(k), phi, dphidxi, dphideta ) ! Evaluate function at integration point f_k = 0.0 diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 79e3ebb60d..176e6e6d13 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -497,7 +497,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, call mpp_sync() call mpp_broadcast(tr_inp,id*jdp,root_PE()) - call mpp_sync_self () + call mpp_sync_self() mask_in=0.0 @@ -770,7 +770,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t call mpp_sync() call mpp_broadcast(tr_inp,id*jdp,root_PE()) - call mpp_sync_self () + call mpp_sync_self() mask_in=0.0 diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 49332bf813..a05d9c1023 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -578,7 +578,7 @@ subroutine offline_add_diurnal_SW(fluxes, G, Time_start, Time_end) call diurnal_solar(G%geoLatT(i,j)*rad, G%geoLonT(i,j)*rad, Time_start, cosz=cosz_dt, & fracday=fracday_dt, rrsun=rrsun_dt, dt_time=dt_here) - call daily_mean_solar (G%geoLatT(i,j)*rad, time_since_ae, cosz_day, fracday_day, rrsun_day) + call daily_mean_solar(G%geoLatT(i,j)*rad, time_since_ae, cosz_day, fracday_day, rrsun_day) diurnal_factor = cosz_dt*fracday_dt*rrsun_dt / & max(1e-30, cosz_day*fracday_day*rrsun_day) From 233f76c017b7c695016a6a16ff200345e965ee10 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 6 May 2018 13:56:29 -0400 Subject: [PATCH 0196/1072] Removed space between arrays and indices in MOM_ice_shelf Changed 'array (...)' to 'array(...)' and 'call sub (...)' to 'call sub(...)' in numerous places in MOM_ice_shelf.F90. All answers are bitwise identical, and only white-space is changed. --- src/ice_shelf/MOM_ice_shelf.F90 | 1106 +++++++++++++++---------------- 1 file changed, 553 insertions(+), 553 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 60f0c688d7..a07946d59d 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -244,7 +244,7 @@ module MOM_ice_shelf integer :: nonlin_solve_err_mode ! 1: exit vel solve based on nonlin residual ! 2: exit based on "fixed point" metric (|u - u_last| / |u| < tol where | | is infty-norm real :: CFL_factor ! in uncoupled run, how to limit subcycled advective timestep - ! i.e. dt = CFL_factor * min (dx / u) + ! i.e. dt = CFL_factor * min(dx / u) logical :: use_reproducing_sums !< use new reproducing sums of Bob & Alistair for !! global sums. !! NOTE: for this to work all tiles must have the same & of @@ -461,12 +461,12 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) endif if (CS%DEBUG) then - call hchksum (fluxes%frac_shelf_h, "frac_shelf_h before apply melting", G%HI, haloshift=0) - call hchksum (state%sst, "sst before apply melting", G%HI, haloshift=0) - call hchksum (state%sss, "sss before apply melting", G%HI, haloshift=0) - call hchksum (state%u, "u_ml before apply melting", G%HI, haloshift=0) - call hchksum (state%v, "v_ml before apply melting", G%HI, haloshift=0) - call hchksum (state%ocean_mass, "ocean_mass before apply melting", G%HI, haloshift=0) + call hchksum(fluxes%frac_shelf_h, "frac_shelf_h before apply melting", G%HI, haloshift=0) + call hchksum(state%sst, "sst before apply melting", G%HI, haloshift=0) + call hchksum(state%sss, "sss before apply melting", G%HI, haloshift=0) + call hchksum(state%u, "u_ml before apply melting", G%HI, haloshift=0) + call hchksum(state%v, "v_ml before apply melting", G%HI, haloshift=0) + call hchksum(state%ocean_mass, "ocean_mass before apply melting", G%HI, haloshift=0) endif do j=js,je @@ -809,7 +809,7 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) ! note time_step is [s] and lprec is [kg / m^2 / s] - call ice_shelf_advect (CS, time_step, CS%lprec, Time) + call ice_shelf_advect(CS, time_step, CS%lprec, Time) CS%velocity_update_sub_counter = CS%velocity_update_sub_counter+1 @@ -817,14 +817,14 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) call update_OD_ffrac(CS, state%ocean_mass, CS%velocity_update_sub_counter, CS%nstep_velocity, & CS%time_step, CS%velocity_update_time_step) else - call update_OD_ffrac_uncoupled (CS) + call update_OD_ffrac_uncoupled(CS) endif if (CS%velocity_update_sub_counter == CS%nstep_velocity) then if (is_root_pe()) write(*,*) "ABOUT TO CALL VELOCITY SOLVER" - call ice_shelf_solve_outer (CS, CS%u_shelf, CS%v_shelf, 1, iters_vel_solve, Time) + call ice_shelf_solve_outer(CS, CS%u_shelf, CS%v_shelf, 1, iters_vel_solve, Time) CS%velocity_update_sub_counter = 0 @@ -885,8 +885,8 @@ subroutine change_thickness_using_melt(CS,G,time_step, fluxes) if (associated(fluxes%p_surf)) fluxes%p_surf(i,j) = 0.0 if (associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = 0.0 - if (CS%lprec(i,j) / CS%density_ice * time_step < CS%h_shelf (i,j)) then - CS%h_shelf (i,j) = CS%h_shelf (i,j) - CS%lprec(i,j) / CS%density_ice * time_step + if (CS%lprec(i,j) / CS%density_ice * time_step < CS%h_shelf(i,j)) then + CS%h_shelf(i,j) = CS%h_shelf(i,j) - CS%lprec(i,j) / CS%density_ice * time_step else ! the ice is about to melt away ! in this case set thickness, area, and mask to zero @@ -917,8 +917,8 @@ subroutine change_thickness_using_melt(CS,G,time_step, fluxes) call pass_var(CS%mass_shelf, G%domain) if (CS%DEBUG) then - call hchksum (CS%h_shelf, "h_shelf after change thickness using melt", G%HI, haloshift=0) - call hchksum (CS%mass_shelf, "mass_shelf after change thickness using melt", G%HI, haloshift=0) + call hchksum(CS%h_shelf, "h_shelf after change thickness using melt", G%HI, haloshift=0) + call hchksum(CS%mass_shelf, "mass_shelf after change thickness using melt", G%HI, haloshift=0) endif end subroutine change_thickness_using_melt @@ -1109,7 +1109,7 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) ! apply calving if (CS%min_thickness_simple_calve > 0.0) then - call ice_shelf_min_thickness_calve (CS,last_h_shelf,last_area_shelf_h,last_hmask) + call ice_shelf_min_thickness_calve(CS,last_h_shelf,last_area_shelf_h,last_hmask) ! convert to mass again last_mass_shelf = last_h_shelf * CS%density_ice endif @@ -1523,45 +1523,45 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl allocate( CS%exch_vel_s(isd:ied,jsd:jed) ) ; CS%exch_vel_s(:,:) = 0.0 allocate( CS%exch_vel_t(isd:ied,jsd:jed) ) ; CS%exch_vel_t(:,:) = 0.0 - allocate ( CS%h_shelf(isd:ied,jsd:jed) ) ; CS%h_shelf(:,:) = 0.0 - allocate ( CS%hmask(isd:ied,jsd:jed) ) ; CS%hmask(:,:) = -2.0 + allocate( CS%h_shelf(isd:ied,jsd:jed) ) ; CS%h_shelf(:,:) = 0.0 + allocate( CS%hmask(isd:ied,jsd:jed) ) ; CS%hmask(:,:) = -2.0 ! OVS vertically integrated Temperature - allocate ( CS%t_shelf(isd:ied,jsd:jed) ) ; CS%t_shelf(:,:) = -10.0 - allocate ( CS%t_boundary_values(isd:ied,jsd:jed) ) ; CS%t_boundary_values(:,:) = -15.0 - allocate ( CS%tmask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%tmask(:,:) = -1.0 + allocate( CS%t_shelf(isd:ied,jsd:jed) ) ; CS%t_shelf(:,:) = -10.0 + allocate( CS%t_boundary_values(isd:ied,jsd:jed) ) ; CS%t_boundary_values(:,:) = -15.0 + allocate( CS%tmask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%tmask(:,:) = -1.0 if (CS%shelf_mass_is_dynamic .and. .not.CS%override_shelf_movement) then ! DNG - allocate ( CS%u_shelf(Isdq:Iedq,Jsdq:Jedq) ) ; CS%u_shelf(:,:) = 0.0 - allocate ( CS%v_shelf(Isdq:Iedq,Jsdq:Jedq) ) ; CS%v_shelf(:,:) = 0.0 - allocate ( CS%u_boundary_values(Isdq:Iedq,Jsdq:Jedq) ) ; CS%u_boundary_values(:,:) = 0.0 - allocate ( CS%v_boundary_values(Isdq:Iedq,Jsdq:Jedq) ) ; CS%v_boundary_values(:,:) = 0.0 - allocate ( CS%h_boundary_values(isd:ied,jsd:jed) ) ; CS%h_boundary_values(:,:) = 0.0 - allocate ( CS%thickness_boundary_values(isd:ied,jsd:jed) ) ; CS%thickness_boundary_values(:,:) = 0.0 - allocate ( CS%ice_visc_bilinear(isd:ied,jsd:jed) ) ; CS%ice_visc_bilinear(:,:) = 0.0 - allocate ( CS%ice_visc_lower_tri(isd:ied,jsd:jed) ) ; CS%ice_visc_lower_tri = 0.0 - allocate ( CS%ice_visc_upper_tri(isd:ied,jsd:jed) ) ; CS%ice_visc_upper_tri = 0.0 - allocate ( CS%u_face_mask(Isdq:Iedq,jsd:jed) ) ; CS%u_face_mask(:,:) = 0.0 - allocate ( CS%v_face_mask(isd:ied,Jsdq:Jedq) ) ; CS%v_face_mask(:,:) = 0.0 - allocate ( CS%u_face_mask_boundary(Isdq:Iedq,jsd:jed) ) ; CS%u_face_mask_boundary(:,:) = -2.0 - allocate ( CS%v_face_mask_boundary(isd:ied,Jsdq:Jedq) ) ; CS%v_face_mask_boundary(:,:) = -2.0 - allocate ( CS%u_flux_boundary_values(Isdq:Iedq,jsd:jed) ) ; CS%u_flux_boundary_values(:,:) = 0.0 - allocate ( CS%v_flux_boundary_values(isd:ied,Jsdq:Jedq) ) ; CS%v_flux_boundary_values(:,:) = 0.0 - allocate ( CS%umask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%umask(:,:) = -1.0 - allocate ( CS%vmask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%vmask(:,:) = -1.0 - - allocate ( CS%taub_beta_eff_bilinear(isd:ied,jsd:jed) ) ; CS%taub_beta_eff_bilinear(:,:) = 0.0 - allocate ( CS%taub_beta_eff_upper_tri(isd:ied,jsd:jed) ) ; CS%taub_beta_eff_upper_tri(:,:) = 0.0 - allocate ( CS%taub_beta_eff_lower_tri(isd:ied,jsd:jed) ) ; CS%taub_beta_eff_lower_tri(:,:) = 0.0 - allocate ( CS%OD_rt(isd:ied,jsd:jed) ) ; CS%OD_rt(:,:) = 0.0 - allocate ( CS%OD_av(isd:ied,jsd:jed) ) ; CS%OD_av(:,:) = 0.0 - allocate ( CS%float_frac(isd:ied,jsd:jed) ) ; CS%float_frac(:,:) = 0.0 - allocate ( CS%float_frac_rt(isd:ied,jsd:jed) ) ; CS%float_frac_rt(:,:) = 0.0 + allocate( CS%u_shelf(Isdq:Iedq,Jsdq:Jedq) ) ; CS%u_shelf(:,:) = 0.0 + allocate( CS%v_shelf(Isdq:Iedq,Jsdq:Jedq) ) ; CS%v_shelf(:,:) = 0.0 + allocate( CS%u_boundary_values(Isdq:Iedq,Jsdq:Jedq) ) ; CS%u_boundary_values(:,:) = 0.0 + allocate( CS%v_boundary_values(Isdq:Iedq,Jsdq:Jedq) ) ; CS%v_boundary_values(:,:) = 0.0 + allocate( CS%h_boundary_values(isd:ied,jsd:jed) ) ; CS%h_boundary_values(:,:) = 0.0 + allocate( CS%thickness_boundary_values(isd:ied,jsd:jed) ) ; CS%thickness_boundary_values(:,:) = 0.0 + allocate( CS%ice_visc_bilinear(isd:ied,jsd:jed) ) ; CS%ice_visc_bilinear(:,:) = 0.0 + allocate( CS%ice_visc_lower_tri(isd:ied,jsd:jed) ) ; CS%ice_visc_lower_tri = 0.0 + allocate( CS%ice_visc_upper_tri(isd:ied,jsd:jed) ) ; CS%ice_visc_upper_tri = 0.0 + allocate( CS%u_face_mask(Isdq:Iedq,jsd:jed) ) ; CS%u_face_mask(:,:) = 0.0 + allocate( CS%v_face_mask(isd:ied,Jsdq:Jedq) ) ; CS%v_face_mask(:,:) = 0.0 + allocate( CS%u_face_mask_boundary(Isdq:Iedq,jsd:jed) ) ; CS%u_face_mask_boundary(:,:) = -2.0 + allocate( CS%v_face_mask_boundary(isd:ied,Jsdq:Jedq) ) ; CS%v_face_mask_boundary(:,:) = -2.0 + allocate( CS%u_flux_boundary_values(Isdq:Iedq,jsd:jed) ) ; CS%u_flux_boundary_values(:,:) = 0.0 + allocate( CS%v_flux_boundary_values(isd:ied,Jsdq:Jedq) ) ; CS%v_flux_boundary_values(:,:) = 0.0 + allocate( CS%umask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%umask(:,:) = -1.0 + allocate( CS%vmask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%vmask(:,:) = -1.0 + + allocate( CS%taub_beta_eff_bilinear(isd:ied,jsd:jed) ) ; CS%taub_beta_eff_bilinear(:,:) = 0.0 + allocate( CS%taub_beta_eff_upper_tri(isd:ied,jsd:jed) ) ; CS%taub_beta_eff_upper_tri(:,:) = 0.0 + allocate( CS%taub_beta_eff_lower_tri(isd:ied,jsd:jed) ) ; CS%taub_beta_eff_lower_tri(:,:) = 0.0 + allocate( CS%OD_rt(isd:ied,jsd:jed) ) ; CS%OD_rt(:,:) = 0.0 + allocate( CS%OD_av(isd:ied,jsd:jed) ) ; CS%OD_av(:,:) = 0.0 + allocate( CS%float_frac(isd:ied,jsd:jed) ) ; CS%float_frac(:,:) = 0.0 + allocate( CS%float_frac_rt(isd:ied,jsd:jed) ) ; CS%float_frac_rt(:,:) = 0.0 if (CS%calve_to_mask) then - allocate ( CS%calve_mask (isd:ied,jsd:jed) ) ; CS%calve_mask(:,:) = 0.0 + allocate( CS%calve_mask(isd:ied,jsd:jed) ) ; CS%calve_mask(:,:) = 0.0 endif endif @@ -1662,7 +1662,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if (new_sim) then ! new simulation, initialize ice thickness as in the static case - call initialize_ice_thickness (CS%h_shelf, CS%area_shelf_h, CS%hmask, G, param_file) + call initialize_ice_thickness(CS%h_shelf, CS%area_shelf_h, CS%hmask, G, param_file) ! next make sure mass is consistent with thickness do j=G%jsd,G%jed @@ -1674,7 +1674,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl enddo if (CS%min_thickness_simple_calve > 0.0) then - call ice_shelf_min_thickness_calve (CS, CS%h_shelf, CS%area_shelf_h, CS%hmask) + call ice_shelf_min_thickness_calve(CS, CS%h_shelf, CS%area_shelf_h, CS%hmask) endif endif @@ -1699,7 +1699,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if (new_sim .and. (.not. (CS%override_shelf_movement .and. CS%mass_from_file))) then ! This model is initialized internally or from a file. - call initialize_ice_thickness (CS%h_shelf, CS%area_shelf_h, CS%hmask, G, param_file) + call initialize_ice_thickness(CS%h_shelf, CS%area_shelf_h, CS%hmask, G, param_file) ! next make sure mass is consistent with thickness do j=G%jsd,G%jed @@ -1730,25 +1730,25 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl do j=G%jsd,G%jed do i=G%isd,G%ied if (((i+G%idg_offset) == (G%domain%nihalo+1)).and.(CS%u_face_mask(i-1,j) == 3)) then - CS%u_shelf (i-1,j-1) = CS%u_boundary_values (i-1,j-1) - CS%u_shelf (i-1,j) = CS%u_boundary_values (i-1,j) + CS%u_shelf(i-1,j-1) = CS%u_boundary_values(i-1,j-1) + CS%u_shelf(i-1,j) = CS%u_boundary_values(i-1,j) endif if (((j+G%jdg_offset) == (G%domain%njhalo+1)).and.(CS%v_face_mask(i,j-1) == 3)) then - CS%u_shelf (i-1,j-1) = CS%u_boundary_values (i-1,j-1) - CS%u_shelf (i,j-1) = CS%u_boundary_values (i,j-1) + CS%u_shelf(i-1,j-1) = CS%u_boundary_values(i-1,j-1) + CS%u_shelf(i,j-1) = CS%u_boundary_values(i,j-1) endif enddo enddo endif - call pass_var (CS%OD_av,G%domain) - call pass_var (CS%float_frac,G%domain) - call pass_var (CS%ice_visc_bilinear,G%domain) - call pass_var (CS%taub_beta_eff_bilinear,G%domain) + call pass_var(CS%OD_av,G%domain) + call pass_var(CS%float_frac,G%domain) + call pass_var(CS%ice_visc_bilinear,G%domain) + call pass_var(CS%taub_beta_eff_bilinear,G%domain) call pass_vector(CS%u_shelf, CS%v_shelf, G%domain, TO_ALL, BGRID_NE) - call pass_var (CS%area_shelf_h,G%domain) - call pass_var (CS%h_shelf,G%domain) - call pass_var (CS%hmask,G%domain) + call pass_var(CS%area_shelf_h,G%domain) + call pass_var(CS%h_shelf,G%domain) + call pass_var(CS%hmask,G%domain) if (is_root_pe()) PRINT *, "RESTORING ICE SHELF FROM FILE!!!!!!!!!!!!!" endif @@ -1766,7 +1766,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call cpu_clock_begin(id_clock_pass) call pass_var(G%bathyT, G%domain) call pass_var(CS%hmask, G%domain) - call update_velocity_masks (CS) + call update_velocity_masks(CS) call cpu_clock_end(id_clock_pass) endif @@ -1787,7 +1787,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl enddo ; enddo if (CS%DEBUG) then - call hchksum (fluxes%frac_shelf_h, "IS init: frac_shelf_h", G%HI, haloshift=0) + call hchksum(fluxes%frac_shelf_h, "IS init: frac_shelf_h", G%HI, haloshift=0) endif if (present(forces) .and. .not. CS%solo_ice_sheet) then @@ -1847,11 +1847,11 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl enddo enddo - call pass_var (CS%calve_mask,G%domain) + call pass_var(CS%calve_mask,G%domain) endif if (CS%shelf_mass_is_dynamic .and. .not.CS%override_shelf_movement) then -! call init_boundary_values (CS, time, CS%input_flux, CS%input_thickness, new_sim) +! call init_boundary_values(CS, time, CS%input_flux, CS%input_thickness, new_sim) if (.not. CS%isthermo) then CS%lprec(:,:) = 0.0 @@ -1860,8 +1860,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if (new_sim) then if (is_root_pe()) print *,"NEW SIM: initialize velocity" - call update_OD_ffrac_uncoupled (CS) - call ice_shelf_solve_outer (CS, CS%u_shelf, CS%v_shelf, 1, iters, Time) + call update_OD_ffrac_uncoupled(CS) + call ice_shelf_solve_outer(CS, CS%u_shelf, CS%v_shelf, 1, iters, Time) ! write (procnum,'(I2)') mpp_pe() @@ -2075,7 +2075,7 @@ subroutine update_shelf_mass(G, CS, Time, fluxes) ! CS%hmask, CS%grid, CS%user_CS, Time, .true.) if (CS%min_thickness_simple_calve > 0.0) then - call ice_shelf_min_thickness_calve (CS, CS%h_shelf, CS%area_shelf_h, CS%hmask) + call ice_shelf_min_thickness_calve(CS, CS%h_shelf, CS%area_shelf_h, CS%hmask) endif call pass_var(CS%area_shelf_h, G%domain) @@ -2097,7 +2097,7 @@ subroutine update_shelf_mass(G, CS, Time, fluxes) end subroutine update_shelf_mass -subroutine initialize_diagnostic_fields (CS, FE, Time) +subroutine initialize_diagnostic_fields(CS, FE, Time) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure integer :: FE type(time_type), intent(in) :: Time @@ -2119,19 +2119,19 @@ subroutine initialize_diagnostic_fields (CS, FE, Time) do j=jsd,jed do i=isd,ied - OD = G%bathyT(i,j) - rhoi/rhow * h_shelf (i,j) + OD = G%bathyT(i,j) - rhoi/rhow * h_shelf(i,j) if (OD >= 0) then ! ice thickness does not take up whole ocean column -> floating - OD_av (i,j) = OD + OD_av(i,j) = OD float_frac(i,j) = 0. else - OD_av (i,j) = 0. + OD_av(i,j) = 0. float_frac(i,j) = 1. endif enddo enddo - call ice_shelf_solve_outer (CS, CS%u_shelf, CS%v_shelf, FE, iters, dummy_time) + call ice_shelf_solve_outer(CS, CS%u_shelf, CS%v_shelf, FE, iters, dummy_time) end subroutine initialize_diagnostic_fields @@ -2200,10 +2200,10 @@ subroutine ice_shelf_advect(CS, time_step, melt_rate, Time) ! ###Perhaps flux_enter should be changed into u-face and v-face ! ###fluxes, which can then be used in halo updates, etc. ! - ! from left neighbor: flux_enter (:,:,1) - ! from right neighbor: flux_enter (:,:,2) - ! from bottom neighbor: flux_enter (:,:,3) - ! from top neighbor: flux_enter (:,:,4) + ! from left neighbor: flux_enter(:,:,1) + ! from right neighbor: flux_enter(:,:,2) + ! from bottom neighbor: flux_enter(:,:,3) + ! from top neighbor: flux_enter(:,:,4) ! ! THESE ARE NOT CONSISTENT ==> FIND OUT WHAT YOU IMPLEMENTED @@ -2231,10 +2231,10 @@ subroutine ice_shelf_advect(CS, time_step, melt_rate, Time) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec - flux_enter (:,:,:) = 0.0 + flux_enter(:,:,:) = 0.0 - h_after_uflux (:,:) = 0.0 - h_after_vflux (:,:) = 0.0 + h_after_uflux(:,:) = 0.0 + h_after_vflux(:,:) = 0.0 ! if (is_root_pe()) write(*,*) "ice_shelf_advect called" do j=jsd,jed @@ -2246,35 +2246,35 @@ subroutine ice_shelf_advect(CS, time_step, melt_rate, Time) enddo enddo - call ice_shelf_advect_thickness_x (CS, time_step/spy, CS%h_shelf, h_after_uflux, flux_enter) + call ice_shelf_advect_thickness_x(CS, time_step/spy, CS%h_shelf, h_after_uflux, flux_enter) ! call enable_averaging(time_step,Time,CS%diag) - ! call pass_var (h_after_uflux, G%domain) + ! call pass_var(h_after_uflux, G%domain) ! if (CS%id_h_after_uflux > 0) call post_data(CS%id_h_after_uflux, h_after_uflux, CS%diag) ! call disable_averaging(CS%diag) - call ice_shelf_advect_thickness_y (CS, time_step/spy, h_after_uflux, h_after_vflux, flux_enter) + call ice_shelf_advect_thickness_y(CS, time_step/spy, h_after_uflux, h_after_vflux, flux_enter) ! call enable_averaging(time_step,Time,CS%diag) -! call pass_var (h_after_vflux, G%domain) +! call pass_var(h_after_vflux, G%domain) ! if (CS%id_h_after_vflux > 0) call post_data(CS%id_h_after_vflux, h_after_vflux, CS%diag) ! call disable_averaging(CS%diag) do j=jsd,jed do i=isd,ied if (CS%hmask(i,j) == 1) then - CS%h_shelf (i,j) = h_after_vflux(i,j) + CS%h_shelf(i,j) = h_after_vflux(i,j) endif enddo enddo if (CS%moving_shelf_front) then - call shelf_advance_front (CS, flux_enter) + call shelf_advance_front(CS, flux_enter) if (CS%min_thickness_simple_calve > 0.0) then - call ice_shelf_min_thickness_calve (CS, CS%h_shelf, CS%area_shelf_h, CS%hmask) + call ice_shelf_min_thickness_calve(CS, CS%h_shelf, CS%area_shelf_h, CS%hmask) endif if (CS%calve_to_mask) then - call calve_to_mask (CS, CS%h_shelf, CS%area_shelf_h, CS%hmask, CS%calve_mask) + call calve_to_mask(CS, CS%h_shelf, CS%area_shelf_h, CS%hmask, CS%calve_mask) endif endif @@ -2284,11 +2284,11 @@ subroutine ice_shelf_advect(CS, time_step, melt_rate, Time) !call change_thickness_using_melt(CS,G,time_step, fluxes) - call update_velocity_masks (CS) + call update_velocity_masks(CS) end subroutine ice_shelf_advect -subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) +subroutine ice_shelf_solve_outer(CS, u, v, FE, iters, time) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u, v integer, intent(in) :: FE @@ -2304,8 +2304,8 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) real :: err_max, err_tempu, err_tempv, err_init, area, max_vel, tempu, tempv, rhoi, rhow real, pointer, dimension(:,:,:,:) :: Phi real, pointer, dimension(:,:,:,:,:,:) :: Phisub - real, dimension (8,4) :: Phi_temp - real, dimension (2,2) :: X,Y + real, dimension(8,4) :: Phi_temp + real, dimension(2,2) :: X,Y character(2) :: iternum character(2) :: procnum, numproc @@ -2317,18 +2317,18 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed rhoi = CS%density_ice rhow = CS%density_ocean_avg - allocate(TAUDX (isdq:iedq,jsdq:jedq) ) ; TAUDX(:,:)=0 - allocate(TAUDY (isdq:iedq,jsdq:jedq) ) ; TAUDY(:,:)=0 - allocate(u_prev_iterate (isdq:iedq,jsdq:jedq) ) - allocate(v_prev_iterate (isdq:iedq,jsdq:jedq) ) - allocate(u_bdry_cont (isdq:iedq,jsdq:jedq) ) ; u_bdry_cont(:,:)=0 - allocate(v_bdry_cont (isdq:iedq,jsdq:jedq) ) ; v_bdry_cont(:,:)=0 - allocate(Au (isdq:iedq,jsdq:jedq) ) ; Au(:,:)=0 - allocate(Av (isdq:iedq,jsdq:jedq) ) ; Av(:,:)=0 - allocate(err_u (isdq:iedq,jsdq:jedq) ) - allocate(err_v (isdq:iedq,jsdq:jedq) ) - allocate(u_last (isdq:iedq,jsdq:jedq) ) - allocate(v_last (isdq:iedq,jsdq:jedq) ) + allocate(TAUDX(isdq:iedq,jsdq:jedq) ) ; TAUDX(:,:)=0 + allocate(TAUDY(isdq:iedq,jsdq:jedq) ) ; TAUDY(:,:)=0 + allocate(u_prev_iterate(isdq:iedq,jsdq:jedq) ) + allocate(v_prev_iterate(isdq:iedq,jsdq:jedq) ) + allocate(u_bdry_cont(isdq:iedq,jsdq:jedq) ) ; u_bdry_cont(:,:)=0 + allocate(v_bdry_cont(isdq:iedq,jsdq:jedq) ) ; v_bdry_cont(:,:)=0 + allocate(Au(isdq:iedq,jsdq:jedq) ) ; Au(:,:)=0 + allocate(Av(isdq:iedq,jsdq:jedq) ) ; Av(:,:)=0 + allocate(err_u(isdq:iedq,jsdq:jedq) ) + allocate(err_v(isdq:iedq,jsdq:jedq) ) + allocate(u_last(isdq:iedq,jsdq:jedq) ) + allocate(v_last(isdq:iedq,jsdq:jedq) ) ! need to make these conditional on GL interpolation allocate(float_cond (G%isd:G%ied,G%jsd:G%jed)) ; float_cond(:,:)=0 @@ -2353,7 +2353,7 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) jsumstart = JSUMSTART_INT_ endif - call calc_shelf_driving_stress (CS, TAUDX, TAUDY, CS%OD_av, FE) + call calc_shelf_driving_stress(CS, TAUDX, TAUDY, CS%OD_av, FE) ! this is to determine which cells contain the grounding line, ! the criterion being that the cell is ice-covered, with some nodes @@ -2365,7 +2365,7 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) if (CS%GL_regularize) then - call interpolate_H_to_B (CS, CS%h_shelf, CS%hmask, H_node) + call interpolate_H_to_B(CS, CS%h_shelf, CS%hmask, H_node) call savearray2 ("H_node",H_node,CS%write_output_to_file) do j=G%jsc,G%jec @@ -2381,16 +2381,16 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) enddo if ((nodefloat > 0) .and. (nodefloat < 4)) then !print *,"nodefloat",nodefloat - float_cond (i,j) = 1.0 - CS%float_frac (i,j) = 1.0 + float_cond(i,j) = 1.0 + CS%float_frac(i,j) = 1.0 endif enddo enddo call savearray2 ("float_cond",float_cond,CS%write_output_to_file) - call pass_var (float_cond, G%Domain) + call pass_var(float_cond, G%Domain) - call bilinear_shape_functions_subgrid (Phisub, nsub) + call bilinear_shape_functions_subgrid(Phisub, nsub) call savearray2("Phisub1111",Phisub(:,:,1,1,1,1),CS%write_output_to_file) @@ -2398,21 +2398,21 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) ! make above conditional - u_prev_iterate (:,:) = u(:,:) - v_prev_iterate (:,:) = v(:,:) + u_prev_iterate(:,:) = u(:,:) + v_prev_iterate(:,:) = v(:,:) isym=0 ! must prepare phi if (FE == 1) then - allocate (Phi (isd:ied,jsd:jed,1:8,1:4)) ; Phi(:,:,:,:)=0 + allocate(Phi(isd:ied,jsd:jed,1:8,1:4)) ; Phi(:,:,:,:)=0 do j=jsd,jed do i=isd,ied if (((i > isd) .and. (j > jsd)) .or. (isym == 1)) then - X(:,:) = geolonq (i-1:i,j-1:j)*1000 - Y(:,:) = geolatq (i-1:i,j-1:j)*1000 + X(:,:) = geolonq(i-1:i,j-1:j)*1000 + Y(:,:) = geolatq(i-1:i,j-1:j)*1000 else X(2,:) = geolonq(i,j)*1000 X(1,:) = geolonq(i,j)*1000-G%dxT(i,j) @@ -2420,25 +2420,25 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) Y(:,1) = geolatq(i,j)*1000-G%dyT(i,j) endif - call bilinear_shape_functions (X, Y, Phi_temp, area) - Phi (i,j,:,:) = Phi_temp + call bilinear_shape_functions(X, Y, Phi_temp, area) + Phi(i,j,:,:) = Phi_temp enddo enddo endif if (FE == 1) then - call calc_shelf_visc_bilinear (CS, u, v) + call calc_shelf_visc_bilinear(CS, u, v) - call pass_var (CS%ice_visc_bilinear, G%domain) - call pass_var (CS%taub_beta_eff_bilinear, G%domain) + call pass_var(CS%ice_visc_bilinear, G%domain) + call pass_var(CS%taub_beta_eff_bilinear, G%domain) else - call calc_shelf_visc_triangular (CS,u,v) + call calc_shelf_visc_triangular(CS,u,v) - call pass_var (CS%ice_visc_upper_tri, G%domain) - call pass_var (CS%taub_beta_eff_upper_tri, G%domain) - call pass_var (CS%ice_visc_lower_tri, G%domain) - call pass_var (CS%taub_beta_eff_lower_tri, G%domain) + call pass_var(CS%ice_visc_upper_tri, G%domain) + call pass_var(CS%taub_beta_eff_upper_tri, G%domain) + call pass_var(CS%ice_visc_lower_tri, G%domain) + call pass_var(CS%taub_beta_eff_lower_tri, G%domain) endif ! makes sure basal stress is only applied when it is supposed to be @@ -2446,29 +2446,29 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) do j=G%jsd,G%jed do i=G%isd,G%ied if (FE == 1) then - CS%taub_beta_eff_bilinear (i,j) = CS%taub_beta_eff_bilinear (i,j) * CS%float_frac (i,j) + CS%taub_beta_eff_bilinear(i,j) = CS%taub_beta_eff_bilinear(i,j) * CS%float_frac(i,j) else - CS%taub_beta_eff_upper_tri (i,j) = CS%taub_beta_eff_upper_tri (i,j) * CS%float_frac (i,j) - CS%taub_beta_eff_lower_tri (i,j) = CS%taub_beta_eff_lower_tri (i,j) * CS%float_frac (i,j) + CS%taub_beta_eff_upper_tri(i,j) = CS%taub_beta_eff_upper_tri(i,j) * CS%float_frac(i,j) + CS%taub_beta_eff_lower_tri(i,j) = CS%taub_beta_eff_lower_tri(i,j) * CS%float_frac(i,j) endif enddo enddo if (FE == 1) then - call apply_boundary_values_bilinear (CS, time, Phisub, H_node, float_cond, & + call apply_boundary_values_bilinear(CS, time, Phisub, H_node, float_cond, & rhoi/rhow, u_bdry_cont, v_bdry_cont) elseif (FE == 2) then - call apply_boundary_values_triangle (CS, time, u_bdry_cont, v_bdry_cont) + call apply_boundary_values_triangle(CS, time, u_bdry_cont, v_bdry_cont) endif Au(:,:) = 0.0 ; Av(:,:) = 0.0 if (FE == 1) then - call CG_action_bilinear (Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, CS%hmask, H_node, & + call CG_action_bilinear(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, CS%hmask, H_node, & CS%ice_visc_bilinear, float_cond, G%bathyT, CS%taub_beta_eff_bilinear, G%areaT, & G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) elseif (FE == 2) then - call CG_action_triangular (Au, Av, u, v, CS%umask, CS%vmask, CS%hmask, CS%ice_visc_upper_tri, & + call CG_action_triangular(Au, Av, u, v, CS%umask, CS%vmask, CS%hmask, CS%ice_visc_upper_tri, & CS%ice_visc_lower_tri, CS%taub_beta_eff_upper_tri, CS%taub_beta_eff_lower_tri, & G%dxT, G%dyT, G%areaT, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, isym) endif @@ -2491,7 +2491,7 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) enddo enddo - call mpp_max (err_init) + call mpp_max(err_init) if (is_root_pe()) print *,"INITIAL nonlinear residual: ",err_init @@ -2502,27 +2502,27 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) do iter=1,100 - call ice_shelf_solve_inner (CS, u, v, TAUDX, TAUDY, H_node, float_cond, & + call ice_shelf_solve_inner(CS, u, v, TAUDX, TAUDY, H_node, float_cond, & FE, conv_flag, iters, time, Phi, Phisub) if (CS%DEBUG) then - call qchksum (u, "u shelf", G%HI, haloshift=2) - call qchksum (v, "v shelf", G%HI, haloshift=2) + call qchksum(u, "u shelf", G%HI, haloshift=2) + call qchksum(v, "v shelf", G%HI, haloshift=2) endif if (is_root_pe()) print *,"linear solve done",iters," iterations" if (FE == 1) then - call calc_shelf_visc_bilinear (CS,u,v) - call pass_var (CS%ice_visc_bilinear, G%domain) - call pass_var (CS%taub_beta_eff_bilinear, G%domain) + call calc_shelf_visc_bilinear(CS,u,v) + call pass_var(CS%ice_visc_bilinear, G%domain) + call pass_var(CS%taub_beta_eff_bilinear, G%domain) else - call calc_shelf_visc_triangular (CS,u,v) - call pass_var (CS%ice_visc_upper_tri, G%domain) - call pass_var (CS%taub_beta_eff_upper_tri, G%domain) - call pass_var (CS%ice_visc_lower_tri, G%domain) - call pass_var (CS%taub_beta_eff_lower_tri, G%domain) + call calc_shelf_visc_triangular(CS,u,v) + call pass_var(CS%ice_visc_upper_tri, G%domain) + call pass_var(CS%taub_beta_eff_upper_tri, G%domain) + call pass_var(CS%ice_visc_lower_tri, G%domain) + call pass_var(CS%taub_beta_eff_lower_tri, G%domain) endif if (iter == 1) then @@ -2534,31 +2534,31 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) do j=G%jsd,G%jed do i=G%isd,G%ied if (FE == 1) then - CS%taub_beta_eff_bilinear (i,j) = CS%taub_beta_eff_bilinear (i,j) * CS%float_frac (i,j) + CS%taub_beta_eff_bilinear(i,j) = CS%taub_beta_eff_bilinear(i,j) * CS%float_frac(i,j) else - CS%taub_beta_eff_upper_tri (i,j) = CS%taub_beta_eff_upper_tri (i,j) * CS%float_frac (i,j) - CS%taub_beta_eff_lower_tri (i,j) = CS%taub_beta_eff_lower_tri (i,j) * CS%float_frac (i,j) + CS%taub_beta_eff_upper_tri(i,j) = CS%taub_beta_eff_upper_tri(i,j) * CS%float_frac(i,j) + CS%taub_beta_eff_lower_tri(i,j) = CS%taub_beta_eff_lower_tri(i,j) * CS%float_frac(i,j) endif enddo enddo - u_bdry_cont (:,:) = 0 ; v_bdry_cont (:,:) = 0 + u_bdry_cont(:,:) = 0 ; v_bdry_cont(:,:) = 0 if (FE == 1) then - call apply_boundary_values_bilinear (CS, time, Phisub, H_node, float_cond, & + call apply_boundary_values_bilinear(CS, time, Phisub, H_node, float_cond, & rhoi/rhow, u_bdry_cont, v_bdry_cont) elseif (FE == 2) then - call apply_boundary_values_triangle (CS, time, u_bdry_cont, v_bdry_cont) + call apply_boundary_values_triangle(CS, time, u_bdry_cont, v_bdry_cont) endif Au(:,:) = 0 ; Av(:,:) = 0 if (FE == 1) then - call CG_action_bilinear (Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, CS%hmask, H_node, & + call CG_action_bilinear(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, CS%hmask, H_node, & CS%ice_visc_bilinear, float_cond, G%bathyT, CS%taub_beta_eff_bilinear, G%areaT, G%isc-1, & G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) elseif (FE == 2) then - call CG_action_triangular (Au, Av, u, v, CS%umask, CS%vmask, CS%hmask, CS%ice_visc_upper_tri, & + call CG_action_triangular(Au, Av, u, v, CS%umask, CS%vmask, CS%hmask, CS%ice_visc_upper_tri, & CS%ice_visc_lower_tri, CS%taub_beta_eff_upper_tri, CS%taub_beta_eff_lower_tri, & G%dxT, G%dyT, G%areaT, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, isym) endif @@ -2581,7 +2581,7 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) enddo enddo - call mpp_max (err_max) + call mpp_max(err_max) elseif (CS%nonlin_solve_err_mode == 2) then @@ -2606,11 +2606,11 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) enddo enddo - u_last (:,:) = u(:,:) - v_last (:,:) = v(:,:) + u_last(:,:) = u(:,:) + v_last(:,:) = v(:,:) - call mpp_max (max_vel) - call mpp_max (err_max) + call mpp_max(max_vel) + call mpp_max(err_max) err_init = max_vel endif @@ -2628,25 +2628,25 @@ subroutine ice_shelf_solve_outer (CS, u, v, FE, iters, time) !write (procnum,'(I1)') mpp_pe() !write (numproc,'(I1)') mpp_npes() - deallocate (TAUDX) - deallocate (TAUDY) - deallocate (u_prev_iterate) - deallocate (v_prev_iterate) - deallocate (u_bdry_cont) - deallocate (v_bdry_cont) - deallocate (Au) - deallocate (Av) - deallocate (err_u) - deallocate (err_v) - deallocate (u_last) - deallocate (v_last) - deallocate (H_node) - deallocate (float_cond) - deallocate (Phisub) + deallocate(TAUDX) + deallocate(TAUDY) + deallocate(u_prev_iterate) + deallocate(v_prev_iterate) + deallocate(u_bdry_cont) + deallocate(v_bdry_cont) + deallocate(Au) + deallocate(Av) + deallocate(err_u) + deallocate(err_v) + deallocate(u_last) + deallocate(v_last) + deallocate(H_node) + deallocate(float_cond) + deallocate(Phisub) end subroutine ice_shelf_solve_outer -subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE, conv_flag, iters, time, Phi, Phisub) +subroutine ice_shelf_solve_inner(CS, u, v, taudx, taudy, H_node, float_cond, FE, conv_flag, iters, time, Phi, Phisub) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u, v real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(in) :: taudx, taudy, H_node @@ -2655,7 +2655,7 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE integer, intent(out) :: conv_flag, iters type(time_type) :: time real, pointer, dimension(:,:,:,:) :: Phi - real, dimension (:,:,:,:,:,:),pointer :: Phisub + real, dimension(:,:,:,:,:,:),pointer :: Phisub ! one linear solve (nonlinear iteration) of the solution for velocity @@ -2682,8 +2682,8 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE character(1) :: procnum character(2) :: gridsize - real, dimension (8,4) :: Phi_temp - real, dimension (2,2) :: X,Y + real, dimension(8,4) :: Phi_temp + real, dimension(2,2) :: X,Y hmask => CS%hmask umask => CS%umask @@ -2702,8 +2702,8 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec Zu(:,:) = 0 ; Zv(:,:) = 0 ; DIAGu(:,:) = 0 ; DIAGv(:,:) = 0 - Ru(:,:) = 0 ; Rv (:,:) = 0 ; Au (:,:) = 0 ; Av (:,:) = 0 - Du(:,:) = 0 ; Dv (:,:) = 0 ; ubd(:,:) = 0 ; vbd(:,:) = 0 + Ru(:,:) = 0 ; Rv(:,:) = 0 ; Au(:,:) = 0 ; Av(:,:) = 0 + Du(:,:) = 0 ; Dv(:,:) = 0 ; ubd(:,:) = 0 ; vbd(:,:) = 0 dot_p1 = 0 ; dot_p2 = 0 ! if (G%symmetric) then @@ -2741,10 +2741,10 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE endif if (FE == 1) then - call apply_boundary_values_bilinear (CS, time, Phisub, H_node, float_cond, & + call apply_boundary_values_bilinear(CS, time, Phisub, H_node, float_cond, & CS%density_ice/CS%density_ocean_avg, ubd, vbd) elseif (FE == 2) then - call apply_boundary_values_triangle (CS, time, ubd, vbd) + call apply_boundary_values_triangle(CS, time, ubd, vbd) endif RHSu(:,:) = taudx(:,:) - ubd(:,:) @@ -2759,7 +2759,7 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE CS%density_ice/CS%density_ocean_avg, Phisub, DIAGu, DIAGv) ! DIAGu(:,:) = 1 ; DIAGv(:,:) = 1 elseif (FE == 2) then - call matrix_diagonal_triangle (CS, DIAGu, DIAGv) + call matrix_diagonal_triangle(CS, DIAGu, DIAGv) DIAGu(:,:) = 1 ; DIAGv(:,:) = 1 endif @@ -2768,11 +2768,11 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE if (FE == 1) then - call CG_action_bilinear (Au, Av, u, v, Phi, Phisub, umask, vmask, hmask, & + call CG_action_bilinear(Au, Av, u, v, Phi, Phisub, umask, vmask, hmask, & H_node, visc, float_cond, G%bathyT, beta, G%areaT, isc-1, iec+1, jsc-1, & jec+1, CS%density_ice/CS%density_ocean_avg) elseif (FE == 2) then - call CG_action_triangular (Au, Av, u, v, umask, vmask, hmask, visc, visc_lo, & + call CG_action_triangular(Au, Av, u, v, umask, vmask, hmask, visc, visc_lo, & beta, beta_lo, G%dxT, G%dyT, G%areaT, isc-1, iec+1, jsc-1, jec+1, isym) endif @@ -2789,7 +2789,7 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE enddo enddo - call mpp_sum (dot_p1) + call mpp_sum(dot_p1) else @@ -2802,7 +2802,7 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE enddo enddo - dot_p1 = reproducing_sum ( sum_vec, ISUMSTART_INT_, iecq, & + dot_p1 = reproducing_sum( sum_vec, ISUMSTART_INT_, iecq, & JSUMSTART_INT_, jecq ) endif @@ -2811,8 +2811,8 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE do j=jsdq,jedq do i=isdq,iedq - if (umask(i,j) == 1) Zu(i,j) = Ru (i,j) / DIAGu (i,j) - if (vmask(i,j) == 1) Zv(i,j) = Rv (i,j) / DIAGv (i,j) + if (umask(i,j) == 1) Zu(i,j) = Ru(i,j) / DIAGu(i,j) + if (vmask(i,j) == 1) Zv(i,j) = Rv(i,j) / DIAGv(i,j) enddo enddo @@ -2845,13 +2845,13 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE if (FE == 1) then - call CG_action_bilinear (Au, Av, Du, Dv, Phi, Phisub, umask, vmask, hmask, & + call CG_action_bilinear(Au, Av, Du, Dv, Phi, Phisub, umask, vmask, hmask, & H_node, visc, float_cond, G%bathyT, beta, G%areaT, is, ie, js, & je, CS%density_ice/CS%density_ocean_avg) elseif (FE == 2) then - call CG_action_triangular (Au, Av, Du, Dv, umask, vmask, hmask, visc, visc_lo, & + call CG_action_triangular(Au, Av, Du, Dv, umask, vmask, hmask, visc, visc_lo, & beta, beta_lo, G%dxT, G%dyT, G%areaT, is, ie, js, je, isym) endif @@ -2875,7 +2875,7 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE endif enddo enddo - call mpp_sum (dot_p1) ; call mpp_sum (dot_p2) + call mpp_sum(dot_p1) ; call mpp_sum(dot_p2) else sum_vec(:,:) = 0.0 ; sum_vec_2(:,:) = 0.0 @@ -2892,10 +2892,10 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE enddo enddo - dot_p1 = reproducing_sum ( sum_vec, iscq, iecq, & + dot_p1 = reproducing_sum( sum_vec, iscq, iecq, & jscq, jecq ) - dot_p2 = reproducing_sum ( sum_vec_2, iscq, iecq, & + dot_p2 = reproducing_sum( sum_vec_2, iscq, iecq, & jscq, jecq ) endif @@ -2940,10 +2940,10 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE do j=jsdq,jedq do i=isdq,iedq if (umask(i,j) == 1) then - Zu(i,j) = Ru (i,j) / DIAGu (i,j) + Zu(i,j) = Ru(i,j) / DIAGu(i,j) endif if (vmask(i,j) == 1) then - Zv(i,j) = Rv (i,j) / DIAGv (i,j) + Zv(i,j) = Rv(i,j) / DIAGv(i,j) endif enddo enddo @@ -2966,7 +2966,7 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE endif enddo enddo - call mpp_sum (dot_p1) ; call mpp_sum (dot_p2) + call mpp_sum(dot_p1) ; call mpp_sum(dot_p2) else @@ -2986,10 +2986,10 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE enddo - dot_p1 = reproducing_sum ( sum_vec, ISUMSTART_INT_, iecq, & + dot_p1 = reproducing_sum( sum_vec, ISUMSTART_INT_, iecq, & JSUMSTART_INT_, jecq ) - dot_p2 = reproducing_sum ( sum_vec_2, ISUMSTART_INT_, iecq, & + dot_p2 = reproducing_sum( sum_vec_2, ISUMSTART_INT_, iecq, & JSUMSTART_INT_, jecq ) endif @@ -3023,7 +3023,7 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE endif enddo enddo - call mpp_sum (dot_p1) + call mpp_sum(dot_p1) else @@ -3036,7 +3036,7 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE enddo enddo - dot_p1 = reproducing_sum ( sum_vec, ISUMSTART_INT_, iecq, & + dot_p1 = reproducing_sum( sum_vec, ISUMSTART_INT_, iecq, & JSUMSTART_INT_, jecq ) ! if (is_root_pe()) print *, dot_p1 @@ -3084,7 +3084,7 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE enddo enddo - call pass_vector (u,v, G%domain, TO_ALL, BGRID_NE) + call pass_vector(u,v, G%domain, TO_ALL, BGRID_NE) if (conv_flag == 0) then iters = CS%cg_max_iterations @@ -3092,7 +3092,7 @@ subroutine ice_shelf_solve_inner (CS, u, v, taudx, taudy, H_node, float_cond, FE end subroutine ice_shelf_solve_inner -subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_enter) +subroutine ice_shelf_advect_thickness_x(CS, time_step, h0, h_after_uflux, flux_enter) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, intent(in) :: time_step real, dimension(:,:), intent(in) :: h0 @@ -3105,10 +3105,10 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary ! - ! from left neighbor: flux_enter (:,:,1) - ! from right neighbor: flux_enter (:,:,2) - ! from bottom neighbor: flux_enter (:,:,3) - ! from top neighbor: flux_enter (:,:,4) + ! from left neighbor: flux_enter(:,:,1) + ! from right neighbor: flux_enter(:,:,2) + ! from bottom neighbor: flux_enter(:,:,3) + ! from top neighbor: flux_enter(:,:,4) ! ! o--- (4) ---o ! | | @@ -3178,9 +3178,9 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ ! 1ST DO LEFT FACE - if (u_face_mask (i-1,j) == 4.) then + if (u_face_mask(i-1,j) == 4.) then - flux_diff_cell = flux_diff_cell + dyh * time_step * u_flux_boundary_values (i-1,j) / dxdyh + flux_diff_cell = flux_diff_cell + dyh * time_step * u_flux_boundary_values(i-1,j) / dxdyh else @@ -3233,9 +3233,9 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ ! get u-velocity at center of right face - if (u_face_mask (i+1,j) == 4.) then + if (u_face_mask(i+1,j) == 4.) then - flux_diff_cell = flux_diff_cell + dyh * time_step * u_flux_boundary_values (i+1,j) / dxdyh + flux_diff_cell = flux_diff_cell + dyh * time_step * u_flux_boundary_values(i+1,j) / dxdyh else @@ -3292,16 +3292,16 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - flux_enter (i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_boundary_values(i-1,j) - elseif (u_face_mask (i-1,j) == 4.) then - flux_enter (i,j,1) = G%dyT(i,j) * time_step * u_flux_boundary_values (i-1,j) + flux_enter(i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_boundary_values(i-1,j) + elseif (u_face_mask(i-1,j) == 4.) then + flux_enter(i,j,1) = G%dyT(i,j) * time_step * u_flux_boundary_values(i-1,j) endif if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_boundary_values(i+1,j) - elseif (u_face_mask (i+1,j) == 4.) then - flux_enter (i,j,2) = G%dyT(i,j) * time_step * u_flux_boundary_values (i+1,j) + elseif (u_face_mask(i+1,j) == 4.) then + flux_enter(i,j,2) = G%dyT(i,j) * time_step * u_flux_boundary_values(i+1,j) endif if ((i == is) .AND. (hmask(i,j) == 0) .AND. (hmask(i-1,j) == 1)) then @@ -3333,7 +3333,7 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ end subroutine ice_shelf_advect_thickness_x -subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_vflux, flux_enter) +subroutine ice_shelf_advect_thickness_y(CS, time_step, h_after_uflux, h_after_vflux, flux_enter) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, intent(in) :: time_step real, dimension(:,:), intent(in) :: h_after_uflux @@ -3346,10 +3346,10 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary ! - ! from left neighbor: flux_enter (:,:,1) - ! from right neighbor: flux_enter (:,:,2) - ! from bottom neighbor: flux_enter (:,:,3) - ! from top neighbor: flux_enter (:,:,4) + ! from left neighbor: flux_enter(:,:,1) + ! from right neighbor: flux_enter(:,:,2) + ! from bottom neighbor: flux_enter(:,:,3) + ! from top neighbor: flux_enter(:,:,4) ! ! o--- (4) ---o ! | | @@ -3408,16 +3408,16 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v if (hmask(i,j) == 1) then dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) - h_after_vflux (i,j) = h_after_uflux (i,j) + h_after_vflux(i,j) = h_after_uflux(i,j) - stencil (:) = h_after_uflux (i,j-2:j+2) ! fine as long has ny_halo >= 2 + stencil(:) = h_after_uflux(i,j-2:j+2) ! fine as long has ny_halo >= 2 flux_diff_cell = 0 ! 1ST DO south FACE - if (v_face_mask (i,j-1) == 4.) then + if (v_face_mask(i,j-1) == 4.) then - flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values (i,j-1) / dxdyh + flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values(i,j-1) / dxdyh else @@ -3467,7 +3467,7 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v if (v_face_mask(i,j+1) == 4.) then - flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values (i,j+1) / dxdyh + flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values(i,j+1) / dxdyh else @@ -3508,34 +3508,34 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v endif - h_after_vflux (i,j) = h_after_vflux (i,j) + flux_diff_cell + h_after_vflux(i,j) = h_after_vflux(i,j) + flux_diff_cell elseif ((hmask(i,j) == 0) .OR. (hmask(i,j) == 2)) then if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then v_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i,j-1)) - flux_enter (i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_boundary_values(i,j-1) + flux_enter(i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_boundary_values(i,j-1) elseif (v_face_mask(i,j-1) == 4.) then - flux_enter (i,j,3) = G%dxT(i,j) * time_step * v_flux_boundary_values (i,j-1) + flux_enter(i,j,3) = G%dxT(i,j) * time_step * v_flux_boundary_values(i,j-1) endif if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then v_face = 0.5 * (CS%u_shelf(i-1,j) + CS%u_shelf(i,j)) - flux_enter (i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_boundary_values(i,j+1) + flux_enter(i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_boundary_values(i,j+1) elseif (v_face_mask(i,j+1) == 4.) then - flux_enter (i,j,4) = G%dxT(i,j) * time_step * v_flux_boundary_values (i,j+1) + flux_enter(i,j,4) = G%dxT(i,j) * time_step * v_flux_boundary_values(i,j+1) endif if ((j == js) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j-1) == 1)) then ! this is solely for the purposes of keeping the mask consistent while advancing ! the front without having to call pass_var - if cell is empty and cell to left ! is ice-covered then this cell will become partly covered - hmask (i,j) = 2 + hmask(i,j) = 2 elseif ((j == je) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j+1) == 1)) then ! this is solely for the purposes of keeping the mask consistent while advancing ! the front without having to call pass_var - if cell is empty and cell to left ! is ice-covered then this cell will become partly covered - hmask (i,j) = 2 + hmask(i,j) = 2 endif endif @@ -3548,7 +3548,7 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v end subroutine ice_shelf_advect_thickness_y -subroutine shelf_advance_front (CS, flux_enter) +subroutine shelf_advance_front(CS, flux_enter) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(:,:,:), intent(inout) :: flux_enter @@ -3567,10 +3567,10 @@ subroutine shelf_advance_front (CS, flux_enter) ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary ! - ! from left neighbor: flux_enter (:,:,1) - ! from right neighbor: flux_enter (:,:,2) - ! from bottom neighbor: flux_enter (:,:,3) - ! from top neighbor: flux_enter (:,:,4) + ! from left neighbor: flux_enter(:,:,1) + ! from right neighbor: flux_enter(:,:,2) + ! from bottom neighbor: flux_enter(:,:,3) + ! from top neighbor: flux_enter(:,:,4) ! ! o--- (4) ---o ! | | @@ -3587,7 +3587,7 @@ subroutine shelf_advance_front (CS, flux_enter) real :: h_reference, dxh, dyh, dxdyh, rho, partial_vol, tot_flux integer, dimension(4) :: mapi, mapj, new_partial ! real, dimension(size(flux_enter,1),size(flux_enter,2),size(flux_enter,2)) :: flux_enter_replace - real, dimension (:,:,:), pointer :: flux_enter_replace => NULL() + real, dimension(:,:,:), pointer :: flux_enter_replace => NULL() G => CS%grid h_shelf => CS%h_shelf @@ -3617,8 +3617,8 @@ subroutine shelf_advance_front (CS, flux_enter) iter_flag = 0 if (iter_count > 0) then - flux_enter (:,:,:) = flux_enter_replace(:,:,:) - flux_enter_replace (:,:,:) = 0.0 + flux_enter(:,:,:) = flux_enter_replace(:,:,:) + flux_enter_replace(:,:,:) = 0.0 endif iter_count = iter_count + 1 @@ -3653,55 +3653,55 @@ subroutine shelf_advance_front (CS, flux_enter) do k=1,2 if (flux_enter(i,j,k+2) > 0) then n_flux = n_flux + 1 - h_reference = h_reference + h_shelf (i,j+2*k-3) + h_reference = h_reference + h_shelf(i,j+2*k-3) tot_flux = tot_flux + flux_enter(i,j,k+2) - flux_enter (i,j,k+2) = 0.0 + flux_enter(i,j,k+2) = 0.0 endif enddo if (n_flux > 0) then dxdyh = G%areaT(i,j) h_reference = h_reference / real(n_flux) - partial_vol = h_shelf (i,j) * area_shelf_h (i,j) + tot_flux + partial_vol = h_shelf(i,j) * area_shelf_h(i,j) + tot_flux if ((partial_vol / dxdyh) == h_reference) then ! cell is exactly covered, no overflow - hmask (i,j) = 1 - h_shelf (i,j) = h_reference + hmask(i,j) = 1 + h_shelf(i,j) = h_reference area_shelf_h(i,j) = dxdyh elseif ((partial_vol / dxdyh) < h_reference) then - hmask (i,j) = 2 - ! mass_shelf (i,j) = partial_vol * rho - area_shelf_h (i,j) = partial_vol / h_reference - h_shelf (i,j) = h_reference + hmask(i,j) = 2 + ! mass_shelf(i,j) = partial_vol * rho + area_shelf_h(i,j) = partial_vol / h_reference + h_shelf(i,j) = h_reference else if (.not. associated (flux_enter_replace)) then - allocate ( flux_enter_replace (G%isd:G%ied,G%jsd:G%jed,1:4) ) - flux_enter_replace (:,:,:) = 0.0 + allocate( flux_enter_replace (G%isd:G%ied,G%jsd:G%jed,1:4) ) + flux_enter_replace(:,:,:) = 0.0 endif - hmask (i,j) = 1 + hmask(i,j) = 1 area_shelf_h(i,j) = dxdyh - !h_temp (i,j) = h_reference + !h_temp(i,j) = h_reference partial_vol = partial_vol - h_reference * dxdyh iter_flag = 1 - n_flux = 0 ; new_partial (:) = 0 + n_flux = 0 ; new_partial(:) = 0 do k=1,2 - if (u_face_mask (i-2+k,j) == 2) then + if (u_face_mask(i-2+k,j) == 2) then n_flux = n_flux + 1 - elseif (hmask (i+2*k-3,j) == 0) then + elseif (hmask(i+2*k-3,j) == 0) then n_flux = n_flux + 1 - new_partial (k) = 1 + new_partial(k) = 1 endif enddo do k=1,2 - if (v_face_mask (i,j-2+k) == 2) then + if (v_face_mask(i,j-2+k) == 2) then n_flux = n_flux + 1 - elseif (hmask (i,j+2*k-3) == 0) then + elseif (hmask(i,j+2*k-3) == 0) then n_flux = n_flux + 1 - new_partial (k+2) = 1 + new_partial(k+2) = 1 endif enddo @@ -3712,7 +3712,7 @@ subroutine shelf_advance_front (CS, flux_enter) do k=1,2 if (new_partial(k) == 1) & - flux_enter_replace (i+2*k-3,j,3-k) = partial_vol / real(n_flux) + flux_enter_replace(i+2*k-3,j,3-k) = partial_vol / real(n_flux) enddo do k=1,2 ! ### Combine these two loops? if (new_partial(k+2) == 1) & @@ -3741,7 +3741,7 @@ subroutine shelf_advance_front (CS, flux_enter) end subroutine shelf_advance_front !> Apply a very simple calving law using a minimum thickness rule -subroutine ice_shelf_min_thickness_calve (CS, h_shelf, area_shelf_h,hmask) +subroutine ice_shelf_min_thickness_calve(CS, h_shelf, area_shelf_h,hmask) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(:,:), intent(inout) :: h_shelf, area_shelf_h, hmask type(ocean_grid_type), pointer :: G @@ -3763,7 +3763,7 @@ subroutine ice_shelf_min_thickness_calve (CS, h_shelf, area_shelf_h,hmask) end subroutine ice_shelf_min_thickness_calve -subroutine calve_to_mask (CS, h_shelf, area_shelf_h, hmask, calve_mask) +subroutine calve_to_mask(CS, h_shelf, area_shelf_h, hmask, calve_mask) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(:,:), intent(inout) :: h_shelf, area_shelf_h, hmask, calve_mask @@ -3786,7 +3786,7 @@ subroutine calve_to_mask (CS, h_shelf, area_shelf_h, hmask, calve_mask) end subroutine calve_to_mask -subroutine calc_shelf_driving_stress (CS, TAUD_X, TAUD_Y, OD, FE) +subroutine calc_shelf_driving_stress(CS, TAUD_X, TAUD_Y, OD, FE) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(:,:), intent(in) :: OD real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: TAUD_X, TAUD_Y @@ -3805,10 +3805,10 @@ subroutine calc_shelf_driving_stress (CS, TAUD_X, TAUD_Y, OD, FE) ! FE : 1 if bilinear, 2 if triangular linear FE - real, dimension (:,:), pointer :: D, & ! ocean floor depth + real, dimension(:,:), pointer :: D, & ! ocean floor depth H, & ! ice shelf thickness hmask, u_face_mask, v_face_mask, float_frac - real, dimension (SIZE(OD,1),SIZE(OD,2)) :: S, & ! surface elevation + real, dimension(SIZE(OD,1),SIZE(OD,2)) :: S, & ! surface elevation BASE ! basal elevation of shelf/stream character(1) :: procnum @@ -3948,7 +3948,7 @@ subroutine calc_shelf_driving_stress (CS, TAUD_X, TAUD_Y, OD, FE) if (FE == 1) then ! SW vertex - taud_x (i-1,j-1) = taud_x (i-1,j-1) - .25 * rho * grav * H(i,j) * sx * dxdyh + taud_x(i-1,j-1) = taud_x(i-1,j-1) - .25 * rho * grav * H(i,j) * sx * dxdyh taud_y(i-1,j-1) = taud_y(i-1,j-1) - .25 * rho * grav * H(i,j) * sy * dxdyh ! SE vertex @@ -3985,7 +3985,7 @@ subroutine calc_shelf_driving_stress (CS, TAUD_X, TAUD_Y, OD, FE) endif if (float_frac(i,j) == 1) then - neumann_val = .5 * grav * (rho * H (i,j) ** 2 - rhow * D(i,j) ** 2) + neumann_val = .5 * grav * (rho * H(i,j) ** 2 - rhow * D(i,j) ** 2) else neumann_val = .5 * grav * (1-rho/rhow) * rho * H(i,j) ** 2 endif @@ -4033,7 +4033,7 @@ subroutine calc_shelf_driving_stress (CS, TAUD_X, TAUD_Y, OD, FE) end subroutine calc_shelf_driving_stress -subroutine init_boundary_values (CS, time, input_flux, input_thick, new_sim) +subroutine init_boundary_values(CS, time, input_flux, input_thick, new_sim) type(time_type), intent(in) :: Time type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, intent(in) :: input_flux, input_thick @@ -4047,7 +4047,7 @@ subroutine init_boundary_values (CS, time, input_flux, input_thick, new_sim) ! computational domain -- if this function gets moves to another module, ! DO NOT TAKE THE RESTARTING BIT WITH IT - real, dimension (:,:) , pointer :: thickness_boundary_values, & + real, dimension(:,:) , pointer :: thickness_boundary_values, & u_boundary_values, & v_boundary_values, & u_face_mask, v_face_mask, hmask @@ -4089,15 +4089,15 @@ subroutine init_boundary_values (CS, time, input_flux, input_thick, new_sim) ! endif if (hmask(i,j) == 3) then - thickness_boundary_values (i,j) = input_thick + thickness_boundary_values(i,j) = input_thick endif if ((hmask(i,j) == 0) .or. (hmask(i,j) == 1) .or. (hmask(i,j) == 2)) then if ((i <= iec).and.(i >= isc)) then - if (u_face_mask (i-1,j) == 3) then - u_boundary_values (i-1,j-1) = (1 - ((G%geoLatBu(i-1,j-1) - 0.5*CS%len_lat)*2./CS%len_lat)**2) * & + if (u_face_mask(i-1,j) == 3) then + u_boundary_values(i-1,j-1) = (1 - ((G%geoLatBu(i-1,j-1) - 0.5*CS%len_lat)*2./CS%len_lat)**2) * & 1.5 * input_flux / input_thick - u_boundary_values (i-1,j) = (1 - ((G%geoLatBu(i-1,j) - 0.5*CS%len_lat)*2./CS%len_lat)**2) * & + u_boundary_values(i-1,j) = (1 - ((G%geoLatBu(i-1,j) - 0.5*CS%len_lat)*2./CS%len_lat)**2) * & 1.5 * input_flux / input_thick endif endif @@ -4106,13 +4106,13 @@ subroutine init_boundary_values (CS, time, input_flux, input_thick, new_sim) if (.not.(new_sim)) then if (.not. G%symmetric) then if (((i+i_off) == (G%domain%nihalo+1)).and.(u_face_mask(i-1,j) == 3)) then - CS%u_shelf (i-1,j-1) = u_boundary_values (i-1,j-1) - CS%u_shelf (i-1,j) = u_boundary_values (i-1,j) -! print *, u_boundary_values (i-1,j) + CS%u_shelf(i-1,j-1) = u_boundary_values(i-1,j-1) + CS%u_shelf(i-1,j) = u_boundary_values(i-1,j) +! print *, u_boundary_values(i-1,j) endif if (((j+j_off) == (G%domain%njhalo+1)).and.(v_face_mask(i,j-1) == 3)) then - CS%u_shelf (i-1,j-1) = u_boundary_values (i-1,j-1) - CS%u_shelf (i,j-1) = u_boundary_values (i,j-1) + CS%u_shelf(i-1,j-1) = u_boundary_values(i-1,j-1) + CS%u_shelf(i,j-1) = u_boundary_values(i,j-1) endif endif endif @@ -4124,11 +4124,11 @@ end subroutine init_boundary_values subroutine CG_action_triangular (uret, vret, u, v, umask, vmask, hmask, nu_upper, nu_lower, & beta_upper, beta_lower, dxh, dyh, dxdyh, is, ie, js, je, isym) -real, dimension (:,:), intent (inout) :: uret, vret -real, dimension (:,:), intent (in) :: u, v -real, dimension (:,:), intent (in) :: umask, vmask -real, dimension (:,:), intent (in) :: hmask, nu_upper, nu_lower, beta_upper, beta_lower -real, dimension (:,:), intent (in) :: dxh, dyh, dxdyh +real, dimension(:,:), intent (inout) :: uret, vret +real, dimension(:,:), intent (in) :: u, v +real, dimension(:,:), intent (in) :: umask, vmask +real, dimension(:,:), intent (in) :: hmask, nu_upper, nu_lower, beta_upper, beta_lower +real, dimension(:,:), intent (in) :: dxh, dyh, dxdyh integer, intent(in) :: is, ie, js, je, isym ! the linear action of the matrix on (u,v) with triangular finite elements @@ -4155,10 +4155,10 @@ subroutine CG_action_triangular (uret, vret, u, v, umask, vmask, hmask, nu_upper if (umask(i,j-1) == 1) then ! this (bot right) is a degree of freedom node uret(i,j-1) = uret(i,j-1) + & - .5 * dxdyh(i,j) * nu_lower (i,j) * ((4*ux+2*vy) * (1./dxh(i,j)) + (uy+vy) * (0./dyh(i,j))) + .5 * dxdyh(i,j) * nu_lower(i,j) * ((4*ux+2*vy) * (1./dxh(i,j)) + (uy+vy) * (0./dyh(i,j))) vret(i,j-1) = vret(i,j-1) + & - .5 * dxdyh(i,j) * nu_lower (i,j) * ((uy+vx) * (1./dxh(i,j)) + (4*vy+2*ux) * (0./dyh(i,j))) + .5 * dxdyh(i,j) * nu_lower(i,j) * ((uy+vx) * (1./dxh(i,j)) + (4*vy+2*ux) * (0./dyh(i,j))) uret(i,j-1) = uret(i,j-1) + & beta_lower(i,j) * dxdyh(i,j) * 1./24 * (u(i-1,j-1) + & @@ -4172,10 +4172,10 @@ subroutine CG_action_triangular (uret, vret, u, v, umask, vmask, hmask, nu_upper if (umask(i-1,j) == 1) then ! this (top left) is a degree of freedom node uret(i-1,j) = uret(i-1,j) + & - .5 * dxdyh(i,j) * nu_lower (i,j) * ((4*ux+2*vy) * (0./dxh(i,j)) + (uy+vy) * (1./dyh(i,j))) + .5 * dxdyh(i,j) * nu_lower(i,j) * ((4*ux+2*vy) * (0./dxh(i,j)) + (uy+vy) * (1./dyh(i,j))) vret(i-1,j) = vret(i-1,j) + & - .5 * dxdyh(i,j) * nu_lower (i,j) * ((uy+vx) * (0./dxh(i,j)) + (4*vy+2*ux) * (1./dyh(i,j))) + .5 * dxdyh(i,j) * nu_lower(i,j) * ((uy+vx) * (0./dxh(i,j)) + (4*vy+2*ux) * (1./dyh(i,j))) uret(i,j-1) = uret(i,j-1) + & beta_lower(i,j) * dxdyh(i,j) * 1./24 * (u(i-1,j-1) + & @@ -4189,10 +4189,10 @@ subroutine CG_action_triangular (uret, vret, u, v, umask, vmask, hmask, nu_upper if (umask(i-1,j-1) == 1) then ! this (bot left) is a degree of freedom node uret(i-1,j-1) = uret(i-1,j-1) + & - .5 * dxdyh(i,j) * nu_upper (i,j) * ((4*ux+2*vy) * (-1./dxh(i,j)) + (uy+vy) * (-1./dyh(i,j))) + .5 * dxdyh(i,j) * nu_upper(i,j) * ((4*ux+2*vy) * (-1./dxh(i,j)) + (uy+vy) * (-1./dyh(i,j))) vret(i-1,j-1) = vret(i-1,j-1) + & - .5 * dxdyh(i,j) * nu_upper (i,j) * ((uy+vx) * (-1./dxh(i,j)) + (4*vy+2*ux) * (-1./dyh(i,j))) + .5 * dxdyh(i,j) * nu_upper(i,j) * ((uy+vx) * (-1./dxh(i,j)) + (4*vy+2*ux) * (-1./dyh(i,j))) uret(i-1,j-1) = uret(i-1,j-1) + & beta_lower(i,j) * dxdyh(i,j) * 1./24 * (u(i-1,j-1) + & @@ -4212,10 +4212,10 @@ subroutine CG_action_triangular (uret, vret, u, v, umask, vmask, hmask, nu_upper if (umask(i,j-1) == 1) then ! this (bot right) is a degree of freedom node uret(i,j-1) = uret(i,j-1) + & - .5 * dxdyh(i,j) * nu_upper (i,j) * ((4*ux+2*vy) * (0./dxh(i,j)) + (uy+vy) * (-1./dyh(i,j))) + .5 * dxdyh(i,j) * nu_upper(i,j) * ((4*ux+2*vy) * (0./dxh(i,j)) + (uy+vy) * (-1./dyh(i,j))) vret(i,j-1) = vret(i,j-1) + & - .5 * dxdyh(i,j) * nu_upper (i,j) * ((uy+vx) * (0./dxh(i,j)) + (4*vy+2*ux) * (-1./dyh(i,j))) + .5 * dxdyh(i,j) * nu_upper(i,j) * ((uy+vx) * (0./dxh(i,j)) + (4*vy+2*ux) * (-1./dyh(i,j))) uret(i,j-1) = uret(i,j-1) + & beta_upper(i,j) * dxdyh(i,j) * 1./24 * (u(i,j) + & @@ -4229,10 +4229,10 @@ subroutine CG_action_triangular (uret, vret, u, v, umask, vmask, hmask, nu_upper if (umask(i-1,j) == 1) then ! this (top left) is a degree of freedom node uret(i-1,j) = uret(i-1,j) + & - .5 * dxdyh(i,j) * nu_upper (i,j) * ((4*ux+2*vy) * (-1./dxh(i,j)) + (uy+vy) * (0./dyh(i,j))) + .5 * dxdyh(i,j) * nu_upper(i,j) * ((4*ux+2*vy) * (-1./dxh(i,j)) + (uy+vy) * (0./dyh(i,j))) vret(i-1,j) = vret(i-1,j) + & - .5 * dxdyh(i,j) * nu_upper (i,j) * ((uy+vx) * (-1./dxh(i,j)) + (4*vy+2*ux) * (0./dyh(i,j))) + .5 * dxdyh(i,j) * nu_upper(i,j) * ((uy+vx) * (-1./dxh(i,j)) + (4*vy+2*ux) * (0./dyh(i,j))) uret(i,j-1) = uret(i,j-1) + & beta_upper(i,j) * dxdyh(i,j) * 1./24 * (u(i,j) + & @@ -4246,10 +4246,10 @@ subroutine CG_action_triangular (uret, vret, u, v, umask, vmask, hmask, nu_upper if (umask(i,j) == 1) then ! this (top right) is a degree of freedom node uret(i,j) = uret(i,j) + & - .5 * dxdyh(i,j) * nu_upper (i,j) * ((4*ux+2*vy) * (1./dxh(i,j)) + (uy+vy) * (1./dyh(i,j))) + .5 * dxdyh(i,j) * nu_upper(i,j) * ((4*ux+2*vy) * (1./dxh(i,j)) + (uy+vy) * (1./dyh(i,j))) vret(i,j) = vret(i,j) + & - .5 * dxdyh(i,j) * nu_upper (i,j) * ((uy+vx) * (1./dxh(i,j)) + (4*vy+2*ux) * (1./dyh(i,j))) + .5 * dxdyh(i,j) * nu_upper(i,j) * ((uy+vx) * (1./dxh(i,j)) + (4*vy+2*ux) * (1./dyh(i,j))) uret(i,j) = uret(i,j) + & beta_upper(i,j) * dxdyh(i,j) * 1./24 * (u(i,j) + & @@ -4270,12 +4270,12 @@ end subroutine CG_action_triangular subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmask, H_node, & nu, float_cond, D, beta, dxdyh, is, ie, js, je, dens_ratio) -real, dimension (NILIMB_SYM_,NJLIMB_SYM_), intent (inout) :: uret, vret -real, dimension (:,:,:,:), pointer :: Phi -real, dimension (:,:,:,:,:,:),pointer :: Phisub -real, dimension (NILIMB_SYM_,NJLIMB_SYM_), intent (in) :: u, v -real, dimension (NILIMB_SYM_,NJLIMB_SYM_), intent (in) :: umask, vmask, H_node -real, dimension (:,:), intent (in) :: hmask, nu, float_cond, D, beta, dxdyh +real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent (inout) :: uret, vret +real, dimension(:,:,:,:), pointer :: Phi +real, dimension(:,:,:,:,:,:),pointer :: Phisub +real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent (in) :: u, v +real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent (in) :: umask, vmask, H_node +real, dimension(:,:), intent (in) :: hmask, nu, float_cond, D, beta, dxdyh real, intent(in) :: dens_ratio integer, intent(in) :: is, ie, js, je @@ -4289,14 +4289,14 @@ subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmas ! the linear action of the matrix on (u,v) with triangular finite elements ! Phi has the form -! Phi (i,j,k,q) - applies to cell i,j +! Phi(i,j,k,q) - applies to cell i,j ! 3 - 4 ! | | ! 1 - 2 -! Phi (i,j,2*k-1,q) gives d(Phi_k)/dx at quadrature point q -! Phi (i,j,2*k,q) gives d(Phi_k)/dy at quadrature point q +! Phi(i,j,2*k-1,q) gives d(Phi_k)/dx at quadrature point q +! Phi(i,j,2*k,q) gives d(Phi_k)/dy at quadrature point q ! Phi_k is equal to 1 at vertex k, and 0 at vertex l /= k, and bilinear real :: ux, vx, uy, vy, uq, vq, area, basel @@ -4372,16 +4372,16 @@ subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmas v(i,j) * Phi(i,j,8,2*(jq-1)+iq) do iphi=1,2 ; do jphi=1,2 - if (umask (i-2+iphi,j-2+jphi) == 1) then + if (umask(i-2+iphi,j-2+jphi) == 1) then - uret (i-2+iphi,j-2+jphi) = uret (i-2+iphi,j-2+jphi) + & - .25 * area * nu (i,j) * ((4*ux+2*vy) * Phi(i,j,2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & + uret(i-2+iphi,j-2+jphi) = uret(i-2+iphi,j-2+jphi) + & + .25 * area * nu(i,j) * ((4*ux+2*vy) * Phi(i,j,2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & (uy+vx) * Phi(i,j,2*(2*(jphi-1)+iphi),2*(jq-1)+iq)) endif - if (vmask (i-2+iphi,j-2+jphi) == 1) then + if (vmask(i-2+iphi,j-2+jphi) == 1) then - vret (i-2+iphi,j-2+jphi) = vret (i-2+iphi,j-2+jphi) + & - .25 * area * nu (i,j) * ((uy+vx) * Phi(i,j,2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & + vret(i-2+iphi,j-2+jphi) = vret(i-2+iphi,j-2+jphi) + & + .25 * area * nu(i,j) * ((uy+vx) * Phi(i,j,2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & (4*vy+2*ux) * Phi(i,j,2*(2*(jphi-1)+iphi),2*(jq-1)+iq)) endif @@ -4399,16 +4399,16 @@ subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmas if (float_cond(i,j) == 0) then - if (umask (i-2+iphi,j-2+jphi) == 1) then + if (umask(i-2+iphi,j-2+jphi) == 1) then - uret (i-2+iphi,j-2+jphi) = uret (i-2+iphi,j-2+jphi) + & + uret(i-2+iphi,j-2+jphi) = uret(i-2+iphi,j-2+jphi) + & .25 * beta(i,j) * area * uq * xquad(ilq) * xquad(jlq) endif - if (vmask (i-2+iphi,j-2+jphi) == 1) then + if (vmask(i-2+iphi,j-2+jphi) == 1) then - vret (i-2+iphi,j-2+jphi) = vret (i-2+iphi,j-2+jphi) + & + vret(i-2+iphi,j-2+jphi) = vret(i-2+iphi,j-2+jphi) + & .25 * beta(i,j) * area * vq * xquad(ilq) * xquad(jlq) endif @@ -4428,11 +4428,11 @@ subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmas call CG_action_subgrid_basal_bilinear & (Phisub, Hcell, Ucell, Vcell, area, basel, dens_ratio, Usubcontr, Vsubcontr, i, j) do iphi=1,2 ; do jphi=1,2 - if (umask (i-2+iphi,j-2+jphi) == 1) then - uret (i-2+iphi,j-2+jphi) = uret (i-2+iphi,j-2+jphi) + Usubcontr (iphi,jphi) * beta(i,j) + if (umask(i-2+iphi,j-2+jphi) == 1) then + uret(i-2+iphi,j-2+jphi) = uret(i-2+iphi,j-2+jphi) + Usubcontr (iphi,jphi) * beta(i,j) endif - if (vmask (i-2+iphi,j-2+jphi) == 1) then - vret (i-2+iphi,j-2+jphi) = vret (i-2+iphi,j-2+jphi) + Vsubcontr (iphi,jphi) * beta(i,j) + if (vmask(i-2+iphi,j-2+jphi) == 1) then + vret(i-2+iphi,j-2+jphi) = vret(i-2+iphi,j-2+jphi) + Vsubcontr (iphi,jphi) * beta(i,j) !if ( (iphi == 1) .and. (jphi == 1)) 8 ! print *, i,j, Usubcontr (iphi,jphi) * beta(i,j), " ", Ucontr(iphi,jphi) endif @@ -4511,14 +4511,14 @@ subroutine CG_action_subgrid_basal_bilinear (Phisub, H, U, V, DXDYH, D, dens_rat end subroutine CG_action_subgrid_basal_bilinear -subroutine matrix_diagonal_triangle (CS, u_diagonal, v_diagonal) +subroutine matrix_diagonal_triangle(CS, u_diagonal, v_diagonal) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - real, dimension (:,:), intent(inout) :: u_diagonal, v_diagonal + real, dimension(:,:), intent(inout) :: u_diagonal, v_diagonal ! returns the diagonal entries of the matrix for a Jacobi preconditioning - real, pointer, dimension (:,:) :: umask, vmask, & + real, pointer, dimension(:,:) :: umask, vmask, & nu_lower, nu_upper, beta_lower, beta_upper, hmask type(ocean_grid_type), pointer :: G integer :: isym, i, j, is, js, cnt, isc, jsc, iec, jec @@ -4545,125 +4545,125 @@ subroutine matrix_diagonal_triangle (CS, u_diagonal, v_diagonal) dyh = G%dyT(i,j) dxdyh = G%areaT(i,j) - if (umask (i,j-1) == 1) then ! this (bot right) is a degree of freedom node + if (umask(i,j-1) == 1) then ! this (bot right) is a degree of freedom node ux = 1./dxh ; uy = 0./dyh vx = 0. ; vy = 0. - u_diagonal (i,j-1) = u_diagonal (i,j-1) + & - .5 * dxdyh * nu_lower (i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (0./dyh)) + u_diagonal(i,j-1) = u_diagonal(i,j-1) + & + .5 * dxdyh * nu_lower(i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (0./dyh)) - u_diagonal (i,j-1) = u_diagonal (i,j-1) + & + u_diagonal(i,j-1) = u_diagonal(i,j-1) + & beta_lower(i,j) * dxdyh * 1./24 ux = 0. ; uy = 0. vx = 1./dxh ; vy = 0./dyh - v_diagonal (i,j-1) = v_diagonal (i,j-1) + & - .5 * dxdyh * nu_lower (i,j) * ((uy+vx) * (1./dxh) + (4*vy+2*ux) * (0./dyh)) + v_diagonal(i,j-1) = v_diagonal(i,j-1) + & + .5 * dxdyh * nu_lower(i,j) * ((uy+vx) * (1./dxh) + (4*vy+2*ux) * (0./dyh)) - v_diagonal (i,j-1) = v_diagonal (i,j-1) + & + v_diagonal(i,j-1) = v_diagonal(i,j-1) + & beta_lower(i,j) * dxdyh * 1./24 ux = 0./dxh ; uy = -1./dyh vx = 0. ; vy = 0. - u_diagonal (i,j-1) = u_diagonal (i,j-1) + & - .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (-1./dyh)) + u_diagonal(i,j-1) = u_diagonal(i,j-1) + & + .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (-1./dyh)) - u_diagonal (i,j-1) = u_diagonal (i,j-1) + & + u_diagonal(i,j-1) = u_diagonal(i,j-1) + & beta_upper(i,j) * dxdyh * 1./24 vx = 0./dxh ; vy = -1./dyh ux = 0. ; uy = 0. - v_diagonal (i,j-1) = v_diagonal (i,j-1) + & - .5 * dxdyh * nu_upper (i,j) * ((uy+vx) * (0./dxh) + (4*vy+2*ux) * (-1./dyh)) + v_diagonal(i,j-1) = v_diagonal(i,j-1) + & + .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (0./dxh) + (4*vy+2*ux) * (-1./dyh)) - v_diagonal (i,j-1) = v_diagonal (i,j-1) + & + v_diagonal(i,j-1) = v_diagonal(i,j-1) + & beta_upper(i,j) * dxdyh * 1./24 endif - if (umask (i-1,j) == 1) then ! this (top left) is a degree of freedom node + if (umask(i-1,j) == 1) then ! this (top left) is a degree of freedom node ux = 0./dxh ; uy = 1./dyh vx = 0. ; vy = 0. - u_diagonal (i-1,j) = u_diagonal (i-1,j) + & - .5 * dxdyh * nu_lower (i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (1./dyh)) + u_diagonal(i-1,j) = u_diagonal(i-1,j) + & + .5 * dxdyh * nu_lower(i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (1./dyh)) - u_diagonal (i,j-1) = u_diagonal (i,j-1) + & + u_diagonal(i,j-1) = u_diagonal(i,j-1) + & beta_lower(i,j) * dxdyh * 1./24 ux = 0. ; uy = 0. vx = 0./dxh ; vy = 1./dyh - v_diagonal (i-1,j) = v_diagonal (i-1,j) + & - .5 * dxdyh * nu_lower (i,j) * ((uy+vx) * (0./dxh) + (4*vy+2*ux) * (1./dyh)) + v_diagonal(i-1,j) = v_diagonal(i-1,j) + & + .5 * dxdyh * nu_lower(i,j) * ((uy+vx) * (0./dxh) + (4*vy+2*ux) * (1./dyh)) - v_diagonal (i,j-1) = v_diagonal (i,j-1) + & + v_diagonal(i,j-1) = v_diagonal(i,j-1) + & beta_lower(i,j) * dxdyh * 1./24 ux = -1./dxh ; uy = 0./dyh vx = 0. ; vy = 0. - u_diagonal (i-1,j) = u_diagonal (i-1,j) + & - .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (0./dyh)) + u_diagonal(i-1,j) = u_diagonal(i-1,j) + & + .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (0./dyh)) - u_diagonal (i,j-1) = u_diagonal (i,j-1) + & + u_diagonal(i,j-1) = u_diagonal(i,j-1) + & beta_upper(i,j) * dxdyh * 1./24 vx = -1./dxh ; vy = 0./dyh ux = 0. ; uy = 0. - v_diagonal (i-1,j) = v_diagonal (i-1,j) + & - .5 * dxdyh * nu_upper (i,j) * ((uy+vx) * (-1./dxh) + (4*vy+2*ux) * (0./dyh)) + v_diagonal(i-1,j) = v_diagonal(i-1,j) + & + .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (-1./dxh) + (4*vy+2*ux) * (0./dyh)) - v_diagonal (i,j-1) = v_diagonal (i,j-1) + & + v_diagonal(i,j-1) = v_diagonal(i,j-1) + & beta_upper(i,j) * dxdyh * 1./24 endif - if (umask (i-1,j-1) == 1) then ! this (bot left) is a degree of freedom node + if (umask(i-1,j-1) == 1) then ! this (bot left) is a degree of freedom node ux = -1./dxh ; uy = -1./dyh vx = 0. ; vy = 0. - u_diagonal (i-1,j-1) = u_diagonal (i-1,j-1) + & - .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (-1./dyh)) + u_diagonal(i-1,j-1) = u_diagonal(i-1,j-1) + & + .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (-1./dyh)) - u_diagonal (i-1,j-1) = u_diagonal (i-1,j-1) + & + u_diagonal(i-1,j-1) = u_diagonal(i-1,j-1) + & beta_lower(i,j) * dxdyh * 1./24 vx = -1./dxh ; vy = -1./dyh ux = 0. ; uy = 0. - v_diagonal (i-1,j-1) = v_diagonal (i-1,j-1) + & - .5 * dxdyh * nu_upper (i,j) * ((uy+vx) * (-1./dxh) + (4*vy+2*ux) * (-1./dyh)) + v_diagonal(i-1,j-1) = v_diagonal(i-1,j-1) + & + .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (-1./dxh) + (4*vy+2*ux) * (-1./dyh)) - v_diagonal (i-1,j-1) = v_diagonal (i-1,j-1) + & + v_diagonal(i-1,j-1) = v_diagonal(i-1,j-1) + & beta_lower(i,j) * dxdyh * 1./24 endif - if (umask (i,j) == 1) then ! this (top right) is a degree of freedom node + if (umask(i,j) == 1) then ! this (top right) is a degree of freedom node ux = 1./ dxh ; uy = 1./dyh vx = 0. ; vy = 0. - u_diagonal (i,j) = u_diagonal (i,j) + & - .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (1./dyh)) + u_diagonal(i,j) = u_diagonal(i,j) + & + .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (1./dyh)) - u_diagonal (i,j) = u_diagonal (i,j) + & + u_diagonal(i,j) = u_diagonal(i,j) + & beta_upper(i,j) * dxdyh * 1./24 vx = 1./ dxh ; vy = 1./dyh ux = 0. ; uy = 0. - v_diagonal (i,j) = v_diagonal (i,j) + & - .5 * dxdyh * nu_upper (i,j) * ((uy+vx) * (1./dxh) + (4*vy+2*ux) * (1./dyh)) + v_diagonal(i,j) = v_diagonal(i,j) + & + .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (1./dxh) + (4*vy+2*ux) * (1./dyh)) - v_diagonal (i,j) = v_diagonal (i,j) + & + v_diagonal(i,j) = v_diagonal(i,j) + & beta_upper(i,j) * dxdyh * 1./24 endif @@ -4674,16 +4674,16 @@ end subroutine matrix_diagonal_triangle subroutine matrix_diagonal_bilinear(CS, float_cond, H_node, dens_ratio, Phisub, u_diagonal, v_diagonal) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - real, dimension (NILIMB_SYM_,NJLIMB_SYM_), intent(in) :: H_node + real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(in) :: H_node real :: dens_ratio - real, dimension (:,:), intent(in) :: float_cond - real, dimension (:,:,:,:,:,:),pointer :: Phisub - real, dimension (NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u_diagonal, v_diagonal + real, dimension(:,:), intent(in) :: float_cond + real, dimension(:,:,:,:,:,:),pointer :: Phisub + real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u_diagonal, v_diagonal ! returns the diagonal entries of the matrix for a Jacobi preconditioning - real, dimension (:,:), pointer :: umask, vmask, hmask, & + real, dimension(:,:), pointer :: umask, vmask, hmask, & nu, beta type(ocean_grid_type), pointer :: G integer :: isym, i, j, is, js, cnt, isc, jsc, iec, jec, iphi, jphi, iq, jq, ilq, jlq @@ -4724,12 +4724,12 @@ subroutine matrix_diagonal_bilinear(CS, float_cond, H_node, dens_ratio, Phisub, dyh = G%dyT(i,j) dxdyh = G%areaT(i,j) - X(1:2) = G%geoLonBu (i-1:i,j-1)*1000 - X(3:4) = G%geoLonBu (i-1:i,j) *1000 - Y(1:2) = G%geoLatBu (i-1:i,j-1) *1000 - Y(3:4) = G%geoLatBu (i-1:i,j)*1000 + X(1:2) = G%geoLonBu(i-1:i,j-1)*1000 + X(3:4) = G%geoLonBu(i-1:i,j) *1000 + Y(1:2) = G%geoLatBu(i-1:i,j-1) *1000 + Y(3:4) = G%geoLatBu(i-1:i,j)*1000 - call bilinear_shape_functions (X, Y, Phi, area) + call bilinear_shape_functions(X, Y, Phi, area) ! X and Y must be passed in the form ! 3 - 4 @@ -4754,41 +4754,41 @@ subroutine matrix_diagonal_bilinear(CS, float_cond, H_node, dens_ratio, Phisub, jlq = 1 endif - if (umask (i-2+iphi,j-2+jphi) == 1) then + if (umask(i-2+iphi,j-2+jphi) == 1) then ux = Phi (2*(2*(jphi-1)+iphi)-1, 2*(jq-1)+iq) uy = Phi (2*(2*(jphi-1)+iphi), 2*(jq-1)+iq) vx = 0. vy = 0. - u_diagonal (i-2+iphi,j-2+jphi) = u_diagonal (i-2+iphi,j-2+jphi) + & - .25 * dxdyh * nu (i,j) * ((4*ux+2*vy) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & + u_diagonal(i-2+iphi,j-2+jphi) = u_diagonal(i-2+iphi,j-2+jphi) + & + .25 * dxdyh * nu(i,j) * ((4*ux+2*vy) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & (uy+vy) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq)) uq = xquad(ilq) * xquad(jlq) if (float_cond(i,j) == 0) then - u_diagonal (i-2+iphi,j-2+jphi) = u_diagonal (i-2+iphi,j-2+jphi) + & + u_diagonal(i-2+iphi,j-2+jphi) = u_diagonal(i-2+iphi,j-2+jphi) + & .25 * beta(i,j) * dxdyh * uq * xquad(ilq) * xquad(jlq) endif endif - if (vmask (i-2+iphi,j-2+jphi) == 1) then + if (vmask(i-2+iphi,j-2+jphi) == 1) then vx = Phi (2*(2*(jphi-1)+iphi)-1, 2*(jq-1)+iq) vy = Phi (2*(2*(jphi-1)+iphi), 2*(jq-1)+iq) ux = 0. uy = 0. - v_diagonal (i-2+iphi,j-2+jphi) = v_diagonal (i-2+iphi,j-2+jphi) + & - .25 * dxdyh * nu (i,j) * ((uy+vx) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & + v_diagonal(i-2+iphi,j-2+jphi) = v_diagonal(i-2+iphi,j-2+jphi) + & + .25 * dxdyh * nu(i,j) * ((uy+vx) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & (4*vy+2*ux) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq)) vq = xquad(ilq) * xquad(jlq) if (float_cond(i,j) == 0) then - v_diagonal (i-2+iphi,j-2+jphi) = v_diagonal (i-2+iphi,j-2+jphi) + & + v_diagonal(i-2+iphi,j-2+jphi) = v_diagonal(i-2+iphi,j-2+jphi) + & .25 * beta(i,j) * dxdyh * vq * xquad(ilq) * xquad(jlq) endif @@ -4801,9 +4801,9 @@ subroutine matrix_diagonal_bilinear(CS, float_cond, H_node, dens_ratio, Phisub, call CG_diagonal_subgrid_basal_bilinear & (Phisub, Hcell, dxdyh, basel, dens_ratio, Usubcontr, Vsubcontr) do iphi=1,2 ; do jphi=1,2 - if (umask (i-2+iphi,j-2+jphi) == 1) then - u_diagonal (i-2+iphi,j-2+jphi) = u_diagonal (i-2+iphi,j-2+jphi) + Usubcontr (iphi,jphi) * beta(i,j) - v_diagonal (i-2+iphi,j-2+jphi) = v_diagonal (i-2+iphi,j-2+jphi) + Vsubcontr (iphi,jphi) * beta(i,j) + if (umask(i-2+iphi,j-2+jphi) == 1) then + u_diagonal(i-2+iphi,j-2+jphi) = u_diagonal(i-2+iphi,j-2+jphi) + Usubcontr(iphi,jphi) * beta(i,j) + v_diagonal(i-2+iphi,j-2+jphi) = v_diagonal(i-2+iphi,j-2+jphi) + Vsubcontr(iphi,jphi) * beta(i,j) endif enddo ; enddo endif @@ -4851,16 +4851,16 @@ subroutine CG_diagonal_subgrid_basal_bilinear (Phisub, H, DXDYH, D, dens_ratio, end subroutine CG_diagonal_subgrid_basal_bilinear -subroutine apply_boundary_values_triangle (CS, time, u_boundary_contr, v_boundary_contr) +subroutine apply_boundary_values_triangle(CS, time, u_boundary_contr, v_boundary_contr) type(time_type), intent(in) :: Time type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - real, dimension (:,:), intent(inout) :: u_boundary_contr, v_boundary_contr + real, dimension(:,:), intent(inout) :: u_boundary_contr, v_boundary_contr ! this will be a per-setup function. the boundary values of thickness and velocity ! (and possibly other variables) will be updated in this function - real, pointer, dimension (:,:) :: u_boundary_values, & + real, pointer, dimension(:,:) :: u_boundary_values, & v_boundary_values, & umask, vmask, hmask, & nu_lower, nu_upper, beta_lower, beta_upper @@ -4901,53 +4901,53 @@ subroutine apply_boundary_values_triangle (CS, time, u_boundary_contr, v_boundar uy = (u_boundary_values(i-1,j)-u_boundary_values(i-1,j-1))/dyh vy = (v_boundary_values(i-1,j)-v_boundary_values(i-1,j-1))/dyh - if (umask (i,j-1) == 1) then ! this (bot right) is a degree of freedom node + if (umask(i,j-1) == 1) then ! this (bot right) is a degree of freedom node - u_boundary_contr (i,j-1) = u_boundary_contr (i,j-1) + & - .5 * dxdyh * nu_lower (i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (0./dyh)) + u_boundary_contr(i,j-1) = u_boundary_contr(i,j-1) + & + .5 * dxdyh * nu_lower(i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (0./dyh)) - v_boundary_contr (i,j-1) = v_boundary_contr (i,j-1) + & - .5 * dxdyh * nu_lower (i,j) * ((uy+vx) * (1./dxh) + (4*vy+2*ux) * (0./dyh)) + v_boundary_contr(i,j-1) = v_boundary_contr(i,j-1) + & + .5 * dxdyh * nu_lower(i,j) * ((uy+vx) * (1./dxh) + (4*vy+2*ux) * (0./dyh)) - u_boundary_contr (i,j-1) = u_boundary_contr (i,j-1) + & + u_boundary_contr(i,j-1) = u_boundary_contr(i,j-1) + & beta_lower(i,j) * dxdyh * 1./24 * (u_boundary_values(i-1,j-1) + & u_boundary_values(i-1,j) + u_boundary_values(i,j-1)) - v_boundary_contr (i,j-1) = v_boundary_contr (i,j-1) + & + v_boundary_contr(i,j-1) = v_boundary_contr(i,j-1) + & beta_lower(i,j) * dxdyh * 1./24 * (v_boundary_values(i-1,j-1) + & v_boundary_values(i-1,j) + v_boundary_values(i,j-1)) endif - if (umask (i-1,j) == 1) then ! this (top left) is a degree of freedom node + if (umask(i-1,j) == 1) then ! this (top left) is a degree of freedom node - u_boundary_contr (i-1,j) = u_boundary_contr (i-1,j) + & - .5 * dxdyh * nu_lower (i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (1./dyh)) + u_boundary_contr(i-1,j) = u_boundary_contr(i-1,j) + & + .5 * dxdyh * nu_lower(i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (1./dyh)) - v_boundary_contr (i-1,j) = v_boundary_contr (i-1,j) + & - .5 * dxdyh * nu_lower (i,j) * ((uy+vx) * (0./dxh) + (4*vy+2*ux) * (1./dyh)) + v_boundary_contr(i-1,j) = v_boundary_contr(i-1,j) + & + .5 * dxdyh * nu_lower(i,j) * ((uy+vx) * (0./dxh) + (4*vy+2*ux) * (1./dyh)) - u_boundary_contr (i,j-1) = u_boundary_contr (i,j-1) + & + u_boundary_contr(i,j-1) = u_boundary_contr(i,j-1) + & beta_lower(i,j) * dxdyh * 1./24 * (u_boundary_values(i-1,j-1) + & u_boundary_values(i-1,j) + u_boundary_values(i,j-1)) - v_boundary_contr (i,j-1) = v_boundary_contr (i,j-1) + & + v_boundary_contr(i,j-1) = v_boundary_contr(i,j-1) + & beta_lower(i,j) * dxdyh * 1./24 * (v_boundary_values(i-1,j-1) + & v_boundary_values(i-1,j) + v_boundary_values(i,j-1)) endif - if (umask (i-1,j-1) == 1) then ! this (bot left) is a degree of freedom node + if (umask(i-1,j-1) == 1) then ! this (bot left) is a degree of freedom node - u_boundary_contr (i-1,j-1) = u_boundary_contr (i-1,j-1) + & - .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (-1./dyh)) + u_boundary_contr(i-1,j-1) = u_boundary_contr(i-1,j-1) + & + .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (-1./dyh)) - v_boundary_contr (i-1,j-1) = v_boundary_contr (i-1,j-1) + & - .5 * dxdyh * nu_upper (i,j) * ((uy+vx) * (-1./dxh) + (4*vy+2*ux) * (-1./dyh)) + v_boundary_contr(i-1,j-1) = v_boundary_contr(i-1,j-1) + & + .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (-1./dxh) + (4*vy+2*ux) * (-1./dyh)) - u_boundary_contr (i-1,j-1) = u_boundary_contr (i-1,j-1) + & + u_boundary_contr(i-1,j-1) = u_boundary_contr(i-1,j-1) + & beta_lower(i,j) * dxdyh * 1./24 * (u_boundary_values(i-1,j-1) + & u_boundary_values(i-1,j) + u_boundary_values(i,j-1)) - v_boundary_contr (i-1,j-1) = v_boundary_contr (i-1,j-1) + & + v_boundary_contr(i-1,j-1) = v_boundary_contr(i-1,j-1) + & beta_lower(i,j) * dxdyh * 1./24 * (v_boundary_values(i-1,j-1) + & v_boundary_values(i-1,j) + v_boundary_values(i,j-1)) endif @@ -4965,58 +4965,58 @@ subroutine apply_boundary_values_triangle (CS, time, u_boundary_contr, v_boundar uy = (u_boundary_values(i,j)-u_boundary_values(i,j-1))/dyh vy = (v_boundary_values(i,j)-v_boundary_values(i,j-1))/dyh - if (umask (i,j-1) == 1) then ! this (bot right) is a degree of freedom node + if (umask(i,j-1) == 1) then ! this (bot right) is a degree of freedom node - u_boundary_contr (i,j-1) = u_boundary_contr (i,j-1) + & - .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (-1./dyh)) + u_boundary_contr(i,j-1) = u_boundary_contr(i,j-1) + & + .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (-1./dyh)) - v_boundary_contr (i,j-1) = v_boundary_contr (i,j-1) + & - .5 * dxdyh * nu_upper (i,j) * ((uy+vx) * (0./dxh) + (4*vy+2*ux) * (-1./dyh)) + v_boundary_contr(i,j-1) = v_boundary_contr(i,j-1) + & + .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (0./dxh) + (4*vy+2*ux) * (-1./dyh)) - u_boundary_contr (i,j-1) = u_boundary_contr (i,j-1) + & + u_boundary_contr(i,j-1) = u_boundary_contr(i,j-1) + & beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + & u_boundary_values(i-1,j) + & u_boundary_values(i,j-1)) - v_boundary_contr (i,j-1) = v_boundary_contr (i,j-1) + & + v_boundary_contr(i,j-1) = v_boundary_contr(i,j-1) + & beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + & u_boundary_values(i-1,j) + & u_boundary_values(i,j-1)) endif - if (umask (i-1,j) == 1) then ! this (top left) is a degree of freedom node + if (umask(i-1,j) == 1) then ! this (top left) is a degree of freedom node - u_boundary_contr (i-1,j) = u_boundary_contr (i-1,j) + & - .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (0./dyh)) + u_boundary_contr(i-1,j) = u_boundary_contr(i-1,j) + & + .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (0./dyh)) - v_boundary_contr (i-1,j) = v_boundary_contr (i-1,j) + & - .5 * dxdyh * nu_upper (i,j) * ((uy+vx) * (-1./dxh) + (4*vy+2*ux) * (0./dyh)) + v_boundary_contr(i-1,j) = v_boundary_contr(i-1,j) + & + .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (-1./dxh) + (4*vy+2*ux) * (0./dyh)) - u_boundary_contr (i,j-1) = u_boundary_contr (i,j-1) + & + u_boundary_contr(i,j-1) = u_boundary_contr(i,j-1) + & beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + & u_boundary_values(i-1,j) + & u_boundary_values(i,j-1)) - v_boundary_contr (i,j-1) = v_boundary_contr (i,j-1) + & + v_boundary_contr(i,j-1) = v_boundary_contr(i,j-1) + & beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + & u_boundary_values(i-1,j) + & u_boundary_values(i,j-1)) endif - if (umask (i,j) == 1) then ! this (top right) is a degree of freedom node + if (umask(i,j) == 1) then ! this (top right) is a degree of freedom node - u_boundary_contr (i,j) = u_boundary_contr (i,j) + & - .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (1./dyh)) + u_boundary_contr(i,j) = u_boundary_contr(i,j) + & + .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (1./dyh)) - v_boundary_contr (i,j) = v_boundary_contr (i,j) + & - .5 * dxdyh * nu_upper (i,j) * ((uy+vx) * (1./dxh) + (4*vy+2*ux) * (1./dyh)) + v_boundary_contr(i,j) = v_boundary_contr(i,j) + & + .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (1./dxh) + (4*vy+2*ux) * (1./dyh)) - u_boundary_contr (i,j) = u_boundary_contr (i,j) + & + u_boundary_contr(i,j) = u_boundary_contr(i,j) + & beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + & u_boundary_values(i-1,j) + & u_boundary_values(i,j-1)) - v_boundary_contr (i,j) = v_boundary_contr (i,j) + & + v_boundary_contr(i,j) = v_boundary_contr(i,j) + & beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + & u_boundary_values(i-1,j) + & u_boundary_values(i,j-1)) @@ -5032,17 +5032,17 @@ subroutine apply_boundary_values_bilinear(CS, time, Phisub, H_node, float_cond, u_boundary_contr, v_boundary_contr) type(time_type), intent(in) :: Time - real, dimension (:,:,:,:,:,:),pointer:: Phisub + real, dimension(:,:,:,:,:,:),pointer:: Phisub type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - real, dimension (NILIMB_SYM_,NJLIMB_SYM_), intent (in) :: H_node - real, dimension (:,:), intent (in) :: float_cond + real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent (in) :: H_node + real, dimension(:,:), intent (in) :: float_cond real :: dens_ratio - real, dimension (NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u_boundary_contr, v_boundary_contr + real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u_boundary_contr, v_boundary_contr ! this will be a per-setup function. the boundary values of thickness and velocity ! (and possibly other variables) will be updated in this function - real, pointer, dimension (:,:) :: u_boundary_values, & + real, pointer, dimension(:,:) :: u_boundary_values, & v_boundary_values, & umask, vmask, & nu, beta, hmask @@ -5094,12 +5094,12 @@ subroutine apply_boundary_values_bilinear(CS, time, Phisub, H_node, float_cond, dyh = G%dyT(i,j) dxdyh = G%areaT(i,j) - X(1:2) = G%geoLonBu (i-1:i,j-1)*1000 - X(3:4) = G%geoLonBu (i-1:i,j)*1000 - Y(1:2) = G%geoLatBu (i-1:i,j-1)*1000 - Y(3:4) = G%geoLatBu (i-1:i,j)*1000 + X(1:2) = G%geoLonBu(i-1:i,j-1)*1000 + X(3:4) = G%geoLonBu(i-1:i,j)*1000 + Y(1:2) = G%geoLatBu(i-1:i,j-1)*1000 + Y(3:4) = G%geoLatBu(i-1:i,j)*1000 - call bilinear_shape_functions (X, Y, Phi, area) + call bilinear_shape_functions(X, Y, Phi, area) ! X and Y must be passed in the form ! 3 - 4 @@ -5156,29 +5156,29 @@ subroutine apply_boundary_values_bilinear(CS, time, Phisub, H_node, float_cond, jlq = 1 endif - if (umask (i-2+iphi,j-2+jphi) == 1) then + if (umask(i-2+iphi,j-2+jphi) == 1) then - u_boundary_contr (i-2+iphi,j-2+jphi) = u_boundary_contr (i-2+iphi,j-2+jphi) + & - .25 * dxdyh * nu (i,j) * ( (4*ux+2*vy) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & + u_boundary_contr(i-2+iphi,j-2+jphi) = u_boundary_contr(i-2+iphi,j-2+jphi) + & + .25 * dxdyh * nu(i,j) * ( (4*ux+2*vy) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & (uy+vx) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq) ) if (float_cond(i,j) == 0) then - u_boundary_contr (i-2+iphi,j-2+jphi) = u_boundary_contr (i-2+iphi,j-2+jphi) + & + u_boundary_contr(i-2+iphi,j-2+jphi) = u_boundary_contr(i-2+iphi,j-2+jphi) + & .25 * beta(i,j) * dxdyh * uq * xquad(ilq) * xquad(jlq) endif endif - if (vmask (i-2+iphi,j-2+jphi) == 1) then + if (vmask(i-2+iphi,j-2+jphi) == 1) then - v_boundary_contr (i-2+iphi,j-2+jphi) = v_boundary_contr (i-2+iphi,j-2+jphi) + & - .25 * dxdyh * nu (i,j) * ( (uy+vx) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & + v_boundary_contr(i-2+iphi,j-2+jphi) = v_boundary_contr(i-2+iphi,j-2+jphi) + & + .25 * dxdyh * nu(i,j) * ( (uy+vx) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & (4*vy+2*ux) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq)) if (float_cond(i,j) == 0) then - v_boundary_contr (i-2+iphi,j-2+jphi) = v_boundary_contr (i-2+iphi,j-2+jphi) + & + v_boundary_contr(i-2+iphi,j-2+jphi) = v_boundary_contr(i-2+iphi,j-2+jphi) + & .25 * beta(i,j) * dxdyh * vq * xquad(ilq) * xquad(jlq) endif @@ -5193,13 +5193,13 @@ subroutine apply_boundary_values_bilinear(CS, time, Phisub, H_node, float_cond, call CG_action_subgrid_basal_bilinear & (Phisub, Hcell, Ucell, Vcell, dxdyh, basel, dens_ratio, Usubcontr, Vsubcontr) do iphi=1,2 ; do jphi = 1,2 - if (umask (i-2+iphi,j-2+jphi) == 1) then - u_boundary_contr (i-2+iphi,j-2+jphi) = u_boundary_contr (i-2+iphi,j-2+jphi) + & - Usubcontr(iphi,jphi) * beta (i,j) + if (umask(i-2+iphi,j-2+jphi) == 1) then + u_boundary_contr(i-2+iphi,j-2+jphi) = u_boundary_contr(i-2+iphi,j-2+jphi) + & + Usubcontr(iphi,jphi) * beta(i,j) endif - if (vmask (i-2+iphi,j-2+jphi) == 1) then - v_boundary_contr (i-2+iphi,j-2+jphi) = v_boundary_contr (i-2+iphi,j-2+jphi) + & - Vsubcontr(iphi,jphi) * beta (i,j) + if (vmask(i-2+iphi,j-2+jphi) == 1) then + v_boundary_contr(i-2+iphi,j-2+jphi) = v_boundary_contr(i-2+iphi,j-2+jphi) + & + Vsubcontr(iphi,jphi) * beta(i,j) endif enddo ; enddo endif @@ -5208,7 +5208,7 @@ subroutine apply_boundary_values_bilinear(CS, time, Phisub, H_node, float_cond, end subroutine apply_boundary_values_bilinear -subroutine calc_shelf_visc_triangular (CS,u,v) +subroutine calc_shelf_visc_triangular(CS,u,v) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(:,:), intent(inout) :: u, v @@ -5219,11 +5219,11 @@ subroutine calc_shelf_visc_triangular (CS,u,v) ! this may be subject to change later... to make it "hybrid" - real, pointer, dimension (:,:) :: nu_lower , & + real, pointer, dimension(:,:) :: nu_lower , & nu_upper, & beta_eff_lower, & beta_eff_upper - real, pointer, dimension (:,:) :: H, &! thickness + real, pointer, dimension(:,:) :: H, &! thickness hmask type(ocean_grid_type), pointer :: G @@ -5265,7 +5265,7 @@ subroutine calc_shelf_visc_triangular (CS,u,v) dyh = G%dyT(i,j) dxdyh = G%areaT(i,j) - if (hmask (i,j) == 1) then + if (hmask(i,j) == 1) then ux = (u(i,j-1)-u(i-1,j-1)) / dxh vx = (v(i,j-1)-v(i-1,j-1)) / dxh uy = (u(i-1,j)-u(i-1,j-1)) / dyh @@ -5275,7 +5275,7 @@ subroutine calc_shelf_visc_triangular (CS,u,v) umid = 1./3 * (u(i-1,j-1)+u(i-1,j)+u(i,j-1)) vmid = 1./3 * (v(i-1,j-1)+v(i-1,j)+v(i,j-1)) unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) - beta_eff_lower (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) + beta_eff_lower(i,j) = C_basal_friction * unorm ** (n_basal_friction-1) ux = (u(i,j)-u(i-1,j)) / dxh vx = (v(i,j)-v(i-1,j)) / dxh @@ -5286,7 +5286,7 @@ subroutine calc_shelf_visc_triangular (CS,u,v) umid = 1./3 * (u(i,j)+u(i-1,j)+u(i,j-1)) vmid = 1./3 * (v(i,j)+v(i-1,j)+v(i,j-1)) unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) - beta_eff_upper (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) + beta_eff_upper(i,j) = C_basal_friction * unorm ** (n_basal_friction-1) endif enddo @@ -5294,7 +5294,7 @@ subroutine calc_shelf_visc_triangular (CS,u,v) end subroutine calc_shelf_visc_triangular -subroutine calc_shelf_visc_bilinear (CS, u, v) +subroutine calc_shelf_visc_bilinear(CS, u, v) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u, v @@ -5305,9 +5305,9 @@ subroutine calc_shelf_visc_bilinear (CS, u, v) ! this may be subject to change later... to make it "hybrid" - real, pointer, dimension (:,:) :: nu, & + real, pointer, dimension(:,:) :: nu, & beta - real, pointer, dimension (:,:) :: H, &! thickness + real, pointer, dimension(:,:) :: H, &! thickness hmask type(ocean_grid_type), pointer :: G @@ -5341,7 +5341,7 @@ subroutine calc_shelf_visc_bilinear (CS, u, v) dyh = G%dyT(i,j) dxdyh = G%areaT(i,j) - if (hmask (i,j) == 1) then + if (hmask(i,j) == 1) then ux = (u(i,j) + u(i,j-1) - u(i-1,j) - u(i-1,j-1)) / (2*dxh) vx = (v(i,j) + v(i,j-1) - v(i-1,j) - v(i-1,j-1)) / (2*dxh) uy = (u(i,j) - u(i,j-1) + u(i-1,j) - u(i-1,j-1)) / (2*dyh) @@ -5351,14 +5351,14 @@ subroutine calc_shelf_visc_bilinear (CS, u, v) umid = (u(i,j) + u(i,j-1) + u(i-1,j) + u(i-1,j-1))/4 vmid = (v(i,j) + v(i,j-1) + v(i-1,j) + v(i-1,j-1))/4 - unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) ; beta (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) + unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) ; beta(i,j) = C_basal_friction * unorm ** (n_basal_friction-1) endif enddo enddo end subroutine calc_shelf_visc_bilinear -subroutine update_OD_ffrac (CS, ocean_mass, counter, nstep_velocity, time_step, velocity_update_time_step) +subroutine update_OD_ffrac(CS, ocean_mass, counter, nstep_velocity, time_step, velocity_update_time_step) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(CS%grid%isd:,CS%grid%jsd:) :: ocean_mass integer,intent(in) :: counter @@ -5409,7 +5409,7 @@ subroutine update_OD_ffrac (CS, ocean_mass, counter, nstep_velocity, time_step, end subroutine update_OD_ffrac -subroutine update_OD_ffrac_uncoupled (CS) +subroutine update_OD_ffrac_uncoupled(CS) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), pointer :: G @@ -5432,13 +5432,13 @@ subroutine update_OD_ffrac_uncoupled (CS) do j=jsd,jed do i=isd,ied - OD = G%bathyT(i,j) - rhoi/rhow * h_shelf (i,j) + OD = G%bathyT(i,j) - rhoi/rhow * h_shelf(i,j) if (OD >= 0) then ! ice thickness does not take up whole ocean column -> floating - OD_av (i,j) = OD + OD_av(i,j) = OD float_frac(i,j) = 0. else - OD_av (i,j) = 0. + OD_av(i,j) = 0. float_frac(i,j) = 1. endif enddo @@ -5469,7 +5469,7 @@ subroutine bilinear_shape_functions (X, Y, Phi, area) ! This should be a one-off; once per nonlinear solve? once per lifetime? ! ... will all cells have the same shape and dimension? - real, dimension (4) :: xquad, yquad + real, dimension(4) :: xquad, yquad integer :: node, qpoint, xnode, xq, ynode, yq real :: a,b,c,d,e,f,xexp,yexp @@ -5522,7 +5522,7 @@ subroutine bilinear_shape_functions_subgrid (Phisub, nsub) ! i think this general approach may not work for nonrectangular elements... ! - ! Phisub (i,j,k,l,q1,q2) + ! Phisub(i,j,k,l,q1,q2) ! i: subgrid index in x-direction ! j: subgrid index in y-direction ! k: basis function x-index @@ -5566,7 +5566,7 @@ subroutine bilinear_shape_functions_subgrid (Phisub, nsub) else val = val * y endif - Phisub (i,j,k,l,qx,qy) = val + Phisub(i,j,k,l,qx,qy) = val enddo enddo enddo @@ -5580,7 +5580,7 @@ subroutine bilinear_shape_functions_subgrid (Phisub, nsub) end subroutine bilinear_shape_functions_subgrid -subroutine update_velocity_masks (CS) +subroutine update_velocity_masks(CS) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure ! sets masks for velocity solve @@ -5621,8 +5621,8 @@ subroutine update_velocity_masks (CS) isym = 0 - umask (:,:) = 0 ; vmask (:,:) = 0 - u_face_mask (:,:) = 0 ; v_face_mask (:,:) = 0 + umask(:,:) = 0 ; vmask(:,:) = 0 + u_face_mask(:,:) = 0 ; v_face_mask(:,:) = 0 if (G%symmetric) then is = isd ; js = jsd @@ -5685,17 +5685,17 @@ subroutine update_velocity_masks (CS) enddo !if (u_face_mask_boundary(i-1,j).geq.0) then !left boundary - ! u_face_mask (i-1,j) = u_face_mask_boundary(i-1,j) - ! umask (i-1,j-1:j) = 3. - ! vmask (i-1,j-1:j) = 0. + ! u_face_mask(i-1,j) = u_face_mask_boundary(i-1,j) + ! umask(i-1,j-1:j) = 3. + ! vmask(i-1,j-1:j) = 0. !endif !if (j_off+j == gjsc+1) then !bot boundary - ! v_face_mask (i,j-1) = 0. + ! v_face_mask(i,j-1) = 0. ! umask (i-1:i,j-1) = 0. ! vmask (i-1:i,j-1) = 0. !elseif (j_off+j == gjec) then !top boundary - ! v_face_mask (i,j) = 0. + ! v_face_mask(i,j) = 0. ! umask (i-1:i,j) = 0. ! vmask (i-1:i,j) = 0. !endif @@ -5704,28 +5704,28 @@ subroutine update_velocity_masks (CS) if ((hmask(i+1,j) == 0) & .OR. (hmask(i+1,j) == 2)) then !right boundary or adjacent to unfilled cell - u_face_mask (i,j) = 2. + u_face_mask(i,j) = 2. endif endif if (i > G%isd) then if ((hmask(i-1,j) == 0) .OR. (hmask(i-1,j) == 2)) then !adjacent to unfilled cell - u_face_mask (i-1,j) = 2. + u_face_mask(i-1,j) = 2. endif endif if (j > G%jsd) then if ((hmask(i,j-1) == 0) .OR. (hmask(i,j-1) == 2)) then !adjacent to unfilled cell - v_face_mask (i,j-1) = 2. + v_face_mask(i,j-1) = 2. endif endif if (j < G%jed) then if ((hmask(i,j+1) == 0) .OR. (hmask(i,j+1) == 2)) then !adjacent to unfilled cell - v_face_mask (i,j) = 2. + v_face_mask(i,j) = 2. endif endif @@ -5739,12 +5739,12 @@ subroutine update_velocity_masks (CS) ! so this subroutine must update its own symmetric part of the halo call pass_vector(u_face_mask, v_face_mask, G%domain, TO_ALL, CGRID_NE) - call pass_vector (umask,vmask,G%domain,TO_ALL,BGRID_NE) + call pass_vector(umask,vmask,G%domain,TO_ALL,BGRID_NE) end subroutine update_velocity_masks -subroutine interpolate_H_to_B (CS, h_shelf, hmask, H_node) +subroutine interpolate_H_to_B(CS, h_shelf, hmask, H_node) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, dimension(:,:), intent(in) :: h_shelf, hmask real, dimension(NILIMB_SYM_,NJLIMB_SYM_), & @@ -5768,8 +5768,8 @@ subroutine interpolate_H_to_B (CS, h_shelf, hmask, H_node) num_h = 0 do k=0,1 do l=0,1 - if (hmask (i+k,j+l) == 1.0) then - summ = summ + h_shelf (i+k,j+l) + if (hmask(i+k,j+l) == 1.0) then + summ = summ + h_shelf(i+k,j+l) num_h = num_h + 1 endif enddo @@ -5903,7 +5903,7 @@ subroutine savearray2(fname,A,flag) end subroutine savearray2 -subroutine solo_time_step (CS, time_step, n, Time, min_time_step_in) +subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real,intent(in) :: time_step integer, intent(inout) :: n @@ -5949,18 +5949,18 @@ subroutine solo_time_step (CS, time_step, n, Time, min_time_step_in) local_u_max = 0 ; local_v_max = 0 - if (hmask (i,j) == 1.0) then + if (hmask(i,j) == 1.0) then ! all 4 corners of the cell should have valid velocity values; otherwise something is wrong ! this is done by checking that umask and vmask are nonzero at all 4 corners do ki=1,2 ; do kj = 1,2 - local_u_max = max (local_u_max, abs(u_shelf(i-1+ki,j-1+kj))) - local_v_max = max (local_v_max, abs(v_shelf(i-1+ki,j-1+kj))) + local_u_max = max(local_u_max, abs(u_shelf(i-1+ki,j-1+kj))) + local_v_max = max(local_v_max, abs(v_shelf(i-1+ki,j-1+kj))) enddo ; enddo - ratio = min (G%areaT(i,j) / (local_u_max+1.0e-12), G%areaT(i,j) / (local_v_max+1.0e-12)) - min_ratio = min (min_ratio, ratio) + ratio = min(G%areaT(i,j) / (local_u_max+1.0e-12), G%areaT(i,j) / (local_v_max+1.0e-12)) + min_ratio = min(min_ratio, ratio) endif enddo ! j loop @@ -5968,12 +5968,12 @@ subroutine solo_time_step (CS, time_step, n, Time, min_time_step_in) ! solved velocities are in m/yr; we want m/s - call mpp_min (min_ratio) + call mpp_min(min_ratio) time_step_int = min(CS%CFL_factor * min_ratio * (365*86400), time_step) if (time_step_int < min_time_step) then - call MOM_error (FATAL, "MOM_ice_shelf:solo_time_step: abnormally small timestep") + call MOM_error(FATAL, "MOM_ice_shelf:solo_time_step: abnormally small timestep") else if (is_root_pe()) then write(*,*) "Ice model timestep: ", time_step_int, " seconds" @@ -5989,7 +5989,7 @@ subroutine solo_time_step (CS, time_step, n, Time, min_time_step_in) write (stepnum,'(I4)') CS%velocity_update_sub_counter - call ice_shelf_advect (CS, time_step_int, CS%lprec, Time) + call ice_shelf_advect(CS, time_step_int, CS%lprec, Time) if (mpp_pe() == 7) then call savearray2 ("hmask",CS%hmask,CS%write_output_to_file) @@ -6000,17 +6000,17 @@ subroutine solo_time_step (CS, time_step, n, Time, min_time_step_in) ! if the last mini-timestep is a day or less, we cannot expect velocities to change by much. ! do not update them if (time_step_int > 1000) then - call update_velocity_masks (CS) + call update_velocity_masks(CS) ! call savearray2 ("Umask"//"p"//trim(procnum)//"_"//trim(stepnum),CS%umask,CS%write_output_to_file) ! call savearray2 ("Vmask"//"p"//trim(procnum)//"_"//trim(stepnum),CS%vmask,CS%write_output_to_file) - call update_OD_ffrac_uncoupled (CS) - call ice_shelf_solve_outer (CS, CS%u_shelf, CS%v_shelf, 1, iters, dummy) + call update_OD_ffrac_uncoupled(CS) + call ice_shelf_solve_outer(CS, CS%u_shelf, CS%v_shelf, 1, iters, dummy) endif !!! OVS!!! - call ice_shelf_temp (CS, time_step_int, CS%lprec, Time) + call ice_shelf_temp(CS, time_step_int, CS%lprec, Time) call enable_averaging(time_step,Time,CS%diag) if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, CS%area_shelf_h, CS%diag) @@ -6065,10 +6065,10 @@ subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) ! ###Perhaps flux_enter should be changed into u-face and v-face ! ###fluxes, which can then be used in halo updates, etc. ! - ! from left neighbor: flux_enter (:,:,1) - ! from right neighbor: flux_enter (:,:,2) - ! from bottom neighbor: flux_enter (:,:,3) - ! from top neighbor: flux_enter (:,:,4) + ! from left neighbor: flux_enter(:,:,1) + ! from right neighbor: flux_enter(:,:,2) + ! from bottom neighbor: flux_enter(:,:,3) + ! from top neighbor: flux_enter(:,:,4) ! ! THESE ARE NOT CONSISTENT ==> FIND OUT WHAT YOU IMPLEMENTED @@ -6100,10 +6100,10 @@ subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec - flux_enter (:,:,:) = 0.0 + flux_enter(:,:,:) = 0.0 - th_after_uflux (:,:) = 0.0 - th_after_vflux (:,:) = 0.0 + th_after_uflux(:,:) = 0.0 + th_after_vflux(:,:) = 0.0 do j=jsd,jed do i=isd,ied @@ -6117,32 +6117,32 @@ subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) do j=jsd,jed do i=isd,ied - TH (i,j) = CS%t_shelf(i,j)*CS%h_shelf (i,j) + TH(i,j) = CS%t_shelf(i,j)*CS%h_shelf(i,j) enddo enddo ! call enable_averaging(time_step,Time,CS%diag) - ! call pass_var (h_after_uflux, G%domain) + ! call pass_var(h_after_uflux, G%domain) ! if (CS%id_h_after_uflux > 0) call post_data(CS%id_h_after_uflux, h_after_uflux, CS%diag) ! call disable_averaging(CS%diag) ! call enable_averaging(time_step,Time,CS%diag) -! call pass_var (h_after_vflux, G%domain) +! call pass_var(h_after_vflux, G%domain) ! if (CS%id_h_after_vflux > 0) call post_data(CS%id_h_after_vflux, h_after_vflux, CS%diag) ! call disable_averaging(CS%diag) - call ice_shelf_advect_temp_x (CS, time_step/spy, TH, th_after_uflux, flux_enter) - call ice_shelf_advect_temp_y (CS, time_step/spy, th_after_uflux, th_after_vflux, flux_enter) + call ice_shelf_advect_temp_x(CS, time_step/spy, TH, th_after_uflux, flux_enter) + call ice_shelf_advect_temp_y(CS, time_step/spy, th_after_uflux, th_after_vflux, flux_enter) do j=jsd,jed do i=isd,ied ! if (CS%hmask(i,j) == 1) then if (CS%h_shelf(i,j) > 0.0) then - CS%t_shelf (i,j) = th_after_vflux(i,j)/CS%h_shelf (i,j) + CS%t_shelf(i,j) = th_after_vflux(i,j)/CS%h_shelf(i,j) else CS%t_shelf(i,j) = -10.0 endif @@ -6164,8 +6164,8 @@ subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) do i=isc,iec if ((CS%hmask(i,j) == 1) .or. (CS%hmask(i,j) == 2)) then if (CS%h_shelf(i,j) > 0.0) then -! CS%t_shelf (i,j) = CS%t_shelf (i,j) + time_step*(adot*Tsurf -melt_rate (i,j)*Tbot(i,j))/CS%h_shelf (i,j) - CS%t_shelf (i,j) = CS%t_shelf (i,j) + time_step*(adot*Tsurf -3/spy*Tbot(i,j))/CS%h_shelf (i,j) +! CS%t_shelf(i,j) = CS%t_shelf(i,j) + time_step*(adot*Tsurf -melt_rate(i,j)*Tbot(i,j))/CS%h_shelf(i,j) + CS%t_shelf(i,j) = CS%t_shelf(i,j) + time_step*(adot*Tsurf -3/spy*Tbot(i,j))/CS%h_shelf(i,j) else ! the ice is about to melt away ! in this case set thickness, area, and mask to zero @@ -6183,13 +6183,13 @@ subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) call pass_var(CS%tmask, G%domain) if (CS%DEBUG) then - call hchksum (CS%t_shelf, "temp after front", G%HI, haloshift=3) + call hchksum(CS%t_shelf, "temp after front", G%HI, haloshift=3) endif end subroutine ice_shelf_temp -subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter) +subroutine ice_shelf_advect_temp_x(CS, time_step, h0, h_after_uflux, flux_enter) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, intent(in) :: time_step real, dimension(:,:), intent(in) :: h0 @@ -6202,10 +6202,10 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary ! - ! from left neighbor: flux_enter (:,:,1) - ! from right neighbor: flux_enter (:,:,2) - ! from bottom neighbor: flux_enter (:,:,3) - ! from top neighbor: flux_enter (:,:,4) + ! from left neighbor: flux_enter(:,:,1) + ! from right neighbor: flux_enter(:,:,2) + ! from bottom neighbor: flux_enter(:,:,3) + ! from top neighbor: flux_enter(:,:,4) ! ! o--- (4) ---o ! | | @@ -6278,9 +6278,9 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter ! 1ST DO LEFT FACE - if (u_face_mask (i-1,j) == 4.) then + if (u_face_mask(i-1,j) == 4.) then - flux_diff_cell = flux_diff_cell + dyh * time_step * u_flux_boundary_values (i-1,j) * & + flux_diff_cell = flux_diff_cell + dyh * time_step * u_flux_boundary_values(i-1,j) * & t_boundary(i-1,j) / dxdyh ! assume no flux bc for temp ! flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_shelf(i,j)*t_boundary(i-1,j) / dxdyh @@ -6290,7 +6290,7 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter ! get u-velocity at center of left face u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - ! if (at_west_bdry .and. (i == G%isc)) then + ! if (at_west_bdry .and.(i == G%isc)) then ! print *, j, u_face, stencil(-1) ! endif @@ -6336,12 +6336,12 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter ! get u-velocity at center of right face - if (u_face_mask (i+1,j) == 4.) then + if (u_face_mask(i+1,j) == 4.) then - flux_diff_cell = flux_diff_cell + dyh * time_step * u_flux_boundary_values (i+1,j) *& + flux_diff_cell = flux_diff_cell + dyh * time_step * u_flux_boundary_values(i+1,j) *& t_boundary(i+1,j)/ dxdyh ! assume no flux bc for temp -! flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_shelf(i,j)*t_boundary (i+1,j)/ dxdyh +! flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_shelf(i,j)*t_boundary(i+1,j)/ dxdyh else @@ -6399,11 +6399,11 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - flux_enter (i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * t_boundary(i-1,j)* & + flux_enter(i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * t_boundary(i-1,j)* & CS%thickness_boundary_values(i+1,j) - elseif (u_face_mask (i-1,j) == 4.) then - flux_enter (i,j,1) = G%dyT(i,j) * time_step * u_flux_boundary_values (i-1,j)*t_boundary(i-1,j) -! flux_enter (i,j,1) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*t_boundary (i-1,j) + elseif (u_face_mask(i-1,j) == 4.) then + flux_enter(i,j,1) = G%dyT(i,j) * time_step * u_flux_boundary_values(i-1,j)*t_boundary(i-1,j) +! flux_enter(i,j,1) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*t_boundary(i-1,j) ! assume no flux bc for temp endif @@ -6411,10 +6411,10 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * t_boundary(i+1,j)* & CS%thickness_boundary_values(i+1,j) - elseif (u_face_mask (i+1,j) == 4.) then - flux_enter (i,j,2) = G%dyT(i,j) * time_step * u_flux_boundary_values (i+1,j) * t_boundary(i+1,j) + elseif (u_face_mask(i+1,j) == 4.) then + flux_enter(i,j,2) = G%dyT(i,j) * time_step * u_flux_boundary_values(i+1,j) * t_boundary(i+1,j) ! assume no flux bc for temp -! flux_enter (i,j,2) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*t_boundary (i+1,j) +! flux_enter(i,j,2) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*t_boundary(i+1,j) endif ! if ((i == is) .AND. (hmask(i,j) == 0) .AND. (hmask(i-1,j) == 1)) then @@ -6444,7 +6444,7 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter end subroutine ice_shelf_advect_temp_x -subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, flux_enter) +subroutine ice_shelf_advect_temp_y(CS, time_step, h_after_uflux, h_after_vflux, flux_enter) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, intent(in) :: time_step real, dimension(:,:), intent(in) :: h_after_uflux @@ -6457,10 +6457,10 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary ! - ! from left neighbor: flux_enter (:,:,1) - ! from right neighbor: flux_enter (:,:,2) - ! from bottom neighbor: flux_enter (:,:,3) - ! from top neighbor: flux_enter (:,:,4) + ! from left neighbor: flux_enter(:,:,1) + ! from right neighbor: flux_enter(:,:,2) + ! from bottom neighbor: flux_enter(:,:,3) + ! from top neighbor: flux_enter(:,:,4) ! ! o--- (4) ---o ! | | @@ -6520,19 +6520,19 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, if (hmask(i,j) == 1) then dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) - h_after_vflux (i,j) = h_after_uflux (i,j) + h_after_vflux(i,j) = h_after_uflux(i,j) - stencil (:) = h_after_uflux (i,j-2:j+2) ! fine as long has ny_halo >= 2 + stencil(:) = h_after_uflux(i,j-2:j+2) ! fine as long has ny_halo >= 2 flux_diff_cell = 0 ! 1ST DO south FACE - if (v_face_mask (i,j-1) == 4.) then + if (v_face_mask(i,j-1) == 4.) then - flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values (i,j-1) * & + flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values(i,j-1) * & t_boundary(i,j-1)/ dxdyh ! assume no flux bc for temp -! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*t_boundary (i,j-1) / dxdyh +! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*t_boundary(i,j-1) / dxdyh else @@ -6582,10 +6582,10 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, if (v_face_mask(i,j+1) == 4.) then - flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values (i,j+1) *& + flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values(i,j+1) *& t_boundary(i,j+1)/ dxdyh ! assume no flux bc for temp -! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*t_boundary (i,j+1) / dxdyh +! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*t_boundary(i,j+1) / dxdyh else @@ -6626,41 +6626,41 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, endif - h_after_vflux (i,j) = h_after_vflux (i,j) + flux_diff_cell + h_after_vflux(i,j) = h_after_vflux(i,j) + flux_diff_cell elseif ((hmask(i,j) == 0) .OR. (hmask(i,j) == 2)) then if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then v_face = 0.5 * (CS%v_shelf(i-1,j-1) + CS%v_shelf(i,j-1)) - flux_enter (i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * t_boundary(i,j-1)* & + flux_enter(i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * t_boundary(i,j-1)* & CS%thickness_boundary_values(i,j-1) elseif (v_face_mask(i,j-1) == 4.) then - flux_enter (i,j,3) = G%dxT(i,j) * time_step * v_flux_boundary_values (i,j-1)*t_boundary(i,j-1) + flux_enter(i,j,3) = G%dxT(i,j) * time_step * v_flux_boundary_values(i,j-1)*t_boundary(i,j-1) ! assume no flux bc for temp -! flux_enter (i,j,3) = G%dxh(i,j) * time_step * CS%v_shelf(i,j)*t_boundary (i,j-1) +! flux_enter(i,j,3) = G%dxh(i,j) * time_step * CS%v_shelf(i,j)*t_boundary(i,j-1) endif if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then v_face = 0.5 * (CS%v_shelf(i-1,j) + CS%v_shelf(i,j)) - flux_enter (i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * t_boundary(i,j+1)* & + flux_enter(i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * t_boundary(i,j+1)* & CS%thickness_boundary_values(i,j+1) elseif (v_face_mask(i,j+1) == 4.) then - flux_enter (i,j,4) = G%dxT(i,j) * time_step * v_flux_boundary_values (i,j+1)*t_boundary(i,j+1) + flux_enter(i,j,4) = G%dxT(i,j) * time_step * v_flux_boundary_values(i,j+1)*t_boundary(i,j+1) ! assume no flux bc for temp -! flux_enter (i,j,4) = G%dxh(i,j) * time_step * CS%v_shelf(i,j)*t_boundary (i,j+1) +! flux_enter(i,j,4) = G%dxh(i,j) * time_step * CS%v_shelf(i,j)*t_boundary(i,j+1) endif ! if ((j == js) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j-1) == 1)) then ! this is solely for the purposes of keeping the mask consistent while advancing ! the front without having to call pass_var - if cell is empty and cell to left ! is ice-covered then this cell will become partly covered - ! hmask (i,j) = 2 + ! hmask(i,j) = 2 ! elseif ((j == je) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j+1) == 1)) then ! this is solely for the purposes of keeping the mask consistent while advancing the ! front without having to call pass_var - if cell is empty and cell to left is ! ice-covered then this cell will become partly covered -! hmask (i,j) = 2 +! hmask(i,j) = 2 ! endif endif From 30c1b265e0bc7398eef171ba805ddf88c2823612 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 6 May 2018 15:22:28 -0400 Subject: [PATCH 0197/1072] Eliminated trailing semicolons from MOM6 code Semicolons are not proper punctuation to end a sentence; instead they connect independent clauses. MOM6 is written in Fortran, not C; therefore trailing semicolons are unnecssary and have been removed. All answers are bitwise identical. --- config_src/solo_driver/MOM_driver.F90 | 2 +- src/ALE/regrid_edge_values.F90 | 4 +-- src/core/MOM.F90 | 4 +-- src/core/MOM_checksum_packages.F90 | 2 +- src/diagnostics/MOM_diag_to_Z.F90 | 6 ++-- src/diagnostics/MOM_sum_output.F90 | 4 +-- src/equation_of_state/MOM_EOS.F90 | 2 +- src/framework/MOM_coms.F90 | 20 ++++++------- src/framework/MOM_file_parser.F90 | 2 +- src/framework/MOM_hor_index.F90 | 6 ++-- src/framework/MOM_io.F90 | 2 +- src/framework/MOM_string_functions.F90 | 2 +- src/ice_shelf/MOM_ice_shelf.F90 | 6 ++-- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 2 +- src/ice_shelf/shelf_triangular_FEstuff.F90 | 2 +- src/ice_shelf/user_shelf_init.F90 | 2 +- src/initialization/MOM_grid_initialize.F90 | 2 +- .../MOM_state_initialization.F90 | 18 +++++------ src/initialization/midas_vertmap.F90 | 30 +++++++++---------- .../lateral/MOM_internal_tides.F90 | 26 ++++++++-------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 4 +-- .../lateral/MOM_thickness_diffuse.F90 | 2 +- .../vertical/MOM_CVMix_conv.F90 | 2 +- src/parameterizations/vertical/MOM_KPP.F90 | 4 +-- .../vertical/MOM_bulk_mixed_layer.F90 | 2 +- .../vertical/MOM_diabatic_driver.F90 | 8 ++--- .../vertical/MOM_energetic_PBL.F90 | 4 +-- .../vertical/MOM_entrain_diffusive.F90 | 2 +- .../vertical/MOM_geothermal.F90 | 2 +- .../vertical/MOM_opacity.F90 | 4 +-- .../vertical/MOM_regularize_layers.F90 | 4 +-- .../vertical/MOM_set_diffusivity.F90 | 4 +-- .../vertical/MOM_set_viscosity.F90 | 4 +-- .../vertical/MOM_shortwave_abs.F90 | 2 +- .../vertical/MOM_tidal_mixing.F90 | 4 +-- src/tracer/DOME_tracer.F90 | 2 +- src/tracer/ISOMIP_tracer.F90 | 2 +- src/tracer/MOM_OCMIP2_CFC.F90 | 4 +-- src/tracer/MOM_generic_tracer.F90 | 2 +- src/tracer/MOM_neutral_diffusion.F90 | 8 ++--- src/tracer/MOM_offline_aux.F90 | 6 ++-- src/tracer/MOM_offline_main.F90 | 2 +- src/tracer/MOM_tracer_Z_init.F90 | 2 +- src/tracer/MOM_tracer_advect.F90 | 2 +- src/tracer/MOM_tracer_registry.F90 | 2 +- src/tracer/advection_test_tracer.F90 | 2 +- src/tracer/boundary_impulse_tracer.F90 | 2 +- src/tracer/dye_example.F90 | 2 +- src/tracer/dyed_obc_tracer.F90 | 2 +- src/tracer/ideal_age_example.F90 | 2 +- src/tracer/oil_tracer.F90 | 2 +- src/tracer/pseudo_salt_tracer.F90 | 2 +- src/user/MOM_wave_interface.F90 | 4 +-- src/user/SCM_CVmix_tests.F90 | 2 +- src/user/benchmark_initialization.F90 | 2 +- src/user/sloshing_initialization.F90 | 6 ++-- src/user/tidal_bay_initialization.F90 | 2 +- 57 files changed, 129 insertions(+), 129 deletions(-) diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 1bc713d106..2727f42e1f 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -104,7 +104,7 @@ program MOM_main ! simulation does not exceed its CPU time limit. nmax is determined by ! evaluating the CPU time used between successive calls to write_cputime. ! Initially it is set to be very large. - integer :: nmax=2000000000; + integer :: nmax=2000000000 ! A structure containing several relevant directory paths. type(directories) :: dirs diff --git a/src/ALE/regrid_edge_values.F90 b/src/ALE/regrid_edge_values.F90 index f9cdad794a..d43cf5cc36 100644 --- a/src/ALE/regrid_edge_values.F90 +++ b/src/ALE/regrid_edge_values.F90 @@ -152,7 +152,7 @@ end subroutine bound_edge_values !> Replace discontinuous collocated edge values with their average subroutine average_discontinuous_edge_values( N, edge_val ) integer, intent(in) :: N !< Number of cells - real, dimension(:,:), intent(inout) :: edge_val !< Edge values that may be modified; + real, dimension(:,:), intent(inout) :: edge_val !< Edge values that may be modified !! the second index size is 2. ! ------------------------------------------------------------------------------ ! For each interior edge, check whether the edge values are discontinuous. @@ -253,7 +253,7 @@ subroutine edge_values_explicit_h2( N, h, u, edge_val, h_neglect ) ! ! Boundary edge values are set to be equal to the boundary cell averages. ! ------------------------------------------------------------------------------ - + ! Local variables integer :: k ! loop index real :: h0, h1 ! cell widths diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index ea22a1832a..9fca715e42 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1099,7 +1099,7 @@ subroutine step_MOM_thermo(CS, G, GV, u, v, h, tv, fluxes, dtdia, & type(time_type), intent(in) :: Time_end_thermo !< End of averaging interval for thermo diags logical, intent(in) :: update_BBL !< If true, calculate the bottom boundary layer properties. type(wave_parameters_CS), & - optional, pointer :: Waves !< Container for wave related parameters; + optional, pointer :: Waves !< Container for wave related parameters !! the fields in Waves are intent in here. logical :: use_ice_shelf ! Needed for selecting the right ALE interface. @@ -2611,7 +2611,7 @@ end subroutine adjust_ssh_for_p_atm subroutine extract_surface_state(CS, sfc_state) type(MOM_control_struct), pointer :: CS !< Master MOM control structure type(surface), intent(inout) :: sfc_state !< transparent ocean surface state - !! structure shared with the calling routine; + !! structure shared with the calling routine !! data in this structure is intent out. ! local diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index c47b16989e..8f7685b605 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -143,7 +143,7 @@ end subroutine MOM_thermo_chksum subroutine MOM_surface_chksum(mesg, sfc, G, haloshift, symmetric) character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. type(surface), intent(inout) :: sfc !< transparent ocean surface state - !! structure shared with the calling routine; + !! structure shared with the calling routine !! data in this structure is intent out. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index 5dd78e8eee..4efed0628f 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -106,7 +106,7 @@ function global_z_mean(var,G,CS,tracer) real, dimension(CS%nk_zspace) :: global_z_mean, scalarij, weightij real, dimension(CS%nk_zspace) :: global_temp_scalar, global_weight_scalar integer :: i, j, k, is, ie, js, je, nz, tracer - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec nz = CS%nk_zspace ! Initialize local arrays @@ -1153,7 +1153,7 @@ subroutine get_Z_depths(depth_file, int_depth_name, int_depth, cell_depth_name, nk_out = -1 - status = NF90_OPEN(depth_file, NF90_NOWRITE, ncid); + status = NF90_OPEN(depth_file, NF90_NOWRITE, ncid) if (status /= NF90_NOERR) then call MOM_error(WARNING,"MOM_diag_to_Z get_Z_depths: "//& " Difficulties opening "//trim(depth_file)//" - "//& @@ -1302,7 +1302,7 @@ function ocean_register_diag_with_z(tr_ptr, vardesc_tr, G, Time, CS) ! register the layer tracer ocean_register_diag_with_z = ocean_register_diag(vardesc_tr, G, CS%diag, Time) - ! copy layer tracer variable descriptor to a z-tracer descriptor; + ! copy layer tracer variable descriptor to a z-tracer descriptor ! change the name and layer information. vardesc_z = vardesc_tr call modify_vardesc(vardesc_z, z_grid="z", caller="ocean_register_diag_with_z") diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 1dcaa2e516..4db4d30c18 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -136,7 +136,7 @@ module MOM_sum_output ! Start_time is set in MOM_initialization.F90 integer, pointer :: ntrunc ! The number of times the velocity has been ! truncated since the last call to write_energy. - real :: max_Energy ! The maximum permitted energy per unit mass; + real :: max_Energy ! The maximum permitted energy per unit mass ! If there is more energy than this, the model ! should stop, in m2 s-2. integer :: maxtrunc ! The number of truncations per energy save @@ -1328,7 +1328,7 @@ subroutine read_depth_list(G, CS, filename) mdl = "MOM_sum_output read_depth_list:" - status = NF90_OPEN(filename, NF90_NOWRITE, ncid); + status = NF90_OPEN(filename, NF90_NOWRITE, ncid) if (status /= NF90_NOERR) then call MOM_error(FATAL,mdl//" Difficulties opening "//trim(filename)// & " - "//trim(NF90_STRERROR(status))) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 01167693f9..dceed058f2 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -1575,7 +1575,7 @@ subroutine int_density_dz_generic_ppm (T, T_t, T_b, S, S_t, S_b, & !rho_anom = C1_90*(7.0*(r5(1)+r5(5)) + 32.0*(r5(2)+r5(4)) + 12.0*r5(3)) - & ! rho_ref - rho_anom = 1000.0 + S(i,j) - rho_ref; + rho_anom = 1000.0 + S(i,j) - rho_ref dpa(i-ioff,j-joff) = G_e*dz*rho_anom ! Use a Bode's-rule-like fifth-order accurate estimate of diff --git a/src/framework/MOM_coms.F90 b/src/framework/MOM_coms.F90 index d2a268a741..cae5303c96 100644 --- a/src/framework/MOM_coms.F90 +++ b/src/framework/MOM_coms.F90 @@ -116,20 +116,20 @@ function reproducing_sum_2d(array, isr, ier, jsr, jer, EFP_sum, reproducing, & if (over_check) then if ((je+1-js)*(ie+1-is) < max_count_prec) then do j=js,je ; do i=is,ie - call increment_ints_faster(ints_sum, array(i,j), max_mag_term); + call increment_ints_faster(ints_sum, array(i,j), max_mag_term) enddo ; enddo call carry_overflow(ints_sum, prec_error) elseif ((ie+1-is) < max_count_prec) then do j=js,je do i=is,ie - call increment_ints_faster(ints_sum, array(i,j), max_mag_term); + call increment_ints_faster(ints_sum, array(i,j), max_mag_term) enddo call carry_overflow(ints_sum, prec_error) enddo else do j=js,je ; do i=is,ie call increment_ints(ints_sum, real_to_ints(array(i,j), prec_error), & - prec_error); + prec_error) enddo ; enddo endif else @@ -172,7 +172,7 @@ function reproducing_sum_2d(array, isr, ier, jsr, jer, EFP_sum, reproducing, & else rsum(1) = 0.0 do j=js,je ; do i=is,ie - rsum(1) = rsum(1) + array(i,j); + rsum(1) = rsum(1) + array(i,j) enddo ; enddo call sum_across_PEs(rsum,1) sum = rsum(1) @@ -260,21 +260,21 @@ function reproducing_sum_3d(array, isr, ier, jsr, jer, sums, EFP_sum, err) & if (jsz*isz < max_count_prec) then do k=1,ke do j=js,je ; do i=is,ie - call increment_ints_faster(ints_sums(:,k), array(i,j,k), max_mag_term); + call increment_ints_faster(ints_sums(:,k), array(i,j,k), max_mag_term) enddo ; enddo call carry_overflow(ints_sums(:,k), prec_error) enddo elseif (isz < max_count_prec) then do k=1,ke ; do j=js,je do i=is,ie - call increment_ints_faster(ints_sums(:,k), array(i,j,k), max_mag_term); + call increment_ints_faster(ints_sums(:,k), array(i,j,k), max_mag_term) enddo call carry_overflow(ints_sums(:,k), prec_error) enddo ; enddo else do k=1,ke ; do j=js,je ; do i=is,ie call increment_ints(ints_sums(:,k), & - real_to_ints(array(i,j,k), prec_error), prec_error); + real_to_ints(array(i,j,k), prec_error), prec_error) enddo ; enddo ; enddo endif if (present(err)) then @@ -318,21 +318,21 @@ function reproducing_sum_3d(array, isr, ier, jsr, jer, sums, EFP_sum, err) & if (jsz*isz < max_count_prec) then do k=1,ke do j=js,je ; do i=is,ie - call increment_ints_faster(ints_sum, array(i,j,k), max_mag_term); + call increment_ints_faster(ints_sum, array(i,j,k), max_mag_term) enddo ; enddo call carry_overflow(ints_sum, prec_error) enddo elseif (isz < max_count_prec) then do k=1,ke ; do j=js,je do i=is,ie - call increment_ints_faster(ints_sum, array(i,j,k), max_mag_term); + call increment_ints_faster(ints_sum, array(i,j,k), max_mag_term) enddo call carry_overflow(ints_sum, prec_error) enddo ; enddo else do k=1,ke ; do j=js,je ; do i=is,ie call increment_ints(ints_sum, real_to_ints(array(i,j,k), prec_error), & - prec_error); + prec_error) enddo ; enddo ; enddo endif if (present(err)) then diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index 5f5d927016..a15f317a99 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -885,7 +885,7 @@ subroutine get_variable_line(CS, varname, found, defined, value_string, paramIsL ! return variables indicating whether this variable is defined and the string ! that contains the value of this variable. found = .false. - oval = 0; ival = 0; + oval = 0; ival = 0 max_vals = SIZE(value_string) do is=1,max_vals ; value_string(is) = " " ; enddo diff --git a/src/framework/MOM_hor_index.F90 b/src/framework/MOM_hor_index.F90 index 4326693957..5a626dd934 100644 --- a/src/framework/MOM_hor_index.F90 +++ b/src/framework/MOM_hor_index.F90 @@ -118,9 +118,9 @@ end subroutine HIT_assign !! The non-symmetric memory mode will then also work, albeit with a different (less efficient) communication pattern. !! !! Using the hor_index_type HI: -!! - declaration of h-point data is of the form `h(HI%%isd:HI%%ied,HI%%jsd:HI%%jed)`; -!! - declaration of q-point data is of the form `q(HI%%IsdB:HI%%IedB,HI%%JsdB:HI%%JedB)`; -!! - declaration of u-point data is of the form `u(HI%%IsdB:HI%%IedB,HI%%jsd:HI%%jed)`; +!! - declaration of h-point data is of the form `h(HI%%isd:HI%%ied,HI%%jsd:HI%%jed)` +!! - declaration of q-point data is of the form `q(HI%%IsdB:HI%%IedB,HI%%JsdB:HI%%JedB)` +!! - declaration of u-point data is of the form `u(HI%%IsdB:HI%%IedB,HI%%jsd:HI%%jed)` !! - declaration of v-point data is of the form `v(HI%%isd:HI%%ied,HI%%JsdB:HI%%JedB)`. !! !! For more detail explanation of horizontal indexing see \ref Horizontal_indexing. diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index e60a151ae7..079ac6ba3a 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -426,7 +426,7 @@ subroutine reopen_file(unit, filename, vars, novars, fields, threading, timeunit ! call mpp_get_field_atts(fields(i),name) ! !if (trim(name) /= trim(vars%name) then ! !write (mesg,'("Reopening file ",a," variable ",a," is called ",a,".")',& -! ! filename,vars%name,name); +! ! filename,vars%name,name) ! !call MOM_error(NOTE,"MOM_io: "//mesg) ! enddo endif diff --git a/src/framework/MOM_string_functions.F90 b/src/framework/MOM_string_functions.F90 index aa9b11bda6..f56834a8f6 100644 --- a/src/framework/MOM_string_functions.F90 +++ b/src/framework/MOM_string_functions.F90 @@ -224,7 +224,7 @@ end function extractWord extract_word = '' lastCharIsSeperator = .true. ns = len_trim(string) - i = 0; b=0; e=0; nw=0; + i = 0; b=0; e=0; nw=0 do while (i 0.0) c1 = 1.0 / CS%shelf_slope_scale - do j=G%jsd,G%jed ; + do j=G%jsd,G%jed if (((j+G%jdg_offset) <= G%domain%njglobal+G%domain%njhalo) .AND. & ((j+G%jdg_offset) >= G%domain%njhalo+1)) then diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index eab249921e..ba84d55763 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -477,7 +477,7 @@ subroutine set_grid_metrics_cartesian(G, param_file) call callTree_enter("set_grid_metrics_cartesian(), MOM_grid_initialize.F90") - PI = 4.0*atan(1.0) ; + PI = 4.0*atan(1.0) call get_param(param_file, mdl, "AXIS_UNITS", units_temp, & "The units for the Cartesian axes. Valid entries are: \n"//& diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index b26e13b61e..49153586b7 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1678,7 +1678,7 @@ subroutine initialize_temp_salt_linear(T, S, G, param_file, just_read_params) ! reference surface layer salinity and temperature and a specified range. ! Note that the linear distribution is set up with respect to the layer ! number, not the physical position). - integer :: k; + integer :: k real :: delta_S, delta_T real :: S_top, T_top ! Reference salinity and temerature within surface layer real :: S_range, T_range ! Range of salinities and temperatures over the vertical @@ -1705,10 +1705,10 @@ subroutine initialize_temp_salt_linear(T, S, G, param_file, just_read_params) if (just_read) return ! All run-time parameters have been read, so return. ! ! Prescribe salinity -! delta_S = S_range / ( G%ke - 1.0 ); -! S(:,:,1) = S_top; +! delta_S = S_range / ( G%ke - 1.0 ) +! S(:,:,1) = S_top ! do k = 2,G%ke -! S(:,:,k) = S(:,:,k-1) + delta_S; +! S(:,:,k) = S(:,:,k-1) + delta_S ! end do do k = 1,G%ke S(:,:,k) = S_top - S_range*((real(k)-0.5)/real(G%ke)) @@ -1716,13 +1716,13 @@ subroutine initialize_temp_salt_linear(T, S, G, param_file, just_read_params) end do ! ! Prescribe temperature -! delta_T = T_range / ( G%ke - 1.0 ); -! T(:,:,1) = T_top; +! delta_T = T_range / ( G%ke - 1.0 ) +! T(:,:,1) = T_top ! do k = 2,G%ke -! T(:,:,k) = T(:,:,k-1) + delta_T; +! T(:,:,k) = T(:,:,k-1) + delta_T ! end do -! delta = 1; -! T(:,:,G%ke/2 - (delta-1):G%ke/2 + delta) = 1.0; +! delta = 1 +! T(:,:,G%ke/2 - (delta-1):G%ke/2 + delta) = 1.0 call callTree_leave(trim(mdl)//'()') end subroutine initialize_temp_salt_linear diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index d8c30b345c..373062ffc3 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -79,11 +79,11 @@ function wright_eos_2d(T,S,p) result(rho) real(kind=8) :: al0,lam,p0,I_denom integer :: i,k - a0 = 7.057924e-4; a1 = 3.480336e-7; a2 = -1.112733e-7; - b0 = 5.790749e8; b1 = 3.516535e6; b2 = -4.002714e4; - b3 = 2.084372e2; b4 = 5.944068e5; b5 = -9.643486e3; - c0 = 1.704853e5; c1 = 7.904722e2; c2 = -7.984422; - c3 = 5.140652e-2; c4 = -2.302158e2; c5 = -3.079464; + a0 = 7.057924e-4; a1 = 3.480336e-7; a2 = -1.112733e-7 + b0 = 5.790749e8; b1 = 3.516535e6; b2 = -4.002714e4 + b3 = 2.084372e2; b4 = 5.944068e5; b5 = -9.643486e3 + c0 = 1.704853e5; c1 = 7.904722e2; c2 = -7.984422 + c3 = 5.140652e-2; c4 = -2.302158e2; c5 = -3.079464 do k=1,size(T,2) do i=1,size(T,1) @@ -120,11 +120,11 @@ function alpha_wright_eos_2d(T,S,p) result(drho_dT) real(kind=8) :: al0,lam,p0,I_denom,I_denom2 integer :: i,k -a0 = 7.057924e-4; a1 = 3.480336e-7; a2 = -1.112733e-7; -b0 = 5.790749e8; b1 = 3.516535e6; b2 = -4.002714e4; -b3 = 2.084372e2; b4 = 5.944068e5; b5 = -9.643486e3; -c0 = 1.704853e5; c1 = 7.904722e2; c2 = -7.984422; -c3 = 5.140652e-2; c4 = -2.302158e2; c5 = -3.079464; +a0 = 7.057924e-4; a1 = 3.480336e-7; a2 = -1.112733e-7 +b0 = 5.790749e8; b1 = 3.516535e6; b2 = -4.002714e4 +b3 = 2.084372e2; b4 = 5.944068e5; b5 = -9.643486e3 +c0 = 1.704853e5; c1 = 7.904722e2; c2 = -7.984422 +c3 = 5.140652e-2; c4 = -2.302158e2; c5 = -3.079464 do k=1,size(T,2) do i=1,size(T,1) @@ -167,11 +167,11 @@ function beta_wright_eos_2d(T,S,p) result(drho_dS) real(kind=8) :: al0,lam,p0,I_denom,I_denom2 integer :: i,k -a0 = 7.057924e-4; a1 = 3.480336e-7; a2 = -1.112733e-7; -b0 = 5.790749e8; b1 = 3.516535e6; b2 = -4.002714e4; -b3 = 2.084372e2; b4 = 5.944068e5; b5 = -9.643486e3; -c0 = 1.704853e5; c1 = 7.904722e2; c2 = -7.984422; -c3 = 5.140652e-2; c4 = -2.302158e2; c5 = -3.079464; +a0 = 7.057924e-4; a1 = 3.480336e-7; a2 = -1.112733e-7 +b0 = 5.790749e8; b1 = 3.516535e6; b2 = -4.002714e4 +b3 = 2.084372e2; b4 = 5.944068e5; b5 = -9.643486e3 +c0 = 1.704853e5; c1 = 7.904722e2; c2 = -7.984422 +c3 = 5.140652e-2; c4 = -2.302158e2; c5 = -3.079464 do k=1,size(T,2) do i=1,size(T,1) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 7fcb842bee..076dab7b56 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -654,7 +654,7 @@ subroutine sum_En(G, CS, En, label) call get_time(CS%Time, seconds) days = real(seconds) * Isecs_per_day - En_sum = 0.0; + En_sum = 0.0 tmpForSumming = 0.0 do a=1,CS%nAngle tmpForSumming = global_area_mean(En(:,:,a),G)*G%areaT_global @@ -664,7 +664,7 @@ subroutine sum_En(G, CS, En, label) if (CS%En_sum /= 0.0) then En_sum_pdiff= (En_sum_diff/CS%En_sum)*100.0 else - En_sum_pdiff= 0.0; + En_sum_pdiff= 0.0 endif CS%En_sum = En_sum !! Print to screen @@ -864,7 +864,7 @@ subroutine refract(En, cn, freq, dt, G, NAngle, use_PPMang) enddo !### There should also be refraction due to cn.grad(grid_orientation). - CFL_ang(:,:,:) = 0.0; + CFL_ang(:,:,:) = 0.0 do j=js,je ! Copy En into angle space with halos. do a=1,na ; do i=is,ie @@ -1096,10 +1096,10 @@ subroutine propagate(En, cn, freq, dt, G, CS, NAngle) if (CS%corner_adv) then ! IMPLEMENT CORNER ADVECTION IN HORIZONTAL-------------------- - ! FIND AVERAGE GROUP VELOCITY (SPEED) AT CELL CORNERS; + ! FIND AVERAGE GROUP VELOCITY (SPEED) AT CELL CORNERS ! NOTE: THIS HAS NOT BE ADAPTED FOR REFLECTION YET (BDM)!! ! Fix indexing here later - speed(:,:) = 0; + speed(:,:) = 0 do J=jsh-1,jeh ; do I=ish-1,ieh f2 = G%CoriolisBu(I,J)**2 speed(I,J) = 0.25*(cn(i,j) + cn(i+1,j) + cn(i+1,j+1) + cn(i,j+1)) * & @@ -1199,7 +1199,7 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS real :: TwoPi, Angle_size real :: energized_angle ! angle through center of current wedge real :: theta ! angle at edge of wedge - real :: Nsubrays ! number of sub-rays for averaging; + real :: Nsubrays ! number of sub-rays for averaging ! count includes the two rays that bound the current wedge, ! i.e. those at -dtheta/2 and +dtheta/2 from energized angle real :: I_Nsubwedges ! inverse of number of sub-wedges @@ -1323,7 +1323,7 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS aW = 0.0; aSW = 0.0; aS = 0.0; ! initialize areas aSE = 0.0; aE = 0.0; aC = 0.0; ! initialize areas if (0.0 <= theta .and. theta < 0.25*TwoPi) then - xCrn = x(I-1,J-1); yCrn = y(I-1,J-1); + xCrn = x(I-1,J-1); yCrn = y(I-1,J-1) ! west area a1 = (yN - yCrn)*(0.5*(xN + xCrn)) a2 = (yCrn - yW)*(0.5*(xCrn + xW)) @@ -1349,7 +1349,7 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS a4 = (yN - yNE)*(0.5*(xN + xNE)) aC = a1 + a2 + a3 + a4 elseif (0.25*TwoPi <= theta .and. theta < 0.5*TwoPi) then - xCrn = x(I,J-1); yCrn = y(I,J-1); + xCrn = x(I,J-1); yCrn = y(I,J-1) ! south area a1 = (yCrn - yS)*(0.5*(xCrn + xS)) a2 = (yS - ySW)*(0.5*(xS + xSW)) @@ -1375,7 +1375,7 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS a4 = (yNW - yN)*(0.5*(xNW + xN)) aC = a1 + a2 + a3 + a4 elseif (0.5*TwoPi <= theta .and. theta < 0.75*TwoPi) then - xCrn = x(I,J); yCrn = y(I,J); + xCrn = x(I,J); yCrn = y(I,J) ! east area a1 = (yE - ySE)*(0.5*(xE + xSE)) a2 = (ySE - yS)*(0.5*(xSE + xS)) @@ -1401,7 +1401,7 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS a4 = (yW - yCrn)*(0.5*(xW + xCrn)) aC = a1 + a2 + a3 + a4 elseif (0.75*TwoPi <= theta .and. theta <= 1.00*TwoPi) then - xCrn = x(I-1,J); yCrn = y(I-1,J); + xCrn = x(I-1,J); yCrn = y(I-1,J) ! north area a1 = (yNE - yE)*(0.5*(xNE + xE)) a2 = (yE - yCrn)*(0.5*(xE + xCrn)) @@ -1413,7 +1413,7 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS a2 = (yCrn - yW)*(0.5*(xCrn + xW)) a3 = (yW - yNW)*(0.5*(xW + xNW)) a4 = (yNW - yN)*(0.5*(xNW + xN)) - aNW = a1 + a2 + a3 + a4; + aNW = a1 + a2 + a3 + a4 ! west area a1 = (yCrn - yS)*(0.5*(xCrn + xS)) a2 = (yS - ySW)*(0.5*(xS + xSW)) @@ -1768,7 +1768,7 @@ subroutine reflect(En, NAngle, CS, G, LB) isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh - TwoPi = 8.0*atan(1.0); + TwoPi = 8.0*atan(1.0) Angle_size = TwoPi / (real(NAngle)) do a=1,NAngle @@ -2498,7 +2498,7 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS) do j=G%jsc,G%jec ; do i=G%isc,G%iec ! Restrict rms topo to 10 percent of column depth. h2(i,j) = min(0.01*G%bathyT(i,j)**2, h2(i,j)) - ! Compute the fixed part; units are [kg m-2] here; + ! Compute the fixed part; units are [kg m-2] here ! will be multiplied by N and En to get into [W m-2] CS%TKE_itidal_loss_fixed(i,j) = 0.5*kappa_h2_factor*GV%Rho0*& kappa_itides * h2(i,j) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 532362f082..ecc586d025 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -22,7 +22,7 @@ module MOM_lateral_mixing_coeffs #include !> Variable mixing coefficients -type, public :: VarMix_CS ; +type, public :: VarMix_CS logical :: use_variable_mixing !< If true, use the variable mixing. logical :: Resoln_scaled_Kh !< If true, scale away the Laplacian viscosity !! when the deformation radius is well resolved. @@ -685,7 +685,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) enddo ! k !$OMP do - do j = js,je; + do j = js,je do k=nz,CS%VarMix_Ktop,-1 ; do I=is-1,ie CS%SN_u(I,j) = CS%SN_u(I,j) + SN_u_local(I,j,k) enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 07fad7c421..4ef29b9e9d 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -338,7 +338,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS ! depth will place a spurious depth dependence to the diagnosed KH_t. if (CS%id_KH_t > 0 .or. CS%id_KH_t1 > 0) then do k=1,nz - ! thicknesses across u and v faces, converted to 0/1 mask; + ! thicknesses across u and v faces, converted to 0/1 mask ! layer average of the interface diffusivities KH_u and KH_v do j=js,je ; do I=is-1,ie hu(I,j) = 2.0*h(i,j,k)*h(i+1,j,k)/(h(i,j,k)+h(i+1,j,k)+h_neglect) diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 4b422ccf9a..2be8beee4a 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -172,7 +172,7 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, CS, hbl) rho_lwr(:) = 0.0; rho_1d(:) = 0.0 if (.not. associated(hbl)) then - allocate(hbl(SZI_(G), SZJ_(G))); + allocate(hbl(SZI_(G), SZJ_(G))) hbl(:,:) = 0.0 endif diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 08ed2fb130..c0289bbd79 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -86,7 +86,7 @@ module MOM_KPP character(len=30) :: MatchTechnique !< Method used in CVMix for setting diffusivity and NLT profile functions integer :: NLT_shape !< MOM6 over-ride of CVMix NLT shape function logical :: applyNonLocalTrans !< If True, apply non-local transport to heat and scalars - logical :: KPPzeroDiffusivity !< If True, will set diffusivity and viscosity from KPP to zero; + logical :: KPPzeroDiffusivity !< If True, will set diffusivity and viscosity from KPP to zero !! for testing purposes. logical :: KPPisAdditive !< If True, will add KPP diffusivity to initial diffusivity. !! If False, will replace initial diffusivity wherever KPP diffusivity @@ -486,7 +486,7 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive, Waves) CS%id_EnhVt2 = register_diag_field('ocean_model', 'EnhVt2', diag%axesTL, Time, & 'Langmuir number enhancement to Vt2 as used by [CVMix] KPP','nondim') - allocate( CS%OBLdepthprev( SZI_(G), SZJ_(G) ) );CS%OBLdepthprev(:,:)=0.0; + allocate( CS%OBLdepthprev( SZI_(G), SZJ_(G) ) );CS%OBLdepthprev(:,:)=0.0 if (CS%id_OBLdepth > 0) allocate( CS%OBLdepth( SZI_(G), SZJ_(G) ) ) if (CS%id_OBLdepth > 0) CS%OBLdepth(:,:) = 0. if (CS%id_BulkDrho > 0) allocate( CS%dRho( SZI_(G), SZJ_(G), SZK_(G) ) ) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index d80d5d04fc..201588a2c2 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -2977,7 +2977,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, h_det_to_h1 = h_to_bl - h_det_to_h2 h_ml_to_h1 = MAX(h_min_bl-h_det_to_h1,0.0) - Ih = 1.0/h_min_bl; + Ih = 1.0/h_min_bl Ihdet = 0.0 ; if (h_to_bl > 0.0) Ihdet = 1.0 / h_to_bl Ih1f = 1.0 / (h_det_to_h1 + h_ml_to_h1) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index f28fe31a9b..0db5fbd5b3 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -258,7 +258,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity (m/s) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity (m/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness (m for Bouss / kg/m2 for non-Bouss) - type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields; + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs real, dimension(:,:), pointer :: Hml !< active mixed layer depth type(forcing), intent(inout) :: fluxes !< points to forcing fields @@ -387,7 +387,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (showCallTree) call callTree_enter("diabatic(), MOM_diabatic_driver.F90") - ! Offer diagnostics of various state varables at the start of diabatic; + ! Offer diagnostics of various state varables at the start of diabatic ! these are mostly for debugging purposes. if (CS%id_u_predia > 0) call post_data(CS%id_u_predia, u, CS%diag) if (CS%id_v_predia > 0) call post_data(CS%id_v_predia, v, CS%diag) @@ -2189,7 +2189,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, endif - ! diagnostics for tendencies of temp and saln due to diabatic processes; + ! diagnostics for tendencies of temp and saln due to diabatic processes ! available only for ALE algorithm. ! diagnostics for tendencies of temp and heat due to frazil CS%id_diabatic_diff_h = register_diag_field('ocean_model', 'diabatic_diff_h', diag%axesTL, Time, & @@ -2261,7 +2261,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, CS%diabatic_diff_tendency_diag = .true. endif - ! diagnostics for tendencies of thickness temp and saln due to boundary forcing; + ! diagnostics for tendencies of thickness temp and saln due to boundary forcing ! available only for ALE algorithm. ! diagnostics for tendencies of temp and heat due to frazil CS%id_boundary_forcing_h = register_diag_field('ocean_model', 'boundary_forcing_h', diag%axesTL, Time, & diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 78b4a81662..89a11217fa 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -1252,7 +1252,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & ! There is not enough energy to support the mixing, so reduce the ! diffusivity to what can be supported. Kddt_h_max = Kddt_h_g0 ; Kddt_h_min = 0.0 - TKE_left_max = tot_TKE + (MKE_src - N2_DISSIPATION*PE_chg_g0) ; + TKE_left_max = tot_TKE + (MKE_src - N2_DISSIPATION*PE_chg_g0) TKE_left_min = tot_TKE ! As a starting guess, take the minimum of a false position estimate @@ -1925,7 +1925,7 @@ subroutine ust_2_u10_coare3p5(USTair,U10,GV) z0sm = 0.11 * nu / USTair; !Compute z0smooth from ustar guess u10 = USTair/sqrt(0.001); !Guess for u10 - u10a = 1000; + u10a = 1000 CT=0 do while (abs(u10a/u10-1.)>0.001) diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index c225edac13..c9f10826db 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -2089,7 +2089,7 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & new_min_bound = .false. ! We have a new maximum bound. else ! This case would bracket a minimum. Wierd. ! Unless the derivative indicates that there is a maximum near the - ! lower bound, try keeping the end with the larger value of F; + ! lower bound, try keeping the end with the larger value of F ! in a tie keep the minimum as the answer here will be compared ! with the maximum input value later. new_min_bound = .true. diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index bfad193803..7cb7dc5dc7 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -57,7 +57,7 @@ module MOM_geothermal ! W m-2. real :: geothermal_thick ! The thickness over which geothermal heating is ! applied, in m. - logical :: apply_geothermal ! If true, geothermal heating will be applied; + logical :: apply_geothermal ! If true, geothermal heating will be applied ! otherwise GEOTHERMAL_SCALE has been set to 0 and ! there is no heat to apply. diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 4a14bc41ba..2952d9ac9b 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -162,10 +162,10 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) enddo ; enddo ; enddo else !$OMP parallel do default(shared) - do j=js,je ; do i=is,ie ; + do j=js,je ; do i=is,ie optics%sw_pen_band(1,i,j) = (CS%SW_1st_EXP_RATIO) * fluxes%sw(i,j) optics%sw_pen_band(2,i,j) = (1.-CS%SW_1st_EXP_RATIO) * fluxes%sw(i,j) - enddo ; enddo ; + enddo ; enddo endif else do k=1,nz ; do j=js,je ; do i=is,ie ; do n=1,optics%nbands diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 1e3a82dee4..a06c25b8f3 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -109,7 +109,7 @@ subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, CS) !! layer detrainment, in the same units as !! h - usually m or kg m-2 (i.e., H). real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: eb !< The amount of fluid moved upward into a layer; + intent(inout) :: eb !< The amount of fluid moved upward into a layer !! this should be increased due to mixed layer !! entrainment, in the same units as h - usually !! m or kg m-2 (i.e., H). @@ -168,7 +168,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) !! layer detrainment, in the same units as h - !! usually m or kg m-2 (i.e., H). real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: eb !< The amount of fluid moved upward into a layer; + intent(inout) :: eb !< The amount of fluid moved upward into a layer !! this should be increased due to mixed layer !! entrainment, in the same units as h - usually !! m or kg m-2 (i.e., H). diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 6b1c219508..cc772bdb53 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -222,7 +222,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & type(diffusivity_diags) :: dd ! structure w/ arrays of pointers to avail diags real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - T_f, S_f ! temperature and salinity (deg C and ppt); + T_f, S_f ! temperature and salinity (deg C and ppt) ! massless layers filled vertically by diffusion. real, dimension(SZI_(G),SZK_(G)) :: & @@ -1851,7 +1851,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp ! These default values always need to be set. CS%BBL_mixing_as_max = .true. - CS%Kdml = 0.0 ; CS%cdrag = 0.003 ; CS%BBL_effic = 0.0 ; + CS%Kdml = 0.0 ; CS%cdrag = 0.003 ; CS%BBL_effic = 0.0 CS%bulkmixedlayer = (GV%nkml > 0) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 5148be3379..e50d5db614 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1791,8 +1791,8 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) call get_param(param_file, mdl, "ADIABATIC", adiabatic, default=.false., & do_not_log=.true.) - use_kappa_shear = .false. ; use_CVMix_shear = .false. ; - useKPP = .false. ; useEPBL = .false. ; use_CVMix_conv = .false. ; + use_kappa_shear = .false. ; use_CVMix_shear = .false. + useKPP = .false. ; useEPBL = .false. ; use_CVMix_conv = .false. if (.not.adiabatic) then use_kappa_shear = kappa_shear_is_used(param_file) use_CVMix_shear = CVMix_shear_is_used(param_file) diff --git a/src/parameterizations/vertical/MOM_shortwave_abs.F90 b/src/parameterizations/vertical/MOM_shortwave_abs.F90 index 1e22ba5bf9..f0695785f8 100644 --- a/src/parameterizations/vertical/MOM_shortwave_abs.F90 +++ b/src/parameterizations/vertical/MOM_shortwave_abs.F90 @@ -365,7 +365,7 @@ subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & ! Arguments: ! (in) G = ocean grid structure ! (in) GV = The ocean's vertical grid structure. -! (in) h = layer thickness (units of m or kg/m^2); +! (in) h = layer thickness (units of m or kg/m^2) ! units of h are referred to as H below. ! (in) opacity_band = opacity in each band of penetrating shortwave ! radiation, in m-1. The indicies are band, i, k. diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index b786f9c919..2fc99c48fc 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -1039,7 +1039,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, dd%Kd_lowmode_work(i,j,k) = GV%Rho0 * TKE_lowmode_lay if (associated(dd%Fl_lowmode)) dd%Fl_lowmode(i,j,k) = TKE_lowmode_rem(i) - enddo ; enddo ; + enddo ; enddo endif ! Simmons ! Polzin: @@ -1125,7 +1125,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, dd%Kd_lowmode_work(i,j,k) = GV%Rho0 * TKE_lowmode_lay if (associated(dd%Fl_lowmode)) dd%Fl_lowmode(i,j,k) = TKE_lowmode_rem(i) - enddo ; enddo; + enddo ; enddo endif ! Polzin end subroutine add_int_tide_diffusivity diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 62d2c98de6..38f3f4ee57 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -318,7 +318,7 @@ subroutine DOME_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, do m=1,NTR do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) - enddo ; enddo ; enddo; + enddo ; enddo ; enddo call applyTracerBoundaryFluxesInOut(G, GV, CS%tr(:,:,:,m) , dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) call tracer_vertdiff(h_work, ea, eb, dt, CS%tr(:,:,:,m), G, GV) diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index d0163f2804..f3fa46210f 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -324,7 +324,7 @@ subroutine ISOMIP_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, G do m=1,NTR do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) - enddo ; enddo ; enddo; + enddo ; enddo ; enddo call applyTracerBoundaryFluxesInOut(G, GV, CS%tr(:,:,:,m) , dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) call tracer_vertdiff(h_work, ea, eb, dt, CS%tr(:,:,:,m), G, GV) diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index 454521184e..fcb55382c4 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -542,14 +542,14 @@ subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) - enddo ; enddo ; enddo; + enddo ; enddo ; enddo call applyTracerBoundaryFluxesInOut(G, GV, CFC11, dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) call tracer_vertdiff(h_work, ea, eb, dt, CFC11, G, GV, sfc_flux=CFC11_flux) do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) - enddo ; enddo ; enddo; + enddo ; enddo ; enddo call applyTracerBoundaryFluxesInOut(G, GV, CFC12, dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) call tracer_vertdiff(h_work, ea, eb, dt, CFC12, G, GV, sfc_flux=CFC12_flux) diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 6ec168b499..bb4e744b01 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -546,7 +546,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, if (g_tracer_is_prog(g_tracer)) then do k=1,nk ;do j=jsc,jec ; do i=isc,iec h_work(i,j,k) = h_old(i,j,k) - enddo ; enddo ; enddo; + enddo ; enddo ; enddo call applyTracerBoundaryFluxesInOut(G, GV, g_tracer%field(:,:,:,1), dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) endif diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index f5ce1f10e6..b3232c1bca 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -483,7 +483,7 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, CS) if (G%mask2dT(i,j)>0.) then dTracer(:) = 0. - do ks = 1,CS%nsurf-1 ; + do ks = 1,CS%nsurf-1 k = CS%uKoL(I,j,ks) dTracer(k) = dTracer(k) + Coef_x(I,j) * uFlx(I,j,ks) k = CS%uKoR(I-1,j,ks) @@ -513,7 +513,7 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, CS) do j = G%jsc,G%jec ; do I = G%isc-1,G%iec trans_x_2d(I,j) = 0. if (G%mask2dCu(I,j)>0.) then - do ks = 1,CS%nsurf-1 ; + do ks = 1,CS%nsurf-1 trans_x_2d(I,j) = trans_x_2d(I,j) - Coef_x(I,j) * uFlx(I,j,ks) enddo trans_x_2d(I,j) = trans_x_2d(I,j) * Idt @@ -528,7 +528,7 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, CS) do J = G%jsc-1,G%jec ; do i = G%isc,G%iec trans_y_2d(i,J) = 0. if (G%mask2dCv(i,J)>0.) then - do ks = 1,CS%nsurf-1 ; + do ks = 1,CS%nsurf-1 trans_y_2d(i,J) = trans_y_2d(i,J) - Coef_y(i,J) * vFlx(i,J,ks) enddo trans_y_2d(i,J) = trans_y_2d(i,J) * Idt @@ -1850,7 +1850,7 @@ logical function ndiff_unit_tests_discontinuous(verbose) (/0.0, 0.0, 0.5, 0.5, 1.0, 0.0, 0.5, 0.5, 1.0, 0.0, 0.5, 1.0/), & ! pR (/0.0, 5.0, 0.0, 5.0, 0.0, 5.0, 0.0, 5.0, 0.0, 5.0, 0.0/), & ! hEff 'Right column slightly cooler') - Tl = (/18.,14.,10./) ; Tr = (/20.,16.,12./) ; + Tl = (/18.,14.,10./) ; Tr = (/20.,16.,12./) call build_reconstructions_1d( remap_CS, nk, hL, Tl, poly_T_l, TiL, poly_slope, iMethod, h_neglect, h_neglect_edge ) call build_reconstructions_1d( remap_CS, nk, hR, Tr, poly_T_r, TiR, poly_slope, iMethod, h_neglect, h_neglect_edge ) call mark_unstable_cells( nk, dRdT, dRdS, Til, Sil, stable_l, ns_l ) diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index a05d9c1023..4c63ea2b33 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -252,7 +252,7 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) else h2d(i,k) = GV%H_subroundoff endif - enddo; enddo; + enddo; enddo ! Distribute flux. Note min/max is intended to make sure that the mass transport ! does not deplete a cell @@ -320,7 +320,7 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) else h2d(j,k) = GV%H_subroundoff endif - enddo; enddo; + enddo; enddo ! Distribute flux evenly throughout a column do j=js-1,je @@ -631,7 +631,7 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ integer :: i, j, k, is, ie, js, je, nz real :: Initer_vert - do_ale = .false.; + do_ale = .false. if (present(do_ale_in) ) do_ale = do_ale_in is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 54c47792b6..8da247186e 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -1032,7 +1032,7 @@ subroutine update_offline_fields(CS, h, fluxes, do_ale) if (CS%Kd_max>0.) then CS%Kd(i,j,k) = MIN(CS%Kd_max, CS%Kd(i,j,k)) endif - enddo ; enddo ; enddo ; + enddo ; enddo ; enddo do k=1,nz ; do J=js-1,je ; do i=is,ie if (CS%G%mask2dCv(i,J)<1.0) then diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index 9a86d25c9c..df244cd8a4 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -319,7 +319,7 @@ subroutine read_Z_edges(filename, tr_name, z_edges, nz_out, has_edges, & mdl = "MOM_tracer_Z_init read_Z_edges: " tr_msg = trim(tr_name)//" in "//trim(filename) - status = NF90_OPEN(filename, NF90_NOWRITE, ncid); + status = NF90_OPEN(filename, NF90_NOWRITE, ncid) if (status /= NF90_NOERR) then call MOM_error(WARNING,mdl//" Difficulties opening "//trim(filename)//& " - "//trim(NF90_STRERROR(status))) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 1389365139..5c0bb7fd42 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -162,7 +162,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & enddo ; enddo else do i=is,ie ; do j=js,je - hprev(i,j,k) = h_prev_opt(i,j,k); + hprev(i,j,k) = h_prev_opt(i,j,k) enddo ; enddo endif enddo diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index daa2062c81..2d95e8bc58 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -186,7 +186,7 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit integer, optional, intent(in) :: diag_form !< An integer (1 or 2, 1 by default) indicating the !! character string template to use in !! labeling diagnostics - type(MOM_restart_CS), optional, pointer :: restart_CS !< A pointer to the restart control structure; + type(MOM_restart_CS), optional, pointer :: restart_CS !< A pointer to the restart control structure !! this tracer will be registered for !! restarts if this argument is present logical, optional, intent(in) :: mandatory !< If true, this tracer must be read diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 39e6e668e3..7fb6ff8028 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -349,7 +349,7 @@ subroutine advection_test_tracer_column_physics(h_old, h_new, ea, eb, fluxes, do m=1,CS%ntr do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) - enddo ; enddo ; enddo; + enddo ; enddo ; enddo call applyTracerBoundaryFluxesInOut(G, GV, CS%tr(:,:,:,m) , dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) call tracer_vertdiff(h_work, ea, eb, dt, CS%tr(:,:,:,m), G, GV) diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index b98d39e4d8..f320bb5716 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -284,7 +284,7 @@ subroutine boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) - enddo ; enddo ; enddo; + enddo ; enddo ; enddo call applyTracerBoundaryFluxesInOut(G, GV, CS%tr(:,:,:,1), dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) call tracer_vertdiff(h_work, ea, eb, dt, CS%tr(:,:,:,1), G, GV) diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index dcd2b6fecb..d2cc4dafbb 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -283,7 +283,7 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS do m=1,CS%ntr do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) - enddo ; enddo ; enddo; + enddo ; enddo ; enddo call applyTracerBoundaryFluxesInOut(G, GV, CS%tr(:,:,:,m) , dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) call tracer_vertdiff(h_work, ea, eb, dt, CS%tr(:,:,:,m), G, GV) diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index 149b207791..e65dcdfcf4 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -243,7 +243,7 @@ subroutine dyed_obc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, do m=1,CS%ntr do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) - enddo ; enddo ; enddo; + enddo ; enddo ; enddo call applyTracerBoundaryFluxesInOut(G, GV, CS%tr(:,:,:,m) , dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) if (nz > 1) call tracer_vertdiff(h_work, ea, eb, dt, CS%tr(:,:,:,m), G, GV) diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index 4f08dd7db1..0a0ad34b3f 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -378,7 +378,7 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, do m=1,CS%ntr do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) - enddo ; enddo ; enddo; + enddo ; enddo ; enddo call applyTracerBoundaryFluxesInOut(G, GV, CS%tr(:,:,:,m) , dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) call tracer_vertdiff(h_work, ea, eb, dt, CS%tr(:,:,:,m), G, GV) diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index e7071f9431..b3f595f175 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -397,7 +397,7 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS do m=1,CS%ntr do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) - enddo ; enddo ; enddo; + enddo ; enddo ; enddo call applyTracerBoundaryFluxesInOut(G, GV, CS%tr(:,:,:,m) , dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) call tracer_vertdiff(h_work, ea, eb, dt, CS%tr(:,:,:,m), G, GV) diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index 65cd122234..06d490c835 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -278,7 +278,7 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) - enddo ; enddo ; enddo; + enddo ; enddo ; enddo call applyTracerBoundaryFluxesInOut(G, GV, CS%ps, dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth, out_flux_optional=net_salt) call tracer_vertdiff(h_work, ea, eb, dt, CS%ps, G, GV) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index c183b5b7a3..a41e3b55a2 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -782,7 +782,7 @@ subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) endif do b=1,NumBands - temp_x(:,:)=0.0;temp_y(:,:)=0.0; + temp_x(:,:)=0.0;temp_y(:,:)=0.0 varname = ' ' write(varname,"(A3,I0)")'Usx',b call data_override('OCN',trim(varname), temp_x, day_center) @@ -1252,7 +1252,7 @@ subroutine ust_2_u10_coare3p5(USTair,U10,GV) z0sm = 0.11 * nu / USTair; !Compute z0smooth from ustar guess u10 = USTair/sqrt(0.001); !Guess for u10 - u10a = 1000; + u10a = 1000 CT=0 do while (abs(u10a/u10-1.)>0.001) diff --git a/src/user/SCM_CVmix_tests.F90 b/src/user/SCM_CVmix_tests.F90 index 4a6802dc23..e7940f88eb 100644 --- a/src/user/SCM_CVmix_tests.F90 +++ b/src/user/SCM_CVmix_tests.F90 @@ -25,7 +25,7 @@ module SCM_CVMix_tests public SCM_CVMix_tests_CS !> Container for surface forcing parameters -type SCM_CVMix_tests_CS ; +type SCM_CVMix_tests_CS private logical :: UseWindStress !< True to use wind stress logical :: UseHeatFlux !< True to use heat flux diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index 7a1d3dc86b..8d0506eede 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -52,7 +52,7 @@ subroutine benchmark_initialize_topography(D, G, param_file, max_depth) "The minimum depth of the ocean.", units="m", default=0.0) PI = 4.0*atan(1.0) - D0 = max_depth / 0.5; + D0 = max_depth / 0.5 ! Calculate the depth of the bottom. do i=is,ie ; do j=js,je diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index 06b1df3218..a33718b243 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -116,7 +116,7 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param x = -z_unif(k) if ( x <= x1 ) then - t = y1*x/x1; + t = y1*x/x1 else if ( (x > x1 ) .and. ( x < x2 )) then t = y1 + (y2-y1) * (x-x1) / (x2-x1) else @@ -136,7 +136,7 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param weight_z = - 4.0 * ( z_unif(k) + 0.5 )**2 + 1 x = G%geoLonT(i,j) / G%len_lon - displ(k) = a0 * cos(acos(-1.0)*x) + weight_z; + displ(k) = a0 * cos(acos(-1.0)*x) + weight_z if ( k == 1 ) then displ(k) = 0.0 @@ -236,7 +236,7 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file ! S(:,:,k) = S(:,:,k-1) + delta_S !end do - deltah = G%max_depth / nz; + deltah = G%max_depth / nz do j=js,je ; do i=is,ie xi0 = 0.0 do k = 1,nz diff --git a/src/user/tidal_bay_initialization.F90 b/src/user/tidal_bay_initialization.F90 index bf3cd44e57..9e16775a3c 100644 --- a/src/user/tidal_bay_initialization.F90 +++ b/src/user/tidal_bay_initialization.F90 @@ -81,7 +81,7 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, h, Time) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - PI = 4.0*atan(1.0) ; + PI = 4.0*atan(1.0) if (.not.associated(OBC)) return From 4e9317f21e7a142a9d0fc390bfb13cf640dd5e53 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 7 May 2018 09:08:08 -0400 Subject: [PATCH 0198/1072] dOxyGenized MOM_debugging.F90 Added dOxyGen comments for all routines and arguments in MOM_debugging.F90. All answers are bitwise identical. --- src/diagnostics/MOM_debugging.F90 | 84 +++++++++++++++---------------- 1 file changed, 42 insertions(+), 42 deletions(-) diff --git a/src/diagnostics/MOM_debugging.F90 b/src/diagnostics/MOM_debugging.F90 index 4301368de9..2e9c80470a 100644 --- a/src/diagnostics/MOM_debugging.F90 +++ b/src/diagnostics/MOM_debugging.F90 @@ -96,12 +96,12 @@ end subroutine MOM_debugging_init subroutine check_redundant_vC3d(mesg, u_comp, v_comp, G, is, ie, js, je, & direction) - character(len=*), intent(in) :: mesg + character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%jsd:,:), intent(in) :: u_comp - real, dimension(G%isd:,G%JsdB:,:), intent(in) :: v_comp - integer, optional, intent(in) :: is, ie, js, je - integer, optional, intent(in) :: direction + real, dimension(G%IsdB:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector to be checked for consistency + real, dimension(G%isd:,G%JsdB:,:), intent(in) :: v_comp !< The u-component of the vector to be checked for consistency + integer, optional, intent(in) :: is, ie, js, je !< The range of indices to check for consistency + integer, optional, intent(in) :: direction !< the direction flag to be passed to pass_vector ! Arguments: u_comp - The u-component of the vector being checked. ! (in) v_comp - The v-component of the vector being checked. ! (in) mesg - A message indicating what is being checked. @@ -125,12 +125,12 @@ end subroutine check_redundant_vC3d subroutine check_redundant_vC2d(mesg, u_comp, v_comp, G, is, ie, js, je, & direction) - character(len=*), intent(in) :: mesg + character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%jsd:), intent(in) :: u_comp - real, dimension(G%isd:,G%JsdB:), intent(in) :: v_comp - integer, optional, intent(in) :: is, ie, js, je - integer, optional, intent(in) :: direction + real, dimension(G%IsdB:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector to be checked for consistency + real, dimension(G%isd:,G%JsdB:), intent(in) :: v_comp !< The u-component of the vector to be checked for consistency + integer, optional, intent(in) :: is, ie, js, je !< The range of indices to check for consistency + integer, optional, intent(in) :: direction !< the direction flag to be passed to pass_vector ! Arguments: u_comp - The u-component of the vector being checked. ! (in) v_comp - The v-component of the vector being checked. ! (in) mesg - A message indicating what is being checked. @@ -199,10 +199,10 @@ subroutine check_redundant_vC2d(mesg, u_comp, v_comp, G, is, ie, js, je, & end subroutine check_redundant_vC2d subroutine check_redundant_sB3d(mesg, array, G, is, ie, js, je) - character(len=*), intent(in) :: mesg + character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: array - integer, optional, intent(in) :: is, ie, js, je + real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: array !< The array to be checked for consistency + integer, optional, intent(in) :: is, ie, js, je !< The range of indices to check for consistency ! Arguments: array - The array being checked. ! (in) mesg - A message indicating what is being checked. ! (in) G - The ocean's grid structure. @@ -224,10 +224,10 @@ end subroutine check_redundant_sB3d subroutine check_redundant_sB2d(mesg, array, G, is, ie, js, je) - character(len=*), intent(in) :: mesg + character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%JsdB:), intent(in) :: array - integer, optional, intent(in) :: is, ie, js, je + real, dimension(G%IsdB:,G%JsdB:), intent(in) :: array !< The array to be checked for consistency + integer, optional, intent(in) :: is, ie, js, je !< The range of indices to check for consistency ! Arguments: array - The array being checked. ! (in) mesg - A message indicating what is being checked. ! (in) G - The ocean's grid structure. @@ -284,12 +284,12 @@ end subroutine check_redundant_sB2d subroutine check_redundant_vB3d(mesg, u_comp, v_comp, G, is, ie, js, je, & direction) - character(len=*), intent(in) :: mesg + character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: u_comp - real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: v_comp - integer, optional, intent(in) :: is, ie, js, je - integer, optional, intent(in) :: direction + real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: u_comp !< The u-component of the vector to be checked for consistency + real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: v_comp !< The u-component of the vector to be checked for consistency + integer, optional, intent(in) :: is, ie, js, je !< The range of indices to check for consistency + integer, optional, intent(in) :: direction !< the direction flag to be passed to pass_vector ! Arguments: u_comp - The u-component of the vector being checked. ! (in) v_comp - The v-component of the vector being checked. ! (in) mesg - A message indicating what is being checked. @@ -313,12 +313,12 @@ end subroutine check_redundant_vB3d subroutine check_redundant_vB2d(mesg, u_comp, v_comp, G, is, ie, js, je, & direction) - character(len=*), intent(in) :: mesg + character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%JsdB:), intent(in) :: u_comp - real, dimension(G%IsdB:,G%JsdB:), intent(in) :: v_comp - integer, optional, intent(in) :: is, ie, js, je - integer, optional, intent(in) :: direction + real, dimension(G%IsdB:,G%JsdB:), intent(in) :: u_comp !< The u-component of the vector to be checked for consistency + real, dimension(G%IsdB:,G%JsdB:), intent(in) :: v_comp !< The u-component of the vector to be checked for consistency + integer, optional, intent(in) :: is, ie, js, je !< The range of indices to check for consistency + integer, optional, intent(in) :: direction !< the direction flag to be passed to pass_vector ! Arguments: u_comp - The u-component of the vector being checked. ! (in) v_comp - The v-component of the vector being checked. ! (in) mesg - A message indicating what is being checked. @@ -388,10 +388,10 @@ subroutine check_redundant_vB2d(mesg, u_comp, v_comp, G, is, ie, js, je, & end subroutine check_redundant_vB2d subroutine check_redundant_sT3d(mesg, array, G, is, ie, js, je) - character(len=*), intent(in) :: mesg + character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%isd:,G%jsd:,:), intent(in) :: array - integer, optional, intent(in) :: is, ie, js, je + real, dimension(G%isd:,G%jsd:,:), intent(in) :: array !< The array to be checked for consistency + integer, optional, intent(in) :: is, ie, js, je !< The range of indices to check for consistency ! Arguments: array - The array being checked. ! (in) mesg - A message indicating what is being checked. ! (in) G - The ocean's grid structure. @@ -413,10 +413,10 @@ end subroutine check_redundant_sT3d subroutine check_redundant_sT2d(mesg, array, G, is, ie, js, je) - character(len=*), intent(in) :: mesg + character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%isd:,G%jsd:), intent(in) :: array - integer, optional, intent(in) :: is, ie, js, je + real, dimension(G%isd:,G%jsd:), intent(in) :: array !< The array to be checked for consistency + integer, optional, intent(in) :: is, ie, js, je !< The range of indices to check for consistency ! Arguments: array - The array being checked. ! (in) mesg - A message indicating what is being checked. ! (in) G - The ocean's grid structure. @@ -459,12 +459,12 @@ end subroutine check_redundant_sT2d subroutine check_redundant_vT3d(mesg, u_comp, v_comp, G, is, ie, js, je, & direction) - character(len=*), intent(in) :: mesg + character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%isd:,G%jsd:,:), intent(in) :: u_comp - real, dimension(G%isd:,G%jsd:,:), intent(in) :: v_comp - integer, optional, intent(in) :: is, ie, js, je - integer, optional, intent(in) :: direction + real, dimension(G%isd:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector to be checked for consistency + real, dimension(G%isd:,G%jsd:,:), intent(in) :: v_comp !< The u-component of the vector to be checked for consistency + integer, optional, intent(in) :: is, ie, js, je !< The range of indices to check for consistency + integer, optional, intent(in) :: direction !< the direction flag to be passed to pass_vector ! Arguments: u_comp - The u-component of the vector being checked. ! (in) v_comp - The v-component of the vector being checked. ! (in) mesg - A message indicating what is being checked. @@ -488,12 +488,12 @@ end subroutine check_redundant_vT3d subroutine check_redundant_vT2d(mesg, u_comp, v_comp, G, is, ie, js, je, & direction) - character(len=*), intent(in) :: mesg + character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%isd:,G%jsd:), intent(in) :: u_comp - real, dimension(G%isd:,G%jsd:), intent(in) :: v_comp - integer, optional, intent(in) :: is, ie, js, je - integer, optional, intent(in) :: direction + real, dimension(G%isd:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector to be checked for consistency + real, dimension(G%isd:,G%jsd:), intent(in) :: v_comp !< The u-component of the vector to be checked for consistency + integer, optional, intent(in) :: is, ie, js, je !< The range of indices to check for consistency + integer, optional, intent(in) :: direction !< the direction flag to be passed to pass_vector ! Arguments: u_comp - The u-component of the vector being checked. ! (in) v_comp - The v-component of the vector being checked. ! (in) mesg - A message indicating what is being checked. From bef564f13791e4ad3dd09f88fade65236d1bee60 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 7 May 2018 09:08:35 -0400 Subject: [PATCH 0199/1072] dOxyGenized MOM_checksums.F90 Added dOxyGen comments for all routines and arguments in MOM_checksums.F90. All answers are bitwise identical. --- src/framework/MOM_checksums.F90 | 201 +++++++++++++++++--------------- 1 file changed, 109 insertions(+), 92 deletions(-) diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index 01678dce41..fd880f6656 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -189,10 +189,10 @@ subroutine chksum_h_2d(array, mesg, HI, haloshift, omit_corners, scale) contains integer function subchk(array, HI, di, dj, scale) - type(hor_index_type), intent(in) :: HI - real, dimension(HI%isd:,HI%jsd:), intent(in) :: array - integer, intent(in) :: di, dj - real, intent(in) :: scale + type(hor_index_type), intent(in) :: HI !< A horizontal index type + real, dimension(HI%isd:,HI%jsd:), intent(in) :: array !< The array to be checksummed + integer, intent(in) :: di, dj !< i- and j- direction array shifts for this checksum + real, intent(in) :: scale !< A scaling factor for this array. integer :: i, j, bc subchk = 0 do j=HI%jsc+dj,HI%jec+dj; do i=HI%isc+di,HI%iec+di @@ -204,9 +204,9 @@ integer function subchk(array, HI, di, dj, scale) end function subchk subroutine subStats(HI, array, mesg) - type(hor_index_type), intent(in) :: HI - real, dimension(HI%isd:,HI%jsd:), intent(in) :: array - character(len=*), intent(in) :: mesg + type(hor_index_type), intent(in) :: HI !< A horizontal index type + real, dimension(HI%isd:,HI%jsd:), intent(in) :: array !< The array to be checksummed + character(len=*), intent(in) :: mesg !< An identifying message integer :: i, j, n real :: aMean, aMin, aMax @@ -375,10 +375,10 @@ subroutine chksum_B_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal contains integer function subchk(array, HI, di, dj, scale) - type(hor_index_type), intent(in) :: HI - real, dimension(HI%IsdB:,HI%JsdB:), intent(in) :: array - integer, intent(in) :: di, dj - real, intent(in) :: scale + type(hor_index_type), intent(in) :: HI !< A horizontal index type + real, dimension(HI%IsdB:,HI%JsdB:), intent(in) :: array !< The array to be checksummed + integer, intent(in) :: di, dj !< i- and j- direction array shifts for this checksum + real, intent(in) :: scale !< A scaling factor for this array. integer :: i, j, bc subchk = 0 ! This line deliberately uses the h-point computational domain. @@ -391,10 +391,11 @@ integer function subchk(array, HI, di, dj, scale) end function subchk subroutine subStats(HI, array, mesg, sym_stats) - type(hor_index_type), intent(in) :: HI - real, dimension(HI%IsdB:,HI%JsdB:), intent(in) :: array - character(len=*), intent(in) :: mesg - logical, intent(in) :: sym_stats + type(hor_index_type), intent(in) :: HI !< A horizontal index type + real, dimension(HI%IsdB:,HI%JsdB:), intent(in) :: array !< The array to be checksummed + character(len=*), intent(in) :: mesg !< An identifying message + logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the + !! full symmetric computational domain. integer :: i, j, n, IsB, JsB real :: aMean, aMin, aMax @@ -562,10 +563,10 @@ subroutine chksum_u_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal contains integer function subchk(array, HI, di, dj, scale) - type(hor_index_type), intent(in) :: HI - real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: array - integer, intent(in) :: di, dj - real, intent(in) :: scale + type(hor_index_type), intent(in) :: HI !< A horizontal index type + real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: array !< The array to be checksummed + integer, intent(in) :: di, dj !< i- and j- direction array shifts for this checksum + real, intent(in) :: scale !< A scaling factor for this array. integer :: i, j, bc subchk = 0 ! This line deliberately uses the h-point computational domain. @@ -578,10 +579,11 @@ integer function subchk(array, HI, di, dj, scale) end function subchk subroutine subStats(HI, array, mesg, sym_stats) - type(hor_index_type), intent(in) :: HI - real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: array - character(len=*), intent(in) :: mesg - logical, intent(in) :: sym_stats + type(hor_index_type), intent(in) :: HI !< A horizontal index type + real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: array !< The array to be checksummed + character(len=*), intent(in) :: mesg !< An identifying message + logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the + !! full symmetric computational domain. integer :: i, j, n, IsB real :: aMean, aMin, aMax @@ -706,10 +708,10 @@ subroutine chksum_v_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal contains integer function subchk(array, HI, di, dj, scale) - type(hor_index_type), intent(in) :: HI - real, dimension(HI%isd:,HI%JsdB:), intent(in) :: array - integer, intent(in) :: di, dj - real, intent(in) :: scale + type(hor_index_type), intent(in) :: HI !< A horizontal index type + real, dimension(HI%isd:,HI%JsdB:), intent(in) :: array !< The array to be checksummed + integer, intent(in) :: di, dj !< i- and j- direction array shifts for this checksum + real, intent(in) :: scale !< A scaling factor for this array. integer :: i, j, bc subchk = 0 ! This line deliberately uses the h-point computational domain. @@ -722,10 +724,11 @@ integer function subchk(array, HI, di, dj, scale) end function subchk subroutine subStats(HI, array, mesg, sym_stats) - type(hor_index_type), intent(in) :: HI - real, dimension(HI%isd:,HI%JsdB:), intent(in) :: array - character(len=*), intent(in) :: mesg - logical, intent(in) :: sym_stats + type(hor_index_type), intent(in) :: HI !< A horizontal index type + real, dimension(HI%isd:,HI%JsdB:), intent(in) :: array !< The array to be checksummed + character(len=*), intent(in) :: mesg !< An identifying message + logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the + !! full symmetric computational domain. integer :: i, j, n, JsB real :: aMean, aMin, aMax @@ -832,10 +835,10 @@ subroutine chksum_h_3d(array, mesg, HI, haloshift, omit_corners, scale) contains integer function subchk(array, HI, di, dj, scale) - type(hor_index_type), intent(in) :: HI - real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: array - integer, intent(in) :: di, dj - real, intent(in) :: scale + type(hor_index_type), intent(in) :: HI !< A horizontal index type + real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed + integer, intent(in) :: di, dj !< i- and j- direction array shifts for this checksum + real, intent(in) :: scale !< A scaling factor for this array. integer :: i, j, k, bc subchk = 0 do k=LBOUND(array,3),UBOUND(array,3) ; do j=HI%jsc+dj,HI%jec+dj ; do i=HI%isc+di,HI%iec+di @@ -847,9 +850,9 @@ integer function subchk(array, HI, di, dj, scale) end function subchk subroutine subStats(HI, array, mesg) - type(hor_index_type), intent(in) :: HI - real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: array - character(len=*), intent(in) :: mesg + type(hor_index_type), intent(in) :: HI !< A horizontal index type + real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed + character(len=*), intent(in) :: mesg !< An identifying message integer :: i, j, k, n real :: aMean, aMin, aMax @@ -973,10 +976,10 @@ subroutine chksum_B_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal contains integer function subchk(array, HI, di, dj, scale) - type(hor_index_type), intent(in) :: HI - real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array - integer, intent(in) :: di, dj - real, intent(in) :: scale + type(hor_index_type), intent(in) :: HI !< A horizontal index type + real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed + integer, intent(in) :: di, dj !< i- and j- direction array shifts for this checksum + real, intent(in) :: scale !< A scaling factor for this array. integer :: i, j, k, bc subchk = 0 ! This line deliberately uses the h-point computational domain. @@ -989,10 +992,11 @@ integer function subchk(array, HI, di, dj, scale) end function subchk subroutine subStats(HI, array, mesg, sym_stats) - type(hor_index_type), intent(in) :: HI - real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array - character(len=*), intent(in) :: mesg - logical, intent(in) :: sym_stats + type(hor_index_type), intent(in) :: HI !< A horizontal index type + real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed + character(len=*), intent(in) :: mesg !< An identifying message + logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the + !! full symmetric computational domain. integer :: i, j, k, n, IsB, JsB real :: aMean, aMin, aMax @@ -1117,10 +1121,10 @@ subroutine chksum_u_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal contains integer function subchk(array, HI, di, dj, scale) - type(hor_index_type), intent(in) :: HI - real, dimension(HI%IsdB:,HI%jsd:,:), intent(in) :: array - integer, intent(in) :: di, dj - real, intent(in) :: scale + type(hor_index_type), intent(in) :: HI !< A horizontal index type + real, dimension(HI%IsdB:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed + integer, intent(in) :: di, dj !< i- and j- direction array shifts for this checksum + real, intent(in) :: scale !< A scaling factor for this array. integer :: i, j, k, bc subchk = 0 ! This line deliberately uses the h-point computational domain. @@ -1133,10 +1137,11 @@ integer function subchk(array, HI, di, dj, scale) end function subchk subroutine subStats(HI, array, mesg, sym_stats) - type(hor_index_type), intent(in) :: HI - real, dimension(HI%IsdB:,HI%jsd:,:), intent(in) :: array - character(len=*), intent(in) :: mesg - logical, intent(in) :: sym_stats + type(hor_index_type), intent(in) :: HI !< A horizontal index type + real, dimension(HI%IsdB:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed + character(len=*), intent(in) :: mesg !< An identifying message + logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the + !! full symmetric computational domain. integer :: i, j, k, n, IsB real :: aMean, aMin, aMax @@ -1334,10 +1339,10 @@ subroutine chksum_v_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal contains integer function subchk(array, HI, di, dj, scale) - type(hor_index_type), intent(in) :: HI - real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: array - integer, intent(in) :: di, dj - real, intent(in) :: scale + type(hor_index_type), intent(in) :: HI !< A horizontal index type + real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed + integer, intent(in) :: di, dj !< i- and j- direction array shifts for this checksum + real, intent(in) :: scale !< A scaling factor for this array. integer :: i, j, k, bc subchk = 0 ! This line deliberately uses the h-point computational domain. @@ -1350,10 +1355,11 @@ integer function subchk(array, HI, di, dj, scale) end function subchk subroutine subStats(HI, array, mesg, sym_stats) - type(hor_index_type), intent(in) :: HI - real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: array - character(len=*), intent(in) :: mesg - logical, intent(in) :: sym_stats + type(hor_index_type), intent(in) :: HI !< A horizontal index type + real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed + character(len=*), intent(in) :: mesg !< An identifying message + logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the + !! full symmetric computational domain. integer :: i, j, k, n, JsB real :: aMean, aMin, aMax @@ -1445,8 +1451,8 @@ end subroutine chksum1d !> chksum2d does a checksum of all data in a 2-d array. subroutine chksum2d(array, mesg) - real, dimension(:,:) :: array - character(len=*) :: mesg + real, dimension(:,:) :: array !< The array to be checksummed + character(len=*) :: mesg !< An identifying message integer :: xs,xe,ys,ye,i,j,sum1,bc real :: sum @@ -1473,8 +1479,8 @@ end subroutine chksum2d !> chksum3d does a checksum of all data in a 2-d array. subroutine chksum3d(array, mesg) - real, dimension(:,:,:) :: array - character(len=*) :: mesg + real, dimension(:,:,:) :: array !< The array to be checksummed + character(len=*) :: mesg !< An identifying message integer :: xs,xe,ys,ye,zs,ze,i,j,k, bc,sum1 real :: sum @@ -1583,63 +1589,75 @@ function is_NaN_3d(x) end function is_NaN_3d ! ===================================================================== - +!> Write a message including the checksum of the non-shifted array subroutine chk_sum_msg1(fmsg,bc0,mesg) - character(len=*), intent(in) :: fmsg, mesg - integer, intent(in) :: bc0 + character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble + character(len=*), intent(in) :: mesg !< An identifying message supplied by top-level caller + integer, intent(in) :: bc0 !< The bitcount of the non-shifted array if (is_root_pe()) write(0,'(A,1(A,I10,X),A)') fmsg," c=",bc0,trim(mesg) end subroutine chk_sum_msg1 ! ===================================================================== - +!> Write a message including checksums of non-shifted and diagonally shifted arrays subroutine chk_sum_msg5(fmsg,bc0,bcSW,bcSE,bcNW,bcNE,mesg) - character(len=*), intent(in) :: fmsg, mesg - integer, intent(in) :: bc0,bcSW,bcSE,bcNW,bcNE + character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble + character(len=*), intent(in) :: mesg !< An identifying message supplied by top-level caller + integer, intent(in) :: bc0 !< The bitcount of the non-shifted array + integer, intent(in) :: bcSW,bcSE,bcNW,bcNE !< The bitcounts for 4 diagonal array shifts if (is_root_pe()) write(0,'(A,5(A,I10,1X),A)') & fmsg," c=",bc0,"sw=",bcSW,"se=",bcSE,"nw=",bcNW,"ne=",bcNE,trim(mesg) end subroutine chk_sum_msg5 ! ===================================================================== - +!> Write a message including checksums of non-shifted and laterally shifted arrays subroutine chk_sum_msg_NSEW(fmsg,bc0,bcN,bcS,bcE,bcW,mesg) - character(len=*), intent(in) :: fmsg, mesg - integer, intent(in) :: bc0, bcN, bcS, bcE, bcW + character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble + character(len=*), intent(in) :: mesg !< An identifying message supplied by top-level caller + integer, intent(in) :: bc0 !< The bitcount of the non-shifted array + integer, intent(in) :: bcN, bcS, bcE, bcW !< The bitcounts including 4 lateral array shifts if (is_root_pe()) write(0,'(A,5(A,I10,1X),A)') & fmsg," c=",bc0,"N=",bcN,"S=",bcS,"E=",bcE,"W=",bcW,trim(mesg) end subroutine chk_sum_msg_NSEW ! ===================================================================== - +!> Write a message including checksums of non-shifted and southward shifted arrays subroutine chk_sum_msg_S(fmsg,bc0,bcS,mesg) - character(len=*), intent(in) :: fmsg, mesg - integer, intent(in) :: bc0, bcS + character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble + character(len=*), intent(in) :: mesg !< An identifying message supplied by top-level caller + integer, intent(in) :: bc0 !< The bitcount of the non-shifted array + integer, intent(in) :: bcS !< The bitcount of the south-shifted array if (is_root_pe()) write(0,'(A,2(A,I10,1X),A)') & fmsg," c=",bc0,"S=",bcS,trim(mesg) end subroutine chk_sum_msg_S ! ===================================================================== - +!> Write a message including checksums of non-shifted and westward shifted arrays subroutine chk_sum_msg_W(fmsg,bc0,bcW,mesg) - character(len=*), intent(in) :: fmsg, mesg - integer, intent(in) :: bc0, bcW + character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble + character(len=*), intent(in) :: mesg !< An identifying message supplied by top-level caller + integer, intent(in) :: bc0 !< The bitcount of the non-shifted array + integer, intent(in) :: bcW !< The bitcount of the west-shifted array if (is_root_pe()) write(0,'(A,2(A,I10,1X),A)') & fmsg," c=",bc0,"W=",bcW,trim(mesg) end subroutine chk_sum_msg_W ! ===================================================================== - +!> Write a message including checksums of non-shifted and southwestward shifted arrays subroutine chk_sum_msg2(fmsg,bc0,bcSW,mesg) - character(len=*), intent(in) :: fmsg, mesg - integer, intent(in) :: bc0,bcSW + character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble + character(len=*), intent(in) :: mesg !< An identifying message supplied by top-level caller + integer, intent(in) :: bc0 !< The bitcount of the non-shifted array + integer, intent(in) :: bcSW !< The bitcount of the southwest-shifted array if (is_root_pe()) write(0,'(A,2(A,I9,1X),A)') & fmsg," c=",bc0,"s/w=",bcSW,trim(mesg) end subroutine chk_sum_msg2 ! ===================================================================== - +!> Write a message including the global mean, maximum and minimum of an array subroutine chk_sum_msg3(fmsg,aMean,aMin,aMax,mesg) - character(len=*), intent(in) :: fmsg, mesg - real, intent(in) :: aMean,aMin,aMax + character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble + character(len=*), intent(in) :: mesg !< An identifying message supplied by top-level caller + real, intent(in) :: aMean,aMin,aMax !< The mean, minimum and maximum of the array if (is_root_pe()) write(0,'(A,3(A,ES25.16,1X),A)') & fmsg," mean=",aMean,"min=",aMin,"max=",aMax,trim(mesg) end subroutine chk_sum_msg3 @@ -1659,12 +1677,11 @@ subroutine MOM_checksums_init(param_file) end subroutine MOM_checksums_init ! ===================================================================== - +!> A wrapper for MOM_error used in the checksum code subroutine chksum_error(signal, message) - ! Wrapper for MOM_error to help place specific break points in - ! debuggers - integer, intent(in) :: signal - character(len=*), intent(in) :: message + ! Wrapper for MOM_error to help place specific break points in debuggers + integer, intent(in) :: signal !< An error severity level, such as FATAL or WARNING + character(len=*), intent(in) :: message !< An error message call MOM_error(signal, message) end subroutine chksum_error From c64fc57770eba01d1aee1b2076133d214724d524 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 7 May 2018 09:08:55 -0400 Subject: [PATCH 0200/1072] dOxyGenized MOM_safe_alloc.F90 Added dOxyGen comments for all routines and arguments in MOM_safe_alloc.F90. All answers are bitwise identical. --- src/framework/MOM_safe_alloc.F90 | 46 +++++++++++++++++++++----------- 1 file changed, 31 insertions(+), 15 deletions(-) diff --git a/src/framework/MOM_safe_alloc.F90 b/src/framework/MOM_safe_alloc.F90 index 196a6b40e6..5b4d331645 100644 --- a/src/framework/MOM_safe_alloc.F90 +++ b/src/framework/MOM_safe_alloc.F90 @@ -14,11 +14,13 @@ module MOM_safe_alloc public safe_alloc_ptr, safe_alloc_alloc +!> Allocate a pointer to a 1-d, 2-d or 3-d array interface safe_alloc_ptr module procedure safe_alloc_ptr_3d_2arg, safe_alloc_ptr_2d_2arg module procedure safe_alloc_ptr_3d, safe_alloc_ptr_2d, safe_alloc_ptr_1d end interface safe_alloc_ptr +!> Allocate a 2-d or 3-d allocatable array interface safe_alloc_alloc module procedure safe_alloc_allocatable_3d, safe_alloc_allocatable_2d end interface safe_alloc_alloc @@ -34,10 +36,11 @@ module MOM_safe_alloc contains +!> Allocate a pointer to a 1-d array subroutine safe_alloc_ptr_1d(ptr, i1, i2) - real, pointer :: ptr(:) - integer, intent(in) :: i1 - integer, optional, intent(in) :: i2 + real, dimension(:), pointer :: ptr !< A pointer to allocate + integer, intent(in) :: i1 !< The size of the array, or its starting index if i2 is present + integer, optional, intent(in) :: i2 !< The ending index of the array if (.not.associated(ptr)) then if (present(i2)) then allocate(ptr(i1:i2)) @@ -48,54 +51,67 @@ subroutine safe_alloc_ptr_1d(ptr, i1, i2) endif end subroutine safe_alloc_ptr_1d +!> Allocate a pointer to a 2-d array based on its dimension sizes subroutine safe_alloc_ptr_2d_2arg(ptr, ni, nj) - real, pointer :: ptr(:,:) - integer, intent(in) :: ni, nj + real, dimension(:,:), pointer :: ptr !< A pointer to allocate + integer, intent(in) :: ni, nj !< The sizes of the 1st and 2nd dimensions of the array if (.not.associated(ptr)) then allocate(ptr(ni,nj)) ptr(:,:) = 0.0 endif end subroutine safe_alloc_ptr_2d_2arg +!> Allocate a pointer to a 3-d array based on its dimension sizes subroutine safe_alloc_ptr_3d_2arg(ptr, ni, nj, nk) - real, pointer :: ptr(:,:,:) - integer, intent(in) :: ni, nj, nk + real, dimension(:,:,:), pointer :: ptr !< A pointer to allocate + integer, intent(in) :: ni, nj !< The sizes of the 1st and 2nd dimensions of the array + integer, intent(in) :: nk !< The size to allocate for the 3rd dimension if (.not.associated(ptr)) then allocate(ptr(ni,nj,nk)) ptr(:,:,:) = 0.0 endif end subroutine safe_alloc_ptr_3d_2arg +!> Allocate a pointer to a 2-d array based on its index starting and ending values subroutine safe_alloc_ptr_2d(ptr, is, ie, js, je) - real, pointer :: ptr(:,:) - integer, intent(in) :: is, ie, js, je + real, dimension(:,:), pointer :: ptr !< A pointer to allocate + integer, intent(in) :: is, ie !< The start and end indices to allocate for the 1st dimension + integer, intent(in) :: js, je !< The start and end indices to allocate for the 2nd dimension if (.not.associated(ptr)) then allocate(ptr(is:ie,js:je)) ptr(:,:) = 0.0 endif end subroutine safe_alloc_ptr_2d +!> Allocate a pointer to a 3-d array based on its index starting and ending values subroutine safe_alloc_ptr_3d(ptr, is, ie, js, je, nk) - real, pointer :: ptr(:,:,:) - integer, intent(in) :: is, ie, js, je, nk + real, dimension(:,:,:), pointer :: ptr !< A pointer to allocate + integer, intent(in) :: is, ie !< The start and end indices to allocate for the 1st dimension + integer, intent(in) :: js, je !< The start and end indices to allocate for the 2nd dimension + integer, intent(in) :: nk !< The size to allocate for the 3rd dimension if (.not.associated(ptr)) then allocate(ptr(is:ie,js:je,nk)) ptr(:,:,:) = 0.0 endif end subroutine safe_alloc_ptr_3d +!> Allocate a 2-d allocatable array based on its index starting and ending values subroutine safe_alloc_allocatable_2d(ptr, is, ie, js, je) - real, allocatable :: ptr(:,:) - integer, intent(in) :: is, ie, js, je + real, dimension(:,:), allocatable :: ptr !< An allocatable array to allocate + integer, intent(in) :: is, ie !< The start and end indices to allocate for the 1st dimension + integer, intent(in) :: js, je !< The start and end indices to allocate for the 2nd dimension if (.not.allocated(ptr)) then allocate(ptr(is:ie,js:je)) ptr(:,:) = 0.0 endif end subroutine safe_alloc_allocatable_2d +!> Allocate a 3-d allocatable array based on its index starting and ending values subroutine safe_alloc_allocatable_3d(ptr, is, ie, js, je, nk) - real, allocatable :: ptr(:,:,:) - integer, intent(in) :: is, ie, js, je, nk + real, dimension(:,:,:), allocatable :: ptr !< An allocatable array to allocate + integer, intent(in) :: is, ie !< The start and end indices to allocate for the 1st dimension + integer, intent(in) :: js, je !< The start and end indices to allocate for the 2nd dimension + integer, intent(in) :: nk !< The size to allocate for the 3rd dimension if (.not.allocated(ptr)) then allocate(ptr(is:ie,js:je,nk)) ptr(:,:,:) = 0.0 From 5cb839eaf9df1684f12e287710944241fc5a8c1e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 7 May 2018 09:09:29 -0400 Subject: [PATCH 0201/1072] dOxyGenized MOM_file_parser.F90 Added dOxyGen comments for all routines and arguments in MOM_file_parser.F90. All answers are bitwise identical. --- src/framework/MOM_file_parser.F90 | 699 ++++++++++++++++++++---------- 1 file changed, 466 insertions(+), 233 deletions(-) diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index a15f317a99..a2531fdac9 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -72,66 +72,76 @@ module MOM_file_parser end type parameter_block type, public :: param_file_type ; private - integer :: nfiles = 0 ! The number of open files. - integer :: iounit(MAX_PARAM_FILES) ! The unit number of an open file. - character(len=FILENAME_LENGTH) :: filename(MAX_PARAM_FILES) ! The names of the open files. - logical :: NetCDF_file(MAX_PARAM_FILES)! If true, the input file is in NetCDF. + integer :: nfiles = 0 !< The number of open files. + integer :: iounit(MAX_PARAM_FILES) !< The unit numbers of open files. + character(len=FILENAME_LENGTH) :: filename(MAX_PARAM_FILES) !< The names of the open files. + logical :: NetCDF_file(MAX_PARAM_FILES) !< If true, the input file is in NetCDF. ! This is not yet implemented. - type(file_data_type) :: param_data(MAX_PARAM_FILES) ! Structures that contain - ! the valid data lines from the parameter - ! files, enabling all subsequent reads of - ! parameter data to occur internally. - logical :: report_unused = report_unused_default ! If true, report any - ! parameter lines that are not used in the run. - logical :: unused_params_fatal = unused_params_fatal_default ! If true, kill - ! the run if there are any unused parameters. - logical :: log_to_stdout = log_to_stdout_default ! If true, all log - ! messages are also sent to stdout. - logical :: log_open = .false. ! True if the log file has been opened. - integer :: stdout, stdlog ! The units from stdout() and stdlog(). - character(len=240) :: doc_file ! A file where all run-time parameters, their - ! settings and defaults are documented. - logical :: complete_doc = complete_doc_default ! If true, document all - ! run-time parameters. - logical :: minimal_doc = minimal_doc_default ! If true, document only those - ! run-time parameters that differ from defaults. - type(doc_type), pointer :: doc => NULL() ! A structure that contains information - ! related to parameter documentation. - type(link_parameter), pointer :: chain => NULL() ! Facilitates linked list - type(parameter_block), pointer :: blockName => NULL() ! Name of active parameter block + type(file_data_type) :: param_data(MAX_PARAM_FILES) !< Structures that contain + !! the valid data lines from the parameter + !! files, enabling all subsequent reads of + !! parameter data to occur internally. + logical :: report_unused = report_unused_default !< If true, report any + !! parameter lines that are not used in the run. + logical :: unused_params_fatal = unused_params_fatal_default !< If true, kill + !! the run if there are any unused parameters. + logical :: log_to_stdout = log_to_stdout_default !< If true, all log + !! messages are also sent to stdout. + logical :: log_open = .false. !< True if the log file has been opened. + integer :: stdout, stdlog !< The units from stdout() and stdlog(). + character(len=240) :: doc_file !< A file where all run-time parameters, their + !! settings and defaults are documented. + logical :: complete_doc = complete_doc_default !< If true, document all + !! run-time parameters. + logical :: minimal_doc = minimal_doc_default !< If true, document only those + !! run-time parameters that differ from defaults. + type(doc_type), pointer :: doc => NULL() !< A structure that contains information + !! related to parameter documentation. + type(link_parameter), pointer :: chain => NULL() !< Facilitates linked list + type(parameter_block), pointer :: blockName => NULL() !< Name of active parameter block end type param_file_type public read_param, open_param_file, close_param_file, log_param, log_version public doc_param, get_param public clearParameterBlock, openParameterBlock, closeParameterBlock +!> An overloaded interface to read various types of parameters interface read_param module procedure read_param_int, read_param_real, read_param_logical, & read_param_char, read_param_char_array, read_param_time, & read_param_int_array, read_param_real_array end interface +!> An overloaded interface to log the values of various types of parameters interface log_param module procedure log_param_int, log_param_real, log_param_logical, & log_param_char, log_param_time, & log_param_int_array, log_param_real_array end interface +!> An overloaded interface to log the values of various types of parameters interface get_param module procedure get_param_int, get_param_real, get_param_logical, & get_param_char, get_param_char_array, get_param_time, & get_param_int_array, get_param_real_array end interface + +!> An overloaded interface to log version information about modules interface log_version module procedure log_version_cs, log_version_plain end interface contains +!> Make the contents of a parameter input file availalble in a param_file_type subroutine open_param_file(filename, CS, checkable, component, doc_file_dir) - character(len=*), intent(in) :: filename - type(param_file_type), intent(inout) :: CS - logical, optional, intent(in) :: checkable - character(len=*), optional, intent(in) :: component - character(len=*), optional, intent(in) :: doc_file_dir + character(len=*), intent(in) :: filename !< An input file name, optionally with the full path + type(param_file_type), intent(inout) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + logical, optional, intent(in) :: checkable !< If this is false, it disables checks of this + !! file for unused parameters. The default is True. + character(len=*), optional, intent(in) :: component !< If present, this component name is used + !! to generate parameter documentation file names; the default is"MOM" + character(len=*), optional, intent(in) :: doc_file_dir !< An optional directory in which to write out + !! the documentation files. The default is effectively './'. logical :: file_exists, unit_in_use, Netcdf_file, may_check integer :: ios, iounit, strlen, i @@ -244,17 +254,23 @@ subroutine open_param_file(filename, CS, checkable, component, doc_file_dir) end subroutine open_param_file +!> Close any open input files and deallocate memory associated with this param_file_type. +!! To use this type again, open_param_file would have to be called again. subroutine close_param_file(CS, quiet_close, component) - type(param_file_type), intent(inout) :: CS - logical, optional, intent(in) :: quiet_close - character(len=*), optional, intent(in) :: component + type(param_file_type), intent(inout) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + logical, optional, intent(in) :: quiet_close !< if present and true, do not do any + !! logging with this call. + character(len=*), optional, intent(in) :: component !< If present, this component name is used + !! to generate parameter documentation file names ! Arguments: CS - the param_file_type to close ! (in,opt) quiet_close - if present and true, do not do any logging with this ! call. -! This include declares and sets the variable "version". -#include "version_variable.h" + character(len=128) :: docfile_default character(len=40) :: mdl ! This module's name. +! This include declares and sets the variable "version". +#include "version_variable.h" integer :: i, n, num_unused if (present(quiet_close)) then ; if (quiet_close) then @@ -337,10 +353,13 @@ subroutine close_param_file(CS, quiet_close, component) end subroutine close_param_file +!> Read the contents of a parameter input file, and store the contents in a +!! file_data_type after removing comments and simplifying white space subroutine populate_param_data(iounit, filename, param_data) - integer, intent(in) :: iounit - character(len=*), intent(in) :: filename - type(file_data_type), intent(inout) :: param_data + integer, intent(in) :: iounit !< The IO unit number that is open for filename + character(len=*), intent(in) :: filename !< An input file name, optionally with the full path + type(file_data_type), intent(inout) :: param_data !< A list of the input lines that set parameters + !! after comments have been stripped out. character(len=INPUT_STR_LENGTH) :: line integer :: num_lines @@ -432,8 +451,10 @@ subroutine populate_param_data(iounit, filename, param_data) end subroutine populate_param_data + +!> Return True if a /* appears on this line without a closing */ function openMultiLineComment(string) - character(len=*), intent(in) :: string + character(len=*), intent(in) :: string !< The input string to process logical :: openMultiLineComment ! True if a /* appears on this line without a closing */ integer :: icom, last @@ -447,38 +468,43 @@ function openMultiLineComment(string) icom = index(string(last:), "*/") ; if (icom > 0) openMultiLineComment=.false. end function openMultiLineComment +!> Return True if a */ appears on this line function closeMultiLineComment(string) - character(len=*), intent(in) :: string + character(len=*), intent(in) :: string !< The input string to process logical :: closeMultiLineComment ! True if a */ appears on this line closeMultiLineComment = .false. if (index(string, "*/")>0) closeMultiLineComment=.true. end function closeMultiLineComment +!> Find position of last character before any comments, As marked by "!", "//", or "/*" +!! following F90, C++, or C syntax function lastNonCommentIndex(string) - character(len=*), intent(in) :: string + character(len=*), intent(in) :: string !< The input string to process integer :: lastNonCommentIndex ! Find position of last character before any comments ! This s/r is the only place where a comment needs to be defined integer :: icom, last last = len_trim(string) icom = index(string(:last), "!") ; if (icom > 0) last = icom-1 ! F90 style - icom = index(string(:last), "//") ; if (icom > 0) last = icom-1 ! C+ style + icom = index(string(:last), "//") ; if (icom > 0) last = icom-1 ! C++ style icom = index(string(:last), "/*") ; if (icom > 0) last = icom-1 ! C style lastNonCommentIndex = last end function lastNonCommentIndex +!> Find position of last non-blank character before any comments function lastNonCommentNonBlank(string) - character(len=*), intent(in) :: string + character(len=*), intent(in) :: string !< The input string to process integer :: lastNonCommentNonBlank ! Find position of last non-blank character before any comments lastNonCommentNonBlank = len_trim(string(:lastNonCommentIndex(string))) ! Ignore remaining trailing blanks end function lastNonCommentNonBlank +!> Returns a string with tabs replaced by a blank function replaceTabs(string) - character(len=*), intent(in) :: string + character(len=*), intent(in) :: string !< The input string to process character(len=len(string)) :: replaceTabs -! Returns string with tabs replaced by a ablank +! Returns string with tabs replaced by a blank integer :: i do i=1, len(string) if (string(i:i)==achar(9)) then @@ -489,8 +515,9 @@ function replaceTabs(string) enddo end function replaceTabs +!> Trims comments and leading blanks from string function removeComments(string) - character(len=*), intent(in) :: string + character(len=*), intent(in) :: string !< The input string to process character(len=len(string)) :: removeComments ! Trims comments and leading blanks from string integer :: last @@ -499,8 +526,10 @@ function removeComments(string) removeComments(:last)=adjustl(string(:last)) ! Copy only the non-comment part of string end function removeComments +!> Constructs a string with all repeated whitespace replaced with single blanks +!! and insert white space where it helps delineate tokens (e.g. around =) function simplifyWhiteSpace(string) - character(len=*), intent(in) :: string + character(len=*), intent(in) :: string !< A string to modify to simpify white space character(len=len(string)+16) :: simplifyWhiteSpace ! Constructs a string with all repeated whitespace replaced with single blanks ! and insert white space where it helps delineate tokens (e.g. around =) @@ -551,11 +580,15 @@ function simplifyWhiteSpace(string) endif end function simplifyWhiteSpace +!> This subroutine reads the value of an integer model parameter from a parameter file. subroutine read_param_int(CS, varname, value, fail_if_missing) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: varname - integer, intent(inout) :: value - logical, optional, intent(in) :: fail_if_missing + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + integer, intent(inout) :: value !< The value of the parameter that may be + !! read from the parameter file + logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs + !! if this variable is not found in the parameter file ! This subroutine determines the value of an integer model parameter ! from a parameter file. The arguments are the unit of the open file ! which is to be read, the (case-sensitive) variable name, the variable @@ -583,11 +616,14 @@ subroutine read_param_int(CS, varname, value, fail_if_missing) ' parsing "'//trim(value_string(1))//'"') end subroutine read_param_int +!> This subroutine reads the values of an array of integer model parameters from a parameter file. subroutine read_param_int_array(CS, varname, value, fail_if_missing) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: varname - integer, intent(inout) :: value(:) - logical, optional, intent(in) :: fail_if_missing + type(param_file_type), intent(in) :: CS !< The control structure for this parameter, which is also a structure to parse for run-time parameters + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + integer, dimension(:), intent(inout) :: value !< The value of the parameter that may be + !! read from the parameter file + logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs + !! if this variable is not found in the parameter file ! This subroutine determines the value of an integer model parameter ! from a parameter file. The arguments are the unit of the open file ! which is to be read, the (case-sensitive) variable name, the variable @@ -616,11 +652,15 @@ subroutine read_param_int_array(CS, varname, value, fail_if_missing) ' parsing "'//trim(value_string(1))//'"') end subroutine read_param_int_array +!> This subroutine reads the value of a real model parameter from a parameter file. subroutine read_param_real(CS, varname, value, fail_if_missing) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: varname - real, intent(inout) :: value - logical, optional, intent(in) :: fail_if_missing + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + real, intent(inout) :: value !< The value of the parameter that may be + !! read from the parameter file + logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs + !! if this variable is not found in the parameter file ! This subroutine determines the value of an integer model parameter ! from a parameter file. The arguments are the unit of the open file ! which is to be read, the (case-sensitive) variable name, the variable @@ -648,11 +688,15 @@ subroutine read_param_real(CS, varname, value, fail_if_missing) ' parsing "'//trim(value_string(1))//'"') end subroutine read_param_real +!> This subroutine reads the values of an array of real model parameters from a parameter file. subroutine read_param_real_array(CS, varname, value, fail_if_missing) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: varname - real, intent(inout) :: value(:) - logical, optional, intent(in) :: fail_if_missing + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + real, dimension(:), intent(inout) :: value !< The value of the parameter that may be + !! read from the parameter file + logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs + !! if this variable is not found in the parameter file ! This subroutine determines the value of an integer model parameter ! from a parameter file. The arguments are the unit of the open file ! which is to be read, the (case-sensitive) variable name, the variable @@ -681,11 +725,15 @@ subroutine read_param_real_array(CS, varname, value, fail_if_missing) ' parsing "'//trim(value_string(1))//'"') end subroutine read_param_real_array +!> This subroutine reads the value of a character string model parameter from a parameter file. subroutine read_param_char(CS, varname, value, fail_if_missing) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: varname - character(len=*), intent(inout) :: value - logical, optional, intent(in) :: fail_if_missing + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + character(len=*), intent(inout) :: value !< The value of the parameter that may be + !! read from the parameter file + logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs + !! if this variable is not found in the parameter file ! This subroutine determines the value of an integer model parameter ! from a parameter file. The arguments are the unit of the open file ! which is to be read, the (case-sensitive) variable name, the variable @@ -704,11 +752,15 @@ subroutine read_param_char(CS, varname, value, fail_if_missing) end subroutine read_param_char +!> This subroutine reads the values of an array of character string model parameters from a parameter file. subroutine read_param_char_array(CS, varname, value, fail_if_missing) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: varname - character(len=*), intent(inout) :: value(:) - logical, optional, intent(in) :: fail_if_missing + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + character(len=*), dimension(:), intent(inout) :: value !< The value of the parameter that may be + !! read from the parameter file + logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs + !! if this variable is not found in the parameter file ! This subroutine determines the value of an integer model parameter ! from a parameter file. The arguments are the unit of the open file ! which is to be read, the (case-sensitive) variable name, the variable @@ -741,11 +793,15 @@ subroutine read_param_char_array(CS, varname, value, fail_if_missing) end subroutine read_param_char_array +!> This subroutine reads the value of a logical model parameter from a parameter file. subroutine read_param_logical(CS, varname, value, fail_if_missing) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: varname - logical, intent(inout) :: value - logical, optional, intent(in) :: fail_if_missing + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + logical, intent(inout) :: value !< The value of the parameter that may be + !! read from the parameter file + logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs + !! if this variable is not found in the parameter file ! This subroutine determines the value of an integer model parameter ! from a parameter file. The arguments are the unit of the open file ! which is to be read, the (case-sensitive) variable name, the variable @@ -763,14 +819,19 @@ subroutine read_param_logical(CS, varname, value, fail_if_missing) endif ; endif end subroutine read_param_logical - +!> This subroutine reads the value of a time_type model parameter from a parameter file. subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing, date_format) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: varname - type(time_type), intent(inout) :: value - real, optional, intent(in) :: timeunit - logical, optional, intent(in) :: fail_if_missing - logical, optional, intent(out) :: date_format + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + type(time_type), intent(inout) :: value !< The value of the parameter that may be + !! read from the parameter file + real, optional, intent(in) :: timeunit !< The number of seconds in a time unit for real-number input. + logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs + !! if this variable is not found in the parameter file + logical, optional, intent(out) :: date_format !< If present, this indicates whether this + !! parameter was read in a date format, so that it can + !! later be logged in the same format. ! This subroutine determines the value of an time-type model parameter ! from a parameter file. The arguments are the unit of the open file ! which is to be read, the (case-sensitive) variable name, the variable @@ -834,8 +895,9 @@ subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing, date_f trim(varname)// ' parsing "'//trim(value_string(1))//'"') end subroutine read_param_time +!> This function removes single and double quotes from a character string function strip_quotes(val_str) - character(len=*) :: val_str + character(len=*) :: val_str !< The character string to work on character(len=INPUT_STR_LENGTH) :: strip_quotes ! Local variables integer :: i @@ -854,12 +916,18 @@ function strip_quotes(val_str) enddo end function strip_quotes +!> This subtoutine extracts the contents of lines in the param_file_type that refer to +!! a named parameter. The value_string that is returned must be interepreted in a way +!! that depends on the type of this variable. subroutine get_variable_line(CS, varname, found, defined, value_string, paramIsLogical) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: varname - logical, intent(out) :: found, defined - character(len=*), intent(out) :: value_string(:) - logical, optional, intent(in) :: paramIsLogical + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + logical, intent(out) :: found !< If true, this parameter has been found in CS + logical, intent(out) :: defined !< If true, this parameter is set (or true) in the CS + character(len=*), intent(out) :: value_string(:) !< A string that encodes the new value + logical, optional, intent(in) :: paramIsLogical !< If true, this is a logical parameter + !! that can be simply defined without parsing a value_string. character(len=INPUT_STR_LENGTH) :: val_str, lname, origLine character(len=INPUT_STR_LENGTH) :: line, continuationBuffer, blockName @@ -1170,15 +1238,17 @@ subroutine get_variable_line(CS, varname, found, defined, value_string, paramIsL end subroutine get_variable_line -subroutine flag_line_as_read(line_used,count) - logical, dimension(:), pointer :: line_used - integer, intent(in) :: count +!> Record that a line has been used to set a parameter +subroutine flag_line_as_read(line_used, count) + logical, dimension(:), pointer :: line_used !< A structure indicating which lines have been read + integer, intent(in) :: count !< The parameter on this line number has been read line_used(count) = .true. end subroutine flag_line_as_read +!> Returns true if an override warning has been issued for the variable varName function overrideWarningHasBeenIssued(chain, varName) type(link_parameter), pointer :: chain - character(len=*), intent(in) :: varName + character(len=*), intent(in) :: varName !< The name of the variable being queried for warnings logical :: overrideWarningHasBeenIssued ! Returns true if an override warning has been issued for the variable varName type(link_parameter), pointer :: newLink, this @@ -1234,16 +1304,22 @@ subroutine log_version_plain(modulename, version) end subroutine log_version_plain +!> Log the name and value of an integer model parameter in documentation files. subroutine log_param_int(CS, modulename, varname, value, desc, units, & default, layoutParam, debuggingParam) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: modulename - character(len=*), intent(in) :: varname - integer, intent(in) :: value - character(len=*), optional, intent(in) :: desc, units - integer, optional, intent(in) :: default - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: modulename !< The name of the module using this parameter + character(len=*), intent(in) :: varname !< The name of the parameter to log + integer, intent(in) :: value !< The value of the parameter to log + character(len=*), optional, intent(in) :: desc !< A description of this variable; if not + !! present, this paramter is not written to a doc file + character(len=*), optional, intent(in) :: units !< The units of this parameter + integer, optional, intent(in) :: default !< The default value of the parameter + logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + !! logged in the layout parameter file + logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + !! logged in the debugging parameter file ! This subroutine writes the value of an integer parameter to a log file, ! along with its name and the module it came from. character(len=240) :: mesg, myunits @@ -1261,16 +1337,21 @@ subroutine log_param_int(CS, modulename, varname, value, desc, units, & end subroutine log_param_int +!> Log the name and values of an array of integer model parameter in documentation files. subroutine log_param_int_array(CS, modulename, varname, value, desc, & units, default, layoutParam, debuggingParam) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: modulename - character(len=*), intent(in) :: varname - integer, intent(in) :: value(:) - character(len=*), optional, intent(in) :: desc, units - integer, optional, intent(in) :: default - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: modulename !< The name of the module using this parameter + character(len=*), intent(in) :: varname !< The name of the parameter to log + integer, dimension(:), intent(in) :: value !< The value of the parameter to log + character(len=*), optional, intent(in) :: desc !< A description of this variable; if not + !! present, this paramter is not written to a doc file + character(len=*), optional, intent(in) :: units !< The units of this parameter + integer, optional, intent(in) :: default !< The default value of the parameter + logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is logged in the layout parameter file + logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + !! logged in the debugging parameter file ! This subroutine writes the value of an integer parameter to a log file, ! along with its name and the module it came from. character(len=1320) :: mesg @@ -1289,15 +1370,20 @@ subroutine log_param_int_array(CS, modulename, varname, value, desc, & end subroutine log_param_int_array +!> Log the name and value of a real model parameter in documentation files. subroutine log_param_real(CS, modulename, varname, value, desc, units, & default, debuggingParam) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: modulename - character(len=*), intent(in) :: varname - real, intent(in) :: value - character(len=*), optional, intent(in) :: desc, units - real, optional, intent(in) :: default - logical, optional, intent(in) :: debuggingParam + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: modulename !< The name of the calling module + character(len=*), intent(in) :: varname !< The name of the parameter to log + real, intent(in) :: value !< The value of the parameter to log + character(len=*), optional, intent(in) :: desc !< A description of this variable; if not + !! present, this paramter is not written to a doc file + character(len=*), optional, intent(in) :: units !< The units of this parameter + real, optional, intent(in) :: default !< The default value of the parameter + logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + !! logged in the debugging parameter file ! This subroutine writes the value of a real parameter to a log file, ! along with its name and the module it came from. character(len=240) :: mesg, myunits @@ -1316,14 +1402,18 @@ subroutine log_param_real(CS, modulename, varname, value, desc, units, & end subroutine log_param_real +!> Log the name and values of an array of real model parameter in documentation files. subroutine log_param_real_array(CS, modulename, varname, value, desc, & units, default) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: modulename - character(len=*), intent(in) :: varname - real, intent(in) :: value(:) - character(len=*), optional, intent(in) :: desc, units - real, optional, intent(in) :: default + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: modulename !< The name of the calling module + character(len=*), intent(in) :: varname !< The name of the parameter to log + real, dimension(:), intent(in) :: value !< The value of the parameter to log + character(len=*), optional, intent(in) :: desc !< A description of this variable; if not + !! present, this paramter is not written to a doc file + character(len=*), optional, intent(in) :: units !< The units of this parameter + real, optional, intent(in) :: default !< The default value of the parameter ! This subroutine writes the value of a real parameter to a log file, ! along with its name and the module it came from. character(len=1320) :: mesg @@ -1345,16 +1435,22 @@ subroutine log_param_real_array(CS, modulename, varname, value, desc, & end subroutine log_param_real_array +!> Log the name and value of a logical model parameter in documentation files. subroutine log_param_logical(CS, modulename, varname, value, desc, & units, default, layoutParam, debuggingParam) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: modulename - character(len=*), intent(in) :: varname - logical, intent(in) :: value - character(len=*), optional, intent(in) :: desc, units - logical, optional, intent(in) :: default - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: modulename !< The name of the calling module + character(len=*), intent(in) :: varname !< The name of the parameter to log + logical, intent(in) :: value !< The value of the parameter to log + character(len=*), optional, intent(in) :: desc !< A description of this variable; if not + !! present, this paramter is not written to a doc file + character(len=*), optional, intent(in) :: units !< The units of this parameter + logical, optional, intent(in) :: default !< The default value of the parameter + logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + !! logged in the layout parameter file + logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + !! logged in the debugging parameter file ! This subroutine writes the value of a logical parameter to a log file, ! along with its name and the module it came from. character(len=240) :: mesg, myunits @@ -1376,16 +1472,22 @@ subroutine log_param_logical(CS, modulename, varname, value, desc, & end subroutine log_param_logical +!> Log the name and value of a character string model parameter in documentation files. subroutine log_param_char(CS, modulename, varname, value, desc, units, & default, layoutParam, debuggingParam) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: modulename - character(len=*), intent(in) :: varname - character(len=*), intent(in) :: value - character(len=*), optional, intent(in) :: desc, units - character(len=*), optional, intent(in) :: default - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: modulename !< The name of the calling module + character(len=*), intent(in) :: varname !< The name of the parameter to log + character(len=*), intent(in) :: value !< The value of the parameter to log + character(len=*), optional, intent(in) :: desc !< A description of this variable; if not + !! present, this paramter is not written to a doc file + character(len=*), optional, intent(in) :: units !< The units of this parameter + character(len=*), optional, intent(in) :: default !< The default value of the parameter + logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + !! logged in the layout parameter file + logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + !! logged in the debugging parameter file ! This subroutine writes the value of a character string parameter to a log ! file, along with its name and the module it came from. character(len=240) :: mesg, myunits @@ -1408,16 +1510,23 @@ end subroutine log_param_char !! along with its name and the module it came from. subroutine log_param_time(CS, modulename, varname, value, desc, units, & default, timeunit, layoutParam, debuggingParam, log_date) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: modulename - character(len=*), intent(in) :: varname - type(time_type), intent(in) :: value - character(len=*), optional, intent(in) :: desc, units - type(time_type), optional, intent(in) :: default - real, optional, intent(in) :: timeunit + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: modulename !< The name of the calling module + character(len=*), intent(in) :: varname !< The name of the parameter to log + type(time_type), intent(in) :: value !< The value of the parameter to log + character(len=*), optional, intent(in) :: desc !< A description of this variable; if not + !! present, this paramter is not written to a doc file + character(len=*), optional, intent(in) :: units !< The units of this parameter + type(time_type), optional, intent(in) :: default !< The default value of the parameter + real, optional, intent(in) :: timeunit !< The number of seconds in a time unit for + !! real-number output. logical, optional, intent(in) :: log_date !< If true, log the time_type in date format. - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + !! If missing the default is false. + logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + !! logged in the layout parameter file + logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + !! logged in the debugging parameter file real :: real_time, real_default logical :: use_timeunit, date_format @@ -1516,19 +1625,34 @@ function convert_date_to_string(date) result(date_string) end function convert_date_to_string +!> This subroutine reads the value of an integer model parameter from a parameter file +!! and logs it in documentation files. subroutine get_param_int(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, & static_value, layoutParam, debuggingParam) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: modulename - character(len=*), intent(in) :: varname - integer, intent(inout) :: value - character(len=*), optional, intent(in) :: desc, units - integer, optional, intent(in) :: default, static_value - logical, optional, intent(in) :: fail_if_missing - logical, optional, intent(in) :: do_not_read, do_not_log - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: modulename !< The name of the calling module + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + integer, intent(inout) :: value !< The value of the parameter that may be + !! read from the parameter file and logged + character(len=*), optional, intent(in) :: desc !< A description of this variable; if not + !! present, this paramter is not written to a doc file + character(len=*), optional, intent(in) :: units !< The units of this parameter + integer, optional, intent(in) :: default !< The default value of the parameter + integer, optional, intent(in) :: static_value !< If this parameter is static, it takes + !! this value, which can be compared for consistency with + !! what is in the parameter file. + logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs + !! if this variable is not found in the parameter file + logical, optional, intent(in) :: do_not_read !< If present and true, do not read a + !! value for this parameter, although it might be logged. + logical, optional, intent(in) :: do_not_log !< If present and true, do not log this + !! parameter to the documentation files + logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + !! logged in the layout parameter file + logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + !! logged in the debugging parameter file ! This subroutine writes the value of a real parameter to a log file, ! along with its name and the module it came from. logical :: do_read, do_log @@ -1549,19 +1673,33 @@ subroutine get_param_int(CS, modulename, varname, value, desc, units, & end subroutine get_param_int +!> This subroutine reads the values of an array of integer model parameters from a parameter file +!! and logs them in documentation files. subroutine get_param_int_array(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, & static_value, layoutParam, debuggingParam) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: modulename - character(len=*), intent(in) :: varname - integer, intent(inout) :: value(:) - character(len=*), optional, intent(in) :: desc, units - integer, optional, intent(in) :: default, static_value - logical, optional, intent(in) :: fail_if_missing - logical, optional, intent(in) :: do_not_read, do_not_log - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: modulename !< The name of the calling module + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + integer, dimension(:), intent(inout) :: value !< The value of the parameter that may be reset from the parameter file + character(len=*), optional, intent(in) :: desc !< A description of this variable; if not + !! present, this paramter is not written to a doc file + character(len=*), optional, intent(in) :: units !< The units of this parameter + integer, optional, intent(in) :: default !< The default value of the parameter + integer, optional, intent(in) :: static_value !< If this parameter is static, it takes + !! this value, which can be compared for consistency with + !! what is in the parameter file. + logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs + !! if this variable is not found in the parameter file + logical, optional, intent(in) :: do_not_read !< If present and true, do not read a + !! value for this parameter, although it might be logged. + logical, optional, intent(in) :: do_not_log !< If present and true, do not log this + !! parameter to the documentation files + logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + !! logged in the layout parameter file + logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + !! logged in the debugging parameter file ! This subroutine writes the value of a real parameter to a log file, ! along with its name and the module it came from. logical :: do_read, do_log @@ -1582,18 +1720,32 @@ subroutine get_param_int_array(CS, modulename, varname, value, desc, units, & end subroutine get_param_int_array +!> This subroutine reads the value of a real model parameter from a parameter file +!! and logs it in documentation files. subroutine get_param_real(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, & static_value, debuggingParam) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: modulename - character(len=*), intent(in) :: varname - real, intent(inout) :: value - character(len=*), optional, intent(in) :: desc, units - real, optional, intent(in) :: default, static_value - logical, optional, intent(in) :: fail_if_missing - logical, optional, intent(in) :: do_not_read, do_not_log - logical, optional, intent(in) :: debuggingParam + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: modulename !< The name of the calling module + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + real, intent(inout) :: value !< The value of the parameter that may be + !! read from the parameter file and logged + character(len=*), optional, intent(in) :: desc !< A description of this variable; if not + !! present, this paramter is not written to a doc file + character(len=*), optional, intent(in) :: units !< The units of this parameter + real, optional, intent(in) :: default !< The default value of the parameter + real, optional, intent(in) :: static_value !< If this parameter is static, it takes + !! this value, which can be compared for consistency with + !! what is in the parameter file. + logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs + !! if this variable is not found in the parameter file + logical, optional, intent(in) :: do_not_read !< If present and true, do not read a + !! value for this parameter, although it might be logged. + logical, optional, intent(in) :: do_not_log !< If present and true, do not log this + !! parameter to the documentation files + logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + !! logged in the debugging parameter file ! This subroutine writes the value of a real parameter to a log file, ! along with its name and the module it came from. logical :: do_read, do_log @@ -1614,18 +1766,30 @@ subroutine get_param_real(CS, modulename, varname, value, desc, units, & end subroutine get_param_real +!> This subroutine reads the values of an array of real model parameters from a parameter file +!! and logs them in documentation files. subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, static_value) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: modulename - character(len=*), intent(in) :: varname - real, intent(inout) :: value(:) - character(len=*), optional, intent(in) :: desc, units - real, optional, intent(in) :: default, static_value - logical, optional, intent(in) :: fail_if_missing - logical, optional, intent(in) :: do_not_read, do_not_log -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: modulename !< The name of the calling module + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + real, dimension(:), intent(inout) :: value !< The value of the parameter that may be + !! read from the parameter file and logged + character(len=*), optional, intent(in) :: desc !< A description of this variable; if not + !! present, this paramter is not written to a doc file + character(len=*), optional, intent(in) :: units !< The units of this parameter + real, optional, intent(in) :: default !< The default value of the parameter + real, optional, intent(in) :: static_value !< If this parameter is static, it takes + !! this value, which can be compared for consistency with + !! what is in the parameter file. + logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs + !! if this variable is not found in the parameter file + logical, optional, intent(in) :: do_not_read !< If present and true, do not read a + !! value for this parameter, although it might be logged. + logical, optional, intent(in) :: do_not_log !< If present and true, do not log this + !! parameter to the documentation files + logical :: do_read, do_log do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read @@ -1644,19 +1808,34 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & end subroutine get_param_real_array +!> This subroutine reads the value of a character string model parameter from a parameter file +!! and logs it in documentation files. subroutine get_param_char(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, & static_value, layoutParam, debuggingParam) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: modulename - character(len=*), intent(in) :: varname - character(len=*), intent(inout) :: value - character(len=*), optional, intent(in) :: desc, units - character(len=*), optional, intent(in) :: default, static_value - logical, optional, intent(in) :: fail_if_missing - logical, optional, intent(in) :: do_not_read, do_not_log - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: modulename !< The name of the calling module + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + character(len=*), intent(inout) :: value !< The value of the parameter that may be + !! read from the parameter file and logged + character(len=*), optional, intent(in) :: desc !< A description of this variable; if not + !! present, this paramter is not written to a doc file + character(len=*), optional, intent(in) :: units !< The units of this parameter + character(len=*), optional, intent(in) :: default !< The default value of the parameter + character(len=*), optional, intent(in) :: static_value !< If this parameter is static, it takes + !! this value, which can be compared for consistency with + !! what is in the parameter file. + logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs + !! if this variable is not found in the parameter file + logical, optional, intent(in) :: do_not_read !< If present and true, do not read a + !! value for this parameter, although it might be logged. + logical, optional, intent(in) :: do_not_log !< If present and true, do not log this + !! parameter to the documentation files + logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + !! logged in the layout parameter file + logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + !! logged in the debugging parameter file ! This subroutine writes the value of a real parameter to a log file, ! along with its name and the module it came from. logical :: do_read, do_log @@ -1677,16 +1856,29 @@ subroutine get_param_char(CS, modulename, varname, value, desc, units, & end subroutine get_param_char +!> This subroutine reads the values of an array of character string model parameters +!! from a parameter file and logs them in documentation files. subroutine get_param_char_array(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, static_value) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: modulename - character(len=*), intent(in) :: varname - character(len=*), intent(inout) :: value(:) - character(len=*), optional, intent(in) :: desc, units - character(len=*), optional, intent(in) :: default, static_value - logical, optional, intent(in) :: fail_if_missing - logical, optional, intent(in) :: do_not_read, do_not_log + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: modulename !< The name of the calling module + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + character(len=*), dimension(:), intent(inout) :: value !< The value of the parameter that may be + !! read from the parameter file and logged + character(len=*), optional, intent(in) :: desc !< A description of this variable; if not + !! present, this paramter is not written to a doc file + character(len=*), optional, intent(in) :: units !< The units of this parameter + character(len=*), optional, intent(in) :: default !< The default value of the parameter + character(len=*), optional, intent(in) :: static_value !< If this parameter is static, it takes + !! this value, which can be compared for consistency with + !! what is in the parameter file. + logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs + !! if this variable is not found in the parameter file + logical, optional, intent(in) :: do_not_read !< If present and true, do not read a + !! value for this parameter, although it might be logged. + logical, optional, intent(in) :: do_not_log !< If present and true, do not log this + !! parameter to the documentation files ! This subroutine writes the value of a real parameter to a log file, ! along with its name and the module it came from. logical :: do_read, do_log @@ -1717,19 +1909,34 @@ subroutine get_param_char_array(CS, modulename, varname, value, desc, units, & end subroutine get_param_char_array +!> This subroutine reads the value of a logical model parameter from a parameter file +!! and logs it in documentation files. subroutine get_param_logical(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, & static_value, layoutParam, debuggingParam) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: modulename - character(len=*), intent(in) :: varname - logical, intent(inout) :: value - character(len=*), optional, intent(in) :: desc, units - logical, optional, intent(in) :: default, static_value - logical, optional, intent(in) :: fail_if_missing - logical, optional, intent(in) :: do_not_read, do_not_log - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: modulename !< The name of the calling module + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + logical, intent(inout) :: value !< The value of the parameter that may be + !! read from the parameter file and logged + character(len=*), optional, intent(in) :: desc !< A description of this variable; if not + !! present, this paramter is not written to a doc file + character(len=*), optional, intent(in) :: units !< The units of this parameter + logical, optional, intent(in) :: default !< The default value of the parameter + logical, optional, intent(in) :: static_value !< If this parameter is static, it takes + !! this value, which can be compared for consistency with + !! what is in the parameter file. + logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs + !! if this variable is not found in the parameter file + logical, optional, intent(in) :: do_not_read !< If present and true, do not read a + !! value for this parameter, although it might be logged. + logical, optional, intent(in) :: do_not_log !< If present and true, do not log this + !! parameter to the documentation files + logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + !! logged in the layout parameter file + logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + !! logged in the debugging parameter file ! This subroutine writes the value of a real parameter to a log file, ! along with its name and the module it came from. logical :: do_read, do_log @@ -1750,22 +1957,39 @@ subroutine get_param_logical(CS, modulename, varname, value, desc, units, & end subroutine get_param_logical +!> This subroutine reads the value of a time-type model parameter from a parameter file +!! and logs it in documentation files. subroutine get_param_time(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, & timeunit, static_value, layoutParam, debuggingParam, & log_as_date) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: modulename - character(len=*), intent(in) :: varname - type(time_type), intent(inout) :: value - character(len=*), optional, intent(in) :: desc, units - type(time_type), optional, intent(in) :: default, static_value - logical, optional, intent(in) :: fail_if_missing - logical, optional, intent(in) :: do_not_read, do_not_log - real, optional, intent(in) :: timeunit - logical, optional, intent(in) :: layoutParam - logical, optional, intent(in) :: debuggingParam - logical, optional, intent(in) :: log_as_date + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: modulename !< The name of the calling module + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + type(time_type), intent(inout) :: value !< The value of the parameter that may be + !! read from the parameter file and logged + character(len=*), optional, intent(in) :: desc !< A description of this variable; if not + !! present, this paramter is not written to a doc file + character(len=*), optional, intent(in) :: units !< The units of this parameter + type(time_type), optional, intent(in) :: default !< The default value of the parameter + type(time_type), optional, intent(in) :: static_value !< If this parameter is static, it takes + !! this value, which can be compared for consistency with + !! what is in the parameter file. + logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs + !! if this variable is not found in the parameter file + logical, optional, intent(in) :: do_not_read !< If present and true, do not read a + !! value for this parameter, although it might be logged. + logical, optional, intent(in) :: do_not_log !< If present and true, do not log this + !! parameter to the documentation files + real, optional, intent(in) :: timeunit !< The number of seconds in a time unit for + !! real-number input to be translated to a time. + logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + !! logged in the layout parameter file + logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + !! logged in the debugging parameter file + logical, optional, intent(in) :: log_as_date !< If true, log the time_type in date + !! format. The default is false. ! This subroutine writes the value of a real parameter to a log file, ! along with its name and the module it came from. logical :: do_read, do_log, date_format, log_date @@ -1791,8 +2015,10 @@ end subroutine get_param_time ! ----------------------------------------------------------------------------- +!> Resets the parameter block name to blank subroutine clearParameterBlock(CS) - type(param_file_type), intent(in) :: CS + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters ! Resets the parameter block name to blank type(parameter_block), pointer :: block if (associated(CS%blockName)) then @@ -1804,10 +2030,12 @@ subroutine clearParameterBlock(CS) endif end subroutine clearParameterBlock +!> Tags blockName onto the end of the active parameter block name subroutine openParameterBlock(CS,blockName,desc) - type(param_file_type), intent(in) :: CS - character(len=*), intent(in) :: blockName - character(len=*), optional, intent(in) :: desc + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters + character(len=*), intent(in) :: blockName !< The name of a parameter block being added + character(len=*), optional, intent(in) :: desc !< A description of the parameter block being added ! Tags blockName onto the end of the active parameter block name type(parameter_block), pointer :: block if (associated(CS%blockName)) then @@ -1820,8 +2048,10 @@ subroutine openParameterBlock(CS,blockName,desc) endif end subroutine openParameterBlock +!> Remove the lowest level of recursion from the active block name subroutine closeParameterBlock(CS) - type(param_file_type), intent(in) :: CS + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters ! Remove the lowest level of recursion from the active block name type(parameter_block), pointer :: block @@ -1838,8 +2068,10 @@ subroutine closeParameterBlock(CS) block%name = popBlockLevel(block%name) end subroutine closeParameterBlock +!> Extends block name (deeper level of parameter block) function pushBlockLevel(oldblockName,newBlockName) - character(len=*), intent(in) :: oldBlockName, newBlockName + character(len=*), intent(in) :: oldBlockName !< A sequence of hierarchical parameter block names + character(len=*), intent(in) :: newBlockName !< A new block name to add to the end of the sequence character(len=len(oldBlockName)+40) :: pushBlockLevel ! Extends block name (deeper level of parameter block) if (len_trim(oldBlockName)>0) then @@ -1849,8 +2081,9 @@ function pushBlockLevel(oldblockName,newBlockName) endif end function pushBlockLevel +!> Truncates block name (shallower level of parameter block) function popBlockLevel(oldblockName) - character(len=*), intent(in) :: oldBlockName + character(len=*), intent(in) :: oldBlockName !< A sequence of hierarchical parameter block names character(len=len(oldBlockName)+40) :: popBlockLevel ! Truncates block name (shallower level of parameter block) integer :: i From 01160781639b92ed3fbf467824fd39ce8b685b1c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 7 May 2018 14:39:02 -0400 Subject: [PATCH 0202/1072] Merged keywords end do & end if to enddo & endif Replaced 'end do' with 'enddo' and 'else if' with 'elseif', to follow typical practice in MOM6. Also adding spacing around the semicolons separating stacked enddo statements in several places. All answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 14 +-- config_src/coupled_driver/ocean_model_MOM.F90 | 4 +- config_src/solo_driver/MOM_driver.F90 | 12 +- .../solo_driver/MOM_surface_forcing.F90 | 44 +++---- src/ALE/MOM_ALE.F90 | 2 +- src/ALE/MOM_regridding.F90 | 56 ++++----- src/ALE/MOM_remapping.F90 | 26 ++--- src/ALE/P1M_functions.F90 | 10 +- src/ALE/P3M_functions.F90 | 72 ++++++------ src/ALE/PCM_functions.F90 | 2 +- src/ALE/PLM_functions.F90 | 4 +- src/ALE/PPM_functions.F90 | 12 +- src/ALE/PQM_functions.F90 | 110 +++++++++--------- src/ALE/coord_rho.F90 | 44 +++---- src/ALE/polynomial_functions.F90 | 6 +- src/ALE/regrid_edge_slopes.F90 | 32 ++--- src/ALE/regrid_edge_values.F90 | 72 ++++++------ src/ALE/regrid_interp.F90 | 74 ++++++------ src/ALE/regrid_solvers.F90 | 28 ++--- src/core/MOM.F90 | 2 +- src/core/MOM_CoriolisAdv.F90 | 2 +- src/core/MOM_continuity_PPM.F90 | 6 +- src/core/MOM_open_boundary.F90 | 60 +++++----- src/diagnostics/MOM_diagnostics.F90 | 12 +- src/diagnostics/MOM_sum_output.F90 | 8 +- src/diagnostics/MOM_wave_speed.F90 | 2 +- src/equation_of_state/MOM_EOS.F90 | 2 +- src/framework/MOM_checksums.F90 | 8 +- src/framework/MOM_horizontal_regridding.F90 | 6 +- src/framework/MOM_io.F90 | 10 +- src/framework/MOM_restart.F90 | 10 +- src/framework/MOM_string_functions.F90 | 4 +- src/ice_shelf/MOM_ice_shelf.F90 | 24 ++-- src/initialization/MOM_grid_initialize.F90 | 12 +- .../MOM_shared_initialization.F90 | 6 +- .../MOM_state_initialization.F90 | 12 +- src/initialization/midas_vertmap.F90 | 4 +- src/ocean_data_assim/MOM_oda_driver.F90 | 14 +-- .../lateral/MOM_hor_visc.F90 | 2 +- .../lateral/MOM_internal_tides.F90 | 18 +-- .../vertical/MOM_ALE_sponge.F90 | 16 +-- src/parameterizations/vertical/MOM_KPP.F90 | 2 +- .../vertical/MOM_bulk_mixed_layer.F90 | 2 +- .../vertical/MOM_diapyc_energy_req.F90 | 2 +- .../vertical/MOM_energetic_PBL.F90 | 2 +- .../vertical/MOM_entrain_diffusive.F90 | 8 +- .../vertical/MOM_internal_tide_input.F90 | 2 +- .../vertical/MOM_opacity.F90 | 2 +- .../vertical/MOM_set_diffusivity.F90 | 2 +- .../vertical/MOM_set_viscosity.F90 | 4 +- .../vertical/MOM_tidal_mixing.F90 | 12 +- .../vertical/MOM_vert_friction.F90 | 8 +- src/tracer/DOME_tracer.F90 | 2 +- src/tracer/MOM_OCMIP2_CO2calc.F90 | 6 +- src/tracer/MOM_generic_tracer.F90 | 8 +- src/tracer/MOM_neutral_diffusion.F90 | 4 +- src/tracer/MOM_neutral_diffusion_aux.F90 | 16 +-- src/tracer/MOM_offline_aux.F90 | 4 +- src/tracer/MOM_offline_main.F90 | 28 ++--- src/tracer/MOM_tracer_diabatic.F90 | 12 +- src/tracer/MOM_tracer_hor_diff.F90 | 2 +- src/tracer/dye_example.F90 | 4 +- src/tracer/oil_tracer.F90 | 2 +- src/user/BFB_initialization.F90 | 4 +- src/user/BFB_surface_forcing.F90 | 4 +- src/user/DOME2d_initialization.F90 | 4 +- src/user/ISOMIP_initialization.F90 | 4 +- src/user/MOM_wave_interface.F90 | 8 +- src/user/Phillips_initialization.F90 | 8 +- src/user/Rossby_front_2d_initialization.F90 | 6 +- src/user/SCM_CVmix_tests.F90 | 6 +- src/user/SCM_idealized_hurricane.F90 | 2 +- src/user/adjustment_initialization.F90 | 4 +- src/user/baroclinic_zone_initialization.F90 | 2 +- src/user/dense_water_initialization.F90 | 8 +- src/user/dumbbell_initialization.F90 | 2 +- src/user/dumbbell_surface_forcing.F90 | 6 +- src/user/seamount_initialization.F90 | 2 +- src/user/sloshing_initialization.F90 | 24 ++-- src/user/soliton_initialization.F90 | 2 +- 80 files changed, 547 insertions(+), 547 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index a76d37cd6e..7d2af296e0 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -305,7 +305,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & do j=js-2,je+2 ; do i=is-2,ie+2 fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) - enddo; enddo + enddo ; enddo if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) @@ -353,7 +353,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & if (CS%mask_srestore_under_ice) then ! Do not restore under sea-ice do j=js,je ; do i=is,ie if (sfc_state%SST(i,j) <= -0.0539*sfc_state%SSS(i,j)) open_ocn_mask(i,j)=0.0 - enddo; enddo + enddo ; enddo endif if (CS%salt_restore_as_sflux) then do j=js,je ; do i=is,ie @@ -361,7 +361,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & 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)*CS%srestore_mask(i,j)) *delta_sss ! kg Salt m-2 s-1 - enddo; enddo + enddo ; enddo if (CS%adjust_net_srestore_to_zero) then if (CS%adjust_net_srestore_by_scaling) then call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) @@ -382,7 +382,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & (CS%Rho0*CS%Flux_const) * & delta_sss / (0.5*(sfc_state%SSS(i,j) + data_restore(i,j))) endif - enddo; enddo + enddo ; enddo if (CS%adjust_net_srestore_to_zero) then if (CS%adjust_net_srestore_by_scaling) then call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) @@ -392,7 +392,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf do j=js,je ; do i=is,ie fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) - enddo; enddo + enddo ; enddo endif endif endif @@ -536,12 +536,12 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) do j=js,je ; do i=is,ie fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) - enddo; enddo + enddo ; enddo else fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf do j=js,je ; do i=is,ie fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%netFWGlobalAdj ) * G%mask2dT(i,j) - enddo; enddo + enddo ; enddo endif endif diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index dca6b8a837..395a4d3abb 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -1079,9 +1079,9 @@ subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc) case('mask') array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) !OR same result -! do j=g_jsc,g_jec; do i=g_isc,g_iec +! do j=g_jsc,g_jec ; do i=g_isc,g_iec ! array2D(isc+i-g_isc,jsc+j-g_jsc) = OS%grid%mask2dT(i,j) -! enddo; enddo +! enddo ; enddo case('t_surf') array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('t_pme') diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 2727f42e1f..80a622b5ec 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -273,11 +273,11 @@ program MOM_main else calendar = uppercase(calendar) if (calendar(1:6) == 'JULIAN') then ; calendar_type = JULIAN - else if (calendar(1:9) == 'GREGORIAN') then ; calendar_type = GREGORIAN - else if (calendar(1:6) == 'NOLEAP') then ; calendar_type = NOLEAP - else if (calendar(1:10)=='THIRTY_DAY') then ; calendar_type = THIRTY_DAY_MONTHS - else if (calendar(1:11)=='NO_CALENDAR') then; calendar_type = NO_CALENDAR - else if (calendar(1:1) /= ' ') then + elseif (calendar(1:9) == 'GREGORIAN') then ; calendar_type = GREGORIAN + elseif (calendar(1:6) == 'NOLEAP') then ; calendar_type = NOLEAP + elseif (calendar(1:10)=='THIRTY_DAY') then ; calendar_type = THIRTY_DAY_MONTHS + elseif (calendar(1:11)=='NO_CALENDAR') then; calendar_type = NO_CALENDAR + elseif (calendar(1:1) /= ' ') then call MOM_error(FATAL,'MOM_driver: Invalid namelist value '//trim(calendar)//' for calendar') else call MOM_error(FATAL,'MOM_driver: No namelist value for calendar') @@ -641,7 +641,7 @@ program MOM_main call get_date(Time, yr, mon, day, hr, mins, sec) write(unit, '(6i6,8x,a)') yr, mon, day, hr, mins, sec, & 'Current model time: year, month, day, hour, minute, second' - end if + endif call close_file(unit) endif diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 37bcaea17e..9a25b4b11a 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -599,16 +599,16 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, CS) time_lev_daily = days - 365*floor(real(days) / 365.0) if (time_lev_daily < 31) then ; time_lev_monthly = 0 - else if (time_lev_daily < 59) then ; time_lev_monthly = 1 - else if (time_lev_daily < 90) then ; time_lev_monthly = 2 - else if (time_lev_daily < 120) then ; time_lev_monthly = 3 - else if (time_lev_daily < 151) then ; time_lev_monthly = 4 - else if (time_lev_daily < 181) then ; time_lev_monthly = 5 - else if (time_lev_daily < 212) then ; time_lev_monthly = 6 - else if (time_lev_daily < 243) then ; time_lev_monthly = 7 - else if (time_lev_daily < 273) then ; time_lev_monthly = 8 - else if (time_lev_daily < 304) then ; time_lev_monthly = 9 - else if (time_lev_daily < 334) then ; time_lev_monthly = 10 + elseif (time_lev_daily < 59) then ; time_lev_monthly = 1 + elseif (time_lev_daily < 90) then ; time_lev_monthly = 2 + elseif (time_lev_daily < 120) then ; time_lev_monthly = 3 + elseif (time_lev_daily < 151) then ; time_lev_monthly = 4 + elseif (time_lev_daily < 181) then ; time_lev_monthly = 5 + elseif (time_lev_daily < 212) then ; time_lev_monthly = 6 + elseif (time_lev_daily < 243) then ; time_lev_monthly = 7 + elseif (time_lev_daily < 273) then ; time_lev_monthly = 8 + elseif (time_lev_daily < 304) then ; time_lev_monthly = 9 + elseif (time_lev_daily < 334) then ; time_lev_monthly = 10 else ; time_lev_monthly = 11 endif @@ -847,16 +847,16 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) time_lev_daily = days - 365*floor(real(days) / 365.0) if (time_lev_daily < 31) then ; time_lev_monthly = 0 - else if (time_lev_daily < 59) then ; time_lev_monthly = 1 - else if (time_lev_daily < 90) then ; time_lev_monthly = 2 - else if (time_lev_daily < 120) then ; time_lev_monthly = 3 - else if (time_lev_daily < 151) then ; time_lev_monthly = 4 - else if (time_lev_daily < 181) then ; time_lev_monthly = 5 - else if (time_lev_daily < 212) then ; time_lev_monthly = 6 - else if (time_lev_daily < 243) then ; time_lev_monthly = 7 - else if (time_lev_daily < 273) then ; time_lev_monthly = 8 - else if (time_lev_daily < 304) then ; time_lev_monthly = 9 - else if (time_lev_daily < 334) then ; time_lev_monthly = 10 + elseif (time_lev_daily < 59) then ; time_lev_monthly = 1 + elseif (time_lev_daily < 90) then ; time_lev_monthly = 2 + elseif (time_lev_daily < 120) then ; time_lev_monthly = 3 + elseif (time_lev_daily < 151) then ; time_lev_monthly = 4 + elseif (time_lev_daily < 181) then ; time_lev_monthly = 5 + elseif (time_lev_daily < 212) then ; time_lev_monthly = 6 + elseif (time_lev_daily < 243) then ; time_lev_monthly = 7 + elseif (time_lev_daily < 273) then ; time_lev_monthly = 8 + elseif (time_lev_daily < 304) then ; time_lev_monthly = 9 + elseif (time_lev_daily < 334) then ; time_lev_monthly = 10 else ; time_lev_monthly = 11 endif @@ -1153,7 +1153,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, CS ! but evap is normally a positive quantity in the files fluxes%latent(i,j) = CS%latent_heat_vapor*fluxes%evap(i,j) fluxes%latent_evap_diag(i,j) = fluxes%latent(i,j) - enddo; enddo + enddo ; enddo call data_override('OCN', 'sens', fluxes%sens(:,:), day, & is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) @@ -1162,7 +1162,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, CS do j=js,je ; do i=is,ie fluxes%sens(i,j) = -fluxes%sens(i,j) ! Normal convention is positive into the ocean ! but sensible is normally a positive quantity in the files - enddo; enddo + enddo ; enddo call data_override('OCN', 'sw', fluxes%sw(:,:), day, & is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index e4d297ddc8..c56d8a3fc3 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -1225,7 +1225,7 @@ subroutine ALE_initThicknessToCoord( CS, G, GV, h ) do j = G%jsd,G%jed ; do i = G%isd,G%ied h(i,j,:) = GV%m_to_H * getStaticThickness( CS%regridCS, 0., G%bathyT(i,j) ) - enddo; enddo + enddo ; enddo end subroutine ALE_initThicknessToCoord diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 1f3488a7bc..ebe8b93bf6 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -1147,7 +1147,7 @@ subroutine build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h) totalThickness = 0.0 do k = 1,nz totalThickness = totalThickness + h(i,j,k) - end do + enddo zOld(nz+1) = - nominalDepth do k = nz,1,-1 @@ -1190,8 +1190,8 @@ subroutine build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h) call adjust_interface_motion( CS, nz, h(i,j,:), dzInterface(i,j,:) ) - end do - end do + enddo + enddo end subroutine build_zstar_grid @@ -1236,7 +1236,7 @@ subroutine build_sigma_grid( CS, G, GV, h, dzInterface ) totalThickness = 0.0 do k = 1,nz totalThickness = totalThickness + h(i,j,k) - end do + enddo call build_sigma_column(CS%sigma_CS, nominalDepth, totalThickness, zNew) @@ -1244,7 +1244,7 @@ subroutine build_sigma_grid( CS, G, GV, h, dzInterface ) zOld(nz+1) = -nominalDepth do k = nz,1,-1 zOld(k) = zOld(k+1) + h(i, j, k) - end do + enddo call filtered_grid_motion( CS, nz, zOld, zNew, dzInterface(i,j,:) ) @@ -1267,8 +1267,8 @@ subroutine build_sigma_grid( CS, G, GV, h, dzInterface ) dzInterface(i,j,CS%nk+1) = 0. #endif - end do - end do + enddo + enddo end subroutine build_sigma_grid @@ -1393,8 +1393,8 @@ subroutine build_rho_grid( G, GV, h, tv, dzInterface, remapCS, CS ) endif #endif - end do ! end loop on i - end do ! end loop on j + enddo ! end loop on i + enddo ! end loop on j end subroutine build_rho_grid @@ -1466,7 +1466,7 @@ subroutine build_grid_HyCOM1( G, GV, h, tv, h_new, dzInterface, CS ) else ! on land dzInterface(i,j,:) = 0. endif ! mask2dT - enddo; enddo ! i,j + enddo ; enddo ! i,j call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new) @@ -1597,7 +1597,7 @@ subroutine build_grid_SLight(G, GV, h, tv, dzInterface, CS) else ! on land dzInterface(i,j,:) = 0. endif ! mask2dT - enddo; enddo ! i,j + enddo ; enddo ! i,j end subroutine build_grid_SLight @@ -1704,7 +1704,7 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) total_height = 0.0 do k = 1,nz total_height = total_height + h(i,j,k) - end do + enddo eta = total_height - local_depth @@ -1715,7 +1715,7 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) z_inter(1) = eta do k = 1,nz z_inter(k+1) = z_inter(k) - delta_h - end do + enddo ! Refine grid in the middle do k = 1,nz+1 @@ -1725,15 +1725,15 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) if ( x <= x1 ) then t = y1*x/x1 - else if ( (x > x1 ) .and. ( x < x2 )) then + elseif ( (x > x1 ) .and. ( x < x2 )) then t = y1 + (y2-y1) * (x-x1) / (x2-x1) else t = y2 + (1.0-y2) * (x-x2) / (1.0-x2) - end if + endif z_inter(k) = -t * max_depth + eta - end do + enddo ! Modify interface heights to account for topography z_inter(nz+1) = - local_depth @@ -1742,8 +1742,8 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) do k = nz,1,-1 if ( z_inter(k) < (z_inter(k+1) + min_thickness) ) then z_inter(k) = z_inter(k+1) + min_thickness - end if - end do + endif + enddo ! Chnage in interface position x = 0. ! Left boundary at x=0 @@ -1751,11 +1751,11 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) do k = 2,nz x = x + h(i,j,k) dzInterface(i,j,k) = z_inter(k) - x - end do + enddo dzInterface(i,j,nz+1) = 0. - end do - end do + enddo + enddo stop 'OOOOOOPS' ! For some reason the gnu compiler will not let me delete this ! routine???? @@ -1792,17 +1792,17 @@ subroutine inflate_vanished_layers_old( CS, G, GV, h ) ! Build grid for current column do k = 1,GV%ke hTmp(k) = h(i,j,k) - end do + enddo call old_inflate_layers_1d( CS%min_thickness, GV%ke, hTmp ) ! Save modified grid do k = 1,GV%ke h(i,j,k) = hTmp(k) - end do + enddo - end do - end do + enddo + enddo end subroutine inflate_vanished_layers_old @@ -1859,7 +1859,7 @@ subroutine convective_adjustment(G, GV, h, tv) call calculate_density( tv%T(i,j,k+1), tv%S(i,j,k+1), p_col(k+1), & densities(k+1), tv%eqn_of_state ) stratified = .false. - end if + endif enddo ! k if ( stratified ) exit @@ -1962,7 +1962,7 @@ subroutine set_target_densities_from_GV( GV, CS ) CS%target_density(nz+1) = GV%Rlay(nz)+0.5*(GV%Rlay(nz)-GV%Rlay(nz-1)) do k = 2,nz CS%target_density(k) = CS%target_density(k-1) + CS%coordinateResolution(k) - end do + enddo CS%target_density_set = .true. end subroutine set_target_densities_from_GV @@ -2080,7 +2080,7 @@ function getCoordinateInterfaces( CS ) ! The following line has an "abs()" to allow ferret users to reference ! data by index. It is a temporary work around... :( -AJA getCoordinateInterfaces(:) = abs( getCoordinateInterfaces(:) ) - end if + endif end function getCoordinateInterfaces diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index 10ba747d14..c0620122c1 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -140,7 +140,7 @@ subroutine buildGridFromH(nz, h, x) x(1) = 0.0 do k = 1,nz x(k+1) = x(k) + h(k) - end do + enddo end subroutine buildGridFromH @@ -389,21 +389,21 @@ subroutine build_reconstructions_1d( CS, n0, h0, u0, ppoly_r_coefs, & call PLM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect ) if ( CS%boundary_extrapolation ) then call PLM_boundary_extrapolation( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect) - end if + endif iMethod = INTEGRATION_PLM case ( REMAPPING_PPM_H4 ) call edge_values_explicit_h4( n0, h0, u0, ppoly_r_E, h_neglect_edge ) call PPM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect ) if ( CS%boundary_extrapolation ) then call PPM_boundary_extrapolation( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect ) - end if + endif iMethod = INTEGRATION_PPM case ( REMAPPING_PPM_IH4 ) call edge_values_implicit_h4( n0, h0, u0, ppoly_r_E, h_neglect_edge ) call PPM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect ) if ( CS%boundary_extrapolation ) then call PPM_boundary_extrapolation( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect ) - end if + endif iMethod = INTEGRATION_PPM case ( REMAPPING_PQM_IH4IH3 ) call edge_values_implicit_h4( n0, h0, u0, ppoly_r_E, h_neglect_edge ) @@ -412,7 +412,7 @@ subroutine build_reconstructions_1d( CS, n0, h0, u0, ppoly_r_coefs, & if ( CS%boundary_extrapolation ) then call PQM_boundary_extrapolation_v1( n0, h0, u0, ppoly_r_E, ppoly_r_S, & ppoly_r_coefs, h_neglect ) - end if + endif iMethod = INTEGRATION_PQM case ( REMAPPING_PQM_IH6IH5 ) call edge_values_implicit_h6( n0, h0, u0, ppoly_r_E, h_neglect_edge ) @@ -421,7 +421,7 @@ subroutine build_reconstructions_1d( CS, n0, h0, u0, ppoly_r_coefs, & if ( CS%boundary_extrapolation ) then call PQM_boundary_extrapolation_v1( n0, h0, u0, ppoly_r_E, ppoly_r_S, & ppoly_r_coefs, h_neglect ) - end if + endif iMethod = INTEGRATION_PQM case default call MOM_error( FATAL, 'MOM_remapping, build_reconstructions_1d: '//& @@ -1119,7 +1119,7 @@ subroutine remapByProjection( n0, h0, u0, ppoly0_E, ppoly0_coefs, & call integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefs, method, & xL, xR, h1(iTarget), u1(iTarget), jStart, xStart, h_neglect ) - end do ! end iTarget loop on target grid cells + enddo ! end iTarget loop on target grid cells end subroutine remapByProjection @@ -1206,7 +1206,7 @@ subroutine remapByDeltaZ( n0, h0, u0, ppoly0_E, ppoly0_coefs, n1, dx1, & if (present(h1)) h1(iTarget) = hNew endif - end do ! end iTarget loop on target grid cells + enddo ! end iTarget loop on target grid cells end subroutine remapByDeltaZ @@ -1321,7 +1321,7 @@ subroutine integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefs, method, call MOM_error( FATAL,'The selected integration method is invalid' ) end select - end if ! end checking whether source cell is vanished + endif ! end checking whether source cell is vanished ! 2. Cell is not vanished else @@ -1454,8 +1454,8 @@ subroutine integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefs, method, do k = jL+1,jR-1 q = q + h0(k) * u0(k) hAct = hAct + h0(k) - end do - end if + enddo + endif ! Integrate from left boundary of cell jR up to xR xi0 = 0.0 @@ -1494,7 +1494,7 @@ subroutine integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefs, method, call MOM_error( FATAL,'The selected integration method is invalid' ) end select - end if ! end integration for non-vanished cells + endif ! end integration for non-vanished cells ! The cell average is the integrated value divided by the cell width #ifdef __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ @@ -1507,7 +1507,7 @@ subroutine integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefs, method, uAve = q / hC #endif - end if ! end if clause to check if cell is vanished + endif ! endif clause to check if cell is vanished end subroutine integrateReconOnInterval diff --git a/src/ALE/P1M_functions.F90 b/src/ALE/P1M_functions.F90 index 8590a7297f..75490bee9f 100644 --- a/src/ALE/P1M_functions.F90 +++ b/src/ALE/P1M_functions.F90 @@ -87,7 +87,7 @@ subroutine P1M_interpolation( N, h, u, ppoly_E, ppoly_coef, h_neglect ) ppoly_coef(k,1) = u0_l ppoly_coef(k,2) = u0_r - u0_l - end do ! end loop on interior cells + enddo ! end loop on interior cells end subroutine P1M_interpolation @@ -147,7 +147,7 @@ subroutine P1M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef ) if ( (u1 - u0) * (ppoly_E(2,1) - u0_r) < 0.0 ) then slope = 2.0 * ( ppoly_E(2,1) - u0 ) - end if + endif ! Using the limited slope, the left edge value is reevaluated and ! the interpolant coefficients recomputed @@ -155,7 +155,7 @@ subroutine P1M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef ) ppoly_E(1,1) = u0 - 0.5 * slope else ppoly_E(1,1) = u0 - end if + endif ppoly_coef(1,1) = ppoly_E(1,1) ppoly_coef(1,2) = ppoly_E(1,2) - ppoly_E(1,1) @@ -175,13 +175,13 @@ subroutine P1M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef ) if ( (u1 - u0) * (u0_l - ppoly_E(N-1,2)) < 0.0 ) then slope = 2.0 * ( u1 - ppoly_E(N-1,2) ) - end if + endif if ( h1 /= 0.0 ) then ppoly_E(N,2) = u1 + 0.5 * slope else ppoly_E(N,2) = u1 - end if + endif ppoly_coef(N,1) = ppoly_E(N,1) ppoly_coef(N,2) = ppoly_E(N,2) - ppoly_E(N,1) diff --git a/src/ALE/P3M_functions.F90 b/src/ALE/P3M_functions.F90 index acc3e064ce..3034d2a8b4 100644 --- a/src/ALE/P3M_functions.F90 +++ b/src/ALE/P3M_functions.F90 @@ -144,7 +144,7 @@ subroutine P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect ) else h_l = h(k-1) u_l = u(k-1) - end if + endif if ( k == N ) then h_r = h(k) @@ -152,7 +152,7 @@ subroutine P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect ) else h_r = h(k+1) u_r = u(k+1) - end if + endif ! Compute limited slope sigma_l = 2.0 * ( u_c - u_l ) / ( h_c + hNeglect ) @@ -163,28 +163,28 @@ subroutine P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect ) slope = sign( min(abs(sigma_l),abs(sigma_c),abs(sigma_r)), sigma_c ) else slope = 0.0 - end if + endif ! If the slopes are close to zero in machine precision and in absolute ! value, we set the slope to zero. This prevents asymmetric representation ! near extrema. These expressions are both nondimensional. if ( abs(u1_l*h_c) < eps ) then u1_l = 0.0 - end if + endif if ( abs(u1_r*h_c) < eps ) then u1_r = 0.0 - end if + endif ! The edge slopes are limited from above by the respective ! one-sided slopes if ( abs(u1_l) > abs(sigma_l) ) then u1_l = sigma_l - end if + endif if ( abs(u1_r) > abs(sigma_r) ) then u1_r = sigma_r - end if + endif ! Build cubic interpolant (compute the coefficients) call build_cubic_interpolant( h, k, ppoly_E, ppoly_S, ppoly_coef ) @@ -197,7 +197,7 @@ subroutine P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect ) ! cubic coefficients if ( monotonic == 0 ) then call monotonize_cubic( h_c, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r ) - end if + endif ! Store edge slopes ppoly_S(k,1) = u1_l @@ -206,7 +206,7 @@ subroutine P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect ) ! Recompute coefficients of cubic call build_cubic_interpolant( h, k, ppoly_E, ppoly_S, ppoly_coef ) - end do ! loop on cells + enddo ! loop on cells end subroutine P3M_limiter @@ -278,7 +278,7 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coef, & slope = 2.0 * ( u1 - u0 ) / ( h0 + hNeglect ) if ( abs(u1_r) > abs(slope) ) then u1_r = slope - end if + endif ! The right edge value in the boundary cell is taken to be the left ! edge value in the neighboring cell @@ -297,7 +297,7 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coef, & u0_l = u0_r u1_l = 0.0 u1_r = 0.0 - end if + endif ! Store edge values and slope, build cubic and check monotonicity ppoly_E(i0,1) = u0_l @@ -317,7 +317,7 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coef, & ppoly_S(i0,2) = u1_r call build_cubic_interpolant( h, i0, ppoly_E, ppoly_S, ppoly_coef ) - end if + endif ! ----- Right boundary ----- i0 = N-1 @@ -338,7 +338,7 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coef, & slope = 2.0 * ( u1 - u0 ) / ( h1 + hNeglect ) if ( abs(u1_l) > abs(slope) ) then u1_l = slope - end if + endif ! The left edge value in the boundary cell is taken to be the right ! edge value in the neighboring cell @@ -357,7 +357,7 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coef, & u0_r = u0_l u1_l = 0.0 u1_r = 0.0 - end if + endif ! Store edge values and slope, build cubic and check monotonicity ppoly_E(i1,1) = u0_l @@ -376,7 +376,7 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coef, & ppoly_S(i1,2) = u1_r call build_cubic_interpolant( h, i1, ppoly_E, ppoly_S, ppoly_coef ) - end if + endif end subroutine P3M_boundary_extrapolation @@ -474,10 +474,10 @@ integer function is_cubic_monotonic( ppoly_coef, k ) if ( abs(c) > 1e-15 ) then xi_0 = 0.5 * ( -b - sqrt( rho ) ) / c xi_1 = 0.5 * ( -b + sqrt( rho ) ) / c - else if ( abs(b) > 1e-15 ) then + elseif ( abs(b) > 1e-15 ) then xi_0 = - a / b xi_1 = - a / b - end if + endif ! If one of the roots of the first derivative lies in (0,1), ! the cubic is not monotonic. @@ -486,11 +486,11 @@ integer function is_cubic_monotonic( ppoly_coef, k ) monotonic = 0 else monotonic = 1 - end if + endif else ! there are no real roots --> cubic is monotonic monotonic = 1 - end if + endif ! Set the return value is_cubic_monotonic = monotonic @@ -560,11 +560,11 @@ subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r ! set them to zero if ( u1_l*slope <= 0.0 ) then u1_l = 0.0 - end if + endif if ( u1_r*slope <= 0.0 ) then u1_r = 0.0 - end if + endif ! Compute the location of the inflexion point, which is the root ! of the second derivative @@ -582,8 +582,8 @@ subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r ! If the inflexion point lies in [0,1], change boolean value if ( (xi_ip >= 0.0) .AND. (xi_ip <= 1.0) ) then found_ip = 1 - end if - end if + endif + endif ! When there is an inflexion point within [0,1], check the slope ! to see if it is consistent with the limited PLM slope. If not, @@ -599,9 +599,9 @@ subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r inflexion_l = 1 else inflexion_r = 1 - end if - end if - end if ! found_ip + endif + endif + endif ! found_ip ! At this point, if the cubic is not monotonic, we know where the ! inflexion point should lie. When the cubic is monotonic, both @@ -618,12 +618,12 @@ subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r u1_l = 0.0 u1_r = 3.0 * (u0_r - u0_l) / h - else if (u1_l_tmp*slope < 0.0) then + elseif (u1_l_tmp*slope < 0.0) then u1_r = u1_r_tmp u1_l = 1.5*(u0_r - u0_l)/h - 0.5*u1_r - else if (u1_r_tmp*slope < 0.0) then + elseif (u1_r_tmp*slope < 0.0) then u1_l = u1_l_tmp u1_r = 3.0*(u0_r - u0_l)/h - 2.0*u1_l @@ -633,9 +633,9 @@ subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r u1_l = u1_l_tmp u1_r = u1_r_tmp - end if + endif - end if ! end treating case with inflexion point on the left + endif ! end treating case with inflexion point on the left ! Move inflexion point on the right if ( inflexion_r == 1 ) then @@ -648,12 +648,12 @@ subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r u1_l = 3.0 * (u0_r - u0_l) / h u1_r = 0.0 - else if (u1_l_tmp*slope < 0.0) then + elseif (u1_l_tmp*slope < 0.0) then u1_r = u1_r_tmp u1_l = 3.0*(u0_r - u0_l)/h - 2.0*u1_r - else if (u1_r_tmp*slope < 0.0) then + elseif (u1_r_tmp*slope < 0.0) then u1_l = u1_l_tmp u1_r = 1.5*(u0_r - u0_l)/h - 0.5*u1_l @@ -663,17 +663,17 @@ subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r u1_l = u1_l_tmp u1_r = u1_r_tmp - end if + endif - end if ! end treating case with inflexion point on the right + endif ! end treating case with inflexion point on the right if ( abs(u1_l*h) < eps ) then u1_l = 0.0 - end if + endif if ( abs(u1_r*h) < eps ) then u1_r = 0.0 - end if + endif end subroutine monotonize_cubic diff --git a/src/ALE/PCM_functions.F90 b/src/ALE/PCM_functions.F90 index bcb963faa6..6d407b0cc5 100644 --- a/src/ALE/PCM_functions.F90 +++ b/src/ALE/PCM_functions.F90 @@ -56,7 +56,7 @@ subroutine PCM_reconstruction( N, u, ppoly_E, ppoly_coef ) ! The edge values are equal to the cell average do k = 1,N ppoly_E(k,:) = u(k) - end do + enddo end subroutine PCM_reconstruction diff --git a/src/ALE/PLM_functions.F90 b/src/ALE/PLM_functions.F90 index 73f9206c21..12cd558e60 100644 --- a/src/ALE/PLM_functions.F90 +++ b/src/ALE/PLM_functions.F90 @@ -102,7 +102,7 @@ subroutine PLM_reconstruction( N, h, u, ppoly_E, ppoly_coef, h_neglect ) ! Extrema in the mean values require a PCM reconstruction avoid generating ! larger extreme values. slope = 0.0 - end if + endif ! This block tests to see if roundoff causes edge values to be out of bounds u_min = min( u_l, u_c, u_r ) @@ -130,7 +130,7 @@ subroutine PLM_reconstruction( N, h, u, ppoly_E, ppoly_coef, h_neglect ) ppoly_E(k,1) = u_c - 0.5 * slope ppoly_E(k,2) = u_c + 0.5 * slope - end do ! end loop on interior cells + enddo ! end loop on interior cells ! Boundary cells use PCM. Extrapolation is handled in a later routine. slp(1) = 0. diff --git a/src/ALE/PPM_functions.F90 b/src/ALE/PPM_functions.F90 index d0eb8325ad..11dabad684 100644 --- a/src/ALE/PPM_functions.F90 +++ b/src/ALE/PPM_functions.F90 @@ -198,7 +198,7 @@ subroutine PPM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef, h_neglect) slope = 2.0 * ( u1 - u0 ) if ( abs(u1_r) > abs(slope) ) then u1_r = slope - end if + endif ! The right edge value in the boundary cell is taken to be the left ! edge value in the neighboring cell @@ -215,11 +215,11 @@ subroutine PPM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef, h_neglect) if ( exp1 > exp2 ) then u0_l = 3.0 * u0 - 2.0 * u0_r - end if + endif if ( exp1 < -exp2 ) then u0_r = 3.0 * u0 - 2.0 * u0_l - end if + endif ppoly_E(i0,1) = u0_l ppoly_E(i0,2) = u0_r @@ -251,7 +251,7 @@ subroutine PPM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef, h_neglect) slope = 2.0 * ( u1 - u0 ) if ( abs(u1_l) > abs(slope) ) then u1_l = slope - end if + endif ! The left edge value in the boundary cell is taken to be the right ! edge value in the neighboring cell @@ -268,11 +268,11 @@ subroutine PPM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef, h_neglect) if ( exp1 > exp2 ) then u0_l = 3.0 * u1 - 2.0 * u0_r - end if + endif if ( exp1 < -exp2 ) then u0_r = 3.0 * u1 - 2.0 * u0_l - end if + endif ppoly_E(i1,1) = u0_l ppoly_E(i1,2) = u0_r diff --git a/src/ALE/PQM_functions.F90 b/src/ALE/PQM_functions.F90 index 6c89c7ac10..3a4e517e57 100644 --- a/src/ALE/PQM_functions.F90 +++ b/src/ALE/PQM_functions.F90 @@ -83,7 +83,7 @@ subroutine PQM_reconstruction( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect ppoly_coef(k,4) = d ppoly_coef(k,5) = e - end do ! end loop on cells + enddo ! end loop on cells end subroutine PQM_reconstruction @@ -171,7 +171,7 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) slope = sign( min(abs(sigma_l),abs(sigma_c),abs(sigma_r)), sigma_c ) else slope = 0.0 - end if + endif ! If one of the slopes has the wrong sign compared with the ! limited PLM slope, it is set equal to the limited PLM slope @@ -186,7 +186,7 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) u1_r = 0.0 inflexion_l = -1 inflexion_r = -1 - end if + endif ! Edge values are bounded and averaged when discontinuous and not ! monotonic, edge slopes are consistent and the cell is not an extremum. @@ -232,12 +232,12 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) inflexion_l = 1 else inflexion_r = 1 - end if - end if + endif + endif ! If both x1 and x2 do not lie in [0,1], check whether ! only x1 lies in [0,1] - else if ( (x1 >= 0.0) .AND. (x1 <= 1.0) ) then + elseif ( (x1 >= 0.0) .AND. (x1 <= 1.0) ) then gradient1 = 4.0 * e * (x1**3) + 3.0 * d * (x1**2) + 2.0 * c * x1 + b @@ -249,11 +249,11 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) inflexion_l = 1 else inflexion_r = 1 - end if - end if + endif + endif ! If x1 does not lie in [0,1], check whether x2 lies in [0,1] - else if ( (x2 >= 0.0) .AND. (x2 <= 1.0) ) then + elseif ( (x2 >= 0.0) .AND. (x2 <= 1.0) ) then gradient2 = 4.0 * e * (x2**3) + 3.0 * d * (x2**2) + 2.0 * c * x2 + b @@ -265,12 +265,12 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) inflexion_l = 1 else inflexion_r = 1 - end if - end if + endif + endif - end if ! end checking where the inflexion points lie + endif ! end checking where the inflexion points lie - end if ! end checking if alpha1 != 0 AND rho >= 0 + endif ! end checking if alpha1 != 0 AND rho >= 0 ! If alpha1 is zero, the second derivative of the quartic reduces ! to a straight line @@ -289,14 +289,14 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) inflexion_l = 1 else inflexion_r = 1 - end if - end if ! check slope consistency + endif + endif ! check slope consistency - end if + endif - end if ! end check whether we can find the root of the straight line + endif ! end check whether we can find the root of the straight line - end if ! end checking whether to shift inflexion points + endif ! end checking whether to shift inflexion points ! At this point, we know onto which edge to shift inflexion points if ( inflexion_l == 1 ) then @@ -316,15 +316,15 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) u0_r = 5.0 * u_c - 4.0 * u0_l u1_r = 20.0 * (u_c - u0_l) / ( h_c + hNeglect ) - else if ( u1_r * slope < 0.0 ) then + elseif ( u1_r * slope < 0.0 ) then u1_r = 0.0 u0_l = (5.0*u_c - 3.0*u0_r) / 2.0 u1_l = 10.0 * (-u_c + u0_r) / (3.0 * h_c + hNeglect) - end if + endif - else if ( inflexion_r == 1 ) then + elseif ( inflexion_r == 1 ) then ! We modify the edge slopes so that both inflexion points ! collapse onto the right edge @@ -341,15 +341,15 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) u0_r = ( 5.0 * u_c - 3.0 * u0_l ) / 2.0 u1_r = 10.0 * (u_c - u0_l) / (3.0 * h_c + hNeglect) - else if ( u1_r * slope < 0.0 ) then + elseif ( u1_r * slope < 0.0 ) then u1_r = 0.0 u0_l = 5.0 * u_c - 4.0 * u0_r u1_l = 20.0 * ( -u_c + u0_r ) / (h_c + hNeglect) - end if + endif - end if ! clause to check where to collapse inflexion points + endif ! clause to check where to collapse inflexion points ! Save edge values and edge slopes for reconstruction ppoly_E(k,1) = u0_l @@ -357,7 +357,7 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) ppoly_S(k,1) = u1_l ppoly_S(k,2) = u1_r - end do ! end loop on interior cells + enddo ! end loop on interior cells ! Constant reconstruction within boundary cells ppoly_E(1,:) = u(1) @@ -431,7 +431,7 @@ subroutine PQM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef ) slope = 2.0 * ( u1 - u0 ) if ( abs(u1_r) > abs(slope) ) then u1_r = slope - end if + endif ! The right edge value in the boundary cell is taken to be the left ! edge value in the neighboring cell @@ -448,11 +448,11 @@ subroutine PQM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef ) if ( exp1 > exp2 ) then u0_l = 3.0 * u0 - 2.0 * u0_r - end if + endif if ( exp1 < -exp2 ) then u0_r = 3.0 * u0 - 2.0 * u0_l - end if + endif ppoly_E(i0,1) = u0_l ppoly_E(i0,2) = u0_r @@ -489,7 +489,7 @@ subroutine PQM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef ) slope = 2.0 * ( u1 - u0 ) if ( abs(u1_l) > abs(slope) ) then u1_l = slope - end if + endif ! The left edge value in the boundary cell is taken to be the right ! edge value in the neighboring cell @@ -506,11 +506,11 @@ subroutine PQM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef ) if ( exp1 > exp2 ) then u0_l = 3.0 * u1 - 2.0 * u0_r - end if + endif if ( exp1 < -exp2 ) then u0_r = 3.0 * u1 - 2.0 * u0_l - end if + endif ppoly_E(i1,1) = u0_l ppoly_E(i1,2) = u0_r @@ -636,7 +636,7 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coef, else u0_l = u_plm u1_l = slope / (h0 + hNeglect) - end if + endif ! Monotonize quartic inflexion_l = 0 @@ -664,18 +664,18 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coef, gradient1 = 4.0 * e * (x1**3) + 3.0 * d * (x1**2) + 2.0 * c * x1 + b if ( gradient1 * slope < 0.0 ) then inflexion_l = 1 - end if - end if + endif + endif x2 = 0.5 * ( - alpha2 + sqrt_rho ) / alpha1 if ( (x2 > 0.0) .and. (x2 < 1.0) ) then gradient2 = 4.0 * e * (x2**3) + 3.0 * d * (x2**2) + 2.0 * c * x2 + b if ( gradient2 * slope < 0.0 ) then inflexion_l = 1 - end if - end if + endif + endif - end if + endif if (( alpha1 == 0.0 ) .and. ( alpha2 /= 0.0 )) then @@ -684,10 +684,10 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coef, gradient1 = 3.0 * d * (x1**2) + 2.0 * c * x1 + b if ( gradient1 * slope < 0.0 ) then inflexion_l = 1 - end if - end if + endif + endif - end if + endif if ( inflexion_l == 1 ) then @@ -706,15 +706,15 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coef, u0_r = 5.0 * um - 4.0 * u0_l u1_r = 20.0 * (um - u0_l) / ( h0 + hNeglect ) - else if ( u1_r * slope < 0.0 ) then + elseif ( u1_r * slope < 0.0 ) then u1_r = 0.0 u0_l = (5.0*um - 3.0*u0_r) / 2.0 u1_l = 10.0 * (-um + u0_r) / (3.0 * h0 + hNeglect ) - end if + endif - end if + endif ! Store edge values, edge slopes and coefficients ppoly_E(i0,1) = u0_l @@ -789,7 +789,7 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coef, else u0_r = u_plm u1_r = slope / h1 - end if + endif ! Monotonize quartic inflexion_r = 0 @@ -817,18 +817,18 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coef, gradient1 = 4.0 * e * (x1**3) + 3.0 * d * (x1**2) + 2.0 * c * x1 + b if ( gradient1 * slope < 0.0 ) then inflexion_r = 1 - end if - end if + endif + endif x2 = 0.5 * ( - alpha2 + sqrt_rho ) / alpha1 if ( (x2 > 0.0) .and. (x2 < 1.0) ) then gradient2 = 4.0 * e * (x2**3) + 3.0 * d * (x2**2) + 2.0 * c * x2 + b if ( gradient2 * slope < 0.0 ) then inflexion_r = 1 - end if - end if + endif + endif - end if + endif if (( alpha1 == 0.0 ) .and. ( alpha2 /= 0.0 )) then @@ -837,10 +837,10 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coef, gradient1 = 3.0 * d * (x1**2) + 2.0 * c * x1 + b if ( gradient1 * slope < 0.0 ) then inflexion_r = 1 - end if - end if + endif + endif - end if + endif if ( inflexion_r == 1 ) then @@ -859,15 +859,15 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coef, u0_r = ( 5.0 * um - 3.0 * u0_l ) / 2.0 u1_r = 10.0 * (um - u0_l) / (3.0 * h1) - else if ( u1_r * slope < 0.0 ) then + elseif ( u1_r * slope < 0.0 ) then u1_r = 0.0 u0_l = 5.0 * um - 4.0 * u0_r u1_l = 20.0 * ( -um + u0_r ) / h1 - end if + endif - end if + endif ! Store edge values, edge slopes and coefficients ppoly_E(i1,1) = u0_l diff --git a/src/ALE/coord_rho.F90 b/src/ALE/coord_rho.F90 index d3141cfd2d..84bb9e5518 100644 --- a/src/ALE/coord_rho.F90 +++ b/src/ALE/coord_rho.F90 @@ -123,14 +123,14 @@ subroutine build_rho_column(CS, nz, depth, h, T, S, eqn_of_state, z_interface, & xTmp(1) = 0.0 do k = 1,count_nonzero_layers xTmp(k+1) = xTmp(k) + h_nv(k) - end do + enddo ! Compute densities on source column p(:) = CS%ref_pressure call calculate_density(T, S, p, densities, 1, nz, eqn_of_state) do k = 1,count_nonzero_layers densities(k) = densities(mapping(k)) - end do + enddo ! Based on source column density profile, interpolate to generate a new grid call build_and_interpolate_grid(CS%interp_CS, densities, count_nonzero_layers, & @@ -141,10 +141,10 @@ subroutine build_rho_column(CS, nz, depth, h, T, S, eqn_of_state, z_interface, & call old_inflate_layers_1d(CS%min_thickness, CS%nk, h_new) ! Comment: The following adjustment of h_new, and re-calculation of h_new via x1 needs to be removed - x1(1) = 0.0 ; do k = 1,CS%nk ; x1(k+1) = x1(k) + h_new(k) ; end do + x1(1) = 0.0 ; do k = 1,CS%nk ; x1(k+1) = x1(k) + h_new(k) ; enddo do k = 1,CS%nk h_new(k) = x1(k+1) - x1(k) - end do + enddo else ! count_nonzero_layers <= 1 if (nz == CS%nk) then @@ -231,12 +231,12 @@ subroutine build_rho_column_iteratively(CS, remapCS, nz, depth, h, T, S, eqn_of_ if ( count_nonzero_layers <= 1 ) then h1(:) = h0(:) exit ! stop iterations here - end if + endif xTmp(1) = 0.0 do k = 1,count_nonzero_layers xTmp(k+1) = xTmp(k) + hTmp(k) - end do + enddo ! Compute densities within current water column call calculate_density( T_tmp, S_tmp, p, densities,& @@ -244,7 +244,7 @@ subroutine build_rho_column_iteratively(CS, remapCS, nz, depth, h, T, S, eqn_of_ do k = 1,count_nonzero_layers densities(k) = densities(mapping(k)) - end do + enddo ! One regridding iteration ! Based on global density profile, interpolate to generate a new grid @@ -252,12 +252,12 @@ subroutine build_rho_column_iteratively(CS, remapCS, nz, depth, h, T, S, eqn_of_ hTmp, xTmp, CS%target_density, nz, h1, x1, h_neglect, h_neglect_edge) call old_inflate_layers_1d( CS%min_thickness, nz, h1 ) - x1(1) = 0.0 ; do k = 1,nz ; x1(k+1) = x1(k) + h1(k) ; end do + x1(1) = 0.0 ; do k = 1,nz ; x1(k+1) = x1(k) + h1(k) ; enddo ! Remap T and S from previous grid to new grid do k = 1,nz h1(k) = x1(k+1) - x1(k) - end do + enddo call remapping_core_h(remapCS, nz, h0, S, nz, h1, Tmp, h_neglect, h_neglect_edge) S_tmp(:) = Tmp(:) @@ -273,7 +273,7 @@ subroutine build_rho_column_iteratively(CS, remapCS, nz, depth, h, T, S, eqn_of_ x0(k) = x0(k-1) + h0(k-1) x1(k) = x1(k-1) + h1(k-1) deviation = deviation + (x0(k)-x1(k))**2 - end do + enddo deviation = sqrt( deviation / (nz-1) ) m = m + 1 @@ -281,7 +281,7 @@ subroutine build_rho_column_iteratively(CS, remapCS, nz, depth, h, T, S, eqn_of_ ! Copy final grid onto start grid for next iteration h0(:) = h1(:) - end do ! end regridding iterations + enddo ! end regridding iterations if (CS%integrate_downward_for_e) then zInterface(1) = 0. @@ -330,12 +330,12 @@ subroutine copy_finite_thicknesses(nk, h_in, threshold, nout, h_out, mapping) if (h_out(nout) > thickest_h_out) then thickest_h_out = h_out(nout) k_thickest = nout - end if + endif else ! Add up mass in vanished layers thickness_in_vanished = thickness_in_vanished + h_in(k) - end if - end do + endif + enddo ! No finite layers if (nout <= 1) return @@ -367,8 +367,8 @@ subroutine old_inflate_layers_1d( min_thickness, nk, h ) do k = 1,nk if ( h(k) > min_thickness ) then count_nonzero_layers = count_nonzero_layers + 1 - end if - end do + endif + enddo ! If all layer thicknesses are greater than the threshold, exit routine if ( count_nonzero_layers == nk ) return @@ -377,9 +377,9 @@ subroutine old_inflate_layers_1d( min_thickness, nk, h ) if ( count_nonzero_layers == 0 ) then do k = 1,nk h(k) = min_thickness - end do + enddo return - end if + endif ! Inflate zero layers correction = 0.0 @@ -388,8 +388,8 @@ subroutine old_inflate_layers_1d( min_thickness, nk, h ) delta = min_thickness - h(k) correction = correction + delta h(k) = h(k) + delta - end if - end do + endif + enddo ! Modify thicknesses of nonzero layers to ensure volume conservation maxThickness = h(1) @@ -398,8 +398,8 @@ subroutine old_inflate_layers_1d( min_thickness, nk, h ) if ( h(k) > maxThickness ) then maxThickness = h(k) k_found = k - end if - end do + endif + enddo h(k_found) = h(k_found) - correction diff --git a/src/ALE/polynomial_functions.F90 b/src/ALE/polynomial_functions.F90 index 0cc4eb0b71..78c75f53a0 100644 --- a/src/ALE/polynomial_functions.F90 +++ b/src/ALE/polynomial_functions.F90 @@ -45,7 +45,7 @@ real function evaluation_polynomial( coeff, ncoef, x ) f = 0.0 do k = 1,ncoef f = f + coeff(k) * ( x**(k-1) ) - end do + enddo evaluation_polynomial = f @@ -73,7 +73,7 @@ real function first_derivative_polynomial( coeff, ncoef, x ) f = 0.0 do k = 2,ncoef f = f + REAL(k-1)*coeff(k) * ( x**(k-2) ) - end do + enddo first_derivative_polynomial = f @@ -99,7 +99,7 @@ real function integration_polynomial( xi0, xi1, Coeff, npoly ) do k = 1,npoly+1 integral = integral + Coeff(k) * (xi1**k - xi0**k) / real(k) - end do + enddo ! !One non-answer-changing way of unrolling the above is: ! k=1 diff --git a/src/ALE/regrid_edge_slopes.F90 b/src/ALE/regrid_edge_slopes.F90 index e07f3c3bd5..59d36e3e0e 100644 --- a/src/ALE/regrid_edge_slopes.F90 +++ b/src/ALE/regrid_edge_slopes.F90 @@ -116,23 +116,23 @@ subroutine edge_slopes_implicit_h3( N, h, u, edge_slopes, h_neglect ) tri_b(i+1) = a * u(i) + b * u(i+1) - end do ! end loop on cells + enddo ! end loop on cells ! Boundary conditions: left boundary x(1) = 0.0 do i = 2,5 x(i) = x(i-1) + h(i-1) - end do + enddo do i = 1,4 do j = 1,4 Asys(i,j) = ( (x(i+1)**j) - (x(i)**j) ) / j - end do + enddo Bsys(i) = u(i) * ( h(i) ) - end do + enddo call solve_linear_system( Asys, Bsys, Csys, 4 ) @@ -148,17 +148,17 @@ subroutine edge_slopes_implicit_h3( N, h, u, edge_slopes, h_neglect ) x(1) = 0.0 do i = 2,5 x(i) = x(i-1) + h(N-5+i) - end do + enddo do i = 1,4 do j = 1,4 Asys(i,j) = ( (x(i+1)**j) - (x(i)**j) ) / j - end do + enddo Bsys(i) = u(N-4+i) * ( h(N-4+i) ) - end do + enddo call solve_linear_system( Asys, Bsys, Csys, 4 ) @@ -176,7 +176,7 @@ subroutine edge_slopes_implicit_h3( N, h, u, edge_slopes, h_neglect ) do i = 2,N edge_slopes(i,1) = tri_x(i) edge_slopes(i-1,2) = tri_x(i) - end do + enddo edge_slopes(1,1) = tri_x(1) edge_slopes(N,2) = tri_x(N+1) @@ -364,7 +364,7 @@ subroutine edge_slopes_implicit_h5( N, h, u, edge_slopes, h_neglect ) tri_u(k+1) = beta tri_b(k+1) = a * u(k-1) + b * u(k) + c * u(k+1) + d * u(k+2) - end do ! end loop on cells + enddo ! end loop on cells ! Use a right-biased stencil for the second row @@ -481,17 +481,17 @@ subroutine edge_slopes_implicit_h5( N, h, u, edge_slopes, h_neglect ) x(1) = 0.0 do i = 2,7 x(i) = x(i-1) + h(i-1) - end do + enddo do i = 1,6 do j = 1,6 Asys(i,j) = ( (x(i+1)**j) - (x(i)**j) ) / j - end do + enddo Bsys(i) = u(i) * h(i) - end do + enddo call solve_linear_system( Asys, Bsys, Csys, 6 ) @@ -621,17 +621,17 @@ subroutine edge_slopes_implicit_h5( N, h, u, edge_slopes, h_neglect ) x(1) = 0.0 do i = 2,7 x(i) = x(i-1) + h(N-7+i) - end do + enddo do i = 1,6 do j = 1,6 Asys(i,j) = ( (x(i+1)**j) - (x(i)**j) ) / j - end do + enddo Bsys(i) = u(N-6+i) * h(N-6+i) - end do + enddo call solve_linear_system( Asys, Bsys, Csys, 6 ) @@ -652,7 +652,7 @@ subroutine edge_slopes_implicit_h5( N, h, u, edge_slopes, h_neglect ) do i = 2,N edge_slopes(i,1) = tri_x(i) edge_slopes(i-1,2) = tri_x(i) - end do + enddo edge_slopes(1,1) = tri_x(1) edge_slopes(N,2) = tri_x(N+1) diff --git a/src/ALE/regrid_edge_values.F90 b/src/ALE/regrid_edge_values.F90 index d43cf5cc36..5fe4700c38 100644 --- a/src/ALE/regrid_edge_values.F90 +++ b/src/ALE/regrid_edge_values.F90 @@ -89,7 +89,7 @@ subroutine bound_edge_values( N, h, u, edge_val, h_neglect ) k0 = 1 k1 = 1 k2 = 2 - else if ( k == N ) then + elseif ( k == N ) then k0 = N-1 k1 = N k2 = N @@ -97,7 +97,7 @@ subroutine bound_edge_values( N, h, u, edge_val, h_neglect ) k0 = k-1 k1 = k k2 = k+1 - end if + endif ! All cells can now be treated equally h_l = h(k0) @@ -119,7 +119,7 @@ subroutine bound_edge_values( N, h, u, edge_val, h_neglect ) slope = sign( min(abs(sigma_l),abs(sigma_c),abs(sigma_r)), sigma_c ) else slope = 0.0 - end if + endif ! The limiter must be used in the local coordinate system to each cell. ! Hence, we must multiply the slope by h1. The multiplication by 0.5 is @@ -129,11 +129,11 @@ subroutine bound_edge_values( N, h, u, edge_val, h_neglect ) if ( (u_l-u0_l)*(u0_l-u_c) < 0.0 ) then u0_l = u_c - sign( min( abs(slope), abs(u0_l-u_c) ), slope ) - end if + endif if ( (u_r-u0_r)*(u0_r-u_c) < 0.0 ) then u0_r = u_c + sign( min( abs(slope), abs(u0_r-u_c) ), slope ) - end if + endif ! Finally bound by neighboring cell means in case of round off u0_l = max( min( u0_l, max(u_l, u_c) ), min(u_l, u_c) ) @@ -143,7 +143,7 @@ subroutine bound_edge_values( N, h, u, edge_val, h_neglect ) edge_val(k,1) = u0_l edge_val(k,2) = u0_r - end do ! loop on interior edges + enddo ! loop on interior edges end subroutine bound_edge_values @@ -178,9 +178,9 @@ subroutine average_discontinuous_edge_values( N, edge_val ) u0_avg = 0.5 * ( u0_minus + u0_plus ) edge_val(k,2) = u0_avg edge_val(k+1,1) = u0_avg - end if + endif - end do ! end loop on interior edges + enddo ! end loop on interior edges end subroutine average_discontinuous_edge_values @@ -224,9 +224,9 @@ subroutine check_discontinuous_edge_values( N, u, edge_val ) u0_avg = max( min( u0_avg, max(um_minus, um_plus) ), min(um_minus, um_plus) ) edge_val(k,2) = u0_avg edge_val(k+1,1) = u0_avg - end if + endif - end do ! end loop on interior edges + enddo ! end loop on interior edges end subroutine check_discontinuous_edge_values @@ -284,7 +284,7 @@ subroutine edge_values_explicit_h2( N, h, u, edge_val, h_neglect ) ! value of left cell edge_val(k-1,2) = edge_val(k,1) - end do ! end loop on interior cells + enddo ! end loop on interior cells ! Boundary edge values are simply equal to the boundary cell averages edge_val(1,1) = u(1) @@ -388,24 +388,24 @@ subroutine edge_values_explicit_h4( N, h, u, edge_val, h_neglect ) endif #endif - end do ! end loop on interior cells + enddo ! end loop on interior cells ! Determine first two edge values f1 = max( hNeglect, hMinFrac*sum(h(1:4)) ) x(1) = 0.0 do i = 2,5 x(i) = x(i-1) + max(f1, h(i-1)) - end do + enddo do i = 1,4 do j = 1,4 A(i,j) = ( (x(i+1)**j) - (x(i)**j) ) / real(j) - end do + enddo B(i) = u(i) * max(f1, h(i) ) - end do + enddo call solve_linear_system( A, B, C, 4 ) @@ -433,17 +433,17 @@ subroutine edge_values_explicit_h4( N, h, u, edge_val, h_neglect ) x(1) = 0.0 do i = 2,5 x(i) = x(i-1) + max(f1, h(N-5+i)) - end do + enddo do i = 1,4 do j = 1,4 A(i,j) = ( (x(i+1)**j) - (x(i)**j) ) / real(j) - end do + enddo B(i) = u(N-4+i) * max(f1, h(N-4+i) ) - end do + enddo call solve_linear_system( A, B, C, 4 ) @@ -461,10 +461,10 @@ subroutine edge_values_explicit_h4( N, h, u, edge_val, h_neglect ) do i = 1,4 do j = 1,4 A(i,j) = ( (x(i+1)**j) - (x(i)**j) ) / real(j) - end do + enddo write(0,*) A(i,:) B(i) = u(N-4+i) * ( h(N-4+i) ) - end do + enddo write(0,*) 'B=',B write(0,*) 'C=',C write(0,*) 'h(:N)=',h(N-3:N) @@ -561,24 +561,24 @@ subroutine edge_values_implicit_h4( N, h, u, edge_val, h_neglect ) tri_b(i+1) = a * u(i) + b * u(i+1) - end do ! end loop on cells + enddo ! end loop on cells ! Boundary conditions: left boundary h0 = max( hNeglect, hMinFrac*sum(h(1:4)) ) x(1) = 0.0 do i = 2,5 x(i) = x(i-1) + max( h0, h(i-1) ) - end do + enddo do i = 1,4 do j = 1,4 Asys(i,j) = ( (x(i+1)**j) - (x(i)**j) ) / j - end do + enddo Bsys(i) = u(i) * max( h0, h(i) ) - end do + enddo call solve_linear_system( Asys, Bsys, Csys, 4 ) @@ -591,17 +591,17 @@ subroutine edge_values_implicit_h4( N, h, u, edge_val, h_neglect ) x(1) = 0.0 do i = 2,5 x(i) = x(i-1) + max( h0, h(N-5+i) ) - end do + enddo do i = 1,4 do j = 1,4 Asys(i,j) = ( (x(i+1)**j) - (x(i)**j) ) / j - end do + enddo Bsys(i) = u(N-4+i) * max( h0, h(N-4+i) ) - end do + enddo call solve_linear_system( Asys, Bsys, Csys, 4 ) @@ -615,7 +615,7 @@ subroutine edge_values_implicit_h4( N, h, u, edge_val, h_neglect ) do i = 2,N edge_val(i,1) = tri_x(i) edge_val(i-1,2) = tri_x(i) - end do + enddo edge_val(1,1) = tri_x(1) edge_val(N,2) = tri_x(N+1) @@ -812,7 +812,7 @@ subroutine edge_values_implicit_h6( N, h, u, edge_val, h_neglect ) tri_u(k+1) = beta tri_b(k+1) = a * u(k-1) + b * u(k) + c * u(k+1) + d * u(k+2) - end do ! end loop on cells + enddo ! end loop on cells ! Use a right-biased stencil for the second row @@ -940,17 +940,17 @@ subroutine edge_values_implicit_h6( N, h, u, edge_val, h_neglect ) x(1) = 0.0 do i = 2,7 x(i) = x(i-1) + max( g, h(i-1) ) - end do + enddo do i = 1,6 do j = 1,6 Asys(i,j) = ( (x(i+1)**j) - (x(i)**j) ) / j - end do + enddo Bsys(i) = u(i) * max( g, h(i) ) - end do + enddo call solve_linear_system( Asys, Bsys, Csys, 6 ) @@ -1085,17 +1085,17 @@ subroutine edge_values_implicit_h6( N, h, u, edge_val, h_neglect ) x(1) = 0.0 do i = 2,7 x(i) = x(i-1) + max( g, h(N-7+i) ) - end do + enddo do i = 1,6 do j = 1,6 Asys(i,j) = ( (x(i+1)**j) - (x(i)**j) ) / j - end do + enddo Bsys(i) = u(N-6+i) * max( g, h(N-6+i) ) - end do + enddo call solve_linear_system( Asys, Bsys, Csys, 6 ) @@ -1110,7 +1110,7 @@ subroutine edge_values_implicit_h6( N, h, u, edge_val, h_neglect ) do i = 2,N edge_val(i,1) = tri_x(i) edge_val(i-1,2) = tri_x(i) - end do + enddo edge_val(1,1) = tri_x(1) edge_val(N,2) = tri_x(N+1) diff --git a/src/ALE/regrid_interp.F90 b/src/ALE/regrid_interp.F90 index d9d2a19228..fd445e7318 100644 --- a/src/ALE/regrid_interp.F90 +++ b/src/ALE/regrid_interp.F90 @@ -104,7 +104,7 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect ) if (extrapolate) then call P1M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs ) - end if + endif case ( INTERPOLATION_P1M_H4 ) degree = DEGREE_1 @@ -112,11 +112,11 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & call edge_values_explicit_h4( n0, h0, densities, ppoly0_E, h_neglect_edge ) else call edge_values_explicit_h2( n0, h0, densities, ppoly0_E, h_neglect_edge ) - end if + endif call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect ) if (extrapolate) then call P1M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs ) - end if + endif case ( INTERPOLATION_P1M_IH4 ) degree = DEGREE_1 @@ -124,18 +124,18 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & call edge_values_implicit_h4( n0, h0, densities, ppoly0_E, h_neglect_edge ) else call edge_values_explicit_h2( n0, h0, densities, ppoly0_E, h_neglect_edge ) - end if + endif call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect ) if (extrapolate) then call P1M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs ) - end if + endif case ( INTERPOLATION_PLM ) degree = DEGREE_1 call PLM_reconstruction( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect ) if (extrapolate) then call PLM_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect ) - end if + endif case ( INTERPOLATION_PPM_H4 ) if ( n0 >= 4 ) then @@ -145,15 +145,15 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & if (extrapolate) then call PPM_boundary_extrapolation( n0, h0, densities, ppoly0_E, & ppoly0_coefs, h_neglect ) - end if + endif else degree = DEGREE_1 call edge_values_explicit_h2( n0, h0, densities, ppoly0_E, h_neglect_edge ) call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect ) if (extrapolate) then call P1M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs ) - end if - end if + endif + endif case ( INTERPOLATION_PPM_IH4 ) if ( n0 >= 4 ) then @@ -163,15 +163,15 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & if (extrapolate) then call PPM_boundary_extrapolation( n0, h0, densities, ppoly0_E, & ppoly0_coefs, h_neglect ) - end if + endif else degree = DEGREE_1 call edge_values_explicit_h2( n0, h0, densities, ppoly0_E, h_neglect_edge ) call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect ) if (extrapolate) then call P1M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs ) - end if - end if + endif + endif case ( INTERPOLATION_P3M_IH4IH3 ) if ( n0 >= 4 ) then @@ -183,15 +183,15 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & if (extrapolate) then call P3M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_S, & ppoly0_coefs, h_neglect, h_neglect_edge ) - end if + endif else degree = DEGREE_1 call edge_values_explicit_h2( n0, h0, densities, ppoly0_E, h_neglect_edge ) call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect ) if (extrapolate) then call P1M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs ) - end if - end if + endif + endif case ( INTERPOLATION_P3M_IH6IH5 ) if ( n0 >= 6 ) then @@ -203,15 +203,15 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & if (extrapolate) then call P3M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_S, & ppoly0_coefs, h_neglect, h_neglect_edge ) - end if + endif else degree = DEGREE_1 call edge_values_explicit_h2( n0, h0, densities, ppoly0_E, h_neglect_edge ) call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect ) if (extrapolate) then call P1M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs ) - end if - end if + endif + endif case ( INTERPOLATION_PQM_IH4IH3 ) if ( n0 >= 4 ) then @@ -223,15 +223,15 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & if (extrapolate) then call PQM_boundary_extrapolation_v1( n0, h0, densities, ppoly0_E, ppoly0_S, & ppoly0_coefs, h_neglect ) - end if + endif else degree = DEGREE_1 call edge_values_explicit_h2( n0, h0, densities, ppoly0_E, h_neglect_edge ) call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect ) if (extrapolate) then call P1M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs ) - end if - end if + endif + endif case ( INTERPOLATION_PQM_IH6IH5 ) if ( n0 >= 6 ) then @@ -243,15 +243,15 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & if (extrapolate) then call PQM_boundary_extrapolation_v1( n0, h0, densities, ppoly0_E, ppoly0_S, & ppoly0_coefs, h_neglect ) - end if + endif else degree = DEGREE_1 call edge_values_explicit_h2( n0, h0, densities, ppoly0_E, h_neglect_edge ) call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect ) if (extrapolate) then call P1M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs ) - end if - end if + endif + endif end select end subroutine regridding_set_ppolys @@ -288,7 +288,7 @@ subroutine interpolate_grid( n0, h0, x0, ppoly0_E, ppoly0_coefs, & t = target_values(k) x1(k) = get_polynomial_coordinate ( n0, h0, x0, ppoly0_E, ppoly0_coefs, t, degree ) h1(k-1) = x1(k) - x1(k-1) - end do + enddo h1(n1) = x1(n1+1) - x1(n1) end subroutine interpolate_grid @@ -373,7 +373,7 @@ function get_polynomial_coordinate ( N, h, x_g, ppoly_E, ppoly_coefs, & if ( target_value <= ppoly_E(1,1) ) then x_tgt = x_g(1) return ! return because there is no need to look further - end if + endif ! Since discontinuous edge values are allowed, we check whether the target ! value lies between two discontinuous edge values at interior interfaces @@ -383,8 +383,8 @@ function get_polynomial_coordinate ( N, h, x_g, ppoly_E, ppoly_coefs, & x_tgt = x_g(k) return ! return because there is no need to look further exit - end if - end do + endif + enddo ! If the target value is outside the range of all values, we ! force the target coordinate to be equal to the lowest or @@ -392,7 +392,7 @@ function get_polynomial_coordinate ( N, h, x_g, ppoly_E, ppoly_coefs, & if ( target_value >= ppoly_E(N,2) ) then x_tgt = x_g(N+1) return ! return because there is no need to look further - end if + endif ! At this point, we know that the target value is bounded and does not ! lie between discontinuous, monotonic edge values. Therefore, @@ -404,8 +404,8 @@ function get_polynomial_coordinate ( N, h, x_g, ppoly_E, ppoly_coefs, & ( target_value < ppoly_E(k,2) ) ) then k_found = k exit - end if - end do + endif + enddo ! At this point, 'k_found' should be strictly positive. If not, this is ! a major failure because it means we could not find any target cell @@ -419,14 +419,14 @@ function get_polynomial_coordinate ( N, h, x_g, ppoly_E, ppoly_coefs, & 'inconsistent interpolant (perhaps not monotonically '//& 'increasing)' call MOM_error( FATAL, 'Aborting execution' ) - end if + endif ! Reset all polynomial coefficients to 0 and copy those pertaining to ! the found cell a(:) = 0.0 do i = 1,degree+1 a(i) = ppoly_coefs(k_found,i) - end do + enddo ! Guess value to start Newton-Raphson iterations (middle of cell) xi0 = 0.5 @@ -439,7 +439,7 @@ function get_polynomial_coordinate ( N, h, x_g, ppoly_E, ppoly_coefs, & if ( ( iter > NR_ITERATIONS ) .OR. & ( abs(delta) < NR_TOLERANCE ) ) then exit - end if + endif numerator = a(1) + a(2)*xi0 + a(3)*xi0*xi0 + a(4)*xi0*xi0*xi0 + & a(5)*xi0*xi0*xi0*xi0 - target_value @@ -459,16 +459,16 @@ function get_polynomial_coordinate ( N, h, x_g, ppoly_E, ppoly_coefs, & xi0 = 0.0 grad = a(2) if ( grad == 0.0 ) xi0 = xi0 + eps - end if + endif if ( xi0 > 1.0 ) then xi0 = 1.0 grad = a(2) + 2*a(3) + 3*a(4) + 4*a(5) if ( grad == 0.0 ) xi0 = xi0 - eps - end if + endif iter = iter + 1 - end do ! end Newton-Raphson iterations + enddo ! end Newton-Raphson iterations x_tgt = x_g(k_found) + xi0 * h(k_found) end function get_polynomial_coordinate diff --git a/src/ALE/regrid_solvers.F90 b/src/ALE/regrid_solvers.F90 index 7e44039831..18ef1e5e0b 100644 --- a/src/ALE/regrid_solvers.F90 +++ b/src/ALE/regrid_solvers.F90 @@ -63,16 +63,16 @@ subroutine solve_linear_system( A, B, X, system_size ) else ! Go to the next row to see ! if there is a valid pivot there k = k + 1 - end if + endif - end do ! end loop to find pivot + enddo ! end loop to find pivot ! If no pivot could be found, the system is singular and we need ! to end the execution if ( .NOT. found_pivot ) then write(0,*) ' A=',A call MOM_error( FATAL, 'The linear system is singular !' ) - end if + endif ! If the pivot is in a row that is different than row i, that is if ! k is different than i, we need to swap those two rows @@ -81,18 +81,18 @@ subroutine solve_linear_system( A, B, X, system_size ) swap_a = A(i,j) A(i,j) = A(k,j) A(k,j) = swap_a - end do + enddo swap_b = B(i) B(i) = B(k) B(k) = swap_b - end if + endif ! Transform pivot to 1 by dividing the entire row ! (right-hand side included) by the pivot pivot = A(i,i) do j = i,system_size A(i,j) = A(i,j) / pivot - end do + enddo B(i) = B(i) / pivot ! #INV: At this point, A(i,i) is a suitable pivot and it is equal to 1 @@ -103,11 +103,11 @@ subroutine solve_linear_system( A, B, X, system_size ) factor = A(k,i) do j = (i+1),system_size ! j is the column index A(k,j) = A(k,j) - factor * A(i,j) - end do + enddo B(k) = B(k) - factor * B(i) - end do + enddo - end do ! end loop on i + enddo ! end loop on i ! Solve system by back substituting @@ -116,9 +116,9 @@ subroutine solve_linear_system( A, B, X, system_size ) X(i) = B(i) do j = (i+1),system_size X(i) = X(i) - A(i,j) * X(j) - end do + enddo X(i) = X(i) / A(i,i) - end do + enddo end subroutine solve_linear_system @@ -147,18 +147,18 @@ subroutine solve_tridiagonal_system( Al, Ad, Au, B, X, system_size ) do k = 1,N-1 Al(k+1) = Al(k+1) / Ad(k) Ad(k+1) = Ad(k+1) - Al(k+1) * Au(k) - end do + enddo ! Forward sweep do k = 2,N B(k) = B(k) - Al(k) * B(k-1) - end do + enddo ! Backward sweep X(N) = B(N) / Ad(N) do k = N-1,1,-1 X(k) = ( B(k) - Au(k)*X(k+1) ) / Ad(k) - end do + enddo end subroutine solve_tridiagonal_system diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 9fca715e42..c1dcf4cf33 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2882,7 +2882,7 @@ subroutine extract_surface_state(CS, sfc_state) endif ! numberOfErrors endif ! localError endif ! mask2dT - enddo; enddo + enddo ; enddo call sum_across_PEs(numberOfErrors) if (numberOfErrors>0) then write(msg(1:240),'(3(a,i9,x))') 'There were a total of ',numberOfErrors, & diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 9d01f108d1..690fcb42e9 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -549,7 +549,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) vhm = 10.0*vhc elseif (abs(vhc) > c1*abs(vhm)) then if (abs(vhc) < c2*abs(vhm)) then ; vhc = (3.0*vhc+(1.0-c2*3.0)*vhm) - else if (abs(vhc) <= c3*abs(vhm)) then ; vhc = vhm + elseif (abs(vhc) <= c3*abs(vhm)) then ; vhc = vhm else ; vhc = slope*vhc+(1.0-c3*slope)*vhm endif endif diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index c430179917..a54d7bb01f 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -665,7 +665,7 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, & if (marginal) then ; h_u(I,j,k) = h_marg else ; h_u(I,j,k) = h_avg ; endif - enddo; enddo ; enddo + enddo ; enddo ; enddo if (present(visc_rem_u)) then !$OMP parallel do default(shared) do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh @@ -1948,7 +1948,7 @@ subroutine PPM_reconstruction_x(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_ slp(i,j) = sign(1.,slp(i,j)) * min(abs(slp(i,j)), 2. * min(dMx, dMn)) ! * (G%mask2dT(i-1,j) * G%mask2dT(i,j) * G%mask2dT(i+1,j)) endif - enddo; enddo + enddo ; enddo if (local_open_BC) then do n=1, OBC%number_of_segments @@ -1975,7 +1975,7 @@ subroutine PPM_reconstruction_x(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_ ! Left/right values following Eq. B2 in Lin 1994, MWR (132) h_L(i,j) = 0.5*( h_im1 + h_in(i,j) ) + oneSixth*( slp(i-1,j) - slp(i,j) ) h_R(i,j) = 0.5*( h_ip1 + h_in(i,j) ) + oneSixth*( slp(i,j) - slp(i+1,j) ) - enddo; enddo + enddo ; enddo endif if (local_open_BC) then diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 91f9f6546b..3668861db7 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -763,7 +763,7 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF) if (Je_obc>Js_obc) then OBC%segment(l_seg)%direction = OBC_DIRECTION_E - else if (Je_obcIs_obc) then OBC%segment(l_seg)%direction = OBC_DIRECTION_S - else if (Ie_obc0.) then + elseif (G%mask2dCu(I,j)>0.) then h_stack(:) = h(i+ishift,j,:) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src,segment%field(m)%dz_src(I,J,:), & segment%field(m)%buffer_src(I,J,:), & G%ke, h_stack, segment%field(m)%buffer_dst(I,J,:)) - else if (G%mask2dCu(I,j+1)>0.) then + elseif (G%mask2dCu(I,j+1)>0.) then h_stack(:) = h(i+ishift,j+1,:) call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src,segment%field(m)%dz_src(I,j,:), & @@ -2462,10 +2462,10 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (segment%field(m)%name == 'V') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) allocate(segment%field(m)%bt_vel(is_obc:ie_obc,js_obc:je_obc)) - else if (segment%field(m)%name == 'U') then + elseif (segment%field(m)%name == 'U') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc+1:je_obc,G%ke)) allocate(segment%field(m)%bt_vel(is_obc:ie_obc,js_obc+1:je_obc)) - else if (segment%field(m)%name == 'DVDX') then + elseif (segment%field(m)%name == 'DVDX') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) else allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc+1:je_obc,G%ke)) @@ -2474,10 +2474,10 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (segment%field(m)%name == 'U') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) allocate(segment%field(m)%bt_vel(is_obc:ie_obc,js_obc:je_obc)) - else if (segment%field(m)%name == 'V') then + elseif (segment%field(m)%name == 'V') then allocate(segment%field(m)%buffer_dst(is_obc+1:ie_obc,js_obc:je_obc,G%ke)) allocate(segment%field(m)%bt_vel(is_obc+1:ie_obc,js_obc:je_obc)) - else if (segment%field(m)%name == 'DUDY') then + elseif (segment%field(m)%name == 'DUDY') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) else allocate(segment%field(m)%buffer_dst(is_obc+1:ie_obc,js_obc:je_obc,G%ke)) @@ -2583,12 +2583,12 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (associated(segment%field(m)%buffer_dst)) then do k=1,nz; do j=js_obc2, je_obc; do i=is_obc2,ie_obc segment%tr_Reg%Tr(1)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k) - enddo; enddo; enddo + enddo ; enddo ; enddo if (.not. segment%tr_Reg%Tr(1)%is_initialized) then ! if the tracer reservoir has not yet been initialized, then set to external value. do k=1,nz; do j=js_obc2, je_obc; do i=is_obc2,ie_obc segment%tr_Reg%Tr(1)%tres(i,j,k) = segment%tr_Reg%Tr(1)%t(i,j,k) - enddo; enddo; enddo + enddo ; enddo ; enddo segment%tr_Reg%Tr(1)%is_initialized=.true. endif else @@ -2598,12 +2598,12 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (associated(segment%field(m)%buffer_dst)) then do k=1,nz; do j=js_obc2, je_obc; do i=is_obc2,ie_obc segment%tr_Reg%Tr(2)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k) - enddo; enddo; enddo + enddo ; enddo ; enddo if (.not. segment%tr_Reg%Tr(1)%is_initialized) then !if the tracer reservoir has not yet been initialized, then set to external value. do k=1,nz; do j=js_obc2, je_obc; do i=is_obc2,ie_obc segment%tr_Reg%Tr(2)%tres(i,j,k) = segment%tr_Reg%Tr(2)%t(i,j,k) - enddo; enddo; enddo + enddo ; enddo ; enddo segment%tr_Reg%Tr(1)%is_initialized=.true. endif else diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 7add057e0e..943ed8eb83 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -386,7 +386,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if ((CS%id_Tpot > 0) .or. (CS%id_tob > 0)) then do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = gsw_pt_from_ct(tv%S(i,j,k),tv%T(i,j,k)) - enddo; enddo ; enddo + enddo ; enddo ; enddo if (CS%id_Tpot > 0) call post_data(CS%id_Tpot, work_3d, CS%diag) if (CS%id_tob > 0) call post_data(CS%id_tob, work_3d(:,:,nz), CS%diag, mask=G%mask2dT) endif @@ -403,7 +403,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if ((CS%id_Sprac > 0) .or. (CS%id_sob > 0)) then do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = gsw_sp_from_sr(tv%S(i,j,k)) - enddo; enddo ; enddo + enddo ; enddo ; enddo if (CS%id_Sprac > 0) call post_data(CS%id_Sprac, work_3d, CS%diag) if (CS%id_sob > 0) call post_data(CS%id_sob, work_3d(:,:,nz), CS%diag, mask=G%mask2dT) endif @@ -718,19 +718,19 @@ subroutine find_weights(Rlist, R_in, k, nz, wt, wt_p) if ((k_lower == 1) .or. (R_in >= Rlist(k_lower))) exit k_upper = k_lower inc = inc*2 - end do + enddo else do k_upper = min(k_upper+inc, nz) if ((k_upper == nz) .or. (R_in < Rlist(k_upper))) exit k_lower = k_upper inc = inc*2 - end do + enddo endif if ((k_lower == 1) .and. (R_in <= Rlist(k_lower))) then k = 1 ; wt = 1.0 ; wt_p = 0.0 - else if ((k_upper == nz) .and. (R_in >= Rlist(k_upper))) then + elseif ((k_upper == nz) .and. (R_in >= Rlist(k_upper))) then k = nz-1 ; wt = 0.0 ; wt_p = 1.0 else do @@ -741,7 +741,7 @@ subroutine find_weights(Rlist, R_in, k, nz, wt, wt_p) else k_lower = k_new endif - end do + enddo ! Uncomment this as a code check ! if ((R_in < Rlist(k_lower)) .or. (R_in >= Rlist(k_upper)) .or. (k_upper-k_lower /= 1)) & diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 4db4d30c18..17427fb80f 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -234,7 +234,7 @@ subroutine MOM_sum_output_init(G, param_file, directory, ntrnc, & call get_filename_appendix(filename_appendix) if (len_trim(filename_appendix) > 0) then energyfile = trim(energyfile) //'.'//trim(filename_appendix) - end if + endif CS%energyfile = trim(slasher(directory))//trim(energyfile) call log_param(param_file, mdl, "output_path/ENERGYFILE", CS%energyfile) @@ -606,11 +606,11 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc else if ((CS%timeunit >= 0.99) .and. (CS%timeunit < 1.01)) then time_units = " [seconds] " - else if ((CS%timeunit >= 3599.0) .and. (CS%timeunit < 3601.0)) then + elseif ((CS%timeunit >= 3599.0) .and. (CS%timeunit < 3601.0)) then time_units = " [hours] " - else if ((CS%timeunit >= 86399.0) .and. (CS%timeunit < 86401.0)) then + elseif ((CS%timeunit >= 86399.0) .and. (CS%timeunit < 86401.0)) then time_units = " [days] " - else if ((CS%timeunit >= 3.0e7) .and. (CS%timeunit < 3.2e7)) then + elseif ((CS%timeunit >= 3.0e7) .and. (CS%timeunit < 3.2e7)) then time_units = " [years] " else write(time_units,'(9x,"[",es8.2," s] ")') CS%timeunit diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index ec4a78fc7b..9244b33738 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -120,7 +120,7 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & if (calc_modal_structure) then do k=1,nz; do j=js,je; do i=is,ie modal_structure(i,j,k) = 0.0 - enddo; enddo; enddo + enddo ; enddo ; enddo endif S => tv%S ; T => tv%T diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index dceed058f2..2df645c338 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -2341,7 +2341,7 @@ subroutine convert_temp_salt_for_TEOS10(T, S, press, G, kd, mask_z, EOS) ! S(i,j,k) = gsw_sa_from_sp(S(i,j,k),p,G%geoLonT(i,j),G%geoLatT(i,j)) T(i,j,k) = gsw_ct_from_pt(S(i,j,k),T(i,j,k)) endif - enddo; enddo; enddo + enddo ; enddo ; enddo end subroutine convert_temp_salt_for_TEOS10 ! Extractor routine for the EOS type if the members need to be accessed outside this module diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index fd880f6656..da90ef1ad7 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -198,7 +198,7 @@ integer function subchk(array, HI, di, dj, scale) do j=HI%jsc+dj,HI%jec+dj; do i=HI%isc+di,HI%iec+di bc = bitcount(abs(scale*array(i,j))) subchk = subchk + bc - enddo; enddo + enddo ; enddo call sum_across_PEs(subchk) subchk=mod(subchk,1000000000) end function subchk @@ -385,7 +385,7 @@ integer function subchk(array, HI, di, dj, scale) do J=HI%jsc+dj,HI%jec+dj; do I=HI%isc+di,HI%iec+di bc = bitcount(abs(scale*array(I,J))) subchk = subchk + bc - enddo; enddo + enddo ; enddo call sum_across_PEs(subchk) subchk=mod(subchk,1000000000) end function subchk @@ -573,7 +573,7 @@ integer function subchk(array, HI, di, dj, scale) do j=HI%jsc+dj,HI%jec+dj; do I=HI%isc+di,HI%iec+di bc = bitcount(abs(scale*array(I,j))) subchk = subchk + bc - enddo; enddo + enddo ; enddo call sum_across_PEs(subchk) subchk=mod(subchk,1000000000) end function subchk @@ -718,7 +718,7 @@ integer function subchk(array, HI, di, dj, scale) do J=HI%jsc+dj,HI%jec+dj; do i=HI%isc+di,HI%iec+di bc = bitcount(abs(scale*array(i,J))) subchk = subchk + bc - enddo; enddo + enddo ; enddo call sum_across_PEs(subchk) subchk=mod(subchk,1000000000) end function subchk diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 176e6e6d13..d4f8dbff57 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -225,7 +225,7 @@ subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug endif enddo enddo - else if (nfill == nfill_prev) then + elseif (nfill == nfill_prev) then print *,& 'Unable to fill missing points using either data at the same vertical level from a connected basin'//& 'or using a point from a previous vertical level. Make sure that the original data has some valid'//& @@ -236,7 +236,7 @@ subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug nfill = sum(fill_pts(is:ie,js:je)) call sum_across_PEs(nfill) - end do + enddo if (do_smooth) then do k=1,npass @@ -1010,7 +1010,7 @@ subroutine smooth_heights(zi,fill,bad,sor,niter,cyclic_x, tripolar_n) zi(:,:)=mp(1:ni,1:nj) mp = fill_boundaries(zi,cyclic_x,tripolar_n) -end do +enddo diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 079ac6ba3a..17ba449715 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -216,7 +216,7 @@ subroutine create_file(unit, filename, vars, novars, fields, threading, timeunit call MOM_error(WARNING, "MOM_io create_file: "//trim(vars(k)%name)//& " has unrecognized t_grid "//trim(vars(k)%t_grid)) end select - end do + enddo if ((use_lath .or. use_lonh .or. use_latq .or. use_lonq)) then if (.not.domain_set) call MOM_error(FATAL, "create_file: "//& @@ -260,13 +260,13 @@ subroutine create_file(unit, filename, vars, novars, fields, threading, timeunit ! Set appropriate units, depending on the value. if (timeunit < 0.0) then time_units = "days" ! The default value. - else if ((timeunit >= 0.99) .and. (timeunit < 1.01)) then + elseif ((timeunit >= 0.99) .and. (timeunit < 1.01)) then time_units = "seconds" - else if ((timeunit >= 3599.0) .and. (timeunit < 3601.0)) then + elseif ((timeunit >= 3599.0) .and. (timeunit < 3601.0)) then time_units = "hours" - else if ((timeunit >= 86399.0) .and. (timeunit < 86401.0)) then + elseif ((timeunit >= 86399.0) .and. (timeunit < 86401.0)) then time_units = "days" - else if ((timeunit >= 3.0e7) .and. (timeunit < 3.2e7)) then + elseif ((timeunit >= 3.0e7) .and. (timeunit < 3.2e7)) then time_units = "years" else write(time_units,'(es8.2," s")') timeunit diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 6944647008..bb34fe4985 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -869,7 +869,7 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV) seconds = seconds + 60*minute + 3600*hour if (year <= 9999) then write(restartname,'("_Y",I4.4,"_D",I3.3,"_S",I5.5)') year, days, seconds - else if (year <= 99999) then + elseif (year <= 99999) then write(restartname,'("_Y",I5.5,"_D",I3.3,"_S",I5.5)') year, days, seconds else write(restartname,'("_Y",I10.10,"_D",I3.3,"_S",I5.5)') year, days, seconds @@ -920,8 +920,8 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV) restartname = restartname(1:length-3)//'.'//trim(filename_appendix)//'.nc' else restartname = restartname(1:length) //'.'//trim(filename_appendix) - end if - end if + endif + endif restartpath = trim(directory)// trim(restartname) @@ -1453,8 +1453,8 @@ function open_restart_units(filename, directory, G, CS, units, file_paths, & restartname = restartname(1:length-3)//'.'//trim(filename_appendix)//'.nc' else restartname = restartname(1:length) //'.'//trim(filename_appendix) - end if - end if + endif + endif filepath = trim(directory) // trim(restartname) if (num_restart < 10) then diff --git a/src/framework/MOM_string_functions.F90 b/src/framework/MOM_string_functions.F90 index f56834a8f6..142134ddc5 100644 --- a/src/framework/MOM_string_functions.F90 +++ b/src/framework/MOM_string_functions.F90 @@ -42,7 +42,7 @@ function lowercase(input_string) do k=1, len_trim(input_string) if (lowercase(k:k) >= 'A' .and. lowercase(k:k) <= 'Z') & lowercase(k:k) = achar(ichar(lowercase(k:k))+co) - end do + enddo end function lowercase function uppercase(input_string) @@ -59,7 +59,7 @@ function uppercase(input_string) do k=1, len_trim(input_string) if (uppercase(k:k) >= 'a' .and. uppercase(k:k) <= 'z') & uppercase(k:k) = achar(ichar(uppercase(k:k))+co) - end do + enddo end function uppercase function left_int(i) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 94b628221c..6be4f7d0d3 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -1089,7 +1089,7 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) if (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then sponge_area = sponge_area + G%areaT(i,j) endif - enddo; enddo + enddo ; enddo ! take into account changes in mass (or thickness) when imposing ice shelf mass if (CS%shelf_mass_is_dynamic .and. CS%override_shelf_movement .and. & @@ -1125,7 +1125,7 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) shelf_mass1 = shelf_mass1 + (CS%mass_shelf(i,j) * CS%area_shelf_h(i,j)) endif - enddo; enddo + enddo ; enddo call mpp_sum(shelf_mass0); call mpp_sum(shelf_mass1) delta_mass_shelf = (shelf_mass1 - shelf_mass0)/CS%time_step ! delta_mass_shelf = (shelf_mass1 - shelf_mass0)* & @@ -1152,7 +1152,7 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) fluxes%sens(i,j) = fluxes%vprec(i,j) * CS%Cp * CS%T0 ! W /m^2 fluxes%salt_flux(i,j) = fluxes%vprec(i,j) * CS%S0*1.0e-3 ! kg (salt)/(m^2 s) endif - enddo; enddo + enddo ; enddo if (CS%DEBUG) then if (is_root_pe()) write(*,*)'Mean melt flux (kg/(m^2 s)),dt',mean_melt_flux,CS%time_step @@ -1679,12 +1679,12 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl endif - ! else if (CS%shelf_mass_is_dynamic) then + ! elseif (CS%shelf_mass_is_dynamic) then ! call initialize_ice_shelf_boundary ( CS%u_face_mask_boundary, CS%v_face_mask_boundary, & ! CS%u_flux_boundary_values, CS%v_flux_boundary_values, & ! CS%u_boundary_values, CS%v_boundary_values, CS%h_boundary_values, & ! CS%hmask, G, param_file) - end if + endif if (CS%shelf_mass_is_dynamic .and. .not. CS%override_shelf_movement) then ! the only reason to initialize boundary conds is if the shelf is dynamic @@ -1694,7 +1694,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl !MJH CS%u_boundary_values, CS%v_boundary_values, CS%h_boundary_values, & !MJH CS%hmask, G, param_file) - end if + endif if (new_sim .and. (.not. (CS%override_shelf_movement .and. CS%mass_from_file))) then @@ -5856,14 +5856,14 @@ subroutine savearray2(fname,A,flag) WRITE(fin) 'SECOND DIMENSION TOO LARGE' CLOSE(fin) RETURN -END IF +ENDIF DO i=1,M WRITE(ln,'(E17.9)') A(i,1) DO j=2,N WRITE(sing,'(E17.9)') A(i,j) ln = TRIM(ln) // ' ' // TRIM(sing) - END DO + ENDDO if (i == 1) THEN @@ -5889,14 +5889,14 @@ subroutine savearray2(fname,A,flag) FMT1 = TRIM(FMT1) // ')' - END IF + ENDIF WRITE(UNIT=fin,IOSTAT=iock,FMT=TRIM(FMT1)) TRIM(ln) if (iock /= 0) THEN - PRINT*,iock - END IF -END DO + PRINT *,iock + ENDIF +ENDDO CLOSE(FIN) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index ba84d55763..f59728af8f 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -538,7 +538,7 @@ subroutine set_grid_metrics_cartesian(G, param_file) if (units_temp(1:1) == 'k') then ! Axes are measured in km. dx_everywhere = 1000.0 * G%len_lon / (REAL(niglobal)) dy_everywhere = 1000.0 * G%len_lat / (REAL(njglobal)) - else if (units_temp(1:1) == 'm') then ! Axes are measured in m. + elseif (units_temp(1:1) == 'm') then ! Axes are measured in m. dx_everywhere = G%len_lon / (REAL(niglobal)) dy_everywhere = G%len_lat / (REAL(njglobal)) else ! Axes are measured in degrees of latitude and longitude. @@ -679,7 +679,7 @@ subroutine set_grid_metrics_spherical(G, param_file) ! G%dxBu(I,J) = G%Rad_Earth * dLon*PI_180 * COS( G%geoLatBu(I,J)*PI_180 ) G%dyBu(I,J) = G%Rad_Earth * dLat*PI_180 G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) - enddo; enddo + enddo ; enddo do J=JsdB,JedB ; do i=isd,ied G%geoLonCv(i,J) = grid_LonT(i) @@ -690,7 +690,7 @@ subroutine set_grid_metrics_spherical(G, param_file) G%dxCv(i,J) = G%Rad_Earth * COS( G%geoLatCv(i,J)*PI_180 ) * dL_di ! G%dxCv(i,J) = G%Rad_Earth * (dLon*PI_180) * COS( G%geoLatCv(i,J)*PI_180 ) G%dyCv(i,J) = G%Rad_Earth * dLat*PI_180 - enddo; enddo + enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB G%geoLonCu(I,j) = grid_lonB(I) @@ -701,7 +701,7 @@ subroutine set_grid_metrics_spherical(G, param_file) G%dxCu(I,j) = G%Rad_Earth * COS( G%geoLatCu(I,j)*PI_180 ) * dL_di ! G%dxCu(I,j) = G%Rad_Earth * dLon*PI_180 * COS( latitude ) G%dyCu(I,j) = G%Rad_Earth * dLat*PI_180 - enddo; enddo + enddo ; enddo do j=jsd,jed ; do i=isd,ied G%geoLonT(i,j) = grid_LonT(i) @@ -717,7 +717,7 @@ subroutine set_grid_metrics_spherical(G, param_file) ! dL_di = G%geoLatCv(i,max(jsd,J-1))*PI_180 ! In radians ! G%areaT(i,j) = Rad_Earth**2*dLon*dLat*ABS(SIN(latitude)-SIN(dL_di)) G%areaT(i,j) = G%dxT(i,j) * G%dyT(i,j) - enddo; enddo + enddo ; enddo call callTree_leave("set_grid_metrics_spherical()") end subroutine set_grid_metrics_spherical @@ -1207,7 +1207,7 @@ function Int_dj_dy(y, GP) if (y >= y_eq_enhance) then r = r + I_C0*0.5*(GP%lat_enhance_factor - 1.0)*y_eq_enhance - else if (y <= -y_eq_enhance) then + elseif (y <= -y_eq_enhance) then r = r - I_C0*0.5*(GP%lat_enhance_factor - 1.0)*y_eq_enhance else r = r + I_C0*0.5*(GP%lat_enhance_factor - 1.0) * & diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index b150b8c4ad..e818c33acd 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -1187,9 +1187,9 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file) call create_file(unit, trim(filepath), vars, nFlds_used, fields, & file_threading, dG=G) - do J=Jsq,Jeq; do I=Isq,Ieq; out_q(I,J) = G%geoLatBu(I,J); enddo; enddo + do J=Jsq,Jeq; do I=Isq,Ieq; out_q(I,J) = G%geoLatBu(I,J); enddo ; enddo call write_field(unit, fields(1), G%Domain%mpp_domain, out_q) - do J=Jsq,Jeq; do I=Isq,Ieq; out_q(I,J) = G%geoLonBu(I,J); enddo; enddo + do J=Jsq,Jeq; do I=Isq,Ieq; out_q(I,J) = G%geoLonBu(I,J); enddo ; enddo call write_field(unit, fields(2), G%Domain%mpp_domain, out_q) call write_field(unit, fields(3), G%Domain%mpp_domain, G%geoLatT) call write_field(unit, fields(4), G%Domain%mpp_domain, G%geoLonT) @@ -1210,7 +1210,7 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file) do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = G%dyCv(i,J) ; enddo ; enddo call write_field(unit, fields(10), G%Domain%mpp_domain, out_v) - do j=js,je ; do i=is,ie ; out_h(i,j) = G%dxT(i,j); enddo; enddo + do j=js,je ; do i=is,ie ; out_h(i,j) = G%dxT(i,j); enddo ; enddo call write_field(unit, fields(11), G%Domain%mpp_domain, out_h) do j=js,je ; do i=is,ie ; out_h(i,j) = G%dyT(i,j) ; enddo ; enddo call write_field(unit, fields(12), G%Domain%mpp_domain, out_h) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 49153586b7..491c806a6b 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1709,18 +1709,18 @@ subroutine initialize_temp_salt_linear(T, S, G, param_file, just_read_params) ! S(:,:,1) = S_top ! do k = 2,G%ke ! S(:,:,k) = S(:,:,k-1) + delta_S -! end do +! enddo do k = 1,G%ke S(:,:,k) = S_top - S_range*((real(k)-0.5)/real(G%ke)) T(:,:,k) = T_top - T_range*((real(k)-0.5)/real(G%ke)) - end do + enddo ! ! Prescribe temperature ! delta_T = T_range / ( G%ke - 1.0 ) ! T(:,:,1) = T_top ! do k = 2,G%ke ! T(:,:,k) = T(:,:,k-1) + delta_T -! end do +! enddo ! delta = 1 ! T(:,:,G%ke/2 - (delta-1):G%ke/2 + delta) = 1.0 @@ -1848,7 +1848,7 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, ! apply the sponges, along with the interface heights. ! call initialize_sponge(Idamp, eta, G, param_file, CSp) deallocate(eta) - else if (.not. new_sponges) then ! ALE mode + elseif (.not. new_sponges) then ! ALE mode call field_size(filename,eta_var,siz,no_domain=.true.) if (siz(1) /= G%ieg-G%isg+1 .or. siz(2) /= G%jeg-G%jsg+1) & @@ -1872,7 +1872,7 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, enddo ; enddo ; enddo do k=1,nz; do j=js,je ; do i=is,ie h(i,j,k) = eta(i,j,k)-eta(i,j,k+1) - enddo ; enddo; enddo + enddo ; enddo ; enddo call initialize_ALE_sponge(Idamp, G, param_file, ALE_CSp, h, nz_data) deallocate(eta) deallocate(h) @@ -1910,7 +1910,7 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, call set_up_sponge_field(tmp, tv%T, G, nz, CSp) call MOM_read_data(filename, salin_var, tmp(:,:,:), G%Domain) call set_up_sponge_field(tmp, tv%S, G, nz, CSp) - else if (use_temperature) then + elseif (use_temperature) then call set_up_ALE_sponge_field(filename, potemp_var, Time, G, tv%T, ALE_CSp) call set_up_ALE_sponge_field(filename, salin_var, Time, G, tv%S, ALE_CSp) endif diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index 373062ffc3..8d022d97cc 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -408,7 +408,7 @@ function bisect_fast(a, x, lo, hi) result(bi_r) if (PRESENT(lo)) then where (lo>0) lo_=lo -end if +endif if (PRESENT(hi)) then where (hi>0) hi_=hi endif @@ -950,7 +950,7 @@ subroutine smooth_heights(zi,fill,bad,sor,niter,cyclic_x, tripolar_n) zi(:,:)=mp(1:ni,1:nj) mp = fill_boundaries(zi,cyclic_x,tripolar_n) -end do +enddo return diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 2672308fd7..de5a97363b 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -308,15 +308,15 @@ subroutine init_oda(Time, G, GV, CS) do i=1, CS%ni; do j=1, CS%nj if ( global2D(i,j) > 1 ) then T_grid%mask(i,j,k) = 1.0 - end if - end do; end do + endif + enddo ; enddo if (k == 1) then T_grid%z(:,:,k) = global2D/2 else T_grid%z(:,:,k) = T_grid%z(:,:,k-1) + (global2D + global2D_old)/2 - end if + endif global2D_old = global2D - end do + enddo call ocean_da_core_init(CS%mpp_domain, T_grid, CS%Profiles, Time) @@ -363,7 +363,7 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) CS%nk, CS%h(i,j,:), T(i,j,:)) call remapping_core_h(CS%remapCS, GV%ke, h(i,j,:), tv%S(i,j,:), & CS%nk, CS%h(i,j,:), S(i,j,:)) - enddo; enddo + enddo ; enddo do m=1,CS%ensemble_size call mpp_redistribute(CS%domains(m)%mpp_domain, T,& @@ -449,7 +449,7 @@ subroutine get_posterior_tracer(Time, CS, G, GV, h, tv, increment) used=send_data(CS%Ocean_posterior%id_s(m), CS%Ocean_posterior%S(isc:iec,jsc:jec,:,m), CS%Time) endif endif - end do + enddo tv => CS%tv h => CS%h @@ -479,7 +479,7 @@ subroutine oda(Time, CS) !! switch back to ensemble member pelist call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:)) - end if + endif return end subroutine oda diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index c4e771375c..11798d3bdb 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -433,7 +433,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, else do j=js-2,je+2 ; do I=Isq-1,Ieq+1 h_u(I,j) = 0.5 * (h(i,j,k) + h(i+1,j,k)) - enddo; enddo + enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=is-2,ie+2 h_v(i,J) = 0.5 * (h(i,j,k) + h(i,j+1,k)) enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 076dab7b56..3be1ae6192 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -284,7 +284,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & do j=jsd,jed ; do i=isd,ied ; test(i,j,1) = 1.0 ; test(i,j,2) = 0.0 ; enddo ; enddo do m=1,CS%nMode ; do fr=1,CS%nFreq call create_group_pass(pass_En, CS%En(:,:,:,fr,m), G%domain) - enddo; enddo + enddo ; enddo call create_group_pass(pass_test, test(:,:,1), test(:,:,2), G%domain, stagger=AGRID) call start_group_pass(pass_test, G%domain) @@ -920,7 +920,7 @@ subroutine refract(En, cn, freq, dt, G, NAngle, use_PPMang) call MOM_error(WARNING, "refract: CFL exceeds 1.", .true.) if (CFL_ang(i,j,A) > 0.0) then ; CFL_ang(i,j,A) = 1.0 ; else ; CFL_ang(i,j,A) = -1.0 ; endif endif - enddo; enddo + enddo ; enddo ! Advect in angular space if (.not.use_PPMang) then @@ -931,7 +931,7 @@ subroutine refract(En, cn, freq, dt, G, NAngle, use_PPMang) else Flux_E(i,A) = CFL_ang(i,j,A) * En2d(i,A+1) endif - enddo; enddo + enddo ; enddo else ! Use PPM do i=is,ie @@ -1109,7 +1109,7 @@ subroutine propagate(En, cn, freq, dt, G, CS, NAngle) ! Apply the propagation WITH CORNER ADVECTION/FINITE VOLUME APPROACH. LB%jsh = js ; LB%jeh = je ; LB%ish = is ; LB%ieh = ie call propagate_corner_spread(En(:,:,a), a, NAngle, speed, dt, G, CS, LB) - end do ! a-loop + enddo ! a-loop else ! IMPLEMENT PPM ADVECTION IN HORIZONTAL----------------------- ! These could be in the control structure, as they do not vary. @@ -1436,7 +1436,7 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS enddo ! m-loop ! update energy in cell En(i,j) = sum(E_new)/Nsubrays - enddo; enddo + enddo ; enddo end subroutine propagate_corner_spread ! #@# This subroutine needs a doxygen description @@ -2069,7 +2069,7 @@ subroutine PPM_reconstruction_x(h_in, h_l, h_r, G, LB, simple_2nd) slp(i,j) = sign(1.,slp(i,j)) * min(abs(slp(i,j)), 2. * min(dMx, dMn)) ! * (G%mask2dT(i-1,j) * G%mask2dT(i,j) * G%mask2dT(i+1,j)) endif - enddo; enddo + enddo ; enddo do j=jsl,jel ; do i=isl,iel ! Neighboring values should take into account any boundaries. The 3 @@ -2081,7 +2081,7 @@ subroutine PPM_reconstruction_x(h_in, h_l, h_r, G, LB, simple_2nd) ! Left/right values following Eq. B2 in Lin 1994, MWR (132) h_l(i,j) = 0.5*( h_im1 + h_in(i,j) ) + oneSixth*( slp(i-1,j) - slp(i,j) ) h_r(i,j) = 0.5*( h_ip1 + h_in(i,j) ) + oneSixth*( slp(i,j) - slp(i+1,j) ) - enddo; enddo + enddo ; enddo endif call PPM_limit_pos(h_in, h_l, h_r, 0.0, G, isl, iel, jsl, jel) @@ -2502,7 +2502,7 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS) ! will be multiplied by N and En to get into [W m-2] CS%TKE_itidal_loss_fixed(i,j) = 0.5*kappa_h2_factor*GV%Rho0*& kappa_itides * h2(i,j) - enddo; enddo + enddo ; enddo ! Read in prescribed coast/ridge/shelf angles from file call get_param(param_file, mdl, "REFL_ANGLE_FILE", refl_angle_file, & @@ -2556,7 +2556,7 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS) do i=isd,ied; do j=jsd,jed if (ridge_temp(i,j) == 1) then; CS%refl_dbl(i,j) = .true. else ; CS%refl_dbl(i,j) = .false. ; endif - enddo; enddo + enddo ; enddo ! Read in prescribed land mask from file (if overwriting -BDM). ! This should be done in MOM_initialize_topography subroutine diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 308b7ca9b6..93aeb6f750 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -198,7 +198,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ allocate(CS%Ref_h%p(CS%nz_data,CS%num_col)) do col=1,CS%num_col ; do K=1,CS%nz_data CS%Ref_h%p(K,col) = data_h(CS%col_i(col),CS%col_j(col),K) - enddo; enddo + enddo ; enddo endif total_sponge_cols = CS%num_col @@ -224,7 +224,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ Iresttime_u(I,j) = 0.5 * (Iresttime(i,j) + Iresttime(i+1,j)) if ((Iresttime_u(I,j)>0.0) .and. (G%mask2dCu(I,j)>0)) & CS%num_col_u = CS%num_col_u + 1 - enddo; enddo + enddo ; enddo if (CS%num_col_u > 0) then @@ -247,7 +247,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ allocate(CS%Ref_hu%p(CS%nz_data,CS%num_col_u)) do col=1,CS%num_col_u ; do K=1,CS%nz_data CS%Ref_hu%p(K,col) = data_hu(CS%col_i_u(col),CS%col_j_u(col),K) - enddo; enddo + enddo ; enddo endif total_sponge_cols_u = CS%num_col_u call sum_across_PEs(total_sponge_cols_u) @@ -261,7 +261,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ Iresttime_v(i,J) = 0.5 * (Iresttime(i,j) + Iresttime(i,j+1)) if ((Iresttime_v(i,J)>0.0) .and. (G%mask2dCv(i,J)>0)) & CS%num_col_v = CS%num_col_v + 1 - enddo; enddo + enddo ; enddo if (CS%num_col_v > 0) then @@ -400,7 +400,7 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) Iresttime_u(I,j) = 0.5 * (Iresttime(i,j) + Iresttime(i+1,j)) if ((Iresttime_u(I,j)>0.0) .and. (G%mask2dCu(I,j)>0)) & CS%num_col_u = CS%num_col_u + 1 - enddo; enddo + enddo ; enddo if (CS%num_col_u > 0) then @@ -432,7 +432,7 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) Iresttime_v(i,J) = 0.5 * (Iresttime(i,j) + Iresttime(i,j+1)) if ((Iresttime_v(i,J)>0.0) .and. (G%mask2dCv(i,J)>0)) & CS%num_col_v = CS%num_col_v + 1 - enddo; enddo + enddo ; enddo if (CS%num_col_v > 0) then @@ -863,7 +863,7 @@ subroutine apply_ALE_sponge(h, dt, G, CS, Time) ! u points do j=CS%jsc,CS%jec; do I=CS%iscB,CS%iecB; do k=1,nz hu(I,j,k) = 0.5 * (h(i,j,k) + h(i+1,j,k)) - enddo; enddo; enddo + enddo ; enddo ; enddo if (CS%new_sponges) then if (.not. present(Time)) & @@ -935,7 +935,7 @@ subroutine apply_ALE_sponge(h, dt, G, CS, Time) ! v points do J=CS%jscB,CS%jecB; do i=CS%isc,CS%iec; do k=1,nz hv(i,J,k) = 0.5 * (h(i,j,k) + h(i,j+1,k)) - enddo; enddo; enddo + enddo ; enddo ; enddo do c=1,CS%num_col_v i = CS%col_i_v(c) ; j = CS%col_j_v(c) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index c0289bbd79..2861218128 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -401,7 +401,7 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive, Waves) 'Constant value to enhance VT2 in KPP.', & default=1.0) endif - end if + endif call closeParameterBlock(paramFile) call get_param(paramFile, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 201588a2c2..7eafb011bd 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -1343,7 +1343,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & h_prev = h_ent ; h_ent = h_prev+dh_Newt if (h_ent > h_max) then h_ent = 0.5*(h_prev+h_max) - else if (h_ent < h_min) then + elseif (h_ent < h_min) then h_ent = 0.5*(h_prev+h_min) endif diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index afdebe4ae5..2678b18e1a 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -1091,7 +1091,7 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & ColHt_chg = ColHt_core * y1 if (ColHt_chg < 0.0) PE_chg = PE_chg - pres * ColHt_chg if (present(ColHt_cor)) ColHt_cor = -pres * min(ColHt_chg, 0.0) - else if (present(ColHt_cor)) then + elseif (present(ColHt_cor)) then y1 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) ColHt_cor = -pres * min(ColHt_core * y1, 0.0) endif diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 89a11217fa..a58773d066 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -1710,7 +1710,7 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & ColHt_chg = ColHt_core * y1 if (ColHt_chg < 0.0) PE_chg = PE_chg - pres * ColHt_chg if (present(ColHt_cor)) ColHt_cor = -pres * min(ColHt_chg, 0.0) - else if (present(ColHt_cor)) then + elseif (present(ColHt_cor)) then y1 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) ColHt_cor = -pres * min(ColHt_core * y1, 0.0) endif diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index c9f10826db..5f3f982dd1 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -736,7 +736,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & F(i,k) = MIN(F(i,k), ds_dsp1(i,k)*( ((F(i,k-1) + & dsp1_ds(i,k-1)*F(i,k-1)) - F(i,k-2)) + (h(i,j,k-1) - Angstrom))) F(i,k) = MAX(F(i,k),MIN(minF(i,k),0.0)) - else if (k == kb(i)+1) then + elseif (k == kb(i)+1) then F(i,k) = MIN(F(i,k), ds_dsp1(i,k)*( ((F(i,k-1) + eakb(i)) - & eb_kmb(i)) + (h(i,j,k-1) - Angstrom))) F(i,k) = MAX(F(i,k),MIN(minF(i,k),0.0)) @@ -791,7 +791,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & ea(i,j,k) = ea(i,j,k) - dsp1_ds(i,k)*F_cor eb(i,j,k) = eb(i,j,k) + F_cor - else if ((k==kb(i)) .and. (F(i,k) > 0.0)) then + elseif ((k==kb(i)) .and. (F(i,k) > 0.0)) then ! Rho_cor is the density anomaly that needs to be corrected, ! taking into account that the true potential density of the ! deepest buffer layer is not exactly what is returned as dS_kb. @@ -817,7 +817,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & ea(i,j,k) = ea(i,j,k) + ea_cor eb(i,j,k) = eb(i,j,k) - (dS_kb(i) * I_dSkbp1(i)) * ea_cor - else if (k < kb(i)) then + elseif (k < kb(i)) then ! Repetative, unless ea(kb) has been corrected. ea(i,j,k) = ea(i,j,k+1) endif @@ -1007,7 +1007,7 @@ subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb, ! elsewhere, so F should always be nonnegative. ea(i,j,k) = dsp1_ds(i,k)*F(i,k) eb(i,j,k) = F(i,k) - else if (k == kb(i)) then + elseif (k == kb(i)) then ea(i,j,k) = eakb(i) eb(i,j,k) = F(i,k) elseif (k == kb(i)-1) then diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index e65af9183c..3c9188b6bb 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -372,7 +372,7 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide) ! Compute the fixed part of internal tidal forcing; units are [J m-2] here. CS%TKE_itidal_coef(i,j) = 0.5*kappa_h2_factor*GV%Rho0*& kappa_itides * itide%h2(i,j) * itide%tideamp(i,j)**2 - enddo; enddo + enddo ; enddo CS%id_TKE_itidal = register_diag_field('ocean_model','TKE_itidal_itide',diag%axesT1,Time, & diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 2952d9ac9b..ef6c160f9f 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -295,7 +295,7 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) chl_in(i,j,k), i, j, k, G%geoLonT(i,j), G%geoLatT(i,j) call MOM_error(FATAL,"MOM_opacity opacity_from_chl: "//trim(mesg)) endif - enddo; enddo; enddo + enddo ; enddo ; enddo else ! Only the 2-d surface chlorophyll can be read in from a file. The ! same value is assumed for all layers. diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index cc772bdb53..9906083597 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -391,7 +391,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & visc%Kd_extra_T(i,j,k) = 0.0 visc%Kd_extra_S(i,j,k) = 0.0 endif - enddo; enddo + enddo ; enddo if (associated(dd%KT_extra)) then ; do K=1,nz+1 ; do i=is,ie dd%KT_extra(i,j,K) = KT_extra(i,K) enddo ; enddo ; endif diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index e50d5db614..ec0b5a80b3 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -643,7 +643,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (oldfn >= ustarsq) then cycle - else if ((oldfn + Dfn) <= ustarsq) then + elseif ((oldfn + Dfn) <= ustarsq) then Dh = h_at_vel(i,k) else Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn)/Dfn) @@ -659,7 +659,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (oldfn >= ustarsq) then cycle - else if ((oldfn + Dfn) <= ustarsq) then + elseif ((oldfn + Dfn) <= ustarsq) then Dh = h_at_vel(i,k) else Dh = h_at_vel(i,k) * sqrt((ustarsq-oldfn)/Dfn) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 2fc99c48fc..1bb8eb48dd 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -273,14 +273,14 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, " "//trim(int_tide_profile_str)//" unavailable in CVMix. Available "//& "profiles in CVMix are "//trim(SIMMONS_PROFILE_STRING)//" and "//& trim(SCHMITTNER_PROFILE_STRING)//".") - else if (.not.CS%use_CVMix_tidal .and. (CS%int_tide_profile == SIMMONS_04.or. & + elseif (.not.CS%use_CVMix_tidal .and. (CS%int_tide_profile == SIMMONS_04.or. & CS%int_tide_profile == SCHMITTNER)) then call MOM_error(FATAL, "tidal_mixing_init: Tidal mixing profiles "// & trim(SIMMONS_PROFILE_STRING)//" and "//trim(SCHMITTNER_PROFILE_STRING)//& " are available only when USE_CVMix_TIDAL is True.") endif - else if (CS%use_CVMix_tidal) then + elseif (CS%use_CVMix_tidal) then call MOM_error(FATAL, "tidal_mixing_init: Cannot set INT_TIDE_DISSIPATION to False "// & "when USE_CVMix_TIDAL is set to True.") endif @@ -294,7 +294,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, if (CS%use_CVMix_tidal) then call MOM_error(FATAL, "tidal_mixing_init: Lee wave driven dissipation scheme cannot "// & "be used when CVMix tidal mixing scheme is active.") - end if + endif call get_param(param_file, mdl, "LEE_WAVE_PROFILE", tmpstr, & "LEE_WAVE_PROFILE selects the vertical profile of energy \n"//& "dissipation with LEE_WAVE_DISSIPATION. Valid values are:\n"//& @@ -325,7 +325,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, if (CS%use_CVMix_tidal) then call MOM_error(FATAL, "tidal_mixing_init: Polzin scheme cannot "// & "be used when CVMix tidal mixing scheme is active.") - end if + endif call get_param(param_file, mdl, "NU_POLZIN", CS%Nu_Polzin, & "When the Polzin decay profile is used, this is a \n"//& "non-dimensional constant in the expression for the \n"//& @@ -407,7 +407,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, if (CS%use_CVMix_tidal) then call MOM_error(FATAL, "tidal_mixing_init: Tidal amplitude files are "// & "not compatible with CVMix tidal mixing. ") - end if + endif call get_param(param_file, mdl, "TIDEAMP_FILE", tideamp_file, & "The path to the file containing the spatially varying \n"//& "tidal amplitudes with INT_TIDE_DISSIPATION.", default="tideamp.nc") @@ -438,7 +438,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, ! Compute the fixed part of internal tidal forcing; units are [kg s-2] here. CS%TKE_itidal(i,j) = 0.5*CS%kappa_h2_factor*GV%Rho0*& CS%kappa_itides*CS%h2(i,j)*utide*utide - enddo; enddo + enddo ; enddo endif diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 4226e4fa8c..5f9a8f8281 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1373,7 +1373,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, CS) do k=1,nz ; do I=Isq,Ieq ; if (abs(u(I,j,k)) > maxvel) then u(I,j,k) = SIGN(truncvel,u(I,j,k)) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - endif ; enddo ; enddo + endif ; enddo ; enddo endif ; endif enddo ! j-loop else ! Do not report accelerations leading to large velocities. @@ -1408,7 +1408,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, CS) call write_u_accel(I, j, u_old, h, ADp, CDp, dt, G, GV, CS%PointAccel_CSp, & vel_report(I,j), -vel_report(I,j), forces%taux(I,j)*dt_Rho0, & a=CS%a_u(:,j,:), hv=CS%h_u(:,j,:)) - endif ; enddo; enddo + endif ; enddo ; enddo endif if (len_trim(CS%v_trunc_file) > 0) then @@ -1459,7 +1459,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, CS) do k=1,nz ; do i=is,ie ; if (abs(v(i,J,k)) > maxvel) then v(i,J,k) = SIGN(truncvel,v(i,J,k)) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - endif ; enddo ; enddo + endif ; enddo ; enddo endif ; endif enddo ! J-loop else ! Do not report accelerations leading to large velocities. @@ -1494,7 +1494,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, CS) call write_v_accel(i, J, v_old, h, ADp, CDp, dt, G, GV, CS%PointAccel_CSp, & vel_report(i,J), -vel_report(i,J), forces%tauy(i,J)*dt_Rho0, & a=CS%a_v(:,J,:),hv=CS%h_v(:,J,:)) - endif ; enddo; enddo + endif ; enddo ; enddo endif end subroutine vertvisc_limit_vel diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 38f3f4ee57..d8f6b9a972 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -214,7 +214,7 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, h, diag, OBC, CS, & ! This adds the stripes of tracer to every layer. CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + tr_y enddo - enddo; enddo; enddo + enddo ; enddo ; enddo if (NTR > 7) then do j=js,je ; do i=is,ie diff --git a/src/tracer/MOM_OCMIP2_CO2calc.F90 b/src/tracer/MOM_OCMIP2_CO2calc.F90 index 8c2809418d..aa87c19e73 100644 --- a/src/tracer/MOM_OCMIP2_CO2calc.F90 +++ b/src/tracer/MOM_OCMIP2_CO2calc.F90 @@ -421,7 +421,7 @@ function drtsafe(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf, & swap=fl fl=fh fh=swap -end if +endif drtsafe=0.5*(x1+x2) dxold=abs(x2-x1) dx=dxold @@ -446,7 +446,7 @@ function drtsafe(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf, & ! write (6,*) 'Exiting drtsafe at B on iteration ', j, ', ph = ', -log10(drtsafe) return endif - end if + endif if (abs(dx) < xacc) then ! write (6,*) 'Exiting drtsafe at C on iteration ', j, ', ph = ', -log10(drtsafe) return @@ -459,7 +459,7 @@ function drtsafe(k0, k1, k2, kb, k1p, k2p, k3p, ksi, kw, ks, kf, & else xh=drtsafe fh=f - end if + endif enddo !} j return diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 65000627ef..91d96bcc65 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -298,7 +298,7 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, h, param_file, dia !Jasmin does not want to apply the maximum for now !if (tr_ptr(i,j,k) > g_tracer%src_var_valid_max) tr_ptr(i,j,k) = g_tracer%src_var_valid_max endif - enddo; enddo ; enddo + enddo ; enddo ; enddo !jgj: Reset CASED to 0 below K=1 if (trim(g_tracer_name) == 'cased') then @@ -306,7 +306,7 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, h, param_file, dia if (tr_ptr(i,j,k) /= CS%tracer_land_val) then tr_ptr(i,j,k) = 0.0 endif - enddo; enddo ; enddo + enddo ; enddo ; enddo endif elseif(.not. g_tracer%requires_restart) then !Do nothing for this tracer, it is initialized by the tracer package @@ -521,12 +521,12 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, rho_dzt(:,:,:) = GV%H_to_kg_m2 * GV%Angstrom do k = 1, nk ; do j = jsc, jec ; do i = isc, iec !{ rho_dzt(i,j,k) = GV%H_to_kg_m2 * h_old(i,j,k) - enddo; enddo ; enddo !} + enddo ; enddo ; enddo !} dzt(:,:,:) = 1.0 do k = 1, nk ; do j = jsc, jec ; do i = isc, iec !{ dzt(i,j,k) = GV%H_to_m * h_old(i,j,k) - enddo; enddo ; enddo !} + enddo ; enddo ; enddo !} do j=jsc,jec ; do i=isc,iec surface_field(i,j) = tv%S(i,j,1) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index b3232c1bca..00e97deb8a 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -394,14 +394,14 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, h, T, S, CS) hEff_sum(:,:) = 0. do k = 1,CS%nsurf-1 ; do j=G%jsc,G%jec ; do i=G%isc-1,G%iec hEff_sum(i,j) = hEff_sum(i,j) + CS%uhEff(i,j,k) - enddo ; enddo; enddo + enddo ; enddo ; enddo call post_data(CS%id_uhEff_2d, hEff_sum, CS%diag) endif if (CS%id_vhEff_2d>0) then hEff_sum(:,:) = 0. do k = 1,CS%nsurf-1 ; do j=G%jsc-1,G%jec ; do i=G%isc,G%iec hEff_sum(i,j) = hEff_sum(i,j) + CS%vhEff(i,j,k) - enddo ; enddo; enddo + enddo ; enddo ; enddo call post_data(CS%id_vhEff_2d, hEff_sum, CS%diag) endif diff --git a/src/tracer/MOM_neutral_diffusion_aux.F90 b/src/tracer/MOM_neutral_diffusion_aux.F90 index 1ecfd7a25a..94ffe5234c 100644 --- a/src/tracer/MOM_neutral_diffusion_aux.F90 +++ b/src/tracer/MOM_neutral_diffusion_aux.F90 @@ -507,7 +507,7 @@ real function refine_nondim_position(CS, T_ref, S_ref, alpha_ref, beta_ref, P_to fa = fb fb = fc fc = fa - end if + endif tol = 2. * machep * abs ( sb ) + CS%xtol m = 0.5 * ( c - sb ) if ( abs ( m ) <= tol .or. fb == 0. ) then @@ -526,12 +526,12 @@ real function refine_nondim_position(CS, T_ref, S_ref, alpha_ref, beta_ref, P_to r = fb / fc p = s0 * ( 2. * m * q * ( q - r ) - ( sb - sa ) * ( r - 1. ) ) q = ( q - 1. ) * ( r - 1. ) * ( s0 - 1. ) - end if + endif if ( 0. < p ) then q = - q else p = - p - end if + endif s0 = e e = d if ( 2. * p < 3. * m * q - abs ( tol * q ) .and. & @@ -540,17 +540,17 @@ real function refine_nondim_position(CS, T_ref, S_ref, alpha_ref, beta_ref, P_to else e = m d = e - end if - end if + endif + endif sa = sb fa = fb if ( tol < abs ( d ) ) then sb = sb + d - else if ( 0. < m ) then + elseif ( 0. < m ) then sb = sb + tol else sb = sb - tol - end if + endif call drho_at_pos(CS, T_ref, S_ref, alpha_ref, beta_ref, P_top, P_bot, ppoly_T, ppoly_S, & sb, fb) if ( ( 0. < fb .and. 0. < fc ) .or. & @@ -559,7 +559,7 @@ real function refine_nondim_position(CS, T_ref, S_ref, alpha_ref, beta_ref, P_to fc = fa e = sb - sa d = e - end if + endif enddo ! Modified from original to ensure that the minimum is found fa = ABS(fa) ; fb = ABS(fb) ; fc = ABS(fc) diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 4c63ea2b33..deb395bc4a 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -252,7 +252,7 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) else h2d(i,k) = GV%H_subroundoff endif - enddo; enddo + enddo ; enddo ! Distribute flux. Note min/max is intended to make sure that the mass transport ! does not deplete a cell @@ -320,7 +320,7 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) else h2d(j,k) = GV%H_subroundoff endif - enddo; enddo + enddo ; enddo ! Distribute flux evenly throughout a column do j=js-1,je diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 8da247186e..a821219cd5 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -607,7 +607,7 @@ real function remaining_transport_sum(CS, uhtr, vhtr) if (ABS(vhtr(i,J,k))>vh_neglect) then remaining_transport_sum = remaining_transport_sum + ABS(vhtr(i,J,k)) endif - enddo; enddo; enddo + enddo ; enddo ; enddo call sum_across_PEs(remaining_transport_sum) end function remaining_transport_sum @@ -852,15 +852,15 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 eatr_sub(i,j,k) = eatr(i,j,k) ebtr_sub(i,j,k) = ebtr(i,j,k) - enddo; enddo ; enddo + enddo ; enddo ; enddo do k = 1, nz ; do j=js-1,je+1 ; do i=is-2,ie+1 uhtr_sub(I,j,k) = uhtr(I,j,k) - enddo; enddo ; enddo + enddo ; enddo ; enddo do k = 1, nz ; do j=js-2,je+1 ; do i=is-1,ie+1 vhtr_sub(i,J,k) = vhtr(i,J,k) - enddo; enddo ; enddo + enddo ; enddo ; enddo ! Calculate 3d mass transports to be used in this iteration @@ -881,7 +881,7 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) - enddo; enddo; enddo + enddo ; enddo ; enddo call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) @@ -898,7 +898,7 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) - enddo; enddo; enddo + enddo ; enddo ; enddo call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) @@ -922,15 +922,15 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 eatr(i,j,k) = eatr(i,j,k) - eatr_sub(i,j,k) ebtr(i,j,k) = ebtr(i,j,k) - ebtr_sub(i,j,k) - enddo; enddo ; enddo + enddo ; enddo ; enddo do k = 1, nz ; do j=js-1,je+1 ; do i=is-2,ie+1 uhtr(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) - enddo; enddo ; enddo + enddo ; enddo ; enddo do k = 1, nz ; do j=js-2,je+1 ; do i=is-1,ie+1 vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) - enddo; enddo ; enddo + enddo ; enddo ; enddo call pass_var(eatr,G%Domain) call pass_var(ebtr,G%Domain) @@ -946,7 +946,7 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, sum_v = sum_v + abs(vhtr(i,J-1,k))+abs(vhtr(I,J,k)) sum_abs_fluxes = sum_abs_fluxes + abs(eatr(i,j,k)) + abs(ebtr(i,j,k)) + abs(uhtr(I-1,j,k)) + & abs(uhtr(I,j,k)) + abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k)) - enddo; enddo; enddo + enddo ; enddo ; enddo call sum_across_PEs(sum_abs_fluxes) print *, "Remaining u-flux, v-flux:", sum_u, sum_v @@ -958,7 +958,7 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, ! Switch order of Strang split every iteration z_first = .not. z_first x_before_y = .not. x_before_y - end do + enddo end subroutine offline_advection_layer @@ -1025,7 +1025,7 @@ subroutine update_offline_fields(CS, h, fluxes, do_ale) if (CS%G%mask2dT(i,j)<1.0) then CS%h_end(i,j,k) = CS%GV%Angstrom endif - enddo; enddo ; enddo + enddo ; enddo ; enddo do k=1,nz+1 ; do j=js,je ; do i=is,ie CS%Kd(i,j,k) = max(0.0, CS%Kd(i,j,k)) @@ -1038,13 +1038,13 @@ subroutine update_offline_fields(CS, h, fluxes, do_ale) if (CS%G%mask2dCv(i,J)<1.0) then CS%vhtr(i,J,k) = 0.0 endif - enddo; enddo ; enddo + enddo ; enddo ; enddo do k=1,nz ; do j=js,je ; do I=is-1,ie if (CS%G%mask2dCu(I,j)<1.0) then CS%uhtr(I,j,k) = 0.0 endif - enddo; enddo ; enddo + enddo ; enddo ; enddo if (CS%debug) then call uvchksum("[uv]htr_sub after update_offline_fields", CS%uhtr, CS%vhtr, CS%G%HI) diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index f61b5a6a5e..7f9b975863 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -85,18 +85,18 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & !$OMP h_old,convert_flux,h_neglect,eb,tr) & !$OMP private(sink,h_minus_dsink,b_denom_1,b1,d1,h_tr,c1) !$OMP do - do j=js,je; do i=is,ie ; sfc_src(i,j) = 0.0 ; btm_src(i,j) = 0.0 ; enddo; enddo + do j=js,je; do i=is,ie ; sfc_src(i,j) = 0.0 ; btm_src(i,j) = 0.0 ; enddo ; enddo if (present(sfc_flux)) then if (convert_flux) then !$OMP do do j = js, je; do i = is,ie sfc_src(i,j) = (sfc_flux(i,j)*dt) * GV%kg_m2_to_H - enddo; enddo + enddo ; enddo else !$OMP do do j = js, je; do i = is,ie sfc_src(i,j) = sfc_flux(i,j) - enddo; enddo + enddo ; enddo endif endif if (present(btm_flux)) then @@ -104,12 +104,12 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & !$OMP do do j = js, je; do i = is,ie btm_src(i,j) = (btm_flux(i,j)*dt) * GV%kg_m2_to_H - enddo; enddo + enddo ; enddo else !$OMP do do j = js, je; do i = is,ie btm_src(i,j) = btm_flux(i,j) - enddo; enddo + enddo ; enddo endif endif @@ -271,7 +271,7 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim if (present(in_flux_optional)) then do j=js,je ; do i=is,ie in_flux(i,j) = in_flux_optional(i,j) - enddo; enddo + enddo ; enddo endif if (present(out_flux_optional)) then do j=js,je ; do i=is,ie diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 491803c4e5..0edc123d26 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -723,7 +723,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & tmp = h_srt(i,k2-1,j) ; h_srt(i,k2-1,j) = h_srt(i,k2,j) ; h_srt(i,k2,j) = tmp enddo endif ; enddo - enddo; enddo + enddo ; enddo !$OMP do do j=js-1,je+1 max_srt(j) = 0 diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index d2cc4dafbb..68fbd3fdd0 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -233,7 +233,7 @@ subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_C z_bot = z_bot + h(i,j,k)*GV%H_to_m enddo endif - enddo; enddo + enddo ; enddo enddo end subroutine initialize_dye_tracer @@ -312,7 +312,7 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS z_bot = z_bot + h_new(i,j,k)*GV%H_to_m enddo endif - enddo; enddo + enddo ; enddo enddo end subroutine dye_tracer_column_physics diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index b3f595f175..36e503e10c 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -301,7 +301,7 @@ subroutine initialize_oil_tracer(restart, day, G, GV, h, diag, OBC, CS, & CS%oil_source_i=i CS%oil_source_j=j endif - enddo; enddo + enddo ; enddo CS%Time => day CS%diag => diag diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 8e6443ae4a..b4d317d289 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -75,10 +75,10 @@ subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) g_prime(k) = (Rlay(k) - Rlay(k-1))*GV%g_earth/GV%rho0 else g_prime(k) = GV%g_earth - end if + endif !Rlay(:) = 0.0 !g_prime(:) = 0.0 - end do + enddo if (first_call) call write_BFB_log(param_file) diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 7aa2943ff0..e3aa923179 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -202,12 +202,12 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) ! density in kg m-3 that is being restored toward. if (G%geoLatT(i,j) < CS%lfrslat) then Temp_restore = CS%SST_s - else if (G%geoLatT(i,j) > CS%lfrnlat) then + elseif (G%geoLatT(i,j) > CS%lfrnlat) then Temp_restore = CS%SST_n else Temp_restore = (CS%SST_s - CS%SST_n)/(CS%lfrslat - CS%lfrnlat) * & (G%geoLatT(i,j) - CS%lfrslat) + CS%SST_s - end if + endif density_restore = Temp_restore*CS%drho_dt + CS%Rho0 diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 0e9a18ffad..3b30e2ee31 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -71,7 +71,7 @@ subroutine DOME2d_initialize_topography ( D, G, param_file, max_depth ) if ( x <= l1 ) then D(i,j) = bay_depth * max_depth - else if (( x > l1 ) .and. ( x < l2 )) then + elseif (( x > l1 ) .and. ( x < l2 )) then D(i,j) = bay_depth * max_depth + (1.0-bay_depth) * max_depth * & ( x - l1 ) / (l2 - l1) else @@ -453,7 +453,7 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) h(i,j,k) = eta1D(k) - eta1D(k+1) endif enddo - enddo; enddo + enddo ; enddo ! Store the grid on which the T/S sponge data will reside call initialize_ALE_sponge(Idamp, G, param_file, ACSp, h, nz) diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index b8d46798e4..34ef50b8cb 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -238,7 +238,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par do j=js,je ; do i=is,ie delta_h = G%bathyT(i,j) / dfloat(nz) h(i,j,:) = GV%m_to_H * delta_h - end do ; end do + enddo ; enddo case default call MOM_error(FATAL,"isomip_initialize: "// & @@ -570,7 +570,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) do j=js,je ; do i=is,ie delta_h = G%bathyT(i,j) / dfloat(nz) h(i,j,:) = delta_h - end do ; end do + enddo ; enddo case default call MOM_error(FATAL,"ISOMIP_initialize_sponges: "// & diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index a41e3b55a2..c464a2b1f6 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -798,14 +798,14 @@ subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) temp_x(i,j)=0.0 temp_y(i,j)=0.0 endif - enddo; enddo + enddo ; enddo ! Interpolate to u/v grids do j = G%jsc,G%jec ; do I = G%IscB,G%IecB CS%STKx0(I,j,b) = 0.5 * (temp_x(i,j) + temp_x(i+1,j)) - enddo; enddo + enddo ; enddo do j = G%JscB,G%JecB ; do i = G%isc,G%iec CS%STKy0(i,J,b) = 0.5 * (temp_y(i,j) + temp_y(i,j+1)) - enddo; enddo + enddo ; enddo ! Disperse into halo on u/v grids call pass_vector(CS%STKx0(:,:,b),CS%STKy0(:,:,b), G%Domain, To_ALL) enddo @@ -895,7 +895,7 @@ subroutine get_Langmuir_Number( LA, G, GV, HBL, USTAR, I, J, & if (.not.(WaveMethod==LF17)) then LA = max(0.1,sqrt(USTAR/(LA_STK+1.e-8))) - end if + endif if (LA_Misalignment) then WaveDirection = atan2(LA_STKy,LA_STKx) diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 736e6d662b..83740a1d61 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -310,14 +310,14 @@ subroutine Phillips_initialize_topography(D, G, param_file, max_depth) D(i,j) = Htop*sin(PI*(G%geoLonT(i,j)-x1)/(x2-x1))**2 if (G%geoLatT(i,j)>y1 .and. G%geoLatT(i,j)x3 .and. G%geoLonT(i,j)x3 .and. G%geoLonT(i,j)y1 .and. G%geoLatT(i,j) 0. .and. x > (1. - east_sponge_width)) then + elseif (east_sponge_time_scale > 0. .and. x > (1. - east_sponge_width)) then dist = 1. - (1. - x) / east_sponge_width Idamp(i,j) = 1. / east_sponge_time_scale * max(0., min(1., dist)) endif diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index e2bc9b5869..b19afec76c 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -177,7 +177,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param do j=js,je ; do i=is,ie delta_h = G%bathyT(i,j) / dfloat(nz) h(i,j,:) = delta_h - end do ; end do + enddo ; enddo end select diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index 2eeda73243..839918270d 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -162,7 +162,7 @@ subroutine dumbbell_buoyancy_forcing(state, fluxes, day, dt, G, CS) ((CS%S_restore(i,j) - state%SSS(i,j)) / & (0.5 * (CS%S_restore(i,j) + state%SSS(i,j)))) - end if + endif enddo ; enddo endif ! end RESTOREBUOY @@ -234,7 +234,7 @@ subroutine dumbbell_dynamic_forcing(state, fluxes, day, dt, G, CS) G%mask2dT(i,j) * sin(deg_rad*(rdays/CS%slp_period)) fluxes%p_surf_full(i,j) = CS%forcing_mask(i,j) * CS%slp_amplitude * & G%mask2dT(i,j) * sin(deg_rad*(rdays/CS%slp_period)) - enddo; enddo + enddo ; enddo @@ -339,7 +339,7 @@ subroutine dumbbell_surface_forcing_init(Time, G, param_file, diag, CS) if ((x>0.25)) then CS%forcing_mask(i,j) = 1 CS%S_restore(i,j) = CS%S_surf + CS%S_range - else if ((x<-0.25)) then + elseif ((x<-0.25)) then CS%forcing_mask(i,j) = 1 CS%S_restore(i,j) = CS%S_surf - CS%S_range endif diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 790185d0ee..017a36bc9a 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -178,7 +178,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param do j=js,je ; do i=is,ie delta_h = G%bathyT(i,j) / dfloat(nz) h(i,j,:) = GV%m_to_H * delta_h - end do ; end do + enddo ; enddo end select diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index a33718b243..14f31e6916 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -101,7 +101,7 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param ! Define uniform interfaces do k = 0,nz z_unif(k+1) = -real(k)/real(nz) - end do + enddo ! 1. Define stratification n = 3 @@ -117,17 +117,17 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param if ( x <= x1 ) then t = y1*x/x1 - else if ( (x > x1 ) .and. ( x < x2 )) then + elseif ( (x > x1 ) .and. ( x < x2 )) then t = y1 + (y2-y1) * (x-x1) / (x2-x1) else t = y2 + (1.0-y2) * (x-x2) / (1.0-x2) - end if + endif t = - z_unif(k) z_inter(k) = -t * G%max_depth - end do + enddo ! 2. Define displacement a0 = 75.0; ! Displacement amplitude (meters) @@ -140,15 +140,15 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param if ( k == 1 ) then displ(k) = 0.0 - end if + endif if ( k == nz+1 ) then displ(k) = 0.0 - end if + endif z_inter(k) = z_inter(k) + displ(k) - end do + enddo ! 3. The last interface must coincide with the seabed z_inter(nz+1) = -G%bathyT(i,j) @@ -159,9 +159,9 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param if ( z_inter(k) < (z_inter(k+1) + GV%Angstrom_Z) ) then z_inter(k) = z_inter(k+1) + GV%Angstrom_Z - end if + endif - end do + enddo ! 4. Define layers total_height = 0.0 @@ -169,7 +169,7 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param h(i,j,k) = GV%m_to_H * (z_inter(k) - z_inter(k+1)) total_height = total_height + h(i,j,k) - end do + enddo enddo ; enddo @@ -234,7 +234,7 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file !S(:,:,1) = S_ref !do k = 2,G%ke ! S(:,:,k) = S(:,:,k-1) + delta_S - !end do + !enddo deltah = G%max_depth / nz do j=js,je ; do i=is,ie @@ -252,7 +252,7 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file T(:,:,1) = T_ref do k = 2,G%ke T(:,:,k) = T(:,:,k-1) + delta_T - end do + enddo kdelta = 2 T(:,:,G%ke/2 - (kdelta-1):G%ke/2 + kdelta) = 1.0 diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index 1d4981a003..c9e7eec40e 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -55,7 +55,7 @@ subroutine soliton_initialize_thickness(h, G, GV) val4 = val2*((2.0*val3/(1.0+(val3*val3)))**2) h(i,j,k) = GV%m_to_H * (0.25*val4 * (6.0*y*y+3.0) * exp(-0.5*y*y)) enddo - end do ; end do + enddo ; enddo end subroutine soliton_initialize_thickness From 5490e5a0856182d6f9dac46046bb757718b8e08d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 7 May 2018 15:22:40 -0400 Subject: [PATCH 0203/1072] dOxyGenized MOM_coms.F90 Added dOxyGen comments for all routines and arguments in MOM_coms.F90. All answers are bitwise identical. --- src/framework/MOM_coms.F90 | 166 +++++++++++++++++++++++++++---------- 1 file changed, 122 insertions(+), 44 deletions(-) diff --git a/src/framework/MOM_coms.F90 b/src/framework/MOM_coms.F90 index cae5303c96..467a7483a4 100644 --- a/src/framework/MOM_coms.F90 +++ b/src/framework/MOM_coms.F90 @@ -45,27 +45,46 @@ module MOM_coms module procedure reproducing_sum_2d, reproducing_sum_3d end interface reproducing_sum -! The Extended Fixed Point (EFP) type provides a public interface for doing -! sums and taking differences with this type. +! The Extended Fixed Point (EFP) type provides a public interface for doing sums +! and taking differences with this type. The use of this type is documented in +! Hallberg, R. & A. Adcroft, 2014: An Order-invariant Real-to-Integer Conversion Sum. +! Parallel Computing, 40(5-6), doi:10.1016/j.parco.2014.04.007. type, public :: EFP_type ; private integer(kind=8), dimension(ni) :: v end type EFP_type -interface operator (+); module procedure EFP_plus ; end interface -interface operator (-); module procedure EFP_minus ; end interface +interface operator (+) ; module procedure EFP_plus ; end interface +interface operator (-) ; module procedure EFP_minus ; end interface interface assignment(=); module procedure EFP_assign ; end interface contains +!> This subroutine uses a conversion to an integer representation of real numbers to give an +!! order-invariant sum of distributed 2-D arrays that reproduces across domain decomposition. +!! This technique is described in Hallberg & Adcroft, 2014, Parallel Computing, +!! doi:10.1016/j.parco.2014.04.007. function reproducing_sum_2d(array, isr, ier, jsr, jer, EFP_sum, reproducing, & overflow_check, err) result(sum) - real, dimension(:,:), intent(in) :: array - integer, optional, intent(in) :: isr, ier, jsr, jer - type(EFP_type), optional, intent(out) :: EFP_sum - logical, optional, intent(in) :: reproducing - logical, optional, intent(in) :: overflow_check - integer, optional, intent(out) :: err - real :: sum ! Result + real, dimension(:,:), intent(in) :: array !< The array to be summed + integer, optional, intent(in) :: isr !< The starting i-index of the sum, noting + !! that the array indices starts at 1 + integer, optional, intent(in) :: ier !< The ending i-index of the sum, noting + !! that the array indices starts at 1 + integer, optional, intent(in) :: jsr !< The starting j-index of the sum, noting + !! that the array indices starts at 1 + integer, optional, intent(in) :: jer !< The ending j-index of the sum, noting + !! that the array indices starts at 1 + type(EFP_type), optional, intent(out) :: EFP_sum !< The result in extended fixed point format + logical, optional, intent(in) :: reproducing !< If present and false, do the sum + !! using the naive non-reproducing approach + logical, optional, intent(in) :: overflow_check !< If present and false, disable + !! checking for overflows in incremental results. + !! This can speed up calculations if the number + !! of values being summed is small enough + integer, optional, intent(out) :: err !< If present, return an error code instead of + !! triggering any fatal errors directly from + !! this routine. + real :: sum !< Result ! This subroutine uses a conversion to an integer representation ! of real numbers to give order-invariant sums that will reproduce @@ -202,14 +221,27 @@ function reproducing_sum_2d(array, isr, ier, jsr, jer, EFP_sum, reproducing, & end function reproducing_sum_2d +!> This subroutine uses a conversion to an integer representation of real numbers to give an +!! order-invariant sum of distributed 3-D arrays that reproduces across domain decomposition. +!! This technique is described in Hallberg & Adcroft, 2014, Parallel Computing, +!! doi:10.1016/j.parco.2014.04.007. function reproducing_sum_3d(array, isr, ier, jsr, jer, sums, EFP_sum, err) & result(sum) - real, dimension(:,:,:), intent(in) :: array - integer, optional, intent(in) :: isr, ier, jsr, jer - real, dimension(:), optional, intent(out) :: sums - type(EFP_type), optional, intent(out) :: EFP_sum - integer, optional, intent(out) :: err - real :: sum ! Result + real, dimension(:,:,:), intent(in) :: array !< The array to be summed + integer, optional, intent(in) :: isr !< The starting i-index of the sum, noting + !! that the array indices starts at 1 + integer, optional, intent(in) :: ier !< The ending i-index of the sum, noting + !! that the array indices starts at 1 + integer, optional, intent(in) :: jsr !< The starting j-index of the sum, noting + !! that the array indices starts at 1 + integer, optional, intent(in) :: jer !< The ending j-index of the sum, noting + !! that the array indices starts at 1 + real, dimension(:), optional, intent(out) :: sums !< The sums by vertical layer + type(EFP_type), optional, intent(out) :: EFP_sum !< The result in extended fixed point format + integer, optional, intent(out) :: err !< If present, return an error code instead of + !! triggering any fatal errors directly from + !! this routine. + real :: sum !< Result ! This subroutine uses a conversion to an integer representation ! of real numbers to give order-invariant sums that will reproduce @@ -365,10 +397,15 @@ function reproducing_sum_3d(array, isr, ier, jsr, jer, sums, EFP_sum, err) & end function reproducing_sum_3d +!> Convert a real number into the array of integers constitute its extended-fixed-point representation function real_to_ints(r, prec_error, overflow) result(ints) - real, intent(in) :: r - integer(kind=8), optional, intent(in) :: prec_error - logical, optional, intent(inout) :: overflow + real, intent(in) :: r !< The real number being converted + integer(kind=8), optional, intent(in) :: prec_error !< The PE-count dependent precision of the + !! integers that is safe from overflows during global + !! sums. This will be larger than the compile-time + !! precision parameter, and is used to detect overflows. + logical, optional, intent(inout) :: overflow !< Returns true if the conversion is being + !! done on a value that is too large to be represented integer(kind=8), dimension(ni) :: ints ! This subroutine converts a real number to an equivalent representation ! using several long integers. @@ -401,8 +438,10 @@ function real_to_ints(r, prec_error, overflow) result(ints) end function real_to_ints +!> Convert the array of integers that constitute an extended-fixed-point +!! representation into a real number function ints_to_real(ints) result(r) - integer(kind=8), dimension(ni), intent(in) :: ints + integer(kind=8), dimension(ni), intent(in) :: ints !< The array of EFP integers real :: r ! This subroutine reverses the conversion in real_to_ints. @@ -412,10 +451,15 @@ function ints_to_real(ints) result(r) do i=1,ni ; r = r + pr(i)*ints(i) ; enddo end function ints_to_real +!> Increment an array of integers that constitutes an extended-fixed-point +!! representation with a another EFP number subroutine increment_ints(int_sum, int2, prec_error) - integer(kind=8), dimension(ni), intent(inout) :: int_sum - integer(kind=8), dimension(ni), intent(in) :: int2 - integer(kind=8), optional, intent(in) :: prec_error + integer(kind=8), dimension(ni), intent(inout) :: int_sum !< The array of EFP integers being incremented + integer(kind=8), dimension(ni), intent(in) :: int2 !< The array of EFP integers being added + integer(kind=8), optional, intent(in) :: prec_error !!< The PE-count dependent precision of the + !! integers that is safe from overflows during global + !! sums. This will be larger than the compile-time + !! precision parameter, and is used to detect overflows. ! This subroutine increments a number with another, both using the integer ! representation in real_to_ints. @@ -441,10 +485,12 @@ subroutine increment_ints(int_sum, int2, prec_error) end subroutine increment_ints +!> Increment an EFP number with a real number without doing any carrying of +!! of overflows and using only minimal error checking. subroutine increment_ints_faster(int_sum, r, max_mag_term) - integer(kind=8), dimension(ni), intent(inout) :: int_sum - real, intent(in) :: r - real, intent(inout) :: max_mag_term + integer(kind=8), dimension(ni), intent(inout) :: int_sum !< The array of EFP integers being incremented + real, intent(in) :: r !< The real number being added. + real, intent(inout) :: max_mag_term !< A running maximum magnitude of the r's. ! This subroutine increments a number with another, both using the integer ! representation in real_to_ints, but without doing any carrying of overflow. @@ -466,9 +512,14 @@ subroutine increment_ints_faster(int_sum, r, max_mag_term) end subroutine increment_ints_faster +!> This subroutine handles carrying of the overflow. subroutine carry_overflow(int_sum, prec_error) - integer(kind=8), dimension(ni), intent(inout) :: int_sum - integer(kind=8), intent(in) :: prec_error + integer(kind=8), dimension(ni), intent(inout) :: int_sum !< The array of EFP integers being + !! modified by carries, but without changing value. + integer(kind=8), intent(in) :: prec_error !< The PE-count dependent precision of the + !! integers that is safe from overflows during global + !! sums. This will be larger than the compile-time + !! precision parameter, and is used to detect overflows. ! This subroutine handles carrying of the overflow. integer :: i, num_carry @@ -484,8 +535,13 @@ subroutine carry_overflow(int_sum, prec_error) end subroutine carry_overflow +!> This subroutine carries the overflow, and then makes sure that +!! all integers are of the same sign as the overall value. subroutine regularize_ints(int_sum) - integer(kind=8), dimension(ni), intent(inout) :: int_sum + integer(kind=8), dimension(ni), & + intent(inout) :: int_sum !< The array of integers being modified to take a + !! regular form with all integers of the same sign, + !! but without changing value. ! This subroutine carries the overflow, and then makes sure that ! all integers are of the same sign as the overall value. @@ -521,27 +577,34 @@ subroutine regularize_ints(int_sum) end subroutine regularize_ints +!> Returns the status of the module's error flag function query_EFP_overflow_error() logical :: query_EFP_overflow_error query_EFP_overflow_error = overflow_error end function query_EFP_overflow_error +!> Reset the module's error flag to false subroutine reset_EFP_overflow_error() overflow_error = .false. end subroutine reset_EFP_overflow_error +!> Add two extended-fixed-point numbers function EFP_plus(EFP1, EFP2) - type(EFP_type) :: EFP_plus - type(EFP_type), intent(in) :: EFP1, EFP2 + type(EFP_type) :: EFP_plus !< The result in extended fixed point format + type(EFP_type), intent(in) :: EFP1 !< The first extended fixed point number + type(EFP_type), intent(in) :: EFP2 !< The second extended fixed point number EFP_plus = EFP1 call increment_ints(EFP_plus%v(:), EFP2%v(:)) end function EFP_plus +!> Subract one extended-fixed-point number from another function EFP_minus(EFP1, EFP2) - type(EFP_type) :: EFP_minus - type(EFP_type), intent(in) :: EFP1, EFP2 + type(EFP_type) :: EFP_minus !< The result in extended fixed point format + type(EFP_type), intent(in) :: EFP1 !< The first extended fixed point number + type(EFP_type), intent(in) :: EFP2 !< The extended fixed point number being + !! subtracted from the first extended fixed point number integer :: i do i=1,ni ; EFP_minus%v(i) = -1*EFP2%v(i) ; enddo @@ -549,9 +612,10 @@ function EFP_minus(EFP1, EFP2) call increment_ints(EFP_minus%v(:), EFP1%v(:)) end function EFP_minus +!> Copy one extended-fixed-point number into another subroutine EFP_assign(EFP1, EFP2) - type(EFP_type), intent(out) :: EFP1 - type(EFP_type), intent(in) :: EFP2 + type(EFP_type), intent(out) :: EFP1 !< The recipient extended fixed point number + type(EFP_type), intent(in) :: EFP2 !< The source extended fixed point number integer i ! This subroutine assigns all components of the extended fixed point type ! variable on the RHS (EFP2) to the components of the variable on the LHS @@ -560,17 +624,22 @@ subroutine EFP_assign(EFP1, EFP2) do i=1,ni ; EFP1%v(i) = EFP2%v(i) ; enddo end subroutine EFP_assign +!> Return the real number that an extended-fixed-point number corresponds with function EFP_to_real(EFP1) - type(EFP_type), intent(inout) :: EFP1 + type(EFP_type), intent(inout) :: EFP1 !< The extended fixed point number being converted real :: EFP_to_real call regularize_ints(EFP1%v) EFP_to_real = ints_to_real(EFP1%v) end function EFP_to_real +!> Take the difference between two extended-fixed-point numbers (EFP1 - EFP2) +!! and return the result as a real number function EFP_real_diff(EFP1, EFP2) - type(EFP_type), intent(in) :: EFP1, EFP2 - real :: EFP_real_diff + type(EFP_type), intent(in) :: EFP1 !< The first extended fixed point number + type(EFP_type), intent(in) :: EFP2 !< The extended fixed point number being + !! subtracted from the first extended fixed point number + real :: EFP_real_diff !< The real result type(EFP_type) :: EFP_diff @@ -579,9 +648,11 @@ function EFP_real_diff(EFP1, EFP2) end function EFP_real_diff +!> Return the extended-fixed-point number that a real number corresponds with function real_to_EFP(val, overflow) - real, intent(in) :: val - logical, optional, intent(inout) :: overflow + real, intent(in) :: val !< The real number being converted + logical, optional, intent(inout) :: overflow !< Returns true if the conversion is being + !! done on a value that is too large to be represented type(EFP_type) :: real_to_EFP logical :: over @@ -600,10 +671,15 @@ function real_to_EFP(val, overflow) end function real_to_EFP +!< This subroutine does a sum across PEs of a list of EFP variables, +!! returning the sums in place, with all overflows carried. subroutine EFP_list_sum_across_PEs(EFPs, nval, errors) - type(EFP_type), dimension(:), intent(inout) :: EFPs - integer, intent(in) :: nval - logical, dimension(:), optional, intent(out) :: errors + type(EFP_type), dimension(:), & + intent(inout) :: EFPs !< The list of extended fixed point numbers + !! being summed across PEs. + integer, intent(in) :: nval !< The number of values being summed. + logical, dimension(:), & + optional, intent(out) :: errors !< A list of error flags for each sum ! This subroutine does a sum across PEs of a list of EFP variables, ! returning the sums in place, with all overflows carried. @@ -645,6 +721,8 @@ subroutine EFP_list_sum_across_PEs(EFPs, nval, errors) end subroutine EFP_list_sum_across_PEs +!< This subroutine carries out all of the calls required to close out the infrastructure cleanly. +!! This should only be called in ocean-only runs, as the coupler takes care of this in coupled runs. subroutine MOM_infra_end ! This subroutine should contain all of the calls that are required ! to close out the infrastructure cleanly. This should only be called From ce614c6eed2b94890a9e23705ff7a7a52a2607f4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 7 May 2018 15:23:09 -0400 Subject: [PATCH 0204/1072] dOxyGenized MOM_spatial_means.F90 Added dOxyGen comments for all routines and arguments in MOM_spatial_means.F90. All answers are bitwise identical. --- src/framework/MOM_spatial_means.F90 | 31 +++++++++++++++++++---------- 1 file changed, 20 insertions(+), 11 deletions(-) diff --git a/src/framework/MOM_spatial_means.F90 b/src/framework/MOM_spatial_means.F90 index 38c4b61180..9e2d312887 100644 --- a/src/framework/MOM_spatial_means.F90 +++ b/src/framework/MOM_spatial_means.F90 @@ -23,9 +23,10 @@ module MOM_spatial_means contains +!> Return the global area mean of a variable. This uses reproducing sums. function global_area_mean(var,G) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G), SZJ_(G)), intent(in) :: var + real, dimension(SZI_(G), SZJ_(G)), intent(in) :: var !< The variable to average real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming real :: global_area_mean @@ -40,9 +41,10 @@ function global_area_mean(var,G) end function global_area_mean +!> Return the global area integral of a variable. This uses reproducing sums. function global_area_integral(var,G) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G), SZJ_(G)), intent(in) :: var + real, dimension(SZI_(G), SZJ_(G)), intent(in) :: var !< The variable to integrate real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming real :: global_area_integral @@ -57,10 +59,11 @@ function global_area_integral(var,G) end function global_area_integral +!> Return the layerwise global thickness-weighted mean of a variable. This uses reproducing sums. function global_layer_mean(var, h, G, GV) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: var + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: var !< The variable to average real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) real, dimension(SZK_(GV)) :: global_layer_mean @@ -86,7 +89,7 @@ function global_layer_mean(var, h, G, GV) end function global_layer_mean -!> Find the global thickness-weighted mean of a variable. +!> Find the global thickness-weighted mean of a variable. This uses reproducing sums. function global_volume_mean(var, h, G, GV) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -114,7 +117,7 @@ function global_volume_mean(var, h, G, GV) end function global_volume_mean -!> Find the global mass-weighted integral of a variable +!> Find the global mass-weighted integral of a variable. This uses reproducing sums. function global_mass_integral(h, G, GV, var, on_PE_only) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -158,11 +161,14 @@ function global_mass_integral(h, G, GV, var, on_PE_only) end function global_mass_integral +!> Determine the global mean of a field along rows of constant i, returning it +!! in a 1-d array using the local indexing. This uses reproducing sums. subroutine global_i_mean(array, i_mean, G, mask) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: array - real, dimension(SZJ_(G)), intent(out) :: i_mean - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: mask + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: array !< The variable being averaged + real, dimension(SZJ_(G)), intent(out) :: i_mean !< Global mean of array along its i-axis + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(in) :: mask !< An array used for weighting the i-mean ! This subroutine determines the global mean of a field along rows of ! constant i, returning it in a 1-d array using the local indexing. @@ -236,11 +242,14 @@ subroutine global_i_mean(array, i_mean, G, mask) end subroutine global_i_mean +!> Determine the global mean of a field along rows of constant j, returning it +!! in a 1-d array using the local indexing. This uses reproducing sums. subroutine global_j_mean(array, j_mean, G, mask) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: array - real, dimension(SZI_(G)), intent(out) :: j_mean - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: mask + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: array !< The variable being averaged + real, dimension(SZI_(G)), intent(out) :: j_mean !< Global mean of array along its j-axis + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(in) :: mask !< An array used for weighting the j-mean ! This subroutine determines the global mean of a field along rows of ! constant j, returning it in a 1-d array using the local indexing. From 999e343a1786e06626767b30790a2489591bb78c Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 7 May 2018 21:35:39 -0400 Subject: [PATCH 0205/1072] gitlab: Indicates status of MOM_parameter_doc files - A pipeline will now be flagged with a warning if the MOM_parameter_doc files are modified by the PR. --- .gitlab-ci.yml | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 17abc9b0e3..0505578ed0 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -34,10 +34,12 @@ setup: - git clone https://github.com/adcroft/MRS.git MRS # Update MOM6-examples and submodules - (cd MOM6-examples && git checkout . && git checkout dev/gfdl && git pull && git submodule init && git submodule update) + - (cd MOM6-examples/src/MOM6 && git submodule update) - test -d MOM6-examples/src/LM3 || make -f MRS/Makefile.clone clone_gfdl -s - make -f MRS/Makefile.clone MOM6-examples/.datasets -s #- (cd MOM6-examples/src/mkmf && git pull https://github.com/adcroft/mkmf.git add_coverage_mode) - env > gitlab_session.log + # Cache everything under tests to unpack for each subsequent stage - cd ../ ; time tar zcf $CACHE_DIR/tests_$CI_PIPELINE_ID.tgz tests # Compiles @@ -218,6 +220,16 @@ gnu:restart: - time tar zxf $CACHE_DIR/results-$CI_PIPELINE_ID.tgz - make -f MRS/Makefile.tests gnu_check_restarts +gnu:params: + stage: tests + tags: + - ncrc4 + script: + - time tar zxf $CACHE_DIR/tests_$CI_PIPELINE_ID.tgz && cd tests + - time tar zxf $CACHE_DIR/results-$CI_PIPELINE_ID.tgz + - make -f MRS/Makefile.tests params_gnu_symmetric + allow_failure: true + cleanup: stage: cleanup tags: From a9f84c44c4c3c4c0063e839f69c0cae4cd50b04e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:17:57 -0400 Subject: [PATCH 0206/1072] Fixed some dOxygen comments in MOM_debugging.F90 Fixed some of the new dOxygen comments in MOM_debugging.F90 to document only one variable per comment and avoid excessively long lines. All answers are bitwise identical. --- src/diagnostics/MOM_debugging.F90 | 150 ++++++++++++++++++++---------- 1 file changed, 99 insertions(+), 51 deletions(-) diff --git a/src/diagnostics/MOM_debugging.F90 b/src/diagnostics/MOM_debugging.F90 index 2e9c80470a..53105609ca 100644 --- a/src/diagnostics/MOM_debugging.F90 +++ b/src/diagnostics/MOM_debugging.F90 @@ -96,12 +96,18 @@ end subroutine MOM_debugging_init subroutine check_redundant_vC3d(mesg, u_comp, v_comp, G, is, ie, js, je, & direction) - character(len=*), intent(in) :: mesg !< An identifying message - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector to be checked for consistency - real, dimension(G%isd:,G%JsdB:,:), intent(in) :: v_comp !< The u-component of the vector to be checked for consistency - integer, optional, intent(in) :: is, ie, js, je !< The range of indices to check for consistency - integer, optional, intent(in) :: direction !< the direction flag to be passed to pass_vector + character(len=*), intent(in) :: mesg !< An identifying message + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + real, dimension(G%IsdB:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector + !! to be checked for consistency + real, dimension(G%isd:,G%JsdB:,:), intent(in) :: v_comp !< The u-component of the vector + !! to be checked for consistency + integer, optional, intent(in) :: is !< The starting i-index to check + integer, optional, intent(in) :: ie !< The ending i-index to check + integer, optional, intent(in) :: js !< The starting j-index to check + integer, optional, intent(in) :: je !< The ending j-index to check + integer, optional, intent(in) :: direction !< the direction flag to be + !! passed to pass_vector ! Arguments: u_comp - The u-component of the vector being checked. ! (in) v_comp - The v-component of the vector being checked. ! (in) mesg - A message indicating what is being checked. @@ -125,12 +131,18 @@ end subroutine check_redundant_vC3d subroutine check_redundant_vC2d(mesg, u_comp, v_comp, G, is, ie, js, je, & direction) - character(len=*), intent(in) :: mesg !< An identifying message - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector to be checked for consistency - real, dimension(G%isd:,G%JsdB:), intent(in) :: v_comp !< The u-component of the vector to be checked for consistency - integer, optional, intent(in) :: is, ie, js, je !< The range of indices to check for consistency - integer, optional, intent(in) :: direction !< the direction flag to be passed to pass_vector + character(len=*), intent(in) :: mesg !< An identifying message + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + real, dimension(G%IsdB:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector + !! to be checked for consistency + real, dimension(G%isd:,G%JsdB:), intent(in) :: v_comp !< The u-component of the vector + !! to be checked for consistency + integer, optional, intent(in) :: is !< The starting i-index to check + integer, optional, intent(in) :: ie !< The ending i-index to check + integer, optional, intent(in) :: js !< The starting j-index to check + integer, optional, intent(in) :: je !< The ending j-index to check + integer, optional, intent(in) :: direction !< the direction flag to be + !! passed to pass_vector ! Arguments: u_comp - The u-component of the vector being checked. ! (in) v_comp - The v-component of the vector being checked. ! (in) mesg - A message indicating what is being checked. @@ -200,9 +212,12 @@ end subroutine check_redundant_vC2d subroutine check_redundant_sB3d(mesg, array, G, is, ie, js, je) character(len=*), intent(in) :: mesg !< An identifying message - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: array !< The array to be checked for consistency - integer, optional, intent(in) :: is, ie, js, je !< The range of indices to check for consistency + integer, optional, intent(in) :: is !< The starting i-index to check + integer, optional, intent(in) :: ie !< The ending i-index to check + integer, optional, intent(in) :: js !< The starting j-index to check + integer, optional, intent(in) :: je !< The ending j-index to check ! Arguments: array - The array being checked. ! (in) mesg - A message indicating what is being checked. ! (in) G - The ocean's grid structure. @@ -225,9 +240,12 @@ end subroutine check_redundant_sB3d subroutine check_redundant_sB2d(mesg, array, G, is, ie, js, je) character(len=*), intent(in) :: mesg !< An identifying message - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure real, dimension(G%IsdB:,G%JsdB:), intent(in) :: array !< The array to be checked for consistency - integer, optional, intent(in) :: is, ie, js, je !< The range of indices to check for consistency + integer, optional, intent(in) :: is !< The starting i-index to check + integer, optional, intent(in) :: ie !< The ending i-index to check + integer, optional, intent(in) :: js !< The starting j-index to check + integer, optional, intent(in) :: je !< The ending j-index to check ! Arguments: array - The array being checked. ! (in) mesg - A message indicating what is being checked. ! (in) G - The ocean's grid structure. @@ -284,12 +302,18 @@ end subroutine check_redundant_sB2d subroutine check_redundant_vB3d(mesg, u_comp, v_comp, G, is, ie, js, je, & direction) - character(len=*), intent(in) :: mesg !< An identifying message - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: u_comp !< The u-component of the vector to be checked for consistency - real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: v_comp !< The u-component of the vector to be checked for consistency - integer, optional, intent(in) :: is, ie, js, je !< The range of indices to check for consistency - integer, optional, intent(in) :: direction !< the direction flag to be passed to pass_vector + character(len=*), intent(in) :: mesg !< An identifying message + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: u_comp !< The u-component of the vector + !! to be checked for consistency + real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: v_comp !< The v-component of the vector + !! to be checked for consistency + integer, optional, intent(in) :: is !< The starting i-index to check + integer, optional, intent(in) :: ie !< The ending i-index to check + integer, optional, intent(in) :: js !< The starting j-index to check + integer, optional, intent(in) :: je !< The ending j-index to check + integer, optional, intent(in) :: direction !< the direction flag to be + !! passed to pass_vector ! Arguments: u_comp - The u-component of the vector being checked. ! (in) v_comp - The v-component of the vector being checked. ! (in) mesg - A message indicating what is being checked. @@ -313,12 +337,18 @@ end subroutine check_redundant_vB3d subroutine check_redundant_vB2d(mesg, u_comp, v_comp, G, is, ie, js, je, & direction) - character(len=*), intent(in) :: mesg !< An identifying message - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%JsdB:), intent(in) :: u_comp !< The u-component of the vector to be checked for consistency - real, dimension(G%IsdB:,G%JsdB:), intent(in) :: v_comp !< The u-component of the vector to be checked for consistency - integer, optional, intent(in) :: is, ie, js, je !< The range of indices to check for consistency - integer, optional, intent(in) :: direction !< the direction flag to be passed to pass_vector + character(len=*), intent(in) :: mesg !< An identifying message + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + real, dimension(G%IsdB:,G%JsdB:), intent(in) :: u_comp !< The u-component of the vector + !! to be checked for consistency + real, dimension(G%IsdB:,G%JsdB:), intent(in) :: v_comp !< The v-component of the vector + !! to be checked for consistency + integer, optional, intent(in) :: is !< The starting i-index to check + integer, optional, intent(in) :: ie !< The ending i-index to check + integer, optional, intent(in) :: js !< The starting j-index to check + integer, optional, intent(in) :: je !< The ending j-index to check + integer, optional, intent(in) :: direction !< the direction flag to be + !! passed to pass_vector ! Arguments: u_comp - The u-component of the vector being checked. ! (in) v_comp - The v-component of the vector being checked. ! (in) mesg - A message indicating what is being checked. @@ -389,9 +419,12 @@ end subroutine check_redundant_vB2d subroutine check_redundant_sT3d(mesg, array, G, is, ie, js, je) character(len=*), intent(in) :: mesg !< An identifying message - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure real, dimension(G%isd:,G%jsd:,:), intent(in) :: array !< The array to be checked for consistency - integer, optional, intent(in) :: is, ie, js, je !< The range of indices to check for consistency + integer, optional, intent(in) :: is !< The starting i-index to check + integer, optional, intent(in) :: ie !< The ending i-index to check + integer, optional, intent(in) :: js !< The starting j-index to check + integer, optional, intent(in) :: je !< The ending j-index to check ! Arguments: array - The array being checked. ! (in) mesg - A message indicating what is being checked. ! (in) G - The ocean's grid structure. @@ -414,9 +447,12 @@ end subroutine check_redundant_sT3d subroutine check_redundant_sT2d(mesg, array, G, is, ie, js, je) character(len=*), intent(in) :: mesg !< An identifying message - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure real, dimension(G%isd:,G%jsd:), intent(in) :: array !< The array to be checked for consistency - integer, optional, intent(in) :: is, ie, js, je !< The range of indices to check for consistency + integer, optional, intent(in) :: is !< The starting i-index to check + integer, optional, intent(in) :: ie !< The ending i-index to check + integer, optional, intent(in) :: js !< The starting j-index to check + integer, optional, intent(in) :: je !< The ending j-index to check ! Arguments: array - The array being checked. ! (in) mesg - A message indicating what is being checked. ! (in) G - The ocean's grid structure. @@ -459,12 +495,18 @@ end subroutine check_redundant_sT2d subroutine check_redundant_vT3d(mesg, u_comp, v_comp, G, is, ie, js, je, & direction) - character(len=*), intent(in) :: mesg !< An identifying message - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%isd:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector to be checked for consistency - real, dimension(G%isd:,G%jsd:,:), intent(in) :: v_comp !< The u-component of the vector to be checked for consistency - integer, optional, intent(in) :: is, ie, js, je !< The range of indices to check for consistency - integer, optional, intent(in) :: direction !< the direction flag to be passed to pass_vector + character(len=*), intent(in) :: mesg !< An identifying message + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + real, dimension(G%isd:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector + !! to be checked for consistency + real, dimension(G%isd:,G%jsd:,:), intent(in) :: v_comp !< The v-component of the vector + !! to be checked for consistency + integer, optional, intent(in) :: is !< The starting i-index to check + integer, optional, intent(in) :: ie !< The ending i-index to check + integer, optional, intent(in) :: js !< The starting j-index to check + integer, optional, intent(in) :: je !< The ending j-index to check + integer, optional, intent(in) :: direction !< the direction flag to be + !! passed to pass_vector ! Arguments: u_comp - The u-component of the vector being checked. ! (in) v_comp - The v-component of the vector being checked. ! (in) mesg - A message indicating what is being checked. @@ -488,12 +530,18 @@ end subroutine check_redundant_vT3d subroutine check_redundant_vT2d(mesg, u_comp, v_comp, G, is, ie, js, je, & direction) - character(len=*), intent(in) :: mesg !< An identifying message - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%isd:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector to be checked for consistency - real, dimension(G%isd:,G%jsd:), intent(in) :: v_comp !< The u-component of the vector to be checked for consistency - integer, optional, intent(in) :: is, ie, js, je !< The range of indices to check for consistency - integer, optional, intent(in) :: direction !< the direction flag to be passed to pass_vector + character(len=*), intent(in) :: mesg !< An identifying message + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + real, dimension(G%isd:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector + !! to be checked for consistency + real, dimension(G%isd:,G%jsd:), intent(in) :: v_comp !< The v-component of the vector + !! to be checked for consistency + integer, optional, intent(in) :: is !< The starting i-index to check + integer, optional, intent(in) :: ie !< The ending i-index to check + integer, optional, intent(in) :: js !< The starting j-index to check + integer, optional, intent(in) :: je !< The ending j-index to check + integer, optional, intent(in) :: direction !< the direction flag to be + !! passed to pass_vector ! Arguments: u_comp - The u-component of the vector being checked. ! (in) v_comp - The v-component of the vector being checked. ! (in) mesg - A message indicating what is being checked. @@ -559,7 +607,7 @@ subroutine chksum_vec_C3d(mesg, u_comp, v_comp, G, halos, scalars) real, dimension(G%isd:,G%JsdB:,:), intent(in) :: v_comp !< The v-component of the vector integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of - !! scalars that are being checked. + !! scalars that are being checked. logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars @@ -585,7 +633,7 @@ subroutine chksum_vec_C2d(mesg, u_comp, v_comp, G, halos, scalars) real, dimension(G%isd:,G%JsdB:), intent(in) :: v_comp !< The v-component of the vector integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of - !! scalars that are being checked. + !! scalars that are being checked. logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars @@ -611,7 +659,7 @@ subroutine chksum_vec_B3d(mesg, u_comp, v_comp, G, halos, scalars) real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: v_comp !< The v-component of the vector integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of - !! scalars that are being checked. + !! scalars that are being checked. logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars @@ -638,9 +686,9 @@ subroutine chksum_vec_B2d(mesg, u_comp, v_comp, G, halos, scalars, symmetric) real, dimension(G%IsdB:,G%JsdB:), intent(in) :: v_comp !< The v-component of the vector integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of - !! scalars that are being checked. + !! scalars that are being checked. logical, optional, intent(in) :: symmetric !< If true, do the checksums on the - !! full symmetric computational domain. + !! full symmetric computational domain. logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars @@ -667,7 +715,7 @@ subroutine chksum_vec_A3d(mesg, u_comp, v_comp, G, halos, scalars) real, dimension(G%isd:,G%jsd:,:), intent(in) :: v_comp !< The v-component of the vector integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of - !! scalars that are being checked. + !! scalars that are being checked. logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars @@ -695,7 +743,7 @@ subroutine chksum_vec_A2d(mesg, u_comp, v_comp, G, halos, scalars) real, dimension(G%isd:,G%jsd:), intent(in) :: v_comp !< The v-component of the vector integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of - !! scalars that are being checked. + !! scalars that are being checked. logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars From 668f13ad6d2e17f063a62d3b96c1713691c1cb9a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:18:26 -0400 Subject: [PATCH 0207/1072] Split excessively long lines in MOM_open_boundary Split several recently introduced excessively long lines in MOM_open_boundary.F90. All answers are bitwise identical. --- src/core/MOM_open_boundary.F90 | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 3668861db7..b4d00144b8 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -2520,30 +2520,36 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) G%dxCv(i,J)) if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(i,J,:) = segment%normal_vel(i,J,:) enddo - elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_E_or_W .and. associated(segment%tangential_vel)) then + elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_E_or_W .and. & + associated(segment%tangential_vel)) then I=is_obc do J=js_obc,je_obc do k=1,G%ke segment%tangential_vel(I,J,k) = segment%field(m)%buffer_dst(I,J,k) enddo - if (associated(segment%nudged_tangential_vel)) segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) + if (associated(segment%nudged_tangential_vel)) & + segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) enddo - elseif (trim(segment%field(m)%name) == 'U' .and. segment%is_N_or_S .and. associated(segment%tangential_vel)) then + elseif (trim(segment%field(m)%name) == 'U' .and. segment%is_N_or_S .and. & + associated(segment%tangential_vel)) then J=js_obc do I=is_obc,ie_obc do k=1,G%ke segment%tangential_vel(I,J,k) = segment%field(m)%buffer_dst(I,J,k) enddo - if (associated(segment%nudged_tangential_vel)) segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) + if (associated(segment%nudged_tangential_vel)) & + segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) enddo - elseif (trim(segment%field(m)%name) == 'DVDX' .and. segment%is_E_or_W .and. associated(segment%tangential_grad)) then + elseif (trim(segment%field(m)%name) == 'DVDX' .and. segment%is_E_or_W .and. & + associated(segment%tangential_grad)) then I=is_obc do J=js_obc,je_obc do k=1,G%ke segment%tangential_grad(I,J,k) = segment%field(m)%buffer_dst(I,J,k) enddo enddo - elseif (trim(segment%field(m)%name) == 'DUDY' .and. segment%is_N_or_S .and. associated(segment%tangential_grad)) then + elseif (trim(segment%field(m)%name) == 'DUDY' .and. segment%is_N_or_S .and. & + associated(segment%tangential_grad)) then J=js_obc do I=is_obc,ie_obc do k=1,G%ke From 3bc5d095d5ea49143800c93405caa99252886a67 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:18:46 -0400 Subject: [PATCH 0208/1072] Split excessively long lines in MOM_file_parser Split several recently introduced excessively long lines in MOM_file_parser.F90. All answers are bitwise identical. --- src/framework/MOM_file_parser.F90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index a2531fdac9..5cf0417d09 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -618,7 +618,8 @@ end subroutine read_param_int !> This subroutine reads the values of an array of integer model parameters from a parameter file. subroutine read_param_int_array(CS, varname, value, fail_if_missing) - type(param_file_type), intent(in) :: CS !< The control structure for this parameter, which is also a structure to parse for run-time parameters + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, + !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read integer, dimension(:), intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file @@ -1349,7 +1350,8 @@ subroutine log_param_int_array(CS, modulename, varname, value, desc, & !! present, this paramter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter integer, optional, intent(in) :: default !< The default value of the parameter - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is logged in the layout parameter file + logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + !! logged in the layout parameter file logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is !! logged in the debugging parameter file ! This subroutine writes the value of an integer parameter to a log file, @@ -1682,7 +1684,8 @@ subroutine get_param_int_array(CS, modulename, varname, value, desc, units, & !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read - integer, dimension(:), intent(inout) :: value !< The value of the parameter that may be reset from the parameter file + integer, dimension(:), intent(inout) :: value !< The value of the parameter that may be reset + !! from the parameter file character(len=*), optional, intent(in) :: desc !< A description of this variable; if not !! present, this paramter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter From 70f96c179e184a45b0f5fdb451b6a68e87dc2d1c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:19:21 -0400 Subject: [PATCH 0209/1072] dOxyGenized MOM_diag_mediator.F90 Added dOxyGen comments for all remaining routines and arguments in MOM_diag_mediator.F90. All answers are bitwise identical. --- src/framework/MOM_diag_mediator.F90 | 229 ++++++++++++++++------------ 1 file changed, 134 insertions(+), 95 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 34bde56f02..e0737ad2f8 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -691,9 +691,10 @@ subroutine define_axes_group(diag_cs, handles, axes, nz, vertical_coordinate_num end subroutine define_axes_group +!> Set up the array extents for doing diagnostics subroutine set_diag_mediator_grid(G, diag_cs) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(diag_ctrl), intent(inout) :: diag_cs + type(diag_ctrl), intent(inout) :: diag_CS !< Structure used to regulate diagnostic output ! Arguments: ! (inout) G - ocean grid structure @@ -706,11 +707,13 @@ subroutine set_diag_mediator_grid(G, diag_cs) end subroutine set_diag_mediator_grid +!> Make a real scalar diagnostic available for averaging or output subroutine post_data_0d(diag_field_id, field, diag_cs, is_static) - integer, intent(in) :: diag_field_id - real, intent(in) :: field - type(diag_ctrl), target, intent(in) :: diag_cs - logical, optional, intent(in) :: is_static + integer, intent(in) :: diag_field_id !< The id for an output variable returned by a + !! previous call to register_diag_field. + real, intent(in) :: field !< real value being offered for output or averaging + type(diag_ctrl), target, intent(in) :: diag_CS !< Structure used to regulate diagnostic output + logical, optional, intent(in) :: is_static !< If true, this is a static field that is always offered. ! Arguments: ! (in) diag_field_id - the id for an output variable returned by a @@ -743,16 +746,18 @@ subroutine post_data_0d(diag_field_id, field, diag_cs, is_static) if (id_clock_diag_mediator>0) call cpu_clock_end(id_clock_diag_mediator) end subroutine post_data_0d +!> Make a real 1-d array diagnostic available for averaging or output subroutine post_data_1d_k(diag_field_id, field, diag_cs, is_static) - integer, intent(in) :: diag_field_id - real, intent(in) :: field(:) - type(diag_ctrl), target, intent(in) :: diag_cs - logical, optional, intent(in) :: is_static + integer, intent(in) :: diag_field_id !< The id for an output variable returned by a + !! previous call to register_diag_field. + real, intent(in) :: field(:) !< 1-d array being offered for output or averaging + type(diag_ctrl), target, intent(in) :: diag_CS !< Structure used to regulate diagnostic output + logical, optional, intent(in) :: is_static !< If true, this is a static field that is always offered. ! Arguments: ! (in) diag_field_id - id for an output variable returned by a ! previous call to register_diag_field. -! (in) field - 3-d array being offered for output or averaging +! (in) field - 1-d array being offered for output or averaging ! (inout) diag_cs - structure used to regulate diagnostic output ! (in) static - If true, this is a static field that is always offered. @@ -780,12 +785,14 @@ subroutine post_data_1d_k(diag_field_id, field, diag_cs, is_static) if (id_clock_diag_mediator>0) call cpu_clock_end(id_clock_diag_mediator) end subroutine post_data_1d_k +!> Make a real 2-d array diagnostic available for averaging or output subroutine post_data_2d(diag_field_id, field, diag_cs, is_static, mask) - integer, intent(in) :: diag_field_id - real, intent(in) :: field(:,:) - type(diag_ctrl), target, intent(in) :: diag_cs - logical, optional, intent(in) :: is_static - real, optional, intent(in) :: mask(:,:) + integer, intent(in) :: diag_field_id !< The id for an output variable returned by a + !! previous call to register_diag_field. + real, intent(in) :: field(:,:) !< 2-d array being offered for output or averaging + type(diag_ctrl), target, intent(in) :: diag_CS !< Structure used to regulate diagnostic output + logical, optional, intent(in) :: is_static !< If true, this is a static field that is always offered. + real, optional, intent(in) :: mask(:,:) !< If present, use this real array as the data mask. ! Arguments: ! (in) diag_field_id - id for an output variable returned by a @@ -811,12 +818,14 @@ subroutine post_data_2d(diag_field_id, field, diag_cs, is_static, mask) if (id_clock_diag_mediator>0) call cpu_clock_end(id_clock_diag_mediator) end subroutine post_data_2d +!> Make a real 2-d array diagnostic available for averaging or output +!! using a diag_type instead of an integer id. subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) - type(diag_type), intent(in) :: diag - real, target, intent(in) :: field(:,:) - type(diag_ctrl), intent(in) :: diag_cs - logical, optional, intent(in) :: is_static - real, optional, intent(in) :: mask(:,:) + type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post + real, target, intent(in) :: field(:,:) !< 2-d array being offered for output or averaging + type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output + logical, optional, intent(in) :: is_static !< If true, this is a static field that is always offered. + real, optional, intent(in) :: mask(:,:) !< If present, use this real array as the data mask. ! Arguments: ! (in) diag - structure representing the diagnostic to post @@ -916,14 +925,18 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) end subroutine post_data_2d_low +!> Make a real 3-d array diagnostic available for averaging or output. subroutine post_data_3d(diag_field_id, field, diag_cs, is_static, mask, alt_h) - integer, intent(in) :: diag_field_id - real, intent(in) :: field(:,:,:) - type(diag_ctrl), target, intent(in) :: diag_cs - logical, optional, intent(in) :: is_static - real, optional, intent(in) :: mask(:,:,:) - real, target, optional, intent(in) :: alt_h(:,:,:) + integer, intent(in) :: diag_field_id !< The id for an output variable returned by a + !! previous call to register_diag_field. + real, intent(in) :: field(:,:,:) !< 3-d array being offered for output or averaging + type(diag_ctrl), target, intent(in) :: diag_CS !< Structure used to regulate diagnostic output + logical, optional, intent(in) :: is_static !< If true, this is a static field that is always offered. + real, optional, intent(in) :: mask(:,:,:) !< If present, use this real array as the data mask. + real, dimension(:,:,:), & + target, optional, intent(in) :: alt_h !< An alternate thickness to use for vertically + !! remapping this diagnostic, in H. ! Arguments: ! (in) diag_field_id - id for an output variable returned by a @@ -1039,12 +1052,14 @@ subroutine post_data_3d(diag_field_id, field, diag_cs, is_static, mask, alt_h) end subroutine post_data_3d +!> Make a real 3-d array diagnostic available for averaging or output +!! using a diag_type instead of an integer id. subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) - type(diag_type), intent(in) :: diag - real, target, intent(in) :: field(:,:,:) - type(diag_ctrl), intent(in) :: diag_cs - logical, optional, intent(in) :: is_static - real, optional, intent(in) :: mask(:,:,:) + type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post + real, target, intent(in) :: field(:,:,:) !< 3-d array being offered for output or averaging + type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output + logical, optional, intent(in) :: is_static !< If true, this is a static field that is always offered. + real, optional, intent(in) :: mask(:,:,:) !< If present, use this real array as the data mask. ! Arguments: ! (in) diag - the diagnostic to post. @@ -1217,10 +1232,12 @@ subroutine post_xy_average(diag_cs, diag, field) weight=diag_cs%time_int) end subroutine post_xy_average +!> This subroutine enables the accumulation of time averages over the specified time interval. subroutine enable_averaging(time_int_in, time_end_in, diag_cs) - real, intent(in) :: time_int_in - type(time_type), intent(in) :: time_end_in - type(diag_ctrl), intent(inout) :: diag_cs + real, intent(in) :: time_int_in !< The time interval in s over which any + !! values that are offered are valid. + type(time_type), intent(in) :: time_end_in !< The end time of the valid interval + type(diag_ctrl), intent(inout) :: diag_CS !< Structure used to regulate diagnostic output ! This subroutine enables the accumulation of time averages over the ! specified time interval. @@ -1228,7 +1245,7 @@ subroutine enable_averaging(time_int_in, time_end_in, diag_cs) ! Arguments: ! (in) time_int_in - time interval in s over which any ! values that are offered are valid. -! (in) time_end_in - end time in s of the valid interval +! (in) time_end_in - end time of the valid interval ! (inout) diag - structure used to regulate diagnostic output ! if (num_file==0) return @@ -1237,9 +1254,9 @@ subroutine enable_averaging(time_int_in, time_end_in, diag_cs) diag_cs%ave_enabled = .true. end subroutine enable_averaging -! Call this subroutine to avoid averaging any offered fields. +!> Call this subroutine to avoid averaging any offered fields. subroutine disable_averaging(diag_cs) - type(diag_ctrl), intent(inout) :: diag_cs + type(diag_ctrl), intent(inout) :: diag_CS !< Structure used to regulate diagnostic output ! Argument: ! diag - structure used to regulate diagnostic output @@ -1249,12 +1266,12 @@ subroutine disable_averaging(diag_cs) end subroutine disable_averaging -! Call this subroutine to determine whether the averaging is -! currently enabled. .true. is returned if it is. +!> Call this subroutine to determine whether the averaging is +!! currently enabled. .true. is returned if it is. function query_averaging_enabled(diag_cs, time_int, time_end) - type(diag_ctrl), intent(in) :: diag_cs - real, optional, intent(out) :: time_int - type(time_type), optional, intent(out) :: time_end + type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output + real, optional, intent(out) :: time_int !< Current setting of diag%time_int, in s + type(time_type), optional, intent(out) :: time_end !< Current setting of diag%time_end logical :: query_averaging_enabled ! Arguments: @@ -1267,15 +1284,13 @@ function query_averaging_enabled(diag_cs, time_int, time_end) query_averaging_enabled = diag_cs%ave_enabled end function query_averaging_enabled +!> This function returns the valid end time for use with diagnostics that are +!! handled outside of the MOM6 diagnostics infrastructure. function get_diag_time_end(diag_cs) - type(diag_ctrl), intent(in) :: diag_cs + type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output type(time_type) :: get_diag_time_end - -! Argument: -! (in) diag - structure used to regulate diagnostic output - -! This function returns the valid end time for diagnostics that are handled -! outside of the MOM6 infrastructure, such as via the generic tracer code. + ! This function returns the valid end time for diagnostics that are handled + ! outside of the MOM6 infrastructure, such as via the generic tracer code. get_diag_time_end = diag_cs%time_end end function get_diag_time_end @@ -1326,7 +1341,7 @@ integer function register_diag_field(module_name, field_name, axes, init_time, & !! integrated). Default/absent for intensive. ! Local variables real :: MOM_missing_value - type(diag_ctrl), pointer :: diag_cs + type(diag_ctrl), pointer :: diag_cs => NULL() type(axes_grp), pointer :: remap_axes => null() integer :: dm_id, i character(len=256) :: new_module_name @@ -1447,7 +1462,7 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, !! integrated). Default/absent for intensive. ! Local variables real :: MOM_missing_value - type(diag_ctrl), pointer :: diag_cs + type(diag_ctrl), pointer :: diag_cs => null() type(diag_type), pointer :: this_diag => null() integer :: fms_id, fms_xyave_id character(len=256) :: posted_cmor_units, posted_cmor_standard_name, posted_cmor_long_name, cm_string, msg @@ -1812,16 +1827,25 @@ function register_scalar_field(module_name, field_name, init_time, diag_cs, & do_not_log, err_msg, interp_method, cmor_field_name, & cmor_long_name, cmor_units, cmor_standard_name) integer :: register_scalar_field - character(len=*), intent(in) :: module_name, field_name - type(time_type), intent(in) :: init_time - type(diag_ctrl), intent(inout) :: diag_cs - character(len=*), optional, intent(in) :: long_name, units, standard_name - real, optional, intent(in) :: missing_value, range(2) - logical, optional, intent(in) :: do_not_log - character(len=*), optional, intent(out):: err_msg - character(len=*), optional, intent(in) :: interp_method - character(len=*), optional, intent(in) :: cmor_field_name, cmor_long_name - character(len=*), optional, intent(in) :: cmor_units, cmor_standard_name + character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" + !! or "ice_shelf_model" + character(len=*), intent(in) :: field_name !< Name of the diagnostic field + type(time_type), intent(in) :: init_time !< Time at which a field is first available? + type(diag_ctrl), intent(inout) :: diag_CS !< Structure used to regulate diagnostic output + character(len=*), optional, intent(in) :: long_name !< Long name of a field. + character(len=*), optional, intent(in) :: units !< Units of a field. + character(len=*), optional, intent(in) :: standard_name !< Standardized name associated with a field + real, optional, intent(in) :: missing_value !< A value that indicates missing values. + real, optional, intent(in) :: range(2) !< Valid range of a variable (not used in MOM?) + logical, optional, intent(in) :: do_not_log !< If true, do not log something (not used in MOM?) + character(len=*), optional, intent(out):: err_msg !< String into which an error message might be + !! placed (not used in MOM?) + character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not + !! be interpolated as a scalar + character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name of a field + character(len=*), optional, intent(in) :: cmor_long_name !< CMOR long name of a field + character(len=*), optional, intent(in) :: cmor_units !< CMOR units of a field + character(len=*), optional, intent(in) :: cmor_standard_name !< CMOR standardized name associated with a field ! Output: An integer handle for a diagnostic array. ! Arguments: @@ -1918,15 +1942,26 @@ function register_static_field(module_name, field_name, axes, & cmor_field_name, cmor_long_name, cmor_units, cmor_standard_name, area, & x_cell_method, y_cell_method, area_cell_method) integer :: register_static_field - character(len=*), intent(in) :: module_name, field_name - type(axes_grp), target, intent(in) :: axes - character(len=*), optional, intent(in) :: long_name, units, standard_name - real, optional, intent(in) :: missing_value, range(2) - logical, optional, intent(in) :: mask_variant, do_not_log - character(len=*), optional, intent(in) :: interp_method - integer, optional, intent(in) :: tile_count - character(len=*), optional, intent(in) :: cmor_field_name, cmor_long_name - character(len=*), optional, intent(in) :: cmor_units, cmor_standard_name + character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" + !! or "ice_shelf_model" + character(len=*), intent(in) :: field_name !< Name of the diagnostic field + type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that + !! indicates axes for this field + character(len=*), optional, intent(in) :: long_name !< Long name of a field. + character(len=*), optional, intent(in) :: units !< Units of a field. + character(len=*), optional, intent(in) :: standard_name !< Standardized name associated with a field + real, optional, intent(in) :: missing_value !< A value that indicates missing values. + real, optional, intent(in) :: range(2) !< Valid range of a variable (not used in MOM?) + logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with + !! post_data calls (not used in MOM?) + logical, optional, intent(in) :: do_not_log !< If true, do not log something (not used in MOM?) + character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not + !! be interpolated as a scalar + integer, optional, intent(in) :: tile_count !< no clue (not used in MOM?) + character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name of a field + character(len=*), optional, intent(in) :: cmor_long_name !< CMOR long name of a field + character(len=*), optional, intent(in) :: cmor_units !< CMOR units of a field + character(len=*), optional, intent(in) :: cmor_standard_name !< CMOR standardized name associated with a field integer, optional, intent(in) :: area !< fms_id for area_t character(len=*), optional, intent(in) :: x_cell_method !< Specifies the cell method for the x-direction. character(len=*), optional, intent(in) :: y_cell_method !< Specifies the cell method for the y-direction. @@ -1950,7 +1985,7 @@ function register_static_field(module_name, field_name, axes, & ! (in,opt) tile_count - no clue real :: MOM_missing_value - type(diag_ctrl), pointer :: diag_cs + type(diag_ctrl), pointer :: diag_cs => null() type(diag_type), pointer :: diag => null(), cmor_diag => null() integer :: dm_id, fms_id, cmor_id character(len=256) :: posted_cmor_units, posted_cmor_standard_name, posted_cmor_long_name @@ -2046,9 +2081,11 @@ function register_static_field(module_name, field_name, axes, & end function register_static_field +!> Describe an option setting in the diagnostic files. subroutine describe_option(opt_name, value, diag_CS) - character(len=*), intent(in) :: opt_name, value - type(diag_ctrl), intent(in) :: diag_CS + character(len=*), intent(in) :: opt_name !< The name of the option + character(len=*), intent(in) :: value !< A character string with the setting of the option. + type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output character(len=240) :: mesg integer :: len_ind @@ -2161,13 +2198,13 @@ function ocean_register_diag(var_desc, G, diag_CS, day) end select ocean_register_diag = register_diag_field("ocean_model", trim(var_name), & - axes, day, trim(longname), trim(units), missing_value = -1.0e+34) + axes, day, trim(longname), trim(units), missing_value=-1.0e+34) end function ocean_register_diag subroutine diag_mediator_infrastructure_init(err_msg) ! This subroutine initializes the FMS diag_manager. - character(len=*), optional, intent(out) :: err_msg + character(len=*), optional, intent(out) :: err_msg !< An error message call diag_manager_init(err_msg=err_msg) end subroutine diag_mediator_infrastructure_init @@ -2455,7 +2492,7 @@ subroutine diag_masks_set(G, nz, diag_cs) end subroutine diag_masks_set subroutine diag_mediator_close_registration(diag_CS) - type(diag_ctrl), intent(inout) :: diag_CS + type(diag_ctrl), intent(inout) :: diag_CS !< Structure used to regulate diagnostic output integer :: i @@ -2470,8 +2507,8 @@ subroutine diag_mediator_close_registration(diag_CS) end subroutine diag_mediator_close_registration subroutine diag_mediator_end(time, diag_CS, end_diag_manager) - type(time_type), intent(in) :: time - type(diag_ctrl), intent(inout) :: diag_cs + type(time_type), intent(in) :: time !< The current model time + type(diag_ctrl), intent(inout) :: diag_CS !< Structure used to regulate diagnostic output logical, optional, intent(in) :: end_diag_manager !< If true, call diag_manager_end() ! Local variables @@ -2510,24 +2547,26 @@ subroutine diag_mediator_end(time, diag_CS, end_diag_manager) end subroutine diag_mediator_end +!> Convert the first n elements (up to 3) of an integer array to an underscore delimited string. function i2s(a,n_in) -! "Convert the first n elements of an integer array to a string." - integer, dimension(:), intent(in) :: a - integer, optional , intent(in) :: n_in - character(len=15) :: i2s - - character(len=15) :: i2s_temp - integer :: i,n - - n=size(a) - if (present(n_in)) n = n_in - - i2s = '' - do i=1,n - write (i2s_temp, '(I4.4)') a(i) - i2s = trim(i2s) //'_'// trim(i2s_temp) - enddo - i2s = adjustl(i2s) + ! "Convert the first n elements of an integer array to a string." + ! Perhaps this belongs elsewhere in the MOM6 code? + integer, dimension(:), intent(in) :: a !< The array of integers to translate + integer, optional , intent(in) :: n_in !< The number of elements to translate, by default all + character(len=15) :: i2s !< The returned string + + character(len=15) :: i2s_temp + integer :: i,n + + n=size(a) + if (present(n_in)) n = n_in + + i2s = '' + do i=1,max(n,3) + write (i2s_temp, '(I4.4)') a(i) + i2s = trim(i2s) //'_'// trim(i2s_temp) + enddo + i2s = adjustl(i2s) end function i2s !> Returns a new diagnostic id, it may be necessary to expand the diagnostics array. From dc91dd0bd6f6611c27b42d090a54e8def631ebc7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:19:49 -0400 Subject: [PATCH 0210/1072] dOxyGenized MOM_diag_remap.F90 Added dOxyGen comments for all remaining routines and arguments in MOM_diag_remap.F90. All answers are bitwise identical. --- src/framework/MOM_diag_remap.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 9ba8988d0f..c43f8f5026 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -209,7 +209,7 @@ end subroutine diag_remap_get_axes_info !! Configuration is complete when diag_remap_configure_axes() has been !! successfully called. function diag_remap_axes_configured(remap_cs) - type(diag_remap_ctrl), intent(in) :: remap_cs + type(diag_remap_ctrl), intent(in) :: remap_cs !< Diagnostic coordinate control structure logical :: diag_remap_axes_configured diag_remap_axes_configured = remap_cs%configured From 6c198b769e55973b8eeb961142e12167402b762d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:20:09 -0400 Subject: [PATCH 0211/1072] dOxyGenized MOM_domains.F90 Added dOxyGen comments for all remaining routines and arguments in MOM_domains.F90. All answers are bitwise identical. --- src/framework/MOM_domains.F90 | 64 +++++++++++++++++++++++------------ 1 file changed, 42 insertions(+), 22 deletions(-) diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index 10346f2542..0d68dc5dfb 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -1421,7 +1421,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & integer, optional, intent(in) :: NJPROC !< Processor counts, required with !! static memory. integer, dimension(2), optional, intent(inout) :: min_halo !< If present, this sets the - !! minimum halo size for this domain in the x- and y- + !! minimum halo size for this domain in the i- and j- !! directions, and returns the actual halo size used. character(len=*), optional, intent(in) :: domain_name !< A name for this domain, "MOM" !! if missing. @@ -1444,7 +1444,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & ! (in,opt) NIGLOBAL, NJGLOBAL - Total domain sizes, required with static memory. ! (in,opt) NIPROC, NJPROC - Processor counts, required with static memory. ! (in,opt) min_halo - If present, this sets the minimum halo size for this -! domain in the x- and y- directions, and returns the +! domain in the i- and j- directions, and returns the ! actual halo size used. ! (in,opt) domain_name - A name for this domain, "MOM" if missing. ! (in,opt) include_name - A name for model's include file, "MOM_memory.h" if missing. @@ -1717,7 +1717,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & "STATIC_MEMORY_ this is set in "//trim(inc_nm)//" at compile time.",& layoutParam=.true.) call log_param(param_file, mdl, trim(njproc_nm), layout(2), & - "The number of processors in the x-direction. With \n"//& + "The number of processors in the x-direction. With \n"//& !### FIX THIS COMMENT "STATIC_MEMORY_ this is set in "//trim(inc_nm)//" at compile time.",& layoutParam=.true.) call log_param(param_file, mdl, trim(layout_nm), layout, & @@ -1738,7 +1738,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & call parse_mask_table(mask_table, MOM_dom%maskmap, dom_name) endif - ! Set up the I/O lay-out, and check that it uses an even multiple of the + ! Set up the I/O layout, and check that it uses an even multiple of the ! number of PEs in each direction. io_layout(:) = (/ 1, 1 /) call get_param(param_file, mdl, trim(io_layout_nm), io_layout, & @@ -1751,8 +1751,8 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & &"are not allowed in ")') io_layout(1) call MOM_error(FATAL, mesg//trim(IO_layout_nm)) elseif (io_layout(1) > 0) then ; if (modulo(layout(1), io_layout(1)) /= 0) then - write(mesg,'("MOM_domains_init: The x-direction I/O-layout, IO_LAYOUT(1)=",i4, & - &", does not evenly divide the x-direction layout, NIPROC=,",i4,".")') & + write(mesg,'("MOM_domains_init: The i-direction I/O-layout, IO_LAYOUT(1)=",i4, & + &", does not evenly divide the i-direction layout, NIPROC=,",i4,".")') & io_layout(1),layout(1) call MOM_error(FATAL, mesg) endif ; endif @@ -1762,8 +1762,8 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & &"are not allowed in ")') io_layout(2) call MOM_error(FATAL, mesg//trim(IO_layout_nm)) elseif (io_layout(2) /= 0) then ; if (modulo(layout(2), io_layout(2)) /= 0) then - write(mesg,'("MOM_domains_init: The y-direction I/O-layout, IO_LAYOUT(2)=",i4, & - &", does not evenly divide the y-direction layout, NJPROC=,",i4,".")') & + write(mesg,'("MOM_domains_init: The j-direction I/O-layout, IO_LAYOUT(2)=",i4, & + &", does not evenly divide the j-direction layout, NJPROC=,",i4,".")') & io_layout(2),layout(2) call MOM_error(FATAL, mesg) endif ; endif @@ -1834,12 +1834,23 @@ end subroutine MOM_domains_init !! some properties of the new type to differ from the original one. subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, & domain_name) - type(MOM_domain_type), intent(in) :: MD_in - type(MOM_domain_type), pointer :: MOM_dom - integer, dimension(2), optional, intent(inout) :: min_halo - integer, optional, intent(in) :: halo_size - logical, optional, intent(in) :: symmetric - character(len=*), optional, intent(in) :: domain_name + type(MOM_domain_type), intent(in) :: MD_in !< An existing MOM_domain + type(MOM_domain_type), pointer :: MOM_dom !< A pointer to a MOM_domain that will be + !! allocated if it is unassociated, and will have data + !! copied from MD_in + integer, dimension(2), & + optional, intent(inout) :: min_halo !< If present, this sets the + !! minimum halo size for this domain in the i- and j- + !! directions, and returns the actual halo size used. + integer, optional, intent(in) :: halo_size !< If present, this sets the halo + !! size for the domian in the i- and j-directions. + !! min_halo and halo_size can not both be present. + logical, optional, intent(in) :: symmetric !< If present, this specifies + !! whether the new domain is symmetric, regardless of + !! whether the macro SYMMETRIC_MEMORY_ is defined. + character(len=*), & + optional, intent(in) :: domain_name !< A name for the new domain, "MOM" + !! if missing. integer :: global_indices(4) logical :: mask_table_exists @@ -1915,12 +1926,21 @@ end subroutine clone_MD_to_MD !! the original one. subroutine clone_MD_to_d2D(MD_in, mpp_domain, min_halo, halo_size, symmetric, & domain_name) - type(MOM_domain_type), intent(in) :: MD_in - type(domain2d), intent(inout) :: mpp_domain - integer, dimension(2), optional, intent(inout) :: min_halo - integer, optional, intent(in) :: halo_size - logical, optional, intent(in) :: symmetric - character(len=*), optional, intent(in) :: domain_name + type(MOM_domain_type), intent(in) :: MD_in !< An existing MOM_domain to be cloned + type(domain2d), intent(inout) :: mpp_domain !< The new mpp_domain to be set up + integer, dimension(2), & + optional, intent(inout) :: min_halo !< If present, this sets the + !! minimum halo size for this domain in the i- and j- + !! directions, and returns the actual halo size used. + integer, optional, intent(in) :: halo_size !< If present, this sets the halo + !! size for the domian in the i- and j-directions. + !! min_halo and halo_size can not both be present. + logical, optional, intent(in) :: symmetric !< If present, this specifies + !! whether the new domain is symmetric, regardless of + !! whether the macro SYMMETRIC_MEMORY_ is defined. + character(len=*), & + optional, intent(in) :: domain_name !< A name for the new domain, "MOM" + !! if missing. integer :: global_indices(4), layout(2), io_layout(2) integer :: X_FLAGS, Y_FLAGS, niglobal, njglobal, nihalo, njhalo @@ -1981,7 +2001,7 @@ subroutine get_domain_extent(Domain, isc, iec, jsc, jec, isd, ied, jsd, jed, & isg, ieg, jsg, jeg, idg_offset, jdg_offset, & symmetric, local_indexing, index_offset) type(MOM_domain_type), & - intent(in) :: Domain + intent(in) :: Domain !< The MOM domain from which to extract information integer, intent(out) :: isc, iec, jsc, jec !< The start & end indices of the computational !! domain. integer, intent(out) :: isd, ied, jsd, jed !< The start & end indices of the data domain. @@ -2042,7 +2062,7 @@ end subroutine get_domain_extent !> Returns the global shape of h-point arrays subroutine get_global_shape(domain, niglobal, njglobal) - type(MOM_domain_type), intent(in) :: domain !< MOM domain + type(MOM_domain_type), intent(in) :: domain !< MOM domain integer, intent(out) :: niglobal !< i-index global size of h-point arrays integer, intent(out) :: njglobal !< j-index global size of h-point arrays From 396b9bce4e86eaef228752d6e89bd3ac0c26827b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:20:26 -0400 Subject: [PATCH 0212/1072] dOxyGenized MOM_intrinsic_functions.F90 Added dOxyGen comments for all remaining routines and arguments in MOM_intrinsic_functions.F90. All answers are bitwise identical. --- src/framework/MOM_intrinsic_functions.F90 | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/src/framework/MOM_intrinsic_functions.F90 b/src/framework/MOM_intrinsic_functions.F90 index 6e829c2072..664f87ad3f 100644 --- a/src/framework/MOM_intrinsic_functions.F90 +++ b/src/framework/MOM_intrinsic_functions.F90 @@ -9,23 +9,25 @@ module MOM_intrinsic_functions !* * !********+*********+*********+*********+*********+*********+*********+** - implicit none - private +implicit none ; private - public :: invcosh +public :: invcosh - contains +contains - function invcosh(x) - real, intent(in) :: x - real :: invcosh +!> Evaluate the inverse cosh, either using a math library or an +!! equivalent expression +function invcosh(x) + real, intent(in) :: x !< The argument of the inverse of cosh. NaNs will + !! occur if x<1, but there is no error checking + real :: invcosh #ifdef __INTEL_COMPILER - invcosh=acosh(x) + invcosh = acosh(x) #else - invcosh=log(x+sqrt(x*x-1)) + invcosh = log(x+sqrt(x*x-1)) #endif - end function invcosh +end function invcosh end module MOM_intrinsic_functions From d9e8f1f3d9f895356b46805e6f7de9b10b749e4d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:20:45 -0400 Subject: [PATCH 0213/1072] dOxyGenized MOM_io.F90 Added dOxyGen comments for all remaining routines and arguments in MOM_io.F90. All answers are bitwise identical. --- src/framework/MOM_io.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 17ba449715..178924d0d7 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -433,10 +433,11 @@ subroutine reopen_file(unit, filename, vars, novars, fields, threading, timeunit end subroutine reopen_file - +!> Read the data associated with a named axis in a file subroutine read_axis_data(filename, axis_name, var) - character(len=*), intent(in) :: filename, axis_name - real, dimension(:), intent(out) :: var + character(len=*), intent(in) :: filename !< Name of the file to read + character(len=*), intent(in) :: axis_name !< Name of the axis to read + real, dimension(:), intent(out) :: var !< The axis location data integer :: i,len,unit, ndim, nvar, natt, ntime logical :: axis_found From 397d2588df2e7d2e1728233105f05b91a91fe63e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:21:12 -0400 Subject: [PATCH 0214/1072] dOxyGenized MOM_restart.F90 Added dOxyGen comments for all remaining routines and arguments in MOM_restart.F90. All answers are bitwise identical. --- src/framework/MOM_restart.F90 | 135 ++++++++++++++++++++++------------ 1 file changed, 86 insertions(+), 49 deletions(-) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index bb34fe4985..d2d782e2c1 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -147,7 +147,8 @@ module MOM_restart !> Register a 3-d field for restarts, providing the metadata in a structure subroutine register_restart_field_ptr3d(f_ptr, var_desc, mandatory, CS) - real, dimension(:,:,:), target :: f_ptr !< A pointer to the field to be read or written + real, dimension(:,:,:), & + target, intent(in) :: f_ptr !< A pointer to the field to be read or written type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. @@ -177,7 +178,8 @@ end subroutine register_restart_field_ptr3d !> Register a 4-d field for restarts, providing the metadata in a structure subroutine register_restart_field_ptr4d(f_ptr, var_desc, mandatory, CS) - real, dimension(:,:,:,:), target :: f_ptr !< A pointer to the field to be read or written + real, dimension(:,:,:,:), & + target, intent(in) :: f_ptr !< A pointer to the field to be read or written type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. @@ -207,7 +209,8 @@ end subroutine register_restart_field_ptr4d !> Register a 2-d field for restarts, providing the metadata in a structure subroutine register_restart_field_ptr2d(f_ptr, var_desc, mandatory, CS) - real, dimension(:,:), target :: f_ptr !< A pointer to the field to be read or written + real, dimension(:,:), & + target, intent(in) :: f_ptr !< A pointer to the field to be read or written type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. @@ -237,7 +240,7 @@ end subroutine register_restart_field_ptr2d !> Register a 1-d field for restarts, providing the metadata in a structure subroutine register_restart_field_ptr1d(f_ptr, var_desc, mandatory, CS) - real, dimension(:), target :: f_ptr !< A pointer to the field to be read or written + real, dimension(:), target, intent(in) :: f_ptr !< A pointer to the field to be read or written type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. @@ -267,7 +270,7 @@ end subroutine register_restart_field_ptr1d !> Register a 0-d field for restarts, providing the metadata in a structure subroutine register_restart_field_ptr0d(f_ptr, var_desc, mandatory, CS) - real, target :: f_ptr !< A pointer to the field to be read or written + real, target, intent(in) :: f_ptr !< A pointer to the field to be read or written type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. @@ -300,7 +303,8 @@ end subroutine register_restart_field_ptr0d !> Register a 4-d field for restarts, providing the metadata as individual arguments subroutine register_restart_field_4d(f_ptr, name, mandatory, CS, longname, units, & hor_grid, z_grid, t_grid) - real, dimension(:,:,:,:), target :: f_ptr !< A pointer to the field to be read or written + real, dimension(:,:,:,:), & + target, intent(in) :: f_ptr !< A pointer to the field to be read or written character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. @@ -326,7 +330,8 @@ end subroutine register_restart_field_4d !> Register a 3-d field for restarts, providing the metadata as individual arguments subroutine register_restart_field_3d(f_ptr, name, mandatory, CS, longname, units, & hor_grid, z_grid, t_grid) - real, dimension(:,:,:), target :: f_ptr !< A pointer to the field to be read or written + real, dimension(:,:,:), & + target, intent(in) :: f_ptr !< A pointer to the field to be read or written character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. @@ -352,7 +357,8 @@ end subroutine register_restart_field_3d !> Register a 2-d field for restarts, providing the metadata as individual arguments subroutine register_restart_field_2d(f_ptr, name, mandatory, CS, longname, units, & hor_grid, z_grid, t_grid) - real, dimension(:,:), target :: f_ptr !< A pointer to the field to be read or written + real, dimension(:,:), & + target, intent(in) :: f_ptr !< A pointer to the field to be read or written character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. @@ -380,7 +386,7 @@ end subroutine register_restart_field_2d !> Register a 1-d field for restarts, providing the metadata as individual arguments subroutine register_restart_field_1d(f_ptr, name, mandatory, CS, longname, units, & hor_grid, z_grid, t_grid) - real, dimension(:), target :: f_ptr !< A pointer to the field to be read or written + real, dimension(:), target, intent(in) :: f_ptr !< A pointer to the field to be read or written character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. @@ -408,7 +414,7 @@ end subroutine register_restart_field_1d !> Register a 0-d field for restarts, providing the metadata as individual arguments subroutine register_restart_field_0d(f_ptr, name, mandatory, CS, longname, units, & t_grid) - real, target :: f_ptr !< A pointer to the field to be read or written + real, target, intent(in) :: f_ptr !< A pointer to the field to be read or written character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. @@ -432,8 +438,8 @@ end subroutine register_restart_field_0d !> query_initialized_name determines whether a named field has been successfully !! read from a restart file yet. function query_initialized_name(name, CS) result(query_initialized) - character(len=*) :: name - type(MOM_restart_CS), pointer :: CS + character(len=*), intent(in) :: name !< The name of the field that is being queried + type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) logical :: query_initialized ! This subroutine returns .true. if the field referred to by name has ! initialized from a restart file, and .false. otherwise. @@ -467,9 +473,10 @@ function query_initialized_name(name, CS) result(query_initialized) end function query_initialized_name +!> Indicate whether the field pointed to by f_ptr has been initialized from a restart file. function query_initialized_0d(f_ptr, CS) result(query_initialized) - real, target :: f_ptr - type(MOM_restart_CS), pointer :: CS + real, target, intent(in) :: f_ptr !< A pointer to the field that is being queried + type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) logical :: query_initialized ! This subroutine tests whether the field pointed to by f_ptr has ! been initialized from a restart file. @@ -496,9 +503,10 @@ function query_initialized_0d(f_ptr, CS) result(query_initialized) end function query_initialized_0d +!> Indicate whether the field pointed to by f_ptr has been initialized from a restart file. function query_initialized_1d(f_ptr, CS) result(query_initialized) - real, dimension(:), target :: f_ptr - type(MOM_restart_CS), pointer :: CS + real, dimension(:), target, intent(in) :: f_ptr !< A pointer to the field that is being queried + type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) logical :: query_initialized ! This subroutine tests whether the field pointed to by f_ptr has ! been initialized from a restart file. @@ -525,9 +533,11 @@ function query_initialized_1d(f_ptr, CS) result(query_initialized) end function query_initialized_1d +!> Indicate whether the field pointed to by f_ptr has been initialized from a restart file. function query_initialized_2d(f_ptr, CS) result(query_initialized) - real, dimension(:,:), target :: f_ptr - type(MOM_restart_CS), pointer :: CS + real, dimension(:,:), & + target, intent(in) :: f_ptr !< A pointer to the field that is being queried + type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) logical :: query_initialized ! This subroutine tests whether the field pointed to by f_ptr has ! been initialized from a restart file. @@ -554,9 +564,11 @@ function query_initialized_2d(f_ptr, CS) result(query_initialized) end function query_initialized_2d +!> Indicate whether the field pointed to by f_ptr has been initialized from a restart file. function query_initialized_3d(f_ptr, CS) result(query_initialized) - real, dimension(:,:,:), target :: f_ptr - type(MOM_restart_CS), pointer :: CS + real, dimension(:,:,:), & + target, intent(in) :: f_ptr !< A pointer to the field that is being queried + type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) logical :: query_initialized ! This subroutine tests whether the field pointed to by f_ptr has ! been initialized from a restart file. @@ -583,9 +595,11 @@ function query_initialized_3d(f_ptr, CS) result(query_initialized) end function query_initialized_3d +!> Indicate whether the field pointed to by f_ptr has been initialized from a restart file. function query_initialized_4d(f_ptr, CS) result(query_initialized) - real, dimension(:,:,:,:), target :: f_ptr - type(MOM_restart_CS), pointer :: CS + real, dimension(:,:,:,:), & + target, intent(in) :: f_ptr !< A pointer to the field that is being queried + type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) logical :: query_initialized ! This subroutine tests whether the field pointed to by f_ptr has ! been initialized from a restart file. @@ -612,10 +626,12 @@ function query_initialized_4d(f_ptr, CS) result(query_initialized) end function query_initialized_4d +!> Indicate whether the field pointed to by f_ptr or with the specified variable +!! name has been initialized from a restart file. function query_initialized_0d_name(f_ptr, name, CS) result(query_initialized) - real, target :: f_ptr - character(len=*) :: name - type(MOM_restart_CS), pointer :: CS + real, target, intent(in) :: f_ptr !< A pointer to the field that is being queried + character(len=*), intent(in) :: name !< The name of the field that is being queried + type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) logical :: query_initialized ! This subroutine tests whether the field pointed to by f_ptr or with the ! specified variable name has been initialized from a restart file. @@ -649,10 +665,13 @@ function query_initialized_0d_name(f_ptr, name, CS) result(query_initialized) end function query_initialized_0d_name +!> Indicate whether the field pointed to by f_ptr or with the specified variable +!! name has been initialized from a restart file. function query_initialized_1d_name(f_ptr, name, CS) result(query_initialized) - real, dimension(:), target :: f_ptr - character(len=*) :: name - type(MOM_restart_CS), pointer :: CS + real, dimension(:), & + target, intent(in) :: f_ptr !< A pointer to the field that is being queried + character(len=*), intent(in) :: name !< The name of the field that is being queried + type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) logical :: query_initialized ! This subroutine tests whether the field pointed to by f_ptr or with the ! specified variable name has been initialized from a restart file. @@ -686,10 +705,13 @@ function query_initialized_1d_name(f_ptr, name, CS) result(query_initialized) end function query_initialized_1d_name +!> Indicate whether the field pointed to by f_ptr or with the specified variable +!! name has been initialized from a restart file. function query_initialized_2d_name(f_ptr, name, CS) result(query_initialized) - real, dimension(:,:), target :: f_ptr - character(len=*) :: name - type(MOM_restart_CS), pointer :: CS + real, dimension(:,:), & + target, intent(in) :: f_ptr !< A pointer to the field that is being queried + character(len=*), intent(in) :: name !< The name of the field that is being queried + type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) logical :: query_initialized ! This subroutine tests whether the field pointed to by f_ptr or with the ! specified variable name has been initialized from a restart file. @@ -723,10 +745,13 @@ function query_initialized_2d_name(f_ptr, name, CS) result(query_initialized) end function query_initialized_2d_name +!> Indicate whether the field pointed to by f_ptr or with the specified variable +!! name has been initialized from a restart file. function query_initialized_3d_name(f_ptr, name, CS) result(query_initialized) - real, dimension(:,:,:), target :: f_ptr - character(len=*) :: name - type(MOM_restart_CS), pointer :: CS + real, dimension(:,:,:), & + target, intent(in) :: f_ptr !< A pointer to the field that is being queried + character(len=*), intent(in) :: name !< The name of the field that is being queried + type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) logical :: query_initialized ! This subroutine tests whether the field pointed to by f_ptr or with the ! specified variable name has been initialized from a restart file. @@ -760,10 +785,13 @@ function query_initialized_3d_name(f_ptr, name, CS) result(query_initialized) end function query_initialized_3d_name +!> Indicate whether the field pointed to by f_ptr or with the specified variable +!! name has been initialized from a restart file. function query_initialized_4d_name(f_ptr, name, CS) result(query_initialized) - real, dimension(:,:,:,:), target :: f_ptr - character(len=*) :: name - type(MOM_restart_CS), pointer :: CS + real, dimension(:,:,:,:), & + target, intent(in) :: f_ptr !< A pointer to the field that is being queried + character(len=*), intent(in) :: name !< The name of the field that is being queried + type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in) logical :: query_initialized ! This subroutine tests whether the field pointed to by f_ptr or with the ! specified variable name has been initialized from a restart file. @@ -797,14 +825,17 @@ function query_initialized_4d_name(f_ptr, name, CS) result(query_initialized) end function query_initialized_4d_name +!> save_restart saves all registered variables to restart files. subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV) -! save_restart saves all registered variables to restart files. - character(len=*), intent(in) :: directory - type(time_type), intent(in) :: time - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(MOM_restart_CS), pointer :: CS - logical, optional, intent(in) :: time_stamped - character(len=*), optional, intent(in) :: filename + character(len=*), intent(in) :: directory !< The directory where the restart files + !! are to be written + type(time_type), intent(in) :: time !< The current model time + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(MOM_restart_CS), pointer :: CS !< The control structure returned by a previous + !! call to restart_init. + logical, optional, intent(in) :: time_stamped !< If present and true, add time-stamp + !! to the restart file names. + character(len=*), optional, intent(in) :: filename !< A filename that overrides the name in CS%restartfile. type(verticalGrid_type), optional, intent(in) :: GV !< The ocean's vertical grid structure ! Arguments: directory - The directory where the restart file goes. ! (in) time - The time of this restart file. @@ -1531,10 +1562,14 @@ function open_restart_units(filename, directory, G, CS, units, file_paths, & end function open_restart_units +!> Initialize this module and set up a restart control structure. subroutine restart_init(param_file, CS, restart_root) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(MOM_restart_CS), pointer :: CS - character(len=*), optional, intent(in) :: restart_root + type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object that is allocated here + character(len=*), optional, & + intent(in) :: restart_root !< A filename root that overrides the value + !! set by RESTARTFILE to enable the use of this module by + !! other components than MOM. ! Arguments: param_file - A structure indicating the open file to parse for ! model parameter values. ! (in/out) CS - A pointer that is set to point to the control structure @@ -1590,8 +1625,9 @@ subroutine restart_init(param_file, CS, restart_root) end subroutine restart_init +!> Indicate that all variables have now been registered. subroutine restart_init_end(CS) - type(MOM_restart_CS), pointer :: CS + type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object if (associated(CS)) then if (CS%novars == 0) call restart_end(CS) @@ -1599,8 +1635,9 @@ subroutine restart_init_end(CS) end subroutine restart_init_end +!> Deallocate memory associated with a MOM_restart_CS variable. subroutine restart_end(CS) - type(MOM_restart_CS), pointer :: CS + type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object if (associated(CS%restart_field)) deallocate(CS%restart_field) if (associated(CS%var_ptr0d)) deallocate(CS%var_ptr0d) @@ -1613,7 +1650,7 @@ subroutine restart_end(CS) end subroutine restart_end subroutine restart_error(CS) - type(MOM_restart_CS), pointer :: CS + type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object ! Arguments: CS - A pointer that is set to point to the control structure ! for this module. (Intent in.) character(len=16) :: num ! String for error messages From 434f77c909dd6850e728f20f3701ff3d310004cf Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:21:31 -0400 Subject: [PATCH 0215/1072] dOxyGenized MOM_string_functions.F90 Added dOxyGen comments for all routines and arguments in MOM_string_functions.F90. All answers are bitwise identical. --- src/framework/MOM_string_functions.F90 | 66 +++++++++++++------------- 1 file changed, 32 insertions(+), 34 deletions(-) diff --git a/src/framework/MOM_string_functions.F90 b/src/framework/MOM_string_functions.F90 index 142134ddc5..643b150219 100644 --- a/src/framework/MOM_string_functions.F90 +++ b/src/framework/MOM_string_functions.F90 @@ -27,14 +27,14 @@ module MOM_string_functions contains +!> Return a string in which all uppercase letters have been replaced by +!! their lowercase counterparts. function lowercase(input_string) + character(len=*), intent(in) :: input_string !< The string to modify + character(len=len(input_string)) :: lowercase !< The modified output string ! This function returns a string in which all uppercase letters have been ! replaced by their lowercase counterparts. It is loosely based on the ! lowercase function in mpp_util.F90. - ! Arguments - character(len=*), intent(in) :: input_string - character(len=len(input_string)) :: lowercase - ! Local variables integer, parameter :: co=iachar('a')-iachar('A') ! case offset integer :: k @@ -45,13 +45,14 @@ function lowercase(input_string) enddo end function lowercase +!> Return a string in which all uppercase letters have been replaced by +!! their lowercase counterparts. function uppercase(input_string) - character(len=*), intent(in) :: input_string - character(len=len(input_string)) :: uppercase + character(len=*), intent(in) :: input_string !< The string to modify + character(len=len(input_string)) :: uppercase !< The modified output string ! This function returns a string in which all lowercase letters have been ! replaced by their uppercase counterparts. It is loosely based on the ! uppercase function in mpp_util.F90. - ! Arguments integer, parameter :: co=iachar('A')-iachar('a') ! case offset integer :: k @@ -62,25 +63,23 @@ function uppercase(input_string) enddo end function uppercase +!> Returns a character string of a left-formatted integer +!! e.g. "123 " (assumes 19 digit maximum) function left_int(i) -! Returns a character string of a left-formatted integer -! e.g. "123 " (assumes 19 digit maximum) - ! Arguments - character(len=19) :: left_int - integer, intent(in) :: i - ! Local variables + integer, intent(in) :: i !< The integer to convert to a string + character(len=19) :: left_int !< The output string + character(len=19) :: tmp write(tmp(1:19),'(I19)') i write(left_int(1:19),'(A)') adjustl(tmp) end function left_int +!> Returns a character string of a comma-separated, compact formatted, +!! integers e.g. "1, 2, 3, 4" function left_ints(i) -! Returns a character string of a comma-separated, compact formatted, -! integers e.g. "1, 2, 3, 4" - ! Arguments - character(len=1320) :: left_ints - integer, intent(in) :: i(:) - ! Local variables + integer, intent(in) :: i(:) !< The array of integers to convert to a string + character(len=1320) :: left_ints !< The output string + character(len=1320) :: tmp integer :: j write(left_ints(1:1320),'(A)') trim(left_int(i(1))) @@ -92,10 +91,11 @@ function left_ints(i) endif end function left_ints +!> Returns a left-justified string with a real formatted like '(G)' function left_real(val) - real, intent(in) :: val - character(len=32) :: left_real -! Returns a left-justified string with a real formatted like '(G)' + real, intent(in) :: val !< The real variable to convert to a string + character(len=32) :: left_real !< The output string + integer :: l, ind if ((abs(val) < 1.0e4) .and. (abs(val) >= 1.0e-3)) then @@ -143,19 +143,18 @@ function left_real(val) left_real = adjustl(left_real) end function left_real +!> Returns a character string of a comma-separated, compact formatted, reals +!! e.g. "1., 2., 5*3., 5.E2" function left_reals(r,sep) -! Returns a character string of a comma-separated, compact formatted, reals -! e.g. "1., 2., 5*3., 5.E2" - ! Arguments - character(len=1320) :: left_reals - real, intent(in) :: r(:) + real, intent(in) :: r(:) !< The array of real variables to convert to a string character(len=*), optional, intent(in) :: sep !< The separator between !! successive values, by default it is ', '. + character(len=1320) :: left_reals !< The output string - ! Local variables integer :: j, n, b, ns logical :: doWrite character(len=10) :: separator + n=1 ; doWrite=.true. ; left_reals='' ; b=1 if (present(sep)) then separator=sep ; ns=len(sep) @@ -185,11 +184,10 @@ function left_reals(r,sep) enddo end function left_reals +!> Returns True if the string can be read/parsed to give the exact value of "val" function isFormattedFloatEqualTo(str, val) -! Returns True if the string can be read/parsed to give the exact -! value of "val" - character(len=*), intent(in) :: str - real, intent(in) :: val + character(len=*), intent(in) :: str !< The string to parse + real, intent(in) :: val !< The real value to compare with logical :: isFormattedFloatEqualTo ! Local variables real :: scannedVal @@ -204,8 +202,8 @@ end function isFormattedFloatEqualTo !! or "" if the string is not long enough. Both spaces and commas !! are interpreted as separators. character(len=120) function extractWord(string, n) - character(len=*), intent(in) :: string - integer, intent(in) :: n + character(len=*), intent(in) :: string !< The string to scan + integer, intent(in) :: n !< Number of word to extract extractWord = extract_word(string, ' ,', n) From 536382ee8c4129c2b2fcfbc370d5be9e2c3d4cb1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:21:53 -0400 Subject: [PATCH 0216/1072] dOxyGenized MOM_write_cputime.F90 Added dOxyGen comments for all routines and arguments in MOM_write_cputime.F90. All answers are bitwise identical. --- src/framework/MOM_write_cputime.F90 | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/src/framework/MOM_write_cputime.F90 b/src/framework/MOM_write_cputime.F90 index 17d4a3153a..98e7c57e4f 100644 --- a/src/framework/MOM_write_cputime.F90 +++ b/src/framework/MOM_write_cputime.F90 @@ -49,8 +49,10 @@ module MOM_write_cputime contains +!> Evaluate the CPU time returned by SYSTEM_CLOCK at the start of a run subroutine write_cputime_start_clock(CS) - type(write_cputime_CS), pointer :: CS + type(write_cputime_CS), pointer :: CS !< The control structure set up by a previous + !! call to MOM_write_cputime_init. ! Argument: CS - A pointer that is set to point to the control structure ! for this module integer :: new_cputime ! The CPU time returned by SYSTEM_CLOCK @@ -60,11 +62,13 @@ subroutine write_cputime_start_clock(CS) CS%prev_cputime = new_cputime end subroutine write_cputime_start_clock +!> Initialize the MOM_write_cputime module. subroutine MOM_write_cputime_init(param_file, directory, Input_start_time, CS) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - character(len=*), intent(in) :: directory - type(time_type), intent(in) :: Input_start_time - type(write_cputime_CS), pointer :: CS + character(len=*), intent(in) :: directory !< The directory where the CPU time file goes. + type(time_type), intent(in) :: Input_start_time !< The start model time of the simulation. + type(write_cputime_CS), pointer :: CS !< A pointer that may be set to point to the + !! control structure for this module. ! Arguments: param_file - A structure indicating the open file to parse for ! model parameter values. ! (in) directory - The directory where the energy file goes. @@ -106,11 +110,15 @@ subroutine MOM_write_cputime_init(param_file, directory, Input_start_time, CS) end subroutine MOM_write_cputime_init +!> This subroutine assesses how much CPU time the model has taken and determines how long the model +!! should be run before it saves a restart file and stops itself. subroutine write_cputime(day, n, nmax, CS) - type(time_type), intent(inout) :: day - integer, intent(in) :: n - integer, intent(inout) :: nmax - type(write_cputime_CS), pointer :: CS + type(time_type), intent(inout) :: day !< The current model time. + integer, intent(in) :: n !< The time step number of the current execution. + integer, intent(inout) :: nmax !< The number of iterations after which to stop so + !! that the simulation will not run out of CPU time. + type(write_cputime_CS), pointer :: CS !< The control structure set up by a previous + !! call to MOM_write_cputime_init. ! This subroutine assesses how much CPU time the model has ! taken and determines how long the model should be run before it ! saves a restart file and stops itself. From 462595f9898044cf1bf9d257dd29ce33346e0b66 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:29:06 -0400 Subject: [PATCH 0217/1072] Removed trailing white space --- src/framework/MOM_coms.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/framework/MOM_coms.F90 b/src/framework/MOM_coms.F90 index 467a7483a4..f8e58d2072 100644 --- a/src/framework/MOM_coms.F90 +++ b/src/framework/MOM_coms.F90 @@ -721,7 +721,7 @@ subroutine EFP_list_sum_across_PEs(EFPs, nval, errors) end subroutine EFP_list_sum_across_PEs -!< This subroutine carries out all of the calls required to close out the infrastructure cleanly. +!< This subroutine carries out all of the calls required to close out the infrastructure cleanly. !! This should only be called in ocean-only runs, as the coupler takes care of this in coupled runs. subroutine MOM_infra_end ! This subroutine should contain all of the calls that are required From 3c95708aa57dae1c386f9a0ab74055e11c214769 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:29:31 -0400 Subject: [PATCH 0218/1072] dOxyGenized MOM_diagnostics.F90 Added dOxyGen comments for all remaining routines and arguments in MOM_diagnostics.F90. All answers are bitwise identical. --- src/diagnostics/MOM_diagnostics.F90 | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 943ed8eb83..8ceca4f691 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -691,15 +691,19 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & end subroutine calculate_diagnostic_fields -!> This subroutine finds location of R_in in an increasing ordered +!> This subroutine finds the location of R_in in an increasing ordered !! list, Rlist, returning as k the element such that !! Rlist(k) <= R_in < Rlist(k+1), and where wt and wt_p are the linear !! weights that should be assigned to elements k and k+1. subroutine find_weights(Rlist, R_in, k, nz, wt, wt_p) - real, intent(in) :: Rlist(:), R_in - integer, intent(inout) :: k - integer, intent(in) :: nz - real, intent(out) :: wt, wt_p + real, dimension(:), & + intent(in) :: Rlist !< The list of target densities, in kg m-3 + real, intent(in) :: R_in !< The density being inserted into Rlist, in kg m-3 + integer, intent(inout) :: k !< The value of k such that Rlist(k) <= R_in < Rlist(k+1) + !! The input value is a first guess + integer, intent(in) :: nz !< The number of layers in Rlist + real, intent(out) :: wt !< The weight of layer k for interpolation, nondim + real, intent(out) :: wt_p !< The weight of layer k+1 for interpolation, nondim ! This subroutine finds location of R_in in an increasing ordered ! list, Rlist, returning as k the element such that @@ -2060,9 +2064,12 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, CS) end subroutine set_dependent_diagnostics +!> Deallocate memory associated with the diagnostics module subroutine MOM_diagnostics_end(CS, ADp) - type(diagnostics_CS), pointer :: CS - type(accel_diag_ptrs), intent(inout) :: ADp + type(diagnostics_CS), pointer :: CS !< Control structure returned by a + !! previous call to diagnostics_init. + type(accel_diag_ptrs), intent(inout) :: ADp !< structure with pointers to + !! accelerations in momentum equation. integer :: m if (associated(CS%e)) deallocate(CS%e) From f5fa06ca28c065abce1f21bbd6ed52779351a0de Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:29:49 -0400 Subject: [PATCH 0219/1072] dOxyGenized MOM_obsolete_diagnostics.F90 Added dOxyGen comments for all remaining routines and arguments in MOM_obsolete_diagnostics.F90. All answers are bitwise identical. --- src/diagnostics/MOM_obsolete_diagnostics.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/diagnostics/MOM_obsolete_diagnostics.F90 b/src/diagnostics/MOM_obsolete_diagnostics.F90 index 4cf55bad3b..4bd5b61255 100644 --- a/src/diagnostics/MOM_obsolete_diagnostics.F90 +++ b/src/diagnostics/MOM_obsolete_diagnostics.F90 @@ -64,9 +64,9 @@ end subroutine register_obsolete_diagnostics !> Fakes a register of a diagnostic to find out if an obsolete !! parameter appears in the diag_table. logical function found_in_diagtable(diag, varName, newVarName) - type(diag_ctrl), intent(in) :: diag - character(len=*), intent(in) :: varName - character(len=*), optional, intent(in) :: newVarName + type(diag_ctrl), intent(in) :: diag !< A structure used to control diagnostics. + character(len=*), intent(in) :: varName !< The obsolete diagnostic name + character(len=*), optional, intent(in) :: newVarName !< The valid name of this diagnostic ! Local integer :: handle ! Integer handle returned from diag_manager From 1d105038299270d22478faae738e69491f03798b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:30:06 -0400 Subject: [PATCH 0220/1072] dOxyGenized MOM_wave_structure.F90 Added dOxyGen comments for all remaining routines and arguments in MOM_wave_structure.F90. All answers are bitwise identical. --- src/diagnostics/MOM_wave_structure.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 88f5bc06d5..b0a889b722 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -598,7 +598,7 @@ end subroutine wave_structure !> This subroutine solves a tri-diagonal system Ax=y using either the standard !! Thomas algorithim (TDMA_T) or its more stable variant that invokes the !! "Hallberg substitution" (TDMA_H). -subroutine tridiag_solver(a,b,c,h,y,method,x) +subroutine tridiag_solver(a, b, c, h, y, method, x) real, dimension(:), intent(in) :: a !< lower diagonal with first entry equal to zero. real, dimension(:), intent(in) :: b !< middle diagonal. real, dimension(:), intent(in) :: c !< upper diagonal with last entry equal to zero. @@ -610,7 +610,7 @@ subroutine tridiag_solver(a,b,c,h,y,method,x) !! where a(k)=[-alpha(k-1/2)], b(k)=[alpha(k-1/2)+alpha(k+1/2) + h(k)], !! and c(k)=[-alpha(k+1/2)]. Only used with TDMA_H method. real, dimension(:), intent(in) :: y !< vector of known values on right hand side. - character(len=*), intent(in) :: method + character(len=*), intent(in) :: method !< A string describing the algorithm to use real, dimension(:), intent(out) :: x !< vector of unknown values to solve for. ! This subroutine solves a tri-diagonal system Ax=y using either the standard From 28da3a2a878c94a0b3e50ff9bde42970d2fd588b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:30:37 -0400 Subject: [PATCH 0221/1072] dOxyGenized MOM_grid_initialization.F90 Added dOxyGen comments for all remaining routines and arguments in MOM_grid_initialization.F90. All answers are bitwise identical. --- src/initialization/MOM_grid_initialize.F90 | 107 ++++++++++++++------- 1 file changed, 70 insertions(+), 37 deletions(-) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index f59728af8f..78d2a3fb8c 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -70,16 +70,27 @@ module MOM_grid_initialize public set_grid_metrics, initialize_masks, Adcroft_reciprocal type, public :: GPS ; private - real :: len_lon - real :: len_lat - real :: west_lon - real :: south_lat - real :: Rad_Earth - real :: Lat_enhance_factor - real :: Lat_eq_enhance - logical :: isotropic - logical :: equator_reference - integer :: niglobal, njglobal ! Duplicates of niglobal and njglobal from MOM_dom + real :: len_lon !< The longitudinal or x-direction length of the domain. + real :: len_lat !< The latitudinal or y-direction length of the domain. + real :: west_lon !< The western longitude of the domain or the equivalent + !! starting value for the x-axis. + real :: south_lat !< The southern latitude of the domain or the equivalent + !! starting value for the y-axis. + real :: Rad_Earth !< The radius of the Earth, in m. + real :: Lat_enhance_factor !< The amount by which the meridional resolution + !! is enhanced within LAT_EQ_ENHANCE of the equator. + real :: Lat_eq_enhance !< The latitude range to the north and south of the equator + !! over which the resolution is enhanced, in degrees. + logical :: isotropic !< If true, an isotropic grid on a sphere (also known as a Mercator grid) + !! is used. With an isotropic grid, the meridional extent of the domain + !! (LENLAT), the zonal extent (LENLON), and the number of grid points in each + !! direction are _not_ independent. In MOM the meridional extent is determined + !! to fit the zonal extent and the number of grid points, while grid is + !! perfectly isotropic. + logical :: equator_reference !< If true, the grid is defined to have the equator at the + !! nearest q- or h- grid point to (-LOWLAT*NJGLOBAL/LENLAT). + integer :: niglobal !< The number of i-points in the global grid computational domain + integer :: njglobal !< The number of j-points in the global grid computational domain end type GPS contains @@ -966,9 +977,11 @@ subroutine set_grid_metrics_mercator(G, param_file) end subroutine set_grid_metrics_mercator +!> This function returns the grid spacing in the logical x direction. function ds_di(x, y, GP) - real, intent(in) :: x, y - type(GPS), intent(in) :: GP + real, intent(in) :: x !< The longitude in question + real, intent(in) :: y !< The latitude in question + type(GPS), intent(in) :: GP !< A structure of grid parameters real :: ds_di ! This function returns the grid spacing in the logical x direction. ! Arguments: x - The latitude in question. @@ -979,9 +992,11 @@ function ds_di(x, y, GP) ! dy_di(x,y,GP)*dy_di(x,y,GP)) end function ds_di +!> This function returns the grid spacing in the logical y direction. function ds_dj(x, y, GP) - real, intent(in) :: x, y - type(GPS), intent(in) :: GP + real, intent(in) :: x !< The longitude in question + real, intent(in) :: y !< The latitude in question + type(GPS), intent(in) :: GP !< A structure of grid parameters real :: ds_dj ! This function returns the grid spacing in the logical y direction. ! Arguments: x - The latitude in question. @@ -993,13 +1008,18 @@ function ds_dj(x, y, GP) end function ds_dj +!> This function returns the contribution from the line integral along one of the four sides of a +!! cell face to the area of a cell, assuming that the sides follow a linear path in latitude and +!! longitude (i.e., on a Mercator grid). function dL(x1, x2, y1, y2) - real, intent(in) :: x1, x2, y1, y2 + real, intent(in) :: x1 !< Segment starting longitude, in degrees E. + real, intent(in) :: x2 !< Segment ending longitude, in degrees E. + real, intent(in) :: y1 !< Segment ending latitude, in degrees N. + real, intent(in) :: y2 !< Segment ending latitude, in degrees N. real :: dL -! This subroutine calculates the contribution from the line integral -! along one of the four sides of a cell face to the area of a cell, -! assuming that the sides follow a linear path in latitude and long- -! itude (i.e., on a Mercator grid). +! This subroutine calculates the contribution from the line integral along one +! of the four sides of a cell face to the area of a cell, assuming that the +! sides follow a linear path in latitude and longitude (i.e., on a Mercator grid). ! Argumnts: x1 - Segment starting longitude. ! (in) x2 - Segment ending longitude. ! (in) y1 - Segment ending latitude. @@ -1017,17 +1037,25 @@ function dL(x1, x2, y1, y2) end function dL +!> This subroutine finds and returns the value of y at which the monotonically increasing +!! function fn takes the value fnval, also returning in ittmax the number of iterations of +!! Newton's method that were used to polish the root. function find_root( fn, dy_df, GP, fnval, y1, ymin, ymax, ittmax) - real :: find_root - real, external :: fn, dy_df - type(GPS), intent(in) :: GP - real, intent(in) :: fnval, y1, ymin, ymax - integer, intent(out) :: ittmax - real :: y, y_next + real :: find_root !< The value of y where fn(y) = fnval that will be returned + real, external :: fn !< The external function whose root is being sought + real, external :: dy_df !< The inverse of the derivative of that function + type(GPS), intent(in) :: GP !< A structure of grid parameters + real, intent(in) :: fnval !< The value of fn being sought + real, intent(in) :: y1 !< A first guess for y + real, intent(in) :: ymin !< The minimum permitted value of y + real, intent(in) :: ymax !< The maximum permitted value of y + integer, intent(out) :: ittmax !< The number of iterations used to polish the root + ! This subroutine finds and returns the value of y at which the ! monotonically increasing function fn takes the value fnval, also returning ! in ittmax the number of iterations of Newton's method that were ! used to polish the root. + real :: y, y_next real :: ybot, ytop, fnbot, fntop integer :: itt character(len=256) :: warnmesg @@ -1126,21 +1154,24 @@ function find_root( fn, dy_df, GP, fnval, y1, ymin, ymax, ittmax) find_root = y end function find_root +!> This function calculates and returns the value of dx/di, where x is the +!! longitude in Radians, and i is the integral north-south grid index. function dx_di(x, GP) - real, intent(in) :: x - type(GPS), intent(in) :: GP + real, intent(in) :: x !< The longitude in question + type(GPS), intent(in) :: GP !< A structure of grid parameters real :: dx_di ! This subroutine calculates and returns the value of dx/di, where -! x is the longitude in Radians, and i is the integral north-south -! grid index. +! x is the longitude in Radians, and i is the integral north-south grid index. dx_di = (GP%len_lon * 4.0*atan(1.0)) / (180.0 * GP%niglobal) end function dx_di +!> This function calculates and returns the integral of the inverse +!! of dx/di to the point x, in radians. function Int_di_dx(x, GP) - real, intent(in) :: x - type(GPS), intent(in) :: GP + real, intent(in) :: x !< The longitude in question + type(GPS), intent(in) :: GP !< A structure of grid parameters real :: Int_di_dx ! This subroutine calculates and returns the integral of the inverse ! of dx/di to the point x, in radians. @@ -1149,9 +1180,11 @@ function Int_di_dx(x, GP) end function Int_di_dx +!> This subroutine calculates and returns the value of dy/dj, where y is the +!! latitude in Radians, and j is the integral north-south grid index. function dy_dj(y, GP) - real, intent(in) :: y - type(GPS), intent(in) :: GP + real, intent(in) :: y !< The latitude in question + type(GPS), intent(in) :: GP !< A structure of grid parameters real :: dy_dj ! This subroutine calculates and returns the value of dy/dj, where ! y is the latitude in Radians, and j is the integral north-south @@ -1178,9 +1211,11 @@ function dy_dj(y, GP) end function dy_dj +!> This subroutine calculates and returns the integral of the inverse +!! of dy/dj to the point y, in radians. function Int_dj_dy(y, GP) - real, intent(in) :: y - type(GPS), intent(in) :: GP + real, intent(in) :: y !< The latitude in question + type(GPS), intent(in) :: GP !< A structure of grid parameters real :: Int_dj_dy ! This subroutine calculates and returns the integral of the inverse ! of dy/dj to the point y, in radians. @@ -1223,8 +1258,6 @@ end function Int_dj_dy ! ------------------------------------------------------------------------------ -! ------------------------------------------------------------------------------ - !> extrapolate_metric extrapolates missing metric data into all the halo regions. subroutine extrapolate_metric(var, jh, missing) real, dimension(:,:), intent(inout) :: var !< The array in which to fill in halos From a4990dece40cb8b4950acc1a577189bb7b0ecfd0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:31:44 -0400 Subject: [PATCH 0222/1072] dOxyGenized MOM_sum_output.F90 Added dOxyGen comments for all routines and arguments in MOM_sum_output.F90. All answers are bitwise identical. --- src/diagnostics/MOM_sum_output.F90 | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 17427fb80f..8e6cd8b8f1 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -1076,7 +1076,8 @@ end subroutine accumulate_net_input !! or it might be created anew. (For now only new creation occurs. subroutine depth_list_setup(G, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(Sum_output_CS), pointer :: CS + type(Sum_output_CS), pointer :: CS !< The control structure returned by a + !! previous call to MOM_sum_output_init. ! This subroutine sets up an ordered list of depths, along with the ! cross sectional areas at each depth and the volume of fluid deeper ! than each depth. This might be read from a previously created file @@ -1232,10 +1233,11 @@ end subroutine create_depth_list !> This subroutine writes out the depth list to the specified file. subroutine write_depth_list(G, CS, filename, list_size) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(Sum_output_CS), pointer :: CS - character(len=*), intent(in) :: filename - integer, intent(in) :: list_size + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(Sum_output_CS), pointer :: CS !< The control structure returned by a + !! previous call to MOM_sum_output_init. + character(len=*), intent(in) :: filename !< The path to the depth list file to write. + integer, intent(in) :: list_size !< The size of the depth list. ! This subroutine writes out the depth list to the specified file. @@ -1314,9 +1316,10 @@ end subroutine write_depth_list !> This subroutine reads in the depth list to the specified file !! and allocates and sets up CS%DL and CS%list_size . subroutine read_depth_list(G, CS, filename) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(Sum_output_CS), pointer :: CS - character(len=*), intent(in) :: filename + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(Sum_output_CS), pointer :: CS !< The control structure returned by a + !! previous call to MOM_sum_output_init. + character(len=*), intent(in) :: filename !< The path to the depth list file to read. ! This subroutine reads in the depth list to the specified file ! and allocates and sets up CS%DL and CS%list_size . From 5663737ae2ec4455290c3dc276cf48470b372468 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:32:55 -0400 Subject: [PATCH 0223/1072] dOxyGenized solo_driver/MOM_surface_forcing.F90 Added dOxyGen comments for all routines and arguments in the solo_driver version of MOM_surface_forcing.F90. Also replaced calls to alloc_if_needed with calls to the functionally equivalent safe_alloc_ptr. All answers are bitwise identical. --- .../solo_driver/MOM_surface_forcing.F90 | 152 ++++++++++-------- 1 file changed, 83 insertions(+), 69 deletions(-) diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 9a25b4b11a..38ac1917a8 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -213,20 +213,23 @@ module MOM_surface_forcing end type surface_forcing_CS - integer :: id_clock_forcing contains +!> This subroutine calls other subroutines in this file to get surface forcing fields. +!! It also allocates and initializes the fields in the forcing and mech_forcing types +!! the first time it is called. subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(forcing), intent(inout) :: fluxes - type(time_type), intent(in) :: day_start - type(time_type), intent(in) :: day_interval + type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields + type(time_type), intent(in) :: day_start !< The start time of the fluxes + type(time_type), intent(in) :: day_interval !< Length of time over which these fluxes applied type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(surface_forcing_CS), pointer :: CS + type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by + !! a previous surface_forcing_init call ! This subroutine calls other subroutines in this file to get surface forcing fields. ! It also allocates and initializes the fields in the flux type. @@ -370,15 +373,17 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS end subroutine set_forcing +!> This subroutine sets the surface wind stresses to constant values subroutine wind_forcing_const(sfc_state, forces, tau_x0, tau_y0, day, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: tau_x0 - real, intent(in) :: tau_y0 - type(time_type), intent(in) :: day + real, intent(in) :: tau_x0 !< The zonal wind stress in Pa + real, intent(in) :: tau_y0 !< The meridional wind stress in Pa + type(time_type), intent(in) :: day !< The time of the fluxes type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(surface_forcing_CS), pointer :: CS + type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by + !! a previous surface_forcing_init call ! subroutine sets the surface wind stresses to zero @@ -424,13 +429,15 @@ subroutine wind_forcing_const(sfc_state, forces, tau_x0, tau_y0, day, G, CS) end subroutine wind_forcing_const +!> This subroutine sets the surface wind stresses to set up two idealized gyres. subroutine wind_forcing_2gyre(sfc_state, forces, day, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), intent(in) :: day + type(time_type), intent(in) :: day !< The time of the fluxes type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(surface_forcing_CS), pointer :: CS + type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by + !! a previous surface_forcing_init call ! This subroutine sets the surface wind stresses according to double gyre. @@ -467,13 +474,15 @@ subroutine wind_forcing_2gyre(sfc_state, forces, day, G, CS) end subroutine wind_forcing_2gyre +!> This subroutine sets the surface wind stresses to set up a single idealized gyre. subroutine wind_forcing_1gyre(sfc_state, forces, day, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), intent(in) :: day + type(time_type), intent(in) :: day !< The time of the fluxes type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(surface_forcing_CS), pointer :: CS + type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by + !! a previous surface_forcing_init call ! This subroutine sets the surface wind stresses according to single gyre. @@ -509,23 +518,17 @@ subroutine wind_forcing_1gyre(sfc_state, forces, day, G, CS) end subroutine wind_forcing_1gyre +!> This subroutine sets the surface wind stresses to set up idealized gyres. subroutine wind_forcing_gyres(sfc_state, forces, day, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), intent(in) :: day + type(time_type), intent(in) :: day !< The time of the fluxes type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(surface_forcing_CS), pointer :: CS + type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by + !! a previous surface_forcing_init call ! This subroutine sets the surface wind stresses according to gyres. - -! Arguments: -! state = structure describing ocean surface state -! (out) fluxes = structure with pointers to forcing fields; unused have NULL ptrs -! (in) day = time of the fluxes -! (in) G = ocean grid structure -! (in) CS = pointer to control struct returned by previous surface_forcing_init call - real :: PI, y integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -561,13 +564,15 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, CS) end subroutine wind_forcing_gyres +! This subroutine sets the surface wind stresses from input files. subroutine wind_forcing_from_file(sfc_state, forces, day, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), intent(in) :: day + type(time_type), intent(in) :: day !< The time of the fluxes type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(surface_forcing_CS), pointer :: CS + type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by + !! a previous surface_forcing_init call ! This subroutine sets the surface wind stresses. @@ -720,13 +725,15 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, CS) end subroutine wind_forcing_from_file +! This subroutine sets the surface wind stresses via the data override facility. subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), intent(in) :: day + type(time_type), intent(in) :: day !< The time of the fluxes type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(surface_forcing_CS), pointer :: CS + type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by + !! a previous surface_forcing_init call ! This subroutine sets the surface wind stresses ! Arguments: @@ -791,29 +798,23 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, CS) end subroutine wind_forcing_by_data_override +!> This subroutine specifies zero surface bouyancy fluxes from input files. subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. - type(forcing), intent(inout) :: fluxes - type(time_type), intent(in) :: day + type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields + type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which !! the fluxes apply, in s type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(surface_forcing_CS), pointer :: CS + type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by + !! a previous surface_forcing_init call ! This subroutine specifies the current surface fluxes of buoyancy ! temperature and fresh water. It may also be modified to add ! surface fluxes of user provided tracers. ! This case has surface buoyancy forcing from input files. -! Arguments: -! state = structure describing ocean surface state -! (out) fluxes = structure with pointers to forcing fields; unused have NULL ptrs -! (in) day = time of the fluxes -! (in) dt = amount of time over which the fluxes apply -! (in) G = ocean grid structure -! (in) CS = pointer to control struct returned by previous surface_forcing_init call - real, dimension(SZI_(G),SZJ_(G)) :: & temp, & ! A 2-d temporary work array with various units. SST_anom, & ! Instantaneous sea surface temperature anomalies from a @@ -1080,16 +1081,17 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) call callTree_leave("buoyancy_forcing_from_files") end subroutine buoyancy_forcing_from_files - +!> This subroutine specifies zero surface bouyancy fluxes from data over-ride. subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, CS) - type(surface), intent(inout) :: sfc_state !< A structure containing fields that - !! describe the surface state of the ocean. - type(forcing), intent(inout) :: fluxes - type(time_type), intent(in) :: day - real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply, in s - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(surface_forcing_CS), pointer :: CS + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields + type(time_type), intent(in) :: day !< The time of the fluxes + real, intent(in) :: dt !< The amount of time over which + !! the fluxes apply, in s + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by + !! a previous surface_forcing_init call ! This subroutine specifies the current surface fluxes of buoyancy ! temperature and fresh water. It may also be modified to add @@ -1258,16 +1260,17 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, CS call callTree_leave("buoyancy_forcing_from_data_override") end subroutine buoyancy_forcing_from_data_override - +!> This subroutine specifies zero surface bouyancy fluxes subroutine buoyancy_forcing_zero(sfc_state, fluxes, day, dt, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. - type(forcing), intent(inout) :: fluxes - type(time_type), intent(in) :: day + type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields + type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which !! the fluxes apply, in s type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(surface_forcing_CS), pointer :: CS + type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by + !! a previous surface_forcing_init call ! This subroutine specifies the current surface fluxes of buoyancy ! temperature and fresh water. It may also be modified to add @@ -1313,15 +1316,17 @@ subroutine buoyancy_forcing_zero(sfc_state, fluxes, day, dt, G, CS) end subroutine buoyancy_forcing_zero +!> This subroutine sets up spatially and temporally constant surface heat fluxes. subroutine buoyancy_forcing_const(sfc_state, fluxes, day, dt, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. - type(forcing), intent(inout) :: fluxes - type(time_type), intent(in) :: day + type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields + type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which !! the fluxes apply, in s type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(surface_forcing_CS), pointer :: CS + type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by + !! a previous surface_forcing_init call ! This subroutine specifies the current surface fluxes of buoyancy ! temperature and fresh water. It may also be modified to add @@ -1366,15 +1371,18 @@ subroutine buoyancy_forcing_const(sfc_state, fluxes, day, dt, G, CS) end subroutine buoyancy_forcing_const +!> This subroutine sets surface fluxes of heat and salinity by restoring to temperature and +!! saliinty profiles that vary linearly with latitude. subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. - type(forcing), intent(inout) :: fluxes - type(time_type), intent(in) :: day + type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields + type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which !! the fluxes apply, in s type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(surface_forcing_CS), pointer :: CS + type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by + !! a previous surface_forcing_init call ! This subroutine specifies the current surface fluxes of buoyancy ! temperature and fresh water. It may also be modified to add @@ -1456,15 +1464,18 @@ subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, CS) call callTree_leave("buoyancy_forcing_linear") end subroutine buoyancy_forcing_linear - +!> Save a restart file for the forcing fields subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & filename_suffix) - type(surface_forcing_CS), pointer :: CS + type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by + !! a previous surface_forcing_init call type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(time_type), intent(in) :: Time - character(len=*), intent(in) :: directory - logical, optional, intent(in) :: time_stamped - character(len=*), optional, intent(in) :: filename_suffix + type(time_type), intent(in) :: Time !< model time at this call; needed for mpp_write calls + character(len=*), intent(in) :: directory !< 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; the default is false. + character(len=*), optional, intent(in) :: filename_suffix !< optional suffix (e.g., a time-stamp) + !! to append to the restart fname ! Arguments: ! CS = pointer to control structure from previous surface_forcing_init call @@ -1482,13 +1493,14 @@ subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & end subroutine forcing_save_restart - +!> Initialize the surface forcing module subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) - type(time_type), intent(in) :: Time + type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(inout) :: diag - type(surface_forcing_CS), pointer :: CS + type(diag_ctrl), target, intent(inout) :: diag !< structure used to regulate diagnostic output + type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by + !! a previous surface_forcing_init call type(tracer_flow_control_CS), pointer :: tracer_flow_CSp ! Arguments: @@ -1891,9 +1903,11 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) end subroutine surface_forcing_init +!> Deallocate memory associated with the surface forcing module subroutine surface_forcing_end(CS, fluxes) - type(surface_forcing_CS), pointer :: CS - type(forcing), optional, intent(inout) :: fluxes + type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by + !! a previous surface_forcing_init call + type(forcing), optional, intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields ! 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 From 7ff278eae8679affa563d54b86650bb8b679a82e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:33:49 -0400 Subject: [PATCH 0224/1072] dOxyGenized user_surface_forcing.F90 Added dOxyGen comments for all routines and arguments in user_surface_forcing.F90. Also replaced calls to alloc_if_needed with calls to the functionally equivalent safe_alloc_ptr. All answers are bitwise identical. --- .../ice_solo_driver/user_surface_forcing.F90 | 106 +++++++++--------- .../solo_driver/user_surface_forcing.F90 | 69 ++++++------ 2 files changed, 89 insertions(+), 86 deletions(-) diff --git a/config_src/ice_solo_driver/user_surface_forcing.F90 b/config_src/ice_solo_driver/user_surface_forcing.F90 index 098931351c..6a70999d50 100644 --- a/config_src/ice_solo_driver/user_surface_forcing.F90 +++ b/config_src/ice_solo_driver/user_surface_forcing.F90 @@ -22,8 +22,8 @@ module user_surface_forcing !* * !* USER_buoyancy forcing is used to set the surface buoyancy * !* forcing, which may include a number of fresh water flux fields * -!* (evap, liq_precip, froz_precip, liq_runoff, froz_runoff, and * -!* virt_precip) and the surface heat fluxes (sw, lw, latent and sens) * +!* (evap, lprec, fprec, lrunoff, frunoff, and * +!* vprec) and the surface heat fluxes (sw, lw, latent and sens) * !* if temperature and salinity are state variables, or it may simply * !* be the buoyancy flux if it is not. This routine also has coded a * !* restoring to surface values of temperature and salinity. * @@ -44,13 +44,14 @@ module user_surface_forcing !* * !********+*********+*********+*********+*********+*********+*********+** use MOM_diag_mediator, only : post_data, query_averaging_enabled -use MOM_diag_mediator, only : register_diag_field, diag_ctrl +use MOM_diag_mediator, only : register_diag_field, diag_ctrl, safe_alloc_ptr use MOM_domains, only : pass_var, pass_vector, AGRID use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe -use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_file_parser, only : get_param, param_file_type, log_version use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing use MOM_grid, only : ocean_grid_type -use MOM_io, only : file_exists, MOM_read_data +use MOM_io, only : file_exists, read_data use MOM_time_manager, only : time_type, operator(+), operator(/), get_time use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS @@ -84,14 +85,17 @@ module user_surface_forcing contains +!> This subroutine sets the surface wind stresses, forces%taux and forces%tauy. +!! These are the stresses in the direction of the model grid (i.e. the same +!! direction as the u- and v- velocities.) They are both in Pa. subroutine USER_wind_forcing(sfc_state, forces, day, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), intent(in) :: day + type(time_type), intent(in) :: day !< The time of the fluxes type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by - !! a previous call to user_surface_forcing_init + type(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned + !! by a previous call to user_surface_forcing_init ! This subroutine sets the surface wind stresses, forces%taux and forces%tauy. ! These are the stresses in the direction of the model grid (i.e. the same @@ -121,6 +125,9 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + ! Allocate the forcing arrays, if necessary. + call allocate_mech_forcing(G, forces, stress=.true., ustar=.true.) + ! Set the surface wind stresses, in units of Pa. A positive taux ! accelerates the ocean to the (pseudo-)east. @@ -144,15 +151,19 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, CS) end subroutine USER_wind_forcing +!> This subroutine specifies the current surface fluxes of buoyancy or +!! temperature and fresh water. It may also be modified to add +!! surface fluxes of user provided tracers. subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that - !! describe the surface state of the ocean. - type(forcing), intent(inout) :: fluxes - type(time_type), intent(in) :: day + !! describe the surface state of the ocean. + type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields + type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which !! the fluxes apply, in s type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(user_surface_forcing_CS), pointer :: CS + type(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned + !! by a previous call to user_surface_forcing_init ! This subroutine specifies the current surface fluxes of buoyancy or ! temperature and fresh water. It may also be modified to add @@ -161,9 +172,9 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! When temperature is used, there are long list of fluxes that need to be ! set - essentially the same as for a full coupled model, but most of these ! can be simply set to zero. The net fresh water flux should probably be -! set in fluxes%evap and fluxes%liq_precip, with any salinity restoring -! appearing in fluxes%virt_precip, and the other water flux components -! (froz_precip, liq_runoff and froz_runoff) left as arrays full of zeros. +! set in fluxes%evap and fluxes%lprec, with any salinity restoring +! appearing in fluxes%vprec, and the other water flux components +! (fprec, lrunoff and frunoff) left as arrays full of zeros. ! Evap is usually negative and precip is usually positive. All heat fluxes ! are in W m-2 and positive for heat going into the ocean. All fresh water ! fluxes are in kg m-2 s-1 and positive for water moving into the ocean. @@ -201,19 +212,19 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! Allocate and zero out the forcing arrays, as necessary. This portion is ! usually not changed. if (CS%use_temperature) then - call alloc_if_needed(fluxes%evap, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%liq_precip, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%froz_precip, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%liq_runoff, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%froz_runoff, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%virt_precip, isd, ied, jsd, jed) - - call alloc_if_needed(fluxes%sw, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%lw, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%latent, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%sens, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%evap, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%lprec, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%fprec, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%lrunoff, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%frunoff, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%vprec, isd, ied, jsd, jed) + + call safe_alloc_ptr(fluxes%sw, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%lw, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%latent, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%sens, isd, ied, jsd, jed) else ! This is the buoyancy only mode. - call alloc_if_needed(fluxes%buoy, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%buoy, isd, ied, jsd, jed) endif @@ -226,10 +237,10 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! Fluxes of fresh water through the surface are in units of kg m-2 s-1 ! and are positive downward - i.e. evaporation should be negative. fluxes%evap(i,j) = -0.0 * G%mask2dT(i,j) - fluxes%liq_precip(i,j) = 0.0 * G%mask2dT(i,j) + fluxes%lprec(i,j) = 0.0 * G%mask2dT(i,j) - ! virt_precip will be set later, if it is needed for salinity restoring. - fluxes%virt_precip(i,j) = 0.0 + ! vprec will be set later, if it is needed for salinity restoring. + fluxes%vprec(i,j) = 0.0 ! Heat fluxes are in units of W m-2 and are positive into the ocean. fluxes%lw(i,j) = 0.0 * G%mask2dT(i,j) @@ -247,7 +258,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) if (CS%restorebuoy) then if (CS%use_temperature) then - call alloc_if_needed(fluxes%heat_restore, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%heat_added, isd, ied, jsd, jed) ! When modifying the code, comment out this error message. It is here ! so that the original (unmodified) version is not accidentally used. call MOM_error(FATAL, "User_buoyancy_surface_forcing: " // & @@ -260,9 +271,9 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) Temp_restore = 0.0 Salin_restore = 0.0 - fluxes%heat_restore(i,j) = (G%mask2dT(i,j) * (rhoXcp * CS%Flux_const)) * & + fluxes%heat_added(i,j) = (G%mask2dT(i,j) * (rhoXcp * CS%Flux_const)) * & (Temp_restore - sfc_state%SST(i,j)) - fluxes%virt_precip(i,j) = - (G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)) * & + fluxes%vprec(i,j) = - (G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)) * & ((Salin_restore - sfc_state%SSS(i,j)) / & (0.5 * (Salin_restore + sfc_state%SSS(i,j)))) enddo ; enddo @@ -287,24 +298,15 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) end subroutine USER_buoyancy_forcing -subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) - ! If ptr is not associated, this routine allocates it with the given size - ! and zeros out its contents. This is equivalent to safe_alloc_ptr in - ! MOM_diag_mediator, but is here so as to be completely transparent. - real, pointer :: ptr(:,:) - integer :: isd, ied, jsd, jed - if (.not.associated(ptr)) then - allocate(ptr(isd:ied,jsd:jed)) - ptr(:,:) = 0.0 - endif -end subroutine alloc_if_needed - +!> This subroutine initializes the USER_surface_forcing module subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS) - type(time_type), intent(in) :: Time + type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(in) :: diag - type(user_surface_forcing_CS), pointer :: CS + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate diagnostic output. + type(user_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to + !! the control structure for this module + ! Arguments: Time - The current model time. ! (in) G - The ocean's grid structure. ! (in) param_file - A structure indicating the open file to parse for @@ -330,18 +332,20 @@ subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS) call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & "If true, Temperature and salinity are used as state \n"//& "variables.", default=.true.) + call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) - call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & - "The background gustiness in the winds.", units="Pa", & - default=0.02) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to \n"//& "calculate accelerations and the mass for conservation \n"//& "properties, or with BOUSSINSEQ false to convert some \n"//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) + call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & + "The background gustiness in the winds.", units="Pa", & + default=0.02) + call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & "If true, the buoyancy fluxes drive the model back \n"//& "toward some specified surface state with a rate \n"//& diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90 index 3127101cb4..6a70999d50 100644 --- a/config_src/solo_driver/user_surface_forcing.F90 +++ b/config_src/solo_driver/user_surface_forcing.F90 @@ -44,7 +44,7 @@ module user_surface_forcing !* * !********+*********+*********+*********+*********+*********+*********+** use MOM_diag_mediator, only : post_data, query_averaging_enabled -use MOM_diag_mediator, only : register_diag_field, diag_ctrl +use MOM_diag_mediator, only : register_diag_field, diag_ctrl, safe_alloc_ptr use MOM_domains, only : pass_var, pass_vector, AGRID use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe use MOM_file_parser, only : get_param, param_file_type, log_version @@ -85,13 +85,17 @@ module user_surface_forcing contains +!> This subroutine sets the surface wind stresses, forces%taux and forces%tauy. +!! These are the stresses in the direction of the model grid (i.e. the same +!! direction as the u- and v- velocities.) They are both in Pa. subroutine USER_wind_forcing(sfc_state, forces, day, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), intent(in) :: day + type(time_type), intent(in) :: day !< The time of the fluxes type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(user_surface_forcing_CS), pointer :: CS + type(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned + !! by a previous call to user_surface_forcing_init ! This subroutine sets the surface wind stresses, forces%taux and forces%tauy. ! These are the stresses in the direction of the model grid (i.e. the same @@ -147,15 +151,19 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, CS) end subroutine USER_wind_forcing +!> This subroutine specifies the current surface fluxes of buoyancy or +!! temperature and fresh water. It may also be modified to add +!! surface fluxes of user provided tracers. subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that - !! describe the surface state of the ocean. - type(forcing), intent(inout) :: fluxes - type(time_type), intent(in) :: day + !! describe the surface state of the ocean. + type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields + type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which !! the fluxes apply, in s type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(user_surface_forcing_CS), pointer :: CS + type(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned + !! by a previous call to user_surface_forcing_init ! This subroutine specifies the current surface fluxes of buoyancy or ! temperature and fresh water. It may also be modified to add @@ -204,19 +212,19 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! Allocate and zero out the forcing arrays, as necessary. This portion is ! usually not changed. if (CS%use_temperature) then - call alloc_if_needed(fluxes%evap, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%lprec, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%fprec, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%lrunoff, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%frunoff, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%vprec, isd, ied, jsd, jed) - - call alloc_if_needed(fluxes%sw, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%lw, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%latent, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%sens, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%evap, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%lprec, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%fprec, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%lrunoff, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%frunoff, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%vprec, isd, ied, jsd, jed) + + call safe_alloc_ptr(fluxes%sw, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%lw, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%latent, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%sens, isd, ied, jsd, jed) else ! This is the buoyancy only mode. - call alloc_if_needed(fluxes%buoy, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%buoy, isd, ied, jsd, jed) endif @@ -250,7 +258,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) if (CS%restorebuoy) then if (CS%use_temperature) then - call alloc_if_needed(fluxes%heat_added, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%heat_added, isd, ied, jsd, jed) ! When modifying the code, comment out this error message. It is here ! so that the original (unmodified) version is not accidentally used. call MOM_error(FATAL, "User_buoyancy_surface_forcing: " // & @@ -290,24 +298,15 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) end subroutine USER_buoyancy_forcing -subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) - ! If ptr is not associated, this routine allocates it with the given size - ! and zeros out its contents. This is equivalent to safe_alloc_ptr in - ! MOM_diag_mediator, but is here so as to be completely transparent. - real, pointer :: ptr(:,:) - integer :: isd, ied, jsd, jed - if (.not.associated(ptr)) then - allocate(ptr(isd:ied,jsd:jed)) - ptr(:,:) = 0.0 - endif -end subroutine alloc_if_needed - +!> This subroutine initializes the USER_surface_forcing module subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS) - type(time_type), intent(in) :: Time + type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(in) :: diag - type(user_surface_forcing_CS), pointer :: CS + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate diagnostic output. + type(user_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to + !! the control structure for this module + ! Arguments: Time - The current model time. ! (in) G - The ocean's grid structure. ! (in) param_file - A structure indicating the open file to parse for From 01b434e3a362de54514dfb539aed28b7403010ae Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:34:09 -0400 Subject: [PATCH 0225/1072] dOxyGenized MESO_surface_forcing.F90 Added dOxyGen comments for all routines and arguments in MESO_surface_forcing.F90. Also replaced calls to alloc_if_needed with calls to the functionally equivalent safe_alloc_ptr. All answers are bitwise identical. --- .../solo_driver/MESO_surface_forcing.F90 | 79 +++++++++---------- 1 file changed, 38 insertions(+), 41 deletions(-) diff --git a/config_src/solo_driver/MESO_surface_forcing.F90 b/config_src/solo_driver/MESO_surface_forcing.F90 index 513358932e..578aa68a2a 100644 --- a/config_src/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/solo_driver/MESO_surface_forcing.F90 @@ -44,7 +44,7 @@ module MESO_surface_forcing !* * !********+*********+*********+*********+*********+*********+*********+** use MOM_diag_mediator, only : post_data, query_averaging_enabled -use MOM_diag_mediator, only : register_diag_field, diag_ctrl +use MOM_diag_mediator, only : register_diag_field, diag_ctrl, safe_alloc_ptr use MOM_domains, only : pass_var, pass_vector, AGRID use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type @@ -97,11 +97,13 @@ module MESO_surface_forcing contains +!### This subroutine sets zero surface wind stresses, but it is not even +!### used by the MESO experimeents. This subroutine can be deleted. -RWH subroutine MESO_wind_forcing(sfc_state, forces, day, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), intent(in) :: day + type(time_type), intent(in) :: day !< The time of the fluxes type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(MESO_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by a previous !! call to MESO_surface_forcing_init @@ -160,15 +162,18 @@ subroutine MESO_wind_forcing(sfc_state, forces, day, G, CS) end subroutine MESO_wind_forcing +!> This subroutine sets up the MESO buoyancy forcing, which uses control-theory style +!! specification restorative buoyancy fluxes at large scales. subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. - type(forcing), intent(inout) :: fluxes - type(time_type), intent(in) :: day + type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields + type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which !! the fluxes apply, in s type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(MESO_surface_forcing_CS), pointer :: CS + type(MESO_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by + !! a previous call to MESO_surface_forcing_init ! This subroutine specifies the current surface fluxes of buoyancy or ! temperature and fresh water. It may also be modified to add @@ -215,30 +220,30 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! Allocate and zero out the forcing arrays, as necessary. This portion is ! usually not changed. if (CS%use_temperature) then - call alloc_if_needed(fluxes%evap, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%lprec, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%fprec, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%lrunoff, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%frunoff, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%vprec, isd, ied, jsd, jed) - - call alloc_if_needed(fluxes%sw, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%lw, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%latent, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%sens, isd, ied, jsd, jed) - call alloc_if_needed(fluxes%heat_content_lprec, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%evap, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%lprec, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%fprec, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%lrunoff, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%frunoff, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%vprec, isd, ied, jsd, jed) + + call safe_alloc_ptr(fluxes%sw, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%lw, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%latent, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%sens, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%heat_content_lprec, isd, ied, jsd, jed) else ! This is the buoyancy only mode. - call alloc_if_needed(fluxes%buoy, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%buoy, isd, ied, jsd, jed) endif ! MODIFY THE CODE IN THE FOLLOWING LOOPS TO SET THE BUOYANCY FORCING TERMS. if (CS%restorebuoy .and. first_call) then !### .or. associated(CS%ctrl_forcing_CSp)) then - call alloc_if_needed(CS%T_Restore, isd, ied, jsd, jed) - call alloc_if_needed(CS%S_Restore, isd, ied, jsd, jed) - call alloc_if_needed(CS%Heat, isd, ied, jsd, jed) - call alloc_if_needed(CS%PmE, isd, ied, jsd, jed) - call alloc_if_needed(CS%Solar, isd, ied, jsd, jed) + call safe_alloc_ptr(CS%T_Restore, isd, ied, jsd, jed) + call safe_alloc_ptr(CS%S_Restore, isd, ied, jsd, jed) + call safe_alloc_ptr(CS%Heat, isd, ied, jsd, jed) + call safe_alloc_ptr(CS%PmE, isd, ied, jsd, jed) + call safe_alloc_ptr(CS%Solar, isd, ied, jsd, jed) call MOM_read_data(trim(CS%inputdir)//trim(CS%SSTrestore_file), "SST", & CS%T_Restore(:,:), G%Domain) @@ -281,7 +286,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) if (CS%restorebuoy) then if (CS%use_temperature) then - call alloc_if_needed(fluxes%heat_added, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%heat_added, isd, ied, jsd, jed) ! When modifying the code, comment out this error message. It is here ! so that the original (unmodified) version is not accidentally used. ! call MOM_error(FATAL, "MESO_buoyancy_surface_forcing: " // & @@ -323,24 +328,16 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) end subroutine MESO_buoyancy_forcing -subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) - ! If ptr is not associated, this routine allocates it with the given size - ! and zeros out its contents. This is equivalent to safe_alloc_ptr in - ! MOM_diag_mediator, but is here so as to be completely transparent. - real, pointer :: ptr(:,:) - integer :: isd, ied, jsd, jed - if (.not.associated(ptr)) then - allocate(ptr(isd:ied,jsd:jed)) - ptr(:,:) = 0.0 - endif -end subroutine alloc_if_needed - +!> Initialize the MESO surface forcing module subroutine MESO_surface_forcing_init(Time, G, param_file, diag, CS) - type(time_type), intent(in) :: Time - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(in) :: diag - type(MESO_surface_forcing_CS), pointer :: CS + + type(time_type), intent(in) :: Time !< The current model time + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(diag_ctrl), target, intent(inout) :: diag !< structure used to regulate diagnostic output + type(MESO_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the + !! control structure for this module + ! Arguments: Time - The current model time. ! (in) G - The ocean's grid structure. ! (in) param_file - A structure indicating the open file to parse for From 881bf4c535ab6028edfe1a6bfdf3031f83a4242f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:34:26 -0400 Subject: [PATCH 0226/1072] dOxyGenized Neverland_surface_forcing.F90 Added dOxyGen comments for all routines and arguments in Neverland_surface_forcing.F90. Also replaced calls to alloc_if_needed with calls to the functionally equivalent safe_alloc_ptr. All answers are bitwise identical. --- .../solo_driver/Neverland_surface_forcing.F90 | 18 +++--------------- 1 file changed, 3 insertions(+), 15 deletions(-) diff --git a/config_src/solo_driver/Neverland_surface_forcing.F90 b/config_src/solo_driver/Neverland_surface_forcing.F90 index 972132ae6a..55476f9051 100644 --- a/config_src/solo_driver/Neverland_surface_forcing.F90 +++ b/config_src/solo_driver/Neverland_surface_forcing.F90 @@ -4,7 +4,7 @@ module Neverland_surface_forcing ! This file is part of MOM6. See LICENSE.md for the license. use MOM_diag_mediator, only : post_data, query_averaging_enabled -use MOM_diag_mediator, only : register_diag_field, diag_ctrl +use MOM_diag_mediator, only : register_diag_field, diag_ctrl, safe_alloc_ptr use MOM_domains, only : pass_var, pass_vector, AGRID use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type @@ -160,13 +160,13 @@ subroutine Neverland_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) "Temperature and salinity mode not coded!" ) else ! This is the buoyancy only mode. - call alloc_if_needed(fluxes%buoy, isd, ied, jsd, jed) + call safe_alloc_ptr(fluxes%buoy, isd, ied, jsd, jed) endif ! MODIFY THE CODE IN THE FOLLOWING LOOPS TO SET THE BUOYANCY FORCING TERMS. if (CS%restorebuoy .and. CS%first_call) then - call alloc_if_needed(CS%buoy_restore, isd, ied, jsd, jed) + call safe_alloc_ptr(CS%buoy_restore, isd, ied, jsd, jed) CS%first_call = .false. ! Set CS%buoy_restore(i,j) here endif @@ -205,18 +205,6 @@ subroutine Neverland_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) end subroutine Neverland_buoyancy_forcing -!> If ptr is not associated, this routine allocates it with the given size -!! and zeros out its contents. This is equivalent to safe_alloc_ptr in -!! MOM_diag_mediator, but is here so as to be completely transparent. -subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) - real, pointer :: ptr(:,:) - integer :: isd, ied, jsd, jed - if (.not.associated(ptr)) then - allocate(ptr(isd:ied,jsd:jed)) - ptr(:,:) = 0.0 - endif -end subroutine alloc_if_needed - !> Initializes the Neverland control structure. subroutine Neverland_surface_forcing_init(Time, G, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time. From 4bdfed6bbe9f67271e39ccd3ae59b0f910249be4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:35:47 -0400 Subject: [PATCH 0227/1072] Shortened excesively long lines in ice_solo_driver Split lines exceeding 120 characters in the code in ice_solo_driver and mct_driver to promote readability and compliance with MOM6 code standards. All answers are bitwise identical. --- config_src/ice_solo_driver/coupler_types.F90 | 111 +++++++++++------- .../ice_solo_driver/ice_shelf_driver.F90 | 3 +- config_src/mct_driver/ocn_comp_mct.F90 | 9 +- 3 files changed, 78 insertions(+), 45 deletions(-) diff --git a/config_src/ice_solo_driver/coupler_types.F90 b/config_src/ice_solo_driver/coupler_types.F90 index a57d2dd37e..99a74e085c 100644 --- a/config_src/ice_solo_driver/coupler_types.F90 +++ b/config_src/ice_solo_driver/coupler_types.F90 @@ -68,7 +68,8 @@ module coupler_types_mod type, public :: coupler_3d_bc_type integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_3d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary condition fields + type(coupler_3d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary + !! condition fields logical :: set = .false. !< If true, this type has been initialized integer :: isd, isc, iec, ied !< The i-direction data and computational domain index ranges for this type integer :: jsd, jsc, jec, jed !< The j-direction data and computational domain index ranges for this type @@ -115,7 +116,8 @@ module coupler_types_mod type, public :: coupler_2d_bc_type integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_2d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary condition fields + type(coupler_2d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary + !! condition fields logical :: set = .false. !< If true, this type has been initialized integer :: isd, isc, iec, ied !< The i-direction data and computational domain index ranges for this type integer :: jsd, jsc, jec, jed !< The j-direction data and computational domain index ranges for this type @@ -156,7 +158,8 @@ module coupler_types_mod type, public :: coupler_1d_bc_type integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_1d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary condition fields + type(coupler_1d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary + !! condition fields logical :: set = .false. !< If true, this type has been initialized end type coupler_1d_bc_type @@ -291,7 +294,8 @@ subroutine coupler_type_copy_1d_2d(var_in, var_out, is, ie, js, je, & integer, intent(in) :: ie !< upper bound of first dimension integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then + !! don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique @@ -310,7 +314,7 @@ subroutine coupler_type_copy_1d_2d(var_in, var_out, is, ie, js, je, & if (var_in%num_bcs >= 0) & call CT_spawn_1d_2d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), suffix) - if ((var_out%num_bcs > 0) .and. (diag_name .ne. ' ')) & + if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & call CT_set_diags_2d(var_out, diag_name, axes, time) end subroutine coupler_type_copy_1d_2d @@ -340,7 +344,8 @@ subroutine coupler_type_copy_1d_3d(var_in, var_out, is, ie, js, je, kd, & integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then + !! don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique @@ -360,7 +365,7 @@ subroutine coupler_type_copy_1d_3d(var_in, var_out, is, ie, js, je, kd, & if (var_in%num_bcs >= 0) & call CT_spawn_1d_3d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), (/1, kd/), suffix) - if ((var_out%num_bcs > 0) .and. (diag_name .ne. ' ')) & + if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & call CT_set_diags_3d(var_out, diag_name, axes, time) end subroutine coupler_type_copy_1d_3d @@ -383,7 +388,8 @@ subroutine coupler_type_copy_2d_2d(var_in, var_out, is, ie, js, je, & integer, intent(in) :: ie !< upper bound of first dimension integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique @@ -402,7 +408,7 @@ subroutine coupler_type_copy_2d_2d(var_in, var_out, is, ie, js, je, & if (var_in%num_bcs >= 0) & call CT_spawn_2d_2d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), suffix) - if ((var_out%num_bcs > 0) .and. (diag_name .ne. ' ')) & + if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & call CT_set_diags_2d(var_out, diag_name, axes, time) end subroutine coupler_type_copy_2d_2d @@ -432,7 +438,8 @@ subroutine coupler_type_copy_2d_3d(var_in, var_out, is, ie, js, je, kd, & integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique @@ -452,7 +459,7 @@ subroutine coupler_type_copy_2d_3d(var_in, var_out, is, ie, js, je, kd, & if (var_in%num_bcs >= 0) & call CT_spawn_2d_3d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), (/1, kd/), suffix) - if ((var_out%num_bcs > 0) .and. (diag_name .ne. ' ')) & + if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & call CT_set_diags_3d(var_out, diag_name, axes, time) end subroutine coupler_type_copy_2d_3d @@ -475,7 +482,8 @@ subroutine coupler_type_copy_3d_2d(var_in, var_out, is, ie, js, je, & integer, intent(in) :: ie !< upper bound of first dimension integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique @@ -494,7 +502,7 @@ subroutine coupler_type_copy_3d_2d(var_in, var_out, is, ie, js, je, & if (var_in%num_bcs >= 0) & call CT_spawn_3d_2d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), suffix) - if ((var_out%num_bcs > 0) .and. (diag_name .ne. ' ')) & + if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & call CT_set_diags_2d(var_out, diag_name, axes, time) end subroutine coupler_type_copy_3d_2d @@ -524,7 +532,8 @@ subroutine coupler_type_copy_3d_3d(var_in, var_out, is, ie, js, je, kd, & integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique @@ -544,7 +553,7 @@ subroutine coupler_type_copy_3d_3d(var_in, var_out, is, ie, js, je, kd, & if (var_in%num_bcs >= 0) & call CT_spawn_3d_3d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), (/1, kd/), suffix) - if ((var_out%num_bcs > 0) .and. (diag_name .ne. ' ')) & + if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & call CT_set_diags_3d(var_out, diag_name, axes, time) end subroutine coupler_type_copy_3d_3d @@ -1174,8 +1183,10 @@ subroutine CT_copy_data_2d(var_in, var, halo_size, bc_index, field_index, & !! that is being copied integer, optional, intent(in) :: field_index !< The index of the field in the !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this copy. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this copy. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this copy. logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose !! value of pass_through ice matches this logical :: copy_bc @@ -1249,8 +1260,10 @@ subroutine CT_copy_data_3d(var_in, var, halo_size, bc_index, field_index, & !! that is being copied integer, optional, intent(in) :: field_index !< The index of the field in the !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this copy. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this copy. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this copy. logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose !! value of pass_through ice matches this logical :: copy_bc @@ -1329,8 +1342,10 @@ subroutine CT_copy_data_2d_3d(var_in, var, halo_size, bc_index, field_index, & !! that is being copied integer, optional, intent(in) :: field_index !< The index of the field in the !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this copy. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this copy. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this copy. logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose !! value of pass_through ice matches this integer, optional, intent(in) :: ind3_start !< The starting value of the 3rd @@ -1563,8 +1578,10 @@ subroutine CT_rescale_data_2d(var, scale, halo_size, bc_index, field_index, & !! that is being copied integer, optional, intent(in) :: field_index !< The index of the field in the !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this copy. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this copy. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this copy. logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose !! value of pass_through ice matches this logical :: do_bc @@ -1640,8 +1657,10 @@ subroutine CT_rescale_data_3d(var, scale, halo_size, bc_index, field_index, & !! that is being copied integer, optional, intent(in) :: field_index !< The index of the field in the !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this copy. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this copy. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this copy. logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose !! value of pass_through ice matches this logical :: do_bc @@ -1718,8 +1737,10 @@ subroutine CT_increment_data_2d_2d(var_in, var, halo_size, bc_index, field_index !! boundary condition that is being copied real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this increment. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this increment. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this increment. logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose !! value of pass_through ice matches this @@ -1802,8 +1823,10 @@ subroutine CT_increment_data_3d_3d(var_in, var, halo_size, bc_index, field_index !! boundary condition that is being copied real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this increment. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this increment. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this increment. logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose !! value of pass_through ice matches this @@ -1893,8 +1916,10 @@ subroutine CT_increment_data_2d_3d(var_in, weights, var, halo_size, bc_index, fi !! boundary condition that is being copied real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this increment. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this increment. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this increment. logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose !! value of pass_through ice matches this @@ -1946,7 +1971,8 @@ subroutine CT_increment_data_2d_3d(var_in, weights, var, halo_size, bc_index, fi elseif ((1+var_in%ied-var_in%isd) == size(weights,1)) then iow = 1 + (var_in%isc - var_in%isd) - var%isc else - call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the i-size of a computational or data domain.") + call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the i-size "//& + "of a computational or data domain.") endif if ((1+var%jec-var%jsc) == size(weights,2)) then jow = 1 - var%jsc @@ -1955,7 +1981,8 @@ subroutine CT_increment_data_2d_3d(var_in, weights, var, halo_size, bc_index, fi elseif ((1+var_in%jed-var_in%jsd) == size(weights,2)) then jow = 1 + (var_in%jsc - var_in%jsd) - var%jsc else - call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the j-size of a computational or data domain.") + call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the j-size "//& + "of a computational or data domain.") endif io1 = var_in%isc - var%isc ; jo1 = var_in%jsc - var%jsc ; kow = 1 - var_in%ks @@ -2720,7 +2747,8 @@ end subroutine CT_set_data_3d !> This routine registers the diagnostics of a coupler_2d_bc_type. subroutine CT_set_diags_2d(var, diag_name, axes, time) type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure for which to register diagnostics - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field @@ -2746,7 +2774,8 @@ end subroutine CT_set_diags_2d !> This routine registers the diagnostics of a coupler_3d_bc_type. subroutine CT_set_diags_3d(var, diag_name, axes, time) type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure for which to register diagnostics - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field @@ -3106,9 +3135,9 @@ end subroutine CT_restore_state_3d !> This subroutine potentially overrides the values in a coupler_2d_bc_type subroutine CT_data_override_2d(gridname, var, Time) - character(len=3), intent(in) :: gridname !< 3-character long model grid ID - type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure to override - type(time_type), intent(in) :: time !< The current model time + character(len=3), intent(in) :: gridname !< 3-character long model grid ID + type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to override + type(time_type), intent(in) :: time !< The current model time integer :: m, n @@ -3120,9 +3149,9 @@ end subroutine CT_data_override_2d !> This subroutine potentially overrides the values in a coupler_3d_bc_type subroutine CT_data_override_3d(gridname, var, Time) - character(len=3), intent(in) :: gridname !< 3-character long model grid ID - type(coupler_3d_bc_type), intent(in) :: var !< BC_type structure to override - type(time_type), intent(in) :: time !< The current model time + character(len=3), intent(in) :: gridname !< 3-character long model grid ID + type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to override + type(time_type), intent(in) :: time !< The current model time integer :: m, n diff --git a/config_src/ice_solo_driver/ice_shelf_driver.F90 b/config_src/ice_solo_driver/ice_shelf_driver.F90 index 628b138639..7bfc7ec5ad 100644 --- a/config_src/ice_solo_driver/ice_shelf_driver.F90 +++ b/config_src/ice_solo_driver/ice_shelf_driver.F90 @@ -265,7 +265,8 @@ program SHELF_main Time_end = daymax endif - if (is_root_pe()) print *,"Time_step_shelf", time_type_to_real(Time_step_shelf), "TIme_end", time_type_to_real(Time_end) + if (is_root_pe()) print *,"Time_step_shelf", time_type_to_real(Time_step_shelf), & + "TIme_end", time_type_to_real(Time_end) if (Time >= Time_end) call MOM_error(FATAL, & "MOM_driver: The run has been started at or after the end time of the run.") diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 354e309ed9..c3967caf6d 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -1622,7 +1622,8 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o) glb%ocn_state%dirs%restart_output_dir, .true.) ! Once we start using the ice shelf module, the following will be needed if (glb%ocn_state%use_ice_shelf) then - call ice_shelf_save_restart(glb%ocn_state%Ice_shelf_CSp, glb%ocn_state%Time, glb%ocn_state%dirs%restart_output_dir, .true.) + call ice_shelf_save_restart(glb%ocn_state%Ice_shelf_CSp, glb%ocn_state%Time, & + glb%ocn_state%dirs%restart_output_dir, .true.) endif endif @@ -1732,7 +1733,8 @@ subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, & ! 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) + ! 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) !endif ! Indicate that there are new unused fluxes. @@ -1752,7 +1754,8 @@ subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, & ! 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) + ! 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) !endif ! Accumulate the forcing over time steps From 6e018cfb0743be06bad107c05a39f67bb8fdd16d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 11:40:32 -0400 Subject: [PATCH 0228/1072] +Combined arguments to write_[uv]_accel Combined the maxvel and minvel arguments to write_[uv]_accel into vel_rpt. Also turned the a and hv arguments from 2-d sliced to full 3-d arrays to avoid doing an extra copy during the calls to write_[uv]_accel. The calls inside of vertvisc_limit_vel have been changed accordingly. Also added dOxyGen comments for all remaining arguments in MOM_PointAccel.F90. All answers are bitwise identical, but two public interfaces change. --- src/diagnostics/MOM_PointAccel.F90 | 73 ++++++------------- .../vertical/MOM_vert_friction.F90 | 6 +- 2 files changed, 26 insertions(+), 53 deletions(-) diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 37d3433330..10845e8cfa 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -78,11 +78,9 @@ module MOM_PointAccel !> This subroutine writes to an output file all of the accelerations !! that have been applied to a column of zonal velocities over the !! previous timestep. This subroutine is called from vertvisc. -subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, & - maxvel, minvel, str, a, hv) +subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a, hv) integer, intent(in) :: I !< The zonal index of the column to be documented. - integer, intent(in) :: j !< The meridional index of the column to be - !! documented. + integer, intent(in) :: j !< The meridional index of the column to be documented. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -96,13 +94,12 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, & real, intent(in) :: dt !< The ocean dynamics time step, in s. type(PointAccel_CS), pointer :: CS !< The control structure returned by a previous !! call to PointAccel_init. - real, intent(in) :: maxvel, minvel + real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report, in m s-1. real, optional, intent(in) :: str !< The surface wind stress integrated over a time !! step, in m2 s-1. - real, dimension(SZIB_(G),SZK_(G)), & - optional, intent(in) :: a !< The layer coupling coefficients from - !! vertvisc, m. - real, dimension(SZIB_(G),SZK_(G)), & + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, m. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, !! from vertvisc, in m. @@ -110,25 +107,6 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, & ! that have been applied to a column of zonal velocities over the ! previous timestep. This subroutine is called from vertvisc. -! Arguments: I - The zonal index of the column to be documented. -! (in) j - The meridional index of the column to be documented. -! (in) um - The new zonal velocity, in m s-1. -! (in) hin - The layer thickness, in m. -! (in) ADp - A structure pointing to the various accelerations in -! the momentum equations. -! (in) CDp - A structure with pointers to various terms in the continuity -! equations. -! (in) dt - The model's dynamics time step. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! PointAccel_init. -! (in) str - The surface wind stress integrated over a time -! step, in m2 s-1. -! (in) a - The layer coupling coefficients from vertvisc, m. -! (in) hv - The layer thicknesses at velocity grid points, from -! vertvisc, in m. - real :: f_eff, CFL real :: Angstrom real :: truncvel, du @@ -167,14 +145,14 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, & ! Determine which layers to write out accelerations for. do k=1,nz - if (((max(CS%u_av(I,j,k),um(I,j,k)) >= maxvel) .or. & - (min(CS%u_av(I,j,k),um(I,j,k)) <= minvel)) .and. & + if (((max(CS%u_av(I,j,k),um(I,j,k)) >= vel_rpt) .or. & + (min(CS%u_av(I,j,k),um(I,j,k)) <= -vel_rpt)) .and. & ((hin(i,j,k) + hin(i+1,j,k)) > 3.0*Angstrom)) exit enddo ks = k do k=nz,1,-1 - if (((max(CS%u_av(I,j,k), um(I,j,k)) >= maxvel) .or. & - (min(CS%u_av(I,j,k), um(I,j,k)) <= minvel)) .and. & + if (((max(CS%u_av(I,j,k), um(I,j,k)) >= vel_rpt) .or. & + (min(CS%u_av(I,j,k), um(I,j,k)) <= -vel_rpt)) .and. & ((hin(i,j,k) + hin(i+1,j,k)) > 3.0*Angstrom)) exit enddo ke = k @@ -254,11 +232,11 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, & endif if (present(a)) then write(file,'(/,"a: ",$)') - do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(I,k); enddo + do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(I,j,k); enddo endif if (present(hv)) then write(file,'(/,"hvel: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') hv(I,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') hv(I,j,k); enddo endif write(file,'(/,"Stress: ",ES10.3)') str @@ -432,11 +410,9 @@ end subroutine write_u_accel !> This subroutine writes to an output file all of the accelerations !! that have been applied to a column of meridional velocities over !! the previous timestep. This subroutine is called from vertvisc. -subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, & - maxvel, minvel, str, a, hv) +subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a, hv) integer, intent(in) :: i !< The zonal index of the column to be documented. - integer, intent(in) :: J !< The meridional index of the column to be - !! documented. + integer, intent(in) :: J !< The meridional index of the column to be documented. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -450,13 +426,12 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, & real, intent(in) :: dt !< The ocean dynamics time step, in s. type(PointAccel_CS), pointer :: CS !< The control structure returned by a previous !! call to PointAccel_init. - real, intent(in) :: maxvel, minvel + real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report, in m s-1. real, optional, intent(in) :: str !< The surface wind stress integrated over a time !! step, in m2 s-1. - real, dimension(SZI_(G),SZK_(G)), & - optional, intent(in) :: a !< The layer coupling coefficients from - !! vertvisc, m. - real, dimension(SZI_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, m. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, !! from vertvisc, in m. @@ -520,14 +495,14 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, & prev_avail = (associated(CS%u_prev) .and. associated(CS%v_prev)) do k=1,nz - if (((max(CS%v_av(i,J,k), vm(i,J,k)) >= maxvel) .or. & - (min(CS%v_av(i,J,k), vm(i,J,k)) <= minvel)) .and. & + if (((max(CS%v_av(i,J,k), vm(i,J,k)) >= vel_rpt) .or. & + (min(CS%v_av(i,J,k), vm(i,J,k)) <= -vel_rpt)) .and. & ((hin(i,j,k) + hin(i,j+1,k)) > 3.0*Angstrom)) exit enddo ks = k do k=nz,1,-1 - if (((max(CS%v_av(i,J,k), vm(i,J,k)) >= maxvel) .or. & - (min(CS%v_av(i,J,k), vm(i,J,k)) <= minvel)) .and. & + if (((max(CS%v_av(i,J,k), vm(i,J,k)) >= vel_rpt) .or. & + (min(CS%v_av(i,J,k), vm(i,J,k)) <= -vel_rpt)) .and. & ((hin(i,j,k) + hin(i,j+1,k)) > 3.0*Angstrom)) exit enddo ke = k @@ -612,11 +587,11 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, & endif if (present(a)) then write(file,'(/,"a: ",$)') - do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(i,k); enddo + do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(i,j,k); enddo endif if (present(hv)) then write(file,'(/,"hvel: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') hv(i,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') hv(i,J,k); enddo endif write(file,'(/,"Stress: ",ES10.3)') str diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 5f9a8f8281..48a6380ead 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1406,8 +1406,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, CS) ! Here the diagnostic reporting subroutines are called if ! unphysically large values were found. call write_u_accel(I, j, u_old, h, ADp, CDp, dt, G, GV, CS%PointAccel_CSp, & - vel_report(I,j), -vel_report(I,j), forces%taux(I,j)*dt_Rho0, & - a=CS%a_u(:,j,:), hv=CS%h_u(:,j,:)) + vel_report(I,j), forces%taux(I,j)*dt_Rho0, a=CS%a_u, hv=CS%h_u) endif ; enddo ; enddo endif @@ -1492,8 +1491,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, CS) ! Here the diagnostic reporting subroutines are called if ! unphysically large values were found. call write_v_accel(i, J, v_old, h, ADp, CDp, dt, G, GV, CS%PointAccel_CSp, & - vel_report(i,J), -vel_report(i,J), forces%tauy(i,J)*dt_Rho0, & - a=CS%a_v(:,J,:),hv=CS%h_v(:,J,:)) + vel_report(i,J), forces%tauy(i,J)*dt_Rho0, a=CS%a_v, hv=CS%h_v) endif ; enddo ; enddo endif From 72774d72b87f8511ef54e26761d5d2cf41a72871 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 8 May 2018 10:32:28 -0600 Subject: [PATCH 0229/1072] split OBL depth computation and KPP_calculate --- src/parameterizations/vertical/MOM_KPP.F90 | 116 +++++++++++++++------ 1 file changed, 85 insertions(+), 31 deletions(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 697cc26125..48c683f60a 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -406,9 +406,8 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) end function KPP_init - -!> KPP vertical diffusivity/viscosity and non-local tracer transport -subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & +!> Compute OBL depth +subroutine KPP_compute_OBL(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & buoyFlux, Kt, Ks, Kv, nonLocalTransHeat,& nonLocalTransScalar) @@ -434,21 +433,19 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport (m/s) ! Local variables - integer :: i, j, k, km1,kp1 ! Loop indices + integer :: i, j, k, km1 ! Loop indices real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) real, dimension( G%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces (1/s2) real, dimension( G%ke+1 ) :: N_1d ! Brunt-Vaisala frequency at interfaces (1/s) (floored at 0) real, dimension( G%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars (m/s) - real, dimension( G%ke ) :: Wm_1d ! Profile of vertical velocity scale for momentum (m/s) + !real, dimension( G%ke ) :: Wm_1d ! Profile of vertical velocity scale for momentum (m/s) real, dimension( G%ke ) :: Vt2_1d ! Unresolved velocity for bulk Ri calculation/diagnostic (m2/s2) - real, dimension( G%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer real, dimension( G%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number real, dimension( G%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri (m2/s2) - real, dimension( G%ke+1, 2) :: Kdiffusivity ! Vertical diffusivity at interfaces (m2/s) - real, dimension( G%ke+1 ) :: Kviscosity ! Vertical viscosity at interfaces (m2/s) real, dimension( G%ke+1, 2) :: nonLocalTrans ! Non-local transport for heat/salt at interfaces (non-dimensional) real, dimension( G%ke ) :: surfBuoyFlux2 + real, dimension( G%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer ! for EOS calculation real, dimension( 3*G%ke ) :: rho_1D @@ -457,7 +454,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & real, dimension( 3*G%ke ) :: Salt_1D real :: kOBL, OBLdepth_0d, surfFricVel, surfBuoyFlux, Coriolis - real :: GoRho, pRef, rho1, rhoK, rhoKm1, Uk, Vk, sigma + real :: GoRho, pRef, rho1, rhoK, Uk, Vk, sigma real :: zBottomMinusOffset ! Height of bottom plus a little bit (m) real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth. @@ -471,20 +468,6 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) integer :: kk, ksfc, ktmp -#ifdef __DO_SAFETY_CHECKS__ - if (CS%debug) then - call hchksum(h, "KPP in: h",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Temp, "KPP in: T",G%HI,haloshift=0) - call hchksum(Salt, "KPP in: S",G%HI,haloshift=0) - call hchksum(u, "KPP in: u",G%HI,haloshift=0) - call hchksum(v, "KPP in: v",G%HI,haloshift=0) - call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0) - call hchksum(buoyFlux, "KPP in: buoyFlux",G%HI,haloshift=0) - call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0) - call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0) - endif -#endif - ! some constants GoRho = GV%g_Earth / GV%Rho0 nonLocalTrans(:,:) = 0.0 @@ -492,17 +475,15 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & if (CS%id_Kd_in > 0) call post_data(CS%id_Kd_in, Kt, CS%diag) !$OMP parallel do default(none) shared(G,GV,CS,EOS,uStar,Temp,Salt,u,v,h,GoRho, & -!$OMP buoyFlux, nonLocalTransHeat, & -!$OMP nonLocalTransScalar,Kt,Ks,Kv) & -!$OMP firstprivate(nonLocalTrans) & +!$OMP buoyFlux) & !$OMP private(Coriolis,surfFricVel,SLdepth_0d,hTot,surfTemp, & !$OMP surfHtemp,surfSalt,surfHsalt,surfU, & !$OMP surfHu,surfV,surfHv,iFaceHeight, & !$OMP pRef,km1,cellHeight,Uk,Vk,deltaU2, & -!$OMP rho1,rhoK,rhoKm1,deltaRho,N2_1d,N_1d,delH, & -!$OMP surfBuoyFlux,Ws_1d,Vt2_1d,BulkRi_1d, & -!$OMP OBLdepth_0d,zBottomMinusOffset,Kdiffusivity, & -!$OMP Kviscosity,sigma,kOBL,kk,pres_1D,Temp_1D, & +!$OMP rho1,rhoK,deltaRho,N2_1d,N_1d,delH, & +!$OMP surfBuoyFlux,Ws_1d,BulkRi_1d, & +!$OMP OBLdepth_0d,zBottomMinusOffset, & +!$OMP sigma,kOBL,kk,pres_1D,Temp_1D, & !$OMP Salt_1D,rho_1D,surfBuoyFlux2,ksfc,dh,hcorr) ! loop over horizontal points on processor @@ -746,6 +727,79 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & ! smg: remove code above ! ********************************************************************** + enddo + enddo + +end subroutine + +!> KPP vertical diffusivity/viscosity and non-local tracer transport +subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & + buoyFlux, Kt, Ks, Kv, nonLocalTransHeat,& + nonLocalTransScalar) + + ! Arguments + type(KPP_CS), pointer :: CS !< Control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< potential/cons temp (deg C) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< Salinity (ppt) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Velocity i-component (m/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Velocity j-component (m/s) + type(EOS_type), pointer :: EOS !< Equation of state + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (m/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux (m2/s3) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP (m2/s) + !< (out) Vertical diffusivity including KPP (m2/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP (m2/s) + !< (out) Vertical diffusivity including KPP (m2/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP (m2/s) + !< (out) Vertical viscosity including KPP (m2/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport (m/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport (m/s) + + ! Local variables + integer :: i, j, k, km1,kp1 ! Loop indices + real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) + real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) + real, dimension( G%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces (1/s2) + real, dimension( G%ke+1 ) :: N_1d ! Brunt-Vaisala frequency at interfaces (1/s) (floored at 0) + real, dimension( G%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars (m/s) + !real, dimension( G%ke ) :: Wm_1d ! Profile of vertical velocity scale for momentum (m/s) + real, dimension( G%ke ) :: Vt2_1d ! Unresolved velocity for bulk Ri calculation/diagnostic (m2/s2) + real, dimension( G%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number + real, dimension( G%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri (m2/s2) + real, dimension( G%ke+1, 2) :: nonLocalTrans ! Non-local transport for heat/salt at interfaces (non-dimensional) + + real, dimension( G%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer + real, dimension( G%ke+1, 2) :: Kdiffusivity ! Vertical diffusivity at interfaces (m2/s) + real, dimension( G%ke+1 ) :: Kviscosity ! Vertical viscosity at interfaces (m2/s) + + real :: kOBL, OBLdepth_0d, surfFricVel, surfBuoyFlux + real :: sigma + + real :: surfTemp ! Integral and average of temp over the surface layer + real :: surfSalt ! Integral and average of saln over the surface layer + real :: surfU ! Integral and average of u over the surface layer + real :: surfV ! Integral and average of v over the surface layer + +#ifdef __DO_SAFETY_CHECKS__ + if (CS%debug) then + call hchksum(h, "KPP in: h",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(Temp, "KPP in: T",G%HI,haloshift=0) + call hchksum(Salt, "KPP in: S",G%HI,haloshift=0) + call hchksum(u, "KPP in: u",G%HI,haloshift=0) + call hchksum(v, "KPP in: v",G%HI,haloshift=0) + call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0) + call hchksum(buoyFlux, "KPP in: buoyFlux",G%HI,haloshift=0) + call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0) + call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0) + endif +#endif + + ! loop over horizontal points on processor + do j = G%jsc, G%jec + do i = G%isc, G%iec ! Call CVMix/KPP to obtain OBL diffusivities, viscosities and non-local transports @@ -880,7 +934,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & if (CS%id_Tsurf > 0) CS%Tsurf(i,j) = surfTemp if (CS%id_Ssurf > 0) CS%Ssurf(i,j) = surfSalt if (CS%id_Usurf > 0) CS%Usurf(i,j) = surfU - if (CS%id_Vsurf > 0) CS%Vsurf(i,j) = surfv + if (CS%id_Vsurf > 0) CS%Vsurf(i,j) = surfV ! Update output of routine From 7a91f93c9acc05b44450d5a60e30b453d383cd69 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Tue, 8 May 2018 08:11:13 -0800 Subject: [PATCH 0230/1072] First whack at OBC radiation-nudging of tangential vel - Also a fix to normal vel rad-nud. - Changes a few answers. --- src/core/MOM_open_boundary.F90 | 187 +++++++++++++++++++++++++++++---- 1 file changed, 164 insertions(+), 23 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 91f9f6546b..2616577dbf 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -105,6 +105,10 @@ module MOM_open_boundary logical :: Flather !< If true, applies Flather + Chapman radiation of barotropic gravity waves. logical :: radiation !< If true, 1D Orlanksi radiation boundary conditions are applied. !! If False, a gradient condition is applied. + logical :: radiation_tan !< If true, 1D Orlanksi radiation boundary conditions are applied to + !! tangential flows. + logical :: radiation_grad !< If true, 1D Orlanksi radiation boundary conditions are applied to + !! dudv and dvdx. logical :: oblique !< Oblique waves supported at radiation boundary. logical :: nudged !< Optional supplement to radiation boundary. logical :: nudged_tan !< Optional supplement to nudge tangential velocity. @@ -384,6 +388,8 @@ subroutine open_boundary_config(G, param_file, OBC) do l=0,OBC%number_of_segments OBC%segment(l)%Flather = .false. OBC%segment(l)%radiation = .false. + OBC%segment(l)%radiation_tan = .false. + OBC%segment(l)%radiation_grad = .false. OBC%segment(l)%oblique = .false. OBC%segment(l)%nudged = .false. OBC%segment(l)%nudged_tan = .false. @@ -783,6 +789,11 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF) OBC%segment(l_seg)%open = .true. OBC%open_u_BCs_exist_globally = .true. OBC%radiation_BCs_exist_globally = .true. + elseif (trim(action_str(a_loop)) == 'ORLANSKI_TAN') then + OBC%segment(l_seg)%radiation_tan = .true. + OBC%radiation_BCs_exist_globally = .true. + elseif (trim(action_str(a_loop)) == 'ORLANSKI_GRAD') then + OBC%segment(l_seg)%radiation_grad = .true. elseif (trim(action_str(a_loop)) == 'OBLIQUE') then OBC%segment(l_seg)%oblique = .true. OBC%segment(l_seg)%open = .true. @@ -790,16 +801,9 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF) OBC%open_u_BCs_exist_globally = .true. elseif (trim(action_str(a_loop)) == 'NUDGED') then OBC%segment(l_seg)%nudged = .true. - write(segment_param_str(1:43),"('OBC_SEGMENT_',i3.3,'_VELOCITY_NUDGING_TIMESCALES')") l_seg - allocate(tnudge(2)) - call get_param(PF, mdl, segment_param_str(1:43), tnudge, & - "Timescales in days for nudging along a segment,\n"//& - "for inflow, then outflow. Setting both to zero should\n"//& - "behave like SIMPLE obcs for the baroclinic velocities.", & - fail_if_missing=.true.,default=0.,units="days") - OBC%segment(l_seg)%Velocity_nudging_timescale_in = tnudge(1)*86400. - OBC%segment(l_seg)%Velocity_nudging_timescale_out = tnudge(2)*86400. - deallocate(tnudge) + OBC%nudged_u_BCs_exist_globally = .true. + elseif (trim(action_str(a_loop)) == 'NUDGED_TAN') then + OBC%segment(l_seg)%nudged_tan = .true. OBC%nudged_u_BCs_exist_globally = .true. elseif (trim(action_str(a_loop)) == 'GRADIENT') then OBC%segment(l_seg)%gradient = .true. @@ -820,6 +824,18 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF) call MOM_error(FATAL, "MOM_open_boundary.F90, setup_u_point_obc: "//& "String '"//trim(action_str(a_loop))//"' not understood.") endif + if (OBC%segment(l_seg)%nudged .or. OBC%segment(l_seg)%nudged_tan) then + write(segment_param_str(1:43),"('OBC_SEGMENT_',i3.3,'_VELOCITY_NUDGING_TIMESCALES')") l_seg + allocate(tnudge(2)) + call get_param(PF, mdl, segment_param_str(1:43), tnudge, & + "Timescales in days for nudging along a segment,\n"//& + "for inflow, then outflow. Setting both to zero should\n"//& + "behave like SIMPLE obcs for the baroclinic velocities.", & + fail_if_missing=.true.,default=0.,units="days") + OBC%segment(l_seg)%Velocity_nudging_timescale_in = tnudge(1)*86400. + OBC%segment(l_seg)%Velocity_nudging_timescale_out = tnudge(2)*86400. + deallocate(tnudge) + endif enddo ! a_loop @@ -887,6 +903,11 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF) OBC%segment(l_seg)%open = .true. OBC%open_v_BCs_exist_globally = .true. OBC%radiation_BCs_exist_globally = .true. + elseif (trim(action_str(a_loop)) == 'ORLANSKI_TAN') then + OBC%segment(l_seg)%radiation_tan = .true. + OBC%radiation_BCs_exist_globally = .true. + elseif (trim(action_str(a_loop)) == 'ORLANSKI_GRAD') then + OBC%segment(l_seg)%radiation_grad = .true. elseif (trim(action_str(a_loop)) == 'OBLIQUE') then OBC%segment(l_seg)%oblique = .true. OBC%segment(l_seg)%open = .true. @@ -894,15 +915,9 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF) OBC%open_v_BCs_exist_globally = .true. elseif (trim(action_str(a_loop)) == 'NUDGED') then OBC%segment(l_seg)%nudged = .true. - write(segment_param_str(1:43),"('OBC_SEGMENT_',i3.3,'_VELOCITY_NUDGING_TIMESCALES')") l_seg - allocate(tnudge(2)) - call get_param(PF, mdl, segment_param_str(1:43), tnudge, & - "Timescales in days for nudging along a segment,\n"//& - "for inflow, then outflow.", & - fail_if_missing=.true.,default=0.,units="days") - OBC%segment(l_seg)%Velocity_nudging_timescale_in = tnudge(1)*86400. - OBC%segment(l_seg)%Velocity_nudging_timescale_out = tnudge(2)*86400. - deallocate(tnudge) + OBC%nudged_v_BCs_exist_globally = .true. + elseif (trim(action_str(a_loop)) == 'NUDGED_TAN') then + OBC%segment(l_seg)%nudged_tan = .true. OBC%nudged_v_BCs_exist_globally = .true. elseif (trim(action_str(a_loop)) == 'GRADIENT') then OBC%segment(l_seg)%gradient = .true. @@ -923,6 +938,18 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF) call MOM_error(FATAL, "MOM_open_boundary.F90, setup_v_point_obc: "//& "String '"//trim(action_str(a_loop))//"' not understood.") endif + if (OBC%segment(l_seg)%nudged .or. OBC%segment(l_seg)%nudged_tan) then + write(segment_param_str(1:43),"('OBC_SEGMENT_',i3.3,'_VELOCITY_NUDGING_TIMESCALES')") l_seg + allocate(tnudge(2)) + call get_param(PF, mdl, segment_param_str(1:43), tnudge, & + "Timescales in days for nudging along a segment,\n"//& + "for inflow, then outflow. Setting both to zero should\n"//& + "behave like SIMPLE obcs for the baroclinic velocities.", & + fail_if_missing=.true.,default=0.,units="days") + OBC%segment(l_seg)%Velocity_nudging_timescale_in = tnudge(1)*86400. + OBC%segment(l_seg)%Velocity_nudging_timescale_out = tnudge(2)*86400. + deallocate(tnudge) + endif enddo ! a_loop @@ -1440,6 +1467,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) real :: rx_max, ry_max ! coefficients for radiation real :: rx_new, rx_avg ! coefficients for radiation real :: ry_new, ry_avg ! coefficients for radiation + real, pointer, dimension(:,:,:) :: rx_tangential=>NULL() + real, pointer, dimension(:,:,:) :: ry_tangential=>NULL() real, parameter :: eps = 1.0e-20 type(OBC_segment_type), pointer :: segment integer :: i, j, k, is, ie, js, je, nz, n @@ -1540,10 +1569,38 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) tau = segment%Velocity_nudging_timescale_out endif gamma_2 = dt / (tau + dt) - segment%normal_vel(I,j,k) = (1 - gamma_2) * u_new(I,j,k) + & + segment%normal_vel(I,j,k) = (1 - gamma_2) * segment%normal_vel(I,j,k) + & gamma_2 * segment%nudged_normal_vel(I,j,k) endif enddo; enddo + if (segment%radiation_tan) then + I=segment%HI%IsdB + allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + rx_tangential(I,segment%HI%JsdB,k) = segment%rx_normal(I,segment%HI%jsd,k) + rx_tangential(I,segment%HI%JedB,k) = segment%rx_normal(I,segment%HI%jed,k) + do J=segment%HI%JsdB+1,segment%HI%JedB-1 + rx_tangential(I,J,k) = 0.5*(segment%rx_normal(I,j,k) + segment%rx_normal(I,j+1,k)) + enddo + enddo + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + rx_avg = rx_tangential(I,J,k) + segment%tangential_vel(I,J,k) = (v_new(I,J,k) + rx_avg*v_new(I-1,J,k)) / (1.0+rx_avg) + enddo; enddo + if (segment%nudged_tan) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + if (rx_tangential(I,J,k) < 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_vel(I,J,k) = (1 - gamma_2) * segment%tangential_vel(I,J,k) + & + gamma_2 * segment%nudged_tangential_vel(I,J,k) + enddo; enddo + endif + deallocate(rx_tangential) + endif endif if (segment%direction == OBC_DIRECTION_W) then @@ -1590,10 +1647,38 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) tau = segment%Velocity_nudging_timescale_out endif gamma_2 = dt / (tau + dt) - segment%normal_vel(I,j,k) = (1 - gamma_2) * u_new(I,j,k) + & + segment%normal_vel(I,j,k) = (1 - gamma_2) * segment%normal_vel(I,j,k) + & gamma_2 * segment%nudged_normal_vel(I,j,k) endif enddo; enddo + if (segment%radiation_tan) then + I=segment%HI%IsdB + allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + rx_tangential(I,segment%HI%JsdB,k) = segment%rx_normal(I,segment%HI%jsd,k) + rx_tangential(I,segment%HI%JedB,k) = segment%rx_normal(I,segment%HI%jed,k) + do J=segment%HI%JsdB+1,segment%HI%JedB-1 + rx_tangential(I,J,k) = 0.5*(segment%rx_normal(I,j,k) + segment%rx_normal(I,j+1,k)) + enddo + enddo + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + rx_avg = rx_tangential(I,J,k) + segment%tangential_vel(I,J,k) = (v_new(I+1,J,k) + rx_avg*v_new(I+2,J,k)) / (1.0+rx_avg) + enddo; enddo + if (segment%nudged_tan) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + if (rx_tangential(I,J,k) < 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_vel(I,J,k) = (1 - gamma_2) * segment%tangential_vel(I,J,k) + & + gamma_2 * segment%nudged_tangential_vel(I,J,k) + enddo; enddo + endif + deallocate(rx_tangential) + endif endif if (segment%direction == OBC_DIRECTION_N) then @@ -1641,10 +1726,38 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) tau = segment%Velocity_nudging_timescale_out endif gamma_2 = dt / (tau + dt) - segment%normal_vel(i,J,k) = (1 - gamma_2) * v_new(i,J,k) + & + segment%normal_vel(i,J,k) = (1 - gamma_2) * segment%normal_vel(i,J,k) + & gamma_2 * segment%nudged_normal_vel(i,J,k) endif enddo; enddo + if (segment%radiation_tan) then + J=segment%HI%JsdB + allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + rx_tangential(segment%HI%IsdB,J,k) = segment%rx_normal(segment%HI%isd,J,k) + rx_tangential(segment%HI%IedB,J,k) = segment%rx_normal(segment%HI%ied,J,k) + do I=segment%HI%IsdB+1,segment%HI%IedB-1 + rx_tangential(I,J,k) = 0.5*(segment%rx_normal(i,J,k) + segment%rx_normal(i+1,J,k)) + enddo + enddo + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + rx_avg = rx_tangential(I,J,k) + segment%tangential_vel(I,J,k) = (u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) / (1.0+rx_avg) + enddo; enddo + if (segment%nudged_tan) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + if (rx_tangential(I,J,k) < 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_vel(I,J,k) = (1 - gamma_2) * segment%tangential_vel(I,J,k) + & + gamma_2 * segment%nudged_tangential_vel(I,J,k) + enddo; enddo + endif + deallocate(rx_tangential) + endif endif @@ -1692,10 +1805,38 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) tau = segment%Velocity_nudging_timescale_out endif gamma_2 = dt / (tau + dt) - segment%normal_vel(i,J,k) = (1 - gamma_2) * v_new(i,J,k) + & + segment%normal_vel(i,J,k) = (1 - gamma_2) * segment%normal_vel(i,J,k) + & gamma_2 * segment%nudged_normal_vel(i,J,k) endif enddo; enddo + if (segment%radiation_tan) then + J=segment%HI%JsdB + allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + rx_tangential(segment%HI%IsdB,J,k) = segment%rx_normal(segment%HI%isd,J,k) + rx_tangential(segment%HI%IedB,J,k) = segment%rx_normal(segment%HI%ied,J,k) + do I=segment%HI%IsdB+1,segment%HI%IedB-1 + rx_tangential(I,J,k) = 0.5*(segment%rx_normal(i,J,k) + segment%rx_normal(i+1,J,k)) + enddo + enddo + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + rx_avg = rx_tangential(I,J,k) + segment%tangential_vel(I,J,k) = (u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) / (1.0+rx_avg) + enddo; enddo + if (segment%nudged_tan) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + if (rx_tangential(I,J,k) < 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_vel(I,J,k) = (1 - gamma_2) * segment%tangential_vel(I,J,k) + & + gamma_2 * segment%nudged_tangential_vel(I,J,k) + enddo; enddo + endif + deallocate(rx_tangential) + endif end if enddo From 8b6ff3ae500bdae36d771f1929d4d317e30a56c4 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Tue, 8 May 2018 13:02:47 -0800 Subject: [PATCH 0231/1072] Bug fixes to OBC dvdx code. --- src/core/MOM_open_boundary.F90 | 152 ++++++++++++++---- src/parameterizations/vertical/MOM_sponge.F90 | 78 ++++----- 2 files changed, 155 insertions(+), 75 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 2616577dbf..7fddc2eb85 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -112,6 +112,7 @@ module MOM_open_boundary logical :: oblique !< Oblique waves supported at radiation boundary. logical :: nudged !< Optional supplement to radiation boundary. logical :: nudged_tan !< Optional supplement to nudge tangential velocity. + logical :: nudged_grad !< Optional supplement to nudge normal gradient of tangential velocity. logical :: specified !< Boundary normal velocity fixed to external value. logical :: specified_tan !< Boundary tangential velocity fixed to external value. logical :: open !< Boundary is open for continuity solver. @@ -159,6 +160,8 @@ module MOM_open_boundary !! that values should be nudged towards (m s-1). real, pointer, dimension(:,:,:) :: nudged_tangential_vel=>NULL() !< The layer velocity tangential to the OB segment !! that values should be nudged towards (m s-1). + real, pointer, dimension(:,:,:) :: nudged_tangential_grad=>NULL() !< The layer dvdx or dudy towards which nudging + !! can occur (s-1). type(segment_tracer_registry_type), pointer :: tr_Reg=> NULL()!< A pointer to the tracer registry for the segment. type(hor_index_type) :: HI !< Horizontal index ranges real :: Tr_InvLscale3_out !< An effective inverse length scale cubed (m-3) @@ -393,6 +396,7 @@ subroutine open_boundary_config(G, param_file, OBC) OBC%segment(l)%oblique = .false. OBC%segment(l)%nudged = .false. OBC%segment(l)%nudged_tan = .false. + OBC%segment(l)%nudged_grad = .false. OBC%segment(l)%specified = .false. OBC%segment(l)%specified_tan = .false. OBC%segment(l)%open = .false. @@ -635,13 +639,13 @@ subroutine initialize_segment_data(G, OBC, PF) siz2(3)=siz(3) if (segment%is_E_or_W) then - if (segment%field(m)%name == 'V') then + if (segment%field(m)%name == 'V' .or. segment%field(m)%name == 'DVDX') then allocate(segment%field(m)%buffer_src(IsdB:IedB,JsdB:JedB,siz2(3))) else allocate(segment%field(m)%buffer_src(IsdB:IedB,jsd:jed,siz2(3))) endif else - if (segment%field(m)%name == 'U') then + if (segment%field(m)%name == 'U' .or. segment%field(m)%name == 'DUDY') then allocate(segment%field(m)%buffer_src(IsdB:IedB,JsdB:JedB,siz2(3))) else allocate(segment%field(m)%buffer_src(isd:ied,JsdB:JedB,siz2(3))) @@ -654,13 +658,13 @@ subroutine initialize_segment_data(G, OBC, PF) fieldname = 'dz_'//trim(fieldname) call field_size(filename,fieldname,siz,no_domain=.true.) if (segment%is_E_or_W) then - if (segment%field(m)%name == 'V') then + if (segment%field(m)%name == 'V' .or. segment%field(m)%name == 'DVDX') then allocate(segment%field(m)%dz_src(IsdB:IedB,JsdB:JedB,siz(3))) else allocate(segment%field(m)%dz_src(IsdB:IedB,jsd:jed,siz(3))) endif else - if (segment%field(m)%name == 'U') then + if (segment%field(m)%name == 'U' .or. segment%field(m)%name == 'DUDY') then allocate(segment%field(m)%dz_src(IsdB:IedB,JsdB:JedB,siz(3))) else allocate(segment%field(m)%dz_src(isd:ied,JsdB:JedB,siz(3))) @@ -805,6 +809,8 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF) elseif (trim(action_str(a_loop)) == 'NUDGED_TAN') then OBC%segment(l_seg)%nudged_tan = .true. OBC%nudged_u_BCs_exist_globally = .true. + elseif (trim(action_str(a_loop)) == 'NUDGED_GRAD') then + OBC%segment(l_seg)%nudged_grad = .true. elseif (trim(action_str(a_loop)) == 'GRADIENT') then OBC%segment(l_seg)%gradient = .true. OBC%segment(l_seg)%open = .true. @@ -919,6 +925,8 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF) elseif (trim(action_str(a_loop)) == 'NUDGED_TAN') then OBC%segment(l_seg)%nudged_tan = .true. OBC%nudged_v_BCs_exist_globally = .true. + elseif (trim(action_str(a_loop)) == 'NUDGED_GRAD') then + OBC%segment(l_seg)%nudged_grad = .true. elseif (trim(action_str(a_loop)) == 'GRADIENT') then OBC%segment(l_seg)%gradient = .true. OBC%segment(l_seg)%open = .true. @@ -1573,7 +1581,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) gamma_2 * segment%nudged_normal_vel(I,j,k) endif enddo; enddo - if (segment%radiation_tan) then + if (segment%radiation_tan .or. segment%radiation_grad) then I=segment%HI%IsdB allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) do k=1,nz @@ -1583,10 +1591,12 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_tangential(I,J,k) = 0.5*(segment%rx_normal(I,j,k) + segment%rx_normal(I,j+1,k)) enddo enddo - do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = (v_new(I,J,k) + rx_avg*v_new(I-1,J,k)) / (1.0+rx_avg) - enddo; enddo + if (segment%radiation_tan) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + rx_avg = rx_tangential(I,J,k) + segment%tangential_vel(I,J,k) = (v_new(I,J,k) + rx_avg*v_new(I-1,J,k)) / (1.0+rx_avg) + enddo; enddo + endif if (segment%nudged_tan) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB if (rx_tangential(I,J,k) < 0.0) then @@ -1599,6 +1609,25 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) gamma_2 * segment%nudged_tangential_vel(I,J,k) enddo; enddo endif + if (segment%radiation_grad) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + rx_avg = rx_tangential(I,J,k) + segment%tangential_grad(I,J,k) = ((v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) + & + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) / (1.0+rx_avg) + enddo; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + if (rx_tangential(I,J,k) < 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo; enddo + endif deallocate(rx_tangential) endif endif @@ -1651,7 +1680,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) gamma_2 * segment%nudged_normal_vel(I,j,k) endif enddo; enddo - if (segment%radiation_tan) then + if (segment%radiation_tan .or. segment%radiation_grad) then I=segment%HI%IsdB allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) do k=1,nz @@ -1661,10 +1690,12 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_tangential(I,J,k) = 0.5*(segment%rx_normal(I,j,k) + segment%rx_normal(I,j+1,k)) enddo enddo - do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = (v_new(I+1,J,k) + rx_avg*v_new(I+2,J,k)) / (1.0+rx_avg) - enddo; enddo + if (segment%radiation_tan) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + rx_avg = rx_tangential(I,J,k) + segment%tangential_vel(I,J,k) = (v_new(I+1,J,k) + rx_avg*v_new(I+2,J,k)) / (1.0+rx_avg) + enddo; enddo + endif if (segment%nudged_tan) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB if (rx_tangential(I,J,k) < 0.0) then @@ -1677,6 +1708,25 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) gamma_2 * segment%nudged_tangential_vel(I,J,k) enddo; enddo endif + if (segment%radiation_grad) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + rx_avg = rx_tangential(I,J,k) + segment%tangential_grad(I,J,k) = ((v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) + & + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) / (1.0+rx_avg) + enddo; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + if (rx_tangential(I,J,k) < 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo; enddo + endif deallocate(rx_tangential) endif endif @@ -1730,7 +1780,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) gamma_2 * segment%nudged_normal_vel(i,J,k) endif enddo; enddo - if (segment%radiation_tan) then + if (segment%radiation_tan .or. segment%radiation_grad) then J=segment%HI%JsdB allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) do k=1,nz @@ -1740,10 +1790,12 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_tangential(I,J,k) = 0.5*(segment%rx_normal(i,J,k) + segment%rx_normal(i+1,J,k)) enddo enddo - do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB - rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = (u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) / (1.0+rx_avg) - enddo; enddo + if (segment%radiation_tan) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + rx_avg = rx_tangential(I,J,k) + segment%tangential_vel(I,J,k) = (u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) / (1.0+rx_avg) + enddo; enddo + endif if (segment%nudged_tan) then do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB if (rx_tangential(I,J,k) < 0.0) then @@ -1756,6 +1808,25 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) gamma_2 * segment%nudged_tangential_vel(I,J,k) enddo; enddo endif + if (segment%radiation_grad) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + rx_avg = rx_tangential(I,J,k) + segment%tangential_grad(I,J,k) = ((u_new(I,j,k) - u_new(I-1,j,k))*G%IdyBu(I,J-1) + & + rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) / (1.0+rx_avg) + enddo; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + if (rx_tangential(I,J,k) < 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo; enddo + endif deallocate(rx_tangential) endif endif @@ -1809,7 +1880,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) gamma_2 * segment%nudged_normal_vel(i,J,k) endif enddo; enddo - if (segment%radiation_tan) then + if (segment%radiation_tan .or. segment%radiation_grad) then J=segment%HI%JsdB allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) do k=1,nz @@ -1819,10 +1890,12 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_tangential(I,J,k) = 0.5*(segment%rx_normal(i,J,k) + segment%rx_normal(i+1,J,k)) enddo enddo - do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB - rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = (u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) / (1.0+rx_avg) - enddo; enddo + if (segment%radiation_tan) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + rx_avg = rx_tangential(I,J,k) + segment%tangential_vel(I,J,k) = (u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) / (1.0+rx_avg) + enddo; enddo + endif if (segment%nudged_tan) then do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB if (rx_tangential(I,J,k) < 0.0) then @@ -1835,9 +1908,28 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) gamma_2 * segment%nudged_tangential_vel(I,J,k) enddo; enddo endif + if (segment%radiation_grad) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + rx_avg = rx_tangential(I,J,k) + segment%tangential_grad(I,J,k) = ((u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & + rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) / (1.0+rx_avg) + enddo; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + if (rx_tangential(I,J,k) < 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo; enddo + endif deallocate(rx_tangential) endif - end if + endif enddo ! Actually update u_new, v_new @@ -2115,7 +2207,10 @@ subroutine allocate_OBC_segment_data(OBC, segment) if (segment%nudged_tan) then allocate(segment%nudged_tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_vel(:,:,:)=0.0 endif - if (OBC%specified_vorticity .or. OBC%specified_strain) then + if (segment%nudged_grad) then + allocate(segment%nudged_tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_grad(:,:,:)=0.0 + endif + if (OBC%specified_vorticity .or. OBC%specified_strain .or. segment%radiation_grad) then allocate(segment%tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_grad(:,:,:)=0.0 endif if (segment%oblique) then @@ -2148,7 +2243,10 @@ subroutine allocate_OBC_segment_data(OBC, segment) if (segment%nudged_tan) then allocate(segment%nudged_tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_vel(:,:,:)=0.0 endif - if (OBC%specified_vorticity .or. OBC%specified_strain) then + if (segment%nudged_grad) then + allocate(segment%nudged_tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_grad(:,:,:)=0.0 + endif + if (OBC%specified_vorticity .or. OBC%specified_strain .or. segment%radiation_grad) then allocate(segment%tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_grad(:,:,:)=0.0 endif if (segment%oblique) then diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index 0bb4a9bfdb..3e55557c89 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -120,29 +120,23 @@ module MOM_sponge contains +!> This subroutine determines the number of points which are within +!! sponges in this computational domain. Only points that have +!! positive values of Iresttime and which mask2dT indicates are ocean +!! points are included in the sponges. It also stores the target interface +!! heights. subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, & Iresttime_i_mean, int_height_i_mean) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: int_height - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(sponge_CS), pointer :: CS + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time, in s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: int_height !< The interface heights to damp back toward, in m. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(sponge_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module real, dimension(SZJ_(G)), optional, intent(in) :: Iresttime_i_mean real, dimension(SZJ_(G),SZK_(G)+1), optional, intent(in) :: int_height_i_mean -! This subroutine determines the number of points which are within -! sponges in this computational domain. Only points that have -! positive values of Iresttime and which mask2dT indicates are ocean -! points are included in the sponges. It also stores the target interface -! heights. -! Arguments: Iresttime - The inverse of the restoring time, in s-1. -! (in) int_height - The interface heights to damp back toward, in m. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_sponge" ! This module's name. @@ -226,21 +220,15 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, & end subroutine initialize_sponge +!> This subroutine sets up diagnostics for the sponges. It is separate +!! from initialize_sponge because it requires fields that are not readily +!! availble where initialize_sponge is called. subroutine init_sponge_diags(Time, G, diag, CS) - type(time_type), target, intent(in) :: Time + type(time_type), target, intent(in) :: Time !< The current model time type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(diag_ctrl), target, intent(inout) :: diag - type(sponge_CS), pointer :: CS - -! This subroutine sets up diagnostics for the sponges. It is separate -! from initialize_sponge because it requires fields that are not readily -! availble where initialize_sponge is called. - -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in/out) CS - A pointer to the control structure for this module that is -! set by a previous call to initialize_sponge. + type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic output + type(sponge_CS), pointer :: CS !< A pointer to the control structure for this module that + !! is set by a previous call to initialize_sponge. if (.not.associated(CS)) return @@ -250,25 +238,19 @@ subroutine init_sponge_diags(Time, G, diag, CS) end subroutine init_sponge_diags +!> This subroutine stores the reference profile for the variable +!! whose address is given by f_ptr. nlay is the number of layers in +!! this variable. subroutine set_up_sponge_field(sp_val, f_ptr, G, nlay, CS, sp_val_i_mean) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: sp_val - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target, intent(in) :: f_ptr - integer, intent(in) :: nlay - type(sponge_CS), pointer :: CS - real, dimension(SZJ_(G),SZK_(G)), optional, intent(in) :: sp_val_i_mean -! This subroutine stores the reference profile for the variable -! whose address is given by f_ptr. nlay is the number of layers in -! this variable. - -! Arguments: sp_val - The reference profiles of the quantity being -! registered. -! (in) f_ptr - a pointer to the field which will be damped. -! (in) nlay - the number of layers in this quantity. -! (in/out) CS - A pointer to the control structure for this module that is -! set by a previous call to initialize_sponge. -! (in,opt) sp_val_i_mean - The i-mean reference value for this field with -! i-mean sponges. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: sp_val !< The reference profiles of the quantity being + !! registered. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target, intent(in) :: f_ptr !< a pointer to the field which will be damped + integer, intent(in) :: nlay !< the number of layers in this quantity + type(sponge_CS), pointer :: CS !< A pointer to the control structure for this module that + !! is set by a previous call to initialize_sponge. + real, dimension(SZJ_(G),SZK_(G)), optional, intent(in) :: sp_val_i_mean !< The i-mean reference value for + !! this field with i-mean sponges. integer :: j, k, col character(len=256) :: mesg ! String for error messages From 80d93232cc447c1db452c80388c18076bf81a25e Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 8 May 2018 15:27:38 -0600 Subject: [PATCH 0232/1072] restore KPP_calculate for now --- src/parameterizations/vertical/MOM_KPP.F90 | 297 ++++++++++++++++++++- 1 file changed, 285 insertions(+), 12 deletions(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 48c683f60a..192ae02389 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -732,6 +732,7 @@ subroutine KPP_compute_OBL(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & end subroutine + !> KPP vertical diffusivity/viscosity and non-local tracer transport subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & buoyFlux, Kt, Ks, Kv, nonLocalTransHeat,& @@ -758,30 +759,43 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport (m/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport (m/s) - ! Local variables +! Local variables integer :: i, j, k, km1,kp1 ! Loop indices real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) real, dimension( G%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces (1/s2) real, dimension( G%ke+1 ) :: N_1d ! Brunt-Vaisala frequency at interfaces (1/s) (floored at 0) real, dimension( G%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars (m/s) - !real, dimension( G%ke ) :: Wm_1d ! Profile of vertical velocity scale for momentum (m/s) + real, dimension( G%ke ) :: Wm_1d ! Profile of vertical velocity scale for momentum (m/s) real, dimension( G%ke ) :: Vt2_1d ! Unresolved velocity for bulk Ri calculation/diagnostic (m2/s2) + real, dimension( G%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer real, dimension( G%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number real, dimension( G%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri (m2/s2) - real, dimension( G%ke+1, 2) :: nonLocalTrans ! Non-local transport for heat/salt at interfaces (non-dimensional) - - real, dimension( G%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer real, dimension( G%ke+1, 2) :: Kdiffusivity ! Vertical diffusivity at interfaces (m2/s) real, dimension( G%ke+1 ) :: Kviscosity ! Vertical viscosity at interfaces (m2/s) + real, dimension( G%ke+1, 2) :: nonLocalTrans ! Non-local transport for heat/salt at interfaces (non-dimensional) + real, dimension( G%ke ) :: surfBuoyFlux2 - real :: kOBL, OBLdepth_0d, surfFricVel, surfBuoyFlux - real :: sigma + ! for EOS calculation + real, dimension( 3*G%ke ) :: rho_1D + real, dimension( 3*G%ke ) :: pres_1D + real, dimension( 3*G%ke ) :: Temp_1D + real, dimension( 3*G%ke ) :: Salt_1D - real :: surfTemp ! Integral and average of temp over the surface layer - real :: surfSalt ! Integral and average of saln over the surface layer - real :: surfU ! Integral and average of u over the surface layer - real :: surfV ! Integral and average of v over the surface layer + real :: kOBL, OBLdepth_0d, surfFricVel, surfBuoyFlux, Coriolis + real :: GoRho, pRef, rho1, rhoK, rhoKm1, Uk, Vk, sigma + + real :: zBottomMinusOffset ! Height of bottom plus a little bit (m) + real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth. + real :: hTot ! Running sum of thickness used in the surface layer average (m) + real :: delH ! Thickness of a layer (m) + real :: surfHtemp, surfTemp ! Integral and average of temp over the surface layer + real :: surfHsalt, surfSalt ! Integral and average of saln over the surface layer + real :: surfHu, surfU ! Integral and average of u over the surface layer + real :: surfHv, surfV ! Integral and average of v over the surface layer + real :: dh ! The local thickness used for calculating interface positions (m) + real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) + integer :: kk, ksfc, ktmp #ifdef __DO_SAFETY_CHECKS__ if (CS%debug) then @@ -797,10 +811,268 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & endif #endif + ! some constants + GoRho = GV%g_Earth / GV%Rho0 + nonLocalTrans(:,:) = 0.0 + + if (CS%id_Kd_in > 0) call post_data(CS%id_Kd_in, Kt, CS%diag) + +!$OMP parallel do default(none) shared(G,GV,CS,EOS,uStar,Temp,Salt,u,v,h,GoRho, & +!$OMP buoyFlux, nonLocalTransHeat, & +!$OMP nonLocalTransScalar,Kt,Ks,Kv) & +!$OMP firstprivate(nonLocalTrans) & +!$OMP private(Coriolis,surfFricVel,SLdepth_0d,hTot,surfTemp, & +!$OMP surfHtemp,surfSalt,surfHsalt,surfU, & +!$OMP surfHu,surfV,surfHv,iFaceHeight, & +!$OMP pRef,km1,cellHeight,Uk,Vk,deltaU2, & +!$OMP rho1,rhoK,rhoKm1,deltaRho,N2_1d,N_1d,delH, & +!$OMP surfBuoyFlux,Ws_1d,Vt2_1d,BulkRi_1d, & +!$OMP OBLdepth_0d,zBottomMinusOffset,Kdiffusivity, & +!$OMP Kviscosity,sigma,kOBL,kk,pres_1D,Temp_1D, & +!$OMP Salt_1D,rho_1D,surfBuoyFlux2,ksfc,dh,hcorr) + ! loop over horizontal points on processor do j = G%jsc, G%jec do i = G%isc, G%iec + ! skip calling KPP for land points + if (G%mask2dT(i,j)==0.) cycle + + ! things independent of position within the column + Coriolis = 0.25*( (G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) & + +(G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1)) ) + surfFricVel = uStar(i,j) + + ! Bullk Richardson number computed for each cell in a column, + ! assuming OBLdepth = grid cell depth. After Rib(k) is + ! known for the column, then CVMix interpolates to find + ! the actual OBLdepth. This approach avoids need to iterate + ! on the OBLdepth calculation. It follows that used in MOM5 + ! and POP. + iFaceHeight(1) = 0.0 ! BBL is all relative to the surface + pRef = 0. + hcorr = 0. + do k=1,G%ke + + ! cell center and cell bottom in meters (negative values in the ocean) + dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) + hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 + dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness + cellHeight(k) = iFaceHeight(k) - 0.5 * dh + iFaceHeight(k+1) = iFaceHeight(k) - dh + + ! find ksfc for cell where "surface layer" sits + SLdepth_0d = CS%surf_layer_ext*max( max(-cellHeight(k),-iFaceHeight(2) ), CS%minOBLdepth ) + ksfc = k + do ktmp = 1,k + if (-1.0*iFaceHeight(ktmp+1) >= SLdepth_0d) then + ksfc = ktmp + exit + endif + enddo + + ! average temp, saln, u, v over surface layer + ! use C-grid average to get u,v on T-points. + surfHtemp=0.0 + surfHsalt=0.0 + surfHu =0.0 + surfHv =0.0 + hTot =0.0 + do ktmp = 1,ksfc + + ! SLdepth_0d can be between cell interfaces + delH = min( max(0.0, SLdepth_0d - hTot), h(i,j,ktmp)*GV%H_to_m ) + + ! surface layer thickness + hTot = hTot + delH + + ! surface averaged fields + surfHtemp = surfHtemp + Temp(i,j,ktmp) * delH + surfHsalt = surfHsalt + Salt(i,j,ktmp) * delH + surfHu = surfHu + 0.5*(u(i,j,ktmp)+u(i-1,j,ktmp)) * delH + surfHv = surfHv + 0.5*(v(i,j,ktmp)+v(i,j-1,ktmp)) * delH + + enddo + surfTemp = surfHtemp / hTot + surfSalt = surfHsalt / hTot + surfU = surfHu / hTot + surfV = surfHv / hTot + + ! vertical shear between present layer and + ! surface layer averaged surfU,surfV. + ! C-grid average to get Uk and Vk on T-points. + Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU + Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV + deltaU2(k) = Uk**2 + Vk**2 + + ! pressure, temp, and saln for EOS + ! kk+1 = surface fields + ! kk+2 = k fields + ! kk+3 = km1 fields + km1 = max(1, k-1) + kk = 3*(k-1) + pres_1D(kk+1) = pRef + pres_1D(kk+2) = pRef + pres_1D(kk+3) = pRef + Temp_1D(kk+1) = surfTemp + Temp_1D(kk+2) = Temp(i,j,k) + Temp_1D(kk+3) = Temp(i,j,km1) + Salt_1D(kk+1) = surfSalt + Salt_1D(kk+2) = Salt(i,j,k) + Salt_1D(kk+3) = Salt(i,j,km1) + + ! pRef is pressure at interface between k and km1. + ! iterate pRef for next pass through k-loop. + pRef = pRef + GV%H_to_Pa * h(i,j,k) + + ! this difference accounts for penetrating SW + surfBuoyFlux2(k) = buoyFlux(i,j,1) - buoyFlux(i,j,k+1) + + enddo ! k-loop finishes + + ! compute in-situ density + call calculate_density(Temp_1D, Salt_1D, pres_1D, rho_1D, 1, 3*G%ke, EOS) + + ! N2 (can be negative) and N (non-negative) on interfaces. + ! deltaRho is non-local rho difference used for bulk Richardson number. + ! N_1d is local N (with floor) used for unresolved shear calculation. + do k = 1, G%ke + km1 = max(1, k-1) + kk = 3*(k-1) + deltaRho(k) = rho_1D(kk+2) - rho_1D(kk+1) + N2_1d(k) = (GoRho * (rho_1D(kk+2) - rho_1D(kk+3)) ) / & + ((0.5*(h(i,j,km1) + h(i,j,k))+GV%H_subroundoff)*GV%H_to_m) + N_1d(k) = sqrt( max( N2_1d(k), 0.) ) + enddo + N2_1d(G%ke+1 ) = 0.0 + N_1d(G%ke+1 ) = 0.0 + + ! turbulent velocity scales w_s and w_m computed at the cell centers. + ! Note that if sigma > CS%surf_layer_ext, then CVMix_kpp_compute_turbulent_scales + ! computes w_s and w_m velocity scale at sigma=CS%surf_layer_ext. So we only pass + ! sigma=CS%surf_layer_ext for this calculation. + call CVMix_kpp_compute_turbulent_scales( & + CS%surf_layer_ext, & ! (in) Normalized surface layer depth; sigma = CS%surf_layer_ext + -cellHeight, & ! (in) Assume here that OBL depth (m) = -cellHeight(k) + surfBuoyFlux2, & ! (in) Buoyancy flux at surface (m2/s3) + surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) + w_s=Ws_1d, & ! (out) Turbulent velocity scale profile (m/s) + CVMix_kpp_params_user=CS%KPP_params ) + + ! Calculate Bulk Richardson number from eq (21) of LMD94 + BulkRi_1d = CVMix_kpp_compute_bulk_Richardson( & + cellHeight(1:G%ke), & ! Depth of cell center (m) + GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) (1/s) + deltaU2, & ! Square of resolved velocity difference (m2/s2) + ws_cntr=Ws_1d, & ! Turbulent velocity scale profile (m/s) + N_iface=N_1d) ! Buoyancy frequency (1/s) + + + surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit + ! h to Monin-Obukov (default is false, ie. not used) + + call CVMix_kpp_compute_OBL_depth( & + BulkRi_1d, & ! (in) Bulk Richardson number + iFaceHeight, & ! (in) Height of interfaces (m) + OBLdepth_0d, & ! (out) OBL depth (m) + kOBL, & ! (out) level (+fraction) of OBL extent + zt_cntr=cellHeight, & ! (in) Height of cell centers (m) + surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) + surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) + Coriolis=Coriolis, & ! (in) Coriolis parameter (1/s) + CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters + + ! A hack to avoid KPP reaching the bottom. It was needed during development + ! because KPP was unable to handle vanishingly small layers near the bottom. + if (CS%deepOBLoffset>0.) then + zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) + OBLdepth_0d = min( OBLdepth_0d, -zBottomMinusOffset ) + endif + + ! apply some constraints on OBLdepth + if(CS%fixedOBLdepth) OBLdepth_0d = CS%fixedOBLdepth_value + OBLdepth_0d = max( OBLdepth_0d, -iFaceHeight(2) ) ! no shallower than top layer + OBLdepth_0d = min( OBLdepth_0d, -iFaceHeight(G%ke+1) ) ! no deeper than bottom + kOBL = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) + +!************************************************************************* +! smg: remove code below + +! Following "correction" step has been found to be unnecessary. +! Code should be removed after further testing. + if (CS%correctSurfLayerAvg) then + + SLdepth_0d = CS%surf_layer_ext * OBLdepth_0d + hTot = h(i,j,1) + surfTemp = Temp(i,j,1) ; surfHtemp = surfTemp * hTot + surfSalt = Salt(i,j,1) ; surfHsalt = surfSalt * hTot + surfU = 0.5*(u(i,j,1)+u(i-1,j,1)) ; surfHu = surfU * hTot + surfV = 0.5*(v(i,j,1)+v(i,j-1,1)) ; surfHv = surfV * hTot + pRef = 0.0 + + do k = 2, G%ke + + ! Recalculate differences with surface layer + Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU + Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV + deltaU2(k) = Uk**2 + Vk**2 + pRef = pRef + GV%H_to_Pa * h(i,j,k) + call calculate_density(surfTemp, surfSalt, pRef, rho1, EOS) + call calculate_density(Temp(i,j,k), Salt(i,j,k), pRef, rhoK, EOS) + deltaRho(k) = rhoK - rho1 + + ! Surface layer averaging (needed for next k+1 iteration of this loop) + if (hTot < SLdepth_0d) then + delH = min( max(0., SLdepth_0d - hTot), h(i,j,k)*GV%H_to_m ) + hTot = hTot + delH + surfHtemp = surfHtemp + Temp(i,j,k) * delH ; surfTemp = surfHtemp / hTot + surfHsalt = surfHsalt + Salt(i,j,k) * delH ; surfSalt = surfHsalt / hTot + surfHu = surfHu + 0.5*(u(i,j,k)+u(i-1,j,k)) * delH ; surfU = surfHu / hTot + surfHv = surfHv + 0.5*(v(i,j,k)+v(i,j-1,k)) * delH ; surfV = surfHv / hTot + endif + + enddo + + BulkRi_1d = CVMix_kpp_compute_bulk_Richardson( & + cellHeight(1:G%ke), & ! Depth of cell center (m) + GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) (1/s) + deltaU2, & ! Square of resolved velocity difference (m2/s2) + ws_cntr=Ws_1d, & ! Turbulent velocity scale profile (m/s) + N_iface=N_1d ) ! Buoyancy frequency (1/s) + + surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit + ! h to Monin-Obukov (default is false, ie. not used) + + call CVMix_kpp_compute_OBL_depth( & + BulkRi_1d, & ! (in) Bulk Richardson number + iFaceHeight, & ! (in) Height of interfaces (m) + OBLdepth_0d, & ! (out) OBL depth (m) + kOBL, & ! (out) level (+fraction) of OBL extent + zt_cntr=cellHeight, & ! (in) Height of cell centers (m) + surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) + surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) + Coriolis=Coriolis, & ! (in) Coriolis parameter (1/s) + CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters + + if (CS%deepOBLoffset>0.) then + zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) + OBLdepth_0d = min( OBLdepth_0d, -zBottomMinusOffset ) + kOBL = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) + endif + + ! apply some constraints on OBLdepth + if(CS%fixedOBLdepth) OBLdepth_0d = CS%fixedOBLdepth_value + OBLdepth_0d = max( OBLdepth_0d, -iFaceHeight(2) ) ! no shallower than top layer + OBLdepth_0d = min( OBLdepth_0d, -iFaceHeight(G%ke+1) ) ! no deep than bottom + kOBL = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) + + endif ! endif for "correction" step + +! smg: remove code above +! ********************************************************************** + + ! Call CVMix/KPP to obtain OBL diffusivities, viscosities and non-local transports ! Unlike LMD94, we do not match to interior diffusivities. If using the original @@ -934,7 +1206,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & if (CS%id_Tsurf > 0) CS%Tsurf(i,j) = surfTemp if (CS%id_Ssurf > 0) CS%Ssurf(i,j) = surfSalt if (CS%id_Usurf > 0) CS%Usurf(i,j) = surfU - if (CS%id_Vsurf > 0) CS%Vsurf(i,j) = surfV + if (CS%id_Vsurf > 0) CS%Vsurf(i,j) = surfv ! Update output of routine @@ -991,6 +1263,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & end subroutine KPP_calculate + !> Copies KPP surface boundary layer depth into BLD subroutine KPP_get_BLD(CS, BLD, G) type(KPP_CS), pointer :: CS !< Control structure for From 85810d2c2afcc2f19a7709f6623a1dcd75da5103 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 8 May 2018 15:32:51 -0600 Subject: [PATCH 0233/1072] remove unnecessary KPP_compute_OBL arguments --- src/parameterizations/vertical/MOM_KPP.F90 | 16 ++-------------- 1 file changed, 2 insertions(+), 14 deletions(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 192ae02389..a9e9c06f87 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -407,9 +407,7 @@ end function KPP_init !> Compute OBL depth -subroutine KPP_compute_OBL(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & - buoyFlux, Kt, Ks, Kv, nonLocalTransHeat,& - nonLocalTransScalar) +subroutine KPP_compute_OBL(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) ! Arguments type(KPP_CS), pointer :: CS !< Control structure @@ -423,14 +421,6 @@ subroutine KPP_compute_OBL(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & type(EOS_type), pointer :: EOS !< Equation of state real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (m/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux (m2/s3) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP (m2/s) - !< (out) Vertical diffusivity including KPP (m2/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP (m2/s) - !< (out) Vertical diffusivity including KPP (m2/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP (m2/s) - !< (out) Vertical viscosity including KPP (m2/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport (m/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport (m/s) ! Local variables integer :: i, j, k, km1 ! Loop indices @@ -472,8 +462,6 @@ subroutine KPP_compute_OBL(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & GoRho = GV%g_Earth / GV%Rho0 nonLocalTrans(:,:) = 0.0 - if (CS%id_Kd_in > 0) call post_data(CS%id_Kd_in, Kt, CS%diag) - !$OMP parallel do default(none) shared(G,GV,CS,EOS,uStar,Temp,Salt,u,v,h,GoRho, & !$OMP buoyFlux) & !$OMP private(Coriolis,surfFricVel,SLdepth_0d,hTot,surfTemp, & @@ -730,7 +718,7 @@ subroutine KPP_compute_OBL(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & enddo enddo -end subroutine +end subroutine KPP_compute_OBL !> KPP vertical diffusivity/viscosity and non-local tracer transport From 7c2e5be45bbd3a82f21b144695f6efed643235a0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 18:18:47 -0400 Subject: [PATCH 0234/1072] Corrected a max to a min in i2s A recent update intended to add a min of n and 3 to avoid segmentation faults, but a max was added instead, triggering segmentation faults. All answers are still bitwise identical in the test cases, but this now passes a more sensitive compiler's checks. --- src/framework/MOM_diag_mediator.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index e0737ad2f8..67b8789109 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -2562,7 +2562,7 @@ function i2s(a,n_in) if (present(n_in)) n = n_in i2s = '' - do i=1,max(n,3) + do i=1,min(n,3) write (i2s_temp, '(I4.4)') a(i) i2s = trim(i2s) //'_'// trim(i2s_temp) enddo From 8e860288441b149fdaa1e0bfeac05c6081d6edde Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 18:21:07 -0400 Subject: [PATCH 0235/1072] dOxyGenized MOM_tracer_flow_control.F90 Added dOxyGen comments for all subroutine arguments in MOM_tracer_flow_control.F90. All answers are bitwise identical. --- src/tracer/MOM_tracer_flow_control.F90 | 94 +++++++++++++++----------- 1 file changed, 53 insertions(+), 41 deletions(-) diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 0a11de9c1e..8483bf2b6f 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -443,13 +443,12 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by !! a previous call to !! call_tracer_register. - logical, intent(in) :: debug !< Calculates checksums - real, optional,intent(in) :: evap_CFL_limit !< Limits how much water - !! can be fluxed out of the top layer - !! Stored previously in diabatic] CS. - real, optional,intent(in) :: minimum_forcing_depth !< The smallest depth - !! over which fluxes can be applied - !! Stored previously in diabatic CS. + logical, intent(in) :: debug !< If true calculate checksums + real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of + !! the water that can be fluxed out + !! of the top layer in a timestep (nondim) + real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over + !! which fluxes can be applied, in m ! This subroutine calls all registered tracer column physics ! subroutines. @@ -596,36 +595,37 @@ end subroutine call_tracer_column_fns !> This subroutine calls all registered tracer packages to enable them to !! add to the surface state returned to the coupler. These routines are optional. subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_units, & - num_stocks, stock_index, got_min_max,global_min, global_max,xgmin, & - ygmin, zgmin, xgmax, ygmax, zgmax) + num_stocks, stock_index, got_min_max, global_min, global_max, & + xgmin, ygmin, zgmin, xgmax, ygmax, zgmax) real, dimension(NIMEM_,NJMEM_,NKMEM_), & intent(in) :: h !< Layer thicknesses, in H !! (usually m or kg m-2). - real, dimension(:), intent(out) :: stock_values + real, dimension(:), intent(out) :: stock_values !< The integrated amounts of a tracer + !! on the current PE, usually in kg x concentration. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a !! previous call to !! call_tracer_register. - character(len=*), dimension(:), optional, & - intent(out) :: stock_names !< Diagnostic names to use for each - !! stock. - character(len=*), dimension(:), optional, & - intent(out) :: stock_units !< Units to use in the metadata for - !! each stock. - integer, optional, & - intent(out) :: num_stocks !< The number of tracer stocks being - !! returned. - integer, optional, & - intent(in) :: stock_index !< The integer stock index from - !! stocks_constans_mod of the stock to be returned. If this is + character(len=*), dimension(:), & + optional, intent(out) :: stock_names !< Diagnostic names to use for each stock. + character(len=*), dimension(:), & + optional, intent(out) :: stock_units !< Units to use in the metadata for each stock. + integer, optional, intent(out) :: num_stocks !< The number of tracer stocks being returned. + integer, optional, intent(in) :: stock_index !< The integer stock index from + !! stocks_constants_mod of the stock to be returned. If this is !! present and greater than 0, only a single stock can be returned. - logical, dimension(:), optional, & - intent(inout) :: got_min_max - real, dimension(:), optional, & - intent(out) :: global_min, global_max - real, dimension(:), optional, & - intent(out) :: xgmin, ygmin, zgmin, xgmax, ygmax, zgmax + logical, dimension(:), & + optional, intent(inout) :: got_min_max !< Indicates whether the global min and + !! max are found for each tracer + real, dimension(:), optional, intent(out) :: global_min !< The global minimum of each tracer + real, dimension(:), optional, intent(out) :: global_max !< The global maximum of each tracer + real, dimension(:), optional, intent(out) :: xgmin !< The x-position of the global minimum + real, dimension(:), optional, intent(out) :: ygmin !< The y-position of the global minimum + real, dimension(:), optional, intent(out) :: zgmin !< The z-position of the global minimum + real, dimension(:), optional, intent(out) :: xgmax !< The x-position of the global maximum + real, dimension(:), optional, intent(out) :: ygmax !< The y-position of the global maximum + real, dimension(:), optional, intent(out) :: zgmax !< The z-position of the global maximum ! This subroutine calls all registered tracer packages to enable them to ! add to the surface state returned to the coupler. These routines are optional. @@ -707,8 +707,9 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni call store_stocks("MOM_generic_tracer", ns, names, units, values, index, stock_values, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) nn=ns_tot-ns+1 - nn=MOM_generic_tracer_min_max(nn, got_min_max, global_min, global_max, xgmin, ygmin, zgmin, xgmax, ygmax, zgmax ,& - G, CS%MOM_generic_tracer_CSp,names, units) + nn=MOM_generic_tracer_min_max(nn, got_min_max, global_min, global_max, & + xgmin, ygmin, zgmin, xgmax, ygmax, zgmax ,& + G, CS%MOM_generic_tracer_CSp,names, units) endif #endif @@ -735,16 +736,26 @@ end subroutine call_tracer_stocks !> This routine stores the stocks and does error handling for call_tracer_stocks. subroutine store_stocks(pkg_name, ns, names, units, values, index, stock_values, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) - character(len=*), intent(in) :: pkg_name - integer, intent(in) :: ns - character(len=*), dimension(:), intent(in) :: names, units - real, dimension(:), intent(in) :: values - integer, intent(in) :: index - real, dimension(:), intent(inout) :: stock_values - character(len=*), intent(inout) :: set_pkg_name - integer, intent(in) :: max_ns - integer, intent(inout) :: ns_tot - character(len=*), dimension(:), optional, intent(inout) :: stock_names, stock_units + character(len=*), intent(in) :: pkg_name !< The tracer package name + integer, intent(in) :: ns !< The number of stocks associated with this tracer package + character(len=*), dimension(:), & + intent(in) :: names !< Diagnostic names to use for each stock. + character(len=*), dimension(:), & + intent(in) :: units !< Units to use in the metadata for each stock. + real, dimension(:), intent(in) :: values !< The values of the tracer stocks + integer, intent(in) :: index !< The integer stock index from + !! stocks_constants_mod of the stock to be returned. If this is + !! present and greater than 0, only a single stock can be returned. + real, dimension(:), intent(inout) :: stock_values !< The master list of stock values + character(len=*), intent(inout) :: set_pkg_name !< The name of the last tracer package whose + !! stocks were stored for a specific index. This is + !! used to trigger an error if there are redundant stocks. + integer, intent(in) :: max_ns !< The maximum size of the master stock list + integer, intent(inout) :: ns_tot !< The total number of stocks in the master list + character(len=*), dimension(:), & + optional, intent(inout) :: stock_names !< Diagnostic names to use for each stock in the master list + character(len=*), dimension(:), & + optional, intent(inout) :: stock_units !< Units to use in the metadata for each stock in the master list ! This routine stores the stocks and does error handling for call_tracer_stocks. character(len=16) :: ind_text, ns_text, max_text @@ -830,7 +841,8 @@ subroutine call_tracer_surface_state(state, h, G, CS) end subroutine call_tracer_surface_state subroutine tracer_flow_control_end(CS) - type(tracer_flow_control_CS), pointer :: CS + type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a + !! previous call to call_tracer_register. if (CS%use_USER_tracer_example) & call USER_tracer_example_end(CS%USER_tracer_example_CSp) From 1b2751e32c53cdcd5ccec3a8b1f9440341c8ad61 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 18:22:01 -0400 Subject: [PATCH 0236/1072] dOxyGenized MOM tracer utility codes Added dOxyGen comments for many arguments in the tracer utility codes, including MOM_neutral_diffusion.F90, MOM_neutral_diffusion_aux.F90, MOM_tracer_advect.F90, MOM_tracer_hor_diff.F90, and MOM_tracer_diabatic.F90. All answers are bitwise identical. --- src/tracer/MOM_neutral_diffusion.F90 | 21 +++++---- src/tracer/MOM_neutral_diffusion_aux.F90 | 2 +- src/tracer/MOM_tracer_advect.F90 | 58 ++++++++++++++++-------- src/tracer/MOM_tracer_diabatic.F90 | 13 ++++-- src/tracer/MOM_tracer_hor_diff.F90 | 2 +- 5 files changed, 60 insertions(+), 36 deletions(-) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 00e97deb8a..65679fe2a6 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -1319,7 +1319,8 @@ subroutine neutral_surface_flux(nk, nsurf, deg, hl, hr, Tl, Tr, PiL, PiR, KoL, K real, intent(in) :: h_neglect !< A negligibly small width for the !! purpose of cell reconstructions !! in the same units as h0. - type(remapping_CS), optional, intent(in) :: remap_CS + type(remapping_CS), optional, intent(in) :: remap_CS !< Remapping control structure used + !! to create sublayers real, optional, intent(in) :: h_neglect_edge !< A negligibly small width !! for the purpose of edge value calculations !! in the same units as h0. @@ -1503,7 +1504,7 @@ end subroutine ppm_left_right_edge_values !> Returns true if unit tests of neutral_diffusion functions fail. Otherwise returns false. logical function neutral_diffusion_unit_tests(verbose) - logical, intent(in) :: verbose + logical, intent(in) :: verbose !< If true, write results to stdout neutral_diffusion_unit_tests = .false. .or. & ndiff_unit_tests_continuous(verbose) .or. ndiff_unit_tests_discontinuous(verbose) @@ -1513,7 +1514,7 @@ end function neutral_diffusion_unit_tests !> Returns true if unit tests of neutral_diffusion functions fail. Otherwise returns false. logical function ndiff_unit_tests_continuous(verbose) - logical, intent(in) :: verbose !< It true, write results to stdout + logical, intent(in) :: verbose !< If true, write results to stdout ! Local variables integer, parameter :: nk = 4 real, dimension(nk+1) :: TiL, TiR1, TiR2, TiR4, Tio ! Test interface temperatures @@ -1790,9 +1791,9 @@ logical function ndiff_unit_tests_discontinuous(verbose) integer, dimension(ns) :: KoL, KoR real, dimension(ns) :: PoL, PoR real, dimension(ns-1) :: hEff, Flx - type(neutral_diffusion_CS) :: CS - type(EOS_type), pointer :: EOS ! Structure for linear equation of state - type(remapping_CS), pointer :: remap_CS ! Remapping control structure (PLM) + type(neutral_diffusion_CS) :: CS !< Neutral diffusion control structure + type(EOS_type), pointer :: EOS !< Structure for linear equation of state + type(remapping_CS), pointer :: remap_CS !< Remapping control structure (PLM) real, dimension(nk,2) :: poly_T_l, poly_T_r, poly_S, poly_slope ! Linear reconstruction for T real, dimension(nk,2) :: dRdT, dRdS logical, dimension(nk) :: stable_l, stable_r @@ -2222,9 +2223,9 @@ end function compare_nsp_row !> Compares output position from refine_nondim_position with an expected value logical function test_rnp(expected_pos, test_pos, title) - real, intent(in) :: expected_pos - real, intent(in) :: test_pos - character(len=*), intent(in) :: title + real, intent(in) :: expected_pos !< The expected position + real, intent(in) :: test_pos !< The position returned by the code + character(len=*), intent(in) :: title !< A label for this test ! Local variables integer :: stdunit = 6 ! Output to standard error test_rnp = expected_pos /= test_pos @@ -2236,7 +2237,7 @@ logical function test_rnp(expected_pos, test_pos, title) end function test_rnp !> Deallocates neutral_diffusion control structure subroutine neutral_diffusion_end(CS) - type(neutral_diffusion_CS), pointer :: CS + type(neutral_diffusion_CS), pointer :: CS !< Neutral diffusion control structure if (associated(CS)) deallocate(CS) diff --git a/src/tracer/MOM_neutral_diffusion_aux.F90 b/src/tracer/MOM_neutral_diffusion_aux.F90 index 94ffe5234c..2cc91606ff 100644 --- a/src/tracer/MOM_neutral_diffusion_aux.F90 +++ b/src/tracer/MOM_neutral_diffusion_aux.F90 @@ -174,7 +174,7 @@ subroutine drho_at_pos(CS, T_ref, S_ref, alpha_ref, beta_ref, P_top, P_bot, ppol real, dimension(CS%nterm), intent(in) :: ppoly_T !< Coefficients of T reconstruction real, dimension(CS%nterm), intent(in) :: ppoly_S !< Coefficients of S reconstruciton real, intent(in) :: x0 !< Nondimensional position to evaluate - real, intent(out) :: delta_rho + real, intent(out) :: delta_rho !< The density difference from a reference value real, optional, intent(out) :: P_out !< Pressure at point x0 real, optional, intent(out) :: T_out !< Temperature at point x0 real, optional, intent(out) :: S_out !< Salinity at point x0 diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 5c0bb7fd42..4d2bcd70f6 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -324,16 +324,26 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & is, ie, js, je, k, G, GV, usePPM, useHuynh) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(tracer_type), dimension(ntr), intent(inout) :: Tr - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hprev + type(tracer_type), dimension(ntr), intent(inout) :: Tr !< The array of registered tracers to work on + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hprev !< cell volume at the end of previous + !! tracer change, in H m2 (m3 or kg) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhr !< accumulated volume/mass flux through - !!the zonal face (m3 or kg) - real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: uh_neglect - type(ocean_OBC_type), pointer :: OBC - logical, dimension(SZJ_(G),SZK_(G)), intent(inout) :: domore_u - real, intent(in) :: Idt - integer, intent(in) :: ntr, is, ie, js, je,k - logical, intent(in) :: usePPM, useHuynh + !! the zonal face, in H m2 (m3 or kg) + real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: uh_neglect !< A tiny zonal mass flux that can + !! be neglected, in H m2 (m3 or kg) + type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used + logical, dimension(SZJ_(G),SZK_(G)), intent(inout) :: domore_u !< If true, there is more advection to be + !! done in this u-row + real, intent(in) :: Idt !< The inverse of dt, in s-1 + integer, intent(in) :: ntr !< The number of tracers + integer, intent(in) :: is !< The starting tracer i-index to work on + integer, intent(in) :: ie !< The ending tracer i-index to work on + integer, intent(in) :: js !< The starting tracer j-index to work on + integer, intent(in) :: je !< The ending tracer j-index to work on + integer, intent(in) :: k !< The k-level to work on + logical, intent(in) :: usePPM !< If true, use PPM instead of PLM + logical, intent(in) :: useHuynh !< If true, use the Huynh scheme + !! for PPM interface values real, dimension(SZI_(G),ntr) :: & slope_x ! The concentration slope per grid point in units of @@ -645,16 +655,26 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & is, ie, js, je, k, G, GV, usePPM, useHuynh) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(tracer_type), dimension(ntr), intent(inout) :: Tr - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hprev + type(tracer_type), dimension(ntr), intent(inout) :: Tr !< The array of registered tracers to work on + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hprev !< cell volume at the end of previous + !! tracer change, in H m2 (m3 or kg) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhr !< accumulated volume/mass flux through - !! the meridional face (m3 or kg) - real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vh_neglect - type(ocean_OBC_type), pointer :: OBC - logical, dimension(SZJB_(G),SZK_(G)), intent(inout) :: domore_v - real, intent(in) :: Idt - integer, intent(in) :: ntr, is, ie, js, je,k - logical, intent(in) :: usePPM, useHuynh + !! the meridional face, in H m2 (m3 or kg) + real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vh_neglect !< A tiny meridional mass flux that can + !! be neglected, in H m2 (m3 or kg) + type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used + logical, dimension(SZJB_(G),SZK_(G)), intent(inout) :: domore_v !< If true, there is more advection to be + !! done in this v-row + real, intent(in) :: Idt !< The inverse of dt, in s-1 + integer, intent(in) :: ntr !< The number of tracers + integer, intent(in) :: is !< The starting tracer i-index to work on + integer, intent(in) :: ie !< The ending tracer i-index to work on + integer, intent(in) :: js !< The starting tracer j-index to work on + integer, intent(in) :: je !< The ending tracer j-index to work on + integer, intent(in) :: k !< The k-level to work on + logical, intent(in) :: usePPM !< If true, use PPM instead of PLM + logical, intent(in) :: useHuynh !< If true, use the Huynh scheme + !! for PPM interface values real, dimension(SZI_(G),ntr,SZJ_(G)) :: & slope_y ! The concentration slope per grid point in units of @@ -1029,7 +1049,7 @@ end subroutine tracer_advect_init !> Close the tracer advection module subroutine tracer_advect_end(CS) - type(tracer_advect_CS), pointer :: CS + type(tracer_advect_CS), pointer :: CS !< module control structure if (associated(CS)) deallocate(CS) diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index 7f9b975863..0bdd327033 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -230,14 +230,17 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim real, intent(in ) :: dt !< Time-step over which forcing is applied (s) type(forcing), intent(in ) :: fluxes !< Surface fluxes container real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness in H units - real, intent(in ) :: evap_CFL_limit - real, intent(in ) :: minimum_forcing_depth + real, intent(in ) :: evap_CFL_limit !< Limit on the fraction of the + !! water that can be fluxed out of the top + !! layer in a timestep (nondim) + real, intent(in ) :: minimum_forcing_depth !< The smallest depth over + !! which fluxes can be applied, in m real, dimension(SZI_(G),SZJ_(G)), optional, intent(in ) :: in_flux_optional !< The total time-integrated !! amount of tracer that enters with freshwater - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: out_flux_optional ! The total time-integrated + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: out_flux_optional !< The total time-integrated !! amount of tracer that leaves with freshwater - !< Optional flag to determine whether h should be updated - logical, optional, intent(in) :: update_h_opt + logical, optional, intent(in) :: update_h_opt !< Optional flag to determine whether + !! h should be updated integer, parameter :: maxGroundings = 5 integer :: numberOfGroundings, iGround(maxGroundings), jGround(maxGroundings) diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 0edc123d26..bdadb4e4e0 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -1478,7 +1478,7 @@ subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS) end subroutine tracer_hor_diff_init subroutine tracer_hor_diff_end(CS) - type(tracer_hor_diff_CS), pointer :: CS + type(tracer_hor_diff_CS), pointer :: CS !< module control structure call neutral_diffusion_end(CS%neutral_diffusion_CSp) if (associated(CS)) deallocate(CS) From 345d40f52a0e6169da2e9772cfb2adb3944a78e3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 8 May 2018 18:22:56 -0400 Subject: [PATCH 0237/1072] dOxyGenized MOM tracer packages Added dOxyGen comments for many arguments in the tracer packages in src/tracer. All answers are bitwise identical. --- src/tracer/DOME_tracer.F90 | 45 ++++++----- src/tracer/ISOMIP_tracer.F90 | 37 ++++++--- src/tracer/MOM_OCMIP2_CFC.F90 | 55 ++++++------- src/tracer/MOM_generic_tracer.F90 | 10 ++- src/tracer/advection_test_tracer.F90 | 81 ++++++++++++------- src/tracer/boundary_impulse_tracer.F90 | 103 ++++++++++++++++--------- src/tracer/dye_example.F90 | 45 ++++++----- src/tracer/dyed_obc_tracer.F90 | 47 ++++++----- src/tracer/ideal_age_example.F90 | 85 +++++++++++++------- src/tracer/oil_tracer.F90 | 83 +++++++++++++------- src/tracer/pseudo_salt_tracer.F90 | 89 ++++++++++++++------- src/tracer/tracer_example.F90 | 61 ++++++++------- 12 files changed, 467 insertions(+), 274 deletions(-) diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index d8f6b9a972..9c4536a013 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -285,25 +285,29 @@ end subroutine initialize_DOME_tracer !! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] subroutine DOME_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & evap_CFL_limit, minimum_forcing_depth) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old !< Layer thickness before entrainment, - !! in m or kg m-2. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_new !< Layer thickness after entrainment, - !! in m or kg m-2. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: ea !< an array to which the amount of - !! fluid entrained from the layer above during this - !! call will be added, in m or kg m-2. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: eb !< an array to which the amount of - !! fluid entrained from the layer below during this - !! call will be added, in m or kg m-2. - type(forcing), intent(in) :: fluxes !< A structure containing pointers to - !! any possible forcing fields. Unused fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call, in s - type(DOME_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to DOME_register_tracer. - real, optional,intent(in) :: evap_CFL_limit - real, optional,intent(in) :: minimum_forcing_depth + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: ea !< an array to which the amount of fluid entrained + !! from the layer above during this call will be + !! added, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: eb !< an array to which the amount of fluid entrained + !! from the layer below during this call will be + !! added, in m or kg m-2. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic + !! and tracer forcing fields. Unused fields have NULL ptrs. + real, intent(in) :: dt !< The amount of time covered by this call, in s + type(DOME_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to DOME_register_tracer. + real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can + !! be fluxed out of the top layer in a timestep (nondim) + real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which + !! fluxes can be applied, in m ! Local variables real :: b1(SZI_(G)) ! b1 and c1 are variables used by the @@ -366,7 +370,8 @@ end subroutine DOME_tracer_surface_state !> Clean up memory allocations, if any. subroutine DOME_tracer_end(CS) - type(DOME_tracer_CS), pointer :: CS + type(DOME_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to DOME_register_tracer. integer :: m if (associated(CS)) then diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index f3fa46210f..f867c26764 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -165,7 +165,8 @@ subroutine initialize_ISOMIP_tracer(restart, day, G, GV, h, diag, OBC, CS, & !! been read from a restart file. type(time_type), target, intent(in) :: day !< Time of the start of the run. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. - type(diag_ctrl), target, intent(in) :: diag + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate + !! diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary conditions !! are used. This is not being used for now. @@ -263,14 +264,29 @@ end subroutine initialize_ISOMIP_tracer ! This is a simple example of a set of advected passive tracers. subroutine ISOMIP_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & evap_CFL_limit, minimum_forcing_depth) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old, h_new, ea, eb - type(forcing), intent(in) :: fluxes - real, intent(in) :: dt !< The amount of time covered by this call, in s - type(ISOMIP_tracer_CS), pointer :: CS - real, optional,intent(in) :: evap_CFL_limit - real, optional,intent(in) :: minimum_forcing_depth + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: ea !< an array to which the amount of fluid entrained + !! from the layer above during this call will be + !! added, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: eb !< an array to which the amount of fluid entrained + !! from the layer below during this call will be + !! added, in m or kg m-2. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic + !! and tracer forcing fields. Unused fields have NULL ptrs. + real, intent(in) :: dt !< The amount of time covered by this call, in s + type(ISOMIP_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to ISOMIP_register_tracer. + real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can + !! be fluxed out of the top layer in a timestep (nondim) + real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which + !! fluxes can be applied, in m ! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2. ! (in) h_new - Layer thickness after entrainment, in m or kg m-2. @@ -371,7 +387,8 @@ subroutine ISOMIP_tracer_surface_state(state, h, G, CS) end subroutine ISOMIP_tracer_surface_state subroutine ISOMIP_tracer_end(CS) - type(ISOMIP_tracer_CS), pointer :: CS + type(ISOMIP_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to ISOMIP_register_tracer. integer :: m if (associated(CS)) then diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index fcb55382c4..11531dcb62 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -351,7 +351,7 @@ subroutine flux_init_OCMIP2_CFC(CS, verbosity) end subroutine flux_init_OCMIP2_CFC -!>This subroutine initializes the NTR tracer fields in tr(:,:,:,:) +!> This subroutine initializes the NTR tracer fields in tr(:,:,:,:) !! and it sets up the tracer output. subroutine initialize_OCMIP2_CFC(restart, day, G, GV, h, diag, OBC, CS, & sponge_CSp, diag_to_Z_CSp) @@ -420,10 +420,12 @@ end subroutine initialize_OCMIP2_CFC subroutine init_tracer_CFC(h, tr, name, land_val, IC_val, G, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: tr - character(len=*), intent(in) :: name - real, intent(in) :: land_val, IC_val - type(OCMIP2_CFC_CS), pointer :: CS + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: tr !< The tracer concentration array + character(len=*), intent(in) :: name !< The tracer name + real, intent(in) :: land_val !< A value the tracer takes over land + real, intent(in) :: IC_val !< The initial condition value for the tracer + type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a + !! previous call to register_OCMIP2_CFC. ! This subroutine initializes a tracer array. @@ -464,31 +466,29 @@ end subroutine init_tracer_CFC ! flux as a source. subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & evap_CFL_limit, minimum_forcing_depth) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_old !< Layer thickness before entrainment, - !! in m or kg m-2. + intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_new !< Layer thickness after entrainment, - !! in m or kg m-2. + intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: ea !< an array to which the amount of fluid - !! entrained from the layer above during - !! this call will be added, in m or kg m-2. + intent(in) :: ea !< an array to which the amount of fluid entrained + !! from the layer above during this call will be + !! added, in m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: eb !< an array to which the amount of fluid - !! entrained from the layer below during - !! this call will be added, in m or kg m-2. - type(forcing), intent(in) :: fluxes !< A structure containing pointers to any - !! possible forcing fields. Unused fields - !! have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this - !! call, in s - type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a - !! previous call to register_OCMIP2_CFC. - real, optional,intent(in) :: evap_CFL_limit - real, optional,intent(in) :: minimum_forcing_depth + intent(in) :: eb !< an array to which the amount of fluid entrained + !! from the layer below during this call will be + !! added, in m or kg m-2. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic + !! and tracer forcing fields. Unused fields have NULL ptrs. + real, intent(in) :: dt !< The amount of time covered by this call, in s + type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a + !! previous call to register_OCMIP2_CFC. + real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can + !! be fluxed out of the top layer in a timestep (nondim) + real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which + !! fluxes can be applied, in m ! This subroutine applies diapycnal diffusion and any other column ! tracer physics or chemistry to the tracers from this file. ! CFCs are relatively simple, as they are passive tracers. with only a surface @@ -701,7 +701,8 @@ subroutine OCMIP2_CFC_surface_state(state, h, G, CS) end subroutine OCMIP2_CFC_surface_state subroutine OCMIP2_CFC_end(CS) - type(OCMIP2_CFC_CS), pointer :: CS + type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a + !! previous call to register_OCMIP2_CFC. ! This subroutine deallocates the memory owned by this module. ! Argument: CS - The control structure returned by a previous call to ! register_OCMIP2_CFC. diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 91d96bcc65..7b7fe8e5a2 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -662,12 +662,18 @@ function MOM_generic_tracer_min_max(ind_start, got_minmax, gmin, gmax, xgmin, yg xgmax, ygmax, zgmax , G, CS, names, units) use mpp_utilities_mod, only: mpp_array_global_min_max integer, intent(in) :: ind_start - logical, dimension(:), intent(out) :: got_minmax + logical, dimension(:), intent(out) :: got_minmax !< Indicates whether the global min and + !! max are found for each tracer real, dimension(:), intent(out) :: gmin !< Global minimum of each tracer, in kg !! times concentration units. real, dimension(:), intent(out) :: gmax !< Global maximum of each tracer, in kg !! times concentration units. - real, dimension(:), intent(out) :: xgmin, ygmin, zgmin, xgmax, ygmax, zgmax + real, dimension(:), intent(out) :: xgmin !< The x-position of the global minimum + real, dimension(:), intent(out) :: ygmin !< The y-position of the global minimum + real, dimension(:), intent(out) :: zgmin !< The z-position of the global minimum + real, dimension(:), intent(out) :: xgmax !< The x-position of the global maximum + real, dimension(:), intent(out) :: ygmax !< The y-position of the global maximum + real, dimension(:), intent(out) :: zgmax !< The z-position of the global maximum type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 7fb6ff8028..58c8955234 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -98,12 +98,15 @@ module advection_test_tracer contains function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in) :: HI + type(hor_index_type), intent(in) :: HI !< A horizontal index type structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(advection_test_tracer_CS), pointer :: CS - type(tracer_registry_type), pointer :: tr_Reg - type(MOM_restart_CS), pointer :: restart_CS + type(advection_test_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_advection_test_tracer. + type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control + !! structure for the tracer advection and + !! diffusion module + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure ! This subroutine is used to register tracer fields and subroutines ! to be used with MOM. ! Arguments: HI - A horizontal index type structure. @@ -203,16 +206,23 @@ end function register_advection_test_tracer subroutine initialize_advection_test_tracer(restart, day, G, GV, h,diag, OBC, CS, & sponge_CSp, diag_to_Z_CSp) - logical, intent(in) :: restart - type(time_type), target, intent(in) :: day + logical, intent(in) :: restart !< .true. if the fields have already + !! been read from a restart file. + type(time_type), target, intent(in) :: day !< Time of the start of the run. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(diag_ctrl), target, intent(in) :: diag - type(ocean_OBC_type), pointer :: OBC - type(advection_test_tracer_CS), pointer :: CS - type(sponge_CS), pointer :: sponge_CSp - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate + !! diagnostic output. + type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies + !! whether, where, and what open boundary + !! conditions are used. + type(advection_test_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_advection_test_tracer. + type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges. + type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure + !! for diagnostics in depth space. ! This subroutine initializes the NTR tracer fields in tr(:,:,:,:) ! and it sets up the tracer output. @@ -307,14 +317,29 @@ end subroutine initialize_advection_test_tracer subroutine advection_test_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & evap_CFL_limit, minimum_forcing_depth) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old, h_new, ea, eb - type(forcing), intent(in) :: fluxes - real, intent(in) :: dt !< The amount of time covered by this call, in s - type(advection_test_tracer_CS), pointer :: CS - real, optional,intent(in) :: evap_CFL_limit - real, optional,intent(in) :: minimum_forcing_depth + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: ea !< an array to which the amount of fluid entrained + !! from the layer above during this call will be + !! added, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: eb !< an array to which the amount of fluid entrained + !! from the layer below during this call will be + !! added, in m or kg m-2. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic + !! and tracer forcing fields. Unused fields have NULL ptrs. + real, intent(in) :: dt !< The amount of time covered by this call, in s + type(advection_test_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_advection_test_tracer. + real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can + !! be fluxed out of the top layer in a timestep (nondim) + real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which + !! fluxes can be applied, in m ! This subroutine applies diapycnal diffusion and any other column ! tracer physics or chemistry to the tracers from this file. ! This is a simple example of a set of advected passive tracers. @@ -398,12 +423,15 @@ end subroutine advection_test_tracer_surface_state function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(:), intent(out) :: stocks + real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each + !! tracer, in kg times concentration units. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(advection_test_tracer_CS), pointer :: CS - character(len=*), dimension(:), intent(out) :: names - character(len=*), dimension(:), intent(out) :: units - integer, optional, intent(in) :: stock_index + type(advection_test_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_advection_test_tracer. + character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. + character(len=*), dimension(:), intent(out) :: units !< the units of the stocks calculated. + integer, optional, intent(in) :: stock_index !< the coded index of a specific stock + !! being sought. integer :: advection_test_stock ! This function calculates the mass-weighted integral of all tracer stocks, ! returning the number of stocks it has calculated. If the stock_index @@ -449,7 +477,8 @@ function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index) end function advection_test_stock subroutine advection_test_tracer_end(CS) - type(advection_test_tracer_CS), pointer :: CS + type(advection_test_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_advection_test_tracer. integer :: m if (associated(CS)) then diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index f320bb5716..6cfa91049f 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -67,12 +67,15 @@ module boundary_impulse_tracer !> Read in runtime options and add boundary impulse tracer to tracer registry function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in ) :: HI + type(hor_index_type), intent(in ) :: HI !< A horizontal index type structure type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in ) :: param_file !< A structure to parse for run-time parameters - type(boundary_impulse_tracer_CS), pointer :: CS - type(tracer_registry_type), pointer :: tr_Reg - type(MOM_restart_CS), pointer :: restart_CS + type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_boundary_impulse_tracer. + type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control + !! structure for the tracer advection and + !! diffusion module + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure ! This subroutine is used to register tracer fields and subroutines ! to be used with MOM. ! Arguments: HI - A horizontal index type structure. @@ -160,18 +163,25 @@ end function register_boundary_impulse_tracer !> Initialize tracer from restart or set to 1 at surface to initialize subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, CS, & sponge_CSp, diag_to_Z_CSp, tv) - logical, intent(in ) :: restart - type(time_type), target, intent(in ) :: day - type(ocean_grid_type), intent(in ) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(diag_ctrl), target, intent(in ) :: diag - type(ocean_OBC_type), pointer, intent(inout) :: OBC - type(boundary_impulse_tracer_CS), pointer,intent(inout) :: CS - type(sponge_CS), pointer, intent(inout) :: sponge_CSp - type(diag_to_Z_CS), pointer, intent(inout) :: diag_to_Z_CSp - type(thermo_var_ptrs), intent(in ) :: tv !< A structure pointing to various - !! thermodynamic variables + logical, intent(in) :: restart !< .true. if the fields have already + !! been read from a restart file. + type(time_type), target, intent(in) :: day !< Time of the start of the run. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate + !! diagnostic output. + type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies + !! whether, where, and what open boundary + !! conditions are used. + type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_boundary_impulse_tracer. + type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges. + type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure + !! for diagnostics in depth space. + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables ! This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:) ! and it sets up the tracer output. @@ -226,19 +236,34 @@ subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, end subroutine initialize_boundary_impulse_tracer ! Apply source or sink at boundary and do vertical diffusion -subroutine boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, tv, debug, & - evap_CFL_limit, minimum_forcing_depth) - type(ocean_grid_type), intent(in ) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: h_old, h_new, ea, eb - type(forcing), intent(in ) :: fluxes - real, intent(in ) :: dt !< The amount of time covered by this call, in s - type(boundary_impulse_tracer_CS), pointer :: CS - type(thermo_var_ptrs), intent(in ) :: tv !< A structure pointing to various - !! thermodynamic variables - logical, intent(in ) :: debug - real, optional, intent(in ) :: evap_CFL_limit - real, optional, intent(in ) :: minimum_forcing_depth +subroutine boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & + tv, debug, evap_CFL_limit, minimum_forcing_depth) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: ea !< an array to which the amount of fluid entrained + !! from the layer above during this call will be + !! added, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: eb !< an array to which the amount of fluid entrained + !! from the layer below during this call will be + !! added, in m or kg m-2. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic + !! and tracer forcing fields. Unused fields have NULL ptrs. + real, intent(in) :: dt !< The amount of time covered by this call, in s + type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_boundary_impulse_tracer. + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables + logical, intent(in) :: debug !< If true calculate checksums + real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can + !! be fluxed out of the top layer in a timestep (nondim) + real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which + !! fluxes can be applied, in m ! This subroutine applies diapycnal diffusion and any other column ! tracer physics or chemistry to the tracers from this file. @@ -314,11 +339,16 @@ function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in ) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(:), intent( out) :: stocks - type(boundary_impulse_tracer_CS), pointer, intent(in ) :: CS - character(len=*), dimension(:), intent( out) :: names - character(len=*), dimension(:), intent( out) :: units - integer, optional, intent(in ) :: stock_index + real, dimension(:), intent( out) :: stocks !< the mass-weighted integrated amount of each + !! tracer, in kg times concentration units. + type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_boundary_impulse_tracer. + character(len=*), dimension(:), intent( out) :: names !< The names of the stocks calculated. + character(len=*), dimension(:), intent( out) :: units !< The units of the stocks calculated. + integer, optional, intent(in ) :: stock_index !< The coded index of a specific stock + !! being sought. + integer :: boundary_impulse_stock !< Return value: the number of stocks calculated here. + ! This function calculates the mass-weighted integral of all tracer stocks, ! returning the number of stocks it has calculated. If the stock_index ! is present, only the stock corresponding to that coded index is returned. @@ -334,7 +364,7 @@ function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index) ! (out) units - the units of the stocks calculated. ! (in,opt) stock_index - the coded index of a specific stock being sought. ! Return value: the number of stocks calculated here. - integer :: boundary_impulse_stock + integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -399,7 +429,8 @@ end subroutine boundary_impulse_tracer_surface_state ! Performs finalization of boundary impulse tracer subroutine boundary_impulse_tracer_end(CS) - type(boundary_impulse_tracer_CS), pointer :: CS + type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_boundary_impulse_tracer. integer :: m if (associated(CS)) then diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 68fbd3fdd0..871b7cdc58 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -245,25 +245,29 @@ end subroutine initialize_dye_tracer !! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & evap_CFL_limit, minimum_forcing_depth) - real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h_old !< Layer thickness before entrainment, - !! in m or kg m-2. - real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h_new !< Layer thickness after entrainment, - !! in m or kg m-2. - real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: ea !< an array to which the amount of - !! fluid entrained from the layer above during this - !! call will be added, in m or kg m-2. - real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: eb !< an array to which the amount of - !! fluid entrained from the layer below during this - !! call will be added, in m or kg m-2. - type(forcing), intent(in) :: fluxes !< A structure containing pointers to - !! any possible forcing fields. Unused fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call, in s - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(dye_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to register_dye_tracer. - real, optional,intent(in) :: evap_CFL_limit - real, optional,intent(in) :: minimum_forcing_depth + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: ea !< an array to which the amount of fluid entrained + !! from the layer above during this call will be + !! added, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: eb !< an array to which the amount of fluid entrained + !! from the layer below during this call will be + !! added, in m or kg m-2. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic + !! and tracer forcing fields. Unused fields have NULL ptrs. + real, intent(in) :: dt !< The amount of time covered by this call, in s + type(dye_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_dye_tracer. + real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can + !! be fluxed out of the top layer in a timestep (nondim) + real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which + !! fluxes can be applied, in m ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified @@ -399,7 +403,8 @@ end subroutine dye_tracer_surface_state !> Clean up any allocated memory after the run. subroutine regional_dyes_end(CS) - type(dye_tracer_CS), pointer :: CS + type(dye_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_dye_tracer. integer :: m if (associated(CS)) then diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index e65dcdfcf4..10d3d5108b 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -209,25 +209,29 @@ end subroutine initialize_dyed_obc_tracer !! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] subroutine dyed_obc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & evap_CFL_limit, minimum_forcing_depth) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old !< Layer thickness before entrainment, - !! in m or kg m-2. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_new !< Layer thickness after entrainment, - !! in m or kg m-2. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: ea !< an array to which the amount of - !! fluid entrained from the layer above during this - !! call will be added, in m or kg m-2. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: eb !< an array to which the amount of - !! fluid entrained from the layer below during this - !! call will be added, in m or kg m-2. - type(forcing), intent(in) :: fluxes !< A structure containing pointers to - !! any possible forcing fields. Unused fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call, in s - type(dyed_obc_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to dyed_obc_register_tracer. - real, optional,intent(in) :: evap_CFL_limit - real, optional,intent(in) :: minimum_forcing_depth + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: ea !< an array to which the amount of fluid entrained + !! from the layer above during this call will be + !! added, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: eb !< an array to which the amount of fluid entrained + !! from the layer below during this call will be + !! added, in m or kg m-2. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic + !! and tracer forcing fields. Unused fields have NULL ptrs. + real, intent(in) :: dt !< The amount of time covered by this call, in s + type(dyed_obc_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to dyed_obc_register_tracer. + real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can + !! be fluxed out of the top layer in a timestep (nondim) + real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which + !! fluxes can be applied, in m ! Local variables real :: b1(SZI_(G)) ! b1 and c1 are variables used by the @@ -258,7 +262,8 @@ end subroutine dyed_obc_tracer_column_physics !> Clean up memory allocations, if any. subroutine dyed_obc_tracer_end(CS) - type(dyed_obc_tracer_CS), pointer :: CS + type(dyed_obc_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to dyed_obc_register_tracer. integer :: m if (associated(CS)) then @@ -271,7 +276,7 @@ end subroutine dyed_obc_tracer_end !> \namespace dyed_obc_tracer !! * !! By Kate Hedstrom, 2017, copied from DOME tracers and also * -!! dye_example. * +!! dye_example. * !! * !! This file contains an example of the code that is needed to set * !! up and use a set of dynamically passive tracers. These tracers * diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index 0a0ad34b3f..c284a4d452 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -109,12 +109,15 @@ module ideal_age_example contains function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in) :: HI + type(hor_index_type), intent(in) :: HI !< A horizontal index type structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(ideal_age_tracer_CS), pointer :: CS - type(tracer_registry_type), pointer :: tr_Reg - type(MOM_restart_CS), pointer :: restart_CS + type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_ideal_age_tracer. + type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control + !! structure for the tracer advection and + !! diffusion module + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure ! This subroutine is used to register tracer fields and subroutines ! to be used with MOM. ! Arguments: HI - A horizontal index type structure. @@ -239,16 +242,23 @@ end function register_ideal_age_tracer subroutine initialize_ideal_age_tracer(restart, day, G, GV, h, diag, OBC, CS, & sponge_CSp, diag_to_Z_CSp) - logical, intent(in) :: restart - type(time_type), target, intent(in) :: day + logical, intent(in) :: restart !< .true. if the fields have already + !! been read from a restart file. + type(time_type), target, intent(in) :: day !< Time of the start of the run. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(diag_ctrl), target, intent(in) :: diag - type(ocean_OBC_type), pointer :: OBC - type(ideal_age_tracer_CS), pointer :: CS - type(sponge_CS), pointer :: sponge_CSp - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate + !! diagnostic output. + type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies + !! whether, where, and what open boundary + !! conditions are used. + type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_ideal_age_tracer. + type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges. + type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure + !! for diagnostics in depth space. ! This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:) ! and it sets up the tracer output. @@ -333,14 +343,29 @@ end subroutine initialize_ideal_age_tracer subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & evap_CFL_limit, minimum_forcing_depth) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old, h_new, ea, eb - type(forcing), intent(in) :: fluxes - real, intent(in) :: dt !< The amount of time covered by this call, in s - type(ideal_age_tracer_CS), pointer :: CS - real, optional,intent(in) :: evap_CFL_limit - real, optional,intent(in) :: minimum_forcing_depth + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: ea !< an array to which the amount of fluid entrained + !! from the layer above during this call will be + !! added, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: eb !< an array to which the amount of fluid entrained + !! from the layer below during this call will be + !! added, in m or kg m-2. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic + !! and tracer forcing fields. Unused fields have NULL ptrs. + real, intent(in) :: dt !< The amount of time covered by this call, in s + type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_ideal_age_tracer. + real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can + !! be fluxed out of the top layer in a timestep (nondim) + real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which + !! fluxes can be applied, in m ! This subroutine applies diapycnal diffusion and any other column ! tracer physics or chemistry to the tracers from this file. ! This is a simple example of a set of advected passive tracers. @@ -422,13 +447,17 @@ end subroutine ideal_age_tracer_column_physics function ideal_age_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(:), intent(out) :: stocks + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each + !! tracer, in kg times concentration units. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(ideal_age_tracer_CS), pointer :: CS - character(len=*), dimension(:), intent(out) :: names - character(len=*), dimension(:), intent(out) :: units - integer, optional, intent(in) :: stock_index + type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_ideal_age_tracer. + character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. + character(len=*), dimension(:), intent(out) :: units !< the units of the stocks calculated. + integer, optional, intent(in) :: stock_index !< the coded index of a specific stock + !! being sought. integer :: ideal_age_stock ! This function calculates the mass-weighted integral of all tracer stocks, ! returning the number of stocks it has calculated. If the stock_index @@ -508,7 +537,9 @@ subroutine ideal_age_tracer_surface_state(state, h, G, CS) end subroutine ideal_age_tracer_surface_state subroutine ideal_age_example_end(CS) - type(ideal_age_tracer_CS), pointer :: CS + type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_ideal_age_tracer. + integer :: m if (associated(CS)) then diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 36e503e10c..47edfac6e6 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -114,12 +114,15 @@ module oil_tracer contains function register_oil_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in) :: HI + type(hor_index_type), intent(in) :: HI !< A horizontal index type structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(oil_tracer_CS), pointer :: CS - type(tracer_registry_type), pointer :: tr_Reg - type(MOM_restart_CS), pointer :: restart_CS + type(oil_tracer_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module + type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control + !! structure for the tracer advection and + !! diffusion module + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure ! This subroutine is used to register tracer fields and subroutines ! to be used with MOM. ! Arguments: HI - A horizontal index type structure. @@ -247,16 +250,23 @@ end function register_oil_tracer subroutine initialize_oil_tracer(restart, day, G, GV, h, diag, OBC, CS, & sponge_CSp, diag_to_Z_CSp) - logical, intent(in) :: restart - type(time_type), target, intent(in) :: day + logical, intent(in) :: restart !< .true. if the fields have already + !! been read from a restart file. + type(time_type), target, intent(in) :: day !< Time of the start of the run. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(diag_ctrl), target, intent(in) :: diag - type(ocean_OBC_type), pointer :: OBC - type(oil_tracer_CS), pointer :: CS - type(sponge_CS), pointer :: sponge_CSp - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate + !! diagnostic output. + type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies + !! whether, where, and what open boundary + !! conditions are used. + type(oil_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_oil_tracer. + type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges. + type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure + !! for diagnostics in depth space. ! This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:) ! and it sets up the tracer output. @@ -351,15 +361,30 @@ end subroutine initialize_oil_tracer subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, tv, & evap_CFL_limit, minimum_forcing_depth) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old, h_new, ea, eb - type(forcing), intent(in) :: fluxes - real, intent(in) :: dt !< The amount of time covered by this call, in s - type(oil_tracer_CS), pointer :: CS - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - real, optional,intent(in) :: evap_CFL_limit - real, optional,intent(in) :: minimum_forcing_depth + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: ea !< an array to which the amount of fluid entrained + !! from the layer above during this call will be + !! added, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: eb !< an array to which the amount of fluid entrained + !! from the layer below during this call will be + !! added, in m or kg m-2. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic + !! and tracer forcing fields. Unused fields have NULL ptrs. + real, intent(in) :: dt !< The amount of time covered by this call, in s + type(oil_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_oil_tracer. + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables + real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can + !! be fluxed out of the top layer in a timestep (nondim) + real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which + !! fluxes can be applied, in m ! This subroutine applies diapycnal diffusion and any other column ! tracer physics or chemistry to the tracers from this file. ! This is a simple example of a set of advected passive tracers. @@ -462,11 +487,14 @@ function oil_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(:), intent(out) :: stocks - type(oil_tracer_CS), pointer :: CS - character(len=*), dimension(:), intent(out) :: names - character(len=*), dimension(:), intent(out) :: units - integer, optional, intent(in) :: stock_index + real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each + !! tracer, in kg times concentration units. + type(oil_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_oil_tracer. + character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. + character(len=*), dimension(:), intent(out) :: units !< the units of the stocks calculated. + integer, optional, intent(in) :: stock_index !< the coded index of a specific stock + !! being sought. integer :: oil_stock ! This function calculates the mass-weighted integral of all tracer stocks, ! returning the number of stocks it has calculated. If the stock_index @@ -546,7 +574,8 @@ subroutine oil_tracer_surface_state(state, h, G, CS) end subroutine oil_tracer_surface_state subroutine oil_tracer_end(CS) - type(oil_tracer_CS), pointer :: CS + type(oil_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_oil_tracer. integer :: m if (associated(CS)) then diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index 06d490c835..ec13de8df2 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -88,12 +88,15 @@ module pseudo_salt_tracer contains function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in) :: HI + type(hor_index_type), intent(in) :: HI !< A horizontal index type structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(pseudo_salt_tracer_CS), pointer :: CS - type(tracer_registry_type), pointer :: tr_Reg - type(MOM_restart_CS), pointer :: restart_CS + type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_pseudo_salt_tracer. + type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control + !! structure for the tracer advection and + !! diffusion module + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure ! This subroutine is used to register tracer fields and subroutines ! to be used with MOM. ! Arguments: HI - A horizontal index type structure. @@ -149,16 +152,23 @@ end function register_pseudo_salt_tracer subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, & sponge_CSp, diag_to_Z_CSp, tv) - logical, intent(in) :: restart - type(time_type), target, intent(in) :: day + logical, intent(in) :: restart !< .true. if the fields have already + !! been read from a restart file. + type(time_type), target, intent(in) :: day !< Time of the start of the run. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(diag_ctrl), target, intent(in) :: diag - type(ocean_OBC_type), pointer :: OBC - type(pseudo_salt_tracer_CS), pointer :: CS - type(sponge_CS), pointer :: sponge_CSp - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate + !! diagnostic output. + type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies + !! whether, where, and what open boundary + !! conditions are used. + type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_pseudo_salt_tracer. + type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges. + type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure + !! for diagnostics in depth space. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables ! This subroutine initializes the tracer fields in CS%ps(:,:,:). @@ -215,16 +225,31 @@ end subroutine initialize_pseudo_salt_tracer subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, tv, debug, & evap_CFL_limit, minimum_forcing_depth) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old, h_new, ea, eb - type(forcing), intent(in) :: fluxes - real, intent(in) :: dt !< The amount of time covered by this call, in s - type(pseudo_salt_tracer_CS), pointer :: CS - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - logical, intent(in) :: debug - real, optional,intent(in) :: evap_CFL_limit - real, optional,intent(in) :: minimum_forcing_depth + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: ea !< an array to which the amount of fluid entrained + !! from the layer above during this call will be + !! added, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: eb !< an array to which the amount of fluid entrained + !! from the layer below during this call will be + !! added, in m or kg m-2. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic + !! and tracer forcing fields. Unused fields have NULL ptrs. + real, intent(in) :: dt !< The amount of time covered by this call, in s + type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_pseudo_salt_tracer. + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables + logical, intent(in) :: debug !< If true calculate checksums + real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can + !! be fluxed out of the top layer in a timestep (nondim) + real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which + !! fluxes can be applied, in m ! This subroutine applies diapycnal diffusion and any other column ! tracer physics or chemistry to the tracers from this file. @@ -303,12 +328,17 @@ function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(:), intent(out) :: stocks - type(pseudo_salt_tracer_CS), pointer :: CS - character(len=*), dimension(:), intent(out) :: names - character(len=*), dimension(:), intent(out) :: units - integer, optional, intent(in) :: stock_index - integer :: pseudo_salt_stock + real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each + !! tracer, in kg times concentration units. + type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_pseudo_salt_tracer. + character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. + character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated. + integer, optional, intent(in) :: stock_index !< The coded index of a specific stock + !! being sought. + integer :: pseudo_salt_stock !< Return value: the number of + !! stocks calculated here. + ! This function calculates the mass-weighted integral of all tracer stocks, ! returning the number of stocks it has calculated. If the stock_index ! is present, only the stock corresponding to that coded index is returned. @@ -378,7 +408,8 @@ subroutine pseudo_salt_tracer_surface_state(state, h, G, CS) end subroutine pseudo_salt_tracer_surface_state subroutine pseudo_salt_tracer_end(CS) - type(pseudo_salt_tracer_CS), pointer :: CS + type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_pseudo_salt_tracer. integer :: m if (associated(CS)) then diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 7035d72a26..c169ce768e 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -89,15 +89,15 @@ module USER_tracer_example !> This subroutine is used to register tracer fields and subroutines !! to be used with MOM. function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. + type(hor_index_type), intent(in) :: HI !< A horizontal index type structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(USER_tracer_example_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control !! structure for the tracer advection and - !! diffusion module. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + !! diffusion module + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure ! Local variables character(len=80) :: name, longname @@ -174,13 +174,13 @@ end function USER_register_tracer_example subroutine USER_initialize_tracer(restart, day, G, GV, h, diag, OBC, CS, & sponge_CSp, diag_to_Z_CSp) logical, intent(in) :: restart !< .true. if the fields have already - !! been read from a restart file. - type(time_type), target, intent(in) :: day !< Time of the start of the run. + !! been read from a restart file. + type(time_type), target, intent(in) :: day !< Time of the start of the run. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary @@ -298,23 +298,25 @@ end subroutine USER_initialize_tracer !! The arguments to this subroutine are redundant in that !! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] subroutine tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old !< Layer thickness before entrainment, - !! in m or kg m-2. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_new !< Layer thickness after entrainment, - !! in m or kg m-2. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: ea !< an array to which the amount of - !! fluid entrained from the layer above during this - !! call will be added, in m or kg m-2. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: eb !< an array to which the amount of - !! fluid entrained from the layer below during this - !! call will be added, in m or kg m-2. - type(forcing), intent(in) :: fluxes !< A structure containing pointers to - !! any possible forcing fields. Unused fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call, in s - type(USER_tracer_example_CS), pointer :: CS !< The control structure returned by a previous - !! call to USER_register_tracer_example. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: ea !< an array to which the amount of fluid entrained + !! from the layer above during this call will be + !! added, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: eb !< an array to which the amount of fluid entrained + !! from the layer below during this call will be + !! added, in m or kg m-2. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic + !! and tracer forcing fields. Unused fields have NULL ptrs. + real, intent(in) :: dt !< The amount of time covered by this call, in s + type(USER_tracer_example_CS), pointer :: CS !< The control structure returned by a previous + !! call to USER_register_tracer_example. ! Local variables real :: hold0(SZI_(G)) ! The original topmost layer thickness, @@ -402,12 +404,12 @@ function USER_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) !! tracer, in kg times concentration units. type(USER_tracer_example_CS), pointer :: CS !< The control structure returned by a !! previous call to register_USER_tracer. - character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. - character(len=*), dimension(:), intent(out) :: units !< the units of the stocks calculated. - integer, optional, intent(in) :: stock_index !< the coded index of a specific stock - !! being sought. + character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. + character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated. + integer, optional, intent(in) :: stock_index !< The coded index of a specific stock + !! being sought. integer :: USER_tracer_stock !< Return value: the number of - !! stocks calculated here. + !! stocks calculated here. ! Local variables integer :: i, j, k, is, ie, js, je, nz, m @@ -471,7 +473,8 @@ end subroutine USER_tracer_surface_state !> Clean up allocated memory at the end. subroutine USER_tracer_example_end(CS) - type(USER_tracer_example_CS), pointer :: CS + type(USER_tracer_example_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_USER_tracer. integer :: m if (associated(CS)) then From 82d9228b2927478463834ecd4b1e48d5ff933fe7 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 8 May 2018 16:33:13 -0600 Subject: [PATCH 0238/1072] rename KPP_compute_OBL as KPP_compute_BLD --- src/parameterizations/vertical/MOM_KPP.F90 | 9 +++++++-- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 6 +++++- 2 files changed, 12 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index a9e9c06f87..83f9788418 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -28,6 +28,7 @@ module MOM_KPP #include "MOM_memory.h" public :: KPP_init +public :: KPP_compute_BLD public :: KPP_calculate public :: KPP_end public :: KPP_NonLocalTransport_temp @@ -171,6 +172,10 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) 'If False, calculates the non-local transport and tendencies but\n'//& 'purely for diagnostic purposes.', & default=.not. CS%passiveMode) + call get_param(paramFile, mdl, 'APPLY_KPP_OBL_FILTER', CS%applyNonLocalTrans, & + 'If True, applies a 1-1-4-1-1 Laplacian filter one time on HBLT.\n'// & + 'computed via CVMix to reduce any horizontal two-grid-point noise.', & + default=.false.) call get_param(paramFile, mdl, 'RI_CRIT', CS%Ri_crit, & 'Critical bulk Richardson number used to define depth of the\n'// & 'surface Ocean Boundary Layer (OBL).', & @@ -407,7 +412,7 @@ end function KPP_init !> Compute OBL depth -subroutine KPP_compute_OBL(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) +subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) ! Arguments type(KPP_CS), pointer :: CS !< Control structure @@ -718,7 +723,7 @@ subroutine KPP_compute_OBL(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) enddo enddo -end subroutine KPP_compute_OBL +end subroutine KPP_compute_BLD !> KPP vertical diffusivity/viscosity and non-local tracer transport diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 02b9896ab7..284b209932 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -49,7 +49,8 @@ module MOM_diabatic_driver use MOM_internal_tides, only : propagate_int_tide use MOM_internal_tides, only : internal_tides_init, internal_tides_end, int_tide_CS use MOM_kappa_shear, only : kappa_shear_is_used -use MOM_KPP, only : KPP_CS, KPP_init, KPP_calculate, KPP_end, KPP_get_BLD +use MOM_KPP, only : KPP_CS, KPP_init, KPP_compute_BLD, KPP_calculate +use MOM_KPP, only : KPP_end, KPP_get_BLD use MOM_KPP, only : KPP_NonLocalTransport_temp, KPP_NonLocalTransport_saln use MOM_opacity, only : opacity_init, set_opacity, opacity_end, opacity_CS use MOM_regularize_layers, only : regularize_layers, regularize_layers_init, regularize_layers_CS @@ -635,6 +636,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G endif !$OMP end parallel + call KPP_compute_BLD(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, & + fluxes%ustar, CS%KPP_buoy_flux) + call KPP_calculate(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, & fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar) !$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,Kd_heat) From 82bde1440c4433f6ac2fd363b48f3a97f236a204 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 9 May 2018 09:03:29 -0400 Subject: [PATCH 0239/1072] Fixed uninitialized data in OBC config code - A test for division by zero is made but the parameters being tested are uninitialized. - I moved the loop to within the overall `if (OBC%number_of_segments > 0)` so that I could rely on the setting of the parameters to zero. - However, this problem occurred because the parameters are only read if Flather BCs are being used. If they are not it seems the tracer reservoir parameters are not read - it might work by chance but this does requirement for Flather does not seem correct to me. @khedstrom ? - Detected by NCI tests, thanks @nicjhan: https://accessdev.nci.org.au/jenkins/job/mom-ocean.org/job/MOM6_run/build=DEBUG,compiler=intel,experiment=ocean_only-DOME,label=nah599,memory_type=dynamic/139/console --- src/core/MOM_open_boundary.F90 | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 91f9f6546b..db66be5ed2 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -451,19 +451,23 @@ subroutine open_boundary_config(G, param_file, OBC) "at the boundaries to values from the interior when the flow \n"//& "is entering the domain.", units="m", default=0.0) + else + Lscale_in = 0. + Lscale_out = 0. endif if (mask_outside) call mask_outside_OBCs(G, param_file, OBC) - endif - ! All tracers are using the same restoring length scale for now, but we may want to make this - ! tracer-specific in the future for example, in cases where certain tracers are poorly constrained - ! by data while others are well constrained - MJH. - do l = 1, OBC%number_of_segments - OBC%segment(l)%Tr_InvLscale3_in=0.0 - if (Lscale_in>0.) OBC%segment(l)%Tr_InvLscale3_in = 1.0/(Lscale_in*Lscale_in*Lscale_in) - OBC%segment(l)%Tr_InvLscale3_out=0.0 - if (Lscale_out>0.) OBC%segment(l)%Tr_InvLscale3_out = 1.0/(Lscale_out*Lscale_out*Lscale_out) - enddo + ! All tracers are using the same restoring length scale for now, but we may want to make this + ! tracer-specific in the future for example, in cases where certain tracers are poorly constrained + ! by data while others are well constrained - MJH. + do l = 1, OBC%number_of_segments + OBC%segment(l)%Tr_InvLscale3_in=0.0 + if (Lscale_in>0.) OBC%segment(l)%Tr_InvLscale3_in = 1.0/(Lscale_in*Lscale_in*Lscale_in) + OBC%segment(l)%Tr_InvLscale3_out=0.0 + if (Lscale_out>0.) OBC%segment(l)%Tr_InvLscale3_out = 1.0/(Lscale_out*Lscale_out*Lscale_out) + enddo + + endif ! OBC%number_of_segments > 0 ! Safety check if ((OBC%open_u_BCs_exist_globally .or. OBC%open_v_BCs_exist_globally) .and. & From fc2b3b7fdb613e64b971b7988d47138f7120d441 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 9 May 2018 09:03:29 -0400 Subject: [PATCH 0240/1072] Fixed uninitialized data in OBC config code - A test for division by zero is made but the parameters being tested are uninitialized. - I moved the loop to within the overall `if (OBC%number_of_segments > 0)` so that I could rely on the setting of the parameters to zero. - However, this problem occurred because the parameters are only read if Flather BCs are being used. If they are not it seems the tracer reservoir parameters are not read - it might work by chance but this does requirement for Flather does not seem correct to me. @khedstrom ? - Detected by NCI tests, thanks @nicjhan: https://accessdev.nci.org.au/jenkins/job/mom-ocean.org/job/MOM6_run/build=DEBUG,compiler=intel,experiment=ocean_only-DOME,label=nah599,memory_type=dynamic/139/console --- src/core/MOM_open_boundary.F90 | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 7fddc2eb85..2469a34428 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -461,19 +461,23 @@ subroutine open_boundary_config(G, param_file, OBC) "at the boundaries to values from the interior when the flow \n"//& "is entering the domain.", units="m", default=0.0) + else + Lscale_in = 0. + Lscale_out = 0. endif if (mask_outside) call mask_outside_OBCs(G, param_file, OBC) - endif - ! All tracers are using the same restoring length scale for now, but we may want to make this - ! tracer-specific in the future for example, in cases where certain tracers are poorly constrained - ! by data while others are well constrained - MJH. - do l = 1, OBC%number_of_segments - OBC%segment(l)%Tr_InvLscale3_in=0.0 - if (Lscale_in>0.) OBC%segment(l)%Tr_InvLscale3_in = 1.0/(Lscale_in*Lscale_in*Lscale_in) - OBC%segment(l)%Tr_InvLscale3_out=0.0 - if (Lscale_out>0.) OBC%segment(l)%Tr_InvLscale3_out = 1.0/(Lscale_out*Lscale_out*Lscale_out) - enddo + ! All tracers are using the same restoring length scale for now, but we may want to make this + ! tracer-specific in the future for example, in cases where certain tracers are poorly constrained + ! by data while others are well constrained - MJH. + do l = 1, OBC%number_of_segments + OBC%segment(l)%Tr_InvLscale3_in=0.0 + if (Lscale_in>0.) OBC%segment(l)%Tr_InvLscale3_in = 1.0/(Lscale_in*Lscale_in*Lscale_in) + OBC%segment(l)%Tr_InvLscale3_out=0.0 + if (Lscale_out>0.) OBC%segment(l)%Tr_InvLscale3_out = 1.0/(Lscale_out*Lscale_out*Lscale_out) + enddo + + endif ! OBC%number_of_segments > 0 ! Safety check if ((OBC%open_u_BCs_exist_globally .or. OBC%open_v_BCs_exist_globally) .and. & From a783d39f2fa8d94481f642975bf99ce490c9a2fd Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 9 May 2018 07:54:52 -0800 Subject: [PATCH 0241/1072] Fixed a bug in MOM_CoriolisAdv.F90. - that dying test in MOM_open_boundary hung again... --- src/core/MOM_CoriolisAdv.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 690fcb42e9..51a1f1f04e 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -330,7 +330,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) if (OBC%freeslip_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB dvdx(I,J) = 0. enddo ; endif - if (OBC%specified_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB + if (OBC%computed_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB if (OBC%segment(n)%direction == OBC_DIRECTION_E) then dvdx(I,J) = 2.0*(OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%dyCv(i,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) From c2a6ed841167d648985044b0827084cef6699d13 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 9 May 2018 20:55:18 -0600 Subject: [PATCH 0242/1072] add smoothBLD var --- src/parameterizations/vertical/MOM_KPP.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 83f9788418..167bd2b589 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -70,6 +70,7 @@ module MOM_KPP character(len=30) :: MatchTechnique !< Method used in CVMix for setting diffusivity and NLT profile functions integer :: NLT_shape !< MOM6 over-ride of CVMix NLT shape function logical :: applyNonLocalTrans !< If True, apply non-local transport to heat and scalars + logical :: smoothBLD !< If True, apply a 1-1-4-1-1 Laplacian filter one time on HBLT. logical :: KPPzeroDiffusivity !< If True, will set diffusivity and viscosity from KPP to zero; for testing purposes. logical :: KPPisAdditive !< If True, will add KPP diffusivity to initial diffusivity. !! If False, will replace initial diffusivity wherever KPP diffusivity is non-zero. @@ -172,7 +173,7 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) 'If False, calculates the non-local transport and tendencies but\n'//& 'purely for diagnostic purposes.', & default=.not. CS%passiveMode) - call get_param(paramFile, mdl, 'APPLY_KPP_OBL_FILTER', CS%applyNonLocalTrans, & + call get_param(paramFile, mdl, 'SMOOTH_BLD', CS%smoothBLD, & 'If True, applies a 1-1-4-1-1 Laplacian filter one time on HBLT.\n'// & 'computed via CVMix to reduce any horizontal two-grid-point noise.', & default=.false.) From ffcb7e00060f7c5827f84ecb37c90ed2f7659460 Mon Sep 17 00:00:00 2001 From: matthew harrison Date: Thu, 10 May 2018 14:40:04 -0400 Subject: [PATCH 0243/1072] update segment htot --- src/core/MOM_open_boundary.F90 | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 8bb12ba5bd..66cb93f190 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -2440,28 +2440,30 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) do j=segment%HI%jsd,segment%HI%jed segment%Cg(I,j) = sqrt(GV%g_prime(1)*G%bathyT(i+ishift,j)) ! if (GV%Boussinesq) then - segment%Htot(I,j) = G%bathyT(i+ishift,j)*GV%m_to_H! + eta(i+ishift,j) + ! segment%Htot(I,j) = G%bathyT(i+ishift,j)*GV%m_to_H! + eta(i+ishift,j) ! else ! segment%Htot(I,j) = eta(i+ishift,j) ! endif + segment%Htot(I,j)=0.0 do k=1,G%ke - segment%h(I,j,k) = h(i+ishift,j,k) - enddo + segment%h(I,j,k) = h(i+ishift,j,k) + segment%Htot(I,j)=segment%Htot(I,j)+segment%h(I,j,k) + enddo enddo - - else! (segment%direction == OBC_DIRECTION_N .or. segment%direction == OBC_DIRECTION_S) if (segment%direction == OBC_DIRECTION_S) jshift=1 J=segment%HI%JsdB do i=segment%HI%isd,segment%HI%ied segment%Cg(i,J) = sqrt(GV%g_prime(1)*G%bathyT(i,j+jshift)) ! if (GV%Boussinesq) then - segment%Htot(i,J) = G%bathyT(i,j+jshift)*GV%m_to_H! + eta(i,j+jshift) -! else -! segment%Htot(i,J) = eta(i,j+jshift) -! endif +! segment%Htot(i,J) = G%bathyT(i,j+jshift)*GV%m_to_H! + eta(i,j+jshift) +! else +! segment%Htot(i,J) = eta(i,j+jshift) +! endif + segment%Htot(i,J)=0.0 do k=1,G%ke - segment%h(i,J,k) = h(i,j+jshift,k) + segment%h(i,J,k) = h(i,j+jshift,k) + segment%Htot(i,J)=segment%Htot(i,J)+segment%h(i,J,k) ! segment%e(i,J,k) = e(i,j+jshift,k) enddo enddo From 3aa2c4315774455beb82e6ca3341d7f941572eae Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Thu, 10 May 2018 10:49:36 -0800 Subject: [PATCH 0244/1072] Cleaning up @adcroft's questions about uninitialized nudging. - Also adding more possible OBC type strings (FLATHER, etc), upping from 5 to 8. - Other random small stuff. --- src/core/MOM_barotropic.F90 | 96 +++++++++++++--------------------- src/core/MOM_open_boundary.F90 | 74 +++++++++++++++++++++----- 2 files changed, 97 insertions(+), 73 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 63f271089e..4c91ef2edb 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -2487,23 +2487,17 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, grad(I-1,J-1) = (ubt(I-1,j) - ubt(I-1,j-1)) * G%mask2dBu(I-1,J-1) dhdt = ubt_old(I-1,j)-ubt(I-1,j) !old-new dhdx = ubt(I-1,j)-ubt(I-2,j) !in new time backward sasha for I-1 -! if (OBC%segment(OBC%segnum_u(I,j))%oblique) then - if (dhdt*(grad(I-1,J) + grad(I-1,J-1)) > 0.0) then - dhdy = grad(I-1,J-1) - elseif (dhdt*(grad(I-1,J) + grad(I-1,J-1)) == 0.0) then - dhdy = 0.0 - else - dhdy = grad(I-1,J) - endif -! endif + if (dhdt*(grad(I-1,J) + grad(I-1,J-1)) > 0.0) then + dhdy = grad(I-1,J-1) + elseif (dhdt*(grad(I-1,J) + grad(I-1,J-1)) == 0.0) then + dhdy = 0.0 + else + dhdy = grad(I-1,J) + endif if (dhdt*dhdx < 0.0) dhdt = 0.0 Cx = min(dhdt*dhdx,rx_max) ! default to normal flow only -! Cy = 0 - cff = max(dhdx*dhdx, eps) -! if (OBC%segment(OBC%segnum_u(I,j))%oblique) then - cff = max(dhdx*dhdx + dhdy*dhdy, eps) - Cy = min(cff, max(dhdt*dhdy, -cff)) -! endif + cff = max(dhdx*dhdx + dhdy*dhdy, eps) + Cy = min(cff, max(dhdt*dhdy, -cff)) ubt(I,j) = ((cff*ubt_old(I,j) + Cx*ubt(I-1,j)) - & (max(Cy,0.0)*grad(I,J-1) + min(Cy,0.0)*grad(I,J))) / (cff + Cx) vel_trans = ubt(I,j) @@ -2531,23 +2525,17 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, grad(I+1,J-1) = (ubt(I+1,j) - ubt(I+1,j-1)) * G%mask2dBu(I+1,J-1) dhdt = ubt_old(I+1,j)-ubt(I+1,j) !old-new dhdx = ubt(I+1,j)-ubt(I+2,j) !in new time backward sasha for I+1 -! if (OBC%segment(OBC%segnum_u(I,j))%oblique) then - if (dhdt*(grad(I+1,J) + grad(I+1,J-1)) > 0.0) then - dhdy = grad(I+1,J-1) - elseif (dhdt*(grad(I+1,J) + grad(I+1,J-1)) == 0.0) then - dhdy = 0.0 - else - dhdy = grad(I+1,J) - endif -! endif + if (dhdt*(grad(I+1,J) + grad(I+1,J-1)) > 0.0) then + dhdy = grad(I+1,J-1) + elseif (dhdt*(grad(I+1,J) + grad(I+1,J-1)) == 0.0) then + dhdy = 0.0 + else + dhdy = grad(I+1,J) + endif if (dhdt*dhdx < 0.0) dhdt = 0.0 Cx = min(dhdt*dhdx,rx_max) ! default to normal flow only -! Cy = 0 - cff = max(dhdx*dhdx, eps) -! if (OBC%segment(OBC%segnum_u(I,j))%oblique) then - cff = max(dhdx*dhdx + dhdy*dhdy, eps) - Cy = min(cff,max(dhdt*dhdy,-cff)) -! endif + cff = max(dhdx*dhdx + dhdy*dhdy, eps) + Cy = min(cff,max(dhdt*dhdy,-cff)) ubt(I,j) = ((cff*ubt_old(I,j) + Cx*ubt(I+1,j)) - & (max(Cy,0.0)*grad(I,J-1) + min(Cy,0.0)*grad(I,J))) / (cff + Cx) ! vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(I,j) @@ -2596,23 +2584,17 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, grad(I-1,J-1) = (vbt(i,J-1) - vbt(i-1,J-1)) * G%mask2dBu(I-1,J-1) dhdt = vbt_old(i,J-1)-vbt(i,J-1) !old-new dhdy = vbt(i,J-1)-vbt(i,J-2) !in new time backward sasha for J-1 -! if (OBC%segment(OBC%segnum_v(i,J))%oblique) then - if (dhdt*(grad(I,J-1) + grad(I-1,J-1)) > 0.0) then - dhdx = grad(I-1,J-1) - elseif (dhdt*(grad(I,J-1) + grad(I-1,J-1)) == 0.0) then - dhdx = 0.0 - else - dhdx = grad(I,J-1) - endif -! endif + if (dhdt*(grad(I,J-1) + grad(I-1,J-1)) > 0.0) then + dhdx = grad(I-1,J-1) + elseif (dhdt*(grad(I,J-1) + grad(I-1,J-1)) == 0.0) then + dhdx = 0.0 + else + dhdx = grad(I,J-1) + endif if (dhdt*dhdy < 0.0) dhdt = 0.0 Cy = min(dhdt*dhdy,rx_max) ! default to normal flow only -! Cx = 0 - cff = max(dhdy*dhdy, eps) -! if (OBC%segment(OBC%segnum_v(i,J))%oblique) then - cff = max(dhdx*dhdx + dhdy*dhdy, eps) - Cx = min(cff,max(dhdt*dhdx,-cff)) -! endif + cff = max(dhdx*dhdx + dhdy*dhdy, eps) + Cx = min(cff,max(dhdt*dhdx,-cff)) vbt(i,J) = ((cff*vbt_old(i,J) + Cy*vbt(i,J-1)) - & (max(Cx,0.0)*grad(I-1,J) + min(Cx,0.0)*grad(I,J))) / (cff + Cy) ! vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J) @@ -2641,23 +2623,17 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, grad(I-1,J+1) = (vbt(i,J+1) - vbt(i-1,J+1)) * G%mask2dBu(I-1,J+1) dhdt = vbt_old(i,J+1)-vbt(i,J+1) !old-new dhdy = vbt(i,J+1)-vbt(i,J+2) !in new time backward sasha for J+1 -! if (OBC%segment(OBC%segnum_v(i,J))%oblique) then - if (dhdt*(grad(I,J+1) + grad(I-1,J+1)) > 0.0) then - dhdx = grad(I-1,J+1) - elseif (dhdt*(grad(I,J+1) + grad(I-1,J+1)) == 0.0) then - dhdx = 0.0 - else - dhdx = grad(I,J+1) - endif -! endif + if (dhdt*(grad(I,J+1) + grad(I-1,J+1)) > 0.0) then + dhdx = grad(I-1,J+1) + elseif (dhdt*(grad(I,J+1) + grad(I-1,J+1)) == 0.0) then + dhdx = 0.0 + else + dhdx = grad(I,J+1) + endif if (dhdt*dhdy < 0.0) dhdt = 0.0 Cy = min(dhdt*dhdy,rx_max) ! default to normal flow only -! Cx = 0 - cff = max(dhdy*dhdy, eps) -! if (OBC%segment(OBC%segnum_v(i,J))%oblique) then - cff = max(dhdx*dhdx + dhdy*dhdy, eps) - Cx = min(cff,max(dhdt*dhdx,-cff)) -! endif + cff = max(dhdx*dhdx + dhdy*dhdy, eps) + Cx = min(cff,max(dhdt*dhdx,-cff)) vbt(i,J) = ((cff*vbt_old(i,J) + Cy*vbt(i,J+1)) - & (max(Cx,0.0)*grad(I-1,J) + min(Cx,0.0)*grad(I,J))) / (cff + Cy) ! vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 8bb12ba5bd..b160840498 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -431,7 +431,7 @@ subroutine open_boundary_config(G, param_file, OBC) ! if (open_boundary_query(OBC, needs_ext_seg_data=.true.)) & call initialize_segment_data(G, OBC, param_file) - if ( OBC%Flather_u_BCs_exist_globally .or. OBC%Flather_v_BCs_exist_globally ) then + if (open_boundary_query(OBC, apply_Flather_OBC=.true.)) then call get_param(param_file, mdl, "OBC_RADIATION_MAX", OBC%rx_max, & "The maximum magnitude of the baroclinic radiation \n"//& "velocity (or speed of characteristics). This is only \n"//& @@ -451,6 +451,11 @@ subroutine open_boundary_config(G, param_file, OBC) "Valid values range from 0 to 1. This is only used if \n"//& "one of the open boundary segments is using Orlanski.", & units="nondim", default=0.2) + endif + + Lscale_in = 0. + Lscale_out = 0. + if (open_boundary_query(OBC, apply_open_OBC=.true.)) then call get_param(param_file, mdl, "OBC_TRACER_RESERVOIR_LENGTH_SCALE_OUT ", Lscale_out, & "An effective length scale for restoring the tracer concentration \n"//& "at the boundaries to externally imposed values when the flow \n"//& @@ -460,11 +465,8 @@ subroutine open_boundary_config(G, param_file, OBC) "An effective length scale for restoring the tracer concentration \n"//& "at the boundaries to values from the interior when the flow \n"//& "is entering the domain.", units="m", default=0.0) - - else - Lscale_in = 0. - Lscale_out = 0. endif + if (mask_outside) call mask_outside_OBCs(G, param_file, OBC) ! All tracers are using the same restoring length scale for now, but we may want to make this @@ -763,7 +765,7 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF) ! Local variables integer :: I_obc, Js_obc, Je_obc ! Position of segment in global index space integer :: j, a_loop - character(len=32) :: action_str(5) + character(len=32) :: action_str(8) character(len=128) :: segment_param_str real, allocatable, dimension(:) :: tnudge ! This returns the global indices for the segment @@ -784,7 +786,7 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF) OBC%segment(l_seg)%on_pe = .false. - do a_loop = 1,5 ! up to 5 options available + do a_loop = 1,8 ! up to 8 options available if (len_trim(action_str(a_loop)) == 0) then cycle elseif (trim(action_str(a_loop)) == 'FLATHER') then @@ -878,7 +880,7 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF) ! Local variables integer :: J_obc, Is_obc, Ie_obc ! Position of segment in global index space integer :: i, a_loop - character(len=32) :: action_str(5) + character(len=32) :: action_str(8) character(len=128) :: segment_param_str real, allocatable, dimension(:) :: tnudge @@ -900,7 +902,7 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF) OBC%segment(l_seg)%on_pe = .false. - do a_loop = 1,5 + do a_loop = 1,8 if (len_trim(action_str(a_loop)) == 0) then cycle elseif (trim(action_str(a_loop)) == 'FLATHER') then @@ -1484,6 +1486,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) real, parameter :: eps = 1.0e-20 type(OBC_segment_type), pointer :: segment integer :: i, j, k, is, ie, js, je, nz, n + integer :: is_obc, ie_obc, js_obc, je_obc + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke if (.not.associated(OBC)) return @@ -1614,8 +1618,19 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) enddo ; enddo endif if (segment%radiation_grad) then - do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + Js_obc = max(segment%HI%JsdB,G%jsd+1) + Je_obc = min(segment%HI%JedB,G%jed-1) + do k=1,nz ; do J=Js_obc,Je_obc rx_avg = rx_tangential(I,J,k) +! if (G%mask2dCu(I-1,j) > 0.0 .and. G%mask2dCu(I-1,j+1) > 0.0) then +! rx_avg = 0.5*(u_new(I-1,j,k) + u_new(I-1,j+1,k))*dt*G%IdxBu(I-1,J) +! elseif (G%mask2dCu(I-1,j) > 0.0) then +! rx_avg = u_new(I-1,j,k)*dt*G%IdxBu(I-1,J) +! elseif (G%mask2dCu(I-1,j+1) > 0.0) then +! rx_avg = u_new(I-1,j+1,k)*dt*G%IdxBu(I-1,J) +! else +! rx_avg = 0.0 +! endif segment%tangential_grad(I,J,k) = ((v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) + & rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) / (1.0+rx_avg) enddo ; enddo @@ -1713,8 +1728,19 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) enddo ; enddo endif if (segment%radiation_grad) then - do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + Js_obc = max(segment%HI%JsdB,G%jsd+1) + Je_obc = min(segment%HI%JedB,G%jed-1) + do k=1,nz ; do J=Js_obc,Je_obc rx_avg = rx_tangential(I,J,k) +! if (G%mask2dCu(I+1,j) > 0.0 .and. G%mask2dCu(I+1,j+1) > 0.0) then +! rx_avg = 0.5*(u_new(I+1,j,k) + u_new(I+1,j+1,k))*dt*G%IdxBu(I+1,J) +! elseif (G%mask2dCu(I+1,j) > 0.0) then +! rx_avg = u_new(I+1,j,k)*dt*G%IdxBu(I+1,J) +! elseif (G%mask2dCu(I+1,j+1) > 0.0) then +! rx_avg = u_new(I+1,j+1,k)*dt*G%IdxBu(I+1,J) +! else +! rx_avg = 0.0 +! endif segment%tangential_grad(I,J,k) = ((v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) + & rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) / (1.0+rx_avg) enddo ; enddo @@ -1813,8 +1839,19 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) enddo ; enddo endif if (segment%radiation_grad) then - do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + Is_obc = max(segment%HI%IsdB,G%isd+1) + Ie_obc = min(segment%HI%IedB,G%ied-1) + do k=1,nz ; do I=Is_obc,Ie_obc rx_avg = rx_tangential(I,J,k) +! if (G%mask2dCv(i,J-1) > 0.0 .and. G%mask2dCv(i+1,J-1) > 0.0) then +! rx_avg = 0.5*(v_new(i,J-1,k) + v_new(i+1,J-1,k)*dt*G%IdyBu(I,J-1)) +! elseif (G%mask2dCv(i,J-1) > 0.0) then +! rx_avg = v_new(i,J-1,k)*dt*G%IdyBu(I,J-1) +! elseif (G%mask2dCv(i+1,J-1) > 0.0) then +! rx_avg = v_new(i+1,J-1,k)*dt*G%IdyBu(I,J-1) +! else +! rx_avg = 0.0 +! endif segment%tangential_grad(I,J,k) = ((u_new(I,j,k) - u_new(I-1,j,k))*G%IdyBu(I,J-1) + & rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) / (1.0+rx_avg) enddo ; enddo @@ -1913,8 +1950,19 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) enddo ; enddo endif if (segment%radiation_grad) then - do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + Is_obc = max(segment%HI%IsdB,G%isd+1) + Ie_obc = min(segment%HI%IedB,G%ied-1) + do k=1,nz ; do I=Is_obc,Ie_obc rx_avg = rx_tangential(I,J,k) +! if (G%mask2dCv(i,J+1) > 0.0 .and. G%mask2dCv(i+1,J+1) > 0.0) then +! rx_avg = 0.5*(v_new(i,J+1,k) + v_new(i+1,J+1,k))*dt*G%IdyBu(I,J+1) +! elseif (G%mask2dCv(i,J+1) > 0.0) then +! rx_avg = v_new(i,J+1,k)*dt*G%IdyBu(I,J+1) +! elseif (G%mask2dCv(i+1,J+1) > 0.0) then +! rx_avg = v_new(i+1,J+1,k)*dt*G%IdyBu(I,J+1) +! else +! rx_avg = 0.0 +! endif segment%tangential_grad(I,J,k) = ((u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) / (1.0+rx_avg) enddo ; enddo From 34e4cf4fc32dc0dba03c7ffd36d4820332881baf Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 10 May 2018 13:57:32 -0600 Subject: [PATCH 0245/1072] use 2d CS arrays for OBLdepth and kOBL --- src/parameterizations/vertical/MOM_KPP.F90 | 173 +++++---------------- 1 file changed, 38 insertions(+), 135 deletions(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 167bd2b589..3ae2a1a196 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -106,6 +106,7 @@ module MOM_KPP ! Diagnostics arrays real, allocatable, dimension(:,:) :: OBLdepth !< Depth (positive) of OBL (m) + real, allocatable, dimension(:,:) :: kOBL !< Level (+fraction) of OBL extent real, allocatable, dimension(:,:,:) :: dRho !< Bulk difference in density (kg/m3) real, allocatable, dimension(:,:,:) :: Uz2 !< Square of bulk difference in resolved velocity (m2/s2) real, allocatable, dimension(:,:,:) :: BulkRi !< Bulk Richardson number for each layer (dimensionless) @@ -376,8 +377,11 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) CS%id_Vsurf = register_diag_field('ocean_model', 'KPP_Vsurf', diag%axesCv1, Time, & 'j-component flow of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'm/s') - if (CS%id_OBLdepth > 0) allocate( CS%OBLdepth( SZI_(G), SZJ_(G) ) ) - if (CS%id_OBLdepth > 0) CS%OBLdepth(:,:) = 0. + allocate( CS%OBLdepth( SZI_(G), SZJ_(G) ) ) + CS%OBLdepth(:,:) = 0. + allocate( CS%kOBL( SZI_(G), SZJ_(G) ) ) + CS%kOBL(:,:) = 0. + if (CS%id_BulkDrho > 0) allocate( CS%dRho( SZI_(G), SZJ_(G), SZK_(G) ) ) if (CS%id_BulkDrho > 0) CS%dRho(:,:,:) = 0. if (CS%id_BulkUz2 > 0) allocate( CS%Uz2( SZI_(G), SZJ_(G), SZK_(G) ) ) @@ -449,7 +453,7 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) real, dimension( 3*G%ke ) :: Temp_1D real, dimension( 3*G%ke ) :: Salt_1D - real :: kOBL, OBLdepth_0d, surfFricVel, surfBuoyFlux, Coriolis + real :: surfFricVel, surfBuoyFlux, Coriolis real :: GoRho, pRef, rho1, rhoK, Uk, Vk, sigma real :: zBottomMinusOffset ! Height of bottom plus a little bit (m) @@ -476,8 +480,8 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) !$OMP pRef,km1,cellHeight,Uk,Vk,deltaU2, & !$OMP rho1,rhoK,deltaRho,N2_1d,N_1d,delH, & !$OMP surfBuoyFlux,Ws_1d,BulkRi_1d, & -!$OMP OBLdepth_0d,zBottomMinusOffset, & -!$OMP sigma,kOBL,kk,pres_1D,Temp_1D, & +!$OMP zBottomMinusOffset, & +!$OMP sigma,kk,pres_1D,Temp_1D, & !$OMP Salt_1D,rho_1D,surfBuoyFlux2,ksfc,dh,hcorr) ! loop over horizontal points on processor @@ -624,8 +628,8 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) call CVMix_kpp_compute_OBL_depth( & BulkRi_1d, & ! (in) Bulk Richardson number iFaceHeight, & ! (in) Height of interfaces (m) - OBLdepth_0d, & ! (out) OBL depth (m) - kOBL, & ! (out) level (+fraction) of OBL extent + CS%OBLdepth(i,j), & ! (out) OBL depth (m) + CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent zt_cntr=cellHeight, & ! (in) Height of cell centers (m) surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) @@ -636,14 +640,14 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) ! because KPP was unable to handle vanishingly small layers near the bottom. if (CS%deepOBLoffset>0.) then zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) - OBLdepth_0d = min( OBLdepth_0d, -zBottomMinusOffset ) + CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -zBottomMinusOffset ) endif ! apply some constraints on OBLdepth - if(CS%fixedOBLdepth) OBLdepth_0d = CS%fixedOBLdepth_value - OBLdepth_0d = max( OBLdepth_0d, -iFaceHeight(2) ) ! no shallower than top layer - OBLdepth_0d = min( OBLdepth_0d, -iFaceHeight(G%ke+1) ) ! no deeper than bottom - kOBL = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) + if(CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value + CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer + CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(G%ke+1) ) ! no deeper than bottom + CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) !************************************************************************* ! smg: remove code below @@ -652,7 +656,7 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) ! Code should be removed after further testing. if (CS%correctSurfLayerAvg) then - SLdepth_0d = CS%surf_layer_ext * OBLdepth_0d + SLdepth_0d = CS%surf_layer_ext * CS%OBLdepth(i,j) hTot = h(i,j,1) surfTemp = Temp(i,j,1) ; surfHtemp = surfTemp * hTot surfSalt = Salt(i,j,1) ; surfHsalt = surfSalt * hTot @@ -696,8 +700,8 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) call CVMix_kpp_compute_OBL_depth( & BulkRi_1d, & ! (in) Bulk Richardson number iFaceHeight, & ! (in) Height of interfaces (m) - OBLdepth_0d, & ! (out) OBL depth (m) - kOBL, & ! (out) level (+fraction) of OBL extent + CS%OBLdepth(i,j), & ! (out) OBL depth (m) + CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent zt_cntr=cellHeight, & ! (in) Height of cell centers (m) surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) @@ -706,15 +710,15 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) if (CS%deepOBLoffset>0.) then zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) - OBLdepth_0d = min( OBLdepth_0d, -zBottomMinusOffset ) - kOBL = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) + CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -zBottomMinusOffset ) + CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) endif ! apply some constraints on OBLdepth - if(CS%fixedOBLdepth) OBLdepth_0d = CS%fixedOBLdepth_value - OBLdepth_0d = max( OBLdepth_0d, -iFaceHeight(2) ) ! no shallower than top layer - OBLdepth_0d = min( OBLdepth_0d, -iFaceHeight(G%ke+1) ) ! no deep than bottom - kOBL = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) + if(CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value + CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer + CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(G%ke+1) ) ! no deep than bottom + CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) endif ! endif for "correction" step @@ -776,7 +780,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & real, dimension( 3*G%ke ) :: Temp_1D real, dimension( 3*G%ke ) :: Salt_1D - real :: kOBL, OBLdepth_0d, surfFricVel, surfBuoyFlux, Coriolis + real :: surfFricVel, surfBuoyFlux, Coriolis real :: GoRho, pRef, rho1, rhoK, rhoKm1, Uk, Vk, sigma real :: zBottomMinusOffset ! Height of bottom plus a little bit (m) @@ -821,8 +825,8 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & !$OMP pRef,km1,cellHeight,Uk,Vk,deltaU2, & !$OMP rho1,rhoK,rhoKm1,deltaRho,N2_1d,N_1d,delH, & !$OMP surfBuoyFlux,Ws_1d,Vt2_1d,BulkRi_1d, & -!$OMP OBLdepth_0d,zBottomMinusOffset,Kdiffusivity, & -!$OMP Kviscosity,sigma,kOBL,kk,pres_1D,Temp_1D, & +!$OMP zBottomMinusOffset,Kdiffusivity, & +!$OMP Kviscosity,sigma,kk,pres_1D,Temp_1D, & !$OMP Salt_1D,rho_1D,surfBuoyFlux2,ksfc,dh,hcorr) ! loop over horizontal points on processor @@ -966,106 +970,6 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit ! h to Monin-Obukov (default is false, ie. not used) - call CVMix_kpp_compute_OBL_depth( & - BulkRi_1d, & ! (in) Bulk Richardson number - iFaceHeight, & ! (in) Height of interfaces (m) - OBLdepth_0d, & ! (out) OBL depth (m) - kOBL, & ! (out) level (+fraction) of OBL extent - zt_cntr=cellHeight, & ! (in) Height of cell centers (m) - surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) - surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) - Coriolis=Coriolis, & ! (in) Coriolis parameter (1/s) - CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters - - ! A hack to avoid KPP reaching the bottom. It was needed during development - ! because KPP was unable to handle vanishingly small layers near the bottom. - if (CS%deepOBLoffset>0.) then - zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) - OBLdepth_0d = min( OBLdepth_0d, -zBottomMinusOffset ) - endif - - ! apply some constraints on OBLdepth - if(CS%fixedOBLdepth) OBLdepth_0d = CS%fixedOBLdepth_value - OBLdepth_0d = max( OBLdepth_0d, -iFaceHeight(2) ) ! no shallower than top layer - OBLdepth_0d = min( OBLdepth_0d, -iFaceHeight(G%ke+1) ) ! no deeper than bottom - kOBL = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) - -!************************************************************************* -! smg: remove code below - -! Following "correction" step has been found to be unnecessary. -! Code should be removed after further testing. - if (CS%correctSurfLayerAvg) then - - SLdepth_0d = CS%surf_layer_ext * OBLdepth_0d - hTot = h(i,j,1) - surfTemp = Temp(i,j,1) ; surfHtemp = surfTemp * hTot - surfSalt = Salt(i,j,1) ; surfHsalt = surfSalt * hTot - surfU = 0.5*(u(i,j,1)+u(i-1,j,1)) ; surfHu = surfU * hTot - surfV = 0.5*(v(i,j,1)+v(i,j-1,1)) ; surfHv = surfV * hTot - pRef = 0.0 - - do k = 2, G%ke - - ! Recalculate differences with surface layer - Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU - Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV - deltaU2(k) = Uk**2 + Vk**2 - pRef = pRef + GV%H_to_Pa * h(i,j,k) - call calculate_density(surfTemp, surfSalt, pRef, rho1, EOS) - call calculate_density(Temp(i,j,k), Salt(i,j,k), pRef, rhoK, EOS) - deltaRho(k) = rhoK - rho1 - - ! Surface layer averaging (needed for next k+1 iteration of this loop) - if (hTot < SLdepth_0d) then - delH = min( max(0., SLdepth_0d - hTot), h(i,j,k)*GV%H_to_m ) - hTot = hTot + delH - surfHtemp = surfHtemp + Temp(i,j,k) * delH ; surfTemp = surfHtemp / hTot - surfHsalt = surfHsalt + Salt(i,j,k) * delH ; surfSalt = surfHsalt / hTot - surfHu = surfHu + 0.5*(u(i,j,k)+u(i-1,j,k)) * delH ; surfU = surfHu / hTot - surfHv = surfHv + 0.5*(v(i,j,k)+v(i,j-1,k)) * delH ; surfV = surfHv / hTot - endif - - enddo - - BulkRi_1d = CVMix_kpp_compute_bulk_Richardson( & - cellHeight(1:G%ke), & ! Depth of cell center (m) - GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) (1/s) - deltaU2, & ! Square of resolved velocity difference (m2/s2) - ws_cntr=Ws_1d, & ! Turbulent velocity scale profile (m/s) - N_iface=N_1d ) ! Buoyancy frequency (1/s) - - surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit - ! h to Monin-Obukov (default is false, ie. not used) - - call CVMix_kpp_compute_OBL_depth( & - BulkRi_1d, & ! (in) Bulk Richardson number - iFaceHeight, & ! (in) Height of interfaces (m) - OBLdepth_0d, & ! (out) OBL depth (m) - kOBL, & ! (out) level (+fraction) of OBL extent - zt_cntr=cellHeight, & ! (in) Height of cell centers (m) - surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) - surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) - Coriolis=Coriolis, & ! (in) Coriolis parameter (1/s) - CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters - - if (CS%deepOBLoffset>0.) then - zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) - OBLdepth_0d = min( OBLdepth_0d, -zBottomMinusOffset ) - kOBL = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) - endif - - ! apply some constraints on OBLdepth - if(CS%fixedOBLdepth) OBLdepth_0d = CS%fixedOBLdepth_value - OBLdepth_0d = max( OBLdepth_0d, -iFaceHeight(2) ) ! no shallower than top layer - OBLdepth_0d = min( OBLdepth_0d, -iFaceHeight(G%ke+1) ) ! no deep than bottom - kOBL = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) - - endif ! endif for "correction" step - -! smg: remove code above -! ********************************************************************** - ! Call CVMix/KPP to obtain OBL diffusivities, viscosities and non-local transports @@ -1076,7 +980,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & if (CS%SW_METHOD .eq. SW_METHOD_ALL_SW) then surfBuoyFlux = buoyFlux(i,j,1) elseif (CS%SW_METHOD .eq. SW_METHOD_MXL_SW) then - surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,int(kOBL)+1) ! We know the actual buoyancy flux into the OBL + surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,int(CS%kOBL(i,j))+1) ! We know the actual buoyancy flux into the OBL elseif (CS%SW_METHOD .eq. SW_METHOD_LV1_SW) then surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,2) endif @@ -1099,8 +1003,8 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & Kviscosity, & ! (in) Original viscosity (m2/s) Kdiffusivity(:,1), & ! (in) Original heat diffusivity (m2/s) Kdiffusivity(:,2), & ! (in) Original salt diffusivity (m2/s) - OBLdepth_0d, & ! (in) OBL depth (m) - kOBL, & ! (in) level (+fraction) of OBL extent + CS%OBLdepth(i,j), & ! (in) OBL depth (m) + CS%kOBL(i,j), & ! (in) level (+fraction) of OBL extent nonLocalTrans(:,1),& ! (out) Non-local heat transport (non-dimensional) nonLocalTrans(:,2),& ! (out) Non-local salt transport (non-dimensional) surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) @@ -1122,26 +1026,26 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & if (surfBuoyFlux < 0.0) then if (CS%NLT_shape == NLT_SHAPE_CUBIC) then do k = 2, G%ke - sigma = min(1.0,-iFaceHeight(k)/OBLdepth_0d) + sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) nonLocalTrans(k,1) = (1.0 - sigma)**2 * (1.0 + 2.0*sigma) !* nonLocalTrans(k,2) = nonLocalTrans(k,1) enddo elseif (CS%NLT_shape == NLT_SHAPE_PARABOLIC) then do k = 2, G%ke - sigma = min(1.0,-iFaceHeight(k)/OBLdepth_0d) + sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) nonLocalTrans(k,1) = (1.0 - sigma)**2 !*CS%CS2 nonLocalTrans(k,2) = nonLocalTrans(k,1) enddo elseif (CS%NLT_shape == NLT_SHAPE_LINEAR) then do k = 2, G%ke - sigma = min(1.0,-iFaceHeight(k)/OBLdepth_0d) + sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) nonLocalTrans(k,1) = (1.0 - sigma)!*CS%CS2 nonLocalTrans(k,2) = nonLocalTrans(k,1) enddo elseif (CS%NLT_shape == NLT_SHAPE_CUBIC_LMD) then ! Sanity check (should agree with CVMix result using simple matching) do k = 2, G%ke - sigma = min(1.0,-iFaceHeight(k)/OBLdepth_0d) + sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) nonLocalTrans(k,1) = CS%CS2 * sigma*(1.0 -sigma)**2 nonLocalTrans(k,2) = nonLocalTrans(k,1) enddo @@ -1163,8 +1067,8 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & ! recompute wscale for diagnostics, now that we in fact know boundary layer depth if (CS%id_Ws > 0) then call CVMix_kpp_compute_turbulent_scales( & - -CellHeight/OBLdepth_0d, & ! (in) Normalized boundary layer coordinate - OBLdepth_0d, & ! (in) OBL depth (m) + -CellHeight/CS%OBLdepth(i,j), & ! (in) Normalized boundary layer coordinate + CS%OBLdepth(i,j), & ! (in) OBL depth (m) surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) w_s=Ws_1d, & ! (out) Turbulent velocity scale profile (m/s) @@ -1184,13 +1088,12 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & endif ! Copy 1d data into 3d diagnostic arrays - if (CS%id_OBLdepth > 0) CS%OBLdepth(i,j) = OBLdepth_0d if (CS%id_BulkDrho > 0) CS%dRho(i,j,:) = deltaRho(:) if (CS%id_BulkUz2 > 0) CS%Uz2(i,j,:) = deltaU2(:) if (CS%id_BulkRi > 0) CS%BulkRi(i,j,:) = BulkRi_1d(:) if (CS%id_sigma > 0) then CS%sigma(i,j,:) = 0. - if (OBLdepth_0d>0.) CS%sigma(i,j,:) = -iFaceHeight/OBLdepth_0d + if (CS%OBLdepth(i,j)>0.) CS%sigma(i,j,:) = -iFaceHeight/CS%OBLdepth(i,j) endif if (CS%id_N > 0) CS%N(i,j,:) = N_1d(:) if (CS%id_N2 > 0) CS%N2(i,j,:) = N2_1d(:) From 29a458ac92590330618d161af08c8a25bd17ca5c Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 10 May 2018 14:18:48 -0600 Subject: [PATCH 0246/1072] remove unnecessary vars in KPP_calculate --- src/parameterizations/vertical/MOM_KPP.F90 | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 3ae2a1a196..eb5d27d7bf 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -780,10 +780,9 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & real, dimension( 3*G%ke ) :: Temp_1D real, dimension( 3*G%ke ) :: Salt_1D - real :: surfFricVel, surfBuoyFlux, Coriolis + real :: surfFricVel, surfBuoyFlux real :: GoRho, pRef, rho1, rhoK, rhoKm1, Uk, Vk, sigma - real :: zBottomMinusOffset ! Height of bottom plus a little bit (m) real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth. real :: hTot ! Running sum of thickness used in the surface layer average (m) real :: delH ! Thickness of a layer (m) @@ -819,13 +818,13 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & !$OMP buoyFlux, nonLocalTransHeat, & !$OMP nonLocalTransScalar,Kt,Ks,Kv) & !$OMP firstprivate(nonLocalTrans) & -!$OMP private(Coriolis,surfFricVel,SLdepth_0d,hTot,surfTemp, & +!$OMP private(surfFricVel,SLdepth_0d,hTot,surfTemp, & !$OMP surfHtemp,surfSalt,surfHsalt,surfU, & !$OMP surfHu,surfV,surfHv,iFaceHeight, & !$OMP pRef,km1,cellHeight,Uk,Vk,deltaU2, & !$OMP rho1,rhoK,rhoKm1,deltaRho,N2_1d,N_1d,delH, & !$OMP surfBuoyFlux,Ws_1d,Vt2_1d,BulkRi_1d, & -!$OMP zBottomMinusOffset,Kdiffusivity, & +!$OMP Kdiffusivity, & !$OMP Kviscosity,sigma,kk,pres_1D,Temp_1D, & !$OMP Salt_1D,rho_1D,surfBuoyFlux2,ksfc,dh,hcorr) @@ -837,8 +836,6 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & if (G%mask2dT(i,j)==0.) cycle ! things independent of position within the column - Coriolis = 0.25*( (G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) & - +(G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1)) ) surfFricVel = uStar(i,j) ! Bullk Richardson number computed for each cell in a column, From 8f730569e1d091ec3219bb73db95da545434b1fc Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 10 May 2018 15:52:01 -0600 Subject: [PATCH 0247/1072] implement smoothing on OBL depth --- src/parameterizations/vertical/MOM_KPP.F90 | 68 ++++++++++++++++++++++ 1 file changed, 68 insertions(+) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index eb5d27d7bf..e479460ebe 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -728,9 +728,77 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) enddo enddo + if (CS%smoothBLD) call KPP_smooth_BLD(CS,G,GV,h) + end subroutine KPP_compute_BLD +!> Apply a 1-1-4-1-1 Laplacian filter one time on BLD to reduce any horizontal two-grid-point noise +subroutine KPP_smooth_BLD(CS,G,GV,h) + ! Arguments + type(KPP_CS), pointer :: CS !< Control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) + + ! local + real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) + real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) + integer :: i, j, k + real :: wc, ww, we, wn, ws ! averaging weights for smoothing + real :: dh ! The local thickness used for calculating interface positions (m) + real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) + + ! apply smoothing on OBL depth + do j = G%jsc, G%jec + do i = G%isc, G%iec + + ! skip land points + if (G%mask2dT(i,j)==0.) cycle + + ! compute weights + ww = 0.125 * G%mask2dT(i-1,j) + we = 0.125 * G%mask2dT(i+1,j) + ws = 0.125 * G%mask2dT(i,j-1) + wn = 0.125 * G%mask2dT(i,j+1) + wc = 1.0 - (ww+we+wn+ws) + + CS%OBLdepth(i,j) = wc * CS%OBLdepth(i,j) & + + ww * CS%OBLdepth(i-1,j) & + + we * CS%OBLdepth(i+1,j) & + + ws * CS%OBLdepth(i,j-1) & + + wn * CS%OBLdepth(i,j+1) + enddo + enddo + + ! Update kOBL for smoothed OBL depths + do j = G%jsc, G%jec + do i = G%isc, G%iec + + ! skip land points + if (G%mask2dT(i,j)==0.) cycle + + iFaceHeight(1) = 0.0 ! BBL is all relative to the surface + hcorr = 0. + do k=1,G%ke + + ! cell center and cell bottom in meters (negative values in the ocean) + dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) + hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 + dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness + cellHeight(k) = iFaceHeight(k) - 0.5 * dh + iFaceHeight(k+1) = iFaceHeight(k) - dh + enddo + + CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) + + enddo + enddo + +end subroutine KPP_smooth_BLD + + !> KPP vertical diffusivity/viscosity and non-local tracer transport subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & buoyFlux, Kt, Ks, Kv, nonLocalTransHeat,& From cdd405d137977d0f2621e955e20244f2ab00d03d Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Fri, 11 May 2018 11:22:43 -0800 Subject: [PATCH 0248/1072] Cleaning up spacing and comments. --- src/core/MOM_open_boundary.F90 | 25 +++++++------------------ 1 file changed, 7 insertions(+), 18 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 4b95441471..f762243aa9 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -2487,32 +2487,21 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) I=segment%HI%IsdB do j=segment%HI%jsd,segment%HI%jed segment%Cg(I,j) = sqrt(GV%g_prime(1)*G%bathyT(i+ishift,j)) - ! if (GV%Boussinesq) then - ! segment%Htot(I,j) = G%bathyT(i+ishift,j)*GV%m_to_H! + eta(i+ishift,j) - ! else - ! segment%Htot(I,j) = eta(i+ishift,j) - ! endif - segment%Htot(I,j)=0.0 + segment%Htot(I,j)=0.0 do k=1,G%ke - segment%h(I,j,k) = h(i+ishift,j,k) - segment%Htot(I,j)=segment%Htot(I,j)+segment%h(I,j,k) - enddo + segment%h(I,j,k) = h(i+ishift,j,k) + segment%Htot(I,j)=segment%Htot(I,j)+segment%h(I,j,k) + enddo enddo else! (segment%direction == OBC_DIRECTION_N .or. segment%direction == OBC_DIRECTION_S) if (segment%direction == OBC_DIRECTION_S) jshift=1 J=segment%HI%JsdB do i=segment%HI%isd,segment%HI%ied segment%Cg(i,J) = sqrt(GV%g_prime(1)*G%bathyT(i,j+jshift)) -! if (GV%Boussinesq) then -! segment%Htot(i,J) = G%bathyT(i,j+jshift)*GV%m_to_H! + eta(i,j+jshift) -! else -! segment%Htot(i,J) = eta(i,j+jshift) -! endif - segment%Htot(i,J)=0.0 + segment%Htot(i,J)=0.0 do k=1,G%ke - segment%h(i,J,k) = h(i,j+jshift,k) - segment%Htot(i,J)=segment%Htot(i,J)+segment%h(i,J,k) -! segment%e(i,J,k) = e(i,j+jshift,k) + segment%h(i,J,k) = h(i,j+jshift,k) + segment%Htot(i,J)=segment%Htot(i,J)+segment%h(i,J,k) enddo enddo endif From 92126aa58f4eb0a6ddeb86424425082c2031265b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 11 May 2018 15:31:34 -0400 Subject: [PATCH 0249/1072] Added 'implicit none ; private' to 5 modules Added 'implicit none ; private' to MOM_unit_tests.F90, MOM_oda_driver.F90, MOM_diag_manager_wrapper.F90, MOM_OCMIP2_CO2calc.F90 and MOM_offline_aux.F90. All answers are bitwise identical. --- src/core/MOM_unit_tests.F90 | 4 ++++ src/framework/MOM_diag_manager_wrapper.F90 | 2 ++ src/ocean_data_assim/MOM_oda_driver.F90 | 3 +-- src/tracer/MOM_OCMIP2_CO2calc.F90 | 4 +--- src/tracer/MOM_offline_aux.F90 | 2 +- 5 files changed, 9 insertions(+), 6 deletions(-) diff --git a/src/core/MOM_unit_tests.F90 b/src/core/MOM_unit_tests.F90 index f3bd5fb76d..ff5a93a62c 100644 --- a/src/core/MOM_unit_tests.F90 +++ b/src/core/MOM_unit_tests.F90 @@ -10,6 +10,10 @@ module MOM_unit_tests use MOM_neutral_diffusion, only : neutral_diffusion_unit_tests use MOM_diag_vkernels, only : diag_vkernels_unit_tests +implicit none ; private + +public unit_tests + contains !> Calls unit tests for other modules. diff --git a/src/framework/MOM_diag_manager_wrapper.F90 b/src/framework/MOM_diag_manager_wrapper.F90 index 0274617d32..709fd80a8e 100644 --- a/src/framework/MOM_diag_manager_wrapper.F90 +++ b/src/framework/MOM_diag_manager_wrapper.F90 @@ -6,6 +6,8 @@ module MOM_diag_manager_wrapper use MOM_time_manager, only : time_type use diag_manager_mod, only : register_diag_field +implicit none ; private + public register_diag_field_fms !> A wrapper for register_diag_field_array() diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index de5a97363b..5935c1d230 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -66,8 +66,7 @@ module MOM_oda_driver_mod use MOM_regridding, only : regridding_CS, initialize_regridding use MOM_regridding, only : regridding_main, set_regrid_params - implicit none - private + implicit none ; private public :: init_oda, oda_end, set_prior_tracer, get_posterior_tracer public :: set_analysis_time, oda, save_obs_diff, apply_oda_tracer_increments diff --git a/src/tracer/MOM_OCMIP2_CO2calc.F90 b/src/tracer/MOM_OCMIP2_CO2calc.F90 index aa87c19e73..58b4adb380 100644 --- a/src/tracer/MOM_OCMIP2_CO2calc.F90 +++ b/src/tracer/MOM_OCMIP2_CO2calc.F90 @@ -29,9 +29,7 @@ module MOM_ocmip2_co2calc_mod !{ !------------------------------------------------------------------ ! -implicit none - -private +implicit none ; private public :: MOM_ocmip2_co2calc, CO2_dope_vector diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index deb395bc4a..45f01686c5 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -22,7 +22,7 @@ module MOM_offline_aux use MOM_diag_mediator, only : post_data use MOM_forcing_type, only : forcing -implicit none +implicit none ; private public update_offline_from_files public update_offline_from_arrays From 74b302a387f0f600a556f9a6fac0d54e71c86e95 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 11 May 2018 16:06:34 -0400 Subject: [PATCH 0250/1072] post_surface_dyn_diags & post_surface_thermo_diags Split post_surface_diagnostics into post_surface_dyn_diags and post_surface_thermo_diags, and call each of them only if appropriate. This corrects the NaNs described in https://github.com/NOAA-GFDL/MOM6/issues/767. All solutions are bitwise identical, but this can increase the frequencey with which the dynamics surface diagnostics are sent for output. --- src/core/MOM.F90 | 16 ++++--- src/diagnostics/MOM_diagnostics.F90 | 66 ++++++++++++++++++++--------- 2 files changed, 56 insertions(+), 26 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c1dcf4cf33..8ee4113f71 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -56,8 +56,8 @@ module MOM use MOM_diabatic_driver, only : adiabatic, adiabatic_driver_init, diabatic_driver_end use MOM_diagnostics, only : calculate_diagnostic_fields, MOM_diagnostics_init use MOM_diagnostics, only : register_transport_diags, post_transport_diagnostics -use MOM_diagnostics, only : register_surface_diags, post_surface_diagnostics -use MOM_diagnostics, only : write_static_fields +use MOM_diagnostics, only : register_surface_diags, write_static_fields +use MOM_diagnostics, only : post_surface_dyn_diags, post_surface_thermo_diags use MOM_diagnostics, only : diagnostics_CS, surface_diag_IDs, transport_diag_IDs use MOM_diag_to_Z, only : calculate_Z_diag_fields, register_Z_tracer use MOM_diag_to_Z, only : MOM_diag_to_Z_init, MOM_diag_to_Z_end, diag_to_Z_CS @@ -808,9 +808,15 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ! Do diagnostics that only occur at the end of a complete forcing step. if (cycle_end) then call cpu_clock_begin(id_clock_diagnostics) - call enable_averaging(CS%time_in_thermo_cycle, Time_local, CS%diag) - call post_surface_diagnostics(CS%sfc_IDs, G, GV, CS%diag, CS%time_in_thermo_cycle, & - sfc_state, CS%tv, ssh, CS%ave_ssh_ibc) + if (CS%time_in_cycle > 0.0) then + call enable_averaging(CS%time_in_cycle, Time_local, CS%diag) + call post_surface_dyn_diags(CS%sfc_IDs, G, CS%diag, sfc_state, ssh) + endif + if (CS%time_in_thermo_cycle > 0.0) then + call enable_averaging(CS%time_in_thermo_cycle, Time_local, CS%diag) + call post_surface_thermo_diags(CS%sfc_IDs, G, GV, CS%diag, CS%time_in_thermo_cycle, & + sfc_state, CS%tv, ssh, CS%ave_ssh_ibc) + endif call disable_averaging(CS%diag) call cpu_clock_end(id_clock_diagnostics) endif diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 8ceca4f691..b0d5d803e4 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -56,9 +56,9 @@ module MOM_diagnostics public calculate_diagnostic_fields, register_time_deriv, write_static_fields public find_eta -public MOM_diagnostics_init, MOM_diagnostics_end -public register_surface_diags, post_surface_diagnostics +public register_surface_diags, post_surface_dyn_diags, post_surface_thermo_diags public register_transport_diags, post_transport_diagnostics +public MOM_diagnostics_init, MOM_diagnostics_end type, public :: diagnostics_CS ; private real :: mono_N2_column_fraction = 0. !< The lower fraction of water column over which N2 is limited as @@ -1153,9 +1153,46 @@ subroutine calculate_derivs(dt, G, CS) end subroutine calculate_derivs +!> This routine posts diagnostics of various dynamic ocean surface quantities, +!! including velocities, speed and sea surface height, at the time the ocean +!! state is reported back to the caller +subroutine post_surface_dyn_diags(IDs, G, diag, sfc_state, ssh) + type(surface_diag_IDs), intent(in) :: IDs !< A structure with the diagnostic IDs. + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output + type(surface), intent(in) :: sfc_state !< structure describing the ocean surface state + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: ssh !< Time mean surface height without corrections for + !! ice displacement (m) + + real, dimension(SZI_(G),SZJ_(G)) :: work_2d ! A 2-d work array + integer :: i, j, is, ie, js, je + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + if (IDs%id_ssh > 0) & + call post_data(IDs%id_ssh, ssh, diag, mask=G%mask2dT) + + if (IDs%id_ssu > 0) & + call post_data(IDs%id_ssu, sfc_state%u, diag, mask=G%mask2dCu) + + if (IDs%id_ssv > 0) & + call post_data(IDs%id_ssv, sfc_state%v, diag, mask=G%mask2dCv) + + if (IDs%id_speed > 0) then + do j=js,je ; do i=is,ie + work_2d(i,j) = sqrt(0.5*(sfc_state%u(I-1,j)**2 + sfc_state%u(I,j)**2) + & + 0.5*(sfc_state%v(i,J-1)**2 + sfc_state%v(i,J)**2)) + enddo ; enddo + call post_data(IDs%id_speed, work_2d, diag, mask=G%mask2dT) + endif + +end subroutine post_surface_dyn_diags + + !> This routine posts diagnostics of various ocean surface and integrated !! quantities at the time the ocean state is reported back to the caller -subroutine post_surface_diagnostics(IDs, G, GV, diag, dt_int, sfc_state, tv, & +subroutine post_surface_thermo_diags(IDs, G, GV, diag, dt_int, sfc_state, tv, & ssh, ssh_ibc) type(surface_diag_IDs), intent(in) :: IDs !< A structure with the diagnostic IDs. type(ocean_grid_type), intent(in) :: G !< ocean grid structure @@ -1186,10 +1223,6 @@ subroutine post_surface_diagnostics(IDs, G, GV, diag, dt_int, sfc_state, tv, & call post_data(IDs%id_ssh_ga, ssh_ga, diag) endif - I_time_int = 1.0 / dt_int - if (IDs%id_ssh > 0) & - call post_data(IDs%id_ssh, ssh, diag, mask=G%mask2dT) - ! post the dynamic sea level, zos, and zossq. ! zos is ave_ssh with sea ice inverse barometer removed, ! and with zero global area mean. @@ -1220,6 +1253,9 @@ subroutine post_surface_diagnostics(IDs, G, GV, diag, dt_int, sfc_state, tv, & call post_data(IDs%id_volo, volo, diag) endif + ! Use Adcroft's rule of reciprocals; it does the right thing here. + I_time_int = 0.0 ; if (dt_int > 0.0) I_time_int = 1.0 / dt_int + ! post time-averaged rate of frazil formation if (associated(tv%frazil) .and. (IDs%id_fraz > 0)) then do j=js,je ; do i=is,ie @@ -1293,22 +1329,10 @@ subroutine post_surface_diagnostics(IDs, G, GV, diag, dt_int, sfc_state, tv, & call post_data(IDs%id_sss_sq, work_2d, diag, mask=G%mask2dT) endif - if (IDs%id_ssu > 0) & - call post_data(IDs%id_ssu, sfc_state%u, diag, mask=G%mask2dCu) - if (IDs%id_ssv > 0) & - call post_data(IDs%id_ssv, sfc_state%v, diag, mask=G%mask2dCv) - - if (IDs%id_speed > 0) then - do j=js,je ; do i=is,ie - work_2d(i,j) = sqrt(0.5*(sfc_state%u(I-1,j)**2 + sfc_state%u(I,j)**2) + & - 0.5*(sfc_state%v(i,J-1)**2 + sfc_state%v(i,J)**2)) - enddo ; enddo - call post_data(IDs%id_speed, work_2d, diag, mask=G%mask2dT) - endif - call coupler_type_send_data(sfc_state%tr_fields, get_diag_time_end(diag)) -end subroutine post_surface_diagnostics +end subroutine post_surface_thermo_diags + !> This routine posts diagnostics of the transports, including the subgridscale !! contributions. From 38d5fb89841116ad925dae5bce0b39d8f8b31196 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Fri, 11 May 2018 13:33:29 -0800 Subject: [PATCH 0251/1072] Kludge to avoid OBC feedback. - Stretch column height in remapping to ensure consistency between source and target total column height. - Also change string length in MOM_file_parser.F90. --- src/core/MOM_open_boundary.F90 | 9 ++++++++- src/framework/MOM_file_parser.F90 | 2 +- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index f762243aa9..ef40f0170c 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -2451,6 +2451,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) real, dimension(:,:,:), allocatable :: tmp_buffer real, dimension(:), allocatable :: h_stack integer :: is_obc2, js_obc2 + real :: net_H_src, net_H_int, scl_fac is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -2683,8 +2684,11 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) ! Pretty sure we need to check for source/target grid consistency here segment%field(m)%buffer_dst(I,j,:)=0.0 ! initialize remap destination buffer if (G%mask2dCu(I,j)>0.) then + net_H_src = sum( segment%field(m)%dz_src(I,j,:) ) + net_H_int = sum( h(i+ishift,j,:) ) + scl_fac = net_H_int / net_H_src call remapping_core_h(OBC%remap_CS, & - segment%field(m)%nk_src,segment%field(m)%dz_src(I,j,:), & + segment%field(m)%nk_src, scl_fac*segment%field(m)%dz_src(I,j,:), & segment%field(m)%buffer_src(I,j,:), & G%ke, h(i+ishift,j,:), segment%field(m)%buffer_dst(I,j,:)) endif @@ -2726,6 +2730,9 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) ! Pretty sure we need to check for source/target grid consistency here segment%field(m)%buffer_dst(i,J,:)=0.0 ! initialize remap destination buffer if (G%mask2dCv(i,J)>0.) then + net_H_src = sum( segment%field(m)%dz_src(i,J,:) ) + net_H_int = sum( h(i,j+jshift,:) ) + scl_fac = net_H_int / net_H_src call remapping_core_h(OBC%remap_CS, & segment%field(m)%nk_src,segment%field(m)%dz_src(i,J,:), & segment%field(m)%buffer_src(i,J,:), & diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index 5cf0417d09..e22b36e5cd 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -41,7 +41,7 @@ module MOM_file_parser implicit none ; private integer, parameter, public :: MAX_PARAM_FILES = 5 ! Maximum number of parameter files. -integer, parameter :: INPUT_STR_LENGTH = 200 ! Maximum linelength in parameter file. +integer, parameter :: INPUT_STR_LENGTH = 320 ! Maximum linelength in parameter file. integer, parameter :: FILENAME_LENGTH = 200 ! Maximum number of characters in ! file names. From bab60070600805b4fb72d8d1a0e5f43e5b52a638 Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Tue, 15 May 2018 11:14:27 -0400 Subject: [PATCH 0252/1072] fix get_posterior_tracer interface --- src/ocean_data_assim/MOM_oda_driver.F90 | 25 +------------------------ 1 file changed, 1 insertion(+), 24 deletions(-) diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 5935c1d230..b71a2bacf4 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -385,21 +385,14 @@ end subroutine set_prior_tracer !> Returns posterior adjustments or full state !!Note that only those PEs associated with an ensemble member receive data - subroutine get_posterior_tracer(Time, CS, G, GV, h, tv, increment) + subroutine get_posterior_tracer(Time, CS, h, tv, increment) type(time_type), intent(in) :: Time !< the current model time type(ODA_CS), pointer :: CS !< ocean DA control structure - type(ocean_grid_type), pointer :: G !< domain and grid information for ocean model - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(:,:,:), pointer :: h !< Layer thicknesses, in H (usually m or kg m-2) type(thermo_var_ptrs), pointer :: tv !< A structure pointing to various thermodynamic variables - logical, optional, intent(in) :: increment - type(ocean_grid_type), pointer :: Grid=>NULL() type(ocean_control_struct), pointer :: Ocean_increment=>NULL() - integer :: is, ie, js, je - integer :: isd, ied, jsd, jed - integer :: isc, iec, jsc, jec integer :: i, j, m logical :: used, get_inc @@ -420,7 +413,6 @@ subroutine get_posterior_tracer(Time, CS, G, GV, h, tv, increment) Ocean_increment%T = CS%Ocean_posterior%T - CS%Ocean_prior%T Ocean_increment%S = CS%Ocean_posterior%S - CS%Ocean_prior%S endif - isc=CS%Grid%isc;iec=CS%Grid%iec;jsc=CS%Grid%jsc;jec=CS%Grid%jec do m=1,CS%ensemble_size if (get_inc) then call mpp_redistribute(CS%mpp_domain, Ocean_increment%T(:,:,:,m), & @@ -433,21 +425,6 @@ subroutine get_posterior_tracer(Time, CS, G, GV, h, tv, increment) call mpp_redistribute(CS%mpp_domain, CS%Ocean_posterior%S(:,:,:,m), & CS%domains(m)%mpp_domain, CS%tv%S, complete=.true.) endif - - if (CS%Ocean_posterior%id_t(m)>0) then - if (get_inc) then - used=send_data(CS%Ocean_posterior%id_t(m), Ocean_increment%T(isc:iec,jsc:jec,:,m), CS%Time) - else - used=send_data(CS%Ocean_posterior%id_t(m), CS%Ocean_posterior%T(isc:iec,jsc:jec,:,m), CS%Time) - endif - endif - if (CS%Ocean_posterior%id_s(m)>0) then - if (get_inc) then - used=send_data(CS%Ocean_posterior%id_s(m), Ocean_increment%S(isc:iec,jsc:jec,:,m), CS%Time) - else - used=send_data(CS%Ocean_posterior%id_s(m), CS%Ocean_posterior%S(isc:iec,jsc:jec,:,m), CS%Time) - endif - endif enddo tv => CS%tv From bde57f32885d5286f4c33a7b500de4cc043db46e Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 15 May 2018 09:54:56 -0600 Subject: [PATCH 0253/1072] rm trailing whitespaces --- src/parameterizations/vertical/MOM_tidal_mixing.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 9321d3f68c..cb868d9e95 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -802,7 +802,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd) exp_hab_zetar = exp_hab_zetar, & zw = iFaceHeight, & CVmix_tidal_params_user = CS%CVMix_tidal_params) - !TODO: in above call, there is no need to pass efficiency, since it gets + !TODO: in above call, there is no need to pass efficiency, since it gets ! passed via CVMix_init_tidal and stored in CVMix_tidal_params. Change ! CVMix API to prevent this redundancy. From bfa2613ceaae65760c305cf8df0c0b6213638d49 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 15 May 2018 14:09:02 -0600 Subject: [PATCH 0254/1072] move KPP_compute_BLD to streamline merging --- src/parameterizations/vertical/MOM_KPP.F90 | 762 ++++++++++----------- 1 file changed, 381 insertions(+), 381 deletions(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index e479460ebe..804f3ebfb1 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -415,9 +415,10 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) end function KPP_init - -!> Compute OBL depth -subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) +!> KPP vertical diffusivity/viscosity and non-local tracer transport +subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & + buoyFlux, Kt, Ks, Kv, nonLocalTransHeat,& + nonLocalTransScalar) ! Arguments type(KPP_CS), pointer :: CS !< Control structure @@ -431,21 +432,31 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) type(EOS_type), pointer :: EOS !< Equation of state real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (m/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux (m2/s3) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP (m2/s) + !< (out) Vertical diffusivity including KPP (m2/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP (m2/s) + !< (out) Vertical diffusivity including KPP (m2/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP (m2/s) + !< (out) Vertical viscosity including KPP (m2/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport (m/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport (m/s) - ! Local variables - integer :: i, j, k, km1 ! Loop indices +! Local variables + integer :: i, j, k, km1,kp1 ! Loop indices real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) real, dimension( G%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces (1/s2) real, dimension( G%ke+1 ) :: N_1d ! Brunt-Vaisala frequency at interfaces (1/s) (floored at 0) real, dimension( G%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars (m/s) - !real, dimension( G%ke ) :: Wm_1d ! Profile of vertical velocity scale for momentum (m/s) + real, dimension( G%ke ) :: Wm_1d ! Profile of vertical velocity scale for momentum (m/s) real, dimension( G%ke ) :: Vt2_1d ! Unresolved velocity for bulk Ri calculation/diagnostic (m2/s2) + real, dimension( G%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer real, dimension( G%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number real, dimension( G%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri (m2/s2) + real, dimension( G%ke+1, 2) :: Kdiffusivity ! Vertical diffusivity at interfaces (m2/s) + real, dimension( G%ke+1 ) :: Kviscosity ! Vertical viscosity at interfaces (m2/s) real, dimension( G%ke+1, 2) :: nonLocalTrans ! Non-local transport for heat/salt at interfaces (non-dimensional) real, dimension( G%ke ) :: surfBuoyFlux2 - real, dimension( G%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer ! for EOS calculation real, dimension( 3*G%ke ) :: rho_1D @@ -453,10 +464,9 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) real, dimension( 3*G%ke ) :: Temp_1D real, dimension( 3*G%ke ) :: Salt_1D - real :: surfFricVel, surfBuoyFlux, Coriolis - real :: GoRho, pRef, rho1, rhoK, Uk, Vk, sigma + real :: surfFricVel, surfBuoyFlux + real :: GoRho, pRef, rho1, rhoK, rhoKm1, Uk, Vk, sigma - real :: zBottomMinusOffset ! Height of bottom plus a little bit (m) real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth. real :: hTot ! Running sum of thickness used in the surface layer average (m) real :: delH ! Thickness of a layer (m) @@ -468,20 +478,38 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) integer :: kk, ksfc, ktmp +#ifdef __DO_SAFETY_CHECKS__ + if (CS%debug) then + call hchksum(h, "KPP in: h",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(Temp, "KPP in: T",G%HI,haloshift=0) + call hchksum(Salt, "KPP in: S",G%HI,haloshift=0) + call hchksum(u, "KPP in: u",G%HI,haloshift=0) + call hchksum(v, "KPP in: v",G%HI,haloshift=0) + call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0) + call hchksum(buoyFlux, "KPP in: buoyFlux",G%HI,haloshift=0) + call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0) + call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0) + endif +#endif + ! some constants GoRho = GV%g_Earth / GV%Rho0 nonLocalTrans(:,:) = 0.0 + if (CS%id_Kd_in > 0) call post_data(CS%id_Kd_in, Kt, CS%diag) + !$OMP parallel do default(none) shared(G,GV,CS,EOS,uStar,Temp,Salt,u,v,h,GoRho, & -!$OMP buoyFlux) & -!$OMP private(Coriolis,surfFricVel,SLdepth_0d,hTot,surfTemp, & +!$OMP buoyFlux, nonLocalTransHeat, & +!$OMP nonLocalTransScalar,Kt,Ks,Kv) & +!$OMP firstprivate(nonLocalTrans) & +!$OMP private(surfFricVel,SLdepth_0d,hTot,surfTemp, & !$OMP surfHtemp,surfSalt,surfHsalt,surfU, & !$OMP surfHu,surfV,surfHv,iFaceHeight, & !$OMP pRef,km1,cellHeight,Uk,Vk,deltaU2, & -!$OMP rho1,rhoK,deltaRho,N2_1d,N_1d,delH, & -!$OMP surfBuoyFlux,Ws_1d,BulkRi_1d, & -!$OMP zBottomMinusOffset, & -!$OMP sigma,kk,pres_1D,Temp_1D, & +!$OMP rho1,rhoK,rhoKm1,deltaRho,N2_1d,N_1d,delH, & +!$OMP surfBuoyFlux,Ws_1d,Vt2_1d,BulkRi_1d, & +!$OMP Kdiffusivity, & +!$OMP Kviscosity,sigma,kk,pres_1D,Temp_1D, & !$OMP Salt_1D,rho_1D,surfBuoyFlux2,ksfc,dh,hcorr) ! loop over horizontal points on processor @@ -492,8 +520,6 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) if (G%mask2dT(i,j)==0.) cycle ! things independent of position within the column - Coriolis = 0.25*( (G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) & - +(G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1)) ) surfFricVel = uStar(i,j) ! Bullk Richardson number computed for each cell in a column, @@ -625,184 +651,199 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit ! h to Monin-Obukov (default is false, ie. not used) - call CVMix_kpp_compute_OBL_depth( & - BulkRi_1d, & ! (in) Bulk Richardson number - iFaceHeight, & ! (in) Height of interfaces (m) - CS%OBLdepth(i,j), & ! (out) OBL depth (m) - CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent - zt_cntr=cellHeight, & ! (in) Height of cell centers (m) - surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) - surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) - Coriolis=Coriolis, & ! (in) Coriolis parameter (1/s) - CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters - - ! A hack to avoid KPP reaching the bottom. It was needed during development - ! because KPP was unable to handle vanishingly small layers near the bottom. - if (CS%deepOBLoffset>0.) then - zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) - CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -zBottomMinusOffset ) - endif - - ! apply some constraints on OBLdepth - if(CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value - CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer - CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(G%ke+1) ) ! no deeper than bottom - CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) - -!************************************************************************* -! smg: remove code below - -! Following "correction" step has been found to be unnecessary. -! Code should be removed after further testing. - if (CS%correctSurfLayerAvg) then - - SLdepth_0d = CS%surf_layer_ext * CS%OBLdepth(i,j) - hTot = h(i,j,1) - surfTemp = Temp(i,j,1) ; surfHtemp = surfTemp * hTot - surfSalt = Salt(i,j,1) ; surfHsalt = surfSalt * hTot - surfU = 0.5*(u(i,j,1)+u(i-1,j,1)) ; surfHu = surfU * hTot - surfV = 0.5*(v(i,j,1)+v(i,j-1,1)) ; surfHv = surfV * hTot - pRef = 0.0 - - do k = 2, G%ke - ! Recalculate differences with surface layer - Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU - Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV - deltaU2(k) = Uk**2 + Vk**2 - pRef = pRef + GV%H_to_Pa * h(i,j,k) - call calculate_density(surfTemp, surfSalt, pRef, rho1, EOS) - call calculate_density(Temp(i,j,k), Salt(i,j,k), pRef, rhoK, EOS) - deltaRho(k) = rhoK - rho1 + ! Call CVMix/KPP to obtain OBL diffusivities, viscosities and non-local transports - ! Surface layer averaging (needed for next k+1 iteration of this loop) - if (hTot < SLdepth_0d) then - delH = min( max(0., SLdepth_0d - hTot), h(i,j,k)*GV%H_to_m ) - hTot = hTot + delH - surfHtemp = surfHtemp + Temp(i,j,k) * delH ; surfTemp = surfHtemp / hTot - surfHsalt = surfHsalt + Salt(i,j,k) * delH ; surfSalt = surfHsalt / hTot - surfHu = surfHu + 0.5*(u(i,j,k)+u(i-1,j,k)) * delH ; surfU = surfHu / hTot - surfHv = surfHv + 0.5*(v(i,j,k)+v(i,j-1,k)) * delH ; surfV = surfHv / hTot - endif + ! Unlike LMD94, we do not match to interior diffusivities. If using the original + ! LMD94 shape function, not matching is equivalent to matching to a zero diffusivity. - enddo + !BGR/ Add option for use of surface buoyancy flux with total sw flux. + if (CS%SW_METHOD .eq. SW_METHOD_ALL_SW) then + surfBuoyFlux = buoyFlux(i,j,1) + elseif (CS%SW_METHOD .eq. SW_METHOD_MXL_SW) then + surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,int(CS%kOBL(i,j))+1) ! We know the actual buoyancy flux into the OBL + elseif (CS%SW_METHOD .eq. SW_METHOD_LV1_SW) then + surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,2) + endif - BulkRi_1d = CVMix_kpp_compute_bulk_Richardson( & - cellHeight(1:G%ke), & ! Depth of cell center (m) - GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) (1/s) - deltaU2, & ! Square of resolved velocity difference (m2/s2) - ws_cntr=Ws_1d, & ! Turbulent velocity scale profile (m/s) - N_iface=N_1d ) ! Buoyancy frequency (1/s) + ! If option "MatchBoth" is selected in CVMix, MOM should be capable of matching. + if (.not. (CS%MatchTechnique.eq.'MatchBoth')) then + Kdiffusivity(:,:) = 0. ! Diffusivities for heat and salt (m2/s) + Kviscosity(:) = 0. ! Viscosity (m2/s) + else + Kdiffusivity(:,1) = Kt(i,j,:) + Kdiffusivity(:,2) = Ks(i,j,:) + Kviscosity(:)=Kv(i,j,:) + endif - surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit - ! h to Monin-Obukov (default is false, ie. not used) + call CVMix_coeffs_kpp(Kviscosity, & ! (inout) Total viscosity (m2/s) + Kdiffusivity(:,1), & ! (inout) Total heat diffusivity (m2/s) + Kdiffusivity(:,2), & ! (inout) Total salt diffusivity (m2/s) + iFaceHeight, & ! (in) Height of interfaces (m) + cellHeight, & ! (in) Height of level centers (m) + Kviscosity, & ! (in) Original viscosity (m2/s) + Kdiffusivity(:,1), & ! (in) Original heat diffusivity (m2/s) + Kdiffusivity(:,2), & ! (in) Original salt diffusivity (m2/s) + CS%OBLdepth(i,j), & ! (in) OBL depth (m) + CS%kOBL(i,j), & ! (in) level (+fraction) of OBL extent + nonLocalTrans(:,1),& ! (out) Non-local heat transport (non-dimensional) + nonLocalTrans(:,2),& ! (out) Non-local salt transport (non-dimensional) + surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) + surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) + G%ke, & ! (in) Number of levels to compute coeffs for + G%ke, & ! (in) Number of levels in array shape + CVMix_kpp_params_user=CS%KPP_params ) - call CVMix_kpp_compute_OBL_depth( & - BulkRi_1d, & ! (in) Bulk Richardson number - iFaceHeight, & ! (in) Height of interfaces (m) - CS%OBLdepth(i,j), & ! (out) OBL depth (m) - CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent - zt_cntr=cellHeight, & ! (in) Height of cell centers (m) - surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) - surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) - Coriolis=Coriolis, & ! (in) Coriolis parameter (1/s) - CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters - if (CS%deepOBLoffset>0.) then - zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) - CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -zBottomMinusOffset ) - CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) + ! Over-write CVMix NLT shape function with one of the following choices. + ! The CVMix code has yet to update for thse options, so we compute in MOM6. + ! Note that nonLocalTrans = Cs * G(sigma) (LMD94 notation), with + ! Cs = 6.32739901508. + ! Start do-loop at k=2, since k=1 is ocean surface (sigma=0) + ! and we do not wish to double-count the surface forcing. + ! Only compute nonlocal transport for 0 <= sigma <= 1. + ! MOM6 recommended shape is the parabolic; it gives deeper boundary layer + ! and no spurious extrema. + if (surfBuoyFlux < 0.0) then + if (CS%NLT_shape == NLT_SHAPE_CUBIC) then + do k = 2, G%ke + sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) + nonLocalTrans(k,1) = (1.0 - sigma)**2 * (1.0 + 2.0*sigma) !* + nonLocalTrans(k,2) = nonLocalTrans(k,1) + enddo + elseif (CS%NLT_shape == NLT_SHAPE_PARABOLIC) then + do k = 2, G%ke + sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) + nonLocalTrans(k,1) = (1.0 - sigma)**2 !*CS%CS2 + nonLocalTrans(k,2) = nonLocalTrans(k,1) + enddo + elseif (CS%NLT_shape == NLT_SHAPE_LINEAR) then + do k = 2, G%ke + sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) + nonLocalTrans(k,1) = (1.0 - sigma)!*CS%CS2 + nonLocalTrans(k,2) = nonLocalTrans(k,1) + enddo + elseif (CS%NLT_shape == NLT_SHAPE_CUBIC_LMD) then + ! Sanity check (should agree with CVMix result using simple matching) + do k = 2, G%ke + sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) + nonLocalTrans(k,1) = CS%CS2 * sigma*(1.0 -sigma)**2 + nonLocalTrans(k,2) = nonLocalTrans(k,1) + enddo endif + endif - ! apply some constraints on OBLdepth - if(CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value - CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer - CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(G%ke+1) ) ! no deep than bottom - CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) + ! we apply nonLocalTrans in subroutines + ! KPP_NonLocalTransport_temp and KPP_NonLocalTransport_saln + nonLocalTransHeat(i,j,:) = nonLocalTrans(:,1) ! temp + nonLocalTransScalar(i,j,:) = nonLocalTrans(:,2) ! saln - endif ! endif for "correction" step + ! set the KPP diffusivity and viscosity to zero for testing purposes + if(CS%KPPzeroDiffusivity) then + Kdiffusivity(:,1) = 0.0 + Kdiffusivity(:,2) = 0.0 + Kviscosity(:) = 0.0 + endif -! smg: remove code above -! ********************************************************************** + ! recompute wscale for diagnostics, now that we in fact know boundary layer depth + if (CS%id_Ws > 0) then + call CVMix_kpp_compute_turbulent_scales( & + -CellHeight/CS%OBLdepth(i,j), & ! (in) Normalized boundary layer coordinate + CS%OBLdepth(i,j), & ! (in) OBL depth (m) + surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) + surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) + w_s=Ws_1d, & ! (out) Turbulent velocity scale profile (m/s) + CVMix_kpp_params_user=CS%KPP_params & ! KPP parameters + ) + CS%Ws(i,j,:) = Ws_1d(:) + endif - enddo - enddo + ! compute unresolved squared velocity for diagnostics + if (CS%id_Vt2 > 0) then + Vt2_1d(:) = CVMix_kpp_compute_unresolved_shear( & + cellHeight(1:G%ke), & ! Depth of cell center (m) + ws_cntr=Ws_1d, & ! Turbulent velocity scale profile, at centers (m/s) + N_iface=N_1d, & ! Buoyancy frequency at interface (1/s) + CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters + CS%Vt2(i,j,:) = Vt2_1d(:) + endif - if (CS%smoothBLD) call KPP_smooth_BLD(CS,G,GV,h) - -end subroutine KPP_compute_BLD - - -!> Apply a 1-1-4-1-1 Laplacian filter one time on BLD to reduce any horizontal two-grid-point noise -subroutine KPP_smooth_BLD(CS,G,GV,h) - ! Arguments - type(KPP_CS), pointer :: CS !< Control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) - - ! local - real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) - real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) - integer :: i, j, k - real :: wc, ww, we, wn, ws ! averaging weights for smoothing - real :: dh ! The local thickness used for calculating interface positions (m) - real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) - - ! apply smoothing on OBL depth - do j = G%jsc, G%jec - do i = G%isc, G%iec - - ! skip land points - if (G%mask2dT(i,j)==0.) cycle - - ! compute weights - ww = 0.125 * G%mask2dT(i-1,j) - we = 0.125 * G%mask2dT(i+1,j) - ws = 0.125 * G%mask2dT(i,j-1) - wn = 0.125 * G%mask2dT(i,j+1) - wc = 1.0 - (ww+we+wn+ws) + ! Copy 1d data into 3d diagnostic arrays + if (CS%id_BulkDrho > 0) CS%dRho(i,j,:) = deltaRho(:) + if (CS%id_BulkUz2 > 0) CS%Uz2(i,j,:) = deltaU2(:) + if (CS%id_BulkRi > 0) CS%BulkRi(i,j,:) = BulkRi_1d(:) + if (CS%id_sigma > 0) then + CS%sigma(i,j,:) = 0. + if (CS%OBLdepth(i,j)>0.) CS%sigma(i,j,:) = -iFaceHeight/CS%OBLdepth(i,j) + endif + if (CS%id_N > 0) CS%N(i,j,:) = N_1d(:) + if (CS%id_N2 > 0) CS%N2(i,j,:) = N2_1d(:) + if (CS%id_Kt_KPP > 0) CS%Kt_KPP(i,j,:) = Kdiffusivity(:,1) + if (CS%id_Ks_KPP > 0) CS%Ks_KPP(i,j,:) = Kdiffusivity(:,2) + if (CS%id_Kv_KPP > 0) CS%Kv_KPP(i,j,:) = Kviscosity(:) + if (CS%id_Tsurf > 0) CS%Tsurf(i,j) = surfTemp + if (CS%id_Ssurf > 0) CS%Ssurf(i,j) = surfSalt + if (CS%id_Usurf > 0) CS%Usurf(i,j) = surfU + if (CS%id_Vsurf > 0) CS%Vsurf(i,j) = surfv - CS%OBLdepth(i,j) = wc * CS%OBLdepth(i,j) & - + ww * CS%OBLdepth(i-1,j) & - + we * CS%OBLdepth(i+1,j) & - + ws * CS%OBLdepth(i,j-1) & - + wn * CS%OBLdepth(i,j+1) - enddo - enddo - ! Update kOBL for smoothed OBL depths - do j = G%jsc, G%jec - do i = G%isc, G%iec + ! Update output of routine + if (.not. CS%passiveMode) then + if (CS%KPPisAdditive) then + do k=1, G%ke+1 + Kt(i,j,k) = Kt(i,j,k) + Kdiffusivity(k,1) + Ks(i,j,k) = Ks(i,j,k) + Kdiffusivity(k,2) + Kv(i,j,k) = Kv(i,j,k) + Kviscosity(k) + enddo + else ! KPP replaces prior diffusivity when former is non-zero + do k=1, G%ke+1 + if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = Kdiffusivity(k,1) + if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = Kdiffusivity(k,2) + if (Kviscosity(k) /= 0.) Kv(i,j,k) = Kviscosity(k) + enddo + endif + endif - ! skip land points - if (G%mask2dT(i,j)==0.) cycle - iFaceHeight(1) = 0.0 ! BBL is all relative to the surface - hcorr = 0. - do k=1,G%ke + ! end of the horizontal do-loops over the vertical columns + enddo ! i + enddo ! j - ! cell center and cell bottom in meters (negative values in the ocean) - dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment - dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) - hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 - dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness - cellHeight(k) = iFaceHeight(k) - 0.5 * dh - iFaceHeight(k+1) = iFaceHeight(k) - dh - enddo - CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) +#ifdef __DO_SAFETY_CHECKS__ + if (CS%debug) then + call hchksum(Kt, "KPP out: Kt",G%HI,haloshift=0) + call hchksum(Ks, "KPP out: Ks",G%HI,haloshift=0) + endif +#endif - enddo - enddo + ! send diagnostics to post_data + if (CS%id_OBLdepth > 0) call post_data(CS%id_OBLdepth, CS%OBLdepth, CS%diag) + if (CS%id_BulkDrho > 0) call post_data(CS%id_BulkDrho, CS%dRho, CS%diag) + if (CS%id_BulkUz2 > 0) call post_data(CS%id_BulkUz2, CS%Uz2, CS%diag) + if (CS%id_BulkRi > 0) call post_data(CS%id_BulkRi, CS%BulkRi, CS%diag) + if (CS%id_sigma > 0) call post_data(CS%id_sigma, CS%sigma, CS%diag) + if (CS%id_Ws > 0) call post_data(CS%id_Ws, CS%Ws, CS%diag) + if (CS%id_N > 0) call post_data(CS%id_N, CS%N, CS%diag) + if (CS%id_N2 > 0) call post_data(CS%id_N2, CS%N2, CS%diag) + if (CS%id_Vt2 > 0) call post_data(CS%id_Vt2, CS%Vt2, CS%diag) + if (CS%id_uStar > 0) call post_data(CS%id_uStar, uStar, CS%diag) + if (CS%id_buoyFlux > 0) call post_data(CS%id_buoyFlux, buoyFlux, CS%diag) + if (CS%id_Kt_KPP > 0) call post_data(CS%id_Kt_KPP, CS%Kt_KPP, CS%diag) + if (CS%id_Ks_KPP > 0) call post_data(CS%id_Ks_KPP, CS%Ks_KPP, CS%diag) + if (CS%id_Kv_KPP > 0) call post_data(CS%id_Kv_KPP, CS%Kv_KPP, CS%diag) + if (CS%id_NLTt > 0) call post_data(CS%id_NLTt, nonLocalTransHeat, CS%diag) + if (CS%id_NLTs > 0) call post_data(CS%id_NLTs, nonLocalTransScalar,CS%diag) + if (CS%id_Tsurf > 0) call post_data(CS%id_Tsurf, CS%Tsurf, CS%diag) + if (CS%id_Ssurf > 0) call post_data(CS%id_Ssurf, CS%Ssurf, CS%diag) + if (CS%id_Usurf > 0) call post_data(CS%id_Usurf, CS%Usurf, CS%diag) + if (CS%id_Vsurf > 0) call post_data(CS%id_Vsurf, CS%Vsurf, CS%diag) -end subroutine KPP_smooth_BLD +end subroutine KPP_calculate -!> KPP vertical diffusivity/viscosity and non-local tracer transport -subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & - buoyFlux, Kt, Ks, Kv, nonLocalTransHeat,& - nonLocalTransScalar) +!> Compute OBL depth +subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) ! Arguments type(KPP_CS), pointer :: CS !< Control structure @@ -816,31 +857,21 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & type(EOS_type), pointer :: EOS !< Equation of state real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (m/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux (m2/s3) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP (m2/s) - !< (out) Vertical diffusivity including KPP (m2/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP (m2/s) - !< (out) Vertical diffusivity including KPP (m2/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP (m2/s) - !< (out) Vertical viscosity including KPP (m2/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport (m/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport (m/s) -! Local variables - integer :: i, j, k, km1,kp1 ! Loop indices + ! Local variables + integer :: i, j, k, km1 ! Loop indices real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) real, dimension( G%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces (1/s2) real, dimension( G%ke+1 ) :: N_1d ! Brunt-Vaisala frequency at interfaces (1/s) (floored at 0) real, dimension( G%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars (m/s) - real, dimension( G%ke ) :: Wm_1d ! Profile of vertical velocity scale for momentum (m/s) + !real, dimension( G%ke ) :: Wm_1d ! Profile of vertical velocity scale for momentum (m/s) real, dimension( G%ke ) :: Vt2_1d ! Unresolved velocity for bulk Ri calculation/diagnostic (m2/s2) - real, dimension( G%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer real, dimension( G%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number real, dimension( G%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri (m2/s2) - real, dimension( G%ke+1, 2) :: Kdiffusivity ! Vertical diffusivity at interfaces (m2/s) - real, dimension( G%ke+1 ) :: Kviscosity ! Vertical viscosity at interfaces (m2/s) real, dimension( G%ke+1, 2) :: nonLocalTrans ! Non-local transport for heat/salt at interfaces (non-dimensional) real, dimension( G%ke ) :: surfBuoyFlux2 + real, dimension( G%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer ! for EOS calculation real, dimension( 3*G%ke ) :: rho_1D @@ -848,9 +879,10 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & real, dimension( 3*G%ke ) :: Temp_1D real, dimension( 3*G%ke ) :: Salt_1D - real :: surfFricVel, surfBuoyFlux - real :: GoRho, pRef, rho1, rhoK, rhoKm1, Uk, Vk, sigma + real :: surfFricVel, surfBuoyFlux, Coriolis + real :: GoRho, pRef, rho1, rhoK, Uk, Vk, sigma + real :: zBottomMinusOffset ! Height of bottom plus a little bit (m) real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth. real :: hTot ! Running sum of thickness used in the surface layer average (m) real :: delH ! Thickness of a layer (m) @@ -862,38 +894,20 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) integer :: kk, ksfc, ktmp -#ifdef __DO_SAFETY_CHECKS__ - if (CS%debug) then - call hchksum(h, "KPP in: h",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Temp, "KPP in: T",G%HI,haloshift=0) - call hchksum(Salt, "KPP in: S",G%HI,haloshift=0) - call hchksum(u, "KPP in: u",G%HI,haloshift=0) - call hchksum(v, "KPP in: v",G%HI,haloshift=0) - call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0) - call hchksum(buoyFlux, "KPP in: buoyFlux",G%HI,haloshift=0) - call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0) - call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0) - endif -#endif - ! some constants GoRho = GV%g_Earth / GV%Rho0 nonLocalTrans(:,:) = 0.0 - if (CS%id_Kd_in > 0) call post_data(CS%id_Kd_in, Kt, CS%diag) - !$OMP parallel do default(none) shared(G,GV,CS,EOS,uStar,Temp,Salt,u,v,h,GoRho, & -!$OMP buoyFlux, nonLocalTransHeat, & -!$OMP nonLocalTransScalar,Kt,Ks,Kv) & -!$OMP firstprivate(nonLocalTrans) & -!$OMP private(surfFricVel,SLdepth_0d,hTot,surfTemp, & +!$OMP buoyFlux) & +!$OMP private(Coriolis,surfFricVel,SLdepth_0d,hTot,surfTemp, & !$OMP surfHtemp,surfSalt,surfHsalt,surfU, & !$OMP surfHu,surfV,surfHv,iFaceHeight, & !$OMP pRef,km1,cellHeight,Uk,Vk,deltaU2, & -!$OMP rho1,rhoK,rhoKm1,deltaRho,N2_1d,N_1d,delH, & -!$OMP surfBuoyFlux,Ws_1d,Vt2_1d,BulkRi_1d, & -!$OMP Kdiffusivity, & -!$OMP Kviscosity,sigma,kk,pres_1D,Temp_1D, & +!$OMP rho1,rhoK,deltaRho,N2_1d,N_1d,delH, & +!$OMP surfBuoyFlux,Ws_1d,BulkRi_1d, & +!$OMP zBottomMinusOffset, & +!$OMP sigma,kk,pres_1D,Temp_1D, & !$OMP Salt_1D,rho_1D,surfBuoyFlux2,ksfc,dh,hcorr) ! loop over horizontal points on processor @@ -904,6 +918,8 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & if (G%mask2dT(i,j)==0.) cycle ! things independent of position within the column + Coriolis = 0.25*( (G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) & + +(G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1)) ) surfFricVel = uStar(i,j) ! Bullk Richardson number computed for each cell in a column, @@ -1035,195 +1051,179 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit ! h to Monin-Obukov (default is false, ie. not used) + call CVMix_kpp_compute_OBL_depth( & + BulkRi_1d, & ! (in) Bulk Richardson number + iFaceHeight, & ! (in) Height of interfaces (m) + CS%OBLdepth(i,j), & ! (out) OBL depth (m) + CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent + zt_cntr=cellHeight, & ! (in) Height of cell centers (m) + surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) + surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) + Coriolis=Coriolis, & ! (in) Coriolis parameter (1/s) + CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters - ! Call CVMix/KPP to obtain OBL diffusivities, viscosities and non-local transports + ! A hack to avoid KPP reaching the bottom. It was needed during development + ! because KPP was unable to handle vanishingly small layers near the bottom. + if (CS%deepOBLoffset>0.) then + zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) + CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -zBottomMinusOffset ) + endif - ! Unlike LMD94, we do not match to interior diffusivities. If using the original - ! LMD94 shape function, not matching is equivalent to matching to a zero diffusivity. + ! apply some constraints on OBLdepth + if(CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value + CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer + CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(G%ke+1) ) ! no deeper than bottom + CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) - !BGR/ Add option for use of surface buoyancy flux with total sw flux. - if (CS%SW_METHOD .eq. SW_METHOD_ALL_SW) then - surfBuoyFlux = buoyFlux(i,j,1) - elseif (CS%SW_METHOD .eq. SW_METHOD_MXL_SW) then - surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,int(CS%kOBL(i,j))+1) ! We know the actual buoyancy flux into the OBL - elseif (CS%SW_METHOD .eq. SW_METHOD_LV1_SW) then - surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,2) - endif +!************************************************************************* +! smg: remove code below - ! If option "MatchBoth" is selected in CVMix, MOM should be capable of matching. - if (.not. (CS%MatchTechnique.eq.'MatchBoth')) then - Kdiffusivity(:,:) = 0. ! Diffusivities for heat and salt (m2/s) - Kviscosity(:) = 0. ! Viscosity (m2/s) - else - Kdiffusivity(:,1) = Kt(i,j,:) - Kdiffusivity(:,2) = Ks(i,j,:) - Kviscosity(:)=Kv(i,j,:) - endif +! Following "correction" step has been found to be unnecessary. +! Code should be removed after further testing. + if (CS%correctSurfLayerAvg) then - call CVMix_coeffs_kpp(Kviscosity, & ! (inout) Total viscosity (m2/s) - Kdiffusivity(:,1), & ! (inout) Total heat diffusivity (m2/s) - Kdiffusivity(:,2), & ! (inout) Total salt diffusivity (m2/s) - iFaceHeight, & ! (in) Height of interfaces (m) - cellHeight, & ! (in) Height of level centers (m) - Kviscosity, & ! (in) Original viscosity (m2/s) - Kdiffusivity(:,1), & ! (in) Original heat diffusivity (m2/s) - Kdiffusivity(:,2), & ! (in) Original salt diffusivity (m2/s) - CS%OBLdepth(i,j), & ! (in) OBL depth (m) - CS%kOBL(i,j), & ! (in) level (+fraction) of OBL extent - nonLocalTrans(:,1),& ! (out) Non-local heat transport (non-dimensional) - nonLocalTrans(:,2),& ! (out) Non-local salt transport (non-dimensional) - surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) - surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) - G%ke, & ! (in) Number of levels to compute coeffs for - G%ke, & ! (in) Number of levels in array shape - CVMix_kpp_params_user=CS%KPP_params ) + SLdepth_0d = CS%surf_layer_ext * CS%OBLdepth(i,j) + hTot = h(i,j,1) + surfTemp = Temp(i,j,1) ; surfHtemp = surfTemp * hTot + surfSalt = Salt(i,j,1) ; surfHsalt = surfSalt * hTot + surfU = 0.5*(u(i,j,1)+u(i-1,j,1)) ; surfHu = surfU * hTot + surfV = 0.5*(v(i,j,1)+v(i,j-1,1)) ; surfHv = surfV * hTot + pRef = 0.0 + do k = 2, G%ke - ! Over-write CVMix NLT shape function with one of the following choices. - ! The CVMix code has yet to update for thse options, so we compute in MOM6. - ! Note that nonLocalTrans = Cs * G(sigma) (LMD94 notation), with - ! Cs = 6.32739901508. - ! Start do-loop at k=2, since k=1 is ocean surface (sigma=0) - ! and we do not wish to double-count the surface forcing. - ! Only compute nonlocal transport for 0 <= sigma <= 1. - ! MOM6 recommended shape is the parabolic; it gives deeper boundary layer - ! and no spurious extrema. - if (surfBuoyFlux < 0.0) then - if (CS%NLT_shape == NLT_SHAPE_CUBIC) then - do k = 2, G%ke - sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) - nonLocalTrans(k,1) = (1.0 - sigma)**2 * (1.0 + 2.0*sigma) !* - nonLocalTrans(k,2) = nonLocalTrans(k,1) - enddo - elseif (CS%NLT_shape == NLT_SHAPE_PARABOLIC) then - do k = 2, G%ke - sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) - nonLocalTrans(k,1) = (1.0 - sigma)**2 !*CS%CS2 - nonLocalTrans(k,2) = nonLocalTrans(k,1) - enddo - elseif (CS%NLT_shape == NLT_SHAPE_LINEAR) then - do k = 2, G%ke - sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) - nonLocalTrans(k,1) = (1.0 - sigma)!*CS%CS2 - nonLocalTrans(k,2) = nonLocalTrans(k,1) - enddo - elseif (CS%NLT_shape == NLT_SHAPE_CUBIC_LMD) then - ! Sanity check (should agree with CVMix result using simple matching) - do k = 2, G%ke - sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) - nonLocalTrans(k,1) = CS%CS2 * sigma*(1.0 -sigma)**2 - nonLocalTrans(k,2) = nonLocalTrans(k,1) - enddo + ! Recalculate differences with surface layer + Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU + Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV + deltaU2(k) = Uk**2 + Vk**2 + pRef = pRef + GV%H_to_Pa * h(i,j,k) + call calculate_density(surfTemp, surfSalt, pRef, rho1, EOS) + call calculate_density(Temp(i,j,k), Salt(i,j,k), pRef, rhoK, EOS) + deltaRho(k) = rhoK - rho1 + + ! Surface layer averaging (needed for next k+1 iteration of this loop) + if (hTot < SLdepth_0d) then + delH = min( max(0., SLdepth_0d - hTot), h(i,j,k)*GV%H_to_m ) + hTot = hTot + delH + surfHtemp = surfHtemp + Temp(i,j,k) * delH ; surfTemp = surfHtemp / hTot + surfHsalt = surfHsalt + Salt(i,j,k) * delH ; surfSalt = surfHsalt / hTot + surfHu = surfHu + 0.5*(u(i,j,k)+u(i-1,j,k)) * delH ; surfU = surfHu / hTot + surfHv = surfHv + 0.5*(v(i,j,k)+v(i,j-1,k)) * delH ; surfV = surfHv / hTot + endif + + enddo + + BulkRi_1d = CVMix_kpp_compute_bulk_Richardson( & + cellHeight(1:G%ke), & ! Depth of cell center (m) + GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) (1/s) + deltaU2, & ! Square of resolved velocity difference (m2/s2) + ws_cntr=Ws_1d, & ! Turbulent velocity scale profile (m/s) + N_iface=N_1d ) ! Buoyancy frequency (1/s) + + surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit + ! h to Monin-Obukov (default is false, ie. not used) + + call CVMix_kpp_compute_OBL_depth( & + BulkRi_1d, & ! (in) Bulk Richardson number + iFaceHeight, & ! (in) Height of interfaces (m) + CS%OBLdepth(i,j), & ! (out) OBL depth (m) + CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent + zt_cntr=cellHeight, & ! (in) Height of cell centers (m) + surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) + surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) + Coriolis=Coriolis, & ! (in) Coriolis parameter (1/s) + CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters + + if (CS%deepOBLoffset>0.) then + zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) + CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -zBottomMinusOffset ) + CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) endif - endif - ! we apply nonLocalTrans in subroutines - ! KPP_NonLocalTransport_temp and KPP_NonLocalTransport_saln - nonLocalTransHeat(i,j,:) = nonLocalTrans(:,1) ! temp - nonLocalTransScalar(i,j,:) = nonLocalTrans(:,2) ! saln + ! apply some constraints on OBLdepth + if(CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value + CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer + CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(G%ke+1) ) ! no deep than bottom + CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) - ! set the KPP diffusivity and viscosity to zero for testing purposes - if(CS%KPPzeroDiffusivity) then - Kdiffusivity(:,1) = 0.0 - Kdiffusivity(:,2) = 0.0 - Kviscosity(:) = 0.0 - endif + endif ! endif for "correction" step - ! recompute wscale for diagnostics, now that we in fact know boundary layer depth - if (CS%id_Ws > 0) then - call CVMix_kpp_compute_turbulent_scales( & - -CellHeight/CS%OBLdepth(i,j), & ! (in) Normalized boundary layer coordinate - CS%OBLdepth(i,j), & ! (in) OBL depth (m) - surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) - surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) - w_s=Ws_1d, & ! (out) Turbulent velocity scale profile (m/s) - CVMix_kpp_params_user=CS%KPP_params & ! KPP parameters - ) - CS%Ws(i,j,:) = Ws_1d(:) - endif +! smg: remove code above +! ********************************************************************** - ! compute unresolved squared velocity for diagnostics - if (CS%id_Vt2 > 0) then - Vt2_1d(:) = CVMix_kpp_compute_unresolved_shear( & - cellHeight(1:G%ke), & ! Depth of cell center (m) - ws_cntr=Ws_1d, & ! Turbulent velocity scale profile, at centers (m/s) - N_iface=N_1d, & ! Buoyancy frequency at interface (1/s) - CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters - CS%Vt2(i,j,:) = Vt2_1d(:) - endif + enddo + enddo - ! Copy 1d data into 3d diagnostic arrays - if (CS%id_BulkDrho > 0) CS%dRho(i,j,:) = deltaRho(:) - if (CS%id_BulkUz2 > 0) CS%Uz2(i,j,:) = deltaU2(:) - if (CS%id_BulkRi > 0) CS%BulkRi(i,j,:) = BulkRi_1d(:) - if (CS%id_sigma > 0) then - CS%sigma(i,j,:) = 0. - if (CS%OBLdepth(i,j)>0.) CS%sigma(i,j,:) = -iFaceHeight/CS%OBLdepth(i,j) - endif - if (CS%id_N > 0) CS%N(i,j,:) = N_1d(:) - if (CS%id_N2 > 0) CS%N2(i,j,:) = N2_1d(:) - if (CS%id_Kt_KPP > 0) CS%Kt_KPP(i,j,:) = Kdiffusivity(:,1) - if (CS%id_Ks_KPP > 0) CS%Ks_KPP(i,j,:) = Kdiffusivity(:,2) - if (CS%id_Kv_KPP > 0) CS%Kv_KPP(i,j,:) = Kviscosity(:) - if (CS%id_Tsurf > 0) CS%Tsurf(i,j) = surfTemp - if (CS%id_Ssurf > 0) CS%Ssurf(i,j) = surfSalt - if (CS%id_Usurf > 0) CS%Usurf(i,j) = surfU - if (CS%id_Vsurf > 0) CS%Vsurf(i,j) = surfv + if (CS%smoothBLD) call KPP_smooth_BLD(CS,G,GV,h) +end subroutine KPP_compute_BLD - ! Update output of routine - if (.not. CS%passiveMode) then - if (CS%KPPisAdditive) then - do k=1, G%ke+1 - Kt(i,j,k) = Kt(i,j,k) + Kdiffusivity(k,1) - Ks(i,j,k) = Ks(i,j,k) + Kdiffusivity(k,2) - Kv(i,j,k) = Kv(i,j,k) + Kviscosity(k) - enddo - else ! KPP replaces prior diffusivity when former is non-zero - do k=1, G%ke+1 - if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = Kdiffusivity(k,1) - if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = Kdiffusivity(k,2) - if (Kviscosity(k) /= 0.) Kv(i,j,k) = Kviscosity(k) - enddo - endif - endif +!> Apply a 1-1-4-1-1 Laplacian filter one time on BLD to reduce any horizontal two-grid-point noise +subroutine KPP_smooth_BLD(CS,G,GV,h) + ! Arguments + type(KPP_CS), pointer :: CS !< Control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) - ! end of the horizontal do-loops over the vertical columns - enddo ! i - enddo ! j + ! local + real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) + real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) + integer :: i, j, k + real :: wc, ww, we, wn, ws ! averaging weights for smoothing + real :: dh ! The local thickness used for calculating interface positions (m) + real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) + ! apply smoothing on OBL depth + do j = G%jsc, G%jec + do i = G%isc, G%iec -#ifdef __DO_SAFETY_CHECKS__ - if (CS%debug) then - call hchksum(Kt, "KPP out: Kt",G%HI,haloshift=0) - call hchksum(Ks, "KPP out: Ks",G%HI,haloshift=0) - endif -#endif + ! skip land points + if (G%mask2dT(i,j)==0.) cycle - ! send diagnostics to post_data - if (CS%id_OBLdepth > 0) call post_data(CS%id_OBLdepth, CS%OBLdepth, CS%diag) - if (CS%id_BulkDrho > 0) call post_data(CS%id_BulkDrho, CS%dRho, CS%diag) - if (CS%id_BulkUz2 > 0) call post_data(CS%id_BulkUz2, CS%Uz2, CS%diag) - if (CS%id_BulkRi > 0) call post_data(CS%id_BulkRi, CS%BulkRi, CS%diag) - if (CS%id_sigma > 0) call post_data(CS%id_sigma, CS%sigma, CS%diag) - if (CS%id_Ws > 0) call post_data(CS%id_Ws, CS%Ws, CS%diag) - if (CS%id_N > 0) call post_data(CS%id_N, CS%N, CS%diag) - if (CS%id_N2 > 0) call post_data(CS%id_N2, CS%N2, CS%diag) - if (CS%id_Vt2 > 0) call post_data(CS%id_Vt2, CS%Vt2, CS%diag) - if (CS%id_uStar > 0) call post_data(CS%id_uStar, uStar, CS%diag) - if (CS%id_buoyFlux > 0) call post_data(CS%id_buoyFlux, buoyFlux, CS%diag) - if (CS%id_Kt_KPP > 0) call post_data(CS%id_Kt_KPP, CS%Kt_KPP, CS%diag) - if (CS%id_Ks_KPP > 0) call post_data(CS%id_Ks_KPP, CS%Ks_KPP, CS%diag) - if (CS%id_Kv_KPP > 0) call post_data(CS%id_Kv_KPP, CS%Kv_KPP, CS%diag) - if (CS%id_NLTt > 0) call post_data(CS%id_NLTt, nonLocalTransHeat, CS%diag) - if (CS%id_NLTs > 0) call post_data(CS%id_NLTs, nonLocalTransScalar,CS%diag) - if (CS%id_Tsurf > 0) call post_data(CS%id_Tsurf, CS%Tsurf, CS%diag) - if (CS%id_Ssurf > 0) call post_data(CS%id_Ssurf, CS%Ssurf, CS%diag) - if (CS%id_Usurf > 0) call post_data(CS%id_Usurf, CS%Usurf, CS%diag) - if (CS%id_Vsurf > 0) call post_data(CS%id_Vsurf, CS%Vsurf, CS%diag) + ! compute weights + ww = 0.125 * G%mask2dT(i-1,j) + we = 0.125 * G%mask2dT(i+1,j) + ws = 0.125 * G%mask2dT(i,j-1) + wn = 0.125 * G%mask2dT(i,j+1) + wc = 1.0 - (ww+we+wn+ws) + + CS%OBLdepth(i,j) = wc * CS%OBLdepth(i,j) & + + ww * CS%OBLdepth(i-1,j) & + + we * CS%OBLdepth(i+1,j) & + + ws * CS%OBLdepth(i,j-1) & + + wn * CS%OBLdepth(i,j+1) + enddo + enddo + + ! Update kOBL for smoothed OBL depths + do j = G%jsc, G%jec + do i = G%isc, G%iec + + ! skip land points + if (G%mask2dT(i,j)==0.) cycle + + iFaceHeight(1) = 0.0 ! BBL is all relative to the surface + hcorr = 0. + do k=1,G%ke + + ! cell center and cell bottom in meters (negative values in the ocean) + dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) + hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 + dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness + cellHeight(k) = iFaceHeight(k) - 0.5 * dh + iFaceHeight(k+1) = iFaceHeight(k) - dh + enddo + + CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) + + enddo + enddo + +end subroutine KPP_smooth_BLD -end subroutine KPP_calculate !> Copies KPP surface boundary layer depth into BLD From 91e459a99e22c91ed4950af5f2c3817fbfed8311 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 15 May 2018 15:12:31 -0600 Subject: [PATCH 0255/1072] 2/2 - merge with candidate may15 --- src/parameterizations/vertical/MOM_KPP.F90 | 142 +++++++++++++++++---- 1 file changed, 114 insertions(+), 28 deletions(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 82cfc1c8fb..6ae93013ac 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -688,6 +688,8 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & surfHu =0.0 surfHv =0.0 surfHuS =0.0 + surfHuS =0.0 + surfHvS =0.0 surfHvS =0.0 hTot =0.0 do ktmp = 1,ksfc @@ -918,7 +920,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & Kdiffusivity(k,2) = Kdiffusivity(k,2) * LangEnhK Kviscosity(k) = Kviscosity(k) * LangEnhK elseif (CS%LT_K_SHAPE == LT_K_SCALED) then - sigma = min(1.0,-iFaceHeight(k)/OBLdepth_0d) + sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) SigmaRatio = sigma * (1. - sigma)**2. / 0.148148037 if (CS%id_EnhK > 0) CS%EnhK(i,j,k) = (1.0 + (LangEnhK - 1.)*sigmaRatio) Kdiffusivity(k,1) = Kdiffusivity(k,1) * ( 1. + & @@ -1087,19 +1089,20 @@ end subroutine KPP_calculate !> Compute OBL depth -subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) +subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux, Waves) ! Arguments - type(KPP_CS), pointer :: CS !< Control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< potential/cons temp (deg C) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< Salinity (ppt) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Velocity i-component (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Velocity j-component (m/s) - type(EOS_type), pointer :: EOS !< Equation of state - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (m/s) + type(KPP_CS), pointer :: CS !< Control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< potential/cons temp (deg C) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< Salinity (ppt) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Velocity i-component (m/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Velocity j-component (m/s) + type(EOS_type), pointer :: EOS !< Equation of state + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (m/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux (m2/s3) ! Local variables @@ -1124,7 +1127,7 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) real, dimension( 3*G%ke ) :: Salt_1D real :: surfFricVel, surfBuoyFlux, Coriolis - real :: GoRho, pRef, rho1, rhoK, Uk, Vk, sigma + real :: GoRho, pRef, rho1, rhoK, Uk, Vk, sigma, sigmaRatio real :: zBottomMinusOffset ! Height of bottom plus a little bit (m) real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth. @@ -1138,21 +1141,24 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) integer :: kk, ksfc, ktmp + ! For Langmuir Calculations + real :: LangEnhW ! Langmuir enhancement for turbulent velocity scale + real, dimension(G%ke) :: LangEnhVt2 ! Langmuir enhancement for unresolved shear + real, dimension(G%ke) :: U_H, V_H + real :: MLD_GUESS, LA + real :: LangEnhK ! Langmuir enhancement for mixing coefficient + real :: surfHuS, surfHvS, surfUs, surfVs, wavedir, currentdir + real :: VarUp, VarDn, M, VarLo, VarAvg + real :: H10pct, H20pct,CMNFACT, USx20pct, USy20pct + integer :: B + real :: WST + ! some constants GoRho = GV%g_Earth / GV%Rho0 nonLocalTrans(:,:) = 0.0 -!$OMP parallel do default(none) shared(G,GV,CS,EOS,uStar,Temp,Salt,u,v,h,GoRho, & -!$OMP buoyFlux) & -!$OMP private(Coriolis,surfFricVel,SLdepth_0d,hTot,surfTemp, & -!$OMP surfHtemp,surfSalt,surfHsalt,surfU, & -!$OMP surfHu,surfV,surfHv,iFaceHeight, & -!$OMP pRef,km1,cellHeight,Uk,Vk,deltaU2, & -!$OMP rho1,rhoK,deltaRho,N2_1d,N_1d,delH, & -!$OMP surfBuoyFlux,Ws_1d,BulkRi_1d, & -!$OMP zBottomMinusOffset, & -!$OMP sigma,kk,pres_1D,Temp_1D, & -!$OMP Salt_1D,rho_1D,surfBuoyFlux2,ksfc,dh,hcorr) +!$OMP parallel do default(private) shared(G,GV,CS,EOS,uStar,Temp,Salt,u,v,h,GoRho, & +!$OMP Waves,buoyFlux) & ! loop over horizontal points on processor do j = G%jsc, G%jec @@ -1161,6 +1167,11 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) ! skip calling KPP for land points if (G%mask2dT(i,j)==0.) cycle + do k=1,G%ke + U_H(k) = 0.5 * (U(i,j,k)+U(i-1,j,k)) + V_H(k) = 0.5 * (V(i,j,k)+V(i,j-1,k)) + enddo + ! things independent of position within the column Coriolis = 0.25*( (G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) & +(G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1)) ) @@ -1201,6 +1212,8 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) surfHsalt=0.0 surfHu =0.0 surfHv =0.0 + surfHuS =0.0 + surfHvS =0.0 hTot =0.0 do ktmp = 1,ksfc @@ -1215,18 +1228,33 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) surfHsalt = surfHsalt + Salt(i,j,ktmp) * delH surfHu = surfHu + 0.5*(u(i,j,ktmp)+u(i-1,j,ktmp)) * delH surfHv = surfHv + 0.5*(v(i,j,ktmp)+v(i,j-1,ktmp)) * delH + if (CS%Stokes_Mixing) then + surfHus = surfHus + 0.5*(WAVES%US_x(i,j,ktmp)+WAVES%US_x(i-1,j,ktmp)) * delH + surfHvs = surfHvs + 0.5*(WAVES%US_y(i,j,ktmp)+WAVES%US_y(i,j-1,ktmp)) * delH + endif enddo surfTemp = surfHtemp / hTot surfSalt = surfHsalt / hTot surfU = surfHu / hTot surfV = surfHv / hTot + surfUs = surfHus / hTot + surfVs = surfHvs / hTot ! vertical shear between present layer and ! surface layer averaged surfU,surfV. ! C-grid average to get Uk and Vk on T-points. Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV + + if (CS%Stokes_Mixing) then + ! If momentum is mixed down the Stokes drift gradient, then + ! the Stokes drift must be included in the bulk Richardson number + ! calculation. + Uk = Uk + (0.5*(Waves%Us_x(i,j,k)+Waves%US_x(i-1,j,k)) -surfUs ) + Vk = Vk + (0.5*(Waves%Us_y(i,j,k)+Waves%Us_y(i,j-1,k)) -surfVs ) + endif + deltaU2(k) = Uk**2 + Vk**2 ! pressure, temp, and saln for EOS @@ -1254,6 +1282,19 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) enddo ! k-loop finishes + if (CS%LT_K_ENHANCEMENT .or. CS%LT_VT2_ENHANCEMENT) then + if (.not.(present(WAVES).and.associated(WAVES))) then + call MOM_error(FATAL,"Trying to use input WAVES information in KPP\n"//& + "without activating USEWAVES") + endif + !For now get Langmuir number based on prev. MLD (otherwise must compute 3d LA) + MLD_GUESS = max( 1., abs(CS%OBLdepthprev(i,j) ) ) + call get_Langmuir_Number( LA, G, GV, MLD_guess, surfFricVel, I, J, & + H=H(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES) + WAVES%LangNum(i,j)=LA + endif + + ! compute in-situ density call calculate_density(Temp_1D, Salt_1D, pres_1D, rho_1D, 1, 3*G%ke, EOS) @@ -1283,11 +1324,56 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) w_s=Ws_1d, & ! (out) Turbulent velocity scale profile (m/s) CVMix_kpp_params_user=CS%KPP_params ) + !Compute CVMix VT2 + Vt2_1d(:) = CVmix_kpp_compute_unresolved_shear( & + zt_cntr=cellHeight(1:G%ke), & ! Depth of cell center (m) + ws_cntr=Ws_1d, & ! Turbulent velocity scale profile, at centers (m/s) + N_iface=N_1d, & ! Buoyancy frequency at interface (1/s) + CVmix_kpp_params_user=CS%KPP_params ) ! KPP parameters + + !Modify CVMix VT2 + IF (CS%LT_VT2_ENHANCEMENT) then + IF (CS%LT_VT2_METHOD==LT_VT2_MODE_CONSTANT) then + do k=1,G%ke + LangEnhVT2(k) = CS%KPP_VT2_ENH_FAC + enddo + elseif (CS%LT_VT2_METHOD==LT_VT2_MODE_VR12) then + do k=1,G%ke + LangEnhVT2(k) = min(10.,sqrt(1.+(1.5*WAVES%LangNum(i,j))**(-2) + & + (5.4*WAVES%LangNum(i,j))**(-4))) + enddo + elseif (CS%LT_VT2_METHOD==LT_VT2_MODE_RW16) then + do k=1,G%ke + LangEnhVT2(k) = min(2.25, 1. + 1./WAVES%LangNum(i,j)) + enddo + elseif (CS%LT_VT2_METHOD==LT_VT2_MODE_LF17) then + CS%CS=cvmix_get_kpp_real('c_s',CS%KPP_params) + do k=1,G%ke + WST = (max(0.,-buoyflux(i,j,1))*(-cellHeight(k)))**(1./3.) + LangEnhVT2(k) = sqrt((0.15*WST**3. + 0.17*surfFricVel**3.* & + (1.+0.49*WAVES%LangNum(i,j)**(-2.))) / & + (0.2*ws_1d(k)**3/(CS%cs*CS%surf_layer_ext*CS%vonKarman**4.))) + enddo + else + !This shouldn't be reached. + !call MOM_error(WARNING,"Unexpected behavior in MOM_KPP, see error in Vt2") + LangEnhVT2(:) = 1.0 + endif + else + LangEnhVT2(:) = 1.0 + endif + + do k=1,G%ke + Vt2_1d(k)=Vt2_1d(k)*LangEnhVT2(k) + if (CS%id_EnhVt2 > 0) CS%EnhVt2(i,j,k)=LangEnhVT2(k) + enddo + ! Calculate Bulk Richardson number from eq (21) of LMD94 - BulkRi_1d = CVMix_kpp_compute_bulk_Richardson( & - cellHeight(1:G%ke), & ! Depth of cell center (m) - GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) (1/s) - deltaU2, & ! Square of resolved velocity difference (m2/s2) + BulkRi_1d = CVmix_kpp_compute_bulk_Richardson( & + zt_cntr = cellHeight(1:G%ke), & ! Depth of cell center (m) + delta_buoy_cntr=GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) (1/s) + delta_Vsqr_cntr=deltaU2, & ! Square of resolved velocity difference (m2/s2) + Vt_sqr_cntr=Vt2_1d, & ws_cntr=Ws_1d, & ! Turbulent velocity scale profile (m/s) N_iface=N_1d) ! Buoyancy frequency (1/s) From 90e8f930b1e50ba0b8e3f12c8e00f68a8136978d Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 16 May 2018 10:06:48 -0600 Subject: [PATCH 0256/1072] Update halo OBLdepth before smoothing --- src/parameterizations/vertical/MOM_KPP.F90 | 27 ++++++++++++++-------- 1 file changed, 17 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 6ae93013ac..f98185685a 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -14,6 +14,7 @@ module MOM_KPP use MOM_grid, only : ocean_grid_type, isPointInCell use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only : wave_parameters_CS, Get_Langmuir_Number +use MOM_domains, only : pass_var use CVMix_kpp, only : CVMix_init_kpp, CVMix_put_kpp, CVMix_get_kpp_real use CVMix_kpp, only : CVMix_coeffs_kpp @@ -1503,12 +1504,18 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) ! local - real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) - real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) + real, dimension(SZI_(G),SZJ_(G)) :: OBLdepth_original ! Original OBL depths computed by CVMix + real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) + real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) + real :: wc, ww, we, wn, ws ! averaging weights for smoothing + real :: dh ! The local thickness used for calculating interface positions (m) + real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) integer :: i, j, k - real :: wc, ww, we, wn, ws ! averaging weights for smoothing - real :: dh ! The local thickness used for calculating interface positions (m) - real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) + + ! Update halos + call pass_var(CS%OBLdepth, G%Domain) + + OBLdepth_original = CS%OBLdepth ! apply smoothing on OBL depth do j = G%jsc, G%jec @@ -1524,11 +1531,11 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) wn = 0.125 * G%mask2dT(i,j+1) wc = 1.0 - (ww+we+wn+ws) - CS%OBLdepth(i,j) = wc * CS%OBLdepth(i,j) & - + ww * CS%OBLdepth(i-1,j) & - + we * CS%OBLdepth(i+1,j) & - + ws * CS%OBLdepth(i,j-1) & - + wn * CS%OBLdepth(i,j+1) + CS%OBLdepth(i,j) = wc * OBLdepth_original(i,j) & + + ww * OBLdepth_original(i-1,j) & + + we * OBLdepth_original(i+1,j) & + + ws * OBLdepth_original(i,j-1) & + + wn * OBLdepth_original(i,j+1) enddo enddo From 02acd12398eec40a2f55b73ecfcdbaaa37d8e6b8 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 16 May 2018 16:11:13 -0600 Subject: [PATCH 0257/1072] Doxygenize subroutine differential_diffuse_T_S --- .../vertical/MOM_diabatic_aux.F90 | 22 ++++++------------- 1 file changed, 7 insertions(+), 15 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 9588ac3a5c..82799d531a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -239,25 +239,17 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf) end subroutine make_frazil +!> Applies double diffusion to T & S, assuming no diapycal mass +!! fluxes, using a simple triadiagonal solver. subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(inout) :: tv - type(vertvisc_type), intent(in) :: visc - real, intent(in) :: dt - -! This subroutine applies double diffusion to T & S, assuming no diapycal mass -! fluxes, using a simple triadiagonal solver. - -! Arguments: h - Layer thickness, in m or kg m-2. -! (in) tv - A structure containing pointers to any available -! thermodynamic fields. Absent fields have NULL ptrs. -! (in) visc - A structure containing vertical viscosities, bottom boundary -! layer properies, and related fields. -! (in) dt - Time increment, in s. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. + type(thermo_var_ptrs), intent(inout) :: tv !< pointers to any available modynamic fields. + !! Absent fields have NULL ptrs. + type(vertvisc_type), intent(in) :: visc !< structure containing vertical viscosities, + !! layer properies, and related fields. + real, intent(in) :: dt !< Time increment, in s. real, dimension(SZI_(G)) :: & b1_T, b1_S, & ! Variables used by the tridiagonal solvers of T & S, in H. From 724b5896fabe13737cc05baa741fc2e14b2b4a80 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 16 May 2018 16:07:55 -0800 Subject: [PATCH 0258/1072] Insufficient testing of N-S OBCs for all options. --- src/core/MOM_open_boundary.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index ef40f0170c..38eb78b89a 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1814,10 +1814,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) J=segment%HI%JsdB allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) do k=1,nz - rx_tangential(segment%HI%IsdB,J,k) = segment%rx_normal(segment%HI%isd,J,k) - rx_tangential(segment%HI%IedB,J,k) = segment%rx_normal(segment%HI%ied,J,k) + rx_tangential(segment%HI%IsdB,J,k) = segment%ry_normal(segment%HI%isd,J,k) + rx_tangential(segment%HI%IedB,J,k) = segment%ry_normal(segment%HI%ied,J,k) do I=segment%HI%IsdB+1,segment%HI%IedB-1 - rx_tangential(I,J,k) = 0.5*(segment%rx_normal(i,J,k) + segment%rx_normal(i+1,J,k)) + rx_tangential(I,J,k) = 0.5*(segment%ry_normal(i,J,k) + segment%ry_normal(i+1,J,k)) enddo enddo if (segment%radiation_tan) then @@ -1925,10 +1925,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) J=segment%HI%JsdB allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) do k=1,nz - rx_tangential(segment%HI%IsdB,J,k) = segment%rx_normal(segment%HI%isd,J,k) - rx_tangential(segment%HI%IedB,J,k) = segment%rx_normal(segment%HI%ied,J,k) + rx_tangential(segment%HI%IsdB,J,k) = segment%ry_normal(segment%HI%isd,J,k) + rx_tangential(segment%HI%IedB,J,k) = segment%ry_normal(segment%HI%ied,J,k) do I=segment%HI%IsdB+1,segment%HI%IedB-1 - rx_tangential(I,J,k) = 0.5*(segment%rx_normal(i,J,k) + segment%rx_normal(i+1,J,k)) + rx_tangential(I,J,k) = 0.5*(segment%ry_normal(i,J,k) + segment%ry_normal(i+1,J,k)) enddo enddo if (segment%radiation_tan) then From 4dd011148127f7da24c7d4b9ccfc7e87d0d65084 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 16 May 2018 18:08:27 -0600 Subject: [PATCH 0259/1072] add original OBLdepth diag --- src/parameterizations/vertical/MOM_KPP.F90 | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index f98185685a..185be4f0b4 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -134,10 +134,12 @@ module MOM_KPP integer :: id_NLT_temp_budget = -1 integer :: id_NLT_saln_budget = -1 integer :: id_EnhK = -1, id_EnhW = -1, id_EnhVt2 = -1 + integer :: id_OBLdepth_original = -1 ! Diagnostics arrays real, allocatable, dimension(:,:) :: OBLdepth !< Depth (positive) of OBL (m) + real, allocatable, dimension(:,:) :: OBLdepth_original !< Depth (positive) of OBL (m) without smoothing real, allocatable, dimension(:,:) :: kOBL !< Level (+fraction) of OBL extent real, allocatable, dimension(:,:) :: OBLdepthprev !< previous Depth (positive) of OBL (m) real, allocatable, dimension(:,:,:) :: dRho !< Bulk difference in density (kg/m3) @@ -437,6 +439,10 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive, Waves) ! CMOR names are placeholders; must be modified by time period ! for CMOR compliance. Diag manager will be used for omlmax and ! omldamax. + CS%id_OBLdepth_original = register_diag_field('ocean_model', 'KPP_OBLdepth_original', diag%axesT1, Time, & + 'Thickness of the surface Ocean Boundary Layer without smoothing calculated by [CVMix] KPP', 'meter', & + cmor_field_name='oml', cmor_long_name='ocean_mixed_layer_thickness_defined_by_mixing_scheme', & + cmor_units='m', cmor_standard_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme') CS%id_BulkDrho = register_diag_field('ocean_model', 'KPP_BulkDrho', diag%axesTL, Time, & 'Bulk difference in density used in Bulk Richardson number, as used by [CVMix] KPP', 'kg/m3') CS%id_BulkUz2 = register_diag_field('ocean_model', 'KPP_BulkUz2', diag%axesTL, Time, & @@ -498,6 +504,7 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive, Waves) CS%OBLdepth(:,:) = 0. allocate( CS%kOBL( SZI_(G), SZJ_(G) ) ) CS%kOBL(:,:) = 0. + if (CS%id_OBLdepth_original > 0) allocate( CS%OBLdepth_original( SZI_(G), SZJ_(G) ) ) allocate( CS%OBLdepthprev( SZI_(G), SZJ_(G) ) );CS%OBLdepthprev(:,:)=0.0 if (CS%id_BulkDrho > 0) allocate( CS%dRho( SZI_(G), SZJ_(G), SZK_(G) ) ) @@ -1063,6 +1070,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & ! send diagnostics to post_data if (CS%id_OBLdepth > 0) call post_data(CS%id_OBLdepth, CS%OBLdepth, CS%diag) + if (CS%id_OBLdepth_original > 0) call post_data(CS%id_OBLdepth_original,CS%OBLdepth_original,CS%diag) if (CS%id_BulkDrho > 0) call post_data(CS%id_BulkDrho, CS%dRho, CS%diag) if (CS%id_BulkUz2 > 0) call post_data(CS%id_BulkUz2, CS%Uz2, CS%diag) if (CS%id_BulkRi > 0) call post_data(CS%id_BulkRi, CS%BulkRi, CS%diag) @@ -1516,6 +1524,7 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) call pass_var(CS%OBLdepth, G%Domain) OBLdepth_original = CS%OBLdepth + CS%OBLdepth_original = OBLdepth_original ! apply smoothing on OBL depth do j = G%jsc, G%jec From cfc6742025f71fdadef9c9ebc2effdfced6504cc Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 17 May 2018 15:07:12 -0600 Subject: [PATCH 0260/1072] prevent OBL depths deeper than the bathymetric depth --- src/parameterizations/vertical/MOM_KPP.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 185be4f0b4..da59d487cc 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -1548,6 +1548,9 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) enddo enddo + ! prevent OBL depths deeper than the bathymetric depth + where (CS%OBLdepth > G%bathyT) CS%OBLdepth = G%bathyT + ! Update kOBL for smoothed OBL depths do j = G%jsc, G%jec do i = G%isc, G%iec From 0a2470cd13f2c2439968d076ebbcbcd9bb18fbf1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 17 May 2018 17:53:54 -0400 Subject: [PATCH 0261/1072] *)Corrected ISOMIP with mech_forcing type structure Corrected the code setting p_surf in MOM_ice_shelf so that the ISOMIP test case gives the same answers before and after a separate mec_forcing type structure was added. This restores the answers in two ISOMIP test cases to the previous commit. --- src/ice_shelf/MOM_ice_shelf.F90 | 44 +++++++++++++++++++-------------- 1 file changed, 26 insertions(+), 18 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 82cb951a7a..01a7519bd6 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -30,6 +30,7 @@ module MOM_ice_shelf use MOM_variables, only : surface use MOM_forcing_type, only : forcing, allocate_forcing_type, MOM_forcing_chksum use MOM_forcing_type, only : mech_forcing, allocate_mech_forcing, MOM_mech_forcing_chksum +use MOM_forcing_type, only : copy_common_forcing_fields use MOM_get_input, only : directories, Get_MOM_input use MOM_EOS, only : calculate_density, calculate_density_derivs, calculate_TFreeze use MOM_EOS, only : EOS_type, EOS_init @@ -456,7 +457,7 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) if (CS%shelf_mass_is_dynamic .and. CS%override_shelf_movement) then CS%time_step = time_step ! update shelf mass - if (CS%mass_from_file) call update_shelf_mass(G, CS, Time, fluxes) + if (CS%mass_from_file) call update_shelf_mass(G, CS, Time, fluxes, forces) endif if (CS%DEBUG) then @@ -880,7 +881,6 @@ subroutine change_thickness_using_melt(CS,G,time_step, fluxes) if (associated(fluxes%lprec)) fluxes%lprec(i,j) = 0.0 if (associated(fluxes%sens)) fluxes%sens(i,j) = 0.0 if (associated(fluxes%frac_shelf_h)) fluxes%frac_shelf_h(i,j) = 0.0 - if (associated(fluxes%p_surf)) fluxes%p_surf(i,j) = 0.0 if (associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = 0.0 if (CS%lprec(i,j) / CS%density_ice * time_step .lt. CS%h_shelf (i,j)) then @@ -1060,9 +1060,9 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) if (associated(fluxes%sens)) fluxes%sens(i,j) = -frac_area*CS%t_flux(i,j)*CS%flux_factor if (associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = frac_area * CS%salt_flux(i,j)*CS%flux_factor - if (associated(fluxes%p_surf)) fluxes%p_surf(i,j) = frac_area * CS%g_Earth * CS%mass_shelf(i,j) + if (associated(forces%p_surf)) forces%p_surf(i,j) = frac_area * CS%g_Earth * CS%mass_shelf(i,j) ! Same for IOB%p - if (associated(fluxes%p_surf_full) ) fluxes%p_surf_full(i,j) = & + if (associated(forces%p_surf_full) ) forces%p_surf_full(i,j) = & frac_area * CS%g_Earth * CS%mass_shelf(i,j) endif @@ -1177,6 +1177,8 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) enddo ; enddo endif + call copy_common_forcing_fields(forces, fluxes, G) + end subroutine add_shelf_flux @@ -1792,14 +1794,18 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl endif if (present(fluxes)) then if (G%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = CS%area_shelf_h(i,j) / G%areaT(i,j) - if (associated(fluxes%p_surf)) & - fluxes%p_surf(i,j) = fluxes%p_surf(i,j) + & + endif + if (present(forces)) then + if (associated(forces%p_surf)) & + forces%p_surf(i,j) = forces%p_surf(i,j) + & fluxes%frac_shelf_h(i,j) * (CS%g_Earth * CS%mass_shelf(i,j)) - if (associated(fluxes%p_surf_full)) & - fluxes%p_surf_full(i,j) = fluxes%p_surf_full(i,j) + & + if (associated(forces%p_surf_full)) & + forces%p_surf_full(i,j) = forces%p_surf_full(i,j) + & fluxes%frac_shelf_h(i,j) * (CS%g_Earth * CS%mass_shelf(i,j)) endif enddo ; enddo + if (present(fluxes) .and. present(forces)) & + call copy_common_forcing_fields(forces, fluxes, G) if (CS%DEBUG) then call hchksum (fluxes%frac_shelf_h, "IS init: frac_shelf_h", G%HI, haloshift=0) @@ -2061,11 +2067,12 @@ subroutine initialize_shelf_mass(G, param_file, CS, new_sim) end subroutine initialize_shelf_mass !> Updates the ice shelf mass using data from a file. -subroutine update_shelf_mass(G, CS, Time, fluxes) +subroutine update_shelf_mass(G, CS, Time, fluxes, forces) type(ocean_grid_type), intent(inout) :: G type(ice_shelf_CS), pointer :: CS type(time_type), intent(in) :: Time type(forcing), intent(inout) :: fluxes + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces ! local variables integer :: i, j, is, ie, js, je @@ -2085,7 +2092,7 @@ subroutine update_shelf_mass(G, CS, Time, fluxes) if (associated(fluxes%lprec)) fluxes%lprec(i,j) = 0.0 if (associated(fluxes%sens)) fluxes%sens(i,j) = 0.0 if (associated(fluxes%frac_shelf_h)) fluxes%frac_shelf_h(i,j) = 0.0 - if (associated(fluxes%p_surf)) fluxes%p_surf(i,j) = 0.0 + if (associated(forces%p_surf)) forces%p_surf(i,j) = 0.0 if (associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = 0.0 endif CS%area_shelf_h(i,j) = 0.0 @@ -2110,16 +2117,17 @@ subroutine update_shelf_mass(G, CS, Time, fluxes) call pass_var(CS%mass_shelf, G%domain) - ! update psurf and frac_shelf_h in fluxes + ! update psurf in forces and frac_shelf_h in fluxes do j=js,je ; do i=is,ie - if (associated(fluxes%p_surf)) & - fluxes%p_surf(i,j) = (CS%g_Earth * CS%mass_shelf(i,j)) - if (associated(fluxes%p_surf_full)) & - fluxes%p_surf_full(i,j) = (CS%g_Earth * CS%mass_shelf(i,j)) + if (associated(forces%p_surf)) & + forces%p_surf(i,j) = (CS%g_Earth * CS%mass_shelf(i,j)) + if (associated(forces%p_surf_full)) & + forces%p_surf_full(i,j) = (CS%g_Earth * CS%mass_shelf(i,j)) if (G%areaT(i,j) > 0.0) & fluxes%frac_shelf_h(i,j) = CS%area_shelf_h(i,j) / G%areaT(i,j) enddo ; enddo + call copy_common_forcing_fields(forces, fluxes, G) end subroutine update_shelf_mass @@ -6872,11 +6880,11 @@ end subroutine ice_shelf_advect_temp_y ! ! Same for -1*IOB%t_flux ! ! fluxes%salt_flux(i,j) = fluxes%salt_flux(i,j) + frac_area * CS%salt_flux(i,j) ! ! ! Same for IOB%salt_flux. -! fluxes%p_surf(i,j) = fluxes%p_surf(i,j) + & +! forces%p_surf(i,j) = forces%p_surf(i,j) + & ! frac_area * CS%g_Earth * CS%mass_shelf(i,j) ! ! Same for IOB%p -! if (associated(fluxes%p_surf_full)) fluxes%p_surf_full(i,j) = & -! fluxes%p_surf_full(i,j) + frac_area * CS%g_Earth * CS%mass_shelf(i,j) +! if (associated(forces%p_surf_full)) forces%p_surf_full(i,j) = & +! forces%p_surf_full(i,j) + frac_area * CS%g_Earth * CS%mass_shelf(i,j) ! endif ! enddo ; enddo From 507d34e350a3566cfd68bf15899f889f1b955e63 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 17 May 2018 16:35:53 -0600 Subject: [PATCH 0262/1072] First version of Double-diffusion via CVMix * Delete the old double-diffusion code --- .../vertical/MOM_cvmix_ddiff.F90 | 314 ++++++++++++++++++ .../vertical/MOM_diabatic_driver.F90 | 26 +- .../vertical/MOM_set_diffusivity.F90 | 282 +++------------- .../vertical/MOM_set_viscosity.F90 | 18 +- 4 files changed, 384 insertions(+), 256 deletions(-) create mode 100644 src/parameterizations/vertical/MOM_cvmix_ddiff.F90 diff --git a/src/parameterizations/vertical/MOM_cvmix_ddiff.F90 b/src/parameterizations/vertical/MOM_cvmix_ddiff.F90 new file mode 100644 index 0000000000..8e52c39849 --- /dev/null +++ b/src/parameterizations/vertical/MOM_cvmix_ddiff.F90 @@ -0,0 +1,314 @@ +!> Interface to CVMix double diffusion scheme. +module MOM_CVMix_ddiff + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field +use MOM_diag_mediator, only : post_data +use MOM_EOS, only : calculate_density_derivs +use MOM_variables, only : thermo_var_ptrs +use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE +use MOM_file_parser, only : openParameterBlock, closeParameterBlock +use MOM_debugging, only : hchksum +use MOM_grid, only : ocean_grid_type +use MOM_verticalGrid, only : verticalGrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use cvmix_ddiff, only : cvmix_init_ddiff, CVMix_coeffs_ddiff +use cvmix_kpp, only : CVmix_kpp_compute_kOBL_depth +implicit none ; private + +#include + +public CVMix_ddiff_init, CVMix_ddiff_end, CVMix_ddiff_is_used, compute_ddiff_coeffs + +!> Control structure including parameters for CVMix double diffusion. +type, public :: CVMix_ddiff_cs + + ! Parameters + real :: strat_param_max !< maximum value for the stratification parameter (nondim) + real :: kappa_ddiff_s !< leading coefficient in formula for salt-fingering regime + !! for salinity diffusion (m^2/s) + real :: ddiff_exp1 !< interior exponent in salt-fingering regime formula (nondim) + real :: ddiff_exp2 !< exterior exponent in salt-fingering regime formula (nondim) + real :: mol_diff !< molecular diffusivity (m^2/s) + real :: kappa_ddiff_param1 !< exterior coefficient in diffusive convection regime (nondim) + real :: kappa_ddiff_param2 !< middle coefficient in diffusive convection regime (nondim) + real :: kappa_ddiff_param3 !< interior coefficient in diffusive convection regime (nondim) + real :: min_thickness !< Minimum thickness allowed (m) + character(len=4) :: diff_conv_type !< type of diffusive convection to use. Options are Marmorino & + !! Caldwell 1976 ("MC76"; default) and Kelley 1988, 1990 ("K90") + logical :: debug !< If true, turn on debugging + + ! Daignostic handles and pointers + type(diag_ctrl), pointer :: diag => NULL() + integer :: id_KT_extra = -1, id_KS_extra = -1, id_R_rho = -1 + + ! Diagnostics arrays + real, allocatable, dimension(:,:,:) :: KT_extra !< double diffusion diffusivity for temp (m2/s) + real, allocatable, dimension(:,:,:) :: KS_extra !< double diffusion diffusivity for salt (m2/s) + real, allocatable, dimension(:,:,:) :: R_rho !< double-diffusion density ratio (nondim) + +end type CVMix_ddiff_cs + +character(len=40) :: mdl = "MOM_CVMix_ddiff" !< This module's name. + +contains + +!> Initialized the CVMix double diffusion module. +logical function CVMix_ddiff_init(Time, G, GV, param_file, diag, CS) + + type(time_type), intent(in) :: Time !< The current time. + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle + type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. + type(CVMix_ddiff_cs), pointer :: CS !< This module's control structure. + + ! Local variables +! real :: prandtl_conv !< Turbulent Prandtl number used in convective instabilities. + +! This include declares and sets the variable "version". +#include "version_variable.h" + + if (associated(CS)) then + call MOM_error(WARNING, "CVMix_ddiff_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + + ! Read parameters + call log_version(param_file, mdl, version, & + "Parameterization of mixing due to double diffusion processes via CVMix") + call get_param(param_file, mdl, "USE_CVMIX_DDIFF", CVMix_ddiff_init, & + "If true, turns on double diffusive processes via CVMix. \n"// & + "Note that double diffusive processes on viscosity are ignored \n"// & + "in CVMix, see http://cvmix.github.io/ for justification.",& + default=.false.) + + if (.not. CVMix_ddiff_init) return + + call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) + + call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, default=0.001, do_not_log=.True.) + + call openParameterBlock(param_file,'CVMIX_DDIFF') + + call get_param(param_file, mdl, "STRAT_PARAM_MAX", CS%strat_param_max, & + "The maximum value for the double dissusion stratification parameter", & + units="nondim", default=2.55) + + call get_param(param_file, mdl, "KAPPA_DDIFF_S", CS%kappa_ddiff_s, & + "Leading coefficient in formula for salt-fingering regime \n"// & + "for salinity diffusion.", units="m2 s-1", default=1.0e-4) + + call get_param(param_file, mdl, "DDIFF_EXP1", CS%ddiff_exp1, & + "Interior exponent in salt-fingering regime formula.", & + units="nondim", default=1.0) + + call get_param(param_file, mdl, "DDIFF_EXP2", CS%ddiff_exp2, & + "Exterior exponent in salt-fingering regime formula.", & + units="nondim", default=3.0) + + call get_param(param_file, mdl, "KAPPA_DDIFF_PARAM1", CS%kappa_ddiff_param1, & + "Exterior coefficient in diffusive convection regime.", & + units="nondim", default=0.909) + + call get_param(param_file, mdl, "KAPPA_DDIFF_PARAM2", CS%kappa_ddiff_param2, & + "Middle coefficient in diffusive convection regime.", & + units="nondim", default=4.6) + + call get_param(param_file, mdl, "KAPPA_DDIFF_PARAM3", CS%kappa_ddiff_param3, & + "Interior coefficient in diffusive convection regime.", & + units="nondim", default=-0.54) + + call get_param(param_file, mdl, "MOL_DIFF", CS%mol_diff, & + "Molecular diffusivity used in CVMix double diffusion.", & + units="m2 s-1", default=1.5e-6) + + call get_param(param_file, mdl, "DIFF_CONV_TYPE", CS%diff_conv_type, & + "type of diffusive convection to use. Options are Marmorino \n" //& + "and Caldwell 1976 (MC76) and Kelley 1988, 1990 (K90).", & + default="MC76") + + call closeParameterBlock(param_file) + + ! allocate arrays and set them to zero + ! GMM, dont need the following + !allocate(CS%KT_extra(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%KT_extra(:,:,:) = 0. + !allocate(CS%KS_extra(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%KS_extra(:,:,:) = 0. + + ! Register diagnostics + CS%diag => diag + + CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & + 'Double-diffusive diffusivity for temperature', 'm2 s-1') + + CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & + 'Double-diffusive diffusivity for salinity', 'm2 s-1') + + CS%id_R_rho = register_diag_field('ocean_model','R_rho',diag%axesTi,Time, & + 'Double-diffusion density ratio', 'nondim') + if (CS%id_R_rho > 0) & + allocate(CS%R_rho( SZI_(G), SZJ_(G), SZK_(G)+1)); CS%R_rho(:,:,:) = 0.0 + + call cvmix_init_ddiff(strat_param_max=CS%strat_param_max, & + kappa_ddiff_s=CS%kappa_ddiff_s, & + ddiff_exp1=CS%ddiff_exp1, & + ddiff_exp2=CS%ddiff_exp2, & + mol_diff=CS%mol_diff, & + kappa_ddiff_param1=CS%kappa_ddiff_param1, & + kappa_ddiff_param2=CS%kappa_ddiff_param2, & + kappa_ddiff_param3=CS%kappa_ddiff_param3, & + diff_conv_type=CS%diff_conv_type) + +end function CVMix_ddiff_init + +!> Subroutine for computing vertical diffusion coefficients for the +!! double diffusion mixing parameterization. +subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) + + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_T !< Interface double diffusion diapycnal +! real, dimension(:,:,:), pointer :: Kd_T +! real, dimension(:,:,:), pointer :: Kd_S + !! diffusivity for temp (m2/sec). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_S !< Interface double diffusion diapycnal + !! diffusivity for salt (m2/sec). + type(CVMix_ddiff_cs), pointer :: CS !< The control structure returned + !! by a previous call to CVMix_ddiff_init. + integer, intent(in) :: j !< Meridional grid indice. +! real, dimension(:,:), optional, pointer :: hbl !< Depth of ocean boundary layer (m) + + ! local variables + real, dimension(SZK_(G)) :: & + cellHeight, & !< Height of cell centers (m) + dRho_dT, & !< partial derivatives of density wrt temp (kg m-3 degC-1) + dRho_dS, & !< partial derivatives of density wrt saln (kg m-3 PPT-1) + pres_int, & !< pressure at each interface (Pa) + temp_int, & !< temp and at interfaces (degC) + salt_int, & !< salt at at interfaces + alpha_dT, & !< alpha*dT across interfaces + beta_dS, & !< beta*dS across interfaces + dT, & !< temp. difference between adjacent layers (degC) + dS !< salt difference between adjacent layers + + real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) + integer :: kOBL !< level of OBL extent + real :: pref, g_o_rho0, rhok, rhokm1, dz, dh, hcorr + integer :: i, k + + ! initialize dummy variables + pres_int(:) = 0.0; temp_int(:) = 0.0; salt_int(:) = 0.0 + alpha_dT(:) = 0.0; beta_dS(:) = 0.0; dRho_dT(:) = 0.0 + dRho_dS(:) = 0.0; dT(:) = 0.0; dS(:) = 0.0 + + ! set Kd_T and Kd_S to zero to avoid passing values from previous call + Kd_T(:,j,:) = 0.0; Kd_S(:,j,:) = 0.0 + + ! GMM, check this. + !if (.not. associated(hbl)) then + ! allocate(hbl(SZI_(G), SZJ_(G))); + ! hbl(:,:) = 0.0 + !endif + + do i = G%isc, G%iec + + ! skip calling at land points + if (G%mask2dT(i,j) == 0.) cycle + + pRef = 0. + pres_int(1) = pRef + ! we don't have SST and SSS, so let's use values at top-most layer + temp_int(1) = TV%T(i,j,1); salt_int(1) = TV%S(i,j,1) + do k=2,G%ke + ! pressure at interface + pres_int(k) = pRef + GV%H_to_Pa * h(i,j,k-1) + ! temp and salt at interface + ! for temp: (t1*h1 + t2*h2)/(h1+h2) + temp_int(k) = (TV%T(i,j,k-1)*h(i,j,k-1) + TV%T(i,j,k)*h(i,j,k))/(h(i,j,k-1)+h(i,j,k)) + salt_int(k) = (TV%S(i,j,k-1)*h(i,j,k-1) + TV%S(i,j,k)*h(i,j,k))/(h(i,j,k-1)+h(i,j,k)) + ! dT and dS + dT(k) = (TV%T(i,j,k-1)-TV%T(i,j,k)) + dS(k) = (TV%S(i,j,k-1)-TV%S(i,j,k)) + pRef = pRef + GV%H_to_Pa * h(i,j,k-1) + enddo ! k-loop finishes + + call calculate_density_derivs(temp_int(:), salt_int(:), pres_int(:), drho_dT(:), drho_dS(:), 1, G%ke, TV%EQN_OF_STATE) + + ! GMM, explain need for -1 in front of alpha + ! if ((alpha_dT > beta_dS) .and. (beta_dS > 0.0)) then ! salt finger case + ! if ((alpha_dT < 0.) .and. (beta_dS < 0.) .and. (alpha_dT > beta_dS)) then ! diffusive convection + do k=1,G%ke + alpha_dT(k) = -1.0*drho_dT(k) * dT(k) + beta_dS(k) = drho_dS(k) * dS(k) + enddo + + if (CS%id_R_rho > 0.0) then + do k=1,G%ke + CS%R_rho(i,j,k) = alpha_dT(k)/beta_dS(k) + enddo + endif + + iFaceHeight(1) = 0.0 ! BBL is all relative to the surface + hcorr = 0.0 + ! compute heights at cell center and interfaces + do k=1,G%ke + dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) + hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 + dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness + cellHeight(k) = iFaceHeight(k) - 0.5 * dh + iFaceHeight(k+1) = iFaceHeight(k) - dh + enddo + + ! gets index of the level and interface above hbl + !kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl(i,j)) + + call CVMix_coeffs_ddiff(Tdiff_out=Kd_T(i,j,:), & + Sdiff_out=Kd_S(i,j,:), & + strat_param_num=alpha_dT(:), & + strat_param_denom=beta_dS(:), & + nlev=G%ke, & + max_nlev=G%ke) + + !if (is_root_pe()) then + ! write(*,*)'drho_dT, alpha_dT', & + ! drho_dT(:), alpha_dT(:) + ! write(*,*)'drho_dS, beta_dS', & + ! drho_dS(:), beta_dS(:) + !endif + + ! Do not apply mixing due to convection within the boundary layer + !do k=1,kOBL + ! Kd_T(i,j,k) = 0.0 + ! Kd_S(i,j,k) = 0.0 + !enddo + + enddo ! i-loop + +end subroutine compute_ddiff_coeffs + +!> Reads the parameter "USE_CVMIX_DDIFF" and returns state. +!! This function allows other modules to know whether this parameterization will +!! be used without needing to duplicate the log entry. +logical function CVMix_ddiff_is_used(param_file) + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + call get_param(param_file, mdl, "USE_CVMIX_DDIFF", CVMix_ddiff_is_used, & + default=.false., do_not_log = .true.) + +end function CVMix_ddiff_is_used + +!> Clear pointers and dealocate memory +subroutine CVMix_ddiff_end(CS) + type(CVMix_ddiff_cs), pointer :: CS ! Control structure + + deallocate(CS) + +end subroutine CVMix_ddiff_end + + +end module MOM_CVMix_ddiff diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index eea1eba16a..b109d3642a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -9,7 +9,8 @@ module MOM_diabatic_driver use MOM_checksum_packages, only : MOM_state_chksum, MOM_state_stats use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE -use MOM_CVMix_shear, only : cvmix_shear_is_used +use MOM_CVMix_shear, only : CVMix_shear_is_used +use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used use MOM_diabatic_aux, only : diabatic_aux_init, diabatic_aux_end, diabatic_aux_CS use MOM_diabatic_aux, only : make_frazil, adjust_salt, insert_brine, differential_diffuse_T_S, triDiagTS use MOM_diabatic_aux, only : find_uv_at_h, diagnoseMLDbyDensityDifference, applyBoundaryFluxesInOut @@ -90,8 +91,9 @@ module MOM_diabatic_driver !! in the surface boundary layer. logical :: use_kappa_shear !< If true, use the kappa_shear module to find the !! shear-driven diapycnal diffusivity. - logical :: use_cvmix_shear !< If true, use the CVMix module to find the + logical :: use_CVMix_shear !< If true, use the CVMix module to find the !! shear-driven diapycnal diffusivity. + logical :: use_CVMix_ddiff !< If true, use the CVMix double diffusion module. logical :: use_tidal_mixing !< If true, activate tidal mixing diffusivity. logical :: use_cvmix_conv !< If true, use the CVMix module to get enhanced !! mixing due to convection. @@ -244,7 +246,7 @@ module MOM_diabatic_driver integer :: id_clock_entrain, id_clock_mixedlayer, id_clock_set_diffusivity integer :: id_clock_tracers, id_clock_tridiag, id_clock_pass, id_clock_sponge integer :: id_clock_geothermal, id_clock_differential_diff, id_clock_remap -integer :: id_clock_kpp +integer :: id_clock_kpp, id_clock_CVMix_ddiff contains @@ -721,10 +723,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G ! a diffusivity and happen before KPP. But generally in MOM, we do not match ! KPP boundary layer to interior, so this diffusivity can be computed when convenient. if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T)) then - call cpu_clock_begin(id_clock_differential_diff) + call cpu_clock_begin(id_clock_CVMix_ddiff) call differential_diffuse_T_S(h, tv, visc, dt, G, GV) - call cpu_clock_end(id_clock_differential_diff) + call cpu_clock_end(id_clock_CVMix_ddiff) if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G) @@ -737,7 +739,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G enddo ; enddo ; enddo endif - endif @@ -1872,7 +1873,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, real :: Kd integer :: num_mode - logical :: use_temperature, differentialDiffusion + logical :: use_temperature type(vardesc) :: vd ! This "include" declares and sets the variable "version". @@ -1924,11 +1925,10 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, "If true, the diffusivity from ePBL is added to all\n"//& "other diffusivities. Otherwise, the larger of kappa-\n"//& "shear and ePBL diffusivities are used.", default=.true.) - call get_param(param_file, mod, "DOUBLE_DIFFUSION", differentialDiffusion, & - "If true, apply parameterization of double-diffusion.", & - default=.false. ) + CS%use_CVMix_ddiff = CVMix_ddiff_is_used(param_file) CS%use_kappa_shear = kappa_shear_is_used(param_file) - CS%use_cvmix_shear = cvmix_shear_is_used(param_file) + CS%use_CVMix_shear = CVMix_shear_is_used(param_file) + if (CS%bulkmixedlayer) then call get_param(param_file, mod, "ML_MIX_FIRST", CS%ML_mix_first, & "The fraction of the mixed layer mixing that is applied \n"//& @@ -2384,8 +2384,8 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, id_clock_sponge = cpu_clock_id('(Ocean sponges)', grain=CLOCK_MODULE) id_clock_tridiag = cpu_clock_id('(Ocean diabatic tridiag)', grain=CLOCK_ROUTINE) id_clock_pass = cpu_clock_id('(Ocean diabatic message passing)', grain=CLOCK_ROUTINE) - id_clock_differential_diff = -1 ; if (differentialDiffusion) & - id_clock_differential_diff = cpu_clock_id('(Ocean differential diffusion)', grain=CLOCK_ROUTINE) + id_clock_CVMix_ddiff = -1 ; if (CS%use_CVMix_ddiff) & + id_clock_CVMix_ddiff = cpu_clock_id('(Double diffusion)', grain=CLOCK_ROUTINE) ! initialize the auxiliary diabatic driver module call diabatic_aux_init(Time, G, GV, param_file, diag, CS%diabatic_aux_CSp, & diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index b9905977d5..f33bdea2a8 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -21,8 +21,10 @@ module MOM_set_diffusivity use MOM_intrinsic_functions, only : invcosh use MOM_io, only : slasher, vardesc, var_desc, MOM_read_data use MOM_kappa_shear, only : calculate_kappa_shear, kappa_shear_init, Kappa_shear_CS -use MOM_cvmix_shear, only : calculate_cvmix_shear, cvmix_shear_init, cvmix_shear_cs -use MOM_cvmix_shear, only : cvmix_shear_end +use MOM_CVMix_shear, only : calculate_CVMix_shear, CVMix_shear_init, CVMix_shear_cs +use MOM_CVMix_shear, only : CVMix_shear_end +use MOM_CVMix_ddiff, only : CVMix_ddiff_init, CVMix_ddiff_end, CVMix_ddiff_cs +use MOM_CVMix_ddiff, only : compute_ddiff_coeffs use MOM_bkgnd_mixing, only : calculate_bkgnd_mixing, bkgnd_mixing_init, bkgnd_mixing_cs use MOM_bkgnd_mixing, only : bkgnd_mixing_end, sfc_bkgnd_mixing use MOM_string_functions, only : uppercase @@ -129,18 +131,16 @@ module MOM_set_diffusivity ! shear-driven diapycnal diffusivity. logical :: use_cvmix_shear ! If true, use one of the CVMix modules to find ! shear-driven diapycnal diffusivity. - logical :: double_diffusion ! If true, enable double-diffusive mixing. + logical :: use_CVMix_ddiff ! If true, enable double-diffusive mixing via CVMix. logical :: simple_TKE_to_Kd ! If true, uses a simple estimate of Kd/TKE that ! does not rely on a layer-formulation. - real :: Max_Rrho_salt_fingers ! max density ratio for salt fingering - real :: Max_salt_diff_salt_fingers ! max salt diffusivity for salt fingers (m2/s) - real :: Kv_molecular ! molecular visc for double diff convect (m2/s) character(len=200) :: inputdir type(user_change_diff_CS), pointer :: user_change_diff_CSp => NULL() type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() type(Kappa_shear_CS), pointer :: kappaShear_CSp => NULL() - type(cvmix_shear_cs), pointer :: cvmix_shear_csp => NULL() + type(CVMix_shear_cs), pointer :: CVMix_shear_csp => NULL() + type(CVMix_ddiff_cs), pointer :: CVMix_ddiff_csp => NULL() type(bkgnd_mixing_cs), pointer :: bkgnd_mixing_csp => NULL() type(int_tide_CS), pointer :: int_tide_CSp => NULL() type(tidal_mixing_cs), pointer :: tm_csp => NULL() @@ -158,11 +158,6 @@ module MOM_set_diffusivity integer :: id_N2 = -1 integer :: id_N2_z = -1 - integer :: id_KT_extra = -1 - integer :: id_KS_extra = -1 - integer :: id_KT_extra_z = -1 - integer :: id_KS_extra_z = -1 - end type set_diffusivity_CS type diffusivity_diags @@ -172,12 +167,9 @@ module MOM_set_diffusivity Kd_BBL => NULL(),& ! BBL diffusivity at interfaces (m2/s) Kd_work => NULL(),& ! layer integrated work by diapycnal mixing (W/m2) maxTKE => NULL(),& ! energy required to entrain to h_max (m3/s3) - TKE_to_Kd => NULL(),& ! conversion rate (~1.0 / (G_Earth + dRho_lay)) + TKE_to_Kd => NULL() ! conversion rate (~1.0 / (G_Earth + dRho_lay)) ! between TKE dissipated within a layer and Kd ! in that layer, in m2 s-1 / m3 s-3 = s2 m-1 - KT_extra => NULL(),& ! double diffusion diffusivity for temp (m2/s) - KS_extra => NULL() ! double diffusion diffusivity for saln (m2/s) - end type diffusivity_diags ! Clocks @@ -226,17 +218,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! massless layers filled vertically by diffusion. real, dimension(SZI_(G),SZK_(G)) :: & - N2_lay, & ! squared buoyancy frequency associated with layers (1/s2) - maxTKE, & ! energy required to entrain to h_max (m3/s3) - TKE_to_Kd ! conversion rate (~1.0 / (G_Earth + dRho_lay)) between - ! TKE dissipated within a layer and Kd in that layer, in - ! m2 s-1 / m3 s-3 = s2 m-1. + N2_lay, & !< squared buoyancy frequency associated with layers (1/s2) + maxTKE, & !< energy required to entrain to h_max (m3/s3) + TKE_to_Kd !< conversion rate (~1.0 / (G_Earth + dRho_lay)) between + !< TKE dissipated within a layer and Kd in that layer, in + !< m2 s-1 / m3 s-3 = s2 m-1. real, dimension(SZI_(G),SZK_(G)+1) :: & - N2_int, & ! squared buoyancy frequency associated at interfaces (1/s2) - dRho_int, & ! locally ref potential density difference across interfaces (in s-2) smg: or kg/m3? - KT_extra, & ! double difusion diffusivity on temperature (m2/sec) - KS_extra ! double difusion diffusivity on salinity (m2/sec) + N2_int, & !< squared buoyancy frequency associated at interfaces (1/s2) + dRho_int !< locally ref potential density difference across interfaces (in s-2) smg: or kg/m3? real :: I_Rho0 ! inverse of Boussinesq density (m3/kg) real :: dissip ! local variable for dissipation calculations (W/m3) @@ -271,10 +261,10 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & use_EOS = associated(tv%eqn_of_state) - if ((CS%double_diffusion) .and. & + if ((CS%use_CVMix_ddiff) .and. & .not.(associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S)) ) & call MOM_error(FATAL, "set_diffusivity: visc%Kd_extra_T and "//& - "visc%Kd_extra_S must be associated when DOUBLE_DIFFUSION is true.") + "visc%Kd_extra_S must be associated when USE_CVMIX_DDIFF is true.") ! Set Kd, Kd_int and Kv_slow to constant values. ! If nothing else is specified, this will be the value used. @@ -299,12 +289,6 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%id_TKE_to_Kd > 0) then allocate(dd%TKE_to_Kd(isd:ied,jsd:jed,nz)) ; dd%TKE_to_Kd(:,:,:) = 0.0 endif - if ((CS%id_KT_extra > 0) .or. (CS%id_KT_extra_z > 0)) then - allocate(dd%KT_extra(isd:ied,jsd:jed,nz+1)) ; dd%KT_extra(:,:,:) = 0.0 - endif - if ((CS%id_KS_extra > 0) .or. (CS%id_KS_extra_z > 0)) then - allocate(dd%KS_extra(isd:ied,jsd:jed,nz+1)) ; dd%KS_extra(:,:,:) = 0.0 - endif if ((CS%id_Kd_BBL > 0) .or. (CS%id_Kd_BBL_z > 0)) then allocate(dd%Kd_BBL(isd:ied,jsd:jed,nz+1)) ; dd%Kd_BBL(:,:,:) = 0.0 endif @@ -376,35 +360,13 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & do K=1,nz+1 ; do i=is,ie ; dd%N2_3d(i,j,K) = N2_int(i,K) ; enddo ; enddo endif - ! add background mixing + ! Add background mixing call calculate_bkgnd_mixing(h, tv, N2_lay, Kd, visc%Kv_slow, j, G, GV, CS%bkgnd_mixing_csp) - ! GMM, the following will go into the MOM_cvmix_double_diffusion module - if (CS%double_diffusion) then - call double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, KT_extra, KS_extra) - do K=2,nz ; do i=is,ie - if (KS_extra(i,K) > KT_extra(i,K)) then ! salt fingering - Kd(i,j,k-1) = Kd(i,j,k-1) + 0.5*KT_extra(i,K) - Kd(i,j,k) = Kd(i,j,k) + 0.5*KT_extra(i,K) - visc%Kd_extra_S(i,j,k) = KS_extra(i,K)-KT_extra(i,K) - visc%Kd_extra_T(i,j,k) = 0.0 - elseif (KT_extra(i,K) > 0.0) then ! double-diffusive convection - Kd(i,j,k-1) = Kd(i,j,k-1) + 0.5*KS_extra(i,K) - Kd(i,j,k) = Kd(i,j,k) + 0.5*KS_extra(i,K) - visc%Kd_extra_T(i,j,k) = KT_extra(i,K)-KS_extra(i,K) - visc%Kd_extra_S(i,j,k) = 0.0 - else ! There is no double diffusion at this interface. - visc%Kd_extra_T(i,j,k) = 0.0 - visc%Kd_extra_S(i,j,k) = 0.0 - endif - enddo; enddo - if (associated(dd%KT_extra)) then ; do K=1,nz+1 ; do i=is,ie - dd%KT_extra(i,j,K) = KT_extra(i,K) - enddo ; enddo ; endif - - if (associated(dd%KS_extra)) then ; do K=1,nz+1 ; do i=is,ie - dd%KS_extra(i,j,K) = KS_extra(i,K) - enddo ; enddo ; endif + ! Apply double diffusion + ! GMM, we need to pass HBL to compute_ddiff_coeffs, but it is not yet available. + if (CS%use_CVMix_ddiff) then + call compute_ddiff_coeffs(h, tv, G, GV, j, visc%Kd_extra_T, visc%Kd_extra_S, CS%CVMix_ddiff_csp) endif ! Add the input turbulent diffusivity. @@ -502,6 +464,11 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%useKappaShear) call hchksum(visc%Kd_shear,"Turbulent Kd",G%HI,haloshift=0) + if (CS%use_CVMix_ddiff) then + call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T",G%HI,haloshift=0) + call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S",G%HI,haloshift=0) + endif + if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then call uvchksum("BBL Kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, & G%HI, 0, symmetric=.true.) @@ -539,17 +506,27 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif ! post diagnostics + + ! background mixing if (CS%bkgnd_mixing_csp%id_kd_bkgnd > 0) & call post_data(CS%bkgnd_mixing_csp%id_kd_bkgnd, CS%bkgnd_mixing_csp%kd_bkgnd, CS%bkgnd_mixing_csp%diag) if (CS%bkgnd_mixing_csp%id_kv_bkgnd > 0) & call post_data(CS%bkgnd_mixing_csp%id_kv_bkgnd, CS%bkgnd_mixing_csp%kv_bkgnd, CS%bkgnd_mixing_csp%diag) - if (CS%id_Kd_layer > 0) call post_data(CS%id_Kd_layer, Kd, CS%diag) + ! double diffusive mixing + if (CS%CVMix_ddiff_csp%id_KT_extra > 0) & + call post_data(CS%CVMix_ddiff_csp%id_KT_extra, visc%Kd_extra_T, CS%CVMix_ddiff_csp%diag) + if (CS%CVMix_ddiff_csp%id_KS_extra > 0) & + call post_data(CS%CVMix_ddiff_csp%id_KS_extra, visc%Kd_extra_S, CS%CVMix_ddiff_csp%diag) + if (CS%CVMix_ddiff_csp%id_R_rho > 0) & + call post_data(CS%CVMix_ddiff_csp%id_R_rho, CS%CVMix_ddiff_csp%R_rho, CS%CVMix_ddiff_csp%diag) - num_z_diags = 0 + if (CS%id_Kd_layer > 0) call post_data(CS%id_Kd_layer, Kd, CS%diag) + ! tidal mixing call post_tidal_diagnostics(G,GV,h,CS%tm_csp) + num_z_diags = 0 if (CS%tm_csp%Int_tide_dissipation .or. CS%tm_csp%Lee_wave_dissipation .or. & CS%tm_csp%Lowmode_itidal_dissipation) then @@ -573,26 +550,11 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif - if (CS%id_KT_extra > 0) call post_data(CS%id_KT_extra, dd%KT_extra, CS%diag) - if (CS%id_KS_extra > 0) call post_data(CS%id_KS_extra, dd%KS_extra, CS%diag) if (CS%id_Kd_BBL > 0) call post_data(CS%id_Kd_BBL, dd%Kd_BBL, CS%diag) - if (CS%id_KT_extra_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_KT_extra_z - z_ptrs(num_z_diags)%p => dd%KT_extra - endif - - if (CS%id_KS_extra_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_KS_extra_z - z_ptrs(num_z_diags)%p => dd%KS_extra - endif - if (CS%id_Kd_BBL_z > 0) then num_z_diags = num_z_diags + 1 z_ids(num_z_diags) = CS%id_Kd_BBL_z - z_ptrs(num_z_diags)%p => dd%KS_extra endif if (num_z_diags > 0) & @@ -603,8 +565,6 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(dd%Kd_user)) deallocate(dd%Kd_user) if (associated(dd%maxTKE)) deallocate(dd%maxTKE) if (associated(dd%TKE_to_Kd)) deallocate(dd%TKE_to_Kd) - if (associated(dd%KT_extra)) deallocate(dd%KT_extra) - if (associated(dd%KS_extra)) deallocate(dd%KS_extra) if (associated(dd%Kd_BBL)) deallocate(dd%Kd_BBL) if (showCallTree) call callTree_leave("set_diffusivity()") @@ -956,119 +916,6 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & end subroutine find_N2 -! GMM, the following will be moved to a new module - -!> This subroutine sets the additional diffusivities of temperature and -!! salinity due to double diffusion, using the same functional form as is -!! used in MOM4.1, and taken from an NCAR technical note (REF?) that updates -!! what was in Large et al. (1994). All the coefficients here should probably -!! be made run-time variables rather than hard-coded constants. -!! -!! \todo Find reference for NCAR tech note above. -subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, Kd_T_dd, Kd_S_dd) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available - !! thermodynamic fields; absent fields have NULL - !! ptrs. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: T_f !< layer temp in C with the values in massless layers - !! filled vertically by diffusion. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: S_f !< Layer salinities in PPT with values in massless - !! layers filled vertically by diffusion. - integer, intent(in) :: j !< Meridional index upon which to work. - type(set_diffusivity_CS), pointer :: CS !< Module control structure. - real, dimension(SZI_(G),SZK_(G)+1), & - intent(out) :: Kd_T_dd !< Interface double diffusion diapycnal - !! diffusivity for temp (m2/sec). - real, dimension(SZI_(G),SZK_(G)+1), & - intent(out) :: Kd_S_dd !< Interface double diffusion diapycnal - !! diffusivity for saln (m2/sec). - -! Arguments: -! (in) tv - structure containing pointers to any available -! thermodynamic fields; absent fields have NULL ptrs -! (in) h - layer thickness (m or kg m-2) -! (in) T_f - layer temp in C with the values in massless layers -! filled vertically by diffusion -! (in) S_f - layer salinities in PPT with values in massless layers -! filled vertically by diffusion -! (in) G - ocean grid structure -! (in) GV - The ocean's vertical grid structure. -! (in) CS - module control structure -! (in) j - meridional index upon which to work -! (out) Kd_T_dd - interface double diffusion diapycnal diffusivity for temp (m2/sec) -! (out) Kd_S_dd - interface double diffusion diapycnal diffusivity for saln (m2/sec) - -! This subroutine sets the additional diffusivities of temperature and -! salinity due to double diffusion, using the same functional form as is -! used in MOM4.1, and taken from an NCAR technical note (###REF?) that updates -! what was in Large et al. (1994). All the coefficients here should probably -! be made run-time variables rather than hard-coded constants. - - real, dimension(SZI_(G)) :: & - dRho_dT, & ! partial derivatives of density wrt temp (kg m-3 degC-1) - dRho_dS, & ! partial derivatives of density wrt saln (kg m-3 PPT-1) - pres, & ! pressure at each interface (Pa) - Temp_int, & ! temp and saln at interfaces - Salin_int - - real :: alpha_dT ! density difference between layers due to temp diffs (kg/m3) - real :: beta_dS ! density difference between layers due to saln diffs (kg/m3) - - real :: Rrho ! vertical density ratio - real :: diff_dd ! factor for double-diffusion - real :: prandtl ! flux ratio for diffusive convection regime - - real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio - real, parameter :: dsfmax = 1.e-4 ! max diffusivity in case of salt fingering - real, parameter :: Kv_molecular = 1.5e-6 ! molecular viscosity (m2/sec) - - integer :: i, k, is, ie, nz - is = G%isc ; ie = G%iec ; nz = G%ke - - if (associated(tv%eqn_of_state)) then - do i=is,ie - pres(i) = 0.0 ; Kd_T_dd(i,1) = 0.0 ; Kd_S_dd(i,1) = 0.0 - Kd_T_dd(i,nz+1) = 0.0 ; Kd_S_dd(i,nz+1) = 0.0 - enddo - do K=2,nz - do i=is,ie - pres(i) = pres(i) + GV%H_to_Pa*h(i,j,k-1) - Temp_Int(i) = 0.5 * (T_f(i,j,k-1) + T_f(i,j,k)) - Salin_Int(i) = 0.5 * (S_f(i,j,k-1) + S_f(i,j,k)) - enddo - call calculate_density_derivs(Temp_int, Salin_int, pres, & - dRho_dT(:), dRho_dS(:), is, ie-is+1, tv%eqn_of_state) - - do i=is,ie - alpha_dT = -1.0*dRho_dT(i) * (T_f(i,j,k-1) - T_f(i,j,k)) - beta_dS = dRho_dS(i) * (S_f(i,j,k-1) - S_f(i,j,k)) - - if ((alpha_dT > beta_dS) .and. (beta_dS > 0.0)) then ! salt finger case - Rrho = min(alpha_dT/beta_dS,Rrho0) - diff_dd = 1.0 - ((RRho-1.0)/(RRho0-1.0)) - diff_dd = dsfmax*diff_dd*diff_dd*diff_dd - Kd_T_dd(i,K) = 0.7*diff_dd - Kd_S_dd(i,K) = diff_dd - elseif ((alpha_dT < 0.) .and. (beta_dS < 0.) .and. (alpha_dT > beta_dS)) then ! diffusive convection - Rrho = alpha_dT/beta_dS - diff_dd = Kv_molecular*0.909*exp(4.6*exp(-0.54*(1/Rrho-1))) - prandtl = 0.15*Rrho - if (Rrho > 0.5) prandtl = (1.85-0.85/Rrho)*Rrho - Kd_T_dd(i,K) = diff_dd - Kd_S_dd(i,K) = prandtl*diff_dd - else - Kd_T_dd(i,K) = 0.0 ; Kd_S_dd(i,K) = 0.0 - endif - enddo - enddo - endif - -end subroutine double_diffusion !> This routine adds diffusion sustained by flow energy extracted by bottom drag. subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & maxTKE, kb, G, GV, CS, Kd, Kd_int, Kd_BBL) @@ -2079,45 +1926,6 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp endif endif - - ! GMM, the following should be moved to the DD module - call get_param(param_file, mdl, "DOUBLE_DIFFUSION", CS%double_diffusion, & - "If true, increase diffusivitives for temperature or salt \n"//& - "based on double-diffusive paramaterization from MOM4/KPP.", & - default=.false.) - if (CS%double_diffusion) then - call get_param(param_file, mdl, "MAX_RRHO_SALT_FINGERS", CS%Max_Rrho_salt_fingers, & - "Maximum density ratio for salt fingering regime.", & - default=2.55, units="nondim") - call get_param(param_file, mdl, "MAX_SALT_DIFF_SALT_FINGERS", CS%Max_salt_diff_salt_fingers, & - "Maximum salt diffusivity for salt fingering regime.", & - default=1.e-4, units="m2 s-1") - call get_param(param_file, mdl, "KV_MOLECULAR", CS%Kv_molecular, & - "Molecular viscosity for calculation of fluxes under \n"//& - "double-diffusive convection.", default=1.5e-6, units="m2 s-1") - ! The default molecular viscosity follows the CCSM4.0 and MOM4p1 defaults. - - CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for temperature', 'm2 s-1') - - CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for salinity', 'm2 s-1') - - if (associated(diag_to_Z_CSp)) then - vd = var_desc("KT_extra", "m2 s-1", & - "Double-Diffusive Temperature Diffusivity, interpolated to z", & - z_grid='z') - CS%id_KT_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - vd = var_desc("KS_extra", "m2 s-1", & - "Double-Diffusive Salinity Diffusivity, interpolated to z",& - z_grid='z') - CS%id_KS_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - vd = var_desc("Kd_BBL", "m2 s-1", & - "Bottom Boundary Layer Diffusivity", z_grid='z') - CS%id_Kd_BBL_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - endif - endif - if (CS%user_change_diff) then call user_change_diff_init(Time, G, param_file, diag, CS%user_change_diff_CSp) endif @@ -2131,7 +1939,10 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp id_clock_kappaShear = cpu_clock_id('(Ocean kappa_shear)', grain=CLOCK_MODULE) ! CVMix shear-driven mixing - CS%use_cvmix_shear = cvmix_shear_init(Time, G, GV, param_file, CS%diag, CS%cvmix_shear_csp) + CS%use_CVMix_shear = CVMix_shear_init(Time, G, GV, param_file, CS%diag, CS%CVMix_shear_csp) + + ! CVMix double diffusion mixing + CS%use_CVMix_ddiff = CVMix_ddiff_init(Time, G, GV, param_file, CS%diag, CS%CVMix_ddiff_csp) end subroutine set_diffusivity_init @@ -2146,8 +1957,11 @@ subroutine set_diffusivity_end(CS) if (CS%user_change_diff) & call user_change_diff_end(CS%user_change_diff_CSp) - if (CS%use_cvmix_shear) & - call cvmix_shear_end(CS%cvmix_shear_csp) + if (CS%use_CVMix_shear) & + call CVMix_shear_end(CS%CVMix_shear_csp) + + if (CS%use_CVMix_ddiff) & + call CVMix_ddiff_end(CS%CVMix_ddiff_csp) if (associated(CS)) deallocate(CS) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 18eb80f280..ee18094f7e 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -46,6 +46,7 @@ module MOM_set_visc use MOM_kappa_shear, only : kappa_shear_is_used use MOM_cvmix_shear, only : cvmix_shear_is_used use MOM_cvmix_conv, only : cvmix_conv_is_used +use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used use MOM_io, only : vardesc, var_desc use MOM_restart, only : register_restart_field, MOM_restart_CS use MOM_variables, only : thermo_var_ptrs @@ -1791,7 +1792,7 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) call get_param(param_file, mdl, "ADIABATIC", adiabatic, default=.false., & do_not_log=.true.) - use_kappa_shear = .false. ; use_cvmix_shear = .false. ; + use_kappa_shear = .false. ; use_cvmix_shear = .false. useKPP = .false. ; useEPBL = .false. ; use_cvmix_conv = .false. ; if (.not.adiabatic) then use_kappa_shear = kappa_shear_is_used(param_file) @@ -1870,7 +1871,8 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) real :: Kv_background real :: omega_frac_dflt integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, i, j, n - logical :: use_kappa_shear, adiabatic, differential_diffusion, use_omega + logical :: use_kappa_shear, adiabatic, use_omega + logical :: use_CVMix_ddiff type(OBC_segment_type), pointer :: segment ! pointer to OBC segment type ! This include declares and sets the variable "version". #include "version_variable.h" @@ -1893,8 +1895,8 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) ! Set default, read and log parameters call log_version(param_file, mdl, version, "") - CS%RiNo_mix = .false. - use_kappa_shear = .false. ; differential_diffusion = .false. !; adiabatic = .false. ! Needed? -AJA + CS%RiNo_mix = .false. ; use_CVMix_ddiff = .false. + use_kappa_shear = .false. !; adiabatic = .false. ! Needed? -AJA call get_param(param_file, mdl, "BOTTOMDRAGLAW", CS%bottomdraglaw, & "If true, the bottom stress is calculated with a drag \n"//& "law of the form c_drag*|u|*u. The velocity magnitude \n"//& @@ -1921,11 +1923,9 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) if (.not.adiabatic) then use_kappa_shear = kappa_shear_is_used(param_file) CS%RiNo_mix = use_kappa_shear - call get_param(param_file, mdl, "DOUBLE_DIFFUSION", differential_diffusion, & - "If true, increase diffusivitives for temperature or salt \n"//& - "based on double-diffusive paramaterization from MOM4/KPP.", & - default=.false.) + use_CVMix_ddiff = CVMix_ddiff_is_used(param_file) endif + call get_param(param_file, mdl, "PRANDTL_TURB", visc%Prandtl_turb, & "The turbulent Prandtl number applied to shear \n"//& "instability.", units="nondim", default=1.0) @@ -2067,7 +2067,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) Time, 'Rayleigh drag velocity at v points', 'm s-1') endif - if (differential_diffusion) then + if (use_CVMix_ddiff) then allocate(visc%Kd_extra_T(isd:ied,jsd:jed,nz+1)) ; visc%Kd_extra_T = 0.0 allocate(visc%Kd_extra_S(isd:ied,jsd:jed,nz+1)) ; visc%Kd_extra_S = 0.0 endif From 8c83e21f4679674341cdf7c6224922cdd8425284 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 17 May 2018 17:04:53 -0600 Subject: [PATCH 0263/1072] add viscosities due to tidal mixing --- .../vertical/MOM_set_diffusivity.F90 | 2 +- .../vertical/MOM_tidal_mixing.F90 | 24 +++++++++++++++---- 2 files changed, 20 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 9906083597..29cd8c7ca7 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -441,7 +441,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! Add the Nikurashin and / or tidal bottom-driven mixing call calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, maxTKE, G, GV, CS%tm_csp, & - N2_lay, N2_int, Kd, Kd_int, CS%Kd_max) + N2_lay, N2_int, Kd, Kd_int, CS%Kd_max, visc%Kv_slow) ! This adds the diffusion sustained by the energy extracted from the flow ! by the bottom drag. diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 9c60a05451..b659e9149a 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -642,7 +642,7 @@ end function tidal_mixing_init !! tidal dissipation and to add the effect of internal-tide-driven mixing to the layer or interface !! diffusivities. subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & - N2_lay, N2_int, Kd, Kd_int, Kd_max) + N2_lay, N2_int, Kd, Kd_int, Kd_max, Kv) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) @@ -655,10 +655,12 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int real, intent(inout) :: Kd_max + real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface + !! (not layer!) in m2 s-1. if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then if (CS%use_CVMix_tidal) then - call calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd) + call calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) else call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & N2_lay, Kd, Kd_int, Kd_max) @@ -669,7 +671,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & !> Calls the CVMix routines to compute tidal dissipation and to add the effect of internal-tide-driven !! mixing to the interface diffusivities. -subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd) +subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) integer, intent(in) :: j type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -677,6 +679,8 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd) real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: N2_int real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd + real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface + !! (not layer!) in m2 s-1. ! local real, dimension(SZK_(G)+1) :: Kd_tidal !< tidal diffusivity [m2/s] @@ -744,9 +748,14 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd) CVMix_params = CS%CVMix_glb_params, & CVMix_tidal_params_user = CS%CVMix_tidal_params) + ! Update diffusivity do k=1,G%ke Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_tidal(k) + Kd_tidal(k+1) ) - !TODO: Kv(i,j,k) = ???????????? + enddo + + ! Update viscosity + do k=1,G%ke+1 + Kv(i,j,k) = Kv(i,j,k) + Kv_tidal(k) enddo ! diagnostics @@ -836,9 +845,14 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd) CVmix_params = CS%CVMix_glb_params, & CVmix_tidal_params_user = CS%CVMix_tidal_params) + ! Update diffusivity do k=1,G%ke Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_tidal(k) + Kd_tidal(k+1) ) - !TODO: Kv(i,j,k) = ???????????? + enddo + + ! Update viscosity + do k=1,G%ke+1 + Kv(i,j,k) = Kv(i,j,k) + Kv_tidal(k) enddo ! diagnostics From 81265e64ae209c0685de5d8b1cfbe22049533b61 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 18 May 2018 08:09:41 -0600 Subject: [PATCH 0264/1072] Doxygenize MOM_diabatic_aux --- .../vertical/MOM_diabatic_aux.F90 | 132 +++++++----------- 1 file changed, 52 insertions(+), 80 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 82799d531a..89d16f8e87 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -340,27 +340,23 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) end subroutine differential_diffuse_T_S +!> Keep salinity from falling below a small but positive threshold +!! This occurs when the ice model attempts to extract more salt then +!! is actually available to it from the ocean. subroutine adjust_salt(h, tv, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(inout) :: tv - type(diabatic_aux_CS), intent(in) :: CS - -! Keep salinity from falling below a small but positive threshold -! This occurs when the ice model attempts to extract more salt then -! is actually available to it from the ocean. - -! Arguments: h - Layer thickness, in m. -! (in/out) tv - A structure containing pointers to any available -! thermodynamic fields. Absent fields have NULL ptrs. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! diabatic_driver_init. - real :: salt_add_col(SZI_(G),SZJ_(G)) ! The accumulated salt requirement - real :: S_min ! The minimum salinity - real :: mc ! A layer's mass kg m-2 . + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m + !! or kg m-2) + type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to any + !! available thermodynamic fields. + type(diabatic_aux_CS), intent(in) :: CS !< control structure returned by + !! a previous call to diabatic_driver_init. + + ! local variables + real :: salt_add_col(SZI_(G),SZJ_(G)) !< The accumulated salt requirement + real :: S_min !< The minimum salinity + real :: mc !< A layer's mass kg m-2 . integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -402,33 +398,29 @@ subroutine adjust_salt(h, tv, G, GV, CS) end subroutine adjust_salt +!> Insert salt from brine rejection into the first layer below +!! the mixed layer which both contains mass and in which the +!! change in layer density remains stable after the addition +!! of salt via brine rejection. subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(inout) :: tv - type(forcing), intent(in) :: fluxes - integer, intent(in) :: nkmb - type(diabatic_aux_CS), intent(in) :: CS - real, intent(in) :: dt + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m + !! or kg m-2) + type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to + !! any available hermodynamic fields. + type(forcing), intent(in) :: fluxes !< tructure containing pointers + !! any possible forcing fields + integer, intent(in) :: nkmb !< number of layers in the mixed and + !! buffer layers + type(diabatic_aux_CS), intent(in) :: CS !< control structure returned by a + !! previous call to diabatic_driver_init. + real, intent(in) :: dt !< time step between calls to this + !! function (s) ?? integer, intent(in) :: id_brine_lay -! Insert salt from brine rejection into the first layer below -! the mixed layer which both contains mass and in which the -! change in layer density remains stable after the addition -! of salt via brine rejection. - -! Arguments: h - Layer thickness, in m. -! (in/out) tv - A structure containing pointers to any available -! thermodynamic fields. Absent fields have NULL ptrs. -! (in) fluxes = A structure containing pointers to any possible -! forcing fields; unused fields have NULL ptrs. -! (in) nkmb - The number of layers in the mixed and buffer layers. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! diabatic_driver_init. + ! local variables real :: salt(SZI_(G)) ! The amount of salt rejected from ! sea ice. [grams] real :: dzbr(SZI_(G)) ! cumulative depth over which brine is distributed @@ -531,10 +523,9 @@ subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) end subroutine insert_brine +!> Simple tri-diagnonal solver for T and S. +!! "Simple" means it only uses arrays hold, ea and eb. subroutine triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, T, S) -! Simple tri-diagnonal solver for T and S -! "Simple" means it only uses arrays hold, ea and eb - ! Arguments type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure integer, intent(in) :: is, ie, js, je @@ -571,35 +562,22 @@ subroutine triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, T, S) enddo end subroutine triDiagTS - +!> Calculates u_h and v_h (velocities at thickness points), +!! optionally using the entrainments (in m) passed in as arguments. subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1 real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: u_h, v_h - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in), optional :: ea, eb -! This subroutine calculates u_h and v_h (velocities at thickness -! points), optionally using the entrainments (in m) passed in as arguments. - -! Arguments: u - Zonal velocity, in m s-1. -! (in) v - Meridional velocity, in m s-1. -! (in) h - Layer thickness, in m or kg m-2. -! (out) u_h - The zonal velocity at thickness points after -! entrainment, in m s-1. -! (out) v_h - The meridional velocity at thickness points after -! entrainment, in m s-1. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in, opt) ea - The amount of fluid entrained from the layer above within -! this time step, in units of m or kg m-2. Omitting ea is the -! same as setting it to 0. -! (in, opt) eb - The amount of fluid entrained from the layer below within -! this time step, in units of m or kg m-2. Omitting eb is the -! same as setting it to 0. ea and eb must either be both -! present or both absent. - + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: u_h, v_h !< zonal and meridional velocity at thickness + !! points entrainment, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in), optional :: ea, eb !< The amount of fluid entrained + !! from the layer above within this time step + !! , in units of m or kg m-2. Omitting ea is the + !! same as setting it to 0. + + ! local variables real :: b_denom_1 ! The first term in the denominator of b1 in m or kg m-2. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in m or kg m-2. @@ -1306,26 +1284,20 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & end subroutine applyBoundaryFluxesInOut +!> Initializes this module. subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm, use_ePBL) type(time_type), intent(in) :: Time type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(inout) :: diag - type(diabatic_aux_CS), pointer :: CS - logical, intent(in) :: useALEalgorithm - logical, intent(in) :: use_ePBL - -! Arguments: -! (in) Time = current model time -! (in) G = ocean grid structure -! (in) GV - The ocean's vertical grid structure. -! (in) param_file = structure indicating the open file to parse for parameter values -! (in) diag = structure used to regulate diagnostic output -! (in/out) CS = pointer set to point to the control structure for this module -! (in) use_ePBL = If true, use the implicit energetics planetary boundary -! layer scheme to determine the diffusivity in the -! surface boundary layer. + type(diag_ctrl), target, intent(inout) :: diag !< structure used to regulate diagnostic output + type(diabatic_aux_CS), pointer :: CS !< pointer set to point to the ontrol structure for + !! this module + logical, intent(in) :: useALEalgorithm !< If True, uses ALE. + logical, intent(in) :: use_ePBL !< If true, use the implicit energetics + !! planetary boundary layer scheme to determine the + !! diffusivity in the surface boundary layer. + ! local variables type(vardesc) :: vd ! This "include" declares and sets the variable "version". From 05daededb4103ecd3a3c1fbd2fcefd13968f1278 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 18 May 2018 08:10:36 -0600 Subject: [PATCH 0265/1072] Fix indentation --- src/parameterizations/vertical/MOM_set_diffusivity.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index f33bdea2a8..37696386be 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -465,8 +465,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%useKappaShear) call hchksum(visc%Kd_shear,"Turbulent Kd",G%HI,haloshift=0) if (CS%use_CVMix_ddiff) then - call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T",G%HI,haloshift=0) - call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S",G%HI,haloshift=0) + call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T",G%HI,haloshift=0) + call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S",G%HI,haloshift=0) endif if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then From d5ce7a4aa4d94a239e19d5b5330bcc41ac4a0ae3 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 18 May 2018 13:54:27 -0600 Subject: [PATCH 0266/1072] Avoid NaNs when computing stratification parameter --- src/parameterizations/vertical/MOM_cvmix_ddiff.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/parameterizations/vertical/MOM_cvmix_ddiff.F90 b/src/parameterizations/vertical/MOM_cvmix_ddiff.F90 index 8e52c39849..da75caf1e3 100644 --- a/src/parameterizations/vertical/MOM_cvmix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_ddiff.F90 @@ -250,6 +250,8 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) if (CS%id_R_rho > 0.0) then do k=1,G%ke CS%R_rho(i,j,k) = alpha_dT(k)/beta_dS(k) + ! avoid NaN's + if(CS%R_rho(i,j,k) /= CS%R_rho(i,j,k)) CS%R_rho(i,j,k) = 0.0 enddo endif From abd620c8c730143aae2bcd55c752741a1d602789 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 18 May 2018 13:55:19 -0600 Subject: [PATCH 0267/1072] Move description to the end of the module --- .../vertical/MOM_diabatic_aux.F90 | 93 +++++++++---------- 1 file changed, 45 insertions(+), 48 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 89d16f8e87..fa0cca8681 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -2,53 +2,6 @@ module MOM_diabatic_aux ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, April 1994 - July 2000 * -!* Alistair Adcroft, and Stephen Griffies * -!* * -!* This program contains the subroutine that, along with the * -!* subroutines that it calls, implements diapycnal mass and momentum * -!* fluxes and a bulk mixed layer. The diapycnal diffusion can be * -!* used without the bulk mixed layer. * -!* * -!* diabatic first determines the (diffusive) diapycnal mass fluxes * -!* based on the convergence of the buoyancy fluxes within each layer. * -!* The dual-stream entrainment scheme of MacDougall and Dewar (JPO, * -!* 1997) is used for combined diapycnal advection and diffusion, * -!* calculated implicitly and potentially with the Richardson number * -!* dependent mixing, as described by Hallberg (MWR, 2000). Diapycnal * -!* advection is fundamentally the residual of diapycnal diffusion, * -!* so the fully implicit upwind differencing scheme that is used is * -!* entirely appropriate. The downward buoyancy flux in each layer * -!* is determined from an implicit calculation based on the previously * -!* calculated flux of the layer above and an estimated flux in the * -!* layer below. This flux is subject to the following conditions: * -!* (1) the flux in the top and bottom layers are set by the boundary * -!* conditions, and (2) no layer may be driven below an Angstrom thick-* -!* ness. If there is a bulk mixed layer, the buffer layer is treat- * -!* ed as a fixed density layer with vanishingly small diffusivity. * -!* * -!* diabatic takes 5 arguments: the two velocities (u and v), the * -!* thicknesses (h), a structure containing the forcing fields, and * -!* the length of time over which to act (dt). The velocities and * -!* thickness are taken as inputs and modified within the subroutine. * -!* There is no limit on the time step. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, T, S, buoy, ustar, ea, eb, etc. * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr @@ -251,6 +204,7 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) !! layer properies, and related fields. real, intent(in) :: dt !< Time increment, in s. + ! local variables real, dimension(SZI_(G)) :: & b1_T, b1_S, & ! Variables used by the tridiagonal solvers of T & S, in H. d1_T, d1_S ! Variables used by the tridiagonal solvers, nondim. @@ -337,7 +291,6 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) S(i,j,k) = S(i,j,k) + c1_S(i,k+1)*S(i,j,k+1) enddo ; enddo enddo - end subroutine differential_diffuse_T_S !> Keep salinity from falling below a small but positive threshold @@ -1420,4 +1373,48 @@ subroutine diabatic_aux_end(CS) end subroutine diabatic_aux_end +!> \namespace MOM_diabatic_aux +!! +!! This module contains the subroutines that, along with the * +!! subroutines that it calls, implements diapycnal mass and momentum * +!! fluxes and a bulk mixed layer. The diapycnal diffusion can be * +!! used without the bulk mixed layer. * +!! * +!! diabatic first determines the (diffusive) diapycnal mass fluxes * +!! based on the convergence of the buoyancy fluxes within each layer. * +!! The dual-stream entrainment scheme of MacDougall and Dewar (JPO, * +!! 1997) is used for combined diapycnal advection and diffusion, * +!! calculated implicitly and potentially with the Richardson number * +!! dependent mixing, as described by Hallberg (MWR, 2000). Diapycnal * +!! advection is fundamentally the residual of diapycnal diffusion, * +!! so the fully implicit upwind differencing scheme that is used is * +!! entirely appropriate. The downward buoyancy flux in each layer * +!! is determined from an implicit calculation based on the previously * +!! calculated flux of the layer above and an estimated flux in the * +!! layer below. This flux is subject to the following conditions: * +!! (1) the flux in the top and bottom layers are set by the boundary * +!! conditions, and (2) no layer may be driven below an Angstrom thick-* +!! ness. If there is a bulk mixed layer, the buffer layer is treat- * +!! ed as a fixed density layer with vanishingly small diffusivity. * +!! * +!! diabatic takes 5 arguments: the two velocities (u and v), the * +!! thicknesses (h), a structure containing the forcing fields, and * +!! the length of time over which to act (dt). The velocities and * +!! thickness are taken as inputs and modified within the subroutine. * +!! There is no limit on the time step. * +!! * +!! A small fragment of the grid is shown below: * +!! * +!! j+1 x ^ x ^ x At x: q * +!! j+1 > o > o > At ^: v * +!! j x ^ x ^ x At >: u * +!! j > o > o > At o: h, T, S, buoy, ustar, ea, eb, etc. * +!! j-1 x ^ x ^ x * +!! i-1 i i+1 At x & ^: * +!! i i+1 At > & o: * +!! * +!! The boundaries always run through q grid points (x). * +!! * +!!********+*********+*********+*********+*********+*********+*********+** + end module MOM_diabatic_aux From 152a7073db62e9b9b68023d2eb1dd8529414a7fd Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 18 May 2018 13:56:00 -0600 Subject: [PATCH 0268/1072] Change cvmix to CVMix --- .../vertical/MOM_diabatic_driver.F90 | 24 +++++++++---------- 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index b109d3642a..abc0d664f5 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -23,8 +23,8 @@ module MOM_diabatic_driver use MOM_diag_to_Z, only : diag_to_Z_CS, register_Zint_diag, calc_Zint_diags use MOM_diapyc_energy_req, only : diapyc_energy_req_init, diapyc_energy_req_end use MOM_diapyc_energy_req, only : diapyc_energy_req_calc, diapyc_energy_req_test, diapyc_energy_req_CS -use MOM_cvmix_conv, only : cvmix_conv_init, cvmix_conv_cs -use MOM_cvmix_conv, only : cvmix_conv_end, calculate_cvmix_conv +use MOM_CVMix_conv, only : CVMix_conv_init, CVMix_conv_cs +use MOM_CVMix_conv, only : CVMix_conv_end, calculate_CVMix_conv use MOM_domains, only : pass_var, To_West, To_South, To_All, Omit_Corners use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_tidal_mixing, only : tidal_mixing_init, tidal_mixing_cs @@ -95,7 +95,7 @@ module MOM_diabatic_driver !! shear-driven diapycnal diffusivity. logical :: use_CVMix_ddiff !< If true, use the CVMix double diffusion module. logical :: use_tidal_mixing !< If true, activate tidal mixing diffusivity. - logical :: use_cvmix_conv !< If true, use the CVMix module to get enhanced + logical :: use_CVMix_conv !< If true, use the CVMix module to get enhanced !! mixing due to convection. logical :: use_sponge !< If true, sponges may be applied anywhere in the !! domain. The exact location and properties of @@ -226,7 +226,7 @@ module MOM_diabatic_driver type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() type(KPP_CS), pointer :: KPP_CSp => NULL() type(tidal_mixing_cs), pointer :: tidal_mixing_csp => NULL() - type(cvmix_conv_cs), pointer :: cvmix_conv_csp => NULL() + type(CVMix_conv_cs), pointer :: CVMix_conv_csp => NULL() type(diapyc_energy_req_CS), pointer :: diapyc_en_rec_CSp => NULL() type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass @@ -530,7 +530,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G if (CS%debug) then call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) endif - if (CS%use_kappa_shear .or. CS%use_cvmix_shear) then + if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eaml, ebml) if (CS%debug) then @@ -680,13 +680,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G endif ! endif for KPP ! Add vertical diff./visc. due to convection (computed via CVMix) - if (CS%use_cvmix_conv) then - call calculate_cvmix_conv(h, tv, G, GV, CS%cvmix_conv_csp, Hml) + if (CS%use_CVMix_conv) then + call calculate_CVMix_conv(h, tv, G, GV, CS%CVMix_conv_csp, Hml) !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,k) = Kd_int(i,j,k) + CS%cvmix_conv_csp%kd_conv(i,j,k) - visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%cvmix_conv_csp%kv_conv(i,j,k) + Kd_int(i,j,k) = Kd_int(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) + visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) enddo ; enddo ; enddo !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -2349,9 +2349,9 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, ! CS%use_tidal_mixing is set to True if an internal tidal dissipation scheme is to be used. CS%use_tidal_mixing = tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, CS%tidal_mixing_CSp) - ! CS%use_cvmix_conv is set to True if CVMix convection will be used, otherwise + ! CS%use_CVMix_conv is set to True if CVMix convection will be used, otherwise ! False. - CS%use_cvmix_conv = cvmix_conv_init(Time, G, GV, param_file, diag, CS%cvmix_conv_csp) + CS%use_CVMix_conv = CVMix_conv_init(Time, G, GV, param_file, diag, CS%CVMix_conv_csp) call entrain_diffusive_init(Time, G, GV, param_file, diag, CS%entrain_diffusive_CSp) @@ -2442,7 +2442,7 @@ subroutine diabatic_driver_end(CS) if (CS%use_tidal_mixing) call tidal_mixing_end(CS%tidal_mixing_CSp) - if (CS%use_cvmix_conv) call cvmix_conv_end(CS%cvmix_conv_csp) + if (CS%use_CVMix_conv) call CVMix_conv_end(CS%CVMix_conv_csp) if (CS%use_energetic_PBL) & call energetic_PBL_end(CS%energetic_PBL_CSp) From 6324a57c6a1547f5b3ce24c4c1f55c83d23930df Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 18 May 2018 16:24:56 -0400 Subject: [PATCH 0269/1072] +*Added forces%accumulate_rigidity Added a new element, accumulate_rigidity, to the mech_forcing type to control whether rigidity is reset or accumulated in various ice elements. With this change, the ISOMIP test cases return to acceptable solutions; other cases are unchanged. --- config_src/coupled_driver/MOM_surface_forcing.F90 | 1 + config_src/coupled_driver/ocean_model_MOM.F90 | 2 ++ config_src/mct_driver/ocn_comp_mct.F90 | 1 + src/core/MOM_forcing_type.F90 | 3 +++ src/ice_shelf/MOM_ice_shelf.F90 | 7 ++++++- 5 files changed, 13 insertions(+), 1 deletion(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 00ef5ae2be..c9ba0c913c 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -645,6 +645,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) 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 diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 8fb5b14dbe..da13bf3785 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -727,6 +727,8 @@ subroutine add_berg_flux_to_shelf(G, forces, fluxes, use_ice_shelf, density_ice, ! This section sets or augments the values of fields in forces. if (.not. use_ice_shelf) then forces%frac_shelf_u(:,:) = 0.0 ; forces%frac_shelf_v(:,:) = 0.0 + endif + if (.not. forces%accumulate_rigidity) then forces%rigidity_ice_u(:,:) = 0.0 ; forces%rigidity_ice_v(:,:) = 0.0 endif diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 398ae829a4..ae9ec3badc 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -1944,6 +1944,7 @@ subroutine ocn_import(forces, fluxes, Time, G, CS, state, x2o_o, ind, sw_decomp, fluxes%heat_added(:,:)=0.0 fluxes%salt_flux_added(:,:)=0.0 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 diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index e092c2a5ab..53a98ad7de 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -207,6 +207,9 @@ module MOM_forcing_type !< enabled, and is exactly 0 away from shelves or on land. rigidity_ice_u => NULL(), & !< Depth-integrated lateral viscosity of ice rigidity_ice_v => NULL() !< shelves or sea ice at u- or v-points (m3/s) + logical :: accumulate_rigidity = .false. !< If true, the rigidity due to various types of + !! ice needs to be accumulated, and the rigidity explicitly + !! reset to zero at the driver level when appropriate. logical :: initialized = .false. !< This indicates whether the appropriate !! arrays have been initialized. diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 56d4fc2ad0..d424db8248 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -978,13 +978,16 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) endif ! For various reasons, forces%rigidity_ice_[uv] is always updated here, and - ! it has been zeroed out where IOB is translated to forces. + ! it may have been zeroed out where IOB is translated to forces and + ! contributions from icebergs added subsequently. kv_rho_ice = CS%kv_ice / CS%density_ice do j=js,je ; do I=is-1,ie + if (.not.forces%accumulate_rigidity) forces%rigidity_ice_u(I,j) = 0.0 forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + & kv_rho_ice * min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) enddo ; enddo do J=js-1,je ; do i=is,ie + if (.not.forces%accumulate_rigidity) forces%rigidity_ice_v(i,J) = 0.0 forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + & kv_rho_ice * min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) enddo ; enddo @@ -1799,6 +1802,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%areaCu(I,j) > 0.0)) & forces%frac_shelf_u(I,j) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i+1,j)) / & (G%areaT(i,j) + G%areaT(i+1,j))) + if (.not.forces%accumulate_rigidity) forces%rigidity_ice_u(I,j) = 0.0 forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + & kv_rho_ice * min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) enddo ; enddo @@ -1807,6 +1811,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%areaCv(i,J) > 0.0)) & forces%frac_shelf_v(i,J) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i,j+1)) / & (G%areaT(i,j) + G%areaT(i,j+1))) + if (.not.forces%accumulate_rigidity) forces%rigidity_ice_v(i,J) = 0.0 forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + & kv_rho_ice * min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) enddo ; enddo From cc273629b858ddc197e2f6f43e75731d87cbac3f Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 18 May 2018 15:01:08 -0600 Subject: [PATCH 0270/1072] Clean up spaces and comments --- .../vertical/MOM_diabatic_driver.F90 | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index abc0d664f5..27ff1de4d9 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -484,13 +484,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G endif if (CS%ML_mix_first > 0.0) then -! This subroutine -! (1) Cools the mixed layer. -! (2) Performs convective adjustment by mixed layer entrainment. -! (3) Heats the mixed layer and causes it to detrain to -! Monin-Obukhov depth or minimum mixed layer depth. -! (4) Uses any remaining TKE to drive mixed layer entrainment. -! (5) Possibly splits buffer layer into two isopycnal layers (when using isopycnal coordinate) + ! This subroutine: + ! (1) Cools the mixed layer. + ! (2) Performs convective adjustment by mixed layer entrainment. + ! (3) Heats the mixed layer and causes it to detrain to + ! Monin-Obukhov depth or minimum mixed layer depth. + ! (4) Uses any remaining TKE to drive mixed layer entrainment. + ! (5) Possibly splits buffer layer into two isopycnal layers (when using isopycnal coordinate) call find_uv_at_h(u, v, h, u_h, v_h, G, GV) call cpu_clock_begin(id_clock_mixedlayer) @@ -525,11 +525,12 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G if (showCallTree) call callTree_waypoint("done with 1st bulkmixedlayer (diabatic)") if (CS%debugConservation) call MOM_state_stats('1st bulkmixedlayer', u, v, h, tv%T, tv%S, G) endif - endif + endif ! end CS%bulkmixedlayer if (CS%debug) then call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) endif + if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eaml, ebml) @@ -586,7 +587,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G CS%int_tide_input%tideamp, CS%int_tide_input%Nb, dt, G, GV, CS%int_tide_CSp) endif if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") - endif + endif ! end CS%use_int_tides call cpu_clock_begin(id_clock_set_diffusivity) ! Sets: Kd, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S From 0626bca9dc97fed54bb6eb2692964881a60cf526 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 19 May 2018 05:44:08 -0400 Subject: [PATCH 0271/1072] Improved post_data peculiar size error messsages Improved the post_data peculiar size error messsages, so that they now give information about which diagnostic is being posted, the understood sizes, and the strange size that has been sent in. All answers are bitwise identical. --- src/framework/MOM_diag_mediator.F90 | 90 +++++++++++++++++------------ 1 file changed, 54 insertions(+), 36 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 67b8789109..6a148d1878 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -835,7 +835,9 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) ! (in,opt) mask - If present, use this real array as the data mask. real, dimension(:,:), pointer :: locfield => NULL() + character(len=300) :: mesg logical :: used, is_stat + integer :: cszi, cszj, dszi, dszj integer :: isv, iev, jsv, jev, i, j, chksum is_stat = .false. ; if (present(is_static)) is_stat = is_static @@ -847,27 +849,34 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) ! the output data size and assumes that halos are symmetric. isv = diag_cs%is ; iev = diag_cs%ie ; jsv = diag_cs%js ; jev = diag_cs%je - if ( size(field,1) == diag_cs%ied-diag_cs%isd +1 ) then - isv = diag_cs%is ; iev = diag_cs%ie ! Data domain - elseif ( size(field,1) == diag_cs%ied-diag_cs%isd +2 ) then - isv = diag_cs%is ; iev = diag_cs%ie+1 ! Symmetric data domain - elseif ( size(field,1) == diag_cs%ie-diag_cs%is +1 ) then - isv = 1 ; iev = diag_cs%ie + 1-diag_cs%is ! Computational domain - elseif ( size(field,1) == diag_cs%ie-diag_cs%is +2 ) then - isv = 1 ; iev = diag_cs%ie + 2-diag_cs%is ! Symmetric computational domain + cszi = diag_cs%ie-diag_cs%is +1 ; dszi = diag_cs%ied-diag_cs%isd +1 + cszj = diag_cs%je-diag_cs%js +1 ; dszj = diag_cs%jed-diag_cs%jsd +1 + if ( size(field,1) == dszi ) then + isv = diag_cs%is ; iev = diag_cs%ie ! Data domain + elseif ( size(field,1) == dszi + 1 ) then + isv = diag_cs%is ; iev = diag_cs%ie+1 ! Symmetric data domain + elseif ( size(field,1) == cszi) then + isv = 1 ; iev = cszi ! Computational domain + elseif ( size(field,1) == cszi + 1 ) then + isv = 1 ; iev = cszi+1 ! Symmetric computational domain else - call MOM_error(FATAL,"post_data_2d_low: peculiar size in i-direction") + write (mesg,*) " peculiar size ",size(field,1)," in i-direction\n"//& + "does not match one of ", cszi, cszi+1, dszi, dszi+1 + call MOM_error(FATAL,"post_data_2d_low: "//trim(diag%debug_str)//trim(mesg)) endif - if ( size(field,2) == diag_cs%jed-diag_cs%jsd +1 ) then - jsv = diag_cs%js ; jev = diag_cs%je ! Data domain - elseif ( size(field,2) == diag_cs%jed-diag_cs%jsd +2 ) then - jsv = diag_cs%js ; jev = diag_cs%je+1 ! Symmetric data domain - elseif ( size(field,2) == diag_cs%je-diag_cs%js +1 ) then - jsv = 1 ; jev = diag_cs%je + 1-diag_cs%js ! Computational domain - elseif ( size(field,1) == diag_cs%je-diag_cs%js +2 ) then - jsv = 1 ; jev = diag_cs%je + 2-diag_cs%js ! Symmetric computational domain + + if ( size(field,2) == dszj ) then + jsv = diag_cs%js ; jev = diag_cs%je ! Data domain + elseif ( size(field,2) == dszj + 1 ) then + jsv = diag_cs%js ; jev = diag_cs%je+1 ! Symmetric data domain + elseif ( size(field,2) == cszj ) then + jsv = 1 ; jev = cszj ! Computational domain + elseif ( size(field,2) == cszj+1 ) then + jsv = 1 ; jev = cszj+1 ! Symmetric computational domain else - call MOM_error(FATAL,"post_data_2d_low: peculiar size in j-direction") + write (mesg,*) " peculiar size ",size(field,2)," in j-direction\n"//& + "does not match one of ", cszj, cszj+1, dszj, dszj+1 + call MOM_error(FATAL,"post_data_2d_low: "//trim(diag%debug_str)//trim(mesg)) endif if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) then @@ -1069,9 +1078,11 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) ! (in,opt) mask - If present, use this real array as the data mask. real, dimension(:,:,:), pointer :: locfield => NULL() + character(len=300) :: mesg logical :: used ! The return value of send_data is not used for anything. logical :: staggered_in_x, staggered_in_y logical :: is_stat + integer :: cszi, cszj, dszi, dszj integer :: isv, iev, jsv, jev, ks, ke, i, j, k, isv_c, jsv_c integer :: chksum @@ -1084,27 +1095,34 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) ! the output data size and assumes that halos are symmetric. isv = diag_cs%is ; iev = diag_cs%ie ; jsv = diag_cs%js ; jev = diag_cs%je - if ( size(field,1) == diag_cs%ied-diag_cs%isd +1 ) then - isv = diag_cs%is ; iev = diag_cs%ie ! Data domain - elseif ( size(field,1) == diag_cs%ied-diag_cs%isd +2 ) then - isv = diag_cs%is ; iev = diag_cs%ie+1 ! Symmetric data domain - elseif ( size(field,1) == diag_cs%ie-diag_cs%is +1 ) then - isv = 1 ; iev = diag_cs%ie + 1-diag_cs%is ! Computational domain - elseif ( size(field,1) == diag_cs%ie-diag_cs%is +2 ) then - isv = 1 ; iev = diag_cs%ie + 2-diag_cs%is ! Symmetric computational domain + cszi = (diag_cs%ie-diag_cs%is) +1 ; dszi = (diag_cs%ied-diag_cs%isd) +1 + cszj = (diag_cs%je-diag_cs%js) +1 ; dszj = (diag_cs%jed-diag_cs%jsd) +1 + if ( size(field,1) == dszi ) then + isv = diag_cs%is ; iev = diag_cs%ie ! Data domain + elseif ( size(field,1) == dszi + 1 ) then + isv = diag_cs%is ; iev = diag_cs%ie+1 ! Symmetric data domain + elseif ( size(field,1) == cszi) then + isv = 1 ; iev = cszi ! Computational domain + elseif ( size(field,1) == cszi + 1 ) then + isv = 1 ; iev = cszi+1 ! Symmetric computational domain else - call MOM_error(FATAL,"post_data_3d_low: peculiar size in i-direction") + write (mesg,*) " peculiar size ",size(field,1)," in i-direction\n"//& + "does not match one of ", cszi, cszi+1, dszi, dszi+1 + call MOM_error(FATAL,"post_data_3d_low: "//trim(diag%debug_str)//trim(mesg)) endif - if ( size(field,2) == diag_cs%jed-diag_cs%jsd +1 ) then - jsv = diag_cs%js ; jev = diag_cs%je ! Data domain - elseif ( size(field,2) == diag_cs%jed-diag_cs%jsd +2 ) then - jsv = diag_cs%js ; jev = diag_cs%je+1 ! Symmetric data domain - elseif ( size(field,2) == diag_cs%je-diag_cs%js +1 ) then - jsv = 1 ; jev = diag_cs%je + 1-diag_cs%js ! Computational domain - elseif ( size(field,1) == diag_cs%je-diag_cs%js +2 ) then - jsv = 1 ; jev = diag_cs%je + 2-diag_cs%js ! Symmetric computational domain + + if ( size(field,2) == dszj ) then + jsv = diag_cs%js ; jev = diag_cs%je ! Data domain + elseif ( size(field,2) == dszj + 1 ) then + jsv = diag_cs%js ; jev = diag_cs%je+1 ! Symmetric data domain + elseif ( size(field,2) == cszj ) then + jsv = 1 ; jev = cszj ! Computational domain + elseif ( size(field,2) == cszj+1 ) then + jsv = 1 ; jev = cszj+1 ! Symmetric computational domain else - call MOM_error(FATAL,"post_data_3d_low: peculiar size in j-direction") + write (mesg,*) " peculiar size ",size(field,2)," in j-direction\n"//& + "does not match one of ", cszj, cszj+1, dszj, dszj+1 + call MOM_error(FATAL,"post_data_3d_low: "//trim(diag%debug_str)//trim(mesg)) endif if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) then From 92157dd5d3b90315f1f6c341194d4f74b0b4d98b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 19 May 2018 05:44:50 -0400 Subject: [PATCH 0272/1072] Corrected MOM_tracer_chkinv index ranges Corrected index ranges for reproducing_sum in MOM_tracer_chkinv. Because the tracer array is passed into reproducing sum as an array, it is converted internally to start at 1, per F90 conventions. This is now compensated for in the tracer range arguments. The solutions are identical, as are the tracer inventories if the data domains start at 1, as is common with MOM6. --- src/tracer/MOM_tracer_registry.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index 2d95e8bc58..06ac26d120 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -727,11 +727,11 @@ end subroutine MOM_tracer_chksum !> Calculates and prints the global inventory of all tracers in the registry. subroutine MOM_tracer_chkinv(mesg, G, h, Tr, ntr) - character(len=*), intent(in) :: mesg !< message that appears on the chksum lines - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(tracer_type), intent(in) :: Tr(:) !< array of all of registered tracers - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses - integer, intent(in) :: ntr !< number of registered tracers + character(len=*), intent(in) :: mesg !< message that appears on the chksum lines + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(tracer_type), dimension(:), intent(in) :: Tr !< array of all of registered tracers + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses + integer, intent(in) :: ntr !< number of registered tracers real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: tr_inv !< Tracer inventory real :: total_inv @@ -743,7 +743,7 @@ subroutine MOM_tracer_chkinv(mesg, G, h, Tr, ntr) do k=1,nz ; do j=js,je ; do i=is,ie tr_inv(i,j,k) = Tr(m)%t(i,j,k)*h(i,j,k)*G%areaT(i,j)*G%mask2dT(i,j) enddo ; enddo ; enddo - total_inv = reproducing_sum(tr_inv, is, ie, js, je) + total_inv = reproducing_sum(tr_inv, is+(1-G%isd), ie+(1-G%isd), js+(1-G%jsd), je+(1-G%jsd)) if (is_root_pe()) write(0,'(A,1X,A5,1X,ES25.16,1X,A)') "h-point: inventory", Tr(m)%name, total_inv, mesg enddo From 1ffe2e273b08eacb5779836b962c74bd4a7b2292 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 20 May 2018 16:15:12 -0400 Subject: [PATCH 0273/1072] +Added forces%accumulate_p_surf Added a new element, accumulate_p_surf, to the mech_forcing type, to indicate whether surface pressure has been reset to 0 and can be accumulated across multiple contributions, or whether it should be reset if it is to be changed. All answers in existing test cases are bitwise identical. --- config_src/coupled_driver/MOM_surface_forcing.F90 | 6 ++++++ config_src/mct_driver/ocn_comp_mct.F90 | 1 + src/core/MOM_forcing_type.F90 | 4 ++++ 3 files changed, 11 insertions(+) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 2bdcea69c0..d4f64a23e9 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -662,7 +662,13 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) forces%p_surf(i,j) = forces%p_surf_full(i,j) enddo ; enddo endif + else + 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. wind_stagger = CS%wind_stagger if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. & diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 298387bfa9..09565d9d59 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -2143,6 +2143,7 @@ subroutine ocn_import(forces, fluxes, Time, G, CS, state, x2o_o, ind, sw_decomp, else forces%p_surf_SSH => forces%p_surf_full endif + forces%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. endif diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 9bec7f14b1..92d215ec91 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -207,6 +207,10 @@ module MOM_forcing_type !< enabled, and is exactly 0 away from shelves or on land. rigidity_ice_u => NULL(), & !< Depth-integrated lateral viscosity of ice rigidity_ice_v => NULL() !< shelves or sea ice at u- or v-points (m3/s) + logical :: accumulate_p_surf = .false. !< If true, the surface pressure due to the atmosphere + !! and various types of ice needs to be accumulated, and the + !! surface pressure explicitly reset to zero at the driver level + !! when appropriate. logical :: accumulate_rigidity = .false. !< If true, the rigidity due to various types of !! ice needs to be accumulated, and the rigidity explicitly !! reset to zero at the driver level when appropriate. From adb5f4281fe70328591266b1b36c6fcb3d515fb2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 20 May 2018 16:16:33 -0400 Subject: [PATCH 0274/1072] +Added add_shelf_forces Separated the new publicly visibile subroutine add_shelf_forces out of add_shelf_flux, permitting the dynamic forces to be set separately from the thermodynamic forcing. All answers are bitwise identical. --- src/ice_shelf/MOM_ice_shelf.F90 | 197 +++++++++++++++----------------- 1 file changed, 93 insertions(+), 104 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 1925232522..14c8ae0e3f 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -41,7 +41,7 @@ module MOM_ice_shelf use constants_mod, only: GRAV use mpp_mod, only : mpp_sum, mpp_max, mpp_min, mpp_pe, mpp_npes, mpp_sync use MOM_coms, only : reproducing_sum -use MOM_checksums, only : hchksum, qchksum, chksum, uchksum, vchksum +use MOM_checksums, only : hchksum, qchksum, chksum, uchksum, vchksum, uvchksum use time_interp_external_mod, only : init_external_field, time_interp_external use time_interp_external_mod, only : time_interp_external_init use time_manager_mod, only : print_time, time_type_to_real, real_to_time_type @@ -64,6 +64,7 @@ module MOM_ice_shelf public shelf_calc_flux, add_shelf_flux, initialize_ice_shelf, ice_shelf_end public ice_shelf_save_restart, solo_time_step +public add_shelf_forces !> Control structure that contains ice shelf parameters and diagnostics handles type, public :: ice_shelf_CS ; private @@ -923,7 +924,80 @@ subroutine change_thickness_using_melt(CS,G,time_step, fluxes) end subroutine change_thickness_using_melt -!> Updates suface fluxes that are influenced by sub-ice-shelf melting +!> This subroutine adds the mechanical forcing fields and perhaps shelf areas, based on +!! the ice state in ice_shelf_CS. +subroutine add_shelf_forces(G, CS, forces, do_shelf_area) + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(ice_shelf_CS), pointer :: CS !< This module's control structure. + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + logical, optional, intent(in) :: do_shelf_area !< If true find the shelf-covered areas. + + real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1. + real :: press_ice ! The pressure of the ice shelf per unit area of ocean (not ice) in Pa. + logical :: find_area ! If true find the shelf areas at u & v points. + + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed + + find_area = .true. ; if (present(do_shelf_area)) find_area = do_shelf_area + + if (find_area) then + ! The frac-_shelf is set over the widest possible area. Could it be smaller? + do j=jsd,jed ; do I=isd,ied-1 + forces%frac_shelf_u(I,j) = 0.0 + if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%areaCu(I,j) > 0.0)) & + forces%frac_shelf_u(I,j) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i+1,j)) / & + (G%areaT(i,j) + G%areaT(i+1,j))) + enddo ; enddo + do J=jsd,jed-1 ; do i=isd,ied + forces%frac_shelf_v(i,J) = 0.0 + if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%areaCv(i,J) > 0.0)) & + forces%frac_shelf_v(i,J) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i,j+1)) / & + (G%areaT(i,j) + G%areaT(i,j+1))) + enddo ; enddo + call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) + endif + + !### Consider working over a smaller array range. + do j=jsd,jed ; do i=isd,ied + press_ice = (CS%area_shelf_h(i,j) * G%IareaT(i,j)) * (CS%g_Earth * CS%mass_shelf(i,j)) + if (associated(forces%p_surf)) then + if (.not.forces%accumulate_p_surf) forces%p_surf(i,j) = 0.0 + forces%p_surf(i,j) = forces%p_surf(i,j) + press_ice + endif + if (associated(forces%p_surf_full)) then + if (.not.forces%accumulate_p_surf) forces%p_surf_full(i,j) = 0.0 + forces%p_surf_full(i,j) = forces%p_surf_full(i,j) + press_ice + endif + enddo ; enddo + + ! For various reasons, forces%rigidity_ice_[uv] is always updated here. Note + ! that it may have been zeroed out where IOB is translated to forces and + ! contributions from icebergs and the sea-ice pack added subsequently. + !### THE RIGIDITY SHOULD ALSO INCORPORATE AREAL-COVERAGE INFORMATION. + kv_rho_ice = CS%kv_ice / CS%density_ice + do j=js,je ; do I=is-1,ie + if (.not.forces%accumulate_rigidity) forces%rigidity_ice_u(I,j) = 0.0 + forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + & + kv_rho_ice * min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) + enddo ; enddo + do J=js-1,je ; do i=is,ie + if (.not.forces%accumulate_rigidity) forces%rigidity_ice_v(i,J) = 0.0 + forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + & + kv_rho_ice * min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) + enddo ; enddo + + if (CS%debug) then + call uvchksum("rigidity_ice_[uv]", forces%rigidity_ice_u, forces%rigidity_ice_v, & + G%HI, symmetric=.true.) + call uvchksum("frac_shelf_[uv]", forces%frac_shelf_u, forces%frac_shelf_v, & + G%HI, symmetric=.true.) + endif + +end subroutine add_shelf_forces + +!> Updates surface fluxes that are influenced by sub-ice-shelf melting subroutine add_shelf_flux(G, CS, state, forces, fluxes) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(ice_shelf_CS), pointer :: CS !< This module's control structure. @@ -960,51 +1034,17 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed - Irho0 = 1.0 / CS%Rho0 + + call add_shelf_forces(G, CS, forces, do_shelf_area=CS%shelf_mass_is_dynamic) + ! Determine ustar and the square magnitude of the velocity in the ! bottom boundary layer. Together these give the TKE source and ! vertical decay scale. - if (CS%shelf_mass_is_dynamic) then - do j=jsd,jed ; do I=isd,ied-1 - forces%frac_shelf_u(I,j) = 0.0 - if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%areaCu(I,j) > 0.0)) & - forces%frac_shelf_u(I,j) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i+1,j)) / & - (G%areaT(i,j) + G%areaT(i+1,j))) - enddo ; enddo - do J=jsd,jed-1 ; do i=isd,ied - forces%frac_shelf_v(i,J) = 0.0 - if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%areaCv(i,J) > 0.0)) & - forces%frac_shelf_v(i,J) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i,j+1)) / & - (G%areaT(i,j) + G%areaT(i,j+1))) - enddo ; enddo - call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) - endif - - ! For various reasons, forces%rigidity_ice_[uv] is always updated here, and - ! it may have been zeroed out where IOB is translated to forces and - ! contributions from icebergs added subsequently. - kv_rho_ice = CS%kv_ice / CS%density_ice - do j=js,je ; do I=is-1,ie - if (.not.forces%accumulate_rigidity) forces%rigidity_ice_u(I,j) = 0.0 - forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + & - kv_rho_ice * min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) - enddo ; enddo - do J=js-1,je ; do i=is,ie - if (.not.forces%accumulate_rigidity) forces%rigidity_ice_v(i,J) = 0.0 - forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + & - kv_rho_ice * min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) - enddo ; enddo if (CS%debug) then - if (associated(state%taux_shelf)) then - call uchksum(state%taux_shelf, "taux_shelf", G%HI, haloshift=0) - endif - if (associated(state%tauy_shelf)) then - call vchksum(state%tauy_shelf, "tauy_shelf", G%HI, haloshift=0) - call vchksum(forces%rigidity_ice_u, "rigidity_ice_u", G%HI, haloshift=0) - call vchksum(forces%rigidity_ice_v, "rigidity_ice_v", G%HI, haloshift=0) - call vchksum(forces%frac_shelf_u, "frac_shelf_u", G%HI, haloshift=0) - call vchksum(forces%frac_shelf_v, "frac_shelf_v", G%HI, haloshift=0) + if (associated(state%taux_shelf) .and. associated(state%tauy_shelf)) then + call uvchksum("tau[xy]_shelf", state%taux_shelf, state%tauy_shelf, & + G%HI, haloshift=0) endif endif @@ -1013,6 +1053,7 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) endif ! GMM: melting is computed using ustar_shelf (and not ustar), which has already ! been passed, I so believe we do not need to update fluxes%ustar. +! Irho0 = 1.0 / CS%Rho0 ! do j=js,je ; do i=is,ie ; if (fluxes%frac_shelf_h(i,j) > 0.0) then ! ### THIS SHOULD BE AN AREA WEIGHTED AVERAGE OF THE ustar_shelf POINTS. ! taux2 = 0.0 ; tauy2 = 0.0 @@ -1037,8 +1078,8 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) enddo ; enddo endif - do j=js,je ; do i=is,ie ; if (fluxes%frac_shelf_h(i,j) > 0.0) then - frac_area = fluxes%frac_shelf_h(i,j) + do j=js,je ; do i=is,ie ; if (CS%area_shelf_h(i,j) > 0.0) then + frac_area = fluxes%frac_shelf_h(i,j) !### Should this be 1-frac_shelf_h? if (associated(fluxes%sw)) fluxes%sw(i,j) = 0.0 if (associated(fluxes%sw_vis_dir)) fluxes%sw_vis_dir(i,j) = 0.0 if (associated(fluxes%sw_vis_dif)) fluxes%sw_vis_dif(i,j) = 0.0 @@ -1060,11 +1101,6 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) fluxes%sens(i,j) = -frac_area*CS%t_flux(i,j)*CS%flux_factor if (associated(fluxes%salt_flux)) & fluxes%salt_flux(i,j) = frac_area * CS%salt_flux(i,j)*CS%flux_factor - if (associated(forces%p_surf)) & - forces%p_surf(i,j) = frac_area * CS%g_Earth * CS%mass_shelf(i,j) - if (associated(forces%p_surf_full)) & - forces%p_surf_full(i,j) = frac_area * CS%g_Earth * CS%mass_shelf(i,j) - endif ; enddo ; enddo ! keep sea level constant by removing mass in the sponge @@ -1075,7 +1111,7 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) if (CS%constant_sea_level) then !### This code has lots of problems with hard coded constants and the use of - !### of non-reproducing sums. I needs to be refactored. -RWH + !### of non-reproducing sums. It needs to be refactored. -RWH if (.not. associated(fluxes%salt_flux)) allocate(fluxes%salt_flux(ie,je)) if (.not. associated(fluxes%vprec)) allocate(fluxes%vprec(ie,je)) @@ -1779,54 +1815,21 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call MOM_error(WARNING,"Initialize_ice_shelf: area_shelf_h exceeds G%areaT.") CS%area_shelf_h(i,j) = G%areaT(i,j) endif - if (present(fluxes)) then - if (G%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = CS%area_shelf_h(i,j) / G%areaT(i,j) - endif - if (present(forces)) then - if (associated(forces%p_surf)) & - forces%p_surf(i,j) = forces%p_surf(i,j) + & - fluxes%frac_shelf_h(i,j) * (CS%g_Earth * CS%mass_shelf(i,j)) - if (associated(forces%p_surf_full)) & - forces%p_surf_full(i,j) = forces%p_surf_full(i,j) + & - fluxes%frac_shelf_h(i,j) * (CS%g_Earth * CS%mass_shelf(i,j)) - endif enddo ; enddo - if (present(fluxes) .and. present(forces)) & - call copy_common_forcing_fields(forces, fluxes, G) + if (present(fluxes)) then ; do j=jsd,jed ; do i=isd,ied + if (G%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = CS%area_shelf_h(i,j) / G%areaT(i,j) + enddo ; enddo ; endif if (CS%DEBUG) then call hchksum(fluxes%frac_shelf_h, "IS init: frac_shelf_h", G%HI, haloshift=0) endif - if (present(forces) .and. .not. CS%solo_ice_sheet) then - kv_rho_ice = CS%kv_ice / CS%density_ice - do j=js,je ; do i=is-1,ie - forces%frac_shelf_u(I,j) = 0.0 - if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%areaCu(I,j) > 0.0)) & - forces%frac_shelf_u(I,j) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i+1,j)) / & - (G%areaT(i,j) + G%areaT(i+1,j))) - if (.not.forces%accumulate_rigidity) forces%rigidity_ice_u(I,j) = 0.0 - forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + & - kv_rho_ice * min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) - enddo ; enddo - do j=js-1,je ; do i=is,ie - forces%frac_shelf_v(i,J) = 0.0 - if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%areaCv(i,J) > 0.0)) & - forces%frac_shelf_v(i,J) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i,j+1)) / & - (G%areaT(i,j) + G%areaT(i,j+1))) - if (.not.forces%accumulate_rigidity) forces%rigidity_ice_v(i,J) = 0.0 - forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + & - kv_rho_ice * min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) - enddo ; enddo + if (present(forces)) then + call add_shelf_forces(G, CS, forces, do_shelf_area=.not.CS%solo_ice_sheet) endif - if (present(forces) .and. .not.CS%solo_ice_sheet) then - call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) - endif - ! call savearray2 ('frac_shelf_u'//procnum,forces%frac_shelf_u,CS%write_output_to_file) - ! call savearray2 ('frac_shelf_v'//procnum,forces%frac_shelf_v,CS%write_output_to_file) - ! call savearray2 ('frac_shelf_h'//procnum,fluxes%frac_shelf_h,CS%write_output_to_file) - ! call savearray2 ('area_shelf_h'//procnum,CS%area_shelf_h,CS%write_output_to_file) + if (present(fluxes) .and. present(forces)) & + call copy_common_forcing_fields(forces, fluxes, G) ! if we are calving to a mask, i.e. if a mask exists where a shelf cannot, then we read ! the mask from a file @@ -2070,7 +2073,6 @@ subroutine update_shelf_mass(G, CS, Time, fluxes, forces) if (associated(fluxes%lprec)) fluxes%lprec(i,j) = 0.0 if (associated(fluxes%sens)) fluxes%sens(i,j) = 0.0 if (associated(fluxes%frac_shelf_h)) fluxes%frac_shelf_h(i,j) = 0.0 - if (associated(forces%p_surf)) forces%p_surf(i,j) = 0.0 if (associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = 0.0 endif CS%area_shelf_h(i,j) = 0.0 @@ -2094,19 +2096,6 @@ subroutine update_shelf_mass(G, CS, Time, fluxes, forces) call pass_var(CS%hmask, G%domain) call pass_var(CS%mass_shelf, G%domain) - - ! update psurf in forces and frac_shelf_h in fluxes - do j=js,je ; do i=is,ie - if (associated(forces%p_surf)) & - forces%p_surf(i,j) = (CS%g_Earth * CS%mass_shelf(i,j)) - if (associated(forces%p_surf_full)) & - forces%p_surf_full(i,j) = (CS%g_Earth * CS%mass_shelf(i,j)) - if (G%areaT(i,j) > 0.0) & - fluxes%frac_shelf_h(i,j) = CS%area_shelf_h(i,j) / G%areaT(i,j) - enddo ; enddo - - call copy_common_forcing_fields(forces, fluxes, G) - end subroutine update_shelf_mass subroutine initialize_diagnostic_fields(CS, FE, Time) From 002e5d983d42a00ffd7ce8b41c2286b79b3a4f3d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 20 May 2018 20:34:25 -0400 Subject: [PATCH 0275/1072] +Eliminated unused triangular element routines Eliminated the unused triangular finite element subroutines and related arrays. Also added grid-type arguments to numerous internal subroutines, and used this to set array sizes. Eliminated the variable isym and the macros N[IJ]LIMB_SYM_ and [IJ]SUMSTART_INT_. Also eliminated the finite-element shape argument, FE, from some subroutines. All test cases are bitwise identical. --- src/ice_shelf/MOM_ice_shelf.F90 | 1401 ++++---------------- src/ice_shelf/shelf_triangular_FEstuff.F90 | 731 ---------- 2 files changed, 270 insertions(+), 1862 deletions(-) delete mode 100644 src/ice_shelf/shelf_triangular_FEstuff.F90 diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 14c8ae0e3f..3704fa6a67 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -11,7 +11,7 @@ module MOM_ice_shelf use MOM_diag_mediator, only : diag_mediator_init, set_diag_mediator_grid use MOM_diag_mediator, only : diag_ctrl, time_type, enable_averaging, disable_averaging use MOM_domains, only : MOM_domains_init, clone_MOM_domain -use MOM_domains, only : pass_var, pass_vector, TO_ALL, CGRID_NE, BGRID_NE +use MOM_domains, only : pass_var, pass_vector, TO_ALL, CGRID_NE, BGRID_NE, CORNER use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe use MOM_file_parser, only : read_param, get_param, log_param, log_version, param_file_type @@ -50,16 +50,8 @@ module MOM_ice_shelf #include #ifdef SYMMETRIC_LAND_ICE # define GRID_SYM_ .true. -# define NILIMB_SYM_ NIMEMB_SYM_ -# define NJLIMB_SYM_ NJMEMB_SYM_ -# define ISUMSTART_INT_ CS%grid%iscB+1 -# define JSUMSTART_INT_ CS%grid%jscB+1 #else # define GRID_SYM_ .false. -# define NILIMB_SYM_ NIMEMB_ -# define NJLIMB_SYM_ NJMEMB_ -# define ISUMSTART_INT_ CS%grid%iscB -# define JSUMSTART_INT_ CS%grid%jscB #endif public shelf_calc_flux, add_shelf_flux, initialize_ice_shelf, ice_shelf_end @@ -77,10 +69,22 @@ module MOM_ice_shelf real :: flux_factor = 1.0 !< A factor that can be used to turn off ice shelf !! melting (flux_factor = 0). character(len=128) :: restart_output_dir = ' ' + real, pointer, dimension(:,:) :: & mass_shelf => NULL(), & !< The mass per unit area of the ice shelf or !! sheet, in kg m-2. area_shelf_h => NULL(), & !< The area per cell covered by the ice shelf, in m2. + h_shelf => NULL(), & !< the thickness of the shelf in m, redundant + !! with mass but may make code more readable + hmask => NULL(),& !< Mask used to indicate ice-covered or partiall-covered cells + !! 1: fully covered, solve for velocity here (for now all + !! ice-covered cells are treated the same, this may change) + !! 2: partially covered, do not solve for velocity + !! 0: no ice in cell. + !! 3: bdry condition on thickness set - not in computational domain + !! -2 : default (out of computational boundary, and) not = 3 + !! NOTE: hmask will change over time and NEEDS TO BE MAINTAINED + !! otherwise the wrong nodes will be included in velocity calcs. t_flux => NULL(), & !< The UPWARD sensible ocean heat flux at the !! ocean-ice interface, in W m-2. @@ -100,21 +104,7 @@ module MOM_ice_shelf ! in meters per second??? on q-points (B grid) v_shelf => NULL(), & !< the meridional velocity of the ice shelf/sheet, !! in m/s ?? on q-points (B grid) - h_shelf => NULL(), & !< the thickness of the shelf in m, redundant - !! with mass but may make code more readable - hmask => NULL(),& !< Mask used to indicate ice-covered cells, as - !! well as partially-covered 1: fully covered, - !! solve for velocity here (for now all ice-covered - !! cells are treated the same, this may change) - !! 2: partially covered, do not solve for velocity - !! 0: no ice in cell. - !! 3: bdry condition on thickness set - not in - !! computational domain - !! -2 : default (out of computational boundary, - !! and not = 3 - !! NOTE: hmask will change over time and - !! NEEDS TO BE MAINTAINED otherwise the wrong nodes - !! will be included in velocity calcs. + u_face_mask => NULL(), & !> masks for velocity boundary conditions v_face_mask => NULL(), & !! on *C GRID* - this is because the FEM !! cares about FACES THAT GET INTEGRATED OVER, @@ -143,8 +133,6 @@ module MOM_ice_shelf tmask => NULL(), & ! masks for temperature boundary conditions ??? ice_visc_bilinear => NULL(), & - ice_visc_lower_tri => NULL(), & - ice_visc_upper_tri => NULL(), & thickness_boundary_values => NULL(), & u_boundary_values => NULL(), & v_boundary_values => NULL(), & @@ -155,8 +143,6 @@ module MOM_ice_shelf taub_beta_eff_bilinear => NULL(), & ! nonlinear part of "linearized" basal stress - ! exact form depends on basal law exponent ! and/or whether flow is "hybridized" a la Goldberg 2011 - taub_beta_eff_lower_tri => NULL(), & - taub_beta_eff_upper_tri => NULL(), & OD_rt => NULL(), float_frac_rt => NULL(), & !< two arrays that represent averages OD_av => NULL(), float_frac => NULL() !! of ocean values that are maintained @@ -360,6 +346,8 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) !! returned by a previous call to !! initialize_ice_shelf. + type(ocean_grid_type), pointer :: G => NULL() ! The grid structure used by the ice shelf. + real, dimension(SZI_(CS%grid)) :: & Rhoml, & !< Ocean mixed layer density in kg m-3. dR0_dT, & !< Partial derivative of the mixed layer density @@ -414,16 +402,16 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) character(4) :: stepnum character(2) :: procnum - type(ocean_grid_type), pointer :: G => NULL() real, parameter :: c2_3 = 2.0/3.0 integer :: i, j, is, ie, js, je, ied, jed, it1, it3, iters_vel_solve real, parameter :: rho_fw = 1000.0 ! fresh water density + if (.not. associated(CS)) call MOM_error(FATAL, "shelf_calc_flux: "// & "initialize_ice_shelf must be called before shelf_calc_flux.") call cpu_clock_begin(id_clock_shelf) - ! useful parameters G => CS%grid + ! useful parameters is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; ied = G%ied ; jed = G%jed I_ZETA_N = 1.0 / ZETA_N LF = CS%Lat_fusion @@ -459,7 +447,7 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) if (CS%shelf_mass_is_dynamic .and. CS%override_shelf_movement) then CS%time_step = time_step ! update shelf mass - if (CS%mass_from_file) call update_shelf_mass(G, CS, Time, fluxes, forces) + if (CS%mass_from_file) call update_shelf_mass(G, CS, Time) endif if (CS%DEBUG) then @@ -811,22 +799,22 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) ! note time_step is [s] and lprec is [kg / m^2 / s] - call ice_shelf_advect(CS, time_step, CS%lprec, Time) + call ice_shelf_advect(CS, G, time_step, CS%lprec, Time) CS%velocity_update_sub_counter = CS%velocity_update_sub_counter+1 if (CS%GL_couple .and. .not. CS%solo_ice_sheet) then - call update_OD_ffrac(CS, state%ocean_mass, CS%velocity_update_sub_counter, CS%nstep_velocity, & + call update_OD_ffrac(CS, G, state%ocean_mass, CS%velocity_update_sub_counter, CS%nstep_velocity, & CS%time_step, CS%velocity_update_time_step) else - call update_OD_ffrac_uncoupled(CS) + call update_OD_ffrac_uncoupled(CS, G) endif if (CS%velocity_update_sub_counter == CS%nstep_velocity) then if (is_root_pe()) write(*,*) "ABOUT TO CALL VELOCITY SOLVER" - call ice_shelf_solve_outer(CS, CS%u_shelf, CS%v_shelf, 1, iters_vel_solve, Time) + call ice_shelf_solve_outer(CS, G, CS%u_shelf, CS%v_shelf, iters_vel_solve, Time) CS%velocity_update_sub_counter = 0 @@ -943,7 +931,7 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) find_area = .true. ; if (present(do_shelf_area)) find_area = do_shelf_area if (find_area) then - ! The frac-_shelf is set over the widest possible area. Could it be smaller? + ! The frac_shelf is set over the widest possible area. Could it be smaller? do j=jsd,jed ; do I=isd,ied-1 forces%frac_shelf_u(I,j) = 0.0 if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%areaCu(I,j) > 0.0)) & @@ -1147,7 +1135,7 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) ! apply calving if (CS%min_thickness_simple_calve > 0.0) then - call ice_shelf_min_thickness_calve(CS,last_h_shelf,last_area_shelf_h,last_hmask) + call ice_shelf_min_thickness_calve(CS, G, last_h_shelf, last_area_shelf_h, last_hmask) ! convert to mass again last_mass_shelf = last_h_shelf * CS%density_ice endif @@ -1216,7 +1204,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl type(time_type), optional, intent(in) :: Time_in logical, optional, intent(in) :: solo_ice_sheet_in - type(ocean_grid_type), pointer :: G, OG ! Convenience pointers + type(ocean_grid_type), pointer :: G => NULL(), OG => NULL() ! Pointers to grids for convenience. type(directories) :: dirs type(vardesc) :: vd type(dyn_horgrid_type), pointer :: dG => NULL() @@ -1581,8 +1569,6 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl allocate( CS%h_boundary_values(isd:ied,jsd:jed) ) ; CS%h_boundary_values(:,:) = 0.0 allocate( CS%thickness_boundary_values(isd:ied,jsd:jed) ) ; CS%thickness_boundary_values(:,:) = 0.0 allocate( CS%ice_visc_bilinear(isd:ied,jsd:jed) ) ; CS%ice_visc_bilinear(:,:) = 0.0 - allocate( CS%ice_visc_lower_tri(isd:ied,jsd:jed) ) ; CS%ice_visc_lower_tri = 0.0 - allocate( CS%ice_visc_upper_tri(isd:ied,jsd:jed) ) ; CS%ice_visc_upper_tri = 0.0 allocate( CS%u_face_mask(Isdq:Iedq,jsd:jed) ) ; CS%u_face_mask(:,:) = 0.0 allocate( CS%v_face_mask(isd:ied,Jsdq:Jedq) ) ; CS%v_face_mask(:,:) = 0.0 allocate( CS%u_face_mask_boundary(Isdq:Iedq,jsd:jed) ) ; CS%u_face_mask_boundary(:,:) = -2.0 @@ -1593,8 +1579,6 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl allocate( CS%vmask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%vmask(:,:) = -1.0 allocate( CS%taub_beta_eff_bilinear(isd:ied,jsd:jed) ) ; CS%taub_beta_eff_bilinear(:,:) = 0.0 - allocate( CS%taub_beta_eff_upper_tri(isd:ied,jsd:jed) ) ; CS%taub_beta_eff_upper_tri(:,:) = 0.0 - allocate( CS%taub_beta_eff_lower_tri(isd:ied,jsd:jed) ) ; CS%taub_beta_eff_lower_tri(:,:) = 0.0 allocate( CS%OD_rt(isd:ied,jsd:jed) ) ; CS%OD_rt(:,:) = 0.0 allocate( CS%OD_av(isd:ied,jsd:jed) ) ; CS%OD_av(:,:) = 0.0 allocate( CS%float_frac(isd:ied,jsd:jed) ) ; CS%float_frac(:,:) = 0.0 @@ -1714,7 +1698,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl enddo if (CS%min_thickness_simple_calve > 0.0) then - call ice_shelf_min_thickness_calve(CS, CS%h_shelf, CS%area_shelf_h, CS%hmask) + call ice_shelf_min_thickness_calve(CS, G, CS%h_shelf, CS%area_shelf_h, CS%hmask) endif endif @@ -1806,7 +1790,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call cpu_clock_begin(id_clock_pass) call pass_var(G%bathyT, G%domain) call pass_var(CS%hmask, G%domain) - call update_velocity_masks(CS) + call update_velocity_masks(CS, G) call cpu_clock_end(id_clock_pass) endif @@ -1864,7 +1848,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl endif if (CS%shelf_mass_is_dynamic .and. .not.CS%override_shelf_movement) then -! call init_boundary_values(CS, time, CS%input_flux, CS%input_thickness, new_sim) +! call init_boundary_values(CS, G, time, CS%input_flux, CS%input_thickness, new_sim) if (.not. CS%isthermo) then CS%lprec(:,:) = 0.0 @@ -1873,8 +1857,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if (new_sim) then if (is_root_pe()) print *,"NEW SIM: initialize velocity" - call update_OD_ffrac_uncoupled(CS) - call ice_shelf_solve_outer(CS, CS%u_shelf, CS%v_shelf, 1, iters, Time) + call update_OD_ffrac_uncoupled(CS, G) + call ice_shelf_solve_outer(CS, G, CS%u_shelf, CS%v_shelf, iters, Time) ! write (procnum,'(I2)') mpp_pe() @@ -2054,12 +2038,10 @@ subroutine initialize_shelf_mass(G, param_file, CS, new_sim) end subroutine initialize_shelf_mass !> Updates the ice shelf mass using data from a file. -subroutine update_shelf_mass(G, CS, Time, fluxes, forces) +subroutine update_shelf_mass(G, CS, Time) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure type(time_type), intent(in) :: Time - type(forcing), intent(inout) :: fluxes - type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces ! local variables integer :: i, j, is, ie, js, je @@ -2068,13 +2050,6 @@ subroutine update_shelf_mass(G, CS, Time, fluxes, forces) call time_interp_external(CS%id_read_mass, Time, CS%mass_shelf) do j=js,je ; do i=is,ie - ! first, zero out fluxes applied during previous time step - if (CS%area_shelf_h(i,j) > 0.0) then - if (associated(fluxes%lprec)) fluxes%lprec(i,j) = 0.0 - if (associated(fluxes%sens)) fluxes%sens(i,j) = 0.0 - if (associated(fluxes%frac_shelf_h)) fluxes%frac_shelf_h(i,j) = 0.0 - if (associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = 0.0 - endif CS%area_shelf_h(i,j) = 0.0 CS%hmask(i,j) = 0. if (CS%mass_shelf(i,j) > 0.0) then @@ -2088,7 +2063,7 @@ subroutine update_shelf_mass(G, CS, Time, fluxes, forces) ! CS%hmask, CS%grid, CS%user_CS, Time, .true.) if (CS%min_thickness_simple_calve > 0.0) then - call ice_shelf_min_thickness_calve(CS, CS%h_shelf, CS%area_shelf_h, CS%hmask) + call ice_shelf_min_thickness_calve(CS, G, CS%h_shelf, CS%area_shelf_h, CS%hmask) endif call pass_var(CS%area_shelf_h, G%domain) @@ -2098,18 +2073,16 @@ subroutine update_shelf_mass(G, CS, Time, fluxes, forces) end subroutine update_shelf_mass -subroutine initialize_diagnostic_fields(CS, FE, Time) +subroutine initialize_diagnostic_fields(CS, G, Time) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - integer :: FE - type(time_type), intent(in) :: Time + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + type(time_type), intent(in) :: Time - type(ocean_grid_type), pointer :: G integer :: i, j, iters, isd, ied, jsd, jed real :: rhoi, rhow, OD type(time_type) :: dummy_time real,dimension(:,:),pointer :: OD_av, float_frac, h_shelf - G => CS%grid rhoi = CS%density_ice rhow = CS%density_ocean_avg dummy_time = set_time (0,0) @@ -2132,7 +2105,7 @@ subroutine initialize_diagnostic_fields(CS, FE, Time) enddo enddo - call ice_shelf_solve_outer(CS, CS%u_shelf, CS%v_shelf, FE, iters, dummy_time) + call ice_shelf_solve_outer(CS, G, CS%u_shelf, CS%v_shelf, iters, dummy_time) end subroutine initialize_diagnostic_fields @@ -2147,7 +2120,7 @@ subroutine ice_shelf_save_restart(CS, Time, directory, time_stamped, filename_su character(len=*), optional, intent(in) :: filename_suffix !< An optional suffix (e.g., a !! time-stamp) to append to the restart file names. ! local variables - type(ocean_grid_type), pointer :: G + type(ocean_grid_type), pointer :: G => NULL() character(len=200) :: restart_dir character(2) :: procnum @@ -2172,11 +2145,12 @@ subroutine ice_shelf_save_restart(CS, Time, directory, time_stamped, filename_su end subroutine ice_shelf_save_restart -subroutine ice_shelf_advect(CS, time_step, melt_rate, Time) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - real, intent(in) :: time_step - real, dimension(:,:), pointer :: melt_rate - type(time_type), intent(in) :: Time +subroutine ice_shelf_advect(CS, G, time_step, melt_rate, Time) + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real, intent(in) :: time_step + real, dimension(:,:), pointer :: melt_rate + type(time_type), intent(in) :: Time ! time_step: time step in sec ! melt_rate: basal melt rate in kg/m^2/s @@ -2217,7 +2191,6 @@ subroutine ice_shelf_advect(CS, time_step, melt_rate, Time) ! o--- (3) ---o ! - type(ocean_grid_type), pointer :: G real, dimension(size(CS%h_shelf,1),size(CS%h_shelf,2)) :: h_after_uflux, h_after_vflux real, dimension(size(CS%h_shelf,1),size(CS%h_shelf,2),4) :: flux_enter integer :: isd, ied, jsd, jed, i, j, isc, iec, jsc, jec @@ -2226,7 +2199,6 @@ subroutine ice_shelf_advect(CS, time_step, melt_rate, Time) character(len=2) :: procnum hmask => CS%hmask - G => CS%grid rho = CS%density_ice spy = 365 * 86400 ! seconds per year; is there a global constant for this? No - it is dependent upon a calendar. @@ -2247,14 +2219,14 @@ subroutine ice_shelf_advect(CS, time_step, melt_rate, Time) enddo enddo - call ice_shelf_advect_thickness_x(CS, time_step/spy, CS%h_shelf, h_after_uflux, flux_enter) + call ice_shelf_advect_thickness_x(CS, G, time_step/spy, CS%h_shelf, h_after_uflux, flux_enter) ! call enable_averaging(time_step,Time,CS%diag) ! call pass_var(h_after_uflux, G%domain) ! if (CS%id_h_after_uflux > 0) call post_data(CS%id_h_after_uflux, h_after_uflux, CS%diag) ! call disable_averaging(CS%diag) - call ice_shelf_advect_thickness_y(CS, time_step/spy, h_after_uflux, h_after_vflux, flux_enter) + call ice_shelf_advect_thickness_y(CS, G, time_step/spy, h_after_uflux, h_after_vflux, flux_enter) ! call enable_averaging(time_step,Time,CS%diag) ! call pass_var(h_after_vflux, G%domain) @@ -2270,12 +2242,12 @@ subroutine ice_shelf_advect(CS, time_step, melt_rate, Time) enddo if (CS%moving_shelf_front) then - call shelf_advance_front(CS, flux_enter) + call shelf_advance_front(CS, G, flux_enter) if (CS%min_thickness_simple_calve > 0.0) then - call ice_shelf_min_thickness_calve(CS, CS%h_shelf, CS%area_shelf_h, CS%hmask) + call ice_shelf_min_thickness_calve(CS, G, CS%h_shelf, CS%area_shelf_h, CS%hmask) endif if (CS%calve_to_mask) then - call calve_to_mask(CS, CS%h_shelf, CS%area_shelf_h, CS%hmask, CS%calve_mask) + call calve_to_mask(CS, G, CS%h_shelf, CS%area_shelf_h, CS%hmask, CS%calve_mask) endif endif @@ -2285,22 +2257,22 @@ subroutine ice_shelf_advect(CS, time_step, melt_rate, Time) !call change_thickness_using_melt(CS,G,time_step, fluxes) - call update_velocity_masks(CS) + call update_velocity_masks(CS, G) end subroutine ice_shelf_advect -subroutine ice_shelf_solve_outer(CS, u, v, FE, iters, time) +subroutine ice_shelf_solve_outer(CS, G, u, v, iters, time) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u, v - integer, intent(in) :: FE - integer, intent(out) :: iters - type(time_type), intent(in) :: time + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(inout) :: u, v + integer, intent(out) :: iters + type(time_type), intent(in) :: time real, dimension(:,:), pointer :: TAUDX, TAUDY, u_prev_iterate, v_prev_iterate, & u_bdry_cont, v_bdry_cont, Au, Av, err_u, err_v, & - geolonq, geolatq, u_last, v_last, float_cond, H_node - type(ocean_grid_type), pointer :: G - integer :: conv_flag, i, j, k,l, iter, isym, & + u_last, v_last, float_cond, H_node + integer :: conv_flag, i, j, k,l, iter, & isdq, iedq, jsdq, jedq, isd, ied, jsd, jed, isumstart, jsumstart, nodefloat, nsub real :: err_max, err_tempu, err_tempv, err_init, area, max_vel, tempu, tempv, rhoi, rhow real, pointer, dimension(:,:,:,:) :: Phi @@ -2313,7 +2285,6 @@ subroutine ice_shelf_solve_outer(CS, u, v, FE, iters, time) ! for GL interpolation - need to make this a readable parameter nsub = CS%n_sub_regularize - G => CS%grid isdq = G%isdB ; iedq = G%iedB ; jsdq = G%jsdB ; jedq = G%jedB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed rhoi = CS%density_ice @@ -2336,25 +2307,15 @@ subroutine ice_shelf_solve_outer(CS, u, v, FE, iters, time) allocate(H_node (G%isdB:G%iedB,G%jsdB:G%jedB)) ; H_node(:,:)=0 allocate(Phisub (nsub,nsub,2,2,2,2)) ; Phisub = 0.0 - geolonq => G%geoLonBu ; geolatq => G%geoLatBu + isumstart = G%isc + ! Include the edge if tile is at the western bdry; Should add a test to avoid this if reentrant. + if (G%isc+G%idg_offset==G%isg) isumstart = G%iscB - if (G%isc+G%idg_offset==G%isg) then - ! tile is at west bdry - isumstart = G%iscB - else - ! tile is interior - isumstart = ISUMSTART_INT_ - endif + jsumstart = G%jsc + ! Include the edge if tile is at the southern bdry; Should add a test to avoid this if reentrant. + if (G%jsc+G%jdg_offset==G%jsg) jsumstart = G%jscB - if (G%jsc+G%jdg_offset==G%jsg) then - ! tile is at south bdry - jsumstart = G%jscB - else - ! tile is interior - jsumstart = JSUMSTART_INT_ - endif - - call calc_shelf_driving_stress(CS, TAUDX, TAUDY, CS%OD_av, FE) + call calc_shelf_driving_stress(CS, G, TAUDX, TAUDY, CS%OD_av) ! this is to determine which cells contain the grounding line, ! the criterion being that the cell is ice-covered, with some nodes @@ -2366,7 +2327,7 @@ subroutine ice_shelf_solve_outer(CS, u, v, FE, iters, time) if (CS%GL_regularize) then - call interpolate_H_to_B(CS, CS%h_shelf, CS%hmask, H_node) + call interpolate_H_to_B(CS, G, CS%h_shelf, CS%hmask, H_node) call savearray2 ("H_node",H_node,CS%write_output_to_file) do j=G%jsc,G%jec @@ -2402,77 +2363,43 @@ subroutine ice_shelf_solve_outer(CS, u, v, FE, iters, time) u_prev_iterate(:,:) = u(:,:) v_prev_iterate(:,:) = v(:,:) - isym=0 - ! must prepare phi - if (FE == 1) then - allocate(Phi(isd:ied,jsd:jed,1:8,1:4)) ; Phi(:,:,:,:)=0 - - do j=jsd,jed - do i=isd,ied - - if (((i > isd) .and. (j > jsd)) .or. (isym == 1)) then - X(:,:) = geolonq(i-1:i,j-1:j)*1000 - Y(:,:) = geolatq(i-1:i,j-1:j)*1000 - else - X(2,:) = geolonq(i,j)*1000 - X(1,:) = geolonq(i,j)*1000-G%dxT(i,j) - Y(:,2) = geolatq(i,j)*1000 - Y(:,1) = geolatq(i,j)*1000-G%dyT(i,j) - endif + allocate(Phi(isd:ied,jsd:jed,1:8,1:4)) ; Phi(:,:,:,:)=0 - call bilinear_shape_functions(X, Y, Phi_temp, area) - Phi(i,j,:,:) = Phi_temp - - enddo - enddo - endif + do j=jsd,jed ; do i=isd,ied + if (((i > isd) .and. (j > jsd))) then + X(:,:) = G%geoLonBu(i-1:i,j-1:j)*1000 + Y(:,:) = G%geoLatBu(i-1:i,j-1:j)*1000 + else + X(2,:) = G%geoLonBu(i,j)*1000 + X(1,:) = G%geoLonBu(i,j)*1000-G%dxT(i,j) + Y(:,2) = G%geoLatBu(i,j)*1000 + Y(:,1) = G%geoLatBu(i,j)*1000-G%dyT(i,j) + endif - if (FE == 1) then - call calc_shelf_visc_bilinear(CS, u, v) + call bilinear_shape_functions(X, Y, Phi_temp, area) + Phi(i,j,:,:) = Phi_temp + enddo ; enddo - call pass_var(CS%ice_visc_bilinear, G%domain) - call pass_var(CS%taub_beta_eff_bilinear, G%domain) - else - call calc_shelf_visc_triangular(CS,u,v) + call calc_shelf_visc_bilinear(CS, G, u, v) - call pass_var(CS%ice_visc_upper_tri, G%domain) - call pass_var(CS%taub_beta_eff_upper_tri, G%domain) - call pass_var(CS%ice_visc_lower_tri, G%domain) - call pass_var(CS%taub_beta_eff_lower_tri, G%domain) - endif + call pass_var(CS%ice_visc_bilinear, G%domain) + call pass_var(CS%taub_beta_eff_bilinear, G%domain) ! makes sure basal stress is only applied when it is supposed to be - do j=G%jsd,G%jed - do i=G%isd,G%ied - if (FE == 1) then - CS%taub_beta_eff_bilinear(i,j) = CS%taub_beta_eff_bilinear(i,j) * CS%float_frac(i,j) - else - CS%taub_beta_eff_upper_tri(i,j) = CS%taub_beta_eff_upper_tri(i,j) * CS%float_frac(i,j) - CS%taub_beta_eff_lower_tri(i,j) = CS%taub_beta_eff_lower_tri(i,j) * CS%float_frac(i,j) - endif - enddo - enddo + do j=G%jsd,G%jed ; do i=G%isd,G%ied + CS%taub_beta_eff_bilinear(i,j) = CS%taub_beta_eff_bilinear(i,j) * CS%float_frac(i,j) + enddo ; enddo - if (FE == 1) then - call apply_boundary_values_bilinear(CS, time, Phisub, H_node, float_cond, & - rhoi/rhow, u_bdry_cont, v_bdry_cont) - elseif (FE == 2) then - call apply_boundary_values_triangle(CS, time, u_bdry_cont, v_bdry_cont) - endif + call apply_boundary_values_bilinear(CS, G, time, Phisub, H_node, float_cond, & + rhoi/rhow, u_bdry_cont, v_bdry_cont) Au(:,:) = 0.0 ; Av(:,:) = 0.0 - if (FE == 1) then - call CG_action_bilinear(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, CS%hmask, H_node, & - CS%ice_visc_bilinear, float_cond, G%bathyT, CS%taub_beta_eff_bilinear, G%areaT, & - G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) - elseif (FE == 2) then - call CG_action_triangular(Au, Av, u, v, CS%umask, CS%vmask, CS%hmask, CS%ice_visc_upper_tri, & - CS%ice_visc_lower_tri, CS%taub_beta_eff_upper_tri, CS%taub_beta_eff_lower_tri, & - G%dxT, G%dyT, G%areaT, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, isym) - endif + call CG_action_bilinear(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, CS%hmask, H_node, & + CS%ice_visc_bilinear, float_cond, G%bathyT, CS%taub_beta_eff_bilinear, G%areaT, & + G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) ! write (procnum,'(I2)') mpp_pe() @@ -2502,10 +2429,8 @@ subroutine ice_shelf_solve_outer(CS, u, v, FE, iters, time) do iter=1,100 - - call ice_shelf_solve_inner(CS, u, v, TAUDX, TAUDY, H_node, float_cond, & - FE, conv_flag, iters, time, Phi, Phisub) - + call ice_shelf_solve_inner(CS, G, u, v, TAUDX, TAUDY, H_node, float_cond, & + conv_flag, iters, time, Phi, Phisub) if (CS%DEBUG) then call qchksum(u, "u shelf", G%HI, haloshift=2) @@ -2514,17 +2439,9 @@ subroutine ice_shelf_solve_outer(CS, u, v, FE, iters, time) if (is_root_pe()) print *,"linear solve done",iters," iterations" - if (FE == 1) then - call calc_shelf_visc_bilinear(CS,u,v) - call pass_var(CS%ice_visc_bilinear, G%domain) - call pass_var(CS%taub_beta_eff_bilinear, G%domain) - else - call calc_shelf_visc_triangular(CS,u,v) - call pass_var(CS%ice_visc_upper_tri, G%domain) - call pass_var(CS%taub_beta_eff_upper_tri, G%domain) - call pass_var(CS%ice_visc_lower_tri, G%domain) - call pass_var(CS%taub_beta_eff_lower_tri, G%domain) - endif + call calc_shelf_visc_bilinear(CS, G, u, v) + call pass_var(CS%ice_visc_bilinear, G%domain) + call pass_var(CS%taub_beta_eff_bilinear, G%domain) if (iter == 1) then ! call savearray2 ("visc1",CS%ice_visc_bilinear,CS%write_output_to_file) @@ -2532,37 +2449,20 @@ subroutine ice_shelf_solve_outer(CS, u, v, FE, iters, time) ! makes sure basal stress is only applied when it is supposed to be - do j=G%jsd,G%jed - do i=G%isd,G%ied - if (FE == 1) then - CS%taub_beta_eff_bilinear(i,j) = CS%taub_beta_eff_bilinear(i,j) * CS%float_frac(i,j) - else - CS%taub_beta_eff_upper_tri(i,j) = CS%taub_beta_eff_upper_tri(i,j) * CS%float_frac(i,j) - CS%taub_beta_eff_lower_tri(i,j) = CS%taub_beta_eff_lower_tri(i,j) * CS%float_frac(i,j) - endif - enddo - enddo + do j=G%jsd,G%jed ; do i=G%isd,G%ied + CS%taub_beta_eff_bilinear(i,j) = CS%taub_beta_eff_bilinear(i,j) * CS%float_frac(i,j) + enddo ; enddo u_bdry_cont(:,:) = 0 ; v_bdry_cont(:,:) = 0 - if (FE == 1) then - call apply_boundary_values_bilinear(CS, time, Phisub, H_node, float_cond, & - rhoi/rhow, u_bdry_cont, v_bdry_cont) - elseif (FE == 2) then - call apply_boundary_values_triangle(CS, time, u_bdry_cont, v_bdry_cont) - endif + call apply_boundary_values_bilinear(CS, G, time, Phisub, H_node, float_cond, & + rhoi/rhow, u_bdry_cont, v_bdry_cont) Au(:,:) = 0 ; Av(:,:) = 0 - if (FE == 1) then - call CG_action_bilinear(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, CS%hmask, H_node, & - CS%ice_visc_bilinear, float_cond, G%bathyT, CS%taub_beta_eff_bilinear, G%areaT, G%isc-1, & - G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) - elseif (FE == 2) then - call CG_action_triangular(Au, Av, u, v, CS%umask, CS%vmask, CS%hmask, CS%ice_visc_upper_tri, & - CS%ice_visc_lower_tri, CS%taub_beta_eff_upper_tri, CS%taub_beta_eff_lower_tri, & - G%dxT, G%dyT, G%areaT, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, isym) - endif + call CG_action_bilinear(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, CS%hmask, H_node, & + CS%ice_visc_bilinear, float_cond, G%bathyT, CS%taub_beta_eff_bilinear, G%areaT, & + G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) err_max = 0 @@ -2647,12 +2547,12 @@ subroutine ice_shelf_solve_outer(CS, u, v, FE, iters, time) end subroutine ice_shelf_solve_outer -subroutine ice_shelf_solve_inner(CS, u, v, taudx, taudy, H_node, float_cond, FE, conv_flag, iters, time, Phi, Phisub) +subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, conv_flag, iters, time, Phi, Phisub) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u, v - real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(in) :: taudx, taudy, H_node + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u, v + real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: taudx, taudy, H_node real, dimension(:,:),intent(in) :: float_cond - integer, intent(in) :: FE integer, intent(out) :: conv_flag, iters type(time_type) :: time real, pointer, dimension(:,:,:,:) :: Phi @@ -2669,17 +2569,16 @@ subroutine ice_shelf_solve_inner(CS, u, v, taudx, taudy, H_node, float_cond, FE, real, dimension(:,:), pointer :: hmask, umask, vmask, u_bdry, v_bdry, & - visc, visc_lo, beta, beta_lo, geolonq, geolatq + visc, visc_lo, beta, beta_lo real, dimension(LBOUND(u,1):UBOUND(u,1),LBOUND(u,2):UBOUND(u,2)) :: & Ru, Rv, Zu, Zv, DIAGu, DIAGv, RHSu, RHSv, & ubd, vbd, Au, Av, Du, Dv, & Zu_old, Zv_old, Ru_old, Rv_old, & sum_vec, sum_vec_2 - integer :: iter, i, j, isym, isd, ied, jsd, jed, & + integer :: iter, i, j, isd, ied, jsd, jed, & isc, iec, jsc, jec, is, js, ie, je, isumstart, jsumstart, & isdq, iedq, jsdq, jedq, iscq, iecq, jscq, jecq, nx_halo, ny_halo real :: tol, beta_k, alpha_k, area, dot_p1, dot_p2, resid0, cg_halo, dot_p1a, dot_p2a - type(ocean_grid_type), pointer :: G character(1) :: procnum character(2) :: gridsize @@ -2692,9 +2591,6 @@ subroutine ice_shelf_solve_inner(CS, u, v, taudx, taudy, H_node, float_cond, FE, u_bdry => CS%u_boundary_values v_bdry => CS%v_boundary_values - G => CS%grid - geolonq => G%geoLonBu - geolatq => G%geoLatBu hmask => CS%hmask isdq = G%isdB ; iedq = G%iedB ; jsdq = G%jsdB ; jedq = G%jedB iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB @@ -2707,46 +2603,19 @@ subroutine ice_shelf_solve_inner(CS, u, v, taudx, taudy, H_node, float_cond, FE, Du(:,:) = 0 ; Dv(:,:) = 0 ; ubd(:,:) = 0 ; vbd(:,:) = 0 dot_p1 = 0 ; dot_p2 = 0 -! if (G%symmetric) then -! isym = 1 -! else -! isym = 0 -! endif + isumstart = G%isc + ! Include the edge if tile is at the western bdry; Should add a test to avoid this if reentrant. + if (G%isc+G%idg_offset==G%isg) isumstart = G%iscB - isym = 0 - - if (G%isc+G%idg_offset==G%isg) then - ! tile is at west bdry - isumstart = G%iscB - else - ! tile is interior - isumstart = ISUMSTART_INT_ - endif + jsumstart = G%jsc + ! Include the edge if tile is at the southern bdry; Should add a test to avoid this if reentrant. + if (G%jsc+G%jdg_offset==G%jsg) jsumstart = G%jscB - if (G%jsc+G%jdg_offset==G%jsg) then - ! tile is at south bdry - jsumstart = G%jscB - else - ! tile is interior - jsumstart = JSUMSTART_INT_ - endif - - if (FE == 1) then - visc => CS%ice_visc_bilinear - beta => CS%taub_beta_eff_bilinear - elseif (FE == 2) then - visc => CS%ice_visc_upper_tri - visc_lo => CS%ice_visc_lower_tri - beta => CS%taub_beta_eff_upper_tri - beta_lo => CS%taub_beta_eff_lower_tri - endif + visc => CS%ice_visc_bilinear + beta => CS%taub_beta_eff_bilinear - if (FE == 1) then - call apply_boundary_values_bilinear(CS, time, Phisub, H_node, float_cond, & - CS%density_ice/CS%density_ocean_avg, ubd, vbd) - elseif (FE == 2) then - call apply_boundary_values_triangle(CS, time, ubd, vbd) - endif + call apply_boundary_values_bilinear(CS, G, time, Phisub, H_node, float_cond, & + CS%density_ice/CS%density_ocean_avg, ubd, vbd) RHSu(:,:) = taudx(:,:) - ubd(:,:) RHSv(:,:) = taudy(:,:) - vbd(:,:) @@ -2754,28 +2623,15 @@ subroutine ice_shelf_solve_inner(CS, u, v, taudx, taudy, H_node, float_cond, FE, call pass_vector(RHSu, RHSv, G%domain, TO_ALL, BGRID_NE) - - if (FE == 1) then - call matrix_diagonal_bilinear(CS, float_cond, H_node, & - CS%density_ice/CS%density_ocean_avg, Phisub, DIAGu, DIAGv) + call matrix_diagonal_bilinear(CS, G, float_cond, H_node, & + CS%density_ice/CS%density_ocean_avg, Phisub, DIAGu, DIAGv) ! DIAGu(:,:) = 1 ; DIAGv(:,:) = 1 - elseif (FE == 2) then - call matrix_diagonal_triangle(CS, DIAGu, DIAGv) - DIAGu(:,:) = 1 ; DIAGv(:,:) = 1 - endif call pass_vector(DIAGu, DIAGv, G%domain, TO_ALL, BGRID_NE) - - - if (FE == 1) then - call CG_action_bilinear(Au, Av, u, v, Phi, Phisub, umask, vmask, hmask, & - H_node, visc, float_cond, G%bathyT, beta, G%areaT, isc-1, iec+1, jsc-1, & - jec+1, CS%density_ice/CS%density_ocean_avg) - elseif (FE == 2) then - call CG_action_triangular(Au, Av, u, v, umask, vmask, hmask, visc, visc_lo, & - beta, beta_lo, G%dxT, G%dyT, G%areaT, isc-1, iec+1, jsc-1, jec+1, isym) - endif + call CG_action_bilinear(Au, Av, u, v, Phi, Phisub, umask, vmask, hmask, & + H_node, visc, float_cond, G%bathyT, beta, G%areaT, G, isc-1, iec+1, jsc-1, & + jec+1, CS%density_ice/CS%density_ocean_avg) call pass_vector(Au, Av, G%domain, TO_ALL, BGRID_NE) @@ -2796,15 +2652,15 @@ subroutine ice_shelf_solve_inner(CS, u, v, taudx, taudy, H_node, float_cond, FE, sum_vec(:,:) = 0.0 - do j=JSUMSTART_INT_,jecq - do i=ISUMSTART_INT_,iecq + do j=jsumstart,jecq + do i=isumstart,iecq if (umask(i,j) == 1) sum_vec(i,j) = Ru(i,j)**2 if (vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + Rv(i,j)**2 enddo enddo - dot_p1 = reproducing_sum( sum_vec, ISUMSTART_INT_, iecq, & - JSUMSTART_INT_, jecq ) + dot_p1 = reproducing_sum( sum_vec, isumstart+(1-G%IsdB), Iecq+(1-G%IsdB), & + jsumstart+(1-G%JsdB), jecq+(1-G%JsdB) ) endif @@ -2844,18 +2700,9 @@ subroutine ice_shelf_solve_inner(CS, u, v, taudx, taudy, H_node, float_cond, FE, Au(:,:) = 0 ; Av(:,:) = 0 - if (FE == 1) then - - call CG_action_bilinear(Au, Av, Du, Dv, Phi, Phisub, umask, vmask, hmask, & - H_node, visc, float_cond, G%bathyT, beta, G%areaT, is, ie, js, & - je, CS%density_ice/CS%density_ocean_avg) - - elseif (FE == 2) then - - call CG_action_triangular(Au, Av, Du, Dv, umask, vmask, hmask, visc, visc_lo, & - beta, beta_lo, G%dxT, G%dyT, G%areaT, is, ie, js, je, isym) - endif - + call CG_action_bilinear(Au, Av, Du, Dv, Phi, Phisub, umask, vmask, hmask, & + H_node, visc, float_cond, G%bathyT, beta, G%areaT, G, is, ie, js, & + je, CS%density_ice/CS%density_ocean_avg) ! Au, Av valid region moves in by 1 @@ -2893,12 +2740,11 @@ subroutine ice_shelf_solve_inner(CS, u, v, taudx, taudy, H_node, float_cond, FE, enddo enddo - dot_p1 = reproducing_sum( sum_vec, iscq, iecq, & - jscq, jecq ) - - dot_p2 = reproducing_sum( sum_vec_2, iscq, iecq, & - jscq, jecq ) + dot_p1 = reproducing_sum( sum_vec, isumstart+(1-G%IsdB), Iecq+(1-G%IsdB), & + jsumstart+(1-G%JsdB), jecq+(1-G%JsdB) ) + dot_p2 = reproducing_sum( sum_vec_2, isumstart+(1-G%IsdB), Iecq+(1-G%IsdB), & + jsumstart+(1-G%JsdB), jecq+(1-G%JsdB) ) endif alpha_k = dot_p1/dot_p2 @@ -2974,8 +2820,8 @@ subroutine ice_shelf_solve_inner(CS, u, v, taudx, taudy, H_node, float_cond, FE, sum_vec(:,:) = 0.0 ; sum_vec_2(:,:) = 0.0 - do j=JSUMSTART_INT_,jecq - do i=ISUMSTART_INT_,iecq + do j=jsumstart,jecq + do i=isumstart,iecq if (umask(i,j) == 1) sum_vec(i,j) = Zu(i,j) * Ru(i,j) if (vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + & Zv(i,j) * Rv(i,j) @@ -2987,11 +2833,11 @@ subroutine ice_shelf_solve_inner(CS, u, v, taudx, taudy, H_node, float_cond, FE, enddo - dot_p1 = reproducing_sum( sum_vec, ISUMSTART_INT_, iecq, & - JSUMSTART_INT_, jecq ) + dot_p1 = reproducing_sum(sum_vec, isumstart+(1-G%IsdB), Iecq+(1-G%IsdB), & + jsumstart+(1-G%JsdB), Jecq+(1-G%JsdB) ) - dot_p2 = reproducing_sum( sum_vec_2, ISUMSTART_INT_, iecq, & - JSUMSTART_INT_, jecq ) + dot_p2 = reproducing_sum(sum_vec_2, isumstart+(1-G%IsdB), Iecq+(1-G%IsdB), & + jsumstart+(1-G%JsdB), Jecq+(1-G%JsdB) ) endif @@ -3030,15 +2876,15 @@ subroutine ice_shelf_solve_inner(CS, u, v, taudx, taudy, H_node, float_cond, FE, sum_vec(:,:) = 0.0 - do j=JSUMSTART_INT_,jecq - do i=ISUMSTART_INT_,iecq + do j=jsumstart,jecq + do i=isumstart,iecq if (umask(i,j) == 1) sum_vec(i,j) = Ru(i,j)**2 if (vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + Rv(i,j)**2 enddo enddo - dot_p1 = reproducing_sum( sum_vec, ISUMSTART_INT_, iecq, & - JSUMSTART_INT_, jecq ) + dot_p1 = reproducing_sum( sum_vec, isumstart+(1-G%IsdB), Iecq+(1-G%IsdB), & + jsumstart+(1-G%JsdB), jecq+(1-G%JsdB) ) ! if (is_root_pe()) print *, dot_p1 ! if (is_root_pe()) print *, dot_p1a @@ -3093,11 +2939,12 @@ subroutine ice_shelf_solve_inner(CS, u, v, taudx, taudy, H_node, float_cond, FE, end subroutine ice_shelf_solve_inner -subroutine ice_shelf_advect_thickness_x(CS, time_step, h0, h_after_uflux, flux_enter) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - real, intent(in) :: time_step - real, dimension(:,:), intent(in) :: h0 - real, dimension(:,:), intent(inout) :: h_after_uflux +subroutine ice_shelf_advect_thickness_x(CS, G, time_step, h0, h_after_uflux, flux_enter) + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, intent(in) :: time_step + real, dimension(:,:), intent(in) :: h0 + real, dimension(:,:), intent(inout) :: h_after_uflux real, dimension(:,:,:), intent(inout) :: flux_enter ! use will be made of CS%hmask here - its value at the boundary will be zero, just like uncovered cells @@ -3118,10 +2965,9 @@ subroutine ice_shelf_advect_thickness_x(CS, time_step, h0, h_after_uflux, flux_e ! o--- (3) ---o ! - integer :: isym, i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied integer :: i_off, j_off logical :: at_east_bdry, at_west_bdry, one_off_west_bdry, one_off_east_bdry - type(ocean_grid_type), pointer :: G real, dimension(-2:2) :: stencil real, dimension(:,:), pointer :: hmask, u_face_mask, u_flux_boundary_values real :: u_face, & ! positive if out @@ -3129,15 +2975,7 @@ subroutine ice_shelf_advect_thickness_x(CS, time_step, h0, h_after_uflux, flux_e character (len=1) :: debug_str, procnum -! if (CS%grid%symmetric) then -! isym = 1 -! else -! isym = 0 -! endif - - isym = 0 - G => CS%grid hmask => CS%hmask u_face_mask => CS%u_face_mask u_flux_boundary_values => CS%u_flux_boundary_values @@ -3334,11 +3172,12 @@ subroutine ice_shelf_advect_thickness_x(CS, time_step, h0, h_after_uflux, flux_e end subroutine ice_shelf_advect_thickness_x -subroutine ice_shelf_advect_thickness_y(CS, time_step, h_after_uflux, h_after_vflux, flux_enter) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - real, intent(in) :: time_step - real, dimension(:,:), intent(in) :: h_after_uflux - real, dimension(:,:), intent(inout) :: h_after_vflux +subroutine ice_shelf_advect_thickness_y(CS, G, time_step, h_after_uflux, h_after_vflux, flux_enter) + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, intent(in) :: time_step + real, dimension(:,:), intent(in) :: h_after_uflux + real, dimension(:,:), intent(inout) :: h_after_vflux real, dimension(:,:,:), intent(inout) :: flux_enter ! use will be made of CS%hmask here - its value at the boundary will be zero, just like uncovered cells @@ -3359,25 +3198,16 @@ subroutine ice_shelf_advect_thickness_y(CS, time_step, h_after_uflux, h_after_vf ! o--- (3) ---o ! - integer :: isym, i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied integer :: i_off, j_off logical :: at_north_bdry, at_south_bdry, one_off_west_bdry, one_off_east_bdry - type(ocean_grid_type), pointer :: G real, dimension(-2:2) :: stencil real, dimension(:,:), pointer :: hmask, v_face_mask, v_flux_boundary_values real :: v_face, & ! positive if out flux_diff_cell, phi, dxh, dyh, dxdyh character(len=1) :: debug_str, procnum -! if (CS%grid%symmetric) then -! isym = 1 -! else -! isym = 0 -! endif - - isym = 0 - G => CS%grid hmask => CS%hmask v_face_mask => CS%v_face_mask v_flux_boundary_values => CS%v_flux_boundary_values @@ -3549,8 +3379,9 @@ subroutine ice_shelf_advect_thickness_y(CS, time_step, h_after_uflux, h_after_vf end subroutine ice_shelf_advect_thickness_y -subroutine shelf_advance_front(CS, flux_enter) +subroutine shelf_advance_front(CS, G, flux_enter) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(:,:,:), intent(inout) :: flux_enter ! in this subroutine we go through the computational cells only and, if they are empty or partial cells, @@ -3580,17 +3411,15 @@ subroutine shelf_advance_front(CS, flux_enter) ! o--- (3) ---o ! - integer :: i, j, isc, iec, jsc, jec, n_flux, k, l, iter_count, isym + integer :: i, j, isc, iec, jsc, jec, n_flux, k, l, iter_count integer :: i_off, j_off integer :: iter_flag - type(ocean_grid_type), pointer :: G real, dimension(:,:), pointer :: hmask, mass_shelf, area_shelf_h, u_face_mask, v_face_mask, h_shelf real :: h_reference, dxh, dyh, dxdyh, rho, partial_vol, tot_flux integer, dimension(4) :: mapi, mapj, new_partial ! real, dimension(size(flux_enter,1),size(flux_enter,2),size(flux_enter,2)) :: flux_enter_replace real, dimension(:,:,:), pointer :: flux_enter_replace => NULL() - G => CS%grid h_shelf => CS%h_shelf hmask => CS%hmask mass_shelf => CS%mass_shelf @@ -3602,13 +3431,6 @@ subroutine shelf_advance_front(CS, flux_enter) rho = CS%density_ice iter_count = 0 ; iter_flag = 1 -! if (G%symmetric) then -! isym = 1 -! else -! isym = 0 -! endif - - isym = 0 mapi(1) = -1 ; mapi(2) = 1 ; mapi(3:4) = 0 mapj(3) = -1 ; mapj(4) = 1 ; mapj(1:2) = 0 @@ -3742,14 +3564,12 @@ subroutine shelf_advance_front(CS, flux_enter) end subroutine shelf_advance_front !> Apply a very simple calving law using a minimum thickness rule -subroutine ice_shelf_min_thickness_calve(CS, h_shelf, area_shelf_h,hmask) +subroutine ice_shelf_min_thickness_calve(CS, G, h_shelf, area_shelf_h,hmask) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(:,:), intent(inout) :: h_shelf, area_shelf_h, hmask - type(ocean_grid_type), pointer :: G integer :: i,j - G => CS%grid - do j=G%jsd,G%jed do i=G%isd,G%ied ! if ((h_shelf(i,j) < CS%min_thickness_simple_calve) .and. (hmask(i,j) == 1) .and. & @@ -3764,34 +3584,30 @@ subroutine ice_shelf_min_thickness_calve(CS, h_shelf, area_shelf_h,hmask) end subroutine ice_shelf_min_thickness_calve -subroutine calve_to_mask(CS, h_shelf, area_shelf_h, hmask, calve_mask) +subroutine calve_to_mask(CS, G, h_shelf, area_shelf_h, hmask, calve_mask) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(:,:), intent(inout) :: h_shelf, area_shelf_h, hmask, calve_mask - type(ocean_grid_type), pointer :: G integer :: i,j - G => CS%grid - if (CS%calve_to_mask) then - do j=G%jsc,G%jec - do i=G%isc,G%iec - if ((calve_mask(i,j) == 0.0) .and. (hmask(i,j) /= 0.0)) then - h_shelf(i,j) = 0.0 - area_shelf_h(i,j) = 0.0 - hmask(i,j) = 0.0 - endif - enddo - enddo + do j=G%jsc,G%jec ; do i=G%isc,G%iec + if ((calve_mask(i,j) == 0.0) .and. (hmask(i,j) /= 0.0)) then + h_shelf(i,j) = 0.0 + area_shelf_h(i,j) = 0.0 + hmask(i,j) = 0.0 + endif + enddo ; enddo endif end subroutine calve_to_mask -subroutine calc_shelf_driving_stress(CS, TAUD_X, TAUD_Y, OD, FE) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure +subroutine calc_shelf_driving_stress(CS, G, TAUD_X, TAUD_Y, OD) + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, dimension(:,:), intent(in) :: OD - real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: TAUD_X, TAUD_Y - integer, intent(in) :: FE + real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: TAUD_X, TAUD_Y ! driving stress! @@ -3804,10 +3620,8 @@ subroutine calc_shelf_driving_stress(CS, TAUD_X, TAUD_Y, OD, FE) ! "average" ocean depth -- and is needed to find surface elevation ! (it is assumed that base_ice = bed + OD) -! FE : 1 if bilinear, 2 if triangular linear FE - - real, dimension(:,:), pointer :: D, & ! ocean floor depth - H, & ! ice shelf thickness + ! real, dimension(:,:), pointer :: D ! ocean floor depth + real, dimension(:,:), pointer :: H, & ! ice shelf thickness hmask, u_face_mask, v_face_mask, float_frac real, dimension(SIZE(OD,1),SIZE(OD,2)) :: S, & ! surface elevation BASE ! basal elevation of shelf/stream @@ -3816,24 +3630,20 @@ subroutine calc_shelf_driving_stress(CS, TAUD_X, TAUD_Y, OD, FE) real :: rho, rhow, sx, sy, neumann_val, dxh, dyh, dxdyh - type(ocean_grid_type), pointer :: G - integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq + integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec integer :: i_off, j_off - G => CS%grid - - isym = 0 isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB isd = G%isd ; jsd = G%jsd iegq = G%iegB ; jegq = G%jegB gisc = G%domain%nihalo+1 ; gjsc = G%domain%njhalo+1 giec = G%domain%niglobal+G%domain%nihalo ; gjec = G%domain%njglobal+G%domain%njhalo - is = iscq - (1-isym); js = jscq - (1-isym) + is = iscq - 1; js = jscq - 1 i_off = G%idg_offset ; j_off = G%jdg_offset - D => G%bathyT +! D => G%bathyT H => CS%h_shelf float_frac => CS%float_frac hmask => CS%hmask @@ -3849,18 +3659,11 @@ subroutine calc_shelf_driving_stress(CS, TAUD_X, TAUD_Y, OD, FE) call savearray2 ("v_face_mask", CS%v_face_mask_boundary,CS%write_output_to_file) call savearray2 ("vmask", CS%vmask,CS%write_output_to_file) -! if (G%symmetric) then -! isym=1 -! else -! isym=0 -! endif - - isym = 0 ! prelim - go through and calculate S ! or is this faster? - BASE(:,:) = -D(:,:) + OD(:,:) + BASE(:,:) = -G%bathyT(:,:) + OD(:,:) S(:,:) = BASE(:,:) + H(:,:) ! write (procnum,'(I1)') mpp_pe() @@ -3945,48 +3748,24 @@ subroutine calc_shelf_driving_stress(CS, TAUD_X, TAUD_Y, OD, FE) endif endif + ! SW vertex + taud_x(i-1,j-1) = taud_x(i-1,j-1) - .25 * rho * grav * H(i,j) * sx * dxdyh + taud_y(i-1,j-1) = taud_y(i-1,j-1) - .25 * rho * grav * H(i,j) * sy * dxdyh - if (FE == 1) then + ! SE vertex + taud_x(i,j-1) = taud_x(i,j-1) - .25 * rho * grav * H(i,j) * sx * dxdyh + taud_y(i,j-1) = taud_y(i,j-1) - .25 * rho * grav * H(i,j) * sy * dxdyh - ! SW vertex - taud_x(i-1,j-1) = taud_x(i-1,j-1) - .25 * rho * grav * H(i,j) * sx * dxdyh - taud_y(i-1,j-1) = taud_y(i-1,j-1) - .25 * rho * grav * H(i,j) * sy * dxdyh + ! NW vertex + taud_x(i-1,j) = taud_x(i-1,j) - .25 * rho * grav * H(i,j) * sx * dxdyh + taud_y(i-1,j) = taud_y(i-1,j) - .25 * rho * grav * H(i,j) * sy * dxdyh - ! SE vertex - taud_x(i,j-1) = taud_x(i,j-1) - .25 * rho * grav * H(i,j) * sx * dxdyh - taud_y(i,j-1) = taud_y(i,j-1) - .25 * rho * grav * H(i,j) * sy * dxdyh - - ! NW vertex - taud_x(i-1,j) = taud_x(i-1,j) - .25 * rho * grav * H(i,j) * sx * dxdyh - taud_y(i-1,j) = taud_y(i-1,j) - .25 * rho * grav * H(i,j) * sy * dxdyh - - ! NE vertex - taud_x(i,j) = taud_x(i,j) - .25 * rho * grav * H(i,j) * sx * dxdyh - taud_y(i,j) = taud_y(i,j) - .25 * rho * grav * H(i,j) * sy * dxdyh - - - else - - ! SW vertex - taud_x(i-1,j-1) = taud_x(i-1,j-1) - (1./6) * rho * grav * H(i,j) * sx * dxdyh - taud_y(i-1,j-1) = taud_y(i-1,j-1) - (1./6) * rho * grav * H(i,j) * sy * dxdyh - - ! SE vertex - taud_x(i,j-1) = taud_x(i,j-1) - (1./3) * rho * grav * H(i,j) * sx * dxdyh - taud_y(i,j-1) = taud_y(i,j-1) - (1./3) * rho * grav * H(i,j) * sy * dxdyh - - ! NW vertex - taud_x(i-1,j) = taud_x(i-1,j) - (1./3) * rho * grav * H(i,j) * sx * dxdyh - taud_y(i-1,j) = taud_y(i-1,j) - (1./3) * rho * grav * H(i,j) * sy * dxdyh - - ! NE vertex - taud_x(i,j) = taud_x(i,j) - (1./6) * rho * grav * H(i,j) * sx * dxdyh - taud_y(i,j) = taud_y(i,j) - (1./6) * rho * grav * H(i,j) * sy * dxdyh - - endif + ! NE vertex + taud_x(i,j) = taud_x(i,j) - .25 * rho * grav * H(i,j) * sx * dxdyh + taud_y(i,j) = taud_y(i,j) - .25 * rho * grav * H(i,j) * sy * dxdyh if (float_frac(i,j) == 1) then - neumann_val = .5 * grav * (rho * H(i,j) ** 2 - rhow * D(i,j) ** 2) + neumann_val = .5 * grav * (rho * H(i,j) ** 2 - rhow * G%bathyT(i,j) ** 2) else neumann_val = .5 * grav * (1-rho/rhow) * rho * H(i,j) ** 2 endif @@ -4034,9 +3813,10 @@ subroutine calc_shelf_driving_stress(CS, TAUD_X, TAUD_Y, OD, FE) end subroutine calc_shelf_driving_stress -subroutine init_boundary_values(CS, time, input_flux, input_thick, new_sim) - type(time_type), intent(in) :: Time +subroutine init_boundary_values(CS, G, time, input_flux, input_thick, new_sim) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + type(time_type), intent(in) :: Time real, intent(in) :: input_flux, input_thick logical, optional, intent(in) :: new_sim !< If present and false, this run is being restarted @@ -4052,21 +3832,11 @@ subroutine init_boundary_values(CS, time, input_flux, input_thick, new_sim) u_boundary_values, & v_boundary_values, & u_face_mask, v_face_mask, hmask - type(ocean_grid_type), pointer :: G - integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq + integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq integer :: gjec, gisc, gjsc, cnt, isc, jsc, iec, jec integer :: i_off, j_off real :: A, n, ux, uy, vx, vy, eps_min, domain_width - G => CS%grid - -! if (G%symmetric) then -! isym=1 -! else -! isym=0 -! endif - - isym = 0 isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec ! iscq = G%iscq ; iecq = G%iecq ; jscq = G%jscq ; jecq = G%jecq @@ -4122,173 +3892,28 @@ subroutine init_boundary_values(CS, time, input_flux, input_thick, new_sim) end subroutine init_boundary_values -subroutine CG_action_triangular (uret, vret, u, v, umask, vmask, hmask, nu_upper, nu_lower, & - beta_upper, beta_lower, dxh, dyh, dxdyh, is, ie, js, je, isym) - -real, dimension(:,:), intent (inout) :: uret, vret -real, dimension(:,:), intent (in) :: u, v -real, dimension(:,:), intent (in) :: umask, vmask -real, dimension(:,:), intent (in) :: hmask, nu_upper, nu_lower, beta_upper, beta_lower -real, dimension(:,:), intent (in) :: dxh, dyh, dxdyh -integer, intent(in) :: is, ie, js, je, isym - -! the linear action of the matrix on (u,v) with triangular finite elements -! as of now everything is passed in so no grid pointers or anything of the sort have to be dereferenced, -! but this may change pursuant to conversations with others -! -! is & ie are the cells over which the iteration is done; this may change between calls to this subroutine -! in order to make less frequent halo updates -! isym = 1 if grid is symmetric, 0 o.w. - - real :: ux, uy, vx, vy - integer :: i,j - - do i=is,ie - do j=js,je - - if (hmask(i,j) == 1) then ! this cell's vertices contain degrees of freedom - ux = (u(i,j-1)-u(i-1,j-1))/dxh(i,j) - vx = (v(i,j-1)-v(i-1,j-1))/dxh(i,j) - uy = (u(i-1,j)-u(i-1,j-1))/dyh(i,j) - vy = (v(i-1,j)-v(i-1,j-1))/dyh(i,j) - - if (umask(i,j-1) == 1) then ! this (bot right) is a degree of freedom node - - uret(i,j-1) = uret(i,j-1) + & - .5 * dxdyh(i,j) * nu_lower(i,j) * ((4*ux+2*vy) * (1./dxh(i,j)) + (uy+vy) * (0./dyh(i,j))) - - vret(i,j-1) = vret(i,j-1) + & - .5 * dxdyh(i,j) * nu_lower(i,j) * ((uy+vx) * (1./dxh(i,j)) + (4*vy+2*ux) * (0./dyh(i,j))) - - uret(i,j-1) = uret(i,j-1) + & - beta_lower(i,j) * dxdyh(i,j) * 1./24 * (u(i-1,j-1) + & - u(i-1,j) + u(i,j-1)) - - vret(i,j-1) = vret(i,j-1) + & - beta_lower(i,j) * dxdyh(i,j) * 1./24 * (v(i-1,j-1) + & - v(i-1,j) + v(i,j-1)) - endif - - if (umask(i-1,j) == 1) then ! this (top left) is a degree of freedom node - - uret(i-1,j) = uret(i-1,j) + & - .5 * dxdyh(i,j) * nu_lower(i,j) * ((4*ux+2*vy) * (0./dxh(i,j)) + (uy+vy) * (1./dyh(i,j))) - - vret(i-1,j) = vret(i-1,j) + & - .5 * dxdyh(i,j) * nu_lower(i,j) * ((uy+vx) * (0./dxh(i,j)) + (4*vy+2*ux) * (1./dyh(i,j))) - - uret(i,j-1) = uret(i,j-1) + & - beta_lower(i,j) * dxdyh(i,j) * 1./24 * (u(i-1,j-1) + & - u(i-1,j) + u(i,j-1)) - - vret(i,j-1) = vret(i,j-1) + & - beta_lower(i,j) * dxdyh(i,j) * 1./24 * (v(i-1,j-1) + & - v(i-1,j) + v(i,j-1)) - endif - - if (umask(i-1,j-1) == 1) then ! this (bot left) is a degree of freedom node - - uret(i-1,j-1) = uret(i-1,j-1) + & - .5 * dxdyh(i,j) * nu_upper(i,j) * ((4*ux+2*vy) * (-1./dxh(i,j)) + (uy+vy) * (-1./dyh(i,j))) - - vret(i-1,j-1) = vret(i-1,j-1) + & - .5 * dxdyh(i,j) * nu_upper(i,j) * ((uy+vx) * (-1./dxh(i,j)) + (4*vy+2*ux) * (-1./dyh(i,j))) - - uret(i-1,j-1) = uret(i-1,j-1) + & - beta_lower(i,j) * dxdyh(i,j) * 1./24 * (u(i-1,j-1) + & - u(i-1,j) + u(i,j-1)) - - vret(i-1,j-1) = vret(i-1,j-1) + & - beta_lower(i,j) * dxdyh(i,j) * 1./24 * (v(i-1,j-1) + & - v(i-1,j) + v(i,j-1)) - endif - - - ux = (u(i,j)-u(i-1,j))/dxh(i,j) - vx = (v(i,j)-v(i-1,j))/dxh(i,j) - uy = (u(i,j)-u(i,j-1))/dyh(i,j) - vy = (v(i,j)-v(i,j-1))/dyh(i,j) - - if (umask(i,j-1) == 1) then ! this (bot right) is a degree of freedom node - - uret(i,j-1) = uret(i,j-1) + & - .5 * dxdyh(i,j) * nu_upper(i,j) * ((4*ux+2*vy) * (0./dxh(i,j)) + (uy+vy) * (-1./dyh(i,j))) - - vret(i,j-1) = vret(i,j-1) + & - .5 * dxdyh(i,j) * nu_upper(i,j) * ((uy+vx) * (0./dxh(i,j)) + (4*vy+2*ux) * (-1./dyh(i,j))) - - uret(i,j-1) = uret(i,j-1) + & - beta_upper(i,j) * dxdyh(i,j) * 1./24 * (u(i,j) + & - u(i-1,j) + u(i,j-1)) - - vret(i,j-1) = vret(i,j-1) + & - beta_upper(i,j) * dxdyh(i,j) * 1./24 * (u(i,j) + & - u(i-1,j) + u(i,j-1)) - endif - - if (umask(i-1,j) == 1) then ! this (top left) is a degree of freedom node - - uret(i-1,j) = uret(i-1,j) + & - .5 * dxdyh(i,j) * nu_upper(i,j) * ((4*ux+2*vy) * (-1./dxh(i,j)) + (uy+vy) * (0./dyh(i,j))) - - vret(i-1,j) = vret(i-1,j) + & - .5 * dxdyh(i,j) * nu_upper(i,j) * ((uy+vx) * (-1./dxh(i,j)) + (4*vy+2*ux) * (0./dyh(i,j))) - - uret(i,j-1) = uret(i,j-1) + & - beta_upper(i,j) * dxdyh(i,j) * 1./24 * (u(i,j) + & - u(i-1,j) + u(i,j-1)) - - vret(i,j-1) = vret(i,j-1) + & - beta_upper(i,j) * dxdyh(i,j) * 1./24 * (u(i,j) + & - u(i-1,j) + u(i,j-1)) - endif - - if (umask(i,j) == 1) then ! this (top right) is a degree of freedom node - - uret(i,j) = uret(i,j) + & - .5 * dxdyh(i,j) * nu_upper(i,j) * ((4*ux+2*vy) * (1./dxh(i,j)) + (uy+vy) * (1./dyh(i,j))) - - vret(i,j) = vret(i,j) + & - .5 * dxdyh(i,j) * nu_upper(i,j) * ((uy+vx) * (1./dxh(i,j)) + (4*vy+2*ux) * (1./dyh(i,j))) - - uret(i,j) = uret(i,j) + & - beta_upper(i,j) * dxdyh(i,j) * 1./24 * (u(i,j) + & - u(i-1,j) + u(i,j-1)) - - vret(i,j) = vret(i,j) + & - beta_upper(i,j) * dxdyh(i,j) * 1./24 * (u(i,j) + & - u(i-1,j) + u(i,j-1)) - endif - - endif - - enddo - enddo +subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmask, H_node, & + nu, float_cond, D, beta, dxdyh, G, is, ie, js, je, dens_ratio) -end subroutine CG_action_triangular + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent (inout) :: uret, vret + real, dimension(:,:,:,:), pointer :: Phi + real, dimension(:,:,:,:,:,:),pointer :: Phisub + real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent (in) :: u, v + real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent (in) :: umask, vmask, H_node + real, dimension(:,:), intent (in) :: hmask, nu, float_cond, D, beta, dxdyh + real, intent(in) :: dens_ratio + integer, intent(in) :: is, ie, js, je -subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmask, H_node, & - nu, float_cond, D, beta, dxdyh, is, ie, js, je, dens_ratio) - -real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent (inout) :: uret, vret -real, dimension(:,:,:,:), pointer :: Phi -real, dimension(:,:,:,:,:,:),pointer :: Phisub -real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent (in) :: u, v -real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent (in) :: umask, vmask, H_node -real, dimension(:,:), intent (in) :: hmask, nu, float_cond, D, beta, dxdyh -real, intent(in) :: dens_ratio -integer, intent(in) :: is, ie, js, je - -! the linear action of the matrix on (u,v) with triangular finite elements +! the linear action of the matrix on (u,v) with bilinear finite elements ! as of now everything is passed in so no grid pointers or anything of the sort have to be dereferenced, ! but this may change pursuant to conversations with others ! ! is & ie are the cells over which the iteration is done; this may change between calls to this subroutine ! in order to make less frequent halo updates -! isym = 1 if grid is symmetric, 0 o.w. -! the linear action of the matrix on (u,v) with triangular finite elements +! the linear action of the matrix on (u,v) with bilinear finite elements ! Phi has the form ! Phi(i,j,k,q) - applies to cell i,j @@ -4312,8 +3937,8 @@ subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmas ! dxh = G%dxh(i,j) ! dyh = G%dyh(i,j) ! -! X(:,:) = geolonq (i-1:i,j-1:j) -! Y(:,:) = geolatq (i-1:i,j-1:j) +! X(:,:) = G%geoLonBu(i-1:i,j-1:j) +! Y(:,:) = G%geoLatBu(i-1:i,j-1:j) ! ! call bilinear_shape_functions (X, Y, Phi, area) @@ -4512,197 +4137,29 @@ subroutine CG_action_subgrid_basal_bilinear (Phisub, H, U, V, DXDYH, D, dens_rat end subroutine CG_action_subgrid_basal_bilinear -subroutine matrix_diagonal_triangle(CS, u_diagonal, v_diagonal) - - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - real, dimension(:,:), intent(inout) :: u_diagonal, v_diagonal - -! returns the diagonal entries of the matrix for a Jacobi preconditioning - - real, pointer, dimension(:,:) :: umask, vmask, & - nu_lower, nu_upper, beta_lower, beta_upper, hmask - type(ocean_grid_type), pointer :: G - integer :: isym, i, j, is, js, cnt, isc, jsc, iec, jec - real :: A, n, ux, uy, vx, vy, eps_min, domain_width, dxh, dyh, dxdyh - - G => CS%grid - -! if (G%symmetric) then -! isym=1 -! else -! isym=0 -! endif - - isym = 0 - - isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec - - umask => CS%umask ; vmask => CS%vmask ; hmask => CS%hmask - nu_lower => CS%ice_visc_lower_tri ; nu_upper => CS%ice_visc_upper_tri - beta_lower => CS%taub_beta_eff_lower_tri ; beta_upper => CS%taub_beta_eff_upper_tri - - do i=isc-1,iec+1 ; do j=jsc-1,jec+1 ; if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) - - if (umask(i,j-1) == 1) then ! this (bot right) is a degree of freedom node - - ux = 1./dxh ; uy = 0./dyh - vx = 0. ; vy = 0. - - u_diagonal(i,j-1) = u_diagonal(i,j-1) + & - .5 * dxdyh * nu_lower(i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (0./dyh)) - - u_diagonal(i,j-1) = u_diagonal(i,j-1) + & - beta_lower(i,j) * dxdyh * 1./24 - - ux = 0. ; uy = 0. - vx = 1./dxh ; vy = 0./dyh - - v_diagonal(i,j-1) = v_diagonal(i,j-1) + & - .5 * dxdyh * nu_lower(i,j) * ((uy+vx) * (1./dxh) + (4*vy+2*ux) * (0./dyh)) - - v_diagonal(i,j-1) = v_diagonal(i,j-1) + & - beta_lower(i,j) * dxdyh * 1./24 - - ux = 0./dxh ; uy = -1./dyh - vx = 0. ; vy = 0. - - u_diagonal(i,j-1) = u_diagonal(i,j-1) + & - .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (-1./dyh)) - - u_diagonal(i,j-1) = u_diagonal(i,j-1) + & - beta_upper(i,j) * dxdyh * 1./24 - - vx = 0./dxh ; vy = -1./dyh - ux = 0. ; uy = 0. - - v_diagonal(i,j-1) = v_diagonal(i,j-1) + & - .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (0./dxh) + (4*vy+2*ux) * (-1./dyh)) - - v_diagonal(i,j-1) = v_diagonal(i,j-1) + & - beta_upper(i,j) * dxdyh * 1./24 - - endif - - if (umask(i-1,j) == 1) then ! this (top left) is a degree of freedom node - - ux = 0./dxh ; uy = 1./dyh - vx = 0. ; vy = 0. - - u_diagonal(i-1,j) = u_diagonal(i-1,j) + & - .5 * dxdyh * nu_lower(i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (1./dyh)) - - u_diagonal(i,j-1) = u_diagonal(i,j-1) + & - beta_lower(i,j) * dxdyh * 1./24 - - ux = 0. ; uy = 0. - vx = 0./dxh ; vy = 1./dyh - - v_diagonal(i-1,j) = v_diagonal(i-1,j) + & - .5 * dxdyh * nu_lower(i,j) * ((uy+vx) * (0./dxh) + (4*vy+2*ux) * (1./dyh)) - - v_diagonal(i,j-1) = v_diagonal(i,j-1) + & - beta_lower(i,j) * dxdyh * 1./24 - - ux = -1./dxh ; uy = 0./dyh - vx = 0. ; vy = 0. - - u_diagonal(i-1,j) = u_diagonal(i-1,j) + & - .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (0./dyh)) - - u_diagonal(i,j-1) = u_diagonal(i,j-1) + & - beta_upper(i,j) * dxdyh * 1./24 - - vx = -1./dxh ; vy = 0./dyh - ux = 0. ; uy = 0. - - v_diagonal(i-1,j) = v_diagonal(i-1,j) + & - .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (-1./dxh) + (4*vy+2*ux) * (0./dyh)) - - v_diagonal(i,j-1) = v_diagonal(i,j-1) + & - beta_upper(i,j) * dxdyh * 1./24 - - endif - - if (umask(i-1,j-1) == 1) then ! this (bot left) is a degree of freedom node - - ux = -1./dxh ; uy = -1./dyh - vx = 0. ; vy = 0. - - u_diagonal(i-1,j-1) = u_diagonal(i-1,j-1) + & - .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (-1./dyh)) - - u_diagonal(i-1,j-1) = u_diagonal(i-1,j-1) + & - beta_lower(i,j) * dxdyh * 1./24 - - vx = -1./dxh ; vy = -1./dyh - ux = 0. ; uy = 0. - - v_diagonal(i-1,j-1) = v_diagonal(i-1,j-1) + & - .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (-1./dxh) + (4*vy+2*ux) * (-1./dyh)) - - v_diagonal(i-1,j-1) = v_diagonal(i-1,j-1) + & - beta_lower(i,j) * dxdyh * 1./24 - endif - - if (umask(i,j) == 1) then ! this (top right) is a degree of freedom node - - ux = 1./ dxh ; uy = 1./dyh - vx = 0. ; vy = 0. - - u_diagonal(i,j) = u_diagonal(i,j) + & - .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (1./dyh)) - - u_diagonal(i,j) = u_diagonal(i,j) + & - beta_upper(i,j) * dxdyh * 1./24 - vx = 1./ dxh ; vy = 1./dyh - ux = 0. ; uy = 0. - - v_diagonal(i,j) = v_diagonal(i,j) + & - .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (1./dxh) + (4*vy+2*ux) * (1./dyh)) - - v_diagonal(i,j) = v_diagonal(i,j) + & - beta_upper(i,j) * dxdyh * 1./24 - - endif - endif ; enddo ; enddo - -end subroutine matrix_diagonal_triangle - -subroutine matrix_diagonal_bilinear(CS, float_cond, H_node, dens_ratio, Phisub, u_diagonal, v_diagonal) +subroutine matrix_diagonal_bilinear(CS, G, float_cond, H_node, dens_ratio, Phisub, u_diagonal, v_diagonal) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(in) :: H_node + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: H_node real :: dens_ratio real, dimension(:,:), intent(in) :: float_cond real, dimension(:,:,:,:,:,:),pointer :: Phisub - real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u_diagonal, v_diagonal + real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u_diagonal, v_diagonal ! returns the diagonal entries of the matrix for a Jacobi preconditioning real, dimension(:,:), pointer :: umask, vmask, hmask, & nu, beta - type(ocean_grid_type), pointer :: G - integer :: isym, i, j, is, js, cnt, isc, jsc, iec, jec, iphi, jphi, iq, jq, ilq, jlq + integer :: i, j, is, js, cnt, isc, jsc, iec, jec, iphi, jphi, iq, jq, ilq, jlq real :: A, n, ux, uy, vx, vy, eps_min, domain_width, dxh, dyh, dxdyh, area, uq, vq, basel real, dimension(8,4) :: Phi real, dimension(4) :: X, Y real, dimension(2) :: xquad real, dimension(2,2) :: Hcell,Usubcontr,Vsubcontr - G => CS%grid - -! if (G%symmetric) then -! isym=1 -! else -! isym=0 -! endif - - isym = 0 isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec @@ -4852,193 +4309,17 @@ subroutine CG_diagonal_subgrid_basal_bilinear (Phisub, H, DXDYH, D, dens_ratio, end subroutine CG_diagonal_subgrid_basal_bilinear -subroutine apply_boundary_values_triangle(CS, time, u_boundary_contr, v_boundary_contr) - - type(time_type), intent(in) :: Time - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - real, dimension(:,:), intent(inout) :: u_boundary_contr, v_boundary_contr - -! this will be a per-setup function. the boundary values of thickness and velocity -! (and possibly other variables) will be updated in this function - - real, pointer, dimension(:,:) :: u_boundary_values, & - v_boundary_values, & - umask, vmask, hmask, & - nu_lower, nu_upper, beta_lower, beta_upper - type(ocean_grid_type), pointer :: G - integer :: isym, i, j, cnt, isc, jsc, iec, jec - real :: A, n, ux, uy, vx, vy, eps_min, domain_width, dxh, dyh, dxdyh - - G => CS%grid - -! if (G%symmetric) then -! isym=1 -! else -! isym=0 -! endif - - isym = 0 - - isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec - - u_boundary_values => CS%u_boundary_values - v_boundary_values => CS%v_boundary_values - umask => CS%umask ; vmask => CS%vmask ; hmask => CS%hmask - nu_lower => CS%ice_visc_lower_tri ; nu_upper => CS%ice_visc_upper_tri - beta_lower => CS%taub_beta_eff_lower_tri ; beta_upper => CS%taub_beta_eff_upper_tri - - domain_width = CS%len_lat - - do i=isc-1,iec+1 ; do j=jsc-1,jec+1 ; if (hmask(i,j) == 1) then - - if ((umask(i-1,j-1) == 3) .OR. (umask(i,j-1) == 3) .OR. (umask(i-1,j) == 3)) then - - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) - - ux = (u_boundary_values(i,j-1)-u_boundary_values(i-1,j-1))/dxh - vx = (v_boundary_values(i,j-1)-v_boundary_values(i-1,j-1))/dxh - uy = (u_boundary_values(i-1,j)-u_boundary_values(i-1,j-1))/dyh - vy = (v_boundary_values(i-1,j)-v_boundary_values(i-1,j-1))/dyh - - if (umask(i,j-1) == 1) then ! this (bot right) is a degree of freedom node - - u_boundary_contr(i,j-1) = u_boundary_contr(i,j-1) + & - .5 * dxdyh * nu_lower(i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (0./dyh)) - - v_boundary_contr(i,j-1) = v_boundary_contr(i,j-1) + & - .5 * dxdyh * nu_lower(i,j) * ((uy+vx) * (1./dxh) + (4*vy+2*ux) * (0./dyh)) - - u_boundary_contr(i,j-1) = u_boundary_contr(i,j-1) + & - beta_lower(i,j) * dxdyh * 1./24 * (u_boundary_values(i-1,j-1) + & - u_boundary_values(i-1,j) + u_boundary_values(i,j-1)) - - v_boundary_contr(i,j-1) = v_boundary_contr(i,j-1) + & - beta_lower(i,j) * dxdyh * 1./24 * (v_boundary_values(i-1,j-1) + & - v_boundary_values(i-1,j) + v_boundary_values(i,j-1)) - endif - - if (umask(i-1,j) == 1) then ! this (top left) is a degree of freedom node - - u_boundary_contr(i-1,j) = u_boundary_contr(i-1,j) + & - .5 * dxdyh * nu_lower(i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (1./dyh)) - - v_boundary_contr(i-1,j) = v_boundary_contr(i-1,j) + & - .5 * dxdyh * nu_lower(i,j) * ((uy+vx) * (0./dxh) + (4*vy+2*ux) * (1./dyh)) - - u_boundary_contr(i,j-1) = u_boundary_contr(i,j-1) + & - beta_lower(i,j) * dxdyh * 1./24 * (u_boundary_values(i-1,j-1) + & - u_boundary_values(i-1,j) + u_boundary_values(i,j-1)) - - v_boundary_contr(i,j-1) = v_boundary_contr(i,j-1) + & - beta_lower(i,j) * dxdyh * 1./24 * (v_boundary_values(i-1,j-1) + & - v_boundary_values(i-1,j) + v_boundary_values(i,j-1)) - endif - - if (umask(i-1,j-1) == 1) then ! this (bot left) is a degree of freedom node - - u_boundary_contr(i-1,j-1) = u_boundary_contr(i-1,j-1) + & - .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (-1./dyh)) - - v_boundary_contr(i-1,j-1) = v_boundary_contr(i-1,j-1) + & - .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (-1./dxh) + (4*vy+2*ux) * (-1./dyh)) - - u_boundary_contr(i-1,j-1) = u_boundary_contr(i-1,j-1) + & - beta_lower(i,j) * dxdyh * 1./24 * (u_boundary_values(i-1,j-1) + & - u_boundary_values(i-1,j) + u_boundary_values(i,j-1)) - - v_boundary_contr(i-1,j-1) = v_boundary_contr(i-1,j-1) + & - beta_lower(i,j) * dxdyh * 1./24 * (v_boundary_values(i-1,j-1) + & - v_boundary_values(i-1,j) + v_boundary_values(i,j-1)) - endif - - endif - - if ((umask(i,j) == 3) .OR. (umask(i,j-1) == 3) .OR. (umask(i-1,j) == 3)) then - - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) - - ux = (u_boundary_values(i,j)-u_boundary_values(i-1,j))/dxh - vx = (v_boundary_values(i,j)-v_boundary_values(i-1,j))/dxh - uy = (u_boundary_values(i,j)-u_boundary_values(i,j-1))/dyh - vy = (v_boundary_values(i,j)-v_boundary_values(i,j-1))/dyh - - if (umask(i,j-1) == 1) then ! this (bot right) is a degree of freedom node - - u_boundary_contr(i,j-1) = u_boundary_contr(i,j-1) + & - .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (-1./dyh)) - - v_boundary_contr(i,j-1) = v_boundary_contr(i,j-1) + & - .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (0./dxh) + (4*vy+2*ux) * (-1./dyh)) - - u_boundary_contr(i,j-1) = u_boundary_contr(i,j-1) + & - beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + & - u_boundary_values(i-1,j) + & - u_boundary_values(i,j-1)) - - v_boundary_contr(i,j-1) = v_boundary_contr(i,j-1) + & - beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + & - u_boundary_values(i-1,j) + & - u_boundary_values(i,j-1)) - endif - - if (umask(i-1,j) == 1) then ! this (top left) is a degree of freedom node - - u_boundary_contr(i-1,j) = u_boundary_contr(i-1,j) + & - .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (0./dyh)) - - v_boundary_contr(i-1,j) = v_boundary_contr(i-1,j) + & - .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (-1./dxh) + (4*vy+2*ux) * (0./dyh)) - - u_boundary_contr(i,j-1) = u_boundary_contr(i,j-1) + & - beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + & - u_boundary_values(i-1,j) + & - u_boundary_values(i,j-1)) - - v_boundary_contr(i,j-1) = v_boundary_contr(i,j-1) + & - beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + & - u_boundary_values(i-1,j) + & - u_boundary_values(i,j-1)) - endif - - if (umask(i,j) == 1) then ! this (top right) is a degree of freedom node - - u_boundary_contr(i,j) = u_boundary_contr(i,j) + & - .5 * dxdyh * nu_upper(i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (1./dyh)) - - v_boundary_contr(i,j) = v_boundary_contr(i,j) + & - .5 * dxdyh * nu_upper(i,j) * ((uy+vx) * (1./dxh) + (4*vy+2*ux) * (1./dyh)) - - u_boundary_contr(i,j) = u_boundary_contr(i,j) + & - beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + & - u_boundary_values(i-1,j) + & - u_boundary_values(i,j-1)) - - v_boundary_contr(i,j) = v_boundary_contr(i,j) + & - beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + & - u_boundary_values(i-1,j) + & - u_boundary_values(i,j-1)) - endif - - - endif - endif ; enddo ; enddo - -end subroutine apply_boundary_values_triangle - -subroutine apply_boundary_values_bilinear(CS, time, Phisub, H_node, float_cond, dens_ratio, & +subroutine apply_boundary_values_bilinear(CS, G, time, Phisub, H_node, float_cond, dens_ratio, & u_boundary_contr, v_boundary_contr) + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. type(time_type), intent(in) :: Time real, dimension(:,:,:,:,:,:),pointer:: Phisub - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent (in) :: H_node + real, dimension(SZDIB_(G),SZDJB_(G)), intent (in) :: H_node real, dimension(:,:), intent (in) :: float_cond real :: dens_ratio - real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u_boundary_contr, v_boundary_contr + real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u_boundary_contr, v_boundary_contr ! this will be a per-setup function. the boundary values of thickness and velocity ! (and possibly other variables) will be updated in this function @@ -5050,20 +4331,10 @@ subroutine apply_boundary_values_bilinear(CS, time, Phisub, H_node, float_cond, real, dimension(8,4) :: Phi real, dimension(4) :: X, Y real, dimension(2) :: xquad - type(ocean_grid_type), pointer :: G - integer :: isym, i, j, isc, jsc, iec, jec, iq, jq, iphi, jphi, ilq, jlq + integer :: i, j, isc, jsc, iec, jec, iq, jq, iphi, jphi, ilq, jlq real :: A, n, ux, uy, vx, vy, eps_min, domain_width, dxh, dyh, dxdyh, uq, vq, area, basel real, dimension(2,2) :: Ucell,Vcell,Hcell,Usubcontr,Vsubcontr - G => CS%grid - -! if (G%symmetric) then -! isym=1 -! else -! isym=0 -! endif - - isym = 0 isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec @@ -5209,98 +4480,14 @@ subroutine apply_boundary_values_bilinear(CS, time, Phisub, H_node, float_cond, end subroutine apply_boundary_values_bilinear -subroutine calc_shelf_visc_triangular(CS,u,v) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - real, dimension(:,:), intent(inout) :: u, v -! update DEPTH_INTEGRATED viscosity, based on horizontal strain rates - this is for triangle FEM solve so there is -! an "upper" and "lower" triangular viscosity +subroutine calc_shelf_visc_bilinear(CS, G, u, v) + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent(inout) :: u, v -! also this subroutine updates the nonlinear part of the basal traction - -! this may be subject to change later... to make it "hybrid" - - real, pointer, dimension(:,:) :: nu_lower , & - nu_upper, & - beta_eff_lower, & - beta_eff_upper - real, pointer, dimension(:,:) :: H, &! thickness - hmask - - type(ocean_grid_type), pointer :: G - integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed - integer :: iegq, jegq, giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js - real :: A, n, ux, uy, vx, vy, eps_min, umid, vmid, unorm, C_basal_friction, n_basal_friction, dxh, dyh, dxdyh - - G => CS%grid - - if (G%symmetric) then - isym = 1 - else - isym = 0 - endif - - isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec - iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB - isd = G%isd ; jsd = G%jsd ; ied = G%isd ; jed = G%jsd - iegq = G%iegB ; jegq = G%jegB - gisc = G%domain%nihalo+1 ; gjsc = G%domain%njhalo+1 - giec = G%domain%niglobal+gisc ; gjec = G%domain%njglobal+gjsc - is = iscq - (1-isym); js = jscq - (1-isym) - - A = CS%A_glen_isothermal ; n = CS%n_glen; eps_min = CS%eps_glen_min - - H => CS%h_shelf - hmask => CS%hmask - nu_upper => CS%ice_visc_upper_tri - nu_lower => CS%ice_visc_lower_tri - beta_eff_upper => CS%taub_beta_eff_upper_tri - beta_eff_lower => CS%taub_beta_eff_lower_tri - - C_basal_friction = CS%C_basal_friction ; n_basal_friction = CS%n_basal_friction - - do i=isd,ied - do j=jsd,jed - - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) - - if (hmask(i,j) == 1) then - ux = (u(i,j-1)-u(i-1,j-1)) / dxh - vx = (v(i,j-1)-v(i-1,j-1)) / dxh - uy = (u(i-1,j)-u(i-1,j-1)) / dyh - vy = (v(i-1,j)-v(i-1,j-1)) / dyh - - nu_lower(i,j) = A**(-1/n) * (ux**2+vy**2+ux*vy+0.25*(uy+vx)**2+eps_min**2) ** ((1-n)/(2*n)) * H(i,j) - umid = 1./3 * (u(i-1,j-1)+u(i-1,j)+u(i,j-1)) - vmid = 1./3 * (v(i-1,j-1)+v(i-1,j)+v(i,j-1)) - unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) - beta_eff_lower(i,j) = C_basal_friction * unorm ** (n_basal_friction-1) - - ux = (u(i,j)-u(i-1,j)) / dxh - vx = (v(i,j)-v(i-1,j)) / dxh - uy = (u(i,j)-u(i,j-1)) / dyh - vy = (u(i,j)-u(i,j-1)) / dyh - - nu_upper(i,j) = A**(-1/n) * (ux**2+vy**2+ux*vy+0.25*(uy+vx)**2+eps_min**2) ** ((1-n)/(2*n)) * H(i,j) - umid = 1./3 * (u(i,j)+u(i-1,j)+u(i,j-1)) - vmid = 1./3 * (v(i,j)+v(i-1,j)+v(i,j-1)) - unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) - beta_eff_upper(i,j) = C_basal_friction * unorm ** (n_basal_friction-1) - - endif - enddo - enddo - -end subroutine calc_shelf_visc_triangular - -subroutine calc_shelf_visc_bilinear(CS, u, v) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - real, dimension(NILIMB_SYM_,NJLIMB_SYM_), intent(inout) :: u, v - -! update DEPTH_INTEGRATED viscosity, based on horizontal strain rates - this is for triangle FEM solve so there is -! an "upper" and "lower" triangular viscosity +! update DEPTH_INTEGRATED viscosity, based on horizontal strain rates - this is for bilinear FEM solve +! so there is an "upper" and "lower" bilinear viscosity ! also this subroutine updates the nonlinear part of the basal traction @@ -5311,21 +4498,17 @@ subroutine calc_shelf_visc_bilinear(CS, u, v) real, pointer, dimension(:,:) :: H, &! thickness hmask - type(ocean_grid_type), pointer :: G - integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq + integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js real :: A, n, ux, uy, vx, vy, eps_min, umid, vmid, unorm, C_basal_friction, n_basal_friction, dxh, dyh, dxdyh - G => CS%grid - - isym=0 isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed iegq = G%iegB ; jegq = G%jegB gisc = G%domain%nihalo+1 ; gjsc = G%domain%njhalo+1 giec = G%domain%niglobal+gisc ; gjec = G%domain%njglobal+gjsc - is = iscq - (1-isym); js = jscq - (1-isym) + is = iscq - 1; js = jscq - 1 A = CS%A_glen_isothermal ; n = CS%n_glen; eps_min = CS%eps_glen_min C_basal_friction = CS%C_basal_friction ; n_basal_friction = CS%n_basal_friction @@ -5359,22 +4542,20 @@ subroutine calc_shelf_visc_bilinear(CS, u, v) end subroutine calc_shelf_visc_bilinear -subroutine update_OD_ffrac(CS, ocean_mass, counter, nstep_velocity, time_step, velocity_update_time_step) +subroutine update_OD_ffrac(CS, G, ocean_mass, counter, nstep_velocity, time_step, velocity_update_time_step) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - real, dimension(CS%grid%isd:,CS%grid%jsd:) :: ocean_mass + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, dimension(G%isd:,G%jsd:) :: ocean_mass integer,intent(in) :: counter integer,intent(in) :: nstep_velocity real,intent(in) :: time_step real,intent(in) :: velocity_update_time_step - type(ocean_grid_type), pointer :: G integer :: isc, iec, jsc, jec, i, j - real :: threshold_col_depth, rho_ocean, inv_rho_ocean + real :: threshold_col_depth, rho_ocean, inv_rho_ocean threshold_col_depth = CS%thresh_float_col_depth - G=>CS%grid - rho_ocean = CS%density_ocean_avg inv_rho_ocean = 1./rho_ocean @@ -5410,17 +4591,16 @@ subroutine update_OD_ffrac(CS, ocean_mass, counter, nstep_velocity, time_step, v end subroutine update_OD_ffrac -subroutine update_OD_ffrac_uncoupled(CS) +subroutine update_OD_ffrac_uncoupled(CS, G) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - type(ocean_grid_type), pointer :: G integer :: i, j, iters, isd, ied, jsd, jed real :: rhoi, rhow, OD type(time_type) :: dummy_time real,dimension(:,:),pointer :: OD_av, float_frac, h_shelf - G => CS%grid rhoi = CS%density_ice rhow = CS%density_ocean_avg dummy_time = set_time (0,0) @@ -5581,22 +4761,21 @@ subroutine bilinear_shape_functions_subgrid (Phisub, nsub) end subroutine bilinear_shape_functions_subgrid -subroutine update_velocity_masks(CS) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure +subroutine update_velocity_masks(CS, G) + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. ! sets masks for velocity solve ! ignores the fact that their might be ice-free cells - this only considers the computational boundary ! !!!IMPORTANT!!! relies on thickness mask - assumed that this is called after hmask has been updated & halo-updated - integer :: isym, i, j, k, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq + integer :: i, j, k, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq integer :: giec, gjec, gisc, gjsc, isc, jsc, iec, jec integer :: i_off, j_off - type(ocean_grid_type), pointer :: G => NULL() real, dimension(:,:), pointer :: umask, vmask, u_face_mask, v_face_mask, hmask real, dimension(:,:), pointer :: u_face_mask_boundary, v_face_mask_boundary - G => CS%grid isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB i_off = G%idg_offset ; j_off = G%jdg_offset @@ -5614,14 +4793,6 @@ subroutine update_velocity_masks(CS) hmask => CS%hmask -! if (G%symmetric) then -! isym=1 -! else -! isym=0 -! endif - - isym = 0 - umask(:,:) = 0 ; vmask(:,:) = 0 u_face_mask(:,:) = 0 ; v_face_mask(:,:) = 0 @@ -5745,17 +4916,16 @@ subroutine update_velocity_masks(CS) end subroutine update_velocity_masks -subroutine interpolate_H_to_B(CS, h_shelf, hmask, H_node) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - real, dimension(:,:), intent(in) :: h_shelf, hmask - real, dimension(NILIMB_SYM_,NJLIMB_SYM_), & +subroutine interpolate_H_to_B(CS, G, h_shelf, hmask, H_node) + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, dimension(:,:), intent(in) :: h_shelf, hmask + real, dimension(SZDIB_(G),SZDJB_(G)), & intent(inout) :: H_node - type(ocean_grid_type), pointer :: G => NULL() integer :: i, j, isc, iec, jsc, jec, num_h, k, l real :: summ - G => CS%grid isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec H_node(:,:) = 0.0 @@ -5781,7 +4951,7 @@ subroutine interpolate_H_to_B(CS, h_shelf, hmask, H_node) enddo enddo - call pass_var(H_node, G%domain) + call pass_var(H_node, G%domain, position=CORNER) end subroutine interpolate_H_to_B @@ -5807,13 +4977,10 @@ subroutine ice_shelf_end(CS) deallocate(CS%t_boundary_values) deallocate(CS%u_boundary_values) ; deallocate(CS%v_boundary_values) deallocate(CS%ice_visc_bilinear) - deallocate(CS%ice_visc_lower_tri) ; deallocate(CS%ice_visc_upper_tri) deallocate(CS%u_face_mask) ; deallocate(CS%v_face_mask) deallocate(CS%umask) ; deallocate(CS%vmask) deallocate(CS%taub_beta_eff_bilinear) - deallocate(CS%taub_beta_eff_upper_tri) - deallocate(CS%taub_beta_eff_lower_tri) deallocate(CS%OD_rt) ; deallocate(CS%OD_av) deallocate(CS%float_frac) ; deallocate(CS%float_frac_rt) endif @@ -5990,7 +5157,7 @@ subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) write (stepnum,'(I4)') CS%velocity_update_sub_counter - call ice_shelf_advect(CS, time_step_int, CS%lprec, Time) + call ice_shelf_advect(CS, G, time_step_int, CS%lprec, Time) if (mpp_pe() == 7) then call savearray2 ("hmask",CS%hmask,CS%write_output_to_file) @@ -6001,17 +5168,17 @@ subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) ! if the last mini-timestep is a day or less, we cannot expect velocities to change by much. ! do not update them if (time_step_int > 1000) then - call update_velocity_masks(CS) + call update_velocity_masks(CS, G) ! call savearray2 ("Umask"//"p"//trim(procnum)//"_"//trim(stepnum),CS%umask,CS%write_output_to_file) ! call savearray2 ("Vmask"//"p"//trim(procnum)//"_"//trim(stepnum),CS%vmask,CS%write_output_to_file) - call update_OD_ffrac_uncoupled(CS) - call ice_shelf_solve_outer(CS, CS%u_shelf, CS%v_shelf, 1, iters, dummy) + call update_OD_ffrac_uncoupled(CS, G) + call ice_shelf_solve_outer(CS, G, CS%u_shelf, CS%v_shelf, iters, dummy) endif !!! OVS!!! - call ice_shelf_temp(CS, time_step_int, CS%lprec, Time) + call ice_shelf_temp(CS, G, time_step_int, CS%lprec, Time) call enable_averaging(time_step,Time,CS%diag) if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, CS%area_shelf_h, CS%diag) @@ -6038,8 +5205,9 @@ subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) end subroutine solo_time_step !!! OVS !!! -subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) +subroutine ice_shelf_temp(CS, G, time_step, melt_rate, Time) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), pointer :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step real, dimension(:,:), pointer :: melt_rate type(time_type), intent(in) :: Time @@ -6082,7 +5250,6 @@ subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) ! o--- (3) ---o ! - type(ocean_grid_type), pointer :: G => NULL() real, dimension(size(CS%h_shelf,1),size(CS%h_shelf,2)) :: th_after_uflux, th_after_vflux, TH real, dimension(size(CS%h_shelf,1),size(CS%h_shelf,2),4) :: flux_enter integer :: isd, ied, jsd, jed, i, j, isc, iec, jsc, jec @@ -6091,7 +5258,6 @@ subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) character(len=2) :: procnum hmask => CS%hmask - G => CS%grid rho = CS%density_ice spy = 365 * 86400 ! seconds per year; is there a global constant for this? No - it is dependent upon a calendar. @@ -6136,8 +5302,8 @@ subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) - call ice_shelf_advect_temp_x(CS, time_step/spy, TH, th_after_uflux, flux_enter) - call ice_shelf_advect_temp_y(CS, time_step/spy, th_after_uflux, th_after_vflux, flux_enter) + call ice_shelf_advect_temp_x(CS, G, time_step/spy, TH, th_after_uflux, flux_enter) + call ice_shelf_advect_temp_y(CS, G, time_step/spy, th_after_uflux, th_after_vflux, flux_enter) do j=jsd,jed do i=isd,ied @@ -6190,8 +5356,9 @@ subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) end subroutine ice_shelf_temp -subroutine ice_shelf_advect_temp_x(CS, time_step, h0, h_after_uflux, flux_enter) +subroutine ice_shelf_advect_temp_x(CS, G, time_step, h0, h_after_uflux, flux_enter) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step real, dimension(:,:), intent(in) :: h0 real, dimension(:,:), intent(inout) :: h_after_uflux @@ -6215,10 +5382,9 @@ subroutine ice_shelf_advect_temp_x(CS, time_step, h0, h_after_uflux, flux_enter) ! o--- (3) ---o ! - integer :: isym, i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied integer :: i_off, j_off logical :: at_east_bdry, at_west_bdry, one_off_west_bdry, one_off_east_bdry - type(ocean_grid_type), pointer :: G => NULL() real, dimension(-2:2) :: stencil real, dimension(:,:), pointer :: hmask, u_face_mask, u_flux_boundary_values,u_boundary_values,t_boundary real :: u_face, & ! positive if out @@ -6226,15 +5392,7 @@ subroutine ice_shelf_advect_temp_x(CS, time_step, h0, h_after_uflux, flux_enter) character (len=1) :: debug_str, procnum -! if (CS%grid%symmetric) then -! isym = 1 -! else -! isym = 0 -! endif - - isym = 0 - G => CS%grid hmask => CS%hmask u_face_mask => CS%u_face_mask u_flux_boundary_values => CS%u_flux_boundary_values @@ -6445,11 +5603,12 @@ subroutine ice_shelf_advect_temp_x(CS, time_step, h0, h_after_uflux, flux_enter) end subroutine ice_shelf_advect_temp_x -subroutine ice_shelf_advect_temp_y(CS, time_step, h_after_uflux, h_after_vflux, flux_enter) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - real, intent(in) :: time_step - real, dimension(:,:), intent(in) :: h_after_uflux - real, dimension(:,:), intent(inout) :: h_after_vflux +subroutine ice_shelf_advect_temp_y(CS, G, time_step, h_after_uflux, h_after_vflux, flux_enter) + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), pointer :: G !< The grid structure used by the ice shelf. + real, intent(in) :: time_step + real, dimension(:,:), intent(in) :: h_after_uflux + real, dimension(:,:), intent(inout) :: h_after_vflux real, dimension(:,:,:), intent(inout) :: flux_enter ! use will be made of CS%hmask here - its value at the boundary will be zero, just like uncovered cells @@ -6470,25 +5629,16 @@ subroutine ice_shelf_advect_temp_y(CS, time_step, h_after_uflux, h_after_vflux, ! o--- (3) ---o ! - integer :: isym, i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied integer :: i_off, j_off logical :: at_north_bdry, at_south_bdry, one_off_west_bdry, one_off_east_bdry - type(ocean_grid_type), pointer :: G => NULL() real, dimension(-2:2) :: stencil real, dimension(:,:), pointer :: hmask, v_face_mask, v_flux_boundary_values,t_boundary,v_boundary_values real :: v_face, & ! positive if out flux_diff_cell, phi, dxh, dyh, dxdyh character(len=1) :: debug_str, procnum -! if (CS%grid%symmetric) then -! isym = 1 -! else -! isym = 0 -! endif - isym = 0 - - G => CS%grid hmask => CS%hmask v_face_mask => CS%v_face_mask v_flux_boundary_values => CS%v_flux_boundary_values @@ -6712,15 +5862,9 @@ end subroutine ice_shelf_advect_temp_y !! bilinear_shape_functions - shape function for FEM solve using (convex) quadrilateral elements and !! bilinear nodal basis !! calc_shelf_visc_bilinear - Glen's law viscosity and nonlinear sliding law (called by ice_shelf_solve_outer) -!! calc_shelf_visc_triangular - LET'S TAKE THIS OUT !! apply_boundary_values_bilinear - same as CG_action_bilinear, but input is zero except for dirichlet bdry conds -!! apply_boundary_values_triangle - LET'S TAKE THIS OUT !! CG_action_bilinear - Effect of matrix (that is never explicitly constructed) !! on vector space of Degrees of Freedom (DoFs) in velocity solve -!! CG_action_triangular -LET'S TAKE THIS OUT -!! matrix_diagonal_bilinear - Returns the diagonal entries of a matrix for preconditioning. -!! (ISSUE: No need to use control structure - add arguments. -!! matrix_diagonal_triangle - LET'S TAKE THIS OUT !! ice_shelf_advect - Given the melt rate and velocities, it advects the ice shelf THICKNESS !! - modified h_shelf, area_shelf_h, hmask !! (maybe should updater mass_shelf as well ???) @@ -6745,11 +5889,6 @@ end subroutine ice_shelf_advect_temp_y !! Overall issues: Many variables need better documentation and units and the !! subgrid on which they are discretized. !! -!! DNG 4/09/11 : due to a misunderstanding (i confused a SYMMETRIC GRID -!! a SOUTHWEST GRID there is a variable called "isym" that appears -!! throughout in array loops. i am leaving it in for now, -!!though uniformly setting it to zero -!! !! \subsection section_ICE_SHELF_equations ICE_SHELF equations !! !! The three fundamental equations are: diff --git a/src/ice_shelf/shelf_triangular_FEstuff.F90 b/src/ice_shelf/shelf_triangular_FEstuff.F90 deleted file mode 100644 index 5c4fbaf213..0000000000 --- a/src/ice_shelf/shelf_triangular_FEstuff.F90 +++ /dev/null @@ -1,731 +0,0 @@ -module shelf_triangular_FEstuff - -! This file is part of MOM6. See LICENSE.md for the license. - -use MOM_diag_mediator, only : diag_ctrl, time_type, enable_averaging, disable_averaging -use MOM_grid, only : ocean_grid_type -use MOM_time_manager, only : time_type, set_time, time_type_to_real -use MOM_restart, only : restart_init, restore_state, MOM_restart_CS -use MOM_EOS, only : EOS_type -use user_shelf_init, only : user_ice_shelf_CS - -implicit none ; private - -#include -type, public :: ice_shelf_CS ; private - type(MOM_restart_CS), pointer :: restart_CSp => NULL() - type(ocean_grid_type) :: grid ! A structure containing metrics, etc. - ! The rest is private - character(len=128) :: restart_output_dir = ' ' - real, pointer, dimension(:,:) :: & - mass_shelf => NULL(), & ! The mass per unit area of the ice shelf or sheet, in kg m-2. - area_shelf_h => NULL(), & ! The area per cell covered by the ice shelf, in m2. - - t_flux => NULL(), & ! The UPWARD sensible ocean heat flux at the ocean-ice - ! interface, in W m-2. - salt_flux => NULL(), & ! The downward salt flux at the ocean-ice interface, in kg m-2 s-1. - lprec => NULL(), & ! The downward liquid water flux at the ocean-ice interface, - ! in kg m-2 s-1. - ! Perhaps these diagnostics should only be kept with the call? - exch_vel_t => NULL(), & - exch_vel_s => NULL(), & - tfreeze => NULL(), & ! The freezing point potential temperature an the ice-ocean - ! interface, in deg C. - tflux_shelf => NULL(), & ! The UPWARD diffusive heat flux in the ice shelf at the - ! ice-ocean interface, in W m-2. -!!! DNG !!! - u_shelf => NULL(), & ! the zonal (?) velocity of the ice shelf/sheet... in meters per second??? - ! on q-points (B grid) - v_shelf => NULL(), & ! the meridional velocity of the ice shelf/sheet... m/s ?? - ! on q-points (B grid) - h_shelf => NULL(), & ! the thickness of the shelf in m... redundant with mass - ! but may make code more readable - hmask => NULL(),& ! used to indicate ice-covered cells, as well as partially-covered - ! 1: fully covered, solve for velocity here - ! (for now all ice-covered cells are treated the same, this may change) - ! 2: partially covered, do not solve for velocity - ! 0: no ice in cell. - ! 3: bdry condition on thickness set - not in computational domain - ! -2 : default (out of computational boundary, and not = 3 - - ! NOTE: hmask will change over time and NEEDS TO BE MAINTAINED - ! otherwise the wrong nodes will be included in velocity calcs. - u_face_mask => NULL(), v_face_mask => NULL(), & - ! masks for velocity boundary conditions - on *C GRID* - this is because the FEM solution - ! cares about FACES THAT GET INTEGRATED OVER, not vertices - ! Will represent boundary conditions on computational boundary (or permanent boundary - ! between fast-moving and near-stagnant ice - ! FOR NOW: 1=interior bdry, 0=no-flow boundary, 2=stress bdry condition, 3=inhomogeneous dirichlet boundary - umask => NULL(), vmask => NULL(), & - ! masks on the actual degrees of freedom (B grid) - - ! 1=normal node, 3=inhomogeneous boundary node, 0 - no flow node (will also get ice-free nodes) - ice_visc_bilinear => NULL(), & - ice_visc_lower_tri => NULL(), & - ice_visc_upper_tri => NULL(), & - thickness_boundary_values => NULL(), & - u_boundary_values => NULL(), & - v_boundary_values => NULL(), & - - - taub_beta_eff_bilinear => NULL(), & ! nonlinear part of "linearized" basal stress - exact form depends on basal - ! law exponent and/or whether flow is "hybridized" a la Goldberg 2011 - taub_beta_eff_lower_tri => NULL(), & - taub_beta_eff_upper_tri => NULL(), & - - OD_rt => NULL(), float_frac_rt => NULL(), & - OD_av => NULL(), float_frac => NULL() !! two arrays that represent averages of ocean values that are maintained - !! within the ice shelf module and updated based on the "ocean state". - !! OD_av is ocean depth, and float_frac is the average amount of time - !! a cell is "exposed", i.e. the column thickness is below a threshold. - !! both are averaged over the time of a diagnostic (ice velocity) - - !! [if float_frac = 1 ==> grounded; obv. counterintuitive; might fix] - - real :: ustar_bg ! A minimum value for ustar under ice shelves, in m s-1. - real :: Cp ! The heat capacity of sea water, in J kg-1 K-1. - real :: Cp_ice ! The heat capacity of fresh ice, in J kg-1 K-1. - real :: gamma_t ! The (fixed) turbulent exchange velocity in the - ! 2-equation formulation, in m s-1. - real :: Salin_ice ! The salinity of shelf ice, in PSU. - real :: Temp_ice ! The core temperature of shelf ice, in C. - real :: kv_ice ! The viscosity of ice, in m2 s-1. - real :: density_ice ! A typical density of ice, in kg m-3. - real :: kv_molec ! The molecular kinematic viscosity of sea water, m2 s-1. - real :: kd_molec_salt ! The molecular diffusivity of salt, in m2 s-1. - real :: kd_molec_temp ! The molecular diffusivity of heat, in m2 s-1. - real :: Lat_fusion ! The latent heat of fusion, in J kg-1. - -!!!! PHYSICAL AND NUMERICAL PARAMETERS FOR ICE DYNAMICS !!!!!! - - real :: time_step ! this is the shortest timestep that the ice shelf sees, and - ! is equal to the forcing timestep (it is passed in when the shelf - ! is initialized - so need to reorganize MOM driver. - ! it will be the prognistic timestep ... maybe. - -!!! all need to be initialized - - real :: A_glen_isothermal - real :: n_glen - real :: eps_glen_min - real :: C_basal_friction - real :: n_basal_friction - real :: density_ocean_avg ! this does not affect ocean circulation OR thermodynamics - ! it is to estimate the gravitational driving force at the shelf front - ! (until we think of a better way to do it- but any difference will be negligible) - real :: thresh_float_col_depth ! the water column depth over which the shelf if considered to be floating - real :: input_flux - real :: input_thickness - - real :: len_lat ! this really should be a Grid or Domain field - - - real :: velocity_update_time_step ! the time to update the velocity through the nonlinear - ! elliptic equation. i think this should be done no more often than - ! ~ once a day (maybe longer) because it will depend on ocean values - ! that are averaged over this time interval, and the solve will begin - ! to lose meaning if it is done too frequently - integer :: velocity_update_sub_counter ! there is no outer loop for the velocity solve - ! the counter will have to be stored - integer :: velocity_update_counter ! the "outer" timestep number - integer :: nstep_velocity ! ~ (velocity_update_time_step / time_step) - - real :: cg_tolerance, nonlinear_tolerance - integer :: cg_max_iterations - integer :: nonlin_solve_err_mode ! 1: exit vel solve based on nonlin residual - ! 2: exit based on "fixed point" metric (|u - u_last| / |u| < tol where | | is infty-norm - real :: CFL_factor ! in uncoupled run, how to limit subcycled advective timestep - ! i.e. dt = CFL_factor * min (dx / u) - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - type(time_type) :: Time ! The component's time. - type(EOS_type), pointer :: eqn_of_state => NULL() ! Type that indicates the - ! equation of state to use. - logical :: isshelf ! True if a shelf model is to be used. - logical :: shelf_mass_is_dynamic ! True if the ice shelf mass changes with - ! time. - logical :: override_shelf_movement ! If true, user code specifies the shelf - ! movement instead of using the dynamic ice-shelf mode. - logical :: isthermo ! True if the ice shelf can exchange heat and mass with - ! the underlying ocean. - logical :: threeeq ! If true, the 3 equation consistency equations are - ! used to calculate the flux at the ocean-ice interface. - integer :: id_melt = -1, id_exch_vel_s = -1, id_exch_vel_t = -1, & - id_tfreeze = -1, id_tfl_shelf = -1, & - id_u_shelf = -1, id_v_shelf = -1, id_h_shelf = -1, id_h_mask = -1, & - id_u_mask = -1, id_v_mask = -1, & - id_surf_elev = -1, id_bathym = -1, id_float_frac = -1, id_col_thick = -1, & - id_area_shelf_h = -1, id_OD_rt = -1, id_float_frac_rt = -1 - type(diag_ctrl) :: diag ! A structure that is used to control diagnostic - ! output. - type(user_ice_shelf_CS), pointer :: user_CS => NULL() - - logical :: write_output_to_file ! this is for seeing arrays w/out netcdf capability -end type ice_shelf_CS -contains - -subroutine matrix_diagonal_triangle (CS, u_diagonal, v_diagonal) - - type(ice_shelf_CS), pointer :: CS - real, dimension (:,:), intent(inout) :: u_diagonal, v_diagonal - -! returns the diagonal entries of the matrix for a Jacobi preconditioning - - real, pointer, dimension (:,:) :: umask, vmask, & - nu_lower, nu_upper, beta_lower, beta_upper, hmask - type(ocean_grid_type), pointer :: G - integer :: i, j, is, js, cnt, isc, jsc, iec, jec - real :: A, n, ux, uy, vx, vy, eps_min, domain_width, dxh, dyh, dxdyh - - G => CS%grid - -! if (G%symmetric) then -! isym=1 -! else -! isym=0 -! endif - - - isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec - - umask => CS%umask ; vmask => CS%vmask ; hmask => CS%hmask - nu_lower => CS%ice_visc_lower_tri ; nu_upper => CS%ice_visc_upper_tri - beta_lower => CS%taub_beta_eff_lower_tri ; beta_upper => CS%taub_beta_eff_upper_tri - - do i=isc-1,iec+1 ; do j=jsc-1,jec+1 ; if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) - - if (umask (i,j-1) == 1) then ! this (bot right) is a degree of freedom node - - ux = 1./dxh ; uy = 0./dyh - vx = 0. ; vy = 0. - - u_diagonal (i,j-1) = u_diagonal (i,j-1) + & - .5 * dxdyh * nu_lower (i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (0./dyh)) - - u_diagonal (i,j-1) = u_diagonal (i,j-1) + & - beta_lower(i,j) * dxdyh * 1./24 - - ux = 0. ; uy = 0. - vx = 1./dxh ; vy = 0./dyh - - v_diagonal (i,j-1) = v_diagonal (i,j-1) + & - .5 * dxdyh * nu_lower (i,j) * ((uy+vx) * (1./dxh) + (4*vy+2*ux) * (0./dyh)) - - v_diagonal (i,j-1) = v_diagonal (i,j-1) + & - beta_lower(i,j) * dxdyh * 1./24 - - ux = 0./dxh ; uy = -1./dyh - vx = 0. ; vy = 0. - - u_diagonal (i,j-1) = u_diagonal (i,j-1) + & - .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (-1./dyh)) - - u_diagonal (i,j-1) = u_diagonal (i,j-1) + & - beta_upper(i,j) * dxdyh * 1./24 - - vx = 0./dxh ; vy = -1./dyh - ux = 0. ; uy = 0. - - v_diagonal (i,j-1) = v_diagonal (i,j-1) + & - .5 * dxdyh * nu_upper (i,j) * ((uy+vx) * (0./dxh) + (4*vy+2*ux) * (-1./dyh)) - - v_diagonal (i,j-1) = v_diagonal (i,j-1) + & - beta_upper(i,j) * dxdyh * 1./24 - - endif - - if (umask (i-1,j) == 1) then ! this (top left) is a degree of freedom node - - ux = 0./dxh ; uy = 1./dyh - vx = 0. ; vy = 0. - - u_diagonal (i-1,j) = u_diagonal (i-1,j) + & - .5 * dxdyh * nu_lower (i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (1./dyh)) - - u_diagonal (i,j-1) = u_diagonal (i,j-1) + & - beta_lower(i,j) * dxdyh * 1./24 - - ux = 0. ; uy = 0. - vx = 0./dxh ; vy = 1./dyh - - v_diagonal (i-1,j) = v_diagonal (i-1,j) + & - .5 * dxdyh * nu_lower (i,j) * ((uy+vx) * (0./dxh) + (4*vy+2*ux) * (1./dyh)) - - v_diagonal (i,j-1) = v_diagonal (i,j-1) + & - beta_lower(i,j) * dxdyh * 1./24 - - ux = -1./dxh ; uy = 0./dyh - vx = 0. ; vy = 0. - - u_diagonal (i-1,j) = u_diagonal (i-1,j) + & - .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (0./dyh)) - - u_diagonal (i,j-1) = u_diagonal (i,j-1) + & - beta_upper(i,j) * dxdyh * 1./24 - - vx = -1./dxh ; vy = 0./dyh - ux = 0. ; uy = 0. - - v_diagonal (i-1,j) = v_diagonal (i-1,j) + & - .5 * dxdyh * nu_upper (i,j) * ((uy+vx) * (-1./dxh) + (4*vy+2*ux) * (0./dyh)) - - v_diagonal (i,j-1) = v_diagonal (i,j-1) + & - beta_upper(i,j) * dxdyh * 1./24 - - endif - - if (umask (i-1,j-1) == 1) then ! this (bot left) is a degree of freedom node - - ux = -1./dxh ; uy = -1./dyh - vx = 0. ; vy = 0. - - u_diagonal (i-1,j-1) = u_diagonal (i-1,j-1) + & - .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (-1./dyh)) - - u_diagonal (i-1,j-1) = u_diagonal (i-1,j-1) + & - beta_lower(i,j) * dxdyh * 1./24 - - vx = -1./dxh ; vy = -1./dyh - ux = 0. ; uy = 0. - - v_diagonal (i-1,j-1) = v_diagonal (i-1,j-1) + & - .5 * dxdyh * nu_upper (i,j) * ((uy+vx) * (-1./dxh) + (4*vy+2*ux) * (-1./dyh)) - - v_diagonal (i-1,j-1) = v_diagonal (i-1,j-1) + & - beta_lower(i,j) * dxdyh * 1./24 - endif - - if (umask (i,j) == 1) then ! this (top right) is a degree of freedom node - - ux = 1./ dxh ; uy = 1./dyh - vx = 0. ; vy = 0. - - u_diagonal (i,j) = u_diagonal (i,j) + & - .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (1./dyh)) - - u_diagonal (i,j) = u_diagonal (i,j) + & - beta_upper(i,j) * dxdyh * 1./24 - - vx = 1./ dxh ; vy = 1./dyh - ux = 0. ; uy = 0. - - v_diagonal (i,j) = v_diagonal (i,j) + & - .5 * dxdyh * nu_upper (i,j) * ((uy+vx) * (1./dxh) + (4*vy+2*ux) * (1./dyh)) - - v_diagonal (i,j) = v_diagonal (i,j) + & - beta_upper(i,j) * dxdyh * 1./24 - - endif - endif ; enddo ; enddo - -end subroutine matrix_diagonal_triangle - -!~ subroutine apply_boundary_values_triangle (CS, time, u_boundary_contr, v_boundary_contr) - - !~ type(time_type), intent(in) :: Time - !~ type(ice_shelf_CS), pointer :: CS - !~ real, dimension (:,:), intent(inout) :: u_boundary_contr, v_boundary_contr - -!~ ! this will be a per-setup function. the boundary values of thickness and velocity -!~ ! (and possibly other variables) will be updated in this function - - !~ real, pointer, dimension (:,:) :: u_boundary_values, & - !~ v_boundary_values, & - !~ umask, vmask, hmask, & - !~ nu_lower, nu_upper, beta_lower, beta_upper - !~ type(ocean_grid_type), pointer :: G - !~ integer :: 0, i, j, cnt, isc, jsc, iec, jec - !~ real :: A, n, ux, uy, vx, vy, eps_min, domain_width, dxh, dyh, dxdyh - - !~ G => CS%grid - -!~ ! if (G%symmetric) then -!~ ! isym=1 -!~ ! else -!~ ! isym=0 -!~ ! endif - - - - !~ isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec - - !~ u_boundary_values => CS%u_boundary_values - !~ v_boundary_values => CS%v_boundary_values - !~ umask => CS%umask ; vmask => CS%vmask ; hmask => CS%hmask - !~ nu_lower => CS%ice_visc_lower_tri ; nu_upper => CS%ice_visc_upper_tri - !~ beta_lower => CS%taub_beta_eff_lower_tri ; beta_upper => CS%taub_beta_eff_upper_tri - - !~ domain_width = CS%len_lat - - !~ do i=isc-1,iec+1 ; do j=jsc-1,jec+1 ; if (hmask(i,j) == 1) then - - !~ if ((umask(i-1,j-1) == 3) .OR. (umask(i,j-1) == 3) .OR. (umask(i-1,j) == 3)) then - - !~ dxh = G%dxh(i,j) - !~ dyh = G%dyh(i,j) - !~ dxdyh = G%dxdyh(i,j) - - !~ ux = (u_boundary_values(i,j-1)-u_boundary_values(i-1,j-1))/dxh - !~ vx = (v_boundary_values(i,j-1)-v_boundary_values(i-1,j-1))/dxh - !~ uy = (u_boundary_values(i-1,j)-u_boundary_values(i-1,j-1))/dyh - !~ vy = (v_boundary_values(i-1,j)-v_boundary_values(i-1,j-1))/dyh - - !~ if (umask (i,j-1) == 1) then ! this (bot right) is a degree of freedom node - - !~ u_boundary_contr (i,j-1) = u_boundary_contr (i,j-1) + & - !~ .5 * dxdyh * nu_lower (i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (0./dyh)) - - !~ v_boundary_contr (i,j-1) = v_boundary_contr (i,j-1) + & - !~ .5 * dxdyh * nu_lower (i,j) * ((uy+vx) * (1./dxh) + (4*vy+2*ux) * (0./dyh)) - - !~ u_boundary_contr (i,j-1) = u_boundary_contr (i,j-1) + & - !~ beta_lower(i,j) * dxdyh * 1./24 * (u_boundary_values(i-1,j-1) + & - !~ u_boundary_values(i-1,j) + u_boundary_values(i,j-1)) - - !~ v_boundary_contr (i,j-1) = v_boundary_contr (i,j-1) + & - !~ beta_lower(i,j) * dxdyh * 1./24 * (v_boundary_values(i-1,j-1) + & - !~ v_boundary_values(i-1,j) + v_boundary_values(i,j-1)) - !~ endif - - !~ if (umask (i-1,j) == 1) then ! this (top left) is a degree of freedom node - - !~ u_boundary_contr (i-1,j) = u_boundary_contr (i-1,j) + & - !~ .5 * dxdyh * nu_lower (i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (1./dyh)) - - !~ v_boundary_contr (i-1,j) = v_boundary_contr (i-1,j) + & - !~ .5 * dxdyh * nu_lower (i,j) * ((uy+vx) * (0./dxh) + (4*vy+2*ux) * (1./dyh)) - - !~ u_boundary_contr (i,j-1) = u_boundary_contr (i,j-1) + & - !~ beta_lower(i,j) * dxdyh * 1./24 * (u_boundary_values(i-1,j-1) + & - !~ u_boundary_values(i-1,j) + u_boundary_values(i,j-1)) - - !~ v_boundary_contr (i,j-1) = v_boundary_contr (i,j-1) + & - !~ beta_lower(i,j) * dxdyh * 1./24 * (v_boundary_values(i-1,j-1) + & - !~ v_boundary_values(i-1,j) + v_boundary_values(i,j-1)) - !~ endif - - !~ if (umask (i-1,j-1) == 1) then ! this (bot left) is a degree of freedom node - - !~ u_boundary_contr (i-1,j-1) = u_boundary_contr (i-1,j-1) + & - !~ .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (-1./dyh)) - - !~ v_boundary_contr (i-1,j-1) = v_boundary_contr (i-1,j-1) + & - !~ .5 * dxdyh * nu_upper (i,j) * ((uy+vx) * (-1./dxh) + (4*vy+2*ux) * (-1./dyh)) - - !~ u_boundary_contr (i-1,j-1) = u_boundary_contr (i-1,j-1) + & - !~ beta_lower(i,j) * dxdyh * 1./24 * (u_boundary_values(i-1,j-1) + & - !~ u_boundary_values(i-1,j) + u_boundary_values(i,j-1)) - - !~ v_boundary_contr (i-1,j-1) = v_boundary_contr (i-1,j-1) + & - !~ beta_lower(i,j) * dxdyh * 1./24 * (v_boundary_values(i-1,j-1) + & - !~ v_boundary_values(i-1,j) + v_boundary_values(i,j-1)) - !~ endif - - !~ endif - - !~ if ((umask(i,j) == 3) .OR. (umask(i,j-1) == 3) .OR. (umask(i-1,j) == 3)) then - - !~ dxh = G%dxh(i,j) - !~ dyh = G%dyh(i,j) - !~ dxdyh = G%dxdyh(i,j) - - !~ ux = (u_boundary_values(i,j)-u_boundary_values(i-1,j))/dxh - !~ vx = (v_boundary_values(i,j)-v_boundary_values(i-1,j))/dxh - !~ uy = (u_boundary_values(i,j)-u_boundary_values(i,j-1))/dyh - !~ vy = (v_boundary_values(i,j)-v_boundary_values(i,j-1))/dyh - - !~ if (umask (i,j-1) == 1) then ! this (bot right) is a degree of freedom node - - !~ u_boundary_contr (i,j-1) = u_boundary_contr (i,j-1) + & - !~ .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (0./dxh) + (uy+vy) * (-1./dyh)) - - !~ v_boundary_contr (i,j-1) = v_boundary_contr (i,j-1) + & - !~ .5 * dxdyh * nu_upper (i,j) * ((uy+vx) * (0./dxh) + (4*vy+2*ux) * (-1./dyh)) - - !~ u_boundary_contr (i,j-1) = u_boundary_contr (i,j-1) + & - !~ beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + & - !~ u_boundary_values(i-1,j) + & - !~ u_boundary_values(i,j-1)) - - !~ v_boundary_contr (i,j-1) = v_boundary_contr (i,j-1) + & - !~ beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + & - !~ u_boundary_values(i-1,j) + & - !~ u_boundary_values(i,j-1)) - !~ endif - - !~ if (umask (i-1,j) == 1) then ! this (top left) is a degree of freedom node - - !~ u_boundary_contr (i-1,j) = u_boundary_contr (i-1,j) + & - !~ .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (-1./dxh) + (uy+vy) * (0./dyh)) - - !~ v_boundary_contr (i-1,j) = v_boundary_contr (i-1,j) + & - !~ .5 * dxdyh * nu_upper (i,j) * ((uy+vx) * (-1./dxh) + (4*vy+2*ux) * (0./dyh)) - - !~ u_boundary_contr (i,j-1) = u_boundary_contr (i,j-1) + & - !~ beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + & - !~ u_boundary_values(i-1,j) + & - !~ u_boundary_values(i,j-1)) - - !~ v_boundary_contr (i,j-1) = v_boundary_contr (i,j-1) + & - !~ beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + & - !~ u_boundary_values(i-1,j) + & - !~ u_boundary_values(i,j-1)) - !~ endif - - !~ if (umask (i,j) == 1) then ! this (top right) is a degree of freedom node - - !~ u_boundary_contr (i,j) = u_boundary_contr (i,j) + & - !~ .5 * dxdyh * nu_upper (i,j) * ((4*ux+2*vy) * (1./dxh) + (uy+vy) * (1./dyh)) - - !~ v_boundary_contr (i,j) = v_boundary_contr (i,j) + & - !~ .5 * dxdyh * nu_upper (i,j) * ((uy+vx) * (1./dxh) + (4*vy+2*ux) * (1./dyh)) - - !~ u_boundary_contr (i,j) = u_boundary_contr (i,j) + & - !~ beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + & - !~ u_boundary_values(i-1,j) + & - !~ u_boundary_values(i,j-1)) - - !~ v_boundary_contr (i,j) = v_boundary_contr (i,j) + & - !~ beta_upper(i,j) * dxdyh * 1./24 * (u_boundary_values(i,j) + & - !~ u_boundary_values(i-1,j) + & - !~ u_boundary_values(i,j-1)) - !~ endif - - - !~ endif - !~ endif ; enddo ; enddo - -!~ end subroutine apply_boundary_values_triangle - -!~ subroutine calc_shelf_visc_triangular (CS,u,v) - !~ type(ice_shelf_CS), pointer :: CS - !~ real, dimension(:,:), intent(inout) :: u, v - -!~ ! update DEPTH_INTEGRATED viscosity, based on horizontal strain rates - this is for triangle FEM solve so there is -!~ ! an "upper" and "lower" triangular viscosity - -!~ ! also this subroutine updates the nonlinear part of the basal traction - -!~ ! this may be subject to change later... to make it "hybrid" - - !~ real, pointer, dimension (:,:) :: nu_lower , & - !~ nu_upper, & - !~ beta_eff_lower, & - !~ beta_eff_upper - !~ real, pointer, dimension (:,:) :: H, &! thickness - !~ hmask - - !~ type(ocean_grid_type), pointer :: G - !~ integer :: 0, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq - !~ integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js - !~ real :: A, n, ux, uy, vx, vy, eps_min, umid, vmid, unorm, C_basal_friction, n_basal_friction, dxh, dyh, dxdyh - - !~ G => CS%grid - - !~ isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec - !~ iscq = G%iscq ; iecq = G%iecq ; jscq = G%jscq ; jecq = G%jecq - !~ isd = G%isd ; jsd = G%jsd ; ied = G%isd ; jed = G%jsd - !~ iegq = G%iegq ; jegq = G%jegq - !~ gisc = G%domain%nx_halo+1 ; gjsc = G%domain%ny_halo+1 - !~ giec = G%domain%nxtot+gisc ; gjec = G%domain%nytot+gjsc - !~ is = iscq - (1-0); js = jscq - (1-0) - - !~ A = CS%A_glen_isothermal ; n = CS%n_glen; eps_min = CS%eps_glen_min - - !~ H => CS%h_shelf - !~ hmask => CS%hmask - !~ nu_upper => CS%ice_visc_upper_tri - !~ nu_lower => CS%ice_visc_lower_tri - !~ beta_eff_upper => CS%taub_beta_eff_upper_tri - !~ beta_eff_lower => CS%taub_beta_eff_lower_tri - - !~ C_basal_friction = CS%C_basal_friction ; n_basal_friction = CS%n_basal_friction - - !~ do i=isd,ied - !~ do j=jsd,jed - - !~ dxh = G%dxh(i,j) - !~ dyh = G%dyh(i,j) - !~ dxdyh = G%dxdyh(i,j) - - !~ if (hmask (i,j) == 1) then - !~ ux = (u(i,j-1)-u(i-1,j-1)) / dxh - !~ vx = (v(i,j-1)-v(i-1,j-1)) / dxh - !~ uy = (u(i-1,j)-u(i-1,j-1)) / dyh - !~ vy = (v(i-1,j)-v(i-1,j-1)) / dyh - - !~ nu_lower(i,j) = A**(-1/n) * (ux**2+vy**2+ux*vy.25*(uy+vx)**2+eps_min**2) ** ((1-n)/(2*n)) * H(i,j) - !~ umid = 1./3 * (u(i-1,j-1)+u(i-1,j)+u(i,j-1)) - !~ vmid = 1./3 * (v(i-1,j-1)+v(i-1,j)+v(i,j-1)) - !~ unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) - !~ beta_eff_lower (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) - - !~ ux = (u(i,j)-u(i-1,j)) / dxh - !~ vx = (v(i,j)-v(i-1,j)) / dxh - !~ uy = (u(i,j)-u(i,j-1)) / dyh - !~ vy = (u(i,j)-u(i,j-1)) / dyh - - !~ nu_upper(i,j) = A**(-1/n) * (ux**2+vy**2+ux*vy.25*(uy+vx)**2+eps_min**2) ** ((1-n)/(2*n)) * H(i,j) - !~ umid = 1./3 * (u(i,j)+u(i-1,j)+u(i,j-1)) - !~ vmid = 1./3 * (v(i,j)+v(i-1,j)+v(i,j-1)) - !~ unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) - !~ beta_eff_upper (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) - - !~ endif - !~ enddo - !~ enddo - -!~ end subroutine calc_shelf_visc_triangular - - -!~ subroutine CG_action_triangular (uret, vret, u, v, umask, vmask, hmask, nu_upper, nu_lower, & - !~ beta_upper, beta_lower, dxh, dyh, dxdyh, is, ie, js, je, 0) - -!~ real, dimension (:,:), intent (inout) :: uret, vret -!~ real, dimension (:,:), intent (in) :: u, v -!~ real, dimension (:,:), intent (in) :: umask, vmask -!~ real, dimension (:,:), intent (in) :: hmask, nu_upper, nu_lower, beta_upper, beta_lower -!~ real, dimension (:,:), intent (in) :: dxh, dyh, dxdyh -!~ integer, intent(in) :: is, ie, js, je, 0 - -!~ ! the linear action of the matrix on (u,v) with triangular finite elements -!~ ! as of now everything is passed in so no grid pointers or anything of the sort have to be dereferenced, -!~ ! but this may change pursuant to conversations with others -!~ ! -!~ ! is & ie are the cells over which the iteration is done; this may change between calls to this subroutine -!~ ! in order to make less frequent halo updates -!~ ! isym = 1 if grid is symmetric, 0 o.w. - - !~ real :: ux, uy, vx, vy - !~ integer :: i,j - - !~ do i=is,ie - !~ do j=js,je - - !~ if (hmask(i,j) == 1) then ! this cell's vertices contain degrees of freedom - - !~ ux = (u(i,j-1)-u(i-1,j-1))/dxh(i,j) - !~ vx = (v(i,j-1)-v(i-1,j-1))/dxh(i,j) - !~ uy = (u(i-1,j)-u(i-1,j-1))/dyh(i,j) - !~ vy = (v(i-1,j)-v(i-1,j-1))/dyh(i,j) - - !~ if (umask(i,j-1) == 1) then ! this (bot right) is a degree of freedom node - - !~ uret(i,j-1) = uret(i,j-1) + & - !~ .5 * dxdyh(i,j) * nu_lower (i,j) * ((4*ux+2*vy) * (1./dxh(i,j)) + (uy+vy) * (0./dyh(i,j))) - - !~ vret(i,j-1) = vret(i,j-1) + & - !~ .5 * dxdyh(i,j) * nu_lower (i,j) * ((uy+vx) * (1./dxh(i,j)) + (4*vy+2*ux) * (0./dyh(i,j))) - - !~ uret(i,j-1) = uret(i,j-1) + & - !~ beta_lower(i,j) * dxdyh(i,j) * 1./24 * (u(i-1,j-1) + & - !~ u(i-1,j) + u(i,j-1)) - - !~ vret(i,j-1) = vret(i,j-1) + & - !~ beta_lower(i,j) * dxdyh(i,j) * 1./24 * (v(i-1,j-1) + & - !~ v(i-1,j) + v(i,j-1)) - !~ endif - - !~ if (umask(i-1,j) == 1) then ! this (top left) is a degree of freedom node - - !~ uret(i-1,j) = uret(i-1,j) + & - !~ .5 * dxdyh(i,j) * nu_lower (i,j) * ((4*ux+2*vy) * (0./dxh(i,j)) + (uy+vy) * (1./dyh(i,j))) - - !~ vret(i-1,j) = vret(i-1,j) + & - !~ .5 * dxdyh(i,j) * nu_lower (i,j) * ((uy+vx) * (0./dxh(i,j)) + (4*vy+2*ux) * (1./dyh(i,j))) - - !~ uret(i,j-1) = uret(i,j-1) + & - !~ beta_lower(i,j) * dxdyh(i,j) * 1./24 * (u(i-1,j-1) + & - !~ u(i-1,j) + u(i,j-1)) - - !~ vret(i,j-1) = vret(i,j-1) + & - !~ beta_lower(i,j) * dxdyh(i,j) * 1./24 * (v(i-1,j-1) + & - !~ v(i-1,j) + v(i,j-1)) - !~ endif - - !~ if (umask(i-1,j-1) == 1) then ! this (bot left) is a degree of freedom node - - !~ uret(i-1,j-1) = uret(i-1,j-1) + & - !~ .5 * dxdyh(i,j) * nu_upper (i,j) * ((4*ux+2*vy) * (-1./dxh(i,j)) + (uy+vy) * (-1./dyh(i,j))) - - !~ vret(i-1,j-1) = vret(i-1,j-1) + & - !~ .5 * dxdyh(i,j) * nu_upper (i,j) * ((uy+vx) * (-1./dxh(i,j)) + (4*vy+2*ux) * (-1./dyh(i,j))) - - !~ uret(i-1,j-1) = uret(i-1,j-1) + & - !~ beta_lower(i,j) * dxdyh(i,j) * 1./24 * (u(i-1,j-1) + & - !~ u(i-1,j) + u(i,j-1)) - - !~ vret(i-1,j-1) = vret(i-1,j-1) + & - !~ beta_lower(i,j) * dxdyh(i,j) * 1./24 * (v(i-1,j-1) + & - !~ v(i-1,j) + v(i,j-1)) - !~ endif - - - !~ ux = (u(i,j)-u(i-1,j))/dxh(i,j) - !~ vx = (v(i,j)-v(i-1,j))/dxh(i,j) - !~ uy = (u(i,j)-u(i,j-1))/dyh(i,j) - !~ vy = (v(i,j)-v(i,j-1))/dyh(i,j) - - !~ if (umask(i,j-1) == 1) then ! this (bot right) is a degree of freedom node - - !~ uret(i,j-1) = uret(i,j-1) + & - !~ .5 * dxdyh(i,j) * nu_upper (i,j) * ((4*ux+2*vy) * (0./dxh(i,j)) + (uy+vy) * (-1./dyh(i,j))) - - !~ vret(i,j-1) = vret(i,j-1) + & - !~ .5 * dxdyh(i,j) * nu_upper (i,j) * ((uy+vx) * (0./dxh(i,j)) + (4*vy+2*ux) * (-1./dyh(i,j))) - - !~ uret(i,j-1) = uret(i,j-1) + & - !~ beta_upper(i,j) * dxdyh(i,j) * 1./24 * (u(i,j) + & - !~ u(i-1,j) + u(i,j-1)) - - !~ vret(i,j-1) = vret(i,j-1) + & - !~ beta_upper(i,j) * dxdyh(i,j) * 1./24 * (u(i,j) + & - !~ u(i-1,j) + u(i,j-1)) - !~ endif - - !~ if (umask(i-1,j) == 1) then ! this (top left) is a degree of freedom node - - !~ uret(i-1,j) = uret(i-1,j) + & - !~ .5 * dxdyh(i,j) * nu_upper (i,j) * ((4*ux+2*vy) * (-1./dxh(i,j)) + (uy+vy) * (0./dyh(i,j))) - - !~ vret(i-1,j) = vret(i-1,j) + & - !~ .5 * dxdyh(i,j) * nu_upper (i,j) * ((uy+vx) * (-1./dxh(i,j)) + (4*vy+2*ux) * (0./dyh(i,j))) - - !~ uret(i,j-1) = uret(i,j-1) + & - !~ beta_upper(i,j) * dxdyh(i,j) * 1./24 * (u(i,j) + & - !~ u(i-1,j) + u(i,j-1)) - - !~ vret(i,j-1) = vret(i,j-1) + & - !~ beta_upper(i,j) * dxdyh(i,j) * 1./24 * (u(i,j) + & - !~ u(i-1,j) + u(i,j-1)) - !~ endif - - !~ if (umask(i,j) == 1) then ! this (top right) is a degree of freedom node - - !~ uret(i,j) = uret(i,j) + & - !~ .5 * dxdyh(i,j) * nu_upper (i,j) * ((4*ux+2*vy) * (1./dxh(i,j)) + (uy+vy) * (1./dyh(i,j))) - - !~ vret(i,j) = vret(i,j) + & - !~ .5 * dxdyh(i,j) * nu_upper (i,j) * ((uy+vx) * (1./dxh(i,j)) + (4*vy+2*ux) * (1./dyh(i,j))) - - !~ uret(i,j) = uret(i,j) + & - !~ beta_upper(i,j) * dxdyh(i,j) * 1./24 * (u(i,j) + & - !~ u(i-1,j) + u(i,j-1)) - - !~ vret(i,j) = vret(i,j) + & - !~ beta_upper(i,j) * dxdyh(i,j) * 1./24 * (u(i,j) + & - !~ u(i-1,j) + u(i,j-1)) - !~ endif - - !~ endif - - !~ enddo - !~ enddo - -!~ end subroutine CG_action_triangular - - -END MODULE shelf_triangular_FEstuff From f583775d35399d31fbfa72ef81589f899323d05c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 20 May 2018 21:20:33 -0400 Subject: [PATCH 0276/1072] +Create and use ice_shelf_state Moved the ice shelf state variables, mass_shelf, area_shelf_h, h_shelf and hmask into a new ice_shelf_state type in the new module MOM_ice_shelf_state, and use this type for these variables in MOM_ice_shelf.F90. The allocation and deallocation of this new type is handled via calls to ice_shelf_state_init and ice_shelf_state_end, respectively. This change will permit the ice shelf dynamics code to be separated out from the rest of the ice shelf code. All answers are bitwise identical. --- src/ice_shelf/MOM_ice_shelf.F90 | 527 +++++++++++++------------- src/ice_shelf/MOM_ice_shelf_state.F90 | 101 +++++ 2 files changed, 375 insertions(+), 253 deletions(-) create mode 100644 src/ice_shelf/MOM_ice_shelf_state.F90 diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 3704fa6a67..4aacf218c5 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -36,6 +36,7 @@ module MOM_ice_shelf use MOM_EOS, only : EOS_type, EOS_init !MJHuse MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary, initialize_ice_thickness use MOM_ice_shelf_initialize, only : initialize_ice_thickness +use MOM_ice_shelf_state, only : ice_shelf_state, ice_shelf_state_end, ice_shelf_state_init use user_shelf_init, only : USER_initialize_shelf_mass, USER_update_shelf_mass use user_shelf_init, only : user_ice_shelf_CS use constants_mod, only: GRAV @@ -69,23 +70,10 @@ module MOM_ice_shelf real :: flux_factor = 1.0 !< A factor that can be used to turn off ice shelf !! melting (flux_factor = 0). character(len=128) :: restart_output_dir = ' ' + type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe + !! the ice-shelf state real, pointer, dimension(:,:) :: & - mass_shelf => NULL(), & !< The mass per unit area of the ice shelf or - !! sheet, in kg m-2. - area_shelf_h => NULL(), & !< The area per cell covered by the ice shelf, in m2. - h_shelf => NULL(), & !< the thickness of the shelf in m, redundant - !! with mass but may make code more readable - hmask => NULL(),& !< Mask used to indicate ice-covered or partiall-covered cells - !! 1: fully covered, solve for velocity here (for now all - !! ice-covered cells are treated the same, this may change) - !! 2: partially covered, do not solve for velocity - !! 0: no ice in cell. - !! 3: bdry condition on thickness set - not in computational domain - !! -2 : default (out of computational boundary, and) not = 3 - !! NOTE: hmask will change over time and NEEDS TO BE MAINTAINED - !! otherwise the wrong nodes will be included in velocity calcs. - t_flux => NULL(), & !< The UPWARD sensible ocean heat flux at the !! ocean-ice interface, in W m-2. salt_flux => NULL(), & !< The downward salt flux at the ocean-ice @@ -347,6 +335,8 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) !! initialize_ice_shelf. type(ocean_grid_type), pointer :: G => NULL() ! The grid structure used by the ice shelf. + type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe + !! the ice-shelf state real, dimension(SZI_(CS%grid)) :: & Rhoml, & !< Ocean mixed layer density in kg m-3. @@ -411,6 +401,8 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) call cpu_clock_begin(id_clock_shelf) G => CS%grid + ISS => CS%ISS + ! useful parameters is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; ied = G%ied ; jed = G%jed I_ZETA_N = 1.0 / ZETA_N @@ -447,7 +439,7 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) if (CS%shelf_mass_is_dynamic .and. CS%override_shelf_movement) then CS%time_step = time_step ! update shelf mass - if (CS%mass_from_file) call update_shelf_mass(G, CS, Time) + if (CS%mass_from_file) call update_shelf_mass(G, CS, ISS, Time) endif if (CS%DEBUG) then @@ -462,7 +454,7 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) do j=js,je ! Find the pressure at the ice-ocean interface, averaged only over the ! part of the cell covered by ice shelf. - do i=is,ie ; p_int(i) = CS%g_Earth * CS%mass_shelf(i,j) ; enddo + do i=is,ie ; p_int(i) = CS%g_Earth * ISS%mass_shelf(i,j) ; enddo ! Calculate insitu densities and expansion coefficients call calculate_density(state%sst(:,j),state%sss(:,j), p_int, & @@ -479,7 +471,7 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) ! propose instead to allow where Hml > [some threshold] if ((iDens*state%ocean_mass(i,j) > CS%col_thick_melt_threshold) .and. & - (CS%area_shelf_h(i,j) > 0.0) .and. & + (ISS%area_shelf_h(i,j) > 0.0) .and. & (CS%isthermo) .and. (state%Hml(i,j) > 0.0) ) then if (CS%threeeq) then @@ -722,13 +714,13 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) do j=js,je do i=is,ie if ((iDens*state%ocean_mass(i,j) > CS%col_thick_melt_threshold) .and. & - (CS%area_shelf_h(i,j) > 0.0) .and. & + (ISS%area_shelf_h(i,j) > 0.0) .and. & (CS%isthermo) .and. (state%Hml(i,j) > 0.0) ) then ! Set melt to zero above a cutoff pressure ! (CS%Rho0*CS%cutoff_depth*CS%g_Earth) this is needed for the isomip ! test case. - if ((CS%g_Earth * CS%mass_shelf(i,j)) < CS%Rho0*CS%cutoff_depth* & + if ((CS%g_Earth * ISS%mass_shelf(i,j)) < CS%Rho0*CS%cutoff_depth* & CS%g_Earth) then CS%lprec(i,j) = 0.0 fluxes%iceshelf_melt(i,j) = 0.0 @@ -766,12 +758,12 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) ! mass flux (kg/s), part of ISOMIP diags. allocate( mass_flux(G%ied,G%jed) ); mass_flux(:,:) = 0.0 - mass_flux = (CS%lprec) * CS%area_shelf_h + mass_flux = (CS%lprec) * ISS%area_shelf_h if (CS%shelf_mass_is_dynamic) then call cpu_clock_begin(id_clock_pass) - call pass_var(CS%area_shelf_h, G%domain, complete=.false.) - call pass_var(CS%mass_shelf, G%domain) + call pass_var(ISS%area_shelf_h, G%domain, complete=.false.) + call pass_var(ISS%mass_shelf, G%domain) call cpu_clock_end(id_clock_pass) endif @@ -779,7 +771,7 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) if (CS%shelf_mass_is_dynamic .and. CS%override_shelf_movement) then if (.not. (CS%mass_from_file)) then - call change_thickness_using_melt(CS,G,time_step, fluxes) + call change_thickness_using_melt(CS, ISS, G, time_step, fluxes) endif @@ -799,7 +791,7 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) ! note time_step is [s] and lprec is [kg / m^2 / s] - call ice_shelf_advect(CS, G, time_step, CS%lprec, Time) + call ice_shelf_advect(CS, ISS, G, time_step, CS%lprec, Time) CS%velocity_update_sub_counter = CS%velocity_update_sub_counter+1 @@ -807,14 +799,14 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) call update_OD_ffrac(CS, G, state%ocean_mass, CS%velocity_update_sub_counter, CS%nstep_velocity, & CS%time_step, CS%velocity_update_time_step) else - call update_OD_ffrac_uncoupled(CS, G) + call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf) endif if (CS%velocity_update_sub_counter == CS%nstep_velocity) then if (is_root_pe()) write(*,*) "ABOUT TO CALL VELOCITY SOLVER" - call ice_shelf_solve_outer(CS, G, CS%u_shelf, CS%v_shelf, iters_vel_solve, Time) + call ice_shelf_solve_outer(CS, ISS, G, CS%u_shelf, CS%v_shelf, iters_vel_solve, Time) CS%velocity_update_sub_counter = 0 @@ -822,8 +814,8 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) endif call enable_averaging(time_step,Time,CS%diag) - if (CS%id_shelf_mass > 0) call post_data(CS%id_shelf_mass, CS%mass_shelf, CS%diag) - if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, CS%area_shelf_h, CS%diag) + if (CS%id_shelf_mass > 0) call post_data(CS%id_shelf_mass, ISS%mass_shelf, CS%diag) + if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, ISS%area_shelf_h, CS%diag) if (CS%id_ustar_shelf > 0) call post_data(CS%id_ustar_shelf, fluxes%ustar_shelf, CS%diag) if (CS%id_melt > 0) call post_data(CS%id_melt, fluxes%iceshelf_melt, CS%diag) if (CS%id_thermal_driving > 0) call post_data(CS%id_thermal_driving, (state%sst-CS%tfreeze), CS%diag) @@ -837,8 +829,8 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) if (CS%id_exch_vel_t > 0) call post_data(CS%id_exch_vel_t, CS%exch_vel_t, CS%diag) if (CS%id_exch_vel_s > 0) call post_data(CS%id_exch_vel_s, CS%exch_vel_s, CS%diag) if (CS%id_col_thick > 0) call post_data(CS%id_col_thick, CS%OD_av, CS%diag) - if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf,CS%h_shelf,CS%diag) - if (CS%id_h_mask > 0) call post_data(CS%id_h_mask,CS%hmask,CS%diag) + if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf,ISS%h_shelf,CS%diag) + if (CS%id_h_mask > 0) call post_data(CS%id_h_mask,ISS%hmask,CS%diag) if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf,CS%u_shelf,CS%diag) if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf,CS%v_shelf,CS%diag) if (CS%id_float_frac > 0) call post_data(CS%id_float_frac,CS%float_frac,CS%diag) @@ -855,10 +847,12 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) end subroutine shelf_calc_flux !> Changes the thickness (mass) of the ice shelf based on sub-ice-shelf melting -subroutine change_thickness_using_melt(CS,G,time_step, fluxes) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(ice_shelf_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure - real, intent(in) :: time_step +subroutine change_thickness_using_melt(CS, ISS, G,time_step, fluxes) + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(ice_shelf_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe + !! the ice-shelf state + real, intent(in) :: time_step type(forcing), intent(inout) :: fluxes ! locals @@ -867,47 +861,47 @@ subroutine change_thickness_using_melt(CS,G,time_step, fluxes) do j=G%jsc,G%jec do i=G%isc,G%iec - if ((CS%hmask(i,j) == 1) .or. (CS%hmask(i,j) == 2)) then + if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2)) then ! first, zero out fluxes applied during previous time step if (associated(fluxes%lprec)) fluxes%lprec(i,j) = 0.0 if (associated(fluxes%sens)) fluxes%sens(i,j) = 0.0 if (associated(fluxes%frac_shelf_h)) fluxes%frac_shelf_h(i,j) = 0.0 if (associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = 0.0 - if (CS%lprec(i,j) / CS%density_ice * time_step < CS%h_shelf(i,j)) then - CS%h_shelf(i,j) = CS%h_shelf(i,j) - CS%lprec(i,j) / CS%density_ice * time_step + if (CS%lprec(i,j) / CS%density_ice * time_step < ISS%h_shelf(i,j)) then + ISS%h_shelf(i,j) = ISS%h_shelf(i,j) - CS%lprec(i,j) / CS%density_ice * time_step else ! the ice is about to melt away ! in this case set thickness, area, and mask to zero ! NOTE: not mass conservative ! should maybe scale salt & heat flux for this cell - CS%h_shelf(i,j) = 0.0 - CS%hmask(i,j) = 0.0 - CS%area_shelf_h(i,j) = 0.0 + ISS%h_shelf(i,j) = 0.0 + ISS%hmask(i,j) = 0.0 + ISS%area_shelf_h(i,j) = 0.0 endif endif enddo enddo - call pass_var(CS%area_shelf_h, G%domain) - call pass_var(CS%h_shelf, G%domain) - call pass_var(CS%hmask, G%domain) + call pass_var(ISS%area_shelf_h, G%domain) + call pass_var(ISS%h_shelf, G%domain) + call pass_var(ISS%hmask, G%domain) do j=G%jsd,G%jed do i=G%isd,G%ied - if ((CS%hmask(i,j) == 1) .or. (CS%hmask(i,j) == 2)) then - CS%mass_shelf(i,j) = CS%h_shelf(i,j)*CS%density_ice + if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2)) then + ISS%mass_shelf(i,j) = ISS%h_shelf(i,j)*CS%density_ice endif enddo enddo - call pass_var(CS%mass_shelf, G%domain) + call pass_var(ISS%mass_shelf, G%domain) if (CS%DEBUG) then - call hchksum(CS%h_shelf, "h_shelf after change thickness using melt", G%HI, haloshift=0) - call hchksum(CS%mass_shelf, "mass_shelf after change thickness using melt", G%HI, haloshift=0) + call hchksum(ISS%h_shelf, "h_shelf after change thickness using melt", G%HI, haloshift=0) + call hchksum(ISS%mass_shelf, "mass_shelf after change thickness using melt", G%HI, haloshift=0) endif end subroutine change_thickness_using_melt @@ -923,11 +917,15 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1. real :: press_ice ! The pressure of the ice shelf per unit area of ocean (not ice) in Pa. logical :: find_area ! If true find the shelf areas at u & v points. + type(ice_shelf_state), pointer :: ISS => NULL() ! A structure with elements that describe + ! the ice-shelf state integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed + ISS => CS%ISS + find_area = .true. ; if (present(do_shelf_area)) find_area = do_shelf_area if (find_area) then @@ -935,13 +933,13 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) do j=jsd,jed ; do I=isd,ied-1 forces%frac_shelf_u(I,j) = 0.0 if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%areaCu(I,j) > 0.0)) & - forces%frac_shelf_u(I,j) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i+1,j)) / & + forces%frac_shelf_u(I,j) = ((ISS%area_shelf_h(i,j) + ISS%area_shelf_h(i+1,j)) / & (G%areaT(i,j) + G%areaT(i+1,j))) enddo ; enddo do J=jsd,jed-1 ; do i=isd,ied forces%frac_shelf_v(i,J) = 0.0 if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%areaCv(i,J) > 0.0)) & - forces%frac_shelf_v(i,J) = ((CS%area_shelf_h(i,j) + CS%area_shelf_h(i,j+1)) / & + forces%frac_shelf_v(i,J) = ((ISS%area_shelf_h(i,j) + ISS%area_shelf_h(i,j+1)) / & (G%areaT(i,j) + G%areaT(i,j+1))) enddo ; enddo call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) @@ -949,7 +947,7 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) !### Consider working over a smaller array range. do j=jsd,jed ; do i=isd,ied - press_ice = (CS%area_shelf_h(i,j) * G%IareaT(i,j)) * (CS%g_Earth * CS%mass_shelf(i,j)) + press_ice = (ISS%area_shelf_h(i,j) * G%IareaT(i,j)) * (CS%g_Earth * ISS%mass_shelf(i,j)) if (associated(forces%p_surf)) then if (.not.forces%accumulate_p_surf) forces%p_surf(i,j) = 0.0 forces%p_surf(i,j) = forces%p_surf(i,j) + press_ice @@ -968,12 +966,12 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) do j=js,je ; do I=is-1,ie if (.not.forces%accumulate_rigidity) forces%rigidity_ice_u(I,j) = 0.0 forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + & - kv_rho_ice * min(CS%mass_shelf(i,j), CS%mass_shelf(i+1,j)) + kv_rho_ice * min(ISS%mass_shelf(i,j), ISS%mass_shelf(i+1,j)) enddo ; enddo do J=js-1,je ; do i=is,ie if (.not.forces%accumulate_rigidity) forces%rigidity_ice_v(i,J) = 0.0 forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + & - kv_rho_ice * min(CS%mass_shelf(i,j), CS%mass_shelf(i,j+1)) + kv_rho_ice * min(ISS%mass_shelf(i,j), ISS%mass_shelf(i,j+1)) enddo ; enddo if (CS%debug) then @@ -1015,6 +1013,8 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) ! at at previous time (Time-dt) real, dimension(:,:), allocatable, target :: last_area_shelf_h !< Ice shelf area ! at at previous time (Time-dt), m^2 + type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe + !! the ice-shelf state real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1. real, parameter :: rho_fw = 1000.0 ! fresh water density @@ -1022,6 +1022,7 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed + ISS => CS%ISS call add_shelf_forces(G, CS, forces, do_shelf_area=CS%shelf_mass_is_dynamic) @@ -1062,11 +1063,11 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) if (CS%shelf_mass_is_dynamic) then do j=jsd,jed ; do i=isd,ied if (G%areaT(i,j) > 0.0) & - fluxes%frac_shelf_h(i,j) = CS%area_shelf_h(i,j) * G%IareaT(i,j) + fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) * G%IareaT(i,j) enddo ; enddo endif - do j=js,je ; do i=is,ie ; if (CS%area_shelf_h(i,j) > 0.0) then + do j=js,je ; do i=is,ie ; if (ISS%area_shelf_h(i,j) > 0.0) then frac_area = fluxes%frac_shelf_h(i,j) !### Should this be 1-frac_shelf_h? if (associated(fluxes%sw)) fluxes%sw(i,j) = 0.0 if (associated(fluxes%sw_vis_dir)) fluxes%sw_vis_dir(i,j) = 0.0 @@ -1109,7 +1110,7 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) do j=js,je ; do i=is,ie frac_area = fluxes%frac_shelf_h(i,j) if (frac_area > 0.0) then - mean_melt_flux = mean_melt_flux + (CS%lprec(i,j)) * CS%area_shelf_h(i,j) + mean_melt_flux = mean_melt_flux + (CS%lprec(i,j)) * ISS%area_shelf_h(i,j) endif if (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then @@ -1129,7 +1130,7 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) allocate(last_h_shelf(isd:ied,jsd:jed)) allocate(last_area_shelf_h(isd:ied,jsd:jed)) allocate(last_hmask(isd:ied,jsd:jed)) - last_hmask(:,:) = CS%hmask(:,:); last_area_shelf_h(:,:) = CS%area_shelf_h(:,:) + last_hmask(:,:) = ISS%hmask(:,:); last_area_shelf_h(:,:) = ISS%area_shelf_h(:,:) call time_interp_external(CS%id_read_mass, Time0, last_mass_shelf) last_h_shelf = last_mass_shelf/CS%density_ice @@ -1145,10 +1146,10 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) do j=js,je ; do i=is,ie ! just floating shelf (0.1 is a threshold for min ocean thickness) if (((1.0/CS%density_ocean_avg)*state%ocean_mass(i,j) > 0.1) .and. & - (CS%area_shelf_h(i,j) > 0.0)) then + (ISS%area_shelf_h(i,j) > 0.0)) then - shelf_mass0 = shelf_mass0 + (last_mass_shelf(i,j) * CS%area_shelf_h(i,j)) - shelf_mass1 = shelf_mass1 + (CS%mass_shelf(i,j) * CS%area_shelf_h(i,j)) + shelf_mass0 = shelf_mass0 + (last_mass_shelf(i,j) * ISS%area_shelf_h(i,j)) + shelf_mass1 = shelf_mass1 + (ISS%mass_shelf(i,j) * ISS%area_shelf_h(i,j)) endif enddo ; enddo @@ -1205,6 +1206,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl logical, optional, intent(in) :: solo_ice_sheet_in type(ocean_grid_type), pointer :: G => NULL(), OG => NULL() ! Pointers to grids for convenience. + type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe + !! the ice-shelf state type(directories) :: dirs type(vardesc) :: vd type(dyn_horgrid_type), pointer :: dG => NULL() @@ -1540,8 +1543,9 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl endif ! Allocate and initialize variables - allocate( CS%mass_shelf(isd:ied,jsd:jed) ) ; CS%mass_shelf(:,:) = 0.0 - allocate( CS%area_shelf_h(isd:ied,jsd:jed) ) ; CS%area_shelf_h(:,:) = 0.0 + call ice_shelf_state_init(CS%ISS, CS%grid) + ISS => CS%ISS + allocate( CS%t_flux(isd:ied,jsd:jed) ) ; CS%t_flux(:,:) = 0.0 allocate( CS%lprec(isd:ied,jsd:jed) ) ; CS%lprec(:,:) = 0.0 allocate( CS%salt_flux(isd:ied,jsd:jed) ) ; CS%salt_flux(:,:) = 0.0 @@ -1551,10 +1555,6 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl allocate( CS%exch_vel_s(isd:ied,jsd:jed) ) ; CS%exch_vel_s(:,:) = 0.0 allocate( CS%exch_vel_t(isd:ied,jsd:jed) ) ; CS%exch_vel_t(:,:) = 0.0 - allocate( CS%h_shelf(isd:ied,jsd:jed) ) ; CS%h_shelf(:,:) = 0.0 - allocate( CS%hmask(isd:ied,jsd:jed) ) ; CS%hmask(:,:) = -2.0 - - ! OVS vertically integrated Temperature allocate( CS%t_shelf(isd:ied,jsd:jed) ) ; CS%t_shelf(:,:) = -10.0 allocate( CS%t_boundary_values(isd:ied,jsd:jed) ) ; CS%t_boundary_values(:,:) = -15.0 @@ -1621,11 +1621,11 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! Set up the restarts. call restart_init(param_file, CS%restart_CSp, "Shelf.res") vd = var_desc("shelf_mass","kg m-2","Ice shelf mass",z_grid='1') - call register_restart_field(CS%mass_shelf, vd, .true., CS%restart_CSp) + call register_restart_field(ISS%mass_shelf, vd, .true., CS%restart_CSp) vd = var_desc("shelf_area","m2","Ice shelf area in cell",z_grid='1') - call register_restart_field(CS%area_shelf_h, vd, .true., CS%restart_CSp) + call register_restart_field(ISS%area_shelf_h, vd, .true., CS%restart_CSp) vd = var_desc("h_shelf","m","ice sheet/shelf thickness",z_grid='1') - call register_restart_field(CS%h_shelf, vd, .true., CS%restart_CSp) + call register_restart_field(ISS%h_shelf, vd, .true., CS%restart_CSp) if (CS%shelf_mass_is_dynamic .and. .not.CS%override_shelf_movement) then ! additional restarts for ice shelf state @@ -1634,10 +1634,10 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl vd = var_desc("v_shelf","m s-1","ice sheet/shelf velocity",'q',z_grid='1') call register_restart_field(CS%v_shelf, vd, .true., CS%restart_CSp) !vd = var_desc("h_shelf","m","ice sheet/shelf thickness",z_grid='1') - !call register_restart_field(CS%h_shelf, vd, .true., CS%restart_CSp) + !call register_restart_field(ISS%h_shelf, vd, .true., CS%restart_CSp) vd = var_desc("h_mask","none","ice sheet/shelf thickness mask",z_grid='1') - call register_restart_field(CS%hmask, vd, .true., CS%restart_CSp) + call register_restart_field(ISS%hmask, vd, .true., CS%restart_CSp) ! OVS vertically integrated stream/shelf temperature vd = var_desc("t_shelf","deg C","ice sheet/shelf temperature",z_grid='1') @@ -1645,7 +1645,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! vd = var_desc("area_shelf_h","m-2","ice-covered area of a cell",z_grid='1') - ! call register_restart_field(CS%area_shelf_h, CS%area_shelf_h, vd, .true., CS%restart_CSp) + ! call register_restart_field(ISS%area_shelf_h, vd, .true., CS%restart_CSp) vd = var_desc("OD_av","m","avg ocean depth in a cell",z_grid='1') call register_restart_field(CS%OD_av, vd, .true., CS%restart_CSp) @@ -1682,23 +1682,23 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if (CS%override_shelf_movement .and. CS%mass_from_file) then ! initialize the ids for reading shelf mass from a netCDF - call initialize_shelf_mass(G, param_file, CS) + call initialize_shelf_mass(G, param_file, CS, ISS) if (new_sim) then ! new simulation, initialize ice thickness as in the static case - call initialize_ice_thickness(CS%h_shelf, CS%area_shelf_h, CS%hmask, G, param_file) + call initialize_ice_thickness(ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, G, param_file) ! next make sure mass is consistent with thickness do j=G%jsd,G%jed do i=G%isd,G%ied - if ((CS%hmask(i,j) == 1) .or. (CS%hmask(i,j) == 2)) then - CS%mass_shelf(i,j) = CS%h_shelf(i,j)*CS%density_ice + if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2)) then + ISS%mass_shelf(i,j) = ISS%h_shelf(i,j)*CS%density_ice endif enddo enddo if (CS%min_thickness_simple_calve > 0.0) then - call ice_shelf_min_thickness_calve(CS, G, CS%h_shelf, CS%area_shelf_h, CS%hmask) + call ice_shelf_min_thickness_calve(CS, G, ISS%h_shelf, ISS%area_shelf_h, ISS%hmask) endif endif @@ -1707,7 +1707,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! call initialize_ice_shelf_boundary ( CS%u_face_mask_boundary, CS%v_face_mask_boundary, & ! CS%u_flux_boundary_values, CS%v_flux_boundary_values, & ! CS%u_boundary_values, CS%v_boundary_values, CS%h_boundary_values, & -! CS%hmask, G, param_file) +! ISS%hmask, G, param_file) endif if (CS%shelf_mass_is_dynamic .and. .not. CS%override_shelf_movement) then @@ -1716,20 +1716,20 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl !MJHcall initialize_ice_shelf_boundary ( CS%u_face_mask_boundary, CS%v_face_mask_boundary, & !MJH CS%u_flux_boundary_values, CS%v_flux_boundary_values, & !MJH CS%u_boundary_values, CS%v_boundary_values, CS%h_boundary_values, & - !MJH CS%hmask, G, param_file) + !MJH ISS%hmask, G, param_file) endif if (new_sim .and. (.not. (CS%override_shelf_movement .and. CS%mass_from_file))) then ! This model is initialized internally or from a file. - call initialize_ice_thickness(CS%h_shelf, CS%area_shelf_h, CS%hmask, G, param_file) + call initialize_ice_thickness(ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, G, param_file) ! next make sure mass is consistent with thickness do j=G%jsd,G%jed do i=G%isd,G%ied - if ((CS%hmask(i,j) == 1) .or. (CS%hmask(i,j) == 2)) then - CS%mass_shelf(i,j) = CS%h_shelf(i,j)*CS%density_ice + if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2)) then + ISS%mass_shelf(i,j) = ISS%h_shelf(i,j)*CS%density_ice endif enddo enddo @@ -1743,7 +1743,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! i think this call isnt necessary - all it does is set hmask to 3 at ! the dirichlet boundary, and now this is done elsewhere - ! call initialize_shelf_mass(G, param_file, CS, .false.) + ! call initialize_shelf_mass(G, param_file, CS, ISS, .false.) if (CS%shelf_mass_is_dynamic .and. .not.CS%override_shelf_movement) then @@ -1770,9 +1770,9 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call pass_var(CS%ice_visc_bilinear,G%domain) call pass_var(CS%taub_beta_eff_bilinear,G%domain) call pass_vector(CS%u_shelf, CS%v_shelf, G%domain, TO_ALL, BGRID_NE) - call pass_var(CS%area_shelf_h,G%domain) - call pass_var(CS%h_shelf,G%domain) - call pass_var(CS%hmask,G%domain) + call pass_var(ISS%area_shelf_h,G%domain) + call pass_var(ISS%h_shelf,G%domain) + call pass_var(ISS%hmask,G%domain) if (is_root_pe()) PRINT *, "RESTORING ICE SHELF FROM FILE!!!!!!!!!!!!!" endif @@ -1781,27 +1781,27 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl CS%Time = Time - call pass_var(CS%area_shelf_h, G%domain) - call pass_var(CS%h_shelf, G%domain) - call pass_var(CS%mass_shelf, G%domain) + call pass_var(ISS%area_shelf_h, G%domain) + call pass_var(ISS%h_shelf, G%domain) + call pass_var(ISS%mass_shelf, G%domain) ! Transfer the appropriate fields to the forcing type. if (CS%shelf_mass_is_dynamic .and. .not.CS%override_shelf_movement) then call cpu_clock_begin(id_clock_pass) call pass_var(G%bathyT, G%domain) - call pass_var(CS%hmask, G%domain) - call update_velocity_masks(CS, G) + call pass_var(ISS%hmask, G%domain) + call update_velocity_masks(CS, G, ISS%hmask) call cpu_clock_end(id_clock_pass) endif do j=jsd,jed ; do i=isd,ied - if (CS%area_shelf_h(i,j) > G%areaT(i,j)) then + if (ISS%area_shelf_h(i,j) > G%areaT(i,j)) then call MOM_error(WARNING,"Initialize_ice_shelf: area_shelf_h exceeds G%areaT.") - CS%area_shelf_h(i,j) = G%areaT(i,j) + ISS%area_shelf_h(i,j) = G%areaT(i,j) endif enddo ; enddo if (present(fluxes)) then ; do j=jsd,jed ; do i=isd,ied - if (G%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = CS%area_shelf_h(i,j) / G%areaT(i,j) + if (G%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) / G%areaT(i,j) enddo ; enddo ; endif if (CS%DEBUG) then @@ -1848,7 +1848,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl endif if (CS%shelf_mass_is_dynamic .and. .not.CS%override_shelf_movement) then -! call init_boundary_values(CS, G, time, CS%input_flux, CS%input_thickness, new_sim) +! call init_boundary_values(CS, G, time, ISS%hmask, CS%input_flux, CS%input_thickness, new_sim) if (.not. CS%isthermo) then CS%lprec(:,:) = 0.0 @@ -1857,8 +1857,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if (new_sim) then if (is_root_pe()) print *,"NEW SIM: initialize velocity" - call update_OD_ffrac_uncoupled(CS, G) - call ice_shelf_solve_outer(CS, G, CS%u_shelf, CS%v_shelf, iters, Time) + call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf) + call ice_shelf_solve_outer(CS, ISS, G, CS%u_shelf, CS%v_shelf, iters, Time) ! write (procnum,'(I2)') mpp_pe() @@ -1952,11 +1952,12 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl end subroutine initialize_ice_shelf !> Initializes shelf mass based on three options (file, zero and user) -subroutine initialize_shelf_mass(G, param_file, CS, new_sim) +subroutine initialize_shelf_mass(G, param_file, CS, ISS, new_sim) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(inout) :: ISS !< The ice shelf state type that is being updated logical, optional, intent(in) :: new_sim !< If present and false, this run is being restarted integer :: i, j, is, ie, js, je @@ -2023,13 +2024,13 @@ subroutine initialize_shelf_mass(G, param_file, CS, new_sim) case ("zero") do j=js,je ; do i=is,ie - CS%mass_shelf(i,j) = 0.0 - CS%area_shelf_h(i,j) = 0.0 + ISS%mass_shelf(i,j) = 0.0 + ISS%area_shelf_h(i,j) = 0.0 enddo ; enddo case ("USER") - call USER_initialize_shelf_mass(CS%mass_shelf, CS%area_shelf_h, & - CS%h_shelf, CS%hmask, G, CS%user_CS, param_file, new_sim_2) + call USER_initialize_shelf_mass(ISS%mass_shelf, ISS%area_shelf_h, & + ISS%h_shelf, ISS%hmask, G, CS%user_CS, param_file, new_sim_2) case default ; call MOM_error(FATAL,"initialize_ice_shelf: "// & "Unrecognized ice shelf setup "//trim(config)) @@ -2038,62 +2039,64 @@ subroutine initialize_shelf_mass(G, param_file, CS, new_sim) end subroutine initialize_shelf_mass !> Updates the ice shelf mass using data from a file. -subroutine update_shelf_mass(G, CS, Time) +subroutine update_shelf_mass(G, CS, ISS, Time) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(inout) :: ISS !< The ice shelf state type that is being updated type(time_type), intent(in) :: Time ! local variables integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - call time_interp_external(CS%id_read_mass, Time, CS%mass_shelf) + call time_interp_external(CS%id_read_mass, Time, ISS%mass_shelf) do j=js,je ; do i=is,ie - CS%area_shelf_h(i,j) = 0.0 - CS%hmask(i,j) = 0. - if (CS%mass_shelf(i,j) > 0.0) then - CS%area_shelf_h(i,j) = G%areaT(i,j) - CS%h_shelf(i,j) = CS%mass_shelf(i,j)/CS%density_ice - CS%hmask(i,j) = 1. + ISS%area_shelf_h(i,j) = 0.0 + ISS%hmask(i,j) = 0. + if (ISS%mass_shelf(i,j) > 0.0) then + ISS%area_shelf_h(i,j) = G%areaT(i,j) + ISS%h_shelf(i,j) = ISS%mass_shelf(i,j)/CS%density_ice + ISS%hmask(i,j) = 1. endif enddo ; enddo - !call USER_update_shelf_mass(CS%mass_shelf, CS%area_shelf_h, CS%h_shelf, & - ! CS%hmask, CS%grid, CS%user_CS, Time, .true.) + !call USER_update_shelf_mass(ISS%mass_shelf, ISS%area_shelf_h, ISS%h_shelf, & + ! ISS%hmask, CS%grid, CS%user_CS, Time, .true.) if (CS%min_thickness_simple_calve > 0.0) then - call ice_shelf_min_thickness_calve(CS, G, CS%h_shelf, CS%area_shelf_h, CS%hmask) + call ice_shelf_min_thickness_calve(CS, G, ISS%h_shelf, ISS%area_shelf_h, ISS%hmask) endif - call pass_var(CS%area_shelf_h, G%domain) - call pass_var(CS%h_shelf, G%domain) - call pass_var(CS%hmask, G%domain) - call pass_var(CS%mass_shelf, G%domain) + call pass_var(ISS%area_shelf_h, G%domain) + call pass_var(ISS%h_shelf, G%domain) + call pass_var(ISS%hmask, G%domain) + call pass_var(ISS%mass_shelf, G%domain) end subroutine update_shelf_mass -subroutine initialize_diagnostic_fields(CS, G, Time) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure +subroutine initialize_diagnostic_fields(CS, ISS, G, Time) + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), pointer :: ISS !< A structure with elements that describe + !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. type(time_type), intent(in) :: Time integer :: i, j, iters, isd, ied, jsd, jed real :: rhoi, rhow, OD type(time_type) :: dummy_time - real,dimension(:,:),pointer :: OD_av, float_frac, h_shelf + real,dimension(:,:),pointer :: OD_av, float_frac rhoi = CS%density_ice rhow = CS%density_ocean_avg dummy_time = set_time (0,0) OD_av => CS%OD_av - h_shelf => CS%h_shelf float_frac => CS%float_frac isd=G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed do j=jsd,jed do i=isd,ied - OD = G%bathyT(i,j) - rhoi/rhow * h_shelf(i,j) + OD = G%bathyT(i,j) - rhoi/rhow * ISS%h_shelf(i,j) if (OD >= 0) then ! ice thickness does not take up whole ocean column -> floating OD_av(i,j) = OD @@ -2105,7 +2108,7 @@ subroutine initialize_diagnostic_fields(CS, G, Time) enddo enddo - call ice_shelf_solve_outer(CS, G, CS%u_shelf, CS%v_shelf, iters, dummy_time) + call ice_shelf_solve_outer(CS, ISS, G, CS%u_shelf, CS%v_shelf, iters, dummy_time) end subroutine initialize_diagnostic_fields @@ -2131,9 +2134,9 @@ subroutine ice_shelf_save_restart(CS, Time, directory, time_stamped, filename_su !### THESE ARE ONLY HERE FOR DEBUGGING? ! call savearray2 ("U_before_"//"p"//trim(procnum),CS%u_shelf,CS%write_output_to_file) ! call savearray2 ("V_before_"//"p"//trim(procnum),CS%v_shelf,CS%write_output_to_file) -! call savearray2 ("H_before_"//"p"//trim(procnum),CS%h_shelf,CS%write_output_to_file) -! call savearray2 ("Hmask_before_"//"p"//trim(procnum),CS%hmask,CS%write_output_to_file) -! call savearray2 ("Harea_before_"//"p"//trim(procnum),CS%area_shelf_h,CS%write_output_to_file) +! call savearray2 ("H_before_"//"p"//trim(procnum),ISS%h_shelf,CS%write_output_to_file) +! call savearray2 ("Hmask_before_"//"p"//trim(procnum),ISS%hmask,CS%write_output_to_file) +! call savearray2 ("Harea_before_"//"p"//trim(procnum),ISS%area_shelf_h,CS%write_output_to_file) ! call savearray2 ("Visc_before_"//"p"//trim(procnum),CS%ice_visc_bilinear,CS%write_output_to_file) ! call savearray2 ("taub_before_"//"p"//trim(procnum),CS%taub_beta_eff_bilinear,CS%write_output_to_file) ! call savearray2 ("taub_before_"//"p"//trim(procnum),CS%taub_beta_eff_bilinear,CS%write_output_to_file) @@ -2145,8 +2148,10 @@ subroutine ice_shelf_save_restart(CS, Time, directory, time_stamped, filename_su end subroutine ice_shelf_save_restart -subroutine ice_shelf_advect(CS, G, time_step, melt_rate, Time) +subroutine ice_shelf_advect(CS, ISS, G, time_step, melt_rate, Time) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), pointer :: ISS !< A structure with elements that describe + !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step real, dimension(:,:), pointer :: melt_rate @@ -2191,14 +2196,12 @@ subroutine ice_shelf_advect(CS, G, time_step, melt_rate, Time) ! o--- (3) ---o ! - real, dimension(size(CS%h_shelf,1),size(CS%h_shelf,2)) :: h_after_uflux, h_after_vflux - real, dimension(size(CS%h_shelf,1),size(CS%h_shelf,2),4) :: flux_enter + real, dimension(SZDI_(G),SZDJ_(G)) :: h_after_uflux, h_after_vflux + real, dimension(SZDI_(G),SZDJ_(G),4) :: flux_enter integer :: isd, ied, jsd, jed, i, j, isc, iec, jsc, jec real :: rho, spy, thick_bd - real, dimension(:,:), pointer :: hmask character(len=2) :: procnum - hmask => CS%hmask rho = CS%density_ice spy = 365 * 86400 ! seconds per year; is there a global constant for this? No - it is dependent upon a calendar. @@ -2214,19 +2217,19 @@ subroutine ice_shelf_advect(CS, G, time_step, melt_rate, Time) do i=isd,ied thick_bd = CS%thickness_boundary_values(i,j) if (thick_bd /= 0.0) then - CS%h_shelf(i,j) = CS%thickness_boundary_values(i,j) + ISS%h_shelf(i,j) = CS%thickness_boundary_values(i,j) endif enddo enddo - call ice_shelf_advect_thickness_x(CS, G, time_step/spy, CS%h_shelf, h_after_uflux, flux_enter) + call ice_shelf_advect_thickness_x(CS, G, time_step/spy, ISS%hmask, ISS%h_shelf, h_after_uflux, flux_enter) ! call enable_averaging(time_step,Time,CS%diag) ! call pass_var(h_after_uflux, G%domain) ! if (CS%id_h_after_uflux > 0) call post_data(CS%id_h_after_uflux, h_after_uflux, CS%diag) ! call disable_averaging(CS%diag) - call ice_shelf_advect_thickness_y(CS, G, time_step/spy, h_after_uflux, h_after_vflux, flux_enter) + call ice_shelf_advect_thickness_y(CS, G, time_step/spy, ISS%hmask, h_after_uflux, h_after_vflux, flux_enter) ! call enable_averaging(time_step,Time,CS%diag) ! call pass_var(h_after_vflux, G%domain) @@ -2235,34 +2238,34 @@ subroutine ice_shelf_advect(CS, G, time_step, melt_rate, Time) do j=jsd,jed do i=isd,ied - if (CS%hmask(i,j) == 1) then - CS%h_shelf(i,j) = h_after_vflux(i,j) - endif + if (ISS%hmask(i,j) == 1) ISS%h_shelf(i,j) = h_after_vflux(i,j) enddo enddo if (CS%moving_shelf_front) then - call shelf_advance_front(CS, G, flux_enter) + call shelf_advance_front(CS, ISS, G, flux_enter) if (CS%min_thickness_simple_calve > 0.0) then - call ice_shelf_min_thickness_calve(CS, G, CS%h_shelf, CS%area_shelf_h, CS%hmask) + call ice_shelf_min_thickness_calve(CS, G, ISS%h_shelf, ISS%area_shelf_h, ISS%hmask) endif if (CS%calve_to_mask) then - call calve_to_mask(CS, G, CS%h_shelf, CS%area_shelf_h, CS%hmask, CS%calve_mask) + call calve_to_mask(CS, G, ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, CS%calve_mask) endif endif !call enable_averaging(time_step,Time,CS%diag) - !if (CS%id_h_after_adv > 0) call post_data(CS%id_h_after_adv, CS%h_shelf, CS%diag) + !if (CS%id_h_after_adv > 0) call post_data(CS%id_h_after_adv, ISS%h_shelf, CS%diag) !call disable_averaging(CS%diag) - !call change_thickness_using_melt(CS,G,time_step, fluxes) + !call change_thickness_using_melt(CS, ISS, G,time_step, fluxes) - call update_velocity_masks(CS, G) + call update_velocity_masks(CS, G, ISS%hmask) end subroutine ice_shelf_advect -subroutine ice_shelf_solve_outer(CS, G, u, v, iters, time) +subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), pointer :: ISS !< A structure with elements that describe + !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, dimension(SZDIB_(G),SZDJB_(G)), & intent(inout) :: u, v @@ -2315,7 +2318,7 @@ subroutine ice_shelf_solve_outer(CS, G, u, v, iters, time) ! Include the edge if tile is at the southern bdry; Should add a test to avoid this if reentrant. if (G%jsc+G%jdg_offset==G%jsg) jsumstart = G%jscB - call calc_shelf_driving_stress(CS, G, TAUDX, TAUDY, CS%OD_av) + call calc_shelf_driving_stress(CS, ISS, G, TAUDX, TAUDY, CS%OD_av) ! this is to determine which cells contain the grounding line, ! the criterion being that the cell is ice-covered, with some nodes @@ -2327,7 +2330,7 @@ subroutine ice_shelf_solve_outer(CS, G, u, v, iters, time) if (CS%GL_regularize) then - call interpolate_H_to_B(CS, G, CS%h_shelf, CS%hmask, H_node) + call interpolate_H_to_B(CS, G, ISS%h_shelf, ISS%hmask, H_node) call savearray2 ("H_node",H_node,CS%write_output_to_file) do j=G%jsc,G%jec @@ -2335,7 +2338,7 @@ subroutine ice_shelf_solve_outer(CS, G, u, v, iters, time) nodefloat = 0 do k=0,1 do l=0,1 - if ((CS%hmask(i,j) == 1) .and. & + if ((ISS%hmask(i,j) == 1) .and. & (rhoi/rhow * H_node(i-1+k,j-1+l) - G%bathyT(i,j) <= 0)) then nodefloat = nodefloat + 1 endif @@ -2381,7 +2384,7 @@ subroutine ice_shelf_solve_outer(CS, G, u, v, iters, time) Phi(i,j,:,:) = Phi_temp enddo ; enddo - call calc_shelf_visc_bilinear(CS, G, u, v) + call calc_shelf_visc_bilinear(CS, ISS, G, u, v) call pass_var(CS%ice_visc_bilinear, G%domain) call pass_var(CS%taub_beta_eff_bilinear, G%domain) @@ -2392,12 +2395,12 @@ subroutine ice_shelf_solve_outer(CS, G, u, v, iters, time) CS%taub_beta_eff_bilinear(i,j) = CS%taub_beta_eff_bilinear(i,j) * CS%float_frac(i,j) enddo ; enddo - call apply_boundary_values_bilinear(CS, G, time, Phisub, H_node, float_cond, & + call apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, float_cond, & rhoi/rhow, u_bdry_cont, v_bdry_cont) Au(:,:) = 0.0 ; Av(:,:) = 0.0 - call CG_action_bilinear(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, CS%hmask, H_node, & + call CG_action_bilinear(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & CS%ice_visc_bilinear, float_cond, G%bathyT, CS%taub_beta_eff_bilinear, G%areaT, & G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) @@ -2430,7 +2433,7 @@ subroutine ice_shelf_solve_outer(CS, G, u, v, iters, time) do iter=1,100 call ice_shelf_solve_inner(CS, G, u, v, TAUDX, TAUDY, H_node, float_cond, & - conv_flag, iters, time, Phi, Phisub) + ISS%hmask, conv_flag, iters, time, Phi, Phisub) if (CS%DEBUG) then call qchksum(u, "u shelf", G%HI, haloshift=2) @@ -2439,7 +2442,7 @@ subroutine ice_shelf_solve_outer(CS, G, u, v, iters, time) if (is_root_pe()) print *,"linear solve done",iters," iterations" - call calc_shelf_visc_bilinear(CS, G, u, v) + call calc_shelf_visc_bilinear(CS, ISS, G, u, v) call pass_var(CS%ice_visc_bilinear, G%domain) call pass_var(CS%taub_beta_eff_bilinear, G%domain) @@ -2455,12 +2458,12 @@ subroutine ice_shelf_solve_outer(CS, G, u, v, iters, time) u_bdry_cont(:,:) = 0 ; v_bdry_cont(:,:) = 0 - call apply_boundary_values_bilinear(CS, G, time, Phisub, H_node, float_cond, & + call apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, float_cond, & rhoi/rhow, u_bdry_cont, v_bdry_cont) Au(:,:) = 0 ; Av(:,:) = 0 - call CG_action_bilinear(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, CS%hmask, H_node, & + call CG_action_bilinear(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & CS%ice_visc_bilinear, float_cond, G%bathyT, CS%taub_beta_eff_bilinear, G%areaT, & G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) @@ -2547,12 +2550,14 @@ subroutine ice_shelf_solve_outer(CS, G, u, v, iters, time) end subroutine ice_shelf_solve_outer -subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, conv_flag, iters, time, Phi, Phisub) +subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, & + hmask, conv_flag, iters, time, Phi, Phisub) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u, v real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: taudx, taudy, H_node - real, dimension(:,:),intent(in) :: float_cond + real, dimension(:,:),intent(in) :: float_cond + real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: hmask integer, intent(out) :: conv_flag, iters type(time_type) :: time real, pointer, dimension(:,:,:,:) :: Phi @@ -2568,7 +2573,7 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, ! assumed - u, v, taud, visc, beta_eff are valid on the halo - real, dimension(:,:), pointer :: hmask, umask, vmask, u_bdry, v_bdry, & + real, dimension(:,:), pointer :: umask, vmask, u_bdry, v_bdry, & visc, visc_lo, beta, beta_lo real, dimension(LBOUND(u,1):UBOUND(u,1),LBOUND(u,2):UBOUND(u,2)) :: & Ru, Rv, Zu, Zv, DIAGu, DIAGv, RHSu, RHSv, & @@ -2585,13 +2590,11 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, real, dimension(8,4) :: Phi_temp real, dimension(2,2) :: X,Y - hmask => CS%hmask umask => CS%umask vmask => CS%vmask u_bdry => CS%u_boundary_values v_bdry => CS%v_boundary_values - hmask => CS%hmask isdq = G%isdB ; iedq = G%iedB ; jsdq = G%jsdB ; jedq = G%jedB iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB ny_halo = G%domain%njhalo ; nx_halo = G%domain%nihalo @@ -2614,8 +2617,8 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, visc => CS%ice_visc_bilinear beta => CS%taub_beta_eff_bilinear - call apply_boundary_values_bilinear(CS, G, time, Phisub, H_node, float_cond, & - CS%density_ice/CS%density_ocean_avg, ubd, vbd) + call apply_boundary_values_bilinear(CS, CS%ISS, G, time, Phisub, H_node, float_cond, & + CS%density_ice/CS%density_ocean_avg, ubd, vbd) RHSu(:,:) = taudx(:,:) - ubd(:,:) RHSv(:,:) = taudy(:,:) - vbd(:,:) @@ -2623,7 +2626,7 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, call pass_vector(RHSu, RHSv, G%domain, TO_ALL, BGRID_NE) - call matrix_diagonal_bilinear(CS, G, float_cond, H_node, & + call matrix_diagonal_bilinear(CS, G, float_cond, H_node, hmask, & CS%density_ice/CS%density_ocean_avg, Phisub, DIAGu, DIAGv) ! DIAGu(:,:) = 1 ; DIAGv(:,:) = 1 @@ -2939,15 +2942,16 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, end subroutine ice_shelf_solve_inner -subroutine ice_shelf_advect_thickness_x(CS, G, time_step, h0, h_after_uflux, flux_enter) +subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_uflux, flux_enter) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step - real, dimension(:,:), intent(in) :: h0 - real, dimension(:,:), intent(inout) :: h_after_uflux + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask + real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h0 + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_uflux real, dimension(:,:,:), intent(inout) :: flux_enter - ! use will be made of CS%hmask here - its value at the boundary will be zero, just like uncovered cells + ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells ! if there is an input bdry condition, the thickness there will be set in initialization @@ -2969,14 +2973,11 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, h0, h_after_uflux, flu integer :: i_off, j_off logical :: at_east_bdry, at_west_bdry, one_off_west_bdry, one_off_east_bdry real, dimension(-2:2) :: stencil - real, dimension(:,:), pointer :: hmask, u_face_mask, u_flux_boundary_values + real, dimension(:,:), pointer :: u_face_mask, u_flux_boundary_values real :: u_face, & ! positive if out flux_diff_cell, phi, dxh, dyh, dxdyh - character (len=1) :: debug_str, procnum - - hmask => CS%hmask u_face_mask => CS%u_face_mask u_flux_boundary_values => CS%u_flux_boundary_values is = G%isc-2 ; ie = G%iec+2 ; js = G%jsc ; je = G%jec ; isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -3172,15 +3173,16 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, h0, h_after_uflux, flu end subroutine ice_shelf_advect_thickness_x -subroutine ice_shelf_advect_thickness_y(CS, G, time_step, h_after_uflux, h_after_vflux, flux_enter) +subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, h_after_vflux, flux_enter) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step - real, dimension(:,:), intent(in) :: h_after_uflux - real, dimension(:,:), intent(inout) :: h_after_vflux + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask + real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h_after_uflux + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_vflux real, dimension(:,:,:), intent(inout) :: flux_enter - ! use will be made of CS%hmask here - its value at the boundary will be zero, just like uncovered cells + ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells ! if there is an input bdry condition, the thickness there will be set in initialization @@ -3202,13 +3204,12 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, h_after_uflux, h_after integer :: i_off, j_off logical :: at_north_bdry, at_south_bdry, one_off_west_bdry, one_off_east_bdry real, dimension(-2:2) :: stencil - real, dimension(:,:), pointer :: hmask, v_face_mask, v_flux_boundary_values + real, dimension(:,:), pointer :: v_face_mask, v_flux_boundary_values real :: v_face, & ! positive if out flux_diff_cell, phi, dxh, dyh, dxdyh character(len=1) :: debug_str, procnum - hmask => CS%hmask v_face_mask => CS%v_face_mask v_flux_boundary_values => CS%v_flux_boundary_values is = G%isc ; ie = G%iec ; js = G%jsc-1 ; je = G%jec+1 ; isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -3379,8 +3380,10 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, h_after_uflux, h_after end subroutine ice_shelf_advect_thickness_y -subroutine shelf_advance_front(CS, G, flux_enter) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure +subroutine shelf_advance_front(CS, ISS, G, flux_enter) + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), pointer :: ISS !< A structure with elements that describe + !! the ice-shelf state type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(:,:,:), intent(inout) :: flux_enter @@ -3420,10 +3423,10 @@ subroutine shelf_advance_front(CS, G, flux_enter) ! real, dimension(size(flux_enter,1),size(flux_enter,2),size(flux_enter,2)) :: flux_enter_replace real, dimension(:,:,:), pointer :: flux_enter_replace => NULL() - h_shelf => CS%h_shelf - hmask => CS%hmask - mass_shelf => CS%mass_shelf - area_shelf_h => CS%area_shelf_h + h_shelf => ISS%h_shelf + hmask => ISS%hmask + mass_shelf => ISS%mass_shelf + area_shelf_h => ISS%area_shelf_h u_face_mask => CS%u_face_mask v_face_mask => CS%v_face_mask isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec @@ -3564,8 +3567,8 @@ subroutine shelf_advance_front(CS, G, flux_enter) end subroutine shelf_advance_front !> Apply a very simple calving law using a minimum thickness rule -subroutine ice_shelf_min_thickness_calve(CS, G, h_shelf, area_shelf_h,hmask) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure +subroutine ice_shelf_min_thickness_calve(CS, G, h_shelf, area_shelf_h, hmask) + type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(:,:), intent(inout) :: h_shelf, area_shelf_h, hmask integer :: i,j @@ -3603,8 +3606,10 @@ subroutine calve_to_mask(CS, G, h_shelf, area_shelf_h, hmask, calve_mask) end subroutine calve_to_mask -subroutine calc_shelf_driving_stress(CS, G, TAUD_X, TAUD_Y, OD) +subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), pointer :: ISS !< A structure with elements that describe + !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, dimension(:,:), intent(in) :: OD real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: TAUD_X, TAUD_Y @@ -3644,9 +3649,9 @@ subroutine calc_shelf_driving_stress(CS, G, TAUD_X, TAUD_Y, OD) i_off = G%idg_offset ; j_off = G%jdg_offset ! D => G%bathyT - H => CS%h_shelf + H => ISS%h_shelf float_frac => CS%float_frac - hmask => CS%hmask + hmask => ISS%hmask u_face_mask => CS%u_face_mask v_face_mask => CS%v_face_mask rho = CS%density_ice @@ -3813,10 +3818,13 @@ subroutine calc_shelf_driving_stress(CS, G, TAUD_X, TAUD_Y, OD) end subroutine calc_shelf_driving_stress -subroutine init_boundary_values(CS, G, time, input_flux, input_thick, new_sim) +subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new_sim) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. type(time_type), intent(in) :: Time + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: hmask !< A mask indicating which tracer points are + !! partly or fully coupled by an ice-shelf real, intent(in) :: input_flux, input_thick logical, optional, intent(in) :: new_sim !< If present and false, this run is being restarted @@ -3831,7 +3839,7 @@ subroutine init_boundary_values(CS, G, time, input_flux, input_thick, new_sim) real, dimension(:,:) , pointer :: thickness_boundary_values, & u_boundary_values, & v_boundary_values, & - u_face_mask, v_face_mask, hmask + u_face_mask, v_face_mask integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq integer :: gjec, gisc, gjsc, cnt, isc, jsc, iec, jec integer :: i_off, j_off @@ -3846,7 +3854,7 @@ subroutine init_boundary_values(CS, G, time, input_flux, input_thick, new_sim) thickness_boundary_values => CS%thickness_boundary_values u_boundary_values => CS%u_boundary_values ; v_boundary_values => CS%v_boundary_values - u_face_mask => CS%u_face_mask ; v_face_mask => CS%v_face_mask ; hmask => CS%hmask + u_face_mask => CS%u_face_mask ; v_face_mask => CS%v_face_mask domain_width = CS%len_lat @@ -4138,20 +4146,23 @@ subroutine CG_action_subgrid_basal_bilinear (Phisub, H, U, V, DXDYH, D, dens_rat end subroutine CG_action_subgrid_basal_bilinear -subroutine matrix_diagonal_bilinear(CS, G, float_cond, H_node, dens_ratio, Phisub, u_diagonal, v_diagonal) +subroutine matrix_diagonal_bilinear(CS, G, float_cond, H_node, hmask, dens_ratio, Phisub, u_diagonal, v_diagonal) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: H_node real :: dens_ratio real, dimension(:,:), intent(in) :: float_cond + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: hmask !< A mask indicating which tracer points are + !! partly or fully coupled by an ice-shelf real, dimension(:,:,:,:,:,:),pointer :: Phisub real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u_diagonal, v_diagonal ! returns the diagonal entries of the matrix for a Jacobi preconditioning - real, dimension(:,:), pointer :: umask, vmask, hmask, & + real, dimension(:,:), pointer :: umask, vmask, & nu, beta integer :: i, j, is, js, cnt, isc, jsc, iec, jec, iphi, jphi, iq, jq, ilq, jlq real :: A, n, ux, uy, vx, vy, eps_min, domain_width, dxh, dyh, dxdyh, area, uq, vq, basel @@ -4163,7 +4174,7 @@ subroutine matrix_diagonal_bilinear(CS, G, float_cond, H_node, dens_ratio, Phisu isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec - umask => CS%umask ; vmask => CS%vmask ; hmask => CS%hmask + umask => CS%umask ; vmask => CS%vmask nu => CS%ice_visc_bilinear beta => CS%taub_beta_eff_bilinear @@ -4309,10 +4320,12 @@ subroutine CG_diagonal_subgrid_basal_bilinear (Phisub, H, DXDYH, D, dens_ratio, end subroutine CG_diagonal_subgrid_basal_bilinear -subroutine apply_boundary_values_bilinear(CS, G, time, Phisub, H_node, float_cond, dens_ratio, & +subroutine apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, float_cond, dens_ratio, & u_boundary_contr, v_boundary_contr) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), pointer :: ISS !< A structure with elements that describe + !! the ice-shelf state type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. type(time_type), intent(in) :: Time real, dimension(:,:,:,:,:,:),pointer:: Phisub @@ -4340,7 +4353,7 @@ subroutine apply_boundary_values_bilinear(CS, G, time, Phisub, H_node, float_con u_boundary_values => CS%u_boundary_values v_boundary_values => CS%v_boundary_values - umask => CS%umask ; vmask => CS%vmask ; hmask => CS%hmask + umask => CS%umask ; vmask => CS%vmask ; hmask => ISS%hmask nu => CS%ice_visc_bilinear beta => CS%taub_beta_eff_bilinear @@ -4481,8 +4494,10 @@ subroutine apply_boundary_values_bilinear(CS, G, time, Phisub, H_node, float_con end subroutine apply_boundary_values_bilinear -subroutine calc_shelf_visc_bilinear(CS, G, u, v) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure +subroutine calc_shelf_visc_bilinear(CS, ISS, G, u, v) + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), pointer :: ISS !< A structure with elements that describe + !! the ice-shelf state type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent(inout) :: u, v @@ -4513,8 +4528,8 @@ subroutine calc_shelf_visc_bilinear(CS, G, u, v) A = CS%A_glen_isothermal ; n = CS%n_glen; eps_min = CS%eps_glen_min C_basal_friction = CS%C_basal_friction ; n_basal_friction = CS%n_basal_friction - H => CS%h_shelf - hmask => CS%hmask + H => ISS%h_shelf + hmask => ISS%hmask nu => CS%ice_visc_bilinear beta => CS%taub_beta_eff_bilinear @@ -4591,21 +4606,22 @@ subroutine update_OD_ffrac(CS, G, ocean_mass, counter, nstep_velocity, time_step end subroutine update_OD_ffrac -subroutine update_OD_ffrac_uncoupled(CS, G) +subroutine update_OD_ffrac_uncoupled(CS, G, h_shelf) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: h_shelf !< the thickness of the ice shelf in m integer :: i, j, iters, isd, ied, jsd, jed real :: rhoi, rhow, OD type(time_type) :: dummy_time - real,dimension(:,:),pointer :: OD_av, float_frac, h_shelf + real,dimension(:,:),pointer :: OD_av, float_frac rhoi = CS%density_ice rhow = CS%density_ocean_avg dummy_time = set_time (0,0) OD_av => CS%OD_av - h_shelf => CS%h_shelf float_frac => CS%float_frac isd=G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -4761,10 +4777,12 @@ subroutine bilinear_shape_functions_subgrid (Phisub, nsub) end subroutine bilinear_shape_functions_subgrid -subroutine update_velocity_masks(CS, G) +subroutine update_velocity_masks(CS, G, hmask) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: hmask !< A mask indicating which tracer points are + !! partly or fully coupled by an ice-shelf ! sets masks for velocity solve ! ignores the fact that their might be ice-free cells - this only considers the computational boundary @@ -4773,7 +4791,7 @@ subroutine update_velocity_masks(CS, G) integer :: i, j, k, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq integer :: giec, gjec, gisc, gjsc, isc, jsc, iec, jec integer :: i_off, j_off - real, dimension(:,:), pointer :: umask, vmask, u_face_mask, v_face_mask, hmask + real, dimension(:,:), pointer :: umask, vmask, u_face_mask, v_face_mask real, dimension(:,:), pointer :: u_face_mask_boundary, v_face_mask_boundary isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec @@ -4790,8 +4808,6 @@ subroutine update_velocity_masks(CS, G) v_face_mask => CS%v_face_mask u_face_mask_boundary => CS%u_face_mask_boundary v_face_mask_boundary => CS%v_face_mask_boundary - hmask => CS%hmask - umask(:,:) = 0 ; vmask(:,:) = 0 u_face_mask(:,:) = 0 ; v_face_mask(:,:) = 0 @@ -4961,14 +4977,14 @@ subroutine ice_shelf_end(CS) if (.not.associated(CS)) return - deallocate(CS%mass_shelf) ; deallocate(CS%area_shelf_h) + call ice_shelf_state_end(CS%ISS) + deallocate(CS%t_flux) ; deallocate(CS%lprec) deallocate(CS%salt_flux) deallocate(CS%tflux_shelf) ; deallocate(CS%tfreeze) deallocate(CS%exch_vel_t) ; deallocate(CS%exch_vel_s) - deallocate(CS%h_shelf) ; deallocate(CS%hmask) if (CS%shelf_mass_is_dynamic .and. .not.CS%override_shelf_movement) then deallocate(CS%u_shelf) ; deallocate(CS%v_shelf) @@ -5079,6 +5095,8 @@ subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) real,optional,intent(in) :: min_time_step_in type(ocean_grid_type), pointer :: G => NULL() + type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe + !! the ice-shelf state integer :: is, iec, js, jec, i, j, ki, kj, iters real :: ratio, min_ratio, time_step_remain, local_u_max, & local_v_max, time_step_int, min_time_step,spy,dumtimeprint @@ -5091,9 +5109,11 @@ subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) CS%velocity_update_sub_counter = CS%velocity_update_sub_counter + 1 spy = 365 * 86400 G => CS%grid + ISS => CS%ISS + u_shelf => CS%u_shelf v_shelf => CS%v_shelf - hmask => CS%hmask + hmask => ISS%hmask umask => CS%umask vmask => CS%vmask time_step_remain = time_step @@ -5157,10 +5177,10 @@ subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) write (stepnum,'(I4)') CS%velocity_update_sub_counter - call ice_shelf_advect(CS, G, time_step_int, CS%lprec, Time) + call ice_shelf_advect(CS, ISS, G, time_step_int, CS%lprec, Time) if (mpp_pe() == 7) then - call savearray2 ("hmask",CS%hmask,CS%write_output_to_file) + call savearray2 ("hmask",ISS%hmask,CS%write_output_to_file) !!! OVS!!! ! call savearray2 ("tshelf",CS%t_shelf,CS%write_output_to_file) endif @@ -5168,23 +5188,23 @@ subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) ! if the last mini-timestep is a day or less, we cannot expect velocities to change by much. ! do not update them if (time_step_int > 1000) then - call update_velocity_masks(CS, G) + call update_velocity_masks(CS, G, ISS%hmask) ! call savearray2 ("Umask"//"p"//trim(procnum)//"_"//trim(stepnum),CS%umask,CS%write_output_to_file) ! call savearray2 ("Vmask"//"p"//trim(procnum)//"_"//trim(stepnum),CS%vmask,CS%write_output_to_file) - call update_OD_ffrac_uncoupled(CS, G) - call ice_shelf_solve_outer(CS, G, CS%u_shelf, CS%v_shelf, iters, dummy) + call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf) + call ice_shelf_solve_outer(CS, ISS, G, CS%u_shelf, CS%v_shelf, iters, dummy) endif !!! OVS!!! - call ice_shelf_temp(CS, G, time_step_int, CS%lprec, Time) + call ice_shelf_temp(CS, ISS, G, time_step_int, CS%lprec, Time) call enable_averaging(time_step,Time,CS%diag) - if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, CS%area_shelf_h, CS%diag) + if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, ISS%area_shelf_h, CS%diag) if (CS%id_col_thick > 0) call post_data(CS%id_col_thick, CS%OD_av, CS%diag) - if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf,CS%h_shelf,CS%diag) - if (CS%id_h_mask > 0) call post_data(CS%id_h_mask,CS%hmask,CS%diag) + if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf,ISS%h_shelf,CS%diag) + if (CS%id_h_mask > 0) call post_data(CS%id_h_mask,ISS%hmask,CS%diag) if (CS%id_u_mask > 0) call post_data(CS%id_u_mask,CS%umask,CS%diag) if (CS%id_v_mask > 0) call post_data(CS%id_v_mask,CS%vmask,CS%diag) if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf,CS%u_shelf,CS%diag) @@ -5205,8 +5225,10 @@ subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) end subroutine solo_time_step !!! OVS !!! -subroutine ice_shelf_temp(CS, G, time_step, melt_rate, Time) +subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), pointer :: ISS !< A structure with elements that describe + !! the ice-shelf state type(ocean_grid_type), pointer :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step real, dimension(:,:), pointer :: melt_rate @@ -5250,14 +5272,14 @@ subroutine ice_shelf_temp(CS, G, time_step, melt_rate, Time) ! o--- (3) ---o ! - real, dimension(size(CS%h_shelf,1),size(CS%h_shelf,2)) :: th_after_uflux, th_after_vflux, TH - real, dimension(size(CS%h_shelf,1),size(CS%h_shelf,2),4) :: flux_enter + real, dimension(SZDI_(G),SZDJ_(G)) :: th_after_uflux, th_after_vflux, TH + real, dimension(SZDI_(G),SZDJ_(G),4) :: flux_enter integer :: isd, ied, jsd, jed, i, j, isc, iec, jsc, jec real :: rho, spy, t_bd, Tsurf, adot real, dimension(:,:), pointer :: hmask, Tbot character(len=2) :: procnum - hmask => CS%hmask + hmask => ISS%hmask rho = CS%density_ice spy = 365 * 86400 ! seconds per year; is there a global constant for this? No - it is dependent upon a calendar. @@ -5275,8 +5297,8 @@ subroutine ice_shelf_temp(CS, G, time_step, melt_rate, Time) do j=jsd,jed do i=isd,ied t_bd = CS%t_boundary_values(i,j) -! if (CS%hmask(i,j) > 1) then - if ((CS%hmask(i,j) == 3) .or. (CS%hmask(i,j) == -2)) then +! if (ISS%hmask(i,j) > 1) then + if ((ISS%hmask(i,j) == 3) .or. (ISS%hmask(i,j) == -2)) then CS%t_shelf(i,j) = CS%t_boundary_values(i,j) endif enddo @@ -5284,7 +5306,7 @@ subroutine ice_shelf_temp(CS, G, time_step, melt_rate, Time) do j=jsd,jed do i=isd,ied - TH(i,j) = CS%t_shelf(i,j)*CS%h_shelf(i,j) + TH(i,j) = CS%t_shelf(i,j)*ISS%h_shelf(i,j) enddo enddo @@ -5302,14 +5324,14 @@ subroutine ice_shelf_temp(CS, G, time_step, melt_rate, Time) - call ice_shelf_advect_temp_x(CS, G, time_step/spy, TH, th_after_uflux, flux_enter) - call ice_shelf_advect_temp_y(CS, G, time_step/spy, th_after_uflux, th_after_vflux, flux_enter) + call ice_shelf_advect_temp_x(CS, G, time_step/spy, hmask, TH, th_after_uflux, flux_enter) + call ice_shelf_advect_temp_y(CS, G, time_step/spy, hmask, th_after_uflux, th_after_vflux, flux_enter) do j=jsd,jed do i=isd,ied -! if (CS%hmask(i,j) == 1) then - if (CS%h_shelf(i,j) > 0.0) then - CS%t_shelf(i,j) = th_after_vflux(i,j)/CS%h_shelf(i,j) +! if (ISS%hmask(i,j) == 1) then + if (ISS%h_shelf(i,j) > 0.0) then + CS%t_shelf(i,j) = th_after_vflux(i,j)/ISS%h_shelf(i,j) else CS%t_shelf(i,j) = -10.0 endif @@ -5319,8 +5341,8 @@ subroutine ice_shelf_temp(CS, G, time_step, melt_rate, Time) do j=jsd,jed do i=isd,ied t_bd = CS%t_boundary_values(i,j) -! if (CS%hmask(i,j) > 1) then - if ((CS%hmask(i,j) == 3) .or. (CS%hmask(i,j) == -2)) then +! if (ISS%hmask(i,j) > 1) then + if ((ISS%hmask(i,j) == 3) .or. (ISS%hmask(i,j) == -2)) then CS%t_shelf(i,j) = t_bd ! CS%t_shelf(i,j) = -15.0 endif @@ -5329,10 +5351,10 @@ subroutine ice_shelf_temp(CS, G, time_step, melt_rate, Time) do j=jsc,jec do i=isc,iec - if ((CS%hmask(i,j) == 1) .or. (CS%hmask(i,j) == 2)) then - if (CS%h_shelf(i,j) > 0.0) then -! CS%t_shelf(i,j) = CS%t_shelf(i,j) + time_step*(adot*Tsurf -melt_rate(i,j)*Tbot(i,j))/CS%h_shelf(i,j) - CS%t_shelf(i,j) = CS%t_shelf(i,j) + time_step*(adot*Tsurf -3/spy*Tbot(i,j))/CS%h_shelf(i,j) + if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2)) then + if (ISS%h_shelf(i,j) > 0.0) then +! CS%t_shelf(i,j) = CS%t_shelf(i,j) + time_step*(adot*Tsurf -melt_rate(i,j)*Tbot(i,j))/ISS%h_shelf(i,j) + CS%t_shelf(i,j) = CS%t_shelf(i,j) + time_step*(adot*Tsurf -3/spy*Tbot(i,j))/ISS%h_shelf(i,j) else ! the ice is about to melt away ! in this case set thickness, area, and mask to zero @@ -5356,15 +5378,16 @@ subroutine ice_shelf_temp(CS, G, time_step, melt_rate, Time) end subroutine ice_shelf_temp -subroutine ice_shelf_advect_temp_x(CS, G, time_step, h0, h_after_uflux, flux_enter) +subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, flux_enter) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step - real, dimension(:,:), intent(in) :: h0 - real, dimension(:,:), intent(inout) :: h_after_uflux + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask + real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h0 + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_uflux real, dimension(:,:,:), intent(inout) :: flux_enter - ! use will be made of CS%hmask here - its value at the boundary will be zero, just like uncovered cells + ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells ! if there is an input bdry condition, the thickness there will be set in initialization @@ -5386,18 +5409,17 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, h0, h_after_uflux, flux_ent integer :: i_off, j_off logical :: at_east_bdry, at_west_bdry, one_off_west_bdry, one_off_east_bdry real, dimension(-2:2) :: stencil - real, dimension(:,:), pointer :: hmask, u_face_mask, u_flux_boundary_values,u_boundary_values,t_boundary + real, dimension(:,:), pointer :: u_face_mask, u_flux_boundary_values,u_boundary_values,t_boundary real :: u_face, & ! positive if out flux_diff_cell, phi, dxh, dyh, dxdyh character (len=1) :: debug_str, procnum - hmask => CS%hmask u_face_mask => CS%u_face_mask u_flux_boundary_values => CS%u_flux_boundary_values u_boundary_values => CS%u_shelf -! h_boundaries => CS%h_shelf +! h_boundaries => ISS%h_shelf t_boundary => CS%t_boundary_values is = G%isc-2 ; ie = G%iec+2 ; js = G%jsc ; je = G%jec ; isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed i_off = G%idg_offset ; j_off = G%jdg_offset @@ -5459,7 +5481,6 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, h0, h_after_uflux, flux_ent if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then ! at western bdry but there is a ! thickness bdry condition, and the stencil contains it - stencil (-1) = CS%t_boundary_values(i-1,j)*CS%h_shelf(i-1,j) flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(-1) / dxdyh elseif (hmask(i-1,j) * hmask(i-2,j) == 1) then ! h(i-2) and h(i-1) are valid @@ -5603,15 +5624,16 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, h0, h_after_uflux, flux_ent end subroutine ice_shelf_advect_temp_x -subroutine ice_shelf_advect_temp_y(CS, G, time_step, h_after_uflux, h_after_vflux, flux_enter) +subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_after_vflux, flux_enter) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), pointer :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step - real, dimension(:,:), intent(in) :: h_after_uflux - real, dimension(:,:), intent(inout) :: h_after_vflux + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask + real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h_after_uflux + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_vflux real, dimension(:,:,:), intent(inout) :: flux_enter - ! use will be made of CS%hmask here - its value at the boundary will be zero, just like uncovered cells + ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells ! if there is an input bdry condition, the thickness there will be set in initialization @@ -5633,13 +5655,12 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, h_after_uflux, h_after_vflu integer :: i_off, j_off logical :: at_north_bdry, at_south_bdry, one_off_west_bdry, one_off_east_bdry real, dimension(-2:2) :: stencil - real, dimension(:,:), pointer :: hmask, v_face_mask, v_flux_boundary_values,t_boundary,v_boundary_values + real, dimension(:,:), pointer :: v_face_mask, v_flux_boundary_values,t_boundary,v_boundary_values real :: v_face, & ! positive if out flux_diff_cell, phi, dxh, dyh, dxdyh character(len=1) :: debug_str, procnum - hmask => CS%hmask v_face_mask => CS%v_face_mask v_flux_boundary_values => CS%v_flux_boundary_values t_boundary => CS%t_boundary_values diff --git a/src/ice_shelf/MOM_ice_shelf_state.F90 b/src/ice_shelf/MOM_ice_shelf_state.F90 new file mode 100644 index 0000000000..fe9ec8d74b --- /dev/null +++ b/src/ice_shelf/MOM_ice_shelf_state.F90 @@ -0,0 +1,101 @@ +!> Implements the thermodynamic aspects of ocean / ice-shelf interactions, +!! along with a crude placeholder for a later implementation of full +!! ice shelf dynamics, all using the MOM framework and coding style. +module MOM_ice_shelf_state + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end +use MOM_cpu_clock, only : CLOCK_COMPONENT, CLOCK_ROUTINE +use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid +use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe +use MOM_file_parser, only : read_param, get_param, log_param, log_version, param_file_type +use MOM_grid, only : MOM_grid_init, ocean_grid_type +use MOM_get_input, only : directories, Get_MOM_input +use mpp_mod, only : mpp_sum, mpp_max, mpp_min, mpp_pe, mpp_npes, mpp_sync +use MOM_coms, only : reproducing_sum +use MOM_checksums, only : hchksum, qchksum, chksum, uchksum, vchksum, uvchksum + +implicit none ; private + +public ice_shelf_state_end, ice_shelf_state_init + +!> Structure that describes the ice shelf state +type, public :: ice_shelf_state + real, pointer, dimension(:,:) :: & + mass_shelf => NULL(), & !< The mass per unit area of the ice shelf or sheet, in kg m-2. + area_shelf_h => NULL(), & !< The area per cell covered by the ice shelf, in m2. + h_shelf => NULL(), & !< the thickness of the shelf in m, redundant with mass but may + !! make the code more readable + hmask => NULL(),& !< Mask used to indicate ice-covered or partiall-covered cells + !! 1: fully covered, solve for velocity here (for now all + !! ice-covered cells are treated the same, this may change) + !! 2: partially covered, do not solve for velocity + !! 0: no ice in cell. + !! 3: bdry condition on thickness set - not in computational domain + !! -2 : default (out of computational boundary, and) not = 3 + !! NOTE: hmask will change over time and NEEDS TO BE MAINTAINED + !! otherwise the wrong nodes will be included in velocity calcs. + + tflux_ocn => NULL(), & !< The UPWARD sensible ocean heat flux at the + !! ocean-ice interface, in W m-2. + salt_flux => NULL(), & !< The downward salt flux at the ocean-ice + !! interface, in kg m-2 s-1. + water_flux => NULL(), & !< The net downward liquid water flux at the + !! ocean-ice interface, in kg m-2 s-1. + tflux_shelf => NULL(), & !< The UPWARD diffusive heat flux in the ice + !! shelf at the ice-ocean interface, in W m-2. + + tfreeze => NULL() !< The freezing point potential temperature + !! an the ice-ocean interface, in deg C. + +end type ice_shelf_state + +contains + +!> Deallocates all memory associated with this module +subroutine ice_shelf_state_init(ISS, G) + type(ice_shelf_state), pointer :: ISS !< A pointer to the ice shelf state structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + + integer :: isd, ied, jsd, jed + isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed + + if (associated(ISS)) then + call MOM_error(FATAL, "MOM_ice_shelf_state.F90, ice_shelf_state_init: "// & + "called with an associated ice_shelf_state pointer.") + return + endif + allocate(ISS) + + allocate(ISS%mass_shelf(isd:ied,jsd:jed) ) ; ISS%mass_shelf(:,:) = 0.0 + allocate(ISS%area_shelf_h(isd:ied,jsd:jed) ) ; ISS%area_shelf_h(:,:) = 0.0 + allocate(ISS%h_shelf(isd:ied,jsd:jed) ) ; ISS%h_shelf(:,:) = 0.0 + allocate(ISS%hmask(isd:ied,jsd:jed) ) ; ISS%hmask(:,:) = -2.0 + + allocate(ISS%tflux_ocn(isd:ied,jsd:jed) ) ; ISS%tflux_ocn(:,:) = 0.0 + allocate(ISS%water_flux(isd:ied,jsd:jed) ) ; ISS%water_flux(:,:) = 0.0 + allocate(ISS%salt_flux(isd:ied,jsd:jed) ) ; ISS%salt_flux(:,:) = 0.0 + allocate(ISS%tflux_shelf(isd:ied,jsd:jed) ) ; ISS%tflux_shelf(:,:) = 0.0 + allocate(ISS%tfreeze(isd:ied,jsd:jed) ) ; ISS%tfreeze(:,:) = 0.0 + +end subroutine ice_shelf_state_init + + +!> Deallocates all memory associated with this module +subroutine ice_shelf_state_end(ISS) + type(ice_shelf_state), pointer :: ISS !< A pointer to the ice shelf state structure + + if (.not.associated(ISS)) return + + deallocate(ISS%mass_shelf, ISS%area_shelf_h, ISS%h_shelf, ISS%hmask) + + deallocate(ISS%tflux_ocn, ISS%water_flux, ISS%salt_flux, ISS%tflux_shelf) + deallocate(ISS%tfreeze) + + deallocate(ISS) + +end subroutine ice_shelf_state_end + + +end module MOM_ice_shelf_state From 658f760785b746d900dd52d1237869ea1fe1c1a1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 21 May 2018 05:07:11 -0400 Subject: [PATCH 0277/1072] +Use ice_shelf_state for fluxes to ice shelf Use elements of the ice_shelf_state for the thermodynamic fluxes between the ice shelf and the ocean, as seen by the ice shelf. Also made the exchange velocity arrays into local variables. All answers are bitwise identical. --- src/ice_shelf/MOM_ice_shelf.F90 | 162 ++++++++++++++------------------ 1 file changed, 68 insertions(+), 94 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 4aacf218c5..128e850e31 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -74,19 +74,7 @@ module MOM_ice_shelf !! the ice-shelf state real, pointer, dimension(:,:) :: & - t_flux => NULL(), & !< The UPWARD sensible ocean heat flux at the - !! ocean-ice interface, in W m-2. - salt_flux => NULL(), & !< The downward salt flux at the ocean-ice - !! interface, in kg m-2 s-1. - lprec => NULL(), & !< The downward liquid water flux at the - !! ocean-ice interface, in kg m-2 s-1. - exch_vel_t => NULL(), & !< Sub-shelf thermal exchange velocity, in m/s - exch_vel_s => NULL(), & !< Sub-shelf salt exchange velocity, in m/s utide => NULL(), & !< tidal velocity, in m/s - tfreeze => NULL(), & !< The freezing point potential temperature - !! an the ice-ocean interface, in deg C. - tflux_shelf => NULL(), & !< The UPWARD diffusive heat flux in the ice - !! shelf at the ice-ocean interface, in W m-2. !!! DNG !!! u_shelf => NULL(), & !< the zonal (?) velocity of the ice shelf/sheet, ! in meters per second??? on q-points (B grid) @@ -269,8 +257,7 @@ module MOM_ice_shelf integer :: id_read_area !< An integer handle used in time interpolation of !! the ice shelf mass read from a file - type(diag_ctrl), pointer :: diag !< A structure that is used to control diagnostic - !! output. + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to control diagnostic output. type(user_ice_shelf_CS), pointer :: user_CS => NULL() logical :: write_output_to_file !< this is for seeing arrays w/out netcdf capability @@ -346,6 +333,10 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) !< with salinity, in units of kg m-3 psu-1. p_int !< The pressure at the ice-ocean interface, in Pa. + real, dimension(SZI_(CS%grid),SZJ_(CS%grid)) :: & + exch_vel_t, & !< Sub-shelf thermal exchange velocity, in m/s + exch_vel_s !< Sub-shelf salt exchange velocity, in m/s + real, dimension(:,:), allocatable :: mass_flux !< total mass flux of freshwater across real, dimension(:,:), allocatable :: haline_driving !< (SSS - S_boundary) ice-ocean !! interface, positive for melting and negative for freezing. @@ -425,10 +416,10 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) ! these fields are already set to zero during initialization ! However, they seem to be changed somewhere and, for diagnostic ! reasons, it is better to set them to zero again. - CS%tflux_shelf(:,:) = 0.0; CS%exch_vel_t(:,:) = 0.0 - CS%lprec(:,:) = 0.0; CS%exch_vel_s(:,:) = 0.0 - CS%salt_flux(:,:) = 0.0; CS%t_flux(:,:) = 0.0 - CS%tfreeze(:,:) = 0.0 + exch_vel_t(:,:) = 0.0 ; exch_vel_s(:,:) = 0.0 + ISS%tflux_shelf(:,:) = 0.0 ; ISS%water_flux(:,:) = 0.0 + ISS%salt_flux(:,:) = 0.0; ISS%tflux_ocn(:,:) = 0.0 + ISS%tfreeze(:,:) = 0.0 ! define Sbdry to avoid Run-Time Check Failure, when melt is not computed. allocate( haline_driving(G%ied,G%jed) ); haline_driving(:,:) = 0.0 allocate( Sbdry(G%ied,G%jed) ); Sbdry(:,:) = state%sss(:,:) @@ -538,9 +529,9 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) do it1 = 1,20 ! Determine the potential temperature at the ice-ocean interface. - call calculate_TFreeze(Sbdry(i,j), p_int(i), CS%tfreeze(i,j), CS%eqn_of_state) + call calculate_TFreeze(Sbdry(i,j), p_int(i), ISS%tfreeze(i,j), CS%eqn_of_state) - dT_ustar = (state%sst(i,j) - CS%tfreeze(i,j)) * ustar_h + dT_ustar = (state%sst(i,j) - ISS%tfreeze(i,j)) * ustar_h dS_ustar = (state%sss(i,j) - Sbdry(i,j)) * ustar_h ! First, determine the buoyancy flux assuming no effects of stability @@ -607,9 +598,9 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) enddo !it3 endif - CS%t_flux(i,j) = RhoCp * wT_flux - CS%exch_vel_t(i,j) = ustar_h * I_Gam_T - CS%exch_vel_s(i,j) = ustar_h * I_Gam_S + ISS%tflux_ocn(i,j) = RhoCp * wT_flux + exch_vel_t(i,j) = ustar_h * I_Gam_T + exch_vel_s(i,j) = ustar_h * I_Gam_S !Calculate the heat flux inside the ice shelf. @@ -619,39 +610,39 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) ! dT/dz ~= min( (lprec/(rho_ice*K_ice))*(CS%Temp_Ice-T_freeze) , 0.0 ) !If this approximation is not made, iterations are required... See H+J Fig 3. - if (CS%t_flux(i,j) <= 0.0) then ! Freezing occurs, so zero ice heat flux. - CS%lprec(i,j) = I_LF * CS%t_flux(i,j) - CS%tflux_shelf(i,j) = 0.0 + if (ISS%tflux_ocn(i,j) <= 0.0) then ! Freezing occurs, so zero ice heat flux. + ISS%water_flux(i,j) = I_LF * ISS%tflux_ocn(i,j) + ISS%tflux_shelf(i,j) = 0.0 else if (CS%insulator) then !no conduction/perfect insulator - CS%tflux_shelf(i,j) = 0.0 - CS%lprec(i,j) = I_LF * (- CS%tflux_shelf(i,j) + CS%t_flux(i,j)) + ISS%tflux_shelf(i,j) = 0.0 + ISS%water_flux(i,j) = I_LF * (- ISS%tflux_shelf(i,j) + ISS%tflux_ocn(i,j)) else ! With melting, from H&J 1999, eqs (31) & (26)... ! Q_ice ~= cp_ice * (CS%Temp_Ice-T_freeze) * lprec - ! RhoLF*lprec = Q_ice + CS%t_flux(i,j) - ! lprec = (CS%t_flux(i,j)) / (LF + cp_ice * (T_freeze-CS%Temp_Ice)) - CS%lprec(i,j) = CS%t_flux(i,j) / & - (LF + CS%CP_Ice * (CS%Tfreeze(i,j) - CS%Temp_Ice)) + ! RhoLF*lprec = Q_ice + ISS%tflux_ocn(i,j) + ! lprec = (ISS%tflux_ocn(i,j)) / (LF + cp_ice * (T_freeze-CS%Temp_Ice)) + ISS%water_flux(i,j) = ISS%tflux_ocn(i,j) / & + (LF + CS%CP_Ice * (ISS%tfreeze(i,j) - CS%Temp_Ice)) - CS%tflux_shelf(i,j) = CS%t_flux(i,j) - LF*CS%lprec(i,j) + ISS%tflux_shelf(i,j) = ISS%tflux_ocn(i,j) - LF*ISS%water_flux(i,j) endif endif !other options: dTi/dz linear through shelf - ! dTi_dz = (CS%Temp_Ice - CS%tfreeze(i,j))/G%draft(i,j) - ! CS%tflux_shelf(i,j) = - Rho_Ice * CS%CP_Ice * KTI * dTi_dz + ! dTi_dz = (CS%Temp_Ice - ISS%tfreeze(i,j))/G%draft(i,j) + ! ISS%tflux_shelf(i,j) = - Rho_Ice * CS%CP_Ice * KTI * dTi_dz if (CS%find_salt_root) then exit ! no need to do interaction, so exit loop else - mass_exch = CS%exch_vel_s(i,j) * CS%Rho0 + mass_exch = exch_vel_s(i,j) * CS%Rho0 Sbdry_it = (state%sss(i,j) * mass_exch + CS%Salin_ice * & - CS%lprec(i,j)) / (mass_exch + CS%lprec(i,j)) + ISS%water_flux(i,j)) / (mass_exch + ISS%water_flux(i,j)) dS_it = Sbdry_it - Sbdry(i,j) if (abs(dS_it) < 1e-4*(0.5*(state%sss(i,j) + Sbdry(i,j) + 1.e-10))) exit @@ -686,16 +677,16 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) ! is specified and large enough that the ocean salinity at the interface ! is about the same as the boundary layer salinity. - call calculate_TFreeze(state%sss(i,j), p_int(i), CS%tfreeze(i,j), CS%eqn_of_state) + call calculate_TFreeze(state%sss(i,j), p_int(i), ISS%tfreeze(i,j), CS%eqn_of_state) - CS%exch_vel_t(i,j) = CS%gamma_t - CS%t_flux(i,j) = RhoCp * CS%exch_vel_t(i,j) * (state%sst(i,j) - CS%tfreeze(i,j)) - CS%tflux_shelf(i,j) = 0.0 - CS%lprec(i,j) = I_LF * CS%t_flux(i,j) + exch_vel_t(i,j) = CS%gamma_t + ISS%tflux_ocn(i,j) = RhoCp * exch_vel_t(i,j) * (state%sst(i,j) - ISS%tfreeze(i,j)) + ISS%tflux_shelf(i,j) = 0.0 + ISS%water_flux(i,j) = I_LF * ISS%tflux_ocn(i,j) Sbdry(i,j) = 0.0 endif else !not shelf - CS%t_flux(i,j) = 0.0 + ISS%tflux_ocn(i,j) = 0.0 endif ! haline_driving(:,:) = state%sss(i,j) - Sbdry(i,j) @@ -703,12 +694,12 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) enddo ! i-loop enddo ! j-loop - ! CS%lprec = precipitating liquid water into the ocean ( kg/(m^2 s) ) + ! ISS%water_flux = net liquid water into the ocean ( kg/(m^2 s) ) ! We want melt in m/year if (CS%const_gamma) then ! use ISOMIP+ eq. with rho_fw - fluxes%iceshelf_melt = CS%lprec * (86400.0*365.0/rho_fw) * CS%flux_factor + fluxes%iceshelf_melt = ISS%water_flux * (86400.0*365.0/rho_fw) * CS%flux_factor else ! use original eq. - fluxes%iceshelf_melt = CS%lprec * (86400.0*365.0/CS%density_ice) * CS%flux_factor + fluxes%iceshelf_melt = ISS%water_flux * (86400.0*365.0/CS%density_ice) * CS%flux_factor endif do j=js,je @@ -722,12 +713,12 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) ! test case. if ((CS%g_Earth * ISS%mass_shelf(i,j)) < CS%Rho0*CS%cutoff_depth* & CS%g_Earth) then - CS%lprec(i,j) = 0.0 + ISS%water_flux(i,j) = 0.0 fluxes%iceshelf_melt(i,j) = 0.0 endif ! Compute haline driving, which is one of the diags. used in ISOMIP - haline_driving(i,j) = (CS%lprec(i,j) * Sbdry(i,j)) / & - (CS%Rho0 * CS%exch_vel_s(i,j)) + haline_driving(i,j) = (ISS%water_flux(i,j) * Sbdry(i,j)) / & + (CS%Rho0 * exch_vel_s(i,j)) !!!!!!!!!!!!!!!!!!!!!!!!!!!!Safety checks !!!!!!!!!!!!!!!!!!!!!!!!! !1)Check if haline_driving computed above is consistent with @@ -758,7 +749,7 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) ! mass flux (kg/s), part of ISOMIP diags. allocate( mass_flux(G%ied,G%jed) ); mass_flux(:,:) = 0.0 - mass_flux = (CS%lprec) * ISS%area_shelf_h + mass_flux = (ISS%water_flux) * ISS%area_shelf_h if (CS%shelf_mass_is_dynamic) then call cpu_clock_begin(id_clock_pass) @@ -791,7 +782,7 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) ! note time_step is [s] and lprec is [kg / m^2 / s] - call ice_shelf_advect(CS, ISS, G, time_step, CS%lprec, Time) + call ice_shelf_advect(CS, ISS, G, time_step, ISS%water_flux, Time) CS%velocity_update_sub_counter = CS%velocity_update_sub_counter+1 @@ -818,16 +809,16 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, ISS%area_shelf_h, CS%diag) if (CS%id_ustar_shelf > 0) call post_data(CS%id_ustar_shelf, fluxes%ustar_shelf, CS%diag) if (CS%id_melt > 0) call post_data(CS%id_melt, fluxes%iceshelf_melt, CS%diag) - if (CS%id_thermal_driving > 0) call post_data(CS%id_thermal_driving, (state%sst-CS%tfreeze), CS%diag) + if (CS%id_thermal_driving > 0) call post_data(CS%id_thermal_driving, (state%sst-ISS%tfreeze), CS%diag) if (CS%id_Sbdry > 0) call post_data(CS%id_Sbdry, Sbdry, CS%diag) if (CS%id_haline_driving > 0) call post_data(CS%id_haline_driving, haline_driving, CS%diag) if (CS%id_mass_flux > 0) call post_data(CS%id_mass_flux, mass_flux, CS%diag) if (CS%id_u_ml > 0) call post_data(CS%id_u_ml,state%u,CS%diag) if (CS%id_v_ml > 0) call post_data(CS%id_v_ml,state%v,CS%diag) - if (CS%id_tfreeze > 0) call post_data(CS%id_tfreeze, CS%tfreeze, CS%diag) - if (CS%id_tfl_shelf > 0) call post_data(CS%id_tfl_shelf, CS%tflux_shelf, CS%diag) - if (CS%id_exch_vel_t > 0) call post_data(CS%id_exch_vel_t, CS%exch_vel_t, CS%diag) - if (CS%id_exch_vel_s > 0) call post_data(CS%id_exch_vel_s, CS%exch_vel_s, CS%diag) + if (CS%id_tfreeze > 0) call post_data(CS%id_tfreeze, ISS%tfreeze, CS%diag) + if (CS%id_tfl_shelf > 0) call post_data(CS%id_tfl_shelf, ISS%tflux_shelf, CS%diag) + if (CS%id_exch_vel_t > 0) call post_data(CS%id_exch_vel_t, exch_vel_t, CS%diag) + if (CS%id_exch_vel_s > 0) call post_data(CS%id_exch_vel_s, exch_vel_s, CS%diag) if (CS%id_col_thick > 0) call post_data(CS%id_col_thick, CS%OD_av, CS%diag) if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf,ISS%h_shelf,CS%diag) if (CS%id_h_mask > 0) call post_data(CS%id_h_mask,ISS%hmask,CS%diag) @@ -868,8 +859,8 @@ subroutine change_thickness_using_melt(CS, ISS, G,time_step, fluxes) if (associated(fluxes%frac_shelf_h)) fluxes%frac_shelf_h(i,j) = 0.0 if (associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = 0.0 - if (CS%lprec(i,j) / CS%density_ice * time_step < ISS%h_shelf(i,j)) then - ISS%h_shelf(i,j) = ISS%h_shelf(i,j) - CS%lprec(i,j) / CS%density_ice * time_step + if (ISS%water_flux(i,j) / CS%density_ice * time_step < ISS%h_shelf(i,j)) then + ISS%h_shelf(i,j) = ISS%h_shelf(i,j) - ISS%water_flux(i,j) / CS%density_ice * time_step else ! the ice is about to melt away ! in this case set thickness, area, and mask to zero @@ -945,7 +936,7 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) endif - !### Consider working over a smaller array range. + !### Consider working over a smaller array range. do j=jsd,jed ; do i=isd,ied press_ice = (ISS%area_shelf_h(i,j) * G%IareaT(i,j)) * (CS%g_Earth * ISS%mass_shelf(i,j)) if (associated(forces%p_surf)) then @@ -965,7 +956,7 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) kv_rho_ice = CS%kv_ice / CS%density_ice do j=js,je ; do I=is-1,ie if (.not.forces%accumulate_rigidity) forces%rigidity_ice_u(I,j) = 0.0 - forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + & + forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + & kv_rho_ice * min(ISS%mass_shelf(i,j), ISS%mass_shelf(i+1,j)) enddo ; enddo do J=js-1,je ; do i=is,ie @@ -1078,18 +1069,18 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) if (associated(fluxes%latent)) fluxes%latent(i,j) = 0.0 if (associated(fluxes%evap)) fluxes%evap(i,j) = 0.0 if (associated(fluxes%lprec)) then - if (CS%lprec(i,j) > 0.0) then - fluxes%lprec(i,j) = frac_area*CS%lprec(i,j)*CS%flux_factor + if (ISS%water_flux(i,j) > 0.0) then + fluxes%lprec(i,j) = frac_area*ISS%water_flux(i,j)*CS%flux_factor else fluxes%lprec(i,j) = 0.0 - fluxes%evap(i,j) = frac_area*CS%lprec(i,j)*CS%flux_factor + fluxes%evap(i,j) = frac_area*ISS%water_flux(i,j)*CS%flux_factor endif endif if (associated(fluxes%sens)) & - fluxes%sens(i,j) = -frac_area*CS%t_flux(i,j)*CS%flux_factor + fluxes%sens(i,j) = -frac_area*ISS%tflux_ocn(i,j)*CS%flux_factor if (associated(fluxes%salt_flux)) & - fluxes%salt_flux(i,j) = frac_area * CS%salt_flux(i,j)*CS%flux_factor + fluxes%salt_flux(i,j) = frac_area * ISS%salt_flux(i,j)*CS%flux_factor endif ; enddo ; enddo ! keep sea level constant by removing mass in the sponge @@ -1110,7 +1101,7 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) do j=js,je ; do i=is,ie frac_area = fluxes%frac_shelf_h(i,j) if (frac_area > 0.0) then - mean_melt_flux = mean_melt_flux + (CS%lprec(i,j)) * ISS%area_shelf_h(i,j) + mean_melt_flux = mean_melt_flux + (ISS%water_flux(i,j)) * ISS%area_shelf_h(i,j) endif if (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then @@ -1442,7 +1433,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call get_param(param_file, mdl, "UTIDE", utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & units="m s-1", default=0.0) - CS%utide = utide + CS%utide(:,:) = utide endif call EOS_init(param_file, CS%eqn_of_state) @@ -1546,15 +1537,6 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call ice_shelf_state_init(CS%ISS, CS%grid) ISS => CS%ISS - allocate( CS%t_flux(isd:ied,jsd:jed) ) ; CS%t_flux(:,:) = 0.0 - allocate( CS%lprec(isd:ied,jsd:jed) ) ; CS%lprec(:,:) = 0.0 - allocate( CS%salt_flux(isd:ied,jsd:jed) ) ; CS%salt_flux(:,:) = 0.0 - - allocate( CS%tflux_shelf(isd:ied,jsd:jed) ) ; CS%tflux_shelf(:,:) = 0.0 - allocate( CS%tfreeze(isd:ied,jsd:jed) ) ; CS%tfreeze(:,:) = 0.0 - allocate( CS%exch_vel_s(isd:ied,jsd:jed) ) ; CS%exch_vel_s(:,:) = 0.0 - allocate( CS%exch_vel_t(isd:ied,jsd:jed) ) ; CS%exch_vel_t(:,:) = 0.0 - ! OVS vertically integrated Temperature allocate( CS%t_shelf(isd:ied,jsd:jed) ) ; CS%t_shelf(:,:) = -10.0 allocate( CS%t_boundary_values(isd:ied,jsd:jed) ) ; CS%t_boundary_values(:,:) = -15.0 @@ -1851,7 +1833,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! call init_boundary_values(CS, G, time, ISS%hmask, CS%input_flux, CS%input_thickness, new_sim) if (.not. CS%isthermo) then - CS%lprec(:,:) = 0.0 + ISS%water_flux(:,:) = 0.0 endif @@ -2085,7 +2067,7 @@ subroutine initialize_diagnostic_fields(CS, ISS, G, Time) integer :: i, j, iters, isd, ied, jsd, jed real :: rhoi, rhow, OD type(time_type) :: dummy_time - real,dimension(:,:),pointer :: OD_av, float_frac + real,dimension(:,:),pointer :: OD_av => NULL(), float_frac => NULL() rhoi = CS%density_ice rhow = CS%density_ocean_avg @@ -2263,8 +2245,8 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, melt_rate, Time) end subroutine ice_shelf_advect subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - type(ice_shelf_state), pointer :: ISS !< A structure with elements that describe + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), pointer :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, dimension(SZDIB_(G),SZDJB_(G)), & @@ -2561,7 +2543,7 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, integer, intent(out) :: conv_flag, iters type(time_type) :: time real, pointer, dimension(:,:,:,:) :: Phi - real, dimension(:,:,:,:,:,:),pointer :: Phisub + real, dimension(:,:,:,:,:,:), pointer :: Phisub ! one linear solve (nonlinear iteration) of the solution for velocity @@ -4979,13 +4961,6 @@ subroutine ice_shelf_end(CS) call ice_shelf_state_end(CS%ISS) - deallocate(CS%t_flux) ; deallocate(CS%lprec) - deallocate(CS%salt_flux) - - deallocate(CS%tflux_shelf) ; deallocate(CS%tfreeze) - deallocate(CS%exch_vel_t) ; deallocate(CS%exch_vel_s) - - if (CS%shelf_mass_is_dynamic .and. .not.CS%override_shelf_movement) then deallocate(CS%u_shelf) ; deallocate(CS%v_shelf) !!! OVS !!! @@ -5177,7 +5152,7 @@ subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) write (stepnum,'(I4)') CS%velocity_update_sub_counter - call ice_shelf_advect(CS, ISS, G, time_step_int, CS%lprec, Time) + call ice_shelf_advect(CS, ISS, G, time_step_int, ISS%water_flux, Time) if (mpp_pe() == 7) then call savearray2 ("hmask",ISS%hmask,CS%write_output_to_file) @@ -5198,7 +5173,7 @@ subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) endif !!! OVS!!! - call ice_shelf_temp(CS, ISS, G, time_step_int, CS%lprec, Time) + call ice_shelf_temp(CS, ISS, G, time_step_int, ISS%water_flux, Time) call enable_averaging(time_step,Time,CS%diag) if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, ISS%area_shelf_h, CS%diag) @@ -5276,7 +5251,7 @@ subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) real, dimension(SZDI_(G),SZDJ_(G),4) :: flux_enter integer :: isd, ied, jsd, jed, i, j, isc, iec, jsc, jec real :: rho, spy, t_bd, Tsurf, adot - real, dimension(:,:), pointer :: hmask, Tbot + real, dimension(:,:), pointer :: hmask => NULL() character(len=2) :: procnum hmask => ISS%hmask @@ -5284,7 +5259,6 @@ subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) spy = 365 * 86400 ! seconds per year; is there a global constant for this? No - it is dependent upon a calendar. adot = 0.1/spy ! for now adot and Tsurf are defined here adot=surf acc 0.1m/yr, Tsurf=-20oC, vary them later - Tbot =>CS%Tfreeze Tsurf = -20.0 isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -5353,8 +5327,8 @@ subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) do i=isc,iec if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2)) then if (ISS%h_shelf(i,j) > 0.0) then -! CS%t_shelf(i,j) = CS%t_shelf(i,j) + time_step*(adot*Tsurf -melt_rate(i,j)*Tbot(i,j))/ISS%h_shelf(i,j) - CS%t_shelf(i,j) = CS%t_shelf(i,j) + time_step*(adot*Tsurf -3/spy*Tbot(i,j))/ISS%h_shelf(i,j) +! CS%t_shelf(i,j) = CS%t_shelf(i,j) + time_step*(adot*Tsurf -melt_rate(i,j)*ISS%tfreeze(i,j))/ISS%h_shelf(i,j) + CS%t_shelf(i,j) = CS%t_shelf(i,j) + time_step*(adot*Tsurf -3/spy*ISS%tfreeze(i,j))/ISS%h_shelf(i,j) else ! the ice is about to melt away ! in this case set thickness, area, and mask to zero From 1e8e505ab3631b23186ec2b3dc21dd524c362f3d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 21 May 2018 05:45:13 -0400 Subject: [PATCH 0278/1072] +Reduce pointer use in MOM_ice_shelf Replaced the excessive use of pointers and allocatable arrays in MOM_ice_shelf.F90 with automatically allocated arrays using information from the grid type to set the array extents. Because pointers are not being used, many of the arguments to the internal subroutines have been changed from pointers to simple arguments with an intent, while other arguments have been added to explicitly pass the arrays being worked on in preparation for splitting out the ice shelf dynamics. The remaining pointers are nullified where they are declared. All answers are bitwise identical. --- src/ice_shelf/MOM_ice_shelf.F90 | 866 ++++++++++++++------------------ 1 file changed, 387 insertions(+), 479 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 128e850e31..244b2d1e84 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -337,8 +337,10 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) exch_vel_t, & !< Sub-shelf thermal exchange velocity, in m/s exch_vel_s !< Sub-shelf salt exchange velocity, in m/s - real, dimension(:,:), allocatable :: mass_flux !< total mass flux of freshwater across - real, dimension(:,:), allocatable :: haline_driving !< (SSS - S_boundary) ice-ocean + real, dimension(SZDI_(CS%grid),SZDJ_(CS%grid)) :: & + mass_flux !< total mass flux of freshwater across + real, dimension(SZDI_(CS%grid),SZDJ_(CS%grid)) :: & + haline_driving !< (SSS - S_boundary) ice-ocean !! interface, positive for melting and negative for freezing. !! This is computed as part of the ISOMIP diagnostics. real, parameter :: VK = 0.40 !< Von Karman's constant - dimensionless @@ -351,8 +353,8 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) real :: PR, SC !< The Prandtl number and Schmidt number, nondim. ! 3 equations formulation variables - real, dimension(:,:), allocatable :: Sbdry !< Salinities in the ocean at the interface - !! with the ice shelf, in PSU. + real, dimension(SZDI_(CS%grid),SZDJ_(CS%grid)) :: & + Sbdry !< Salinities in the ocean at the interface with the ice shelf, in PSU. real :: Sbdry_it real :: Sbdry1, Sbdry2, S_a, S_b, S_c ! use to find salt roots real :: dS_it !< The interface salinity change during an iteration, in PSU. @@ -421,8 +423,8 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) ISS%salt_flux(:,:) = 0.0; ISS%tflux_ocn(:,:) = 0.0 ISS%tfreeze(:,:) = 0.0 ! define Sbdry to avoid Run-Time Check Failure, when melt is not computed. - allocate( haline_driving(G%ied,G%jed) ); haline_driving(:,:) = 0.0 - allocate( Sbdry(G%ied,G%jed) ); Sbdry(:,:) = state%sss(:,:) + haline_driving(:,:) = 0.0 + Sbdry(:,:) = state%sss(:,:) !update time CS%Time = Time @@ -748,8 +750,8 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) enddo ! j-loop ! mass flux (kg/s), part of ISOMIP diags. - allocate( mass_flux(G%ied,G%jed) ); mass_flux(:,:) = 0.0 - mass_flux = (ISS%water_flux) * ISS%area_shelf_h + mass_flux(:,:) = 0.0 + mass_flux(:,:) = ISS%water_flux(:,:) * ISS%area_shelf_h(:,:) if (CS%shelf_mass_is_dynamic) then call cpu_clock_begin(id_clock_pass) @@ -782,7 +784,7 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) ! note time_step is [s] and lprec is [kg / m^2 / s] - call ice_shelf_advect(CS, ISS, G, time_step, ISS%water_flux, Time) + call ice_shelf_advect(CS, ISS, G, time_step, Time) CS%velocity_update_sub_counter = CS%velocity_update_sub_counter+1 @@ -907,7 +909,7 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1. real :: press_ice ! The pressure of the ice shelf per unit area of ocean (not ice) in Pa. - logical :: find_area ! If true find the shelf areas at u & v points. +logical :: find_area ! If true find the shelf areas at u & v points. type(ice_shelf_state), pointer :: ISS => NULL() ! A structure with elements that describe ! the ice-shelf state @@ -936,7 +938,7 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) endif - !### Consider working over a smaller array range. + !### Consider working over a smaller array range. do j=jsd,jed ; do i=isd,ied press_ice = (ISS%area_shelf_h(i,j) * G%IareaT(i,j)) * (CS%g_Earth * ISS%mass_shelf(i,j)) if (associated(forces%p_surf)) then @@ -956,7 +958,7 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) kv_rho_ice = CS%kv_ice / CS%density_ice do j=js,je ; do I=is-1,ie if (.not.forces%accumulate_rigidity) forces%rigidity_ice_u(I,j) = 0.0 - forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + & + forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + & kv_rho_ice * min(ISS%mass_shelf(i,j), ISS%mass_shelf(i+1,j)) enddo ; enddo do J=js-1,je ; do i=is,ie @@ -996,14 +998,14 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) real :: sponge_area !< total area of sponge region real :: t0 !< The previous time (Time-dt) in sec. type(time_type) :: Time0!< The previous time (Time-dt) - real, dimension(:,:), allocatable, target :: last_mass_shelf !< Ice shelf mass - ! at at previous time (Time-dt), in kg/m^2 - real, dimension(:,:), allocatable, target :: last_h_shelf !< Ice shelf thickness - ! at at previous time (Time-dt), in m - real, dimension(:,:), allocatable, target :: last_hmask !< Ice shelf mask - ! at at previous time (Time-dt) - real, dimension(:,:), allocatable, target :: last_area_shelf_h !< Ice shelf area - ! at at previous time (Time-dt), m^2 + real, dimension(SZDI_(G),SZDJ_(G)) :: last_mass_shelf !< Ice shelf mass + !! at at previous time (Time-dt), in kg/m^2 + real, dimension(SZDI_(G),SZDJ_(G)) :: last_h_shelf !< Ice shelf thickness + !! at at previous time (Time-dt), in m + real, dimension(SZDI_(G),SZDJ_(G)) :: last_hmask !< Ice shelf mask + !! at at previous time (Time-dt) + real, dimension(SZDI_(G),SZDJ_(G)) :: last_area_shelf_h !< Ice shelf area + !! at at previous time (Time-dt), m^2 type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe !! the ice-shelf state @@ -1117,11 +1119,7 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) ! just compute changes in mass after first time step if (t0>0.0) then Time0 = real_to_time_type(t0) - allocate(last_mass_shelf(isd:ied,jsd:jed)) - allocate(last_h_shelf(isd:ied,jsd:jed)) - allocate(last_area_shelf_h(isd:ied,jsd:jed)) - allocate(last_hmask(isd:ied,jsd:jed)) - last_hmask(:,:) = ISS%hmask(:,:); last_area_shelf_h(:,:) = ISS%area_shelf_h(:,:) + last_hmask(:,:) = ISS%hmask(:,:) ; last_area_shelf_h(:,:) = ISS%area_shelf_h(:,:) call time_interp_external(CS%id_read_mass, Time0, last_mass_shelf) last_h_shelf = last_mass_shelf/CS%density_ice @@ -1772,7 +1770,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call cpu_clock_begin(id_clock_pass) call pass_var(G%bathyT, G%domain) call pass_var(ISS%hmask, G%domain) - call update_velocity_masks(CS, G, ISS%hmask) + call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) call cpu_clock_end(id_clock_pass) endif @@ -2058,8 +2056,8 @@ subroutine update_shelf_mass(G, CS, ISS, Time) end subroutine update_shelf_mass subroutine initialize_diagnostic_fields(CS, ISS, G, Time) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - type(ice_shelf_state), pointer :: ISS !< A structure with elements that describe + type(ice_shelf_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. type(time_type), intent(in) :: Time @@ -2067,13 +2065,10 @@ subroutine initialize_diagnostic_fields(CS, ISS, G, Time) integer :: i, j, iters, isd, ied, jsd, jed real :: rhoi, rhow, OD type(time_type) :: dummy_time - real,dimension(:,:),pointer :: OD_av => NULL(), float_frac => NULL() rhoi = CS%density_ice rhow = CS%density_ocean_avg dummy_time = set_time (0,0) - OD_av => CS%OD_av - float_frac => CS%float_frac isd=G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed do j=jsd,jed @@ -2081,11 +2076,11 @@ subroutine initialize_diagnostic_fields(CS, ISS, G, Time) OD = G%bathyT(i,j) - rhoi/rhow * ISS%h_shelf(i,j) if (OD >= 0) then ! ice thickness does not take up whole ocean column -> floating - OD_av(i,j) = OD - float_frac(i,j) = 0. + CS%OD_av(i,j) = OD + CS%float_frac(i,j) = 0. else - OD_av(i,j) = 0. - float_frac(i,j) = 1. + CS%OD_av(i,j) = 0. + CS%float_frac(i,j) = 1. endif enddo enddo @@ -2130,17 +2125,15 @@ subroutine ice_shelf_save_restart(CS, Time, directory, time_stamped, filename_su end subroutine ice_shelf_save_restart -subroutine ice_shelf_advect(CS, ISS, G, time_step, melt_rate, Time) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - type(ice_shelf_state), pointer :: ISS !< A structure with elements that describe +subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) + type(ice_shelf_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step - real, dimension(:,:), pointer :: melt_rate + real, intent(in) :: time_step !< time step in sec type(time_type), intent(in) :: Time ! time_step: time step in sec -! melt_rate: basal melt rate in kg/m^2/s ! 3/8/11 DNG ! Arguments: @@ -2240,13 +2233,13 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, melt_rate, Time) !call change_thickness_using_melt(CS, ISS, G,time_step, fluxes) - call update_velocity_masks(CS, G, ISS%hmask) + call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) end subroutine ice_shelf_advect subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - type(ice_shelf_state), pointer :: ISS !< A structure with elements that describe + type(ice_shelf_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, dimension(SZDIB_(G),SZDJB_(G)), & @@ -2254,14 +2247,15 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) integer, intent(out) :: iters type(time_type), intent(in) :: time - real, dimension(:,:), pointer :: TAUDX, TAUDY, u_prev_iterate, v_prev_iterate, & + real, dimension(SZDIB_(G),SZDJB_(G)) :: TAUDX, TAUDY, u_prev_iterate, v_prev_iterate, & u_bdry_cont, v_bdry_cont, Au, Av, err_u, err_v, & - u_last, v_last, float_cond, H_node - integer :: conv_flag, i, j, k,l, iter, & - isdq, iedq, jsdq, jedq, isd, ied, jsd, jed, isumstart, jsumstart, nodefloat, nsub + u_last, v_last, H_node + real, dimension(SZDI_(G),SZDJ_(G)) :: float_cond + integer :: conv_flag, i, j, k,l, iter + integer :: isdq, iedq, jsdq, jedq, isd, ied, jsd, jed, isumstart, jsumstart, nodefloat, nsub real :: err_max, err_tempu, err_tempv, err_init, area, max_vel, tempu, tempv, rhoi, rhow - real, pointer, dimension(:,:,:,:) :: Phi - real, pointer, dimension(:,:,:,:,:,:) :: Phisub + real, pointer, dimension(:,:,:,:) :: Phi => NULL() + real, pointer, dimension(:,:,:,:,:,:) :: Phisub => NULL() real, dimension(8,4) :: Phi_temp real, dimension(2,2) :: X,Y character(2) :: iternum @@ -2274,23 +2268,14 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed rhoi = CS%density_ice rhow = CS%density_ocean_avg - allocate(TAUDX(isdq:iedq,jsdq:jedq) ) ; TAUDX(:,:)=0 - allocate(TAUDY(isdq:iedq,jsdq:jedq) ) ; TAUDY(:,:)=0 - allocate(u_prev_iterate(isdq:iedq,jsdq:jedq) ) - allocate(v_prev_iterate(isdq:iedq,jsdq:jedq) ) - allocate(u_bdry_cont(isdq:iedq,jsdq:jedq) ) ; u_bdry_cont(:,:)=0 - allocate(v_bdry_cont(isdq:iedq,jsdq:jedq) ) ; v_bdry_cont(:,:)=0 - allocate(Au(isdq:iedq,jsdq:jedq) ) ; Au(:,:)=0 - allocate(Av(isdq:iedq,jsdq:jedq) ) ; Av(:,:)=0 - allocate(err_u(isdq:iedq,jsdq:jedq) ) - allocate(err_v(isdq:iedq,jsdq:jedq) ) - allocate(u_last(isdq:iedq,jsdq:jedq) ) - allocate(v_last(isdq:iedq,jsdq:jedq) ) + + TAUDX(:,:) = 0.0 ; TAUDY(:,:) = 0.0 + u_bdry_cont(:,:) = 0.0 ; v_bdry_cont(:,:) = 0.0 + Au(:,:) = 0.0 ; Av(:,:) = 0.0 ! need to make these conditional on GL interpolation - allocate(float_cond (G%isd:G%ied,G%jsd:G%jed)) ; float_cond(:,:)=0 - allocate(H_node (G%isdB:G%iedB,G%jsdB:G%jedB)) ; H_node(:,:)=0 - allocate(Phisub (nsub,nsub,2,2,2,2)) ; Phisub = 0.0 + float_cond(:,:) = 0.0 ; H_node(:,:)=0 + allocate(Phisub (nsub,nsub,2,2,2,2)) ; Phisub = 0.0 isumstart = G%isc ! Include the edge if tile is at the western bdry; Should add a test to avoid this if reentrant. @@ -2312,7 +2297,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) if (CS%GL_regularize) then - call interpolate_H_to_B(CS, G, ISS%h_shelf, ISS%hmask, H_node) + call interpolate_H_to_B(G, ISS%h_shelf, ISS%hmask, H_node) call savearray2 ("H_node",H_node,CS%write_output_to_file) do j=G%jsc,G%jec @@ -2349,7 +2334,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) v_prev_iterate(:,:) = v(:,:) ! must prepare phi - allocate(Phi(isd:ied,jsd:jed,1:8,1:4)) ; Phi(:,:,:,:)=0 + allocate(Phi(isd:ied,jsd:jed,1:8,1:4)) ; Phi(:,:,:,:) = 0.0 do j=jsd,jed ; do i=isd,ied if (((i > isd) .and. (j > jsd))) then @@ -2377,7 +2362,8 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) CS%taub_beta_eff_bilinear(i,j) = CS%taub_beta_eff_bilinear(i,j) * CS%float_frac(i,j) enddo ; enddo - call apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, float_cond, & + call apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, CS%ice_visc_bilinear, & + CS%taub_beta_eff_bilinear, float_cond, & rhoi/rhow, u_bdry_cont, v_bdry_cont) Au(:,:) = 0.0 ; Av(:,:) = 0.0 @@ -2440,8 +2426,9 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) u_bdry_cont(:,:) = 0 ; v_bdry_cont(:,:) = 0 - call apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, float_cond, & - rhoi/rhow, u_bdry_cont, v_bdry_cont) + call apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, CS%ice_visc_bilinear, & + CS%taub_beta_eff_bilinear, float_cond, & + rhoi/rhow, u_bdry_cont, v_bdry_cont) Au(:,:) = 0 ; Av(:,:) = 0 @@ -2514,36 +2501,23 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) !write (procnum,'(I1)') mpp_pe() !write (numproc,'(I1)') mpp_npes() - deallocate(TAUDX) - deallocate(TAUDY) - deallocate(u_prev_iterate) - deallocate(v_prev_iterate) - deallocate(u_bdry_cont) - deallocate(v_bdry_cont) - deallocate(Au) - deallocate(Av) - deallocate(err_u) - deallocate(err_v) - deallocate(u_last) - deallocate(v_last) - deallocate(H_node) - deallocate(float_cond) + deallocate(Phi) deallocate(Phisub) end subroutine ice_shelf_solve_outer subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, & hmask, conv_flag, iters, time, Phi, Phisub) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u, v - real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: taudx, taudy, H_node - real, dimension(:,:),intent(in) :: float_cond - real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: hmask + type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u, v + real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: taudx, taudy, H_node + real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: float_cond + real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: hmask integer, intent(out) :: conv_flag, iters - type(time_type) :: time - real, pointer, dimension(:,:,:,:) :: Phi - real, dimension(:,:,:,:,:,:), pointer :: Phisub + type(time_type), intent(in) :: time + real, dimension(SZDI_(G),SZDJ_(G),8,4), intent(in) :: Phi + real, dimension(:,:,:,:,:,:), intent(in) :: Phisub ! one linear solve (nonlinear iteration) of the solution for velocity @@ -2554,10 +2528,7 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, ! assumed - u, v, taud, visc, beta_eff are valid on the halo - - real, dimension(:,:), pointer :: umask, vmask, u_bdry, v_bdry, & - visc, visc_lo, beta, beta_lo - real, dimension(LBOUND(u,1):UBOUND(u,1),LBOUND(u,2):UBOUND(u,2)) :: & + real, dimension(SZDIB_(G),SZDJB_(G)) :: & Ru, Rv, Zu, Zv, DIAGu, DIAGv, RHSu, RHSv, & ubd, vbd, Au, Av, Du, Dv, & Zu_old, Zv_old, Ru_old, Rv_old, & @@ -2572,11 +2543,6 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, real, dimension(8,4) :: Phi_temp real, dimension(2,2) :: X,Y - umask => CS%umask - vmask => CS%vmask - u_bdry => CS%u_boundary_values - v_bdry => CS%v_boundary_values - isdq = G%isdB ; iedq = G%iedB ; jsdq = G%jsdB ; jedq = G%jedB iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB ny_halo = G%domain%njhalo ; nx_halo = G%domain%nihalo @@ -2596,11 +2562,9 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, ! Include the edge if tile is at the southern bdry; Should add a test to avoid this if reentrant. if (G%jsc+G%jdg_offset==G%jsg) jsumstart = G%jscB - visc => CS%ice_visc_bilinear - beta => CS%taub_beta_eff_bilinear - - call apply_boundary_values_bilinear(CS, CS%ISS, G, time, Phisub, H_node, float_cond, & - CS%density_ice/CS%density_ocean_avg, ubd, vbd) + call apply_boundary_values_bilinear(CS, CS%ISS, G, time, Phisub, H_node, CS%ice_visc_bilinear, & + CS%taub_beta_eff_bilinear, float_cond, & + CS%density_ice/CS%density_ocean_avg, ubd, vbd) RHSu(:,:) = taudx(:,:) - ubd(:,:) RHSv(:,:) = taudy(:,:) - vbd(:,:) @@ -2608,15 +2572,16 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, call pass_vector(RHSu, RHSv, G%domain, TO_ALL, BGRID_NE) - call matrix_diagonal_bilinear(CS, G, float_cond, H_node, hmask, & + call matrix_diagonal_bilinear(CS, G, float_cond, H_node, CS%ice_visc_bilinear, & + CS%taub_beta_eff_bilinear, hmask, & CS%density_ice/CS%density_ocean_avg, Phisub, DIAGu, DIAGv) ! DIAGu(:,:) = 1 ; DIAGv(:,:) = 1 call pass_vector(DIAGu, DIAGv, G%domain, TO_ALL, BGRID_NE) - call CG_action_bilinear(Au, Av, u, v, Phi, Phisub, umask, vmask, hmask, & - H_node, visc, float_cond, G%bathyT, beta, G%areaT, G, isc-1, iec+1, jsc-1, & - jec+1, CS%density_ice/CS%density_ocean_avg) + call CG_action_bilinear(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, hmask, & + H_node, CS%ice_visc_bilinear, float_cond, G%bathyT, CS%taub_beta_eff_bilinear, & + G%areaT, G, isc-1, iec+1, jsc-1, jec+1, CS%density_ice/CS%density_ocean_avg) call pass_vector(Au, Av, G%domain, TO_ALL, BGRID_NE) @@ -2626,8 +2591,8 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, do j=jsumstart,jecq do i=isumstart,iecq - if (umask(i,j) == 1) dot_p1 = dot_p1 + Ru(i,j)**2 - if (vmask(i,j) == 1) dot_p1 = dot_p1 + Rv(i,j)**2 + if (CS%umask(i,j) == 1) dot_p1 = dot_p1 + Ru(i,j)**2 + if (CS%vmask(i,j) == 1) dot_p1 = dot_p1 + Rv(i,j)**2 enddo enddo @@ -2639,8 +2604,8 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, do j=jsumstart,jecq do i=isumstart,iecq - if (umask(i,j) == 1) sum_vec(i,j) = Ru(i,j)**2 - if (vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + Rv(i,j)**2 + if (CS%umask(i,j) == 1) sum_vec(i,j) = Ru(i,j)**2 + if (CS%vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + Rv(i,j)**2 enddo enddo @@ -2653,8 +2618,8 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, do j=jsdq,jedq do i=isdq,iedq - if (umask(i,j) == 1) Zu(i,j) = Ru(i,j) / DIAGu(i,j) - if (vmask(i,j) == 1) Zv(i,j) = Rv(i,j) / DIAGv(i,j) + if (CS%umask(i,j) == 1) Zu(i,j) = Ru(i,j) / DIAGu(i,j) + if (CS%vmask(i,j) == 1) Zv(i,j) = Rv(i,j) / DIAGv(i,j) enddo enddo @@ -2685,9 +2650,9 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, Au(:,:) = 0 ; Av(:,:) = 0 - call CG_action_bilinear(Au, Av, Du, Dv, Phi, Phisub, umask, vmask, hmask, & - H_node, visc, float_cond, G%bathyT, beta, G%areaT, G, is, ie, js, & - je, CS%density_ice/CS%density_ocean_avg) + call CG_action_bilinear(Au, Av, Du, Dv, Phi, Phisub, CS%umask, CS%vmask, hmask, & + H_node, CS%ice_visc_bilinear, float_cond, G%bathyT, CS%taub_beta_eff_bilinear, & + G%areaT, G, is, ie, js, je, CS%density_ice/CS%density_ocean_avg) ! Au, Av valid region moves in by 1 @@ -2698,11 +2663,11 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, dot_p1 = 0 ; dot_p2 = 0 do j=jsumstart,jecq do i=isumstart,iecq - if (umask(i,j) == 1) then + if (CS%umask(i,j) == 1) then dot_p1 = dot_p1 + Zu(i,j)*Ru(i,j) dot_p2 = dot_p2 + Du(i,j)*Au(i,j) endif - if (vmask(i,j) == 1) then + if (CS%vmask(i,j) == 1) then dot_p1 = dot_p1 + Zv(i,j)*Rv(i,j) dot_p2 = dot_p2 + Dv(i,j)*Av(i,j) endif @@ -2715,12 +2680,12 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, do j=jscq,jecq do i=iscq,iecq - if (umask(i,j) == 1) sum_vec(i,j) = Zu(i,j) * Ru(i,j) - if (vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + & + if (CS%umask(i,j) == 1) sum_vec(i,j) = Zu(i,j) * Ru(i,j) + if (CS%vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + & Zv(i,j) * Rv(i,j) - if (umask(i,j) == 1) sum_vec_2(i,j) = Du(i,j) * Au(i,j) - if (vmask(i,j) == 1) sum_vec_2(i,j) = sum_vec_2(i,j) + & + if (CS%umask(i,j) == 1) sum_vec_2(i,j) = Du(i,j) * Au(i,j) + if (CS%vmask(i,j) == 1) sum_vec_2(i,j) = sum_vec_2(i,j) + & Dv(i,j) * Av(i,j) enddo enddo @@ -2742,17 +2707,17 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, do j=jsd,jed do i=isd,ied - if (umask(i,j) == 1) u(i,j) = u(i,j) + alpha_k * Du(i,j) - if (vmask(i,j) == 1) v(i,j) = v(i,j) + alpha_k * Dv(i,j) + if (CS%umask(i,j) == 1) u(i,j) = u(i,j) + alpha_k * Du(i,j) + if (CS%vmask(i,j) == 1) v(i,j) = v(i,j) + alpha_k * Dv(i,j) enddo enddo do j=jsd,jed do i=isd,ied - if (umask(i,j) == 1) then + if (CS%umask(i,j) == 1) then Ru_old(i,j) = Ru(i,j) ; Zu_old(i,j) = Zu(i,j) endif - if (vmask(i,j) == 1) then + if (CS%vmask(i,j) == 1) then Rv_old(i,j) = Rv(i,j) ; Zv_old(i,j) = Zv(i,j) endif enddo @@ -2763,18 +2728,18 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, do j=jsd,jed do i=isd,ied - if (umask(i,j) == 1) Ru(i,j) = Ru(i,j) - alpha_k * Au(i,j) - if (vmask(i,j) == 1) Rv(i,j) = Rv(i,j) - alpha_k * Av(i,j) + if (CS%umask(i,j) == 1) Ru(i,j) = Ru(i,j) - alpha_k * Au(i,j) + if (CS%vmask(i,j) == 1) Rv(i,j) = Rv(i,j) - alpha_k * Av(i,j) enddo enddo do j=jsdq,jedq do i=isdq,iedq - if (umask(i,j) == 1) then + if (CS%umask(i,j) == 1) then Zu(i,j) = Ru(i,j) / DIAGu(i,j) endif - if (vmask(i,j) == 1) then + if (CS%vmask(i,j) == 1) then Zv(i,j) = Rv(i,j) / DIAGv(i,j) endif enddo @@ -2788,11 +2753,11 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, dot_p1 = 0 ; dot_p2 = 0 do j=jsumstart,jecq do i=isumstart,iecq - if (umask(i,j) == 1) then + if (CS%umask(i,j) == 1) then dot_p1 = dot_p1 + Zu(i,j)*Ru(i,j) dot_p2 = dot_p2 + Zu_old(i,j)*Ru_old(i,j) endif - if (vmask(i,j) == 1) then + if (CS%vmask(i,j) == 1) then dot_p1 = dot_p1 + Zv(i,j)*Rv(i,j) dot_p2 = dot_p2 + Zv_old(i,j)*Rv_old(i,j) endif @@ -2807,12 +2772,12 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, do j=jsumstart,jecq do i=isumstart,iecq - if (umask(i,j) == 1) sum_vec(i,j) = Zu(i,j) * Ru(i,j) - if (vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + & + if (CS%umask(i,j) == 1) sum_vec(i,j) = Zu(i,j) * Ru(i,j) + if (CS%vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + & Zv(i,j) * Rv(i,j) - if (umask(i,j) == 1) sum_vec_2(i,j) = Zu_old(i,j) * Ru_old(i,j) - if (vmask(i,j) == 1) sum_vec_2(i,j) = sum_vec_2(i,j) + & + if (CS%umask(i,j) == 1) sum_vec_2(i,j) = Zu_old(i,j) * Ru_old(i,j) + if (CS%vmask(i,j) == 1) sum_vec_2(i,j) = sum_vec_2(i,j) + & Zv_old(i,j) * Rv_old(i,j) enddo enddo @@ -2834,8 +2799,8 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, do j=jsd,jed do i=isd,ied - if (umask(i,j) == 1) Du(i,j) = Zu(i,j) + beta_k * Du(i,j) - if (vmask(i,j) == 1) Dv(i,j) = Zv(i,j) + beta_k * Dv(i,j) + if (CS%umask(i,j) == 1) Du(i,j) = Zu(i,j) + beta_k * Du(i,j) + if (CS%vmask(i,j) == 1) Dv(i,j) = Zv(i,j) + beta_k * Dv(i,j) enddo enddo @@ -2847,10 +2812,10 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, do j=jsumstart,jecq do i=isumstart,iecq - if (umask(i,j) == 1) then + if (CS%umask(i,j) == 1) then dot_p1 = dot_p1 + Ru(i,j)**2 endif - if (vmask(i,j) == 1) then + if (CS%vmask(i,j) == 1) then dot_p1 = dot_p1 + Rv(i,j)**2 endif enddo @@ -2863,8 +2828,8 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, do j=jsumstart,jecq do i=isumstart,iecq - if (umask(i,j) == 1) sum_vec(i,j) = Ru(i,j)**2 - if (vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + Rv(i,j)**2 + if (CS%umask(i,j) == 1) sum_vec(i,j) = Ru(i,j)**2 + if (CS%vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + Rv(i,j)**2 enddo enddo @@ -2902,15 +2867,15 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, do j=jsdq,jedq do i=isdq,iedq - if (umask(i,j) == 3) then - u(i,j) = u_bdry(i,j) - elseif (umask(i,j) == 0) then + if (CS%umask(i,j) == 3) then + u(i,j) = CS%u_boundary_values(i,j) + elseif (CS%umask(i,j) == 0) then u(i,j) = 0 endif - if (vmask(i,j) == 3) then - v(i,j) = v_bdry(i,j) - elseif (vmask(i,j) == 0) then + if (CS%vmask(i,j) == 3) then + v(i,j) = CS%v_boundary_values(i,j) + elseif (CS%vmask(i,j) == 0) then v(i,j) = 0 endif enddo @@ -2925,13 +2890,13 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, end subroutine ice_shelf_solve_inner subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_uflux, flux_enter) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h0 real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_uflux - real, dimension(:,:,:), intent(inout) :: flux_enter + real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells @@ -2955,14 +2920,12 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl integer :: i_off, j_off logical :: at_east_bdry, at_west_bdry, one_off_west_bdry, one_off_east_bdry real, dimension(-2:2) :: stencil - real, dimension(:,:), pointer :: u_face_mask, u_flux_boundary_values real :: u_face, & ! positive if out flux_diff_cell, phi, dxh, dyh, dxdyh character (len=1) :: debug_str, procnum - u_face_mask => CS%u_face_mask - u_flux_boundary_values => CS%u_flux_boundary_values - is = G%isc-2 ; ie = G%iec+2 ; js = G%jsc ; je = G%jec ; isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + is = G%isc-2 ; ie = G%iec+2 ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed i_off = G%idg_offset ; j_off = G%jdg_offset do j=jsd+1,jed-1 @@ -3000,9 +2963,9 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl ! 1ST DO LEFT FACE - if (u_face_mask(i-1,j) == 4.) then + if (CS%u_face_mask(i-1,j) == 4.) then - flux_diff_cell = flux_diff_cell + dyh * time_step * u_flux_boundary_values(i-1,j) / dxdyh + flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_flux_boundary_values(i-1,j) / dxdyh else @@ -3055,9 +3018,9 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl ! get u-velocity at center of right face - if (u_face_mask(i+1,j) == 4.) then + if (CS%u_face_mask(i+1,j) == 4.) then - flux_diff_cell = flux_diff_cell + dyh * time_step * u_flux_boundary_values(i+1,j) / dxdyh + flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_flux_boundary_values(i+1,j) / dxdyh else @@ -3115,15 +3078,15 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) flux_enter(i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_boundary_values(i-1,j) - elseif (u_face_mask(i-1,j) == 4.) then - flux_enter(i,j,1) = G%dyT(i,j) * time_step * u_flux_boundary_values(i-1,j) + elseif (CS%u_face_mask(i-1,j) == 4.) then + flux_enter(i,j,1) = G%dyT(i,j) * time_step * CS%u_flux_boundary_values(i-1,j) endif if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_boundary_values(i+1,j) - elseif (u_face_mask(i+1,j) == 4.) then - flux_enter(i,j,2) = G%dyT(i,j) * time_step * u_flux_boundary_values(i+1,j) + elseif (CS%u_face_mask(i+1,j) == 4.) then + flux_enter(i,j,2) = G%dyT(i,j) * time_step * CS%u_flux_boundary_values(i+1,j) endif if ((i == is) .AND. (hmask(i,j) == 0) .AND. (hmask(i-1,j) == 1)) then @@ -3156,13 +3119,13 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl end subroutine ice_shelf_advect_thickness_x subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, h_after_vflux, flux_enter) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask - real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h_after_uflux - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_vflux - real, dimension(:,:,:), intent(inout) :: flux_enter + real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h_after_uflux + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_vflux + real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells @@ -3186,14 +3149,10 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, integer :: i_off, j_off logical :: at_north_bdry, at_south_bdry, one_off_west_bdry, one_off_east_bdry real, dimension(-2:2) :: stencil - real, dimension(:,:), pointer :: v_face_mask, v_flux_boundary_values real :: v_face, & ! positive if out flux_diff_cell, phi, dxh, dyh, dxdyh character(len=1) :: debug_str, procnum - - v_face_mask => CS%v_face_mask - v_flux_boundary_values => CS%v_flux_boundary_values is = G%isc ; ie = G%iec ; js = G%jsc-1 ; je = G%jec+1 ; isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed i_off = G%idg_offset ; j_off = G%jdg_offset @@ -3229,9 +3188,9 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, ! 1ST DO south FACE - if (v_face_mask(i,j-1) == 4.) then + if (CS%v_face_mask(i,j-1) == 4.) then - flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values(i,j-1) / dxdyh + flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_flux_boundary_values(i,j-1) / dxdyh else @@ -3279,9 +3238,9 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, ! NEXT DO north FACE - if (v_face_mask(i,j+1) == 4.) then + if (CS%v_face_mask(i,j+1) == 4.) then - flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values(i,j+1) / dxdyh + flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_flux_boundary_values(i,j+1) / dxdyh else @@ -3329,15 +3288,15 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then v_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i,j-1)) flux_enter(i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_boundary_values(i,j-1) - elseif (v_face_mask(i,j-1) == 4.) then - flux_enter(i,j,3) = G%dxT(i,j) * time_step * v_flux_boundary_values(i,j-1) + elseif (CS%v_face_mask(i,j-1) == 4.) then + flux_enter(i,j,3) = G%dxT(i,j) * time_step * CS%v_flux_boundary_values(i,j-1) endif if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then v_face = 0.5 * (CS%u_shelf(i-1,j) + CS%u_shelf(i,j)) flux_enter(i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_boundary_values(i,j+1) - elseif (v_face_mask(i,j+1) == 4.) then - flux_enter(i,j,4) = G%dxT(i,j) * time_step * v_flux_boundary_values(i,j+1) + elseif (CS%v_face_mask(i,j+1) == 4.) then + flux_enter(i,j,4) = G%dxT(i,j) * time_step * CS%v_flux_boundary_values(i,j+1) endif if ((j == js) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j-1) == 1)) then @@ -3363,11 +3322,11 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, end subroutine ice_shelf_advect_thickness_y subroutine shelf_advance_front(CS, ISS, G, flux_enter) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - type(ice_shelf_state), pointer :: ISS !< A structure with elements that describe + type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, dimension(:,:,:), intent(inout) :: flux_enter + real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter ! in this subroutine we go through the computational cells only and, if they are empty or partial cells, ! we find the reference thickness and update the shelf mass and partial area fraction and the hmask if necessary @@ -3399,18 +3358,12 @@ subroutine shelf_advance_front(CS, ISS, G, flux_enter) integer :: i, j, isc, iec, jsc, jec, n_flux, k, l, iter_count integer :: i_off, j_off integer :: iter_flag - real, dimension(:,:), pointer :: hmask, mass_shelf, area_shelf_h, u_face_mask, v_face_mask, h_shelf + real :: h_reference, dxh, dyh, dxdyh, rho, partial_vol, tot_flux integer, dimension(4) :: mapi, mapj, new_partial ! real, dimension(size(flux_enter,1),size(flux_enter,2),size(flux_enter,2)) :: flux_enter_replace - real, dimension(:,:,:), pointer :: flux_enter_replace => NULL() - - h_shelf => ISS%h_shelf - hmask => ISS%hmask - mass_shelf => ISS%mass_shelf - area_shelf_h => ISS%area_shelf_h - u_face_mask => CS%u_face_mask - v_face_mask => CS%v_face_mask + real, dimension(SZDI_(G),SZDJ_(G),4) :: flux_enter_replace + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec i_off = G%idg_offset ; j_off = G%jdg_offset rho = CS%density_ice @@ -3426,24 +3379,22 @@ subroutine shelf_advance_front(CS, ISS, G, flux_enter) if (iter_count > 0) then flux_enter(:,:,:) = flux_enter_replace(:,:,:) - flux_enter_replace(:,:,:) = 0.0 endif + flux_enter_replace(:,:,:) = 0.0 iter_count = iter_count + 1 ! if iter_count >= 3 then some halo updates need to be done... - - do j=jsc-1,jec+1 if (((j+j_off) <= G%domain%njglobal+G%domain%njhalo) .AND. & ((j+j_off) >= G%domain%njhalo+1)) then - do i=isc-1,iec+1 + do i=isc-1,iec+1 - if (((i+i_off) <= G%domain%niglobal+G%domain%nihalo) .AND. & - ((i+i_off) >= G%domain%nihalo+1)) then + if (((i+i_off) <= G%domain%niglobal+G%domain%nihalo) .AND. & + ((i+i_off) >= G%domain%nihalo+1)) then ! first get reference thickness by averaging over cells that are fluxing into this cell n_flux = 0 h_reference = 0.0 @@ -3452,7 +3403,7 @@ subroutine shelf_advance_front(CS, ISS, G, flux_enter) do k=1,2 if (flux_enter(i,j,k) > 0) then n_flux = n_flux + 1 - h_reference = h_reference + h_shelf(i+2*k-3,j) + h_reference = h_reference + ISS%h_shelf(i+2*k-3,j) tot_flux = tot_flux + flux_enter(i,j,k) flux_enter(i,j,k) = 0.0 endif @@ -3461,7 +3412,7 @@ subroutine shelf_advance_front(CS, ISS, G, flux_enter) do k=1,2 if (flux_enter(i,j,k+2) > 0) then n_flux = n_flux + 1 - h_reference = h_reference + h_shelf(i,j+2*k-3) + h_reference = h_reference + ISS%h_shelf(i,j+2*k-3) tot_flux = tot_flux + flux_enter(i,j,k+2) flux_enter(i,j,k+2) = 0.0 endif @@ -3470,25 +3421,21 @@ subroutine shelf_advance_front(CS, ISS, G, flux_enter) if (n_flux > 0) then dxdyh = G%areaT(i,j) h_reference = h_reference / real(n_flux) - partial_vol = h_shelf(i,j) * area_shelf_h(i,j) + tot_flux + partial_vol = ISS%h_shelf(i,j) * ISS%area_shelf_h(i,j) + tot_flux if ((partial_vol / dxdyh) == h_reference) then ! cell is exactly covered, no overflow - hmask(i,j) = 1 - h_shelf(i,j) = h_reference - area_shelf_h(i,j) = dxdyh + ISS%hmask(i,j) = 1 + ISS%h_shelf(i,j) = h_reference + ISS%area_shelf_h(i,j) = dxdyh elseif ((partial_vol / dxdyh) < h_reference) then - hmask(i,j) = 2 - ! mass_shelf(i,j) = partial_vol * rho - area_shelf_h(i,j) = partial_vol / h_reference - h_shelf(i,j) = h_reference + ISS%hmask(i,j) = 2 + ! ISS%mass_shelf(i,j) = partial_vol * rho + ISS%area_shelf_h(i,j) = partial_vol / h_reference + ISS%h_shelf(i,j) = h_reference else - if (.not. associated (flux_enter_replace)) then - allocate( flux_enter_replace (G%isd:G%ied,G%jsd:G%jed,1:4) ) - flux_enter_replace(:,:,:) = 0.0 - endif - hmask(i,j) = 1 - area_shelf_h(i,j) = dxdyh + ISS%hmask(i,j) = 1 + ISS%area_shelf_h(i,j) = dxdyh !h_temp(i,j) = h_reference partial_vol = partial_vol - h_reference * dxdyh @@ -3497,26 +3444,26 @@ subroutine shelf_advance_front(CS, ISS, G, flux_enter) n_flux = 0 ; new_partial(:) = 0 do k=1,2 - if (u_face_mask(i-2+k,j) == 2) then + if (CS%u_face_mask(i-2+k,j) == 2) then n_flux = n_flux + 1 - elseif (hmask(i+2*k-3,j) == 0) then + elseif (ISS%hmask(i+2*k-3,j) == 0) then n_flux = n_flux + 1 new_partial(k) = 1 endif enddo do k=1,2 - if (v_face_mask(i,j-2+k) == 2) then + if (CS%v_face_mask(i,j-2+k) == 2) then n_flux = n_flux + 1 - elseif (hmask(i,j+2*k-3) == 0) then + elseif (ISS%hmask(i,j+2*k-3) == 0) then n_flux = n_flux + 1 new_partial(k+2) = 1 endif enddo if (n_flux == 0) then ! there is nowhere to put the extra ice! - h_shelf(i,j) = h_reference + partial_vol / dxdyh + ISS%h_shelf(i,j) = h_reference + partial_vol / dxdyh else - h_shelf(i,j) = h_reference + ISS%h_shelf(i,j) = h_reference do k=1,2 if (new_partial(k) == 1) & @@ -3544,15 +3491,19 @@ subroutine shelf_advance_front(CS, ISS, G, flux_enter) if (is_root_pe() .and. (iter_count > 1)) print *, iter_count, "MAX ITERATIONS,ADVANCE FRONT" - if (associated(flux_enter_replace)) deallocate(flux_enter_replace) - end subroutine shelf_advance_front !> Apply a very simple calving law using a minimum thickness rule subroutine ice_shelf_min_thickness_calve(CS, G, h_shelf, area_shelf_h, hmask) - type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, dimension(:,:), intent(inout) :: h_shelf, area_shelf_h, hmask + type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: h_shelf + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: area_shelf_h + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: hmask + integer :: i,j do j=G%jsd,G%jed @@ -3570,9 +3521,12 @@ subroutine ice_shelf_min_thickness_calve(CS, G, h_shelf, area_shelf_h, hmask) end subroutine ice_shelf_min_thickness_calve subroutine calve_to_mask(CS, G, h_shelf, area_shelf_h, hmask, calve_mask) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, dimension(:,:), intent(inout) :: h_shelf, area_shelf_h, hmask, calve_mask + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_shelf + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: area_shelf_h + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask + real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: calve_mask integer :: i,j @@ -3589,12 +3543,16 @@ subroutine calve_to_mask(CS, G, h_shelf, area_shelf_h, hmask, calve_mask) end subroutine calve_to_mask subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - type(ice_shelf_state), pointer :: ISS !< A structure with elements that describe + type(ice_shelf_CS), intent(in):: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - real, dimension(:,:), intent(in) :: OD - real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: TAUD_X, TAUD_Y + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: OD !< ocean floor depth at tracer points, in m + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(inout) :: TAUD_X !< X-direction driving stress at q-points + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(inout) :: TAUD_Y !< Y-direction driving stress at q-points ! driving stress! @@ -3607,9 +3565,6 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) ! "average" ocean depth -- and is needed to find surface elevation ! (it is assumed that base_ice = bed + OD) - ! real, dimension(:,:), pointer :: D ! ocean floor depth - real, dimension(:,:), pointer :: H, & ! ice shelf thickness - hmask, u_face_mask, v_face_mask, float_frac real, dimension(SIZE(OD,1),SIZE(OD,2)) :: S, & ! surface elevation BASE ! basal elevation of shelf/stream character(1) :: procnum @@ -3631,16 +3586,13 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) i_off = G%idg_offset ; j_off = G%jdg_offset ! D => G%bathyT - H => ISS%h_shelf - float_frac => CS%float_frac - hmask => ISS%hmask - u_face_mask => CS%u_face_mask - v_face_mask => CS%v_face_mask +! H => ISS%h_shelf +! float_frac => CS%float_frac +! hmask => ISS%hmask rho = CS%density_ice rhow = CS%density_ocean_avg - call savearray2 ("H",H,CS%write_output_to_file) -! call savearray2 ("hmask",hmask,CS%write_output_to_file) + call savearray2 ("H",ISS%h_shelf,CS%write_output_to_file) call savearray2 ("u_face_mask", CS%u_face_mask_boundary,CS%write_output_to_file) call savearray2 ("umask", CS%umask,CS%write_output_to_file) call savearray2 ("v_face_mask", CS%v_face_mask_boundary,CS%write_output_to_file) @@ -3651,7 +3603,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) ! or is this faster? BASE(:,:) = -G%bathyT(:,:) + OD(:,:) - S(:,:) = BASE(:,:) + H(:,:) + S(:,:) = BASE(:,:) + ISS%h_shelf(:,:) ! write (procnum,'(I1)') mpp_pe() @@ -3665,29 +3617,29 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) dxdyh = G%areaT(i,j) ! print *,dxh," ",dyh," ",dxdyh - if (hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell + if (ISS%hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell ! calculate sx if ((i+i_off) == gisc) then ! at left computational bdry - if (hmask(i+1,j) == 1) then + if (ISS%hmask(i+1,j) == 1) then sx = (S(i+1,j)-S(i,j))/dxh else sx = 0 endif elseif ((i+i_off) == giec) then ! at right computational bdry - if (hmask(i-1,j) == 1) then + if (ISS%hmask(i-1,j) == 1) then sx = (S(i,j)-S(i-1,j))/dxh else sx=0 endif else ! interior - if (hmask(i+1,j) == 1) then + if (ISS%hmask(i+1,j) == 1) then cnt = cnt+1 sx = S(i+1,j) else sx = S(i,j) endif - if (hmask(i-1,j) == 1) then + if (ISS%hmask(i-1,j) == 1) then cnt = cnt+1 sx = sx - S(i-1,j) else @@ -3704,25 +3656,25 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) ! calculate sy, similarly if ((j+j_off) == gjsc) then ! at south computational bdry - if (hmask(i,j+1) == 1) then + if (ISS%hmask(i,j+1) == 1) then sy = (S(i,j+1)-S(i,j))/dyh else sy = 0 endif elseif ((j+j_off) == gjec) then ! at nprth computational bdry - if (hmask(i,j-1) == 1) then + if (ISS%hmask(i,j-1) == 1) then sy = (S(i,j)-S(i,j-1))/dyh else sy = 0 endif else ! interior - if (hmask(i,j+1) == 1) then + if (ISS%hmask(i,j+1) == 1) then cnt = cnt+1 sy = S(i,j+1) else sy = S(i,j) endif - if (hmask(i,j-1) == 1) then + if (ISS%hmask(i,j-1) == 1) then cnt = cnt+1 sy = sy - S(i,j-1) else @@ -3736,29 +3688,29 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) endif ! SW vertex - taud_x(i-1,j-1) = taud_x(i-1,j-1) - .25 * rho * grav * H(i,j) * sx * dxdyh - taud_y(i-1,j-1) = taud_y(i-1,j-1) - .25 * rho * grav * H(i,j) * sy * dxdyh + taud_x(I-1,J-1) = taud_x(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * dxdyh + taud_y(I-1,J-1) = taud_y(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * dxdyh ! SE vertex - taud_x(i,j-1) = taud_x(i,j-1) - .25 * rho * grav * H(i,j) * sx * dxdyh - taud_y(i,j-1) = taud_y(i,j-1) - .25 * rho * grav * H(i,j) * sy * dxdyh + taud_x(I,J-1) = taud_x(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * dxdyh + taud_y(I,J-1) = taud_y(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * dxdyh ! NW vertex - taud_x(i-1,j) = taud_x(i-1,j) - .25 * rho * grav * H(i,j) * sx * dxdyh - taud_y(i-1,j) = taud_y(i-1,j) - .25 * rho * grav * H(i,j) * sy * dxdyh + taud_x(I-1,J) = taud_x(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * dxdyh + taud_y(I-1,J) = taud_y(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * dxdyh ! NE vertex - taud_x(i,j) = taud_x(i,j) - .25 * rho * grav * H(i,j) * sx * dxdyh - taud_y(i,j) = taud_y(i,j) - .25 * rho * grav * H(i,j) * sy * dxdyh + taud_x(I,J) = taud_x(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * dxdyh + taud_y(I,J) = taud_y(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * dxdyh - if (float_frac(i,j) == 1) then - neumann_val = .5 * grav * (rho * H(i,j) ** 2 - rhow * G%bathyT(i,j) ** 2) + if (CS%float_frac(i,j) == 1) then + neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j) ** 2 - rhow * G%bathyT(i,j) ** 2) else - neumann_val = .5 * grav * (1-rho/rhow) * rho * H(i,j) ** 2 + neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j) ** 2 endif - if ((u_face_mask(i-1,j) == 2) .OR. (hmask(i-1,j) == 0) .OR. (hmask(i-1,j) == 2) ) then + if ((CS%u_face_mask(i-1,j) == 2) .OR. (ISS%hmask(i-1,j) == 0) .OR. (ISS%hmask(i-1,j) == 2) ) then ! left face of the cell is at a stress boundary ! the depth-integrated longitudinal stress is equal to the difference of depth-integrated ! pressure on either side of the face @@ -3772,19 +3724,19 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) taud_x(i-1,j) = taud_x(i-1,j) - .5 * dyh * neumann_val endif - if ((u_face_mask(i,j) == 2) .OR. (hmask(i+1,j) == 0) .OR. (hmask(i+1,j) == 2) ) then + if ((CS%u_face_mask(i,j) == 2) .OR. (ISS%hmask(i+1,j) == 0) .OR. (ISS%hmask(i+1,j) == 2) ) then ! right face of the cell is at a stress boundary taud_x(i,j-1) = taud_x(i,j-1) + .5 * dyh * neumann_val taud_x(i,j) = taud_x(i,j) + .5 * dyh * neumann_val endif - if ((v_face_mask(i,j-1) == 2) .OR. (hmask(i,j-1) == 0) .OR. (hmask(i,j-1) == 2) ) then + if ((CS%v_face_mask(i,j-1) == 2) .OR. (ISS%hmask(i,j-1) == 0) .OR. (ISS%hmask(i,j-1) == 2) ) then ! south face of the cell is at a stress boundary taud_y(i-1,j-1) = taud_y(i-1,j-1) - .5 * dxh * neumann_val taud_y(i,j-1) = taud_y(i,j-1) - .5 * dxh * neumann_val endif - if ((v_face_mask(i,j) == 2) .OR. (hmask(i,j+1) == 0) .OR. (hmask(i,j+1) == 2) ) then + if ((CS%v_face_mask(i,j) == 2) .OR. (ISS%hmask(i,j+1) == 0) .OR. (ISS%hmask(i,j+1) == 2) ) then ! north face of the cell is at a stress boundary taud_y(i-1,j) = taud_y(i-1,j) + .5 * dxh * neumann_val ! note negative sign due to direction of normal vector taud_y(i,j) = taud_y(i,j) + .5 * dxh * neumann_val @@ -3801,7 +3753,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) end subroutine calc_shelf_driving_stress subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new_sim) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. type(time_type), intent(in) :: Time real, dimension(SZDI_(G),SZDJ_(G)), & @@ -3817,11 +3769,6 @@ subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new ! need to update those velocity points not *technically* in any ! computational domain -- if this function gets moves to another module, ! DO NOT TAKE THE RESTARTING BIT WITH IT - - real, dimension(:,:) , pointer :: thickness_boundary_values, & - u_boundary_values, & - v_boundary_values, & - u_face_mask, v_face_mask integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq integer :: gjec, gisc, gjsc, cnt, isc, jsc, iec, jec integer :: i_off, j_off @@ -3834,10 +3781,6 @@ subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new ! iegq = G%iegq ; jegq = G%jegq i_off = G%idg_offset ; j_off = G%jdg_offset - thickness_boundary_values => CS%thickness_boundary_values - u_boundary_values => CS%u_boundary_values ; v_boundary_values => CS%v_boundary_values - u_face_mask => CS%u_face_mask ; v_face_mask => CS%v_face_mask - domain_width = CS%len_lat ! this loop results in some values being set twice but... eh. @@ -3850,15 +3793,15 @@ subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new ! endif if (hmask(i,j) == 3) then - thickness_boundary_values(i,j) = input_thick + CS%thickness_boundary_values(i,j) = input_thick endif if ((hmask(i,j) == 0) .or. (hmask(i,j) == 1) .or. (hmask(i,j) == 2)) then if ((i <= iec).and.(i >= isc)) then - if (u_face_mask(i-1,j) == 3) then - u_boundary_values(i-1,j-1) = (1 - ((G%geoLatBu(i-1,j-1) - 0.5*CS%len_lat)*2./CS%len_lat)**2) * & + if (CS%u_face_mask(i-1,j) == 3) then + CS%u_boundary_values(i-1,j-1) = (1 - ((G%geoLatBu(i-1,j-1) - 0.5*CS%len_lat)*2./CS%len_lat)**2) * & 1.5 * input_flux / input_thick - u_boundary_values(i-1,j) = (1 - ((G%geoLatBu(i-1,j) - 0.5*CS%len_lat)*2./CS%len_lat)**2) * & + CS%u_boundary_values(i-1,j) = (1 - ((G%geoLatBu(i-1,j) - 0.5*CS%len_lat)*2./CS%len_lat)**2) * & 1.5 * input_flux / input_thick endif endif @@ -3866,14 +3809,14 @@ subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new if (.not.(new_sim)) then if (.not. G%symmetric) then - if (((i+i_off) == (G%domain%nihalo+1)).and.(u_face_mask(i-1,j) == 3)) then - CS%u_shelf(i-1,j-1) = u_boundary_values(i-1,j-1) - CS%u_shelf(i-1,j) = u_boundary_values(i-1,j) + if (((i+i_off) == (G%domain%nihalo+1)).and.(CS%u_face_mask(i-1,j) == 3)) then + CS%u_shelf(i-1,j-1) = CS%u_boundary_values(i-1,j-1) + CS%u_shelf(i-1,j) = CS%u_boundary_values(i-1,j) ! print *, u_boundary_values(i-1,j) endif - if (((j+j_off) == (G%domain%njhalo+1)).and.(v_face_mask(i,j-1) == 3)) then - CS%u_shelf(i-1,j-1) = u_boundary_values(i-1,j-1) - CS%u_shelf(i,j-1) = u_boundary_values(i,j-1) + if (((j+j_off) == (G%domain%njhalo+1)).and.(CS%v_face_mask(i,j-1) == 3)) then + CS%u_shelf(i-1,j-1) = CS%u_boundary_values(i-1,j-1) + CS%u_shelf(i,j-1) = CS%u_boundary_values(i,j-1) endif endif endif @@ -3888,11 +3831,16 @@ subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmas type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent (inout) :: uret, vret - real, dimension(:,:,:,:), pointer :: Phi - real, dimension(:,:,:,:,:,:),pointer :: Phisub + real, dimension(SZDI_(G),SZDJ_(G),8,4), intent(in) :: Phi + real, dimension(:,:,:,:,:,:), intent(in) :: Phisub real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent (in) :: u, v real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent (in) :: umask, vmask, H_node - real, dimension(:,:), intent (in) :: hmask, nu, float_cond, D, beta, dxdyh + real, dimension(SZDI_(G),SZDJ_(G)), intent (in) :: hmask + real, dimension(SZDIB_(G),SZDJB_(G)), intent (in) :: nu + real, dimension(SZDI_(G),SZDJ_(G)), intent (in) :: float_cond + real, dimension(SZDI_(G),SZDJ_(G)), intent (in) :: D + real, dimension(SZDIB_(G),SZDJB_(G)), intent (in) :: beta + real, dimension(SZDI_(G),SZDJ_(G)), intent (in) :: dxdyh real, intent(in) :: dens_ratio integer, intent(in) :: is, ie, js, je @@ -4061,7 +4009,7 @@ subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmas end subroutine CG_action_bilinear subroutine CG_action_subgrid_basal_bilinear (Phisub, H, U, V, DXDYH, D, dens_ratio, Ucontr, Vcontr, iin, jin) - real, pointer, dimension(:,:,:,:,:,:) :: Phisub + real, dimension(:,:,:,:,:,:), intent(in) :: Phisub real, dimension(2,2), intent(in) :: H,U,V real, intent(in) :: DXDYH, D, dens_ratio real, dimension(2,2), intent(inout) :: Ucontr, Vcontr @@ -4128,24 +4076,26 @@ subroutine CG_action_subgrid_basal_bilinear (Phisub, H, U, V, DXDYH, D, dens_rat end subroutine CG_action_subgrid_basal_bilinear -subroutine matrix_diagonal_bilinear(CS, G, float_cond, H_node, hmask, dens_ratio, Phisub, u_diagonal, v_diagonal) +subroutine matrix_diagonal_bilinear(CS, G, float_cond, H_node, nu, beta, hmask, dens_ratio, & + Phisub, u_diagonal, v_diagonal) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: float_cond real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: H_node - real :: dens_ratio - real, dimension(:,:), intent(in) :: float_cond + real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: nu + real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: beta real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully coupled by an ice-shelf - real, dimension(:,:,:,:,:,:),pointer :: Phisub + real :: dens_ratio + real, dimension(:,:,:,:,:,:), intent(in) :: Phisub real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u_diagonal, v_diagonal ! returns the diagonal entries of the matrix for a Jacobi preconditioning - real, dimension(:,:), pointer :: umask, vmask, & - nu, beta integer :: i, j, is, js, cnt, isc, jsc, iec, jec, iphi, jphi, iq, jq, ilq, jlq real :: A, n, ux, uy, vx, vy, eps_min, domain_width, dxh, dyh, dxdyh, area, uq, vq, basel real, dimension(8,4) :: Phi @@ -4156,10 +4106,6 @@ subroutine matrix_diagonal_bilinear(CS, G, float_cond, H_node, hmask, dens_ratio isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec - umask => CS%umask ; vmask => CS%vmask - nu => CS%ice_visc_bilinear - beta => CS%taub_beta_eff_bilinear - xquad(1) = .5 * (1-sqrt(1./3)) ; xquad(2) = .5 * (1+sqrt(1./3)) ! X and Y must be passed in the form @@ -4205,7 +4151,7 @@ subroutine matrix_diagonal_bilinear(CS, G, float_cond, H_node, hmask, dens_ratio jlq = 1 endif - if (umask(i-2+iphi,j-2+jphi) == 1) then + if (CS%umask(i-2+iphi,j-2+jphi) == 1) then ux = Phi (2*(2*(jphi-1)+iphi)-1, 2*(jq-1)+iq) uy = Phi (2*(2*(jphi-1)+iphi), 2*(jq-1)+iq) @@ -4225,7 +4171,7 @@ subroutine matrix_diagonal_bilinear(CS, G, float_cond, H_node, hmask, dens_ratio endif - if (vmask(i-2+iphi,j-2+jphi) == 1) then + if (CS%vmask(i-2+iphi,j-2+jphi) == 1) then vx = Phi (2*(2*(jphi-1)+iphi)-1, 2*(jq-1)+iq) vy = Phi (2*(2*(jphi-1)+iphi), 2*(jq-1)+iq) @@ -4252,7 +4198,7 @@ subroutine matrix_diagonal_bilinear(CS, G, float_cond, H_node, hmask, dens_ratio call CG_diagonal_subgrid_basal_bilinear & (Phisub, Hcell, dxdyh, basel, dens_ratio, Usubcontr, Vsubcontr) do iphi=1,2 ; do jphi=1,2 - if (umask(i-2+iphi,j-2+jphi) == 1) then + if (CS%umask(i-2+iphi,j-2+jphi) == 1) then u_diagonal(i-2+iphi,j-2+jphi) = u_diagonal(i-2+iphi,j-2+jphi) + Usubcontr(iphi,jphi) * beta(i,j) v_diagonal(i-2+iphi,j-2+jphi) = v_diagonal(i-2+iphi,j-2+jphi) + Vsubcontr(iphi,jphi) * beta(i,j) endif @@ -4263,7 +4209,7 @@ subroutine matrix_diagonal_bilinear(CS, G, float_cond, H_node, hmask, dens_ratio end subroutine matrix_diagonal_bilinear subroutine CG_diagonal_subgrid_basal_bilinear (Phisub, H, DXDYH, D, dens_ratio, Ucontr, Vcontr) - real, pointer, dimension(:,:,:,:,:,:) :: Phisub + real, dimension(:,:,:,:,:,:), intent(in) :: Phisub real, dimension(2,2), intent(in) :: H real, intent(in) :: DXDYH, D, dens_ratio real, dimension(2,2), intent(inout) :: Ucontr, Vcontr @@ -4302,27 +4248,25 @@ subroutine CG_diagonal_subgrid_basal_bilinear (Phisub, H, DXDYH, D, dens_ratio, end subroutine CG_diagonal_subgrid_basal_bilinear -subroutine apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, float_cond, dens_ratio, & - u_boundary_contr, v_boundary_contr) +subroutine apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, nu, beta, float_cond, & + dens_ratio, u_boundary_contr, v_boundary_contr) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - type(ice_shelf_state), pointer :: ISS !< A structure with elements that describe + type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. type(time_type), intent(in) :: Time - real, dimension(:,:,:,:,:,:),pointer:: Phisub - real, dimension(SZDIB_(G),SZDJB_(G)), intent (in) :: H_node - real, dimension(:,:), intent (in) :: float_cond + real, dimension(:,:,:,:,:,:), intent(in) :: Phisub + real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: H_node + real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: nu + real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: beta + real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: float_cond real :: dens_ratio real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u_boundary_contr, v_boundary_contr ! this will be a per-setup function. the boundary values of thickness and velocity ! (and possibly other variables) will be updated in this function - real, pointer, dimension(:,:) :: u_boundary_values, & - v_boundary_values, & - umask, vmask, & - nu, beta, hmask real, dimension(8,4) :: Phi real, dimension(4) :: X, Y real, dimension(2) :: xquad @@ -4333,12 +4277,6 @@ subroutine apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, floa isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec - u_boundary_values => CS%u_boundary_values - v_boundary_values => CS%v_boundary_values - umask => CS%umask ; vmask => CS%vmask ; hmask => ISS%hmask - nu => CS%ice_visc_bilinear - beta => CS%taub_beta_eff_bilinear - xquad(1) = .5 * (1-sqrt(1./3)) ; xquad(2) = .5 * (1+sqrt(1./3)) ! X and Y must be passed in the form @@ -4348,13 +4286,13 @@ subroutine apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, floa ! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j ! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j - do j=jsc-1,jec+1 ; do i=isc-1,iec+1 ; if (hmask(i,j) == 1) then + do j=jsc-1,jec+1 ; do i=isc-1,iec+1 ; if (ISS%hmask(i,j) == 1) then ! process this cell if any corners have umask set to non-dirichlet bdry. ! NOTE: vmask not considered, probably should be - if ((umask(i-1,j-1) == 3) .OR. (umask(i,j-1) == 3) .OR. & - (umask(i-1,j) == 3) .OR. (umask(i,j) == 3)) then + if ((CS%umask(i-1,j-1) == 3) .OR. (CS%umask(i,j-1) == 3) .OR. & + (CS%umask(i-1,j) == 3) .OR. (CS%umask(i,j) == 3)) then dxh = G%dxT(i,j) @@ -4379,35 +4317,35 @@ subroutine apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, floa do iq=1,2 ; do jq=1,2 - uq = u_boundary_values(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + & - u_boundary_values(i,j-1) * xquad(iq) * xquad(3-jq) + & - u_boundary_values(i-1,j) * xquad(3-iq) * xquad(jq) + & - u_boundary_values(i,j) * xquad(iq) * xquad(jq) + uq = CS%u_boundary_values(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + & + CS%u_boundary_values(i,j-1) * xquad(iq) * xquad(3-jq) + & + CS%u_boundary_values(i-1,j) * xquad(3-iq) * xquad(jq) + & + CS%u_boundary_values(i,j) * xquad(iq) * xquad(jq) - vq = v_boundary_values(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + & - v_boundary_values(i,j-1) * xquad(iq) * xquad(3-jq) + & - v_boundary_values(i-1,j) * xquad(3-iq) * xquad(jq) + & - v_boundary_values(i,j) * xquad(iq) * xquad(jq) + vq = CS%v_boundary_values(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + & + CS%v_boundary_values(i,j-1) * xquad(iq) * xquad(3-jq) + & + CS%v_boundary_values(i-1,j) * xquad(3-iq) * xquad(jq) + & + CS%v_boundary_values(i,j) * xquad(iq) * xquad(jq) - ux = u_boundary_values(i-1,j-1) * Phi(1,2*(jq-1)+iq) + & - u_boundary_values(i,j-1) * Phi(3,2*(jq-1)+iq) + & - u_boundary_values(i-1,j) * Phi(5,2*(jq-1)+iq) + & - u_boundary_values(i,j) * Phi(7,2*(jq-1)+iq) + ux = CS%u_boundary_values(i-1,j-1) * Phi(1,2*(jq-1)+iq) + & + CS%u_boundary_values(i,j-1) * Phi(3,2*(jq-1)+iq) + & + CS%u_boundary_values(i-1,j) * Phi(5,2*(jq-1)+iq) + & + CS%u_boundary_values(i,j) * Phi(7,2*(jq-1)+iq) - vx = v_boundary_values(i-1,j-1) * Phi(1,2*(jq-1)+iq) + & - v_boundary_values(i,j-1) * Phi(3,2*(jq-1)+iq) + & - v_boundary_values(i-1,j) * Phi(5,2*(jq-1)+iq) + & - v_boundary_values(i,j) * Phi(7,2*(jq-1)+iq) + vx = CS%v_boundary_values(i-1,j-1) * Phi(1,2*(jq-1)+iq) + & + CS%v_boundary_values(i,j-1) * Phi(3,2*(jq-1)+iq) + & + CS%v_boundary_values(i-1,j) * Phi(5,2*(jq-1)+iq) + & + CS%v_boundary_values(i,j) * Phi(7,2*(jq-1)+iq) - uy = u_boundary_values(i-1,j-1) * Phi(2,2*(jq-1)+iq) + & - u_boundary_values(i,j-1) * Phi(4,2*(jq-1)+iq) + & - u_boundary_values(i-1,j) * Phi(6,2*(jq-1)+iq) + & - u_boundary_values(i,j) * Phi(8,2*(jq-1)+iq) + uy = CS%u_boundary_values(i-1,j-1) * Phi(2,2*(jq-1)+iq) + & + CS%u_boundary_values(i,j-1) * Phi(4,2*(jq-1)+iq) + & + CS%u_boundary_values(i-1,j) * Phi(6,2*(jq-1)+iq) + & + CS%u_boundary_values(i,j) * Phi(8,2*(jq-1)+iq) - vy = v_boundary_values(i-1,j-1) * Phi(2,2*(jq-1)+iq) + & - v_boundary_values(i,j-1) * Phi(4,2*(jq-1)+iq) + & - v_boundary_values(i-1,j) * Phi(6,2*(jq-1)+iq) + & - v_boundary_values(i,j) * Phi(8,2*(jq-1)+iq) + vy = CS%v_boundary_values(i-1,j-1) * Phi(2,2*(jq-1)+iq) + & + CS%v_boundary_values(i,j-1) * Phi(4,2*(jq-1)+iq) + & + CS%v_boundary_values(i-1,j) * Phi(6,2*(jq-1)+iq) + & + CS%v_boundary_values(i,j) * Phi(8,2*(jq-1)+iq) do iphi=1,2 ; do jphi=1,2 @@ -4423,7 +4361,7 @@ subroutine apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, floa jlq = 1 endif - if (umask(i-2+iphi,j-2+jphi) == 1) then + if (CS%umask(i-2+iphi,j-2+jphi) == 1) then u_boundary_contr(i-2+iphi,j-2+jphi) = u_boundary_contr(i-2+iphi,j-2+jphi) + & @@ -4437,7 +4375,7 @@ subroutine apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, floa endif - if (vmask(i-2+iphi,j-2+jphi) == 1) then + if (CS%vmask(i-2+iphi,j-2+jphi) == 1) then v_boundary_contr(i-2+iphi,j-2+jphi) = v_boundary_contr(i-2+iphi,j-2+jphi) + & @@ -4455,16 +4393,16 @@ subroutine apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, floa if (float_cond(i,j) == 1) then Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%bathyT(i,j) - Ucell(:,:) = u_boundary_values(i-1:i,j-1:j) ; Vcell(:,:) = v_boundary_values(i-1:i,j-1:j) + Ucell(:,:) = CS%u_boundary_values(i-1:i,j-1:j) ; Vcell(:,:) = CS%v_boundary_values(i-1:i,j-1:j) Hcell(:,:) = H_node(i-1:i,j-1:j) call CG_action_subgrid_basal_bilinear & (Phisub, Hcell, Ucell, Vcell, dxdyh, basel, dens_ratio, Usubcontr, Vsubcontr) do iphi=1,2 ; do jphi = 1,2 - if (umask(i-2+iphi,j-2+jphi) == 1) then + if (CS%umask(i-2+iphi,j-2+jphi) == 1) then u_boundary_contr(i-2+iphi,j-2+jphi) = u_boundary_contr(i-2+iphi,j-2+jphi) + & Usubcontr(iphi,jphi) * beta(i,j) endif - if (vmask(i-2+iphi,j-2+jphi) == 1) then + if (CS%vmask(i-2+iphi,j-2+jphi) == 1) then v_boundary_contr(i-2+iphi,j-2+jphi) = v_boundary_contr(i-2+iphi,j-2+jphi) + & Vsubcontr(iphi,jphi) * beta(i,j) endif @@ -4477,8 +4415,8 @@ end subroutine apply_boundary_values_bilinear subroutine calc_shelf_visc_bilinear(CS, ISS, G, u, v) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - type(ice_shelf_state), pointer :: ISS !< A structure with elements that describe + type(ice_shelf_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent(inout) :: u, v @@ -4490,11 +4428,6 @@ subroutine calc_shelf_visc_bilinear(CS, ISS, G, u, v) ! this may be subject to change later... to make it "hybrid" - real, pointer, dimension(:,:) :: nu, & - beta - real, pointer, dimension(:,:) :: H, &! thickness - hmask - integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js real :: A, n, ux, uy, vx, vy, eps_min, umid, vmid, unorm, C_basal_friction, n_basal_friction, dxh, dyh, dxdyh @@ -4510,11 +4443,6 @@ subroutine calc_shelf_visc_bilinear(CS, ISS, G, u, v) A = CS%A_glen_isothermal ; n = CS%n_glen; eps_min = CS%eps_glen_min C_basal_friction = CS%C_basal_friction ; n_basal_friction = CS%n_basal_friction - H => ISS%h_shelf - hmask => ISS%hmask - nu => CS%ice_visc_bilinear - beta => CS%taub_beta_eff_bilinear - do j=jsd+1,jed-1 do i=isd+1,ied-1 @@ -4522,17 +4450,20 @@ subroutine calc_shelf_visc_bilinear(CS, ISS, G, u, v) dyh = G%dyT(i,j) dxdyh = G%areaT(i,j) - if (hmask(i,j) == 1) then + if (ISS%hmask(i,j) == 1) then ux = (u(i,j) + u(i,j-1) - u(i-1,j) - u(i-1,j-1)) / (2*dxh) vx = (v(i,j) + v(i,j-1) - v(i-1,j) - v(i-1,j-1)) / (2*dxh) uy = (u(i,j) - u(i,j-1) + u(i-1,j) - u(i-1,j-1)) / (2*dyh) vy = (v(i,j) - v(i,j-1) + v(i-1,j) - v(i-1,j-1)) / (2*dyh) - nu(i,j) = .5 * A**(-1/n) * (ux**2+vy**2+ux*vy+0.25*(uy+vx)**2+eps_min**2) ** ((1-n)/(2*n)) * H(i,j) + CS%ice_visc_bilinear(i,j) = .5 * A**(-1/n) * & + (ux**2+vy**2+ux*vy+0.25*(uy+vx)**2+eps_min**2) ** ((1-n)/(2*n)) * & + ISS%h_shelf(i,j) umid = (u(i,j) + u(i,j-1) + u(i-1,j) + u(i-1,j-1))/4 vmid = (v(i,j) + v(i,j-1) + v(i-1,j) + v(i-1,j-1))/4 - unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) ; beta(i,j) = C_basal_friction * unorm ** (n_basal_friction-1) + unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) + CS%taub_beta_eff_bilinear(i,j) = C_basal_friction * unorm ** (n_basal_friction-1) endif enddo enddo @@ -4540,7 +4471,7 @@ subroutine calc_shelf_visc_bilinear(CS, ISS, G, u, v) end subroutine calc_shelf_visc_bilinear subroutine update_OD_ffrac(CS, G, ocean_mass, counter, nstep_velocity, time_step, velocity_update_time_step) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_CS), intent(inout):: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(G%isd:,G%jsd:) :: ocean_mass integer,intent(in) :: counter @@ -4589,7 +4520,7 @@ subroutine update_OD_ffrac(CS, G, ocean_mass, counter, nstep_velocity, time_step end subroutine update_OD_ffrac subroutine update_OD_ffrac_uncoupled(CS, G, h_shelf) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: h_shelf !< the thickness of the ice shelf in m @@ -4597,33 +4528,26 @@ subroutine update_OD_ffrac_uncoupled(CS, G, h_shelf) integer :: i, j, iters, isd, ied, jsd, jed real :: rhoi, rhow, OD type(time_type) :: dummy_time - real,dimension(:,:),pointer :: OD_av, float_frac - rhoi = CS%density_ice rhow = CS%density_ocean_avg dummy_time = set_time (0,0) - OD_av => CS%OD_av - float_frac => CS%float_frac - isd=G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - -! print *,"rhow",rhow,"rho",rhoi + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed do j=jsd,jed do i=isd,ied OD = G%bathyT(i,j) - rhoi/rhow * h_shelf(i,j) if (OD >= 0) then ! ice thickness does not take up whole ocean column -> floating - OD_av(i,j) = OD - float_frac(i,j) = 0. + CS%OD_av(i,j) = OD + CS%float_frac(i,j) = 0. else - OD_av(i,j) = 0. - float_frac(i,j) = 1. + CS%OD_av(i,j) = 0. + CS%float_frac(i,j) = 1. endif enddo enddo - end subroutine update_OD_ffrac_uncoupled subroutine bilinear_shape_functions (X, Y, Phi, area) @@ -4759,12 +4683,22 @@ subroutine bilinear_shape_functions_subgrid (Phisub, nsub) end subroutine bilinear_shape_functions_subgrid -subroutine update_velocity_masks(CS, G, hmask) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure +subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face_mask) + type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully coupled by an ice-shelf + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(out) :: umask !< A coded mask indicating the nature of the + !! zonal flow at the corner point + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(out) :: vmask !< A coded mask indicating the nature of the + !! meridional flow at the corner point + real, dimension(SZDIB_(G),SZDJ_(G)), & + intent(out) :: u_face_mask !< A coded mask for velocities at the C-grid u-face + real, dimension(SZDI_(G),SZDJB_(G)), & + intent(out) :: v_face_mask !< A coded mask for velocities at the C-grid v-face ! sets masks for velocity solve ! ignores the fact that their might be ice-free cells - this only considers the computational boundary @@ -4773,8 +4707,6 @@ subroutine update_velocity_masks(CS, G, hmask) integer :: i, j, k, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq integer :: giec, gjec, gisc, gjsc, isc, jsc, iec, jec integer :: i_off, j_off - real, dimension(:,:), pointer :: umask, vmask, u_face_mask, v_face_mask - real, dimension(:,:), pointer :: u_face_mask_boundary, v_face_mask_boundary isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB @@ -4784,13 +4716,6 @@ subroutine update_velocity_masks(CS, G, hmask) gisc = G%Domain%nihalo ; gjsc = G%Domain%njhalo giec = G%Domain%niglobal+gisc ; gjec = G%Domain%njglobal+gjsc - umask => CS%umask - vmask => CS%vmask - u_face_mask => CS%u_face_mask - v_face_mask => CS%v_face_mask - u_face_mask_boundary => CS%u_face_mask_boundary - v_face_mask_boundary => CS%v_face_mask_boundary - umask(:,:) = 0 ; vmask(:,:) = 0 u_face_mask(:,:) = 0 ; v_face_mask(:,:) = 0 @@ -4810,7 +4735,7 @@ subroutine update_velocity_masks(CS, G, hmask) do k=0,1 - select case (int(u_face_mask_boundary(i-1+k,j))) + select case (int(CS%u_face_mask_boundary(i-1+k,j))) case (3) umask(i-1+k,j-1:j)=3. vmask(i-1+k,j-1:j)=0. @@ -4833,7 +4758,7 @@ subroutine update_velocity_masks(CS, G, hmask) do k=0,1 - select case (int(v_face_mask_boundary(i,j-1+k))) + select case (int(CS%v_face_mask_boundary(i,j-1+k))) case (3) vmask(i-1:i,j-1+k)=3. umask(i-1:i,j-1+k)=0. @@ -4854,8 +4779,8 @@ subroutine update_velocity_masks(CS, G, hmask) end select enddo - !if (u_face_mask_boundary(i-1,j).geq.0) then !left boundary - ! u_face_mask(i-1,j) = u_face_mask_boundary(i-1,j) + !if (CS%u_face_mask_boundary(i-1,j).geq.0) then !left boundary + ! u_face_mask(i-1,j) = CS%u_face_mask_boundary(i-1,j) ! umask(i-1,j-1:j) = 3. ! vmask(i-1,j-1:j) = 0. !endif @@ -4909,20 +4834,22 @@ subroutine update_velocity_masks(CS, G, hmask) ! so this subroutine must update its own symmetric part of the halo call pass_vector(u_face_mask, v_face_mask, G%domain, TO_ALL, CGRID_NE) - call pass_vector(umask,vmask,G%domain,TO_ALL,BGRID_NE) + call pass_vector(umask, vmask, G%domain, TO_ALL, BGRID_NE) end subroutine update_velocity_masks -subroutine interpolate_H_to_B(CS, G, h_shelf, hmask, H_node) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, dimension(:,:), intent(in) :: h_shelf, hmask +subroutine interpolate_H_to_B(G, h_shelf, hmask, H_node) + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: h_shelf + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: hmask real, dimension(SZDIB_(G),SZDJB_(G)), & - intent(inout) :: H_node + intent(inout) :: H_node - integer :: i, j, isc, iec, jsc, jec, num_h, k, l - real :: summ + integer :: i, j, isc, iec, jsc, jec, num_h, k, l + real :: summ isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec @@ -5075,7 +5002,6 @@ subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) integer :: is, iec, js, jec, i, j, ki, kj, iters real :: ratio, min_ratio, time_step_remain, local_u_max, & local_v_max, time_step_int, min_time_step,spy,dumtimeprint - real, dimension(:,:), pointer :: u_shelf, v_shelf, hmask, umask, vmask logical :: flag type (time_type) :: dummy character(2) :: procnum @@ -5086,11 +5012,6 @@ subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) G => CS%grid ISS => CS%ISS - u_shelf => CS%u_shelf - v_shelf => CS%v_shelf - hmask => ISS%hmask - umask => CS%umask - vmask => CS%vmask time_step_remain = time_step if (.not. (present (min_time_step_in))) then min_time_step = 1000 ! i think this is in seconds - this would imply ice is moving at ~1 meter per second @@ -5112,13 +5033,13 @@ subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) local_u_max = 0 ; local_v_max = 0 - if (hmask(i,j) == 1.0) then + if (ISS%hmask(i,j) == 1.0) then ! all 4 corners of the cell should have valid velocity values; otherwise something is wrong ! this is done by checking that umask and vmask are nonzero at all 4 corners do ki=1,2 ; do kj = 1,2 - local_u_max = max(local_u_max, abs(u_shelf(i-1+ki,j-1+kj))) - local_v_max = max(local_v_max, abs(v_shelf(i-1+ki,j-1+kj))) + local_u_max = max(local_u_max, abs(CS%u_shelf(i-1+ki,j-1+kj))) + local_v_max = max(local_v_max, abs(CS%v_shelf(i-1+ki,j-1+kj))) enddo ; enddo @@ -5152,7 +5073,7 @@ subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) write (stepnum,'(I4)') CS%velocity_update_sub_counter - call ice_shelf_advect(CS, ISS, G, time_step_int, ISS%water_flux, Time) + call ice_shelf_advect(CS, ISS, G, time_step_int, Time) if (mpp_pe() == 7) then call savearray2 ("hmask",ISS%hmask,CS%write_output_to_file) @@ -5163,7 +5084,7 @@ subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) ! if the last mini-timestep is a day or less, we cannot expect velocities to change by much. ! do not update them if (time_step_int > 1000) then - call update_velocity_masks(CS, G, ISS%hmask) + call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) ! call savearray2 ("Umask"//"p"//trim(procnum)//"_"//trim(stepnum),CS%umask,CS%write_output_to_file) ! call savearray2 ("Vmask"//"p"//trim(procnum)//"_"//trim(stepnum),CS%vmask,CS%write_output_to_file) @@ -5201,13 +5122,14 @@ end subroutine solo_time_step !!! OVS !!! subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - type(ice_shelf_state), pointer :: ISS !< A structure with elements that describe - !! the ice-shelf state - type(ocean_grid_type), pointer :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step - real, dimension(:,:), pointer :: melt_rate - type(time_type), intent(in) :: Time + type(ice_shelf_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe + !! the ice-shelf state + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real, intent(in) :: time_step + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: melt_rate !< basal melt rate in kg/m^2/s + type(time_type), intent(in) :: Time ! time_step: time step in sec ! melt_rate: basal melt rate in kg/m^2/s @@ -5251,10 +5173,8 @@ subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) real, dimension(SZDI_(G),SZDJ_(G),4) :: flux_enter integer :: isd, ied, jsd, jed, i, j, isc, iec, jsc, jec real :: rho, spy, t_bd, Tsurf, adot - real, dimension(:,:), pointer :: hmask => NULL() character(len=2) :: procnum - hmask => ISS%hmask rho = CS%density_ice spy = 365 * 86400 ! seconds per year; is there a global constant for this? No - it is dependent upon a calendar. @@ -5298,8 +5218,8 @@ subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) - call ice_shelf_advect_temp_x(CS, G, time_step/spy, hmask, TH, th_after_uflux, flux_enter) - call ice_shelf_advect_temp_y(CS, G, time_step/spy, hmask, th_after_uflux, th_after_vflux, flux_enter) + call ice_shelf_advect_temp_x(CS, G, time_step/spy, ISS%hmask, TH, th_after_uflux, flux_enter) + call ice_shelf_advect_temp_y(CS, G, time_step/spy, ISS%hmask, th_after_uflux, th_after_vflux, flux_enter) do j=jsd,jed do i=isd,ied @@ -5353,13 +5273,13 @@ end subroutine ice_shelf_temp subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, flux_enter) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h0 real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_uflux - real, dimension(:,:,:), intent(inout) :: flux_enter + real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells @@ -5383,18 +5303,12 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f integer :: i_off, j_off logical :: at_east_bdry, at_west_bdry, one_off_west_bdry, one_off_east_bdry real, dimension(-2:2) :: stencil - real, dimension(:,:), pointer :: u_face_mask, u_flux_boundary_values,u_boundary_values,t_boundary real :: u_face, & ! positive if out flux_diff_cell, phi, dxh, dyh, dxdyh character (len=1) :: debug_str, procnum - u_face_mask => CS%u_face_mask - u_flux_boundary_values => CS%u_flux_boundary_values - u_boundary_values => CS%u_shelf -! h_boundaries => ISS%h_shelf - t_boundary => CS%t_boundary_values is = G%isc-2 ; ie = G%iec+2 ; js = G%jsc ; je = G%jec ; isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed i_off = G%idg_offset ; j_off = G%jdg_offset @@ -5433,12 +5347,12 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f ! 1ST DO LEFT FACE - if (u_face_mask(i-1,j) == 4.) then + if (CS%u_face_mask(i-1,j) == 4.) then - flux_diff_cell = flux_diff_cell + dyh * time_step * u_flux_boundary_values(i-1,j) * & - t_boundary(i-1,j) / dxdyh + flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_flux_boundary_values(i-1,j) * & + CS%t_boundary_values(i-1,j) / dxdyh ! assume no flux bc for temp -! flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_shelf(i,j)*t_boundary(i-1,j) / dxdyh +! flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_shelf(i,j)*CS%t_boundary_values(i-1,j) / dxdyh else @@ -5490,12 +5404,12 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f ! get u-velocity at center of right face - if (u_face_mask(i+1,j) == 4.) then + if (CS%u_face_mask(i+1,j) == 4.) then - flux_diff_cell = flux_diff_cell + dyh * time_step * u_flux_boundary_values(i+1,j) *& - t_boundary(i+1,j)/ dxdyh + flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_flux_boundary_values(i+1,j) *& + CS%t_boundary_values(i+1,j)/ dxdyh ! assume no flux bc for temp -! flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_shelf(i,j)*t_boundary(i+1,j)/ dxdyh +! flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_shelf(i,j)*CS%t_boundary_values(i+1,j)/ dxdyh else @@ -5553,22 +5467,22 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - flux_enter(i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * t_boundary(i-1,j)* & + flux_enter(i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * CS%t_boundary_values(i-1,j)* & CS%thickness_boundary_values(i+1,j) - elseif (u_face_mask(i-1,j) == 4.) then - flux_enter(i,j,1) = G%dyT(i,j) * time_step * u_flux_boundary_values(i-1,j)*t_boundary(i-1,j) -! flux_enter(i,j,1) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*t_boundary(i-1,j) + elseif (CS%u_face_mask(i-1,j) == 4.) then + flux_enter(i,j,1) = G%dyT(i,j) * time_step * CS%u_flux_boundary_values(i-1,j)*CS%t_boundary_values(i-1,j) +! flux_enter(i,j,1) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*CS%t_boundary_values(i-1,j) ! assume no flux bc for temp endif if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) - flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * t_boundary(i+1,j)* & + flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * CS%t_boundary_values(i+1,j)* & CS%thickness_boundary_values(i+1,j) - elseif (u_face_mask(i+1,j) == 4.) then - flux_enter(i,j,2) = G%dyT(i,j) * time_step * u_flux_boundary_values(i+1,j) * t_boundary(i+1,j) + elseif (CS%u_face_mask(i+1,j) == 4.) then + flux_enter(i,j,2) = G%dyT(i,j) * time_step * CS%u_flux_boundary_values(i+1,j) * CS%t_boundary_values(i+1,j) ! assume no flux bc for temp -! flux_enter(i,j,2) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*t_boundary(i+1,j) +! flux_enter(i,j,2) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*CS%t_boundary_values(i+1,j) endif ! if ((i == is) .AND. (hmask(i,j) == 0) .AND. (hmask(i-1,j) == 1)) then @@ -5599,13 +5513,13 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f end subroutine ice_shelf_advect_temp_x subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_after_vflux, flux_enter) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - type(ocean_grid_type), pointer :: G !< The grid structure used by the ice shelf. + type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h_after_uflux real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_vflux - real, dimension(:,:,:), intent(inout) :: flux_enter + real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells @@ -5629,16 +5543,10 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft integer :: i_off, j_off logical :: at_north_bdry, at_south_bdry, one_off_west_bdry, one_off_east_bdry real, dimension(-2:2) :: stencil - real, dimension(:,:), pointer :: v_face_mask, v_flux_boundary_values,t_boundary,v_boundary_values real :: v_face, & ! positive if out flux_diff_cell, phi, dxh, dyh, dxdyh character(len=1) :: debug_str, procnum - - v_face_mask => CS%v_face_mask - v_flux_boundary_values => CS%v_flux_boundary_values - t_boundary => CS%t_boundary_values - v_boundary_values => CS%v_shelf is = G%isc ; ie = G%iec ; js = G%jsc-1 ; je = G%jec+1 ; isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed i_off = G%idg_offset ; j_off = G%jdg_offset @@ -5673,12 +5581,12 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft ! 1ST DO south FACE - if (v_face_mask(i,j-1) == 4.) then + if (CS%v_face_mask(i,j-1) == 4.) then - flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values(i,j-1) * & - t_boundary(i,j-1)/ dxdyh + flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_flux_boundary_values(i,j-1) * & + CS%t_boundary_values(i,j-1)/ dxdyh ! assume no flux bc for temp -! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*t_boundary(i,j-1) / dxdyh +! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*CS%t_boundary_values(i,j-1) / dxdyh else @@ -5726,12 +5634,12 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft ! NEXT DO north FACE - if (v_face_mask(i,j+1) == 4.) then + if (CS%v_face_mask(i,j+1) == 4.) then - flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values(i,j+1) *& - t_boundary(i,j+1)/ dxdyh + flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_flux_boundary_values(i,j+1) *& + CS%t_boundary_values(i,j+1)/ dxdyh ! assume no flux bc for temp -! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*t_boundary(i,j+1) / dxdyh +! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*CS%t_boundary_values(i,j+1) / dxdyh else @@ -5778,23 +5686,23 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then v_face = 0.5 * (CS%v_shelf(i-1,j-1) + CS%v_shelf(i,j-1)) - flux_enter(i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * t_boundary(i,j-1)* & + flux_enter(i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * CS%t_boundary_values(i,j-1)* & CS%thickness_boundary_values(i,j-1) - elseif (v_face_mask(i,j-1) == 4.) then - flux_enter(i,j,3) = G%dxT(i,j) * time_step * v_flux_boundary_values(i,j-1)*t_boundary(i,j-1) + elseif (CS%v_face_mask(i,j-1) == 4.) then + flux_enter(i,j,3) = G%dxT(i,j) * time_step * CS%v_flux_boundary_values(i,j-1)*CS%t_boundary_values(i,j-1) ! assume no flux bc for temp -! flux_enter(i,j,3) = G%dxh(i,j) * time_step * CS%v_shelf(i,j)*t_boundary(i,j-1) +! flux_enter(i,j,3) = G%dxh(i,j) * time_step * CS%v_shelf(i,j)*CS%t_boundary_values(i,j-1) endif if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then v_face = 0.5 * (CS%v_shelf(i-1,j) + CS%v_shelf(i,j)) - flux_enter(i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * t_boundary(i,j+1)* & + flux_enter(i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * CS%t_boundary_values(i,j+1)* & CS%thickness_boundary_values(i,j+1) - elseif (v_face_mask(i,j+1) == 4.) then - flux_enter(i,j,4) = G%dxT(i,j) * time_step * v_flux_boundary_values(i,j+1)*t_boundary(i,j+1) + elseif (CS%v_face_mask(i,j+1) == 4.) then + flux_enter(i,j,4) = G%dxT(i,j) * time_step * CS%v_flux_boundary_values(i,j+1)*CS%t_boundary_values(i,j+1) ! assume no flux bc for temp -! flux_enter(i,j,4) = G%dxh(i,j) * time_step * CS%v_shelf(i,j)*t_boundary(i,j+1) +! flux_enter(i,j,4) = G%dxh(i,j) * time_step * CS%v_shelf(i,j)*CS%t_boundary_values(i,j+1) endif ! if ((j == js) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j-1) == 1)) then From dfe3dc235ab86620aa4cbdab1a944e13175e7bbf Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 21 May 2018 07:31:25 -0400 Subject: [PATCH 0279/1072] +Created ice shelf dynamics control structure Created a new ice shelf dynamics control structure, separate from the overall ice shelf control structure, in preparation for moving the ice shelf dynamics into its own module. All answers are bitwise identical, although several internal interfaces are changed. --- src/ice_shelf/MOM_ice_shelf.F90 | 1007 +++++++++++++------------------ 1 file changed, 432 insertions(+), 575 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 244b2d1e84..edafa092be 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -34,7 +34,7 @@ module MOM_ice_shelf use MOM_get_input, only : directories, Get_MOM_input use MOM_EOS, only : calculate_density, calculate_density_derivs, calculate_TFreeze use MOM_EOS, only : EOS_type, EOS_init -!MJHuse MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary, initialize_ice_thickness +!MJH use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary, initialize_ice_thickness use MOM_ice_shelf_initialize, only : initialize_ice_thickness use MOM_ice_shelf_state, only : ice_shelf_state, ice_shelf_state_end, ice_shelf_state_init use user_shelf_init, only : USER_initialize_shelf_mass, USER_update_shelf_mass @@ -72,62 +72,10 @@ module MOM_ice_shelf character(len=128) :: restart_output_dir = ' ' type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe !! the ice-shelf state + type(ice_shelf_dyn_CS), pointer :: dCS => NULL() !< The control structure for the ice-shelf dynamics. real, pointer, dimension(:,:) :: & - utide => NULL(), & !< tidal velocity, in m/s - !!! DNG !!! - u_shelf => NULL(), & !< the zonal (?) velocity of the ice shelf/sheet, - ! in meters per second??? on q-points (B grid) - v_shelf => NULL(), & !< the meridional velocity of the ice shelf/sheet, - !! in m/s ?? on q-points (B grid) - - u_face_mask => NULL(), & !> masks for velocity boundary conditions - v_face_mask => NULL(), & !! on *C GRID* - this is because the FEM - !! cares about FACES THAT GET INTEGRATED OVER, - !! not vertices. Will represent boundary conditions - !! on computational boundary (or permanent boundary - !! between fast-moving and near-stagnant ice - !! FOR NOW: 1=interior bdry, 0=no-flow boundary, - !! 2=stress bdry condition, 3=inhomogeneous - !! dirichlet boundary, 4=flux boundary: at these - !! faces a flux will be specified which will - !! override velocities; a homogeneous velocity - !! condition will be specified (this seems to give - !! the solver less difficulty) - u_face_mask_boundary => NULL(), v_face_mask_boundary => NULL(), & - u_flux_boundary_values => NULL(), v_flux_boundary_values => NULL(), & - ! needed where u_face_mask is equal to 4, similary for v_face_mask - umask => NULL(), vmask => NULL(), & !< masks on the actual degrees of freedom (B grid) - !! 1=normal node, 3=inhomogeneous boundary node, - !! 0 - no flow node (will also get ice-free nodes) - calve_mask => NULL(), & !< a mask to prevent the ice shelf front from - !! advancing past its initial position (but it may - !! retreat) - !!! OVS !!! - t_shelf => NULL(), & ! veritcally integrated temperature the ice shelf/stream... oC - ! on q-points (B grid) - tmask => NULL(), & - ! masks for temperature boundary conditions ??? - ice_visc_bilinear => NULL(), & - thickness_boundary_values => NULL(), & - u_boundary_values => NULL(), & - v_boundary_values => NULL(), & - h_boundary_values => NULL(), & -!!! OVS !!! - t_boundary_values => NULL(), & - - taub_beta_eff_bilinear => NULL(), & ! nonlinear part of "linearized" basal stress - - ! exact form depends on basal law exponent - ! and/or whether flow is "hybridized" a la Goldberg 2011 - - OD_rt => NULL(), float_frac_rt => NULL(), & !< two arrays that represent averages - OD_av => NULL(), float_frac => NULL() !! of ocean values that are maintained - !! within the ice shelf module and updated based on the "ocean state". - !! OD_av is ocean depth, and float_frac is the average amount of time - !! a cell is "exposed", i.e. the column thickness is below a threshold. - !! both are averaged over the time of a diagnostic (ice velocity) - - !! [if float_frac = 1 ==> grounded; obv. counterintuitive; might fix] + utide => NULL() !< tidal velocity, in m/s real :: ustar_bg !< A minimum value for ustar under ice shelves, in m s-1. real :: cdrag !< drag coefficient under ice shelves , non-dimensional. @@ -157,42 +105,24 @@ module MOM_ice_shelf !! is initialized - so need to reorganize MOM driver. !! it will be the prognistic timestep ... maybe. - !!! all need to be initialized - logical :: solo_ice_sheet !< whether the ice model is running without being !! coupled to the ocean logical :: GL_regularize !< whether to regularize the floatation condition !! at the grounding line a la Goldberg Holland Schoof 2009 - integer :: n_sub_regularize - !< partition of cell over which to integrate for - !! interpolated grounding line the (rectangular) is - !! divided into nxn equally-sized rectangles, over which - !! basal contribution is integrated (iterative quadrature) logical :: GL_couple !< whether to let the floatation condition be !!determined by ocean column thickness means update_OD_ffrac !! will be called (note: GL_regularize and GL_couple !! should be exclusive) - - real :: A_glen_isothermal - real :: n_glen - real :: eps_glen_min - real :: C_basal_friction - real :: n_basal_friction real :: density_ocean_avg !< this does not affect ocean circulation OR thermodynamics !! it is to estimate the gravitational driving force at the !! shelf front(until we think of a better way to do it- !! but any difference will be negligible) - real :: thresh_float_col_depth ! the water column depth over which the shelf if considered to be floating - logical :: moving_shelf_front logical :: calve_to_mask real :: min_thickness_simple_calve ! min. ice shelf thickness criteria for calving real :: T0, S0 ! temp/salt at ocean surface in the restoring region real :: input_flux real :: input_thickness - real :: len_lat ! this really should be a Grid or Domain field - - real :: velocity_update_time_step ! the time to update the velocity through the nonlinear ! elliptic equation. i think this should be done no more often than ! ~ once a day (maybe longer) because it will depend on ocean values @@ -203,26 +133,14 @@ module MOM_ice_shelf integer :: velocity_update_counter ! the "outer" timestep number integer :: nstep_velocity ! ~ (velocity_update_time_step / time_step) - real :: cg_tolerance, nonlinear_tolerance - integer :: cg_max_iterations - integer :: nonlin_solve_err_mode ! 1: exit vel solve based on nonlin residual - ! 2: exit based on "fixed point" metric (|u - u_last| / |u| < tol where | | is infty-norm real :: CFL_factor ! in uncoupled run, how to limit subcycled advective timestep ! i.e. dt = CFL_factor * min(dx / u) - logical :: use_reproducing_sums !< use new reproducing sums of Bob & Alistair for - !! global sums. - !! NOTE: for this to work all tiles must have the same & of - !! elements. this means thatif a symmetric grid is being - !! used, the southwest nodes of the southwest tiles will not - !! be included in the - - - logical :: switch_var ! for debdugging - a switch to ensure some event happens only once type(time_type) :: Time !< The component's time. type(EOS_type), pointer :: eqn_of_state => NULL() !< Type that indicates the !! equation of state to use. - logical :: shelf_mass_is_dynamic !< True if the ice shelf mass changes with time. + logical :: active_shelf_dynamics !< True if the ice shelf mass changes as a result + !! the dynamic ice-shelf model. logical :: override_shelf_movement !< If true, user code specifies the shelf movement !! instead of using the dynamic ice-shelf mode. logical :: isthermo !< True if the ice shelf can exchange heat and @@ -260,11 +178,113 @@ module MOM_ice_shelf type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to control diagnostic output. type(user_ice_shelf_CS), pointer :: user_CS => NULL() - logical :: write_output_to_file !< this is for seeing arrays w/out netcdf capability logical :: debug !< If true, write verbose checksums for debugging purposes !! and use reproducible sums end type ice_shelf_CS +!> The control structure for the ice shelf dynamics. +type, public :: ice_shelf_dyn_CS ; private + real, pointer, dimension(:,:) :: & + u_shelf => NULL(), & !< the zonal (?) velocity of the ice shelf/sheet, + ! in meters per second??? on q-points (B grid) + v_shelf => NULL(), & !< the meridional velocity of the ice shelf/sheet, + !! in m/s ?? on q-points (B grid) + + u_face_mask => NULL(), & !> masks for velocity boundary conditions + v_face_mask => NULL(), & !! on *C GRID* - this is because the FEM + !! cares about FACES THAT GET INTEGRATED OVER, + !! not vertices. Will represent boundary conditions + !! on computational boundary (or permanent boundary + !! between fast-moving and near-stagnant ice + !! FOR NOW: 1=interior bdry, 0=no-flow boundary, + !! 2=stress bdry condition, 3=inhomogeneous + !! dirichlet boundary, 4=flux boundary: at these + !! faces a flux will be specified which will + !! override velocities; a homogeneous velocity + !! condition will be specified (this seems to give + !! the solver less difficulty) + u_face_mask_boundary => NULL(), & + v_face_mask_boundary => NULL(), & + u_flux_boundary_values => NULL(), & + v_flux_boundary_values => NULL(), & + ! needed where u_face_mask is equal to 4, similary for v_face_mask + umask => NULL(), vmask => NULL(), & !< masks on the actual degrees of freedom (B grid) + !! 1=normal node, 3=inhomogeneous boundary node, + !! 0 - no flow node (will also get ice-free nodes) + calve_mask => NULL(), & !< a mask to prevent the ice shelf front from + !! advancing past its initial position (but it may + !! retreat) + !!! OVS !!! + t_shelf => NULL(), & ! veritcally integrated temperature the ice shelf/stream... oC + ! on q-points (B grid) + tmask => NULL(), & + ! masks for temperature boundary conditions ??? + ice_visc_bilinear => NULL(), & + thickness_boundary_values => NULL(), & + u_boundary_values => NULL(), & + v_boundary_values => NULL(), & + h_boundary_values => NULL(), & + t_boundary_values => NULL(), & + + taub_beta_eff_bilinear => NULL(), & ! nonlinear part of "linearized" basal stress - + ! exact form depends on basal law exponent + ! and/or whether flow is "hybridized" a la Goldberg 2011 + + OD_rt => NULL(), float_frac_rt => NULL(), & !< two arrays that represent averages + OD_av => NULL(), float_frac => NULL() !! of ocean values that are maintained + !! within the ice shelf module and updated based on the "ocean state". + !! OD_av is ocean depth, and float_frac is the average amount of time + !! a cell is "exposed", i.e. the column thickness is below a threshold. + !! both are averaged over the time of a diagnostic (ice velocity) + + !! [if float_frac = 1 ==> grounded; obv. counterintuitive; might fix] + + real :: density_ice !< A typical density of ice, in kg m-3. + + logical :: GL_regularize !< whether to regularize the floatation condition + !! at the grounding line a la Goldberg Holland Schoof 2009 + integer :: n_sub_regularize + !< partition of cell over which to integrate for + !! interpolated grounding line the (rectangular) is + !! divided into nxn equally-sized rectangles, over which + !! basal contribution is integrated (iterative quadrature) + logical :: GL_couple !< whether to let the floatation condition be + !!determined by ocean column thickness means update_OD_ffrac + !! will be called (note: GL_regularize and GL_couple + !! should be exclusive) + + + real :: A_glen_isothermal + real :: n_glen + real :: eps_glen_min + real :: C_basal_friction + real :: n_basal_friction + real :: density_ocean_avg !< this does not affect ocean circulation OR thermodynamics + !! it is to estimate the gravitational driving force at the + !! shelf front(until we think of a better way to do it- + !! but any difference will be negligible) + real :: thresh_float_col_depth ! the water column depth over which the shelf if considered to be floating + logical :: moving_shelf_front + logical :: calve_to_mask + real :: min_thickness_simple_calve ! min. ice shelf thickness criteria for calving + + + real :: cg_tolerance + real :: nonlinear_tolerance + integer :: cg_max_iterations + integer :: nonlin_solve_err_mode ! 1: exit vel solve based on nonlin residual + ! 2: exit based on "fixed point" metric (|u - u_last| / |u| < tol where | | is infty-norm + logical :: use_reproducing_sums !< use new reproducing sums of Bob & Alistair for global sums. + + ! ids for outputting intermediate thickness in advection subroutine (debugging) + !integer :: id_h_after_uflux = -1, id_h_after_vflux = -1, id_h_after_adv = -1 + +! type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to control diagnostic output. + + logical :: debug !< If true, write verbose checksums for debugging purposes + !! and use reproducible sums +end type ice_shelf_dyn_CS + integer :: id_clock_shelf, id_clock_pass !< Clock for group pass calls contains @@ -429,7 +449,7 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) !update time CS%Time = Time - if (CS%shelf_mass_is_dynamic .and. CS%override_shelf_movement) then + if (CS%override_shelf_movement) then CS%time_step = time_step ! update shelf mass if (CS%mass_from_file) call update_shelf_mass(G, CS, ISS, Time) @@ -517,11 +537,10 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) Sbdry(i,j) = MAX(Sbdry1, Sbdry2) ! Safety check if (Sbdry(i,j) < 0.) then - write(*,*)'state%sss(i,j)',state%sss(i,j) - write(*,*)'S_a, S_b, S_c',S_a, S_b, S_c - write(*,*)'I,J,Sbdry1,Sbdry2',i,j,Sbdry1,Sbdry2 - call MOM_error(FATAL, & - "shelf_calc_flux: Negative salinity (Sbdry).") + write(*,*)'state%sss(i,j)',state%sss(i,j) + write(*,*)'S_a, S_b, S_c',S_a, S_b, S_c + write(*,*)'I,J,Sbdry1,Sbdry2',i,j,Sbdry1,Sbdry2 + call MOM_error(FATAL, "shelf_calc_flux: Negative salinity (Sbdry).") endif else ! Guess sss as the iteration starting point for the boundary salinity. @@ -753,7 +772,7 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) mass_flux(:,:) = 0.0 mass_flux(:,:) = ISS%water_flux(:,:) * ISS%area_shelf_h(:,:) - if (CS%shelf_mass_is_dynamic) then + if (CS%active_shelf_dynamics .or. CS%override_shelf_movement) then call cpu_clock_begin(id_clock_pass) call pass_var(ISS%area_shelf_h, G%domain, complete=.false.) call pass_var(ISS%mass_shelf, G%domain) @@ -761,45 +780,39 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) endif ! Melting has been computed, now is time to update thickness and mass - if (CS%shelf_mass_is_dynamic .and. CS%override_shelf_movement) then - if (.not. (CS%mass_from_file)) then - - call change_thickness_using_melt(CS, ISS, G, time_step, fluxes) - - endif - + if ( CS%override_shelf_movement .and. (.not.CS%mass_from_file)) then + call change_thickness_using_melt(ISS, G, time_step, fluxes, CS%density_ice, CS%debug) endif - if (CS%DEBUG) then - call MOM_forcing_chksum("Before add shelf flux", fluxes, G, haloshift=0) - endif + if (CS%DEBUG) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, haloshift=0) + call add_shelf_flux(G, CS, state, forces, fluxes) ! now the thermodynamic data is passed on... time to update the ice dynamic quantities - if (CS%shelf_mass_is_dynamic .and. .not.CS%override_shelf_movement) then + if (CS%active_shelf_dynamics) then ! advect the ice shelf, and advance the front. Calving will be in here somewhere as well.. ! when we decide on how to do it ! note time_step is [s] and lprec is [kg / m^2 / s] - call ice_shelf_advect(CS, ISS, G, time_step, Time) + call ice_shelf_advect(CS%dCS, ISS, G, time_step, Time) CS%velocity_update_sub_counter = CS%velocity_update_sub_counter+1 if (CS%GL_couple .and. .not. CS%solo_ice_sheet) then - call update_OD_ffrac(CS, G, state%ocean_mass, CS%velocity_update_sub_counter, CS%nstep_velocity, & + call update_OD_ffrac(CS%dCS, G, state%ocean_mass, CS%velocity_update_sub_counter, CS%nstep_velocity, & CS%time_step, CS%velocity_update_time_step) else - call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf) + call update_OD_ffrac_uncoupled(CS%dCS, G, ISS%h_shelf) endif if (CS%velocity_update_sub_counter == CS%nstep_velocity) then - if (is_root_pe()) write(*,*) "ABOUT TO CALL VELOCITY SOLVER" + call MOM_mesg("MOM_ice_shelf.F90, shelf_calc_flux: About to call velocity solver") - call ice_shelf_solve_outer(CS, ISS, G, CS%u_shelf, CS%v_shelf, iters_vel_solve, Time) + call ice_shelf_solve_outer(CS%dCS, ISS, G, CS%dCS%u_shelf, CS%dCS%v_shelf, iters_vel_solve, Time) CS%velocity_update_sub_counter = 0 @@ -807,95 +820,93 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) endif call enable_averaging(time_step,Time,CS%diag) - if (CS%id_shelf_mass > 0) call post_data(CS%id_shelf_mass, ISS%mass_shelf, CS%diag) - if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, ISS%area_shelf_h, CS%diag) - if (CS%id_ustar_shelf > 0) call post_data(CS%id_ustar_shelf, fluxes%ustar_shelf, CS%diag) - if (CS%id_melt > 0) call post_data(CS%id_melt, fluxes%iceshelf_melt, CS%diag) - if (CS%id_thermal_driving > 0) call post_data(CS%id_thermal_driving, (state%sst-ISS%tfreeze), CS%diag) - if (CS%id_Sbdry > 0) call post_data(CS%id_Sbdry, Sbdry, CS%diag) - if (CS%id_haline_driving > 0) call post_data(CS%id_haline_driving, haline_driving, CS%diag) - if (CS%id_mass_flux > 0) call post_data(CS%id_mass_flux, mass_flux, CS%diag) - if (CS%id_u_ml > 0) call post_data(CS%id_u_ml,state%u,CS%diag) - if (CS%id_v_ml > 0) call post_data(CS%id_v_ml,state%v,CS%diag) - if (CS%id_tfreeze > 0) call post_data(CS%id_tfreeze, ISS%tfreeze, CS%diag) - if (CS%id_tfl_shelf > 0) call post_data(CS%id_tfl_shelf, ISS%tflux_shelf, CS%diag) - if (CS%id_exch_vel_t > 0) call post_data(CS%id_exch_vel_t, exch_vel_t, CS%diag) - if (CS%id_exch_vel_s > 0) call post_data(CS%id_exch_vel_s, exch_vel_s, CS%diag) - if (CS%id_col_thick > 0) call post_data(CS%id_col_thick, CS%OD_av, CS%diag) - if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf,ISS%h_shelf,CS%diag) - if (CS%id_h_mask > 0) call post_data(CS%id_h_mask,ISS%hmask,CS%diag) - if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf,CS%u_shelf,CS%diag) - if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf,CS%v_shelf,CS%diag) - if (CS%id_float_frac > 0) call post_data(CS%id_float_frac,CS%float_frac,CS%diag) - if (CS%id_OD_av >0) call post_data(CS%id_OD_av,CS%OD_av,CS%diag) - if (CS%id_float_frac_rt>0) call post_data(CS%id_float_frac_rt,CS%float_frac_rt,CS%diag) + if (CS%id_shelf_mass > 0) call post_data(CS%id_shelf_mass, ISS%mass_shelf, CS%diag) + if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, ISS%area_shelf_h, CS%diag) + if (CS%id_ustar_shelf > 0) call post_data(CS%id_ustar_shelf, fluxes%ustar_shelf, CS%diag) + if (CS%id_melt > 0) call post_data(CS%id_melt, fluxes%iceshelf_melt, CS%diag) + if (CS%id_thermal_driving > 0) call post_data(CS%id_thermal_driving, (state%sst-ISS%tfreeze), CS%diag) + if (CS%id_Sbdry > 0) call post_data(CS%id_Sbdry, Sbdry, CS%diag) + if (CS%id_haline_driving > 0) call post_data(CS%id_haline_driving, haline_driving, CS%diag) + if (CS%id_mass_flux > 0) call post_data(CS%id_mass_flux, mass_flux, CS%diag) + if (CS%id_u_ml > 0) call post_data(CS%id_u_ml, state%u, CS%diag) + if (CS%id_v_ml > 0) call post_data(CS%id_v_ml, state%v, CS%diag) + if (CS%id_tfreeze > 0) call post_data(CS%id_tfreeze, ISS%tfreeze, CS%diag) + if (CS%id_tfl_shelf > 0) call post_data(CS%id_tfl_shelf, ISS%tflux_shelf, CS%diag) + if (CS%id_exch_vel_t > 0) call post_data(CS%id_exch_vel_t, exch_vel_t, CS%diag) + if (CS%id_exch_vel_s > 0) call post_data(CS%id_exch_vel_s, exch_vel_s, CS%diag) + if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf,ISS%h_shelf,CS%diag) + if (CS%id_h_mask > 0) call post_data(CS%id_h_mask,ISS%hmask,CS%diag) + + if (CS%id_col_thick > 0) call post_data(CS%id_col_thick, CS%dCS%OD_av, CS%diag) + if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf,CS%dCS%u_shelf,CS%diag) + if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf,CS%dCS%v_shelf,CS%diag) + if (CS%id_float_frac > 0) call post_data(CS%id_float_frac,CS%dCS%float_frac,CS%diag) + if (CS%id_OD_av >0) call post_data(CS%id_OD_av,CS%dCS%OD_av,CS%diag) + if (CS%id_float_frac_rt>0) call post_data(CS%id_float_frac_rt,CS%dCS%float_frac_rt,CS%diag) call disable_averaging(CS%diag) call cpu_clock_end(id_clock_shelf) - if (CS%DEBUG) then - call MOM_forcing_chksum("End of shelf calc flux", fluxes, G, haloshift=0) - endif + if (CS%DEBUG) call MOM_forcing_chksum("End of shelf calc flux", fluxes, G, haloshift=0) end subroutine shelf_calc_flux !> Changes the thickness (mass) of the ice shelf based on sub-ice-shelf melting -subroutine change_thickness_using_melt(CS, ISS, G,time_step, fluxes) +subroutine change_thickness_using_melt(ISS, G,time_step, fluxes, rho_ice, debug) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(ice_shelf_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe !! the ice-shelf state real, intent(in) :: time_step type(forcing), intent(inout) :: fluxes + real, intent(in) :: rho_ice !< The density of ice-shelf ice, in kg m-3. + logical, optional, intent(in) :: debug !< If present and true, write chksums ! locals + real :: I_rho_ice integer :: i, j - do j=G%jsc,G%jec - do i=G%isc,G%iec + I_rho_ice = 1.0 / rho_ice - if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2)) then - ! first, zero out fluxes applied during previous time step - if (associated(fluxes%lprec)) fluxes%lprec(i,j) = 0.0 - if (associated(fluxes%sens)) fluxes%sens(i,j) = 0.0 - if (associated(fluxes%frac_shelf_h)) fluxes%frac_shelf_h(i,j) = 0.0 - if (associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = 0.0 - - if (ISS%water_flux(i,j) / CS%density_ice * time_step < ISS%h_shelf(i,j)) then - ISS%h_shelf(i,j) = ISS%h_shelf(i,j) - ISS%water_flux(i,j) / CS%density_ice * time_step - else - ! the ice is about to melt away - ! in this case set thickness, area, and mask to zero - ! NOTE: not mass conservative - ! should maybe scale salt & heat flux for this cell - - ISS%h_shelf(i,j) = 0.0 - ISS%hmask(i,j) = 0.0 - ISS%area_shelf_h(i,j) = 0.0 - endif - endif - enddo - enddo + do j=G%jsc,G%jec ; do i=G%isc,G%iec + if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2)) then + ! first, zero out fluxes applied during previous time step + if (associated(fluxes%lprec)) fluxes%lprec(i,j) = 0.0 + if (associated(fluxes%sens)) fluxes%sens(i,j) = 0.0 + if (associated(fluxes%frac_shelf_h)) fluxes%frac_shelf_h(i,j) = 0.0 + if (associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = 0.0 - call pass_var(ISS%area_shelf_h, G%domain) - call pass_var(ISS%h_shelf, G%domain) - call pass_var(ISS%hmask, G%domain) + if (ISS%water_flux(i,j) / rho_ice * time_step < ISS%h_shelf(i,j)) then + ISS%h_shelf(i,j) = ISS%h_shelf(i,j) - ISS%water_flux(i,j) / rho_ice * time_step + else + ! the ice is about to melt away + ! in this case set thickness, area, and mask to zero + ! NOTE: not mass conservative + ! should maybe scale salt & heat flux for this cell + + ISS%h_shelf(i,j) = 0.0 + ISS%hmask(i,j) = 0.0 + ISS%area_shelf_h(i,j) = 0.0 + endif + endif + enddo ; enddo - do j=G%jsd,G%jed - do i=G%isd,G%ied + call pass_var(ISS%area_shelf_h, G%domain) + call pass_var(ISS%h_shelf, G%domain) + call pass_var(ISS%hmask, G%domain) - if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2)) then - ISS%mass_shelf(i,j) = ISS%h_shelf(i,j)*CS%density_ice - endif - enddo - enddo + !### combine this with the loops above. + do j=G%jsd,G%jed ; do i=G%isd,G%ied + if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2)) then + ISS%mass_shelf(i,j) = ISS%h_shelf(i,j)*rho_ice + endif + enddo ; enddo - call pass_var(ISS%mass_shelf, G%domain) + call pass_var(ISS%mass_shelf, G%domain) - if (CS%DEBUG) then - call hchksum(ISS%h_shelf, "h_shelf after change thickness using melt", G%HI, haloshift=0) - call hchksum(ISS%mass_shelf, "mass_shelf after change thickness using melt", G%HI, haloshift=0) - endif + if (present(debug)) then ; if (debug) then + call hchksum(ISS%h_shelf, "h_shelf after change thickness using melt", G%HI, haloshift=0) + call hchksum(ISS%mass_shelf, "mass_shelf after change thickness using melt", G%HI, haloshift=0) + endif ; endif end subroutine change_thickness_using_melt @@ -909,7 +920,7 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1. real :: press_ice ! The pressure of the ice shelf per unit area of ocean (not ice) in Pa. -logical :: find_area ! If true find the shelf areas at u & v points. + logical :: find_area ! If true find the shelf areas at u & v points. type(ice_shelf_state), pointer :: ISS => NULL() ! A structure with elements that describe ! the ice-shelf state @@ -1011,13 +1022,15 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1. real, parameter :: rho_fw = 1000.0 ! fresh water density + logical :: find_shelf_area integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed ISS => CS%ISS - call add_shelf_forces(G, CS, forces, do_shelf_area=CS%shelf_mass_is_dynamic) + find_shelf_area = (CS%active_shelf_dynamics .or. CS%override_shelf_movement) + call add_shelf_forces(G, CS, forces, do_shelf_area=find_shelf_area) ! Determine ustar and the square magnitude of the velocity in the ! bottom boundary layer. Together these give the TKE source and @@ -1053,7 +1066,7 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) !fluxes%ustar(i,j) = MAX(CS%ustar_bg, sqrt(Irho0 * sqrt(taux2 + tauy2))) ! endif ; enddo ; enddo - if (CS%shelf_mass_is_dynamic) then + if (find_shelf_area) then do j=jsd,jed ; do i=isd,ied if (G%areaT(i,j) > 0.0) & fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) * G%IareaT(i,j) @@ -1112,8 +1125,7 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) enddo ; enddo ! take into account changes in mass (or thickness) when imposing ice shelf mass - if (CS%shelf_mass_is_dynamic .and. CS%override_shelf_movement .and. & - CS%mass_from_file) then + if (CS%override_shelf_movement .and. CS%mass_from_file) then t0 = time_type_to_real(CS%Time) - CS%time_step ! just compute changes in mass after first time step @@ -1125,7 +1137,8 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) ! apply calving if (CS%min_thickness_simple_calve > 0.0) then - call ice_shelf_min_thickness_calve(CS, G, last_h_shelf, last_area_shelf_h, last_hmask) + call ice_shelf_min_thickness_calve(G, last_h_shelf, last_area_shelf_h, last_hmask, & + CS%min_thickness_simple_calve) ! convert to mass again last_mass_shelf = last_h_shelf * CS%density_ice endif @@ -1135,7 +1148,7 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) do j=js,je ; do i=is,ie ! just floating shelf (0.1 is a threshold for min ocean thickness) if (((1.0/CS%density_ocean_avg)*state%ocean_mass(i,j) > 0.1) .and. & - (ISS%area_shelf_h(i,j) > 0.0)) then + (ISS%area_shelf_h(i,j) > 0.0)) then shelf_mass0 = shelf_mass0 + (last_mass_shelf(i,j) * ISS%area_shelf_h(i,j)) shelf_mass1 = shelf_mass1 + (ISS%mass_shelf(i,j) * ISS%area_shelf_h(i,j)) @@ -1171,11 +1184,11 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) enddo ; enddo if (CS%DEBUG) then - if (is_root_pe()) write(*,*)'Mean melt flux (kg/(m^2 s)),dt',mean_melt_flux,CS%time_step + if (is_root_pe()) write(*,*)'Mean melt flux (kg/(m^2 s)),dt',mean_melt_flux,CS%time_step call MOM_forcing_chksum("After constant sea level", fluxes, G, haloshift=0) endif - endif!constant_sea_level + endif !constant_sea_level call copy_common_forcing_fields(forces, fluxes, G) @@ -1197,6 +1210,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl type(ocean_grid_type), pointer :: G => NULL(), OG => NULL() ! Pointers to grids for convenience. type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe !! the ice-shelf state + type(ice_shelf_dyn_CS), pointer :: dCS => NULL() type(directories) :: dirs type(vardesc) :: vd type(dyn_horgrid_type), pointer :: dG => NULL() @@ -1212,7 +1226,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl character(len=2) :: procnum integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, Isdq, Iedq, Jsdq, Jedq, iters integer :: wd_halos(2) - logical :: read_TideAmp + logical :: read_TideAmp, shelf_mass_is_dynamic, debug character(len=240) :: Tideamp_file real :: utide if (associated(CS)) then @@ -1255,6 +1269,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl CS%Time = Time ! ### This might not be in the right place? CS%diag => diag + allocate(CS%dCS) ; dCS => CS%dCS + ! Are we being called from the solo ice-sheet driver? When called by the ocean ! model solo_ice_sheet_in is not preset. CS%solo_ice_sheet = .false. @@ -1267,28 +1283,35 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl Isdq = G%IsdB ; Iedq = G%IedB ; Jsdq = G%JsdB ; Jedq = G%JedB CS%Lat_fusion = 3.34e5 - CS%override_shelf_movement = .false. - - CS%use_reproducing_sums = .false. - CS%switch_var = .false. + CS%override_shelf_movement = .false. ; CS%active_shelf_dynamics = .false. call log_version(param_file, mdl, version, "") - call get_param(param_file, mdl, "DEBUG_IS", CS%debug, default=.false.) - call get_param(param_file, mdl, "DYNAMIC_SHELF_MASS", CS%shelf_mass_is_dynamic, & + call get_param(param_file, mdl, "DEBUG", debug, default=.false.) + call get_param(param_file, mdl, "DEBUG_IS", CS%debug, & + "If true, write verbose debugging messages for the ice shelf.", & + default=debug) + call get_param(param_file, mdl, "DEBUG_IS", dCS%debug, & + "If true, write verbose debugging messages for the ice shelf.", & + default=debug) + call get_param(param_file, mdl, "DYNAMIC_SHELF_MASS", shelf_mass_is_dynamic, & "If true, the ice sheet mass can evolve with time.", & default=.false.) - if (CS%shelf_mass_is_dynamic) then + if (shelf_mass_is_dynamic) then call get_param(param_file, mdl, "OVERRIDE_SHELF_MOVEMENT", CS%override_shelf_movement, & "If true, user provided code specifies the ice-shelf \n"//& "movement instead of the dynamic ice model.", default=.false.) - call get_param(param_file, mdl, "GROUNDING_LINE_INTERPOLATE", CS%GL_regularize, & + CS%active_shelf_dynamics = .not.CS%override_shelf_movement + call get_param(param_file, mdl, "GROUNDING_LINE_INTERPOLATE", dCS%GL_regularize, & "THIS PARAMETER NEEDS A DESCRIPTION.", default=.false.) - call get_param(param_file, mdl, "GROUNDING_LINE_INTERP_SUBGRID_N", CS%n_sub_regularize, & + CS%GL_regularize = dCS%GL_regularize + call get_param(param_file, mdl, "GROUNDING_LINE_INTERP_SUBGRID_N", dCS%n_sub_regularize, & "THIS PARAMETER NEEDS A DESCRIPTION.", default=0) call get_param(param_file, mdl, "GROUNDING_LINE_COUPLE", CS%GL_couple, & "THIS PARAMETER NEEDS A DESCRIPTION.", default=.false.) if (CS%GL_regularize) CS%GL_couple = .false. - if (CS%GL_regularize .and. (CS%n_sub_regularize == 0)) call MOM_error (FATAL, & + dCS%GL_couple = CS%GL_couple + if (dCS%GL_regularize) dCS%GL_couple = .false. + if (dCS%GL_regularize .and. (dCS%n_sub_regularize == 0)) call MOM_error (FATAL, & "GROUNDING_LINE_INTERP_SUBGRID_N must be a positive integer if GL regularization is used") endif call get_param(param_file, mdl, "SHELF_THERMO", CS%isthermo, & @@ -1398,9 +1421,10 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call get_param(param_file, mdl, "KD_TEMP_MOLECULAR", CS%kd_molec_temp, & "The molecular diffusivity of heat in sea water at the \n"//& "freezing point.", units="m2 s-1", default=1.41e-7) - call get_param(param_file, mdl, "RHO_0", CS%density_ocean_avg, & + call get_param(param_file, mdl, "RHO_0", dCS%density_ocean_avg, & "avg ocean density used in floatation cond", & units="kg m-3", default=1035.) + CS%density_ocean_avg = dCS%density_ocean_avg call get_param(param_file, mdl, "DT_FORCING", CS%time_step, & "The time step for changing forcing, coupling with other \n"//& "components, or potentially writing certain diagnostics. \n"//& @@ -1438,25 +1462,26 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl !! new parameters that need to be in MOM_input - if (CS%shelf_mass_is_dynamic .and. .not.CS%override_shelf_movement) then + if (CS%active_shelf_dynamics) then - call get_param(param_file, mdl, "A_GLEN_ISOTHERM", CS%A_glen_isothermal, & + call get_param(param_file, mdl, "A_GLEN_ISOTHERM", dCS%A_glen_isothermal, & "Ice viscosity parameter in Glen's Law", & units="Pa -1/3 a", default=9.461e-18) - call get_param(param_file, mdl, "GLEN_EXPONENT", CS%n_glen, & + call get_param(param_file, mdl, "GLEN_EXPONENT", dCS%n_glen, & "nonlinearity exponent in Glen's Law", & units="none", default=3.) - call get_param(param_file, mdl, "MIN_STRAIN_RATE_GLEN", CS%eps_glen_min, & + call get_param(param_file, mdl, "MIN_STRAIN_RATE_GLEN", dCS%eps_glen_min, & "min. strain rate to avoid infinite Glen's law viscosity", & units="a-1", default=1.e-12) - call get_param(param_file, mdl, "BASAL_FRICTION_COEFF", CS%C_basal_friction, & + call get_param(param_file, mdl, "BASAL_FRICTION_COEFF", dCS%C_basal_friction, & "ceofficient in sliding law \tau_b = C u^(n_basal_friction)", & units="Pa (m-a)-(n_basal_friction)", fail_if_missing=.true.) - call get_param(param_file, mdl, "BASAL_FRICTION_EXP", CS%n_basal_friction, & + call get_param(param_file, mdl, "BASAL_FRICTION_EXP", dCS%n_basal_friction, & "exponent in sliding law \tau_b = C u^(m_slide)", & units="none", fail_if_missing=.true.) call get_param(param_file, mdl, "DENSITY_ICE", CS%density_ice, & "A typical density of ice.", units="kg m-3", default=917.0) + dCS%density_ice = CS%density_ice call get_param(param_file, mdl, "INPUT_FLUX_ICE_SHELF", CS%input_flux, & "volume flux at upstream boundary", & @@ -1468,32 +1493,32 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl "seconds between ice velocity calcs", units="s", & fail_if_missing=.true.) - call get_param(param_file, mdl, "CONJUGATE_GRADIENT_TOLERANCE", CS%cg_tolerance, & + call get_param(param_file, mdl, "CONJUGATE_GRADIENT_TOLERANCE", dCS%cg_tolerance, & "tolerance in CG solver, relative to initial residual", default=1.e-6) - call get_param(param_file, mdl, "ICE_NONLINEAR_TOLERANCE", & - CS%nonlinear_tolerance,"nonlin tolerance in iterative velocity solve",default=1.e-6) - call get_param(param_file, mdl, "CONJUGATE_GRADIENT_MAXIT", CS%cg_max_iterations, & + call get_param(param_file, mdl, "ICE_NONLINEAR_TOLERANCE", dCS%nonlinear_tolerance, & + "nonlin tolerance in iterative velocity solve",default=1.e-6) + call get_param(param_file, mdl, "CONJUGATE_GRADIENT_MAXIT", dCS%cg_max_iterations, & "max iteratiions in CG solver", default=2000) - call get_param(param_file, mdl, "THRESH_FLOAT_COL_DEPTH", CS%thresh_float_col_depth, & + call get_param(param_file, mdl, "THRESH_FLOAT_COL_DEPTH", dCS%thresh_float_col_depth, & "min ocean thickness to consider ice *floating*; \n"// & "will only be important with use of tides", & units="m",default=1.e-3) - call get_param(param_file, mdl, "SHELF_MOVING_FRONT", CS%moving_shelf_front, & + call get_param(param_file, mdl, "SHELF_MOVING_FRONT", dCS%moving_shelf_front, & "whether or not to advance shelf front (and calve..)") - call get_param(param_file, mdl, "CALVE_TO_MASK", CS%calve_to_mask, & + call get_param(param_file, mdl, "CALVE_TO_MASK", dCS%calve_to_mask, & "if true, do not allow an ice shelf where prohibited by a mask") call get_param(param_file, mdl, "ICE_SHELF_CFL_FACTOR", CS%CFL_factor, & "limit timestep as a factor of min (\Delta x / u); \n"// & "only important for ice-only model", & default=0.25) - call get_param(param_file, mdl, "NONLIN_SOLVE_ERR_MODE", CS%nonlin_solve_err_mode, & + call get_param(param_file, mdl, "NONLIN_SOLVE_ERR_MODE", dCS%nonlin_solve_err_mode, & "choose whether nonlin error in vel solve is based on nonlinear residual (1) \n"// & "or relative change since last iteration (2)", & default=1) - - - if (CS%debug) CS%use_reproducing_sums = .true. + call get_param(param_file, mdl, "SHELF_DYN_REPRODUCING_SUMS", dCS%use_reproducing_sums, & + "If true, use the reproducing extended-fixed-point sums in the ice \n"//& + "shelf dynamics solvers.", default=.true.) CS%nstep_velocity = FLOOR (CS%velocity_update_time_step / CS%time_step) CS%velocity_update_counter = 0 @@ -1508,10 +1533,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call get_param(param_file, mdl, "MIN_THICKNESS_SIMPLE_CALVE", & CS%min_thickness_simple_calve, & "min thickness rule for VERY simple calving law",& - units="m", default=0.0) - - call get_param(param_file, mdl, "WRITE_OUTPUT_TO_FILE", & - CS%write_output_to_file, "for debugging purposes",default=.false.) + units="m", default=0.0) + dCS%min_thickness_simple_calve = CS%min_thickness_simple_calve call get_param(param_file, mdl, "USTAR_SHELF_BG", CS%ustar_bg, & "The minimum value of ustar under ice sheves.", units="m s-1", & @@ -1536,43 +1559,43 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ISS => CS%ISS ! OVS vertically integrated Temperature - allocate( CS%t_shelf(isd:ied,jsd:jed) ) ; CS%t_shelf(:,:) = -10.0 - allocate( CS%t_boundary_values(isd:ied,jsd:jed) ) ; CS%t_boundary_values(:,:) = -15.0 - allocate( CS%tmask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%tmask(:,:) = -1.0 + allocate( dCS%t_shelf(isd:ied,jsd:jed) ) ; dCS%t_shelf(:,:) = -10.0 + allocate( dCS%t_boundary_values(isd:ied,jsd:jed) ) ; dCS%t_boundary_values(:,:) = -15.0 + allocate( dCS%tmask(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%tmask(:,:) = -1.0 - if (CS%shelf_mass_is_dynamic .and. .not.CS%override_shelf_movement) then + if (CS%active_shelf_dynamics) then ! DNG - allocate( CS%u_shelf(Isdq:Iedq,Jsdq:Jedq) ) ; CS%u_shelf(:,:) = 0.0 - allocate( CS%v_shelf(Isdq:Iedq,Jsdq:Jedq) ) ; CS%v_shelf(:,:) = 0.0 - allocate( CS%u_boundary_values(Isdq:Iedq,Jsdq:Jedq) ) ; CS%u_boundary_values(:,:) = 0.0 - allocate( CS%v_boundary_values(Isdq:Iedq,Jsdq:Jedq) ) ; CS%v_boundary_values(:,:) = 0.0 - allocate( CS%h_boundary_values(isd:ied,jsd:jed) ) ; CS%h_boundary_values(:,:) = 0.0 - allocate( CS%thickness_boundary_values(isd:ied,jsd:jed) ) ; CS%thickness_boundary_values(:,:) = 0.0 - allocate( CS%ice_visc_bilinear(isd:ied,jsd:jed) ) ; CS%ice_visc_bilinear(:,:) = 0.0 - allocate( CS%u_face_mask(Isdq:Iedq,jsd:jed) ) ; CS%u_face_mask(:,:) = 0.0 - allocate( CS%v_face_mask(isd:ied,Jsdq:Jedq) ) ; CS%v_face_mask(:,:) = 0.0 - allocate( CS%u_face_mask_boundary(Isdq:Iedq,jsd:jed) ) ; CS%u_face_mask_boundary(:,:) = -2.0 - allocate( CS%v_face_mask_boundary(isd:ied,Jsdq:Jedq) ) ; CS%v_face_mask_boundary(:,:) = -2.0 - allocate( CS%u_flux_boundary_values(Isdq:Iedq,jsd:jed) ) ; CS%u_flux_boundary_values(:,:) = 0.0 - allocate( CS%v_flux_boundary_values(isd:ied,Jsdq:Jedq) ) ; CS%v_flux_boundary_values(:,:) = 0.0 - allocate( CS%umask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%umask(:,:) = -1.0 - allocate( CS%vmask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%vmask(:,:) = -1.0 - - allocate( CS%taub_beta_eff_bilinear(isd:ied,jsd:jed) ) ; CS%taub_beta_eff_bilinear(:,:) = 0.0 - allocate( CS%OD_rt(isd:ied,jsd:jed) ) ; CS%OD_rt(:,:) = 0.0 - allocate( CS%OD_av(isd:ied,jsd:jed) ) ; CS%OD_av(:,:) = 0.0 - allocate( CS%float_frac(isd:ied,jsd:jed) ) ; CS%float_frac(:,:) = 0.0 - allocate( CS%float_frac_rt(isd:ied,jsd:jed) ) ; CS%float_frac_rt(:,:) = 0.0 - - if (CS%calve_to_mask) then - allocate( CS%calve_mask(isd:ied,jsd:jed) ) ; CS%calve_mask(:,:) = 0.0 + allocate( dCS%u_shelf(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%u_shelf(:,:) = 0.0 + allocate( dCS%v_shelf(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%v_shelf(:,:) = 0.0 + allocate( dCS%u_boundary_values(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%u_boundary_values(:,:) = 0.0 + allocate( dCS%v_boundary_values(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%v_boundary_values(:,:) = 0.0 + allocate( dCS%h_boundary_values(isd:ied,jsd:jed) ) ; dCS%h_boundary_values(:,:) = 0.0 + allocate( dCS%thickness_boundary_values(isd:ied,jsd:jed) ) ; dCS%thickness_boundary_values(:,:) = 0.0 + allocate( dCS%ice_visc_bilinear(isd:ied,jsd:jed) ) ; dCS%ice_visc_bilinear(:,:) = 0.0 + allocate( dCS%u_face_mask(Isdq:Iedq,jsd:jed) ) ; dCS%u_face_mask(:,:) = 0.0 + allocate( dCS%v_face_mask(isd:ied,Jsdq:Jedq) ) ; dCS%v_face_mask(:,:) = 0.0 + allocate( dCS%u_face_mask_boundary(Isdq:Iedq,jsd:jed) ) ; dCS%u_face_mask_boundary(:,:) = -2.0 + allocate( dCS%v_face_mask_boundary(isd:ied,Jsdq:Jedq) ) ; dCS%v_face_mask_boundary(:,:) = -2.0 + allocate( dCS%u_flux_boundary_values(Isdq:Iedq,jsd:jed) ) ; dCS%u_flux_boundary_values(:,:) = 0.0 + allocate( dCS%v_flux_boundary_values(isd:ied,Jsdq:Jedq) ) ; dCS%v_flux_boundary_values(:,:) = 0.0 + allocate( dCS%umask(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%umask(:,:) = -1.0 + allocate( dCS%vmask(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%vmask(:,:) = -1.0 + + allocate( dCS%taub_beta_eff_bilinear(isd:ied,jsd:jed) ) ; dCS%taub_beta_eff_bilinear(:,:) = 0.0 + allocate( dCS%OD_rt(isd:ied,jsd:jed) ) ; dCS%OD_rt(:,:) = 0.0 + allocate( dCS%OD_av(isd:ied,jsd:jed) ) ; dCS%OD_av(:,:) = 0.0 + allocate( dCS%float_frac(isd:ied,jsd:jed) ) ; dCS%float_frac(:,:) = 0.0 + allocate( dCS%float_frac_rt(isd:ied,jsd:jed) ) ; dCS%float_frac_rt(:,:) = 0.0 + + if (dCS%calve_to_mask) then + allocate( dCS%calve_mask(isd:ied,jsd:jed) ) ; dCS%calve_mask(:,:) = 0.0 endif endif ! Allocate the arrays for passing ice-shelf data through the forcing type. if (.not. CS%solo_ice_sheet) then - if (is_root_pe()) print *,"initialize_ice_shelf: allocating fluxes" + call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: allocating fluxes.") ! GMM: the following assures that water/heat fluxes are just allocated ! when SHELF_THERMO = True. These fluxes are necessary if one wants to ! use either ENERGETICS_SFC_PBL (ALE mode) or BULKMIXEDLAYER (layer mode). @@ -1580,10 +1603,9 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call allocate_forcing_type(G, fluxes, ustar=.true., shelf=.true., & press=.true., water=CS%isthermo, heat=CS%isthermo) if (present(forces)) & - call allocate_mech_forcing(G, forces, ustar=.true., shelf=.true., & - press=.true.) + call allocate_mech_forcing(G, forces, ustar=.true., shelf=.true., press=.true.) else - if (is_root_pe()) print *,"allocating fluxes in solo mode" + call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: allocating fluxes in solo mode.") if (present(fluxes)) & call allocate_forcing_type(G, fluxes, ustar=.true., shelf=.true., press=.true.) if (present(forces)) & @@ -1607,12 +1629,12 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl vd = var_desc("h_shelf","m","ice sheet/shelf thickness",z_grid='1') call register_restart_field(ISS%h_shelf, vd, .true., CS%restart_CSp) - if (CS%shelf_mass_is_dynamic .and. .not.CS%override_shelf_movement) then + if (CS%active_shelf_dynamics) then ! additional restarts for ice shelf state vd = var_desc("u_shelf","m s-1","ice sheet/shelf velocity",'q',z_grid='1') - call register_restart_field(CS%u_shelf, vd, .true., CS%restart_CSp) + call register_restart_field(dCS%u_shelf, vd, .true., CS%restart_CSp) vd = var_desc("v_shelf","m s-1","ice sheet/shelf velocity",'q',z_grid='1') - call register_restart_field(CS%v_shelf, vd, .true., CS%restart_CSp) + call register_restart_field(dCS%v_shelf, vd, .true., CS%restart_CSp) !vd = var_desc("h_shelf","m","ice sheet/shelf thickness",z_grid='1') !call register_restart_field(ISS%h_shelf, vd, .true., CS%restart_CSp) @@ -1621,28 +1643,28 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! OVS vertically integrated stream/shelf temperature vd = var_desc("t_shelf","deg C","ice sheet/shelf temperature",z_grid='1') - call register_restart_field(CS%t_shelf, vd, .true., CS%restart_CSp) + call register_restart_field(dCS%t_shelf, vd, .true., CS%restart_CSp) ! vd = var_desc("area_shelf_h","m-2","ice-covered area of a cell",z_grid='1') ! call register_restart_field(ISS%area_shelf_h, vd, .true., CS%restart_CSp) vd = var_desc("OD_av","m","avg ocean depth in a cell",z_grid='1') - call register_restart_field(CS%OD_av, vd, .true., CS%restart_CSp) + call register_restart_field(dCS%OD_av, vd, .true., CS%restart_CSp) ! vd = var_desc("OD_av_rt","m","avg ocean depth in a cell, intermed",z_grid='1') - ! call register_restart_field(CS%OD_av_rt, CS%OD_av_rt, vd, .true., CS%restart_CSp) + ! call register_restart_field(dCS%OD_av_rt, CS%OD_av_rt, vd, .true., CS%restart_CSp) vd = var_desc("float_frac","m","degree of grounding",z_grid='1') - call register_restart_field(CS%float_frac, vd, .true., CS%restart_CSp) + call register_restart_field(dCS%float_frac, vd, .true., CS%restart_CSp) ! vd = var_desc("float_frac_rt","m","degree of grounding, intermed",z_grid='1') - ! call register_restart_field(CS%float_frac_rt, CS%float_frac_rt, vd, .true., CS%restart_CSp) + ! call register_restart_field(dCS%float_frac_rt, CS%float_frac_rt, vd, .true., CS%restart_CSp) vd = var_desc("viscosity","m","glens law ice visc",z_grid='1') - call register_restart_field(CS%ice_visc_bilinear, vd, .true., CS%restart_CSp) + call register_restart_field(dCS%ice_visc_bilinear, vd, .true., CS%restart_CSp) vd = var_desc("tau_b_beta","m","coefficient of basal traction",z_grid='1') - call register_restart_field(CS%taub_beta_eff_bilinear, vd, .true., CS%restart_CSp) + call register_restart_field(dCS%taub_beta_eff_bilinear, vd, .true., CS%restart_CSp) endif !GMM - I think we do not need to save ustar_shelf and iceshelf_melt in the restart file @@ -1669,34 +1691,26 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call initialize_ice_thickness(ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, G, param_file) ! next make sure mass is consistent with thickness - do j=G%jsd,G%jed - do i=G%isd,G%ied + do j=G%jsd,G%jed ; do i=G%isd,G%ied if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2)) then - ISS%mass_shelf(i,j) = ISS%h_shelf(i,j)*CS%density_ice + ISS%mass_shelf(i,j) = ISS%h_shelf(i,j)*CS%density_ice endif - enddo - enddo + enddo ; enddo - if (CS%min_thickness_simple_calve > 0.0) then - call ice_shelf_min_thickness_calve(CS, G, ISS%h_shelf, ISS%area_shelf_h, ISS%hmask) - endif + if (CS%min_thickness_simple_calve > 0.0) & + call ice_shelf_min_thickness_calve(G, ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, & + CS%min_thickness_simple_calve) endif - - ! elseif (CS%shelf_mass_is_dynamic) then - ! call initialize_ice_shelf_boundary ( CS%u_face_mask_boundary, CS%v_face_mask_boundary, & - ! CS%u_flux_boundary_values, CS%v_flux_boundary_values, & - ! CS%u_boundary_values, CS%v_boundary_values, CS%h_boundary_values, & -! ISS%hmask, G, param_file) endif - if (CS%shelf_mass_is_dynamic .and. .not. CS%override_shelf_movement) then - ! the only reason to initialize boundary conds is if the shelf is dynamic + if (CS%active_shelf_dynamics) then + ! the only reason to initialize boundary conds is if the shelf is dynamic - MJH - !MJHcall initialize_ice_shelf_boundary ( CS%u_face_mask_boundary, CS%v_face_mask_boundary, & - !MJH CS%u_flux_boundary_values, CS%v_flux_boundary_values, & - !MJH CS%u_boundary_values, CS%v_boundary_values, CS%h_boundary_values, & - !MJH ISS%hmask, G, param_file) + ! call initialize_ice_shelf_boundary ( CS%u_face_mask_boundary, CS%v_face_mask_boundary, & + ! CS%u_flux_boundary_values, CS%v_flux_boundary_values, & + ! CS%u_boundary_values, CS%v_boundary_values, CS%h_boundary_values, & + ! ISS%hmask, G, param_file) endif @@ -1725,7 +1739,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! the dirichlet boundary, and now this is done elsewhere ! call initialize_shelf_mass(G, param_file, CS, ISS, .false.) - if (CS%shelf_mass_is_dynamic .and. .not.CS%override_shelf_movement) then + if (CS%active_shelf_dynamics) then ! this is unfortunately necessary; if grid is not symmetric the boundary values ! of u and v are otherwise not set till the end of the first linear solve, and so @@ -1733,28 +1747,28 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if (.not. G%symmetric) then do j=G%jsd,G%jed do i=G%isd,G%ied - if (((i+G%idg_offset) == (G%domain%nihalo+1)).and.(CS%u_face_mask(i-1,j) == 3)) then - CS%u_shelf(i-1,j-1) = CS%u_boundary_values(i-1,j-1) - CS%u_shelf(i-1,j) = CS%u_boundary_values(i-1,j) + if (((i+G%idg_offset) == (G%domain%nihalo+1)).and.(dCS%u_face_mask(i-1,j) == 3)) then + dCS%u_shelf(i-1,j-1) = dCS%u_boundary_values(i-1,j-1) + dCS%u_shelf(i-1,j) = dCS%u_boundary_values(i-1,j) endif - if (((j+G%jdg_offset) == (G%domain%njhalo+1)).and.(CS%v_face_mask(i,j-1) == 3)) then - CS%u_shelf(i-1,j-1) = CS%u_boundary_values(i-1,j-1) - CS%u_shelf(i,j-1) = CS%u_boundary_values(i,j-1) + if (((j+G%jdg_offset) == (G%domain%njhalo+1)).and.(dCS%v_face_mask(i,j-1) == 3)) then + dCS%u_shelf(i-1,j-1) = dCS%u_boundary_values(i-1,j-1) + dCS%u_shelf(i,j-1) = dCS%u_boundary_values(i,j-1) endif enddo enddo endif - call pass_var(CS%OD_av,G%domain) - call pass_var(CS%float_frac,G%domain) - call pass_var(CS%ice_visc_bilinear,G%domain) - call pass_var(CS%taub_beta_eff_bilinear,G%domain) - call pass_vector(CS%u_shelf, CS%v_shelf, G%domain, TO_ALL, BGRID_NE) + call pass_var(dCS%OD_av,G%domain) + call pass_var(dCS%float_frac,G%domain) + call pass_var(dCS%ice_visc_bilinear,G%domain) + call pass_var(dCS%taub_beta_eff_bilinear,G%domain) + call pass_vector(dCS%u_shelf, dCS%v_shelf, G%domain, TO_ALL, BGRID_NE) call pass_var(ISS%area_shelf_h,G%domain) call pass_var(ISS%h_shelf,G%domain) call pass_var(ISS%hmask,G%domain) - if (is_root_pe()) PRINT *, "RESTORING ICE SHELF FROM FILE!!!!!!!!!!!!!" + call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: Restoring ice shelf from file.") endif endif ! .not. new_sim @@ -1766,11 +1780,11 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call pass_var(ISS%mass_shelf, G%domain) ! Transfer the appropriate fields to the forcing type. - if (CS%shelf_mass_is_dynamic .and. .not.CS%override_shelf_movement) then + if (CS%active_shelf_dynamics) then call cpu_clock_begin(id_clock_pass) call pass_var(G%bathyT, G%domain) call pass_var(ISS%hmask, G%domain) - call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) + call update_velocity_masks(dCS, G, ISS%hmask, dCS%umask, dCS%vmask, dCS%u_face_mask, dCS%v_face_mask) call cpu_clock_end(id_clock_pass) endif @@ -1798,52 +1812,48 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! if we are calving to a mask, i.e. if a mask exists where a shelf cannot, then we read ! the mask from a file - if (CS%shelf_mass_is_dynamic .and. CS%calve_to_mask .and. & - .not.CS%override_shelf_movement) then + if (CS%active_shelf_dynamics) then + if (dCS%calve_to_mask) then - call MOM_mesg(" MOM_ice_shelf.F90, initialize_ice_shelf: reading calving_mask") + call MOM_mesg(" MOM_ice_shelf.F90, initialize_ice_shelf: reading calving_mask") - call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") - inputdir = slasher(inputdir) - call get_param(param_file, mdl, "CALVING_MASK_FILE", IC_file, & - "The file with a mask for where calving might occur.", & - default="ice_shelf_h.nc") - call get_param(param_file, mdl, "CALVING_MASK_VARNAME", var_name, & - "The variable to use in masking calving.", & - default="area_shelf_h") - - filename = trim(inputdir)//trim(IC_file) - call log_param(param_file, mdl, "INPUTDIR/CALVING_MASK_FILE", filename) - if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & - " calving mask file: Unable to open "//trim(filename)) - - call MOM_read_data(filename,trim(var_name),CS%calve_mask,G%Domain) - do j=G%jsc,G%jec - do i=G%isc,G%iec - if (CS%calve_mask(i,j) > 0.0) CS%calve_mask(i,j) = 1.0 + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") + inputdir = slasher(inputdir) + call get_param(param_file, mdl, "CALVING_MASK_FILE", IC_file, & + "The file with a mask for where calving might occur.", & + default="ice_shelf_h.nc") + call get_param(param_file, mdl, "CALVING_MASK_VARNAME", var_name, & + "The variable to use in masking calving.", & + default="area_shelf_h") + + filename = trim(inputdir)//trim(IC_file) + call log_param(param_file, mdl, "INPUTDIR/CALVING_MASK_FILE", filename) + if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & + " calving mask file: Unable to open "//trim(filename)) + + call MOM_read_data(filename,trim(var_name),dCS%calve_mask,G%Domain) + do j=G%jsc,G%jec + do i=G%isc,G%iec + if (dCS%calve_mask(i,j) > 0.0) dCS%calve_mask(i,j) = 1.0 + enddo enddo - enddo - call pass_var(CS%calve_mask,G%domain) - endif + call pass_var(dCS%calve_mask,G%domain) + endif - if (CS%shelf_mass_is_dynamic .and. .not.CS%override_shelf_movement) then ! call init_boundary_values(CS, G, time, ISS%hmask, CS%input_flux, CS%input_thickness, new_sim) if (.not. CS%isthermo) then ISS%water_flux(:,:) = 0.0 endif - if (new_sim) then - if (is_root_pe()) print *,"NEW SIM: initialize velocity" - call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf) - call ice_shelf_solve_outer(CS, ISS, G, CS%u_shelf, CS%v_shelf, iters, Time) - -! write (procnum,'(I2)') mpp_pe() + call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") + call update_OD_ffrac_uncoupled(dCS, G, ISS%h_shelf) + call ice_shelf_solve_outer(dCS, ISS, G, dCS%u_shelf, dCS%v_shelf, iters, Time) - if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf,CS%u_shelf,CS%diag) - if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf,CS%v_shelf,CS%diag) + if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf,dCS%u_shelf,CS%diag) + if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf,dCS%v_shelf,CS%diag) endif endif @@ -1891,7 +1901,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl CS%id_ustar_shelf = register_diag_field('ocean_model', 'ustar_shelf', CS%diag%axesT1, CS%Time, & 'Fric vel under shelf', 'm/s') - if (CS%shelf_mass_is_dynamic .and. .not.CS%override_shelf_movement) then + if (CS%active_shelf_dynamics) then CS%id_u_shelf = register_diag_field('ocean_model','u_shelf',CS%diag%axesCu1,CS%Time, & 'x-velocity of ice', 'm yr-1') CS%id_v_shelf = register_diag_field('ocean_model','v_shelf',CS%diag%axesCv1,CS%Time, & @@ -2023,7 +2033,7 @@ subroutine update_shelf_mass(G, CS, ISS, Time) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(inout) :: ISS !< The ice shelf state type that is being updated - type(time_type), intent(in) :: Time + type(time_type), intent(in) :: Time ! local variables integer :: i, j, is, ie, js, je @@ -2045,7 +2055,8 @@ subroutine update_shelf_mass(G, CS, ISS, Time) ! ISS%hmask, CS%grid, CS%user_CS, Time, .true.) if (CS%min_thickness_simple_calve > 0.0) then - call ice_shelf_min_thickness_calve(CS, G, ISS%h_shelf, ISS%area_shelf_h, ISS%hmask) + call ice_shelf_min_thickness_calve(G, ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, & + CS%min_thickness_simple_calve) endif call pass_var(ISS%area_shelf_h, G%domain) @@ -2056,11 +2067,11 @@ subroutine update_shelf_mass(G, CS, ISS, Time) end subroutine update_shelf_mass subroutine initialize_diagnostic_fields(CS, ISS, G, Time) - type(ice_shelf_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - type(time_type), intent(in) :: Time + type(time_type), intent(in) :: Time integer :: i, j, iters, isd, ied, jsd, jed real :: rhoi, rhow, OD @@ -2106,17 +2117,6 @@ subroutine ice_shelf_save_restart(CS, Time, directory, time_stamped, filename_su G => CS%grid -! write (procnum,'(I2)') mpp_pe() - - !### THESE ARE ONLY HERE FOR DEBUGGING? -! call savearray2 ("U_before_"//"p"//trim(procnum),CS%u_shelf,CS%write_output_to_file) -! call savearray2 ("V_before_"//"p"//trim(procnum),CS%v_shelf,CS%write_output_to_file) -! call savearray2 ("H_before_"//"p"//trim(procnum),ISS%h_shelf,CS%write_output_to_file) -! call savearray2 ("Hmask_before_"//"p"//trim(procnum),ISS%hmask,CS%write_output_to_file) -! call savearray2 ("Harea_before_"//"p"//trim(procnum),ISS%area_shelf_h,CS%write_output_to_file) -! call savearray2 ("Visc_before_"//"p"//trim(procnum),CS%ice_visc_bilinear,CS%write_output_to_file) -! call savearray2 ("taub_before_"//"p"//trim(procnum),CS%taub_beta_eff_bilinear,CS%write_output_to_file) -! call savearray2 ("taub_before_"//"p"//trim(procnum),CS%taub_beta_eff_bilinear,CS%write_output_to_file) if (present(directory)) then ; restart_dir = directory else ; restart_dir = CS%restart_output_dir ; endif @@ -2126,7 +2126,7 @@ end subroutine ice_shelf_save_restart subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) - type(ice_shelf_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. @@ -2186,7 +2186,7 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) h_after_uflux(:,:) = 0.0 h_after_vflux(:,:) = 0.0 -! if (is_root_pe()) write(*,*) "ice_shelf_advect called" + ! call MOM_mesg("MOM_ice_shelf.F90: ice_shelf_advect called") do j=jsd,jed do i=isd,ied @@ -2220,10 +2220,11 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) if (CS%moving_shelf_front) then call shelf_advance_front(CS, ISS, G, flux_enter) if (CS%min_thickness_simple_calve > 0.0) then - call ice_shelf_min_thickness_calve(CS, G, ISS%h_shelf, ISS%area_shelf_h, ISS%hmask) + call ice_shelf_min_thickness_calve(G, ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, & + CS%min_thickness_simple_calve) endif if (CS%calve_to_mask) then - call calve_to_mask(CS, G, ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, CS%calve_mask) + call calve_to_mask(G, ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, CS%calve_mask) endif endif @@ -2231,14 +2232,14 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) !if (CS%id_h_after_adv > 0) call post_data(CS%id_h_after_adv, ISS%h_shelf, CS%diag) !call disable_averaging(CS%diag) - !call change_thickness_using_melt(CS, ISS, G,time_step, fluxes) + !call change_thickness_using_melt(ISS, G, time_step, fluxes, CS%density_ice) call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) end subroutine ice_shelf_advect subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) - type(ice_shelf_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. @@ -2298,7 +2299,6 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) if (CS%GL_regularize) then call interpolate_H_to_B(G, ISS%h_shelf, ISS%hmask, H_node) - call savearray2 ("H_node",H_node,CS%write_output_to_file) do j=G%jsc,G%jec do i=G%isc,G%iec @@ -2312,20 +2312,16 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) enddo enddo if ((nodefloat > 0) .and. (nodefloat < 4)) then - !print *,"nodefloat",nodefloat float_cond(i,j) = 1.0 CS%float_frac(i,j) = 1.0 endif enddo enddo - call savearray2 ("float_cond",float_cond,CS%write_output_to_file) call pass_var(float_cond, G%Domain) call bilinear_shape_functions_subgrid(Phisub, nsub) - call savearray2("Phisub1111",Phisub(:,:,1,1,1,1),CS%write_output_to_file) - endif ! make above conditional @@ -2400,7 +2396,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) do iter=1,100 - call ice_shelf_solve_inner(CS, G, u, v, TAUDX, TAUDY, H_node, float_cond, & + call ice_shelf_solve_inner(CS, ISS, G, u, v, TAUDX, TAUDY, H_node, float_cond, & ISS%hmask, conv_flag, iters, time, Phi, Phisub) if (CS%DEBUG) then @@ -2414,10 +2410,6 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) call pass_var(CS%ice_visc_bilinear, G%domain) call pass_var(CS%taub_beta_eff_bilinear, G%domain) - if (iter == 1) then -! call savearray2 ("visc1",CS%ice_visc_bilinear,CS%write_output_to_file) - endif - ! makes sure basal stress is only applied when it is supposed to be do j=G%jsd,G%jed ; do i=G%isd,G%ied @@ -2506,9 +2498,11 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) end subroutine ice_shelf_solve_outer -subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, & +subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_cond, & hmask, conv_flag, iters, time, Phi, Phisub) - type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe + !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u, v real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: taudx, taudy, H_node @@ -2562,7 +2556,7 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, ! Include the edge if tile is at the southern bdry; Should add a test to avoid this if reentrant. if (G%jsc+G%jdg_offset==G%jsg) jsumstart = G%jscB - call apply_boundary_values_bilinear(CS, CS%ISS, G, time, Phisub, H_node, CS%ice_visc_bilinear, & + call apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, CS%ice_visc_bilinear, & CS%taub_beta_eff_bilinear, float_cond, & CS%density_ice/CS%density_ocean_avg, ubd, vbd) @@ -2835,18 +2829,10 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, dot_p1 = reproducing_sum( sum_vec, isumstart+(1-G%IsdB), Iecq+(1-G%IsdB), & jsumstart+(1-G%JsdB), jecq+(1-G%JsdB) ) - -! if (is_root_pe()) print *, dot_p1 -! if (is_root_pe()) print *, dot_p1a - endif dot_p1 = sqrt (dot_p1) -! if (mpp_pe () == 0) then -! print *,"|r|",dot_p1 -! endif - if (dot_p1 <= CS%cg_tolerance * resid0) then iters = iter conv_flag = 1 @@ -2890,7 +2876,7 @@ subroutine ice_shelf_solve_inner(CS, G, u, v, taudx, taudy, H_node, float_cond, end subroutine ice_shelf_solve_inner subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_uflux, flux_enter) - type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask @@ -2972,10 +2958,6 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl ! get u-velocity at center of left face u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - ! if (at_west_bdry .and. (i == G%isc)) then - ! print *, j, u_face, stencil(-1) - ! endif - if (u_face > 0) then !flux is into cell - we need info from h(i-2), h(i-1) if available ! i may not cover all the cases.. but i cover the realistic ones @@ -3119,7 +3101,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl end subroutine ice_shelf_advect_thickness_x subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, h_after_vflux, flux_enter) - type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask @@ -3322,7 +3304,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, end subroutine ice_shelf_advect_thickness_y subroutine shelf_advance_front(CS, ISS, G, flux_enter) - type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. @@ -3494,8 +3476,7 @@ subroutine shelf_advance_front(CS, ISS, G, flux_enter) end subroutine shelf_advance_front !> Apply a very simple calving law using a minimum thickness rule -subroutine ice_shelf_min_thickness_calve(CS, G, h_shelf, area_shelf_h, hmask) - type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure +subroutine ice_shelf_min_thickness_calve(G, h_shelf, area_shelf_h, hmask, thickness_calve) type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_shelf @@ -3503,14 +3484,15 @@ subroutine ice_shelf_min_thickness_calve(CS, G, h_shelf, area_shelf_h, hmask) intent(inout) :: area_shelf_h real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask + real, intent(in) :: thickness_calve integer :: i,j do j=G%jsd,G%jed do i=G%isd,G%ied -! if ((h_shelf(i,j) < CS%min_thickness_simple_calve) .and. (hmask(i,j) == 1) .and. & +! if ((h_shelf(i,j) < CS%thickness_calve) .and. (hmask(i,j) == 1) .and. & ! (CS%float_frac(i,j) == 0.0)) then - if ((h_shelf(i,j) < CS%min_thickness_simple_calve) .and. (area_shelf_h(i,j) > 0.)) then + if ((h_shelf(i,j) < thickness_calve) .and. (area_shelf_h(i,j) > 0.)) then h_shelf(i,j) = 0.0 area_shelf_h(i,j) = 0.0 hmask(i,j) = 0.0 @@ -3520,8 +3502,7 @@ subroutine ice_shelf_min_thickness_calve(CS, G, h_shelf, area_shelf_h, hmask) end subroutine ice_shelf_min_thickness_calve -subroutine calve_to_mask(CS, G, h_shelf, area_shelf_h, hmask, calve_mask) - type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure +subroutine calve_to_mask(G, h_shelf, area_shelf_h, hmask, calve_mask) type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_shelf real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: area_shelf_h @@ -3530,20 +3511,18 @@ subroutine calve_to_mask(CS, G, h_shelf, area_shelf_h, hmask, calve_mask) integer :: i,j - if (CS%calve_to_mask) then - do j=G%jsc,G%jec ; do i=G%isc,G%iec - if ((calve_mask(i,j) == 0.0) .and. (hmask(i,j) /= 0.0)) then - h_shelf(i,j) = 0.0 - area_shelf_h(i,j) = 0.0 - hmask(i,j) = 0.0 - endif - enddo ; enddo - endif + do j=G%jsc,G%jec ; do i=G%isc,G%iec + if ((calve_mask(i,j) == 0.0) .and. (hmask(i,j) /= 0.0)) then + h_shelf(i,j) = 0.0 + area_shelf_h(i,j) = 0.0 + hmask(i,j) = 0.0 + endif + enddo ; enddo end subroutine calve_to_mask subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) - type(ice_shelf_CS), intent(in):: CS !< A pointer to the ice shelf control structure + type(ice_shelf_dyn_CS), intent(in):: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. @@ -3585,20 +3564,9 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) is = iscq - 1; js = jscq - 1 i_off = G%idg_offset ; j_off = G%jdg_offset -! D => G%bathyT -! H => ISS%h_shelf -! float_frac => CS%float_frac -! hmask => ISS%hmask rho = CS%density_ice rhow = CS%density_ocean_avg - call savearray2 ("H",ISS%h_shelf,CS%write_output_to_file) - call savearray2 ("u_face_mask", CS%u_face_mask_boundary,CS%write_output_to_file) - call savearray2 ("umask", CS%umask,CS%write_output_to_file) - call savearray2 ("v_face_mask", CS%v_face_mask_boundary,CS%write_output_to_file) - call savearray2 ("vmask", CS%vmask,CS%write_output_to_file) - - ! prelim - go through and calculate S ! or is this faster? @@ -3615,7 +3583,6 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) dxh = G%dxT(i,j) dyh = G%dyT(i,j) dxdyh = G%areaT(i,j) -! print *,dxh," ",dyh," ",dxdyh if (ISS%hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell @@ -3746,14 +3713,10 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) enddo enddo - -! call savearray2 ("Taux"//"p"//procnum,taud_x,CS%write_output_to_file) -! call savearray2 ("Tauy"//"p"//procnum,taud_y,CS%write_output_to_file) - end subroutine calc_shelf_driving_stress subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new_sim) - type(ice_shelf_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. type(time_type), intent(in) :: Time real, dimension(SZDI_(G),SZDJ_(G)), & @@ -3781,17 +3744,13 @@ subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new ! iegq = G%iegq ; jegq = G%jegq i_off = G%idg_offset ; j_off = G%jdg_offset - domain_width = CS%len_lat + domain_width = G%len_lat ! this loop results in some values being set twice but... eh. do j=jsd,jed do i=isd,ied -! if ((i == 4) .AND. ((mpp_pe() == 0) .or. (mpp_pe() == 6))) then -! print *,hmask(i,j),i,j,mpp_pe() -! endif - if (hmask(i,j) == 3) then CS%thickness_boundary_values(i,j) = input_thick endif @@ -3799,9 +3758,9 @@ subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new if ((hmask(i,j) == 0) .or. (hmask(i,j) == 1) .or. (hmask(i,j) == 2)) then if ((i <= iec).and.(i >= isc)) then if (CS%u_face_mask(i-1,j) == 3) then - CS%u_boundary_values(i-1,j-1) = (1 - ((G%geoLatBu(i-1,j-1) - 0.5*CS%len_lat)*2./CS%len_lat)**2) * & + CS%u_boundary_values(i-1,j-1) = (1 - ((G%geoLatBu(i-1,j-1) - 0.5*G%len_lat)*2./G%len_lat)**2) * & 1.5 * input_flux / input_thick - CS%u_boundary_values(i-1,j) = (1 - ((G%geoLatBu(i-1,j) - 0.5*CS%len_lat)*2./CS%len_lat)**2) * & + CS%u_boundary_values(i-1,j) = (1 - ((G%geoLatBu(i-1,j) - 0.5*G%len_lat)*2./G%len_lat)**2) * & 1.5 * input_flux / input_thick endif endif @@ -3812,7 +3771,6 @@ subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new if (((i+i_off) == (G%domain%nihalo+1)).and.(CS%u_face_mask(i-1,j) == 3)) then CS%u_shelf(i-1,j-1) = CS%u_boundary_values(i-1,j-1) CS%u_shelf(i-1,j) = CS%u_boundary_values(i-1,j) -! print *, u_boundary_values(i-1,j) endif if (((j+j_off) == (G%domain%njhalo+1)).and.(CS%v_face_mask(i,j-1) == 3)) then CS%u_shelf(i-1,j-1) = CS%u_boundary_values(i-1,j-1) @@ -3826,15 +3784,15 @@ subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new end subroutine init_boundary_values -subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmask, H_node, & +subroutine CG_action_bilinear(uret, vret, u, v, Phi, Phisub, umask, vmask, hmask, H_node, & nu, float_cond, D, beta, dxdyh, G, is, ie, js, je, dens_ratio) type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent (inout) :: uret, vret real, dimension(SZDI_(G),SZDJ_(G),8,4), intent(in) :: Phi real, dimension(:,:,:,:,:,:), intent(in) :: Phisub - real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent (in) :: u, v - real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent (in) :: umask, vmask, H_node + real, dimension(SZDIB_(G),SZDJB_(G)), intent (in) :: u, v + real, dimension(SZDIB_(G),SZDJB_(G)), intent (in) :: umask, vmask, H_node real, dimension(SZDI_(G),SZDJ_(G)), intent (in) :: hmask real, dimension(SZDIB_(G),SZDJB_(G)), intent (in) :: nu real, dimension(SZDI_(G),SZDJ_(G)), intent (in) :: float_cond @@ -3979,10 +3937,6 @@ subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmas endif Ucontr(iphi,jphi) = Ucontr(iphi,jphi) + .25 * area * uq * xquad(ilq) * xquad(jlq) * beta(i,j) -! if ((i == 27) .and. (j == 8) .and. (iphi == 1) .and. (jphi == 1)) & -! print *, "grid", uq, .25 * area * uq * xquad(ilq) * xquad(jlq) - - !endif enddo ; enddo enddo ; enddo @@ -3997,8 +3951,6 @@ subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmas endif if (vmask(i-2+iphi,j-2+jphi) == 1) then vret(i-2+iphi,j-2+jphi) = vret(i-2+iphi,j-2+jphi) + Vsubcontr (iphi,jphi) * beta(i,j) - !if ( (iphi == 1) .and. (jphi == 1)) 8 - ! print *, i,j, Usubcontr (iphi,jphi) * beta(i,j), " ", Ucontr(iphi,jphi) endif enddo ; enddo endif @@ -4008,7 +3960,7 @@ subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmas end subroutine CG_action_bilinear -subroutine CG_action_subgrid_basal_bilinear (Phisub, H, U, V, DXDYH, D, dens_ratio, Ucontr, Vcontr, iin, jin) +subroutine CG_action_subgrid_basal_bilinear(Phisub, H, U, V, DXDYH, D, dens_ratio, Ucontr, Vcontr, iin, jin) real, dimension(:,:,:,:,:,:), intent(in) :: Phisub real, dimension(2,2), intent(in) :: H,U,V real, intent(in) :: DXDYH, D, dens_ratio @@ -4061,9 +4013,6 @@ subroutine CG_action_subgrid_basal_bilinear (Phisub, H, U, V, DXDYH, D, dens_rat Ucontr (m,n) = Ucontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * uq Vcontr (m,n) = Vcontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * vq - ! if ((i_m == 27) .and. (j_m == 8) .and. (m == 1) .and. (n == 1)) & - print *, "in subgrid", uq, Phisub(i,j,m,n,qx,qy) - endif enddo @@ -4079,7 +4028,7 @@ end subroutine CG_action_subgrid_basal_bilinear subroutine matrix_diagonal_bilinear(CS, G, float_cond, H_node, nu, beta, hmask, dens_ratio, & Phisub, u_diagonal, v_diagonal) - type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: float_cond @@ -4251,7 +4200,7 @@ end subroutine CG_diagonal_subgrid_basal_bilinear subroutine apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, nu, beta, float_cond, & dens_ratio, u_boundary_contr, v_boundary_contr) - type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. @@ -4415,7 +4364,7 @@ end subroutine apply_boundary_values_bilinear subroutine calc_shelf_visc_bilinear(CS, ISS, G, u, v) - type(ice_shelf_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. @@ -4471,7 +4420,7 @@ subroutine calc_shelf_visc_bilinear(CS, ISS, G, u, v) end subroutine calc_shelf_visc_bilinear subroutine update_OD_ffrac(CS, G, ocean_mass, counter, nstep_velocity, time_step, velocity_update_time_step) - type(ice_shelf_CS), intent(inout):: CS !< A pointer to the ice shelf control structure + type(ice_shelf_dyn_CS), intent(inout):: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(G%isd:,G%jsd:) :: ocean_mass integer,intent(in) :: counter @@ -4503,9 +4452,6 @@ subroutine update_OD_ffrac(CS, G, ocean_mass, counter, nstep_velocity, time_step do j=jsc,jec do i=isc,iec CS%float_frac(i,j) = 1.0 - (CS%float_frac_rt(i,j) / real(nstep_velocity)) -! if ((CS%float_frac(i,j) > 0) .and. (CS%float_frac(i,j) < 1)) then -! print *,"PARTLY GROUNDED", CS%float_frac(i,j),i,j,mpp_pe() -! endif CS%OD_av(i,j) = CS%OD_rt(i,j) / real(nstep_velocity) CS%OD_rt(i,j) = 0.0 ; CS%float_frac_rt(i,j) = 0.0 @@ -4520,7 +4466,7 @@ subroutine update_OD_ffrac(CS, G, ocean_mass, counter, nstep_velocity, time_step end subroutine update_OD_ffrac subroutine update_OD_ffrac_uncoupled(CS, G, h_shelf) - type(ice_shelf_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: h_shelf !< the thickness of the ice shelf in m @@ -4677,14 +4623,11 @@ subroutine bilinear_shape_functions_subgrid (Phisub, nsub) enddo enddo -! print *, Phisub(1,1,2,2,1,1),Phisub(1,1,2,2,1,2),Phisub(1,1,2,2,2,1),Phisub(1,1,2,2,2,2) - - end subroutine bilinear_shape_functions_subgrid subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face_mask) - type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are @@ -4880,113 +4823,40 @@ subroutine interpolate_H_to_B(G, h_shelf, hmask, H_node) end subroutine interpolate_H_to_B -!> Deallocates all memory associated with this module -subroutine ice_shelf_end(CS) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure +!> Deallocates all memory associated with the ice shelf dynamics module +subroutine ice_shelf_dyn_end(CS) + type(ice_shelf_dyn_CS), pointer :: CS !< A pointer to the ice shelf dynamics control structure if (.not.associated(CS)) return - call ice_shelf_state_end(CS%ISS) + deallocate(CS%u_shelf, CS%v_shelf) + deallocate(CS%t_shelf, CS%tmask) + deallocate(CS%u_boundary_values, CS%v_boundary_values, CS%t_boundary_values) + deallocate(CS%u_face_mask, CS%v_face_mask) + deallocate(CS%umask, CS%vmask) - if (CS%shelf_mass_is_dynamic .and. .not.CS%override_shelf_movement) then - deallocate(CS%u_shelf) ; deallocate(CS%v_shelf) -!!! OVS !!! - deallocate(CS%t_shelf); deallocate(CS%tmask) - deallocate(CS%t_boundary_values) - deallocate(CS%u_boundary_values) ; deallocate(CS%v_boundary_values) - deallocate(CS%ice_visc_bilinear) - deallocate(CS%u_face_mask) ; deallocate(CS%v_face_mask) - deallocate(CS%umask) ; deallocate(CS%vmask) - - deallocate(CS%taub_beta_eff_bilinear) - deallocate(CS%OD_rt) ; deallocate(CS%OD_av) - deallocate(CS%float_frac) ; deallocate(CS%float_frac_rt) - endif + deallocate(CS%ice_visc_bilinear, CS%taub_beta_eff_bilinear) + deallocate(CS%OD_rt, CS%OD_av) + deallocate(CS%float_frac, CS%float_frac_rt) deallocate(CS) -end subroutine ice_shelf_end - -subroutine savearray2(fname,A,flag) - -! print 2-D array to file - -! this is here strictly for debug purposes - -CHARACTER(*),intent(in) :: fname -! This change is to allow the code to compile with the GNU compiler. -! DOUBLE PRECISION,DIMENSION(:,:),intent(in) :: A -REAL, DIMENSION(:,:), intent(in) :: A -LOGICAL :: flag - -INTEGER :: M,N,i,j,iock,lh,FIN -CHARACTER(23000) :: ln -CHARACTER(17) :: sing -CHARACTER(9) :: STR -CHARACTER(7) :: FMT1 - -if (.NOT. flag) then - return -endif - -PRINT *,"WRITING ARRAY " // fname - -FIN=7 -M = size(A,1) -N = size(A,2) - -OPEN(unit=fin,FILE=fname,STATUS='REPLACE',ACCESS='SEQUENTIAL',& - ACTION='WRITE',IOSTAT=iock) - -if (M > 1300) THEN - WRITE(fin) 'SECOND DIMENSION TOO LARGE' - CLOSE(fin) - RETURN -ENDIF - -DO i=1,M - WRITE(ln,'(E17.9)') A(i,1) - DO j=2,N - WRITE(sing,'(E17.9)') A(i,j) - ln = TRIM(ln) // ' ' // TRIM(sing) - ENDDO - - - if (i == 1) THEN - - lh = LEN(TRIM(ln)) - - FMT1 = '(A' - - SELECT CASE (lh) - CASE(1:9) - WRITE(FMT1(3:3),'(I1)') lh +end subroutine ice_shelf_dyn_end - CASE(10:99) - WRITE(FMT1(3:4),'(I2)') lh - - CASE(100:999) - WRITE(FMT1(3:5),'(I3)') lh - - CASE(1000:9999) - WRITE(FMT1(3:6),'(I4)') lh - - END SELECT - - FMT1 = TRIM(FMT1) // ')' +!> Deallocates all memory associated with this module +subroutine ice_shelf_end(CS) + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - ENDIF + if (.not.associated(CS)) return - WRITE(UNIT=fin,IOSTAT=iock,FMT=TRIM(FMT1)) TRIM(ln) + call ice_shelf_state_end(CS%ISS) - if (iock /= 0) THEN - PRINT *,iock - ENDIF -ENDDO + if (CS%active_shelf_dynamics) & + call ice_shelf_dyn_end(CS%dCS) -CLOSE(FIN) + deallocate(CS) -end subroutine savearray2 +end subroutine ice_shelf_end subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) @@ -4999,6 +4869,7 @@ subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) type(ocean_grid_type), pointer :: G => NULL() type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe !! the ice-shelf state + type(ice_shelf_dyn_CS), pointer :: dCS => NULL() integer :: is, iec, js, jec, i, j, ki, kj, iters real :: ratio, min_ratio, time_step_remain, local_u_max, & local_v_max, time_step_int, min_time_step,spy,dumtimeprint @@ -5011,6 +4882,7 @@ subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) spy = 365 * 86400 G => CS%grid ISS => CS%ISS + dCS => CS%dCS time_step_remain = time_step if (.not. (present (min_time_step_in))) then @@ -5038,8 +4910,8 @@ subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) ! this is done by checking that umask and vmask are nonzero at all 4 corners do ki=1,2 ; do kj = 1,2 - local_u_max = max(local_u_max, abs(CS%u_shelf(i-1+ki,j-1+kj))) - local_v_max = max(local_v_max, abs(CS%v_shelf(i-1+ki,j-1+kj))) + local_u_max = max(local_u_max, abs(dCS%u_shelf(i-1+ki,j-1+kj))) + local_v_max = max(local_v_max, abs(dCS%v_shelf(i-1+ki,j-1+kj))) enddo ; enddo @@ -5073,46 +4945,35 @@ subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) write (stepnum,'(I4)') CS%velocity_update_sub_counter - call ice_shelf_advect(CS, ISS, G, time_step_int, Time) - - if (mpp_pe() == 7) then - call savearray2 ("hmask",ISS%hmask,CS%write_output_to_file) -!!! OVS!!! -! call savearray2 ("tshelf",CS%t_shelf,CS%write_output_to_file) - endif + call ice_shelf_advect(dCS, ISS, G, time_step_int, Time) ! if the last mini-timestep is a day or less, we cannot expect velocities to change by much. ! do not update them if (time_step_int > 1000) then - call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) + call update_velocity_masks(dCS, G, ISS%hmask, dCS%umask, dCS%vmask, dCS%u_face_mask, dCS%v_face_mask) -! call savearray2 ("Umask"//"p"//trim(procnum)//"_"//trim(stepnum),CS%umask,CS%write_output_to_file) -! call savearray2 ("Vmask"//"p"//trim(procnum)//"_"//trim(stepnum),CS%vmask,CS%write_output_to_file) - - call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf) - call ice_shelf_solve_outer(CS, ISS, G, CS%u_shelf, CS%v_shelf, iters, dummy) + call update_OD_ffrac_uncoupled(dCS, G, ISS%h_shelf) + call ice_shelf_solve_outer(dCS, ISS, G, dCS%u_shelf, dCS%v_shelf, iters, dummy) endif !!! OVS!!! - call ice_shelf_temp(CS, ISS, G, time_step_int, ISS%water_flux, Time) + call ice_shelf_temp(dCS, ISS, G, time_step_int, ISS%water_flux, Time) call enable_averaging(time_step,Time,CS%diag) if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, ISS%area_shelf_h, CS%diag) - if (CS%id_col_thick > 0) call post_data(CS%id_col_thick, CS%OD_av, CS%diag) + if (CS%id_col_thick > 0) call post_data(CS%id_col_thick, dCS%OD_av, CS%diag) if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf,ISS%h_shelf,CS%diag) if (CS%id_h_mask > 0) call post_data(CS%id_h_mask,ISS%hmask,CS%diag) - if (CS%id_u_mask > 0) call post_data(CS%id_u_mask,CS%umask,CS%diag) - if (CS%id_v_mask > 0) call post_data(CS%id_v_mask,CS%vmask,CS%diag) - if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf,CS%u_shelf,CS%diag) - if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf,CS%v_shelf,CS%diag) - if (CS%id_float_frac > 0) call post_data(CS%id_float_frac,CS%float_frac,CS%diag) - if (CS%id_OD_av >0) call post_data(CS%id_OD_av,CS%OD_av,CS%diag) - if (CS%id_float_frac_rt>0) call post_data(CS%id_float_frac_rt,CS%float_frac_rt,CS%diag) -!!! OVS!!! -! if (CS%id_t_mask > 0) - call post_data(CS%id_t_mask,CS%tmask,CS%diag) -! if (CS%id_t_shelf > 0) - call post_data(CS%id_t_shelf,CS%t_shelf,CS%diag) + + if (CS%id_u_mask > 0) call post_data(CS%id_u_mask,dCS%umask,CS%diag) + if (CS%id_v_mask > 0) call post_data(CS%id_v_mask,dCS%vmask,CS%diag) + if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf,dCS%u_shelf,CS%diag) + if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf,dCS%v_shelf,CS%diag) + if (CS%id_float_frac > 0) call post_data(CS%id_float_frac,dCS%float_frac,CS%diag) + if (CS%id_OD_av >0) call post_data(CS%id_OD_av,dCS%OD_av,CS%diag) + if (CS%id_float_frac_rt>0) call post_data(CS%id_float_frac_rt,dCS%float_frac_rt,CS%diag) + if (CS%id_t_mask > 0) call post_data(CS%id_t_mask,dCS%tmask,CS%diag) + if (CS%id_t_shelf > 0) call post_data(CS%id_t_shelf,dCS%t_shelf,CS%diag) call disable_averaging(CS%diag) @@ -5122,7 +4983,7 @@ end subroutine solo_time_step !!! OVS !!! subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) - type(ice_shelf_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. @@ -5273,7 +5134,7 @@ end subroutine ice_shelf_temp subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, flux_enter) - type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask @@ -5359,10 +5220,6 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f ! get u-velocity at center of left face u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - ! if (at_west_bdry .and.(i == G%isc)) then - ! print *, j, u_face, stencil(-1) - ! endif - if (u_face > 0) then !flux is into cell - we need info from h(i-2), h(i-1) if available ! i may not cover all the cases.. but i cover the realistic ones @@ -5513,7 +5370,7 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f end subroutine ice_shelf_advect_temp_x subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_after_vflux, flux_enter) - type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask From 70d88e4e52f9ef500b43583a2888d9d6acd41209 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 21 May 2018 17:05:14 -0600 Subject: [PATCH 0280/1072] Add a flag to control if visc%Kv_slow is used This commit adds a flag ADD_KV_SLOW (default is FALSE) that controls if the background vertical viscosity in the interior (i.e., tidal + background + shear + convenction) is addded when computing the coupling coefficient. The purpose of this flag is to be able to recover previous answers and it will likely be removed in the future since this option should always be true. --- src/core/MOM_variables.F90 | 3 + .../vertical/MOM_set_viscosity.F90 | 86 ++++++++++--------- .../vertical/MOM_vert_friction.F90 | 2 +- 3 files changed, 48 insertions(+), 43 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 09305eb9fb..02b0b622a3 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -233,6 +233,9 @@ module MOM_variables !! convection etc). TKE_turb => NULL() !< The turbulent kinetic energy per unit mass defined !! at the interfaces between each layer, in m2 s-2. + logical :: add_Kv_slow !< If True, adds Kv_slow when calculating the + !! 'coupling coefficient' (a[k]) at the interfaces. + !! This is done in find_coupling_coef. end type vertvisc_type !> The BT_cont_type structure contains information about the summed layer diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index c0b03e5832..ec1b09a5ad 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -2,38 +2,6 @@ module MOM_set_visc ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, April 1994 - October 2006 * -!* Quadratic Bottom Drag by James Stephens and R. Hallberg. * -!* * -!* This file contains the subroutine that calculates various values * -!* related to the bottom boundary layer, such as the viscosity and * -!* thickness of the BBL (set_viscous_BBL). This would also be the * -!* module in which other viscous quantities that are flow-independent * -!* might be set. This information is transmitted to other modules * -!* via a vertvisc type structure. * -!* * -!* The same code is used for the two velocity components, by * -!* indirectly referencing the velocities and defining a handful of * -!* direction-specific defined variables. * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v, frhatv, tauy * -!* j x ^ x ^ x At >: u, frhatu, taux * -!* j > o > o > At o: h * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_debugging, only : uvchksum, hchksum use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr @@ -1859,16 +1827,8 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) type(set_visc_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module type(ocean_OBC_type), pointer :: OBC -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (out) visc - A structure containing vertical viscosities and related -! fields. Allocated here. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module + + ! local variables real :: Csmag_chan_dflt, smag_const1, TKE_decay_dflt, bulk_Ri_ML_dflt real :: Kv_background real :: omega_frac_dflt @@ -2020,6 +1980,15 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) "The background kinematic viscosity in the interior. \n"//& "The molecular value, ~1e-6 m2 s-1, may be used.", & units="m2 s-1", fail_if_missing=.true.) + + call get_param(param_file, mdl, "ADD_KV_SLOW", visc%add_Kv_slow, & + "If true, the background vertical viscosity in the interior \n"//& + "(i.e., tidal + background + shear + convenction) is addded \n"// & + "when computing the coupling coefficient. The purpose of this \n"// & + "flag is to be able to recover previous answers and it will likely \n"// & + "be removed in the future since this option should always be true.", & + default=.false.) + call get_param(param_file, mdl, "KV_BBL_MIN", CS%KV_BBL_min, & "The minimum viscosities in the bottom boundary layer.", & units="m2 s-1", default=Kv_background) @@ -2117,4 +2086,37 @@ subroutine set_visc_end(visc, CS) deallocate(CS) end subroutine set_visc_end +!> \namespace MOM_set_visc +!!********+*********+*********+*********+*********+*********+*********+** +!!* * +!!* By Robert Hallberg, April 1994 - October 2006 * +!!* Quadratic Bottom Drag by James Stephens and R. Hallberg. * +!!* * +!!* This file contains the subroutine that calculates various values * +!!* related to the bottom boundary layer, such as the viscosity and * +!!* thickness of the BBL (set_viscous_BBL). This would also be the * +!!* module in which other viscous quantities that are flow-independent * +!!* might be set. This information is transmitted to other modules * +!!* via a vertvisc type structure. * +!!* * +!!* The same code is used for the two velocity components, by * +!!* indirectly referencing the velocities and defining a handful of * +!!* direction-specific defined variables. * +!!* * +!!* Macros written all in capital letters are defined in MOM_memory.h. * +!!* * +!!* A small fragment of the grid is shown below: * +!!* * +!!* j+1 x ^ x ^ x At x: q * +!!* j+1 > o > o > At ^: v, frhatv, tauy * +!!* j x ^ x ^ x At >: u, frhatu, taux * +!!* j > o > o > At o: h * +!!* j-1 x ^ x ^ x * +!!* i-1 i i+1 At x & ^: * +!!* i i+1 At > & o: * +!!* * +!!* The boundaries always run through q grid points (x). * +!!* * +!!********+*********+*********+*********+*********+*********+*********+** + end module MOM_set_visc diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index ad0d7fc90d..bafbe5eb59 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1195,7 +1195,7 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif ! add "slow" varying vertical viscosity (e.g., from background, tidal etc) - if (associated(visc%Kv_slow)) then + if (associated(visc%Kv_slow) .and. (visc%add_Kv_slow)) then ! GMM/ A factor of 2 is also needed here, see comment above from BGR. if (work_on_u) then do K=2,nz ; do i=is,ie ; if (do_i(i)) then From 8877c17dccd111e4789f4553eb4e25befee6e091 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 22 May 2018 08:32:43 -0600 Subject: [PATCH 0281/1072] Rename MOM_cvmix_ddiff.F90 -> MOM_CVMix_ddiff.F90 --- .../vertical/{MOM_cvmix_ddiff.F90 => MOM_CVMix_ddiff.F90} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/parameterizations/vertical/{MOM_cvmix_ddiff.F90 => MOM_CVMix_ddiff.F90} (100%) diff --git a/src/parameterizations/vertical/MOM_cvmix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 similarity index 100% rename from src/parameterizations/vertical/MOM_cvmix_ddiff.F90 rename to src/parameterizations/vertical/MOM_CVMix_ddiff.F90 From bf6c0030a308c3099fce3674a84a03ad16e358ba Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 22 May 2018 08:41:39 -0600 Subject: [PATCH 0282/1072] Clean the ddiff code and improve comments --- .../vertical/MOM_CVMix_ddiff.F90 | 27 +++++-------------- 1 file changed, 6 insertions(+), 21 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index da75caf1e3..7137aabfa6 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -64,9 +64,6 @@ logical function CVMix_ddiff_init(Time, G, GV, param_file, diag, CS) type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. type(CVMix_ddiff_cs), pointer :: CS !< This module's control structure. - ! Local variables -! real :: prandtl_conv !< Turbulent Prandtl number used in convective instabilities. - ! This include declares and sets the variable "version". #include "version_variable.h" @@ -133,11 +130,6 @@ logical function CVMix_ddiff_init(Time, G, GV, param_file, diag, CS) call closeParameterBlock(param_file) - ! allocate arrays and set them to zero - ! GMM, dont need the following - !allocate(CS%KT_extra(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%KT_extra(:,:,:) = 0. - !allocate(CS%KS_extra(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%KS_extra(:,:,:) = 0. - ! Register diagnostics CS%diag => diag @@ -173,8 +165,6 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_T !< Interface double diffusion diapycnal -! real, dimension(:,:,:), pointer :: Kd_T -! real, dimension(:,:,:), pointer :: Kd_S !! diffusivity for temp (m2/sec). real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_S !< Interface double diffusion diapycnal !! diffusivity for salt (m2/sec). @@ -209,7 +199,9 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) ! set Kd_T and Kd_S to zero to avoid passing values from previous call Kd_T(:,j,:) = 0.0; Kd_S(:,j,:) = 0.0 - ! GMM, check this. + ! GMM, I am leaving some code commented below. We need to pass BLD to + ! this soubroutine to avoid adding diffusivity above that. This needs + ! to be done once we re-structure the order of the calls. !if (.not. associated(hbl)) then ! allocate(hbl(SZI_(G), SZJ_(G))); ! hbl(:,:) = 0.0 @@ -239,9 +231,9 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) call calculate_density_derivs(temp_int(:), salt_int(:), pres_int(:), drho_dT(:), drho_dS(:), 1, G%ke, TV%EQN_OF_STATE) - ! GMM, explain need for -1 in front of alpha - ! if ((alpha_dT > beta_dS) .and. (beta_dS > 0.0)) then ! salt finger case - ! if ((alpha_dT < 0.) .and. (beta_dS < 0.) .and. (alpha_dT > beta_dS)) then ! diffusive convection + ! The "-1.0" below is needed so that the following criteria is satisfied: + ! if ((alpha_dT > beta_dS) .and. (beta_dS > 0.0)) then "salt finger" + ! if ((alpha_dT < 0.) .and. (beta_dS < 0.) .and. (alpha_dT > beta_dS)) then "diffusive convection" do k=1,G%ke alpha_dT(k) = -1.0*drho_dT(k) * dT(k) beta_dS(k) = drho_dS(k) * dS(k) @@ -277,13 +269,6 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) nlev=G%ke, & max_nlev=G%ke) - !if (is_root_pe()) then - ! write(*,*)'drho_dT, alpha_dT', & - ! drho_dT(:), alpha_dT(:) - ! write(*,*)'drho_dS, beta_dS', & - ! drho_dS(:), beta_dS(:) - !endif - ! Do not apply mixing due to convection within the boundary layer !do k=1,kOBL ! Kd_T(i,j,k) = 0.0 From 387f4e64bd246cef62569b087f1bf457c0b9810b Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 22 May 2018 10:17:52 -0600 Subject: [PATCH 0283/1072] Add a legacy version of diabatic_driver A new input parameter has been added (USE_LEGACY_DIABATIC_DRIVER). If true, the model will use a legacy version of the diabatic driver (module MOM_legacy_diabatic_driver). This is temporary and is needed to avoid change in answers while MOM_diabatic_driver is been restructured. --- src/core/MOM.F90 | 18 +- .../vertical/MOM_diabatic_driver.F90 | 6 +- .../vertical/MOM_legacy_diabatic_driver.F90 | 1660 +++++++++++++++++ 3 files changed, 1680 insertions(+), 4 deletions(-) create mode 100644 src/parameterizations/vertical/MOM_legacy_diabatic_driver.F90 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 8ee4113f71..9b70b81415 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -52,6 +52,7 @@ module MOM use MOM_ALE, only : ALE_getCoordinate, ALE_getCoordinateUnits, ALE_writeCoordinateFile use MOM_ALE, only : ALE_updateVerticalGridType, ALE_remap_init_conds, ALE_register_diags use MOM_boundary_update, only : call_OBC_register, OBC_register_end, update_OBC_CS +use MOM_legacy_diabatic_driver,only : legacy_diabatic use MOM_diabatic_driver, only : diabatic, diabatic_driver_init, diabatic_CS use MOM_diabatic_driver, only : adiabatic, adiabatic_driver_init, diabatic_driver_end use MOM_diagnostics, only : calculate_diagnostic_fields, MOM_diagnostics_init @@ -197,6 +198,9 @@ module MOM logical :: adiabatic !< If true, there are no diapycnal mass fluxes, and no calls !! to routines to calculate or apply diapycnal fluxes. + logical :: use_legacy_diabatic_driver!< If true (default), use the a legacy version of the + !! diabatic subroutine. This is temporary and is needed + !! to avoid change in answers. logical :: diabatic_first !< If true, apply diabatic and thermodynamic !! processes before time stepping the dynamics. logical :: use_ALE_algorithm !< If true, use the ALE algorithm rather than layered @@ -1151,8 +1155,14 @@ subroutine step_MOM_thermo(CS, G, GV, u, v, h, tv, fluxes, dtdia, & endif call cpu_clock_begin(id_clock_diabatic) - call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, & - dtdia, Time_end_thermo, G, GV, CS%diabatic_CSp, Waves=Waves) + if (CS%use_legacy_diabatic_driver) then + ! the following subroutine is legacy and will be deleted in the near future. + call legacy_diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, & + dtdia, Time_end_thermo, G, GV, CS%diabatic_CSp, Waves=Waves) + else + call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, & + dtdia, Time_end_thermo, G, GV, CS%diabatic_CSp, Waves=Waves) + endif fluxes%fluxes_used = .true. call cpu_clock_end(id_clock_diabatic) @@ -1627,6 +1637,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "true. This assumes that KD = KDML = 0.0 and that \n"//& "there is no buoyancy forcing, but makes the model \n"//& "faster by eliminating subroutine calls.", default=.false.) + call get_param(param_file, "MOM", "USE_LEGACY_DIABATIC_DRIVER", CS%use_legacy_diabatic_driver, & + "If true, use the a legacy version of the diabatic subroutine. \n"//& + "This is temporary and is needed avoid change in answers.", & + default=.true.) call get_param(param_file, "MOM", "DO_DYNAMICS", CS%do_dynamics, & "If False, skips the dynamics calls that update u & v, as well as \n"//& "the gravity wave adjustment to h. This is a fragile feature and \n"//& diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 259abcfadc..6316fd40e6 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -84,7 +84,10 @@ module MOM_diabatic_driver public adiabatic_driver_init !> Control structure for this module -type, public:: diabatic_CS ; private +! GMM, I've made the following type public so it work with the legacy version of +! diabatic. This type should be made private once the legacy code is deleted. +!type, public:: diabatic_CS; private +type, public:: diabatic_CS logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with !! nkml sublayers (and additional buffer layers). logical :: use_energetic_PBL !< If true, use the implicit energetics planetary @@ -1917,7 +1920,6 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, ! Set default, read and log parameters call log_version(param_file, mod, version, & "The following parameters are used for diabatic processes.") - call get_param(param_file, mod, "SPONGE", CS%use_sponge, & "If true, sponges may be applied anywhere in the domain. \n"//& "The exact location and properties of those sponges are \n"//& diff --git a/src/parameterizations/vertical/MOM_legacy_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_legacy_diabatic_driver.F90 new file mode 100644 index 0000000000..739c74c80c --- /dev/null +++ b/src/parameterizations/vertical/MOM_legacy_diabatic_driver.F90 @@ -0,0 +1,1660 @@ +!> This routine drives the diabatic/dianeutral physics for MOM. +!! This is a legacy module that will be deleted in the near future. +module MOM_legacy_diabatic_driver + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_bulk_mixed_layer, only : bulkmixedlayer, bulkmixedlayer_init, bulkmixedlayer_CS +use MOM_debugging, only : hchksum +use MOM_checksum_packages, only : MOM_state_chksum, MOM_state_stats +use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end +use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE +use MOM_CVMix_shear, only : CVMix_shear_is_used +use MOM_diabatic_aux, only : diabatic_aux_init, diabatic_aux_end, diabatic_aux_CS +use MOM_diabatic_aux, only : make_frazil, adjust_salt, insert_brine, differential_diffuse_T_S, triDiagTS +use MOM_diabatic_aux, only : find_uv_at_h, diagnoseMLDbyDensityDifference, applyBoundaryFluxesInOut +use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr +use MOM_diag_mediator, only : diag_ctrl, time_type, diag_update_remap_grids +use MOM_diag_mediator, only : diag_ctrl, query_averaging_enabled, enable_averaging, disable_averaging +use MOM_diag_mediator, only : diag_grid_storage, diag_grid_storage_init, diag_grid_storage_end +use MOM_diag_mediator, only : diag_copy_diag_to_storage, diag_copy_storage_to_diag +use MOM_diag_mediator, only : diag_save_grids, diag_restore_grids +use MOM_diag_to_Z, only : diag_to_Z_CS, register_Zint_diag, calc_Zint_diags +use MOM_diapyc_energy_req, only : diapyc_energy_req_init, diapyc_energy_req_end +use MOM_diapyc_energy_req, only : diapyc_energy_req_calc, diapyc_energy_req_test, diapyc_energy_req_CS +use MOM_CVMix_conv, only : CVMix_conv_init, CVMix_conv_cs +use MOM_CVMix_conv, only : CVMix_conv_end, calculate_CVMix_conv +use MOM_domains, only : pass_var, To_West, To_South, To_All, Omit_Corners +use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type +use MOM_tidal_mixing, only : tidal_mixing_init, tidal_mixing_cs +use MOM_tidal_mixing, only : tidal_mixing_end +use MOM_energetic_PBL, only : energetic_PBL, energetic_PBL_init +use MOM_energetic_PBL, only : energetic_PBL_end, energetic_PBL_CS +use MOM_energetic_PBL, only : energetic_PBL_get_MLD +use MOM_entrain_diffusive, only : entrainment_diffusive, entrain_diffusive_init +use MOM_entrain_diffusive, only : entrain_diffusive_end, entrain_diffusive_CS +use MOM_EOS, only : calculate_density, calculate_TFreeze +use MOM_EOS, only : calculate_specific_vol_derivs +use MOM_error_handler, only : MOM_error, FATAL, WARNING, callTree_showQuery,MOM_mesg +use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint +use MOM_file_parser, only : get_param, log_version, param_file_type, read_param +use MOM_forcing_type, only : forcing, MOM_forcing_chksum +use MOM_forcing_type, only : calculateBuoyancyFlux2d, forcing_SinglePointPrint +use MOM_geothermal, only : geothermal, geothermal_init, geothermal_end, geothermal_CS +use MOM_grid, only : ocean_grid_type +use MOM_io, only : vardesc, var_desc +use MOM_int_tide_input, only : set_int_tide_input, int_tide_input_init +use MOM_int_tide_input, only : int_tide_input_end, int_tide_input_CS, int_tide_input_type +use MOM_interface_heights, only : find_eta +use MOM_internal_tides, only : propagate_int_tide +use MOM_internal_tides, only : internal_tides_init, internal_tides_end, int_tide_CS +use MOM_kappa_shear, only : kappa_shear_is_used +use MOM_KPP, only : KPP_CS, KPP_init, KPP_compute_BLD, KPP_calculate +use MOM_KPP, only : KPP_end, KPP_get_BLD +use MOM_KPP, only : KPP_NonLocalTransport_temp, KPP_NonLocalTransport_saln +use MOM_opacity, only : opacity_init, set_opacity, opacity_end, opacity_CS +use MOM_regularize_layers, only : regularize_layers, regularize_layers_init, regularize_layers_CS +use MOM_set_diffusivity, only : set_diffusivity, set_BBL_TKE +use MOM_set_diffusivity, only : set_diffusivity_init, set_diffusivity_end +use MOM_set_diffusivity, only : set_diffusivity_CS +use MOM_shortwave_abs, only : absorbRemainingSW, optics_type +use MOM_sponge, only : apply_sponge, sponge_CS +use MOM_ALE_sponge, only : apply_ALE_sponge, ALE_sponge_CS +use MOM_time_manager, only : operator(-), set_time +use MOM_time_manager, only : operator(<=), time_type ! for testing itides (BDM) +use MOM_tracer_flow_control, only : call_tracer_column_fns, tracer_flow_control_CS +use MOM_tracer_diabatic, only : tracer_vertdiff +use MOM_variables, only : thermo_var_ptrs, vertvisc_type, accel_diag_ptrs +use MOM_variables, only : cont_diag_ptrs, MOM_thermovar_chksum, p3d +use MOM_verticalGrid, only : verticalGrid_type +use MOM_wave_speed, only : wave_speeds +use time_manager_mod, only : increment_time ! for testing itides (BDM) +use MOM_wave_interface, only : wave_parameters_CS +use MOM_diabatic_driver, only : diabatic_CS + +implicit none ; private + +#include + +public legacy_diabatic + +! clock ids +integer :: id_clock_entrain, id_clock_mixedlayer, id_clock_set_diffusivity +integer :: id_clock_tracers, id_clock_tridiag, id_clock_pass, id_clock_sponge +integer :: id_clock_geothermal, id_clock_differential_diff, id_clock_remap +integer :: id_clock_kpp + +contains + +!> This subroutine imposes the diapycnal mass fluxes and the +!! accompanying diapycnal advection of momentum and tracers. +subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, CS, WAVES) + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity (m/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity (m/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness (m for Bouss / kg/m2 for non-Bouss) + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields + !! unused have NULL ptrs + real, dimension(:,:), pointer :: Hml !< active mixed layer depth + type(forcing), intent(inout) :: fluxes !< points to forcing fields + !! unused fields have NULL ptrs + type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and + type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum + !! equations, to enable the later derived + !! diagnostics, like energy budgets + type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations + real, intent(in) :: dt !< time increment (seconds) + type(time_type), intent(in) :: Time_end !< Time at the end of the interval + type(diabatic_CS), pointer :: CS !< module control structure + type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + ea, & ! amount of fluid entrained from the layer above within + ! one time step (m for Bouss, kg/m^2 for non-Bouss) + eb, & ! amount of fluid entrained from the layer below within + ! one time step (m for Bouss, kg/m^2 for non-Bouss) + Kd, & ! diapycnal diffusivity of layers (m^2/sec) + h_orig, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) + h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) + hold, & ! layer thickness before diapycnal entrainment, and later + ! the initial layer thicknesses (if a mixed layer is used), + ! (m for Bouss, kg/m^2 for non-Bouss) + dSV_dT, & ! The partial derivatives of specific volume with temperature + dSV_dS, & ! and salinity in m^3/(kg K) and m^3/(kg ppt). + cTKE, & ! convective TKE requirements for each layer in J/m^2. + u_h, & ! zonal and meridional velocities at thickness points after + v_h ! entrainment (m/s) + + real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & + cn ! baroclinic gravity wave speeds (formerly cg1 - BDM) + + real, dimension(SZI_(G),SZJ_(G)) :: & + Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges + SkinBuoyFlux! 2d surface buoyancy flux (m2/s3), used by ePBL + real, dimension(SZI_(G),SZJ_(G),G%ke) :: h_diag ! diagnostic array for thickness + real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp + real, dimension(SZI_(G),SZJ_(G),G%ke) :: saln_diag ! diagnostic array for salinity + real, dimension(SZI_(G),SZJ_(G)) :: tendency_2d ! depth integrated content tendency for diagn + real, dimension(SZI_(G),SZJ_(G)) :: TKE_itidal_input_test ! override of energy input for testing (BDM) + + real :: net_ent ! The net of ea-eb at an interface. + + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & + ! These are targets so that the space can be shared with eaml & ebml. + eatr, & ! The equivalent of ea and eb for tracers, which differ from ea and + ebtr ! eb in that they tend to homogenize tracers in massless layers + ! near the boundaries (m for Bouss and kg/m^2 for non-Bouss) + + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & + Kd_int, & ! diapycnal diffusivity of interfaces (m^2/s) + Kd_heat, & ! diapycnal diffusivity of heat (m^2/s) + Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (m^2/s) + Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (m^2/s) + eta, & ! Interface heights before diapycnal mixing, in m. + Tdif_flx, & ! diffusive diapycnal heat flux across interfaces (K m/s) + Tadv_flx, & ! advective diapycnal heat flux across interfaces (K m/s) + Sdif_flx, & ! diffusive diapycnal salt flux across interfaces (ppt m/s) + Sadv_flx ! advective diapycnal salt flux across interfaces (ppt m/s) + + ! The following 5 variables are only used with a bulk mixed layer. + real, pointer, dimension(:,:,:) :: & + eaml, & ! The equivalent of ea and eb due to mixed layer processes, + ebml ! (m for Bouss and kg/m^2 for non-Bouss). These will be + ! pointers to eatr and ebtr so as to reuse the memory as + ! the arrays are not needed at the same time. + + integer :: kb(SZI_(G),SZJ_(G)) ! index of the lightest layer denser + ! than the buffer laye (nondimensional) + + real :: p_ref_cv(SZI_(G)) ! Reference pressure for the potential + ! density which defines the coordinate + ! variable, set to P_Ref, in Pa. + + logical :: in_boundary(SZI_(G)) ! True if there are no massive layers below, + ! where massive is defined as sufficiently thick that + ! the no-flux boundary conditions have not restricted + ! the entrainment - usually sqrt(Kd*dt). + + real :: b_denom_1 ! The first term in the denominator of b1 + ! (m for Bouss, kg/m^2 for non-Bouss) + real :: h_neglect ! A thickness that is so small it is usually lost + ! in roundoff and can be neglected + ! (m for Bouss and kg/m^2 for non-Bouss) + real :: h_neglect2 ! h_neglect^2 (m^2 for Bouss, kg^2/m^4 for non-Bouss) + real :: add_ent ! Entrainment that needs to be added when mixing tracers + ! (m for Bouss and kg/m^2 for non-Bouss) + real :: eaval ! eaval is 2*ea at velocity grid points (m for Bouss, kg/m^2 for non-Bouss) + real :: hval ! hval is 2*h at velocity grid points (m for Bouss, kg/m^2 for non-Bouss) + real :: h_tr ! h_tr is h at tracer points with a tiny thickness + ! added to ensure positive definiteness (m for Bouss, kg/m^2 for non-Bouss) + real :: Tr_ea_BBL ! The diffusive tracer thickness in the BBL that is + ! coupled to the bottom within a timestep (m) + + real :: htot(SZIB_(G)) ! The summed thickness from the bottom, in m. + real :: b1(SZIB_(G)), d1(SZIB_(G)) ! b1, c1, and d1 are variables used by the + real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. + + real :: Ent_int ! The diffusive entrainment rate at an interface + ! (H units = m for Bouss, kg/m^2 for non-Bouss). + real :: dt_mix ! amount of time over which to apply mixing (seconds) + real :: Idt ! inverse time step (1/s) + + type(p3d) :: z_ptrs(7) ! pointers to diagnostics to be interpolated to depth + integer :: num_z_diags ! number of diagnostics to be interpolated to depth + integer :: z_ids(7) ! id numbers of diagnostics to be interpolated to depth + integer :: dir_flag ! An integer encoding the directions in which to do halo updates. + logical :: showCallTree ! If true, show the call tree + integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m + + integer :: ig, jg ! global indices for testing testing itide point source (BDM) + logical :: avg_enabled ! for testing internal tides (BDM) + real :: Kd_add_here ! An added diffusivity in m2/s + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + nkmb = GV%nk_rho_varies + h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect*h_neglect + Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 + + + if (nz == 1) return + showCallTree = callTree_showQuery() + if (showCallTree) call callTree_enter("diabatic(), MOM_diabatic_driver.F90") + + + ! Offer diagnostics of various state varables at the start of diabatic + ! these are mostly for debugging purposes. + if (CS%id_u_predia > 0) call post_data(CS%id_u_predia, u, CS%diag) + if (CS%id_v_predia > 0) call post_data(CS%id_v_predia, v, CS%diag) + if (CS%id_h_predia > 0) call post_data(CS%id_h_predia, h, CS%diag) + if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) + if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) + if (CS%id_e_predia > 0) then + call find_eta(h, tv, GV%g_Earth, G, GV, eta) + call post_data(CS%id_e_predia, eta, CS%diag) + endif + + + ! set equivalence between the same bits of memory for these arrays + eaml => eatr ; ebml => ebtr + + ! inverse time step + Idt = 1.0 / dt + + if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & + "Module must be initialized before it is used.") + + if (CS%debug) then + call MOM_state_chksum("Start of diabatic ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("Start of diabatic", fluxes, G, haloshift=0) + endif + if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G) + + if (CS%debug_energy_req) & + call diapyc_energy_req_test(h, dt, tv, G, GV, CS%diapyc_en_rec_CSp) + + + call cpu_clock_begin(id_clock_set_diffusivity) + call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS%set_diff_CSp) + call cpu_clock_end(id_clock_set_diffusivity) + + ! Frazil formation keeps the temperature above the freezing point. + ! make_frazil is deliberately called at both the beginning and at + ! the end of the diabatic processes. + if (associated(tv%T) .AND. associated(tv%frazil)) then + ! For frazil diagnostic, the first call covers the first half of the time step + call enable_averaging(0.5*dt, Time_end - set_time(int(floor(0.5*dt+0.5))), CS%diag) + if (CS%frazil_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + temp_diag(i,j,k) = tv%T(i,j,k) + enddo ; enddo ; enddo + endif + + if (associated(fluxes%p_surf_full)) then + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) + else + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) + endif + if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)") + + if (CS%frazil_tendency_diag) then + call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) + if (CS%id_frazil_h > 0) call post_data(CS%id_frazil_h, h, CS%diag) + endif + call disable_averaging(CS%diag) + endif + ! For all other diabatic subroutines, the averaging window should be the entire diabatic timestep + call enable_averaging(dt, Time_end, CS%diag) + if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) + + if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then +!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_orig,h,eaml,ebml) + do k=1,nz ; do j=js,je ; do i=is,ie + h_orig(i,j,k) = h(i,j,k) ; eaml(i,j,k) = 0.0 ; ebml(i,j,k) = 0.0 + enddo ; enddo ; enddo + endif + + if (CS%use_geothermal) then + call cpu_clock_begin(id_clock_geothermal) + call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp) + call cpu_clock_end(id_clock_geothermal) + if (showCallTree) call callTree_waypoint("geothermal (diabatic)") + if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G) + endif + + ! Whenever thickness changes let the diag manager know, target grids + ! for vertical remapping may need to be regenerated. + call diag_update_remap_grids(CS%diag) + + ! Set_opacity estimates the optical properties of the water column. + ! It will need to be modified later to include information about the + ! biological properties and layer thicknesses. + if (associated(CS%optics)) & + call set_opacity(CS%optics, fluxes, G, GV, CS%opacity_CSp) + + if (CS%bulkmixedlayer) then + if (CS%debug) then + call MOM_forcing_chksum("Before mixedlayer", fluxes, G, haloshift=0) + endif + + if (CS%ML_mix_first > 0.0) then +! This subroutine +! (1) Cools the mixed layer. +! (2) Performs convective adjustment by mixed layer entrainment. +! (3) Heats the mixed layer and causes it to detrain to +! Monin-Obukhov depth or minimum mixed layer depth. +! (4) Uses any remaining TKE to drive mixed layer entrainment. +! (5) Possibly splits buffer layer into two isopycnal layers (when using isopycnal coordinate) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + + call cpu_clock_begin(id_clock_mixedlayer) + if (CS%ML_mix_first < 1.0) then + ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) + call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt*CS%ML_mix_first, & + eaml,ebml, G, GV, CS%bulkmixedlayer_CSp, CS%optics, & + Hml, CS%aggregate_FW_forcing, dt, last_call=.false.) + if (CS%salt_reject_below_ML) & + call insert_brine(h, tv, G, GV, fluxes, nkmb, CS%diabatic_aux_CSp, & + dt*CS%ML_mix_first, CS%id_brine_lay) + else + ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) + call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt, eaml, ebml, & + G, GV, CS%bulkmixedlayer_CSp, CS%optics, & + Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) + endif + + ! Keep salinity from falling below a small but positive threshold. + ! This constraint is needed for SIS1 ice model, which can extract + ! more salt than is present in the ocean. SIS2 does not suffer + ! from this limitation, in which case we can let salinity=0 and still + ! have salt conserved with SIS2 ice. So for SIS2, we can run with + ! BOUND_SALINITY=False in MOM.F90. + if (associated(tv%S) .and. associated(tv%salt_deficit)) & + call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) + call cpu_clock_end(id_clock_mixedlayer) + if (CS%debug) then + call MOM_state_chksum("After mixedlayer ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("After mixedlayer", fluxes, G, haloshift=0) + endif + if (showCallTree) call callTree_waypoint("done with 1st bulkmixedlayer (diabatic)") + if (CS%debugConservation) call MOM_state_stats('1st bulkmixedlayer', u, v, h, tv%T, tv%S, G) + endif + endif + + if (CS%debug) then + call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) + endif + if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then + if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then + call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eaml, ebml) + if (CS%debug) then + call hchksum(eaml, "after find_uv_at_h eaml",G%HI, scale=GV%H_to_m) + call hchksum(ebml, "after find_uv_at_h ebml",G%HI, scale=GV%H_to_m) + endif + else + call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + endif + if (showCallTree) call callTree_waypoint("done with find_uv_at_h (diabatic)") + endif + + if (CS%use_int_tides) then + ! This block provides an interface for the unresolved low-mode internal + ! tide module (BDM). + + ! PROVIDE ENERGY DISTRIBUTION (calculate time-varying energy source) + call set_int_tide_input(u, v, h, tv, fluxes, CS%int_tide_input, dt, G, GV, & + CS%int_tide_input_CSp) + ! CALCULATE MODAL VELOCITIES + cn(:,:,:) = 0.0 + if (CS%uniform_cg) then + ! SET TO CONSTANT VALUE TO TEST PROPAGATE CODE + do m=1,CS%nMode ; cn(:,:,m) = CS%cg_test ; enddo + else + call wave_speeds(h, tv, G, GV, CS%nMode, cn, full_halos=.true.) + ! uncomment the lines below for a hard-coded cn that changes linearly with latitude + !do j=G%jsd,G%jed ; do i=G%isd,G%ied + ! cn(i,j,:) = ((7.-1.)/14000000.)*G%geoLatBu(i,j) + (1.-((7.-1.)/14000000.)*-7000000.) + !enddo ; enddo + endif + + if (CS%int_tide_source_test) then + ! BUILD 2D ARRAY WITH POINT SOURCE FOR TESTING + ! This block of code should be moved into set_int_tide_input. -RWH + TKE_itidal_input_test(:,:) = 0.0 + avg_enabled = query_averaging_enabled(CS%diag,time_end=CS%time_end) + if (CS%time_end <= CS%time_max_source) then + do j=G%jsc,G%jec ; do i=G%isc,G%iec + !INPUT ARBITRARY ENERGY POINT SOURCE + if ((G%idg_offset + i == CS%int_tide_source_x) .and. & + (G%jdg_offset + j == CS%int_tide_source_y)) then + TKE_itidal_input_test(i,j) = 1.0 + endif + enddo ; enddo + endif + ! CALL ROUTINE USING PRESCRIBED KE FOR TESTING + call propagate_int_tide(h, tv, cn, TKE_itidal_input_test, & + CS%int_tide_input%tideamp, CS%int_tide_input%Nb, dt, G, GV, CS%int_tide_CSp) + else + ! CALL ROUTINE USING CALCULATED KE INPUT + call propagate_int_tide(h, tv, cn, CS%int_tide_input%TKE_itidal_input, & + CS%int_tide_input%tideamp, CS%int_tide_input%Nb, dt, G, GV, CS%int_tide_CSp) + endif + if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") + endif + + call cpu_clock_begin(id_clock_set_diffusivity) + ! Sets: Kd, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S + ! Also changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ???? + ! And sets visc%Kv_shear + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, CS%set_diff_CSp, Kd, Kd_int) + call cpu_clock_end(id_clock_set_diffusivity) + if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") + + if (CS%debug) then + call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, haloshift=0) + call MOM_thermovar_chksum("after set_diffusivity ", tv, G) + call hchksum(Kd, "after set_diffusivity Kd",G%HI,haloshift=0) + call hchksum(Kd_Int, "after set_diffusivity Kd_Int",G%HI,haloshift=0) + endif + + + if (CS%useKPP) then + call cpu_clock_begin(id_clock_kpp) + ! KPP needs the surface buoyancy flux but does not update state variables. + ! We could make this call higher up to avoid a repeat unpacking of the surface fluxes. + ! Sets: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux + ! NOTE: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux are returned as rates (i.e. stuff per second) + ! unlike other instances where the fluxes are integrated in time over a time-step. + call calculateBuoyancyFlux2d(G, GV, fluxes, CS%optics, h, tv%T, tv%S, tv, & + CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) + ! The KPP scheme calculates boundary layer diffusivities and non-local transport. + ! MOM6 implementation of KPP matches the boundary layer to zero interior diffusivity, + ! since the matching to nonzero interior diffusivity can be problematic. + ! Changes: Kd_int. Sets: KPP_NLTheat, KPP_NLTscalar + +!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,Kd_heat) +!$OMP do + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_salt(i,j,k) = Kd_int(i,j,k) + Kd_heat(i,j,k) = Kd_int(i,j,k) + enddo ; enddo ; enddo + if (associated(visc%Kd_extra_S)) then +!$OMP do + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_salt(i,j,k) = Kd_salt(i,j,k) + visc%Kd_extra_S(i,j,k) + enddo ; enddo ; enddo + endif + if (associated(visc%Kd_extra_T)) then +!$OMP do + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k) + enddo ; enddo ; enddo + endif +!$OMP end parallel + + call KPP_compute_BLD(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, & + fluxes%ustar, CS%KPP_buoy_flux) + + call KPP_calculate(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, & + fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, & + CS%KPP_NLTscalar, Waves=Waves) +!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,G,Kd_heat,Hml) + + if (associated(Hml)) then + call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G) + call pass_var(Hml, G%domain, halo=1) + endif + + if (.not. CS%KPPisPassive) then +!$OMP do + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_int(i,j,k) = min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) + enddo ; enddo ; enddo + if (associated(visc%Kd_extra_S)) then +!$OMP do + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kd_extra_S(i,j,k) = Kd_salt(i,j,k) - Kd_int(i,j,k) + enddo ; enddo ; enddo + endif + if (associated(visc%Kd_extra_T)) then +!$OMP do + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kd_extra_T(i,j,k) = Kd_heat(i,j,k) - Kd_int(i,j,k) + enddo ; enddo ; enddo + endif + endif ! not passive +!$OMP end parallel + call cpu_clock_end(id_clock_kpp) + if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") + if (CS%debug) then + call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("after KPP", fluxes, G, haloshift=0) + call MOM_thermovar_chksum("after KPP", tv, G) + call hchksum(Kd, "after KPP Kd",G%HI,haloshift=0) + call hchksum(Kd_Int, "after KPP Kd_Int",G%HI,haloshift=0) + endif + + endif ! endif for KPP + + ! Add vertical diff./visc. due to convection (computed via CVMix) + if (CS%use_CVMix_conv) then + call calculate_CVMix_conv(h, tv, G, GV, CS%CVMix_conv_csp, Hml) + + !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + do k=1,nz ; do j=js,je ; do i=is,ie + Kd_int(i,j,k) = Kd_int(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) + visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) + enddo ; enddo ; enddo + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + endif + + if (CS%useKPP) then + + call cpu_clock_begin(id_clock_kpp) + if (CS%debug) then + call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat",G%HI,haloshift=0) + call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar",G%HI,haloshift=0) + endif + ! Apply non-local transport of heat and salt + ! Changes: tv%T, tv%S + call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, dt, tv%T, tv%C_p) + call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, dt, tv%S) + call cpu_clock_end(id_clock_kpp) + if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") + if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G) + + if (CS%debug) then + call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, haloshift=0) + call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) + endif + + endif ! endif for KPP + + ! Differential diffusion done here. + ! Changes: tv%T, tv%S + ! If using matching within the KPP scheme, then this step needs to provide + ! a diffusivity and happen before KPP. But generally in MOM, we do not match + ! KPP boundary layer to interior, so this diffusivity can be computed when convenient. + if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T)) then + call cpu_clock_begin(id_clock_differential_diff) + + call differential_diffuse_T_S(h, tv, visc, dt, G, GV) + call cpu_clock_end(id_clock_differential_diff) + if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") + if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G) + + ! increment heat and salt diffusivity. + ! CS%useKPP==.true. already has extra_T and extra_S included + if (.not. CS%useKPP) then + do K=2,nz ; do j=js,je ; do i=is,ie + Kd_heat(i,j,K) = Kd_heat(i,j,K) + visc%Kd_extra_T(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + visc%Kd_extra_S(i,j,K) + enddo ; enddo ; enddo + endif + + + endif + + + ! This block sets ea, eb from Kd or Kd_int. + ! If using ALE algorithm, set ea=eb=Kd_int on interfaces for + ! use in the tri-diagonal solver. + ! Otherwise, call entrainment_diffusive() which sets ea and eb + ! based on KD and target densities (ie. does remapping as well). + if (CS%useALEalgorithm) then + + do j=js,je ; do i=is,ie + ea(i,j,1) = 0. + enddo ; enddo +!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_neglect,h,ea,GV,dt,Kd_int,eb) & +!$OMP private(hval) + do k=2,nz ; do j=js,je ; do i=is,ie + hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) + ea(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_int(i,j,k) + eb(i,j,k-1) = ea(i,j,k) + enddo ; enddo ; enddo + do j=js,je ; do i=is,ie + eb(i,j,nz) = 0. + enddo ; enddo + if (showCallTree) call callTree_waypoint("done setting ea,eb from Kd_int (diabatic)") + + else ! .not. CS%useALEalgorithm + ! When not using ALE, calculate layer entrainments/detrainments from + ! diffusivities and differences between layer and target densities + call cpu_clock_begin(id_clock_entrain) + ! Calculate appropriately limited diapycnal mass fluxes to account + ! for diapycnal diffusion and advection. Sets: ea, eb. Changes: kb + call Entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS%entrain_diffusive_CSp, & + ea, eb, kb, Kd_Lay=Kd, Kd_int=Kd_int) + call cpu_clock_end(id_clock_entrain) + if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)") + + endif ! endif for (CS%useALEalgorithm) + + if (CS%debug) then + call MOM_forcing_chksum("after calc_entrain ", fluxes, G, haloshift=0) + call MOM_thermovar_chksum("after calc_entrain ", tv, G) + call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, haloshift=0) + call hchksum(ea, "after calc_entrain ea", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(eb, "after calc_entrain eb", G%HI, haloshift=0, scale=GV%H_to_m) + endif + + ! Save fields before boundary forcing is applied for tendency diagnostics + if (CS%boundary_forcing_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + h_diag(i,j,k) = h(i,j,k) + temp_diag(i,j,k) = tv%T(i,j,k) + saln_diag(i,j,k) = tv%S(i,j,k) + enddo ; enddo ; enddo + endif + + ! Apply forcing when using the ALE algorithm + if (CS%useALEalgorithm) then + call cpu_clock_begin(id_clock_remap) + + ! Changes made to following fields: h, tv%T and tv%S. + + do k=1,nz ; do j=js,je ; do i=is,ie + h_prebound(i,j,k) = h(i,j,k) + enddo ; enddo ; enddo + if (CS%use_energetic_PBL) then + + skinbuoyflux(:,:) = 0.0 + call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, dt, fluxes, CS%optics, & + h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & + CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux) + + if (CS%debug) then + call hchksum(ea, "after applyBoundaryFluxes ea",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb, "after applyBoundaryFluxes eb",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(cTKE, "after applyBoundaryFluxes cTKE",G%HI,haloshift=0) + call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT",G%HI,haloshift=0) + call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS",G%HI,haloshift=0) + endif + + call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, & + CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + + ! If visc%MLD exists, copy the ePBL's MLD into it + if (associated(visc%MLD)) then + call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G) + call pass_var(visc%MLD, G%domain, halo=1) + Hml(:,:) = visc%MLD(:,:) + endif + + ! Augment the diffusivities due to those diagnosed in energetic_PBL. + do K=2,nz ; do j=js,je ; do i=is,ie + + if (CS%ePBL_is_additive) then + Kd_add_here = Kd_ePBL(i,j,K) + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) + else + Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) + visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) + endif + Ent_int = Kd_add_here * (GV%m_to_H**2 * dt) / & + (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) + eb(i,j,k-1) = eb(i,j,k-1) + Ent_int + ea(i,j,k) = ea(i,j,k) + Ent_int + Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here + + ! for diagnostics + Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_int(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_int(i,j,K) + + enddo ; enddo ; enddo + + if (CS%debug) then + call hchksum(ea, "after ePBL ea",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb, "after ePBL eb",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL",G%HI,haloshift=0) + endif + + else + call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, dt, fluxes, CS%optics, & + h, tv, CS%aggregate_FW_forcing, & + CS%evap_CFL_limit, CS%minimum_forcing_depth) + + endif ! endif for CS%use_energetic_PBL + + ! diagnose the tendencies due to boundary forcing + ! At this point, the diagnostic grids have not been updated since the call to the boundary layer scheme + ! so all tendency diagnostics need to be posted on h_diag, and grids rebuilt afterwards + if (CS%boundary_forcing_tendency_diag) then + call diagnose_boundary_forcing_tendency(tv, h, temp_diag, saln_diag, h_diag, dt, G, GV, CS) + if (CS%id_boundary_forcing_h > 0) call post_data(CS%id_boundary_forcing_h, h, CS%diag, alt_h = h_diag) + endif + ! Boundary fluxes may have changed T, S, and h + call diag_update_remap_grids(CS%diag) + + call cpu_clock_end(id_clock_remap) + if (CS%debug) then + call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, haloshift=0) + call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G) + call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, haloshift=0) + endif + if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") + if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G) + + endif ! endif for (CS%useALEalgorithm) + + ! Update h according to divergence of the difference between + ! ea and eb. We keep a record of the original h in hold. + ! In the following, the checks for negative values are to guard + ! against instances where entrainment drives a layer to + ! negative thickness. This situation will never happen if + ! enough iterations are permitted in Calculate_Entrainment. + ! Even if too few iterations are allowed, it is still guarded + ! against. In other words the checks are probably unnecessary. + !$OMP parallel do default(shared) + do j=js,je + do i=is,ie + hold(i,j,1) = h(i,j,1) + h(i,j,1) = h(i,j,1) + (eb(i,j,1) - ea(i,j,2)) + hold(i,j,nz) = h(i,j,nz) + h(i,j,nz) = h(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)) + if (h(i,j,1) <= 0.0) then + h(i,j,1) = GV%Angstrom + endif + if (h(i,j,nz) <= 0.0) then + h(i,j,nz) = GV%Angstrom + endif + enddo + do k=2,nz-1 ; do i=is,ie + hold(i,j,k) = h(i,j,k) + h(i,j,k) = h(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & + (eb(i,j,k) - ea(i,j,k+1))) + if (h(i,j,k) <= 0.0) then + h(i,j,k) = GV%Angstrom + endif + enddo ; enddo + enddo + ! Checks for negative thickness may have changed layer thicknesses + call diag_update_remap_grids(CS%diag) + + if (CS%debug) then + call MOM_state_chksum("after negative check ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("after negative check ", fluxes, G, haloshift=0) + call MOM_thermovar_chksum("after negative check ", tv, G) + endif + if (showCallTree) call callTree_waypoint("done with h=ea-eb (diabatic)") + if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G) + + + ! Here, T and S are updated according to ea and eb. + ! If using the bulk mixed layer, T and S are also updated + ! by surface fluxes (in fluxes%*). + ! This is a very long block. + if (CS%bulkmixedlayer) then + + if (associated(tv%T)) then + call cpu_clock_begin(id_clock_tridiag) + ! Temperature and salinity (as state variables) are treated + ! differently from other tracers to insure massless layers that + ! are lighter than the mixed layer have temperatures and salinities + ! that correspond to their prescribed densities. + if (CS%massless_match_targets) then + !$OMP parallel do default (shared) private(h_tr,b1,d1,c1,b_denom_1) + do j=js,je + do i=is,ie + h_tr = hold(i,j,1) + h_neglect + b1(i) = 1.0 / (h_tr + eb(i,j,1)) + d1(i) = h_tr * b1(i) + tv%T(i,j,1) = b1(i) * (h_tr*tv%T(i,j,1)) + tv%S(i,j,1) = b1(i) * (h_tr*tv%S(i,j,1)) + enddo + do k=2,nkmb ; do i=is,ie + c1(i,k) = eb(i,j,k-1) * b1(i) + h_tr = hold(i,j,k) + h_neglect + b_denom_1 = h_tr + d1(i)*ea(i,j,k) + b1(i) = 1.0 / (b_denom_1 + eb(i,j,k)) + if (k kb(i,j)) then + c1(i,k) = eb(i,j,k-1) * b1(i) + h_tr = hold(i,j,k) + h_neglect + b_denom_1 = h_tr + d1(i)*ea(i,j,k) + b1(i) = 1.0 / (b_denom_1 + eb(i,j,k)) + d1(i) = b_denom_1 * b1(i) + tv%T(i,j,k) = b1(i) * (h_tr*tv%T(i,j,k) + ea(i,j,k)*tv%T(i,j,k-1)) + tv%S(i,j,k) = b1(i) * (h_tr*tv%S(i,j,k) + ea(i,j,k)*tv%S(i,j,k-1)) + elseif (eb(i,j,k) < eb(i,j,k-1)) then ! (note that k < kb(i,j)) + ! The bottommost buffer layer might entrain all the mass from some + ! of the interior layers that are thin and lighter in the coordinate + ! density than that buffer layer. The T and S of these newly + ! massless interior layers are unchanged. + tv%T(i,j,nkmb) = tv%T(i,j,nkmb) + b1(i) * (eb(i,j,k-1) - eb(i,j,k)) * tv%T(i,j,k) + tv%S(i,j,nkmb) = tv%S(i,j,nkmb) + b1(i) * (eb(i,j,k-1) - eb(i,j,k)) * tv%S(i,j,k) + endif + enddo ; enddo + + do k=nz-1,nkmb,-1 ; do i=is,ie + if (k >= kb(i,j)) then + tv%T(i,j,k) = tv%T(i,j,k) + c1(i,k+1)*tv%T(i,j,k+1) + tv%S(i,j,k) = tv%S(i,j,k) + c1(i,k+1)*tv%S(i,j,k+1) + endif + enddo ; enddo + do i=is,ie ; if (kb(i,j) <= nz) then + tv%T(i,j,nkmb) = tv%T(i,j,nkmb) + c1(i,kb(i,j))*tv%T(i,j,kb(i,j)) + tv%S(i,j,nkmb) = tv%S(i,j,nkmb) + c1(i,kb(i,j))*tv%S(i,j,kb(i,j)) + endif ; enddo + do k=nkmb-1,1,-1 ; do i=is,ie + tv%T(i,j,k) = tv%T(i,j,k) + c1(i,k+1)*tv%T(i,j,k+1) + tv%S(i,j,k) = tv%S(i,j,k) + c1(i,k+1)*tv%S(i,j,k+1) + enddo ; enddo + enddo ! end of j loop + else ! .not. massless_match_targets + ! This simpler form allows T & S to be too dense for the layers + ! between the buffer layers and the interior. + ! Changes: T, S + if (CS%tracer_tridiag) then + call tracer_vertdiff(hold, ea, eb, dt, tv%T, G, GV) + call tracer_vertdiff(hold, ea, eb, dt, tv%S, G, GV) + else + call triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, tv%T, tv%S) + endif + endif ! massless_match_targets + call cpu_clock_end(id_clock_tridiag) + + endif ! endif for associated(T) + if (CS%debugConservation) call MOM_state_stats('BML tridiag', u, v, h, tv%T, tv%S, G) + + if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then + ! The mixed layer code has already been called, but there is some needed + ! bookkeeping. + !$OMP parallel do default(shared) + do k=1,nz ; do j=js,je ; do i=is,ie + hold(i,j,k) = h_orig(i,j,k) + ea(i,j,k) = ea(i,j,k) + eaml(i,j,k) + eb(i,j,k) = eb(i,j,k) + ebml(i,j,k) + enddo ; enddo ; enddo + if (CS%debug) then + call hchksum(ea, "after ea = ea + eaml",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb, "after eb = eb + ebml",G%HI,haloshift=0, scale=GV%H_to_m) + endif + endif + + if (CS%ML_mix_first < 1.0) then + ! Call the mixed layer code now, perhaps for a second time. + ! This subroutine (1) Cools the mixed layer. + ! (2) Performs convective adjustment by mixed layer entrainment. + ! (3) Heats the mixed layer and causes it to detrain to + ! Monin-Obukhov depth or minimum mixed layer depth. + ! (4) Uses any remaining TKE to drive mixed layer entrainment. + ! (5) Possibly splits the buffer layer into two isopycnal layers. + + call find_uv_at_h(u, v, hold, u_h, v_h, G, GV, ea, eb) + if (CS%debug) call MOM_state_chksum("find_uv_at_h1 ", u, v, h, G, GV, haloshift=0) + + dt_mix = min(dt,dt*(1.0 - CS%ML_mix_first)) + call cpu_clock_begin(id_clock_mixedlayer) + ! Changes: h, tv%T, tv%S, ea and eb (G is also inout???) + call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_mix, ea, eb, & + G, GV, CS%bulkmixedlayer_CSp, CS%optics, & + Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) + + if (CS%salt_reject_below_ML) & + call insert_brine(h, tv, G, GV, fluxes, nkmb, CS%diabatic_aux_CSp, dt_mix, & + CS%id_brine_lay) + + ! Keep salinity from falling below a small but positive threshold. + ! This constraint is needed for SIS1 ice model, which can extract + ! more salt than is present in the ocean. SIS2 does not suffer + ! from this limitation, in which case we can let salinity=0 and still + ! have salt conserved with SIS2 ice. So for SIS2, we can run with + ! BOUND_SALINITY=False in MOM.F90. + if (associated(tv%S) .and. associated(tv%salt_deficit)) & + call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) + + call cpu_clock_end(id_clock_mixedlayer) + if (showCallTree) call callTree_waypoint("done with 2nd bulkmixedlayer (diabatic)") + if (CS%debugConservation) call MOM_state_stats('2nd bulkmixedlayer', u, v, h, tv%T, tv%S, G) + endif + + else ! following block for when NOT using BULKMIXEDLAYER + + + ! calculate change in temperature & salinity due to dia-coordinate surface diffusion + if (associated(tv%T)) then + + if (CS%debug) then + call hchksum(ea, "before triDiagTS ea ",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb, "before triDiagTS eb ",G%HI,haloshift=0, scale=GV%H_to_m) + endif + call cpu_clock_begin(id_clock_tridiag) + + ! Keep salinity from falling below a small but positive threshold. + ! This constraint is needed for SIS1 ice model, which can extract + ! more salt than is present in the ocean. SIS2 does not suffer + ! from this limitation, in which case we can let salinity=0 and still + ! have salt conserved with SIS2 ice. So for SIS2, we can run with + ! BOUND_SALINITY=False in MOM.F90. + if (associated(tv%S) .and. associated(tv%salt_deficit)) & + call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) + + if (CS%diabatic_diff_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + temp_diag(i,j,k) = tv%T(i,j,k) + saln_diag(i,j,k) = tv%S(i,j,k) + enddo ; enddo ; enddo + endif + + ! Changes T and S via the tridiagonal solver; no change to h + if (CS%tracer_tridiag) then + call tracer_vertdiff(hold, ea, eb, dt, tv%T, G, GV) + call tracer_vertdiff(hold, ea, eb, dt, tv%S, G, GV) + else + call triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, tv%T, tv%S) + endif + + ! diagnose temperature, salinity, heat, and salt tendencies + ! Note: hold here refers to the thicknesses from before the dual-entraintment when using + ! the bulk mixed layer scheme. Otherwise in ALE-mode, layer thicknesses will have changed + ! In either case, tendencies should be posted on hold + if (CS%diabatic_diff_tendency_diag) then + call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, CS) + if (CS%id_diabatic_diff_h > 0) call post_data(CS%id_diabatic_diff_h, hold, CS%diag, alt_h = hold) + endif + + call cpu_clock_end(id_clock_tridiag) + if (showCallTree) call callTree_waypoint("done with triDiagTS (diabatic)") + + endif ! endif corresponding to if (associated(tv%T)) + if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G) + + + endif ! endif for the BULKMIXEDLAYER block + + + if (CS%debug) then + call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, haloshift=0) + call MOM_thermovar_chksum("after mixed layer ", tv, G) + call hchksum(ea, "after mixed layer ea", G%HI, scale=GV%H_to_m) + call hchksum(eb, "after mixed layer eb", G%HI, scale=GV%H_to_m) + endif + + if (.not. CS%useALEalgorithm) then + call cpu_clock_begin(id_clock_remap) + call regularize_layers(h, tv, dt, ea, eb, G, GV, CS%regularize_layers_CSp) + call cpu_clock_end(id_clock_remap) + if (showCallTree) call callTree_waypoint("done with regularize_layers (diabatic)") + if (CS%debugConservation) call MOM_state_stats('regularize_layers', u, v, h, tv%T, tv%S, G) + endif + + ! Whenever thickness changes let the diag manager know, as the + ! target grids for vertical remapping may need to be regenerated. + call diag_update_remap_grids(CS%diag) + + ! diagnostics + if ((CS%id_Tdif > 0) .or. (CS%id_Tdif_z > 0) .or. & + (CS%id_Tadv > 0) .or. (CS%id_Tadv_z > 0)) then + do j=js,je ; do i=is,ie + Tdif_flx(i,j,1) = 0.0 ; Tdif_flx(i,j,nz+1) = 0.0 + Tadv_flx(i,j,1) = 0.0 ; Tadv_flx(i,j,nz+1) = 0.0 + enddo ; enddo + !$OMP parallel do default(shared) + do K=2,nz ; do j=js,je ; do i=is,ie + Tdif_flx(i,j,K) = (Idt * 0.5*(ea(i,j,k) + eb(i,j,k-1))) * & + (tv%T(i,j,k-1) - tv%T(i,j,k)) + Tadv_flx(i,j,K) = (Idt * (ea(i,j,k) - eb(i,j,k-1))) * & + 0.5*(tv%T(i,j,k-1) + tv%T(i,j,k)) + enddo ; enddo ; enddo + endif + if ((CS%id_Sdif > 0) .or. (CS%id_Sdif_z > 0) .or. & + (CS%id_Sadv > 0) .or. (CS%id_Sadv_z > 0)) then + do j=js,je ; do i=is,ie + Sdif_flx(i,j,1) = 0.0 ; Sdif_flx(i,j,nz+1) = 0.0 + Sadv_flx(i,j,1) = 0.0 ; Sadv_flx(i,j,nz+1) = 0.0 + enddo ; enddo + !$OMP parallel do default(shared) + do K=2,nz ; do j=js,je ; do i=is,ie + Sdif_flx(i,j,K) = (Idt * 0.5*(ea(i,j,k) + eb(i,j,k-1))) * & + (tv%S(i,j,k-1) - tv%S(i,j,k)) + Sadv_flx(i,j,K) = (Idt * (ea(i,j,k) - eb(i,j,k-1))) * & + 0.5*(tv%S(i,j,k-1) + tv%S(i,j,k)) + enddo ; enddo ; enddo + endif + + ! mixing of passive tracers from massless boundary layers to interior + call cpu_clock_begin(id_clock_tracers) + if (CS%mix_boundary_tracers) then + Tr_ea_BBL = sqrt(dt*CS%Kd_BBL_tr) + !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) + do j=js,je + do i=is,ie + ebtr(i,j,nz) = eb(i,j,nz) + htot(i) = 0.0 + in_boundary(i) = (G%mask2dT(i,j) > 0.0) + enddo + do k=nz,2,-1 ; do i=is,ie + if (in_boundary(i)) then + htot(i) = htot(i) + h(i,j,k) + ! If diapycnal mixing has been suppressed because this is a massless + ! layer near the bottom, add some mixing of tracers between these + ! layers. This flux is based on the harmonic mean of the two + ! thicknesses, as this corresponds pretty closely (to within + ! differences in the density jumps between layers) with what is done + ! in the calculation of the fluxes in the first place. Kd_min_tr + ! should be much less than the values that have been set in Kd, + ! perhaps a molecular diffusivity. + add_ent = ((dt * CS%Kd_min_tr) * GV%m_to_H**2) * & + ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & + (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & + 0.5*(ea(i,j,k) + eb(i,j,k-1)) + if (htot(i) < Tr_ea_BBL) then + add_ent = max(0.0, add_ent, & + (Tr_ea_BBL - htot(i)) - min(ea(i,j,k),eb(i,j,k-1))) + elseif (add_ent < 0.0) then + add_ent = 0.0 ; in_boundary(i) = .false. + endif + + ebtr(i,j,k-1) = eb(i,j,k-1) + add_ent + eatr(i,j,k) = ea(i,j,k) + add_ent + else + ebtr(i,j,k-1) = eb(i,j,k-1) ; eatr(i,j,k) = ea(i,j,k) + endif + if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / & + (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & + h_neglect) + ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent + eatr(i,j,k) = eatr(i,j,k) + add_ent + endif ; endif + enddo ; enddo + do i=is,ie ; eatr(i,j,1) = ea(i,j,1) ; enddo + + enddo + + if (CS%useALEalgorithm) then + ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied + ! so hold should be h_orig + call call_tracer_column_fns(h_prebound, h, ea, eb, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug, & + evap_CFL_limit = CS%evap_CFL_limit, & + minimum_forcing_depth = CS%minimum_forcing_depth) + else + call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug) + endif + + elseif (associated(visc%Kd_extra_S)) then ! extra diffusivity for passive tracers + + do j=js,je ; do i=is,ie + ebtr(i,j,nz) = eb(i,j,nz) ; eatr(i,j,1) = ea(i,j,1) + enddo ; enddo + !$OMP parallel do default(shared) private(add_ent) + do k=nz,2,-1 ; do j=js,je ; do i=is,ie + if (visc%Kd_extra_S(i,j,k) > 0.0) then + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / & + (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & + h_neglect) + else + add_ent = 0.0 + endif + ebtr(i,j,k-1) = eb(i,j,k-1) + add_ent + eatr(i,j,k) = ea(i,j,k) + add_ent + enddo ; enddo ; enddo + + if (CS%useALEalgorithm) then + ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied + call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug,& + evap_CFL_limit = CS%evap_CFL_limit, & + minimum_forcing_depth = CS%minimum_forcing_depth) + else + call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug) + endif + + else + if (CS%useALEalgorithm) then + ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied + call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug, & + evap_CFL_limit = CS%evap_CFL_limit, & + minimum_forcing_depth = CS%minimum_forcing_depth) + else + call call_tracer_column_fns(hold, h, ea, eb, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug) + endif + + endif ! (CS%mix_boundary_tracers) + + + + call cpu_clock_end(id_clock_tracers) + + + ! sponges + if (CS%use_sponge) then + call cpu_clock_begin(id_clock_sponge) + if (associated(CS%ALE_sponge_CSp)) then + ! ALE sponge + call apply_ALE_sponge(h, dt, G, CS%ALE_sponge_CSp, CS%Time) + else + ! Layer mode sponge + if (CS%bulkmixedlayer .and. associated(tv%eqn_of_state)) then + do i=is,ie ; p_ref_cv(i) = tv%P_Ref ; enddo + !$OMP parallel do default(shared) + do j=js,je + call calculate_density(tv%T(:,j,1), tv%S(:,j,1), p_ref_cv, Rcv_ml(:,j), & + is, ie-is+1, tv%eqn_of_state) + enddo + call apply_sponge(h, dt, G, GV, ea, eb, CS%sponge_CSp, Rcv_ml) + else + call apply_sponge(h, dt, G, GV, ea, eb, CS%sponge_CSp) + endif + endif + call cpu_clock_end(id_clock_sponge) + if (CS%debug) then + call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, haloshift=0) + call MOM_thermovar_chksum("apply_sponge ", tv, G) + endif + endif ! CS%use_sponge + + +! Save the diapycnal mass fluxes as a diagnostic field. + if (associated(CDp%diapyc_vel)) then + !$OMP parallel do default(shared) + do j=js,je + do K=2,nz ; do i=is,ie + CDp%diapyc_vel(i,j,K) = Idt * (GV%H_to_m * (ea(i,j,k) - eb(i,j,k-1))) + enddo ; enddo + do i=is,ie + CDp%diapyc_vel(i,j,1) = 0.0 + CDp%diapyc_vel(i,j,nz+1) = 0.0 + enddo + enddo + endif + +! For momentum, it is only the net flux that homogenizes within +! the mixed layer. Vertical viscosity that is proportional to the +! mixed layer turbulence is applied elsewhere. + if (CS%bulkmixedlayer) then + if (CS%debug) then + call hchksum(ea, "before net flux rearrangement ea",G%HI, scale=GV%H_to_m) + call hchksum(eb, "before net flux rearrangement eb",G%HI, scale=GV%H_to_m) + endif + !$OMP parallel do default(shared) private(net_ent) + do j=js,je + do K=2,GV%nkml ; do i=is,ie + net_ent = ea(i,j,k) - eb(i,j,k-1) + ea(i,j,k) = max(net_ent, 0.0) + eb(i,j,k-1) = max(-net_ent, 0.0) + enddo ; enddo + enddo + if (CS%debug) then + call hchksum(ea, "after net flux rearrangement ea",G%HI, scale=GV%H_to_m) + call hchksum(eb, "after net flux rearrangement eb",G%HI, scale=GV%H_to_m) + endif + endif + +! Initialize halo regions of ea, eb, and hold to default values. + !$OMP parallel do default(shared) + do k=1,nz + do i=is-1,ie+1 + hold(i,js-1,k) = GV%Angstrom ; ea(i,js-1,k) = 0.0 ; eb(i,js-1,k) = 0.0 + hold(i,je+1,k) = GV%Angstrom ; ea(i,je+1,k) = 0.0 ; eb(i,je+1,k) = 0.0 + enddo + do j=js,je + hold(is-1,j,k) = GV%Angstrom ; ea(is-1,j,k) = 0.0 ; eb(is-1,j,k) = 0.0 + hold(ie+1,j,k) = GV%Angstrom ; ea(ie+1,j,k) = 0.0 ; eb(ie+1,j,k) = 0.0 + enddo + enddo + + call cpu_clock_begin(id_clock_pass) + if (G%symmetric) then ; dir_flag = To_All+Omit_Corners + else ; dir_flag = To_West+To_South+Omit_Corners ; endif + call create_group_pass(CS%pass_hold_eb_ea, hold, G%Domain, dir_flag, halo=1) + call create_group_pass(CS%pass_hold_eb_ea, eb, G%Domain, dir_flag, halo=1) + call create_group_pass(CS%pass_hold_eb_ea, ea, G%Domain, dir_flag, halo=1) + call do_group_pass(CS%pass_hold_eb_ea, G%Domain) + ! visc%Kv_shear is not in the group pass because it has larger vertical extent. + if (associated(visc%Kv_shear)) & + call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) + call cpu_clock_end(id_clock_pass) + + if (.not. CS%useALEalgorithm) then + ! Use a tridiagonal solver to determine effect of the diapycnal + ! advection on velocity field. It is assumed that water leaves + ! or enters the ocean with the surface velocity. + if (CS%debug) then + call MOM_state_chksum("before u/v tridiag ", u, v, h, G, GV, haloshift=0) + call hchksum(ea, "before u/v tridiag ea",G%HI, scale=GV%H_to_m) + call hchksum(eb, "before u/v tridiag eb",G%HI, scale=GV%H_to_m) + call hchksum(hold, "before u/v tridiag hold",G%HI, scale=GV%H_to_m) + endif + call cpu_clock_begin(id_clock_tridiag) + !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) + do j=js,je + do I=Isq,Ieq + if (associated(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,1) = u(I,j,1) + hval = (hold(i,j,1) + hold(i+1,j,1)) + (ea(i,j,1) + ea(i+1,j,1)) + h_neglect + b1(I) = 1.0 / (hval + (eb(i,j,1) + eb(i+1,j,1))) + d1(I) = hval * b1(I) + u(I,j,1) = b1(I) * (hval * u(I,j,1)) + enddo + do k=2,nz ; do I=Isq,Ieq + if (associated(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,k) = u(I,j,k) + c1(I,k) = (eb(i,j,k-1)+eb(i+1,j,k-1)) * b1(I) + eaval = ea(i,j,k) + ea(i+1,j,k) + hval = hold(i,j,k) + hold(i+1,j,k) + h_neglect + b1(I) = 1.0 / ((eb(i,j,k) + eb(i+1,j,k)) + (hval + d1(I)*eaval)) + d1(I) = (hval + d1(I)*eaval) * b1(I) + u(I,j,k) = (hval*u(I,j,k) + eaval*u(I,j,k-1))*b1(I) + enddo ; enddo + do k=nz-1,1,-1 ; do I=Isq,Ieq + u(I,j,k) = u(I,j,k) + c1(I,k+1)*u(I,j,k+1) + if (associated(ADp%du_dt_dia)) & + ADp%du_dt_dia(I,j,k) = (u(I,j,k) - ADp%du_dt_dia(I,j,k)) * Idt + enddo ; enddo + if (associated(ADp%du_dt_dia)) then + do I=Isq,Ieq + ADp%du_dt_dia(I,j,nz) = (u(I,j,nz)-ADp%du_dt_dia(I,j,nz)) * Idt + enddo + endif + enddo + if (CS%debug) then + call MOM_state_chksum("aft 1st loop tridiag ", u, v, h, G, GV, haloshift=0) + endif + !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) + do J=Jsq,Jeq + do i=is,ie + if (associated(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,1) = v(i,J,1) + hval = (hold(i,j,1) + hold(i,j+1,1)) + (ea(i,j,1) + ea(i,j+1,1)) + h_neglect + b1(i) = 1.0 / (hval + (eb(i,j,1) + eb(i,j+1,1))) + d1(I) = hval * b1(I) + v(i,J,1) = b1(i) * (hval * v(i,J,1)) + enddo + do k=2,nz ; do i=is,ie + if (associated(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,k) = v(i,J,k) + c1(i,k) = (eb(i,j,k-1)+eb(i,j+1,k-1)) * b1(i) + eaval = ea(i,j,k) + ea(i,j+1,k) + hval = hold(i,j,k) + hold(i,j+1,k) + h_neglect + b1(i) = 1.0 / ((eb(i,j,k) + eb(i,j+1,k)) + (hval + d1(i)*eaval)) + d1(i) = (hval + d1(i)*eaval) * b1(i) + v(i,J,k) = (hval*v(i,J,k) + eaval*v(i,J,k-1))*b1(i) + enddo ; enddo + do k=nz-1,1,-1 ; do i=is,ie + v(i,J,k) = v(i,J,k) + c1(i,k+1)*v(i,J,k+1) + if (associated(ADp%dv_dt_dia)) & + ADp%dv_dt_dia(i,J,k) = (v(i,J,k) - ADp%dv_dt_dia(i,J,k)) * Idt + enddo ; enddo + if (associated(ADp%dv_dt_dia)) then + do i=is,ie + ADp%dv_dt_dia(i,J,nz) = (v(i,J,nz)-ADp%dv_dt_dia(i,J,nz)) * Idt + enddo + endif + enddo + call cpu_clock_end(id_clock_tridiag) + if (CS%debug) then + call MOM_state_chksum("after u/v tridiag ", u, v, h, G, GV, haloshift=0) + endif + endif ! useALEalgorithm + + call disable_averaging(CS%diag) + ! Frazil formation keeps temperature above the freezing point. + ! make_frazil is deliberately called at both the beginning and at + ! the end of the diabatic processes. + if (associated(tv%T) .AND. associated(tv%frazil)) then + call enable_averaging(0.5*dt, Time_end, CS%diag) + if (CS%frazil_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + temp_diag(i,j,k) = tv%T(i,j,k) + enddo ; enddo ; enddo + endif + + if (associated(fluxes%p_surf_full)) then + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) + else + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) + endif + + if (CS%frazil_tendency_diag) then + call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) + if (CS%id_frazil_h > 0 ) call post_data(CS%id_frazil_h, h, CS%diag) + endif + + if (showCallTree) call callTree_waypoint("done with 2nd make_frazil (diabatic)") + if (CS%debugConservation) call MOM_state_stats('2nd make_frazil', u, v, h, tv%T, tv%S, G) + call disable_averaging(CS%diag) + + endif ! endif for frazil + + ! Diagnose the diapycnal diffusivities and other related quantities. + call enable_averaging(dt, Time_end, CS%diag) + + if (CS%id_Kd_interface > 0) call post_data(CS%id_Kd_interface, Kd_int, CS%diag) + if (CS%id_Kd_heat > 0) call post_data(CS%id_Kd_heat, Kd_heat, CS%diag) + if (CS%id_Kd_salt > 0) call post_data(CS%id_Kd_salt, Kd_salt, CS%diag) + if (CS%id_Kd_ePBL > 0) call post_data(CS%id_Kd_ePBL, Kd_ePBL, CS%diag) + + if (CS%id_ea > 0) call post_data(CS%id_ea, ea, CS%diag) + if (CS%id_eb > 0) call post_data(CS%id_eb, eb, CS%diag) + + if (CS%id_dudt_dia > 0) call post_data(CS%id_dudt_dia, ADp%du_dt_dia, CS%diag) + if (CS%id_dvdt_dia > 0) call post_data(CS%id_dvdt_dia, ADp%dv_dt_dia, CS%diag) + if (CS%id_wd > 0) call post_data(CS%id_wd, CDp%diapyc_vel, CS%diag) + + if (CS%id_MLD_003 > 0 .or. CS%id_subMLN2 > 0 .or. CS%id_mlotstsq > 0) then + call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03, G, GV, CS%diag, & + id_N2subML=CS%id_subMLN2, id_MLDsq=CS%id_mlotstsq) + endif + if (CS%id_MLD_0125 > 0) then + call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125, G, GV, CS%diag) + endif + if (CS%id_MLD_user > 0) then + call diagnoseMLDbyDensityDifference(CS%id_MLD_user, h, tv, CS%MLDdensityDifference, G, GV, CS%diag) + endif + + if (CS%id_Tdif > 0) call post_data(CS%id_Tdif, Tdif_flx, CS%diag) + if (CS%id_Tadv > 0) call post_data(CS%id_Tadv, Tadv_flx, CS%diag) + if (CS%id_Sdif > 0) call post_data(CS%id_Sdif, Sdif_flx, CS%diag) + if (CS%id_Sadv > 0) call post_data(CS%id_Sadv, Sadv_flx, CS%diag) + if (CS%use_int_tides) then + if (CS%id_cg1 > 0) call post_data(CS%id_cg1, cn(:,:,1),CS%diag) + do m=1,CS%nMode + if (CS%id_cn(m) > 0) call post_data(CS%id_cn(m),cn(:,:,m),CS%diag) + enddo + endif + + call disable_averaging(CS%diag) + + num_z_diags = 0 + if (CS%id_Kd_z > 0) then + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_Kd_z ; z_ptrs(num_z_diags)%p => Kd_int + endif + if (CS%id_Tdif_z > 0) then + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_Tdif_z ; z_ptrs(num_z_diags)%p => Tdif_flx + endif + if (CS%id_Tadv_z > 0) then + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_Tadv_z ; z_ptrs(num_z_diags)%p => Tadv_flx + endif + if (CS%id_Sdif_z > 0) then + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_Sdif_z ; z_ptrs(num_z_diags)%p => Sdif_flx + endif + if (CS%id_Sadv_z > 0) then + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_Sadv_z ; z_ptrs(num_z_diags)%p => Sadv_flx + endif + + if (num_z_diags > 0) & + call calc_Zint_diags(h, z_ptrs, z_ids, num_z_diags, G, GV, CS%diag_to_Z_CSp) + + if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G) + if (showCallTree) call callTree_leave("diabatic()") + +end subroutine legacy_diabatic + +!> This routine diagnoses tendencies from application of diabatic diffusion +!! using ALE algorithm. Note that layer thickness is not altered by +!! diabatic diffusion. +subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, CS) + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< thickness (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: temp_old !< temperature prior to diabatic physics + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: saln_old !< salinity prior to diabatic physics (PPT) + real, intent(in) :: dt !< time step (sec) + type(diabatic_CS), pointer :: CS !< module control structure + + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d + real, dimension(SZI_(G),SZJ_(G)) :: work_2d + real :: Idt + integer :: i, j, k, is, ie, js, je, nz + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + Idt = 1/dt + work_3d(:,:,:) = 0.0 + work_2d(:,:) = 0.0 + + + ! temperature tendency + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = (tv%T(i,j,k)-temp_old(i,j,k))*Idt + enddo ; enddo ; enddo + if (CS%id_diabatic_diff_temp_tend > 0) then + call post_data(CS%id_diabatic_diff_temp_tend, work_3d, CS%diag, alt_h = h) + endif + + ! heat tendency + if (CS%id_diabatic_diff_heat_tend > 0 .or. CS%id_diabatic_diff_heat_tend_2d > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = h(i,j,k) * GV%H_to_kg_m2 * tv%C_p * work_3d(i,j,k) + enddo ; enddo ; enddo + if (CS%id_diabatic_diff_heat_tend > 0) then + call post_data(CS%id_diabatic_diff_heat_tend, work_3d, CS%diag, alt_h = h) + endif + if (CS%id_diabatic_diff_heat_tend_2d > 0) then + do j=js,je ; do i=is,ie + work_2d(i,j) = 0.0 + do k=1,nz + work_2d(i,j) = work_2d(i,j) + work_3d(i,j,k) + enddo + enddo ; enddo + call post_data(CS%id_diabatic_diff_heat_tend_2d, work_2d, CS%diag) + endif + endif + + ! salinity tendency + if (CS%id_diabatic_diff_saln_tend > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = (tv%S(i,j,k)-saln_old(i,j,k))*Idt + enddo ; enddo ; enddo + call post_data(CS%id_diabatic_diff_saln_tend, work_3d, CS%diag, alt_h = h) + endif + + ! salt tendency + if (CS%id_diabatic_diff_salt_tend > 0 .or. CS%id_diabatic_diff_salt_tend_2d > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = h(i,j,k) * GV%H_to_kg_m2 * CS%ppt2mks * work_3d(i,j,k) + enddo ; enddo ; enddo + if (CS%id_diabatic_diff_salt_tend > 0) then + call post_data(CS%id_diabatic_diff_salt_tend, work_3d, CS%diag, alt_h = h) + endif + if (CS%id_diabatic_diff_salt_tend_2d > 0) then + do j=js,je ; do i=is,ie + work_2d(i,j) = 0.0 + do k=1,nz + work_2d(i,j) = work_2d(i,j) + work_3d(i,j,k) + enddo + enddo ; enddo + call post_data(CS%id_diabatic_diff_salt_tend_2d, work_2d, CS%diag) + endif + endif + +end subroutine diagnose_diabatic_diff_tendency + + +!> This routine diagnoses tendencies from application of boundary fluxes. +!! These impacts are generally 3d, in particular for penetrative shortwave. +!! Other fluxes contribute 3d in cases when the layers vanish or are very thin, +!! in which case we distribute the flux into k > 1 layers. +subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, & + dt, G, GV, CS) + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< thickness after boundary flux application (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: temp_old !< temperature prior to boundary flux application + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: saln_old !< salinity prior to boundary flux application (PPT) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_old !< thickness prior to boundary flux application (m or kg/m2) + real, intent(in) :: dt !< time step (sec) + type(diabatic_CS), pointer :: CS !< module control structure + + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d + real, dimension(SZI_(G),SZJ_(G)) :: work_2d + real :: Idt + integer :: i, j, k, is, ie, js, je, nz + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + Idt = 1/dt + work_3d(:,:,:) = 0.0 + work_2d(:,:) = 0.0 + + ! Thickness tendency + if (CS%id_boundary_forcing_h_tendency > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = (h(i,j,k) - h_old(i,j,k))*Idt + enddo ; enddo ; enddo + call post_data(CS%id_boundary_forcing_h_tendency, work_3d, CS%diag, alt_h = h_old) + endif + + ! temperature tendency + if (CS%id_boundary_forcing_temp_tend > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = (tv%T(i,j,k)-temp_old(i,j,k))*Idt + enddo ; enddo ; enddo + call post_data(CS%id_boundary_forcing_temp_tend, work_3d, CS%diag, alt_h = h_old) + endif + + ! heat tendency + if (CS%id_boundary_forcing_heat_tend > 0 .or. CS%id_boundary_forcing_heat_tend_2d > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = GV%H_to_kg_m2 * tv%C_p * Idt * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * temp_old(i,j,k)) + enddo ; enddo ; enddo + if (CS%id_boundary_forcing_heat_tend > 0) then + call post_data(CS%id_boundary_forcing_heat_tend, work_3d, CS%diag, alt_h = h_old) + endif + if (CS%id_boundary_forcing_heat_tend_2d > 0) then + do j=js,je ; do i=is,ie + work_2d(i,j) = 0.0 + do k=1,nz + work_2d(i,j) = work_2d(i,j) + work_3d(i,j,k) + enddo + enddo ; enddo + call post_data(CS%id_boundary_forcing_heat_tend_2d, work_2d, CS%diag) + endif + endif + + ! salinity tendency + if (CS%id_boundary_forcing_saln_tend > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = (tv%S(i,j,k)-saln_old(i,j,k))*Idt + enddo ; enddo ; enddo + call post_data(CS%id_boundary_forcing_saln_tend, work_3d, CS%diag, alt_h = h_old) + endif + + ! salt tendency + if (CS%id_boundary_forcing_salt_tend > 0 .or. CS%id_boundary_forcing_salt_tend_2d > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = GV%H_to_kg_m2 * CS%ppt2mks * Idt * (h(i,j,k) * tv%S(i,j,k) - h_old(i,j,k) * saln_old(i,j,k)) + enddo ; enddo ; enddo + if (CS%id_boundary_forcing_salt_tend > 0) then + call post_data(CS%id_boundary_forcing_salt_tend, work_3d, CS%diag, alt_h = h_old) + endif + if (CS%id_boundary_forcing_salt_tend_2d > 0) then + do j=js,je ; do i=is,ie + work_2d(i,j) = 0.0 + do k=1,nz + work_2d(i,j) = work_2d(i,j) + work_3d(i,j,k) + enddo + enddo ; enddo + call post_data(CS%id_boundary_forcing_salt_tend_2d, work_2d, CS%diag) + endif + endif + +end subroutine diagnose_boundary_forcing_tendency + + +!> This routine diagnoses tendencies for temperature and heat from frazil formation. +!! This routine is called twice from within subroutine diabatic; at start and at +!! end of the diabatic processes. The impacts from frazil are generally a function +!! of depth. Hence, when checking heat budget, be sure to remove HFSIFRAZIL from HFDS in k=1. +subroutine diagnose_frazil_tendency(tv, h, temp_old, dt, G, GV, CS) + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(diabatic_CS), pointer :: CS !< module control structure + type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< thickness (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: temp_old !< temperature prior to frazil formation + real, intent(in) :: dt !< time step (sec) + + real, dimension(SZI_(G),SZJ_(G)) :: work_2d + real :: Idt + integer :: i, j, k, is, ie, js, je, nz + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + Idt = 1/dt + + ! temperature tendency + if (CS%id_frazil_temp_tend > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + CS%frazil_temp_diag(i,j,k) = Idt * (tv%T(i,j,k)-temp_old(i,j,k)) + enddo ; enddo ; enddo + call post_data(CS%id_frazil_temp_tend, CS%frazil_temp_diag(:,:,:), CS%diag) + endif + + ! heat tendency + if (CS%id_frazil_heat_tend > 0 .or. CS%id_frazil_heat_tend_2d > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + CS%frazil_heat_diag(i,j,k) = GV%H_to_kg_m2 * tv%C_p * h(i,j,k) * Idt * (tv%T(i,j,k)-temp_old(i,j,k)) + enddo ; enddo ; enddo + if (CS%id_frazil_heat_tend > 0) call post_data(CS%id_frazil_heat_tend, CS%frazil_heat_diag(:,:,:), CS%diag) + + ! As a consistency check, we must have + ! FRAZIL_HEAT_TENDENCY_2d = HFSIFRAZIL + if (CS%id_frazil_heat_tend_2d > 0) then + do j=js,je ; do i=is,ie + work_2d(i,j) = 0.0 + do k=1,nz + work_2d(i,j) = work_2d(i,j) + CS%frazil_heat_diag(i,j,k) + enddo + enddo ; enddo + call post_data(CS%id_frazil_heat_tend_2d, work_2d, CS%diag) + endif + endif + +end subroutine diagnose_frazil_tendency + + +!> \namespace mom_diabatic_driver +!! +!! By Robert Hallberg, Alistair Adcroft, and Stephen Griffies +!! +!! This program contains the subroutine that, along with the +!! subroutines that it calls, implements diapycnal mass and momentum +!! fluxes and a bulk mixed layer. The diapycnal diffusion can be +!! used without the bulk mixed layer. +!! +!! \section section_diabatic Outline of MOM diabatic +!! +!! * diabatic first determines the (diffusive) diapycnal mass fluxes +!! based on the convergence of the buoyancy fluxes within each layer. +!! +!! * The dual-stream entrainment scheme of MacDougall and Dewar (JPO, +!! 1997) is used for combined diapycnal advection and diffusion, +!! calculated implicitly and potentially with the Richardson number +!! dependent mixing, as described by Hallberg (MWR, 2000). +!! +!! * Diapycnal advection is the residual of diapycnal diffusion, +!! so the fully implicit upwind differencing scheme that is used is +!! entirely appropriate. +!! +!! * The downward buoyancy flux in each layer is determined from +!! an implicit calculation based on the previously +!! calculated flux of the layer above and an estimated flux in the +!! layer below. This flux is subject to the following conditions: +!! (1) the flux in the top and bottom layers are set by the boundary +!! conditions, and (2) no layer may be driven below an Angstrom thick- +!! ness. If there is a bulk mixed layer, the buffer layer is treated +!! as a fixed density layer with vanishingly small diffusivity. +!! +!! diabatic takes 5 arguments: the two velocities (u and v), the +!! thicknesses (h), a structure containing the forcing fields, and +!! the length of time over which to act (dt). The velocities and +!! thickness are taken as inputs and modified within the subroutine. +!! There is no limit on the time step. + +end module MOM_legacy_diabatic_driver From fb9cec0ae75cb77ef101ea9a844ec814817d64eb Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 22 May 2018 17:18:12 -0400 Subject: [PATCH 0284/1072] Fixes failing readthedocs builds --- src/core/MOM_grid.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 75140c3d4f..d302b2c152 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -574,8 +574,8 @@ end subroutine MOM_grid_end !! - Metrics centered on v-points are labelled Cv (C-grid v location). e.g. dyCv is the y-distance between two -points. !! - Metrics centered on q-points are labelled Bu (B-grid u,v location). e.g. areaBu is the area centered on a q-point. !! -!! \image html Grid_metrics.png -!! "The labelling of distances (grid metrics) at various staggered location on an T-cell and around a q-point. +!! \image html Grid_metrics.png "The labelling of distances (grid metrics) at various staggered +!! location on an T-cell and around a q-point." !! !! Areas centered at T-, u-, v- and q- points are `areaT`, `areaCu`, `areaCv` and `areaBu` respectively. !! From 8b1fa39ee1410c2e8c48a9f27860dc7db2782206 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 23 May 2018 04:35:40 -0400 Subject: [PATCH 0285/1072] Simple code clean-up in MOM_ice_shelf.F90 Made a number of minor changes in MOM_ice_shelf.F90, including renaming a number of excessively long variable names, eliminating unused variables, and adding dOxyGen comments to some arguments and routines, and fixing code indentation in some routines. The suffix _bilinear is no longer needed in subroutine names and has been removed. All answers are bitwise identical. --- src/ice_shelf/MOM_ice_shelf.F90 | 597 +++++++++++++++----------------- 1 file changed, 287 insertions(+), 310 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index edafa092be..3023562422 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -62,7 +62,8 @@ module MOM_ice_shelf !> Control structure that contains ice shelf parameters and diagnostics handles type, public :: ice_shelf_CS ; private ! Parameters - type(MOM_restart_CS), pointer :: restart_CSp => NULL() + type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control + !! structure for the ice shelves type(ocean_grid_type) :: grid !< Grid for the ice-shelf model !type(dyn_horgrid_type), pointer :: dG !< Dynamic grid for the ice-shelf model type(ocean_grid_type), pointer :: ocn_grid => NULL() !< A pointer to the ocean model grid @@ -203,10 +204,10 @@ module MOM_ice_shelf !! override velocities; a homogeneous velocity !! condition will be specified (this seems to give !! the solver less difficulty) - u_face_mask_boundary => NULL(), & - v_face_mask_boundary => NULL(), & - u_flux_boundary_values => NULL(), & - v_flux_boundary_values => NULL(), & + u_face_mask_bdry => NULL(), & + v_face_mask_bdry => NULL(), & + u_flux_bdry_val => NULL(), & + v_flux_bdry_val => NULL(), & ! needed where u_face_mask is equal to 4, similary for v_face_mask umask => NULL(), vmask => NULL(), & !< masks on the actual degrees of freedom (B grid) !! 1=normal node, 3=inhomogeneous boundary node, @@ -219,14 +220,14 @@ module MOM_ice_shelf ! on q-points (B grid) tmask => NULL(), & ! masks for temperature boundary conditions ??? - ice_visc_bilinear => NULL(), & - thickness_boundary_values => NULL(), & - u_boundary_values => NULL(), & - v_boundary_values => NULL(), & - h_boundary_values => NULL(), & - t_boundary_values => NULL(), & - - taub_beta_eff_bilinear => NULL(), & ! nonlinear part of "linearized" basal stress - + ice_visc => NULL(), & + thickness_bdry_val => NULL(), & + u_bdry_val => NULL(), & + v_bdry_val => NULL(), & + h_bdry_val => NULL(), & + t_bdry_val => NULL(), & + + taub_beta_eff => NULL(), & ! nonlinear part of "linearized" basal stress - ! exact form depends on basal law exponent ! and/or whether flow is "hybridized" a la Goldberg 2011 @@ -333,8 +334,8 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) !!describe the surface state of the ocean type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(forcing), intent(inout) :: fluxes !< structure containing pointers to any possible - !! thermodynanamic or mass-flux forcing fields. - type(time_type), intent(in) :: Time !< Start time of the fluxes. + !! thermodynamic or mass-flux forcing fields. + type(time_type), intent(in) :: Time !< Start time of the fluxes. real, intent(in) :: time_step !< Length of time over which !! these fluxes will be applied, in s. type(ice_shelf_CS), pointer :: CS !< A pointer to the control structure @@ -403,7 +404,6 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) real :: u_at_h, v_at_h, Isqrt2 logical :: Sb_min_set, Sb_max_set character(4) :: stepnum - character(2) :: procnum real, parameter :: c2_3 = 2.0/3.0 integer :: i, j, is, ie, js, je, ied, jed, it1, it3, iters_vel_solve @@ -450,19 +450,19 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) CS%Time = Time if (CS%override_shelf_movement) then - CS%time_step = time_step - ! update shelf mass - if (CS%mass_from_file) call update_shelf_mass(G, CS, ISS, Time) + CS%time_step = time_step + ! update shelf mass + if (CS%mass_from_file) call update_shelf_mass(G, CS, ISS, Time) endif - if (CS%DEBUG) then - call hchksum(fluxes%frac_shelf_h, "frac_shelf_h before apply melting", G%HI, haloshift=0) - call hchksum(state%sst, "sst before apply melting", G%HI, haloshift=0) - call hchksum(state%sss, "sss before apply melting", G%HI, haloshift=0) - call hchksum(state%u, "u_ml before apply melting", G%HI, haloshift=0) - call hchksum(state%v, "v_ml before apply melting", G%HI, haloshift=0) - call hchksum(state%ocean_mass, "ocean_mass before apply melting", G%HI, haloshift=0) - endif + if (CS%DEBUG) then + call hchksum(fluxes%frac_shelf_h, "frac_shelf_h before apply melting", G%HI, haloshift=0) + call hchksum(state%sst, "sst before apply melting", G%HI, haloshift=0) + call hchksum(state%sss, "sss before apply melting", G%HI, haloshift=0) + call hchksum(state%u, "u_ml before apply melting", G%HI, haloshift=0) + call hchksum(state%v, "v_ml before apply melting", G%HI, haloshift=0) + call hchksum(state%ocean_mass, "ocean_mass before apply melting", G%HI, haloshift=0) + endif do j=js,je ! Find the pressure at the ice-ocean interface, averaged only over the @@ -560,13 +560,13 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) ! when the buoyancy flux is destabilizing. if (CS%const_gamma) then ! if using a constant gamma_T - ! note the different form, here I_Gam_T is NOT 1/Gam_T! - I_Gam_T = CS%Gamma_T_3EQ - I_Gam_S = CS%Gamma_T_3EQ/35. + ! note the different form, here I_Gam_T is NOT 1/Gam_T! + I_Gam_T = CS%Gamma_T_3EQ + I_Gam_S = CS%Gamma_T_3EQ/35. else - Gam_turb = I_VK * (ln_neut + (0.5 * I_ZETA_N - 1.0)) - I_Gam_T = 1.0 / (Gam_mol_t + Gam_turb) - I_Gam_S = 1.0 / (Gam_mol_s + Gam_turb) + Gam_turb = I_VK * (ln_neut + (0.5 * I_ZETA_N - 1.0)) + I_Gam_T = 1.0 / (Gam_mol_t + Gam_turb) + I_Gam_S = 1.0 / (Gam_mol_s + Gam_turb) endif wT_flux = dT_ustar * I_Gam_T @@ -595,9 +595,9 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) endif if (CS%const_gamma) then ! if using a constant gamma_T - ! note the different form, here I_Gam_T is NOT 1/Gam_T! - I_Gam_T = CS%Gamma_T_3EQ - I_Gam_S = CS%Gamma_T_3EQ/35. + ! note the different form, here I_Gam_T is NOT 1/Gam_T! + I_Gam_T = CS%Gamma_T_3EQ + I_Gam_S = CS%Gamma_T_3EQ/35. else I_Gam_T = 1.0 / (Gam_mol_t + Gam_turb) I_Gam_S = 1.0 / (Gam_mol_s + Gam_turb) @@ -636,17 +636,17 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) ISS%tflux_shelf(i,j) = 0.0 else if (CS%insulator) then - !no conduction/perfect insulator - ISS%tflux_shelf(i,j) = 0.0 - ISS%water_flux(i,j) = I_LF * (- ISS%tflux_shelf(i,j) + ISS%tflux_ocn(i,j)) + !no conduction/perfect insulator + ISS%tflux_shelf(i,j) = 0.0 + ISS%water_flux(i,j) = I_LF * (- ISS%tflux_shelf(i,j) + ISS%tflux_ocn(i,j)) else - ! With melting, from H&J 1999, eqs (31) & (26)... - ! Q_ice ~= cp_ice * (CS%Temp_Ice-T_freeze) * lprec - ! RhoLF*lprec = Q_ice + ISS%tflux_ocn(i,j) - ! lprec = (ISS%tflux_ocn(i,j)) / (LF + cp_ice * (T_freeze-CS%Temp_Ice)) - ISS%water_flux(i,j) = ISS%tflux_ocn(i,j) / & - (LF + CS%CP_Ice * (ISS%tfreeze(i,j) - CS%Temp_Ice)) + ! With melting, from H&J 1999, eqs (31) & (26)... + ! Q_ice ~= cp_ice * (CS%Temp_Ice-T_freeze) * lprec + ! RhoLF*lprec = Q_ice + ISS%tflux_ocn(i,j) + ! lprec = (ISS%tflux_ocn(i,j)) / (LF + cp_ice * (T_freeze-CS%Temp_Ice)) + ISS%water_flux(i,j) = ISS%tflux_ocn(i,j) / & + (LF + CS%CP_Ice * (ISS%tfreeze(i,j) - CS%Temp_Ice)) ISS%tflux_shelf(i,j) = ISS%tflux_ocn(i,j) - LF*ISS%water_flux(i,j) endif @@ -680,11 +680,11 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) endif ! dS_it < 0.0 if (Sb_min_set .and. Sb_max_set) then - ! Use the false position method for the next iteration. - Sbdry(i,j) = Sb_min + (Sb_max-Sb_min) * & - (dS_min / (dS_min - dS_max)) + ! Use the false position method for the next iteration. + Sbdry(i,j) = Sb_min + (Sb_max-Sb_min) * & + (dS_min / (dS_min - dS_max)) else - Sbdry(i,j) = Sbdry_it + Sbdry(i,j) = Sbdry_it endif ! Sb_min_set Sbdry(i,j) = Sbdry_it @@ -809,13 +809,9 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) endif if (CS%velocity_update_sub_counter == CS%nstep_velocity) then - call MOM_mesg("MOM_ice_shelf.F90, shelf_calc_flux: About to call velocity solver") - call ice_shelf_solve_outer(CS%dCS, ISS, G, CS%dCS%u_shelf, CS%dCS%v_shelf, iters_vel_solve, Time) - CS%velocity_update_sub_counter = 0 - endif endif @@ -852,12 +848,13 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) end subroutine shelf_calc_flux !> Changes the thickness (mass) of the ice shelf based on sub-ice-shelf melting -subroutine change_thickness_using_melt(ISS, G,time_step, fluxes, rho_ice, debug) +subroutine change_thickness_using_melt(ISS, G, time_step, fluxes, rho_ice, debug) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe !! the ice-shelf state - real, intent(in) :: time_step - type(forcing), intent(inout) :: fluxes + real, intent(in) :: time_step !< The time step for this update, in s. + type(forcing), intent(inout) :: fluxes !< structure containing pointers to any possible + !! thermodynamic or mass-flux forcing fields. real, intent(in) :: rho_ice !< The density of ice-shelf ice, in kg m-3. logical, optional, intent(in) :: debug !< If present and true, write chksums @@ -1199,7 +1196,7 @@ end subroutine add_shelf_flux subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fluxes, Time_in, solo_ice_sheet_in) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(ocean_grid_type), pointer :: ocn_grid - type(time_type), intent(inout) :: Time + type(time_type), intent(inout) :: Time !< The current model time type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure type(diag_ctrl), target, intent(in) :: diag type(forcing), optional, intent(inout) :: fluxes @@ -1223,7 +1220,6 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl character(len=200) :: IC_file,filename,inputdir character(len=40) :: var_name character(len=40) :: mdl = "MOM_ice_shelf" ! This module's name. - character(len=2) :: procnum integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, Isdq, Iedq, Jsdq, Jedq, iters integer :: wd_halos(2) logical :: read_TideAmp, shelf_mass_is_dynamic, debug @@ -1560,28 +1556,28 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! OVS vertically integrated Temperature allocate( dCS%t_shelf(isd:ied,jsd:jed) ) ; dCS%t_shelf(:,:) = -10.0 - allocate( dCS%t_boundary_values(isd:ied,jsd:jed) ) ; dCS%t_boundary_values(:,:) = -15.0 + allocate( dCS%t_bdry_val(isd:ied,jsd:jed) ) ; dCS%t_bdry_val(:,:) = -15.0 allocate( dCS%tmask(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%tmask(:,:) = -1.0 if (CS%active_shelf_dynamics) then ! DNG allocate( dCS%u_shelf(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%u_shelf(:,:) = 0.0 allocate( dCS%v_shelf(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%v_shelf(:,:) = 0.0 - allocate( dCS%u_boundary_values(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%u_boundary_values(:,:) = 0.0 - allocate( dCS%v_boundary_values(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%v_boundary_values(:,:) = 0.0 - allocate( dCS%h_boundary_values(isd:ied,jsd:jed) ) ; dCS%h_boundary_values(:,:) = 0.0 - allocate( dCS%thickness_boundary_values(isd:ied,jsd:jed) ) ; dCS%thickness_boundary_values(:,:) = 0.0 - allocate( dCS%ice_visc_bilinear(isd:ied,jsd:jed) ) ; dCS%ice_visc_bilinear(:,:) = 0.0 + allocate( dCS%u_bdry_val(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%u_bdry_val(:,:) = 0.0 + allocate( dCS%v_bdry_val(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%v_bdry_val(:,:) = 0.0 + allocate( dCS%h_bdry_val(isd:ied,jsd:jed) ) ; dCS%h_bdry_val(:,:) = 0.0 + allocate( dCS%thickness_bdry_val(isd:ied,jsd:jed) ) ; dCS%thickness_bdry_val(:,:) = 0.0 + allocate( dCS%ice_visc(isd:ied,jsd:jed) ) ; dCS%ice_visc(:,:) = 0.0 allocate( dCS%u_face_mask(Isdq:Iedq,jsd:jed) ) ; dCS%u_face_mask(:,:) = 0.0 allocate( dCS%v_face_mask(isd:ied,Jsdq:Jedq) ) ; dCS%v_face_mask(:,:) = 0.0 - allocate( dCS%u_face_mask_boundary(Isdq:Iedq,jsd:jed) ) ; dCS%u_face_mask_boundary(:,:) = -2.0 - allocate( dCS%v_face_mask_boundary(isd:ied,Jsdq:Jedq) ) ; dCS%v_face_mask_boundary(:,:) = -2.0 - allocate( dCS%u_flux_boundary_values(Isdq:Iedq,jsd:jed) ) ; dCS%u_flux_boundary_values(:,:) = 0.0 - allocate( dCS%v_flux_boundary_values(isd:ied,Jsdq:Jedq) ) ; dCS%v_flux_boundary_values(:,:) = 0.0 + allocate( dCS%u_face_mask_bdry(Isdq:Iedq,jsd:jed) ) ; dCS%u_face_mask_bdry(:,:) = -2.0 + allocate( dCS%v_face_mask_bdry(isd:ied,Jsdq:Jedq) ) ; dCS%v_face_mask_bdry(:,:) = -2.0 + allocate( dCS%u_flux_bdry_val(Isdq:Iedq,jsd:jed) ) ; dCS%u_flux_bdry_val(:,:) = 0.0 + allocate( dCS%v_flux_bdry_val(isd:ied,Jsdq:Jedq) ) ; dCS%v_flux_bdry_val(:,:) = 0.0 allocate( dCS%umask(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%umask(:,:) = -1.0 allocate( dCS%vmask(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%vmask(:,:) = -1.0 - allocate( dCS%taub_beta_eff_bilinear(isd:ied,jsd:jed) ) ; dCS%taub_beta_eff_bilinear(:,:) = 0.0 + allocate( dCS%taub_beta_eff(isd:ied,jsd:jed) ) ; dCS%taub_beta_eff(:,:) = 0.0 allocate( dCS%OD_rt(isd:ied,jsd:jed) ) ; dCS%OD_rt(:,:) = 0.0 allocate( dCS%OD_av(isd:ied,jsd:jed) ) ; dCS%OD_av(:,:) = 0.0 allocate( dCS%float_frac(isd:ied,jsd:jed) ) ; dCS%float_frac(:,:) = 0.0 @@ -1662,9 +1658,9 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! call register_restart_field(dCS%float_frac_rt, CS%float_frac_rt, vd, .true., CS%restart_CSp) vd = var_desc("viscosity","m","glens law ice visc",z_grid='1') - call register_restart_field(dCS%ice_visc_bilinear, vd, .true., CS%restart_CSp) + call register_restart_field(dCS%ice_visc, vd, .true., CS%restart_CSp) vd = var_desc("tau_b_beta","m","coefficient of basal traction",z_grid='1') - call register_restart_field(dCS%taub_beta_eff_bilinear, vd, .true., CS%restart_CSp) + call register_restart_field(dCS%taub_beta_eff, vd, .true., CS%restart_CSp) endif !GMM - I think we do not need to save ustar_shelf and iceshelf_melt in the restart file @@ -1707,9 +1703,9 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if (CS%active_shelf_dynamics) then ! the only reason to initialize boundary conds is if the shelf is dynamic - MJH - ! call initialize_ice_shelf_boundary ( CS%u_face_mask_boundary, CS%v_face_mask_boundary, & - ! CS%u_flux_boundary_values, CS%v_flux_boundary_values, & - ! CS%u_boundary_values, CS%v_boundary_values, CS%h_boundary_values, & + ! call initialize_ice_shelf_boundary ( CS%u_face_mask_bdry, CS%v_face_mask_bdry, & + ! CS%u_flux_bdry_val, CS%v_flux_bdry_val, & + ! CS%u_bdry_val, CS%v_bdry_val, CS%h_bdry_val, & ! ISS%hmask, G, param_file) endif @@ -1720,13 +1716,11 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call initialize_ice_thickness(ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, G, param_file) ! next make sure mass is consistent with thickness - do j=G%jsd,G%jed - do i=G%isd,G%ied - if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2)) then - ISS%mass_shelf(i,j) = ISS%h_shelf(i,j)*CS%density_ice - endif - enddo - enddo + do j=G%jsd,G%jed ; do i=G%isd,G%ied + if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2)) then + ISS%mass_shelf(i,j) = ISS%h_shelf(i,j)*CS%density_ice + endif + enddo ; enddo ! else ! Previous block for new_sim=.T., this block restores the state. elseif (.not.new_sim) then @@ -1748,12 +1742,12 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl do j=G%jsd,G%jed do i=G%isd,G%ied if (((i+G%idg_offset) == (G%domain%nihalo+1)).and.(dCS%u_face_mask(i-1,j) == 3)) then - dCS%u_shelf(i-1,j-1) = dCS%u_boundary_values(i-1,j-1) - dCS%u_shelf(i-1,j) = dCS%u_boundary_values(i-1,j) + dCS%u_shelf(i-1,j-1) = dCS%u_bdry_val(i-1,j-1) + dCS%u_shelf(i-1,j) = dCS%u_bdry_val(i-1,j) endif if (((j+G%jdg_offset) == (G%domain%njhalo+1)).and.(dCS%v_face_mask(i,j-1) == 3)) then - dCS%u_shelf(i-1,j-1) = dCS%u_boundary_values(i-1,j-1) - dCS%u_shelf(i,j-1) = dCS%u_boundary_values(i,j-1) + dCS%u_shelf(i-1,j-1) = dCS%u_bdry_val(i-1,j-1) + dCS%u_shelf(i,j-1) = dCS%u_bdry_val(i,j-1) endif enddo enddo @@ -1761,8 +1755,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call pass_var(dCS%OD_av,G%domain) call pass_var(dCS%float_frac,G%domain) - call pass_var(dCS%ice_visc_bilinear,G%domain) - call pass_var(dCS%taub_beta_eff_bilinear,G%domain) + call pass_var(dCS%ice_visc,G%domain) + call pass_var(dCS%taub_beta_eff,G%domain) call pass_vector(dCS%u_shelf, dCS%v_shelf, G%domain, TO_ALL, BGRID_NE) call pass_var(ISS%area_shelf_h,G%domain) call pass_var(ISS%h_shelf,G%domain) @@ -1866,7 +1860,6 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if (save_IC .and. .not.((dirs%input_filename(1:1) == 'r') .and. & (LEN_TRIM(dirs%input_filename) == 1))) then - call save_restart(dirs%output_directory, CS%Time, G, & CS%restart_CSp, filename=IC_file) endif @@ -2033,7 +2026,7 @@ subroutine update_shelf_mass(G, CS, ISS, Time) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(ice_shelf_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(inout) :: ISS !< The ice shelf state type that is being updated - type(time_type), intent(in) :: Time + type(time_type), intent(in) :: Time !< The current model time ! local variables integer :: i, j, is, ie, js, je @@ -2071,7 +2064,7 @@ subroutine initialize_diagnostic_fields(CS, ISS, G, Time) type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - type(time_type), intent(in) :: Time + type(time_type), intent(in) :: Time !< The current model time integer :: i, j, iters, isd, ied, jsd, jed real :: rhoi, rhow, OD @@ -2113,7 +2106,6 @@ subroutine ice_shelf_save_restart(CS, Time, directory, time_stamped, filename_su ! local variables type(ocean_grid_type), pointer :: G => NULL() character(len=200) :: restart_dir - character(2) :: procnum G => CS%grid @@ -2125,13 +2117,16 @@ subroutine ice_shelf_save_restart(CS, Time, directory, time_stamped, filename_su end subroutine ice_shelf_save_restart +!> This subroutine takes the velocity (on the Bgrid) and timesteps h_t = - div (uh) once. +!! Additionally, it will update the volume of ice in partially-filled cells, and update +!! hmask accordingly subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) - type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure - type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe + type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure + type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe !! the ice-shelf state - type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step !< time step in sec - type(time_type), intent(in) :: Time + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real, intent(in) :: time_step !< time step in sec + type(time_type), intent(in) :: Time !< The current model time ! time_step: time step in sec @@ -2175,7 +2170,6 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) real, dimension(SZDI_(G),SZDJ_(G),4) :: flux_enter integer :: isd, ied, jsd, jed, i, j, isc, iec, jsc, jec real :: rho, spy, thick_bd - character(len=2) :: procnum rho = CS%density_ice spy = 365 * 86400 ! seconds per year; is there a global constant for this? No - it is dependent upon a calendar. @@ -2190,9 +2184,9 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) do j=jsd,jed do i=isd,ied - thick_bd = CS%thickness_boundary_values(i,j) + thick_bd = CS%thickness_bdry_val(i,j) if (thick_bd /= 0.0) then - ISS%h_shelf(i,j) = CS%thickness_boundary_values(i,j) + ISS%h_shelf(i,j) = CS%thickness_bdry_val(i,j) endif enddo enddo @@ -2239,14 +2233,14 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) end subroutine ice_shelf_advect subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) - type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, dimension(SZDIB_(G),SZDJB_(G)), & intent(inout) :: u, v integer, intent(out) :: iters - type(time_type), intent(in) :: time + type(time_type), intent(in) :: Time !< The current model time real, dimension(SZDIB_(G),SZDJB_(G)) :: TAUDX, TAUDY, u_prev_iterate, v_prev_iterate, & u_bdry_cont, v_bdry_cont, Au, Av, err_u, err_v, & @@ -2260,7 +2254,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) real, dimension(8,4) :: Phi_temp real, dimension(2,2) :: X,Y character(2) :: iternum - character(2) :: procnum, numproc + character(2) :: numproc ! for GL interpolation - need to make this a readable parameter nsub = CS%n_sub_regularize @@ -2347,30 +2341,27 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) Phi(i,j,:,:) = Phi_temp enddo ; enddo - call calc_shelf_visc_bilinear(CS, ISS, G, u, v) + call calc_shelf_visc(CS, ISS, G, u, v) - call pass_var(CS%ice_visc_bilinear, G%domain) - call pass_var(CS%taub_beta_eff_bilinear, G%domain) + call pass_var(CS%ice_visc, G%domain) + call pass_var(CS%taub_beta_eff, G%domain) ! makes sure basal stress is only applied when it is supposed to be do j=G%jsd,G%jed ; do i=G%isd,G%ied - CS%taub_beta_eff_bilinear(i,j) = CS%taub_beta_eff_bilinear(i,j) * CS%float_frac(i,j) + CS%taub_beta_eff(i,j) = CS%taub_beta_eff(i,j) * CS%float_frac(i,j) enddo ; enddo - call apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, CS%ice_visc_bilinear, & - CS%taub_beta_eff_bilinear, float_cond, & + call apply_boundary_values(CS, ISS, G, time, Phisub, H_node, CS%ice_visc, & + CS%taub_beta_eff, float_cond, & rhoi/rhow, u_bdry_cont, v_bdry_cont) Au(:,:) = 0.0 ; Av(:,:) = 0.0 - call CG_action_bilinear(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & - CS%ice_visc_bilinear, float_cond, G%bathyT, CS%taub_beta_eff_bilinear, G%areaT, & + call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & + CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, G%areaT, & G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) -! write (procnum,'(I2)') mpp_pe() - - err_init = 0 ; err_tempu = 0; err_tempv = 0 do j=jsumstart,G%jecB do i=isumstart,G%iecB @@ -2406,26 +2397,26 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) if (is_root_pe()) print *,"linear solve done",iters," iterations" - call calc_shelf_visc_bilinear(CS, ISS, G, u, v) - call pass_var(CS%ice_visc_bilinear, G%domain) - call pass_var(CS%taub_beta_eff_bilinear, G%domain) + call calc_shelf_visc(CS, ISS, G, u, v) + call pass_var(CS%ice_visc, G%domain) + call pass_var(CS%taub_beta_eff, G%domain) ! makes sure basal stress is only applied when it is supposed to be do j=G%jsd,G%jed ; do i=G%isd,G%ied - CS%taub_beta_eff_bilinear(i,j) = CS%taub_beta_eff_bilinear(i,j) * CS%float_frac(i,j) + CS%taub_beta_eff(i,j) = CS%taub_beta_eff(i,j) * CS%float_frac(i,j) enddo ; enddo u_bdry_cont(:,:) = 0 ; v_bdry_cont(:,:) = 0 - call apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, CS%ice_visc_bilinear, & - CS%taub_beta_eff_bilinear, float_cond, & + call apply_boundary_values(CS, ISS, G, time, Phisub, H_node, CS%ice_visc, & + CS%taub_beta_eff, float_cond, & rhoi/rhow, u_bdry_cont, v_bdry_cont) Au(:,:) = 0 ; Av(:,:) = 0 - call CG_action_bilinear(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & - CS%ice_visc_bilinear, float_cond, G%bathyT, CS%taub_beta_eff_bilinear, G%areaT, & + call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & + CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, G%areaT, & G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) err_max = 0 @@ -2490,9 +2481,6 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) enddo - !write (procnum,'(I1)') mpp_pe() - !write (numproc,'(I1)') mpp_npes() - deallocate(Phi) deallocate(Phisub) @@ -2500,7 +2488,7 @@ end subroutine ice_shelf_solve_outer subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_cond, & hmask, conv_flag, iters, time, Phi, Phisub) - type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_dyn_CS),intent(in) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. @@ -2509,7 +2497,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: float_cond real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: hmask integer, intent(out) :: conv_flag, iters - type(time_type), intent(in) :: time + type(time_type), intent(in) :: Time !< The current model time real, dimension(SZDI_(G),SZDJ_(G),8,4), intent(in) :: Phi real, dimension(:,:,:,:,:,:), intent(in) :: Phisub @@ -2531,7 +2519,6 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c isc, iec, jsc, jec, is, js, ie, je, isumstart, jsumstart, & isdq, iedq, jsdq, jedq, iscq, iecq, jscq, jecq, nx_halo, ny_halo real :: tol, beta_k, alpha_k, area, dot_p1, dot_p2, resid0, cg_halo, dot_p1a, dot_p2a - character(1) :: procnum character(2) :: gridsize real, dimension(8,4) :: Phi_temp @@ -2556,8 +2543,8 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c ! Include the edge if tile is at the southern bdry; Should add a test to avoid this if reentrant. if (G%jsc+G%jdg_offset==G%jsg) jsumstart = G%jscB - call apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, CS%ice_visc_bilinear, & - CS%taub_beta_eff_bilinear, float_cond, & + call apply_boundary_values(CS, ISS, G, time, Phisub, H_node, CS%ice_visc, & + CS%taub_beta_eff, float_cond, & CS%density_ice/CS%density_ocean_avg, ubd, vbd) RHSu(:,:) = taudx(:,:) - ubd(:,:) @@ -2566,15 +2553,15 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c call pass_vector(RHSu, RHSv, G%domain, TO_ALL, BGRID_NE) - call matrix_diagonal_bilinear(CS, G, float_cond, H_node, CS%ice_visc_bilinear, & - CS%taub_beta_eff_bilinear, hmask, & + call matrix_diagonal(CS, G, float_cond, H_node, CS%ice_visc, & + CS%taub_beta_eff, hmask, & CS%density_ice/CS%density_ocean_avg, Phisub, DIAGu, DIAGv) ! DIAGu(:,:) = 1 ; DIAGv(:,:) = 1 call pass_vector(DIAGu, DIAGv, G%domain, TO_ALL, BGRID_NE) - call CG_action_bilinear(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, hmask, & - H_node, CS%ice_visc_bilinear, float_cond, G%bathyT, CS%taub_beta_eff_bilinear, & + call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, hmask, & + H_node, CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, & G%areaT, G, isc-1, iec+1, jsc-1, jec+1, CS%density_ice/CS%density_ocean_avg) call pass_vector(Au, Av, G%domain, TO_ALL, BGRID_NE) @@ -2644,8 +2631,8 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c Au(:,:) = 0 ; Av(:,:) = 0 - call CG_action_bilinear(Au, Av, Du, Dv, Phi, Phisub, CS%umask, CS%vmask, hmask, & - H_node, CS%ice_visc_bilinear, float_cond, G%bathyT, CS%taub_beta_eff_bilinear, & + call CG_action(Au, Av, Du, Dv, Phi, Phisub, CS%umask, CS%vmask, hmask, & + H_node, CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, & G%areaT, G, is, ie, js, je, CS%density_ice/CS%density_ocean_avg) ! Au, Av valid region moves in by 1 @@ -2854,13 +2841,13 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c do j=jsdq,jedq do i=isdq,iedq if (CS%umask(i,j) == 3) then - u(i,j) = CS%u_boundary_values(i,j) + u(i,j) = CS%u_bdry_val(i,j) elseif (CS%umask(i,j) == 0) then u(i,j) = 0 endif if (CS%vmask(i,j) == 3) then - v(i,j) = CS%v_boundary_values(i,j) + v(i,j) = CS%v_bdry_val(i,j) elseif (CS%vmask(i,j) == 0) then v(i,j) = 0 endif @@ -2878,7 +2865,7 @@ end subroutine ice_shelf_solve_inner subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_uflux, flux_enter) type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step + real, intent(in) :: time_step !< The time step for this update, in s. real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h0 real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_uflux @@ -2908,7 +2895,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl real, dimension(-2:2) :: stencil real :: u_face, & ! positive if out flux_diff_cell, phi, dxh, dyh, dxdyh - character (len=1) :: debug_str, procnum + character (len=1) :: debug_str is = G%isc-2 ; ie = G%iec+2 ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -2951,7 +2938,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl if (CS%u_face_mask(i-1,j) == 4.) then - flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_flux_boundary_values(i-1,j) / dxdyh + flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_flux_bdry_val(i-1,j) / dxdyh else @@ -2964,7 +2951,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then ! at western bdry but there is a ! thickness bdry condition, and the stencil contains it - stencil (-1) = CS%thickness_boundary_values(i-1,j) + stencil (-1) = CS%thickness_bdry_val(i-1,j) flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(-1) / dxdyh elseif (hmask(i-1,j) * hmask(i-2,j) == 1) then ! h(i-2) and h(i-1) are valid @@ -3002,7 +2989,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl if (CS%u_face_mask(i+1,j) == 4.) then - flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_flux_boundary_values(i+1,j) / dxdyh + flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_flux_bdry_val(i+1,j) / dxdyh else @@ -3059,16 +3046,16 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - flux_enter(i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_boundary_values(i-1,j) + flux_enter(i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_bdry_val(i-1,j) elseif (CS%u_face_mask(i-1,j) == 4.) then - flux_enter(i,j,1) = G%dyT(i,j) * time_step * CS%u_flux_boundary_values(i-1,j) + flux_enter(i,j,1) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j) endif if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) - flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_boundary_values(i+1,j) + flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_bdry_val(i+1,j) elseif (CS%u_face_mask(i+1,j) == 4.) then - flux_enter(i,j,2) = G%dyT(i,j) * time_step * CS%u_flux_boundary_values(i+1,j) + flux_enter(i,j,2) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) endif if ((i == is) .AND. (hmask(i,j) == 0) .AND. (hmask(i-1,j) == 1)) then @@ -3096,14 +3083,12 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl enddo ! j loop -! write (procnum,'(I1)') mpp_pe() - end subroutine ice_shelf_advect_thickness_x subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, h_after_vflux, flux_enter) type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step + real, intent(in) :: time_step !< The time step for this update, in s. real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h_after_uflux real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_vflux @@ -3133,7 +3118,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, real, dimension(-2:2) :: stencil real :: v_face, & ! positive if out flux_diff_cell, phi, dxh, dyh, dxdyh - character(len=1) :: debug_str, procnum + character(len=1) :: debug_str is = G%isc ; ie = G%iec ; js = G%jsc-1 ; je = G%jec+1 ; isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed i_off = G%idg_offset ; j_off = G%jdg_offset @@ -3172,7 +3157,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, if (CS%v_face_mask(i,j-1) == 4.) then - flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_flux_boundary_values(i,j-1) / dxdyh + flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_flux_bdry_val(i,j-1) / dxdyh else @@ -3222,7 +3207,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, if (CS%v_face_mask(i,j+1) == 4.) then - flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_flux_boundary_values(i,j+1) / dxdyh + flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_flux_bdry_val(i,j+1) / dxdyh else @@ -3269,16 +3254,16 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then v_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i,j-1)) - flux_enter(i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_boundary_values(i,j-1) + flux_enter(i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_bdry_val(i,j-1) elseif (CS%v_face_mask(i,j-1) == 4.) then - flux_enter(i,j,3) = G%dxT(i,j) * time_step * CS%v_flux_boundary_values(i,j-1) + flux_enter(i,j,3) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1) endif if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then v_face = 0.5 * (CS%u_shelf(i-1,j) + CS%u_shelf(i,j)) - flux_enter(i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_boundary_values(i,j+1) + flux_enter(i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_bdry_val(i,j+1) elseif (CS%v_face_mask(i,j+1) == 4.) then - flux_enter(i,j,4) = G%dxT(i,j) * time_step * CS%v_flux_boundary_values(i,j+1) + flux_enter(i,j,4) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1) endif if ((j == js) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j-1) == 1)) then @@ -3299,8 +3284,6 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, endif enddo ! i loop - !write (procnum,'(I1)') mpp_pe() - end subroutine ice_shelf_advect_thickness_y subroutine shelf_advance_front(CS, ISS, G, flux_enter) @@ -3546,7 +3529,6 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) real, dimension(SIZE(OD,1),SIZE(OD,2)) :: S, & ! surface elevation BASE ! basal elevation of shelf/stream - character(1) :: procnum real :: rho, rhow, sx, sy, neumann_val, dxh, dyh, dxdyh @@ -3573,8 +3555,6 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) BASE(:,:) = -G%bathyT(:,:) + OD(:,:) S(:,:) = BASE(:,:) + ISS%h_shelf(:,:) -! write (procnum,'(I1)') mpp_pe() - do j=jsc-1,jec+1 do i=isc-1,iec+1 cnt = 0 @@ -3718,7 +3698,7 @@ end subroutine calc_shelf_driving_stress subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new_sim) type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - type(time_type), intent(in) :: Time + type(time_type), intent(in) :: Time !< The current model time real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully coupled by an ice-shelf @@ -3752,15 +3732,15 @@ subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new do i=isd,ied if (hmask(i,j) == 3) then - CS%thickness_boundary_values(i,j) = input_thick + CS%thickness_bdry_val(i,j) = input_thick endif if ((hmask(i,j) == 0) .or. (hmask(i,j) == 1) .or. (hmask(i,j) == 2)) then if ((i <= iec).and.(i >= isc)) then if (CS%u_face_mask(i-1,j) == 3) then - CS%u_boundary_values(i-1,j-1) = (1 - ((G%geoLatBu(i-1,j-1) - 0.5*G%len_lat)*2./G%len_lat)**2) * & + CS%u_bdry_val(i-1,j-1) = (1 - ((G%geoLatBu(i-1,j-1) - 0.5*G%len_lat)*2./G%len_lat)**2) * & 1.5 * input_flux / input_thick - CS%u_boundary_values(i-1,j) = (1 - ((G%geoLatBu(i-1,j) - 0.5*G%len_lat)*2./G%len_lat)**2) * & + CS%u_bdry_val(i-1,j) = (1 - ((G%geoLatBu(i-1,j) - 0.5*G%len_lat)*2./G%len_lat)**2) * & 1.5 * input_flux / input_thick endif endif @@ -3769,12 +3749,12 @@ subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new if (.not.(new_sim)) then if (.not. G%symmetric) then if (((i+i_off) == (G%domain%nihalo+1)).and.(CS%u_face_mask(i-1,j) == 3)) then - CS%u_shelf(i-1,j-1) = CS%u_boundary_values(i-1,j-1) - CS%u_shelf(i-1,j) = CS%u_boundary_values(i-1,j) + CS%u_shelf(i-1,j-1) = CS%u_bdry_val(i-1,j-1) + CS%u_shelf(i-1,j) = CS%u_bdry_val(i-1,j) endif if (((j+j_off) == (G%domain%njhalo+1)).and.(CS%v_face_mask(i,j-1) == 3)) then - CS%u_shelf(i-1,j-1) = CS%u_boundary_values(i-1,j-1) - CS%u_shelf(i,j-1) = CS%u_boundary_values(i,j-1) + CS%u_shelf(i-1,j-1) = CS%u_bdry_val(i-1,j-1) + CS%u_shelf(i,j-1) = CS%u_bdry_val(i,j-1) endif endif endif @@ -3784,7 +3764,7 @@ subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new end subroutine init_boundary_values -subroutine CG_action_bilinear(uret, vret, u, v, Phi, Phisub, umask, vmask, hmask, H_node, & +subroutine CG_action(uret, vret, u, v, Phi, Phisub, umask, vmask, hmask, H_node, & nu, float_cond, D, beta, dxdyh, G, is, ie, js, je, dens_ratio) type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. @@ -3943,7 +3923,7 @@ subroutine CG_action_bilinear(uret, vret, u, v, Phi, Phisub, umask, vmask, hmask if (float_cond(i,j) == 1) then Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = D(i,j) Ucell(:,:) = u(i-1:i,j-1:j) ; Vcell(:,:) = v(i-1:i,j-1:j) ; Hcell(:,:) = H_node(i-1:i,j-1:j) - call CG_action_subgrid_basal_bilinear & + call CG_action_subgrid_basal & (Phisub, Hcell, Ucell, Vcell, area, basel, dens_ratio, Usubcontr, Vsubcontr, i, j) do iphi=1,2 ; do jphi=1,2 if (umask(i-2+iphi,j-2+jphi) == 1) then @@ -3958,9 +3938,9 @@ subroutine CG_action_bilinear(uret, vret, u, v, Phi, Phisub, umask, vmask, hmask endif enddo ; enddo -end subroutine CG_action_bilinear +end subroutine CG_action -subroutine CG_action_subgrid_basal_bilinear(Phisub, H, U, V, DXDYH, D, dens_ratio, Ucontr, Vcontr, iin, jin) +subroutine CG_action_subgrid_basal(Phisub, H, U, V, DXDYH, D, dens_ratio, Ucontr, Vcontr, iin, jin) real, dimension(:,:,:,:,:,:), intent(in) :: Phisub real, dimension(2,2), intent(in) :: H,U,V real, intent(in) :: DXDYH, D, dens_ratio @@ -4022,17 +4002,18 @@ subroutine CG_action_subgrid_basal_bilinear(Phisub, H, U, V, DXDYH, D, dens_rati enddo enddo -end subroutine CG_action_subgrid_basal_bilinear +end subroutine CG_action_subgrid_basal -subroutine matrix_diagonal_bilinear(CS, G, float_cond, H_node, nu, beta, hmask, dens_ratio, & - Phisub, u_diagonal, v_diagonal) +subroutine matrix_diagonal(CS, G, float_cond, H_node, nu, beta, hmask, dens_ratio, & + Phisub, u_diagonal, v_diagonal) type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: float_cond - real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: H_node + real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: H_node !< The ice shelf thickness at nodal + !! (corner) points, in m. real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: nu real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: beta real, dimension(SZDI_(G),SZDJ_(G)), & @@ -4144,7 +4125,7 @@ subroutine matrix_diagonal_bilinear(CS, G, float_cond, H_node, nu, beta, hmask, if (float_cond(i,j) == 1) then Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%bathyT(i,j) Hcell(:,:) = H_node(i-1:i,j-1:j) - call CG_diagonal_subgrid_basal_bilinear & + call CG_diagonal_subgrid_basal & (Phisub, Hcell, dxdyh, basel, dens_ratio, Usubcontr, Vsubcontr) do iphi=1,2 ; do jphi=1,2 if (CS%umask(i-2+iphi,j-2+jphi) == 1) then @@ -4155,9 +4136,9 @@ subroutine matrix_diagonal_bilinear(CS, G, float_cond, H_node, nu, beta, hmask, endif endif ; enddo ; enddo -end subroutine matrix_diagonal_bilinear +end subroutine matrix_diagonal -subroutine CG_diagonal_subgrid_basal_bilinear (Phisub, H, DXDYH, D, dens_ratio, Ucontr, Vcontr) +subroutine CG_diagonal_subgrid_basal (Phisub, H, DXDYH, D, dens_ratio, Ucontr, Vcontr) real, dimension(:,:,:,:,:,:), intent(in) :: Phisub real, dimension(2,2), intent(in) :: H real, intent(in) :: DXDYH, D, dens_ratio @@ -4194,24 +4175,25 @@ subroutine CG_diagonal_subgrid_basal_bilinear (Phisub, H, DXDYH, D, dens_ratio, enddo enddo -end subroutine CG_diagonal_subgrid_basal_bilinear +end subroutine CG_diagonal_subgrid_basal -subroutine apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, nu, beta, float_cond, & - dens_ratio, u_boundary_contr, v_boundary_contr) +subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, float_cond, & + dens_ratio, u_bdry_contr, v_bdry_contr) type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - type(time_type), intent(in) :: Time + type(time_type), intent(in) :: Time !< The current model time real, dimension(:,:,:,:,:,:), intent(in) :: Phisub - real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: H_node + real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: H_node !< The ice shelf thickness at nodal + !! (corner) points, in m. real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: nu real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: beta real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: float_cond real :: dens_ratio - real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u_boundary_contr, v_boundary_contr + real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u_bdry_contr, v_bdry_contr ! this will be a per-setup function. the boundary values of thickness and velocity ! (and possibly other variables) will be updated in this function @@ -4266,35 +4248,35 @@ subroutine apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, nu, do iq=1,2 ; do jq=1,2 - uq = CS%u_boundary_values(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + & - CS%u_boundary_values(i,j-1) * xquad(iq) * xquad(3-jq) + & - CS%u_boundary_values(i-1,j) * xquad(3-iq) * xquad(jq) + & - CS%u_boundary_values(i,j) * xquad(iq) * xquad(jq) + uq = CS%u_bdry_val(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + & + CS%u_bdry_val(i,j-1) * xquad(iq) * xquad(3-jq) + & + CS%u_bdry_val(i-1,j) * xquad(3-iq) * xquad(jq) + & + CS%u_bdry_val(i,j) * xquad(iq) * xquad(jq) - vq = CS%v_boundary_values(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + & - CS%v_boundary_values(i,j-1) * xquad(iq) * xquad(3-jq) + & - CS%v_boundary_values(i-1,j) * xquad(3-iq) * xquad(jq) + & - CS%v_boundary_values(i,j) * xquad(iq) * xquad(jq) + vq = CS%v_bdry_val(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + & + CS%v_bdry_val(i,j-1) * xquad(iq) * xquad(3-jq) + & + CS%v_bdry_val(i-1,j) * xquad(3-iq) * xquad(jq) + & + CS%v_bdry_val(i,j) * xquad(iq) * xquad(jq) - ux = CS%u_boundary_values(i-1,j-1) * Phi(1,2*(jq-1)+iq) + & - CS%u_boundary_values(i,j-1) * Phi(3,2*(jq-1)+iq) + & - CS%u_boundary_values(i-1,j) * Phi(5,2*(jq-1)+iq) + & - CS%u_boundary_values(i,j) * Phi(7,2*(jq-1)+iq) + ux = CS%u_bdry_val(i-1,j-1) * Phi(1,2*(jq-1)+iq) + & + CS%u_bdry_val(i,j-1) * Phi(3,2*(jq-1)+iq) + & + CS%u_bdry_val(i-1,j) * Phi(5,2*(jq-1)+iq) + & + CS%u_bdry_val(i,j) * Phi(7,2*(jq-1)+iq) - vx = CS%v_boundary_values(i-1,j-1) * Phi(1,2*(jq-1)+iq) + & - CS%v_boundary_values(i,j-1) * Phi(3,2*(jq-1)+iq) + & - CS%v_boundary_values(i-1,j) * Phi(5,2*(jq-1)+iq) + & - CS%v_boundary_values(i,j) * Phi(7,2*(jq-1)+iq) + vx = CS%v_bdry_val(i-1,j-1) * Phi(1,2*(jq-1)+iq) + & + CS%v_bdry_val(i,j-1) * Phi(3,2*(jq-1)+iq) + & + CS%v_bdry_val(i-1,j) * Phi(5,2*(jq-1)+iq) + & + CS%v_bdry_val(i,j) * Phi(7,2*(jq-1)+iq) - uy = CS%u_boundary_values(i-1,j-1) * Phi(2,2*(jq-1)+iq) + & - CS%u_boundary_values(i,j-1) * Phi(4,2*(jq-1)+iq) + & - CS%u_boundary_values(i-1,j) * Phi(6,2*(jq-1)+iq) + & - CS%u_boundary_values(i,j) * Phi(8,2*(jq-1)+iq) + uy = CS%u_bdry_val(i-1,j-1) * Phi(2,2*(jq-1)+iq) + & + CS%u_bdry_val(i,j-1) * Phi(4,2*(jq-1)+iq) + & + CS%u_bdry_val(i-1,j) * Phi(6,2*(jq-1)+iq) + & + CS%u_bdry_val(i,j) * Phi(8,2*(jq-1)+iq) - vy = CS%v_boundary_values(i-1,j-1) * Phi(2,2*(jq-1)+iq) + & - CS%v_boundary_values(i,j-1) * Phi(4,2*(jq-1)+iq) + & - CS%v_boundary_values(i-1,j) * Phi(6,2*(jq-1)+iq) + & - CS%v_boundary_values(i,j) * Phi(8,2*(jq-1)+iq) + vy = CS%v_bdry_val(i-1,j-1) * Phi(2,2*(jq-1)+iq) + & + CS%v_bdry_val(i,j-1) * Phi(4,2*(jq-1)+iq) + & + CS%v_bdry_val(i-1,j) * Phi(6,2*(jq-1)+iq) + & + CS%v_bdry_val(i,j) * Phi(8,2*(jq-1)+iq) do iphi=1,2 ; do jphi=1,2 @@ -4313,12 +4295,12 @@ subroutine apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, nu, if (CS%umask(i-2+iphi,j-2+jphi) == 1) then - u_boundary_contr(i-2+iphi,j-2+jphi) = u_boundary_contr(i-2+iphi,j-2+jphi) + & + u_bdry_contr(i-2+iphi,j-2+jphi) = u_bdry_contr(i-2+iphi,j-2+jphi) + & .25 * dxdyh * nu(i,j) * ( (4*ux+2*vy) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & (uy+vx) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq) ) if (float_cond(i,j) == 0) then - u_boundary_contr(i-2+iphi,j-2+jphi) = u_boundary_contr(i-2+iphi,j-2+jphi) + & + u_bdry_contr(i-2+iphi,j-2+jphi) = u_bdry_contr(i-2+iphi,j-2+jphi) + & .25 * beta(i,j) * dxdyh * uq * xquad(ilq) * xquad(jlq) endif @@ -4327,12 +4309,12 @@ subroutine apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, nu, if (CS%vmask(i-2+iphi,j-2+jphi) == 1) then - v_boundary_contr(i-2+iphi,j-2+jphi) = v_boundary_contr(i-2+iphi,j-2+jphi) + & + v_bdry_contr(i-2+iphi,j-2+jphi) = v_bdry_contr(i-2+iphi,j-2+jphi) + & .25 * dxdyh * nu(i,j) * ( (uy+vx) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & (4*vy+2*ux) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq)) if (float_cond(i,j) == 0) then - v_boundary_contr(i-2+iphi,j-2+jphi) = v_boundary_contr(i-2+iphi,j-2+jphi) + & + v_bdry_contr(i-2+iphi,j-2+jphi) = v_bdry_contr(i-2+iphi,j-2+jphi) + & .25 * beta(i,j) * dxdyh * vq * xquad(ilq) * xquad(jlq) endif @@ -4342,17 +4324,17 @@ subroutine apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, nu, if (float_cond(i,j) == 1) then Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%bathyT(i,j) - Ucell(:,:) = CS%u_boundary_values(i-1:i,j-1:j) ; Vcell(:,:) = CS%v_boundary_values(i-1:i,j-1:j) + Ucell(:,:) = CS%u_bdry_val(i-1:i,j-1:j) ; Vcell(:,:) = CS%v_bdry_val(i-1:i,j-1:j) Hcell(:,:) = H_node(i-1:i,j-1:j) - call CG_action_subgrid_basal_bilinear & + call CG_action_subgrid_basal & (Phisub, Hcell, Ucell, Vcell, dxdyh, basel, dens_ratio, Usubcontr, Vsubcontr) do iphi=1,2 ; do jphi = 1,2 if (CS%umask(i-2+iphi,j-2+jphi) == 1) then - u_boundary_contr(i-2+iphi,j-2+jphi) = u_boundary_contr(i-2+iphi,j-2+jphi) + & + u_bdry_contr(i-2+iphi,j-2+jphi) = u_bdry_contr(i-2+iphi,j-2+jphi) + & Usubcontr(iphi,jphi) * beta(i,j) endif if (CS%vmask(i-2+iphi,j-2+jphi) == 1) then - v_boundary_contr(i-2+iphi,j-2+jphi) = v_boundary_contr(i-2+iphi,j-2+jphi) + & + v_bdry_contr(i-2+iphi,j-2+jphi) = v_bdry_contr(i-2+iphi,j-2+jphi) + & Vsubcontr(iphi,jphi) * beta(i,j) endif enddo ; enddo @@ -4360,15 +4342,18 @@ subroutine apply_boundary_values_bilinear(CS, ISS, G, time, Phisub, H_node, nu, endif endif ; enddo ; enddo -end subroutine apply_boundary_values_bilinear +end subroutine apply_boundary_values -subroutine calc_shelf_visc_bilinear(CS, ISS, G, u, v) +subroutine calc_shelf_visc(CS, ISS, G, u, v) type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent(inout) :: u, v + real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & + intent(inout) :: u !< The zonal ice shelf velocity, in m/s. + real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & + intent(inout) :: v !< The meridional ice shelf velocity, in m/s. ! update DEPTH_INTEGRATED viscosity, based on horizontal strain rates - this is for bilinear FEM solve ! so there is an "upper" and "lower" bilinear viscosity @@ -4405,19 +4390,19 @@ subroutine calc_shelf_visc_bilinear(CS, ISS, G, u, v) uy = (u(i,j) - u(i,j-1) + u(i-1,j) - u(i-1,j-1)) / (2*dyh) vy = (v(i,j) - v(i,j-1) + v(i-1,j) - v(i-1,j-1)) / (2*dyh) - CS%ice_visc_bilinear(i,j) = .5 * A**(-1/n) * & + CS%ice_visc(i,j) = .5 * A**(-1/n) * & (ux**2+vy**2+ux*vy+0.25*(uy+vx)**2+eps_min**2) ** ((1-n)/(2*n)) * & ISS%h_shelf(i,j) umid = (u(i,j) + u(i,j-1) + u(i-1,j) + u(i-1,j-1))/4 vmid = (v(i,j) + v(i,j-1) + v(i-1,j) + v(i-1,j-1))/4 unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) - CS%taub_beta_eff_bilinear(i,j) = C_basal_friction * unorm ** (n_basal_friction-1) + CS%taub_beta_eff(i,j) = C_basal_friction * unorm ** (n_basal_friction-1) endif enddo enddo -end subroutine calc_shelf_visc_bilinear +end subroutine calc_shelf_visc subroutine update_OD_ffrac(CS, G, ocean_mass, counter, nstep_velocity, time_step, velocity_update_time_step) type(ice_shelf_dyn_CS), intent(inout):: CS !< A pointer to the ice shelf control structure @@ -4425,7 +4410,7 @@ subroutine update_OD_ffrac(CS, G, ocean_mass, counter, nstep_velocity, time_step real, dimension(G%isd:,G%jsd:) :: ocean_mass integer,intent(in) :: counter integer,intent(in) :: nstep_velocity - real,intent(in) :: time_step + real,intent(in) :: time_step !< The time step for this update, in s. real,intent(in) :: velocity_update_time_step integer :: isc, iec, jsc, jec, i, j @@ -4586,8 +4571,6 @@ subroutine bilinear_shape_functions_subgrid (Phisub, nsub) ! | | ! 1 - 2 - - integer :: i, j, k, l, qx, qy, indx, indy real,dimension(2) :: xquad real :: x0, y0, x, y, val, fracx @@ -4627,7 +4610,7 @@ end subroutine bilinear_shape_functions_subgrid subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face_mask) - type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_dyn_CS),intent(in) :: CS !< A pointer to the ice shelf dynamics control structure type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are @@ -4678,7 +4661,7 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face do k=0,1 - select case (int(CS%u_face_mask_boundary(i-1+k,j))) + select case (int(CS%u_face_mask_bdry(i-1+k,j))) case (3) umask(i-1+k,j-1:j)=3. vmask(i-1+k,j-1:j)=0. @@ -4701,7 +4684,7 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face do k=0,1 - select case (int(CS%v_face_mask_boundary(i,j-1+k))) + select case (int(CS%v_face_mask_bdry(i,j-1+k))) case (3) vmask(i-1:i,j-1+k)=3. umask(i-1:i,j-1+k)=0. @@ -4722,8 +4705,8 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face end select enddo - !if (CS%u_face_mask_boundary(i-1,j).geq.0) then !left boundary - ! u_face_mask(i-1,j) = CS%u_face_mask_boundary(i-1,j) + !if (CS%u_face_mask_bdry(i-1,j).geq.0) then !left boundary + ! u_face_mask(i-1,j) = CS%u_face_mask_bdry(i-1,j) ! umask(i-1,j-1:j) = 3. ! vmask(i-1,j-1:j) = 0. !endif @@ -4781,15 +4764,18 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face end subroutine update_velocity_masks - +!> Interpolate the ice shelf thickness from tracer point to nodal points, +!! subject to a mask. subroutine interpolate_H_to_B(G, h_shelf, hmask, H_node) type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: h_shelf + intent(in) :: h_shelf !< The ice shelf thickness at tracer points, in m. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: hmask + intent(in) :: hmask !< A mask indicating which tracer points are + !! partly or fully coupled by an ice-shelf real, dimension(SZDIB_(G),SZDJB_(G)), & - intent(inout) :: H_node + intent(inout) :: H_node !< The ice shelf thickness at nodal (corner) + !! points, in m. integer :: i, j, isc, iec, jsc, jec, num_h, k, l real :: summ @@ -4831,11 +4817,11 @@ subroutine ice_shelf_dyn_end(CS) deallocate(CS%u_shelf, CS%v_shelf) deallocate(CS%t_shelf, CS%tmask) - deallocate(CS%u_boundary_values, CS%v_boundary_values, CS%t_boundary_values) + deallocate(CS%u_bdry_val, CS%v_bdry_val, CS%t_bdry_val) deallocate(CS%u_face_mask, CS%v_face_mask) deallocate(CS%umask, CS%vmask) - deallocate(CS%ice_visc_bilinear, CS%taub_beta_eff_bilinear) + deallocate(CS%ice_visc, CS%taub_beta_eff) deallocate(CS%OD_rt, CS%OD_av) deallocate(CS%float_frac, CS%float_frac_rt) @@ -4861,9 +4847,9 @@ end subroutine ice_shelf_end subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - real,intent(in) :: time_step + real,intent(in) :: time_step !< The time step for this update, in s. integer, intent(inout) :: n - type(time_type) :: Time + type(time_type) :: Time !< The current model time real,optional,intent(in) :: min_time_step_in type(ocean_grid_type), pointer :: G => NULL() @@ -4875,7 +4861,6 @@ subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) local_v_max, time_step_int, min_time_step,spy,dumtimeprint logical :: flag type (time_type) :: dummy - character(2) :: procnum character(4) :: stepnum CS%velocity_update_sub_counter = CS%velocity_update_sub_counter + 1 @@ -4957,40 +4942,40 @@ subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) endif !!! OVS!!! - call ice_shelf_temp(dCS, ISS, G, time_step_int, ISS%water_flux, Time) + call ice_shelf_temp(dCS, ISS, G, time_step_int, ISS%water_flux, Time) - call enable_averaging(time_step,Time,CS%diag) - if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, ISS%area_shelf_h, CS%diag) - if (CS%id_col_thick > 0) call post_data(CS%id_col_thick, dCS%OD_av, CS%diag) - if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf,ISS%h_shelf,CS%diag) - if (CS%id_h_mask > 0) call post_data(CS%id_h_mask,ISS%hmask,CS%diag) - - if (CS%id_u_mask > 0) call post_data(CS%id_u_mask,dCS%umask,CS%diag) - if (CS%id_v_mask > 0) call post_data(CS%id_v_mask,dCS%vmask,CS%diag) - if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf,dCS%u_shelf,CS%diag) - if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf,dCS%v_shelf,CS%diag) - if (CS%id_float_frac > 0) call post_data(CS%id_float_frac,dCS%float_frac,CS%diag) - if (CS%id_OD_av >0) call post_data(CS%id_OD_av,dCS%OD_av,CS%diag) - if (CS%id_float_frac_rt>0) call post_data(CS%id_float_frac_rt,dCS%float_frac_rt,CS%diag) - if (CS%id_t_mask > 0) call post_data(CS%id_t_mask,dCS%tmask,CS%diag) - if (CS%id_t_shelf > 0) call post_data(CS%id_t_shelf,dCS%t_shelf,CS%diag) + call enable_averaging(time_step,Time,CS%diag) + if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, ISS%area_shelf_h, CS%diag) + if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf,ISS%h_shelf,CS%diag) + if (CS%id_h_mask > 0) call post_data(CS%id_h_mask,ISS%hmask,CS%diag) - call disable_averaging(CS%diag) + if (CS%id_col_thick > 0) call post_data(CS%id_col_thick, dCS%OD_av, CS%diag) + if (CS%id_u_mask > 0) call post_data(CS%id_u_mask,dCS%umask,CS%diag) + if (CS%id_v_mask > 0) call post_data(CS%id_v_mask,dCS%vmask,CS%diag) + if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf,dCS%u_shelf,CS%diag) + if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf,dCS%v_shelf,CS%diag) + if (CS%id_float_frac > 0) call post_data(CS%id_float_frac,dCS%float_frac,CS%diag) + if (CS%id_OD_av >0) call post_data(CS%id_OD_av,dCS%OD_av,CS%diag) + if (CS%id_float_frac_rt>0) call post_data(CS%id_float_frac_rt,dCS%float_frac_rt,CS%diag) + if (CS%id_t_mask > 0) call post_data(CS%id_t_mask,dCS%tmask,CS%diag) + if (CS%id_t_shelf > 0) call post_data(CS%id_t_shelf,dCS%t_shelf,CS%diag) + + call disable_averaging(CS%diag) - enddo + enddo end subroutine solo_time_step -!!! OVS !!! +!> This subroutine updates the vertically averaged ice shelf temperature. subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) - type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step + real, intent(in) :: time_step !< The time step for this update, in s. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: melt_rate !< basal melt rate in kg/m^2/s - type(time_type), intent(in) :: Time + type(time_type), intent(in) :: Time !< The current model time ! time_step: time step in sec ! melt_rate: basal melt rate in kg/m^2/s @@ -5034,7 +5019,6 @@ subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) real, dimension(SZDI_(G),SZDJ_(G),4) :: flux_enter integer :: isd, ied, jsd, jed, i, j, isc, iec, jsc, jec real :: rho, spy, t_bd, Tsurf, adot - character(len=2) :: procnum rho = CS%density_ice spy = 365 * 86400 ! seconds per year; is there a global constant for this? No - it is dependent upon a calendar. @@ -5051,10 +5035,10 @@ subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) do j=jsd,jed do i=isd,ied - t_bd = CS%t_boundary_values(i,j) + t_bd = CS%t_bdry_val(i,j) ! if (ISS%hmask(i,j) > 1) then if ((ISS%hmask(i,j) == 3) .or. (ISS%hmask(i,j) == -2)) then - CS%t_shelf(i,j) = CS%t_boundary_values(i,j) + CS%t_shelf(i,j) = CS%t_bdry_val(i,j) endif enddo enddo @@ -5095,7 +5079,7 @@ subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) do j=jsd,jed do i=isd,ied - t_bd = CS%t_boundary_values(i,j) + t_bd = CS%t_bdry_val(i,j) ! if (ISS%hmask(i,j) > 1) then if ((ISS%hmask(i,j) == 3) .or. (ISS%hmask(i,j) == -2)) then CS%t_shelf(i,j) = t_bd @@ -5136,7 +5120,7 @@ end subroutine ice_shelf_temp subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, flux_enter) type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step + real, intent(in) :: time_step !< The time step for this update, in s. real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h0 real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_uflux @@ -5167,7 +5151,7 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f real :: u_face, & ! positive if out flux_diff_cell, phi, dxh, dyh, dxdyh - character (len=1) :: debug_str, procnum + character (len=1) :: debug_str is = G%isc-2 ; ie = G%iec+2 ; js = G%jsc ; je = G%jec ; isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -5210,10 +5194,10 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f if (CS%u_face_mask(i-1,j) == 4.) then - flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_flux_boundary_values(i-1,j) * & - CS%t_boundary_values(i-1,j) / dxdyh + flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_flux_bdry_val(i-1,j) * & + CS%t_bdry_val(i-1,j) / dxdyh ! assume no flux bc for temp -! flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_shelf(i,j)*CS%t_boundary_values(i-1,j) / dxdyh +! flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_shelf(i,j)*CS%t_bdry_val(i-1,j) / dxdyh else @@ -5263,10 +5247,10 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f if (CS%u_face_mask(i+1,j) == 4.) then - flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_flux_boundary_values(i+1,j) *& - CS%t_boundary_values(i+1,j)/ dxdyh + flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_flux_bdry_val(i+1,j) *& + CS%t_bdry_val(i+1,j)/ dxdyh ! assume no flux bc for temp -! flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_shelf(i,j)*CS%t_boundary_values(i+1,j)/ dxdyh +! flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_shelf(i,j)*CS%t_bdry_val(i+1,j)/ dxdyh else @@ -5324,22 +5308,22 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - flux_enter(i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * CS%t_boundary_values(i-1,j)* & - CS%thickness_boundary_values(i+1,j) + flux_enter(i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * CS%t_bdry_val(i-1,j)* & + CS%thickness_bdry_val(i+1,j) elseif (CS%u_face_mask(i-1,j) == 4.) then - flux_enter(i,j,1) = G%dyT(i,j) * time_step * CS%u_flux_boundary_values(i-1,j)*CS%t_boundary_values(i-1,j) -! flux_enter(i,j,1) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*CS%t_boundary_values(i-1,j) + flux_enter(i,j,1) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j)*CS%t_bdry_val(i-1,j) +! flux_enter(i,j,1) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*CS%t_bdry_val(i-1,j) ! assume no flux bc for temp endif if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) - flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * CS%t_boundary_values(i+1,j)* & - CS%thickness_boundary_values(i+1,j) + flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * CS%t_bdry_val(i+1,j)* & + CS%thickness_bdry_val(i+1,j) elseif (CS%u_face_mask(i+1,j) == 4.) then - flux_enter(i,j,2) = G%dyT(i,j) * time_step * CS%u_flux_boundary_values(i+1,j) * CS%t_boundary_values(i+1,j) + flux_enter(i,j,2) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) * CS%t_bdry_val(i+1,j) ! assume no flux bc for temp -! flux_enter(i,j,2) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*CS%t_boundary_values(i+1,j) +! flux_enter(i,j,2) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*CS%t_bdry_val(i+1,j) endif ! if ((i == is) .AND. (hmask(i,j) == 0) .AND. (hmask(i-1,j) == 1)) then @@ -5365,14 +5349,12 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f enddo ! j loop -! write (procnum,'(I1)') mpp_pe() - end subroutine ice_shelf_advect_temp_x subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_after_vflux, flux_enter) type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step + real, intent(in) :: time_step !< The time step for this update, in s. real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h_after_uflux real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_vflux @@ -5402,7 +5384,7 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft real, dimension(-2:2) :: stencil real :: v_face, & ! positive if out flux_diff_cell, phi, dxh, dyh, dxdyh - character(len=1) :: debug_str, procnum + character(len=1) :: debug_str is = G%isc ; ie = G%iec ; js = G%jsc-1 ; je = G%jec+1 ; isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed i_off = G%idg_offset ; j_off = G%jdg_offset @@ -5440,10 +5422,10 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft if (CS%v_face_mask(i,j-1) == 4.) then - flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_flux_boundary_values(i,j-1) * & - CS%t_boundary_values(i,j-1)/ dxdyh + flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_flux_bdry_val(i,j-1) * & + CS%t_bdry_val(i,j-1)/ dxdyh ! assume no flux bc for temp -! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*CS%t_boundary_values(i,j-1) / dxdyh +! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*CS%t_bdry_val(i,j-1) / dxdyh else @@ -5493,10 +5475,10 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft if (CS%v_face_mask(i,j+1) == 4.) then - flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_flux_boundary_values(i,j+1) *& - CS%t_boundary_values(i,j+1)/ dxdyh + flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_flux_bdry_val(i,j+1) *& + CS%t_bdry_val(i,j+1)/ dxdyh ! assume no flux bc for temp -! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*CS%t_boundary_values(i,j+1) / dxdyh +! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*CS%t_bdry_val(i,j+1) / dxdyh else @@ -5543,23 +5525,23 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then v_face = 0.5 * (CS%v_shelf(i-1,j-1) + CS%v_shelf(i,j-1)) - flux_enter(i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * CS%t_boundary_values(i,j-1)* & - CS%thickness_boundary_values(i,j-1) + flux_enter(i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * CS%t_bdry_val(i,j-1)* & + CS%thickness_bdry_val(i,j-1) elseif (CS%v_face_mask(i,j-1) == 4.) then - flux_enter(i,j,3) = G%dxT(i,j) * time_step * CS%v_flux_boundary_values(i,j-1)*CS%t_boundary_values(i,j-1) + flux_enter(i,j,3) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1)*CS%t_bdry_val(i,j-1) ! assume no flux bc for temp -! flux_enter(i,j,3) = G%dxh(i,j) * time_step * CS%v_shelf(i,j)*CS%t_boundary_values(i,j-1) +! flux_enter(i,j,3) = G%dxh(i,j) * time_step * CS%v_shelf(i,j)*CS%t_bdry_val(i,j-1) endif if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then v_face = 0.5 * (CS%v_shelf(i-1,j) + CS%v_shelf(i,j)) - flux_enter(i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * CS%t_boundary_values(i,j+1)* & - CS%thickness_boundary_values(i,j+1) + flux_enter(i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * CS%t_bdry_val(i,j+1)* & + CS%thickness_bdry_val(i,j+1) elseif (CS%v_face_mask(i,j+1) == 4.) then - flux_enter(i,j,4) = G%dxT(i,j) * time_step * CS%v_flux_boundary_values(i,j+1)*CS%t_boundary_values(i,j+1) + flux_enter(i,j,4) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1)*CS%t_bdry_val(i,j+1) ! assume no flux bc for temp -! flux_enter(i,j,4) = G%dxh(i,j) * time_step * CS%v_shelf(i,j)*CS%t_boundary_values(i,j+1) +! flux_enter(i,j,4) = G%dxh(i,j) * time_step * CS%v_shelf(i,j)*CS%t_bdry_val(i,j+1) endif ! if ((j == js) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j-1) == 1)) then @@ -5580,8 +5562,6 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft endif enddo ! i loop - !write (procnum,'(I1)') mpp_pe() - end subroutine ice_shelf_advect_temp_y !> \namespace mom_ice_shelf @@ -5594,9 +5574,6 @@ end subroutine ice_shelf_advect_temp_y !! !! Derived from code by Chris Little, early 2010. !! -!! NOTE: THERE ARE A NUMBER OF SUBROUTINES WITH "TRIANGLE" IN THE NAME; THESE -!! HAVE NOT BEEN TESTED AND SHOULD PROBABLY BE PHASED OUT -!! !! The ice-sheet dynamics subroutines do the following: !! initialize_shelf_mass - Initializes the ice shelf mass distribution. !! - Initializes h_shelf, h_mask, area_shelf_h @@ -5609,7 +5586,7 @@ end subroutine ice_shelf_advect_temp_y !! stresses and checks for error tolerances. !! Max iteration count for outer loop currently fixed at 100 iteration !! - tolerance (and error evaluation) can be set through input file -!! - updates u_shelf, v_shelf, ice_visc_bilinear, taub_beta_eff_bilinear +!! - updates u_shelf, v_shelf, ice_visc, taub_beta_eff !! ice_shelf_solve_inner - Conjugate Gradient solve of matrix solve for ice_shelf_solve_outer !! - Jacobi Preconditioner - basically diagonal of matrix (not sure if it is effective at all) !! - modifies u_shelf and v_shelf only @@ -5621,9 +5598,9 @@ end subroutine ice_shelf_advect_temp_y !! init_boundary_values - !! bilinear_shape_functions - shape function for FEM solve using (convex) quadrilateral elements and !! bilinear nodal basis -!! calc_shelf_visc_bilinear - Glen's law viscosity and nonlinear sliding law (called by ice_shelf_solve_outer) -!! apply_boundary_values_bilinear - same as CG_action_bilinear, but input is zero except for dirichlet bdry conds -!! CG_action_bilinear - Effect of matrix (that is never explicitly constructed) +!! calc_shelf_visc - Glen's law viscosity and nonlinear sliding law (called by ice_shelf_solve_outer) +!! apply_boundary_values - same as CG_action, but input is zero except for dirichlet bdry conds +!! CG_action - Effect of matrix (that is never explicitly constructed) !! on vector space of Degrees of Freedom (DoFs) in velocity solve !! ice_shelf_advect - Given the melt rate and velocities, it advects the ice shelf THICKNESS !! - modified h_shelf, area_shelf_h, hmask From 198d75559a5f7ef65c566a3f56f9c641286329e8 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 23 May 2018 11:14:06 -0600 Subject: [PATCH 0286/1072] Delete visc%kv_slow=0 since this is done in set_diffusivity --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 882ed8cb26..698243a7f6 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -387,9 +387,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect*h_neglect Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 - ! visc%Kv_slow must be set to zero - visc%Kv_slow(:,:,:) = 0.0 - if (nz == 1) return showCallTree = callTree_showQuery() if (showCallTree) call callTree_enter("diabatic(), MOM_diabatic_driver.F90") From 720dbc04da0cd278d6c2fe6f56aa2edc0c14e90b Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 23 May 2018 11:25:31 -0600 Subject: [PATCH 0287/1072] Doxygenize set_diff + read background kinematic viscosity --- .../vertical/MOM_set_diffusivity.F90 | 201 ++++++++++-------- 1 file changed, 109 insertions(+), 92 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 9835c19912..903868795a 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -45,95 +45,94 @@ module MOM_set_diffusivity public set_diffusivity_end type, public :: set_diffusivity_CS ; private - logical :: debug ! If true, write verbose checksums for debugging. - - logical :: bulkmixedlayer ! If true, a refined bulk mixed layer is used with - ! GV%nk_rho_varies variable density mixed & buffer - ! layers. - real :: FluxRi_max ! The flux Richardson number where the stratification is - ! large enough that N2 > omega2. The full expression for - ! the Flux Richardson number is usually - ! FLUX_RI_MAX*N2/(N2+OMEGA2). The default is 0.2. - logical :: bottomdraglaw ! If true, the bottom stress is calculated with a - ! drag law c_drag*|u|*u. - logical :: BBL_mixing_as_max ! If true, take the maximum of the diffusivity - ! from the BBL mixing and the other diffusivities. - ! Otherwise, diffusivities from the BBL_mixing is - ! added. - logical :: use_LOTW_BBL_diffusivity ! If true, use simpler/less precise, BBL diffusivity. - logical :: LOTW_BBL_use_omega ! If true, use simpler/less precise, BBL diffusivity. - real :: BBL_effic ! efficiency with which the energy extracted - ! by bottom drag drives BBL diffusion (nondim) - real :: cdrag ! quadratic drag coefficient (nondim) - real :: IMax_decay ! inverse of a maximum decay scale for - ! bottom-drag driven turbulence, (1/m) - - real :: Kd ! interior diapycnal diffusivity (m2/s) - real :: Kd_min ! minimum diapycnal diffusivity (m2/s) - real :: Kd_max ! maximum increment for diapycnal diffusivity (m2/s) - ! Set to a negative value to have no limit. - real :: Kd_add ! uniform diffusivity added everywhere without - ! filtering or scaling (m2/s) - real :: Kv ! interior vertical viscosity (m2/s) - real :: Kdml ! mixed layer diapycnal diffusivity (m2/s) - ! when bulkmixedlayer==.false. - real :: Hmix ! mixed layer thickness (meter) when - ! bulkmixedlayer==.false. + logical :: debug !< If true, write verbose checksums for debugging. + + logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with + !! GV%nk_rho_varies variable density mixed & buffer + !! layers. + real :: FluxRi_max !< The flux Richardson number where the stratification is + !! large enough that N2 > omega2. The full expression for + !! the Flux Richardson number is usually + !! FLUX_RI_MAX*N2/(N2+OMEGA2). The default is 0.2. + logical :: bottomdraglaw !< If true, the bottom stress is calculated with a + !! drag law c_drag*|u|*u. + logical :: BBL_mixing_as_max !< If true, take the maximum of the diffusivity + !! from the BBL mixing and the other diffusivities. + !! Otherwise, diffusivities from the BBL_mixing is + !! added. + logical :: use_LOTW_BBL_diffusivity !< If true, use simpler/less precise, BBL diffusivity. + logical :: LOTW_BBL_use_omega !< If true, use simpler/less precise, BBL diffusivity. + real :: BBL_effic !< efficiency with which the energy extracted + !! by bottom drag drives BBL diffusion (nondim) + real :: cdrag !< quadratic drag coefficient (nondim) + real :: IMax_decay !< inverse of a maximum decay scale for + !! bottom-drag driven turbulence, (1/m) + real :: Kv !< The interior vertical viscosity (m2/s) + real :: Kd !< interior diapycnal diffusivity (m2/s) + real :: Kd_min !< minimum diapycnal diffusivity (m2/s) + real :: Kd_max !< maximum increment for diapycnal diffusivity (m2/s) + !! Set to a negative value to have no limit. + real :: Kd_add !< uniform diffusivity added everywhere without + !! filtering or scaling (m2/s) + real :: Kdml !< mixed layer diapycnal diffusivity (m2/s) + !! when bulkmixedlayer==.false. + real :: Hmix !< mixed layer thickness (meter) when + !! bulkmixedlayer==.false. type(diag_ctrl), pointer :: diag ! structure to regulate diagn output timing - logical :: limit_dissipation ! If enabled, dissipation is limited to be larger - ! than the following: - real :: dissip_min ! Minimum dissipation (W/m3) - real :: dissip_N0 ! Coefficient a in minimum dissipation = a+b*N (W/m3) - real :: dissip_N1 ! Coefficient b in minimum dissipation = a+b*N (J/m3) - real :: dissip_N2 ! Coefficient c in minimum dissipation = c*N2 (W m-3 s2) - real :: dissip_Kd_min ! Minimum Kd (m2/s) with dissipatio Rho0*Kd_min*N^2 - - real :: TKE_itide_max ! maximum internal tide conversion (W m-2) - ! available to mix above the BBL - real :: omega ! Earth's rotation frequency (s-1) - logical :: ML_radiation ! allow a fraction of TKE available from wind work - ! to penetrate below mixed layer base with a vertical - ! decay scale determined by the minimum of - ! (1) The depth of the mixed layer, or - ! (2) An Ekman length scale. - ! Energy availble to drive mixing below the mixed layer is - ! given by E = ML_RAD_COEFF*MSTAR*USTAR**3. Optionally, if - ! ML_rad_TKE_decay is true, this is further reduced by a factor - ! of exp(-h_ML*Idecay_len_TkE), where Idecay_len_TKE is - ! calculated the same way as in the mixed layer code. - ! The diapycnal diffusivity is KD(k) = E/(N2(k)+OMEGA2), - ! where N2 is the squared buoyancy frequency (s-2) and OMEGA2 - ! is the rotation rate of the earth squared. - real :: ML_rad_kd_max ! Maximum diapycnal diffusivity due to turbulence - ! radiated from the base of the mixed layer (m2/s) - real :: ML_rad_efold_coeff ! non-dim coefficient to scale penetration depth - real :: ML_rad_coeff ! coefficient, which scales MSTAR*USTAR^3 to - ! obtain energy available for mixing below - ! mixed layer base (nondimensional) - logical :: ML_rad_TKE_decay ! If true, apply same exponential decay - ! to ML_rad as applied to the other surface - ! sources of TKE in the mixed layer code. - real :: ustar_min ! A minimum value of ustar to avoid numerical - ! problems (m/s). If the value is small enough, - ! this parameter should not affect the solution. - real :: TKE_decay ! ratio of natural Ekman depth to TKE decay scale (nondim) - real :: mstar ! ratio of friction velocity cubed to - ! TKE input to the mixed layer (nondim) - logical :: ML_use_omega ! If true, use absolute rotation rate instead - ! of the vertical component of rotation when - ! setting the decay scale for mixed layer turbulence. - real :: ML_omega_frac ! When setting the decay scale for turbulence, use - ! this fraction of the absolute rotation rate blended - ! with the local value of f, as f^2 ~= (1-of)*f^2 + of*4*omega^2. - logical :: user_change_diff ! If true, call user-defined code to change diffusivity. - logical :: useKappaShear ! If true, use the kappa_shear module to find the - ! shear-driven diapycnal diffusivity. - logical :: use_CVMix_shear ! If true, use one of the CVMix modules to find - ! shear-driven diapycnal diffusivity. - logical :: use_CVMix_ddiff ! If true, enable double-diffusive mixing via CVMix. - logical :: simple_TKE_to_Kd ! If true, uses a simple estimate of Kd/TKE that - ! does not rely on a layer-formulation. + logical :: limit_dissipation !< If enabled, dissipation is limited to be larger + !! than the following: + real :: dissip_min !< Minimum dissipation (W/m3) + real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N (W/m3) + real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N (J/m3) + real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 (W m-3 s2) + real :: dissip_Kd_min !< Minimum Kd (m2/s) with dissipatio Rho0*Kd_min*N^2 + + real :: TKE_itide_max !< maximum internal tide conversion (W m-2) + !! available to mix above the BBL + real :: omega !< Earth's rotation frequency (s-1) + logical :: ML_radiation !< allow a fraction of TKE available from wind work + !! to penetrate below mixed layer base with a vertical + !! decay scale determined by the minimum of + !! (1) The depth of the mixed layer, or + !! (2) An Ekman length scale. + !! Energy availble to drive mixing below the mixed layer is + !! given by E = ML_RAD_COEFF*MSTAR*USTAR**3. Optionally, if + !! ML_rad_TKE_decay is true, this is further reduced by a factor + !! of exp(-h_ML*Idecay_len_TkE), where Idecay_len_TKE is + !! calculated the same way as in the mixed layer code. + !! The diapycnal diffusivity is KD(k) = E/(N2(k)+OMEGA2), + !! where N2 is the squared buoyancy frequency (s-2) and OMEGA2 + !! is the rotation rate of the earth squared. + real :: ML_rad_kd_max !< Maximum diapycnal diffusivity due to turbulence + !! radiated from the base of the mixed layer (m2/s) + real :: ML_rad_efold_coeff !< non-dim coefficient to scale penetration depth + real :: ML_rad_coeff !< coefficient, which scales MSTAR*USTAR^3 to + !! obtain energy available for mixing below + !! mixed layer base (nondimensional) + logical :: ML_rad_TKE_decay !< If true, apply same exponential decay + !! to ML_rad as applied to the other surface + !! sources of TKE in the mixed layer code. + real :: ustar_min !< A minimum value of ustar to avoid numerical + !! problems (m/s). If the value is small enough, + !! this parameter should not affect the solution. + real :: TKE_decay !< ratio of natural Ekman depth to TKE decay scale (nondim) + real :: mstar !! ratio of friction velocity cubed to + !! TKE input to the mixed layer (nondim) + logical :: ML_use_omega !< If true, use absolute rotation rate instead + !! of the vertical component of rotation when + !! setting the decay scale for mixed layer turbulence. + real :: ML_omega_frac !< When setting the decay scale for turbulence, use + !! this fraction of the absolute rotation rate blended + !! with the local value of f, as f^2 ~= (1-of)*f^2 + of*4*omega^2. + logical :: user_change_diff !< If true, call user-defined code to change diffusivity. + logical :: useKappaShear !< If true, use the kappa_shear module to find the + !! shear-driven diapycnal diffusivity. + logical :: use_CVMix_shear !< If true, use one of the CVMix modules to find + !! shear-driven diapycnal diffusivity. + logical :: use_CVMix_ddiff !< If true, enable double-diffusive mixing via CVMix. + logical :: simple_TKE_to_Kd !< If true, uses a simple estimate of Kd/TKE that + !! does not rely on a layer-formulation. character(len=200) :: inputdir type(user_change_diff_CS), pointer :: user_change_diff_CSp => NULL() @@ -177,6 +176,17 @@ module MOM_set_diffusivity contains +!> Sets the interior vertical diffusion of scalars due to the following processes: +!! 1) Shear-driven mixing: two options, Jackson et at. and KPP interior; +!! 2) Background mixing via CVMix (Bryan-Lewis profile) or the scheme described by +!! Harrison & Hallberg, JPO 2008; +!! 3) Double-diffusion aplpied via CVMix; +!! 4) Tidal mixing: many options available, see MOM_tidal_mixing.F90; +!! In addition, this subroutine has the option to set the interior vertical +!! viscosity associated with processes 2-4 listed above, which is stored in +!! visc%Kv_slow. Vertical viscosity due to shear-driven mixing is passed via +!! visc%Kv_shear +!! GMM, TODO: add contribution from tidal mixing into visc%Kv_slow subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & G, GV, CS, Kd, Kd_int) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -188,9 +198,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u_h + intent(in) :: u_h !< zonal thickness transport m^2/s. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: v_h + intent(in) :: v_h !< meridional thickness transport m^2/s. type(thermo_var_ptrs), intent(inout) :: tv !< Structure with pointers to thermodynamic !! fields. Out is for tv%TempxPmE. type(forcing), intent(in) :: fluxes !< Structure of surface fluxes that may be @@ -270,7 +280,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! If nothing else is specified, this will be the value used. Kd(:,:,:) = CS%Kd Kd_int(:,:,:) = CS%Kd - visc%Kv_slow(:,:,:) = CS%Kv + if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = CS%Kv ! Set up arrays for diagnostics. @@ -331,6 +341,10 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & elseif (CS%use_CVMix_shear) then !NOTE{BGR}: this needs to be cleaned up. It works in 1D case, but has not been tested outside. call calculate_CVMix_shear(u_h, v_h, h, tv, visc%Kd_shear, visc%Kv_shear,G,GV,CS%CVMix_shear_csp) + if (CS%debug) then + call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear",G%HI) + call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear",G%HI) + endif elseif (associated(visc%Kv_shear)) then visc%Kv_shear(:,:,:) = 0. ! needed if calculate_kappa_shear is not enabled endif @@ -342,8 +356,6 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! set surface diffusivities (CS%bkgnd_mixing_csp%Kd_sfc) call sfc_bkgnd_mixing(G, CS%bkgnd_mixing_csp) -! GMM, fix OMP calls below - !$OMP parallel do default(none) shared(is,ie,js,je,nz,G,GV,CS,h,tv,T_f,S_f,fluxes,dd, & !$OMP Kd,visc, & !$OMP Kd_int,dt,u,v,Omega2) & @@ -1826,6 +1838,11 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp ! set params releted to the background mixing call bkgnd_mixing_init(Time, G, GV, param_file, CS%diag, CS%bkgnd_mixing_csp) + call get_param(param_file, mdl, "KV", CS%Kv, & + "The background kinematic viscosity in the interior. \n"//& + "The molecular value, ~1e-6 m2 s-1, may be used.", & + units="m2 s-1", fail_if_missing=.true.) + call get_param(param_file, mdl, "KD", CS%Kd, & "The background diapycnal diffusivity of density in the \n"//& "interior. Zero or the molecular value, ~1e-7 m2 s-1, \n"//& From 6782ecb9dade745c6c5307cbf69b66b3e3a0dc33 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 23 May 2018 17:13:39 -0600 Subject: [PATCH 0288/1072] Deleted calls related to layer mode --- .../vertical/MOM_diabatic_driver.F90 | 653 ++++-------------- 1 file changed, 146 insertions(+), 507 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 698243a7f6..a26e44fe48 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -279,6 +279,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & type(diabatic_CS), pointer :: CS !< module control structure type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & ea, & ! amount of fluid entrained from the layer above within ! one time step (m for Bouss, kg/m^2 for non-Bouss) @@ -391,6 +392,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & showCallTree = callTree_showQuery() if (showCallTree) call callTree_enter("diabatic(), MOM_diabatic_driver.F90") + if (.not. (CS%useALEalgorithm)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & + "The ALE algorithm must be enabled when using MOM_diabatic_driver.") ! Offer diagnostics of various state varables at the start of diabatic ! these are mostly for debugging purposes. @@ -452,7 +455,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%id_frazil_h > 0) call post_data(CS%id_frazil_h, h, CS%diag) endif call disable_averaging(CS%diag) - endif + endif !associated(tv%T) .AND. associated(tv%frazil) + ! For all other diabatic subroutines, the averaging window should be the entire diabatic timestep call enable_averaging(dt, Time_end, CS%diag) if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) @@ -482,58 +486,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (associated(CS%optics)) & call set_opacity(CS%optics, fluxes, G, GV, CS%opacity_CSp) - if (CS%bulkmixedlayer) then - if (CS%debug) then - call MOM_forcing_chksum("Before mixedlayer", fluxes, G, haloshift=0) - endif - - if (CS%ML_mix_first > 0.0) then - ! This subroutine: - ! (1) Cools the mixed layer. - ! (2) Performs convective adjustment by mixed layer entrainment. - ! (3) Heats the mixed layer and causes it to detrain to - ! Monin-Obukhov depth or minimum mixed layer depth. - ! (4) Uses any remaining TKE to drive mixed layer entrainment. - ! (5) Possibly splits buffer layer into two isopycnal layers (when using isopycnal coordinate) - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) - - call cpu_clock_begin(id_clock_mixedlayer) - if (CS%ML_mix_first < 1.0) then - ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) - call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt*CS%ML_mix_first, & - eaml,ebml, G, GV, CS%bulkmixedlayer_CSp, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt, last_call=.false.) - if (CS%salt_reject_below_ML) & - call insert_brine(h, tv, G, GV, fluxes, nkmb, CS%diabatic_aux_CSp, & - dt*CS%ML_mix_first, CS%id_brine_lay) - else - ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) - call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt, eaml, ebml, & - G, GV, CS%bulkmixedlayer_CSp, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) - endif - - ! Keep salinity from falling below a small but positive threshold. - ! This constraint is needed for SIS1 ice model, which can extract - ! more salt than is present in the ocean. SIS2 does not suffer - ! from this limitation, in which case we can let salinity=0 and still - ! have salt conserved with SIS2 ice. So for SIS2, we can run with - ! BOUND_SALINITY=False in MOM.F90. - if (associated(tv%S) .and. associated(tv%salt_deficit)) & - call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) - call cpu_clock_end(id_clock_mixedlayer) - if (CS%debug) then - call MOM_state_chksum("After mixedlayer ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("After mixedlayer", fluxes, G, haloshift=0) - endif - if (showCallTree) call callTree_waypoint("done with 1st bulkmixedlayer (diabatic)") - if (CS%debugConservation) call MOM_state_stats('1st bulkmixedlayer', u, v, h, tv%T, tv%S, G) - endif - endif ! end CS%bulkmixedlayer - - if (CS%debug) then + if (CS%debug) & call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) - endif if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then @@ -609,7 +563,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call hchksum(Kd_Int, "after set_diffusivity Kd_Int",G%HI,haloshift=0) endif - if (CS%useKPP) then call cpu_clock_begin(id_clock_kpp) ! KPP needs the surface buoyancy flux but does not update state variables. @@ -752,47 +705,22 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! This block sets ea, eb from Kd or Kd_int. - ! If using ALE algorithm, set ea=eb=Kd_int on interfaces for - ! use in the tri-diagonal solver. - ! Otherwise, call entrainment_diffusive() which sets ea and eb - ! based on KD and target densities (ie. does remapping as well). - if (CS%useALEalgorithm) then + ! set ea=eb=Kd_int on interfaces for use in the tri-diagonal solver. - do j=js,je ; do i=is,ie - ea(i,j,1) = 0. - enddo ; enddo + do j=js,je ; do i=is,ie + ea(i,j,1) = 0. + enddo ; enddo !$OMP parallel do default(none) shared(is,ie,js,je,nz,h_neglect,h,ea,GV,dt,Kd_int,eb) & !$OMP private(hval) - do k=2,nz ; do j=js,je ; do i=is,ie - hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_int(i,j,k) - eb(i,j,k-1) = ea(i,j,k) - enddo ; enddo ; enddo - do j=js,je ; do i=is,ie - eb(i,j,nz) = 0. - enddo ; enddo - if (showCallTree) call callTree_waypoint("done setting ea,eb from Kd_int (diabatic)") - - else ! .not. CS%useALEalgorithm - ! When not using ALE, calculate layer entrainments/detrainments from - ! diffusivities and differences between layer and target densities - call cpu_clock_begin(id_clock_entrain) - ! Calculate appropriately limited diapycnal mass fluxes to account - ! for diapycnal diffusion and advection. Sets: ea, eb. Changes: kb - call Entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS%entrain_diffusive_CSp, & - ea, eb, kb, Kd_Lay=Kd, Kd_int=Kd_int) - call cpu_clock_end(id_clock_entrain) - if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)") - - endif ! endif for (CS%useALEalgorithm) - - if (CS%debug) then - call MOM_forcing_chksum("after calc_entrain ", fluxes, G, haloshift=0) - call MOM_thermovar_chksum("after calc_entrain ", tv, G) - call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, haloshift=0) - call hchksum(ea, "after calc_entrain ea", G%HI, haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "after calc_entrain eb", G%HI, haloshift=0, scale=GV%H_to_m) - endif + do k=2,nz ; do j=js,je ; do i=is,ie + hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) + ea(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_int(i,j,k) + eb(i,j,k-1) = ea(i,j,k) + enddo ; enddo ; enddo + do j=js,je ; do i=is,ie + eb(i,j,nz) = 0. + enddo ; enddo + if (showCallTree) call callTree_waypoint("done setting ea,eb from Kd_int (diabatic)") ! Save fields before boundary forcing is applied for tendency diagnostics if (CS%boundary_forcing_tendency_diag) then @@ -803,96 +731,90 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & enddo ; enddo ; enddo endif - ! Apply forcing when using the ALE algorithm - if (CS%useALEalgorithm) then - call cpu_clock_begin(id_clock_remap) - - ! Changes made to following fields: h, tv%T and tv%S. - - do k=1,nz ; do j=js,je ; do i=is,ie - h_prebound(i,j,k) = h(i,j,k) - enddo ; enddo ; enddo - if (CS%use_energetic_PBL) then - - skinbuoyflux(:,:) = 0.0 - call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, dt, fluxes, CS%optics, & - h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & - CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux) - - if (CS%debug) then - call hchksum(ea, "after applyBoundaryFluxes ea",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "after applyBoundaryFluxes eb",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(cTKE, "after applyBoundaryFluxes cTKE",G%HI,haloshift=0) - call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT",G%HI,haloshift=0) - call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS",G%HI,haloshift=0) - endif + ! Apply forcing + call cpu_clock_begin(id_clock_remap) - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) - call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) - - ! If visc%MLD exists, copy the ePBL's MLD into it - if (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G) - call pass_var(visc%MLD, G%domain, halo=1) - Hml(:,:) = visc%MLD(:,:) - endif + ! Changes made to following fields: h, tv%T and tv%S. + do k=1,nz ; do j=js,je ; do i=is,ie + h_prebound(i,j,k) = h(i,j,k) + enddo ; enddo ; enddo + if (CS%use_energetic_PBL) then - ! Augment the diffusivities due to those diagnosed in energetic_PBL. - do K=2,nz ; do j=js,je ; do i=is,ie + skinbuoyflux(:,:) = 0.0 + call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, dt, fluxes, CS%optics, & + h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & + CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux) - if (CS%ePBL_is_additive) then - Kd_add_here = Kd_ePBL(i,j,K) - visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) - else - Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) - visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) - endif - Ent_int = Kd_add_here * (GV%m_to_H**2 * dt) / & - (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) - eb(i,j,k-1) = eb(i,j,k-1) + Ent_int - ea(i,j,k) = ea(i,j,k) + Ent_int - Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here + if (CS%debug) then + call hchksum(ea, "after applyBoundaryFluxes ea",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb, "after applyBoundaryFluxes eb",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(cTKE, "after applyBoundaryFluxes cTKE",G%HI,haloshift=0) + call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT",G%HI,haloshift=0) + call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS",G%HI,haloshift=0) + endif - ! for diagnostics - Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_int(i,j,K) - Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_int(i,j,K) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, & + CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) - enddo ; enddo ; enddo + ! If visc%MLD exists, copy the ePBL's MLD into it + if (associated(visc%MLD)) then + call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G) + call pass_var(visc%MLD, G%domain, halo=1) + Hml(:,:) = visc%MLD(:,:) + endif - if (CS%debug) then - call hchksum(ea, "after ePBL ea",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "after ePBL eb",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL",G%HI,haloshift=0) + ! Augment the diffusivities due to those diagnosed in energetic_PBL. + do K=2,nz ; do j=js,je ; do i=is,ie + if (CS%ePBL_is_additive) then + Kd_add_here = Kd_ePBL(i,j,K) + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) + else + Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) + visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) endif + Ent_int = Kd_add_here * (GV%m_to_H**2 * dt) / & + (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) + eb(i,j,k-1) = eb(i,j,k-1) + Ent_int + ea(i,j,k) = ea(i,j,k) + Ent_int + Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here - else - call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, dt, fluxes, CS%optics, & - h, tv, CS%aggregate_FW_forcing, & - CS%evap_CFL_limit, CS%minimum_forcing_depth) - - endif ! endif for CS%use_energetic_PBL - - ! diagnose the tendencies due to boundary forcing - ! At this point, the diagnostic grids have not been updated since the call to the boundary layer scheme - ! so all tendency diagnostics need to be posted on h_diag, and grids rebuilt afterwards - if (CS%boundary_forcing_tendency_diag) then - call diagnose_boundary_forcing_tendency(tv, h, temp_diag, saln_diag, h_diag, dt, G, GV, CS) - if (CS%id_boundary_forcing_h > 0) call post_data(CS%id_boundary_forcing_h, h, CS%diag, alt_h = h_diag) - endif - ! Boundary fluxes may have changed T, S, and h - call diag_update_remap_grids(CS%diag) + ! for diagnostics + Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_int(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_int(i,j,K) + + enddo ; enddo ; enddo - call cpu_clock_end(id_clock_remap) if (CS%debug) then - call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, haloshift=0) - call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G) - call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, haloshift=0) + call hchksum(ea, "after ePBL ea",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb, "after ePBL eb",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL",G%HI,haloshift=0) endif - if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") - if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G) - endif ! endif for (CS%useALEalgorithm) + else + call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, dt, fluxes, CS%optics, & + h, tv, CS%aggregate_FW_forcing, & + CS%evap_CFL_limit, CS%minimum_forcing_depth) + + endif ! endif for CS%use_energetic_PBL + + ! diagnose the tendencies due to boundary forcing + ! At this point, the diagnostic grids have not been updated since the call to the boundary layer scheme + ! so all tendency diagnostics need to be posted on h_diag, and grids rebuilt afterwards + if (CS%boundary_forcing_tendency_diag) then + call diagnose_boundary_forcing_tendency(tv, h, temp_diag, saln_diag, h_diag, dt, G, GV, CS) + if (CS%id_boundary_forcing_h > 0) call post_data(CS%id_boundary_forcing_h, h, CS%diag, alt_h = h_diag) + endif + ! Boundary fluxes may have changed T, S, and h + call diag_update_remap_grids(CS%diag) + call cpu_clock_end(id_clock_remap) + if (CS%debug) then + call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, haloshift=0) + call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G) + call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, haloshift=0) + endif + if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") + if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G) ! Update h according to divergence of the difference between ! ea and eb. We keep a record of the original h in hold. @@ -902,6 +824,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! enough iterations are permitted in Calculate_Entrainment. ! Even if too few iterations are allowed, it is still guarded ! against. In other words the checks are probably unnecessary. + + ! GMM, should the code below be deleted? eb(i,j,k-1) = ea(i,j,k), + ! see above, so h should not change. + !$OMP parallel do default(shared) do j=js,je do i=is,ie @@ -937,204 +863,54 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G) - ! Here, T and S are updated according to ea and eb. - ! If using the bulk mixed layer, T and S are also updated - ! by surface fluxes (in fluxes%*). - ! This is a very long block. - if (CS%bulkmixedlayer) then + ! calculate change in temperature & salinity due to dia-coordinate surface diffusion + if (associated(tv%T)) then - if (associated(tv%T)) then - call cpu_clock_begin(id_clock_tridiag) - ! Temperature and salinity (as state variables) are treated - ! differently from other tracers to insure massless layers that - ! are lighter than the mixed layer have temperatures and salinities - ! that correspond to their prescribed densities. - if (CS%massless_match_targets) then - !$OMP parallel do default (shared) private(h_tr,b1,d1,c1,b_denom_1) - do j=js,je - do i=is,ie - h_tr = hold(i,j,1) + h_neglect - b1(i) = 1.0 / (h_tr + eb(i,j,1)) - d1(i) = h_tr * b1(i) - tv%T(i,j,1) = b1(i) * (h_tr*tv%T(i,j,1)) - tv%S(i,j,1) = b1(i) * (h_tr*tv%S(i,j,1)) - enddo - do k=2,nkmb ; do i=is,ie - c1(i,k) = eb(i,j,k-1) * b1(i) - h_tr = hold(i,j,k) + h_neglect - b_denom_1 = h_tr + d1(i)*ea(i,j,k) - b1(i) = 1.0 / (b_denom_1 + eb(i,j,k)) - if (k kb(i,j)) then - c1(i,k) = eb(i,j,k-1) * b1(i) - h_tr = hold(i,j,k) + h_neglect - b_denom_1 = h_tr + d1(i)*ea(i,j,k) - b1(i) = 1.0 / (b_denom_1 + eb(i,j,k)) - d1(i) = b_denom_1 * b1(i) - tv%T(i,j,k) = b1(i) * (h_tr*tv%T(i,j,k) + ea(i,j,k)*tv%T(i,j,k-1)) - tv%S(i,j,k) = b1(i) * (h_tr*tv%S(i,j,k) + ea(i,j,k)*tv%S(i,j,k-1)) - elseif (eb(i,j,k) < eb(i,j,k-1)) then ! (note that k < kb(i,j)) - ! The bottommost buffer layer might entrain all the mass from some - ! of the interior layers that are thin and lighter in the coordinate - ! density than that buffer layer. The T and S of these newly - ! massless interior layers are unchanged. - tv%T(i,j,nkmb) = tv%T(i,j,nkmb) + b1(i) * (eb(i,j,k-1) - eb(i,j,k)) * tv%T(i,j,k) - tv%S(i,j,nkmb) = tv%S(i,j,nkmb) + b1(i) * (eb(i,j,k-1) - eb(i,j,k)) * tv%S(i,j,k) - endif - enddo ; enddo - - do k=nz-1,nkmb,-1 ; do i=is,ie - if (k >= kb(i,j)) then - tv%T(i,j,k) = tv%T(i,j,k) + c1(i,k+1)*tv%T(i,j,k+1) - tv%S(i,j,k) = tv%S(i,j,k) + c1(i,k+1)*tv%S(i,j,k+1) - endif - enddo ; enddo - do i=is,ie ; if (kb(i,j) <= nz) then - tv%T(i,j,nkmb) = tv%T(i,j,nkmb) + c1(i,kb(i,j))*tv%T(i,j,kb(i,j)) - tv%S(i,j,nkmb) = tv%S(i,j,nkmb) + c1(i,kb(i,j))*tv%S(i,j,kb(i,j)) - endif ; enddo - do k=nkmb-1,1,-1 ; do i=is,ie - tv%T(i,j,k) = tv%T(i,j,k) + c1(i,k+1)*tv%T(i,j,k+1) - tv%S(i,j,k) = tv%S(i,j,k) + c1(i,k+1)*tv%S(i,j,k+1) - enddo ; enddo - enddo ! end of j loop - else ! .not. massless_match_targets - ! This simpler form allows T & S to be too dense for the layers - ! between the buffer layers and the interior. - ! Changes: T, S - if (CS%tracer_tridiag) then - call tracer_vertdiff(hold, ea, eb, dt, tv%T, G, GV) - call tracer_vertdiff(hold, ea, eb, dt, tv%S, G, GV) - else - call triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, tv%T, tv%S) - endif - endif ! massless_match_targets - call cpu_clock_end(id_clock_tridiag) + if (CS%debug) then + call hchksum(ea, "before triDiagTS ea ",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb, "before triDiagTS eb ",G%HI,haloshift=0, scale=GV%H_to_m) + endif + call cpu_clock_begin(id_clock_tridiag) - endif ! endif for associated(T) - if (CS%debugConservation) call MOM_state_stats('BML tridiag', u, v, h, tv%T, tv%S, G) + ! Keep salinity from falling below a small but positive threshold. + ! This constraint is needed for SIS1 ice model, which can extract + ! more salt than is present in the ocean. SIS2 does not suffer + ! from this limitation, in which case we can let salinity=0 and still + ! have salt conserved with SIS2 ice. So for SIS2, we can run with + ! BOUND_SALINITY=False in MOM.F90. + if (associated(tv%S) .and. associated(tv%salt_deficit)) & + call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) - if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then - ! The mixed layer code has already been called, but there is some needed - ! bookkeeping. - !$OMP parallel do default(shared) + if (CS%diabatic_diff_tendency_diag) then do k=1,nz ; do j=js,je ; do i=is,ie - hold(i,j,k) = h_orig(i,j,k) - ea(i,j,k) = ea(i,j,k) + eaml(i,j,k) - eb(i,j,k) = eb(i,j,k) + ebml(i,j,k) + temp_diag(i,j,k) = tv%T(i,j,k) + saln_diag(i,j,k) = tv%S(i,j,k) enddo ; enddo ; enddo - if (CS%debug) then - call hchksum(ea, "after ea = ea + eaml",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "after eb = eb + ebml",G%HI,haloshift=0, scale=GV%H_to_m) - endif endif - if (CS%ML_mix_first < 1.0) then - ! Call the mixed layer code now, perhaps for a second time. - ! This subroutine (1) Cools the mixed layer. - ! (2) Performs convective adjustment by mixed layer entrainment. - ! (3) Heats the mixed layer and causes it to detrain to - ! Monin-Obukhov depth or minimum mixed layer depth. - ! (4) Uses any remaining TKE to drive mixed layer entrainment. - ! (5) Possibly splits the buffer layer into two isopycnal layers. - - call find_uv_at_h(u, v, hold, u_h, v_h, G, GV, ea, eb) - if (CS%debug) call MOM_state_chksum("find_uv_at_h1 ", u, v, h, G, GV, haloshift=0) - - dt_mix = min(dt,dt*(1.0 - CS%ML_mix_first)) - call cpu_clock_begin(id_clock_mixedlayer) - ! Changes: h, tv%T, tv%S, ea and eb (G is also inout???) - call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_mix, ea, eb, & - G, GV, CS%bulkmixedlayer_CSp, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) - - if (CS%salt_reject_below_ML) & - call insert_brine(h, tv, G, GV, fluxes, nkmb, CS%diabatic_aux_CSp, dt_mix, & - CS%id_brine_lay) - - ! Keep salinity from falling below a small but positive threshold. - ! This constraint is needed for SIS1 ice model, which can extract - ! more salt than is present in the ocean. SIS2 does not suffer - ! from this limitation, in which case we can let salinity=0 and still - ! have salt conserved with SIS2 ice. So for SIS2, we can run with - ! BOUND_SALINITY=False in MOM.F90. - if (associated(tv%S) .and. associated(tv%salt_deficit)) & - call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) - - call cpu_clock_end(id_clock_mixedlayer) - if (showCallTree) call callTree_waypoint("done with 2nd bulkmixedlayer (diabatic)") - if (CS%debugConservation) call MOM_state_stats('2nd bulkmixedlayer', u, v, h, tv%T, tv%S, G) + ! Changes T and S via the tridiagonal solver; no change to h + if (CS%tracer_tridiag) then + call tracer_vertdiff(hold, ea, eb, dt, tv%T, G, GV) + call tracer_vertdiff(hold, ea, eb, dt, tv%S, G, GV) + else + call triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, tv%T, tv%S) endif - else ! following block for when NOT using BULKMIXEDLAYER - - - ! calculate change in temperature & salinity due to dia-coordinate surface diffusion - if (associated(tv%T)) then - - if (CS%debug) then - call hchksum(ea, "before triDiagTS ea ",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "before triDiagTS eb ",G%HI,haloshift=0, scale=GV%H_to_m) - endif - call cpu_clock_begin(id_clock_tridiag) - - ! Keep salinity from falling below a small but positive threshold. - ! This constraint is needed for SIS1 ice model, which can extract - ! more salt than is present in the ocean. SIS2 does not suffer - ! from this limitation, in which case we can let salinity=0 and still - ! have salt conserved with SIS2 ice. So for SIS2, we can run with - ! BOUND_SALINITY=False in MOM.F90. - if (associated(tv%S) .and. associated(tv%salt_deficit)) & - call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) - - if (CS%diabatic_diff_tendency_diag) then - do k=1,nz ; do j=js,je ; do i=is,ie - temp_diag(i,j,k) = tv%T(i,j,k) - saln_diag(i,j,k) = tv%S(i,j,k) - enddo ; enddo ; enddo - endif - - ! Changes T and S via the tridiagonal solver; no change to h - if (CS%tracer_tridiag) then - call tracer_vertdiff(hold, ea, eb, dt, tv%T, G, GV) - call tracer_vertdiff(hold, ea, eb, dt, tv%S, G, GV) - else - call triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, tv%T, tv%S) - endif - - ! diagnose temperature, salinity, heat, and salt tendencies - ! Note: hold here refers to the thicknesses from before the dual-entraintment when using - ! the bulk mixed layer scheme. Otherwise in ALE-mode, layer thicknesses will have changed - ! In either case, tendencies should be posted on hold - if (CS%diabatic_diff_tendency_diag) then - call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, CS) - if (CS%id_diabatic_diff_h > 0) call post_data(CS%id_diabatic_diff_h, hold, CS%diag, alt_h = hold) - endif - - call cpu_clock_end(id_clock_tridiag) - if (showCallTree) call callTree_waypoint("done with triDiagTS (diabatic)") - - endif ! endif corresponding to if (associated(tv%T)) - if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G) + ! diagnose temperature, salinity, heat, and salt tendencies + ! Note: hold here refers to the thicknesses from before the dual-entraintment when using + ! the bulk mixed layer scheme. Otherwise in ALE-mode, layer thicknesses will have changed + ! In either case, tendencies should be posted on hold + if (CS%diabatic_diff_tendency_diag) then + call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, CS) + if (CS%id_diabatic_diff_h > 0) call post_data(CS%id_diabatic_diff_h, hold, CS%diag, alt_h = hold) + endif + call cpu_clock_end(id_clock_tridiag) + if (showCallTree) call callTree_waypoint("done with triDiagTS (diabatic)") - endif ! endif for the BULKMIXEDLAYER block + endif ! endif corresponding to if (associated(tv%T)) + if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G) if (CS%debug) then call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, haloshift=0) @@ -1143,14 +919,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call hchksum(eb, "after mixed layer eb", G%HI, scale=GV%H_to_m) endif - if (.not. CS%useALEalgorithm) then - call cpu_clock_begin(id_clock_remap) - call regularize_layers(h, tv, dt, ea, eb, G, GV, CS%regularize_layers_CSp) - call cpu_clock_end(id_clock_remap) - if (showCallTree) call callTree_waypoint("done with regularize_layers (diabatic)") - if (CS%debugConservation) call MOM_state_stats('regularize_layers', u, v, h, tv%T, tv%S, G) - endif - ! Whenever thickness changes let the diag manager know, as the ! target grids for vertical remapping may need to be regenerated. call diag_update_remap_grids(CS%diag) @@ -1187,6 +955,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! mixing of passive tracers from massless boundary layers to interior call cpu_clock_begin(id_clock_tracers) + if (CS%mix_boundary_tracers) then Tr_ea_BBL = sqrt(dt*CS%Kd_BBL_tr) !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) @@ -1235,17 +1004,12 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & enddo - if (CS%useALEalgorithm) then ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied ! so hold should be h_orig - call call_tracer_column_fns(h_prebound, h, ea, eb, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug, & - evap_CFL_limit = CS%evap_CFL_limit, & - minimum_forcing_depth = CS%minimum_forcing_depth) - else - call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug) - endif + call call_tracer_column_fns(h_prebound, h, ea, eb, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug, & + evap_CFL_limit = CS%evap_CFL_limit, & + minimum_forcing_depth = CS%minimum_forcing_depth) elseif (associated(visc%Kd_extra_S)) then ! extra diffusivity for passive tracers @@ -1265,56 +1029,31 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & eatr(i,j,k) = ea(i,j,k) + add_ent enddo ; enddo ; enddo - if (CS%useALEalgorithm) then ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied - call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug,& - evap_CFL_limit = CS%evap_CFL_limit, & - minimum_forcing_depth = CS%minimum_forcing_depth) - else - call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug) - endif + call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug,& + evap_CFL_limit = CS%evap_CFL_limit, & + minimum_forcing_depth = CS%minimum_forcing_depth) else - if (CS%useALEalgorithm) then ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied - call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug, & - evap_CFL_limit = CS%evap_CFL_limit, & - minimum_forcing_depth = CS%minimum_forcing_depth) - else - call call_tracer_column_fns(hold, h, ea, eb, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug) - endif + call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug, & + evap_CFL_limit = CS%evap_CFL_limit, & + minimum_forcing_depth = CS%minimum_forcing_depth) endif ! (CS%mix_boundary_tracers) - - call cpu_clock_end(id_clock_tracers) - ! sponges if (CS%use_sponge) then call cpu_clock_begin(id_clock_sponge) if (associated(CS%ALE_sponge_CSp)) then ! ALE sponge call apply_ALE_sponge(h, dt, G, CS%ALE_sponge_CSp, CS%Time) - else - ! Layer mode sponge - if (CS%bulkmixedlayer .and. associated(tv%eqn_of_state)) then - do i=is,ie ; p_ref_cv(i) = tv%P_Ref ; enddo - !$OMP parallel do default(shared) - do j=js,je - call calculate_density(tv%T(:,j,1), tv%S(:,j,1), p_ref_cv, Rcv_ml(:,j), & - is, ie-is+1, tv%eqn_of_state) - enddo - call apply_sponge(h, dt, G, GV, ea, eb, CS%sponge_CSp, Rcv_ml) - else - call apply_sponge(h, dt, G, GV, ea, eb, CS%sponge_CSp) - endif endif + call cpu_clock_end(id_clock_sponge) if (CS%debug) then call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, haloshift=0) @@ -1337,29 +1076,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & enddo endif -! For momentum, it is only the net flux that homogenizes within -! the mixed layer. Vertical viscosity that is proportional to the -! mixed layer turbulence is applied elsewhere. - if (CS%bulkmixedlayer) then - if (CS%debug) then - call hchksum(ea, "before net flux rearrangement ea",G%HI, scale=GV%H_to_m) - call hchksum(eb, "before net flux rearrangement eb",G%HI, scale=GV%H_to_m) - endif - !$OMP parallel do default(shared) private(net_ent) - do j=js,je - do K=2,GV%nkml ; do i=is,ie - net_ent = ea(i,j,k) - eb(i,j,k-1) - ea(i,j,k) = max(net_ent, 0.0) - eb(i,j,k-1) = max(-net_ent, 0.0) - enddo ; enddo - enddo - if (CS%debug) then - call hchksum(ea, "after net flux rearrangement ea",G%HI, scale=GV%H_to_m) - call hchksum(eb, "after net flux rearrangement eb",G%HI, scale=GV%H_to_m) - endif - endif - -! Initialize halo regions of ea, eb, and hold to default values. + ! Initialize halo regions of ea, eb, and hold to default values. !$OMP parallel do default(shared) do k=1,nz do i=is-1,ie+1 @@ -1387,84 +1104,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call cpu_clock_end(id_clock_pass) - if (.not. CS%useALEalgorithm) then - ! Use a tridiagonal solver to determine effect of the diapycnal - ! advection on velocity field. It is assumed that water leaves - ! or enters the ocean with the surface velocity. - if (CS%debug) then - call MOM_state_chksum("before u/v tridiag ", u, v, h, G, GV, haloshift=0) - call hchksum(ea, "before u/v tridiag ea",G%HI, scale=GV%H_to_m) - call hchksum(eb, "before u/v tridiag eb",G%HI, scale=GV%H_to_m) - call hchksum(hold, "before u/v tridiag hold",G%HI, scale=GV%H_to_m) - endif - call cpu_clock_begin(id_clock_tridiag) - !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) - do j=js,je - do I=Isq,Ieq - if (associated(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,1) = u(I,j,1) - hval = (hold(i,j,1) + hold(i+1,j,1)) + (ea(i,j,1) + ea(i+1,j,1)) + h_neglect - b1(I) = 1.0 / (hval + (eb(i,j,1) + eb(i+1,j,1))) - d1(I) = hval * b1(I) - u(I,j,1) = b1(I) * (hval * u(I,j,1)) - enddo - do k=2,nz ; do I=Isq,Ieq - if (associated(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,k) = u(I,j,k) - c1(I,k) = (eb(i,j,k-1)+eb(i+1,j,k-1)) * b1(I) - eaval = ea(i,j,k) + ea(i+1,j,k) - hval = hold(i,j,k) + hold(i+1,j,k) + h_neglect - b1(I) = 1.0 / ((eb(i,j,k) + eb(i+1,j,k)) + (hval + d1(I)*eaval)) - d1(I) = (hval + d1(I)*eaval) * b1(I) - u(I,j,k) = (hval*u(I,j,k) + eaval*u(I,j,k-1))*b1(I) - enddo ; enddo - do k=nz-1,1,-1 ; do I=Isq,Ieq - u(I,j,k) = u(I,j,k) + c1(I,k+1)*u(I,j,k+1) - if (associated(ADp%du_dt_dia)) & - ADp%du_dt_dia(I,j,k) = (u(I,j,k) - ADp%du_dt_dia(I,j,k)) * Idt - enddo ; enddo - if (associated(ADp%du_dt_dia)) then - do I=Isq,Ieq - ADp%du_dt_dia(I,j,nz) = (u(I,j,nz)-ADp%du_dt_dia(I,j,nz)) * Idt - enddo - endif - enddo - if (CS%debug) then - call MOM_state_chksum("aft 1st loop tridiag ", u, v, h, G, GV, haloshift=0) - endif - !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) - do J=Jsq,Jeq - do i=is,ie - if (associated(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,1) = v(i,J,1) - hval = (hold(i,j,1) + hold(i,j+1,1)) + (ea(i,j,1) + ea(i,j+1,1)) + h_neglect - b1(i) = 1.0 / (hval + (eb(i,j,1) + eb(i,j+1,1))) - d1(I) = hval * b1(I) - v(i,J,1) = b1(i) * (hval * v(i,J,1)) - enddo - do k=2,nz ; do i=is,ie - if (associated(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,k) = v(i,J,k) - c1(i,k) = (eb(i,j,k-1)+eb(i,j+1,k-1)) * b1(i) - eaval = ea(i,j,k) + ea(i,j+1,k) - hval = hold(i,j,k) + hold(i,j+1,k) + h_neglect - b1(i) = 1.0 / ((eb(i,j,k) + eb(i,j+1,k)) + (hval + d1(i)*eaval)) - d1(i) = (hval + d1(i)*eaval) * b1(i) - v(i,J,k) = (hval*v(i,J,k) + eaval*v(i,J,k-1))*b1(i) - enddo ; enddo - do k=nz-1,1,-1 ; do i=is,ie - v(i,J,k) = v(i,J,k) + c1(i,k+1)*v(i,J,k+1) - if (associated(ADp%dv_dt_dia)) & - ADp%dv_dt_dia(i,J,k) = (v(i,J,k) - ADp%dv_dt_dia(i,J,k)) * Idt - enddo ; enddo - if (associated(ADp%dv_dt_dia)) then - do i=is,ie - ADp%dv_dt_dia(i,J,nz) = (v(i,J,nz)-ADp%dv_dt_dia(i,J,nz)) * Idt - enddo - endif - enddo - call cpu_clock_end(id_clock_tridiag) - if (CS%debug) then - call MOM_state_chksum("after u/v tridiag ", u, v, h, G, GV, haloshift=0) - endif - endif ! useALEalgorithm - call disable_averaging(CS%diag) ! Frazil formation keeps temperature above the freezing point. ! make_frazil is deliberately called at both the beginning and at From 17e73ea02d8aac609995f94b9b9e2dd98cab6f63 Mon Sep 17 00:00:00 2001 From: Zhi Liang Date: Thu, 24 May 2018 14:30:25 -0400 Subject: [PATCH 0289/1072] fix for openmp --- config_src/solo_driver/MOM_driver.F90 | 4 +-- src/framework/MOM_domains.F90 | 50 +++++++++++++++------------ 2 files changed, 30 insertions(+), 24 deletions(-) diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 80a622b5ec..62304ed2b5 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -246,8 +246,8 @@ program MOM_main endif !$ call omp_set_num_threads(ocean_nthreads) -!$OMP PARALLEL private(adder) !$ base_cpu = get_cpu_affinity() +!$OMP PARALLEL private(adder) !$ if (use_hyper_thread) then !$ if (mod(omp_get_thread_num(),2) == 0) then !$ adder = omp_get_thread_num()/2 @@ -258,7 +258,7 @@ program MOM_main !$ adder = omp_get_thread_num() !$ endif !$ call set_cpu_affinity (base_cpu + adder) -!$ write(6,*) " ocean ", omp_get_num_threads(), get_cpu_affinity(), adder, omp_get_thread_num() +!$ write(6,*) " ocean ", base_cpu, get_cpu_affinity(), adder, omp_get_thread_num(), omp_get_num_threads() !$ call flush(6) !$OMP END PARALLEL diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index 0d68dc5dfb..4afcf590a2 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -1536,34 +1536,40 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & default=.false.) #ifndef NOT_SET_AFFINITY -!$ call get_param(param_file, mdl, "OCEAN_OMP_THREADS", ocean_nthreads, & -!$ "The number of OpenMP threads that MOM6 will use.", & -!$ default = 1, layoutParam=.true.) -!$ call get_param(param_file, mdl, "OCEAN_OMP_HYPER_THREAD", ocean_omp_hyper_thread, & -!$ "If True, use hyper-threading.", default = .false., layoutParam=.true.) -!$ if (ocean_omp_hyper_thread) then -!$ call get_param(param_file, mdl, "OMP_CORES_PER_NODE", omp_cores_per_node, & -!$ "Number of cores per node needed for hyper-threading.", & -!$ fail_if_missing=.true., layoutParam=.true.) -!$ endif -!$ call omp_set_num_threads(ocean_nthreads) +!$OMP PARALLEL +!$OMP master +!$ ocean_nthreads = omp_get_num_threads() +!$OMP END MASTER +!$OMP END PARALLEL +!$ if(ocean_nthreads < 2 ) then +!$ call get_param(param_file, mdl, "OCEAN_OMP_THREADS", ocean_nthreads, & +!$ "The number of OpenMP threads that MOM6 will use.", & +!$ default = 1, layoutParam=.true.) +!$ call get_param(param_file, mdl, "OCEAN_OMP_HYPER_THREAD", ocean_omp_hyper_thread, & +!$ "If True, use hyper-threading.", default = .false., layoutParam=.true.) +!$ if (ocean_omp_hyper_thread) then +!$ call get_param(param_file, mdl, "OMP_CORES_PER_NODE", omp_cores_per_node, & +!$ "Number of cores per node needed for hyper-threading.", & +!$ fail_if_missing=.true., layoutParam=.true.) +!$ endif +!$ call omp_set_num_threads(ocean_nthreads) +!$ base_cpu = get_cpu_affinity() !$OMP PARALLEL private(adder) -!$ base_cpu = get_cpu_affinity() -!$ if (ocean_omp_hyper_thread) then -!$ if (mod(omp_get_thread_num(),2) == 0) then -!$ adder = omp_get_thread_num()/2 +!$ if (ocean_omp_hyper_thread) then +!$ if (mod(omp_get_thread_num(),2) == 0) then +!$ adder = omp_get_thread_num()/2 +!$ else +!$ adder = omp_cores_per_node + omp_get_thread_num()/2 +!$ endif !$ else -!$ adder = omp_cores_per_node + omp_get_thread_num()/2 +!$ adder = omp_get_thread_num() !$ endif -!$ else -!$ adder = omp_get_thread_num() -!$ endif -!$ call set_cpu_affinity(base_cpu + adder) -!!$ write(6,*) " ocean ", omp_get_num_threads(), get_cpu_affinity(), adder, omp_get_thread_num() +!$ call set_cpu_affinity(base_cpu + adder) +!!$ write(6,*) " ocean ", base_cpu, get_cpu_affinity(), adder, omp_get_thread_num(), omp_get_num_threads() !!$ call flush(6) !$OMP END PARALLEL +!$ endif #endif - call log_param(param_file, mdl, "!SYMMETRIC_MEMORY_", MOM_dom%symmetric, & "If defined, the velocity point data domain includes \n"//& "every face of the thickness points. In other words, \n"//& From 9fae628cd1cb10b2fe1a84b29543a76677a94ef0 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 24 May 2018 13:51:06 -0600 Subject: [PATCH 0290/1072] fixes for having mom6 work with nuopc-cmeps-v0.4 --- config_src/nuopc_driver/mom_cap.F90 | 25 +- config_src/nuopc_driver/mom_cap_methods.F90 | 1072 +++++++++---------- 2 files changed, 554 insertions(+), 543 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index f6ad787dcf..09557df8c8 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1410,11 +1410,15 @@ subroutine DataInitialize(gcomp, rc) ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr call get_ocean_grid(ocean_state, ocean_grid) -!tcx ---------- - return -!tcx ---------- + !tcx ---------- + RETURN + !tcx ---------- - call ocn_export(ocean_public, ocean_grid, exportState) + call ocn_export(ocean_public, ocean_grid, exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1501,7 +1505,6 @@ subroutine ModelAdvance(gcomp, rc) integer :: nc #ifdef CESMCOUPLED ! in ocn_import, ocn_export - #else real(ESMF_KIND_R8), allocatable :: ofld(:,:), ocz(:,:), ocm(:,:) real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) @@ -1629,7 +1632,11 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - call ocn_import(ocean_public, ocean_grid, importState, ice_ocean_boundary) + call ocn_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out #else call State_getFldPtr(exportState,'ocean_mask',dataPtr_mask,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1721,7 +1728,11 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - call ocn_export(ocean_public, ocean_grid, exportState) + call ocn_export(ocean_public, ocean_grid, exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out #else allocate(ofld(isc:iec,jsc:jec)) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 8d571bb335..0a5d237c78 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -1,550 +1,550 @@ !> This is the main driver for MOM6 in CIME module mom_cap_methods -! This file is part of MOM6. See LICENSE.md for the license. + ! This file is part of MOM6. See LICENSE.md for the license. -! mct modules -use ESMF -use perf_mod, only: t_startf, t_stopf -use ocean_model_mod, only: ocean_public_type, ocean_state_type -use ocean_model_mod, only: ice_ocean_boundary_type -use MOM_grid, only: ocean_grid_type -use MOM_domains, only: pass_var -use mpp_domains_mod, only: mpp_get_compute_domain + ! mct modules + use ESMF + use perf_mod, only: t_startf, t_stopf + use ocean_model_mod, only: ocean_public_type, ocean_state_type + use ocean_model_mod, only: ice_ocean_boundary_type + use MOM_grid, only: ocean_grid_type + use MOM_domains, only: pass_var + use mpp_domains_mod, only: mpp_get_compute_domain -! By default make data private -implicit none; private + ! By default make data private + implicit none; private -! Public member functions -public :: ocn_export -public :: ocn_import + ! Public member functions + public :: ocn_export + public :: ocn_import -integer :: rc,dbrc -integer :: import_cnt = 0 -character(len=1024) :: tmpstr + integer :: rc,dbrc + integer :: import_cnt = 0 + character(len=1024) :: tmpstr -!--------------------------- +!----------------------------------------------------------------------- contains -!--------------------------- - -!> Maps outgoing ocean data to ESMF State -!! See \ref section_ocn_export for a summary of the data -!! that is transferred from MOM6 to MCT. -subroutine ocn_export(ocean_public, grid, exportState) - type(ocean_public_type), intent(in) :: ocean_public !< Ocean surface state - type(ocean_grid_type), intent(in) :: grid !< Ocean model grid - type(ESMF_State), intent(inout) :: exportState !< outgoing data - ! Local variables - real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo - integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices - integer :: lbnd1, lbnd2, ubnd1, ubnd2 - real :: slp_L, slp_R, slp_C, slope, u_min, u_max - real(ESMF_KIND_R8), pointer :: dataPtr_omask(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_t(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_s(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_u(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_v(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_q(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_fswpen(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_roce_16O(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_roce_HDO(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_fco2_ocn(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_fdms_ocn(:,:) - - character(len=*),parameter :: subname = '(ocn_export)' - - call State_getFldPtr(exportState,"So_omask", dataPtr_omask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call State_getFldPtr(exportState,"So_t", dataPtr_t, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call State_getFldPtr(exportState,"So_s", dataPtr_s, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"So_u", dataPtr_u, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"So_v", dataPtr_v, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"Fioo_q", dataPtr_q, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"So_dhdx", dataPtr_dhdx, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"So_dhdy", dataPtr_dhdy, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"So_bldepth", dataPtr_bldepth, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"So_fswpen", dataPtr_fswpen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -! call State_getFldPtr(exportState,"So_roce_16O", dataPtr_roce_16O, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out -! call State_getFldPtr(exportState,"So_roce_HDO", dataPtr_roce_HDO, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out -! call State_getFldPtr(exportState,"Faoo_fco2_ocn", dataPtr_fco2_ocn, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out -! call State_getFldPtr(exportState,"Faoo_fdms_ocn", dataPtr_fdms_ocn, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out - - - lbnd1 = lbound(dataPtr_t,1) - ubnd1 = ubound(dataPtr_t,1) - lbnd2 = lbound(dataPtr_t,2) - ubnd2 = ubound(dataPtr_t,2) - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - -!tcx -! write(tmpstr,'(a,6i8)') subname//'tcx1',lbnd1,ubnd1,lbnd2,ubnd2 -! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) -! write(tmpstr,'(a,6i8)') subname//'tcx2',isc,iec,jsc,jec -! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) -! write(tmpstr,'(a,6i8)') subname//'tcx3',lbound(ssh,1),ubound(ssh,1),lbound(ssh,2),ubound(ssh,2) -! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) -! write(tmpstr,'(a,6i8)') subname//'tcx4',lbound(ocean_public%sea_lev,1),ubound(ocean_public%sea_lev,1),lbound(ocean_public%sea_lev,2),ubound(ocean_public%sea_lev,2) -! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) -! write(tmpstr,'(a,6i8)') subname//'tcx5',lbound(grid%mask2dT,1),ubound(grid%mask2dT,1),lbound(grid%mask2dT,2),ubound(grid%mask2dT,2) -! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) -! write(tmpstr,'(a,6i8)') subname//'tcx6',grid%isd,grid%ied,grid%jsd,grid%jed -! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) -! write(tmpstr,'(a,6i8)') subname//'tcx7',grid%isc,grid%iec,grid%jsc,grid%jec -! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) -! write(tmpstr,'(a,6i8)') subname//'tcx8',grid%idg_offset, grid%jdg_offset -! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) -! write(tmpstr,'(a,6i8)') subname//'tcx9',lbound(dataPtr_omask,1),ubound(dataPtr_omask,1),lbound(dataPtr_omask,2),ubound(dataPtr_omask,2) -! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - ! Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. - ! The mask comes from "grid" that uses the usual MOM domain that has halos - ! and does not use global indexing. - do j = jsc, jec - j1 = j + lbnd2 - jsc - jg = j + grid%jsc - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + grid%jsc - isc - ! surface temperature in Kelvin - dataPtr_omask(i1,j1) = grid%mask2dT(ig,jg) - dataPtr_t(i1,j1) = ocean_public%t_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_s(i1,j1) = ocean_public%s_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_u(i1,j1) = ocean_public%u_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_v(i1,j1) = ocean_public%v_surf(i,j) * grid%mask2dT(ig,jg) -! dataPtr_u(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%u_surf(i,j) & -! - grid%sin_rot(ig,jg) * ocean_public%v_surf(i,j)) * grid%mask2dT(ig,jg) -! dataPtr_v(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%v_surf(i,j) & -! + grid%sin_rot(ig,jg) * ocean_public%u_surf(i,j)) * grid%mask2dT(ig,jg) - ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain - ! in order to update halos. i.e. does not use global indexing. -! ssh(i,j) = ocean_public%sea_lev(i,j) - ssh = 0. +!----------------------------------------------------------------------- + + !> Maps outgoing ocean data to ESMF State + !! See \ref section_ocn_export for a summary of the data + !! that is transferred from MOM6 to MCT. + subroutine ocn_export(ocean_public, grid, exportState, rc) + type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state + type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid + type(ESMF_State) , intent(inout) :: exportState !< outgoing data + integer , intent(inout) :: rc + + ! Local variables + real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo + integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices + integer :: lbnd1, lbnd2, ubnd1, ubnd2 + real :: slp_L, slp_R, slp_C, slope, u_min, u_max + + real(ESMF_KIND_R8), pointer :: dataPtr_omask(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_t(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_s(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_u(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_v(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_q(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fswpen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_roce_16O(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_roce_HDO(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fco2_ocn(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fdms_ocn(:,:) + character(len=*), parameter :: subname = '(ocn_export)' + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call State_getFldPtr(exportState,"So_omask", dataPtr_omask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_t", dataPtr_t, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_s", dataPtr_s, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_u", dataPtr_u, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_v", dataPtr_v, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"Fioo_q", dataPtr_q, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_dhdx", dataPtr_dhdx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_dhdy", dataPtr_dhdy, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_bldepth", dataPtr_bldepth, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,"So_fswpen", dataPtr_fswpen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ! call State_getFldPtr(exportState,"So_roce_16O", dataPtr_roce_16O, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + ! call State_getFldPtr(exportState,"So_roce_HDO", dataPtr_roce_HDO, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + ! call State_getFldPtr(exportState,"Faoo_fco2_ocn", dataPtr_fco2_ocn, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + ! call State_getFldPtr(exportState,"Faoo_fdms_ocn", dataPtr_fdms_ocn, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + + lbnd1 = lbound(dataPtr_t,1) + ubnd1 = ubound(dataPtr_t,1) + lbnd2 = lbound(dataPtr_t,2) + ubnd2 = ubound(dataPtr_t,2) + + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + + !tcx + ! write(tmpstr,'(a,6i8)') subname//'tcx1',lbnd1,ubnd1,lbnd2,ubnd2 + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx2',isc,iec,jsc,jec + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx3',lbound(ssh,1),ubound(ssh,1),lbound(ssh,2),ubound(ssh,2) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx4',lbound(ocean_public%sea_lev,1),ubound(ocean_public%sea_lev,1),lbound(ocean_public%sea_lev,2),ubound(ocean_public%sea_lev,2) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx5',lbound(grid%mask2dT,1),ubound(grid%mask2dT,1),lbound(grid%mask2dT,2),ubound(grid%mask2dT,2) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx6',grid%isd,grid%ied,grid%jsd,grid%jed + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx7',grid%isc,grid%iec,grid%jsc,grid%jec + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx8',grid%idg_offset, grid%jdg_offset + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx9',lbound(dataPtr_omask,1),ubound(dataPtr_omask,1),lbound(dataPtr_omask,2),ubound(dataPtr_omask,2) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + ! Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. + ! The mask comes from "grid" that uses the usual MOM domain that has halos + ! and does not use global indexing. + do j = jsc, jec + j1 = j + lbnd2 - jsc + jg = j + grid%jsc - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + ig = i + grid%jsc - isc + ! surface temperature in Kelvin + dataPtr_omask(i1,j1) = grid%mask2dT(ig,jg) + dataPtr_t(i1,j1) = ocean_public%t_surf(i,j) * grid%mask2dT(ig,jg) + dataPtr_s(i1,j1) = ocean_public%s_surf(i,j) * grid%mask2dT(ig,jg) + dataPtr_u(i1,j1) = ocean_public%u_surf(i,j) * grid%mask2dT(ig,jg) + dataPtr_v(i1,j1) = ocean_public%v_surf(i,j) * grid%mask2dT(ig,jg) + ! dataPtr_u(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%u_surf(i,j) & + ! - grid%sin_rot(ig,jg) * ocean_public%v_surf(i,j)) * grid%mask2dT(ig,jg) + ! dataPtr_v(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%v_surf(i,j) & + ! + grid%sin_rot(ig,jg) * ocean_public%u_surf(i,j)) * grid%mask2dT(ig,jg) + ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain + ! in order to update halos. i.e. does not use global indexing. + ! ssh(i,j) = ocean_public%sea_lev(i,j) + ssh = 0. + end do end do - end do #if (1 == 0) - ! Update halo of ssh so we can calculate gradients - call pass_var(ssh, grid%domain) - - ! d/dx ssh - do j=jsc, jec - j1 = j + lbnd2 - jsc - do i=isc,iec - i1 = i + lbnd1 - isc - ! This is a simple second-order difference - !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(ig,jg) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) - if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. - slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(I,j) - if (grid%mask2dCu(I+1,j)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - if ( (slp_L * slp_R) > 0.0 ) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - dataPtr_dhdx(i1,j1) = slope * grid%IdxT(i,j) * grid%mask2dT(ig,jg) - if (grid%mask2dT(ig,jg)==0.) dataPtr_dhdx(i1,j1) = 0.0 + ! Update halo of ssh so we can calculate gradients + call pass_var(ssh, grid%domain) + + ! d/dx ssh + do j=jsc, jec + j1 = j + lbnd2 - jsc + do i=isc,iec + i1 = i + lbnd1 - isc + ! This is a simple second-order difference + !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(ig,jg) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) + if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(I,j) + if (grid%mask2dCu(I+1,j)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + if ( (slp_L * slp_R) > 0.0 ) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + dataPtr_dhdx(i1,j1) = slope * grid%IdxT(i,j) * grid%mask2dT(ig,jg) + if (grid%mask2dT(ig,jg)==0.) dataPtr_dhdx(i1,j1) = 0.0 + end do end do - end do - - ! d/dy ssh - do j=jsc, jec - j1 = j + lbnd2 - jsc - do i=isc,iec - i1 = i + lbnd1 - isc - ! This is a simple second-order difference - !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(ig,jg) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) - if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. - slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,J) - if (grid%mask2dCv(i,J+1)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R - if ((slp_L * slp_R) > 0.0) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - dataPtr_dhdy(i1,j1) = slope * grid%IdyT(i,j) * grid%mask2dT(ig,jg) - if (grid%mask2dT(ig,jg)==0.) dataPtr_dhdy(i1,j1) = 0.0 + + ! d/dy ssh + do j=jsc, jec + j1 = j + lbnd2 - jsc + do i=isc,iec + i1 = i + lbnd1 - isc + ! This is a simple second-order difference + !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(ig,jg) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) + if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. + slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,J) + if (grid%mask2dCv(i,J+1)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R + if ((slp_L * slp_R) > 0.0) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + dataPtr_dhdy(i1,j1) = slope * grid%IdyT(i,j) * grid%mask2dT(ig,jg) + if (grid%mask2dT(ig,jg)==0.) dataPtr_dhdy(i1,j1) = 0.0 + end do end do - end do #endif - -end subroutine ocn_export - - -!> 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. -subroutine ocn_import(ocean_public, grid, importState, ice_ocean_boundary) - type(ocean_public_type), intent(in) :: ocean_public !< Ocean surface state - type(ocean_grid_type), intent(in) :: grid !< Ocean model grid - type(ESMF_State), intent(inout) :: importState !< incoming data - type(ice_ocean_boundary_type), intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing - - integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices - real(ESMF_KIND_R8) :: c1,c2,c3,c4 - integer :: lbnd1, lbnd2, ubnd1, ubnd2 - - real(ESMF_KIND_R8), pointer :: dataPtr_p(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ifrac(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_duu10n(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_co2prog(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_co2diag(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lamult(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ustokes(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_vstokes(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_taux(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_tauy(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_sen(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lat(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_osalt(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lwdn(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lwup(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swvdr(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swvdf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swndr(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swndf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swnet(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_rofl(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_rofi(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_meltw(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_melth(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_iosalt(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_prec(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_rain(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_snow(:,:) - - character(len=*),parameter :: subname = '(ocn_import)' - - import_cnt = import_cnt + 1 - - call State_getFldPtr(importState,'Sa_pslv', dataPtr_p,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call State_getFldPtr(importState,'Si_ifrac', dataPtr_ifrac,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"So_duu10n", dataPtr_duu10n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -! call State_getFldPtr(importState,"Sa_co2prog", dataPtr_co2prog, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out -! call State_getFldPtr(importState,"Sa_co2diag", dataPtr_co2diag, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out - call State_getFldPtr(importState,"Sw_lamult", dataPtr_lamult, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Sw_ustokes", dataPtr_ustokes, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Sw_vstokes", dataPtr_vstokes, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_swndr" , dataPtr_swndr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_swndf" , dataPtr_swndf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_swvdr" , dataPtr_swvdr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_swvdf" , dataPtr_swvdf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_taux" , dataPtr_taux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_tauy" , dataPtr_tauy, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_sen" , dataPtr_sen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_lat" , dataPtr_lat, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_evap" , dataPtr_evap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_salt" , dataPtr_osalt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_lwdn" , dataPtr_lwdn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_lwup" , dataPtr_lwup, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_swnet", dataPtr_swnet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_rofl" , dataPtr_rofl, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_rofi" , dataPtr_rofi, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_meltw", dataPtr_meltw, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_melth", dataPtr_melth, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_salt" , dataPtr_iosalt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_prec" , dataPtr_prec, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_rain" , dataPtr_rain, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_snow" , dataPtr_snow, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - lbnd1 = lbound(dataPtr_p,1) - ubnd1 = ubound(dataPtr_p,1) - lbnd2 = lbound(dataPtr_p,2) - ubnd2 = ubound(dataPtr_p,2) - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - -!tcx -! write(tmpstr,'(a,6i8)') subname//'tcx1',lbnd1,ubnd1,lbnd2,ubnd2 -! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) -! write(tmpstr,'(a,6i8)') subname//'tcx2',isc,iec,jsc,jec -! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) -! write(tmpstr,'(a,6i8)') subname//'tcx3',i,j,i1,j1 -! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) -! write(tmpstr,'(a,6i8)') subname//'tcx4',lbound(ice_ocean_boundary%p,1),ubound(ice_ocean_boundary%p,1),lbound(ice_ocean_boundary%p,2),ubound(ice_ocean_boundary%p,2) -! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) -! write(tmpstr,'(a,6i8)') subname//'tcx5',lbound(grid%mask2dT,1),ubound(grid%mask2dT,1),lbound(grid%mask2dT,2),ubound(grid%mask2dT,2) -! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - -! write(tmpstr,'(a,i8)') subname//' tcx import_cnt ',import_cnt -! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - do j = jsc, jec - j1 = j + lbnd2 - jsc - jg = j + grid%jsc - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + grid%jsc - isc - -! ice_ocean_boundary%p(i,j) = 0.0_ESMF_KIND_R8 - -! ice_ocean_boundary%u_flux(i,j) = 0.0_ESMF_KIND_R8 -! ice_ocean_boundary%v_flux(i,j) = 0.0_ESMF_KIND_R8 - -! ice_ocean_boundary%t_flux(i,j) = 0.0_ESMF_KIND_R8 -! ice_ocean_boundary%q_flux(i,j) = 0.0_ESMF_KIND_R8 -! ice_ocean_boundary%lw_flux(i,j) = 0.0_ESMF_KIND_R8 - -! ice_ocean_boundary%sw_flux_vis_dir(i,j) = 0.0_ESMF_KIND_R8 -! ice_ocean_boundary%sw_flux_vis_dif(i,j) = 0.0_ESMF_KIND_R8 -! ice_ocean_boundary%sw_flux_nir_dir(i,j) = 0.0_ESMF_KIND_R8 -! ice_ocean_boundary%sw_flux_nir_dif(i,j) = 0.0_ESMF_KIND_R8 - -! ice_ocean_boundary%lprec(i,j) = 0.0_ESMF_KIND_R8 -! ice_ocean_boundary%fprec(i,j) = 0.0_ESMF_KIND_R8 -! ice_ocean_boundary%runoff(i,j) = 0.0_ESMF_KIND_R8 - -! ice_ocean_boundary%runoff_hflx(i,j) = 0.0 * GRID%mask2dT(ig,jg) -! ice_ocean_boundary%calving(i,j) = 0.0 * GRID%mask2dT(ig,jg) -! ice_ocean_boundary%calving_hflx(i,j) = 0.0 * GRID%mask2dT(ig,jg) - -! ice_ocean_boundary%ustar_berg(i,j) = 0.0 * GRID%mask2dT(ig,jg) -! ice_ocean_boundary%area_berg(i,j) = 0.0 * GRID%mask2dT(ig,jg) -! ice_ocean_boundary%mass_berg(i,j) = 0.0 * GRID%mask2dT(ig,jg) -! ice_ocean_boundary%mi(i,j) = 0.0 * GRID%mask2dT(ig,jg) - -if (import_cnt > 2) then - -! ice_ocean_boundary%p(i,j) = GRID%mask2dT(ig,jg) * dataPtr_p(i1,j1) - ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) * GRID%mask2dT(ig,jg) -! ice_ocean_boundary%u_flux(i,j) = (GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + & -! GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1)) -! ice_ocean_boundary%v_flux(i,j) = (GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + & -! GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1)) - - ice_ocean_boundary%t_flux(i,j) = -dataPtr_sen(i1,j1) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) * GRID%mask2dT(ig,jg) -!! ice_ocean_boundary%latent(i,j) = dataPtr_lat(i1,j1) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%lw_flux(i,j) = (dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1)) * GRID%mask2dT(ig,jg) - -! tcx TO DO c1-c4 -! c1 = 0.25_ESMF_KIND_R8 -! c2 = 0.25_ESMF_KIND_R8 -! c3 = 0.25_ESMF_KIND_R8 -! c4 = 0.25_ESMF_KIND_R8 - ice_ocean_boundary%sw_flux_vis_dir(i,j) = GRID%mask2dT(ig,jg) * dataPtr_swvdr(i1,j1) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = GRID%mask2dT(ig,jg) * dataPtr_swvdf(i1,j1) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = GRID%mask2dT(ig,jg) * dataPtr_swndf(i1,j1) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = GRID%mask2dT(ig,jg) * dataPtr_swndf(i1,j1) - -! ice_ocean_boundary%sw(i,j) = ice_ocean_boundary%sw_flux_vis_dir(i,j) + ice_ocean_boundary%sw_flux_vis_dif(i,j) + & -! ice_ocean_boundary%sw_flux_nir_dir(i,j) + ice_ocean_boundary%sw_flux_nir_dif(i,j) - - ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) * GRID%mask2dT(ig,jg) -! ice_ocean_boundary%runoff(i,j) = (dataPtr_rofl(i1,j1)+dataPtr_rofi(i1,j1)) * GRID%mask2dT(ig,jg) - -! ice_ocean_boundary%salt_flux(i,j) = GRID%mask2dT(ig,jg)*dataPtr_iosalt(i1,j1) -! ice_ocean_boundary%salt_flux(i,j) = GRID%mask2dT(ig,jg)*(dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j)) - -endif - + end subroutine ocn_export + +!----------------------------------------------------------------------- + + !> 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. + subroutine ocn_import(ocean_public, grid, importState, ice_ocean_boundary, rc) + type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state + type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid + type(ESMF_State) , intent(inout) :: importState !< incoming data + type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing + integer , intent(inout) :: rc + + integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices + real(ESMF_KIND_R8) :: c1,c2,c3,c4 + integer :: lbnd1, lbnd2, ubnd1, ubnd2 + + real(ESMF_KIND_R8), pointer :: dataPtr_p(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ifrac(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_duu10n(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_co2prog(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_co2diag(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lamult(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ustokes(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_vstokes(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_taux(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_tauy(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_sen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lat(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_osalt(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lwdn(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lwup(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_swvdr(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_swvdf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_swndr(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_swndf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_swnet(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_rofl(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_rofi(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_meltw(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_melth(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_iosalt(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_prec(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_rain(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_snow(:,:) + character(len=*), parameter :: subname = '(ocn_import)' + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! import_cnt is used to skip using the import state at the first count + import_cnt = import_cnt + 1 + + call State_getFldPtr(importState,'Sa_pslv', dataPtr_p,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,'Si_ifrac', dataPtr_ifrac,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"So_duu10n", dataPtr_duu10n, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ! call State_getFldPtr(importState,"Sa_co2prog", dataPtr_co2prog, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + ! call State_getFldPtr(importState,"Sa_co2diag", dataPtr_co2diag, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + call State_getFldPtr(importState,"Sw_lamult", dataPtr_lamult, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Sw_ustokes", dataPtr_ustokes, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Sw_vstokes", dataPtr_vstokes, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Faxa_swndr" , dataPtr_swndr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Faxa_swndf" , dataPtr_swndf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Faxa_swvdr" , dataPtr_swvdr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Faxa_swvdf" , dataPtr_swvdf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_taux" , dataPtr_taux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_tauy" , dataPtr_tauy, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_sen" , dataPtr_sen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_lat" , dataPtr_lat, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_evap" , dataPtr_evap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Fioi_salt" , dataPtr_osalt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Faxa_lwdn" , dataPtr_lwdn, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_lwup" , dataPtr_lwup, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_swnet", dataPtr_swnet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_rofl" , dataPtr_rofl, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Foxx_rofi" , dataPtr_rofi, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Fioi_meltw", dataPtr_meltw, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Fioi_melth", dataPtr_melth, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Fioi_salt" , dataPtr_iosalt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Faxa_prec" , dataPtr_prec, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Faxa_rain" , dataPtr_rain, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"Faxa_snow" , dataPtr_snow, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr_p,1) + ubnd1 = ubound(dataPtr_p,1) + lbnd2 = lbound(dataPtr_p,2) + ubnd2 = ubound(dataPtr_p,2) + + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + + !tcx + ! write(tmpstr,'(a,6i8)') subname//'tcx1',lbnd1,ubnd1,lbnd2,ubnd2 + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx2',isc,iec,jsc,jec + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx3',i,j,i1,j1 + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx4',lbound(ice_ocean_boundary%p,1),ubound(ice_ocean_boundary%p,1),& + ! lbound(ice_ocean_boundary%p,2),ubound(ice_ocean_boundary%p,2) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx5',lbound(grid%mask2dT,1),ubound(grid%mask2dT,1),& + ! lbound(grid%mask2dT,2),ubound(grid%mask2dT,2) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,i8)') subname//' tcx import_cnt ',import_cnt + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + do j = jsc, jec + j1 = j + lbnd2 - jsc + jg = j + grid%jsc - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + ig = i + grid%jsc - isc + + ! ice_ocean_boundary%p(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%u_flux(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%v_flux(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%t_flux(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%q_flux(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%lw_flux(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%sw_flux_vis_dir(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%sw_flux_vis_dif(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%sw_flux_nir_dir(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%sw_flux_nir_dif(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%lprec(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%fprec(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%runoff(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%runoff_hflx(i,j) = 0.0 * GRID%mask2dT(ig,jg) + ! ice_ocean_boundary%calving(i,j) = 0.0 * GRID%mask2dT(ig,jg) + ! ice_ocean_boundary%calving_hflx(i,j) = 0.0 * GRID%mask2dT(ig,jg) + ! ice_ocean_boundary%ustar_berg(i,j) = 0.0 * GRID%mask2dT(ig,jg) + ! ice_ocean_boundary%area_berg(i,j) = 0.0 * GRID%mask2dT(ig,jg) + ! ice_ocean_boundary%mass_berg(i,j) = 0.0 * GRID%mask2dT(ig,jg) + ! ice_ocean_boundary%mi(i,j) = 0.0 * GRID%mask2dT(ig,jg) + + ! This will skip the first time import information is given + if (import_cnt > 2) then + + ! ice_ocean_boundary%p(i,j) = GRID%mask2dT(ig,jg) * dataPtr_p(i1,j1) + ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) * GRID%mask2dT(ig,jg) + ! ice_ocean_boundary%u_flux(i,j) = (GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + & + ! GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1)) + ! ice_ocean_boundary%v_flux(i,j) = (GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + & + ! GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1)) + + ice_ocean_boundary%t_flux(i,j) = -dataPtr_sen(i1,j1) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) * GRID%mask2dT(ig,jg) + !! ice_ocean_boundary%latent(i,j) = dataPtr_lat(i1,j1) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%lw_flux(i,j) = (dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1)) * GRID%mask2dT(ig,jg) + + ! tcx TO DO c1-c4 + ! c1 = 0.25_ESMF_KIND_R8 + ! c2 = 0.25_ESMF_KIND_R8 + ! c3 = 0.25_ESMF_KIND_R8 + ! c4 = 0.25_ESMF_KIND_R8 + ice_ocean_boundary%sw_flux_vis_dir(i,j) = GRID%mask2dT(ig,jg) * dataPtr_swvdr(i1,j1) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = GRID%mask2dT(ig,jg) * dataPtr_swvdf(i1,j1) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = GRID%mask2dT(ig,jg) * dataPtr_swndf(i1,j1) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = GRID%mask2dT(ig,jg) * dataPtr_swndf(i1,j1) + + ! ice_ocean_boundary%sw(i,j) = ice_ocean_boundary%sw_flux_vis_dir(i,j) + ice_ocean_boundary%sw_flux_vis_dif(i,j) + & + ! ice_ocean_boundary%sw_flux_nir_dir(i,j) + ice_ocean_boundary%sw_flux_nir_dif(i,j) + + ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) * GRID%mask2dT(ig,jg) + ! ice_ocean_boundary%runoff(i,j) = (dataPtr_rofl(i1,j1)+dataPtr_rofi(i1,j1)) * GRID%mask2dT(ig,jg) + + ! ice_ocean_boundary%salt_flux(i,j) = GRID%mask2dT(ig,jg)*dataPtr_iosalt(i1,j1) + ! ice_ocean_boundary%salt_flux(i,j) = GRID%mask2dT(ig,jg)*(dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j)) + + endif + + enddo enddo - enddo - -end subroutine ocn_import + end subroutine ocn_import !----------------------------------------------------------------------------- @@ -561,14 +561,14 @@ subroutine State_GetFldPtr(ST, fldname, fldptr, rc) call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out if (present(rc)) rc = lrc From 6abae7d14d2b1ea73fc50ea3b04615ff9563fb71 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 25 May 2018 09:27:22 -0400 Subject: [PATCH 0291/1072] +Created initialize_ice_shelf_dyn Created a new subroutine, initialize_ice_shelf_dyn, to initialize the ice shelf dynamics control structure. Also commented out the register_diag_field call for ice_surf, which was never actually posted. Moved the IDs for diagnostics related to the ice shelf dynamics into the ice shelf dynamics control structure. Also dOxyGenised the arguments to initialize_ice_shelf. All answers are bitwise identical in the MOM6_examples test cases, but the order of entries in the MOM_parameter_doc files will change with active ice shelf dynamics. --- src/ice_shelf/MOM_ice_shelf.F90 | 768 ++++++++++++++++++-------------- 1 file changed, 439 insertions(+), 329 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 3023562422..d49b7e2395 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -21,7 +21,7 @@ module MOM_ice_shelf use MOM_fixed_initialization, only : MOM_initialize_rotation use user_initialization, only : user_initialize_topography use MOM_io, only : field_exists, file_exists, MOM_read_data, write_version_number -use MOM_io, only : slasher, vardesc, var_desc, fieldtype +use MOM_io, only : slasher, fieldtype use MOM_io, only : write_field, close_file, SINGLE_FILE, MULTIPLE use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, restore_state, MOM_restart_CS @@ -162,14 +162,11 @@ module MOM_ice_shelf id_tfreeze = -1, id_tfl_shelf = -1, & id_thermal_driving = -1, id_haline_driving = -1, & id_u_ml = -1, id_v_ml = -1, id_sbdry = -1, & - id_u_shelf = -1, id_v_shelf = -1, id_h_shelf = -1, id_h_mask = -1, & - id_u_mask = -1, id_v_mask = -1, id_t_shelf = -1, id_t_mask = -1, & - id_surf_elev = -1, id_bathym = -1, id_float_frac = -1, id_col_thick = -1, & - id_area_shelf_h = -1, id_OD_av = -1, id_float_frac_rt = -1,& + id_h_shelf = -1, id_h_mask = -1, & +! id_surf_elev = -1, id_bathym = -1, & + id_area_shelf_h = -1, & id_ustar_shelf = -1, id_shelf_mass = -1, id_mass_flux = -1 !>@} - ! ids for outputting intermediate thickness in advection subroutine (debugging) - !integer :: id_h_after_uflux = -1, id_h_after_vflux = -1, id_h_after_adv = -1 integer :: id_read_mass !< An integer handle used in time interpolation of !! the ice shelf mass read from a file @@ -284,6 +281,21 @@ module MOM_ice_shelf logical :: debug !< If true, write verbose checksums for debugging purposes !! and use reproducible sums + + logical :: module_is_initialized = .false. !< True if this module has been initialized. + + !>@{ + ! Diagnostic handles + integer :: id_u_shelf = -1, id_v_shelf = -1, & + id_float_frac = -1, id_col_thick = -1, & + id_u_mask = -1, id_v_mask = -1, id_t_shelf = -1, id_t_mask = -1, & + id_OD_av = -1, id_float_frac_rt = -1 + !>@} + ! ids for outputting intermediate thickness in advection subroutine (debugging) + !integer :: id_h_after_uflux = -1, id_h_after_vflux = -1, id_h_after_adv = -1 + + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to control diagnostic output. + end type ice_shelf_dyn_CS integer :: id_clock_shelf, id_clock_pass !< Clock for group pass calls @@ -723,50 +735,46 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) fluxes%iceshelf_melt = ISS%water_flux * (86400.0*365.0/CS%density_ice) * CS%flux_factor endif - do j=js,je - do i=is,ie - if ((iDens*state%ocean_mass(i,j) > CS%col_thick_melt_threshold) .and. & - (ISS%area_shelf_h(i,j) > 0.0) .and. & - (CS%isthermo) .and. (state%Hml(i,j) > 0.0) ) then - - ! Set melt to zero above a cutoff pressure - ! (CS%Rho0*CS%cutoff_depth*CS%g_Earth) this is needed for the isomip - ! test case. - if ((CS%g_Earth * ISS%mass_shelf(i,j)) < CS%Rho0*CS%cutoff_depth* & - CS%g_Earth) then - ISS%water_flux(i,j) = 0.0 - fluxes%iceshelf_melt(i,j) = 0.0 - endif - ! Compute haline driving, which is one of the diags. used in ISOMIP - haline_driving(i,j) = (ISS%water_flux(i,j) * Sbdry(i,j)) / & - (CS%Rho0 * exch_vel_s(i,j)) - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!Safety checks !!!!!!!!!!!!!!!!!!!!!!!!! - !1)Check if haline_driving computed above is consistent with - ! haline_driving = state%sss - Sbdry - !if (fluxes%iceshelf_melt(i,j) /= 0.0) then - ! if (haline_driving(i,j) /= (state%sss(i,j) - Sbdry(i,j))) then - ! write(*,*)'Something is wrong at i,j',i,j - ! write(*,*)'haline_driving, sss-Sbdry',haline_driving(i,j), & - ! (state%sss(i,j) - Sbdry(i,j)) - ! call MOM_error(FATAL, & - ! "shelf_calc_flux: Inconsistency in melt and haline_driving") - ! endif - !endif - - ! 2) check if |melt| > 0 when star_shelf = 0. - ! this should never happen - if (abs(fluxes%iceshelf_melt(i,j))>0.0) then - if (fluxes%ustar_shelf(i,j) == 0.0) then - write(*,*)'Something is wrong at i,j',i,j - call MOM_error(FATAL, & - "shelf_calc_flux: |melt| > 0 and star_shelf = 0.") - endif - endif - endif ! area_shelf_h - !!!!!!!!!!!!!!!!!!!!!!!!!!!!End of safety checks !!!!!!!!!!!!!!!!!!! - enddo ! i-loop - enddo ! j-loop + do j=js,je ; do i=is,ie + if ((iDens*state%ocean_mass(i,j) > CS%col_thick_melt_threshold) .and. & + (ISS%area_shelf_h(i,j) > 0.0) .and. & + (CS%isthermo) .and. (state%Hml(i,j) > 0.0) ) then + + ! Set melt to zero above a cutoff pressure + ! (CS%Rho0*CS%cutoff_depth*CS%g_Earth) this is needed for the isomip + ! test case. + if ((CS%g_Earth * ISS%mass_shelf(i,j)) < CS%Rho0*CS%cutoff_depth* & + CS%g_Earth) then + ISS%water_flux(i,j) = 0.0 + fluxes%iceshelf_melt(i,j) = 0.0 + endif + ! Compute haline driving, which is one of the diags. used in ISOMIP + haline_driving(i,j) = (ISS%water_flux(i,j) * Sbdry(i,j)) / & + (CS%Rho0 * exch_vel_s(i,j)) + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!Safety checks !!!!!!!!!!!!!!!!!!!!!!!!! + !1)Check if haline_driving computed above is consistent with + ! haline_driving = state%sss - Sbdry + !if (fluxes%iceshelf_melt(i,j) /= 0.0) then + ! if (haline_driving(i,j) /= (state%sss(i,j) - Sbdry(i,j))) then + ! write(*,*)'Something is wrong at i,j',i,j + ! write(*,*)'haline_driving, sss-Sbdry',haline_driving(i,j), & + ! (state%sss(i,j) - Sbdry(i,j)) + ! call MOM_error(FATAL, & + ! "shelf_calc_flux: Inconsistency in melt and haline_driving") + ! endif + !endif + + ! 2) check if |melt| > 0 when star_shelf = 0. + ! this should never happen + if ((abs(fluxes%iceshelf_melt(i,j))>0.0) .and. (fluxes%ustar_shelf(i,j) == 0.0)) then + write(*,*)'Something is wrong at i,j',i,j + call MOM_error(FATAL, & + "shelf_calc_flux: |melt| > 0 and star_shelf = 0.") + endif + endif ! area_shelf_h + !!!!!!!!!!!!!!!!!!!!!!!!!!!!End of safety checks !!!!!!!!!!!!!!!!!!! + enddo ; enddo ! i- and j-loops ! mass flux (kg/s), part of ISOMIP diags. mass_flux(:,:) = 0.0 @@ -833,12 +841,12 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf,ISS%h_shelf,CS%diag) if (CS%id_h_mask > 0) call post_data(CS%id_h_mask,ISS%hmask,CS%diag) - if (CS%id_col_thick > 0) call post_data(CS%id_col_thick, CS%dCS%OD_av, CS%diag) - if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf,CS%dCS%u_shelf,CS%diag) - if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf,CS%dCS%v_shelf,CS%diag) - if (CS%id_float_frac > 0) call post_data(CS%id_float_frac,CS%dCS%float_frac,CS%diag) - if (CS%id_OD_av >0) call post_data(CS%id_OD_av,CS%dCS%OD_av,CS%diag) - if (CS%id_float_frac_rt>0) call post_data(CS%id_float_frac_rt,CS%dCS%float_frac_rt,CS%diag) + if (CS%dCS%id_col_thick > 0) call post_data(CS%dCS%id_col_thick, CS%dCS%OD_av, CS%diag) + if (CS%dCS%id_u_shelf > 0) call post_data(CS%dCS%id_u_shelf,CS%dCS%u_shelf,CS%diag) + if (CS%dCS%id_v_shelf > 0) call post_data(CS%dCS%id_v_shelf,CS%dCS%v_shelf,CS%diag) + if (CS%dCS%id_float_frac > 0) call post_data(CS%dCS%id_float_frac,CS%dCS%float_frac,CS%diag) + if (CS%dCS%id_OD_av >0) call post_data(CS%dCS%id_OD_av,CS%dCS%OD_av,CS%diag) + if (CS%dCS%id_float_frac_rt>0) call post_data(CS%dCS%id_float_frac_rt,CS%dCS%float_frac_rt,CS%diag) call disable_averaging(CS%diag) call cpu_clock_end(id_clock_shelf) @@ -1195,30 +1203,29 @@ end subroutine add_shelf_flux !> Initializes shelf model data, parameters and diagnostics subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fluxes, Time_in, solo_ice_sheet_in) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(ocean_grid_type), pointer :: ocn_grid - type(time_type), intent(inout) :: Time !< The current model time + type(ocean_grid_type), pointer :: ocn_grid !< The calling ocean model's horizontal grid structure + type(time_type), intent(inout) :: Time !< The clock that that will indicate the model time type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - type(diag_ctrl), target, intent(in) :: diag - type(forcing), optional, intent(inout) :: fluxes - type(mech_forcing), optional, intent(inout) :: forces - type(time_type), optional, intent(in) :: Time_in - logical, optional, intent(in) :: solo_ice_sheet_in + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate the diagnostic output. + type(forcing), optional, intent(inout) :: fluxes !< A structure containing pointers to any possible + !! thermodynamic or mass-flux forcing fields. + type(mech_forcing), optional, intent(inout) :: forces !< A structure with the driving mechanical forces + type(time_type), optional, intent(in) :: Time_in !< The time at initialization. + logical, optional, intent(in) :: solo_ice_sheet_in !< If present, this indicates whether + !! a solo ice-sheet driver. type(ocean_grid_type), pointer :: G => NULL(), OG => NULL() ! Pointers to grids for convenience. type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe !! the ice-shelf state - type(ice_shelf_dyn_CS), pointer :: dCS => NULL() +! type(ice_shelf_dyn_CS), pointer :: dCS => NULL() type(directories) :: dirs - type(vardesc) :: vd type(dyn_horgrid_type), pointer :: dG => NULL() real :: cdrag, drag_bg_vel - real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1. logical :: new_sim, save_IC, var_force !This include declares and sets the variable "version". #include "version_variable.h" character(len=200) :: config character(len=200) :: IC_file,filename,inputdir - character(len=40) :: var_name character(len=40) :: mdl = "MOM_ice_shelf" ! This module's name. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, Isdq, Iedq, Jsdq, Jedq, iters integer :: wd_halos(2) @@ -1265,8 +1272,6 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl CS%Time = Time ! ### This might not be in the right place? CS%diag => diag - allocate(CS%dCS) ; dCS => CS%dCS - ! Are we being called from the solo ice-sheet driver? When called by the ocean ! model solo_ice_sheet_in is not preset. CS%solo_ice_sheet = .false. @@ -1286,9 +1291,6 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call get_param(param_file, mdl, "DEBUG_IS", CS%debug, & "If true, write verbose debugging messages for the ice shelf.", & default=debug) - call get_param(param_file, mdl, "DEBUG_IS", dCS%debug, & - "If true, write verbose debugging messages for the ice shelf.", & - default=debug) call get_param(param_file, mdl, "DYNAMIC_SHELF_MASS", shelf_mass_is_dynamic, & "If true, the ice sheet mass can evolve with time.", & default=.false.) @@ -1297,19 +1299,17 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl "If true, user provided code specifies the ice-shelf \n"//& "movement instead of the dynamic ice model.", default=.false.) CS%active_shelf_dynamics = .not.CS%override_shelf_movement - call get_param(param_file, mdl, "GROUNDING_LINE_INTERPOLATE", dCS%GL_regularize, & - "THIS PARAMETER NEEDS A DESCRIPTION.", default=.false.) - CS%GL_regularize = dCS%GL_regularize - call get_param(param_file, mdl, "GROUNDING_LINE_INTERP_SUBGRID_N", dCS%n_sub_regularize, & - "THIS PARAMETER NEEDS A DESCRIPTION.", default=0) + call get_param(param_file, mdl, "GROUNDING_LINE_INTERPOLATE", CS%GL_regularize, & + "If true, regularize the floatation condition at the \n"//& + "grounding line as in Goldberg Holland Schoof 2009.", default=.false.) call get_param(param_file, mdl, "GROUNDING_LINE_COUPLE", CS%GL_couple, & - "THIS PARAMETER NEEDS A DESCRIPTION.", default=.false.) + "If true, let the floatation condition be determined by \n"//& + "ocean column thickness. This means that update_OD_ffrac \n"//& + "will be called. GL_REGULARIZE and GL_COUPLE are exclusive.", & + default=.false., do_not_log=CS%GL_regularize) if (CS%GL_regularize) CS%GL_couple = .false. - dCS%GL_couple = CS%GL_couple - if (dCS%GL_regularize) dCS%GL_couple = .false. - if (dCS%GL_regularize .and. (dCS%n_sub_regularize == 0)) call MOM_error (FATAL, & - "GROUNDING_LINE_INTERP_SUBGRID_N must be a positive integer if GL regularization is used") endif + call get_param(param_file, mdl, "SHELF_THERMO", CS%isthermo, & "If true, use a thermodynamically interactive ice shelf.", & default=.false.) @@ -1417,10 +1417,9 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call get_param(param_file, mdl, "KD_TEMP_MOLECULAR", CS%kd_molec_temp, & "The molecular diffusivity of heat in sea water at the \n"//& "freezing point.", units="m2 s-1", default=1.41e-7) - call get_param(param_file, mdl, "RHO_0", dCS%density_ocean_avg, & + call get_param(param_file, mdl, "RHO_0", CS%density_ocean_avg, & "avg ocean density used in floatation cond", & units="kg m-3", default=1035.) - CS%density_ocean_avg = dCS%density_ocean_avg call get_param(param_file, mdl, "DT_FORCING", CS%time_step, & "The time step for changing forcing, coupling with other \n"//& "components, or potentially writing certain diagnostics. \n"//& @@ -1460,24 +1459,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if (CS%active_shelf_dynamics) then - call get_param(param_file, mdl, "A_GLEN_ISOTHERM", dCS%A_glen_isothermal, & - "Ice viscosity parameter in Glen's Law", & - units="Pa -1/3 a", default=9.461e-18) - call get_param(param_file, mdl, "GLEN_EXPONENT", dCS%n_glen, & - "nonlinearity exponent in Glen's Law", & - units="none", default=3.) - call get_param(param_file, mdl, "MIN_STRAIN_RATE_GLEN", dCS%eps_glen_min, & - "min. strain rate to avoid infinite Glen's law viscosity", & - units="a-1", default=1.e-12) - call get_param(param_file, mdl, "BASAL_FRICTION_COEFF", dCS%C_basal_friction, & - "ceofficient in sliding law \tau_b = C u^(n_basal_friction)", & - units="Pa (m-a)-(n_basal_friction)", fail_if_missing=.true.) - call get_param(param_file, mdl, "BASAL_FRICTION_EXP", dCS%n_basal_friction, & - "exponent in sliding law \tau_b = C u^(m_slide)", & - units="none", fail_if_missing=.true.) call get_param(param_file, mdl, "DENSITY_ICE", CS%density_ice, & "A typical density of ice.", units="kg m-3", default=917.0) - dCS%density_ice = CS%density_ice call get_param(param_file, mdl, "INPUT_FLUX_ICE_SHELF", CS%input_flux, & "volume flux at upstream boundary", & @@ -1489,32 +1472,10 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl "seconds between ice velocity calcs", units="s", & fail_if_missing=.true.) - call get_param(param_file, mdl, "CONJUGATE_GRADIENT_TOLERANCE", dCS%cg_tolerance, & - "tolerance in CG solver, relative to initial residual", default=1.e-6) - call get_param(param_file, mdl, "ICE_NONLINEAR_TOLERANCE", dCS%nonlinear_tolerance, & - "nonlin tolerance in iterative velocity solve",default=1.e-6) - call get_param(param_file, mdl, "CONJUGATE_GRADIENT_MAXIT", dCS%cg_max_iterations, & - "max iteratiions in CG solver", default=2000) - call get_param(param_file, mdl, "THRESH_FLOAT_COL_DEPTH", dCS%thresh_float_col_depth, & - "min ocean thickness to consider ice *floating*; \n"// & - "will only be important with use of tides", & - units="m",default=1.e-3) - - call get_param(param_file, mdl, "SHELF_MOVING_FRONT", dCS%moving_shelf_front, & - "whether or not to advance shelf front (and calve..)") - call get_param(param_file, mdl, "CALVE_TO_MASK", dCS%calve_to_mask, & - "if true, do not allow an ice shelf where prohibited by a mask") call get_param(param_file, mdl, "ICE_SHELF_CFL_FACTOR", CS%CFL_factor, & "limit timestep as a factor of min (\Delta x / u); \n"// & "only important for ice-only model", & default=0.25) - call get_param(param_file, mdl, "NONLIN_SOLVE_ERR_MODE", dCS%nonlin_solve_err_mode, & - "choose whether nonlin error in vel solve is based on nonlinear residual (1) \n"// & - "or relative change since last iteration (2)", & - default=1) - call get_param(param_file, mdl, "SHELF_DYN_REPRODUCING_SUMS", dCS%use_reproducing_sums, & - "If true, use the reproducing extended-fixed-point sums in the ice \n"//& - "shelf dynamics solvers.", default=.true.) CS%nstep_velocity = FLOOR (CS%velocity_update_time_step / CS%time_step) CS%velocity_update_counter = 0 @@ -1525,12 +1486,10 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call get_param(param_file, mdl, "DENSITY_ICE", CS%density_ice, & "A typical density of ice.", units="kg m-3", default=900.0) endif - call get_param(param_file, mdl, "MIN_THICKNESS_SIMPLE_CALVE", & CS%min_thickness_simple_calve, & - "min thickness rule for VERY simple calving law",& + "Min thickness rule for the very simple calving law",& units="m", default=0.0) - dCS%min_thickness_simple_calve = CS%min_thickness_simple_calve call get_param(param_file, mdl, "USTAR_SHELF_BG", CS%ustar_bg, & "The minimum value of ustar under ice sheves.", units="m s-1", & @@ -1550,45 +1509,10 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl endif - ! Allocate and initialize variables + ! Allocate and initialize state variables to default values call ice_shelf_state_init(CS%ISS, CS%grid) ISS => CS%ISS - ! OVS vertically integrated Temperature - allocate( dCS%t_shelf(isd:ied,jsd:jed) ) ; dCS%t_shelf(:,:) = -10.0 - allocate( dCS%t_bdry_val(isd:ied,jsd:jed) ) ; dCS%t_bdry_val(:,:) = -15.0 - allocate( dCS%tmask(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%tmask(:,:) = -1.0 - - if (CS%active_shelf_dynamics) then - ! DNG - allocate( dCS%u_shelf(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%u_shelf(:,:) = 0.0 - allocate( dCS%v_shelf(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%v_shelf(:,:) = 0.0 - allocate( dCS%u_bdry_val(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%u_bdry_val(:,:) = 0.0 - allocate( dCS%v_bdry_val(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%v_bdry_val(:,:) = 0.0 - allocate( dCS%h_bdry_val(isd:ied,jsd:jed) ) ; dCS%h_bdry_val(:,:) = 0.0 - allocate( dCS%thickness_bdry_val(isd:ied,jsd:jed) ) ; dCS%thickness_bdry_val(:,:) = 0.0 - allocate( dCS%ice_visc(isd:ied,jsd:jed) ) ; dCS%ice_visc(:,:) = 0.0 - allocate( dCS%u_face_mask(Isdq:Iedq,jsd:jed) ) ; dCS%u_face_mask(:,:) = 0.0 - allocate( dCS%v_face_mask(isd:ied,Jsdq:Jedq) ) ; dCS%v_face_mask(:,:) = 0.0 - allocate( dCS%u_face_mask_bdry(Isdq:Iedq,jsd:jed) ) ; dCS%u_face_mask_bdry(:,:) = -2.0 - allocate( dCS%v_face_mask_bdry(isd:ied,Jsdq:Jedq) ) ; dCS%v_face_mask_bdry(:,:) = -2.0 - allocate( dCS%u_flux_bdry_val(Isdq:Iedq,jsd:jed) ) ; dCS%u_flux_bdry_val(:,:) = 0.0 - allocate( dCS%v_flux_bdry_val(isd:ied,Jsdq:Jedq) ) ; dCS%v_flux_bdry_val(:,:) = 0.0 - allocate( dCS%umask(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%umask(:,:) = -1.0 - allocate( dCS%vmask(Isdq:Iedq,Jsdq:Jedq) ) ; dCS%vmask(:,:) = -1.0 - - allocate( dCS%taub_beta_eff(isd:ied,jsd:jed) ) ; dCS%taub_beta_eff(:,:) = 0.0 - allocate( dCS%OD_rt(isd:ied,jsd:jed) ) ; dCS%OD_rt(:,:) = 0.0 - allocate( dCS%OD_av(isd:ied,jsd:jed) ) ; dCS%OD_av(:,:) = 0.0 - allocate( dCS%float_frac(isd:ied,jsd:jed) ) ; dCS%float_frac(:,:) = 0.0 - allocate( dCS%float_frac_rt(isd:ied,jsd:jed) ) ; dCS%float_frac_rt(:,:) = 0.0 - - if (dCS%calve_to_mask) then - allocate( dCS%calve_mask(isd:ied,jsd:jed) ) ; dCS%calve_mask(:,:) = 0.0 - endif - - endif - ! Allocate the arrays for passing ice-shelf data through the forcing type. if (.not. CS%solo_ice_sheet) then call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: allocating fluxes.") @@ -1618,57 +1542,28 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! Set up the restarts. call restart_init(param_file, CS%restart_CSp, "Shelf.res") - vd = var_desc("shelf_mass","kg m-2","Ice shelf mass",z_grid='1') - call register_restart_field(ISS%mass_shelf, vd, .true., CS%restart_CSp) - vd = var_desc("shelf_area","m2","Ice shelf area in cell",z_grid='1') - call register_restart_field(ISS%area_shelf_h, vd, .true., CS%restart_CSp) - vd = var_desc("h_shelf","m","ice sheet/shelf thickness",z_grid='1') - call register_restart_field(ISS%h_shelf, vd, .true., CS%restart_CSp) - + call register_restart_field(ISS%mass_shelf, "shelf_mass", .true., CS%restart_CSp, & + "Ice shelf mass", "kg m-2") + call register_restart_field(ISS%area_shelf_h, "shelf_area", .true., CS%restart_CSp, & + "Ice shelf area in cell", "m2") + call register_restart_field(ISS%h_shelf, "h_shelf", .true., CS%restart_CSp, & + "ice sheet/shelf thickness", "m") if (CS%active_shelf_dynamics) then - ! additional restarts for ice shelf state - vd = var_desc("u_shelf","m s-1","ice sheet/shelf velocity",'q',z_grid='1') - call register_restart_field(dCS%u_shelf, vd, .true., CS%restart_CSp) - vd = var_desc("v_shelf","m s-1","ice sheet/shelf velocity",'q',z_grid='1') - call register_restart_field(dCS%v_shelf, vd, .true., CS%restart_CSp) - !vd = var_desc("h_shelf","m","ice sheet/shelf thickness",z_grid='1') - !call register_restart_field(ISS%h_shelf, vd, .true., CS%restart_CSp) - - vd = var_desc("h_mask","none","ice sheet/shelf thickness mask",z_grid='1') - call register_restart_field(ISS%hmask, vd, .true., CS%restart_CSp) - - ! OVS vertically integrated stream/shelf temperature - vd = var_desc("t_shelf","deg C","ice sheet/shelf temperature",z_grid='1') - call register_restart_field(dCS%t_shelf, vd, .true., CS%restart_CSp) - - - ! vd = var_desc("area_shelf_h","m-2","ice-covered area of a cell",z_grid='1') - ! call register_restart_field(ISS%area_shelf_h, vd, .true., CS%restart_CSp) - - vd = var_desc("OD_av","m","avg ocean depth in a cell",z_grid='1') - call register_restart_field(dCS%OD_av, vd, .true., CS%restart_CSp) - - ! vd = var_desc("OD_av_rt","m","avg ocean depth in a cell, intermed",z_grid='1') - ! call register_restart_field(dCS%OD_av_rt, CS%OD_av_rt, vd, .true., CS%restart_CSp) - - vd = var_desc("float_frac","m","degree of grounding",z_grid='1') - call register_restart_field(dCS%float_frac, vd, .true., CS%restart_CSp) - - ! vd = var_desc("float_frac_rt","m","degree of grounding, intermed",z_grid='1') - ! call register_restart_field(dCS%float_frac_rt, CS%float_frac_rt, vd, .true., CS%restart_CSp) - - vd = var_desc("viscosity","m","glens law ice visc",z_grid='1') - call register_restart_field(dCS%ice_visc, vd, .true., CS%restart_CSp) - vd = var_desc("tau_b_beta","m","coefficient of basal traction",z_grid='1') - call register_restart_field(dCS%taub_beta_eff, vd, .true., CS%restart_CSp) + call register_restart_field(ISS%hmask, "h_mask", .true., CS%restart_CSp, & + "ice sheet/shelf thickness mask" ,"none") endif + ! if (CS%active_shelf_dynamics) then !### Consider adding an ice shelf dynamics switch. + ! Allocate CS%dCS and specify additional restarts for ice shelf dynamics + call register_ice_shelf_dyn_restarts(G, param_file, CS%dCS, CS%restart_CSp) + ! endif + !GMM - I think we do not need to save ustar_shelf and iceshelf_melt in the restart file - ! if (.not. CS%solo_ice_sheet) then - ! vd = var_desc("ustar_shelf","m s-1","Friction velocity under ice shelves",z_grid='1') - ! call register_restart_field(fluxes%ustar_shelf, vd, .true., CS%restart_CSp) - ! vd = var_desc("iceshelf_melt","m year-1","Ice Shelf Melt Rate",z_grid='1') - ! call register_restart_field(fluxes%iceshelf_melt, vd, .true., CS%restart_CSp) + !if (.not. CS%solo_ice_sheet) then + ! call register_restart_field(fluxes%ustar_shelf, "ustar_shelf", .false., CS%restart_CSp, & + ! "Friction velocity under ice shelves", "m s-1") + ! call register_restart_field(fluxes%iceshelf_melt, "iceshelf_melt", .false., CS%restart_CSp, & + ! "Ice Shelf Melt Rate", "m year-1") !endif CS%restart_output_dir = dirs%restart_output_dir @@ -1726,61 +1621,25 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl elseif (.not.new_sim) then ! This line calls a subroutine that reads the initial conditions ! from a restart file. - call restore_state(dirs%input_filename, dirs%restart_input_dir, Time, & + call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: Restoring ice shelf from file.") + call restore_state(dirs%input_filename, dirs%restart_input_dir, Time, & G, CS%restart_CSp) ! i think this call isnt necessary - all it does is set hmask to 3 at ! the dirichlet boundary, and now this is done elsewhere ! call initialize_shelf_mass(G, param_file, CS, ISS, .false.) - if (CS%active_shelf_dynamics) then - - ! this is unfortunately necessary; if grid is not symmetric the boundary values - ! of u and v are otherwise not set till the end of the first linear solve, and so - ! viscosity is not calculated correctly - if (.not. G%symmetric) then - do j=G%jsd,G%jed - do i=G%isd,G%ied - if (((i+G%idg_offset) == (G%domain%nihalo+1)).and.(dCS%u_face_mask(i-1,j) == 3)) then - dCS%u_shelf(i-1,j-1) = dCS%u_bdry_val(i-1,j-1) - dCS%u_shelf(i-1,j) = dCS%u_bdry_val(i-1,j) - endif - if (((j+G%jdg_offset) == (G%domain%njhalo+1)).and.(dCS%v_face_mask(i,j-1) == 3)) then - dCS%u_shelf(i-1,j-1) = dCS%u_bdry_val(i-1,j-1) - dCS%u_shelf(i,j-1) = dCS%u_bdry_val(i,j-1) - endif - enddo - enddo - endif - - call pass_var(dCS%OD_av,G%domain) - call pass_var(dCS%float_frac,G%domain) - call pass_var(dCS%ice_visc,G%domain) - call pass_var(dCS%taub_beta_eff,G%domain) - call pass_vector(dCS%u_shelf, dCS%v_shelf, G%domain, TO_ALL, BGRID_NE) - call pass_var(ISS%area_shelf_h,G%domain) - call pass_var(ISS%h_shelf,G%domain) - call pass_var(ISS%hmask,G%domain) - - call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: Restoring ice shelf from file.") - endif - endif ! .not. new_sim CS%Time = Time + call cpu_clock_begin(id_clock_pass) call pass_var(ISS%area_shelf_h, G%domain) call pass_var(ISS%h_shelf, G%domain) call pass_var(ISS%mass_shelf, G%domain) - - ! Transfer the appropriate fields to the forcing type. - if (CS%active_shelf_dynamics) then - call cpu_clock_begin(id_clock_pass) - call pass_var(G%bathyT, G%domain) - call pass_var(ISS%hmask, G%domain) - call update_velocity_masks(dCS, G, ISS%hmask, dCS%umask, dCS%vmask, dCS%u_face_mask, dCS%v_face_mask) - call cpu_clock_end(id_clock_pass) - endif + call pass_var(ISS%hmask, G%domain) + call pass_var(G%bathyT, G%domain) + call cpu_clock_end(id_clock_pass) do j=jsd,jed ; do i=isd,ied if (ISS%area_shelf_h(i,j) > G%areaT(i,j)) then @@ -1803,54 +1662,13 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if (present(fluxes) .and. present(forces)) & call copy_common_forcing_fields(forces, fluxes, G) - ! if we are calving to a mask, i.e. if a mask exists where a shelf cannot, then we read - ! the mask from a file - - if (CS%active_shelf_dynamics) then - if (dCS%calve_to_mask) then - - call MOM_mesg(" MOM_ice_shelf.F90, initialize_ice_shelf: reading calving_mask") - - call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") - inputdir = slasher(inputdir) - call get_param(param_file, mdl, "CALVING_MASK_FILE", IC_file, & - "The file with a mask for where calving might occur.", & - default="ice_shelf_h.nc") - call get_param(param_file, mdl, "CALVING_MASK_VARNAME", var_name, & - "The variable to use in masking calving.", & - default="area_shelf_h") - - filename = trim(inputdir)//trim(IC_file) - call log_param(param_file, mdl, "INPUTDIR/CALVING_MASK_FILE", filename) - if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & - " calving mask file: Unable to open "//trim(filename)) - - call MOM_read_data(filename,trim(var_name),dCS%calve_mask,G%Domain) - do j=G%jsc,G%jec - do i=G%isc,G%iec - if (dCS%calve_mask(i,j) > 0.0) dCS%calve_mask(i,j) = 1.0 - enddo - enddo - - call pass_var(dCS%calve_mask,G%domain) - endif - -! call init_boundary_values(CS, G, time, ISS%hmask, CS%input_flux, CS%input_thickness, new_sim) - - if (.not. CS%isthermo) then - ISS%water_flux(:,:) = 0.0 - endif - - if (new_sim) then - call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") - call update_OD_ffrac_uncoupled(dCS, G, ISS%h_shelf) - call ice_shelf_solve_outer(dCS, ISS, G, dCS%u_shelf, dCS%v_shelf, iters, Time) - - if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf,dCS%u_shelf,CS%diag) - if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf,dCS%v_shelf,CS%diag) - endif + if (CS%active_shelf_dynamics .and. .not.CS%isthermo) then + ISS%water_flux(:,:) = 0.0 endif + if (shelf_mass_is_dynamic) & + call initialize_ice_shelf_dyn(param_file, Time, ISS, CS%dCS, G, diag, new_sim, solo_ice_sheet_in) + call get_param(param_file, mdl, "SAVE_INITIAL_CONDS", save_IC, & "If true, save the ice shelf initial conditions.", & default=.false.) @@ -1869,6 +1687,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl 'Ice Shelf Area in cell', 'meter-2') CS%id_shelf_mass = register_diag_field('ocean_model', 'shelf_mass', CS%diag%axesT1, CS%Time, & 'mass of shelf', 'kg/m^2') + CS%id_h_shelf = register_diag_field('ocean_model', 'h_shelf', CS%diag%axesT1, CS%Time, & + 'ice shelf thickness', 'm') CS%id_mass_flux = register_diag_field('ocean_model', 'mass_flux', CS%diag%axesT1,& CS%Time,'Total mass flux of freshwater across the ice-ocean interface.', 'kg/s') CS%id_melt = register_diag_field('ocean_model', 'melt', CS%diag%axesT1, CS%Time, & @@ -1893,46 +1713,336 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl 'Heat conduction into ice shelf', 'W m-2') CS%id_ustar_shelf = register_diag_field('ocean_model', 'ustar_shelf', CS%diag%axesT1, CS%Time, & 'Fric vel under shelf', 'm/s') - if (CS%active_shelf_dynamics) then - CS%id_u_shelf = register_diag_field('ocean_model','u_shelf',CS%diag%axesCu1,CS%Time, & + CS%id_h_mask = register_diag_field('ocean_model', 'h_mask', CS%diag%axesT1, CS%Time, & + 'ice shelf thickness mask', 'none') + endif + + id_clock_shelf = cpu_clock_id('Ice shelf', grain=CLOCK_COMPONENT) + id_clock_pass = cpu_clock_id(' Ice shelf halo updates', grain=CLOCK_ROUTINE) + +end subroutine initialize_ice_shelf + +!> This subroutine is used to register any fields related to the ice shelf +!! dynamics that should be written to or read from the restart file. +subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) + type(ocean_grid_type), intent(inout) :: G !< The grid type describing the ice shelf grid. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(ice_shelf_dyn_CS), pointer :: CS !< A pointer to the ice shelf dynamics control structure + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + + logical :: shelf_mass_is_dynamic, override_shelf_movement, active_shelf_dynamics + character(len=40) :: mdl = "MOM_ice_shelf_dyn" ! This module's name. + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + if (associated(CS)) then + call MOM_error(FATAL, "MOM_ice_shelf_dyn.F90, register_ice_shelf_dyn_restarts: "// & + "called with an associated control structure.") + return + endif + allocate(CS) + + override_shelf_movement = .false. ; active_shelf_dynamics = .false. + call get_param(param_file, mdl, "DYNAMIC_SHELF_MASS", shelf_mass_is_dynamic, & + "If true, the ice sheet mass can evolve with time.", & + default=.false., do_not_log=.true.) + if (shelf_mass_is_dynamic) then + call get_param(param_file, mdl, "OVERRIDE_SHELF_MOVEMENT", override_shelf_movement, & + "If true, user provided code specifies the ice-shelf \n"//& + "movement instead of the dynamic ice model.", default=.false., do_not_log=.true.) + active_shelf_dynamics = .not.override_shelf_movement + endif + + allocate( CS%t_shelf(isd:ied,jsd:jed) ) ; CS%t_shelf(:,:) = -10.0 + + if (active_shelf_dynamics) then + allocate( CS%u_shelf(IsdB:IedB,JsdB:JedB) ) ; CS%u_shelf(:,:) = 0.0 + allocate( CS%v_shelf(IsdB:IedB,JsdB:JedB) ) ; CS%v_shelf(:,:) = 0.0 + allocate( CS%ice_visc(isd:ied,jsd:jed) ) ; CS%ice_visc(:,:) = 0.0 + allocate( CS%taub_beta_eff(isd:ied,jsd:jed) ) ; CS%taub_beta_eff(:,:) = 0.0 + allocate( CS%OD_av(isd:ied,jsd:jed) ) ; CS%OD_av(:,:) = 0.0 + allocate( CS%float_frac(isd:ied,jsd:jed) ) ; CS%float_frac(:,:) = 0.0 + + ! additional restarts for ice shelf state + call register_restart_field(CS%u_shelf, "u_shelf", .false., restart_CS, & + "ice sheet/shelf u-velocity", "m s-1", hor_grid='Bu') + call register_restart_field(CS%v_shelf, "v_shelf", .false., restart_CS, & + "ice sheet/shelf v-velocity", "m s-1", hor_grid='Bu') + call register_restart_field(CS%t_shelf, "t_shelf", .true., restart_CS, & + "ice sheet/shelf vertically averaged temperature", "deg C") + call register_restart_field(CS%OD_av, "OD_av", .true., restart_CS, & + "Average open ocean depth in a cell","m") + call register_restart_field(CS%float_frac, "float_frac", .true., restart_CS, & + "fractional degree of grounding", "nondim") + call register_restart_field(CS%ice_visc, "viscosity", .true., restart_CS, & + "Glens law ice viscosity", "m (seems wrong)") + call register_restart_field(CS%taub_beta_eff, "tau_b_beta", .true., restart_CS, & + "Coefficient of basal traction", "m (seems wrong)") + endif + +end subroutine register_ice_shelf_dyn_restarts + +!> Initializes shelf model data, parameters and diagnostics +subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, diag, new_sim, solo_ice_sheet_in) + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(ocean_grid_type), pointer :: ocn_grid !< The calling ocean model's horizontal grid structure + type(time_type), intent(inout) :: Time !< The clock that that will indicate the model time + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe + !! the ice-shelf state + type(ice_shelf_dyn_CS), pointer :: CS !< A pointer to the ice shelf dynamics control structure + type(ocean_grid_type), intent(inout) :: G !< The grid type describing the ice shelf grid. + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate the diagnostic output. + logical, intent(in) :: new_sim !< If true this is a new simulation, otherwise + !! has been started from a restart file. + logical, optional, intent(in) :: solo_ice_sheet_in !< If present, this indicates whether + !! a solo ice-sheet driver. + + !This include declares and sets the variable "version". +#include "version_variable.h" + character(len=200) :: config + character(len=200) :: IC_file,filename,inputdir + character(len=40) :: var_name + character(len=40) :: mdl = "MOM_ice_shelf_dyn" ! This module's name. + logical :: shelf_mass_is_dynamic, override_shelf_movement, active_shelf_dynamics + logical :: debug + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, Isdq, Iedq, Jsdq, Jedq, iters + + if (.not.associated(CS)) then + call MOM_error(FATAL, "MOM_ice_shelf_dyn.F90, initialize_ice_shelf_dyn: "// & + "called with an associated control structure.") + return + endif + if (CS%module_is_initialized) then + call MOM_error(WARNING, "MOM_ice_shelf_dyn.F90, initialize_ice_shelf_dyn was "//& + "called with a control structure that has already been initialized.") + endif + CS%module_is_initialized = .true. + + CS%diag => diag ! ; CS%Time => Time + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "DEBUG", debug, default=.false.) + call get_param(param_file, mdl, "DEBUG_IS", CS%debug, & + "If true, write verbose debugging messages for the ice shelf.", & + default=debug) + call get_param(param_file, mdl, "DYNAMIC_SHELF_MASS", shelf_mass_is_dynamic, & + "If true, the ice sheet mass can evolve with time.", & + default=.false.) + override_shelf_movement = .false. ; active_shelf_dynamics = .false. + if (shelf_mass_is_dynamic) then + call get_param(param_file, mdl, "OVERRIDE_SHELF_MOVEMENT", override_shelf_movement, & + "If true, user provided code specifies the ice-shelf \n"//& + "movement instead of the dynamic ice model.", default=.false., do_not_log=.true.) + active_shelf_dynamics = .not.override_shelf_movement + + call get_param(param_file, mdl, "GROUNDING_LINE_INTERPOLATE", CS%GL_regularize, & + "If true, regularize the floatation condition at the \n"//& + "grounding line as in Goldberg Holland Schoof 2009.", default=.false.) + call get_param(param_file, mdl, "GROUNDING_LINE_INTERP_SUBGRID_N", CS%n_sub_regularize, & + "The number of sub-partitions of each cell over which to \n"//& + "integrate for the interpolated grounding line. Each cell \n"//& + "is divided into NxN equally-sized rectangles, over which the \n"//& + "basal contribution is integrated by iterative quadrature.", & + default=0) + call get_param(param_file, mdl, "GROUNDING_LINE_COUPLE", CS%GL_couple, & + "If true, let the floatation condition be determined by \n"//& + "ocean column thickness. This means that update_OD_ffrac \n"//& + "will be called. GL_REGULARIZE and GL_COUPLE are exclusive.", & + default=.false., do_not_log=CS%GL_regularize) + if (CS%GL_regularize) CS%GL_couple = .false. + if (CS%GL_regularize .and. (CS%n_sub_regularize == 0)) call MOM_error (FATAL, & + "GROUNDING_LINE_INTERP_SUBGRID_N must be a positive integer if GL regularization is used") + endif + call get_param(param_file, mdl, "RHO_0", CS%density_ocean_avg, & + "avg ocean density used in floatation cond", & + units="kg m-3", default=1035.) + if (active_shelf_dynamics) then + + call get_param(param_file, mdl, "A_GLEN_ISOTHERM", CS%A_glen_isothermal, & + "Ice viscosity parameter in Glen's Law", & + units="Pa -1/3 a", default=9.461e-18) + call get_param(param_file, mdl, "GLEN_EXPONENT", CS%n_glen, & + "nonlinearity exponent in Glen's Law", & + units="none", default=3.) + call get_param(param_file, mdl, "MIN_STRAIN_RATE_GLEN", CS%eps_glen_min, & + "min. strain rate to avoid infinite Glen's law viscosity", & + units="a-1", default=1.e-12) + call get_param(param_file, mdl, "BASAL_FRICTION_COEFF", CS%C_basal_friction, & + "ceofficient in sliding law \tau_b = C u^(n_basal_friction)", & + units="Pa (m-a)-(n_basal_friction)", fail_if_missing=.true.) + call get_param(param_file, mdl, "BASAL_FRICTION_EXP", CS%n_basal_friction, & + "exponent in sliding law \tau_b = C u^(m_slide)", & + units="none", fail_if_missing=.true.) + call get_param(param_file, mdl, "DENSITY_ICE", CS%density_ice, & + "A typical density of ice.", units="kg m-3", default=917.0) + call get_param(param_file, mdl, "CONJUGATE_GRADIENT_TOLERANCE", CS%cg_tolerance, & + "tolerance in CG solver, relative to initial residual", default=1.e-6) + call get_param(param_file, mdl, "ICE_NONLINEAR_TOLERANCE", CS%nonlinear_tolerance, & + "nonlin tolerance in iterative velocity solve",default=1.e-6) + call get_param(param_file, mdl, "CONJUGATE_GRADIENT_MAXIT", CS%cg_max_iterations, & + "max iteratiions in CG solver", default=2000) + call get_param(param_file, mdl, "THRESH_FLOAT_COL_DEPTH", CS%thresh_float_col_depth, & + "min ocean thickness to consider ice *floating*; \n"// & + "will only be important with use of tides", & + units="m", default=1.e-3) + call get_param(param_file, mdl, "NONLIN_SOLVE_ERR_MODE", CS%nonlin_solve_err_mode, & + "Choose whether nonlin error in vel solve is based on nonlinear \n"// & + "residual (1) or relative change since last iteration (2)", default=1) + call get_param(param_file, mdl, "SHELF_DYN_REPRODUCING_SUMS", CS%use_reproducing_sums, & + "If true, use the reproducing extended-fixed-point sums in \n"//& + "the ice shelf dynamics solvers.", default=.true.) + + call get_param(param_file, mdl, "SHELF_MOVING_FRONT", CS%moving_shelf_front, & + "Specify whether to advance shelf front (and calve).", & + default=.true.) + call get_param(param_file, mdl, "CALVE_TO_MASK", CS%calve_to_mask, & + "If true, do not allow an ice shelf where prohibited by a mask.", & + default=.false.) + endif + call get_param(param_file, mdl, "MIN_THICKNESS_SIMPLE_CALVE", & + CS%min_thickness_simple_calve, & + "Min thickness rule for the VERY simple calving law",& + units="m", default=0.0) + + ! Allocate memory in the ice shelf dynamics control structure that was not + ! previously allocated for registration for restarts. + ! OVS vertically integrated Temperature + allocate( CS%t_bdry_val(isd:ied,jsd:jed) ) ; CS%t_bdry_val(:,:) = -15.0 + allocate( CS%tmask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%tmask(:,:) = -1.0 + + if (active_shelf_dynamics) then + ! DNG + allocate( CS%u_bdry_val(Isdq:Iedq,Jsdq:Jedq) ) ; CS%u_bdry_val(:,:) = 0.0 + allocate( CS%v_bdry_val(Isdq:Iedq,Jsdq:Jedq) ) ; CS%v_bdry_val(:,:) = 0.0 + allocate( CS%h_bdry_val(isd:ied,jsd:jed) ) ; CS%h_bdry_val(:,:) = 0.0 + allocate( CS%thickness_bdry_val(isd:ied,jsd:jed) ) ; CS%thickness_bdry_val(:,:) = 0.0 + allocate( CS%u_face_mask(Isdq:Iedq,jsd:jed) ) ; CS%u_face_mask(:,:) = 0.0 + allocate( CS%v_face_mask(isd:ied,Jsdq:Jedq) ) ; CS%v_face_mask(:,:) = 0.0 + allocate( CS%u_face_mask_bdry(Isdq:Iedq,jsd:jed) ) ; CS%u_face_mask_bdry(:,:) = -2.0 + allocate( CS%v_face_mask_bdry(isd:ied,Jsdq:Jedq) ) ; CS%v_face_mask_bdry(:,:) = -2.0 + allocate( CS%u_flux_bdry_val(Isdq:Iedq,jsd:jed) ) ; CS%u_flux_bdry_val(:,:) = 0.0 + allocate( CS%v_flux_bdry_val(isd:ied,Jsdq:Jedq) ) ; CS%v_flux_bdry_val(:,:) = 0.0 + allocate( CS%umask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%umask(:,:) = -1.0 + allocate( CS%vmask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%vmask(:,:) = -1.0 + + allocate( CS%OD_rt(isd:ied,jsd:jed) ) ; CS%OD_rt(:,:) = 0.0 + allocate( CS%float_frac_rt(isd:ied,jsd:jed) ) ; CS%float_frac_rt(:,:) = 0.0 + + if (CS%calve_to_mask) then + allocate( CS%calve_mask(isd:ied,jsd:jed) ) ; CS%calve_mask(:,:) = 0.0 + endif + + endif + + if (active_shelf_dynamics) then + call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) + endif + + ! Take additional initialization steps, for example of dependent variables. + if (active_shelf_dynamics .and. .not.new_sim) then + ! this is unfortunately necessary; if grid is not symmetric the boundary values + ! of u and v are otherwise not set till the end of the first linear solve, and so + ! viscosity is not calculated correctly. + ! This has to occur after init_boundary_values or some of the arrays on the + ! right hand side have not been set up yet. + if (.not. G%symmetric) then + do j=G%jsd,G%jed ; do i=G%isd,G%ied + if (((i+G%idg_offset) == (G%domain%nihalo+1)).and.(CS%u_face_mask(i-1,j) == 3)) then + CS%u_shelf(i-1,j-1) = CS%u_bdry_val(i-1,j-1) + CS%u_shelf(i-1,j) = CS%u_bdry_val(i-1,j) + endif + if (((j+G%jdg_offset) == (G%domain%njhalo+1)).and.(CS%v_face_mask(i,j-1) == 3)) then + CS%u_shelf(i-1,j-1) = CS%u_bdry_val(i-1,j-1) + CS%u_shelf(i,j-1) = CS%u_bdry_val(i,j-1) + endif + enddo ; enddo + endif + + call pass_var(CS%OD_av,G%domain) + call pass_var(CS%float_frac,G%domain) + call pass_var(CS%ice_visc,G%domain) + call pass_var(CS%taub_beta_eff,G%domain) + call pass_vector(CS%u_shelf, CS%v_shelf, G%domain, TO_ALL, BGRID_NE) + endif + + if (active_shelf_dynamics) then + ! If we are calving to a mask, i.e. if a mask exists where a shelf cannot, read the mask from a file. + if (CS%calve_to_mask) then + call MOM_mesg(" MOM_ice_shelf.F90, initialize_ice_shelf: reading calving_mask") + + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") + inputdir = slasher(inputdir) + call get_param(param_file, mdl, "CALVING_MASK_FILE", IC_file, & + "The file with a mask for where calving might occur.", & + default="ice_shelf_h.nc") + call get_param(param_file, mdl, "CALVING_MASK_VARNAME", var_name, & + "The variable to use in masking calving.", & + default="area_shelf_h") + + filename = trim(inputdir)//trim(IC_file) + call log_param(param_file, mdl, "INPUTDIR/CALVING_MASK_FILE", filename) + if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & + " calving mask file: Unable to open "//trim(filename)) + + call MOM_read_data(filename,trim(var_name),CS%calve_mask,G%Domain) + do j=G%jsc,G%jec ; do i=G%isc,G%iec + if (CS%calve_mask(i,j) > 0.0) CS%calve_mask(i,j) = 1.0 + enddo ; enddo + call pass_var(CS%calve_mask,G%domain) + endif + +! call init_boundary_values(CS, G, time, ISS%hmask, CS%input_flux, CS%input_thickness, new_sim) + + if (new_sim) then + call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") + call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf) + call ice_shelf_solve_outer(CS, ISS, G, CS%u_shelf, CS%v_shelf, iters, Time) + + if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf,CS%u_shelf,CS%diag) + if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf,CS%v_shelf,CS%diag) + endif + + endif + + ! Register diagnostics. + if (active_shelf_dynamics) then + CS%id_u_shelf = register_diag_field('ocean_model','u_shelf',CS%diag%axesCu1, Time, & 'x-velocity of ice', 'm yr-1') - CS%id_v_shelf = register_diag_field('ocean_model','v_shelf',CS%diag%axesCv1,CS%Time, & + CS%id_v_shelf = register_diag_field('ocean_model','v_shelf',CS%diag%axesCv1, Time, & 'y-velocity of ice', 'm yr-1') - CS%id_u_mask = register_diag_field('ocean_model','u_mask',CS%diag%axesCu1,CS%Time, & + CS%id_u_mask = register_diag_field('ocean_model','u_mask',CS%diag%axesCu1, Time, & 'mask for u-nodes', 'none') - CS%id_v_mask = register_diag_field('ocean_model','v_mask',CS%diag%axesCv1,CS%Time, & + CS%id_v_mask = register_diag_field('ocean_model','v_mask',CS%diag%axesCv1, Time, & 'mask for v-nodes', 'none') - CS%id_h_mask = register_diag_field('ocean_model','h_mask',CS%diag%axesT1,CS%Time, & - 'ice shelf thickness', 'none') - CS%id_surf_elev = register_diag_field('ocean_model','ice_surf',CS%diag%axesT1,CS%Time, & - 'ice surf elev', 'm') - CS%id_float_frac = register_diag_field('ocean_model','ice_float_frac',CS%diag%axesT1,CS%Time, & +! CS%id_surf_elev = register_diag_field('ocean_model','ice_surf',CS%diag%axesT1, Time, & +! 'ice surf elev', 'm') + CS%id_float_frac = register_diag_field('ocean_model','ice_float_frac',CS%diag%axesT1, Time, & 'fraction of cell that is floating (sort of)', 'none') - CS%id_col_thick = register_diag_field('ocean_model','col_thick',CS%diag%axesT1,CS%Time, & + CS%id_col_thick = register_diag_field('ocean_model','col_thick',CS%diag%axesT1, Time, & 'ocean column thickness passed to ice model', 'm') - CS%id_OD_av = register_diag_field('ocean_model','OD_av',CS%diag%axesT1,CS%Time, & + CS%id_OD_av = register_diag_field('ocean_model','OD_av',CS%diag%axesT1, Time, & 'intermediate ocean column thickness passed to ice model', 'm') - CS%id_float_frac_rt = register_diag_field('ocean_model','float_frac_rt',CS%diag%axesT1,CS%Time, & + CS%id_float_frac_rt = register_diag_field('ocean_model','float_frac_rt',CS%diag%axesT1, Time, & 'timesteps where cell is floating ', 'none') - !CS%id_h_after_uflux = register_diag_field('ocean_model','h_after_uflux',CS%diag%axesh1,CS%Time, & + !CS%id_h_after_uflux = register_diag_field('ocean_model','h_after_uflux',CS%diag%axesh1, Time, & ! 'thickness after u flux ', 'none') - !CS%id_h_after_vflux = register_diag_field('ocean_model','h_after_vflux',CS%diag%axesh1,CS%Time, & + !CS%id_h_after_vflux = register_diag_field('ocean_model','h_after_vflux',CS%diag%axesh1, Time, & ! 'thickness after v flux ', 'none') - !CS%id_h_after_adv = register_diag_field('ocean_model','h_after_adv',CS%diag%axesh1,CS%Time, & + !CS%id_h_after_adv = register_diag_field('ocean_model','h_after_adv',CS%diag%axesh1, Time, & ! 'thickness after front adv ', 'none') !!! OVS vertically integrated temperature - CS%id_t_shelf = register_diag_field('ocean_model','t_shelf',CS%diag%axesT1,CS%Time, & + CS%id_t_shelf = register_diag_field('ocean_model','t_shelf',CS%diag%axesT1, Time, & 'T of ice', 'oC') - CS%id_t_mask = register_diag_field('ocean_model','tmask',CS%diag%axesT1,CS%Time, & + CS%id_t_mask = register_diag_field('ocean_model','tmask',CS%diag%axesT1, Time, & 'mask for T-nodes', 'none') endif - id_clock_shelf = cpu_clock_id('Ice shelf', grain=CLOCK_COMPONENT) - id_clock_pass = cpu_clock_id(' Ice shelf halo updates', grain=CLOCK_ROUTINE) - -end subroutine initialize_ice_shelf +end subroutine initialize_ice_shelf_dyn !> Initializes shelf mass based on three options (file, zero and user) subroutine initialize_shelf_mass(G, param_file, CS, ISS, new_sim) @@ -4949,16 +5059,16 @@ subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf,ISS%h_shelf,CS%diag) if (CS%id_h_mask > 0) call post_data(CS%id_h_mask,ISS%hmask,CS%diag) - if (CS%id_col_thick > 0) call post_data(CS%id_col_thick, dCS%OD_av, CS%diag) - if (CS%id_u_mask > 0) call post_data(CS%id_u_mask,dCS%umask,CS%diag) - if (CS%id_v_mask > 0) call post_data(CS%id_v_mask,dCS%vmask,CS%diag) - if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf,dCS%u_shelf,CS%diag) - if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf,dCS%v_shelf,CS%diag) - if (CS%id_float_frac > 0) call post_data(CS%id_float_frac,dCS%float_frac,CS%diag) - if (CS%id_OD_av >0) call post_data(CS%id_OD_av,dCS%OD_av,CS%diag) - if (CS%id_float_frac_rt>0) call post_data(CS%id_float_frac_rt,dCS%float_frac_rt,CS%diag) - if (CS%id_t_mask > 0) call post_data(CS%id_t_mask,dCS%tmask,CS%diag) - if (CS%id_t_shelf > 0) call post_data(CS%id_t_shelf,dCS%t_shelf,CS%diag) + if (dCS%id_col_thick > 0) call post_data(dCS%id_col_thick, dCS%OD_av, CS%diag) + if (dCS%id_u_mask > 0) call post_data(dCS%id_u_mask,dCS%umask,CS%diag) + if (dCS%id_v_mask > 0) call post_data(dCS%id_v_mask,dCS%vmask,CS%diag) + if (dCS%id_u_shelf > 0) call post_data(dCS%id_u_shelf,dCS%u_shelf,CS%diag) + if (dCS%id_v_shelf > 0) call post_data(dCS%id_v_shelf,dCS%v_shelf,CS%diag) + if (dCS%id_float_frac > 0) call post_data(dCS%id_float_frac,dCS%float_frac,CS%diag) + if (dCS%id_OD_av >0) call post_data(dCS%id_OD_av,dCS%OD_av,CS%diag) + if (dCS%id_float_frac_rt>0) call post_data(dCS%id_float_frac_rt,dCS%float_frac_rt,CS%diag) + if (dCS%id_t_mask > 0) call post_data(dCS%id_t_mask,dCS%tmask,CS%diag) + if (dCS%id_t_shelf > 0) call post_data(dCS%id_t_shelf,dCS%t_shelf,CS%diag) call disable_averaging(CS%diag) From 2c9bf18a8ef95306f9d9571809ec708b3e05182a Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 25 May 2018 12:36:16 -0400 Subject: [PATCH 0292/1072] Revert "Merge pull request #776 from ESMG/dev/esmg" This reverts commit bcb3f12dc0952f1ba93a06ad18033f62e7c2eb4b, reversing changes made to 496ab52a09bce6954e41a81f9de99f9fcfbeb79b. - Unfortunately, PR #776 included a merge from dev/ncar as a result of PR #777 and both these PRs were made on branches that were updated subsequent to the instigation of tests. The tests passed but the branches had updates that were not tested. In both cases, the untested updates would not have passed so I am revoked the entirety of #776 in order to recover a working code. --- src/core/MOM.F90 | 3 - src/core/MOM_open_boundary.F90 | 12 +- src/core/MOM_variables.F90 | 3 - .../vertical/MOM_CVMix_conv.F90 | 1 - .../vertical/MOM_CVMix_ddiff.F90 | 301 ----------- .../vertical/MOM_CVMix_shear.F90 | 61 +-- src/parameterizations/vertical/MOM_KPP.F90 | 2 +- .../vertical/MOM_bkgnd_mixing.F90 | 2 +- .../vertical/MOM_diabatic_aux.F90 | 249 +++++---- .../vertical/MOM_diabatic_driver.F90 | 43 +- .../vertical/MOM_set_diffusivity.F90 | 486 ++++++++++++------ .../vertical/MOM_set_viscosity.F90 | 112 ++-- .../vertical/MOM_vert_friction.F90 | 82 +-- 13 files changed, 570 insertions(+), 787 deletions(-) delete mode 100644 src/parameterizations/vertical/MOM_CVMix_ddiff.F90 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index e96a3807a7..9b70b81415 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2378,9 +2378,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (associated(CS%visc%Kv_shear)) & call pass_var(CS%visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) - if (associated(CS%visc%Kv_slow)) & - call pass_var(CS%visc%Kv_slow, G%Domain, To_All+Omit_Corners, halo=1) - call cpu_clock_end(id_clock_pass_init) call register_obsolete_diagnostics(param_file, CS%diag) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 38eb78b89a..ef40f0170c 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1814,10 +1814,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) J=segment%HI%JsdB allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) do k=1,nz - rx_tangential(segment%HI%IsdB,J,k) = segment%ry_normal(segment%HI%isd,J,k) - rx_tangential(segment%HI%IedB,J,k) = segment%ry_normal(segment%HI%ied,J,k) + rx_tangential(segment%HI%IsdB,J,k) = segment%rx_normal(segment%HI%isd,J,k) + rx_tangential(segment%HI%IedB,J,k) = segment%rx_normal(segment%HI%ied,J,k) do I=segment%HI%IsdB+1,segment%HI%IedB-1 - rx_tangential(I,J,k) = 0.5*(segment%ry_normal(i,J,k) + segment%ry_normal(i+1,J,k)) + rx_tangential(I,J,k) = 0.5*(segment%rx_normal(i,J,k) + segment%rx_normal(i+1,J,k)) enddo enddo if (segment%radiation_tan) then @@ -1925,10 +1925,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) J=segment%HI%JsdB allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) do k=1,nz - rx_tangential(segment%HI%IsdB,J,k) = segment%ry_normal(segment%HI%isd,J,k) - rx_tangential(segment%HI%IedB,J,k) = segment%ry_normal(segment%HI%ied,J,k) + rx_tangential(segment%HI%IsdB,J,k) = segment%rx_normal(segment%HI%isd,J,k) + rx_tangential(segment%HI%IedB,J,k) = segment%rx_normal(segment%HI%ied,J,k) do I=segment%HI%IsdB+1,segment%HI%IedB-1 - rx_tangential(I,J,k) = 0.5*(segment%ry_normal(i,J,k) + segment%ry_normal(i+1,J,k)) + rx_tangential(I,J,k) = 0.5*(segment%rx_normal(i,J,k) + segment%rx_normal(i+1,J,k)) enddo enddo if (segment%radiation_tan) then diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 02b0b622a3..09305eb9fb 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -233,9 +233,6 @@ module MOM_variables !! convection etc). TKE_turb => NULL() !< The turbulent kinetic energy per unit mass defined !! at the interfaces between each layer, in m2 s-2. - logical :: add_Kv_slow !< If True, adds Kv_slow when calculating the - !! 'coupling coefficient' (a[k]) at the interfaces. - !! This is done in find_coupling_coef. end type vertvisc_type !> The BT_cont_type structure contains information about the summed layer diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 57b86c80ca..2be8beee4a 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -212,7 +212,6 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, CS, hbl) iFaceHeight(k+1) = iFaceHeight(k) - dh enddo - ! gets index of the level and interface above hbl kOBL = CVMix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl(i,j)) call CVMix_coeffs_conv(Mdiff_out=CS%kv_conv(i,j,:), & diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 deleted file mode 100644 index 7137aabfa6..0000000000 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ /dev/null @@ -1,301 +0,0 @@ -!> Interface to CVMix double diffusion scheme. -module MOM_CVMix_ddiff - -! This file is part of MOM6. See LICENSE.md for the license. - -use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field -use MOM_diag_mediator, only : post_data -use MOM_EOS, only : calculate_density_derivs -use MOM_variables, only : thermo_var_ptrs -use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE -use MOM_file_parser, only : openParameterBlock, closeParameterBlock -use MOM_debugging, only : hchksum -use MOM_grid, only : ocean_grid_type -use MOM_verticalGrid, only : verticalGrid_type -use MOM_file_parser, only : get_param, log_version, param_file_type -use cvmix_ddiff, only : cvmix_init_ddiff, CVMix_coeffs_ddiff -use cvmix_kpp, only : CVmix_kpp_compute_kOBL_depth -implicit none ; private - -#include - -public CVMix_ddiff_init, CVMix_ddiff_end, CVMix_ddiff_is_used, compute_ddiff_coeffs - -!> Control structure including parameters for CVMix double diffusion. -type, public :: CVMix_ddiff_cs - - ! Parameters - real :: strat_param_max !< maximum value for the stratification parameter (nondim) - real :: kappa_ddiff_s !< leading coefficient in formula for salt-fingering regime - !! for salinity diffusion (m^2/s) - real :: ddiff_exp1 !< interior exponent in salt-fingering regime formula (nondim) - real :: ddiff_exp2 !< exterior exponent in salt-fingering regime formula (nondim) - real :: mol_diff !< molecular diffusivity (m^2/s) - real :: kappa_ddiff_param1 !< exterior coefficient in diffusive convection regime (nondim) - real :: kappa_ddiff_param2 !< middle coefficient in diffusive convection regime (nondim) - real :: kappa_ddiff_param3 !< interior coefficient in diffusive convection regime (nondim) - real :: min_thickness !< Minimum thickness allowed (m) - character(len=4) :: diff_conv_type !< type of diffusive convection to use. Options are Marmorino & - !! Caldwell 1976 ("MC76"; default) and Kelley 1988, 1990 ("K90") - logical :: debug !< If true, turn on debugging - - ! Daignostic handles and pointers - type(diag_ctrl), pointer :: diag => NULL() - integer :: id_KT_extra = -1, id_KS_extra = -1, id_R_rho = -1 - - ! Diagnostics arrays - real, allocatable, dimension(:,:,:) :: KT_extra !< double diffusion diffusivity for temp (m2/s) - real, allocatable, dimension(:,:,:) :: KS_extra !< double diffusion diffusivity for salt (m2/s) - real, allocatable, dimension(:,:,:) :: R_rho !< double-diffusion density ratio (nondim) - -end type CVMix_ddiff_cs - -character(len=40) :: mdl = "MOM_CVMix_ddiff" !< This module's name. - -contains - -!> Initialized the CVMix double diffusion module. -logical function CVMix_ddiff_init(Time, G, GV, param_file, diag, CS) - - type(time_type), intent(in) :: Time !< The current time. - type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle - type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. - type(CVMix_ddiff_cs), pointer :: CS !< This module's control structure. - -! This include declares and sets the variable "version". -#include "version_variable.h" - - if (associated(CS)) then - call MOM_error(WARNING, "CVMix_ddiff_init called with an associated "// & - "control structure.") - return - endif - allocate(CS) - - ! Read parameters - call log_version(param_file, mdl, version, & - "Parameterization of mixing due to double diffusion processes via CVMix") - call get_param(param_file, mdl, "USE_CVMIX_DDIFF", CVMix_ddiff_init, & - "If true, turns on double diffusive processes via CVMix. \n"// & - "Note that double diffusive processes on viscosity are ignored \n"// & - "in CVMix, see http://cvmix.github.io/ for justification.",& - default=.false.) - - if (.not. CVMix_ddiff_init) return - - call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) - - call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, default=0.001, do_not_log=.True.) - - call openParameterBlock(param_file,'CVMIX_DDIFF') - - call get_param(param_file, mdl, "STRAT_PARAM_MAX", CS%strat_param_max, & - "The maximum value for the double dissusion stratification parameter", & - units="nondim", default=2.55) - - call get_param(param_file, mdl, "KAPPA_DDIFF_S", CS%kappa_ddiff_s, & - "Leading coefficient in formula for salt-fingering regime \n"// & - "for salinity diffusion.", units="m2 s-1", default=1.0e-4) - - call get_param(param_file, mdl, "DDIFF_EXP1", CS%ddiff_exp1, & - "Interior exponent in salt-fingering regime formula.", & - units="nondim", default=1.0) - - call get_param(param_file, mdl, "DDIFF_EXP2", CS%ddiff_exp2, & - "Exterior exponent in salt-fingering regime formula.", & - units="nondim", default=3.0) - - call get_param(param_file, mdl, "KAPPA_DDIFF_PARAM1", CS%kappa_ddiff_param1, & - "Exterior coefficient in diffusive convection regime.", & - units="nondim", default=0.909) - - call get_param(param_file, mdl, "KAPPA_DDIFF_PARAM2", CS%kappa_ddiff_param2, & - "Middle coefficient in diffusive convection regime.", & - units="nondim", default=4.6) - - call get_param(param_file, mdl, "KAPPA_DDIFF_PARAM3", CS%kappa_ddiff_param3, & - "Interior coefficient in diffusive convection regime.", & - units="nondim", default=-0.54) - - call get_param(param_file, mdl, "MOL_DIFF", CS%mol_diff, & - "Molecular diffusivity used in CVMix double diffusion.", & - units="m2 s-1", default=1.5e-6) - - call get_param(param_file, mdl, "DIFF_CONV_TYPE", CS%diff_conv_type, & - "type of diffusive convection to use. Options are Marmorino \n" //& - "and Caldwell 1976 (MC76) and Kelley 1988, 1990 (K90).", & - default="MC76") - - call closeParameterBlock(param_file) - - ! Register diagnostics - CS%diag => diag - - CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for temperature', 'm2 s-1') - - CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for salinity', 'm2 s-1') - - CS%id_R_rho = register_diag_field('ocean_model','R_rho',diag%axesTi,Time, & - 'Double-diffusion density ratio', 'nondim') - if (CS%id_R_rho > 0) & - allocate(CS%R_rho( SZI_(G), SZJ_(G), SZK_(G)+1)); CS%R_rho(:,:,:) = 0.0 - - call cvmix_init_ddiff(strat_param_max=CS%strat_param_max, & - kappa_ddiff_s=CS%kappa_ddiff_s, & - ddiff_exp1=CS%ddiff_exp1, & - ddiff_exp2=CS%ddiff_exp2, & - mol_diff=CS%mol_diff, & - kappa_ddiff_param1=CS%kappa_ddiff_param1, & - kappa_ddiff_param2=CS%kappa_ddiff_param2, & - kappa_ddiff_param3=CS%kappa_ddiff_param3, & - diff_conv_type=CS%diff_conv_type) - -end function CVMix_ddiff_init - -!> Subroutine for computing vertical diffusion coefficients for the -!! double diffusion mixing parameterization. -subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) - - type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_T !< Interface double diffusion diapycnal - !! diffusivity for temp (m2/sec). - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_S !< Interface double diffusion diapycnal - !! diffusivity for salt (m2/sec). - type(CVMix_ddiff_cs), pointer :: CS !< The control structure returned - !! by a previous call to CVMix_ddiff_init. - integer, intent(in) :: j !< Meridional grid indice. -! real, dimension(:,:), optional, pointer :: hbl !< Depth of ocean boundary layer (m) - - ! local variables - real, dimension(SZK_(G)) :: & - cellHeight, & !< Height of cell centers (m) - dRho_dT, & !< partial derivatives of density wrt temp (kg m-3 degC-1) - dRho_dS, & !< partial derivatives of density wrt saln (kg m-3 PPT-1) - pres_int, & !< pressure at each interface (Pa) - temp_int, & !< temp and at interfaces (degC) - salt_int, & !< salt at at interfaces - alpha_dT, & !< alpha*dT across interfaces - beta_dS, & !< beta*dS across interfaces - dT, & !< temp. difference between adjacent layers (degC) - dS !< salt difference between adjacent layers - - real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) - integer :: kOBL !< level of OBL extent - real :: pref, g_o_rho0, rhok, rhokm1, dz, dh, hcorr - integer :: i, k - - ! initialize dummy variables - pres_int(:) = 0.0; temp_int(:) = 0.0; salt_int(:) = 0.0 - alpha_dT(:) = 0.0; beta_dS(:) = 0.0; dRho_dT(:) = 0.0 - dRho_dS(:) = 0.0; dT(:) = 0.0; dS(:) = 0.0 - - ! set Kd_T and Kd_S to zero to avoid passing values from previous call - Kd_T(:,j,:) = 0.0; Kd_S(:,j,:) = 0.0 - - ! GMM, I am leaving some code commented below. We need to pass BLD to - ! this soubroutine to avoid adding diffusivity above that. This needs - ! to be done once we re-structure the order of the calls. - !if (.not. associated(hbl)) then - ! allocate(hbl(SZI_(G), SZJ_(G))); - ! hbl(:,:) = 0.0 - !endif - - do i = G%isc, G%iec - - ! skip calling at land points - if (G%mask2dT(i,j) == 0.) cycle - - pRef = 0. - pres_int(1) = pRef - ! we don't have SST and SSS, so let's use values at top-most layer - temp_int(1) = TV%T(i,j,1); salt_int(1) = TV%S(i,j,1) - do k=2,G%ke - ! pressure at interface - pres_int(k) = pRef + GV%H_to_Pa * h(i,j,k-1) - ! temp and salt at interface - ! for temp: (t1*h1 + t2*h2)/(h1+h2) - temp_int(k) = (TV%T(i,j,k-1)*h(i,j,k-1) + TV%T(i,j,k)*h(i,j,k))/(h(i,j,k-1)+h(i,j,k)) - salt_int(k) = (TV%S(i,j,k-1)*h(i,j,k-1) + TV%S(i,j,k)*h(i,j,k))/(h(i,j,k-1)+h(i,j,k)) - ! dT and dS - dT(k) = (TV%T(i,j,k-1)-TV%T(i,j,k)) - dS(k) = (TV%S(i,j,k-1)-TV%S(i,j,k)) - pRef = pRef + GV%H_to_Pa * h(i,j,k-1) - enddo ! k-loop finishes - - call calculate_density_derivs(temp_int(:), salt_int(:), pres_int(:), drho_dT(:), drho_dS(:), 1, G%ke, TV%EQN_OF_STATE) - - ! The "-1.0" below is needed so that the following criteria is satisfied: - ! if ((alpha_dT > beta_dS) .and. (beta_dS > 0.0)) then "salt finger" - ! if ((alpha_dT < 0.) .and. (beta_dS < 0.) .and. (alpha_dT > beta_dS)) then "diffusive convection" - do k=1,G%ke - alpha_dT(k) = -1.0*drho_dT(k) * dT(k) - beta_dS(k) = drho_dS(k) * dS(k) - enddo - - if (CS%id_R_rho > 0.0) then - do k=1,G%ke - CS%R_rho(i,j,k) = alpha_dT(k)/beta_dS(k) - ! avoid NaN's - if(CS%R_rho(i,j,k) /= CS%R_rho(i,j,k)) CS%R_rho(i,j,k) = 0.0 - enddo - endif - - iFaceHeight(1) = 0.0 ! BBL is all relative to the surface - hcorr = 0.0 - ! compute heights at cell center and interfaces - do k=1,G%ke - dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment - dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) - hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 - dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness - cellHeight(k) = iFaceHeight(k) - 0.5 * dh - iFaceHeight(k+1) = iFaceHeight(k) - dh - enddo - - ! gets index of the level and interface above hbl - !kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl(i,j)) - - call CVMix_coeffs_ddiff(Tdiff_out=Kd_T(i,j,:), & - Sdiff_out=Kd_S(i,j,:), & - strat_param_num=alpha_dT(:), & - strat_param_denom=beta_dS(:), & - nlev=G%ke, & - max_nlev=G%ke) - - ! Do not apply mixing due to convection within the boundary layer - !do k=1,kOBL - ! Kd_T(i,j,k) = 0.0 - ! Kd_S(i,j,k) = 0.0 - !enddo - - enddo ! i-loop - -end subroutine compute_ddiff_coeffs - -!> Reads the parameter "USE_CVMIX_DDIFF" and returns state. -!! This function allows other modules to know whether this parameterization will -!! be used without needing to duplicate the log entry. -logical function CVMix_ddiff_is_used(param_file) - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - call get_param(param_file, mdl, "USE_CVMIX_DDIFF", CVMix_ddiff_is_used, & - default=.false., do_not_log = .true.) - -end function CVMix_ddiff_is_used - -!> Clear pointers and dealocate memory -subroutine CVMix_ddiff_end(CS) - type(CVMix_ddiff_cs), pointer :: CS ! Control structure - - deallocate(CS) - -end subroutine CVMix_ddiff_end - - -end module MOM_CVMix_ddiff diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 53339d3488..2635af7fb5 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -30,14 +30,14 @@ module MOM_CVMix_shear !> Control structure including parameters for CVMix interior shear schemes. type, public :: CVMix_shear_cs logical :: use_LMD94, use_PP81 !< Flags for various schemes - logical :: smooth_ri !< If true, smooth Ri using a 1-2-1 filter real :: Ri_zero !< LMD94 critical Richardson number real :: Nu_zero !< LMD94 maximum interior diffusivity - real :: KPP_exp !< Exponent of unitless factor of diff. - !! for KPP internal shear mixing scheme. + real :: KPP_exp !< real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency (1/s2) real, allocatable, dimension(:,:,:) :: S2 !< Squared shear frequency (1/s2) real, allocatable, dimension(:,:,:) :: ri_grad !< Gradient Richardson number +! real, allocatable, dimension(:,:,:) :: kv !< vertical viscosity at interface (m2/s) +! real, allocatable, dimension(:,:,:) :: kd !< vertical diffusivity at interface (m2/s) character(10) :: Mix_Scheme !< Mixing scheme name (string) ! Daignostic handles and pointers type(diag_ctrl), pointer :: diag => NULL() @@ -52,26 +52,25 @@ module MOM_CVMix_shear !> Subroutine for calculating (internal) vertical diffusivities/viscosities subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & kv, G, GV, CS ) - type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: u_H !< Initial zonal velocity on T points, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: v_H !< Initial meridional velocity on T points, in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface - !! (not layer!) in m2 s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface - !! (not layer!) in m2 s-1. - type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous call to - !! CVMix_shear_init. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface + !! (not layer!) in m2 s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface + !! (not layer!) in m2 s-1. + type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous call to + !! CVMix_shear_init. ! Local variables integer :: i, j, k, kk, km1 - real :: GoRho - real :: pref, DU, DV, DRHO, DZ, N2, S2, dummy + real :: gorho + real :: pref, DU, DV, DRHO, DZ, N2, S2 real, dimension(2*(G%ke)) :: pres_1d, temp_1d, salt_1d, rho_1d real, dimension(G%ke+1) :: Ri_Grad !< Gradient Richardson number - real, parameter :: epsln = 1.e-10 !< Threshold to identify - !! vanished layers + ! some constants GoRho = GV%g_Earth / GV%Rho0 @@ -121,30 +120,10 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & ! fill 3d arrays, if user asks for diagsnostics if (CS%id_N2 > 0) CS%N2(i,j,k) = N2 if (CS%id_S2 > 0) CS%S2(i,j,k) = S2 + if (CS%id_ri_grad > 0) CS%ri_grad(i,j,k) = Ri_Grad(k) enddo - Ri_grad(G%ke+1) = Ri_grad(G%ke) - - if (CS%smooth_ri) then - ! 1) fill Ri_grad in vanished layers with adjacent value - do k = 2, G%ke - if (h(i,j,k) .le. epsln) Ri_grad(k) = Ri_grad(k-1) - enddo - - Ri_grad(G%ke+1) = Ri_grad(G%ke) - - ! 2) vertically smooth Ri with 1-2-1 filter - dummy = 0.25 * Ri_grad(1) - Ri_grad(G%ke+1) = Ri_grad(G%ke) - do k = 1, G%ke - Ri_Grad(k) = dummy + 0.5 * Ri_Grad(k) + 0.25 * Ri_grad(k+1) - dummy = 0.25 * Ri_grad(k) - enddo - endif - - if (CS%id_ri_grad > 0) CS%ri_grad(i,j,:) = Ri_Grad(:) - ! Call to CVMix wrapper for computing interior mixing coefficients. call CVMix_coeffs_shear(Mdiff_out=kv(i,j,:), & Tdiff_out=kd(i,j,:), & @@ -230,11 +209,7 @@ logical function CVMix_shear_init(Time, G, GV, param_file, diag, CS) "Exponent of unitless factor of diffusivities,"// & " for KPP internal shear mixing scheme." & ,units="nondim", default=3.0) - call get_param(param_file, mdl, "SMOOTH_RI", CS%smooth_ri, & - "If true, vertically smooth the Richardson"// & - "number by applying a 1-2-1 filter once.", & - default = .false.) - call cvmix_init_shear(mix_scheme=CS%mix_scheme, & + call CVMix_init_shear(mix_scheme=CS%mix_scheme, & KPP_nu_zero=CS%Nu_Zero, & KPP_Ri_zero=CS%Ri_zero, & KPP_exp=CS%KPP_exp) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 79234c7e11..f98185685a 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -1573,7 +1573,7 @@ subroutine KPP_get_BLD(CS, BLD, G) type(KPP_CS), pointer :: CS !< Control structure for !! this module type(ocean_grid_type), intent(in) :: G !< Grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: BLD!< bnd. layer depth (m) + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: BLD!< bnd. layer depth (m) ! Local variables integer :: i,j do j = G%jsc, G%jec ; do i = G%isc, G%iec diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index bb1e0b11c1..61c212db8b 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -408,7 +408,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, CS) CS%kd_bkgnd(i,j,1) = 0.0; CS%kv_bkgnd(i,j,1) = 0.0 CS%kd_bkgnd(i,j,nz+1) = 0.0; CS%kv_bkgnd(i,j,nz+1) = 0.0 do k=2,nz - CS%kd_bkgnd(i,j,k) = 0.5*(kd_lay(i,j,K-1) + kd_lay(i,j,K)) + CS%kd_bkgnd(i,j,k) = CS%kd_bkgnd(i,j,k) + 0.5*(kd_lay(i,j,K-1) + kd_lay(i,j,K)) CS%kv_bkgnd(i,j,k) = CS%kd_bkgnd(i,j,k) * CS%prandtl_bkgnd enddo enddo diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 528dc33135..6eb3b854f4 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -2,6 +2,53 @@ module MOM_diabatic_aux ! This file is part of MOM6. See LICENSE.md for the license. +!********+*********+*********+*********+*********+*********+*********+** +!* * +!* By Robert Hallberg, April 1994 - July 2000 * +!* Alistair Adcroft, and Stephen Griffies * +!* * +!* This program contains the subroutine that, along with the * +!* subroutines that it calls, implements diapycnal mass and momentum * +!* fluxes and a bulk mixed layer. The diapycnal diffusion can be * +!* used without the bulk mixed layer. * +!* * +!* diabatic first determines the (diffusive) diapycnal mass fluxes * +!* based on the convergence of the buoyancy fluxes within each layer. * +!* The dual-stream entrainment scheme of MacDougall and Dewar (JPO, * +!* 1997) is used for combined diapycnal advection and diffusion, * +!* calculated implicitly and potentially with the Richardson number * +!* dependent mixing, as described by Hallberg (MWR, 2000). Diapycnal * +!* advection is fundamentally the residual of diapycnal diffusion, * +!* so the fully implicit upwind differencing scheme that is used is * +!* entirely appropriate. The downward buoyancy flux in each layer * +!* is determined from an implicit calculation based on the previously * +!* calculated flux of the layer above and an estimated flux in the * +!* layer below. This flux is subject to the following conditions: * +!* (1) the flux in the top and bottom layers are set by the boundary * +!* conditions, and (2) no layer may be driven below an Angstrom thick-* +!* ness. If there is a bulk mixed layer, the buffer layer is treat- * +!* ed as a fixed density layer with vanishingly small diffusivity. * +!* * +!* diabatic takes 5 arguments: the two velocities (u and v), the * +!* thicknesses (h), a structure containing the forcing fields, and * +!* the length of time over which to act (dt). The velocities and * +!* thickness are taken as inputs and modified within the subroutine. * +!* There is no limit on the time step. * +!* * +!* A small fragment of the grid is shown below: * +!* * +!* j+1 x ^ x ^ x At x: q * +!* j+1 > o > o > At ^: v * +!* j x ^ x ^ x At >: u * +!* j > o > o > At o: h, T, S, buoy, ustar, ea, eb, etc. * +!* j-1 x ^ x ^ x * +!* i-1 i i+1 At x & ^: * +!* i i+1 At > & o: * +!* * +!* The boundaries always run through q grid points (x). * +!* * +!********+*********+*********+*********+*********+*********+*********+** + use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr @@ -192,19 +239,26 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf) end subroutine make_frazil -!> Applies double diffusion to T & S, assuming no diapycal mass -!! fluxes, using a simple triadiagonal solver. subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(inout) :: tv !< pointers to any available modynamic fields. - !! Absent fields have NULL ptrs. - type(vertvisc_type), intent(in) :: visc !< structure containing vertical viscosities, - !! layer properies, and related fields. - real, intent(in) :: dt !< Time increment, in s. + type(thermo_var_ptrs), intent(inout) :: tv + type(vertvisc_type), intent(in) :: visc + real, intent(in) :: dt + +! This subroutine applies double diffusion to T & S, assuming no diapycal mass +! fluxes, using a simple triadiagonal solver. + +! Arguments: h - Layer thickness, in m or kg m-2. +! (in) tv - A structure containing pointers to any available +! thermodynamic fields. Absent fields have NULL ptrs. +! (in) visc - A structure containing vertical viscosities, bottom boundary +! layer properies, and related fields. +! (in) dt - Time increment, in s. +! (in) G - The ocean's grid structure. +! (in) GV - The ocean's vertical grid structure. - ! local variables real, dimension(SZI_(G)) :: & b1_T, b1_S, & ! Variables used by the tridiagonal solvers of T & S, in H. d1_T, d1_S ! Variables used by the tridiagonal solvers, nondim. @@ -291,25 +345,30 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) S(i,j,k) = S(i,j,k) + c1_S(i,k+1)*S(i,j,k+1) enddo ; enddo enddo + end subroutine differential_diffuse_T_S -!> Keep salinity from falling below a small but positive threshold -!! This occurs when the ice model attempts to extract more salt then -!! is actually available to it from the ocean. subroutine adjust_salt(h, tv, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m - !! or kg m-2) - type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to any - !! available thermodynamic fields. - type(diabatic_aux_CS), intent(in) :: CS !< control structure returned by - !! a previous call to diabatic_driver_init. - - ! local variables - real :: salt_add_col(SZI_(G),SZJ_(G)) !< The accumulated salt requirement - real :: S_min !< The minimum salinity - real :: mc !< A layer's mass kg m-2 . + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + type(thermo_var_ptrs), intent(inout) :: tv + type(diabatic_aux_CS), intent(in) :: CS + +! Keep salinity from falling below a small but positive threshold +! This occurs when the ice model attempts to extract more salt then +! is actually available to it from the ocean. + +! Arguments: h - Layer thickness, in m. +! (in/out) tv - A structure containing pointers to any available +! thermodynamic fields. Absent fields have NULL ptrs. +! (in) G - The ocean's grid structure. +! (in) GV - The ocean's vertical grid structure. +! (in) CS - The control structure returned by a previous call to +! diabatic_driver_init. + real :: salt_add_col(SZI_(G),SZJ_(G)) ! The accumulated salt requirement + real :: S_min ! The minimum salinity + real :: mc ! A layer's mass kg m-2 . integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -351,29 +410,33 @@ subroutine adjust_salt(h, tv, G, GV, CS) end subroutine adjust_salt -!> Insert salt from brine rejection into the first layer below -!! the mixed layer which both contains mass and in which the -!! change in layer density remains stable after the addition -!! of salt via brine rejection. subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m - !! or kg m-2) - type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to - !! any available hermodynamic fields. - type(forcing), intent(in) :: fluxes !< tructure containing pointers - !! any possible forcing fields - integer, intent(in) :: nkmb !< number of layers in the mixed and - !! buffer layers - type(diabatic_aux_CS), intent(in) :: CS !< control structure returned by a - !! previous call to diabatic_driver_init. - real, intent(in) :: dt !< time step between calls to this - !! function (s) ?? + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + type(thermo_var_ptrs), intent(inout) :: tv + type(forcing), intent(in) :: fluxes + integer, intent(in) :: nkmb + type(diabatic_aux_CS), intent(in) :: CS + real, intent(in) :: dt integer, intent(in) :: id_brine_lay +! Insert salt from brine rejection into the first layer below +! the mixed layer which both contains mass and in which the +! change in layer density remains stable after the addition +! of salt via brine rejection. + +! Arguments: h - Layer thickness, in m. +! (in/out) tv - A structure containing pointers to any available +! thermodynamic fields. Absent fields have NULL ptrs. +! (in) fluxes = A structure containing pointers to any possible +! forcing fields; unused fields have NULL ptrs. +! (in) nkmb - The number of layers in the mixed and buffer layers. +! (in) G - The ocean's grid structure. +! (in) GV - The ocean's vertical grid structure. +! (in) CS - The control structure returned by a previous call to +! diabatic_driver_init. - ! local variables real :: salt(SZI_(G)) ! The amount of salt rejected from ! sea ice. [grams] real :: dzbr(SZI_(G)) ! cumulative depth over which brine is distributed @@ -476,9 +539,10 @@ subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) end subroutine insert_brine -!> Simple tri-diagnonal solver for T and S. -!! "Simple" means it only uses arrays hold, ea and eb. subroutine triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, T, S) +! Simple tri-diagnonal solver for T and S +! "Simple" means it only uses arrays hold, ea and eb + ! Arguments type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure integer, intent(in) :: is, ie, js, je @@ -515,22 +579,37 @@ subroutine triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, T, S) enddo end subroutine triDiagTS -!> Calculates u_h and v_h (velocities at thickness points), -!! optionally using the entrainments (in m) passed in as arguments. + subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1 real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: u_h, v_h !< zonal and meridional velocity at thickness - !! points entrainment, in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in), optional :: ea, eb !< The amount of fluid entrained - !! from the layer above within this time step - !! , in units of m or kg m-2. Omitting ea is the - !! same as setting it to 0. - - ! local variables + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: u_h + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: v_h + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: ea + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: eb +! This subroutine calculates u_h and v_h (velocities at thickness +! points), optionally using the entrainments (in m) passed in as arguments. + +! Arguments: u - Zonal velocity, in m s-1. +! (in) v - Meridional velocity, in m s-1. +! (in) h - Layer thickness, in m or kg m-2. +! (out) u_h - The zonal velocity at thickness points after +! entrainment, in m s-1. +! (out) v_h - The meridional velocity at thickness points after +! entrainment, in m s-1. +! (in) G - The ocean's grid structure. +! (in) GV - The ocean's vertical grid structure. +! (in, opt) ea - The amount of fluid entrained from the layer above within +! this time step, in units of m or kg m-2. Omitting ea is the +! same as setting it to 0. +! (in, opt) eb - The amount of fluid entrained from the layer below within +! this time step, in units of m or kg m-2. Omitting eb is the +! same as setting it to 0. ea and eb must either be both +! present or both absent. + real :: b_denom_1 ! The first term in the denominator of b1 in m or kg m-2. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in m or kg m-2. @@ -1239,20 +1318,26 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & end subroutine applyBoundaryFluxesInOut -!> Initializes this module. subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm, use_ePBL) type(time_type), intent(in) :: Time type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(inout) :: diag !< structure used to regulate diagnostic output - type(diabatic_aux_CS), pointer :: CS !< pointer set to point to the ontrol structure for - !! this module - logical, intent(in) :: useALEalgorithm !< If True, uses ALE. - logical, intent(in) :: use_ePBL !< If true, use the implicit energetics - !! planetary boundary layer scheme to determine the - !! diffusivity in the surface boundary layer. - ! local variables + type(diag_ctrl), target, intent(inout) :: diag + type(diabatic_aux_CS), pointer :: CS + logical, intent(in) :: useALEalgorithm + logical, intent(in) :: use_ePBL + +! Arguments: +! (in) Time = current model time +! (in) G = ocean grid structure +! (in) GV - The ocean's vertical grid structure. +! (in) param_file = structure indicating the open file to parse for parameter values +! (in) diag = structure used to regulate diagnostic output +! (in/out) CS = pointer set to point to the control structure for this module +! (in) use_ePBL = If true, use the implicit energetics planetary boundary +! layer scheme to determine the diffusivity in the +! surface boundary layer. type(vardesc) :: vd ! This "include" declares and sets the variable "version". @@ -1375,48 +1460,4 @@ subroutine diabatic_aux_end(CS) end subroutine diabatic_aux_end -!> \namespace MOM_diabatic_aux -!! -!! This module contains the subroutines that, along with the * -!! subroutines that it calls, implements diapycnal mass and momentum * -!! fluxes and a bulk mixed layer. The diapycnal diffusion can be * -!! used without the bulk mixed layer. * -!! * -!! diabatic first determines the (diffusive) diapycnal mass fluxes * -!! based on the convergence of the buoyancy fluxes within each layer. * -!! The dual-stream entrainment scheme of MacDougall and Dewar (JPO, * -!! 1997) is used for combined diapycnal advection and diffusion, * -!! calculated implicitly and potentially with the Richardson number * -!! dependent mixing, as described by Hallberg (MWR, 2000). Diapycnal * -!! advection is fundamentally the residual of diapycnal diffusion, * -!! so the fully implicit upwind differencing scheme that is used is * -!! entirely appropriate. The downward buoyancy flux in each layer * -!! is determined from an implicit calculation based on the previously * -!! calculated flux of the layer above and an estimated flux in the * -!! layer below. This flux is subject to the following conditions: * -!! (1) the flux in the top and bottom layers are set by the boundary * -!! conditions, and (2) no layer may be driven below an Angstrom thick-* -!! ness. If there is a bulk mixed layer, the buffer layer is treat- * -!! ed as a fixed density layer with vanishingly small diffusivity. * -!! * -!! diabatic takes 5 arguments: the two velocities (u and v), the * -!! thicknesses (h), a structure containing the forcing fields, and * -!! the length of time over which to act (dt). The velocities and * -!! thickness are taken as inputs and modified within the subroutine. * -!! There is no limit on the time step. * -!! * -!! A small fragment of the grid is shown below: * -!! * -!! j+1 x ^ x ^ x At x: q * -!! j+1 > o > o > At ^: v * -!! j x ^ x ^ x At >: u * -!! j > o > o > At o: h, T, S, buoy, ustar, ea, eb, etc. * -!! j-1 x ^ x ^ x * -!! i-1 i i+1 At x & ^: * -!! i i+1 At > & o: * -!! * -!! The boundaries always run through q grid points (x). * -!! * -!!********+*********+*********+*********+*********+*********+*********+** - end module MOM_diabatic_aux diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 698243a7f6..6316fd40e6 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -10,7 +10,6 @@ module MOM_diabatic_driver use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE use MOM_CVMix_shear, only : CVMix_shear_is_used -use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used use MOM_diabatic_aux, only : diabatic_aux_init, diabatic_aux_end, diabatic_aux_CS use MOM_diabatic_aux, only : make_frazil, adjust_salt, insert_brine, differential_diffuse_T_S, triDiagTS use MOM_diabatic_aux, only : find_uv_at_h, diagnoseMLDbyDensityDifference, applyBoundaryFluxesInOut @@ -98,7 +97,6 @@ module MOM_diabatic_driver !! shear-driven diapycnal diffusivity. logical :: use_CVMix_shear !< If true, use the CVMix module to find the !! shear-driven diapycnal diffusivity. - logical :: use_CVMix_ddiff !< If true, use the CVMix double diffusion module. logical :: use_tidal_mixing !< If true, activate tidal mixing diffusivity. logical :: use_CVMix_conv !< If true, use the CVMix module to get enhanced !! mixing due to convection. @@ -251,7 +249,7 @@ module MOM_diabatic_driver integer :: id_clock_entrain, id_clock_mixedlayer, id_clock_set_diffusivity integer :: id_clock_tracers, id_clock_tridiag, id_clock_pass, id_clock_sponge integer :: id_clock_geothermal, id_clock_differential_diff, id_clock_remap -integer :: id_clock_kpp, id_clock_CVMix_ddiff +integer :: id_clock_kpp contains @@ -387,6 +385,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect*h_neglect Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 + if (nz == 1) return showCallTree = callTree_showQuery() if (showCallTree) call callTree_enter("diabatic(), MOM_diabatic_driver.F90") @@ -488,13 +487,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif if (CS%ML_mix_first > 0.0) then - ! This subroutine: - ! (1) Cools the mixed layer. - ! (2) Performs convective adjustment by mixed layer entrainment. - ! (3) Heats the mixed layer and causes it to detrain to - ! Monin-Obukhov depth or minimum mixed layer depth. - ! (4) Uses any remaining TKE to drive mixed layer entrainment. - ! (5) Possibly splits buffer layer into two isopycnal layers (when using isopycnal coordinate) +! This subroutine +! (1) Cools the mixed layer. +! (2) Performs convective adjustment by mixed layer entrainment. +! (3) Heats the mixed layer and causes it to detrain to +! Monin-Obukhov depth or minimum mixed layer depth. +! (4) Uses any remaining TKE to drive mixed layer entrainment. +! (5) Possibly splits buffer layer into two isopycnal layers (when using isopycnal coordinate) call find_uv_at_h(u, v, h, u_h, v_h, G, GV) call cpu_clock_begin(id_clock_mixedlayer) @@ -529,12 +528,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (showCallTree) call callTree_waypoint("done with 1st bulkmixedlayer (diabatic)") if (CS%debugConservation) call MOM_state_stats('1st bulkmixedlayer', u, v, h, tv%T, tv%S, G) endif - endif ! end CS%bulkmixedlayer + endif if (CS%debug) then call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) endif - if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eaml, ebml) @@ -591,7 +589,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & CS%int_tide_input%tideamp, CS%int_tide_input%Nb, dt, G, GV, CS%int_tide_CSp) endif if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") - endif ! end CS%use_int_tides + endif call cpu_clock_begin(id_clock_set_diffusivity) ! Sets: Kd, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S @@ -732,10 +730,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! a diffusivity and happen before KPP. But generally in MOM, we do not match ! KPP boundary layer to interior, so this diffusivity can be computed when convenient. if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T)) then - call cpu_clock_begin(id_clock_CVMix_ddiff) + call cpu_clock_begin(id_clock_differential_diff) call differential_diffuse_T_S(h, tv, visc, dt, G, GV) - call cpu_clock_end(id_clock_CVMix_ddiff) + call cpu_clock_end(id_clock_differential_diff) if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G) @@ -748,6 +746,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & enddo ; enddo ; enddo endif + endif @@ -1382,9 +1381,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! visc%Kv_shear is not in the group pass because it has larger vertical extent. if (associated(visc%Kv_shear)) & call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) - if (associated(visc%Kv_slow)) & - call pass_var(visc%Kv_slow, G%Domain, To_All+Omit_Corners, halo=1) - call cpu_clock_end(id_clock_pass) if (.not. CS%useALEalgorithm) then @@ -1889,7 +1885,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, real :: Kd integer :: num_mode - logical :: use_temperature + logical :: use_temperature, differentialDiffusion type(vardesc) :: vd ! This "include" declares and sets the variable "version". @@ -1940,10 +1936,11 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, "If true, the diffusivity from ePBL is added to all\n"//& "other diffusivities. Otherwise, the larger of kappa-\n"//& "shear and ePBL diffusivities are used.", default=.true.) - CS%use_CVMix_ddiff = CVMix_ddiff_is_used(param_file) + call get_param(param_file, mod, "DOUBLE_DIFFUSION", differentialDiffusion, & + "If true, apply parameterization of double-diffusion.", & + default=.false. ) CS%use_kappa_shear = kappa_shear_is_used(param_file) CS%use_CVMix_shear = CVMix_shear_is_used(param_file) - if (CS%bulkmixedlayer) then call get_param(param_file, mod, "ML_MIX_FIRST", CS%ML_mix_first, & "The fraction of the mixed layer mixing that is applied \n"//& @@ -2402,8 +2399,8 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, id_clock_sponge = cpu_clock_id('(Ocean sponges)', grain=CLOCK_MODULE) id_clock_tridiag = cpu_clock_id('(Ocean diabatic tridiag)', grain=CLOCK_ROUTINE) id_clock_pass = cpu_clock_id('(Ocean diabatic message passing)', grain=CLOCK_ROUTINE) - id_clock_CVMix_ddiff = -1 ; if (CS%use_CVMix_ddiff) & - id_clock_CVMix_ddiff = cpu_clock_id('(Double diffusion)', grain=CLOCK_ROUTINE) + id_clock_differential_diff = -1 ; if (differentialDiffusion) & + id_clock_differential_diff = cpu_clock_id('(Ocean differential diffusion)', grain=CLOCK_ROUTINE) ! initialize the auxiliary diabatic driver module call diabatic_aux_init(Time, G, GV, param_file, diag, CS%diabatic_aux_CSp, & diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 903868795a..9906083597 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -23,8 +23,6 @@ module MOM_set_diffusivity use MOM_kappa_shear, only : calculate_kappa_shear, kappa_shear_init, Kappa_shear_CS use MOM_CVMix_shear, only : calculate_CVMix_shear, CVMix_shear_init, CVMix_shear_cs use MOM_CVMix_shear, only : CVMix_shear_end -use MOM_CVMix_ddiff, only : CVMix_ddiff_init, CVMix_ddiff_end, CVMix_ddiff_cs -use MOM_CVMix_ddiff, only : compute_ddiff_coeffs use MOM_bkgnd_mixing, only : calculate_bkgnd_mixing, bkgnd_mixing_init, bkgnd_mixing_cs use MOM_bkgnd_mixing, only : bkgnd_mixing_end, sfc_bkgnd_mixing use MOM_string_functions, only : uppercase @@ -45,101 +43,104 @@ module MOM_set_diffusivity public set_diffusivity_end type, public :: set_diffusivity_CS ; private - logical :: debug !< If true, write verbose checksums for debugging. - - logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with - !! GV%nk_rho_varies variable density mixed & buffer - !! layers. - real :: FluxRi_max !< The flux Richardson number where the stratification is - !! large enough that N2 > omega2. The full expression for - !! the Flux Richardson number is usually - !! FLUX_RI_MAX*N2/(N2+OMEGA2). The default is 0.2. - logical :: bottomdraglaw !< If true, the bottom stress is calculated with a - !! drag law c_drag*|u|*u. - logical :: BBL_mixing_as_max !< If true, take the maximum of the diffusivity - !! from the BBL mixing and the other diffusivities. - !! Otherwise, diffusivities from the BBL_mixing is - !! added. - logical :: use_LOTW_BBL_diffusivity !< If true, use simpler/less precise, BBL diffusivity. - logical :: LOTW_BBL_use_omega !< If true, use simpler/less precise, BBL diffusivity. - real :: BBL_effic !< efficiency with which the energy extracted - !! by bottom drag drives BBL diffusion (nondim) - real :: cdrag !< quadratic drag coefficient (nondim) - real :: IMax_decay !< inverse of a maximum decay scale for - !! bottom-drag driven turbulence, (1/m) - real :: Kv !< The interior vertical viscosity (m2/s) - real :: Kd !< interior diapycnal diffusivity (m2/s) - real :: Kd_min !< minimum diapycnal diffusivity (m2/s) - real :: Kd_max !< maximum increment for diapycnal diffusivity (m2/s) - !! Set to a negative value to have no limit. - real :: Kd_add !< uniform diffusivity added everywhere without - !! filtering or scaling (m2/s) - real :: Kdml !< mixed layer diapycnal diffusivity (m2/s) - !! when bulkmixedlayer==.false. - real :: Hmix !< mixed layer thickness (meter) when - !! bulkmixedlayer==.false. + logical :: debug ! If true, write verbose checksums for debugging. + + logical :: bulkmixedlayer ! If true, a refined bulk mixed layer is used with + ! GV%nk_rho_varies variable density mixed & buffer + ! layers. + real :: FluxRi_max ! The flux Richardson number where the stratification is + ! large enough that N2 > omega2. The full expression for + ! the Flux Richardson number is usually + ! FLUX_RI_MAX*N2/(N2+OMEGA2). The default is 0.2. + logical :: bottomdraglaw ! If true, the bottom stress is calculated with a + ! drag law c_drag*|u|*u. + logical :: BBL_mixing_as_max ! If true, take the maximum of the diffusivity + ! from the BBL mixing and the other diffusivities. + ! Otherwise, diffusivities from the BBL_mixing is + ! added. + logical :: use_LOTW_BBL_diffusivity ! If true, use simpler/less precise, BBL diffusivity. + logical :: LOTW_BBL_use_omega ! If true, use simpler/less precise, BBL diffusivity. + real :: BBL_effic ! efficiency with which the energy extracted + ! by bottom drag drives BBL diffusion (nondim) + real :: cdrag ! quadratic drag coefficient (nondim) + real :: IMax_decay ! inverse of a maximum decay scale for + ! bottom-drag driven turbulence, (1/m) + + real :: Kd ! interior diapycnal diffusivity (m2/s) + real :: Kd_min ! minimum diapycnal diffusivity (m2/s) + real :: Kd_max ! maximum increment for diapycnal diffusivity (m2/s) + ! Set to a negative value to have no limit. + real :: Kd_add ! uniform diffusivity added everywhere without + ! filtering or scaling (m2/s) + real :: Kv ! interior vertical viscosity (m2/s) + real :: Kdml ! mixed layer diapycnal diffusivity (m2/s) + ! when bulkmixedlayer==.false. + real :: Hmix ! mixed layer thickness (meter) when + ! bulkmixedlayer==.false. type(diag_ctrl), pointer :: diag ! structure to regulate diagn output timing - logical :: limit_dissipation !< If enabled, dissipation is limited to be larger - !! than the following: - real :: dissip_min !< Minimum dissipation (W/m3) - real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N (W/m3) - real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N (J/m3) - real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 (W m-3 s2) - real :: dissip_Kd_min !< Minimum Kd (m2/s) with dissipatio Rho0*Kd_min*N^2 - - real :: TKE_itide_max !< maximum internal tide conversion (W m-2) - !! available to mix above the BBL - real :: omega !< Earth's rotation frequency (s-1) - logical :: ML_radiation !< allow a fraction of TKE available from wind work - !! to penetrate below mixed layer base with a vertical - !! decay scale determined by the minimum of - !! (1) The depth of the mixed layer, or - !! (2) An Ekman length scale. - !! Energy availble to drive mixing below the mixed layer is - !! given by E = ML_RAD_COEFF*MSTAR*USTAR**3. Optionally, if - !! ML_rad_TKE_decay is true, this is further reduced by a factor - !! of exp(-h_ML*Idecay_len_TkE), where Idecay_len_TKE is - !! calculated the same way as in the mixed layer code. - !! The diapycnal diffusivity is KD(k) = E/(N2(k)+OMEGA2), - !! where N2 is the squared buoyancy frequency (s-2) and OMEGA2 - !! is the rotation rate of the earth squared. - real :: ML_rad_kd_max !< Maximum diapycnal diffusivity due to turbulence - !! radiated from the base of the mixed layer (m2/s) - real :: ML_rad_efold_coeff !< non-dim coefficient to scale penetration depth - real :: ML_rad_coeff !< coefficient, which scales MSTAR*USTAR^3 to - !! obtain energy available for mixing below - !! mixed layer base (nondimensional) - logical :: ML_rad_TKE_decay !< If true, apply same exponential decay - !! to ML_rad as applied to the other surface - !! sources of TKE in the mixed layer code. - real :: ustar_min !< A minimum value of ustar to avoid numerical - !! problems (m/s). If the value is small enough, - !! this parameter should not affect the solution. - real :: TKE_decay !< ratio of natural Ekman depth to TKE decay scale (nondim) - real :: mstar !! ratio of friction velocity cubed to - !! TKE input to the mixed layer (nondim) - logical :: ML_use_omega !< If true, use absolute rotation rate instead - !! of the vertical component of rotation when - !! setting the decay scale for mixed layer turbulence. - real :: ML_omega_frac !< When setting the decay scale for turbulence, use - !! this fraction of the absolute rotation rate blended - !! with the local value of f, as f^2 ~= (1-of)*f^2 + of*4*omega^2. - logical :: user_change_diff !< If true, call user-defined code to change diffusivity. - logical :: useKappaShear !< If true, use the kappa_shear module to find the - !! shear-driven diapycnal diffusivity. - logical :: use_CVMix_shear !< If true, use one of the CVMix modules to find - !! shear-driven diapycnal diffusivity. - logical :: use_CVMix_ddiff !< If true, enable double-diffusive mixing via CVMix. - logical :: simple_TKE_to_Kd !< If true, uses a simple estimate of Kd/TKE that - !! does not rely on a layer-formulation. + logical :: limit_dissipation ! If enabled, dissipation is limited to be larger + ! than the following: + real :: dissip_min ! Minimum dissipation (W/m3) + real :: dissip_N0 ! Coefficient a in minimum dissipation = a+b*N (W/m3) + real :: dissip_N1 ! Coefficient b in minimum dissipation = a+b*N (J/m3) + real :: dissip_N2 ! Coefficient c in minimum dissipation = c*N2 (W m-3 s2) + real :: dissip_Kd_min ! Minimum Kd (m2/s) with dissipatio Rho0*Kd_min*N^2 + + real :: TKE_itide_max ! maximum internal tide conversion (W m-2) + ! available to mix above the BBL + real :: omega ! Earth's rotation frequency (s-1) + logical :: ML_radiation ! allow a fraction of TKE available from wind work + ! to penetrate below mixed layer base with a vertical + ! decay scale determined by the minimum of + ! (1) The depth of the mixed layer, or + ! (2) An Ekman length scale. + ! Energy availble to drive mixing below the mixed layer is + ! given by E = ML_RAD_COEFF*MSTAR*USTAR**3. Optionally, if + ! ML_rad_TKE_decay is true, this is further reduced by a factor + ! of exp(-h_ML*Idecay_len_TkE), where Idecay_len_TKE is + ! calculated the same way as in the mixed layer code. + ! The diapycnal diffusivity is KD(k) = E/(N2(k)+OMEGA2), + ! where N2 is the squared buoyancy frequency (s-2) and OMEGA2 + ! is the rotation rate of the earth squared. + real :: ML_rad_kd_max ! Maximum diapycnal diffusivity due to turbulence + ! radiated from the base of the mixed layer (m2/s) + real :: ML_rad_efold_coeff ! non-dim coefficient to scale penetration depth + real :: ML_rad_coeff ! coefficient, which scales MSTAR*USTAR^3 to + ! obtain energy available for mixing below + ! mixed layer base (nondimensional) + logical :: ML_rad_TKE_decay ! If true, apply same exponential decay + ! to ML_rad as applied to the other surface + ! sources of TKE in the mixed layer code. + real :: ustar_min ! A minimum value of ustar to avoid numerical + ! problems (m/s). If the value is small enough, + ! this parameter should not affect the solution. + real :: TKE_decay ! ratio of natural Ekman depth to TKE decay scale (nondim) + real :: mstar ! ratio of friction velocity cubed to + ! TKE input to the mixed layer (nondim) + logical :: ML_use_omega ! If true, use absolute rotation rate instead + ! of the vertical component of rotation when + ! setting the decay scale for mixed layer turbulence. + real :: ML_omega_frac ! When setting the decay scale for turbulence, use + ! this fraction of the absolute rotation rate blended + ! with the local value of f, as f^2 ~= (1-of)*f^2 + of*4*omega^2. + logical :: user_change_diff ! If true, call user-defined code to change diffusivity. + logical :: useKappaShear ! If true, use the kappa_shear module to find the + ! shear-driven diapycnal diffusivity. + logical :: use_CVMix_shear ! If true, use one of the CVMix modules to find + ! shear-driven diapycnal diffusivity. + logical :: double_diffusion ! If true, enable double-diffusive mixing. + logical :: simple_TKE_to_Kd ! If true, uses a simple estimate of Kd/TKE that + ! does not rely on a layer-formulation. + real :: Max_Rrho_salt_fingers ! max density ratio for salt fingering + real :: Max_salt_diff_salt_fingers ! max salt diffusivity for salt fingers (m2/s) + real :: Kv_molecular ! molecular visc for double diff convect (m2/s) character(len=200) :: inputdir type(user_change_diff_CS), pointer :: user_change_diff_CSp => NULL() type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() type(Kappa_shear_CS), pointer :: kappaShear_CSp => NULL() type(CVMix_shear_cs), pointer :: CVMix_shear_csp => NULL() - type(CVMix_ddiff_cs), pointer :: CVMix_ddiff_csp => NULL() type(bkgnd_mixing_cs), pointer :: bkgnd_mixing_csp => NULL() type(int_tide_CS), pointer :: int_tide_CSp => NULL() type(tidal_mixing_cs), pointer :: tm_csp => NULL() @@ -157,6 +158,11 @@ module MOM_set_diffusivity integer :: id_N2 = -1 integer :: id_N2_z = -1 + integer :: id_KT_extra = -1 + integer :: id_KS_extra = -1 + integer :: id_KT_extra_z = -1 + integer :: id_KS_extra_z = -1 + end type set_diffusivity_CS type diffusivity_diags @@ -166,9 +172,12 @@ module MOM_set_diffusivity Kd_BBL => NULL(),& ! BBL diffusivity at interfaces (m2/s) Kd_work => NULL(),& ! layer integrated work by diapycnal mixing (W/m2) maxTKE => NULL(),& ! energy required to entrain to h_max (m3/s3) - TKE_to_Kd => NULL() ! conversion rate (~1.0 / (G_Earth + dRho_lay)) + TKE_to_Kd => NULL(),& ! conversion rate (~1.0 / (G_Earth + dRho_lay)) ! between TKE dissipated within a layer and Kd ! in that layer, in m2 s-1 / m3 s-3 = s2 m-1 + KT_extra => NULL(),& ! double diffusion diffusivity for temp (m2/s) + KS_extra => NULL() ! double diffusion diffusivity for saln (m2/s) + end type diffusivity_diags ! Clocks @@ -176,17 +185,6 @@ module MOM_set_diffusivity contains -!> Sets the interior vertical diffusion of scalars due to the following processes: -!! 1) Shear-driven mixing: two options, Jackson et at. and KPP interior; -!! 2) Background mixing via CVMix (Bryan-Lewis profile) or the scheme described by -!! Harrison & Hallberg, JPO 2008; -!! 3) Double-diffusion aplpied via CVMix; -!! 4) Tidal mixing: many options available, see MOM_tidal_mixing.F90; -!! In addition, this subroutine has the option to set the interior vertical -!! viscosity associated with processes 2-4 listed above, which is stored in -!! visc%Kv_slow. Vertical viscosity due to shear-driven mixing is passed via -!! visc%Kv_shear -!! GMM, TODO: add contribution from tidal mixing into visc%Kv_slow subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & G, GV, CS, Kd, Kd_int) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -198,9 +196,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u_h !< zonal thickness transport m^2/s. + intent(in) :: u_h real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: v_h !< meridional thickness transport m^2/s. + intent(in) :: v_h type(thermo_var_ptrs), intent(inout) :: tv !< Structure with pointers to thermodynamic !! fields. Out is for tv%TempxPmE. type(forcing), intent(in) :: fluxes !< Structure of surface fluxes that may be @@ -228,15 +226,17 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! massless layers filled vertically by diffusion. real, dimension(SZI_(G),SZK_(G)) :: & - N2_lay, & !< squared buoyancy frequency associated with layers (1/s2) - maxTKE, & !< energy required to entrain to h_max (m3/s3) - TKE_to_Kd !< conversion rate (~1.0 / (G_Earth + dRho_lay)) between - !< TKE dissipated within a layer and Kd in that layer, in - !< m2 s-1 / m3 s-3 = s2 m-1. + N2_lay, & ! squared buoyancy frequency associated with layers (1/s2) + maxTKE, & ! energy required to entrain to h_max (m3/s3) + TKE_to_Kd ! conversion rate (~1.0 / (G_Earth + dRho_lay)) between + ! TKE dissipated within a layer and Kd in that layer, in + ! m2 s-1 / m3 s-3 = s2 m-1. real, dimension(SZI_(G),SZK_(G)+1) :: & - N2_int, & !< squared buoyancy frequency associated at interfaces (1/s2) - dRho_int !< locally ref potential density difference across interfaces (in s-2) smg: or kg/m3? + N2_int, & ! squared buoyancy frequency associated at interfaces (1/s2) + dRho_int, & ! locally ref potential density difference across interfaces (in s-2) smg: or kg/m3? + KT_extra, & ! double difusion diffusivity on temperature (m2/sec) + KS_extra ! double difusion diffusivity on salinity (m2/sec) real :: I_Rho0 ! inverse of Boussinesq density (m3/kg) real :: dissip ! local variable for dissipation calculations (W/m3) @@ -271,16 +271,10 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & use_EOS = associated(tv%eqn_of_state) - if ((CS%use_CVMix_ddiff) .and. & + if ((CS%double_diffusion) .and. & .not.(associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S)) ) & call MOM_error(FATAL, "set_diffusivity: visc%Kd_extra_T and "//& - "visc%Kd_extra_S must be associated when USE_CVMIX_DDIFF is true.") - - ! Set Kd, Kd_int and Kv_slow to constant values. - ! If nothing else is specified, this will be the value used. - Kd(:,:,:) = CS%Kd - Kd_int(:,:,:) = CS%Kd - if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = CS%Kv + "visc%Kd_extra_S must be associated when DOUBLE_DIFFUSION is true.") ! Set up arrays for diagnostics. @@ -299,6 +293,12 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%id_TKE_to_Kd > 0) then allocate(dd%TKE_to_Kd(isd:ied,jsd:jed,nz)) ; dd%TKE_to_Kd(:,:,:) = 0.0 endif + if ((CS%id_KT_extra > 0) .or. (CS%id_KT_extra_z > 0)) then + allocate(dd%KT_extra(isd:ied,jsd:jed,nz+1)) ; dd%KT_extra(:,:,:) = 0.0 + endif + if ((CS%id_KS_extra > 0) .or. (CS%id_KS_extra_z > 0)) then + allocate(dd%KS_extra(isd:ied,jsd:jed,nz+1)) ; dd%KS_extra(:,:,:) = 0.0 + endif if ((CS%id_Kd_BBL > 0) .or. (CS%id_Kd_BBL_z > 0)) then allocate(dd%Kd_BBL(isd:ied,jsd:jed,nz+1)) ; dd%Kd_BBL(:,:,:) = 0.0 endif @@ -341,10 +341,6 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & elseif (CS%use_CVMix_shear) then !NOTE{BGR}: this needs to be cleaned up. It works in 1D case, but has not been tested outside. call calculate_CVMix_shear(u_h, v_h, h, tv, visc%Kd_shear, visc%Kv_shear,G,GV,CS%CVMix_shear_csp) - if (CS%debug) then - call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear",G%HI) - call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear",G%HI) - endif elseif (associated(visc%Kv_shear)) then visc%Kv_shear(:,:,:) = 0. ! needed if calculate_kappa_shear is not enabled endif @@ -356,6 +352,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! set surface diffusivities (CS%bkgnd_mixing_csp%Kd_sfc) call sfc_bkgnd_mixing(G, CS%bkgnd_mixing_csp) +! GMM, fix OMP calls below + !$OMP parallel do default(none) shared(is,ie,js,je,nz,G,GV,CS,h,tv,T_f,S_f,fluxes,dd, & !$OMP Kd,visc, & !$OMP Kd_int,dt,u,v,Omega2) & @@ -372,13 +370,35 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & do K=1,nz+1 ; do i=is,ie ; dd%N2_3d(i,j,K) = N2_int(i,K) ; enddo ; enddo endif - ! Add background mixing + ! add background mixing call calculate_bkgnd_mixing(h, tv, N2_lay, Kd, visc%Kv_slow, j, G, GV, CS%bkgnd_mixing_csp) - ! Apply double diffusion - ! GMM, we need to pass HBL to compute_ddiff_coeffs, but it is not yet available. - if (CS%use_CVMix_ddiff) then - call compute_ddiff_coeffs(h, tv, G, GV, j, visc%Kd_extra_T, visc%Kd_extra_S, CS%CVMix_ddiff_csp) + ! GMM, the following will go into the MOM_CVMix_double_diffusion module + if (CS%double_diffusion) then + call double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, KT_extra, KS_extra) + do K=2,nz ; do i=is,ie + if (KS_extra(i,K) > KT_extra(i,K)) then ! salt fingering + Kd(i,j,k-1) = Kd(i,j,k-1) + 0.5*KT_extra(i,K) + Kd(i,j,k) = Kd(i,j,k) + 0.5*KT_extra(i,K) + visc%Kd_extra_S(i,j,k) = KS_extra(i,K)-KT_extra(i,K) + visc%Kd_extra_T(i,j,k) = 0.0 + elseif (KT_extra(i,K) > 0.0) then ! double-diffusive convection + Kd(i,j,k-1) = Kd(i,j,k-1) + 0.5*KS_extra(i,K) + Kd(i,j,k) = Kd(i,j,k) + 0.5*KS_extra(i,K) + visc%Kd_extra_T(i,j,k) = KT_extra(i,K)-KS_extra(i,K) + visc%Kd_extra_S(i,j,k) = 0.0 + else ! There is no double diffusion at this interface. + visc%Kd_extra_T(i,j,k) = 0.0 + visc%Kd_extra_S(i,j,k) = 0.0 + endif + enddo ; enddo + if (associated(dd%KT_extra)) then ; do K=1,nz+1 ; do i=is,ie + dd%KT_extra(i,j,K) = KT_extra(i,K) + enddo ; enddo ; endif + + if (associated(dd%KS_extra)) then ; do K=1,nz+1 ; do i=is,ie + dd%KS_extra(i,j,K) = KS_extra(i,K) + enddo ; enddo ; endif endif ! Add the input turbulent diffusivity. @@ -476,11 +496,6 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%useKappaShear) call hchksum(visc%Kd_shear,"Turbulent Kd",G%HI,haloshift=0) - if (CS%use_CVMix_ddiff) then - call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T",G%HI,haloshift=0) - call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S",G%HI,haloshift=0) - endif - if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then call uvchksum("BBL Kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, & G%HI, 0, symmetric=.true.) @@ -497,6 +512,12 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif + ! send bkgnd_mixing diagnostics to post_data + if (CS%bkgnd_mixing_csp%id_kd_bkgnd > 0) & + call post_data(CS%bkgnd_mixing_csp%id_kd_bkgnd, CS%bkgnd_mixing_csp%kd_bkgnd, CS%bkgnd_mixing_csp%diag) + if (CS%bkgnd_mixing_csp%id_kv_bkgnd > 0) & + call post_data(CS%bkgnd_mixing_csp%id_kv_bkgnd, CS%bkgnd_mixing_csp%kv_bkgnd, CS%bkgnd_mixing_csp%diag) + if (CS%Kd_add > 0.0) then if (present(Kd_int)) then !$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_int,CS,Kd) @@ -517,28 +538,13 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & T_f, S_f, dd%Kd_user) endif - ! post diagnostics - - ! background mixing - if (CS%bkgnd_mixing_csp%id_kd_bkgnd > 0) & - call post_data(CS%bkgnd_mixing_csp%id_kd_bkgnd, CS%bkgnd_mixing_csp%kd_bkgnd, CS%bkgnd_mixing_csp%diag) - if (CS%bkgnd_mixing_csp%id_kv_bkgnd > 0) & - call post_data(CS%bkgnd_mixing_csp%id_kv_bkgnd, CS%bkgnd_mixing_csp%kv_bkgnd, CS%bkgnd_mixing_csp%diag) - - ! double diffusive mixing - if (CS%CVMix_ddiff_csp%id_KT_extra > 0) & - call post_data(CS%CVMix_ddiff_csp%id_KT_extra, visc%Kd_extra_T, CS%CVMix_ddiff_csp%diag) - if (CS%CVMix_ddiff_csp%id_KS_extra > 0) & - call post_data(CS%CVMix_ddiff_csp%id_KS_extra, visc%Kd_extra_S, CS%CVMix_ddiff_csp%diag) - if (CS%CVMix_ddiff_csp%id_R_rho > 0) & - call post_data(CS%CVMix_ddiff_csp%id_R_rho, CS%CVMix_ddiff_csp%R_rho, CS%CVMix_ddiff_csp%diag) - + ! GMM, post diags... if (CS%id_Kd_layer > 0) call post_data(CS%id_Kd_layer, Kd, CS%diag) - ! tidal mixing + num_z_diags = 0 + call post_tidal_diagnostics(G,GV,h,CS%tm_csp) - num_z_diags = 0 if (CS%tm_csp%Int_tide_dissipation .or. CS%tm_csp%Lee_wave_dissipation .or. & CS%tm_csp%Lowmode_itidal_dissipation) then @@ -562,11 +568,26 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif + if (CS%id_KT_extra > 0) call post_data(CS%id_KT_extra, dd%KT_extra, CS%diag) + if (CS%id_KS_extra > 0) call post_data(CS%id_KS_extra, dd%KS_extra, CS%diag) if (CS%id_Kd_BBL > 0) call post_data(CS%id_Kd_BBL, dd%Kd_BBL, CS%diag) + if (CS%id_KT_extra_z > 0) then + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_KT_extra_z + z_ptrs(num_z_diags)%p => dd%KT_extra + endif + + if (CS%id_KS_extra_z > 0) then + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_KS_extra_z + z_ptrs(num_z_diags)%p => dd%KS_extra + endif + if (CS%id_Kd_BBL_z > 0) then num_z_diags = num_z_diags + 1 z_ids(num_z_diags) = CS%id_Kd_BBL_z + z_ptrs(num_z_diags)%p => dd%KS_extra endif if (num_z_diags > 0) & @@ -577,6 +598,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(dd%Kd_user)) deallocate(dd%Kd_user) if (associated(dd%maxTKE)) deallocate(dd%maxTKE) if (associated(dd%TKE_to_Kd)) deallocate(dd%TKE_to_Kd) + if (associated(dd%KT_extra)) deallocate(dd%KT_extra) + if (associated(dd%KS_extra)) deallocate(dd%KS_extra) if (associated(dd%Kd_BBL)) deallocate(dd%Kd_BBL) if (showCallTree) call callTree_leave("set_diffusivity()") @@ -929,6 +952,119 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & end subroutine find_N2 +! GMM, the following will be moved to a new module + +!> This subroutine sets the additional diffusivities of temperature and +!! salinity due to double diffusion, using the same functional form as is +!! used in MOM4.1, and taken from an NCAR technical note (REF?) that updates +!! what was in Large et al. (1994). All the coefficients here should probably +!! be made run-time variables rather than hard-coded constants. +!! +!! \todo Find reference for NCAR tech note above. +subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, Kd_T_dd, Kd_S_dd) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available + !! thermodynamic fields; absent fields have NULL + !! ptrs. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: T_f !< layer temp in C with the values in massless layers + !! filled vertically by diffusion. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: S_f !< Layer salinities in PPT with values in massless + !! layers filled vertically by diffusion. + integer, intent(in) :: j !< Meridional index upon which to work. + type(set_diffusivity_CS), pointer :: CS !< Module control structure. + real, dimension(SZI_(G),SZK_(G)+1), & + intent(out) :: Kd_T_dd !< Interface double diffusion diapycnal + !! diffusivity for temp (m2/sec). + real, dimension(SZI_(G),SZK_(G)+1), & + intent(out) :: Kd_S_dd !< Interface double diffusion diapycnal + !! diffusivity for saln (m2/sec). + +! Arguments: +! (in) tv - structure containing pointers to any available +! thermodynamic fields; absent fields have NULL ptrs +! (in) h - layer thickness (m or kg m-2) +! (in) T_f - layer temp in C with the values in massless layers +! filled vertically by diffusion +! (in) S_f - layer salinities in PPT with values in massless layers +! filled vertically by diffusion +! (in) G - ocean grid structure +! (in) GV - The ocean's vertical grid structure. +! (in) CS - module control structure +! (in) j - meridional index upon which to work +! (out) Kd_T_dd - interface double diffusion diapycnal diffusivity for temp (m2/sec) +! (out) Kd_S_dd - interface double diffusion diapycnal diffusivity for saln (m2/sec) + +! This subroutine sets the additional diffusivities of temperature and +! salinity due to double diffusion, using the same functional form as is +! used in MOM4.1, and taken from an NCAR technical note (###REF?) that updates +! what was in Large et al. (1994). All the coefficients here should probably +! be made run-time variables rather than hard-coded constants. + + real, dimension(SZI_(G)) :: & + dRho_dT, & ! partial derivatives of density wrt temp (kg m-3 degC-1) + dRho_dS, & ! partial derivatives of density wrt saln (kg m-3 PPT-1) + pres, & ! pressure at each interface (Pa) + Temp_int, & ! temp and saln at interfaces + Salin_int + + real :: alpha_dT ! density difference between layers due to temp diffs (kg/m3) + real :: beta_dS ! density difference between layers due to saln diffs (kg/m3) + + real :: Rrho ! vertical density ratio + real :: diff_dd ! factor for double-diffusion + real :: prandtl ! flux ratio for diffusive convection regime + + real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio + real, parameter :: dsfmax = 1.e-4 ! max diffusivity in case of salt fingering + real, parameter :: Kv_molecular = 1.5e-6 ! molecular viscosity (m2/sec) + + integer :: i, k, is, ie, nz + is = G%isc ; ie = G%iec ; nz = G%ke + + if (associated(tv%eqn_of_state)) then + do i=is,ie + pres(i) = 0.0 ; Kd_T_dd(i,1) = 0.0 ; Kd_S_dd(i,1) = 0.0 + Kd_T_dd(i,nz+1) = 0.0 ; Kd_S_dd(i,nz+1) = 0.0 + enddo + do K=2,nz + do i=is,ie + pres(i) = pres(i) + GV%H_to_Pa*h(i,j,k-1) + Temp_Int(i) = 0.5 * (T_f(i,j,k-1) + T_f(i,j,k)) + Salin_Int(i) = 0.5 * (S_f(i,j,k-1) + S_f(i,j,k)) + enddo + call calculate_density_derivs(Temp_int, Salin_int, pres, & + dRho_dT(:), dRho_dS(:), is, ie-is+1, tv%eqn_of_state) + + do i=is,ie + alpha_dT = -1.0*dRho_dT(i) * (T_f(i,j,k-1) - T_f(i,j,k)) + beta_dS = dRho_dS(i) * (S_f(i,j,k-1) - S_f(i,j,k)) + + if ((alpha_dT > beta_dS) .and. (beta_dS > 0.0)) then ! salt finger case + Rrho = min(alpha_dT/beta_dS,Rrho0) + diff_dd = 1.0 - ((RRho-1.0)/(RRho0-1.0)) + diff_dd = dsfmax*diff_dd*diff_dd*diff_dd + Kd_T_dd(i,K) = 0.7*diff_dd + Kd_S_dd(i,K) = diff_dd + elseif ((alpha_dT < 0.) .and. (beta_dS < 0.) .and. (alpha_dT > beta_dS)) then ! diffusive convection + Rrho = alpha_dT/beta_dS + diff_dd = Kv_molecular*0.909*exp(4.6*exp(-0.54*(1/Rrho-1))) + prandtl = 0.15*Rrho + if (Rrho > 0.5) prandtl = (1.85-0.85/Rrho)*Rrho + Kd_T_dd(i,K) = diff_dd + Kd_S_dd(i,K) = prandtl*diff_dd + else + Kd_T_dd(i,K) = 0.0 ; Kd_S_dd(i,K) = 0.0 + endif + enddo + enddo + endif + +end subroutine double_diffusion !> This routine adds diffusion sustained by flow energy extracted by bottom drag. subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & maxTKE, kb, G, GV, CS, Kd, Kd_int, Kd_BBL) @@ -1838,11 +1974,6 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp ! set params releted to the background mixing call bkgnd_mixing_init(Time, G, GV, param_file, CS%diag, CS%bkgnd_mixing_csp) - call get_param(param_file, mdl, "KV", CS%Kv, & - "The background kinematic viscosity in the interior. \n"//& - "The molecular value, ~1e-6 m2 s-1, may be used.", & - units="m2 s-1", fail_if_missing=.true.) - call get_param(param_file, mdl, "KD", CS%Kd, & "The background diapycnal diffusivity of density in the \n"//& "interior. Zero or the molecular value, ~1e-7 m2 s-1, \n"//& @@ -1945,6 +2076,45 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp endif endif + + ! GMM, the following should be moved to the DD module + call get_param(param_file, mdl, "DOUBLE_DIFFUSION", CS%double_diffusion, & + "If true, increase diffusivitives for temperature or salt \n"//& + "based on double-diffusive paramaterization from MOM4/KPP.", & + default=.false.) + if (CS%double_diffusion) then + call get_param(param_file, mdl, "MAX_RRHO_SALT_FINGERS", CS%Max_Rrho_salt_fingers, & + "Maximum density ratio for salt fingering regime.", & + default=2.55, units="nondim") + call get_param(param_file, mdl, "MAX_SALT_DIFF_SALT_FINGERS", CS%Max_salt_diff_salt_fingers, & + "Maximum salt diffusivity for salt fingering regime.", & + default=1.e-4, units="m2 s-1") + call get_param(param_file, mdl, "KV_MOLECULAR", CS%Kv_molecular, & + "Molecular viscosity for calculation of fluxes under \n"//& + "double-diffusive convection.", default=1.5e-6, units="m2 s-1") + ! The default molecular viscosity follows the CCSM4.0 and MOM4p1 defaults. + + CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & + 'Double-diffusive diffusivity for temperature', 'm2 s-1') + + CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & + 'Double-diffusive diffusivity for salinity', 'm2 s-1') + + if (associated(diag_to_Z_CSp)) then + vd = var_desc("KT_extra", "m2 s-1", & + "Double-Diffusive Temperature Diffusivity, interpolated to z", & + z_grid='z') + CS%id_KT_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + vd = var_desc("KS_extra", "m2 s-1", & + "Double-Diffusive Salinity Diffusivity, interpolated to z",& + z_grid='z') + CS%id_KS_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + vd = var_desc("Kd_BBL", "m2 s-1", & + "Bottom Boundary Layer Diffusivity", z_grid='z') + CS%id_Kd_BBL_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + endif + endif + if (CS%user_change_diff) then call user_change_diff_init(Time, G, param_file, diag, CS%user_change_diff_CSp) endif @@ -1960,9 +2130,6 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp ! CVMix shear-driven mixing CS%use_CVMix_shear = CVMix_shear_init(Time, G, GV, param_file, CS%diag, CS%CVMix_shear_csp) - ! CVMix double diffusion mixing - CS%use_CVMix_ddiff = CVMix_ddiff_init(Time, G, GV, param_file, CS%diag, CS%CVMix_ddiff_csp) - end subroutine set_diffusivity_init !> Clear pointers and dealocate memory @@ -1979,9 +2146,6 @@ subroutine set_diffusivity_end(CS) if (CS%use_CVMix_shear) & call CVMix_shear_end(CS%CVMix_shear_csp) - if (CS%use_CVMix_ddiff) & - call CVMix_ddiff_end(CS%CVMix_ddiff_csp) - if (associated(CS)) deallocate(CS) end subroutine set_diffusivity_end diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index ec1b09a5ad..ec0b5a80b3 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -2,6 +2,38 @@ module MOM_set_visc ! This file is part of MOM6. See LICENSE.md for the license. +!********+*********+*********+*********+*********+*********+*********+** +!* * +!* By Robert Hallberg, April 1994 - October 2006 * +!* Quadratic Bottom Drag by James Stephens and R. Hallberg. * +!* * +!* This file contains the subroutine that calculates various values * +!* related to the bottom boundary layer, such as the viscosity and * +!* thickness of the BBL (set_viscous_BBL). This would also be the * +!* module in which other viscous quantities that are flow-independent * +!* might be set. This information is transmitted to other modules * +!* via a vertvisc type structure. * +!* * +!* The same code is used for the two velocity components, by * +!* indirectly referencing the velocities and defining a handful of * +!* direction-specific defined variables. * +!* * +!* Macros written all in capital letters are defined in MOM_memory.h. * +!* * +!* A small fragment of the grid is shown below: * +!* * +!* j+1 x ^ x ^ x At x: q * +!* j+1 > o > o > At ^: v, frhatv, tauy * +!* j x ^ x ^ x At >: u, frhatu, taux * +!* j > o > o > At o: h * +!* j-1 x ^ x ^ x * +!* i-1 i i+1 At x & ^: * +!* i i+1 At > & o: * +!* * +!* The boundaries always run through q grid points (x). * +!* * +!********+*********+*********+*********+*********+*********+*********+** + use MOM_debugging, only : uvchksum, hchksum use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr @@ -12,9 +44,8 @@ module MOM_set_visc use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type use MOM_kappa_shear, only : kappa_shear_is_used -use MOM_cvmix_shear, only : cvmix_shear_is_used -use MOM_cvmix_conv, only : cvmix_conv_is_used -use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used +use MOM_CVMix_shear, only : CVMix_shear_is_used +use MOM_CVMix_conv, only : CVMix_conv_is_used use MOM_io, only : vardesc, var_desc use MOM_restart, only : register_restart_field, MOM_restart_CS use MOM_variables, only : thermo_var_ptrs @@ -1760,10 +1791,8 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) call get_param(param_file, mdl, "ADIABATIC", adiabatic, default=.false., & do_not_log=.true.) - use_kappa_shear = .false. ; use_CVMix_shear = .false. useKPP = .false. ; useEPBL = .false. ; use_CVMix_conv = .false. - if (.not.adiabatic) then use_kappa_shear = kappa_shear_is_used(param_file) use_CVMix_shear = CVMix_shear_is_used(param_file) @@ -1782,9 +1811,7 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) allocate(visc%Kd_shear(isd:ied,jsd:jed,nz+1)) ; visc%Kd_shear(:,:,:) = 0.0 allocate(visc%TKE_turb(isd:ied,jsd:jed,nz+1)) ; visc%TKE_turb(:,:,:) = 0.0 allocate(visc%Kv_shear(isd:ied,jsd:jed,nz+1)) ; visc%Kv_shear(:,:,:) = 0.0 - - ! MOM_bkgnd_mixing is always used, so always allocate visc%Kv_slow. GMM - allocate(visc%Kv_slow(isd:ied,jsd:jed,nz+1)) ; visc%Kv_slow(:,:,:) = 0.0 + allocate(visc%Kv_slow(isd:ied,jsd:jed,nz+1)) ; visc%Kv_slow(:,:,:) = 0.0 vd = var_desc("Kd_shear","m2 s-1","Shear-driven turbulent diffusivity at interfaces", & hor_grid='h', z_grid='i') @@ -1827,14 +1854,21 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) type(set_visc_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module type(ocean_OBC_type), pointer :: OBC - - ! local variables +! Arguments: Time - The current model time. +! (in) G - The ocean's grid structure. +! (in) GV - The ocean's vertical grid structure. +! (in) param_file - A structure indicating the open file to parse for +! model parameter values. +! (in) diag - A structure that is used to regulate diagnostic output. +! (out) visc - A structure containing vertical viscosities and related +! fields. Allocated here. +! (in/out) CS - A pointer that is set to point to the control structure +! for this module real :: Csmag_chan_dflt, smag_const1, TKE_decay_dflt, bulk_Ri_ML_dflt real :: Kv_background real :: omega_frac_dflt integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, i, j, n - logical :: use_kappa_shear, adiabatic, use_omega - logical :: use_CVMix_ddiff + logical :: use_kappa_shear, adiabatic, differential_diffusion, use_omega type(OBC_segment_type), pointer :: segment ! pointer to OBC segment type ! This include declares and sets the variable "version". #include "version_variable.h" @@ -1857,8 +1891,8 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) ! Set default, read and log parameters call log_version(param_file, mdl, version, "") - CS%RiNo_mix = .false. ; use_CVMix_ddiff = .false. - use_kappa_shear = .false. !; adiabatic = .false. ! Needed? -AJA + CS%RiNo_mix = .false. + use_kappa_shear = .false. ; differential_diffusion = .false. !; adiabatic = .false. ! Needed? -AJA call get_param(param_file, mdl, "BOTTOMDRAGLAW", CS%bottomdraglaw, & "If true, the bottom stress is calculated with a drag \n"//& "law of the form c_drag*|u|*u. The velocity magnitude \n"//& @@ -1885,9 +1919,11 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) if (.not.adiabatic) then use_kappa_shear = kappa_shear_is_used(param_file) CS%RiNo_mix = use_kappa_shear - use_CVMix_ddiff = CVMix_ddiff_is_used(param_file) + call get_param(param_file, mdl, "DOUBLE_DIFFUSION", differential_diffusion, & + "If true, increase diffusivitives for temperature or salt \n"//& + "based on double-diffusive paramaterization from MOM4/KPP.", & + default=.false.) endif - call get_param(param_file, mdl, "PRANDTL_TURB", visc%Prandtl_turb, & "The turbulent Prandtl number applied to shear \n"//& "instability.", units="nondim", default=1.0) @@ -1980,15 +2016,6 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) "The background kinematic viscosity in the interior. \n"//& "The molecular value, ~1e-6 m2 s-1, may be used.", & units="m2 s-1", fail_if_missing=.true.) - - call get_param(param_file, mdl, "ADD_KV_SLOW", visc%add_Kv_slow, & - "If true, the background vertical viscosity in the interior \n"//& - "(i.e., tidal + background + shear + convenction) is addded \n"// & - "when computing the coupling coefficient. The purpose of this \n"// & - "flag is to be able to recover previous answers and it will likely \n"// & - "be removed in the future since this option should always be true.", & - default=.false.) - call get_param(param_file, mdl, "KV_BBL_MIN", CS%KV_BBL_min, & "The minimum viscosities in the bottom boundary layer.", & units="m2 s-1", default=Kv_background) @@ -2038,7 +2065,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) Time, 'Rayleigh drag velocity at v points', 'm s-1') endif - if (use_CVMix_ddiff) then + if (differential_diffusion) then allocate(visc%Kd_extra_T(isd:ied,jsd:jed,nz+1)) ; visc%Kd_extra_T = 0.0 allocate(visc%Kd_extra_S(isd:ied,jsd:jed,nz+1)) ; visc%Kd_extra_S = 0.0 endif @@ -2086,37 +2113,4 @@ subroutine set_visc_end(visc, CS) deallocate(CS) end subroutine set_visc_end -!> \namespace MOM_set_visc -!!********+*********+*********+*********+*********+*********+*********+** -!!* * -!!* By Robert Hallberg, April 1994 - October 2006 * -!!* Quadratic Bottom Drag by James Stephens and R. Hallberg. * -!!* * -!!* This file contains the subroutine that calculates various values * -!!* related to the bottom boundary layer, such as the viscosity and * -!!* thickness of the BBL (set_viscous_BBL). This would also be the * -!!* module in which other viscous quantities that are flow-independent * -!!* might be set. This information is transmitted to other modules * -!!* via a vertvisc type structure. * -!!* * -!!* The same code is used for the two velocity components, by * -!!* indirectly referencing the velocities and defining a handful of * -!!* direction-specific defined variables. * -!!* * -!!* Macros written all in capital letters are defined in MOM_memory.h. * -!!* * -!!* A small fragment of the grid is shown below: * -!!* * -!!* j+1 x ^ x ^ x At x: q * -!!* j+1 > o > o > At ^: v, frhatv, tauy * -!!* j x ^ x ^ x At >: u, frhatu, taux * -!!* j > o > o > At o: h * -!!* j-1 x ^ x ^ x * -!!* i-1 i i+1 At x & ^: * -!!* i i+1 At > & o: * -!!* * -!!* The boundaries always run through q grid points (x). * -!!* * -!!********+*********+*********+*********+*********+*********+*********+** - end module MOM_set_visc diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index bafbe5eb59..48a6380ead 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -2,7 +2,7 @@ module MOM_vert_friction ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_domains, only : pass_var, To_All, Omit_corners + use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl use MOM_debugging, only : uvchksum, hchksum @@ -116,7 +116,6 @@ module MOM_vert_friction integer :: id_du_dt_visc = -1, id_dv_dt_visc = -1, id_au_vv = -1, id_av_vv = -1 integer :: id_h_u = -1, id_h_v = -1, id_hML_u = -1 , id_hML_v = -1 integer :: id_Ray_u = -1, id_Ray_v = -1, id_taux_bot = -1, id_tauy_bot = -1 - integer :: id_Kv_slow = -1, id_Kv_u = -1, id_Kv_v = -1 !>@} type(PointAccel_CS), pointer :: PointAccel_CSp => NULL() @@ -615,8 +614,6 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! based on harmonic mean thicknesses, in m or kg m-2. h_ml ! The mixed layer depth, in m or kg m-2. real, allocatable, dimension(:,:) :: hML_u, hML_v - real, allocatable, dimension(:,:,:) :: Kv_v, & !< Total vertical viscosity at u-points - Kv_u !< Total vertical viscosity at v-points real :: zcol(SZI_(G)) ! The height of an interface at h-points, in m or kg m-2. real :: botfn ! A function which goes from 1 at the bottom to 0 much more ! than Hbbl into the interior. @@ -649,14 +646,6 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) I_Hbbl(:) = 1.0 / (CS%Hbbl * GV%m_to_H + h_neglect) I_valBL = 0.0 ; if (CS%harm_BL_val > 0.0) I_valBL = 1.0 / CS%harm_BL_val - if (CS%id_Kv_u > 0) then - allocate(Kv_u(G%IsdB:G%IedB,G%jsd:G%jed,G%ke)) ; Kv_u(:,:,:) = 0.0 - endif - - if (CS%id_Kv_v > 0) then - allocate(Kv_v(G%isd:G%ied,G%JsdB:G%JedB,G%ke)) ; Kv_v(:,:,:) = 0.0 - endif - if (CS%debug .or. (CS%id_hML_u > 0)) then allocate(hML_u(G%IsdB:G%IedB,G%jsd:G%jed)) ; hML_u(:,:) = 0.0 endif @@ -832,13 +821,6 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) CS%h_u(I,j,k) = hvel(I,k) ; enddo ; enddo endif - ! Diagnose total Kv at u-points - if (CS%id_Kv_u > 0) then - do k=1,nz ; do I=Isq,Ieq - if (do_i(I)) Kv_u(I,j,k) = 0.5 * (CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k) - enddo ; enddo - endif - enddo @@ -1002,14 +984,6 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) CS%a_v(i,J,K) = a(i,K) ; enddo ; enddo do k=1,nz ; do i=is,ie ; if (do_i(i)) CS%h_v(i,J,k) = hvel(i,k) ; enddo ; enddo endif - - ! Diagnose total Kv at v-points - if (CS%id_Kv_v > 0) then - do k=1,nz ; do i=is,ie - if (do_i(I)) Kv_v(i,J,k) = 0.5 * (CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k) - enddo ; enddo - endif - enddo ! end of v-point j loop if (CS%debug) then @@ -1023,9 +997,6 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) endif ! Offer diagnostic fields for averaging. - if (CS%id_Kv_slow > 0) call post_data(CS%id_Kv_slow, visc%Kv_slow, CS%diag) - if (CS%id_Kv_u > 0) call post_data(CS%id_Kv_u, Kv_u, CS%diag) - if (CS%id_Kv_v > 0) call post_data(CS%id_Kv_v, Kv_v, CS%diag) if (CS%id_au_vv > 0) call post_data(CS%id_au_vv, CS%a_u, CS%diag) if (CS%id_av_vv > 0) call post_data(CS%id_av_vv, CS%a_v, CS%diag) if (CS%id_h_u > 0) call post_data(CS%id_h_u, CS%h_u, CS%diag) @@ -1194,44 +1165,6 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif endif - ! add "slow" varying vertical viscosity (e.g., from background, tidal etc) - if (associated(visc%Kv_slow) .and. (visc%add_Kv_slow)) then - ! GMM/ A factor of 2 is also needed here, see comment above from BGR. - if (work_on_u) then - do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = Kv_add(i,K) + 1.0 * (visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k)) - endif ; enddo ; enddo - if (do_OBCs) then - do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then - if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j,k) ; enddo - elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i+1,j,k) ; enddo - endif - endif ; enddo - endif - do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a(i,K) = a(i,K) + Kv_add(i,K) - endif ; enddo ; enddo - else - do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = Kv_add(i,K) + 1.0*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j+1,k)) - endif ; enddo ; enddo - if (do_OBCs) then - do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then - if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j,k) ; enddo - elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j+1,k) ; enddo - endif - endif ; enddo - endif - do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a(i,K) = a(i,K) + Kv_add(i,K) - endif ; enddo ; enddo - endif - endif - do K=nz,2,-1 ; do i=is,ie ; if (do_i(i)) then ! botfn determines when a point is within the influence of the bottom ! boundary layer, going from 1 at the bottom to 0 in the interior. @@ -1738,30 +1671,17 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & ALLOC_(CS%a_v(isd:ied,JsdB:JedB,nz+1)) ; CS%a_v(:,:,:) = 0.0 ALLOC_(CS%h_v(isd:ied,JsdB:JedB,nz)) ; CS%h_v(:,:,:) = 0.0 - CS%id_Kv_slow = register_diag_field('ocean_model', 'Kv_slow', diag%axesTi, Time, & - 'Slow varying vertical viscosity', 'm2 s-1') - - CS%id_Kv_u = register_diag_field('ocean_model', 'Kv_u', diag%axesCuL, Time, & - 'Total vertical viscosity at u-points', 'm2 s-1') - - CS%id_Kv_v = register_diag_field('ocean_model', 'Kv_v', diag%axesCvL, Time, & - 'Total vertical viscosity at v-points', 'm2 s-1') - CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, & 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1') - CS%id_av_vv = register_diag_field('ocean_model', 'av_visc', diag%axesCvi, Time, & 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1') CS%id_h_u = register_diag_field('ocean_model', 'Hu_visc', diag%axesCuL, Time, & 'Thickness at Zonal Velocity Points for Viscosity', thickness_units) - CS%id_h_v = register_diag_field('ocean_model', 'Hv_visc', diag%axesCvL, Time, & 'Thickness at Meridional Velocity Points for Viscosity', thickness_units) - CS%id_hML_u = register_diag_field('ocean_model', 'HMLu_visc', diag%axesCu1, Time, & 'Mixed Layer Thickness at Zonal Velocity Points for Viscosity', thickness_units) - CS%id_hML_v = register_diag_field('ocean_model', 'HMLv_visc', diag%axesCv1, Time, & 'Mixed Layer Thickness at Meridional Velocity Points for Viscosity', thickness_units) From b33e7c598217c739892e5a81402979b87e3a8a81 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 16 May 2018 16:07:55 -0800 Subject: [PATCH 0293/1072] Insufficient testing of N-S OBCs for all options. --- src/core/MOM_open_boundary.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index ef40f0170c..38eb78b89a 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1814,10 +1814,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) J=segment%HI%JsdB allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) do k=1,nz - rx_tangential(segment%HI%IsdB,J,k) = segment%rx_normal(segment%HI%isd,J,k) - rx_tangential(segment%HI%IedB,J,k) = segment%rx_normal(segment%HI%ied,J,k) + rx_tangential(segment%HI%IsdB,J,k) = segment%ry_normal(segment%HI%isd,J,k) + rx_tangential(segment%HI%IedB,J,k) = segment%ry_normal(segment%HI%ied,J,k) do I=segment%HI%IsdB+1,segment%HI%IedB-1 - rx_tangential(I,J,k) = 0.5*(segment%rx_normal(i,J,k) + segment%rx_normal(i+1,J,k)) + rx_tangential(I,J,k) = 0.5*(segment%ry_normal(i,J,k) + segment%ry_normal(i+1,J,k)) enddo enddo if (segment%radiation_tan) then @@ -1925,10 +1925,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) J=segment%HI%JsdB allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) do k=1,nz - rx_tangential(segment%HI%IsdB,J,k) = segment%rx_normal(segment%HI%isd,J,k) - rx_tangential(segment%HI%IedB,J,k) = segment%rx_normal(segment%HI%ied,J,k) + rx_tangential(segment%HI%IsdB,J,k) = segment%ry_normal(segment%HI%isd,J,k) + rx_tangential(segment%HI%IedB,J,k) = segment%ry_normal(segment%HI%ied,J,k) do I=segment%HI%IsdB+1,segment%HI%IedB-1 - rx_tangential(I,J,k) = 0.5*(segment%rx_normal(i,J,k) + segment%rx_normal(i+1,J,k)) + rx_tangential(I,J,k) = 0.5*(segment%ry_normal(i,J,k) + segment%ry_normal(i+1,J,k)) enddo enddo if (segment%radiation_tan) then From 0459742777de175e8f034048566af1d75e254380 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 25 May 2018 09:47:43 -0400 Subject: [PATCH 0294/1072] Make diabatic_CS private again - The creation of legacy_diabatic() was made by putting it into a separate module which require making members of diabatic_CS public. - I've moved legacy_diabatic() into MOM_diabatic_driver.F90 and made diabatic_CS private. This also removes some duplicated code for diagnostics. --- src/core/MOM.F90 | 2 +- .../vertical/MOM_diabatic_driver.F90 | 1300 ++++++++++++- .../vertical/MOM_legacy_diabatic_driver.F90 | 1660 ----------------- 3 files changed, 1297 insertions(+), 1665 deletions(-) delete mode 100644 src/parameterizations/vertical/MOM_legacy_diabatic_driver.F90 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 9b70b81415..74169f6a45 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -52,9 +52,9 @@ module MOM use MOM_ALE, only : ALE_getCoordinate, ALE_getCoordinateUnits, ALE_writeCoordinateFile use MOM_ALE, only : ALE_updateVerticalGridType, ALE_remap_init_conds, ALE_register_diags use MOM_boundary_update, only : call_OBC_register, OBC_register_end, update_OBC_CS -use MOM_legacy_diabatic_driver,only : legacy_diabatic use MOM_diabatic_driver, only : diabatic, diabatic_driver_init, diabatic_CS use MOM_diabatic_driver, only : adiabatic, adiabatic_driver_init, diabatic_driver_end +use MOM_diabatic_driver, only : legacy_diabatic use MOM_diagnostics, only : calculate_diagnostic_fields, MOM_diagnostics_init use MOM_diagnostics, only : register_transport_diags, post_transport_diagnostics use MOM_diagnostics, only : register_surface_diags, write_static_fields diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 6316fd40e6..b931e4e224 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -82,12 +82,10 @@ module MOM_diabatic_driver public extract_diabatic_member public adiabatic public adiabatic_driver_init +public legacy_diabatic !> Control structure for this module -! GMM, I've made the following type public so it work with the legacy version of -! diabatic. This type should be made private once the legacy code is deleted. -!type, public:: diabatic_CS; private -type, public:: diabatic_CS +type, public:: diabatic_CS; private logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with !! nkml sublayers (and additional buffer layers). logical :: use_energetic_PBL !< If true, use the implicit energetics planetary @@ -1559,6 +1557,1300 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & end subroutine diabatic +!> Imposes the diapycnal mass fluxes and the accompanying diapycnal advection of momentum and tracers +!! using the original MOM6 algorithms. +subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, CS, WAVES) + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity (m/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity (m/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness (m for Bouss / kg/m2 for non-Bouss) + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields + !! unused have NULL ptrs + real, dimension(:,:), pointer :: Hml !< active mixed layer depth + type(forcing), intent(inout) :: fluxes !< points to forcing fields + !! unused fields have NULL ptrs + type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and + type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum + !! equations, to enable the later derived + !! diagnostics, like energy budgets + type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations + real, intent(in) :: dt !< time increment (seconds) + type(time_type), intent(in) :: Time_end !< Time at the end of the interval + type(diabatic_CS), pointer :: CS !< module control structure + type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + ea, & ! amount of fluid entrained from the layer above within + ! one time step (m for Bouss, kg/m^2 for non-Bouss) + eb, & ! amount of fluid entrained from the layer below within + ! one time step (m for Bouss, kg/m^2 for non-Bouss) + Kd, & ! diapycnal diffusivity of layers (m^2/sec) + h_orig, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) + h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) + hold, & ! layer thickness before diapycnal entrainment, and later + ! the initial layer thicknesses (if a mixed layer is used), + ! (m for Bouss, kg/m^2 for non-Bouss) + dSV_dT, & ! The partial derivatives of specific volume with temperature + dSV_dS, & ! and salinity in m^3/(kg K) and m^3/(kg ppt). + cTKE, & ! convective TKE requirements for each layer in J/m^2. + u_h, & ! zonal and meridional velocities at thickness points after + v_h ! entrainment (m/s) + + real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & + cn ! baroclinic gravity wave speeds (formerly cg1 - BDM) + + real, dimension(SZI_(G),SZJ_(G)) :: & + Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges + SkinBuoyFlux! 2d surface buoyancy flux (m2/s3), used by ePBL + real, dimension(SZI_(G),SZJ_(G),G%ke) :: h_diag ! diagnostic array for thickness + real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp + real, dimension(SZI_(G),SZJ_(G),G%ke) :: saln_diag ! diagnostic array for salinity + real, dimension(SZI_(G),SZJ_(G)) :: tendency_2d ! depth integrated content tendency for diagn + real, dimension(SZI_(G),SZJ_(G)) :: TKE_itidal_input_test ! override of energy input for testing (BDM) + + real :: net_ent ! The net of ea-eb at an interface. + + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & + ! These are targets so that the space can be shared with eaml & ebml. + eatr, & ! The equivalent of ea and eb for tracers, which differ from ea and + ebtr ! eb in that they tend to homogenize tracers in massless layers + ! near the boundaries (m for Bouss and kg/m^2 for non-Bouss) + + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & + Kd_int, & ! diapycnal diffusivity of interfaces (m^2/s) + Kd_heat, & ! diapycnal diffusivity of heat (m^2/s) + Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (m^2/s) + Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (m^2/s) + eta, & ! Interface heights before diapycnal mixing, in m. + Tdif_flx, & ! diffusive diapycnal heat flux across interfaces (K m/s) + Tadv_flx, & ! advective diapycnal heat flux across interfaces (K m/s) + Sdif_flx, & ! diffusive diapycnal salt flux across interfaces (ppt m/s) + Sadv_flx ! advective diapycnal salt flux across interfaces (ppt m/s) + + ! The following 5 variables are only used with a bulk mixed layer. + real, pointer, dimension(:,:,:) :: & + eaml, & ! The equivalent of ea and eb due to mixed layer processes, + ebml ! (m for Bouss and kg/m^2 for non-Bouss). These will be + ! pointers to eatr and ebtr so as to reuse the memory as + ! the arrays are not needed at the same time. + + integer :: kb(SZI_(G),SZJ_(G)) ! index of the lightest layer denser + ! than the buffer laye (nondimensional) + + real :: p_ref_cv(SZI_(G)) ! Reference pressure for the potential + ! density which defines the coordinate + ! variable, set to P_Ref, in Pa. + + logical :: in_boundary(SZI_(G)) ! True if there are no massive layers below, + ! where massive is defined as sufficiently thick that + ! the no-flux boundary conditions have not restricted + ! the entrainment - usually sqrt(Kd*dt). + + real :: b_denom_1 ! The first term in the denominator of b1 + ! (m for Bouss, kg/m^2 for non-Bouss) + real :: h_neglect ! A thickness that is so small it is usually lost + ! in roundoff and can be neglected + ! (m for Bouss and kg/m^2 for non-Bouss) + real :: h_neglect2 ! h_neglect^2 (m^2 for Bouss, kg^2/m^4 for non-Bouss) + real :: add_ent ! Entrainment that needs to be added when mixing tracers + ! (m for Bouss and kg/m^2 for non-Bouss) + real :: eaval ! eaval is 2*ea at velocity grid points (m for Bouss, kg/m^2 for non-Bouss) + real :: hval ! hval is 2*h at velocity grid points (m for Bouss, kg/m^2 for non-Bouss) + real :: h_tr ! h_tr is h at tracer points with a tiny thickness + ! added to ensure positive definiteness (m for Bouss, kg/m^2 for non-Bouss) + real :: Tr_ea_BBL ! The diffusive tracer thickness in the BBL that is + ! coupled to the bottom within a timestep (m) + + real :: htot(SZIB_(G)) ! The summed thickness from the bottom, in m. + real :: b1(SZIB_(G)), d1(SZIB_(G)) ! b1, c1, and d1 are variables used by the + real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. + + real :: Ent_int ! The diffusive entrainment rate at an interface + ! (H units = m for Bouss, kg/m^2 for non-Bouss). + real :: dt_mix ! amount of time over which to apply mixing (seconds) + real :: Idt ! inverse time step (1/s) + + type(p3d) :: z_ptrs(7) ! pointers to diagnostics to be interpolated to depth + integer :: num_z_diags ! number of diagnostics to be interpolated to depth + integer :: z_ids(7) ! id numbers of diagnostics to be interpolated to depth + integer :: dir_flag ! An integer encoding the directions in which to do halo updates. + logical :: showCallTree ! If true, show the call tree + integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m + + integer :: ig, jg ! global indices for testing testing itide point source (BDM) + logical :: avg_enabled ! for testing internal tides (BDM) + real :: Kd_add_here ! An added diffusivity in m2/s + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + nkmb = GV%nk_rho_varies + h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect*h_neglect + Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 + + + if (nz == 1) return + showCallTree = callTree_showQuery() + if (showCallTree) call callTree_enter("diabatic(), MOM_diabatic_driver.F90") + + ! Offer diagnostics of various state varables at the start of diabatic + ! these are mostly for debugging purposes. + if (CS%id_u_predia > 0) call post_data(CS%id_u_predia, u, CS%diag) + if (CS%id_v_predia > 0) call post_data(CS%id_v_predia, v, CS%diag) + if (CS%id_h_predia > 0) call post_data(CS%id_h_predia, h, CS%diag) + if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) + if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) + if (CS%id_e_predia > 0) then + call find_eta(h, tv, GV%g_Earth, G, GV, eta) + call post_data(CS%id_e_predia, eta, CS%diag) + endif + + ! set equivalence between the same bits of memory for these arrays + eaml => eatr ; ebml => ebtr + + ! inverse time step + Idt = 1.0 / dt + + if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & + "Module must be initialized before it is used.") + + if (CS%debug) then + call MOM_state_chksum("Start of diabatic ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("Start of diabatic", fluxes, G, haloshift=0) + endif + if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G) + + if (CS%debug_energy_req) & + call diapyc_energy_req_test(h, dt, tv, G, GV, CS%diapyc_en_rec_CSp) + + + call cpu_clock_begin(id_clock_set_diffusivity) + call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS%set_diff_CSp) + call cpu_clock_end(id_clock_set_diffusivity) + + ! Frazil formation keeps the temperature above the freezing point. + ! make_frazil is deliberately called at both the beginning and at + ! the end of the diabatic processes. + if (associated(tv%T) .AND. associated(tv%frazil)) then + ! For frazil diagnostic, the first call covers the first half of the time step + call enable_averaging(0.5*dt, Time_end - set_time(int(floor(0.5*dt+0.5))), CS%diag) + if (CS%frazil_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + temp_diag(i,j,k) = tv%T(i,j,k) + enddo ; enddo ; enddo + endif + + if (associated(fluxes%p_surf_full)) then + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) + else + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) + endif + if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)") + + if (CS%frazil_tendency_diag) then + call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) + if (CS%id_frazil_h > 0) call post_data(CS%id_frazil_h, h, CS%diag) + endif + call disable_averaging(CS%diag) + endif + ! For all other diabatic subroutines, the averaging window should be the entire diabatic timestep + call enable_averaging(dt, Time_end, CS%diag) + if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) + + if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then +!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_orig,h,eaml,ebml) + do k=1,nz ; do j=js,je ; do i=is,ie + h_orig(i,j,k) = h(i,j,k) ; eaml(i,j,k) = 0.0 ; ebml(i,j,k) = 0.0 + enddo ; enddo ; enddo + endif + + if (CS%use_geothermal) then + call cpu_clock_begin(id_clock_geothermal) + call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp) + call cpu_clock_end(id_clock_geothermal) + if (showCallTree) call callTree_waypoint("geothermal (diabatic)") + if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G) + endif + + ! Whenever thickness changes let the diag manager know, target grids + ! for vertical remapping may need to be regenerated. + call diag_update_remap_grids(CS%diag) + + ! Set_opacity estimates the optical properties of the water column. + ! It will need to be modified later to include information about the + ! biological properties and layer thicknesses. + if (associated(CS%optics)) & + call set_opacity(CS%optics, fluxes, G, GV, CS%opacity_CSp) + + if (CS%bulkmixedlayer) then + if (CS%debug) then + call MOM_forcing_chksum("Before mixedlayer", fluxes, G, haloshift=0) + endif + + if (CS%ML_mix_first > 0.0) then +! This subroutine +! (1) Cools the mixed layer. +! (2) Performs convective adjustment by mixed layer entrainment. +! (3) Heats the mixed layer and causes it to detrain to +! Monin-Obukhov depth or minimum mixed layer depth. +! (4) Uses any remaining TKE to drive mixed layer entrainment. +! (5) Possibly splits buffer layer into two isopycnal layers (when using isopycnal coordinate) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + + call cpu_clock_begin(id_clock_mixedlayer) + if (CS%ML_mix_first < 1.0) then + ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) + call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt*CS%ML_mix_first, & + eaml,ebml, G, GV, CS%bulkmixedlayer_CSp, CS%optics, & + Hml, CS%aggregate_FW_forcing, dt, last_call=.false.) + if (CS%salt_reject_below_ML) & + call insert_brine(h, tv, G, GV, fluxes, nkmb, CS%diabatic_aux_CSp, & + dt*CS%ML_mix_first, CS%id_brine_lay) + else + ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) + call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt, eaml, ebml, & + G, GV, CS%bulkmixedlayer_CSp, CS%optics, & + Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) + endif + + ! Keep salinity from falling below a small but positive threshold. + ! This constraint is needed for SIS1 ice model, which can extract + ! more salt than is present in the ocean. SIS2 does not suffer + ! from this limitation, in which case we can let salinity=0 and still + ! have salt conserved with SIS2 ice. So for SIS2, we can run with + ! BOUND_SALINITY=False in MOM.F90. + if (associated(tv%S) .and. associated(tv%salt_deficit)) & + call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) + call cpu_clock_end(id_clock_mixedlayer) + if (CS%debug) then + call MOM_state_chksum("After mixedlayer ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("After mixedlayer", fluxes, G, haloshift=0) + endif + if (showCallTree) call callTree_waypoint("done with 1st bulkmixedlayer (diabatic)") + if (CS%debugConservation) call MOM_state_stats('1st bulkmixedlayer', u, v, h, tv%T, tv%S, G) + endif + endif + + if (CS%debug) then + call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) + endif + if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then + if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then + call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eaml, ebml) + if (CS%debug) then + call hchksum(eaml, "after find_uv_at_h eaml",G%HI, scale=GV%H_to_m) + call hchksum(ebml, "after find_uv_at_h ebml",G%HI, scale=GV%H_to_m) + endif + else + call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + endif + if (showCallTree) call callTree_waypoint("done with find_uv_at_h (diabatic)") + endif + + if (CS%use_int_tides) then + ! This block provides an interface for the unresolved low-mode internal + ! tide module (BDM). + + ! PROVIDE ENERGY DISTRIBUTION (calculate time-varying energy source) + call set_int_tide_input(u, v, h, tv, fluxes, CS%int_tide_input, dt, G, GV, & + CS%int_tide_input_CSp) + ! CALCULATE MODAL VELOCITIES + cn(:,:,:) = 0.0 + if (CS%uniform_cg) then + ! SET TO CONSTANT VALUE TO TEST PROPAGATE CODE + do m=1,CS%nMode ; cn(:,:,m) = CS%cg_test ; enddo + else + call wave_speeds(h, tv, G, GV, CS%nMode, cn, full_halos=.true.) + ! uncomment the lines below for a hard-coded cn that changes linearly with latitude + !do j=G%jsd,G%jed ; do i=G%isd,G%ied + ! cn(i,j,:) = ((7.-1.)/14000000.)*G%geoLatBu(i,j) + (1.-((7.-1.)/14000000.)*-7000000.) + !enddo ; enddo + endif + + if (CS%int_tide_source_test) then + ! BUILD 2D ARRAY WITH POINT SOURCE FOR TESTING + ! This block of code should be moved into set_int_tide_input. -RWH + TKE_itidal_input_test(:,:) = 0.0 + avg_enabled = query_averaging_enabled(CS%diag,time_end=CS%time_end) + if (CS%time_end <= CS%time_max_source) then + do j=G%jsc,G%jec ; do i=G%isc,G%iec + !INPUT ARBITRARY ENERGY POINT SOURCE + if ((G%idg_offset + i == CS%int_tide_source_x) .and. & + (G%jdg_offset + j == CS%int_tide_source_y)) then + TKE_itidal_input_test(i,j) = 1.0 + endif + enddo ; enddo + endif + ! CALL ROUTINE USING PRESCRIBED KE FOR TESTING + call propagate_int_tide(h, tv, cn, TKE_itidal_input_test, & + CS%int_tide_input%tideamp, CS%int_tide_input%Nb, dt, G, GV, CS%int_tide_CSp) + else + ! CALL ROUTINE USING CALCULATED KE INPUT + call propagate_int_tide(h, tv, cn, CS%int_tide_input%TKE_itidal_input, & + CS%int_tide_input%tideamp, CS%int_tide_input%Nb, dt, G, GV, CS%int_tide_CSp) + endif + if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") + endif + + call cpu_clock_begin(id_clock_set_diffusivity) + ! Sets: Kd, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S + ! Also changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ???? + ! And sets visc%Kv_shear + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, CS%set_diff_CSp, Kd, Kd_int) + call cpu_clock_end(id_clock_set_diffusivity) + if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") + + if (CS%debug) then + call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, haloshift=0) + call MOM_thermovar_chksum("after set_diffusivity ", tv, G) + call hchksum(Kd, "after set_diffusivity Kd",G%HI,haloshift=0) + call hchksum(Kd_Int, "after set_diffusivity Kd_Int",G%HI,haloshift=0) + endif + + + if (CS%useKPP) then + call cpu_clock_begin(id_clock_kpp) + ! KPP needs the surface buoyancy flux but does not update state variables. + ! We could make this call higher up to avoid a repeat unpacking of the surface fluxes. + ! Sets: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux + ! NOTE: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux are returned as rates (i.e. stuff per second) + ! unlike other instances where the fluxes are integrated in time over a time-step. + call calculateBuoyancyFlux2d(G, GV, fluxes, CS%optics, h, tv%T, tv%S, tv, & + CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) + ! The KPP scheme calculates boundary layer diffusivities and non-local transport. + ! MOM6 implementation of KPP matches the boundary layer to zero interior diffusivity, + ! since the matching to nonzero interior diffusivity can be problematic. + ! Changes: Kd_int. Sets: KPP_NLTheat, KPP_NLTscalar + +!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,Kd_heat) +!$OMP do + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_salt(i,j,k) = Kd_int(i,j,k) + Kd_heat(i,j,k) = Kd_int(i,j,k) + enddo ; enddo ; enddo + if (associated(visc%Kd_extra_S)) then +!$OMP do + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_salt(i,j,k) = Kd_salt(i,j,k) + visc%Kd_extra_S(i,j,k) + enddo ; enddo ; enddo + endif + if (associated(visc%Kd_extra_T)) then +!$OMP do + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k) + enddo ; enddo ; enddo + endif +!$OMP end parallel + + call KPP_compute_BLD(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, & + fluxes%ustar, CS%KPP_buoy_flux) + + call KPP_calculate(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, & + fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, & + CS%KPP_NLTscalar, Waves=Waves) +!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,G,Kd_heat,Hml) + + if (associated(Hml)) then + call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G) + call pass_var(Hml, G%domain, halo=1) + endif + + if (.not. CS%KPPisPassive) then +!$OMP do + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_int(i,j,k) = min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) + enddo ; enddo ; enddo + if (associated(visc%Kd_extra_S)) then +!$OMP do + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kd_extra_S(i,j,k) = Kd_salt(i,j,k) - Kd_int(i,j,k) + enddo ; enddo ; enddo + endif + if (associated(visc%Kd_extra_T)) then +!$OMP do + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kd_extra_T(i,j,k) = Kd_heat(i,j,k) - Kd_int(i,j,k) + enddo ; enddo ; enddo + endif + endif ! not passive +!$OMP end parallel + call cpu_clock_end(id_clock_kpp) + if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") + if (CS%debug) then + call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("after KPP", fluxes, G, haloshift=0) + call MOM_thermovar_chksum("after KPP", tv, G) + call hchksum(Kd, "after KPP Kd",G%HI,haloshift=0) + call hchksum(Kd_Int, "after KPP Kd_Int",G%HI,haloshift=0) + endif + + endif ! endif for KPP + + ! Add vertical diff./visc. due to convection (computed via CVMix) + if (CS%use_CVMix_conv) then + call calculate_CVMix_conv(h, tv, G, GV, CS%CVMix_conv_csp, Hml) + + !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + do k=1,nz ; do j=js,je ; do i=is,ie + Kd_int(i,j,k) = Kd_int(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) + visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) + enddo ; enddo ; enddo + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + endif + + if (CS%useKPP) then + + call cpu_clock_begin(id_clock_kpp) + if (CS%debug) then + call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat",G%HI,haloshift=0) + call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar",G%HI,haloshift=0) + endif + ! Apply non-local transport of heat and salt + ! Changes: tv%T, tv%S + call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, dt, tv%T, tv%C_p) + call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, dt, tv%S) + call cpu_clock_end(id_clock_kpp) + if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") + if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G) + + if (CS%debug) then + call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, haloshift=0) + call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) + endif + + endif ! endif for KPP + + ! Differential diffusion done here. + ! Changes: tv%T, tv%S + ! If using matching within the KPP scheme, then this step needs to provide + ! a diffusivity and happen before KPP. But generally in MOM, we do not match + ! KPP boundary layer to interior, so this diffusivity can be computed when convenient. + if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T)) then + call cpu_clock_begin(id_clock_differential_diff) + + call differential_diffuse_T_S(h, tv, visc, dt, G, GV) + call cpu_clock_end(id_clock_differential_diff) + if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") + if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G) + + ! increment heat and salt diffusivity. + ! CS%useKPP==.true. already has extra_T and extra_S included + if (.not. CS%useKPP) then + do K=2,nz ; do j=js,je ; do i=is,ie + Kd_heat(i,j,K) = Kd_heat(i,j,K) + visc%Kd_extra_T(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + visc%Kd_extra_S(i,j,K) + enddo ; enddo ; enddo + endif + + endif + + ! This block sets ea, eb from Kd or Kd_int. + ! If using ALE algorithm, set ea=eb=Kd_int on interfaces for + ! use in the tri-diagonal solver. + ! Otherwise, call entrainment_diffusive() which sets ea and eb + ! based on KD and target densities (ie. does remapping as well). + if (CS%useALEalgorithm) then + + do j=js,je ; do i=is,ie + ea(i,j,1) = 0. + enddo ; enddo +!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_neglect,h,ea,GV,dt,Kd_int,eb) & +!$OMP private(hval) + do k=2,nz ; do j=js,je ; do i=is,ie + hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) + ea(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_int(i,j,k) + eb(i,j,k-1) = ea(i,j,k) + enddo ; enddo ; enddo + do j=js,je ; do i=is,ie + eb(i,j,nz) = 0. + enddo ; enddo + if (showCallTree) call callTree_waypoint("done setting ea,eb from Kd_int (diabatic)") + + else ! .not. CS%useALEalgorithm + ! When not using ALE, calculate layer entrainments/detrainments from + ! diffusivities and differences between layer and target densities + call cpu_clock_begin(id_clock_entrain) + ! Calculate appropriately limited diapycnal mass fluxes to account + ! for diapycnal diffusion and advection. Sets: ea, eb. Changes: kb + call Entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS%entrain_diffusive_CSp, & + ea, eb, kb, Kd_Lay=Kd, Kd_int=Kd_int) + call cpu_clock_end(id_clock_entrain) + if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)") + + endif ! endif for (CS%useALEalgorithm) + + if (CS%debug) then + call MOM_forcing_chksum("after calc_entrain ", fluxes, G, haloshift=0) + call MOM_thermovar_chksum("after calc_entrain ", tv, G) + call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, haloshift=0) + call hchksum(ea, "after calc_entrain ea", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(eb, "after calc_entrain eb", G%HI, haloshift=0, scale=GV%H_to_m) + endif + + ! Save fields before boundary forcing is applied for tendency diagnostics + if (CS%boundary_forcing_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + h_diag(i,j,k) = h(i,j,k) + temp_diag(i,j,k) = tv%T(i,j,k) + saln_diag(i,j,k) = tv%S(i,j,k) + enddo ; enddo ; enddo + endif + + ! Apply forcing when using the ALE algorithm + if (CS%useALEalgorithm) then + call cpu_clock_begin(id_clock_remap) + + ! Changes made to following fields: h, tv%T and tv%S. + + do k=1,nz ; do j=js,je ; do i=is,ie + h_prebound(i,j,k) = h(i,j,k) + enddo ; enddo ; enddo + if (CS%use_energetic_PBL) then + + skinbuoyflux(:,:) = 0.0 + call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, dt, fluxes, CS%optics, & + h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & + CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux) + + if (CS%debug) then + call hchksum(ea, "after applyBoundaryFluxes ea",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb, "after applyBoundaryFluxes eb",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(cTKE, "after applyBoundaryFluxes cTKE",G%HI,haloshift=0) + call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT",G%HI,haloshift=0) + call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS",G%HI,haloshift=0) + endif + + call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, & + CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + + ! If visc%MLD exists, copy the ePBL's MLD into it + if (associated(visc%MLD)) then + call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G) + call pass_var(visc%MLD, G%domain, halo=1) + Hml(:,:) = visc%MLD(:,:) + endif + + ! Augment the diffusivities due to those diagnosed in energetic_PBL. + do K=2,nz ; do j=js,je ; do i=is,ie + + if (CS%ePBL_is_additive) then + Kd_add_here = Kd_ePBL(i,j,K) + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) + else + Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) + visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) + endif + Ent_int = Kd_add_here * (GV%m_to_H**2 * dt) / & + (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) + eb(i,j,k-1) = eb(i,j,k-1) + Ent_int + ea(i,j,k) = ea(i,j,k) + Ent_int + Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here + + ! for diagnostics + Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_int(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_int(i,j,K) + + enddo ; enddo ; enddo + + if (CS%debug) then + call hchksum(ea, "after ePBL ea",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb, "after ePBL eb",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL",G%HI,haloshift=0) + endif + + else + call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, dt, fluxes, CS%optics, & + h, tv, CS%aggregate_FW_forcing, & + CS%evap_CFL_limit, CS%minimum_forcing_depth) + + endif ! endif for CS%use_energetic_PBL + + ! diagnose the tendencies due to boundary forcing + ! At this point, the diagnostic grids have not been updated since the call to the boundary layer scheme + ! so all tendency diagnostics need to be posted on h_diag, and grids rebuilt afterwards + if (CS%boundary_forcing_tendency_diag) then + call diagnose_boundary_forcing_tendency(tv, h, temp_diag, saln_diag, h_diag, dt, G, GV, CS) + if (CS%id_boundary_forcing_h > 0) call post_data(CS%id_boundary_forcing_h, h, CS%diag, alt_h = h_diag) + endif + ! Boundary fluxes may have changed T, S, and h + call diag_update_remap_grids(CS%diag) + + call cpu_clock_end(id_clock_remap) + if (CS%debug) then + call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, haloshift=0) + call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G) + call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, haloshift=0) + endif + if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") + if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G) + + endif ! endif for (CS%useALEalgorithm) + + ! Update h according to divergence of the difference between + ! ea and eb. We keep a record of the original h in hold. + ! In the following, the checks for negative values are to guard + ! against instances where entrainment drives a layer to + ! negative thickness. This situation will never happen if + ! enough iterations are permitted in Calculate_Entrainment. + ! Even if too few iterations are allowed, it is still guarded + ! against. In other words the checks are probably unnecessary. + !$OMP parallel do default(shared) + do j=js,je + do i=is,ie + hold(i,j,1) = h(i,j,1) + h(i,j,1) = h(i,j,1) + (eb(i,j,1) - ea(i,j,2)) + hold(i,j,nz) = h(i,j,nz) + h(i,j,nz) = h(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)) + if (h(i,j,1) <= 0.0) then + h(i,j,1) = GV%Angstrom + endif + if (h(i,j,nz) <= 0.0) then + h(i,j,nz) = GV%Angstrom + endif + enddo + do k=2,nz-1 ; do i=is,ie + hold(i,j,k) = h(i,j,k) + h(i,j,k) = h(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & + (eb(i,j,k) - ea(i,j,k+1))) + if (h(i,j,k) <= 0.0) then + h(i,j,k) = GV%Angstrom + endif + enddo ; enddo + enddo + ! Checks for negative thickness may have changed layer thicknesses + call diag_update_remap_grids(CS%diag) + + if (CS%debug) then + call MOM_state_chksum("after negative check ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("after negative check ", fluxes, G, haloshift=0) + call MOM_thermovar_chksum("after negative check ", tv, G) + endif + if (showCallTree) call callTree_waypoint("done with h=ea-eb (diabatic)") + if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G) + + ! Here, T and S are updated according to ea and eb. + ! If using the bulk mixed layer, T and S are also updated + ! by surface fluxes (in fluxes%*). + ! This is a very long block. + if (CS%bulkmixedlayer) then + + if (associated(tv%T)) then + call cpu_clock_begin(id_clock_tridiag) + ! Temperature and salinity (as state variables) are treated + ! differently from other tracers to insure massless layers that + ! are lighter than the mixed layer have temperatures and salinities + ! that correspond to their prescribed densities. + if (CS%massless_match_targets) then + !$OMP parallel do default (shared) private(h_tr,b1,d1,c1,b_denom_1) + do j=js,je + do i=is,ie + h_tr = hold(i,j,1) + h_neglect + b1(i) = 1.0 / (h_tr + eb(i,j,1)) + d1(i) = h_tr * b1(i) + tv%T(i,j,1) = b1(i) * (h_tr*tv%T(i,j,1)) + tv%S(i,j,1) = b1(i) * (h_tr*tv%S(i,j,1)) + enddo + do k=2,nkmb ; do i=is,ie + c1(i,k) = eb(i,j,k-1) * b1(i) + h_tr = hold(i,j,k) + h_neglect + b_denom_1 = h_tr + d1(i)*ea(i,j,k) + b1(i) = 1.0 / (b_denom_1 + eb(i,j,k)) + if (k kb(i,j)) then + c1(i,k) = eb(i,j,k-1) * b1(i) + h_tr = hold(i,j,k) + h_neglect + b_denom_1 = h_tr + d1(i)*ea(i,j,k) + b1(i) = 1.0 / (b_denom_1 + eb(i,j,k)) + d1(i) = b_denom_1 * b1(i) + tv%T(i,j,k) = b1(i) * (h_tr*tv%T(i,j,k) + ea(i,j,k)*tv%T(i,j,k-1)) + tv%S(i,j,k) = b1(i) * (h_tr*tv%S(i,j,k) + ea(i,j,k)*tv%S(i,j,k-1)) + elseif (eb(i,j,k) < eb(i,j,k-1)) then ! (note that k < kb(i,j)) + ! The bottommost buffer layer might entrain all the mass from some + ! of the interior layers that are thin and lighter in the coordinate + ! density than that buffer layer. The T and S of these newly + ! massless interior layers are unchanged. + tv%T(i,j,nkmb) = tv%T(i,j,nkmb) + b1(i) * (eb(i,j,k-1) - eb(i,j,k)) * tv%T(i,j,k) + tv%S(i,j,nkmb) = tv%S(i,j,nkmb) + b1(i) * (eb(i,j,k-1) - eb(i,j,k)) * tv%S(i,j,k) + endif + enddo ; enddo + + do k=nz-1,nkmb,-1 ; do i=is,ie + if (k >= kb(i,j)) then + tv%T(i,j,k) = tv%T(i,j,k) + c1(i,k+1)*tv%T(i,j,k+1) + tv%S(i,j,k) = tv%S(i,j,k) + c1(i,k+1)*tv%S(i,j,k+1) + endif + enddo ; enddo + do i=is,ie ; if (kb(i,j) <= nz) then + tv%T(i,j,nkmb) = tv%T(i,j,nkmb) + c1(i,kb(i,j))*tv%T(i,j,kb(i,j)) + tv%S(i,j,nkmb) = tv%S(i,j,nkmb) + c1(i,kb(i,j))*tv%S(i,j,kb(i,j)) + endif ; enddo + do k=nkmb-1,1,-1 ; do i=is,ie + tv%T(i,j,k) = tv%T(i,j,k) + c1(i,k+1)*tv%T(i,j,k+1) + tv%S(i,j,k) = tv%S(i,j,k) + c1(i,k+1)*tv%S(i,j,k+1) + enddo ; enddo + enddo ! end of j loop + else ! .not. massless_match_targets + ! This simpler form allows T & S to be too dense for the layers + ! between the buffer layers and the interior. + ! Changes: T, S + if (CS%tracer_tridiag) then + call tracer_vertdiff(hold, ea, eb, dt, tv%T, G, GV) + call tracer_vertdiff(hold, ea, eb, dt, tv%S, G, GV) + else + call triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, tv%T, tv%S) + endif + endif ! massless_match_targets + call cpu_clock_end(id_clock_tridiag) + + endif ! endif for associated(T) + if (CS%debugConservation) call MOM_state_stats('BML tridiag', u, v, h, tv%T, tv%S, G) + + if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then + ! The mixed layer code has already been called, but there is some needed + ! bookkeeping. + !$OMP parallel do default(shared) + do k=1,nz ; do j=js,je ; do i=is,ie + hold(i,j,k) = h_orig(i,j,k) + ea(i,j,k) = ea(i,j,k) + eaml(i,j,k) + eb(i,j,k) = eb(i,j,k) + ebml(i,j,k) + enddo ; enddo ; enddo + if (CS%debug) then + call hchksum(ea, "after ea = ea + eaml",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb, "after eb = eb + ebml",G%HI,haloshift=0, scale=GV%H_to_m) + endif + endif + + if (CS%ML_mix_first < 1.0) then + ! Call the mixed layer code now, perhaps for a second time. + ! This subroutine (1) Cools the mixed layer. + ! (2) Performs convective adjustment by mixed layer entrainment. + ! (3) Heats the mixed layer and causes it to detrain to + ! Monin-Obukhov depth or minimum mixed layer depth. + ! (4) Uses any remaining TKE to drive mixed layer entrainment. + ! (5) Possibly splits the buffer layer into two isopycnal layers. + + call find_uv_at_h(u, v, hold, u_h, v_h, G, GV, ea, eb) + if (CS%debug) call MOM_state_chksum("find_uv_at_h1 ", u, v, h, G, GV, haloshift=0) + + dt_mix = min(dt,dt*(1.0 - CS%ML_mix_first)) + call cpu_clock_begin(id_clock_mixedlayer) + ! Changes: h, tv%T, tv%S, ea and eb (G is also inout???) + call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_mix, ea, eb, & + G, GV, CS%bulkmixedlayer_CSp, CS%optics, & + Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) + + if (CS%salt_reject_below_ML) & + call insert_brine(h, tv, G, GV, fluxes, nkmb, CS%diabatic_aux_CSp, dt_mix, & + CS%id_brine_lay) + + ! Keep salinity from falling below a small but positive threshold. + ! This constraint is needed for SIS1 ice model, which can extract + ! more salt than is present in the ocean. SIS2 does not suffer + ! from this limitation, in which case we can let salinity=0 and still + ! have salt conserved with SIS2 ice. So for SIS2, we can run with + ! BOUND_SALINITY=False in MOM.F90. + if (associated(tv%S) .and. associated(tv%salt_deficit)) & + call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) + + call cpu_clock_end(id_clock_mixedlayer) + if (showCallTree) call callTree_waypoint("done with 2nd bulkmixedlayer (diabatic)") + if (CS%debugConservation) call MOM_state_stats('2nd bulkmixedlayer', u, v, h, tv%T, tv%S, G) + endif + + else ! following block for when NOT using BULKMIXEDLAYER + + ! calculate change in temperature & salinity due to dia-coordinate surface diffusion + if (associated(tv%T)) then + + if (CS%debug) then + call hchksum(ea, "before triDiagTS ea ",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb, "before triDiagTS eb ",G%HI,haloshift=0, scale=GV%H_to_m) + endif + call cpu_clock_begin(id_clock_tridiag) + + ! Keep salinity from falling below a small but positive threshold. + ! This constraint is needed for SIS1 ice model, which can extract + ! more salt than is present in the ocean. SIS2 does not suffer + ! from this limitation, in which case we can let salinity=0 and still + ! have salt conserved with SIS2 ice. So for SIS2, we can run with + ! BOUND_SALINITY=False in MOM.F90. + if (associated(tv%S) .and. associated(tv%salt_deficit)) & + call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) + + if (CS%diabatic_diff_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + temp_diag(i,j,k) = tv%T(i,j,k) + saln_diag(i,j,k) = tv%S(i,j,k) + enddo ; enddo ; enddo + endif + + ! Changes T and S via the tridiagonal solver; no change to h + if (CS%tracer_tridiag) then + call tracer_vertdiff(hold, ea, eb, dt, tv%T, G, GV) + call tracer_vertdiff(hold, ea, eb, dt, tv%S, G, GV) + else + call triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, tv%T, tv%S) + endif + + ! diagnose temperature, salinity, heat, and salt tendencies + ! Note: hold here refers to the thicknesses from before the dual-entraintment when using + ! the bulk mixed layer scheme. Otherwise in ALE-mode, layer thicknesses will have changed + ! In either case, tendencies should be posted on hold + if (CS%diabatic_diff_tendency_diag) then + call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, CS) + if (CS%id_diabatic_diff_h > 0) call post_data(CS%id_diabatic_diff_h, hold, CS%diag, alt_h = hold) + endif + + call cpu_clock_end(id_clock_tridiag) + if (showCallTree) call callTree_waypoint("done with triDiagTS (diabatic)") + + endif ! endif corresponding to if (associated(tv%T)) + if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G) + + endif ! endif for the BULKMIXEDLAYER block + + if (CS%debug) then + call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, haloshift=0) + call MOM_thermovar_chksum("after mixed layer ", tv, G) + call hchksum(ea, "after mixed layer ea", G%HI, scale=GV%H_to_m) + call hchksum(eb, "after mixed layer eb", G%HI, scale=GV%H_to_m) + endif + + if (.not. CS%useALEalgorithm) then + call cpu_clock_begin(id_clock_remap) + call regularize_layers(h, tv, dt, ea, eb, G, GV, CS%regularize_layers_CSp) + call cpu_clock_end(id_clock_remap) + if (showCallTree) call callTree_waypoint("done with regularize_layers (diabatic)") + if (CS%debugConservation) call MOM_state_stats('regularize_layers', u, v, h, tv%T, tv%S, G) + endif + + ! Whenever thickness changes let the diag manager know, as the + ! target grids for vertical remapping may need to be regenerated. + call diag_update_remap_grids(CS%diag) + + ! diagnostics + if ((CS%id_Tdif > 0) .or. (CS%id_Tdif_z > 0) .or. & + (CS%id_Tadv > 0) .or. (CS%id_Tadv_z > 0)) then + do j=js,je ; do i=is,ie + Tdif_flx(i,j,1) = 0.0 ; Tdif_flx(i,j,nz+1) = 0.0 + Tadv_flx(i,j,1) = 0.0 ; Tadv_flx(i,j,nz+1) = 0.0 + enddo ; enddo + !$OMP parallel do default(shared) + do K=2,nz ; do j=js,je ; do i=is,ie + Tdif_flx(i,j,K) = (Idt * 0.5*(ea(i,j,k) + eb(i,j,k-1))) * & + (tv%T(i,j,k-1) - tv%T(i,j,k)) + Tadv_flx(i,j,K) = (Idt * (ea(i,j,k) - eb(i,j,k-1))) * & + 0.5*(tv%T(i,j,k-1) + tv%T(i,j,k)) + enddo ; enddo ; enddo + endif + if ((CS%id_Sdif > 0) .or. (CS%id_Sdif_z > 0) .or. & + (CS%id_Sadv > 0) .or. (CS%id_Sadv_z > 0)) then + do j=js,je ; do i=is,ie + Sdif_flx(i,j,1) = 0.0 ; Sdif_flx(i,j,nz+1) = 0.0 + Sadv_flx(i,j,1) = 0.0 ; Sadv_flx(i,j,nz+1) = 0.0 + enddo ; enddo + !$OMP parallel do default(shared) + do K=2,nz ; do j=js,je ; do i=is,ie + Sdif_flx(i,j,K) = (Idt * 0.5*(ea(i,j,k) + eb(i,j,k-1))) * & + (tv%S(i,j,k-1) - tv%S(i,j,k)) + Sadv_flx(i,j,K) = (Idt * (ea(i,j,k) - eb(i,j,k-1))) * & + 0.5*(tv%S(i,j,k-1) + tv%S(i,j,k)) + enddo ; enddo ; enddo + endif + + ! mixing of passive tracers from massless boundary layers to interior + call cpu_clock_begin(id_clock_tracers) + if (CS%mix_boundary_tracers) then + Tr_ea_BBL = sqrt(dt*CS%Kd_BBL_tr) + !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) + do j=js,je + do i=is,ie + ebtr(i,j,nz) = eb(i,j,nz) + htot(i) = 0.0 + in_boundary(i) = (G%mask2dT(i,j) > 0.0) + enddo + do k=nz,2,-1 ; do i=is,ie + if (in_boundary(i)) then + htot(i) = htot(i) + h(i,j,k) + ! If diapycnal mixing has been suppressed because this is a massless + ! layer near the bottom, add some mixing of tracers between these + ! layers. This flux is based on the harmonic mean of the two + ! thicknesses, as this corresponds pretty closely (to within + ! differences in the density jumps between layers) with what is done + ! in the calculation of the fluxes in the first place. Kd_min_tr + ! should be much less than the values that have been set in Kd, + ! perhaps a molecular diffusivity. + add_ent = ((dt * CS%Kd_min_tr) * GV%m_to_H**2) * & + ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & + (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & + 0.5*(ea(i,j,k) + eb(i,j,k-1)) + if (htot(i) < Tr_ea_BBL) then + add_ent = max(0.0, add_ent, & + (Tr_ea_BBL - htot(i)) - min(ea(i,j,k),eb(i,j,k-1))) + elseif (add_ent < 0.0) then + add_ent = 0.0 ; in_boundary(i) = .false. + endif + + ebtr(i,j,k-1) = eb(i,j,k-1) + add_ent + eatr(i,j,k) = ea(i,j,k) + add_ent + else + ebtr(i,j,k-1) = eb(i,j,k-1) ; eatr(i,j,k) = ea(i,j,k) + endif + if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / & + (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & + h_neglect) + ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent + eatr(i,j,k) = eatr(i,j,k) + add_ent + endif ; endif + enddo ; enddo + do i=is,ie ; eatr(i,j,1) = ea(i,j,1) ; enddo + + enddo + + if (CS%useALEalgorithm) then + ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied + ! so hold should be h_orig + call call_tracer_column_fns(h_prebound, h, ea, eb, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug, & + evap_CFL_limit = CS%evap_CFL_limit, & + minimum_forcing_depth = CS%minimum_forcing_depth) + else + call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug) + endif + + elseif (associated(visc%Kd_extra_S)) then ! extra diffusivity for passive tracers + + do j=js,je ; do i=is,ie + ebtr(i,j,nz) = eb(i,j,nz) ; eatr(i,j,1) = ea(i,j,1) + enddo ; enddo + !$OMP parallel do default(shared) private(add_ent) + do k=nz,2,-1 ; do j=js,je ; do i=is,ie + if (visc%Kd_extra_S(i,j,k) > 0.0) then + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / & + (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & + h_neglect) + else + add_ent = 0.0 + endif + ebtr(i,j,k-1) = eb(i,j,k-1) + add_ent + eatr(i,j,k) = ea(i,j,k) + add_ent + enddo ; enddo ; enddo + + if (CS%useALEalgorithm) then + ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied + call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug,& + evap_CFL_limit = CS%evap_CFL_limit, & + minimum_forcing_depth = CS%minimum_forcing_depth) + else + call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug) + endif + + else + if (CS%useALEalgorithm) then + ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied + call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug, & + evap_CFL_limit = CS%evap_CFL_limit, & + minimum_forcing_depth = CS%minimum_forcing_depth) + else + call call_tracer_column_fns(hold, h, ea, eb, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug) + endif + + endif ! (CS%mix_boundary_tracers) + + call cpu_clock_end(id_clock_tracers) + + ! sponges + if (CS%use_sponge) then + call cpu_clock_begin(id_clock_sponge) + if (associated(CS%ALE_sponge_CSp)) then + ! ALE sponge + call apply_ALE_sponge(h, dt, G, CS%ALE_sponge_CSp, CS%Time) + else + ! Layer mode sponge + if (CS%bulkmixedlayer .and. associated(tv%eqn_of_state)) then + do i=is,ie ; p_ref_cv(i) = tv%P_Ref ; enddo + !$OMP parallel do default(shared) + do j=js,je + call calculate_density(tv%T(:,j,1), tv%S(:,j,1), p_ref_cv, Rcv_ml(:,j), & + is, ie-is+1, tv%eqn_of_state) + enddo + call apply_sponge(h, dt, G, GV, ea, eb, CS%sponge_CSp, Rcv_ml) + else + call apply_sponge(h, dt, G, GV, ea, eb, CS%sponge_CSp) + endif + endif + call cpu_clock_end(id_clock_sponge) + if (CS%debug) then + call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, haloshift=0) + call MOM_thermovar_chksum("apply_sponge ", tv, G) + endif + endif ! CS%use_sponge + +! Save the diapycnal mass fluxes as a diagnostic field. + if (associated(CDp%diapyc_vel)) then + !$OMP parallel do default(shared) + do j=js,je + do K=2,nz ; do i=is,ie + CDp%diapyc_vel(i,j,K) = Idt * (GV%H_to_m * (ea(i,j,k) - eb(i,j,k-1))) + enddo ; enddo + do i=is,ie + CDp%diapyc_vel(i,j,1) = 0.0 + CDp%diapyc_vel(i,j,nz+1) = 0.0 + enddo + enddo + endif + +! For momentum, it is only the net flux that homogenizes within +! the mixed layer. Vertical viscosity that is proportional to the +! mixed layer turbulence is applied elsewhere. + if (CS%bulkmixedlayer) then + if (CS%debug) then + call hchksum(ea, "before net flux rearrangement ea",G%HI, scale=GV%H_to_m) + call hchksum(eb, "before net flux rearrangement eb",G%HI, scale=GV%H_to_m) + endif + !$OMP parallel do default(shared) private(net_ent) + do j=js,je + do K=2,GV%nkml ; do i=is,ie + net_ent = ea(i,j,k) - eb(i,j,k-1) + ea(i,j,k) = max(net_ent, 0.0) + eb(i,j,k-1) = max(-net_ent, 0.0) + enddo ; enddo + enddo + if (CS%debug) then + call hchksum(ea, "after net flux rearrangement ea",G%HI, scale=GV%H_to_m) + call hchksum(eb, "after net flux rearrangement eb",G%HI, scale=GV%H_to_m) + endif + endif + +! Initialize halo regions of ea, eb, and hold to default values. + !$OMP parallel do default(shared) + do k=1,nz + do i=is-1,ie+1 + hold(i,js-1,k) = GV%Angstrom ; ea(i,js-1,k) = 0.0 ; eb(i,js-1,k) = 0.0 + hold(i,je+1,k) = GV%Angstrom ; ea(i,je+1,k) = 0.0 ; eb(i,je+1,k) = 0.0 + enddo + do j=js,je + hold(is-1,j,k) = GV%Angstrom ; ea(is-1,j,k) = 0.0 ; eb(is-1,j,k) = 0.0 + hold(ie+1,j,k) = GV%Angstrom ; ea(ie+1,j,k) = 0.0 ; eb(ie+1,j,k) = 0.0 + enddo + enddo + + call cpu_clock_begin(id_clock_pass) + if (G%symmetric) then ; dir_flag = To_All+Omit_Corners + else ; dir_flag = To_West+To_South+Omit_Corners ; endif + call create_group_pass(CS%pass_hold_eb_ea, hold, G%Domain, dir_flag, halo=1) + call create_group_pass(CS%pass_hold_eb_ea, eb, G%Domain, dir_flag, halo=1) + call create_group_pass(CS%pass_hold_eb_ea, ea, G%Domain, dir_flag, halo=1) + call do_group_pass(CS%pass_hold_eb_ea, G%Domain) + ! visc%Kv_shear is not in the group pass because it has larger vertical extent. + if (associated(visc%Kv_shear)) & + call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) + call cpu_clock_end(id_clock_pass) + + if (.not. CS%useALEalgorithm) then + ! Use a tridiagonal solver to determine effect of the diapycnal + ! advection on velocity field. It is assumed that water leaves + ! or enters the ocean with the surface velocity. + if (CS%debug) then + call MOM_state_chksum("before u/v tridiag ", u, v, h, G, GV, haloshift=0) + call hchksum(ea, "before u/v tridiag ea",G%HI, scale=GV%H_to_m) + call hchksum(eb, "before u/v tridiag eb",G%HI, scale=GV%H_to_m) + call hchksum(hold, "before u/v tridiag hold",G%HI, scale=GV%H_to_m) + endif + call cpu_clock_begin(id_clock_tridiag) + !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) + do j=js,je + do I=Isq,Ieq + if (associated(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,1) = u(I,j,1) + hval = (hold(i,j,1) + hold(i+1,j,1)) + (ea(i,j,1) + ea(i+1,j,1)) + h_neglect + b1(I) = 1.0 / (hval + (eb(i,j,1) + eb(i+1,j,1))) + d1(I) = hval * b1(I) + u(I,j,1) = b1(I) * (hval * u(I,j,1)) + enddo + do k=2,nz ; do I=Isq,Ieq + if (associated(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,k) = u(I,j,k) + c1(I,k) = (eb(i,j,k-1)+eb(i+1,j,k-1)) * b1(I) + eaval = ea(i,j,k) + ea(i+1,j,k) + hval = hold(i,j,k) + hold(i+1,j,k) + h_neglect + b1(I) = 1.0 / ((eb(i,j,k) + eb(i+1,j,k)) + (hval + d1(I)*eaval)) + d1(I) = (hval + d1(I)*eaval) * b1(I) + u(I,j,k) = (hval*u(I,j,k) + eaval*u(I,j,k-1))*b1(I) + enddo ; enddo + do k=nz-1,1,-1 ; do I=Isq,Ieq + u(I,j,k) = u(I,j,k) + c1(I,k+1)*u(I,j,k+1) + if (associated(ADp%du_dt_dia)) & + ADp%du_dt_dia(I,j,k) = (u(I,j,k) - ADp%du_dt_dia(I,j,k)) * Idt + enddo ; enddo + if (associated(ADp%du_dt_dia)) then + do I=Isq,Ieq + ADp%du_dt_dia(I,j,nz) = (u(I,j,nz)-ADp%du_dt_dia(I,j,nz)) * Idt + enddo + endif + enddo + if (CS%debug) then + call MOM_state_chksum("aft 1st loop tridiag ", u, v, h, G, GV, haloshift=0) + endif + !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) + do J=Jsq,Jeq + do i=is,ie + if (associated(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,1) = v(i,J,1) + hval = (hold(i,j,1) + hold(i,j+1,1)) + (ea(i,j,1) + ea(i,j+1,1)) + h_neglect + b1(i) = 1.0 / (hval + (eb(i,j,1) + eb(i,j+1,1))) + d1(I) = hval * b1(I) + v(i,J,1) = b1(i) * (hval * v(i,J,1)) + enddo + do k=2,nz ; do i=is,ie + if (associated(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,k) = v(i,J,k) + c1(i,k) = (eb(i,j,k-1)+eb(i,j+1,k-1)) * b1(i) + eaval = ea(i,j,k) + ea(i,j+1,k) + hval = hold(i,j,k) + hold(i,j+1,k) + h_neglect + b1(i) = 1.0 / ((eb(i,j,k) + eb(i,j+1,k)) + (hval + d1(i)*eaval)) + d1(i) = (hval + d1(i)*eaval) * b1(i) + v(i,J,k) = (hval*v(i,J,k) + eaval*v(i,J,k-1))*b1(i) + enddo ; enddo + do k=nz-1,1,-1 ; do i=is,ie + v(i,J,k) = v(i,J,k) + c1(i,k+1)*v(i,J,k+1) + if (associated(ADp%dv_dt_dia)) & + ADp%dv_dt_dia(i,J,k) = (v(i,J,k) - ADp%dv_dt_dia(i,J,k)) * Idt + enddo ; enddo + if (associated(ADp%dv_dt_dia)) then + do i=is,ie + ADp%dv_dt_dia(i,J,nz) = (v(i,J,nz)-ADp%dv_dt_dia(i,J,nz)) * Idt + enddo + endif + enddo + call cpu_clock_end(id_clock_tridiag) + if (CS%debug) then + call MOM_state_chksum("after u/v tridiag ", u, v, h, G, GV, haloshift=0) + endif + endif ! useALEalgorithm + + call disable_averaging(CS%diag) + ! Frazil formation keeps temperature above the freezing point. + ! make_frazil is deliberately called at both the beginning and at + ! the end of the diabatic processes. + if (associated(tv%T) .AND. associated(tv%frazil)) then + call enable_averaging(0.5*dt, Time_end, CS%diag) + if (CS%frazil_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + temp_diag(i,j,k) = tv%T(i,j,k) + enddo ; enddo ; enddo + endif + + if (associated(fluxes%p_surf_full)) then + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) + else + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) + endif + + if (CS%frazil_tendency_diag) then + call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) + if (CS%id_frazil_h > 0 ) call post_data(CS%id_frazil_h, h, CS%diag) + endif + + if (showCallTree) call callTree_waypoint("done with 2nd make_frazil (diabatic)") + if (CS%debugConservation) call MOM_state_stats('2nd make_frazil', u, v, h, tv%T, tv%S, G) + call disable_averaging(CS%diag) + + endif ! endif for frazil + + ! Diagnose the diapycnal diffusivities and other related quantities. + call enable_averaging(dt, Time_end, CS%diag) + + if (CS%id_Kd_interface > 0) call post_data(CS%id_Kd_interface, Kd_int, CS%diag) + if (CS%id_Kd_heat > 0) call post_data(CS%id_Kd_heat, Kd_heat, CS%diag) + if (CS%id_Kd_salt > 0) call post_data(CS%id_Kd_salt, Kd_salt, CS%diag) + if (CS%id_Kd_ePBL > 0) call post_data(CS%id_Kd_ePBL, Kd_ePBL, CS%diag) + + if (CS%id_ea > 0) call post_data(CS%id_ea, ea, CS%diag) + if (CS%id_eb > 0) call post_data(CS%id_eb, eb, CS%diag) + + if (CS%id_dudt_dia > 0) call post_data(CS%id_dudt_dia, ADp%du_dt_dia, CS%diag) + if (CS%id_dvdt_dia > 0) call post_data(CS%id_dvdt_dia, ADp%dv_dt_dia, CS%diag) + if (CS%id_wd > 0) call post_data(CS%id_wd, CDp%diapyc_vel, CS%diag) + + if (CS%id_MLD_003 > 0 .or. CS%id_subMLN2 > 0 .or. CS%id_mlotstsq > 0) then + call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03, G, GV, CS%diag, & + id_N2subML=CS%id_subMLN2, id_MLDsq=CS%id_mlotstsq) + endif + if (CS%id_MLD_0125 > 0) then + call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125, G, GV, CS%diag) + endif + if (CS%id_MLD_user > 0) then + call diagnoseMLDbyDensityDifference(CS%id_MLD_user, h, tv, CS%MLDdensityDifference, G, GV, CS%diag) + endif + + if (CS%id_Tdif > 0) call post_data(CS%id_Tdif, Tdif_flx, CS%diag) + if (CS%id_Tadv > 0) call post_data(CS%id_Tadv, Tadv_flx, CS%diag) + if (CS%id_Sdif > 0) call post_data(CS%id_Sdif, Sdif_flx, CS%diag) + if (CS%id_Sadv > 0) call post_data(CS%id_Sadv, Sadv_flx, CS%diag) + if (CS%use_int_tides) then + if (CS%id_cg1 > 0) call post_data(CS%id_cg1, cn(:,:,1),CS%diag) + do m=1,CS%nMode + if (CS%id_cn(m) > 0) call post_data(CS%id_cn(m),cn(:,:,m),CS%diag) + enddo + endif + + call disable_averaging(CS%diag) + + num_z_diags = 0 + if (CS%id_Kd_z > 0) then + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_Kd_z ; z_ptrs(num_z_diags)%p => Kd_int + endif + if (CS%id_Tdif_z > 0) then + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_Tdif_z ; z_ptrs(num_z_diags)%p => Tdif_flx + endif + if (CS%id_Tadv_z > 0) then + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_Tadv_z ; z_ptrs(num_z_diags)%p => Tadv_flx + endif + if (CS%id_Sdif_z > 0) then + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_Sdif_z ; z_ptrs(num_z_diags)%p => Sdif_flx + endif + if (CS%id_Sadv_z > 0) then + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_Sadv_z ; z_ptrs(num_z_diags)%p => Sadv_flx + endif + + if (num_z_diags > 0) & + call calc_Zint_diags(h, z_ptrs, z_ids, num_z_diags, G, GV, CS%diag_to_Z_CSp) + + if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G) + if (showCallTree) call callTree_leave("diabatic()") + +end subroutine legacy_diabatic + !> Returns pointers or values of members within the diabatic_CS type. For extensibility, !! each returned argument is an optional argument subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, & diff --git a/src/parameterizations/vertical/MOM_legacy_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_legacy_diabatic_driver.F90 deleted file mode 100644 index 739c74c80c..0000000000 --- a/src/parameterizations/vertical/MOM_legacy_diabatic_driver.F90 +++ /dev/null @@ -1,1660 +0,0 @@ -!> This routine drives the diabatic/dianeutral physics for MOM. -!! This is a legacy module that will be deleted in the near future. -module MOM_legacy_diabatic_driver - -! This file is part of MOM6. See LICENSE.md for the license. - -use MOM_bulk_mixed_layer, only : bulkmixedlayer, bulkmixedlayer_init, bulkmixedlayer_CS -use MOM_debugging, only : hchksum -use MOM_checksum_packages, only : MOM_state_chksum, MOM_state_stats -use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end -use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE -use MOM_CVMix_shear, only : CVMix_shear_is_used -use MOM_diabatic_aux, only : diabatic_aux_init, diabatic_aux_end, diabatic_aux_CS -use MOM_diabatic_aux, only : make_frazil, adjust_salt, insert_brine, differential_diffuse_T_S, triDiagTS -use MOM_diabatic_aux, only : find_uv_at_h, diagnoseMLDbyDensityDifference, applyBoundaryFluxesInOut -use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr -use MOM_diag_mediator, only : diag_ctrl, time_type, diag_update_remap_grids -use MOM_diag_mediator, only : diag_ctrl, query_averaging_enabled, enable_averaging, disable_averaging -use MOM_diag_mediator, only : diag_grid_storage, diag_grid_storage_init, diag_grid_storage_end -use MOM_diag_mediator, only : diag_copy_diag_to_storage, diag_copy_storage_to_diag -use MOM_diag_mediator, only : diag_save_grids, diag_restore_grids -use MOM_diag_to_Z, only : diag_to_Z_CS, register_Zint_diag, calc_Zint_diags -use MOM_diapyc_energy_req, only : diapyc_energy_req_init, diapyc_energy_req_end -use MOM_diapyc_energy_req, only : diapyc_energy_req_calc, diapyc_energy_req_test, diapyc_energy_req_CS -use MOM_CVMix_conv, only : CVMix_conv_init, CVMix_conv_cs -use MOM_CVMix_conv, only : CVMix_conv_end, calculate_CVMix_conv -use MOM_domains, only : pass_var, To_West, To_South, To_All, Omit_Corners -use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type -use MOM_tidal_mixing, only : tidal_mixing_init, tidal_mixing_cs -use MOM_tidal_mixing, only : tidal_mixing_end -use MOM_energetic_PBL, only : energetic_PBL, energetic_PBL_init -use MOM_energetic_PBL, only : energetic_PBL_end, energetic_PBL_CS -use MOM_energetic_PBL, only : energetic_PBL_get_MLD -use MOM_entrain_diffusive, only : entrainment_diffusive, entrain_diffusive_init -use MOM_entrain_diffusive, only : entrain_diffusive_end, entrain_diffusive_CS -use MOM_EOS, only : calculate_density, calculate_TFreeze -use MOM_EOS, only : calculate_specific_vol_derivs -use MOM_error_handler, only : MOM_error, FATAL, WARNING, callTree_showQuery,MOM_mesg -use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint -use MOM_file_parser, only : get_param, log_version, param_file_type, read_param -use MOM_forcing_type, only : forcing, MOM_forcing_chksum -use MOM_forcing_type, only : calculateBuoyancyFlux2d, forcing_SinglePointPrint -use MOM_geothermal, only : geothermal, geothermal_init, geothermal_end, geothermal_CS -use MOM_grid, only : ocean_grid_type -use MOM_io, only : vardesc, var_desc -use MOM_int_tide_input, only : set_int_tide_input, int_tide_input_init -use MOM_int_tide_input, only : int_tide_input_end, int_tide_input_CS, int_tide_input_type -use MOM_interface_heights, only : find_eta -use MOM_internal_tides, only : propagate_int_tide -use MOM_internal_tides, only : internal_tides_init, internal_tides_end, int_tide_CS -use MOM_kappa_shear, only : kappa_shear_is_used -use MOM_KPP, only : KPP_CS, KPP_init, KPP_compute_BLD, KPP_calculate -use MOM_KPP, only : KPP_end, KPP_get_BLD -use MOM_KPP, only : KPP_NonLocalTransport_temp, KPP_NonLocalTransport_saln -use MOM_opacity, only : opacity_init, set_opacity, opacity_end, opacity_CS -use MOM_regularize_layers, only : regularize_layers, regularize_layers_init, regularize_layers_CS -use MOM_set_diffusivity, only : set_diffusivity, set_BBL_TKE -use MOM_set_diffusivity, only : set_diffusivity_init, set_diffusivity_end -use MOM_set_diffusivity, only : set_diffusivity_CS -use MOM_shortwave_abs, only : absorbRemainingSW, optics_type -use MOM_sponge, only : apply_sponge, sponge_CS -use MOM_ALE_sponge, only : apply_ALE_sponge, ALE_sponge_CS -use MOM_time_manager, only : operator(-), set_time -use MOM_time_manager, only : operator(<=), time_type ! for testing itides (BDM) -use MOM_tracer_flow_control, only : call_tracer_column_fns, tracer_flow_control_CS -use MOM_tracer_diabatic, only : tracer_vertdiff -use MOM_variables, only : thermo_var_ptrs, vertvisc_type, accel_diag_ptrs -use MOM_variables, only : cont_diag_ptrs, MOM_thermovar_chksum, p3d -use MOM_verticalGrid, only : verticalGrid_type -use MOM_wave_speed, only : wave_speeds -use time_manager_mod, only : increment_time ! for testing itides (BDM) -use MOM_wave_interface, only : wave_parameters_CS -use MOM_diabatic_driver, only : diabatic_CS - -implicit none ; private - -#include - -public legacy_diabatic - -! clock ids -integer :: id_clock_entrain, id_clock_mixedlayer, id_clock_set_diffusivity -integer :: id_clock_tracers, id_clock_tridiag, id_clock_pass, id_clock_sponge -integer :: id_clock_geothermal, id_clock_differential_diff, id_clock_remap -integer :: id_clock_kpp - -contains - -!> This subroutine imposes the diapycnal mass fluxes and the -!! accompanying diapycnal advection of momentum and tracers. -subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, CS, WAVES) - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity (m/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness (m for Bouss / kg/m2 for non-Bouss) - type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields - !! unused have NULL ptrs - real, dimension(:,:), pointer :: Hml !< active mixed layer depth - type(forcing), intent(inout) :: fluxes !< points to forcing fields - !! unused fields have NULL ptrs - type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and - type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum - !! equations, to enable the later derived - !! diagnostics, like energy budgets - type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations - real, intent(in) :: dt !< time increment (seconds) - type(time_type), intent(in) :: Time_end !< Time at the end of the interval - type(diabatic_CS), pointer :: CS !< module control structure - type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves - - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - ea, & ! amount of fluid entrained from the layer above within - ! one time step (m for Bouss, kg/m^2 for non-Bouss) - eb, & ! amount of fluid entrained from the layer below within - ! one time step (m for Bouss, kg/m^2 for non-Bouss) - Kd, & ! diapycnal diffusivity of layers (m^2/sec) - h_orig, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) - h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) - hold, & ! layer thickness before diapycnal entrainment, and later - ! the initial layer thicknesses (if a mixed layer is used), - ! (m for Bouss, kg/m^2 for non-Bouss) - dSV_dT, & ! The partial derivatives of specific volume with temperature - dSV_dS, & ! and salinity in m^3/(kg K) and m^3/(kg ppt). - cTKE, & ! convective TKE requirements for each layer in J/m^2. - u_h, & ! zonal and meridional velocities at thickness points after - v_h ! entrainment (m/s) - - real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & - cn ! baroclinic gravity wave speeds (formerly cg1 - BDM) - - real, dimension(SZI_(G),SZJ_(G)) :: & - Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges - SkinBuoyFlux! 2d surface buoyancy flux (m2/s3), used by ePBL - real, dimension(SZI_(G),SZJ_(G),G%ke) :: h_diag ! diagnostic array for thickness - real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp - real, dimension(SZI_(G),SZJ_(G),G%ke) :: saln_diag ! diagnostic array for salinity - real, dimension(SZI_(G),SZJ_(G)) :: tendency_2d ! depth integrated content tendency for diagn - real, dimension(SZI_(G),SZJ_(G)) :: TKE_itidal_input_test ! override of energy input for testing (BDM) - - real :: net_ent ! The net of ea-eb at an interface. - - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & - ! These are targets so that the space can be shared with eaml & ebml. - eatr, & ! The equivalent of ea and eb for tracers, which differ from ea and - ebtr ! eb in that they tend to homogenize tracers in massless layers - ! near the boundaries (m for Bouss and kg/m^2 for non-Bouss) - - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & - Kd_int, & ! diapycnal diffusivity of interfaces (m^2/s) - Kd_heat, & ! diapycnal diffusivity of heat (m^2/s) - Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (m^2/s) - Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (m^2/s) - eta, & ! Interface heights before diapycnal mixing, in m. - Tdif_flx, & ! diffusive diapycnal heat flux across interfaces (K m/s) - Tadv_flx, & ! advective diapycnal heat flux across interfaces (K m/s) - Sdif_flx, & ! diffusive diapycnal salt flux across interfaces (ppt m/s) - Sadv_flx ! advective diapycnal salt flux across interfaces (ppt m/s) - - ! The following 5 variables are only used with a bulk mixed layer. - real, pointer, dimension(:,:,:) :: & - eaml, & ! The equivalent of ea and eb due to mixed layer processes, - ebml ! (m for Bouss and kg/m^2 for non-Bouss). These will be - ! pointers to eatr and ebtr so as to reuse the memory as - ! the arrays are not needed at the same time. - - integer :: kb(SZI_(G),SZJ_(G)) ! index of the lightest layer denser - ! than the buffer laye (nondimensional) - - real :: p_ref_cv(SZI_(G)) ! Reference pressure for the potential - ! density which defines the coordinate - ! variable, set to P_Ref, in Pa. - - logical :: in_boundary(SZI_(G)) ! True if there are no massive layers below, - ! where massive is defined as sufficiently thick that - ! the no-flux boundary conditions have not restricted - ! the entrainment - usually sqrt(Kd*dt). - - real :: b_denom_1 ! The first term in the denominator of b1 - ! (m for Bouss, kg/m^2 for non-Bouss) - real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected - ! (m for Bouss and kg/m^2 for non-Bouss) - real :: h_neglect2 ! h_neglect^2 (m^2 for Bouss, kg^2/m^4 for non-Bouss) - real :: add_ent ! Entrainment that needs to be added when mixing tracers - ! (m for Bouss and kg/m^2 for non-Bouss) - real :: eaval ! eaval is 2*ea at velocity grid points (m for Bouss, kg/m^2 for non-Bouss) - real :: hval ! hval is 2*h at velocity grid points (m for Bouss, kg/m^2 for non-Bouss) - real :: h_tr ! h_tr is h at tracer points with a tiny thickness - ! added to ensure positive definiteness (m for Bouss, kg/m^2 for non-Bouss) - real :: Tr_ea_BBL ! The diffusive tracer thickness in the BBL that is - ! coupled to the bottom within a timestep (m) - - real :: htot(SZIB_(G)) ! The summed thickness from the bottom, in m. - real :: b1(SZIB_(G)), d1(SZIB_(G)) ! b1, c1, and d1 are variables used by the - real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. - - real :: Ent_int ! The diffusive entrainment rate at an interface - ! (H units = m for Bouss, kg/m^2 for non-Bouss). - real :: dt_mix ! amount of time over which to apply mixing (seconds) - real :: Idt ! inverse time step (1/s) - - type(p3d) :: z_ptrs(7) ! pointers to diagnostics to be interpolated to depth - integer :: num_z_diags ! number of diagnostics to be interpolated to depth - integer :: z_ids(7) ! id numbers of diagnostics to be interpolated to depth - integer :: dir_flag ! An integer encoding the directions in which to do halo updates. - logical :: showCallTree ! If true, show the call tree - integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m - - integer :: ig, jg ! global indices for testing testing itide point source (BDM) - logical :: avg_enabled ! for testing internal tides (BDM) - real :: Kd_add_here ! An added diffusivity in m2/s - - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - nkmb = GV%nk_rho_varies - h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect*h_neglect - Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 - - - if (nz == 1) return - showCallTree = callTree_showQuery() - if (showCallTree) call callTree_enter("diabatic(), MOM_diabatic_driver.F90") - - - ! Offer diagnostics of various state varables at the start of diabatic - ! these are mostly for debugging purposes. - if (CS%id_u_predia > 0) call post_data(CS%id_u_predia, u, CS%diag) - if (CS%id_v_predia > 0) call post_data(CS%id_v_predia, v, CS%diag) - if (CS%id_h_predia > 0) call post_data(CS%id_h_predia, h, CS%diag) - if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) - if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) - if (CS%id_e_predia > 0) then - call find_eta(h, tv, GV%g_Earth, G, GV, eta) - call post_data(CS%id_e_predia, eta, CS%diag) - endif - - - ! set equivalence between the same bits of memory for these arrays - eaml => eatr ; ebml => ebtr - - ! inverse time step - Idt = 1.0 / dt - - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & - "Module must be initialized before it is used.") - - if (CS%debug) then - call MOM_state_chksum("Start of diabatic ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("Start of diabatic", fluxes, G, haloshift=0) - endif - if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G) - - if (CS%debug_energy_req) & - call diapyc_energy_req_test(h, dt, tv, G, GV, CS%diapyc_en_rec_CSp) - - - call cpu_clock_begin(id_clock_set_diffusivity) - call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS%set_diff_CSp) - call cpu_clock_end(id_clock_set_diffusivity) - - ! Frazil formation keeps the temperature above the freezing point. - ! make_frazil is deliberately called at both the beginning and at - ! the end of the diabatic processes. - if (associated(tv%T) .AND. associated(tv%frazil)) then - ! For frazil diagnostic, the first call covers the first half of the time step - call enable_averaging(0.5*dt, Time_end - set_time(int(floor(0.5*dt+0.5))), CS%diag) - if (CS%frazil_tendency_diag) then - do k=1,nz ; do j=js,je ; do i=is,ie - temp_diag(i,j,k) = tv%T(i,j,k) - enddo ; enddo ; enddo - endif - - if (associated(fluxes%p_surf_full)) then - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) - else - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) - endif - if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)") - - if (CS%frazil_tendency_diag) then - call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) - if (CS%id_frazil_h > 0) call post_data(CS%id_frazil_h, h, CS%diag) - endif - call disable_averaging(CS%diag) - endif - ! For all other diabatic subroutines, the averaging window should be the entire diabatic timestep - call enable_averaging(dt, Time_end, CS%diag) - if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) - - if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_orig,h,eaml,ebml) - do k=1,nz ; do j=js,je ; do i=is,ie - h_orig(i,j,k) = h(i,j,k) ; eaml(i,j,k) = 0.0 ; ebml(i,j,k) = 0.0 - enddo ; enddo ; enddo - endif - - if (CS%use_geothermal) then - call cpu_clock_begin(id_clock_geothermal) - call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp) - call cpu_clock_end(id_clock_geothermal) - if (showCallTree) call callTree_waypoint("geothermal (diabatic)") - if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G) - endif - - ! Whenever thickness changes let the diag manager know, target grids - ! for vertical remapping may need to be regenerated. - call diag_update_remap_grids(CS%diag) - - ! Set_opacity estimates the optical properties of the water column. - ! It will need to be modified later to include information about the - ! biological properties and layer thicknesses. - if (associated(CS%optics)) & - call set_opacity(CS%optics, fluxes, G, GV, CS%opacity_CSp) - - if (CS%bulkmixedlayer) then - if (CS%debug) then - call MOM_forcing_chksum("Before mixedlayer", fluxes, G, haloshift=0) - endif - - if (CS%ML_mix_first > 0.0) then -! This subroutine -! (1) Cools the mixed layer. -! (2) Performs convective adjustment by mixed layer entrainment. -! (3) Heats the mixed layer and causes it to detrain to -! Monin-Obukhov depth or minimum mixed layer depth. -! (4) Uses any remaining TKE to drive mixed layer entrainment. -! (5) Possibly splits buffer layer into two isopycnal layers (when using isopycnal coordinate) - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) - - call cpu_clock_begin(id_clock_mixedlayer) - if (CS%ML_mix_first < 1.0) then - ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) - call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt*CS%ML_mix_first, & - eaml,ebml, G, GV, CS%bulkmixedlayer_CSp, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt, last_call=.false.) - if (CS%salt_reject_below_ML) & - call insert_brine(h, tv, G, GV, fluxes, nkmb, CS%diabatic_aux_CSp, & - dt*CS%ML_mix_first, CS%id_brine_lay) - else - ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) - call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt, eaml, ebml, & - G, GV, CS%bulkmixedlayer_CSp, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) - endif - - ! Keep salinity from falling below a small but positive threshold. - ! This constraint is needed for SIS1 ice model, which can extract - ! more salt than is present in the ocean. SIS2 does not suffer - ! from this limitation, in which case we can let salinity=0 and still - ! have salt conserved with SIS2 ice. So for SIS2, we can run with - ! BOUND_SALINITY=False in MOM.F90. - if (associated(tv%S) .and. associated(tv%salt_deficit)) & - call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) - call cpu_clock_end(id_clock_mixedlayer) - if (CS%debug) then - call MOM_state_chksum("After mixedlayer ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("After mixedlayer", fluxes, G, haloshift=0) - endif - if (showCallTree) call callTree_waypoint("done with 1st bulkmixedlayer (diabatic)") - if (CS%debugConservation) call MOM_state_stats('1st bulkmixedlayer', u, v, h, tv%T, tv%S, G) - endif - endif - - if (CS%debug) then - call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) - endif - if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then - if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then - call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eaml, ebml) - if (CS%debug) then - call hchksum(eaml, "after find_uv_at_h eaml",G%HI, scale=GV%H_to_m) - call hchksum(ebml, "after find_uv_at_h ebml",G%HI, scale=GV%H_to_m) - endif - else - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) - endif - if (showCallTree) call callTree_waypoint("done with find_uv_at_h (diabatic)") - endif - - if (CS%use_int_tides) then - ! This block provides an interface for the unresolved low-mode internal - ! tide module (BDM). - - ! PROVIDE ENERGY DISTRIBUTION (calculate time-varying energy source) - call set_int_tide_input(u, v, h, tv, fluxes, CS%int_tide_input, dt, G, GV, & - CS%int_tide_input_CSp) - ! CALCULATE MODAL VELOCITIES - cn(:,:,:) = 0.0 - if (CS%uniform_cg) then - ! SET TO CONSTANT VALUE TO TEST PROPAGATE CODE - do m=1,CS%nMode ; cn(:,:,m) = CS%cg_test ; enddo - else - call wave_speeds(h, tv, G, GV, CS%nMode, cn, full_halos=.true.) - ! uncomment the lines below for a hard-coded cn that changes linearly with latitude - !do j=G%jsd,G%jed ; do i=G%isd,G%ied - ! cn(i,j,:) = ((7.-1.)/14000000.)*G%geoLatBu(i,j) + (1.-((7.-1.)/14000000.)*-7000000.) - !enddo ; enddo - endif - - if (CS%int_tide_source_test) then - ! BUILD 2D ARRAY WITH POINT SOURCE FOR TESTING - ! This block of code should be moved into set_int_tide_input. -RWH - TKE_itidal_input_test(:,:) = 0.0 - avg_enabled = query_averaging_enabled(CS%diag,time_end=CS%time_end) - if (CS%time_end <= CS%time_max_source) then - do j=G%jsc,G%jec ; do i=G%isc,G%iec - !INPUT ARBITRARY ENERGY POINT SOURCE - if ((G%idg_offset + i == CS%int_tide_source_x) .and. & - (G%jdg_offset + j == CS%int_tide_source_y)) then - TKE_itidal_input_test(i,j) = 1.0 - endif - enddo ; enddo - endif - ! CALL ROUTINE USING PRESCRIBED KE FOR TESTING - call propagate_int_tide(h, tv, cn, TKE_itidal_input_test, & - CS%int_tide_input%tideamp, CS%int_tide_input%Nb, dt, G, GV, CS%int_tide_CSp) - else - ! CALL ROUTINE USING CALCULATED KE INPUT - call propagate_int_tide(h, tv, cn, CS%int_tide_input%TKE_itidal_input, & - CS%int_tide_input%tideamp, CS%int_tide_input%Nb, dt, G, GV, CS%int_tide_CSp) - endif - if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") - endif - - call cpu_clock_begin(id_clock_set_diffusivity) - ! Sets: Kd, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S - ! Also changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ???? - ! And sets visc%Kv_shear - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, CS%set_diff_CSp, Kd, Kd_int) - call cpu_clock_end(id_clock_set_diffusivity) - if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") - - if (CS%debug) then - call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, haloshift=0) - call MOM_thermovar_chksum("after set_diffusivity ", tv, G) - call hchksum(Kd, "after set_diffusivity Kd",G%HI,haloshift=0) - call hchksum(Kd_Int, "after set_diffusivity Kd_Int",G%HI,haloshift=0) - endif - - - if (CS%useKPP) then - call cpu_clock_begin(id_clock_kpp) - ! KPP needs the surface buoyancy flux but does not update state variables. - ! We could make this call higher up to avoid a repeat unpacking of the surface fluxes. - ! Sets: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux - ! NOTE: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux are returned as rates (i.e. stuff per second) - ! unlike other instances where the fluxes are integrated in time over a time-step. - call calculateBuoyancyFlux2d(G, GV, fluxes, CS%optics, h, tv%T, tv%S, tv, & - CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) - ! The KPP scheme calculates boundary layer diffusivities and non-local transport. - ! MOM6 implementation of KPP matches the boundary layer to zero interior diffusivity, - ! since the matching to nonzero interior diffusivity can be problematic. - ! Changes: Kd_int. Sets: KPP_NLTheat, KPP_NLTscalar - -!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,Kd_heat) -!$OMP do - do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = Kd_int(i,j,k) - Kd_heat(i,j,k) = Kd_int(i,j,k) - enddo ; enddo ; enddo - if (associated(visc%Kd_extra_S)) then -!$OMP do - do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = Kd_salt(i,j,k) + visc%Kd_extra_S(i,j,k) - enddo ; enddo ; enddo - endif - if (associated(visc%Kd_extra_T)) then -!$OMP do - do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k) - enddo ; enddo ; enddo - endif -!$OMP end parallel - - call KPP_compute_BLD(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, & - fluxes%ustar, CS%KPP_buoy_flux) - - call KPP_calculate(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, & - fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, & - CS%KPP_NLTscalar, Waves=Waves) -!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,G,Kd_heat,Hml) - - if (associated(Hml)) then - call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G) - call pass_var(Hml, G%domain, halo=1) - endif - - if (.not. CS%KPPisPassive) then -!$OMP do - do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_int(i,j,k) = min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) - enddo ; enddo ; enddo - if (associated(visc%Kd_extra_S)) then -!$OMP do - do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_S(i,j,k) = Kd_salt(i,j,k) - Kd_int(i,j,k) - enddo ; enddo ; enddo - endif - if (associated(visc%Kd_extra_T)) then -!$OMP do - do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_T(i,j,k) = Kd_heat(i,j,k) - Kd_int(i,j,k) - enddo ; enddo ; enddo - endif - endif ! not passive -!$OMP end parallel - call cpu_clock_end(id_clock_kpp) - if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") - if (CS%debug) then - call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("after KPP", fluxes, G, haloshift=0) - call MOM_thermovar_chksum("after KPP", tv, G) - call hchksum(Kd, "after KPP Kd",G%HI,haloshift=0) - call hchksum(Kd_Int, "after KPP Kd_Int",G%HI,haloshift=0) - endif - - endif ! endif for KPP - - ! Add vertical diff./visc. due to convection (computed via CVMix) - if (CS%use_CVMix_conv) then - call calculate_CVMix_conv(h, tv, G, GV, CS%CVMix_conv_csp, Hml) - - !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,k) = Kd_int(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) - visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) - enddo ; enddo ; enddo - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - endif - - if (CS%useKPP) then - - call cpu_clock_begin(id_clock_kpp) - if (CS%debug) then - call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat",G%HI,haloshift=0) - call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar",G%HI,haloshift=0) - endif - ! Apply non-local transport of heat and salt - ! Changes: tv%T, tv%S - call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, dt, tv%T, tv%C_p) - call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, dt, tv%S) - call cpu_clock_end(id_clock_kpp) - if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") - if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G) - - if (CS%debug) then - call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, haloshift=0) - call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) - endif - - endif ! endif for KPP - - ! Differential diffusion done here. - ! Changes: tv%T, tv%S - ! If using matching within the KPP scheme, then this step needs to provide - ! a diffusivity and happen before KPP. But generally in MOM, we do not match - ! KPP boundary layer to interior, so this diffusivity can be computed when convenient. - if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T)) then - call cpu_clock_begin(id_clock_differential_diff) - - call differential_diffuse_T_S(h, tv, visc, dt, G, GV) - call cpu_clock_end(id_clock_differential_diff) - if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") - if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G) - - ! increment heat and salt diffusivity. - ! CS%useKPP==.true. already has extra_T and extra_S included - if (.not. CS%useKPP) then - do K=2,nz ; do j=js,je ; do i=is,ie - Kd_heat(i,j,K) = Kd_heat(i,j,K) + visc%Kd_extra_T(i,j,K) - Kd_salt(i,j,K) = Kd_salt(i,j,K) + visc%Kd_extra_S(i,j,K) - enddo ; enddo ; enddo - endif - - - endif - - - ! This block sets ea, eb from Kd or Kd_int. - ! If using ALE algorithm, set ea=eb=Kd_int on interfaces for - ! use in the tri-diagonal solver. - ! Otherwise, call entrainment_diffusive() which sets ea and eb - ! based on KD and target densities (ie. does remapping as well). - if (CS%useALEalgorithm) then - - do j=js,je ; do i=is,ie - ea(i,j,1) = 0. - enddo ; enddo -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_neglect,h,ea,GV,dt,Kd_int,eb) & -!$OMP private(hval) - do k=2,nz ; do j=js,je ; do i=is,ie - hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_int(i,j,k) - eb(i,j,k-1) = ea(i,j,k) - enddo ; enddo ; enddo - do j=js,je ; do i=is,ie - eb(i,j,nz) = 0. - enddo ; enddo - if (showCallTree) call callTree_waypoint("done setting ea,eb from Kd_int (diabatic)") - - else ! .not. CS%useALEalgorithm - ! When not using ALE, calculate layer entrainments/detrainments from - ! diffusivities and differences between layer and target densities - call cpu_clock_begin(id_clock_entrain) - ! Calculate appropriately limited diapycnal mass fluxes to account - ! for diapycnal diffusion and advection. Sets: ea, eb. Changes: kb - call Entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS%entrain_diffusive_CSp, & - ea, eb, kb, Kd_Lay=Kd, Kd_int=Kd_int) - call cpu_clock_end(id_clock_entrain) - if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)") - - endif ! endif for (CS%useALEalgorithm) - - if (CS%debug) then - call MOM_forcing_chksum("after calc_entrain ", fluxes, G, haloshift=0) - call MOM_thermovar_chksum("after calc_entrain ", tv, G) - call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, haloshift=0) - call hchksum(ea, "after calc_entrain ea", G%HI, haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "after calc_entrain eb", G%HI, haloshift=0, scale=GV%H_to_m) - endif - - ! Save fields before boundary forcing is applied for tendency diagnostics - if (CS%boundary_forcing_tendency_diag) then - do k=1,nz ; do j=js,je ; do i=is,ie - h_diag(i,j,k) = h(i,j,k) - temp_diag(i,j,k) = tv%T(i,j,k) - saln_diag(i,j,k) = tv%S(i,j,k) - enddo ; enddo ; enddo - endif - - ! Apply forcing when using the ALE algorithm - if (CS%useALEalgorithm) then - call cpu_clock_begin(id_clock_remap) - - ! Changes made to following fields: h, tv%T and tv%S. - - do k=1,nz ; do j=js,je ; do i=is,ie - h_prebound(i,j,k) = h(i,j,k) - enddo ; enddo ; enddo - if (CS%use_energetic_PBL) then - - skinbuoyflux(:,:) = 0.0 - call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, dt, fluxes, CS%optics, & - h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & - CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux) - - if (CS%debug) then - call hchksum(ea, "after applyBoundaryFluxes ea",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "after applyBoundaryFluxes eb",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(cTKE, "after applyBoundaryFluxes cTKE",G%HI,haloshift=0) - call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT",G%HI,haloshift=0) - call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS",G%HI,haloshift=0) - endif - - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) - call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) - - ! If visc%MLD exists, copy the ePBL's MLD into it - if (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G) - call pass_var(visc%MLD, G%domain, halo=1) - Hml(:,:) = visc%MLD(:,:) - endif - - ! Augment the diffusivities due to those diagnosed in energetic_PBL. - do K=2,nz ; do j=js,je ; do i=is,ie - - if (CS%ePBL_is_additive) then - Kd_add_here = Kd_ePBL(i,j,K) - visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) - else - Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) - visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) - endif - Ent_int = Kd_add_here * (GV%m_to_H**2 * dt) / & - (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) - eb(i,j,k-1) = eb(i,j,k-1) + Ent_int - ea(i,j,k) = ea(i,j,k) + Ent_int - Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here - - ! for diagnostics - Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_int(i,j,K) - Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_int(i,j,K) - - enddo ; enddo ; enddo - - if (CS%debug) then - call hchksum(ea, "after ePBL ea",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "after ePBL eb",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL",G%HI,haloshift=0) - endif - - else - call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, dt, fluxes, CS%optics, & - h, tv, CS%aggregate_FW_forcing, & - CS%evap_CFL_limit, CS%minimum_forcing_depth) - - endif ! endif for CS%use_energetic_PBL - - ! diagnose the tendencies due to boundary forcing - ! At this point, the diagnostic grids have not been updated since the call to the boundary layer scheme - ! so all tendency diagnostics need to be posted on h_diag, and grids rebuilt afterwards - if (CS%boundary_forcing_tendency_diag) then - call diagnose_boundary_forcing_tendency(tv, h, temp_diag, saln_diag, h_diag, dt, G, GV, CS) - if (CS%id_boundary_forcing_h > 0) call post_data(CS%id_boundary_forcing_h, h, CS%diag, alt_h = h_diag) - endif - ! Boundary fluxes may have changed T, S, and h - call diag_update_remap_grids(CS%diag) - - call cpu_clock_end(id_clock_remap) - if (CS%debug) then - call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, haloshift=0) - call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G) - call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, haloshift=0) - endif - if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") - if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G) - - endif ! endif for (CS%useALEalgorithm) - - ! Update h according to divergence of the difference between - ! ea and eb. We keep a record of the original h in hold. - ! In the following, the checks for negative values are to guard - ! against instances where entrainment drives a layer to - ! negative thickness. This situation will never happen if - ! enough iterations are permitted in Calculate_Entrainment. - ! Even if too few iterations are allowed, it is still guarded - ! against. In other words the checks are probably unnecessary. - !$OMP parallel do default(shared) - do j=js,je - do i=is,ie - hold(i,j,1) = h(i,j,1) - h(i,j,1) = h(i,j,1) + (eb(i,j,1) - ea(i,j,2)) - hold(i,j,nz) = h(i,j,nz) - h(i,j,nz) = h(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)) - if (h(i,j,1) <= 0.0) then - h(i,j,1) = GV%Angstrom - endif - if (h(i,j,nz) <= 0.0) then - h(i,j,nz) = GV%Angstrom - endif - enddo - do k=2,nz-1 ; do i=is,ie - hold(i,j,k) = h(i,j,k) - h(i,j,k) = h(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & - (eb(i,j,k) - ea(i,j,k+1))) - if (h(i,j,k) <= 0.0) then - h(i,j,k) = GV%Angstrom - endif - enddo ; enddo - enddo - ! Checks for negative thickness may have changed layer thicknesses - call diag_update_remap_grids(CS%diag) - - if (CS%debug) then - call MOM_state_chksum("after negative check ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("after negative check ", fluxes, G, haloshift=0) - call MOM_thermovar_chksum("after negative check ", tv, G) - endif - if (showCallTree) call callTree_waypoint("done with h=ea-eb (diabatic)") - if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G) - - - ! Here, T and S are updated according to ea and eb. - ! If using the bulk mixed layer, T and S are also updated - ! by surface fluxes (in fluxes%*). - ! This is a very long block. - if (CS%bulkmixedlayer) then - - if (associated(tv%T)) then - call cpu_clock_begin(id_clock_tridiag) - ! Temperature and salinity (as state variables) are treated - ! differently from other tracers to insure massless layers that - ! are lighter than the mixed layer have temperatures and salinities - ! that correspond to their prescribed densities. - if (CS%massless_match_targets) then - !$OMP parallel do default (shared) private(h_tr,b1,d1,c1,b_denom_1) - do j=js,je - do i=is,ie - h_tr = hold(i,j,1) + h_neglect - b1(i) = 1.0 / (h_tr + eb(i,j,1)) - d1(i) = h_tr * b1(i) - tv%T(i,j,1) = b1(i) * (h_tr*tv%T(i,j,1)) - tv%S(i,j,1) = b1(i) * (h_tr*tv%S(i,j,1)) - enddo - do k=2,nkmb ; do i=is,ie - c1(i,k) = eb(i,j,k-1) * b1(i) - h_tr = hold(i,j,k) + h_neglect - b_denom_1 = h_tr + d1(i)*ea(i,j,k) - b1(i) = 1.0 / (b_denom_1 + eb(i,j,k)) - if (k kb(i,j)) then - c1(i,k) = eb(i,j,k-1) * b1(i) - h_tr = hold(i,j,k) + h_neglect - b_denom_1 = h_tr + d1(i)*ea(i,j,k) - b1(i) = 1.0 / (b_denom_1 + eb(i,j,k)) - d1(i) = b_denom_1 * b1(i) - tv%T(i,j,k) = b1(i) * (h_tr*tv%T(i,j,k) + ea(i,j,k)*tv%T(i,j,k-1)) - tv%S(i,j,k) = b1(i) * (h_tr*tv%S(i,j,k) + ea(i,j,k)*tv%S(i,j,k-1)) - elseif (eb(i,j,k) < eb(i,j,k-1)) then ! (note that k < kb(i,j)) - ! The bottommost buffer layer might entrain all the mass from some - ! of the interior layers that are thin and lighter in the coordinate - ! density than that buffer layer. The T and S of these newly - ! massless interior layers are unchanged. - tv%T(i,j,nkmb) = tv%T(i,j,nkmb) + b1(i) * (eb(i,j,k-1) - eb(i,j,k)) * tv%T(i,j,k) - tv%S(i,j,nkmb) = tv%S(i,j,nkmb) + b1(i) * (eb(i,j,k-1) - eb(i,j,k)) * tv%S(i,j,k) - endif - enddo ; enddo - - do k=nz-1,nkmb,-1 ; do i=is,ie - if (k >= kb(i,j)) then - tv%T(i,j,k) = tv%T(i,j,k) + c1(i,k+1)*tv%T(i,j,k+1) - tv%S(i,j,k) = tv%S(i,j,k) + c1(i,k+1)*tv%S(i,j,k+1) - endif - enddo ; enddo - do i=is,ie ; if (kb(i,j) <= nz) then - tv%T(i,j,nkmb) = tv%T(i,j,nkmb) + c1(i,kb(i,j))*tv%T(i,j,kb(i,j)) - tv%S(i,j,nkmb) = tv%S(i,j,nkmb) + c1(i,kb(i,j))*tv%S(i,j,kb(i,j)) - endif ; enddo - do k=nkmb-1,1,-1 ; do i=is,ie - tv%T(i,j,k) = tv%T(i,j,k) + c1(i,k+1)*tv%T(i,j,k+1) - tv%S(i,j,k) = tv%S(i,j,k) + c1(i,k+1)*tv%S(i,j,k+1) - enddo ; enddo - enddo ! end of j loop - else ! .not. massless_match_targets - ! This simpler form allows T & S to be too dense for the layers - ! between the buffer layers and the interior. - ! Changes: T, S - if (CS%tracer_tridiag) then - call tracer_vertdiff(hold, ea, eb, dt, tv%T, G, GV) - call tracer_vertdiff(hold, ea, eb, dt, tv%S, G, GV) - else - call triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, tv%T, tv%S) - endif - endif ! massless_match_targets - call cpu_clock_end(id_clock_tridiag) - - endif ! endif for associated(T) - if (CS%debugConservation) call MOM_state_stats('BML tridiag', u, v, h, tv%T, tv%S, G) - - if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then - ! The mixed layer code has already been called, but there is some needed - ! bookkeeping. - !$OMP parallel do default(shared) - do k=1,nz ; do j=js,je ; do i=is,ie - hold(i,j,k) = h_orig(i,j,k) - ea(i,j,k) = ea(i,j,k) + eaml(i,j,k) - eb(i,j,k) = eb(i,j,k) + ebml(i,j,k) - enddo ; enddo ; enddo - if (CS%debug) then - call hchksum(ea, "after ea = ea + eaml",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "after eb = eb + ebml",G%HI,haloshift=0, scale=GV%H_to_m) - endif - endif - - if (CS%ML_mix_first < 1.0) then - ! Call the mixed layer code now, perhaps for a second time. - ! This subroutine (1) Cools the mixed layer. - ! (2) Performs convective adjustment by mixed layer entrainment. - ! (3) Heats the mixed layer and causes it to detrain to - ! Monin-Obukhov depth or minimum mixed layer depth. - ! (4) Uses any remaining TKE to drive mixed layer entrainment. - ! (5) Possibly splits the buffer layer into two isopycnal layers. - - call find_uv_at_h(u, v, hold, u_h, v_h, G, GV, ea, eb) - if (CS%debug) call MOM_state_chksum("find_uv_at_h1 ", u, v, h, G, GV, haloshift=0) - - dt_mix = min(dt,dt*(1.0 - CS%ML_mix_first)) - call cpu_clock_begin(id_clock_mixedlayer) - ! Changes: h, tv%T, tv%S, ea and eb (G is also inout???) - call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_mix, ea, eb, & - G, GV, CS%bulkmixedlayer_CSp, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) - - if (CS%salt_reject_below_ML) & - call insert_brine(h, tv, G, GV, fluxes, nkmb, CS%diabatic_aux_CSp, dt_mix, & - CS%id_brine_lay) - - ! Keep salinity from falling below a small but positive threshold. - ! This constraint is needed for SIS1 ice model, which can extract - ! more salt than is present in the ocean. SIS2 does not suffer - ! from this limitation, in which case we can let salinity=0 and still - ! have salt conserved with SIS2 ice. So for SIS2, we can run with - ! BOUND_SALINITY=False in MOM.F90. - if (associated(tv%S) .and. associated(tv%salt_deficit)) & - call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) - - call cpu_clock_end(id_clock_mixedlayer) - if (showCallTree) call callTree_waypoint("done with 2nd bulkmixedlayer (diabatic)") - if (CS%debugConservation) call MOM_state_stats('2nd bulkmixedlayer', u, v, h, tv%T, tv%S, G) - endif - - else ! following block for when NOT using BULKMIXEDLAYER - - - ! calculate change in temperature & salinity due to dia-coordinate surface diffusion - if (associated(tv%T)) then - - if (CS%debug) then - call hchksum(ea, "before triDiagTS ea ",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "before triDiagTS eb ",G%HI,haloshift=0, scale=GV%H_to_m) - endif - call cpu_clock_begin(id_clock_tridiag) - - ! Keep salinity from falling below a small but positive threshold. - ! This constraint is needed for SIS1 ice model, which can extract - ! more salt than is present in the ocean. SIS2 does not suffer - ! from this limitation, in which case we can let salinity=0 and still - ! have salt conserved with SIS2 ice. So for SIS2, we can run with - ! BOUND_SALINITY=False in MOM.F90. - if (associated(tv%S) .and. associated(tv%salt_deficit)) & - call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) - - if (CS%diabatic_diff_tendency_diag) then - do k=1,nz ; do j=js,je ; do i=is,ie - temp_diag(i,j,k) = tv%T(i,j,k) - saln_diag(i,j,k) = tv%S(i,j,k) - enddo ; enddo ; enddo - endif - - ! Changes T and S via the tridiagonal solver; no change to h - if (CS%tracer_tridiag) then - call tracer_vertdiff(hold, ea, eb, dt, tv%T, G, GV) - call tracer_vertdiff(hold, ea, eb, dt, tv%S, G, GV) - else - call triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, tv%T, tv%S) - endif - - ! diagnose temperature, salinity, heat, and salt tendencies - ! Note: hold here refers to the thicknesses from before the dual-entraintment when using - ! the bulk mixed layer scheme. Otherwise in ALE-mode, layer thicknesses will have changed - ! In either case, tendencies should be posted on hold - if (CS%diabatic_diff_tendency_diag) then - call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, CS) - if (CS%id_diabatic_diff_h > 0) call post_data(CS%id_diabatic_diff_h, hold, CS%diag, alt_h = hold) - endif - - call cpu_clock_end(id_clock_tridiag) - if (showCallTree) call callTree_waypoint("done with triDiagTS (diabatic)") - - endif ! endif corresponding to if (associated(tv%T)) - if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G) - - - endif ! endif for the BULKMIXEDLAYER block - - - if (CS%debug) then - call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, haloshift=0) - call MOM_thermovar_chksum("after mixed layer ", tv, G) - call hchksum(ea, "after mixed layer ea", G%HI, scale=GV%H_to_m) - call hchksum(eb, "after mixed layer eb", G%HI, scale=GV%H_to_m) - endif - - if (.not. CS%useALEalgorithm) then - call cpu_clock_begin(id_clock_remap) - call regularize_layers(h, tv, dt, ea, eb, G, GV, CS%regularize_layers_CSp) - call cpu_clock_end(id_clock_remap) - if (showCallTree) call callTree_waypoint("done with regularize_layers (diabatic)") - if (CS%debugConservation) call MOM_state_stats('regularize_layers', u, v, h, tv%T, tv%S, G) - endif - - ! Whenever thickness changes let the diag manager know, as the - ! target grids for vertical remapping may need to be regenerated. - call diag_update_remap_grids(CS%diag) - - ! diagnostics - if ((CS%id_Tdif > 0) .or. (CS%id_Tdif_z > 0) .or. & - (CS%id_Tadv > 0) .or. (CS%id_Tadv_z > 0)) then - do j=js,je ; do i=is,ie - Tdif_flx(i,j,1) = 0.0 ; Tdif_flx(i,j,nz+1) = 0.0 - Tadv_flx(i,j,1) = 0.0 ; Tadv_flx(i,j,nz+1) = 0.0 - enddo ; enddo - !$OMP parallel do default(shared) - do K=2,nz ; do j=js,je ; do i=is,ie - Tdif_flx(i,j,K) = (Idt * 0.5*(ea(i,j,k) + eb(i,j,k-1))) * & - (tv%T(i,j,k-1) - tv%T(i,j,k)) - Tadv_flx(i,j,K) = (Idt * (ea(i,j,k) - eb(i,j,k-1))) * & - 0.5*(tv%T(i,j,k-1) + tv%T(i,j,k)) - enddo ; enddo ; enddo - endif - if ((CS%id_Sdif > 0) .or. (CS%id_Sdif_z > 0) .or. & - (CS%id_Sadv > 0) .or. (CS%id_Sadv_z > 0)) then - do j=js,je ; do i=is,ie - Sdif_flx(i,j,1) = 0.0 ; Sdif_flx(i,j,nz+1) = 0.0 - Sadv_flx(i,j,1) = 0.0 ; Sadv_flx(i,j,nz+1) = 0.0 - enddo ; enddo - !$OMP parallel do default(shared) - do K=2,nz ; do j=js,je ; do i=is,ie - Sdif_flx(i,j,K) = (Idt * 0.5*(ea(i,j,k) + eb(i,j,k-1))) * & - (tv%S(i,j,k-1) - tv%S(i,j,k)) - Sadv_flx(i,j,K) = (Idt * (ea(i,j,k) - eb(i,j,k-1))) * & - 0.5*(tv%S(i,j,k-1) + tv%S(i,j,k)) - enddo ; enddo ; enddo - endif - - ! mixing of passive tracers from massless boundary layers to interior - call cpu_clock_begin(id_clock_tracers) - if (CS%mix_boundary_tracers) then - Tr_ea_BBL = sqrt(dt*CS%Kd_BBL_tr) - !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) - do j=js,je - do i=is,ie - ebtr(i,j,nz) = eb(i,j,nz) - htot(i) = 0.0 - in_boundary(i) = (G%mask2dT(i,j) > 0.0) - enddo - do k=nz,2,-1 ; do i=is,ie - if (in_boundary(i)) then - htot(i) = htot(i) + h(i,j,k) - ! If diapycnal mixing has been suppressed because this is a massless - ! layer near the bottom, add some mixing of tracers between these - ! layers. This flux is based on the harmonic mean of the two - ! thicknesses, as this corresponds pretty closely (to within - ! differences in the density jumps between layers) with what is done - ! in the calculation of the fluxes in the first place. Kd_min_tr - ! should be much less than the values that have been set in Kd, - ! perhaps a molecular diffusivity. - add_ent = ((dt * CS%Kd_min_tr) * GV%m_to_H**2) * & - ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & - (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & - 0.5*(ea(i,j,k) + eb(i,j,k-1)) - if (htot(i) < Tr_ea_BBL) then - add_ent = max(0.0, add_ent, & - (Tr_ea_BBL - htot(i)) - min(ea(i,j,k),eb(i,j,k-1))) - elseif (add_ent < 0.0) then - add_ent = 0.0 ; in_boundary(i) = .false. - endif - - ebtr(i,j,k-1) = eb(i,j,k-1) + add_ent - eatr(i,j,k) = ea(i,j,k) + add_ent - else - ebtr(i,j,k-1) = eb(i,j,k-1) ; eatr(i,j,k) = ea(i,j,k) - endif - if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / & - (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & - h_neglect) - ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent - eatr(i,j,k) = eatr(i,j,k) + add_ent - endif ; endif - enddo ; enddo - do i=is,ie ; eatr(i,j,1) = ea(i,j,1) ; enddo - - enddo - - if (CS%useALEalgorithm) then - ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied - ! so hold should be h_orig - call call_tracer_column_fns(h_prebound, h, ea, eb, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug, & - evap_CFL_limit = CS%evap_CFL_limit, & - minimum_forcing_depth = CS%minimum_forcing_depth) - else - call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug) - endif - - elseif (associated(visc%Kd_extra_S)) then ! extra diffusivity for passive tracers - - do j=js,je ; do i=is,ie - ebtr(i,j,nz) = eb(i,j,nz) ; eatr(i,j,1) = ea(i,j,1) - enddo ; enddo - !$OMP parallel do default(shared) private(add_ent) - do k=nz,2,-1 ; do j=js,je ; do i=is,ie - if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / & - (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & - h_neglect) - else - add_ent = 0.0 - endif - ebtr(i,j,k-1) = eb(i,j,k-1) + add_ent - eatr(i,j,k) = ea(i,j,k) + add_ent - enddo ; enddo ; enddo - - if (CS%useALEalgorithm) then - ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied - call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug,& - evap_CFL_limit = CS%evap_CFL_limit, & - minimum_forcing_depth = CS%minimum_forcing_depth) - else - call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug) - endif - - else - if (CS%useALEalgorithm) then - ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied - call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug, & - evap_CFL_limit = CS%evap_CFL_limit, & - minimum_forcing_depth = CS%minimum_forcing_depth) - else - call call_tracer_column_fns(hold, h, ea, eb, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug) - endif - - endif ! (CS%mix_boundary_tracers) - - - - call cpu_clock_end(id_clock_tracers) - - - ! sponges - if (CS%use_sponge) then - call cpu_clock_begin(id_clock_sponge) - if (associated(CS%ALE_sponge_CSp)) then - ! ALE sponge - call apply_ALE_sponge(h, dt, G, CS%ALE_sponge_CSp, CS%Time) - else - ! Layer mode sponge - if (CS%bulkmixedlayer .and. associated(tv%eqn_of_state)) then - do i=is,ie ; p_ref_cv(i) = tv%P_Ref ; enddo - !$OMP parallel do default(shared) - do j=js,je - call calculate_density(tv%T(:,j,1), tv%S(:,j,1), p_ref_cv, Rcv_ml(:,j), & - is, ie-is+1, tv%eqn_of_state) - enddo - call apply_sponge(h, dt, G, GV, ea, eb, CS%sponge_CSp, Rcv_ml) - else - call apply_sponge(h, dt, G, GV, ea, eb, CS%sponge_CSp) - endif - endif - call cpu_clock_end(id_clock_sponge) - if (CS%debug) then - call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, haloshift=0) - call MOM_thermovar_chksum("apply_sponge ", tv, G) - endif - endif ! CS%use_sponge - - -! Save the diapycnal mass fluxes as a diagnostic field. - if (associated(CDp%diapyc_vel)) then - !$OMP parallel do default(shared) - do j=js,je - do K=2,nz ; do i=is,ie - CDp%diapyc_vel(i,j,K) = Idt * (GV%H_to_m * (ea(i,j,k) - eb(i,j,k-1))) - enddo ; enddo - do i=is,ie - CDp%diapyc_vel(i,j,1) = 0.0 - CDp%diapyc_vel(i,j,nz+1) = 0.0 - enddo - enddo - endif - -! For momentum, it is only the net flux that homogenizes within -! the mixed layer. Vertical viscosity that is proportional to the -! mixed layer turbulence is applied elsewhere. - if (CS%bulkmixedlayer) then - if (CS%debug) then - call hchksum(ea, "before net flux rearrangement ea",G%HI, scale=GV%H_to_m) - call hchksum(eb, "before net flux rearrangement eb",G%HI, scale=GV%H_to_m) - endif - !$OMP parallel do default(shared) private(net_ent) - do j=js,je - do K=2,GV%nkml ; do i=is,ie - net_ent = ea(i,j,k) - eb(i,j,k-1) - ea(i,j,k) = max(net_ent, 0.0) - eb(i,j,k-1) = max(-net_ent, 0.0) - enddo ; enddo - enddo - if (CS%debug) then - call hchksum(ea, "after net flux rearrangement ea",G%HI, scale=GV%H_to_m) - call hchksum(eb, "after net flux rearrangement eb",G%HI, scale=GV%H_to_m) - endif - endif - -! Initialize halo regions of ea, eb, and hold to default values. - !$OMP parallel do default(shared) - do k=1,nz - do i=is-1,ie+1 - hold(i,js-1,k) = GV%Angstrom ; ea(i,js-1,k) = 0.0 ; eb(i,js-1,k) = 0.0 - hold(i,je+1,k) = GV%Angstrom ; ea(i,je+1,k) = 0.0 ; eb(i,je+1,k) = 0.0 - enddo - do j=js,je - hold(is-1,j,k) = GV%Angstrom ; ea(is-1,j,k) = 0.0 ; eb(is-1,j,k) = 0.0 - hold(ie+1,j,k) = GV%Angstrom ; ea(ie+1,j,k) = 0.0 ; eb(ie+1,j,k) = 0.0 - enddo - enddo - - call cpu_clock_begin(id_clock_pass) - if (G%symmetric) then ; dir_flag = To_All+Omit_Corners - else ; dir_flag = To_West+To_South+Omit_Corners ; endif - call create_group_pass(CS%pass_hold_eb_ea, hold, G%Domain, dir_flag, halo=1) - call create_group_pass(CS%pass_hold_eb_ea, eb, G%Domain, dir_flag, halo=1) - call create_group_pass(CS%pass_hold_eb_ea, ea, G%Domain, dir_flag, halo=1) - call do_group_pass(CS%pass_hold_eb_ea, G%Domain) - ! visc%Kv_shear is not in the group pass because it has larger vertical extent. - if (associated(visc%Kv_shear)) & - call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) - call cpu_clock_end(id_clock_pass) - - if (.not. CS%useALEalgorithm) then - ! Use a tridiagonal solver to determine effect of the diapycnal - ! advection on velocity field. It is assumed that water leaves - ! or enters the ocean with the surface velocity. - if (CS%debug) then - call MOM_state_chksum("before u/v tridiag ", u, v, h, G, GV, haloshift=0) - call hchksum(ea, "before u/v tridiag ea",G%HI, scale=GV%H_to_m) - call hchksum(eb, "before u/v tridiag eb",G%HI, scale=GV%H_to_m) - call hchksum(hold, "before u/v tridiag hold",G%HI, scale=GV%H_to_m) - endif - call cpu_clock_begin(id_clock_tridiag) - !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) - do j=js,je - do I=Isq,Ieq - if (associated(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,1) = u(I,j,1) - hval = (hold(i,j,1) + hold(i+1,j,1)) + (ea(i,j,1) + ea(i+1,j,1)) + h_neglect - b1(I) = 1.0 / (hval + (eb(i,j,1) + eb(i+1,j,1))) - d1(I) = hval * b1(I) - u(I,j,1) = b1(I) * (hval * u(I,j,1)) - enddo - do k=2,nz ; do I=Isq,Ieq - if (associated(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,k) = u(I,j,k) - c1(I,k) = (eb(i,j,k-1)+eb(i+1,j,k-1)) * b1(I) - eaval = ea(i,j,k) + ea(i+1,j,k) - hval = hold(i,j,k) + hold(i+1,j,k) + h_neglect - b1(I) = 1.0 / ((eb(i,j,k) + eb(i+1,j,k)) + (hval + d1(I)*eaval)) - d1(I) = (hval + d1(I)*eaval) * b1(I) - u(I,j,k) = (hval*u(I,j,k) + eaval*u(I,j,k-1))*b1(I) - enddo ; enddo - do k=nz-1,1,-1 ; do I=Isq,Ieq - u(I,j,k) = u(I,j,k) + c1(I,k+1)*u(I,j,k+1) - if (associated(ADp%du_dt_dia)) & - ADp%du_dt_dia(I,j,k) = (u(I,j,k) - ADp%du_dt_dia(I,j,k)) * Idt - enddo ; enddo - if (associated(ADp%du_dt_dia)) then - do I=Isq,Ieq - ADp%du_dt_dia(I,j,nz) = (u(I,j,nz)-ADp%du_dt_dia(I,j,nz)) * Idt - enddo - endif - enddo - if (CS%debug) then - call MOM_state_chksum("aft 1st loop tridiag ", u, v, h, G, GV, haloshift=0) - endif - !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) - do J=Jsq,Jeq - do i=is,ie - if (associated(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,1) = v(i,J,1) - hval = (hold(i,j,1) + hold(i,j+1,1)) + (ea(i,j,1) + ea(i,j+1,1)) + h_neglect - b1(i) = 1.0 / (hval + (eb(i,j,1) + eb(i,j+1,1))) - d1(I) = hval * b1(I) - v(i,J,1) = b1(i) * (hval * v(i,J,1)) - enddo - do k=2,nz ; do i=is,ie - if (associated(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,k) = v(i,J,k) - c1(i,k) = (eb(i,j,k-1)+eb(i,j+1,k-1)) * b1(i) - eaval = ea(i,j,k) + ea(i,j+1,k) - hval = hold(i,j,k) + hold(i,j+1,k) + h_neglect - b1(i) = 1.0 / ((eb(i,j,k) + eb(i,j+1,k)) + (hval + d1(i)*eaval)) - d1(i) = (hval + d1(i)*eaval) * b1(i) - v(i,J,k) = (hval*v(i,J,k) + eaval*v(i,J,k-1))*b1(i) - enddo ; enddo - do k=nz-1,1,-1 ; do i=is,ie - v(i,J,k) = v(i,J,k) + c1(i,k+1)*v(i,J,k+1) - if (associated(ADp%dv_dt_dia)) & - ADp%dv_dt_dia(i,J,k) = (v(i,J,k) - ADp%dv_dt_dia(i,J,k)) * Idt - enddo ; enddo - if (associated(ADp%dv_dt_dia)) then - do i=is,ie - ADp%dv_dt_dia(i,J,nz) = (v(i,J,nz)-ADp%dv_dt_dia(i,J,nz)) * Idt - enddo - endif - enddo - call cpu_clock_end(id_clock_tridiag) - if (CS%debug) then - call MOM_state_chksum("after u/v tridiag ", u, v, h, G, GV, haloshift=0) - endif - endif ! useALEalgorithm - - call disable_averaging(CS%diag) - ! Frazil formation keeps temperature above the freezing point. - ! make_frazil is deliberately called at both the beginning and at - ! the end of the diabatic processes. - if (associated(tv%T) .AND. associated(tv%frazil)) then - call enable_averaging(0.5*dt, Time_end, CS%diag) - if (CS%frazil_tendency_diag) then - do k=1,nz ; do j=js,je ; do i=is,ie - temp_diag(i,j,k) = tv%T(i,j,k) - enddo ; enddo ; enddo - endif - - if (associated(fluxes%p_surf_full)) then - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) - else - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) - endif - - if (CS%frazil_tendency_diag) then - call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) - if (CS%id_frazil_h > 0 ) call post_data(CS%id_frazil_h, h, CS%diag) - endif - - if (showCallTree) call callTree_waypoint("done with 2nd make_frazil (diabatic)") - if (CS%debugConservation) call MOM_state_stats('2nd make_frazil', u, v, h, tv%T, tv%S, G) - call disable_averaging(CS%diag) - - endif ! endif for frazil - - ! Diagnose the diapycnal diffusivities and other related quantities. - call enable_averaging(dt, Time_end, CS%diag) - - if (CS%id_Kd_interface > 0) call post_data(CS%id_Kd_interface, Kd_int, CS%diag) - if (CS%id_Kd_heat > 0) call post_data(CS%id_Kd_heat, Kd_heat, CS%diag) - if (CS%id_Kd_salt > 0) call post_data(CS%id_Kd_salt, Kd_salt, CS%diag) - if (CS%id_Kd_ePBL > 0) call post_data(CS%id_Kd_ePBL, Kd_ePBL, CS%diag) - - if (CS%id_ea > 0) call post_data(CS%id_ea, ea, CS%diag) - if (CS%id_eb > 0) call post_data(CS%id_eb, eb, CS%diag) - - if (CS%id_dudt_dia > 0) call post_data(CS%id_dudt_dia, ADp%du_dt_dia, CS%diag) - if (CS%id_dvdt_dia > 0) call post_data(CS%id_dvdt_dia, ADp%dv_dt_dia, CS%diag) - if (CS%id_wd > 0) call post_data(CS%id_wd, CDp%diapyc_vel, CS%diag) - - if (CS%id_MLD_003 > 0 .or. CS%id_subMLN2 > 0 .or. CS%id_mlotstsq > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03, G, GV, CS%diag, & - id_N2subML=CS%id_subMLN2, id_MLDsq=CS%id_mlotstsq) - endif - if (CS%id_MLD_0125 > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125, G, GV, CS%diag) - endif - if (CS%id_MLD_user > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_user, h, tv, CS%MLDdensityDifference, G, GV, CS%diag) - endif - - if (CS%id_Tdif > 0) call post_data(CS%id_Tdif, Tdif_flx, CS%diag) - if (CS%id_Tadv > 0) call post_data(CS%id_Tadv, Tadv_flx, CS%diag) - if (CS%id_Sdif > 0) call post_data(CS%id_Sdif, Sdif_flx, CS%diag) - if (CS%id_Sadv > 0) call post_data(CS%id_Sadv, Sadv_flx, CS%diag) - if (CS%use_int_tides) then - if (CS%id_cg1 > 0) call post_data(CS%id_cg1, cn(:,:,1),CS%diag) - do m=1,CS%nMode - if (CS%id_cn(m) > 0) call post_data(CS%id_cn(m),cn(:,:,m),CS%diag) - enddo - endif - - call disable_averaging(CS%diag) - - num_z_diags = 0 - if (CS%id_Kd_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Kd_z ; z_ptrs(num_z_diags)%p => Kd_int - endif - if (CS%id_Tdif_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Tdif_z ; z_ptrs(num_z_diags)%p => Tdif_flx - endif - if (CS%id_Tadv_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Tadv_z ; z_ptrs(num_z_diags)%p => Tadv_flx - endif - if (CS%id_Sdif_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Sdif_z ; z_ptrs(num_z_diags)%p => Sdif_flx - endif - if (CS%id_Sadv_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Sadv_z ; z_ptrs(num_z_diags)%p => Sadv_flx - endif - - if (num_z_diags > 0) & - call calc_Zint_diags(h, z_ptrs, z_ids, num_z_diags, G, GV, CS%diag_to_Z_CSp) - - if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G) - if (showCallTree) call callTree_leave("diabatic()") - -end subroutine legacy_diabatic - -!> This routine diagnoses tendencies from application of diabatic diffusion -!! using ALE algorithm. Note that layer thickness is not altered by -!! diabatic diffusion. -subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, CS) - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< thickness (m or kg/m2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: temp_old !< temperature prior to diabatic physics - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: saln_old !< salinity prior to diabatic physics (PPT) - real, intent(in) :: dt !< time step (sec) - type(diabatic_CS), pointer :: CS !< module control structure - - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d - real, dimension(SZI_(G),SZJ_(G)) :: work_2d - real :: Idt - integer :: i, j, k, is, ie, js, je, nz - - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - Idt = 1/dt - work_3d(:,:,:) = 0.0 - work_2d(:,:) = 0.0 - - - ! temperature tendency - do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = (tv%T(i,j,k)-temp_old(i,j,k))*Idt - enddo ; enddo ; enddo - if (CS%id_diabatic_diff_temp_tend > 0) then - call post_data(CS%id_diabatic_diff_temp_tend, work_3d, CS%diag, alt_h = h) - endif - - ! heat tendency - if (CS%id_diabatic_diff_heat_tend > 0 .or. CS%id_diabatic_diff_heat_tend_2d > 0) then - do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = h(i,j,k) * GV%H_to_kg_m2 * tv%C_p * work_3d(i,j,k) - enddo ; enddo ; enddo - if (CS%id_diabatic_diff_heat_tend > 0) then - call post_data(CS%id_diabatic_diff_heat_tend, work_3d, CS%diag, alt_h = h) - endif - if (CS%id_diabatic_diff_heat_tend_2d > 0) then - do j=js,je ; do i=is,ie - work_2d(i,j) = 0.0 - do k=1,nz - work_2d(i,j) = work_2d(i,j) + work_3d(i,j,k) - enddo - enddo ; enddo - call post_data(CS%id_diabatic_diff_heat_tend_2d, work_2d, CS%diag) - endif - endif - - ! salinity tendency - if (CS%id_diabatic_diff_saln_tend > 0) then - do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = (tv%S(i,j,k)-saln_old(i,j,k))*Idt - enddo ; enddo ; enddo - call post_data(CS%id_diabatic_diff_saln_tend, work_3d, CS%diag, alt_h = h) - endif - - ! salt tendency - if (CS%id_diabatic_diff_salt_tend > 0 .or. CS%id_diabatic_diff_salt_tend_2d > 0) then - do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = h(i,j,k) * GV%H_to_kg_m2 * CS%ppt2mks * work_3d(i,j,k) - enddo ; enddo ; enddo - if (CS%id_diabatic_diff_salt_tend > 0) then - call post_data(CS%id_diabatic_diff_salt_tend, work_3d, CS%diag, alt_h = h) - endif - if (CS%id_diabatic_diff_salt_tend_2d > 0) then - do j=js,je ; do i=is,ie - work_2d(i,j) = 0.0 - do k=1,nz - work_2d(i,j) = work_2d(i,j) + work_3d(i,j,k) - enddo - enddo ; enddo - call post_data(CS%id_diabatic_diff_salt_tend_2d, work_2d, CS%diag) - endif - endif - -end subroutine diagnose_diabatic_diff_tendency - - -!> This routine diagnoses tendencies from application of boundary fluxes. -!! These impacts are generally 3d, in particular for penetrative shortwave. -!! Other fluxes contribute 3d in cases when the layers vanish or are very thin, -!! in which case we distribute the flux into k > 1 layers. -subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, & - dt, G, GV, CS) - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< thickness after boundary flux application (m or kg/m2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: temp_old !< temperature prior to boundary flux application - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: saln_old !< salinity prior to boundary flux application (PPT) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_old !< thickness prior to boundary flux application (m or kg/m2) - real, intent(in) :: dt !< time step (sec) - type(diabatic_CS), pointer :: CS !< module control structure - - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d - real, dimension(SZI_(G),SZJ_(G)) :: work_2d - real :: Idt - integer :: i, j, k, is, ie, js, je, nz - - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - Idt = 1/dt - work_3d(:,:,:) = 0.0 - work_2d(:,:) = 0.0 - - ! Thickness tendency - if (CS%id_boundary_forcing_h_tendency > 0) then - do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = (h(i,j,k) - h_old(i,j,k))*Idt - enddo ; enddo ; enddo - call post_data(CS%id_boundary_forcing_h_tendency, work_3d, CS%diag, alt_h = h_old) - endif - - ! temperature tendency - if (CS%id_boundary_forcing_temp_tend > 0) then - do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = (tv%T(i,j,k)-temp_old(i,j,k))*Idt - enddo ; enddo ; enddo - call post_data(CS%id_boundary_forcing_temp_tend, work_3d, CS%diag, alt_h = h_old) - endif - - ! heat tendency - if (CS%id_boundary_forcing_heat_tend > 0 .or. CS%id_boundary_forcing_heat_tend_2d > 0) then - do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = GV%H_to_kg_m2 * tv%C_p * Idt * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * temp_old(i,j,k)) - enddo ; enddo ; enddo - if (CS%id_boundary_forcing_heat_tend > 0) then - call post_data(CS%id_boundary_forcing_heat_tend, work_3d, CS%diag, alt_h = h_old) - endif - if (CS%id_boundary_forcing_heat_tend_2d > 0) then - do j=js,je ; do i=is,ie - work_2d(i,j) = 0.0 - do k=1,nz - work_2d(i,j) = work_2d(i,j) + work_3d(i,j,k) - enddo - enddo ; enddo - call post_data(CS%id_boundary_forcing_heat_tend_2d, work_2d, CS%diag) - endif - endif - - ! salinity tendency - if (CS%id_boundary_forcing_saln_tend > 0) then - do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = (tv%S(i,j,k)-saln_old(i,j,k))*Idt - enddo ; enddo ; enddo - call post_data(CS%id_boundary_forcing_saln_tend, work_3d, CS%diag, alt_h = h_old) - endif - - ! salt tendency - if (CS%id_boundary_forcing_salt_tend > 0 .or. CS%id_boundary_forcing_salt_tend_2d > 0) then - do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = GV%H_to_kg_m2 * CS%ppt2mks * Idt * (h(i,j,k) * tv%S(i,j,k) - h_old(i,j,k) * saln_old(i,j,k)) - enddo ; enddo ; enddo - if (CS%id_boundary_forcing_salt_tend > 0) then - call post_data(CS%id_boundary_forcing_salt_tend, work_3d, CS%diag, alt_h = h_old) - endif - if (CS%id_boundary_forcing_salt_tend_2d > 0) then - do j=js,je ; do i=is,ie - work_2d(i,j) = 0.0 - do k=1,nz - work_2d(i,j) = work_2d(i,j) + work_3d(i,j,k) - enddo - enddo ; enddo - call post_data(CS%id_boundary_forcing_salt_tend_2d, work_2d, CS%diag) - endif - endif - -end subroutine diagnose_boundary_forcing_tendency - - -!> This routine diagnoses tendencies for temperature and heat from frazil formation. -!! This routine is called twice from within subroutine diabatic; at start and at -!! end of the diabatic processes. The impacts from frazil are generally a function -!! of depth. Hence, when checking heat budget, be sure to remove HFSIFRAZIL from HFDS in k=1. -subroutine diagnose_frazil_tendency(tv, h, temp_old, dt, G, GV, CS) - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(diabatic_CS), pointer :: CS !< module control structure - type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< thickness (m or kg/m2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: temp_old !< temperature prior to frazil formation - real, intent(in) :: dt !< time step (sec) - - real, dimension(SZI_(G),SZJ_(G)) :: work_2d - real :: Idt - integer :: i, j, k, is, ie, js, je, nz - - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - Idt = 1/dt - - ! temperature tendency - if (CS%id_frazil_temp_tend > 0) then - do k=1,nz ; do j=js,je ; do i=is,ie - CS%frazil_temp_diag(i,j,k) = Idt * (tv%T(i,j,k)-temp_old(i,j,k)) - enddo ; enddo ; enddo - call post_data(CS%id_frazil_temp_tend, CS%frazil_temp_diag(:,:,:), CS%diag) - endif - - ! heat tendency - if (CS%id_frazil_heat_tend > 0 .or. CS%id_frazil_heat_tend_2d > 0) then - do k=1,nz ; do j=js,je ; do i=is,ie - CS%frazil_heat_diag(i,j,k) = GV%H_to_kg_m2 * tv%C_p * h(i,j,k) * Idt * (tv%T(i,j,k)-temp_old(i,j,k)) - enddo ; enddo ; enddo - if (CS%id_frazil_heat_tend > 0) call post_data(CS%id_frazil_heat_tend, CS%frazil_heat_diag(:,:,:), CS%diag) - - ! As a consistency check, we must have - ! FRAZIL_HEAT_TENDENCY_2d = HFSIFRAZIL - if (CS%id_frazil_heat_tend_2d > 0) then - do j=js,je ; do i=is,ie - work_2d(i,j) = 0.0 - do k=1,nz - work_2d(i,j) = work_2d(i,j) + CS%frazil_heat_diag(i,j,k) - enddo - enddo ; enddo - call post_data(CS%id_frazil_heat_tend_2d, work_2d, CS%diag) - endif - endif - -end subroutine diagnose_frazil_tendency - - -!> \namespace mom_diabatic_driver -!! -!! By Robert Hallberg, Alistair Adcroft, and Stephen Griffies -!! -!! This program contains the subroutine that, along with the -!! subroutines that it calls, implements diapycnal mass and momentum -!! fluxes and a bulk mixed layer. The diapycnal diffusion can be -!! used without the bulk mixed layer. -!! -!! \section section_diabatic Outline of MOM diabatic -!! -!! * diabatic first determines the (diffusive) diapycnal mass fluxes -!! based on the convergence of the buoyancy fluxes within each layer. -!! -!! * The dual-stream entrainment scheme of MacDougall and Dewar (JPO, -!! 1997) is used for combined diapycnal advection and diffusion, -!! calculated implicitly and potentially with the Richardson number -!! dependent mixing, as described by Hallberg (MWR, 2000). -!! -!! * Diapycnal advection is the residual of diapycnal diffusion, -!! so the fully implicit upwind differencing scheme that is used is -!! entirely appropriate. -!! -!! * The downward buoyancy flux in each layer is determined from -!! an implicit calculation based on the previously -!! calculated flux of the layer above and an estimated flux in the -!! layer below. This flux is subject to the following conditions: -!! (1) the flux in the top and bottom layers are set by the boundary -!! conditions, and (2) no layer may be driven below an Angstrom thick- -!! ness. If there is a bulk mixed layer, the buffer layer is treated -!! as a fixed density layer with vanishingly small diffusivity. -!! -!! diabatic takes 5 arguments: the two velocities (u and v), the -!! thicknesses (h), a structure containing the forcing fields, and -!! the length of time over which to act (dt). The velocities and -!! thickness are taken as inputs and modified within the subroutine. -!! There is no limit on the time step. - -end module MOM_legacy_diabatic_driver From e408e336e5b89689179e55891db8ae1e8b04b423 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 25 May 2018 13:50:06 -0400 Subject: [PATCH 0295/1072] Call diabatic_driver_end() - The call to diabatic_driver_end() was commented out. --- src/core/MOM.F90 | 3 +-- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 3 +-- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 74169f6a45..346f86005e 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2991,8 +2991,7 @@ subroutine MOM_end(CS) call tracer_registry_end(CS%tracer_Reg) call tracer_flow_control_end(CS%tracer_flow_CSp) - ! GMM, the following is commented because it fails on Travis. - !if (associated(CS%diabatic_CSp)) call diabatic_driver_end(CS%diabatic_CSp) + call diabatic_driver_end(CS%diabatic_CSp) if (CS%offline_tracer_mode) call offline_transport_end(CS%offline_CSp) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index b931e4e224..ffc6e938c0 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -3768,8 +3768,7 @@ subroutine diabatic_driver_end(CS) !call diag_grid_storage_end(CS%diag_grids_prev) - if (associated(CS)) deallocate(CS) - + deallocate(CS) end subroutine diabatic_driver_end From 0ff1efb72fa4fb6f9b2ab65994fed1d78937c245 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 25 May 2018 14:08:14 -0400 Subject: [PATCH 0296/1072] Avoid SEGV in CVMIX_*_end() - deallocation should only happen if allocation was done --- src/parameterizations/vertical/MOM_CVMix_conv.F90 | 2 ++ src/parameterizations/vertical/MOM_CVMix_shear.F90 | 2 ++ 2 files changed, 4 insertions(+) diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 2be8beee4a..cdb26a49e1 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -259,6 +259,8 @@ end function CVMix_conv_is_used subroutine CVMix_conv_end(CS) type(CVMix_conv_cs), pointer :: CS ! Control structure + if (.not. associated(CS)) return + deallocate(CS%N2) deallocate(CS%kd_conv) deallocate(CS%kv_conv) diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 2635af7fb5..89992ebc94 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -257,6 +257,8 @@ end function CVMix_shear_is_used subroutine CVMix_shear_end(CS) type(CVMix_shear_cs), pointer :: CS ! Control structure + if (.not. associated(CS)) return + if (CS%id_N2 > 0) deallocate(CS%N2) if (CS%id_S2 > 0) deallocate(CS%S2) if (CS%id_ri_grad > 0) deallocate(CS%ri_grad) From aa7fcebdf0f86bd7463a7bd805dc862c68e7b644 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 27 May 2018 12:35:16 -0400 Subject: [PATCH 0297/1072] +Added update_ice_shelf Created the new routine update_ice_shelf and moved 7 elements of the ice shelf control structure into the ice shelf dynamics control structure. Also moved several of the post data calls for ice shelf diagnostics into this new routine, so they will only occur with active ice shelf dynamics. All solutions are bitwise identical, but there will be changes in the MOM_parameter_doc and available diagnostics files. --- src/ice_shelf/MOM_ice_shelf.F90 | 409 ++++++++++++++++---------------- 1 file changed, 199 insertions(+), 210 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index d49b7e2395..9a00860e7a 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -34,8 +34,8 @@ module MOM_ice_shelf use MOM_get_input, only : directories, Get_MOM_input use MOM_EOS, only : calculate_density, calculate_density_derivs, calculate_TFreeze use MOM_EOS, only : EOS_type, EOS_init -!MJH use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary, initialize_ice_thickness use MOM_ice_shelf_initialize, only : initialize_ice_thickness +!MJH use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary use MOM_ice_shelf_state, only : ice_shelf_state, ice_shelf_state_end, ice_shelf_state_init use user_shelf_init, only : USER_initialize_shelf_mass, USER_update_shelf_mass use user_shelf_init, only : user_ice_shelf_CS @@ -124,19 +124,6 @@ module MOM_ice_shelf real :: input_flux real :: input_thickness - real :: velocity_update_time_step ! the time to update the velocity through the nonlinear - ! elliptic equation. i think this should be done no more often than - ! ~ once a day (maybe longer) because it will depend on ocean values - ! that are averaged over this time interval, and the solve will begin - ! to lose meaning if it is done too frequently - integer :: velocity_update_sub_counter ! there is no outer loop for the velocity solve - ! the counter will have to be stored - integer :: velocity_update_counter ! the "outer" timestep number - integer :: nstep_velocity ! ~ (velocity_update_time_step / time_step) - - real :: CFL_factor ! in uncoupled run, how to limit subcycled advective timestep - ! i.e. dt = CFL_factor * min(dx / u) - type(time_type) :: Time !< The component's time. type(EOS_type), pointer :: eqn_of_state => NULL() !< Type that indicates the !! equation of state to use. @@ -212,9 +199,8 @@ module MOM_ice_shelf calve_mask => NULL(), & !< a mask to prevent the ice shelf front from !! advancing past its initial position (but it may !! retreat) - !!! OVS !!! - t_shelf => NULL(), & ! veritcally integrated temperature the ice shelf/stream... oC - ! on q-points (B grid) + t_shelf => NULL(), & !< Veritcally integrated temperature in the ice shelf/stream, in degC + !< on corner-points (B grid) tmask => NULL(), & ! masks for temperature boundary conditions ??? ice_visc => NULL(), & @@ -228,14 +214,21 @@ module MOM_ice_shelf ! exact form depends on basal law exponent ! and/or whether flow is "hybridized" a la Goldberg 2011 - OD_rt => NULL(), float_frac_rt => NULL(), & !< two arrays that represent averages - OD_av => NULL(), float_frac => NULL() !! of ocean values that are maintained - !! within the ice shelf module and updated based on the "ocean state". - !! OD_av is ocean depth, and float_frac is the average amount of time - !! a cell is "exposed", i.e. the column thickness is below a threshold. - !! both are averaged over the time of a diagnostic (ice velocity) - + OD_rt => NULL(), & !< A running total for calulating OD_av. + float_frac_rt => NULL(), & !< A running total for calculating float_frac. + OD_av => NULL(), & !< The time average open ocean depth, in m. + float_frac => NULL() !< Fraction of the time a cell is "exposed", i.e. the column + !! thickness is below a threshold. !! [if float_frac = 1 ==> grounded; obv. counterintuitive; might fix] + integer :: OD_rt_counter = 0 !< A counter of the number of contributions to OD_rt. + + real :: velocity_update_time_step !< The time in s to update the ice shelf velocity through the + !! nonlinear elliptic equation, or 0 to update every timestep. + ! DNGoldberg thinks this should be done no more often than about once a day + ! (maybe longer) because it will depend on ocean values that are averaged over + ! this time interval, and solving for the equiliabrated flow will begin to lose + ! meaning if it is done too frequently. + real :: elapsed_velocity_time !< The elapsed time since the ice velocies were last udated, in s. real :: density_ice !< A typical density of ice, in kg m-3. @@ -251,6 +244,8 @@ module MOM_ice_shelf !! will be called (note: GL_regularize and GL_couple !! should be exclusive) + real :: CFL_factor !< A factor used to limit subcycled advective timestep in uncoupled runs + !! i.e. dt <= CFL_factor * min(dx / u) real :: A_glen_isothermal real :: n_glen @@ -286,10 +281,9 @@ module MOM_ice_shelf !>@{ ! Diagnostic handles - integer :: id_u_shelf = -1, id_v_shelf = -1, & - id_float_frac = -1, id_col_thick = -1, & - id_u_mask = -1, id_v_mask = -1, id_t_shelf = -1, id_t_mask = -1, & - id_OD_av = -1, id_float_frac_rt = -1 + integer :: id_u_shelf = -1, id_v_shelf = -1, id_t_shelf = -1, & + id_float_frac = -1, id_col_thick = -1, id_OD_av = -1, & + id_u_mask = -1, id_v_mask = -1, id_t_mask = -1 !>@} ! ids for outputting intermediate thickness in advection subroutine (debugging) !integer :: id_h_after_uflux = -1, id_h_after_vflux = -1, id_h_after_adv = -1 @@ -415,7 +409,9 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) real :: I_Gam_T, I_Gam_S, dG_dwB, iDens real :: u_at_h, v_at_h, Isqrt2 logical :: Sb_min_set, Sb_max_set - character(4) :: stepnum + logical :: update_ice_vel ! If true, it is time to update the ice shelf velocities. + logical :: coupled_GL ! If true, the grouding line position is determined based on + ! coupled ice-ocean dynamics. real, parameter :: c2_3 = 2.0/3.0 integer :: i, j, is, ie, js, je, ied, jed, it1, it3, iters_vel_solve @@ -799,28 +795,13 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) ! now the thermodynamic data is passed on... time to update the ice dynamic quantities if (CS%active_shelf_dynamics) then + update_ice_vel = .false. + coupled_GL = (CS%GL_couple .and. .not.CS%solo_ice_sheet) ! advect the ice shelf, and advance the front. Calving will be in here somewhere as well.. ! when we decide on how to do it + call update_ice_shelf(CS%dCS, ISS, G, time_step, Time, state%ocean_mass, coupled_GL) - ! note time_step is [s] and lprec is [kg / m^2 / s] - - call ice_shelf_advect(CS%dCS, ISS, G, time_step, Time) - - CS%velocity_update_sub_counter = CS%velocity_update_sub_counter+1 - - if (CS%GL_couple .and. .not. CS%solo_ice_sheet) then - call update_OD_ffrac(CS%dCS, G, state%ocean_mass, CS%velocity_update_sub_counter, CS%nstep_velocity, & - CS%time_step, CS%velocity_update_time_step) - else - call update_OD_ffrac_uncoupled(CS%dCS, G, ISS%h_shelf) - endif - - if (CS%velocity_update_sub_counter == CS%nstep_velocity) then - call MOM_mesg("MOM_ice_shelf.F90, shelf_calc_flux: About to call velocity solver") - call ice_shelf_solve_outer(CS%dCS, ISS, G, CS%dCS%u_shelf, CS%dCS%v_shelf, iters_vel_solve, Time) - CS%velocity_update_sub_counter = 0 - endif endif call enable_averaging(time_step,Time,CS%diag) @@ -840,13 +821,6 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) if (CS%id_exch_vel_s > 0) call post_data(CS%id_exch_vel_s, exch_vel_s, CS%diag) if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf,ISS%h_shelf,CS%diag) if (CS%id_h_mask > 0) call post_data(CS%id_h_mask,ISS%hmask,CS%diag) - - if (CS%dCS%id_col_thick > 0) call post_data(CS%dCS%id_col_thick, CS%dCS%OD_av, CS%diag) - if (CS%dCS%id_u_shelf > 0) call post_data(CS%dCS%id_u_shelf,CS%dCS%u_shelf,CS%diag) - if (CS%dCS%id_v_shelf > 0) call post_data(CS%dCS%id_v_shelf,CS%dCS%v_shelf,CS%diag) - if (CS%dCS%id_float_frac > 0) call post_data(CS%dCS%id_float_frac,CS%dCS%float_frac,CS%diag) - if (CS%dCS%id_OD_av >0) call post_data(CS%dCS%id_OD_av,CS%dCS%OD_av,CS%diag) - if (CS%dCS%id_float_frac_rt>0) call post_data(CS%dCS%id_float_frac_rt,CS%dCS%float_frac_rt,CS%diag) call disable_averaging(CS%diag) call cpu_clock_end(id_clock_shelf) @@ -1424,8 +1398,6 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl "The time step for changing forcing, coupling with other \n"//& "components, or potentially writing certain diagnostics. \n"//& "The default value is given by DT.", units="s", default=0.0) - call get_param(param_file, mdl, "SHELF_DIAG_TIMESTEP", CS%velocity_update_time_step, & - "A timestep to use for diagnostics of the shelf.", default=0.0) call get_param(param_file, mdl, "COL_THICK_MELT_THRESHOLD", CS%col_thick_melt_threshold, & "The minimum ML thickness where melting is allowed.", units="m", & @@ -1468,20 +1440,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call get_param(param_file, mdl, "INPUT_THICK_ICE_SHELF", CS%input_thickness, & "flux thickness at upstream boundary", & units="m", default=1000.) - call get_param(param_file, mdl, "ICE_VELOCITY_TIMESTEP", CS%velocity_update_time_step, & - "seconds between ice velocity calcs", units="s", & - fail_if_missing=.true.) - - call get_param(param_file, mdl, "ICE_SHELF_CFL_FACTOR", CS%CFL_factor, & - "limit timestep as a factor of min (\Delta x / u); \n"// & - "only important for ice-only model", & - default=0.25) - - CS%nstep_velocity = FLOOR (CS%velocity_update_time_step / CS%time_step) - CS%velocity_update_counter = 0 - CS%velocity_update_sub_counter = 0 else - CS%nstep_velocity = 0 ! This is here because of inconsistent defaults. I don't know why. RWH call get_param(param_file, mdl, "DENSITY_ICE", CS%density_ice, & "A typical density of ice.", units="kg m-3", default=900.0) @@ -1756,11 +1715,10 @@ subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) active_shelf_dynamics = .not.override_shelf_movement endif - allocate( CS%t_shelf(isd:ied,jsd:jed) ) ; CS%t_shelf(:,:) = -10.0 - if (active_shelf_dynamics) then allocate( CS%u_shelf(IsdB:IedB,JsdB:JedB) ) ; CS%u_shelf(:,:) = 0.0 allocate( CS%v_shelf(IsdB:IedB,JsdB:JedB) ) ; CS%v_shelf(:,:) = 0.0 + allocate( CS%t_shelf(isd:ied,jsd:jed) ) ; CS%t_shelf(:,:) = -10.0 allocate( CS%ice_visc(isd:ied,jsd:jed) ) ; CS%ice_visc(:,:) = 0.0 allocate( CS%taub_beta_eff(isd:ied,jsd:jed) ) ; CS%taub_beta_eff(:,:) = 0.0 allocate( CS%OD_av(isd:ied,jsd:jed) ) ; CS%OD_av(:,:) = 0.0 @@ -1856,11 +1814,17 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, diag, new_sim, if (CS%GL_regularize) CS%GL_couple = .false. if (CS%GL_regularize .and. (CS%n_sub_regularize == 0)) call MOM_error (FATAL, & "GROUNDING_LINE_INTERP_SUBGRID_N must be a positive integer if GL regularization is used") + call get_param(param_file, mdl, "ICE_SHELF_CFL_FACTOR", CS%CFL_factor, & + "A factor used to limit timestep as CFL_FACTOR * min (\Delta x / u). \n"// & + "This is only used with an ice-only model.", default=0.25) endif call get_param(param_file, mdl, "RHO_0", CS%density_ocean_avg, & "avg ocean density used in floatation cond", & units="kg m-3", default=1035.) if (active_shelf_dynamics) then + call get_param(param_file, mdl, "ICE_VELOCITY_TIMESTEP", CS%velocity_update_time_step, & + "seconds between ice velocity calcs", units="s", & + fail_if_missing=.true.) call get_param(param_file, mdl, "A_GLEN_ISOTHERM", CS%A_glen_isothermal, & "Ice viscosity parameter in Glen's Law", & @@ -1911,13 +1875,12 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, diag, new_sim, ! Allocate memory in the ice shelf dynamics control structure that was not ! previously allocated for registration for restarts. ! OVS vertically integrated Temperature - allocate( CS%t_bdry_val(isd:ied,jsd:jed) ) ; CS%t_bdry_val(:,:) = -15.0 - allocate( CS%tmask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%tmask(:,:) = -1.0 if (active_shelf_dynamics) then ! DNG allocate( CS%u_bdry_val(Isdq:Iedq,Jsdq:Jedq) ) ; CS%u_bdry_val(:,:) = 0.0 allocate( CS%v_bdry_val(Isdq:Iedq,Jsdq:Jedq) ) ; CS%v_bdry_val(:,:) = 0.0 + allocate( CS%t_bdry_val(isd:ied,jsd:jed) ) ; CS%t_bdry_val(:,:) = -15.0 allocate( CS%h_bdry_val(isd:ied,jsd:jed) ) ; CS%h_bdry_val(:,:) = 0.0 allocate( CS%thickness_bdry_val(isd:ied,jsd:jed) ) ; CS%thickness_bdry_val(:,:) = 0.0 allocate( CS%u_face_mask(Isdq:Iedq,jsd:jed) ) ; CS%u_face_mask(:,:) = 0.0 @@ -1928,7 +1891,9 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, diag, new_sim, allocate( CS%v_flux_bdry_val(isd:ied,Jsdq:Jedq) ) ; CS%v_flux_bdry_val(:,:) = 0.0 allocate( CS%umask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%umask(:,:) = -1.0 allocate( CS%vmask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%vmask(:,:) = -1.0 + allocate( CS%tmask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%tmask(:,:) = -1.0 + CS%OD_rt_counter = 0 allocate( CS%OD_rt(isd:ied,jsd:jed) ) ; CS%OD_rt(:,:) = 0.0 allocate( CS%float_frac_rt(isd:ied,jsd:jed) ) ; CS%float_frac_rt(:,:) = 0.0 @@ -1936,9 +1901,8 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, diag, new_sim, allocate( CS%calve_mask(isd:ied,jsd:jed) ) ; CS%calve_mask(:,:) = 0.0 endif - endif + CS%elapsed_velocity_time = 0.0 - if (active_shelf_dynamics) then call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) endif @@ -2006,10 +1970,7 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, diag, new_sim, if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf,CS%v_shelf,CS%diag) endif - endif - ! Register diagnostics. - if (active_shelf_dynamics) then CS%id_u_shelf = register_diag_field('ocean_model','u_shelf',CS%diag%axesCu1, Time, & 'x-velocity of ice', 'm yr-1') CS%id_v_shelf = register_diag_field('ocean_model','v_shelf',CS%diag%axesCv1, Time, & @@ -2026,8 +1987,6 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, diag, new_sim, 'ocean column thickness passed to ice model', 'm') CS%id_OD_av = register_diag_field('ocean_model','OD_av',CS%diag%axesT1, Time, & 'intermediate ocean column thickness passed to ice model', 'm') - CS%id_float_frac_rt = register_diag_field('ocean_model','float_frac_rt',CS%diag%axesT1, Time, & - 'timesteps where cell is floating ', 'none') !CS%id_h_after_uflux = register_diag_field('ocean_model','h_after_uflux',CS%diag%axesh1, Time, & ! 'thickness after u flux ', 'none') !CS%id_h_after_vflux = register_diag_field('ocean_model','h_after_vflux',CS%diag%axesh1, Time, & @@ -2226,6 +2185,97 @@ subroutine ice_shelf_save_restart(CS, Time, directory, time_stamped, filename_su end subroutine ice_shelf_save_restart +!> This function returns the global maximum timestep that can be taken based on the current +!! ice velocities. Because it involves finding a global minimum, it can be suprisingly expensive. +function ice_time_step_CFL(CS, ISS, G) + type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure + type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe + !! the ice-shelf state + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real :: ice_time_step_CFL !< The maximum permitted timestep, in s, based on the ice velocities. + + real :: ratio, min_ratio + real :: local_u_max, local_v_max + integer :: i, j + + min_ratio = 1.0e16 ! This is just an arbitrary large value. + do j=G%jsc,G%jec ; do i=G%isc,G%iec ; if (ISS%hmask(i,j) == 1.0) then + local_u_max = max(abs(CS%u_shelf(i,j)), abs(CS%u_shelf(i+1,j+1)), & + abs(CS%u_shelf(i+1,j)), abs(CS%u_shelf(i,j+1))) + local_v_max = max(abs(CS%v_shelf(i,j)), abs(CS%v_shelf(i+1,j+1)), & + abs(CS%v_shelf(i+1,j)), abs(CS%v_shelf(i,j+1))) + + ratio = min(G%areaT(i,j) / (local_u_max+1.0e-12), G%areaT(i,j) / (local_v_max+1.0e-12)) + min_ratio = min(min_ratio, ratio) + endif ; enddo ; enddo ! i- and j- loops + + call mpp_min(min_ratio) + + ! solved velocities are in m/yr; we want time_step_int in seconds + ice_time_step_CFL = CS%CFL_factor * min_ratio * (365*86400) + +end function ice_time_step_CFL + +!> This subroutine updates the ice shelf velocities, mass, stresses and properties due to the +!! ice shelf dynamics. +subroutine update_ice_shelf(CS, ISS, G, time_step, Time, ocean_mass, coupled_grounding, must_update_vel) + type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure + type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe + !! the ice-shelf state + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real, intent(in) :: time_step !< time step in sec + type(time_type), intent(in) :: Time !< The current model time + real, dimension(SZDI_(G),SZDJ_(G)), & + optional, intent(in) :: ocean_mass !< If present this is the mass puer unit area + !! of the ocean in kg m-2. + logical, optional, intent(in) :: coupled_grounding !< If true, the grounding line is + !! determined by coupled ice-ocean dynamics + logical, optional, intent(in) :: must_update_vel !< Always update the ice velocities if true. + + integer :: iters + logical :: update_ice_vel, coupled_GL + + update_ice_vel = .false. + if (present(must_update_vel)) update_ice_vel = must_update_vel + + coupled_GL = .false. + if (present(ocean_mass) .and. present(coupled_grounding)) coupled_GL = coupled_grounding + + call ice_shelf_advect(CS, ISS, G, time_step, Time) + CS%elapsed_velocity_time = CS%elapsed_velocity_time + time_step + if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) update_ice_vel = .true. + + if (coupled_GL) then + call update_OD_ffrac(CS, G, ocean_mass, update_ice_vel) + elseif (update_ice_vel) then + call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf) + endif + + if (update_ice_vel) then + call ice_shelf_solve_outer(CS, ISS, G, CS%u_shelf, CS%v_shelf, iters, Time) + endif + + call ice_shelf_temp(CS, ISS, G, time_step, ISS%water_flux, Time) + + if (update_ice_vel) then + call enable_averaging(CS%elapsed_velocity_time, Time, CS%diag) + if (CS%id_col_thick > 0) call post_data(CS%id_col_thick, CS%OD_av, CS%diag) + if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf,CS%u_shelf,CS%diag) + if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf,CS%v_shelf,CS%diag) + if (CS%id_t_shelf > 0) call post_data(CS%id_t_shelf,CS%t_shelf,CS%diag) + if (CS%id_float_frac > 0) call post_data(CS%id_float_frac,CS%float_frac,CS%diag) + if (CS%id_OD_av >0) call post_data(CS%id_OD_av,CS%OD_av,CS%diag) + + if (CS%id_u_mask > 0) call post_data(CS%id_u_mask,CS%umask,CS%diag) + if (CS%id_v_mask > 0) call post_data(CS%id_v_mask,CS%vmask,CS%diag) + if (CS%id_t_mask > 0) call post_data(CS%id_t_mask,CS%tmask,CS%diag) + + call disable_averaging(CS%diag) + + CS%elapsed_velocity_time = 0.0 + endif + +end subroutine update_ice_shelf !> This subroutine takes the velocity (on the Bgrid) and timesteps h_t = - div (uh) once. !! Additionally, it will update the volume of ice in partially-filled cells, and update @@ -2345,7 +2395,7 @@ end subroutine ice_shelf_advect subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe - !! the ice-shelf state + !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, dimension(SZDIB_(G),SZDJB_(G)), & intent(inout) :: u, v @@ -4514,48 +4564,41 @@ subroutine calc_shelf_visc(CS, ISS, G, u, v) end subroutine calc_shelf_visc -subroutine update_OD_ffrac(CS, G, ocean_mass, counter, nstep_velocity, time_step, velocity_update_time_step) - type(ice_shelf_dyn_CS), intent(inout):: CS !< A pointer to the ice shelf control structure - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, dimension(G%isd:,G%jsd:) :: ocean_mass - integer,intent(in) :: counter - integer,intent(in) :: nstep_velocity - real,intent(in) :: time_step !< The time step for this update, in s. - real,intent(in) :: velocity_update_time_step +subroutine update_OD_ffrac(CS, G, ocean_mass, find_avg) + type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: ocean_mass !< The mass per unit area of the ocean in kg m-2. + logical, intent(in) :: find_avg !< If true, find the average of OD and ffrac, and + !! reset the underlying running sums to 0. integer :: isc, iec, jsc, jec, i, j - real :: threshold_col_depth, rho_ocean, inv_rho_ocean - - threshold_col_depth = CS%thresh_float_col_depth + real :: I_rho_ocean + real :: I_counter - rho_ocean = CS%density_ocean_avg - inv_rho_ocean = 1./rho_ocean + I_rho_ocean = 1.0/CS%density_ocean_avg isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec - do j=jsc,jec - do i=isc,iec - CS%OD_rt(i,j) = CS%OD_rt(i,j) + ocean_mass(i,j)*inv_rho_ocean - if (ocean_mass(i,j) > threshold_col_depth*rho_ocean) then - CS%float_frac_rt(i,j) = CS%float_frac_rt(i,j) + 1.0 - endif - enddo - enddo - - if (counter == nstep_velocity) then + do j=jsc,jec ; do i=isc,iec + CS%OD_rt(i,j) = CS%OD_rt(i,j) + ocean_mass(i,j)*I_rho_ocean + if (ocean_mass(i,j)*I_rho_ocean > CS%thresh_float_col_depth) then + CS%float_frac_rt(i,j) = CS%float_frac_rt(i,j) + 1.0 + endif + enddo ; enddo + CS%OD_rt_counter = CS%OD_rt_counter + 1 - do j=jsc,jec - do i=isc,iec - CS%float_frac(i,j) = 1.0 - (CS%float_frac_rt(i,j) / real(nstep_velocity)) - CS%OD_av(i,j) = CS%OD_rt(i,j) / real(nstep_velocity) + if (find_avg) then + I_counter = 1.0 / real(CS%OD_rt_counter) + do j=jsc,jec ; do i=isc,iec + CS%float_frac(i,j) = 1.0 - (CS%float_frac_rt(i,j) * I_counter) + CS%OD_av(i,j) = CS%OD_rt(i,j) * I_counter - CS%OD_rt(i,j) = 0.0 ; CS%float_frac_rt(i,j) = 0.0 - enddo - enddo + CS%OD_rt(i,j) = 0.0 ; CS%float_frac_rt(i,j) = 0.0 + enddo ; enddo call pass_var(CS%float_frac, G%domain) call pass_var(CS%OD_av, G%domain) - endif end subroutine update_OD_ffrac @@ -4568,11 +4611,9 @@ subroutine update_OD_ffrac_uncoupled(CS, G, h_shelf) integer :: i, j, iters, isd, ied, jsd, jed real :: rhoi, rhow, OD - type(time_type) :: dummy_time rhoi = CS%density_ice rhow = CS%density_ocean_avg - dummy_time = set_time (0,0) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed do j=jsd,jed @@ -4955,121 +4996,75 @@ subroutine ice_shelf_end(CS) end subroutine ice_shelf_end -subroutine solo_time_step(CS, time_step, n, Time, min_time_step_in) +subroutine solo_time_step(CS, time_step, nsteps, Time, min_time_step_in) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - real,intent(in) :: time_step !< The time step for this update, in s. - integer, intent(inout) :: n - type(time_type) :: Time !< The current model time - real,optional,intent(in) :: min_time_step_in + real, intent(in) :: time_step !< The time interval for this update, in s. + integer, intent(inout) :: nsteps !< The running number of ice shelf steps. + type(time_type), intent(inout) :: Time !< The current model time + real, optional, intent(in) :: min_time_step_in !< The minimum permitted time step in s. type(ocean_grid_type), pointer :: G => NULL() type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe !! the ice-shelf state type(ice_shelf_dyn_CS), pointer :: dCS => NULL() - integer :: is, iec, js, jec, i, j, ki, kj, iters - real :: ratio, min_ratio, time_step_remain, local_u_max, & - local_v_max, time_step_int, min_time_step,spy,dumtimeprint - logical :: flag - type (time_type) :: dummy - character(4) :: stepnum - - CS%velocity_update_sub_counter = CS%velocity_update_sub_counter + 1 + integer :: is, iec, js, jec, i, j, ki, kj, iters + real :: ratio, min_ratio, time_step_remain, local_u_max + real :: local_v_max, time_step_int, min_time_step, spy, dumtimeprint + character(len=240) :: mesg + logical :: update_ice_vel ! If true, it is time to update the ice shelf velocities. + logical :: coupled_GL ! If true the grouding line position is determined based on + ! coupled ice-ocean dynamics. + logical :: flag + spy = 365 * 86400 G => CS%grid ISS => CS%ISS dCS => CS%dCS + is = G%isc ; iec = G%iec ; js = G%jsc ; jec = G%jec time_step_remain = time_step - if (.not. (present (min_time_step_in))) then - min_time_step = 1000 ! i think this is in seconds - this would imply ice is moving at ~1 meter per second + if (present (min_time_step_in)) then + min_time_step = min_time_step_in else - min_time_step=min_time_step_in + min_time_step = 1000.0 ! This is in seconds - at 1 km resolution it would imply ice is moving at ~1 meter per second endif - is = G%isc ; iec = G%iec ; js = G%jsc ; jec = G%jec ! NOTE: this relies on NE grid indexing ! dumtimeprint=time_type_to_real(Time)/spy - if (is_root_pe()) print *, "TIME in ice shelf call, yrs: ", time_type_to_real(Time)/spy + write (mesg,*) "TIME in ice shelf call, yrs: ", time_type_to_real(Time)/spy + call MOM_mesg("solo_time_step: "//mesg) do while (time_step_remain > 0.0) + nsteps = nsteps+1 - min_ratio = 1.0e16 - n=n+1 - do j=js,jec - do i=is,iec - - local_u_max = 0 ; local_v_max = 0 + ! If time_step is not too long, this is unnecessary. + time_step_int = min(ice_time_step_CFL(dCS, ISS, G), time_step) - if (ISS%hmask(i,j) == 1.0) then - ! all 4 corners of the cell should have valid velocity values; otherwise something is wrong - ! this is done by checking that umask and vmask are nonzero at all 4 corners - do ki=1,2 ; do kj = 1,2 - - local_u_max = max(local_u_max, abs(dCS%u_shelf(i-1+ki,j-1+kj))) - local_v_max = max(local_v_max, abs(dCS%v_shelf(i-1+ki,j-1+kj))) - - enddo ; enddo - - ratio = min(G%areaT(i,j) / (local_u_max+1.0e-12), G%areaT(i,j) / (local_v_max+1.0e-12)) - min_ratio = min(min_ratio, ratio) - - endif - enddo ! j loop - enddo ! i loop - - ! solved velocities are in m/yr; we want m/s - - call mpp_min(min_ratio) - - time_step_int = min(CS%CFL_factor * min_ratio * (365*86400), time_step) - - if (time_step_int < min_time_step) then - call MOM_error(FATAL, "MOM_ice_shelf:solo_time_step: abnormally small timestep") - else - if (is_root_pe()) then - write(*,*) "Ice model timestep: ", time_step_int, " seconds" - endif - endif - - if (time_step_int >= time_step_remain) then - time_step_int = time_step_remain - time_step_remain = 0.0 - else - time_step_remain = time_step_remain - time_step_int - endif - - write (stepnum,'(I4)') CS%velocity_update_sub_counter - - call ice_shelf_advect(dCS, ISS, G, time_step_int, Time) - - ! if the last mini-timestep is a day or less, we cannot expect velocities to change by much. - ! do not update them - if (time_step_int > 1000) then - call update_velocity_masks(dCS, G, ISS%hmask, dCS%umask, dCS%vmask, dCS%u_face_mask, dCS%v_face_mask) + write (mesg,*) "Ice model timestep = ", time_step_int, " seconds" + if (time_step_int < min_time_step) then + call MOM_error(FATAL, "MOM_ice_shelf:solo_time_step: abnormally small timestep "//mesg) + else + call MOM_mesg("solo_time_step: "//mesg) + endif - call update_OD_ffrac_uncoupled(dCS, G, ISS%h_shelf) - call ice_shelf_solve_outer(dCS, ISS, G, dCS%u_shelf, dCS%v_shelf, iters, dummy) - endif + if (time_step_int >= time_step_remain) then + time_step_int = time_step_remain + time_step_remain = 0.0 + else + time_step_remain = time_step_remain - time_step_int + endif -!!! OVS!!! - call ice_shelf_temp(dCS, ISS, G, time_step_int, ISS%water_flux, Time) + ! If the last mini-timestep is a day or less, we cannot expect velocities to change by much. + ! Do not update the velocities if the last step is very short. + update_ice_vel = ((time_step_int > min_time_step) .or. (time_step_int >= time_step)) + coupled_GL = .false. + call update_ice_shelf(dCS, ISS, G, time_step_int, Time, must_update_vel=update_ice_vel) + call enable_averaging(time_step,Time,CS%diag) if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, ISS%area_shelf_h, CS%diag) if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf,ISS%h_shelf,CS%diag) if (CS%id_h_mask > 0) call post_data(CS%id_h_mask,ISS%hmask,CS%diag) - - if (dCS%id_col_thick > 0) call post_data(dCS%id_col_thick, dCS%OD_av, CS%diag) - if (dCS%id_u_mask > 0) call post_data(dCS%id_u_mask,dCS%umask,CS%diag) - if (dCS%id_v_mask > 0) call post_data(dCS%id_v_mask,dCS%vmask,CS%diag) - if (dCS%id_u_shelf > 0) call post_data(dCS%id_u_shelf,dCS%u_shelf,CS%diag) - if (dCS%id_v_shelf > 0) call post_data(dCS%id_v_shelf,dCS%v_shelf,CS%diag) - if (dCS%id_float_frac > 0) call post_data(dCS%id_float_frac,dCS%float_frac,CS%diag) - if (dCS%id_OD_av >0) call post_data(dCS%id_OD_av,dCS%OD_av,CS%diag) - if (dCS%id_float_frac_rt>0) call post_data(dCS%id_float_frac_rt,dCS%float_frac_rt,CS%diag) - if (dCS%id_t_mask > 0) call post_data(dCS%id_t_mask,dCS%tmask,CS%diag) - if (dCS%id_t_shelf > 0) call post_data(dCS%id_t_shelf,dCS%t_shelf,CS%diag) - call disable_averaging(CS%diag) enddo @@ -5161,18 +5156,12 @@ subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) ! call enable_averaging(time_step,Time,CS%diag) - ! call pass_var(h_after_uflux, G%domain) -! if (CS%id_h_after_uflux > 0) call post_data(CS%id_h_after_uflux, h_after_uflux, CS%diag) -! call disable_averaging(CS%diag) - - -! call enable_averaging(time_step,Time,CS%diag) +! call pass_var(h_after_uflux, G%domain) ! call pass_var(h_after_vflux, G%domain) +! if (CS%id_h_after_uflux > 0) call post_data(CS%id_h_after_uflux, h_after_uflux, CS%diag) ! if (CS%id_h_after_vflux > 0) call post_data(CS%id_h_after_vflux, h_after_vflux, CS%diag) ! call disable_averaging(CS%diag) - - call ice_shelf_advect_temp_x(CS, G, time_step/spy, ISS%hmask, TH, th_after_uflux, flux_enter) call ice_shelf_advect_temp_y(CS, G, time_step/spy, ISS%hmask, th_after_uflux, th_after_vflux, flux_enter) @@ -5182,7 +5171,7 @@ subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) if (ISS%h_shelf(i,j) > 0.0) then CS%t_shelf(i,j) = th_after_vflux(i,j)/ISS%h_shelf(i,j) else - CS%t_shelf(i,j) = -10.0 + CS%t_shelf(i,j) = -10.0 endif enddo enddo From 16ec6b1d5cf5c0d13c5c95e36ade6f48e675c6e9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 27 May 2018 14:28:04 -0400 Subject: [PATCH 0298/1072] +Created MOM_ice_shelf_dynamics Created a new module for the ice shelf dynamics, separating numerous routines out from MOM_ice_shelf. All answers are bitwise identical, although there are several new publicly visible subroutines. --- src/ice_shelf/MOM_ice_shelf.F90 | 4051 +--------------------- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 4034 +++++++++++++++++++++ 2 files changed, 4109 insertions(+), 3976 deletions(-) create mode 100644 src/ice_shelf/MOM_ice_shelf_dynamics.F90 diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 9a00860e7a..1f8d0ada05 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -34,14 +34,16 @@ module MOM_ice_shelf use MOM_get_input, only : directories, Get_MOM_input use MOM_EOS, only : calculate_density, calculate_density_derivs, calculate_TFreeze use MOM_EOS, only : EOS_type, EOS_init +use MOM_ice_shelf_dynamics, only : ice_shelf_dyn_CS, update_ice_shelf +use MOM_ice_shelf_dynamics, only : register_ice_shelf_dyn_restarts, initialize_ice_shelf_dyn +use MOM_ice_shelf_dynamics, only : ice_shelf_min_thickness_calve +use MOM_ice_shelf_dynamics, only : ice_time_step_CFL, ice_shelf_dyn_end use MOM_ice_shelf_initialize, only : initialize_ice_thickness !MJH use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary use MOM_ice_shelf_state, only : ice_shelf_state, ice_shelf_state_end, ice_shelf_state_init use user_shelf_init, only : USER_initialize_shelf_mass, USER_update_shelf_mass use user_shelf_init, only : user_ice_shelf_CS -use constants_mod, only: GRAV -use mpp_mod, only : mpp_sum, mpp_max, mpp_min, mpp_pe, mpp_npes, mpp_sync -use MOM_coms, only : reproducing_sum +use MOM_coms, only : reproducing_sum, sum_across_PEs use MOM_checksums, only : hchksum, qchksum, chksum, uchksum, vchksum, uvchksum use time_interp_external_mod, only : init_external_field, time_interp_external use time_interp_external_mod, only : time_interp_external_init @@ -167,171 +169,10 @@ module MOM_ice_shelf !! and use reproducible sums end type ice_shelf_CS -!> The control structure for the ice shelf dynamics. -type, public :: ice_shelf_dyn_CS ; private - real, pointer, dimension(:,:) :: & - u_shelf => NULL(), & !< the zonal (?) velocity of the ice shelf/sheet, - ! in meters per second??? on q-points (B grid) - v_shelf => NULL(), & !< the meridional velocity of the ice shelf/sheet, - !! in m/s ?? on q-points (B grid) - - u_face_mask => NULL(), & !> masks for velocity boundary conditions - v_face_mask => NULL(), & !! on *C GRID* - this is because the FEM - !! cares about FACES THAT GET INTEGRATED OVER, - !! not vertices. Will represent boundary conditions - !! on computational boundary (or permanent boundary - !! between fast-moving and near-stagnant ice - !! FOR NOW: 1=interior bdry, 0=no-flow boundary, - !! 2=stress bdry condition, 3=inhomogeneous - !! dirichlet boundary, 4=flux boundary: at these - !! faces a flux will be specified which will - !! override velocities; a homogeneous velocity - !! condition will be specified (this seems to give - !! the solver less difficulty) - u_face_mask_bdry => NULL(), & - v_face_mask_bdry => NULL(), & - u_flux_bdry_val => NULL(), & - v_flux_bdry_val => NULL(), & - ! needed where u_face_mask is equal to 4, similary for v_face_mask - umask => NULL(), vmask => NULL(), & !< masks on the actual degrees of freedom (B grid) - !! 1=normal node, 3=inhomogeneous boundary node, - !! 0 - no flow node (will also get ice-free nodes) - calve_mask => NULL(), & !< a mask to prevent the ice shelf front from - !! advancing past its initial position (but it may - !! retreat) - t_shelf => NULL(), & !< Veritcally integrated temperature in the ice shelf/stream, in degC - !< on corner-points (B grid) - tmask => NULL(), & - ! masks for temperature boundary conditions ??? - ice_visc => NULL(), & - thickness_bdry_val => NULL(), & - u_bdry_val => NULL(), & - v_bdry_val => NULL(), & - h_bdry_val => NULL(), & - t_bdry_val => NULL(), & - - taub_beta_eff => NULL(), & ! nonlinear part of "linearized" basal stress - - ! exact form depends on basal law exponent - ! and/or whether flow is "hybridized" a la Goldberg 2011 - - OD_rt => NULL(), & !< A running total for calulating OD_av. - float_frac_rt => NULL(), & !< A running total for calculating float_frac. - OD_av => NULL(), & !< The time average open ocean depth, in m. - float_frac => NULL() !< Fraction of the time a cell is "exposed", i.e. the column - !! thickness is below a threshold. - !! [if float_frac = 1 ==> grounded; obv. counterintuitive; might fix] - integer :: OD_rt_counter = 0 !< A counter of the number of contributions to OD_rt. - - real :: velocity_update_time_step !< The time in s to update the ice shelf velocity through the - !! nonlinear elliptic equation, or 0 to update every timestep. - ! DNGoldberg thinks this should be done no more often than about once a day - ! (maybe longer) because it will depend on ocean values that are averaged over - ! this time interval, and solving for the equiliabrated flow will begin to lose - ! meaning if it is done too frequently. - real :: elapsed_velocity_time !< The elapsed time since the ice velocies were last udated, in s. - - real :: density_ice !< A typical density of ice, in kg m-3. - - logical :: GL_regularize !< whether to regularize the floatation condition - !! at the grounding line a la Goldberg Holland Schoof 2009 - integer :: n_sub_regularize - !< partition of cell over which to integrate for - !! interpolated grounding line the (rectangular) is - !! divided into nxn equally-sized rectangles, over which - !! basal contribution is integrated (iterative quadrature) - logical :: GL_couple !< whether to let the floatation condition be - !!determined by ocean column thickness means update_OD_ffrac - !! will be called (note: GL_regularize and GL_couple - !! should be exclusive) - - real :: CFL_factor !< A factor used to limit subcycled advective timestep in uncoupled runs - !! i.e. dt <= CFL_factor * min(dx / u) - - real :: A_glen_isothermal - real :: n_glen - real :: eps_glen_min - real :: C_basal_friction - real :: n_basal_friction - real :: density_ocean_avg !< this does not affect ocean circulation OR thermodynamics - !! it is to estimate the gravitational driving force at the - !! shelf front(until we think of a better way to do it- - !! but any difference will be negligible) - real :: thresh_float_col_depth ! the water column depth over which the shelf if considered to be floating - logical :: moving_shelf_front - logical :: calve_to_mask - real :: min_thickness_simple_calve ! min. ice shelf thickness criteria for calving - - - real :: cg_tolerance - real :: nonlinear_tolerance - integer :: cg_max_iterations - integer :: nonlin_solve_err_mode ! 1: exit vel solve based on nonlin residual - ! 2: exit based on "fixed point" metric (|u - u_last| / |u| < tol where | | is infty-norm - logical :: use_reproducing_sums !< use new reproducing sums of Bob & Alistair for global sums. - - ! ids for outputting intermediate thickness in advection subroutine (debugging) - !integer :: id_h_after_uflux = -1, id_h_after_vflux = -1, id_h_after_adv = -1 - -! type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to control diagnostic output. - - logical :: debug !< If true, write verbose checksums for debugging purposes - !! and use reproducible sums - - logical :: module_is_initialized = .false. !< True if this module has been initialized. - - !>@{ - ! Diagnostic handles - integer :: id_u_shelf = -1, id_v_shelf = -1, id_t_shelf = -1, & - id_float_frac = -1, id_col_thick = -1, id_OD_av = -1, & - id_u_mask = -1, id_v_mask = -1, id_t_mask = -1 - !>@} - ! ids for outputting intermediate thickness in advection subroutine (debugging) - !integer :: id_h_after_uflux = -1, id_h_after_vflux = -1, id_h_after_adv = -1 - - type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to control diagnostic output. - -end type ice_shelf_dyn_CS - integer :: id_clock_shelf, id_clock_pass !< Clock for group pass calls contains -!> used for flux limiting in advective subroutines Van Leer limiter (source: Wikipedia) -function slope_limiter (num, denom) - real, intent(in) :: num - real, intent(in) :: denom - real :: slope_limiter - real :: r - - if (denom == 0) then - slope_limiter = 0 - elseif (num*denom <= 0) then - slope_limiter = 0 - else - r = num/denom - slope_limiter = (r+abs(r))/(1+abs(r)) - endif - -end function slope_limiter - -!> Calculate area of quadrilateral. -function quad_area (X, Y) - real, dimension(4), intent(in) :: X - real, dimension(4), intent(in) :: Y - real :: quad_area, p2, q2, a2, c2, b2, d2 - -! X and Y must be passed in the form - ! 3 - 4 - ! | | - ! 1 - 2 - - p2 = (X(4)-X(1))**2 + (Y(4)-Y(1))**2 ; q2 = (X(3)-X(2))**2 + (Y(3)-Y(2))**2 - a2 = (X(3)-X(4))**2 + (Y(3)-Y(4))**2 ; c2 = (X(1)-X(2))**2 + (Y(1)-Y(2))**2 - b2 = (X(2)-X(4))**2 + (Y(2)-Y(4))**2 ; d2 = (X(3)-X(1))**2 + (Y(3)-Y(1))**2 - quad_area = .25 * sqrt(4*P2*Q2-(B2+D2-A2-C2)**2) - -end function quad_area - !> Calculates fluxes between the ocean and ice-shelf using the three-equations !! formulation (optional to use just two equations). !! See \ref section_ICE_SHELF_equations @@ -1134,7 +975,7 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) endif enddo ; enddo - call mpp_sum(shelf_mass0); call mpp_sum(shelf_mass1) + call sum_across_PEs(shelf_mass0); call sum_across_PEs(shelf_mass1) delta_mass_shelf = (shelf_mass1 - shelf_mass0)/CS%time_step ! delta_mass_shelf = (shelf_mass1 - shelf_mass0)* & ! (rho_fw/CS%density_ice)/CS%time_step @@ -1146,8 +987,8 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) delta_mass_shelf = 0.0 endif - call mpp_sum(mean_melt_flux) - call mpp_sum(sponge_area) + call sum_across_PEs(mean_melt_flux) + call sum_across_PEs(sponge_area) ! average total melt flux over sponge area mean_melt_flux = (mean_melt_flux+delta_mass_shelf) / sponge_area !kg/(m^2 s) @@ -1682,327 +1523,6 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl end subroutine initialize_ice_shelf -!> This subroutine is used to register any fields related to the ice shelf -!! dynamics that should be written to or read from the restart file. -subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) - type(ocean_grid_type), intent(inout) :: G !< The grid type describing the ice shelf grid. - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(ice_shelf_dyn_CS), pointer :: CS !< A pointer to the ice shelf dynamics control structure - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. - - logical :: shelf_mass_is_dynamic, override_shelf_movement, active_shelf_dynamics - character(len=40) :: mdl = "MOM_ice_shelf_dyn" ! This module's name. - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - - if (associated(CS)) then - call MOM_error(FATAL, "MOM_ice_shelf_dyn.F90, register_ice_shelf_dyn_restarts: "// & - "called with an associated control structure.") - return - endif - allocate(CS) - - override_shelf_movement = .false. ; active_shelf_dynamics = .false. - call get_param(param_file, mdl, "DYNAMIC_SHELF_MASS", shelf_mass_is_dynamic, & - "If true, the ice sheet mass can evolve with time.", & - default=.false., do_not_log=.true.) - if (shelf_mass_is_dynamic) then - call get_param(param_file, mdl, "OVERRIDE_SHELF_MOVEMENT", override_shelf_movement, & - "If true, user provided code specifies the ice-shelf \n"//& - "movement instead of the dynamic ice model.", default=.false., do_not_log=.true.) - active_shelf_dynamics = .not.override_shelf_movement - endif - - if (active_shelf_dynamics) then - allocate( CS%u_shelf(IsdB:IedB,JsdB:JedB) ) ; CS%u_shelf(:,:) = 0.0 - allocate( CS%v_shelf(IsdB:IedB,JsdB:JedB) ) ; CS%v_shelf(:,:) = 0.0 - allocate( CS%t_shelf(isd:ied,jsd:jed) ) ; CS%t_shelf(:,:) = -10.0 - allocate( CS%ice_visc(isd:ied,jsd:jed) ) ; CS%ice_visc(:,:) = 0.0 - allocate( CS%taub_beta_eff(isd:ied,jsd:jed) ) ; CS%taub_beta_eff(:,:) = 0.0 - allocate( CS%OD_av(isd:ied,jsd:jed) ) ; CS%OD_av(:,:) = 0.0 - allocate( CS%float_frac(isd:ied,jsd:jed) ) ; CS%float_frac(:,:) = 0.0 - - ! additional restarts for ice shelf state - call register_restart_field(CS%u_shelf, "u_shelf", .false., restart_CS, & - "ice sheet/shelf u-velocity", "m s-1", hor_grid='Bu') - call register_restart_field(CS%v_shelf, "v_shelf", .false., restart_CS, & - "ice sheet/shelf v-velocity", "m s-1", hor_grid='Bu') - call register_restart_field(CS%t_shelf, "t_shelf", .true., restart_CS, & - "ice sheet/shelf vertically averaged temperature", "deg C") - call register_restart_field(CS%OD_av, "OD_av", .true., restart_CS, & - "Average open ocean depth in a cell","m") - call register_restart_field(CS%float_frac, "float_frac", .true., restart_CS, & - "fractional degree of grounding", "nondim") - call register_restart_field(CS%ice_visc, "viscosity", .true., restart_CS, & - "Glens law ice viscosity", "m (seems wrong)") - call register_restart_field(CS%taub_beta_eff, "tau_b_beta", .true., restart_CS, & - "Coefficient of basal traction", "m (seems wrong)") - endif - -end subroutine register_ice_shelf_dyn_restarts - -!> Initializes shelf model data, parameters and diagnostics -subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, diag, new_sim, solo_ice_sheet_in) - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(ocean_grid_type), pointer :: ocn_grid !< The calling ocean model's horizontal grid structure - type(time_type), intent(inout) :: Time !< The clock that that will indicate the model time - type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe - !! the ice-shelf state - type(ice_shelf_dyn_CS), pointer :: CS !< A pointer to the ice shelf dynamics control structure - type(ocean_grid_type), intent(inout) :: G !< The grid type describing the ice shelf grid. - type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate the diagnostic output. - logical, intent(in) :: new_sim !< If true this is a new simulation, otherwise - !! has been started from a restart file. - logical, optional, intent(in) :: solo_ice_sheet_in !< If present, this indicates whether - !! a solo ice-sheet driver. - - !This include declares and sets the variable "version". -#include "version_variable.h" - character(len=200) :: config - character(len=200) :: IC_file,filename,inputdir - character(len=40) :: var_name - character(len=40) :: mdl = "MOM_ice_shelf_dyn" ! This module's name. - logical :: shelf_mass_is_dynamic, override_shelf_movement, active_shelf_dynamics - logical :: debug - integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, Isdq, Iedq, Jsdq, Jedq, iters - - if (.not.associated(CS)) then - call MOM_error(FATAL, "MOM_ice_shelf_dyn.F90, initialize_ice_shelf_dyn: "// & - "called with an associated control structure.") - return - endif - if (CS%module_is_initialized) then - call MOM_error(WARNING, "MOM_ice_shelf_dyn.F90, initialize_ice_shelf_dyn was "//& - "called with a control structure that has already been initialized.") - endif - CS%module_is_initialized = .true. - - CS%diag => diag ! ; CS%Time => Time - - ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mdl, version, "") - call get_param(param_file, mdl, "DEBUG", debug, default=.false.) - call get_param(param_file, mdl, "DEBUG_IS", CS%debug, & - "If true, write verbose debugging messages for the ice shelf.", & - default=debug) - call get_param(param_file, mdl, "DYNAMIC_SHELF_MASS", shelf_mass_is_dynamic, & - "If true, the ice sheet mass can evolve with time.", & - default=.false.) - override_shelf_movement = .false. ; active_shelf_dynamics = .false. - if (shelf_mass_is_dynamic) then - call get_param(param_file, mdl, "OVERRIDE_SHELF_MOVEMENT", override_shelf_movement, & - "If true, user provided code specifies the ice-shelf \n"//& - "movement instead of the dynamic ice model.", default=.false., do_not_log=.true.) - active_shelf_dynamics = .not.override_shelf_movement - - call get_param(param_file, mdl, "GROUNDING_LINE_INTERPOLATE", CS%GL_regularize, & - "If true, regularize the floatation condition at the \n"//& - "grounding line as in Goldberg Holland Schoof 2009.", default=.false.) - call get_param(param_file, mdl, "GROUNDING_LINE_INTERP_SUBGRID_N", CS%n_sub_regularize, & - "The number of sub-partitions of each cell over which to \n"//& - "integrate for the interpolated grounding line. Each cell \n"//& - "is divided into NxN equally-sized rectangles, over which the \n"//& - "basal contribution is integrated by iterative quadrature.", & - default=0) - call get_param(param_file, mdl, "GROUNDING_LINE_COUPLE", CS%GL_couple, & - "If true, let the floatation condition be determined by \n"//& - "ocean column thickness. This means that update_OD_ffrac \n"//& - "will be called. GL_REGULARIZE and GL_COUPLE are exclusive.", & - default=.false., do_not_log=CS%GL_regularize) - if (CS%GL_regularize) CS%GL_couple = .false. - if (CS%GL_regularize .and. (CS%n_sub_regularize == 0)) call MOM_error (FATAL, & - "GROUNDING_LINE_INTERP_SUBGRID_N must be a positive integer if GL regularization is used") - call get_param(param_file, mdl, "ICE_SHELF_CFL_FACTOR", CS%CFL_factor, & - "A factor used to limit timestep as CFL_FACTOR * min (\Delta x / u). \n"// & - "This is only used with an ice-only model.", default=0.25) - endif - call get_param(param_file, mdl, "RHO_0", CS%density_ocean_avg, & - "avg ocean density used in floatation cond", & - units="kg m-3", default=1035.) - if (active_shelf_dynamics) then - call get_param(param_file, mdl, "ICE_VELOCITY_TIMESTEP", CS%velocity_update_time_step, & - "seconds between ice velocity calcs", units="s", & - fail_if_missing=.true.) - - call get_param(param_file, mdl, "A_GLEN_ISOTHERM", CS%A_glen_isothermal, & - "Ice viscosity parameter in Glen's Law", & - units="Pa -1/3 a", default=9.461e-18) - call get_param(param_file, mdl, "GLEN_EXPONENT", CS%n_glen, & - "nonlinearity exponent in Glen's Law", & - units="none", default=3.) - call get_param(param_file, mdl, "MIN_STRAIN_RATE_GLEN", CS%eps_glen_min, & - "min. strain rate to avoid infinite Glen's law viscosity", & - units="a-1", default=1.e-12) - call get_param(param_file, mdl, "BASAL_FRICTION_COEFF", CS%C_basal_friction, & - "ceofficient in sliding law \tau_b = C u^(n_basal_friction)", & - units="Pa (m-a)-(n_basal_friction)", fail_if_missing=.true.) - call get_param(param_file, mdl, "BASAL_FRICTION_EXP", CS%n_basal_friction, & - "exponent in sliding law \tau_b = C u^(m_slide)", & - units="none", fail_if_missing=.true.) - call get_param(param_file, mdl, "DENSITY_ICE", CS%density_ice, & - "A typical density of ice.", units="kg m-3", default=917.0) - call get_param(param_file, mdl, "CONJUGATE_GRADIENT_TOLERANCE", CS%cg_tolerance, & - "tolerance in CG solver, relative to initial residual", default=1.e-6) - call get_param(param_file, mdl, "ICE_NONLINEAR_TOLERANCE", CS%nonlinear_tolerance, & - "nonlin tolerance in iterative velocity solve",default=1.e-6) - call get_param(param_file, mdl, "CONJUGATE_GRADIENT_MAXIT", CS%cg_max_iterations, & - "max iteratiions in CG solver", default=2000) - call get_param(param_file, mdl, "THRESH_FLOAT_COL_DEPTH", CS%thresh_float_col_depth, & - "min ocean thickness to consider ice *floating*; \n"// & - "will only be important with use of tides", & - units="m", default=1.e-3) - call get_param(param_file, mdl, "NONLIN_SOLVE_ERR_MODE", CS%nonlin_solve_err_mode, & - "Choose whether nonlin error in vel solve is based on nonlinear \n"// & - "residual (1) or relative change since last iteration (2)", default=1) - call get_param(param_file, mdl, "SHELF_DYN_REPRODUCING_SUMS", CS%use_reproducing_sums, & - "If true, use the reproducing extended-fixed-point sums in \n"//& - "the ice shelf dynamics solvers.", default=.true.) - - call get_param(param_file, mdl, "SHELF_MOVING_FRONT", CS%moving_shelf_front, & - "Specify whether to advance shelf front (and calve).", & - default=.true.) - call get_param(param_file, mdl, "CALVE_TO_MASK", CS%calve_to_mask, & - "If true, do not allow an ice shelf where prohibited by a mask.", & - default=.false.) - endif - call get_param(param_file, mdl, "MIN_THICKNESS_SIMPLE_CALVE", & - CS%min_thickness_simple_calve, & - "Min thickness rule for the VERY simple calving law",& - units="m", default=0.0) - - ! Allocate memory in the ice shelf dynamics control structure that was not - ! previously allocated for registration for restarts. - ! OVS vertically integrated Temperature - - if (active_shelf_dynamics) then - ! DNG - allocate( CS%u_bdry_val(Isdq:Iedq,Jsdq:Jedq) ) ; CS%u_bdry_val(:,:) = 0.0 - allocate( CS%v_bdry_val(Isdq:Iedq,Jsdq:Jedq) ) ; CS%v_bdry_val(:,:) = 0.0 - allocate( CS%t_bdry_val(isd:ied,jsd:jed) ) ; CS%t_bdry_val(:,:) = -15.0 - allocate( CS%h_bdry_val(isd:ied,jsd:jed) ) ; CS%h_bdry_val(:,:) = 0.0 - allocate( CS%thickness_bdry_val(isd:ied,jsd:jed) ) ; CS%thickness_bdry_val(:,:) = 0.0 - allocate( CS%u_face_mask(Isdq:Iedq,jsd:jed) ) ; CS%u_face_mask(:,:) = 0.0 - allocate( CS%v_face_mask(isd:ied,Jsdq:Jedq) ) ; CS%v_face_mask(:,:) = 0.0 - allocate( CS%u_face_mask_bdry(Isdq:Iedq,jsd:jed) ) ; CS%u_face_mask_bdry(:,:) = -2.0 - allocate( CS%v_face_mask_bdry(isd:ied,Jsdq:Jedq) ) ; CS%v_face_mask_bdry(:,:) = -2.0 - allocate( CS%u_flux_bdry_val(Isdq:Iedq,jsd:jed) ) ; CS%u_flux_bdry_val(:,:) = 0.0 - allocate( CS%v_flux_bdry_val(isd:ied,Jsdq:Jedq) ) ; CS%v_flux_bdry_val(:,:) = 0.0 - allocate( CS%umask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%umask(:,:) = -1.0 - allocate( CS%vmask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%vmask(:,:) = -1.0 - allocate( CS%tmask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%tmask(:,:) = -1.0 - - CS%OD_rt_counter = 0 - allocate( CS%OD_rt(isd:ied,jsd:jed) ) ; CS%OD_rt(:,:) = 0.0 - allocate( CS%float_frac_rt(isd:ied,jsd:jed) ) ; CS%float_frac_rt(:,:) = 0.0 - - if (CS%calve_to_mask) then - allocate( CS%calve_mask(isd:ied,jsd:jed) ) ; CS%calve_mask(:,:) = 0.0 - endif - - CS%elapsed_velocity_time = 0.0 - - call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) - endif - - ! Take additional initialization steps, for example of dependent variables. - if (active_shelf_dynamics .and. .not.new_sim) then - ! this is unfortunately necessary; if grid is not symmetric the boundary values - ! of u and v are otherwise not set till the end of the first linear solve, and so - ! viscosity is not calculated correctly. - ! This has to occur after init_boundary_values or some of the arrays on the - ! right hand side have not been set up yet. - if (.not. G%symmetric) then - do j=G%jsd,G%jed ; do i=G%isd,G%ied - if (((i+G%idg_offset) == (G%domain%nihalo+1)).and.(CS%u_face_mask(i-1,j) == 3)) then - CS%u_shelf(i-1,j-1) = CS%u_bdry_val(i-1,j-1) - CS%u_shelf(i-1,j) = CS%u_bdry_val(i-1,j) - endif - if (((j+G%jdg_offset) == (G%domain%njhalo+1)).and.(CS%v_face_mask(i,j-1) == 3)) then - CS%u_shelf(i-1,j-1) = CS%u_bdry_val(i-1,j-1) - CS%u_shelf(i,j-1) = CS%u_bdry_val(i,j-1) - endif - enddo ; enddo - endif - - call pass_var(CS%OD_av,G%domain) - call pass_var(CS%float_frac,G%domain) - call pass_var(CS%ice_visc,G%domain) - call pass_var(CS%taub_beta_eff,G%domain) - call pass_vector(CS%u_shelf, CS%v_shelf, G%domain, TO_ALL, BGRID_NE) - endif - - if (active_shelf_dynamics) then - ! If we are calving to a mask, i.e. if a mask exists where a shelf cannot, read the mask from a file. - if (CS%calve_to_mask) then - call MOM_mesg(" MOM_ice_shelf.F90, initialize_ice_shelf: reading calving_mask") - - call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") - inputdir = slasher(inputdir) - call get_param(param_file, mdl, "CALVING_MASK_FILE", IC_file, & - "The file with a mask for where calving might occur.", & - default="ice_shelf_h.nc") - call get_param(param_file, mdl, "CALVING_MASK_VARNAME", var_name, & - "The variable to use in masking calving.", & - default="area_shelf_h") - - filename = trim(inputdir)//trim(IC_file) - call log_param(param_file, mdl, "INPUTDIR/CALVING_MASK_FILE", filename) - if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & - " calving mask file: Unable to open "//trim(filename)) - - call MOM_read_data(filename,trim(var_name),CS%calve_mask,G%Domain) - do j=G%jsc,G%jec ; do i=G%isc,G%iec - if (CS%calve_mask(i,j) > 0.0) CS%calve_mask(i,j) = 1.0 - enddo ; enddo - call pass_var(CS%calve_mask,G%domain) - endif - -! call init_boundary_values(CS, G, time, ISS%hmask, CS%input_flux, CS%input_thickness, new_sim) - - if (new_sim) then - call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") - call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf) - call ice_shelf_solve_outer(CS, ISS, G, CS%u_shelf, CS%v_shelf, iters, Time) - - if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf,CS%u_shelf,CS%diag) - if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf,CS%v_shelf,CS%diag) - endif - - ! Register diagnostics. - CS%id_u_shelf = register_diag_field('ocean_model','u_shelf',CS%diag%axesCu1, Time, & - 'x-velocity of ice', 'm yr-1') - CS%id_v_shelf = register_diag_field('ocean_model','v_shelf',CS%diag%axesCv1, Time, & - 'y-velocity of ice', 'm yr-1') - CS%id_u_mask = register_diag_field('ocean_model','u_mask',CS%diag%axesCu1, Time, & - 'mask for u-nodes', 'none') - CS%id_v_mask = register_diag_field('ocean_model','v_mask',CS%diag%axesCv1, Time, & - 'mask for v-nodes', 'none') -! CS%id_surf_elev = register_diag_field('ocean_model','ice_surf',CS%diag%axesT1, Time, & -! 'ice surf elev', 'm') - CS%id_float_frac = register_diag_field('ocean_model','ice_float_frac',CS%diag%axesT1, Time, & - 'fraction of cell that is floating (sort of)', 'none') - CS%id_col_thick = register_diag_field('ocean_model','col_thick',CS%diag%axesT1, Time, & - 'ocean column thickness passed to ice model', 'm') - CS%id_OD_av = register_diag_field('ocean_model','OD_av',CS%diag%axesT1, Time, & - 'intermediate ocean column thickness passed to ice model', 'm') - !CS%id_h_after_uflux = register_diag_field('ocean_model','h_after_uflux',CS%diag%axesh1, Time, & - ! 'thickness after u flux ', 'none') - !CS%id_h_after_vflux = register_diag_field('ocean_model','h_after_vflux',CS%diag%axesh1, Time, & - ! 'thickness after v flux ', 'none') - !CS%id_h_after_adv = register_diag_field('ocean_model','h_after_adv',CS%diag%axesh1, Time, & - ! 'thickness after front adv ', 'none') - -!!! OVS vertically integrated temperature - CS%id_t_shelf = register_diag_field('ocean_model','t_shelf',CS%diag%axesT1, Time, & - 'T of ice', 'oC') - CS%id_t_mask = register_diag_field('ocean_model','tmask',CS%diag%axesT1, Time, & - 'mask for T-nodes', 'none') - endif - -end subroutine initialize_ice_shelf_dyn - !> Initializes shelf mass based on three options (file, zero and user) subroutine initialize_shelf_mass(G, param_file, CS, ISS, new_sim) @@ -2128,40 +1648,6 @@ subroutine update_shelf_mass(G, CS, ISS, Time) end subroutine update_shelf_mass -subroutine initialize_diagnostic_fields(CS, ISS, G, Time) - type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure - type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe - !! the ice-shelf state - type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - type(time_type), intent(in) :: Time !< The current model time - - integer :: i, j, iters, isd, ied, jsd, jed - real :: rhoi, rhow, OD - type(time_type) :: dummy_time - - rhoi = CS%density_ice - rhow = CS%density_ocean_avg - dummy_time = set_time (0,0) - isd=G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - - do j=jsd,jed - do i=isd,ied - OD = G%bathyT(i,j) - rhoi/rhow * ISS%h_shelf(i,j) - if (OD >= 0) then - ! ice thickness does not take up whole ocean column -> floating - CS%OD_av(i,j) = OD - CS%float_frac(i,j) = 0. - else - CS%OD_av(i,j) = 0. - CS%float_frac(i,j) = 1. - endif - enddo - enddo - - call ice_shelf_solve_outer(CS, ISS, G, CS%u_shelf, CS%v_shelf, iters, dummy_time) - -end subroutine initialize_diagnostic_fields - !> Save the ice shelf restart file subroutine ice_shelf_save_restart(CS, Time, directory, time_stamped, filename_suffix) type(ice_shelf_CS), pointer :: CS !< ice shelf control structure @@ -2185,3491 +1671,104 @@ subroutine ice_shelf_save_restart(CS, Time, directory, time_stamped, filename_su end subroutine ice_shelf_save_restart -!> This function returns the global maximum timestep that can be taken based on the current -!! ice velocities. Because it involves finding a global minimum, it can be suprisingly expensive. -function ice_time_step_CFL(CS, ISS, G) - type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure - type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe - !! the ice-shelf state - type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - real :: ice_time_step_CFL !< The maximum permitted timestep, in s, based on the ice velocities. - - real :: ratio, min_ratio - real :: local_u_max, local_v_max - integer :: i, j - - min_ratio = 1.0e16 ! This is just an arbitrary large value. - do j=G%jsc,G%jec ; do i=G%isc,G%iec ; if (ISS%hmask(i,j) == 1.0) then - local_u_max = max(abs(CS%u_shelf(i,j)), abs(CS%u_shelf(i+1,j+1)), & - abs(CS%u_shelf(i+1,j)), abs(CS%u_shelf(i,j+1))) - local_v_max = max(abs(CS%v_shelf(i,j)), abs(CS%v_shelf(i+1,j+1)), & - abs(CS%v_shelf(i+1,j)), abs(CS%v_shelf(i,j+1))) - - ratio = min(G%areaT(i,j) / (local_u_max+1.0e-12), G%areaT(i,j) / (local_v_max+1.0e-12)) - min_ratio = min(min_ratio, ratio) - endif ; enddo ; enddo ! i- and j- loops +!> Deallocates all memory associated with this module +subroutine ice_shelf_end(CS) + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - call mpp_min(min_ratio) + if (.not.associated(CS)) return - ! solved velocities are in m/yr; we want time_step_int in seconds - ice_time_step_CFL = CS%CFL_factor * min_ratio * (365*86400) + call ice_shelf_state_end(CS%ISS) -end function ice_time_step_CFL + if (CS%active_shelf_dynamics) & + call ice_shelf_dyn_end(CS%dCS) -!> This subroutine updates the ice shelf velocities, mass, stresses and properties due to the -!! ice shelf dynamics. -subroutine update_ice_shelf(CS, ISS, G, time_step, Time, ocean_mass, coupled_grounding, must_update_vel) - type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure - type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe - !! the ice-shelf state - type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step !< time step in sec - type(time_type), intent(in) :: Time !< The current model time - real, dimension(SZDI_(G),SZDJ_(G)), & - optional, intent(in) :: ocean_mass !< If present this is the mass puer unit area - !! of the ocean in kg m-2. - logical, optional, intent(in) :: coupled_grounding !< If true, the grounding line is - !! determined by coupled ice-ocean dynamics - logical, optional, intent(in) :: must_update_vel !< Always update the ice velocities if true. - - integer :: iters - logical :: update_ice_vel, coupled_GL - - update_ice_vel = .false. - if (present(must_update_vel)) update_ice_vel = must_update_vel - - coupled_GL = .false. - if (present(ocean_mass) .and. present(coupled_grounding)) coupled_GL = coupled_grounding - - call ice_shelf_advect(CS, ISS, G, time_step, Time) - CS%elapsed_velocity_time = CS%elapsed_velocity_time + time_step - if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) update_ice_vel = .true. - - if (coupled_GL) then - call update_OD_ffrac(CS, G, ocean_mass, update_ice_vel) - elseif (update_ice_vel) then - call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf) - endif + deallocate(CS) - if (update_ice_vel) then - call ice_shelf_solve_outer(CS, ISS, G, CS%u_shelf, CS%v_shelf, iters, Time) - endif +end subroutine ice_shelf_end - call ice_shelf_temp(CS, ISS, G, time_step, ISS%water_flux, Time) - if (update_ice_vel) then - call enable_averaging(CS%elapsed_velocity_time, Time, CS%diag) - if (CS%id_col_thick > 0) call post_data(CS%id_col_thick, CS%OD_av, CS%diag) - if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf,CS%u_shelf,CS%diag) - if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf,CS%v_shelf,CS%diag) - if (CS%id_t_shelf > 0) call post_data(CS%id_t_shelf,CS%t_shelf,CS%diag) - if (CS%id_float_frac > 0) call post_data(CS%id_float_frac,CS%float_frac,CS%diag) - if (CS%id_OD_av >0) call post_data(CS%id_OD_av,CS%OD_av,CS%diag) +subroutine solo_time_step(CS, time_step, nsteps, Time, min_time_step_in) + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + real, intent(in) :: time_step !< The time interval for this update, in s. + integer, intent(inout) :: nsteps !< The running number of ice shelf steps. + type(time_type), intent(inout) :: Time !< The current model time + real, optional, intent(in) :: min_time_step_in !< The minimum permitted time step in s. - if (CS%id_u_mask > 0) call post_data(CS%id_u_mask,CS%umask,CS%diag) - if (CS%id_v_mask > 0) call post_data(CS%id_v_mask,CS%vmask,CS%diag) - if (CS%id_t_mask > 0) call post_data(CS%id_t_mask,CS%tmask,CS%diag) + type(ocean_grid_type), pointer :: G => NULL() + type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe + !! the ice-shelf state + type(ice_shelf_dyn_CS), pointer :: dCS => NULL() + integer :: is, iec, js, jec, i, j, ki, kj, iters + real :: ratio, min_ratio, time_step_remain, local_u_max + real :: local_v_max, time_step_int, min_time_step, spy, dumtimeprint + character(len=240) :: mesg + logical :: update_ice_vel ! If true, it is time to update the ice shelf velocities. + logical :: coupled_GL ! If true the grouding line position is determined based on + ! coupled ice-ocean dynamics. + logical :: flag - call disable_averaging(CS%diag) + spy = 365 * 86400 + G => CS%grid + ISS => CS%ISS + dCS => CS%dCS + is = G%isc ; iec = G%iec ; js = G%jsc ; jec = G%jec - CS%elapsed_velocity_time = 0.0 + time_step_remain = time_step + if (present (min_time_step_in)) then + min_time_step = min_time_step_in + else + min_time_step = 1000.0 ! This is in seconds - at 1 km resolution it would imply ice is moving at ~1 meter per second endif -end subroutine update_ice_shelf - -!> This subroutine takes the velocity (on the Bgrid) and timesteps h_t = - div (uh) once. -!! Additionally, it will update the volume of ice in partially-filled cells, and update -!! hmask accordingly -subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) - type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure - type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe - !! the ice-shelf state - type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step !< time step in sec - type(time_type), intent(in) :: Time !< The current model time - -! time_step: time step in sec - -! 3/8/11 DNG -! Arguments: -! CS - A structure containing the ice shelf state - including current velocities -! h0 - an array containing the thickness at the beginning of the call -! h_after_uflux - an array containing the thickness after advection in u-direction -! h_after_vflux - similar -! -! This subroutine takes the velocity (on the Bgrid) and timesteps h_t = - div (uh) once. -! ADDITIONALLY, it will update the volume of ice in partially-filled cells, and update -! hmask accordingly -! -! The flux overflows are included here. That is because they will be used to advect 3D scalars -! into partial cells - - ! - ! flux_enter: this is to capture flow into partially covered cells; it gives the mass flux into a given - ! cell across its boundaries. - ! ###Perhaps flux_enter should be changed into u-face and v-face - ! ###fluxes, which can then be used in halo updates, etc. - ! - ! from left neighbor: flux_enter(:,:,1) - ! from right neighbor: flux_enter(:,:,2) - ! from bottom neighbor: flux_enter(:,:,3) - ! from top neighbor: flux_enter(:,:,4) - ! - ! THESE ARE NOT CONSISTENT ==> FIND OUT WHAT YOU IMPLEMENTED - - ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary - ! - ! o--- (4) ---o - ! | | - ! (1) (2) - ! | | - ! o--- (3) ---o - ! - - real, dimension(SZDI_(G),SZDJ_(G)) :: h_after_uflux, h_after_vflux - real, dimension(SZDI_(G),SZDJ_(G),4) :: flux_enter - integer :: isd, ied, jsd, jed, i, j, isc, iec, jsc, jec - real :: rho, spy, thick_bd - - rho = CS%density_ice - spy = 365 * 86400 ! seconds per year; is there a global constant for this? No - it is dependent upon a calendar. - - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec - flux_enter(:,:,:) = 0.0 - - h_after_uflux(:,:) = 0.0 - h_after_vflux(:,:) = 0.0 - ! call MOM_mesg("MOM_ice_shelf.F90: ice_shelf_advect called") - - do j=jsd,jed - do i=isd,ied - thick_bd = CS%thickness_bdry_val(i,j) - if (thick_bd /= 0.0) then - ISS%h_shelf(i,j) = CS%thickness_bdry_val(i,j) - endif - enddo - enddo - - call ice_shelf_advect_thickness_x(CS, G, time_step/spy, ISS%hmask, ISS%h_shelf, h_after_uflux, flux_enter) - -! call enable_averaging(time_step,Time,CS%diag) - ! call pass_var(h_after_uflux, G%domain) -! if (CS%id_h_after_uflux > 0) call post_data(CS%id_h_after_uflux, h_after_uflux, CS%diag) -! call disable_averaging(CS%diag) - - call ice_shelf_advect_thickness_y(CS, G, time_step/spy, ISS%hmask, h_after_uflux, h_after_vflux, flux_enter) + ! NOTE: this relies on NE grid indexing + ! dumtimeprint=time_type_to_real(Time)/spy + write (mesg,*) "TIME in ice shelf call, yrs: ", time_type_to_real(Time)/spy + call MOM_mesg("solo_time_step: "//mesg) -! call enable_averaging(time_step,Time,CS%diag) -! call pass_var(h_after_vflux, G%domain) -! if (CS%id_h_after_vflux > 0) call post_data(CS%id_h_after_vflux, h_after_vflux, CS%diag) -! call disable_averaging(CS%diag) + do while (time_step_remain > 0.0) + nsteps = nsteps+1 - do j=jsd,jed - do i=isd,ied - if (ISS%hmask(i,j) == 1) ISS%h_shelf(i,j) = h_after_vflux(i,j) - enddo - enddo + ! If time_step is not too long, this is unnecessary. + time_step_int = min(ice_time_step_CFL(dCS, ISS, G), time_step) - if (CS%moving_shelf_front) then - call shelf_advance_front(CS, ISS, G, flux_enter) - if (CS%min_thickness_simple_calve > 0.0) then - call ice_shelf_min_thickness_calve(G, ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, & - CS%min_thickness_simple_calve) - endif - if (CS%calve_to_mask) then - call calve_to_mask(G, ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, CS%calve_mask) + write (mesg,*) "Ice model timestep = ", time_step_int, " seconds" + if (time_step_int < min_time_step) then + call MOM_error(FATAL, "MOM_ice_shelf:solo_time_step: abnormally small timestep "//mesg) + else + call MOM_mesg("solo_time_step: "//mesg) endif - endif - - !call enable_averaging(time_step,Time,CS%diag) - !if (CS%id_h_after_adv > 0) call post_data(CS%id_h_after_adv, ISS%h_shelf, CS%diag) - !call disable_averaging(CS%diag) - - !call change_thickness_using_melt(ISS, G, time_step, fluxes, CS%density_ice) - - call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) - -end subroutine ice_shelf_advect - -subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) - type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure - type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe - !! the ice-shelf state - type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - real, dimension(SZDIB_(G),SZDJB_(G)), & - intent(inout) :: u, v - integer, intent(out) :: iters - type(time_type), intent(in) :: Time !< The current model time - - real, dimension(SZDIB_(G),SZDJB_(G)) :: TAUDX, TAUDY, u_prev_iterate, v_prev_iterate, & - u_bdry_cont, v_bdry_cont, Au, Av, err_u, err_v, & - u_last, v_last, H_node - real, dimension(SZDI_(G),SZDJ_(G)) :: float_cond - integer :: conv_flag, i, j, k,l, iter - integer :: isdq, iedq, jsdq, jedq, isd, ied, jsd, jed, isumstart, jsumstart, nodefloat, nsub - real :: err_max, err_tempu, err_tempv, err_init, area, max_vel, tempu, tempv, rhoi, rhow - real, pointer, dimension(:,:,:,:) :: Phi => NULL() - real, pointer, dimension(:,:,:,:,:,:) :: Phisub => NULL() - real, dimension(8,4) :: Phi_temp - real, dimension(2,2) :: X,Y - character(2) :: iternum - character(2) :: numproc - - ! for GL interpolation - need to make this a readable parameter - nsub = CS%n_sub_regularize - - isdq = G%isdB ; iedq = G%iedB ; jsdq = G%jsdB ; jedq = G%jedB - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - rhoi = CS%density_ice - rhow = CS%density_ocean_avg - - TAUDX(:,:) = 0.0 ; TAUDY(:,:) = 0.0 - u_bdry_cont(:,:) = 0.0 ; v_bdry_cont(:,:) = 0.0 - Au(:,:) = 0.0 ; Av(:,:) = 0.0 - - ! need to make these conditional on GL interpolation - float_cond(:,:) = 0.0 ; H_node(:,:)=0 - allocate(Phisub (nsub,nsub,2,2,2,2)) ; Phisub = 0.0 - - isumstart = G%isc - ! Include the edge if tile is at the western bdry; Should add a test to avoid this if reentrant. - if (G%isc+G%idg_offset==G%isg) isumstart = G%iscB - - jsumstart = G%jsc - ! Include the edge if tile is at the southern bdry; Should add a test to avoid this if reentrant. - if (G%jsc+G%jdg_offset==G%jsg) jsumstart = G%jscB - - call calc_shelf_driving_stress(CS, ISS, G, TAUDX, TAUDY, CS%OD_av) - - ! this is to determine which cells contain the grounding line, - ! the criterion being that the cell is ice-covered, with some nodes - ! floating and some grounded - ! floatation condition is estimated by assuming topography is cellwise constant - ! and H is bilinear in a cell; floating where rho_i/rho_w * H_node + D is nonpositive - - ! need to make this conditional on GL interp - - if (CS%GL_regularize) then - - call interpolate_H_to_B(G, ISS%h_shelf, ISS%hmask, H_node) - - do j=G%jsc,G%jec - do i=G%isc,G%iec - nodefloat = 0 - do k=0,1 - do l=0,1 - if ((ISS%hmask(i,j) == 1) .and. & - (rhoi/rhow * H_node(i-1+k,j-1+l) - G%bathyT(i,j) <= 0)) then - nodefloat = nodefloat + 1 - endif - enddo - enddo - if ((nodefloat > 0) .and. (nodefloat < 4)) then - float_cond(i,j) = 1.0 - CS%float_frac(i,j) = 1.0 - endif - enddo - enddo - - call pass_var(float_cond, G%Domain) - - call bilinear_shape_functions_subgrid(Phisub, nsub) - - endif - - ! make above conditional - - u_prev_iterate(:,:) = u(:,:) - v_prev_iterate(:,:) = v(:,:) - ! must prepare phi - allocate(Phi(isd:ied,jsd:jed,1:8,1:4)) ; Phi(:,:,:,:) = 0.0 - - do j=jsd,jed ; do i=isd,ied - if (((i > isd) .and. (j > jsd))) then - X(:,:) = G%geoLonBu(i-1:i,j-1:j)*1000 - Y(:,:) = G%geoLatBu(i-1:i,j-1:j)*1000 + if (time_step_int >= time_step_remain) then + time_step_int = time_step_remain + time_step_remain = 0.0 else - X(2,:) = G%geoLonBu(i,j)*1000 - X(1,:) = G%geoLonBu(i,j)*1000-G%dxT(i,j) - Y(:,2) = G%geoLatBu(i,j)*1000 - Y(:,1) = G%geoLatBu(i,j)*1000-G%dyT(i,j) + time_step_remain = time_step_remain - time_step_int endif - call bilinear_shape_functions(X, Y, Phi_temp, area) - Phi(i,j,:,:) = Phi_temp - enddo ; enddo - - call calc_shelf_visc(CS, ISS, G, u, v) - - call pass_var(CS%ice_visc, G%domain) - call pass_var(CS%taub_beta_eff, G%domain) - - ! makes sure basal stress is only applied when it is supposed to be - - do j=G%jsd,G%jed ; do i=G%isd,G%ied - CS%taub_beta_eff(i,j) = CS%taub_beta_eff(i,j) * CS%float_frac(i,j) - enddo ; enddo - - call apply_boundary_values(CS, ISS, G, time, Phisub, H_node, CS%ice_visc, & - CS%taub_beta_eff, float_cond, & - rhoi/rhow, u_bdry_cont, v_bdry_cont) - - Au(:,:) = 0.0 ; Av(:,:) = 0.0 + ! If the last mini-timestep is a day or less, we cannot expect velocities to change by much. + ! Do not update the velocities if the last step is very short. + update_ice_vel = ((time_step_int > min_time_step) .or. (time_step_int >= time_step)) + coupled_GL = .false. - call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & - CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, G%areaT, & - G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) - - err_init = 0 ; err_tempu = 0; err_tempv = 0 - do j=jsumstart,G%jecB - do i=isumstart,G%iecB - if (CS%umask(i,j) == 1) then - err_tempu = ABS (Au(i,j) + u_bdry_cont(i,j) - TAUDX(i,j)) - endif - if (CS%vmask(i,j) == 1) then - err_tempv = MAX(ABS (Av(i,j) + v_bdry_cont(i,j) - TAUDY(i,j)), err_tempu) - endif - if (err_tempv >= err_init) then - err_init = err_tempv - endif - enddo - enddo - - call mpp_max(err_init) - - if (is_root_pe()) print *,"INITIAL nonlinear residual: ",err_init - - u_last(:,:) = u(:,:) ; v_last(:,:) = v(:,:) - - !! begin loop - - do iter=1,100 - - call ice_shelf_solve_inner(CS, ISS, G, u, v, TAUDX, TAUDY, H_node, float_cond, & - ISS%hmask, conv_flag, iters, time, Phi, Phisub) - - if (CS%DEBUG) then - call qchksum(u, "u shelf", G%HI, haloshift=2) - call qchksum(v, "v shelf", G%HI, haloshift=2) - endif - - if (is_root_pe()) print *,"linear solve done",iters," iterations" - - call calc_shelf_visc(CS, ISS, G, u, v) - call pass_var(CS%ice_visc, G%domain) - call pass_var(CS%taub_beta_eff, G%domain) - - ! makes sure basal stress is only applied when it is supposed to be - - do j=G%jsd,G%jed ; do i=G%isd,G%ied - CS%taub_beta_eff(i,j) = CS%taub_beta_eff(i,j) * CS%float_frac(i,j) - enddo ; enddo - - u_bdry_cont(:,:) = 0 ; v_bdry_cont(:,:) = 0 - - call apply_boundary_values(CS, ISS, G, time, Phisub, H_node, CS%ice_visc, & - CS%taub_beta_eff, float_cond, & - rhoi/rhow, u_bdry_cont, v_bdry_cont) - - Au(:,:) = 0 ; Av(:,:) = 0 - - call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & - CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, G%areaT, & - G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) - - err_max = 0 - - if (CS%nonlin_solve_err_mode == 1) then - - do j=jsumstart,G%jecB - do i=isumstart,G%iecB - if (CS%umask(i,j) == 1) then - err_tempu = ABS (Au(i,j) + u_bdry_cont(i,j) - TAUDX(i,j)) - endif - if (CS%vmask(i,j) == 1) then - err_tempv = MAX(ABS (Av(i,j) + v_bdry_cont(i,j) - TAUDY(i,j)), err_tempu) - endif - if (err_tempv >= err_max) then - err_max = err_tempv - endif - enddo - enddo - - call mpp_max(err_max) - - elseif (CS%nonlin_solve_err_mode == 2) then - - max_vel = 0 ; tempu = 0 ; tempv = 0 - - do j=jsumstart,G%jecB - do i=isumstart,G%iecB - if (CS%umask(i,j) == 1) then - err_tempu = ABS (u_last(i,j)-u(i,j)) - tempu = u(i,j) - endif - if (CS%vmask(i,j) == 1) then - err_tempv = MAX(ABS (v_last(i,j)- v(i,j)), err_tempu) - tempv = SQRT(v(i,j)**2+tempu**2) - endif - if (err_tempv >= err_max) then - err_max = err_tempv - endif - if (tempv >= max_vel) then - max_vel = tempv - endif - enddo - enddo - - u_last(:,:) = u(:,:) - v_last(:,:) = v(:,:) - - call mpp_max(max_vel) - call mpp_max(err_max) - err_init = max_vel - - endif - - if (is_root_pe()) print *,"nonlinear residual: ",err_max/err_init - - if (err_max <= CS%nonlinear_tolerance * err_init) then - if (is_root_pe()) & - print *,"exiting nonlinear solve after ",iter," iterations" - exit - endif - - enddo - - deallocate(Phi) - deallocate(Phisub) - -end subroutine ice_shelf_solve_outer - -subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_cond, & - hmask, conv_flag, iters, time, Phi, Phisub) - type(ice_shelf_dyn_CS),intent(in) :: CS !< A pointer to the ice shelf control structure - type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe - !! the ice-shelf state - type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u, v - real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: taudx, taudy, H_node - real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: float_cond - real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: hmask - integer, intent(out) :: conv_flag, iters - type(time_type), intent(in) :: Time !< The current model time - real, dimension(SZDI_(G),SZDJ_(G),8,4), intent(in) :: Phi - real, dimension(:,:,:,:,:,:), intent(in) :: Phisub - -! one linear solve (nonlinear iteration) of the solution for velocity - -! in this subroutine: -! boundary contributions are added to taud to get the RHS -! diagonal of matrix is found (for Jacobi precondition) -! CG iteration is carried out for max. iterations or until convergence - -! assumed - u, v, taud, visc, beta_eff are valid on the halo - - real, dimension(SZDIB_(G),SZDJB_(G)) :: & - Ru, Rv, Zu, Zv, DIAGu, DIAGv, RHSu, RHSv, & - ubd, vbd, Au, Av, Du, Dv, & - Zu_old, Zv_old, Ru_old, Rv_old, & - sum_vec, sum_vec_2 - integer :: iter, i, j, isd, ied, jsd, jed, & - isc, iec, jsc, jec, is, js, ie, je, isumstart, jsumstart, & - isdq, iedq, jsdq, jedq, iscq, iecq, jscq, jecq, nx_halo, ny_halo - real :: tol, beta_k, alpha_k, area, dot_p1, dot_p2, resid0, cg_halo, dot_p1a, dot_p2a - character(2) :: gridsize - - real, dimension(8,4) :: Phi_temp - real, dimension(2,2) :: X,Y - - isdq = G%isdB ; iedq = G%iedB ; jsdq = G%jsdB ; jedq = G%jedB - iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB - ny_halo = G%domain%njhalo ; nx_halo = G%domain%nihalo - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec - - Zu(:,:) = 0 ; Zv(:,:) = 0 ; DIAGu(:,:) = 0 ; DIAGv(:,:) = 0 - Ru(:,:) = 0 ; Rv(:,:) = 0 ; Au(:,:) = 0 ; Av(:,:) = 0 - Du(:,:) = 0 ; Dv(:,:) = 0 ; ubd(:,:) = 0 ; vbd(:,:) = 0 - dot_p1 = 0 ; dot_p2 = 0 - - isumstart = G%isc - ! Include the edge if tile is at the western bdry; Should add a test to avoid this if reentrant. - if (G%isc+G%idg_offset==G%isg) isumstart = G%iscB - - jsumstart = G%jsc - ! Include the edge if tile is at the southern bdry; Should add a test to avoid this if reentrant. - if (G%jsc+G%jdg_offset==G%jsg) jsumstart = G%jscB - - call apply_boundary_values(CS, ISS, G, time, Phisub, H_node, CS%ice_visc, & - CS%taub_beta_eff, float_cond, & - CS%density_ice/CS%density_ocean_avg, ubd, vbd) - - RHSu(:,:) = taudx(:,:) - ubd(:,:) - RHSv(:,:) = taudy(:,:) - vbd(:,:) - - - call pass_vector(RHSu, RHSv, G%domain, TO_ALL, BGRID_NE) - - call matrix_diagonal(CS, G, float_cond, H_node, CS%ice_visc, & - CS%taub_beta_eff, hmask, & - CS%density_ice/CS%density_ocean_avg, Phisub, DIAGu, DIAGv) -! DIAGu(:,:) = 1 ; DIAGv(:,:) = 1 - - call pass_vector(DIAGu, DIAGv, G%domain, TO_ALL, BGRID_NE) - - call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, hmask, & - H_node, CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, & - G%areaT, G, isc-1, iec+1, jsc-1, jec+1, CS%density_ice/CS%density_ocean_avg) - - call pass_vector(Au, Av, G%domain, TO_ALL, BGRID_NE) - - Ru(:,:) = RHSu(:,:) - Au(:,:) ; Rv(:,:) = RHSv(:,:) - Av(:,:) - - if (.not. CS%use_reproducing_sums) then - - do j=jsumstart,jecq - do i=isumstart,iecq - if (CS%umask(i,j) == 1) dot_p1 = dot_p1 + Ru(i,j)**2 - if (CS%vmask(i,j) == 1) dot_p1 = dot_p1 + Rv(i,j)**2 - enddo - enddo - - call mpp_sum(dot_p1) - - else - - sum_vec(:,:) = 0.0 - - do j=jsumstart,jecq - do i=isumstart,iecq - if (CS%umask(i,j) == 1) sum_vec(i,j) = Ru(i,j)**2 - if (CS%vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + Rv(i,j)**2 - enddo - enddo - - dot_p1 = reproducing_sum( sum_vec, isumstart+(1-G%IsdB), Iecq+(1-G%IsdB), & - jsumstart+(1-G%JsdB), jecq+(1-G%JsdB) ) - - endif - - resid0 = sqrt (dot_p1) - - do j=jsdq,jedq - do i=isdq,iedq - if (CS%umask(i,j) == 1) Zu(i,j) = Ru(i,j) / DIAGu(i,j) - if (CS%vmask(i,j) == 1) Zv(i,j) = Rv(i,j) / DIAGv(i,j) - enddo - enddo - - Du(:,:) = Zu(:,:) ; Dv(:,:) = Zv(:,:) - - cg_halo = 3 - conv_flag = 0 - - !!!!!!!!!!!!!!!!!! - !! !! - !! MAIN CG LOOP !! - !! !! - !!!!!!!!!!!!!!!!!! - - - - ! initially, c-grid data is valid up to 3 halo nodes out - - do iter = 1,CS%cg_max_iterations - - ! assume asymmetry - ! thus we can never assume that any arrays are legit more than 3 vertices past - ! the computational domain - this is their state in the initial iteration - - - is = isc - cg_halo ; ie = iecq + cg_halo - js = jscq - cg_halo ; je = jecq + cg_halo - - Au(:,:) = 0 ; Av(:,:) = 0 - - call CG_action(Au, Av, Du, Dv, Phi, Phisub, CS%umask, CS%vmask, hmask, & - H_node, CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, & - G%areaT, G, is, ie, js, je, CS%density_ice/CS%density_ocean_avg) - - ! Au, Av valid region moves in by 1 - - if ( .not. CS%use_reproducing_sums) then - - - ! alpha_k = (Z \dot R) / (D \dot AD} - dot_p1 = 0 ; dot_p2 = 0 - do j=jsumstart,jecq - do i=isumstart,iecq - if (CS%umask(i,j) == 1) then - dot_p1 = dot_p1 + Zu(i,j)*Ru(i,j) - dot_p2 = dot_p2 + Du(i,j)*Au(i,j) - endif - if (CS%vmask(i,j) == 1) then - dot_p1 = dot_p1 + Zv(i,j)*Rv(i,j) - dot_p2 = dot_p2 + Dv(i,j)*Av(i,j) - endif - enddo - enddo - call mpp_sum(dot_p1) ; call mpp_sum(dot_p2) - else - - sum_vec(:,:) = 0.0 ; sum_vec_2(:,:) = 0.0 - - do j=jscq,jecq - do i=iscq,iecq - if (CS%umask(i,j) == 1) sum_vec(i,j) = Zu(i,j) * Ru(i,j) - if (CS%vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + & - Zv(i,j) * Rv(i,j) - - if (CS%umask(i,j) == 1) sum_vec_2(i,j) = Du(i,j) * Au(i,j) - if (CS%vmask(i,j) == 1) sum_vec_2(i,j) = sum_vec_2(i,j) + & - Dv(i,j) * Av(i,j) - enddo - enddo - - dot_p1 = reproducing_sum( sum_vec, isumstart+(1-G%IsdB), Iecq+(1-G%IsdB), & - jsumstart+(1-G%JsdB), jecq+(1-G%JsdB) ) - - dot_p2 = reproducing_sum( sum_vec_2, isumstart+(1-G%IsdB), Iecq+(1-G%IsdB), & - jsumstart+(1-G%JsdB), jecq+(1-G%JsdB) ) - endif - - alpha_k = dot_p1/dot_p2 - - !### These should probably use explicit index notation so that they are - !### not applied outside of the valid range. - RWH - - ! u(:,:) = u(:,:) + alpha_k * Du(:,:) - ! v(:,:) = v(:,:) + alpha_k * Dv(:,:) - - do j=jsd,jed - do i=isd,ied - if (CS%umask(i,j) == 1) u(i,j) = u(i,j) + alpha_k * Du(i,j) - if (CS%vmask(i,j) == 1) v(i,j) = v(i,j) + alpha_k * Dv(i,j) - enddo - enddo - - do j=jsd,jed - do i=isd,ied - if (CS%umask(i,j) == 1) then - Ru_old(i,j) = Ru(i,j) ; Zu_old(i,j) = Zu(i,j) - endif - if (CS%vmask(i,j) == 1) then - Rv_old(i,j) = Rv(i,j) ; Zv_old(i,j) = Zv(i,j) - endif - enddo - enddo - -! Ru(:,:) = Ru(:,:) - alpha_k * Au(:,:) -! Rv(:,:) = Rv(:,:) - alpha_k * Av(:,:) - - do j=jsd,jed - do i=isd,ied - if (CS%umask(i,j) == 1) Ru(i,j) = Ru(i,j) - alpha_k * Au(i,j) - if (CS%vmask(i,j) == 1) Rv(i,j) = Rv(i,j) - alpha_k * Av(i,j) - enddo - enddo - - - do j=jsdq,jedq - do i=isdq,iedq - if (CS%umask(i,j) == 1) then - Zu(i,j) = Ru(i,j) / DIAGu(i,j) - endif - if (CS%vmask(i,j) == 1) then - Zv(i,j) = Rv(i,j) / DIAGv(i,j) - endif - enddo - enddo - - ! R,u,v,Z valid region moves in by 1 - - if (.not. CS%use_reproducing_sums) then - - ! beta_k = (Z \dot R) / (Zold \dot Rold} - dot_p1 = 0 ; dot_p2 = 0 - do j=jsumstart,jecq - do i=isumstart,iecq - if (CS%umask(i,j) == 1) then - dot_p1 = dot_p1 + Zu(i,j)*Ru(i,j) - dot_p2 = dot_p2 + Zu_old(i,j)*Ru_old(i,j) - endif - if (CS%vmask(i,j) == 1) then - dot_p1 = dot_p1 + Zv(i,j)*Rv(i,j) - dot_p2 = dot_p2 + Zv_old(i,j)*Rv_old(i,j) - endif - enddo - enddo - call mpp_sum(dot_p1) ; call mpp_sum(dot_p2) - - - else - - sum_vec(:,:) = 0.0 ; sum_vec_2(:,:) = 0.0 - - do j=jsumstart,jecq - do i=isumstart,iecq - if (CS%umask(i,j) == 1) sum_vec(i,j) = Zu(i,j) * Ru(i,j) - if (CS%vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + & - Zv(i,j) * Rv(i,j) - - if (CS%umask(i,j) == 1) sum_vec_2(i,j) = Zu_old(i,j) * Ru_old(i,j) - if (CS%vmask(i,j) == 1) sum_vec_2(i,j) = sum_vec_2(i,j) + & - Zv_old(i,j) * Rv_old(i,j) - enddo - enddo - - - dot_p1 = reproducing_sum(sum_vec, isumstart+(1-G%IsdB), Iecq+(1-G%IsdB), & - jsumstart+(1-G%JsdB), Jecq+(1-G%JsdB) ) - - dot_p2 = reproducing_sum(sum_vec_2, isumstart+(1-G%IsdB), Iecq+(1-G%IsdB), & - jsumstart+(1-G%JsdB), Jecq+(1-G%JsdB) ) - - endif - - beta_k = dot_p1/dot_p2 - - -! Du(:,:) = Zu(:,:) + beta_k * Du(:,:) -! Dv(:,:) = Zv(:,:) + beta_k * Dv(:,:) - - do j=jsd,jed - do i=isd,ied - if (CS%umask(i,j) == 1) Du(i,j) = Zu(i,j) + beta_k * Du(i,j) - if (CS%vmask(i,j) == 1) Dv(i,j) = Zv(i,j) + beta_k * Dv(i,j) - enddo - enddo - - ! D valid region moves in by 1 - - dot_p1 = 0 - - if (.not. CS%use_reproducing_sums) then - - do j=jsumstart,jecq - do i=isumstart,iecq - if (CS%umask(i,j) == 1) then - dot_p1 = dot_p1 + Ru(i,j)**2 - endif - if (CS%vmask(i,j) == 1) then - dot_p1 = dot_p1 + Rv(i,j)**2 - endif - enddo - enddo - call mpp_sum(dot_p1) - - else - - sum_vec(:,:) = 0.0 - - do j=jsumstart,jecq - do i=isumstart,iecq - if (CS%umask(i,j) == 1) sum_vec(i,j) = Ru(i,j)**2 - if (CS%vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + Rv(i,j)**2 - enddo - enddo - - dot_p1 = reproducing_sum( sum_vec, isumstart+(1-G%IsdB), Iecq+(1-G%IsdB), & - jsumstart+(1-G%JsdB), jecq+(1-G%JsdB) ) - endif - - dot_p1 = sqrt (dot_p1) - - if (dot_p1 <= CS%cg_tolerance * resid0) then - iters = iter - conv_flag = 1 - exit - endif - - cg_halo = cg_halo - 1 - - if (cg_halo == 0) then - ! pass vectors - call pass_vector(Du, Dv, G%domain, TO_ALL, BGRID_NE) - call pass_vector(u, v, G%domain, TO_ALL, BGRID_NE) - call pass_vector(Ru, Rv, G%domain, TO_ALL, BGRID_NE) - cg_halo = 3 - endif - - enddo ! end of CG loop - - do j=jsdq,jedq - do i=isdq,iedq - if (CS%umask(i,j) == 3) then - u(i,j) = CS%u_bdry_val(i,j) - elseif (CS%umask(i,j) == 0) then - u(i,j) = 0 - endif - - if (CS%vmask(i,j) == 3) then - v(i,j) = CS%v_bdry_val(i,j) - elseif (CS%vmask(i,j) == 0) then - v(i,j) = 0 - endif - enddo - enddo - - call pass_vector(u,v, G%domain, TO_ALL, BGRID_NE) - - if (conv_flag == 0) then - iters = CS%cg_max_iterations - endif - -end subroutine ice_shelf_solve_inner - -subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_uflux, flux_enter) - type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step !< The time step for this update, in s. - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask - real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h0 - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_uflux - real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter - - ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells - - ! if there is an input bdry condition, the thickness there will be set in initialization - - ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary - ! - ! from left neighbor: flux_enter(:,:,1) - ! from right neighbor: flux_enter(:,:,2) - ! from bottom neighbor: flux_enter(:,:,3) - ! from top neighbor: flux_enter(:,:,4) - ! - ! o--- (4) ---o - ! | | - ! (1) (2) - ! | | - ! o--- (3) ---o - ! - - integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied - integer :: i_off, j_off - logical :: at_east_bdry, at_west_bdry, one_off_west_bdry, one_off_east_bdry - real, dimension(-2:2) :: stencil - real :: u_face, & ! positive if out - flux_diff_cell, phi, dxh, dyh, dxdyh - character (len=1) :: debug_str - - is = G%isc-2 ; ie = G%iec+2 ; js = G%jsc ; je = G%jec - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - i_off = G%idg_offset ; j_off = G%jdg_offset - - do j=jsd+1,jed-1 - if (((j+j_off) <= G%domain%njglobal+G%domain%njhalo) .AND. & - ((j+j_off) >= G%domain%njhalo+1)) then ! based on mehmet's code - only if btw north & south boundaries - - stencil(:) = -1 -! if (i+i_off == G%domain%nihalo+G%domain%nihalo) - do i=is,ie - - if (((i+i_off) <= G%domain%niglobal+G%domain%nihalo) .AND. & - ((i+i_off) >= G%domain%nihalo+1)) then - - if (i+i_off == G%domain%nihalo+1) then - at_west_bdry=.true. - else - at_west_bdry=.false. - endif - - if (i+i_off == G%domain%niglobal+G%domain%nihalo) then - at_east_bdry=.true. - else - at_east_bdry=.false. - endif - - if (hmask(i,j) == 1) then - - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) - - h_after_uflux(i,j) = h0(i,j) - - stencil(:) = h0(i-2:i+2,j) ! fine as long has nx_halo >= 2 - - flux_diff_cell = 0 - - ! 1ST DO LEFT FACE - - if (CS%u_face_mask(i-1,j) == 4.) then - - flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_flux_bdry_val(i-1,j) / dxdyh - - else - - ! get u-velocity at center of left face - u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - - if (u_face > 0) then !flux is into cell - we need info from h(i-2), h(i-1) if available - - ! i may not cover all the cases.. but i cover the realistic ones - - if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then ! at western bdry but there is a - ! thickness bdry condition, and the stencil contains it - stencil (-1) = CS%thickness_bdry_val(i-1,j) - flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(-1) / dxdyh - - elseif (hmask(i-1,j) * hmask(i-2,j) == 1) then ! h(i-2) and h(i-1) are valid - phi = slope_limiter (stencil(-1)-stencil(-2), stencil(0)-stencil(-1)) - flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh* time_step / dxdyh * & - (stencil(-1) - phi * (stencil(-1)-stencil(0))/2) - - else ! h(i-1) is valid - ! (o.w. flux would most likely be out of cell) - ! but h(i-2) is not - - flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step / dxdyh * stencil(-1) - - endif - - elseif (u_face < 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available - if (hmask(i-1,j) * hmask(i+1,j) == 1) then ! h(i-1) and h(i+1) are both valid - phi = slope_limiter (stencil(0)-stencil(1), stencil(-1)-stencil(0)) - flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * & - (stencil(0) - phi * (stencil(0)-stencil(-1))/2) - - else - flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * stencil(0) - - if ((hmask(i-1,j) == 0) .OR. (hmask(i-1,j) == 2)) then - flux_enter(i-1,j,2) = ABS(u_face) * dyh * time_step * stencil(0) - endif - endif - endif - endif - - ! NEXT DO RIGHT FACE - - ! get u-velocity at center of right face - - if (CS%u_face_mask(i+1,j) == 4.) then - - flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_flux_bdry_val(i+1,j) / dxdyh - - else - - u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) - - if (u_face < 0) then !flux is into cell - we need info from h(i+2), h(i+1) if available - - if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then ! at eastern bdry but there is a - ! thickness bdry condition, and the stencil contains it - - flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(1) / dxdyh - - elseif (hmask(i+1,j) * hmask(i+2,j) == 1) then ! h(i+2) and h(i+1) are valid - - phi = slope_limiter (stencil(1)-stencil(2), stencil(0)-stencil(1)) - flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step / dxdyh * & - (stencil(1) - phi * (stencil(1)-stencil(0))/2) - - else ! h(i+1) is valid - ! (o.w. flux would most likely be out of cell) - ! but h(i+2) is not - - flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step / dxdyh * stencil(1) - - endif - - elseif (u_face > 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available - - if (hmask(i-1,j) * hmask(i+1,j) == 1) then ! h(i-1) and h(i+1) are both valid - - phi = slope_limiter (stencil(0)-stencil(-1), stencil(1)-stencil(0)) - flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * & - (stencil(0) - phi * (stencil(0)-stencil(1))/2) - - else ! h(i+1) is valid - ! (o.w. flux would most likely be out of cell) - ! but h(i+2) is not - - flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * stencil(0) - - if ((hmask(i+1,j) == 0) .OR. (hmask(i+1,j) == 2)) then - flux_enter(i+1,j,1) = ABS(u_face) * dyh * time_step * stencil(0) - endif - - endif - - endif - - h_after_uflux(i,j) = h_after_uflux(i,j) + flux_diff_cell - - endif - - elseif ((hmask(i,j) == 0) .OR. (hmask(i,j) == 2)) then - - if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then - u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - flux_enter(i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_bdry_val(i-1,j) - elseif (CS%u_face_mask(i-1,j) == 4.) then - flux_enter(i,j,1) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j) - endif - - if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then - u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) - flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_bdry_val(i+1,j) - elseif (CS%u_face_mask(i+1,j) == 4.) then - flux_enter(i,j,2) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) - endif - - if ((i == is) .AND. (hmask(i,j) == 0) .AND. (hmask(i-1,j) == 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing - ! the front without having to call pass_var - if cell is empty and cell to left - ! is ice-covered then this cell will become partly covered - - hmask(i,j) = 2 - elseif ((i == ie) .AND. (hmask(i,j) == 0) .AND. (hmask(i+1,j) == 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing - ! the front without having to call pass_var - if cell is empty and cell to left - ! is ice-covered then this cell will become partly covered - - hmask(i,j) = 2 - - endif - - endif - - endif - - enddo ! i loop - - endif - - enddo ! j loop - -end subroutine ice_shelf_advect_thickness_x - -subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, h_after_vflux, flux_enter) - type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step !< The time step for this update, in s. - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask - real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h_after_uflux - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_vflux - real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter - - ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells - - ! if there is an input bdry condition, the thickness there will be set in initialization - - ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary - ! - ! from left neighbor: flux_enter(:,:,1) - ! from right neighbor: flux_enter(:,:,2) - ! from bottom neighbor: flux_enter(:,:,3) - ! from top neighbor: flux_enter(:,:,4) - ! - ! o--- (4) ---o - ! | | - ! (1) (2) - ! | | - ! o--- (3) ---o - ! - - integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied - integer :: i_off, j_off - logical :: at_north_bdry, at_south_bdry, one_off_west_bdry, one_off_east_bdry - real, dimension(-2:2) :: stencil - real :: v_face, & ! positive if out - flux_diff_cell, phi, dxh, dyh, dxdyh - character(len=1) :: debug_str - - is = G%isc ; ie = G%iec ; js = G%jsc-1 ; je = G%jec+1 ; isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - i_off = G%idg_offset ; j_off = G%jdg_offset - - do i=isd+2,ied-2 - if (((i+i_off) <= G%domain%niglobal+G%domain%nihalo) .AND. & - ((i+i_off) >= G%domain%nihalo+1)) then ! based on mehmet's code - only if btw east & west boundaries - - stencil(:) = -1 - - do j=js,je - - if (((j+j_off) <= G%domain%njglobal+G%domain%njhalo) .AND. & - ((j+j_off) >= G%domain%njhalo+1)) then - - if (j+j_off == G%domain%njhalo+1) then - at_south_bdry=.true. - else - at_south_bdry=.false. - endif - - if (j+j_off == G%domain%njglobal+G%domain%njhalo) then - at_north_bdry=.true. - else - at_north_bdry=.false. - endif - - if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) - h_after_vflux(i,j) = h_after_uflux(i,j) - - stencil(:) = h_after_uflux(i,j-2:j+2) ! fine as long has ny_halo >= 2 - flux_diff_cell = 0 - - ! 1ST DO south FACE - - if (CS%v_face_mask(i,j-1) == 4.) then - - flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_flux_bdry_val(i,j-1) / dxdyh - - else - - ! get u-velocity at center of left face - v_face = 0.5 * (CS%v_shelf(i-1,j-1) + CS%v_shelf(i,j-1)) - - if (v_face > 0) then !flux is into cell - we need info from h(j-2), h(j-1) if available - - ! i may not cover all the cases.. but i cover the realistic ones - - if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then ! at western bdry but there is a - ! thickness bdry condition, and the stencil contains it - flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(-1) / dxdyh - - elseif (hmask(i,j-1) * hmask(i,j-2) == 1) then ! h(j-2) and h(j-1) are valid - - phi = slope_limiter (stencil(-1)-stencil(-2), stencil(0)-stencil(-1)) - flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * & - (stencil(-1) - phi * (stencil(-1)-stencil(0))/2) - - else ! h(j-1) is valid - ! (o.w. flux would most likely be out of cell) - ! but h(j-2) is not - flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * stencil(-1) - endif - - elseif (v_face < 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available - - if (hmask(i,j-1) * hmask(i,j+1) == 1) then ! h(j-1) and h(j+1) are both valid - phi = slope_limiter (stencil(0)-stencil(1), stencil(-1)-stencil(0)) - flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * & - (stencil(0) - phi * (stencil(0)-stencil(-1))/2) - else - flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * stencil(0) - - if ((hmask(i,j-1) == 0) .OR. (hmask(i,j-1) == 2)) then - flux_enter(i,j-1,4) = ABS(v_face) * dyh * time_step * stencil(0) - endif - - endif - - endif - - endif - - ! NEXT DO north FACE - - if (CS%v_face_mask(i,j+1) == 4.) then - - flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_flux_bdry_val(i,j+1) / dxdyh - - else - - ! get u-velocity at center of right face - v_face = 0.5 * (CS%v_shelf(i-1,j) + CS%v_shelf(i,j)) - - if (v_face < 0) then !flux is into cell - we need info from h(j+2), h(j+1) if available - - if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then ! at eastern bdry but there is a - ! thickness bdry condition, and the stencil contains it - flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(1) / dxdyh - elseif (hmask(i,j+1) * hmask(i,j+2) == 1) then ! h(j+2) and h(j+1) are valid - phi = slope_limiter (stencil(1)-stencil(2), stencil(0)-stencil(1)) - flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * & - (stencil(1) - phi * (stencil(1)-stencil(0))/2) - else ! h(j+1) is valid - ! (o.w. flux would most likely be out of cell) - ! but h(j+2) is not - flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * stencil(1) - endif - - elseif (v_face > 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available - - if (hmask(i,j-1) * hmask(i,j+1) == 1) then ! h(j-1) and h(j+1) are both valid - phi = slope_limiter (stencil(0)-stencil(-1), stencil(1)-stencil(0)) - flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * & - (stencil(0) - phi * (stencil(0)-stencil(1))/2) - else ! h(j+1) is valid - ! (o.w. flux would most likely be out of cell) - ! but h(j+2) is not - flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * stencil(0) - if ((hmask(i,j+1) == 0) .OR. (hmask(i,j+1) == 2)) then - flux_enter(i,j+1,3) = ABS(v_face) * dxh * time_step * stencil(0) - endif - endif - - endif - - endif - - h_after_vflux(i,j) = h_after_vflux(i,j) + flux_diff_cell - - elseif ((hmask(i,j) == 0) .OR. (hmask(i,j) == 2)) then - - if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then - v_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i,j-1)) - flux_enter(i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_bdry_val(i,j-1) - elseif (CS%v_face_mask(i,j-1) == 4.) then - flux_enter(i,j,3) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1) - endif - - if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then - v_face = 0.5 * (CS%u_shelf(i-1,j) + CS%u_shelf(i,j)) - flux_enter(i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_bdry_val(i,j+1) - elseif (CS%v_face_mask(i,j+1) == 4.) then - flux_enter(i,j,4) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1) - endif - - if ((j == js) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j-1) == 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing - ! the front without having to call pass_var - if cell is empty and cell to left - ! is ice-covered then this cell will become partly covered - hmask(i,j) = 2 - elseif ((j == je) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j+1) == 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing - ! the front without having to call pass_var - if cell is empty and cell to left - ! is ice-covered then this cell will become partly covered - hmask(i,j) = 2 - endif - - endif - endif - enddo ! j loop - endif - enddo ! i loop - -end subroutine ice_shelf_advect_thickness_y - -subroutine shelf_advance_front(CS, ISS, G, flux_enter) - type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure - type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe - !! the ice-shelf state - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter - - ! in this subroutine we go through the computational cells only and, if they are empty or partial cells, - ! we find the reference thickness and update the shelf mass and partial area fraction and the hmask if necessary - - ! if any cells go from partial to complete, we then must set the thickness, update hmask accordingly, - ! and divide the overflow across the adjacent EMPTY (not partly-covered) cells. - ! (it is highly unlikely there will not be any; in which case this will need to be rethought.) - - ! most likely there will only be one "overflow". if not, though, a pass_var of all relevant variables - ! is done; there will therefore be a loop which, in practice, will hopefully not have to go through - ! many iterations - - ! when 3d advected scalars are introduced, they will be impacted by what is done here - - ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary - ! - ! from left neighbor: flux_enter(:,:,1) - ! from right neighbor: flux_enter(:,:,2) - ! from bottom neighbor: flux_enter(:,:,3) - ! from top neighbor: flux_enter(:,:,4) - ! - ! o--- (4) ---o - ! | | - ! (1) (2) - ! | | - ! o--- (3) ---o - ! - - integer :: i, j, isc, iec, jsc, jec, n_flux, k, l, iter_count - integer :: i_off, j_off - integer :: iter_flag - - real :: h_reference, dxh, dyh, dxdyh, rho, partial_vol, tot_flux - integer, dimension(4) :: mapi, mapj, new_partial -! real, dimension(size(flux_enter,1),size(flux_enter,2),size(flux_enter,2)) :: flux_enter_replace - real, dimension(SZDI_(G),SZDJ_(G),4) :: flux_enter_replace - - isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec - i_off = G%idg_offset ; j_off = G%jdg_offset - rho = CS%density_ice - iter_count = 0 ; iter_flag = 1 - - - mapi(1) = -1 ; mapi(2) = 1 ; mapi(3:4) = 0 - mapj(3) = -1 ; mapj(4) = 1 ; mapj(1:2) = 0 - - do while (iter_flag == 1) - - iter_flag = 0 - - if (iter_count > 0) then - flux_enter(:,:,:) = flux_enter_replace(:,:,:) - endif - flux_enter_replace(:,:,:) = 0.0 - - iter_count = iter_count + 1 - - ! if iter_count >= 3 then some halo updates need to be done... - - do j=jsc-1,jec+1 - - if (((j+j_off) <= G%domain%njglobal+G%domain%njhalo) .AND. & - ((j+j_off) >= G%domain%njhalo+1)) then - - do i=isc-1,iec+1 - - if (((i+i_off) <= G%domain%niglobal+G%domain%nihalo) .AND. & - ((i+i_off) >= G%domain%nihalo+1)) then - ! first get reference thickness by averaging over cells that are fluxing into this cell - n_flux = 0 - h_reference = 0.0 - tot_flux = 0.0 - - do k=1,2 - if (flux_enter(i,j,k) > 0) then - n_flux = n_flux + 1 - h_reference = h_reference + ISS%h_shelf(i+2*k-3,j) - tot_flux = tot_flux + flux_enter(i,j,k) - flux_enter(i,j,k) = 0.0 - endif - enddo - - do k=1,2 - if (flux_enter(i,j,k+2) > 0) then - n_flux = n_flux + 1 - h_reference = h_reference + ISS%h_shelf(i,j+2*k-3) - tot_flux = tot_flux + flux_enter(i,j,k+2) - flux_enter(i,j,k+2) = 0.0 - endif - enddo - - if (n_flux > 0) then - dxdyh = G%areaT(i,j) - h_reference = h_reference / real(n_flux) - partial_vol = ISS%h_shelf(i,j) * ISS%area_shelf_h(i,j) + tot_flux - - if ((partial_vol / dxdyh) == h_reference) then ! cell is exactly covered, no overflow - ISS%hmask(i,j) = 1 - ISS%h_shelf(i,j) = h_reference - ISS%area_shelf_h(i,j) = dxdyh - elseif ((partial_vol / dxdyh) < h_reference) then - ISS%hmask(i,j) = 2 - ! ISS%mass_shelf(i,j) = partial_vol * rho - ISS%area_shelf_h(i,j) = partial_vol / h_reference - ISS%h_shelf(i,j) = h_reference - else - - ISS%hmask(i,j) = 1 - ISS%area_shelf_h(i,j) = dxdyh - !h_temp(i,j) = h_reference - partial_vol = partial_vol - h_reference * dxdyh - - iter_flag = 1 - - n_flux = 0 ; new_partial(:) = 0 - - do k=1,2 - if (CS%u_face_mask(i-2+k,j) == 2) then - n_flux = n_flux + 1 - elseif (ISS%hmask(i+2*k-3,j) == 0) then - n_flux = n_flux + 1 - new_partial(k) = 1 - endif - enddo - do k=1,2 - if (CS%v_face_mask(i,j-2+k) == 2) then - n_flux = n_flux + 1 - elseif (ISS%hmask(i,j+2*k-3) == 0) then - n_flux = n_flux + 1 - new_partial(k+2) = 1 - endif - enddo - - if (n_flux == 0) then ! there is nowhere to put the extra ice! - ISS%h_shelf(i,j) = h_reference + partial_vol / dxdyh - else - ISS%h_shelf(i,j) = h_reference - - do k=1,2 - if (new_partial(k) == 1) & - flux_enter_replace(i+2*k-3,j,3-k) = partial_vol / real(n_flux) - enddo - do k=1,2 ! ### Combine these two loops? - if (new_partial(k+2) == 1) & - flux_enter_replace(i,j+2*k-3,5-k) = partial_vol / real(n_flux) - enddo - endif - - endif ! Parital_vol test. - endif ! n_flux gt 0 test. - - endif - enddo ! j-loop - endif - enddo - - ! call mpp_max(iter_flag) - - enddo ! End of do while(iter_flag) loop - - call mpp_max(iter_count) - - if (is_root_pe() .and. (iter_count > 1)) print *, iter_count, "MAX ITERATIONS,ADVANCE FRONT" - -end subroutine shelf_advance_front - -!> Apply a very simple calving law using a minimum thickness rule -subroutine ice_shelf_min_thickness_calve(G, h_shelf, area_shelf_h, hmask, thickness_calve) - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf - real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: area_shelf_h - real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: hmask - real, intent(in) :: thickness_calve - - integer :: i,j - - do j=G%jsd,G%jed - do i=G%isd,G%ied -! if ((h_shelf(i,j) < CS%thickness_calve) .and. (hmask(i,j) == 1) .and. & -! (CS%float_frac(i,j) == 0.0)) then - if ((h_shelf(i,j) < thickness_calve) .and. (area_shelf_h(i,j) > 0.)) then - h_shelf(i,j) = 0.0 - area_shelf_h(i,j) = 0.0 - hmask(i,j) = 0.0 - endif - enddo - enddo - -end subroutine ice_shelf_min_thickness_calve - -subroutine calve_to_mask(G, h_shelf, area_shelf_h, hmask, calve_mask) - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_shelf - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: area_shelf_h - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask - real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: calve_mask - - integer :: i,j - - do j=G%jsc,G%jec ; do i=G%isc,G%iec - if ((calve_mask(i,j) == 0.0) .and. (hmask(i,j) /= 0.0)) then - h_shelf(i,j) = 0.0 - area_shelf_h(i,j) = 0.0 - hmask(i,j) = 0.0 - endif - enddo ; enddo - -end subroutine calve_to_mask - -subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) - type(ice_shelf_dyn_CS), intent(in):: CS !< A pointer to the ice shelf control structure - type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe - !! the ice-shelf state - type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: OD !< ocean floor depth at tracer points, in m - real, dimension(SZDIB_(G),SZDJB_(G)), & - intent(inout) :: TAUD_X !< X-direction driving stress at q-points - real, dimension(SZDIB_(G),SZDJB_(G)), & - intent(inout) :: TAUD_Y !< Y-direction driving stress at q-points - -! driving stress! - -! ! TAUD_X and TAUD_Y will hold driving stress in the x- and y- directions when done. -! they will sit on the BGrid, and so their size depends on whether the grid is symmetric -! -! Since this is a finite element solve, they will actually have the form \int \phi_i rho g h \nabla s -! -! OD -this is important and we do not yet know where (in MOM) it will come from. It represents -! "average" ocean depth -- and is needed to find surface elevation -! (it is assumed that base_ice = bed + OD) - - real, dimension(SIZE(OD,1),SIZE(OD,2)) :: S, & ! surface elevation - BASE ! basal elevation of shelf/stream - - - real :: rho, rhow, sx, sy, neumann_val, dxh, dyh, dxdyh - - integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq - integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec - integer :: i_off, j_off - - isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec - iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB - isd = G%isd ; jsd = G%jsd - iegq = G%iegB ; jegq = G%jegB - gisc = G%domain%nihalo+1 ; gjsc = G%domain%njhalo+1 - giec = G%domain%niglobal+G%domain%nihalo ; gjec = G%domain%njglobal+G%domain%njhalo - is = iscq - 1; js = jscq - 1 - i_off = G%idg_offset ; j_off = G%jdg_offset - - rho = CS%density_ice - rhow = CS%density_ocean_avg - - ! prelim - go through and calculate S - - ! or is this faster? - BASE(:,:) = -G%bathyT(:,:) + OD(:,:) - S(:,:) = BASE(:,:) + ISS%h_shelf(:,:) - - do j=jsc-1,jec+1 - do i=isc-1,iec+1 - cnt = 0 - sx = 0 - sy = 0 - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) - - if (ISS%hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell - - ! calculate sx - if ((i+i_off) == gisc) then ! at left computational bdry - if (ISS%hmask(i+1,j) == 1) then - sx = (S(i+1,j)-S(i,j))/dxh - else - sx = 0 - endif - elseif ((i+i_off) == giec) then ! at right computational bdry - if (ISS%hmask(i-1,j) == 1) then - sx = (S(i,j)-S(i-1,j))/dxh - else - sx=0 - endif - else ! interior - if (ISS%hmask(i+1,j) == 1) then - cnt = cnt+1 - sx = S(i+1,j) - else - sx = S(i,j) - endif - if (ISS%hmask(i-1,j) == 1) then - cnt = cnt+1 - sx = sx - S(i-1,j) - else - sx = sx - S(i,j) - endif - if (cnt == 0) then - sx=0 - else - sx = sx / (cnt * dxh) - endif - endif - - cnt = 0 - - ! calculate sy, similarly - if ((j+j_off) == gjsc) then ! at south computational bdry - if (ISS%hmask(i,j+1) == 1) then - sy = (S(i,j+1)-S(i,j))/dyh - else - sy = 0 - endif - elseif ((j+j_off) == gjec) then ! at nprth computational bdry - if (ISS%hmask(i,j-1) == 1) then - sy = (S(i,j)-S(i,j-1))/dyh - else - sy = 0 - endif - else ! interior - if (ISS%hmask(i,j+1) == 1) then - cnt = cnt+1 - sy = S(i,j+1) - else - sy = S(i,j) - endif - if (ISS%hmask(i,j-1) == 1) then - cnt = cnt+1 - sy = sy - S(i,j-1) - else - sy = sy - S(i,j) - endif - if (cnt == 0) then - sy=0 - else - sy = sy / (cnt * dyh) - endif - endif - - ! SW vertex - taud_x(I-1,J-1) = taud_x(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * dxdyh - taud_y(I-1,J-1) = taud_y(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * dxdyh - - ! SE vertex - taud_x(I,J-1) = taud_x(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * dxdyh - taud_y(I,J-1) = taud_y(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * dxdyh - - ! NW vertex - taud_x(I-1,J) = taud_x(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * dxdyh - taud_y(I-1,J) = taud_y(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * dxdyh - - ! NE vertex - taud_x(I,J) = taud_x(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * dxdyh - taud_y(I,J) = taud_y(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * dxdyh - - if (CS%float_frac(i,j) == 1) then - neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j) ** 2 - rhow * G%bathyT(i,j) ** 2) - else - neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j) ** 2 - endif - - - if ((CS%u_face_mask(i-1,j) == 2) .OR. (ISS%hmask(i-1,j) == 0) .OR. (ISS%hmask(i-1,j) == 2) ) then - ! left face of the cell is at a stress boundary - ! the depth-integrated longitudinal stress is equal to the difference of depth-integrated - ! pressure on either side of the face - ! on the ice side, it is rho g h^2 / 2 - ! on the ocean side, it is rhow g (delta OD)^2 / 2 - ! OD can be zero under the ice; but it is ASSUMED on the ice-free side of the face, topography elevation - ! is not above the base of the ice in the current cell - - ! note negative sign due to direction of normal vector - taud_x(i-1,j-1) = taud_x(i-1,j-1) - .5 * dyh * neumann_val - taud_x(i-1,j) = taud_x(i-1,j) - .5 * dyh * neumann_val - endif - - if ((CS%u_face_mask(i,j) == 2) .OR. (ISS%hmask(i+1,j) == 0) .OR. (ISS%hmask(i+1,j) == 2) ) then - ! right face of the cell is at a stress boundary - taud_x(i,j-1) = taud_x(i,j-1) + .5 * dyh * neumann_val - taud_x(i,j) = taud_x(i,j) + .5 * dyh * neumann_val - endif - - if ((CS%v_face_mask(i,j-1) == 2) .OR. (ISS%hmask(i,j-1) == 0) .OR. (ISS%hmask(i,j-1) == 2) ) then - ! south face of the cell is at a stress boundary - taud_y(i-1,j-1) = taud_y(i-1,j-1) - .5 * dxh * neumann_val - taud_y(i,j-1) = taud_y(i,j-1) - .5 * dxh * neumann_val - endif - - if ((CS%v_face_mask(i,j) == 2) .OR. (ISS%hmask(i,j+1) == 0) .OR. (ISS%hmask(i,j+1) == 2) ) then - ! north face of the cell is at a stress boundary - taud_y(i-1,j) = taud_y(i-1,j) + .5 * dxh * neumann_val ! note negative sign due to direction of normal vector - taud_y(i,j) = taud_y(i,j) + .5 * dxh * neumann_val - endif - - endif - enddo - enddo - -end subroutine calc_shelf_driving_stress - -subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new_sim) - type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure - type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - type(time_type), intent(in) :: Time !< The current model time - real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: hmask !< A mask indicating which tracer points are - !! partly or fully coupled by an ice-shelf - real, intent(in) :: input_flux, input_thick - logical, optional, intent(in) :: new_sim !< If present and false, this run is being restarted - -! this will be a per-setup function. the boundary values of thickness and velocity -! (and possibly other variables) will be updated in this function - -! FOR RESTARTING PURPOSES: if grid is not symmetric and the model is restarted, we will -! need to update those velocity points not *technically* in any -! computational domain -- if this function gets moves to another module, -! DO NOT TAKE THE RESTARTING BIT WITH IT - integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq - integer :: gjec, gisc, gjsc, cnt, isc, jsc, iec, jec - integer :: i_off, j_off - real :: A, n, ux, uy, vx, vy, eps_min, domain_width - - - isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec -! iscq = G%iscq ; iecq = G%iecq ; jscq = G%jscq ; jecq = G%jecq - isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed -! iegq = G%iegq ; jegq = G%jegq - i_off = G%idg_offset ; j_off = G%jdg_offset - - domain_width = G%len_lat - - ! this loop results in some values being set twice but... eh. - - do j=jsd,jed - do i=isd,ied - - if (hmask(i,j) == 3) then - CS%thickness_bdry_val(i,j) = input_thick - endif - - if ((hmask(i,j) == 0) .or. (hmask(i,j) == 1) .or. (hmask(i,j) == 2)) then - if ((i <= iec).and.(i >= isc)) then - if (CS%u_face_mask(i-1,j) == 3) then - CS%u_bdry_val(i-1,j-1) = (1 - ((G%geoLatBu(i-1,j-1) - 0.5*G%len_lat)*2./G%len_lat)**2) * & - 1.5 * input_flux / input_thick - CS%u_bdry_val(i-1,j) = (1 - ((G%geoLatBu(i-1,j) - 0.5*G%len_lat)*2./G%len_lat)**2) * & - 1.5 * input_flux / input_thick - endif - endif - endif - - if (.not.(new_sim)) then - if (.not. G%symmetric) then - if (((i+i_off) == (G%domain%nihalo+1)).and.(CS%u_face_mask(i-1,j) == 3)) then - CS%u_shelf(i-1,j-1) = CS%u_bdry_val(i-1,j-1) - CS%u_shelf(i-1,j) = CS%u_bdry_val(i-1,j) - endif - if (((j+j_off) == (G%domain%njhalo+1)).and.(CS%v_face_mask(i,j-1) == 3)) then - CS%u_shelf(i-1,j-1) = CS%u_bdry_val(i-1,j-1) - CS%u_shelf(i,j-1) = CS%u_bdry_val(i,j-1) - endif - endif - endif - enddo - enddo - -end subroutine init_boundary_values - - -subroutine CG_action(uret, vret, u, v, Phi, Phisub, umask, vmask, hmask, H_node, & - nu, float_cond, D, beta, dxdyh, G, is, ie, js, je, dens_ratio) - - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent (inout) :: uret, vret - real, dimension(SZDI_(G),SZDJ_(G),8,4), intent(in) :: Phi - real, dimension(:,:,:,:,:,:), intent(in) :: Phisub - real, dimension(SZDIB_(G),SZDJB_(G)), intent (in) :: u, v - real, dimension(SZDIB_(G),SZDJB_(G)), intent (in) :: umask, vmask, H_node - real, dimension(SZDI_(G),SZDJ_(G)), intent (in) :: hmask - real, dimension(SZDIB_(G),SZDJB_(G)), intent (in) :: nu - real, dimension(SZDI_(G),SZDJ_(G)), intent (in) :: float_cond - real, dimension(SZDI_(G),SZDJ_(G)), intent (in) :: D - real, dimension(SZDIB_(G),SZDJB_(G)), intent (in) :: beta - real, dimension(SZDI_(G),SZDJ_(G)), intent (in) :: dxdyh - real, intent(in) :: dens_ratio - integer, intent(in) :: is, ie, js, je - -! the linear action of the matrix on (u,v) with bilinear finite elements -! as of now everything is passed in so no grid pointers or anything of the sort have to be dereferenced, -! but this may change pursuant to conversations with others -! -! is & ie are the cells over which the iteration is done; this may change between calls to this subroutine -! in order to make less frequent halo updates - -! the linear action of the matrix on (u,v) with bilinear finite elements -! Phi has the form -! Phi(i,j,k,q) - applies to cell i,j - - ! 3 - 4 - ! | | - ! 1 - 2 - -! Phi(i,j,2*k-1,q) gives d(Phi_k)/dx at quadrature point q -! Phi(i,j,2*k,q) gives d(Phi_k)/dy at quadrature point q -! Phi_k is equal to 1 at vertex k, and 0 at vertex l /= k, and bilinear - - real :: ux, vx, uy, vy, uq, vq, area, basel - integer :: iq, jq, iphi, jphi, i, j, ilq, jlq - real, dimension(2) :: xquad - real, dimension(2,2) :: Ucell,Vcell,Hcell,Usubcontr,Vsubcontr,Ucontr - - xquad(1) = .5 * (1-sqrt(1./3)) ; xquad(2) = .5 * (1+sqrt(1./3)) - - do j=js,je - do i=is,ie ; if (hmask(i,j) == 1) then -! dxh = G%dxh(i,j) -! dyh = G%dyh(i,j) -! -! X(:,:) = G%geoLonBu(i-1:i,j-1:j) -! Y(:,:) = G%geoLatBu(i-1:i,j-1:j) -! -! call bilinear_shape_functions (X, Y, Phi, area) - - ! X and Y must be passed in the form - ! 3 - 4 - ! | | - ! 1 - 2 - ! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j - ! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j - - area = dxdyh(i,j) - - Ucontr=0 - do iq=1,2 ; do jq=1,2 - - - if (iq == 2) then - ilq = 2 - else - ilq = 1 - endif - - if (jq == 2) then - jlq = 2 - else - jlq = 1 - endif - - uq = u(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + & - u(i,j-1) * xquad(iq) * xquad(3-jq) + & - u(i-1,j) * xquad(3-iq) * xquad(jq) + & - u(i,j) * xquad(iq) * xquad(jq) - - vq = v(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + & - v(i,j-1) * xquad(iq) * xquad(3-jq) + & - v(i-1,j) * xquad(3-iq) * xquad(jq) + & - v(i,j) * xquad(iq) * xquad(jq) - - ux = u(i-1,j-1) * Phi(i,j,1,2*(jq-1)+iq) + & - u(i,j-1) * Phi(i,j,3,2*(jq-1)+iq) + & - u(i-1,j) * Phi(i,j,5,2*(jq-1)+iq) + & - u(i,j) * Phi(i,j,7,2*(jq-1)+iq) - - vx = v(i-1,j-1) * Phi(i,j,1,2*(jq-1)+iq) + & - v(i,j-1) * Phi(i,j,3,2*(jq-1)+iq) + & - v(i-1,j) * Phi(i,j,5,2*(jq-1)+iq) + & - v(i,j) * Phi(i,j,7,2*(jq-1)+iq) - - uy = u(i-1,j-1) * Phi(i,j,2,2*(jq-1)+iq) + & - u(i,j-1) * Phi(i,j,4,2*(jq-1)+iq) + & - u(i-1,j) * Phi(i,j,6,2*(jq-1)+iq) + & - u(i,j) * Phi(i,j,8,2*(jq-1)+iq) - - vy = v(i-1,j-1) * Phi(i,j,2,2*(jq-1)+iq) + & - v(i,j-1) * Phi(i,j,4,2*(jq-1)+iq) + & - v(i-1,j) * Phi(i,j,6,2*(jq-1)+iq) + & - v(i,j) * Phi(i,j,8,2*(jq-1)+iq) - - do iphi=1,2 ; do jphi=1,2 - if (umask(i-2+iphi,j-2+jphi) == 1) then - - uret(i-2+iphi,j-2+jphi) = uret(i-2+iphi,j-2+jphi) + & - .25 * area * nu(i,j) * ((4*ux+2*vy) * Phi(i,j,2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & - (uy+vx) * Phi(i,j,2*(2*(jphi-1)+iphi),2*(jq-1)+iq)) - endif - if (vmask(i-2+iphi,j-2+jphi) == 1) then - - vret(i-2+iphi,j-2+jphi) = vret(i-2+iphi,j-2+jphi) + & - .25 * area * nu(i,j) * ((uy+vx) * Phi(i,j,2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & - (4*vy+2*ux) * Phi(i,j,2*(2*(jphi-1)+iphi),2*(jq-1)+iq)) - endif - - if (iq == iphi) then - ilq = 2 - else - ilq = 1 - endif - - if (jq == jphi) then - jlq = 2 - else - jlq = 1 - endif - - if (float_cond(i,j) == 0) then - - if (umask(i-2+iphi,j-2+jphi) == 1) then - - uret(i-2+iphi,j-2+jphi) = uret(i-2+iphi,j-2+jphi) + & - .25 * beta(i,j) * area * uq * xquad(ilq) * xquad(jlq) - - endif - - if (vmask(i-2+iphi,j-2+jphi) == 1) then - - vret(i-2+iphi,j-2+jphi) = vret(i-2+iphi,j-2+jphi) + & - .25 * beta(i,j) * area * vq * xquad(ilq) * xquad(jlq) - - endif - - endif - Ucontr(iphi,jphi) = Ucontr(iphi,jphi) + .25 * area * uq * xquad(ilq) * xquad(jlq) * beta(i,j) - enddo ; enddo - enddo ; enddo - - if (float_cond(i,j) == 1) then - Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = D(i,j) - Ucell(:,:) = u(i-1:i,j-1:j) ; Vcell(:,:) = v(i-1:i,j-1:j) ; Hcell(:,:) = H_node(i-1:i,j-1:j) - call CG_action_subgrid_basal & - (Phisub, Hcell, Ucell, Vcell, area, basel, dens_ratio, Usubcontr, Vsubcontr, i, j) - do iphi=1,2 ; do jphi=1,2 - if (umask(i-2+iphi,j-2+jphi) == 1) then - uret(i-2+iphi,j-2+jphi) = uret(i-2+iphi,j-2+jphi) + Usubcontr (iphi,jphi) * beta(i,j) - endif - if (vmask(i-2+iphi,j-2+jphi) == 1) then - vret(i-2+iphi,j-2+jphi) = vret(i-2+iphi,j-2+jphi) + Vsubcontr (iphi,jphi) * beta(i,j) - endif - enddo ; enddo - endif - - endif - enddo ; enddo - -end subroutine CG_action - -subroutine CG_action_subgrid_basal(Phisub, H, U, V, DXDYH, D, dens_ratio, Ucontr, Vcontr, iin, jin) - real, dimension(:,:,:,:,:,:), intent(in) :: Phisub - real, dimension(2,2), intent(in) :: H,U,V - real, intent(in) :: DXDYH, D, dens_ratio - real, dimension(2,2), intent(inout) :: Ucontr, Vcontr - integer, optional, intent(in) :: iin, jin - - ! D = cellwise-constant bed elevation - - integer :: nsub, i, j, k, l, qx, qy, m, n, i_m, j_m - real :: subarea, hloc, uq, vq - - nsub = size(Phisub,1) - subarea = DXDYH / (nsub**2) - - - if (.not. present(iin)) then - i_m = -1 - else - i_m = iin - endif - - if (.not. present(jin)) then - j_m = -1 - else - j_m = jin - endif - - - do m=1,2 - do n=1,2 - do j=1,nsub - do i=1,nsub - do qx=1,2 - do qy = 1,2 - - hloc = Phisub(i,j,1,1,qx,qy)*H(1,1)+Phisub(i,j,1,2,qx,qy)*H(1,2)+& - Phisub(i,j,2,1,qx,qy)*H(2,1)+Phisub(i,j,2,2,qx,qy)*H(2,2) - - if (dens_ratio * hloc - D > 0) then - !if (.true.) then - uq = 0 ; vq = 0 - do k=1,2 - do l=1,2 - !Ucontr(m,n) = Ucontr(m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * Phisub(i,j,k,l,qx,qy) * U(k,l) - !Vcontr(m,n) = Vcontr(m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * Phisub(i,j,k,l,qx,qy) * V(k,l) - uq = uq + Phisub(i,j,k,l,qx,qy) * U(k,l) ; vq = vq + Phisub(i,j,k,l,qx,qy) * V(k,l) - enddo - enddo - - Ucontr (m,n) = Ucontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * uq - Vcontr (m,n) = Vcontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * vq - - endif - - enddo - enddo - enddo - enddo - enddo - enddo - -end subroutine CG_action_subgrid_basal - - -subroutine matrix_diagonal(CS, G, float_cond, H_node, nu, beta, hmask, dens_ratio, & - Phisub, u_diagonal, v_diagonal) - - type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: float_cond - real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: H_node !< The ice shelf thickness at nodal - !! (corner) points, in m. - real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: nu - real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: beta - real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: hmask !< A mask indicating which tracer points are - !! partly or fully coupled by an ice-shelf - real :: dens_ratio - real, dimension(:,:,:,:,:,:), intent(in) :: Phisub - real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u_diagonal, v_diagonal - - -! returns the diagonal entries of the matrix for a Jacobi preconditioning - - integer :: i, j, is, js, cnt, isc, jsc, iec, jec, iphi, jphi, iq, jq, ilq, jlq - real :: A, n, ux, uy, vx, vy, eps_min, domain_width, dxh, dyh, dxdyh, area, uq, vq, basel - real, dimension(8,4) :: Phi - real, dimension(4) :: X, Y - real, dimension(2) :: xquad - real, dimension(2,2) :: Hcell,Usubcontr,Vsubcontr - - - isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec - - xquad(1) = .5 * (1-sqrt(1./3)) ; xquad(2) = .5 * (1+sqrt(1./3)) - -! X and Y must be passed in the form - ! 3 - 4 - ! | | - ! 1 - 2 -! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j -! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j - - do j=jsc-1,jec+1 ; do i=isc-1,iec+1 ; if (hmask(i,j) == 1) then - - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) - - X(1:2) = G%geoLonBu(i-1:i,j-1)*1000 - X(3:4) = G%geoLonBu(i-1:i,j) *1000 - Y(1:2) = G%geoLatBu(i-1:i,j-1) *1000 - Y(3:4) = G%geoLatBu(i-1:i,j)*1000 - - call bilinear_shape_functions(X, Y, Phi, area) - - ! X and Y must be passed in the form - ! 3 - 4 - ! | | - ! 1 - 2 - ! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j - ! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j - - do iq=1,2 ; do jq=1,2 - - do iphi=1,2 ; do jphi=1,2 - - if (iq == iphi) then - ilq = 2 - else - ilq = 1 - endif - - if (jq == jphi) then - jlq = 2 - else - jlq = 1 - endif - - if (CS%umask(i-2+iphi,j-2+jphi) == 1) then - - ux = Phi (2*(2*(jphi-1)+iphi)-1, 2*(jq-1)+iq) - uy = Phi (2*(2*(jphi-1)+iphi), 2*(jq-1)+iq) - vx = 0. - vy = 0. - - u_diagonal(i-2+iphi,j-2+jphi) = u_diagonal(i-2+iphi,j-2+jphi) + & - .25 * dxdyh * nu(i,j) * ((4*ux+2*vy) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & - (uy+vy) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq)) - - uq = xquad(ilq) * xquad(jlq) - - if (float_cond(i,j) == 0) then - u_diagonal(i-2+iphi,j-2+jphi) = u_diagonal(i-2+iphi,j-2+jphi) + & - .25 * beta(i,j) * dxdyh * uq * xquad(ilq) * xquad(jlq) - endif - - endif - - if (CS%vmask(i-2+iphi,j-2+jphi) == 1) then - - vx = Phi (2*(2*(jphi-1)+iphi)-1, 2*(jq-1)+iq) - vy = Phi (2*(2*(jphi-1)+iphi), 2*(jq-1)+iq) - ux = 0. - uy = 0. - - v_diagonal(i-2+iphi,j-2+jphi) = v_diagonal(i-2+iphi,j-2+jphi) + & - .25 * dxdyh * nu(i,j) * ((uy+vx) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & - (4*vy+2*ux) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq)) - - vq = xquad(ilq) * xquad(jlq) - - if (float_cond(i,j) == 0) then - v_diagonal(i-2+iphi,j-2+jphi) = v_diagonal(i-2+iphi,j-2+jphi) + & - .25 * beta(i,j) * dxdyh * vq * xquad(ilq) * xquad(jlq) - endif - - endif - enddo ; enddo - enddo ; enddo - if (float_cond(i,j) == 1) then - Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%bathyT(i,j) - Hcell(:,:) = H_node(i-1:i,j-1:j) - call CG_diagonal_subgrid_basal & - (Phisub, Hcell, dxdyh, basel, dens_ratio, Usubcontr, Vsubcontr) - do iphi=1,2 ; do jphi=1,2 - if (CS%umask(i-2+iphi,j-2+jphi) == 1) then - u_diagonal(i-2+iphi,j-2+jphi) = u_diagonal(i-2+iphi,j-2+jphi) + Usubcontr(iphi,jphi) * beta(i,j) - v_diagonal(i-2+iphi,j-2+jphi) = v_diagonal(i-2+iphi,j-2+jphi) + Vsubcontr(iphi,jphi) * beta(i,j) - endif - enddo ; enddo - endif - endif ; enddo ; enddo - -end subroutine matrix_diagonal - -subroutine CG_diagonal_subgrid_basal (Phisub, H, DXDYH, D, dens_ratio, Ucontr, Vcontr) - real, dimension(:,:,:,:,:,:), intent(in) :: Phisub - real, dimension(2,2), intent(in) :: H - real, intent(in) :: DXDYH, D, dens_ratio - real, dimension(2,2), intent(inout) :: Ucontr, Vcontr - - ! D = cellwise-constant bed elevation - - integer :: nsub, i, j, k, l, qx, qy, m, n - real :: subarea, hloc - - nsub = size(Phisub,1) - subarea = DXDYH / (nsub**2) - - do m=1,2 - do n=1,2 - do j=1,nsub - do i=1,nsub - do qx=1,2 - do qy = 1,2 - - hloc = Phisub(i,j,1,1,qx,qy)*H(1,1)+Phisub(i,j,1,2,qx,qy)*H(1,2)+& - Phisub(i,j,2,1,qx,qy)*H(2,1)+Phisub(i,j,2,2,qx,qy)*H(2,2) - - if (dens_ratio * hloc - D > 0) then - Ucontr (m,n) = Ucontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy)**2 - Vcontr (m,n) = Vcontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy)**2 - endif - - - enddo - enddo - enddo - enddo - enddo - enddo - -end subroutine CG_diagonal_subgrid_basal - - -subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, float_cond, & - dens_ratio, u_bdry_contr, v_bdry_contr) - - type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure - type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe - !! the ice-shelf state - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - type(time_type), intent(in) :: Time !< The current model time - real, dimension(:,:,:,:,:,:), intent(in) :: Phisub - real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: H_node !< The ice shelf thickness at nodal - !! (corner) points, in m. - real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: nu - real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: beta - real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: float_cond - real :: dens_ratio - real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u_bdry_contr, v_bdry_contr - -! this will be a per-setup function. the boundary values of thickness and velocity -! (and possibly other variables) will be updated in this function - - real, dimension(8,4) :: Phi - real, dimension(4) :: X, Y - real, dimension(2) :: xquad - integer :: i, j, isc, jsc, iec, jec, iq, jq, iphi, jphi, ilq, jlq - real :: A, n, ux, uy, vx, vy, eps_min, domain_width, dxh, dyh, dxdyh, uq, vq, area, basel - real, dimension(2,2) :: Ucell,Vcell,Hcell,Usubcontr,Vsubcontr - - - isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec - - xquad(1) = .5 * (1-sqrt(1./3)) ; xquad(2) = .5 * (1+sqrt(1./3)) - -! X and Y must be passed in the form - ! 3 - 4 - ! | | - ! 1 - 2 -! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j -! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j - - do j=jsc-1,jec+1 ; do i=isc-1,iec+1 ; if (ISS%hmask(i,j) == 1) then - - ! process this cell if any corners have umask set to non-dirichlet bdry. - ! NOTE: vmask not considered, probably should be - - if ((CS%umask(i-1,j-1) == 3) .OR. (CS%umask(i,j-1) == 3) .OR. & - (CS%umask(i-1,j) == 3) .OR. (CS%umask(i,j) == 3)) then - - - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) - - X(1:2) = G%geoLonBu(i-1:i,j-1)*1000 - X(3:4) = G%geoLonBu(i-1:i,j)*1000 - Y(1:2) = G%geoLatBu(i-1:i,j-1)*1000 - Y(3:4) = G%geoLatBu(i-1:i,j)*1000 - - call bilinear_shape_functions(X, Y, Phi, area) - - ! X and Y must be passed in the form - ! 3 - 4 - ! | | - ! 1 - 2 - ! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j - ! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j - - - - do iq=1,2 ; do jq=1,2 - - uq = CS%u_bdry_val(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + & - CS%u_bdry_val(i,j-1) * xquad(iq) * xquad(3-jq) + & - CS%u_bdry_val(i-1,j) * xquad(3-iq) * xquad(jq) + & - CS%u_bdry_val(i,j) * xquad(iq) * xquad(jq) - - vq = CS%v_bdry_val(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + & - CS%v_bdry_val(i,j-1) * xquad(iq) * xquad(3-jq) + & - CS%v_bdry_val(i-1,j) * xquad(3-iq) * xquad(jq) + & - CS%v_bdry_val(i,j) * xquad(iq) * xquad(jq) - - ux = CS%u_bdry_val(i-1,j-1) * Phi(1,2*(jq-1)+iq) + & - CS%u_bdry_val(i,j-1) * Phi(3,2*(jq-1)+iq) + & - CS%u_bdry_val(i-1,j) * Phi(5,2*(jq-1)+iq) + & - CS%u_bdry_val(i,j) * Phi(7,2*(jq-1)+iq) - - vx = CS%v_bdry_val(i-1,j-1) * Phi(1,2*(jq-1)+iq) + & - CS%v_bdry_val(i,j-1) * Phi(3,2*(jq-1)+iq) + & - CS%v_bdry_val(i-1,j) * Phi(5,2*(jq-1)+iq) + & - CS%v_bdry_val(i,j) * Phi(7,2*(jq-1)+iq) - - uy = CS%u_bdry_val(i-1,j-1) * Phi(2,2*(jq-1)+iq) + & - CS%u_bdry_val(i,j-1) * Phi(4,2*(jq-1)+iq) + & - CS%u_bdry_val(i-1,j) * Phi(6,2*(jq-1)+iq) + & - CS%u_bdry_val(i,j) * Phi(8,2*(jq-1)+iq) - - vy = CS%v_bdry_val(i-1,j-1) * Phi(2,2*(jq-1)+iq) + & - CS%v_bdry_val(i,j-1) * Phi(4,2*(jq-1)+iq) + & - CS%v_bdry_val(i-1,j) * Phi(6,2*(jq-1)+iq) + & - CS%v_bdry_val(i,j) * Phi(8,2*(jq-1)+iq) - - do iphi=1,2 ; do jphi=1,2 - - if (iq == iphi) then - ilq = 2 - else - ilq = 1 - endif - - if (jq == jphi) then - jlq = 2 - else - jlq = 1 - endif - - if (CS%umask(i-2+iphi,j-2+jphi) == 1) then - - - u_bdry_contr(i-2+iphi,j-2+jphi) = u_bdry_contr(i-2+iphi,j-2+jphi) + & - .25 * dxdyh * nu(i,j) * ( (4*ux+2*vy) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & - (uy+vx) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq) ) - - if (float_cond(i,j) == 0) then - u_bdry_contr(i-2+iphi,j-2+jphi) = u_bdry_contr(i-2+iphi,j-2+jphi) + & - .25 * beta(i,j) * dxdyh * uq * xquad(ilq) * xquad(jlq) - endif - - endif - - if (CS%vmask(i-2+iphi,j-2+jphi) == 1) then - - - v_bdry_contr(i-2+iphi,j-2+jphi) = v_bdry_contr(i-2+iphi,j-2+jphi) + & - .25 * dxdyh * nu(i,j) * ( (uy+vx) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & - (4*vy+2*ux) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq)) - - if (float_cond(i,j) == 0) then - v_bdry_contr(i-2+iphi,j-2+jphi) = v_bdry_contr(i-2+iphi,j-2+jphi) + & - .25 * beta(i,j) * dxdyh * vq * xquad(ilq) * xquad(jlq) - endif - - endif - enddo ; enddo - enddo ; enddo - - if (float_cond(i,j) == 1) then - Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%bathyT(i,j) - Ucell(:,:) = CS%u_bdry_val(i-1:i,j-1:j) ; Vcell(:,:) = CS%v_bdry_val(i-1:i,j-1:j) - Hcell(:,:) = H_node(i-1:i,j-1:j) - call CG_action_subgrid_basal & - (Phisub, Hcell, Ucell, Vcell, dxdyh, basel, dens_ratio, Usubcontr, Vsubcontr) - do iphi=1,2 ; do jphi = 1,2 - if (CS%umask(i-2+iphi,j-2+jphi) == 1) then - u_bdry_contr(i-2+iphi,j-2+jphi) = u_bdry_contr(i-2+iphi,j-2+jphi) + & - Usubcontr(iphi,jphi) * beta(i,j) - endif - if (CS%vmask(i-2+iphi,j-2+jphi) == 1) then - v_bdry_contr(i-2+iphi,j-2+jphi) = v_bdry_contr(i-2+iphi,j-2+jphi) + & - Vsubcontr(iphi,jphi) * beta(i,j) - endif - enddo ; enddo - endif - endif - endif ; enddo ; enddo - -end subroutine apply_boundary_values - - -subroutine calc_shelf_visc(CS, ISS, G, u, v) - type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure - type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe - !! the ice-shelf state - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & - intent(inout) :: u !< The zonal ice shelf velocity, in m/s. - real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & - intent(inout) :: v !< The meridional ice shelf velocity, in m/s. - -! update DEPTH_INTEGRATED viscosity, based on horizontal strain rates - this is for bilinear FEM solve -! so there is an "upper" and "lower" bilinear viscosity - -! also this subroutine updates the nonlinear part of the basal traction - -! this may be subject to change later... to make it "hybrid" - - integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq - integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js - real :: A, n, ux, uy, vx, vy, eps_min, umid, vmid, unorm, C_basal_friction, n_basal_friction, dxh, dyh, dxdyh - - isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec - iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB - isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed - iegq = G%iegB ; jegq = G%jegB - gisc = G%domain%nihalo+1 ; gjsc = G%domain%njhalo+1 - giec = G%domain%niglobal+gisc ; gjec = G%domain%njglobal+gjsc - is = iscq - 1; js = jscq - 1 - - A = CS%A_glen_isothermal ; n = CS%n_glen; eps_min = CS%eps_glen_min - C_basal_friction = CS%C_basal_friction ; n_basal_friction = CS%n_basal_friction - - do j=jsd+1,jed-1 - do i=isd+1,ied-1 - - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) - - if (ISS%hmask(i,j) == 1) then - ux = (u(i,j) + u(i,j-1) - u(i-1,j) - u(i-1,j-1)) / (2*dxh) - vx = (v(i,j) + v(i,j-1) - v(i-1,j) - v(i-1,j-1)) / (2*dxh) - uy = (u(i,j) - u(i,j-1) + u(i-1,j) - u(i-1,j-1)) / (2*dyh) - vy = (v(i,j) - v(i,j-1) + v(i-1,j) - v(i-1,j-1)) / (2*dyh) - - CS%ice_visc(i,j) = .5 * A**(-1/n) * & - (ux**2+vy**2+ux*vy+0.25*(uy+vx)**2+eps_min**2) ** ((1-n)/(2*n)) * & - ISS%h_shelf(i,j) - - umid = (u(i,j) + u(i,j-1) + u(i-1,j) + u(i-1,j-1))/4 - vmid = (v(i,j) + v(i,j-1) + v(i-1,j) + v(i-1,j-1))/4 - unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) - CS%taub_beta_eff(i,j) = C_basal_friction * unorm ** (n_basal_friction-1) - endif - enddo - enddo - -end subroutine calc_shelf_visc - -subroutine update_OD_ffrac(CS, G, ocean_mass, find_avg) - type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure - type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: ocean_mass !< The mass per unit area of the ocean in kg m-2. - logical, intent(in) :: find_avg !< If true, find the average of OD and ffrac, and - !! reset the underlying running sums to 0. - - integer :: isc, iec, jsc, jec, i, j - real :: I_rho_ocean - real :: I_counter - - I_rho_ocean = 1.0/CS%density_ocean_avg - - isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec - - do j=jsc,jec ; do i=isc,iec - CS%OD_rt(i,j) = CS%OD_rt(i,j) + ocean_mass(i,j)*I_rho_ocean - if (ocean_mass(i,j)*I_rho_ocean > CS%thresh_float_col_depth) then - CS%float_frac_rt(i,j) = CS%float_frac_rt(i,j) + 1.0 - endif - enddo ; enddo - CS%OD_rt_counter = CS%OD_rt_counter + 1 - - if (find_avg) then - I_counter = 1.0 / real(CS%OD_rt_counter) - do j=jsc,jec ; do i=isc,iec - CS%float_frac(i,j) = 1.0 - (CS%float_frac_rt(i,j) * I_counter) - CS%OD_av(i,j) = CS%OD_rt(i,j) * I_counter - - CS%OD_rt(i,j) = 0.0 ; CS%float_frac_rt(i,j) = 0.0 - enddo ; enddo - - call pass_var(CS%float_frac, G%domain) - call pass_var(CS%OD_av, G%domain) - endif - -end subroutine update_OD_ffrac - -subroutine update_OD_ffrac_uncoupled(CS, G, h_shelf) - type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: h_shelf !< the thickness of the ice shelf in m - - integer :: i, j, iters, isd, ied, jsd, jed - real :: rhoi, rhow, OD - - rhoi = CS%density_ice - rhow = CS%density_ocean_avg - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - - do j=jsd,jed - do i=isd,ied - OD = G%bathyT(i,j) - rhoi/rhow * h_shelf(i,j) - if (OD >= 0) then - ! ice thickness does not take up whole ocean column -> floating - CS%OD_av(i,j) = OD - CS%float_frac(i,j) = 0. - else - CS%OD_av(i,j) = 0. - CS%float_frac(i,j) = 1. - endif - enddo - enddo - -end subroutine update_OD_ffrac_uncoupled - -subroutine bilinear_shape_functions (X, Y, Phi, area) - real, dimension(4), intent(in) :: X, Y - real, dimension(8,4), intent (inout) :: Phi - real, intent (out) :: area - -! X and Y must be passed in the form - ! 3 - 4 - ! | | - ! 1 - 2 - -! this subroutine calculates the gradients of bilinear basis elements that -! that are centered at the vertices of the cell. values are calculated at -! points of gaussian quadrature. (in 1D: .5 * (1 +/- sqrt(1/3)) for [0,1]) -! (ordered in same way as vertices) -! -! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j -! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j -! Phi_i is equal to 1 at vertex i, and 0 at vertex k /= i, and bilinear -! -! This should be a one-off; once per nonlinear solve? once per lifetime? -! ... will all cells have the same shape and dimension? - - real, dimension(4) :: xquad, yquad - integer :: node, qpoint, xnode, xq, ynode, yq - real :: a,b,c,d,e,f,xexp,yexp - - xquad(1:3:2) = .5 * (1-sqrt(1./3)) ; yquad(1:2) = .5 * (1-sqrt(1./3)) - xquad(2:4:2) = .5 * (1+sqrt(1./3)) ; yquad(3:4) = .5 * (1+sqrt(1./3)) - - do qpoint=1,4 - - a = -X(1)*(1-yquad(qpoint)) + X(2)*(1-yquad(qpoint)) - X(3)*yquad(qpoint) + X(4)*yquad(qpoint) ! d(x)/d(x*) - b = -Y(1)*(1-yquad(qpoint)) + Y(2)*(1-yquad(qpoint)) - Y(3)*yquad(qpoint) + Y(4)*yquad(qpoint) ! d(y)/d(x*) - c = -X(1)*(1-xquad(qpoint)) - X(2)*(xquad(qpoint)) + X(3)*(1-xquad(qpoint)) + X(4)*(xquad(qpoint)) ! d(x)/d(y*) - d = -Y(1)*(1-xquad(qpoint)) - Y(2)*(xquad(qpoint)) + Y(3)*(1-xquad(qpoint)) + Y(4)*(xquad(qpoint)) ! d(y)/d(y*) - - do node=1,4 - - xnode = 2-mod(node,2) ; ynode = ceiling(REAL(node)/2) - - if (ynode == 1) then - yexp = 1-yquad(qpoint) - else - yexp = yquad(qpoint) - endif - - if (1 == xnode) then - xexp = 1-xquad(qpoint) - else - xexp = xquad(qpoint) - endif - - Phi (2*node-1,qpoint) = ( d * (2 * xnode - 3) * yexp - b * (2 * ynode - 3) * xexp) / (a*d-b*c) - Phi (2*node,qpoint) = ( -c * (2 * xnode - 3) * yexp + a * (2 * ynode - 3) * xexp) / (a*d-b*c) - - enddo - enddo - - area = quad_area (X,Y) - -end subroutine bilinear_shape_functions - - -subroutine bilinear_shape_functions_subgrid (Phisub, nsub) - real, dimension(nsub,nsub,2,2,2,2), intent(inout) :: Phisub - integer :: nsub - - ! this subroutine is a helper for interpolation of floatation condition - ! for the purposes of evaluating the terms \int (u,v) \phi_i dx dy in a cell that is - ! in partial floatation - ! the array Phisub contains the values of \phi_i (where i is a node of the cell) - ! at quad point j - ! i think this general approach may not work for nonrectangular elements... - ! - - ! Phisub(i,j,k,l,q1,q2) - ! i: subgrid index in x-direction - ! j: subgrid index in y-direction - ! k: basis function x-index - ! l: basis function y-index - ! q1: quad point x-index - ! q2: quad point y-index - - ! e.g. k=1,l=1 => node 1 - ! q1=2,q2=1 => quad point 2 - - ! 3 - 4 - ! | | - ! 1 - 2 - - integer :: i, j, k, l, qx, qy, indx, indy - real,dimension(2) :: xquad - real :: x0, y0, x, y, val, fracx - - xquad(1) = .5 * (1-sqrt(1./3)) ; xquad(2) = .5 * (1+sqrt(1./3)) - fracx = 1.0/real(nsub) - - do j=1,nsub - do i=1,nsub - x0 = (i-1) * fracx ; y0 = (j-1) * fracx - do qx=1,2 - do qy=1,2 - x = x0 + fracx*xquad(qx) - y = y0 + fracx*xquad(qy) - do k=1,2 - do l=1,2 - val = 1.0 - if (k == 1) then - val = val * (1.0-x) - else - val = val * x - endif - if (l == 1) then - val = val * (1.0-y) - else - val = val * y - endif - Phisub(i,j,k,l,qx,qy) = val - enddo - enddo - enddo - enddo - enddo - enddo - -end subroutine bilinear_shape_functions_subgrid - - -subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face_mask) - type(ice_shelf_dyn_CS),intent(in) :: CS !< A pointer to the ice shelf dynamics control structure - type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: hmask !< A mask indicating which tracer points are - !! partly or fully coupled by an ice-shelf - real, dimension(SZDIB_(G),SZDJB_(G)), & - intent(out) :: umask !< A coded mask indicating the nature of the - !! zonal flow at the corner point - real, dimension(SZDIB_(G),SZDJB_(G)), & - intent(out) :: vmask !< A coded mask indicating the nature of the - !! meridional flow at the corner point - real, dimension(SZDIB_(G),SZDJ_(G)), & - intent(out) :: u_face_mask !< A coded mask for velocities at the C-grid u-face - real, dimension(SZDI_(G),SZDJB_(G)), & - intent(out) :: v_face_mask !< A coded mask for velocities at the C-grid v-face - ! sets masks for velocity solve - ! ignores the fact that their might be ice-free cells - this only considers the computational boundary - - ! !!!IMPORTANT!!! relies on thickness mask - assumed that this is called after hmask has been updated & halo-updated - - integer :: i, j, k, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq - integer :: giec, gjec, gisc, gjsc, isc, jsc, iec, jec - integer :: i_off, j_off - - isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec - iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB - i_off = G%idg_offset ; j_off = G%jdg_offset - isd = G%isd ; jsd = G%jsd - iegq = G%iegB ; jegq = G%jegB - gisc = G%Domain%nihalo ; gjsc = G%Domain%njhalo - giec = G%Domain%niglobal+gisc ; gjec = G%Domain%njglobal+gjsc - - umask(:,:) = 0 ; vmask(:,:) = 0 - u_face_mask(:,:) = 0 ; v_face_mask(:,:) = 0 - - if (G%symmetric) then - is = isd ; js = jsd - else - is = isd+1 ; js = jsd+1 - endif - - do j=js,G%jed - do i=is,G%ied - - if (hmask(i,j) == 1) then - - umask(i-1:i,j-1:j) = 1. - vmask(i-1:i,j-1:j) = 1. - - do k=0,1 - - select case (int(CS%u_face_mask_bdry(i-1+k,j))) - case (3) - umask(i-1+k,j-1:j)=3. - vmask(i-1+k,j-1:j)=0. - u_face_mask(i-1+k,j)=3. - case (2) - u_face_mask(i-1+k,j)=2. - case (4) - umask(i-1+k,j-1:j)=0. - vmask(i-1+k,j-1:j)=0. - u_face_mask(i-1+k,j)=4. - case (0) - umask(i-1+k,j-1:j)=0. - vmask(i-1+k,j-1:j)=0. - u_face_mask(i-1+k,j)=0. - case (1) ! stress free x-boundary - umask(i-1+k,j-1:j)=0. - case default - end select - enddo - - do k=0,1 - - select case (int(CS%v_face_mask_bdry(i,j-1+k))) - case (3) - vmask(i-1:i,j-1+k)=3. - umask(i-1:i,j-1+k)=0. - v_face_mask(i,j-1+k)=3. - case (2) - v_face_mask(i,j-1+k)=2. - case (4) - umask(i-1:i,j-1+k)=0. - vmask(i-1:i,j-1+k)=0. - v_face_mask(i,j-1+k)=4. - case (0) - umask(i-1:i,j-1+k)=0. - vmask(i-1:i,j-1+k)=0. - u_face_mask(i,j-1+k)=0. - case (1) ! stress free y-boundary - vmask(i-1:i,j-1+k)=0. - case default - end select - enddo - - !if (CS%u_face_mask_bdry(i-1,j).geq.0) then !left boundary - ! u_face_mask(i-1,j) = CS%u_face_mask_bdry(i-1,j) - ! umask(i-1,j-1:j) = 3. - ! vmask(i-1,j-1:j) = 0. - !endif - - !if (j_off+j == gjsc+1) then !bot boundary - ! v_face_mask(i,j-1) = 0. - ! umask (i-1:i,j-1) = 0. - ! vmask (i-1:i,j-1) = 0. - !elseif (j_off+j == gjec) then !top boundary - ! v_face_mask(i,j) = 0. - ! umask (i-1:i,j) = 0. - ! vmask (i-1:i,j) = 0. - !endif - - if (i < G%ied) then - if ((hmask(i+1,j) == 0) & - .OR. (hmask(i+1,j) == 2)) then - !right boundary or adjacent to unfilled cell - u_face_mask(i,j) = 2. - endif - endif - - if (i > G%isd) then - if ((hmask(i-1,j) == 0) .OR. (hmask(i-1,j) == 2)) then - !adjacent to unfilled cell - u_face_mask(i-1,j) = 2. - endif - endif - - if (j > G%jsd) then - if ((hmask(i,j-1) == 0) .OR. (hmask(i,j-1) == 2)) then - !adjacent to unfilled cell - v_face_mask(i,j-1) = 2. - endif - endif - - if (j < G%jed) then - if ((hmask(i,j+1) == 0) .OR. (hmask(i,j+1) == 2)) then - !adjacent to unfilled cell - v_face_mask(i,j) = 2. - endif - endif - - - endif - - enddo - enddo - - ! note: if the grid is nonsymmetric, there is a part that will not be transferred with a halo update - ! so this subroutine must update its own symmetric part of the halo - - call pass_vector(u_face_mask, v_face_mask, G%domain, TO_ALL, CGRID_NE) - call pass_vector(umask, vmask, G%domain, TO_ALL, BGRID_NE) - -end subroutine update_velocity_masks - -!> Interpolate the ice shelf thickness from tracer point to nodal points, -!! subject to a mask. -subroutine interpolate_H_to_B(G, h_shelf, hmask, H_node) - type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: h_shelf !< The ice shelf thickness at tracer points, in m. - real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: hmask !< A mask indicating which tracer points are - !! partly or fully coupled by an ice-shelf - real, dimension(SZDIB_(G),SZDJB_(G)), & - intent(inout) :: H_node !< The ice shelf thickness at nodal (corner) - !! points, in m. - - integer :: i, j, isc, iec, jsc, jec, num_h, k, l - real :: summ - - isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec - - H_node(:,:) = 0.0 - - ! H_node is node-centered; average over all cells that share that node - ! if no (active) cells share the node then its value there is irrelevant - - do j=jsc-1,jec - do i=isc-1,iec - summ = 0.0 - num_h = 0 - do k=0,1 - do l=0,1 - if (hmask(i+k,j+l) == 1.0) then - summ = summ + h_shelf(i+k,j+l) - num_h = num_h + 1 - endif - enddo - enddo - if (num_h > 0) then - H_node(i,j) = summ / num_h - endif - enddo - enddo - - call pass_var(H_node, G%domain, position=CORNER) - -end subroutine interpolate_H_to_B - -!> Deallocates all memory associated with the ice shelf dynamics module -subroutine ice_shelf_dyn_end(CS) - type(ice_shelf_dyn_CS), pointer :: CS !< A pointer to the ice shelf dynamics control structure - - if (.not.associated(CS)) return - - deallocate(CS%u_shelf, CS%v_shelf) - deallocate(CS%t_shelf, CS%tmask) - deallocate(CS%u_bdry_val, CS%v_bdry_val, CS%t_bdry_val) - deallocate(CS%u_face_mask, CS%v_face_mask) - deallocate(CS%umask, CS%vmask) - - deallocate(CS%ice_visc, CS%taub_beta_eff) - deallocate(CS%OD_rt, CS%OD_av) - deallocate(CS%float_frac, CS%float_frac_rt) - - deallocate(CS) - -end subroutine ice_shelf_dyn_end - -!> Deallocates all memory associated with this module -subroutine ice_shelf_end(CS) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - - if (.not.associated(CS)) return - - call ice_shelf_state_end(CS%ISS) - - if (CS%active_shelf_dynamics) & - call ice_shelf_dyn_end(CS%dCS) - - deallocate(CS) - -end subroutine ice_shelf_end - - -subroutine solo_time_step(CS, time_step, nsteps, Time, min_time_step_in) - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - real, intent(in) :: time_step !< The time interval for this update, in s. - integer, intent(inout) :: nsteps !< The running number of ice shelf steps. - type(time_type), intent(inout) :: Time !< The current model time - real, optional, intent(in) :: min_time_step_in !< The minimum permitted time step in s. - - type(ocean_grid_type), pointer :: G => NULL() - type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe - !! the ice-shelf state - type(ice_shelf_dyn_CS), pointer :: dCS => NULL() - integer :: is, iec, js, jec, i, j, ki, kj, iters - real :: ratio, min_ratio, time_step_remain, local_u_max - real :: local_v_max, time_step_int, min_time_step, spy, dumtimeprint - character(len=240) :: mesg - logical :: update_ice_vel ! If true, it is time to update the ice shelf velocities. - logical :: coupled_GL ! If true the grouding line position is determined based on - ! coupled ice-ocean dynamics. - logical :: flag - - spy = 365 * 86400 - G => CS%grid - ISS => CS%ISS - dCS => CS%dCS - is = G%isc ; iec = G%iec ; js = G%jsc ; jec = G%jec - - time_step_remain = time_step - if (present (min_time_step_in)) then - min_time_step = min_time_step_in - else - min_time_step = 1000.0 ! This is in seconds - at 1 km resolution it would imply ice is moving at ~1 meter per second - endif - - ! NOTE: this relies on NE grid indexing - ! dumtimeprint=time_type_to_real(Time)/spy - write (mesg,*) "TIME in ice shelf call, yrs: ", time_type_to_real(Time)/spy - call MOM_mesg("solo_time_step: "//mesg) - - do while (time_step_remain > 0.0) - nsteps = nsteps+1 - - ! If time_step is not too long, this is unnecessary. - time_step_int = min(ice_time_step_CFL(dCS, ISS, G), time_step) - - write (mesg,*) "Ice model timestep = ", time_step_int, " seconds" - if (time_step_int < min_time_step) then - call MOM_error(FATAL, "MOM_ice_shelf:solo_time_step: abnormally small timestep "//mesg) - else - call MOM_mesg("solo_time_step: "//mesg) - endif - - if (time_step_int >= time_step_remain) then - time_step_int = time_step_remain - time_step_remain = 0.0 - else - time_step_remain = time_step_remain - time_step_int - endif - - ! If the last mini-timestep is a day or less, we cannot expect velocities to change by much. - ! Do not update the velocities if the last step is very short. - update_ice_vel = ((time_step_int > min_time_step) .or. (time_step_int >= time_step)) - coupled_GL = .false. - - call update_ice_shelf(dCS, ISS, G, time_step_int, Time, must_update_vel=update_ice_vel) - - call enable_averaging(time_step,Time,CS%diag) - if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, ISS%area_shelf_h, CS%diag) - if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf,ISS%h_shelf,CS%diag) - if (CS%id_h_mask > 0) call post_data(CS%id_h_mask,ISS%hmask,CS%diag) - call disable_averaging(CS%diag) + call update_ice_shelf(dCS, ISS, G, time_step_int, Time, must_update_vel=update_ice_vel) + + call enable_averaging(time_step,Time,CS%diag) + if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, ISS%area_shelf_h, CS%diag) + if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf,ISS%h_shelf,CS%diag) + if (CS%id_h_mask > 0) call post_data(CS%id_h_mask,ISS%hmask,CS%diag) + call disable_averaging(CS%diag) enddo end subroutine solo_time_step -!> This subroutine updates the vertically averaged ice shelf temperature. -subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) - type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure - type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe - !! the ice-shelf state - type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step !< The time step for this update, in s. - real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: melt_rate !< basal melt rate in kg/m^2/s - type(time_type), intent(in) :: Time !< The current model time - -! time_step: time step in sec -! melt_rate: basal melt rate in kg/m^2/s - -! 5/23/12 OVS -! Arguments: -! CS - A structure containing the ice shelf state - including current velocities -! t0 - an array containing temperature at the beginning of the call -! t_after_uflux - an array containing the temperature after advection in u-direction -! t_after_vflux - similar -! -! This subroutine takes the velocity (on the Bgrid) and timesteps -! (HT)_t = - div (uHT) + (adot Tsurd -bdot Tbot) once and then calculates T=HT/H -! -! The flux overflows are included here. That is because they will be used to advect 3D scalars -! into partial cells - - ! - ! flux_enter: this is to capture flow into partially covered cells; it gives the mass flux into a given - ! cell across its boundaries. - ! ###Perhaps flux_enter should be changed into u-face and v-face - ! ###fluxes, which can then be used in halo updates, etc. - ! - ! from left neighbor: flux_enter(:,:,1) - ! from right neighbor: flux_enter(:,:,2) - ! from bottom neighbor: flux_enter(:,:,3) - ! from top neighbor: flux_enter(:,:,4) - ! - ! THESE ARE NOT CONSISTENT ==> FIND OUT WHAT YOU IMPLEMENTED - - ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary - ! - ! o--- (4) ---o - ! | | - ! (1) (2) - ! | | - ! o--- (3) ---o - ! - - real, dimension(SZDI_(G),SZDJ_(G)) :: th_after_uflux, th_after_vflux, TH - real, dimension(SZDI_(G),SZDJ_(G),4) :: flux_enter - integer :: isd, ied, jsd, jed, i, j, isc, iec, jsc, jec - real :: rho, spy, t_bd, Tsurf, adot - - rho = CS%density_ice - spy = 365 * 86400 ! seconds per year; is there a global constant for this? No - it is dependent upon a calendar. - - adot = 0.1/spy ! for now adot and Tsurf are defined here adot=surf acc 0.1m/yr, Tsurf=-20oC, vary them later - Tsurf = -20.0 - - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec - flux_enter(:,:,:) = 0.0 - - th_after_uflux(:,:) = 0.0 - th_after_vflux(:,:) = 0.0 - - do j=jsd,jed - do i=isd,ied - t_bd = CS%t_bdry_val(i,j) -! if (ISS%hmask(i,j) > 1) then - if ((ISS%hmask(i,j) == 3) .or. (ISS%hmask(i,j) == -2)) then - CS%t_shelf(i,j) = CS%t_bdry_val(i,j) - endif - enddo - enddo - - do j=jsd,jed - do i=isd,ied - TH(i,j) = CS%t_shelf(i,j)*ISS%h_shelf(i,j) - enddo - enddo - - -! call enable_averaging(time_step,Time,CS%diag) -! call pass_var(h_after_uflux, G%domain) -! call pass_var(h_after_vflux, G%domain) -! if (CS%id_h_after_uflux > 0) call post_data(CS%id_h_after_uflux, h_after_uflux, CS%diag) -! if (CS%id_h_after_vflux > 0) call post_data(CS%id_h_after_vflux, h_after_vflux, CS%diag) -! call disable_averaging(CS%diag) - - call ice_shelf_advect_temp_x(CS, G, time_step/spy, ISS%hmask, TH, th_after_uflux, flux_enter) - call ice_shelf_advect_temp_y(CS, G, time_step/spy, ISS%hmask, th_after_uflux, th_after_vflux, flux_enter) - - do j=jsd,jed - do i=isd,ied -! if (ISS%hmask(i,j) == 1) then - if (ISS%h_shelf(i,j) > 0.0) then - CS%t_shelf(i,j) = th_after_vflux(i,j)/ISS%h_shelf(i,j) - else - CS%t_shelf(i,j) = -10.0 - endif - enddo - enddo - - do j=jsd,jed - do i=isd,ied - t_bd = CS%t_bdry_val(i,j) -! if (ISS%hmask(i,j) > 1) then - if ((ISS%hmask(i,j) == 3) .or. (ISS%hmask(i,j) == -2)) then - CS%t_shelf(i,j) = t_bd -! CS%t_shelf(i,j) = -15.0 - endif - enddo - enddo - - do j=jsc,jec - do i=isc,iec - if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2)) then - if (ISS%h_shelf(i,j) > 0.0) then -! CS%t_shelf(i,j) = CS%t_shelf(i,j) + time_step*(adot*Tsurf -melt_rate(i,j)*ISS%tfreeze(i,j))/ISS%h_shelf(i,j) - CS%t_shelf(i,j) = CS%t_shelf(i,j) + time_step*(adot*Tsurf -3/spy*ISS%tfreeze(i,j))/ISS%h_shelf(i,j) - else - ! the ice is about to melt away - ! in this case set thickness, area, and mask to zero - ! NOTE: not mass conservative - ! should maybe scale salt & heat flux for this cell - - CS%t_shelf(i,j) = -10.0 - CS%tmask(i,j) = 0.0 - endif - endif - enddo - enddo - - call pass_var(CS%t_shelf, G%domain) - call pass_var(CS%tmask, G%domain) - - if (CS%DEBUG) then - call hchksum(CS%t_shelf, "temp after front", G%HI, haloshift=3) - endif - -end subroutine ice_shelf_temp - - -subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, flux_enter) - type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure - type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step !< The time step for this update, in s. - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask - real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h0 - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_uflux - real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter - - ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells - - ! if there is an input bdry condition, the thickness there will be set in initialization - - ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary - ! - ! from left neighbor: flux_enter(:,:,1) - ! from right neighbor: flux_enter(:,:,2) - ! from bottom neighbor: flux_enter(:,:,3) - ! from top neighbor: flux_enter(:,:,4) - ! - ! o--- (4) ---o - ! | | - ! (1) (2) - ! | | - ! o--- (3) ---o - ! - - integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied - integer :: i_off, j_off - logical :: at_east_bdry, at_west_bdry, one_off_west_bdry, one_off_east_bdry - real, dimension(-2:2) :: stencil - real :: u_face, & ! positive if out - flux_diff_cell, phi, dxh, dyh, dxdyh - - character (len=1) :: debug_str - - - is = G%isc-2 ; ie = G%iec+2 ; js = G%jsc ; je = G%jec ; isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - i_off = G%idg_offset ; j_off = G%jdg_offset - - do j=jsd+1,jed-1 - if (((j+j_off) <= G%domain%njglobal+G%domain%njhalo) .AND. & - ((j+j_off) >= G%domain%njhalo+1)) then ! based on mehmet's code - only if btw north & south boundaries - - stencil(:) = -1 -! if (i+i_off == G%domain%nihalo+G%domain%nihalo) - do i=is,ie - - if (((i+i_off) <= G%domain%niglobal+G%domain%nihalo) .AND. & - ((i+i_off) >= G%domain%nihalo+1)) then - - if (i+i_off == G%domain%nihalo+1) then - at_west_bdry=.true. - else - at_west_bdry=.false. - endif - - if (i+i_off == G%domain%niglobal+G%domain%nihalo) then - at_east_bdry=.true. - else - at_east_bdry=.false. - endif - - if (hmask(i,j) == 1) then - - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) - - h_after_uflux(i,j) = h0(i,j) - - stencil(:) = h0(i-2:i+2,j) ! fine as long has nx_halo >= 2 - - flux_diff_cell = 0 - - ! 1ST DO LEFT FACE - - if (CS%u_face_mask(i-1,j) == 4.) then - - flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_flux_bdry_val(i-1,j) * & - CS%t_bdry_val(i-1,j) / dxdyh -! assume no flux bc for temp -! flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_shelf(i,j)*CS%t_bdry_val(i-1,j) / dxdyh - - else - - ! get u-velocity at center of left face - u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - - if (u_face > 0) then !flux is into cell - we need info from h(i-2), h(i-1) if available - - ! i may not cover all the cases.. but i cover the realistic ones - - if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then ! at western bdry but there is a - ! thickness bdry condition, and the stencil contains it - flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(-1) / dxdyh - - elseif (hmask(i-1,j) * hmask(i-2,j) == 1) then ! h(i-2) and h(i-1) are valid - phi = slope_limiter (stencil(-1)-stencil(-2), stencil(0)-stencil(-1)) - flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh* time_step / dxdyh * & - (stencil(-1) - phi * (stencil(-1)-stencil(0))/2) - - else ! h(i-1) is valid - ! (o.w. flux would most likely be out of cell) - ! but h(i-2) is not - - flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step / dxdyh * stencil(-1) - - endif - - elseif (u_face < 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available - if (hmask(i-1,j) * hmask(i+1,j) == 1) then ! h(i-1) and h(i+1) are both valid - phi = slope_limiter (stencil(0)-stencil(1), stencil(-1)-stencil(0)) - flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * & - (stencil(0) - phi * (stencil(0)-stencil(-1))/2) - - else - flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * stencil(0) - - if ((hmask(i-1,j) == 0) .OR. (hmask(i-1,j) == 2)) then - flux_enter(i-1,j,2) = ABS(u_face) * dyh * time_step * stencil(0) - endif - endif - endif - endif - - ! NEXT DO RIGHT FACE - - ! get u-velocity at center of right face - - if (CS%u_face_mask(i+1,j) == 4.) then - - flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_flux_bdry_val(i+1,j) *& - CS%t_bdry_val(i+1,j)/ dxdyh -! assume no flux bc for temp -! flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_shelf(i,j)*CS%t_bdry_val(i+1,j)/ dxdyh - - else - - u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) - - if (u_face < 0) then !flux is into cell - we need info from h(i+2), h(i+1) if available - - if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then ! at eastern bdry but there is a - ! thickness bdry condition, and the stencil contains it - - flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(1) / dxdyh - - elseif (hmask(i+1,j) * hmask(i+2,j) == 1) then ! h(i+2) and h(i+1) are valid - - phi = slope_limiter (stencil(1)-stencil(2), stencil(0)-stencil(1)) - flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step / dxdyh * & - (stencil(1) - phi * (stencil(1)-stencil(0))/2) - - else ! h(i+1) is valid - ! (o.w. flux would most likely be out of cell) - ! but h(i+2) is not - - flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step / dxdyh * stencil(1) - - endif - - elseif (u_face > 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available - - if (hmask(i-1,j) * hmask(i+1,j) == 1) then ! h(i-1) and h(i+1) are both valid - - phi = slope_limiter (stencil(0)-stencil(-1), stencil(1)-stencil(0)) - flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * & - (stencil(0) - phi * (stencil(0)-stencil(1))/2) - - else ! h(i+1) is valid - ! (o.w. flux would most likely be out of cell) - ! but h(i+2) is not - - flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * stencil(0) - - if ((hmask(i+1,j) == 0) .OR. (hmask(i+1,j) == 2)) then - - flux_enter(i+1,j,1) = ABS(u_face) * dyh * time_step * stencil(0) - endif - - endif - - endif - - h_after_uflux(i,j) = h_after_uflux(i,j) + flux_diff_cell - - endif - - elseif ((hmask(i,j) == 0) .OR. (hmask(i,j) == 2)) then - - if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then - u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - flux_enter(i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * CS%t_bdry_val(i-1,j)* & - CS%thickness_bdry_val(i+1,j) - elseif (CS%u_face_mask(i-1,j) == 4.) then - flux_enter(i,j,1) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j)*CS%t_bdry_val(i-1,j) -! flux_enter(i,j,1) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*CS%t_bdry_val(i-1,j) -! assume no flux bc for temp - endif - - if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then - u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) - flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * CS%t_bdry_val(i+1,j)* & - CS%thickness_bdry_val(i+1,j) - elseif (CS%u_face_mask(i+1,j) == 4.) then - flux_enter(i,j,2) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) * CS%t_bdry_val(i+1,j) -! assume no flux bc for temp -! flux_enter(i,j,2) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*CS%t_bdry_val(i+1,j) - endif - -! if ((i == is) .AND. (hmask(i,j) == 0) .AND. (hmask(i-1,j) == 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing - ! the front without having to call pass_var - if cell is empty and cell to left - ! is ice-covered then this cell will become partly covered -! hmask(i,j) = 2 -! elseif ((i == ie) .AND. (hmask(i,j) == 0) .AND. (hmask(i+1,j) == 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing - ! the front without having to call pass_var - if cell is empty and cell to left - ! is ice-covered then this cell will become partly covered -! hmask(i,j) = 2 - -! endif - - endif - - endif - - enddo ! i loop - - endif - - enddo ! j loop - -end subroutine ice_shelf_advect_temp_x - -subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_after_vflux, flux_enter) - type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step !< The time step for this update, in s. - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask - real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h_after_uflux - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_vflux - real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter - - ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells - - ! if there is an input bdry condition, the thickness there will be set in initialization - - ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary - ! - ! from left neighbor: flux_enter(:,:,1) - ! from right neighbor: flux_enter(:,:,2) - ! from bottom neighbor: flux_enter(:,:,3) - ! from top neighbor: flux_enter(:,:,4) - ! - ! o--- (4) ---o - ! | | - ! (1) (2) - ! | | - ! o--- (3) ---o - ! - - integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied - integer :: i_off, j_off - logical :: at_north_bdry, at_south_bdry, one_off_west_bdry, one_off_east_bdry - real, dimension(-2:2) :: stencil - real :: v_face, & ! positive if out - flux_diff_cell, phi, dxh, dyh, dxdyh - character(len=1) :: debug_str - - is = G%isc ; ie = G%iec ; js = G%jsc-1 ; je = G%jec+1 ; isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - i_off = G%idg_offset ; j_off = G%jdg_offset - - do i=isd+2,ied-2 - if (((i+i_off) <= G%domain%niglobal+G%domain%nihalo) .AND. & - ((i+i_off) >= G%domain%nihalo+1)) then ! based on mehmet's code - only if btw east & west boundaries - - stencil(:) = -1 - - do j=js,je - - if (((j+j_off) <= G%domain%njglobal+G%domain%njhalo) .AND. & - ((j+j_off) >= G%domain%njhalo+1)) then - - if (j+j_off == G%domain%njhalo+1) then - at_south_bdry=.true. - else - at_south_bdry=.false. - endif - if (j+j_off == G%domain%njglobal+G%domain%njhalo) then - at_north_bdry=.true. - else - at_north_bdry=.false. - endif - - if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) - h_after_vflux(i,j) = h_after_uflux(i,j) - - stencil(:) = h_after_uflux(i,j-2:j+2) ! fine as long has ny_halo >= 2 - flux_diff_cell = 0 - - ! 1ST DO south FACE - - if (CS%v_face_mask(i,j-1) == 4.) then - - flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_flux_bdry_val(i,j-1) * & - CS%t_bdry_val(i,j-1)/ dxdyh -! assume no flux bc for temp -! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*CS%t_bdry_val(i,j-1) / dxdyh - - else - - ! get u-velocity at center of left face - v_face = 0.5 * (CS%v_shelf(i-1,j-1) + CS%v_shelf(i,j-1)) - - if (v_face > 0) then !flux is into cell - we need info from h(j-2), h(j-1) if available - - ! i may not cover all the cases.. but i cover the realistic ones - - if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then ! at western bdry but there is a - ! thickness bdry condition, and the stencil contains it - flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(-1) / dxdyh - - elseif (hmask(i,j-1) * hmask(i,j-2) == 1) then ! h(j-2) and h(j-1) are valid - - phi = slope_limiter (stencil(-1)-stencil(-2), stencil(0)-stencil(-1)) - flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * & - (stencil(-1) - phi * (stencil(-1)-stencil(0))/2) - - else ! h(j-1) is valid - ! (o.w. flux would most likely be out of cell) - ! but h(j-2) is not - flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * stencil(-1) - endif - - elseif (v_face < 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available - - if (hmask(i,j-1) * hmask(i,j+1) == 1) then ! h(j-1) and h(j+1) are both valid - phi = slope_limiter (stencil(0)-stencil(1), stencil(-1)-stencil(0)) - flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * & - (stencil(0) - phi * (stencil(0)-stencil(-1))/2) - else - flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * stencil(0) - - if ((hmask(i,j-1) == 0) .OR. (hmask(i,j-1) == 2)) then - flux_enter(i,j-1,4) = ABS(v_face) * dyh * time_step * stencil(0) - endif - - endif - - endif - - endif - - ! NEXT DO north FACE - - if (CS%v_face_mask(i,j+1) == 4.) then - - flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_flux_bdry_val(i,j+1) *& - CS%t_bdry_val(i,j+1)/ dxdyh -! assume no flux bc for temp -! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*CS%t_bdry_val(i,j+1) / dxdyh - - else - - ! get u-velocity at center of right face - v_face = 0.5 * (CS%v_shelf(i-1,j) + CS%v_shelf(i,j)) - - if (v_face < 0) then !flux is into cell - we need info from h(j+2), h(j+1) if available - - if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then ! at eastern bdry but there is a - ! thickness bdry condition, and the stencil contains it - flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(1) / dxdyh - elseif (hmask(i,j+1) * hmask(i,j+2) == 1) then ! h(j+2) and h(j+1) are valid - phi = slope_limiter (stencil(1)-stencil(2), stencil(0)-stencil(1)) - flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * & - (stencil(1) - phi * (stencil(1)-stencil(0))/2) - else ! h(j+1) is valid - ! (o.w. flux would most likely be out of cell) - ! but h(j+2) is not - flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * stencil(1) - endif - - elseif (v_face > 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available - - if (hmask(i,j-1) * hmask(i,j+1) == 1) then ! h(j-1) and h(j+1) are both valid - phi = slope_limiter (stencil(0)-stencil(-1), stencil(1)-stencil(0)) - flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * & - (stencil(0) - phi * (stencil(0)-stencil(1))/2) - else ! h(j+1) is valid - ! (o.w. flux would most likely be out of cell) - ! but h(j+2) is not - flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * stencil(0) - if ((hmask(i,j+1) == 0) .OR. (hmask(i,j+1) == 2)) then - flux_enter(i,j+1,3) = ABS(v_face) * dxh * time_step * stencil(0) - endif - endif - - endif - - endif - - h_after_vflux(i,j) = h_after_vflux(i,j) + flux_diff_cell - - elseif ((hmask(i,j) == 0) .OR. (hmask(i,j) == 2)) then - - if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then - v_face = 0.5 * (CS%v_shelf(i-1,j-1) + CS%v_shelf(i,j-1)) - flux_enter(i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * CS%t_bdry_val(i,j-1)* & - CS%thickness_bdry_val(i,j-1) - elseif (CS%v_face_mask(i,j-1) == 4.) then - flux_enter(i,j,3) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1)*CS%t_bdry_val(i,j-1) -! assume no flux bc for temp -! flux_enter(i,j,3) = G%dxh(i,j) * time_step * CS%v_shelf(i,j)*CS%t_bdry_val(i,j-1) - - endif - - if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then - v_face = 0.5 * (CS%v_shelf(i-1,j) + CS%v_shelf(i,j)) - flux_enter(i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * CS%t_bdry_val(i,j+1)* & - CS%thickness_bdry_val(i,j+1) - elseif (CS%v_face_mask(i,j+1) == 4.) then - flux_enter(i,j,4) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1)*CS%t_bdry_val(i,j+1) -! assume no flux bc for temp -! flux_enter(i,j,4) = G%dxh(i,j) * time_step * CS%v_shelf(i,j)*CS%t_bdry_val(i,j+1) - endif - -! if ((j == js) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j-1) == 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing - ! the front without having to call pass_var - if cell is empty and cell to left - ! is ice-covered then this cell will become partly covered - ! hmask(i,j) = 2 - ! elseif ((j == je) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j+1) == 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the - ! front without having to call pass_var - if cell is empty and cell to left is - ! ice-covered then this cell will become partly covered -! hmask(i,j) = 2 -! endif - - endif - endif - enddo ! j loop - endif - enddo ! i loop - -end subroutine ice_shelf_advect_temp_y !> \namespace mom_ice_shelf !! !! \section section_ICE_SHELF !! !! This module implements the thermodynamic aspects of ocean/ice-shelf -!! inter-actions, along with a crude placeholder for a later implementation of full -!! ice shelf dynamics, all using the MOM framework and coding style. +!! inter-actions using the MOM framework and coding style. !! !! Derived from code by Chris Little, early 2010. !! @@ -5691,7 +1790,7 @@ end subroutine ice_shelf_advect_temp_y !! - modifies u_shelf and v_shelf only !! - max iteration count can be set through input file !! - tolerance (and error evaluation) can be set through input file -!! (ISSUE: Too many mpp_sum calls?) +!! (ISSUE: Too many sum_across_PEs calls?) !! calc_shelf_driving_stress - Determine the driving stresses using h_shelf, (water) column thickness, bathymetry !! - does not modify any permanent arrays !! init_boundary_values - diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 new file mode 100644 index 0000000000..992b3d2f6c --- /dev/null +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -0,0 +1,4034 @@ +!> Implements the thermodynamic aspects of ocean / ice-shelf interactions, +!! along with a crude placeholder for a later implementation of full +!! ice shelf dynamics, all using the MOM framework and coding style. +module MOM_ice_shelf_dynamics + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end +use MOM_cpu_clock, only : CLOCK_COMPONENT, CLOCK_ROUTINE +use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr +use MOM_diag_mediator, only : diag_mediator_init, set_diag_mediator_grid +use MOM_diag_mediator, only : diag_ctrl, time_type, enable_averaging, disable_averaging +use MOM_domains, only : MOM_domains_init, clone_MOM_domain +use MOM_domains, only : pass_var, pass_vector, TO_ALL, CGRID_NE, BGRID_NE, CORNER +use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe +use MOM_file_parser, only : read_param, get_param, log_param, log_version, param_file_type +use MOM_grid, only : MOM_grid_init, ocean_grid_type +use MOM_io, only : file_exists, slasher, MOM_read_data +use MOM_restart, only : register_restart_field, query_initialized +use MOM_restart, only : MOM_restart_CS +use MOM_time_manager, only : time_type, set_time, time_type_to_real +!MJH use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary +use MOM_ice_shelf_state, only : ice_shelf_state +use MOM_coms, only : reproducing_sum, sum_across_PEs, max_across_PEs, min_across_PEs +use MOM_checksums, only : hchksum, qchksum + +implicit none ; private + +#include + +public register_ice_shelf_dyn_restarts, initialize_ice_shelf_dyn, update_ice_shelf +public ice_time_step_CFL, ice_shelf_dyn_end +public shelf_advance_front, ice_shelf_min_thickness_calve, calve_to_mask + +!> The control structure for the ice shelf dynamics. +type, public :: ice_shelf_dyn_CS ; private + real, pointer, dimension(:,:) :: & + u_shelf => NULL(), & !< the zonal (?) velocity of the ice shelf/sheet, + ! in meters per second??? on q-points (B grid) + v_shelf => NULL(), & !< the meridional velocity of the ice shelf/sheet, + !! in m/s ?? on q-points (B grid) + + u_face_mask => NULL(), & !> masks for velocity boundary conditions + v_face_mask => NULL(), & !! on *C GRID* - this is because the FEM + !! cares about FACES THAT GET INTEGRATED OVER, + !! not vertices. Will represent boundary conditions + !! on computational boundary (or permanent boundary + !! between fast-moving and near-stagnant ice + !! FOR NOW: 1=interior bdry, 0=no-flow boundary, + !! 2=stress bdry condition, 3=inhomogeneous + !! dirichlet boundary, 4=flux boundary: at these + !! faces a flux will be specified which will + !! override velocities; a homogeneous velocity + !! condition will be specified (this seems to give + !! the solver less difficulty) + u_face_mask_bdry => NULL(), & + v_face_mask_bdry => NULL(), & + u_flux_bdry_val => NULL(), & + v_flux_bdry_val => NULL(), & + ! needed where u_face_mask is equal to 4, similary for v_face_mask + umask => NULL(), vmask => NULL(), & !< masks on the actual degrees of freedom (B grid) + !! 1=normal node, 3=inhomogeneous boundary node, + !! 0 - no flow node (will also get ice-free nodes) + calve_mask => NULL(), & !< a mask to prevent the ice shelf front from + !! advancing past its initial position (but it may + !! retreat) + t_shelf => NULL(), & !< Veritcally integrated temperature in the ice shelf/stream, in degC + !< on corner-points (B grid) + tmask => NULL(), & + ! masks for temperature boundary conditions ??? + ice_visc => NULL(), & + thickness_bdry_val => NULL(), & + u_bdry_val => NULL(), & + v_bdry_val => NULL(), & + h_bdry_val => NULL(), & + t_bdry_val => NULL(), & + + taub_beta_eff => NULL(), & ! nonlinear part of "linearized" basal stress - + ! exact form depends on basal law exponent + ! and/or whether flow is "hybridized" a la Goldberg 2011 + + OD_rt => NULL(), & !< A running total for calulating OD_av. + float_frac_rt => NULL(), & !< A running total for calculating float_frac. + OD_av => NULL(), & !< The time average open ocean depth, in m. + float_frac => NULL() !< Fraction of the time a cell is "exposed", i.e. the column + !! thickness is below a threshold. + !! [if float_frac = 1 ==> grounded; obv. counterintuitive; might fix] + integer :: OD_rt_counter = 0 !< A counter of the number of contributions to OD_rt. + + real :: velocity_update_time_step !< The time in s to update the ice shelf velocity through the + !! nonlinear elliptic equation, or 0 to update every timestep. + ! DNGoldberg thinks this should be done no more often than about once a day + ! (maybe longer) because it will depend on ocean values that are averaged over + ! this time interval, and solving for the equiliabrated flow will begin to lose + ! meaning if it is done too frequently. + real :: elapsed_velocity_time !< The elapsed time since the ice velocies were last udated, in s. + + real :: g_Earth !< The gravitational acceleration in m s-2. + real :: density_ice !< A typical density of ice, in kg m-3. + + logical :: GL_regularize !< whether to regularize the floatation condition + !! at the grounding line a la Goldberg Holland Schoof 2009 + integer :: n_sub_regularize + !< partition of cell over which to integrate for + !! interpolated grounding line the (rectangular) is + !! divided into nxn equally-sized rectangles, over which + !! basal contribution is integrated (iterative quadrature) + logical :: GL_couple !< whether to let the floatation condition be + !!determined by ocean column thickness means update_OD_ffrac + !! will be called (note: GL_regularize and GL_couple + !! should be exclusive) + + real :: CFL_factor !< A factor used to limit subcycled advective timestep in uncoupled runs + !! i.e. dt <= CFL_factor * min(dx / u) + + real :: A_glen_isothermal + real :: n_glen + real :: eps_glen_min + real :: C_basal_friction + real :: n_basal_friction + real :: density_ocean_avg !< this does not affect ocean circulation OR thermodynamics + !! it is to estimate the gravitational driving force at the + !! shelf front(until we think of a better way to do it- + !! but any difference will be negligible) + real :: thresh_float_col_depth ! the water column depth over which the shelf if considered to be floating + logical :: moving_shelf_front + logical :: calve_to_mask + real :: min_thickness_simple_calve ! min. ice shelf thickness criteria for calving + + + real :: cg_tolerance + real :: nonlinear_tolerance + integer :: cg_max_iterations + integer :: nonlin_solve_err_mode ! 1: exit vel solve based on nonlin residual + ! 2: exit based on "fixed point" metric (|u - u_last| / |u| < tol where | | is infty-norm + logical :: use_reproducing_sums !< use new reproducing sums of Bob & Alistair for global sums. + + ! ids for outputting intermediate thickness in advection subroutine (debugging) + !integer :: id_h_after_uflux = -1, id_h_after_vflux = -1, id_h_after_adv = -1 + + logical :: debug !< If true, write verbose checksums for debugging purposes + !! and use reproducible sums + logical :: module_is_initialized = .false. !< True if this module has been initialized. + + !>@{ + ! Diagnostic handles + integer :: id_u_shelf = -1, id_v_shelf = -1, id_t_shelf = -1, & + id_float_frac = -1, id_col_thick = -1, id_OD_av = -1, & + id_u_mask = -1, id_v_mask = -1, id_t_mask = -1 + !>@} + ! ids for outputting intermediate thickness in advection subroutine (debugging) + !integer :: id_h_after_uflux = -1, id_h_after_vflux = -1, id_h_after_adv = -1 + + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to control diagnostic output. + +end type ice_shelf_dyn_CS + +contains + +!> used for flux limiting in advective subroutines Van Leer limiter (source: Wikipedia) +function slope_limiter (num, denom) + real, intent(in) :: num + real, intent(in) :: denom + real :: slope_limiter + real :: r + + if (denom == 0) then + slope_limiter = 0 + elseif (num*denom <= 0) then + slope_limiter = 0 + else + r = num/denom + slope_limiter = (r+abs(r))/(1+abs(r)) + endif + +end function slope_limiter + +!> Calculate area of quadrilateral. +function quad_area (X, Y) + real, dimension(4), intent(in) :: X + real, dimension(4), intent(in) :: Y + real :: quad_area, p2, q2, a2, c2, b2, d2 + +! X and Y must be passed in the form + ! 3 - 4 + ! | | + ! 1 - 2 + + p2 = (X(4)-X(1))**2 + (Y(4)-Y(1))**2 ; q2 = (X(3)-X(2))**2 + (Y(3)-Y(2))**2 + a2 = (X(3)-X(4))**2 + (Y(3)-Y(4))**2 ; c2 = (X(1)-X(2))**2 + (Y(1)-Y(2))**2 + b2 = (X(2)-X(4))**2 + (Y(2)-Y(4))**2 ; d2 = (X(3)-X(1))**2 + (Y(3)-Y(1))**2 + quad_area = .25 * sqrt(4*P2*Q2-(B2+D2-A2-C2)**2) + +end function quad_area + +!> This subroutine is used to register any fields related to the ice shelf +!! dynamics that should be written to or read from the restart file. +subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) + type(ocean_grid_type), intent(inout) :: G !< The grid type describing the ice shelf grid. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(ice_shelf_dyn_CS), pointer :: CS !< A pointer to the ice shelf dynamics control structure + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + + logical :: shelf_mass_is_dynamic, override_shelf_movement, active_shelf_dynamics + character(len=40) :: mdl = "MOM_ice_shelf_dyn" ! This module's name. + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + if (associated(CS)) then + call MOM_error(FATAL, "MOM_ice_shelf_dyn.F90, register_ice_shelf_dyn_restarts: "// & + "called with an associated control structure.") + return + endif + allocate(CS) + + override_shelf_movement = .false. ; active_shelf_dynamics = .false. + call get_param(param_file, mdl, "DYNAMIC_SHELF_MASS", shelf_mass_is_dynamic, & + "If true, the ice sheet mass can evolve with time.", & + default=.false., do_not_log=.true.) + if (shelf_mass_is_dynamic) then + call get_param(param_file, mdl, "OVERRIDE_SHELF_MOVEMENT", override_shelf_movement, & + "If true, user provided code specifies the ice-shelf \n"//& + "movement instead of the dynamic ice model.", default=.false., do_not_log=.true.) + active_shelf_dynamics = .not.override_shelf_movement + endif + + if (active_shelf_dynamics) then + allocate( CS%u_shelf(IsdB:IedB,JsdB:JedB) ) ; CS%u_shelf(:,:) = 0.0 + allocate( CS%v_shelf(IsdB:IedB,JsdB:JedB) ) ; CS%v_shelf(:,:) = 0.0 + allocate( CS%t_shelf(isd:ied,jsd:jed) ) ; CS%t_shelf(:,:) = -10.0 + allocate( CS%ice_visc(isd:ied,jsd:jed) ) ; CS%ice_visc(:,:) = 0.0 + allocate( CS%taub_beta_eff(isd:ied,jsd:jed) ) ; CS%taub_beta_eff(:,:) = 0.0 + allocate( CS%OD_av(isd:ied,jsd:jed) ) ; CS%OD_av(:,:) = 0.0 + allocate( CS%float_frac(isd:ied,jsd:jed) ) ; CS%float_frac(:,:) = 0.0 + + ! additional restarts for ice shelf state + call register_restart_field(CS%u_shelf, "u_shelf", .false., restart_CS, & + "ice sheet/shelf u-velocity", "m s-1", hor_grid='Bu') + call register_restart_field(CS%v_shelf, "v_shelf", .false., restart_CS, & + "ice sheet/shelf v-velocity", "m s-1", hor_grid='Bu') + call register_restart_field(CS%t_shelf, "t_shelf", .true., restart_CS, & + "ice sheet/shelf vertically averaged temperature", "deg C") + call register_restart_field(CS%OD_av, "OD_av", .true., restart_CS, & + "Average open ocean depth in a cell","m") + call register_restart_field(CS%float_frac, "float_frac", .true., restart_CS, & + "fractional degree of grounding", "nondim") + call register_restart_field(CS%ice_visc, "viscosity", .true., restart_CS, & + "Glens law ice viscosity", "m (seems wrong)") + call register_restart_field(CS%taub_beta_eff, "tau_b_beta", .true., restart_CS, & + "Coefficient of basal traction", "m (seems wrong)") + endif + +end subroutine register_ice_shelf_dyn_restarts + +!> Initializes shelf model data, parameters and diagnostics +subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, diag, new_sim, solo_ice_sheet_in) + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(ocean_grid_type), pointer :: ocn_grid !< The calling ocean model's horizontal grid structure + type(time_type), intent(inout) :: Time !< The clock that that will indicate the model time + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe + !! the ice-shelf state + type(ice_shelf_dyn_CS), pointer :: CS !< A pointer to the ice shelf dynamics control structure + type(ocean_grid_type), intent(inout) :: G !< The grid type describing the ice shelf grid. + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate the diagnostic output. + logical, intent(in) :: new_sim !< If true this is a new simulation, otherwise + !! has been started from a restart file. + logical, optional, intent(in) :: solo_ice_sheet_in !< If present, this indicates whether + !! a solo ice-sheet driver. + + !This include declares and sets the variable "version". +#include "version_variable.h" + character(len=200) :: config + character(len=200) :: IC_file,filename,inputdir + character(len=40) :: var_name + character(len=40) :: mdl = "MOM_ice_shelf_dyn" ! This module's name. + logical :: shelf_mass_is_dynamic, override_shelf_movement, active_shelf_dynamics + logical :: debug + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, Isdq, Iedq, Jsdq, Jedq, iters + + if (.not.associated(CS)) then + call MOM_error(FATAL, "MOM_ice_shelf_dyn.F90, initialize_ice_shelf_dyn: "// & + "called with an associated control structure.") + return + endif + if (CS%module_is_initialized) then + call MOM_error(WARNING, "MOM_ice_shelf_dyn.F90, initialize_ice_shelf_dyn was "//& + "called with a control structure that has already been initialized.") + endif + CS%module_is_initialized = .true. + + CS%diag => diag ! ; CS%Time => Time + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "DEBUG", debug, default=.false.) + call get_param(param_file, mdl, "DEBUG_IS", CS%debug, & + "If true, write verbose debugging messages for the ice shelf.", & + default=debug) + call get_param(param_file, mdl, "DYNAMIC_SHELF_MASS", shelf_mass_is_dynamic, & + "If true, the ice sheet mass can evolve with time.", & + default=.false.) + override_shelf_movement = .false. ; active_shelf_dynamics = .false. + if (shelf_mass_is_dynamic) then + call get_param(param_file, mdl, "OVERRIDE_SHELF_MOVEMENT", override_shelf_movement, & + "If true, user provided code specifies the ice-shelf \n"//& + "movement instead of the dynamic ice model.", default=.false., do_not_log=.true.) + active_shelf_dynamics = .not.override_shelf_movement + + call get_param(param_file, mdl, "GROUNDING_LINE_INTERPOLATE", CS%GL_regularize, & + "If true, regularize the floatation condition at the \n"//& + "grounding line as in Goldberg Holland Schoof 2009.", default=.false.) + call get_param(param_file, mdl, "GROUNDING_LINE_INTERP_SUBGRID_N", CS%n_sub_regularize, & + "The number of sub-partitions of each cell over which to \n"//& + "integrate for the interpolated grounding line. Each cell \n"//& + "is divided into NxN equally-sized rectangles, over which the \n"//& + "basal contribution is integrated by iterative quadrature.", & + default=0) + call get_param(param_file, mdl, "GROUNDING_LINE_COUPLE", CS%GL_couple, & + "If true, let the floatation condition be determined by \n"//& + "ocean column thickness. This means that update_OD_ffrac \n"//& + "will be called. GL_REGULARIZE and GL_COUPLE are exclusive.", & + default=.false., do_not_log=CS%GL_regularize) + if (CS%GL_regularize) CS%GL_couple = .false. + if (CS%GL_regularize .and. (CS%n_sub_regularize == 0)) call MOM_error (FATAL, & + "GROUNDING_LINE_INTERP_SUBGRID_N must be a positive integer if GL regularization is used") + call get_param(param_file, mdl, "ICE_SHELF_CFL_FACTOR", CS%CFL_factor, & + "A factor used to limit timestep as CFL_FACTOR * min (\Delta x / u). \n"// & + "This is only used with an ice-only model.", default=0.25) + endif + call get_param(param_file, mdl, "RHO_0", CS%density_ocean_avg, & + "avg ocean density used in floatation cond", & + units="kg m-3", default=1035.) + if (active_shelf_dynamics) then + call get_param(param_file, mdl, "ICE_VELOCITY_TIMESTEP", CS%velocity_update_time_step, & + "seconds between ice velocity calcs", units="s", & + fail_if_missing=.true.) + call get_param(param_file, mdl, "G_EARTH", CS%g_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) + + call get_param(param_file, mdl, "A_GLEN_ISOTHERM", CS%A_glen_isothermal, & + "Ice viscosity parameter in Glen's Law", & + units="Pa -1/3 a", default=9.461e-18) + call get_param(param_file, mdl, "GLEN_EXPONENT", CS%n_glen, & + "nonlinearity exponent in Glen's Law", & + units="none", default=3.) + call get_param(param_file, mdl, "MIN_STRAIN_RATE_GLEN", CS%eps_glen_min, & + "min. strain rate to avoid infinite Glen's law viscosity", & + units="a-1", default=1.e-12) + call get_param(param_file, mdl, "BASAL_FRICTION_COEFF", CS%C_basal_friction, & + "ceofficient in sliding law \tau_b = C u^(n_basal_friction)", & + units="Pa (m-a)-(n_basal_friction)", fail_if_missing=.true.) + call get_param(param_file, mdl, "BASAL_FRICTION_EXP", CS%n_basal_friction, & + "exponent in sliding law \tau_b = C u^(m_slide)", & + units="none", fail_if_missing=.true.) + call get_param(param_file, mdl, "DENSITY_ICE", CS%density_ice, & + "A typical density of ice.", units="kg m-3", default=917.0) + call get_param(param_file, mdl, "CONJUGATE_GRADIENT_TOLERANCE", CS%cg_tolerance, & + "tolerance in CG solver, relative to initial residual", default=1.e-6) + call get_param(param_file, mdl, "ICE_NONLINEAR_TOLERANCE", CS%nonlinear_tolerance, & + "nonlin tolerance in iterative velocity solve",default=1.e-6) + call get_param(param_file, mdl, "CONJUGATE_GRADIENT_MAXIT", CS%cg_max_iterations, & + "max iteratiions in CG solver", default=2000) + call get_param(param_file, mdl, "THRESH_FLOAT_COL_DEPTH", CS%thresh_float_col_depth, & + "min ocean thickness to consider ice *floating*; \n"// & + "will only be important with use of tides", & + units="m", default=1.e-3) + call get_param(param_file, mdl, "NONLIN_SOLVE_ERR_MODE", CS%nonlin_solve_err_mode, & + "Choose whether nonlin error in vel solve is based on nonlinear \n"// & + "residual (1) or relative change since last iteration (2)", default=1) + call get_param(param_file, mdl, "SHELF_DYN_REPRODUCING_SUMS", CS%use_reproducing_sums, & + "If true, use the reproducing extended-fixed-point sums in \n"//& + "the ice shelf dynamics solvers.", default=.true.) + + call get_param(param_file, mdl, "SHELF_MOVING_FRONT", CS%moving_shelf_front, & + "Specify whether to advance shelf front (and calve).", & + default=.true.) + call get_param(param_file, mdl, "CALVE_TO_MASK", CS%calve_to_mask, & + "If true, do not allow an ice shelf where prohibited by a mask.", & + default=.false.) + endif + call get_param(param_file, mdl, "MIN_THICKNESS_SIMPLE_CALVE", & + CS%min_thickness_simple_calve, & + "Min thickness rule for the VERY simple calving law",& + units="m", default=0.0) + + ! Allocate memory in the ice shelf dynamics control structure that was not + ! previously allocated for registration for restarts. + ! OVS vertically integrated Temperature + + if (active_shelf_dynamics) then + ! DNG + allocate( CS%u_bdry_val(Isdq:Iedq,Jsdq:Jedq) ) ; CS%u_bdry_val(:,:) = 0.0 + allocate( CS%v_bdry_val(Isdq:Iedq,Jsdq:Jedq) ) ; CS%v_bdry_val(:,:) = 0.0 + allocate( CS%t_bdry_val(isd:ied,jsd:jed) ) ; CS%t_bdry_val(:,:) = -15.0 + allocate( CS%h_bdry_val(isd:ied,jsd:jed) ) ; CS%h_bdry_val(:,:) = 0.0 + allocate( CS%thickness_bdry_val(isd:ied,jsd:jed) ) ; CS%thickness_bdry_val(:,:) = 0.0 + allocate( CS%u_face_mask(Isdq:Iedq,jsd:jed) ) ; CS%u_face_mask(:,:) = 0.0 + allocate( CS%v_face_mask(isd:ied,Jsdq:Jedq) ) ; CS%v_face_mask(:,:) = 0.0 + allocate( CS%u_face_mask_bdry(Isdq:Iedq,jsd:jed) ) ; CS%u_face_mask_bdry(:,:) = -2.0 + allocate( CS%v_face_mask_bdry(isd:ied,Jsdq:Jedq) ) ; CS%v_face_mask_bdry(:,:) = -2.0 + allocate( CS%u_flux_bdry_val(Isdq:Iedq,jsd:jed) ) ; CS%u_flux_bdry_val(:,:) = 0.0 + allocate( CS%v_flux_bdry_val(isd:ied,Jsdq:Jedq) ) ; CS%v_flux_bdry_val(:,:) = 0.0 + allocate( CS%umask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%umask(:,:) = -1.0 + allocate( CS%vmask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%vmask(:,:) = -1.0 + allocate( CS%tmask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%tmask(:,:) = -1.0 + + CS%OD_rt_counter = 0 + allocate( CS%OD_rt(isd:ied,jsd:jed) ) ; CS%OD_rt(:,:) = 0.0 + allocate( CS%float_frac_rt(isd:ied,jsd:jed) ) ; CS%float_frac_rt(:,:) = 0.0 + + if (CS%calve_to_mask) then + allocate( CS%calve_mask(isd:ied,jsd:jed) ) ; CS%calve_mask(:,:) = 0.0 + endif + + CS%elapsed_velocity_time = 0.0 + + call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) + endif + + ! Take additional initialization steps, for example of dependent variables. + if (active_shelf_dynamics .and. .not.new_sim) then + ! this is unfortunately necessary; if grid is not symmetric the boundary values + ! of u and v are otherwise not set till the end of the first linear solve, and so + ! viscosity is not calculated correctly. + ! This has to occur after init_boundary_values or some of the arrays on the + ! right hand side have not been set up yet. + if (.not. G%symmetric) then + do j=G%jsd,G%jed ; do i=G%isd,G%ied + if (((i+G%idg_offset) == (G%domain%nihalo+1)).and.(CS%u_face_mask(i-1,j) == 3)) then + CS%u_shelf(i-1,j-1) = CS%u_bdry_val(i-1,j-1) + CS%u_shelf(i-1,j) = CS%u_bdry_val(i-1,j) + endif + if (((j+G%jdg_offset) == (G%domain%njhalo+1)).and.(CS%v_face_mask(i,j-1) == 3)) then + CS%u_shelf(i-1,j-1) = CS%u_bdry_val(i-1,j-1) + CS%u_shelf(i,j-1) = CS%u_bdry_val(i,j-1) + endif + enddo ; enddo + endif + + call pass_var(CS%OD_av,G%domain) + call pass_var(CS%float_frac,G%domain) + call pass_var(CS%ice_visc,G%domain) + call pass_var(CS%taub_beta_eff,G%domain) + call pass_vector(CS%u_shelf, CS%v_shelf, G%domain, TO_ALL, BGRID_NE) + endif + + if (active_shelf_dynamics) then + ! If we are calving to a mask, i.e. if a mask exists where a shelf cannot, read the mask from a file. + if (CS%calve_to_mask) then + call MOM_mesg(" MOM_ice_shelf.F90, initialize_ice_shelf: reading calving_mask") + + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") + inputdir = slasher(inputdir) + call get_param(param_file, mdl, "CALVING_MASK_FILE", IC_file, & + "The file with a mask for where calving might occur.", & + default="ice_shelf_h.nc") + call get_param(param_file, mdl, "CALVING_MASK_VARNAME", var_name, & + "The variable to use in masking calving.", & + default="area_shelf_h") + + filename = trim(inputdir)//trim(IC_file) + call log_param(param_file, mdl, "INPUTDIR/CALVING_MASK_FILE", filename) + if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & + " calving mask file: Unable to open "//trim(filename)) + + call MOM_read_data(filename,trim(var_name),CS%calve_mask,G%Domain) + do j=G%jsc,G%jec ; do i=G%isc,G%iec + if (CS%calve_mask(i,j) > 0.0) CS%calve_mask(i,j) = 1.0 + enddo ; enddo + call pass_var(CS%calve_mask,G%domain) + endif + +! call init_boundary_values(CS, G, time, ISS%hmask, CS%input_flux, CS%input_thickness, new_sim) + + if (new_sim) then + call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") + call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf) + call ice_shelf_solve_outer(CS, ISS, G, CS%u_shelf, CS%v_shelf, iters, Time) + + if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf,CS%u_shelf,CS%diag) + if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf,CS%v_shelf,CS%diag) + endif + + ! Register diagnostics. + CS%id_u_shelf = register_diag_field('ocean_model','u_shelf',CS%diag%axesCu1, Time, & + 'x-velocity of ice', 'm yr-1') + CS%id_v_shelf = register_diag_field('ocean_model','v_shelf',CS%diag%axesCv1, Time, & + 'y-velocity of ice', 'm yr-1') + CS%id_u_mask = register_diag_field('ocean_model','u_mask',CS%diag%axesCu1, Time, & + 'mask for u-nodes', 'none') + CS%id_v_mask = register_diag_field('ocean_model','v_mask',CS%diag%axesCv1, Time, & + 'mask for v-nodes', 'none') +! CS%id_surf_elev = register_diag_field('ocean_model','ice_surf',CS%diag%axesT1, Time, & +! 'ice surf elev', 'm') + CS%id_float_frac = register_diag_field('ocean_model','ice_float_frac',CS%diag%axesT1, Time, & + 'fraction of cell that is floating (sort of)', 'none') + CS%id_col_thick = register_diag_field('ocean_model','col_thick',CS%diag%axesT1, Time, & + 'ocean column thickness passed to ice model', 'm') + CS%id_OD_av = register_diag_field('ocean_model','OD_av',CS%diag%axesT1, Time, & + 'intermediate ocean column thickness passed to ice model', 'm') + !CS%id_h_after_uflux = register_diag_field('ocean_model','h_after_uflux',CS%diag%axesh1, Time, & + ! 'thickness after u flux ', 'none') + !CS%id_h_after_vflux = register_diag_field('ocean_model','h_after_vflux',CS%diag%axesh1, Time, & + ! 'thickness after v flux ', 'none') + !CS%id_h_after_adv = register_diag_field('ocean_model','h_after_adv',CS%diag%axesh1, Time, & + ! 'thickness after front adv ', 'none') + +!!! OVS vertically integrated temperature + CS%id_t_shelf = register_diag_field('ocean_model','t_shelf',CS%diag%axesT1, Time, & + 'T of ice', 'oC') + CS%id_t_mask = register_diag_field('ocean_model','tmask',CS%diag%axesT1, Time, & + 'mask for T-nodes', 'none') + endif + +end subroutine initialize_ice_shelf_dyn + + +subroutine initialize_diagnostic_fields(CS, ISS, G, Time) + type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe + !! the ice-shelf state + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + type(time_type), intent(in) :: Time !< The current model time + + integer :: i, j, iters, isd, ied, jsd, jed + real :: rhoi, rhow, OD + type(time_type) :: dummy_time + + rhoi = CS%density_ice + rhow = CS%density_ocean_avg + dummy_time = set_time (0,0) + isd=G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + + do j=jsd,jed + do i=isd,ied + OD = G%bathyT(i,j) - rhoi/rhow * ISS%h_shelf(i,j) + if (OD >= 0) then + ! ice thickness does not take up whole ocean column -> floating + CS%OD_av(i,j) = OD + CS%float_frac(i,j) = 0. + else + CS%OD_av(i,j) = 0. + CS%float_frac(i,j) = 1. + endif + enddo + enddo + + call ice_shelf_solve_outer(CS, ISS, G, CS%u_shelf, CS%v_shelf, iters, dummy_time) + +end subroutine initialize_diagnostic_fields + +!> This function returns the global maximum timestep that can be taken based on the current +!! ice velocities. Because it involves finding a global minimum, it can be suprisingly expensive. +function ice_time_step_CFL(CS, ISS, G) + type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure + type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe + !! the ice-shelf state + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real :: ice_time_step_CFL !< The maximum permitted timestep, in s, based on the ice velocities. + + real :: ratio, min_ratio + real :: local_u_max, local_v_max + integer :: i, j + + min_ratio = 1.0e16 ! This is just an arbitrary large value. + do j=G%jsc,G%jec ; do i=G%isc,G%iec ; if (ISS%hmask(i,j) == 1.0) then + local_u_max = max(abs(CS%u_shelf(i,j)), abs(CS%u_shelf(i+1,j+1)), & + abs(CS%u_shelf(i+1,j)), abs(CS%u_shelf(i,j+1))) + local_v_max = max(abs(CS%v_shelf(i,j)), abs(CS%v_shelf(i+1,j+1)), & + abs(CS%v_shelf(i+1,j)), abs(CS%v_shelf(i,j+1))) + + ratio = min(G%areaT(i,j) / (local_u_max+1.0e-12), G%areaT(i,j) / (local_v_max+1.0e-12)) + min_ratio = min(min_ratio, ratio) + endif ; enddo ; enddo ! i- and j- loops + + call min_across_PEs(min_ratio) + + ! solved velocities are in m/yr; we want time_step_int in seconds + ice_time_step_CFL = CS%CFL_factor * min_ratio * (365*86400) + +end function ice_time_step_CFL + +!> This subroutine updates the ice shelf velocities, mass, stresses and properties due to the +!! ice shelf dynamics. +subroutine update_ice_shelf(CS, ISS, G, time_step, Time, ocean_mass, coupled_grounding, must_update_vel) + type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure + type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe + !! the ice-shelf state + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real, intent(in) :: time_step !< time step in sec + type(time_type), intent(in) :: Time !< The current model time + real, dimension(SZDI_(G),SZDJ_(G)), & + optional, intent(in) :: ocean_mass !< If present this is the mass puer unit area + !! of the ocean in kg m-2. + logical, optional, intent(in) :: coupled_grounding !< If true, the grounding line is + !! determined by coupled ice-ocean dynamics + logical, optional, intent(in) :: must_update_vel !< Always update the ice velocities if true. + + integer :: iters + logical :: update_ice_vel, coupled_GL + + update_ice_vel = .false. + if (present(must_update_vel)) update_ice_vel = must_update_vel + + coupled_GL = .false. + if (present(ocean_mass) .and. present(coupled_grounding)) coupled_GL = coupled_grounding + + call ice_shelf_advect(CS, ISS, G, time_step, Time) + CS%elapsed_velocity_time = CS%elapsed_velocity_time + time_step + if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) update_ice_vel = .true. + + if (coupled_GL) then + call update_OD_ffrac(CS, G, ocean_mass, update_ice_vel) + elseif (update_ice_vel) then + call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf) + endif + + if (update_ice_vel) then + call ice_shelf_solve_outer(CS, ISS, G, CS%u_shelf, CS%v_shelf, iters, Time) + endif + + call ice_shelf_temp(CS, ISS, G, time_step, ISS%water_flux, Time) + + if (update_ice_vel) then + call enable_averaging(CS%elapsed_velocity_time, Time, CS%diag) + if (CS%id_col_thick > 0) call post_data(CS%id_col_thick, CS%OD_av, CS%diag) + if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf,CS%u_shelf,CS%diag) + if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf,CS%v_shelf,CS%diag) + if (CS%id_t_shelf > 0) call post_data(CS%id_t_shelf,CS%t_shelf,CS%diag) + if (CS%id_float_frac > 0) call post_data(CS%id_float_frac,CS%float_frac,CS%diag) + if (CS%id_OD_av >0) call post_data(CS%id_OD_av,CS%OD_av,CS%diag) + + if (CS%id_u_mask > 0) call post_data(CS%id_u_mask,CS%umask,CS%diag) + if (CS%id_v_mask > 0) call post_data(CS%id_v_mask,CS%vmask,CS%diag) + if (CS%id_t_mask > 0) call post_data(CS%id_t_mask,CS%tmask,CS%diag) + + call disable_averaging(CS%diag) + + CS%elapsed_velocity_time = 0.0 + endif + +end subroutine update_ice_shelf + +!> This subroutine takes the velocity (on the Bgrid) and timesteps h_t = - div (uh) once. +!! Additionally, it will update the volume of ice in partially-filled cells, and update +!! hmask accordingly +subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) + type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure + type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe + !! the ice-shelf state + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real, intent(in) :: time_step !< time step in sec + type(time_type), intent(in) :: Time !< The current model time + +! time_step: time step in sec + +! 3/8/11 DNG +! Arguments: +! CS - A structure containing the ice shelf state - including current velocities +! h0 - an array containing the thickness at the beginning of the call +! h_after_uflux - an array containing the thickness after advection in u-direction +! h_after_vflux - similar +! +! This subroutine takes the velocity (on the Bgrid) and timesteps h_t = - div (uh) once. +! ADDITIONALLY, it will update the volume of ice in partially-filled cells, and update +! hmask accordingly +! +! The flux overflows are included here. That is because they will be used to advect 3D scalars +! into partial cells + + ! + ! flux_enter: this is to capture flow into partially covered cells; it gives the mass flux into a given + ! cell across its boundaries. + ! ###Perhaps flux_enter should be changed into u-face and v-face + ! ###fluxes, which can then be used in halo updates, etc. + ! + ! from left neighbor: flux_enter(:,:,1) + ! from right neighbor: flux_enter(:,:,2) + ! from bottom neighbor: flux_enter(:,:,3) + ! from top neighbor: flux_enter(:,:,4) + ! + ! THESE ARE NOT CONSISTENT ==> FIND OUT WHAT YOU IMPLEMENTED + + ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary + ! + ! o--- (4) ---o + ! | | + ! (1) (2) + ! | | + ! o--- (3) ---o + ! + + real, dimension(SZDI_(G),SZDJ_(G)) :: h_after_uflux, h_after_vflux + real, dimension(SZDI_(G),SZDJ_(G),4) :: flux_enter + integer :: isd, ied, jsd, jed, i, j, isc, iec, jsc, jec + real :: rho, spy, thick_bd + + rho = CS%density_ice + spy = 365 * 86400 ! seconds per year; is there a global constant for this? No - it is dependent upon a calendar. + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec + flux_enter(:,:,:) = 0.0 + + h_after_uflux(:,:) = 0.0 + h_after_vflux(:,:) = 0.0 + ! call MOM_mesg("MOM_ice_shelf.F90: ice_shelf_advect called") + + do j=jsd,jed + do i=isd,ied + thick_bd = CS%thickness_bdry_val(i,j) + if (thick_bd /= 0.0) then + ISS%h_shelf(i,j) = CS%thickness_bdry_val(i,j) + endif + enddo + enddo + + call ice_shelf_advect_thickness_x(CS, G, time_step/spy, ISS%hmask, ISS%h_shelf, h_after_uflux, flux_enter) + +! call enable_averaging(time_step,Time,CS%diag) + ! call pass_var(h_after_uflux, G%domain) +! if (CS%id_h_after_uflux > 0) call post_data(CS%id_h_after_uflux, h_after_uflux, CS%diag) +! call disable_averaging(CS%diag) + + call ice_shelf_advect_thickness_y(CS, G, time_step/spy, ISS%hmask, h_after_uflux, h_after_vflux, flux_enter) + +! call enable_averaging(time_step,Time,CS%diag) +! call pass_var(h_after_vflux, G%domain) +! if (CS%id_h_after_vflux > 0) call post_data(CS%id_h_after_vflux, h_after_vflux, CS%diag) +! call disable_averaging(CS%diag) + + do j=jsd,jed + do i=isd,ied + if (ISS%hmask(i,j) == 1) ISS%h_shelf(i,j) = h_after_vflux(i,j) + enddo + enddo + + if (CS%moving_shelf_front) then + call shelf_advance_front(CS, ISS, G, flux_enter) + if (CS%min_thickness_simple_calve > 0.0) then + call ice_shelf_min_thickness_calve(G, ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, & + CS%min_thickness_simple_calve) + endif + if (CS%calve_to_mask) then + call calve_to_mask(G, ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, CS%calve_mask) + endif + endif + + !call enable_averaging(time_step,Time,CS%diag) + !if (CS%id_h_after_adv > 0) call post_data(CS%id_h_after_adv, ISS%h_shelf, CS%diag) + !call disable_averaging(CS%diag) + + !call change_thickness_using_melt(ISS, G, time_step, fluxes, CS%density_ice) + + call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) + +end subroutine ice_shelf_advect + +subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) + type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe + !! the ice-shelf state + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(inout) :: u, v + integer, intent(out) :: iters + type(time_type), intent(in) :: Time !< The current model time + + real, dimension(SZDIB_(G),SZDJB_(G)) :: TAUDX, TAUDY, u_prev_iterate, v_prev_iterate, & + u_bdry_cont, v_bdry_cont, Au, Av, err_u, err_v, & + u_last, v_last, H_node + real, dimension(SZDI_(G),SZDJ_(G)) :: float_cond + integer :: conv_flag, i, j, k,l, iter + integer :: isdq, iedq, jsdq, jedq, isd, ied, jsd, jed, isumstart, jsumstart, nodefloat, nsub + real :: err_max, err_tempu, err_tempv, err_init, area, max_vel, tempu, tempv, rhoi, rhow + real, pointer, dimension(:,:,:,:) :: Phi => NULL() + real, pointer, dimension(:,:,:,:,:,:) :: Phisub => NULL() + real, dimension(8,4) :: Phi_temp + real, dimension(2,2) :: X,Y + character(2) :: iternum + character(2) :: numproc + + ! for GL interpolation - need to make this a readable parameter + nsub = CS%n_sub_regularize + + isdq = G%isdB ; iedq = G%iedB ; jsdq = G%jsdB ; jedq = G%jedB + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + rhoi = CS%density_ice + rhow = CS%density_ocean_avg + + TAUDX(:,:) = 0.0 ; TAUDY(:,:) = 0.0 + u_bdry_cont(:,:) = 0.0 ; v_bdry_cont(:,:) = 0.0 + Au(:,:) = 0.0 ; Av(:,:) = 0.0 + + ! need to make these conditional on GL interpolation + float_cond(:,:) = 0.0 ; H_node(:,:)=0 + allocate(Phisub (nsub,nsub,2,2,2,2)) ; Phisub = 0.0 + + isumstart = G%isc + ! Include the edge if tile is at the western bdry; Should add a test to avoid this if reentrant. + if (G%isc+G%idg_offset==G%isg) isumstart = G%iscB + + jsumstart = G%jsc + ! Include the edge if tile is at the southern bdry; Should add a test to avoid this if reentrant. + if (G%jsc+G%jdg_offset==G%jsg) jsumstart = G%jscB + + call calc_shelf_driving_stress(CS, ISS, G, TAUDX, TAUDY, CS%OD_av) + + ! this is to determine which cells contain the grounding line, + ! the criterion being that the cell is ice-covered, with some nodes + ! floating and some grounded + ! floatation condition is estimated by assuming topography is cellwise constant + ! and H is bilinear in a cell; floating where rho_i/rho_w * H_node + D is nonpositive + + ! need to make this conditional on GL interp + + if (CS%GL_regularize) then + + call interpolate_H_to_B(G, ISS%h_shelf, ISS%hmask, H_node) + + do j=G%jsc,G%jec + do i=G%isc,G%iec + nodefloat = 0 + do k=0,1 + do l=0,1 + if ((ISS%hmask(i,j) == 1) .and. & + (rhoi/rhow * H_node(i-1+k,j-1+l) - G%bathyT(i,j) <= 0)) then + nodefloat = nodefloat + 1 + endif + enddo + enddo + if ((nodefloat > 0) .and. (nodefloat < 4)) then + float_cond(i,j) = 1.0 + CS%float_frac(i,j) = 1.0 + endif + enddo + enddo + + call pass_var(float_cond, G%Domain) + + call bilinear_shape_functions_subgrid(Phisub, nsub) + + endif + + ! make above conditional + + u_prev_iterate(:,:) = u(:,:) + v_prev_iterate(:,:) = v(:,:) + + ! must prepare phi + allocate(Phi(isd:ied,jsd:jed,1:8,1:4)) ; Phi(:,:,:,:) = 0.0 + + do j=jsd,jed ; do i=isd,ied + if (((i > isd) .and. (j > jsd))) then + X(:,:) = G%geoLonBu(i-1:i,j-1:j)*1000 + Y(:,:) = G%geoLatBu(i-1:i,j-1:j)*1000 + else + X(2,:) = G%geoLonBu(i,j)*1000 + X(1,:) = G%geoLonBu(i,j)*1000-G%dxT(i,j) + Y(:,2) = G%geoLatBu(i,j)*1000 + Y(:,1) = G%geoLatBu(i,j)*1000-G%dyT(i,j) + endif + + call bilinear_shape_functions(X, Y, Phi_temp, area) + Phi(i,j,:,:) = Phi_temp + enddo ; enddo + + call calc_shelf_visc(CS, ISS, G, u, v) + + call pass_var(CS%ice_visc, G%domain) + call pass_var(CS%taub_beta_eff, G%domain) + + ! makes sure basal stress is only applied when it is supposed to be + + do j=G%jsd,G%jed ; do i=G%isd,G%ied + CS%taub_beta_eff(i,j) = CS%taub_beta_eff(i,j) * CS%float_frac(i,j) + enddo ; enddo + + call apply_boundary_values(CS, ISS, G, time, Phisub, H_node, CS%ice_visc, & + CS%taub_beta_eff, float_cond, & + rhoi/rhow, u_bdry_cont, v_bdry_cont) + + Au(:,:) = 0.0 ; Av(:,:) = 0.0 + + call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & + CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, G%areaT, & + G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) + + err_init = 0 ; err_tempu = 0; err_tempv = 0 + do j=jsumstart,G%jecB + do i=isumstart,G%iecB + if (CS%umask(i,j) == 1) then + err_tempu = ABS (Au(i,j) + u_bdry_cont(i,j) - TAUDX(i,j)) + endif + if (CS%vmask(i,j) == 1) then + err_tempv = MAX(ABS (Av(i,j) + v_bdry_cont(i,j) - TAUDY(i,j)), err_tempu) + endif + if (err_tempv >= err_init) then + err_init = err_tempv + endif + enddo + enddo + + call max_across_PEs(err_init) + + if (is_root_pe()) print *,"INITIAL nonlinear residual: ",err_init + + u_last(:,:) = u(:,:) ; v_last(:,:) = v(:,:) + + !! begin loop + + do iter=1,100 + + call ice_shelf_solve_inner(CS, ISS, G, u, v, TAUDX, TAUDY, H_node, float_cond, & + ISS%hmask, conv_flag, iters, time, Phi, Phisub) + + if (CS%DEBUG) then + call qchksum(u, "u shelf", G%HI, haloshift=2) + call qchksum(v, "v shelf", G%HI, haloshift=2) + endif + + if (is_root_pe()) print *,"linear solve done",iters," iterations" + + call calc_shelf_visc(CS, ISS, G, u, v) + call pass_var(CS%ice_visc, G%domain) + call pass_var(CS%taub_beta_eff, G%domain) + + ! makes sure basal stress is only applied when it is supposed to be + + do j=G%jsd,G%jed ; do i=G%isd,G%ied + CS%taub_beta_eff(i,j) = CS%taub_beta_eff(i,j) * CS%float_frac(i,j) + enddo ; enddo + + u_bdry_cont(:,:) = 0 ; v_bdry_cont(:,:) = 0 + + call apply_boundary_values(CS, ISS, G, time, Phisub, H_node, CS%ice_visc, & + CS%taub_beta_eff, float_cond, & + rhoi/rhow, u_bdry_cont, v_bdry_cont) + + Au(:,:) = 0 ; Av(:,:) = 0 + + call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & + CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, G%areaT, & + G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) + + err_max = 0 + + if (CS%nonlin_solve_err_mode == 1) then + + do j=jsumstart,G%jecB + do i=isumstart,G%iecB + if (CS%umask(i,j) == 1) then + err_tempu = ABS (Au(i,j) + u_bdry_cont(i,j) - TAUDX(i,j)) + endif + if (CS%vmask(i,j) == 1) then + err_tempv = MAX(ABS (Av(i,j) + v_bdry_cont(i,j) - TAUDY(i,j)), err_tempu) + endif + if (err_tempv >= err_max) then + err_max = err_tempv + endif + enddo + enddo + + call max_across_PEs(err_max) + + elseif (CS%nonlin_solve_err_mode == 2) then + + max_vel = 0 ; tempu = 0 ; tempv = 0 + + do j=jsumstart,G%jecB + do i=isumstart,G%iecB + if (CS%umask(i,j) == 1) then + err_tempu = ABS (u_last(i,j)-u(i,j)) + tempu = u(i,j) + endif + if (CS%vmask(i,j) == 1) then + err_tempv = MAX(ABS (v_last(i,j)- v(i,j)), err_tempu) + tempv = SQRT(v(i,j)**2+tempu**2) + endif + if (err_tempv >= err_max) then + err_max = err_tempv + endif + if (tempv >= max_vel) then + max_vel = tempv + endif + enddo + enddo + + u_last(:,:) = u(:,:) + v_last(:,:) = v(:,:) + + call max_across_PEs(max_vel) + call max_across_PEs(err_max) + err_init = max_vel + + endif + + if (is_root_pe()) print *,"nonlinear residual: ",err_max/err_init + + if (err_max <= CS%nonlinear_tolerance * err_init) then + if (is_root_pe()) & + print *,"exiting nonlinear solve after ",iter," iterations" + exit + endif + + enddo + + deallocate(Phi) + deallocate(Phisub) + +end subroutine ice_shelf_solve_outer + +subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_cond, & + hmask, conv_flag, iters, time, Phi, Phisub) + type(ice_shelf_dyn_CS),intent(in) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe + !! the ice-shelf state + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u, v + real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: taudx, taudy, H_node + real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: float_cond + real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: hmask + integer, intent(out) :: conv_flag, iters + type(time_type), intent(in) :: Time !< The current model time + real, dimension(SZDI_(G),SZDJ_(G),8,4), intent(in) :: Phi + real, dimension(:,:,:,:,:,:), intent(in) :: Phisub + +! one linear solve (nonlinear iteration) of the solution for velocity + +! in this subroutine: +! boundary contributions are added to taud to get the RHS +! diagonal of matrix is found (for Jacobi precondition) +! CG iteration is carried out for max. iterations or until convergence + +! assumed - u, v, taud, visc, beta_eff are valid on the halo + + real, dimension(SZDIB_(G),SZDJB_(G)) :: & + Ru, Rv, Zu, Zv, DIAGu, DIAGv, RHSu, RHSv, & + ubd, vbd, Au, Av, Du, Dv, & + Zu_old, Zv_old, Ru_old, Rv_old, & + sum_vec, sum_vec_2 + integer :: iter, i, j, isd, ied, jsd, jed, & + isc, iec, jsc, jec, is, js, ie, je, isumstart, jsumstart, & + isdq, iedq, jsdq, jedq, iscq, iecq, jscq, jecq, nx_halo, ny_halo + real :: tol, beta_k, alpha_k, area, dot_p1, dot_p2, resid0, cg_halo, dot_p1a, dot_p2a + character(2) :: gridsize + + real, dimension(8,4) :: Phi_temp + real, dimension(2,2) :: X,Y + + isdq = G%isdB ; iedq = G%iedB ; jsdq = G%jsdB ; jedq = G%jedB + iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB + ny_halo = G%domain%njhalo ; nx_halo = G%domain%nihalo + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec + + Zu(:,:) = 0 ; Zv(:,:) = 0 ; DIAGu(:,:) = 0 ; DIAGv(:,:) = 0 + Ru(:,:) = 0 ; Rv(:,:) = 0 ; Au(:,:) = 0 ; Av(:,:) = 0 + Du(:,:) = 0 ; Dv(:,:) = 0 ; ubd(:,:) = 0 ; vbd(:,:) = 0 + dot_p1 = 0 ; dot_p2 = 0 + + isumstart = G%isc + ! Include the edge if tile is at the western bdry; Should add a test to avoid this if reentrant. + if (G%isc+G%idg_offset==G%isg) isumstart = G%iscB + + jsumstart = G%jsc + ! Include the edge if tile is at the southern bdry; Should add a test to avoid this if reentrant. + if (G%jsc+G%jdg_offset==G%jsg) jsumstart = G%jscB + + call apply_boundary_values(CS, ISS, G, time, Phisub, H_node, CS%ice_visc, & + CS%taub_beta_eff, float_cond, & + CS%density_ice/CS%density_ocean_avg, ubd, vbd) + + RHSu(:,:) = taudx(:,:) - ubd(:,:) + RHSv(:,:) = taudy(:,:) - vbd(:,:) + + + call pass_vector(RHSu, RHSv, G%domain, TO_ALL, BGRID_NE) + + call matrix_diagonal(CS, G, float_cond, H_node, CS%ice_visc, & + CS%taub_beta_eff, hmask, & + CS%density_ice/CS%density_ocean_avg, Phisub, DIAGu, DIAGv) +! DIAGu(:,:) = 1 ; DIAGv(:,:) = 1 + + call pass_vector(DIAGu, DIAGv, G%domain, TO_ALL, BGRID_NE) + + call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, hmask, & + H_node, CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, & + G%areaT, G, isc-1, iec+1, jsc-1, jec+1, CS%density_ice/CS%density_ocean_avg) + + call pass_vector(Au, Av, G%domain, TO_ALL, BGRID_NE) + + Ru(:,:) = RHSu(:,:) - Au(:,:) ; Rv(:,:) = RHSv(:,:) - Av(:,:) + + if (.not. CS%use_reproducing_sums) then + + do j=jsumstart,jecq + do i=isumstart,iecq + if (CS%umask(i,j) == 1) dot_p1 = dot_p1 + Ru(i,j)**2 + if (CS%vmask(i,j) == 1) dot_p1 = dot_p1 + Rv(i,j)**2 + enddo + enddo + + call sum_across_PEs(dot_p1) + + else + + sum_vec(:,:) = 0.0 + + do j=jsumstart,jecq + do i=isumstart,iecq + if (CS%umask(i,j) == 1) sum_vec(i,j) = Ru(i,j)**2 + if (CS%vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + Rv(i,j)**2 + enddo + enddo + + dot_p1 = reproducing_sum( sum_vec, isumstart+(1-G%IsdB), Iecq+(1-G%IsdB), & + jsumstart+(1-G%JsdB), jecq+(1-G%JsdB) ) + + endif + + resid0 = sqrt (dot_p1) + + do j=jsdq,jedq + do i=isdq,iedq + if (CS%umask(i,j) == 1) Zu(i,j) = Ru(i,j) / DIAGu(i,j) + if (CS%vmask(i,j) == 1) Zv(i,j) = Rv(i,j) / DIAGv(i,j) + enddo + enddo + + Du(:,:) = Zu(:,:) ; Dv(:,:) = Zv(:,:) + + cg_halo = 3 + conv_flag = 0 + + !!!!!!!!!!!!!!!!!! + !! !! + !! MAIN CG LOOP !! + !! !! + !!!!!!!!!!!!!!!!!! + + + + ! initially, c-grid data is valid up to 3 halo nodes out + + do iter = 1,CS%cg_max_iterations + + ! assume asymmetry + ! thus we can never assume that any arrays are legit more than 3 vertices past + ! the computational domain - this is their state in the initial iteration + + + is = isc - cg_halo ; ie = iecq + cg_halo + js = jscq - cg_halo ; je = jecq + cg_halo + + Au(:,:) = 0 ; Av(:,:) = 0 + + call CG_action(Au, Av, Du, Dv, Phi, Phisub, CS%umask, CS%vmask, hmask, & + H_node, CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, & + G%areaT, G, is, ie, js, je, CS%density_ice/CS%density_ocean_avg) + + ! Au, Av valid region moves in by 1 + + if ( .not. CS%use_reproducing_sums) then + + + ! alpha_k = (Z \dot R) / (D \dot AD} + dot_p1 = 0 ; dot_p2 = 0 + do j=jsumstart,jecq + do i=isumstart,iecq + if (CS%umask(i,j) == 1) then + dot_p1 = dot_p1 + Zu(i,j)*Ru(i,j) + dot_p2 = dot_p2 + Du(i,j)*Au(i,j) + endif + if (CS%vmask(i,j) == 1) then + dot_p1 = dot_p1 + Zv(i,j)*Rv(i,j) + dot_p2 = dot_p2 + Dv(i,j)*Av(i,j) + endif + enddo + enddo + call sum_across_PEs(dot_p1) ; call sum_across_PEs(dot_p2) + else + + sum_vec(:,:) = 0.0 ; sum_vec_2(:,:) = 0.0 + + do j=jscq,jecq + do i=iscq,iecq + if (CS%umask(i,j) == 1) sum_vec(i,j) = Zu(i,j) * Ru(i,j) + if (CS%vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + & + Zv(i,j) * Rv(i,j) + + if (CS%umask(i,j) == 1) sum_vec_2(i,j) = Du(i,j) * Au(i,j) + if (CS%vmask(i,j) == 1) sum_vec_2(i,j) = sum_vec_2(i,j) + & + Dv(i,j) * Av(i,j) + enddo + enddo + + dot_p1 = reproducing_sum( sum_vec, isumstart+(1-G%IsdB), Iecq+(1-G%IsdB), & + jsumstart+(1-G%JsdB), jecq+(1-G%JsdB) ) + + dot_p2 = reproducing_sum( sum_vec_2, isumstart+(1-G%IsdB), Iecq+(1-G%IsdB), & + jsumstart+(1-G%JsdB), jecq+(1-G%JsdB) ) + endif + + alpha_k = dot_p1/dot_p2 + + !### These should probably use explicit index notation so that they are + !### not applied outside of the valid range. - RWH + + ! u(:,:) = u(:,:) + alpha_k * Du(:,:) + ! v(:,:) = v(:,:) + alpha_k * Dv(:,:) + + do j=jsd,jed + do i=isd,ied + if (CS%umask(i,j) == 1) u(i,j) = u(i,j) + alpha_k * Du(i,j) + if (CS%vmask(i,j) == 1) v(i,j) = v(i,j) + alpha_k * Dv(i,j) + enddo + enddo + + do j=jsd,jed + do i=isd,ied + if (CS%umask(i,j) == 1) then + Ru_old(i,j) = Ru(i,j) ; Zu_old(i,j) = Zu(i,j) + endif + if (CS%vmask(i,j) == 1) then + Rv_old(i,j) = Rv(i,j) ; Zv_old(i,j) = Zv(i,j) + endif + enddo + enddo + +! Ru(:,:) = Ru(:,:) - alpha_k * Au(:,:) +! Rv(:,:) = Rv(:,:) - alpha_k * Av(:,:) + + do j=jsd,jed + do i=isd,ied + if (CS%umask(i,j) == 1) Ru(i,j) = Ru(i,j) - alpha_k * Au(i,j) + if (CS%vmask(i,j) == 1) Rv(i,j) = Rv(i,j) - alpha_k * Av(i,j) + enddo + enddo + + + do j=jsdq,jedq + do i=isdq,iedq + if (CS%umask(i,j) == 1) then + Zu(i,j) = Ru(i,j) / DIAGu(i,j) + endif + if (CS%vmask(i,j) == 1) then + Zv(i,j) = Rv(i,j) / DIAGv(i,j) + endif + enddo + enddo + + ! R,u,v,Z valid region moves in by 1 + + if (.not. CS%use_reproducing_sums) then + + ! beta_k = (Z \dot R) / (Zold \dot Rold} + dot_p1 = 0 ; dot_p2 = 0 + do j=jsumstart,jecq + do i=isumstart,iecq + if (CS%umask(i,j) == 1) then + dot_p1 = dot_p1 + Zu(i,j)*Ru(i,j) + dot_p2 = dot_p2 + Zu_old(i,j)*Ru_old(i,j) + endif + if (CS%vmask(i,j) == 1) then + dot_p1 = dot_p1 + Zv(i,j)*Rv(i,j) + dot_p2 = dot_p2 + Zv_old(i,j)*Rv_old(i,j) + endif + enddo + enddo + call sum_across_PEs(dot_p1) ; call sum_across_PEs(dot_p2) + + + else + + sum_vec(:,:) = 0.0 ; sum_vec_2(:,:) = 0.0 + + do j=jsumstart,jecq + do i=isumstart,iecq + if (CS%umask(i,j) == 1) sum_vec(i,j) = Zu(i,j) * Ru(i,j) + if (CS%vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + & + Zv(i,j) * Rv(i,j) + + if (CS%umask(i,j) == 1) sum_vec_2(i,j) = Zu_old(i,j) * Ru_old(i,j) + if (CS%vmask(i,j) == 1) sum_vec_2(i,j) = sum_vec_2(i,j) + & + Zv_old(i,j) * Rv_old(i,j) + enddo + enddo + + + dot_p1 = reproducing_sum(sum_vec, isumstart+(1-G%IsdB), Iecq+(1-G%IsdB), & + jsumstart+(1-G%JsdB), Jecq+(1-G%JsdB) ) + + dot_p2 = reproducing_sum(sum_vec_2, isumstart+(1-G%IsdB), Iecq+(1-G%IsdB), & + jsumstart+(1-G%JsdB), Jecq+(1-G%JsdB) ) + + endif + + beta_k = dot_p1/dot_p2 + + +! Du(:,:) = Zu(:,:) + beta_k * Du(:,:) +! Dv(:,:) = Zv(:,:) + beta_k * Dv(:,:) + + do j=jsd,jed + do i=isd,ied + if (CS%umask(i,j) == 1) Du(i,j) = Zu(i,j) + beta_k * Du(i,j) + if (CS%vmask(i,j) == 1) Dv(i,j) = Zv(i,j) + beta_k * Dv(i,j) + enddo + enddo + + ! D valid region moves in by 1 + + dot_p1 = 0 + + if (.not. CS%use_reproducing_sums) then + + do j=jsumstart,jecq + do i=isumstart,iecq + if (CS%umask(i,j) == 1) then + dot_p1 = dot_p1 + Ru(i,j)**2 + endif + if (CS%vmask(i,j) == 1) then + dot_p1 = dot_p1 + Rv(i,j)**2 + endif + enddo + enddo + call sum_across_PEs(dot_p1) + + else + + sum_vec(:,:) = 0.0 + + do j=jsumstart,jecq + do i=isumstart,iecq + if (CS%umask(i,j) == 1) sum_vec(i,j) = Ru(i,j)**2 + if (CS%vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + Rv(i,j)**2 + enddo + enddo + + dot_p1 = reproducing_sum( sum_vec, isumstart+(1-G%IsdB), Iecq+(1-G%IsdB), & + jsumstart+(1-G%JsdB), jecq+(1-G%JsdB) ) + endif + + dot_p1 = sqrt (dot_p1) + + if (dot_p1 <= CS%cg_tolerance * resid0) then + iters = iter + conv_flag = 1 + exit + endif + + cg_halo = cg_halo - 1 + + if (cg_halo == 0) then + ! pass vectors + call pass_vector(Du, Dv, G%domain, TO_ALL, BGRID_NE) + call pass_vector(u, v, G%domain, TO_ALL, BGRID_NE) + call pass_vector(Ru, Rv, G%domain, TO_ALL, BGRID_NE) + cg_halo = 3 + endif + + enddo ! end of CG loop + + do j=jsdq,jedq + do i=isdq,iedq + if (CS%umask(i,j) == 3) then + u(i,j) = CS%u_bdry_val(i,j) + elseif (CS%umask(i,j) == 0) then + u(i,j) = 0 + endif + + if (CS%vmask(i,j) == 3) then + v(i,j) = CS%v_bdry_val(i,j) + elseif (CS%vmask(i,j) == 0) then + v(i,j) = 0 + endif + enddo + enddo + + call pass_vector(u,v, G%domain, TO_ALL, BGRID_NE) + + if (conv_flag == 0) then + iters = CS%cg_max_iterations + endif + +end subroutine ice_shelf_solve_inner + +subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_uflux, flux_enter) + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, intent(in) :: time_step !< The time step for this update, in s. + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask + real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h0 + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_uflux + real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter + + ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells + + ! if there is an input bdry condition, the thickness there will be set in initialization + + ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary + ! + ! from left neighbor: flux_enter(:,:,1) + ! from right neighbor: flux_enter(:,:,2) + ! from bottom neighbor: flux_enter(:,:,3) + ! from top neighbor: flux_enter(:,:,4) + ! + ! o--- (4) ---o + ! | | + ! (1) (2) + ! | | + ! o--- (3) ---o + ! + + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied + integer :: i_off, j_off + logical :: at_east_bdry, at_west_bdry, one_off_west_bdry, one_off_east_bdry + real, dimension(-2:2) :: stencil + real :: u_face, & ! positive if out + flux_diff_cell, phi, dxh, dyh, dxdyh + character (len=1) :: debug_str + + is = G%isc-2 ; ie = G%iec+2 ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + i_off = G%idg_offset ; j_off = G%jdg_offset + + do j=jsd+1,jed-1 + if (((j+j_off) <= G%domain%njglobal+G%domain%njhalo) .AND. & + ((j+j_off) >= G%domain%njhalo+1)) then ! based on mehmet's code - only if btw north & south boundaries + + stencil(:) = -1 +! if (i+i_off == G%domain%nihalo+G%domain%nihalo) + do i=is,ie + + if (((i+i_off) <= G%domain%niglobal+G%domain%nihalo) .AND. & + ((i+i_off) >= G%domain%nihalo+1)) then + + if (i+i_off == G%domain%nihalo+1) then + at_west_bdry=.true. + else + at_west_bdry=.false. + endif + + if (i+i_off == G%domain%niglobal+G%domain%nihalo) then + at_east_bdry=.true. + else + at_east_bdry=.false. + endif + + if (hmask(i,j) == 1) then + + dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) + + h_after_uflux(i,j) = h0(i,j) + + stencil(:) = h0(i-2:i+2,j) ! fine as long has nx_halo >= 2 + + flux_diff_cell = 0 + + ! 1ST DO LEFT FACE + + if (CS%u_face_mask(i-1,j) == 4.) then + + flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_flux_bdry_val(i-1,j) / dxdyh + + else + + ! get u-velocity at center of left face + u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) + + if (u_face > 0) then !flux is into cell - we need info from h(i-2), h(i-1) if available + + ! i may not cover all the cases.. but i cover the realistic ones + + if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then ! at western bdry but there is a + ! thickness bdry condition, and the stencil contains it + stencil (-1) = CS%thickness_bdry_val(i-1,j) + flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(-1) / dxdyh + + elseif (hmask(i-1,j) * hmask(i-2,j) == 1) then ! h(i-2) and h(i-1) are valid + phi = slope_limiter (stencil(-1)-stencil(-2), stencil(0)-stencil(-1)) + flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh* time_step / dxdyh * & + (stencil(-1) - phi * (stencil(-1)-stencil(0))/2) + + else ! h(i-1) is valid + ! (o.w. flux would most likely be out of cell) + ! but h(i-2) is not + + flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step / dxdyh * stencil(-1) + + endif + + elseif (u_face < 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available + if (hmask(i-1,j) * hmask(i+1,j) == 1) then ! h(i-1) and h(i+1) are both valid + phi = slope_limiter (stencil(0)-stencil(1), stencil(-1)-stencil(0)) + flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * & + (stencil(0) - phi * (stencil(0)-stencil(-1))/2) + + else + flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * stencil(0) + + if ((hmask(i-1,j) == 0) .OR. (hmask(i-1,j) == 2)) then + flux_enter(i-1,j,2) = ABS(u_face) * dyh * time_step * stencil(0) + endif + endif + endif + endif + + ! NEXT DO RIGHT FACE + + ! get u-velocity at center of right face + + if (CS%u_face_mask(i+1,j) == 4.) then + + flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_flux_bdry_val(i+1,j) / dxdyh + + else + + u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) + + if (u_face < 0) then !flux is into cell - we need info from h(i+2), h(i+1) if available + + if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then ! at eastern bdry but there is a + ! thickness bdry condition, and the stencil contains it + + flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(1) / dxdyh + + elseif (hmask(i+1,j) * hmask(i+2,j) == 1) then ! h(i+2) and h(i+1) are valid + + phi = slope_limiter (stencil(1)-stencil(2), stencil(0)-stencil(1)) + flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step / dxdyh * & + (stencil(1) - phi * (stencil(1)-stencil(0))/2) + + else ! h(i+1) is valid + ! (o.w. flux would most likely be out of cell) + ! but h(i+2) is not + + flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step / dxdyh * stencil(1) + + endif + + elseif (u_face > 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available + + if (hmask(i-1,j) * hmask(i+1,j) == 1) then ! h(i-1) and h(i+1) are both valid + + phi = slope_limiter (stencil(0)-stencil(-1), stencil(1)-stencil(0)) + flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * & + (stencil(0) - phi * (stencil(0)-stencil(1))/2) + + else ! h(i+1) is valid + ! (o.w. flux would most likely be out of cell) + ! but h(i+2) is not + + flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * stencil(0) + + if ((hmask(i+1,j) == 0) .OR. (hmask(i+1,j) == 2)) then + flux_enter(i+1,j,1) = ABS(u_face) * dyh * time_step * stencil(0) + endif + + endif + + endif + + h_after_uflux(i,j) = h_after_uflux(i,j) + flux_diff_cell + + endif + + elseif ((hmask(i,j) == 0) .OR. (hmask(i,j) == 2)) then + + if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then + u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) + flux_enter(i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_bdry_val(i-1,j) + elseif (CS%u_face_mask(i-1,j) == 4.) then + flux_enter(i,j,1) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j) + endif + + if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then + u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) + flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_bdry_val(i+1,j) + elseif (CS%u_face_mask(i+1,j) == 4.) then + flux_enter(i,j,2) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) + endif + + if ((i == is) .AND. (hmask(i,j) == 0) .AND. (hmask(i-1,j) == 1)) then + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered + + hmask(i,j) = 2 + elseif ((i == ie) .AND. (hmask(i,j) == 0) .AND. (hmask(i+1,j) == 1)) then + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered + + hmask(i,j) = 2 + + endif + + endif + + endif + + enddo ! i loop + + endif + + enddo ! j loop + +end subroutine ice_shelf_advect_thickness_x + +subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, h_after_vflux, flux_enter) + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, intent(in) :: time_step !< The time step for this update, in s. + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask + real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h_after_uflux + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_vflux + real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter + + ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells + + ! if there is an input bdry condition, the thickness there will be set in initialization + + ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary + ! + ! from left neighbor: flux_enter(:,:,1) + ! from right neighbor: flux_enter(:,:,2) + ! from bottom neighbor: flux_enter(:,:,3) + ! from top neighbor: flux_enter(:,:,4) + ! + ! o--- (4) ---o + ! | | + ! (1) (2) + ! | | + ! o--- (3) ---o + ! + + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied + integer :: i_off, j_off + logical :: at_north_bdry, at_south_bdry, one_off_west_bdry, one_off_east_bdry + real, dimension(-2:2) :: stencil + real :: v_face, & ! positive if out + flux_diff_cell, phi, dxh, dyh, dxdyh + character(len=1) :: debug_str + + is = G%isc ; ie = G%iec ; js = G%jsc-1 ; je = G%jec+1 ; isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + i_off = G%idg_offset ; j_off = G%jdg_offset + + do i=isd+2,ied-2 + if (((i+i_off) <= G%domain%niglobal+G%domain%nihalo) .AND. & + ((i+i_off) >= G%domain%nihalo+1)) then ! based on mehmet's code - only if btw east & west boundaries + + stencil(:) = -1 + + do j=js,je + + if (((j+j_off) <= G%domain%njglobal+G%domain%njhalo) .AND. & + ((j+j_off) >= G%domain%njhalo+1)) then + + if (j+j_off == G%domain%njhalo+1) then + at_south_bdry=.true. + else + at_south_bdry=.false. + endif + + if (j+j_off == G%domain%njglobal+G%domain%njhalo) then + at_north_bdry=.true. + else + at_north_bdry=.false. + endif + + if (hmask(i,j) == 1) then + dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) + h_after_vflux(i,j) = h_after_uflux(i,j) + + stencil(:) = h_after_uflux(i,j-2:j+2) ! fine as long has ny_halo >= 2 + flux_diff_cell = 0 + + ! 1ST DO south FACE + + if (CS%v_face_mask(i,j-1) == 4.) then + + flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_flux_bdry_val(i,j-1) / dxdyh + + else + + ! get u-velocity at center of left face + v_face = 0.5 * (CS%v_shelf(i-1,j-1) + CS%v_shelf(i,j-1)) + + if (v_face > 0) then !flux is into cell - we need info from h(j-2), h(j-1) if available + + ! i may not cover all the cases.. but i cover the realistic ones + + if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then ! at western bdry but there is a + ! thickness bdry condition, and the stencil contains it + flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(-1) / dxdyh + + elseif (hmask(i,j-1) * hmask(i,j-2) == 1) then ! h(j-2) and h(j-1) are valid + + phi = slope_limiter (stencil(-1)-stencil(-2), stencil(0)-stencil(-1)) + flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * & + (stencil(-1) - phi * (stencil(-1)-stencil(0))/2) + + else ! h(j-1) is valid + ! (o.w. flux would most likely be out of cell) + ! but h(j-2) is not + flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * stencil(-1) + endif + + elseif (v_face < 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available + + if (hmask(i,j-1) * hmask(i,j+1) == 1) then ! h(j-1) and h(j+1) are both valid + phi = slope_limiter (stencil(0)-stencil(1), stencil(-1)-stencil(0)) + flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * & + (stencil(0) - phi * (stencil(0)-stencil(-1))/2) + else + flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * stencil(0) + + if ((hmask(i,j-1) == 0) .OR. (hmask(i,j-1) == 2)) then + flux_enter(i,j-1,4) = ABS(v_face) * dyh * time_step * stencil(0) + endif + + endif + + endif + + endif + + ! NEXT DO north FACE + + if (CS%v_face_mask(i,j+1) == 4.) then + + flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_flux_bdry_val(i,j+1) / dxdyh + + else + + ! get u-velocity at center of right face + v_face = 0.5 * (CS%v_shelf(i-1,j) + CS%v_shelf(i,j)) + + if (v_face < 0) then !flux is into cell - we need info from h(j+2), h(j+1) if available + + if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then ! at eastern bdry but there is a + ! thickness bdry condition, and the stencil contains it + flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(1) / dxdyh + elseif (hmask(i,j+1) * hmask(i,j+2) == 1) then ! h(j+2) and h(j+1) are valid + phi = slope_limiter (stencil(1)-stencil(2), stencil(0)-stencil(1)) + flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * & + (stencil(1) - phi * (stencil(1)-stencil(0))/2) + else ! h(j+1) is valid + ! (o.w. flux would most likely be out of cell) + ! but h(j+2) is not + flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * stencil(1) + endif + + elseif (v_face > 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available + + if (hmask(i,j-1) * hmask(i,j+1) == 1) then ! h(j-1) and h(j+1) are both valid + phi = slope_limiter (stencil(0)-stencil(-1), stencil(1)-stencil(0)) + flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * & + (stencil(0) - phi * (stencil(0)-stencil(1))/2) + else ! h(j+1) is valid + ! (o.w. flux would most likely be out of cell) + ! but h(j+2) is not + flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * stencil(0) + if ((hmask(i,j+1) == 0) .OR. (hmask(i,j+1) == 2)) then + flux_enter(i,j+1,3) = ABS(v_face) * dxh * time_step * stencil(0) + endif + endif + + endif + + endif + + h_after_vflux(i,j) = h_after_vflux(i,j) + flux_diff_cell + + elseif ((hmask(i,j) == 0) .OR. (hmask(i,j) == 2)) then + + if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then + v_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i,j-1)) + flux_enter(i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_bdry_val(i,j-1) + elseif (CS%v_face_mask(i,j-1) == 4.) then + flux_enter(i,j,3) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1) + endif + + if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then + v_face = 0.5 * (CS%u_shelf(i-1,j) + CS%u_shelf(i,j)) + flux_enter(i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_bdry_val(i,j+1) + elseif (CS%v_face_mask(i,j+1) == 4.) then + flux_enter(i,j,4) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1) + endif + + if ((j == js) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j-1) == 1)) then + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered + hmask(i,j) = 2 + elseif ((j == je) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j+1) == 1)) then + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered + hmask(i,j) = 2 + endif + + endif + endif + enddo ! j loop + endif + enddo ! i loop + +end subroutine ice_shelf_advect_thickness_y + +subroutine shelf_advance_front(CS, ISS, G, flux_enter) + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe + !! the ice-shelf state + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter + + ! in this subroutine we go through the computational cells only and, if they are empty or partial cells, + ! we find the reference thickness and update the shelf mass and partial area fraction and the hmask if necessary + + ! if any cells go from partial to complete, we then must set the thickness, update hmask accordingly, + ! and divide the overflow across the adjacent EMPTY (not partly-covered) cells. + ! (it is highly unlikely there will not be any; in which case this will need to be rethought.) + + ! most likely there will only be one "overflow". if not, though, a pass_var of all relevant variables + ! is done; there will therefore be a loop which, in practice, will hopefully not have to go through + ! many iterations + + ! when 3d advected scalars are introduced, they will be impacted by what is done here + + ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary + ! + ! from left neighbor: flux_enter(:,:,1) + ! from right neighbor: flux_enter(:,:,2) + ! from bottom neighbor: flux_enter(:,:,3) + ! from top neighbor: flux_enter(:,:,4) + ! + ! o--- (4) ---o + ! | | + ! (1) (2) + ! | | + ! o--- (3) ---o + ! + + integer :: i, j, isc, iec, jsc, jec, n_flux, k, l, iter_count + integer :: i_off, j_off + integer :: iter_flag + + real :: h_reference, dxh, dyh, dxdyh, rho, partial_vol, tot_flux + integer, dimension(4) :: mapi, mapj, new_partial +! real, dimension(size(flux_enter,1),size(flux_enter,2),size(flux_enter,2)) :: flux_enter_replace + real, dimension(SZDI_(G),SZDJ_(G),4) :: flux_enter_replace + + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec + i_off = G%idg_offset ; j_off = G%jdg_offset + rho = CS%density_ice + iter_count = 0 ; iter_flag = 1 + + + mapi(1) = -1 ; mapi(2) = 1 ; mapi(3:4) = 0 + mapj(3) = -1 ; mapj(4) = 1 ; mapj(1:2) = 0 + + do while (iter_flag == 1) + + iter_flag = 0 + + if (iter_count > 0) then + flux_enter(:,:,:) = flux_enter_replace(:,:,:) + endif + flux_enter_replace(:,:,:) = 0.0 + + iter_count = iter_count + 1 + + ! if iter_count >= 3 then some halo updates need to be done... + + do j=jsc-1,jec+1 + + if (((j+j_off) <= G%domain%njglobal+G%domain%njhalo) .AND. & + ((j+j_off) >= G%domain%njhalo+1)) then + + do i=isc-1,iec+1 + + if (((i+i_off) <= G%domain%niglobal+G%domain%nihalo) .AND. & + ((i+i_off) >= G%domain%nihalo+1)) then + ! first get reference thickness by averaging over cells that are fluxing into this cell + n_flux = 0 + h_reference = 0.0 + tot_flux = 0.0 + + do k=1,2 + if (flux_enter(i,j,k) > 0) then + n_flux = n_flux + 1 + h_reference = h_reference + ISS%h_shelf(i+2*k-3,j) + tot_flux = tot_flux + flux_enter(i,j,k) + flux_enter(i,j,k) = 0.0 + endif + enddo + + do k=1,2 + if (flux_enter(i,j,k+2) > 0) then + n_flux = n_flux + 1 + h_reference = h_reference + ISS%h_shelf(i,j+2*k-3) + tot_flux = tot_flux + flux_enter(i,j,k+2) + flux_enter(i,j,k+2) = 0.0 + endif + enddo + + if (n_flux > 0) then + dxdyh = G%areaT(i,j) + h_reference = h_reference / real(n_flux) + partial_vol = ISS%h_shelf(i,j) * ISS%area_shelf_h(i,j) + tot_flux + + if ((partial_vol / dxdyh) == h_reference) then ! cell is exactly covered, no overflow + ISS%hmask(i,j) = 1 + ISS%h_shelf(i,j) = h_reference + ISS%area_shelf_h(i,j) = dxdyh + elseif ((partial_vol / dxdyh) < h_reference) then + ISS%hmask(i,j) = 2 + ! ISS%mass_shelf(i,j) = partial_vol * rho + ISS%area_shelf_h(i,j) = partial_vol / h_reference + ISS%h_shelf(i,j) = h_reference + else + + ISS%hmask(i,j) = 1 + ISS%area_shelf_h(i,j) = dxdyh + !h_temp(i,j) = h_reference + partial_vol = partial_vol - h_reference * dxdyh + + iter_flag = 1 + + n_flux = 0 ; new_partial(:) = 0 + + do k=1,2 + if (CS%u_face_mask(i-2+k,j) == 2) then + n_flux = n_flux + 1 + elseif (ISS%hmask(i+2*k-3,j) == 0) then + n_flux = n_flux + 1 + new_partial(k) = 1 + endif + enddo + do k=1,2 + if (CS%v_face_mask(i,j-2+k) == 2) then + n_flux = n_flux + 1 + elseif (ISS%hmask(i,j+2*k-3) == 0) then + n_flux = n_flux + 1 + new_partial(k+2) = 1 + endif + enddo + + if (n_flux == 0) then ! there is nowhere to put the extra ice! + ISS%h_shelf(i,j) = h_reference + partial_vol / dxdyh + else + ISS%h_shelf(i,j) = h_reference + + do k=1,2 + if (new_partial(k) == 1) & + flux_enter_replace(i+2*k-3,j,3-k) = partial_vol / real(n_flux) + enddo + do k=1,2 ! ### Combine these two loops? + if (new_partial(k+2) == 1) & + flux_enter_replace(i,j+2*k-3,5-k) = partial_vol / real(n_flux) + enddo + endif + + endif ! Parital_vol test. + endif ! n_flux gt 0 test. + + endif + enddo ! j-loop + endif + enddo + + ! call max_across_PEs(iter_flag) + + enddo ! End of do while(iter_flag) loop + + call max_across_PEs(iter_count) + + if (is_root_pe() .and. (iter_count > 1)) print *, iter_count, "MAX ITERATIONS,ADVANCE FRONT" + +end subroutine shelf_advance_front + +!> Apply a very simple calving law using a minimum thickness rule +subroutine ice_shelf_min_thickness_calve(G, h_shelf, area_shelf_h, hmask, thickness_calve) + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: h_shelf + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: area_shelf_h + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: hmask + real, intent(in) :: thickness_calve + + integer :: i,j + + do j=G%jsd,G%jed + do i=G%isd,G%ied +! if ((h_shelf(i,j) < CS%thickness_calve) .and. (hmask(i,j) == 1) .and. & +! (CS%float_frac(i,j) == 0.0)) then + if ((h_shelf(i,j) < thickness_calve) .and. (area_shelf_h(i,j) > 0.)) then + h_shelf(i,j) = 0.0 + area_shelf_h(i,j) = 0.0 + hmask(i,j) = 0.0 + endif + enddo + enddo + +end subroutine ice_shelf_min_thickness_calve + +subroutine calve_to_mask(G, h_shelf, area_shelf_h, hmask, calve_mask) + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_shelf + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: area_shelf_h + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask + real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: calve_mask + + integer :: i,j + + do j=G%jsc,G%jec ; do i=G%isc,G%iec + if ((calve_mask(i,j) == 0.0) .and. (hmask(i,j) /= 0.0)) then + h_shelf(i,j) = 0.0 + area_shelf_h(i,j) = 0.0 + hmask(i,j) = 0.0 + endif + enddo ; enddo + +end subroutine calve_to_mask + +subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe + !! the ice-shelf state + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: OD !< ocean floor depth at tracer points, in m + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(inout) :: TAUD_X !< X-direction driving stress at q-points + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(inout) :: TAUD_Y !< Y-direction driving stress at q-points + +! driving stress! + +! ! TAUD_X and TAUD_Y will hold driving stress in the x- and y- directions when done. +! they will sit on the BGrid, and so their size depends on whether the grid is symmetric +! +! Since this is a finite element solve, they will actually have the form \int \phi_i rho g h \nabla s +! +! OD -this is important and we do not yet know where (in MOM) it will come from. It represents +! "average" ocean depth -- and is needed to find surface elevation +! (it is assumed that base_ice = bed + OD) + + real, dimension(SIZE(OD,1),SIZE(OD,2)) :: S, & ! surface elevation + BASE ! basal elevation of shelf/stream + + + real :: rho, rhow, sx, sy, neumann_val, dxh, dyh, dxdyh, grav + + integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq + integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec + integer :: i_off, j_off + + isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec + iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB + isd = G%isd ; jsd = G%jsd + iegq = G%iegB ; jegq = G%jegB + gisc = G%domain%nihalo+1 ; gjsc = G%domain%njhalo+1 + giec = G%domain%niglobal+G%domain%nihalo ; gjec = G%domain%njglobal+G%domain%njhalo + is = iscq - 1; js = jscq - 1 + i_off = G%idg_offset ; j_off = G%jdg_offset + + rho = CS%density_ice + rhow = CS%density_ocean_avg + grav = CS%g_Earth + + ! prelim - go through and calculate S + + ! or is this faster? + BASE(:,:) = -G%bathyT(:,:) + OD(:,:) + S(:,:) = BASE(:,:) + ISS%h_shelf(:,:) + + do j=jsc-1,jec+1 + do i=isc-1,iec+1 + cnt = 0 + sx = 0 + sy = 0 + dxh = G%dxT(i,j) + dyh = G%dyT(i,j) + dxdyh = G%areaT(i,j) + + if (ISS%hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell + + ! calculate sx + if ((i+i_off) == gisc) then ! at left computational bdry + if (ISS%hmask(i+1,j) == 1) then + sx = (S(i+1,j)-S(i,j))/dxh + else + sx = 0 + endif + elseif ((i+i_off) == giec) then ! at right computational bdry + if (ISS%hmask(i-1,j) == 1) then + sx = (S(i,j)-S(i-1,j))/dxh + else + sx=0 + endif + else ! interior + if (ISS%hmask(i+1,j) == 1) then + cnt = cnt+1 + sx = S(i+1,j) + else + sx = S(i,j) + endif + if (ISS%hmask(i-1,j) == 1) then + cnt = cnt+1 + sx = sx - S(i-1,j) + else + sx = sx - S(i,j) + endif + if (cnt == 0) then + sx=0 + else + sx = sx / (cnt * dxh) + endif + endif + + cnt = 0 + + ! calculate sy, similarly + if ((j+j_off) == gjsc) then ! at south computational bdry + if (ISS%hmask(i,j+1) == 1) then + sy = (S(i,j+1)-S(i,j))/dyh + else + sy = 0 + endif + elseif ((j+j_off) == gjec) then ! at nprth computational bdry + if (ISS%hmask(i,j-1) == 1) then + sy = (S(i,j)-S(i,j-1))/dyh + else + sy = 0 + endif + else ! interior + if (ISS%hmask(i,j+1) == 1) then + cnt = cnt+1 + sy = S(i,j+1) + else + sy = S(i,j) + endif + if (ISS%hmask(i,j-1) == 1) then + cnt = cnt+1 + sy = sy - S(i,j-1) + else + sy = sy - S(i,j) + endif + if (cnt == 0) then + sy=0 + else + sy = sy / (cnt * dyh) + endif + endif + + ! SW vertex + taud_x(I-1,J-1) = taud_x(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * dxdyh + taud_y(I-1,J-1) = taud_y(I-1,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * dxdyh + + ! SE vertex + taud_x(I,J-1) = taud_x(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * dxdyh + taud_y(I,J-1) = taud_y(I,J-1) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * dxdyh + + ! NW vertex + taud_x(I-1,J) = taud_x(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * dxdyh + taud_y(I-1,J) = taud_y(I-1,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * dxdyh + + ! NE vertex + taud_x(I,J) = taud_x(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sx * dxdyh + taud_y(I,J) = taud_y(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * dxdyh + + if (CS%float_frac(i,j) == 1) then + neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j) ** 2 - rhow * G%bathyT(i,j) ** 2) + else + neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j) ** 2 + endif + + + if ((CS%u_face_mask(i-1,j) == 2) .OR. (ISS%hmask(i-1,j) == 0) .OR. (ISS%hmask(i-1,j) == 2) ) then + ! left face of the cell is at a stress boundary + ! the depth-integrated longitudinal stress is equal to the difference of depth-integrated + ! pressure on either side of the face + ! on the ice side, it is rho g h^2 / 2 + ! on the ocean side, it is rhow g (delta OD)^2 / 2 + ! OD can be zero under the ice; but it is ASSUMED on the ice-free side of the face, topography elevation + ! is not above the base of the ice in the current cell + + ! note negative sign due to direction of normal vector + taud_x(i-1,j-1) = taud_x(i-1,j-1) - .5 * dyh * neumann_val + taud_x(i-1,j) = taud_x(i-1,j) - .5 * dyh * neumann_val + endif + + if ((CS%u_face_mask(i,j) == 2) .OR. (ISS%hmask(i+1,j) == 0) .OR. (ISS%hmask(i+1,j) == 2) ) then + ! right face of the cell is at a stress boundary + taud_x(i,j-1) = taud_x(i,j-1) + .5 * dyh * neumann_val + taud_x(i,j) = taud_x(i,j) + .5 * dyh * neumann_val + endif + + if ((CS%v_face_mask(i,j-1) == 2) .OR. (ISS%hmask(i,j-1) == 0) .OR. (ISS%hmask(i,j-1) == 2) ) then + ! south face of the cell is at a stress boundary + taud_y(i-1,j-1) = taud_y(i-1,j-1) - .5 * dxh * neumann_val + taud_y(i,j-1) = taud_y(i,j-1) - .5 * dxh * neumann_val + endif + + if ((CS%v_face_mask(i,j) == 2) .OR. (ISS%hmask(i,j+1) == 0) .OR. (ISS%hmask(i,j+1) == 2) ) then + ! north face of the cell is at a stress boundary + taud_y(i-1,j) = taud_y(i-1,j) + .5 * dxh * neumann_val ! note negative sign due to direction of normal vector + taud_y(i,j) = taud_y(i,j) + .5 * dxh * neumann_val + endif + + endif + enddo + enddo + +end subroutine calc_shelf_driving_stress + +subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new_sim) + type(ice_shelf_dyn_CS),intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + type(time_type), intent(in) :: Time !< The current model time + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: hmask !< A mask indicating which tracer points are + !! partly or fully coupled by an ice-shelf + real, intent(in) :: input_flux, input_thick + logical, optional, intent(in) :: new_sim !< If present and false, this run is being restarted + +! this will be a per-setup function. the boundary values of thickness and velocity +! (and possibly other variables) will be updated in this function + +! FOR RESTARTING PURPOSES: if grid is not symmetric and the model is restarted, we will +! need to update those velocity points not *technically* in any +! computational domain -- if this function gets moves to another module, +! DO NOT TAKE THE RESTARTING BIT WITH IT + integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq + integer :: gjec, gisc, gjsc, cnt, isc, jsc, iec, jec + integer :: i_off, j_off + real :: A, n, ux, uy, vx, vy, eps_min, domain_width + + + isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec +! iscq = G%iscq ; iecq = G%iecq ; jscq = G%jscq ; jecq = G%jecq + isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed +! iegq = G%iegq ; jegq = G%jegq + i_off = G%idg_offset ; j_off = G%jdg_offset + + domain_width = G%len_lat + + ! this loop results in some values being set twice but... eh. + + do j=jsd,jed + do i=isd,ied + + if (hmask(i,j) == 3) then + CS%thickness_bdry_val(i,j) = input_thick + endif + + if ((hmask(i,j) == 0) .or. (hmask(i,j) == 1) .or. (hmask(i,j) == 2)) then + if ((i <= iec).and.(i >= isc)) then + if (CS%u_face_mask(i-1,j) == 3) then + CS%u_bdry_val(i-1,j-1) = (1 - ((G%geoLatBu(i-1,j-1) - 0.5*G%len_lat)*2./G%len_lat)**2) * & + 1.5 * input_flux / input_thick + CS%u_bdry_val(i-1,j) = (1 - ((G%geoLatBu(i-1,j) - 0.5*G%len_lat)*2./G%len_lat)**2) * & + 1.5 * input_flux / input_thick + endif + endif + endif + + if (.not.(new_sim)) then + if (.not. G%symmetric) then + if (((i+i_off) == (G%domain%nihalo+1)).and.(CS%u_face_mask(i-1,j) == 3)) then + CS%u_shelf(i-1,j-1) = CS%u_bdry_val(i-1,j-1) + CS%u_shelf(i-1,j) = CS%u_bdry_val(i-1,j) + endif + if (((j+j_off) == (G%domain%njhalo+1)).and.(CS%v_face_mask(i,j-1) == 3)) then + CS%u_shelf(i-1,j-1) = CS%u_bdry_val(i-1,j-1) + CS%u_shelf(i,j-1) = CS%u_bdry_val(i,j-1) + endif + endif + endif + enddo + enddo + +end subroutine init_boundary_values + + +subroutine CG_action(uret, vret, u, v, Phi, Phisub, umask, vmask, hmask, H_node, & + nu, float_cond, D, beta, dxdyh, G, is, ie, js, je, dens_ratio) + + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent (inout) :: uret, vret + real, dimension(SZDI_(G),SZDJ_(G),8,4), intent(in) :: Phi + real, dimension(:,:,:,:,:,:), intent(in) :: Phisub + real, dimension(SZDIB_(G),SZDJB_(G)), intent (in) :: u, v + real, dimension(SZDIB_(G),SZDJB_(G)), intent (in) :: umask, vmask, H_node + real, dimension(SZDI_(G),SZDJ_(G)), intent (in) :: hmask + real, dimension(SZDIB_(G),SZDJB_(G)), intent (in) :: nu + real, dimension(SZDI_(G),SZDJ_(G)), intent (in) :: float_cond + real, dimension(SZDI_(G),SZDJ_(G)), intent (in) :: D + real, dimension(SZDIB_(G),SZDJB_(G)), intent (in) :: beta + real, dimension(SZDI_(G),SZDJ_(G)), intent (in) :: dxdyh + real, intent(in) :: dens_ratio + integer, intent(in) :: is, ie, js, je + +! the linear action of the matrix on (u,v) with bilinear finite elements +! as of now everything is passed in so no grid pointers or anything of the sort have to be dereferenced, +! but this may change pursuant to conversations with others +! +! is & ie are the cells over which the iteration is done; this may change between calls to this subroutine +! in order to make less frequent halo updates + +! the linear action of the matrix on (u,v) with bilinear finite elements +! Phi has the form +! Phi(i,j,k,q) - applies to cell i,j + + ! 3 - 4 + ! | | + ! 1 - 2 + +! Phi(i,j,2*k-1,q) gives d(Phi_k)/dx at quadrature point q +! Phi(i,j,2*k,q) gives d(Phi_k)/dy at quadrature point q +! Phi_k is equal to 1 at vertex k, and 0 at vertex l /= k, and bilinear + + real :: ux, vx, uy, vy, uq, vq, area, basel + integer :: iq, jq, iphi, jphi, i, j, ilq, jlq + real, dimension(2) :: xquad + real, dimension(2,2) :: Ucell,Vcell,Hcell,Usubcontr,Vsubcontr,Ucontr + + xquad(1) = .5 * (1-sqrt(1./3)) ; xquad(2) = .5 * (1+sqrt(1./3)) + + do j=js,je + do i=is,ie ; if (hmask(i,j) == 1) then +! dxh = G%dxh(i,j) +! dyh = G%dyh(i,j) +! +! X(:,:) = G%geoLonBu(i-1:i,j-1:j) +! Y(:,:) = G%geoLatBu(i-1:i,j-1:j) +! +! call bilinear_shape_functions (X, Y, Phi, area) + + ! X and Y must be passed in the form + ! 3 - 4 + ! | | + ! 1 - 2 + ! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j + ! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j + + area = dxdyh(i,j) + + Ucontr=0 + do iq=1,2 ; do jq=1,2 + + + if (iq == 2) then + ilq = 2 + else + ilq = 1 + endif + + if (jq == 2) then + jlq = 2 + else + jlq = 1 + endif + + uq = u(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + & + u(i,j-1) * xquad(iq) * xquad(3-jq) + & + u(i-1,j) * xquad(3-iq) * xquad(jq) + & + u(i,j) * xquad(iq) * xquad(jq) + + vq = v(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + & + v(i,j-1) * xquad(iq) * xquad(3-jq) + & + v(i-1,j) * xquad(3-iq) * xquad(jq) + & + v(i,j) * xquad(iq) * xquad(jq) + + ux = u(i-1,j-1) * Phi(i,j,1,2*(jq-1)+iq) + & + u(i,j-1) * Phi(i,j,3,2*(jq-1)+iq) + & + u(i-1,j) * Phi(i,j,5,2*(jq-1)+iq) + & + u(i,j) * Phi(i,j,7,2*(jq-1)+iq) + + vx = v(i-1,j-1) * Phi(i,j,1,2*(jq-1)+iq) + & + v(i,j-1) * Phi(i,j,3,2*(jq-1)+iq) + & + v(i-1,j) * Phi(i,j,5,2*(jq-1)+iq) + & + v(i,j) * Phi(i,j,7,2*(jq-1)+iq) + + uy = u(i-1,j-1) * Phi(i,j,2,2*(jq-1)+iq) + & + u(i,j-1) * Phi(i,j,4,2*(jq-1)+iq) + & + u(i-1,j) * Phi(i,j,6,2*(jq-1)+iq) + & + u(i,j) * Phi(i,j,8,2*(jq-1)+iq) + + vy = v(i-1,j-1) * Phi(i,j,2,2*(jq-1)+iq) + & + v(i,j-1) * Phi(i,j,4,2*(jq-1)+iq) + & + v(i-1,j) * Phi(i,j,6,2*(jq-1)+iq) + & + v(i,j) * Phi(i,j,8,2*(jq-1)+iq) + + do iphi=1,2 ; do jphi=1,2 + if (umask(i-2+iphi,j-2+jphi) == 1) then + + uret(i-2+iphi,j-2+jphi) = uret(i-2+iphi,j-2+jphi) + & + .25 * area * nu(i,j) * ((4*ux+2*vy) * Phi(i,j,2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & + (uy+vx) * Phi(i,j,2*(2*(jphi-1)+iphi),2*(jq-1)+iq)) + endif + if (vmask(i-2+iphi,j-2+jphi) == 1) then + + vret(i-2+iphi,j-2+jphi) = vret(i-2+iphi,j-2+jphi) + & + .25 * area * nu(i,j) * ((uy+vx) * Phi(i,j,2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & + (4*vy+2*ux) * Phi(i,j,2*(2*(jphi-1)+iphi),2*(jq-1)+iq)) + endif + + if (iq == iphi) then + ilq = 2 + else + ilq = 1 + endif + + if (jq == jphi) then + jlq = 2 + else + jlq = 1 + endif + + if (float_cond(i,j) == 0) then + + if (umask(i-2+iphi,j-2+jphi) == 1) then + + uret(i-2+iphi,j-2+jphi) = uret(i-2+iphi,j-2+jphi) + & + .25 * beta(i,j) * area * uq * xquad(ilq) * xquad(jlq) + + endif + + if (vmask(i-2+iphi,j-2+jphi) == 1) then + + vret(i-2+iphi,j-2+jphi) = vret(i-2+iphi,j-2+jphi) + & + .25 * beta(i,j) * area * vq * xquad(ilq) * xquad(jlq) + + endif + + endif + Ucontr(iphi,jphi) = Ucontr(iphi,jphi) + .25 * area * uq * xquad(ilq) * xquad(jlq) * beta(i,j) + enddo ; enddo + enddo ; enddo + + if (float_cond(i,j) == 1) then + Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = D(i,j) + Ucell(:,:) = u(i-1:i,j-1:j) ; Vcell(:,:) = v(i-1:i,j-1:j) ; Hcell(:,:) = H_node(i-1:i,j-1:j) + call CG_action_subgrid_basal & + (Phisub, Hcell, Ucell, Vcell, area, basel, dens_ratio, Usubcontr, Vsubcontr, i, j) + do iphi=1,2 ; do jphi=1,2 + if (umask(i-2+iphi,j-2+jphi) == 1) then + uret(i-2+iphi,j-2+jphi) = uret(i-2+iphi,j-2+jphi) + Usubcontr (iphi,jphi) * beta(i,j) + endif + if (vmask(i-2+iphi,j-2+jphi) == 1) then + vret(i-2+iphi,j-2+jphi) = vret(i-2+iphi,j-2+jphi) + Vsubcontr (iphi,jphi) * beta(i,j) + endif + enddo ; enddo + endif + + endif + enddo ; enddo + +end subroutine CG_action + +subroutine CG_action_subgrid_basal(Phisub, H, U, V, DXDYH, D, dens_ratio, Ucontr, Vcontr, iin, jin) + real, dimension(:,:,:,:,:,:), intent(in) :: Phisub + real, dimension(2,2), intent(in) :: H,U,V + real, intent(in) :: DXDYH, D, dens_ratio + real, dimension(2,2), intent(inout) :: Ucontr, Vcontr + integer, optional, intent(in) :: iin, jin + + ! D = cellwise-constant bed elevation + + integer :: nsub, i, j, k, l, qx, qy, m, n, i_m, j_m + real :: subarea, hloc, uq, vq + + nsub = size(Phisub,1) + subarea = DXDYH / (nsub**2) + + + if (.not. present(iin)) then + i_m = -1 + else + i_m = iin + endif + + if (.not. present(jin)) then + j_m = -1 + else + j_m = jin + endif + + + do m=1,2 + do n=1,2 + do j=1,nsub + do i=1,nsub + do qx=1,2 + do qy = 1,2 + + hloc = Phisub(i,j,1,1,qx,qy)*H(1,1)+Phisub(i,j,1,2,qx,qy)*H(1,2)+& + Phisub(i,j,2,1,qx,qy)*H(2,1)+Phisub(i,j,2,2,qx,qy)*H(2,2) + + if (dens_ratio * hloc - D > 0) then + !if (.true.) then + uq = 0 ; vq = 0 + do k=1,2 + do l=1,2 + !Ucontr(m,n) = Ucontr(m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * Phisub(i,j,k,l,qx,qy) * U(k,l) + !Vcontr(m,n) = Vcontr(m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * Phisub(i,j,k,l,qx,qy) * V(k,l) + uq = uq + Phisub(i,j,k,l,qx,qy) * U(k,l) ; vq = vq + Phisub(i,j,k,l,qx,qy) * V(k,l) + enddo + enddo + + Ucontr (m,n) = Ucontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * uq + Vcontr (m,n) = Vcontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * vq + + endif + + enddo + enddo + enddo + enddo + enddo + enddo + +end subroutine CG_action_subgrid_basal + + +subroutine matrix_diagonal(CS, G, float_cond, H_node, nu, beta, hmask, dens_ratio, & + Phisub, u_diagonal, v_diagonal) + + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: float_cond + real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: H_node !< The ice shelf thickness at nodal + !! (corner) points, in m. + real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: nu + real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: beta + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: hmask !< A mask indicating which tracer points are + !! partly or fully coupled by an ice-shelf + real :: dens_ratio + real, dimension(:,:,:,:,:,:), intent(in) :: Phisub + real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u_diagonal, v_diagonal + + +! returns the diagonal entries of the matrix for a Jacobi preconditioning + + integer :: i, j, is, js, cnt, isc, jsc, iec, jec, iphi, jphi, iq, jq, ilq, jlq + real :: A, n, ux, uy, vx, vy, eps_min, domain_width, dxh, dyh, dxdyh, area, uq, vq, basel + real, dimension(8,4) :: Phi + real, dimension(4) :: X, Y + real, dimension(2) :: xquad + real, dimension(2,2) :: Hcell,Usubcontr,Vsubcontr + + + isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec + + xquad(1) = .5 * (1-sqrt(1./3)) ; xquad(2) = .5 * (1+sqrt(1./3)) + +! X and Y must be passed in the form + ! 3 - 4 + ! | | + ! 1 - 2 +! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j +! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j + + do j=jsc-1,jec+1 ; do i=isc-1,iec+1 ; if (hmask(i,j) == 1) then + + dxh = G%dxT(i,j) + dyh = G%dyT(i,j) + dxdyh = G%areaT(i,j) + + X(1:2) = G%geoLonBu(i-1:i,j-1)*1000 + X(3:4) = G%geoLonBu(i-1:i,j) *1000 + Y(1:2) = G%geoLatBu(i-1:i,j-1) *1000 + Y(3:4) = G%geoLatBu(i-1:i,j)*1000 + + call bilinear_shape_functions(X, Y, Phi, area) + + ! X and Y must be passed in the form + ! 3 - 4 + ! | | + ! 1 - 2 + ! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j + ! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j + + do iq=1,2 ; do jq=1,2 + + do iphi=1,2 ; do jphi=1,2 + + if (iq == iphi) then + ilq = 2 + else + ilq = 1 + endif + + if (jq == jphi) then + jlq = 2 + else + jlq = 1 + endif + + if (CS%umask(i-2+iphi,j-2+jphi) == 1) then + + ux = Phi (2*(2*(jphi-1)+iphi)-1, 2*(jq-1)+iq) + uy = Phi (2*(2*(jphi-1)+iphi), 2*(jq-1)+iq) + vx = 0. + vy = 0. + + u_diagonal(i-2+iphi,j-2+jphi) = u_diagonal(i-2+iphi,j-2+jphi) + & + .25 * dxdyh * nu(i,j) * ((4*ux+2*vy) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & + (uy+vy) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq)) + + uq = xquad(ilq) * xquad(jlq) + + if (float_cond(i,j) == 0) then + u_diagonal(i-2+iphi,j-2+jphi) = u_diagonal(i-2+iphi,j-2+jphi) + & + .25 * beta(i,j) * dxdyh * uq * xquad(ilq) * xquad(jlq) + endif + + endif + + if (CS%vmask(i-2+iphi,j-2+jphi) == 1) then + + vx = Phi (2*(2*(jphi-1)+iphi)-1, 2*(jq-1)+iq) + vy = Phi (2*(2*(jphi-1)+iphi), 2*(jq-1)+iq) + ux = 0. + uy = 0. + + v_diagonal(i-2+iphi,j-2+jphi) = v_diagonal(i-2+iphi,j-2+jphi) + & + .25 * dxdyh * nu(i,j) * ((uy+vx) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & + (4*vy+2*ux) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq)) + + vq = xquad(ilq) * xquad(jlq) + + if (float_cond(i,j) == 0) then + v_diagonal(i-2+iphi,j-2+jphi) = v_diagonal(i-2+iphi,j-2+jphi) + & + .25 * beta(i,j) * dxdyh * vq * xquad(ilq) * xquad(jlq) + endif + + endif + enddo ; enddo + enddo ; enddo + if (float_cond(i,j) == 1) then + Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%bathyT(i,j) + Hcell(:,:) = H_node(i-1:i,j-1:j) + call CG_diagonal_subgrid_basal & + (Phisub, Hcell, dxdyh, basel, dens_ratio, Usubcontr, Vsubcontr) + do iphi=1,2 ; do jphi=1,2 + if (CS%umask(i-2+iphi,j-2+jphi) == 1) then + u_diagonal(i-2+iphi,j-2+jphi) = u_diagonal(i-2+iphi,j-2+jphi) + Usubcontr(iphi,jphi) * beta(i,j) + v_diagonal(i-2+iphi,j-2+jphi) = v_diagonal(i-2+iphi,j-2+jphi) + Vsubcontr(iphi,jphi) * beta(i,j) + endif + enddo ; enddo + endif + endif ; enddo ; enddo + +end subroutine matrix_diagonal + +subroutine CG_diagonal_subgrid_basal (Phisub, H, DXDYH, D, dens_ratio, Ucontr, Vcontr) + real, dimension(:,:,:,:,:,:), intent(in) :: Phisub + real, dimension(2,2), intent(in) :: H + real, intent(in) :: DXDYH, D, dens_ratio + real, dimension(2,2), intent(inout) :: Ucontr, Vcontr + + ! D = cellwise-constant bed elevation + + integer :: nsub, i, j, k, l, qx, qy, m, n + real :: subarea, hloc + + nsub = size(Phisub,1) + subarea = DXDYH / (nsub**2) + + do m=1,2 + do n=1,2 + do j=1,nsub + do i=1,nsub + do qx=1,2 + do qy = 1,2 + + hloc = Phisub(i,j,1,1,qx,qy)*H(1,1)+Phisub(i,j,1,2,qx,qy)*H(1,2)+& + Phisub(i,j,2,1,qx,qy)*H(2,1)+Phisub(i,j,2,2,qx,qy)*H(2,2) + + if (dens_ratio * hloc - D > 0) then + Ucontr (m,n) = Ucontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy)**2 + Vcontr (m,n) = Vcontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy)**2 + endif + + + enddo + enddo + enddo + enddo + enddo + enddo + +end subroutine CG_diagonal_subgrid_basal + + +subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, float_cond, & + dens_ratio, u_bdry_contr, v_bdry_contr) + + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe + !! the ice-shelf state + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + type(time_type), intent(in) :: Time !< The current model time + real, dimension(:,:,:,:,:,:), intent(in) :: Phisub + real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: H_node !< The ice shelf thickness at nodal + !! (corner) points, in m. + real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: nu + real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: beta + real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: float_cond + real :: dens_ratio + real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u_bdry_contr, v_bdry_contr + +! this will be a per-setup function. the boundary values of thickness and velocity +! (and possibly other variables) will be updated in this function + + real, dimension(8,4) :: Phi + real, dimension(4) :: X, Y + real, dimension(2) :: xquad + integer :: i, j, isc, jsc, iec, jec, iq, jq, iphi, jphi, ilq, jlq + real :: A, n, ux, uy, vx, vy, eps_min, domain_width, dxh, dyh, dxdyh, uq, vq, area, basel + real, dimension(2,2) :: Ucell,Vcell,Hcell,Usubcontr,Vsubcontr + + + isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec + + xquad(1) = .5 * (1-sqrt(1./3)) ; xquad(2) = .5 * (1+sqrt(1./3)) + +! X and Y must be passed in the form + ! 3 - 4 + ! | | + ! 1 - 2 +! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j +! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j + + do j=jsc-1,jec+1 ; do i=isc-1,iec+1 ; if (ISS%hmask(i,j) == 1) then + + ! process this cell if any corners have umask set to non-dirichlet bdry. + ! NOTE: vmask not considered, probably should be + + if ((CS%umask(i-1,j-1) == 3) .OR. (CS%umask(i,j-1) == 3) .OR. & + (CS%umask(i-1,j) == 3) .OR. (CS%umask(i,j) == 3)) then + + + dxh = G%dxT(i,j) + dyh = G%dyT(i,j) + dxdyh = G%areaT(i,j) + + X(1:2) = G%geoLonBu(i-1:i,j-1)*1000 + X(3:4) = G%geoLonBu(i-1:i,j)*1000 + Y(1:2) = G%geoLatBu(i-1:i,j-1)*1000 + Y(3:4) = G%geoLatBu(i-1:i,j)*1000 + + call bilinear_shape_functions(X, Y, Phi, area) + + ! X and Y must be passed in the form + ! 3 - 4 + ! | | + ! 1 - 2 + ! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j + ! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j + + + + do iq=1,2 ; do jq=1,2 + + uq = CS%u_bdry_val(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + & + CS%u_bdry_val(i,j-1) * xquad(iq) * xquad(3-jq) + & + CS%u_bdry_val(i-1,j) * xquad(3-iq) * xquad(jq) + & + CS%u_bdry_val(i,j) * xquad(iq) * xquad(jq) + + vq = CS%v_bdry_val(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + & + CS%v_bdry_val(i,j-1) * xquad(iq) * xquad(3-jq) + & + CS%v_bdry_val(i-1,j) * xquad(3-iq) * xquad(jq) + & + CS%v_bdry_val(i,j) * xquad(iq) * xquad(jq) + + ux = CS%u_bdry_val(i-1,j-1) * Phi(1,2*(jq-1)+iq) + & + CS%u_bdry_val(i,j-1) * Phi(3,2*(jq-1)+iq) + & + CS%u_bdry_val(i-1,j) * Phi(5,2*(jq-1)+iq) + & + CS%u_bdry_val(i,j) * Phi(7,2*(jq-1)+iq) + + vx = CS%v_bdry_val(i-1,j-1) * Phi(1,2*(jq-1)+iq) + & + CS%v_bdry_val(i,j-1) * Phi(3,2*(jq-1)+iq) + & + CS%v_bdry_val(i-1,j) * Phi(5,2*(jq-1)+iq) + & + CS%v_bdry_val(i,j) * Phi(7,2*(jq-1)+iq) + + uy = CS%u_bdry_val(i-1,j-1) * Phi(2,2*(jq-1)+iq) + & + CS%u_bdry_val(i,j-1) * Phi(4,2*(jq-1)+iq) + & + CS%u_bdry_val(i-1,j) * Phi(6,2*(jq-1)+iq) + & + CS%u_bdry_val(i,j) * Phi(8,2*(jq-1)+iq) + + vy = CS%v_bdry_val(i-1,j-1) * Phi(2,2*(jq-1)+iq) + & + CS%v_bdry_val(i,j-1) * Phi(4,2*(jq-1)+iq) + & + CS%v_bdry_val(i-1,j) * Phi(6,2*(jq-1)+iq) + & + CS%v_bdry_val(i,j) * Phi(8,2*(jq-1)+iq) + + do iphi=1,2 ; do jphi=1,2 + + if (iq == iphi) then + ilq = 2 + else + ilq = 1 + endif + + if (jq == jphi) then + jlq = 2 + else + jlq = 1 + endif + + if (CS%umask(i-2+iphi,j-2+jphi) == 1) then + + + u_bdry_contr(i-2+iphi,j-2+jphi) = u_bdry_contr(i-2+iphi,j-2+jphi) + & + .25 * dxdyh * nu(i,j) * ( (4*ux+2*vy) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & + (uy+vx) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq) ) + + if (float_cond(i,j) == 0) then + u_bdry_contr(i-2+iphi,j-2+jphi) = u_bdry_contr(i-2+iphi,j-2+jphi) + & + .25 * beta(i,j) * dxdyh * uq * xquad(ilq) * xquad(jlq) + endif + + endif + + if (CS%vmask(i-2+iphi,j-2+jphi) == 1) then + + + v_bdry_contr(i-2+iphi,j-2+jphi) = v_bdry_contr(i-2+iphi,j-2+jphi) + & + .25 * dxdyh * nu(i,j) * ( (uy+vx) * Phi(2*(2*(jphi-1)+iphi)-1,2*(jq-1)+iq) + & + (4*vy+2*ux) * Phi(2*(2*(jphi-1)+iphi),2*(jq-1)+iq)) + + if (float_cond(i,j) == 0) then + v_bdry_contr(i-2+iphi,j-2+jphi) = v_bdry_contr(i-2+iphi,j-2+jphi) + & + .25 * beta(i,j) * dxdyh * vq * xquad(ilq) * xquad(jlq) + endif + + endif + enddo ; enddo + enddo ; enddo + + if (float_cond(i,j) == 1) then + Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%bathyT(i,j) + Ucell(:,:) = CS%u_bdry_val(i-1:i,j-1:j) ; Vcell(:,:) = CS%v_bdry_val(i-1:i,j-1:j) + Hcell(:,:) = H_node(i-1:i,j-1:j) + call CG_action_subgrid_basal & + (Phisub, Hcell, Ucell, Vcell, dxdyh, basel, dens_ratio, Usubcontr, Vsubcontr) + do iphi=1,2 ; do jphi = 1,2 + if (CS%umask(i-2+iphi,j-2+jphi) == 1) then + u_bdry_contr(i-2+iphi,j-2+jphi) = u_bdry_contr(i-2+iphi,j-2+jphi) + & + Usubcontr(iphi,jphi) * beta(i,j) + endif + if (CS%vmask(i-2+iphi,j-2+jphi) == 1) then + v_bdry_contr(i-2+iphi,j-2+jphi) = v_bdry_contr(i-2+iphi,j-2+jphi) + & + Vsubcontr(iphi,jphi) * beta(i,j) + endif + enddo ; enddo + endif + endif + endif ; enddo ; enddo + +end subroutine apply_boundary_values + + +subroutine calc_shelf_visc(CS, ISS, G, u, v) + type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe + !! the ice-shelf state + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & + intent(inout) :: u !< The zonal ice shelf velocity, in m/s. + real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & + intent(inout) :: v !< The meridional ice shelf velocity, in m/s. + +! update DEPTH_INTEGRATED viscosity, based on horizontal strain rates - this is for bilinear FEM solve +! so there is an "upper" and "lower" bilinear viscosity + +! also this subroutine updates the nonlinear part of the basal traction + +! this may be subject to change later... to make it "hybrid" + + integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq + integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js + real :: A, n, ux, uy, vx, vy, eps_min, umid, vmid, unorm, C_basal_friction, n_basal_friction, dxh, dyh, dxdyh + + isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec + iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB + isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed + iegq = G%iegB ; jegq = G%jegB + gisc = G%domain%nihalo+1 ; gjsc = G%domain%njhalo+1 + giec = G%domain%niglobal+gisc ; gjec = G%domain%njglobal+gjsc + is = iscq - 1; js = jscq - 1 + + A = CS%A_glen_isothermal ; n = CS%n_glen; eps_min = CS%eps_glen_min + C_basal_friction = CS%C_basal_friction ; n_basal_friction = CS%n_basal_friction + + do j=jsd+1,jed-1 + do i=isd+1,ied-1 + + dxh = G%dxT(i,j) + dyh = G%dyT(i,j) + dxdyh = G%areaT(i,j) + + if (ISS%hmask(i,j) == 1) then + ux = (u(i,j) + u(i,j-1) - u(i-1,j) - u(i-1,j-1)) / (2*dxh) + vx = (v(i,j) + v(i,j-1) - v(i-1,j) - v(i-1,j-1)) / (2*dxh) + uy = (u(i,j) - u(i,j-1) + u(i-1,j) - u(i-1,j-1)) / (2*dyh) + vy = (v(i,j) - v(i,j-1) + v(i-1,j) - v(i-1,j-1)) / (2*dyh) + + CS%ice_visc(i,j) = .5 * A**(-1/n) * & + (ux**2+vy**2+ux*vy+0.25*(uy+vx)**2+eps_min**2) ** ((1-n)/(2*n)) * & + ISS%h_shelf(i,j) + + umid = (u(i,j) + u(i,j-1) + u(i-1,j) + u(i-1,j-1))/4 + vmid = (v(i,j) + v(i,j-1) + v(i-1,j) + v(i-1,j-1))/4 + unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) + CS%taub_beta_eff(i,j) = C_basal_friction * unorm ** (n_basal_friction-1) + endif + enddo + enddo + +end subroutine calc_shelf_visc + +subroutine update_OD_ffrac(CS, G, ocean_mass, find_avg) + type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: ocean_mass !< The mass per unit area of the ocean in kg m-2. + logical, intent(in) :: find_avg !< If true, find the average of OD and ffrac, and + !! reset the underlying running sums to 0. + + integer :: isc, iec, jsc, jec, i, j + real :: I_rho_ocean + real :: I_counter + + I_rho_ocean = 1.0/CS%density_ocean_avg + + isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec + + do j=jsc,jec ; do i=isc,iec + CS%OD_rt(i,j) = CS%OD_rt(i,j) + ocean_mass(i,j)*I_rho_ocean + if (ocean_mass(i,j)*I_rho_ocean > CS%thresh_float_col_depth) then + CS%float_frac_rt(i,j) = CS%float_frac_rt(i,j) + 1.0 + endif + enddo ; enddo + CS%OD_rt_counter = CS%OD_rt_counter + 1 + + if (find_avg) then + I_counter = 1.0 / real(CS%OD_rt_counter) + do j=jsc,jec ; do i=isc,iec + CS%float_frac(i,j) = 1.0 - (CS%float_frac_rt(i,j) * I_counter) + CS%OD_av(i,j) = CS%OD_rt(i,j) * I_counter + + CS%OD_rt(i,j) = 0.0 ; CS%float_frac_rt(i,j) = 0.0 + enddo ; enddo + + call pass_var(CS%float_frac, G%domain) + call pass_var(CS%OD_av, G%domain) + endif + +end subroutine update_OD_ffrac + +subroutine update_OD_ffrac_uncoupled(CS, G, h_shelf) + type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: h_shelf !< the thickness of the ice shelf in m + + integer :: i, j, iters, isd, ied, jsd, jed + real :: rhoi, rhow, OD + + rhoi = CS%density_ice + rhow = CS%density_ocean_avg + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + + do j=jsd,jed + do i=isd,ied + OD = G%bathyT(i,j) - rhoi/rhow * h_shelf(i,j) + if (OD >= 0) then + ! ice thickness does not take up whole ocean column -> floating + CS%OD_av(i,j) = OD + CS%float_frac(i,j) = 0. + else + CS%OD_av(i,j) = 0. + CS%float_frac(i,j) = 1. + endif + enddo + enddo + +end subroutine update_OD_ffrac_uncoupled + +subroutine bilinear_shape_functions (X, Y, Phi, area) + real, dimension(4), intent(in) :: X, Y + real, dimension(8,4), intent (inout) :: Phi + real, intent (out) :: area + +! X and Y must be passed in the form + ! 3 - 4 + ! | | + ! 1 - 2 + +! this subroutine calculates the gradients of bilinear basis elements that +! that are centered at the vertices of the cell. values are calculated at +! points of gaussian quadrature. (in 1D: .5 * (1 +/- sqrt(1/3)) for [0,1]) +! (ordered in same way as vertices) +! +! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j +! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j +! Phi_i is equal to 1 at vertex i, and 0 at vertex k /= i, and bilinear +! +! This should be a one-off; once per nonlinear solve? once per lifetime? +! ... will all cells have the same shape and dimension? + + real, dimension(4) :: xquad, yquad + integer :: node, qpoint, xnode, xq, ynode, yq + real :: a,b,c,d,e,f,xexp,yexp + + xquad(1:3:2) = .5 * (1-sqrt(1./3)) ; yquad(1:2) = .5 * (1-sqrt(1./3)) + xquad(2:4:2) = .5 * (1+sqrt(1./3)) ; yquad(3:4) = .5 * (1+sqrt(1./3)) + + do qpoint=1,4 + + a = -X(1)*(1-yquad(qpoint)) + X(2)*(1-yquad(qpoint)) - X(3)*yquad(qpoint) + X(4)*yquad(qpoint) ! d(x)/d(x*) + b = -Y(1)*(1-yquad(qpoint)) + Y(2)*(1-yquad(qpoint)) - Y(3)*yquad(qpoint) + Y(4)*yquad(qpoint) ! d(y)/d(x*) + c = -X(1)*(1-xquad(qpoint)) - X(2)*(xquad(qpoint)) + X(3)*(1-xquad(qpoint)) + X(4)*(xquad(qpoint)) ! d(x)/d(y*) + d = -Y(1)*(1-xquad(qpoint)) - Y(2)*(xquad(qpoint)) + Y(3)*(1-xquad(qpoint)) + Y(4)*(xquad(qpoint)) ! d(y)/d(y*) + + do node=1,4 + + xnode = 2-mod(node,2) ; ynode = ceiling(REAL(node)/2) + + if (ynode == 1) then + yexp = 1-yquad(qpoint) + else + yexp = yquad(qpoint) + endif + + if (1 == xnode) then + xexp = 1-xquad(qpoint) + else + xexp = xquad(qpoint) + endif + + Phi (2*node-1,qpoint) = ( d * (2 * xnode - 3) * yexp - b * (2 * ynode - 3) * xexp) / (a*d-b*c) + Phi (2*node,qpoint) = ( -c * (2 * xnode - 3) * yexp + a * (2 * ynode - 3) * xexp) / (a*d-b*c) + + enddo + enddo + + area = quad_area (X,Y) + +end subroutine bilinear_shape_functions + + +subroutine bilinear_shape_functions_subgrid (Phisub, nsub) + real, dimension(nsub,nsub,2,2,2,2), intent(inout) :: Phisub + integer :: nsub + + ! this subroutine is a helper for interpolation of floatation condition + ! for the purposes of evaluating the terms \int (u,v) \phi_i dx dy in a cell that is + ! in partial floatation + ! the array Phisub contains the values of \phi_i (where i is a node of the cell) + ! at quad point j + ! i think this general approach may not work for nonrectangular elements... + ! + + ! Phisub(i,j,k,l,q1,q2) + ! i: subgrid index in x-direction + ! j: subgrid index in y-direction + ! k: basis function x-index + ! l: basis function y-index + ! q1: quad point x-index + ! q2: quad point y-index + + ! e.g. k=1,l=1 => node 1 + ! q1=2,q2=1 => quad point 2 + + ! 3 - 4 + ! | | + ! 1 - 2 + + integer :: i, j, k, l, qx, qy, indx, indy + real,dimension(2) :: xquad + real :: x0, y0, x, y, val, fracx + + xquad(1) = .5 * (1-sqrt(1./3)) ; xquad(2) = .5 * (1+sqrt(1./3)) + fracx = 1.0/real(nsub) + + do j=1,nsub + do i=1,nsub + x0 = (i-1) * fracx ; y0 = (j-1) * fracx + do qx=1,2 + do qy=1,2 + x = x0 + fracx*xquad(qx) + y = y0 + fracx*xquad(qy) + do k=1,2 + do l=1,2 + val = 1.0 + if (k == 1) then + val = val * (1.0-x) + else + val = val * x + endif + if (l == 1) then + val = val * (1.0-y) + else + val = val * y + endif + Phisub(i,j,k,l,qx,qy) = val + enddo + enddo + enddo + enddo + enddo + enddo + +end subroutine bilinear_shape_functions_subgrid + + +subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face_mask) + type(ice_shelf_dyn_CS),intent(in) :: CS !< A pointer to the ice shelf dynamics control structure + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: hmask !< A mask indicating which tracer points are + !! partly or fully coupled by an ice-shelf + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(out) :: umask !< A coded mask indicating the nature of the + !! zonal flow at the corner point + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(out) :: vmask !< A coded mask indicating the nature of the + !! meridional flow at the corner point + real, dimension(SZDIB_(G),SZDJ_(G)), & + intent(out) :: u_face_mask !< A coded mask for velocities at the C-grid u-face + real, dimension(SZDI_(G),SZDJB_(G)), & + intent(out) :: v_face_mask !< A coded mask for velocities at the C-grid v-face + ! sets masks for velocity solve + ! ignores the fact that their might be ice-free cells - this only considers the computational boundary + + ! !!!IMPORTANT!!! relies on thickness mask - assumed that this is called after hmask has been updated & halo-updated + + integer :: i, j, k, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq + integer :: giec, gjec, gisc, gjsc, isc, jsc, iec, jec + integer :: i_off, j_off + + isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec + iscq = G%iscB ; iecq = G%iecB ; jscq = G%jscB ; jecq = G%jecB + i_off = G%idg_offset ; j_off = G%jdg_offset + isd = G%isd ; jsd = G%jsd + iegq = G%iegB ; jegq = G%jegB + gisc = G%Domain%nihalo ; gjsc = G%Domain%njhalo + giec = G%Domain%niglobal+gisc ; gjec = G%Domain%njglobal+gjsc + + umask(:,:) = 0 ; vmask(:,:) = 0 + u_face_mask(:,:) = 0 ; v_face_mask(:,:) = 0 + + if (G%symmetric) then + is = isd ; js = jsd + else + is = isd+1 ; js = jsd+1 + endif + + do j=js,G%jed + do i=is,G%ied + + if (hmask(i,j) == 1) then + + umask(i-1:i,j-1:j) = 1. + vmask(i-1:i,j-1:j) = 1. + + do k=0,1 + + select case (int(CS%u_face_mask_bdry(i-1+k,j))) + case (3) + umask(i-1+k,j-1:j)=3. + vmask(i-1+k,j-1:j)=0. + u_face_mask(i-1+k,j)=3. + case (2) + u_face_mask(i-1+k,j)=2. + case (4) + umask(i-1+k,j-1:j)=0. + vmask(i-1+k,j-1:j)=0. + u_face_mask(i-1+k,j)=4. + case (0) + umask(i-1+k,j-1:j)=0. + vmask(i-1+k,j-1:j)=0. + u_face_mask(i-1+k,j)=0. + case (1) ! stress free x-boundary + umask(i-1+k,j-1:j)=0. + case default + end select + enddo + + do k=0,1 + + select case (int(CS%v_face_mask_bdry(i,j-1+k))) + case (3) + vmask(i-1:i,j-1+k)=3. + umask(i-1:i,j-1+k)=0. + v_face_mask(i,j-1+k)=3. + case (2) + v_face_mask(i,j-1+k)=2. + case (4) + umask(i-1:i,j-1+k)=0. + vmask(i-1:i,j-1+k)=0. + v_face_mask(i,j-1+k)=4. + case (0) + umask(i-1:i,j-1+k)=0. + vmask(i-1:i,j-1+k)=0. + u_face_mask(i,j-1+k)=0. + case (1) ! stress free y-boundary + vmask(i-1:i,j-1+k)=0. + case default + end select + enddo + + !if (CS%u_face_mask_bdry(i-1,j).geq.0) then !left boundary + ! u_face_mask(i-1,j) = CS%u_face_mask_bdry(i-1,j) + ! umask(i-1,j-1:j) = 3. + ! vmask(i-1,j-1:j) = 0. + !endif + + !if (j_off+j == gjsc+1) then !bot boundary + ! v_face_mask(i,j-1) = 0. + ! umask (i-1:i,j-1) = 0. + ! vmask (i-1:i,j-1) = 0. + !elseif (j_off+j == gjec) then !top boundary + ! v_face_mask(i,j) = 0. + ! umask (i-1:i,j) = 0. + ! vmask (i-1:i,j) = 0. + !endif + + if (i < G%ied) then + if ((hmask(i+1,j) == 0) & + .OR. (hmask(i+1,j) == 2)) then + !right boundary or adjacent to unfilled cell + u_face_mask(i,j) = 2. + endif + endif + + if (i > G%isd) then + if ((hmask(i-1,j) == 0) .OR. (hmask(i-1,j) == 2)) then + !adjacent to unfilled cell + u_face_mask(i-1,j) = 2. + endif + endif + + if (j > G%jsd) then + if ((hmask(i,j-1) == 0) .OR. (hmask(i,j-1) == 2)) then + !adjacent to unfilled cell + v_face_mask(i,j-1) = 2. + endif + endif + + if (j < G%jed) then + if ((hmask(i,j+1) == 0) .OR. (hmask(i,j+1) == 2)) then + !adjacent to unfilled cell + v_face_mask(i,j) = 2. + endif + endif + + + endif + + enddo + enddo + + ! note: if the grid is nonsymmetric, there is a part that will not be transferred with a halo update + ! so this subroutine must update its own symmetric part of the halo + + call pass_vector(u_face_mask, v_face_mask, G%domain, TO_ALL, CGRID_NE) + call pass_vector(umask, vmask, G%domain, TO_ALL, BGRID_NE) + +end subroutine update_velocity_masks + +!> Interpolate the ice shelf thickness from tracer point to nodal points, +!! subject to a mask. +subroutine interpolate_H_to_B(G, h_shelf, hmask, H_node) + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: h_shelf !< The ice shelf thickness at tracer points, in m. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: hmask !< A mask indicating which tracer points are + !! partly or fully coupled by an ice-shelf + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(inout) :: H_node !< The ice shelf thickness at nodal (corner) + !! points, in m. + + integer :: i, j, isc, iec, jsc, jec, num_h, k, l + real :: summ + + isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec + + H_node(:,:) = 0.0 + + ! H_node is node-centered; average over all cells that share that node + ! if no (active) cells share the node then its value there is irrelevant + + do j=jsc-1,jec + do i=isc-1,iec + summ = 0.0 + num_h = 0 + do k=0,1 + do l=0,1 + if (hmask(i+k,j+l) == 1.0) then + summ = summ + h_shelf(i+k,j+l) + num_h = num_h + 1 + endif + enddo + enddo + if (num_h > 0) then + H_node(i,j) = summ / num_h + endif + enddo + enddo + + call pass_var(H_node, G%domain, position=CORNER) + +end subroutine interpolate_H_to_B + +!> Deallocates all memory associated with the ice shelf dynamics module +subroutine ice_shelf_dyn_end(CS) + type(ice_shelf_dyn_CS), pointer :: CS !< A pointer to the ice shelf dynamics control structure + + if (.not.associated(CS)) return + + deallocate(CS%u_shelf, CS%v_shelf) + deallocate(CS%t_shelf, CS%tmask) + deallocate(CS%u_bdry_val, CS%v_bdry_val, CS%t_bdry_val) + deallocate(CS%u_face_mask, CS%v_face_mask) + deallocate(CS%umask, CS%vmask) + + deallocate(CS%ice_visc, CS%taub_beta_eff) + deallocate(CS%OD_rt, CS%OD_av) + deallocate(CS%float_frac, CS%float_frac_rt) + + deallocate(CS) + +end subroutine ice_shelf_dyn_end + + +!> This subroutine updates the vertically averaged ice shelf temperature. +subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) + type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe + !! the ice-shelf state + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real, intent(in) :: time_step !< The time step for this update, in s. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: melt_rate !< basal melt rate in kg/m^2/s + type(time_type), intent(in) :: Time !< The current model time + +! time_step: time step in sec +! melt_rate: basal melt rate in kg/m^2/s + +! 5/23/12 OVS +! Arguments: +! CS - A structure containing the ice shelf state - including current velocities +! t0 - an array containing temperature at the beginning of the call +! t_after_uflux - an array containing the temperature after advection in u-direction +! t_after_vflux - similar +! +! This subroutine takes the velocity (on the Bgrid) and timesteps +! (HT)_t = - div (uHT) + (adot Tsurd -bdot Tbot) once and then calculates T=HT/H +! +! The flux overflows are included here. That is because they will be used to advect 3D scalars +! into partial cells + + ! + ! flux_enter: this is to capture flow into partially covered cells; it gives the mass flux into a given + ! cell across its boundaries. + ! ###Perhaps flux_enter should be changed into u-face and v-face + ! ###fluxes, which can then be used in halo updates, etc. + ! + ! from left neighbor: flux_enter(:,:,1) + ! from right neighbor: flux_enter(:,:,2) + ! from bottom neighbor: flux_enter(:,:,3) + ! from top neighbor: flux_enter(:,:,4) + ! + ! THESE ARE NOT CONSISTENT ==> FIND OUT WHAT YOU IMPLEMENTED + + ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary + ! + ! o--- (4) ---o + ! | | + ! (1) (2) + ! | | + ! o--- (3) ---o + ! + + real, dimension(SZDI_(G),SZDJ_(G)) :: th_after_uflux, th_after_vflux, TH + real, dimension(SZDI_(G),SZDJ_(G),4) :: flux_enter + integer :: isd, ied, jsd, jed, i, j, isc, iec, jsc, jec + real :: rho, spy, t_bd, Tsurf, adot + + rho = CS%density_ice + spy = 365 * 86400 ! seconds per year; is there a global constant for this? No - it is dependent upon a calendar. + + adot = 0.1/spy ! for now adot and Tsurf are defined here adot=surf acc 0.1m/yr, Tsurf=-20oC, vary them later + Tsurf = -20.0 + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec + flux_enter(:,:,:) = 0.0 + + th_after_uflux(:,:) = 0.0 + th_after_vflux(:,:) = 0.0 + + do j=jsd,jed + do i=isd,ied + t_bd = CS%t_bdry_val(i,j) +! if (ISS%hmask(i,j) > 1) then + if ((ISS%hmask(i,j) == 3) .or. (ISS%hmask(i,j) == -2)) then + CS%t_shelf(i,j) = CS%t_bdry_val(i,j) + endif + enddo + enddo + + do j=jsd,jed + do i=isd,ied + TH(i,j) = CS%t_shelf(i,j)*ISS%h_shelf(i,j) + enddo + enddo + + +! call enable_averaging(time_step,Time,CS%diag) +! call pass_var(h_after_uflux, G%domain) +! call pass_var(h_after_vflux, G%domain) +! if (CS%id_h_after_uflux > 0) call post_data(CS%id_h_after_uflux, h_after_uflux, CS%diag) +! if (CS%id_h_after_vflux > 0) call post_data(CS%id_h_after_vflux, h_after_vflux, CS%diag) +! call disable_averaging(CS%diag) + + call ice_shelf_advect_temp_x(CS, G, time_step/spy, ISS%hmask, TH, th_after_uflux, flux_enter) + call ice_shelf_advect_temp_y(CS, G, time_step/spy, ISS%hmask, th_after_uflux, th_after_vflux, flux_enter) + + do j=jsd,jed + do i=isd,ied +! if (ISS%hmask(i,j) == 1) then + if (ISS%h_shelf(i,j) > 0.0) then + CS%t_shelf(i,j) = th_after_vflux(i,j)/ISS%h_shelf(i,j) + else + CS%t_shelf(i,j) = -10.0 + endif + enddo + enddo + + do j=jsd,jed + do i=isd,ied + t_bd = CS%t_bdry_val(i,j) +! if (ISS%hmask(i,j) > 1) then + if ((ISS%hmask(i,j) == 3) .or. (ISS%hmask(i,j) == -2)) then + CS%t_shelf(i,j) = t_bd +! CS%t_shelf(i,j) = -15.0 + endif + enddo + enddo + + do j=jsc,jec + do i=isc,iec + if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2)) then + if (ISS%h_shelf(i,j) > 0.0) then +! CS%t_shelf(i,j) = CS%t_shelf(i,j) + time_step*(adot*Tsurf -melt_rate(i,j)*ISS%tfreeze(i,j))/ISS%h_shelf(i,j) + CS%t_shelf(i,j) = CS%t_shelf(i,j) + time_step*(adot*Tsurf -3/spy*ISS%tfreeze(i,j))/ISS%h_shelf(i,j) + else + ! the ice is about to melt away + ! in this case set thickness, area, and mask to zero + ! NOTE: not mass conservative + ! should maybe scale salt & heat flux for this cell + + CS%t_shelf(i,j) = -10.0 + CS%tmask(i,j) = 0.0 + endif + endif + enddo + enddo + + call pass_var(CS%t_shelf, G%domain) + call pass_var(CS%tmask, G%domain) + + if (CS%DEBUG) then + call hchksum(CS%t_shelf, "temp after front", G%HI, haloshift=3) + endif + +end subroutine ice_shelf_temp + + +subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, flux_enter) + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real, intent(in) :: time_step !< The time step for this update, in s. + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask + real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h0 + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_uflux + real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter + + ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells + + ! if there is an input bdry condition, the thickness there will be set in initialization + + ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary + ! + ! from left neighbor: flux_enter(:,:,1) + ! from right neighbor: flux_enter(:,:,2) + ! from bottom neighbor: flux_enter(:,:,3) + ! from top neighbor: flux_enter(:,:,4) + ! + ! o--- (4) ---o + ! | | + ! (1) (2) + ! | | + ! o--- (3) ---o + ! + + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied + integer :: i_off, j_off + logical :: at_east_bdry, at_west_bdry, one_off_west_bdry, one_off_east_bdry + real, dimension(-2:2) :: stencil + real :: u_face, & ! positive if out + flux_diff_cell, phi, dxh, dyh, dxdyh + + character (len=1) :: debug_str + + + is = G%isc-2 ; ie = G%iec+2 ; js = G%jsc ; je = G%jec ; isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + i_off = G%idg_offset ; j_off = G%jdg_offset + + do j=jsd+1,jed-1 + if (((j+j_off) <= G%domain%njglobal+G%domain%njhalo) .AND. & + ((j+j_off) >= G%domain%njhalo+1)) then ! based on mehmet's code - only if btw north & south boundaries + + stencil(:) = -1 +! if (i+i_off == G%domain%nihalo+G%domain%nihalo) + do i=is,ie + + if (((i+i_off) <= G%domain%niglobal+G%domain%nihalo) .AND. & + ((i+i_off) >= G%domain%nihalo+1)) then + + if (i+i_off == G%domain%nihalo+1) then + at_west_bdry=.true. + else + at_west_bdry=.false. + endif + + if (i+i_off == G%domain%niglobal+G%domain%nihalo) then + at_east_bdry=.true. + else + at_east_bdry=.false. + endif + + if (hmask(i,j) == 1) then + + dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) + + h_after_uflux(i,j) = h0(i,j) + + stencil(:) = h0(i-2:i+2,j) ! fine as long has nx_halo >= 2 + + flux_diff_cell = 0 + + ! 1ST DO LEFT FACE + + if (CS%u_face_mask(i-1,j) == 4.) then + + flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_flux_bdry_val(i-1,j) * & + CS%t_bdry_val(i-1,j) / dxdyh +! assume no flux bc for temp +! flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_shelf(i,j)*CS%t_bdry_val(i-1,j) / dxdyh + + else + + ! get u-velocity at center of left face + u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) + + if (u_face > 0) then !flux is into cell - we need info from h(i-2), h(i-1) if available + + ! i may not cover all the cases.. but i cover the realistic ones + + if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then ! at western bdry but there is a + ! thickness bdry condition, and the stencil contains it + flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(-1) / dxdyh + + elseif (hmask(i-1,j) * hmask(i-2,j) == 1) then ! h(i-2) and h(i-1) are valid + phi = slope_limiter (stencil(-1)-stencil(-2), stencil(0)-stencil(-1)) + flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh* time_step / dxdyh * & + (stencil(-1) - phi * (stencil(-1)-stencil(0))/2) + + else ! h(i-1) is valid + ! (o.w. flux would most likely be out of cell) + ! but h(i-2) is not + + flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step / dxdyh * stencil(-1) + + endif + + elseif (u_face < 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available + if (hmask(i-1,j) * hmask(i+1,j) == 1) then ! h(i-1) and h(i+1) are both valid + phi = slope_limiter (stencil(0)-stencil(1), stencil(-1)-stencil(0)) + flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * & + (stencil(0) - phi * (stencil(0)-stencil(-1))/2) + + else + flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * stencil(0) + + if ((hmask(i-1,j) == 0) .OR. (hmask(i-1,j) == 2)) then + flux_enter(i-1,j,2) = ABS(u_face) * dyh * time_step * stencil(0) + endif + endif + endif + endif + + ! NEXT DO RIGHT FACE + + ! get u-velocity at center of right face + + if (CS%u_face_mask(i+1,j) == 4.) then + + flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_flux_bdry_val(i+1,j) *& + CS%t_bdry_val(i+1,j)/ dxdyh +! assume no flux bc for temp +! flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_shelf(i,j)*CS%t_bdry_val(i+1,j)/ dxdyh + + else + + u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) + + if (u_face < 0) then !flux is into cell - we need info from h(i+2), h(i+1) if available + + if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then ! at eastern bdry but there is a + ! thickness bdry condition, and the stencil contains it + + flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(1) / dxdyh + + elseif (hmask(i+1,j) * hmask(i+2,j) == 1) then ! h(i+2) and h(i+1) are valid + + phi = slope_limiter (stencil(1)-stencil(2), stencil(0)-stencil(1)) + flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step / dxdyh * & + (stencil(1) - phi * (stencil(1)-stencil(0))/2) + + else ! h(i+1) is valid + ! (o.w. flux would most likely be out of cell) + ! but h(i+2) is not + + flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step / dxdyh * stencil(1) + + endif + + elseif (u_face > 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available + + if (hmask(i-1,j) * hmask(i+1,j) == 1) then ! h(i-1) and h(i+1) are both valid + + phi = slope_limiter (stencil(0)-stencil(-1), stencil(1)-stencil(0)) + flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * & + (stencil(0) - phi * (stencil(0)-stencil(1))/2) + + else ! h(i+1) is valid + ! (o.w. flux would most likely be out of cell) + ! but h(i+2) is not + + flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * stencil(0) + + if ((hmask(i+1,j) == 0) .OR. (hmask(i+1,j) == 2)) then + + flux_enter(i+1,j,1) = ABS(u_face) * dyh * time_step * stencil(0) + endif + + endif + + endif + + h_after_uflux(i,j) = h_after_uflux(i,j) + flux_diff_cell + + endif + + elseif ((hmask(i,j) == 0) .OR. (hmask(i,j) == 2)) then + + if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then + u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) + flux_enter(i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * CS%t_bdry_val(i-1,j)* & + CS%thickness_bdry_val(i+1,j) + elseif (CS%u_face_mask(i-1,j) == 4.) then + flux_enter(i,j,1) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j)*CS%t_bdry_val(i-1,j) +! flux_enter(i,j,1) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*CS%t_bdry_val(i-1,j) +! assume no flux bc for temp + endif + + if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then + u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) + flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * CS%t_bdry_val(i+1,j)* & + CS%thickness_bdry_val(i+1,j) + elseif (CS%u_face_mask(i+1,j) == 4.) then + flux_enter(i,j,2) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) * CS%t_bdry_val(i+1,j) +! assume no flux bc for temp +! flux_enter(i,j,2) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*CS%t_bdry_val(i+1,j) + endif + +! if ((i == is) .AND. (hmask(i,j) == 0) .AND. (hmask(i-1,j) == 1)) then + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered +! hmask(i,j) = 2 +! elseif ((i == ie) .AND. (hmask(i,j) == 0) .AND. (hmask(i+1,j) == 1)) then + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered +! hmask(i,j) = 2 + +! endif + + endif + + endif + + enddo ! i loop + + endif + + enddo ! j loop + +end subroutine ice_shelf_advect_temp_x + +subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_after_vflux, flux_enter) + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, intent(in) :: time_step !< The time step for this update, in s. + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask + real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h_after_uflux + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_vflux + real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter + + ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells + + ! if there is an input bdry condition, the thickness there will be set in initialization + + ! flux_enter(isd:ied,jsd:jed,1:4): if cell is not ice-covered, gives flux of ice into cell from kth boundary + ! + ! from left neighbor: flux_enter(:,:,1) + ! from right neighbor: flux_enter(:,:,2) + ! from bottom neighbor: flux_enter(:,:,3) + ! from top neighbor: flux_enter(:,:,4) + ! + ! o--- (4) ---o + ! | | + ! (1) (2) + ! | | + ! o--- (3) ---o + ! + + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied + integer :: i_off, j_off + logical :: at_north_bdry, at_south_bdry, one_off_west_bdry, one_off_east_bdry + real, dimension(-2:2) :: stencil + real :: v_face, & ! positive if out + flux_diff_cell, phi, dxh, dyh, dxdyh + character(len=1) :: debug_str + + is = G%isc ; ie = G%iec ; js = G%jsc-1 ; je = G%jec+1 ; isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + i_off = G%idg_offset ; j_off = G%jdg_offset + + do i=isd+2,ied-2 + if (((i+i_off) <= G%domain%niglobal+G%domain%nihalo) .AND. & + ((i+i_off) >= G%domain%nihalo+1)) then ! based on mehmet's code - only if btw east & west boundaries + + stencil(:) = -1 + + do j=js,je + + if (((j+j_off) <= G%domain%njglobal+G%domain%njhalo) .AND. & + ((j+j_off) >= G%domain%njhalo+1)) then + + if (j+j_off == G%domain%njhalo+1) then + at_south_bdry=.true. + else + at_south_bdry=.false. + endif + if (j+j_off == G%domain%njglobal+G%domain%njhalo) then + at_north_bdry=.true. + else + at_north_bdry=.false. + endif + + if (hmask(i,j) == 1) then + dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) + h_after_vflux(i,j) = h_after_uflux(i,j) + + stencil(:) = h_after_uflux(i,j-2:j+2) ! fine as long has ny_halo >= 2 + flux_diff_cell = 0 + + ! 1ST DO south FACE + + if (CS%v_face_mask(i,j-1) == 4.) then + + flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_flux_bdry_val(i,j-1) * & + CS%t_bdry_val(i,j-1)/ dxdyh +! assume no flux bc for temp +! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*CS%t_bdry_val(i,j-1) / dxdyh + + else + + ! get u-velocity at center of left face + v_face = 0.5 * (CS%v_shelf(i-1,j-1) + CS%v_shelf(i,j-1)) + + if (v_face > 0) then !flux is into cell - we need info from h(j-2), h(j-1) if available + + ! i may not cover all the cases.. but i cover the realistic ones + + if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then ! at western bdry but there is a + ! thickness bdry condition, and the stencil contains it + flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(-1) / dxdyh + + elseif (hmask(i,j-1) * hmask(i,j-2) == 1) then ! h(j-2) and h(j-1) are valid + + phi = slope_limiter (stencil(-1)-stencil(-2), stencil(0)-stencil(-1)) + flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * & + (stencil(-1) - phi * (stencil(-1)-stencil(0))/2) + + else ! h(j-1) is valid + ! (o.w. flux would most likely be out of cell) + ! but h(j-2) is not + flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * stencil(-1) + endif + + elseif (v_face < 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available + + if (hmask(i,j-1) * hmask(i,j+1) == 1) then ! h(j-1) and h(j+1) are both valid + phi = slope_limiter (stencil(0)-stencil(1), stencil(-1)-stencil(0)) + flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * & + (stencil(0) - phi * (stencil(0)-stencil(-1))/2) + else + flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * stencil(0) + + if ((hmask(i,j-1) == 0) .OR. (hmask(i,j-1) == 2)) then + flux_enter(i,j-1,4) = ABS(v_face) * dyh * time_step * stencil(0) + endif + + endif + + endif + + endif + + ! NEXT DO north FACE + + if (CS%v_face_mask(i,j+1) == 4.) then + + flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_flux_bdry_val(i,j+1) *& + CS%t_bdry_val(i,j+1)/ dxdyh +! assume no flux bc for temp +! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*CS%t_bdry_val(i,j+1) / dxdyh + + else + + ! get u-velocity at center of right face + v_face = 0.5 * (CS%v_shelf(i-1,j) + CS%v_shelf(i,j)) + + if (v_face < 0) then !flux is into cell - we need info from h(j+2), h(j+1) if available + + if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then ! at eastern bdry but there is a + ! thickness bdry condition, and the stencil contains it + flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(1) / dxdyh + elseif (hmask(i,j+1) * hmask(i,j+2) == 1) then ! h(j+2) and h(j+1) are valid + phi = slope_limiter (stencil(1)-stencil(2), stencil(0)-stencil(1)) + flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * & + (stencil(1) - phi * (stencil(1)-stencil(0))/2) + else ! h(j+1) is valid + ! (o.w. flux would most likely be out of cell) + ! but h(j+2) is not + flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * stencil(1) + endif + + elseif (v_face > 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available + + if (hmask(i,j-1) * hmask(i,j+1) == 1) then ! h(j-1) and h(j+1) are both valid + phi = slope_limiter (stencil(0)-stencil(-1), stencil(1)-stencil(0)) + flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * & + (stencil(0) - phi * (stencil(0)-stencil(1))/2) + else ! h(j+1) is valid + ! (o.w. flux would most likely be out of cell) + ! but h(j+2) is not + flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * stencil(0) + if ((hmask(i,j+1) == 0) .OR. (hmask(i,j+1) == 2)) then + flux_enter(i,j+1,3) = ABS(v_face) * dxh * time_step * stencil(0) + endif + endif + + endif + + endif + + h_after_vflux(i,j) = h_after_vflux(i,j) + flux_diff_cell + + elseif ((hmask(i,j) == 0) .OR. (hmask(i,j) == 2)) then + + if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then + v_face = 0.5 * (CS%v_shelf(i-1,j-1) + CS%v_shelf(i,j-1)) + flux_enter(i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * CS%t_bdry_val(i,j-1)* & + CS%thickness_bdry_val(i,j-1) + elseif (CS%v_face_mask(i,j-1) == 4.) then + flux_enter(i,j,3) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1)*CS%t_bdry_val(i,j-1) +! assume no flux bc for temp +! flux_enter(i,j,3) = G%dxh(i,j) * time_step * CS%v_shelf(i,j)*CS%t_bdry_val(i,j-1) + + endif + + if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then + v_face = 0.5 * (CS%v_shelf(i-1,j) + CS%v_shelf(i,j)) + flux_enter(i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * CS%t_bdry_val(i,j+1)* & + CS%thickness_bdry_val(i,j+1) + elseif (CS%v_face_mask(i,j+1) == 4.) then + flux_enter(i,j,4) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1)*CS%t_bdry_val(i,j+1) +! assume no flux bc for temp +! flux_enter(i,j,4) = G%dxh(i,j) * time_step * CS%v_shelf(i,j)*CS%t_bdry_val(i,j+1) + endif + +! if ((j == js) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j-1) == 1)) then + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered + ! hmask(i,j) = 2 + ! elseif ((j == je) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j+1) == 1)) then + ! this is solely for the purposes of keeping the mask consistent while advancing the + ! front without having to call pass_var - if cell is empty and cell to left is + ! ice-covered then this cell will become partly covered +! hmask(i,j) = 2 +! endif + + endif + endif + enddo ! j loop + endif + enddo ! i loop + +end subroutine ice_shelf_advect_temp_y + +!> \namespace mom_ice_shelf_dynamics +!! +!! \section section_ICE_SHELF_dynamics +!! +!! This module implements the thermodynamic aspects of ocean/ice-shelf +!! inter-actions, along with a crude placeholder for a later implementation of full +!! ice shelf dynamics, all using the MOM framework and coding style. +!! +!! Derived from code by Chris Little, early 2010. +!! +!! The ice-sheet dynamics subroutines do the following: +!! initialize_shelf_mass - Initializes the ice shelf mass distribution. +!! - Initializes h_shelf, h_mask, area_shelf_h +!! - CURRENTLY: initializes mass_shelf as well, but this is unnecessary, as mass_shelf is initialized based on +!! h_shelf and density_ice immediately afterwards. Possibly subroutine should be renamed +!! update_shelf_mass - updates ice shelf mass via netCDF file +!! USER_update_shelf_mass (TODO). +!! ice_shelf_solve_outer - Orchestrates the calls to calculate the shelf +!! - outer loop calls ice_shelf_solve_inner +!! stresses and checks for error tolerances. +!! Max iteration count for outer loop currently fixed at 100 iteration +!! - tolerance (and error evaluation) can be set through input file +!! - updates u_shelf, v_shelf, ice_visc, taub_beta_eff +!! ice_shelf_solve_inner - Conjugate Gradient solve of matrix solve for ice_shelf_solve_outer +!! - Jacobi Preconditioner - basically diagonal of matrix (not sure if it is effective at all) +!! - modifies u_shelf and v_shelf only +!! - max iteration count can be set through input file +!! - tolerance (and error evaluation) can be set through input file +!! (ISSUE: Too many sum_across_PEs calls?) +!! calc_shelf_driving_stress - Determine the driving stresses using h_shelf, (water) column thickness, bathymetry +!! - does not modify any permanent arrays +!! init_boundary_values - +!! bilinear_shape_functions - shape function for FEM solve using (convex) quadrilateral elements and +!! bilinear nodal basis +!! calc_shelf_visc - Glen's law viscosity and nonlinear sliding law (called by ice_shelf_solve_outer) +!! apply_boundary_values - same as CG_action, but input is zero except for dirichlet bdry conds +!! CG_action - Effect of matrix (that is never explicitly constructed) +!! on vector space of Degrees of Freedom (DoFs) in velocity solve +!! ice_shelf_advect - Given the melt rate and velocities, it advects the ice shelf THICKNESS +!! - modified h_shelf, area_shelf_h, hmask +!! (maybe should updater mass_shelf as well ???) +!! ice_shelf_advect_thickness_x, ice_shelf_advect_thickness_y - These +!! subroutines determine the mass fluxes through the faces. +!! (ISSUE: duplicative flux calls for shared faces?) +!! ice_shelf_advance_front - Iteratively determine the ice-shelf front location. +!! - IF ice_shelf_advect_thickness_x,y are modified to avoid +!! dupe face processing, THIS NEEDS TO BE MODIFIED TOO +!! as it depends on arrays modified in those functions +!! (if in doubt consult DNG) +!! update_velocity_masks - Controls which elements of u_shelf and v_shelf are considered DoFs in linear solve +!! solo_time_step - called only in ice-only mode. +!! shelf_calc_flux - after melt rate & fluxes are calculated, ice dynamics are done. currently mass_shelf is +!! updated immediately after ice_shelf_advect. +!! +!! +!! NOTES: be aware that hmask(:,:) has a number of functions; it is used for front advancement, +!! for subroutines in the velocity solve, and for thickness boundary conditions (this last one may be removed). +!! in other words, interfering with its updates will have implications you might not expect. +!! +!! Overall issues: Many variables need better documentation and units and the +!! subgrid on which they are discretized. +!! +!! \subsection section_ICE_SHELF_equations ICE_SHELF equations +!! +!! The three fundamental equations are: +!! Heat flux +!! \f[ \qquad \rho_w C_{pw} \gamma_T (T_w - T_b) = \rho_i \dot{m} L_f \f] +!! Salt flux +!! \f[ \qquad \rho_w \gamma_s (S_w - S_b) = \rho_i \dot{m} S_b \f] +!! Freezing temperature +!! \f[ \qquad T_b = a S_b + b + c P \f] +!! +!! where .... +!! +!! \subsection section_ICE_SHELF_references References +!! +!! Asay-Davis, Xylar S., Stephen L. Cornford, Benjamin K. Galton-Fenzi, Rupert M. Gladstone, G. Hilmar Gudmundsson, +!! David M. Holland, Paul R. Holland, and Daniel F. Martin. Experimental design for three interrelated marine ice sheet +!! and ocean model intercomparison projects: MISMIP v. 3 (MISMIP+), ISOMIP v. 2 (ISOMIP+) and MISOMIP v. 1 (MISOMIP1). +!! Geoscientific Model Development 9, no. 7 (2016): 2471. +!! +!! Goldberg, D. N., et al. Investigation of land ice-ocean interaction with a fully coupled ice-ocean model: 1. +!! Model description and behavior. Journal of Geophysical Research: Earth Surface 117.F2 (2012). +!! +!! Goldberg, D. N., et al. Investigation of land ice-ocean interaction with a fully coupled ice-ocean model: 2. +!! Sensitivity to external forcings. Journal of Geophysical Research: Earth Surface 117.F2 (2012). +!! +!! Holland, David M., and Adrian Jenkins. Modeling thermodynamic ice-ocean interactions at the base of an ice shelf. +!! Journal of Physical Oceanography 29.8 (1999): 1787-1800. + +end module MOM_ice_shelf_dynamics From bfcb4f7622bd4217c6629914541626420fabaa95 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 27 May 2018 15:16:58 -0400 Subject: [PATCH 0299/1072] Cleaned up the indenting in MOM_ice_shelf.F90 Fixed a number of instances in MOM_ice_shelf.F90 that did not use the MOM6 standard 2-point indentation. Also removed some trailing white space. All answers are bitwise identical. --- src/ice_shelf/MOM_ice_shelf.F90 | 211 +++++++++-------------- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 4 +- 2 files changed, 84 insertions(+), 131 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 1f8d0ada05..701aade3dd 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -646,22 +646,22 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) endif call enable_averaging(time_step,Time,CS%diag) - if (CS%id_shelf_mass > 0) call post_data(CS%id_shelf_mass, ISS%mass_shelf, CS%diag) - if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, ISS%area_shelf_h, CS%diag) - if (CS%id_ustar_shelf > 0) call post_data(CS%id_ustar_shelf, fluxes%ustar_shelf, CS%diag) - if (CS%id_melt > 0) call post_data(CS%id_melt, fluxes%iceshelf_melt, CS%diag) - if (CS%id_thermal_driving > 0) call post_data(CS%id_thermal_driving, (state%sst-ISS%tfreeze), CS%diag) - if (CS%id_Sbdry > 0) call post_data(CS%id_Sbdry, Sbdry, CS%diag) - if (CS%id_haline_driving > 0) call post_data(CS%id_haline_driving, haline_driving, CS%diag) - if (CS%id_mass_flux > 0) call post_data(CS%id_mass_flux, mass_flux, CS%diag) - if (CS%id_u_ml > 0) call post_data(CS%id_u_ml, state%u, CS%diag) - if (CS%id_v_ml > 0) call post_data(CS%id_v_ml, state%v, CS%diag) - if (CS%id_tfreeze > 0) call post_data(CS%id_tfreeze, ISS%tfreeze, CS%diag) - if (CS%id_tfl_shelf > 0) call post_data(CS%id_tfl_shelf, ISS%tflux_shelf, CS%diag) - if (CS%id_exch_vel_t > 0) call post_data(CS%id_exch_vel_t, exch_vel_t, CS%diag) - if (CS%id_exch_vel_s > 0) call post_data(CS%id_exch_vel_s, exch_vel_s, CS%diag) - if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf,ISS%h_shelf,CS%diag) - if (CS%id_h_mask > 0) call post_data(CS%id_h_mask,ISS%hmask,CS%diag) + if (CS%id_shelf_mass > 0) call post_data(CS%id_shelf_mass, ISS%mass_shelf, CS%diag) + if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, ISS%area_shelf_h, CS%diag) + if (CS%id_ustar_shelf > 0) call post_data(CS%id_ustar_shelf, fluxes%ustar_shelf, CS%diag) + if (CS%id_melt > 0) call post_data(CS%id_melt, fluxes%iceshelf_melt, CS%diag) + if (CS%id_thermal_driving > 0) call post_data(CS%id_thermal_driving, (state%sst-ISS%tfreeze), CS%diag) + if (CS%id_Sbdry > 0) call post_data(CS%id_Sbdry, Sbdry, CS%diag) + if (CS%id_haline_driving > 0) call post_data(CS%id_haline_driving, haline_driving, CS%diag) + if (CS%id_mass_flux > 0) call post_data(CS%id_mass_flux, mass_flux, CS%diag) + if (CS%id_u_ml > 0) call post_data(CS%id_u_ml, state%u, CS%diag) + if (CS%id_v_ml > 0) call post_data(CS%id_v_ml, state%v, CS%diag) + if (CS%id_tfreeze > 0) call post_data(CS%id_tfreeze, ISS%tfreeze, CS%diag) + if (CS%id_tfl_shelf > 0) call post_data(CS%id_tfl_shelf, ISS%tflux_shelf, CS%diag) + if (CS%id_exch_vel_t > 0) call post_data(CS%id_exch_vel_t, exch_vel_t, CS%diag) + if (CS%id_exch_vel_s > 0) call post_data(CS%id_exch_vel_s, exch_vel_s, CS%diag) + if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf,ISS%h_shelf,CS%diag) + if (CS%id_h_mask > 0) call post_data(CS%id_h_mask,ISS%hmask,CS%diag) call disable_averaging(CS%diag) call cpu_clock_end(id_clock_shelf) @@ -696,16 +696,13 @@ subroutine change_thickness_using_melt(ISS, G, time_step, fluxes, rho_ice, debug if (associated(fluxes%salt_flux)) fluxes%salt_flux(i,j) = 0.0 if (ISS%water_flux(i,j) / rho_ice * time_step < ISS%h_shelf(i,j)) then - ISS%h_shelf(i,j) = ISS%h_shelf(i,j) - ISS%water_flux(i,j) / rho_ice * time_step + ISS%h_shelf(i,j) = ISS%h_shelf(i,j) - ISS%water_flux(i,j) / rho_ice * time_step else - ! the ice is about to melt away - ! in this case set thickness, area, and mask to zero - ! NOTE: not mass conservative - ! should maybe scale salt & heat flux for this cell - - ISS%h_shelf(i,j) = 0.0 - ISS%hmask(i,j) = 0.0 - ISS%area_shelf_h(i,j) = 0.0 + ! the ice is about to melt away, so set thickness, area, and mask to zero + ! NOTE: this is not mass conservative should maybe scale salt & heat flux for this cell + ISS%h_shelf(i,j) = 0.0 + ISS%hmask(i,j) = 0.0 + ISS%area_shelf_h(i,j) = 0.0 endif endif enddo ; enddo @@ -934,55 +931,53 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) mean_melt_flux = 0.0; sponge_area = 0.0 do j=js,je ; do i=is,ie - frac_area = fluxes%frac_shelf_h(i,j) - if (frac_area > 0.0) then - mean_melt_flux = mean_melt_flux + (ISS%water_flux(i,j)) * ISS%area_shelf_h(i,j) - endif - - if (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then - sponge_area = sponge_area + G%areaT(i,j) - endif + frac_area = fluxes%frac_shelf_h(i,j) + if (frac_area > 0.0) & + mean_melt_flux = mean_melt_flux + (ISS%water_flux(i,j)) * ISS%area_shelf_h(i,j) + + !### These hard-coded limits need to be corrected. They are inappropriate here. + if (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then + sponge_area = sponge_area + G%areaT(i,j) + endif enddo ; enddo ! take into account changes in mass (or thickness) when imposing ice shelf mass if (CS%override_shelf_movement .and. CS%mass_from_file) then - t0 = time_type_to_real(CS%Time) - CS%time_step - - ! just compute changes in mass after first time step - if (t0>0.0) then - Time0 = real_to_time_type(t0) - last_hmask(:,:) = ISS%hmask(:,:) ; last_area_shelf_h(:,:) = ISS%area_shelf_h(:,:) - call time_interp_external(CS%id_read_mass, Time0, last_mass_shelf) - last_h_shelf = last_mass_shelf/CS%density_ice - - ! apply calving - if (CS%min_thickness_simple_calve > 0.0) then - call ice_shelf_min_thickness_calve(G, last_h_shelf, last_area_shelf_h, last_hmask, & - CS%min_thickness_simple_calve) - ! convert to mass again - last_mass_shelf = last_h_shelf * CS%density_ice - endif - - shelf_mass0 = 0.0; shelf_mass1 = 0.0 - ! get total ice shelf mass at (Time-dt) and (Time), in kg - do j=js,je ; do i=is,ie - ! just floating shelf (0.1 is a threshold for min ocean thickness) - if (((1.0/CS%density_ocean_avg)*state%ocean_mass(i,j) > 0.1) .and. & - (ISS%area_shelf_h(i,j) > 0.0)) then - - shelf_mass0 = shelf_mass0 + (last_mass_shelf(i,j) * ISS%area_shelf_h(i,j)) - shelf_mass1 = shelf_mass1 + (ISS%mass_shelf(i,j) * ISS%area_shelf_h(i,j)) + t0 = time_type_to_real(CS%Time) - CS%time_step + + ! just compute changes in mass after first time step + if (t0>0.0) then + Time0 = real_to_time_type(t0) + last_hmask(:,:) = ISS%hmask(:,:) ; last_area_shelf_h(:,:) = ISS%area_shelf_h(:,:) + call time_interp_external(CS%id_read_mass, Time0, last_mass_shelf) + last_h_shelf = last_mass_shelf/CS%density_ice + + ! apply calving + if (CS%min_thickness_simple_calve > 0.0) then + call ice_shelf_min_thickness_calve(G, last_h_shelf, last_area_shelf_h, last_hmask, & + CS%min_thickness_simple_calve) + ! convert to mass again + last_mass_shelf = last_h_shelf * CS%density_ice + endif - endif - enddo ; enddo - call sum_across_PEs(shelf_mass0); call sum_across_PEs(shelf_mass1) - delta_mass_shelf = (shelf_mass1 - shelf_mass0)/CS%time_step + shelf_mass0 = 0.0; shelf_mass1 = 0.0 + ! get total ice shelf mass at (Time-dt) and (Time), in kg + do j=js,je ; do i=is,ie + ! just floating shelf (0.1 is a threshold for min ocean thickness) + if (((1.0/CS%density_ocean_avg)*state%ocean_mass(i,j) > 0.1) .and. & + (ISS%area_shelf_h(i,j) > 0.0)) then + shelf_mass0 = shelf_mass0 + (last_mass_shelf(i,j) * ISS%area_shelf_h(i,j)) + shelf_mass1 = shelf_mass1 + (ISS%mass_shelf(i,j) * ISS%area_shelf_h(i,j)) + endif + enddo ; enddo + call sum_across_PEs(shelf_mass0); call sum_across_PEs(shelf_mass1) + delta_mass_shelf = (shelf_mass1 - shelf_mass0)/CS%time_step ! delta_mass_shelf = (shelf_mass1 - shelf_mass0)* & ! (rho_fw/CS%density_ice)/CS%time_step ! if (is_root_pe()) write(*,*)'delta_mass_shelf',delta_mass_shelf - else! first time step - delta_mass_shelf = 0.0 - endif + else! first time step + delta_mass_shelf = 0.0 + endif else ! ice shelf mass does not change delta_mass_shelf = 0.0 endif @@ -995,12 +990,12 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) ! apply fluxes do j=js,je ; do i=is,ie - ! Note the following is hard coded for ISOMIP - if (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then - fluxes%vprec(i,j) = -mean_melt_flux * CS%density_ice/1000. ! evap is negative - fluxes%sens(i,j) = fluxes%vprec(i,j) * CS%Cp * CS%T0 ! W /m^2 - fluxes%salt_flux(i,j) = fluxes%vprec(i,j) * CS%S0*1.0e-3 ! kg (salt)/(m^2 s) - endif + ! Note the following is hard coded for ISOMIP + if (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then + fluxes%vprec(i,j) = -mean_melt_flux * CS%density_ice/1000. ! evap is negative + fluxes%sens(i,j) = fluxes%vprec(i,j) * CS%Cp * CS%T0 ! W /m^2 + fluxes%salt_flux(i,j) = fluxes%vprec(i,j) * CS%S0*1.0e-3 ! kg (salt)/(m^2 s) + endif enddo ; enddo if (CS%DEBUG) then @@ -1139,7 +1134,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl "Depth above which the melt is set to zero (it must be >= 0) \n"//& "Default value won't affect the solution.", default=0.0) if (CS%cutoff_depth < 0.) & - call MOM_error(WARNING,"Initialize_ice_shelf: MELTING_CUTOFF_DEPTH must be >= 0.") + call MOM_error(WARNING,"Initialize_ice_shelf: MELTING_CUTOFF_DEPTH must be >= 0.") call get_param(param_file, mdl, "CONST_SEA_LEVEL", CS%constant_sea_level, & "If true, apply evaporative, heat and salt fluxes in \n"//& @@ -1289,7 +1284,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call get_param(param_file, mdl, "MIN_THICKNESS_SIMPLE_CALVE", & CS%min_thickness_simple_calve, & "Min thickness rule for the very simple calving law",& - units="m", default=0.0) + units="m", default=0.0) call get_param(param_file, mdl, "USTAR_SHELF_BG", CS%ustar_bg, & "The minimum value of ustar under ice sheves.", units="m s-1", & @@ -1391,7 +1386,6 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if (CS%min_thickness_simple_calve > 0.0) & call ice_shelf_min_thickness_calve(G, ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, & CS%min_thickness_simple_calve) - endif endif @@ -1573,14 +1567,8 @@ subroutine initialize_shelf_mass(G, param_file, CS, ISS, new_sim) filename = trim(slasher(inputdir))//trim(shelf_file) call log_param(param_file, mdl, "INPUTDIR/SHELF_FILE", filename) - if (CS%DEBUG) then - CS%id_read_mass = init_external_field(filename,shelf_mass_var, & - domain=G%Domain%mpp_domain,verbose=.true.) - else - CS%id_read_mass = init_external_field(filename,shelf_mass_var, & - domain=G%Domain%mpp_domain) - - endif + CS%id_read_mass = init_external_field(filename, shelf_mass_var, & + domain=G%Domain%mpp_domain, verbose=CS%debug) if (read_shelf_area) then call get_param(param_file, mdl, "SHELF_AREA_VAR", shelf_area_var, & @@ -1588,7 +1576,7 @@ subroutine initialize_shelf_mass(G, param_file, CS, ISS, new_sim) default="shelf_area") CS%id_read_area = init_external_field(filename,shelf_area_var, & - domain=G%Domain%mpp_domain) + domain=G%Domain%mpp_domain) endif if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & @@ -1624,13 +1612,13 @@ subroutine update_shelf_mass(G, CS, ISS, Time) call time_interp_external(CS%id_read_mass, Time, ISS%mass_shelf) do j=js,je ; do i=is,ie - ISS%area_shelf_h(i,j) = 0.0 - ISS%hmask(i,j) = 0. - if (ISS%mass_shelf(i,j) > 0.0) then - ISS%area_shelf_h(i,j) = G%areaT(i,j) - ISS%h_shelf(i,j) = ISS%mass_shelf(i,j)/CS%density_ice - ISS%hmask(i,j) = 1. - endif + ISS%area_shelf_h(i,j) = 0.0 + ISS%hmask(i,j) = 0. + if (ISS%mass_shelf(i,j) > 0.0) then + ISS%area_shelf_h(i,j) = G%areaT(i,j) + ISS%h_shelf(i,j) = ISS%mass_shelf(i,j)/CS%density_ice + ISS%hmask(i,j) = 1. + endif enddo ; enddo !call USER_update_shelf_mass(ISS%mass_shelf, ISS%area_shelf_h, ISS%h_shelf, & @@ -1679,8 +1667,7 @@ subroutine ice_shelf_end(CS) call ice_shelf_state_end(CS%ISS) - if (CS%active_shelf_dynamics) & - call ice_shelf_dyn_end(CS%dCS) + if (CS%active_shelf_dynamics) call ice_shelf_dyn_end(CS%dCS) deallocate(CS) @@ -1751,7 +1738,7 @@ subroutine solo_time_step(CS, time_step, nsteps, Time, min_time_step_in) coupled_GL = .false. call update_ice_shelf(dCS, ISS, G, time_step_int, Time, must_update_vel=update_ice_vel) - + call enable_averaging(time_step,Time,CS%diag) if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, ISS%area_shelf_h, CS%diag) if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf,ISS%h_shelf,CS%diag) @@ -1779,43 +1766,9 @@ end subroutine solo_time_step !! h_shelf and density_ice immediately afterwards. Possibly subroutine should be renamed !! update_shelf_mass - updates ice shelf mass via netCDF file !! USER_update_shelf_mass (TODO). -!! ice_shelf_solve_outer - Orchestrates the calls to calculate the shelf -!! - outer loop calls ice_shelf_solve_inner -!! stresses and checks for error tolerances. -!! Max iteration count for outer loop currently fixed at 100 iteration -!! - tolerance (and error evaluation) can be set through input file -!! - updates u_shelf, v_shelf, ice_visc, taub_beta_eff -!! ice_shelf_solve_inner - Conjugate Gradient solve of matrix solve for ice_shelf_solve_outer -!! - Jacobi Preconditioner - basically diagonal of matrix (not sure if it is effective at all) -!! - modifies u_shelf and v_shelf only -!! - max iteration count can be set through input file -!! - tolerance (and error evaluation) can be set through input file -!! (ISSUE: Too many sum_across_PEs calls?) -!! calc_shelf_driving_stress - Determine the driving stresses using h_shelf, (water) column thickness, bathymetry -!! - does not modify any permanent arrays -!! init_boundary_values - -!! bilinear_shape_functions - shape function for FEM solve using (convex) quadrilateral elements and -!! bilinear nodal basis -!! calc_shelf_visc - Glen's law viscosity and nonlinear sliding law (called by ice_shelf_solve_outer) -!! apply_boundary_values - same as CG_action, but input is zero except for dirichlet bdry conds -!! CG_action - Effect of matrix (that is never explicitly constructed) -!! on vector space of Degrees of Freedom (DoFs) in velocity solve -!! ice_shelf_advect - Given the melt rate and velocities, it advects the ice shelf THICKNESS -!! - modified h_shelf, area_shelf_h, hmask -!! (maybe should updater mass_shelf as well ???) -!! ice_shelf_advect_thickness_x, ice_shelf_advect_thickness_y - These -!! subroutines determine the mass fluxes through the faces. -!! (ISSUE: duplicative flux calls for shared faces?) -!! ice_shelf_advance_front - Iteratively determine the ice-shelf front location. -!! - IF ice_shelf_advect_thickness_x,y are modified to avoid -!! dupe face processing, THIS NEEDS TO BE MODIFIED TOO -!! as it depends on arrays modified in those functions -!! (if in doubt consult DNG) -!! update_velocity_masks - Controls which elements of u_shelf and v_shelf are considered DoFs in linear solve !! solo_time_step - called only in ice-only mode. !! shelf_calc_flux - after melt rate & fluxes are calculated, ice dynamics are done. currently mass_shelf is -!! updated immediately after ice_shelf_advect. -!! +!! updated immediately after ice_shelf_advect in fully dynamic mode. !! !! NOTES: be aware that hmask(:,:) has a number of functions; it is used for front advancement, !! for subroutines in the velocity solve, and for thickness boundary conditions (this last one may be removed). diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 992b3d2f6c..bf8b6ddba4 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -384,7 +384,7 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, diag, new_sim, call get_param(param_file, mdl, "MIN_THICKNESS_SIMPLE_CALVE", & CS%min_thickness_simple_calve, & "Min thickness rule for the VERY simple calving law",& - units="m", default=0.0) + units="m", default=0.0) ! Allocate memory in the ice shelf dynamics control structure that was not ! previously allocated for registration for restarts. @@ -601,7 +601,7 @@ subroutine update_ice_shelf(CS, ISS, G, time_step, Time, ocean_mass, coupled_gro integer :: iters logical :: update_ice_vel, coupled_GL - + update_ice_vel = .false. if (present(must_update_vel)) update_ice_vel = must_update_vel From 06565ec01c1d6b42a611d7d0b8d68b43cb9fc2c9 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 27 May 2018 18:11:42 -0600 Subject: [PATCH 0300/1072] major refactor of mct interface - and addition -f MOM_ocean_model.F90 and MOM_surface_forcing.F90 to mct and nuopc cap codes --- config_src/mct_driver/MOM_ocean_model.F90 | 1742 +++++++++++++ config_src/mct_driver/MOM_surface_forcing.F90 | 1432 +++++++++++ config_src/mct_driver/ocn_comp_mct.F90 | 2190 ++--------------- config_src/mct_driver/ocn_cpl_indices.F90 | 183 ++ config_src/nuopc_driver/MOM_ocean_model.F90 | 1181 +++++++++ .../nuopc_driver/MOM_surface_forcing.F90 | 1415 +++++++++++ config_src/nuopc_driver/mom_cap.F90 | 19 +- 7 files changed, 6182 insertions(+), 1980 deletions(-) create mode 100644 config_src/mct_driver/MOM_ocean_model.F90 create mode 100644 config_src/mct_driver/MOM_surface_forcing.F90 create mode 100644 config_src/mct_driver/ocn_cpl_indices.F90 create mode 100644 config_src/nuopc_driver/MOM_ocean_model.F90 create mode 100644 config_src/nuopc_driver/MOM_surface_forcing.F90 diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 new file mode 100644 index 0000000000..80395d4a87 --- /dev/null +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -0,0 +1,1742 @@ +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 +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, fill_symmetric_edges +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_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, 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_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 : 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 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 + +! 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 + +#ifdef _USE_GENERIC_TRACER +use MOM_generic_tracer, only : MOM_generic_tracer_fluxes_accumulate +#endif + +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 ocn_export + +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. + 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. + + integer :: stagger = -999 !< The staggering relative to the tracer points + !! of the two velocity components. Valid entries + !! include AGRID, BGRID_NE, CGRID_NE, BGRID_SW, and CGRID_SW, + !! corresponding to the community-standard Arakawa notation. + !! (These are named integers taken from mpp_parameter_mod.) + !! Following MOM, this is BGRID_NE by default when the ocean + !! is initialized, but here it is set to -999 so that a + !! global max across ocean and non-ocean processors can be + !! used to determine its value. + real, pointer, dimension(:,:) :: & + t_surf => NULL(), & !< SST on t-cell (degrees Kelvin) + s_surf => NULL(), & !< SSS on t-cell (psu) + u_surf => NULL(), & !< i-velocity at the locations indicated by stagger, m/s. + v_surf => NULL(), & !< j-velocity at the locations indicated by stagger, m/s. + sea_lev => NULL(), & !< Sea level in m after correction for surface pressure, + !! i.e. dzt(1) + eta_t + patm/rho0/grav (m) + frazil =>NULL(), & !< Accumulated heating (in Joules/m^2) from frazil + !! formation in the ocean. + area => NULL() !< cell area of the ocean surface, in m2. + 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. + integer, dimension(2) :: axes = 0 !< Axis numbers that are available + ! 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. + 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 :: 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 + !! restore sst to a specified value. + real :: press_to_z !< A conversion factor between pressure and ocean + !! depth in m, usually 1/(rho_0*g), in m Pa-1. + real :: C_p !< The heat capacity of seawater, in J K-1 kg-1. + logical :: offline_tracer_mode = .false. !< If false, use the model in prognostic mode + !! with the barotropic and baroclinic dynamics, thermodynamics, + !! etc. stepped forward integrated in time. + !! If true, all of the above are bypassed with all + !! 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 + !! ocean forcing fields for when multiple coupled + !! timesteps are taken per thermodynamic step. + 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(MOM_control_struct), pointer :: MOM_CSp => NULL() + type(surface_forcing_CS), pointer :: forcing_CSp => NULL() + type(MOM_restart_CS), pointer :: & + restart_CSp => NULL() !< A pointer set to the restart control structure + !! that will be used for MOM restart files. + type(diag_ctrl), pointer :: & + 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 +!! for restarts and reading restart files if appropriate. +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). + 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. + type(time_type), intent(in) :: Time_init !< The start time for the coupled model's calendar + type(time_type), intent(in) :: Time_in !< The time at which to initialize the ocean model. + 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, 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, in kg m-3. + real :: G_Earth !< The gravitational acceleration in m s-2. + !! This include declares and sets the variable "version". +#include "version_variable.h" + character(len=40) :: 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 + + call callTree_enter("ocean_model_init(), ocn_comp_mct.F90") + if (associated(OS)) then + call MOM_error(WARNING, "ocean_model_init called with an associated "// & + "ocean_state_type structure. Model is already initialized.") + return + endif + allocate(OS) + + OS%is_ocean_pe = Ocean_sfc%is_ocean_pe + if (.not.OS%is_ocean_pe) return + + 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, C_p=OS%fluxes%C_p, & + use_temp=use_temperature) + OS%C_p = OS%fluxes%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, "RESTART_CONTROL", OS%Restart_control, & + "An integer whose bits encode which restart files are \n"//& + "written. Add 2 (bit 1) for a time-stamped file, and odd \n"//& + "(bit 0) for a non-time-stamped file. A restart file \n"//& + "will be saved at the end of the run segment for any \n"//& + "non-negative value.", default=1) + call get_param(param_file, 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', '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 + + call get_param(param_file, mdl, "RESTORE_SALINITY",OS%restore_salinity, & + "If true, the coupled driver will add a globally-balanced \n"//& + "fresh-water flux that drives sea-surface salinity \n"//& + "toward specified values.", default=.false.) + call get_param(param_file, mdl, "RESTORE_TEMPERATURE",OS%restore_temp, & + "If true, the coupled driver will add a \n"//& + "heat flux that drives sea-surface temperauture \n"//& + "toward specified values.", default=.false.) + call get_param(param_file, mdl, "RHO_0", Rho0, & + "The mean ocean density used with BOUSSINESQ true to \n"//& + "calculate accelerations and the mass for conservation \n"//& + "properties, or with BOUSSINSEQ false to convert some \n"//& + "parameters from vertical units of m to kg m-2.", & + units="kg m-3", default=1035.0) + call get_param(param_file, mdl, "G_EARTH", G_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) + + 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, & + "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 \n"//& + "below berg are set to zero. Not applied for negative \n"//& + " values.", units="non-dim", default=-1.0) + endif + + OS%press_to_z = 1.0/(Rho0*G_Earth) + + ! 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) + + call surface_forcing_init(Time_in, OS%grid, param_file, OS%diag, & + OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) + + if (OS%use_ice_shelf) then + call initialize_ice_shelf(param_file, OS%grid, OS%Time, OS%ice_shelf_CSp, & + OS%diag, OS%forces, OS%fluxes) + 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.) + 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, & + gas_fields_ocn=gas_fields_ocn) + else + call initialize_ocean_public_type(OS%grid%Domain%mpp_domain, Ocean_sfc, & + OS%diag, gas_fields_ocn=gas_fields_ocn) + endif + + ! 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 extract_surface_state(OS%MOM_CSp, OS%sfc_state) + + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + endif + + call close_param_file(param_file) + call diag_mediator_close_registration(OS%diag) + + 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. +subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, & + Ocean_coupling_time_step, x2o_o, ind, sw_decomp, & + c1, c2, c3, c4) + + type(ocean_state_type), pointer :: OS !< Structure containing the internal ocean state + type(ocean_public_type), intent(inout) :: Ocean_sfc !< Structure containing all the publicly + !! visible ocean surface fields after a coupling time step + type(time_type), intent(in) :: time_start_update !< Time at the beginning of the update step + type(time_type), intent(in) :: Ocean_coupling_time_step !< Amount of time over which to + !! advance the ocean + real(kind=8), intent(in) :: x2o_o(:,:) !< Fluxes from coupler to ocean, computed by ocean + type(cpl_indices_type), intent(inout) :: ind !< Structure with MCT attribute vectors and indices + logical, intent(in) :: sw_decomp !< controls if shortwave is + !!decomposed into four components + real(kind=8), optional, intent(in) :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition + + ! 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. + real :: weight !< Flux accumulation weight + real :: time_step !< The time step of a call to step_MOM in seconds. + integer :: secs, days + integer :: is, ie, js, je + + call callTree_enter("update_ocean_model(), ocn_comp_mct.F90") + call get_time(Ocean_coupling_time_step, secs, days) + time_step = 86400.0*real(days) + real(secs) + + if (time_start_update /= OS%Time) then + call MOM_error(WARNING, "update_ocean_model: internal clock does not "//& + "agree with time_start_update argument.") + endif + + if (.not.associated(OS)) then + call MOM_error(FATAL, "update_ocean_model called with an unassociated "// & + "ocean_state_type structure. ocean_model_init must be "// & + "called first to allocate this structure.") + return + endif + + ! 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 + call coupler_type_spawn(Ocean_sfc%fields, OS%sfc_state%tr_fields, & + (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) + + weight = 1.0 + + 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 ocn_import(OS%forces, OS%fluxes, OS%Time, OS%grid, OS%forcing_CSp, & + OS%sfc_state, x2o_o, ind, sw_decomp, c1, c2, c3, c4, & + 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 + + ! Add ice shelf fluxes + if (OS%use_ice_shelf) then + call shelf_calc_flux(OS%sfc_state, OS%forces, OS%fluxes, OS%Time, time_step, OS%Ice_shelf_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) + !endif + + ! Indicate that there are new unused fluxes. + OS%fluxes%fluxes_used = .false. + OS%fluxes%dt_buoy_accum = time_step + + 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 ocn_import(OS%forces, OS%flux_tmp, OS%Time, OS%grid, OS%forcing_CSp, & + OS%sfc_state, x2o_o, ind, sw_decomp, c1, c2, c3, c4, & + OS%restore_salinity, OS%restore_temp) + + if (OS%use_ice_shelf) then + call shelf_calc_flux(OS%sfc_state, OS%forces, OS%flux_tmp, OS%Time, time_step, OS%Ice_shelf_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) + !endif + + ! Accumulate the forcing over time steps + call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, time_step, 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. + 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 + endif + + call set_derived_forcing_fields(OS%forces, OS%fluxes, OS%grid, OS%GV%Rho0) + call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid) + + if (OS%nstep==0) then + call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%restart_CSp) + endif + + call disable_averaging(OS%diag) + 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) + else + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, time_step, OS%MOM_CSp) + 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, OS%fluxes, time_step, OS%grid, & + OS%diag, OS%forcing_CSp%handles) + call disable_averaging(OS%diag) + + if (OS%fluxes%fluxes_used) then + call enable_averaging(OS%fluxes%dt_buoy_accum, OS%Time, OS%diag) + call forcing_diagnostics(OS%fluxes, OS%sfc_state, OS%fluxes%dt_buoy_accum, & + OS%grid, OS%diag, OS%forcing_CSp%handles) + call disable_averaging(OS%diag) + endif + +! Translate state into Ocean. +! 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 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) + 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.) + + if (.not.MOM_state_is_synchronized(OS%MOM_CSp)) & + call MOM_error(WARNING, "End of MOM_main reached with inconsistent "//& + "dynamics and advective times. Additional restart fields "//& + "that have not been coded yet would be required for reproducibility.") + if (.not.OS%fluxes%fluxes_used) call MOM_error(FATAL, "ocean_model_restart "//& + "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 + +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. +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. + + 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. +subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) + type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the + !! internal ocean state (in). + type(time_type), intent(in) :: Time !< The model time at this call, needed for mpp_write calls. + character(len=*), optional, intent(in) :: directory !< An optional directory into which to + !! 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. + character(len=200) :: restart_dir + + if (.not.MOM_state_is_synchronized(OS%MOM_CSp)) & + call MOM_error(WARNING, "ocean_model_save_restart called with inconsistent "//& + "dynamics and advective times. Additional restart fields "//& + "that have not been coded yet would be required for reproducibility.") + if (.not.OS%fluxes%fluxes_used) call MOM_error(FATAL, "ocean_model_save_restart "//& + "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 + + call save_restart(restart_dir, Time, OS%grid, OS%restart_CSp, GV=OS%GV) + + call forcing_save_restart(OS%forcing_CSp, OS%grid, Time, restart_dir) + + if (OS%use_ice_shelf) then + call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir) + endif + +end subroutine ocean_model_save_restart + +!======================================================================= + +!> Initializes domain and state variables contained in the ocean public 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(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 + integer :: xsz, ysz, layout(2) + integer :: isc, iec, jsc, jec + + call mpp_get_layout(input_domain,layout) + call mpp_get_global_domain(input_domain, xsize=xsz, ysize=ysz) + if(PRESENT(maskmap)) then + call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain, maskmap=maskmap) + else + call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain) + endif + call mpp_get_compute_domain(Ocean_sfc%Domain, isc, iec, jsc, jec) + + allocate ( Ocean_sfc%t_surf (isc:iec,jsc:jec), & + Ocean_sfc%s_surf (isc:iec,jsc:jec), & + Ocean_sfc%u_surf (isc:iec,jsc:jec), & + Ocean_sfc%v_surf (isc:iec,jsc:jec), & + Ocean_sfc%sea_lev(isc:iec,jsc:jec), & + Ocean_sfc%area (isc:iec,jsc:jec), & + Ocean_sfc%frazil (isc:iec,jsc:jec)) + + Ocean_sfc%t_surf = 0.0 ! time averaged sst (Kelvin) passed to atmosphere/ice model + Ocean_sfc%s_surf = 0.0 ! time averaged sss (psu) passed to atmosphere/ice models + Ocean_sfc%u_surf = 0.0 ! time averaged u-current (m/sec) passed to atmosphere/ice models + Ocean_sfc%v_surf = 0.0 ! time averaged v-current (m/sec) passed to atmosphere/ice models + Ocean_sfc%sea_lev = 0.0 ! time averaged thickness of top model grid cell (m) plus patm/rho0/grav + Ocean_sfc%frazil = 0.0 ! time accumulated frazil (J/m^2) passed to ice model + Ocean_sfc%area = 0.0 + Ocean_sfc%axes = diag%axesT1%handles !diag axes to be used by coupler tracer flux diagnostics + + if (present(gas_fields_ocn)) then + call coupler_type_spawn(gas_fields_ocn, Ocean_sfc%fields, (/isc,isc,iec,iec/), & + (/jsc,jsc,jec,jec/), suffix = '_ocn', as_needed=.true.) + endif + +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 + 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 mpp_get_compute_domain(Ocean_sfc%Domain, isc_bnd, iec_bnd, & + jsc_bnd, jec_bnd) + if (present(patm)) then + ! Check that the inidicies in patm are (isc_bnd:iec_bnd,jsc_bnd:jec_bnd). + if (.not.present(press_to_z)) call MOM_error(FATAL, & + 'convert_state_to_ocean_type: press_to_z must be present if patm is.') + endif + + i0 = is - isc_bnd ; j0 = js - jsc_bnd + if (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 + 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 + enddo ; enddo + endif + if (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)) + 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) + 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) + 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) + Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + enddo ; enddo + + 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)) + 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)) + 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) + enddo ; enddo + else + write(val_str, '(I8)') Ocean_sfc%stagger + call MOM_error(FATAL, "convert_state_to_ocean_type: "//& + "Ocean_sfc%stagger has the unrecognized value of "//trim(val_str)) + endif + + if (coupler_type_initialized(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) + endif + +end subroutine convert_state_to_ocean_type + +!======================================================================= +! +! +! +! This subroutine extracts the surface properties from the ocean's internal +! state and stores them in the ocean type returned to the calling ice model. +! It has to be separate from the ocean_initialization call because the coupler +! module allocates the space for some of these variables. +! + +subroutine ocean_model_init_sfc(OS, Ocean_sfc) + type(ocean_state_type), pointer :: OS + type(ocean_public_type), intent(inout) :: Ocean_sfc + + integer :: is, ie, js, je + + is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec + call coupler_type_spawn(Ocean_sfc%fields, OS%sfc_state%tr_fields, & + (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) + + call extract_surface_state(OS%MOM_CSp, OS%sfc_state) + + 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 +!! non-ocean PEs, or PEs that have not yet been initialzed, and it can safely +!! be called multiple times. +subroutine ocean_model_flux_init(OS, verbosity) + type(ocean_state_type), optional, pointer :: OS !< An optional pointer to the ocean state, + !! used to figure out if this is an ocean PE that + !! has already been initialized. + integer, optional, intent(in) :: verbosity !< A 0-9 integer indicating a level of verbosity. + + logical :: OS_is_set + integer :: verbose + + OS_is_set = .false. ; if (present(OS)) OS_is_set = associated(OS) + + ! Use this to control the verbosity of output; consider rethinking this logic later. + verbose = 5 ; if (OS_is_set) verbose = 3 + if (present(verbosity)) verbose = verbosity + + call call_tracer_flux_init(verbosity=verbose) + +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). + 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 + !! interfacial compatibility with other models. +! Arguments: OS - A structure containing the internal ocean state. +! (in) index - Index of conservation quantity of interest. +! (in) value - Sum returned for the conservation quantity of interest. +! (in,opt) time_index - Index for time level to use if this is necessary. + + real :: salt + + value = 0.0 + if (.not.associated(OS)) return + if (.not.OS%is_ocean_pe) return + + select case (index) + case (ISTOCK_WATER) ! Return the mass of fresh water in the ocean in kg. + if (OS%GV%Boussinesq) then + call get_ocean_stocks(OS%MOM_CSp, mass=value, on_PE_only=.true.) + else ! In non-Boussinesq mode, the mass of salt needs to be subtracted. + call get_ocean_stocks(OS%MOM_CSp, mass=value, salt=salt, on_PE_only=.true.) + value = value - salt + endif + case (ISTOCK_HEAT) ! Return the heat content of the ocean in J. + call get_ocean_stocks(OS%MOM_CSp, heat=value, on_PE_only=.true.) + case (ISTOCK_SALT) ! Return the mass of the salt in the ocean in kg. + call get_ocean_stocks(OS%MOM_CSp, salt=value, on_PE_only=.true.) + case default ; value = 0.0 + end select + ! If the FMS coupler is changed so that Ocean_stock_PE is only called on + ! ocean PEs, uncomment the following and eliminate the on_PE_only flags above. + ! if (.not.is_root_pe()) value = 0.0 + +end subroutine Ocean_stock_pe + +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 + + integer :: g_isc, g_iec, g_jsc, g_jec,g_isd, g_ied, g_jsd, g_jed, i, j + + if (.not.associated(OS)) return + if (.not.OS%is_ocean_pe) return + +! The problem is %areaT is on MOM domain but Ice_Ocean_Boundary%... is on mpp domain. +! We want to return the MOM data on the mpp (compute) domain +! Get MOM domain extents + call mpp_get_compute_domain(OS%grid%Domain%mpp_domain, g_isc, g_iec, g_jsc, g_jec) + call mpp_get_data_domain (OS%grid%Domain%mpp_domain, g_isd, g_ied, g_jsd, g_jed) + + g_isc = g_isc-g_isd+1 ; g_iec = g_iec-g_isd+1 ; g_jsc = g_jsc-g_jsd+1 ; g_jec = g_jec-g_jsd+1 + + + select case(name) + case('area') + array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) + case('mask') + array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) +!OR same result +! do j=g_jsc,g_jec ; do i=g_isc,g_iec +! array2D(isc+i-g_isc,jsc+j-g_jsc) = OS%grid%mask2dT(i,j) +! enddo ; enddo + case('t_surf') + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + case('t_pme') + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + case('t_runoff') + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + case('t_calving') + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + case('btfHeat') + array2D(isc:,jsc:) = 0 + case('tlat') + array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) + case('tlon') + array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) + case('ulat') + array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) + case('ulon') + array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) + case('vlat') + array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) + case('vlon') + array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) + case('geoLatBu') + array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) + case('geoLonBu') + array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) + case('cos_rot') + array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 + 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) + 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 + + if (.not.associated(OS)) return + if (.not.OS%is_ocean_pe) return + + select case(name) + case('c_p') + value = OS%C_p + case default + call MOM_error(FATAL,'ocean_model_data1D_get: unknown argument name='//name) + end select +end subroutine ocean_model_data1D_get + +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 + + outunit = stdout() + + write(outunit,*) "BEGIN CHECKSUM(ocean_type):: ", id, timestep + write(outunit,100) 'ocean%t_surf ',mpp_chksum(ocn%t_surf ) + write(outunit,100) 'ocean%s_surf ',mpp_chksum(ocn%s_surf ) + write(outunit,100) 'ocean%u_surf ',mpp_chksum(ocn%u_surf ) + 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 ) + + 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) + type(ocean_state_type) :: OS + type(ocean_grid_type) , pointer :: Gridp + + Gridp => OS%grid + return + + end subroutine get_ocean_grid +! NAME="get_ocean_grid" + +!======================================================================= +! Routines that are specific to MCT driver +!======================================================================= + + !> 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. + subroutine ocn_import(forces, fluxes, Time, G, CS, state, x2o_o, ind, sw_decomp, & + c1, c2, c3, c4, restore_salt, restore_temp) + + type(mech_forcing), intent(inout) :: forces !< Driving mechanical forces + type(forcing), intent(inout) :: fluxes !< Surface fluxes + type(time_type), intent(in) :: Time !< Model time + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid + type(surface_forcing_CS), pointer :: CS !< control structure returned by a previous call to surface_forcing_init + type(surface), intent(in) :: state !< control structure to ocean surface state fields. + real(kind=8), intent(in) :: x2o_o(:,:) !< Fluxes from coupler to ocean, computed by ocean + type(cpl_indices_type), intent(inout) :: ind !< Structure with MCT attribute vectors and indices + logical, intent(in) :: sw_decomp !< controls if shortwave is decomposed into four components + real(kind=8), optional, intent(in) :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition + logical, optional, intent(in) :: restore_salt !< Controls if salt is restored + logical, optional, intent(in) :: restore_temp !< Controls if temp is restored + + ! 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) + + real, dimension(SZI_(G),SZJ_(G)) :: & + taux_at_h, & ! Zonal wind stresses at h points (Pa) + tauy_at_h, & ! Meridional wind stresses at h points (Pa) + 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 + + 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, k, 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 + + real :: C_p ! heat capacity of seawater ( J/(K kg) ) + + call cpu_clock_begin(id_clock_forcing) + + 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 + + C_p = fluxes%C_p + Irho0 = 1.0/CS%Rho0 + open_ocn_mask(:,:) = 1.0 + pme_adj(:,:) = 0.0 + fluxes%vPrecGlobalAdj = 0.0 + fluxes%vPrecGlobalScl = 0.0 + fluxes%saltFluxGlobalAdj = 0.0 + fluxes%saltFluxGlobalScl = 0.0 + fluxes%netFWGlobalAdj = 0.0 + fluxes%netFWGlobalScl = 0.0 + + restore_salinity = .false. + if (present(restore_salt)) restore_salinity = restore_salt + restore_sst = .false. + if (present(restore_temp)) restore_sst = restore_temp + + ! if true, allocation and initialization + if (fluxes%dt_buoy_accum < 0) then + call allocate_forcing_type(G, fluxes, water=.true., heat=.true., & + ustar=.true., press=.true.) + call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., & + press=.true.) + call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%sw_nir_dir,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%sw_nir_dif,isd,ied,jsd,jed) + + call safe_alloc_ptr(fluxes%p_surf,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%p_surf_full,isd,ied,jsd,jed) + + call safe_alloc_ptr(fluxes%salt_flux,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%salt_flux_in,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) + + call safe_alloc_ptr(fluxes%TKE_tidal,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%ustar_tidal,isd,ied,jsd,jed) + + if (CS%allow_flux_adjustments) then + call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) + endif + + do j=js-2,je+2 ; do i=is-2,ie+2 + fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) + fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) + enddo; enddo + + 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) + endif + + if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) + + fluxes%dt_buoy_accum = 0.0 + endif ! endif for allocation and initialization + + if (CS%allow_flux_adjustments) then + fluxes%heat_added(:,:)=0.0 + fluxes%salt_flux_added(:,:)=0.0 + endif + if (associated(forces%rigidity_ice_u)) forces%rigidity_ice_u(:,:) = 0.0 + if (associated(forces%rigidity_ice_v)) forces%rigidity_ice_v(:,:) = 0.0 + + 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) + enddo; enddo + CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) + endif ! endif for allocation and initialization + + do j=js,je ; do i=is,ie + fluxes%salt_flux(i,j) = 0.0 + fluxes%vprec(i,j) = 0.0 + enddo; enddo + + ! Salinity restoring logic + if (restore_salinity) then + call time_interp_external(CS%id_srestore,Time,data_restore) + ! open_ocn_mask indicates where to restore salinity (1 means restore, 0 does not) + open_ocn_mask(:,:) = 1.0 + if (CS%mask_srestore_under_ice) then ! Do not restore under sea-ice + do j=js,je ; do i=is,ie + if (state%SST(i,j) .le. -0.0539*state%SSS(i,j)) open_ocn_mask(i,j)=0.0 + enddo; enddo + endif + if (CS%salt_restore_as_sflux) then + do j=js,je ; do i=is,ie + delta_sss = data_restore(i,j)- 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 + enddo; enddo + if (CS%adjust_net_srestore_to_zero) then + if (CS%adjust_net_srestore_by_scaling) then + call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) + fluxes%saltFluxGlobalAdj = 0. + else + work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) + fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf + fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj + endif + endif + fluxes%salt_flux_added(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) ! Diagnostic + else + do j=js,je ; do i=is,ie + if (G%mask2dT(i,j) > 0.5) then + delta_sss = 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))* & + (CS%Rho0*CS%Flux_const) * & + delta_sss / (0.5*(state%SSS(i,j) + data_restore(i,j))) + endif + enddo; enddo + if (CS%adjust_net_srestore_to_zero) then + if (CS%adjust_net_srestore_by_scaling) then + call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) + fluxes%vPrecGlobalAdj = 0. + else + work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) + fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf + do j=js,je ; do i=is,ie + fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) + enddo; enddo + endif + endif + endif + endif + + ! SST restoring logic + if (restore_sst) then + call time_interp_external(CS%id_trestore,Time,data_restore) + do j=js,je ; do i=is,ie + delta_sst = data_restore(i,j)- 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 + enddo; enddo + endif + + ! GMM, CIME uses AGRID. All the BGRID_NE code can be cleaned later + wind_stagger = AGRID + + 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 + endif + if (wind_stagger == AGRID) then + ! This is necessary to fill in the halo points. + taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 + endif + + k = 0 + do j=js,je ; do i=is,ie + k = k + 1 ! Increment position within gindex + + if (wind_stagger == BGRID_NE) then + taux_at_q(I,J) = x2o_o(ind%x2o_Foxx_taux,k) * CS%wind_stress_multiplier + tauy_at_q(I,J) = x2o_o(ind%x2o_Foxx_tauy,k) * CS%wind_stress_multiplier + ! GMM, cime uses AGRID + elseif (wind_stagger == AGRID) then + taux_at_h(i,j) = x2o_o(ind%x2o_Foxx_taux,k) * CS%wind_stress_multiplier + tauy_at_h(i,j) = x2o_o(ind%x2o_Foxx_tauy,k) * CS%wind_stress_multiplier + else ! C-grid wind stresses. + forces%taux(I,j) = x2o_o(ind%x2o_Foxx_taux,k) * CS%wind_stress_multiplier + forces%tauy(i,J) = x2o_o(ind%x2o_Foxx_tauy,k) * CS%wind_stress_multiplier + endif + + ! liquid precipitation (rain) + if (associated(fluxes%lprec)) & + fluxes%lprec(i,j) = x2o_o(ind%x2o_Faxa_rain,k) * G%mask2dT(i,j) + + ! frozen precipitation (snow) + if (associated(fluxes%fprec)) & + fluxes%fprec(i,j) = x2o_o(ind%x2o_Faxa_snow,k) * G%mask2dT(i,j) + + ! evaporation + if (associated(fluxes%evap)) & + fluxes%evap(i,j) = x2o_o(ind%x2o_Foxx_evap,k) * G%mask2dT(i,j) + + ! river runoff flux + if (associated(fluxes%lrunoff)) & + fluxes%lrunoff(i,j) = x2o_o(ind%x2o_Foxx_rofl,k) * G%mask2dT(i,j) + + ! ice runoff flux + if (associated(fluxes%frunoff)) & + fluxes%frunoff(i,j) = x2o_o(ind%x2o_Foxx_rofi,k) * G%mask2dT(i,j) + + ! 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) = 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) + + ! longwave radiation, sum up and down (W/m2) + if (associated(fluxes%LW)) & + fluxes%LW(i,j) = (x2o_o(ind%x2o_Faxa_lwdn,k) + x2o_o(ind%x2o_Foxx_lwup,k)) * G%mask2dT(i,j) + + ! sensible heat flux (W/m2) + if (associated(fluxes%sens)) & + fluxes%sens(i,j) = x2o_o(ind%x2o_Foxx_sen,k) * G%mask2dT(i,j) + + ! latent heat flux (W/m^2) + if (associated(fluxes%latent)) & + fluxes%latent(i,j) = x2o_o(ind%x2o_Foxx_lat,k) * G%mask2dT(i,j) + + if (sw_decomp) then + ! Use runtime coefficients to decompose net short-wave heat flux into 4 components + ! 1) visible, direct shortwave (W/m2) + if (associated(fluxes%sw_vis_dir)) & + fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * x2o_o(ind%x2o_Foxx_swnet,k)*c1 + ! 2) visible, diffuse shortwave (W/m2) + if (associated(fluxes%sw_vis_dif)) & + fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * x2o_o(ind%x2o_Foxx_swnet,k)*c2 + ! 3) near-IR, direct shortwave (W/m2) + if (associated(fluxes%sw_nir_dir)) & + fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * x2o_o(ind%x2o_Foxx_swnet,k)*c3 + ! 4) near-IR, diffuse shortwave (W/m2) + if (associated(fluxes%sw_nir_dif)) & + fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * x2o_o(ind%x2o_Foxx_swnet,k)*c4 + + 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) + else + call MOM_error(FATAL,"fill_ice_ocean_bnd: this option has not been implemented yet."// & + "Shortwave must be decomposed using coeffs. c1, c2, c3, c4."); + endif + + ! applied surface pressure from atmosphere and cryosphere + ! sea-level pressure (Pa) + if (associated(forces%p_surf_full) .and. associated(forces%p_surf)) then + forces%p_surf_full(i,j) = G%mask2dT(i,j) * x2o_o(ind%x2o_Sa_pslv,k) + if (CS%max_p_surf >= 0.0) then + forces%p_surf(i,j) = MIN(forces%p_surf_full(i,j),CS%max_p_surf) + else + forces%p_surf(i,j) = forces%p_surf_full(i,j) + endif + + if (CS%use_limited_P_SSH) then + forces%p_surf_SSH => forces%p_surf + else + forces%p_surf_SSH => forces%p_surf_full + endif + + endif + + ! salt flux + ! more salt restoring logic + if (associated(fluxes%salt_flux)) & + fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(x2o_o(ind%x2o_Fioi_salt,k) + fluxes%salt_flux(i,j)) + + if (associated(fluxes%salt_flux_in)) & + fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*x2o_o(ind%x2o_Fioi_salt,k) + + enddo; enddo + ! ############################ END OF MCT to MOM ############################## + + ! adjust the NET fresh-water flux to zero, if flagged + if (CS%adjust_net_fresh_water_to_zero) then + do j=js,je ; do i=is,ie + net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(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 + 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 + + if (CS%adjust_net_fresh_water_by_scaling) then + call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) + do j=js,je ; do i=is,ie + fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) + enddo; enddo + else + fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf + do j=js,je ; do i=is,ie + fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%netFWGlobalAdj ) * G%mask2dT(i,j) + enddo; enddo + endif + + endif + + ! surface momentum stress related fields as function of staggering + 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) + + do j=js,je ; do I=Isq,Ieq + forces%taux(I,j) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & + forces%taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + & + G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) + enddo; enddo + + do J=Jsq,Jeq ; do i=is,ie + forces%tauy(i,J) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & + forces%tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + & + G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) + enddo; enddo + + ! ustar is required for the bulk mixed layer formulation. The background value + ! of 0.02 Pa is a relatively small value intended to give reasonable behavior + ! in regions of very weak winds. + + do j=js,je ; do i=is,ie + tau_mag = 0.0 ; gustiness = CS%gust_const + if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then + tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & + G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & + (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & + G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & + ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) + if (CS%read_gust_2d) gustiness = CS%gust(i,j) + endif + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) + enddo; enddo + + elseif (wind_stagger == AGRID) then + call pass_vector(taux_at_h, tauy_at_h, G%Domain,stagger=AGRID) + + do j=js,je ; do I=Isq,Ieq + forces%taux(I,j) = 0.0 + if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & + forces%taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + & + G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & + (G%mask2dT(i,j) + G%mask2dT(i+1,j)) + enddo; enddo + + do J=Jsq,Jeq ; do i=is,ie + forces%tauy(i,J) = 0.0 + if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & + forces%tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + & + G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & + (G%mask2dT(i,j) + G%mask2dT(i,j+1)) + enddo; enddo + + do j=js,je ; do i=is,ie + gustiness = CS%gust_const + if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & + sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) + enddo; enddo + + 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) + + do j=js,je ; do i=is,ie + taux2 = 0.0 + if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & + taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + & + G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) + + tauy2 = 0.0 + if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & + tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + & + G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) + + if (CS%read_gust_2d) then + forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) + else + forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) + endif + enddo; enddo + + endif ! endif for wind related fields + + + ! sea ice related fields + if (CS%rigid_sea_ice) then + ! The commented out code here and in the following lines is the correct + ! version, but the incorrect version is being retained temporarily to avoid + ! changing answers. + call pass_var(forces%p_surf_full, G%Domain) + I_GEarth = 1.0 / G%G_Earth + Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) + do I=isd,ied-1 ; do j=jsd,jed + mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth + mass_eff = 0.0 + if (mass_ice > CS%rigid_sea_ice_mass) then + mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & + (mass_ice + CS%rigid_sea_ice_mass) + endif + ! CAUTION: with both rigid_sea_ice and ice shelves, we will need to make this + ! a maximum for the second call. + forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + Kv_rho_ice * mass_eff + enddo; enddo + do i=isd,ied ; do J=jsd,jed-1 + mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i,j+1)) * I_GEarth + mass_eff = 0.0 + if (mass_ice > CS%rigid_sea_ice_mass) then + mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & + (mass_ice + CS%rigid_sea_ice_mass) + endif + forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + Kv_rho_ice * mass_eff + enddo; enddo + endif + + if (CS%allow_flux_adjustments) then + ! Apply adjustments to fluxes + call apply_flux_adjustments(G, CS, Time, forces, fluxes) + endif + + ! Allow for user-written code to alter fluxes after all the above + call user_alter_forcing(state, fluxes, Time, G, CS%urf_CS) + + call cpu_clock_end(id_clock_forcing) + + end subroutine ocn_import + +!======================================================================= + + !> Maps outgoing ocean data to MCT buffer. + !! See \ref section_ocn_export for a summary of the data + !! that is transferred from MOM6 to MCT. + subroutine ocn_export(ind, ocn_public, grid, o2x) + type(cpl_indices_type), intent(inout) :: ind !< Structure with coupler indices and vectors + type(ocean_public_type), intent(in) :: ocn_public !< Ocean surface state + type(ocean_grid_type), intent(in) :: grid !< Ocean model grid + real(kind=8), intent(inout) :: o2x(:,:) !< MCT outgoing bugger + + ! Local variables + real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo + integer :: i, j, n, ig, jg !< Grid indices + real :: slp_L, slp_R, slp_C, slope, u_min, u_max + + ! Copy from ocn_public to o2x. ocn_public uses global indexing with no halos. + ! The mask comes from "grid" that uses the usual MOM domain that has halos + ! and does not use global indexing. + n = 0 + do j=grid%jsc, grid%jec + jg = j + grid%jdg_offset + do i=grid%isc,grid%iec + n = n+1 + ig = i + grid%idg_offset + ! surface temperature in Kelvin + o2x(ind%o2x_So_t, n) = ocn_public%t_surf(ig,jg) * grid%mask2dT(i,j) + o2x(ind%o2x_So_s, n) = ocn_public%s_surf(ig,jg) * grid%mask2dT(i,j) + o2x(ind%o2x_So_u, n) = ocn_public%u_surf(ig,jg) * grid%mask2dT(i,j) + o2x(ind%o2x_So_v, n) = ocn_public%v_surf(ig,jg) * grid%mask2dT(i,j) + ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain + ! in order to update halos. i.e. does not use global indexing. + ssh(i,j) = ocn_public%sea_lev(ig,jg) + end do + end do + + ! Update halo of ssh so we can calculate gradients + call pass_var(ssh, grid%domain) + + ! d/dx ssh + n = 0 + do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec + n = n+1 + ! This is a simple second-order difference + !o2x(ind%o2x_So_dhdx, n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) + if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(I,j) + if (grid%mask2dCu(I+1,j)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + if ( (slp_L * slp_R) > 0.0 ) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + o2x(ind%o2x_So_dhdx, n) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdx, n) = 0.0 + end do; end do + + ! d/dy ssh + n = 0 + do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec + n = n+1 + ! This is a simple second-order difference + ! o2x(ind%o2x_So_dhdy, n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) + if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. + + slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,J) + if (grid%mask2dCv(i,J+1)==0.) slp_R = 0. + + slp_C = 0.5 * (slp_L + slp_R) + !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R + if ((slp_L * slp_R) > 0.0) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + o2x(ind%o2x_So_dhdy, n) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdy, n) = 0.0 + end do; end do + + end subroutine ocn_export + +!======================================================================= + + !> Adds 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) + subroutine apply_flux_adjustments(G, CS, Time, forces, 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(mech_forcing), intent(inout) :: forces !< Driving mechanical forces + type(forcing), optional, 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) + + integer :: isc, iec, jsc, jec, i, j + real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau + logical :: overrode_x, overrode_y, overrode_h + + 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) + + 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 + + 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) + + + tempx_at_h(:,:) = 0.0 ; tempy_at_h(:,:) = 0.0 + ! Either reads data or leaves contents unchanged + overrode_x = .false. ; overrode_y = .false. + call data_override('OCN', 'taux_adj', tempx_at_h(isc:iec,jsc:jec), Time, override=overrode_x) + call data_override('OCN', 'tauy_adj', tempy_at_h(isc:iec,jsc:jec), Time, override=overrode_y) + + if (overrode_x .or. overrode_y) then + if (.not. (overrode_x .and. overrode_y)) call MOM_error(FATAL,"apply_flux_adjustments: "//& + "Both taux_adj and tauy_adj must be specified, or neither, in data_table") + + ! Rotate winds + call pass_vector(tempx_at_h, tempy_at_h, G%Domain, To_All, AGRID) + do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 + dLonDx = G%geoLonCu(I,j) - G%geoLonCu(I-1,j) + dLonDy = G%geoLonCv(i,J) - G%geoLonCv(i,J-1) + rDlon = sqrt( dLonDx * dLonDx + dLonDy * dLonDy ) + if (rDlon > 0.) rDlon = 1. / rDlon + cosA = dLonDx * rDlon + sinA = dLonDy * rDlon + zonal_tau = tempx_at_h(i,j) + merid_tau = tempy_at_h(i,j) + tempx_at_h(i,j) = cosA * zonal_tau - sinA * merid_tau + tempy_at_h(i,j) = sinA * zonal_tau + cosA * merid_tau + enddo; enddo + + ! Average to C-grid locations + do j=G%jsc,G%jec ; do I=G%isc-1,G%iec + forces%taux(I,j) = forces%taux(I,j) + 0.5 * ( tempx_at_h(i,j) + tempx_at_h(i+1,j) ) + enddo; enddo + + do J=G%jsc-1,G%jec ; do i=G%isc,G%iec + forces%tauy(i,J) = forces%tauy(i,J) + 0.5 * ( tempy_at_h(i,j) + tempy_at_h(i,j+1) ) + enddo; enddo + endif ! overrode_x .or. overrode_y + + end subroutine apply_flux_adjustments + +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 new file mode 100644 index 0000000000..0550038b8e --- /dev/null +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -0,0 +1,1432 @@ +module MOM_surface_forcing + +! This file is part of MOM6. See LICENSE.md for the license. + +!### use MOM_controlled_forcing, only : apply_ctrl_forcing, register_ctrl_forcing_restarts +!### use MOM_controlled_forcing, only : controlled_forcing_init, controlled_forcing_end +!### use MOM_controlled_forcing, only : ctrl_forcing_CS +use MOM_coms, only : reproducing_sum +use MOM_constants, only : hlv, hlf +use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end +use MOM_cpu_clock, only : CLOCK_SUBCOMPONENT +use MOM_diag_mediator, only : diag_ctrl +use MOM_diag_mediator, only : safe_alloc_ptr, time_type +use MOM_domains, only : pass_vector, pass_var, fill_symmetric_edges +use MOM_domains, only : global_field_sum, BITWISE_EXACT_SUM +use MOM_domains, only : AGRID, BGRID_NE, CGRID_NE, To_All +use MOM_domains, only : To_North, To_East, Omit_Corners +use MOM_error_handler, only : MOM_error, WARNING, FATAL, is_root_pe, MOM_mesg +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : forcing_diags, mech_forcing_diags, register_forcing_type_diags +use MOM_forcing_type, only : allocate_forcing_type, deallocate_forcing_type +use MOM_forcing_type, only : allocate_mech_forcing, deallocate_mech_forcing +use MOM_get_input, only : Get_MOM_Input, directories +use MOM_grid, only : ocean_grid_type +use MOM_io, only : slasher, write_version_number, MOM_read_data +use MOM_restart, only : register_restart_field, restart_init, MOM_restart_CS +use MOM_restart, only : restart_init_end, save_restart, restore_state +use MOM_string_functions, only : uppercase +use MOM_spatial_means, only : adjust_area_mean_to_zero +use MOM_variables, only : surface +use user_revise_forcing, only : user_alter_forcing, user_revise_forcing_init +use user_revise_forcing, only : user_revise_forcing_CS + +use coupler_types_mod, only : coupler_2d_bc_type, coupler_type_write_chksums +use coupler_types_mod, only : coupler_type_initialized, coupler_type_spawn +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 + +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 + +!> Contains pointers to the forcing fields which may be used to drive MOM. +!! All fluxes are positive downward. +type, public :: surface_forcing_CS ; + 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 + 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 :: 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 + !! structure does not limit the water that can be + !! frozen out of the ocean and the ice-ocean heat + !! fluxes are treated explicitly. + logical :: use_limited_P_SSH !< 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. The default is true. + 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. + gust => NULL(), & !< spatially varying unresolved background + !! 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) + real :: cd_tides !< drag coefficient that applies to the tides (nondimensional) + real :: utide !< constant tidal velocity to use if read_tideamp + !! is false, in 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 :: 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. + logical :: allow_flux_adjustments !< If true, use data_override to obtain flux adjustments + 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 :: 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) + 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 + 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 + 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 + 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 + !### 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 +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. +type, public :: ice_ocean_boundary_type + 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(:,:) :: 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 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, CS, & + sfc_state, restore_salt, restore_temp) + type(ice_ocean_boundary_type), & + 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. + !! 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 + type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a + !! previous call to surface_forcing_init. + type(surface), intent(in) :: sfc_state !< A structure containing fields that describe the + !! surface state of the ocean. + 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. + + + 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, 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 + + 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 + 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 + + C_p = fluxes%C_p + open_ocn_mask(:,:) = 1.0 + pme_adj(:,:) = 0.0 + fluxes%vPrecGlobalAdj = 0.0 + fluxes%vPrecGlobalScl = 0.0 + fluxes%saltFluxGlobalAdj = 0.0 + fluxes%saltFluxGlobalScl = 0.0 + fluxes%netFWGlobalAdj = 0.0 + fluxes%netFWGlobalScl = 0.0 + + restore_salinity = .false. + if (present(restore_salt)) restore_salinity = restore_salt + restore_sst = .false. + if (present(restore_temp)) restore_sst = restore_temp + + ! allocation and initialization if this is the first time that this + ! flux type has been used. + if (fluxes%dt_buoy_accum < 0) then + call allocate_forcing_type(G, fluxes, water=.true., heat=.true., & + ustar=.true., press=.true.) + + call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%sw_nir_dir,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%sw_nir_dif,isd,ied,jsd,jed) + + 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) + call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) + + call safe_alloc_ptr(fluxes%TKE_tidal,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%ustar_tidal,isd,ied,jsd,jed) + + if (CS%allow_flux_adjustments) then + call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) + endif + + do j=js-2,je+2 ; do i=is-2,ie+2 + fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) + fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) + enddo ; enddo + + if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) + + 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) + enddo ; enddo + CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) + endif ! endif for allocation and initialization + + do j=js,je ; do i=is,ie + fluxes%salt_flux(i,j) = 0.0 + fluxes%vprec(i,j) = 0.0 + enddo ; enddo + + ! Salinity restoring logic + if (restore_salinity) then + call time_interp_external(CS%id_srestore,Time,data_restore) + ! open_ocn_mask indicates where to restore salinity (1 means restore, 0 does not) + open_ocn_mask(:,:) = 1.0 + if (CS%mask_srestore_under_ice) then ! Do not restore under sea-ice + do j=js,je ; do i=is,ie + if (sfc_state%SST(i,j) <= -0.0539*sfc_state%SSS(i,j)) open_ocn_mask(i,j)=0.0 + enddo ; enddo + endif + if (CS%salt_restore_as_sflux) then + do j=js,je ; do i=is,ie + 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)*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 + call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) + fluxes%saltFluxGlobalAdj = 0. + else + work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) + fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf + fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj + endif + endif + fluxes%salt_flux_added(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) ! Diagnostic + else + do j=js,je ; do i=is,ie + 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)*CS%srestore_mask(i,j))* & + (CS%Rho0*CS%Flux_const) * & + delta_sss / (0.5*(sfc_state%SSS(i,j) + data_restore(i,j))) + endif + enddo ; enddo + if (CS%adjust_net_srestore_to_zero) then + if (CS%adjust_net_srestore_by_scaling) then + call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) + fluxes%vPrecGlobalAdj = 0. + else + work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) + fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf + do j=js,je ; do i=is,ie + fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) + enddo ; enddo + endif + endif + endif + endif + + ! SST restoring logic + if (restore_sst) then + call time_interp_external(CS%id_trestore,Time,data_restore) + 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%trestore_mask(i,j) * & + (CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2 + enddo ; enddo + endif + + + ! obtain fluxes from IOB; note the staggering of indices + i0 = is - isc_bnd ; j0 = js - jsc_bnd + do j=js,je ; do i=is,ie + + if (associated(IOB%lprec)) & + fluxes%lprec(i,j) = IOB%lprec(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%fprec)) & + fluxes%fprec(i,j) = IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%q_flux)) & + fluxes%evap(i,j) = - IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%runoff)) & + fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%calving)) & + fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%ustar_berg)) & + fluxes%ustar_berg(i,j) = 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%runoff_hflx)) & + fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * 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) + + if (associated(IOB%lw_flux)) & + fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%t_flux)) & + fluxes%sens(i,j) = - IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) + + fluxes%latent(i,j) = 0.0 + 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 + if (associated(IOB%calving)) then + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion + endif + if (associated(IOB%q_flux)) then + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor + fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor + endif + + fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) + + 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) + + enddo ; enddo + + ! 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 + endif + + ! more salt restoring logic + 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 + +!### if (associated(CS%ctrl_forcing_CSp)) then +!### do j=js,je ; do i=is,ie +!### SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) +!### SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) +!### SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) +!### enddo ; enddo +!### call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_restore, & +!### fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) +!### endif + + ! adjust the NET fresh-water flux to zero, if flagged + if (CS%adjust_net_fresh_water_to_zero) then + sign_for_net_FW_bug = 1. + if (CS%use_net_FW_adjustment_sign_bug) sign_for_net_FW_bug = -1. + do j=js,je ; do i=is,ie + net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(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 + 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 + + if (CS%adjust_net_fresh_water_by_scaling) then + call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) + do j=js,je ; do i=is,ie + fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) + enddo ; enddo + else + fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf + do j=js,je ; do i=is,ie + fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%netFWGlobalAdj ) * G%mask2dT(i,j) + enddo ; enddo + 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 + ! TODO (mvertens 5/27/2018): the following call gives an error: + ! "The type of the actual argument differs from the type of the dummy argument [FLUXES]" + ! Will comment out for now + ! call apply_flux_adjustments(G, CS, Time, fluxes) + endif + + ! Allow for user-written code to alter fluxes after all the above + call user_alter_forcing(sfc_state, fluxes, Time, G, CS%urf_CS) + + call cpu_clock_end(id_clock_forcing) + +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. +subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) + type(ice_ocean_boundary_type), & + target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive + !! the ocean in a coupled model + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + 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 + type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a + !! previous call to surface_forcing_init. + + + 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) + + 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) + 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 + i0 = is - isc_bnd ; j0 = js - jsc_bnd + + 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 safe_alloc_ptr(forces%p_surf,isd,ied,jsd,jed) + call safe_alloc_ptr(forces%p_surf_full,isd,ied,jsd,jed) + 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 (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) + endif + + 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 + + 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 + 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) + 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) + enddo ; enddo + endif + endif + + wind_stagger = CS%wind_stagger + 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 + endif + if (wind_stagger == AGRID) then + ! This is necessary to fill in the halo points. + taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 + endif + + ! 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 + elseif (wind_stagger == AGRID) then + if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + else ! C-grid wind stresses. + if (associated(IOB%u_flux)) forces%taux(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%v_flux)) forces%tauy(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + endif + + enddo ; enddo + + ! surface momentum stress related fields as function of staggering + 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, halo=1) + + do j=js,je ; do I=Isq,Ieq + forces%taux(I,j) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & + forces%taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + & + G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) + enddo ; enddo + + do J=Jsq,Jeq ; do i=is,ie + forces%tauy(i,J) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & + forces%tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + & + G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) + enddo ; enddo + + ! ustar is required for the bulk mixed layer formulation. The background value + ! of 0.02 Pa is a relatively small value intended to give reasonable behavior + ! in regions of very weak winds. + + do j=js,je ; do i=is,ie + tau_mag = 0.0 ; gustiness = CS%gust_const + if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then + tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & + G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & + (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & + G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & + ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) + if (CS%read_gust_2d) gustiness = CS%gust(i,j) + endif + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) + enddo ; enddo + + elseif (wind_stagger == AGRID) then + 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 + if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & + forces%taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + & + G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & + (G%mask2dT(i,j) + G%mask2dT(i+1,j)) + enddo ; enddo + + do J=Jsq,Jeq ; do i=is,ie + forces%tauy(i,J) = 0.0 + if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & + forces%tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + & + G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & + (G%mask2dT(i,j) + G%mask2dT(i,j+1)) + enddo ; enddo + + do j=js,je ; do i=is,ie + gustiness = CS%gust_const + if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & + sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) + enddo ; enddo + + 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, halo=1) + + do j=js,je ; do i=is,ie + taux2 = 0.0 + if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & + taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + & + G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) + + tauy2 = 0.0 + if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & + tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + & + G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) + + if (CS%read_gust_2d) then + forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) + else + forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) + endif + enddo ; enddo + + 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 + Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) + do I=is-1,ie ; do j=js,je + mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth + mass_eff = 0.0 + if (mass_ice > CS%rigid_sea_ice_mass) then + mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & + (mass_ice + CS%rigid_sea_ice_mass) + endif + forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + Kv_rho_ice * mass_eff + enddo ; enddo + do i=is,ie ; do J=js-1,je + mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i,j+1)) * I_GEarth + mass_eff = 0.0 + if (mass_ice > CS%rigid_sea_ice_mass) then + mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & + (mass_ice + CS%rigid_sea_ice_mass) + endif + forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + Kv_rho_ice * mass_eff + enddo ; enddo + endif + + if (CS%allow_flux_adjustments) then + ! Apply adjustments to forces + call apply_force_adjustments(G, CS, Time, forces) + endif + +!### ! Allow for user-written code to alter fluxes after all the above +!### call user_alter_mech_forcing(forces, Time, G, CS%urf_CS) + + call cpu_clock_end(id_clock_forcing) +end subroutine convert_IOB_to_forces + +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% u_flux (isc:iec,jsc:jec), & + IOB% v_flux (isc:iec,jsc:jec), & + IOB% t_flux (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% runoff (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%u_flux = 0.0 + IOB%v_flux = 0.0 + IOB%t_flux = 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%runoff = 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 +!! 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) +subroutine apply_flux_adjustments(G, CS, Time, forces, 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(mech_forcing), intent(inout) :: forces !< Driving mechanical forces + type(forcing), optional, 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) + + integer :: isc, iec, jsc, jec, i, j + real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau + logical :: overrode_x, overrode_y, overrode_h + + 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) + + 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 + + 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) + + + tempx_at_h(:,:) = 0.0 ; tempy_at_h(:,:) = 0.0 + ! Either reads data or leaves contents unchanged + overrode_x = .false. ; overrode_y = .false. + call data_override('OCN', 'taux_adj', tempx_at_h(isc:iec,jsc:jec), Time, override=overrode_x) + call data_override('OCN', 'tauy_adj', tempy_at_h(isc:iec,jsc:jec), Time, override=overrode_y) + + if (overrode_x .or. overrode_y) then + if (.not. (overrode_x .and. overrode_y)) call MOM_error(FATAL,"apply_flux_adjustments: "//& + "Both taux_adj and tauy_adj must be specified, or neither, in data_table") + + ! Rotate winds + call pass_vector(tempx_at_h, tempy_at_h, G%Domain, To_All, AGRID) + do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 + dLonDx = G%geoLonCu(I,j) - G%geoLonCu(I-1,j) + dLonDy = G%geoLonCv(i,J) - G%geoLonCv(i,J-1) + rDlon = sqrt( dLonDx * dLonDx + dLonDy * dLonDy ) + if (rDlon > 0.) rDlon = 1. / rDlon + cosA = dLonDx * rDlon + sinA = dLonDy * rDlon + zonal_tau = tempx_at_h(i,j) + merid_tau = tempy_at_h(i,j) + tempx_at_h(i,j) = cosA * zonal_tau - sinA * merid_tau + tempy_at_h(i,j) = sinA * zonal_tau + cosA * merid_tau + enddo ; enddo + + ! Average to C-grid locations + do j=G%jsc,G%jec ; do I=G%isc-1,G%iec + forces%taux(I,j) = forces%taux(I,j) + 0.5 * ( tempx_at_h(i,j) + tempx_at_h(i+1,j) ) + enddo ; enddo + + do J=G%jsc-1,G%jec ; do i=G%isc,G%iec + forces%tauy(i,J) = forces%tauy(i,J) + 0.5 * ( tempy_at_h(i,j) + tempy_at_h(i,j+1) ) + enddo ; enddo + endif ! overrode_x .or. overrode_y + +end subroutine apply_flux_adjustments + +!> Adds mechanical forcing 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) +subroutine apply_force_adjustments(G, CS, Time, forces) + 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(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) + + integer :: isc, iec, jsc, jec, i, j + real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau + logical :: overrode_x, overrode_y + + isc = G%isc; iec = G%iec ; jsc = G%jsc; jec = G%jec + + tempx_at_h(:,:) = 0.0 ; tempy_at_h(:,:) = 0.0 + ! Either reads data or leaves contents unchanged + overrode_x = .false. ; overrode_y = .false. + call data_override('OCN', 'taux_adj', tempx_at_h(isc:iec,jsc:jec), Time, override=overrode_x) + call data_override('OCN', 'tauy_adj', tempy_at_h(isc:iec,jsc:jec), Time, override=overrode_y) + + if (overrode_x .or. overrode_y) then + if (.not. (overrode_x .and. overrode_y)) call MOM_error(FATAL,"apply_flux_adjustments: "//& + "Both taux_adj and tauy_adj must be specified, or neither, in data_table") + + ! Rotate winds + call pass_vector(tempx_at_h, tempy_at_h, G%Domain, To_All, AGRID, halo=1) + do j=jsc-1,jec+1 ; do i=isc-1,iec+1 + dLonDx = G%geoLonCu(I,j) - G%geoLonCu(I-1,j) + dLonDy = G%geoLonCv(i,J) - G%geoLonCv(i,J-1) + rDlon = sqrt( dLonDx * dLonDx + dLonDy * dLonDy ) + if (rDlon > 0.) rDlon = 1. / rDlon + cosA = dLonDx * rDlon + sinA = dLonDy * rDlon + zonal_tau = tempx_at_h(i,j) + merid_tau = tempy_at_h(i,j) + tempx_at_h(i,j) = cosA * zonal_tau - sinA * merid_tau + tempy_at_h(i,j) = sinA * zonal_tau + cosA * merid_tau + enddo ; enddo + + ! Average to C-grid locations + do j=jsc,jec ; do I=isc-1,iec + forces%taux(I,j) = forces%taux(I,j) + 0.5 * ( tempx_at_h(i,j) + tempx_at_h(i+1,j) ) + enddo ; enddo + + do J=jsc-1,jec ; do i=isc,iec + forces%tauy(i,J) = forces%tauy(i,J) + 0.5 * ( tempy_at_h(i,j) + tempy_at_h(i,j+1) ) + enddo ; enddo + endif ! overrode_x .or. overrode_y + +end subroutine apply_force_adjustments + +!> Saves restart fields associated with the 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(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 + 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. +subroutine surface_forcing_init(Time, G, 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(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 + + ! 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=48) :: stagger + character(len=240) :: basin_file + integer :: i, j, isd, ied, jsd, jed + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + + if (associated(CS)) then + call MOM_error(WARNING, "surface_forcing_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + + id_clock_forcing=cpu_clock_id('Ocean surface forcing', grain=CLOCK_SUBCOMPONENT) + call cpu_clock_begin(id_clock_forcing) + + CS%diag => diag + + call write_version_number (version) + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mdl, version, "") + + call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, & + "The directory in which all input files are found.", & + default=".") + CS%inputdir = slasher(CS%inputdir) + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + "If true, Temperature and salinity are used as state \n"//& + "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"//& + "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, & + "The latent heat of fusion.", units="J/kg", default=hlf) + 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"//& + "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"//& + "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"//& + "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"//& + "by the ocean (including restoring) to zero.", 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"//& + "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"//& + "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"//& + "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 \n"//& + "staggering of the input wind stress field. Valid \n"//& + "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 + elseif (uppercase(stagger(1:1)) == 'C') then ; CS%wind_stagger = CGRID_NE + else ; call MOM_error(FATAL,"surface_forcing_init: WIND_STAGGER = "// & + trim(stagger)//" is invalid.") ; endif + call get_param(param_file, mdl, "WIND_STRESS_MULTIPLIER", CS%wind_stress_multiplier, & + "A factor multiplying the wind-stress given to the ocean by the\n"//& + "coupler. This is used for testing and should be =1.0 for any\n"//& + "production runs.", default=1.0) + + if (restore_salt) then + call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & + "The constant that relates the restoring surface fluxes \n"//& + "to the relative surface anomalies (akin to a piston \n"//& + "velocity). Note the non-MKS units.", units="m day-1", & + fail_if_missing=.true.) + call get_param(param_file, mdl, "SALT_RESTORE_FILE", CS%salt_restore_file, & + "A file in which to find the surface salinity to use for restoring.", & + default="salt_restore.nc") + call get_param(param_file, mdl, "SALT_RESTORE_VARIABLE", CS%salt_restore_var_name, & + "The name of the surface salinity variable to read from "//& + "SALT_RESTORE_FILE for restoring salinity.", & + default="salt") +! Convert CS%Flux_const from m day-1 to m s-1. + CS%Flux_const = CS%Flux_const / 86400.0 + + call get_param(param_file, mdl, "SRESTORE_AS_SFLUX", CS%salt_restore_as_sflux, & + "If true, the restoring of salinity is applied as a salt \n"//& + "flux instead of as a freshwater flux.", default=.false.) + call get_param(param_file, 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"//& + "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"//& + "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'.", & + default="basin.nc") + 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) + 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 + 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"//& + "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, & + "A file in which to find the surface temperature to use for restoring.", & + default="temp_restore.nc") + call get_param(param_file, mdl, "SST_RESTORE_VARIABLE", CS%temp_restore_var_name, & + "The name of the surface temperature variable to read from "//& + "SST_RESTORE_FILE for restoring sst.", & + default="temp") +! Convert CS%Flux_const from m day-1 to m s-1. + CS%Flux_const = CS%Flux_const / 86400.0 + + call get_param(param_file, mdl, "MAX_DELTA_TRESTORE", CS%max_delta_trestore, & + "The maximum sst difference used in restoring terms.", & + units="degC ", default=999.0) + + endif + +! 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. + call get_param(param_file, mdl, "CD_TIDES", CS%cd_tides, & + "The drag coefficient that applies to the tides.", & + units="nondim", default=1.0e-4) + call get_param(param_file, mdl, "READ_TIDEAMP", CS%read_TIDEAMP, & + "If true, read a file (given by TIDEAMP_FILE) containing \n"//& + "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) + if (CS%read_TIDEAMP) then + call get_param(param_file, mdl, "TIDEAMP_FILE", TideAmp_file, & + "The path to the file containing the spatially varying \n"//& + "tidal amplitudes with INT_TIDE_DISSIPATION.", & + default="tideamp.nc") + CS%utide=0.0 + else + call get_param(param_file, mdl, "UTIDE", CS%utide, & + "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & + units="m s-1", default=0.0) + endif + + call safe_alloc_ptr(CS%TKE_tidal,isd,ied,jsd,jed) + call safe_alloc_ptr(CS%ustar_tidal,isd,ied,jsd,jed) + + 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) + 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) + CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + enddo ; enddo + else + do j=jsd,jed; do i=isd,ied + utide=CS%utide + CS%TKE_tidal(i,j) = CS%Rho0*CS%cd_tides*(utide*utide*utide) + CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + enddo ; enddo + endif + + call time_interp_external_init + +! Optionally read a x-y gustiness field in place of a global +! constant. + + call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & + "If true, use a 2-dimensional gustiness supplied from \n"//& + "an input file", default=.false.) + call get_param(param_file, 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"//& + "variable gustiness.") + + 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 + endif + +! 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"//& + "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"//& + "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"//& + "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"//& + "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"//& + "as seen by MOM6.", default=.false.) + call register_forcing_type_diags(Time, diag, CS%use_temperature, CS%handles, & + use_berg_fluxes=iceberg_flux_diags) + + call get_param(param_file, mdl, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, & + "If true, allows flux adjustments to specified via the \n"//& + "data_table using the component name 'OCN'.", default=.false.) + if (CS%allow_flux_adjustments) then + call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) + endif + + 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) + 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) + endif ; endif + + ! Set up any restart fields associated with the forcing. + call restart_init(param_file, CS%restart_CSp, "MOM_forcing.res") +!### call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & +!### CS%restart_CSp) + call restart_init_end(CS%restart_CSp) + + if (associated(CS%restart_CSp)) then + call Get_MOM_Input(dirs=dirs) + + new_sim = .false. + if ((dirs%input_filename(1:1) == 'n') .and. & + (LEN_TRIM(dirs%input_filename) == 1)) new_sim = .true. + if (.not.new_sim) then + call restore_state(dirs%input_filename, dirs%restart_input_dir, Time_frc, & + G, CS%restart_CSp) + endif + endif + +!### call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) + + call user_revise_forcing_init(param_file, CS%urf_CS) + + call cpu_clock_end(id_clock_forcing) +end subroutine surface_forcing_init + +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. + + if (present(fluxes)) call deallocate_forcing_type(fluxes) + +!### call controlled_forcing_end(CS%ctrl_forcing_CSp) + + if (associated(CS)) deallocate(CS) + CS => NULL() + +end subroutine surface_forcing_end + +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 + 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%q_flux ', mpp_chksum( iobt%q_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%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 ) + if (associated(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 ) +100 FORMAT(" CHECKSUM::",A20," = ",Z20) + + call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%') + +end subroutine ice_ocn_bnd_type_chksum + +end module MOM_surface_forcing diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index c3967caf6d..9c18b527e4 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -4,87 +4,63 @@ module ocn_comp_mct ! This file is part of MOM6. See LICENSE.md for the license. ! mct modules -use ESMF, only: ESMF_clock, ESMF_time, ESMF_timeInterval, ESMF_TimeInc +use ESMF, only: ESMF_clock, ESMF_time, ESMF_timeInterval use ESMF, only: ESMF_ClockGet, ESMF_TimeGet, ESMF_TimeIntervalGet use seq_cdata_mod, only: seq_cdata, seq_cdata_setptrs -use seq_flds_mod, only: ice_ncat, seq_flds_i2o_per_cat +use seq_flds_mod, only: seq_flds_x2o_fields, seq_flds_o2x_fields +use shr_flds_mod, only: shr_flds_dom_coord, shr_flds_dom_other use mct_mod, only: mct_gsMap, mct_gsmap_init, mct_gsMap_lsize, & mct_gsmap_orderedpoints use mct_mod, only: mct_aVect, mct_aVect_init, mct_aVect_zero, & mct_aVect_nRattr use mct_mod, only: mct_gGrid, mct_gGrid_init, mct_gGrid_importRAttr, & mct_gGrid_importIAttr -use mct_mod, only: mct_avect_indexra, mct_aVect_clean -use seq_flds_mod, only: seq_flds_x2o_fields, seq_flds_o2x_fields, seq_flds_dom_coord, & - seq_flds_dom_other use seq_infodata_mod, only: seq_infodata_type, seq_infodata_GetData, & seq_infodata_start_type_start, seq_infodata_start_type_cont, & seq_infodata_start_type_brnch, seq_infodata_PutData use seq_comm_mct, only: seq_comm_name, seq_comm_inst, seq_comm_suffix use seq_timemgr_mod, only: seq_timemgr_EClockGetData, seq_timemgr_RestartAlarmIsOn use perf_mod, only: t_startf, t_stopf -use shr_kind_mod, only: shr_kind_r8 use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit, shr_file_setIO, & shr_file_getLogUnit, shr_file_getLogLevel, & shr_file_setLogUnit, shr_file_setLogLevel ! MOM6 modules -use MOM_domains, only : MOM_infra_init, MOM_infra_end -use MOM_coms, only : reproducing_sum -use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end -use MOM_cpu_clock, only : CLOCK_SUBCOMPONENT -use MOM, only: initialize_MOM, step_MOM, MOM_control_struct, MOM_end -use MOM, only: extract_surface_state, allocate_surface_state -use MOM, only: finish_MOM_initialization, step_offline -use MOM, only: get_MOM_state_elements, MOM_state_is_synchronized -use MOM_forcing_type, only: forcing, forcing_diags, register_forcing_type_diags -use MOM_forcing_type, only: allocate_forcing_type, deallocate_forcing_type -use MOM_forcing_type, only: mech_forcing_diags, forcing_accumulate, forcing_diagnostics -use MOM_forcing_type, only: mech_forcing, allocate_mech_forcing, copy_back_forcing_fields -use MOM_forcing_type, only: set_net_mass_forcing, set_derived_forcing_fields -use MOM_forcing_type, only: copy_common_forcing_fields +use MOM, only: extract_surface_state +use MOM_variables, only: surface +use MOM_domains, only: MOM_infra_init use MOM_restart, only: save_restart +use MOM_ice_shelf, only: ice_shelf_save_restart use MOM_domains, only: num_pes, root_pe, pe_here -use MOM_domains, only: pass_vector, BGRID_NE, CGRID_NE, To_All -use MOM_domains, only: pass_var, AGRID, fill_symmetric_edges use MOM_grid, only: ocean_grid_type, get_global_grid_size -use MOM_verticalGrid, only: verticalGrid_type -use MOM_variables, only: surface use MOM_error_handler, only: MOM_error, FATAL, is_root_pe, WARNING -use MOM_error_handler, only: callTree_enter, callTree_leave -use MOM_time_manager, only: time_type, set_date, set_time, set_calendar_type, NOLEAP, get_date +use MOM_time_manager, only: time_type, set_date, set_time, set_calendar_type, NOLEAP use MOM_time_manager, only: operator(+), operator(-), operator(*), operator(/) use MOM_time_manager, only: operator(==), operator(/=), operator(>), get_time -use MOM_file_parser, only: get_param, log_version, param_file_type, close_param_file +use MOM_file_parser, only: get_param, log_version, param_file_type use MOM_get_input, only: Get_MOM_Input, directories -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_diag_mediator, only: safe_alloc_ptr -use MOM_ice_shelf, only: initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS -use MOM_ice_shelf, only: ice_shelf_end, ice_shelf_save_restart -use MOM_string_functions, only: uppercase -use MOM_constants, only: CELSIUS_KELVIN_OFFSET, hlf, hlv use MOM_EOS, only: gsw_sp_from_sr, gsw_pt_from_ct -use user_revise_forcing, only : user_alter_forcing, user_revise_forcing_init -use user_revise_forcing, only : user_revise_forcing_CS -use MOM_restart, only : restart_init, MOM_restart_CS -use MOM_restart, only : restart_init_end, save_restart, restore_state -use data_override_mod, only : data_override_init, data_override -use MOM_io, only : slasher, write_version_number -use MOM_spatial_means, only : adjust_area_mean_to_zero +use MOM_constants, only: CELSIUS_KELVIN_OFFSET +use MOM_domains, only: AGRID, BGRID_NE, CGRID_NE, pass_vector +use mpp_domains_mod, only: mpp_get_compute_domain + +! Previously inlined - now in separate modules +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: ocn_export +use MOM_surface_forcing, only: surface_forcing_CS ! FMS modules -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 -use time_interp_external_mod, only : init_external_field, time_interp_external -use time_interp_external_mod, only : time_interp_external_init -use fms_mod, only : read_data +use time_interp_external_mod, only : time_interp_external + +! MCT indices structure and import and export routines that access mom data +use ocn_cpl_indices, only : cpl_indices_type, cpl_indices_init ! GFDL coupler modules -use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type use coupler_types_mod, only : coupler_type_spawn use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data + ! By default make data private implicit none; private @@ -94,283 +70,29 @@ module ocn_comp_mct public :: ocn_init_mct public :: ocn_run_mct public :: ocn_final_mct + ! Flag for debugging logical, parameter :: debug=.true. -!> Structure with MCT attribute vectors and indices -type cpl_indices - - ! ocean to coupler - integer :: o2x_So_t !< Surface potential temperature (deg C) - integer :: o2x_So_u !< Surface zonal velocity (m/s) - integer :: o2x_So_v !< Surface meridional velocity (m/s) - integer :: o2x_So_s !< Surface salinity (PSU) - integer :: o2x_So_dhdx !< Zonal slope in the sea surface height - integer :: o2x_So_dhdy !< Meridional lope in the sea surface height - integer :: o2x_So_bldepth !< Boundary layer depth (m) - integer :: o2x_Fioo_q !< Heat flux? - integer :: o2x_Faoo_fco2_ocn!< CO2 flux - integer :: o2x_Faoo_fdms_ocn!< DMS flux - - ! coupler to ocean - integer :: x2o_Si_ifrac !< Fractional ice wrt ocean - integer :: x2o_So_duu10n !< 10m wind speed squared (m^2/s^2) - integer :: x2o_Sa_pslv !< Sea-level pressure (Pa) - integer :: x2o_Sa_co2prog !< Bottom atm level prognostic CO2 - integer :: x2o_Sa_co2diag !< Bottom atm level diagnostic CO2 - integer :: x2o_Sw_lamult !< Wave model langmuir multiplier - integer :: x2o_Sw_ustokes !< Surface Stokes drift, x-component - integer :: x2o_Sw_vstokes !< Surface Stokes drift, y-component - integer :: x2o_Foxx_taux !< Zonal wind stress (W/m2) - integer :: x2o_Foxx_tauy !< Meridonal wind stress (W/m2) - integer :: x2o_Foxx_swnet !< Net short-wave heat flux (W/m2) - integer :: x2o_Foxx_sen !< Sensible heat flux (W/m2) - integer :: x2o_Foxx_lat !< Latent heat flux (W/m2) - integer :: x2o_Foxx_lwup !< Longwave radiation, up (W/m2) - integer :: x2o_Faxa_lwdn !< Longwave radiation, down (W/m2) - integer :: x2o_Fioi_melth !< Heat flux from snow & ice melt (W/m2) - integer :: x2o_Fioi_meltw !< Snow melt flux (kg/m2/s) - integer :: x2o_Fioi_bcpho !< Black Carbon hydrophobic release - !! from sea ice component - integer :: x2o_Fioi_bcphi !< Black Carbon hydrophilic release from - !! sea ice component - integer :: x2o_Fioi_flxdst !< Dust release from sea ice component - integer :: x2o_Fioi_salt !< Salt flux (kg(salt)/m2/s) - integer :: x2o_Foxx_evap !< Evaporation flux (kg/m2/s) - integer :: x2o_Faxa_prec !< Total precipitation flux (kg/m2/s) - integer :: x2o_Faxa_snow !< Water flux due to snow (kg/m2/s) - integer :: x2o_Faxa_rain !< Water flux due to rain (kg/m2/s) - integer :: x2o_Faxa_bcphidry !< Black Carbon hydrophilic dry deposition - integer :: x2o_Faxa_bcphodry !< Black Carbon hydrophobic dry deposition - integer :: x2o_Faxa_bcphiwet !< Black Carbon hydrophilic wet deposition - integer :: x2o_Faxa_ocphidry !< Organic Carbon hydrophilic dry deposition - integer :: x2o_Faxa_ocphodry !< Organic Carbon hydrophobic dry deposition - integer :: x2o_Faxa_ocphiwet !< Organic Carbon hydrophilic dry deposition - integer :: x2o_Faxa_dstwet1 !< Size 1 dust -- wet deposition - integer :: x2o_Faxa_dstwet2 !< Size 2 dust -- wet deposition - integer :: x2o_Faxa_dstwet3 !< Size 3 dust -- wet deposition - integer :: x2o_Faxa_dstwet4 !< Size 4 dust -- wet deposition - integer :: x2o_Faxa_dstdry1 !< Size 1 dust -- dry deposition - integer :: x2o_Faxa_dstdry2 !< Size 2 dust -- dry deposition - integer :: x2o_Faxa_dstdry3 !< Size 3 dust -- dry deposition - integer :: x2o_Faxa_dstdry4 !< Size 4 dust -- dry deposition - integer :: x2o_Foxx_rofl !< River runoff flux (kg/m2/s) - integer :: x2o_Foxx_rofi !< Ice runoff flux (kg/m2/s) - - ! optional per thickness category fields - integer, dimension(:), allocatable :: x2o_frac_col !< Fraction of ocean cell, - !! per column - integer, dimension(:), allocatable :: x2o_fracr_col!< Fraction of ocean cell used - !! in radiation computations, - !! per column - integer, dimension(:), allocatable :: x2o_qsw_fracr_col !< qsw * fracr, per column -end type cpl_indices - -!> 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. - 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. - - integer :: stagger = -999 !< The staggering relative to the tracer points - !! of the two velocity components. Valid entries - !! include AGRID, BGRID_NE, CGRID_NE, BGRID_SW, and CGRID_SW, - !! corresponding to the community-standard Arakawa notation. - !! (These are named integers taken from mpp_parameter_mod.) - !! Following MOM, this is BGRID_NE by default when the ocean - !! is initialized, but here it is set to -999 so that a - !! global max across ocean and non-ocean processors can be - !! used to determine its value. - real, pointer, dimension(:,:) :: & - t_surf => NULL(), & !< SST on t-cell (degrees Kelvin) - s_surf => NULL(), & !< SSS on t-cell (psu) - u_surf => NULL(), & !< i-velocity at the locations indicated by stagger, m/s. - v_surf => NULL(), & !< j-velocity at the locations indicated by stagger, m/s. - sea_lev => NULL(), & !< Sea level in m after correction for surface pressure, - !! i.e. dzt(1) + eta_t + patm/rho0/grav (m) - frazil =>NULL(), & !< Accumulated heating (in Joules/m^2) from frazil - !! formation in the ocean. - area => NULL() !< cell area of the ocean surface, in m2. - 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. - integer, dimension(2) :: axes = 0 !< Axis numbers that are available - ! for I/O using this surface data. -end type ocean_public_type - -!> Contains pointers to the forcing fields which may be used to drive MOM. -!! All fluxes are positive downward. -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 - 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 :: 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 - !! structure does not limit the water that can be - !! frozen out of the ocean and the ice-ocean heat - !! fluxes are treated explicitly. - logical :: use_limited_P_SSH !< 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. The default is true. - 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. - gust => NULL(), & !< spatially varying unresolved background - !! 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) - real :: cd_tides !< drag coefficient that applies to the tides (nondimensional) - real :: utide !< constant tidal velocity to use if read_tideamp - !! is false, in 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 :: 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. - logical :: allow_flux_adjustments !< If true, use data_override to obtain flux adjustments - 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 :: 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) - 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 - 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 - 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 - 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 - !### 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 -end type surface_forcing_CS - -!> Contains information about the ocean state, although it is not necessary that -!! this is implemented with all models. This type is private, and can therefore vary -!! between different ocean models. -type, public :: ocean_state_type ; private - 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 :: 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 - !! restore sst to a specified value. - real :: press_to_z !< A conversion factor between pressure and ocean - !! depth in m, usually 1/(rho_0*g), in m Pa-1. - real :: C_p !< The heat capacity of seawater, in J K-1 kg-1. - logical :: offline_tracer_mode = .false. !< If false, use the model in prognostic mode - !! with the barotropic and baroclinic dynamics, thermodynamics, - !! etc. stepped forward integrated in time. - !! If true, all of the above are bypassed with all - !! 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 - !! ocean forcing fields for when multiple coupled - !! timesteps are taken per thermodynamic step. - 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(MOM_control_struct), pointer :: MOM_CSp => NULL() - type(surface_forcing_CS), pointer :: forcing_CSp => NULL() - type(MOM_restart_CS), pointer :: & - restart_CSp => NULL() !< A pointer set to the restart control structure - !! that will be used for MOM restart files. - type(diag_ctrl), pointer :: & - diag => NULL() !< A pointer to the diagnostic regulatory structure -end type ocean_state_type - !> Control structure for this module type MCT_MOM_Data - - type(ocean_state_type), pointer :: ocn_state => NULL() !< The private state of ocean - type(ocean_public_type), pointer :: ocn_public => NULL() !< The public state of ocean - type(ocean_grid_type), pointer :: grid => NULL() !< The grid structure - type(surface), pointer :: ocn_surface => NULL() !< The ocean surface state - type(forcing) :: fluxes !< Structure that contains pointers to the - !! boundary forcing used to drive the liquid - !! ocean simulated by MOM. - type(seq_infodata_type), pointer :: infodata !< The input info type - type(cpl_indices), public :: ind !< Variable IDs - ! runtime params - logical :: sw_decomp !< Controls whether shortwave is decomposed into four components - real :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition - ! i/o - character(len=384) :: pointer_filename !< Name of the ascii file that contains the path - !! and filename of the latest restart file. - integer :: stdout !< standard output unit. (by default, it should point to ocn.log.* file) + type(ocean_state_type), pointer :: ocn_state => NULL() !< The private state of ocean + type(ocean_public_type), pointer :: ocn_public => NULL() !< The public state of ocean + type(ocean_grid_type), pointer :: grid => NULL() !< The grid structure + type(seq_infodata_type), pointer :: infodata !< The input info type + type(cpl_indices_type) :: ind !< Variable IDs + logical :: sw_decomp !< Controls whether shortwave is decomposed into four components + real :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition i/o + integer :: stdout !< standard output unit. (by default, it should point to ocn.log.* file) + character(len=384) :: pointer_filename !< Name of the ascii file that contains the path + !! and filename of the latest restart file. end type MCT_MOM_Data -type(MCT_MOM_Data) :: glb !< global structure -integer :: id_clock_forcing +type(MCT_MOM_Data) :: glb !< global structure +!======================================================================= contains +!======================================================================= !> This subroutine initializes MOM6. subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) @@ -382,24 +104,24 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) character(len=*), optional , intent(in) :: NLFilename !< Namelist filename ! local variables - type(time_type) :: time0 !< Model start time - type(ESMF_time) :: time_var !< ESMF_time variable to query time - type(ESMF_time) :: time_in_ESMF !< Initial time for ocean - type(ESMF_timeInterval) :: ocn_cpl_interval !< Ocean coupling interval - integer :: ncouple_per_day - integer :: year, month, day, hour, minute, seconds, seconds_n, seconds_d, rc - character(len=240) :: runid !< Run ID - character(len=32) :: runtype !< Run type - character(len=240) :: restartfile !< Path/Name of restart file - integer :: nu !< i/o unit to read pointer file - character(len=240) :: restart_pointer_file !< File name for restart pointer file - character(len=240) :: restartpath !< Path of the restart file - integer :: mpicom_ocn !< MPI ocn communicator - integer :: npes, pe0 !< # of processors and current processor - integer :: i, errorCode - integer :: lsize, nsend, nrecv - logical :: ldiag_cpl = .false. - integer :: isc, iec, jsc, jec, ni, nj !< Indices for the start and end of the domain + type(time_type) :: time0 !< Model start time + type(ESMF_time) :: time_var !< ESMF_time variable to query time + type(ESMF_time) :: time_in_ESMF !< Initial time for ocean + type(ESMF_timeInterval) :: ocn_cpl_interval !< Ocean coupling interval + integer :: ncouple_per_day + integer :: year, month, day, hour, minute, seconds, seconds_n, seconds_d, rc + character(len=240) :: runid !< Run ID + character(len=32) :: runtype !< Run type + character(len=240) :: restartfile !< Path/Name of restart file + integer :: nu !< i/o unit to read pointer file + character(len=240) :: restart_pointer_file !< File name for restart pointer file + character(len=240) :: restartpath !< Path of the restart file + integer :: mpicom_ocn !< MPI ocn communicator + integer :: npes, pe0 !< # of processors and current processor + integer :: i, errorCode + integer :: lsize, nsend, nrecv + logical :: ldiag_cpl = .false. + integer :: isc, iec, jsc, jec, ni, nj !< Indices for the start and end of the domain !! in the x and y dir., respectively. ! runtime params type(param_file_type) :: param_file !< A structure to parse for run-time parameters @@ -441,7 +163,7 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) gsMap=MOM_MCT_gsMap, dom=MOM_MCT_dom, infodata=glb%infodata) ! Determine attribute vector indices - call coupler_indices_init(glb%ind) + call cpl_indices_init(glb%ind) call seq_infodata_GetData( glb%infodata, case_name=runid ) @@ -482,15 +204,19 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) ! Debugging clocks if (debug .and. is_root_pe()) then write(glb%stdout,*) 'ocn_init_mct, current time: y,m,d-',year,month,day,'h,m,s=',hour,minute,seconds + call ESMF_ClockGet(EClock, StartTime=time_var, rc=rc) call ESMF_TimeGet(time_var, yy=year, mm=month, dd=day, h=hour, m=minute, s=seconds, rc=rc) write(glb%stdout,*) 'ocn_init_mct, start time: y,m,d-',year,month,day,'h,m,s=',hour,minute,seconds + call ESMF_ClockGet(EClock, StopTime=time_var, rc=rc) call ESMF_TimeGet(time_var, yy=year, mm=month, dd=day, h=hour, m=minute, s=seconds, rc=rc) write(glb%stdout,*) 'ocn_init_mct, stop time: y,m,d-',year,month,day,'h,m,s=',hour,minute,seconds + call ESMF_ClockGet(EClock, PrevTime=time_var, rc=rc) call ESMF_TimeGet(time_var, yy=year, mm=month, dd=day, h=hour, m=minute, s=seconds, rc=rc) write(glb%stdout,*) 'ocn_init_mct, previous time: y,m,d-',year,month,day,'h,m,s=',hour,minute,seconds + call ESMF_ClockGet(EClock, TimeStep=ocn_cpl_interval, rc=rc) call ESMF_TimeIntervalGet(ocn_cpl_interval, yy=year, mm=month, d=day, s=seconds, sn=seconds_n, sd=seconds_d, rc=rc) write(glb%stdout,*) 'ocn_init_mct, time step: y,m,d-',year,month,day,'s,sn,sd=',seconds,seconds_n,seconds_d @@ -523,9 +249,11 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) call get_param(param_file, mdl, "SW_c1", glb%c1, & "Coeff. used to convert net shortwave rad. into \n"//& "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"//& "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"//& "near-IR, direct shortwave.", units="nondim", default=0.215) @@ -538,10 +266,13 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) ! Initialize the MOM6 model runtype = get_runtype() - if (runtype == "initial") then ! startup (new run) - 'n' is needed below since we don't - ! specify input_filename in input.nml + if (runtype == "initial") then + + ! startup (new run) - 'n' is needed below since we don't specify input_filename in input.nml call ocean_model_init(glb%ocn_public, glb%ocn_state, time0, time0, input_restart_file = 'n') + else ! hybrid or branch or continuos runs + ! output path root call seq_infodata_GetData( glb%infodata, outPathRoot=restartpath ) ! read name of restart file in the pointer file @@ -556,7 +287,11 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) !endif call shr_file_freeUnit(nu) call ocean_model_init(glb%ocn_public, glb%ocn_state, time0, time0, input_restart_file=trim(restartfile)) + endif + if (is_root_pe()) then + write(glb%stdout,'(/12x,a/)') '======== COMPLETED MOM INITIALIZATION ========' + end if ! Initialize ocn_state%sfc_state out of sight call ocean_model_init_sfc(glb%ocn_state, glb%ocn_public) @@ -651,849 +386,18 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) end subroutine ocn_init_mct -!> Determines attribute vector indices -subroutine coupler_indices_init(ind) - - type(cpl_indices), intent(inout) :: ind !< Structure with coupler indices - !! and vectors - - ! Local Variables - type(mct_aVect) :: o2x !< Array with ocean to coupler data - type(mct_aVect) :: x2o !< Array with coupler to ocean data - - integer :: ncat !< Thickness category index - character(len=2) :: cncat !< Character version of ncat - integer :: ncol !< Column index - integer :: mcog_ncols !< Number of ice thickness categories? - integer :: lmcog_flds_sent !< Used to convert per thickness - !! category fields? - - ! create temporary attribute vectors - call mct_aVect_init(x2o, rList=seq_flds_x2o_fields, lsize=1) - call mct_aVect_init(o2x, rList=seq_flds_o2x_fields, lsize=1) - - ! ocean to coupler - ind%o2x_So_t = mct_avect_indexra(o2x,'So_t') - ind%o2x_So_u = mct_avect_indexra(o2x,'So_u') - ind%o2x_So_v = mct_avect_indexra(o2x,'So_v') - ind%o2x_So_s = mct_avect_indexra(o2x,'So_s') - ind%o2x_So_dhdx = mct_avect_indexra(o2x,'So_dhdx') - ind%o2x_So_dhdy = mct_avect_indexra(o2x,'So_dhdy') - ! QL, 150526, to wav, boundary layer depth - ind%o2x_So_bldepth = mct_avect_indexra(o2x,'So_bldepth') - ind%o2x_Fioo_q = mct_avect_indexra(o2x,'Fioo_q') - ind%o2x_Faoo_fco2_ocn = mct_avect_indexra(o2x,'Faoo_fco2_ocn',perrWith='quiet') - ind%o2x_Faoo_fdms_ocn = mct_avect_indexra(o2x,'Faoo_fdms_ocn',perrWith='quiet') - - ! coupler to ocean - ind%x2o_Si_ifrac = mct_avect_indexra(x2o,'Si_ifrac') - ind%x2o_Sa_pslv = mct_avect_indexra(x2o,'Sa_pslv') - ind%x2o_So_duu10n = mct_avect_indexra(x2o,'So_duu10n') - ! QL, 150526, from wav - ind%x2o_Sw_lamult = mct_avect_indexra(x2o,'Sw_lamult') - ind%x2o_Sw_ustokes = mct_avect_indexra(x2o,'Sw_ustokes') - ind%x2o_Sw_vstokes = mct_avect_indexra(x2o,'Sw_vstokes') - ind%x2o_Foxx_tauy = mct_avect_indexra(x2o,'Foxx_tauy') - ind%x2o_Foxx_taux = mct_avect_indexra(x2o,'Foxx_taux') - ind%x2o_Foxx_swnet = mct_avect_indexra(x2o,'Foxx_swnet') - ind%x2o_Foxx_lat = mct_avect_indexra(x2o,'Foxx_lat') - ind%x2o_Foxx_sen = mct_avect_indexra(x2o,'Foxx_sen') - ind%x2o_Foxx_lwup = mct_avect_indexra(x2o,'Foxx_lwup') - ind%x2o_Faxa_lwdn = mct_avect_indexra(x2o,'Faxa_lwdn') - ind%x2o_Fioi_melth = mct_avect_indexra(x2o,'Fioi_melth') - ind%x2o_Fioi_meltw = mct_avect_indexra(x2o,'Fioi_meltw') - ind%x2o_Fioi_salt = mct_avect_indexra(x2o,'Fioi_salt') - ind%x2o_Fioi_bcpho = mct_avect_indexra(x2o,'Fioi_bcpho') - ind%x2o_Fioi_bcphi = mct_avect_indexra(x2o,'Fioi_bcphi') - ind%x2o_Fioi_flxdst = mct_avect_indexra(x2o,'Fioi_flxdst') - ind%x2o_Faxa_prec = mct_avect_indexra(x2o,'Faxa_prec') - ind%x2o_Faxa_snow = mct_avect_indexra(x2o,'Faxa_snow') - ind%x2o_Faxa_rain = mct_avect_indexra(x2o,'Faxa_rain') - ind%x2o_Foxx_evap = mct_avect_indexra(x2o,'Foxx_evap') - ind%x2o_Foxx_rofl = mct_avect_indexra(x2o,'Foxx_rofl') - ind%x2o_Foxx_rofi = mct_avect_indexra(x2o,'Foxx_rofi') - ind%x2o_Faxa_bcphidry = mct_avect_indexra(x2o,'Faxa_bcphidry') - ind%x2o_Faxa_bcphodry = mct_avect_indexra(x2o,'Faxa_bcphodry') - ind%x2o_Faxa_bcphiwet = mct_avect_indexra(x2o,'Faxa_bcphiwet') - ind%x2o_Faxa_ocphidry = mct_avect_indexra(x2o,'Faxa_ocphidry') - ind%x2o_Faxa_ocphodry = mct_avect_indexra(x2o,'Faxa_ocphodry') - ind%x2o_Faxa_ocphiwet = mct_avect_indexra(x2o,'Faxa_ocphiwet') - ind%x2o_Faxa_dstdry1 = mct_avect_indexra(x2o,'Faxa_dstdry1') - ind%x2o_Faxa_dstdry2 = mct_avect_indexra(x2o,'Faxa_dstdry2') - ind%x2o_Faxa_dstdry3 = mct_avect_indexra(x2o,'Faxa_dstdry3') - ind%x2o_Faxa_dstdry4 = mct_avect_indexra(x2o,'Faxa_dstdry4') - ind%x2o_Faxa_dstwet1 = mct_avect_indexra(x2o,'Faxa_dstwet1') - ind%x2o_Faxa_dstwet2 = mct_avect_indexra(x2o,'Faxa_dstwet2') - ind%x2o_Faxa_dstwet3 = mct_avect_indexra(x2o,'Faxa_dstwet3') - ind%x2o_Faxa_dstwet4 = mct_avect_indexra(x2o,'Faxa_dstwet4') - ind%x2o_Sa_co2prog = mct_avect_indexra(x2o,'Sa_co2prog',perrWith='quiet') - ind%x2o_Sa_co2diag = mct_avect_indexra(x2o,'Sa_co2diag',perrWith='quiet') - ! optional per thickness category fields - - ! convert cpl indices to mcog column indices - ! this implementation only handles columns due to ice thickness categories - lmcog_flds_sent = seq_flds_i2o_per_cat - - if (seq_flds_i2o_per_cat) then - mcog_ncols = ice_ncat+1 - allocate(ind%x2o_frac_col(mcog_ncols)) - allocate(ind%x2o_fracr_col(mcog_ncols)) - allocate(ind%x2o_qsw_fracr_col(mcog_ncols)) - ncol = 1 - ind%x2o_frac_col(ncol) = mct_avect_indexra(x2o,'Sf_afrac') - ind%x2o_fracr_col(ncol) = mct_avect_indexra(x2o,'Sf_afracr') - ind%x2o_qsw_fracr_col(ncol) = mct_avect_indexra(x2o,'Foxx_swnet_afracr') - - do ncat = 1, ice_ncat - write(cncat,'(i2.2)') ncat - ncol = ncat+1 - ind%x2o_frac_col(ncol) = mct_avect_indexra(x2o,'Si_ifrac_'//cncat) - ind%x2o_fracr_col(ncol) = ind%x2o_frac_col(ncol) - ind%x2o_qsw_fracr_col(ncol) = mct_avect_indexra(x2o,'PFioi_swpen_ifrac_'//cncat) - enddo - else - mcog_ncols = 1 - endif - - call mct_aVect_clean(x2o) - call mct_aVect_clean(o2x) - -end subroutine coupler_indices_init - -!> Initializes the ocean model, including registering fields -!! for restarts and reading restart files if appropriate. -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). - 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. - type(time_type), intent(in) :: Time_init !< The start time for the coupled model's calendar - type(time_type), intent(in) :: Time_in !< The time at which to initialize the ocean model. - 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, 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, in kg m-3. - real :: G_Earth !< The gravitational acceleration in m s-2. - !! This include declares and sets the variable "version". -#include "version_variable.h" - character(len=40) :: 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 - - call callTree_enter("ocean_model_init(), ocn_comp_mct.F90") - if (associated(OS)) then - call MOM_error(WARNING, "ocean_model_init called with an associated "// & - "ocean_state_type structure. Model is already initialized.") - return - endif - allocate(OS) - - OS%is_ocean_pe = Ocean_sfc%is_ocean_pe - if (.not.OS%is_ocean_pe) return - - 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, C_p=OS%fluxes%C_p, & - use_temp=use_temperature) - OS%C_p = OS%fluxes%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, "RESTART_CONTROL", OS%Restart_control, & - "An integer whose bits encode which restart files are \n"//& - "written. Add 2 (bit 1) for a time-stamped file, and odd \n"//& - "(bit 0) for a non-time-stamped file. A restart file \n"//& - "will be saved at the end of the run segment for any \n"//& - "non-negative value.", default=1) - call get_param(param_file, 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', '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.") ; 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"//& - "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"//& - "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"//& - "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, & - "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80) - - 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, & - "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 \n"//& - "below berg are set to zero. Not applied for negative \n"//& - " values.", units="non-dim", default=-1.0) - endif - - OS%press_to_z = 1.0/(Rho0*G_Earth) - - ! 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) - - call surface_forcing_init(Time_in, OS%grid, param_file, OS%diag, & - OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) - - if (OS%use_ice_shelf) then - call initialize_ice_shelf(param_file, OS%grid, OS%Time, OS%ice_shelf_CSp, & - OS%diag, OS%forces, OS%fluxes) - 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.) - 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, & - gas_fields_ocn=gas_fields_ocn) - else - call initialize_ocean_public_type(OS%grid%Domain%mpp_domain, Ocean_sfc, & - OS%diag, gas_fields_ocn=gas_fields_ocn) - endif - - ! 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 extract_surface_state(OS%MOM_CSp, OS%sfc_state) - - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) - endif - - call close_param_file(param_file) - call diag_mediator_close_registration(OS%diag) - - if (is_root_pe()) & - write(glb%stdout,'(/12x,a/)') '======== COMPLETED MOM INITIALIZATION ========' - - call callTree_leave("ocean_model_init(") -end subroutine ocean_model_init - -!> 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 - type(ocean_public_type), intent(inout) :: Ocean_sfc - - integer :: is, ie, js, je - - is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec - call coupler_type_spawn(Ocean_sfc%fields, OS%sfc_state%tr_fields, & - (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) - - call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) - -end subroutine ocean_model_init_sfc - -!> Initializes surface forcing: get relevant parameters and allocate arrays. -subroutine surface_forcing_init(Time, G, 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(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 - - ! 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=48) :: stagger - character(len=240) :: basin_file - integer :: i, j, isd, ied, jsd, jed - - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - - if (associated(CS)) then - call MOM_error(WARNING, "surface_forcing_init called with an associated "// & - "control structure.") - return - endif - allocate(CS) - - id_clock_forcing=cpu_clock_id('Ocean surface forcing', grain=CLOCK_SUBCOMPONENT) - call cpu_clock_begin(id_clock_forcing) - - CS%diag => diag - - call write_version_number (version) - ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mdl, version, "") - - call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, & - "The directory in which all input files are found.", & - default=".") - CS%inputdir = slasher(CS%inputdir) - call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & - "If true, Temperature and salinity are used as state \n"//& - "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"//& - "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, & - "The latent heat of fusion.", units="J/kg", default=hlf) - 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"//& - "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"//& - "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"//& - "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"//& - "by the ocean (including restoring) to zero.", 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"//& - "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"//& - "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"//& - "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 \n"//& - "staggering of the input wind stress field. Valid \n"//& - "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 - elseif (uppercase(stagger(1:1)) == 'C') then ; CS%wind_stagger = CGRID_NE - else ; call MOM_error(FATAL,"surface_forcing_init: WIND_STAGGER = "// & - trim(stagger)//" is invalid.") ; endif - call get_param(param_file, mdl, "WIND_STRESS_MULTIPLIER", CS%wind_stress_multiplier, & - "A factor multiplying the wind-stress given to the ocean by the\n"//& - "coupler. This is used for testing and should be =1.0 for any\n"//& - "production runs.", default=1.0) - - if (restore_salt) then - call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & - "The constant that relates the restoring surface fluxes \n"//& - "to the relative surface anomalies (akin to a piston \n"//& - "velocity). Note the non-MKS units.", units="m day-1", & - fail_if_missing=.true.) - call get_param(param_file, mdl, "SALT_RESTORE_FILE", CS%salt_restore_file, & - "A file in which to find the surface salinity to use for restoring.", & - default="salt_restore.nc") - call get_param(param_file, mdl, "SALT_RESTORE_VARIABLE", CS%salt_restore_var_name, & - "The name of the surface salinity variable to read from "//& - "SALT_RESTORE_FILE for restoring salinity.", & - default="salt") -! Convert CS%Flux_const from m day-1 to m s-1. - CS%Flux_const = CS%Flux_const / 86400.0 - - call get_param(param_file, mdl, "SRESTORE_AS_SFLUX", CS%salt_restore_as_sflux, & - "If true, the restoring of salinity is applied as a salt \n"//& - "flux instead of as a freshwater flux.", default=.false.) - call get_param(param_file, 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"//& - "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"//& - "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'.", & - default="basin.nc") - 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) - 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 - 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"//& - "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, & - "A file in which to find the surface temperature to use for restoring.", & - default="temp_restore.nc") - call get_param(param_file, mdl, "SST_RESTORE_VARIABLE", CS%temp_restore_var_name, & - "The name of the surface temperature variable to read from "//& - "SST_RESTORE_FILE for restoring sst.", & - default="temp") -! Convert CS%Flux_const from m day-1 to m s-1. - CS%Flux_const = CS%Flux_const / 86400.0 - - call get_param(param_file, mdl, "MAX_DELTA_TRESTORE", CS%max_delta_trestore, & - "The maximum sst difference used in restoring terms.", & - units="degC ", default=999.0) - - endif - -! 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. - call get_param(param_file, mdl, "CD_TIDES", CS%cd_tides, & - "The drag coefficient that applies to the tides.", & - units="nondim", default=1.0e-4) - call get_param(param_file, mdl, "READ_TIDEAMP", CS%read_TIDEAMP, & - "If true, read a file (given by TIDEAMP_FILE) containing \n"//& - "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) - if (CS%read_TIDEAMP) then - call get_param(param_file, mdl, "TIDEAMP_FILE", TideAmp_file, & - "The path to the file containing the spatially varying \n"//& - "tidal amplitudes with INT_TIDE_DISSIPATION.", & - default="tideamp.nc") - CS%utide=0.0 - else - call get_param(param_file, mdl, "UTIDE", CS%utide, & - "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & - units="m s-1", default=0.0) - endif - - call safe_alloc_ptr(CS%TKE_tidal,isd,ied,jsd,jed) - call safe_alloc_ptr(CS%ustar_tidal,isd,ied,jsd,jed) - - 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) - 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) - CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide - enddo ; enddo - else - do j=jsd,jed; do i=isd,ied - utide=CS%utide - CS%TKE_tidal(i,j) = CS%Rho0*CS%cd_tides*(utide*utide*utide) - CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide - enddo ; enddo - endif - - call time_interp_external_init - -! Optionally read a x-y gustiness field in place of a global -! constant. - - call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & - "If true, use a 2-dimensional gustiness supplied from \n"//& - "an input file", default=.false.) - call get_param(param_file, 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"//& - "variable gustiness.") - - 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 - endif - -! 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"//& - "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"//& - "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"//& - "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"//& - "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"//& - "as seen by MOM6.", default=.false.) - call register_forcing_type_diags(Time, diag, CS%use_temperature, CS%handles, & - use_berg_fluxes=iceberg_flux_diags) - - call get_param(param_file, mdl, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, & - "If true, allows flux adjustments to specified via the \n"//& - "data_table using the component name 'OCN'.", default=.false.) - if (CS%allow_flux_adjustments) then - call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) - endif - - 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) - 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) - endif ; endif - - ! Set up any restart fields associated with the forcing. - call restart_init(param_file, CS%restart_CSp, "MOM_forcing.res") -!### call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & -!### CS%restart_CSp) - call restart_init_end(CS%restart_CSp) - - if (associated(CS%restart_CSp)) then - call Get_MOM_Input(dirs=dirs) - - new_sim = .false. - if ((dirs%input_filename(1:1) == 'n') .and. & - (LEN_TRIM(dirs%input_filename) == 1)) new_sim = .true. - if (.not.new_sim) then - call restore_state(dirs%input_filename, dirs%restart_input_dir, Time_frc, & - G, CS%restart_CSp) - endif - endif - -!### call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) - - call user_revise_forcing_init(param_file, CS%urf_CS) - - call cpu_clock_end(id_clock_forcing) -end subroutine surface_forcing_init - -!> Initializes domain and state variables contained in the ocean public 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(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 - integer :: xsz, ysz, layout(2) - integer :: isc, iec, jsc, jec - - call mpp_get_layout(input_domain,layout) - call mpp_get_global_domain(input_domain, xsize=xsz, ysize=ysz) - if(PRESENT(maskmap)) then - call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain, maskmap=maskmap) - else - call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain) - endif - call mpp_get_compute_domain(Ocean_sfc%Domain, isc, iec, jsc, jec) - - allocate ( Ocean_sfc%t_surf (isc:iec,jsc:jec), & - Ocean_sfc%s_surf (isc:iec,jsc:jec), & - Ocean_sfc%u_surf (isc:iec,jsc:jec), & - Ocean_sfc%v_surf (isc:iec,jsc:jec), & - Ocean_sfc%sea_lev(isc:iec,jsc:jec), & - Ocean_sfc%area (isc:iec,jsc:jec), & - Ocean_sfc%frazil (isc:iec,jsc:jec)) - - Ocean_sfc%t_surf = 0.0 ! time averaged sst (Kelvin) passed to atmosphere/ice model - Ocean_sfc%s_surf = 0.0 ! time averaged sss (psu) passed to atmosphere/ice models - Ocean_sfc%u_surf = 0.0 ! time averaged u-current (m/sec) passed to atmosphere/ice models - Ocean_sfc%v_surf = 0.0 ! time averaged v-current (m/sec) passed to atmosphere/ice models - Ocean_sfc%sea_lev = 0.0 ! time averaged thickness of top model grid cell (m) plus patm/rho0/grav - Ocean_sfc%frazil = 0.0 ! time accumulated frazil (J/m^2) passed to ice model - Ocean_sfc%area = 0.0 - Ocean_sfc%axes = diag%axesT1%handles !diag axes to be used by coupler tracer flux diagnostics - - if (present(gas_fields_ocn)) then - call coupler_type_spawn(gas_fields_ocn, Ocean_sfc%fields, (/isc,isc,iec,iec/), & - (/jsc,jsc,jec,jec/), suffix = '_ocn', as_needed=.true.) - endif - -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 - 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 mpp_get_compute_domain(Ocean_sfc%Domain, isc_bnd, iec_bnd, & - jsc_bnd, jec_bnd) - if (present(patm)) then - ! Check that the inidicies in patm are (isc_bnd:iec_bnd,jsc_bnd:jec_bnd). - if (.not.present(press_to_z)) call MOM_error(FATAL, & - 'convert_state_to_ocean_type: press_to_z must be present if patm is.') - endif - - i0 = is - isc_bnd ; j0 = js - jsc_bnd - if (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 - 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 - enddo ; enddo - endif - if (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)) - 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) - 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) - 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) - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) - enddo ; enddo - - 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)) - 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)) - 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) - enddo ; enddo - else - write(val_str, '(I8)') Ocean_sfc%stagger - call MOM_error(FATAL, "convert_state_to_ocean_type: "//& - "Ocean_sfc%stagger has the unrecognized value of "//trim(val_str)) - endif - - if (coupler_type_initialized(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) - endif - -end subroutine convert_state_to_ocean_type +!======================================================================= !> Returns pointers to objects within ocean_state_type -subroutine get_state_pointers(OS, grid, surf) +subroutine get_state_pointers(OS, grid) type(ocean_state_type), pointer :: OS !< Ocean state type type(ocean_grid_type), optional, pointer :: grid !< Ocean grid - type(surface), optional, pointer :: surf !< Ocean surface state if (present(grid)) grid => OS%grid - if (present(surf)) surf=> OS%sfc_state end subroutine get_state_pointers -!> Maps outgoing ocean data to MCT buffer. -!! See \ref section_ocn_export for a summary of the data -!! that is transferred from MOM6 to MCT. -subroutine ocn_export(ind, ocn_public, grid, o2x) - type(cpl_indices), intent(inout) :: ind !< Structure with coupler - !! indices and vectors - type(ocean_public_type), intent(in) :: ocn_public !< Ocean surface state - type(ocean_grid_type), intent(in) :: grid !< Ocean model grid - real(kind=8), intent(inout) :: o2x(:,:) !< MCT outgoing bugger - ! Local variables - real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo - integer :: i, j, n, ig, jg !< Grid indices - real :: slp_L, slp_R, slp_C, slope, u_min, u_max - - ! Copy from ocn_public to o2x. ocn_public uses global indexing with no halos. - ! The mask comes from "grid" that uses the usual MOM domain that has halos - ! and does not use global indexing. - n = 0 - do j=grid%jsc, grid%jec - jg = j + grid%jdg_offset - do i=grid%isc,grid%iec - n = n+1 - ig = i + grid%idg_offset - ! surface temperature in Kelvin - o2x(ind%o2x_So_t, n) = ocn_public%t_surf(ig,jg) * grid%mask2dT(i,j) - o2x(ind%o2x_So_s, n) = ocn_public%s_surf(ig,jg) * grid%mask2dT(i,j) - o2x(ind%o2x_So_u, n) = ocn_public%u_surf(ig,jg) * grid%mask2dT(i,j) - o2x(ind%o2x_So_v, n) = ocn_public%v_surf(ig,jg) * grid%mask2dT(i,j) - ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain - ! in order to update halos. i.e. does not use global indexing. - ssh(i,j) = ocn_public%sea_lev(ig,jg) - end do - end do - - ! Update halo of ssh so we can calculate gradients - call pass_var(ssh, grid%domain) - - ! d/dx ssh - n = 0 - do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec - n = n+1 - ! This is a simple second-order difference - !o2x(ind%o2x_So_dhdx, n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) - if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. - slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(I,j) - if (grid%mask2dCu(I+1,j)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - if ( (slp_L * slp_R) > 0.0 ) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - o2x(ind%o2x_So_dhdx, n) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdx, n) = 0.0 - end do; end do - - ! d/dy ssh - n = 0 - do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec - n = n+1 - ! This is a simple second-order difference - !o2x(ind%o2x_So_dhdy, n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) - if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. - slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,J) - if (grid%mask2dCv(i,J+1)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R - if ((slp_L * slp_R) > 0.0) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - o2x(ind%o2x_So_dhdy, n) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdy, n) = 0.0 - end do; end do - -end subroutine ocn_export +!======================================================================= !> Step forward ocean model for coupling interval subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o) @@ -1583,8 +487,9 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o) ! GMM, check if this is needed! call seq_cdata_setptrs(cdata_o, infodata=glb%infodata) + ! Note that update_ocean_model calls ocn_import call update_ocean_model(glb%ocn_state, glb%ocn_public, time_start, coupling_timestep, & - x2o_o%rattr, glb%ind, glb%sw_decomp, glb%c1, glb%c2, glb%c3, glb%c4) + x2o_o%rattr, glb%ind, glb%sw_decomp, glb%c1, glb%c2, glb%c3, glb%c4) ! return export state to driver call ocn_export(glb%ind, glb%ocn_public, glb%grid, o2x_o%rattr) @@ -1636,786 +541,7 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o) end subroutine ocn_run_mct -!> Saves restart fields associated with the 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(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 - 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 - -!> 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. -subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, & - Ocean_coupling_time_step, x2o_o, ind, sw_decomp, & - c1, c2, c3, c4) - type(ocean_state_type), pointer :: OS !< Structure containing the internal ocean state - type(ocean_public_type), intent(inout) :: Ocean_sfc !< Structure containing all the publicly - !! visible ocean surface fields after a coupling time step - type(time_type), intent(in) :: time_start_update !< Time at the beginning of the update step - type(time_type), intent(in) :: Ocean_coupling_time_step !< Amount of time over which to - !! advance the ocean - real(kind=8), intent(in) :: x2o_o(:,:) !< Fluxes from coupler to ocean, computed by ocean - type(cpl_indices), intent(inout) :: ind !< Structure with MCT attribute vectors and indices - logical, intent(in) :: sw_decomp !< controls if shortwave is - !!decomposed into four components - real(kind=8), optional, intent(in) :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition - - ! 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. - real :: weight !< Flux accumulation weight - real :: time_step !< The time step of a call to step_MOM in seconds. - integer :: secs, days - integer :: is, ie, js, je - - call callTree_enter("update_ocean_model(), ocn_comp_mct.F90") - call get_time(Ocean_coupling_time_step, secs, days) - time_step = 86400.0*real(days) + real(secs) - - if (time_start_update /= OS%Time) then - call MOM_error(WARNING, "update_ocean_model: internal clock does not "//& - "agree with time_start_update argument.") - endif - - if (.not.associated(OS)) then - call MOM_error(FATAL, "update_ocean_model called with an unassociated "// & - "ocean_state_type structure. ocean_model_init must be "// & - "called first to allocate this structure.") - return - endif - - ! 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 - call coupler_type_spawn(Ocean_sfc%fields, OS%sfc_state%tr_fields, & - (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) - - weight = 1.0 - - 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) - call ocn_import(OS%forces, OS%fluxes, OS%Time, OS%grid, OS%forcing_CSp, OS%sfc_state, x2o_o, ind, sw_decomp, & - c1, c2, c3, c4, 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 - - ! Add ice shelf fluxes - if (OS%use_ice_shelf) then - call shelf_calc_flux(OS%sfc_state, OS%forces, OS%fluxes, OS%Time, time_step, OS%Ice_shelf_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) - !endif - - ! Indicate that there are new unused fluxes. - OS%fluxes%fluxes_used = .false. - OS%fluxes%dt_buoy_accum = time_step - 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 ocn_import(OS%forces, OS%flux_tmp, OS%Time, OS%grid, OS%forcing_CSp, & - OS%sfc_state, x2o_o, ind, sw_decomp, c1, c2, c3, c4, & - OS%restore_salinity,OS%restore_temp) - - if (OS%use_ice_shelf) then - call shelf_calc_flux(OS%sfc_state, OS%forces, OS%flux_tmp, OS%Time, time_step, OS%Ice_shelf_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) - !endif - - ! Accumulate the forcing over time steps - call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, time_step, 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. - 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 - endif - - call set_derived_forcing_fields(OS%forces, OS%fluxes, OS%grid, OS%GV%Rho0) - call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid) - - if (OS%nstep==0) then - call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, S%restart_CSp) - endif - - call disable_averaging(OS%diag) - 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) - else - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, time_step, OS%MOM_CSp) - 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, OS%fluxes, time_step, OS%grid, & - OS%diag, OS%forcing_CSp%handles) - call disable_averaging(OS%diag) - - if (OS%fluxes%fluxes_used) then - call enable_averaging(OS%fluxes%dt_buoy_accum, OS%Time, OS%diag) - call forcing_diagnostics(OS%fluxes, OS%sfc_state, OS%fluxes%dt_buoy_accum, & - OS%grid, OS%diag, OS%forcing_CSp%handles) - call disable_averaging(OS%diag) - endif - -! Translate state into Ocean. -! 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 callTree_leave("update_ocean_model()") -end subroutine update_ocean_model - -!> 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. -subroutine ocn_import(forces, fluxes, Time, G, CS, state, x2o_o, ind, sw_decomp, & - c1, c2, c3, c4, restore_salt, restore_temp) - type(mech_forcing), intent(inout) :: forces !< Driving mechanical forces - type(forcing), intent(inout) :: fluxes !< Surface fluxes - type(time_type), intent(in) :: Time !< Model time - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid - type(surface_forcing_CS), pointer :: CS !< control structure returned by - !! a previous call to surface_forcing_init - type(surface), intent(in) :: state !< control structure to ocean - !! surface state fields. - real(kind=8), intent(in) :: x2o_o(:,:)!< Fluxes from coupler to ocean, computed by ocean - type(cpl_indices), intent(inout) :: ind !< Structure with MCT attribute vectors and indices - logical, intent(in) :: sw_decomp !< controls if shortwave is - !!decomposed into four components - real(kind=8), optional, intent(in) :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition - logical, optional, intent(in) :: restore_salt, restore_temp !< Controls if salt and temp are - !! restored - - ! 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) - - real, dimension(SZI_(G),SZJ_(G)) :: & - taux_at_h, & ! Zonal wind stresses at h points (Pa) - tauy_at_h, & ! Meridional wind stresses at h points (Pa) - 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 - - 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, k, 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 - - real :: C_p ! heat capacity of seawater ( J/(K kg) ) - - call cpu_clock_begin(id_clock_forcing) - - 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 - - C_p = fluxes%C_p - Irho0 = 1.0/CS%Rho0 - open_ocn_mask(:,:) = 1.0 - pme_adj(:,:) = 0.0 - fluxes%vPrecGlobalAdj = 0.0 - fluxes%vPrecGlobalScl = 0.0 - fluxes%saltFluxGlobalAdj = 0.0 - fluxes%saltFluxGlobalScl = 0.0 - fluxes%netFWGlobalAdj = 0.0 - fluxes%netFWGlobalScl = 0.0 - - restore_salinity = .false. - if (present(restore_salt)) restore_salinity = restore_salt - restore_sst = .false. - if (present(restore_temp)) restore_sst = restore_temp - - ! if true, allocation and initialization - if (fluxes%dt_buoy_accum < 0) then - call allocate_forcing_type(G, fluxes, water=.true., heat=.true., & - ustar=.true., press=.true.) - call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., & - press=.true.) - call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%sw_nir_dir,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%sw_nir_dif,isd,ied,jsd,jed) - - call safe_alloc_ptr(fluxes%p_surf,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%p_surf_full,isd,ied,jsd,jed) - - call safe_alloc_ptr(fluxes%salt_flux,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%salt_flux_in,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) - - call safe_alloc_ptr(fluxes%TKE_tidal,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%ustar_tidal,isd,ied,jsd,jed) - - if (CS%allow_flux_adjustments) then - call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) - endif - - do j=js-2,je+2 ; do i=is-2,ie+2 - fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) - fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) - enddo; enddo - - 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) - endif - - if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) - - fluxes%dt_buoy_accum = 0.0 - endif ! endif for allocation and initialization - - if (CS%allow_flux_adjustments) then - fluxes%heat_added(:,:)=0.0 - fluxes%salt_flux_added(:,:)=0.0 - endif - if (associated(forces%rigidity_ice_u)) forces%rigidity_ice_u(:,:) = 0.0 - if (associated(forces%rigidity_ice_v)) forces%rigidity_ice_v(:,:) = 0.0 - - 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) - enddo ; enddo - CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) - endif ! endif for allocation and initialization - - do j=js,je ; do i=is,ie - fluxes%salt_flux(i,j) = 0.0 - fluxes%vprec(i,j) = 0.0 - enddo ; enddo - - ! Salinity restoring logic - if (restore_salinity) then - call time_interp_external(CS%id_srestore,Time,data_restore) - ! open_ocn_mask indicates where to restore salinity (1 means restore, 0 does not) - open_ocn_mask(:,:) = 1.0 - if (CS%mask_srestore_under_ice) then ! Do not restore under sea-ice - do j=js,je ; do i=is,ie - if (state%SST(i,j) .le. -0.0539*state%SSS(i,j)) open_ocn_mask(i,j)=0.0 - enddo; enddo - endif - if (CS%salt_restore_as_sflux) then - do j=js,je ; do i=is,ie - delta_sss = data_restore(i,j)- 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 - enddo; enddo - if (CS%adjust_net_srestore_to_zero) then - if (CS%adjust_net_srestore_by_scaling) then - call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) - fluxes%saltFluxGlobalAdj = 0. - else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf - fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj - endif - endif - fluxes%salt_flux_added(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) ! Diagnostic - else - do j=js,je ; do i=is,ie - if (G%mask2dT(i,j) > 0.5) then - delta_sss = 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))* & - (CS%Rho0*CS%Flux_const) * & - delta_sss / (0.5*(state%SSS(i,j) + data_restore(i,j))) - endif - enddo; enddo - if (CS%adjust_net_srestore_to_zero) then - if (CS%adjust_net_srestore_by_scaling) then - call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) - fluxes%vPrecGlobalAdj = 0. - else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) - fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf - do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) - enddo; enddo - endif - endif - endif - endif - - ! SST restoring logic - if (restore_sst) then - call time_interp_external(CS%id_trestore,Time,data_restore) - do j=js,je ; do i=is,ie - delta_sst = data_restore(i,j)- 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 - enddo; enddo - endif - - ! GMM, CIME uses AGRID. All the BGRID_NE code can be cleaned later - wind_stagger = AGRID - - 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 - endif - if (wind_stagger == AGRID) then - ! This is necessary to fill in the halo points. - taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 - endif - - k = 0 - do j=js,je ; do i=is,ie - k = k + 1 ! Increment position within gindex - - if (wind_stagger == BGRID_NE) then - taux_at_q(I,J) = x2o_o(ind%x2o_Foxx_taux,k) * CS%wind_stress_multiplier - tauy_at_q(I,J) = x2o_o(ind%x2o_Foxx_tauy,k) * CS%wind_stress_multiplier - ! GMM, cime uses AGRID - elseif (wind_stagger == AGRID) then - taux_at_h(i,j) = x2o_o(ind%x2o_Foxx_taux,k) * CS%wind_stress_multiplier - tauy_at_h(i,j) = x2o_o(ind%x2o_Foxx_tauy,k) * CS%wind_stress_multiplier - else ! C-grid wind stresses. - forces%taux(I,j) = x2o_o(ind%x2o_Foxx_taux,k) * CS%wind_stress_multiplier - forces%tauy(i,J) = x2o_o(ind%x2o_Foxx_tauy,k) * CS%wind_stress_multiplier - endif - - ! liquid precipitation (rain) - if (associated(fluxes%lprec)) & - fluxes%lprec(i,j) = x2o_o(ind%x2o_Faxa_rain,k) * G%mask2dT(i,j) - - ! frozen precipitation (snow) - if (associated(fluxes%fprec)) & - fluxes%fprec(i,j) = x2o_o(ind%x2o_Faxa_snow,k) * G%mask2dT(i,j) - - ! evaporation - if (associated(fluxes%evap)) & - fluxes%evap(i,j) = x2o_o(ind%x2o_Foxx_evap,k) * G%mask2dT(i,j) - - ! river runoff flux - if (associated(fluxes%lrunoff)) & - fluxes%lrunoff(i,j) = x2o_o(ind%x2o_Foxx_rofl,k) * G%mask2dT(i,j) - - ! ice runoff flux - if (associated(fluxes%frunoff)) & - fluxes%frunoff(i,j) = x2o_o(ind%x2o_Foxx_rofi,k) * G%mask2dT(i,j) - - ! 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) = 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) - - ! longwave radiation, sum up and down (W/m2) - if (associated(fluxes%LW)) & - fluxes%LW(i,j) = (x2o_o(ind%x2o_Faxa_lwdn,k) + x2o_o(ind%x2o_Foxx_lwup,k)) * G%mask2dT(i,j) - - ! sensible heat flux (W/m2) - if (associated(fluxes%sens)) & - fluxes%sens(i,j) = x2o_o(ind%x2o_Foxx_sen,k) * G%mask2dT(i,j) - - ! latent heat flux (W/m^2) - if (associated(fluxes%latent)) & - fluxes%latent(i,j) = x2o_o(ind%x2o_Foxx_lat,k) * G%mask2dT(i,j) - - if (sw_decomp) then - ! Use runtime coefficients to decompose net short-wave heat flux into 4 components - ! 1) visible, direct shortwave (W/m2) - if (associated(fluxes%sw_vis_dir)) & - fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * x2o_o(ind%x2o_Foxx_swnet,k)*c1 - ! 2) visible, diffuse shortwave (W/m2) - if (associated(fluxes%sw_vis_dif)) & - fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * x2o_o(ind%x2o_Foxx_swnet,k)*c2 - ! 3) near-IR, direct shortwave (W/m2) - if (associated(fluxes%sw_nir_dir)) & - fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * x2o_o(ind%x2o_Foxx_swnet,k)*c3 - ! 4) near-IR, diffuse shortwave (W/m2) - if (associated(fluxes%sw_nir_dif)) & - fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * x2o_o(ind%x2o_Foxx_swnet,k)*c4 - - 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) - else - call MOM_error(FATAL,"fill_ice_ocean_bnd: this option has not been implemented yet."// & - "Shortwave must be decomposed using coeffs. c1, c2, c3, c4."); - endif - - ! applied surface pressure from atmosphere and cryosphere - ! sea-level pressure (Pa) - if (associated(forces%p_surf_full) .and. associated(forces%p_surf)) then - forces%p_surf_full(i,j) = G%mask2dT(i,j) * x2o_o(ind%x2o_Sa_pslv,k) - if (CS%max_p_surf >= 0.0) then - forces%p_surf(i,j) = MIN(forces%p_surf_full(i,j),CS%max_p_surf) - else - forces%p_surf(i,j) = forces%p_surf_full(i,j) - endif - - if (CS%use_limited_P_SSH) then - forces%p_surf_SSH => forces%p_surf - else - forces%p_surf_SSH => forces%p_surf_full - endif - - endif - - ! salt flux - ! more salt restoring logic - if (associated(fluxes%salt_flux)) & - fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(x2o_o(ind%x2o_Fioi_salt,k) + fluxes%salt_flux(i,j)) - - if (associated(fluxes%salt_flux_in)) & - fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*x2o_o(ind%x2o_Fioi_salt,k) - - enddo ; enddo - ! ############################ END OF MCT to MOM ############################## - - ! adjust the NET fresh-water flux to zero, if flagged - if (CS%adjust_net_fresh_water_to_zero) then - do j=js,je ; do i=is,ie - net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(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 - 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 - - if (CS%adjust_net_fresh_water_by_scaling) then - call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) - do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) - enddo; enddo - else - fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf - do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%netFWGlobalAdj ) * G%mask2dT(i,j) - enddo; enddo - endif - - endif - - ! surface momentum stress related fields as function of staggering - 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) - - do j=js,je ; do I=Isq,Ieq - forces%taux(I,j) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & - forces%taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + & - G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) - enddo ; enddo - - do J=Jsq,Jeq ; do i=is,ie - forces%tauy(i,J) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & - forces%tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + & - G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) - enddo ; enddo - - ! ustar is required for the bulk mixed layer formulation. The background value - ! of 0.02 Pa is a relatively small value intended to give reasonable behavior - ! in regions of very weak winds. - - do j=js,je ; do i=is,ie - tau_mag = 0.0 ; gustiness = CS%gust_const - if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & - (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then - tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & - G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & - (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & - G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & - ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) - if (CS%read_gust_2d) gustiness = CS%gust(i,j) - endif - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) - enddo ; enddo - - elseif (wind_stagger == AGRID) then - call pass_vector(taux_at_h, tauy_at_h, G%Domain,stagger=AGRID) - - do j=js,je ; do I=Isq,Ieq - forces%taux(I,j) = 0.0 - if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & - forces%taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + & - G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & - (G%mask2dT(i,j) + G%mask2dT(i+1,j)) - enddo ; enddo - - do J=Jsq,Jeq ; do i=is,ie - forces%tauy(i,J) = 0.0 - if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & - forces%tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + & - G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & - (G%mask2dT(i,j) + G%mask2dT(i,j+1)) - enddo ; enddo - - do j=js,je ; do i=is,ie - gustiness = CS%gust_const - if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & - sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) - enddo ; enddo - - 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) - - do j=js,je ; do i=is,ie - taux2 = 0.0 - if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & - taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + & - G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) - - tauy2 = 0.0 - if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & - tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + & - G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) - - if (CS%read_gust_2d) then - forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) - else - forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) - endif - enddo ; enddo - - endif ! endif for wind related fields - - - ! sea ice related fields - if (CS%rigid_sea_ice) then - ! The commented out code here and in the following lines is the correct - ! version, but the incorrect version is being retained temporarily to avoid - ! changing answers. - call pass_var(forces%p_surf_full, G%Domain) - I_GEarth = 1.0 / G%G_Earth - Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) - do I=isd,ied-1 ; do j=jsd,jed - mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth - mass_eff = 0.0 - if (mass_ice > CS%rigid_sea_ice_mass) then - mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & - (mass_ice + CS%rigid_sea_ice_mass) - endif - ! CAUTION: with both rigid_sea_ice and ice shelves, we will need to make this - ! a maximum for the second call. - forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + Kv_rho_ice * mass_eff - enddo ; enddo - do i=isd,ied ; do J=jsd,jed-1 - mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i,j+1)) * I_GEarth - mass_eff = 0.0 - if (mass_ice > CS%rigid_sea_ice_mass) then - mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & - (mass_ice + CS%rigid_sea_ice_mass) - endif - forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + Kv_rho_ice * mass_eff - enddo ; enddo - endif - - if (CS%allow_flux_adjustments) then - ! Apply adjustments to fluxes - call apply_flux_adjustments(G, CS, Time, forces, fluxes) - endif - - ! Allow for user-written code to alter fluxes after all the above - call user_alter_forcing(state, fluxes, Time, G, CS%urf_CS) - - call cpu_clock_end(id_clock_forcing) - -end subroutine ocn_import - -!> Adds 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) -subroutine apply_flux_adjustments(G, CS, Time, forces, 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(mech_forcing), intent(inout) :: forces !< Driving mechanical forces - type(forcing), optional, 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) - - integer :: isc, iec, jsc, jec, i, j - real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau - logical :: overrode_x, overrode_y, overrode_h - - 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) - - 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 - - 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) - - - tempx_at_h(:,:) = 0.0 ; tempy_at_h(:,:) = 0.0 - ! Either reads data or leaves contents unchanged - overrode_x = .false. ; overrode_y = .false. - call data_override('OCN', 'taux_adj', tempx_at_h(isc:iec,jsc:jec), Time, override=overrode_x) - call data_override('OCN', 'tauy_adj', tempy_at_h(isc:iec,jsc:jec), Time, override=overrode_y) - - if (overrode_x .or. overrode_y) then - if (.not. (overrode_x .and. overrode_y)) call MOM_error(FATAL,"apply_flux_adjustments: "//& - "Both taux_adj and tauy_adj must be specified, or neither, in data_table") - - ! Rotate winds - call pass_vector(tempx_at_h, tempy_at_h, G%Domain, To_All, AGRID) - do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 - dLonDx = G%geoLonCu(I,j) - G%geoLonCu(I-1,j) - dLonDy = G%geoLonCv(i,J) - G%geoLonCv(i,J-1) - rDlon = sqrt( dLonDx * dLonDx + dLonDy * dLonDy ) - if (rDlon > 0.) rDlon = 1. / rDlon - cosA = dLonDx * rDlon - sinA = dLonDy * rDlon - zonal_tau = tempx_at_h(i,j) - merid_tau = tempy_at_h(i,j) - tempx_at_h(i,j) = cosA * zonal_tau - sinA * merid_tau - tempy_at_h(i,j) = sinA * zonal_tau + cosA * merid_tau - enddo ; enddo - - ! Average to C-grid locations - do j=G%jsc,G%jec ; do I=G%isc-1,G%iec - forces%taux(I,j) = forces%taux(I,j) + 0.5 * ( tempx_at_h(i,j) + tempx_at_h(i+1,j) ) - enddo ; enddo - - do J=G%jsc-1,G%jec ; do i=G%isc,G%iec - forces%tauy(i,J) = forces%tauy(i,J) + 0.5 * ( tempy_at_h(i,j) + tempy_at_h(i,j+1) ) - enddo ; enddo - endif ! overrode_x .or. overrode_y - -end subroutine apply_flux_adjustments +!======================================================================= !> Finalizes MOM6 !! @@ -2430,22 +556,7 @@ subroutine ocn_final_mct( EClock, cdata_o, x2o_o, o2x_o) end subroutine ocn_final_mct -!> Terminates the model run, saving the ocean state in a -!! restart file 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. - - 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 +!======================================================================= !> Sets mct global segment maps for the MOM decomposition. !! @@ -2494,6 +605,8 @@ subroutine ocn_SetGSMap_mct(mpicom_ocn, MOM_MCT_ID, gsMap_ocn, gsMap3d_ocn) end subroutine ocn_SetGSMap_mct +!======================================================================= + !> Sets MCT global segment maps for the MOM6 decomposition subroutine ocn_domain_mct( lsize, gsMap_ocn, dom_ocn) integer , intent(in) :: lsize !< Size of attr. vector @@ -2511,8 +624,8 @@ subroutine ocn_domain_mct( lsize, gsMap_ocn, dom_ocn) grid => glb%grid ! for convenience ! set coords to lat and lon, and areas to rad^2 - call mct_gGrid_init(GGrid=dom_ocn, CoordChars=trim(seq_flds_dom_coord), & - OtherChars=trim(seq_flds_dom_other), lsize=lsize ) + call mct_gGrid_init(GGrid=dom_ocn, CoordChars=trim(shr_flds_dom_coord), & + OtherChars=trim(shr_flds_dom_other), lsize=lsize ) call mct_avect_zero(dom_ocn%data) allocate(data(lsize)) @@ -2575,6 +688,8 @@ subroutine ocn_domain_mct( lsize, gsMap_ocn, dom_ocn) end subroutine ocn_domain_mct +!======================================================================= + !> Returns the CESM run type character(32) function get_runtype() character(len=32) :: starttype !< infodata start type @@ -2595,6 +710,143 @@ end subroutine ocn_domain_mct end function +!======================================================================= + +!! 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 + type(ocean_public_type), intent(inout) :: Ocean_sfc + + integer :: is, ie, js, je + + is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec + call coupler_type_spawn(Ocean_sfc%fields, OS%sfc_state%tr_fields, & + (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) + + call extract_surface_state(OS%MOM_CSp, OS%sfc_state) + + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + +end subroutine ocean_model_init_sfc + +!======================================================================= + +!> 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 + 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 mpp_get_compute_domain(Ocean_sfc%Domain, isc_bnd, iec_bnd, & + jsc_bnd, jec_bnd) + if (present(patm)) then + ! Check that the inidicies in patm are (isc_bnd:iec_bnd,jsc_bnd:jec_bnd). + if (.not.present(press_to_z)) call MOM_error(FATAL, & + 'convert_state_to_ocean_type: press_to_z must be present if patm is.') + endif + + i0 = is - isc_bnd ; j0 = js - jsc_bnd + if (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 + 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 + enddo ; enddo + endif + if (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)) + 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) + 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) + 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) + Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + enddo ; enddo + + 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)) + 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)) + 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) + enddo ; enddo + else + write(val_str, '(I8)') Ocean_sfc%stagger + call MOM_error(FATAL, "convert_state_to_ocean_type: "//& + "Ocean_sfc%stagger has the unrecognized value of "//trim(val_str)) + endif + + if (coupler_type_initialized(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) + endif + +end subroutine convert_state_to_ocean_type + +!======================================================================= + +!> Saves restart fields associated with the 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(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 + 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 + +!======================================================================= !> \namespace ocn_comp_mct !! diff --git a/config_src/mct_driver/ocn_cpl_indices.F90 b/config_src/mct_driver/ocn_cpl_indices.F90 new file mode 100644 index 0000000000..1f5c70a59b --- /dev/null +++ b/config_src/mct_driver/ocn_cpl_indices.F90 @@ -0,0 +1,183 @@ +module ocn_cpl_indices + + use mct_mod, only: mct_avect_init, mct_avect_indexra, mct_aVect_clean, mct_aVect + use seq_flds_mod, only: ice_ncat, seq_flds_i2o_per_cat + use seq_flds_mod, only: seq_flds_x2o_fields, seq_flds_o2x_fields + + implicit none ; public + + !> Structure with indices needed for MCT attribute vectors + type cpl_indices_type + ! ocean to coupler + integer :: o2x_So_t !< Surface potential temperature (deg C) + integer :: o2x_So_u !< Surface zonal velocity (m/s) + integer :: o2x_So_v !< Surface meridional velocity (m/s) + integer :: o2x_So_s !< Surface salinity (PSU) + integer :: o2x_So_dhdx !< Zonal slope in the sea surface height + integer :: o2x_So_dhdy !< Meridional lope in the sea surface height + integer :: o2x_So_bldepth !< Boundary layer depth (m) + integer :: o2x_Fioo_q !< Heat flux? + integer :: o2x_Faoo_fco2_ocn !< CO2 flux + integer :: o2x_Faoo_fdms_ocn !< DMS flux + + ! coupler to ocean + integer :: x2o_Si_ifrac !< Fractional ice wrt ocean + integer :: x2o_So_duu10n !< 10m wind speed squared (m^2/s^2) + integer :: x2o_Sa_pslv !< Sea-level pressure (Pa) + integer :: x2o_Sa_co2prog !< Bottom atm level prognostic CO2 + integer :: x2o_Sa_co2diag !< Bottom atm level diagnostic CO2 + integer :: x2o_Sw_lamult !< Wave model langmuir multiplier + integer :: x2o_Sw_ustokes !< Surface Stokes drift, x-component + integer :: x2o_Sw_vstokes !< Surface Stokes drift, y-component + integer :: x2o_Foxx_taux !< Zonal wind stress (W/m2) + integer :: x2o_Foxx_tauy !< Meridonal wind stress (W/m2) + integer :: x2o_Foxx_swnet !< Net short-wave heat flux (W/m2) + integer :: x2o_Foxx_sen !< Sensible heat flux (W/m2) + integer :: x2o_Foxx_lat !< Latent heat flux (W/m2) + integer :: x2o_Foxx_lwup !< Longwave radiation, up (W/m2) + integer :: x2o_Faxa_lwdn !< Longwave radiation, down (W/m2) + integer :: x2o_Fioi_melth !< Heat flux from snow & ice melt (W/m2) + integer :: x2o_Fioi_meltw !< Snow melt flux (kg/m2/s) + integer :: x2o_Fioi_bcpho !< Black Carbon hydrophobic release from sea ice component + integer :: x2o_Fioi_bcphi !< Black Carbon hydrophilic release from sea ice component + integer :: x2o_Fioi_flxdst !< Dust release from sea ice component + integer :: x2o_Fioi_salt !< Salt flux (kg(salt)/m2/s) + integer :: x2o_Foxx_evap !< Evaporation flux (kg/m2/s) + integer :: x2o_Faxa_prec !< Total precipitation flux (kg/m2/s) + integer :: x2o_Faxa_snow !< Water flux due to snow (kg/m2/s) + integer :: x2o_Faxa_rain !< Water flux due to rain (kg/m2/s) + integer :: x2o_Faxa_bcphidry !< Black Carbon hydrophilic dry deposition + integer :: x2o_Faxa_bcphodry !< Black Carbon hydrophobic dry deposition + integer :: x2o_Faxa_bcphiwet !< Black Carbon hydrophilic wet deposition + integer :: x2o_Faxa_ocphidry !< Organic Carbon hydrophilic dry deposition + integer :: x2o_Faxa_ocphodry !< Organic Carbon hydrophobic dry deposition + integer :: x2o_Faxa_ocphiwet !< Organic Carbon hydrophilic dry deposition + integer :: x2o_Faxa_dstwet1 !< Size 1 dust -- wet deposition + integer :: x2o_Faxa_dstwet2 !< Size 2 dust -- wet deposition + integer :: x2o_Faxa_dstwet3 !< Size 3 dust -- wet deposition + integer :: x2o_Faxa_dstwet4 !< Size 4 dust -- wet deposition + integer :: x2o_Faxa_dstdry1 !< Size 1 dust -- dry deposition + integer :: x2o_Faxa_dstdry2 !< Size 2 dust -- dry deposition + integer :: x2o_Faxa_dstdry3 !< Size 3 dust -- dry deposition + integer :: x2o_Faxa_dstdry4 !< Size 4 dust -- dry deposition + integer :: x2o_Foxx_rofl !< River runoff flux (kg/m2/s) + integer :: x2o_Foxx_rofi !< Ice runoff flux (kg/m2/s) + + ! optional per thickness category fields + integer, dimension(:), allocatable :: x2o_frac_col !< Fraction of ocean cell, per column + integer, dimension(:), allocatable :: x2o_fracr_col !< Fraction of ocean cell used in radiation computations, per column + integer, dimension(:), allocatable :: x2o_qsw_fracr_col !< qsw * fracr, per column + end type cpl_indices_type + + public :: cpl_indices_init + +!======================================================================= +contains +!======================================================================= + + !> Determines attribute vector indices + subroutine cpl_indices_init(ind) + type(cpl_indices_type), intent(inout) :: ind !< Structure with coupler indices and vectors + + ! Local Variables + type(mct_aVect) :: o2x !< Array with ocean to coupler data + type(mct_aVect) :: x2o !< Array with coupler to ocean data + integer :: ncat !< Thickness category index + character(len=2) :: cncat !< Character version of ncat + integer :: ncol !< Column index + integer :: mcog_ncols !< Number of ice thickness categories? + integer :: lmcog_flds_sent !< Used to convert per thickness category fields? + + ! create temporary attribute vectors + call mct_aVect_init(x2o, rList=seq_flds_x2o_fields, lsize=1) + call mct_aVect_init(o2x, rList=seq_flds_o2x_fields, lsize=1) + + ! ocean to coupler + ind%o2x_So_t = mct_avect_indexra(o2x,'So_t') + ind%o2x_So_u = mct_avect_indexra(o2x,'So_u') + ind%o2x_So_v = mct_avect_indexra(o2x,'So_v') + ind%o2x_So_s = mct_avect_indexra(o2x,'So_s') + ind%o2x_So_dhdx = mct_avect_indexra(o2x,'So_dhdx') + ind%o2x_So_dhdy = mct_avect_indexra(o2x,'So_dhdy') + ind%o2x_So_bldepth = mct_avect_indexra(o2x,'So_bldepth') + ind%o2x_Fioo_q = mct_avect_indexra(o2x,'Fioo_q') + ind%o2x_Faoo_fco2_ocn = mct_avect_indexra(o2x,'Faoo_fco2_ocn',perrWith='quiet') + ind%o2x_Faoo_fdms_ocn = mct_avect_indexra(o2x,'Faoo_fdms_ocn',perrWith='quiet') + + ! coupler to ocean + ind%x2o_Si_ifrac = mct_avect_indexra(x2o,'Si_ifrac') + ind%x2o_Sa_pslv = mct_avect_indexra(x2o,'Sa_pslv') + ind%x2o_So_duu10n = mct_avect_indexra(x2o,'So_duu10n') + ind%x2o_Sw_lamult = mct_avect_indexra(x2o,'Sw_lamult') + ind%x2o_Sw_ustokes = mct_avect_indexra(x2o,'Sw_ustokes') + ind%x2o_Sw_vstokes = mct_avect_indexra(x2o,'Sw_vstokes') + ind%x2o_Foxx_tauy = mct_avect_indexra(x2o,'Foxx_tauy') + ind%x2o_Foxx_taux = mct_avect_indexra(x2o,'Foxx_taux') + ind%x2o_Foxx_swnet = mct_avect_indexra(x2o,'Foxx_swnet') + ind%x2o_Foxx_lat = mct_avect_indexra(x2o,'Foxx_lat') + ind%x2o_Foxx_sen = mct_avect_indexra(x2o,'Foxx_sen') + ind%x2o_Foxx_lwup = mct_avect_indexra(x2o,'Foxx_lwup') + ind%x2o_Faxa_lwdn = mct_avect_indexra(x2o,'Faxa_lwdn') + ind%x2o_Fioi_melth = mct_avect_indexra(x2o,'Fioi_melth') + ind%x2o_Fioi_meltw = mct_avect_indexra(x2o,'Fioi_meltw') + ind%x2o_Fioi_salt = mct_avect_indexra(x2o,'Fioi_salt') + ind%x2o_Fioi_bcpho = mct_avect_indexra(x2o,'Fioi_bcpho') + ind%x2o_Fioi_bcphi = mct_avect_indexra(x2o,'Fioi_bcphi') + ind%x2o_Fioi_flxdst = mct_avect_indexra(x2o,'Fioi_flxdst') + ind%x2o_Faxa_prec = mct_avect_indexra(x2o,'Faxa_prec') + ind%x2o_Faxa_snow = mct_avect_indexra(x2o,'Faxa_snow') + ind%x2o_Faxa_rain = mct_avect_indexra(x2o,'Faxa_rain') + ind%x2o_Foxx_evap = mct_avect_indexra(x2o,'Foxx_evap') + ind%x2o_Foxx_rofl = mct_avect_indexra(x2o,'Foxx_rofl') + ind%x2o_Foxx_rofi = mct_avect_indexra(x2o,'Foxx_rofi') + ind%x2o_Faxa_bcphidry = mct_avect_indexra(x2o,'Faxa_bcphidry') + ind%x2o_Faxa_bcphodry = mct_avect_indexra(x2o,'Faxa_bcphodry') + ind%x2o_Faxa_bcphiwet = mct_avect_indexra(x2o,'Faxa_bcphiwet') + ind%x2o_Faxa_ocphidry = mct_avect_indexra(x2o,'Faxa_ocphidry') + ind%x2o_Faxa_ocphodry = mct_avect_indexra(x2o,'Faxa_ocphodry') + ind%x2o_Faxa_ocphiwet = mct_avect_indexra(x2o,'Faxa_ocphiwet') + ind%x2o_Faxa_dstdry1 = mct_avect_indexra(x2o,'Faxa_dstdry1') + ind%x2o_Faxa_dstdry2 = mct_avect_indexra(x2o,'Faxa_dstdry2') + ind%x2o_Faxa_dstdry3 = mct_avect_indexra(x2o,'Faxa_dstdry3') + ind%x2o_Faxa_dstdry4 = mct_avect_indexra(x2o,'Faxa_dstdry4') + ind%x2o_Faxa_dstwet1 = mct_avect_indexra(x2o,'Faxa_dstwet1') + ind%x2o_Faxa_dstwet2 = mct_avect_indexra(x2o,'Faxa_dstwet2') + ind%x2o_Faxa_dstwet3 = mct_avect_indexra(x2o,'Faxa_dstwet3') + ind%x2o_Faxa_dstwet4 = mct_avect_indexra(x2o,'Faxa_dstwet4') + ind%x2o_Sa_co2prog = mct_avect_indexra(x2o,'Sa_co2prog',perrWith='quiet') + ind%x2o_Sa_co2diag = mct_avect_indexra(x2o,'Sa_co2diag',perrWith='quiet') + ! optional per thickness category fields + + ! convert cpl indices to mcog column indices + ! this implementation only handles columns due to ice thickness categories + lmcog_flds_sent = seq_flds_i2o_per_cat + + if (seq_flds_i2o_per_cat) then + mcog_ncols = ice_ncat+1 + allocate(ind%x2o_frac_col(mcog_ncols)) + allocate(ind%x2o_fracr_col(mcog_ncols)) + allocate(ind%x2o_qsw_fracr_col(mcog_ncols)) + ncol = 1 + ind%x2o_frac_col(ncol) = mct_avect_indexra(x2o,'Sf_afrac') + ind%x2o_fracr_col(ncol) = mct_avect_indexra(x2o,'Sf_afracr') + ind%x2o_qsw_fracr_col(ncol) = mct_avect_indexra(x2o,'Foxx_swnet_afracr') + + do ncat = 1, ice_ncat + write(cncat,'(i2.2)') ncat + ncol = ncat+1 + ind%x2o_frac_col(ncol) = mct_avect_indexra(x2o,'Si_ifrac_'//cncat) + ind%x2o_fracr_col(ncol) = ind%x2o_frac_col(ncol) + ind%x2o_qsw_fracr_col(ncol) = mct_avect_indexra(x2o,'PFioi_swpen_ifrac_'//cncat) + enddo + else + mcog_ncols = 1 + endif + + call mct_aVect_clean(x2o) + call mct_aVect_clean(o2x) + + end subroutine cpl_indices_init + +!======================================================================= + +end module ocn_cpl_indices diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 new file mode 100644 index 0000000000..fff7ad5ed0 --- /dev/null +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -0,0 +1,1181 @@ +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 +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_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 : 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 + +#ifdef _USE_GENERIC_TRACER +use MOM_generic_tracer, only : MOM_generic_tracer_fluxes_accumulate +#endif + +implicit none ; private + +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 + +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. + 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. + + integer :: stagger = -999 !< The staggering relative to the tracer points + !! points of the two velocity components. Valid entries + !! include AGRID, BGRID_NE, CGRID_NE, BGRID_SW, and CGRID_SW, + !! corresponding to the community-standard Arakawa notation. + !! (These are named integers taken from mpp_parameter_mod.) + !! Following MOM5, stagger is BGRID_NE by default when the + !! ocean is initialized, but here it is set to -999 so that + !! a global max across ocean and non-ocean processors can be + !! used to determine its value. + real, pointer, dimension(:,:) :: & + t_surf => NULL(), & !< SST on t-cell (degrees Kelvin) + s_surf => NULL(), & !< SSS on t-cell (psu) + u_surf => NULL(), & !< i-velocity at the locations indicated by stagger, m/s. + v_surf => NULL(), & !< j-velocity at the locations indicated by stagger, m/s. + sea_lev => NULL(), & !< Sea level in m after correction for surface pressure, + !! i.e. dzt(1) + eta_t + patm/rho0/grav (m) + frazil =>NULL(), & !< Accumulated heating (in Joules/m^2) from frazil + !! formation in the ocean. + area => NULL() !< cell area of the ocean surface, in m2. + 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. +end type ocean_public_type + + +!> 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 ; private + ! 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 :: 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 + !! restore sst to a specified value. + real :: press_to_z !< A conversion factor between pressure and ocean + !! depth in m, usually 1/(rho_0*g), in m Pa-1. + real :: C_p !< The heat capacity of seawater, in J K-1 kg-1. + logical :: offline_tracer_mode = .false. !< If false, use the model in prognostic mode + !! with the barotropic and baroclinic dynamics, thermodynamics, + !! etc. stepped forward integrated in time. + !! If true, all of the above are bypassed with all + !! fields necessary to integrate only the tracer advection + !! and diffusion equation read in from files stored from + !! a previous integration of the prognostic model. + + 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 + !! 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 structure containing information + !! about the vertical grid. + 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. + type(diag_ctrl), pointer :: & + diag => NULL() !< A pointer to the diagnostic regulatory structure +end type ocean_state_type + +contains + +!======================================================================= +! +! +! +! Initialize the ocean model. +! + +!> ocean_model_init initializes the ocean model, including registering fields +!! for restarts and reading restart files if appropriate. +subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) + 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). + 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. + type(time_type), intent(in) :: Time_init !< The start time for the coupled model's calendar + type(time_type), intent(in) :: Time_in !< The time at which to initialize the ocean model. + 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, and can be used to spawn related + !! internal variables in the ice model. + +! 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. + +! Arguments: Ocean_sfc - A structure containing various publicly visible ocean +! surface properties after initialization, this is intent(out). +! (out,private) 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. +! (in) Time_init - The start time for the coupled model's calendar. +! (in) Time_in - The time at which to initialize the ocean model. + real :: Rho0 ! The Boussinesq ocean density, in kg m-3. + real :: G_Earth ! The gravitational acceleration in m s-2. +! This include declares and sets the variable "version". +#include "version_variable.h" + character(len=40) :: mdl = "ocean_model_init" ! This module's name. + character(len=48) :: stagger + integer :: secs, days + type(param_file_type) :: param_file !< A structure to parse for run-time parameters + 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 + call MOM_error(WARNING, "ocean_model_init called with an associated "// & + "ocean_state_type structure. Model is already initialized.") + return + endif + allocate(OS) + + OS%is_ocean_pe = Ocean_sfc%is_ocean_pe + if (.not.OS%is_ocean_pe) return + + 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, & + diag_ptr=OS%diag, count_calls=.true.) + call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, C_p=OS%C_p, & + use_temp=use_temperature) + 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 \n"//& + "including both dynamics and thermodynamics. If false, \n"//& + "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"//& + "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"//& + "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"//& + "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"//& + "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"//& + "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', '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.") ; 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"//& + "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"//& + "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"//& + "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, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) + + 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_alter_ocean, & + "If true, allows icebergs to change boundary condition felt by ocean", default=.false.) + + OS%press_to_z = 1.0/(Rho0*G_Earth) + + ! 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) + + call surface_forcing_init(Time_in, OS%grid, param_file, OS%diag, & + OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) + + if (OS%use_ice_shelf) then + call initialize_ice_shelf(param_file, OS%grid, OS%Time, OS%ice_shelf_CSp, & + OS%diag, OS%forces, OS%fluxes) + endif + if (OS%icebergs_alter_ocean) then + call marine_ice_init(OS%Time, OS%grid, param_file, OS%diag, OS%marine_ice_CSp) + if (.not. OS%use_ice_shelf) & + 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, param_file, OS%Waves, OS%diag) + else + call MOM_wave_interface_init_lite(param_file) + 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, & + gas_fields_ocn=gas_fields_ocn) + else + call initialize_ocean_public_type(OS%grid%Domain%mpp_domain, Ocean_sfc, & + OS%diag, gas_fields_ocn=gas_fields_ocn) + endif + + ! 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) + + endif + + call close_param_file(param_file) + call diag_mediator_close_registration(OS%diag) + + 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. +! +! + +!> 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, & + 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. + 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. + + 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(), ocean_model_MOM.F90") + call get_time(Ocean_coupling_time_step, secs, days) + 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 "//& + "agree with time_start_update argument.") + endif + if (.not.associated(OS)) then + call MOM_error(FATAL, "update_ocean_model called with an unassociated "// & + "ocean_state_type structure. ocean_model_init must be "// & + "called first to allocate this structure.") + 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 + call coupler_type_spawn(Ocean_sfc%fields, OS%sfc_state%tr_fields, & + (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) + + ! Translate Ice_ocean_boundary into fluxes. + call mpp_get_compute_domain(Ocean_sfc%Domain, index_bnds(1), index_bnds(2), & + index_bnds(3), index_bnds(4)) + + weight = 1.0 + + call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time, & + OS%grid, OS%forcing_CSp) + + if (OS%fluxes%fluxes_used) then + call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & + OS%grid, 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%forces, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + endif + if (OS%icebergs_alter_ocean) then + call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + call iceberg_fluxes(OS%grid, OS%fluxes, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + 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, skip_pres=.true.) + +#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 = dt_coupling + else + OS%flux_tmp%C_p = OS%fluxes%C_p + call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & + OS%grid, 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%forces, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + endif + if (OS%icebergs_alter_ocean) then + call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + call iceberg_fluxes(OS%grid, OS%flux_tmp, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + 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 + ! 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 + endif + call set_derived_forcing_fields(OS%forces, OS%fluxes, OS%grid, 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%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 + + call disable_averaging(OS%diag) + Master_time = OS%Time ; Time1 = OS%Time + + if (OS%offline_tracer_mode) then + 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) + !### What to do with these? , start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) + + 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 + 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(dt_coupling, OS%Time, OS%diag) + call mech_forcing_diags(OS%forces, OS%fluxes, dt_coupling, OS%grid, & + OS%diag, OS%forcing_CSp%handles) + call disable_averaging(OS%diag) + + if (OS%fluxes%fluxes_used) then + call enable_averaging(OS%fluxes%dt_buoy_accum, OS%Time, OS%diag) + call forcing_diagnostics(OS%fluxes, OS%sfc_state, OS%fluxes%dt_buoy_accum, & + OS%grid, OS%diag, OS%forcing_CSp%handles) + call disable_averaging(OS%diag) + endif + +! Translate state into Ocean. +! 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) + 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.) + + if (.not.MOM_state_is_synchronized(OS%MOM_CSp)) & + call MOM_error(WARNING, "End of MOM_main reached with inconsistent "//& + "dynamics and advective times. Additional restart fields "//& + "that have not been coded yet would be required for reproducibility.") + if (.not.OS%fluxes%fluxes_used) call MOM_error(FATAL, "ocean_model_restart "//& + "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 + +end subroutine ocean_model_restart +! NAME="ocean_model_restart" + +!======================================================================= +! +! +! +! Close down the ocean model +! + +!> 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 !< 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. + +! This subroutine terminates the model run, saving the ocean state in a +! restart file and deallocating any data associated with the ocean. + +! Arguments: Ocean_sfc - An ocean_public_type structure that is to be +! deallocated upon termination. +! (inout) Ocean_state - A pointer to the structure containing the internal +! ocean state to be deallocated upon termination. +! (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) + 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. +subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) + type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the + !! internal ocean state (in). + type(time_type), intent(in) :: Time !< The model time at this call, needed for mpp_write calls. + character(len=*), optional, intent(in) :: directory !< An optional directory into which to + !! 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. + character(len=200) :: restart_dir + + if (.not.MOM_state_is_synchronized(OS%MOM_CSp)) & + call MOM_error(WARNING, "ocean_model_save_restart called with inconsistent "//& + "dynamics and advective times. Additional restart fields "//& + "that have not been coded yet would be required for reproducibility.") + if (.not.OS%fluxes%fluxes_used) call MOM_error(FATAL, "ocean_model_save_restart "//& + "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 + + call save_restart(restart_dir, Time, OS%grid, OS%restart_CSp, GV=OS%GV) + + call forcing_save_restart(OS%forcing_CSp, OS%grid, Time, restart_dir) + + if (OS%use_ice_shelf) then + call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir) + endif + +end subroutine ocean_model_save_restart + +!======================================================================= + +subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, & + gas_fields_ocn) + type(domain2D), intent(in) :: input_domain + type(ocean_public_type), intent(inout) :: Ocean_sfc + type(diag_ctrl), intent(in) :: diag + logical, dimension(:,:), & + optional, intent(in) :: maskmap + 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. + + 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) + call mpp_get_global_domain(input_domain, xsize=xsz, ysize=ysz) + if (PRESENT(maskmap)) then + call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain, maskmap=maskmap) + else + call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain) + endif + call mpp_get_compute_domain(Ocean_sfc%Domain, isc, iec, jsc, jec) + + allocate ( Ocean_sfc%t_surf (isc:iec,jsc:jec), & + Ocean_sfc%s_surf (isc:iec,jsc:jec), & + Ocean_sfc%u_surf (isc:iec,jsc:jec), & + Ocean_sfc%v_surf (isc:iec,jsc:jec), & + Ocean_sfc%sea_lev(isc:iec,jsc:jec), & + Ocean_sfc%area (isc:iec,jsc:jec), & + Ocean_sfc%frazil (isc:iec,jsc:jec)) + + Ocean_sfc%t_surf = 0.0 ! time averaged sst (Kelvin) passed to atmosphere/ice model + Ocean_sfc%s_surf = 0.0 ! time averaged sss (psu) passed to atmosphere/ice models + Ocean_sfc%u_surf = 0.0 ! time averaged u-current (m/sec) passed to atmosphere/ice models + Ocean_sfc%v_surf = 0.0 ! time averaged v-current (m/sec) passed to atmosphere/ice models + Ocean_sfc%sea_lev = 0.0 ! time averaged thickness of top model grid cell (m) plus patm/rho0/grav + Ocean_sfc%frazil = 0.0 ! time accumulated frazil (J/m^2) passed to ice model + Ocean_sfc%area = 0.0 + Ocean_sfc%axes = diag%axesT1%handles !diag axes to be used by coupler tracer flux diagnostics + + if (present(gas_fields_ocn)) then + call coupler_type_spawn(gas_fields_ocn, Ocean_sfc%fields, (/isc,isc,iec,iec/), & + (/jsc,jsc,jec,jec/), suffix = '_ocn', as_needed=.true.) + endif + +end subroutine initialize_ocean_public_type + +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 + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + real, optional, intent(in) :: patm(:,:) + real, optional, intent(in) :: press_to_z +! 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. + 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(sfc_state%u, sfc_state%v, G%Domain) + + call mpp_get_compute_domain(Ocean_sfc%Domain, isc_bnd, iec_bnd, & + jsc_bnd, jec_bnd) + if (present(patm)) then + ! Check that the inidicies in patm are (isc_bnd:iec_bnd,jsc_bnd:jec_bnd). + if (.not.present(press_to_z)) call MOM_error(FATAL, & + 'convert_state_to_ocean_type: press_to_z must be present if patm is.') + endif + + i0 = is - isc_bnd ; j0 = js - jsc_bnd + 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(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) = sfc_state%SST(i+i0,j+j0) + CELSIUS_KELVIN_OFFSET + enddo ; enddo + endif + 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(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) = sfc_state%SSS(i+i0,j+j0) + enddo ; enddo + endif + + 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 (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*(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*(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)*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 + call MOM_error(FATAL, "convert_state_to_ocean_type: "//& + "Ocean_sfc%stagger has the unrecognized value of "//trim(val_str)) + endif + + 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(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 +! 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 + type(ocean_public_type), intent(inout) :: Ocean_sfc + + integer :: is, ie, js, je + + is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec + call coupler_type_spawn(Ocean_sfc%fields, OS%sfc_state%tr_fields, & + (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) + + call extract_surface_state(OS%MOM_CSp, OS%sfc_state) + + 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 +!! non-ocean PEs, or PEs that have not yet been initialzed, and it can safely +!! be called multiple times. +subroutine ocean_model_flux_init(OS, verbosity) + type(ocean_state_type), optional, pointer :: OS !< An optional pointer to the ocean state, + !! used to figure out if this is an ocean PE that + !! has already been initialized. + integer, optional, intent(in) :: verbosity !< A 0-9 integer indicating a level of verbosity. + + logical :: OS_is_set + integer :: verbose + + OS_is_set = .false. ; if (present(OS)) OS_is_set = associated(OS) + + ! Use this to control the verbosity of output; consider rethinking this logic later. + verbose = 5 ; if (OS_is_set) verbose = 3 + if (present(verbosity)) verbose = verbosity + + call call_tracer_flux_init(verbosity=verbose) + +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). + 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 + !! interfacial compatibility with other models. +! Arguments: OS - A structure containing the internal ocean state. +! (in) index - Index of conservation quantity of interest. +! (in) value - Sum returned for the conservation quantity of interest. +! (in,opt) time_index - Index for time level to use if this is necessary. + + real :: salt + + value = 0.0 + if (.not.associated(OS)) return + if (.not.OS%is_ocean_pe) return + + select case (index) + case (ISTOCK_WATER) ! Return the mass of fresh water in the ocean in kg. + if (OS%GV%Boussinesq) then + call get_ocean_stocks(OS%MOM_CSp, mass=value, on_PE_only=.true.) + else ! In non-Boussinesq mode, the mass of salt needs to be subtracted. + call get_ocean_stocks(OS%MOM_CSp, mass=value, salt=salt, on_PE_only=.true.) + value = value - salt + endif + case (ISTOCK_HEAT) ! Return the heat content of the ocean in J. + call get_ocean_stocks(OS%MOM_CSp, heat=value, on_PE_only=.true.) + case (ISTOCK_SALT) ! Return the mass of the salt in the ocean in kg. + call get_ocean_stocks(OS%MOM_CSp, salt=value, on_PE_only=.true.) + case default ; value = 0.0 + end select + ! If the FMS coupler is changed so that Ocean_stock_PE is only called on + ! ocean PEs, uncomment the following and eliminate the on_PE_only flags above. + ! if (.not.is_root_pe()) value = 0.0 + +end subroutine Ocean_stock_pe + +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 + + integer :: g_isc, g_iec, g_jsc, g_jec,g_isd, g_ied, g_jsd, g_jed, i, j + + if (.not.associated(OS)) return + if (.not.OS%is_ocean_pe) return + +! The problem is %areaT is on MOM domain but Ice_Ocean_Boundary%... is on mpp domain. +! We want to return the MOM data on the mpp (compute) domain +! Get MOM domain extents + call mpp_get_compute_domain(OS%grid%Domain%mpp_domain, g_isc, g_iec, g_jsc, g_jec) + call mpp_get_data_domain (OS%grid%Domain%mpp_domain, g_isd, g_ied, g_jsd, g_jed) + + g_isc = g_isc-g_isd+1 ; g_iec = g_iec-g_isd+1 ; g_jsc = g_jsc-g_jsd+1 ; g_jec = g_jec-g_jsd+1 + + + select case(name) + case('area') + array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) + case('mask') + array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) +!OR same result +! do j=g_jsc,g_jec ; do i=g_isc,g_iec +! array2D(isc+i-g_isc,jsc+j-g_jsc) = OS%grid%mask2dT(i,j) +! enddo ; enddo + case('t_surf') + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + case('t_pme') + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + case('t_runoff') + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + case('t_calving') + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + case('btfHeat') + array2D(isc:,jsc:) = 0 + case('tlat') + array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) + case('tlon') + array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) + case('ulat') + array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) + case('ulon') + array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) + case('vlat') + array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) + case('vlon') + array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) + case('geoLatBu') + array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) + case('geoLonBu') + array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) + case('cos_rot') + array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 + 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) + 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 + + if (.not.associated(OS)) return + if (.not.OS%is_ocean_pe) return + + select case(name) + case('c_p') + value = OS%C_p + case default + call MOM_error(FATAL,'ocean_model_data1D_get: unknown argument name='//name) + end select + + +end subroutine ocean_model_data1D_get + +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 + + outunit = stdout() + + write(outunit,*) "BEGIN CHECKSUM(ocean_type):: ", id, timestep + write(outunit,100) 'ocean%t_surf ',mpp_chksum(ocn%t_surf ) + write(outunit,100) 'ocean%s_surf ',mpp_chksum(ocn%s_surf ) + write(outunit,100) 'ocean%u_surf ',mpp_chksum(ocn%u_surf ) + 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 ) + + 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) + type(ocean_state_type) :: OS + 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/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 new file mode 100644 index 0000000000..bb6c58fa1f --- /dev/null +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -0,0 +1,1415 @@ +module MOM_surface_forcing + +! This file is part of MOM6. See LICENSE.md for the license. + +!### use MOM_controlled_forcing, only : apply_ctrl_forcing, register_ctrl_forcing_restarts +!### use MOM_controlled_forcing, only : controlled_forcing_init, controlled_forcing_end +!### use MOM_controlled_forcing, only : ctrl_forcing_CS +use MOM_coms, only : reproducing_sum +use MOM_constants, only : hlv, hlf +use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end +use MOM_cpu_clock, only : CLOCK_SUBCOMPONENT +use MOM_diag_mediator, only : diag_ctrl +use MOM_diag_mediator, only : safe_alloc_ptr, time_type +use MOM_domains, only : pass_vector, pass_var, fill_symmetric_edges +use MOM_domains, only : global_field_sum, BITWISE_EXACT_SUM +use MOM_domains, only : AGRID, BGRID_NE, CGRID_NE, To_All +use MOM_domains, only : To_North, To_East, Omit_Corners +use MOM_error_handler, only : MOM_error, WARNING, FATAL, is_root_pe, MOM_mesg +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : forcing_diags, mech_forcing_diags, register_forcing_type_diags +use MOM_forcing_type, only : allocate_forcing_type, deallocate_forcing_type +use MOM_forcing_type, only : allocate_mech_forcing, deallocate_mech_forcing +use MOM_get_input, only : Get_MOM_Input, directories +use MOM_grid, only : ocean_grid_type +use MOM_io, only : slasher, write_version_number, MOM_read_data +use MOM_restart, only : register_restart_field, restart_init, MOM_restart_CS +use MOM_restart, only : restart_init_end, save_restart, restore_state +use MOM_string_functions, only : uppercase +use MOM_spatial_means, only : adjust_area_mean_to_zero +use MOM_variables, only : surface +use user_revise_forcing, only : user_alter_forcing, user_revise_forcing_init +use user_revise_forcing, only : user_revise_forcing_CS + +use coupler_types_mod, only : coupler_2d_bc_type, coupler_type_write_chksums +use coupler_types_mod, only : coupler_type_initialized, coupler_type_spawn +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 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 + +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 + + +! surface_forcing_CS is a structure containing pointers to the forcing fields +! which may be used to drive MOM. All fluxes are positive downward. +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. + 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 :: 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 + ! structure does not limit the water that can be + ! frozen out of the ocean and the ice-ocean heat + ! fluxes are treated explicitly. + logical :: use_limited_P_SSH ! 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. The default is true. + + 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. + gust => NULL(), & ! spatially varying unresolved background + ! 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) + real :: cd_tides ! drag coefficient that applies to the tides (nondimensional) + real :: utide ! constant tidal velocity to use if read_tideamp + ! is false, in 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 :: 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. + logical :: allow_flux_adjustments ! If true, use data_override to obtain flux adjustments + + 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 :: 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) + 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 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 + 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 + integer :: id_srestore = -1 ! id number for time_interp_external. + integer :: id_trestore = -1 ! id number for time_interp_external. + + ! Diagnostics handles + type(forcing_diags), public :: handles + +!### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() + 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. +type, public :: ice_ocean_boundary_type + 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(:,:) :: 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 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, CS, & + sfc_state, restore_salt, restore_temp) + type(ice_ocean_boundary_type), & + 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. + !! 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 + type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a + !! previous call to surface_forcing_init. + type(surface), intent(in) :: sfc_state !< A structure containing fields that describe the + !! surface state of the ocean. + 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. + + + 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, 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 + + 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 + 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 + + C_p = fluxes%C_p + open_ocn_mask(:,:) = 1.0 + pme_adj(:,:) = 0.0 + fluxes%vPrecGlobalAdj = 0.0 + fluxes%vPrecGlobalScl = 0.0 + fluxes%saltFluxGlobalAdj = 0.0 + fluxes%saltFluxGlobalScl = 0.0 + fluxes%netFWGlobalAdj = 0.0 + fluxes%netFWGlobalScl = 0.0 + + restore_salinity = .false. + if (present(restore_salt)) restore_salinity = restore_salt + restore_sst = .false. + if (present(restore_temp)) restore_sst = restore_temp + + ! allocation and initialization if this is the first time that this + ! flux type has been used. + if (fluxes%dt_buoy_accum < 0) then + call allocate_forcing_type(G, fluxes, water=.true., heat=.true., & + ustar=.true., press=.true.) + + call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%sw_nir_dir,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%sw_nir_dif,isd,ied,jsd,jed) + + 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) + call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) + + call safe_alloc_ptr(fluxes%TKE_tidal,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%ustar_tidal,isd,ied,jsd,jed) + + if (CS%allow_flux_adjustments) then + call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) + endif + + do j=js-2,je+2 ; do i=is-2,ie+2 + fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) + fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) + enddo ; enddo + + if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) + + 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) + enddo ; enddo + CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) + endif ! endif for allocation and initialization + + do j=js,je ; do i=is,ie + fluxes%salt_flux(i,j) = 0.0 + fluxes%vprec(i,j) = 0.0 + enddo ; enddo + + ! Salinity restoring logic + if (restore_salinity) then + call time_interp_external(CS%id_srestore,Time,data_restore) + ! open_ocn_mask indicates where to restore salinity (1 means restore, 0 does not) + open_ocn_mask(:,:) = 1.0 + if (CS%mask_srestore_under_ice) then ! Do not restore under sea-ice + do j=js,je ; do i=is,ie + if (sfc_state%SST(i,j) <= -0.0539*sfc_state%SSS(i,j)) open_ocn_mask(i,j)=0.0 + enddo ; enddo + endif + if (CS%salt_restore_as_sflux) then + do j=js,je ; do i=is,ie + 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)*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 + call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) + fluxes%saltFluxGlobalAdj = 0. + else + work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) + fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf + fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj + endif + endif + fluxes%salt_flux_added(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) ! Diagnostic + else + do j=js,je ; do i=is,ie + 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)*CS%srestore_mask(i,j))* & + (CS%Rho0*CS%Flux_const) * & + delta_sss / (0.5*(sfc_state%SSS(i,j) + data_restore(i,j))) + endif + enddo ; enddo + if (CS%adjust_net_srestore_to_zero) then + if (CS%adjust_net_srestore_by_scaling) then + call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) + fluxes%vPrecGlobalAdj = 0. + else + work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) + fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf + do j=js,je ; do i=is,ie + fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) + enddo ; enddo + endif + endif + endif + endif + + ! SST restoring logic + if (restore_sst) then + call time_interp_external(CS%id_trestore,Time,data_restore) + 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%trestore_mask(i,j) * & + (CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2 + enddo ; enddo + endif + + + ! obtain fluxes from IOB; note the staggering of indices + i0 = is - isc_bnd ; j0 = js - jsc_bnd + do j=js,je ; do i=is,ie + + if (associated(IOB%lprec)) & + fluxes%lprec(i,j) = IOB%lprec(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%fprec)) & + fluxes%fprec(i,j) = IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%q_flux)) & + fluxes%evap(i,j) = - IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%runoff)) & + fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%calving)) & + fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%ustar_berg)) & + fluxes%ustar_berg(i,j) = 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%runoff_hflx)) & + fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * 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) + + if (associated(IOB%lw_flux)) & + fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%t_flux)) & + fluxes%sens(i,j) = - IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) + + fluxes%latent(i,j) = 0.0 + 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 + if (associated(IOB%calving)) then + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion + endif + if (associated(IOB%q_flux)) then + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor + fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor + endif + + fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) + + 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) + + enddo ; enddo + + ! 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 + endif + + ! more salt restoring logic + 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 + +!### if (associated(CS%ctrl_forcing_CSp)) then +!### do j=js,je ; do i=is,ie +!### SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) +!### SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) +!### SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) +!### enddo ; enddo +!### call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_restore, & +!### fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) +!### endif + + ! adjust the NET fresh-water flux to zero, if flagged + if (CS%adjust_net_fresh_water_to_zero) then + sign_for_net_FW_bug = 1. + if (CS%use_net_FW_adjustment_sign_bug) sign_for_net_FW_bug = -1. + do j=js,je ; do i=is,ie + net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(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 + 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 + + if (CS%adjust_net_fresh_water_by_scaling) then + call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) + do j=js,je ; do i=is,ie + fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) + enddo ; enddo + else + fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf + do j=js,je ; do i=is,ie + fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%netFWGlobalAdj ) * G%mask2dT(i,j) + enddo ; enddo + 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) + endif + + ! Allow for user-written code to alter fluxes after all the above + call user_alter_forcing(sfc_state, fluxes, Time, G, CS%urf_CS) + + call cpu_clock_end(id_clock_forcing) + +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. +subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) + type(ice_ocean_boundary_type), & + target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive + !! the ocean in a coupled model + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + 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 + type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a + !! previous call to surface_forcing_init. + + + 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) + + 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) + 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 + i0 = is - isc_bnd ; j0 = js - jsc_bnd + + 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 safe_alloc_ptr(forces%p_surf,isd,ied,jsd,jed) + call safe_alloc_ptr(forces%p_surf_full,isd,ied,jsd,jed) + 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 (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) + endif + + 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 + + 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 + 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) + 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) + enddo ; enddo + endif + endif + + wind_stagger = CS%wind_stagger + 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 + endif + if (wind_stagger == AGRID) then + ! This is necessary to fill in the halo points. + taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 + endif + + ! 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 + elseif (wind_stagger == AGRID) then + if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + else ! C-grid wind stresses. + if (associated(IOB%u_flux)) forces%taux(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%v_flux)) forces%tauy(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + endif + + enddo ; enddo + + ! surface momentum stress related fields as function of staggering + 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, halo=1) + + do j=js,je ; do I=Isq,Ieq + forces%taux(I,j) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & + forces%taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + & + G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) + enddo ; enddo + + do J=Jsq,Jeq ; do i=is,ie + forces%tauy(i,J) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & + forces%tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + & + G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) + enddo ; enddo + + ! ustar is required for the bulk mixed layer formulation. The background value + ! of 0.02 Pa is a relatively small value intended to give reasonable behavior + ! in regions of very weak winds. + + do j=js,je ; do i=is,ie + tau_mag = 0.0 ; gustiness = CS%gust_const + if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then + tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & + G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & + (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & + G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & + ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) + if (CS%read_gust_2d) gustiness = CS%gust(i,j) + endif + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) + enddo ; enddo + + elseif (wind_stagger == AGRID) then + 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 + if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & + forces%taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + & + G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & + (G%mask2dT(i,j) + G%mask2dT(i+1,j)) + enddo ; enddo + + do J=Jsq,Jeq ; do i=is,ie + forces%tauy(i,J) = 0.0 + if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & + forces%tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + & + G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & + (G%mask2dT(i,j) + G%mask2dT(i,j+1)) + enddo ; enddo + + do j=js,je ; do i=is,ie + gustiness = CS%gust_const + if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & + sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) + enddo ; enddo + + 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, halo=1) + + do j=js,je ; do i=is,ie + taux2 = 0.0 + if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & + taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + & + G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) + + tauy2 = 0.0 + if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & + tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + & + G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) + + if (CS%read_gust_2d) then + forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) + else + forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) + endif + enddo ; enddo + + 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 + Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) + do I=is-1,ie ; do j=js,je + mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth + mass_eff = 0.0 + if (mass_ice > CS%rigid_sea_ice_mass) then + mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & + (mass_ice + CS%rigid_sea_ice_mass) + endif + forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + Kv_rho_ice * mass_eff + enddo ; enddo + do i=is,ie ; do J=js-1,je + mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i,j+1)) * I_GEarth + mass_eff = 0.0 + if (mass_ice > CS%rigid_sea_ice_mass) then + mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & + (mass_ice + CS%rigid_sea_ice_mass) + endif + forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + Kv_rho_ice * mass_eff + enddo ; enddo + endif + + if (CS%allow_flux_adjustments) then + ! Apply adjustments to forces + call apply_force_adjustments(G, CS, Time, forces) + endif + +!### ! Allow for user-written code to alter fluxes after all the above +!### call user_alter_mech_forcing(forces, Time, G, CS%urf_CS) + + call cpu_clock_end(id_clock_forcing) +end subroutine convert_IOB_to_forces + +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% u_flux (isc:iec,jsc:jec), & + IOB% v_flux (isc:iec,jsc:jec), & + IOB% t_flux (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% runoff (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%u_flux = 0.0 + IOB%v_flux = 0.0 + IOB%t_flux = 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%runoff = 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 thermodynamic flux adjustments obtained via data_override +!! Component name is 'OCN' +!! Available adjustments are: +!! - 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), intent(inout) :: fluxes !< Surface fluxes structure + + ! Local variables + 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 + logical :: overrode_h + + 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=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=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) + + 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=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: +!! - taux_adj (Zonal wind stress delta, positive to the east, in Pa) +!! - tauy_adj (Meridional wind stress delta, positive to the north, in Pa) +subroutine apply_force_adjustments(G, CS, Time, forces) + 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(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) + + integer :: isc, iec, jsc, jec, i, j + real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau + logical :: overrode_x, overrode_y + + isc = G%isc; iec = G%iec ; jsc = G%jsc; jec = G%jec + + tempx_at_h(:,:) = 0.0 ; tempy_at_h(:,:) = 0.0 + ! Either reads data or leaves contents unchanged + overrode_x = .false. ; overrode_y = .false. + call data_override('OCN', 'taux_adj', tempx_at_h(isc:iec,jsc:jec), Time, override=overrode_x) + call data_override('OCN', 'tauy_adj', tempy_at_h(isc:iec,jsc:jec), Time, override=overrode_y) + + if (overrode_x .or. overrode_y) then + if (.not. (overrode_x .and. overrode_y)) call MOM_error(FATAL,"apply_flux_adjustments: "//& + "Both taux_adj and tauy_adj must be specified, or neither, in data_table") + + ! Rotate winds + call pass_vector(tempx_at_h, tempy_at_h, G%Domain, To_All, AGRID, halo=1) + do j=jsc-1,jec+1 ; do i=isc-1,iec+1 + dLonDx = G%geoLonCu(I,j) - G%geoLonCu(I-1,j) + dLonDy = G%geoLonCv(i,J) - G%geoLonCv(i,J-1) + rDlon = sqrt( dLonDx * dLonDx + dLonDy * dLonDy ) + if (rDlon > 0.) rDlon = 1. / rDlon + cosA = dLonDx * rDlon + sinA = dLonDy * rDlon + zonal_tau = tempx_at_h(i,j) + merid_tau = tempy_at_h(i,j) + tempx_at_h(i,j) = cosA * zonal_tau - sinA * merid_tau + tempy_at_h(i,j) = sinA * zonal_tau + cosA * merid_tau + enddo ; enddo + + ! Average to C-grid locations + do j=jsc,jec ; do I=isc-1,iec + forces%taux(I,j) = forces%taux(I,j) + 0.5 * ( tempx_at_h(i,j) + tempx_at_h(i+1,j) ) + enddo ; enddo + + do J=jsc-1,jec ; do i=isc,iec + forces%tauy(i,J) = forces%tauy(i,J) + 0.5 * ( tempy_at_h(i,j) + tempy_at_h(i,j+1) ) + enddo ; enddo + endif ! overrode_x .or. overrode_y + +end subroutine apply_force_adjustments + +subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & + filename_suffix) + type(surface_forcing_CS), pointer :: CS + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(time_type), intent(in) :: Time + character(len=*), intent(in) :: directory + logical, optional, intent(in) :: time_stamped + character(len=*), optional, intent(in) :: filename_suffix +! Arguments: CS - A pointer to the control structure returned by a previous +! call to surface_forcing_init. +! (in) G - The ocean's grid structure. +! (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) time_stamped - If true, the restart file names include +! a unique time stamp. The default is false. +! (in, opt) 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 + +subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, restore_temp) + type(time_type), intent(in) :: Time + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(diag_ctrl), target, intent(inout) :: diag + type(surface_forcing_CS), pointer :: CS + logical, optional, intent(in) :: restore_salt, restore_temp +! Arguments: Time - The current model time. +! (in) G - The ocean's grid structure. +! (in) param_file - A structure indicating the open file to parse for +! model parameter values. +! (in) diag - A structure that is used to regulate diagnostic output. +! (in/out) CS - A pointer that is set to point to the control structure +! for this module +! (in) restore_salt - If present and true, salinity restoring will be +! applied in this model. + 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 = "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 + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + + if (associated(CS)) then + call MOM_error(WARNING, "surface_forcing_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + + id_clock_forcing=cpu_clock_id('Ocean surface forcing', grain=CLOCK_SUBCOMPONENT) + call cpu_clock_begin(id_clock_forcing) + + CS%diag => diag + + call write_version_number(version) + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mdl, version, "") + + call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, & + "The directory in which all input files are found.", & + default=".") + CS%inputdir = slasher(CS%inputdir) + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + "If true, Temperature and salinity are used as state \n"//& + "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"//& + "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, & + "The latent heat of fusion.", units="J/kg", default=hlf) + 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"//& + "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"//& + "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"//& + "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"//& + "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"//& + "the net fresh-water.", default=.true.) + call get_param(param_file, mdl, "ADJUST_NET_FRESH_WATER_BY_SCALING", & + CS%adjust_net_fresh_water_by_scaling, & + "If true, adjustments to net fresh water to achieve zero net are\n"//& + "made by scaling values without moving the zero contour.",& + default=.false.) + call get_param(param_file, mdl, "ICE_SALT_CONCENTRATION", & + CS%ice_salt_concentration, & + "The assumed sea-ice salinity needed to reverse engineer the \n"//& + "melt flux (or ice-ocean fresh-water flux).", & + units="kg/kg", default=0.005) + call get_param(param_file, 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"//& + "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 \n"//& + "staggering of the input wind stress field. Valid \n"//& + "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 + elseif (uppercase(stagger(1:1)) == 'C') then ; CS%wind_stagger = CGRID_NE + else ; call MOM_error(FATAL,"surface_forcing_init: WIND_STAGGER = "// & + trim(stagger)//" is invalid.") ; endif + call get_param(param_file, mdl, "WIND_STRESS_MULTIPLIER", CS%wind_stress_multiplier, & + "A factor multiplying the wind-stress given to the ocean by the\n"//& + "coupler. This is used for testing and should be =1.0 for any\n"//& + "production runs.", default=1.0) + + if (restore_salt) then + call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & + "The constant that relates the restoring surface fluxes \n"//& + "to the relative surface anomalies (akin to a piston \n"//& + "velocity). Note the non-MKS units.", units="m day-1", & + fail_if_missing=.true.) + call get_param(param_file, mdl, "SALT_RESTORE_FILE", CS%salt_restore_file, & + "A file in which to find the surface salinity to use for restoring.", & + default="salt_restore.nc") + call get_param(param_file, mdl, "SALT_RESTORE_VARIABLE", CS%salt_restore_var_name, & + "The name of the surface salinity variable to read from "//& + "SALT_RESTORE_FILE for restoring salinity.", & + default="salt") +! Convert CS%Flux_const from m day-1 to m s-1. + CS%Flux_const = CS%Flux_const / 86400.0 + + call get_param(param_file, mdl, "SRESTORE_AS_SFLUX", CS%salt_restore_as_sflux, & + "If true, the restoring of salinity is applied as a salt \n"//& + "flux instead of as a freshwater flux.", default=.false.) + call get_param(param_file, 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"//& + "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"//& + "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'.", & + default="basin.nc") + 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 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 \n"//& + "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"//& + "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, & + "A file in which to find the surface temperature to use for restoring.", & + default="temp_restore.nc") + call get_param(param_file, mdl, "SST_RESTORE_VARIABLE", CS%temp_restore_var_name, & + "The name of the surface temperature variable to read from "//& + "SST_RESTORE_FILE for restoring sst.", & + default="temp") +! Convert CS%Flux_const from m day-1 to m s-1. + CS%Flux_const = CS%Flux_const / 86400.0 + + call get_param(param_file, 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 \n"//& + "a mask for SST restoring.", default=.false.) + + endif + +! 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. + call get_param(param_file, mdl, "CD_TIDES", CS%cd_tides, & + "The drag coefficient that applies to the tides.", & + units="nondim", default=1.0e-4) + call get_param(param_file, mdl, "READ_TIDEAMP", CS%read_TIDEAMP, & + "If true, read a file (given by TIDEAMP_FILE) containing \n"//& + "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) + if (CS%read_TIDEAMP) then + call get_param(param_file, mdl, "TIDEAMP_FILE", TideAmp_file, & + "The path to the file containing the spatially varying \n"//& + "tidal amplitudes with INT_TIDE_DISSIPATION.", & + default="tideamp.nc") + CS%utide=0.0 + else + call get_param(param_file, mdl, "UTIDE", CS%utide, & + "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & + units="m s-1", default=0.0) + endif + + call safe_alloc_ptr(CS%TKE_tidal,isd,ied,jsd,jed) + call safe_alloc_ptr(CS%ustar_tidal,isd,ied,jsd,jed) + + if (CS%read_TIDEAMP) then + TideAmp_file = trim(CS%inputdir) // trim(TideAmp_file) + 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) + CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + enddo ; enddo + else + do j=jsd,jed; do i=isd,ied + utide=CS%utide + CS%TKE_tidal(i,j) = CS%Rho0*CS%cd_tides*(utide*utide*utide) + CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + enddo ; enddo + endif + + call time_interp_external_init + +! Optionally read a x-y gustiness field in place of a global +! constant. + + call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & + "If true, use a 2-dimensional gustiness supplied from \n"//& + "an input file", default=.false.) + call get_param(param_file, 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"//& + "variable gustiness.") + + call safe_alloc_ptr(CS%gust,isd,ied,jsd,jed) + gust_file = trim(CS%inputdir) // trim(gust_file) + 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. + call get_param(param_file, mdl, "USE_RIGID_SEA_ICE", CS%rigid_sea_ice, & + "If true, sea-ice is rigid enough to exert a \n"//& + "nonhydrostatic pressure that resist vertical motion.", & + default=.false.) + if (CS%rigid_sea_ice) then + call get_param(param_file, mdl, "SEA_ICE_MEAN_DENSITY", CS%density_sea_ice, & + "A typical density of sea ice, used with the kinematic \n"//& + "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & + default=900.0) + call get_param(param_file, mdl, "SEA_ICE_VISCOSITY", CS%Kv_sea_ice, & + "The kinematic viscosity of sufficiently thick sea ice \n"//& + "for use in calculating the rigidity of sea ice.", & + units="m2 s-1", default=1.0e9) + call get_param(param_file, mdl, "SEA_ICE_RIGID_MASS", CS%rigid_sea_ice_mass, & + "The mass of sea-ice per unit area at which the sea-ice \n"//& + "starts to exhibit rigidity", units="kg m-2", default=1000.0) + endif + + call get_param(param_file, mdl, "ALLOW_ICEBERG_FLUX_DIAGNOSTICS", iceberg_flux_diags, & + "If true, makes available diagnostics of fluxes from icebergs\n"//& + "as seen by MOM6.", default=.false.) + call register_forcing_type_diags(Time, diag, CS%use_temperature, CS%handles, & + use_berg_fluxes=iceberg_flux_diags) + + call get_param(param_file, mdl, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, & + "If true, allows flux adjustments to specified via the \n"//& + "data_table using the component name 'OCN'.", default=.false.) + if (CS%allow_flux_adjustments) then + call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) + endif + + 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. + call restart_init(param_file, CS%restart_CSp, "MOM_forcing.res") +!### call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & +!### CS%restart_CSp) + call restart_init_end(CS%restart_CSp) + + if (associated(CS%restart_CSp)) then + call Get_MOM_Input(dirs=dirs) + + new_sim = .false. + if ((dirs%input_filename(1:1) == 'n') .and. & + (LEN_TRIM(dirs%input_filename) == 1)) new_sim = .true. + if (.not.new_sim) then + call restore_state(dirs%input_filename, dirs%restart_input_dir, Time_frc, & + G, CS%restart_CSp) + endif + endif + +!### call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) + + call user_revise_forcing_init(param_file, CS%urf_CS) + + call cpu_clock_end(id_clock_forcing) +end subroutine surface_forcing_init + +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. + + if (present(fluxes)) call deallocate_forcing_type(fluxes) + +!### call controlled_forcing_end(CS%ctrl_forcing_CSp) + + if (associated(CS)) deallocate(CS) + CS => NULL() + +end subroutine surface_forcing_end + +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 + 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%q_flux ', mpp_chksum( iobt%q_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%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 ) + if (associated(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 ) +100 FORMAT(" CHECKSUM::",A20," = ",Z20) + + call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%') + +end subroutine ice_ocn_bnd_type_chksum + +end module MOM_surface_forcing diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 09557df8c8..730a889566 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -378,18 +378,7 @@ module mom_cap_mod use time_manager_mod, only: date_to_string use time_manager_mod, only: fms_get_calendar_type => get_calendar_type use MOM_domains, only: MOM_infra_init, num_pes, root_pe, pe_here - -!#ifdef CESMCOUPLED -! use ocn_comp_nuopc, only: ocean_public_type, ocean_state_type -! use ocn_comp_nuopc, only: update_ocean_model, ocean_model_init -! use ocn_comp_nuopc, only: ocn_export, get_ocean_grid, ocean_model_data_get -! use ocn_comp_nuopc, only: ocean_model_end, ocean_model_init_sfc -!#else - use ocean_model_mod, only: ocean_model_restart, ocean_public_type, ocean_state_type - use ocean_model_mod, only: ocean_model_data_get - use ocean_model_mod, only: ocean_model_init , update_ocean_model, ocean_model_end, get_ocean_grid use MOM_surface_forcing, only: IOB_allocate -!#endif use MOM_file_parser, only: get_param, log_version, param_file_type, close_param_file use MOM_get_input, only: Get_MOM_Input, directories use MOM_domains, only: pass_var @@ -410,6 +399,13 @@ module mom_cap_mod use shr_nuopc_methods_mod, only: shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod, only: shr_nuopc_methods_State_GetScalar use shr_nuopc_methods_mod, only: shr_nuopc_methods_State_Diagnose + use MOM_ocean_model, only: ocean_model_restart, ocean_public_type, ocean_state_type + use MOM_ocean_model, only: ocean_model_data_get + use MOM_ocean_model, only: ocean_model_init , update_ocean_model, ocean_model_end, get_ocean_grid +#else + use ocean_model_mod, only: ocean_model_restart, ocean_public_type, ocean_state_type + use ocean_model_mod, only: ocean_model_data_get + use ocean_model_mod, only: ocean_model_init , update_ocean_model, ocean_model_end, get_ocean_grid #endif use ESMF @@ -472,6 +468,7 @@ module mom_cap_mod __FILE__ contains + !----------------------------------------------------------------------- !------------------- Solo Ocean code starts here ----------------------- !----------------------------------------------------------------------- From 8a230737d42c77b9c463737bd2c509f2410a066b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 28 May 2018 10:30:24 -0600 Subject: [PATCH 0301/1072] more udpates to make mct and mom caps similar --- config_src/mct_driver/MOM_ocean_model.F90 | 748 ++------------- config_src/mct_driver/MOM_surface_forcing.F90 | 855 +++++++++++------- config_src/mct_driver/ocn_comp_mct.F90 | 9 + 3 files changed, 593 insertions(+), 1019 deletions(-) diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 80395d4a87..dc17b722ed 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -17,66 +17,66 @@ module MOM_ocean_model ! 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, fill_symmetric_edges -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_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, 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_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 : 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 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, 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, fill_symmetric_edges +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_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_x2o_to_fluxes_and_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_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 : 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 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 ! 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 +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 @@ -92,9 +92,9 @@ module MOM_ocean_model 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_ocean_boundary_type public ice_ocn_bnd_type_chksum public ocean_public_type_chksum public ocean_model_data_get @@ -122,14 +122,14 @@ module MOM_ocean_model !! 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 - !! of the two velocity components. Valid entries + integer :: stagger = -999 !< The staggering relative to the tracer points + !! points of the two velocity components. Valid entries !! include AGRID, BGRID_NE, CGRID_NE, BGRID_SW, and CGRID_SW, !! corresponding to the community-standard Arakawa notation. !! (These are named integers taken from mpp_parameter_mod.) - !! Following MOM, this is BGRID_NE by default when the ocean - !! is initialized, but here it is set to -999 so that a - !! global max across ocean and non-ocean processors can be + !! Following MOM5, stagger is BGRID_NE by default when the + !! ocean is initialized, but here it is set to -999 so that + !! a global max across ocean and non-ocean processors can be !! used to determine its value. real, pointer, dimension(:,:) :: & t_surf => NULL(), & !< SST on t-cell (degrees Kelvin) @@ -449,9 +449,9 @@ subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, & 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 ocn_import(OS%forces, OS%fluxes, OS%Time, OS%grid, OS%forcing_CSp, & - OS%sfc_state, x2o_o, ind, sw_decomp, c1, c2, c3, c4, & - OS%restore_salinity, OS%restore_temp) + call convert_x2o_to_fluxes_and_forces(OS%forces, OS%fluxes, OS%Time, OS%grid, OS%forcing_CSp, & + OS%sfc_state, x2o_o, ind, sw_decomp, c1, c2, c3, c4, & + 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) @@ -481,9 +481,9 @@ subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, & 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 ocn_import(OS%forces, OS%flux_tmp, OS%Time, OS%grid, OS%forcing_CSp, & - OS%sfc_state, x2o_o, ind, sw_decomp, c1, c2, c3, c4, & - OS%restore_salinity, OS%restore_temp) + call convert_x2o_to_fluxes_and_forces(OS%forces, OS%flux_tmp, OS%Time, OS%grid, OS%forcing_CSp, & + OS%sfc_state, x2o_o, ind, sw_decomp, c1, c2, c3, c4, & + OS%restore_salinity, OS%restore_temp) if (OS%use_ice_shelf) then call shelf_calc_flux(OS%sfc_state, OS%forces, OS%flux_tmp, OS%Time, time_step, OS%Ice_shelf_CSp) @@ -498,6 +498,7 @@ subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, & ! Accumulate the forcing over time steps call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, time_step, 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. call copy_back_forcing_fields(OS%fluxes, OS%forces, OS%grid) @@ -1031,518 +1032,6 @@ end subroutine get_ocean_grid ! Routines that are specific to MCT driver !======================================================================= - !> 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. - subroutine ocn_import(forces, fluxes, Time, G, CS, state, x2o_o, ind, sw_decomp, & - c1, c2, c3, c4, restore_salt, restore_temp) - - type(mech_forcing), intent(inout) :: forces !< Driving mechanical forces - type(forcing), intent(inout) :: fluxes !< Surface fluxes - type(time_type), intent(in) :: Time !< Model time - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid - type(surface_forcing_CS), pointer :: CS !< control structure returned by a previous call to surface_forcing_init - type(surface), intent(in) :: state !< control structure to ocean surface state fields. - real(kind=8), intent(in) :: x2o_o(:,:) !< Fluxes from coupler to ocean, computed by ocean - type(cpl_indices_type), intent(inout) :: ind !< Structure with MCT attribute vectors and indices - logical, intent(in) :: sw_decomp !< controls if shortwave is decomposed into four components - real(kind=8), optional, intent(in) :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition - logical, optional, intent(in) :: restore_salt !< Controls if salt is restored - logical, optional, intent(in) :: restore_temp !< Controls if temp is restored - - ! 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) - - real, dimension(SZI_(G),SZJ_(G)) :: & - taux_at_h, & ! Zonal wind stresses at h points (Pa) - tauy_at_h, & ! Meridional wind stresses at h points (Pa) - 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 - - 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, k, 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 - - real :: C_p ! heat capacity of seawater ( J/(K kg) ) - - call cpu_clock_begin(id_clock_forcing) - - 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 - - C_p = fluxes%C_p - Irho0 = 1.0/CS%Rho0 - open_ocn_mask(:,:) = 1.0 - pme_adj(:,:) = 0.0 - fluxes%vPrecGlobalAdj = 0.0 - fluxes%vPrecGlobalScl = 0.0 - fluxes%saltFluxGlobalAdj = 0.0 - fluxes%saltFluxGlobalScl = 0.0 - fluxes%netFWGlobalAdj = 0.0 - fluxes%netFWGlobalScl = 0.0 - - restore_salinity = .false. - if (present(restore_salt)) restore_salinity = restore_salt - restore_sst = .false. - if (present(restore_temp)) restore_sst = restore_temp - - ! if true, allocation and initialization - if (fluxes%dt_buoy_accum < 0) then - call allocate_forcing_type(G, fluxes, water=.true., heat=.true., & - ustar=.true., press=.true.) - call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., & - press=.true.) - call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%sw_nir_dir,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%sw_nir_dif,isd,ied,jsd,jed) - - call safe_alloc_ptr(fluxes%p_surf,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%p_surf_full,isd,ied,jsd,jed) - - call safe_alloc_ptr(fluxes%salt_flux,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%salt_flux_in,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) - - call safe_alloc_ptr(fluxes%TKE_tidal,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%ustar_tidal,isd,ied,jsd,jed) - - if (CS%allow_flux_adjustments) then - call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) - endif - - do j=js-2,je+2 ; do i=is-2,ie+2 - fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) - fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) - enddo; enddo - - 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) - endif - - if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) - - fluxes%dt_buoy_accum = 0.0 - endif ! endif for allocation and initialization - - if (CS%allow_flux_adjustments) then - fluxes%heat_added(:,:)=0.0 - fluxes%salt_flux_added(:,:)=0.0 - endif - if (associated(forces%rigidity_ice_u)) forces%rigidity_ice_u(:,:) = 0.0 - if (associated(forces%rigidity_ice_v)) forces%rigidity_ice_v(:,:) = 0.0 - - 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) - enddo; enddo - CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) - endif ! endif for allocation and initialization - - do j=js,je ; do i=is,ie - fluxes%salt_flux(i,j) = 0.0 - fluxes%vprec(i,j) = 0.0 - enddo; enddo - - ! Salinity restoring logic - if (restore_salinity) then - call time_interp_external(CS%id_srestore,Time,data_restore) - ! open_ocn_mask indicates where to restore salinity (1 means restore, 0 does not) - open_ocn_mask(:,:) = 1.0 - if (CS%mask_srestore_under_ice) then ! Do not restore under sea-ice - do j=js,je ; do i=is,ie - if (state%SST(i,j) .le. -0.0539*state%SSS(i,j)) open_ocn_mask(i,j)=0.0 - enddo; enddo - endif - if (CS%salt_restore_as_sflux) then - do j=js,je ; do i=is,ie - delta_sss = data_restore(i,j)- 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 - enddo; enddo - if (CS%adjust_net_srestore_to_zero) then - if (CS%adjust_net_srestore_by_scaling) then - call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) - fluxes%saltFluxGlobalAdj = 0. - else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf - fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj - endif - endif - fluxes%salt_flux_added(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) ! Diagnostic - else - do j=js,je ; do i=is,ie - if (G%mask2dT(i,j) > 0.5) then - delta_sss = 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))* & - (CS%Rho0*CS%Flux_const) * & - delta_sss / (0.5*(state%SSS(i,j) + data_restore(i,j))) - endif - enddo; enddo - if (CS%adjust_net_srestore_to_zero) then - if (CS%adjust_net_srestore_by_scaling) then - call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) - fluxes%vPrecGlobalAdj = 0. - else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) - fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf - do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) - enddo; enddo - endif - endif - endif - endif - - ! SST restoring logic - if (restore_sst) then - call time_interp_external(CS%id_trestore,Time,data_restore) - do j=js,je ; do i=is,ie - delta_sst = data_restore(i,j)- 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 - enddo; enddo - endif - - ! GMM, CIME uses AGRID. All the BGRID_NE code can be cleaned later - wind_stagger = AGRID - - 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 - endif - if (wind_stagger == AGRID) then - ! This is necessary to fill in the halo points. - taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 - endif - - k = 0 - do j=js,je ; do i=is,ie - k = k + 1 ! Increment position within gindex - - if (wind_stagger == BGRID_NE) then - taux_at_q(I,J) = x2o_o(ind%x2o_Foxx_taux,k) * CS%wind_stress_multiplier - tauy_at_q(I,J) = x2o_o(ind%x2o_Foxx_tauy,k) * CS%wind_stress_multiplier - ! GMM, cime uses AGRID - elseif (wind_stagger == AGRID) then - taux_at_h(i,j) = x2o_o(ind%x2o_Foxx_taux,k) * CS%wind_stress_multiplier - tauy_at_h(i,j) = x2o_o(ind%x2o_Foxx_tauy,k) * CS%wind_stress_multiplier - else ! C-grid wind stresses. - forces%taux(I,j) = x2o_o(ind%x2o_Foxx_taux,k) * CS%wind_stress_multiplier - forces%tauy(i,J) = x2o_o(ind%x2o_Foxx_tauy,k) * CS%wind_stress_multiplier - endif - - ! liquid precipitation (rain) - if (associated(fluxes%lprec)) & - fluxes%lprec(i,j) = x2o_o(ind%x2o_Faxa_rain,k) * G%mask2dT(i,j) - - ! frozen precipitation (snow) - if (associated(fluxes%fprec)) & - fluxes%fprec(i,j) = x2o_o(ind%x2o_Faxa_snow,k) * G%mask2dT(i,j) - - ! evaporation - if (associated(fluxes%evap)) & - fluxes%evap(i,j) = x2o_o(ind%x2o_Foxx_evap,k) * G%mask2dT(i,j) - - ! river runoff flux - if (associated(fluxes%lrunoff)) & - fluxes%lrunoff(i,j) = x2o_o(ind%x2o_Foxx_rofl,k) * G%mask2dT(i,j) - - ! ice runoff flux - if (associated(fluxes%frunoff)) & - fluxes%frunoff(i,j) = x2o_o(ind%x2o_Foxx_rofi,k) * G%mask2dT(i,j) - - ! 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) = 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) - - ! longwave radiation, sum up and down (W/m2) - if (associated(fluxes%LW)) & - fluxes%LW(i,j) = (x2o_o(ind%x2o_Faxa_lwdn,k) + x2o_o(ind%x2o_Foxx_lwup,k)) * G%mask2dT(i,j) - - ! sensible heat flux (W/m2) - if (associated(fluxes%sens)) & - fluxes%sens(i,j) = x2o_o(ind%x2o_Foxx_sen,k) * G%mask2dT(i,j) - - ! latent heat flux (W/m^2) - if (associated(fluxes%latent)) & - fluxes%latent(i,j) = x2o_o(ind%x2o_Foxx_lat,k) * G%mask2dT(i,j) - - if (sw_decomp) then - ! Use runtime coefficients to decompose net short-wave heat flux into 4 components - ! 1) visible, direct shortwave (W/m2) - if (associated(fluxes%sw_vis_dir)) & - fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * x2o_o(ind%x2o_Foxx_swnet,k)*c1 - ! 2) visible, diffuse shortwave (W/m2) - if (associated(fluxes%sw_vis_dif)) & - fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * x2o_o(ind%x2o_Foxx_swnet,k)*c2 - ! 3) near-IR, direct shortwave (W/m2) - if (associated(fluxes%sw_nir_dir)) & - fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * x2o_o(ind%x2o_Foxx_swnet,k)*c3 - ! 4) near-IR, diffuse shortwave (W/m2) - if (associated(fluxes%sw_nir_dif)) & - fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * x2o_o(ind%x2o_Foxx_swnet,k)*c4 - - 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) - else - call MOM_error(FATAL,"fill_ice_ocean_bnd: this option has not been implemented yet."// & - "Shortwave must be decomposed using coeffs. c1, c2, c3, c4."); - endif - - ! applied surface pressure from atmosphere and cryosphere - ! sea-level pressure (Pa) - if (associated(forces%p_surf_full) .and. associated(forces%p_surf)) then - forces%p_surf_full(i,j) = G%mask2dT(i,j) * x2o_o(ind%x2o_Sa_pslv,k) - if (CS%max_p_surf >= 0.0) then - forces%p_surf(i,j) = MIN(forces%p_surf_full(i,j),CS%max_p_surf) - else - forces%p_surf(i,j) = forces%p_surf_full(i,j) - endif - - if (CS%use_limited_P_SSH) then - forces%p_surf_SSH => forces%p_surf - else - forces%p_surf_SSH => forces%p_surf_full - endif - - endif - - ! salt flux - ! more salt restoring logic - if (associated(fluxes%salt_flux)) & - fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(x2o_o(ind%x2o_Fioi_salt,k) + fluxes%salt_flux(i,j)) - - if (associated(fluxes%salt_flux_in)) & - fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*x2o_o(ind%x2o_Fioi_salt,k) - - enddo; enddo - ! ############################ END OF MCT to MOM ############################## - - ! adjust the NET fresh-water flux to zero, if flagged - if (CS%adjust_net_fresh_water_to_zero) then - do j=js,je ; do i=is,ie - net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(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 - 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 - - if (CS%adjust_net_fresh_water_by_scaling) then - call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) - do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) - enddo; enddo - else - fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf - do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%netFWGlobalAdj ) * G%mask2dT(i,j) - enddo; enddo - endif - - endif - - ! surface momentum stress related fields as function of staggering - 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) - - do j=js,je ; do I=Isq,Ieq - forces%taux(I,j) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & - forces%taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + & - G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) - enddo; enddo - - do J=Jsq,Jeq ; do i=is,ie - forces%tauy(i,J) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & - forces%tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + & - G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) - enddo; enddo - - ! ustar is required for the bulk mixed layer formulation. The background value - ! of 0.02 Pa is a relatively small value intended to give reasonable behavior - ! in regions of very weak winds. - - do j=js,je ; do i=is,ie - tau_mag = 0.0 ; gustiness = CS%gust_const - if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & - (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then - tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & - G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & - (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & - G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & - ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) - if (CS%read_gust_2d) gustiness = CS%gust(i,j) - endif - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) - enddo; enddo - - elseif (wind_stagger == AGRID) then - call pass_vector(taux_at_h, tauy_at_h, G%Domain,stagger=AGRID) - - do j=js,je ; do I=Isq,Ieq - forces%taux(I,j) = 0.0 - if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & - forces%taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + & - G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & - (G%mask2dT(i,j) + G%mask2dT(i+1,j)) - enddo; enddo - - do J=Jsq,Jeq ; do i=is,ie - forces%tauy(i,J) = 0.0 - if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & - forces%tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + & - G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & - (G%mask2dT(i,j) + G%mask2dT(i,j+1)) - enddo; enddo - - do j=js,je ; do i=is,ie - gustiness = CS%gust_const - if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & - sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) - enddo; enddo - - 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) - - do j=js,je ; do i=is,ie - taux2 = 0.0 - if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & - taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + & - G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) - - tauy2 = 0.0 - if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & - tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + & - G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) - - if (CS%read_gust_2d) then - forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) - else - forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) - endif - enddo; enddo - - endif ! endif for wind related fields - - - ! sea ice related fields - if (CS%rigid_sea_ice) then - ! The commented out code here and in the following lines is the correct - ! version, but the incorrect version is being retained temporarily to avoid - ! changing answers. - call pass_var(forces%p_surf_full, G%Domain) - I_GEarth = 1.0 / G%G_Earth - Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) - do I=isd,ied-1 ; do j=jsd,jed - mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth - mass_eff = 0.0 - if (mass_ice > CS%rigid_sea_ice_mass) then - mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & - (mass_ice + CS%rigid_sea_ice_mass) - endif - ! CAUTION: with both rigid_sea_ice and ice shelves, we will need to make this - ! a maximum for the second call. - forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + Kv_rho_ice * mass_eff - enddo; enddo - do i=isd,ied ; do J=jsd,jed-1 - mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i,j+1)) * I_GEarth - mass_eff = 0.0 - if (mass_ice > CS%rigid_sea_ice_mass) then - mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & - (mass_ice + CS%rigid_sea_ice_mass) - endif - forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + Kv_rho_ice * mass_eff - enddo; enddo - endif - - if (CS%allow_flux_adjustments) then - ! Apply adjustments to fluxes - call apply_flux_adjustments(G, CS, Time, forces, fluxes) - endif - - ! Allow for user-written code to alter fluxes after all the above - call user_alter_forcing(state, fluxes, Time, G, CS%urf_CS) - - call cpu_clock_end(id_clock_forcing) - - end subroutine ocn_import !======================================================================= @@ -1644,99 +1133,4 @@ end subroutine ocn_export !======================================================================= - !> Adds 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) - subroutine apply_flux_adjustments(G, CS, Time, forces, 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(mech_forcing), intent(inout) :: forces !< Driving mechanical forces - type(forcing), optional, 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) - - integer :: isc, iec, jsc, jec, i, j - real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau - logical :: overrode_x, overrode_y, overrode_h - - 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) - - 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 - - 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) - - - tempx_at_h(:,:) = 0.0 ; tempy_at_h(:,:) = 0.0 - ! Either reads data or leaves contents unchanged - overrode_x = .false. ; overrode_y = .false. - call data_override('OCN', 'taux_adj', tempx_at_h(isc:iec,jsc:jec), Time, override=overrode_x) - call data_override('OCN', 'tauy_adj', tempy_at_h(isc:iec,jsc:jec), Time, override=overrode_y) - - if (overrode_x .or. overrode_y) then - if (.not. (overrode_x .and. overrode_y)) call MOM_error(FATAL,"apply_flux_adjustments: "//& - "Both taux_adj and tauy_adj must be specified, or neither, in data_table") - - ! Rotate winds - call pass_vector(tempx_at_h, tempy_at_h, G%Domain, To_All, AGRID) - do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 - dLonDx = G%geoLonCu(I,j) - G%geoLonCu(I-1,j) - dLonDy = G%geoLonCv(i,J) - G%geoLonCv(i,J-1) - rDlon = sqrt( dLonDx * dLonDx + dLonDy * dLonDy ) - if (rDlon > 0.) rDlon = 1. / rDlon - cosA = dLonDx * rDlon - sinA = dLonDy * rDlon - zonal_tau = tempx_at_h(i,j) - merid_tau = tempy_at_h(i,j) - tempx_at_h(i,j) = cosA * zonal_tau - sinA * merid_tau - tempy_at_h(i,j) = sinA * zonal_tau + cosA * merid_tau - enddo; enddo - - ! Average to C-grid locations - do j=G%jsc,G%jec ; do I=G%isc-1,G%iec - forces%taux(I,j) = forces%taux(I,j) + 0.5 * ( tempx_at_h(i,j) + tempx_at_h(i+1,j) ) - enddo; enddo - - do J=G%jsc-1,G%jec ; do i=G%isc,G%iec - forces%tauy(i,J) = forces%tauy(i,J) + 0.5 * ( tempy_at_h(i,j) + tempy_at_h(i,j+1) ) - enddo; enddo - endif ! overrode_x .or. overrode_y - - end subroutine apply_flux_adjustments - 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 0550038b8e..9a182d547c 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -42,13 +42,15 @@ module MOM_surface_forcing 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 convert_x2o_to_fluxes_and_forces public surface_forcing_init public ice_ocn_bnd_type_chksum public forcing_save_restart @@ -186,377 +188,534 @@ module MOM_surface_forcing integer :: id_clock_forcing +!======================================================================= contains - -!> 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, CS, & - sfc_state, restore_salt, restore_temp) - type(ice_ocean_boundary_type), & - 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. - !! 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 - type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a - !! previous call to surface_forcing_init. - type(surface), intent(in) :: sfc_state !< A structure containing fields that describe the - !! surface state of the ocean. - 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. - - - 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, 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 - - 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 - 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 - - C_p = fluxes%C_p - open_ocn_mask(:,:) = 1.0 - pme_adj(:,:) = 0.0 - fluxes%vPrecGlobalAdj = 0.0 - fluxes%vPrecGlobalScl = 0.0 - fluxes%saltFluxGlobalAdj = 0.0 - fluxes%saltFluxGlobalScl = 0.0 - fluxes%netFWGlobalAdj = 0.0 - fluxes%netFWGlobalScl = 0.0 - - restore_salinity = .false. - if (present(restore_salt)) restore_salinity = restore_salt - restore_sst = .false. - if (present(restore_temp)) restore_sst = restore_temp - - ! allocation and initialization if this is the first time that this - ! flux type has been used. - if (fluxes%dt_buoy_accum < 0) then - call allocate_forcing_type(G, fluxes, water=.true., heat=.true., & - ustar=.true., press=.true.) - - call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%sw_nir_dir,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%sw_nir_dif,isd,ied,jsd,jed) - - 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) - call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) - - call safe_alloc_ptr(fluxes%TKE_tidal,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%ustar_tidal,isd,ied,jsd,jed) +!======================================================================= + + !> 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. + subroutine convert_x2o_to_fluxes_and_forces(forces, fluxes, Time, G, CS, sfc_state, x2o, ind, sw_decomp, & + c1, c2, c3, c4, restore_salt, restore_temp) + + type(mech_forcing), intent(inout) :: forces !< Driving mechanical forces + type(forcing), intent(inout) :: fluxes !< Surface fluxes + type(time_type), intent(in) :: Time !< Model time + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid + type(surface_forcing_CS), pointer :: CS !< control structure returned by a previous call to surface_forcing_init + type(surface), intent(in) :: sfc_state !< control structure to ocean surface state fields. + real(kind=8), intent(in) :: x2o(:,:) !< Fluxes from coupler to ocean, computed by ocean + type(cpl_indices_type), intent(inout) :: ind !< Structure with MCT attribute vectors and indices + logical, intent(in) :: sw_decomp !< controls if shortwave is decomposed into four components + real(kind=8), optional, intent(in) :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition + logical, optional, intent(in) :: restore_salt !< Controls if salt is restored + logical, optional, intent(in) :: restore_temp !< Controls if temp is restored + + ! 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) + + real, dimension(SZI_(G),SZJ_(G)) :: & + taux_at_h, & ! Zonal wind stresses at h points (Pa) + tauy_at_h, & ! Meridional wind stresses at h points (Pa) + 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 + + 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, k, 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 + + real :: C_p ! heat capacity of seawater ( J/(K kg) ) + + call cpu_clock_begin(id_clock_forcing) + + 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 + + C_p = fluxes%C_p + Irho0 = 1.0/CS%Rho0 + open_ocn_mask(:,:) = 1.0 + pme_adj(:,:) = 0.0 + fluxes%vPrecGlobalAdj = 0.0 + fluxes%vPrecGlobalScl = 0.0 + fluxes%saltFluxGlobalAdj = 0.0 + fluxes%saltFluxGlobalScl = 0.0 + fluxes%netFWGlobalAdj = 0.0 + fluxes%netFWGlobalScl = 0.0 + + restore_salinity = .false. + if (present(restore_salt)) restore_salinity = restore_salt + restore_sst = .false. + if (present(restore_temp)) restore_sst = restore_temp + + ! allocation and initialization if this is the first time that this + ! flux type has been used. + if (fluxes%dt_buoy_accum < 0) then + call allocate_forcing_type(G, fluxes, water=.true., heat=.true., & + ustar=.true., press=.true.) + + call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%sw_nir_dir,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%sw_nir_dif,isd,ied,jsd,jed) + + call safe_alloc_ptr(fluxes%p_surf,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%p_surf_full,isd,ied,jsd,jed) + + call safe_alloc_ptr(fluxes%salt_flux,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%salt_flux_in,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) + + call safe_alloc_ptr(fluxes%TKE_tidal,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%ustar_tidal,isd,ied,jsd,jed) + + if (CS%allow_flux_adjustments) then + call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) + endif + + do j=js-2,je+2 ; do i=is-2,ie+2 + fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) + fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) + enddo; enddo + + ! this is contained in convert_IOB_to_forces + 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) + endif + ! end of additional for MCT cap + + if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) + + fluxes%dt_buoy_accum = 0.0 + endif ! endif for allocation and initialization + + ! additional for MCT cap - relative to convert_IOB_to_fluxes + if (associated(forces%rigidity_ice_u)) forces%rigidity_ice_u(:,:) = 0.0 + if (associated(forces%rigidity_ice_v)) forces%rigidity_ice_v(:,:) = 0.0 + ! end of additional for MCT cap if (CS%allow_flux_adjustments) then - call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) + fluxes%heat_added(:,:)=0.0 + fluxes%salt_flux_added(:,:)=0.0 endif - do j=js-2,je+2 ; do i=is-2,ie+2 - fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) - fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) - enddo ; enddo - - if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) - - fluxes%dt_buoy_accum = 0.0 - endif ! endif for allocation and initialization + 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) + enddo; enddo + CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) + 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) - enddo ; enddo - CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) - endif ! endif for allocation and initialization - - do j=js,je ; do i=is,ie - fluxes%salt_flux(i,j) = 0.0 - fluxes%vprec(i,j) = 0.0 - enddo ; enddo + fluxes%salt_flux(i,j) = 0.0 + fluxes%vprec(i,j) = 0.0 + enddo; enddo - ! Salinity restoring logic - if (restore_salinity) then - call time_interp_external(CS%id_srestore,Time,data_restore) - ! open_ocn_mask indicates where to restore salinity (1 means restore, 0 does not) - open_ocn_mask(:,:) = 1.0 - if (CS%mask_srestore_under_ice) then ! Do not restore under sea-ice - do j=js,je ; do i=is,ie - if (sfc_state%SST(i,j) <= -0.0539*sfc_state%SSS(i,j)) open_ocn_mask(i,j)=0.0 - enddo ; enddo - endif - if (CS%salt_restore_as_sflux) then - do j=js,je ; do i=is,ie - 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)*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 - call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) - fluxes%saltFluxGlobalAdj = 0. - else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf - fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj - endif - endif - fluxes%salt_flux_added(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) ! Diagnostic - else - do j=js,je ; do i=is,ie - 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)*CS%srestore_mask(i,j))* & - (CS%Rho0*CS%Flux_const) * & - delta_sss / (0.5*(sfc_state%SSS(i,j) + data_restore(i,j))) - endif - enddo ; enddo - if (CS%adjust_net_srestore_to_zero) then - if (CS%adjust_net_srestore_by_scaling) then - call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) - fluxes%vPrecGlobalAdj = 0. - else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) - fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf + ! Salinity restoring logic + if (restore_salinity) then + call time_interp_external(CS%id_srestore,Time,data_restore) + ! open_ocn_mask indicates where to restore salinity (1 means restore, 0 does not) + open_ocn_mask(:,:) = 1.0 + if (CS%mask_srestore_under_ice) then ! Do not restore under sea-ice do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) - enddo ; enddo - endif - endif + if (sfc_state%SST(i,j) .le. -0.0539*sfc_state%SSS(i,j)) open_ocn_mask(i,j)=0.0 + enddo; enddo + endif + if (CS%salt_restore_as_sflux) then + do j=js,je ; do i=is,ie + 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 + enddo; enddo + if (CS%adjust_net_srestore_to_zero) then + if (CS%adjust_net_srestore_by_scaling) then + call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) + fluxes%saltFluxGlobalAdj = 0. + else + work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) + fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf + fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj + endif + endif + fluxes%salt_flux_added(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) ! Diagnostic + else + do j=js,je ; do i=is,ie + 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))* & + (CS%Rho0*CS%Flux_const) * & + delta_sss / (0.5*(sfc_state%SSS(i,j) + data_restore(i,j))) + endif + enddo; enddo + if (CS%adjust_net_srestore_to_zero) then + if (CS%adjust_net_srestore_by_scaling) then + call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) + fluxes%vPrecGlobalAdj = 0. + else + work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) + fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf + do j=js,je ; do i=is,ie + fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) + enddo; enddo + endif + endif + endif endif - endif - - ! SST restoring logic - if (restore_sst) then - call time_interp_external(CS%id_trestore,Time,data_restore) - 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%trestore_mask(i,j) * & - (CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2 - enddo ; enddo - endif + ! SST restoring logic + if (restore_sst) then + call time_interp_external(CS%id_trestore,Time,data_restore) + 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 + enddo; enddo + endif - ! obtain fluxes from IOB; note the staggering of indices - i0 = is - isc_bnd ; j0 = js - jsc_bnd - do j=js,je ; do i=is,ie - - if (associated(IOB%lprec)) & - fluxes%lprec(i,j) = IOB%lprec(i-i0,j-j0) * G%mask2dT(i,j) - - if (associated(IOB%fprec)) & - fluxes%fprec(i,j) = IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j) - - if (associated(IOB%q_flux)) & - fluxes%evap(i,j) = - IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) - - if (associated(IOB%runoff)) & - fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) + ! GMM, CIME uses AGRID. All the BGRID_NE code can be cleaned later + wind_stagger = AGRID - if (associated(IOB%calving)) & - fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) + 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 + endif + if (wind_stagger == AGRID) then + ! This is necessary to fill in the halo points. + taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 + endif - if (associated(IOB%ustar_berg)) & - fluxes%ustar_berg(i,j) = IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) + k = 0 + do j=js,je ; do i=is,ie + k = k + 1 ! Increment position within gindex + + if (wind_stagger == BGRID_NE) then + taux_at_q(I,J) = x2o(ind%x2o_Foxx_taux,k) * CS%wind_stress_multiplier + tauy_at_q(I,J) = x2o(ind%x2o_Foxx_tauy,k) * CS%wind_stress_multiplier + ! GMM, cime uses AGRID + elseif (wind_stagger == AGRID) then + taux_at_h(i,j) = x2o(ind%x2o_Foxx_taux,k) * CS%wind_stress_multiplier + tauy_at_h(i,j) = x2o(ind%x2o_Foxx_tauy,k) * CS%wind_stress_multiplier + else ! C-grid wind stresses. + forces%taux(I,j) = x2o(ind%x2o_Foxx_taux,k) * CS%wind_stress_multiplier + forces%tauy(i,J) = x2o(ind%x2o_Foxx_tauy,k) * CS%wind_stress_multiplier + endif + + ! NOTE: in convert_IOB_to_fluxes x2o below is replace by + ! IOB%flux_quantity where flux_quantity is what we use to + ! compute fluxes%flux_quantity + + ! liquid precipitation (rain) + if (associated(fluxes%lprec)) & + fluxes%lprec(i,j) = x2o(ind%x2o_Faxa_rain,k) * G%mask2dT(i,j) + + ! frozen precipitation (snow) + if (associated(fluxes%fprec)) & + fluxes%fprec(i,j) = x2o(ind%x2o_Faxa_snow,k) * G%mask2dT(i,j) + + ! evaporation + if (associated(fluxes%evap)) & + fluxes%evap(i,j) = x2o(ind%x2o_Foxx_evap,k) * G%mask2dT(i,j) + + ! river runoff flux + if (associated(fluxes%lrunoff)) & + fluxes%lrunoff(i,j) = x2o(ind%x2o_Foxx_rofl,k) * G%mask2dT(i,j) + + ! ice runoff flux + if (associated(fluxes%frunoff)) & + fluxes%frunoff(i,j) = x2o(ind%x2o_Foxx_rofi,k) * G%mask2dT(i,j) + + ! 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) = 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) + + ! longwave radiation, sum up and down (W/m2) + if (associated(fluxes%LW)) & + fluxes%LW(i,j) = (x2o(ind%x2o_Faxa_lwdn,k) + x2o(ind%x2o_Foxx_lwup,k)) * G%mask2dT(i,j) + + ! sensible heat flux (W/m2) + if (associated(fluxes%sens)) & + fluxes%sens(i,j) = x2o(ind%x2o_Foxx_sen,k) * G%mask2dT(i,j) + + ! latent heat flux (W/m^2) + if (associated(fluxes%latent)) & + fluxes%latent(i,j) = x2o(ind%x2o_Foxx_lat,k) * G%mask2dT(i,j) + + if (sw_decomp) then + ! Use runtime coefficients to decompose net short-wave heat flux into 4 components + ! 1) visible, direct shortwave (W/m2) + if (associated(fluxes%sw_vis_dir)) & + fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * x2o(ind%x2o_Foxx_swnet,k)*c1 + ! 2) visible, diffuse shortwave (W/m2) + if (associated(fluxes%sw_vis_dif)) & + fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * x2o(ind%x2o_Foxx_swnet,k)*c2 + ! 3) near-IR, direct shortwave (W/m2) + if (associated(fluxes%sw_nir_dir)) & + fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * x2o(ind%x2o_Foxx_swnet,k)*c3 + ! 4) near-IR, diffuse shortwave (W/m2) + if (associated(fluxes%sw_nir_dif)) & + fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * x2o(ind%x2o_Foxx_swnet,k)*c4 + + 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) + else + call MOM_error(FATAL,"fill_ice_ocean_bnd: this option has not been implemented yet."// & + "Shortwave must be decomposed using coeffs. c1, c2, c3, c4."); + endif + + ! applied surface pressure from atmosphere and cryosphere + ! sea-level pressure (Pa) + if (associated(forces%p_surf_full) .and. associated(forces%p_surf)) then + forces%p_surf_full(i,j) = G%mask2dT(i,j) * x2o(ind%x2o_Sa_pslv,k) + if (CS%max_p_surf >= 0.0) then + forces%p_surf(i,j) = MIN(forces%p_surf_full(i,j),CS%max_p_surf) + else + forces%p_surf(i,j) = forces%p_surf_full(i,j) + endif + + if (CS%use_limited_P_SSH) then + forces%p_surf_SSH => forces%p_surf + else + forces%p_surf_SSH => forces%p_surf_full + endif + + endif + + ! salt flux + ! more salt restoring logic + if (associated(fluxes%salt_flux)) & + fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(x2o(ind%x2o_Fioi_salt,k) + fluxes%salt_flux(i,j)) + + if (associated(fluxes%salt_flux_in)) & + fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*x2o(ind%x2o_Fioi_salt,k) - if (associated(IOB%area_berg)) & - fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) + enddo; enddo + ! ############################ END OF MCT to MOM ############################## + + ! adjust the NET fresh-water flux to zero, if flagged + if (CS%adjust_net_fresh_water_to_zero) then + do j=js,je ; do i=is,ie + net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(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 + 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 + + if (CS%adjust_net_fresh_water_by_scaling) then + call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) + do j=js,je ; do i=is,ie + fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) + enddo; enddo + else + fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf + do j=js,je ; do i=is,ie + fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%netFWGlobalAdj ) * G%mask2dT(i,j) + enddo; enddo + endif - if (associated(IOB%mass_berg)) & - fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) + endif - if (associated(IOB%runoff_hflx)) & - fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) + ! surface momentum stress related fields as function of staggering + 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) + + do j=js,je ; do I=Isq,Ieq + forces%taux(I,j) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & + forces%taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + & + G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) + enddo; enddo + + do J=Jsq,Jeq ; do i=is,ie + forces%tauy(i,J) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & + forces%tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + & + G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) + enddo; enddo + + ! ustar is required for the bulk mixed layer formulation. The background value + ! of 0.02 Pa is a relatively small value intended to give reasonable behavior + ! in regions of very weak winds. + + do j=js,je ; do i=is,ie + tau_mag = 0.0 ; gustiness = CS%gust_const + if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then + tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & + G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & + (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & + G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & + ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) + if (CS%read_gust_2d) gustiness = CS%gust(i,j) + endif + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) + enddo; enddo - if (associated(IOB%calving_hflx)) & - fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) + elseif (wind_stagger == AGRID) then + call pass_vector(taux_at_h, tauy_at_h, G%Domain,stagger=AGRID) + + do j=js,je ; do I=Isq,Ieq + forces%taux(I,j) = 0.0 + if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & + forces%taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + & + G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & + (G%mask2dT(i,j) + G%mask2dT(i+1,j)) + enddo; enddo + + do J=Jsq,Jeq ; do i=is,ie + forces%tauy(i,J) = 0.0 + if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & + forces%tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + & + G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & + (G%mask2dT(i,j) + G%mask2dT(i,j+1)) + enddo; enddo + + do j=js,je ; do i=is,ie + gustiness = CS%gust_const + if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & + sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) + enddo; enddo - if (associated(IOB%lw_flux)) & - fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) + 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) - if (associated(IOB%t_flux)) & - fluxes%sens(i,j) = - IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) + do j=js,je ; do i=is,ie + taux2 = 0.0 + if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & + taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + & + G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) - fluxes%latent(i,j) = 0.0 - 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 - if (associated(IOB%calving)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion - fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion - endif - if (associated(IOB%q_flux)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor - fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor - endif + tauy2 = 0.0 + if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & + tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + & + G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) - fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) + if (CS%read_gust_2d) then + forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) + else + forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) + endif + enddo; enddo - 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) + endif ! endif for wind related fields - enddo ; enddo - ! 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 + ! sea ice related fields + if (CS%rigid_sea_ice) then + ! The commented out code here and in the following lines is the correct + ! version, but the incorrect version is being retained temporarily to avoid + ! changing answers. + call pass_var(forces%p_surf_full, G%Domain) + I_GEarth = 1.0 / G%G_Earth + Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) + do I=isd,ied-1 ; do j=jsd,jed + mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth + mass_eff = 0.0 + if (mass_ice > CS%rigid_sea_ice_mass) then + mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & + (mass_ice + CS%rigid_sea_ice_mass) + endif + ! CAUTION: with both rigid_sea_ice and ice shelves, we will need to make this + ! a maximum for the second call. + forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + Kv_rho_ice * mass_eff + enddo; enddo + do i=isd,ied ; do J=jsd,jed-1 + mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i,j+1)) * I_GEarth + mass_eff = 0.0 + if (mass_ice > CS%rigid_sea_ice_mass) then + mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & + (mass_ice + CS%rigid_sea_ice_mass) + endif + forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + Kv_rho_ice * mass_eff + enddo; enddo endif - endif - ! more salt restoring logic - 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 - -!### if (associated(CS%ctrl_forcing_CSp)) then -!### do j=js,je ; do i=is,ie -!### SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) -!### SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) -!### SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) -!### enddo ; enddo -!### call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_restore, & -!### fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) -!### endif - - ! adjust the NET fresh-water flux to zero, if flagged - if (CS%adjust_net_fresh_water_to_zero) then - sign_for_net_FW_bug = 1. - if (CS%use_net_FW_adjustment_sign_bug) sign_for_net_FW_bug = -1. - do j=js,je ; do i=is,ie - net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(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 - 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 - - if (CS%adjust_net_fresh_water_by_scaling) then - call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) - do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) - enddo ; enddo - else - fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf - do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%netFWGlobalAdj ) * G%mask2dT(i,j) - enddo ; enddo + if (CS%allow_flux_adjustments) then + ! Apply adjustments to fluxes + call apply_flux_adjustments(G, CS, Time, forces, fluxes) 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 - ! TODO (mvertens 5/27/2018): the following call gives an error: - ! "The type of the actual argument differs from the type of the dummy argument [FLUXES]" - ! Will comment out for now - ! call apply_flux_adjustments(G, CS, Time, fluxes) - endif + ! Allow for user-written code to alter fluxes after all the above + call user_alter_forcing(sfc_state, fluxes, Time, G, CS%urf_CS) - ! Allow for user-written code to alter fluxes after all the above - call user_alter_forcing(sfc_state, fluxes, Time, G, CS%urf_CS) + call cpu_clock_end(id_clock_forcing) - call cpu_clock_end(id_clock_forcing) + end subroutine convert_x2o_to_fluxes_and_forces -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, @@ -835,8 +994,9 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) call cpu_clock_end(id_clock_forcing) end subroutine convert_IOB_to_forces -subroutine IOB_allocate(IOB, isc, iec, jsc, jec) +!======================================================================= +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 @@ -886,6 +1046,7 @@ subroutine IOB_allocate(IOB, isc, iec, jsc, jec) end subroutine IOB_allocate +!======================================================================= !> Adds flux adjustments obtained via data_override !! Component name is 'OCN' @@ -982,6 +1143,8 @@ subroutine apply_flux_adjustments(G, CS, Time, forces, fluxes) end subroutine apply_flux_adjustments +!======================================================================= + !> Adds mechanical forcing adjustments obtained via data_override !! Component name is 'OCN' !! Available adjustments are: @@ -1040,6 +1203,8 @@ subroutine apply_force_adjustments(G, CS, Time, forces) end subroutine apply_force_adjustments +!======================================================================= + !> Saves restart fields associated with the forcing subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & filename_suffix) @@ -1062,6 +1227,8 @@ subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & end subroutine forcing_save_restart +!======================================================================= + !> Initializes surface forcing: get relevant parameters and allocate arrays. subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, restore_temp) type(time_type), intent(in) :: Time !< The current model time @@ -1375,6 +1542,8 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res call cpu_clock_end(id_clock_forcing) end subroutine surface_forcing_init +!======================================================================= + subroutine surface_forcing_end(CS, fluxes) type(surface_forcing_CS), pointer :: CS type(forcing), optional, intent(inout) :: fluxes @@ -1392,6 +1561,8 @@ subroutine surface_forcing_end(CS, fluxes) end subroutine surface_forcing_end +!======================================================================= + subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) character(len=*), intent(in) :: id diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 9c18b527e4..bdb5d2c0e5 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -71,6 +71,15 @@ module ocn_comp_mct public :: ocn_run_mct public :: ocn_final_mct +! Private member functions +private :: get_state_pointers +private :: ocn_SetGSMap_mct +private :: ocn_domain_mct +private :: get_runtype +private :: ocean_model_init_sfc +private :: convert_state_to_ocean_type +private :: forcing_save_restart + ! Flag for debugging logical, parameter :: debug=.true. From 89734e8624a045be096f69e2204e17438b3747f3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 28 May 2018 16:24:53 -0400 Subject: [PATCH 0302/1072] +Extracted add_shelf_forces from add_shelf_fluxes Separated out the call to add_shelf_forces from add_shelf_fluxes and eliminated the mech_forcing type argument to add_shelf_fluxes. All answers are bitwise identical. --- src/ice_shelf/MOM_ice_shelf.F90 | 82 ++++++++++++++------------------- 1 file changed, 34 insertions(+), 48 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 701aade3dd..026c7a0456 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -189,7 +189,7 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) !! returned by a previous call to !! initialize_ice_shelf. - type(ocean_grid_type), pointer :: G => NULL() ! The grid structure used by the ice shelf. + type(ocean_grid_type), pointer :: G => NULL() ! The grid structure used by the ice shelf. type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe !! the ice-shelf state @@ -255,7 +255,7 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) ! coupled ice-ocean dynamics. real, parameter :: c2_3 = 2.0/3.0 - integer :: i, j, is, ie, js, je, ied, jed, it1, it3, iters_vel_solve + integer :: i, j, is, ie, js, je, ied, jed, it1, it3 real, parameter :: rho_fw = 1000.0 ! fresh water density if (.not. associated(CS)) call MOM_error(FATAL, "shelf_calc_flux: "// & @@ -631,7 +631,11 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) if (CS%DEBUG) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, haloshift=0) - call add_shelf_flux(G, CS, state, forces, fluxes) + call add_shelf_forces(G, CS, forces, do_shelf_area=(CS%active_shelf_dynamics .or. & + CS%override_shelf_movement)) + call add_shelf_flux(G, CS, state, fluxes) + + call copy_common_forcing_fields(forces, fluxes, G) ! now the thermodynamic data is passed on... time to update the ice dynamic quantities @@ -805,12 +809,11 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) end subroutine add_shelf_forces !> Updates surface fluxes that are influenced by sub-ice-shelf melting -subroutine add_shelf_flux(G, CS, state, forces, fluxes) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(ice_shelf_CS), pointer :: CS !< This module's control structure. - type(surface), intent(inout) :: state!< Surface ocean state - type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(forcing), intent(inout) :: fluxes !< A structure of surface fluxes that may be used/updated. +subroutine add_shelf_flux(G, CS, state, fluxes) + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(ice_shelf_CS), pointer :: CS !< This module's control structure. + type(surface), intent(inout) :: state!< Surface ocean state + type(forcing), intent(inout) :: fluxes !< A structure of surface fluxes that may be used/updated. ! local variables real :: Irho0 !< The inverse of the mean density in m3 kg-1. @@ -847,7 +850,6 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) ISS => CS%ISS find_shelf_area = (CS%active_shelf_dynamics .or. CS%override_shelf_movement) - call add_shelf_forces(G, CS, forces, do_shelf_area=find_shelf_area) ! Determine ustar and the square magnitude of the velocity in the ! bottom boundary layer. Together these give the TKE source and @@ -869,10 +871,10 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) ! do j=js,je ; do i=is,ie ; if (fluxes%frac_shelf_h(i,j) > 0.0) then ! ### THIS SHOULD BE AN AREA WEIGHTED AVERAGE OF THE ustar_shelf POINTS. ! taux2 = 0.0 ; tauy2 = 0.0 - ! asu1 = forces%frac_shelf_u(I-1,j) * G%areaCu(I-1,j) - ! asu2 = forces%frac_shelf_u(I,j) * G%areaCu(I,j) - ! asv1 = forces%frac_shelf_v(i,J-1) * G%areaCv(i,J-1) - ! asv2 = forces%frac_shelf_v(i,J) * G%areaCv(i,J) + ! asu1 = (ISS%area_shelf_h(i-1,j) + ISS%area_shelf_h(i,j)) + ! asu2 = (ISS%area_shelf_h(i,j) + ISS%area_shelf_h(i+1,j)) + ! asv1 = (ISS%area_shelf_h(i,j-1) + ISS%area_shelf_h(i,j)) + ! asv2 = (ISS%area_shelf_h(i,j) + ISS%area_shelf_h(i,j+1)) ! if ((asu1 + asu2 > 0.0) .and. associated(state%taux_shelf)) & ! taux2 = (asu1 * state%taux_shelf(I-1,j)**2 + & ! asu2 * state%taux_shelf(I,j)**2 ) / (asu1 + asu2) @@ -883,7 +885,7 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) !fluxes%ustar(i,j) = MAX(CS%ustar_bg, sqrt(Irho0 * sqrt(taux2 + tauy2))) ! endif ; enddo ; enddo - if (find_shelf_area) then + if (CS%active_shelf_dynamics .or. CS%override_shelf_movement) then do j=jsd,jed ; do i=isd,ied if (G%areaT(i,j) > 0.0) & fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) * G%IareaT(i,j) @@ -927,7 +929,7 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) if (.not. associated(fluxes%salt_flux)) allocate(fluxes%salt_flux(ie,je)) if (.not. associated(fluxes%vprec)) allocate(fluxes%vprec(ie,je)) - fluxes%salt_flux(:,:) = 0.0; fluxes%vprec(:,:) = 0.0 + fluxes%salt_flux(:,:) = 0.0 ; fluxes%vprec(:,:) = 0.0 mean_melt_flux = 0.0; sponge_area = 0.0 do j=js,je ; do i=is,ie @@ -1005,18 +1007,16 @@ subroutine add_shelf_flux(G, CS, state, forces, fluxes) endif !constant_sea_level - call copy_common_forcing_fields(forces, fluxes, G) - end subroutine add_shelf_flux !> Initializes shelf model data, parameters and diagnostics subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fluxes, Time_in, solo_ice_sheet_in) - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(ocean_grid_type), pointer :: ocn_grid !< The calling ocean model's horizontal grid structure - type(time_type), intent(inout) :: Time !< The clock that that will indicate the model time - type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate the diagnostic output. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(ocean_grid_type), pointer :: ocn_grid !< The calling ocean model's horizontal grid structure + type(time_type), intent(inout) :: Time !< The clock that that will indicate the model time + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate the diagnostic output. type(forcing), optional, intent(inout) :: fluxes !< A structure containing pointers to any possible !! thermodynamic or mass-flux forcing fields. type(mech_forcing), optional, intent(inout) :: forces !< A structure with the driving mechanical forces @@ -1027,7 +1027,6 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl type(ocean_grid_type), pointer :: G => NULL(), OG => NULL() ! Pointers to grids for convenience. type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe !! the ice-shelf state -! type(ice_shelf_dyn_CS), pointer :: dCS => NULL() type(directories) :: dirs type(dyn_horgrid_type), pointer :: dG => NULL() real :: cdrag, drag_bg_vel @@ -1037,7 +1036,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl character(len=200) :: config character(len=200) :: IC_file,filename,inputdir character(len=40) :: mdl = "MOM_ice_shelf" ! This module's name. - integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, Isdq, Iedq, Jsdq, Jedq, iters + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, Isdq, Iedq, Jsdq, Jedq integer :: wd_halos(2) logical :: read_TideAmp, shelf_mass_is_dynamic, debug character(len=240) :: Tideamp_file @@ -1413,16 +1412,10 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! else ! Previous block for new_sim=.T., this block restores the state. elseif (.not.new_sim) then - ! This line calls a subroutine that reads the initial conditions - ! from a restart file. + ! This line calls a subroutine that reads the initial conditions from a restart file. call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: Restoring ice shelf from file.") call restore_state(dirs%input_filename, dirs%restart_input_dir, Time, & G, CS%restart_CSp) - - ! i think this call isnt necessary - all it does is set hmask to 3 at - ! the dirichlet boundary, and now this is done elsewhere - ! call initialize_shelf_mass(G, param_file, CS, ISS, .false.) - endif ! .not. new_sim CS%Time = Time @@ -1673,7 +1666,7 @@ subroutine ice_shelf_end(CS) end subroutine ice_shelf_end - +!> This routine is for stepping a stand-alone ice shelf model without an ocean. subroutine solo_time_step(CS, time_step, nsteps, Time, min_time_step_in) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure real, intent(in) :: time_step !< The time interval for this update, in s. @@ -1684,20 +1677,16 @@ subroutine solo_time_step(CS, time_step, nsteps, Time, min_time_step_in) type(ocean_grid_type), pointer :: G => NULL() type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe !! the ice-shelf state - type(ice_shelf_dyn_CS), pointer :: dCS => NULL() - integer :: is, iec, js, jec, i, j, ki, kj, iters - real :: ratio, min_ratio, time_step_remain, local_u_max - real :: local_v_max, time_step_int, min_time_step, spy, dumtimeprint + integer :: is, iec, js, jec, i, j + real :: time_step_remain + real :: time_step_int, min_time_step character(len=240) :: mesg logical :: update_ice_vel ! If true, it is time to update the ice shelf velocities. logical :: coupled_GL ! If true the grouding line position is determined based on ! coupled ice-ocean dynamics. - logical :: flag - spy = 365 * 86400 G => CS%grid ISS => CS%ISS - dCS => CS%dCS is = G%isc ; iec = G%iec ; js = G%jsc ; jec = G%jec time_step_remain = time_step @@ -1707,16 +1696,14 @@ subroutine solo_time_step(CS, time_step, nsteps, Time, min_time_step_in) min_time_step = 1000.0 ! This is in seconds - at 1 km resolution it would imply ice is moving at ~1 meter per second endif - ! NOTE: this relies on NE grid indexing - ! dumtimeprint=time_type_to_real(Time)/spy - write (mesg,*) "TIME in ice shelf call, yrs: ", time_type_to_real(Time)/spy + write (mesg,*) "TIME in ice shelf call, yrs: ", time_type_to_real(Time)/(365. * 86400.) call MOM_mesg("solo_time_step: "//mesg) do while (time_step_remain > 0.0) nsteps = nsteps+1 ! If time_step is not too long, this is unnecessary. - time_step_int = min(ice_time_step_CFL(dCS, ISS, G), time_step) + time_step_int = min(ice_time_step_CFL(CS%dCS, ISS, G), time_step) write (mesg,*) "Ice model timestep = ", time_step_int, " seconds" if (time_step_int < min_time_step) then @@ -1737,19 +1724,18 @@ subroutine solo_time_step(CS, time_step, nsteps, Time, min_time_step_in) update_ice_vel = ((time_step_int > min_time_step) .or. (time_step_int >= time_step)) coupled_GL = .false. - call update_ice_shelf(dCS, ISS, G, time_step_int, Time, must_update_vel=update_ice_vel) + call update_ice_shelf(CS%dCS, ISS, G, time_step_int, Time, must_update_vel=update_ice_vel) call enable_averaging(time_step,Time,CS%diag) if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, ISS%area_shelf_h, CS%diag) - if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf,ISS%h_shelf,CS%diag) - if (CS%id_h_mask > 0) call post_data(CS%id_h_mask,ISS%hmask,CS%diag) + if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf, ISS%h_shelf, CS%diag) + if (CS%id_h_mask > 0) call post_data(CS%id_h_mask, ISS%hmask, CS%diag) call disable_averaging(CS%diag) enddo end subroutine solo_time_step - !> \namespace mom_ice_shelf !! !! \section section_ICE_SHELF From f482863b3e3002b7d1e7ba67a9838813c8d58776 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 28 May 2018 16:52:04 -0600 Subject: [PATCH 0303/1072] more changes to bring in nuopc and mct caps closer together --- config_src/mct_driver/MOM_ocean_model.F90 | 55 ++++++----- config_src/mct_driver/MOM_surface_forcing.F90 | 92 ++++++++++-------- config_src/mct_driver/ocn_cap_methods.F90 | 95 +++++++++++++++++++ config_src/mct_driver/ocn_comp_mct.F90 | 94 +++++++++--------- config_src/mct_driver/ocn_cpl_indices.F90 | 10 +- 5 files changed, 235 insertions(+), 111 deletions(-) create mode 100644 config_src/mct_driver/ocn_cap_methods.F90 diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index dc17b722ed..b642cbb91e 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -43,7 +43,7 @@ module MOM_ocean_model 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_x2o_to_fluxes_and_forces, ice_ocn_bnd_type_chksum +use MOM_surface_forcing, only : convert_IOB_to_fluxes_and_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(>) @@ -393,21 +393,30 @@ end subroutine ocean_model_init !! 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(OS, Ocean_sfc, time_start_update, & - Ocean_coupling_time_step, x2o_o, ind, sw_decomp, & - c1, c2, c3, c4) - - type(ocean_state_type), pointer :: OS !< Structure containing the internal ocean state - type(ocean_public_type), intent(inout) :: Ocean_sfc !< Structure containing all the publicly - !! visible ocean surface fields after a coupling time step - type(time_type), intent(in) :: time_start_update !< Time at the beginning of the update step - type(time_type), intent(in) :: Ocean_coupling_time_step !< Amount of time over which to - !! advance the ocean - real(kind=8), intent(in) :: x2o_o(:,:) !< Fluxes from coupler to ocean, computed by ocean - type(cpl_indices_type), intent(inout) :: ind !< Structure with MCT attribute vectors and indices - logical, intent(in) :: sw_decomp !< controls if shortwave is - !!decomposed into four components - real(kind=8), optional, intent(in) :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition +subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & + time_start_update, Ocean_coupling_time_step, & + x2o_o, ind) + + 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. + + real(kind=8), intent(in) :: x2o_o(:,:) !< Fluxes from coupler to ocean, computed by ocean + type(cpl_indices_type), intent(inout) :: ind !< Structure with MCT attribute vectors and indices ! local variables type(time_type) :: Master_time !< This allows step_MOM to temporarily change @@ -419,7 +428,7 @@ subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, & integer :: secs, days integer :: is, ie, js, je - call callTree_enter("update_ocean_model(), ocn_comp_mct.F90") + 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) @@ -449,9 +458,9 @@ subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, & 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_x2o_to_fluxes_and_forces(OS%forces, OS%fluxes, OS%Time, OS%grid, OS%forcing_CSp, & - OS%sfc_state, x2o_o, ind, sw_decomp, c1, c2, c3, c4, & - OS%restore_salinity, OS%restore_temp) + call convert_IOB_to_fluxes_and_forces(Ice_ocean_boundary, OS%fluxes, OS%Time, OS%grid, OS%forcing_CSp, & + OS%sfc_state, OS%restore_salinity, OS%restore_temp, & + forces=OS%forces, x2o=x2o_o, ind=ind) ! 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) @@ -481,9 +490,9 @@ subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, & 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_x2o_to_fluxes_and_forces(OS%forces, OS%flux_tmp, OS%Time, OS%grid, OS%forcing_CSp, & - OS%sfc_state, x2o_o, ind, sw_decomp, c1, c2, c3, c4, & - OS%restore_salinity, OS%restore_temp) + call convert_IOB_to_fluxes_and_forces(Ice_ocean_boundary, OS%fluxes, OS%Time, OS%grid, OS%forcing_CSp, & + OS%sfc_state, OS%restore_salinity, OS%restore_temp, & + forces=OS%forces, x2o=x2o_o, ind=ind) if (OS%use_ice_shelf) then call shelf_calc_flux(OS%sfc_state, OS%forces, OS%flux_tmp, OS%Time, time_step, OS%Ice_shelf_CSp) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 9a182d547c..d34006efaa 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -50,7 +50,7 @@ module MOM_surface_forcing #include public IOB_allocate -public convert_x2o_to_fluxes_and_forces +public convert_IOB_to_fluxes_and_forces public surface_forcing_init public ice_ocn_bnd_type_chksum public forcing_save_restart @@ -70,8 +70,8 @@ module MOM_surface_forcing 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 :: 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 @@ -153,6 +153,7 @@ module MOM_surface_forcing 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(:,:) :: latent_flux =>NULL() !< latent 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(:,:) :: lw_flux =>NULL() !< long wave radiation (W/m2) @@ -198,21 +199,31 @@ 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_x2o_to_fluxes_and_forces(forces, fluxes, Time, G, CS, sfc_state, x2o, ind, sw_decomp, & - c1, c2, c3, c4, restore_salt, restore_temp) + subroutine convert_IOB_to_fluxes_and_forces(IOB, fluxes, Time, G, CS, & + sfc_state, restore_salt, restore_temp, & + forces, x2o, ind) + + type(ice_ocean_boundary_type), & + 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. + !! Unused fields have NULL ptrs. + + 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 + type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a + !! previous call to surface_forcing_init. + type(surface), intent(in) :: sfc_state !< A structure containing fields that describe the + !! surface state of the ocean. + 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. type(mech_forcing), intent(inout) :: forces !< Driving mechanical forces - type(forcing), intent(inout) :: fluxes !< Surface fluxes - type(time_type), intent(in) :: Time !< Model time - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid - type(surface_forcing_CS), pointer :: CS !< control structure returned by a previous call to surface_forcing_init - type(surface), intent(in) :: sfc_state !< control structure to ocean surface state fields. real(kind=8), intent(in) :: x2o(:,:) !< Fluxes from coupler to ocean, computed by ocean type(cpl_indices_type), intent(inout) :: ind !< Structure with MCT attribute vectors and indices - logical, intent(in) :: sw_decomp !< controls if shortwave is decomposed into four components - real(kind=8), optional, intent(in) :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition - logical, optional, intent(in) :: restore_salt !< Controls if salt is restored - logical, optional, intent(in) :: restore_temp !< Controls if temp is restored ! local variables real, dimension(SZIB_(G),SZJB_(G)) :: & @@ -258,6 +269,8 @@ subroutine convert_x2o_to_fluxes_and_forces(forces, fluxes, Time, G, CS, sfc_sta real :: C_p ! heat capacity of seawater ( J/(K kg) ) + real :: sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif + call cpu_clock_begin(id_clock_forcing) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -426,6 +439,9 @@ subroutine convert_x2o_to_fluxes_and_forces(forces, fluxes, Time, G, CS, sfc_sta taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 endif + !i0 = is - isc_bnd ; j0 = js - jsc_bnd ??? + i0 = 0; j0 = 0 ! TODO: is this right? + k = 0 do j=js,je ; do i=is,ie k = k + 1 ! Increment position within gindex @@ -448,11 +464,11 @@ subroutine convert_x2o_to_fluxes_and_forces(forces, fluxes, Time, G, CS, sfc_sta ! liquid precipitation (rain) if (associated(fluxes%lprec)) & - fluxes%lprec(i,j) = x2o(ind%x2o_Faxa_rain,k) * G%mask2dT(i,j) + fluxes%lprec(i,j) = G%mask2dT(i,j) * IOB%lprec(i-i0,j-j0) ! frozen precipitation (snow) if (associated(fluxes%fprec)) & - fluxes%fprec(i,j) = x2o(ind%x2o_Faxa_snow,k) * G%mask2dT(i,j) + fluxes%fprec(i,j) = G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0) ! evaporation if (associated(fluxes%evap)) & @@ -488,37 +504,27 @@ subroutine convert_x2o_to_fluxes_and_forces(forces, fluxes, Time, G, CS, sfc_sta ! longwave radiation, sum up and down (W/m2) if (associated(fluxes%LW)) & - fluxes%LW(i,j) = (x2o(ind%x2o_Faxa_lwdn,k) + x2o(ind%x2o_Foxx_lwup,k)) * G%mask2dT(i,j) + fluxes%LW(i,j) = G%mask2dT(i,j) * IOB%lw_flux(i-i0,j-j0) ! sensible heat flux (W/m2) if (associated(fluxes%sens)) & - fluxes%sens(i,j) = x2o(ind%x2o_Foxx_sen,k) * G%mask2dT(i,j) + fluxes%sens(i,j) = G%mask2dT(i,j) * IOB%t_flux(i-i0,j-j0) ! latent heat flux (W/m^2) if (associated(fluxes%latent)) & - fluxes%latent(i,j) = x2o(ind%x2o_Foxx_lat,k) * G%mask2dT(i,j) - - if (sw_decomp) then - ! Use runtime coefficients to decompose net short-wave heat flux into 4 components - ! 1) visible, direct shortwave (W/m2) - if (associated(fluxes%sw_vis_dir)) & - fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * x2o(ind%x2o_Foxx_swnet,k)*c1 - ! 2) visible, diffuse shortwave (W/m2) - if (associated(fluxes%sw_vis_dif)) & - fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * x2o(ind%x2o_Foxx_swnet,k)*c2 - ! 3) near-IR, direct shortwave (W/m2) - if (associated(fluxes%sw_nir_dir)) & - fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * x2o(ind%x2o_Foxx_swnet,k)*c3 - ! 4) near-IR, diffuse shortwave (W/m2) - if (associated(fluxes%sw_nir_dif)) & - fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * x2o(ind%x2o_Foxx_swnet,k)*c4 - - 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) - else - call MOM_error(FATAL,"fill_ice_ocean_bnd: this option has not been implemented yet."// & - "Shortwave must be decomposed using coeffs. c1, c2, c3, c4."); - endif + fluxes%latent(i,j) = G%mask2dT(i,j) * IOB%latent_flux(i-i0,j-j0) + + 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) ! applied surface pressure from atmosphere and cryosphere ! sea-level pressure (Pa) @@ -713,7 +719,7 @@ subroutine convert_x2o_to_fluxes_and_forces(forces, fluxes, Time, G, CS, sfc_sta call cpu_clock_end(id_clock_forcing) - end subroutine convert_x2o_to_fluxes_and_forces + end subroutine convert_IOB_to_fluxes_and_forces !======================================================================= @@ -1003,6 +1009,7 @@ subroutine IOB_allocate(IOB, isc, iec, jsc, jec) allocate ( IOB% u_flux (isc:iec,jsc:jec), & IOB% v_flux (isc:iec,jsc:jec), & IOB% t_flux (isc:iec,jsc:jec), & + IOB% latent_flux (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), & @@ -1025,6 +1032,7 @@ subroutine IOB_allocate(IOB, isc, iec, jsc, jec) IOB%u_flux = 0.0 IOB%v_flux = 0.0 IOB%t_flux = 0.0 + IOB%latent_flux = 0.0 IOB%q_flux = 0.0 IOB%salt_flux = 0.0 IOB%lw_flux = 0.0 diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 new file mode 100644 index 0000000000..5f646d9049 --- /dev/null +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -0,0 +1,95 @@ +module ocn_cap_methods + + use MOM_ocean_model, only: ocean_public_type, ocean_state_type + use MOM_surface_forcing, only: ice_ocean_boundary_type + use MOM_grid, only: ocean_grid_type + use MOM_domains, only: pass_var + use mpp_domains_mod, only: mpp_get_compute_domain + use ocn_cpl_indices, only: cpl_indices_type + + implicit none + private + + public :: ocn_import + public :: ocn_export + +!======================================================================= +contains +!======================================================================= + + subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, c1, c2, c3, c4) + real(kind=8) , intent(in) :: x2o(:,:) !< incoming data + type(cpl_indices_type) , intent(in) :: ind !< Structure with MCT attribute vectors and indices + type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid + type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing + real(kind=8), optional , intent(in) :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition + + ! Local variables + integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices + integer :: k !< temporary + !----------------------------------------------------------------------- + + isc = GRID%isc; iec = GRID%iec ; jsc = GRID%jsc; jec = GRID%jec + + k = 0 + do j = jsc, jec + jg = j + grid%jsc - jsc + do i = isc, iec + ig = i + grid%jsc - isc + k = k + 1 ! Increment position within gindex + + ! liquid precipitation (rain) + ice_ocean_boundary%lprec(i,j) = x2o(ind%x2o_Faxa_rain,k) * GRID%mask2dT(ig,jg) + + ! frozen precipitation (snow) + ice_ocean_boundary%fprec(i,j) = x2o(ind%x2o_Faxa_snow,k) * GRID%mask2dT(ig,jg) + + ! longwave radiation, sum up and down (W/m2) + ice_ocean_boundary%lw_flux(i,j) = (x2o(ind%x2o_Faxa_lwdn,k) + x2o(ind%x2o_Foxx_lwup,k)) * GRID%mask2dT(i,j) + + ! sensible heat flux (W/m2) + ice_ocean_boundary%t_flux(i,j) = x2o(ind%x2o_Foxx_sen,k) * GRID%mask2dT(i,j) + + ! latent heat flux (W/m^2) + ice_ocean_boundary%latent_flux(i,j) = x2o(ind%x2o_Foxx_lat,k) * GRID%mask2dT(i,j) + + ! 1) visible, direct shortwave (W/m2) + ! 2) visible, diffuse shortwave (W/m2) + ! 3) near-IR, direct shortwave (W/m2) + ! 4) near-IR, diffuse shortwave (W/m2) + if (present(c1) .and. present(c2) .and. present(c3) .and. present(c4)) then + ! Use runtime coefficients to decompose net short-wave heat flux into 4 components + ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c1 * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c2 * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c3 * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c4 * GRID%mask2dT(ig,jg) + else + ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Faxa_swvdr,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Faxa_swvdf,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Faxa_swndr,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Faxa_swndf,k) * GRID%mask2dT(ig,jg) + end if + end do + end do + + end subroutine ocn_import + +!======================================================================= + + !> Maps outgoing ocean data to MCT attribute vector real array + subroutine ocn_export(ocean_public, grid, o2x, rc) + type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state + type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid + real(kind=8) , intent(out) :: o2x(:,:) !< outgoing data + integer , intent(inout) :: rc + + ! Local variables + real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo + integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices + integer :: lbnd1, lbnd2, ubnd1, ubnd2 + real :: slp_L, slp_R, slp_C, slope, u_min, u_max + !----------------------------------------------------------------------- + ! Nothing for now + end subroutine ocn_export + +end module ocn_cap_methods diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index bdb5d2c0e5..0e84cc5494 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -25,6 +25,8 @@ 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,6 +51,7 @@ module ocn_comp_mct use MOM_ocean_model, only: ocean_model_init , update_ocean_model, ocean_model_end use MOM_ocean_model, only: ocn_export use MOM_surface_forcing, only: surface_forcing_CS +use ocn_cap_methods, only: ocn_import ! FMS modules use time_interp_external_mod, only : time_interp_external @@ -72,7 +75,6 @@ module ocn_comp_mct public :: ocn_final_mct ! Private member functions -private :: get_state_pointers private :: ocn_SetGSMap_mct private :: ocn_domain_mct private :: get_runtype @@ -97,7 +99,8 @@ module ocn_comp_mct !! and filename of the latest restart file. end type MCT_MOM_Data -type(MCT_MOM_Data) :: glb !< global structure +type(MCT_MOM_Data) :: glb !< global structure +type(ice_ocean_boundary_type) :: ice_ocean_boundary !======================================================================= contains @@ -236,6 +239,7 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) allocate(glb%ocn_public) glb%ocn_public%is_ocean_PE = .true. + allocate(glb%ocn_public%pelist(npes)) glb%ocn_public%pelist(:) = (/(i,i=pe0,pe0+npes)/) ! \todo Set other bits of glb$ocn_public @@ -244,9 +248,11 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) ! read useful runtime params call get_MOM_Input(param_file, dirs_tmp, check_params=.false.) !call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "POINTER_FILENAME", glb%pointer_filename, & "Name of the ascii file that contains the path and filename of" // & " the latest restart file.", default='rpointer.ocn') + call get_param(param_file, mdl, "SW_DECOMP", glb%sw_decomp, & "If True, read coeffs c1, c2, c3 and c4 and decompose" // & "the net shortwave radiation (SW) into four components:\n" // & @@ -254,6 +260,7 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) "visible, diffuse shortwave = c2 * SW \n" // & "near-IR, direct shortwave = c3 * SW \n" // & "near-IR, diffuse shortwave = c4 * SW", default=.true.) + if (glb%sw_decomp) then call get_param(param_file, mdl, "SW_c1", glb%c1, & "Coeff. used to convert net shortwave rad. into \n"//& @@ -266,6 +273,7 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) call get_param(param_file, mdl, "SW_c3", glb%c3, & "Coeff. used to convert net shortwave rad. into \n"//& "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"//& "near-IR, diffuse shortwave.", units="nondim", default=0.215) @@ -276,27 +284,24 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) ! Initialize the MOM6 model runtype = get_runtype() if (runtype == "initial") then - ! startup (new run) - 'n' is needed below since we don't specify input_filename in input.nml - call ocean_model_init(glb%ocn_public, glb%ocn_state, time0, time0, input_restart_file = 'n') - - else ! hybrid or branch or continuos runs - - ! output path root - call seq_infodata_GetData( glb%infodata, outPathRoot=restartpath ) - ! read name of restart file in the pointer file - nu = shr_file_getUnit() - restart_pointer_file = trim(glb%pointer_filename) - if (is_root_pe()) write(glb%stdout,*) 'Reading ocn pointer file: ',restart_pointer_file - open(nu, file=restart_pointer_file, form='formatted', status='unknown') - read(nu,'(a)') restartfile - close(nu) - !restartfile = trim(restartpath) // trim(restartfile) - if (is_root_pe()) write(glb%stdout,*) 'Reading restart file: ',trim(restartfile) - !endif - call shr_file_freeUnit(nu) - call ocean_model_init(glb%ocn_public, glb%ocn_state, time0, time0, input_restart_file=trim(restartfile)) - + call ocean_model_init(glb%ocn_public, glb%ocn_state, time0, time0, input_restart_file = 'n') + else ! hybrid or branch or continuos runs + ! get output path root + call seq_infodata_GetData( glb%infodata, outPathRoot=restartpath ) + ! read name of restart file in the pointer file + nu = shr_file_getUnit() + restart_pointer_file = trim(glb%pointer_filename) + if (is_root_pe()) write(glb%stdout,*) 'Reading ocn pointer file: ',restart_pointer_file + open(nu, file=restart_pointer_file, form='formatted', status='unknown') + read(nu,'(a)') restartfile + close(nu) + !restartfile = trim(restartpath) // trim(restartfile) + if (is_root_pe()) then + write(glb%stdout,*) 'Reading restart file: ',trim(restartfile) + end if + call shr_file_freeUnit(nu) + call ocean_model_init(glb%ocn_public, glb%ocn_state, time0, time0, input_restart_file=trim(restartfile)) endif if (is_root_pe()) then write(glb%stdout,'(/12x,a/)') '======== COMPLETED MOM INITIALIZATION ========' @@ -305,8 +310,11 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) ! Initialize ocn_state%sfc_state out of sight call ocean_model_init_sfc(glb%ocn_state, glb%ocn_public) - ! store pointers to components inside MOM - call get_state_pointers(glb%ocn_state, grid=glb%grid) + ! Store pointers to components inside MOM + glb%grid => glb%ocn_state%grid + + ! Allocate IOB data type (needs to be called after glb%grid is set) + call IOB_allocate(ice_ocean_boundary, glb%grid%isc, glb%grid%iec, glb%grid%jsc, glb%grid%jec) call t_stopf('MOM_init') @@ -373,8 +381,6 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) call t_stopf('MOM_mct_init') - if (debug .and. root_pe().eq.pe_here()) print *, "calling get_state_pointers" - ! Size of global domain call get_global_grid_size(glb%grid, ni, nj) @@ -397,17 +403,6 @@ end subroutine ocn_init_mct !======================================================================= -!> Returns pointers to objects within ocean_state_type -subroutine get_state_pointers(OS, grid) - type(ocean_state_type), pointer :: OS !< Ocean state type - type(ocean_grid_type), optional, pointer :: grid !< Ocean grid - - if (present(grid)) grid => OS%grid - -end subroutine get_state_pointers - -!======================================================================= - !> Step forward ocean model for coupling interval subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o) type(ESMF_Clock), intent(inout) :: EClock !< Time and time step ? \todo Why must this be intent(inout)? @@ -496,9 +491,17 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o) ! GMM, check if this is needed! call seq_cdata_setptrs(cdata_o, infodata=glb%infodata) - ! Note that update_ocean_model calls ocn_import - call update_ocean_model(glb%ocn_state, glb%ocn_public, time_start, coupling_timestep, & - x2o_o%rattr, glb%ind, glb%sw_decomp, glb%c1, glb%c2, glb%c3, glb%c4) + ! Translate import fields to ice_ocean_boundary + if (glb%sw_decomp) then + write(6,*)'DEBUG: using sw_decomp' + call ocn_import(x2o_o%rattr, glb%ind, glb%grid, Ice_ocean_boundary, c1=glb%c1, c2=glb%c2, c3=glb%c3, c4=glb%c4) + else + call ocn_import(x2o_o%rattr, glb%ind, glb%grid, Ice_ocean_boundary) + end if + + ! Update internal ocean + call update_ocean_model(ice_ocean_boundary, glb%ocn_state, glb%ocn_public, time_start, coupling_timestep, & + x2o_o%rattr, glb%ind) ! return export state to driver call ocn_export(glb%ind, glb%ocn_public, glb%grid, o2x_o%rattr) @@ -575,17 +578,18 @@ subroutine ocn_SetGSMap_mct(mpicom_ocn, MOM_MCT_ID, gsMap_ocn, gsMap3d_ocn) integer, intent(in) :: MOM_MCT_ID !< MCT component ID type(mct_gsMap), intent(inout) :: gsMap_ocn !< MCT global segment map for 2d data type(mct_gsMap), intent(inout) :: gsMap3d_ocn !< MCT global segment map for 3d data + ! Local variables - integer :: lsize !< Local size of indirect indexing array - integer :: i, j, k !< Local indices - integer :: ni, nj !< Declared sizes of h-point arrays - integer :: ig, jg !< Global indices + integer :: lsize !< Local size of indirect indexing array + integer :: i, j, k !< Local indices + integer :: ni, nj !< Declared sizes of h-point arrays + integer :: ig, jg !< Global indices type(ocean_grid_type), pointer :: grid => NULL() !< A pointer to a grid structure integer, allocatable :: gindex(:) !< Indirect indices grid => glb%grid ! for convenience if (.not. associated(grid)) call MOM_error(FATAL, 'ocn_comp_mct.F90, ocn_SetGSMap_mct():' // & - 'grid returned from get_state_pointers() was not associated!') + 'grid is not associated!') ! Size of computational domain lsize = ( grid%iec - grid%isc + 1 ) * ( grid%jec - grid%jsc + 1 ) diff --git a/config_src/mct_driver/ocn_cpl_indices.F90 b/config_src/mct_driver/ocn_cpl_indices.F90 index 1f5c70a59b..1c3d733812 100644 --- a/config_src/mct_driver/ocn_cpl_indices.F90 +++ b/config_src/mct_driver/ocn_cpl_indices.F90 @@ -36,6 +36,10 @@ module ocn_cpl_indices integer :: x2o_Foxx_lat !< Latent heat flux (W/m2) integer :: x2o_Foxx_lwup !< Longwave radiation, up (W/m2) integer :: x2o_Faxa_lwdn !< Longwave radiation, down (W/m2) + integer :: x2o_Faxa_swvdr !< Visible, direct shortwave (W/m2) + integer :: x2o_Faxa_swvdf !< Visible, diffuse shortwave (W/m2) + integer :: x2o_Faxa_swndr !< near-IR, direct shortwave (W/m2) + integer :: x2o_Faxa_swndf !< near-IR, direct shortwave (W/m2) integer :: x2o_Fioi_melth !< Heat flux from snow & ice melt (W/m2) integer :: x2o_Fioi_meltw !< Snow melt flux (kg/m2/s) integer :: x2o_Fioi_bcpho !< Black Carbon hydrophobic release from sea ice component @@ -118,6 +122,10 @@ subroutine cpl_indices_init(ind) ind%x2o_Foxx_sen = mct_avect_indexra(x2o,'Foxx_sen') ind%x2o_Foxx_lwup = mct_avect_indexra(x2o,'Foxx_lwup') ind%x2o_Faxa_lwdn = mct_avect_indexra(x2o,'Faxa_lwdn') + ind%x2o_Faxa_swvdr = mct_avect_indexra(x2o,'Faxa_swvdr',perrWith='quiet') + ind%x2o_Faxa_swvdf = mct_avect_indexra(x2o,'Faxa_swvdf',perrWith='quiet') + ind%x2o_Faxa_swndr = mct_avect_indexra(x2o,'Faxa_swndr',perrWith='quiet') + ind%x2o_Faxa_swndf = mct_avect_indexra(x2o,'Faxa_swndf',perrWith='quiet') ind%x2o_Fioi_melth = mct_avect_indexra(x2o,'Fioi_melth') ind%x2o_Fioi_meltw = mct_avect_indexra(x2o,'Fioi_meltw') ind%x2o_Fioi_salt = mct_avect_indexra(x2o,'Fioi_salt') @@ -146,8 +154,8 @@ subroutine cpl_indices_init(ind) ind%x2o_Faxa_dstwet4 = mct_avect_indexra(x2o,'Faxa_dstwet4') ind%x2o_Sa_co2prog = mct_avect_indexra(x2o,'Sa_co2prog',perrWith='quiet') ind%x2o_Sa_co2diag = mct_avect_indexra(x2o,'Sa_co2diag',perrWith='quiet') - ! optional per thickness category fields + ! optional per thickness category fields ! convert cpl indices to mcog column indices ! this implementation only handles columns due to ice thickness categories lmcog_flds_sent = seq_flds_i2o_per_cat From 97229348042d520f76b999fb79e0fc5da36fa59e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 28 May 2018 17:51:56 -0600 Subject: [PATCH 0304/1072] more updates to get nuopc and mct closer --- config_src/mct_driver/MOM_ocean_model.F90 | 121 +----------------- config_src/mct_driver/MOM_surface_forcing.F90 | 51 ++++---- config_src/mct_driver/ocn_cap_methods.F90 | 119 +++++++++++++++-- config_src/mct_driver/ocn_comp_mct.F90 | 10 +- 4 files changed, 142 insertions(+), 159 deletions(-) diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index b642cbb91e..a62a5f8e24 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -94,11 +94,9 @@ module MOM_ocean_model public ocean_model_save_restart, Ocean_stock_pe public ocean_model_init_sfc, ocean_model_flux_init public ocean_model_restart -public ice_ocean_boundary_type -public ice_ocn_bnd_type_chksum public ocean_public_type_chksum public ocean_model_data_get -public ocn_export +public ice_ocn_bnd_type_chksum interface ocean_model_data_get module procedure ocean_model_data1D_get @@ -394,8 +392,7 @@ end subroutine ocean_model_init !! 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, & - x2o_o, ind) + time_start_update, Ocean_coupling_time_step) type(ice_ocean_boundary_type), & intent(in) :: Ice_ocean_boundary !< A structure containing the @@ -415,9 +412,6 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & type(time_type), intent(in) :: Ocean_coupling_time_step !< The amount of time over !! which to advance the ocean. - real(kind=8), intent(in) :: x2o_o(:,:) !< Fluxes from coupler to ocean, computed by ocean - type(cpl_indices_type), intent(inout) :: ind !< Structure with MCT attribute vectors and indices - ! local variables type(time_type) :: Master_time !< This allows step_MOM to temporarily change !! the time that is seen by internal modules. @@ -459,8 +453,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! Import fluxes from coupler to ocean. Also, perform do SST and SSS restoring, if needed. call convert_IOB_to_fluxes_and_forces(Ice_ocean_boundary, OS%fluxes, OS%Time, OS%grid, OS%forcing_CSp, & - OS%sfc_state, OS%restore_salinity, OS%restore_temp, & - forces=OS%forces, x2o=x2o_o, ind=ind) + OS%sfc_state, OS%restore_salinity, OS%restore_temp, forces=OS%forces) ! 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) @@ -491,8 +484,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! Import fluxes from coupler to ocean. Also, perform do SST and SSS restoring, if needed. call convert_IOB_to_fluxes_and_forces(Ice_ocean_boundary, OS%fluxes, OS%Time, OS%grid, OS%forcing_CSp, & - OS%sfc_state, OS%restore_salinity, OS%restore_temp, & - forces=OS%forces, x2o=x2o_o, ind=ind) + OS%sfc_state, OS%restore_salinity, OS%restore_temp, forces=OS%forces) if (OS%use_ice_shelf) then call shelf_calc_flux(OS%sfc_state, OS%forces, OS%flux_tmp, OS%Time, time_step, OS%Ice_shelf_CSp) @@ -1037,109 +1029,4 @@ subroutine get_ocean_grid(OS, Gridp) end subroutine get_ocean_grid ! NAME="get_ocean_grid" -!======================================================================= -! Routines that are specific to MCT driver -!======================================================================= - - -!======================================================================= - - !> Maps outgoing ocean data to MCT buffer. - !! See \ref section_ocn_export for a summary of the data - !! that is transferred from MOM6 to MCT. - subroutine ocn_export(ind, ocn_public, grid, o2x) - type(cpl_indices_type), intent(inout) :: ind !< Structure with coupler indices and vectors - type(ocean_public_type), intent(in) :: ocn_public !< Ocean surface state - type(ocean_grid_type), intent(in) :: grid !< Ocean model grid - real(kind=8), intent(inout) :: o2x(:,:) !< MCT outgoing bugger - - ! Local variables - real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo - integer :: i, j, n, ig, jg !< Grid indices - real :: slp_L, slp_R, slp_C, slope, u_min, u_max - - ! Copy from ocn_public to o2x. ocn_public uses global indexing with no halos. - ! The mask comes from "grid" that uses the usual MOM domain that has halos - ! and does not use global indexing. - n = 0 - do j=grid%jsc, grid%jec - jg = j + grid%jdg_offset - do i=grid%isc,grid%iec - n = n+1 - ig = i + grid%idg_offset - ! surface temperature in Kelvin - o2x(ind%o2x_So_t, n) = ocn_public%t_surf(ig,jg) * grid%mask2dT(i,j) - o2x(ind%o2x_So_s, n) = ocn_public%s_surf(ig,jg) * grid%mask2dT(i,j) - o2x(ind%o2x_So_u, n) = ocn_public%u_surf(ig,jg) * grid%mask2dT(i,j) - o2x(ind%o2x_So_v, n) = ocn_public%v_surf(ig,jg) * grid%mask2dT(i,j) - ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain - ! in order to update halos. i.e. does not use global indexing. - ssh(i,j) = ocn_public%sea_lev(ig,jg) - end do - end do - - ! Update halo of ssh so we can calculate gradients - call pass_var(ssh, grid%domain) - - ! d/dx ssh - n = 0 - do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec - n = n+1 - ! This is a simple second-order difference - !o2x(ind%o2x_So_dhdx, n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) - if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. - slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(I,j) - if (grid%mask2dCu(I+1,j)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - if ( (slp_L * slp_R) > 0.0 ) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - o2x(ind%o2x_So_dhdx, n) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdx, n) = 0.0 - end do; end do - - ! d/dy ssh - n = 0 - do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec - n = n+1 - ! This is a simple second-order difference - ! o2x(ind%o2x_So_dhdy, n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) - if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. - - slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,J) - if (grid%mask2dCv(i,J+1)==0.) slp_R = 0. - - slp_C = 0.5 * (slp_L + slp_R) - !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R - if ((slp_L * slp_R) > 0.0) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - o2x(ind%o2x_So_dhdy, n) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdy, n) = 0.0 - end do; end do - - end subroutine ocn_export - -!======================================================================= - 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 d34006efaa..839c90a497 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -150,10 +150,12 @@ module MOM_surface_forcing ! 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(:,:) :: latent_flux =>NULL() !< latent 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(:,:) :: lw_flux =>NULL() !< long wave radiation (W/m2) @@ -200,8 +202,7 @@ module MOM_surface_forcing !! passed from MCT to MOM6, including fluxes that need to be included in !! the future. subroutine convert_IOB_to_fluxes_and_forces(IOB, fluxes, Time, G, CS, & - sfc_state, restore_salt, restore_temp, & - forces, x2o, ind) + sfc_state, restore_salt, restore_temp, forces) type(ice_ocean_boundary_type), & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive @@ -222,8 +223,6 @@ subroutine convert_IOB_to_fluxes_and_forces(IOB, fluxes, Time, G, CS, & logical, optional, intent(in) :: restore_temp !< If true, temperature is restored to a target value. type(mech_forcing), intent(inout) :: forces !< Driving mechanical forces - real(kind=8), intent(in) :: x2o(:,:) !< Fluxes from coupler to ocean, computed by ocean - type(cpl_indices_type), intent(inout) :: ind !< Structure with MCT attribute vectors and indices ! local variables real, dimension(SZIB_(G),SZJB_(G)) :: & @@ -269,8 +268,6 @@ subroutine convert_IOB_to_fluxes_and_forces(IOB, fluxes, Time, G, CS, & real :: C_p ! heat capacity of seawater ( J/(K kg) ) - real :: sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif - call cpu_clock_begin(id_clock_forcing) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -447,21 +444,17 @@ subroutine convert_IOB_to_fluxes_and_forces(IOB, fluxes, Time, G, CS, & k = k + 1 ! Increment position within gindex if (wind_stagger == BGRID_NE) then - taux_at_q(I,J) = x2o(ind%x2o_Foxx_taux,k) * CS%wind_stress_multiplier - tauy_at_q(I,J) = x2o(ind%x2o_Foxx_tauy,k) * CS%wind_stress_multiplier + taux_at_q(I,J) = IOB%u_flux(i,j) * CS%wind_stress_multiplier + tauy_at_q(I,J) = IOB%v_flux(i,j) * CS%wind_stress_multiplier ! GMM, cime uses AGRID elseif (wind_stagger == AGRID) then - taux_at_h(i,j) = x2o(ind%x2o_Foxx_taux,k) * CS%wind_stress_multiplier - tauy_at_h(i,j) = x2o(ind%x2o_Foxx_tauy,k) * CS%wind_stress_multiplier + taux_at_h(i,j) = IOB%u_flux(i,j) * CS%wind_stress_multiplier + tauy_at_h(i,j) = IOB%v_flux(i,j) * CS%wind_stress_multiplier else ! C-grid wind stresses. - forces%taux(I,j) = x2o(ind%x2o_Foxx_taux,k) * CS%wind_stress_multiplier - forces%tauy(i,J) = x2o(ind%x2o_Foxx_tauy,k) * CS%wind_stress_multiplier + forces%taux(I,j) = IOB%u_flux(i,j) * CS%wind_stress_multiplier + forces%tauy(i,J) = IOB%v_flux(i,j) * CS%wind_stress_multiplier endif - ! NOTE: in convert_IOB_to_fluxes x2o below is replace by - ! IOB%flux_quantity where flux_quantity is what we use to - ! compute fluxes%flux_quantity - ! liquid precipitation (rain) if (associated(fluxes%lprec)) & fluxes%lprec(i,j) = G%mask2dT(i,j) * IOB%lprec(i-i0,j-j0) @@ -472,15 +465,15 @@ subroutine convert_IOB_to_fluxes_and_forces(IOB, fluxes, Time, G, CS, & ! evaporation if (associated(fluxes%evap)) & - fluxes%evap(i,j) = x2o(ind%x2o_Foxx_evap,k) * G%mask2dT(i,j) + fluxes%evap(i,j) = G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0) ! river runoff flux if (associated(fluxes%lrunoff)) & - fluxes%lrunoff(i,j) = x2o(ind%x2o_Foxx_rofl,k) * G%mask2dT(i,j) + fluxes%lrunoff(i,j) = G%mask2dT(i,j) * IOB%rofl_flux(i-i0,j-j0) ! ice runoff flux if (associated(fluxes%frunoff)) & - fluxes%frunoff(i,j) = x2o(ind%x2o_Foxx_rofi,k) * G%mask2dT(i,j) + 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))) & @@ -529,7 +522,8 @@ subroutine convert_IOB_to_fluxes_and_forces(IOB, fluxes, Time, G, CS, & ! applied surface pressure from atmosphere and cryosphere ! sea-level pressure (Pa) if (associated(forces%p_surf_full) .and. associated(forces%p_surf)) then - forces%p_surf_full(i,j) = G%mask2dT(i,j) * x2o(ind%x2o_Sa_pslv,k) + forces%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + if (CS%max_p_surf >= 0.0) then forces%p_surf(i,j) = MIN(forces%p_surf_full(i,j),CS%max_p_surf) else @@ -541,16 +535,15 @@ subroutine convert_IOB_to_fluxes_and_forces(IOB, fluxes, Time, G, CS, & else forces%p_surf_SSH => forces%p_surf_full endif - endif ! salt flux ! more salt restoring logic if (associated(fluxes%salt_flux)) & - fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(x2o(ind%x2o_Fioi_salt,k) + fluxes%salt_flux(i,j)) + fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(IOB%salt_flux(i-i0,j-j0) + fluxes%salt_flux(i,j)) if (associated(fluxes%salt_flux_in)) & - fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*x2o(ind%x2o_Fioi_salt,k) + fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*IOB%salt_flux(i-i0,j-j0) enddo; enddo ! ############################ END OF MCT to MOM ############################## @@ -1006,10 +999,12 @@ 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% u_flux (isc:iec,jsc:jec), & + 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% latent_flux (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), & @@ -1029,10 +1024,12 @@ subroutine IOB_allocate(IOB, 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%latent_flux = 0.0 IOB%q_flux = 0.0 IOB%salt_flux = 0.0 IOB%lw_flux = 0.0 diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 5f646d9049..3e212b1a4e 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -38,6 +38,12 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, c1, c2, c3, c4) ig = i + grid%jsc - isc k = k + 1 ! Increment position within gindex + ! taux + ice_ocean_boundary%u_flux(i,j) = x2o(ind%x2o_Foxx_taux,k) + + ! tauy + ice_ocean_boundary%v_flux(i,j) = x2o(ind%x2o_Foxx_tauy,k) + ! liquid precipitation (rain) ice_ocean_boundary%lprec(i,j) = x2o(ind%x2o_Faxa_rain,k) * GRID%mask2dT(ig,jg) @@ -47,12 +53,27 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, c1, c2, c3, c4) ! longwave radiation, sum up and down (W/m2) ice_ocean_boundary%lw_flux(i,j) = (x2o(ind%x2o_Faxa_lwdn,k) + x2o(ind%x2o_Foxx_lwup,k)) * GRID%mask2dT(i,j) + ! specific humitidy flux + ice_ocean_boundary%q_flux(i,j) = x2o(ind%x2o_Foxx_evap,k) !???TODO: should this be a minus sign + ! sensible heat flux (W/m2) ice_ocean_boundary%t_flux(i,j) = x2o(ind%x2o_Foxx_sen,k) * GRID%mask2dT(i,j) ! latent heat flux (W/m^2) ice_ocean_boundary%latent_flux(i,j) = x2o(ind%x2o_Foxx_lat,k) * GRID%mask2dT(i,j) + ! liquid runoff + ice_ocean_boundary%rofl_flux(i,j) = x2o(ind%x2o_Foxx_rofl,k) * GRID%mask2dT(i,j) + + ! ice runoff + ice_ocean_boundary%rofi_flux(i,j) = x2o(ind%x2o_Foxx_rofi,k) * GRID%mask2dT(i,j) + + ! surface pressure + ice_ocean_boundary%p(i,j) = x2o(ind%x2o_Sa_pslv,k) * GRID%mask2dT(i,j) + + ! salt flux + ice_ocean_boundary%salt_flux(i,j) = x2o(ind%x2o_Fioi_salt,k) + ! 1) visible, direct shortwave (W/m2) ! 2) visible, diffuse shortwave (W/m2) ! 3) near-IR, direct shortwave (W/m2) @@ -77,19 +98,99 @@ end subroutine ocn_import !======================================================================= !> Maps outgoing ocean data to MCT attribute vector real array - subroutine ocn_export(ocean_public, grid, o2x, rc) - type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state - type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid - real(kind=8) , intent(out) :: o2x(:,:) !< outgoing data - integer , intent(inout) :: rc + subroutine ocn_export(ind, ocn_public, grid, o2x) + type(cpl_indices_type), intent(inout) :: ind !< Structure with coupler indices and vectors + type(ocean_public_type), intent(in) :: ocn_public !< Ocean surface state + type(ocean_grid_type), intent(in) :: grid !< Ocean model grid + real(kind=8), intent(inout) :: o2x(:,:) !< MCT outgoing bugger ! Local variables real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo - integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices - integer :: lbnd1, lbnd2, ubnd1, ubnd2 - real :: slp_L, slp_R, slp_C, slope, u_min, u_max + integer :: i, j, n, ig, jg !< Grid indices + real :: slp_L, slp_R, slp_C, slope, u_min, u_max !----------------------------------------------------------------------- - ! Nothing for now + + ! Copy from ocn_public to o2x. ocn_public uses global indexing with no halos. + ! The mask comes from "grid" that uses the usual MOM domain that has halos + ! and does not use global indexing. + + n = 0 + do j=grid%jsc, grid%jec + jg = j + grid%jdg_offset + do i=grid%isc,grid%iec + n = n+1 + ig = i + grid%idg_offset + ! surface temperature in Kelvin + o2x(ind%o2x_So_t, n) = ocn_public%t_surf(ig,jg) * grid%mask2dT(i,j) + o2x(ind%o2x_So_s, n) = ocn_public%s_surf(ig,jg) * grid%mask2dT(i,j) + o2x(ind%o2x_So_u, n) = ocn_public%u_surf(ig,jg) * grid%mask2dT(i,j) + o2x(ind%o2x_So_v, n) = ocn_public%v_surf(ig,jg) * grid%mask2dT(i,j) + ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain + ! in order to update halos. i.e. does not use global indexing. + ssh(i,j) = ocn_public%sea_lev(ig,jg) + end do + end do + + ! Update halo of ssh so we can calculate gradients + call pass_var(ssh, grid%domain) + + ! d/dx ssh + n = 0 + do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec + n = n+1 + ! This is a simple second-order difference + ! o2x(ind%o2x_So_dhdx, n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) + if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(I,j) + if (grid%mask2dCu(I+1,j)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + if ( (slp_L * slp_R) > 0.0 ) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + o2x(ind%o2x_So_dhdx, n) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdx, n) = 0.0 + end do; end do + + ! d/dy ssh + n = 0 + do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec + n = n+1 + ! This is a simple second-order difference + ! o2x(ind%o2x_So_dhdy, n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) + if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. + + slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,J) + if (grid%mask2dCv(i,J+1)==0.) slp_R = 0. + + slp_C = 0.5 * (slp_L + slp_R) + !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R + if ((slp_L * slp_R) > 0.0) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + o2x(ind%o2x_So_dhdy, n) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdy, n) = 0.0 + end do; end do + end subroutine ocn_export end module ocn_cap_methods diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 0e84cc5494..7696f7eae0 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -49,9 +49,8 @@ module ocn_comp_mct ! Previously inlined - now in separate modules 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: ocn_export use MOM_surface_forcing, only: surface_forcing_CS -use ocn_cap_methods, only: ocn_import +use ocn_cap_methods, only: ocn_import, ocn_export ! FMS modules use time_interp_external_mod, only : time_interp_external @@ -493,17 +492,15 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o) ! Translate import fields to ice_ocean_boundary if (glb%sw_decomp) then - write(6,*)'DEBUG: using sw_decomp' call ocn_import(x2o_o%rattr, glb%ind, glb%grid, Ice_ocean_boundary, c1=glb%c1, c2=glb%c2, c3=glb%c3, c4=glb%c4) else call ocn_import(x2o_o%rattr, glb%ind, glb%grid, Ice_ocean_boundary) end if ! Update internal ocean - call update_ocean_model(ice_ocean_boundary, glb%ocn_state, glb%ocn_public, time_start, coupling_timestep, & - x2o_o%rattr, glb%ind) + call update_ocean_model(ice_ocean_boundary, glb%ocn_state, glb%ocn_public, time_start, coupling_timestep) - ! return export state to driver + ! Return export state to driver call ocn_export(glb%ind, glb%ocn_public, glb%grid, o2x_o%rattr) !--- write out intermediate restart file when needed. @@ -537,6 +534,7 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o) ! Is this needed? call forcing_save_restart(glb%ocn_state%forcing_CSp, glb%grid, glb%ocn_state%Time, & glb%ocn_state%dirs%restart_output_dir, .true.) + ! Once we start using the ice shelf module, the following will be needed if (glb%ocn_state%use_ice_shelf) then call ice_shelf_save_restart(glb%ocn_state%Ice_shelf_CSp, glb%ocn_state%Time, & From b10f3434af4076854cdb11302b421deb5c8a14de Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 28 May 2018 20:19:30 -0600 Subject: [PATCH 0305/1072] last set of changes on the mct side to get mct and nuopc caps compatible --- config_src/mct_driver/MOM_ocean_model.F90 | 18 +- config_src/mct_driver/MOM_surface_forcing.F90 | 505 ++++-------------- config_src/mct_driver/ocn_cap_methods.F90 | 4 +- 3 files changed, 132 insertions(+), 395 deletions(-) diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index a62a5f8e24..7bed0ff3cb 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -43,7 +43,8 @@ module MOM_ocean_model 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_and_forces, ice_ocn_bnd_type_chksum +use MOM_surface_forcing, only : 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(>) @@ -417,6 +418,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & !! 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. integer :: secs, days @@ -444,16 +446,22 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call coupler_type_spawn(Ocean_sfc%fields, OS%sfc_state%tr_fields, & (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) + ! Translate Ice_ocean_boundary into fluxes. + call mpp_get_compute_domain(Ocean_sfc%Domain, index_bnds(1), index_bnds(2), & + index_bnds(3), index_bnds(4)) weight = 1.0 + call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time, & + OS%grid, OS%forcing_CSp) + 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_and_forces(Ice_ocean_boundary, OS%fluxes, OS%Time, OS%grid, OS%forcing_CSp, & - OS%sfc_state, OS%restore_salinity, OS%restore_temp, forces=OS%forces) + call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, OS%Time, OS%grid, 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) @@ -483,8 +491,8 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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_and_forces(Ice_ocean_boundary, OS%fluxes, OS%Time, OS%grid, OS%forcing_CSp, & - OS%sfc_state, OS%restore_salinity, OS%restore_temp, forces=OS%forces) + call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, OS%Time, OS%grid, 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%forces, OS%flux_tmp, OS%Time, time_step, OS%Ice_shelf_CSp) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 839c90a497..cf2bb14d41 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -50,7 +50,8 @@ module MOM_surface_forcing #include public IOB_allocate -public convert_IOB_to_fluxes_and_forces +public convert_IOB_to_fluxes +public convert_IOB_to_forces public surface_forcing_init public ice_ocn_bnd_type_chksum public forcing_save_restart @@ -201,8 +202,8 @@ 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_and_forces(IOB, fluxes, Time, G, CS, & - sfc_state, restore_salt, restore_temp, forces) + subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & + sfc_state, restore_salt, restore_temp) type(ice_ocean_boundary_type), & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive @@ -222,16 +223,8 @@ subroutine convert_IOB_to_fluxes_and_forces(IOB, fluxes, Time, G, 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. - type(mech_forcing), intent(inout) :: forces !< Driving mechanical forces - ! 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) - real, dimension(SZI_(G),SZJ_(G)) :: & - taux_at_h, & ! Zonal wind stresses at h points (Pa) - tauy_at_h, & ! Meridional wind stresses at h points (Pa) 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) @@ -245,16 +238,6 @@ subroutine convert_IOB_to_fluxes_and_forces(IOB, fluxes, Time, G, CS, & ! sum, used with units of m2 or (kg/s) open_ocn_mask ! a binary field indicating where ice is present based on frazil criteria - 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, k, 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 @@ -263,6 +246,7 @@ subroutine convert_IOB_to_fluxes_and_forces(IOB, fluxes, Time, G, CS, & ! 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 @@ -277,7 +261,6 @@ subroutine convert_IOB_to_fluxes_and_forces(IOB, fluxes, Time, G, CS, & isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 C_p = fluxes%C_p - Irho0 = 1.0/CS%Rho0 open_ocn_mask(:,:) = 1.0 pme_adj(:,:) = 0.0 fluxes%vPrecGlobalAdj = 0.0 @@ -323,27 +306,11 @@ subroutine convert_IOB_to_fluxes_and_forces(IOB, fluxes, Time, G, CS, & fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) enddo; enddo - ! this is contained in convert_IOB_to_forces - 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) - endif - ! end of additional for MCT cap - if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) fluxes%dt_buoy_accum = 0.0 endif ! endif for allocation and initialization - ! additional for MCT cap - relative to convert_IOB_to_fluxes - if (associated(forces%rigidity_ice_u)) forces%rigidity_ice_u(:,:) = 0.0 - if (associated(forces%rigidity_ice_v)) forces%rigidity_ice_v(:,:) = 0.0 - ! end of additional for MCT cap - if (CS%allow_flux_adjustments) then fluxes%heat_added(:,:)=0.0 fluxes%salt_flux_added(:,:)=0.0 @@ -424,37 +391,10 @@ subroutine convert_IOB_to_fluxes_and_forces(IOB, fluxes, Time, G, CS, & enddo; enddo endif - ! GMM, CIME uses AGRID. All the BGRID_NE code can be cleaned later - wind_stagger = AGRID - - 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 - endif - if (wind_stagger == AGRID) then - ! This is necessary to fill in the halo points. - taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 - endif - !i0 = is - isc_bnd ; j0 = js - jsc_bnd ??? i0 = 0; j0 = 0 ! TODO: is this right? - k = 0 do j=js,je ; do i=is,ie - k = k + 1 ! Increment position within gindex - - if (wind_stagger == BGRID_NE) then - taux_at_q(I,J) = IOB%u_flux(i,j) * CS%wind_stress_multiplier - tauy_at_q(I,J) = IOB%v_flux(i,j) * CS%wind_stress_multiplier - ! GMM, cime uses AGRID - elseif (wind_stagger == AGRID) then - taux_at_h(i,j) = IOB%u_flux(i,j) * CS%wind_stress_multiplier - tauy_at_h(i,j) = IOB%v_flux(i,j) * CS%wind_stress_multiplier - else ! C-grid wind stresses. - forces%taux(I,j) = IOB%u_flux(i,j) * CS%wind_stress_multiplier - forces%tauy(i,J) = IOB%v_flux(i,j) * CS%wind_stress_multiplier - endif - ! liquid precipitation (rain) if (associated(fluxes%lprec)) & fluxes%lprec(i,j) = G%mask2dT(i,j) * IOB%lprec(i-i0,j-j0) @@ -519,24 +459,6 @@ subroutine convert_IOB_to_fluxes_and_forces(IOB, fluxes, Time, G, CS, & 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) - ! applied surface pressure from atmosphere and cryosphere - ! sea-level pressure (Pa) - 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 - forces%p_surf(i,j) = MIN(forces%p_surf_full(i,j),CS%max_p_surf) - else - forces%p_surf(i,j) = forces%p_surf_full(i,j) - endif - - if (CS%use_limited_P_SSH) then - forces%p_surf_SSH => forces%p_surf - else - forces%p_surf_SSH => forces%p_surf_full - endif - endif - ! salt flux ! more salt restoring logic if (associated(fluxes%salt_flux)) & @@ -546,7 +468,6 @@ subroutine convert_IOB_to_fluxes_and_forces(IOB, fluxes, Time, G, CS, & fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*IOB%salt_flux(i-i0,j-j0) enddo; enddo - ! ############################ END OF MCT to MOM ############################## ! adjust the NET fresh-water flux to zero, if flagged if (CS%adjust_net_fresh_water_to_zero) then @@ -577,134 +498,11 @@ subroutine convert_IOB_to_fluxes_and_forces(IOB, fluxes, Time, G, CS, & fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%netFWGlobalAdj ) * G%mask2dT(i,j) enddo; enddo endif - - endif - - ! surface momentum stress related fields as function of staggering - 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) - - do j=js,je ; do I=Isq,Ieq - forces%taux(I,j) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & - forces%taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + & - G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) - enddo; enddo - - do J=Jsq,Jeq ; do i=is,ie - forces%tauy(i,J) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & - forces%tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + & - G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) - enddo; enddo - - ! ustar is required for the bulk mixed layer formulation. The background value - ! of 0.02 Pa is a relatively small value intended to give reasonable behavior - ! in regions of very weak winds. - - do j=js,je ; do i=is,ie - tau_mag = 0.0 ; gustiness = CS%gust_const - if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & - (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then - tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & - G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & - (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & - G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & - ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) - if (CS%read_gust_2d) gustiness = CS%gust(i,j) - endif - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) - enddo; enddo - - elseif (wind_stagger == AGRID) then - call pass_vector(taux_at_h, tauy_at_h, G%Domain,stagger=AGRID) - - do j=js,je ; do I=Isq,Ieq - forces%taux(I,j) = 0.0 - if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & - forces%taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + & - G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & - (G%mask2dT(i,j) + G%mask2dT(i+1,j)) - enddo; enddo - - do J=Jsq,Jeq ; do i=is,ie - forces%tauy(i,J) = 0.0 - if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & - forces%tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + & - G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & - (G%mask2dT(i,j) + G%mask2dT(i,j+1)) - enddo; enddo - - do j=js,je ; do i=is,ie - gustiness = CS%gust_const - if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & - sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) - enddo; enddo - - 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) - - do j=js,je ; do i=is,ie - taux2 = 0.0 - if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & - taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + & - G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) - - tauy2 = 0.0 - if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & - tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + & - G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) - - if (CS%read_gust_2d) then - forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) - else - forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) - endif - enddo; enddo - - endif ! endif for wind related fields - - - ! sea ice related fields - if (CS%rigid_sea_ice) then - ! The commented out code here and in the following lines is the correct - ! version, but the incorrect version is being retained temporarily to avoid - ! changing answers. - call pass_var(forces%p_surf_full, G%Domain) - I_GEarth = 1.0 / G%G_Earth - Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) - do I=isd,ied-1 ; do j=jsd,jed - mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth - mass_eff = 0.0 - if (mass_ice > CS%rigid_sea_ice_mass) then - mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & - (mass_ice + CS%rigid_sea_ice_mass) - endif - ! CAUTION: with both rigid_sea_ice and ice shelves, we will need to make this - ! a maximum for the second call. - forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + Kv_rho_ice * mass_eff - enddo; enddo - do i=isd,ied ; do J=jsd,jed-1 - mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i,j+1)) * I_GEarth - mass_eff = 0.0 - if (mass_ice > CS%rigid_sea_ice_mass) then - mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & - (mass_ice + CS%rigid_sea_ice_mass) - endif - forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + Kv_rho_ice * mass_eff - enddo; enddo endif if (CS%allow_flux_adjustments) then ! Apply adjustments to fluxes - call apply_flux_adjustments(G, CS, Time, forces, fluxes) + call apply_flux_adjustments(G, CS, Time, fluxes) endif ! Allow for user-written code to alter fluxes after all the above @@ -712,7 +510,7 @@ subroutine convert_IOB_to_fluxes_and_forces(IOB, fluxes, Time, G, CS, & call cpu_clock_end(id_clock_forcing) - end subroutine convert_IOB_to_fluxes_and_forces + end subroutine convert_IOB_to_fluxes !======================================================================= @@ -731,7 +529,6 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. - 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) @@ -757,31 +554,26 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) 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 - i0 = is - isc_bnd ; j0 = js - jsc_bnd - Irho0 = 1.0/CS%Rho0 + !isc_bnd = index_bounds(1) ; iec_bnd = index_bounds(2) + !jsc_bnd = index_bounds(3) ; jec_bnd = index_bounds(4) + !i0 = is - isc_bnd ; j0 = js - jsc_bnd + i0 = 0; j0 = 0 ! TODO: is this right? + + 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 safe_alloc_ptr(forces%p_surf,isd,ied,jsd,jed) call safe_alloc_ptr(forces%p_surf_full,isd,ied,jsd,jed) - 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 (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) @@ -790,36 +582,32 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, 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 - 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 - 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) - enddo ; enddo - else - do j=js,je ; do i=is,ie + !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) - forces%p_surf(i,j) = forces%p_surf_full(i,j) - enddo ; enddo - endif - endif - wind_stagger = CS%wind_stagger - if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. & - (IOB%wind_stagger == CGRID_NE)) wind_stagger = IOB%wind_stagger + if (CS%max_p_surf >= 0.0) then + forces%p_surf(i,j) = MIN(forces%p_surf_full(i,j),CS%max_p_surf) + else + forces%p_surf(i,j) = forces%p_surf_full(i,j) + endif + + if (CS%use_limited_P_SSH) then + forces%p_surf_SSH => forces%p_surf + else + forces%p_surf_SSH => forces%p_surf_full + endif + end if + end do; end do + + ! GMM, CIME uses AGRID. All the BGRID_NE code can be cleaned later + wind_stagger = AGRID + 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 @@ -831,15 +619,6 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, 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 @@ -855,109 +634,96 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) ! surface momentum stress related fields as function of staggering 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, halo=1) - - do j=js,je ; do I=Isq,Ieq - forces%taux(I,j) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & - forces%taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + & - G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) - enddo ; enddo - - do J=Jsq,Jeq ; do i=is,ie - forces%tauy(i,J) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & - forces%tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + & - G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) - enddo ; enddo - - ! ustar is required for the bulk mixed layer formulation. The background value - ! of 0.02 Pa is a relatively small value intended to give reasonable behavior - ! in regions of very weak winds. - - do j=js,je ; do i=is,ie - tau_mag = 0.0 ; gustiness = CS%gust_const - if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & - (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then - tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & - G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & - (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & - G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & - ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) - if (CS%read_gust_2d) gustiness = CS%gust(i,j) - endif - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) - enddo ; enddo + 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) + + do j=js,je ; do I=Isq,Ieq + forces%taux(I,j) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & + forces%taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + & + G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) + enddo; enddo + + do J=Jsq,Jeq ; do i=is,ie + forces%tauy(i,J) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & + forces%tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + & + G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) + enddo; enddo + + ! ustar is required for the bulk mixed layer formulation. The background value + ! of 0.02 Pa is a relatively small value intended to give reasonable behavior + ! in regions of very weak winds. + + do j=js,je ; do i=is,ie + tau_mag = 0.0 ; gustiness = CS%gust_const + if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then + tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & + G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & + (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & + G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & + ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) + if (CS%read_gust_2d) gustiness = CS%gust(i,j) + endif + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) + enddo; enddo elseif (wind_stagger == AGRID) then - 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 - if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & - forces%taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + & - G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & - (G%mask2dT(i,j) + G%mask2dT(i+1,j)) - enddo ; enddo - - do J=Jsq,Jeq ; do i=is,ie - forces%tauy(i,J) = 0.0 - if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & - forces%tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + & - G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & - (G%mask2dT(i,j) + G%mask2dT(i,j+1)) - enddo ; enddo - - do j=js,je ; do i=is,ie - gustiness = CS%gust_const - if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & - sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) - enddo ; enddo + call pass_vector(taux_at_h, tauy_at_h, G%Domain,stagger=AGRID) + + do j=js,je ; do I=Isq,Ieq + forces%taux(I,j) = 0.0 + if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & + forces%taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + & + G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & + (G%mask2dT(i,j) + G%mask2dT(i+1,j)) + enddo; enddo + + do J=Jsq,Jeq ; do i=is,ie + forces%tauy(i,J) = 0.0 + if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & + forces%tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + & + G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & + (G%mask2dT(i,j) + G%mask2dT(i,j+1)) + enddo; enddo + + do j=js,je ; do i=is,ie + gustiness = CS%gust_const + if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & + sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) + enddo; enddo 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, halo=1) - - do j=js,je ; do i=is,ie - taux2 = 0.0 - if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & - taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + & - G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) - - tauy2 = 0.0 - if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & - tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + & - G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) - - if (CS%read_gust_2d) then - forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) - else - forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) - endif - enddo ; enddo + if (G%symmetric) & + call fill_symmetric_edges(forces%taux, forces%tauy, G%Domain) + call pass_vector(forces%taux, forces%tauy, G%Domain) + + do j=js,je ; do i=is,ie + taux2 = 0.0 + if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & + taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + & + G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) + + tauy2 = 0.0 + if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & + tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + & + G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) + + if (CS%read_gust_2d) then + forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) + else + forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) + endif + enddo; enddo 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 @@ -1058,11 +824,10 @@ end subroutine IOB_allocate !! 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) -subroutine apply_flux_adjustments(G, CS, Time, forces, fluxes) +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(mech_forcing), intent(inout) :: forces !< Driving mechanical forces type(forcing), optional, intent(inout) :: fluxes !< Surface fluxes structure ! Local variables @@ -1110,42 +875,6 @@ subroutine apply_flux_adjustments(G, CS, Time, forces, fluxes) call pass_var(fluxes%vprec, G%Domain) - - tempx_at_h(:,:) = 0.0 ; tempy_at_h(:,:) = 0.0 - ! Either reads data or leaves contents unchanged - overrode_x = .false. ; overrode_y = .false. - call data_override('OCN', 'taux_adj', tempx_at_h(isc:iec,jsc:jec), Time, override=overrode_x) - call data_override('OCN', 'tauy_adj', tempy_at_h(isc:iec,jsc:jec), Time, override=overrode_y) - - if (overrode_x .or. overrode_y) then - if (.not. (overrode_x .and. overrode_y)) call MOM_error(FATAL,"apply_flux_adjustments: "//& - "Both taux_adj and tauy_adj must be specified, or neither, in data_table") - - ! Rotate winds - call pass_vector(tempx_at_h, tempy_at_h, G%Domain, To_All, AGRID) - do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 - dLonDx = G%geoLonCu(I,j) - G%geoLonCu(I-1,j) - dLonDy = G%geoLonCv(i,J) - G%geoLonCv(i,J-1) - rDlon = sqrt( dLonDx * dLonDx + dLonDy * dLonDy ) - if (rDlon > 0.) rDlon = 1. / rDlon - cosA = dLonDx * rDlon - sinA = dLonDy * rDlon - zonal_tau = tempx_at_h(i,j) - merid_tau = tempy_at_h(i,j) - tempx_at_h(i,j) = cosA * zonal_tau - sinA * merid_tau - tempy_at_h(i,j) = sinA * zonal_tau + cosA * merid_tau - enddo ; enddo - - ! Average to C-grid locations - do j=G%jsc,G%jec ; do I=G%isc-1,G%iec - forces%taux(I,j) = forces%taux(I,j) + 0.5 * ( tempx_at_h(i,j) + tempx_at_h(i+1,j) ) - enddo ; enddo - - do J=G%jsc-1,G%jec ; do i=G%isc,G%iec - forces%tauy(i,J) = forces%tauy(i,J) + 0.5 * ( tempy_at_h(i,j) + tempy_at_h(i,j+1) ) - enddo ; enddo - endif ! overrode_x .or. overrode_y - end subroutine apply_flux_adjustments !======================================================================= diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 3e212b1a4e..c4bed93076 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -57,10 +57,10 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, c1, c2, c3, c4) ice_ocean_boundary%q_flux(i,j) = x2o(ind%x2o_Foxx_evap,k) !???TODO: should this be a minus sign ! sensible heat flux (W/m2) - ice_ocean_boundary%t_flux(i,j) = x2o(ind%x2o_Foxx_sen,k) * GRID%mask2dT(i,j) + ice_ocean_boundary%t_flux(i,j) = x2o(ind%x2o_Foxx_sen,k) * GRID%mask2dT(i,j) !???TODO: should this be a minus sign ! latent heat flux (W/m^2) - ice_ocean_boundary%latent_flux(i,j) = x2o(ind%x2o_Foxx_lat,k) * GRID%mask2dT(i,j) + ice_ocean_boundary%latent_flux(i,j) = x2o(ind%x2o_Foxx_lat,k) * GRID%mask2dT(i,j) !???TODO: should this be a minus sign ! liquid runoff ice_ocean_boundary%rofl_flux(i,j) = x2o(ind%x2o_Foxx_rofl,k) * GRID%mask2dT(i,j) From 3d1962c01fe4b9c9c7dbf5d0db4a50884648177b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 28 May 2018 20:47:22 -0600 Subject: [PATCH 0306/1072] changes to MOM6 to get nuopc and mct caps similar --- config_src/nuopc_driver/MOM_ocean_model.F90 | 71 ++++++++----------- .../nuopc_driver/MOM_surface_forcing.F90 | 6 +- config_src/nuopc_driver/mom_cap.F90 | 4 +- config_src/nuopc_driver/mom_cap_methods.F90 | 12 ++-- 4 files changed, 43 insertions(+), 50 deletions(-) diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index fff7ad5ed0..9367e34a06 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -99,14 +99,15 @@ module MOM_ocean_model type(domain2d) :: Domain !< The domain for the surface fields. 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. + !! 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 @@ -251,13 +252,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) ! Because of the way that indicies and domains are handled, Ocean_sfc must have ! been used in a previous call to initialize_ocean_type. -! Arguments: Ocean_sfc - A structure containing various publicly visible ocean -! surface properties after initialization, this is intent(out). -! (out,private) 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. -! (in) Time_init - The start time for the coupled model's calendar. -! (in) Time_in - The time at which to initialize the ocean model. real :: Rho0 ! The Boussinesq ocean density, in kg m-3. real :: G_Earth ! The gravitational acceleration in m s-2. ! This include declares and sets the variable "version". @@ -457,31 +451,32 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & !! cumulative thermodynamic fluxes from the ocean, !! like frazil, have been used and should be reset. - 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. + ! 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 :: 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. + 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. + 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(), 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) @@ -923,17 +918,13 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, & 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*(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)) + 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*(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)) + 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 diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index bb6c58fa1f..b6a8f9ac5c 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -215,11 +215,12 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. type(surface), intent(in) :: sfc_state !< A structure containing fields that describe the - !! surface state of the ocean. + !! surface state of the ocean. 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 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) @@ -476,6 +477,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & 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) @@ -588,7 +590,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) 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) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 730a889566..e6939af64c 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -383,7 +383,7 @@ module mom_cap_mod use MOM_get_input, only: Get_MOM_Input, directories use MOM_domains, only: pass_var #ifdef MOM6_CAP - use ocean_model_mod, only: ice_ocean_boundary_type + use MOM_ocean_model, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type #else use ocean_types_mod, only: ice_ocean_boundary_type, ocean_grid_type @@ -732,7 +732,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fms_init(mpi_comm_mom) call constants_init call field_manager_init - call set_calendar_type (JULIAN ) + call set_calendar_type (JULIAN) call diag_manager_init ! this ocean connector will be driven at set interval dt_cpld = DT_OCEAN diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 0a5d237c78..92c37f0e56 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -5,12 +5,12 @@ module mom_cap_methods ! mct modules use ESMF - use perf_mod, only: t_startf, t_stopf - use ocean_model_mod, only: ocean_public_type, ocean_state_type - use ocean_model_mod, only: ice_ocean_boundary_type - use MOM_grid, only: ocean_grid_type - use MOM_domains, only: pass_var - use mpp_domains_mod, only: mpp_get_compute_domain + use perf_mod, only: t_startf, t_stopf + use MOM_ocean_model, only: ocean_public_type, ocean_state_type + use MOM_surface_forcing, only: ice_ocean_boundary_type + use MOM_grid, only: ocean_grid_type + use MOM_domains, only: pass_var + use mpp_domains_mod, only: mpp_get_compute_domain ! By default make data private implicit none; private From 5f1b51c727a920a730c72c686ba6103650ca8cc8 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 28 May 2018 21:02:51 -0600 Subject: [PATCH 0307/1072] more cleanup of ocn_comp_mct --- config_src/mct_driver/ocn_comp_mct.F90 | 123 +------------------------ 1 file changed, 2 insertions(+), 121 deletions(-) diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 7696f7eae0..26088eec54 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -49,7 +49,8 @@ module ocn_comp_mct ! Previously inlined - now in separate modules 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_surface_forcing, only: surface_forcing_CS +use MOM_ocean_model, only: convert_state_to_ocean_type +use MOM_surface_forcing, only: surface_forcing_CS, forcing_save_restart use ocn_cap_methods, only: ocn_import, ocn_export ! FMS modules @@ -62,7 +63,6 @@ module ocn_comp_mct use coupler_types_mod, only : coupler_type_spawn use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data - ! By default make data private implicit none; private @@ -78,8 +78,6 @@ module ocn_comp_mct private :: ocn_domain_mct private :: get_runtype private :: ocean_model_init_sfc -private :: convert_state_to_ocean_type -private :: forcing_save_restart ! Flag for debugging logical, parameter :: debug=.true. @@ -374,7 +372,6 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) ! call seq_infodata_PutData( infodata, precip_fact=precip_fact) ! end if - if (debug .and. root_pe().eq.pe_here()) print *, "calling ocn_export" call ocn_export(glb%ind, glb%ocn_public, glb%grid, o2x_o%rattr) @@ -743,122 +740,6 @@ end subroutine ocean_model_init_sfc !======================================================================= -!> 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 - 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 mpp_get_compute_domain(Ocean_sfc%Domain, isc_bnd, iec_bnd, & - jsc_bnd, jec_bnd) - if (present(patm)) then - ! Check that the inidicies in patm are (isc_bnd:iec_bnd,jsc_bnd:jec_bnd). - if (.not.present(press_to_z)) call MOM_error(FATAL, & - 'convert_state_to_ocean_type: press_to_z must be present if patm is.') - endif - - i0 = is - isc_bnd ; j0 = js - jsc_bnd - if (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 - 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 - enddo ; enddo - endif - if (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)) - 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) - 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) - 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) - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) - enddo ; enddo - - 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)) - 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)) - 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) - enddo ; enddo - else - write(val_str, '(I8)') Ocean_sfc%stagger - call MOM_error(FATAL, "convert_state_to_ocean_type: "//& - "Ocean_sfc%stagger has the unrecognized value of "//trim(val_str)) - endif - - if (coupler_type_initialized(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) - endif - -end subroutine convert_state_to_ocean_type - -!======================================================================= - -!> Saves restart fields associated with the 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(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 - 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 - -!======================================================================= - !> \namespace ocn_comp_mct !! !! \section section_ocn_import Fluxes imported from the coupler (MCT) to MOM6 From 42c4f937538db40aedf600239cbf3bf441a1c92a Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 29 May 2018 09:30:37 -0600 Subject: [PATCH 0308/1072] Add some comments --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index a26e44fe48..f283f6243a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -893,6 +893,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call tracer_vertdiff(hold, ea, eb, dt, tv%T, G, GV) call tracer_vertdiff(hold, ea, eb, dt, tv%S, G, GV) else + call triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, tv%T, tv%S) endif From 20ea5e25072e3c8b71e57fb29d8332a200226a3f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 29 May 2018 13:33:27 -0400 Subject: [PATCH 0309/1072] +Changed arguments to shelf_calc_flux Made forces into an optional argument for shelf_calc_flux, and then added calls to add_shelf_forces in most places where shelf_calc_flux is called. Also added acculumulate_p_surf as an element in the forcing type, as well as the mech_forcing_type, so that surface pressure can be calculated independently in the two types, and added a new internal routine, add_shelf_pressure, in the MOM_ice_shelf module. All answers are bitwise identical in the test cases. --- .../coupled_driver/MOM_surface_forcing.F90 | 1 + config_src/coupled_driver/ocean_model_MOM.F90 | 36 ++++++++----- config_src/mct_driver/ocn_comp_mct.F90 | 8 +-- config_src/solo_driver/MOM_driver.F90 | 8 ++- src/core/MOM_forcing_type.F90 | 4 ++ src/ice_shelf/MOM_ice_shelf.F90 | 50 +++++++++++++------ 6 files changed, 73 insertions(+), 34 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index d4f64a23e9..7d6ccd84cf 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -492,6 +492,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & 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 ! more salt restoring logic diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 395a4d3abb..cd72884392 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -54,7 +54,7 @@ module ocean_model_mod use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS -use MOM_ice_shelf, only : ice_shelf_end, ice_shelf_save_restart +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 @@ -514,18 +514,24 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%grid, OS%forcing_CSp) if (OS%fluxes%fluxes_used) then - call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & + if (do_thermo) & + call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & OS%grid, 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%forces, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + 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 - call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) - call iceberg_fluxes(OS%grid, OS%fluxes, OS%use_ice_shelf, & + 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 @@ -541,22 +547,28 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%fluxes%dt_buoy_accum = dt_coupling else OS%flux_tmp%C_p = OS%fluxes%C_p - call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & + if (do_thermo) & + call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & OS%grid, 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%forces, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + 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 - call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) - call iceberg_fluxes(OS%grid, OS%flux_tmp, OS%use_ice_shelf, & + 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 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 diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 09565d9d59..f25eeea438 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -61,7 +61,7 @@ module ocn_comp_mct use MOM_diag_mediator, only: diag_mediator_close_registration, diag_mediator_end use MOM_diag_mediator, only: safe_alloc_ptr use MOM_ice_shelf, only: initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS -use MOM_ice_shelf, only: ice_shelf_end, ice_shelf_save_restart +use MOM_ice_shelf, only: add_shelf_forces, ice_shelf_end, ice_shelf_save_restart use MOM_string_functions, only: uppercase use MOM_constants, only: CELSIUS_KELVIN_OFFSET, hlf, hlv use MOM_EOS, only: gsw_sp_from_sr, gsw_pt_from_ct @@ -1727,7 +1727,8 @@ subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, & ! Add ice shelf fluxes if (OS%use_ice_shelf) then - call shelf_calc_flux(OS%sfc_state, OS%forces, OS%fluxes, OS%Time, time_step, OS%Ice_shelf_CSp) + 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) endif ! GMM, check ocean_model_MOM.F90 to enable the following option @@ -1748,7 +1749,8 @@ subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, & OS%restore_salinity,OS%restore_temp) if (OS%use_ice_shelf) then - call shelf_calc_flux(OS%sfc_state, OS%forces, OS%flux_tmp, OS%Time, time_step, OS%Ice_shelf_CSp) + 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) endif ! GMM, check ocean_model_MOM.F90 to enable the following option diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 80a622b5ec..43c6425659 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -66,7 +66,7 @@ program MOM_main use time_interp_external_mod, only : time_interp_external_init use MOM_ice_shelf, only : initialize_ice_shelf, ice_shelf_end, ice_shelf_CS - use MOM_ice_shelf, only : shelf_calc_flux, ice_shelf_save_restart + use MOM_ice_shelf, only : shelf_calc_flux, add_shelf_forces, ice_shelf_save_restart ! , add_shelf_flux_forcing, add_shelf_flux_IOB use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init @@ -483,10 +483,8 @@ program MOM_main endif if (use_ice_shelf) then - call shelf_calc_flux(sfc_state, forces, fluxes, Time, dt_forcing, ice_shelf_CSp) -!###IS call add_shelf_flux_forcing(fluxes, ice_shelf_CSp) -!###IS ! With a coupled ice/ocean run, use the following call. -!###IS call add_shelf_flux_IOB(ice_ocean_bdry_type, ice_shelf_CSp) + call shelf_calc_flux(sfc_state, fluxes, Time, dt_forcing, ice_shelf_CSp) + call add_shelf_forces(grid, Ice_shelf_CSp, forces) endif fluxes%fluxes_used = .false. fluxes%dt_buoy_accum = dt_forcing diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 92d215ec91..bb03370e03 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -118,6 +118,10 @@ module MOM_forcing_type !! in corrections to the sea surface height field !! that is passed back to the calling routines. !! This may point to p_surf or to p_surf_full. + logical :: accumulate_p_surf = .false. !< If true, the surface pressure due to the atmosphere + !! and various types of ice needs to be accumulated, and the + !! surface pressure explicitly reset to zero at the driver level + !! when appropriate. ! tide related inputs real, pointer, dimension(:,:) :: & diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 026c7a0456..77a4cc82a5 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -58,8 +58,7 @@ module MOM_ice_shelf #endif public shelf_calc_flux, add_shelf_flux, initialize_ice_shelf, ice_shelf_end -public ice_shelf_save_restart, solo_time_step -public add_shelf_forces +public ice_shelf_save_restart, solo_time_step, add_shelf_forces !> Control structure that contains ice shelf parameters and diagnostics handles type, public :: ice_shelf_CS ; private @@ -176,10 +175,9 @@ module MOM_ice_shelf !> Calculates fluxes between the ocean and ice-shelf using the three-equations !! formulation (optional to use just two equations). !! See \ref section_ICE_SHELF_equations -subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) +subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) type(surface), intent(inout) :: state !< structure containing fields that !!describe the surface state of the ocean - type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(forcing), intent(inout) :: fluxes !< structure containing pointers to any possible !! thermodynamic or mass-flux forcing fields. type(time_type), intent(in) :: Time !< Start time of the fluxes. @@ -188,6 +186,7 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) type(ice_shelf_CS), pointer :: CS !< A pointer to the control structure !! returned by a previous call to !! initialize_ice_shelf. + type(mech_forcing), optional, intent(inout) :: forces !< A structure with the driving mechanical forces type(ocean_grid_type), pointer :: G => NULL() ! The grid structure used by the ice shelf. type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe @@ -631,12 +630,8 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) if (CS%DEBUG) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, haloshift=0) - call add_shelf_forces(G, CS, forces, do_shelf_area=(CS%active_shelf_dynamics .or. & - CS%override_shelf_movement)) call add_shelf_flux(G, CS, state, fluxes) - call copy_common_forcing_fields(forces, fluxes, G) - ! now the thermodynamic data is passed on... time to update the ice dynamic quantities if (CS%active_shelf_dynamics) then @@ -668,6 +663,11 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) if (CS%id_h_mask > 0) call post_data(CS%id_h_mask,ISS%hmask,CS%diag) call disable_averaging(CS%diag) + if (present(forces)) then + call add_shelf_forces(G, CS, forces, do_shelf_area=(CS%active_shelf_dynamics .or. & + CS%override_shelf_movement)) + endif + call cpu_clock_end(id_clock_shelf) if (CS%DEBUG) call MOM_forcing_chksum("End of shelf calc flux", fluxes, G, haloshift=0) @@ -808,6 +808,30 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) end subroutine add_shelf_forces +!> This subroutine adds the ice shelf pressure to the fluxes type. +subroutine add_shelf_pressure(G, CS, fluxes) + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(ice_shelf_CS), intent(in) :: CS !< This module's control structure. + type(forcing), intent(inout) :: fluxes !< A structure of surface fluxes that may be updated. + + real :: press_ice !< The pressure of the ice shelf per unit area of ocean (not ice) in Pa. + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + do j=js,je ; do i=is,ie + press_ice = (CS%ISS%area_shelf_h(i,j) * G%IareaT(i,j)) * (CS%g_Earth * CS%ISS%mass_shelf(i,j)) + if (associated(fluxes%p_surf)) then + if (.not.fluxes%accumulate_p_surf) fluxes%p_surf(i,j) = 0.0 + fluxes%p_surf(i,j) = fluxes%p_surf(i,j) + press_ice + endif + if (associated(fluxes%p_surf_full)) then + if (.not.fluxes%accumulate_p_surf) fluxes%p_surf_full(i,j) = 0.0 + fluxes%p_surf_full(i,j) = fluxes%p_surf_full(i,j) + press_ice + endif + enddo ; enddo + +end subroutine add_shelf_pressure + !> Updates surface fluxes that are influenced by sub-ice-shelf melting subroutine add_shelf_flux(G, CS, state, fluxes) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -822,6 +846,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) real :: shelf_mass1 !< Total ice shelf mass at current time (Time). real :: delta_mass_shelf!< Change in ice shelf mass over one time step in kg/s real :: taux2, tauy2 !< The squared surface stresses, in Pa. + real :: press_ice !< The pressure of the ice shelf per unit area of ocean (not ice) in Pa. real :: asu1, asu2 !< Ocean areas covered by ice shelves at neighboring u- real :: asv1, asv2 !< and v-points, in m2. real :: fraz !< refreezing rate in kg m-2 s-1 @@ -842,14 +867,13 @@ subroutine add_shelf_flux(G, CS, state, fluxes) real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1. real, parameter :: rho_fw = 1000.0 ! fresh water density - logical :: find_shelf_area integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed ISS => CS%ISS - find_shelf_area = (CS%active_shelf_dynamics .or. CS%override_shelf_movement) + call add_shelf_pressure(G, CS, fluxes) ! Determine ustar and the square magnitude of the velocity in the ! bottom boundary layer. Together these give the TKE source and @@ -1442,12 +1466,10 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call hchksum(fluxes%frac_shelf_h, "IS init: frac_shelf_h", G%HI, haloshift=0) endif - if (present(forces)) then + if (present(forces)) & call add_shelf_forces(G, CS, forces, do_shelf_area=.not.CS%solo_ice_sheet) - endif - if (present(fluxes) .and. present(forces)) & - call copy_common_forcing_fields(forces, fluxes, G) + if (present(fluxes)) call add_shelf_pressure(G, CS, fluxes) if (CS%active_shelf_dynamics .and. .not.CS%isthermo) then ISS%water_flux(:,:) = 0.0 From 56c461cc8ad7eb31bf695f5f3f4d4ee67c93b7ec Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 29 May 2018 15:51:45 -0600 Subject: [PATCH 0310/1072] Adds back old double-diffusion code --- .../vertical/MOM_diabatic_driver.F90 | 21 +- .../vertical/MOM_set_diffusivity.F90 | 202 +++++++++++++++++- 2 files changed, 213 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 698243a7f6..d6ca59183e 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -731,11 +731,16 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! If using matching within the KPP scheme, then this step needs to provide ! a diffusivity and happen before KPP. But generally in MOM, we do not match ! KPP boundary layer to interior, so this diffusivity can be computed when convenient. - if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T)) then - call cpu_clock_begin(id_clock_CVMix_ddiff) + if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T) .and. .not. & + CS%use_CVMix_ddiff) then + ! GMM, fix this + !call cpu_clock_begin(id_clock_CVMix_ddiff) + call cpu_clock_begin(id_clock_differential_diff) call differential_diffuse_T_S(h, tv, visc, dt, G, GV) - call cpu_clock_end(id_clock_CVMix_ddiff) + !call cpu_clock_end(id_clock_CVMix_ddiff) + call cpu_clock_end(id_clock_differential_diff) + if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G) @@ -1889,7 +1894,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, real :: Kd integer :: num_mode - logical :: use_temperature + logical :: use_temperature, differentialDiffusion type(vardesc) :: vd ! This "include" declares and sets the variable "version". @@ -1940,6 +1945,10 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, "If true, the diffusivity from ePBL is added to all\n"//& "other diffusivities. Otherwise, the larger of kappa-\n"//& "shear and ePBL diffusivities are used.", default=.true.) + call get_param(param_file, mod, "DOUBLE_DIFFUSION", differentialDiffusion, & + "If true, apply parameterization of double-diffusion.", & + default=.false. ) + CS%use_CVMix_ddiff = CVMix_ddiff_is_used(param_file) CS%use_kappa_shear = kappa_shear_is_used(param_file) CS%use_CVMix_shear = CVMix_shear_is_used(param_file) @@ -2402,8 +2411,10 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, id_clock_sponge = cpu_clock_id('(Ocean sponges)', grain=CLOCK_MODULE) id_clock_tridiag = cpu_clock_id('(Ocean diabatic tridiag)', grain=CLOCK_ROUTINE) id_clock_pass = cpu_clock_id('(Ocean diabatic message passing)', grain=CLOCK_ROUTINE) + id_clock_differential_diff = -1 ; if (differentialDiffusion) & + id_clock_differential_diff = cpu_clock_id('(Ocean differential diffusion)', grain=CLOCK_ROUTINE) id_clock_CVMix_ddiff = -1 ; if (CS%use_CVMix_ddiff) & - id_clock_CVMix_ddiff = cpu_clock_id('(Double diffusion)', grain=CLOCK_ROUTINE) + id_clock_CVMix_ddiff = cpu_clock_id('(Double diffusion via CVMix)', grain=CLOCK_ROUTINE) ! initialize the auxiliary diabatic driver module call diabatic_aux_init(Time, G, GV, param_file, diag, CS%diabatic_aux_CSp, & diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 903868795a..b97583aa1c 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -130,9 +130,13 @@ module MOM_set_diffusivity !! shear-driven diapycnal diffusivity. logical :: use_CVMix_shear !< If true, use one of the CVMix modules to find !! shear-driven diapycnal diffusivity. + logical :: double_diffusion !< If true, enable double-diffusive mixing using an old method. logical :: use_CVMix_ddiff !< If true, enable double-diffusive mixing via CVMix. logical :: simple_TKE_to_Kd !< If true, uses a simple estimate of Kd/TKE that !! does not rely on a layer-formulation. + real :: Max_Rrho_salt_fingers !< max density ratio for salt fingering + real :: Max_salt_diff_salt_fingers !< max salt diffusivity for salt fingers (m2/s) + real :: Kv_molecular !< molecular visc for double diff convect (m2/s) character(len=200) :: inputdir type(user_change_diff_CS), pointer :: user_change_diff_CSp => NULL() @@ -156,6 +160,10 @@ module MOM_set_diffusivity integer :: id_N2 = -1 integer :: id_N2_z = -1 + integer :: id_KT_extra = -1 + integer :: id_KS_extra = -1 + integer :: id_KT_extra_z = -1 + integer :: id_KS_extra_z = -1 end type set_diffusivity_CS @@ -166,9 +174,12 @@ module MOM_set_diffusivity Kd_BBL => NULL(),& ! BBL diffusivity at interfaces (m2/s) Kd_work => NULL(),& ! layer integrated work by diapycnal mixing (W/m2) maxTKE => NULL(),& ! energy required to entrain to h_max (m3/s3) - TKE_to_Kd => NULL() ! conversion rate (~1.0 / (G_Earth + dRho_lay)) + TKE_to_Kd => NULL(),& ! conversion rate (~1.0 / (G_Earth + dRho_lay)) ! between TKE dissipated within a layer and Kd ! in that layer, in m2 s-1 / m3 s-3 = s2 m-1 + KT_extra => NULL(),& ! double diffusion diffusivity for temp (m2/s) + KS_extra => NULL() ! double diffusion diffusivity for saln (m2/s) + end type diffusivity_diags ! Clocks @@ -236,7 +247,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & real, dimension(SZI_(G),SZK_(G)+1) :: & N2_int, & !< squared buoyancy frequency associated at interfaces (1/s2) - dRho_int !< locally ref potential density difference across interfaces (in s-2) smg: or kg/m3? + dRho_int, & !< locally ref potential density difference across interfaces (in s-2) smg: or kg/m3? + KT_extra, & !< double difusion diffusivity on temperature (m2/sec) + KS_extra ! double difusion diffusivity on salinity (m2/sec) real :: I_Rho0 ! inverse of Boussinesq density (m3/kg) real :: dissip ! local variable for dissipation calculations (W/m3) @@ -271,10 +284,10 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & use_EOS = associated(tv%eqn_of_state) - if ((CS%use_CVMix_ddiff) .and. & + if ((CS%use_CVMix_ddiff) .or. CS%double_diffusion .and. & .not.(associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S)) ) & call MOM_error(FATAL, "set_diffusivity: visc%Kd_extra_T and "//& - "visc%Kd_extra_S must be associated when USE_CVMIX_DDIFF is true.") + "visc%Kd_extra_S must be associated when USE_CVMIX_DDIFF or DOUBLE_DIFFUSION are true.") ! Set Kd, Kd_int and Kv_slow to constant values. ! If nothing else is specified, this will be the value used. @@ -299,6 +312,12 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%id_TKE_to_Kd > 0) then allocate(dd%TKE_to_Kd(isd:ied,jsd:jed,nz)) ; dd%TKE_to_Kd(:,:,:) = 0.0 endif + if ((CS%id_KT_extra > 0) .or. (CS%id_KT_extra_z > 0)) then + allocate(dd%KT_extra(isd:ied,jsd:jed,nz+1)) ; dd%KT_extra(:,:,:) = 0.0 + endif + if ((CS%id_KS_extra > 0) .or. (CS%id_KS_extra_z > 0)) then + allocate(dd%KS_extra(isd:ied,jsd:jed,nz+1)) ; dd%KS_extra(:,:,:) = 0.0 + endif if ((CS%id_Kd_BBL > 0) .or. (CS%id_Kd_BBL_z > 0)) then allocate(dd%Kd_BBL(isd:ied,jsd:jed,nz+1)) ; dd%Kd_BBL(:,:,:) = 0.0 endif @@ -375,7 +394,35 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! Add background mixing call calculate_bkgnd_mixing(h, tv, N2_lay, Kd, visc%Kv_slow, j, G, GV, CS%bkgnd_mixing_csp) - ! Apply double diffusion + ! Double-diffusion (old method) + if (CS%double_diffusion) then + call double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, KT_extra, KS_extra) + do K=2,nz ; do i=is,ie + if (KS_extra(i,K) > KT_extra(i,K)) then ! salt fingering + Kd(i,j,k-1) = Kd(i,j,k-1) + 0.5*KT_extra(i,K) + Kd(i,j,k) = Kd(i,j,k) + 0.5*KT_extra(i,K) + visc%Kd_extra_S(i,j,k) = KS_extra(i,K)-KT_extra(i,K) + visc%Kd_extra_T(i,j,k) = 0.0 + elseif (KT_extra(i,K) > 0.0) then ! double-diffusive convection + Kd(i,j,k-1) = Kd(i,j,k-1) + 0.5*KS_extra(i,K) + Kd(i,j,k) = Kd(i,j,k) + 0.5*KS_extra(i,K) + visc%Kd_extra_T(i,j,k) = KT_extra(i,K)-KS_extra(i,K) + visc%Kd_extra_S(i,j,k) = 0.0 + else ! There is no double diffusion at this interface. + visc%Kd_extra_T(i,j,k) = 0.0 + visc%Kd_extra_S(i,j,k) = 0.0 + endif + enddo ; enddo + if (associated(dd%KT_extra)) then ; do K=1,nz+1 ; do i=is,ie + dd%KT_extra(i,j,K) = KT_extra(i,K) + enddo ; enddo ; endif + + if (associated(dd%KS_extra)) then ; do K=1,nz+1 ; do i=is,ie + dd%KS_extra(i,j,K) = KS_extra(i,K) + enddo ; enddo ; endif + endif + + ! Apply double diffusion via CVMix ! GMM, we need to pass HBL to compute_ddiff_coeffs, but it is not yet available. if (CS%use_CVMix_ddiff) then call compute_ddiff_coeffs(h, tv, G, GV, j, visc%Kd_extra_T, visc%Kd_extra_S, CS%CVMix_ddiff_csp) @@ -562,11 +609,26 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif + if (CS%id_KT_extra > 0) call post_data(CS%id_KT_extra, dd%KT_extra, CS%diag) + if (CS%id_KS_extra > 0) call post_data(CS%id_KS_extra, dd%KS_extra, CS%diag) if (CS%id_Kd_BBL > 0) call post_data(CS%id_Kd_BBL, dd%Kd_BBL, CS%diag) + if (CS%id_KT_extra_z > 0) then + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_KT_extra_z + z_ptrs(num_z_diags)%p => dd%KT_extra + endif + + if (CS%id_KS_extra_z > 0) then + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_KS_extra_z + z_ptrs(num_z_diags)%p => dd%KS_extra + endif + if (CS%id_Kd_BBL_z > 0) then num_z_diags = num_z_diags + 1 z_ids(num_z_diags) = CS%id_Kd_BBL_z + z_ptrs(num_z_diags)%p => dd%KS_extra endif if (num_z_diags > 0) & @@ -577,6 +639,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(dd%Kd_user)) deallocate(dd%Kd_user) if (associated(dd%maxTKE)) deallocate(dd%maxTKE) if (associated(dd%TKE_to_Kd)) deallocate(dd%TKE_to_Kd) + if (associated(dd%KT_extra)) deallocate(dd%KT_extra) + if (associated(dd%KS_extra)) deallocate(dd%KS_extra) if (associated(dd%Kd_BBL)) deallocate(dd%Kd_BBL) if (showCallTree) call callTree_leave("set_diffusivity()") @@ -929,6 +993,97 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & end subroutine find_N2 +!> This subroutine sets the additional diffusivities of temperature and +!! salinity due to double diffusion, using the same functional form as is +!! used in MOM4.1, and taken from an NCAR technical note (REF?) that updates +!! what was in Large et al. (1994). All the coefficients here should probably +!! be made run-time variables rather than hard-coded constants. +!! +!! \todo Find reference for NCAR tech note above. +subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, Kd_T_dd, Kd_S_dd) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available + !! thermodynamic fields; absent fields have NULL + !! ptrs. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: T_f !< layer temp in C with the values in massless layers + !! filled vertically by diffusion. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: S_f !< Layer salinities in PPT with values in massless + !! layers filled vertically by diffusion. + integer, intent(in) :: j !< Meridional index upon which to work. + type(set_diffusivity_CS), pointer :: CS !< Module control structure. + real, dimension(SZI_(G),SZK_(G)+1), & + intent(out) :: Kd_T_dd !< Interface double diffusion diapycnal + !! diffusivity for temp (m2/sec). + real, dimension(SZI_(G),SZK_(G)+1), & + intent(out) :: Kd_S_dd !< Interface double diffusion diapycnal + !! diffusivity for saln (m2/sec). + + real, dimension(SZI_(G)) :: & + dRho_dT, & ! partial derivatives of density wrt temp (kg m-3 degC-1) + dRho_dS, & ! partial derivatives of density wrt saln (kg m-3 PPT-1) + pres, & ! pressure at each interface (Pa) + Temp_int, & ! temp and saln at interfaces + Salin_int + + real :: alpha_dT ! density difference between layers due to temp diffs (kg/m3) + real :: beta_dS ! density difference between layers due to saln diffs (kg/m3) + + real :: Rrho ! vertical density ratio + real :: diff_dd ! factor for double-diffusion + real :: prandtl ! flux ratio for diffusive convection regime + + real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio + real, parameter :: dsfmax = 1.e-4 ! max diffusivity in case of salt fingering + real, parameter :: Kv_molecular = 1.5e-6 ! molecular viscosity (m2/sec) + + integer :: i, k, is, ie, nz + is = G%isc ; ie = G%iec ; nz = G%ke + + if (associated(tv%eqn_of_state)) then + do i=is,ie + pres(i) = 0.0 ; Kd_T_dd(i,1) = 0.0 ; Kd_S_dd(i,1) = 0.0 + Kd_T_dd(i,nz+1) = 0.0 ; Kd_S_dd(i,nz+1) = 0.0 + enddo + do K=2,nz + do i=is,ie + pres(i) = pres(i) + GV%H_to_Pa*h(i,j,k-1) + Temp_Int(i) = 0.5 * (T_f(i,j,k-1) + T_f(i,j,k)) + Salin_Int(i) = 0.5 * (S_f(i,j,k-1) + S_f(i,j,k)) + enddo + call calculate_density_derivs(Temp_int, Salin_int, pres, & + dRho_dT(:), dRho_dS(:), is, ie-is+1, tv%eqn_of_state) + + do i=is,ie + alpha_dT = -1.0*dRho_dT(i) * (T_f(i,j,k-1) - T_f(i,j,k)) + beta_dS = dRho_dS(i) * (S_f(i,j,k-1) - S_f(i,j,k)) + + if ((alpha_dT > beta_dS) .and. (beta_dS > 0.0)) then ! salt finger case + Rrho = min(alpha_dT/beta_dS,Rrho0) + diff_dd = 1.0 - ((RRho-1.0)/(RRho0-1.0)) + diff_dd = dsfmax*diff_dd*diff_dd*diff_dd + Kd_T_dd(i,K) = 0.7*diff_dd + Kd_S_dd(i,K) = diff_dd + elseif ((alpha_dT < 0.) .and. (beta_dS < 0.) .and. (alpha_dT > beta_dS)) then ! diffusive convection + Rrho = alpha_dT/beta_dS + diff_dd = Kv_molecular*0.909*exp(4.6*exp(-0.54*(1/Rrho-1))) + prandtl = 0.15*Rrho + if (Rrho > 0.5) prandtl = (1.85-0.85/Rrho)*Rrho + Kd_T_dd(i,K) = diff_dd + Kd_S_dd(i,K) = prandtl*diff_dd + else + Kd_T_dd(i,K) = 0.0 ; Kd_S_dd(i,K) = 0.0 + endif + enddo + enddo + endif + +end subroutine double_diffusion + !> This routine adds diffusion sustained by flow energy extracted by bottom drag. subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & maxTKE, kb, G, GV, CS, Kd, Kd_int, Kd_BBL) @@ -1945,6 +2100,43 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp endif endif + call get_param(param_file, mdl, "DOUBLE_DIFFUSION", CS%double_diffusion, & + "If true, increase diffusivitives for temperature or salt \n"//& + "based on double-diffusive paramaterization from MOM4/KPP.", & + default=.false.) + if (CS%double_diffusion) then + call get_param(param_file, mdl, "MAX_RRHO_SALT_FINGERS", CS%Max_Rrho_salt_fingers, & + "Maximum density ratio for salt fingering regime.", & + default=2.55, units="nondim") + call get_param(param_file, mdl, "MAX_SALT_DIFF_SALT_FINGERS", CS%Max_salt_diff_salt_fingers, & + "Maximum salt diffusivity for salt fingering regime.", & + default=1.e-4, units="m2 s-1") + call get_param(param_file, mdl, "KV_MOLECULAR", CS%Kv_molecular, & + "Molecular viscosity for calculation of fluxes under \n"//& + "double-diffusive convection.", default=1.5e-6, units="m2 s-1") + ! The default molecular viscosity follows the CCSM4.0 and MOM4p1 defaults. + + CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & + 'Double-diffusive diffusivity for temperature', 'm2 s-1') + + CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & + 'Double-diffusive diffusivity for salinity', 'm2 s-1') + + if (associated(diag_to_Z_CSp)) then + vd = var_desc("KT_extra", "m2 s-1", & + "Double-Diffusive Temperature Diffusivity, interpolated to z", & + z_grid='z') + CS%id_KT_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + vd = var_desc("KS_extra", "m2 s-1", & + "Double-Diffusive Salinity Diffusivity, interpolated to z",& + z_grid='z') + CS%id_KS_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + vd = var_desc("Kd_BBL", "m2 s-1", & + "Bottom Boundary Layer Diffusivity", z_grid='z') + CS%id_Kd_BBL_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + endif + endif + if (CS%user_change_diff) then call user_change_diff_init(Time, G, param_file, diag, CS%user_change_diff_CSp) endif From 4c1a97fc72f2a541081e6c2fd3f84fd9be9b8776 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 29 May 2018 15:53:26 -0600 Subject: [PATCH 0311/1072] no longer need to scale by mask - since its done in MOM_surface_forcing --- config_src/mct_driver/ocn_cap_methods.F90 | 32 +++++++++++------------ 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index c4bed93076..1777768b36 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -45,31 +45,31 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, c1, c2, c3, c4) ice_ocean_boundary%v_flux(i,j) = x2o(ind%x2o_Foxx_tauy,k) ! liquid precipitation (rain) - ice_ocean_boundary%lprec(i,j) = x2o(ind%x2o_Faxa_rain,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%lprec(i,j) = x2o(ind%x2o_Faxa_rain,k) ! frozen precipitation (snow) - ice_ocean_boundary%fprec(i,j) = x2o(ind%x2o_Faxa_snow,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%fprec(i,j) = x2o(ind%x2o_Faxa_snow,k) ! longwave radiation, sum up and down (W/m2) - ice_ocean_boundary%lw_flux(i,j) = (x2o(ind%x2o_Faxa_lwdn,k) + x2o(ind%x2o_Foxx_lwup,k)) * GRID%mask2dT(i,j) + ice_ocean_boundary%lw_flux(i,j) = (x2o(ind%x2o_Faxa_lwdn,k) + x2o(ind%x2o_Foxx_lwup,k)) ! specific humitidy flux ice_ocean_boundary%q_flux(i,j) = x2o(ind%x2o_Foxx_evap,k) !???TODO: should this be a minus sign ! sensible heat flux (W/m2) - ice_ocean_boundary%t_flux(i,j) = x2o(ind%x2o_Foxx_sen,k) * GRID%mask2dT(i,j) !???TODO: should this be a minus sign + ice_ocean_boundary%t_flux(i,j) = x2o(ind%x2o_Foxx_sen,k) !???TODO: should this be a minus sign ! latent heat flux (W/m^2) - ice_ocean_boundary%latent_flux(i,j) = x2o(ind%x2o_Foxx_lat,k) * GRID%mask2dT(i,j) !???TODO: should this be a minus sign + ice_ocean_boundary%latent_flux(i,j) = x2o(ind%x2o_Foxx_lat,k) !???TODO: should this be a minus sign ! liquid runoff - ice_ocean_boundary%rofl_flux(i,j) = x2o(ind%x2o_Foxx_rofl,k) * GRID%mask2dT(i,j) + ice_ocean_boundary%rofl_flux(i,j) = x2o(ind%x2o_Foxx_rofl,k) ! ice runoff - ice_ocean_boundary%rofi_flux(i,j) = x2o(ind%x2o_Foxx_rofi,k) * GRID%mask2dT(i,j) + ice_ocean_boundary%rofi_flux(i,j) = x2o(ind%x2o_Foxx_rofi,k) ! surface pressure - ice_ocean_boundary%p(i,j) = x2o(ind%x2o_Sa_pslv,k) * GRID%mask2dT(i,j) + ice_ocean_boundary%p(i,j) = x2o(ind%x2o_Sa_pslv,k) ! salt flux ice_ocean_boundary%salt_flux(i,j) = x2o(ind%x2o_Fioi_salt,k) @@ -80,15 +80,15 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, c1, c2, c3, c4) ! 4) near-IR, diffuse shortwave (W/m2) if (present(c1) .and. present(c2) .and. present(c3) .and. present(c4)) then ! Use runtime coefficients to decompose net short-wave heat flux into 4 components - ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c1 * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c2 * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c3 * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c4 * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c1 + ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c2 + ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c3 + ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c4 else - ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Faxa_swvdr,k) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Faxa_swvdf,k) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Faxa_swndr,k) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Faxa_swndf,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Faxa_swvdr,k) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Faxa_swvdf,k) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Faxa_swndr,k) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Faxa_swndf,k) end if end do end do From 71e4beab97a43041587b2c668fa9662602cc6e1a Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 29 May 2018 16:06:10 -0600 Subject: [PATCH 0312/1072] Add fatal error if multiple double-diffusion options are enabled --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index d6ca59183e..f991404149 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1950,6 +1950,13 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, default=.false. ) CS%use_CVMix_ddiff = CVMix_ddiff_is_used(param_file) + + if (CS%use_CVMix_ddiff .and. differentialDiffusion) then + call MOM_error(FATAL, 'diabatic_driver_init: '// & + 'Multiple double-diffusion options selected (DOUBLE_DIFFUSION and'//& + 'USE_CVMIX_DDIFF), please disable all but one option to proceed.') + endif + CS%use_kappa_shear = kappa_shear_is_used(param_file) CS%use_CVMix_shear = CVMix_shear_is_used(param_file) From 474d664a6f023a601f061bcac9cef0d2189dde5f Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 30 May 2018 08:23:04 -0600 Subject: [PATCH 0313/1072] Set clock for double-diffusion via CVMix --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 7 +------ src/parameterizations/vertical/MOM_set_diffusivity.F90 | 6 +++++- 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index eb43f4b0c2..963547f3c0 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -251,7 +251,7 @@ module MOM_diabatic_driver integer :: id_clock_entrain, id_clock_mixedlayer, id_clock_set_diffusivity integer :: id_clock_tracers, id_clock_tridiag, id_clock_pass, id_clock_sponge integer :: id_clock_geothermal, id_clock_differential_diff, id_clock_remap -integer :: id_clock_kpp, id_clock_CVMix_ddiff +integer :: id_clock_kpp contains @@ -687,11 +687,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T) .and. .not. & CS%use_CVMix_ddiff) then - ! GMM, fix this - !call cpu_clock_begin(id_clock_CVMix_ddiff) call cpu_clock_begin(id_clock_differential_diff) call differential_diffuse_T_S(h, tv, visc, dt, G, GV) - !call cpu_clock_end(id_clock_CVMix_ddiff) call cpu_clock_end(id_clock_differential_diff) if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") @@ -2060,8 +2057,6 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, id_clock_pass = cpu_clock_id('(Ocean diabatic message passing)', grain=CLOCK_ROUTINE) id_clock_differential_diff = -1 ; if (differentialDiffusion) & id_clock_differential_diff = cpu_clock_id('(Ocean differential diffusion)', grain=CLOCK_ROUTINE) - id_clock_CVMix_ddiff = -1 ; if (CS%use_CVMix_ddiff) & - id_clock_CVMix_ddiff = cpu_clock_id('(Double diffusion via CVMix)', grain=CLOCK_ROUTINE) ! initialize the auxiliary diabatic driver module call diabatic_aux_init(Time, G, GV, param_file, diag, CS%diabatic_aux_CSp, & diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index b97583aa1c..93018c9dac 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -183,7 +183,7 @@ module MOM_set_diffusivity end type diffusivity_diags ! Clocks -integer :: id_clock_kappaShear +integer :: id_clock_kappaShear, id_clock_CVMix_ddiff contains @@ -425,7 +425,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! Apply double diffusion via CVMix ! GMM, we need to pass HBL to compute_ddiff_coeffs, but it is not yet available. if (CS%use_CVMix_ddiff) then + call cpu_clock_begin(id_clock_CVMix_ddiff) call compute_ddiff_coeffs(h, tv, G, GV, j, visc%Kd_extra_T, visc%Kd_extra_S, CS%CVMix_ddiff_csp) + call cpu_clock_end(id_clock_CVMix_ddiff) endif ! Add the input turbulent diffusivity. @@ -2154,6 +2156,8 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp ! CVMix double diffusion mixing CS%use_CVMix_ddiff = CVMix_ddiff_init(Time, G, GV, param_file, CS%diag, CS%CVMix_ddiff_csp) + if (CS%use_CVMix_ddiff) & + id_clock_CVMix_ddiff = cpu_clock_id('(Double diffusion via CVMix)', grain=CLOCK_MODULE) end subroutine set_diffusivity_init From c266f9f63c51cb4769506e06104c0b82f6774cc6 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 30 May 2018 14:56:10 -0600 Subject: [PATCH 0314/1072] First step towards using Kd_heat and Kd_salt --- .../vertical/MOM_diabatic_driver.F90 | 90 ++++++++++--------- 1 file changed, 50 insertions(+), 40 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index f283f6243a..843ecf76cd 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -281,9 +281,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - ea, & ! amount of fluid entrained from the layer above within + ea_s, & ! amount of fluid entrained from the layer above within ! one time step (m for Bouss, kg/m^2 for non-Bouss) - eb, & ! amount of fluid entrained from the layer below within + eb_s, & ! amount of fluid entrained from the layer below within + ! one time step (m for Bouss, kg/m^2 for non-Bouss) + ea_t, & ! amount of fluid entrained from the layer above within + ! one time step (m for Bouss, kg/m^2 for non-Bouss) + eb_t, & ! amount of fluid entrained from the layer below within ! one time step (m for Bouss, kg/m^2 for non-Bouss) Kd, & ! diapycnal diffusivity of layers (m^2/sec) h_orig, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) @@ -555,12 +559,34 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") + ! Set diffusivities for heat and salt + +!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,Kd_heat) +!$OMP do + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_salt(i,j,k) = Kd_int(i,j,k) + Kd_heat(i,j,k) = Kd_int(i,j,k) + enddo ; enddo ; enddo + if (associated(visc%Kd_extra_S)) then +!$OMP do + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_salt(i,j,k) = Kd_salt(i,j,k) + visc%Kd_extra_S(i,j,k) + enddo ; enddo ; enddo + endif + if (associated(visc%Kd_extra_T)) then +!$OMP do + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k) + enddo ; enddo ; enddo + endif +!$OMP end parallel + if (CS%debug) then call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G) - call hchksum(Kd, "after set_diffusivity Kd",G%HI,haloshift=0) - call hchksum(Kd_Int, "after set_diffusivity Kd_Int",G%HI,haloshift=0) + call hchksum(Kd_heat, "after set_diffusivity Kd_heat",G%HI,haloshift=0) + call hchksum(Kd_salt, "after set_diffusivity Kd_salt",G%HI,haloshift=0) endif if (CS%useKPP) then @@ -577,26 +603,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! since the matching to nonzero interior diffusivity can be problematic. ! Changes: Kd_int. Sets: KPP_NLTheat, KPP_NLTscalar -!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,Kd_heat) -!$OMP do - do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = Kd_int(i,j,k) - Kd_heat(i,j,k) = Kd_int(i,j,k) - enddo ; enddo ; enddo - if (associated(visc%Kd_extra_S)) then -!$OMP do - do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = Kd_salt(i,j,k) + visc%Kd_extra_S(i,j,k) - enddo ; enddo ; enddo - endif - if (associated(visc%Kd_extra_T)) then -!$OMP do - do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k) - enddo ; enddo ; enddo - endif -!$OMP end parallel - call KPP_compute_BLD(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, & fluxes%ustar, CS%KPP_buoy_flux) @@ -610,6 +616,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call pass_var(Hml, G%domain, halo=1) endif +! GMM, I believe the following can be deleted??? if (.not. CS%KPPisPassive) then !$OMP do do k=1,nz+1 ; do j=js,je ; do i=is,ie @@ -628,34 +635,24 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & enddo ; enddo ; enddo endif endif ! not passive + !$OMP end parallel +!!!!!!! delete above ?? !!!!!!!!!!!!! + call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") if (CS%debug) then call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) - call hchksum(Kd, "after KPP Kd",G%HI,haloshift=0) - call hchksum(Kd_Int, "after KPP Kd_Int",G%HI,haloshift=0) + call hchksum(Kd_heat, "after KPP Kd_heat",G%HI,haloshift=0) + call hchksum(Kd_salt, "after KPP Kd_salt",G%HI,haloshift=0) endif endif ! endif for KPP - ! Add vertical diff./visc. due to convection (computed via CVMix) - if (CS%use_CVMix_conv) then - call calculate_CVMix_conv(h, tv, G, GV, CS%CVMix_conv_csp, Hml) - - !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,k) = Kd_int(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) - visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) - enddo ; enddo ; enddo - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - endif if (CS%useKPP) then - call cpu_clock_begin(id_clock_kpp) if (CS%debug) then call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat",G%HI,haloshift=0, scale=GV%H_to_m) @@ -676,7 +673,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, haloshift=0) call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) endif - endif ! endif for KPP ! Differential diffusion done here. @@ -703,6 +699,20 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif + ! Add vertical diff./visc. due to convection (computed via CVMix) + if (CS%use_CVMix_conv) then + call calculate_CVMix_conv(h, tv, G, GV, CS%CVMix_conv_csp, Hml) + +!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,visc,CS,Kd_heat) +!$OMP do + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_heat(i,j,k) = Kd_heat(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) + Kd_salt(i,j,k) = Kd_salt(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) + visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) + enddo ; enddo ; enddo +!$OMP end parallel + endif + ! This block sets ea, eb from Kd or Kd_int. ! set ea=eb=Kd_int on interfaces for use in the tri-diagonal solver. From 88886d9b66cd7b7e9b7a54778bbd31d1d4b665d6 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 30 May 2018 15:27:22 -0600 Subject: [PATCH 0315/1072] Doxygenize tracer_vertdiff --- src/tracer/MOM_tracer_diabatic.F90 | 45 +++++++++++++++--------------- 1 file changed, 23 insertions(+), 22 deletions(-) diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index 0bdd327033..c8ce7700db 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -15,13 +15,13 @@ module MOM_tracer_diabatic #include public tracer_vertdiff public applyTracerBoundaryFluxesInOut + +contains + !> This subroutine solves a tridiagonal equation for the final tracer !! concentrations after the dual-entrainments, and possibly sinking or surface !! and bottom sources, are applied. The sinking is implemented with an !! fully implicit upwind advection scheme. - -contains - subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & sfc_flux, btm_flux, btm_reservoir, sink_rate, convert_flux_in) type(ocean_grid_type), intent(in) :: G !< ocean grid structure @@ -43,27 +43,28 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & logical, optional,intent(in) :: convert_flux_in !< True if the specified sfc_flux needs !! to be integrated in time - real :: sink_dist ! The distance the tracer sinks in a time step, in m or kg m-2. + ! local variables + real :: sink_dist !< The distance the tracer sinks in a time step, in m or kg m-2. real, dimension(SZI_(G),SZJ_(G)) :: & - sfc_src, & ! The time-integrated surface source of the tracer, in - ! units of m or kg m-2 times a concentration. - btm_src ! The time-integrated bottom source of the tracer, in - ! units of m or kg m-2 times a concentration. + sfc_src, & !< The time-integrated surface source of the tracer, in + !! units of m or kg m-2 times a concentration. + btm_src !< The time-integrated bottom source of the tracer, in + !! units of m or kg m-2 times a concentration. real, dimension(SZI_(G)) :: & - b1, & ! b1 is used by the tridiagonal solver, in m-1 or m2 kg-1. - d1 ! d1=1-c1 is used by the tridiagonal solver, nondimensional. - real :: c1(SZI_(G),SZK_(GV)) ! c1 is used by the tridiagonal solver, ND. - real :: h_minus_dsink(SZI_(G),SZK_(GV)) ! The layer thickness minus the - ! difference in sinking rates across the layer, in m or kg m-2. - ! By construction, 0 <= h_minus_dsink < h_work. - real :: sink(SZI_(G),SZK_(GV)+1) ! The tracer's sinking distances at the - ! interfaces, limited to prevent characteristics from - ! crossing within a single timestep, in m or kg m-2. - real :: b_denom_1 ! The first term in the denominator of b1, in m or kg m-2. - real :: h_tr ! h_tr is h at tracer points with a h_neglect added to - ! ensure positive definiteness, in m or kg m-2. - real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m. + b1, & !< b1 is used by the tridiagonal solver, in m-1 or m2 kg-1. + d1 !! d1=1-c1 is used by the tridiagonal solver, nondimensional. + real :: c1(SZI_(G),SZK_(GV)) !< c1 is used by the tridiagonal solver, ND. + real :: h_minus_dsink(SZI_(G),SZK_(GV)) !< The layer thickness minus the + !! difference in sinking rates across the layer, in m or kg m-2. + !! By construction, 0 <= h_minus_dsink < h_work. + real :: sink(SZI_(G),SZK_(GV)+1) !< The tracer's sinking distances at the + !! interfaces, limited to prevent characteristics from + !! crossing within a single timestep, in m or kg m-2. + real :: b_denom_1 !< The first term in the denominator of b1, in m or kg m-2. + real :: h_tr !< h_tr is h at tracer points with a h_neglect added to + !! ensure positive definiteness, in m or kg m-2. + real :: h_neglect !< A thickness that is so small it is usually lost + !! in roundoff and can be neglected, in m. logical :: convert_flux = .true. From c527d5a218099dfc72a4c42efcbf5b4650062106 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 30 May 2018 16:09:32 -0600 Subject: [PATCH 0316/1072] Add missing code relate to old double-diffusion method --- src/parameterizations/vertical/MOM_set_viscosity.F90 | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index ec1b09a5ad..33a7fbaa4f 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1834,7 +1834,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) real :: omega_frac_dflt integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, i, j, n logical :: use_kappa_shear, adiabatic, use_omega - logical :: use_CVMix_ddiff + logical :: use_CVMix_ddiff, differential_diffusion type(OBC_segment_type), pointer :: segment ! pointer to OBC segment type ! This include declares and sets the variable "version". #include "version_variable.h" @@ -1859,6 +1859,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) call log_version(param_file, mdl, version, "") CS%RiNo_mix = .false. ; use_CVMix_ddiff = .false. use_kappa_shear = .false. !; adiabatic = .false. ! Needed? -AJA + differential_diffusion = .false. call get_param(param_file, mdl, "BOTTOMDRAGLAW", CS%bottomdraglaw, & "If true, the bottom stress is calculated with a drag \n"//& "law of the form c_drag*|u|*u. The velocity magnitude \n"//& @@ -1885,6 +1886,10 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) if (.not.adiabatic) then use_kappa_shear = kappa_shear_is_used(param_file) CS%RiNo_mix = use_kappa_shear + call get_param(param_file, mdl, "DOUBLE_DIFFUSION", differential_diffusion, & + "If true, increase diffusivitives for temperature or salt \n"//& + "based on double-diffusive paramaterization from MOM4/KPP.", & + default=.false.) use_CVMix_ddiff = CVMix_ddiff_is_used(param_file) endif @@ -2038,7 +2043,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) Time, 'Rayleigh drag velocity at v points', 'm s-1') endif - if (use_CVMix_ddiff) then + if (use_CVMix_ddiff .or. differential_diffusion) then allocate(visc%Kd_extra_T(isd:ied,jsd:jed,nz+1)) ; visc%Kd_extra_T = 0.0 allocate(visc%Kd_extra_S(isd:ied,jsd:jed,nz+1)) ; visc%Kd_extra_S = 0.0 endif From 309b4d41c91b1abfe27b62e3e5e8beabd4be1332 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 30 May 2018 16:49:55 -0600 Subject: [PATCH 0317/1072] Fix if statement for fatal error when using double diffusion (old and CVMix) --- .../vertical/MOM_set_diffusivity.F90 | 21 +++++++++++-------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 93018c9dac..2e9b7553ab 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -284,9 +284,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & use_EOS = associated(tv%eqn_of_state) - if ((CS%use_CVMix_ddiff) .or. CS%double_diffusion .and. & - .not.(associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S)) ) & - call MOM_error(FATAL, "set_diffusivity: visc%Kd_extra_T and "//& + if (CS%use_CVMix_ddiff .or. CS%double_diffusion .and. & + .not. (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S))) & + call MOM_error(FATAL, "set_diffusivity: both visc%Kd_extra_T and "//& "visc%Kd_extra_S must be associated when USE_CVMIX_DDIFF or DOUBLE_DIFFUSION are true.") ! Set Kd, Kd_int and Kv_slow to constant values. @@ -2106,6 +2106,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp "If true, increase diffusivitives for temperature or salt \n"//& "based on double-diffusive paramaterization from MOM4/KPP.", & default=.false.) + if (CS%double_diffusion) then call get_param(param_file, mdl, "MAX_RRHO_SALT_FINGERS", CS%Max_Rrho_salt_fingers, & "Maximum density ratio for salt fingering regime.", & @@ -2118,12 +2119,6 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp "double-diffusive convection.", default=1.5e-6, units="m2 s-1") ! The default molecular viscosity follows the CCSM4.0 and MOM4p1 defaults. - CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for temperature', 'm2 s-1') - - CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for salinity', 'm2 s-1') - if (associated(diag_to_Z_CSp)) then vd = var_desc("KT_extra", "m2 s-1", & "Double-Diffusive Temperature Diffusivity, interpolated to z", & @@ -2159,6 +2154,14 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp if (CS%use_CVMix_ddiff) & id_clock_CVMix_ddiff = cpu_clock_id('(Double diffusion via CVMix)', grain=CLOCK_MODULE) + if (CS%use_CVMix_ddiff .or. CS%double_diffusion) then + CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & + 'Double-diffusive diffusivity for temperature', 'm2 s-1') + + CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & + 'Double-diffusive diffusivity for salinity', 'm2 s-1') + endif + end subroutine set_diffusivity_init !> Clear pointers and dealocate memory From 9428f515bdfb37e676947bf36606990465ddc938 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Thu, 31 May 2018 09:10:46 -0400 Subject: [PATCH 0318/1072] Changed dimensions of checksum_file to 3 - The FMS code that compares checksums in files has a dummy argument of dimension(3) but MOM6 was passing a dimension(1) variable. Only the first entry seems to be non-zero which is why things seemed to work BUT in debug mode we were hitting an out-of-array-bounds condition. --- src/framework/MOM_restart.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index d2d782e2c1..1ebe63c0da 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -1083,7 +1083,7 @@ subroutine restore_state(filename, directory, day, G, CS) real, allocatable :: time_vals(:) type(fieldtype), allocatable :: fields(:) logical :: check_exist, is_there_a_checksum - integer(kind=8),dimension(1) :: checksum_file + integer(kind=8),dimension(3) :: checksum_file integer(kind=8) :: checksum_data if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & @@ -1176,7 +1176,7 @@ subroutine restore_state(filename, directory, day, G, CS) call get_file_atts(fields(i),name=varname) if (lowercase(trim(varname)) == lowercase(trim(CS%restart_field(m)%var_name))) then check_exist = mpp_attribute_exist(fields(i),"checksum") - checksum_file = -1 + checksum_file(:) = -1 checksum_data = -1 is_there_a_checksum = .false. if ( check_exist ) then From 9e365566cc10ae102cde4c293ff02fface1c80c3 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 31 May 2018 08:52:58 -0600 Subject: [PATCH 0319/1072] Fix a bug This commit fixes a bug in the if statement that checks if visc%Kd_extra_T and visc%Kd_extra_S are associated when either use_CVMix_ddiff or double_diffusion are used. --- .../vertical/MOM_set_diffusivity.F90 | 20 +++++++++---------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 2e9b7553ab..c40b3b0a2b 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -284,9 +284,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & use_EOS = associated(tv%eqn_of_state) - if (CS%use_CVMix_ddiff .or. CS%double_diffusion .and. & - .not. (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S))) & - call MOM_error(FATAL, "set_diffusivity: both visc%Kd_extra_T and "//& + if ((CS%use_CVMix_ddiff .or. CS%double_diffusion) .and. .not. & + (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S))) & + call MOM_error(FATAL, "set_diffusivity: both visc%Kd_extra_T and "//& "visc%Kd_extra_S must be associated when USE_CVMIX_DDIFF or DOUBLE_DIFFUSION are true.") ! Set Kd, Kd_int and Kv_slow to constant values. @@ -2119,6 +2119,12 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp "double-diffusive convection.", default=1.5e-6, units="m2 s-1") ! The default molecular viscosity follows the CCSM4.0 and MOM4p1 defaults. + CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & + 'Double-diffusive diffusivity for temperature', 'm2 s-1') + + CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & + 'Double-diffusive diffusivity for salinity', 'm2 s-1') + if (associated(diag_to_Z_CSp)) then vd = var_desc("KT_extra", "m2 s-1", & "Double-Diffusive Temperature Diffusivity, interpolated to z", & @@ -2154,14 +2160,6 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp if (CS%use_CVMix_ddiff) & id_clock_CVMix_ddiff = cpu_clock_id('(Double diffusion via CVMix)', grain=CLOCK_MODULE) - if (CS%use_CVMix_ddiff .or. CS%double_diffusion) then - CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for temperature', 'm2 s-1') - - CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for salinity', 'm2 s-1') - endif - end subroutine set_diffusivity_init !> Clear pointers and dealocate memory From e15fe54cb87681d2902e41fb34df54ca9c220772 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 31 May 2018 09:04:51 -0600 Subject: [PATCH 0320/1072] Add missing code relate to old double-diffusion method --- src/parameterizations/vertical/MOM_set_viscosity.F90 | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index ec1b09a5ad..33a7fbaa4f 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1834,7 +1834,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) real :: omega_frac_dflt integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, i, j, n logical :: use_kappa_shear, adiabatic, use_omega - logical :: use_CVMix_ddiff + logical :: use_CVMix_ddiff, differential_diffusion type(OBC_segment_type), pointer :: segment ! pointer to OBC segment type ! This include declares and sets the variable "version". #include "version_variable.h" @@ -1859,6 +1859,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) call log_version(param_file, mdl, version, "") CS%RiNo_mix = .false. ; use_CVMix_ddiff = .false. use_kappa_shear = .false. !; adiabatic = .false. ! Needed? -AJA + differential_diffusion = .false. call get_param(param_file, mdl, "BOTTOMDRAGLAW", CS%bottomdraglaw, & "If true, the bottom stress is calculated with a drag \n"//& "law of the form c_drag*|u|*u. The velocity magnitude \n"//& @@ -1885,6 +1886,10 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) if (.not.adiabatic) then use_kappa_shear = kappa_shear_is_used(param_file) CS%RiNo_mix = use_kappa_shear + call get_param(param_file, mdl, "DOUBLE_DIFFUSION", differential_diffusion, & + "If true, increase diffusivitives for temperature or salt \n"//& + "based on double-diffusive paramaterization from MOM4/KPP.", & + default=.false.) use_CVMix_ddiff = CVMix_ddiff_is_used(param_file) endif @@ -2038,7 +2043,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) Time, 'Rayleigh drag velocity at v points', 'm s-1') endif - if (use_CVMix_ddiff) then + if (use_CVMix_ddiff .or. differential_diffusion) then allocate(visc%Kd_extra_T(isd:ied,jsd:jed,nz+1)) ; visc%Kd_extra_T = 0.0 allocate(visc%Kd_extra_S(isd:ied,jsd:jed,nz+1)) ; visc%Kd_extra_S = 0.0 endif From fcdd55deebe96018ec3c33c590ede0db3024597e Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 31 May 2018 09:05:09 -0600 Subject: [PATCH 0321/1072] Add missing code relate to old double-diffusion method --- .../vertical/MOM_set_diffusivity.F90 | 30 +++++++------------ 1 file changed, 10 insertions(+), 20 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 93018c9dac..fb6f25226d 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -148,22 +148,11 @@ module MOM_set_diffusivity type(int_tide_CS), pointer :: int_tide_CSp => NULL() type(tidal_mixing_cs), pointer :: tm_csp => NULL() - integer :: id_maxTKE = -1 - integer :: id_TKE_to_Kd = -1 - - integer :: id_Kd_user = -1 - integer :: id_Kd_layer = -1 - integer :: id_Kd_BBL = -1 - integer :: id_Kd_BBL_z = -1 - integer :: id_Kd_user_z = -1 - integer :: id_Kd_Work = -1 - - integer :: id_N2 = -1 - integer :: id_N2_z = -1 - integer :: id_KT_extra = -1 - integer :: id_KS_extra = -1 - integer :: id_KT_extra_z = -1 - integer :: id_KS_extra_z = -1 + integer :: id_maxTKE = -1, id_TKE_to_Kd = -1, id_Kd_user = -1 + integer :: id_Kd_layer = -1, id_Kd_BBL = -1, id_Kd_BBL_z = -1 + integer :: id_Kd_user_z = -1, id_N2 = -1, id_N2_z = -1 + integer :: id_Kd_Work = -1, id_KT_extra = -1, id_KS_extra = -1 + integer :: id_KT_extra_z = -1, id_KS_extra_z = -1 end type set_diffusivity_CS @@ -284,9 +273,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & use_EOS = associated(tv%eqn_of_state) - if ((CS%use_CVMix_ddiff) .or. CS%double_diffusion .and. & - .not.(associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S)) ) & - call MOM_error(FATAL, "set_diffusivity: visc%Kd_extra_T and "//& + if ((CS%use_CVMix_ddiff .or. CS%double_diffusion) .and. .not. & + (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S))) & + call MOM_error(FATAL, "set_diffusivity: both visc%Kd_extra_T and "//& "visc%Kd_extra_S must be associated when USE_CVMIX_DDIFF or DOUBLE_DIFFUSION are true.") ! Set Kd, Kd_int and Kv_slow to constant values. @@ -2106,6 +2095,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp "If true, increase diffusivitives for temperature or salt \n"//& "based on double-diffusive paramaterization from MOM4/KPP.", & default=.false.) + if (CS%double_diffusion) then call get_param(param_file, mdl, "MAX_RRHO_SALT_FINGERS", CS%Max_Rrho_salt_fingers, & "Maximum density ratio for salt fingering regime.", & @@ -2137,7 +2127,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp "Bottom Boundary Layer Diffusivity", z_grid='z') CS%id_Kd_BBL_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) endif - endif + endif ! old double-diffusion if (CS%user_change_diff) then call user_change_diff_init(Time, G, param_file, diag, CS%user_change_diff_CSp) From 4c36f8f9faec86a43278b09e9e2f31fdc78d7a26 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 31 May 2018 11:26:58 -0600 Subject: [PATCH 0322/1072] Computes diffusivity for salt and heat separetely This commit adds the capability to compute vertical diffusivities for salt and heat separetely (via tracer_vertdiff). --- .../vertical/MOM_diabatic_driver.F90 | 183 ++++++++++-------- 1 file changed, 106 insertions(+), 77 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index c391ceb1c2..962594ae00 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -172,8 +172,9 @@ module MOM_diabatic_driver integer :: id_cg1 = -1 ! diag handle for mode-1 speed (BDM) integer, allocatable, dimension(:) :: id_cn ! diag handle for all mode speeds (BDM) - integer :: id_dudt_dia = -1, id_dvdt_dia = -1, id_wd = -1 - integer :: id_ea = -1, id_eb = -1, id_Kd_z = -1 + integer :: id_wd = -1, id_ea = -1, id_eb = -1 ! used by layer diabatic + integer :: id_dudt_dia = -1, id_dvdt_dia = -1, id_ea_s = -1, id_eb_s = -1 + integer :: id_ea_t = -1, id_eb_t = -1, id_Kd_z = -1 integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_interface = -1, id_Kd_ePBL = -1 integer :: id_Tdif_z = -1, id_Tadv_z = -1, id_Sdif_z = -1, id_Sadv_z = -1 integer :: id_Tdif = -1, id_Tadv = -1, id_Sdif = -1, id_Sadv = -1 @@ -675,7 +676,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif endif ! endif for KPP - ! Differential diffusion done here. + ! GMM, this is the "old" method for applying differential diffusion. + ! TODO\ the following will not work with KPP. We need to add a FATAL + ! error to avoid that. + ! Changes: tv%T, tv%S ! If using matching within the KPP scheme, then this step needs to provide ! a diffusivity and happen before KPP. But generally in MOM, we do not match @@ -693,18 +697,21 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! increment heat and salt diffusivity. ! CS%useKPP==.true. already has extra_T and extra_S included if (.not. CS%useKPP) then +!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,visc,Kd_heat) +!$OMP do do K=2,nz ; do j=js,je ; do i=is,ie Kd_heat(i,j,K) = Kd_heat(i,j,K) + visc%Kd_extra_T(i,j,K) Kd_salt(i,j,K) = Kd_salt(i,j,K) + visc%Kd_extra_S(i,j,K) enddo ; enddo ; enddo +!$OMP end parallel endif endif - ! Add vertical diff./visc. due to convection (computed via CVMix) + ! Calculate vertical mixing due to convection (computed via CVMix) if (CS%use_CVMix_conv) then call calculate_CVMix_conv(h, tv, G, GV, CS%CVMix_conv_csp, Hml) - + ! Increment vertical diffusion and viscosity due to convection !$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,visc,CS,Kd_heat) !$OMP do do k=1,nz+1 ; do j=js,je ; do i=is,ie @@ -716,23 +723,26 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif - ! This block sets ea, eb from Kd or Kd_int. - ! set ea=eb=Kd_int on interfaces for use in the tri-diagonal solver. + ! set ea_t=eb_t=Kd_heat and ea_s=eb_s=Kd_salt on interfaces for use in the + ! tri-diagonal solver. do j=js,je ; do i=is,ie - ea(i,j,1) = 0. + ea_t(i,j,1) = 0.; ea_s(i,j,1) = 0. enddo ; enddo -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_neglect,h,ea,GV,dt,Kd_int,eb) & + +!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_neglect,h,ea_t,ea_s,GV,dt,Kd_salt,Kd_heat,eb_t,eb_s) & !$OMP private(hval) do k=2,nz ; do j=js,je ; do i=is,ie hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_int(i,j,k) - eb(i,j,k-1) = ea(i,j,k) + ea_t(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_heat(i,j,k) + eb_t(i,j,k-1) = ea_t(i,j,k) + ea_s(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_salt(i,j,k) + eb_s(i,j,k-1) = ea_s(i,j,k) enddo ; enddo ; enddo do j=js,je ; do i=is,ie - eb(i,j,nz) = 0. + eb_t(i,j,nz) = 0.; eb_s(i,j,nz) = 0. enddo ; enddo - if (showCallTree) call callTree_waypoint("done setting ea,eb from Kd_int (diabatic)") + if (showCallTree) call callTree_waypoint("done setting ea_t,ea_s,eb_t,eb_s from Kd_heat and Kd_salt (diabatic)") ! Save fields before boundary forcing is applied for tendency diagnostics if (CS%boundary_forcing_tendency_diag) then @@ -758,8 +768,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux) if (CS%debug) then - call hchksum(ea, "after applyBoundaryFluxes ea",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "after applyBoundaryFluxes eb",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(ea_t, "after applyBoundaryFluxes ea_t",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_t, "after applyBoundaryFluxes eb_t",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(ea_s, "after applyBoundaryFluxes ea_s",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_s, "after applyBoundaryFluxes eb_s",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(cTKE, "after applyBoundaryFluxes cTKE",G%HI,haloshift=0) call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT",G%HI,haloshift=0) call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS",G%HI,haloshift=0) @@ -787,8 +799,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif Ent_int = Kd_add_here * (GV%m_to_H**2 * dt) / & (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) - eb(i,j,k-1) = eb(i,j,k-1) + Ent_int - ea(i,j,k) = ea(i,j,k) + Ent_int + eb_t(i,j,k-1) = eb_t(i,j,k-1) + Ent_int + ea_t(i,j,k) = ea_t(i,j,k) + Ent_int + eb_s(i,j,k-1) = eb_s(i,j,k-1) + Ent_int + ea_s(i,j,k) = ea_s(i,j,k) + Ent_int Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here ! for diagnostics @@ -798,8 +812,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & enddo ; enddo ; enddo if (CS%debug) then - call hchksum(ea, "after ePBL ea",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "after ePBL eb",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(ea_t, "after ePBL ea_t",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_t, "after ePBL eb_t",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(ea_s, "after ePBL ea_s",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_s, "after ePBL eb_s",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(Kd_ePBL, "after ePBL Kd_ePBL",G%HI,haloshift=0) endif @@ -844,9 +860,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & do j=js,je do i=is,ie hold(i,j,1) = h(i,j,1) - h(i,j,1) = h(i,j,1) + (eb(i,j,1) - ea(i,j,2)) + h(i,j,1) = h(i,j,1) + (eb_t(i,j,1) - ea_t(i,j,2)) hold(i,j,nz) = h(i,j,nz) - h(i,j,nz) = h(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)) + h(i,j,nz) = h(i,j,nz) + (ea_t(i,j,nz) - eb_t(i,j,nz-1)) if (h(i,j,1) <= 0.0) then h(i,j,1) = GV%Angstrom endif @@ -856,8 +872,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & enddo do k=2,nz-1 ; do i=is,ie hold(i,j,k) = h(i,j,k) - h(i,j,k) = h(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & - (eb(i,j,k) - ea(i,j,k+1))) + h(i,j,k) = h(i,j,k) + ((ea_t(i,j,k) - eb_t(i,j,k-1)) + & + (eb_t(i,j,k) - ea_t(i,j,k+1))) if (h(i,j,k) <= 0.0) then h(i,j,k) = GV%Angstrom endif @@ -871,6 +887,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call MOM_forcing_chksum("after negative check ", fluxes, G, haloshift=0) call MOM_thermovar_chksum("after negative check ", tv, G) endif + if (showCallTree) call callTree_waypoint("done with h=ea-eb (diabatic)") if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G) @@ -879,11 +896,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (associated(tv%T)) then if (CS%debug) then - call hchksum(ea, "before triDiagTS ea ",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "before triDiagTS eb ",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(ea_t, "before triDiagTS ea_t ",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_t, "before triDiagTS eb_t ",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(ea_s, "before triDiagTS ea_s ",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_s, "before triDiagTS eb_s ",G%HI,haloshift=0, scale=GV%H_to_m) endif - call cpu_clock_begin(id_clock_tridiag) + call cpu_clock_begin(id_clock_tridiag) ! Keep salinity from falling below a small but positive threshold. ! This constraint is needed for SIS1 ice model, which can extract ! more salt than is present in the ocean. SIS2 does not suffer @@ -901,13 +920,20 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif ! Changes T and S via the tridiagonal solver; no change to h - if (CS%tracer_tridiag) then - call tracer_vertdiff(hold, ea, eb, dt, tv%T, G, GV) - call tracer_vertdiff(hold, ea, eb, dt, tv%S, G, GV) - else + call tracer_vertdiff(hold, ea_t, eb_t, dt, tv%T, G, GV) + call tracer_vertdiff(hold, ea_s, eb_s, dt, tv%S, G, GV) - call triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, tv%T, tv%S) - endif + ! GMM, with the new approach of having ea,eb for temp and salt + ! only tracer_vertdiff can be used at this time. Therefore, + ! I am commenting the following code. Should this be deleted? + + !if (CS%tracer_tridiag) then + ! call tracer_vertdiff(hold, ea_t, eb_t, dt, tv%T, G, GV) + ! call tracer_vertdiff(hold, ea_s, eb_s, dt, tv%S, G, GV) + !else + ! + ! call triDiagTS(G, GV, is, ie, js, je, hold, ea_t, eb_t, tv%T, tv%S) + !endif ! diagnose temperature, salinity, heat, and salt tendencies ! Note: hold here refers to the thicknesses from before the dual-entraintment when using @@ -917,8 +943,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, CS) if (CS%id_diabatic_diff_h > 0) call post_data(CS%id_diabatic_diff_h, hold, CS%diag, alt_h = hold) endif - call cpu_clock_end(id_clock_tridiag) + if (showCallTree) call callTree_waypoint("done with triDiagTS (diabatic)") endif ! endif corresponding to if (associated(tv%T)) @@ -928,8 +954,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debug) then call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, haloshift=0) call MOM_thermovar_chksum("after mixed layer ", tv, G) - call hchksum(ea, "after mixed layer ea", G%HI, scale=GV%H_to_m) - call hchksum(eb, "after mixed layer eb", G%HI, scale=GV%H_to_m) endif ! Whenever thickness changes let the diag manager know, as the @@ -945,9 +969,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & enddo ; enddo !$OMP parallel do default(shared) do K=2,nz ; do j=js,je ; do i=is,ie - Tdif_flx(i,j,K) = (Idt * 0.5*(ea(i,j,k) + eb(i,j,k-1))) * & + Tdif_flx(i,j,K) = (Idt * 0.5*(ea_t(i,j,k) + eb_t(i,j,k-1))) * & (tv%T(i,j,k-1) - tv%T(i,j,k)) - Tadv_flx(i,j,K) = (Idt * (ea(i,j,k) - eb(i,j,k-1))) * & + Tadv_flx(i,j,K) = (Idt * (ea_t(i,j,k) - eb_t(i,j,k-1))) * & 0.5*(tv%T(i,j,k-1) + tv%T(i,j,k)) enddo ; enddo ; enddo endif @@ -959,9 +983,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & enddo ; enddo !$OMP parallel do default(shared) do K=2,nz ; do j=js,je ; do i=is,ie - Sdif_flx(i,j,K) = (Idt * 0.5*(ea(i,j,k) + eb(i,j,k-1))) * & + Sdif_flx(i,j,K) = (Idt * 0.5*(ea_s(i,j,k) + eb_s(i,j,k-1))) * & (tv%S(i,j,k-1) - tv%S(i,j,k)) - Sadv_flx(i,j,K) = (Idt * (ea(i,j,k) - eb(i,j,k-1))) * & + Sadv_flx(i,j,K) = (Idt * (ea_s(i,j,k) - eb_s(i,j,k-1))) * & 0.5*(tv%S(i,j,k-1) + tv%S(i,j,k)) enddo ; enddo ; enddo endif @@ -974,7 +998,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je do i=is,ie - ebtr(i,j,nz) = eb(i,j,nz) + ebtr(i,j,nz) = eb_s(i,j,nz) htot(i) = 0.0 in_boundary(i) = (G%mask2dT(i,j) > 0.0) enddo @@ -992,19 +1016,20 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & add_ent = ((dt * CS%Kd_min_tr) * GV%m_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & - 0.5*(ea(i,j,k) + eb(i,j,k-1)) + 0.5*(ea_s(i,j,k) + eb_s(i,j,k-1)) if (htot(i) < Tr_ea_BBL) then add_ent = max(0.0, add_ent, & - (Tr_ea_BBL - htot(i)) - min(ea(i,j,k),eb(i,j,k-1))) + (Tr_ea_BBL - htot(i)) - min(ea_s(i,j,k),eb_s(i,j,k-1))) elseif (add_ent < 0.0) then add_ent = 0.0 ; in_boundary(i) = .false. endif - ebtr(i,j,k-1) = eb(i,j,k-1) + add_ent - eatr(i,j,k) = ea(i,j,k) + add_ent + ebtr(i,j,k-1) = eb_s(i,j,k-1) + add_ent + eatr(i,j,k) = ea_s(i,j,k) + add_ent else - ebtr(i,j,k-1) = eb(i,j,k-1) ; eatr(i,j,k) = ea(i,j,k) + ebtr(i,j,k-1) = eb_s(i,j,k-1) ; eatr(i,j,k) = ea_s(i,j,k) endif + if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / & (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & @@ -1013,13 +1038,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & eatr(i,j,k) = eatr(i,j,k) + add_ent endif ; endif enddo ; enddo - do i=is,ie ; eatr(i,j,1) = ea(i,j,1) ; enddo + do i=is,ie ; eatr(i,j,1) = ea_s(i,j,1) ; enddo enddo ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied ! so hold should be h_orig - call call_tracer_column_fns(h_prebound, h, ea, eb, fluxes, Hml, dt, G, GV, tv, & + call call_tracer_column_fns(h_prebound, h, ea_s, eb_s, fluxes, Hml, dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug, & evap_CFL_limit = CS%evap_CFL_limit, & minimum_forcing_depth = CS%minimum_forcing_depth) @@ -1027,7 +1052,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & elseif (associated(visc%Kd_extra_S)) then ! extra diffusivity for passive tracers do j=js,je ; do i=is,ie - ebtr(i,j,nz) = eb(i,j,nz) ; eatr(i,j,1) = ea(i,j,1) + ebtr(i,j,nz) = eb_s(i,j,nz) ; eatr(i,j,1) = ea_s(i,j,1) enddo ; enddo !$OMP parallel do default(shared) private(add_ent) do k=nz,2,-1 ; do j=js,je ; do i=is,ie @@ -1038,8 +1063,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & else add_ent = 0.0 endif - ebtr(i,j,k-1) = eb(i,j,k-1) + add_ent - eatr(i,j,k) = ea(i,j,k) + add_ent + ebtr(i,j,k-1) = eb_s(i,j,k-1) + add_ent + eatr(i,j,k) = ea_s(i,j,k) + add_ent enddo ; enddo ; enddo ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied @@ -1075,30 +1100,24 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif ! CS%use_sponge -! Save the diapycnal mass fluxes as a diagnostic field. - if (associated(CDp%diapyc_vel)) then - !$OMP parallel do default(shared) - do j=js,je - do K=2,nz ; do i=is,ie - CDp%diapyc_vel(i,j,K) = Idt * (GV%H_to_m * (ea(i,j,k) - eb(i,j,k-1))) - enddo ; enddo - do i=is,ie - CDp%diapyc_vel(i,j,1) = 0.0 - CDp%diapyc_vel(i,j,nz+1) = 0.0 - enddo - enddo - endif - ! Initialize halo regions of ea, eb, and hold to default values. !$OMP parallel do default(shared) do k=1,nz do i=is-1,ie+1 - hold(i,js-1,k) = GV%Angstrom ; ea(i,js-1,k) = 0.0 ; eb(i,js-1,k) = 0.0 - hold(i,je+1,k) = GV%Angstrom ; ea(i,je+1,k) = 0.0 ; eb(i,je+1,k) = 0.0 + hold(i,js-1,k) = GV%Angstrom + ea_t(i,js-1,k) = 0.0 ; eb_t(i,js-1,k) = 0.0 + ea_s(i,js-1,k) = 0.0 ; eb_s(i,js-1,k) = 0.0 + hold(i,je+1,k) = GV%Angstrom + ea_t(i,je+1,k) = 0.0 ; eb_t(i,je+1,k) = 0.0 + ea_s(i,je+1,k) = 0.0 ; eb_s(i,je+1,k) = 0.0 enddo do j=js,je - hold(is-1,j,k) = GV%Angstrom ; ea(is-1,j,k) = 0.0 ; eb(is-1,j,k) = 0.0 - hold(ie+1,j,k) = GV%Angstrom ; ea(ie+1,j,k) = 0.0 ; eb(ie+1,j,k) = 0.0 + hold(is-1,j,k) = GV%Angstrom + ea_t(is-1,j,k) = 0.0 ; eb_t(is-1,j,k) = 0.0 + ea_s(is-1,j,k) = 0.0 ; eb_s(is-1,j,k) = 0.0 + hold(ie+1,j,k) = GV%Angstrom + ea_t(ie+1,j,k) = 0.0 ; eb_t(ie+1,j,k) = 0.0 + ea_s(ie+1,j,k) = 0.0 ; eb_s(ie+1,j,k) = 0.0 enddo enddo @@ -1106,10 +1125,12 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (G%symmetric) then ; dir_flag = To_All+Omit_Corners else ; dir_flag = To_West+To_South+Omit_Corners ; endif call create_group_pass(CS%pass_hold_eb_ea, hold, G%Domain, dir_flag, halo=1) - call create_group_pass(CS%pass_hold_eb_ea, eb, G%Domain, dir_flag, halo=1) - call create_group_pass(CS%pass_hold_eb_ea, ea, G%Domain, dir_flag, halo=1) + call create_group_pass(CS%pass_hold_eb_ea, eb_t, G%Domain, dir_flag, halo=1) + call create_group_pass(CS%pass_hold_eb_ea, eb_s, G%Domain, dir_flag, halo=1) + call create_group_pass(CS%pass_hold_eb_ea, ea_t, G%Domain, dir_flag, halo=1) + call create_group_pass(CS%pass_hold_eb_ea, ea_s, G%Domain, dir_flag, halo=1) call do_group_pass(CS%pass_hold_eb_ea, G%Domain) - ! visc%Kv_shear is not in the group pass because it has larger vertical extent. + ! visc%Kv_shear and visc%Kv_slow are not in the group pass because it has larger vertical extent. if (associated(visc%Kv_shear)) & call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) if (associated(visc%Kv_slow)) & @@ -1154,12 +1175,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%id_Kd_salt > 0) call post_data(CS%id_Kd_salt, Kd_salt, CS%diag) if (CS%id_Kd_ePBL > 0) call post_data(CS%id_Kd_ePBL, Kd_ePBL, CS%diag) - if (CS%id_ea > 0) call post_data(CS%id_ea, ea, CS%diag) - if (CS%id_eb > 0) call post_data(CS%id_eb, eb, CS%diag) + if (CS%id_ea_t > 0) call post_data(CS%id_ea_t, ea_t, CS%diag) + if (CS%id_eb_t > 0) call post_data(CS%id_eb_t, eb_t, CS%diag) + if (CS%id_ea_s > 0) call post_data(CS%id_ea_s, ea_s, CS%diag) + if (CS%id_eb_s > 0) call post_data(CS%id_eb_s, eb_s, CS%diag) if (CS%id_dudt_dia > 0) call post_data(CS%id_dudt_dia, ADp%du_dt_dia, CS%diag) if (CS%id_dvdt_dia > 0) call post_data(CS%id_dvdt_dia, ADp%dv_dt_dia, CS%diag) - if (CS%id_wd > 0) call post_data(CS%id_wd, CDp%diapyc_vel, CS%diag) if (CS%id_MLD_003 > 0 .or. CS%id_subMLN2 > 0 .or. CS%id_mlotstsq > 0) then call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03, G, GV, CS%diag, & @@ -1720,16 +1742,24 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, if (GV%Boussinesq) then ; thickness_units = "m" else ; thickness_units = "kg m-2" ; endif + ! used by layer diabatic CS%id_ea = register_diag_field('ocean_model','ea',diag%axesTL,Time, & 'Layer entrainment from above per timestep','m') CS%id_eb = register_diag_field('ocean_model','eb',diag%axesTL,Time, & 'Layer entrainment from below per timestep', 'm') + + CS%id_ea_t = register_diag_field('ocean_model','ea_t',diag%axesTL,Time, & + 'Layer (heat) entrainment from above per timestep','m') + CS%id_eb_t = register_diag_field('ocean_model','eb_t',diag%axesTL,Time, & + 'Layer (heat) entrainment from below per timestep', 'm') + CS%id_ea_s = register_diag_field('ocean_model','ea_s',diag%axesTL,Time, & + 'Layer (salt) entrainment from above per timestep','m') + CS%id_eb_s = register_diag_field('ocean_model','eb_s',diag%axesTL,Time, & + 'Layer (salt) entrainment from below per timestep', 'm') CS%id_dudt_dia = register_diag_field('ocean_model','dudt_dia',diag%axesCuL,Time, & 'Zonal Acceleration from Diapycnal Mixing', 'm s-2') CS%id_dvdt_dia = register_diag_field('ocean_model','dvdt_dia',diag%axesCvL,Time, & 'Meridional Acceleration from Diapycnal Mixing', 'm s-2') - CS%id_wd = register_diag_field('ocean_model','wd',diag%axesTi,Time, & - 'Diapycnal Velocity', 'm s-1') if (CS%use_int_tides) then CS%id_cg1 = register_diag_field('ocean_model','cn1', diag%axesT1, & Time, 'First baroclinic mode (eigen) speed', 'm s-1') @@ -1799,7 +1829,6 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, if (CS%id_dudt_dia > 0) call safe_alloc_ptr(ADp%du_dt_dia,IsdB,IedB,jsd,jed,nz) if (CS%id_dvdt_dia > 0) call safe_alloc_ptr(ADp%dv_dt_dia,isd,ied,JsdB,JedB,nz) - if (CS%id_wd > 0) call safe_alloc_ptr(CDp%diapyc_vel,isd,ied,jsd,jed,nz+1) ! diagnostics for values prior to diabatic and prior to ALE CS%id_u_predia = register_diag_field('ocean_model', 'u_predia', diag%axesCuL, Time, & From e12d9525fff79e46cff9a42118508769fca66f08 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 31 May 2018 13:14:14 -0600 Subject: [PATCH 0323/1072] fix a typo in ocn_comp_mct.F90 --- config_src/mct_driver/ocn_comp_mct.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index c3967caf6d..aece6abebc 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -1772,7 +1772,7 @@ subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, & call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid) if (OS%nstep==0) then - call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, S%restart_CSp) + call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%restart_CSp) endif call disable_averaging(OS%diag) From b2fac04eb9924032363ba79876c1e995b77c3987 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 31 May 2018 18:43:55 -0600 Subject: [PATCH 0324/1072] add multi-smoothing and deepening-only smoothing options --- src/parameterizations/vertical/MOM_KPP.F90 | 78 +++++++++++++--------- 1 file changed, 46 insertions(+), 32 deletions(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index da59d487cc..aee9b28b7e 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -88,7 +88,8 @@ module MOM_KPP character(len=30) :: MatchTechnique !< Method used in CVMix for setting diffusivity and NLT profile functions integer :: NLT_shape !< MOM6 over-ride of CVMix NLT shape function logical :: applyNonLocalTrans !< If True, apply non-local transport to heat and scalars - logical :: smoothBLD !< If True, apply a 1-1-4-1-1 Laplacian filter one time on HBLT. + integer :: n_smooth !< Number of times smoothing operator is applied on OBLdepth. + logical :: deepen_only !< If true, apply OBLdepth smoothing at a cell only if the OBLdepth gets deeper. logical :: KPPzeroDiffusivity !< If True, will set diffusivity and viscosity from KPP to zero !! for testing purposes. logical :: KPPisAdditive !< If True, will add KPP diffusivity to initial diffusivity. @@ -216,10 +217,16 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive, Waves) 'If False, calculates the non-local transport and tendencies but\n'//& 'purely for diagnostic purposes.', & default=.not. CS%passiveMode) - call get_param(paramFile, mdl, 'SMOOTH_BLD', CS%smoothBLD, & - 'If True, applies a 1-1-4-1-1 Laplacian filter one time on HBLT.\n'// & - 'computed via CVMix to reduce any horizontal two-grid-point noise.', & - default=.false.) + call get_param(paramFile, mdl, 'N_SMOOTH', CS%n_smooth, & + 'The number of times the 1-1-4-1-1 Laplacian filter is applied on\n'// & + 'OBL depth.', & + default=0) + if (CS%n_smooth > 0) then + call get_param(paramFile, mdl, 'DEEPEN_ONLY_VIA_SMOOTHING', CS%deepen_only, & + 'If true, apply OBLdepth smoothing at a cell only if the OBLdepth.\n'// & + 'gets deeper via smoothing.', & + default=.false.) + endif call get_param(paramFile, mdl, 'RI_CRIT', CS%Ri_crit, & 'Critical bulk Richardson number used to define depth of the\n'// & 'surface Ocean Boundary Layer (OBL).', & @@ -1498,7 +1505,7 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux, enddo enddo - if (CS%smoothBLD) call KPP_smooth_BLD(CS,G,GV,h) + if (CS%n_smooth > 0) call KPP_smooth_BLD(CS,G,GV,h) end subroutine KPP_compute_BLD @@ -1518,38 +1525,45 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) real :: wc, ww, we, wn, ws ! averaging weights for smoothing real :: dh ! The local thickness used for calculating interface positions (m) real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) - integer :: i, j, k + integer :: i, j, k, s - ! Update halos - call pass_var(CS%OBLdepth, G%Domain) + do s=1,CS%n_smooth - OBLdepth_original = CS%OBLdepth - CS%OBLdepth_original = OBLdepth_original + ! Update halos + call pass_var(CS%OBLdepth, G%Domain) - ! apply smoothing on OBL depth - do j = G%jsc, G%jec - do i = G%isc, G%iec + OBLdepth_original = CS%OBLdepth + CS%OBLdepth_original = OBLdepth_original - ! skip land points - if (G%mask2dT(i,j)==0.) cycle + ! apply smoothing on OBL depth + do j = G%jsc, G%jec + do i = G%isc, G%iec - ! compute weights - ww = 0.125 * G%mask2dT(i-1,j) - we = 0.125 * G%mask2dT(i+1,j) - ws = 0.125 * G%mask2dT(i,j-1) - wn = 0.125 * G%mask2dT(i,j+1) - wc = 1.0 - (ww+we+wn+ws) - - CS%OBLdepth(i,j) = wc * OBLdepth_original(i,j) & - + ww * OBLdepth_original(i-1,j) & - + we * OBLdepth_original(i+1,j) & - + ws * OBLdepth_original(i,j-1) & - + wn * OBLdepth_original(i,j+1) + ! skip land points + if (G%mask2dT(i,j)==0.) cycle + + ! compute weights + ww = 0.125 * G%mask2dT(i-1,j) + we = 0.125 * G%mask2dT(i+1,j) + ws = 0.125 * G%mask2dT(i,j-1) + wn = 0.125 * G%mask2dT(i,j+1) + wc = 1.0 - (ww+we+wn+ws) + + CS%OBLdepth(i,j) = wc * OBLdepth_original(i,j) & + + ww * OBLdepth_original(i-1,j) & + + we * OBLdepth_original(i+1,j) & + + ws * OBLdepth_original(i,j-1) & + + wn * OBLdepth_original(i,j+1) + enddo enddo - enddo - ! prevent OBL depths deeper than the bathymetric depth - where (CS%OBLdepth > G%bathyT) CS%OBLdepth = G%bathyT + ! Apply OBLdepth smoothing at a cell only if the OBLdepth gets deeper via smoothing. + if (CS%deepen_only) CS%OBLdepth = max(CS%OBLdepth,CS%OBLdepth_original) + + ! prevent OBL depths deeper than the bathymetric depth + where (CS%OBLdepth > G%bathyT) CS%OBLdepth = G%bathyT + + enddo ! s-loop ! Update kOBL for smoothed OBL depths do j = G%jsc, G%jec @@ -1571,7 +1585,7 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) iFaceHeight(k+1) = iFaceHeight(k) - dh enddo - CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) + CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) enddo enddo From 21d1038b65d14f9337d60f4412fc0fed27d667aa Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 31 May 2018 18:51:36 -0600 Subject: [PATCH 0325/1072] Check if Kv is associated before updating it --- .../vertical/MOM_tidal_mixing.F90 | 23 +++++++++---------- 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index b659e9149a..226f7c4918 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -754,9 +754,11 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) enddo ! Update viscosity - do k=1,G%ke+1 - Kv(i,j,k) = Kv(i,j,k) + Kv_tidal(k) - enddo + if (associated(Kv)) then + do k=1,G%ke+1 + Kv(i,j,k) = Kv(i,j,k) + Kv_tidal(k) + enddo + endif ! diagnostics if (associated(dd%Kd_itidal)) then @@ -851,9 +853,11 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) enddo ! Update viscosity - do k=1,G%ke+1 - Kv(i,j,k) = Kv(i,j,k) + Kv_tidal(k) - enddo + if (associated(Kv)) then + do k=1,G%ke+1 + Kv(i,j,k) = Kv(i,j,k) + Kv_tidal(k) + enddo + endif ! diagnostics if (associated(dd%Kd_itidal)) then @@ -903,12 +907,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int real, intent(inout) :: Kd_max - ! This subroutine adds the effect of internal-tide-driven mixing to the layer diffusivities. - ! The mechanisms considered are (1) local dissipation of internal waves generated by the - ! barotropic flow ("itidal"), (2) local dissipation of internal waves generated by the propagating - ! low modes (rays) of the internal tide ("lowmode"), and (3) local dissipation of internal lee waves. - ! Will eventually need to add diffusivity due to other wave-breaking processes (e.g. Bottom friction, - ! Froude-number-depending breaking, PSI, etc.). + ! local real, dimension(SZI_(G)) :: & htot, & ! total thickness above or below a layer, or the From d09eba7c64d50f8e6bc125c9019448438975df16 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 1 Jun 2018 06:06:34 -0400 Subject: [PATCH 0326/1072] dOxyGenized arguments in MOM_ice_shelf code dOxyGenized numerous arguments and cleaned up code and variable names in various auxiliary ice_shelf code. All answers are bitwise identical. --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 40 +++-- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 167 ++++++++++++--------- src/ice_shelf/user_shelf_init.F90 | 123 ++++++--------- 3 files changed, 166 insertions(+), 164 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index bf8b6ddba4..b974f208fa 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -1022,7 +1022,8 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u, v real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: taudx, taudy, H_node real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: float_cond - real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: hmask + real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: hmask !< A mask indicating which tracer points are + !! partly or fully covered by an ice-shelf integer, intent(out) :: conv_flag, iters type(time_type), intent(in) :: Time !< The current model time real, dimension(SZDI_(G),SZDJ_(G),8,4), intent(in) :: Phi @@ -1393,7 +1394,8 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step !< The time step for this update, in s. - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask !< A mask indicating which tracer points are + !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h0 real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_uflux real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter @@ -1616,7 +1618,8 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step !< The time step for this update, in s. - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask !< A mask indicating which tracer points are + !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h_after_uflux real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_vflux real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter @@ -1989,11 +1992,12 @@ end subroutine shelf_advance_front subroutine ice_shelf_min_thickness_calve(G, h_shelf, area_shelf_h, hmask, thickness_calve) type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf + intent(inout) :: h_shelf !< The ice shelf thickness, in m. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: area_shelf_h + intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: hmask + intent(inout) :: hmask !< A mask indicating which tracer points are + !! partly or fully covered by an ice-shelf real, intent(in) :: thickness_calve integer :: i,j @@ -2014,9 +2018,13 @@ end subroutine ice_shelf_min_thickness_calve subroutine calve_to_mask(G, h_shelf, area_shelf_h, hmask, calve_mask) type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_shelf - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: area_shelf_h - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: h_shelf !< The ice shelf thickness, in m. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: hmask !< A mask indicating which tracer points are + !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: calve_mask integer :: i,j @@ -2229,7 +2237,7 @@ subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new type(time_type), intent(in) :: Time !< The current model time real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are - !! partly or fully coupled by an ice-shelf + !! partly or fully covered by an ice-shelf real, intent(in) :: input_flux, input_thick logical, optional, intent(in) :: new_sim !< If present and false, this run is being restarted @@ -2546,7 +2554,7 @@ subroutine matrix_diagonal(CS, G, float_cond, H_node, nu, beta, hmask, dens_rati real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: beta real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are - !! partly or fully coupled by an ice-shelf + !! partly or fully covered by an ice-shelf real :: dens_ratio real, dimension(:,:,:,:,:,:), intent(in) :: Phisub real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u_diagonal, v_diagonal @@ -3133,7 +3141,7 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are - !! partly or fully coupled by an ice-shelf + !! partly or fully covered by an ice-shelf real, dimension(SZDIB_(G),SZDJB_(G)), & intent(out) :: umask !< A coded mask indicating the nature of the !! zonal flow at the corner point @@ -3291,7 +3299,7 @@ subroutine interpolate_H_to_B(G, h_shelf, hmask, H_node) intent(in) :: h_shelf !< The ice shelf thickness at tracer points, in m. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are - !! partly or fully coupled by an ice-shelf + !! partly or fully covered by an ice-shelf real, dimension(SZDIB_(G),SZDJB_(G)), & intent(inout) :: H_node !< The ice shelf thickness at nodal (corner) !! points, in m. @@ -3498,7 +3506,8 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step !< The time step for this update, in s. - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask !< A mask indicating which tracer points are + !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h0 real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_uflux real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter @@ -3732,7 +3741,8 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step !< The time step for this update, in s. - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask + real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask !< A mask indicating which tracer points are + !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h_after_uflux real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_vflux real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 38d56e7481..8dcacb3e60 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -11,19 +11,6 @@ module MOM_ice_shelf_initialize implicit none ; private #include -#ifdef SYMMETRIC_LAND_ICE -# define GRID_SYM_ .true. -# define NIMEMQ_IS_ NIMEMQS_ -# define NJMEMQ_IS_ NJMEMQS_ -# define ISUMSTART_INT_ CS%grid%iscq+1 -# define JSUMSTART_INT_ CS%grid%jscq+1 -#else -# define GRID_SYM_ .false. -# define NIMEMQ_IS_ NIMEMQ_ -# define NJMEMQ_IS_ NJMEMQ_ -# define ISUMSTART_INT_ CS%grid%iscq -# define JSUMSTART_INT_ CS%grid%jscq -#endif !MJHpublic initialize_ice_shelf_boundary, initialize_ice_thickness @@ -33,9 +20,15 @@ module MOM_ice_shelf_initialize subroutine initialize_ice_thickness (h_shelf, area_shelf_h, hmask, G, PF) - real, intent(inout), dimension(:,:) :: h_shelf, area_shelf_h, hmask - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(param_file_type), intent(in) :: PF + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: h_shelf !< The ice shelf thickness, in m. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: hmask !< A mask indicating which tracer points are + !! partly or fully covered by an ice-shelf + type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters character(len=40) :: mdl = "initialize_ice_thickness" ! This subroutine's name. character(len=200) :: config @@ -58,9 +51,15 @@ end subroutine initialize_ice_thickness subroutine initialize_ice_thickness_from_file (h_shelf, area_shelf_h, hmask, G, PF) - real, intent(inout), dimension(:,:) :: h_shelf, area_shelf_h, hmask - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(param_file_type), intent(in) :: PF + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: h_shelf !< The ice shelf thickness, in m. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: hmask !< A mask indicating which tracer points are + !! partly or fully covered by an ice-shelf + type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters ! This subroutine reads ice thickness and area from a file and puts it into ! h_shelf and area_shelf_h in m (and dimensionless) and updates hmask @@ -139,9 +138,15 @@ end subroutine initialize_ice_thickness_from_file subroutine initialize_ice_thickness_channel (h_shelf, area_shelf_h, hmask, G, PF) - real, intent(inout), dimension(:,:) :: h_shelf, area_shelf_h, hmask - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(param_file_type), intent(in) :: PF + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: h_shelf !< The ice shelf thickness, in m. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: hmask !< A mask indicating which tracer points are + !! partly or fully covered by an ice-shelf + type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters character(len=40) :: mdl = "initialize_ice_shelf_thickness_channel" ! This subroutine's name. real :: max_draft, min_draft, flat_shelf_width, c1, slope_pos @@ -218,22 +223,34 @@ subroutine initialize_ice_thickness_channel (h_shelf, area_shelf_h, hmask, G, PF end subroutine initialize_ice_thickness_channel -!BEGIN MJH subroutine initialize_ice_shelf_boundary ( & -! u_face_mask_boundary, & -! v_face_mask_boundary, & -! u_flux_boundary_values, & -! v_flux_boundary_values, & -! u_boundary_values, & -! v_boundary_values, & -! h_boundary_values, & -! hmask, G, PF) - -! type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure -! real, intent(inout), dimension(SZIB_(G),SZJ_(G)) :: u_face_mask_boundary, u_flux_boundary_values -! real, intent(inout), dimension(SZI_(G),SZJB_(G)) :: v_face_mask_boundary, v_flux_boundary_values -! real, intent(inout), dimension(SZIB_(G),SZJB_(G)) :: u_boundary_values, v_boundary_values -! real, intent(inout), dimension(:,:) :: hmask, h_boundary_values -! type(param_file_type), intent(in) :: PF +!BEGIN MJH +! subroutine initialize_ice_shelf_boundary(u_face_mask_bdry, v_face_mask_bdry, & +! u_flux_bdry_val, v_flux_bdry_val, u_bdry_val, v_bdry_val, h_bdry_val, & +! hmask, G, PF ) + +! type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure +! real, dimension(SZIB_(G),SZJ_(G)), & +! intent(inout) :: u_face_mask_bdry !< A boundary-type mask at C-grid u faces +! real, dimension(SZIB_(G),SZJ_(G)), & +! intent(inout) :: u_flux_bdry_val !< The boundary thickness flux through + !! C-grid u faces, in m2 s-1. +! real, dimension(SZI_(G),SZJB_(G)), & +! intent(inout) :: v_face_mask_bdry !< A boundary-type mask at C-grid v faces +! real, dimension(SZI_(G),SZJB_(G)), & +! intent(inout) :: v_flux_bdry_val !< The boundary thickness flux through + !! C-grid v faces, in m2 s-1. +! real, dimension(SZIB_(G),SZJB_(G)), & +! intent(inout) :: u_bdry_val !< The zonal ice shelf velocity at open + !! boundary vertices, in m/yr. +! real, dimension(SZIB_(G),SZJB_(G)), & +! intent(inout) :: v_bdry_val !< The meridional ice shelf velocity at open + !! boundary vertices, in m/yr. +! real, dimension(SZDI_(G),SZDJ_(G)), & +! intent(inout) :: h_bdry_val !< The ice shelf thickness at open boundaries +! real, dimension(SZDI_(G),SZDJ_(G)), & +! intent(inout) :: hmask !< A mask indicating which tracer points are +! !! partly or fully covered by an ice-shelf +! type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters ! character(len=40) :: mdl = "initialize_ice_shelf_boundary" ! This subroutine's name. ! character(len=200) :: config @@ -249,9 +266,9 @@ end subroutine initialize_ice_thickness_channel ! select case ( trim(config) ) ! case ("CHANNEL") -! call initialize_ice_shelf_boundary_channel(u_face_mask_boundary, & -! v_face_mask_boundary, u_flux_boundary_values, v_flux_boundary_values, & -! u_boundary_values, v_boundary_values, h_boundary_values, hmask, G, & +! call initialize_ice_shelf_boundary_channel(u_face_mask_bdry, & +! v_face_mask_bdry, u_flux_bdry_val, v_flux_bdry_val, & +! u_bdry_val, v_bdry_val, h_bdry_val, hmask, G, & ! flux_bdry, PF) ! case ("FILE"); call MOM_error(FATAL,"MOM_initialize: "// & ! "Unrecognized topography setup "//trim(config)) @@ -263,24 +280,34 @@ end subroutine initialize_ice_thickness_channel ! end subroutine initialize_ice_shelf_boundary -! subroutine initialize_ice_shelf_boundary_channel ( & -! u_face_mask_boundary, & -! v_face_mask_boundary, & -! u_flux_boundary_values, & -! v_flux_boundary_values, & -! u_boundary_values, & -! v_boundary_values, & -! h_boundary_values, & -! hmask, & -! G, flux_bdry, PF ) - -! type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure -! real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: u_face_mask_boundary, u_flux_boundary_values -! real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: v_face_mask_boundary, v_flux_boundary_values -! real, dimension(SZIB_(G),SZJB_(G)), intent(inout) :: u_boundary_values, v_boundary_values -! real, dimension(:,:), intent(inout) :: h_boundary_values, hmask -! logical, intent(in) :: flux_bdry -! type (param_file_type), intent(in) :: PF +! subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_bdry, & +! u_flux_bdry_val, v_flux_bdry_val, u_bdry_val, v_bdry_val, h_bdry_val, & +! hmask, G, flux_bdry, PF ) + +! type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure +! real, dimension(SZIB_(G),SZJ_(G)), & +! intent(inout) :: u_face_mask_bdry !< A boundary-type mask at C-grid u faces +! real, dimension(SZIB_(G),SZJ_(G)), & +! intent(inout) :: u_flux_bdry_val !< The boundary thickness flux through + !! C-grid u faces, in m2 s-1. +! real, dimension(SZI_(G),SZJB_(G)), & +! intent(inout) :: v_face_mask_bdry !< A boundary-type mask at C-grid v faces +! real, dimension(SZI_(G),SZJB_(G)), & +! intent(inout) :: v_flux_bdry_val !< The boundary thickness flux through + !! C-grid v faces, in m2 s-1. +! real, dimension(SZIB_(G),SZJB_(G)), & +! intent(inout) :: u_bdry_val !< The zonal ice shelf velocity at open + !! boundary vertices, in m/yr. +! real, dimension(SZIB_(G),SZJB_(G)), & +! intent(inout) :: v_bdry_val !< The meridional ice shelf velocity at open + !! boundary vertices, in m/yr. +! real, dimension(SZDI_(G),SZDJ_(G)), & +! intent(inout) :: h_bdry_val !< The ice shelf thickness at open boundaries +! real, dimension(SZDI_(G),SZDJ_(G)), & +! intent(inout) :: hmask !< A mask indicating which tracer points are +! !! partly or fully covered by an ice-shelf +! logical, intent(in) :: flux_bdry !< If true, use mass fluxes as the boundary value. +! type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters ! character(len=40) :: mdl = "initialize_ice_shelf_boundary_channel" ! This subroutine's name. ! integer :: i, j, isd, jsd, is, js, iegq, jegq, giec, gjec, gisc, gjsc, isc, jsc, iec, jec, ied, jed @@ -313,15 +340,15 @@ end subroutine initialize_ice_thickness_channel ! if ((i+G%idg_offset) == G%domain%nihalo+1) then ! if (flux_bdry) then -! u_face_mask_boundary (i-1,j) = 4.0 -! u_flux_boundary_values (i-1,j) = input_flux +! u_face_mask_bdry(i-1,j) = 4.0 +! u_flux_bdry_val(i-1,j) = input_flux ! else ! hmask(i-1,j) = 3.0 -! h_boundary_values (i-1,j) = input_thick -! u_face_mask_boundary (i-1,j) = 3.0 -! u_boundary_values (i-1,j-1) = (1 - ((G%geoLatBu(i-1,j-1) - 0.5*lenlat)*2./lenlat)**2) * & +! h_bdry_val(i-1,j) = input_thick +! u_face_mask_bdry(i-1,j) = 3.0 +! u_bdry_val(i-1,j-1) = (1 - ((G%geoLatBu(i-1,j-1) - 0.5*lenlat)*2./lenlat)**2) * & ! 1.5 * input_flux / input_thick -! u_boundary_values (i-1,j) = (1 - ((G%geoLatBu(i-1,j) - 0.5*lenlat)*2./lenlat)**2) * & +! u_bdry_val(i-1,j) = (1 - ((G%geoLatBu(i-1,j) - 0.5*lenlat)*2./lenlat)**2) * & ! 1.5 * input_flux / input_thick ! endif ! endif @@ -330,22 +357,22 @@ end subroutine initialize_ice_thickness_channel ! if (G%jdg_offset+j == gjsc+1) then !bot boundary ! if (len_stress == 0. .OR. G%geoLonCv(i,j-1) <= len_stress) then -! v_face_mask_boundary (i,j-1) = 0. +! v_face_mask_bdry(i,j-1) = 0. ! else -! v_face_mask_boundary (i,j-1) = 1. +! v_face_mask_bdry(i,j-1) = 1. ! endif ! elseif (G%jdg_offset+j == gjec) then !top boundary ! if (len_stress == 0. .OR. G%geoLonCv(i,j-1) <= len_stress) then -! v_face_mask_boundary (i,j) = 0. +! v_face_mask_bdry(i,j) = 0. ! else -! v_face_mask_boundary (i,j) = 1. +! v_face_mask_bdry(i,j) = 1. ! endif ! endif ! ! downstream boundary - CFBC ! if (i+G%idg_offset == giec) then -! u_face_mask_boundary(i,j) = 2.0 +! u_face_mask_bdry(i,j) = 2.0 ! endif ! enddo diff --git a/src/ice_shelf/user_shelf_init.F90 b/src/ice_shelf/user_shelf_init.F90 index 7c523dea5f..dfd527169d 100644 --- a/src/ice_shelf/user_shelf_init.F90 +++ b/src/ice_shelf/user_shelf_init.F90 @@ -1,76 +1,14 @@ +!> This module specifies the initial values and evolving properties of the +!! MOM6 ice shelf, using user-provided code. module user_shelf_init ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, April 1994 - June 2002 * -!* * -!* This subroutine initializes the fields for the simulations. * -!* The one argument passed to initialize, Time, is set to the * -!* current time of the simulation. The fields which are initialized * -!* here are: * -!* u - Zonal velocity in m s-1. * -!* v - Meridional velocity in m s-1. * -!* h - Layer thickness in m. (Must be positive.) * -!* D - Basin depth in m. (Must be positive.) * -!* f - The Coriolis parameter, in s-1. * -!* g - The reduced gravity at each interface, in m s-2. * -!* Rlay - Layer potential density (coordinate variable) in kg m-3. * -!* If TEMPERATURE is defined: * -!* T - Temperature in C. * -!* S - Salinity in psu. * -!* If BULKMIXEDLAYER is defined: * -!* Rml - Mixed layer and buffer layer potential densities in * -!* units of kg m-3. * -!* If SPONGE is defined: * -!* A series of subroutine calls are made to set up the damping * -!* rates and reference profiles for all variables that are damped * -!* in the sponge. * -!* Any user provided tracer code is also first linked through this * -!* subroutine. * -!* * -!* Forcing-related fields (taux, tauy, buoy, ustar, etc.) are set * -!* in MOM_surface_forcing.F90. * -!* * -!* These variables are all set in the set of subroutines (in this * -!* file) USER_initialize_bottom_depth, USER_initialize_thickness, * -!* USER_initialize_velocity, USER_initialize_temperature_salinity, * -!* USER_initialize_mixed_layer_density, USER_initialize_sponges, * -!* USER_set_coord, and USER_set_ref_profile. * -!* * -!* The names of these subroutines should be self-explanatory. They * -!* start with "USER_" to indicate that they will likely have to be * -!* modified for each simulation to set the initial conditions and * -!* boundary conditions. Most of these take two arguments: an integer * -!* argument specifying whether the fields are to be calculated * -!* internally or read from a NetCDF file; and a string giving the * -!* path to that file. If the field is initialized internally, the * -!* path is ignored. * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h.* -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q, f * -!* j+1 > o > o > At ^: v, tauy * -!* j x ^ x ^ x At >: u, taux * -!* j > o > o > At o: h, D, buoy, tr, T, S, Rml, ustar * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - ! use MOM_domains, only : sum_across_PEs use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_time_manager, only : time_type, set_time, time_type_to_real - -use mpp_mod, only : mpp_pe, mpp_sync ! use MOM_io, only : close_file, fieldtype, file_exists ! use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE ! use MOM_io, only : write_field, slasher @@ -94,13 +32,24 @@ module user_shelf_init contains +!> This subroutine sets up the initial mass and area covered by the ice shelf, based on user-provided code. subroutine USER_initialize_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, CS, param_file, new_sim) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: mass_shelf, area_shelf_h, hmask, h_shelf - type(user_ice_shelf_CS), pointer :: CS - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - logical :: new_sim + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(out) :: mass_shelf !< The ice shelf mass per unit area averaged + !! over the full ocean cell, in kg m-2. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(out) :: h_shelf !< The ice shelf thickness, in m. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(out) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(out) :: hmask !< A mask indicating which tracer points are + !! partly or fully covered by an ice-shelf + type(user_ice_shelf_CS), pointer :: CS !< A pointer to the user ice shelf control structure + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + logical, intent(in) :: new_sim !< If true, this is a new run; otherwise it is + !! being started from a restart file. ! Arguments: mass_shelf - The mass per unit area averaged over the full ocean ! cell, in kg m-2. (Intent out) @@ -111,7 +60,6 @@ subroutine USER_initialize_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, ! model parameter values. -! just check for cvs ! This subroutine sets up the initial mass and area covered by the ice shelf. real :: Rho_ocean ! The ocean's typical density, in kg m-3. real :: max_draft ! The maximum ocean draft of the ice shelf, in m. @@ -149,13 +97,19 @@ subroutine USER_initialize_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, call USER_update_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, CS, set_time(0,0), new_sim) - end subroutine USER_initialize_shelf_mass +!> This subroutine updates the ice shelf thickness, as specified by user-provided code. subroutine USER_init_ice_thickness(h_shelf, area_shelf_h, hmask, G, param_file) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: area_shelf_h, hmask, h_shelf - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(out) :: h_shelf !< The ice shelf thickness, in m. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(out) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(out) :: hmask !< A mask indicating which tracer points are + !! partly or fully covered by an ice-shelf + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! This subroutine initializes the ice shelf thickness. Currently it does so ! calling USER_initialize_shelf_mass, but this can be revised as needed. @@ -166,12 +120,22 @@ subroutine USER_init_ice_thickness(h_shelf, area_shelf_h, hmask, G, param_file) end subroutine USER_init_ice_thickness +!> This subroutine updates the ice shelf mass, as specified by user-provided code. subroutine USER_update_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, CS, Time, new_sim) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: mass_shelf, area_shelf_h, hmask, h_shelf - type(user_ice_shelf_CS), pointer :: CS - type(time_type), intent(in) :: Time - logical, intent(in) :: new_sim + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: mass_shelf !< The ice shelf mass per unit area averaged + !! over the full ocean cell, in kg m-2. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: h_shelf !< The ice shelf thickness, in m. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: hmask !< A mask indicating which tracer points are + !! partly or fully covered by an ice-shelf + type(user_ice_shelf_CS), pointer :: CS !< A pointer to the user ice shelf control structure + type(time_type), intent(in) :: Time !< The current model time + logical, intent(in) :: new_sim !< If true, this the start of a new run. ! Arguments: mass_shelf - The mass per unit area averaged over the full ocean ! cell, in kg m-2. (Intent out) @@ -240,6 +204,7 @@ subroutine USER_update_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, C end subroutine USER_update_shelf_mass +!> This subroutine writes out the user ice shelf code version number to the model log. subroutine write_user_log(param_file) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters From a2acb225d220bd4ca4fd4e72703f87bfcda63a07 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 1 Jun 2018 06:09:16 -0400 Subject: [PATCH 0327/1072] +Added subroutines to get ALE sponge grid info Added get_ALE_sponge_nz_data and get_ALE_sponge_thicknesses, to provide an interface to get information about the fixed ALE sponge grid. All answers are bitwise identical. --- .../vertical/MOM_ALE_sponge.F90 | 192 +++++++++++------- 1 file changed, 121 insertions(+), 71 deletions(-) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 93aeb6f750..1b2dd77928 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -43,6 +43,7 @@ module MOM_ALE_sponge end interface !< Publicly available functions public set_up_ALE_sponge_field, set_up_ALE_sponge_vel_field +public get_ALE_sponge_thicknesses, get_ALE_sponge_nz_data public initialize_ALE_sponge, apply_ALE_sponge, ALE_sponge_end, init_ALE_sponge_diags type :: p3d @@ -212,86 +213,135 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ if (CS%sponge_uv) then - allocate(data_hu(G%isdB:G%iedB,G%jsd:G%jed,nz_data)); data_hu(:,:,:)=0.0 - allocate(data_hv(G%isd:G%ied,G%jsdB:G%jedB,nz_data)); data_hv(:,:,:)=0.0 - allocate(Iresttime_u(G%isdB:G%iedB,G%jsd:G%jed)); Iresttime_u(:,:)=0.0 - allocate(Iresttime_v(G%isd:G%ied,G%jsdB:G%jedB)); Iresttime_v(:,:)=0.0 + allocate(data_hu(G%isdB:G%iedB,G%jsd:G%jed,nz_data)); data_hu(:,:,:)=0.0 + allocate(data_hv(G%isd:G%ied,G%jsdB:G%jedB,nz_data)); data_hv(:,:,:)=0.0 + allocate(Iresttime_u(G%isdB:G%iedB,G%jsd:G%jed)); Iresttime_u(:,:)=0.0 + allocate(Iresttime_v(G%isd:G%ied,G%jsdB:G%jedB)); Iresttime_v(:,:)=0.0 - ! u points - CS%num_col_u = 0 ; !CS%fldno_u = 0 - do j=CS%jsc,CS%jec; do I=CS%iscB,CS%iecB - data_hu(I,j,:) = 0.5 * (data_h(i,j,:) + data_h(i+1,j,:)) - Iresttime_u(I,j) = 0.5 * (Iresttime(i,j) + Iresttime(i+1,j)) - if ((Iresttime_u(I,j)>0.0) .and. (G%mask2dCu(I,j)>0)) & - CS%num_col_u = CS%num_col_u + 1 - enddo ; enddo + ! u points + CS%num_col_u = 0 ; !CS%fldno_u = 0 + do j=CS%jsc,CS%jec; do I=CS%iscB,CS%iecB + data_hu(I,j,:) = 0.5 * (data_h(i,j,:) + data_h(i+1,j,:)) + Iresttime_u(I,j) = 0.5 * (Iresttime(i,j) + Iresttime(i+1,j)) + if ((Iresttime_u(I,j)>0.0) .and. (G%mask2dCu(I,j)>0)) & + CS%num_col_u = CS%num_col_u + 1 + enddo ; enddo - if (CS%num_col_u > 0) then + if (CS%num_col_u > 0) then - allocate(CS%Iresttime_col_u(CS%num_col_u)) ; CS%Iresttime_col_u = 0.0 - allocate(CS%col_i_u(CS%num_col_u)) ; CS%col_i_u = 0 - allocate(CS%col_j_u(CS%num_col_u)) ; CS%col_j_u = 0 + allocate(CS%Iresttime_col_u(CS%num_col_u)) ; CS%Iresttime_col_u = 0.0 + allocate(CS%col_i_u(CS%num_col_u)) ; CS%col_i_u = 0 + allocate(CS%col_j_u(CS%num_col_u)) ; CS%col_j_u = 0 - ! pass indices, restoring time to the CS structure - col = 1 - do j=CS%jsc,CS%jec ; do I=CS%iscB,CS%iecB - if ((Iresttime_u(I,j)>0.0) .and. (G%mask2dCu(I,j)>0)) then - CS%col_i_u(col) = i ; CS%col_j_u(col) = j - CS%Iresttime_col_u(col) = Iresttime_u(i,j) - col = col +1 - endif - enddo ; enddo + ! pass indices, restoring time to the CS structure + col = 1 + do j=CS%jsc,CS%jec ; do I=CS%iscB,CS%iecB + if ((Iresttime_u(I,j)>0.0) .and. (G%mask2dCu(I,j)>0)) then + CS%col_i_u(col) = i ; CS%col_j_u(col) = j + CS%Iresttime_col_u(col) = Iresttime_u(i,j) + col = col +1 + endif + enddo ; enddo - ! same for total number of arbritary layers and correspondent data + ! same for total number of arbritary layers and correspondent data - allocate(CS%Ref_hu%p(CS%nz_data,CS%num_col_u)) - do col=1,CS%num_col_u ; do K=1,CS%nz_data - CS%Ref_hu%p(K,col) = data_hu(CS%col_i_u(col),CS%col_j_u(col),K) - enddo ; enddo - endif - total_sponge_cols_u = CS%num_col_u - call sum_across_PEs(total_sponge_cols_u) - call log_param(param_file, mdl, "!Total sponge columns at u points", total_sponge_cols_u, & - "The total number of columns where sponges are applied at u points.") + allocate(CS%Ref_hu%p(CS%nz_data,CS%num_col_u)) + do col=1,CS%num_col_u ; do K=1,CS%nz_data + CS%Ref_hu%p(K,col) = data_hu(CS%col_i_u(col),CS%col_j_u(col),K) + enddo ; enddo + endif + total_sponge_cols_u = CS%num_col_u + call sum_across_PEs(total_sponge_cols_u) + call log_param(param_file, mdl, "!Total sponge columns at u points", total_sponge_cols_u, & + "The total number of columns where sponges are applied at u points.") - ! v points - CS%num_col_v = 0 ; !CS%fldno_v = 0 - do J=CS%jscB,CS%jecB; do i=CS%isc,CS%iec - data_hv(i,J,:) = 0.5 * (data_h(i,j,:) + data_h(i,j+1,:)) - Iresttime_v(i,J) = 0.5 * (Iresttime(i,j) + Iresttime(i,j+1)) - if ((Iresttime_v(i,J)>0.0) .and. (G%mask2dCv(i,J)>0)) & - CS%num_col_v = CS%num_col_v + 1 - enddo ; enddo + ! v points + CS%num_col_v = 0 ; !CS%fldno_v = 0 + do J=CS%jscB,CS%jecB; do i=CS%isc,CS%iec + data_hv(i,J,:) = 0.5 * (data_h(i,j,:) + data_h(i,j+1,:)) + Iresttime_v(i,J) = 0.5 * (Iresttime(i,j) + Iresttime(i,j+1)) + if ((Iresttime_v(i,J)>0.0) .and. (G%mask2dCv(i,J)>0)) & + CS%num_col_v = CS%num_col_v + 1 + enddo ; enddo - if (CS%num_col_v > 0) then + if (CS%num_col_v > 0) then + + allocate(CS%Iresttime_col_v(CS%num_col_v)) ; CS%Iresttime_col_v = 0.0 + allocate(CS%col_i_v(CS%num_col_v)) ; CS%col_i_v = 0 + allocate(CS%col_j_v(CS%num_col_v)) ; CS%col_j_v = 0 + + ! pass indices, restoring time to the CS structure + col = 1 + do J=CS%jscB,CS%jecB ; do i=CS%isc,CS%iec + if ((Iresttime_v(i,J)>0.0) .and. (G%mask2dCv(i,J)>0)) then + CS%col_i_v(col) = i ; CS%col_j_v(col) = j + CS%Iresttime_col_v(col) = Iresttime_v(i,j) + col = col +1 + endif + enddo ; enddo + + ! same for total number of arbritary layers and correspondent data + allocate(CS%Ref_hv%p(CS%nz_data,CS%num_col_v)) + do col=1,CS%num_col_v ; do K=1,CS%nz_data + CS%Ref_hv%p(K,col) = data_hv(CS%col_i_v(col),CS%col_j_v(col),K) + enddo ; enddo + endif + total_sponge_cols_v = CS%num_col_v + call sum_across_PEs(total_sponge_cols_v) + call log_param(param_file, mdl, "!Total sponge columns at v points", total_sponge_cols_v, & + "The total number of columns where sponges are applied at v points.") + endif - allocate(CS%Iresttime_col_v(CS%num_col_v)) ; CS%Iresttime_col_v = 0.0 - allocate(CS%col_i_v(CS%num_col_v)) ; CS%col_i_v = 0 - allocate(CS%col_j_v(CS%num_col_v)) ; CS%col_j_v = 0 +end subroutine initialize_ALE_sponge_fixed - ! pass indices, restoring time to the CS structure - col = 1 - do J=CS%jscB,CS%jecB ; do i=CS%isc,CS%iec - if ((Iresttime_v(i,J)>0.0) .and. (G%mask2dCv(i,J)>0)) then - CS%col_i_v(col) = i ; CS%col_j_v(col) = j - CS%Iresttime_col_v(col) = Iresttime_v(i,j) - col = col +1 - endif - enddo ; enddo +!> Return the number of layers in the data with a fixed ALE sponge, or 0 if there are +!! no sponge columns on this PE. +function get_ALE_sponge_nz_data(CS) + type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for the ALE_sponge module. + integer :: get_ALE_sponge_nz_data !< The number of layers in the fixed sponge data. - ! same for total number of arbritary layers and correspondent data - allocate(CS%Ref_hv%p(CS%nz_data,CS%num_col_v)) - do col=1,CS%num_col_v ; do K=1,CS%nz_data - CS%Ref_hv%p(K,col) = data_hv(CS%col_i_v(col),CS%col_j_v(col),K) - enddo ; enddo - endif - total_sponge_cols_v = CS%num_col_v - call sum_across_PEs(total_sponge_cols_v) - call log_param(param_file, mdl, "!Total sponge columns at v points", total_sponge_cols_v, & - "The total number of columns where sponges are applied at v points.") + if (associated(CS)) then + get_ALE_sponge_nz_data = CS%nz_data + else + get_ALE_sponge_nz_data = 0 + endif +end function get_ALE_sponge_nz_data + +!> Return the thicknesses used for the data with a fixed ALE sponge +subroutine get_ALE_sponge_thicknesses(G, data_h, sponge_mask, CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). + real, allocatable, dimension(:,:,:), & + intent(inout) :: data_h !< The thicknesses of the sponge input layers. + logical, dimension(SZI_(G),SZJ_(G)), & + intent(out) :: sponge_mask !< A logical mask that is true where + !! sponges are being applied. + type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for the ALE_sponge module. + integer :: c, i, j, k + + if (allocated(data_h)) call MOM_error(FATAL, & + "get_ALE_sponge_thicknesses called with an allocated data_h.") + + if (.not.associated(CS)) then + ! There are no sponge points on this PE. + allocate(data_h(G%isd:G%ied,G%jsd:G%jed,1)) ; data_h(:,:,:) = -1.0 + sponge_mask(:,:) = .false. + return endif -end subroutine initialize_ALE_sponge_fixed + allocate(data_h(G%isd:G%ied,G%jsd:G%jed,CS%nz_data)) ; data_h(:,:,:) = -1.0 + sponge_mask(:,:) = .false. + + do c=1,CS%num_col + i = CS%col_i(c) ; j = CS%col_j(c) + sponge_mask(i,j) = .true. + do k=1,CS%nz_data + data_h(i,j,k) = CS%Ref_h%p(k,c) + enddo + enddo + +end subroutine get_ALE_sponge_thicknesses !> This subroutine determines the number of points which are within ! sponges in this computational domain. Only points that have @@ -474,7 +524,7 @@ subroutine init_ALE_sponge_diags(Time, G, diag, CS) end subroutine init_ALE_sponge_diags !> This subroutine stores the reference profile at h points for the variable -! whose address is given by f_ptr. +!! whose address is given by f_ptr. subroutine set_up_ALE_sponge_field_fixed(sp_val, G, f_ptr, CS) type(ocean_grid_type), intent(in) :: G !< Grid structure type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). @@ -625,8 +675,8 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr, end subroutine set_up_ALE_sponge_field_varying -!> This subroutine stores the reference profile at uand v points for the variable -! whose address is given by u_ptr and v_ptr. +!> This subroutine stores the reference profile at u and v points for the variable +!! whose address is given by u_ptr and v_ptr. subroutine set_up_ALE_sponge_vel_field_fixed(u_val, v_val, G, u_ptr, v_ptr, CS) type(ocean_grid_type), intent(in) :: G !< Grid structure (in). type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). @@ -666,7 +716,7 @@ subroutine set_up_ALE_sponge_vel_field_fixed(u_val, v_val, G, u_ptr, v_ptr, CS) end subroutine set_up_ALE_sponge_vel_field_fixed !> This subroutine stores the reference profile at uand v points for the variable -! whose address is given by u_ptr and v_ptr. +!! whose address is given by u_ptr and v_ptr. subroutine set_up_ALE_sponge_vel_field_varying(filename_u,fieldname_u,filename_v,fieldname_v, Time, G, CS, u_ptr, v_ptr) character(len=*), intent(in) :: filename_u !< File name for u field character(len=*), intent(in) :: fieldname_u !< Name of u variable in file From 139f6afdd400ab29ac658b119e5d5bc172e543a4 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 1 Jun 2018 08:54:40 -0600 Subject: [PATCH 0328/1072] Add comments --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 962594ae00..1f0b640a2c 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -560,7 +560,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") - ! Set diffusivities for heat and salt + ! Set diffusivities for heat and salt separately !$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,Kd_heat) !$OMP do @@ -568,6 +568,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & Kd_salt(i,j,k) = Kd_int(i,j,k) Kd_heat(i,j,k) = Kd_int(i,j,k) enddo ; enddo ; enddo + ! Add contribution from double diffusion if (associated(visc%Kd_extra_S)) then !$OMP do do k=1,nz+1 ; do j=js,je ; do i=is,ie From a93cff637150e7b0627f695b8caca643c2163421 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 1 Jun 2018 11:06:53 -0400 Subject: [PATCH 0329/1072] dOxyGenized arguments in MOM_ice_shelf_dynamics Added dOxyGenized comments the arguments in MOM_ice_shelf_dynamics.F90. Because I do not fully understand the ice-sheet dynamics model, these should be reviewed and revised by someone who understands the ice sheet dynamics solver. All answers in the test cases are bitwise identical. --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 529 ++++++++++++++--------- 1 file changed, 319 insertions(+), 210 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index b974f208fa..eb605c9d28 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -36,7 +36,7 @@ module MOM_ice_shelf_dynamics type, public :: ice_shelf_dyn_CS ; private real, pointer, dimension(:,:) :: & u_shelf => NULL(), & !< the zonal (?) velocity of the ice shelf/sheet, - ! in meters per second??? on q-points (B grid) + !! in meters per second??? on q-points (B grid) v_shelf => NULL(), & !< the meridional velocity of the ice shelf/sheet, !! in m/s ?? on q-points (B grid) @@ -158,9 +158,9 @@ module MOM_ice_shelf_dynamics contains !> used for flux limiting in advective subroutines Van Leer limiter (source: Wikipedia) -function slope_limiter (num, denom) - real, intent(in) :: num - real, intent(in) :: denom +function slope_limiter(num, denom) + real, intent(in) :: num !< The numerator of the ratio used in the Van Leer slope limiter + real, intent(in) :: denom !< The denominator of the ratio used in the Van Leer slope limiter real :: slope_limiter real :: r @@ -177,8 +177,8 @@ end function slope_limiter !> Calculate area of quadrilateral. function quad_area (X, Y) - real, dimension(4), intent(in) :: X - real, dimension(4), intent(in) :: Y + real, dimension(4), intent(in) :: X !< The x-positions of the vertices of the quadrilateral. + real, dimension(4), intent(in) :: Y !< The y-positions of the vertices of the quadrilateral. real :: quad_area, p2, q2, a2, c2, b2, d2 ! X and Y must be passed in the form @@ -197,9 +197,9 @@ end function quad_area !! dynamics that should be written to or read from the restart file. subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) type(ocean_grid_type), intent(inout) :: G !< The grid type describing the ice shelf grid. - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(ice_shelf_dyn_CS), pointer :: CS !< A pointer to the ice shelf dynamics control structure - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(ice_shelf_dyn_CS), pointer :: CS !< A pointer to the ice shelf dynamics control structure + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. logical :: shelf_mass_is_dynamic, override_shelf_movement, active_shelf_dynamics character(len=40) :: mdl = "MOM_ice_shelf_dyn" ! This module's name. @@ -519,11 +519,11 @@ end subroutine initialize_ice_shelf_dyn subroutine initialize_diagnostic_fields(CS, ISS, G, Time) - type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure - type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe - !! the ice-shelf state - type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - type(time_type), intent(in) :: Time !< The current model time + type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe + !! the ice-shelf state + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + type(time_type), intent(in) :: Time !< The current model time integer :: i, j, iters, isd, ied, jsd, jed real :: rhoi, rhow, OD @@ -650,7 +650,7 @@ end subroutine update_ice_shelf subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe - !! the ice-shelf state + !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step !< time step in sec type(time_type), intent(in) :: Time !< The current model time @@ -761,18 +761,21 @@ end subroutine ice_shelf_advect subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure - type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe - !! the ice-shelf state - type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe + !! the ice-shelf state + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, dimension(SZDIB_(G),SZDJB_(G)), & - intent(inout) :: u, v - integer, intent(out) :: iters - type(time_type), intent(in) :: Time !< The current model time + intent(inout) :: u !< The zonal ice shelf velocity at vertices, in m/year + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(inout) :: v !< The meridional ice shelf velocity at vertices, in m/year + integer, intent(out) :: iters !< The number of iterations used in the solver. + type(time_type), intent(in) :: Time !< The current model time real, dimension(SZDIB_(G),SZDJB_(G)) :: TAUDX, TAUDY, u_prev_iterate, v_prev_iterate, & u_bdry_cont, v_bdry_cont, Au, Av, err_u, err_v, & u_last, v_last, H_node - real, dimension(SZDI_(G),SZDJ_(G)) :: float_cond + real, dimension(SZDI_(G),SZDJ_(G)) :: float_cond ! An array indicating where the ice + ! shelf is floating: 0 if floating, 1 if not. integer :: conv_flag, i, j, k,l, iter integer :: isdq, iedq, jsdq, jedq, isd, ied, jsd, jed, isumstart, jsumstart, nodefloat, nsub real :: err_max, err_tempu, err_tempv, err_init, area, max_vel, tempu, tempv, rhoi, rhow @@ -1015,20 +1018,37 @@ end subroutine ice_shelf_solve_outer subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_cond, & hmask, conv_flag, iters, time, Phi, Phisub) - type(ice_shelf_dyn_CS),intent(in) :: CS !< A pointer to the ice shelf control structure - type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state - type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u, v - real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: taudx, taudy, H_node - real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: float_cond - real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: hmask !< A mask indicating which tracer points are + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(inout) :: u !< The zonal ice shelf velocity at vertices, in m/year + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(inout) :: v !< The meridional ice shelf velocity at vertices, in m/year + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(in) :: taudx !< The x-direction driving stress, in ??? + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(in) :: taudy !< The y-direction driving stress, in ??? + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(in) :: H_node !< The ice shelf thickness at nodal (corner) + !! points, in m. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: float_cond !< An array indicating where the ice + !! shelf is floating: 0 if floating, 1 if not. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf - integer, intent(out) :: conv_flag, iters - type(time_type), intent(in) :: Time !< The current model time - real, dimension(SZDI_(G),SZDJ_(G),8,4), intent(in) :: Phi - real, dimension(:,:,:,:,:,:), intent(in) :: Phisub - + integer, intent(out) :: conv_flag !< A flag indicating whether (1) or not (0) the + !! iterations have converged to the specified tolerence + integer, intent(out) :: iters !< The number of iterations used in the solver. + type(time_type), intent(in) :: Time !< The current model time + real, dimension(SZDI_(G),SZDJ_(G),8,4), & + intent(in) :: Phi !< The gradients of bilinear basis elements at Gaussian + !! quadrature points surrounding the cell verticies. + real, dimension(:,:,:,:,:,:), & + intent(in) :: Phisub !< Quadrature structure weights at subgridscale + !! locations for finite element calculations ! one linear solve (nonlinear iteration) of the solution for velocity ! in this subroutine: @@ -1190,12 +1210,10 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c do j=jscq,jecq do i=iscq,iecq if (CS%umask(i,j) == 1) sum_vec(i,j) = Zu(i,j) * Ru(i,j) - if (CS%vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + & - Zv(i,j) * Rv(i,j) + if (CS%vmask(i,j) == 1) sum_vec(i,j) = sum_vec(i,j) + Zv(i,j) * Rv(i,j) if (CS%umask(i,j) == 1) sum_vec_2(i,j) = Du(i,j) * Au(i,j) - if (CS%vmask(i,j) == 1) sum_vec_2(i,j) = sum_vec_2(i,j) + & - Dv(i,j) * Av(i,j) + if (CS%vmask(i,j) == 1) sum_vec_2(i,j) = sum_vec_2(i,j) + Dv(i,j) * Av(i,j) enddo enddo @@ -1208,12 +1226,6 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c alpha_k = dot_p1/dot_p2 - !### These should probably use explicit index notation so that they are - !### not applied outside of the valid range. - RWH - - ! u(:,:) = u(:,:) + alpha_k * Du(:,:) - ! v(:,:) = v(:,:) + alpha_k * Dv(:,:) - do j=jsd,jed do i=isd,ied if (CS%umask(i,j) == 1) u(i,j) = u(i,j) + alpha_k * Du(i,j) @@ -1391,14 +1403,20 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c end subroutine ice_shelf_solve_inner subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_uflux, flux_enter) - type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step !< The time step for this update, in s. - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask !< A mask indicating which tracer points are + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, intent(in) :: time_step !< The time step for this update, in s. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf - real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h0 - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_uflux - real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: h0 !< The initial ice shelf thicknesses in m. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: h_after_uflux !< The ice shelf thicknesses after + !! the zonal mass fluxes, in m. + real, dimension(SZDI_(G),SZDJ_(G),4), & + intent(inout) :: flux_enter !< The ice volume flux into the cell + !! through the 4 cell boundaries, in m3 ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells @@ -1484,7 +1502,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(-1) / dxdyh elseif (hmask(i-1,j) * hmask(i-2,j) == 1) then ! h(i-2) and h(i-1) are valid - phi = slope_limiter (stencil(-1)-stencil(-2), stencil(0)-stencil(-1)) + phi = slope_limiter(stencil(-1)-stencil(-2), stencil(0)-stencil(-1)) flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh* time_step / dxdyh * & (stencil(-1) - phi * (stencil(-1)-stencil(0))/2) @@ -1498,7 +1516,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl elseif (u_face < 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available if (hmask(i-1,j) * hmask(i+1,j) == 1) then ! h(i-1) and h(i+1) are both valid - phi = slope_limiter (stencil(0)-stencil(1), stencil(-1)-stencil(0)) + phi = slope_limiter(stencil(0)-stencil(1), stencil(-1)-stencil(0)) flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * & (stencil(0) - phi * (stencil(0)-stencil(-1))/2) @@ -1533,7 +1551,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl elseif (hmask(i+1,j) * hmask(i+2,j) == 1) then ! h(i+2) and h(i+1) are valid - phi = slope_limiter (stencil(1)-stencil(2), stencil(0)-stencil(1)) + phi = slope_limiter(stencil(1)-stencil(2), stencil(0)-stencil(1)) flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step / dxdyh * & (stencil(1) - phi * (stencil(1)-stencil(0))/2) @@ -1549,7 +1567,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl if (hmask(i-1,j) * hmask(i+1,j) == 1) then ! h(i-1) and h(i+1) are both valid - phi = slope_limiter (stencil(0)-stencil(-1), stencil(1)-stencil(0)) + phi = slope_limiter(stencil(0)-stencil(-1), stencil(1)-stencil(0)) flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * & (stencil(0) - phi * (stencil(0)-stencil(1))/2) @@ -1615,14 +1633,21 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl end subroutine ice_shelf_advect_thickness_x subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, h_after_vflux, flux_enter) - type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step !< The time step for this update, in s. - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask !< A mask indicating which tracer points are + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, intent(in) :: time_step !< The time step for this update, in s. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf - real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h_after_uflux - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_vflux - real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: h_after_uflux !< The ice shelf thicknesses after + !! the zonal mass fluxes, in m. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: h_after_vflux !< The ice shelf thicknesses after + !! the meridional mass fluxes, in m. + real, dimension(SZDI_(G),SZDJ_(G),4), & + intent(inout) :: flux_enter !< The ice volume flux into the cell + !! through the 4 cell boundaries, in m3 ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells @@ -1704,7 +1729,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, elseif (hmask(i,j-1) * hmask(i,j-2) == 1) then ! h(j-2) and h(j-1) are valid - phi = slope_limiter (stencil(-1)-stencil(-2), stencil(0)-stencil(-1)) + phi = slope_limiter(stencil(-1)-stencil(-2), stencil(0)-stencil(-1)) flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * & (stencil(-1) - phi * (stencil(-1)-stencil(0))/2) @@ -1717,7 +1742,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, elseif (v_face < 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available if (hmask(i,j-1) * hmask(i,j+1) == 1) then ! h(j-1) and h(j+1) are both valid - phi = slope_limiter (stencil(0)-stencil(1), stencil(-1)-stencil(0)) + phi = slope_limiter(stencil(0)-stencil(1), stencil(-1)-stencil(0)) flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * & (stencil(0) - phi * (stencil(0)-stencil(-1))/2) else @@ -1750,7 +1775,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(1) / dxdyh elseif (hmask(i,j+1) * hmask(i,j+2) == 1) then ! h(j+2) and h(j+1) are valid - phi = slope_limiter (stencil(1)-stencil(2), stencil(0)-stencil(1)) + phi = slope_limiter(stencil(1)-stencil(2), stencil(0)-stencil(1)) flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * & (stencil(1) - phi * (stencil(1)-stencil(0))/2) else ! h(j+1) is valid @@ -1762,7 +1787,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, elseif (v_face > 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available if (hmask(i,j-1) * hmask(i,j+1) == 1) then ! h(j-1) and h(j+1) are both valid - phi = slope_limiter (stencil(0)-stencil(-1), stencil(1)-stencil(0)) + phi = slope_limiter(stencil(0)-stencil(-1), stencil(1)-stencil(0)) flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * & (stencil(0) - phi * (stencil(0)-stencil(1))/2) else ! h(j+1) is valid @@ -1817,11 +1842,13 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, end subroutine ice_shelf_advect_thickness_y subroutine shelf_advance_front(CS, ISS, G, flux_enter) - type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure - type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe !! the ice-shelf state - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDI_(G),SZDJ_(G),4), & + intent(inout) :: flux_enter !< The ice volume flux into the cell + !! through the 4 cell boundaries, in m3 ! in this subroutine we go through the computational cells only and, if they are empty or partial cells, ! we find the reference thickness and update the shelf mass and partial area fraction and the hmask if necessary @@ -1998,7 +2025,7 @@ subroutine ice_shelf_min_thickness_calve(G, h_shelf, area_shelf_h, hmask, thickn real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf - real, intent(in) :: thickness_calve + real, intent(in) :: thickness_calve !< The thickness at which to trigger calving, in m. integer :: i,j @@ -2025,7 +2052,9 @@ subroutine calve_to_mask(G, h_shelf, area_shelf_h, hmask, calve_mask) real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf - real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: calve_mask + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: calve_mask !< A mask that indicates where the ice shelf + !! can exist, and where it will calve. integer :: i,j @@ -2238,7 +2267,8 @@ subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf - real, intent(in) :: input_flux, input_thick + real, intent(in) :: input_flux !< The integrated inward ice thickness flux in m3 s-1. + real, intent(in) :: input_thick !< The ice thickness at boundaries, in m. logical, optional, intent(in) :: new_sim !< If present and false, this run is being restarted ! this will be a per-setup function. the boundary values of thickness and velocity @@ -2301,22 +2331,57 @@ end subroutine init_boundary_values subroutine CG_action(uret, vret, u, v, Phi, Phisub, umask, vmask, hmask, H_node, & - nu, float_cond, D, beta, dxdyh, G, is, ie, js, je, dens_ratio) + nu, float_cond, bathyT, beta, dxdyh, G, is, ie, js, je, dens_ratio) type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent (inout) :: uret, vret - real, dimension(SZDI_(G),SZDJ_(G),8,4), intent(in) :: Phi - real, dimension(:,:,:,:,:,:), intent(in) :: Phisub - real, dimension(SZDIB_(G),SZDJB_(G)), intent (in) :: u, v - real, dimension(SZDIB_(G),SZDJB_(G)), intent (in) :: umask, vmask, H_node - real, dimension(SZDI_(G),SZDJ_(G)), intent (in) :: hmask - real, dimension(SZDIB_(G),SZDJB_(G)), intent (in) :: nu - real, dimension(SZDI_(G),SZDJ_(G)), intent (in) :: float_cond - real, dimension(SZDI_(G),SZDJ_(G)), intent (in) :: D - real, dimension(SZDIB_(G),SZDJB_(G)), intent (in) :: beta - real, dimension(SZDI_(G),SZDJ_(G)), intent (in) :: dxdyh - real, intent(in) :: dens_ratio - integer, intent(in) :: is, ie, js, je + real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & + intent(inout) :: uret !< The retarding stresses working at u-points. + real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & + intent(inout) :: vret !< The retarding stresses working at v-points. + real, dimension(SZDI_(G),SZDJ_(G),8,4), & + intent(in) :: Phi !< The gradients of bilinear basis elements at Gaussian + !! quadrature points surrounding the cell verticies. + real, dimension(:,:,:,:,:,:), & + intent(in) :: Phisub !< Quadrature structure weights at subgridscale + !! locations for finite element calculations + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(in) :: u !< The zonal ice shelf velocity at vertices, in m/year + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(in) :: v !< The meridional ice shelf velocity at vertices, in m/year + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(in) :: umask !< A coded mask indicating the nature of the + !! zonal flow at the corner point + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(in) :: vmask !< A coded mask indicating the nature of the + !! meridional flow at the corner point + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(in) :: H_node !< The ice shelf thickness at nodal (corner) + !! points, in m. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: hmask !< A mask indicating which tracer points are + !! partly or fully covered by an ice-shelf + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(in) :: nu !< A field related to the ice viscosity from Glen's + !! flow law. The exact form and units depend on the + !! basal law exponent. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: float_cond !< An array indicating where the ice + !! shelf is floating: 0 if floating, 1 if not. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points, in m. + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(in) :: beta !< A field related to the nonlinear part of + !! the "linearized" basal stress. The exact form and + !! units depend on the basal law exponent. + ! and/or whether flow is "hybridized" + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: dxdyh !< The tracer cell area, in m2 + real, intent(in) :: dens_ratio !< The density of ice divided by the density + !! of seawater, nondimensional + integer, intent(in) :: is !< The starting i-index to work on + integer, intent(in) :: ie !< The ending i-index to work on + integer, intent(in) :: js !< The starting j-index to work on + integer, intent(in) :: je !< The ending j-index to work on ! the linear action of the matrix on (u,v) with bilinear finite elements ! as of now everything is passed in so no grid pointers or anything of the sort have to be dereferenced, @@ -2457,10 +2522,10 @@ subroutine CG_action(uret, vret, u, v, Phi, Phisub, umask, vmask, hmask, H_node, enddo ; enddo if (float_cond(i,j) == 1) then - Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = D(i,j) + Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = bathyT(i,j) Ucell(:,:) = u(i-1:i,j-1:j) ; Vcell(:,:) = v(i-1:i,j-1:j) ; Hcell(:,:) = H_node(i-1:i,j-1:j) call CG_action_subgrid_basal & - (Phisub, Hcell, Ucell, Vcell, area, basel, dens_ratio, Usubcontr, Vsubcontr, i, j) + (Phisub, Hcell, Ucell, Vcell, area, basel, dens_ratio, Usubcontr, Vsubcontr) do iphi=1,2 ; do jphi=1,2 if (umask(i-2+iphi,j-2+jphi) == 1) then uret(i-2+iphi,j-2+jphi) = uret(i-2+iphi,j-2+jphi) + Usubcontr (iphi,jphi) * beta(i,j) @@ -2476,46 +2541,39 @@ subroutine CG_action(uret, vret, u, v, Phi, Phisub, umask, vmask, hmask, H_node, end subroutine CG_action -subroutine CG_action_subgrid_basal(Phisub, H, U, V, DXDYH, D, dens_ratio, Ucontr, Vcontr, iin, jin) - real, dimension(:,:,:,:,:,:), intent(in) :: Phisub - real, dimension(2,2), intent(in) :: H,U,V - real, intent(in) :: DXDYH, D, dens_ratio - real, dimension(2,2), intent(inout) :: Ucontr, Vcontr - integer, optional, intent(in) :: iin, jin - - ! D = cellwise-constant bed elevation +subroutine CG_action_subgrid_basal(Phisub, H, U, V, DXDYH, bathyT, dens_ratio, Ucontr, Vcontr) + real, dimension(:,:,:,:,:,:), & + intent(in) :: Phisub !< Quadrature structure weights at subgridscale + !! locations for finite element calculations + real, dimension(2,2), intent(in) :: H !< The ice shelf thickness at nodal (corner) points, in m. + real, dimension(2,2), intent(in) :: U !< The zonal ice shelf velocity at vertices, in m/year + real, dimension(2,2), intent(in) :: V !< The meridional ice shelf velocity at vertices, in m/year + real, intent(in) :: DXDYH !< The tracer cell area, in m2 + real, intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points, in m. + real, intent(in) :: dens_ratio !< The density of ice divided by the density + !! of seawater, nondimensional + real, dimension(2,2), intent(inout) :: Ucontr !< A field related to the subgridscale contributions to + !! the u-direction basal stress. + real, dimension(2,2), intent(inout) :: Vcontr !< A field related to the subgridscale contributions to + !! the v-direction basal stress. - integer :: nsub, i, j, k, l, qx, qy, m, n, i_m, j_m + integer :: nsub, i, j, k, l, qx, qy, m, n real :: subarea, hloc, uq, vq nsub = size(Phisub,1) subarea = DXDYH / (nsub**2) - - if (.not. present(iin)) then - i_m = -1 - else - i_m = iin - endif - - if (.not. present(jin)) then - j_m = -1 - else - j_m = jin - endif - - do m=1,2 do n=1,2 do j=1,nsub do i=1,nsub do qx=1,2 do qy = 1,2 + + hloc = Phisub(i,j,1,1,qx,qy)*H(1,1) + Phisub(i,j,1,2,qx,qy)*H(1,2) + & + Phisub(i,j,2,1,qx,qy)*H(2,1) + Phisub(i,j,2,2,qx,qy)*H(2,2) - hloc = Phisub(i,j,1,1,qx,qy)*H(1,1)+Phisub(i,j,1,2,qx,qy)*H(1,2)+& - Phisub(i,j,2,1,qx,qy)*H(2,1)+Phisub(i,j,2,2,qx,qy)*H(2,2) - - if (dens_ratio * hloc - D > 0) then + if (dens_ratio * hloc - bathyT > 0) then !if (.true.) then uq = 0 ; vq = 0 do k=1,2 @@ -2526,8 +2584,8 @@ subroutine CG_action_subgrid_basal(Phisub, H, U, V, DXDYH, D, dens_ratio, Ucontr enddo enddo - Ucontr (m,n) = Ucontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * uq - Vcontr (m,n) = Vcontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * vq + Ucontr(m,n) = Ucontr(m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * uq + Vcontr(m,n) = Vcontr(m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * vq endif @@ -2540,24 +2598,39 @@ subroutine CG_action_subgrid_basal(Phisub, H, U, V, DXDYH, D, dens_ratio, Ucontr end subroutine CG_action_subgrid_basal - +!> returns the diagonal entries of the matrix for a Jacobi preconditioning subroutine matrix_diagonal(CS, G, float_cond, H_node, nu, beta, hmask, dens_ratio, & Phisub, u_diagonal, v_diagonal) - type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: float_cond - real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: H_node !< The ice shelf thickness at nodal + intent(in) :: float_cond !< An array indicating where the ice + !! shelf is floating: 0 if floating, 1 if not. + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(in) :: H_node !< The ice shelf thickness at nodal !! (corner) points, in m. - real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: nu - real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: beta + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(in) :: nu !< A field related to the ice viscosity from Glen's + !! flow law. The exact form and units depend on the + !! basal law exponent. + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(in) :: beta !< A field related to the nonlinear part of + !! the "linearized" basal stress. The exact form and + !! units depend on the basal law exponent real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: hmask !< A mask indicating which tracer points are + intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf - real :: dens_ratio - real, dimension(:,:,:,:,:,:), intent(in) :: Phisub - real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u_diagonal, v_diagonal + real, intent(in) :: dens_ratio !< The density of ice divided by the density + !! of seawater, nondimensional + real, dimension(:,:,:,:,:,:), intent(in) :: Phisub !< Quadrature structure weights at subgridscale + !! locations for finite element calculations + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(inout) :: u_diagonal !< The diagonal elements of the u-velocity + !! matrix from the left-hand side of the solver. + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(inout) :: v_diagonal !< The diagonal elements of the v-velocity + !! matrix from the left-hand side of the solver. ! returns the diagonal entries of the matrix for a Jacobi preconditioning @@ -2605,17 +2678,17 @@ subroutine matrix_diagonal(CS, G, float_cond, H_node, nu, beta, hmask, dens_rati do iphi=1,2 ; do jphi=1,2 - if (iq == iphi) then - ilq = 2 - else - ilq = 1 - endif + if (iq == iphi) then + ilq = 2 + else + ilq = 1 + endif - if (jq == jphi) then - jlq = 2 - else - jlq = 1 - endif + if (jq == jphi) then + jlq = 2 + else + jlq = 1 + endif if (CS%umask(i-2+iphi,j-2+jphi) == 1) then @@ -2674,13 +2747,22 @@ subroutine matrix_diagonal(CS, G, float_cond, H_node, nu, beta, hmask, dens_rati end subroutine matrix_diagonal -subroutine CG_diagonal_subgrid_basal (Phisub, H, DXDYH, D, dens_ratio, Ucontr, Vcontr) - real, dimension(:,:,:,:,:,:), intent(in) :: Phisub - real, dimension(2,2), intent(in) :: H - real, intent(in) :: DXDYH, D, dens_ratio - real, dimension(2,2), intent(inout) :: Ucontr, Vcontr - - ! D = cellwise-constant bed elevation +subroutine CG_diagonal_subgrid_basal (Phisub, H_node, DXDYH, bathyT, dens_ratio, Ucontr, Vcontr) + real, dimension(:,:,:,:,:,:), & + intent(in) :: Phisub !< Quadrature structure weights at subgridscale + !! locations for finite element calculations + real, dimension(2,2), intent(in) :: H_node !< The ice shelf thickness at nodal (corner) + !! points, in m + real, intent(in) :: DXDYH !< The tracer cell area, in m2 + real, intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points, in m + real, intent(in) :: dens_ratio !< The density of ice divided by the density + !! of seawater, nondimensional + real, dimension(2,2), intent(inout) :: Ucontr !< A field related to the subgridscale contributions to + !! the u-direction diagonal elements from basal stress. + real, dimension(2,2), intent(inout) :: Vcontr !< A field related to the subgridscale contributions to + !! the v-direction diagonal elements from basal stress. + + ! bathyT = cellwise-constant bed elevation integer :: nsub, i, j, k, l, qx, qy, m, n real :: subarea, hloc @@ -2688,28 +2770,17 @@ subroutine CG_diagonal_subgrid_basal (Phisub, H, DXDYH, D, dens_ratio, Ucontr, V nsub = size(Phisub,1) subarea = DXDYH / (nsub**2) - do m=1,2 - do n=1,2 - do j=1,nsub - do i=1,nsub - do qx=1,2 - do qy = 1,2 + do m=1,2 ; do n=1,2 ; do j=1,nsub ; do i=1,nsub ; do qx=1,2 ; do qy = 1,2 - hloc = Phisub(i,j,1,1,qx,qy)*H(1,1)+Phisub(i,j,1,2,qx,qy)*H(1,2)+& - Phisub(i,j,2,1,qx,qy)*H(2,1)+Phisub(i,j,2,2,qx,qy)*H(2,2) - - if (dens_ratio * hloc - D > 0) then - Ucontr (m,n) = Ucontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy)**2 - Vcontr (m,n) = Vcontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy)**2 - endif + hloc = Phisub(i,j,1,1,qx,qy)*H_node(1,1) + Phisub(i,j,1,2,qx,qy)*H_node(1,2) + & + Phisub(i,j,2,1,qx,qy)*H_node(2,1) + Phisub(i,j,2,2,qx,qy)*H_node(2,2) + if (dens_ratio * hloc - bathyT > 0) then + Ucontr(m,n) = Ucontr(m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy)**2 + Vcontr(m,n) = Vcontr(m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy)**2 + endif - enddo - enddo - enddo - enddo - enddo - enddo + enddo ; enddo ; enddo ; enddo ; enddo ; enddo end subroutine CG_diagonal_subgrid_basal @@ -2717,19 +2788,36 @@ end subroutine CG_diagonal_subgrid_basal subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, float_cond, & dens_ratio, u_bdry_contr, v_bdry_contr) - type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure - type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe - !! the ice-shelf state - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - type(time_type), intent(in) :: Time !< The current model time - real, dimension(:,:,:,:,:,:), intent(in) :: Phisub - real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: H_node !< The ice shelf thickness at nodal + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe + !! the ice-shelf state + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + type(time_type), intent(in) :: Time !< The current model time + real, dimension(:,:,:,:,:,:), & + intent(in) :: Phisub !< Quadrature structure weights at subgridscale + !! locations for finite element calculations + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(in) :: H_node !< The ice shelf thickness at nodal !! (corner) points, in m. - real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: nu - real, dimension(SZDIB_(G),SZDJB_(G)), intent(in) :: beta - real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: float_cond - real :: dens_ratio - real, dimension(SZDIB_(G),SZDJB_(G)), intent(inout) :: u_bdry_contr, v_bdry_contr + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(in) :: nu !< A field related to the ice viscosity from Glen's + !! flow law. The exact form and units depend on the + !! basal law exponent. + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(in) :: beta !< A field related to the nonlinear part of + !! the "linearized" basal stress. The exact form and + !! units depend on the basal law exponent + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: float_cond !< An array indicating where the ice + !! shelf is floating: 0 if floating, 1 if not. + real, intent(in) :: dens_ratio !< The density of ice divided by the density + !! of seawater, nondimensional + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(inout) :: u_bdry_contr !< Contributions to the zonal ice + !! velocities due to the open boundaries + real, dimension(SZDIB_(G),SZDJB_(G)), & + intent(inout) :: v_bdry_contr !< Contributions to the zonal ice + !! velocities due to the open boundaries ! this will be a per-setup function. the boundary values of thickness and velocity ! (and possibly other variables) will be updated in this function @@ -2880,16 +2968,17 @@ subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, flo end subroutine apply_boundary_values - +!> Update depth integrated viscosity, based on horizontal strain rates, and also update the +!! nonlinear part of the basal traction. subroutine calc_shelf_visc(CS, ISS, G, u, v) type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure - type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe - !! the ice-shelf state - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe + !! the ice-shelf state + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & - intent(inout) :: u !< The zonal ice shelf velocity, in m/s. + intent(inout) :: u !< The zonal ice shelf velocity, in m/year. real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & - intent(inout) :: v !< The meridional ice shelf velocity, in m/s. + intent(inout) :: v !< The meridional ice shelf velocity, in m/year. ! update DEPTH_INTEGRATED viscosity, based on horizontal strain rates - this is for bilinear FEM solve ! so there is an "upper" and "lower" bilinear viscosity @@ -3008,10 +3097,15 @@ subroutine update_OD_ffrac_uncoupled(CS, G, h_shelf) end subroutine update_OD_ffrac_uncoupled +!> This subroutine calculates the gradients of bilinear basis elements that +!! that are centered at the vertices of the cell. values are calculated at +!! points of gaussian quadrature. subroutine bilinear_shape_functions (X, Y, Phi, area) - real, dimension(4), intent(in) :: X, Y - real, dimension(8,4), intent (inout) :: Phi - real, intent (out) :: area + real, dimension(4), intent(in) :: X !< The x-positions of the vertices of the quadrilateral. + real, dimension(4), intent(in) :: Y !< The y-positions of the vertices of the quadrilateral. + real, dimension(8,4), intent(inout) :: Phi !< The gradients of bilinear basis elements at Gaussian + !! quadrature points surrounding the cell verticies. + real, intent(out) :: area !< The quadrilateral cell area, in m2. ! X and Y must be passed in the form ! 3 - 4 @@ -3066,14 +3160,16 @@ subroutine bilinear_shape_functions (X, Y, Phi, area) enddo enddo - area = quad_area (X,Y) + area = quad_area(X, Y) end subroutine bilinear_shape_functions -subroutine bilinear_shape_functions_subgrid (Phisub, nsub) - real, dimension(nsub,nsub,2,2,2,2), intent(inout) :: Phisub - integer :: nsub +subroutine bilinear_shape_functions_subgrid(Phisub, nsub) + real, dimension(nsub,nsub,2,2,2,2), & + intent(inout) :: Phisub !< Quadrature structure weights at subgridscale + !! locations for finite element calculations + integer, intent(in) :: nsub !< The nubmer of subgridscale quadrature locations in each direction ! this subroutine is a helper for interpolation of floatation condition ! for the purposes of evaluating the terms \int (u,v) \phi_i dx dy in a cell that is @@ -3503,14 +3599,20 @@ end subroutine ice_shelf_temp subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, flux_enter) - type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure - type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step !< The time step for this update, in s. - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask !< A mask indicating which tracer points are + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real, intent(in) :: time_step !< The time step for this update, in s. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf - real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h0 - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_uflux - real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: h0 !< The initial ice shelf thicknesses in m. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: h_after_uflux !< The ice shelf thicknesses after + !! the zonal mass fluxes, in m. + real, dimension(SZDI_(G),SZDJ_(G),4), & + intent(inout) :: flux_enter !< The integrated temperature flux into + !! the cell through the 4 cell boundaries, in degC m3 ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells @@ -3599,7 +3701,7 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(-1) / dxdyh elseif (hmask(i-1,j) * hmask(i-2,j) == 1) then ! h(i-2) and h(i-1) are valid - phi = slope_limiter (stencil(-1)-stencil(-2), stencil(0)-stencil(-1)) + phi = slope_limiter(stencil(-1)-stencil(-2), stencil(0)-stencil(-1)) flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh* time_step / dxdyh * & (stencil(-1) - phi * (stencil(-1)-stencil(0))/2) @@ -3613,7 +3715,7 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f elseif (u_face < 0) then !flux is out of cell - we need info from h(i-1), h(i+1) if available if (hmask(i-1,j) * hmask(i+1,j) == 1) then ! h(i-1) and h(i+1) are both valid - phi = slope_limiter (stencil(0)-stencil(1), stencil(-1)-stencil(0)) + phi = slope_limiter(stencil(0)-stencil(1), stencil(-1)-stencil(0)) flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * & (stencil(0) - phi * (stencil(0)-stencil(-1))/2) @@ -3651,7 +3753,7 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f elseif (hmask(i+1,j) * hmask(i+2,j) == 1) then ! h(i+2) and h(i+1) are valid - phi = slope_limiter (stencil(1)-stencil(2), stencil(0)-stencil(1)) + phi = slope_limiter(stencil(1)-stencil(2), stencil(0)-stencil(1)) flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step / dxdyh * & (stencil(1) - phi * (stencil(1)-stencil(0))/2) @@ -3667,7 +3769,7 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f if (hmask(i-1,j) * hmask(i+1,j) == 1) then ! h(i-1) and h(i+1) are both valid - phi = slope_limiter (stencil(0)-stencil(-1), stencil(1)-stencil(0)) + phi = slope_limiter(stencil(0)-stencil(-1), stencil(1)-stencil(0)) flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * & (stencil(0) - phi * (stencil(0)-stencil(1))/2) @@ -3738,14 +3840,21 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f end subroutine ice_shelf_advect_temp_x subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_after_vflux, flux_enter) - type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step !< The time step for this update, in s. - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: hmask !< A mask indicating which tracer points are + type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, intent(in) :: time_step !< The time step for this update, in s. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf - real, dimension(SZDI_(G),SZDJ_(G)), intent(in) :: h_after_uflux - real, dimension(SZDI_(G),SZDJ_(G)), intent(inout) :: h_after_vflux - real, dimension(SZDI_(G),SZDJ_(G),4), intent(inout) :: flux_enter + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: h_after_uflux !< The ice shelf thicknesses after + !! the zonal mass fluxes, in m. + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: h_after_vflux !< The ice shelf thicknesses after + !! the meridional mass fluxes, in m. + real, dimension(SZDI_(G),SZDJ_(G),4), & + intent(inout) :: flux_enter !< The integrated temperature flux into + !! the cell through the 4 cell boundaries, in degC m3 ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells @@ -3829,7 +3938,7 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft elseif (hmask(i,j-1) * hmask(i,j-2) == 1) then ! h(j-2) and h(j-1) are valid - phi = slope_limiter (stencil(-1)-stencil(-2), stencil(0)-stencil(-1)) + phi = slope_limiter(stencil(-1)-stencil(-2), stencil(0)-stencil(-1)) flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * & (stencil(-1) - phi * (stencil(-1)-stencil(0))/2) @@ -3842,7 +3951,7 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft elseif (v_face < 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available if (hmask(i,j-1) * hmask(i,j+1) == 1) then ! h(j-1) and h(j+1) are both valid - phi = slope_limiter (stencil(0)-stencil(1), stencil(-1)-stencil(0)) + phi = slope_limiter(stencil(0)-stencil(1), stencil(-1)-stencil(0)) flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * & (stencil(0) - phi * (stencil(0)-stencil(-1))/2) else From 795f651a6c1bf0f4d582e8676f53980e0bba0e28 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 1 Jun 2018 11:13:05 -0400 Subject: [PATCH 0330/1072] Fixed trailing white space --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index eb605c9d28..5cf01b10ac 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -2362,16 +2362,16 @@ subroutine CG_action(uret, vret, u, v, Phi, Phisub, umask, vmask, hmask, H_node, !! partly or fully covered by an ice-shelf real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: nu !< A field related to the ice viscosity from Glen's - !! flow law. The exact form and units depend on the - !! basal law exponent. + !! flow law. The exact form and units depend on the + !! basal law exponent. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: float_cond !< An array indicating where the ice !! shelf is floating: 0 if floating, 1 if not. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points, in m. real, dimension(SZDIB_(G),SZDJB_(G)), & - intent(in) :: beta !< A field related to the nonlinear part of - !! the "linearized" basal stress. The exact form and + intent(in) :: beta !< A field related to the nonlinear part of the + !! "linearized" basal stress. The exact form and !! units depend on the basal law exponent. ! and/or whether flow is "hybridized" real, dimension(SZDI_(G),SZDJ_(G)), & @@ -2569,7 +2569,7 @@ subroutine CG_action_subgrid_basal(Phisub, H, U, V, DXDYH, bathyT, dens_ratio, U do i=1,nsub do qx=1,2 do qy = 1,2 - + hloc = Phisub(i,j,1,1,qx,qy)*H(1,1) + Phisub(i,j,1,2,qx,qy)*H(1,2) + & Phisub(i,j,2,1,qx,qy)*H(2,1) + Phisub(i,j,2,2,qx,qy)*H(2,2) @@ -2615,8 +2615,8 @@ subroutine matrix_diagonal(CS, G, float_cond, H_node, nu, beta, hmask, dens_rati !! flow law. The exact form and units depend on the !! basal law exponent. real, dimension(SZDIB_(G),SZDJB_(G)), & - intent(in) :: beta !< A field related to the nonlinear part of - !! the "linearized" basal stress. The exact form and + intent(in) :: beta !< A field related to the nonlinear part of the + !! "linearized" basal stress. The exact form and !! units depend on the basal law exponent real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are @@ -2804,8 +2804,8 @@ subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, flo !! flow law. The exact form and units depend on the !! basal law exponent. real, dimension(SZDIB_(G),SZDJB_(G)), & - intent(in) :: beta !< A field related to the nonlinear part of - !! the "linearized" basal stress. The exact form and + intent(in) :: beta !< A field related to the nonlinear part of the + !! "linearized" basal stress. The exact form and !! units depend on the basal law exponent real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: float_cond !< An array indicating where the ice From b01dda016ce4761193b5aa8c8f41cd4bfe3c9351 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 1 Jun 2018 14:02:24 -0600 Subject: [PATCH 0331/1072] Clean unecessary layer-related code --- .../vertical/MOM_diabatic_driver.F90 | 180 ++++++------------ 1 file changed, 53 insertions(+), 127 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 1f0b640a2c..0f66625f49 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -293,7 +293,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & Kd, & ! diapycnal diffusivity of layers (m^2/sec) h_orig, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) - hold, & ! layer thickness before diapycnal entrainment, and later +! hold, & ! layer thickness before diapycnal entrainment, and later ! the initial layer thicknesses (if a mixed layer is used), ! (m for Bouss, kg/m^2 for non-Bouss) dSV_dT, & ! The partial derivatives of specific volume with temperature @@ -723,28 +723,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & !$OMP end parallel endif - - ! set ea_t=eb_t=Kd_heat and ea_s=eb_s=Kd_salt on interfaces for use in the - ! tri-diagonal solver. - - do j=js,je ; do i=is,ie - ea_t(i,j,1) = 0.; ea_s(i,j,1) = 0. - enddo ; enddo - -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_neglect,h,ea_t,ea_s,GV,dt,Kd_salt,Kd_heat,eb_t,eb_s) & -!$OMP private(hval) - do k=2,nz ; do j=js,je ; do i=is,ie - hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea_t(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_heat(i,j,k) - eb_t(i,j,k-1) = ea_t(i,j,k) - ea_s(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_salt(i,j,k) - eb_s(i,j,k-1) = ea_s(i,j,k) - enddo ; enddo ; enddo - do j=js,je ; do i=is,ie - eb_t(i,j,nz) = 0.; eb_s(i,j,nz) = 0. - enddo ; enddo - if (showCallTree) call callTree_waypoint("done setting ea_t,ea_s,eb_t,eb_s from Kd_heat and Kd_salt (diabatic)") - ! Save fields before boundary forcing is applied for tendency diagnostics if (CS%boundary_forcing_tendency_diag) then do k=1,nz ; do j=js,je ; do i=is,ie @@ -789,7 +767,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & Hml(:,:) = visc%MLD(:,:) endif - ! Augment the diffusivities due to those diagnosed in energetic_PBL. + ! Augment the diffusivities and viscosity due to those diagnosed in energetic_PBL. do K=2,nz ; do j=js,je ; do i=is,ie if (CS%ePBL_is_additive) then Kd_add_here = Kd_ePBL(i,j,K) @@ -798,17 +776,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) endif - Ent_int = Kd_add_here * (GV%m_to_H**2 * dt) / & - (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) - eb_t(i,j,k-1) = eb_t(i,j,k-1) + Ent_int - ea_t(i,j,k) = ea_t(i,j,k) + Ent_int - eb_s(i,j,k-1) = eb_s(i,j,k-1) + Ent_int - ea_s(i,j,k) = ea_s(i,j,k) + Ent_int - Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here - - ! for diagnostics - Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_int(i,j,K) - Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_int(i,j,K) + + Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_add_here + Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_add_here enddo ; enddo ; enddo @@ -845,54 +815,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G) - ! Update h according to divergence of the difference between - ! ea and eb. We keep a record of the original h in hold. - ! In the following, the checks for negative values are to guard - ! against instances where entrainment drives a layer to - ! negative thickness. This situation will never happen if - ! enough iterations are permitted in Calculate_Entrainment. - ! Even if too few iterations are allowed, it is still guarded - ! against. In other words the checks are probably unnecessary. - - ! GMM, should the code below be deleted? eb(i,j,k-1) = ea(i,j,k), - ! see above, so h should not change. - - !$OMP parallel do default(shared) - do j=js,je - do i=is,ie - hold(i,j,1) = h(i,j,1) - h(i,j,1) = h(i,j,1) + (eb_t(i,j,1) - ea_t(i,j,2)) - hold(i,j,nz) = h(i,j,nz) - h(i,j,nz) = h(i,j,nz) + (ea_t(i,j,nz) - eb_t(i,j,nz-1)) - if (h(i,j,1) <= 0.0) then - h(i,j,1) = GV%Angstrom - endif - if (h(i,j,nz) <= 0.0) then - h(i,j,nz) = GV%Angstrom - endif - enddo - do k=2,nz-1 ; do i=is,ie - hold(i,j,k) = h(i,j,k) - h(i,j,k) = h(i,j,k) + ((ea_t(i,j,k) - eb_t(i,j,k-1)) + & - (eb_t(i,j,k) - ea_t(i,j,k+1))) - if (h(i,j,k) <= 0.0) then - h(i,j,k) = GV%Angstrom - endif - enddo ; enddo - enddo - ! Checks for negative thickness may have changed layer thicknesses - call diag_update_remap_grids(CS%diag) - - if (CS%debug) then - call MOM_state_chksum("after negative check ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("after negative check ", fluxes, G, haloshift=0) - call MOM_thermovar_chksum("after negative check ", tv, G) - endif - if (showCallTree) call callTree_waypoint("done with h=ea-eb (diabatic)") if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G) - ! calculate change in temperature & salinity due to dia-coordinate surface diffusion if (associated(tv%T)) then @@ -920,29 +845,53 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & enddo ; enddo ; enddo endif - ! Changes T and S via the tridiagonal solver; no change to h - call tracer_vertdiff(hold, ea_t, eb_t, dt, tv%T, G, GV) - call tracer_vertdiff(hold, ea_s, eb_s, dt, tv%S, G, GV) - - ! GMM, with the new approach of having ea,eb for temp and salt - ! only tracer_vertdiff can be used at this time. Therefore, - ! I am commenting the following code. Should this be deleted? - - !if (CS%tracer_tridiag) then - ! call tracer_vertdiff(hold, ea_t, eb_t, dt, tv%T, G, GV) - ! call tracer_vertdiff(hold, ea_s, eb_s, dt, tv%S, G, GV) - !else - ! - ! call triDiagTS(G, GV, is, ie, js, je, hold, ea_t, eb_t, tv%T, tv%S) - !endif - - ! diagnose temperature, salinity, heat, and salt tendencies - ! Note: hold here refers to the thicknesses from before the dual-entraintment when using - ! the bulk mixed layer scheme. Otherwise in ALE-mode, layer thicknesses will have changed - ! In either case, tendencies should be posted on hold + ! set ea_t=eb_t=Kd_heat and ea_s=eb_s=Kd_salt on interfaces for use in the + ! tri-diagonal solver. + + do j=js,je ; do i=is,ie + ea_t(i,j,1) = 0.; ea_s(i,j,1) = 0. + enddo ; enddo + +!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_neglect,h,ea_t,ea_s,GV,dt,Kd_salt,Kd_heat,eb_t,eb_s) & +!$OMP private(hval) + do k=2,nz ; do j=js,je ; do i=is,ie + hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) + ea_t(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_heat(i,j,k) + eb_t(i,j,k-1) = ea_t(i,j,k) + ea_s(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_salt(i,j,k) + eb_s(i,j,k-1) = ea_s(i,j,k) + enddo ; enddo ; enddo + do j=js,je ; do i=is,ie + eb_t(i,j,nz) = 0.; eb_s(i,j,nz) = 0. + enddo ; enddo + if (showCallTree) call callTree_waypoint("done setting ea_t,ea_s,eb_t,eb_s from Kd_heat" //& + "and Kd_salt (diabatic)") + + ! Initialize halo regions of ea, eb, and hold to default values. + !$OMP parallel do default(shared) + do k=1,nz + do i=is-1,ie+1 + ea_t(i,js-1,k) = 0.0 ; eb_t(i,js-1,k) = 0.0 + ea_s(i,js-1,k) = 0.0 ; eb_s(i,js-1,k) = 0.0 + ea_t(i,je+1,k) = 0.0 ; eb_t(i,je+1,k) = 0.0 + ea_s(i,je+1,k) = 0.0 ; eb_s(i,je+1,k) = 0.0 + enddo + do j=js,je + ea_t(is-1,j,k) = 0.0 ; eb_t(is-1,j,k) = 0.0 + ea_s(is-1,j,k) = 0.0 ; eb_s(is-1,j,k) = 0.0 + ea_t(ie+1,j,k) = 0.0 ; eb_t(ie+1,j,k) = 0.0 + ea_s(ie+1,j,k) = 0.0 ; eb_s(ie+1,j,k) = 0.0 + enddo + enddo + + ! Changes T and S via the tridiagonal solver; no change to h + call tracer_vertdiff(h, ea_t, eb_t, dt, tv%T, G, GV) + call tracer_vertdiff(h, ea_s, eb_s, dt, tv%S, G, GV) + + + ! In ALE-mode, layer thicknesses do not change. Therefore, we can use h below if (CS%diabatic_diff_tendency_diag) then - call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, CS) - if (CS%id_diabatic_diff_h > 0) call post_data(CS%id_diabatic_diff_h, hold, CS%diag, alt_h = hold) + call diagnose_diabatic_diff_tendency(tv, h, temp_diag, saln_diag, dt, G, GV, CS) endif call cpu_clock_end(id_clock_tridiag) @@ -1033,7 +982,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / & - (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & + (0.5 * (h(i,j,k-1) + h(i,j,k)) + & h_neglect) ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent eatr(i,j,k) = eatr(i,j,k) + add_ent @@ -1059,7 +1008,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & do k=nz,2,-1 ; do j=js,je ; do i=is,ie if (visc%Kd_extra_S(i,j,k) > 0.0) then add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / & - (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & + (0.5 * (h(i,j,k-1) + h(i,j,k)) + & h_neglect) else add_ent = 0.0 @@ -1100,32 +1049,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif endif ! CS%use_sponge - - ! Initialize halo regions of ea, eb, and hold to default values. - !$OMP parallel do default(shared) - do k=1,nz - do i=is-1,ie+1 - hold(i,js-1,k) = GV%Angstrom - ea_t(i,js-1,k) = 0.0 ; eb_t(i,js-1,k) = 0.0 - ea_s(i,js-1,k) = 0.0 ; eb_s(i,js-1,k) = 0.0 - hold(i,je+1,k) = GV%Angstrom - ea_t(i,je+1,k) = 0.0 ; eb_t(i,je+1,k) = 0.0 - ea_s(i,je+1,k) = 0.0 ; eb_s(i,je+1,k) = 0.0 - enddo - do j=js,je - hold(is-1,j,k) = GV%Angstrom - ea_t(is-1,j,k) = 0.0 ; eb_t(is-1,j,k) = 0.0 - ea_s(is-1,j,k) = 0.0 ; eb_s(is-1,j,k) = 0.0 - hold(ie+1,j,k) = GV%Angstrom - ea_t(ie+1,j,k) = 0.0 ; eb_t(ie+1,j,k) = 0.0 - ea_s(ie+1,j,k) = 0.0 ; eb_s(ie+1,j,k) = 0.0 - enddo - enddo - call cpu_clock_begin(id_clock_pass) if (G%symmetric) then ; dir_flag = To_All+Omit_Corners else ; dir_flag = To_West+To_South+Omit_Corners ; endif - call create_group_pass(CS%pass_hold_eb_ea, hold, G%Domain, dir_flag, halo=1) call create_group_pass(CS%pass_hold_eb_ea, eb_t, G%Domain, dir_flag, halo=1) call create_group_pass(CS%pass_hold_eb_ea, eb_s, G%Domain, dir_flag, halo=1) call create_group_pass(CS%pass_hold_eb_ea, ea_t, G%Domain, dir_flag, halo=1) From 5a8b9db58ff17aa003d29dd9c922cca667ed1713 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 1 Jun 2018 16:40:28 -0400 Subject: [PATCH 0332/1072] Revert "Revert "Merge pull request #776 from ESMG/dev/esmg"" - This reverts commit 2c9bf18a8ef95306f9d9571809ec708b3e05182a in order to merge in dev/master which included changes that were reverted. - The revert was temporary until subsequent commits were made to address issues. --- src/core/MOM.F90 | 3 + src/core/MOM_variables.F90 | 3 + .../vertical/MOM_CVMix_conv.F90 | 1 + .../vertical/MOM_CVMix_ddiff.F90 | 301 +++++++++++ .../vertical/MOM_CVMix_shear.F90 | 61 ++- src/parameterizations/vertical/MOM_KPP.F90 | 2 +- .../vertical/MOM_bkgnd_mixing.F90 | 2 +- .../vertical/MOM_diabatic_aux.F90 | 249 ++++----- .../vertical/MOM_diabatic_driver.F90 | 43 +- .../vertical/MOM_set_diffusivity.F90 | 486 ++++++------------ .../vertical/MOM_set_viscosity.F90 | 112 ++-- .../vertical/MOM_vert_friction.F90 | 82 ++- 12 files changed, 781 insertions(+), 564 deletions(-) create mode 100644 src/parameterizations/vertical/MOM_CVMix_ddiff.F90 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 346f86005e..bdd1f159cf 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2378,6 +2378,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (associated(CS%visc%Kv_shear)) & call pass_var(CS%visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) + if (associated(CS%visc%Kv_slow)) & + call pass_var(CS%visc%Kv_slow, G%Domain, To_All+Omit_Corners, halo=1) + call cpu_clock_end(id_clock_pass_init) call register_obsolete_diagnostics(param_file, CS%diag) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 09305eb9fb..02b0b622a3 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -233,6 +233,9 @@ module MOM_variables !! convection etc). TKE_turb => NULL() !< The turbulent kinetic energy per unit mass defined !! at the interfaces between each layer, in m2 s-2. + logical :: add_Kv_slow !< If True, adds Kv_slow when calculating the + !! 'coupling coefficient' (a[k]) at the interfaces. + !! This is done in find_coupling_coef. end type vertvisc_type !> The BT_cont_type structure contains information about the summed layer diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index cdb26a49e1..638c3f0a2d 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -212,6 +212,7 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, CS, hbl) iFaceHeight(k+1) = iFaceHeight(k) - dh enddo + ! gets index of the level and interface above hbl kOBL = CVMix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl(i,j)) call CVMix_coeffs_conv(Mdiff_out=CS%kv_conv(i,j,:), & diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 new file mode 100644 index 0000000000..7137aabfa6 --- /dev/null +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -0,0 +1,301 @@ +!> Interface to CVMix double diffusion scheme. +module MOM_CVMix_ddiff + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field +use MOM_diag_mediator, only : post_data +use MOM_EOS, only : calculate_density_derivs +use MOM_variables, only : thermo_var_ptrs +use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE +use MOM_file_parser, only : openParameterBlock, closeParameterBlock +use MOM_debugging, only : hchksum +use MOM_grid, only : ocean_grid_type +use MOM_verticalGrid, only : verticalGrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use cvmix_ddiff, only : cvmix_init_ddiff, CVMix_coeffs_ddiff +use cvmix_kpp, only : CVmix_kpp_compute_kOBL_depth +implicit none ; private + +#include + +public CVMix_ddiff_init, CVMix_ddiff_end, CVMix_ddiff_is_used, compute_ddiff_coeffs + +!> Control structure including parameters for CVMix double diffusion. +type, public :: CVMix_ddiff_cs + + ! Parameters + real :: strat_param_max !< maximum value for the stratification parameter (nondim) + real :: kappa_ddiff_s !< leading coefficient in formula for salt-fingering regime + !! for salinity diffusion (m^2/s) + real :: ddiff_exp1 !< interior exponent in salt-fingering regime formula (nondim) + real :: ddiff_exp2 !< exterior exponent in salt-fingering regime formula (nondim) + real :: mol_diff !< molecular diffusivity (m^2/s) + real :: kappa_ddiff_param1 !< exterior coefficient in diffusive convection regime (nondim) + real :: kappa_ddiff_param2 !< middle coefficient in diffusive convection regime (nondim) + real :: kappa_ddiff_param3 !< interior coefficient in diffusive convection regime (nondim) + real :: min_thickness !< Minimum thickness allowed (m) + character(len=4) :: diff_conv_type !< type of diffusive convection to use. Options are Marmorino & + !! Caldwell 1976 ("MC76"; default) and Kelley 1988, 1990 ("K90") + logical :: debug !< If true, turn on debugging + + ! Daignostic handles and pointers + type(diag_ctrl), pointer :: diag => NULL() + integer :: id_KT_extra = -1, id_KS_extra = -1, id_R_rho = -1 + + ! Diagnostics arrays + real, allocatable, dimension(:,:,:) :: KT_extra !< double diffusion diffusivity for temp (m2/s) + real, allocatable, dimension(:,:,:) :: KS_extra !< double diffusion diffusivity for salt (m2/s) + real, allocatable, dimension(:,:,:) :: R_rho !< double-diffusion density ratio (nondim) + +end type CVMix_ddiff_cs + +character(len=40) :: mdl = "MOM_CVMix_ddiff" !< This module's name. + +contains + +!> Initialized the CVMix double diffusion module. +logical function CVMix_ddiff_init(Time, G, GV, param_file, diag, CS) + + type(time_type), intent(in) :: Time !< The current time. + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle + type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. + type(CVMix_ddiff_cs), pointer :: CS !< This module's control structure. + +! This include declares and sets the variable "version". +#include "version_variable.h" + + if (associated(CS)) then + call MOM_error(WARNING, "CVMix_ddiff_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + + ! Read parameters + call log_version(param_file, mdl, version, & + "Parameterization of mixing due to double diffusion processes via CVMix") + call get_param(param_file, mdl, "USE_CVMIX_DDIFF", CVMix_ddiff_init, & + "If true, turns on double diffusive processes via CVMix. \n"// & + "Note that double diffusive processes on viscosity are ignored \n"// & + "in CVMix, see http://cvmix.github.io/ for justification.",& + default=.false.) + + if (.not. CVMix_ddiff_init) return + + call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) + + call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, default=0.001, do_not_log=.True.) + + call openParameterBlock(param_file,'CVMIX_DDIFF') + + call get_param(param_file, mdl, "STRAT_PARAM_MAX", CS%strat_param_max, & + "The maximum value for the double dissusion stratification parameter", & + units="nondim", default=2.55) + + call get_param(param_file, mdl, "KAPPA_DDIFF_S", CS%kappa_ddiff_s, & + "Leading coefficient in formula for salt-fingering regime \n"// & + "for salinity diffusion.", units="m2 s-1", default=1.0e-4) + + call get_param(param_file, mdl, "DDIFF_EXP1", CS%ddiff_exp1, & + "Interior exponent in salt-fingering regime formula.", & + units="nondim", default=1.0) + + call get_param(param_file, mdl, "DDIFF_EXP2", CS%ddiff_exp2, & + "Exterior exponent in salt-fingering regime formula.", & + units="nondim", default=3.0) + + call get_param(param_file, mdl, "KAPPA_DDIFF_PARAM1", CS%kappa_ddiff_param1, & + "Exterior coefficient in diffusive convection regime.", & + units="nondim", default=0.909) + + call get_param(param_file, mdl, "KAPPA_DDIFF_PARAM2", CS%kappa_ddiff_param2, & + "Middle coefficient in diffusive convection regime.", & + units="nondim", default=4.6) + + call get_param(param_file, mdl, "KAPPA_DDIFF_PARAM3", CS%kappa_ddiff_param3, & + "Interior coefficient in diffusive convection regime.", & + units="nondim", default=-0.54) + + call get_param(param_file, mdl, "MOL_DIFF", CS%mol_diff, & + "Molecular diffusivity used in CVMix double diffusion.", & + units="m2 s-1", default=1.5e-6) + + call get_param(param_file, mdl, "DIFF_CONV_TYPE", CS%diff_conv_type, & + "type of diffusive convection to use. Options are Marmorino \n" //& + "and Caldwell 1976 (MC76) and Kelley 1988, 1990 (K90).", & + default="MC76") + + call closeParameterBlock(param_file) + + ! Register diagnostics + CS%diag => diag + + CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & + 'Double-diffusive diffusivity for temperature', 'm2 s-1') + + CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & + 'Double-diffusive diffusivity for salinity', 'm2 s-1') + + CS%id_R_rho = register_diag_field('ocean_model','R_rho',diag%axesTi,Time, & + 'Double-diffusion density ratio', 'nondim') + if (CS%id_R_rho > 0) & + allocate(CS%R_rho( SZI_(G), SZJ_(G), SZK_(G)+1)); CS%R_rho(:,:,:) = 0.0 + + call cvmix_init_ddiff(strat_param_max=CS%strat_param_max, & + kappa_ddiff_s=CS%kappa_ddiff_s, & + ddiff_exp1=CS%ddiff_exp1, & + ddiff_exp2=CS%ddiff_exp2, & + mol_diff=CS%mol_diff, & + kappa_ddiff_param1=CS%kappa_ddiff_param1, & + kappa_ddiff_param2=CS%kappa_ddiff_param2, & + kappa_ddiff_param3=CS%kappa_ddiff_param3, & + diff_conv_type=CS%diff_conv_type) + +end function CVMix_ddiff_init + +!> Subroutine for computing vertical diffusion coefficients for the +!! double diffusion mixing parameterization. +subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) + + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_T !< Interface double diffusion diapycnal + !! diffusivity for temp (m2/sec). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_S !< Interface double diffusion diapycnal + !! diffusivity for salt (m2/sec). + type(CVMix_ddiff_cs), pointer :: CS !< The control structure returned + !! by a previous call to CVMix_ddiff_init. + integer, intent(in) :: j !< Meridional grid indice. +! real, dimension(:,:), optional, pointer :: hbl !< Depth of ocean boundary layer (m) + + ! local variables + real, dimension(SZK_(G)) :: & + cellHeight, & !< Height of cell centers (m) + dRho_dT, & !< partial derivatives of density wrt temp (kg m-3 degC-1) + dRho_dS, & !< partial derivatives of density wrt saln (kg m-3 PPT-1) + pres_int, & !< pressure at each interface (Pa) + temp_int, & !< temp and at interfaces (degC) + salt_int, & !< salt at at interfaces + alpha_dT, & !< alpha*dT across interfaces + beta_dS, & !< beta*dS across interfaces + dT, & !< temp. difference between adjacent layers (degC) + dS !< salt difference between adjacent layers + + real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) + integer :: kOBL !< level of OBL extent + real :: pref, g_o_rho0, rhok, rhokm1, dz, dh, hcorr + integer :: i, k + + ! initialize dummy variables + pres_int(:) = 0.0; temp_int(:) = 0.0; salt_int(:) = 0.0 + alpha_dT(:) = 0.0; beta_dS(:) = 0.0; dRho_dT(:) = 0.0 + dRho_dS(:) = 0.0; dT(:) = 0.0; dS(:) = 0.0 + + ! set Kd_T and Kd_S to zero to avoid passing values from previous call + Kd_T(:,j,:) = 0.0; Kd_S(:,j,:) = 0.0 + + ! GMM, I am leaving some code commented below. We need to pass BLD to + ! this soubroutine to avoid adding diffusivity above that. This needs + ! to be done once we re-structure the order of the calls. + !if (.not. associated(hbl)) then + ! allocate(hbl(SZI_(G), SZJ_(G))); + ! hbl(:,:) = 0.0 + !endif + + do i = G%isc, G%iec + + ! skip calling at land points + if (G%mask2dT(i,j) == 0.) cycle + + pRef = 0. + pres_int(1) = pRef + ! we don't have SST and SSS, so let's use values at top-most layer + temp_int(1) = TV%T(i,j,1); salt_int(1) = TV%S(i,j,1) + do k=2,G%ke + ! pressure at interface + pres_int(k) = pRef + GV%H_to_Pa * h(i,j,k-1) + ! temp and salt at interface + ! for temp: (t1*h1 + t2*h2)/(h1+h2) + temp_int(k) = (TV%T(i,j,k-1)*h(i,j,k-1) + TV%T(i,j,k)*h(i,j,k))/(h(i,j,k-1)+h(i,j,k)) + salt_int(k) = (TV%S(i,j,k-1)*h(i,j,k-1) + TV%S(i,j,k)*h(i,j,k))/(h(i,j,k-1)+h(i,j,k)) + ! dT and dS + dT(k) = (TV%T(i,j,k-1)-TV%T(i,j,k)) + dS(k) = (TV%S(i,j,k-1)-TV%S(i,j,k)) + pRef = pRef + GV%H_to_Pa * h(i,j,k-1) + enddo ! k-loop finishes + + call calculate_density_derivs(temp_int(:), salt_int(:), pres_int(:), drho_dT(:), drho_dS(:), 1, G%ke, TV%EQN_OF_STATE) + + ! The "-1.0" below is needed so that the following criteria is satisfied: + ! if ((alpha_dT > beta_dS) .and. (beta_dS > 0.0)) then "salt finger" + ! if ((alpha_dT < 0.) .and. (beta_dS < 0.) .and. (alpha_dT > beta_dS)) then "diffusive convection" + do k=1,G%ke + alpha_dT(k) = -1.0*drho_dT(k) * dT(k) + beta_dS(k) = drho_dS(k) * dS(k) + enddo + + if (CS%id_R_rho > 0.0) then + do k=1,G%ke + CS%R_rho(i,j,k) = alpha_dT(k)/beta_dS(k) + ! avoid NaN's + if(CS%R_rho(i,j,k) /= CS%R_rho(i,j,k)) CS%R_rho(i,j,k) = 0.0 + enddo + endif + + iFaceHeight(1) = 0.0 ! BBL is all relative to the surface + hcorr = 0.0 + ! compute heights at cell center and interfaces + do k=1,G%ke + dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) + hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 + dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness + cellHeight(k) = iFaceHeight(k) - 0.5 * dh + iFaceHeight(k+1) = iFaceHeight(k) - dh + enddo + + ! gets index of the level and interface above hbl + !kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl(i,j)) + + call CVMix_coeffs_ddiff(Tdiff_out=Kd_T(i,j,:), & + Sdiff_out=Kd_S(i,j,:), & + strat_param_num=alpha_dT(:), & + strat_param_denom=beta_dS(:), & + nlev=G%ke, & + max_nlev=G%ke) + + ! Do not apply mixing due to convection within the boundary layer + !do k=1,kOBL + ! Kd_T(i,j,k) = 0.0 + ! Kd_S(i,j,k) = 0.0 + !enddo + + enddo ! i-loop + +end subroutine compute_ddiff_coeffs + +!> Reads the parameter "USE_CVMIX_DDIFF" and returns state. +!! This function allows other modules to know whether this parameterization will +!! be used without needing to duplicate the log entry. +logical function CVMix_ddiff_is_used(param_file) + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + call get_param(param_file, mdl, "USE_CVMIX_DDIFF", CVMix_ddiff_is_used, & + default=.false., do_not_log = .true.) + +end function CVMix_ddiff_is_used + +!> Clear pointers and dealocate memory +subroutine CVMix_ddiff_end(CS) + type(CVMix_ddiff_cs), pointer :: CS ! Control structure + + deallocate(CS) + +end subroutine CVMix_ddiff_end + + +end module MOM_CVMix_ddiff diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 89992ebc94..1f22594ccc 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -30,14 +30,14 @@ module MOM_CVMix_shear !> Control structure including parameters for CVMix interior shear schemes. type, public :: CVMix_shear_cs logical :: use_LMD94, use_PP81 !< Flags for various schemes + logical :: smooth_ri !< If true, smooth Ri using a 1-2-1 filter real :: Ri_zero !< LMD94 critical Richardson number real :: Nu_zero !< LMD94 maximum interior diffusivity - real :: KPP_exp !< + real :: KPP_exp !< Exponent of unitless factor of diff. + !! for KPP internal shear mixing scheme. real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency (1/s2) real, allocatable, dimension(:,:,:) :: S2 !< Squared shear frequency (1/s2) real, allocatable, dimension(:,:,:) :: ri_grad !< Gradient Richardson number -! real, allocatable, dimension(:,:,:) :: kv !< vertical viscosity at interface (m2/s) -! real, allocatable, dimension(:,:,:) :: kd !< vertical diffusivity at interface (m2/s) character(10) :: Mix_Scheme !< Mixing scheme name (string) ! Daignostic handles and pointers type(diag_ctrl), pointer :: diag => NULL() @@ -52,25 +52,26 @@ module MOM_CVMix_shear !> Subroutine for calculating (internal) vertical diffusivities/viscosities subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & kv, G, GV, CS ) - type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: u_H !< Initial zonal velocity on T points, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: v_H !< Initial meridional velocity on T points, in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface - !! (not layer!) in m2 s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface - !! (not layer!) in m2 s-1. - type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous call to - !! CVMix_shear_init. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface + !! (not layer!) in m2 s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface + !! (not layer!) in m2 s-1. + type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous call to + !! CVMix_shear_init. ! Local variables integer :: i, j, k, kk, km1 - real :: gorho - real :: pref, DU, DV, DRHO, DZ, N2, S2 + real :: GoRho + real :: pref, DU, DV, DRHO, DZ, N2, S2, dummy real, dimension(2*(G%ke)) :: pres_1d, temp_1d, salt_1d, rho_1d real, dimension(G%ke+1) :: Ri_Grad !< Gradient Richardson number - + real, parameter :: epsln = 1.e-10 !< Threshold to identify + !! vanished layers ! some constants GoRho = GV%g_Earth / GV%Rho0 @@ -120,10 +121,30 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & ! fill 3d arrays, if user asks for diagsnostics if (CS%id_N2 > 0) CS%N2(i,j,k) = N2 if (CS%id_S2 > 0) CS%S2(i,j,k) = S2 - if (CS%id_ri_grad > 0) CS%ri_grad(i,j,k) = Ri_Grad(k) enddo + Ri_grad(G%ke+1) = Ri_grad(G%ke) + + if (CS%smooth_ri) then + ! 1) fill Ri_grad in vanished layers with adjacent value + do k = 2, G%ke + if (h(i,j,k) .le. epsln) Ri_grad(k) = Ri_grad(k-1) + enddo + + Ri_grad(G%ke+1) = Ri_grad(G%ke) + + ! 2) vertically smooth Ri with 1-2-1 filter + dummy = 0.25 * Ri_grad(1) + Ri_grad(G%ke+1) = Ri_grad(G%ke) + do k = 1, G%ke + Ri_Grad(k) = dummy + 0.5 * Ri_Grad(k) + 0.25 * Ri_grad(k+1) + dummy = 0.25 * Ri_grad(k) + enddo + endif + + if (CS%id_ri_grad > 0) CS%ri_grad(i,j,:) = Ri_Grad(:) + ! Call to CVMix wrapper for computing interior mixing coefficients. call CVMix_coeffs_shear(Mdiff_out=kv(i,j,:), & Tdiff_out=kd(i,j,:), & @@ -209,7 +230,11 @@ logical function CVMix_shear_init(Time, G, GV, param_file, diag, CS) "Exponent of unitless factor of diffusivities,"// & " for KPP internal shear mixing scheme." & ,units="nondim", default=3.0) - call CVMix_init_shear(mix_scheme=CS%mix_scheme, & + call get_param(param_file, mdl, "SMOOTH_RI", CS%smooth_ri, & + "If true, vertically smooth the Richardson"// & + "number by applying a 1-2-1 filter once.", & + default = .false.) + call cvmix_init_shear(mix_scheme=CS%mix_scheme, & KPP_nu_zero=CS%Nu_Zero, & KPP_Ri_zero=CS%Ri_zero, & KPP_exp=CS%KPP_exp) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index f98185685a..79234c7e11 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -1573,7 +1573,7 @@ subroutine KPP_get_BLD(CS, BLD, G) type(KPP_CS), pointer :: CS !< Control structure for !! this module type(ocean_grid_type), intent(in) :: G !< Grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: BLD!< bnd. layer depth (m) + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: BLD!< bnd. layer depth (m) ! Local variables integer :: i,j do j = G%jsc, G%jec ; do i = G%isc, G%iec diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 61c212db8b..bb1e0b11c1 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -408,7 +408,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, CS) CS%kd_bkgnd(i,j,1) = 0.0; CS%kv_bkgnd(i,j,1) = 0.0 CS%kd_bkgnd(i,j,nz+1) = 0.0; CS%kv_bkgnd(i,j,nz+1) = 0.0 do k=2,nz - CS%kd_bkgnd(i,j,k) = CS%kd_bkgnd(i,j,k) + 0.5*(kd_lay(i,j,K-1) + kd_lay(i,j,K)) + CS%kd_bkgnd(i,j,k) = 0.5*(kd_lay(i,j,K-1) + kd_lay(i,j,K)) CS%kv_bkgnd(i,j,k) = CS%kd_bkgnd(i,j,k) * CS%prandtl_bkgnd enddo enddo diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 6eb3b854f4..528dc33135 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -2,53 +2,6 @@ module MOM_diabatic_aux ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, April 1994 - July 2000 * -!* Alistair Adcroft, and Stephen Griffies * -!* * -!* This program contains the subroutine that, along with the * -!* subroutines that it calls, implements diapycnal mass and momentum * -!* fluxes and a bulk mixed layer. The diapycnal diffusion can be * -!* used without the bulk mixed layer. * -!* * -!* diabatic first determines the (diffusive) diapycnal mass fluxes * -!* based on the convergence of the buoyancy fluxes within each layer. * -!* The dual-stream entrainment scheme of MacDougall and Dewar (JPO, * -!* 1997) is used for combined diapycnal advection and diffusion, * -!* calculated implicitly and potentially with the Richardson number * -!* dependent mixing, as described by Hallberg (MWR, 2000). Diapycnal * -!* advection is fundamentally the residual of diapycnal diffusion, * -!* so the fully implicit upwind differencing scheme that is used is * -!* entirely appropriate. The downward buoyancy flux in each layer * -!* is determined from an implicit calculation based on the previously * -!* calculated flux of the layer above and an estimated flux in the * -!* layer below. This flux is subject to the following conditions: * -!* (1) the flux in the top and bottom layers are set by the boundary * -!* conditions, and (2) no layer may be driven below an Angstrom thick-* -!* ness. If there is a bulk mixed layer, the buffer layer is treat- * -!* ed as a fixed density layer with vanishingly small diffusivity. * -!* * -!* diabatic takes 5 arguments: the two velocities (u and v), the * -!* thicknesses (h), a structure containing the forcing fields, and * -!* the length of time over which to act (dt). The velocities and * -!* thickness are taken as inputs and modified within the subroutine. * -!* There is no limit on the time step. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, T, S, buoy, ustar, ea, eb, etc. * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr @@ -239,26 +192,19 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf) end subroutine make_frazil +!> Applies double diffusion to T & S, assuming no diapycal mass +!! fluxes, using a simple triadiagonal solver. subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(inout) :: tv - type(vertvisc_type), intent(in) :: visc - real, intent(in) :: dt - -! This subroutine applies double diffusion to T & S, assuming no diapycal mass -! fluxes, using a simple triadiagonal solver. - -! Arguments: h - Layer thickness, in m or kg m-2. -! (in) tv - A structure containing pointers to any available -! thermodynamic fields. Absent fields have NULL ptrs. -! (in) visc - A structure containing vertical viscosities, bottom boundary -! layer properies, and related fields. -! (in) dt - Time increment, in s. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. + type(thermo_var_ptrs), intent(inout) :: tv !< pointers to any available modynamic fields. + !! Absent fields have NULL ptrs. + type(vertvisc_type), intent(in) :: visc !< structure containing vertical viscosities, + !! layer properies, and related fields. + real, intent(in) :: dt !< Time increment, in s. + ! local variables real, dimension(SZI_(G)) :: & b1_T, b1_S, & ! Variables used by the tridiagonal solvers of T & S, in H. d1_T, d1_S ! Variables used by the tridiagonal solvers, nondim. @@ -345,30 +291,25 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) S(i,j,k) = S(i,j,k) + c1_S(i,k+1)*S(i,j,k+1) enddo ; enddo enddo - end subroutine differential_diffuse_T_S +!> Keep salinity from falling below a small but positive threshold +!! This occurs when the ice model attempts to extract more salt then +!! is actually available to it from the ocean. subroutine adjust_salt(h, tv, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(inout) :: tv - type(diabatic_aux_CS), intent(in) :: CS - -! Keep salinity from falling below a small but positive threshold -! This occurs when the ice model attempts to extract more salt then -! is actually available to it from the ocean. - -! Arguments: h - Layer thickness, in m. -! (in/out) tv - A structure containing pointers to any available -! thermodynamic fields. Absent fields have NULL ptrs. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! diabatic_driver_init. - real :: salt_add_col(SZI_(G),SZJ_(G)) ! The accumulated salt requirement - real :: S_min ! The minimum salinity - real :: mc ! A layer's mass kg m-2 . + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m + !! or kg m-2) + type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to any + !! available thermodynamic fields. + type(diabatic_aux_CS), intent(in) :: CS !< control structure returned by + !! a previous call to diabatic_driver_init. + + ! local variables + real :: salt_add_col(SZI_(G),SZJ_(G)) !< The accumulated salt requirement + real :: S_min !< The minimum salinity + real :: mc !< A layer's mass kg m-2 . integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -410,33 +351,29 @@ subroutine adjust_salt(h, tv, G, GV, CS) end subroutine adjust_salt +!> Insert salt from brine rejection into the first layer below +!! the mixed layer which both contains mass and in which the +!! change in layer density remains stable after the addition +!! of salt via brine rejection. subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(inout) :: tv - type(forcing), intent(in) :: fluxes - integer, intent(in) :: nkmb - type(diabatic_aux_CS), intent(in) :: CS - real, intent(in) :: dt + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m + !! or kg m-2) + type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to + !! any available hermodynamic fields. + type(forcing), intent(in) :: fluxes !< tructure containing pointers + !! any possible forcing fields + integer, intent(in) :: nkmb !< number of layers in the mixed and + !! buffer layers + type(diabatic_aux_CS), intent(in) :: CS !< control structure returned by a + !! previous call to diabatic_driver_init. + real, intent(in) :: dt !< time step between calls to this + !! function (s) ?? integer, intent(in) :: id_brine_lay -! Insert salt from brine rejection into the first layer below -! the mixed layer which both contains mass and in which the -! change in layer density remains stable after the addition -! of salt via brine rejection. - -! Arguments: h - Layer thickness, in m. -! (in/out) tv - A structure containing pointers to any available -! thermodynamic fields. Absent fields have NULL ptrs. -! (in) fluxes = A structure containing pointers to any possible -! forcing fields; unused fields have NULL ptrs. -! (in) nkmb - The number of layers in the mixed and buffer layers. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! diabatic_driver_init. + ! local variables real :: salt(SZI_(G)) ! The amount of salt rejected from ! sea ice. [grams] real :: dzbr(SZI_(G)) ! cumulative depth over which brine is distributed @@ -539,10 +476,9 @@ subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) end subroutine insert_brine +!> Simple tri-diagnonal solver for T and S. +!! "Simple" means it only uses arrays hold, ea and eb. subroutine triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, T, S) -! Simple tri-diagnonal solver for T and S -! "Simple" means it only uses arrays hold, ea and eb - ! Arguments type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure integer, intent(in) :: is, ie, js, je @@ -579,37 +515,22 @@ subroutine triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, T, S) enddo end subroutine triDiagTS - +!> Calculates u_h and v_h (velocities at thickness points), +!! optionally using the entrainments (in m) passed in as arguments. subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1 real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: u_h - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: v_h - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: ea - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: eb -! This subroutine calculates u_h and v_h (velocities at thickness -! points), optionally using the entrainments (in m) passed in as arguments. - -! Arguments: u - Zonal velocity, in m s-1. -! (in) v - Meridional velocity, in m s-1. -! (in) h - Layer thickness, in m or kg m-2. -! (out) u_h - The zonal velocity at thickness points after -! entrainment, in m s-1. -! (out) v_h - The meridional velocity at thickness points after -! entrainment, in m s-1. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in, opt) ea - The amount of fluid entrained from the layer above within -! this time step, in units of m or kg m-2. Omitting ea is the -! same as setting it to 0. -! (in, opt) eb - The amount of fluid entrained from the layer below within -! this time step, in units of m or kg m-2. Omitting eb is the -! same as setting it to 0. ea and eb must either be both -! present or both absent. - + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: u_h, v_h !< zonal and meridional velocity at thickness + !! points entrainment, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in), optional :: ea, eb !< The amount of fluid entrained + !! from the layer above within this time step + !! , in units of m or kg m-2. Omitting ea is the + !! same as setting it to 0. + + ! local variables real :: b_denom_1 ! The first term in the denominator of b1 in m or kg m-2. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in m or kg m-2. @@ -1318,26 +1239,20 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & end subroutine applyBoundaryFluxesInOut +!> Initializes this module. subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm, use_ePBL) type(time_type), intent(in) :: Time type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(inout) :: diag - type(diabatic_aux_CS), pointer :: CS - logical, intent(in) :: useALEalgorithm - logical, intent(in) :: use_ePBL - -! Arguments: -! (in) Time = current model time -! (in) G = ocean grid structure -! (in) GV - The ocean's vertical grid structure. -! (in) param_file = structure indicating the open file to parse for parameter values -! (in) diag = structure used to regulate diagnostic output -! (in/out) CS = pointer set to point to the control structure for this module -! (in) use_ePBL = If true, use the implicit energetics planetary boundary -! layer scheme to determine the diffusivity in the -! surface boundary layer. + type(diag_ctrl), target, intent(inout) :: diag !< structure used to regulate diagnostic output + type(diabatic_aux_CS), pointer :: CS !< pointer set to point to the ontrol structure for + !! this module + logical, intent(in) :: useALEalgorithm !< If True, uses ALE. + logical, intent(in) :: use_ePBL !< If true, use the implicit energetics + !! planetary boundary layer scheme to determine the + !! diffusivity in the surface boundary layer. + ! local variables type(vardesc) :: vd ! This "include" declares and sets the variable "version". @@ -1460,4 +1375,48 @@ subroutine diabatic_aux_end(CS) end subroutine diabatic_aux_end +!> \namespace MOM_diabatic_aux +!! +!! This module contains the subroutines that, along with the * +!! subroutines that it calls, implements diapycnal mass and momentum * +!! fluxes and a bulk mixed layer. The diapycnal diffusion can be * +!! used without the bulk mixed layer. * +!! * +!! diabatic first determines the (diffusive) diapycnal mass fluxes * +!! based on the convergence of the buoyancy fluxes within each layer. * +!! The dual-stream entrainment scheme of MacDougall and Dewar (JPO, * +!! 1997) is used for combined diapycnal advection and diffusion, * +!! calculated implicitly and potentially with the Richardson number * +!! dependent mixing, as described by Hallberg (MWR, 2000). Diapycnal * +!! advection is fundamentally the residual of diapycnal diffusion, * +!! so the fully implicit upwind differencing scheme that is used is * +!! entirely appropriate. The downward buoyancy flux in each layer * +!! is determined from an implicit calculation based on the previously * +!! calculated flux of the layer above and an estimated flux in the * +!! layer below. This flux is subject to the following conditions: * +!! (1) the flux in the top and bottom layers are set by the boundary * +!! conditions, and (2) no layer may be driven below an Angstrom thick-* +!! ness. If there is a bulk mixed layer, the buffer layer is treat- * +!! ed as a fixed density layer with vanishingly small diffusivity. * +!! * +!! diabatic takes 5 arguments: the two velocities (u and v), the * +!! thicknesses (h), a structure containing the forcing fields, and * +!! the length of time over which to act (dt). The velocities and * +!! thickness are taken as inputs and modified within the subroutine. * +!! There is no limit on the time step. * +!! * +!! A small fragment of the grid is shown below: * +!! * +!! j+1 x ^ x ^ x At x: q * +!! j+1 > o > o > At ^: v * +!! j x ^ x ^ x At >: u * +!! j > o > o > At o: h, T, S, buoy, ustar, ea, eb, etc. * +!! j-1 x ^ x ^ x * +!! i-1 i i+1 At x & ^: * +!! i i+1 At > & o: * +!! * +!! The boundaries always run through q grid points (x). * +!! * +!!********+*********+*********+*********+*********+*********+*********+** + end module MOM_diabatic_aux diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index ffc6e938c0..4b9b18e688 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -10,6 +10,7 @@ module MOM_diabatic_driver use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE use MOM_CVMix_shear, only : CVMix_shear_is_used +use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used use MOM_diabatic_aux, only : diabatic_aux_init, diabatic_aux_end, diabatic_aux_CS use MOM_diabatic_aux, only : make_frazil, adjust_salt, insert_brine, differential_diffuse_T_S, triDiagTS use MOM_diabatic_aux, only : find_uv_at_h, diagnoseMLDbyDensityDifference, applyBoundaryFluxesInOut @@ -95,6 +96,7 @@ module MOM_diabatic_driver !! shear-driven diapycnal diffusivity. logical :: use_CVMix_shear !< If true, use the CVMix module to find the !! shear-driven diapycnal diffusivity. + logical :: use_CVMix_ddiff !< If true, use the CVMix double diffusion module. logical :: use_tidal_mixing !< If true, activate tidal mixing diffusivity. logical :: use_CVMix_conv !< If true, use the CVMix module to get enhanced !! mixing due to convection. @@ -247,7 +249,7 @@ module MOM_diabatic_driver integer :: id_clock_entrain, id_clock_mixedlayer, id_clock_set_diffusivity integer :: id_clock_tracers, id_clock_tridiag, id_clock_pass, id_clock_sponge integer :: id_clock_geothermal, id_clock_differential_diff, id_clock_remap -integer :: id_clock_kpp +integer :: id_clock_kpp, id_clock_CVMix_ddiff contains @@ -383,7 +385,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect*h_neglect Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 - if (nz == 1) return showCallTree = callTree_showQuery() if (showCallTree) call callTree_enter("diabatic(), MOM_diabatic_driver.F90") @@ -485,13 +486,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif if (CS%ML_mix_first > 0.0) then -! This subroutine -! (1) Cools the mixed layer. -! (2) Performs convective adjustment by mixed layer entrainment. -! (3) Heats the mixed layer and causes it to detrain to -! Monin-Obukhov depth or minimum mixed layer depth. -! (4) Uses any remaining TKE to drive mixed layer entrainment. -! (5) Possibly splits buffer layer into two isopycnal layers (when using isopycnal coordinate) + ! This subroutine: + ! (1) Cools the mixed layer. + ! (2) Performs convective adjustment by mixed layer entrainment. + ! (3) Heats the mixed layer and causes it to detrain to + ! Monin-Obukhov depth or minimum mixed layer depth. + ! (4) Uses any remaining TKE to drive mixed layer entrainment. + ! (5) Possibly splits buffer layer into two isopycnal layers (when using isopycnal coordinate) call find_uv_at_h(u, v, h, u_h, v_h, G, GV) call cpu_clock_begin(id_clock_mixedlayer) @@ -526,11 +527,12 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (showCallTree) call callTree_waypoint("done with 1st bulkmixedlayer (diabatic)") if (CS%debugConservation) call MOM_state_stats('1st bulkmixedlayer', u, v, h, tv%T, tv%S, G) endif - endif + endif ! end CS%bulkmixedlayer if (CS%debug) then call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) endif + if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eaml, ebml) @@ -587,7 +589,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & CS%int_tide_input%tideamp, CS%int_tide_input%Nb, dt, G, GV, CS%int_tide_CSp) endif if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") - endif + endif ! end CS%use_int_tides call cpu_clock_begin(id_clock_set_diffusivity) ! Sets: Kd, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S @@ -728,10 +730,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! a diffusivity and happen before KPP. But generally in MOM, we do not match ! KPP boundary layer to interior, so this diffusivity can be computed when convenient. if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T)) then - call cpu_clock_begin(id_clock_differential_diff) + call cpu_clock_begin(id_clock_CVMix_ddiff) call differential_diffuse_T_S(h, tv, visc, dt, G, GV) - call cpu_clock_end(id_clock_differential_diff) + call cpu_clock_end(id_clock_CVMix_ddiff) if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G) @@ -744,7 +746,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & enddo ; enddo ; enddo endif - endif @@ -1379,6 +1380,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! visc%Kv_shear is not in the group pass because it has larger vertical extent. if (associated(visc%Kv_shear)) & call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) + if (associated(visc%Kv_slow)) & + call pass_var(visc%Kv_slow, G%Domain, To_All+Omit_Corners, halo=1) + call cpu_clock_end(id_clock_pass) if (.not. CS%useALEalgorithm) then @@ -3177,7 +3181,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, real :: Kd integer :: num_mode - logical :: use_temperature, differentialDiffusion + logical :: use_temperature type(vardesc) :: vd ! This "include" declares and sets the variable "version". @@ -3228,11 +3232,10 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, "If true, the diffusivity from ePBL is added to all\n"//& "other diffusivities. Otherwise, the larger of kappa-\n"//& "shear and ePBL diffusivities are used.", default=.true.) - call get_param(param_file, mod, "DOUBLE_DIFFUSION", differentialDiffusion, & - "If true, apply parameterization of double-diffusion.", & - default=.false. ) + CS%use_CVMix_ddiff = CVMix_ddiff_is_used(param_file) CS%use_kappa_shear = kappa_shear_is_used(param_file) CS%use_CVMix_shear = CVMix_shear_is_used(param_file) + if (CS%bulkmixedlayer) then call get_param(param_file, mod, "ML_MIX_FIRST", CS%ML_mix_first, & "The fraction of the mixed layer mixing that is applied \n"//& @@ -3691,8 +3694,8 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, id_clock_sponge = cpu_clock_id('(Ocean sponges)', grain=CLOCK_MODULE) id_clock_tridiag = cpu_clock_id('(Ocean diabatic tridiag)', grain=CLOCK_ROUTINE) id_clock_pass = cpu_clock_id('(Ocean diabatic message passing)', grain=CLOCK_ROUTINE) - id_clock_differential_diff = -1 ; if (differentialDiffusion) & - id_clock_differential_diff = cpu_clock_id('(Ocean differential diffusion)', grain=CLOCK_ROUTINE) + id_clock_CVMix_ddiff = -1 ; if (CS%use_CVMix_ddiff) & + id_clock_CVMix_ddiff = cpu_clock_id('(Double diffusion)', grain=CLOCK_ROUTINE) ! initialize the auxiliary diabatic driver module call diabatic_aux_init(Time, G, GV, param_file, diag, CS%diabatic_aux_CSp, & diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 9906083597..903868795a 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -23,6 +23,8 @@ module MOM_set_diffusivity use MOM_kappa_shear, only : calculate_kappa_shear, kappa_shear_init, Kappa_shear_CS use MOM_CVMix_shear, only : calculate_CVMix_shear, CVMix_shear_init, CVMix_shear_cs use MOM_CVMix_shear, only : CVMix_shear_end +use MOM_CVMix_ddiff, only : CVMix_ddiff_init, CVMix_ddiff_end, CVMix_ddiff_cs +use MOM_CVMix_ddiff, only : compute_ddiff_coeffs use MOM_bkgnd_mixing, only : calculate_bkgnd_mixing, bkgnd_mixing_init, bkgnd_mixing_cs use MOM_bkgnd_mixing, only : bkgnd_mixing_end, sfc_bkgnd_mixing use MOM_string_functions, only : uppercase @@ -43,104 +45,101 @@ module MOM_set_diffusivity public set_diffusivity_end type, public :: set_diffusivity_CS ; private - logical :: debug ! If true, write verbose checksums for debugging. - - logical :: bulkmixedlayer ! If true, a refined bulk mixed layer is used with - ! GV%nk_rho_varies variable density mixed & buffer - ! layers. - real :: FluxRi_max ! The flux Richardson number where the stratification is - ! large enough that N2 > omega2. The full expression for - ! the Flux Richardson number is usually - ! FLUX_RI_MAX*N2/(N2+OMEGA2). The default is 0.2. - logical :: bottomdraglaw ! If true, the bottom stress is calculated with a - ! drag law c_drag*|u|*u. - logical :: BBL_mixing_as_max ! If true, take the maximum of the diffusivity - ! from the BBL mixing and the other diffusivities. - ! Otherwise, diffusivities from the BBL_mixing is - ! added. - logical :: use_LOTW_BBL_diffusivity ! If true, use simpler/less precise, BBL diffusivity. - logical :: LOTW_BBL_use_omega ! If true, use simpler/less precise, BBL diffusivity. - real :: BBL_effic ! efficiency with which the energy extracted - ! by bottom drag drives BBL diffusion (nondim) - real :: cdrag ! quadratic drag coefficient (nondim) - real :: IMax_decay ! inverse of a maximum decay scale for - ! bottom-drag driven turbulence, (1/m) - - real :: Kd ! interior diapycnal diffusivity (m2/s) - real :: Kd_min ! minimum diapycnal diffusivity (m2/s) - real :: Kd_max ! maximum increment for diapycnal diffusivity (m2/s) - ! Set to a negative value to have no limit. - real :: Kd_add ! uniform diffusivity added everywhere without - ! filtering or scaling (m2/s) - real :: Kv ! interior vertical viscosity (m2/s) - real :: Kdml ! mixed layer diapycnal diffusivity (m2/s) - ! when bulkmixedlayer==.false. - real :: Hmix ! mixed layer thickness (meter) when - ! bulkmixedlayer==.false. + logical :: debug !< If true, write verbose checksums for debugging. + + logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with + !! GV%nk_rho_varies variable density mixed & buffer + !! layers. + real :: FluxRi_max !< The flux Richardson number where the stratification is + !! large enough that N2 > omega2. The full expression for + !! the Flux Richardson number is usually + !! FLUX_RI_MAX*N2/(N2+OMEGA2). The default is 0.2. + logical :: bottomdraglaw !< If true, the bottom stress is calculated with a + !! drag law c_drag*|u|*u. + logical :: BBL_mixing_as_max !< If true, take the maximum of the diffusivity + !! from the BBL mixing and the other diffusivities. + !! Otherwise, diffusivities from the BBL_mixing is + !! added. + logical :: use_LOTW_BBL_diffusivity !< If true, use simpler/less precise, BBL diffusivity. + logical :: LOTW_BBL_use_omega !< If true, use simpler/less precise, BBL diffusivity. + real :: BBL_effic !< efficiency with which the energy extracted + !! by bottom drag drives BBL diffusion (nondim) + real :: cdrag !< quadratic drag coefficient (nondim) + real :: IMax_decay !< inverse of a maximum decay scale for + !! bottom-drag driven turbulence, (1/m) + real :: Kv !< The interior vertical viscosity (m2/s) + real :: Kd !< interior diapycnal diffusivity (m2/s) + real :: Kd_min !< minimum diapycnal diffusivity (m2/s) + real :: Kd_max !< maximum increment for diapycnal diffusivity (m2/s) + !! Set to a negative value to have no limit. + real :: Kd_add !< uniform diffusivity added everywhere without + !! filtering or scaling (m2/s) + real :: Kdml !< mixed layer diapycnal diffusivity (m2/s) + !! when bulkmixedlayer==.false. + real :: Hmix !< mixed layer thickness (meter) when + !! bulkmixedlayer==.false. type(diag_ctrl), pointer :: diag ! structure to regulate diagn output timing - logical :: limit_dissipation ! If enabled, dissipation is limited to be larger - ! than the following: - real :: dissip_min ! Minimum dissipation (W/m3) - real :: dissip_N0 ! Coefficient a in minimum dissipation = a+b*N (W/m3) - real :: dissip_N1 ! Coefficient b in minimum dissipation = a+b*N (J/m3) - real :: dissip_N2 ! Coefficient c in minimum dissipation = c*N2 (W m-3 s2) - real :: dissip_Kd_min ! Minimum Kd (m2/s) with dissipatio Rho0*Kd_min*N^2 - - real :: TKE_itide_max ! maximum internal tide conversion (W m-2) - ! available to mix above the BBL - real :: omega ! Earth's rotation frequency (s-1) - logical :: ML_radiation ! allow a fraction of TKE available from wind work - ! to penetrate below mixed layer base with a vertical - ! decay scale determined by the minimum of - ! (1) The depth of the mixed layer, or - ! (2) An Ekman length scale. - ! Energy availble to drive mixing below the mixed layer is - ! given by E = ML_RAD_COEFF*MSTAR*USTAR**3. Optionally, if - ! ML_rad_TKE_decay is true, this is further reduced by a factor - ! of exp(-h_ML*Idecay_len_TkE), where Idecay_len_TKE is - ! calculated the same way as in the mixed layer code. - ! The diapycnal diffusivity is KD(k) = E/(N2(k)+OMEGA2), - ! where N2 is the squared buoyancy frequency (s-2) and OMEGA2 - ! is the rotation rate of the earth squared. - real :: ML_rad_kd_max ! Maximum diapycnal diffusivity due to turbulence - ! radiated from the base of the mixed layer (m2/s) - real :: ML_rad_efold_coeff ! non-dim coefficient to scale penetration depth - real :: ML_rad_coeff ! coefficient, which scales MSTAR*USTAR^3 to - ! obtain energy available for mixing below - ! mixed layer base (nondimensional) - logical :: ML_rad_TKE_decay ! If true, apply same exponential decay - ! to ML_rad as applied to the other surface - ! sources of TKE in the mixed layer code. - real :: ustar_min ! A minimum value of ustar to avoid numerical - ! problems (m/s). If the value is small enough, - ! this parameter should not affect the solution. - real :: TKE_decay ! ratio of natural Ekman depth to TKE decay scale (nondim) - real :: mstar ! ratio of friction velocity cubed to - ! TKE input to the mixed layer (nondim) - logical :: ML_use_omega ! If true, use absolute rotation rate instead - ! of the vertical component of rotation when - ! setting the decay scale for mixed layer turbulence. - real :: ML_omega_frac ! When setting the decay scale for turbulence, use - ! this fraction of the absolute rotation rate blended - ! with the local value of f, as f^2 ~= (1-of)*f^2 + of*4*omega^2. - logical :: user_change_diff ! If true, call user-defined code to change diffusivity. - logical :: useKappaShear ! If true, use the kappa_shear module to find the - ! shear-driven diapycnal diffusivity. - logical :: use_CVMix_shear ! If true, use one of the CVMix modules to find - ! shear-driven diapycnal diffusivity. - logical :: double_diffusion ! If true, enable double-diffusive mixing. - logical :: simple_TKE_to_Kd ! If true, uses a simple estimate of Kd/TKE that - ! does not rely on a layer-formulation. - real :: Max_Rrho_salt_fingers ! max density ratio for salt fingering - real :: Max_salt_diff_salt_fingers ! max salt diffusivity for salt fingers (m2/s) - real :: Kv_molecular ! molecular visc for double diff convect (m2/s) + logical :: limit_dissipation !< If enabled, dissipation is limited to be larger + !! than the following: + real :: dissip_min !< Minimum dissipation (W/m3) + real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N (W/m3) + real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N (J/m3) + real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 (W m-3 s2) + real :: dissip_Kd_min !< Minimum Kd (m2/s) with dissipatio Rho0*Kd_min*N^2 + + real :: TKE_itide_max !< maximum internal tide conversion (W m-2) + !! available to mix above the BBL + real :: omega !< Earth's rotation frequency (s-1) + logical :: ML_radiation !< allow a fraction of TKE available from wind work + !! to penetrate below mixed layer base with a vertical + !! decay scale determined by the minimum of + !! (1) The depth of the mixed layer, or + !! (2) An Ekman length scale. + !! Energy availble to drive mixing below the mixed layer is + !! given by E = ML_RAD_COEFF*MSTAR*USTAR**3. Optionally, if + !! ML_rad_TKE_decay is true, this is further reduced by a factor + !! of exp(-h_ML*Idecay_len_TkE), where Idecay_len_TKE is + !! calculated the same way as in the mixed layer code. + !! The diapycnal diffusivity is KD(k) = E/(N2(k)+OMEGA2), + !! where N2 is the squared buoyancy frequency (s-2) and OMEGA2 + !! is the rotation rate of the earth squared. + real :: ML_rad_kd_max !< Maximum diapycnal diffusivity due to turbulence + !! radiated from the base of the mixed layer (m2/s) + real :: ML_rad_efold_coeff !< non-dim coefficient to scale penetration depth + real :: ML_rad_coeff !< coefficient, which scales MSTAR*USTAR^3 to + !! obtain energy available for mixing below + !! mixed layer base (nondimensional) + logical :: ML_rad_TKE_decay !< If true, apply same exponential decay + !! to ML_rad as applied to the other surface + !! sources of TKE in the mixed layer code. + real :: ustar_min !< A minimum value of ustar to avoid numerical + !! problems (m/s). If the value is small enough, + !! this parameter should not affect the solution. + real :: TKE_decay !< ratio of natural Ekman depth to TKE decay scale (nondim) + real :: mstar !! ratio of friction velocity cubed to + !! TKE input to the mixed layer (nondim) + logical :: ML_use_omega !< If true, use absolute rotation rate instead + !! of the vertical component of rotation when + !! setting the decay scale for mixed layer turbulence. + real :: ML_omega_frac !< When setting the decay scale for turbulence, use + !! this fraction of the absolute rotation rate blended + !! with the local value of f, as f^2 ~= (1-of)*f^2 + of*4*omega^2. + logical :: user_change_diff !< If true, call user-defined code to change diffusivity. + logical :: useKappaShear !< If true, use the kappa_shear module to find the + !! shear-driven diapycnal diffusivity. + logical :: use_CVMix_shear !< If true, use one of the CVMix modules to find + !! shear-driven diapycnal diffusivity. + logical :: use_CVMix_ddiff !< If true, enable double-diffusive mixing via CVMix. + logical :: simple_TKE_to_Kd !< If true, uses a simple estimate of Kd/TKE that + !! does not rely on a layer-formulation. character(len=200) :: inputdir type(user_change_diff_CS), pointer :: user_change_diff_CSp => NULL() type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() type(Kappa_shear_CS), pointer :: kappaShear_CSp => NULL() type(CVMix_shear_cs), pointer :: CVMix_shear_csp => NULL() + type(CVMix_ddiff_cs), pointer :: CVMix_ddiff_csp => NULL() type(bkgnd_mixing_cs), pointer :: bkgnd_mixing_csp => NULL() type(int_tide_CS), pointer :: int_tide_CSp => NULL() type(tidal_mixing_cs), pointer :: tm_csp => NULL() @@ -158,11 +157,6 @@ module MOM_set_diffusivity integer :: id_N2 = -1 integer :: id_N2_z = -1 - integer :: id_KT_extra = -1 - integer :: id_KS_extra = -1 - integer :: id_KT_extra_z = -1 - integer :: id_KS_extra_z = -1 - end type set_diffusivity_CS type diffusivity_diags @@ -172,12 +166,9 @@ module MOM_set_diffusivity Kd_BBL => NULL(),& ! BBL diffusivity at interfaces (m2/s) Kd_work => NULL(),& ! layer integrated work by diapycnal mixing (W/m2) maxTKE => NULL(),& ! energy required to entrain to h_max (m3/s3) - TKE_to_Kd => NULL(),& ! conversion rate (~1.0 / (G_Earth + dRho_lay)) + TKE_to_Kd => NULL() ! conversion rate (~1.0 / (G_Earth + dRho_lay)) ! between TKE dissipated within a layer and Kd ! in that layer, in m2 s-1 / m3 s-3 = s2 m-1 - KT_extra => NULL(),& ! double diffusion diffusivity for temp (m2/s) - KS_extra => NULL() ! double diffusion diffusivity for saln (m2/s) - end type diffusivity_diags ! Clocks @@ -185,6 +176,17 @@ module MOM_set_diffusivity contains +!> Sets the interior vertical diffusion of scalars due to the following processes: +!! 1) Shear-driven mixing: two options, Jackson et at. and KPP interior; +!! 2) Background mixing via CVMix (Bryan-Lewis profile) or the scheme described by +!! Harrison & Hallberg, JPO 2008; +!! 3) Double-diffusion aplpied via CVMix; +!! 4) Tidal mixing: many options available, see MOM_tidal_mixing.F90; +!! In addition, this subroutine has the option to set the interior vertical +!! viscosity associated with processes 2-4 listed above, which is stored in +!! visc%Kv_slow. Vertical viscosity due to shear-driven mixing is passed via +!! visc%Kv_shear +!! GMM, TODO: add contribution from tidal mixing into visc%Kv_slow subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & G, GV, CS, Kd, Kd_int) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -196,9 +198,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u_h + intent(in) :: u_h !< zonal thickness transport m^2/s. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: v_h + intent(in) :: v_h !< meridional thickness transport m^2/s. type(thermo_var_ptrs), intent(inout) :: tv !< Structure with pointers to thermodynamic !! fields. Out is for tv%TempxPmE. type(forcing), intent(in) :: fluxes !< Structure of surface fluxes that may be @@ -226,17 +228,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! massless layers filled vertically by diffusion. real, dimension(SZI_(G),SZK_(G)) :: & - N2_lay, & ! squared buoyancy frequency associated with layers (1/s2) - maxTKE, & ! energy required to entrain to h_max (m3/s3) - TKE_to_Kd ! conversion rate (~1.0 / (G_Earth + dRho_lay)) between - ! TKE dissipated within a layer and Kd in that layer, in - ! m2 s-1 / m3 s-3 = s2 m-1. + N2_lay, & !< squared buoyancy frequency associated with layers (1/s2) + maxTKE, & !< energy required to entrain to h_max (m3/s3) + TKE_to_Kd !< conversion rate (~1.0 / (G_Earth + dRho_lay)) between + !< TKE dissipated within a layer and Kd in that layer, in + !< m2 s-1 / m3 s-3 = s2 m-1. real, dimension(SZI_(G),SZK_(G)+1) :: & - N2_int, & ! squared buoyancy frequency associated at interfaces (1/s2) - dRho_int, & ! locally ref potential density difference across interfaces (in s-2) smg: or kg/m3? - KT_extra, & ! double difusion diffusivity on temperature (m2/sec) - KS_extra ! double difusion diffusivity on salinity (m2/sec) + N2_int, & !< squared buoyancy frequency associated at interfaces (1/s2) + dRho_int !< locally ref potential density difference across interfaces (in s-2) smg: or kg/m3? real :: I_Rho0 ! inverse of Boussinesq density (m3/kg) real :: dissip ! local variable for dissipation calculations (W/m3) @@ -271,10 +271,16 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & use_EOS = associated(tv%eqn_of_state) - if ((CS%double_diffusion) .and. & + if ((CS%use_CVMix_ddiff) .and. & .not.(associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S)) ) & call MOM_error(FATAL, "set_diffusivity: visc%Kd_extra_T and "//& - "visc%Kd_extra_S must be associated when DOUBLE_DIFFUSION is true.") + "visc%Kd_extra_S must be associated when USE_CVMIX_DDIFF is true.") + + ! Set Kd, Kd_int and Kv_slow to constant values. + ! If nothing else is specified, this will be the value used. + Kd(:,:,:) = CS%Kd + Kd_int(:,:,:) = CS%Kd + if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = CS%Kv ! Set up arrays for diagnostics. @@ -293,12 +299,6 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%id_TKE_to_Kd > 0) then allocate(dd%TKE_to_Kd(isd:ied,jsd:jed,nz)) ; dd%TKE_to_Kd(:,:,:) = 0.0 endif - if ((CS%id_KT_extra > 0) .or. (CS%id_KT_extra_z > 0)) then - allocate(dd%KT_extra(isd:ied,jsd:jed,nz+1)) ; dd%KT_extra(:,:,:) = 0.0 - endif - if ((CS%id_KS_extra > 0) .or. (CS%id_KS_extra_z > 0)) then - allocate(dd%KS_extra(isd:ied,jsd:jed,nz+1)) ; dd%KS_extra(:,:,:) = 0.0 - endif if ((CS%id_Kd_BBL > 0) .or. (CS%id_Kd_BBL_z > 0)) then allocate(dd%Kd_BBL(isd:ied,jsd:jed,nz+1)) ; dd%Kd_BBL(:,:,:) = 0.0 endif @@ -341,6 +341,10 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & elseif (CS%use_CVMix_shear) then !NOTE{BGR}: this needs to be cleaned up. It works in 1D case, but has not been tested outside. call calculate_CVMix_shear(u_h, v_h, h, tv, visc%Kd_shear, visc%Kv_shear,G,GV,CS%CVMix_shear_csp) + if (CS%debug) then + call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear",G%HI) + call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear",G%HI) + endif elseif (associated(visc%Kv_shear)) then visc%Kv_shear(:,:,:) = 0. ! needed if calculate_kappa_shear is not enabled endif @@ -352,8 +356,6 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! set surface diffusivities (CS%bkgnd_mixing_csp%Kd_sfc) call sfc_bkgnd_mixing(G, CS%bkgnd_mixing_csp) -! GMM, fix OMP calls below - !$OMP parallel do default(none) shared(is,ie,js,je,nz,G,GV,CS,h,tv,T_f,S_f,fluxes,dd, & !$OMP Kd,visc, & !$OMP Kd_int,dt,u,v,Omega2) & @@ -370,35 +372,13 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & do K=1,nz+1 ; do i=is,ie ; dd%N2_3d(i,j,K) = N2_int(i,K) ; enddo ; enddo endif - ! add background mixing + ! Add background mixing call calculate_bkgnd_mixing(h, tv, N2_lay, Kd, visc%Kv_slow, j, G, GV, CS%bkgnd_mixing_csp) - ! GMM, the following will go into the MOM_CVMix_double_diffusion module - if (CS%double_diffusion) then - call double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, KT_extra, KS_extra) - do K=2,nz ; do i=is,ie - if (KS_extra(i,K) > KT_extra(i,K)) then ! salt fingering - Kd(i,j,k-1) = Kd(i,j,k-1) + 0.5*KT_extra(i,K) - Kd(i,j,k) = Kd(i,j,k) + 0.5*KT_extra(i,K) - visc%Kd_extra_S(i,j,k) = KS_extra(i,K)-KT_extra(i,K) - visc%Kd_extra_T(i,j,k) = 0.0 - elseif (KT_extra(i,K) > 0.0) then ! double-diffusive convection - Kd(i,j,k-1) = Kd(i,j,k-1) + 0.5*KS_extra(i,K) - Kd(i,j,k) = Kd(i,j,k) + 0.5*KS_extra(i,K) - visc%Kd_extra_T(i,j,k) = KT_extra(i,K)-KS_extra(i,K) - visc%Kd_extra_S(i,j,k) = 0.0 - else ! There is no double diffusion at this interface. - visc%Kd_extra_T(i,j,k) = 0.0 - visc%Kd_extra_S(i,j,k) = 0.0 - endif - enddo ; enddo - if (associated(dd%KT_extra)) then ; do K=1,nz+1 ; do i=is,ie - dd%KT_extra(i,j,K) = KT_extra(i,K) - enddo ; enddo ; endif - - if (associated(dd%KS_extra)) then ; do K=1,nz+1 ; do i=is,ie - dd%KS_extra(i,j,K) = KS_extra(i,K) - enddo ; enddo ; endif + ! Apply double diffusion + ! GMM, we need to pass HBL to compute_ddiff_coeffs, but it is not yet available. + if (CS%use_CVMix_ddiff) then + call compute_ddiff_coeffs(h, tv, G, GV, j, visc%Kd_extra_T, visc%Kd_extra_S, CS%CVMix_ddiff_csp) endif ! Add the input turbulent diffusivity. @@ -496,6 +476,11 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%useKappaShear) call hchksum(visc%Kd_shear,"Turbulent Kd",G%HI,haloshift=0) + if (CS%use_CVMix_ddiff) then + call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T",G%HI,haloshift=0) + call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S",G%HI,haloshift=0) + endif + if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then call uvchksum("BBL Kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, & G%HI, 0, symmetric=.true.) @@ -512,12 +497,6 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif - ! send bkgnd_mixing diagnostics to post_data - if (CS%bkgnd_mixing_csp%id_kd_bkgnd > 0) & - call post_data(CS%bkgnd_mixing_csp%id_kd_bkgnd, CS%bkgnd_mixing_csp%kd_bkgnd, CS%bkgnd_mixing_csp%diag) - if (CS%bkgnd_mixing_csp%id_kv_bkgnd > 0) & - call post_data(CS%bkgnd_mixing_csp%id_kv_bkgnd, CS%bkgnd_mixing_csp%kv_bkgnd, CS%bkgnd_mixing_csp%diag) - if (CS%Kd_add > 0.0) then if (present(Kd_int)) then !$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_int,CS,Kd) @@ -538,13 +517,28 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & T_f, S_f, dd%Kd_user) endif - ! GMM, post diags... - if (CS%id_Kd_layer > 0) call post_data(CS%id_Kd_layer, Kd, CS%diag) + ! post diagnostics - num_z_diags = 0 + ! background mixing + if (CS%bkgnd_mixing_csp%id_kd_bkgnd > 0) & + call post_data(CS%bkgnd_mixing_csp%id_kd_bkgnd, CS%bkgnd_mixing_csp%kd_bkgnd, CS%bkgnd_mixing_csp%diag) + if (CS%bkgnd_mixing_csp%id_kv_bkgnd > 0) & + call post_data(CS%bkgnd_mixing_csp%id_kv_bkgnd, CS%bkgnd_mixing_csp%kv_bkgnd, CS%bkgnd_mixing_csp%diag) + ! double diffusive mixing + if (CS%CVMix_ddiff_csp%id_KT_extra > 0) & + call post_data(CS%CVMix_ddiff_csp%id_KT_extra, visc%Kd_extra_T, CS%CVMix_ddiff_csp%diag) + if (CS%CVMix_ddiff_csp%id_KS_extra > 0) & + call post_data(CS%CVMix_ddiff_csp%id_KS_extra, visc%Kd_extra_S, CS%CVMix_ddiff_csp%diag) + if (CS%CVMix_ddiff_csp%id_R_rho > 0) & + call post_data(CS%CVMix_ddiff_csp%id_R_rho, CS%CVMix_ddiff_csp%R_rho, CS%CVMix_ddiff_csp%diag) + + if (CS%id_Kd_layer > 0) call post_data(CS%id_Kd_layer, Kd, CS%diag) + + ! tidal mixing call post_tidal_diagnostics(G,GV,h,CS%tm_csp) + num_z_diags = 0 if (CS%tm_csp%Int_tide_dissipation .or. CS%tm_csp%Lee_wave_dissipation .or. & CS%tm_csp%Lowmode_itidal_dissipation) then @@ -568,26 +562,11 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif - if (CS%id_KT_extra > 0) call post_data(CS%id_KT_extra, dd%KT_extra, CS%diag) - if (CS%id_KS_extra > 0) call post_data(CS%id_KS_extra, dd%KS_extra, CS%diag) if (CS%id_Kd_BBL > 0) call post_data(CS%id_Kd_BBL, dd%Kd_BBL, CS%diag) - if (CS%id_KT_extra_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_KT_extra_z - z_ptrs(num_z_diags)%p => dd%KT_extra - endif - - if (CS%id_KS_extra_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_KS_extra_z - z_ptrs(num_z_diags)%p => dd%KS_extra - endif - if (CS%id_Kd_BBL_z > 0) then num_z_diags = num_z_diags + 1 z_ids(num_z_diags) = CS%id_Kd_BBL_z - z_ptrs(num_z_diags)%p => dd%KS_extra endif if (num_z_diags > 0) & @@ -598,8 +577,6 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(dd%Kd_user)) deallocate(dd%Kd_user) if (associated(dd%maxTKE)) deallocate(dd%maxTKE) if (associated(dd%TKE_to_Kd)) deallocate(dd%TKE_to_Kd) - if (associated(dd%KT_extra)) deallocate(dd%KT_extra) - if (associated(dd%KS_extra)) deallocate(dd%KS_extra) if (associated(dd%Kd_BBL)) deallocate(dd%Kd_BBL) if (showCallTree) call callTree_leave("set_diffusivity()") @@ -952,119 +929,6 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & end subroutine find_N2 -! GMM, the following will be moved to a new module - -!> This subroutine sets the additional diffusivities of temperature and -!! salinity due to double diffusion, using the same functional form as is -!! used in MOM4.1, and taken from an NCAR technical note (REF?) that updates -!! what was in Large et al. (1994). All the coefficients here should probably -!! be made run-time variables rather than hard-coded constants. -!! -!! \todo Find reference for NCAR tech note above. -subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, Kd_T_dd, Kd_S_dd) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available - !! thermodynamic fields; absent fields have NULL - !! ptrs. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: T_f !< layer temp in C with the values in massless layers - !! filled vertically by diffusion. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: S_f !< Layer salinities in PPT with values in massless - !! layers filled vertically by diffusion. - integer, intent(in) :: j !< Meridional index upon which to work. - type(set_diffusivity_CS), pointer :: CS !< Module control structure. - real, dimension(SZI_(G),SZK_(G)+1), & - intent(out) :: Kd_T_dd !< Interface double diffusion diapycnal - !! diffusivity for temp (m2/sec). - real, dimension(SZI_(G),SZK_(G)+1), & - intent(out) :: Kd_S_dd !< Interface double diffusion diapycnal - !! diffusivity for saln (m2/sec). - -! Arguments: -! (in) tv - structure containing pointers to any available -! thermodynamic fields; absent fields have NULL ptrs -! (in) h - layer thickness (m or kg m-2) -! (in) T_f - layer temp in C with the values in massless layers -! filled vertically by diffusion -! (in) S_f - layer salinities in PPT with values in massless layers -! filled vertically by diffusion -! (in) G - ocean grid structure -! (in) GV - The ocean's vertical grid structure. -! (in) CS - module control structure -! (in) j - meridional index upon which to work -! (out) Kd_T_dd - interface double diffusion diapycnal diffusivity for temp (m2/sec) -! (out) Kd_S_dd - interface double diffusion diapycnal diffusivity for saln (m2/sec) - -! This subroutine sets the additional diffusivities of temperature and -! salinity due to double diffusion, using the same functional form as is -! used in MOM4.1, and taken from an NCAR technical note (###REF?) that updates -! what was in Large et al. (1994). All the coefficients here should probably -! be made run-time variables rather than hard-coded constants. - - real, dimension(SZI_(G)) :: & - dRho_dT, & ! partial derivatives of density wrt temp (kg m-3 degC-1) - dRho_dS, & ! partial derivatives of density wrt saln (kg m-3 PPT-1) - pres, & ! pressure at each interface (Pa) - Temp_int, & ! temp and saln at interfaces - Salin_int - - real :: alpha_dT ! density difference between layers due to temp diffs (kg/m3) - real :: beta_dS ! density difference between layers due to saln diffs (kg/m3) - - real :: Rrho ! vertical density ratio - real :: diff_dd ! factor for double-diffusion - real :: prandtl ! flux ratio for diffusive convection regime - - real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio - real, parameter :: dsfmax = 1.e-4 ! max diffusivity in case of salt fingering - real, parameter :: Kv_molecular = 1.5e-6 ! molecular viscosity (m2/sec) - - integer :: i, k, is, ie, nz - is = G%isc ; ie = G%iec ; nz = G%ke - - if (associated(tv%eqn_of_state)) then - do i=is,ie - pres(i) = 0.0 ; Kd_T_dd(i,1) = 0.0 ; Kd_S_dd(i,1) = 0.0 - Kd_T_dd(i,nz+1) = 0.0 ; Kd_S_dd(i,nz+1) = 0.0 - enddo - do K=2,nz - do i=is,ie - pres(i) = pres(i) + GV%H_to_Pa*h(i,j,k-1) - Temp_Int(i) = 0.5 * (T_f(i,j,k-1) + T_f(i,j,k)) - Salin_Int(i) = 0.5 * (S_f(i,j,k-1) + S_f(i,j,k)) - enddo - call calculate_density_derivs(Temp_int, Salin_int, pres, & - dRho_dT(:), dRho_dS(:), is, ie-is+1, tv%eqn_of_state) - - do i=is,ie - alpha_dT = -1.0*dRho_dT(i) * (T_f(i,j,k-1) - T_f(i,j,k)) - beta_dS = dRho_dS(i) * (S_f(i,j,k-1) - S_f(i,j,k)) - - if ((alpha_dT > beta_dS) .and. (beta_dS > 0.0)) then ! salt finger case - Rrho = min(alpha_dT/beta_dS,Rrho0) - diff_dd = 1.0 - ((RRho-1.0)/(RRho0-1.0)) - diff_dd = dsfmax*diff_dd*diff_dd*diff_dd - Kd_T_dd(i,K) = 0.7*diff_dd - Kd_S_dd(i,K) = diff_dd - elseif ((alpha_dT < 0.) .and. (beta_dS < 0.) .and. (alpha_dT > beta_dS)) then ! diffusive convection - Rrho = alpha_dT/beta_dS - diff_dd = Kv_molecular*0.909*exp(4.6*exp(-0.54*(1/Rrho-1))) - prandtl = 0.15*Rrho - if (Rrho > 0.5) prandtl = (1.85-0.85/Rrho)*Rrho - Kd_T_dd(i,K) = diff_dd - Kd_S_dd(i,K) = prandtl*diff_dd - else - Kd_T_dd(i,K) = 0.0 ; Kd_S_dd(i,K) = 0.0 - endif - enddo - enddo - endif - -end subroutine double_diffusion !> This routine adds diffusion sustained by flow energy extracted by bottom drag. subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & maxTKE, kb, G, GV, CS, Kd, Kd_int, Kd_BBL) @@ -1974,6 +1838,11 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp ! set params releted to the background mixing call bkgnd_mixing_init(Time, G, GV, param_file, CS%diag, CS%bkgnd_mixing_csp) + call get_param(param_file, mdl, "KV", CS%Kv, & + "The background kinematic viscosity in the interior. \n"//& + "The molecular value, ~1e-6 m2 s-1, may be used.", & + units="m2 s-1", fail_if_missing=.true.) + call get_param(param_file, mdl, "KD", CS%Kd, & "The background diapycnal diffusivity of density in the \n"//& "interior. Zero or the molecular value, ~1e-7 m2 s-1, \n"//& @@ -2076,45 +1945,6 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp endif endif - - ! GMM, the following should be moved to the DD module - call get_param(param_file, mdl, "DOUBLE_DIFFUSION", CS%double_diffusion, & - "If true, increase diffusivitives for temperature or salt \n"//& - "based on double-diffusive paramaterization from MOM4/KPP.", & - default=.false.) - if (CS%double_diffusion) then - call get_param(param_file, mdl, "MAX_RRHO_SALT_FINGERS", CS%Max_Rrho_salt_fingers, & - "Maximum density ratio for salt fingering regime.", & - default=2.55, units="nondim") - call get_param(param_file, mdl, "MAX_SALT_DIFF_SALT_FINGERS", CS%Max_salt_diff_salt_fingers, & - "Maximum salt diffusivity for salt fingering regime.", & - default=1.e-4, units="m2 s-1") - call get_param(param_file, mdl, "KV_MOLECULAR", CS%Kv_molecular, & - "Molecular viscosity for calculation of fluxes under \n"//& - "double-diffusive convection.", default=1.5e-6, units="m2 s-1") - ! The default molecular viscosity follows the CCSM4.0 and MOM4p1 defaults. - - CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for temperature', 'm2 s-1') - - CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for salinity', 'm2 s-1') - - if (associated(diag_to_Z_CSp)) then - vd = var_desc("KT_extra", "m2 s-1", & - "Double-Diffusive Temperature Diffusivity, interpolated to z", & - z_grid='z') - CS%id_KT_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - vd = var_desc("KS_extra", "m2 s-1", & - "Double-Diffusive Salinity Diffusivity, interpolated to z",& - z_grid='z') - CS%id_KS_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - vd = var_desc("Kd_BBL", "m2 s-1", & - "Bottom Boundary Layer Diffusivity", z_grid='z') - CS%id_Kd_BBL_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - endif - endif - if (CS%user_change_diff) then call user_change_diff_init(Time, G, param_file, diag, CS%user_change_diff_CSp) endif @@ -2130,6 +1960,9 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp ! CVMix shear-driven mixing CS%use_CVMix_shear = CVMix_shear_init(Time, G, GV, param_file, CS%diag, CS%CVMix_shear_csp) + ! CVMix double diffusion mixing + CS%use_CVMix_ddiff = CVMix_ddiff_init(Time, G, GV, param_file, CS%diag, CS%CVMix_ddiff_csp) + end subroutine set_diffusivity_init !> Clear pointers and dealocate memory @@ -2146,6 +1979,9 @@ subroutine set_diffusivity_end(CS) if (CS%use_CVMix_shear) & call CVMix_shear_end(CS%CVMix_shear_csp) + if (CS%use_CVMix_ddiff) & + call CVMix_ddiff_end(CS%CVMix_ddiff_csp) + if (associated(CS)) deallocate(CS) end subroutine set_diffusivity_end diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index ec0b5a80b3..ec1b09a5ad 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -2,38 +2,6 @@ module MOM_set_visc ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, April 1994 - October 2006 * -!* Quadratic Bottom Drag by James Stephens and R. Hallberg. * -!* * -!* This file contains the subroutine that calculates various values * -!* related to the bottom boundary layer, such as the viscosity and * -!* thickness of the BBL (set_viscous_BBL). This would also be the * -!* module in which other viscous quantities that are flow-independent * -!* might be set. This information is transmitted to other modules * -!* via a vertvisc type structure. * -!* * -!* The same code is used for the two velocity components, by * -!* indirectly referencing the velocities and defining a handful of * -!* direction-specific defined variables. * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v, frhatv, tauy * -!* j x ^ x ^ x At >: u, frhatu, taux * -!* j > o > o > At o: h * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_debugging, only : uvchksum, hchksum use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr @@ -44,8 +12,9 @@ module MOM_set_visc use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type use MOM_kappa_shear, only : kappa_shear_is_used -use MOM_CVMix_shear, only : CVMix_shear_is_used -use MOM_CVMix_conv, only : CVMix_conv_is_used +use MOM_cvmix_shear, only : cvmix_shear_is_used +use MOM_cvmix_conv, only : cvmix_conv_is_used +use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used use MOM_io, only : vardesc, var_desc use MOM_restart, only : register_restart_field, MOM_restart_CS use MOM_variables, only : thermo_var_ptrs @@ -1791,8 +1760,10 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) call get_param(param_file, mdl, "ADIABATIC", adiabatic, default=.false., & do_not_log=.true.) + use_kappa_shear = .false. ; use_CVMix_shear = .false. useKPP = .false. ; useEPBL = .false. ; use_CVMix_conv = .false. + if (.not.adiabatic) then use_kappa_shear = kappa_shear_is_used(param_file) use_CVMix_shear = CVMix_shear_is_used(param_file) @@ -1811,7 +1782,9 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) allocate(visc%Kd_shear(isd:ied,jsd:jed,nz+1)) ; visc%Kd_shear(:,:,:) = 0.0 allocate(visc%TKE_turb(isd:ied,jsd:jed,nz+1)) ; visc%TKE_turb(:,:,:) = 0.0 allocate(visc%Kv_shear(isd:ied,jsd:jed,nz+1)) ; visc%Kv_shear(:,:,:) = 0.0 - allocate(visc%Kv_slow(isd:ied,jsd:jed,nz+1)) ; visc%Kv_slow(:,:,:) = 0.0 + + ! MOM_bkgnd_mixing is always used, so always allocate visc%Kv_slow. GMM + allocate(visc%Kv_slow(isd:ied,jsd:jed,nz+1)) ; visc%Kv_slow(:,:,:) = 0.0 vd = var_desc("Kd_shear","m2 s-1","Shear-driven turbulent diffusivity at interfaces", & hor_grid='h', z_grid='i') @@ -1854,21 +1827,14 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) type(set_visc_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module type(ocean_OBC_type), pointer :: OBC -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (out) visc - A structure containing vertical viscosities and related -! fields. Allocated here. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module + + ! local variables real :: Csmag_chan_dflt, smag_const1, TKE_decay_dflt, bulk_Ri_ML_dflt real :: Kv_background real :: omega_frac_dflt integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, i, j, n - logical :: use_kappa_shear, adiabatic, differential_diffusion, use_omega + logical :: use_kappa_shear, adiabatic, use_omega + logical :: use_CVMix_ddiff type(OBC_segment_type), pointer :: segment ! pointer to OBC segment type ! This include declares and sets the variable "version". #include "version_variable.h" @@ -1891,8 +1857,8 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) ! Set default, read and log parameters call log_version(param_file, mdl, version, "") - CS%RiNo_mix = .false. - use_kappa_shear = .false. ; differential_diffusion = .false. !; adiabatic = .false. ! Needed? -AJA + CS%RiNo_mix = .false. ; use_CVMix_ddiff = .false. + use_kappa_shear = .false. !; adiabatic = .false. ! Needed? -AJA call get_param(param_file, mdl, "BOTTOMDRAGLAW", CS%bottomdraglaw, & "If true, the bottom stress is calculated with a drag \n"//& "law of the form c_drag*|u|*u. The velocity magnitude \n"//& @@ -1919,11 +1885,9 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) if (.not.adiabatic) then use_kappa_shear = kappa_shear_is_used(param_file) CS%RiNo_mix = use_kappa_shear - call get_param(param_file, mdl, "DOUBLE_DIFFUSION", differential_diffusion, & - "If true, increase diffusivitives for temperature or salt \n"//& - "based on double-diffusive paramaterization from MOM4/KPP.", & - default=.false.) + use_CVMix_ddiff = CVMix_ddiff_is_used(param_file) endif + call get_param(param_file, mdl, "PRANDTL_TURB", visc%Prandtl_turb, & "The turbulent Prandtl number applied to shear \n"//& "instability.", units="nondim", default=1.0) @@ -2016,6 +1980,15 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) "The background kinematic viscosity in the interior. \n"//& "The molecular value, ~1e-6 m2 s-1, may be used.", & units="m2 s-1", fail_if_missing=.true.) + + call get_param(param_file, mdl, "ADD_KV_SLOW", visc%add_Kv_slow, & + "If true, the background vertical viscosity in the interior \n"//& + "(i.e., tidal + background + shear + convenction) is addded \n"// & + "when computing the coupling coefficient. The purpose of this \n"// & + "flag is to be able to recover previous answers and it will likely \n"// & + "be removed in the future since this option should always be true.", & + default=.false.) + call get_param(param_file, mdl, "KV_BBL_MIN", CS%KV_BBL_min, & "The minimum viscosities in the bottom boundary layer.", & units="m2 s-1", default=Kv_background) @@ -2065,7 +2038,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) Time, 'Rayleigh drag velocity at v points', 'm s-1') endif - if (differential_diffusion) then + if (use_CVMix_ddiff) then allocate(visc%Kd_extra_T(isd:ied,jsd:jed,nz+1)) ; visc%Kd_extra_T = 0.0 allocate(visc%Kd_extra_S(isd:ied,jsd:jed,nz+1)) ; visc%Kd_extra_S = 0.0 endif @@ -2113,4 +2086,37 @@ subroutine set_visc_end(visc, CS) deallocate(CS) end subroutine set_visc_end +!> \namespace MOM_set_visc +!!********+*********+*********+*********+*********+*********+*********+** +!!* * +!!* By Robert Hallberg, April 1994 - October 2006 * +!!* Quadratic Bottom Drag by James Stephens and R. Hallberg. * +!!* * +!!* This file contains the subroutine that calculates various values * +!!* related to the bottom boundary layer, such as the viscosity and * +!!* thickness of the BBL (set_viscous_BBL). This would also be the * +!!* module in which other viscous quantities that are flow-independent * +!!* might be set. This information is transmitted to other modules * +!!* via a vertvisc type structure. * +!!* * +!!* The same code is used for the two velocity components, by * +!!* indirectly referencing the velocities and defining a handful of * +!!* direction-specific defined variables. * +!!* * +!!* Macros written all in capital letters are defined in MOM_memory.h. * +!!* * +!!* A small fragment of the grid is shown below: * +!!* * +!!* j+1 x ^ x ^ x At x: q * +!!* j+1 > o > o > At ^: v, frhatv, tauy * +!!* j x ^ x ^ x At >: u, frhatu, taux * +!!* j > o > o > At o: h * +!!* j-1 x ^ x ^ x * +!!* i-1 i i+1 At x & ^: * +!!* i i+1 At > & o: * +!!* * +!!* The boundaries always run through q grid points (x). * +!!* * +!!********+*********+*********+*********+*********+*********+*********+** + end module MOM_set_visc diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 48a6380ead..bafbe5eb59 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -2,7 +2,7 @@ module MOM_vert_friction ! This file is part of MOM6. See LICENSE.md for the license. - +use MOM_domains, only : pass_var, To_All, Omit_corners use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl use MOM_debugging, only : uvchksum, hchksum @@ -116,6 +116,7 @@ module MOM_vert_friction integer :: id_du_dt_visc = -1, id_dv_dt_visc = -1, id_au_vv = -1, id_av_vv = -1 integer :: id_h_u = -1, id_h_v = -1, id_hML_u = -1 , id_hML_v = -1 integer :: id_Ray_u = -1, id_Ray_v = -1, id_taux_bot = -1, id_tauy_bot = -1 + integer :: id_Kv_slow = -1, id_Kv_u = -1, id_Kv_v = -1 !>@} type(PointAccel_CS), pointer :: PointAccel_CSp => NULL() @@ -614,6 +615,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! based on harmonic mean thicknesses, in m or kg m-2. h_ml ! The mixed layer depth, in m or kg m-2. real, allocatable, dimension(:,:) :: hML_u, hML_v + real, allocatable, dimension(:,:,:) :: Kv_v, & !< Total vertical viscosity at u-points + Kv_u !< Total vertical viscosity at v-points real :: zcol(SZI_(G)) ! The height of an interface at h-points, in m or kg m-2. real :: botfn ! A function which goes from 1 at the bottom to 0 much more ! than Hbbl into the interior. @@ -646,6 +649,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) I_Hbbl(:) = 1.0 / (CS%Hbbl * GV%m_to_H + h_neglect) I_valBL = 0.0 ; if (CS%harm_BL_val > 0.0) I_valBL = 1.0 / CS%harm_BL_val + if (CS%id_Kv_u > 0) then + allocate(Kv_u(G%IsdB:G%IedB,G%jsd:G%jed,G%ke)) ; Kv_u(:,:,:) = 0.0 + endif + + if (CS%id_Kv_v > 0) then + allocate(Kv_v(G%isd:G%ied,G%JsdB:G%JedB,G%ke)) ; Kv_v(:,:,:) = 0.0 + endif + if (CS%debug .or. (CS%id_hML_u > 0)) then allocate(hML_u(G%IsdB:G%IedB,G%jsd:G%jed)) ; hML_u(:,:) = 0.0 endif @@ -821,6 +832,13 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) CS%h_u(I,j,k) = hvel(I,k) ; enddo ; enddo endif + ! Diagnose total Kv at u-points + if (CS%id_Kv_u > 0) then + do k=1,nz ; do I=Isq,Ieq + if (do_i(I)) Kv_u(I,j,k) = 0.5 * (CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k) + enddo ; enddo + endif + enddo @@ -984,6 +1002,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) CS%a_v(i,J,K) = a(i,K) ; enddo ; enddo do k=1,nz ; do i=is,ie ; if (do_i(i)) CS%h_v(i,J,k) = hvel(i,k) ; enddo ; enddo endif + + ! Diagnose total Kv at v-points + if (CS%id_Kv_v > 0) then + do k=1,nz ; do i=is,ie + if (do_i(I)) Kv_v(i,J,k) = 0.5 * (CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k) + enddo ; enddo + endif + enddo ! end of v-point j loop if (CS%debug) then @@ -997,6 +1023,9 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) endif ! Offer diagnostic fields for averaging. + if (CS%id_Kv_slow > 0) call post_data(CS%id_Kv_slow, visc%Kv_slow, CS%diag) + if (CS%id_Kv_u > 0) call post_data(CS%id_Kv_u, Kv_u, CS%diag) + if (CS%id_Kv_v > 0) call post_data(CS%id_Kv_v, Kv_v, CS%diag) if (CS%id_au_vv > 0) call post_data(CS%id_au_vv, CS%a_u, CS%diag) if (CS%id_av_vv > 0) call post_data(CS%id_av_vv, CS%a_v, CS%diag) if (CS%id_h_u > 0) call post_data(CS%id_h_u, CS%h_u, CS%diag) @@ -1165,6 +1194,44 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif endif + ! add "slow" varying vertical viscosity (e.g., from background, tidal etc) + if (associated(visc%Kv_slow) .and. (visc%add_Kv_slow)) then + ! GMM/ A factor of 2 is also needed here, see comment above from BGR. + if (work_on_u) then + do K=2,nz ; do i=is,ie ; if (do_i(i)) then + Kv_add(i,K) = Kv_add(i,K) + 1.0 * (visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k)) + endif ; enddo ; enddo + if (do_OBCs) then + do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then + if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j,k) ; enddo + elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i+1,j,k) ; enddo + endif + endif ; enddo + endif + do K=2,nz ; do i=is,ie ; if (do_i(i)) then + a(i,K) = a(i,K) + Kv_add(i,K) + endif ; enddo ; enddo + else + do K=2,nz ; do i=is,ie ; if (do_i(i)) then + Kv_add(i,K) = Kv_add(i,K) + 1.0*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j+1,k)) + endif ; enddo ; enddo + if (do_OBCs) then + do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then + if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j,k) ; enddo + elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j+1,k) ; enddo + endif + endif ; enddo + endif + do K=2,nz ; do i=is,ie ; if (do_i(i)) then + a(i,K) = a(i,K) + Kv_add(i,K) + endif ; enddo ; enddo + endif + endif + do K=nz,2,-1 ; do i=is,ie ; if (do_i(i)) then ! botfn determines when a point is within the influence of the bottom ! boundary layer, going from 1 at the bottom to 0 in the interior. @@ -1671,17 +1738,30 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & ALLOC_(CS%a_v(isd:ied,JsdB:JedB,nz+1)) ; CS%a_v(:,:,:) = 0.0 ALLOC_(CS%h_v(isd:ied,JsdB:JedB,nz)) ; CS%h_v(:,:,:) = 0.0 + CS%id_Kv_slow = register_diag_field('ocean_model', 'Kv_slow', diag%axesTi, Time, & + 'Slow varying vertical viscosity', 'm2 s-1') + + CS%id_Kv_u = register_diag_field('ocean_model', 'Kv_u', diag%axesCuL, Time, & + 'Total vertical viscosity at u-points', 'm2 s-1') + + CS%id_Kv_v = register_diag_field('ocean_model', 'Kv_v', diag%axesCvL, Time, & + 'Total vertical viscosity at v-points', 'm2 s-1') + CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, & 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1') + CS%id_av_vv = register_diag_field('ocean_model', 'av_visc', diag%axesCvi, Time, & 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1') CS%id_h_u = register_diag_field('ocean_model', 'Hu_visc', diag%axesCuL, Time, & 'Thickness at Zonal Velocity Points for Viscosity', thickness_units) + CS%id_h_v = register_diag_field('ocean_model', 'Hv_visc', diag%axesCvL, Time, & 'Thickness at Meridional Velocity Points for Viscosity', thickness_units) + CS%id_hML_u = register_diag_field('ocean_model', 'HMLu_visc', diag%axesCu1, Time, & 'Mixed Layer Thickness at Zonal Velocity Points for Viscosity', thickness_units) + CS%id_hML_v = register_diag_field('ocean_model', 'HMLv_visc', diag%axesCv1, Time, & 'Mixed Layer Thickness at Meridional Velocity Points for Viscosity', thickness_units) From 8dafed9d3219298fbb818c8e968d3822d3eb4eb8 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Sat, 2 Jun 2018 13:19:45 -0400 Subject: [PATCH 0333/1072] Test for submitting job success - Gaea runtime variability is causing numerous timeouts again so rather than assuming the submitted job succeeds we now test that the last file to be made exists. - Also added 2 minutes to job. --- .gitlab-ci.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 0505578ed0..ec16fd5d7b 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -116,8 +116,9 @@ run: - time tar zxf $CACHE_DIR/build-pgi-repro-$CI_PIPELINE_ID.tgz # time tar zxf $CACHE_DIR/build-gnu-debug-$CI_PIPELINE_ID.tgz - echo "make -f MRS/Makefile.tests all -B" > job.sh - - msub -l partition=c4,nodes=29,walltime=00:29:00,qos=norm -q debug -S /bin/tcsh -j oe -A gfdl_o -z -o log.$CI_PIPELINE_ID -N mom6_regression -K job.sh + - msub -l partition=c4,nodes=29,walltime=00:31:00,qos=norm -q debug -S /bin/tcsh -j oe -A gfdl_o -z -o log.$CI_PIPELINE_ID -N mom6_regression -K job.sh - cat log.$CI_PIPELINE_ID + - test -f restart_results_gnu.tar.gz - time tar zvcf $CACHE_DIR/results-$CI_PIPELINE_ID.tgz *.tar.gz # Tests From eef4bf2d49d4a96be2f37270cb9e42ad485057d6 Mon Sep 17 00:00:00 2001 From: Rocky Dunlap Date: Mon, 4 Jun 2018 14:17:47 -0600 Subject: [PATCH 0334/1072] Added global grid nx and ny scalars to MOM6 cap for writing history files --- config_src/nuopc_driver/mom_cap.F90 | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index e6939af64c..8e833f6128 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -392,6 +392,7 @@ module mom_cap_mod use mom_cap_methods, only: ocn_export, ocn_import use esmFlds, only: flds_scalar_name, flds_scalar_num use esmFlds, only: fldListFr, fldListTo, compocn, compname + use esmFlds, only: flds_scalar_index_nx, flds_scalar_index_ny use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Realize use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Concat use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Getnumflds @@ -868,6 +869,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) real(ESMF_KIND_R8), pointer :: dataPtr_xcor(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_ycor(:,:) type(ESMF_Field) :: field_t_surf + integer :: mpicom character(len=*),parameter :: subname='(mom_cap:InitializeRealize)' rc = ESMF_SUCCESS @@ -888,7 +890,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out - call ESMF_VMGet(vm, petCount=npet, rc=rc) + call ESMF_VMGet(vm, petCount=npet, mpiCommunicator=mpicom, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1307,6 +1309,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call shr_nuopc_fldList_Realize(exportState, fldListFr(compocn), flds_scalar_name, flds_scalar_num, & grid=gridOut, tag=subname//':MOM6Export', rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, mpicom, & + flds_scalar_name, flds_scalar_num, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, mpicom, & + flds_scalar_name, flds_scalar_num, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return #else call MOM_RealizeFields(importState, gridIn , fldsToOcn_num, fldsToOcn, "Ocn import", rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & From f3ca0c8df023ac7281317ea77c2c6b08e0393067 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 4 Jun 2018 18:43:21 -0600 Subject: [PATCH 0335/1072] fixes to get mom cap working with cice --- config_src/nuopc_driver/mom_cap.F90 | 32 ++- config_src/nuopc_driver/mom_cap_methods.F90 | 260 +++++++++++++------- 2 files changed, 184 insertions(+), 108 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index e6939af64c..c24bb1261b 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -399,14 +399,10 @@ module mom_cap_mod use shr_nuopc_methods_mod, only: shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod, only: shr_nuopc_methods_State_GetScalar use shr_nuopc_methods_mod, only: shr_nuopc_methods_State_Diagnose +#endif use MOM_ocean_model, only: ocean_model_restart, ocean_public_type, ocean_state_type - use MOM_ocean_model, only: ocean_model_data_get + use MOM_ocean_model, only: ocean_model_data_get, ocean_model_init_sfc use MOM_ocean_model, only: ocean_model_init , update_ocean_model, ocean_model_end, get_ocean_grid -#else - use ocean_model_mod, only: ocean_model_restart, ocean_public_type, ocean_state_type - use ocean_model_mod, only: ocean_model_data_get - use ocean_model_mod, only: ocean_model_init , update_ocean_model, ocean_model_end, get_ocean_grid -#endif use ESMF use NUOPC @@ -742,10 +738,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ocean_public%is_ocean_pe = .true. call ocean_model_init(ocean_public, ocean_state, Time, Time) -!tcx tcraig This results in errors in CESM with help from Alper -! FATAL error "MPP_OPEN: error in OPEN for data_table" -! The subroutine data_override_init shouldn't be called because ALLOW_FLUX_ADJUSTMENTS is set to FALSE -!tcx call data_override_init(ocean_domain_in = ocean_public%domain) +#ifdef CESMCOUPLED + call ocean_model_init_sfc(ocean_state, ocean_public) +#endif + + !tcx tcraig This results in errors in CESM with help from Alper + ! FATAL error "MPP_OPEN: error in OPEN for data_table" + ! The subroutine data_override_init shouldn't be called because ALLOW_FLUX_ADJUSTMENTS is set to FALSE + !tcx call data_override_init(ocean_domain_in = ocean_public%domain) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) call IOB_allocate(ice_ocean_boundary, isc, iec, jsc, jec) @@ -792,7 +792,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call MOM_FieldsSetup(ice_ocean_boundary, ocean_public) call MOM_AdvertiseFields(importState, fldsToOcn_num, fldsToOcn, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_file_u)) return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out call MOM_AdvertiseFields(exportState, fldsFrOcn_num, fldsFrOcn, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1403,14 +1406,10 @@ subroutine DataInitialize(gcomp, rc) return ! bail out Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr - ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr call get_ocean_grid(ocean_state, ocean_grid) - !tcx ---------- - RETURN - !tcx ---------- - call ocn_export(ocean_public, ocean_grid, exportState, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2432,5 +2431,4 @@ subroutine calculate_rot_angle(OS, OSFC) #endif #endif - end module mom_cap_mod diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 92c37f0e56..4743395938 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -1,6 +1,6 @@ -!> This is the main driver for MOM6 in CIME module mom_cap_methods + ! This is the main driver for MOM6 in CIME ! This file is part of MOM6. See LICENSE.md for the license. ! mct modules @@ -57,6 +57,7 @@ subroutine ocn_export(ocean_public, grid, exportState, rc) real(ESMF_KIND_R8), pointer :: dataPtr_fco2_ocn(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_fdms_ocn(:,:) character(len=*), parameter :: subname = '(ocn_export)' + logical :: first_time = .true. !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -140,67 +141,88 @@ subroutine ocn_export(ocean_public, grid, exportState, rc) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) !tcx - ! write(tmpstr,'(a,6i8)') subname//'tcx1',lbnd1,ubnd1,lbnd2,ubnd2 - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx2',isc,iec,jsc,jec - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx3',lbound(ssh,1),ubound(ssh,1),lbound(ssh,2),ubound(ssh,2) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx4',lbound(ocean_public%sea_lev,1),ubound(ocean_public%sea_lev,1),lbound(ocean_public%sea_lev,2),ubound(ocean_public%sea_lev,2) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx5',lbound(grid%mask2dT,1),ubound(grid%mask2dT,1),lbound(grid%mask2dT,2),ubound(grid%mask2dT,2) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx6',grid%isd,grid%ied,grid%jsd,grid%jed - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx7',grid%isc,grid%iec,grid%jsc,grid%jec - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx8',grid%idg_offset, grid%jdg_offset - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx9',lbound(dataPtr_omask,1),ubound(dataPtr_omask,1),lbound(dataPtr_omask,2),ubound(dataPtr_omask,2) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - ! Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. - ! The mask comes from "grid" that uses the usual MOM domain that has halos - ! and does not use global indexing. + ! write(tmpstr,'(a,6i8)') subname//'tcx1',lbnd1,ubnd1,lbnd2,ubnd2 + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx2',isc,iec,jsc,jec + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx3_1',lbound(ssh,1),ubound(ssh,1) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx3_2',lbound(ssh,2),ubound(ssh,2) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx4_1',lbound(ocean_public%sea_lev,1),ubound(ocean_public%sea_lev,1) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx4_2',lbound(ocean_public%sea_lev,2),ubound(ocean_public%sea_lev,2) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx5_1',lbound(grid%mask2dT,1),ubound(grid%mask2dT,1) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx5_2',lbound(grid%mask2dT,2),ubound(grid%mask2dT,2) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx6',grid%isd,grid%ied,grid%jsd,grid%jed + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx7',grid%isc,grid%iec,grid%jsc,grid%jec + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx8',grid%idg_offset, grid%jdg_offset + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx9_1',lbound(dataPtr_omask,1),ubound(dataPtr_omask,1) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx9_2',lbound(dataPtr_omask,2),ubound(dataPtr_omask,2) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + !tcx + + !Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. + !The mask comes from "grid" that uses the usual MOM domain that has halos + !and does not use global indexing. do j = jsc, jec j1 = j + lbnd2 - jsc jg = j + grid%jsc - jsc do i = isc, iec i1 = i + lbnd1 - isc - ig = i + grid%jsc - isc - ! surface temperature in Kelvin + ig = i + grid%isc - isc dataPtr_omask(i1,j1) = grid%mask2dT(ig,jg) - dataPtr_t(i1,j1) = ocean_public%t_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_s(i1,j1) = ocean_public%s_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_u(i1,j1) = ocean_public%u_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_v(i1,j1) = ocean_public%v_surf(i,j) * grid%mask2dT(ig,jg) - ! dataPtr_u(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%u_surf(i,j) & - ! - grid%sin_rot(ig,jg) * ocean_public%v_surf(i,j)) * grid%mask2dT(ig,jg) - ! dataPtr_v(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%v_surf(i,j) & - ! + grid%sin_rot(ig,jg) * ocean_public%u_surf(i,j)) * grid%mask2dT(ig,jg) - ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain - ! in order to update halos. i.e. does not use global indexing. - ! ssh(i,j) = ocean_public%sea_lev(i,j) - ssh = 0. + dataPtr_t(i1,j1) = ocean_public%t_surf(i,j) * grid%mask2dT(ig,jg) ! surface temp is in K + dataPtr_s(i1,j1) = ocean_public%s_surf(i,j) * grid%mask2dT(ig,jg) + dataPtr_u(i1,j1) = ocean_public%u_surf(i,j) * grid%mask2dT(ig,jg) + dataPtr_v(i1,j1) = ocean_public%v_surf(i,j) * grid%mask2dT(ig,jg) + dataPtr_q(i1,j1) = 0. + !dataPtr_u(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%u_surf(i,j) & + ! - grid%sin_rot(ig,jg) * ocean_public%v_surf(i,j)) * grid%mask2dT(ig,jg) + !dataPtr_v(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%v_surf(i,j) & + ! + grid%sin_rot(ig,jg) * ocean_public%u_surf(i,j)) * grid%mask2dT(ig,jg) + end do + end do + + !dataPtr_dhdx(:,:) = 0. + !dataPtr_dhdy(:,:) = 0. + !ssh(:,:) = 0. + + ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain + ! in order to update halos. i.e. does not use global indexing. + do j=grid%jsc, grid%jec + jg = j + grid%jdg_offset + do i=grid%isc,grid%iec + ig = i + grid%idg_offset + ssh(i,j) = ocean_public%sea_lev(ig,jg) end do end do -#if (1 == 0) ! Update halo of ssh so we can calculate gradients call pass_var(ssh, grid%domain) ! d/dx ssh - do j=jsc, jec - j1 = j + lbnd2 - jsc - do i=isc,iec - i1 = i + lbnd1 - isc + do jg = jsc, jec + j = jg + grid%jsc - jsc + j1 = jg + lbnd2 - jsc + do ig = isc,iec + i = ig + grid%isc - isc + i1 = ig + lbnd1 - isc + ! This is a simple second-order difference !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(ig,jg) ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) - if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. - slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(I,j) - if (grid%mask2dCu(I+1,j)==0.) slp_R = 0. + slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(i-1,j) + if (grid%mask2dCu(i-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(i,j) + if (grid%mask2dCu(i+1,j)==0.) slp_R = 0. slp_C = 0.5 * (slp_L + slp_R) if ( (slp_L * slp_R) > 0.0 ) then ! This limits the slope so that the edge values are bounded by the @@ -213,23 +235,26 @@ subroutine ocn_export(ocean_public, grid, exportState, rc) ! larger extreme values. slope = 0.0 end if - dataPtr_dhdx(i1,j1) = slope * grid%IdxT(i,j) * grid%mask2dT(ig,jg) - if (grid%mask2dT(ig,jg)==0.) dataPtr_dhdx(i1,j1) = 0.0 + dataPtr_dhdx(i1,j1) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) dataPtr_dhdx(i1,j1) = 0.0 end do end do ! d/dy ssh - do j=jsc, jec - j1 = j + lbnd2 - jsc - do i=isc,iec - i1 = i + lbnd1 - isc + do jg = jsc, jec + j = jg + grid%jsc - jsc + j1 = jg + lbnd2 - jsc + do ig = isc,iec + i = ig + grid%isc - isc + i1 = ig + lbnd1 - isc + ! This is a simple second-order difference !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(ig,jg) ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) - if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. - slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,J) - if (grid%mask2dCv(i,J+1)==0.) slp_R = 0. + slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,j-1) + if (grid%mask2dCv(i,j-1)==0.) slp_L = 0. + slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,j) + if (grid%mask2dCv(i,j+1)==0.) slp_R = 0. slp_C = 0.5 * (slp_L + slp_R) !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R if ((slp_L * slp_R) > 0.0) then @@ -243,11 +268,76 @@ subroutine ocn_export(ocean_public, grid, exportState, rc) ! larger extreme values. slope = 0.0 end if - dataPtr_dhdy(i1,j1) = slope * grid%IdyT(i,j) * grid%mask2dT(ig,jg) - if (grid%mask2dT(ig,jg)==0.) dataPtr_dhdy(i1,j1) = 0.0 + dataPtr_dhdy(i1,j1) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) dataPtr_dhdy(i1,j1) = 0.0 end do end do -#endif + +!!$ ! Update halo of ssh so we can calculate gradients +!!$ call pass_var(ssh, grid%domain) +!!$ +!!$ ! d/dx ssh +!!$ do j=grid%jsc, grid%jec +!!$ j1 = j + lbnd2 - grid%jsc +!!$ do i=grid%isc,grid%iec +!!$ i1 = i + lbnd1 - grid%isc +!!$ ! This is a simple second-order difference +!!$ ! dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(ig,jg) +!!$ ! This is a PLM slope which might be less prone to the A-grid null mode +!!$ slp_L = (ssh(i,j) - ssh(i-1,j)) * grid%mask2dCu(i-1,j) +!!$ if (grid%mask2dCu(i-1,j)==0.) slp_L = 0. +!!$ +!!$ slp_R = (ssh(i+1,j) - ssh(i,j)) * grid%mask2dCu(i,j) +!!$ if (grid%mask2dCu(i+1,j)==0.) slp_R = 0. +!!$ +!!$ slp_C = 0.5 * (slp_L + slp_R) +!!$ if ( (slp_L * slp_R) > 0.0 ) then +!!$ ! This limits the slope so that the edge values are bounded by the +!!$ ! two cell averages spanning the edge. +!!$ u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) +!!$ u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) +!!$ slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) +!!$ else +!!$ ! Extrema in the mean values require a PCM reconstruction avoid generating +!!$ ! larger extreme values. +!!$ slope = 0.0 +!!$ end if +!!$ dataPtr_dhdx(i1,j1) = slope * grid%IdxT(i,j) * grid%mask2dT(ig,jg) +!!$ if (grid%mask2dT(ig,jg)==0.) dataPtr_dhdx(i1,j1) = 0.0 +!!$ end do +!!$ end do +!!$ +!!$ ! d/dy ssh +!!$ do j=grid%jsc, grid%jec +!!$ j1 = j + lbnd2 - grid%jsc +!!$ do i=grid%isc,grid%iec +!!$ i1 = i + lbnd1 - grid%isc +!!$ ! This is a simple second-order difference +!!$ ! dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(ig,jg) +!!$ ! This is a PLM slope which might be less prone to the A-grid null mode +!!$ slp_L = ssh(i,j) - ssh(i,j-1) * grid%mask2dCv(i,j-1) +!!$ if (grid%mask2dCv(i,j-1)==0.) slp_L = 0. +!!$ +!!$ slp_R = ssh(i,j+1) - ssh(i,j) * grid%mask2dCv(i,j) +!!$ if (grid%mask2dCv(i,j+1)==0.) slp_R = 0. +!!$ +!!$ slp_C = 0.5 * (slp_L + slp_R) +!!$ if ((slp_L * slp_R) > 0.0) then +!!$ ! This limits the slope so that the edge values are bounded by the +!!$ ! two cell averages spanning the edge. +!!$ u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) +!!$ u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) +!!$ slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) +!!$ else +!!$ ! Extrema in the mean values require a PCM reconstruction avoid generating +!!$ ! larger extreme values. +!!$ slope = 0.0 +!!$ end if +!!$ dataPtr_dhdy(i1,j1) = slope * grid%IdyT(i,j) * grid%mask2dT(ig,jg) +!!$ if (grid%mask2dT(ig,jg)==0.) dataPtr_dhdy(i1,j1) = 0.0 +!!$ end do +!!$ end do + end subroutine ocn_export !----------------------------------------------------------------------- @@ -506,38 +596,26 @@ subroutine ocn_import(ocean_public, grid, importState, ice_ocean_boundary, rc) ! This will skip the first time import information is given if (import_cnt > 2) then - ! ice_ocean_boundary%p(i,j) = GRID%mask2dT(ig,jg) * dataPtr_p(i1,j1) - ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) * GRID%mask2dT(ig,jg) - ! ice_ocean_boundary%u_flux(i,j) = (GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + & - ! GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1)) - ! ice_ocean_boundary%v_flux(i,j) = (GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + & - ! GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1)) - - ice_ocean_boundary%t_flux(i,j) = -dataPtr_sen(i1,j1) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) * GRID%mask2dT(ig,jg) - !! ice_ocean_boundary%latent(i,j) = dataPtr_lat(i1,j1) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%lw_flux(i,j) = (dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1)) * GRID%mask2dT(ig,jg) - - ! tcx TO DO c1-c4 - ! c1 = 0.25_ESMF_KIND_R8 - ! c2 = 0.25_ESMF_KIND_R8 - ! c3 = 0.25_ESMF_KIND_R8 - ! c4 = 0.25_ESMF_KIND_R8 - ice_ocean_boundary%sw_flux_vis_dir(i,j) = GRID%mask2dT(ig,jg) * dataPtr_swvdr(i1,j1) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = GRID%mask2dT(ig,jg) * dataPtr_swvdf(i1,j1) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = GRID%mask2dT(ig,jg) * dataPtr_swndf(i1,j1) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = GRID%mask2dT(ig,jg) * dataPtr_swndf(i1,j1) - - ! ice_ocean_boundary%sw(i,j) = ice_ocean_boundary%sw_flux_vis_dir(i,j) + ice_ocean_boundary%sw_flux_vis_dif(i,j) + & - ! ice_ocean_boundary%sw_flux_nir_dir(i,j) + ice_ocean_boundary%sw_flux_nir_dif(i,j) - - ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) * GRID%mask2dT(ig,jg) - ! ice_ocean_boundary%runoff(i,j) = (dataPtr_rofl(i1,j1)+dataPtr_rofi(i1,j1)) * GRID%mask2dT(ig,jg) - - ! ice_ocean_boundary%salt_flux(i,j) = GRID%mask2dT(ig,jg)*dataPtr_iosalt(i1,j1) - ! ice_ocean_boundary%salt_flux(i,j) = GRID%mask2dT(ig,jg)*(dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j)) + ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%t_flux(i,j) = -dataPtr_sen(i1,j1) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%lw_flux(i,j) = (dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1)) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndf(i1,j1) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(i1,j1) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%salt_flux(i,j) = dataPtr_iosalt(i1,j1) * GRID%mask2dT(ig,jg) + !ice_ocean_boundary%salt_flux(i,j) = (dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j)) * GRID%mask2dT(ig,jg) + !ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(i1,j1) * GRID%mask2dT(ig,jg) + !ice_ocean_boundary%runoff(i,j) = (dataPtr_rofl(i1,j1)+dataPtr_rofi(i1,j1)) * GRID%mask2dT(ig,jg) + !ice_ocean_boundary%u_flux(i,j) = (GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + & + ! GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1)) + !ice_ocean_boundary%v_flux(i,j) = (GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + & + ! GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1)) endif From 50e4a654a542664c26e7f28150045146f5dd271f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 5 Jun 2018 14:27:29 -0600 Subject: [PATCH 0336/1072] additional changes to have mom cap nuopc working without a lot of diagnostic output --- config_src/nuopc_driver/mom_cap.F90 | 4 + config_src/nuopc_driver/mom_cap_methods.F90 | 123 +++++--------------- 2 files changed, 31 insertions(+), 96 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index c24bb1261b..7c5d8a0d7d 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -453,7 +453,11 @@ module mom_cap_mod integer :: dbrc type(ESMF_Grid) :: mom_grid_i +#ifdef CESMCOUPLED + logical :: write_diagnostics = .false. +#else logical :: write_diagnostics = .true. +#endif logical :: profile_memory = .true. logical :: ocean_solo = .true. logical :: grid_attach_area = .false. diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 4743395938..6061e0c7fd 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -141,34 +141,34 @@ subroutine ocn_export(ocean_public, grid, exportState, rc) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) !tcx - ! write(tmpstr,'(a,6i8)') subname//'tcx1',lbnd1,ubnd1,lbnd2,ubnd2 - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx2',isc,iec,jsc,jec - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx3_1',lbound(ssh,1),ubound(ssh,1) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx3_2',lbound(ssh,2),ubound(ssh,2) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx4_1',lbound(ocean_public%sea_lev,1),ubound(ocean_public%sea_lev,1) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx4_2',lbound(ocean_public%sea_lev,2),ubound(ocean_public%sea_lev,2) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx5_1',lbound(grid%mask2dT,1),ubound(grid%mask2dT,1) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx5_2',lbound(grid%mask2dT,2),ubound(grid%mask2dT,2) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx6',grid%isd,grid%ied,grid%jsd,grid%jed - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx7',grid%isc,grid%iec,grid%jsc,grid%jec - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx8',grid%idg_offset, grid%jdg_offset - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx9_1',lbound(dataPtr_omask,1),ubound(dataPtr_omask,1) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx9_2',lbound(dataPtr_omask,2),ubound(dataPtr_omask,2) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx1',lbnd1,ubnd1,lbnd2,ubnd2 + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx2',isc,iec,jsc,jec + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx3_1',lbound(ssh,1),ubound(ssh,1) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx3_2',lbound(ssh,2),ubound(ssh,2) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx4_1',lbound(ocean_public%sea_lev,1),ubound(ocean_public%sea_lev,1) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx4_2',lbound(ocean_public%sea_lev,2),ubound(ocean_public%sea_lev,2) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx5_1',lbound(grid%mask2dT,1),ubound(grid%mask2dT,1) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx5_2',lbound(grid%mask2dT,2),ubound(grid%mask2dT,2) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx6',grid%isd,grid%ied,grid%jsd,grid%jed + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx7',grid%isc,grid%iec,grid%jsc,grid%jec + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx8',grid%idg_offset, grid%jdg_offset + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx9_1',lbound(dataPtr_omask,1),ubound(dataPtr_omask,1) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,6i8)') subname//'tcx9_2',lbound(dataPtr_omask,2),ubound(dataPtr_omask,2) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) !tcx - + !Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. !The mask comes from "grid" that uses the usual MOM domain that has halos !and does not use global indexing. @@ -191,10 +191,6 @@ subroutine ocn_export(ocean_public, grid, exportState, rc) end do end do - !dataPtr_dhdx(:,:) = 0. - !dataPtr_dhdy(:,:) = 0. - !ssh(:,:) = 0. - ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain ! in order to update halos. i.e. does not use global indexing. do j=grid%jsc, grid%jec @@ -273,71 +269,6 @@ subroutine ocn_export(ocean_public, grid, exportState, rc) end do end do -!!$ ! Update halo of ssh so we can calculate gradients -!!$ call pass_var(ssh, grid%domain) -!!$ -!!$ ! d/dx ssh -!!$ do j=grid%jsc, grid%jec -!!$ j1 = j + lbnd2 - grid%jsc -!!$ do i=grid%isc,grid%iec -!!$ i1 = i + lbnd1 - grid%isc -!!$ ! This is a simple second-order difference -!!$ ! dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(ig,jg) -!!$ ! This is a PLM slope which might be less prone to the A-grid null mode -!!$ slp_L = (ssh(i,j) - ssh(i-1,j)) * grid%mask2dCu(i-1,j) -!!$ if (grid%mask2dCu(i-1,j)==0.) slp_L = 0. -!!$ -!!$ slp_R = (ssh(i+1,j) - ssh(i,j)) * grid%mask2dCu(i,j) -!!$ if (grid%mask2dCu(i+1,j)==0.) slp_R = 0. -!!$ -!!$ slp_C = 0.5 * (slp_L + slp_R) -!!$ if ( (slp_L * slp_R) > 0.0 ) then -!!$ ! This limits the slope so that the edge values are bounded by the -!!$ ! two cell averages spanning the edge. -!!$ u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) -!!$ u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) -!!$ slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) -!!$ else -!!$ ! Extrema in the mean values require a PCM reconstruction avoid generating -!!$ ! larger extreme values. -!!$ slope = 0.0 -!!$ end if -!!$ dataPtr_dhdx(i1,j1) = slope * grid%IdxT(i,j) * grid%mask2dT(ig,jg) -!!$ if (grid%mask2dT(ig,jg)==0.) dataPtr_dhdx(i1,j1) = 0.0 -!!$ end do -!!$ end do -!!$ -!!$ ! d/dy ssh -!!$ do j=grid%jsc, grid%jec -!!$ j1 = j + lbnd2 - grid%jsc -!!$ do i=grid%isc,grid%iec -!!$ i1 = i + lbnd1 - grid%isc -!!$ ! This is a simple second-order difference -!!$ ! dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(ig,jg) -!!$ ! This is a PLM slope which might be less prone to the A-grid null mode -!!$ slp_L = ssh(i,j) - ssh(i,j-1) * grid%mask2dCv(i,j-1) -!!$ if (grid%mask2dCv(i,j-1)==0.) slp_L = 0. -!!$ -!!$ slp_R = ssh(i,j+1) - ssh(i,j) * grid%mask2dCv(i,j) -!!$ if (grid%mask2dCv(i,j+1)==0.) slp_R = 0. -!!$ -!!$ slp_C = 0.5 * (slp_L + slp_R) -!!$ if ((slp_L * slp_R) > 0.0) then -!!$ ! This limits the slope so that the edge values are bounded by the -!!$ ! two cell averages spanning the edge. -!!$ u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) -!!$ u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) -!!$ slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) -!!$ else -!!$ ! Extrema in the mean values require a PCM reconstruction avoid generating -!!$ ! larger extreme values. -!!$ slope = 0.0 -!!$ end if -!!$ dataPtr_dhdy(i1,j1) = slope * grid%IdyT(i,j) * grid%mask2dT(ig,jg) -!!$ if (grid%mask2dT(ig,jg)==0.) dataPtr_dhdy(i1,j1) = 0.0 -!!$ end do -!!$ end do - end subroutine ocn_export !----------------------------------------------------------------------- From e729a18c23a08db40939d58f381655a1fc4bc3f1 Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Mon, 11 Jun 2018 14:00:02 -0400 Subject: [PATCH 0337/1072] doxygenize oda_driver --- src/ocean_data_assim/MOM_oda_driver.F90 | 73 ++++++++++++++----------- 1 file changed, 41 insertions(+), 32 deletions(-) diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index de5a97363b..75eff8347e 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -1,23 +1,7 @@ +!> Interfaces for MOM6 ensembles and data assimilation. module MOM_oda_driver_mod -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! This is the top-level module for MOM6 ocean data assimilation. -! It can be used to gather an ensemble of ocean states -! before calling ensemble filter routines which calculate -! increments based on cross-ensemble co-variance. It can also -! be used to compare gridded model state variables to in-situ -! observations without applying DA incrementa. -! -! init_oda: Initialize the ODA module -! set_analysis_time : update time for performing next analysis -! set_prior: Store prior model state -! oda: call to filter -! get_posterior : returns posterior increments (or full state) for the current ensemble member -! -! Authors: Matthew.Harrison@noaa.gov -! Feiyu.Liu@noaa.gov and -! Tony.Rosati@noaa.gov -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! This file is part of MOM6. see LICENSE.md for the license. use fms_mod, only : open_namelist_file, close_file, check_nml_error use fms_mod, only : error_mesg, FATAL use mpp_mod, only : stdout, stdlog, mpp_error, npes=>mpp_npes,pe=>mpp_pe @@ -74,6 +58,7 @@ module MOM_oda_driver_mod #include + !> Control structure that contains a transpose of the ocean state across ensemble members. type, public :: ODA_CS; private type(ocean_control_struct), pointer :: Ocean_prior=> NULL() !< ensemble ocean prior states in DA space type(ocean_control_struct), pointer :: Ocean_posterior=> NULL() !< ensemble ocean posterior states @@ -110,24 +95,26 @@ module MOM_oda_driver_mod type(diag_ctrl) :: diag_cs ! pointer to a mpp_domain object type :: pointer_mpp_domain type(domain2d), pointer :: mpp_domain => NULL() end type pointer_mpp_domain - + !>@{ + !! DA parameters integer, parameter :: NO_ASSIM = 0, OI_ASSIM=1, EAKF_ASSIM=2 + !>@} contains -!V initialize First_guess (prior) and Analysis grid +!> initialize First_guess (prior) and Analysis grid !! information for all ensemble members -!! subroutine init_oda(Time, G, GV, CS) type(time_type), intent(in) :: Time !< The current model time. type(ocean_grid_type), pointer :: G !< domain and grid information for ocean model type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(ODA_CS), pointer, intent(inout) :: CS + type(ODA_CS), pointer, intent(inout) :: CS !< The DA control structure ! Local variables type(thermo_var_ptrs) :: tv_dummy @@ -325,6 +312,7 @@ subroutine init_oda(Time, G, GV, CS) call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:)) end subroutine init_oda + !> Copy ensemble member tracers to ensemble vector. subroutine set_prior_tracer(Time, G, GV, h, tv, CS) type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), pointer :: G !< domain and grid information for ocean model @@ -393,8 +381,7 @@ subroutine get_posterior_tracer(Time, CS, G, GV, h, tv, increment) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(:,:,:), pointer :: h !< Layer thicknesses, in H (usually m or kg m-2) type(thermo_var_ptrs), pointer :: tv !< A structure pointing to various thermodynamic variables - - logical, optional, intent(in) :: increment + logical, optional, intent(in) :: increment !< True if returning increment only type(ocean_grid_type), pointer :: Grid=>NULL() type(ocean_control_struct), pointer :: Ocean_increment=>NULL() @@ -458,13 +445,14 @@ subroutine get_posterior_tracer(Time, CS, G, GV, h, tv, increment) end subroutine get_posterior_tracer + !> Gather observations and sall ODA routines subroutine oda(Time, CS) - type(time_type), intent(in) :: Time - type(oda_CS), intent(inout) :: CS + type(time_type), intent(in) :: Time !< the current model time + type(oda_CS), intent(inout) :: CS !< the ocean DA control structure integer :: i, j integer :: m - integer :: yr, mon, day, hr, min, sec + integer :: yr, mon, day, hr, min, sec if ( Time >= CS%Time ) then @@ -484,11 +472,13 @@ subroutine oda(Time, CS) return end subroutine oda + !> Finalize DA module subroutine oda_end(CS) - type(ODA_CS), intent(inout) :: CS + type(ODA_CS), intent(inout) :: CS !< the ocean DA control structure end subroutine oda_end + !> Initialize DA module subroutine init_ocean_ensemble(CS,Grid,GV,ens_size) type(ocean_control_struct), pointer :: CS !< Pointer to ODA control structure type(ocean_grid_type), pointer :: Grid !< Pointer to ocean analysis grid @@ -515,9 +505,10 @@ subroutine init_ocean_ensemble(CS,Grid,GV,ens_size) return end subroutine init_ocean_ensemble + !> Set the next analysis time subroutine set_analysis_time(Time,CS) - type(time_type), intent(in) :: Time - type(ODA_CS), pointer, intent(inout) :: CS + type(time_type), intent(in) :: Time !< the current model time + type(ODA_CS), pointer, intent(inout) :: CS !< the DA control structure integer :: yr, mon, day, hr, min, sec @@ -538,9 +529,10 @@ subroutine set_analysis_time(Time,CS) end subroutine set_analysis_time + !> Write observation differences to a file subroutine save_obs_diff(filename,CS) - character(len=*), intent(in) :: filename - type(ODA_CS), pointer, intent(in) :: CS + character(len=*), intent(in) :: filename !< name of output file + type(ODA_CS), pointer, intent(in) :: CS !< pointer to DA control structure integer :: fid ! profile file handle type(ocean_profile_type), pointer :: Prof=>NULL() @@ -563,6 +555,8 @@ subroutine save_obs_diff(filename,CS) return end subroutine save_obs_diff + + !> Apply increments to tracers subroutine apply_oda_tracer_increments(dt,G,tv,h,CS) real, intent(in) :: dt ! the tracer timestep (seconds) type(ocean_grid_type), intent(in) :: G !< ocean grid structure @@ -572,4 +566,19 @@ subroutine apply_oda_tracer_increments(dt,G,tv,h,CS) type(ODA_CS), intent(inout) :: CS !< the data assimilation structure end subroutine apply_oda_tracer_increments + +!> \namespace MOM_oda_driver_mod +!! +!! \section section_ODA The Ocean data assimilation (DA) and Ensemble Framework +!! +!! The DA framework implements ensemble capability in MOM6. Currently, this framework +!! is enabled using the cpp directive ENSEMBLE_OCEAN. The ensembles need to be generated +!! at the level of the calling routine for oda_init or above. The ensemble instances may +!! exist on overlapping or non-overlapping processors. The ensemble information is accessed +!! via the FMS ensemble manager. An independent PE layout is used to gather (prior) ensemble +!! member information where this information is stored in the ODA control structure. This +!! module was developed in collaboration with Feiyu Lu and Tony Rosati in the GFDL prediction +!! group for use in their coupled ensemble framework. These interfaces should be suitable for +!! interfacing MOM6 to other data assimilation packages as well. + end module MOM_oda_driver_mod From 130b056d67a504a44507ed7c24614595240d9e46 Mon Sep 17 00:00:00 2001 From: matthew harrison Date: Mon, 11 Jun 2018 16:49:24 -0400 Subject: [PATCH 0338/1072] doxygenize horizontal regridding --- src/framework/MOM_horizontal_regridding.F90 | 79 ++++++++++----------- 1 file changed, 36 insertions(+), 43 deletions(-) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index d4f8dbff57..43c93aa42d 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -56,9 +56,9 @@ module MOM_horizontal_regridding subroutine myStats(array, missing, is, ie, js, je, k, mesg) - real, dimension(:,:), intent(in) :: array - real, intent(in) :: missing - integer :: is,ie,js,je,k + real, dimension(:,:), intent(in) :: array !< input array (ND) + real, intent(in) :: missing !< missing value (ND) + integer :: is,ie,js,je,k character(len=*) :: mesg ! Local variables real :: minA, maxA @@ -97,41 +97,26 @@ end subroutine myStats !! Then use a previous guess (prev). Optionally (smooth) !! blend the filled points to achieve a more desirable result. subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug,debug) - ! - !# Use ICE-9 algorithm to populate points (fill=1) with - !# valid data (good=1). If no information is available, - !# Then use a previous guess (prev). Optionally (smooth) - !# blend the filled points to achieve a more desirable result. - ! - ! (in) a : input 2-d array with missing values - ! (in) good : valid data mask for incoming array (1==good data; 0==missing data) - ! (in) fill : same shape array of points which need filling (1==please fill;0==leave it alone) - ! (in) prev : first guess where isolated holes exist, - ! use MOM_coms, only : sum_across_PEs type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G)), & - intent(inout) :: aout !< The array with missing values to fill - real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: good !< Valid data mask for incoming array - !! (1==good data; 0==missing data). + real, dimension(SZI_(G),SZJ_(G)), & !< The array with missing values to fill + intent(inout) :: aout !! + real, dimension(SZI_(G),SZJ_(G)), & !< Valid data mask for incoming array + intent(in) :: good !! (1==good data; 0==missing data). real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: fill !< Same shape array of points which need - !! filling (1==please fill;0==leave - !! it alone). - real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(in) :: prev !< First guess where isolated holes exist. + !! filling (1==fill;0==dont fill) + + real, dimension(SZI_(G),SZJ_(G)), & !< First guess where isolated holes exist. + optional, intent(in) :: prev !! logical, optional, intent(in) :: smooth !< If present and true, apply a number of - !! Laplacian smoothing passes to the interpolated data - integer, optional, intent(in) :: num_pass !< The maximum number of smoothing passes - !! to apply. - real, optional, intent(in) :: relc !< A nondimensional relaxation coefficient for - !! the smoothing passes. - real, optional, intent(in) :: crit !< A minimal value for changes in the array - !! at which point the smoothing is stopped. + !! Laplacian iterations to the interpolated data + integer, optional, intent(in) :: num_pass !< The maximum number of iterations + real, optional, intent(in) :: relc !< A relaxation coefficient for Laplacian (ND) + real, optional, intent(in) :: crit !< A minimal value for deltas between iterations. logical, optional, intent(in) :: keep_bug !< Use an algorithm with a bug that dates - !! to the "sienna" code release. + !! to the "sienna" code release. logical, optional, intent(in) :: debug !< If true, write verbose debugging messages. @@ -276,6 +261,7 @@ subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug end subroutine fill_miss_2d +!> Extrapolate and interpolate from a file record subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, recnum, G, tr_z, mask_z, z_in, & z_edges_in, missing_value, reentrant_x, tripolar_n, homogenize ) @@ -594,6 +580,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, end subroutine horiz_interp_and_extrap_tracer_record +!> Extrapolate and interpolate using a FMS time interpolation handle subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, tr_z, mask_z, z_in, & z_edges_in, missing_value, reentrant_x, tripolar_n, homogenize ) @@ -870,13 +857,15 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t enddo ! kd end subroutine horiz_interp_and_extrap_tracer_fms_id + + subroutine meshgrid(x,y,x_T,y_T) !< create a 2d-mesh of grid coordinates !! from 1-d arrays. -real, dimension(:), intent(in) :: x,y -real, dimension(size(x,1),size(y,1)), intent(inout) :: x_T,y_T +real, dimension(:), intent(in) :: x,y !< input 1-dimensional vectors +real, dimension(size(x,1),size(y,1)), intent(inout) :: x_T,y_T !< output 2-dimensional arrays integer :: ni,nj,i,j @@ -893,13 +882,16 @@ subroutine meshgrid(x,y,x_T,y_T) return end subroutine meshgrid + + function fill_boundaries_int(m,cyclic_x,tripolar_n) result(mp) ! ! fill grid edges ! -integer, dimension(:,:), intent(in) :: m -logical, intent(in) :: cyclic_x, tripolar_n -real, dimension(size(m,1),size(m,2)) :: m_real +integer, dimension(:,:), intent(in) :: m !< input array (ND) +logical, intent(in) :: cyclic_x !< True if domain is zonally re-entrant +logical, intent(in) :: tripolar_n !< True if domain has an Arctic fold +real, dimension(size(m,1),size(m,2)) :: m_real real, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp_real integer, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp @@ -947,20 +939,21 @@ function fill_boundaries_real(m,cyclic_x,tripolar_n) result(mp) end function fill_boundaries_real -subroutine smooth_heights(zi,fill,bad,sor,niter,cyclic_x, tripolar_n) !< Solve del2 (zi) = 0 using successive iterations !! with a 5 point stencil. Only points fill==1 are !! modified. Except where bad==1, information propagates !! isotropically in index space. The resulting solution !! in each region is an approximation to del2(zi)=0 subject to !! boundary conditions along the valid points curve bounding this region. +subroutine smooth_heights(zi,fill,bad,sor,niter,cyclic_x, tripolar_n) -real, dimension(:,:), intent(inout) :: zi -integer, dimension(size(zi,1),size(zi,2)), intent(in) :: fill -integer, dimension(size(zi,1),size(zi,2)), intent(in) :: bad -real, intent(in) :: sor -integer, intent(in) :: niter -logical, intent(in) :: cyclic_x, tripolar_n +real, dimension(:,:), intent(inout) :: zi !< input and output array (ND) +integer, dimension(size(zi,1),size(zi,2)), intent(in) :: fill !< same shape as zi, 1=fill +integer, dimension(size(zi,1),size(zi,2)), intent(in) :: bad !< same shape as zi, 1=bad data +real, intent(in) :: sor !< relaxation coefficient (ND) +integer, intent(in) :: niter !< maximum number of iterations +logical, intent(in) :: cyclic_x !< true if domain is zonally reentrant +logical, intent(in) :: tripolar_n !< true if domain has an Arctic fold integer :: i,j,k,n integer :: ni,nj From b60007ca71a11664edc378c76d35f5e7b8e4ab56 Mon Sep 17 00:00:00 2001 From: matthew harrison Date: Mon, 11 Jun 2018 17:00:46 -0400 Subject: [PATCH 0339/1072] remove trailing whitespace --- src/framework/MOM_horizontal_regridding.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 43c93aa42d..bb226c5a1c 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -58,7 +58,7 @@ module MOM_horizontal_regridding subroutine myStats(array, missing, is, ie, js, je, k, mesg) real, dimension(:,:), intent(in) :: array !< input array (ND) real, intent(in) :: missing !< missing value (ND) - integer :: is,ie,js,je,k + integer :: is,ie,js,je,k character(len=*) :: mesg ! Local variables real :: minA, maxA @@ -101,13 +101,13 @@ subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. real, dimension(SZI_(G),SZJ_(G)), & !< The array with missing values to fill - intent(inout) :: aout !! + intent(inout) :: aout !! real, dimension(SZI_(G),SZJ_(G)), & !< Valid data mask for incoming array - intent(in) :: good !! (1==good data; 0==missing data). + intent(in) :: good !! (1==good data; 0==missing data). real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: fill !< Same shape array of points which need !! filling (1==fill;0==dont fill) - + real, dimension(SZI_(G),SZJ_(G)), & !< First guess where isolated holes exist. optional, intent(in) :: prev !! logical, optional, intent(in) :: smooth !< If present and true, apply a number of @@ -891,7 +891,7 @@ function fill_boundaries_int(m,cyclic_x,tripolar_n) result(mp) integer, dimension(:,:), intent(in) :: m !< input array (ND) logical, intent(in) :: cyclic_x !< True if domain is zonally re-entrant logical, intent(in) :: tripolar_n !< True if domain has an Arctic fold -real, dimension(size(m,1),size(m,2)) :: m_real +real, dimension(size(m,1),size(m,2)) :: m_real real, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp_real integer, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp From 75d59732b510509cf64076111c08c73302d584a0 Mon Sep 17 00:00:00 2001 From: Brandon Reichl Date: Mon, 11 Jun 2018 17:31:15 -0400 Subject: [PATCH 0340/1072] Fixing doxygen in MOM_wave_interface. - Fixed many doxygen related issues in MOM_wave_interface - Fixed formatting and commenting to standardize w/ the rest of MOM6. - Fixed 1 bug in wavenumber computation (missing factor of gravity) for x-direction Stokes dri ft in data_override method. Bug-fix should not impact any present model test cases/implementatio ns, but it has been fixed/noted in code. --- src/user/MOM_wave_interface.F90 | 903 +++++++++++++++++--------------- 1 file changed, 473 insertions(+), 430 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index c464a2b1f6..337036838c 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -1,35 +1,31 @@ module MOM_wave_interface ! This file is part of MOM6. See LICENSE.md for the license. - -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Brandon Reichl, 2018. * -!* * -!* This module should be moved as wave coupling progresses and * -!* likely will should mirror the iceberg or sea-ice model set-up. * -!* * -!* This module is meant to contain the routines to read in and * -!* interpret surface wave data for MOM6. In its original form, the * -!* capabilities include setting the Stokes drift in the model (from a * -!* variety of sources including prescribed, empirical, and input * -!* files). In short order, the plan is to also ammend the subroutine * -!* to accept Stokes drift information from an external coupler. * -!* Eventually, it will be necessary to break this file apart so that * -!* general wave information may be stored in the control structure * -!* and the Stokes drift effect can be isolated from processes such as * -!* sea-state dependent momentum fluxes, gas fluxes, and other wave * -!* related air-sea interaction and boundary layer phenomenon. * -!* * -!* The Stokes drift are stored on the C-grid with the conventional * -!* protocol to interpolate to the h-grid to compute Langmuir number, * -!* the primary quantity needed for Langmuir turbulence * -!* parameterizations in both the ePBL and KPP approach. This module * -!* also computes full 3d Stokes drift profiles, which will be useful * -!* if second-order type boundary layer parameterizations are * -!* implemented (perhaps via GOTM, work in progress). * -!* * -!********+*********+*********+*********+*********+*********+*********+** +! +! By Brandon Reichl, 2018. +! +! This module should be moved as wave coupling progresses and +! likely will should mirror the iceberg or sea-ice model set-up. +! +! This module is meant to contain the routines to read in and +! interpret surface wave data for MOM6. In its original form, the +! capabilities include setting the Stokes drift in the model (from a +! variety of sources including prescribed, empirical, and input +! files). In short order, the plan is to also ammend the subroutine +! to accept Stokes drift information from an external coupler. +! Eventually, it will be necessary to break this file apart so that +! general wave information may be stored in the control structure +! and the Stokes drift effect can be isolated from processes such as +! sea-state dependent momentum fluxes, gas fluxes, and other wave +! related air-sea interaction and boundary layer phenomenon. +! +! The Stokes drift are stored on the C-grid with the conventional +! protocol to interpolate to the h-grid to compute Langmuir number, +! the primary quantity needed for Langmuir turbulence +! parameterizations in both the ePBL and KPP approach. This module +! also computes full 3d Stokes drift profiles, which will be useful +! if second-order type boundary layer parameterizations are +! implemented (perhaps via GOTM, work in progress). use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_alloc use MOM_diag_mediator, only : diag_ctrl @@ -44,7 +40,10 @@ module MOM_wave_interface time_type_to_real,real_to_time_type use MOM_variables, only : thermo_var_ptrs, surface use data_override_mod, only : data_override_init, data_override -implicit none ; private + +implicit none + +private #include @@ -69,62 +68,68 @@ module MOM_wave_interface !> Container for all surface wave related parameters type, public:: wave_parameters_CS ; private - !> Main surface wave options - logical, public :: UseWaves ! Flag to enable surface gravity wave feature - logical, public :: LagrangianMixing ! NOT READY - ! True if Stokes drift is present and mixing - ! should be applied to Lagrangian current - ! (mean current + Stokes drift). - ! See Reichl et al., 2016 KPP-LT approach - logical, public :: StokesMixing ! NOT READY - ! True if vertical mixing of momentum - ! should be applied directly to Stokes current - ! (with separate mixing parameter for Eulerian - ! mixing contribution). - ! See Harcourt 2013, 2015 Second-Moment approach - logical, public :: CoriolisStokes ! NOT READY + !Main surface wave options + logical, public :: UseWaves !< Flag to enable surface gravity wave feature + logical, public :: LagrangianMixing !< This feature is in development and not ready + !! True if Stokes drift is present and mixing + !! should be applied to Lagrangian current + !! (mean current + Stokes drift). + !! See Reichl et al., 2016 KPP-LT approach + logical, public :: StokesMixing !< This feature is in development and not ready. + !! True if vertical mixing of momentum + !! should be applied directly to Stokes current + !! (with separate mixing parameter for Eulerian + !! mixing contribution). + !! See Harcourt 2013, 2015 Second-Moment approach + logical, public :: CoriolisStokes !< This feature is in development and not ready. ! True if Coriolis-Stokes acceleration should be applied. - integer, public :: StkLevelMode=1 ! = 0 if mid-point value of Stokes drift is used - ! = 1 if average value of Stokes drift over level. - ! If advecting with Stokes transport, 1 is the correct - ! approach. + integer, public :: StkLevelMode=1 !< Sets if Stokes drift is defined at mid-points + !! or layer averaged. Set to 0 if mid-point and set to + !! 1 if average value of Stokes drift over level. + !! If advecting with Stokes transport, 1 is the correct + !! approach. - !> Surface Wave Dependent 1d/2d/3d vars + ! Surface Wave Dependent 1d/2d/3d vars + real, allocatable, dimension(:), public :: & + WaveNum_Cen !< Wavenumber bands for read/coupled + real, allocatable, dimension(:), public :: & + Freq_Cen !< Frequency bands for read/coupled + real, allocatable, dimension(:), public :: & + PrescribedSurfStkX !< Surface Stokes drift if prescribed real, allocatable, dimension(:), public :: & - WaveNum_Cen,& ! Wavenumber bands for read/coupled - Freq_Cen, & ! Frequency bands for read/coupled - PrescribedSurfStkX,& ! Surface Stokes drift if prescribed - PrescribedSurfStkY ! Surface Stokes drift if prescribed + PrescribedSurfStkY !< Surface Stokes drift if prescribed real, allocatable, dimension(:,:,:), public :: & - Us_x ! 3d Stokes drift profile (zonal) - ! Horizontal -> U points - ! Vertical -> Mid-points + Us_x !< 3d Stokes drift profile (zonal) + !! Horizontal -> U points + !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & - Us_y ! 3d Stokes drift profile (meridional) - ! Horizontal -> V points - ! Vertical -> Mid-points - real, allocatable, dimension(:,:), public :: & - LangNum, & ! Langmuir number (directionality factored later) - ! Horizontal -> H points - US0_x, & ! Surface Stokes Drift (zonal) - ! Horizontal -> U points - US0_y ! Surface Stokes Drift (meridional) - ! Horizontal -> V points + Us_y !< 3d Stokes drift profile (meridional) + !! Horizontal -> V points + !! Vertical -> Mid-points + real, allocatable, dimension(:,:), public :: & + LangNum !< Langmuir number (directionality factored later) + !! Horizontal -> H points + real, allocatable, dimension(:,:), public :: & + US0_x !< Surface Stokes Drift (zonal) + !! Horizontal -> U points + real, allocatable, dimension(:,:), public :: & + US0_y !< Surface Stokes Drift (meridional) + !! Horizontal -> V points real, allocatable, dimension(:,:,:), public :: & - STKx0 ! Stokes Drift spectrum (zonal) - ! Horizontal -> U points - ! 3rd dimension -> Freq/Wavenumber + STKx0 !< Stokes Drift spectrum (zonal) + !! Horizontal -> U points + !! 3rd dimension -> Freq/Wavenumber real, allocatable, dimension(:,:,:), public :: & - STKy0 ! Stokes Drift spectrum (meridional) - ! Horizontal -> V points - ! 3rd dimension -> Freq/Wavenumber + STKy0 !< Stokes Drift spectrum (meridional) + !! Horizontal -> V points + !! 3rd dimension -> Freq/Wavenumber real, allocatable, dimension(:,:,:), public :: & - KvS !< Viscosity for Stokes Drift shear + KvS !< Viscosity for Stokes Drift shear ! Pointers to auxiliary fields - type(time_type), pointer, public :: Time ! A pointer to the ocean model's clock. - type(diag_ctrl), pointer, public :: diag ! A structure that is used to regulate the - ! timing of diagnostic output. + type(time_type), pointer, public :: Time !< A pointer to the ocean model's clock. + type(diag_ctrl), pointer, public :: diag !< A structure that is used to regulate the + !! timing of diagnostic output. ! Diagnostic handles integer, public :: id_surfacestokes_x, id_surfacestokes_y @@ -134,49 +139,47 @@ module MOM_wave_interface !Options not needed outside of this module -!> Main Option -integer :: WaveMethod=-99 - ! Options for including wave information - ! Valid (tested) choices are: - ! 0 - Test Profile - ! 1 - Surface Stokes Drift Bands - ! 2 - DHH85 - ! 3 - LF17 - ! -99 - No waves computed, but empirical Langmuir number used. - -!> Options if WaveMethod is Surface Stokes Drift Bands (1) +integer :: WaveMethod=-99 !< Options for including wave information + !! Valid (tested) choices are: + !! 0 - Test Profile + !! 1 - Surface Stokes Drift Bands + !! 2 - DHH85 + !! 3 - LF17 + !! -99 - No waves computed, but empirical Langmuir number used. + +! Options if WaveMethod is Surface Stokes Drift Bands (1) integer, public :: NumBands =0 !< Number of wavenumber/frequency partitions to receive !! This needs to match the number of bands provided !! via either coupling or file. integer, public :: PartitionMode !< Method for partition mode (meant to check input) !! 0 - wavenumbers !! 1 - frequencies -integer :: DataSource ! Integer that specifies where the Model Looks for Data - ! Valid choices are: - ! 1 - FMS DataOverride Routine - ! 2 - Reserved For Coupler - ! 3 - User input (fixed values, useful for 1d testing) -!>> Options if using FMS DataOverride Routine -character(len=40) :: SurfBandFileName ! Filename if using DataOverride -logical :: dataoverrideisinitialized ! Flag for DataOverride Initialization - -!> Options for computing Langmuir number +integer :: DataSource !< Integer that specifies where the Model Looks for Data + !! Valid choices are: + !! 1 - FMS DataOverride Routine + !! 2 - Reserved For Coupler + !! 3 - User input (fixed values, useful for 1d testing) +! Options if using FMS DataOverride Routine +character(len=40) :: SurfBandFileName !< Filename if using DataOverride +logical :: dataoverrideisinitialized !< Flag for DataOverride Initialization + +! Options for computing Langmuir number real :: LA_FracHBL !< Fraction of OSBL for averaging Langmuir number logical :: LA_Misalignment = .false. !< Flag to use misalignment in Langmuir number ! This include declares and sets the variable "version". #include "version_variable.h" -character(len=40) :: mdl = "MOM_wave_interface" ! This module's name. +character(len=40) :: mdl = "MOM_wave_interface" !< This module's name. ! Switches needed in import_stokes_drift integer, parameter :: TESTPROF = 0, SURFBANDS = 1, & DHH85 = 2, LF17 = 3, NULL_WaveMethod=-99, & DATAOVR = 1, COUPLER = 2, INPUT = 3 -! For Test Prof +! Options For Test Prof Real :: TP_STKX0, TP_STKY0, TP_WVL -logical :: WaveAgePeakFreq !> Flag to use W +logical :: WaveAgePeakFreq ! Flag to use W real :: WaveAge, WaveWind real :: PI @@ -184,8 +187,6 @@ module MOM_wave_interface !> Initializes parameters related to MOM_wave_interface subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) - - !Arguments type(time_type), target, intent(in) :: Time !< Time type(ocean_grid_type), intent(inout) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -194,7 +195,6 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) type(diag_ctrl), target, intent(inout) :: diag !< Diagnostic Pointer ! Local variables - ! I/O character*(13) :: TMPSTRING1,TMPSTRING2 character*(5), parameter :: NULL_STRING = "EMPTY" @@ -206,7 +206,7 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) character*(7), parameter :: COUPLER_STRING = "COUPLER" character*(5), parameter :: INPUT_STRING = "INPUT" - !/ Dummy Check + ! Dummy Check if (associated(CS)) then call MOM_error(FATAL, "wave_interface_init called with an associated"//& "control structure.") @@ -215,7 +215,7 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) PI=4.0*atan(1.0) - !/ Allocate CS and set pointers + ! Allocate CS and set pointers allocate(CS) CS%diag => diag @@ -235,25 +235,25 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) "Flag to use Lagrangian Mixing of momentum", units="", & Default=.false.) if (CS%LagrangianMixing) then - !Force Code Intervention + ! Force Code Intervention call MOM_error(FATAL,"Should you be enabling Lagrangian Mixing? Code not ready.") endif call get_param(param_file, mdl, "STOKES_MIXING", CS%StokesMixing, & "Flag to use Stokes Mixing of momentum", units="", & Default=.false.) if (CS%StokesMixing) then - !Force Code Intervention + ! Force Code Intervention call MOM_error(FATAL,"Should you be enabling Stokes Mixing? Code not ready.") endif call get_param(param_file, mdl, "CORIOLIS_STOKES", CS%CoriolisStokes, & "Flag to use Coriolis Stokes acceleration", units="", & Default=.false.) if (CS%CoriolisStokes) then - !Force Code Intervention + ! Force Code Intervention call MOM_error(FATAL,"Should you be enabling Coriolis-Stokes? Code not ready.") endif - ! 1. Get Wave Method and write to integer WaveMethod + ! Get Wave Method and write to integer WaveMethod call get_param(param_file,mdl,"WAVE_METHOD",TMPSTRING1, & "Choice of wave method, valid options include: \n"// & " TEST_PROFILE - Prescribed from surface Stokes drift \n"// & @@ -279,7 +279,7 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) units='m/s',default=0.0) call get_param(param_file,mdl,"TP_WVL",TP_WVL,& units='m',default=50.0) - case (SURFBANDS_STRING)!Surface Stokes Drift Bands + case (SURFBANDS_STRING)! Surface Stokes Drift Bands WaveMethod = SURFBANDS call get_param(param_file, mdl, "SURFBAND_SOURCE",TMPSTRING2, & "Choice of SURFACE_BANDS data mode, valid options include: \n"// & @@ -288,27 +288,32 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) " INPUT - Testing with fixed values.", & units='', default=NULL_STRING) select case (TRIM(TMPSTRING2)) - case (NULL_STRING)! + case (NULL_STRING)! Default call MOM_error(FATAL, "wave_interface_init called with SURFACE_BANDS"//& " but no SURFBAND_SOURCE.") - case (DATAOVR_STRING)!Using Data Override + case (DATAOVR_STRING)! Using Data Override DataSource = DATAOVR call get_param(param_file, mdl, "SURFBAND_FILENAME", SurfBandFileName, & "Filename of surface Stokes drift input band data.", default="StkSpec.nc") - case (COUPLER_STRING)!Reserved for coupling + case (COUPLER_STRING)! Reserved for coupling DataSource = Coupler - case (INPUT_STRING) + case (INPUT_STRING)! A method to input the Stokes band (globally uniform) DataSource = Input call get_param(param_file,mdl,"SURFBAND_NB",NumBands, & "Prescribe number of wavenumber bands for Stokes drift. \n"// & " Make sure this is consistnet w/ WAVENUMBERS, STOKES_X, and \n"// & " STOKES_Y, there are no safety checks in the code.", & units='', default=1) - allocate( CS%WaveNum_Cen(1:NumBands) ) ; CS%WaveNum_Cen(:)=0.0 - allocate( CS%PrescribedSurfStkX(1:NumBands)) ; CS%PrescribedSurfStkX(:) = 0.0 - allocate( CS%PrescribedSurfStkY(1:NumBands)) ; CS%PrescribedSurfStkY(:) = 0.0 - allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,1:NumBands)) ; CS%STKx0(:,:,:) = 0.0 - allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,1:NumBands)) ; CS%STKy0(:,:,:) = 0.0 + allocate( CS%WaveNum_Cen(1:NumBands) ) + CS%WaveNum_Cen(:)=0.0 + allocate( CS%PrescribedSurfStkX(1:NumBands)) + CS%PrescribedSurfStkX(:) = 0.0 + allocate( CS%PrescribedSurfStkY(1:NumBands)) + CS%PrescribedSurfStkY(:) = 0.0 + allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,1:NumBands)) + CS%STKx0(:,:,:) = 0.0 + allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,1:NumBands)) + CS%STKy0(:,:,:) = 0.0 partitionmode=0 call get_param(param_file,mdl,"SURFBAND_WAVENUMBERS",CS%WaveNum_Cen, & "Central wavenumbers for surface Stokes drift bands.",units='rad/m', & @@ -319,12 +324,14 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) call get_param(param_file,mdl,"SURFBAND_STOKES_Y",CS%PrescribedSurfStkY, & "Y-direction surface Stokes drift for bands.",units='m/s', & default=0.0) - case default + case default! No method provided call MOM_error(FATAL,'Check WAVE_METHOD.') end select case (DHH85_STRING)!Donelan et al., 1985 spectrum WaveMethod = DHH85 + call MOM_error(WARNING,"DHH85 only ever set-up for uniform cases w/"//& + " Stokes drift in x-direction.") call get_param(param_file,mdl,"DHH85_AGE_FP",WaveAgePeakFreq, & "Choose true to use waveage in peak frequency.", & units='', default=.false.) @@ -349,25 +356,27 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) "Flag (logical) if using misalignment bt shear and waves in LA",& default=.false.) - ! 2. Allocate and initialize - ! Stokes drift - ! Profiles - allocate(CS%Us_x(G%isdB:G%IedB,G%jsd:G%jed,G%ke)) ; CS%Us_x(:,:,:) = 0.0 - allocate(CS%Us_y(G%isd:G%Ied,G%jsdB:G%jedB,G%ke)) ; CS%Us_y(:,:,:) = 0.0 - ! Surface Values - allocate(CS%US0_x(G%isdB:G%iedB,G%jsd:G%jed)) ; CS%US0_x(:,:) = 0.0 - allocate(CS%US0_y(G%isd:G%ied,G%jsdB:G%jedB)) ; CS%US0_y(:,:) = 0.0 - ! Langmuir number - allocate(CS%LangNum(G%isc:G%iec,G%jsc:G%jec)) ; CS%LangNum(:,:) = 0.0 - + ! Allocate and initialize + ! a. Stokes driftProfiles + allocate(CS%Us_x(G%isdB:G%IedB,G%jsd:G%jed,G%ke)) + CS%Us_x(:,:,:) = 0.0 + allocate(CS%Us_y(G%isd:G%Ied,G%jsdB:G%jedB,G%ke)) + CS%Us_y(:,:,:) = 0.0 + ! b. Surface Values + allocate(CS%US0_x(G%isdB:G%iedB,G%jsd:G%jed)) + CS%US0_x(:,:) = 0.0 + allocate(CS%US0_y(G%isd:G%ied,G%jsdB:G%jedB)) + CS%US0_y(:,:) = 0.0 + ! c. Langmuir number + allocate(CS%LangNum(G%isc:G%iec,G%jsc:G%jec)) + CS%LangNum(:,:) = 0.0 + ! d. Viscosity for Stokes drift if (CS%StokesMixing) then - ! Viscosity for Stokes drift - allocate(CS%KvS(G%isd:G%Ied,G%jsd:G%jed,G%ke)) ; CS%KvS(:,:,:) = 0.0 + allocate(CS%KvS(G%isd:G%Ied,G%jsd:G%jed,G%ke)) + CS%KvS(:,:,:) = 0.0 endif - ! - ! 3. Initialize Wave related outputs - ! + ! Initialize Wave related outputs CS%id_surfacestokes_y = register_diag_field('ocean_model','surface_stokes_y', & CS%diag%axesCu1,Time,'Surface Stokes drift (y)','m s-1') CS%id_surfacestokes_x = register_diag_field('ocean_model','surface_stokes_x', & @@ -378,18 +387,12 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) CS%diag%axesCuL,Time,'3d Stokes drift (y)','m s-1') return - end subroutine MOM_wave_interface_init - +!> A 'lite' init subroutine to initialize a few inputs needed if using wave information +!! with the wind-speed dependent Stokes drift formulation of LF17 subroutine MOM_wave_interface_init_lite(param_file) - !It is possible to estimate Stokes drift without the Wave data (if WaveMethod=LF17). - ! In this case there are still a couple inputs we need to read in, which is done - ! here in a reduced wave_interface_init that doesn't allocate the CS. - - !Arguments - type(param_file_type), intent(in) :: param_file !< Input parameter structure - + type(param_file_type), intent(in) :: param_file !< Input parameter structure ! Langmuir number Options call get_param(param_file, mdl, "LA_DEPTH_RATIO", LA_FracHBL, & @@ -406,19 +409,18 @@ subroutine MOM_wave_interface_init_lite(param_file) return end subroutine MOM_wave_interface_init_lite -! Place to add update of surface wave parameters. +!> Subroutine that handles updating of surface wave/Stokes drift related properties subroutine Update_Surface_Waves(G,GV,Day,DT,CS) -!Arguments - type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure - type(ocean_grid_type), intent(inout) :: G !< Grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - type(time_type), intent(in) :: Day ! This subroutine applies diapycnal diffusion and any other column -! tracer physics or chemistry to the tracers from this file. -! This is a simple example of a set of advected passive tracers. +!> This subroutine applies diapycnal diffusion, including the surface boundary +!! conditions and any other column tracer physics or chemistry to the tracers from this file. subroutine ISOMIP_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & - evap_CFL_limit, minimum_forcing_depth) + evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -288,25 +282,10 @@ subroutine ISOMIP_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, G real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which !! fluxes can be applied, in m -! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2. -! (in) h_new - Layer thickness after entrainment, in m or kg m-2. -! (in) ea - an array to which the amount of fluid entrained -! from the layer above during this call will be -! added, in m or kg m-2. -! (in) eb - an array to which the amount of fluid entrained -! from the layer below during this call will be -! added, in m or kg m-2. -! (in) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) dt - The amount of time covered by this call, in s. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! ISOMIP_register_tracer. -! ! The arguments to this subroutine are redundant in that ! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] + ! Local variables real :: mmax real :: b1(SZI_(G)) ! b1 and c1 are variables used by the real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. @@ -387,6 +366,7 @@ subroutine ISOMIP_tracer_surface_state(state, h, G, CS) end subroutine ISOMIP_tracer_surface_state +!> Deallocate any memory used by the ISOMIP tracer package subroutine ISOMIP_tracer_end(CS) type(ISOMIP_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to ISOMIP_register_tracer. From be3da2383259af05bd349eb3294845eb1cc0868e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 09:41:47 -0400 Subject: [PATCH 0503/1072] dOyxgenization of types in MOM_OCMIP2_CFC.F90 dOxyGenized comments describing types, the elements of types, and routines in MOM_OCMIP2_CFC.F90. Also removed duplicate older-style argument documentation comments. All answers are bitwise identical. --- src/tracer/MOM_OCMIP2_CFC.F90 | 123 +++++++++++----------------------- 1 file changed, 40 insertions(+), 83 deletions(-) diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index e90a1b8eeb..e7577f17e2 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -81,16 +81,18 @@ module MOM_OCMIP2_CFC ! NTR is the number of tracers in this module. integer, parameter :: NTR = 2 +!> The control structure for the OCMPI2_CFC tracer package type, public :: OCMIP2_CFC_CS ; private - character(len=200) :: IC_file ! The file in which the CFC initial values can - ! be found, or an empty string for internal initilaization. - logical :: Z_IC_file ! If true, the IC_file is in Z-space. The default is false.. - type(time_type), pointer :: Time => NULL() ! A pointer to the ocean model's clock. - type(tracer_registry_type), pointer :: tr_Reg => NULL() + character(len=200) :: IC_file !< The file in which the CFC initial values can + !! be found, or an empty string for internal initilaization. + logical :: Z_IC_file !< If true, the IC_file is in Z-space. The default is false.. + type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. + type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the MOM6 tracer registry real, pointer, dimension(:,:,:) :: & - CFC11 => NULL(), & ! The CFC11 concentration in mol m-3. - CFC12 => NULL() ! The CFC12 concentration in mol m-3. + CFC11 => NULL(), & !< The CFC11 concentration in mol m-3. + CFC12 => NULL() !< The CFC12 concentration in mol m-3. ! In the following variables a suffix of _11 refers to CFC11 and _12 to CFC12. + !>@{ Coefficients used in the CFC11 and CFC12 solubility calculation real :: a1_11, a2_11, a3_11, a4_11 ! Coefficients in the calculation of the real :: a1_12, a2_12, a3_12, a4_12 ! CFC11 and CFC12 Schmidt numbers, in ! units of ND, degC-1, degC-2, degC-3. @@ -100,29 +102,34 @@ module MOM_OCMIP2_CFC real :: e1_11, e2_11, e3_11 ! More coefficients in the calculation of real :: e1_12, e2_12, e3_12 ! the CFC11 and CFC12 solubilities, in ! units of PSU-1, PSU-1 K-1, PSU-1 K-2. - real :: CFC11_IC_val = 0.0 ! The initial value assigned to CFC11. - real :: CFC12_IC_val = 0.0 ! The initial value assigned to CFC12. - real :: CFC11_land_val = -1.0 ! The values of CFC11 and CFC12 used where - real :: CFC12_land_val = -1.0 ! land is masked out. - logical :: tracers_may_reinit ! If true, tracers may go through the - ! initialization code if they are not found in the - ! restart files. - character(len=16) :: CFC11_name, CFC12_name ! Variable names. - - integer :: ind_cfc_11_flux ! Indices returned by aof_set_coupler_flux that - integer :: ind_cfc_12_flux ! are used to pack and unpack surface boundary - ! condition arrays. + !!@} + real :: CFC11_IC_val = 0.0 !< The initial value assigned to CFC11. + real :: CFC12_IC_val = 0.0 !< The initial value assigned to CFC12. + real :: CFC11_land_val = -1.0 !< The value of CFC11 used where land is masked out. + real :: CFC12_land_val = -1.0 !< The value of CFC12 used where land is masked out. + logical :: tracers_may_reinit !< If true, tracers may be reset via the initialization code + !! if they are not found in the restart files. + character(len=16) :: CFC11_name !< CFC11 variable name + character(len=16) :: CFC12_name !< CFC12 variable name + + integer :: ind_cfc_11_flux !< Index returned by aof_set_coupler_flux that is used to + !! pack and unpack surface boundary condition arrays. + integer :: ind_cfc_12_flux !< Index returned by aof_set_coupler_flux that is used to + !! pack and unpack surface boundary condition arrays. type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to ! regulate the timing of diagnostic output. type(MOM_restart_CS), pointer :: restart_CSp => NULL() ! The following vardesc types contain a package of metadata about each tracer. - type(vardesc) :: CFC11_desc, CFC12_desc + type(vardesc) :: CFC11_desc !< A set of metadata for the CFC11 tracer + type(vardesc) :: CFC12_desc !< A set of metadata for the CFC12 tracer end type OCMIP2_CFC_CS contains +!> Register the OCMIP2 CFC tracers to be used with MOM and read the parameters +!! that are used with this tracer package function register_OCMIP2_CFC(HI, GV, param_file, CS, tr_Reg, restart_CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -134,18 +141,12 @@ function register_OCMIP2_CFC(HI, GV, param_file, CS, tr_Reg, restart_CS) type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. ! This subroutine is used to register tracer fields and subroutines ! to be used with MOM. -! Arguments: HI - A horizontal index type structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module -! (in/out) tr_Reg - A pointer to the tracer registry. -! (in) restart_CS - A pointer to the restart control structure. - -! This include declares and sets the variable "version". -#include "version_variable.h" + + ! Local variables character(len=40) :: mdl = "MOM_OCMIP2_CFC" ! This module's name. character(len=200) :: inputdir ! The directory where NetCDF input files are. + ! This include declares and sets the variable "version". +#include "version_variable.h" real, dimension(:,:,:), pointer :: tr_ptr => NULL() real :: a11_dflt(4), a12_dflt(4) ! Default values of the various coefficients real :: d11_dflt(4), d12_dflt(4) ! In the expressions for the solubility and @@ -351,8 +352,7 @@ subroutine flux_init_OCMIP2_CFC(CS, verbosity) end subroutine flux_init_OCMIP2_CFC -!> This subroutine initializes the NTR tracer fields in tr(:,:,:,:) -!! and it sets up the tracer output. +!> Initialize the OCMP2 CFC tracer fields and set up the tracer output. subroutine initialize_OCMIP2_CFC(restart, day, G, GV, h, diag, OBC, CS, & sponge_CSp, diag_to_Z_CSp) logical, intent(in) :: restart !< .true. if the fields have already been @@ -378,21 +378,6 @@ subroutine initialize_OCMIP2_CFC(restart, day, G, GV, h, diag, OBC, CS, & ! This subroutine initializes the NTR tracer fields in tr(:,:,:,:) ! and it sets up the tracer output. -! Arguments: restart - .true. if the fields have already been read from -! a restart file. -! (in) day - Time of the start of the run. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) h - Layer thickness, in m or kg m-2. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in) OBC - This open boundary condition type specifies whether, where, -! and what open boundary conditions are used. -! (in/out) CS - The control structure returned by a previous call to -! register_OCMIP2_CFC. -! (in/out) sponge_CSp - A pointer to the control structure for the sponges, if -! they are in use. Otherwise this may be unassociated. -! (in/out) diag_to_Z_Csp - A pointer to the control structure for diagnostics -! in depth space. logical :: from_file = .false. if (.not.associated(CS)) return @@ -460,10 +445,9 @@ subroutine init_tracer_CFC(h, tr, name, land_val, IC_val, G, CS) end subroutine init_tracer_CFC -!> This subroutine applies diapycnal diffusion and any other column -! tracer physics or chemistry to the tracers from this file. -! CFCs are relatively simple, as they are passive tracers. with only a surface -! flux as a source. +!> This subroutine applies diapycnal diffusion, souces and sinks and any other column +!! tracer physics or chemistry to the OCMIP2 CFC tracers. +!! CFCs are relatively simple, as they are passive tracers with only a surface flux as a source. subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -494,25 +478,10 @@ subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS ! CFCs are relatively simple, as they are passive tracers. with only a surface ! flux as a source. -! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2. -! (in) h_new - Layer thickness after entrainment, in m or kg m-2. -! (in) ea - an array to which the amount of fluid entrained -! from the layer above during this call will be -! added, in m or kg m-2. -! (in) eb - an array to which the amount of fluid entrained -! from the layer below during this call will be -! added, in m or kg m-2. -! (in) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) dt - The amount of time covered by this call, in s. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! register_OCMIP2_CFC. -! ! The arguments to this subroutine are redundant in that ! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] + ! Local variables real :: b1(SZI_(G)) ! b1 and c1 are variables used by the real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. real, dimension(SZI_(G),SZJ_(G)) :: & @@ -580,23 +549,9 @@ function OCMIP2_CFC_stock(h, stocks, G, GV, CS, names, units, stock_index) character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated. integer, optional, intent(in) :: stock_index !< The coded index of a specific !! stock being sought. - integer :: OCMIP2_CFC_stock -! This function calculates the mass-weighted integral of all tracer stocks, -! returning the number of stocks it has calculated. If the stock_index -! is present, only the stock corresponding to that coded index is returned. - -! Arguments: h - Layer thickness, in m or kg m-2. -! (out) stocks - the mass-weighted integrated amount of each tracer, -! in kg times concentration units. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! register_OCMIP2_CFC. -! (out) names - the names of the stocks calculated. -! (out) units - the units of the stocks calculated. -! (in,opt) stock_index - the coded index of a specific stock being sought. -! Return value: the number of stocks calculated here. + integer :: OCMIP2_CFC_stock !< The number of stocks calculated here. + ! Local variables real :: mass integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -639,6 +594,7 @@ subroutine OCMIP2_CFC_surface_state(state, h, G, CS) type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a previous !! call to register_OCMIP2_CFC. + ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & CFC11_Csurf, & ! The CFC-11 and CFC-12 surface concentrations times the CFC12_Csurf, & ! Schmidt number term, both in mol m-3. @@ -700,6 +656,7 @@ subroutine OCMIP2_CFC_surface_state(state, h, G, CS) end subroutine OCMIP2_CFC_surface_state +!> Deallocate any memory associated with the OCMIP2 CFC tracer package subroutine OCMIP2_CFC_end(CS) type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a !! previous call to register_OCMIP2_CFC. From aeedc1cc67e7bdde3c672931148cf2d6f9e33724 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 09:42:05 -0400 Subject: [PATCH 0504/1072] dOyxgenization of types in MOM_neutral_diffusion.F90 dOxyGenized comments describing types and the elements of types in MOM_neutral_diffusion.F90. All answers are bitwise identical. --- src/tracer/MOM_neutral_diffusion.F90 | 91 ++++++++++++++-------------- 1 file changed, 45 insertions(+), 46 deletions(-) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 07e8bbd50f..4002fe646b 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -31,61 +31,60 @@ module MOM_neutral_diffusion #include -public neutral_diffusion -public neutral_diffusion_init -public neutral_diffusion_end +public neutral_diffusion, neutral_diffusion_init, neutral_diffusion_end public neutral_diffusion_calc_coeffs public neutral_diffusion_unit_tests +!> The control structure for the MOM_neutral_diffusion module type, public :: neutral_diffusion_CS ; private - integer :: nkp1 ! Number of interfaces for a column = nk + 1 - integer :: nsurf ! Number of neutral surfaces - integer :: deg = 2 ! Degree of polynomial used for reconstructions - logical :: continuous_reconstruction = .true. ! True if using continuous PPM reconstruction at interfaces - logical :: refine_position = .false. - logical :: debug = .false. - integer :: max_iter ! Maximum number of iterations if refine_position is defined - real :: tolerance ! Convergence criterion representing difference from true neutrality - real :: ref_pres ! Reference pressure, negative if using locally referenced neutral density + integer :: nkp1 !< Number of interfaces for a column = nk + 1 + integer :: nsurf !< Number of neutral surfaces + integer :: deg = 2 !< Degree of polynomial used for reconstructions + logical :: continuous_reconstruction = .true. !< True if using continuous PPM reconstruction at interfaces + logical :: refine_position = .false. !< If true, iterate to refine the corresponding positions + !! in neighboring columns + logical :: debug = .false. !< If true, write verbose debugging messages + integer :: max_iter !< Maximum number of iterations if refine_position is defined + real :: tolerance !< Convergence criterion representing difference from true neutrality + real :: ref_pres !< Reference pressure, negative if using locally referenced neutral density ! Positions of neutral surfaces in both the u, v directions - real, allocatable, dimension(:,:,:) :: uPoL ! Non-dimensional position with left layer uKoL-1, u-point - real, allocatable, dimension(:,:,:) :: uPoR ! Non-dimensional position with right layer uKoR-1, u-point - integer, allocatable, dimension(:,:,:) :: uKoL ! Index of left interface corresponding to neutral surface, - ! at a u-point - integer, allocatable, dimension(:,:,:) :: uKoR ! Index of right interface corresponding to neutral surface, - ! at a u-point - real, allocatable, dimension(:,:,:) :: uHeff ! Effective thickness at u-point (H units) - real, allocatable, dimension(:,:,:) :: vPoL ! Non-dimensional position with left layer uKoL-1, v-point - real, allocatable, dimension(:,:,:) :: vPoR ! Non-dimensional position with right layer uKoR-1, v-point - integer, allocatable, dimension(:,:,:) :: vKoL ! Index of left interface corresponding to neutral surface, - ! at a v-point - integer, allocatable, dimension(:,:,:) :: vKoR ! Index of right interface corresponding to neutral surface, - ! at a v-point - real, allocatable, dimension(:,:,:) :: vHeff ! Effective thickness at v-point (H units) + real, allocatable, dimension(:,:,:) :: uPoL !< Non-dimensional position with left layer uKoL-1, u-point + real, allocatable, dimension(:,:,:) :: uPoR !< Non-dimensional position with right layer uKoR-1, u-point + integer, allocatable, dimension(:,:,:) :: uKoL !< Index of left interface corresponding to neutral surface, + !! at a u-point + integer, allocatable, dimension(:,:,:) :: uKoR !< Index of right interface corresponding to neutral surface, + !! at a u-point + real, allocatable, dimension(:,:,:) :: uHeff !< Effective thickness at u-point (H units) + real, allocatable, dimension(:,:,:) :: vPoL !< Non-dimensional position with left layer uKoL-1, v-point + real, allocatable, dimension(:,:,:) :: vPoR !< Non-dimensional position with right layer uKoR-1, v-point + integer, allocatable, dimension(:,:,:) :: vKoL !< Index of left interface corresponding to neutral surface, + !! at a v-point + integer, allocatable, dimension(:,:,:) :: vKoR !< Index of right interface corresponding to neutral surface, + !! at a v-point + real, allocatable, dimension(:,:,:) :: vHeff !< Effective thickness at v-point (H units) ! Coefficients of polynomial reconstructions for temperature and salinity real, allocatable, dimension(:,:,:,:) :: ppoly_coeffs_T !< Polynomial coefficients for temperature - real, allocatable, dimension(:,:,:,:) :: ppoly_coeffs_S !< Polynomial coefficients for temperature + real, allocatable, dimension(:,:,:,:) :: ppoly_coeffs_S !< Polynomial coefficients for salinity ! Variables needed for continuous reconstructions - real, allocatable, dimension(:,:,:) :: dRdT ! dRho/dT (kg/m3/degC) at interfaces - real, allocatable, dimension(:,:,:) :: dRdS ! dRho/dS (kg/m3/ppt) at interfaces - real, allocatable, dimension(:,:,:) :: Tint ! Interface T (degC) - real, allocatable, dimension(:,:,:) :: Sint ! Interface S (ppt) - real, allocatable, dimension(:,:,:) :: Pint ! Interface pressure (Pa) + real, allocatable, dimension(:,:,:) :: dRdT !< dRho/dT (kg/m3/degC) at interfaces + real, allocatable, dimension(:,:,:) :: dRdS !< dRho/dS (kg/m3/ppt) at interfaces + real, allocatable, dimension(:,:,:) :: Tint !< Interface T (degC) + real, allocatable, dimension(:,:,:) :: Sint !< Interface S (ppt) + real, allocatable, dimension(:,:,:) :: Pint !< Interface pressure (Pa) ! Variables needed for discontinuous reconstructions - real, allocatable, dimension(:,:,:,:) :: T_i ! Top edge reconstruction of temperature (degC) - real, allocatable, dimension(:,:,:,:) :: S_i ! Top edge reconstruction of salinity (ppt) - real, allocatable, dimension(:,:,:,:) :: dRdT_i ! dRho/dT (kg/m3/degC) at top edge - real, allocatable, dimension(:,:,:,:) :: dRdS_i ! dRho/dS (kg/m3/ppt) at top edge - integer, allocatable, dimension(:,:) :: ns ! Number of interfacs in a column - logical, allocatable, dimension(:,:,:) :: stable_cell ! True if the cell is stably stratified wrt - ! to the next cell - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. - integer :: id_uhEff_2d = -1 - integer :: id_vhEff_2d = -1 - - real :: C_p ! heat capacity of seawater (J kg-1 K-1) + real, allocatable, dimension(:,:,:,:) :: T_i !< Top edge reconstruction of temperature (degC) + real, allocatable, dimension(:,:,:,:) :: S_i !< Top edge reconstruction of salinity (ppt) + real, allocatable, dimension(:,:,:,:) :: dRdT_i !< dRho/dT (kg/m3/degC) at top edge + real, allocatable, dimension(:,:,:,:) :: dRdS_i !< dRho/dS (kg/m3/ppt) at top edge + integer, allocatable, dimension(:,:) :: ns !< Number of interfacs in a column + logical, allocatable, dimension(:,:,:) :: stable_cell !< True if the cell is stably stratified wrt to the next cell + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. + integer :: id_uhEff_2d = -1 !< Diagnostic IDs + integer :: id_vhEff_2d = -1 !< Diagnostic IDs + + real :: C_p !< heat capacity of seawater (J kg-1 K-1) type(EOS_type), pointer :: EOS !< Equation of state parameters type(remapping_CS) :: remap_CS !< Remapping control structure used to create sublayers type(ndiff_aux_CS_type), pointer :: ndiff_aux_CS !< Store parameters for iteratively finding neutral surface @@ -93,7 +92,7 @@ module MOM_neutral_diffusion ! This include declares and sets the variable "version". #include "version_variable.h" -character(len=40) :: mdl = "MOM_neutral_diffusion" ! module name +character(len=40) :: mdl = "MOM_neutral_diffusion" !< module name contains From 5875751dc874f14b6e7530f27323e79a89adb183 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 09:42:23 -0400 Subject: [PATCH 0505/1072] dOyxgenization of types in MOM_neutral_diffusion_aux.F90 dOxyGenized comments describing types and the elements of types in MOM_neutral_diffusion_aux.F90. All answers are bitwise identical. --- src/tracer/MOM_neutral_diffusion_aux.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/tracer/MOM_neutral_diffusion_aux.F90 b/src/tracer/MOM_neutral_diffusion_aux.F90 index 2cc91606ff..c25564b8da 100644 --- a/src/tracer/MOM_neutral_diffusion_aux.F90 +++ b/src/tracer/MOM_neutral_diffusion_aux.F90 @@ -20,6 +20,7 @@ module MOM_neutral_diffusion_aux public check_neutral_positions public kahan_sum +!> The control structure for this module type, public :: ndiff_aux_CS_type ; private integer :: nterm !< Number of terms in polynomial (deg+1) integer :: max_iter !< Maximum number of iterations @@ -27,10 +28,9 @@ module MOM_neutral_diffusion_aux real :: xtol !< Criterion for how much position changes (nondim) real :: ref_pres !< Determines whether a constant reference pressure is used everywhere or locally referenced !< density is done. ref_pres <-1 is the latter, ref_pres >= 0. otherwise - logical :: force_brent = .false. !< Use Brent's method instead of Newton even when second derivatives are available - logical :: debug + logical :: force_brent = .false. !< Use Brent's method instead of Newton even when second derivatives are available + logical :: debug !< If true, write verbose debugging messages and checksusm type(EOS_type), pointer :: EOS !< Pointer to equation of state used in the model - end type ndiff_aux_CS_type contains From 1923cbc8d5b187731f978e59ad6e1b8e99ebb9bf Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 09:42:44 -0400 Subject: [PATCH 0506/1072] dOyxgenization of types in MOM_offline_main.F90 dOxyGenized comments describing types, the elements of types, and module CPU clock IDs in MOM_offline_main.F90. All answers are bitwise identical. --- src/tracer/MOM_offline_main.F90 | 73 +++++++++++++++++++++------------ 1 file changed, 46 insertions(+), 27 deletions(-) diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 0f7ac54b31..0d90d890fd 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -42,32 +42,46 @@ module MOM_offline_main #include "MOM_memory.h" #include "version_variable.h" +!> The control structure for the offline transport module type, public :: offline_transport_CS ; private - !> Pointers to relevant fields from the main MOM control structure + ! Pointers to relevant fields from the main MOM control structure type(ALE_CS), pointer :: ALE_CSp => NULL() + !< A pointer to the ALE control structure type(diabatic_CS), pointer :: diabatic_CSp => NULL() + !< A pointer to the diabatic control structure type(diag_ctrl), pointer :: diag => NULL() + !< Structure that regulates diagnostic output type(ocean_OBC_type), pointer :: OBC => NULL() + !< A pointer to the open boundary condition control structure type(tracer_advect_CS), pointer :: tracer_adv_CSp => NULL() + !< A pointer to the tracer advection control structure + type(opacity_CS), pointer :: opacity_CSp => NULL() + !< A pointer to the opacity control structure type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() + !< A pointer to control structure that orchestrates the calling of tracer packages type(tracer_registry_type), pointer :: tracer_Reg => NULL() + !< A pointer to the tracer registry type(thermo_var_ptrs), pointer :: tv => NULL() + !< A structure pointing to various thermodynamic variables type(ocean_grid_type), pointer :: G => NULL() + !< Pointer to a structure containing metrics and related information type(verticalGrid_type), pointer :: GV => NULL() + !< Pointer to structure containing information about the vertical grid type(optics_type), pointer :: optics => NULL() - type(opacity_CS), pointer :: opacity_CSp => NULL() + !< Pointer to the optical properties type !> Variables related to reading in fields from online run integer :: start_index !< Timelevel to start integer :: iter_no !< Timelevel to start integer :: numtime !< How many timelevels in the input fields integer :: accumulated_time !< Length of time accumulated in the current offline interval - integer :: & !< Index of each of the variables to be read in - ridx_sum = -1, & !! Separate indices for each variable if they are - ridx_snap = -1 !! setoff from each other in time - integer :: nk_input !! Number of input levels in the input fields - character(len=200) :: offlinedir ! Directory where offline fields are stored + ! Index of each of the variables to be read in with separate indices for each variable if they + ! are set off from each other in time + integer :: ridx_sum = -1 !< Read index offset of the summed variables + integer :: ridx_snap = -1 !< Read index offset of the snapshot variables + integer :: nk_input !< Number of input levels in the input fields + character(len=200) :: offlinedir !< Directory where offline fields are stored character(len=200) :: & ! Names of input files surf_file, & !< Contains surface fields (2d arrays) snap_file, & !< Snapshotted fields (layer thicknesses) @@ -79,7 +93,7 @@ module MOM_offline_main !! 'both' if both methods are used character(len=20) :: mld_var_name !< Name of the mixed layer depth variable to use logical :: fields_are_offset !< True if the time-averaged fields and snapshot fields are - ! offset by one time level + !! offset by one time level logical :: x_before_y !< Which horizontal direction is advected first logical :: print_adv_offline !< Prints out some updates each advection sub interation logical :: skip_diffusion !< Skips horizontal diffusion of tracers @@ -98,13 +112,13 @@ module MOM_offline_main integer :: num_off_iter !< Number of advection iterations per offline step integer :: num_vert_iter !< Number of vertical iterations per offline step integer :: off_ale_mod !< Sets how frequently the ALE step is done during the advection - real :: dt_offline ! Timestep used for offline tracers - real :: dt_offline_vertical ! Timestep used for calls to tracer vertical physics - real :: evap_CFL_limit, minimum_forcing_depth !< Copied from diabatic_CS controlling how tracers - !! follow freshwater fluxes + real :: dt_offline !< Timestep used for offline tracers + real :: dt_offline_vertical !< Timestep used for calls to tracer vertical physics + real :: evap_CFL_limit !< Copied from diabatic_CS controlling how tracers follow freshwater fluxes + real :: minimum_forcing_depth !< Copied from diabatic_CS controlling how tracers follow freshwater fluxes real :: Kd_max !< Runtime parameter specifying the maximum value of vertical diffusivity real :: min_residual !< The minimum amount of total mass flux before exiting the main advection routine - !> Diagnostic manager IDs for some fields that may be of interest when doing offline transport + !>@{ Diagnostic manager IDs for some fields that may be of interest when doing offline transport integer :: & id_uhr = -1, & id_vhr = -1, & @@ -121,30 +135,32 @@ module MOM_offline_main id_h_redist = -1, & id_eta_diff_end = -1 - !> Diagnostic IDs for the regridded/remapped input fields + ! Diagnostic IDs for the regridded/remapped input fields integer :: & id_uhtr_regrid = -1, & id_vhtr_regrid = -1, & id_temp_regrid = -1, & id_salt_regrid = -1, & id_h_regrid = -1 + !!@} - !> IDs for timings of various offline components - integer :: & - id_clock_read_fields = -1, & - id_clock_offline_diabatic = -1, & - id_clock_offline_adv = -1, & - id_clock_redistribute = -1 + ! IDs for timings of various offline components + integer :: id_clock_read_fields = -1 !< A CPU time clock + integer :: id_clock_offline_diabatic = -1 !< A CPU time clock + integer :: id_clock_offline_adv = -1 !< A CPU time clock + integer :: id_clock_redistribute = -1 !< A CPU time clock - !> Variables that may need to be stored between calls to step_MOM + !> Zonal transport that may need to be stored between calls to step_MOM real, allocatable, dimension(:,:,:) :: uhtr + !> Meridional transport that may need to be stored between calls to step_MOM real, allocatable, dimension(:,:,:) :: vhtr ! Fields at T-point - real, allocatable, dimension(:,:,:) :: & - eatr, & !< Amount of fluid entrained from the layer above within + real, allocatable, dimension(:,:,:) :: eatr + !< Amount of fluid entrained from the layer above within !! one time step (m for Bouss, kg/m^2 for non-Bouss) - ebtr !< Amount of fluid entrained from the layer below within + real, allocatable, dimension(:,:,:) :: ebtr + !< Amount of fluid entrained from the layer below within !! one time step (m for Bouss, kg/m^2 for non-Bouss) ! Fields at T-points on interfaces real, allocatable, dimension(:,:,:) :: Kd !< Vertical diffusivity @@ -154,9 +170,12 @@ module MOM_offline_main real, allocatable, dimension(:,:) :: netMassOut !< Freshwater fluxes out of the ocean real, allocatable, dimension(:,:) :: mld !< Mixed layer depths at thickness points, in H. - !> Allocatable arrays to read in entire fields during initialization - real, allocatable, dimension(:,:,:,:) :: & - uhtr_all, vhtr_all, hend_all, temp_all, salt_all + ! Allocatable arrays to read in entire fields during initialization + real, allocatable, dimension(:,:,:,:) :: uhtr_all !< Entire field of zonal transport + real, allocatable, dimension(:,:,:,:) :: vhtr_all !< Entire field of mericional transport + real, allocatable, dimension(:,:,:,:) :: hend_all !< Entire field of layer thicknesses + real, allocatable, dimension(:,:,:,:) :: temp_all !< Entire field of temperatures + real, allocatable, dimension(:,:,:,:) :: salt_all !< Entire field of salinities end type offline_transport_CS From ca25a16560e6471b2bcb152dec42ac6db416b161 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 09:43:03 -0400 Subject: [PATCH 0507/1072] dOyxgenization of types in MOM_tracer_advect.F90 dOxyGenized comments describing types, the elements of types, and module CPU clock IDs in MOM_tracer_advect.F90. All answers are bitwise identical. --- src/tracer/MOM_tracer_advect.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index e38940c565..0370aeaee4 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -34,12 +34,14 @@ module MOM_tracer_advect logical :: debug !< If true, write verbose checksums for debugging purposes. logical :: usePPM !< If true, use PPM instead of PLM logical :: useHuynh !< If true, use the Huynh scheme for PPM interface values - type(group_pass_type) :: pass_uhr_vhr_t_hprev ! For group pass + type(group_pass_type) :: pass_uhr_vhr_t_hprev !< A structred used for group passes end type tracer_advect_CS +!>@{ CPU time clocks integer :: id_clock_advect integer :: id_clock_pass integer :: id_clock_sync +!!@} contains From dc523046e23671a3c92448f3b012a5336518a190 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 09:43:17 -0400 Subject: [PATCH 0508/1072] dOyxgenization of types in MOM_tracer_flow_control.F90 dOxyGenized comments describing types and the elements of types in MOM_tracer_flow_control.F90. All answers are bitwise identical. --- src/tracer/MOM_tracer_flow_control.F90 | 27 ++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 42de7defed..279bc22a95 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -67,19 +67,21 @@ module MOM_tracer_flow_control public call_tracer_column_fns, call_tracer_surface_state, call_tracer_stocks public call_tracer_flux_init, get_chl_from_model, tracer_flow_control_end +!> The control structure for orchestrating the calling of tracer packages type, public :: tracer_flow_control_CS ; private - logical :: use_USER_tracer_example = .false. - logical :: use_DOME_tracer = .false. - logical :: use_ISOMIP_tracer = .false. - logical :: use_ideal_age = .false. - logical :: use_regional_dyes = .false. - logical :: use_oil = .false. - logical :: use_advection_test_tracer = .false. - logical :: use_OCMIP2_CFC = .false. - logical :: use_MOM_generic_tracer = .false. - logical :: use_pseudo_salt_tracer = .false. - logical :: use_boundary_impulse_tracer = .false. - logical :: use_dyed_obc_tracer = .false. + logical :: use_USER_tracer_example = .false. !< If true, use the USER_tracer_example package + logical :: use_DOME_tracer = .false. !< If true, use the DOME_tracer package + logical :: use_ISOMIP_tracer = .false. !< If true, use the ISOMPE_tracer package + logical :: use_ideal_age = .false. !< If true, use the ideal age tracer package + logical :: use_regional_dyes = .false. !< If true, use the regional dyes tracer package + logical :: use_oil = .false. !< If true, use the oil tracer package + logical :: use_advection_test_tracer = .false. !< If true, use the advection_test_tracer package + logical :: use_OCMIP2_CFC = .false. !< If true, use the OCMIP2_CFC tracer package + logical :: use_MOM_generic_tracer = .false. !< If true, use the MOM_generic_tracer packages + logical :: use_pseudo_salt_tracer = .false. !< If true, use the psuedo_salt tracer package + logical :: use_boundary_impulse_tracer = .false. !< If true, use the boundary impulse tracer package + logical :: use_dyed_obc_tracer = .false. !< If true, use the dyed OBC tracer package + !>@{ Pointers to the control strucures for the tracer packages type(USER_tracer_example_CS), pointer :: USER_tracer_example_CSp => NULL() type(DOME_tracer_CS), pointer :: DOME_tracer_CSp => NULL() type(ISOMIP_tracer_CS), pointer :: ISOMIP_tracer_CSp => NULL() @@ -94,6 +96,7 @@ module MOM_tracer_flow_control type(pseudo_salt_tracer_CS), pointer :: pseudo_salt_tracer_CSp => NULL() type(boundary_impulse_tracer_CS), pointer :: boundary_impulse_tracer_CSp => NULL() type(dyed_obc_tracer_CS), pointer :: dyed_obc_tracer_CSp => NULL() + !!@} end type tracer_flow_control_CS contains From e4e7b2d50a79e83ef65a328c979ed113d1569a4a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 09:43:32 -0400 Subject: [PATCH 0509/1072] dOyxgenization of types in MOM_tracer_hor_diff.F90 dOxyGenized comments describing types, the elements of types, and module CPU clock IDs in MOM_tracer_hor_diff.F90. All answers are bitwise identical. --- src/tracer/MOM_tracer_hor_diff.F90 | 71 ++++++++++++++++-------------- 1 file changed, 39 insertions(+), 32 deletions(-) diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 7e3c696bad..99aa562a60 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -32,54 +32,61 @@ module MOM_tracer_hor_diff public tracer_hordiff, tracer_hor_diff_init, tracer_hor_diff_end +!> The ocntrol structure for along-layer and epineutral tracer diffusion type, public :: tracer_hor_diff_CS ; private - real :: dt ! The baroclinic dynamics time step, in s. - real :: KhTr ! The along-isopycnal tracer diffusivity in m2/s. - real :: KhTr_Slope_Cff ! The non-dimensional coefficient in KhTr formula - real :: KhTr_min ! Minimum along-isopycnal tracer diffusivity in m2/s. - real :: KhTr_max ! Maximum along-isopycnal tracer diffusivity in m2/s. - real :: KhTr_passivity_coeff ! Passivity coefficient that scales Rd/dx (default = 0) - ! where passivity is the ratio between along-isopycnal - ! tracer mixing and thickness mixing - real :: KhTr_passivity_min ! Passivity minimum (default = 1/2) - real :: ML_KhTR_scale ! With Diffuse_ML_interior, the ratio of the - ! truly horizontal diffusivity in the mixed - ! layer to the epipycnal diffusivity. Nondim. - real :: max_diff_CFL ! If positive, locally limit the along-isopycnal - ! tracer diffusivity to keep the diffusive CFL - ! locally at or below this value. Nondim. - logical :: Diffuse_ML_interior ! If true, diffuse along isopycnals between - ! the mixed layer and the interior. - logical :: check_diffusive_CFL ! If true, automatically iterate the diffusion - ! to ensure that the diffusive equivalent of - ! the CFL limit is not violated. - logical :: use_neutral_diffusion ! If true, use the neutral_diffusion module from within - ! tracer_hor_diff. - type(neutral_diffusion_CS), pointer :: neutral_diffusion_CSp => NULL() ! Control structure for neutral diffusion. - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. - logical :: debug ! If true, write verbose checksums for debugging purposes. - logical :: show_call_tree ! Display the call tree while running. Set by VERBOSITY level. - logical :: first_call = .true. + real :: dt !< The baroclinic dynamics time step, in s. + real :: KhTr !< The along-isopycnal tracer diffusivity in m2/s. + real :: KhTr_Slope_Cff !< The non-dimensional coefficient in KhTr formula + real :: KhTr_min !< Minimum along-isopycnal tracer diffusivity in m2/s. + real :: KhTr_max !< Maximum along-isopycnal tracer diffusivity in m2/s. + real :: KhTr_passivity_coeff !< Passivity coefficient that scales Rd/dx (default = 0) + !! where passivity is the ratio between along-isopycnal + !! tracer mixing and thickness mixing + real :: KhTr_passivity_min !< Passivity minimum (default = 1/2) + real :: ML_KhTR_scale !< With Diffuse_ML_interior, the ratio of the + !! truly horizontal diffusivity in the mixed + !! layer to the epipycnal diffusivity. Nondim. + real :: max_diff_CFL !< If positive, locally limit the along-isopycnal + !! tracer diffusivity to keep the diffusive CFL + !! locally at or below this value. Nondim. + logical :: Diffuse_ML_interior !< If true, diffuse along isopycnals between + !! the mixed layer and the interior. + logical :: check_diffusive_CFL !< If true, automatically iterate the diffusion + !! to ensure that the diffusive equivalent of + !! the CFL limit is not violated. + logical :: use_neutral_diffusion !< If true, use the neutral_diffusion module from within + !! tracer_hor_diff. + type(neutral_diffusion_CS), pointer :: neutral_diffusion_CSp => NULL() !< Control structure for neutral diffusion. + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. + logical :: debug !< If true, write verbose checksums for debugging purposes. + logical :: show_call_tree !< Display the call tree while running. Set by VERBOSITY level. + logical :: first_call = .true. !< This is true until after the first call + !>@{ Diagnostic IDs integer :: id_KhTr_u = -1 integer :: id_KhTr_v = -1 integer :: id_KhTr_h = -1 integer :: id_CFL = -1 integer :: id_khdt_x = -1 integer :: id_khdt_y = -1 + !!@} - type(group_pass_type) :: pass_t !For group halo pass, used in both - !tracer_hordiff and tracer_epipycnal_ML_diff + type(group_pass_type) :: pass_t !< For group halo pass, used in both + !! tracer_hordiff and tracer_epipycnal_ML_diff end type tracer_hor_diff_CS +!> A type that can be used to create arrays of pointers to 2D arrays type p2d - real, dimension(:,:), pointer :: p => NULL() + real, dimension(:,:), pointer :: p => NULL() !< A pointer to a 2D array of reals end type p2d +!> A type that can be used to create arrays of pointers to 2D integer arrays type p2di - integer, dimension(:,:), pointer :: p => NULL() + integer, dimension(:,:), pointer :: p => NULL() !< A pointer to a 2D array of integers end type p2di +!>@{ CPU time clocks integer :: id_clock_diffuse, id_clock_epimix, id_clock_pass, id_clock_sync +!!@} contains From 179f976415b0e987541a1c837e3a7da3a377a4cf Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 09:43:49 -0400 Subject: [PATCH 0510/1072] dOyxgenization of type elements in MOM_tracer_registry.F90 dOxyGenized comments describing the elements of types in MOM_tracer_registry.F90. Also removed duplicate older-style argument documentation comments. All answers are bitwise identical. --- src/tracer/MOM_tracer_registry.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index 34d1b8553d..6491006c7f 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -93,7 +93,7 @@ module MOM_tracer_registry character(len=48) :: cmor_tendprefix = "" !< The CMOR variable prefix for tendencies of this !! tracer, required because CMOR does not follow any !! discernable pattern for these names. - integer :: ind_tr_squared = -1 + integer :: ind_tr_squared = -1 !< The tracer registry index for the square of this tracer !### THESE CAPABILITIES HAVE NOT YET BEEN IMPLEMENTED. logical :: advect_tr = .true. !< If true, this tracer should be advected @@ -101,6 +101,7 @@ module MOM_tracer_registry logical :: remap_tr = .true. !< If true, this tracer should be vertically remapped integer :: diag_form = 1 !< An integer indicating which template is to be used to label diagnostics. + !>@{ Diagnostic IDs integer :: id_tr = -1 integer :: id_adx = -1, id_ady = -1, id_dfx = -1, id_dfy = -1 integer :: id_adx_2d = -1, id_ady_2d = -1, id_dfx_2d = -1, id_dfy_2d = -1 @@ -109,6 +110,7 @@ module MOM_tracer_registry integer :: id_remap_conc = -1, id_remap_cont = -1, id_remap_cont_2d = -1 integer :: id_tendency = -1, id_trxh_tendency = -1, id_trxh_tendency_2d = -1 integer :: id_tr_vardec = -1 + !!@} end type tracer_type !> Type to carry basic tracer information From 9beef86c0417ef6b0904e11a085b20e38543505d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 09:44:12 -0400 Subject: [PATCH 0511/1072] dOyxgenization of types in advection_test_tracer.F90 dOxyGenized comments describing types, the elements of types, and routines in advection_test_tracer.F90. Also removed duplicate older-style argument documentation comments. All answers are bitwise identical. --- src/tracer/advection_test_tracer.F90 | 132 +++++++++------------------ 1 file changed, 42 insertions(+), 90 deletions(-) diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 611a80f4a4..0ccf4d95b6 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -67,35 +67,37 @@ module advection_test_tracer ! ntr is the number of tracers in this module. integer, parameter :: NTR = 11 +!> The control structure for the advect_test_tracer module type, public :: advection_test_tracer_CS ; private - integer :: ntr = NTR ! Number of tracers in this module - logical :: coupled_tracers = .false. ! These tracers are not offered to the coupler. - character(len=200) :: tracer_IC_file ! The full path to the IC file, or " " - ! to initialize internally. - type(time_type), pointer :: Time => NULL() ! A pointer to the ocean model's clock. - type(tracer_registry_type), pointer :: tr_Reg => NULL() - real, pointer :: tr(:,:,:,:) => NULL() ! The array of tracers used in this - ! subroutine, in g m-3? - real :: land_val(NTR) = -1.0 ! The value of tr used where land is masked out. - logical :: use_sponge ! If true, sponges may be applied somewhere in the domain. - logical :: tracers_may_reinit - - real :: x_origin, x_width ! Parameters describing the test functions - real :: y_origin, y_width ! Parameters describing the test functions - - integer, dimension(NTR) :: ind_tr ! Indices returned by aof_set_coupler_flux - ! if it is used and the surface tracer concentrations are to be - ! provided to the coupler. - - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. - type(MOM_restart_CS), pointer :: restart_CSp => NULL() - - type(vardesc) :: tr_desc(NTR) + integer :: ntr = NTR !< Number of tracers in this module + logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler. + character(len=200) :: tracer_IC_file !< The full path to the IC file, or " " to initialize internally. + type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. + type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the MOM tracer registry + real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3? + real :: land_val(NTR) = -1.0 !< The value of tr used where land is masked out. + logical :: use_sponge !< If true, sponges may be applied somewhere in the domain. + logical :: tracers_may_reinit !< If true, the tracers may be set up via the initialization code if + !! they are not found in the restart files. Otherwise it is a fatal error + !! if the tracers are not found in the restart files of a restarted run. + real :: x_origin !< Parameters describing the test functions + real :: x_width !< Parameters describing the test functions + real :: y_origin !< Parameters describing the test functions + real :: y_width !< Parameters describing the test functions + + integer, dimension(NTR) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and + !! the surface tracer concentrations are to be provided to the coupler. + + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. + type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure. + + type(vardesc) :: tr_desc(NTR) !< Descriptions and metadata for the tracers end type advection_test_tracer_CS contains +!> Register tracer fields and subroutines to be used with MOM. function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -106,17 +108,8 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_ !! structure for the tracer advection and !! diffusion module type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure -! This subroutine is used to register tracer fields and subroutines -! to be used with MOM. -! Arguments: HI - A horizontal index type structure. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module -! (in/out) tr_Reg - A pointer that is set to point to the control structure -! for the tracer advection and diffusion module. -! (in) restart_CS - A pointer to the restart control structure. + + ! Local variables character(len=80) :: name, longname ! This include declares and sets the variable "version". #include "version_variable.h" @@ -203,6 +196,7 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_ register_advection_test_tracer = .true. end function register_advection_test_tracer +!> Initializes the NTR tracer fields in tr(:,:,:,:) and it sets up the tracer output. subroutine initialize_advection_test_tracer(restart, day, G, GV, h,diag, OBC, CS, & sponge_CSp, diag_to_Z_CSp) logical, intent(in) :: restart !< .true. if the fields have already @@ -222,24 +216,8 @@ subroutine initialize_advection_test_tracer(restart, day, G, GV, h,diag, OBC, CS type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges. type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure !! for diagnostics in depth space. -! This subroutine initializes the NTR tracer fields in tr(:,:,:,:) -! and it sets up the tracer output. - -! Arguments: restart - .true. if the fields have already been read from -! a restart file. -! (in) day - Time of the start of the run. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) h - Layer thickness, in m or kg m-2. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in) OBC - This open boundary condition type specifies whether, where, -! and what open boundary conditions are used. -! (in/out) CS - The control structure returned by a previous call to -! register_advection_test_tracer. -! (in/out) sponge_CSp - A pointer to the control structure for the sponges, if -! they are in use. Otherwise this may be unassociated. -! (in/out) diag_to_Z_Csp - A pointer to the control structure for diagnostics -! in depth space. + + ! Local variables real, allocatable :: temp(:,:,:) real, pointer, dimension(:,:,:) :: & OBC_tr1_u => NULL(), & ! These arrays should be allocated and set to @@ -314,6 +292,8 @@ subroutine initialize_advection_test_tracer(restart, day, G, GV, h,diag, OBC, CS end subroutine initialize_advection_test_tracer +!> Applies diapycnal diffusion and any other column tracer physics or chemistry to the tracers +!! from this package. This is a simple example of a set of advected passive tracers. subroutine advection_test_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -343,24 +323,9 @@ subroutine advection_test_tracer_column_physics(h_old, h_new, ea, eb, fluxes, ! tracer physics or chemistry to the tracers from this file. ! This is a simple example of a set of advected passive tracers. -! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2. -! (in) h_new - Layer thickness after entrainment, in m or kg m-2. -! (in) ea - an array to which the amount of fluid entrained -! from the layer above during this call will be -! added, in m or kg m-2. -! (in) eb - an array to which the amount of fluid entrained -! from the layer below during this call will be -! added, in m or kg m-2. -! (in) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) dt - The amount of time covered by this call, in s. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! register_advection_test_tracer. -! ! The arguments to this subroutine are redundant in that ! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] + ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified real :: b1(SZI_(G)) ! b1 and c1 are variables used by the real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. @@ -419,34 +384,20 @@ subroutine advection_test_tracer_surface_state(state, h, G, CS) end subroutine advection_test_tracer_surface_state +!> Calculate the mass-weighted integral of all tracer stocks, returning the number of stocks it has calculated. +!! If the stock_index is present, only the stock corresponding to that coded index is returned. function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(advection_test_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_advection_test_tracer. character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. character(len=*), dimension(:), intent(out) :: units !< the units of the stocks calculated. - integer, optional, intent(in) :: stock_index !< the coded index of a specific stock - !! being sought. - integer :: advection_test_stock -! This function calculates the mass-weighted integral of all tracer stocks, -! returning the number of stocks it has calculated. If the stock_index -! is present, only the stock corresponding to that coded index is returned. - -! Arguments: h - Layer thickness, in m or kg m-2. -! (out) stocks - the mass-weighted integrated amount of each tracer, -! in kg times concentration units. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! register_ideal_age_tracer. -! (out) names - the names of the stocks calculated. -! (out) units - the units of the stocks calculated. -! (in,opt) stock_index - the coded index of a specific stock being sought. -! Return value: the number of stocks calculated here. + integer, optional, intent(in) :: stock_index !< the coded index of a specific stock being sought. + integer :: advection_test_stock !< the number of stocks calculated here. integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -475,6 +426,7 @@ function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index) end function advection_test_stock +!> Deallocate memory associated with this module subroutine advection_test_tracer_end(CS) type(advection_test_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_advection_test_tracer. From 4ff867c527f7e8a71abe73d57f75d6264abf057e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 09:44:26 -0400 Subject: [PATCH 0512/1072] dOyxgenization of types in boundary_impulse_tracer.F90 dOxyGenized comments describing types, the elements of types, and routines in boundary_impulse_tracer.F90. Also removed duplicate older-style argument documentation comments. All answers are bitwise identical. --- src/tracer/boundary_impulse_tracer.F90 | 123 +++++++------------------ 1 file changed, 31 insertions(+), 92 deletions(-) diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 2d4cc4e947..7995b712e3 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -33,33 +33,31 @@ module boundary_impulse_tracer public boundary_impulse_tracer_column_physics, boundary_impulse_tracer_surface_state public boundary_impulse_stock, boundary_impulse_tracer_end -! NTR_MAX is the maximum number of tracers in this module. +!> NTR_MAX is the maximum number of tracers in this module. integer, parameter :: NTR_MAX = 1 +!> The control structure for the boundary impulse tracer package type, public :: boundary_impulse_tracer_CS ; private - integer :: ntr=NTR_MAX ! The number of tracers that are actually used. - logical :: coupled_tracers = .false. ! These tracers are not offered to the coupler. - type(time_type), pointer :: Time => NULL() ! A pointer to the ocean model's clock. - type(tracer_registry_type), pointer :: tr_Reg => NULL() - real, pointer :: tr(:,:,:,:) => NULL() ! The array of tracers used in this - ! subroutine, in g m-3? - logical :: tracers_may_reinit ! If true, boundary_impulse can be initialized if - ! not found in restart file - integer, dimension(NTR_MAX) :: & - ind_tr ! Indices returned by aof_set_coupler_flux if it is used and the - ! surface tracer concentrations are to be provided to the coupler. - - integer :: nkml ! Number of layers in mixed layer - real, dimension(NTR_MAX) :: land_val = -1.0 - real :: kw_eff ! An effective piston velocity used to flux tracer out at the surface - real :: remaining_source_time ! How much longer (same units as the timestep) to - ! inject the tracer at the surface - - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. - type(MOM_restart_CS), pointer :: restart_CSp => NULL() - - type(vardesc) :: tr_desc(NTR_MAX) + integer :: ntr=NTR_MAX !< The number of tracers that are actually used. + logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler. + type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. + type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry + real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3? + logical :: tracers_may_reinit !< If true, boundary_impulse can be initialized if not found in restart file + integer, dimension(NTR_MAX) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and the + !! surface tracer concentrations are to be provided to the coupler. + + integer :: nkml !< Number of layers in mixed layer + real, dimension(NTR_MAX) :: land_val = -1.0 !< A value to use to fill in tracers over land + real :: kw_eff !< An effective piston velocity used to flux tracer out at the surface + real :: remaining_source_time !< How much longer (same units as the timestep) to + !! inject the tracer at the surface + + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. + type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the retart control structure + + type(vardesc) :: tr_desc(NTR_MAX) !< Descriptions and metadata for the tracers end type boundary_impulse_tracer_CS contains @@ -75,26 +73,16 @@ function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restar !! structure for the tracer advection and !! diffusion module type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure -! This subroutine is used to register tracer fields and subroutines -! to be used with MOM. -! Arguments: HI - A horizontal index type structure. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module -! (in/out) tr_Reg - A pointer that is set to point to the control structure -! for the tracer advection and diffusion module. -! (in) restart_CS - A pointer to the restart control structure. - -! This include declares and sets the variable "version". -#include "version_variable.h" + + ! Local variables character(len=40) :: mdl = "boundary_impulse_tracer" ! This module's name. character(len=200) :: inputdir ! The directory where the input files are. character(len=48) :: var_name ! The variable's name. character(len=3) :: name_tag ! String for creating identifying boundary_impulse character(len=48) :: flux_units ! The units for tracer fluxes, usually ! kg(tracer) kg(water)-1 m3 s-1 or kg(tracer) s-1. + ! This include declares and sets the variable "version". +#include "version_variable.h" real, pointer :: tr_ptr(:,:,:) => NULL() real, pointer :: rem_time_ptr => NULL() logical :: register_boundary_impulse_tracer @@ -181,24 +169,7 @@ subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, !! for diagnostics in depth space. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables -! This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:) -! and it sets up the tracer output. - -! Arguments: restart - .true. if the fields have already been read from -! a restart file. -! (in) day - Time of the start of the run. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) h - Layer thickness, in m or kg m-2. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in) OBC - This open boundary condition type specifies whether, where, -! and what open boundary conditions are used. -! (in/out) CS - The control structure returned by a previous call to -! register_boundary_impulse_tracer. -! (in/out) sponge_CSp - A pointer to the control structure for the sponges, if -! they are in use. Otherwise this may be unassociated. -! (in/out) diag_to_Z_Csp - A pointer to the control structure for diagnostics -! in depth space. + ! Local variables character(len=16) :: name ! A variable's name in a NetCDF file. character(len=72) :: longname ! The long name of that variable. character(len=48) :: units ! The dimensions of the variable. @@ -234,7 +205,7 @@ subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, end subroutine initialize_boundary_impulse_tracer -! Apply source or sink at boundary and do vertical diffusion +!> Apply source or sink at boundary and do vertical diffusion subroutine boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & tv, debug, evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -268,31 +239,10 @@ subroutine boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, ! tracer physics or chemistry to the tracers from this file. ! This is a simple example of a set of advected passive tracers. -! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2. -! (in) h_new - Layer thickness after entrainment, in m or kg m-2. -! (in) ea - an array to which the amount of fluid entrained -! from the layer above during this call will be -! added, in m or kg m-2. -! (in) eb - an array to which the amount of fluid entrained -! from the layer below during this call will be -! added, in m or kg m-2. -! (in) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) dt - The amount of time covered by this call, in s. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! register_boundary_impulse_tracer. -! (in) tv - Thermodynamic structure with T and S -! (in) evap_CFL_limit - Limits how much water can be fluxed out of the top layer -! Stored previously in diabatic CS. -! (in) minimum_forcing_depth - The smallest depth over which fluxes can be applied -! Stored previously in diabatic CS. -! (in) debug - Calculates checksums -! ! The arguments to this subroutine are redundant in that ! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] + ! Local variables real :: Isecs_per_year = 1.0 / (365.0*86400.0) real :: year, h_total, scale, htot, Ih_limit integer :: secs, days @@ -352,18 +302,7 @@ function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index) ! returning the number of stocks it has calculated. If the stock_index ! is present, only the stock corresponding to that coded index is returned. -! Arguments: h - Layer thickness, in m or kg m-2. -! (out) stocks - the mass-weighted integrated amount of each tracer, -! in kg times concentration units. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! register_boundary_impulse_tracer. -! (out) names - the names of the stocks calculated. -! (out) units - the units of the stocks calculated. -! (in,opt) stock_index - the coded index of a specific stock being sought. -! Return value: the number of stocks calculated here. - + ! Local variables integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -426,7 +365,7 @@ subroutine boundary_impulse_tracer_surface_state(state, h, G, CS) end subroutine boundary_impulse_tracer_surface_state -! Performs finalization of boundary impulse tracer +!> Performs finalization of boundary impulse tracer subroutine boundary_impulse_tracer_end(CS) type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_boundary_impulse_tracer. From dea05e16db3886b6f3874c58999cbfaa3e0b3bb6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 09:44:46 -0400 Subject: [PATCH 0513/1072] dOyxgenization of types in dye_example.F90 dOxyGenized comments describing types, the elements of types, and routines in dye_example.F90. Also removed duplicate older-style argument documentation comments. All answers are bitwise identical. --- src/tracer/dye_example.F90 | 44 ++++++++++++++++++-------------------- 1 file changed, 21 insertions(+), 23 deletions(-) diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 9a407d24ae..d29e0534ba 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -32,30 +32,28 @@ module regional_dyes public dye_stock, regional_dyes_end +!> The control structure for the regional dyes tracer package type, public :: dye_tracer_CS ; private - integer :: ntr ! The number of tracers that are actually used. - logical :: coupled_tracers = .false. ! These tracers are not offered to the - ! coupler. - real, allocatable, dimension(:) :: dye_source_minlon, & ! Minimum longitude of region dye will be injected. - dye_source_maxlon, & ! Maximum longitude of region dye will be injected. - dye_source_minlat, & ! Minimum latitude of region dye will be injected. - dye_source_maxlat, & ! Maximum latitude of region dye will be injected. - dye_source_mindepth, & ! Minimum depth of region dye will be injected (m). - dye_source_maxdepth ! Maximum depth of region dye will be injected (m). - type(tracer_registry_type), pointer :: tr_Reg => NULL() - real, pointer :: tr(:,:,:,:) => NULL() ! The array of tracers used in this - ! subroutine, in g m-3? - - integer, allocatable, dimension(:) :: & - ind_tr ! Indices returned by aof_set_coupler_flux if it is used and the - ! surface tracer concentrations are to be provided to the coupler. - - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. - type(MOM_restart_CS), pointer :: restart_CSp => NULL() - - type(vardesc), allocatable :: tr_desc(:) - logical :: tracers_may_reinit = .false. ! hard-coding here (mjh) + integer :: ntr !< The number of tracers that are actually used. + logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler. + real, allocatable, dimension(:) :: dye_source_minlon !< Minimum longitude of region dye will be injected. + real, allocatable, dimension(:) :: dye_source_maxlon !< Maximum longitude of region dye will be injected. + real, allocatable, dimension(:) :: dye_source_minlat !< Minimum latitude of region dye will be injected. + real, allocatable, dimension(:) :: dye_source_maxlat !< Maximum latitude of region dye will be injected. + real, allocatable, dimension(:) :: dye_source_mindepth !< Minimum depth of region dye will be injected (m). + real, allocatable, dimension(:) :: dye_source_maxdepth !< Maximum depth of region dye will be injected (m). + type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry + real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3? + + integer, allocatable, dimension(:) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and the + !! surface tracer concentrations are to be provided to the coupler. + + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. + type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure + + type(vardesc), allocatable :: tr_desc(:) !< Descriptions and metadata for the tracers + logical :: tracers_may_reinit = .false. !< If true the tracers may be initialized if not found in a restart file end type dye_tracer_CS contains From d53ee89f32f7947cb413a65059200de89319293b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 09:45:01 -0400 Subject: [PATCH 0514/1072] dOyxgenization of types in ideal_age_example.F90 dOxyGenized comments describing types, the elements of types, and routines in ideal_age_example.F90. Also removed duplicate older-style argument documentation comments. All answers are bitwise identical. --- src/tracer/ideal_age_example.F90 | 132 ++++++++++--------------------- 1 file changed, 42 insertions(+), 90 deletions(-) diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index d6f57faeff..b7fe056498 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -69,44 +69,42 @@ module ideal_age_example ! NTR_MAX is the maximum number of tracers in this module. integer, parameter :: NTR_MAX = 3 +!> The control structure for the ideal_age_tracer package type, public :: ideal_age_tracer_CS ; private - integer :: ntr ! The number of tracers that are actually used. - logical :: coupled_tracers = .false. ! These tracers are not offered to the coupler. - integer :: nkml ! The number of layers in the mixed layer. The ideal - ! age tracers are reset in the top nkml layers. - character(len=200) :: IC_file ! The file in which the age-tracer initial values - ! can be found, or an empty string for internal initialization. - logical :: Z_IC_file ! If true, the IC_file is in Z-space. The default is false. - type(time_type), pointer :: Time => NULL() ! A pointer to the ocean model's clock. - type(tracer_registry_type), pointer :: tr_Reg => NULL() - real, pointer :: tr(:,:,:,:) => NULL() ! The array of tracers used in this - ! subroutine, in g m-3? - real, dimension(NTR_MAX) :: & - IC_val = 0.0, & ! The (uniform) initial condition value. - young_val = 0.0, & ! The value assigned to tr at the surface. - land_val = -1.0, & ! The value of tr used where land is masked out. - sfc_growth_rate, & ! The exponential growth rate for the surface value, - ! in units of year-1. - tracer_start_year ! The year in which tracers start aging, or at which the - ! surface value equals young_val, in years. - logical :: tracers_may_reinit ! If true, tracers may go through the - ! initialization code if they are not found in the - ! restart files. - logical :: tracer_ages(NTR_MAX) - - integer, dimension(NTR_MAX) :: & - ind_tr ! Indices returned by aof_set_coupler_flux if it is used and the - ! surface tracer concentrations are to be provided to the coupler. - - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. - type(MOM_restart_CS), pointer :: restart_CSp => NULL() - - type(vardesc) :: tr_desc(NTR_MAX) + integer :: ntr !< The number of tracers that are actually used. + logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler. + integer :: nkml !< The number of layers in the mixed layer. The ideal + !1 age tracers are reset in the top nkml layers. + character(len=200) :: IC_file !< The file in which the age-tracer initial values + !! can be found, or an empty string for internal initialization. + logical :: Z_IC_file !< If true, the IC_file is in Z-space. The default is false. + type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. + type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry + real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this package, in g m-3? + real, dimension(NTR_MAX) :: IC_val = 0.0 !< The (uniform) initial condition value. + real, dimension(NTR_MAX) :: young_val = 0.0 !< The value assigned to tr at the surface. + real, dimension(NTR_MAX) :: land_val = -1.0 !< The value of tr used where land is masked out. + real, dimension(NTR_MAX) :: sfc_growth_rate !< The exponential growth rate for the surface value, + !! in units of year-1. + real, dimension(NTR_MAX) :: tracer_start_year !< The year in which tracers start aging, or at which the + !! surface value equals young_val, in years. + logical :: tracers_may_reinit !< If true, these tracers be set up via the initialization code if + !! they are not found in the restart files. + logical :: tracer_ages(NTR_MAX) !< Indicates whether each tracer ages. + + integer, dimension(NTR_MAX) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and the + !! surface tracer concentrations are to be provided to the coupler. + + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. + type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart controls structure + + type(vardesc) :: tr_desc(NTR_MAX) !< Descriptions and metadata for the tracers end type ideal_age_tracer_CS contains +!> Register the ideal age tracer fields to be used with MOM. function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -117,16 +115,6 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) !! structure for the tracer advection and !! diffusion module type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure -! This subroutine is used to register tracer fields and subroutines -! to be used with MOM. -! Arguments: HI - A horizontal index type structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module -! (in/out) tr_Reg - A pointer that is set to point to the control structure -! for the tracer advection and diffusion module. -! (in) restart_CS - A pointer to the restart control structure. ! This include declares and sets the variable "version". #include "version_variable.h" @@ -239,6 +227,7 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) register_ideal_age_tracer = .true. end function register_ideal_age_tracer +!> Sets the ideal age traces to their initial values and sets up the tracer output subroutine initialize_ideal_age_tracer(restart, day, G, GV, h, diag, OBC, CS, & sponge_CSp, diag_to_Z_CSp) logical, intent(in) :: restart !< .true. if the fields have already @@ -261,21 +250,7 @@ subroutine initialize_ideal_age_tracer(restart, day, G, GV, h, diag, OBC, CS, & ! This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:) ! and it sets up the tracer output. -! Arguments: restart - .true. if the fields have already been read from -! a restart file. -! (in) day - Time of the start of the run. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) h - Layer thickness, in m or kg m-2. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in) OBC - This open boundary condition type specifies whether, where, -! and what open boundary conditions are used. -! (in/out) CS - The control structure returned by a previous call to -! register_ideal_age_tracer. -! (in/out) sponge_CSp - A pointer to the control structure for the sponges, if -! they are in use. Otherwise this may be unassociated. -! (in/out) diag_to_Z_Csp - A pointer to the control structure for diagnostics -! in depth space. + ! Local variables character(len=24) :: name ! A variable's name in a NetCDF file. character(len=72) :: longname ! The long name of that variable. character(len=48) :: units ! The dimensions of the variable. @@ -340,6 +315,7 @@ subroutine initialize_ideal_age_tracer(restart, day, G, GV, h, diag, OBC, CS, & end subroutine initialize_ideal_age_tracer +!> Applies diapycnal diffusion, aging and regeneration at the surface to the ideal age tracers subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -369,24 +345,9 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, ! tracer physics or chemistry to the tracers from this file. ! This is a simple example of a set of advected passive tracers. -! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2. -! (in) h_new - Layer thickness after entrainment, in m or kg m-2. -! (in) ea - an array to which the amount of fluid entrained -! from the layer above during this call will be -! added, in m or kg m-2. -! (in) eb - an array to which the amount of fluid entrained -! from the layer below during this call will be -! added, in m or kg m-2. -! (in) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) dt - The amount of time covered by this call, in s. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! register_ideal_age_tracer. -! ! The arguments to this subroutine are redundant in that ! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] + ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified real :: sfc_val ! The surface value for the tracers. real :: Isecs_per_year ! The number of seconds in a year. @@ -444,36 +405,26 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, end subroutine ideal_age_tracer_column_physics +!> Calculates the mass-weighted integral of all tracer stocks, returning the number of stocks it +!! has calculated. If stock_index is present, only the stock corresponding to that coded index is found. function ideal_age_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each - !! tracer, in kg times concentration units. + !! tracer, in kg times concentration units. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to register_ideal_age_tracer. + type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_ideal_age_tracer. character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. character(len=*), dimension(:), intent(out) :: units !< the units of the stocks calculated. integer, optional, intent(in) :: stock_index !< the coded index of a specific stock !! being sought. - integer :: ideal_age_stock + integer :: ideal_age_stock !< The number of stocks calculated here. ! This function calculates the mass-weighted integral of all tracer stocks, ! returning the number of stocks it has calculated. If the stock_index ! is present, only the stock corresponding to that coded index is returned. -! Arguments: h - Layer thickness, in m or kg m-2. -! (out) stocks - the mass-weighted integrated amount of each tracer, -! in kg times concentration units. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! register_ideal_age_tracer. -! (out) names - the names of the stocks calculated. -! (out) units - the units of the stocks calculated. -! (in,opt) stock_index - the coded index of a specific stock being sought. -! Return value: the number of stocks calculated here. - integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -535,6 +486,7 @@ subroutine ideal_age_tracer_surface_state(state, h, G, CS) end subroutine ideal_age_tracer_surface_state +!> Deallocate any memory associated with this tracer package subroutine ideal_age_example_end(CS) type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_ideal_age_tracer. From 060f000bc5eed39cfa54d1eb768f7c1c68af7e90 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 09:45:14 -0400 Subject: [PATCH 0515/1072] dOyxgenization of types in oil_tracer.F90 dOxyGenized comments describing types, the elements of types, and routines in oil_tracer.F90. Also removed duplicate older-style argument documentation comments. All answers are bitwise identical. --- src/tracer/oil_tracer.F90 | 144 +++++++++++++------------------------- 1 file changed, 48 insertions(+), 96 deletions(-) diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index eede1de434..0e9ac18174 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -70,48 +70,46 @@ module oil_tracer ! NTR_MAX is the maximum number of tracers in this module. integer, parameter :: NTR_MAX = 20 +!> The control structure for the oil tracer package type, public :: oil_tracer_CS ; private - integer :: ntr ! The number of tracers that are actually used. - logical :: coupled_tracers = .false. ! These tracers are not offered to the coupler. - character(len=200) :: IC_file ! The file in which the age-tracer initial values - ! can be found, or an empty string for internal initialization. - logical :: Z_IC_file ! If true, the IC_file is in Z-space. The default is false. - real :: oil_source_longitude, oil_source_latitude ! Lat,lon of source location (geographic) - integer :: oil_source_i=-999, oil_source_j=-999 ! Local i,j of source location (computational) - real :: oil_source_rate ! Rate of oil injection (kg/s) - real :: oil_start_year ! The year in which tracers start aging, or at which the - ! surface value equals young_val, in years. - real :: oil_end_year ! The year in which tracers start aging, or at which the - ! surface value equals young_val, in years. - type(time_type), pointer :: Time => NULL() ! A pointer to the ocean model's clock. - type(tracer_registry_type), pointer :: tr_Reg => NULL() - real, pointer :: tr(:,:,:,:) => NULL() ! The array of tracers used in this - ! subroutine, in g m-3? - real, dimension(NTR_MAX) :: & - IC_val = 0.0, & ! The (uniform) initial condition value. - young_val = 0.0, & ! The value assigned to tr at the surface. - land_val = -1.0, & ! The value of tr used where land is masked out. - sfc_growth_rate ! The exponential growth rate for the surface value, - ! in units of year-1. - real, dimension(NTR_MAX) :: oil_decay_days, & ! Decay time scale of oil (in days) - oil_decay_rate ! Decay rate of oil (in s^-1) calculated from oil_decay_days - integer, dimension(NTR_MAX) :: oil_source_k ! Layer of source - logical :: oil_may_reinit ! If true, oil may go through the - ! initialization code if they are not found in the - ! restart files. - integer, dimension(NTR_MAX) :: & - ind_tr ! Indices returned by aof_set_coupler_flux if it is used and the - ! surface tracer concentrations are to be provided to the coupler. - - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. - type(MOM_restart_CS), pointer :: restart_CSp => NULL() - - type(vardesc) :: tr_desc(NTR_MAX) + integer :: ntr !< The number of tracers that are actually used. + logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler. + character(len=200) :: IC_file !< The file in which the age-tracer initial values + !! can be found, or an empty string for internal initialization. + logical :: Z_IC_file !< If true, the IC_file is in Z-space. The default is false. + real :: oil_source_longitude !< Latitude of source location (geographic) + real :: oil_source_latitude !< Longitude of source location (geographic) + integer :: oil_source_i=-999 !< Local i of source location (computational) + integer :: oil_source_j=-999 !< Local j of source location (computational) + real :: oil_source_rate !< Rate of oil injection (kg/s) + real :: oil_start_year !< The year in which tracers start aging, or at which the + !! surface value equals young_val, in years. + real :: oil_end_year !< The year in which tracers start aging, or at which the + !! surface value equals young_val, in years. + type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. + type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the MOM tracer registry + real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3? + real, dimension(NTR_MAX) :: IC_val = 0.0 !< The (uniform) initial condition value. + real, dimension(NTR_MAX) :: young_val = 0.0 !< The value assigned to tr at the surface. + real, dimension(NTR_MAX) :: land_val = -1.0 !< The value of tr used where land is masked out. + real, dimension(NTR_MAX) :: sfc_growth_rate !< The exponential growth rate for the surface value, in units of year-1. + real, dimension(NTR_MAX) :: oil_decay_days !< Decay time scale of oil (in days) + real, dimension(NTR_MAX) :: oil_decay_rate !< Decay rate of oil (in s^-1) calculated from oil_decay_days + integer, dimension(NTR_MAX) :: oil_source_k !< Layer of source + logical :: oil_may_reinit !< If true, oil tracers may be reset by the initialization code + !! if they are not found in the restart files. + integer, dimension(NTR_MAX) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and the + !! surface tracer concentrations are to be provided to the coupler. + type(vardesc) :: tr_desc(NTR_MAX) !< Descriptions and metadata for the tracers + + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. + type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure end type oil_tracer_CS contains +!> Register oil tracer fields and subroutines to be used with MOM. function register_oil_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -122,21 +120,11 @@ function register_oil_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) !! structure for the tracer advection and !! diffusion module type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure -! This subroutine is used to register tracer fields and subroutines -! to be used with MOM. -! Arguments: HI - A horizontal index type structure. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module -! (in/out) tr_Reg - A pointer that is set to point to the control structure -! for the tracer advection and diffusion module. -! (in) restart_CS - A pointer to the restart control structure. + ! Local variables + character(len=40) :: mdl = "oil_tracer" ! This module's name. ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mdl = "oil_tracer" ! This module's name. character(len=200) :: inputdir ! The directory where the input files are. character(len=48) :: var_name ! The variable's name. character(len=3) :: name_tag ! String for creating identifying oils @@ -247,6 +235,7 @@ function register_oil_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) end function register_oil_tracer +!> Initialize the oil tracers and set up tracer output subroutine initialize_oil_tracer(restart, day, G, GV, h, diag, OBC, CS, & sponge_CSp, diag_to_Z_CSp) logical, intent(in) :: restart !< .true. if the fields have already @@ -266,24 +255,8 @@ subroutine initialize_oil_tracer(restart, day, G, GV, h, diag, OBC, CS, & type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges. type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure !! for diagnostics in depth space. -! This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:) -! and it sets up the tracer output. - -! Arguments: restart - .true. if the fields have already been read from -! a restart file. -! (in) day - Time of the start of the run. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) h - Layer thickness, in m or kg m-2. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in) OBC - This open boundary condition type specifies whether, where, -! and what open boundary conditions are used. -! (in/out) CS - The control structure returned by a previous call to -! register_oil_tracer. -! (in/out) sponge_CSp - A pointer to the control structure for the sponges, if -! they are in use. Otherwise this may be unassociated. -! (in/out) diag_to_Z_Csp - A pointer to the control structure for diagnostics -! in depth space. + + ! Local variables character(len=16) :: name ! A variable's name in a NetCDF file. character(len=72) :: longname ! The long name of that variable. character(len=48) :: units ! The dimensions of the variable. @@ -358,6 +331,7 @@ subroutine initialize_oil_tracer(restart, day, G, GV, h, diag, OBC, CS, & end subroutine initialize_oil_tracer +!> Apply sources, sinks, diapycnal mixing and rising motions to the oil tracers subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, tv, & evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -388,25 +362,10 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS ! tracer physics or chemistry to the tracers from this file. ! This is a simple example of a set of advected passive tracers. -! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2. -! (in) h_new - Layer thickness after entrainment, in m or kg m-2. -! (in) ea - an array to which the amount of fluid entrained -! from the layer above during this call will be -! added, in m or kg m-2. -! (in) eb - an array to which the amount of fluid entrained -! from the layer below during this call will be -! added, in m or kg m-2. -! (in) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) dt - The amount of time covered by this call, in s. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! register_oil_tracer. -! ! The arguments to this subroutine are redundant in that ! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] + ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified real :: Isecs_per_year = 1.0 / (365.0*86400.0) real :: year, h_total, ldecay @@ -482,6 +441,8 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS end subroutine oil_tracer_column_physics +!> Calculate the mass-weighted integral of the oil tracer stocks, returning the number of stocks it +!! has calculated. If the stock_index is present, only the stock corresponding to that coded index is returned. function oil_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -494,23 +455,13 @@ function oil_stock(h, stocks, G, GV, CS, names, units, stock_index) character(len=*), dimension(:), intent(out) :: units !< the units of the stocks calculated. integer, optional, intent(in) :: stock_index !< the coded index of a specific stock !! being sought. - integer :: oil_stock + integer :: oil_stock !< The number of stocks calculated here. + ! This function calculates the mass-weighted integral of all tracer stocks, ! returning the number of stocks it has calculated. If the stock_index ! is present, only the stock corresponding to that coded index is returned. -! Arguments: h - Layer thickness, in m or kg m-2. -! (out) stocks - the mass-weighted integrated amount of each tracer, -! in kg times concentration units. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! register_oil_tracer. -! (out) names - the names of the stocks calculated. -! (out) units - the units of the stocks calculated. -! (in,opt) stock_index - the coded index of a specific stock being sought. -! Return value: the number of stocks calculated here. - + ! Local variables integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -572,6 +523,7 @@ subroutine oil_tracer_surface_state(state, h, G, CS) end subroutine oil_tracer_surface_state +!> Deallocate memory associated with this tracer package subroutine oil_tracer_end(CS) type(oil_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_oil_tracer. From dca8669bf8c871f3bd6d35d2348a0a2d88874f8d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 09:45:35 -0400 Subject: [PATCH 0516/1072] dOyxgenization of types in pseudo_salt_tracer.F90 dOxyGenized comments describing types, the elements of types, and routines in pseudo_salt_tracer.F90. Also removed duplicate older-style argument documentation comments. All answers are bitwise identical. --- src/tracer/pseudo_salt_tracer.F90 | 101 ++++++++---------------------- 1 file changed, 26 insertions(+), 75 deletions(-) diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index ba7f1d588c..66e38f24aa 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -67,26 +67,28 @@ module pseudo_salt_tracer public pseudo_salt_tracer_column_physics, pseudo_salt_tracer_surface_state public pseudo_salt_stock, pseudo_salt_tracer_end +!> The control structure for the pseudo-salt tracer type, public :: pseudo_salt_tracer_CS ; private - type(time_type), pointer :: Time => NULL() ! A pointer to the ocean model's clock. - type(tracer_registry_type), pointer :: tr_Reg => NULL() - real, pointer :: ps(:,:,:) => NULL() ! The array of pseudo-salt tracer used in this - ! subroutine, in psu - real, pointer :: diff(:,:,:) => NULL() ! The difference between the pseudo-salt - ! tracer and the real salt, in psu. - logical :: pseudo_salt_may_reinit = .true. ! Hard coding since this should not matter + type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. + type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the MOM tracer registry + real, pointer :: ps(:,:,:) => NULL() !< The array of pseudo-salt tracer used in this + !! subroutine, in psu + real, pointer :: diff(:,:,:) => NULL() !< The difference between the pseudo-salt + !! tracer and the real salt, in psu. + logical :: pseudo_salt_may_reinit = .true. !< Hard coding since this should not matter - integer :: id_psd = -1 + integer :: id_psd = -1 !< A diagnostic ID - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. - type(MOM_restart_CS), pointer :: restart_CSp => NULL() + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. + type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure - type(vardesc) :: tr_desc + type(vardesc) :: tr_desc !< A description and metadata for the pseudo-salt tracer end type pseudo_salt_tracer_CS contains +!> Register the pseudo-salt tracer with MOM6 function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -99,22 +101,14 @@ function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure ! This subroutine is used to register tracer fields and subroutines ! to be used with MOM. -! Arguments: HI - A horizontal index type structure. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module -! (in/out) tr_Reg - A pointer that is set to point to the control structure -! for the tracer advection and diffusion module. -! (in) restart_CS - A pointer to the restart control structure. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! Local variables character(len=40) :: mdl = "pseudo_salt_tracer" ! This module's name. character(len=200) :: inputdir ! The directory where the input files are. character(len=48) :: var_name ! The variable's name. character(len=3) :: name_tag ! String for creating identifying pseudo_salt +! This include declares and sets the variable "version". +#include "version_variable.h" real, pointer :: tr_ptr(:,:,:) => NULL() logical :: register_pseudo_salt_tracer integer :: isd, ied, jsd, jed, nz, i, j @@ -150,6 +144,7 @@ function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) end function register_pseudo_salt_tracer +!> Initialize the pseudo-salt tracer subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, & sponge_CSp, diag_to_Z_CSp, tv) logical, intent(in) :: restart !< .true. if the fields have already @@ -172,21 +167,7 @@ subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables ! This subroutine initializes the tracer fields in CS%ps(:,:,:). -! Arguments: restart - .true. if the fields have already been read from -! a restart file. -! (in) day - Time of the start of the run. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) h - Layer thickness, in m or kg m-2. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in) OBC - This open boundary condition type specifies whether, where, -! and what open boundary conditions are used. -! (in/out) CS - The control structure returned by a previous call to -! register_pseudo_salt_tracer. -! (in/out) sponge_CSp - A pointer to the control structure for the sponges, if -! they are in use. Otherwise this may be unassociated. -! (in/out) diag_to_Z_Csp - A pointer to the control structure for diagnostics -! in depth space. + ! Local variables character(len=16) :: name ! A variable's name in a NetCDF file. character(len=72) :: longname ! The long name of that variable. character(len=48) :: units ! The dimensions of the variable. @@ -223,6 +204,7 @@ subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, end subroutine initialize_pseudo_salt_tracer +!> Apply sources, sinks and diapycnal diffusion to the tracers in this package. subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, tv, debug, & evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -253,34 +235,11 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G ! This subroutine applies diapycnal diffusion and any other column ! tracer physics or chemistry to the tracers from this file. -! This is a simple example of a set of advected passive tracers. - -! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2. -! (in) h_new - Layer thickness after entrainment, in m or kg m-2. -! (in) ea - an array to which the amount of fluid entrained -! from the layer above during this call will be -! added, in m or kg m-2. -! (in) eb - an array to which the amount of fluid entrained -! from the layer below during this call will be -! added, in m or kg m-2. -! (in) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) dt - The amount of time covered by this call, in s. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! register_pseudo_salt_tracer. -! (in) tv - Thermodynamic structure with T and S -! (in) evap_CFL_limit - Limits how much water can be fluxed out of the top layer -! Stored previously in diabatic CS. -! (in) minimum_forcing_depth - The smallest depth over which fluxes can be applied -! Stored previously in diabatic CS. -! (in) debug - Calculates checksums -! + ! The arguments to this subroutine are redundant in that ! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] - real :: Isecs_per_year = 1.0 / (365.0*86400.0) + ! Local variables real :: year, h_total, scale, htot, Ih_limit integer :: secs, days integer :: i, j, k, is, ie, js, je, nz, k_max @@ -321,6 +280,9 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G end subroutine pseudo_salt_tracer_column_physics + +!> Calculates the mass-weighted integral of all tracer stocks, returning the number of stocks it has +!! calculated. If the stock_index is present, only the stock corresponding to that coded index is returned. function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -340,18 +302,6 @@ function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index) ! returning the number of stocks it has calculated. If the stock_index ! is present, only the stock corresponding to that coded index is returned. -! Arguments: h - Layer thickness, in m or kg m-2. -! (out) stocks - the mass-weighted integrated amount of each tracer, -! in kg times concentration units. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! register_pseudo_salt_tracer. -! (out) names - the names of the stocks calculated. -! (out) units - the units of the stocks calculated. -! (in,opt) stock_index - the coded index of a specific stock being sought. -! Return value: the number of stocks calculated here. - integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -404,6 +354,7 @@ subroutine pseudo_salt_tracer_surface_state(state, h, G, CS) end subroutine pseudo_salt_tracer_surface_state +!> Deallocate memory associated with this tracer package subroutine pseudo_salt_tracer_end(CS) type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_pseudo_salt_tracer. From de4dddfbc3db55575af0f3735bb00adf17adb251 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 09:45:51 -0400 Subject: [PATCH 0517/1072] dOyxgenization of types in tracer_example.F90 dOxyGenized comments describing types, the elements of types, and routines in tracer_example.F90. Also removed duplicate older-style argument documentation comments. All answers are bitwise identical. --- src/tracer/tracer_example.F90 | 38 ++++++++++++++++------------------- 1 file changed, 17 insertions(+), 21 deletions(-) diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 08ab1a9b13..e7869214dd 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -62,32 +62,28 @@ module USER_tracer_example ! NTR is the number of tracers in this module. integer, parameter :: NTR = 1 +!> The control structure for the USER_tracer_example module type, public :: USER_tracer_example_CS ; private - logical :: coupled_tracers = .false. ! These tracers are not offered to the - ! coupler. - character(len=200) :: tracer_IC_file ! The full path to the IC file, or " " - ! to initialize internally. - type(time_type), pointer :: Time => NULL() ! A pointer to the ocean model's clock. - type(tracer_registry_type), pointer :: tr_Reg => NULL() - real, pointer :: tr(:,:,:,:) => NULL() ! The array of tracers used in this - ! subroutine, in g m-3? - real :: land_val(NTR) = -1.0 ! The value of tr used where land is masked out. - logical :: use_sponge ! If true, sponges may be applied somewhere in the domain. - - integer, dimension(NTR) :: ind_tr ! Indices returned by aof_set_coupler_flux - ! if it is used and the surface tracer concentrations are to be - ! provided to the coupler. - - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. - - type(vardesc) :: tr_desc(NTR) + logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler. + character(len=200) :: tracer_IC_file !< The full path to the IC file, or " " + !! to initialize internally. + type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. + type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry + real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3? + real :: land_val(NTR) = -1.0 !< The value of tr that is used where land is masked out. + logical :: use_sponge !< If true, sponges may be applied somewhere in the domain. + + integer, dimension(NTR) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and the + !! surface tracer concentrations are to be provided to the coupler. + + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the timing of diagnostic output. + + type(vardesc) :: tr_desc(NTR) !< Descriptions of each of the tracers. end type USER_tracer_example_CS contains -!> This subroutine is used to register tracer fields and subroutines -!! to be used with MOM. +!> This subroutine is used to register tracer fields and subroutines to be used with MOM. function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure From 2685a3c4dcf51206af4f5bc7550ef7c2965f0b51 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 10:22:54 -0400 Subject: [PATCH 0518/1072] dOyxgenization of types in dyed_obc_tracer.F90 dOxyGenized comments describing types, the elements of types, and routines in dyed_obc_tracer.F90. All answers are bitwise identical. --- src/tracer/dyed_obc_tracer.F90 | 43 +++++++++++++++------------------- 1 file changed, 19 insertions(+), 24 deletions(-) diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index 866c38aecc..2e8da7299f 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -28,31 +28,28 @@ module dyed_obc_tracer public register_dyed_obc_tracer, initialize_dyed_obc_tracer public dyed_obc_tracer_column_physics, dyed_obc_tracer_end +!> The control structure for the dyed_obc tracer package type, public :: dyed_obc_tracer_CS ; private - integer :: ntr ! The number of tracers that are actually used. - logical :: coupled_tracers = .false. ! These tracers are not offered to the coupler. - character(len=200) :: tracer_IC_file ! The full path to the IC file, or " " - ! to initialize internally. - type(time_type), pointer :: Time => NULL() ! A pointer to the ocean model's clock. - type(tracer_registry_type), pointer :: tr_Reg => NULL() - real, pointer :: tr(:,:,:,:) => NULL() ! The array of tracers used in this - ! subroutine, in g m-3? - - integer, allocatable, dimension(:) :: & - ind_tr ! Indices returned by aof_set_coupler_flux if it is used and the - ! surface tracer concentrations are to be provided to the coupler. - - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. - type(MOM_restart_CS), pointer :: restart_CSp => NULL() - - type(vardesc), allocatable :: tr_desc(:) + integer :: ntr !< The number of tracers that are actually used. + logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler. + character(len=200) :: tracer_IC_file !< The full path to the IC file, or " " to initialize internally. + type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. + type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry + real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3? + + integer, allocatable, dimension(:) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and the + !! surface tracer concentrations are to be provided to the coupler. + + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. + type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure + + type(vardesc), allocatable :: tr_desc(:) !< Descriptions and metadata for the tracers end type dyed_obc_tracer_CS contains -!> This subroutine is used to register tracer fields and subroutines -!! to be used with MOM. +!> Register tracer fields and subroutines to be used with MOM. function register_dyed_obc_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -133,10 +130,8 @@ function register_dyed_obc_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) register_dyed_obc_tracer = .true. end function register_dyed_obc_tracer -!> This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:) -!! and it sets up the tracer output. -subroutine initialize_dyed_obc_tracer(restart, day, G, GV, h, diag, OBC, CS, & - diag_to_Z_CSp) +!> Initializes the CS%ntr tracer fields in tr(:,:,:,:) and sets up the tracer output. +subroutine initialize_dyed_obc_tracer(restart, day, G, GV, h, diag, OBC, CS, diag_to_Z_CSp) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure logical, intent(in) :: restart !< .true. if the fields have already From 4a94c557c2e5fc1b9e3fe42fef0517dc04c20d5e Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 9 Jul 2018 11:19:39 -0400 Subject: [PATCH 0519/1072] Doxumented the interp_CS type in regrid_interp.F90 --- src/ALE/regrid_interp.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/ALE/regrid_interp.F90 b/src/ALE/regrid_interp.F90 index fd445e7318..ec1259874f 100644 --- a/src/ALE/regrid_interp.F90 +++ b/src/ALE/regrid_interp.F90 @@ -18,6 +18,7 @@ module regrid_interp implicit none ; private +!> Control structure for regrid_interp module type, public :: interp_CS_type ; private !> The following parameter is only relevant when used with the target From 0c1398558e092e8cc0d5cc24459bfc61f066b2f0 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 9 Jul 2018 11:20:45 -0400 Subject: [PATCH 0520/1072] Doxumented coord_adapt.F90 - Control structure was not documented. - Cleaned up indenting of existing comments in set_adapt_params(). --- src/ALE/coord_adapt.F90 | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/ALE/coord_adapt.F90 b/src/ALE/coord_adapt.F90 index cf0d99d278..5b17c3b57c 100644 --- a/src/ALE/coord_adapt.F90 +++ b/src/ALE/coord_adapt.F90 @@ -12,6 +12,7 @@ module coord_adapt #include +!> Control structure for adaptive coordinates (coord_adapt). type, public :: adapt_CS ; private !> Number of layers/levels @@ -77,15 +78,15 @@ subroutine set_adapt_params(CS, adaptTimeRatio, adaptAlpha, adaptZoom, adaptZoom type(adapt_CS), pointer :: CS !< The control structure for this module real, optional, intent(in) :: adaptTimeRatio !< Ratio of optimisation and diffusion timescales real, optional, intent(in) :: adaptAlpha !< Nondimensional coefficient determining - !! how much optimisation to apply + !! how much optimisation to apply real, optional, intent(in) :: adaptZoom !< Near-surface zooming depth, in m real, optional, intent(in) :: adaptZoomCoeff !< Near-surface zooming coefficient real, optional, intent(in) :: adaptBuoyCoeff !< Stratification-dependent diffusion coefficient real, optional, intent(in) :: adaptDrho0 !< Reference density difference for - !! stratification-dependent diffusion + !! stratification-dependent diffusion logical, optional, intent(in) :: adaptDoMin !< If true, form a HYCOM1-like mixed layer by - !! preventing interfaces from becoming shallower than - !! the depths set by coordinateResolution + !! preventing interfaces from becoming shallower than + !! the depths set by coordinateResolution if (.not. associated(CS)) call MOM_error(FATAL, "set_adapt_params: CS not associated") From 1bcd141b00d35bbb68780f25010cf50ac2ba7ca1 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 9 Jul 2018 11:22:27 -0400 Subject: [PATCH 0521/1072] Removed unused parameters in regrid_consts.F90 - Removed unused parameters - Doxumented enumerated constants and two interfaces --- src/ALE/regrid_consts.F90 | 35 ++++++++++++----------------------- 1 file changed, 12 insertions(+), 23 deletions(-) diff --git a/src/ALE/regrid_consts.F90 b/src/ALE/regrid_consts.F90 index cf5623c754..7e8edea344 100644 --- a/src/ALE/regrid_consts.F90 +++ b/src/ALE/regrid_consts.F90 @@ -8,20 +8,19 @@ module regrid_consts implicit none ; public -integer, parameter :: REGRIDDING_NUM_TYPES = 2 - ! List of regridding types. These should be consecutive and starting at 1. ! This allows them to be used as array indices. -integer, parameter :: REGRIDDING_LAYER = 1 !< Layer mode -integer, parameter :: REGRIDDING_ZSTAR = 2 !< z* coordinates -integer, parameter :: REGRIDDING_RHO = 3 !< Target interface densities -integer, parameter :: REGRIDDING_SIGMA = 4 !< Sigma coordinates -integer, parameter :: REGRIDDING_ARBITRARY = 5 !< Arbitrary coordinates +integer, parameter :: REGRIDDING_LAYER = 1 !< Layer mode identifier +integer, parameter :: REGRIDDING_ZSTAR = 2 !< z* coordinates identifier +integer, parameter :: REGRIDDING_RHO = 3 !< Density coordinates identifier +integer, parameter :: REGRIDDING_SIGMA = 4 !< Sigma coordinates identifier +integer, parameter :: REGRIDDING_ARBITRARY = 5 !< Arbitrary coordinates identifier integer, parameter :: REGRIDDING_HYCOM1 = 6 !< Simple HyCOM coordinates without BBL -integer, parameter :: REGRIDDING_SLIGHT = 7 !< Stretched coordinates in the -integer, parameter :: REGRIDDING_SIGMA_SHELF_ZSTAR = 8 !< z* coordinates at the bottom, sigma-near the top +integer, parameter :: REGRIDDING_SLIGHT = 7 !< Identifier for stretched coordinates in the !! lightest water, isopycnal below -integer, parameter :: REGRIDDING_ADAPTIVE = 9 +integer, parameter :: REGRIDDING_SIGMA_SHELF_ZSTAR = 8 !< Identifiered for z* coordinates at the bottom, + !! sigma-near the top +integer, parameter :: REGRIDDING_ADAPTIVE = 9 !< Adaptive coordinate mode identifier character(len=*), parameter :: REGRIDDING_LAYER_STRING = "LAYER" !< Layer string character(len=*), parameter :: REGRIDDING_ZSTAR_STRING_OLD = "Z*" !< z* string (legacy name) @@ -32,26 +31,16 @@ module regrid_consts character(len=*), parameter :: REGRIDDING_HYCOM1_STRING = "HYCOM1" !< Hycom string character(len=*), parameter :: REGRIDDING_SLIGHT_STRING = "SLIGHT" !< Hybrid S-rho string character(len=*), parameter :: REGRIDDING_SIGMA_SHELF_ZSTAR_STRING = "SIGMA_SHELF_ZSTAR" !< Hybrid z*/sigma -character(len=*), parameter :: REGRIDDING_ADAPTIVE_STRING = "ADAPTIVE" +character(len=*), parameter :: REGRIDDING_ADAPTIVE_STRING = "ADAPTIVE" !< Adaptive coordinate string character(len=*), parameter :: DEFAULT_COORDINATE_MODE = REGRIDDING_LAYER_STRING !< Default coordinate mode -integer, dimension(REGRIDDING_NUM_TYPES), parameter :: vertical_coords = & - (/ REGRIDDING_LAYER, REGRIDDING_ZSTAR /) - !(/ REGRIDDING_LAYER, REGRIDDING_ZSTAR, REGRIDDING_RHO, & - ! REGRIDDING_SIGMA, REGRIDDING_ARBITRARY, & - ! REGRIDDING_HYCOM1, REGRIDDING_SLIGHT /) - -character(len=*), dimension(REGRIDDING_NUM_TYPES), parameter :: vertical_coord_strings = & - (/ REGRIDDING_LAYER_STRING, REGRIDDING_ZSTAR_STRING /) - !(/ REGRIDDING_LAYER_STRING, REGRIDDING_ZSTAR_STRING, REGRIDDING_RHO_STRING, & - ! REGRIDDING_SIGMA_STRING, REGRIDDING_ARBITRARY_STRING, & - ! REGRIDDING_HYCOM1_STRING, REGRIDDING_SLIGHT_STRING /) - +!> Returns a string with the coordinate units associated with the coordinate mode. interface coordinateUnits module procedure coordinateUnitsI module procedure coordinateUnitsS end interface +!> Returns true if the coordinate is dependent on the state density, returns false otherwise. interface state_dependent module procedure state_dependent_char module procedure state_dependent_int From c409c4074b7348a2ca0dd5ed47c1be1cc610c699 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 9 Jul 2018 11:19:01 -0400 Subject: [PATCH 0522/1072] Doxumented variables in MOM_regridding.F90 - Variables/pointers within the regridding control structure were not documented. --- src/ALE/MOM_regridding.F90 | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index ebe8b93bf6..9f756346bf 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -51,6 +51,8 @@ module MOM_regridding !! target_density(k+1) = coordinateResolution(k) + coordinateResolution(k) !! It is only used in "rho" mode. real, dimension(:), allocatable :: target_density + + !> A flag to indicate that the target_density arrays has been filled with data. logical :: target_density_set = .false. !> This array is set by function set_regrid_max_depths() @@ -104,12 +106,12 @@ module MOM_regridding !! If false, integrate from the bottom upward, as does the rest of the model. logical :: integrate_downward_for_e = .true. - type(zlike_CS), pointer :: zlike_CS => null() - type(sigma_CS), pointer :: sigma_CS => null() - type(rho_CS), pointer :: rho_CS => null() - type(hycom_CS), pointer :: hycom_CS => null() - type(slight_CS), pointer :: slight_CS => null() - type(adapt_CS), pointer :: adapt_CS => null() + type(zlike_CS), pointer :: zlike_CS => null() !< Control structure for z-like coordinate generator + type(sigma_CS), pointer :: sigma_CS => null() !< Control structure for sigma coordinate generator + type(rho_CS), pointer :: rho_CS => null() !< Control structure for rho coordinate generator + type(hycom_CS), pointer :: hycom_CS => null() !< Control structure for hybrid coordinate generator + type(slight_CS), pointer :: slight_CS => null() !< Control structure for Slight-coordinate generator + type(adapt_CS), pointer :: adapt_CS => null() !< Control structure for adaptive coordinate generator end type @@ -137,7 +139,7 @@ module MOM_regridding " SLIGHT - stretched coordinates above continuous isopycnal\n"//& " ADAPTIVE - optimize for smooth neutral density surfaces" -! Documentation for regridding interpolation schemes +!> Documentation for regridding interpolation schemes character(len=*), parameter, public :: regriddingInterpSchemeDoc = & " P1M_H2 (2nd-order accurate)\n"//& " P1M_H4 (2nd-order accurate)\n"//& @@ -149,8 +151,12 @@ module MOM_regridding " P3M_IH6IH5 (4th-order accurate)\n"//& " PQM_IH4IH3 (4th-order accurate)\n"//& " PQM_IH6IH5 (5th-order accurate)" + +!> Default interpolation scheme character(len=*), parameter, public :: regriddingDefaultInterpScheme = "P1M_H2" +!> Default mode for boundary extrapolation logical, parameter, public :: regriddingDefaultBoundaryExtrapolation = .false. +!> Default minimum thickness for some coordinate generation modes real, parameter, public :: regriddingDefaultMinThickness = 1.e-3 #undef __DO_SAFETY_CHECKS__ From fe0b05ef4c804a20f8d0f5bb162b9dc83b51c406 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 9 Jul 2018 13:18:13 -0400 Subject: [PATCH 0523/1072] Doxumented BFB_surface_forcing.F90 and BFB_initialization.F90 - Doxumented types and functions. - Noted use of module data! Flagged with \todo --- src/user/BFB_initialization.F90 | 29 ++------ src/user/BFB_surface_forcing.F90 | 114 ++++++++----------------------- 2 files changed, 33 insertions(+), 110 deletions(-) diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index f68c6722c1..972c475683 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -1,27 +1,8 @@ +!> Initialization of the boundary-forced-basing configuration module BFB_initialization ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, April 1994 - June 2002 * -!* * -!* This subroutine initializes the fields for the simulations. * -!* The one argument passed to initialize, Time, is set to the * -!* current time of the simulation. The fields which are initialized * -!* here are: * -!* G%g_prime - The reduced gravity at each interface, in m s-2. * -!* G%Rlay - Layer potential density (coordinate variable) in kg m-3.* -!* If SPONGE is defined: * -!* A series of subroutine calls are made to set up the damping * -!* rates and reference profiles for all variables that are damped * -!* in the sponge. * -!* * -!* These variables are all set in the set of subroutines (in this * -!* file) BFB_initialize_sponges_southonly and BFB_set_coord. * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories @@ -38,6 +19,8 @@ module BFB_initialization public BFB_set_coord public BFB_initialize_sponges_southonly +!> Unsafe model variable +!! \todo Remove this module variable logical :: first_call = .true. contains @@ -54,8 +37,7 @@ subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(EOS_type), pointer :: eqn_of_state !< Integer that selects the !! equation of state. - - + ! Local variables real :: drho_dt, SST_s, T_bot, rho_top, rho_bot integer :: k, nz character(len=40) :: mdl = "BFB_set_coord" ! This subroutine's name. @@ -71,9 +53,6 @@ subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) rho_bot = GV%rho0 + drho_dt*T_bot nz = GV%ke - !call MOM_error(FATAL, & - ! "BFB_initialization.F90, BFB_set_coord: " // & - ! "Unmodified user routine called - you must edit the routine to use it") do k = 1,nz Rlay(k) = (rho_bot - rho_top)/(nz-1)*real(k-1) + rho_top if (k >1) then diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 6e189c5f04..27168618be 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -1,20 +1,8 @@ +!> Surface forcing for the boundary-forced-basin (BFB) configuration module BFB_surface_forcing ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* Rewritten by Robert Hallberg, June 2009 * -!* * -!* This file contains subroutines for specifying surface buoyancy * -!* forcing for the buoyancy-forced basin (BFB) case. * -!* BFB_buoyancy_forcing is used to restore the surface buoayncy to * -!* a linear meridional ramp of temperature. The extent of the ramp * -!* can be specified by LFR_SLAT (linear forcing ramp southern * -!* latitude) and LFR_NLAT. The temperatures at these edges of the * -!* ramp can be specified by SST_S and SST_N. * -!* * -!********+*********+*********+*********+*********+*********+*********+** use MOM_diag_mediator, only : post_data, query_averaging_enabled use MOM_diag_mediator, only : register_diag_field, diag_ctrl use MOM_domains, only : pass_var, pass_vector, AGRID @@ -33,42 +21,38 @@ module BFB_surface_forcing public BFB_buoyancy_forcing, BFB_surface_forcing_init +!> Control structure for BFB_surface_forcing type, public :: BFB_surface_forcing_CS ; private - ! This control structure should be used to store any run-time variables - ! associated with the user-specified forcing. It can be readily modified - ! for a specific case, and because it is private there will be no changes - ! needed in other code (although they will have to be recompiled). - ! The variables in the cannonical example are used for some common - ! cases, but do not need to be used. - logical :: use_temperature ! If true, temperature and salinity are used as - ! state variables. - logical :: restorebuoy ! If true, use restoring surface buoyancy forcing. - real :: Rho0 ! The density used in the Boussinesq - ! approximation, in kg m-3. - real :: G_Earth ! The gravitational acceleration in m s-2. - real :: Flux_const ! The restoring rate at the surface, in m s-1. - real :: gust_const ! A constant unresolved background gustiness - ! that contributes to ustar, in Pa. - real :: SST_s ! SST at the southern edge of the linear - ! forcing ramp - real :: SST_n ! SST at the northern edge of the linear - ! forcing ramp - real :: lfrslat ! Southern latitude where the linear forcing ramp - ! begins - real :: lfrnlat ! Northern latitude where the linear forcing ramp - ! ends - real :: drho_dt ! Rate of change of density with temperature. - ! Note that temperature is being used as a dummy - ! variable here. All temperatures are converted - ! into density. - - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. + logical :: use_temperature !< If true, temperature and salinity are used as + !! state variables. + logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. + real :: Rho0 !< The density used in the Boussinesq + !! approximation, in kg m-3. + real :: G_Earth !< The gravitational acceleration in m s-2. + real :: Flux_const !< The restoring rate at the surface, in m s-1. + real :: gust_const !< A constant unresolved background gustiness + !! that contributes to ustar, in Pa. + real :: SST_s !< SST at the southern edge of the linear + !! forcing ramp + real :: SST_n !< SST at the northern edge of the linear + !! forcing ramp + real :: lfrslat !< Southern latitude where the linear forcing ramp + !! begins + real :: lfrnlat !< Northern latitude where the linear forcing ramp + !! ends + real :: drho_dt !< Rate of change of density with temperature. + !! Note that temperature is being used as a dummy + !! variable here. All temperatures are converted + !! into density. + + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. end type BFB_surface_forcing_CS contains +!> Bouyancy forcing for the boundary-forced-basin (BFB) configuration subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) type(surface), intent(inout) :: state !< A structure containing fields that !! describe the surface state of the ocean. @@ -82,32 +66,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) type(BFB_surface_forcing_CS), pointer :: CS !< A pointer to the control structure !! returned by a previous call to !! BFB_surface_forcing_init. - -! This subroutine specifies the current surface fluxes of buoyancy or -! temperature and fresh water. It may also be modified to add -! surface fluxes of user provided tracers. - -! When temperature is used, there are long list of fluxes that need to be -! set - essentially the same as for a full coupled model, but most of these -! can be simply set to zero. The net fresh water flux should probably be -! set in fluxes%evap and fluxes%lprec, with any salinity restoring -! appearing in fluxes%vprec, and the other water flux components -! (fprec, lrunoff and frunoff) left as arrays full of zeros. -! Evap is usually negative and precip is usually positive. All heat fluxes -! are in W m-2 and positive for heat going into the ocean. All fresh water -! fluxes are in kg m-2 s-1 and positive for water moving into the ocean. - -! Arguments: state - A structure containing fields that describe the -! surface state of the ocean. -! (out) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) day_start - Start time of the fluxes. -! (in) day_interval - Length of time over which these fluxes -! will be applied. -! (in) G - The ocean's grid structure. -! (in) CS - A pointer to the control structure returned by a previous -! call to user_surface_forcing_init - + ! Local variables real :: Temp_restore ! The temperature that is being restored toward, in C. real :: Salin_restore ! The salinity that is being restored toward, in PSU. real :: density_restore ! The potential density that is being restored @@ -121,11 +80,6 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - ! When modifying the code, comment out this error message. It is here - ! so that the original (unmodified) version is not accidentally used. - ! call MOM_error(FATAL, "User_buoyancy_surface_forcing: " // & - ! "User forcing routine called without modification." ) - ! Allocate and zero out the forcing arrays, as necessary. This portion is ! usually not changed. if (CS%use_temperature) then @@ -144,9 +98,6 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) call safe_alloc_ptr(fluxes%buoy, isd, ied, jsd, jed) endif - - ! MODIFY THE CODE IN THE FOLLOWING LOOPS TO SET THE BUOYANCY FORCING TERMS. - if ( CS%use_temperature ) then ! Set whichever fluxes are to be used here. Any fluxes that ! are always zero do not need to be changed here. @@ -225,6 +176,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) end subroutine BFB_buoyancy_forcing +!> Initialization for forcing the boundary-forced-basin (BFB) configuration subroutine BFB_surface_forcing_init(Time, G, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -232,14 +184,6 @@ subroutine BFB_surface_forcing_init(Time, G, param_file, diag, CS) type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to !! regulate diagnostic output. type(BFB_surface_forcing_CS), pointer :: CS !< A pointer to the control structure for this module -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module - ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "BFB_surface_forcing" ! This module's name. From 6e42ac4bbefcde39a0031971eb63eb01426a8338 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 9 Jul 2018 13:27:54 -0400 Subject: [PATCH 0524/1072] Fixed doxygen errors for dyed-channel and dyed-OBCs - Doxumented module variable and noted with \todo that the module variable needs to be moved into a control structure. --- src/user/dyed_channel_initialization.F90 | 22 ++++++++++++---------- src/user/dyed_obcs_initialization.F90 | 8 +++++--- 2 files changed, 17 insertions(+), 13 deletions(-) diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90 index f777fb3288..133b5388cb 100644 --- a/src/user/dyed_channel_initialization.F90 +++ b/src/user/dyed_channel_initialization.F90 @@ -1,3 +1,4 @@ +!> Initialization for the dyed_channel configuration module dyed_channel_initialization ! This file is part of MOM6. See LICENSE.md for the license. @@ -23,24 +24,26 @@ module dyed_channel_initialization public dyed_channel_set_OBC_tracer_data, dyed_channel_OBC_end public register_dyed_channel_OBC, dyed_channel_update_flow -!> Control structure for tidal bay open boundaries. +!> Control structure for dyed-channel open boundaries. type, public :: dyed_channel_OBC_CS ; private real :: zonal_flow = 8.57 !< Mean inflow real :: tidal_amp = 0.0 !< Sloshing amplitude real :: frequency = 0.0 !< Sloshing frequency end type dyed_channel_OBC_CS -integer :: ntr = 0 +integer :: ntr = 0 !< Number of dye tracers + !! \todo This is a module variable. Move this variable into the control structure. contains !> Add dyed channel to OBC registry. function register_dyed_channel_OBC(param_file, CS, OBC_Reg) type(param_file_type), intent(in) :: param_file !< parameter file. - type(dyed_channel_OBC_CS), pointer :: CS !< tidal bay control structure. + type(dyed_channel_OBC_CS), pointer :: CS !< Dyed channel control structure. type(OBC_registry_type), pointer :: OBC_Reg !< OBC registry. + ! Local variables logical :: register_dyed_channel_OBC - character(len=32) :: casename = "dyed channel" !< This case's name. + character(len=32) :: casename = "dyed channel" ! This case's name. character(len=40) :: mdl = "register_dyed_channel_OBC" ! This subroutine's name. if (associated(CS)) then @@ -68,7 +71,7 @@ end function register_dyed_channel_OBC !> Clean up the dyed_channel OBC from registry. subroutine dyed_channel_OBC_end(CS) - type(dyed_channel_OBC_CS), pointer :: CS !< tidal bay control structure. + type(dyed_channel_OBC_CS), pointer :: CS !< Dyed channel control structure. if (associated(CS)) then deallocate(CS) @@ -85,8 +88,7 @@ subroutine dyed_channel_set_OBC_tracer_data(OBC, G, GV, param_file, tr_Reg) type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry. - -! Local variables + ! Local variables character(len=40) :: mdl = "dyed_channel_set_OBC_tracer_data" ! This subroutine's name. character(len=80) :: name, longname integer :: i, j, k, l, itt, isd, ied, jsd, jed, m, n @@ -133,11 +135,10 @@ subroutine dyed_channel_update_flow(OBC, CS, G, Time) type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary !! conditions are used. - type(dyed_channel_OBC_CS), pointer :: CS !< tidal bay control structure. + type(dyed_channel_OBC_CS), pointer :: CS !< Dyed channel control structure. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(time_type), intent(in) :: Time !< model time. - -! Local variables + ! Local variables character(len=40) :: mdl = "dyed_channel_update_flow" ! This subroutine's name. character(len=80) :: name real :: flow, time_sec, PI @@ -190,5 +191,6 @@ subroutine dyed_channel_update_flow(OBC, CS, G, Time) end subroutine dyed_channel_update_flow !> \namespace dyed_channel_initialization +!! !! Setting dyes, one for painting the inflow on each side. end module dyed_channel_initialization diff --git a/src/user/dyed_obcs_initialization.F90 b/src/user/dyed_obcs_initialization.F90 index 8a16510c6e..eed0f804b4 100644 --- a/src/user/dyed_obcs_initialization.F90 +++ b/src/user/dyed_obcs_initialization.F90 @@ -1,3 +1,4 @@ +!> Dyed open boundary conditions module dyed_obcs_initialization ! This file is part of MOM6. See LICENSE.md for the license. @@ -20,7 +21,8 @@ module dyed_obcs_initialization public dyed_obcs_set_OBC_data -integer :: ntr = 0 +integer :: ntr = 0 !< Number of dye tracers + !! \todo This is a module variable. Move this variable into the control structure. contains @@ -34,8 +36,7 @@ subroutine dyed_obcs_set_OBC_data(OBC, G, GV, param_file, tr_Reg) type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry. - -! Local variables + ! Local variables character(len=40) :: mdl = "dyed_obcs_set_OBC_data" ! This subroutine's name. character(len=80) :: name, longname integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, m, n, nz @@ -81,5 +82,6 @@ subroutine dyed_obcs_set_OBC_data(OBC, G, GV, param_file, tr_Reg) end subroutine dyed_obcs_set_OBC_data !> \namespace dyed_obcs_initialization +!! !! Setting dyes, one for painting the inflow on each side. end module dyed_obcs_initialization From 3fc81dc5f3d14984efcf5d0513b98b525cd928f6 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 9 Jul 2018 13:36:23 -0400 Subject: [PATCH 0525/1072] Fixed doxygen errors in ISOMIP_initialization.F90 - Legitimate module variable was non documented. - Cleaned some commenting style. --- src/user/ISOMIP_initialization.F90 | 36 +++++++----------------------- 1 file changed, 8 insertions(+), 28 deletions(-) diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 01ec3cbd0a..d0b87d518f 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -1,3 +1,4 @@ +!> Configures the ISOMIP test case. module ISOMIP_initialization ! This file is part of MOM6. See LICENSE.md for the license. @@ -23,39 +24,26 @@ module ISOMIP_initialization #include -! ----------------------------------------------------------------------------- -! Private (module-wise) parameters -! ----------------------------------------------------------------------------- +character(len=40) :: mdl = "ISOMIP_initialization" !< This module's name. -character(len=40) :: mdl = "ISOMIP_initialization" ! This module's name. - -! ----------------------------------------------------------------------------- ! The following routines are visible to the outside world -! ----------------------------------------------------------------------------- public ISOMIP_initialize_topography public ISOMIP_initialize_thickness public ISOMIP_initialize_temperature_salinity public ISOMIP_initialize_sponges -! ----------------------------------------------------------------------------- -! This module contains the following routines -! ----------------------------------------------------------------------------- contains -!> Initialization of topography +!> Initialization of topography for the ISOMIP configuration subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(out) :: D !< Ocean bottom depth in m type(param_file_type), intent(in) :: param_file !< Parameter file structure real, intent(in) :: max_depth !< Maximum depth of model in m - -! This subroutine sets up the ISOMIP topography + ! Local variables real :: min_depth ! The minimum and maximum depths in m. - -! The following variables are used to set up the bathymetry in the ISOMIP example. -! check this paper: http://www.geosci-model-dev-discuss.net/8/9859/2015/gmdd-8-9859-2015.pdf - + ! The following variables are used to set up the bathymetry in the ISOMIP example. real :: bmax ! max depth of bedrock topography real :: b0,b2,b4,b6 ! first, second, third and fourth bedrock topography coeff real :: xbar ! characteristic along-flow lenght scale of the bedrock @@ -65,9 +53,6 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth) real :: ly ! domain width (across ice flow) real :: bx, by, xtil ! dummy vatiables logical :: is_2D ! If true, use 2D setup - -! G%ieg and G%jeg are the last indices in the global domain - ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "ISOMIP_initialize_topography" ! This subroutine's name. @@ -75,7 +60,6 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - call MOM_mesg(" ISOMIP_initialization.F90, ISOMIP_initialize_topography: setting topography", 5) call log_version(param_file, mdl, version, "") @@ -83,7 +67,7 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth) "The minimum depth of the ocean.", units="m", default=0.0) call get_param(param_file, mdl, "ISOMIP_2D",is_2D,'If true, use a 2D setup.', default=.false.) -! The following variables should be transformed into runtime parameters? + ! The following variables should be transformed into runtime parameters? bmax=720.0; b0=-150.0; b2=-728.8; b4=343.91; b6=-50.57 xbar=300.0E3; dc=500.0; fc=4.0E3; wc=24.0E3; ly=80.0E3 bx = 0.0; by = 0.0; xtil = 0.0 @@ -131,7 +115,6 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth) endif end subroutine ISOMIP_initialize_topography -! ----------------------------------------------------------------------------- !> Initialization of thicknesses subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_params) @@ -146,7 +129,6 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par !! the eqn. of state. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - ! Local variables real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! ! negative because it is positive upward. ! @@ -264,7 +246,6 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing T & S. - ! Local variables integer :: i, j, k, is, ie, js, je, nz, itt real :: x, ds, dt, rho_sur, rho_bot @@ -440,8 +421,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) logical, intent(in) :: use_ALE !< If true, indicates model is in ALE mode type(sponge_CS), pointer :: CSp !< Layer-mode sponge structure type(ALE_sponge_CS), pointer :: ACSp !< ALE-mode sponge structure - -! Local variables + ! Local variables real :: T(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for temp real :: S(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for salt real :: RHO(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for RHO @@ -680,5 +660,5 @@ end subroutine ISOMIP_initialize_sponges !> \namespace isomip_initialization !! -!! The module configures the ISOMIP test case. +!! See this paper for details: http://www.geosci-model-dev-discuss.net/8/9859/2015/gmdd-8-9859-2015.pdf end module ISOMIP_initialization From ef8c3906e62624d985681b7940298bfca9ed5186 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 9 Jul 2018 13:43:18 -0400 Subject: [PATCH 0526/1072] Document mdl module variable in src/user cases - Five files had undocumented module variable "mdl". - Tidied up some comments. --- src/user/SCM_CVmix_tests.F90 | 5 ++--- src/user/SCM_idealized_hurricane.F90 | 2 +- src/user/seamount_initialization.F90 | 7 +------ src/user/shelfwave_initialization.F90 | 4 +--- src/user/sloshing_initialization.F90 | 8 +------- 5 files changed, 6 insertions(+), 20 deletions(-) diff --git a/src/user/SCM_CVmix_tests.F90 b/src/user/SCM_CVmix_tests.F90 index a0f984ed09..2f2026c848 100644 --- a/src/user/SCM_CVmix_tests.F90 +++ b/src/user/SCM_CVmix_tests.F90 @@ -1,5 +1,4 @@ -!> Initial conditions and forcing for the single column model (SCM) CVMix -!! test set. +!> Initial conditions and forcing for the single column model (SCM) CVMix test set. module SCM_CVMix_tests ! This file is part of MOM6. See LICENSE.md for the license. @@ -42,7 +41,7 @@ module SCM_CVMix_tests ! This include declares and sets the variable "version". #include "version_variable.h" -character(len=40) :: mdl = "SCM_CVMix_tests" ! This module's name. +character(len=40) :: mdl = "SCM_CVMix_tests" !< This module's name. contains diff --git a/src/user/SCM_idealized_hurricane.F90 b/src/user/SCM_idealized_hurricane.F90 index 3d63f9bae4..f688c40ec6 100644 --- a/src/user/SCM_idealized_hurricane.F90 +++ b/src/user/SCM_idealized_hurricane.F90 @@ -40,7 +40,7 @@ module SCM_idealized_hurricane ! This include declares and sets the variable "version". #include "version_variable.h" -character(len=40) :: mdl = "SCM_idealized_hurricane" ! This module's name. +character(len=40) :: mdl = "SCM_idealized_hurricane" !< This module's name. contains diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 017a36bc9a..0b54325e1b 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -21,18 +21,13 @@ module seamount_initialization #include -character(len=40) :: mdl = "seamount_initialization" ! This module's name. +character(len=40) :: mdl = "seamount_initialization" !< This module's name. -! ----------------------------------------------------------------------------- ! The following routines are visible to the outside world -! ----------------------------------------------------------------------------- public seamount_initialize_topography public seamount_initialize_thickness public seamount_initialize_temperature_salinity -! ----------------------------------------------------------------------------- -! This module contains the following routines -! ----------------------------------------------------------------------------- contains !> Initialization of topography. diff --git a/src/user/shelfwave_initialization.F90 b/src/user/shelfwave_initialization.F90 index 428cda4574..e8c2f0ee47 100644 --- a/src/user/shelfwave_initialization.F90 +++ b/src/user/shelfwave_initialization.F90 @@ -16,11 +16,9 @@ module shelfwave_initialization #include -character(len=40) :: mdl = "shelfwave_initialization" ! This module's name. +character(len=40) :: mdl = "shelfwave_initialization" !< This module's name. -! ----------------------------------------------------------------------------- ! The following routines are visible to the outside world -! ----------------------------------------------------------------------------- public shelfwave_initialize_topography public shelfwave_set_OBC_data public register_shelfwave_OBC, shelfwave_OBC_end diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index 14f31e6916..891641bb13 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -18,18 +18,13 @@ module sloshing_initialization #include -! ----------------------------------------------------------------------------- ! The following routines are visible to the outside world -! ----------------------------------------------------------------------------- public sloshing_initialize_topography public sloshing_initialize_thickness public sloshing_initialize_temperature_salinity -character(len=40) :: mdl = "sloshing_initialization" ! This module's name. +character(len=40) :: mdl = "sloshing_initialization" !< This module's name. -! ----------------------------------------------------------------------------- -! This module contains the following routines -! ----------------------------------------------------------------------------- contains !> Initialization of topography. @@ -176,7 +171,6 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param end subroutine sloshing_initialize_thickness -!------------------------------------------------------------------------------ !> Initialization of temperature and salinity !! !! This subroutine initializes linear profiles for T and S according to From ca6f2317f82204c604d95e6ec7471417ae7e11c4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 13:47:23 -0400 Subject: [PATCH 0527/1072] dOyxgenization of interfaces in MOM_TFreeze.F90 dOxyGenized comments describing the overloaded public interfaces in MOM_TFreeze.F90. Also removed duplicate older-style argument documentation comments. All answers are bitwise identical. --- src/equation_of_state/MOM_TFreeze.F90 | 95 ++++++--------------------- 1 file changed, 21 insertions(+), 74 deletions(-) diff --git a/src/equation_of_state/MOM_TFreeze.F90 b/src/equation_of_state/MOM_TFreeze.F90 index c662b7d961..9f3b47893c 100644 --- a/src/equation_of_state/MOM_TFreeze.F90 +++ b/src/equation_of_state/MOM_TFreeze.F90 @@ -12,21 +12,30 @@ module MOM_TFreeze public calculate_TFreeze_linear, calculate_TFreeze_Millero, calculate_TFreeze_teos10 +!> Compute the freezing point potential temperature (in deg C) from salinity (in psu) and +!! pressure (in Pa) using a simple linear expression, with coefficients passed in as arguments. interface calculate_TFreeze_linear module procedure calculate_TFreeze_linear_scalar, calculate_TFreeze_linear_array end interface calculate_TFreeze_linear +!> Compute the freezing point potential temperature (in deg C) from salinity (in psu) and +!! pressure (in Pa) using the expression from Millero (1978) (and in appendix A of Gill 1982), +!! but with the of the pressure dependence changed from 7.53e-8 to 7.75e-8 to make this an +!! expression for potential temperature (not in situ temperature), using a +!! value that is correct at the freezing point at 35 PSU and 5e6 Pa (500 dbar). interface calculate_TFreeze_Millero module procedure calculate_TFreeze_Millero_scalar, calculate_TFreeze_Millero_array end interface calculate_TFreeze_Millero +!> Compute the freezing point conservative temperature (in deg C) from absolute salinity (in g/kg) +!! and pressure (in Pa) using the TEOS10 package. interface calculate_TFreeze_teos10 module procedure calculate_TFreeze_teos10_scalar, calculate_TFreeze_teos10_array end interface calculate_TFreeze_teos10 contains -!> This subroutine computes the freezing point potential temparature +!> This subroutine computes the freezing point potential temperature !! (in deg C) from salinity (in psu), and pressure (in Pa) using a simple !! linear expression, with coefficients passed in as arguments. subroutine calculate_TFreeze_linear_scalar(S, pres, T_Fr, TFr_S0_P0, & @@ -40,24 +49,11 @@ subroutine calculate_TFreeze_linear_scalar(S, pres, T_Fr, TFr_S0_P0, & real, intent(in) :: dTFr_dp !< The derivative of freezing point with pressure, !! in deg C Pa-1. -! This subroutine computes the freezing point potential temparature -! (in deg C) from salinity (in psu), and pressure (in Pa) using a simple -! linear expression, with coefficients passed in as arguments. -! -! Arguments: S - salinity in PSU. -! (in) pres - pressure in Pa. -! (out) T_Fr - Freezing point potential temperature in deg C. -! (in) TFr_S0_P0 - The freezing point at S=0, p=0, in deg C. -! (in) dTFr_dS - The derivatives of freezing point with salinity, in -! deg C PSU-1. -! (in) dTFr_dp - The derivatives of freezing point with pressure, in -! deg C Pa-1. - T_Fr = (TFr_S0_P0 + dTFr_dS*S) + dTFr_dp*pres end subroutine calculate_TFreeze_linear_scalar -!> This subroutine computes an array of freezing point potential temparatures +!> This subroutine computes an array of freezing point potential temperatures !! (in deg C) from salinity (in psu), and pressure (in Pa) using a simple !! linear expression, with coefficients passed in as arguments. subroutine calculate_TFreeze_linear_array(S, pres, T_Fr, start, npts, & @@ -72,21 +68,6 @@ subroutine calculate_TFreeze_linear_array(S, pres, T_Fr, start, npts, & !! in deg C PSU-1. real, intent(in) :: dTFr_dp !< The derivative of freezing point with pressure, !! in deg C Pa-1. - -! This subroutine computes the freezing point potential temparature -! (in deg C) from salinity (in psu), and pressure (in Pa) using a simple -! linear expression, with coefficients passed in as arguments. -! -! Arguments: S - salinity in PSU. -! (in) pres - pressure in Pa. -! (out) T_Fr - Freezing point potential temperature in deg C. -! (in) start - the starting point in the arrays. -! (in) npts - the number of values to calculate. -! (in) TFr_S0_P0 - The freezing point at S=0, p=0, in deg C. -! (in) dTFr_dS - The derivative of freezing point with salinity, in -! deg C PSU-1. -! (in) dTFr_dp - The derivative of freezing point with pressure, in -! deg C Pa-1. integer :: j do j=start,start+npts-1 @@ -95,7 +76,7 @@ subroutine calculate_TFreeze_linear_array(S, pres, T_Fr, start, npts, & end subroutine calculate_TFreeze_linear_array -!> This subroutine computes the freezing point potential temparature +!> This subroutine computes the freezing point potential temperature !! (in deg C) from salinity (in psu), and pressure (in Pa) using the expression !! from Millero (1978) (and in appendix A of Gill 1982), but with the of the !! pressure dependence changed from 7.53e-8 to 7.75e-8 to make this an @@ -106,16 +87,7 @@ subroutine calculate_TFreeze_Millero_scalar(S, pres, T_Fr) real, intent(in) :: pres !< Pressure in Pa. real, intent(out) :: T_Fr !< Freezing point potential temperature in deg C. -! This subroutine computes the freezing point potential temparature -! (in deg C) from salinity (in psu), and pressure (in Pa) using the expression -! from Millero (1978) (and in appendix A of Gill 1982), but with the of the -! pressure dependence changed from 7.53e-8 to 7.75e-8 to make this an -! expression for potential temperature (not in situ temperature), using a -! value that is correct at the freezing point at 35 PSU and 5e6 Pa (500 dbar). -! -! Arguments: S - salinity in PSU. -! (in) pres - pressure in Pa. -! (out) T_Fr - Freezing point potential temperature in deg C. + ! Local variables real, parameter :: cS1 = -0.0575, cS3_2 = 1.710523e-3, cS2 = -2.154996e-4 real, parameter :: dTFr_dp = -7.75e-8 @@ -123,7 +95,7 @@ subroutine calculate_TFreeze_Millero_scalar(S, pres, T_Fr) end subroutine calculate_TFreeze_Millero_scalar -!> This subroutine computes the freezing point potential temparature +!> This subroutine computes the freezing point potential temperature !! (in deg C) from salinity (in psu), and pressure (in Pa) using the expression !! from Millero (1978) (and in appendix A of Gill 1982), but with the of the !! pressure dependence changed from 7.53e-8 to 7.75e-8 to make this an @@ -135,18 +107,8 @@ subroutine calculate_TFreeze_Millero_array(S, pres, T_Fr, start, npts) real, dimension(:), intent(out) :: T_Fr !< Freezing point potential temperature in deg C. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. -! This subroutine computes the freezing point potential temparature -! (in deg C) from salinity (in psu), and pressure (in Pa) using the expression -! from Millero (1978) (and in appendix A of Gill 1982), but with the of the -! pressure dependence changed from 7.53e-8 to 7.75e-8 to make this an -! expression for potential temperature (not in situ temperature), using a -! value that is correct at the freezing point at 35 PSU and 5e6 Pa (500 dbar). -! -! Arguments: S - salinity in PSU. -! (in) pres - pressure in Pa. -! (out) T_Fr - Freezing point potential temperature in deg C. -! (in) start - the starting point in the arrays. -! (in) npts - the number of values to calculate. + + ! Local variables real, parameter :: cS1 = -0.0575, cS3_2 = 1.710523e-3, cS2 = -2.154996e-4 real, parameter :: dTFr_dp = -7.75e-8 integer :: j @@ -158,20 +120,15 @@ subroutine calculate_TFreeze_Millero_array(S, pres, T_Fr, start, npts) end subroutine calculate_TFreeze_Millero_array -!> This subroutine computes the freezing point conservative temparature +!> This subroutine computes the freezing point conservative temperature !! (in deg C) from absolute salinity (in g/kg), and pressure (in Pa) using the !! TEOS10 package. subroutine calculate_TFreeze_teos10_scalar(S, pres, T_Fr) real, intent(in) :: S !< Absolute salinity in g/kg. real, intent(in) :: pres !< Pressure in Pa. real, intent(out) :: T_Fr !< Freezing point conservative temperature in deg C. -! This subroutine computes the freezing point conservative temparature -! (in deg C) from absolute salinity (in g/kg), and pressure (in Pa) using the -! TEOS10 package. -! -! Arguments: S - absolute salinity in g/kg. -! (in) pres - pressure in Pa. -! (out) T_Fr - Freezing point conservative temperature in deg C. + + ! Local variables real, dimension(1) :: S0, pres0 real, dimension(1) :: tfr0 @@ -183,7 +140,7 @@ subroutine calculate_TFreeze_teos10_scalar(S, pres, T_Fr) end subroutine calculate_TFreeze_teos10_scalar -!> This subroutine computes the freezing point conservative temparature +!> This subroutine computes the freezing point conservative temperature !! (in deg C) from absolute salinity (in g/kg), and pressure (in Pa) using the !! TEOS10 package. subroutine calculate_TFreeze_teos10_array(S, pres, T_Fr, start, npts) @@ -192,18 +149,9 @@ subroutine calculate_TFreeze_teos10_array(S, pres, T_Fr, start, npts) real, dimension(:), intent(out) :: T_Fr !< Freezing point conservative temperature in deg C. integer, intent(in) :: start !< the starting point in the arrays. integer, intent(in) :: npts !< the number of values to calculate. -! This subroutine computes the freezing point conservative temparature -! (in deg C) from absolute salinity (in g/kg), and pressure (in Pa) using the -! TEOS10 package. -! -! Arguments: S - absolute salinity in g/kg. -! (in) pres - pressure in Pa. -! (out) T_Fr - Freezing point conservative temperature in deg C. -! * (in) start - the starting point in the arrays. * -! * (in) npts - the number of values to calculate. * + ! Local variables real, parameter :: Pa2db = 1.e-4 ! The conversion factor from Pa to dbar. - real :: zs,zp integer :: j ! Assume sea-water contains no dissolved air. @@ -218,7 +166,6 @@ subroutine calculate_TFreeze_teos10_array(S, pres, T_Fr, start, npts) T_Fr(j) = gsw_ct_freezing_exact(zs,zp,saturation_fraction) enddo - end subroutine calculate_TFreeze_teos10_array end module MOM_TFreeze From 74247b64376a8ffa7c5f1fd51e25c3641c7e1227 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 13:47:55 -0400 Subject: [PATCH 0528/1072] dOyxgenization of interfaces in MOM_EOS_linear.F90 dOxyGenized comments describing the overloaded public interfaces in MOM_EOS_linear.F90. Also removed duplicate older-style argument documentation comments. All answers are bitwise identical. --- src/equation_of_state/MOM_EOS_linear.F90 | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90 index a204614ad2..7168e2f2f7 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -16,18 +16,29 @@ module MOM_EOS_linear public calculate_density_second_derivs_linear public int_density_dz_linear, int_spec_vol_dp_linear +!> Compute the density of sea water (in kg/m^3), or its anomaly from a reference density, +!! using a simple linear equation of state from salinity (in psu), potential temperature (in deg C) +!! and pressure in Pa. interface calculate_density_linear module procedure calculate_density_scalar_linear, calculate_density_array_linear end interface calculate_density_linear +!> Compute the specific volume of sea water (in m^3/kg), or its anomaly from a reference value, +!! using a simple linear equation of state from salinity (in psu), potential temperature (in deg C) +!! and pressure in Pa. interface calculate_spec_vol_linear module procedure calculate_spec_vol_scalar_linear, calculate_spec_vol_array_linear end interface calculate_spec_vol_linear +!> For a given thermodynamic state, return the derivatives of density with temperature and +!! salinity using the simple linear equation of state interface calculate_density_derivs_linear module procedure calculate_density_derivs_scalar_linear, calculate_density_derivs_array_linear end interface calculate_density_derivs_linear +!> For a given thermodynamic state, return the second derivatives of density with various +!! combinations of temperature, salinity, and pressure. Note that with a simple linear +!! equation of state these second derivatives are all 0. interface calculate_density_second_derivs_linear module procedure calculate_density_second_derivs_scalar_linear, calculate_density_second_derivs_array_linear end interface calculate_density_second_derivs_linear @@ -35,7 +46,7 @@ module MOM_EOS_linear contains !> This subroutine computes the density of sea water with a trivial -!! linear equation of state (in kg/m^3) from salinity (sal in psu), +!! linear equation of state (in kg m-3) from salinity (sal in PSU), !! potential temperature (T in deg C), and pressure in Pa. subroutine calculate_density_scalar_linear(T, S, pressure, rho, & Rho_T0_S0, dRho_dT, dRho_dS, rho_ref) From 8115d2059876faf38157cb54eb43cbc01e405bd7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 13:48:14 -0400 Subject: [PATCH 0529/1072] dOyxgenization of interfaces in MOM_EOS_Wright.F90 dOxyGenized comments describing the overloaded public interfaces in MOM_EOS_Wright.F90. Also removed duplicate older-style argument documentation comments. All answers are bitwise identical. --- src/equation_of_state/MOM_EOS_Wright.F90 | 72 ++++++++---------------- 1 file changed, 25 insertions(+), 47 deletions(-) diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index d136d7eeb4..b6b85d9542 100644 --- a/src/equation_of_state/MOM_EOS_Wright.F90 +++ b/src/equation_of_state/MOM_EOS_Wright.F90 @@ -19,18 +19,28 @@ module MOM_EOS_Wright public calculate_density_second_derivs_wright public int_density_dz_wright, int_spec_vol_dp_wright + +!> Compute the in situ density of sea water (in units of kg/m^3), or its anomaly with respect to +!! a reference density, from salinity (in psu), potential temperature (in deg C), and pressure in Pa, +!! using the expressions from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. interface calculate_density_wright module procedure calculate_density_scalar_wright, calculate_density_array_wright end interface calculate_density_wright +!> Compute the in situ specific volume of sea water (in units of m^3/kg), or an anomaly with respect +!! to a reference specific volume, from salinity (in psu), potential temperature (in deg C), and +!! pressure in Pa, using the expressions from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. interface calculate_spec_vol_wright module procedure calculate_spec_vol_scalar_wright, calculate_spec_vol_array_wright end interface calculate_spec_vol_wright +!> For a given thermodynamic state, return the derivatives of density with temperature and salinity interface calculate_density_derivs_wright module procedure calculate_density_derivs_scalar_wright, calculate_density_derivs_array_wright end interface +!> For a given thermodynamic state, return the second derivatives of density with various combinations +!! of temperature, salinity, and pressure interface calculate_density_second_derivs_wright module procedure calculate_density_second_derivs_scalar_wright, calculate_density_second_derivs_array_wright end interface @@ -99,6 +109,7 @@ subroutine calculate_density_array_wright(T, S, pressure, rho, start, npts, rho_ real, optional, intent(in) :: rho_ref !< A reference density in kg m-3. ! Original coded by R. Hallberg, 7/00, anomaly coded in 3/18. + ! Local variables real :: al0, p0, lambda real :: al_TS, p_TSp, lam_TS, pa_000 integer :: j @@ -135,6 +146,7 @@ subroutine calculate_spec_vol_scalar_wright(T, S, pressure, specvol, spv_ref) real, intent(out) :: specvol !< in situ specific volume in m3 kg-1. real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1. + ! Local variables real, dimension(1) :: T0, S0, pressure0, spv0 T0(1) = T ; S0(1) = S ; pressure0(1) = pressure @@ -158,6 +170,7 @@ subroutine calculate_spec_vol_array_wright(T, S, pressure, specvol, start, npts, integer, intent(in) :: npts !< the number of values to calculate. real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1. + ! Local variables real :: al0, p0, lambda integer :: j @@ -187,15 +200,7 @@ subroutine calculate_density_derivs_array_wright(T, S, pressure, drho_dT, drho_d integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. -! * Arguments: T - potential temperature relative to the surface in C. * -! * (in) S - salinity in PSU. * -! * (in) pressure - pressure in Pa. * -! * (out) drho_dT - the partial derivative of density with * -! * potential temperature, in kg m-3 K-1. * -! * (out) drho_dS - the partial derivative of density with * -! * salinity, in kg m-3 psu-1. * -! * (in) start - the starting point in the arrays. * -! * (in) npts - the number of values to calculate. * + ! Local variables real :: al0, p0, lambda, I_denom2 integer :: j @@ -254,10 +259,11 @@ subroutine calculate_density_second_derivs_array_wright(T, S, P, drho_ds_ds, drh integer, intent(in ) :: start !< Starting index in T,S,P integer, intent(in ) :: npts !< Number of points to loop over + ! Local variables + real :: z0, z1, z2, z3, z4, z5, z6 ,z7, z8, z9, z10, z11, z2_2, z2_3 integer :: j ! Based on the above expression with common terms factored, there probably exists a more numerically stable ! and/or efficient expression - real :: z0, z1, z2, z3, z4, z5, z6 ,z7, z8, z9, z10, z11, z2_2, z2_3 do j = start,start+npts-1 z0 = T(j)*(b1 + b5*S(j) + T(j)*(b2 + b3*T(j))) @@ -313,9 +319,10 @@ subroutine calculate_density_second_derivs_scalar_wright(T, S, P, drho_ds_ds, dr end subroutine calculate_density_second_derivs_scalar_wright +!> For a given thermodynamic state, return the partial derivatives of specific volume +!! with temperature and salinity subroutine calculate_specvol_derivs_wright(T, S, pressure, dSV_dT, dSV_dS, start, npts) - real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface - !! in C. + real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface in C. real, intent(in), dimension(:) :: S !< Salinity in g/kg. real, intent(in), dimension(:) :: pressure !< Pressure in Pa. real, intent(out), dimension(:) :: dSV_dT !< The partial derivative of specific volume with @@ -325,15 +332,7 @@ subroutine calculate_specvol_derivs_wright(T, S, pressure, dSV_dT, dSV_dS, start integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. -! * Arguments: T - potential temperature relative to the surface in C. * -! * (in) S - salinity in g/kg. * -! * (in) pressure - pressure in Pa. * -! * (out) dSV_dT - the partial derivative of specific volume with * -! * potential temperature, in m3 kg-1 K-1. * -! * (out) dSV_dS - the partial derivative of specific volume with * -! * salinity, in m3 kg-1 / (g/kg). * -! * (in) start - the starting point in the arrays. * -! * (in) npts - the number of values to calculate. * + ! Local variables real :: al0, p0, lambda, I_denom integer :: j @@ -360,8 +359,7 @@ end subroutine calculate_specvol_derivs_wright !! from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. !! Coded by R. Hallberg, 1/01 subroutine calculate_compress_wright(T, S, pressure, rho, drho_dp, start, npts) - real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface - !! in C. + real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface in C. real, intent(in), dimension(:) :: S !< Salinity in PSU. real, intent(in), dimension(:) :: pressure !< Pressure in Pa. real, intent(out), dimension(:) :: rho !< In situ density in kg m-3. @@ -371,23 +369,8 @@ subroutine calculate_compress_wright(T, S, pressure, rho, drho_dp, start, npts) integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. -! * Arguments: T - potential temperature relative to the surface in C. * -! * (in) S - salinity in PSU. * -! * (in) pressure - pressure in Pa. * -! * (out) rho - in situ density in kg m-3. * -! * (out) drho_dp - the partial derivative of density with * -! * pressure (also the inverse of the square of * -! * sound speed) in s2 m-2. * -! * (in) start - the starting point in the arrays. * -! * (in) npts - the number of values to calculate. * -! *====================================================================* -! * This subroutine computes the in situ density of sea water (rho in * -! * units of kg/m^3) and the compressibility (drho/dp = C_sound^-2) * -! * (drho_dp in units of s2 m-2) from salinity (sal in psu), potential* -! * temperature (T in deg C), and pressure in Pa. It uses the expres-* -! * sions from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. * -! * Coded by R. Hallberg, 1/01 * -! *====================================================================* + ! Coded by R. Hallberg, 1/01 + ! Local variables real :: al0, p0, lambda, I_denom integer :: j @@ -448,6 +431,7 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. + ! Local variables real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed) :: al0_2d, p0_2d, lambda_2d real :: al0, p0, lambda real :: rho_anom ! The density anomaly from rho_ref, in kg m-3. @@ -653,13 +637,7 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting !! to interpolate T/S for top and bottom integrals. -! This subroutine calculates analytical and nearly-analytical integrals in -! pressure across layers of geopotential anomalies, which are required for -! calculating the finite-volume form pressure accelerations in a non-Boussinesq -! model. There are essentially no free assumptions, apart from the use of -! Bode's rule to do the horizontal integrals, and from a truncation in the -! series for log(1-eps/1+eps) that assumes that |eps| < 0.34. - + ! Local variables real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: al0_2d, p0_2d, lambda_2d real :: al0, p0, lambda real :: p_ave From e85be6658b9f882632e2bfaf2a040bb49153a35c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 13:48:31 -0400 Subject: [PATCH 0530/1072] dOyxgenization of interfaces in MOM_EOS_UNESCO.F90 dOxyGenized comments describing the overloaded public interfaces in MOM_EOS_UNESCO.F90. Also removed duplicate older-style argument documentation comments. All answers are bitwise identical. --- src/equation_of_state/MOM_EOS_UNESCO.F90 | 49 ++++++------------------ 1 file changed, 12 insertions(+), 37 deletions(-) diff --git a/src/equation_of_state/MOM_EOS_UNESCO.F90 b/src/equation_of_state/MOM_EOS_UNESCO.F90 index 4489f40a2a..80b31301b0 100644 --- a/src/equation_of_state/MOM_EOS_UNESCO.F90 +++ b/src/equation_of_state/MOM_EOS_UNESCO.F90 @@ -15,10 +15,16 @@ module MOM_EOS_UNESCO public calculate_density_derivs_UNESCO public calculate_density_scalar_UNESCO, calculate_density_array_UNESCO +!> Compute the in situ density of sea water (in units of kg/m^3), or its anomaly with respect to +!! a reference density, from salinity (in psu), potential temperature (in deg C), and pressure in Pa, +!! using the UNESCO (1981) equation of state. interface calculate_density_UNESCO module procedure calculate_density_scalar_UNESCO, calculate_density_array_UNESCO end interface calculate_density_UNESCO +!> Compute the in situ specific volume of sea water (in units of m^3/kg), or an anomaly with respect +!! to a reference specific volume, from salinity (in psu), potential temperature (in deg C), and +!! pressure in Pa, using the UNESCO (1981) equation of state. interface calculate_spec_vol_UNESCO module procedure calculate_spec_vol_scalar_UNESCO, calculate_spec_vol_array_UNESCO end interface calculate_spec_vol_UNESCO @@ -56,6 +62,7 @@ subroutine calculate_density_scalar_UNESCO(T, S, pressure, rho, rho_ref) real, intent(out) :: rho !< In situ density in kg m-3. real, optional, intent(in) :: rho_ref !< A reference density in kg m-3. + ! Local variables real, dimension(1) :: T0, S0, pressure0 real, dimension(1) :: rho0 @@ -80,17 +87,7 @@ subroutine calculate_density_array_UNESCO(T, S, pressure, rho, start, npts, rho_ integer, intent(in) :: npts !< the number of values to calculate. real, optional, intent(in) :: rho_ref !< A reference density in kg m-3. -! * This subroutine computes the in situ density of sea water (rho in * -! * units of kg/m^3) from salinity (S in psu), potential temperature * -! * (T in deg C), and pressure in Pa. * - -! * Arguments: T - potential temperature relative to the surface in C. * -! * (in) S - salinity in PSU. * -! * (in) pressure - pressure in Pa. * -! * (out) rho - in situ density in kg m-3. * -! * (in) start - the starting point in the arrays. * -! * (in) npts - the number of values to calculate. * - + ! Local variables real :: t_local, t2, t3, t4, t5 ! Temperature to the 1st - 5th power. real :: s_local, s32, s2 ! Salinity to the 1st, 3/2, & 2nd power. real :: p1, p2 ! Pressure (in bars) to the 1st and 2nd power. @@ -144,6 +141,7 @@ subroutine calculate_spec_vol_scalar_UNESCO(T, S, pressure, specvol, spv_ref) real, intent(out) :: specvol !< in situ specific volume in m3 kg-1. real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1. + ! Local variables real, dimension(1) :: T0, S0, pressure0, spv0 T0(1) = T ; S0(1) = S ; pressure0(1) = pressure @@ -166,6 +164,7 @@ subroutine calculate_spec_vol_array_UNESCO(T, S, pressure, specvol, start, npts, integer, intent(in) :: npts !< the number of values to calculate. real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1. + ! Local variables real :: t_local, t2, t3, t4, t5; ! Temperature to the 1st - 5th power. real :: s_local, s32, s2; ! Salinity to the 1st, 3/2, & 2nd power. real :: p1, p2; ! Pressure (in bars) to the 1st and 2nd power. @@ -221,18 +220,7 @@ subroutine calculate_density_derivs_UNESCO(T, S, pressure, drho_dT, drho_dS, sta integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. -! * This subroutine calculates the partial derivatives of density * -! * with potential temperature and salinity. * -! * * -! * Arguments: T - potential temperature relative to the surface in C. * -! * (in) S - salinity in PSU. * -! * (in) pressure - pressure in Pa. * -! * (out) drho_dT - the partial derivative of density with * -! * potential temperature, in kg m-3 K-1. * -! * (out) drho_dS - the partial derivative of density with * -! * salinity, in kg m-3 psu-1. * -! * (in) start - the starting point in the arrays. * -! * (in) npts - the number of values to calculate. * + ! Local variables real :: t_local, t2, t3, t4, t5; ! Temperature to the 1st - 5th power. real :: s12, s_local, s32, s2; ! Salinity to the 1/2 - 2nd powers. real :: p1, p2; ! Pressure (in bars) to the 1st & 2nd power. @@ -303,20 +291,7 @@ subroutine calculate_compress_UNESCO(T, S, pressure, rho, drho_dp, start, npts) integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. -! * This subroutine computes the in situ density of sea water (rho) * -! * and the compressibility (drho/dp == C_sound^-2) at the given * -! * salinity, potential temperature, and pressure. * -! * * -! * Arguments: T - potential temperature relative to the surface in C. * -! * (in) S - salinity in PSU. * -! * (in) pressure - pressure in Pa. * -! * (out) rho - in situ density in kg m-3. * -! * (out) drho_dp - the partial derivative of density with * -! * pressure (also the inverse of the square of * -! * sound speed) in s2 m-2. * -! * (in) start - the starting point in the arrays. * -! * (in) npts - the number of values to calculate. * - + ! Local variables real :: t_local, t2, t3, t4, t5; ! Temperature to the 1st - 5th power. real :: s_local, s32, s2; ! Salinity to the 1st, 3/2, & 2nd power. real :: p1, p2; ! Pressure (in bars) to the 1st and 2nd power. From 638213ca53f87d9e23d5ac11a8aebb9ce16d10c8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 13:49:06 -0400 Subject: [PATCH 0531/1072] dOyxgenization of interfaces in MOM_EOS_TEOS10.F90 dOxyGenized comments describing the overloaded public interfaces in MOM_EOS_TEOS10.F90. Also corrected comments to reflect that these routines work with absolute salinity and conservative temperature, and removed duplicate older-style argument documentation comments. All answers are bitwise identical. --- src/equation_of_state/MOM_EOS_TEOS10.F90 | 126 ++++++++++------------- 1 file changed, 54 insertions(+), 72 deletions(-) diff --git a/src/equation_of_state/MOM_EOS_TEOS10.F90 b/src/equation_of_state/MOM_EOS_TEOS10.F90 index 619bdef5e5..b36ae2db07 100644 --- a/src/equation_of_state/MOM_EOS_TEOS10.F90 +++ b/src/equation_of_state/MOM_EOS_TEOS10.F90 @@ -21,18 +21,28 @@ module MOM_EOS_TEOS10 public calculate_density_second_derivs_teos10 public gsw_sp_from_sr, gsw_pt_from_ct +!> Compute the in situ density of sea water (units of kg/m^3), or its anomaly with respect to +!! a reference density, from absolute salinity (g/kg), conservative temperature (in deg C), +!! and pressure in Pa, using the TEOS10 expressions. interface calculate_density_teos10 module procedure calculate_density_scalar_teos10, calculate_density_array_teos10 end interface calculate_density_teos10 +!> Compute the in situ specific volume of sea water (in units of m^3/kg), or an anomaly with respect +!! to a reference specific volume, from absolute salinity (in g/kg), conservative temperature +!! (in deg C), and pressure in Pa, using the TEOS10 expressions. interface calculate_spec_vol_teos10 module procedure calculate_spec_vol_scalar_teos10, calculate_spec_vol_array_teos10 end interface calculate_spec_vol_teos10 +!> For a given thermodynamic state, return the derivatives of density with conservative temperature +!! and absolute salinity, using the TEOS10 expressions. interface calculate_density_derivs_teos10 module procedure calculate_density_derivs_scalar_teos10, calculate_density_derivs_array_teos10 end interface calculate_density_derivs_teos10 +!> For a given thermodynamic state, return the second derivatives of density with various combinations +!! of conservative temperature, absolute salinity, and pressure, using the TEOS10 expressions. interface calculate_density_second_derivs_teos10 module procedure calculate_density_second_derivs_scalar_teos10, calculate_density_second_derivs_array_teos10 end interface calculate_density_second_derivs_teos10 @@ -52,6 +62,7 @@ subroutine calculate_density_scalar_teos10(T, S, pressure, rho, rho_ref) real, intent(out) :: rho !< In situ density in kg m-3. real, optional, intent(in) :: rho_ref !< A reference density in kg m-3. + ! Local variables real, dimension(1) :: T0, S0, pressure0 real, dimension(1) :: rho0 @@ -77,6 +88,7 @@ subroutine calculate_density_array_teos10(T, S, pressure, rho, start, npts, rho_ integer, intent(in) :: npts !< the number of values to calculate. real, optional, intent(in) :: rho_ref !< A reference density in kg m-3. + ! Local variables real :: zs, zt, zp integer :: j @@ -96,17 +108,17 @@ subroutine calculate_density_array_teos10(T, S, pressure, rho, start, npts, rho_ end subroutine calculate_density_array_teos10 !> This subroutine computes the in situ specific volume of sea water (specvol in -!! units of m^3/kg) from salinity (S in psu), potential temperature (T in deg C) +!! units of m^3/kg) from absolute salinity (S in g/kg), conservative temperature (T in deg C) !! and pressure in Pa, using the TEOS10 equation of state. !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_scalar_teos10(T, S, pressure, specvol, spv_ref) - real, intent(in) :: T !< potential temperature relative to the surface - !! in C. - real, intent(in) :: S !< salinity in PSU. + real, intent(in) :: T !< Conservative temperature in C. + real, intent(in) :: S !< Absolute salinity in g/kg real, intent(in) :: pressure !< pressure in Pa. real, intent(out) :: specvol !< in situ specific volume in m3 kg-1. real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1. + ! Local variables real, dimension(1) :: T0, S0, pressure0, spv0 T0(1) = T ; S0(1) = S ; pressure0(1) = pressure @@ -117,19 +129,20 @@ end subroutine calculate_spec_vol_scalar_teos10 !> This subroutine computes the in situ specific volume of sea water (specvol in -!! units of m^3/kg) from salinity (S in psu), potential temperature (T in deg C) +!! units of m^3/kg) from absolute salinity (S in g/kg), conservative temperature (T in deg C) !! and pressure in Pa, using the TEOS10 equation of state. !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_array_teos10(T, S, pressure, specvol, start, npts, spv_ref) - real, dimension(:), intent(in) :: T !< potential temperature relative to the surface + real, dimension(:), intent(in) :: T !< Conservative temperature relative to the surface !! in C. - real, dimension(:), intent(in) :: S !< salinity in PSU. + real, dimension(:), intent(in) :: S !< salinity in g/kg. real, dimension(:), intent(in) :: pressure !< pressure in Pa. real, dimension(:), intent(out) :: specvol !< in situ specific volume in m3 kg-1. integer, intent(in) :: start !< the starting point in the arrays. integer, intent(in) :: npts !< the number of values to calculate. real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1. + ! Local variables real :: zs, zt, zp integer :: j @@ -149,27 +162,21 @@ subroutine calculate_spec_vol_array_teos10(T, S, pressure, specvol, start, npts, end subroutine calculate_spec_vol_array_teos10 - +!> For a given thermodynamic state, calculate the derivatives of density with conservative +!! temperature and absolute salinity, using the TEOS10 expressions. subroutine calculate_density_derivs_array_teos10(T, S, pressure, drho_dT, drho_dS, start, npts) real, intent(in), dimension(:) :: T !< Conservative temperature in C. real, intent(in), dimension(:) :: S !< Absolute salinity in g/kg. real, intent(in), dimension(:) :: pressure !< Pressure in Pa. - real, intent(out), dimension(:) :: drho_dT !< The partial derivative of density with potential + real, intent(out), dimension(:) :: drho_dT !< The partial derivative of density with conservative !! temperature, in kg m-3 K-1. - real, intent(out), dimension(:) :: drho_dS !< The partial derivative of density with salinity, - !! in kg m-3 psu-1. + real, intent(out), dimension(:) :: drho_dS !< The partial derivative of density with absolute salinity, + !! in kg m-3 (g/kg)-1. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. -! * Arguments: T - conservative temperature in C. * -! * (in) S - absolute salinity in g/kg. * -! * (in) pressure - pressure in Pa. * -! * (out) drho_dT - the partial derivative of density with * -! * potential temperature, in kg m-3 K-1. * -! * (out) drho_dS - the partial derivative of density with * -! * salinity, in kg m-3 psu-1. * -! * (in) start - the starting point in the arrays. * -! * (in) npts - the number of values to calculate. * - real :: zs,zt,zp + + ! Local variables + real :: zs, zt, zp integer :: j do j=start,start+npts-1 @@ -186,16 +193,19 @@ subroutine calculate_density_derivs_array_teos10(T, S, pressure, drho_dT, drho_d end subroutine calculate_density_derivs_array_teos10 +!> For a given thermodynamic state, calculate the derivatives of density with conservative +!! temperature and absolute salinity, using the TEOS10 expressions. subroutine calculate_density_derivs_scalar_teos10(T, S, pressure, drho_dT, drho_dS) real, intent(in) :: T !< Conservative temperature in C real, intent(in) :: S !< Absolute Salinity in g/kg real, intent(in) :: pressure !< Pressure in Pa. - real, intent(out) :: drho_dT !< The partial derivative of density with potential + real, intent(out) :: drho_dT !< The partial derivative of density with conservative !! temperature, in kg m-3 K-1. - real, intent(out) :: drho_dS !< The partial derivative of density with salinity, - !! in kg m-3 psu-1. + real, intent(out) :: drho_dS !< The partial derivative of density with absolute salinity, + !! in kg m-3 (g/kg)-1. + ! Local variables - real :: zs,zt,zp + real :: zs, zt, zp !Conversions zs = S !gsw_sr_from_sp(S) !Convert practical salinity to absolute salinity zt = T !gsw_ct_from_pt(S,T) !Convert potantial temp to conservative temp @@ -204,25 +214,20 @@ subroutine calculate_density_derivs_scalar_teos10(T, S, pressure, drho_dT, drho_ call gsw_rho_first_derivatives(zs, zt, zp, drho_dsa=drho_dS, drho_dct=drho_dT) end subroutine calculate_density_derivs_scalar_teos10 +!> For a given thermodynamic state, calculate the derivatives of specific volume with conservative +!! temperature and absolute salinity, using the TEOS10 expressions. subroutine calculate_specvol_derivs_teos10(T, S, pressure, dSV_dT, dSV_dS, start, npts) real, intent(in), dimension(:) :: T !< Conservative temperature in C. real, intent(in), dimension(:) :: S !< Absolute salinity in g/kg. real, intent(in), dimension(:) :: pressure !< Pressure in Pa. real, intent(out), dimension(:) :: dSV_dT !< The partial derivative of specific volume with - !! potential temperature, in m3 kg-1 K-1. + !! conservative temperature, in m3 kg-1 K-1. real, intent(out), dimension(:) :: dSV_dS !< The partial derivative of specific volume with - !! salinity, in m3 kg-1 / (g/kg). + !! absolute salinity, in m3 kg-1 / (g/kg). integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. -! * Arguments: T - conservative temperature in C. * -! * (in) S - absolute salinity in g/kg. * -! * (in) pressure - pressure in Pa. * -! * (out) dSV_dT - the partial derivative of specific volume with * -! * potential temperature, in m3 kg-1 K-1. * -! * (out) dSV_dS - the partial derivative of specific volume with * -! * salinity, in m3 kg-1 / (g/kg). * -! * (in) start - the starting point in the arrays. * -! * (in) npts - the number of values to calculate. * + + ! Local variables real :: zs, zt, zp integer :: j @@ -251,14 +256,9 @@ subroutine calculate_density_second_derivs_scalar_teos10(T, S, pressure, drho_dS real, intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect to T real, intent(out) :: drho_dS_dP !< Partial derivative of beta with respect to pressure real, intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect to pressure -! * Arguments: T - conservative temperature in C. * -! * (in) S - absolute salinity in g/kg. * -! * (in) pressure - pressure in Pa. * -! * (out) drho_dT - the partial derivative of density with * -! * potential temperature, in kg m-3 K-1. * -! * (out) drho_dS - the partial derivative of density with * -! * salinity, in kg m-3 psu-1. * - real :: zs,zt,zp + + ! Local variables + real :: zs, zt, zp !Conversions zs = S !gsw_sr_from_sp(S) !Convert practical salinity to absolute salinity @@ -283,15 +283,11 @@ subroutine calculate_density_second_derivs_array_teos10(T, S, pressure, drho_dS_ real, dimension(:), intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect to pressure integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. -! * Arguments: T - conservative temperature in C. * -! * (in) S - absolute salinity in g/kg. * -! * (in) pressure - pressure in Pa. * -! * (out) drho_dT - the partial derivative of density with * -! * potential temperature, in kg m-3 K-1. * -! * (out) drho_dS - the partial derivative of density with * -! * salinity, in kg m-3 psu-1. * - real :: zs,zt,zp + + ! Local variables + real :: zs, zt, zp integer :: j + do j=start,start+npts-1 !Conversions zs = S(j) !gsw_sr_from_sp(S) !Convert practical salinity to absolute salinity @@ -308,10 +304,10 @@ subroutine calculate_density_second_derivs_array_teos10(T, S, pressure, drho_dS_ end subroutine calculate_density_second_derivs_array_teos10 -!> This subroutine computes the in situ density of sea water (rho in * -!! units of kg/m^3) and the compressibility (drho/dp = C_sound^-2) * -!! (drho_dp in units of s2 m-2) from salinity (sal in psu), potential* -!! temperature (T in deg C), and pressure in Pa. It uses the * +!> This subroutine computes the in situ density of sea water (rho in +!! units of kg/m^3) and the compressibility (drho/dp = C_sound^-2) +!! (drho_dp in units of s2 m-2) from absolute salinity (sal in g/kg), +!! conservative temperature (T in deg C), and pressure in Pa. It uses the !! subroutines from TEOS10 website subroutine calculate_compress_teos10(T, S, pressure, rho, drho_dp, start, npts) real, intent(in), dimension(:) :: T !< Conservative temperature in C. @@ -323,22 +319,8 @@ subroutine calculate_compress_teos10(T, S, pressure, rho, drho_dp, start, npts) !! in s2 m-2. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. -! * Arguments: T - conservative temperature in C. * -! * (in) S - absolute salinity in g/kg. * -! * (in) pressure - pressure in Pa. * -! * (out) rho - in situ density in kg m-3. * -! * (out) drho_dp - the partial derivative of density with * -! * pressure (also the inverse of the square of * -! * sound speed) in s2 m-2. * -! * (in) start - the starting point in the arrays. * -! * (in) npts - the number of values to calculate. * -! *====================================================================* -! * This subroutine computes the in situ density of sea water (rho in * -! * units of kg/m^3) and the compressibility (drho/dp = C_sound^-2) * -! * (drho_dp in units of s2 m-2) from salinity (sal in psu), potential* -! * temperature (T in deg C), and pressure in Pa. It uses the * -! * subroutines from TEOS10 website * -! *====================================================================* + + ! Local variables real :: zs,zt,zp integer :: j From 66d8c0042429ef7bb647d578a3b9cd1bbf47bd85 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 13:49:23 -0400 Subject: [PATCH 0532/1072] dOyxgenization of interfaces in MOM_EOS_NEMO.F90 dOxyGenized comments describing the overloaded public interfaces in MOM_EOS_NEMO.F90. Also corrected comments to reflect that these routines work with absolute salinity and conservative temperature, and removed duplicate older-style argument documentation comments. All answers are bitwise identical. --- src/equation_of_state/MOM_EOS_NEMO.F90 | 37 ++++++++++++-------------- 1 file changed, 17 insertions(+), 20 deletions(-) diff --git a/src/equation_of_state/MOM_EOS_NEMO.F90 b/src/equation_of_state/MOM_EOS_NEMO.F90 index 237d9e4a2f..a95ff0d39c 100644 --- a/src/equation_of_state/MOM_EOS_NEMO.F90 +++ b/src/equation_of_state/MOM_EOS_NEMO.F90 @@ -9,7 +9,7 @@ module MOM_EOS_NEMO !* Roquet, F., Madec, G., McDougall, T. J., and Barker, P. M., 2015. * !* Accurate polynomial expressions for the density and specific volume* !* of seawater using the TEOS-10 standard. Ocean Modelling, 90:29-43. * -!* These algorithms are NOT from NEMO package!! * +!* These algorithms are NOT from the standard NEMO package!! * !*********************************************************************** !use gsw_mod_toolbox, only : gsw_sr_from_sp, gsw_ct_from_pt @@ -21,10 +21,15 @@ module MOM_EOS_NEMO public calculate_density_derivs_nemo public calculate_density_scalar_nemo, calculate_density_array_nemo +!> Compute the in situ density of sea water (units of kg/m^3), or its anomaly with respect to +!! a reference density, from absolute salinity (g/kg), conservative temperature (in deg C), +!! and pressure in Pa, using the expressions derived for use with NEMO interface calculate_density_nemo module procedure calculate_density_scalar_nemo, calculate_density_array_nemo end interface calculate_density_nemo +!> For a given thermodynamic state, return the derivatives of density with conservative temperature +!! and absolute salinity, the expressions derived for use with NEMO interface calculate_density_derivs_nemo module procedure calculate_density_derivs_scalar_nemo, calculate_density_derivs_array_nemo end interface calculate_density_derivs_nemo @@ -205,6 +210,7 @@ subroutine calculate_density_array_nemo(T, S, pressure, rho, start, npts, rho_re integer, intent(in) :: npts !< the number of values to calculate. real, optional, intent(in) :: rho_ref !< A reference density in kg m-3. + ! Local variables real :: zp, zt, zh, zs, zr0, zn, zn0, zn1, zn2, zn3, zs0 integer :: j @@ -255,6 +261,8 @@ subroutine calculate_density_array_nemo(T, S, pressure, rho, start, npts, rho_re enddo end subroutine calculate_density_array_nemo +!> For a given thermodynamic state, calculate the derivatives of density with conservative +!! temperature and absolute salinity, using the expressions derived for use with NEMO. subroutine calculate_density_derivs_array_nemo(T, S, pressure, drho_dT, drho_dS, start, npts) real, intent(in), dimension(:) :: T !< Conservative temperature in C. real, intent(in), dimension(:) :: S !< Absolute salinity in g/kg. @@ -265,15 +273,8 @@ subroutine calculate_density_derivs_array_nemo(T, S, pressure, drho_dT, drho_dS, !! in kg m-3 psu-1. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. -! * Arguments: T - conservative temperature in C. * -! * (in) S - absolute salinity in g/kg. * -! * (in) pressure - pressure in Pa. * -! * (out) drho_dT - the partial derivative of density with * -! * potential temperature, in kg m-3 K-1. * -! * (out) drho_dS - the partial derivative of density with * -! * salinity, in kg m-3 psu-1. * -! * (in) start - the starting point in the arrays. * -! * (in) npts - the number of values to calculate. * + + ! Local variables real :: zp,zt , zh , zs , zr0, zn , zn0, zn1, zn2, zn3 integer :: j @@ -359,6 +360,10 @@ subroutine calculate_density_derivs_scalar_nemo(T, S, pressure, drho_dt, drho_ds drho_ds = drds0(1) end subroutine calculate_density_derivs_scalar_nemo +!> Compute the in situ density of sea water (rho in units of kg/m^3) and the compressibility +!! (drho/dp = C_sound^-2, stored as drho_dp in units of s2 m-2) from absolute salinity +!! (sal in g/kg), conservative temperature (T in deg C), and pressure in Pa, using the expressions +!! derived for use with NEMO. subroutine calculate_compress_nemo(T, S, pressure, rho, drho_dp, start, npts) real, intent(in), dimension(:) :: T !< Conservative temperature in C. real, intent(in), dimension(:) :: S !< Absolute salinity in g/kg. @@ -369,16 +374,8 @@ subroutine calculate_compress_nemo(T, S, pressure, rho, drho_dp, start, npts) !! in s2 m-2. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. -! * Arguments: T - conservative temperature in C. * -! * (in) S - absolute salinity in g/kg. * -! * (in) pressure - pressure in Pa. * -! * (out) rho - in situ density in kg m-3. * -! * (out) drho_dp - the partial derivative of density with * -! * pressure (also the inverse of the square of * -! * sound speed) in s2 m-2. * -! * (in) start - the starting point in the arrays. * -! * (in) npts - the number of values to calculate. * -! *====================================================================* + + ! Local variables real :: zs,zt,zp integer :: j From 3e83e5f6d2f0cc8411a7c14f548fefb449839f24 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 9 Jul 2018 13:49:42 -0400 Subject: [PATCH 0533/1072] dOyxgenization of interfaces in MOM_EOS.F90 dOxyGenized comments describing the overloaded public interfaces and the publicly visible parameters in MOM_EOS.F90. All answers are bitwise identical. --- src/equation_of_state/MOM_EOS.F90 | 46 +++++++++++++++++-------------- 1 file changed, 25 insertions(+), 21 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index e72ac9bb16..87fc7032af 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -61,10 +61,13 @@ module MOM_EOS module procedure calculate_spec_vol_scalar, calculate_spec_vol_array end interface calculate_spec_vol +!> Calculate the derivatives of density with temperature and salinity from T, S, and P interface calculate_density_derivs module procedure calculate_density_derivs_scalar, calculate_density_derivs_array end interface calculate_density_derivs +!> Calculates the second derivatives of density with various combinations of temperature, +!! salinity, and pressure from T, S and P interface calculate_density_second_derivs module procedure calculate_density_second_derivs_scalar, calculate_density_second_derivs_array end interface calculate_density_second_derivs @@ -92,30 +95,31 @@ module MOM_EOS real :: dTFr_dS !< The derivative of freezing point with salinity, in deg C PSU-1. real :: dTFr_dp !< The derivative of freezing point with pressure, in deg C Pa-1. - logical :: test_EOS = .true. +! logical :: test_EOS = .true. ! If true, test the equation of state end type EOS_type ! The named integers that might be stored in eqn_of_state_type%form_of_EOS. -integer, parameter, public :: EOS_LINEAR = 1 -integer, parameter, public :: EOS_UNESCO = 2 -integer, parameter, public :: EOS_WRIGHT = 3 -integer, parameter, public :: EOS_TEOS10 = 4 -integer, parameter, public :: EOS_NEMO = 5 - -character*(10), parameter :: EOS_LINEAR_STRING = "LINEAR" -character*(10), parameter :: EOS_UNESCO_STRING = "UNESCO" -character*(10), parameter :: EOS_WRIGHT_STRING = "WRIGHT" -character*(10), parameter :: EOS_TEOS10_STRING = "TEOS10" -character*(10), parameter :: EOS_NEMO_STRING = "NEMO" -character*(10), parameter :: EOS_DEFAULT = EOS_WRIGHT_STRING - -integer, parameter :: TFREEZE_LINEAR = 1 -integer, parameter :: TFREEZE_MILLERO = 2 -integer, parameter :: TFREEZE_TEOS10 = 3 -character*(10), parameter :: TFREEZE_LINEAR_STRING = "LINEAR" -character*(10), parameter :: TFREEZE_MILLERO_STRING = "MILLERO_78" -character*(10), parameter :: TFREEZE_TEOS10_STRING = "TEOS10" -character*(10), parameter :: TFREEZE_DEFAULT = TFREEZE_LINEAR_STRING +integer, parameter, public :: EOS_LINEAR = 1 !< A named integer specifying an equation of state +integer, parameter, public :: EOS_UNESCO = 2 !< A named integer specifying an equation of state +integer, parameter, public :: EOS_WRIGHT = 3 !< A named integer specifying an equation of state +integer, parameter, public :: EOS_TEOS10 = 4 !< A named integer specifying an equation of state +integer, parameter, public :: EOS_NEMO = 5 !< A named integer specifying an equation of state + +character*(10), parameter :: EOS_LINEAR_STRING = "LINEAR" !< A string for specifying the equation of state +character*(10), parameter :: EOS_UNESCO_STRING = "UNESCO" !< A string for specifying the equation of state +character*(10), parameter :: EOS_WRIGHT_STRING = "WRIGHT" !< A string for specifying the equation of state +character*(10), parameter :: EOS_TEOS10_STRING = "TEOS10" !< A string for specifying the equation of state +character*(10), parameter :: EOS_NEMO_STRING = "NEMO" !< A string for specifying the equation of state +character*(10), parameter :: EOS_DEFAULT = EOS_WRIGHT_STRING !< The default equation of state + +integer, parameter :: TFREEZE_LINEAR = 1 !< A named integer specifying a freezing point expression +integer, parameter :: TFREEZE_MILLERO = 2 !< A named integer specifying a freezing point expression +integer, parameter :: TFREEZE_TEOS10 = 3 !< A named integer specifying a freezing point expression +character*(10), parameter :: TFREEZE_LINEAR_STRING = "LINEAR" !< A string for specifying the freezing point expression +character*(10), parameter :: TFREEZE_MILLERO_STRING = "MILLERO_78" !< A string for specifying + !! freezing point expression +character*(10), parameter :: TFREEZE_TEOS10_STRING = "TEOS10" !< A string for specifying the freezing point expression +character*(10), parameter :: TFREEZE_DEFAULT = TFREEZE_LINEAR_STRING !< The default freezing point expression contains From 24a1fc73f61be7e779821826bd545abbecd3fd1a Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 9 Jul 2018 13:58:03 -0400 Subject: [PATCH 0534/1072] Fixed doxygen errors in MOM_wave_interface.F90 - Documented some undocumented parameters - Cleaned up some comments - Addded \todo for blocks of module variables which also remain undocumented. --- src/user/MOM_wave_interface.F90 | 162 +++++++++++++++++--------------- 1 file changed, 88 insertions(+), 74 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 460e6e4133..950fe4729d 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -1,31 +1,7 @@ +!> Interface for surface waves module MOM_wave_interface ! This file is part of MOM6. See LICENSE.md for the license. -! -! By Brandon Reichl, 2018. -! -! This module should be moved as wave coupling progresses and -! likely will should mirror the iceberg or sea-ice model set-up. -! -! This module is meant to contain the routines to read in and -! interpret surface wave data for MOM6. In its original form, the -! capabilities include setting the Stokes drift in the model (from a -! variety of sources including prescribed, empirical, and input -! files). In short order, the plan is to also ammend the subroutine -! to accept Stokes drift information from an external coupler. -! Eventually, it will be necessary to break this file apart so that -! general wave information may be stored in the control structure -! and the Stokes drift effect can be isolated from processes such as -! sea-state dependent momentum fluxes, gas fluxes, and other wave -! related air-sea interaction and boundary layer phenomenon. -! -! The Stokes drift are stored on the C-grid with the conventional -! protocol to interpolate to the h-grid to compute Langmuir number, -! the primary quantity needed for Langmuir turbulence -! parameterizations in both the ePBL and KPP approach. This module -! also computes full 3d Stokes drift profiles, which will be useful -! if second-order type boundary layer parameterizations are -! implemented (perhaps via GOTM, work in progress). use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_alloc use MOM_diag_mediator, only : diag_ctrl @@ -131,13 +107,14 @@ module MOM_wave_interface type(diag_ctrl), pointer, public :: diag !< A structure that is used to regulate the !! timing of diagnostic output. - ! Diagnostic handles + !>@{ Diagnostic handles integer, public :: id_surfacestokes_x, id_surfacestokes_y integer, public :: id_3dstokes_x, id_3dstokes_y + !!@} end type wave_parameters_CS -!Options not needed outside of this module +! Options not needed outside of this module integer :: WaveMethod=-99 !< Options for including wave information !! Valid (tested) choices are: @@ -146,32 +123,44 @@ module MOM_wave_interface !! 2 - DHH85 !! 3 - LF17 !! -99 - No waves computed, but empirical Langmuir number used. + !! \todo Module variable! Move into a control structure. ! Options if WaveMethod is Surface Stokes Drift Bands (1) integer, public :: NumBands =0 !< Number of wavenumber/frequency partitions to receive !! This needs to match the number of bands provided !! via either coupling or file. + !! \todo Module variable! Move into a control structure. integer, public :: PartitionMode !< Method for partition mode (meant to check input) !! 0 - wavenumbers !! 1 - frequencies + !! \todo Module variable! Move into a control structure. integer :: DataSource !< Integer that specifies where the Model Looks for Data !! Valid choices are: !! 1 - FMS DataOverride Routine !! 2 - Reserved For Coupler !! 3 - User input (fixed values, useful for 1d testing) + !! \todo Module variable! Move into a control structure. + ! Options if using FMS DataOverride Routine character(len=40) :: SurfBandFileName !< Filename if using DataOverride + !! \todo Module variable! Move into a control structure. logical :: dataoverrideisinitialized !< Flag for DataOverride Initialization + !! \todo Module variable! Move into a control structure. ! Options for computing Langmuir number real :: LA_FracHBL !< Fraction of OSBL for averaging Langmuir number + !! \todo Module variable! Move into a control structure. logical :: LA_Misalignment = .false. !< Flag to use misalignment in Langmuir number + !! \todo Module variable! Move into a control structure. ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_wave_interface" !< This module's name. +!>@{ Undocumented parameters. +!! \todo These module variables need to be documented as static/private variables or moved +!! into a control structure. ! Switches needed in import_stokes_drift integer, parameter :: TESTPROF = 0, SURFBANDS = 1, & DHH85 = 2, LF17 = 3, NULL_WaveMethod=-99, & @@ -182,8 +171,9 @@ module MOM_wave_interface logical :: WaveAgePeakFreq ! Flag to use W real :: WaveAge, WaveWind real :: PI +!!@} -CONTAINS +contains !> Initializes parameters related to MOM_wave_interface subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) @@ -193,7 +183,6 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) type(param_file_type), intent(in) :: param_file !< Input parameter structure type(wave_parameters_CS), pointer :: CS !< Wave parameter control structure type(diag_ctrl), target, intent(inout) :: diag !< Diagnostic Pointer - ! Local variables ! I/O character*(13) :: TMPSTRING1,TMPSTRING2 @@ -416,7 +405,7 @@ subroutine Update_Surface_Waves(G,GV,Day,DT,CS) type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(time_type), intent(in) :: Day !< Time (s) type(time_type), intent(in) :: DT !< Timestep (s) - + ! Local variables integer :: ii, jj, kk, b type(time_type) :: Day_Center @@ -462,7 +451,6 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) intent(in) :: h ! A subroutine to fill the Stokes drift from a NetCDF file !! using the data_override procedures. subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) use NETCDF @@ -670,14 +658,13 @@ subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) type(wave_parameters_CS), pointer :: CS !< Wave structure type(ocean_grid_type), intent(inout) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - ! local variables + ! Local variables real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal and psuedo-meridional real :: temp_y(SZI_(G),SZJ_(G)) ! Stokes drift of band at h-points, in m/s real :: Top, MidPoint, Bottom real :: DecayScale integer :: b integer :: i, j - integer, dimension(4) :: start, counter, dims, dim_id character(len=12) :: dim_name(4) character(20) :: varname, varread1, varread2 @@ -831,11 +818,12 @@ subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) end subroutine Surface_Bands_by_data_override !> Interface to get Langmuir number based on options stored in wave structure +!! +!! Note this can be called with an unallocated Waves pointer, which is okay if we +!! want the wind-speed only dependent Langmuir number. Therefore, we need to be +!! careful about what we try to access here. subroutine get_Langmuir_Number( LA, G, GV, HBL, USTAR, i, j, & H, U_H, V_H, Waves ) -! Note this can be called with an unallocated Waves pointer, which is okay if we -! want the wind-speed only dependent Langmuir number. Therefore, we need to be -! careful about what we try to access here. type(ocean_grid_type), & intent(in) :: G !< Ocean grid structure type(verticalGrid_type), & @@ -931,27 +919,29 @@ subroutine get_Langmuir_Number( LA, G, GV, HBL, USTAR, i, j, & end subroutine get_Langmuir_Number !> Get SL averaged Stokes drift from Li/FK 17 method +!! +!! Original description: +!! - This function returns the enhancement factor, given the 10-meter +!! wind (m/s), friction velocity (m/s) and the boundary layer depth (m). +!! +!! Update (Jan/25): +!! - Converted from function to subroutine, now returns Langmuir number. +!! - Computs 10m wind internally, so only ustar and hbl need passed to +!! subroutine. +!! +!! Qing Li, 160606 +!! - BGR port from CVMix to MOM6 Jan/25/2017 +!! - BGR change output to LA from Efactor +!! - BGR remove u10 input +!! - BGR note: fixed parameter values should be changed to "get_params" subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US_SL, LA) -! Original description: -! This function returns the enhancement factor, given the 10-meter -! wind (m/s), friction velocity (m/s) and the boundary layer depth (m). -! Update (Jan/25): -! Converted from function to subroutine, now returns Langmuir number. -! Computs 10m wind internally, so only ustar and hbl need passed to -! subroutine. -! -! Qing Li, 160606 -! BGR port from CVMix to MOM6 Jan/25/2017 -! BGR change output to LA from Efactor -! BGR remove u10 input -! BGR note: fixed parameter values should be changed to "get_params" real, intent(in) :: ustar !< water-side surface friction velocity (m/s) real, intent(in) :: hbl !< boundary layer depth (m) type(verticalGrid_type), & intent(in) :: GV !< Ocean vertical grid structure real, intent(out) :: US_SL !< Surface layer averaged Stokes drift (m/s) real, intent(out) :: LA !< Langmuir number -! Local variables + ! Local variables ! parameters real, parameter :: & ! ratio of U19.5 to U10 (Holthuijsen, 2007) @@ -1034,16 +1024,15 @@ subroutine Get_SL_Average_Prof( GV, AvgDepth, H, Profile, Average ) !! (used here for Stokes drift, m/s) real, intent(out) :: Average !< Output quantity averaged over depth AvgDepth !! (used here for Stokes drift, m/s) - !Local variables real :: top, midpoint, bottom real :: Sum integer :: kk -! Initializing sum + ! Initializing sum Sum = 0.0 -! Integrate + ! Integrate bottom = 0.0 do kk = 1, GV%ke Top = Bottom @@ -1073,12 +1062,11 @@ subroutine Get_SL_Average_Band( GV, AvgDepth, NB, WaveNumbers, SurfStokes, Avera real, dimension(NB), & intent(in) :: SurfStokes !< Surface Stokes drift for each band (m/s) real, intent(out) :: Average !< Output average Stokes drift over depth AvgDepth (m/s) - ! Local variables real :: top, midpoint, bottom integer :: bb -! Loop over bands + ! Loop over bands Average = 0.0 do bb = 1, NB ! Factor includes analytical integration of e(2kz) @@ -1092,11 +1080,12 @@ subroutine Get_SL_Average_Band( GV, AvgDepth, NB, WaveNumbers, SurfStokes, Avera end subroutine Get_SL_Average_Band !> Compute the Stokes drift at a given depth +!! +!! Taken from Qing Li (Brown) +!! use for comparing MOM6 simulation to his LES +!! computed at z mid point (I think) and not depth averaged. +!! Should be fine to integrate in frequency from 0.1 to sqrt(-0.2*grav*2pi/dz subroutine DHH85_mid(GV, ust, zpt, US) -! Taken from Qing Li (Brown) -! use for comparing MOM6 simulation to his LES -! computed at z mid point (I think) and not depth averaged. -! Should be fine to integrate in frequency from 0.1 to sqrt(-0.2*grav*2pi/dz type(verticalGrid_type), & intent(in) :: GV !< Ocean vertical grid real, intent(in) :: UST !< Surface friction velocity (m/s) @@ -1151,7 +1140,7 @@ end subroutine DHH85_mid !> Explicit solver for Stokes mixing. !! Still in development do not use. -subroutine StokesMixing(G, GV, DT, h, u, v, WAVES ) +subroutine StokesMixing(G, GV, DT, h, u, v, Waves ) type(ocean_grid_type), & intent(in) :: G !< Ocean grid type(verticalGrid_type), & @@ -1165,10 +1154,9 @@ subroutine StokesMixing(G, GV, DT, h, u, v, WAVES ) intent(inout) :: v !< Velocity j-component (m/s) type(Wave_parameters_CS), & pointer :: Waves !< Surface wave related control structure. - ! Local variables - REAL :: dTauUp, dTauDn, DVel - INTEGER :: i,j,k + real :: dTauUp, dTauDn, DVel + integer :: i,j,k ! This is a template to think about down-Stokes mixing. ! This is not ready for use... @@ -1233,8 +1221,9 @@ end subroutine StokesMixing !! Still in development and not meant for general use. !! Can be activated (with code intervention) for LES comparison !! CHECK THAT RIGHT TIMESTEP IS PASSED IF YOU USE THIS** +!! +!! Not accessed in the standard code. subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES) - ! Not accessed in the standard code. type(ocean_grid_type), & intent(in) :: G !< Ocean grid type(verticalGrid_type), & @@ -1248,10 +1237,9 @@ subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES) intent(inout) :: v !< Velocity j-component (m/s) type(Wave_parameters_CS), & pointer :: Waves !< Surface wave related control structure. - ! Local variables - REAL :: DVel - INTEGER :: i,j,k + real :: DVel + integer :: i,j,k do k = 1, G%ke do j = G%jscB, G%jecB !**Are these index bounds right? @@ -1280,9 +1268,9 @@ end subroutine CoriolisStokes !! the neutral wind-speed as written here. subroutine ust_2_u10_coare3p5(USTair,U10,GV) real, intent(in) :: USTair !< Wind friction velocity (m/s) - type(verticalGrid_type), intent(in) :: GV !< vertical grid type real, intent(out) :: U10 !< 10-m neutral wind speed (m/s) - ! + type(verticalGrid_type), intent(in) :: GV !< vertical grid type + ! Local variables real, parameter :: vonkar = 0.4 ! Should access a get_param von karman real, parameter :: nu=1e-6 ! Should access a get_param air-viscosity real :: z0sm, z0, z0rough, u10a, alpha, CD @@ -1323,9 +1311,8 @@ end subroutine ust_2_u10_coare3p5 !> Clear pointers, deallocate memory subroutine Waves_end(CS) -!/ type(wave_parameters_CS), pointer :: CS !< Control structure -!/ + if (allocated(CS%WaveNum_Cen)) then; deallocate( CS%WaveNum_Cen ); endif if (allocated(CS%Freq_Cen)) deallocate( CS%Freq_Cen ) if (allocated(CS%Us_x)) deallocate( CS%Us_x ) @@ -1336,10 +1323,37 @@ subroutine Waves_end(CS) if (allocated(CS%KvS)) deallocate( CS%KvS ) if (allocated(CS%Us0_y)) deallocate( CS%Us0_y ) if (allocated(CS%Us0_x)) deallocate( CS%Us0_x ) -!/ + deallocate( CS ) -!/ + return end subroutine Waves_end +!> \namespace mom_wave_interface +!! +!! \author Brandon Reichl, 2018. +!! +!! This module should be moved as wave coupling progresses and +!! likely will should mirror the iceberg or sea-ice model set-up. +!! +!! This module is meant to contain the routines to read in and +!! interpret surface wave data for MOM6. In its original form, the +!! capabilities include setting the Stokes drift in the model (from a +!! variety of sources including prescribed, empirical, and input +!! files). In short order, the plan is to also ammend the subroutine +!! to accept Stokes drift information from an external coupler. +!! Eventually, it will be necessary to break this file apart so that +!! general wave information may be stored in the control structure +!! and the Stokes drift effect can be isolated from processes such as +!! sea-state dependent momentum fluxes, gas fluxes, and other wave +!! related air-sea interaction and boundary layer phenomenon. +!! +!! The Stokes drift are stored on the C-grid with the conventional +!! protocol to interpolate to the h-grid to compute Langmuir number, +!! the primary quantity needed for Langmuir turbulence +!! parameterizations in both the ePBL and KPP approach. This module +!! also computes full 3d Stokes drift profiles, which will be useful +!! if second-order type boundary layer parameterizations are +!! implemented (perhaps via GOTM, work in progress). + end module MOM_wave_interface From 07c925830f8b84c5d69637c45a949bed2f55eddc Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 9 Jul 2018 14:05:37 -0400 Subject: [PATCH 0535/1072] Doxeginized the user_initialization.F90 and user_revise_forcing.F90 - Cleaned up doxumentation. - Noted bad use of module variable. --- src/user/user_initialization.F90 | 100 +++++++++++++------------------ src/user/user_revise_forcing.F90 | 21 +++---- 2 files changed, 51 insertions(+), 70 deletions(-) diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index ec948cfdb2..b7e1efe6b1 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -1,3 +1,4 @@ +!> A template of a user to code up customized initial conditions. module user_initialization ! This file is part of MOM6. See LICENSE.md for the license. @@ -23,6 +24,8 @@ module user_initialization public USER_initialize_velocity, USER_init_temperature_salinity public USER_initialize_sponges, USER_set_OBC_data, USER_set_rotation +!> A module variable that should not be used. +!! \todo Move this module variable into a control structure. logical :: first_call = .true. contains @@ -228,61 +231,44 @@ end subroutine write_user_log !> \namespace user_initialization !! -!! By Robert Hallberg, April 1994 - June 2002 * -!! * -!! This subroutine initializes the fields for the simulations. * -!! The one argument passed to initialize, Time, is set to the * -!! current time of the simulation. The fields which are initialized * -!! here are: * -!! u - Zonal velocity in m s-1. * -!! v - Meridional velocity in m s-1. * -!! h - Layer thickness in m. (Must be positive.) * -!! G%bathyT - Basin depth in m. (Must be positive.) * -!! G%CoriolisBu - The Coriolis parameter, in s-1. * -!! GV%g_prime - The reduced gravity at each interface, in m s-2. * -!! GV%Rlay - Layer potential density (coordinate variable), kg m-3. * -!! If ENABLE_THERMODYNAMICS is defined: * -!! T - Temperature in C. * -!! S - Salinity in psu. * -!! If BULKMIXEDLAYER is defined: * -!! Rml - Mixed layer and buffer layer potential densities in * -!! units of kg m-3. * -!! If SPONGE is defined: * -!! A series of subroutine calls are made to set up the damping * -!! rates and reference profiles for all variables that are damped * -!! in the sponge. * -!! Any user provided tracer code is also first linked through this * -!! subroutine. * -!! * -!! Forcing-related fields (taux, tauy, buoy, ustar, etc.) are set * -!! in MOM_surface_forcing.F90. * -!! * -!! These variables are all set in the set of subroutines (in this * -!! file) USER_initialize_bottom_depth, USER_initialize_thickness, * -!! USER_initialize_velocity, USER_initialize_temperature_salinity, * -!! USER_initialize_mixed_layer_density, USER_initialize_sponges, * -!! USER_set_coord, and USER_set_ref_profile. * -!! * -!! The names of these subroutines should be self-explanatory. They * -!! start with "USER_" to indicate that they will likely have to be * -!! modified for each simulation to set the initial conditions and * -!! boundary conditions. Most of these take two arguments: an integer * -!! argument specifying whether the fields are to be calculated * -!! internally or read from a NetCDF file; and a string giving the * -!! path to that file. If the field is initialized internally, the * -!! path is ignored. * -!! * -!! Macros written all in capital letters are defined in MOM_memory.h. * -!! * -!! A small fragment of the grid is shown below: * -!! * -!! j+1 x ^ x ^ x At x: q, CoriolisBu * -!! j+1 > o > o > At ^: v, tauy * -!! j x ^ x ^ x At >: u, taux * -!! j > o > o > At o: h, bathyT, buoy, tr, T, S, Rml, ustar * -!! j-1 x ^ x ^ x * -!! i-1 i i+1 At x & ^: * -!! i i+1 At > & o: * -!! * -!! The boundaries always run through q grid points (x). * +!! This subroutine initializes the fields for the simulations. +!! The one argument passed to initialize, Time, is set to the +!! current time of the simulation. The fields which are initialized +!! here are: +!! - u - Zonal velocity in m s-1. +!! - v - Meridional velocity in m s-1. +!! - h - Layer thickness in m. (Must be positive.) +!! - G%bathyT - Basin depth in m. (Must be positive.) +!! - G%CoriolisBu - The Coriolis parameter, in s-1. +!! - GV%g_prime - The reduced gravity at each interface, in m s-2. +!! - GV%Rlay - Layer potential density (coordinate variable), kg m-3. +!! If ENABLE_THERMODYNAMICS is defined: +!! - T - Temperature in C. +!! - S - Salinity in psu. +!! If BULKMIXEDLAYER is defined: +!! - Rml - Mixed layer and buffer layer potential densities in +!! units of kg m-3. +!! If SPONGE is defined: +!! - A series of subroutine calls are made to set up the damping +!! rates and reference profiles for all variables that are damped +!! in the sponge. +!! +!! Any user provided tracer code is also first linked through this +!! subroutine. +!! +!! These variables are all set in the set of subroutines (in this +!! file) USER_initialize_bottom_depth, USER_initialize_thickness, +!! USER_initialize_velocity, USER_initialize_temperature_salinity, +!! USER_initialize_mixed_layer_density, USER_initialize_sponges, +!! USER_set_coord, and USER_set_ref_profile. +!! +!! The names of these subroutines should be self-explanatory. They +!! start with "USER_" to indicate that they will likely have to be +!! modified for each simulation to set the initial conditions and +!! boundary conditions. Most of these take two arguments: an integer +!! argument specifying whether the fields are to be calculated +!! internally or read from a NetCDF file; and a string giving the +!! path to that file. If the field is initialized internally, the +!! path is ignored. + end module user_initialization diff --git a/src/user/user_revise_forcing.F90 b/src/user/user_revise_forcing.F90 index 02eb399e7c..f2e381cc4a 100644 --- a/src/user/user_revise_forcing.F90 +++ b/src/user/user_revise_forcing.F90 @@ -1,14 +1,8 @@ +!> Provides a template for users to code updating the forcing fluxes. module user_revise_forcing ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* This module provides a method for updating the forcing fluxes * -!* using user-written code without the need to duplicate the * -!* extensive code used to create or obtain the fluxes. * -!* * -!********+*********+*********+*********+*********+*********+*********+** use MOM_domains, only : pass_var, pass_vector, AGRID use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type @@ -25,10 +19,14 @@ module user_revise_forcing public user_alter_forcing, user_revise_forcing_init +!> Control structure for user_revise_forcing type, public :: user_revise_forcing_CS ; private - real :: cdrag ! The quadratic bottom drag coefficient. + real :: cdrag !< The quadratic bottom drag coefficient. end type user_revise_forcing_CS +! This include declares and sets the variable "version". +#include "version_variable.h" + character(len=40) :: mdl = "user_revise_forcing" !< This module's name. contains !> This subroutine sets the surface wind stresses. @@ -46,17 +44,14 @@ subroutine user_alter_forcing(state, fluxes, day, G, CS) end subroutine user_alter_forcing +!> Initialize the user_revise_forcing control structure subroutine user_revise_forcing_init(param_file,CS) - type(param_file_type), intent(in) :: param_file !< !< A structure indicating the open file to + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for model parameter values. type(user_revise_forcing_CS), pointer :: CS !< A pointer to the control structure !! returned by a previous call to !! surface_forcing_init. -! This include declares and sets the variable "version". -#include "version_variable.h" - character(len=40) :: mdl = "user_revise_forcing" ! This module's name. - call log_version(param_file, mdl, version) end subroutine user_revise_forcing_init From 7a10dfa82cd762f026db89c9fa346df33f2c6330 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 9 Jul 2018 14:09:35 -0400 Subject: [PATCH 0536/1072] Fixed doxygen errors in user_change_diffusivity.F90 - Doxumented control structure, including member parameters. - Cleaned up some comments. --- src/user/user_change_diffusivity.F90 | 55 +++++++++------------------- 1 file changed, 18 insertions(+), 37 deletions(-) diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index 2aa1b6a5d2..ea15387f64 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -1,3 +1,4 @@ +!> Increments the diapycnal diffusivity in a specified band of latitudes and densities. module user_change_diffusivity ! This file is part of MOM6. See LICENSE.md for the license. @@ -16,18 +17,19 @@ module user_change_diffusivity public user_change_diff, user_change_diff_init public user_change_diff_end +!> Control structure for user_change_diffusivity type, public :: user_change_diff_CS ; private - real :: Kd_add ! The scale of a diffusivity that is added everywhere - ! without any filtering or scaling, in m2 s-1. - real :: lat_range(4) ! 4 values that define the latitude range over which - ! a diffusivity scaled by Kd_add is added, in deg. - real :: rho_range(4) ! 4 values that define the coordinate potential - ! density range over which a diffusivity scaled by - ! Kd_add is added, in kg m-3. - logical :: use_abs_lat ! If true, use the absolute value of latitude when - ! setting lat_range. - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. + real :: Kd_add !< The scale of a diffusivity that is added everywhere + !! without any filtering or scaling, in m2 s-1. + real :: lat_range(4) !< 4 values that define the latitude range over which + !! a diffusivity scaled by Kd_add is added, in deg. + real :: rho_range(4) !< 4 values that define the coordinate potential + !! density range over which a diffusivity scaled by + !! Kd_add is added, in kg m-3. + logical :: use_abs_lat !< If true, use the absolute value of latitude when + !! setting lat_range. + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. end type user_change_diff_CS contains @@ -54,7 +56,7 @@ subroutine user_change_diff(h, tv, G, CS, Kd, Kd_int, T_f, S_f, Kd_int_add) real, dimension(:,:,:), optional, pointer :: Kd_int_add !< The diapycnal !! diffusivity that is being added at !! each interface in m2 s-1. - + ! Local variables real :: Rcv(SZI_(G),SZK_(G)) ! The coordinate density in layers in kg m-3. real :: p_ref(SZI_(G)) ! An array of tv%P_Ref pressures. real :: rho_fn ! The density dependence of the input function, 0-1, ND. @@ -143,7 +145,6 @@ function range_OK(range) result(OK) real, dimension(4), intent(in) :: range !< Four values to check. logical :: OK !< Return value. - OK = ((range(1) <= range(2)) .and. (range(2) <= range(3)) .and. & (range(3) <= range(4))) @@ -158,7 +159,7 @@ function val_weights(val, range) result(ans) real, intent(in) :: val !< Value for which we need an answer. real, dimension(4), intent(in) :: range !< Range over which the answer is non-zero. real :: ans !< Return value. - + ! Local variables real :: x ! A nondimensional number between 0 and 1. ans = 0.0 @@ -234,7 +235,7 @@ subroutine user_change_diff_init(Time, G, param_file, diag, CS) default=.false.) endif - if (.not.range_OK(CS%lat_range)) then + if (.not.range_OK(CS%lat_range)) then write(mesg, '(4(1pe15.6))') CS%lat_range(1:4) call MOM_error(FATAL, "user_set_diffusivity: bad latitude range: \n "//& trim(mesg)) @@ -249,31 +250,11 @@ end subroutine user_change_diff_init !> Clean up the module control structure. subroutine user_change_diff_end(CS) - type(user_change_diff_CS), pointer :: CS !< A pointer that is set to - !! point to the control - !! structure for this module. + type(user_change_diff_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module. if (associated(CS)) deallocate(CS) end subroutine user_change_diff_end -!> \namespace user_change_diffusivity -!! -!! By Robert Hallberg, May 2012 -!! -!! This file contains a subroutine that increments the diapycnal -!! diffusivity in a specified band of latitudes and densities. -!! -!! A small fragment of the grid is shown below: -!! -!! j+1 x ^ x ^ x At x: q -!! j+1 > o > o > At ^: v -!! j x ^ x ^ x At >: u -!! j > o > o > At o: h, T, S, Kd, etc. -!! j-1 x ^ x ^ x -!! i-1 i i+1 At x & ^: -!! i i+1 At > & o: -!! -!! The boundaries always run through q grid points (x). - end module user_change_diffusivity From 9e9d84820cc62e8d0abdef40e752aabfca63a5fc Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 9 Jul 2018 14:14:36 -0400 Subject: [PATCH 0537/1072] Fixed doxygen errors in MOM_controlled_forcing.F90 - Doxumented undocumented parameters. - Added todo for a few that need better documentation. --- src/user/MOM_controlled_forcing.F90 | 66 ++++++++++++++++------------- 1 file changed, 36 insertions(+), 30 deletions(-) diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index a15c16515e..c361a37176 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -1,3 +1,9 @@ +!> Use control-theory to adjust the surface heat flux and precipitation. +!! +!! Adjustments are based on the time-mean or periodically (seasonally) varying +!! anomalies from the observed state. +!! +!! The techniques behind this are described in Hallberg and Adcroft (2018, in prep.). module MOM_controlled_forcing ! This file is part of MOM6. See LICENSE.md for the license. @@ -15,10 +21,6 @@ module MOM_controlled_forcing use MOM_time_manager, only : get_time, get_date, set_time, set_date use MOM_time_manager, only : time_type_to_real use MOM_variables, only : surface -! Forcing is a structure containing pointers to the forcing fields -! which may be used to drive MOM. All fluxes are positive downward. -! Surface is a structure containing pointers to various fields that -! may be used describe the surface state of MOM. implicit none ; private @@ -27,30 +29,33 @@ module MOM_controlled_forcing public apply_ctrl_forcing, register_ctrl_forcing_restarts public controlled_forcing_init, controlled_forcing_end +!> Control structure for MOM_controlled_forcing type, public :: ctrl_forcing_CS ; private - logical :: use_temperature ! If true, temperature and salinity are used as - ! state variables. - logical :: do_integrated ! If true, use time-integrated anomalies to control - ! the surface state. - integer :: num_cycle ! The number of elements in the forcing cycle. - real :: heat_int_rate ! The rate at which heating anomalies accumulate, in s-1. - real :: prec_int_rate ! The rate at which precipitation anomalies accumulate, in s-1. - real :: heat_cyc_rate ! The rate at which cyclical heating anomaliess - ! accumulate, in s-1. - real :: prec_cyc_rate ! The rate at which cyclical precipitation anomaliess - ! accumulate, in s-1. - real :: Len2 ! The square of the length scale over which the anomalies - ! are smoothed via a Laplacian filter, in m2. - real :: lam_heat ! A constant of proportionality between SST anomalies - ! and heat fluxes, in W m-2 K-1. - real :: lam_prec ! A constant of proportionality between SSS anomalies - ! (normalised by mean SSS) and precipitation, in kg m-2. - real :: lam_cyc_heat ! A constant of proportionality between cyclical SST - ! anomalies and corrective heat fluxes, in W m-2 K-1. - real :: lam_cyc_prec ! A constant of proportionality between cyclical SSS - ! anomalies (normalised by mean SSS) and corrective - ! precipitation, in kg m-2. - + logical :: use_temperature !< If true, temperature and salinity are used as + !! state variables. + logical :: do_integrated !< If true, use time-integrated anomalies to control + !! the surface state. + integer :: num_cycle !< The number of elements in the forcing cycle. + real :: heat_int_rate !< The rate at which heating anomalies accumulate, in s-1. + real :: prec_int_rate !< The rate at which precipitation anomalies accumulate, in s-1. + real :: heat_cyc_rate !< The rate at which cyclical heating anomaliess + !! accumulate, in s-1. + real :: prec_cyc_rate !< The rate at which cyclical precipitation anomaliess + !! accumulate, in s-1. + real :: Len2 !< The square of the length scale over which the anomalies + !! are smoothed via a Laplacian filter, in m2. + real :: lam_heat !< A constant of proportionality between SST anomalies + !! and heat fluxes, in W m-2 K-1. + real :: lam_prec !< A constant of proportionality between SSS anomalies + !! (normalised by mean SSS) and precipitation, in kg m-2. + real :: lam_cyc_heat !< A constant of proportionality between cyclical SST + !! anomalies and corrective heat fluxes, in W m-2 K-1. + real :: lam_cyc_prec !< A constant of proportionality between cyclical SSS + !! anomalies (normalised by mean SSS) and corrective + !! precipitation, in kg m-2. + + !>@{ Pointers for data. + !! \todo Needs more complete documentation. real, pointer, dimension(:) :: & avg_time => NULL() real, pointer, dimension(:,:) :: & @@ -62,9 +67,10 @@ module MOM_controlled_forcing avg_SST_anom => NULL(), & avg_SSS_anom => NULL(), & avg_SSS => NULL() - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. - integer :: id_heat_0 = -1 ! See if these are needed later... + !!@} + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. + integer :: id_heat_0 = -1 !< Diagnostic handle end type ctrl_forcing_CS contains From 9cdb07976e54f030ab64ca9594a899d660dc1d1b Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 9 Jul 2018 15:24:29 -0400 Subject: [PATCH 0538/1072] Fixed doxygen errors in the MOM_CVmix_* files - Documented undocumented varaibles in the control structures - Minor tidy up of other comments --- .../vertical/MOM_CVMix_KPP.F90 | 15 ++++++--------- .../vertical/MOM_CVMix_conv.F90 | 9 ++++----- .../vertical/MOM_CVMix_ddiff.F90 | 15 +++++++-------- .../vertical/MOM_CVMix_shear.F90 | 17 +++++++---------- 4 files changed, 24 insertions(+), 32 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index c4cc516f99..3253003119 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -116,8 +116,8 @@ module MOM_CVMix_KPP !> CVMix parameters type(CVMix_kpp_params_type), pointer :: KPP_params => NULL() - ! Diagnostic handles and pointers - type(diag_ctrl), pointer :: diag => NULL() + type(diag_ctrl), pointer :: diag => NULL() !< Pointer to diagnostics control structure + !>@{ Diagnostic handles integer :: id_OBLdepth = -1, id_BulkRi = -1 integer :: id_N = -1, id_N2 = -1 integer :: id_Ws = -1, id_Vt2 = -1 @@ -137,6 +137,7 @@ module MOM_CVMix_KPP integer :: id_NLT_saln_budget = -1 integer :: id_EnhK = -1, id_EnhW = -1, id_EnhVt2 = -1 integer :: id_OBLdepth_original = -1 + !!@} ! Diagnostics arrays real, allocatable, dimension(:,:) :: OBLdepth !< Depth (positive) of OBL (m) @@ -158,15 +159,11 @@ module MOM_CVMix_KPP real, allocatable, dimension(:,:) :: Ssurf !< Salinity of surface layer (ppt) real, allocatable, dimension(:,:) :: Usurf !< i-velocity of surface layer (m/s) real, allocatable, dimension(:,:) :: Vsurf !< j-velocity of surface layer (m/s) - real, allocatable, dimension(:,:,:) :: EnhK !< Enhancement for mixing coefficient - real, allocatable, dimension(:,:,:) :: EnhVt2 !< Enhancement for Vt2 - - + real, allocatable, dimension(:,:,:) :: EnhK !< Enhancement for mixing coefficient + real, allocatable, dimension(:,:,:) :: EnhVt2 !< Enhancement for Vt2 end type KPP_CS -! Module data used for debugging only -logical, parameter :: verbose = .False. #define __DO_SAFETY_CHECKS__ contains @@ -1552,7 +1549,7 @@ subroutine KPP_end(CS) end subroutine KPP_end -!> \namespace mom_kpp +!> \namespace mom_cvmix_kpp !! !! \section section_KPP The K-Profile Parameterization !! diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 0c1332c151..74fc2d6f2d 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -34,11 +34,13 @@ module MOM_CVMix_conv logical :: debug !< If true, turn on debugging ! Daignostic handles and pointers - type(diag_ctrl), pointer :: diag => NULL() + type(diag_ctrl), pointer :: diag => NULL() !< Pointer to diagnostics control structure + !>@{ Diagnostics handles integer :: id_N2 = -1, id_kd_conv = -1, id_kv_conv = -1 + !!@} ! Diagnostics arrays - real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency (1/s2) + real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency (1/s2) real, allocatable, dimension(:,:,:) :: kd_conv !< Diffusivity added by convection (m2/s) real, allocatable, dimension(:,:,:) :: kv_conv !< Viscosity added by convection (m2/s) @@ -57,7 +59,6 @@ logical function CVMix_conv_init(Time, G, GV, param_file, diag, CS) type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. type(CVMix_conv_cs), pointer :: CS !< This module's control structure. - ! Local variables real :: prandtl_conv !< Turbulent Prandtl number used in convective instabilities. logical :: useEPBL !< If True, use the ePBL boundary layer scheme. @@ -153,7 +154,6 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, CS, hbl) type(CVMix_conv_cs), pointer :: CS !< The control structure returned !! by a previous call to CVMix_conv_init. real, dimension(:,:), optional, pointer :: hbl!< Depth of ocean boundary layer (m) - ! local variables real, dimension(SZK_(G)) :: rho_lwr !< Adiabatic Water Density, this is a dummy !! variable since here convection is always @@ -270,5 +270,4 @@ subroutine CVMix_conv_end(CS) end subroutine CVMix_conv_end - end module MOM_CVMix_conv diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index 8f633028f3..117c958acb 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -40,13 +40,15 @@ module MOM_CVMix_ddiff logical :: debug !< If true, turn on debugging ! Daignostic handles and pointers - type(diag_ctrl), pointer :: diag => NULL() + type(diag_ctrl), pointer :: diag => NULL() !< Pointer to diagnostics control structure + !>@{ Diagnostics handles integer :: id_KT_extra = -1, id_KS_extra = -1, id_R_rho = -1 + !!@} ! Diagnostics arrays - real, allocatable, dimension(:,:,:) :: KT_extra !< double diffusion diffusivity for temp (m2/s) - real, allocatable, dimension(:,:,:) :: KS_extra !< double diffusion diffusivity for salt (m2/s) - real, allocatable, dimension(:,:,:) :: R_rho !< double-diffusion density ratio (nondim) + real, allocatable, dimension(:,:,:) :: KT_extra !< Double diffusion diffusivity for temp (m2/s) + real, allocatable, dimension(:,:,:) :: KS_extra !< Double diffusion diffusivity for salt (m2/s) + real, allocatable, dimension(:,:,:) :: R_rho !< Double-diffusion density ratio (nondim) end type CVMix_ddiff_cs @@ -171,9 +173,7 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) type(CVMix_ddiff_cs), pointer :: CS !< The control structure returned !! by a previous call to CVMix_ddiff_init. integer, intent(in) :: j !< Meridional grid indice. -! real, dimension(:,:), optional, pointer :: hbl !< Depth of ocean boundary layer (m) - - ! local variables + ! Local variables real, dimension(SZK_(G)) :: & cellHeight, & !< Height of cell centers (m) dRho_dT, & !< partial derivatives of density wrt temp (kg m-3 degC-1) @@ -299,5 +299,4 @@ subroutine CVMix_ddiff_end(CS) end subroutine CVMix_ddiff_end - end module MOM_CVMix_ddiff diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index ce08b09c45..6f73d7984c 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -3,13 +3,7 @@ module MOM_CVMix_shear ! This file is part of MOM6. See LICENSE.md for the license. -!--------------------------------------------------- -! module MOM_CVMix_shear -! Author: Brandon Reichl -! Date: Aug 31, 2016 -! Purpose: Interface to CVMix interior shear schemes -! Further information to be added at a later time. -!--------------------------------------------------- +!> \author Brandon Reichl use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl, time_type @@ -29,7 +23,8 @@ module MOM_CVMix_shear !> Control structure including parameters for CVMix interior shear schemes. type, public :: CVMix_shear_cs - logical :: use_LMD94, use_PP81 !< Flags for various schemes + logical :: use_LMD94 !< Flags to use the LMD94 scheme + logical :: use_PP81 !< Flags to use Pacanowski and Philander (JPO 1981) logical :: smooth_ri !< If true, smooth Ri using a 1-2-1 filter real :: Ri_zero !< LMD94 critical Richardson number real :: Nu_zero !< LMD94 maximum interior diffusivity @@ -41,10 +36,12 @@ module MOM_CVMix_shear real, allocatable, dimension(:,:,:) :: ri_grad_smooth !< Gradient Richardson number !! after smoothing character(10) :: Mix_Scheme !< Mixing scheme name (string) - ! Daignostic handles and pointers - type(diag_ctrl), pointer :: diag => NULL() + + type(diag_ctrl), pointer :: diag => NULL() !< Pointer to the diagnostics control structure + !>@{ Diagnostic handles integer :: id_N2 = -1, id_S2 = -1, id_ri_grad = -1, id_kv = -1, id_kd = -1 integer :: id_ri_grad_smooth = -1 + !!@} end type CVMix_shear_cs From 5e059e79588703b303a22df1ab23271a1f3072a4 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 9 Jul 2018 15:25:38 -0400 Subject: [PATCH 0539/1072] Fixed doxygen errors in MOM_set_viscosity.F90 - Fixed documented but undoxumented variables in the control structure - Cleaned up module documentation --- .../vertical/MOM_set_viscosity.F90 | 193 +++++++----------- 1 file changed, 70 insertions(+), 123 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 3ce2331f11..31dfb89cb8 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1,3 +1,5 @@ +!> Calculates various values related to the bottom boundary layer, such as the viscosity and +!! thickness of the BBL (set_viscous_BBL). module MOM_set_visc ! This file is part of MOM6. See LICENSE.md for the license. @@ -32,65 +34,66 @@ module MOM_set_visc public set_viscous_BBL, set_viscous_ML, set_visc_init, set_visc_end public set_visc_register_restarts +!> Control structure for MOM_set_visc type, public :: set_visc_CS ; private - real :: Hbbl ! The static bottom boundary layer thickness, in - ! the same units as thickness (m or kg m-2). - real :: cdrag ! The quadratic drag coefficient. - real :: c_Smag ! The Laplacian Smagorinsky coefficient for - ! calculating the drag in channels. - real :: drag_bg_vel ! An assumed unresolved background velocity for - ! calculating the bottom drag, in m s-1. - real :: BBL_thick_min ! The minimum bottom boundary layer thickness in - ! the same units as thickness (m or kg m-2). - ! This might be Kv / (cdrag * drag_bg_vel) to give - ! Kv as the minimum near-bottom viscosity. - real :: Htbl_shelf ! A nominal thickness of the surface boundary layer - ! for use in calculating the near-surface velocity, - ! in units of m. - real :: Htbl_shelf_min ! The minimum surface boundary layer thickness in m. - real :: KV_BBL_min ! The minimum viscosities in the bottom and top - real :: KV_TBL_min ! boundary layers, both in m2 s-1. - - logical :: bottomdraglaw ! If true, the bottom stress is calculated with a - ! drag law c_drag*|u|*u. The velocity magnitude - ! may be an assumed value or it may be based on the - ! actual velocity in the bottommost HBBL, depending - ! on whether linear_drag is true. - logical :: BBL_use_EOS ! If true, use the equation of state in determining - ! the properties of the bottom boundary layer. - logical :: linear_drag ! If true, the drag law is cdrag*DRAG_BG_VEL*u. - logical :: Channel_drag ! If true, the drag is exerted directly on each - ! layer according to what fraction of the bottom - ! they overlie. - logical :: RiNo_mix ! If true, use Richardson number dependent mixing. - logical :: dynamic_viscous_ML ! If true, use a bulk Richardson number criterion to - ! determine the mixed layer thickness for viscosity. - real :: bulk_Ri_ML ! The bulk mixed layer used to determine the - ! thickness of the viscous mixed layer. Nondim. - real :: omega ! The Earth's rotation rate, in s-1. - real :: ustar_min ! A minimum value of ustar to avoid numerical - ! problems, in m s-1. If the value is small enough, - ! this should not affect the solution. - real :: TKE_decay ! The ratio of the natural Ekman depth to the TKE - ! decay scale, nondimensional. - real :: omega_frac ! When setting the decay scale for turbulence, use - ! this fraction of the absolute rotation rate blended - ! with the local value of f, as sqrt((1-of)*f^2 + of*4*omega^2). - logical :: debug ! If true, write verbose checksums for debugging purposes. - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. + real :: Hbbl !< The static bottom boundary layer thickness, in + !! the same units as thickness (m or kg m-2). + real :: cdrag !< The quadratic drag coefficient. + real :: c_Smag !< The Laplacian Smagorinsky coefficient for + !! calculating the drag in channels. + real :: drag_bg_vel !< An assumed unresolved background velocity for + !! calculating the bottom drag, in m s-1. + real :: BBL_thick_min !< The minimum bottom boundary layer thickness in + !! the same units as thickness (m or kg m-2). + !! This might be Kv / (cdrag * drag_bg_vel) to give + !! Kv as the minimum near-bottom viscosity. + real :: Htbl_shelf !< A nominal thickness of the surface boundary layer + !! for use in calculating the near-surface velocity, + !! in units of m. + real :: Htbl_shelf_min !< The minimum surface boundary layer thickness in m. + real :: KV_BBL_min !< The minimum viscosities in the bottom and top + real :: KV_TBL_min !< boundary layers, both in m2 s-1. + logical :: bottomdraglaw !< If true, the bottom stress is calculated with a + !! drag law c_drag*|u|*u. The velocity magnitude + !! may be an assumed value or it may be based on the + !! actual velocity in the bottommost HBBL, depending + !! on whether linear_drag is true. + logical :: BBL_use_EOS !< If true, use the equation of state in determining + !! the properties of the bottom boundary layer. + logical :: linear_drag !< If true, the drag law is cdrag*DRAG_BG_VEL*u. + logical :: Channel_drag !< If true, the drag is exerted directly on each + !! layer according to what fraction of the bottom + !! they overlie. + logical :: RiNo_mix !< If true, use Richardson number dependent mixing. + logical :: dynamic_viscous_ML !< If true, use a bulk Richardson number criterion to + !! determine the mixed layer thickness for viscosity. + real :: bulk_Ri_ML !< The bulk mixed layer used to determine the + !! thickness of the viscous mixed layer. Nondim. + real :: omega !< The Earth's rotation rate, in s-1. + real :: ustar_min !< A minimum value of ustar to avoid numerical + !! problems, in m s-1. If the value is small enough, + !! this should not affect the solution. + real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE + !! decay scale, nondimensional. + real :: omega_frac !< When setting the decay scale for turbulence, use + !! this fraction of the absolute rotation rate blended + !! with the local value of f, as sqrt((1-of)*f^2 + of*4*omega^2). + logical :: debug !< If true, write verbose checksums for debugging purposes. + type(ocean_OBC_type), pointer :: OBC => NULL() !< Open boundaries control structure + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. + !>@{ Diagnostics handles integer :: id_bbl_thick_u = -1, id_kv_bbl_u = -1 integer :: id_bbl_thick_v = -1, id_kv_bbl_v = -1 integer :: id_Ray_u = -1, id_Ray_v = -1 integer :: id_nkml_visc_u = -1, id_nkml_visc_v = -1 - type(ocean_OBC_type), pointer :: OBC => NULL() + !!@} end type set_visc_CS contains -!> The following subroutine calculates the thickness of the bottom -!! boundary layer and the viscosity within that layer. A drag law is -!! used, either linearized about an assumed bottom velocity or using +!> Calculates the thickness of the bottom boundary layer and the viscosity within that layer. +!! A drag law is used, either linearized about an assumed bottom velocity or using !! the actual near-bottom velocities combined with an assumed !! unresolved velocity. The bottom boundary layer thickness is !! limited by a combination of stratification and rotation, as in the @@ -1013,11 +1016,11 @@ function set_u_at_v(u, h, G, i, j, k, mask2dCu, OBC) end function set_u_at_v -!> The following subroutine calculates the thickness of the surface boundary -!! layer for applying an elevated viscosity. A bulk Richardson criterion or -!! the thickness of the topmost NKML layers (with a bulk mixed layer) are -!! currently used. The thicknesses are given in terms of fractional layers, so -!! that this thickness will move as the thickness of the topmost layers change. +!> Calculates the thickness of the surface boundary layer for applying an elevated viscosity. +!! +!! A bulk Richardson criterion or the thickness of the topmost NKML layers (with a bulk mixed layer) +!! are currently used. The thicknesses are given in terms of fractional layers, so that this +!! thickness will move as the thickness of the topmost layers change. subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -1039,29 +1042,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) logical, optional, intent(in) :: symmetrize !< If present and true, do extra calculations !! of those values in visc that would be !! calculated with symmetric memory. - -! The following subroutine calculates the thickness of the surface boundary -! layer for applying an elevated viscosity. A bulk Richardson criterion or -! the thickness of the topmost NKML layers (with a bulk mixed layer) are -! currently used. The thicknesses are given in terms of fractional layers, so -! that this thickness will move as the thickness of the topmost layers change. -! -! Arguments: u - Zonal velocity, in m s-1. -! (in) v - Meridional velocity, in m s-1. -! (in) h - Layer thickness, in m or kg m-2. In the comments below, -! the units of h are denoted as H. -! (in) tv - A structure containing pointers to any available -! thermodynamic fields. Absent fields have NULL ptrs. -! (in) forces - A structure containing pointers to mechanical -! forcing fields. Unused fields have NULL ptrs. -! (out) visc - A structure containing vertical viscosities and related -! fields. -! (in) dt - Time increment in s. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! vertvisc_init. - + ! Local variables real, dimension(SZIB_(G)) :: & htot, & ! The total depth of the layers being that are within the ! surface mixed layer, in H. @@ -1726,8 +1707,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) end subroutine set_viscous_ML -!> This subroutine is used to register any fields associated with the -!! vertvisc_type. +!> Register any fields associated with the vertvisc_type. subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -1738,15 +1718,7 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) !! Allocated here. type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control !! structure. -! This subroutine is used to register any fields associated with the -! vertvisc_type. -! Arguments: HI - A horizontal index type structure. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (out) visc - A structure containing vertical viscosities and related -! fields. Allocated here. -! (in) restart_CS - A pointer to the restart control structure. + ! Local variables logical :: use_kappa_shear, KS_at_vertex logical :: adiabatic, useKPP, useEPBL logical :: use_CVMix_shear, MLE_use_PBL_MLD, use_CVMix_conv @@ -1818,6 +1790,7 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) end subroutine set_visc_register_restarts +!> Initializes the MOM_set_visc control structure subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) type(time_type), target, intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -1831,7 +1804,6 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) type(set_visc_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure - ! Local variables real :: Csmag_chan_dflt, smag_const1, TKE_decay_dflt, bulk_Ri_ML_dflt real :: Kv_background @@ -1859,7 +1831,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) CS%diag => diag -! Set default, read and log parameters + ! Set default, read and log parameters call log_version(param_file, mdl, version, "") CS%RiNo_mix = .false. ; use_CVMix_ddiff = .false. differential_diffusion = .false. @@ -2113,37 +2085,12 @@ subroutine set_visc_end(visc, CS) deallocate(CS) end subroutine set_visc_end -!> \namespace MOM_set_visc -!!********+*********+*********+*********+*********+*********+*********+** -!!* * -!!* By Robert Hallberg, April 1994 - October 2006 * -!!* Quadratic Bottom Drag by James Stephens and R. Hallberg. * -!!* * -!!* This file contains the subroutine that calculates various values * -!!* related to the bottom boundary layer, such as the viscosity and * -!!* thickness of the BBL (set_viscous_BBL). This would also be the * -!!* module in which other viscous quantities that are flow-independent * -!!* might be set. This information is transmitted to other modules * -!!* via a vertvisc type structure. * -!!* * -!!* The same code is used for the two velocity components, by * -!!* indirectly referencing the velocities and defining a handful of * -!!* direction-specific defined variables. * -!!* * -!!* Macros written all in capital letters are defined in MOM_memory.h. * -!!* * -!!* A small fragment of the grid is shown below: * -!!* * -!!* j+1 x ^ x ^ x At x: q * -!!* j+1 > o > o > At ^: v, frhatv, tauy * -!!* j x ^ x ^ x At >: u, frhatu, taux * -!!* j > o > o > At o: h * -!!* j-1 x ^ x ^ x * -!!* i-1 i i+1 At x & ^: * -!!* i i+1 At > & o: * -!!* * -!!* The boundaries always run through q grid points (x). * -!!* * -!!********+*********+*********+*********+*********+*********+*********+** +!> \namespace mom_set_visc +!! +!! This would also be the module in which other viscous quantities that are flow-independent might be set. +!! This information is transmitted to other modules via a vertvisc type structure. +!! +!! The same code is used for the two velocity components, by indirectly referencing the velocities and +!! defining a handful of direction-specific defined variables. end module MOM_set_visc From 639ffd7b97b03c1226531993b2246260ddc94332 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 9 Jul 2018 16:17:53 -0400 Subject: [PATCH 0540/1072] Doxygenized MOM_geothermal_heating control structure - Fixes doxygen errors. --- .../vertical/MOM_geothermal.F90 | 100 +++++------------- 1 file changed, 26 insertions(+), 74 deletions(-) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 1b5c052db1..360c3a791d 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -1,38 +1,8 @@ +!> Implemented geothermal heating at the ocean bottom. module MOM_geothermal ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, 2010. * -!* * -!* This file contains the subroutine (geothemal) that implements * -!* a geothermal heating at the bottom. This can be done either in a * -!* layered isopycnal mode, in which the heating raises the density of * -!* the layer to the target density of the layer above, and then moves * -!* the water into that layer, or in a simple Eulerian mode, in which * -!* the bottommost GEOTHERMAL_THICKNESS are heated. Geothermal heating* -!* will also provide a buoyant source of bottom TKE that can be used * -!* to further mix the near-bottom water. In cold fresh water lakes * -!* where heating increases density, water should be moved into deeper * -!* layers, but this is not implemented yet. * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, buoy, Rml, eaml, ebml, etc. * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : register_static_field, time_type, diag_ctrl use MOM_error_handler, only : MOM_error, FATAL, WARNING @@ -49,26 +19,26 @@ module MOM_geothermal public geothermal, geothermal_init, geothermal_end +!> Control structure for geothermal heating type, public :: geothermal_CS ; private - real :: dRcv_dT_inplace ! The value of dRcv_dT above which (dRcv_dT is - ! negative) the water is heated in place instead - ! of moving upward between layers, in kg m-3 K-1. - real, pointer :: geo_heat(:,:) => NULL() ! The geothermal heat flux, in - ! W m-2. - real :: geothermal_thick ! The thickness over which geothermal heating is - ! applied, in m. - logical :: apply_geothermal ! If true, geothermal heating will be applied - ! otherwise GEOTHERMAL_SCALE has been set to 0 and - ! there is no heat to apply. - - type(time_type), pointer :: Time => NULL() ! A pointer to the ocean model's clock. - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. + real :: dRcv_dT_inplace !< The value of dRcv_dT above which (dRcv_dT is + !! negative) the water is heated in place instead + !! of moving upward between layers, in kg m-3 K-1. + real, pointer :: geo_heat(:,:) => NULL() !< The geothermal heat flux, in W m-2. + real :: geothermal_thick !< The thickness over which geothermal heating is + !! applied, in m. + logical :: apply_geothermal !< If true, geothermal heating will be applied + !! otherwise GEOTHERMAL_SCALE has been set to 0 and + !! there is no heat to apply. + + type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. end type geothermal_CS contains -!> This subroutine applies geothermal heating, including the movement of water +!> Applies geothermal heating, including the movement of water !! between isopycnal layers to match the target densities. The heating is !! applied to the bottommost layers that occur within ### of the bottom. If !! the partial derivative of the coordinate density with temperature is positive @@ -99,32 +69,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS) type(geothermal_CS), pointer :: CS !< The control structure returned by !! a previous call to !! geothermal_init. - -! This subroutine applies geothermal heating, including the movement of water -! between isopycnal layers to match the target densities. The heating is -! applied to the bottommost layers that occur within ### of the bottom. If -! the partial derivative of the coordinate density with temperature is positive -! or very small, the layers are simply heated in place. Any heat that can not -! be applied to the ocean is returned (WHERE)? - -! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out) -! The units of h are referred to as H below. -! (in/out) tv - A structure containing pointers to any available -! thermodynamic fields. Absent fields have NULL ptrs. -! (in) dt - Time increment, in s. -! (in/out) ea - The amount of fluid moved downward into a layer; this should -! be increased due to mixed layer detrainment, in the same units -! as h - usually m or kg m-2 (i.e., H). -! (in/out) eb - The amount of fluid moved upward into a layer; this should -! be increased due to mixed layer entrainment, in the same units -! as h - usually m or kg m-2 (i.e., H). -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! geothermal_init. - -! real :: resid(SZI_(G),SZJ_(G)) !z1l: never been used. - + ! Local variables real, dimension(SZI_(G)) :: & heat_rem, & ! remaining heat (H * degC) h_geo_rem, & ! remaining thickness to apply geothermal heating (units of H) @@ -371,11 +316,10 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) type(diag_ctrl), target, intent(inout) :: diag !< Structure used to regulate diagnostic output. type(geothermal_CS), pointer :: CS !< Pointer pointing to the module control !! structure. - ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mdl = "MOM_geothermal" ! module name + ! Local variables character(len=200) :: inputdir, geo_file, filename, geotherm_var real :: scale integer :: i, j, isd, ied, jsd, jed, id @@ -454,4 +398,12 @@ subroutine geothermal_end(CS) if (associated(CS)) deallocate(CS) end subroutine geothermal_end +!> \namespace mom_geothermal +!! +!! Geothermal heating can be added either in a layered isopycnal mode, in which the heating raises the density of the layer to the +!! target density of the layer above, and then moves the water into that layer, or in a simple Eulerian mode, in which the bottommost +!! GEOTHERMAL_THICKNESS are heated. Geothermal heating will also provide a buoyant source of bottom TKE that can be used to further +!! mix the near-bottom water. In cold fresh water lakes where heating increases density, water should be moved into deeper layers, but +!! this is not implemented yet. + end module MOM_geothermal From 62dea759f59430dce0697d5022af61dd7938aa75 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 9 Jul 2018 22:32:47 -0600 Subject: [PATCH 0541/1072] updates for get nuopc working --- config_src/nuopc_driver/MOM_ocean_model.F90 | 81 ++- config_src/nuopc_driver/mom_cap.F90 | 702 ++++++++++++++------ config_src/nuopc_driver/mom_cap_methods.F90 | 71 +- src/framework/MOM_restart.F90 | 10 +- 4 files changed, 570 insertions(+), 294 deletions(-) diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 9367e34a06..23d94212db 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -91,7 +91,6 @@ module MOM_ocean_model 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". @@ -231,7 +230,7 @@ module MOM_ocean_model !> ocean_model_init initializes the ocean model, including registering fields !! for restarts and reading restart files if appropriate. -subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) +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, @@ -247,6 +246,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) !! in the calculation of additional gas or other !! 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 @@ -277,6 +277,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) 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, C_p=OS%C_p, & use_temp=use_temperature) @@ -679,39 +680,65 @@ end subroutine update_ocean_model ! used for writing restart. timestamp will prepend to ! the any restart file name as a prefix. ! -! -subroutine ocean_model_restart(OS, timestamp) +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.) + !! 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 "//& "dynamics and advective times. Additional restart fields "//& "that have not been coded yet would be required for reproducibility.") + if (.not.OS%fluxes%fluxes_used) call MOM_error(FATAL, "ocean_model_restart "//& "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 + + write(6,*)'DEBUG: calling save_restart with restartname= ',restartname + write(6,*)'DEBUG: restart_outputdir is ',OS%dirs%restart_output_dir + + 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" @@ -749,6 +776,7 @@ subroutine ocean_model_end(Ocean_sfc, Ocean_state, Time) end subroutine ocean_model_end ! NAME="ocean_model_end" +!======================================================================= !> ocean_model_save_restart causes restart files associated with the ocean to be !! written out. @@ -779,8 +807,11 @@ 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) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 62e6a121bf..36cd3478cf 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -382,6 +382,7 @@ module mom_cap_mod use MOM_file_parser, only: get_param, log_version, param_file_type, close_param_file use MOM_get_input, only: Get_MOM_Input, directories use MOM_domains, only: pass_var + use MOM_error_handler, only: is_root_pe #ifdef MOM6_CAP use MOM_ocean_model, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type @@ -389,7 +390,7 @@ module mom_cap_mod use ocean_types_mod, only: ice_ocean_boundary_type, ocean_grid_type #endif #ifdef CESMCOUPLED - use mom_cap_methods, only: ocn_export, ocn_import + use mom_cap_methods, only: mom_import, mom_export use esmFlds, only: flds_scalar_name, flds_scalar_num use esmFlds, only: fldListFr, fldListTo, compocn, compname use esmFlds, only: flds_scalar_index_nx, flds_scalar_index_ny @@ -411,10 +412,13 @@ module mom_cap_mod use ESMF use NUOPC use NUOPC_Model, & - model_routine_SS => SetServices, & + model_routine_SS => SetServices, & model_label_DataInitialize => label_DataInitialize, & - model_label_Advance => label_Advance, & - model_label_Finalize => label_Finalize + model_label_Advance => label_Advance, & +#ifdef CESMCOUPLED + model_label_SetRunClock => label_SetRunClock, & +#endif + model_label_Finalize => label_Finalize use time_utils_mod @@ -461,11 +465,11 @@ module mom_cap_mod #ifdef CESMCOUPLED integer :: logunit ! logging unit number logical :: write_diagnostics = .false. + character(len=32) :: runtype ! Run type #else logical :: write_diagnostics = .true. #endif logical :: profile_memory = .true. - logical :: ocean_solo = .true. logical :: grid_attach_area = .false. integer(ESMF_KIND_I8) :: restart_interval logical :: sw_decomp @@ -473,14 +477,9 @@ module mom_cap_mod character(len=*),parameter :: u_file_u = & __FILE__ - contains - - !----------------------------------------------------------------------- - !------------------- Solo Ocean code starts here ----------------------- - !----------------------------------------------------------------------- +contains !=============================================================================== - !> NUOPC SetService method is the only public entry point. !! SetServices registers all of the user-provided subroutines !! in the module with the NUOPC layer. @@ -542,6 +541,20 @@ subroutine SetServices(gcomp, rc) file=__FILE__)) & return ! bail out +#ifdef CESMCOUPLED + call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, & + specRoutine=ModelSetRunClock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +#endif + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & specRoutine=ocean_model_finalize, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -600,15 +613,6 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) profile_memory=(trim(value)/="false") call ESMF_LogWrite('MOM_CAP:ProfileMemory = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) - call ESMF_AttributeGet(gcomp, name="OceanSolo", value=value, defaultValue="false", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ocean_solo=(trim(value)=="true") - call ESMF_LogWrite('MOM_CAP:OceanSolo = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) - ! Retrieve restart_interval in (seconds) ! A restart_interval value of 0 means no restart will be written. call ESMF_AttributeGet(gcomp, name="restart_interval", value=value, defaultValue="0", & @@ -656,7 +660,6 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) !! @param clock an ESMF_Clock object !! @param rc return code subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -665,13 +668,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) type(ESMF_VM) :: vm type(ESMF_Time) :: MyTime type(ESMF_TimeInterval) :: TINT - - type (ocean_public_type), pointer :: ocean_public => NULL() + type (ocean_public_type), pointer :: ocean_public => NULL() type (ocean_state_type), pointer :: ocean_state => NULL() type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() type(ocean_internalstate_wrapper) :: ocean_internalstate type(ocean_grid_type), pointer :: ocean_grid => NULL() - type(time_type) :: Run_len ! length of experiment type(time_type) :: Time type(time_type) :: Time_restart @@ -681,18 +682,29 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: dt_cpld = 86400 integer :: year=0, month=0, day=0, hour=0, minute=0, second=0 integer :: mpi_comm_mom - integer :: npes, pe0, i - - type(ESMF_Grid) :: gridIn - type(ESMF_Grid) :: gridOut - type(param_file_type) :: param_file !< A structure to parse for run-time parameters - type(directories) :: dirs_tmp !< A structure containing several relevant directory paths - character(len=384) :: pointer_filename - integer :: npet, npet_x, npet_y - integer :: n,nflds - logical :: activefld - character(80) :: stdname, shortname - character(len=*),parameter :: subname='(mom_cap:InitializeAdvertise)' + integer :: i,n + character(80) :: stdname, shortname +#ifdef CESMCOUPLED + integer :: nflds + logical :: activefld + character(len=32) :: starttype ! model start type + integer :: logunit + character(len=512) :: diro + character(len=512) :: logfile + character(len=64) :: cvalue + integer :: shrlogunit ! original log unit + integer :: shrloglev ! original log level + integer :: inst_index ! number of current instance (ie. 1) + character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") + character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") + logical :: isPresent + character(len=384) :: restart_pointer_file ! File name for restart pointer file + character(len=384) :: restartfile ! Path/Name of restart file + character(len=384) :: restartname ! The restart file name (no dir) + integer :: nu ! i/o unit to read pointer file +#endif + character(len=*),parameter :: subname='(mom_cap:InitializeAdvertise)' + !-------------------------------- rc = ESMF_SUCCESS @@ -722,10 +734,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out - call ESMF_TimeGet (MyTime, & - YY=YEAR, MM=MONTH, DD=DAY, & - H=HOUR, M =MINUTE, S =SECOND, & - RC=rc ) + call ESMF_TimeGet (MyTime, YY=YEAR, MM=MONTH, DD=DAY, H=HOUR, M=MINUTE, S=SECOND, RC=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -742,6 +751,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call field_manager_init call set_calendar_type (JULIAN) call diag_manager_init + ! this ocean connector will be driven at set interval dt_cpld = DT_OCEAN DT = set_time (DT_OCEAN, 0) @@ -760,7 +770,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !tcx call data_override_init(ocean_domain_in = ocean_public%domain) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - write(6,*)'DEBUG: isc,iec,jsc,jec= ',isc,iec,jsc,jec call IOB_allocate(ice_ocean_boundary, isc, iec, jsc, jec) call external_coupler_sbc_init(ocean_public%domain, dt_cpld, Run_len) @@ -773,8 +782,104 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) return ! bail out #ifdef CESMCOUPLED - ! WARNING tcx tcraig - ! tcraig this is just a starting point, the fields are not complete or correct here + + ! determine instance information + call NUOPC_CompAttributeGet(gcomp, name="inst_name", value=inst_name, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call NUOPC_CompAttributeGet(gcomp, name="inst_index", value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + read(cvalue,*) inst_index + + call ESMF_AttributeGet(gcomp, name="inst_suffix", isPresent=isPresent, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent) then + call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", value=inst_suffix, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else + inst_suffix = '' + end if + + ! reset shr logging to my log file + if (is_root_pe()) then + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + logunit = shr_file_getUnit() + open(logunit,file=trim(diro)//"/"//trim(logfile)) + else + logunit = 6 + endif + + call shr_file_getLogUnit (shrlogunit) + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogLevel(max(shrloglev,1)) + call shr_file_setLogUnit (logunit) + + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + read(cvalue,*) starttype + + if (trim(starttype) == trim('startup')) then + runtype = "initial" + else if (trim(starttype) == trim('continue') ) then + runtype = "continue" + else if (trim(starttype) == trim('branch')) then + runtype = "continue" + else + call ESMF_LogWrite(subname//' ERROR: unknown starttype '//trim(starttype), ESMF_LOGMSG_ERROR, rc=dbrc) + rc = ESMF_FAILURE + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + + if (runtype == "initial") then + ! startup (new run) - 'n' is needed below since we don't specify input_filename in input.nml + call ocean_model_init(ocean_public, ocean_state, Time, Time, input_restart_file = 'n') + + else ! hybrid or branch or continuos runs + + ! read name of restart file in the pointer file + nu = shr_file_getUnit() + restart_pointer_file = 'rpointer.ocn' + if (is_root_pe()) then + write(logunit,*) 'Reading ocn pointer file: ',restart_pointer_file + end if + open(nu, file=restart_pointer_file, form='formatted', status='unknown') + read(nu,'(a)') restartfile + close(nu) + + ! initialize from restart file + if (is_root_pe()) then + write(logunit,*) 'Reading restart file: ',trim(restartfile) + end if + call shr_file_freeUnit(nu) + end if ! create import and export field list needed by data models call shr_nuopc_fldList_Concat(fldListFr(compocn), fldListTo(compocn), flds_o2x, flds_x2o, flds_scalar_name) @@ -801,7 +906,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) end if call ESMF_LogWrite(subname//':To_'//trim(compname(compocn))//': '//trim(shortname), ESMF_LOGMSG_INFO) end do + #else + call MOM_FieldsSetup(ice_ocean_boundary, ocean_public) call MOM_AdvertiseFields(importState, fldsToOcn_num, fldsToOcn, rc) @@ -852,51 +959,51 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! Local Variables - type(ESMF_VM) :: vm - type(ESMF_Grid) :: gridIn - type(ESMF_Grid) :: gridOut - type(ESMF_DeLayout) :: delayout - type(ESMF_Distgrid) :: Distgrid + type(ESMF_VM) :: vm + type(ESMF_Grid) :: gridIn + type(ESMF_Grid) :: gridOut + type(ESMF_DeLayout) :: delayout + type(ESMF_Distgrid) :: Distgrid type(ESMF_DistGridConnection), allocatable :: connectionList(:) - type (ocean_public_type), pointer :: ocean_public => NULL() - type (ocean_state_type), pointer :: ocean_state => NULL() - type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() - type(ocean_internalstate_wrapper) :: ocean_internalstate - integer :: npet, ntiles - integer :: nxg, nyg, cnt - integer :: isc,iec,jsc,jec - integer, allocatable :: xb(:),xe(:),yb(:),ye(:),pe(:) - integer, allocatable :: deBlockList(:,:,:) - integer, allocatable :: petMap(:) - integer, allocatable :: deLabelList(:) - integer, allocatable :: indexList(:) - integer :: ioff, joff - integer :: i, j, n, i1, j1, n1, icount - integer :: lbnd1,ubnd1,lbnd2,ubnd2 - integer :: lbnd3,ubnd3,lbnd4,ubnd4 - integer :: nblocks_tot - logical :: found - real(ESMF_KIND_R8), allocatable :: ofld(:,:), gfld(:,:) - real(ESMF_KIND_R8), pointer :: t_surf(:,:) - integer(ESMF_KIND_I4), pointer :: dataPtr_mask(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_area(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_xcen(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ycen(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_xcor(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ycor(:,:) - type(ESMF_Field) :: field_t_surf - integer :: mpicom - integer :: localPet + type (ocean_public_type), pointer :: ocean_public => NULL() + type (ocean_state_type), pointer :: ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + integer :: npet, ntiles + integer :: nxg, nyg, cnt + integer :: isc,iec,jsc,jec + integer, allocatable :: xb(:),xe(:),yb(:),ye(:),pe(:) + integer, allocatable :: deBlockList(:,:,:) + integer, allocatable :: petMap(:) + integer, allocatable :: deLabelList(:) + integer, allocatable :: indexList(:) + integer :: ioff, joff + integer :: i, j, n, i1, j1, n1, icount + integer :: lbnd1,ubnd1,lbnd2,ubnd2 + integer :: lbnd3,ubnd3,lbnd4,ubnd4 + integer :: nblocks_tot + logical :: found + real(ESMF_KIND_R8), allocatable :: ofld(:,:), gfld(:,:) + real(ESMF_KIND_R8), pointer :: t_surf(:,:) + integer(ESMF_KIND_I4), pointer :: dataPtr_mask(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_area(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_xcen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ycen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_xcor(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ycor(:,:) + type(ESMF_Field) :: field_t_surf + integer :: mpicom + integer :: localPet #ifdef CESMCOUPLED - integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - integer :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") - character(len=64) :: cvalue - character(len=512) :: diro - character(len=512) :: logfile - logical :: isPresent + integer :: shrlogunit ! original log unit + integer :: shrloglev ! original log level + integer :: inst_index ! number of current instance (ie. 1) + character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") + character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") + character(len=64) :: cvalue + character(len=512) :: diro + character(len=512) :: logfile + logical :: isPresent #endif character(len=*),parameter :: subname='(mom_cap:InitializeRealize)' !-------------------------------- @@ -933,60 +1040,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out -#ifdef CESMCOUPLED - ! determine instance information - call NUOPC_CompAttributeGet(gcomp, name="inst_name", value=inst_name, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call NUOPC_CompAttributeGet(gcomp, name="inst_index", value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - read(cvalue,*) inst_index - - call ESMF_AttributeGet(gcomp, name="inst_suffix", isPresent=isPresent, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (isPresent) then - call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", value=inst_suffix, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else - inst_suffix = '' - end if - - ! reset shr logging to my log file - if (localPet == 0) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - logunit = shr_file_getUnit() - open(logunit,file=trim(diro)//"/"//trim(logfile)) - else - logunit = 6 - endif - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) - call shr_file_setLogUnit (logunit) -#endif - !--------------------------------- ! global mom grid size !--------------------------------- @@ -1399,19 +1452,31 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) #ifdef CESMCOUPLED call shr_nuopc_fldList_Realize(importState, fldListTo(compocn), flds_scalar_name, flds_scalar_num, & grid=gridIn, tag=subname//':MOM6Import', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out call shr_nuopc_fldList_Realize(exportState, fldListFr(compocn), flds_scalar_name, flds_scalar_num, & grid=gridOut, tag=subname//':MOM6Export', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, mpicom, & flds_scalar_name, flds_scalar_num, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, mpicom, & flds_scalar_name, flds_scalar_num, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out #else call MOM_RealizeFields(importState, gridIn , fldsToOcn_num, fldsToOcn, "Ocn import", rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1472,12 +1537,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) write(*,*) '----- MOM initialization phase Realize completed' -#ifdef CESMCOUPLED - ! Reset shr logging to original values - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) -#endif - end subroutine InitializeRealize !=============================================================================== @@ -1497,11 +1556,7 @@ subroutine DataInitialize(gcomp, rc) character(240) :: msgString integer :: fieldCount, n type(ESMF_Field) :: field -#ifdef CESMCOUPLED - integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level -#endif - character(len=64),allocatable :: fieldNameList(:) + character(len=64),allocatable :: fieldNameList(:) character(len=*),parameter :: subname='(mom_cap:DataInitialize)' ! query the Component for its clock, importState and exportState @@ -1522,7 +1577,7 @@ subroutine DataInitialize(gcomp, rc) ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr call get_ocean_grid(ocean_state, ocean_grid) - call ocn_export(ocean_public, ocean_grid, exportState, rc=rc) + call mom_export(ocean_public, ocean_grid, exportState, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1590,6 +1645,7 @@ subroutine ModelAdvance(gcomp, rc) ! local variables type(ESMF_Clock) :: clock + type(ESMF_Alarm) :: alarm type(ESMF_State) :: importState, exportState type(ESMF_Time) :: currTime type(ESMF_TimeInterval) :: timeStep @@ -1609,8 +1665,17 @@ subroutine ModelAdvance(gcomp, rc) integer :: i,j,i1,j1 integer :: nc #ifdef CESMCOUPLED + type(ESMF_Time) :: MyTime + integer :: seconds, day, year, month, hour, minute integer :: shrlogunit ! original log unit integer :: shrloglev ! original log level + integer :: logunit ! i/o unit for stdout + integer :: nu ! i/o unit to write pointer file + logical :: force_restart_now + character(ESMF_MAXSTR) :: cvalue + character(ESMF_MAXSTR) :: runid ! Run ID + character(len=384) :: restartname ! restart file name (no dir) + character(len=384) :: restart_pointer_file ! file name for restart pointer file #else real(ESMF_KIND_R8), allocatable :: ofld(:,:), ocz(:,:), ocm(:,:) real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) @@ -1626,6 +1691,7 @@ subroutine ModelAdvance(gcomp, rc) type(ocean_grid_type), pointer :: ocean_grid character(240) :: msgString character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' + !-------------------------------- rc = ESMF_SUCCESS if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") @@ -1648,14 +1714,6 @@ subroutine ModelAdvance(gcomp, rc) ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr -#ifdef CESMCOUPLED - ! Reset shr logging to my log file - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) - call shr_file_setLogUnit (logunit) -#endif - ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep call ESMF_ClockPrint(clock, options="currTime", & @@ -1718,15 +1776,6 @@ subroutine ModelAdvance(gcomp, rc) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - write(msgString,'(A,L3)') 'ocean_solo=',ocean_solo - call ESMF_LogWrite(trim(subname)//trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if(.not. ocean_solo) then - call ESMF_LogWrite(subname//' tcx in not ocean_solo', ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1741,7 +1790,13 @@ subroutine ModelAdvance(gcomp, rc) !#endif #ifdef CESMCOUPLED - call ocn_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, logunit, clock, rc=rc) + ! Reset shr logging to my log file + call shr_file_getLogUnit (shrlogunit) + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogLevel(max(shrloglev,1)) + call shr_file_setLogUnit (logunit) + + call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, logunit, runtype, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1798,7 +1853,6 @@ subroutine ModelAdvance(gcomp, rc) dataPtr_mmmf = mmmf deallocate(mzmf, mmmf) #endif - endif ! not ocean_solo !Optionally write restart files when currTime-startTime is integer multiples of restart_interval if(restart_interval > 0 ) then @@ -1822,8 +1876,6 @@ subroutine ModelAdvance(gcomp, rc) call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled) if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") - if(.not. ocean_solo) then - !#ifdef MOM5_CAP call get_ocean_grid(ocean_state, ocean_grid) !#endif @@ -1832,16 +1884,100 @@ subroutine ModelAdvance(gcomp, rc) !#endif #ifdef CESMCOUPLED - call ESMF_LogWrite(subname//' tcx call ocn_export', ESMF_LOGMSG_INFO, rc=rc) + call mom_export(ocean_public, ocean_grid, exportState, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call ocn_export(ocean_public, ocean_grid, exportState, rc=rc) + + !DEBUG + call ESMF_ClockGet(clock, currTIME=MyTime, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, s=seconds, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + !DEBUG + + ! Determine if need to write restart + call ESMF_ClockGetAlarm(clock, alarmname='seq_timemgr_alarm_restart', alarm=alarm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + write(6,*)'DEBUG: alarm is ringing' + + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + force_restart_now = .true. + call ESMF_AlarmRingerOff( alarm, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else + force_restart_now = .false. + endif + + if (debug > 0 .and. is_root_pe()) then + write(logunit) subname//' force_restart_now=', force_restart_now + end if + + write(6,*)'DEBUG: day,seconds,restart= ',day,seconds,force_restart_now + + if (force_restart_now) then + + ! determine restart filename + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + read(cvalue,*) runid + call ESMF_ClockGet(clock, currTIME=MyTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, h=hour, m=minute, s=seconds, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + seconds = seconds + hour*3600 + minute*60 + write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I5.5)') trim(runid), year, month, day, seconds + write(6,*)'DEBUG: runid= ',runid + write(6,*)'DEBUG: year,month,day,seconds= ',year,month,day,seconds + write(6,*)'DEBUG: restartname= ',trim(restartname) + + ! write name of restart file in the rpointer file + nu = shr_file_getUnit() + if (is_root_pe()) then + restart_pointer_file = 'rpointer.ocn' + open(nu, file=restart_pointer_file, form='formatted', status='unknown') + write(nu,'(a)') trim(restartname) //'.nc' + close(nu) + write(logunit,*) 'ocn restart pointer file written: ',trim(restartname) + endif + call shr_file_freeUnit(nu) + + ! write restart file(s) + call ocean_model_restart(ocean_state, restartname=restartname) + + endif + + ! reset shr logging to my original values + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + #else allocate(ofld(isc:iec,jsc:jec)) @@ -1890,7 +2026,6 @@ subroutine ModelAdvance(gcomp, rc) enddo enddo deallocate(ocz, ocm) - endif ! not ocean_solo !call ESMF_LogWrite("Before writing diagnostics", dataPtr_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc)) do j = lbnd2, ubnd2 @@ -1939,7 +2074,8 @@ subroutine ModelAdvance(gcomp, rc) deallocate(ocz, ocm) #endif - if(write_diagnostics) then + + if (write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & timeslice=export_slice, relaxedFlag=.true., rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1949,53 +2085,182 @@ subroutine ModelAdvance(gcomp, rc) export_slice = export_slice + 1 endif - endif ! not ocean_solo - - call ESMF_LogWrite("Before calling sbc forcing", ESMF_LOGMSG_INFO, rc=rc) + !call ESMF_LogWrite("Before calling sbc forcing", ESMF_LOGMSG_INFO, rc=rc) call external_coupler_sbc_after(Ice_ocean_boundary, ocean_public, nc, dt_cpld ) - call ESMF_LogWrite("Before dumpMomInternal", ESMF_LOGMSG_INFO, rc=rc) + !call ESMF_LogWrite("Before dumpMomInternal", ESMF_LOGMSG_INFO, rc=rc) !write(*,*) 'MOM: --- run phase called ---' - call dumpMomInternal(mom_grid_i, import_slice, "mean_zonal_moment_flx", "will provide", Ice_ocean_boundary%u_flux) - call dumpMomInternal(mom_grid_i, import_slice, "mean_merid_moment_flx", "will provide", Ice_ocean_boundary%v_flux) - call dumpMomInternal(mom_grid_i, import_slice, "mean_sensi_heat_flx" , "will provide", Ice_ocean_boundary%t_flux) - call dumpMomInternal(mom_grid_i, import_slice, "mean_evap_rate" , "will provide", Ice_ocean_boundary%q_flux) - call dumpMomInternal(mom_grid_i, import_slice, "mean_salt_rate" , "will provide", Ice_ocean_boundary%salt_flux) - call dumpMomInternal(mom_grid_i, import_slice, "mean_net_lw_flx" , "will provide", Ice_ocean_boundary%lw_flux ) - call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dir_flx", "will provide", Ice_ocean_boundary%sw_flux_vis_dir) - call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dif_flx", "will provide", Ice_ocean_boundary%sw_flux_vis_dif) - call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dir_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dir) - call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dif_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dif) - call dumpMomInternal(mom_grid_i, import_slice, "mean_prec_rate" , "will provide", Ice_ocean_boundary%lprec ) - call dumpMomInternal(mom_grid_i, import_slice, "mean_fprec_rate" , "will provide", Ice_ocean_boundary%fprec ) - call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_rate" , "will provide", Ice_ocean_boundary%runoff ) - call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_rate" , "will provide", Ice_ocean_boundary%calving) - call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_heat_flx" , "will provide", Ice_ocean_boundary%runoff_hflx ) - call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_heat_flx", "will provide", Ice_ocean_boundary%calving_hflx) - call dumpMomInternal(mom_grid_i, import_slice, "inst_pres_height_surface" , "will provide", Ice_ocean_boundary%p ) - call dumpMomInternal(mom_grid_i, import_slice, "mass_of_overlying_sea_ice", "will provide", Ice_ocean_boundary%mi) + call dumpMomInternal(mom_grid_i, import_slice, "mean_zonal_moment_flx" , "will provide", Ice_ocean_boundary%u_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_merid_moment_flx" , "will provide", Ice_ocean_boundary%v_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_sensi_heat_flx" , "will provide", Ice_ocean_boundary%t_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_evap_rate" , "will provide", Ice_ocean_boundary%q_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_salt_rate" , "will provide", Ice_ocean_boundary%salt_flux) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_lw_flx" , "will provide", Ice_ocean_boundary%lw_flux ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dir_flx" , "will provide", Ice_ocean_boundary%sw_flux_vis_dir) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dif_flx" , "will provide", Ice_ocean_boundary%sw_flux_vis_dif) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dir_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dir) + call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dif_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dif) + call dumpMomInternal(mom_grid_i, import_slice, "mean_prec_rate" , "will provide", Ice_ocean_boundary%lprec ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_fprec_rate" , "will provide", Ice_ocean_boundary%fprec ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_rate" , "will provide", Ice_ocean_boundary%runoff ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_rate" , "will provide", Ice_ocean_boundary%calving) + call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_heat_flx" , "will provide", Ice_ocean_boundary%runoff_hflx ) + call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_heat_flx" , "will provide", Ice_ocean_boundary%calving_hflx) + call dumpMomInternal(mom_grid_i, import_slice, "inst_pres_height_surface" , "will provide", Ice_ocean_boundary%p ) + call dumpMomInternal(mom_grid_i, import_slice, "mass_of_overlying_sea_ice" , "will provide", Ice_ocean_boundary%mi) !--------- export fields ------------- -! call dumpMomInternal(mom_grid_i, export_slice, "ocean_mask", "will provide", dataPtr_mask) - call dumpMomInternal(mom_grid_i, export_slice, "sea_surface_temperature", "will provide", ocean_public%t_surf) - call dumpMomInternal(mom_grid_i, export_slice, "s_surf" , "will provide", ocean_public%s_surf ) - call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_zonal", "will provide", ocean_public%u_surf ) - call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_merid", "will provide", ocean_public%v_surf ) - call dumpMomInternal(mom_grid_i, export_slice, "sea_lev" , "will provide", ocean_public%sea_lev) +! call dumpMomInternal(mom_grid_i, export_slice, "ocean_mask" , "will provide", dataPtr_mask) + call dumpMomInternal(mom_grid_i, export_slice, "sea_surface_temperature" , "will provide", ocean_public%t_surf) + call dumpMomInternal(mom_grid_i, export_slice, "s_surf" , "will provide", ocean_public%s_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_zonal" , "will provide", ocean_public%u_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_merid" , "will provide", ocean_public%v_surf ) + call dumpMomInternal(mom_grid_i, export_slice, "sea_lev" , "will provide", ocean_public%sea_lev) if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") -#ifdef CESMCOUPLED - ! reset shr logging to my original values - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) -#endif - end subroutine ModelAdvance !=============================================================================== + subroutine ModelSetRunClock(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: mclock, dclock + type(ESMF_Time) :: mcurrtime, dcurrtime + type(ESMF_Time) :: mstoptime + type(ESMF_TimeInterval) :: mtimestep, dtimestep + character(len=128) :: mtimestring, dtimestring + type(ESMF_Alarm),pointer :: alarmList(:) + type(ESMF_Alarm) :: dalarm + integer :: alarmcount, n + character(len=*),parameter :: subname='mom_cap:(ModelSetRunClock) ' + !-------------------------------- + + rc = ESMF_SUCCESS + + ! query the Component for its clock, importState and exportState + call NUOPC_ModelGet(gcomp, driverClock=dclock, modelClock=mclock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(dclock, currTime=dcurrtime, timeStep=dtimestep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(mclock, currTime=mcurrtime, timeStep=mtimestep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !-------------------------------- + ! check that the current time in the model and driver are the same + !-------------------------------- + + if (mcurrtime /= dcurrtime) then + call ESMF_TimeGet(dcurrtime, timeString=dtimestring, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_TimeGet(mcurrtime, timeString=mtimestring, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_LogWrite(subname//" ERROR in time consistency; "//trim(dtimestring)//" ne "//trim(mtimestring), & + ESMF_LOGMSG_ERROR, rc=dbrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + rc=ESMF_Failure + endif + + !-------------------------------- + ! force model clock currtime and timestep to match driver and set stoptime + !-------------------------------- + + mstoptime = mcurrtime + dtimestep + + call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !-------------------------------- + ! copy alarms from driver to model clock if model clock has no alarms (do this only once!) + !-------------------------------- + + call ESMF_ClockGetAlarmList(mclock, alarmlistflag=ESMF_ALARMLIST_ALL, alarmCount=alarmCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (alarmCount == 0) then + call ESMF_ClockGetAlarmList(dclock, alarmlistflag=ESMF_ALARMLIST_ALL, alarmCount=alarmCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + allocate(alarmList(alarmCount)) + call ESMF_ClockGetAlarmList(dclock, alarmlistflag=ESMF_ALARMLIST_ALL, alarmList=alarmList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + do n = 1, alarmCount + ! call ESMF_AlarmPrint(alarmList(n), rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + dalarm = ESMF_AlarmCreate(alarmList(n), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_AlarmSet(dalarm, clock=mclock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + enddo + + deallocate(alarmList) + endif + + !-------------------------------- + ! Advance model clock to trigger alarms then reset model clock back to currtime + !-------------------------------- + + call ESMF_ClockAdvance(mclock,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end subroutine ModelSetRunClock + + !=============================================================================== + !> Called by NUOPC at the end of the run to clean up. !! !! @param gcomp an ESMF_GridComp object @@ -2471,7 +2736,6 @@ subroutine dumpMomInternal(grid, slice, stdname, nop, farray) #endif if(.not. write_diagnostics) return ! nop in production mode - if(ocean_solo) return ! do not dump internal fields in ocean solo mode field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, & indexflag=ESMF_INDEX_DELOCAL, & diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index e16a580ad1..55809b76f1 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -18,8 +18,8 @@ module mom_cap_methods private ! Public member functions - public :: ocn_export - public :: ocn_import + public :: mom_export + public :: mom_import integer :: rc,dbrc integer :: import_cnt = 0 @@ -32,9 +32,9 @@ module mom_cap_methods !----------------------------------------------------------------------- !> Maps outgoing ocean data to ESMF State - !! See \ref section_ocn_export for a summary of the data + !! See \ref section_mom_export for a summary of the data !! that is transferred from MOM6 to MCT. - subroutine ocn_export(ocean_public, grid, exportState, rc) + subroutine mom_export(ocean_public, grid, exportState, rc) type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid type(ESMF_State) , intent(inout) :: exportState !< outgoing data @@ -144,35 +144,6 @@ subroutine ocn_export(ocean_public, grid, exportState, rc) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - !tcx - ! write(tmpstr,'(a,6i8)') subname//'tcx1',lbnd1,ubnd1,lbnd2,ubnd2 - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx2',isc,iec,jsc,jec - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx3_1',lbound(ssh,1),ubound(ssh,1) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx3_2',lbound(ssh,2),ubound(ssh,2) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx4_1',lbound(ocean_public%sea_lev,1),ubound(ocean_public%sea_lev,1) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx4_2',lbound(ocean_public%sea_lev,2),ubound(ocean_public%sea_lev,2) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx5_1',lbound(grid%mask2dT,1),ubound(grid%mask2dT,1) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx5_2',lbound(grid%mask2dT,2),ubound(grid%mask2dT,2) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx6',grid%isd,grid%ied,grid%jsd,grid%jed - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx7',grid%isc,grid%iec,grid%jsc,grid%jec - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx8',grid%idg_offset, grid%jdg_offset - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx9_1',lbound(dataPtr_omask,1),ubound(dataPtr_omask,1) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx9_2',lbound(dataPtr_omask,2),ubound(dataPtr_omask,2) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - !tcx - !Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. !The mask comes from "grid" that uses the usual MOM domain that has halos !and does not use global indexing. @@ -273,7 +244,7 @@ subroutine ocn_export(ocean_public, grid, exportState, rc) end do end do - end subroutine ocn_export + end subroutine mom_export !----------------------------------------------------------------------- @@ -283,13 +254,16 @@ end subroutine ocn_export !! 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 ocn_import(ocean_public, grid, importState, ice_ocean_boundary, logunit, clock, rc) + subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & + logunit, runtype, clock, rc) + type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid type(ESMF_State) , intent(inout) :: importState !< incoming data type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing type(ESMF_Clock) , intent(in) :: clock integer , intent(in) :: logunit + character(len=*) , intent(in) :: runtype integer , intent(inout) :: rc ! Local Variables @@ -329,6 +303,7 @@ subroutine ocn_import(ocean_public, grid, importState, ice_ocean_boundary, logun real(ESMF_KIND_R8), pointer :: dataPtr_snow(:,:) integer :: day, secs type(ESMF_time) :: currTime + logical :: do_import character(len=*), parameter :: F01 = "('(ocn_import) ',a,4(i6,2x),d21.14)" character(len=*), parameter :: subname = '(ocn_import)' !----------------------------------------------------------------------- @@ -507,6 +482,14 @@ subroutine ocn_import(ocean_public, grid, importState, ice_ocean_boundary, logun ! write(tmpstr,'(a,i8)') subname//' tcx import_cnt ',import_cnt ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + if ((trim(runtype) == 'initial' .and. import_cnt <= 2)) then + ! This will skip the first time import information is given + do_import = .false. + else + do_import = .true. + end if + write(6,*)'DEBUG: import_cnt, do_import= ',import_cnt, do_import + do j = jsc, jec j1 = j + lbnd2 - jsc jg = j + grid%jsc - jsc @@ -535,9 +518,7 @@ subroutine ocn_import(ocean_public, grid, importState, ice_ocean_boundary, logun ! ice_ocean_boundary%mass_berg(i,j) = 0.0 * GRID%mask2dT(ig,jg) ! ice_ocean_boundary%mi(i,j) = 0.0 * GRID%mask2dT(ig,jg) - ! This will skip the first time import information is given - if (import_cnt > 2) then - + if (do_import) then ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) * GRID%mask2dT(ig,jg) ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) * GRID%mask2dT(ig,jg) ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) * GRID%mask2dT(ig,jg) @@ -557,6 +538,7 @@ subroutine ocn_import(ocean_public, grid, importState, ice_ocean_boundary, logun !ice_ocean_boundary%u_flux(i,j) = (GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1)) !ice_ocean_boundary%v_flux(i,j) = (GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1)) endif + enddo enddo @@ -587,15 +569,14 @@ subroutine ocn_import(ocean_public, grid, importState, ice_ocean_boundary, logun end do end if - end subroutine ocn_import - - !----------------------------------------------------------------------------- + end subroutine mom_import + !----------------------------------------------------------------------------- subroutine State_GetFldPtr(ST, fldname, fldptr, rc) - type(ESMF_State), intent(in) :: ST - character(len=*), intent(in) :: fldname - real(ESMF_KIND_R8), pointer, intent(in) :: fldptr(:,:) - integer, intent(out), optional :: rc + type(ESMF_State) , intent(in) :: ST + character(len=*) , intent(in) :: fldname + real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:,:) + integer, optional , intent(out) :: rc ! local variables type(ESMF_Field) :: lfield diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index d2d782e2c1..103e3930bf 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -850,8 +850,8 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV) type(vardesc) :: vars(CS%max_fields) ! Descriptions of the fields that ! are to be read from the restart file. type(fieldtype) :: fields(CS%max_fields) ! - character(len=200) :: restartpath ! The restart file path (dir/file). - character(len=80) :: restartname ! The restart file name (no dir). + character(len=512) :: restartpath ! The restart file path (dir/file). + character(len=256) :: restartname ! The restart file name (no dir). character(len=8) :: suffix ! A suffix (like _2) that is appended ! to the name of files after the first. integer(kind=8) :: var_sz, size_in_file ! The size in bytes of each variable @@ -1439,9 +1439,9 @@ function open_restart_units(filename, directory, G, CS, units, file_paths, & ! (in/out) CS - The control structure returned by a previous call to ! restart_init. - character(len=200) :: filepath ! The path (dir/file) to the file being opened. - character(len=80) :: fname ! The name of the current file. - character(len=8) :: suffix ! A suffix (like "_2") that is added to any + character(len=256) :: filepath ! The path (dir/file) to the file being opened. + character(len=256) :: fname ! The name of the current file. + character(len=8) :: suffix ! A suffix (like "_2") that is added to any ! additional restart files. ! character(len=256) :: mesg ! A message for warnings. integer :: num_restart ! The number of restart files that have already From 6f43605f919532191969013a96ac88bcad39146f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 9 Jul 2018 22:53:52 -0600 Subject: [PATCH 0542/1072] removed use for shr_flds_dom_coord and shr_flds_dom_other by hardwiring names --- config_src/mct_driver/ocn_comp_mct.F90 | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 7a347851c2..b3a48f5757 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -8,8 +8,6 @@ module ocn_comp_mct use ESMF, only: ESMF_ClockGet, ESMF_TimeGet, ESMF_TimeIntervalGet use seq_cdata_mod, only: seq_cdata, seq_cdata_setptrs use seq_flds_mod, only: seq_flds_x2o_fields, seq_flds_o2x_fields -!use seq_flds_mod, only: shr_flds_dom_coord=>seq_flds_dom_coord, shr_flds_dom_other=>seq_flds_dom_other -use seq_flds_mod, only: shr_flds_dom_coord, shr_flds_dom_other use mct_mod, only: mct_gsMap, mct_gsmap_init, mct_gsMap_lsize, & mct_gsmap_orderedpoints use mct_mod, only: mct_aVect, mct_aVect_init, mct_aVect_zero, & @@ -638,8 +636,7 @@ subroutine ocn_domain_mct( lsize, gsMap_ocn, dom_ocn) grid => glb%grid ! for convenience ! set coords to lat and lon, and areas to rad^2 - call mct_gGrid_init(GGrid=dom_ocn, CoordChars=trim(shr_flds_dom_coord), & - OtherChars=trim(shr_flds_dom_other), lsize=lsize ) + call mct_gGrid_init(GGrid=dom_ocn, CoordChars='lat:lon:hgt', OtherChars='area:aream:mask:frac', lsize=lsize ) call mct_avect_zero(dom_ocn%data) allocate(data(lsize)) From 61b5fef7dea7e2e6aebf11d47e08efce8bb636a8 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 10 Jul 2018 10:44:08 -0400 Subject: [PATCH 0543/1072] Removed trailing space in MOM_EOS.F90 - Minor correction --- src/equation_of_state/MOM_EOS.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 87fc7032af..30ac795c56 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -116,7 +116,7 @@ module MOM_EOS integer, parameter :: TFREEZE_MILLERO = 2 !< A named integer specifying a freezing point expression integer, parameter :: TFREEZE_TEOS10 = 3 !< A named integer specifying a freezing point expression character*(10), parameter :: TFREEZE_LINEAR_STRING = "LINEAR" !< A string for specifying the freezing point expression -character*(10), parameter :: TFREEZE_MILLERO_STRING = "MILLERO_78" !< A string for specifying +character*(10), parameter :: TFREEZE_MILLERO_STRING = "MILLERO_78" !< A string for specifying !! freezing point expression character*(10), parameter :: TFREEZE_TEOS10_STRING = "TEOS10" !< A string for specifying the freezing point expression character*(10), parameter :: TFREEZE_DEFAULT = TFREEZE_LINEAR_STRING !< The default freezing point expression From 8abd0e1fe489246c45188f32d5b79e6718627590 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 11:04:24 -0400 Subject: [PATCH 0544/1072] dOyxgenization of types in MOM_bulk_mixed_layer.F90 dOxyGenized comments describing types, the elements of types, and routines in MOM_bulk_mixed_layer.F90. All answers are bitwise identical. --- .../vertical/MOM_bulk_mixed_layer.F90 | 204 +++++++++--------- 1 file changed, 100 insertions(+), 104 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 45fe816eea..0fcb8551ab 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -55,123 +55,119 @@ module MOM_bulk_mixed_layer public bulkmixedlayer, bulkmixedlayer_init +!> The control structure with parameters for the MOM_bulk_mixed_layer module type, public :: bulkmixedlayer_CS ; private - integer :: nkml ! The number of layers in the mixed layer. - integer :: nkbl ! The number of buffer layers. - integer :: nsw ! The number of bands of penetrating shortwave radiation. - real :: mstar ! The ratio of the friction velocity cubed to the - ! TKE input to the mixed layer, nondimensional. - real :: nstar ! The fraction of the TKE input to the mixed layer - ! available to drive entrainment, nondim. - real :: nstar2 ! The fraction of potential energy released by - ! convective adjustment that drives entrainment, ND. - logical :: absorb_all_SW ! If true, all shortwave radiation is absorbed by the - ! ocean, instead of passing through to the bottom mud. - real :: TKE_decay ! The ratio of the natural Ekman depth to the TKE - ! decay scale, nondimensional. - real :: bulk_Ri_ML ! The efficiency with which mean kinetic energy - ! released by mechanically forced entrainment of - ! the mixed layer is converted to TKE, nondim. - real :: bulk_Ri_convective ! The efficiency with which convectively - ! released mean kinetic energy becomes TKE, nondim. - real :: Hmix_min ! The minimum mixed layer thickness in m. - real :: H_limit_fluxes ! When the total ocean depth is less than this - ! value, in m, scale away all surface forcing to - ! avoid boiling the ocean. - real :: ustar_min ! A minimum value of ustar to avoid numerical - ! problems, in m s-1. If the value is small enough, - ! this should not affect the solution. - real :: omega ! The Earth's rotation rate, in s-1. - real :: dT_dS_wt ! When forced to extrapolate T & S to match the - ! layer densities, this factor (in deg C / PSU) is - ! combined with the derivatives of density with T & S - ! to determines what direction is orthogonal to - ! density contours. It should be a typical value of - ! (dR/dS) / (dR/dT) in oceanic profiles. - ! 6 K psu-1 might be reasonable. - real :: BL_extrap_lim ! A limit on the density range over which - ! extrapolation can occur when detraining from the - ! buffer layers, relative to the density range - ! within the mixed and buffer layers, when the - ! detrainment is going into the lightest interior - ! layer, nondimensional. - logical :: ML_resort ! If true, resort the layers by density, rather than - ! doing convective adjustment. - integer :: ML_presort_nz_conv_adj ! If ML_resort is true, do convective - ! adjustment on this many layers (starting from the - ! top) before sorting the remaining layers. - real :: omega_frac ! When setting the decay scale for turbulence, use - ! this fraction of the absolute rotation rate blended - ! with the local value of f, as sqrt((1-of)*f^2 + of*4*omega^2). - logical :: correct_absorption ! If true, the depth at which penetrating - ! shortwave radiation is absorbed is corrected by - ! moving some of the heating upward in the water - ! column. The default is false. - logical :: Resolve_Ekman ! If true, the nkml layers in the mixed layer are - ! chosen to optimally represent the impact of the - ! Ekman transport on the mixed layer TKE budget. - type(time_type), pointer :: Time => NULL() ! A pointer to the ocean model's clock. - logical :: TKE_diagnostics = .false. - logical :: do_rivermix = .false. ! Provide additional TKE to mix river runoff - ! at the river mouths to "rivermix_depth" meters - real :: rivermix_depth = 0.0 ! Used if "do_rivermix" = T - logical :: limit_det ! If true, limit the extent of buffer layer - ! detrainment to be consistent with neighbors. - real :: lim_det_dH_sfc ! The fractional limit in the change between grid - ! points of the surface region (mixed & buffer - ! layer) thickness, nondim. 0.5 by default. - real :: lim_det_dH_bathy ! The fraction of the total depth by which the - ! thickness of the surface region (mixed & buffer - ! layer) is allowed to change between grid points. - ! Nondimensional, 0.2 by default. - logical :: use_river_heat_content ! If true, use the fluxes%runoff_Hflx field - ! to set the heat carried by runoff, instead of - ! using SST for temperature of liq_runoff - logical :: use_calving_heat_content ! Use SST for temperature of froz_runoff - logical :: salt_reject_below_ML ! It true, add salt below mixed layer (layer mode only) - - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to regulate the - ! timing of diagnostic output. - real :: Allowed_T_chg ! The amount by which temperature is allowed - ! to exceed previous values during detrainment, K. - real :: Allowed_S_chg ! The amount by which salinity is allowed - ! to exceed previous values during detrainment, PSU. + integer :: nkml !< The number of layers in the mixed layer. + integer :: nkbl !< The number of buffer layers. + integer :: nsw !< The number of bands of penetrating shortwave radiation. + real :: mstar !< The ratio of the friction velocity cubed to the + !! TKE input to the mixed layer, nondimensional. + real :: nstar !< The fraction of the TKE input to the mixed layer + !! available to drive entrainment, nondim. + real :: nstar2 !< The fraction of potential energy released by + !! convective adjustment that drives entrainment, ND. + logical :: absorb_all_SW !< If true, all shortwave radiation is absorbed by the + !! ocean, instead of passing through to the bottom mud. + real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE + !! decay scale, nondimensional. + real :: bulk_Ri_ML !< The efficiency with which mean kinetic energy + !! released by mechanically forced entrainment of + !! the mixed layer is converted to TKE, nondim. + real :: bulk_Ri_convective !< The efficiency with which convectively + !! released mean kinetic energy becomes TKE, nondim. + real :: Hmix_min !< The minimum mixed layer thickness in m. + real :: H_limit_fluxes !< When the total ocean depth is less than this + !! value, in m, scale away all surface forcing to + !! avoid boiling the ocean. + real :: ustar_min !< A minimum value of ustar to avoid numerical + !! problems, in m s-1. If the value is small enough, + !! this should not affect the solution. + real :: omega !< The Earth's rotation rate, in s-1. + real :: dT_dS_wt !< When forced to extrapolate T & S to match the + !! layer densities, this factor (in deg C / PSU) is + !! combined with the derivatives of density with T & S + !! to determines what direction is orthogonal to + !! density contours. It should be a typical value of + !! (dR/dS) / (dR/dT) in oceanic profiles. + !! 6 K psu-1 might be reasonable. + real :: BL_extrap_lim !< A limit on the density range over which + !! extrapolation can occur when detraining from the + !! buffer layers, relative to the density range + !! within the mixed and buffer layers, when the + !! detrainment is going into the lightest interior + !! layer, nondimensional. + logical :: ML_resort !< If true, resort the layers by density, rather than + !! doing convective adjustment. + integer :: ML_presort_nz_conv_adj !< If ML_resort is true, do convective + !! adjustment on this many layers (starting from the + !! top) before sorting the remaining layers. + real :: omega_frac !< When setting the decay scale for turbulence, use + !! this fraction of the absolute rotation rate blended + !! with the local value of f, as sqrt((1-of)*f^2 + of*4*omega^2). + logical :: correct_absorption !< If true, the depth at which penetrating + !! shortwave radiation is absorbed is corrected by + !! moving some of the heating upward in the water + !! column. The default is false. + logical :: Resolve_Ekman !< If true, the nkml layers in the mixed layer are + !! chosen to optimally represent the impact of the + !! Ekman transport on the mixed layer TKE budget. + type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. + logical :: TKE_diagnostics = .false. !< If true, calculate extensive diagnostics of the TKE budget + logical :: do_rivermix = .false. !< Provide additional TKE to mix river runoff + !! at the river mouths to "rivermix_depth" meters + real :: rivermix_depth = 0.0 !< Used if "do_rivermix" = T + logical :: limit_det !< If true, limit the extent of buffer layer + !! detrainment to be consistent with neighbors. + real :: lim_det_dH_sfc !< The fractional limit in the change between grid + !! points of the surface region (mixed & buffer + !! layer) thickness, nondim. 0.5 by default. + real :: lim_det_dH_bathy !< The fraction of the total depth by which the + !! thickness of the surface region (mixed & buffer + !! layer) is allowed to change between grid points. + !! Nondimensional, 0.2 by default. + logical :: use_river_heat_content !< If true, use the fluxes%runoff_Hflx field + !! to set the heat carried by runoff, instead of + !! using SST for temperature of liq_runoff + logical :: use_calving_heat_content !< Use SST for temperature of froz_runoff + logical :: salt_reject_below_ML !< It true, add salt below mixed layer (layer mode only) + + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the + !! timing of diagnostic output. + real :: Allowed_T_chg !< The amount by which temperature is allowed + !! to exceed previous values during detrainment, K. + real :: Allowed_S_chg !< The amount by which salinity is allowed + !! to exceed previous values during detrainment, PSU. ! These are terms in the mixed layer TKE budget, all in m3 s-2. real, allocatable, dimension(:,:) :: & - ML_depth, & ! The mixed layer depth in m. - diag_TKE_wind, & ! The wind source of TKE. - diag_TKE_RiBulk, & ! The resolved KE source of TKE. - diag_TKE_conv, & ! The convective source of TKE. - diag_TKE_pen_SW, & ! The TKE sink required to mix - ! penetrating shortwave heating. - diag_TKE_mech_decay, & ! The decay of mechanical TKE. - diag_TKE_conv_decay, & ! The decay of convective TKE. - diag_TKE_mixing, & ! The work done by TKE to deepen - ! the mixed layer. - diag_TKE_conv_s2, &! The convective source of TKE due to - ! to mixing in sigma2. - diag_PE_detrain, & ! The spurious source of potential - ! energy due to mixed layer - ! detrainment, W m-2. - diag_PE_detrain2 ! The spurious source of potential - ! energy due to mixed layer only - ! detrainment, W m-2. - logical :: allow_clocks_in_omp_loops ! If true, clocks can be called - ! from inside loops that can be threaded. - ! To run with multiple threads, set to False. - type(group_pass_type) :: pass_h_sum_hmbl_prev ! For group halo pass + ML_depth, & !< The mixed layer depth in m. + diag_TKE_wind, & !< The wind source of TKE. + diag_TKE_RiBulk, & !< The resolved KE source of TKE. + diag_TKE_conv, & !< The convective source of TKE. + diag_TKE_pen_SW, & !< The TKE sink required to mix penetrating shortwave heating. + diag_TKE_mech_decay, & !< The decay of mechanical TKE. + diag_TKE_conv_decay, & !< The decay of convective TKE. + diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer. + diag_TKE_conv_s2, & !< The convective source of TKE due to to mixing in sigma2. + diag_PE_detrain, & !< The spurious source of potential energy due to mixed layer detrainment, W m-2. + diag_PE_detrain2 !< The spurious source of potential energy due to mixed layer only detrainment, W m-2. + logical :: allow_clocks_in_omp_loops !< If true, clocks can be called from inside loops that can + !! be threaded. To run with multiple threads, set to False. + type(group_pass_type) :: pass_h_sum_hmbl_prev !< For group halo pass + + !>@{ Diagnostic IDs integer :: id_ML_depth = -1, id_TKE_wind = -1, id_TKE_mixing = -1 integer :: id_TKE_RiBulk = -1, id_TKE_conv = -1, id_TKE_pen_SW = -1 integer :: id_TKE_mech_decay = -1, id_TKE_conv_decay = -1, id_TKE_conv_s2 = -1 integer :: id_PE_detrain = -1, id_PE_detrain2 = -1, id_h_mismatch = -1 integer :: id_Hsfc_used = -1, id_Hsfc_max = -1, id_Hsfc_min = -1 + !!@} end type bulkmixedlayer_CS +!>@{ CPU clock IDs integer :: id_clock_detrain=0, id_clock_mech=0, id_clock_conv=0, id_clock_adjustment=0 integer :: id_clock_EOS=0, id_clock_resort=0, id_clock_pass=0 - -integer :: num_msg = 0, max_msg = 2 +!!@} contains From d2342522bc572152b4b1e32b62eb5dd8af58d42f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 11:04:55 -0400 Subject: [PATCH 0545/1072] dOyxgenization of types in MOM_ALE_sponge.F90 dOxyGenized comments describing types, the elements of types, and routines in MOM_ALE_sponge.F90. All answers are bitwise identical. --- .../vertical/MOM_ALE_sponge.F90 | 94 +++++++++++-------- 1 file changed, 54 insertions(+), 40 deletions(-) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 7092b827ba..631adfe57b 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -27,25 +27,32 @@ module MOM_ALE_sponge #include +!> Store the reference profile at h points for a variable interface set_up_ALE_sponge_field module procedure set_up_ALE_sponge_field_fixed module procedure set_up_ALE_sponge_field_varying end interface +!> This subroutine stores the reference profile at u and v points for a vector interface set_up_ALE_sponge_vel_field module procedure set_up_ALE_sponge_vel_field_fixed module procedure set_up_ALE_sponge_vel_field_varying end interface +!> Ddetermine the number of points which are within sponges in this computational domain. +!! Only points that have positive values of Iresttime and which mask2dT indicates are ocean +!! points are included in the sponges. It also stores the target interface heights. interface initialize_ALE_sponge module procedure initialize_ALE_sponge_fixed module procedure initialize_ALE_sponge_varying end interface -!< Publicly available functions + +! Publicly available functions public set_up_ALE_sponge_field, set_up_ALE_sponge_vel_field public get_ALE_sponge_thicknesses, get_ALE_sponge_nz_data public initialize_ALE_sponge, apply_ALE_sponge, ALE_sponge_end, init_ALE_sponge_diags +!> A structure for creating arrays of pointers to 3D arrays with extra gridding information type :: p3d integer :: id !< id for FMS external time interpolator integer :: nz_data !< The number of vertical levels in the input field. @@ -54,6 +61,8 @@ module MOM_ALE_sponge real, dimension(:,:,:), pointer :: p => NULL() !< pointer to the data. real, dimension(:,:,:), pointer :: h => NULL() !< pointer to the data grid. end type p3d + +!> A structure for creating arrays of pointers to 2D arrays with extra gridding information type :: p2d integer :: id !< id for FMS external time interpolator integer :: nz_data !< The number of vertical levels in the input field @@ -63,39 +72,48 @@ module MOM_ALE_sponge real, dimension(:,:), pointer :: h => NULL() !< pointer the data grid. end type p2d -!> SPONGE control structure +!> ALE sponge control structure type, public :: ALE_sponge_CS ; private - integer :: nz !< The total number of layers. - integer :: nz_data !< The total number of arbritary layers (used by older code). - integer :: isc, iec, jsc, jec !< The index ranges of the computational domain at h. - integer :: iscB, iecB, jscB, jecB !< The index ranges of the computational domain at u/v. - integer :: isd, ied, jsd, jed !< The index ranges of the data domain. - integer :: num_col, num_col_u, num_col_v !< The number of sponge points within the - !! computational domain. - integer :: fldno = 0 !< The number of fields which have already been - !! registered by calls to set_up_sponge_field - logical :: sponge_uv !< Control whether u and v are included in sponge - integer, pointer :: col_i(:) => NULL() !< Arrays containing the i- and j- indicies - integer, pointer :: col_j(:) => NULL() !! of each of the columns being damped. - integer, pointer :: col_i_u(:) => NULL() !< Same as above for u points - integer, pointer :: col_j_u(:) => NULL() - integer, pointer :: col_i_v(:) => NULL() !< Same as above for v points - integer, pointer :: col_j_v(:) => NULL() - - real, pointer :: Iresttime_col(:) => NULL() !< The inverse restoring time of - !! each column. - real, pointer :: Iresttime_col_u(:) => NULL() !< Same as above for u points - real, pointer :: Iresttime_col_v(:) => NULL() !< Same as above for v points + integer :: nz !< The total number of layers. + integer :: nz_data !< The total number of arbritary layers (used by older code). + integer :: isc !< The starting i-index of the computational domain at h. + integer :: iec !< The ending i-index of the computational domain at h. + integer :: jsc !< The starting j-index of the computational domain at h. + integer :: jec !< The ending j-index of the computational domain at h. + integer :: IscB !< The starting I-index of the computational domain at u/v. + integer :: IecB !< The ending I-index of the computational domain at u/v. + integer :: JscB !< The starting J-index of the computational domain at u/v. + integer :: JecB !< The ending J-index of the computational domain at h. + integer :: isd !< The starting i-index of the data domain at h. + integer :: ied !< The ending i-index of the data domain at h. + integer :: jsd !< The starting j-index of the data domain at h. + integer :: jed !< The ending j-index of the data domain at h. + integer :: num_col !< The number of sponge tracer points within the computational domain. + integer :: num_col_u !< The number of sponge u-points within the computational domain. + integer :: num_col_v !< The number of sponge v-points within the computational domain. + integer :: fldno = 0 !< The number of fields which have already been + !! registered by calls to set_up_sponge_field + logical :: sponge_uv !< Control whether u and v are included in sponge + integer, pointer :: col_i(:) => NULL() !< Array of the i-indicies of each tracer columns being damped. + integer, pointer :: col_j(:) => NULL() !< Array of the j-indicies of each tracer columns being damped. + integer, pointer :: col_i_u(:) => NULL() !< Array of the i-indicies of each u-columns being damped. + integer, pointer :: col_j_u(:) => NULL() !< Array of the j-indicies of each u-columns being damped. + integer, pointer :: col_i_v(:) => NULL() !< Array of the i-indicies of each v-columns being damped. + integer, pointer :: col_j_v(:) => NULL() !< Array of the j-indicies of each v-columns being damped. + + real, pointer :: Iresttime_col(:) => NULL() !< The inverse restoring time of each tracer column. + real, pointer :: Iresttime_col_u(:) => NULL() !< The inverse restoring time of each u-column. + real, pointer :: Iresttime_col_v(:) => NULL() !< The inverse restoring time of each v-column. type(p3d) :: var(MAX_FIELDS_) !< Pointers to the fields that are being damped. - type(p2d) :: Ref_val(MAX_FIELDS_) !< The values to which the fields are damped. - type(p2d) :: Ref_val_u !< Same as above for u points. - type(p2d) :: Ref_val_v !< Same as above for v points. - type(p3d) :: var_u !< Pointers to the u vel. that are being damped. - type(p3d) :: var_v !< Pointers to the v vel. that are being damped. + type(p2d) :: Ref_val(MAX_FIELDS_) !< The values to which the fields are damped. + type(p2d) :: Ref_val_u !< The values to which the u-velocities are damped. + type(p2d) :: Ref_val_v !< The values to which the v-velocities are damped. + type(p3d) :: var_u !< Pointer to the u velocities. that are being damped. + type(p3d) :: var_v !< Pointer to the v velocities. that are being damped. type(p2d) :: Ref_h !< Grid on which reference data is provided (older code). - type(p2d) :: Ref_hu !< Same as above for u points. - type(p2d) :: Ref_hv !< Same as above for v points. + type(p2d) :: Ref_hu !< u-point grid on which reference data is provided (older code). + type(p2d) :: Ref_hv !< v-point grid on which reference data is provided (older code). type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the !! timing of diagnostic output. @@ -107,11 +125,9 @@ module MOM_ALE_sponge contains -!> This subroutine determines the number of points which are within -! sponges in this computational domain. Only points that have -! positive values of Iresttime and which mask2dT indicates are ocean -! points are included in the sponges. It also stores the target interface -! heights. +!> This subroutine determines the number of points which are within sponges in this computational +!! domain. Only points that have positive values of Iresttime and which mask2dT indicates are ocean +!! points are included in the sponges. It also stores the target interface heights. subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_data) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). @@ -343,11 +359,9 @@ subroutine get_ALE_sponge_thicknesses(G, data_h, sponge_mask, CS) end subroutine get_ALE_sponge_thicknesses -!> This subroutine determines the number of points which are within -! sponges in this computational domain. Only points that have -! positive values of Iresttime and which mask2dT indicates are ocean -! points are included in the sponges. It also stores the target interface -! heights. +!> This subroutine determines the number of points which are within sponges in this computational +!! domain. Only points that have positive values of Iresttime and which mask2dT indicates are ocean +!! points are included in the sponges. subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). From f99946451d08ce5172dc752704909bb8cc4fb791 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 11:05:21 -0400 Subject: [PATCH 0546/1072] dOyxgenization of types in MOM_sponge.F90 dOxyGenized comments describing types and the elements of types in MOM_sponge.F90. All answers are bitwise identical. --- src/parameterizations/vertical/MOM_sponge.F90 | 87 ++++++++++--------- 1 file changed, 46 insertions(+), 41 deletions(-) diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index 99b27e5016..4706db9a3c 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -73,49 +73,54 @@ module MOM_sponge public set_up_sponge_field, set_up_sponge_ML_density public initialize_sponge, apply_sponge, sponge_end, init_sponge_diags -type :: p3d - real, dimension(:,:,:), pointer :: p => NULL() +!> A structure for creating arrays of pointers to 3D arrays +type, public :: p3d + real, dimension(:,:,:), pointer :: p => NULL() !< A pointer to a 3D array end type p3d -type :: p2d - real, dimension(:,:), pointer :: p => NULL() +!> A structure for creating arrays of pointers to 2D arrays +type, public :: p2d + real, dimension(:,:), pointer :: p => NULL() !< A pointer to a 2D array end type p2d +!> This control structure holds memory and parameters for the MOM_sponge module type, public :: sponge_CS ; private - logical :: bulkmixedlayer ! If true, a refined bulk mixed layer is used with - ! nkml sublayers and nkbl buffer layer. - integer :: nz ! The total number of layers. - integer :: isc, iec, jsc, jec ! The index ranges of the computational domain. - integer :: isd, ied, jsd, jed ! The index ranges of the data domain. - integer :: num_col ! The number of sponge points within the - ! computational domain. - integer :: fldno = 0 ! The number of fields which have already been - ! registered by calls to set_up_sponge_field - integer, pointer :: col_i(:) => NULL() ! Arrays containing the i- and j- indicies - integer, pointer :: col_j(:) => NULL() ! of each of the columns being damped. - real, pointer :: Iresttime_col(:) => NULL() ! The inverse restoring time of - ! each column. - real, pointer :: Rcv_ml_ref(:) => NULL() ! The value toward which the mixed layer - ! coordinate-density is being damped, in kg m-3. - real, pointer :: Ref_eta(:,:) => NULL() ! The value toward which the interface - ! heights are being damped, in m. - type(p3d) :: var(MAX_FIELDS_) ! Pointers to the fields that are being damped. - type(p2d) :: Ref_val(MAX_FIELDS_) ! The values to which the fields are damped. - - logical :: do_i_mean_sponge ! If true, apply sponges to the i-mean fields. - real, pointer :: Iresttime_im(:) => NULL() ! The inverse restoring time of - ! each row for i-mean sponges. - real, pointer :: Rcv_ml_ref_im(:) => NULL() ! The value toward which the i-mean - ! mixed layer coordinate-density is being damped, - ! in kg m-3. - real, pointer :: Ref_eta_im(:,:) => NULL() ! The value toward which the i-mean - ! interface heights are being damped, in m. - type(p2d) :: Ref_val_im(MAX_FIELDS_) ! The values toward which the i-means of - ! fields are damped. - - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. - integer :: id_w_sponge = -1 - + logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with + !! nkml sublayers and nkbl buffer layer. + integer :: nz !< The total number of layers. + integer :: isc !< The starting i-index of the computational domain at h. + integer :: iec !< The ending i-index of the computational domain at h. + integer :: jsc !< The starting j-index of the computational domain at h. + integer :: jec !< The ending j-index of the computational domain at h. + integer :: isd !< The starting i-index of the data domain at h. + integer :: ied !< The ending i-index of the data domain at h. + integer :: jsd !< The starting j-index of the data domain at h. + integer :: jed !< The ending j-index of the data domain at h. + integer :: num_col !< The number of sponge points within the computational domain. + integer :: fldno = 0 !< The number of fields which have already been + !! registered by calls to set_up_sponge_field + integer, pointer :: col_i(:) => NULL() !< Array of the i-indicies of each of the columns being damped. + integer, pointer :: col_j(:) => NULL() !< Array of the j-indicies of each of the columns being damped. + real, pointer :: Iresttime_col(:) => NULL() !< The inverse restoring time of each column. + real, pointer :: Rcv_ml_ref(:) => NULL() !< The value toward which the mixed layer + !! coordinate-density is being damped, in kg m-3. + real, pointer :: Ref_eta(:,:) => NULL() !< The value toward which the interface + !! heights are being damped, in m. + type(p3d) :: var(MAX_FIELDS_) !< Pointers to the fields that are being damped. + type(p2d) :: Ref_val(MAX_FIELDS_) !< The values to which the fields are damped. + + logical :: do_i_mean_sponge !< If true, apply sponges to the i-mean fields. + real, pointer :: Iresttime_im(:) => NULL() !< The inverse restoring time of + !! each row for i-mean sponges. + real, pointer :: Rcv_ml_ref_im(:) => NULL() !! The value toward which the i-mean + !< mixed layer coordinate-density is being damped, in kg m-3. + real, pointer :: Ref_eta_im(:,:) => NULL() !< The value toward which the i-mean + !! interface heights are being damped, in m. + type(p2d) :: Ref_val_im(MAX_FIELDS_) !< The values toward which the i-means of + !! fields are damped. + + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. + integer :: id_w_sponge = -1 !< A diagnostic ID end type sponge_CS contains @@ -173,8 +178,8 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, & CS%do_i_mean_sponge = present(Iresttime_i_mean) CS%nz = G%ke - CS%isc = G%isc ; CS%iec = G%iec ; CS%jsc = G%jsc ; CS%jec = G%jec - CS%isd = G%isd ; CS%ied = G%ied ; CS%jsd = G%jsd ; CS%jed = G%jed +! CS%isc = G%isc ; CS%iec = G%iec ; CS%jsc = G%jsc ; CS%jec = G%jec +! CS%isd = G%isd ; CS%ied = G%ied ; CS%jsd = G%jsd ; CS%jed = G%jed ! CS%bulkmixedlayer may be set later via a call to set_up_sponge_ML_density. CS%bulkmixedlayer = .false. From 795a57ee129cdac67fe67f28313f863876fa12f2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 11:06:05 -0400 Subject: [PATCH 0547/1072] dOyxgenization of type elements in MOM_bkgnd_mixing.F90 dOxyGenized comments describing the elements of types in MOM_bkgnd_mixing.F90. All answers are bitwise identical. --- src/parameterizations/vertical/MOM_bkgnd_mixing.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 65a29045e3..d25cb8592d 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -82,8 +82,9 @@ module MOM_bkgnd_mixing logical :: bulkmixedlayer !< If true, a refined bulk mixed layer scheme is used logical :: debug !< If true, turn on debugging in this module ! Daignostic handles and pointers - type(diag_ctrl), pointer :: diag => NULL() - integer :: id_kd_bkgnd = -1, id_kv_bkgnd = -1 + type(diag_ctrl), pointer :: diag => NULL() !< A structure that regulates diagnostic output + integer :: id_kd_bkgnd = -1 !< Diagnotic IDs + integer :: id_kv_bkgnd = -1 !< Diagnostic IDs real, allocatable, dimension(:,:) :: Kd_sfc !< surface value of the diffusivity (m2/s) ! Diagnostics arrays From f4e5f09f313c77f74d6b6d3e10c6e142a054f371 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 11:06:23 -0400 Subject: [PATCH 0548/1072] dOyxgenization of type elements in MOM_diabatic_aux.F90 dOxyGenized comments describing the elements of types in MOM_diabatic_aux.F90. All answers are bitwise identical. --- .../vertical/MOM_diabatic_aux.F90 | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index dcd518857c..c848a1de60 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -24,12 +24,12 @@ module MOM_diabatic_aux public diabatic_aux_init, diabatic_aux_end public make_frazil, adjust_salt, insert_brine, differential_diffuse_T_S, triDiagTS public find_uv_at_h, diagnoseMLDbyDensityDifference, applyBoundaryFluxesInOut + !> Control structure for diabatic_aux type, public :: diabatic_aux_CS ; private logical :: do_rivermix = .false. !< Provide additional TKE to mix river runoff !! at the river mouths to "rivermix_depth" meters - real :: rivermix_depth = 0.0 !< The depth to which rivers are mixed if - !! do_rivermix = T, in m. + real :: rivermix_depth = 0.0 !< The depth to which rivers are mixed if do_rivermix = T, in m. logical :: reclaim_frazil !< If true, try to use any frazil heat deficit to !! to cool the topmost layer down to the freezing !! point. The default is false. @@ -51,11 +51,11 @@ module MOM_diabatic_aux type(diag_ctrl), pointer :: diag !< Structure used to regulate timing of diagnostic output ! Diagnostic handles - integer :: id_createdH = -1 - integer :: id_brine_lay = -1 - integer :: id_penSW_diag = -1 !< Penetrative shortwave heating (flux convergence) diagnostic - integer :: id_penSWflux_diag = -1 !< Penetrative shortwave flux diagnostic - integer :: id_nonpenSW_diag = -1 !< Non-penetrative shortwave heating diagnostic + integer :: id_createdH = -1 !< Diagnostic ID of mass added to avoid grounding + integer :: id_brine_lay = -1 !< Diagnostic ID of which layer receives the brine + integer :: id_penSW_diag = -1 !< Diagnostic ID of Penetrative shortwave heating (flux convergence) + integer :: id_penSWflux_diag = -1 !< Diagnostic ID of Penetrative shortwave flux + integer :: id_nonpenSW_diag = -1 !< Diagnostic ID of Non-penetrative shortwave heating ! Optional diagnostic arrays real, allocatable, dimension(:,:) :: createdH !< The amount of volume added in order to avoid grounding (m/s) @@ -65,7 +65,9 @@ module MOM_diabatic_aux end type diabatic_aux_CS +!>@{ CPU time clock IDs integer :: id_clock_uv_at_h, id_clock_frazil +!!@} contains From 9eaf8a350856174231192a036b3e6f90ed66236d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 11:06:46 -0400 Subject: [PATCH 0549/1072] Oyxgenization of type elements in MOM_diabatic_driver.F90 dOxyGenized comments describing the elements of types in MOM_diabatic_driver.F90. All answers are bitwise identical. --- .../vertical/MOM_diabatic_driver.F90 | 65 ++++++++++--------- 1 file changed, 35 insertions(+), 30 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 4d62fd898a..8a16e79ecd 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -163,11 +163,12 @@ module MOM_diabatic_driver logical :: debugConservation !< If true, monitor conservation and extrema. logical :: tracer_tridiag !< If true, use tracer_vertdiff instead of tridiagTS for !< vertical diffusion of T and S - logical :: debug_energy_req ! If true, test the mixing energy requirement code. + logical :: debug_energy_req !< If true, test the mixing energy requirement code. type(diag_ctrl), pointer :: diag !< structure used to regulate timing of diagnostic output real :: MLDdensityDifference !< Density difference used to determine MLD_user integer :: nsw !< SW_NBANDS + !>@{ Diagnostic IDs integer :: id_cg1 = -1 ! diag handle for mode-1 speed (BDM) integer, allocatable, dimension(:) :: id_cn ! diag handle for all mode speeds (BDM) integer :: id_wd = -1, id_ea = -1, id_eb = -1 ! used by layer diabatic @@ -190,7 +191,6 @@ module MOM_diabatic_driver integer :: id_diabatic_diff_heat_tend_2d = -1 integer :: id_diabatic_diff_salt_tend_2d = -1 integer :: id_diabatic_diff_h= -1 - logical :: diabatic_diff_tendency_diag = .false. integer :: id_boundary_forcing_h = -1 integer :: id_boundary_forcing_h_tendency = -1 @@ -200,38 +200,39 @@ module MOM_diabatic_driver integer :: id_boundary_forcing_salt_tend = -1 integer :: id_boundary_forcing_heat_tend_2d = -1 integer :: id_boundary_forcing_salt_tend_2d = -1 - logical :: boundary_forcing_tendency_diag = .false. integer :: id_frazil_h = -1 integer :: id_frazil_temp_tend = -1 integer :: id_frazil_heat_tend = -1 integer :: id_frazil_heat_tend_2d = -1 - logical :: frazil_tendency_diag = .false. + !!@} + + logical :: diabatic_diff_tendency_diag = .false. !< If true calculate diffusive tendency diagnostics + logical :: boundary_forcing_tendency_diag = .false. !< If true calculate frazil diagnostics + logical :: frazil_tendency_diag = .false. !< If true calculate frazil tendency diagnostics real, allocatable, dimension(:,:,:) :: frazil_heat_diag !< diagnose 3d heat tendency from frazil real, allocatable, dimension(:,:,:) :: frazil_temp_diag !< diagnose 3d temp tendency from frazil - real :: ppt2mks = 0.001 - - type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() - type(entrain_diffusive_CS), pointer :: entrain_diffusive_CSp => NULL() - type(bulkmixedlayer_CS), pointer :: bulkmixedlayer_CSp => NULL() - type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL() - type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL() - type(geothermal_CS), pointer :: geothermal_CSp => NULL() - type(int_tide_CS), pointer :: int_tide_CSp => NULL() - type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() - type(int_tide_input_type), pointer :: int_tide_input => NULL() - type(opacity_CS), pointer :: opacity_CSp => NULL() - type(set_diffusivity_CS), pointer :: set_diff_CSp => NULL() - type(sponge_CS), pointer :: sponge_CSp => NULL() - type(ALE_sponge_CS), pointer :: ALE_sponge_CSp => NULL() - type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() - type(optics_type), pointer :: optics => NULL() - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() - type(KPP_CS), pointer :: KPP_CSp => NULL() - type(tidal_mixing_cs), pointer :: tidal_mixing_csp => NULL() - type(CVMix_conv_cs), pointer :: CVMix_conv_csp => NULL() - type(diapyc_energy_req_CS), pointer :: diapyc_en_rec_CSp => NULL() + type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() !< Control structure for a child module + type(entrain_diffusive_CS), pointer :: entrain_diffusive_CSp => NULL() !< Control structure for a child module + type(bulkmixedlayer_CS), pointer :: bulkmixedlayer_CSp => NULL() !< Control structure for a child module + type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL() !< Control structure for a child module + type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL() !< Control structure for a child module + type(geothermal_CS), pointer :: geothermal_CSp => NULL() !< Control structure for a child module + type(int_tide_CS), pointer :: int_tide_CSp => NULL() !< Control structure for a child module + type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module + type(int_tide_input_type), pointer :: int_tide_input => NULL() !< Control structure for a child module + type(opacity_CS), pointer :: opacity_CSp => NULL() !< Control structure for a child module + type(set_diffusivity_CS), pointer :: set_diff_CSp => NULL() !< Control structure for a child module + type(sponge_CS), pointer :: sponge_CSp => NULL() !< Control structure for a child module + type(ALE_sponge_CS), pointer :: ALE_sponge_CSp => NULL() !< Control structure for a child module + type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() !< Control structure for a child module + type(optics_type), pointer :: optics => NULL() !< Control structure for a child module + type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() !< Control structure for a child module + type(KPP_CS), pointer :: KPP_CSp => NULL() !< Control structure for a child module + type(tidal_mixing_cs), pointer :: tidal_mixing_csp => NULL() !< Control structure for a child module + type(CVMix_conv_cs), pointer :: CVMix_conv_csp => NULL() !< Control structure for a child module + type(diapyc_energy_req_CS), pointer :: diapyc_en_rec_CSp => NULL() !< Control structure for a child module type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass type(group_pass_type) :: pass_Kv !< For group halo pass @@ -2481,9 +2482,11 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, real, intent(in) :: dt !< time step (sec) type(diabatic_CS), pointer :: CS !< module control structure + ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d real, dimension(SZI_(G),SZJ_(G)) :: work_2d - real :: Idt + real :: Idt ! The inverse of the timestep, in s-1 + real :: ppt2mks = 0.001 ! Conversion factor from g/kg to kg/kg. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -2530,7 +2533,7 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, ! salt tendency if (CS%id_diabatic_diff_salt_tend > 0 .or. CS%id_diabatic_diff_salt_tend_2d > 0) then do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = h(i,j,k) * GV%H_to_kg_m2 * CS%ppt2mks * work_3d(i,j,k) + work_3d(i,j,k) = h(i,j,k) * GV%H_to_kg_m2 * ppt2mks * work_3d(i,j,k) enddo ; enddo ; enddo if (CS%id_diabatic_diff_salt_tend > 0) then call post_data(CS%id_diabatic_diff_salt_tend, work_3d, CS%diag, alt_h = h) @@ -2569,9 +2572,11 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, real, intent(in) :: dt !< time step (sec) type(diabatic_CS), pointer :: CS !< module control structure + ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d real, dimension(SZI_(G),SZJ_(G)) :: work_2d - real :: Idt + real :: Idt ! The inverse of the timestep, in s-1 + real :: ppt2mks = 0.001 ! Conversion factor from g/kg to kg/kg. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -2625,7 +2630,7 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, ! salt tendency if (CS%id_boundary_forcing_salt_tend > 0 .or. CS%id_boundary_forcing_salt_tend_2d > 0) then do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = GV%H_to_kg_m2 * CS%ppt2mks * Idt * (h(i,j,k) * tv%S(i,j,k) - h_old(i,j,k) * saln_old(i,j,k)) + work_3d(i,j,k) = GV%H_to_kg_m2 * ppt2mks * Idt * (h(i,j,k) * tv%S(i,j,k) - h_old(i,j,k) * saln_old(i,j,k)) enddo ; enddo ; enddo if (CS%id_boundary_forcing_salt_tend > 0) then call post_data(CS%id_boundary_forcing_salt_tend, work_3d, CS%diag, alt_h = h_old) From 9fc8bb5ef7d770aae9a4b7b707580fb0e7ab9cb2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 11:07:09 -0400 Subject: [PATCH 0550/1072] dOyxgenization of types in MOM_diapyc_energy_req.F90 dOxyGenized comments describing types and the elements of types in MOM_diapyc_energy_req.F90. All answers are bitwise identical. --- .../vertical/MOM_diapyc_energy_req.F90 | 22 ++++++++++--------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 7ebf62efab..ef0ecdc2ea 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -22,21 +22,23 @@ module MOM_diapyc_energy_req public diapyc_energy_req_init, diapyc_energy_req_calc, diapyc_energy_req_test, diapyc_energy_req_end +!> This control structure holds parameters for the MOM_diapyc_energy_req module type, public :: diapyc_energy_req_CS ; private - logical :: initialized = .false. ! A variable that is here because empty - ! structures are not permitted by some compilers. - real :: test_Kh_scaling ! A scaling factor for the diapycnal diffusivity. - real :: ColHt_scaling ! A scaling factor for the column height change - ! correction term. - logical :: use_test_Kh_profile ! If true, use the internal test diffusivity - ! profile in place of any that might be passed - ! in as an argument. - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. + logical :: initialized = .false. !< A variable that is here because empty + !! structures are not permitted by some compilers. + real :: test_Kh_scaling !< A scaling factor for the diapycnal diffusivity. + real :: ColHt_scaling !< A scaling factor for the column height change correction term. + logical :: use_test_Kh_profile !< If true, use the internal test diffusivity profile in place of + !! any that might be passed in as an argument. + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. + + !>@{ Diagnostic IDs integer :: id_ERt=-1, id_ERb=-1, id_ERc=-1, id_ERh=-1, id_Kddt=-1, id_Kd=-1 integer :: id_CHCt=-1, id_CHCb=-1, id_CHCc=-1, id_CHCh=-1 integer :: id_T0=-1, id_Tf=-1, id_S0=-1, id_Sf=-1, id_N2_0=-1, id_N2_f=-1 integer :: id_h=-1, id_zInt=-1 + !!@} end type diapyc_energy_req_CS contains From 55623c64bde79af2b5f6111d9aedecbe9b473c6d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 11:07:38 -0400 Subject: [PATCH 0551/1072] dOyxgenization of types in MOM_energetic_PBL.F90 dOxyGenized comments describing types and the elements of types in MOM_energetic_PBL.F90. All answers are bitwise identical. --- .../vertical/MOM_energetic_PBL.F90 | 261 +++++++++--------- 1 file changed, 132 insertions(+), 129 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index bd9010dbcc..5e46742a6b 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -68,138 +68,142 @@ module MOM_energetic_PBL public energetic_PBL, energetic_PBL_init, energetic_PBL_end public energetic_PBL_get_MLD +!> This control structure holds parameters for the MOM_energetic_PBL module type, public :: energetic_PBL_CS ; private - real :: mstar ! The ratio of the friction velocity cubed to the - ! TKE available to drive entrainment, nondimensional. - ! This quantity is the vertically integrated - ! shear production minus the vertically integrated - ! dissipation of TKE produced by shear. - real :: nstar ! The fraction of the TKE input to the mixed layer - ! available to drive entrainment, nondim. - ! This quantity is the vertically integrated - ! buoyancy production minus the vertically integrated - ! dissipation of TKE produced by buoyancy. - real :: MixLenExponent ! Exponent in the mixing length shape-function. - ! 1 is law-of-the-wall at top and bottom, - ! 2 is more KPP like. - real :: TKE_decay ! The ratio of the natural Ekman depth to the TKE - ! decay scale, nondimensional. - real :: MKE_to_TKE_effic ! The efficiency with which mean kinetic energy - ! released by mechanically forced entrainment of - ! the mixed layer is converted to TKE, nondim. -! real :: Hmix_min ! The minimum mixed layer thickness in m. - real :: ustar_min ! A minimum value of ustar to avoid numerical - ! problems, in m s-1. If the value is small enough, - ! this should not affect the solution. - real :: omega ! The Earth's rotation rate, in s-1. - real :: omega_frac ! When setting the decay scale for turbulence, use - ! this fraction of the absolute rotation rate blended - ! with the local value of f, as sqrt((1-of)*f^2 + of*4*omega^2). - real :: wstar_ustar_coef ! A ratio relating the efficiency with which - ! convectively released energy is converted to a - ! turbulent velocity, relative to mechanically - ! forced turbulent kinetic energy, nondim. Making - ! this larger increases the diffusivity. - real :: vstar_scale_fac ! An overall nondimensional scaling factor - ! for vstar. Making this larger increases the - ! diffusivity. - real :: Ekman_scale_coef ! A nondimensional scaling factor controlling - ! the inhibition of the diffusive length scale by - ! rotation. Making this larger decreases the - ! diffusivity in the planetary boundary layer. - real :: transLay_scale ! A scale for the mixing length in the transition layer - ! at the edge of the boundary layer as a fraction of the - ! boundary layer thickness. The default is 0, but a - ! value of 0.1 might be better justified by observations. - real :: MLD_tol ! A tolerance for determining the boundary layer - ! thickness when Use_MLD_iteration is true, in m. - real :: min_mix_len ! The minimum mixing length scale that will be - ! used by ePBL, in m. The default (0) does not - ! set a minimum. - real :: N2_Dissipation_Scale_Neg - real :: N2_Dissipation_Scale_Pos - ! A nondimensional scaling factor controlling the - ! loss of TKE due to enhanced dissipation in the presence - ! of stratification. This dissipation is applied to the - ! available TKE which includes both that generated at the - ! surface and that generated at depth. It may be important - ! to distinguish which TKE flavor that this dissipation - ! applies to in subsequent revisions of this code. - ! "_Neg" and "_Pos" refer to which scale is applied as a - ! function of negative or positive local buoyancy. - real :: MSTAR_CAP ! Since MSTAR is restoring undissipated energy to mixing, - ! there must be a cap on how large it can be. This - ! is definitely a function of latitude (Ekman limit), - ! but will be taken as constant for now. - real :: MSTAR_SLOPE ! Slope of the function which relates the shear production - ! to the mixing layer depth, Ekman depth, and Monin-Obukhov - ! depth. - real :: MSTAR_XINT ! Value where MSTAR function transitions from linear - ! to decay toward MSTAR->0 at fully developed Ekman depth. - real :: MSTAR_XINT_UP ! Similar but for transition to asymptotic cap. - real :: MSTAR_AT_XINT ! Intercept value of MSTAR at value where function - ! changes to linear transition. - integer :: LT_ENHANCE_FORM ! Integer for Enhancement functional form (various options) - real :: LT_ENHANCE_COEF ! Coefficient in fit for Langmuir Enhancment - real :: LT_ENHANCE_EXP ! Exponent in fit for Langmuir Enhancement - real :: MSTAR_N = -2. ! Exponent in decay at negative and positive limits of MLD_over_STAB - real :: MSTAR_A,MSTAR_A2 ! MSTAR_A and MSTAR_B are coefficients in asymptote toward limits. - real :: MSTAR_B,MSTAR_B2 ! These are computed to match the function value and slope at both - ! ends of the linear fit within the well constrained region. - real :: C_EK = 0.17 ! MSTAR Coefficient in rotation limit for mstar_mode=2 - real :: MSTAR_COEF = 0.3 ! MSTAR coefficient in rotation/stabilizing balance for mstar_mode=2 - real :: LaC_MLDoEK ! Coefficients for Langmuir number modification based on - real :: LaC_MLDoOB_stab ! length scale ratios, MLD is boundary, EK is Ekman, - real :: LaC_EKoOB_stab ! and OB is Obukhov, the "o" in the name is for division. - real :: LaC_MLDoOB_un ! Stab/un are for stable (pos) and unstable (neg) Obukhov depths - real :: LaC_EKoOB_un ! ... - real :: Max_Enhance_M = 5. ! The maximum allowed LT enhancement to the mixing. - real :: CNV_MST_FAC ! Factor to reduce mstar when statically unstable. - type(time_type), pointer :: Time=>NULL() ! A pointer to the ocean model's clock. - - integer :: MSTAR_MODE = 0 ! An integer to determine which formula is used to - ! set mstar - integer :: CONST_MSTAR=0,MLD_o_OBUKHOV=1,EKMAN_o_OBUKHOV=2 - logical :: MSTAR_FLATCAP=.true. !Set false to use asymptotic mstar cap. - logical :: TKE_diagnostics = .false. - logical :: Use_LT = .false. ! Flag for using LT in Energy calculation - logical :: orig_PE_calc = .true. - logical :: Use_MLD_iteration=.false. ! False to use old ePBL method. - logical :: Orig_MLD_iteration=.false. ! False to use old MLD value - logical :: MLD_iteration_guess=.false. ! False to default to guessing half the - ! ocean depth for the iteration. - logical :: Mixing_Diagnostics = .false. ! Will be true when outputing mixing - ! length and velocity scale - logical :: MSTAR_Diagnostics=.false. - type(diag_ctrl), pointer :: diag=>NULL() ! A structure that is used to regulate the - ! timing of diagnostic output. - -! These are terms in the mixed layer TKE budget, all in J m-2 = kg s-2. + real :: mstar !< The ratio of the friction velocity cubed to the TKE available to + !! drive entrainment, nondimensional. This quantity is the vertically + !! integrated shear production minus the vertically integrated + !! dissipation of TKE produced by shear. + real :: nstar !< The fraction of the TKE input to the mixed layer available to drive + !! entrainment, nondim. This quantity is the vertically integrated + !! buoyancy production minus the vertically integrated dissipation of + !! TKE produced by buoyancy. + real :: MixLenExponent !< Exponent in the mixing length shape-function. + !! 1 is law-of-the-wall at top and bottom, + !! 2 is more KPP like. + real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE decay scale, nondim. + real :: MKE_to_TKE_effic !< The efficiency with which mean kinetic energy released by + !! mechanically forced entrainment of the mixed layer is converted to + !! TKE, nondim. +! real :: Hmix_min !< The minimum mixed layer thickness in m. + real :: ustar_min !< A minimum value of ustar to avoid numerical problems, in m s-1. + !! If the value is small enough, this should not affect the solution. + real :: omega !< The Earth's rotation rate, in s-1. + real :: omega_frac !< When setting the decay scale for turbulence, use this fraction of + !! the absolute rotation rate blended with the local value of f, as + !! sqrt((1-of)*f^2 + of*4*omega^2). + real :: wstar_ustar_coef !< A ratio relating the efficiency with which convectively released + !! energy is converted to a turbulent velocity, relative to + !! mechanically forced turbulent kinetic energy, nondim. + !! Making this larger increases the diffusivity. + real :: vstar_scale_fac !< An overall nondimensional scaling factor for vstar. + !! Making this larger increases the diffusivity. + real :: Ekman_scale_coef !< A nondimensional scaling factor controlling the inhibition of the + !! diffusive length scale by rotation. Making this larger decreases + !! the diffusivity in the planetary boundary layer. + real :: transLay_scale !< A scale for the mixing length in the transition layer + !! at the edge of the boundary layer as a fraction of the + !! boundary layer thickness. The default is 0, but a + !! value of 0.1 might be better justified by observations. + real :: MLD_tol !< A tolerance for determining the boundary layer thickness when + !! Use_MLD_iteration is true, in m. + real :: min_mix_len !< The minimum mixing length scale that will be used by ePBL, in m. + !! The default (0) does not set a minimum. + real :: N2_Dissipation_Scale_Neg !< A nondimensional scaling factor controlling the loss of TKE + !! due to enhanced dissipation in the presence of negative (unstable) + !! local stratification. This dissipation is applied to the available + !! TKE which includes both that generated at the surface and that + !! generated at depth. + real :: N2_Dissipation_Scale_Pos !< A nondimensional scaling factor controlling the loss of TKE + !! due to enhanced dissipation in the presence of positive (stable) + !! local stratification. This dissipation is applied to the available + !! TKE which includes both that generated at the surface and that + !! generated at depth. + real :: MSTAR_CAP !< Since MSTAR is restoring undissipated energy to mixing, + !! there must be a cap on how large it can be. This + !! is definitely a function of latitude (Ekman limit), + !! but will be taken as constant for now. + real :: MSTAR_SLOPE !< Slope of the function which relates the shear production to the + !< mixing layer depth, Ekman depth, and Monin-Obukhov depth. + real :: MSTAR_XINT !< Value where MSTAR function transitions from linear + !! to decay toward MSTAR->0 at fully developed Ekman depth. + real :: MSTAR_XINT_UP !< Similar but for transition to asymptotic cap. + real :: MSTAR_AT_XINT !< Intercept value of MSTAR at value where function + !! changes to linear transition. + integer :: LT_ENHANCE_FORM !< Integer for Enhancement functional form (various options) + real :: LT_ENHANCE_COEF !< Coefficient in fit for Langmuir Enhancment + real :: LT_ENHANCE_EXP !< Exponent in fit for Langmuir Enhancement + real :: MSTAR_N = -2. !< Exponent in decay at negative and positive limits of MLD_over_STAB + real :: MSTAR_A !< Coefficients of expressions for mstar in asymptotic limits, computed + !! to match the function value and slope at both ends of the linear fit + !! within the well constrained region. + real :: MSTAR_A2 !< Coefficients of expressions for mstar in asymptotic limits. + real :: MSTAR_B !< Coefficients of expressions for mstar in asymptotic limits. + real :: MSTAR_B2 !< Coefficients of expressions for mstar in asymptotic limits. + real :: C_EK = 0.17 !< MSTAR Coefficient in rotation limit for mstar_mode=2 + real :: MSTAR_COEF = 0.3 !< MSTAR coefficient in rotation/stabilizing balance for mstar_mode=2 + real :: LaC_MLDoEK !< Coefficient for Langmuir number modification based on the ratio of + !! the mixed layer depth over the Ekman depth. + real :: LaC_MLDoOB_stab !< Coefficient for Langmuir number modification based on the ratio of + !! the mixed layer depth over the Obukov depth with stablizing forcing. + real :: LaC_EKoOB_stab !< Coefficient for Langmuir number modification based on the ratio of + !! the Ekman depth over the Obukov depth with stablizing forcing. + real :: LaC_MLDoOB_un !< Coefficient for Langmuir number modification based on the ratio of + !! the mixed layer depth over the Obukov depth with destablizing forcing. + real :: LaC_EKoOB_un !< Coefficient for Langmuir number modification based on the ratio of + !! the Ekman depth over the Obukov depth with destablizing forcing. + real :: Max_Enhance_M = 5. !< The maximum allowed LT enhancement to the mixing. + real :: CNV_MST_FAC !< Factor to reduce mstar when statically unstable. + type(time_type), pointer :: Time=>NULL() !< A pointer to the ocean model's clock. + + integer :: MSTAR_MODE = 0 !< An coded integer to determine which formula is used to set mstar + integer :: CONST_MSTAR=0 !< The value of MSTAR_MODE to use a constant mstar + integer :: MLD_o_OBUKHOV=1 !< The value of MSTAR_MODE to base mstar on the ratio of the mixed + !! layer depth to the Obukhov depth + integer :: EKMAN_o_OBUKHOV=2 !< The value of MSTAR_MODE to base mstar on the ratio of the Ekman + !! layer depth to the Obukhov depth + logical :: MSTAR_FLATCAP=.true. !< Set false to use asymptotic mstar cap. + logical :: TKE_diagnostics = .false. !< If true, diagnostics of the TKE budget are being calculated. + logical :: Use_LT = .false. !< Flag for using LT in Energy calculation + logical :: orig_PE_calc = .true. !< If true, the ePBL code uses the original form of the + !! potential energy change code. Otherwise, it uses a newer version + !! that can work with successive increments to the diffusivity in + !! upward or downward passes. + logical :: Use_MLD_iteration=.false. !< False to use old ePBL method. + logical :: Orig_MLD_iteration=.false. !< False to use old MLD value + logical :: MLD_iteration_guess=.false. !< False to default to guessing half the + !! ocean depth for the iteration. + logical :: Mixing_Diagnostics = .false. !< Will be true when outputting mixing + !! length and velocity scales + logical :: MSTAR_Diagnostics=.false. !< If true, utput diagnostics of the mstar calculation. + type(diag_ctrl), pointer :: diag=>NULL() !< A structure that is used to regulate the + !! timing of diagnostic output. + + ! These are terms in the mixed layer TKE budget, all in J m-2 = kg s-2. real, allocatable, dimension(:,:) :: & - diag_TKE_wind, & ! The wind source of TKE. - diag_TKE_MKE, & ! The resolved KE source of TKE. - diag_TKE_conv, & ! The convective source of TKE. - diag_TKE_forcing, & ! The TKE sink required to mix surface - ! penetrating shortwave heating. - diag_TKE_mech_decay, & ! The decay of mechanical TKE. - diag_TKE_conv_decay, & ! The decay of convective TKE. - diag_TKE_mixing,& ! The work done by TKE to deepen - ! the mixed layer. + diag_TKE_wind, & !< The wind source of TKE, in J m-2. + diag_TKE_MKE, & !< The resolved KE source of TKE, in J m-2. + diag_TKE_conv, & !< The convective source of TKE, in J m-2. + diag_TKE_forcing, & !< The TKE sink required to mix surface penetrating shortwave heating, in J m-2. + diag_TKE_mech_decay, & !< The decay of mechanical TKE, in J m-2. + diag_TKE_conv_decay, & !< The decay of convective TKE, in J m-2. + diag_TKE_mixing,& !< The work done by TKE to deepen the mixed layer, in J m-2. ! Additional output parameters also 2d - ML_depth, & ! The mixed layer depth in m. (result after iteration step) - ML_depth2, & ! The mixed layer depth in m. (guess for iteration step) - Enhance_M, & ! The enhancement to the turbulent velocity scale (non-dim) - MSTAR_MIX, & ! Mstar used in EPBL - MSTAR_LT, & ! Mstar for Langmuir turbulence - MLD_EKMAN, & ! MLD over Ekman length - MLD_OBUKHOV, & ! MLD over Obukhov length - EKMAN_OBUKHOV, & ! Ekman over Obukhov length - LA, & ! Langmuir number - LA_MOD ! Modified Langmuir number + ML_depth, & !< The mixed layer depth in m. (result after iteration step) + ML_depth2, & !< The mixed layer depth in m. (guess for iteration step) + Enhance_M, & !< The enhancement to the turbulent velocity scale (non-dim) + MSTAR_MIX, & !< Mstar used in EPBL + MSTAR_LT, & !< Mstar for Langmuir turbulence + MLD_EKMAN, & !< MLD over Ekman length + MLD_OBUKHOV, & !< MLD over Obukhov length + EKMAN_OBUKHOV, & !< Ekman over Obukhov length + LA, & !< Langmuir number + LA_MOD !< Modified Langmuir number real, allocatable, dimension(:,:,:) :: & - Velocity_Scale, & ! The velocity scale used in getting Kd - Mixing_Length ! The length scale used in getting Kd + Velocity_Scale, & !< The velocity scale used in getting Kd + Mixing_Length !< The length scale used in getting Kd + !>@{ Diagnostic IDs integer :: id_ML_depth = -1, id_TKE_wind = -1, id_TKE_mixing = -1 integer :: id_TKE_MKE = -1, id_TKE_conv = -1, id_TKE_forcing = -1 integer :: id_TKE_mech_decay = -1, id_TKE_conv_decay = -1 @@ -208,10 +212,9 @@ module MOM_energetic_PBL integer :: id_OSBL = -1, id_LT_Enhancement = -1, id_MSTAR_mix = -1 integer :: id_mld_ekman = -1, id_mld_obukhov = -1, id_ekman_obukhov = -1 integer :: id_LA_mod = -1, id_LA = -1, id_MSTAR_LT = -1 + !!@} end type energetic_PBL_CS -integer :: num_msg = 0, max_msg = 2 - contains !> This subroutine determines the diffusivities from the integrated energetics From a935d0d0089b1f805d9c636816c6507b7bc7fea1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 11:07:57 -0400 Subject: [PATCH 0552/1072] dOyxgenization of types in MOM_internal_tide_input.F90 dOxyGenized comments describing types and the elements of types in MOM_internal_tide_input.F90. All answers are bitwise identical. --- .../vertical/MOM_internal_tide_input.F90 | 30 ++++++++++--------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 5176be6939..55834769aa 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -25,28 +25,30 @@ module MOM_int_tide_input public set_int_tide_input, int_tide_input_init, int_tide_input_end +!> This control structure holds parameters that regulate internal tide energy inputs. type, public :: int_tide_input_CS ; private - logical :: debug ! If true, write verbose checksums for debugging. - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. - real :: TKE_itide_max ! Maximum Internal tide conversion (W m-2) - ! available to mix above the BBL + logical :: debug !< If true, write verbose checksums for debugging. + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. + real :: TKE_itide_max !< Maximum Internal tide conversion (W m-2) + !! available to mix above the BBL - real, allocatable, dimension(:,:) :: & - TKE_itidal_coef ! The time-invariant field that enters the TKE_itidal - ! input calculation, in J m-2. + real, allocatable, dimension(:,:) :: TKE_itidal_coef + !< The time-invariant field that enters the TKE_itidal input calculation, in J m-2. + character(len=200) :: inputdir !< The directory for input files. + !>@{ Diagnostic IDs integer :: id_TKE_itidal = -1, id_Nb = -1, id_N2_bot = -1 - character(len=200) :: inputdir + !!@} end type int_tide_input_CS +!> This type is used to exchange fields related to the internal tides. type, public :: int_tide_input_type real, allocatable, dimension(:,:) :: & - TKE_itidal_input, & ! The internal tide TKE input at the bottom of - ! the ocean, in W m-2. - h2, & ! The squared topographic roughness height, in m2. - tideamp, & ! The amplitude of the tidal velocities, in m s-1. - Nb ! The bottom stratification, in s-1. + TKE_itidal_input, & !< The internal tide TKE input at the bottom of the ocean, in W m-2. + h2, & !< The squared topographic roughness height, in m2. + tideamp, & !< The amplitude of the tidal velocities, in m s-1. + Nb !< The bottom stratification, in s-1. end type int_tide_input_type contains From 5286346a915e0f2ed17a1fbfbc5603cbc7283804 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 11:08:13 -0400 Subject: [PATCH 0553/1072] dOyxgenization of type elements in MOM_kappa_shear.F90 dOxyGenized comments describing the elements of types in MOM_kappa_shear.F90. All answers are bitwise identical. --- src/parameterizations/vertical/MOM_kappa_shear.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 5e858d380d..be02fab00b 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -87,12 +87,14 @@ module MOM_kappa_shear logical :: eliminate_massless !< If true, massless layers are merged with neighboring !! massive layers in this calculation. ! I can think of no good reason why this should be false. - RWH - logical :: layer_stagger = .false. +! logical :: layer_stagger = .false. ! If true, do the calculations centered at + ! layers, rather than the interfaces. logical :: debug = .false. !< If true, write verbose debugging messages. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. - integer :: id_Kd_shear = -1, id_TKE = -1 - integer :: id_ILd2 = -1, id_dz_Int = -1 + !>@{ Diagnostic IDs + integer :: id_Kd_shear = -1, id_TKE = -1, id_ILd2 = -1, id_dz_Int = -1 + !!@} end type Kappa_shear_CS ! integer :: id_clock_project, id_clock_KQ, id_clock_avg, id_clock_setup From a58cb44d0e6bb636d6f188a70e63cd88a3cc8ffe Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 11:09:22 -0400 Subject: [PATCH 0554/1072] dOyxgenization of types in MOM_opacity.F90 dOxyGenized comments describing types and the elements of types in MOM_opacity.F90. All answers are bitwise identical. --- .../vertical/MOM_opacity.F90 | 67 ++++++++++--------- 1 file changed, 34 insertions(+), 33 deletions(-) diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index f6c25dbc67..8651f983a9 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -55,47 +55,48 @@ module MOM_opacity public set_opacity, opacity_init, opacity_end, opacity_manizza, opacity_morel +!> The control structure with paramters for the MOM_opacity module type, public :: opacity_CS ; private - logical :: var_pen_sw ! If true, use one of the CHL_A schemes - ! (specified below) to determine the e-folding - ! depth of incoming short wave radiation. - ! The default is false. - integer :: opacity_scheme ! An integer indicating which scheme should be - ! used to translate water properties into the - ! opacity (i.e., the e-folding depth) and (perhaps) - ! the number of bands of penetrating shortwave - ! radiation to use. - real :: pen_sw_scale ! The vertical absorption e-folding depth of the - ! penetrating shortwave radiation, in m. - real :: pen_sw_scale_2nd ! The vertical absorption e-folding depth of the - ! (2nd) penetrating shortwave radiation, in m. - real :: SW_1ST_EXP_RATIO ! Ratio for 1st exp decay in Two Exp decay opacity - real :: pen_sw_frac ! The fraction of shortwave radiation that is - ! penetrating with a constant e-folding approach. - real :: blue_frac ! The fraction of the penetrating shortwave - ! radiation that is in the blue band, ND. - real :: opacity_land_value ! The value to use for opacity over land, in m-1. - ! The default is 10 m-1 - a value for muddy water. - integer :: sbc_chl ! An integer handle used in time interpolation of - ! chlorophyll read from a file. - logical :: chl_from_file ! If true, chl_a is read from a file. - type(time_type), pointer :: Time => NULL() ! A pointer to the ocean model's clock. - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. + logical :: var_pen_sw !< If true, use one of the CHL_A schemes (specified below) to + !! determine the e-folding depth of incoming short wave radiation. + !! The default is false. + integer :: opacity_scheme !< An integer indicating which scheme should be used to translate + !! water properties into the opacity (i.e., the e-folding depth) and + !! (perhaps) the number of bands of penetrating shortwave radiation to use. + real :: pen_sw_scale !< The vertical absorption e-folding depth of the + !! penetrating shortwave radiation, in m. + real :: pen_sw_scale_2nd !< The vertical absorption e-folding depth of the + !! (2nd) penetrating shortwave radiation, in m. + real :: SW_1ST_EXP_RATIO !< Ratio for 1st exp decay in Two Exp decay opacity + real :: pen_sw_frac !< The fraction of shortwave radiation that is + !! penetrating with a constant e-folding approach. + real :: blue_frac !< The fraction of the penetrating shortwave + !! radiation that is in the blue band, ND. + real :: opacity_land_value !< The value to use for opacity over land, in m-1. + !! The default is 10 m-1 - a value for muddy water. + integer :: sbc_chl !< An integer handle used in time interpolation of + !! chlorophyll read from a file. + logical :: chl_from_file !< If true, chl_a is read from a file. + type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() - ! A pointer to the control structure of the tracer modules. + !< A pointer to the control structure of the tracer modules. + !>@{ Diagnostic IDs integer :: id_sw_pen = -1, id_sw_vis_pen = -1, id_chl = -1 integer, pointer :: id_opacity(:) => NULL() + !!@} end type opacity_CS -integer, parameter :: NO_SCHEME = 0, MANIZZA_05 = 1, MOREL_88 = 2, & - SINGLE_EXP = 3, DOUBLE_EXP = 4 +!>@{ Coded integers to specify the opacity scheme +integer, parameter :: NO_SCHEME = 0, MANIZZA_05 = 1, MOREL_88 = 2, SINGLE_EXP = 3, DOUBLE_EXP = 4 +!!@} -character*(10), parameter :: MANIZZA_05_STRING = "MANIZZA_05" -character*(10), parameter :: MOREL_88_STRING = "MOREL_88" -character*(10), parameter :: SINGLE_EXP_STRING = "SINGLE_EXP" -character*(10), parameter :: DOUBLE_EXP_STRING = "DOUBLE_EXP" +character*(10), parameter :: MANIZZA_05_STRING = "MANIZZA_05" !< String to specify the opacity scheme +character*(10), parameter :: MOREL_88_STRING = "MOREL_88" !< String to specify the opacity scheme +character*(10), parameter :: SINGLE_EXP_STRING = "SINGLE_EXP" !< String to specify the opacity scheme +character*(10), parameter :: DOUBLE_EXP_STRING = "DOUBLE_EXP" !< String to specify the opacity scheme contains From dbc951a158ee312786353d0aa8b053d7574395a1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 11:09:48 -0400 Subject: [PATCH 0555/1072] dOyxgenization of types in MOM_regularize_layers.F90 dOxyGenized comments describing types and the elements of types in MOM_regularize_layers.F90. All answers are bitwise identical. --- .../vertical/MOM_regularize_layers.F90 | 57 ++++++++++--------- 1 file changed, 31 insertions(+), 26 deletions(-) diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 030f6c58c1..8ca682c6b9 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -49,34 +49,38 @@ module MOM_regularize_layers public regularize_layers, regularize_layers_init +!> This control structure holds parameters used by the MOM_regularize_layers module type, public :: regularize_layers_CS ; private - logical :: regularize_surface_layers ! If true, vertically restructure the - ! near-surface layers when they have too much - ! lateral variations to allow for sensible lateral - ! barotropic transports. - logical :: reg_sfc_detrain - real :: h_def_tol1 ! The value of the relative thickness deficit at - ! which to start modifying the structure, 0.5 by - ! default (or a thickness ratio of 5.83). - real :: h_def_tol2 ! The value of the relative thickness deficit at - ! which to the structure modification is in full - ! force, now 20% of the way from h_def_tol1 to 1. - real :: h_def_tol3 ! The values of the relative thickness defitic at - real :: h_def_tol4 ! which to start detrainment from the buffer layers - ! to the interior, and at which to do this at full - ! intensity. Now 30% and 50% of the way from - ! h_def_tol1 to 1. - real :: Hmix_min ! The minimum mixed layer thickness in m. - type(time_type), pointer :: Time => NULL() ! A pointer to the ocean model's clock. - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. - logical :: debug ! If true, do more thorough checks for debugging purposes. - - integer :: id_def_rat = -1 - logical :: allow_clocks_in_omp_loops ! If true, clocks can be called - ! from inside loops that can be threaded. - ! To run with multiple threads, set to False. + logical :: regularize_surface_layers !< If true, vertically restructure the + !! near-surface layers when they have too much + !! lateral variations to allow for sensible lateral + !! barotropic transports. + logical :: reg_sfc_detrain !< If true, allow the buffer layers to detrain into the + !! interior as a part of the restructuring when + !! regularize_surface_layers is true + real :: h_def_tol1 !< The value of the relative thickness deficit at + !! which to start modifying the structure, 0.5 by + !! default (or a thickness ratio of 5.83). + real :: h_def_tol2 !< The value of the relative thickness deficit at + !! which to the structure modification is in full + !! force, now 20% of the way from h_def_tol1 to 1. + real :: h_def_tol3 !< The value of the relative thickness deficit at which to start + !! detrainment from the buffer layers to the interior, now 30% of + !! the way from h_def_tol1 to 1. + real :: h_def_tol4 !< The value of the relative thickness deficit at which to do + !! detrainment from the buffer layers to the interior at full + !! force, now 50% of the way from h_def_tol1 to 1. + real :: Hmix_min !< The minimum mixed layer thickness in m. + type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. + logical :: debug !< If true, do more thorough checks for debugging purposes. + + integer :: id_def_rat = -1 !< A diagnostic ID + logical :: allow_clocks_in_omp_loops !< If true, clocks can be called from inside loops that + !! can be threaded. To run with multiple threads, set to False. #ifdef DEBUG_CODE + !>@{ Diagnostic IDs integer :: id_def_rat_2 = -1, id_def_rat_3 = -1 integer :: id_def_rat_u = -1, id_def_rat_v = -1 integer :: id_e1 = -1, id_e2 = -1, id_e3 = -1 @@ -85,6 +89,7 @@ module MOM_regularize_layers integer :: id_def_rat_v_2 = -1, id_def_rat_v_2b = -1 integer :: id_def_rat_u_3 = -1, id_def_rat_u_3b = -1 integer :: id_def_rat_v_3 = -1, id_def_rat_v_3b = -1 + !!@} #endif end type regularize_layers_CS From 4f2fae409f8877c7de1053efd885bc7b206cbc6f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 11:10:06 -0400 Subject: [PATCH 0556/1072] dOyxgenization of types in MOM_shortwave_abs.F90 dOxyGenized comments describing types, the elements of types, and routines in MOM_shortwave_abs.F90. All answers are bitwise identical. --- .../vertical/MOM_shortwave_abs.F90 | 91 +++++-------------- 1 file changed, 22 insertions(+), 69 deletions(-) diff --git a/src/parameterizations/vertical/MOM_shortwave_abs.F90 b/src/parameterizations/vertical/MOM_shortwave_abs.F90 index 74cd32a342..4d07a66dfb 100644 --- a/src/parameterizations/vertical/MOM_shortwave_abs.F90 +++ b/src/parameterizations/vertical/MOM_shortwave_abs.F90 @@ -13,42 +13,36 @@ module MOM_shortwave_abs public absorbRemainingSW, sumSWoverBands +!> This type is used to exchange information about ocean optical properties type, public :: optics_type ! ocean optical properties - integer :: nbands ! number of penetrating bands of SW radiation + integer :: nbands !< number of penetrating bands of SW radiation - real, pointer, dimension(:,:,:,:) :: & - opacity_band => NULL() ! SW optical depth per unit thickness (1/m) - ! Number of radiation bands is most rapidly varying (first) index. + real, pointer, dimension(:,:,:,:) :: opacity_band => NULL() !< SW optical depth per unit thickness (1/m) + !! The number of radiation bands is most rapidly varying (first) index. - real, pointer, dimension(:,:,:) :: & - SW_pen_band => NULL() ! shortwave radiation (W/m^2) at the surface in each of - ! the nbands bands that penetrates beyond the surface. - ! The most rapidly varying dimension is the band. + real, pointer, dimension(:,:,:) :: SW_pen_band => NULL() !< shortwave radiation (W/m^2) at the surface + !! in each of the nbands bands that penetrates beyond the surface. + !! The most rapidly varying dimension is the band. real, pointer, dimension(:) :: & - min_wavelength_band => NULL(), & ! The range of wavelengths in each band of - max_wavelength_band => NULL() ! penetrating shortwave radiation (nm) + min_wavelength_band => NULL(), & !< The minimum wavelength in each band of penetrating shortwave radiation (nm) + max_wavelength_band => NULL() !< The maximum wavelength in each band of penetrating shortwave radiation (nm) end type optics_type - contains -!> Apply shortwave heating below surface boundary layer. +!> Apply shortwave heating below the boundary layer (when running with the bulk mixed layer inhereted +!! from GOLD) or throughout the water column. In addition, it causes all of the remaining SW radiation +!! to be absorbed, provided that the total water column thickness is greater than H_limit_fluxes. +!! For thinner water columns, the heating is scaled down proportionately, the assumption being that the +!! remaining heating (which is left in Pen_SW) should go into an (absent for now) ocean bottom sediment layer. subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, & adjustAbsorptionProfile, absorbAllSW, T, Pen_SW_bnd, & eps, ksort, htot, Ttot, TKE, dSV_dT) -!< This subroutine applies shortwave heating below the boundary layer (when running -!! with the bulk mixed layer from GOLD) or throughout the water column. In -!! addition, it causes all of the remaining SW radiation to be absorbed, -!! provided that the total water column thickness is greater than -!! H_limit_fluxes. For thinner water columns, the heating is scaled down -!! proportionately, the assumption being that the remaining heating (which is -!! left in Pen_SW) should go into an (absent for now) ocean bottom sediment layer. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or @@ -85,60 +79,19 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, !! will be redistributed through the !! water column (units of K*H), size !! nsw x SZI_(G). - real, dimension(SZI_(G),SZK_(G)), & - optional, intent(in) :: eps !< Small thickness that must remain in + real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: eps !< Small thickness that must remain in !! each layer, and which will not be !! subject to heating (units of H) - integer, dimension(SZI_(G),SZK_(G)), & - optional, intent(in) :: ksort !< Density-sorted k-indicies. - real, dimension(SZI_(G)), & - optional, intent(in) :: htot !< Total mixed layer thickness, in H . - real, dimension(SZI_(G)), & - optional, intent(inout) :: Ttot !< Depth integrated mixed layer + integer, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: ksort !< Density-sorted k-indicies. + real, dimension(SZI_(G)), optional, intent(in) :: htot !< Total mixed layer thickness, in H . + real, dimension(SZI_(G)), optional, intent(inout) :: Ttot !< Depth integrated mixed layer !! temperature (units of K H). - real, dimension(SZI_(G),SZK_(G)), & - optional, intent(in) :: dSV_dT !< The partial derivative of specific - !! volume with temperature, in m3 kg-1 - !! K-1. - real, dimension(SZI_(G),SZK_(G)), & - optional, intent(inout) :: TKE !< The TKE sink from mixing the heating + real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: dSV_dT !< The partial derivative of specific + !! volume with temperature, in m3 kg-1 K-1. + real, dimension(SZI_(G),SZK_(G)), optional, intent(inout) :: TKE !< The TKE sink from mixing the heating !! throughout a layer, in J m-2. -! Arguments: -! (in) G = the ocean grid structure. -! (in) GV = The ocean's vertical grid structure. -! (in) h = the layer thicknesses, in m or kg m-2. -! units of h are referred to as "H" below. -! (in) opacity_band = opacity in each band of penetrating shortwave -! radiation (1/H). The indicies are band, i, k. -! (in) nsw = number of bands of penetrating shortwave radiation -! (in) j = j-index to work on -! (in) dt = time step (seconds) -! (in) H_limit_fluxes = if the total ocean depth is less than this, they -! are scaled away to avoid numerical instabilities. (H) -! This would not be necessary if a finite heat -! capacity mud-layer were added. -! (in) adjustAbsorptionProfile = if true, apply heating above the layers -! in which it should have occurred to get the correct -! mean depth (and potential energy change) of the -! shortwave that should be absorbed by each layer. -! (in) absorbAllSW = if true, any shortwave radiation that hits the -! bottom is absorbed uniformly over the water column. -! (inout) T = layer potential/conservative temperatures (deg C) -! (inout) Pen_SW_bnd = penetrating shortwave heating in each band that -! hits the bottom and will be redistributed through -! the water column (units of K*H), size nsw x SZI_(G). - -! These optional arguments apply when the bulk mixed layer is used -! but are unnecessary with other schemes. -! (in,opt) eps = small thickness that must remain in each layer, and -! which will not be subject to heating (units of H) -! (inout,opt) ksort = density-sorted k-indicies -! (in,opt) htot = total mixed layer thickness, in H -! (inout,opt) Ttot = depth integrated mixed layer temperature (units of K H) -! (in,opt) dSV_dT = the partial derivative of specific volume with temperature, in m3 kg-1 K-1. -! (inout,opt) TKE = the TKE sink from mixing the heating throughout a layer, in J m-2. - + ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & T_chg_above ! A temperature change that will be applied to all the thick ! layers above a given layer, in K. This is only nonzero if From 746359a54a26228be8976bcd0a1043fa97a7b4ac Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 11:10:21 -0400 Subject: [PATCH 0557/1072] dOyxgenization of types in MOM_tidal_mixing.F90 dOxyGenized comments describing types and the elements of types in MOM_tidal_mixing.F90. All answers are bitwise identical. --- .../vertical/MOM_tidal_mixing.F90 | 226 +++++++++--------- 1 file changed, 116 insertions(+), 110 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 11e88442dd..7c712e8010 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -36,129 +36,132 @@ module MOM_tidal_mixing public tidal_mixing_end !> Containers for tidal mixing diagnostics -type, public :: tidal_mixing_diags - private +type, public :: tidal_mixing_diags ; private real, pointer, dimension(:,:,:) :: & - Kd_itidal => NULL(),& ! internal tide diffusivity at interfaces (m2/s) - Fl_itidal => NULL(),& ! vertical flux of tidal turbulent dissipation (m3/s3) - Kd_lowmode => NULL(),& ! internal tide diffusivity at interfaces - ! due to propagating low modes (m2/s) (BDM) - Fl_lowmode => NULL(),& ! vertical flux of tidal turbulent dissipation - ! due to propagating low modes (m3/s3) (BDM) - Kd_Niku => NULL(),& ! lee-wave diffusivity at interfaces (m2/s) - Kd_Niku_work => NULL(),& ! layer integrated work by lee-wave driven mixing (W/m2) - Kd_Itidal_Work => NULL(),& ! layer integrated work by int tide driven mixing (W/m2) - Kd_Lowmode_Work => NULL(),& ! layer integrated work by low mode driven mixing (W/m2) BDM - N2_int => NULL(),& - vert_dep_3d => NULL(),& - Schmittner_coeff_3d => NULL(),& - tidal_qe_md => NULL() - + Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces (m2 s-1) + Fl_itidal => NULL(),& !< vertical flux of tidal turbulent dissipation (m3 s-3) + Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces (m2 s-1) + Kd_Niku_work => NULL(),& !< layer integrated work by lee-wave driven mixing (W m-2) + Kd_Itidal_Work => NULL(),& !< layer integrated work by int tide driven mixing (W m-2) + Kd_Lowmode_Work => NULL(),& !< layer integrated work by low mode driven mixing (W m-2) + N2_int => NULL(),& !< Bouyancy frequency squared at interfaces (s-2) + vert_dep_3d => NULL(),& !< The 3-d mixing energy deposition (W m-3) + Schmittner_coeff_3d => NULL() !< The coefficient in the Schmittner et al mixing scheme, in UNITS? + real, pointer, dimension(:,:,:) :: tidal_qe_md => NULL() !< Input tidal energy dissipated locally, + !! interpolated to model vertical coordinate (W m-3?) + real, pointer, dimension(:,:,:) :: Kd_lowmode => NULL() !< internal tide diffusivity at interfaces + !! due to propagating low modes (m2/s) + real, pointer, dimension(:,:,:) :: Fl_lowmode => NULL() !< vertical flux of tidal turbulent + !! dissipation due to propagating low modes (m3/s3) real, pointer, dimension(:,:) :: & - TKE_itidal_used => NULL(),& ! internal tide TKE input at ocean bottom (W/m2) - N2_bot => NULL(),& ! bottom squared buoyancy frequency (1/s2) - N2_meanz => NULL(),& ! vertically averaged buoyancy frequency (1/s2) - Polzin_decay_scale_scaled => NULL(),& ! vertical scale of decay for tidal dissipation - Polzin_decay_scale => NULL(),& ! vertical decay scale for tidal diss with Polzin (meter) - Simmons_coeff_2d => NULL() + TKE_itidal_used => NULL(),& !< internal tide TKE input at ocean bottom (W/m2) + N2_bot => NULL(),& !< bottom squared buoyancy frequency (1/s2) + N2_meanz => NULL(),& !< vertically averaged buoyancy frequency (1/s2) + Polzin_decay_scale_scaled => NULL(),& !< vertical scale of decay for tidal dissipation + Polzin_decay_scale => NULL(),& !< vertical decay scale for tidal diss with Polzin (meter) + Simmons_coeff_2d => NULL() !< The Simmons et al mixing coefficient end type -!> Control structure for tidal mixing module. +!> Control structure with parameters for the tidal mixing module. type, public :: tidal_mixing_cs - logical :: debug = .true. ! TODO: private + logical :: debug = .true. !< If true, do more extensive debugging checks. This is hard-coded. ! Parameters - logical :: int_tide_dissipation = .false. ! Internal tide conversion (from barotropic) - ! with the schemes of St Laurent et al (2002)/ - ! Simmons et al (2004) - - integer :: Int_tide_profile ! A coded integer indicating the vertical profile - ! for dissipation of the internal waves. Schemes that - ! are currently encoded are St Laurent et al (2002) and - ! Polzin (2009). - logical :: Lee_wave_dissipation = .false. ! Enable lee-wave driven mixing, following - ! Nikurashin (2010), with a vertical energy - ! deposition profile specified by Lee_wave_profile. - ! St Laurent et al (2002) or - ! Simmons et al (2004) scheme - - integer :: Lee_wave_profile ! A coded integer indicating the vertical profile - ! for dissipation of the lee waves. Schemes that are - ! currently encoded are St Laurent et al (2002) and - ! Polzin (2009). - real :: Int_tide_decay_scale ! decay scale for internal wave TKE (meter) - - real :: Mu_itides ! efficiency for conversion of dissipation - ! to potential energy (nondimensional) - - real :: Gamma_itides ! fraction of local dissipation (nondimensional) - - real :: Gamma_lee ! fraction of local dissipation for lee waves - ! (Nikurashin's energy input) (nondimensional) - real :: Decay_scale_factor_lee ! Scaling factor for the decay scale of lee - ! wave energy dissipation (nondimensional) - - real :: min_zbot_itides ! minimum depth for internal tide conversion (meter) - logical :: Lowmode_itidal_dissipation = .false. ! Internal tide conversion (from low modes) - ! with the schemes of St Laurent et al (2002)/ - ! Simmons et al (2004) !BDM - - real :: Nu_Polzin ! The non-dimensional constant used in Polzin form of - ! the vertical scale of decay of tidal dissipation - - real :: Nbotref_Polzin ! Reference value for the buoyancy frequency at the - ! ocean bottom used in Polzin formulation of the - ! vertical scale of decay of tidal dissipation (1/s) - real :: Polzin_decay_scale_factor ! Scaling factor for the decay length scale - ! of the tidal dissipation profile in Polzin - ! (nondimensional) - real :: Polzin_decay_scale_max_factor ! The decay length scale of tidal - ! dissipation profile in Polzin formulation should not - ! exceed Polzin_decay_scale_max_factor * depth of the - ! ocean (nondimensional). - real :: Polzin_min_decay_scale ! minimum decay scale of the tidal dissipation - ! profile in Polzin formulation (meter) - - real :: TKE_itide_max ! maximum internal tide conversion (W m-2) - ! available to mix above the BBL - - real :: utide ! constant tidal amplitude (m s-1) used if - real :: kappa_itides ! topographic wavenumber and non-dimensional scaling - real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height - character(len=200) :: inputdir - - logical :: use_CVMix_tidal = .false. ! true if CVMix is to be used for determining - ! diffusivity due to tidal mixing - - real :: min_thickness ! Minimum thickness allowed [m] + logical :: int_tide_dissipation = .false. !< Internal tide conversion (from barotropic) + !! with the schemes of St Laurent et al (2002) & Simmons et al (2004) + + integer :: Int_tide_profile !< A coded integer indicating the vertical profile + !! for dissipation of the internal waves. Schemes that are + !! currently encoded are St Laurent et al (2002) and Polzin (2009). + logical :: Lee_wave_dissipation = .false. !< Enable lee-wave driven mixing, following + !! Nikurashin (2010), with a vertical energy + !! deposition profile specified by Lee_wave_profile to be + !! St Laurent et al (2002) or Simmons et al (2004) scheme + + integer :: Lee_wave_profile !< A coded integer indicating the vertical profile + !! for dissipation of the lee waves. Schemes that are + !! currently encoded are St Laurent et al (2002) and + !! Polzin (2009). + real :: Int_tide_decay_scale !< decay scale for internal wave TKE (meter) + + real :: Mu_itides !< efficiency for conversion of dissipation + !! to potential energy (nondimensional) + + real :: Gamma_itides !< fraction of local dissipation (nondimensional) + + real :: Gamma_lee !< fraction of local dissipation for lee waves + !! (Nikurashin's energy input) (nondimensional) + real :: Decay_scale_factor_lee !< Scaling factor for the decay scale of lee + !! wave energy dissipation (nondimensional) + + real :: min_zbot_itides !< minimum depth for internal tide conversion (meter) + logical :: Lowmode_itidal_dissipation = .false. !< If true, consider mixing due to breaking low + !! modes that have been remotely generated using an internal tidal + !! dissipation scheme to specify the vertical profile of the energy + !! input to drive diapycnal mixing, along the lines of St. Laurent + !! et al. (2002) and Simmons et al. (2004). + + real :: Nu_Polzin !< The non-dimensional constant used in Polzin form of + !! the vertical scale of decay of tidal dissipation + + real :: Nbotref_Polzin !< Reference value for the buoyancy frequency at the + !! ocean bottom used in Polzin formulation of the + !! vertical scale of decay of tidal dissipation (1/s) + real :: Polzin_decay_scale_factor !< Scaling factor for the decay length scale + !! of the tidal dissipation profile in Polzin (nondimensional) + real :: Polzin_decay_scale_max_factor !< The decay length scale of tidal dissipation + !! profile in Polzin formulation should not exceed + !! Polzin_decay_scale_max_factor * depth of the ocean (nondimensional). + real :: Polzin_min_decay_scale !< minimum decay scale of the tidal dissipation + !! profile in Polzin formulation (meter) + + real :: TKE_itide_max !< maximum internal tide conversion (W m-2) + !! available to mix above the BBL + + real :: utide !< constant tidal amplitude (m s-1) used if + real :: kappa_itides !< topographic wavenumber and non-dimensional scaling + real :: kappa_h2_factor !< factor for the product of wavenumber * rms sgs height + character(len=200) :: inputdir !< The directory in which to find input files + + logical :: use_CVMix_tidal = .false. !< true if CVMix is to be used for determining + !! diffusivity due to tidal mixing + + real :: min_thickness !< Minimum thickness allowed [m] ! CVMix-specific parameters - integer :: CVMix_tidal_scheme = -1 ! 1 for Simmons, 2 for Schmittner - type(CVMix_tidal_params_type) :: CVMix_tidal_params - type(CVMix_global_params_type) :: CVMix_glb_params ! for Prandtl number only - real :: tidal_max_coef ! maximum allowable tidal diffusivity. [m^2/s] - real :: tidal_diss_lim_tc ! dissipation limit for tidal-energy-constituent data - type(remapping_CS) :: remap_cs + integer :: CVMix_tidal_scheme = -1 !< 1 for Simmons, 2 for Schmittner + type(CVMix_tidal_params_type) :: CVMix_tidal_params !< A CVMix-specific type with parameters for tidal mixing + type(CVMix_global_params_type) :: CVMix_glb_params !< CVMix-specific for Prandtl number only + real :: tidal_max_coef !< CVMix-specific maximum allowable tidal diffusivity. [m^2/s] + real :: tidal_diss_lim_tc !< CVMix-specific dissipation limit for + !! tidal-energy-constituent data + type(remapping_CS) :: remap_CS !< The control structure for remapping ! Data containers - real, pointer, dimension(:,:) :: TKE_Niku => NULL() - real, pointer, dimension(:,:) :: TKE_itidal => NULL() - real, pointer, dimension(:,:) :: Nb => NULL() - real, pointer, dimension(:,:) :: mask_itidal => NULL() - real, pointer, dimension(:,:) :: h2 => NULL() - real, pointer, dimension(:,:) :: tideamp => NULL() !< RMS tidal amplitude [m/s] - real, allocatable, dimension(:) :: h_src !< tidal constituent input layer thickness [m] - real, allocatable ,dimension(:,:) :: tidal_qe_2d ! q*E(x,y) ! TODO: make this E(x,y) only - real, allocatable ,dimension(:,:,:) :: tidal_qe_3d_in ! q*E(x,y) + real, pointer, dimension(:,:) :: TKE_Niku => NULL() !< Lee wave driven Turbulent Kinetic Energy input, + !! in W m-2 + real, pointer, dimension(:,:) :: TKE_itidal => NULL() !< The internal Turbulent Kinetic Energy input divided + !! by the bottom stratfication, in J m-2. + real, pointer, dimension(:,:) :: Nb => NULL() !< The near bottom buoyancy frequency, in s-1. + real, pointer, dimension(:,:) :: mask_itidal => NULL() !< A mask of where internal tide energy is input + real, pointer, dimension(:,:) :: h2 => NULL() !< Squared bottom depth variance, in m2. + real, pointer, dimension(:,:) :: tideamp => NULL() !< RMS tidal amplitude [m/s] + real, allocatable, dimension(:) :: h_src !< tidal constituent input layer thickness [m] + real, allocatable, dimension(:,:) :: tidal_qe_2d !< Tidal energy input times the local dissipation + !! fraction, q*E(x,y), with the CVMix implementation + !! of Jayne et al tidal mixing, in W m-2. + !! TODO: make this E(x,y) only + real, allocatable, dimension(:,:,:) :: tidal_qe_3d_in !< q*E(x,y,z) with the Schmittner parameterization, in W m-3? ! Diagnostics - type(diag_ctrl), pointer :: diag => NULL() ! structure to regulate diagn output timing - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() - type(tidal_mixing_diags), pointer :: dd => NULL() + type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostic output timing + type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() !< A pointer to the control structure + !! for remapping diagnostics into Z-space + type(tidal_mixing_diags), pointer :: dd => NULL() !< A pointer to a structure of diagnostic arrays - ! Diagnostic identifiers + !>@{ Diagnostic identifiers integer :: id_TKE_itidal = -1 integer :: id_TKE_leewave = -1 integer :: id_Kd_itidal = -1 @@ -182,9 +185,11 @@ module MOM_tidal_mixing integer :: id_Schmittner_coeff = -1 integer :: id_tidal_qe_md = -1 integer :: id_vert_dep = -1 + !!@} end type tidal_mixing_cs +!!@{ Coded parmameters for specifying mixing schemes character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name. character*(20), parameter :: STLAURENT_PROFILE_STRING = "STLAURENT_02" character*(20), parameter :: POLZIN_PROFILE_STRING = "POLZIN_09" @@ -194,6 +199,7 @@ module MOM_tidal_mixing character*(20), parameter :: SCHMITTNER_SCHEME_STRING = "SCHMITTNER" integer, parameter :: SIMMONS = 1 integer, parameter :: SCHMITTNER = 2 +!!@} contains @@ -206,7 +212,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< pointer to the Z-diagnostics control - type(tidal_mixing_cs), pointer :: CS !< This module's control structure. + type(tidal_mixing_cs), pointer :: CS !< This module's control structure. ! Local variables logical :: read_tideamp @@ -477,7 +483,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, filename = trim(CS%inputdir) // trim(Niku_TKE_input_file) call log_param(param_file, mdl, "INPUTDIR/NIKURASHIN_TKE_INPUT_FILE", & filename) - call safe_alloc_ptr(CS%TKE_Niku,is,ie,js,je); CS%TKE_Niku(:,:) = 0.0 + call safe_alloc_ptr(CS%TKE_Niku,is,ie,js,je) ; CS%TKE_Niku(:,:) = 0.0 call MOM_read_data(filename, 'TKE_input', CS%TKE_Niku, G%domain, timelevel=1 ) ! ??? timelevel -aja CS%TKE_Niku(:,:) = Niku_scale * CS%TKE_Niku(:,:) @@ -560,7 +566,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, if (CS%use_CVMix_tidal) then CS%id_N2_int = register_diag_field('ocean_model','N2_int',diag%axesTi,Time, & 'Bouyancy frequency squared, at interfaces', 's-2') - ! TODO: add units + !> TODO: add units CS%id_Simmons_coeff = register_diag_field('ocean_model','Simmons_coeff',diag%axesT1,Time, & 'time-invariant portion of the tidal mixing coefficient using the Simmons', '') CS%id_Schmittner_coeff = register_diag_field('ocean_model','Schmittner_coeff',diag%axesTL,Time, & From 7a07e6ec35066c571af8a7b4864d9251da4dd1e9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 11:11:38 -0400 Subject: [PATCH 0558/1072] dOyxgenization of types in MOM_entrain_diffusive.F90 dOxyGenized comments describing types and the elements of types in MOM_entrain_diffusive.F90. All answers are bitwise identical. --- .../vertical/MOM_entrain_diffusive.F90 | 24 +++++++++---------- 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index d7a6a617d8..df7afe2e57 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -66,19 +66,19 @@ module MOM_entrain_diffusive public entrainment_diffusive, entrain_diffusive_init, entrain_diffusive_end +!> The control structure holding parametes for the MOM_entrain_diffusive module type, public :: entrain_diffusive_CS ; private - logical :: bulkmixedlayer ! If true, a refined bulk mixed layer is used with - ! GV%nk_rho_varies variable density mixed & buffer - ! layers. - logical :: correct_density ! If true, the layer densities are restored toward - ! their target variables by the diapycnal mixing. - integer :: max_ent_it ! The maximum number of iterations that may be - ! used to calculate the diapycnal entrainment. - real :: Tolerance_Ent ! The tolerance with which to solve for entrainment - ! values, in m. - type(diag_ctrl), pointer :: diag => NULL() ! A structure that is used to - ! regulate the timing of diagnostic output. - integer :: id_Kd = -1, id_diff_work = -1 + logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with + !! GV%nk_rho_varies variable density mixed & buffer layers. + logical :: correct_density !< If true, the layer densities are restored toward + !! their target variables by the diapycnal mixing. + integer :: max_ent_it !< The maximum number of iterations that may be used to + !! calculate the diapycnal entrainment. + real :: Tolerance_Ent !< The tolerance with which to solve for entrainment values, in m. + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. + integer :: id_Kd = -1 !< Diagnostic ID for diffusivity + integer :: id_diff_work = -1 !< Diagnostic ID for mixing work end type entrain_diffusive_CS contains From e52ef107694dc5edbb1f328d1b71c118dbdfa143 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 11:22:42 -0400 Subject: [PATCH 0559/1072] Removed trailing white space in MOM_bulk_mixed_layer --- src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 0fcb8551ab..c2a923d404 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -154,7 +154,7 @@ module MOM_bulk_mixed_layer logical :: allow_clocks_in_omp_loops !< If true, clocks can be called from inside loops that can !! be threaded. To run with multiple threads, set to False. type(group_pass_type) :: pass_h_sum_hmbl_prev !< For group halo pass - + !>@{ Diagnostic IDs integer :: id_ML_depth = -1, id_TKE_wind = -1, id_TKE_mixing = -1 integer :: id_TKE_RiBulk = -1, id_TKE_conv = -1, id_TKE_pen_SW = -1 From 4d68f2c0d8cc40baec2a1e0dd515232b3f3e075f Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Tue, 10 Jul 2018 08:52:11 -0800 Subject: [PATCH 0560/1072] A different tack on reentrant OBC fix. --- src/core/MOM_open_boundary.F90 | 63 ++++++++++++++++++++++++---------- 1 file changed, 45 insertions(+), 18 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 27fd7ddd4d..f6fe94be89 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -283,7 +283,7 @@ subroutine open_boundary_config(G, param_file, OBC) type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure ! Local variables integer :: l ! For looping over segments - logical :: debug_OBC, debug, mask_outside + logical :: debug_OBC, debug, mask_outside, reentrant_x, reentrant_y character(len=15) :: segment_param_str ! The run-time parameter name for each segment character(len=100) :: segment_str ! The contents (rhs) for parameter "segment_param_str" character(len=200) :: config1 ! String for OBC_USER_CONFIG @@ -378,6 +378,10 @@ subroutine open_boundary_config(G, param_file, OBC) "A silly value of velocities used outside of open boundary \n"//& "conditions for debugging.", units="m/s", default=0.0, & do_not_log=.not.debug_OBC, debuggingParam=.true.) + reentrant_x = .false. + call get_param(param_file, mdl, "REENTRANT_X", reentrant_x, default=.true.) + reentrant_y = .false. + call get_param(param_file, mdl, "REENTRANT_Y", reentrant_y, default=.false.) ! Allocate everything ! Note the 0-segment is needed when %segnum_u/v(:,:) = 0 @@ -413,9 +417,9 @@ subroutine open_boundary_config(G, param_file, OBC) fail_if_missing=.true.) segment_str = remove_spaces(segment_str) if (segment_str(1:2) == 'I=') then - call setup_u_point_obc(OBC, G, segment_str, l, param_file) + call setup_u_point_obc(OBC, G, segment_str, l, param_file, reentrant_y) elseif (segment_str(1:2) == 'J=') then - call setup_v_point_obc(OBC, G, segment_str, l, param_file) + call setup_v_point_obc(OBC, G, segment_str, l, param_file, reentrant_x) else call MOM_error(FATAL, "MOM_open_boundary.F90, open_boundary_config: "//& "Unable to interpret "//segment_param_str//" = "//trim(segment_str)) @@ -753,12 +757,13 @@ subroutine setup_segment_indices(G, seg, Is_obc, Ie_obc, Js_obc, Je_obc) end subroutine setup_segment_indices !> Parse an OBC_SEGMENT_%%% string starting with "I=" and configure placement and type of OBC accordingly -subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF) +subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_y) type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure character(len=*), intent(in) :: segment_str !< A string in form of "I=%,J=%:%,string" integer, intent(in) :: l_seg !< which segment is this? type(param_file_type), intent(in) :: PF !< Parameter file handle + logical, intent(in) :: reentrant_y !< is the domain reentrant in y? ! Local variables integer :: I_obc, Js_obc, Je_obc ! Position of segment in global index space integer :: j, a_loop @@ -766,7 +771,7 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF) character(len=128) :: segment_param_str real, allocatable, dimension(:) :: tnudge ! This returns the global indices for the segment - call parse_segment_str(G%ieg, G%jeg, segment_str, I_obc, Js_obc, Je_obc, action_str ) + call parse_segment_str(G%ieg, G%jeg, segment_str, I_obc, Js_obc, Je_obc, action_str, reentrant_y) call setup_segment_indices(G, OBC%segment(l_seg),I_obc,I_obc,Js_obc,Je_obc) @@ -864,12 +869,13 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF) end subroutine setup_u_point_obc !> Parse an OBC_SEGMENT_%%% string starting with "J=" and configure placement and type of OBC accordingly -subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF) +subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_x) type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure character(len=*), intent(in) :: segment_str !< A string in form of "J=%,I=%:%,string" integer, intent(in) :: l_seg !< which segment is this? type(param_file_type), intent(in) :: PF !< Parameter file handle + logical, intent(in) :: reentrant_x !< is the domain reentrant in x? ! Local variables integer :: J_obc, Is_obc, Ie_obc ! Position of segment in global index space integer :: i, a_loop @@ -878,7 +884,7 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF) real, allocatable, dimension(:) :: tnudge ! This returns the global indices for the segment - call parse_segment_str(G%ieg, G%jeg, segment_str, J_obc, Is_obc, Ie_obc, action_str ) + call parse_segment_str(G%ieg, G%jeg, segment_str, J_obc, Is_obc, Ie_obc, action_str, reentrant_x) call setup_segment_indices(G, OBC%segment(l_seg),Is_obc,Ie_obc,J_obc,J_obc) @@ -976,7 +982,7 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF) end subroutine setup_v_point_obc !> Parse an OBC_SEGMENT_%%% string -subroutine parse_segment_str(ni_global, nj_global, segment_str, l, m, n, action_str ) +subroutine parse_segment_str(ni_global, nj_global, segment_str, l, m, n, action_str, reentrant) integer, intent(in) :: ni_global !< Number of h-points in zonal direction integer, intent(in) :: nj_global !< Number of h-points in meridional direction character(len=*), intent(in) :: segment_str !< A string in form of "I=l,J=m:n,string" or "J=l,I=m,n,string" @@ -984,12 +990,14 @@ subroutine parse_segment_str(ni_global, nj_global, segment_str, l, m, n, action_ integer, intent(out) :: m !< The value of J=m, if segment_str begins with I=, or the value of I=m integer, intent(out) :: n !< The value of J=n, if segment_str begins with I=, or the value of I=n character(len=*), intent(out) :: action_str(:) !< The "string" part of segment_str + logical, intent(in) :: reentrant !< is domain reentrant in relevant direction? ! Local variables character(len=24) :: word1, word2, m_word, n_word !< Words delineated by commas in a string in form of !! "I=%,J=%:%,string" integer :: l_max !< Either ni_global or nj_global, depending on whether segment_str begins with "I=" or "J=" integer :: mn_max !< Either nj_global or ni_global, depending on whether segment_str begins with "I=" or "J=" integer :: j + integer, parameter :: halo = 10 ! Process first word which will started with either 'I=' or 'J=' word1 = extract_word(segment_str,',',1) @@ -1019,17 +1027,31 @@ subroutine parse_segment_str(ni_global, nj_global, segment_str, l, m, n, action_ ! Read m m_word = extract_word(word2(3:24),':',1) m = interpret_int_expr( m_word, mn_max ) - if (m<-1 .or. m>mn_max+1) then - call MOM_error(FATAL, "MOM_open_boundary.F90, parse_segment_str: "//& - "Beginning of range in string '"//trim(segment_str)//"' is outside of the physical domain.") + if (reentrant) then + if (m<-halo .or. m>mn_max+halo) then + call MOM_error(FATAL, "MOM_open_boundary.F90, parse_segment_str: "//& + "Beginning of range in string '"//trim(segment_str)//"' is outside of the physical domain.") + endif + else + if (m<-1 .or. m>mn_max+1) then + call MOM_error(FATAL, "MOM_open_boundary.F90, parse_segment_str: "//& + "Beginning of range in string '"//trim(segment_str)//"' is outside of the physical domain.") + endif endif - ! Read m + ! Read n n_word = extract_word(word2(3:24),':',2) n = interpret_int_expr( n_word, mn_max ) - if (n<-1 .or. n>mn_max+1) then - call MOM_error(FATAL, "MOM_open_boundary.F90, parse_segment_str: "//& - "End of range in string '"//trim(segment_str)//"' is outside of the physical domain.") + if (reentrant) then + if (n<-halo .or. n>mn_max+halo) then + call MOM_error(FATAL, "MOM_open_boundary.F90, parse_segment_str: "//& + "End of range in string '"//trim(segment_str)//"' is outside of the physical domain.") + endif + else + if (n<-1 .or. n>mn_max+1) then + call MOM_error(FATAL, "MOM_open_boundary.F90, parse_segment_str: "//& + "End of range in string '"//trim(segment_str)//"' is outside of the physical domain.") + endif endif if (abs(n-m)==0) then @@ -1044,7 +1066,7 @@ subroutine parse_segment_str(ni_global, nj_global, segment_str, l, m, n, action_ contains - ! Returns integer value interpreted from string in form of %I, N or N-%I + ! Returns integer value interpreted from string in form of %I, N or N+-%I integer function interpret_int_expr(string, imax) character(len=*), intent(in) :: string !< Integer in form or %I, N or N-%I integer, intent(in) :: imax !< Value to replace 'N' with @@ -1057,8 +1079,13 @@ integer function interpret_int_expr(string, imax) if (len_trim(string)==1 .and. string(1:1)=='N') then interpret_int_expr = imax elseif (string(1:1)=='N') then - read(string(2:slen),*,err=911) interpret_int_expr - interpret_int_expr = imax - interpret_int_expr + if (string(2:2)=='+') then + read(string(3:slen),*,err=911) interpret_int_expr + interpret_int_expr = imax + interpret_int_expr + elseif (string(2:2)=='-') then + read(string(3:slen),*,err=911) interpret_int_expr + interpret_int_expr = imax - interpret_int_expr + endif else read(string(1:slen),*,err=911) interpret_int_expr endif From 05017cbb4e604dc1aad2c5f108b445841c9bc86c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 14:48:11 -0400 Subject: [PATCH 0561/1072] dOyxgenization of type elements in MOM_oda_driver.F90 Added dOxyGenized comments describing three elements of types in MOM_oda_driver.F90. All answers are bitwise identical. --- src/ocean_data_assim/MOM_oda_driver.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 3929f2eacf..829c6d883d 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -58,7 +58,7 @@ module MOM_oda_driver_mod #include !> Control structure that contains a transpose of the ocean state across ensemble members. - type, public :: ODA_CS; private + type, public :: ODA_CS ; private type(ocean_control_struct), pointer :: Ocean_prior=> NULL() !< ensemble ocean prior states in DA space type(ocean_control_struct), pointer :: Ocean_posterior=> NULL() !< ensemble ocean posterior states !! or increments to prior in DA space @@ -71,7 +71,8 @@ module MOM_oda_driver_mod type(grid_type), pointer :: oda_grid !< local tracer grid real, pointer, dimension(:,:,:) :: h => NULL() ! NULL() !< pointer to thermodynamic variables - integer :: ni, nj !< global grid size + integer :: ni !< global i-direction grid size + integer :: nj !< global j-direction grid size logical :: reentrant_x !< grid is reentrant in the x direction logical :: reentrant_y !< grid is reentrant in the y direction logical :: tripolar_N !< grid is folded at its north edge @@ -85,7 +86,7 @@ module MOM_oda_driver_mod ! Profiles local to the analysis domain type(ocean_profile_type), pointer :: Profiles => NULL() !< pointer to linked list of all available profiles type(ocean_profile_type), pointer :: CProfiles => NULL()!< pointer to linked list of current profiles - type(kd_root), pointer :: kdroot => NULL() + type(kd_root), pointer :: kdroot => NULL() !< A structure for storing nearest neighbors type(ALE_CS), pointer :: ALE_CS=>NULL() !< ALE control structure for DA logical :: use_ALE_algorithm !< true is using ALE remapping type(regridding_CS) :: regridCS !< ALE control structure for regridding @@ -94,15 +95,14 @@ module MOM_oda_driver_mod type(diag_ctrl) :: diag_cs ! pointer to a mpp_domain object + !> A structure with a pointer to a domain2d, to allow for the creation of arrays of pointers. type :: ptr_mpp_domain - type(domain2d), pointer :: mpp_domain => NULL() + type(domain2d), pointer :: mpp_domain => NULL() !< pointer to an mpp domain2d end type ptr_mpp_domain - !>@{ - !! DA parameters + !>@{ DA parameters integer, parameter :: NO_ASSIM = 0, OI_ASSIM=1, EAKF_ASSIM=2 - !>@} + !!@} contains From 358ce51737019d7da4e3284925efe141481db32a Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 10 Jul 2018 15:03:44 -0400 Subject: [PATCH 0562/1072] Fixed doxygen errors in midas_vertmap.F90 - Added doxumentation where missing - Cleaned up old-style comments - Partially fixed indenting --- src/initialization/midas_vertmap.F90 | 1533 +++++++++++++------------- 1 file changed, 752 insertions(+), 781 deletions(-) diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index 3e4aafe68f..95c7b9fa3f 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -3,783 +3,752 @@ module MIDAS_vertmap ! This file is part of MOM6. See LICENSE.md for the license. -!> If calling from MOM6, use MOM6 interfaces for EOS functions +! If calling from MOM6, use MOM6 interfaces for EOS functions #ifndef PY_SOLO - use MOM_EOS, only : EOS_type, calculate_density,calculate_density_derivs +use MOM_EOS, only : EOS_type, calculate_density,calculate_density_derivs - implicit none ; private +implicit none ; private - public tracer_z_init, determine_temperature, fill_boundaries - public find_interfaces, meshgrid +public tracer_z_init, determine_temperature, fill_boundaries +public find_interfaces, meshgrid #endif - interface fill_boundaries - module procedure fill_boundaries_real - module procedure fill_boundaries_int - end interface +!> Fill grid edges +interface fill_boundaries + module procedure fill_boundaries_real + module procedure fill_boundaries_int +end interface - real, parameter :: epsln=1.e-10 +real, parameter :: epsln=1.e-10 !< A hard-wired constant! + !! \todo Get rid of this constant contains #ifdef PY_SOLO -! ----------------------------------------------------------------------------- -!> These EOS routines are needed only for the stand-alone version of the code - function wright_eos_2d(T,S,p) result(rho) -! -!********************************************************************** -! The subroutines in this file implement the equation of state for * -! sea water using the formulae given by Wright, 1997, J. Atmos. * -! Ocean. Tech., 14, 735-740. * -! *********************************************************************** -! - -! Calculate seawater equation of state, given T[degC],S[PSU],p[Pa] -! Returns density [kg m-3] - - real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and Salinity (psu) - real, intent(in) :: p !< pressure (Pa) - real(kind=8), dimension(size(T,1),size(T,2)) :: rho !< potential density (kg m-3) - - - real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5 - real(kind=8) :: al0,lam,p0,I_denom - integer :: i,k - - a0 = 7.057924e-4; a1 = 3.480336e-7; a2 = -1.112733e-7 - b0 = 5.790749e8; b1 = 3.516535e6; b2 = -4.002714e4 - b3 = 2.084372e2; b4 = 5.944068e5; b5 = -9.643486e3 - c0 = 1.704853e5; c1 = 7.904722e2; c2 = -7.984422 - c3 = 5.140652e-2; c4 = -2.302158e2; c5 = -3.079464 - - do k=1,size(T,2) - do i=1,size(T,1) - al0 = a0 + a1*T(i,k) +a2*S(i,k) - p0 = b0 + b4*S(i,k) + T(i,k) * (b1 + T(i,k)*(b2 + & - b3*T(i,k)) + b5*S(i,k)) - lam = c0 +c4*S(i,k) + T(i,k) * (c1 + T(i,k)*(c2 + & - c3*T(i,k)) + c5*S(i,k)) - I_denom = 1.0 / (lam + al0*(p+p0)) - rho(i,k) = (p + p0) * I_denom - enddo +!> Calculate seawater equation of state, given T[degC],S[PSU],p[Pa] +!! Returns density [kg m-3] +!! +!! These EOS routines are needed only for the stand-alone version of the code +!! The subroutines in this file implement the equation of state for +!! sea water using the formulae given by Wright, 1997, J. Atmos. +!! Ocean. Tech., 14, 735-740. +function wright_eos_2d(T,S,p) result(rho) + real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and Salinity (psu) + real, intent(in) :: p !< pressure (Pa) + real(kind=8), dimension(size(T,1),size(T,2)) :: rho !< potential density (kg m-3) + ! Local variables + real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5 + real(kind=8) :: al0,lam,p0,I_denom + integer :: i,k + + a0 = 7.057924e-4; a1 = 3.480336e-7; a2 = -1.112733e-7 + b0 = 5.790749e8; b1 = 3.516535e6; b2 = -4.002714e4 + b3 = 2.084372e2; b4 = 5.944068e5; b5 = -9.643486e3 + c0 = 1.704853e5; c1 = 7.904722e2; c2 = -7.984422 + c3 = 5.140652e-2; c4 = -2.302158e2; c5 = -3.079464 + + do k=1,size(T,2) + do i=1,size(T,1) + al0 = a0 + a1*T(i,k) +a2*S(i,k) + p0 = b0 + b4*S(i,k) + T(i,k) * (b1 + T(i,k)*(b2 + & + b3*T(i,k)) + b5*S(i,k)) + lam = c0 +c4*S(i,k) + T(i,k) * (c1 + T(i,k)*(c2 + & + c3*T(i,k)) + c5*S(i,k)) + I_denom = 1.0 / (lam + al0*(p+p0)) + rho(i,k) = (p + p0) * I_denom enddo - - - return - end function wright_eos_2d - - function alpha_wright_eos_2d(T,S,p) result(drho_dT) - - ! ********************************************************************** - ! The subroutines in this file implement the equation of state for * - ! sea water using the formulae given by Wright, 1997, J. Atmos. * - ! Ocean. Tech., 14, 735-740. * - ! *********************************************************************** - - ! Calculate seawater thermal expansion coefficient given T[degC],S[PSU],p[Pa] - ! Returns density [kg m-3 C-1] - - real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and Salinity (psu) - real, intent(in) :: p !< pressure (Pa) - real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dT !< partial derivative of density with respect to temperature (kg m-3 C-1) - - real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5 - real(kind=8) :: al0,lam,p0,I_denom,I_denom2 - integer :: i,k - - a0 = 7.057924e-4; a1 = 3.480336e-7; a2 = -1.112733e-7 - b0 = 5.790749e8; b1 = 3.516535e6; b2 = -4.002714e4 - b3 = 2.084372e2; b4 = 5.944068e5; b5 = -9.643486e3 - c0 = 1.704853e5; c1 = 7.904722e2; c2 = -7.984422 - c3 = 5.140652e-2; c4 = -2.302158e2; c5 = -3.079464 - - do k=1,size(T,2) - do i=1,size(T,1) - al0 = a0 + a1*T(i,k) +a2*S(i,k) - p0 = b0 + b4*S(i,k) + T(i,k) * (b1 + T(i,k)*(b2 + & - b3*T(i,k)) + b5*S(i,k)) - lam = c0 +c4*S(i,k) + T(i,k) * (c1 + T(i,k)*(c2 + & - c3*T(i,k)) + c5*S(i,k)) - I_denom = 1.0 / (lam + al0*(p+p0)) - I_denom2 = I_denom*I_denom - drho_dT(i,k) = I_denom2*(lam*(b1+T(i,k)*(2*b2 + & - 3*b3*T(i,k)) + b5*S(i,k)) - (p+p0)*((p+p0)*a1 + & - (c1+T(i,k)*(2*c2 + 3*c3*T(i,k)) + c5*S(i,k)))) - enddo + enddo + + return +end function wright_eos_2d + +!> Calculate seawater thermal expansion coefficient given T[degC],S[PSU],p[Pa] +!! Returns density [kg m-3 C-1] +!! +!! The subroutines in this file implement the equation of state for +!! sea water using the formulae given by Wright, 1997, J. Atmos. +!! Ocean. Tech., 14, 735-740. +function alpha_wright_eos_2d(T,S,p) result(drho_dT) + real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and Salinity (psu) + real, intent(in) :: p !< pressure (Pa) + real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dT !< partial derivative of density with respect to temperature (kg m-3 C-1) + ! Local variables + real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5 + real(kind=8) :: al0,lam,p0,I_denom,I_denom2 + integer :: i,k + + a0 = 7.057924e-4; a1 = 3.480336e-7; a2 = -1.112733e-7 + b0 = 5.790749e8; b1 = 3.516535e6; b2 = -4.002714e4 + b3 = 2.084372e2; b4 = 5.944068e5; b5 = -9.643486e3 + c0 = 1.704853e5; c1 = 7.904722e2; c2 = -7.984422 + c3 = 5.140652e-2; c4 = -2.302158e2; c5 = -3.079464 + + do k=1,size(T,2) + do i=1,size(T,1) + al0 = a0 + a1*T(i,k) +a2*S(i,k) + p0 = b0 + b4*S(i,k) + T(i,k) * (b1 + T(i,k)*(b2 + & + b3*T(i,k)) + b5*S(i,k)) + lam = c0 +c4*S(i,k) + T(i,k) * (c1 + T(i,k)*(c2 + & + c3*T(i,k)) + c5*S(i,k)) + I_denom = 1.0 / (lam + al0*(p+p0)) + I_denom2 = I_denom*I_denom + drho_dT(i,k) = I_denom2*(lam*(b1+T(i,k)*(2*b2 + & + 3*b3*T(i,k)) + b5*S(i,k)) - (p+p0)*((p+p0)*a1 + & + (c1+T(i,k)*(2*c2 + 3*c3*T(i,k)) + c5*S(i,k)))) enddo - - - return - end function alpha_wright_eos_2d - - function beta_wright_eos_2d(T,S,p) result(drho_dS) - - ! ********************************************************************** - ! The subroutines in this file implement the equation of state for * - ! sea water using the formulae given by Wright, 1997, J. Atmos. * - ! Ocean. Tech., 14, 735-740. * - ! *********************************************************************** - - ! Calculate seawater haline expansion coefficient given T[degC],S[PSU],p[Pa] - ! Returns density [kg m-3 PSU-1] - - real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and salinity (psu) - real, intent(in) :: p !< pressure (Pa) - real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dS !< partial derivative of density with respect to salinity (kg m-3 PSU-1) - - - - real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5 - real(kind=8) :: al0,lam,p0,I_denom,I_denom2 - integer :: i,k - - a0 = 7.057924e-4; a1 = 3.480336e-7; a2 = -1.112733e-7 - b0 = 5.790749e8; b1 = 3.516535e6; b2 = -4.002714e4 - b3 = 2.084372e2; b4 = 5.944068e5; b5 = -9.643486e3 - c0 = 1.704853e5; c1 = 7.904722e2; c2 = -7.984422 - c3 = 5.140652e-2; c4 = -2.302158e2; c5 = -3.079464 - - do k=1,size(T,2) - do i=1,size(T,1) - al0 = a0 + a1*T(i,k) +a2*S(i,k) - p0 = b0 + b4*S(i,k) + T(i,k) * (b1 + T(i,k)*(b2 + & - b3*T(i,k)) + b5*S(i,k)) - lam = c0 +c4*S(i,k) + T(i,k) * (c1 + T(i,k)*(c2 + & - c3*T(i,k)) + c5*S(i,k)) - I_denom = 1.0 / (lam + al0*(p+p0)) - I_denom2 = I_denom*I_denom - drho_dS(i,k) = I_denom2*(lam*(b4+b5*T(i,k)) - & - (p+p0)*((p+p0)*a2 + (c4+c5*T(i,k)))) - enddo + enddo + + return +end function alpha_wright_eos_2d + +!> Calculate seawater haline expansion coefficient given T[degC],S[PSU],p[Pa] +!! Returns density [kg m-3 PSU-1] +!! +!! The subroutines in this file implement the equation of state for +!! sea water using the formulae given by Wright, 1997, J. Atmos. +!! Ocean. Tech., 14, 735-740. +function beta_wright_eos_2d(T,S,p) result(drho_dS) + real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and salinity (psu) + real, intent(in) :: p !< pressure (Pa) + real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dS !< partial derivative of density with respect to salinity (kg m-3 PSU-1) + ! Local variables + real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5 + real(kind=8) :: al0,lam,p0,I_denom,I_denom2 + integer :: i,k + + a0 = 7.057924e-4; a1 = 3.480336e-7; a2 = -1.112733e-7 + b0 = 5.790749e8; b1 = 3.516535e6; b2 = -4.002714e4 + b3 = 2.084372e2; b4 = 5.944068e5; b5 = -9.643486e3 + c0 = 1.704853e5; c1 = 7.904722e2; c2 = -7.984422 + c3 = 5.140652e-2; c4 = -2.302158e2; c5 = -3.079464 + + do k=1,size(T,2) + do i=1,size(T,1) + al0 = a0 + a1*T(i,k) +a2*S(i,k) + p0 = b0 + b4*S(i,k) + T(i,k) * (b1 + T(i,k)*(b2 + & + b3*T(i,k)) + b5*S(i,k)) + lam = c0 +c4*S(i,k) + T(i,k) * (c1 + T(i,k)*(c2 + & + c3*T(i,k)) + c5*S(i,k)) + I_denom = 1.0 / (lam + al0*(p+p0)) + I_denom2 = I_denom*I_denom + drho_dS(i,k) = I_denom2*(lam*(b4+b5*T(i,k)) - & + (p+p0)*((p+p0)*a2 + (c4+c5*T(i,k)))) enddo + enddo - - return - end function beta_wright_eos_2d -!< End stand-alone functions -! ----------------------------------------------------------------------------- + return +end function beta_wright_eos_2d #endif !> Layer model routine for remapping tracers - function tracer_z_init(tr_in,z_edges,e,nkml,nkbl,land_fill,wet,nlay,nlevs,debug,i_debug,j_debug) result(tr) - real, dimension(:,:,:), intent(in) :: tr_in !< The z-space array of tracer concentrations that is read in. - real, dimension(size(tr_in,3)+1), intent(in) :: z_edges !< The depths of the cell edges in the input z* data (m) - integer, intent(in) :: nlay !< The number of vertical layers in the target grid - real, dimension(size(tr_in,1),size(tr_in,2),nlay+1), intent(in) :: e !< The depths of the target layer interfaces (m) - integer, intent(in) :: nkml !< The number of mixed layers - integer, intent(in) :: nkbl !< The number of buffer layers - real, intent(in) :: land_fill !< fill in data over land (1) - real, dimension(size(tr_in,1),size(tr_in,2)), intent(in) :: wet !< The wet mask for the source data (valid points) - real, dimension(size(tr_in,1),size(tr_in,2)), optional, intent(in) ::nlevs !< The number of input levels with valid data - logical, optional, intent(in) :: debug !< optional debug flag - integer, optional, intent(in) :: i_debug !< i-index of point for debugging - integer, optional, intent(in) :: j_debug !< j-index of point for debugging - real, dimension(size(tr_in,1),size(tr_in,2),nlay) :: tr !< tracers in layer space - - real, dimension(size(tr_in,3)) :: tr_1d !< a copy of the input tracer concentrations in a column. - real, dimension(nlay+1) :: e_1d - real, dimension(nlay) :: tr_ - integer, dimension(size(tr_in,1),size(tr_in,2)) :: nlevs_data !< number of valid levels in the input dataset - - integer :: n,i,j,k,l,nx,ny,nz,nt,kz - integer :: k_top,k_bot,k_bot_prev,kk,kstart - real :: sl_tr - real, dimension(size(tr_in,3)) :: wt !< The fractional weight for each layer in the range between z1 and z2 - real, dimension(size(tr_in,3)) :: z1,z2 !< z1 and z2 are the depths of the top and bottom limits of the part - ! of a z-cell that contributes to a layer, relative to the cell - ! center and normalized by the cell thickness, nondim. - ! Note that -1/2 <= z1 <= z2 <= 1/2. - - logical :: debug_msg, debug_ - - nx = size(tr_in,1); ny=size(tr_in,2); nz = size(tr_in,3) - - nlevs_data = size(tr_in,3) - if (PRESENT(nlevs)) then - nlevs_data = anint(nlevs) - endif - - debug_=.false. - if (PRESENT(debug)) then - debug_=debug - endif - - debug_msg = .false. - if (debug_) then - debug_msg=.true. - endif - - - do j=1,ny - i_loop: do i=1,nx - if (nlevs_data(i,j) == 0 .or. wet(i,j) == 0.) then - tr(i,j,:) = land_fill - cycle i_loop - endif - - do k=1,nz - tr_1d(k) = tr_in(i,j,k) - enddo - - do k=1,nlay+1 - e_1d(k) = e(i,j,k) - enddo - k_bot = 1 ; k_bot_prev = -1 - do k=1,nlay - if (e_1d(k+1) > z_edges(1)) then - tr(i,j,k) = tr_1d(1) - elseif (e_1d(k) < z_edges(nlevs_data(i,j)+1)) then - if (debug_msg) then - print *,'*** WARNING : Found interface below valid range of z data ' - print *,'(i,j,z_bottom,interface)= ',& - i,j,z_edges(nlevs_data(i,j)+1),e_1d(k) - print *,'z_edges= ',z_edges - print *,'e=',e_1d - print *,'*** I will extrapolate below using the bottom-most valid values' - debug_msg = .false. - endif - tr(i,j,k) = tr_1d(nlevs_data(i,j)) - - else - kstart=k_bot - call find_overlap(z_edges, e_1d(k), e_1d(k+1), nlevs_data(i,j), & - kstart, k_top, k_bot, wt, z1, z2) - - if (debug_) then - if (PRESENT(i_debug)) then - if (i == i_debug.and.j == j_debug) then - print *,'0001 k,k_top,k_bot,sum(wt),sum(z2-z1) = ',k,k_top,k_bot,sum(wt),sum(z2-z1) - endif - endif - endif - kz = k_top - sl_tr=0.0; ! cur_tr=0.0 - if (kz /= k_bot_prev) then - ! Calculate the intra-cell profile. - if ((kz < nlevs_data(i,j)) .and. (kz > 1)) then - sl_tr = find_limited_slope(tr_1d, z_edges, kz) - endif - endif - if (kz > nlevs_data(i,j)) kz = nlevs_data(i,j) - ! This is the piecewise linear form. - tr(i,j,k) = wt(kz) * & - (tr_1d(kz) + 0.5*sl_tr*(z2(kz) + z1(kz))) - ! For the piecewise parabolic form add the following... - ! + C1_3*cur_tr*(z2(kz)**2 + z2(kz)*z1(kz) + z1(kz)**2)) - ! if (debug_) then - ! print *,'k,k_top,k_bot= ',k,k_top,k_bot - ! endif - if (debug_) then - if (PRESENT(i_debug)) then - if (i == i_debug.and.j == j_debug) then - print *,'0002 k,k_top,k_bot,k_bot_prev,sl_tr = ',k,k_top,k_bot,k_bot_prev,sl_tr - endif - endif - endif - - do kz=k_top+1,k_bot-1 - tr(i,j,k) = tr(i,j,k) + wt(kz)*tr_1d(kz) - enddo - - if (debug_) then - if (PRESENT(i_debug)) then - if (i == i_debug.and.j == j_debug) then - print *,'0003 k,tr = ',k,tr(i,j,k) - endif - endif - endif - - if (k_bot > k_top) then - kz = k_bot - ! Calculate the intra-cell profile. - sl_tr = 0.0 ! ; cur_tr = 0.0 - if ((kz < nlevs_data(i,j)) .and. (kz > 1)) then - sl_tr = find_limited_slope(tr_1d, z_edges, kz) - ! if (debug_) then - ! print *,'002 sl_tr,k,kz,nlevs= ',sl_tr,k,kz,nlevs_data(i,j),nlevs(i,j) - ! endif - endif - ! This is the piecewise linear form. - tr(i,j,k) = tr(i,j,k) + wt(kz) * & - (tr_1d(kz) + 0.5*sl_tr*(z2(kz) + z1(kz))) - ! For the piecewise parabolic form add the following... - ! + C1_3*cur_tr*(z2(kz)**2 + z2(kz)*z1(kz) + z1(kz)**2)) - - if (debug_) then - if (PRESENT(i_debug)) then - if (i == i_debug.and.j == j_debug) then - print *,'0004 k,kz,nlevs,sl_tr,tr = ',k,kz,nlevs_data(i,j),sl_tr,tr(i,j,k) - print *,'0005 k,kz,tr(kz),tr(kz-1),tr(kz+1) = ',k,kz,tr_1d(kz),tr_1d(kz-1),tr_1d(kz+1),z_edges(kz+2) - endif - endif - endif - - endif - k_bot_prev = k_bot - - endif - enddo ! k-loop +function tracer_z_init(tr_in,z_edges,e,nkml,nkbl,land_fill,wet,nlay,nlevs,debug,i_debug,j_debug) result(tr) + real, dimension(:,:,:), intent(in) :: tr_in !< The z-space array of tracer concentrations that is read in. + real, dimension(size(tr_in,3)+1), intent(in) :: z_edges !< The depths of the cell edges in the input z* data (m) + integer, intent(in) :: nlay !< The number of vertical layers in the target grid + real, dimension(size(tr_in,1),size(tr_in,2),nlay+1), intent(in) :: e !< The depths of the target layer interfaces (m) + integer, intent(in) :: nkml !< The number of mixed layers + integer, intent(in) :: nkbl !< The number of buffer layers + real, intent(in) :: land_fill !< fill in data over land (1) + real, dimension(size(tr_in,1),size(tr_in,2)), intent(in) :: wet !< The wet mask for the source data (valid points) + real, dimension(size(tr_in,1),size(tr_in,2)), optional, intent(in) ::nlevs !< The number of input levels with valid data + logical, optional, intent(in) :: debug !< optional debug flag + integer, optional, intent(in) :: i_debug !< i-index of point for debugging + integer, optional, intent(in) :: j_debug !< j-index of point for debugging + real, dimension(size(tr_in,1),size(tr_in,2),nlay) :: tr !< tracers in layer space + ! Local variables + real, dimension(size(tr_in,3)) :: tr_1d !< a copy of the input tracer concentrations in a column. + real, dimension(nlay+1) :: e_1d + real, dimension(nlay) :: tr_ + integer, dimension(size(tr_in,1),size(tr_in,2)) :: nlevs_data !< number of valid levels in the input dataset + integer :: n,i,j,k,l,nx,ny,nz,nt,kz + integer :: k_top,k_bot,k_bot_prev,kk,kstart + real :: sl_tr + real, dimension(size(tr_in,3)) :: wt !< The fractional weight for each layer in the range between z1 and z2 + real, dimension(size(tr_in,3)) :: z1,z2 !< z1 and z2 are the depths of the top and bottom limits of the part + ! of a z-cell that contributes to a layer, relative to the cell + ! center and normalized by the cell thickness, nondim. + ! Note that -1/2 <= z1 <= z2 <= 1/2. + + logical :: debug_msg, debug_ + + nx = size(tr_in,1); ny=size(tr_in,2); nz = size(tr_in,3) + + nlevs_data = size(tr_in,3) + if (PRESENT(nlevs)) then + nlevs_data = anint(nlevs) + endif + + debug_=.false. + if (PRESENT(debug)) then + debug_=debug + endif + + debug_msg = .false. + if (debug_) then + debug_msg=.true. + endif + + do j=1,ny + i_loop: do i=1,nx + if (nlevs_data(i,j) == 0 .or. wet(i,j) == 0.) then + tr(i,j,:) = land_fill + cycle i_loop + endif - do k=2,nlay ! simply fill vanished layers with adjacent value - if (e_1d(k)-e_1d(k+1) <= epsln) tr(i,j,k)=tr(i,j,k-1) - enddo + do k=1,nz + tr_1d(k) = tr_in(i,j,k) + enddo - enddo i_loop - enddo + do k=1,nlay+1 + e_1d(k) = e(i,j,k) + enddo + k_bot = 1 ; k_bot_prev = -1 + do k=1,nlay + if (e_1d(k+1) > z_edges(1)) then + tr(i,j,k) = tr_1d(1) + elseif (e_1d(k) < z_edges(nlevs_data(i,j)+1)) then + if (debug_msg) then + print *,'*** WARNING : Found interface below valid range of z data ' + print *,'(i,j,z_bottom,interface)= ',& + i,j,z_edges(nlevs_data(i,j)+1),e_1d(k) + print *,'z_edges= ',z_edges + print *,'e=',e_1d + print *,'*** I will extrapolate below using the bottom-most valid values' + debug_msg = .false. + endif + tr(i,j,k) = tr_1d(nlevs_data(i,j)) + + else + kstart=k_bot + call find_overlap(z_edges, e_1d(k), e_1d(k+1), nlevs_data(i,j), & + kstart, k_top, k_bot, wt, z1, z2) + + if (debug_) then + if (PRESENT(i_debug)) then + if (i == i_debug.and.j == j_debug) then + print *,'0001 k,k_top,k_bot,sum(wt),sum(z2-z1) = ',k,k_top,k_bot,sum(wt),sum(z2-z1) + endif + endif + endif + kz = k_top + sl_tr=0.0; ! cur_tr=0.0 + if (kz /= k_bot_prev) then + ! Calculate the intra-cell profile. + if ((kz < nlevs_data(i,j)) .and. (kz > 1)) then + sl_tr = find_limited_slope(tr_1d, z_edges, kz) + endif + endif + if (kz > nlevs_data(i,j)) kz = nlevs_data(i,j) + ! This is the piecewise linear form. + tr(i,j,k) = wt(kz) * & + (tr_1d(kz) + 0.5*sl_tr*(z2(kz) + z1(kz))) + ! For the piecewise parabolic form add the following... + ! + C1_3*cur_tr*(z2(kz)**2 + z2(kz)*z1(kz) + z1(kz)**2)) + ! if (debug_) then + ! print *,'k,k_top,k_bot= ',k,k_top,k_bot + ! endif + if (debug_) then + if (PRESENT(i_debug)) then + if (i == i_debug.and.j == j_debug) then + print *,'0002 k,k_top,k_bot,k_bot_prev,sl_tr = ',k,k_top,k_bot,k_bot_prev,sl_tr + endif + endif + endif - return + do kz=k_top+1,k_bot-1 + tr(i,j,k) = tr(i,j,k) + wt(kz)*tr_1d(kz) + enddo - end function tracer_z_init + if (debug_) then + if (PRESENT(i_debug)) then + if (i == i_debug.and.j == j_debug) then + print *,'0003 k,tr = ',k,tr(i,j,k) + endif + endif + endif -!> Return the index where to insert item x in list a, assuming a is sorted. -!> The return values [i] is such that all e in a[:i-1] have e <= x, and all e in -!> a[i:] have e > x. So if x already appears in the list, will -!> insert just after the rightmost x already there. -!> Optional args lo (default 1) and hi (default len(a)) bound the -!> slice of a to be searched. - function bisect_fast(a, x, lo, hi) result(bi_r) - real, dimension(:,:), intent(in) :: a !< Sorted list - real, dimension(:), intent(in) :: x !< Item to be inserted - integer, dimension(size(a,1)), optional, intent(in) :: lo !< Lower bracket of optional range to search - integer, dimension(size(a,1)), optional, intent(in) :: hi !< Upper bracket of optional range to search - integer, dimension(size(a,1),size(x,1)) :: bi_r + if (k_bot > k_top) then + kz = k_bot + ! Calculate the intra-cell profile. + sl_tr = 0.0 ! ; cur_tr = 0.0 + if ((kz < nlevs_data(i,j)) .and. (kz > 1)) then + sl_tr = find_limited_slope(tr_1d, z_edges, kz) + ! if (debug_) then + ! print *,'002 sl_tr,k,kz,nlevs= ',sl_tr,k,kz,nlevs_data(i,j),nlevs(i,j) + ! endif + endif + ! This is the piecewise linear form. + tr(i,j,k) = tr(i,j,k) + wt(kz) * & + (tr_1d(kz) + 0.5*sl_tr*(z2(kz) + z1(kz))) + ! For the piecewise parabolic form add the following... + ! + C1_3*cur_tr*(z2(kz)**2 + z2(kz)*z1(kz) + z1(kz)**2)) + + if (debug_) then + if (PRESENT(i_debug)) then + if (i == i_debug.and.j == j_debug) then + print *,'0004 k,kz,nlevs,sl_tr,tr = ',k,kz,nlevs_data(i,j),sl_tr,tr(i,j,k) + print *,'0005 k,kz,tr(kz),tr(kz-1),tr(kz+1) = ',k,kz,tr_1d(kz),tr_1d(kz-1),tr_1d(kz+1),z_edges(kz+2) + endif + endif + endif - integer :: mid,num_x,num_a,i - integer, dimension(size(a,1)) :: lo_,hi_,lo0,hi0 - integer :: nprofs,j + endif + k_bot_prev = k_bot - lo_=1;hi_=size(a,2);num_x=size(x,1);bi_r=-1;nprofs=size(a,1) + endif + enddo ! k-loop - if (PRESENT(lo)) then - where (lo>0) lo_=lo - endif - if (PRESENT(hi)) then - where (hi>0) hi_=hi - endif + do k=2,nlay ! simply fill vanished layers with adjacent value + if (e_1d(k)-e_1d(k+1) <= epsln) tr(i,j,k)=tr(i,j,k-1) + enddo - lo0=lo_;hi0=hi_ - - do j=1,nprofs - do i=1,num_x - lo_=lo0;hi_=hi0 - do while (lo_(j) < hi_(j)) - mid = (lo_(j)+hi_(j))/2 - if (x(i) < a(j,mid)) then - hi_(j) = mid - else - lo_(j) = mid+1 - endif - enddo - bi_r(j,i)=lo_(j) + enddo i_loop + enddo + + return + +end function tracer_z_init + +!> Return the index where to insert item x in list a, assuming a is sorted. +!! The return values [i] is such that all e in a[:i-1] have e <= x, and all e in +!! a[i:] have e > x. So if x already appears in the list, will +!! insert just after the rightmost x already there. +!! Optional args lo (default 1) and hi (default len(a)) bound the +!! slice of a to be searched. +function bisect_fast(a, x, lo, hi) result(bi_r) + real, dimension(:,:), intent(in) :: a !< Sorted list + real, dimension(:), intent(in) :: x !< Item to be inserted + integer, dimension(size(a,1)), optional, intent(in) :: lo !< Lower bracket of optional range to search + integer, dimension(size(a,1)), optional, intent(in) :: hi !< Upper bracket of optional range to search + integer, dimension(size(a,1),size(x,1)) :: bi_r + + integer :: mid,num_x,num_a,i + integer, dimension(size(a,1)) :: lo_,hi_,lo0,hi0 + integer :: nprofs,j + + lo_=1;hi_=size(a,2);num_x=size(x,1);bi_r=-1;nprofs=size(a,1) + + if (PRESENT(lo)) then + where (lo>0) lo_=lo + endif + if (PRESENT(hi)) then + where (hi>0) hi_=hi + endif + + lo0=lo_;hi0=hi_ + + do j=1,nprofs + do i=1,num_x + lo_=lo0;hi_=hi0 + do while (lo_(j) < hi_(j)) + mid = (lo_(j)+hi_(j))/2 + if (x(i) < a(j,mid)) then + hi_(j) = mid + else + lo_(j) = mid+1 + endif enddo + bi_r(j,i)=lo_(j) enddo + enddo - return - - end function bisect_fast + return +end function bisect_fast #ifdef PY_SOLO -!> Only for stand-alone python -!> This subroutine determines the potential temperature and -!> salinity that is consistent with the target density -!> using provided initial guess - subroutine determine_temperature(temp,salt,R,p_ref,niter,land_fill,h,k_start) - real(kind=8), dimension(:,:,:), intent(inout) :: temp !< potential temperature (degC) - real(kind=8), dimension(:,:,:), intent(inout) :: salt !< salinity (PSU) - real(kind=8), dimension(size(temp,3)), intent(in) :: R !< desired potential density, in kg m-3. - real, intent(in) :: p_ref !< reference pressure, in Pa. - integer, intent(in) :: niter !< maximum number of iterations - integer, intent(in) :: k_start !< starting index (i.e. below the buffer layer) - real, intent(in) :: land_fill !< land fill value - real(kind=8), dimension(:,:,:), intent(in) :: h !< layer thickness . Do not iterate for massless layers - - real(kind=8), dimension(size(temp,1),size(temp,3)) :: T,S,dT,dS,rho,hin - real(kind=8), dimension(size(temp,1),size(temp,3)) :: drho_dT,drho_dS - real(kind=8), dimension(size(temp,1)) :: press - - integer :: nx,ny,nz,nt,i,j,k,n,itt - logical :: adjust_salt , old_fit - real :: dT_dS - real, parameter :: T_max = 35.0, T_min = -2.0 - real, parameter :: S_min = 0.5, S_max=65.0 - real, parameter :: tol=1.e-4, max_t_adj=1.0, max_s_adj = 0.5 +! Only for stand-alone python +!> This subroutine determines the potential temperature and +!! salinity that is consistent with the target density +!! using provided initial guess +subroutine determine_temperature(temp,salt,R,p_ref,niter,land_fill,h,k_start) + real(kind=8), dimension(:,:,:), intent(inout) :: temp !< potential temperature (degC) + real(kind=8), dimension(:,:,:), intent(inout) :: salt !< salinity (PSU) + real(kind=8), dimension(size(temp,3)), intent(in) :: R !< desired potential density, in kg m-3. + real, intent(in) :: p_ref !< reference pressure, in Pa. + integer, intent(in) :: niter !< maximum number of iterations + integer, intent(in) :: k_start !< starting index (i.e. below the buffer layer) + real, intent(in) :: land_fill !< land fill value + real(kind=8), dimension(:,:,:), intent(in) :: h !< layer thickness . Do not iterate for massless layers + ! Local variables + real(kind=8), dimension(size(temp,1),size(temp,3)) :: T,S,dT,dS,rho,hin + real(kind=8), dimension(size(temp,1),size(temp,3)) :: drho_dT,drho_dS + real(kind=8), dimension(size(temp,1)) :: press + integer :: nx,ny,nz,nt,i,j,k,n,itt + logical :: adjust_salt , old_fit + real :: dT_dS + real, parameter :: T_max = 35.0, T_min = -2.0 + real, parameter :: S_min = 0.5, S_max=65.0 + real, parameter :: tol=1.e-4, max_t_adj=1.0, max_s_adj = 0.5 #else !> This subroutine determines the potential temperature and -!> salinity that is consistent with the target density -!> using provided initial guess - subroutine determine_temperature(temp,salt,R,p_ref,niter,land_fill,h,k_start,eos) - real, dimension(:,:,:), intent(inout) :: temp !< potential temperature (degC) - real, dimension(:,:,:), intent(inout) :: salt !< salinity (PSU) - real, dimension(size(temp,3)), intent(in) :: R !< desired potential density, in kg m-3. - real, intent(in) :: p_ref !< reference pressure, in Pa. - integer, intent(in) :: niter !< maximum number of iterations - integer, intent(in) :: k_start !< starting index (i.e. below the buffer layer) - real, intent(in) :: land_fill !< land fill value - real, dimension(:,:,:), intent(in) :: h !< layer thickness . Do not iterate for massless layers - type(eos_type), pointer :: eos !< seawater equation of state control structure - - real(kind=8), dimension(size(temp,1),size(temp,3)) :: T,S,dT,dS,rho,hin - real(kind=8), dimension(size(temp,1),size(temp,3)) :: drho_dT,drho_dS - real(kind=8), dimension(size(temp,1)) :: press - - integer :: nx,ny,nz,nt,i,j,k,n,itt - real :: dT_dS - logical :: adjust_salt , old_fit - real, parameter :: T_max = 31.0, T_min = -2.0 - real, parameter :: S_min = 0.5, S_max=65.0 - real, parameter :: tol=1.e-4, max_t_adj=1.0, max_s_adj = 0.5 - - +!! salinity that is consistent with the target density +!! using provided initial guess +subroutine determine_temperature(temp,salt,R,p_ref,niter,land_fill,h,k_start,eos) + real, dimension(:,:,:), intent(inout) :: temp !< potential temperature (degC) + real, dimension(:,:,:), intent(inout) :: salt !< salinity (PSU) + real, dimension(size(temp,3)), intent(in) :: R !< desired potential density, in kg m-3. + real, intent(in) :: p_ref !< reference pressure, in Pa. + integer, intent(in) :: niter !< maximum number of iterations + integer, intent(in) :: k_start !< starting index (i.e. below the buffer layer) + real, intent(in) :: land_fill !< land fill value + real, dimension(:,:,:), intent(in) :: h !< layer thickness . Do not iterate for massless layers + type(eos_type), pointer :: eos !< seawater equation of state control structure + ! Local variables + real(kind=8), dimension(size(temp,1),size(temp,3)) :: T,S,dT,dS,rho,hin + real(kind=8), dimension(size(temp,1),size(temp,3)) :: drho_dT,drho_dS + real(kind=8), dimension(size(temp,1)) :: press + integer :: nx,ny,nz,nt,i,j,k,n,itt + real :: dT_dS + logical :: adjust_salt , old_fit + real, parameter :: T_max = 31.0, T_min = -2.0 + real, parameter :: S_min = 0.5, S_max=65.0 + real, parameter :: tol=1.e-4, max_t_adj=1.0, max_s_adj = 0.5 #endif + old_fit = .true. ! reproduces siena behavior + ! will switch to the newer + ! method which simultaneously adjusts + ! temp and salt based on the ratio + ! of the thermal and haline coefficients. - old_fit = .true. ! reproduces siena behavior - ! will switch to the newer - ! method which simultaneously adjusts - ! temp and salt based on the ratio - ! of the thermal and haline coefficients. - - nx=size(temp,1);ny=size(temp,2); nz=size(temp,3) + nx=size(temp,1);ny=size(temp,2); nz=size(temp,3) - press(:) = p_ref + press(:) = p_ref - do j=1,ny - dS(:,:) = 0. ! Needs to be zero everywhere since there is a maxval(abs(dS)) later... - T=temp(:,j,:) - S=salt(:,j,:) - hin=h(:,j,:) - dT=0.0 - adjust_salt = .true. - iter_loop: do itt = 1,niter + do j=1,ny + dS(:,:) = 0. ! Needs to be zero everywhere since there is a maxval(abs(dS)) later... + T=temp(:,j,:) + S=salt(:,j,:) + hin=h(:,j,:) + dT=0.0 + adjust_salt = .true. + iter_loop: do itt = 1,niter #ifdef PY_SOLO - rho=wright_eos_2d(T,S,p_ref) - drho_dT=alpha_wright_eos_2d(T,S,p_ref) + rho=wright_eos_2d(T,S,p_ref) + drho_dT=alpha_wright_eos_2d(T,S,p_ref) #else - do k=1, nz - call calculate_density(T(:,k),S(:,k),press,rho(:,k),1,nx,eos) - call calculate_density_derivs(T(:,k),S(:,k),press,drho_dT(:,k),drho_dS(:,k),1,nx,eos) - enddo + do k=1, nz + call calculate_density(T(:,k),S(:,k),press,rho(:,k),1,nx,eos) + call calculate_density_derivs(T(:,k),S(:,k),press,drho_dT(:,k),drho_dS(:,k),1,nx,eos) + enddo #endif - do k=k_start,nz - do i=1,nx - - ! if (abs(rho(i,k)-R(k))>tol .and. hin(i,k)>epsln .and. abs(T(i,k)-land_fill) < epsln) then - if (abs(rho(i,k)-R(k))>tol) then - if (old_fit) then - dT(i,k)=(R(k)-rho(i,k))/drho_dT(i,k) - if (dT(i,k)>max_t_adj) dT(i,k)=max_t_adj - if (dT(i,k)<-1.0*max_t_adj) dT(i,k)=-1.0*max_t_adj - T(i,k)=max(min(T(i,k)+dT(i,k),T_max),T_min) - else - dT_dS = 10.0 - min(-drho_dT(i,k)/drho_dS(i,k),10.) - dS(i,k) = (R(k)-rho(i,k))/(drho_dS(i,k) - drho_dT(i,k)*dT_dS ) - dT(i,k)= -dT_dS*dS(i,k) - ! if (dT(i,k)>max_t_adj) dT(i,k)=max_t_adj - ! if (dT(i,k)<-1.0*max_t_adj) dT(i,k)=-1.0*max_t_adj - T(i,k)=max(min(T(i,k)+dT(i,k),T_max),T_min) - S(i,k)=max(min(S(i,k)+dS(i,k),S_max),S_min) - endif - endif - enddo + do k=k_start,nz + do i=1,nx + +! if (abs(rho(i,k)-R(k))>tol .and. hin(i,k)>epsln .and. abs(T(i,k)-land_fill) < epsln) then + if (abs(rho(i,k)-R(k))>tol) then + if (old_fit) then + dT(i,k)=(R(k)-rho(i,k))/drho_dT(i,k) + if (dT(i,k)>max_t_adj) dT(i,k)=max_t_adj + if (dT(i,k)<-1.0*max_t_adj) dT(i,k)=-1.0*max_t_adj + T(i,k)=max(min(T(i,k)+dT(i,k),T_max),T_min) + else + dT_dS = 10.0 - min(-drho_dT(i,k)/drho_dS(i,k),10.) + dS(i,k) = (R(k)-rho(i,k))/(drho_dS(i,k) - drho_dT(i,k)*dT_dS ) + dT(i,k)= -dT_dS*dS(i,k) +! if (dT(i,k)>max_t_adj) dT(i,k)=max_t_adj +! if (dT(i,k)<-1.0*max_t_adj) dT(i,k)=-1.0*max_t_adj + T(i,k)=max(min(T(i,k)+dT(i,k),T_max),T_min) + S(i,k)=max(min(S(i,k)+dS(i,k),S_max),S_min) + endif + endif enddo - if (maxval(abs(dT)) < tol) then - adjust_salt = .false. - exit iter_loop - endif - enddo iter_loop + enddo + if (maxval(abs(dT)) < tol) then + adjust_salt = .false. + exit iter_loop + endif + enddo iter_loop - if (adjust_salt .and. old_fit) then - iter_loop2: do itt = 1,niter + if (adjust_salt .and. old_fit) then + iter_loop2: do itt = 1,niter #ifdef PY_SOLO - rho=wright_eos_2d(T,S,p_ref) - drho_dS=beta_wright_eos_2d(T,S,p_ref) + rho=wright_eos_2d(T,S,p_ref) + drho_dS=beta_wright_eos_2d(T,S,p_ref) #else - do k=1, nz - call calculate_density(T(:,k),S(:,k),press,rho(:,k),1,nx,eos) - call calculate_density_derivs(T(:,k),S(:,k),press,drho_dT(:,k),drho_dS(:,k),1,nx,eos) - enddo + do k=1, nz + call calculate_density(T(:,k),S(:,k),press,rho(:,k),1,nx,eos) + call calculate_density_derivs(T(:,k),S(:,k),press,drho_dT(:,k),drho_dS(:,k),1,nx,eos) + enddo #endif - do k=k_start,nz - do i=1,nx - ! if (abs(rho(i,k)-R(k))>tol .and. hin(i,k)>epsln .and. abs(T(i,k)-land_fill) < epsln ) then - if (abs(rho(i,k)-R(k))>tol ) then - dS(i,k)=(R(k)-rho(i,k))/drho_dS(i,k) - if (dS(i,k)>max_s_adj) dS(i,k)=max_s_adj - if (dS(i,k)<-1.0*max_s_adj) dS(i,k)=-1.0*max_s_adj - S(i,k)=max(min(S(i,k)+dS(i,k),S_max),S_min) - endif - enddo + do k=k_start,nz + do i=1,nx +! if (abs(rho(i,k)-R(k))>tol .and. hin(i,k)>epsln .and. abs(T(i,k)-land_fill) < epsln ) then + if (abs(rho(i,k)-R(k))>tol ) then + dS(i,k)=(R(k)-rho(i,k))/drho_dS(i,k) + if (dS(i,k)>max_s_adj) dS(i,k)=max_s_adj + if (dS(i,k)<-1.0*max_s_adj) dS(i,k)=-1.0*max_s_adj + S(i,k)=max(min(S(i,k)+dS(i,k),S_max),S_min) + endif enddo - if (maxval(abs(dS)) < tol) then - exit iter_loop2 - endif - enddo iter_loop2 - endif - - temp(:,j,:)=T(:,:) - salt(:,j,:)=S(:,:) - enddo + enddo + if (maxval(abs(dS)) < tol) then + exit iter_loop2 + endif + enddo iter_loop2 + endif + temp(:,j,:)=T(:,:) + salt(:,j,:)=S(:,:) + enddo - return + return - end subroutine determine_temperature +end subroutine determine_temperature !> This subroutine determines the layers bounded by interfaces e that overlap -!> with the depth range between Z_top and Z_bot, and also the fractional weights -!> of each layer. It also calculates the normalized relative depths of the range -!> of each layer that overlaps that depth range. -!> Note that by convention, e decreases with increasing k and Z_top > Z_bot. - subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z2) - real, dimension(:), intent(in) :: e !< the interface positions, in m. - real, intent(in) :: Z_top !< The top of the range being mapped to, in m. - real, intent(in) :: Z_bot !< The bottom of the range being mapped to, in m. - integer, intent(in) :: k_max !< The number of valid layers. - integer, intent(in) :: k_start !< The layer at which to start searching. - integer, intent(out) :: k_top !< The index of the top layer that overlap with the depth range. - integer, intent(out) :: k_bot !< The index of the bottom layer that overlap with the depth range. - real, dimension(:), intent(out) :: wt !< The relative weights of each layer from k_top to k_bot. - real, dimension(:), intent(out) :: z1 !< Depth of the top limit of layer that contributes to a level - real, dimension(:), intent(out) :: z2 !< Depth of the bottom limit of layer that contributes to a level - - real :: Ih, e_c, tot_wt, I_totwt - integer :: k - - wt(:)=0.0; z1(:)=0.0; z2(:)=0.0 - k_top = k_start; k_bot= k_start; wt(1) = 1.0; z1(1)=-0.5; z2(1) = 0.5 - - do k=k_start,k_max ;if (e(k+1)k_max) return - - ! Determine the fractional weights of each layer. - ! Note that by convention, e and Z_int decrease with increasing k. - if (e(k+1)<=Z_bot) then - wt(k) = 1.0 ; k_bot = k - Ih = 1.0 / (e(k)-e(k+1)) - e_c = 0.5*(e(k)+e(k+1)) - z1(k) = (e_c - MIN(e(k),Z_top)) * Ih - z2(k) = (e_c - Z_bot) * Ih - else - wt(k) = MIN(e(k),Z_top) - e(k+1) ; tot_wt = wt(k) ! These are always > 0. - z1(k) = (0.5*(e(k)+e(k+1)) - MIN(e(k),Z_top)) / (e(k)-e(k+1)) - z2(k) = 0.5 - k_bot = k_max - do k=k_top+1,k_max - if (e(k+1)<=Z_bot) then - k_bot = k - wt(k) = e(k) - Z_bot ; z1(k) = -0.5 - z2(k) = (0.5*(e(k)+e(k+1)) - Z_bot) / (e(k)-e(k+1)) - else - wt(k) = e(k) - e(k+1) ; z1(k) = -0.5 ; z2(k) = 0.5 - endif - tot_wt = tot_wt + wt(k) ! wt(k) is always > 0. - if (k>=k_bot) exit - enddo +!! with the depth range between Z_top and Z_bot, and also the fractional weights +!! of each layer. It also calculates the normalized relative depths of the range +!! of each layer that overlaps that depth range. +!! Note that by convention, e decreases with increasing k and Z_top > Z_bot. +subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z2) + real, dimension(:), intent(in) :: e !< the interface positions, in m. + real, intent(in) :: Z_top !< The top of the range being mapped to, in m. + real, intent(in) :: Z_bot !< The bottom of the range being mapped to, in m. + integer, intent(in) :: k_max !< The number of valid layers. + integer, intent(in) :: k_start !< The layer at which to start searching. + integer, intent(out) :: k_top !< The index of the top layer that overlap with the depth range. + integer, intent(out) :: k_bot !< The index of the bottom layer that overlap with the depth range. + real, dimension(:), intent(out) :: wt !< The relative weights of each layer from k_top to k_bot. + real, dimension(:), intent(out) :: z1 !< Depth of the top limit of layer that contributes to a level + real, dimension(:), intent(out) :: z2 !< Depth of the bottom limit of layer that contributes to a level + ! Local variables + real :: Ih, e_c, tot_wt, I_totwt + integer :: k + + wt(:)=0.0; z1(:)=0.0; z2(:)=0.0 + k_top = k_start; k_bot= k_start; wt(1) = 1.0; z1(1)=-0.5; z2(1) = 0.5 + + do k=k_start,k_max ;if (e(k+1)k_max) return + + ! Determine the fractional weights of each layer. + ! Note that by convention, e and Z_int decrease with increasing k. + if (e(k+1)<=Z_bot) then + wt(k) = 1.0 ; k_bot = k + Ih = 1.0 / (e(k)-e(k+1)) + e_c = 0.5*(e(k)+e(k+1)) + z1(k) = (e_c - MIN(e(k),Z_top)) * Ih + z2(k) = (e_c - Z_bot) * Ih + else + wt(k) = MIN(e(k),Z_top) - e(k+1) ; tot_wt = wt(k) ! These are always > 0. + z1(k) = (0.5*(e(k)+e(k+1)) - MIN(e(k),Z_top)) / (e(k)-e(k+1)) + z2(k) = 0.5 + k_bot = k_max + do k=k_top+1,k_max + if (e(k+1)<=Z_bot) then + k_bot = k + wt(k) = e(k) - Z_bot ; z1(k) = -0.5 + z2(k) = (0.5*(e(k)+e(k+1)) - Z_bot) / (e(k)-e(k+1)) + else + wt(k) = e(k) - e(k+1) ; z1(k) = -0.5 ; z2(k) = 0.5 + endif + tot_wt = tot_wt + wt(k) ! wt(k) is always > 0. + if (k>=k_bot) exit + enddo - I_totwt = 1.0 / tot_wt - do k=k_top,k_bot ; wt(k) = I_totwt*wt(k) ; enddo - endif + I_totwt = 1.0 / tot_wt + do k=k_top,k_bot ; wt(k) = I_totwt*wt(k) ; enddo + endif - return + return - end subroutine find_overlap +end subroutine find_overlap !> This subroutine determines a limited slope for val to be advected with !! a piecewise limited scheme. - function find_limited_slope(val, e, k) result(slope) - real, dimension(:), intent(in) :: val !< An column the values that are being interpolated. - real, dimension(:), intent(in) :: e !< A column's interface heights, in m. - integer, intent(in) :: k !< The layer whose slope is being determined. - real :: slope !< The normalized slope in the intracell distribution of val. - real :: amx,bmx,amn,bmn,cmn,dmn - - real :: d1, d2 - - if ((val(k)-val(k-1)) * (val(k)-val(k+1)) >= 0.0) then - slope = 0.0 ! ; curvature = 0.0 - else - d1 = 0.5*(e(k-1)-e(k+1)) ; d2 = 0.5*(e(k)-e(k+2)) - slope = ((d1**2)*(val(k+1) - val(k)) + (d2**2)*(val(k) - val(k-1))) * & - (e(k) - e(k+1)) / (d1*d2*(d1+d2)) - ! slope = 0.5*(val(k+1) - val(k-1)) - ! This is S.J. Lin's form of the PLM limiter. - amx=max(val(k-1),val(k)) - bmx = max(amx,val(k+1)) - amn = min(abs(slope),2.0*(bmx-val(k))) - bmn = min(val(k-1),val(k)) - cmn = 2.0*(val(k)-min(bmn,val(k+1))) - dmn = min(amn,cmn) - slope = sign(1.0,slope) * dmn - - ! min(abs(slope), & - ! 2.0*(max(val(k-1),val(k),val(k+1)) - val(k)), & - ! 2.0*(val(k) - min(val(k-1),val(k),val(k+1)))) - ! curvature = 0.0 - endif - - return - - end function find_limited_slope +function find_limited_slope(val, e, k) result(slope) + real, dimension(:), intent(in) :: val !< An column the values that are being interpolated. + real, dimension(:), intent(in) :: e !< A column's interface heights, in m. + integer, intent(in) :: k !< The layer whose slope is being determined. + real :: slope !< The normalized slope in the intracell distribution of val. + ! Local variables + real :: amx,bmx,amn,bmn,cmn,dmn + real :: d1, d2 + + if ((val(k)-val(k-1)) * (val(k)-val(k+1)) >= 0.0) then + slope = 0.0 ! ; curvature = 0.0 + else + d1 = 0.5*(e(k-1)-e(k+1)) ; d2 = 0.5*(e(k)-e(k+2)) + slope = ((d1**2)*(val(k+1) - val(k)) + (d2**2)*(val(k) - val(k-1))) * & + (e(k) - e(k+1)) / (d1*d2*(d1+d2)) + ! slope = 0.5*(val(k+1) - val(k-1)) + ! This is S.J. Lin's form of the PLM limiter. + amx=max(val(k-1),val(k)) + bmx = max(amx,val(k+1)) + amn = min(abs(slope),2.0*(bmx-val(k))) + bmn = min(val(k-1),val(k)) + cmn = 2.0*(val(k)-min(bmn,val(k+1))) + dmn = min(amn,cmn) + slope = sign(1.0,slope) * dmn + + ! min(abs(slope), & + ! 2.0*(max(val(k-1),val(k),val(k+1)) - val(k)), & + ! 2.0*(val(k) - min(val(k-1),val(k),val(k+1)))) + ! curvature = 0.0 + endif + + return + +end function find_limited_slope !> Find interface positions corresponding to density profile - function find_interfaces(rho,zin,Rb,depth,nlevs,nkml,nkbl,hml,debug) result(zi) - real, dimension(:,:,:), & - intent(in) :: rho !< potential density in z-space (kg m-3) - real, dimension(size(rho,3)), & - intent(in) :: zin !< levels (m) - real, dimension(:), intent(in) :: Rb !< target interface densities (kg m-3) - real, dimension(size(rho,1),size(rho,2)), & - intent(in) :: depth !< ocean depth (m) - real, dimension(size(rho,1),size(rho,2)), & - optional, intent(in) ::nlevs !< number of valid points in each column - logical, optional, intent(in) :: debug !< optional debug flag - integer, optional, intent(in) :: nkml !< number of mixed layer pieces - integer, optional, intent(in) :: nkbl !< number of buffer layer pieces - real, optional, intent(in) :: hml !< mixed layer depth - - real, dimension(size(rho,1),size(rho,2),size(Rb,1)) :: zi - real, dimension(size(rho,1),size(rho,3)) :: rho_ - real, dimension(size(rho,1)) :: depth_ - logical :: unstable - integer :: dir - integer, dimension(size(rho,1),size(Rb,1)) :: ki_ - real, dimension(size(rho,1),size(Rb,1)) :: zi_ - integer, dimension(size(rho,1),size(rho,2)) :: nlevs_data - integer, dimension(size(rho,1)) :: lo,hi - real :: slope,rsm,drhodz,hml_ - integer :: n,i,j,k,l,nx,ny,nz,nt - integer :: nlay,kk,nkml_,nkbl_ - logical :: debug_ = .false. - - real, parameter :: zoff=0.999 - - nlay=size(Rb)-1 - - zi(:,:,:) = 0.0 - - if (PRESENT(debug)) debug_=debug - - nx = size(rho,1); ny=size(rho,2); nz = size(rho,3) - nlevs_data(:,:) = size(rho,3) - - nkml_=0;nkbl_=0;hml_=0.0 - if (PRESENT(nkml)) nkml_=max(0,nkml) - if (PRESENT(nkbl)) nkbl_=max(0,nkbl) - if (PRESENT(hml)) hml_=hml - - if (PRESENT(nlevs)) then - nlevs_data(:,:) = nlevs(:,:) - endif - - do j=1,ny - rho_(:,:) = rho(:,j,:) - i_loop: do i=1,nx - if (debug_) then - print *,'looking for interfaces, i,j,nlevs= ',i,j,nlevs_data(i,j) - print *,'initial density profile= ', rho_(i,:) +function find_interfaces(rho,zin,Rb,depth,nlevs,nkml,nkbl,hml,debug) result(zi) + real, dimension(:,:,:), & + intent(in) :: rho !< potential density in z-space (kg m-3) + real, dimension(size(rho,3)), & + intent(in) :: zin !< levels (m) + real, dimension(:), intent(in) :: Rb !< target interface densities (kg m-3) + real, dimension(size(rho,1),size(rho,2)), & + intent(in) :: depth !< ocean depth (m) + real, dimension(size(rho,1),size(rho,2)), & + optional, intent(in) ::nlevs !< number of valid points in each column + logical, optional, intent(in) :: debug !< optional debug flag + integer, optional, intent(in) :: nkml !< number of mixed layer pieces + integer, optional, intent(in) :: nkbl !< number of buffer layer pieces + real, optional, intent(in) :: hml !< mixed layer depth + ! Local variables + real, dimension(size(rho,1),size(rho,2),size(Rb,1)) :: zi + real, dimension(size(rho,1),size(rho,3)) :: rho_ + real, dimension(size(rho,1)) :: depth_ + logical :: unstable + integer :: dir + integer, dimension(size(rho,1),size(Rb,1)) :: ki_ + real, dimension(size(rho,1),size(Rb,1)) :: zi_ + integer, dimension(size(rho,1),size(rho,2)) :: nlevs_data + integer, dimension(size(rho,1)) :: lo,hi + real :: slope,rsm,drhodz,hml_ + integer :: n,i,j,k,l,nx,ny,nz,nt + integer :: nlay,kk,nkml_,nkbl_ + logical :: debug_ = .false. + real, parameter :: zoff=0.999 + + nlay=size(Rb)-1 + + zi(:,:,:) = 0.0 + + if (PRESENT(debug)) debug_=debug + + nx = size(rho,1); ny=size(rho,2); nz = size(rho,3) + nlevs_data(:,:) = size(rho,3) + + nkml_=0;nkbl_=0;hml_=0.0 + if (PRESENT(nkml)) nkml_=max(0,nkml) + if (PRESENT(nkbl)) nkbl_=max(0,nkbl) + if (PRESENT(hml)) hml_=hml + + if (PRESENT(nlevs)) then + nlevs_data(:,:) = nlevs(:,:) + endif + + do j=1,ny + rho_(:,:) = rho(:,j,:) + i_loop: do i=1,nx + if (debug_) then + print *,'looking for interfaces, i,j,nlevs= ',i,j,nlevs_data(i,j) + print *,'initial density profile= ', rho_(i,:) + endif + unstable=.true. + dir=1 + do while (unstable) + unstable=.false. + if (dir == 1) then + do k=2,nlevs_data(i,j)-1 + if (rho_(i,k) - rho_(i,k-1) < 0.0 ) then + if (k == 2) then + rho_(i,k-1)=rho_(i,k)-epsln + else + drhodz = (rho_(i,k+1)-rho_(i,k-1))/(zin(k+1)-zin(k-1)) + if (drhodz < 0.0) then + unstable=.true. + endif + rho_(i,k) = rho_(i,k-1)+drhodz*zoff*(zin(k)-zin(k-1)) + endif + endif + enddo + dir=-1*dir + else + do k=nlevs_data(i,j)-1,2,-1 + if (rho_(i,k+1) - rho_(i,k) < 0.0) then + if (k == nlevs_data(i,j)-1) then + rho_(i,k+1)=rho_(i,k-1)+epsln + else + drhodz = (rho_(i,k+1)-rho_(i,k-1))/(zin(k+1)-zin(k-1)) + if (drhodz < 0.0) then + unstable=.true. + endif + rho_(i,k) = rho_(i,k+1)-drhodz*(zin(k+1)-zin(k)) + endif + endif + enddo + dir=-1*dir endif - unstable=.true. - dir=1 - do while (unstable) - unstable=.false. - if (dir == 1) then - do k=2,nlevs_data(i,j)-1 - if (rho_(i,k) - rho_(i,k-1) < 0.0 ) then - if (k == 2) then - rho_(i,k-1)=rho_(i,k)-epsln - else - drhodz = (rho_(i,k+1)-rho_(i,k-1))/(zin(k+1)-zin(k-1)) - if (drhodz < 0.0) then - unstable=.true. - endif - rho_(i,k) = rho_(i,k-1)+drhodz*zoff*(zin(k)-zin(k-1)) - endif - endif - enddo - dir=-1*dir - else - do k=nlevs_data(i,j)-1,2,-1 - if (rho_(i,k+1) - rho_(i,k) < 0.0) then - if (k == nlevs_data(i,j)-1) then - rho_(i,k+1)=rho_(i,k-1)+epsln - else - drhodz = (rho_(i,k+1)-rho_(i,k-1))/(zin(k+1)-zin(k-1)) - if (drhodz < 0.0) then - unstable=.true. - endif - rho_(i,k) = rho_(i,k+1)-drhodz*(zin(k+1)-zin(k)) - endif - endif - enddo - dir=-1*dir - endif - enddo - if (debug_) then - print *,'final density profile= ', rho_(i,:) + enddo + if (debug_) then + print *,'final density profile= ', rho_(i,:) + endif + enddo i_loop + + ki_(:,:) = 0 + zi_(:,:) = 0.0 + depth_(:)=-1.0*depth(:,j) + lo(:)=1 + hi(:)=nlevs_data(:,j) + ki_ = bisect_fast(rho_,Rb,lo,hi) + ki_(:,:) = max(1,ki_(:,:)-1) + do i=1,nx + do l=2,nlay + slope = (zin(ki_(i,l)+1) - zin(ki_(i,l)))/max(rho_(i,ki_(i,l)+1) - rho_(i,ki_(i,l)),epsln) + zi_(i,l) = -1.0*(zin(ki_(i,l)) + slope*(Rb(l)-rho_(i,ki_(i,l)))) + zi_(i,l) = max(zi_(i,l),depth_(i)) + zi_(i,l) = min(zi_(i,l),-1.0*hml_) + enddo + zi_(i,nlay+1)=depth_(i) + do l=2,nkml_+1 + zi_(i,l)=max(((1.0-real(l))/real(nkml_))*hml_,depth_(i)) + enddo + do l=nlay,nkml_+2,-1 + if (zi_(i,l) < zi_(i,l+1)+epsln) then + zi_(i,l)=zi_(i,l+1)+epsln + endif + if (zi_(i,l)>-1.0*hml_) then + zi_(i,l)=max(-1.0*hml_,depth_(i)) endif - enddo i_loop - - ki_(:,:) = 0 - zi_(:,:) = 0.0 - depth_(:)=-1.0*depth(:,j) - lo(:)=1 - hi(:)=nlevs_data(:,j) - ki_ = bisect_fast(rho_,Rb,lo,hi) - ki_(:,:) = max(1,ki_(:,:)-1) - do i=1,nx - do l=2,nlay - slope = (zin(ki_(i,l)+1) - zin(ki_(i,l)))/max(rho_(i,ki_(i,l)+1) - rho_(i,ki_(i,l)),epsln) - zi_(i,l) = -1.0*(zin(ki_(i,l)) + slope*(Rb(l)-rho_(i,ki_(i,l)))) - zi_(i,l) = max(zi_(i,l),depth_(i)) - zi_(i,l) = min(zi_(i,l),-1.0*hml_) - enddo - zi_(i,nlay+1)=depth_(i) - do l=2,nkml_+1 - zi_(i,l)=max(((1.0-real(l))/real(nkml_))*hml_,depth_(i)) - enddo - do l=nlay,nkml_+2,-1 - if (zi_(i,l) < zi_(i,l+1)+epsln) then - zi_(i,l)=zi_(i,l+1)+epsln - endif - if (zi_(i,l)>-1.0*hml_) then - zi_(i,l)=max(-1.0*hml_,depth_(i)) - endif - enddo enddo - zi(:,j,:)=zi_(:,:) enddo + zi(:,j,:)=zi_(:,:) + enddo - return + return - - end function find_interfaces +end function find_interfaces !> Create a 2d-mesh of grid coordinates from 1-d arrays - subroutine meshgrid(x,y,x_T,y_T) - real, dimension(:), intent(in) :: x !< input x coordinates - real, dimension(:), intent(in) :: y !< input y coordinates - real, dimension(size(x,1),size(y,1)), intent(inout) :: x_T !< output 2-d version - real, dimension(size(x,1),size(y,1)), intent(inout) :: y_T !< output 2-d version +subroutine meshgrid(x,y,x_T,y_T) + real, dimension(:), intent(in) :: x !< input x coordinates + real, dimension(:), intent(in) :: y !< input y coordinates + real, dimension(size(x,1),size(y,1)), intent(inout) :: x_T !< output 2-d version + real, dimension(size(x,1),size(y,1)), intent(inout) :: y_T !< output 2-d version - integer :: ni,nj,i,j + integer :: ni,nj,i,j - ni=size(x,1);nj=size(y,1) + ni=size(x,1);nj=size(y,1) - do j=1,nj - x_T(:,j)=x(:) - enddo + do j=1,nj + x_T(:,j)=x(:) + enddo - do i=1,ni - y_T(i,:)=y(:) - enddo + do i=1,ni + y_T(i,:)=y(:) + enddo - return + return - end subroutine meshgrid +end subroutine meshgrid !> Solve del2 (zi) = 0 using successive iterations !! with a 5 point stencil. Only points fill==1 are @@ -787,119 +756,121 @@ end subroutine meshgrid !! isotropically in index space. The resulting solution !! in each region is an approximation to del2(zi)=0 subject to !! boundary conditions along the valid points curve bounding this region. - subroutine smooth_heights(zi,fill,bad,sor,niter,cyclic_x, tripolar_n) - real, dimension(:,:), intent(inout) :: zi !< interface positions (m) - integer, dimension(size(zi,1),size(zi,2)), intent(in) :: fill !< points to be smoothed - integer, dimension(size(zi,1),size(zi,2)), intent(in) :: bad !< ignore these points - real, intent(in) :: sor !< successive over-relaxation coefficient (typically 0.6) - integer, intent(in) :: niter !< maximum number of iterations - logical, intent(in) :: cyclic_x !< input grid cyclic condition in the zonal direction - logical, intent(in) :: tripolar_n !< tripolar Arctic fold flag +subroutine smooth_heights(zi,fill,bad,sor,niter,cyclic_x, tripolar_n) + real, dimension(:,:), intent(inout) :: zi !< interface positions (m) + integer, dimension(size(zi,1),size(zi,2)), intent(in) :: fill !< points to be smoothed + integer, dimension(size(zi,1),size(zi,2)), intent(in) :: bad !< ignore these points + real, intent(in) :: sor !< successive over-relaxation coefficient (typically 0.6) + integer, intent(in) :: niter !< maximum number of iterations + logical, intent(in) :: cyclic_x !< input grid cyclic condition in the zonal direction + logical, intent(in) :: tripolar_n !< tripolar Arctic fold flag + + integer :: i,j,k,n + integer :: ni,nj - integer :: i,j,k,n - integer :: ni,nj + real, dimension(size(zi,1),size(zi,2)) :: res, m + integer, dimension(size(zi,1),size(zi,2),4) :: B + real, dimension(0:size(zi,1)+1,0:size(zi,2)+1) :: mp + integer, dimension(0:size(zi,1)+1,0:size(zi,2)+1) :: nm - real, dimension(size(zi,1),size(zi,2)) :: res, m - integer, dimension(size(zi,1),size(zi,2),4) :: B - real, dimension(0:size(zi,1)+1,0:size(zi,2)+1) :: mp - integer, dimension(0:size(zi,1)+1,0:size(zi,2)+1) :: nm + real :: Isum, bsum - real :: Isum, bsum + ni=size(zi,1); nj=size(zi,2) - ni=size(zi,1); nj=size(zi,2) + mp=fill_boundaries(zi,cyclic_x,tripolar_n) - mp=fill_boundaries(zi,cyclic_x,tripolar_n) + B(:,:,:)=0.0 + nm=fill_boundaries(bad,cyclic_x,tripolar_n) - B(:,:,:)=0.0 - nm=fill_boundaries(bad,cyclic_x,tripolar_n) + do j=1,nj + do i=1,ni + if (fill(i,j) == 1) then + B(i,j,1)=1-nm(i+1,j);B(i,j,2)=1-nm(i-1,j) + B(i,j,3)=1-nm(i,j+1);B(i,j,4)=1-nm(i,j-1) + endif + enddo + enddo + do n=1,niter do j=1,nj do i=1,ni if (fill(i,j) == 1) then - B(i,j,1)=1-nm(i+1,j);B(i,j,2)=1-nm(i-1,j) - B(i,j,3)=1-nm(i,j+1);B(i,j,4)=1-nm(i,j-1) + bsum = real(B(i,j,1)+B(i,j,2)+B(i,j,3)+B(i,j,4)) + Isum = 1.0/bsum + res(i,j)=Isum*(B(i,j,1)*mp(i+1,j)+B(i,j,2)*mp(i-1,j)+& + B(i,j,3)*mp(i,j+1)+B(i,j,4)*mp(i,j-1)) - mp(i,j) endif enddo enddo + res(:,:)=res(:,:)*sor - do n=1,niter - do j=1,nj - do i=1,ni - if (fill(i,j) == 1) then - bsum = real(B(i,j,1)+B(i,j,2)+B(i,j,3)+B(i,j,4)) - Isum = 1.0/bsum - res(i,j)=Isum*(B(i,j,1)*mp(i+1,j)+B(i,j,2)*mp(i-1,j)+& - B(i,j,3)*mp(i,j+1)+B(i,j,4)*mp(i,j-1)) - mp(i,j) - endif - enddo - enddo - res(:,:)=res(:,:)*sor - - do j=1,nj - do i=1,ni - mp(i,j)=mp(i,j)+res(i,j) - enddo + do j=1,nj + do i=1,ni + mp(i,j)=mp(i,j)+res(i,j) enddo - - zi(:,:)=mp(1:ni,1:nj) - mp = fill_boundaries(zi,cyclic_x,tripolar_n) enddo - return + zi(:,:)=mp(1:ni,1:nj) + mp = fill_boundaries(zi,cyclic_x,tripolar_n) + enddo - end subroutine smooth_heights + return -!> fill grid edges - function fill_boundaries_int(m,cyclic_x,tripolar_n) result(mp) - integer, dimension(:,:), intent(in) :: m !< input array - logical, intent(in) :: cyclic_x !< zonal cyclic condition - logical, intent(in) :: tripolar_n !< northern fold condition - real, dimension(size(m,1),size(m,2)) :: m_real - real, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp_real - integer, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp !< output filled array +end subroutine smooth_heights + +!> Fill grid edges +function fill_boundaries_int(m,cyclic_x,tripolar_n) result(mp) + integer, dimension(:,:), intent(in) :: m !< input array + logical, intent(in) :: cyclic_x !< zonal cyclic condition + logical, intent(in) :: tripolar_n !< northern fold condition + integer, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp !< output filled array + ! Local variables + real, dimension(size(m,1),size(m,2)) :: m_real + real, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp_real - m_real = real(m) + m_real = real(m) - mp_real = fill_boundaries_real(m_real,cyclic_x,tripolar_n) + mp_real = fill_boundaries_real(m_real,cyclic_x,tripolar_n) - mp = int(mp_real) + mp = int(mp_real) - return + return - end function fill_boundaries_int +end function fill_boundaries_int !> fill grid edges - function fill_boundaries_real(m,cyclic_x,tripolar_n) result(mp) - real, dimension(:,:), intent(in) :: m !< input array - logical, intent(in) :: cyclic_x !< zonal cyclic condition - logical, intent(in) :: tripolar_n !< northern fold condition - real, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp !< output filled array +function fill_boundaries_real(m,cyclic_x,tripolar_n) result(mp) + real, dimension(:,:), intent(in) :: m !< input array + logical, intent(in) :: cyclic_x !< zonal cyclic condition + logical, intent(in) :: tripolar_n !< northern fold condition + real, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp !< output filled array - integer :: ni,nj,i,j + integer :: ni,nj,i,j - ni=size(m,1); nj=size(m,2) + ni=size(m,1); nj=size(m,2) - mp(1:ni,1:nj)=m(:,:) + mp(1:ni,1:nj)=m(:,:) - if (cyclic_x) then - mp(0,1:nj)=m(ni,1:nj) - mp(ni+1,1:nj)=m(1,1:nj) - else - mp(0,1:nj)=m(1,1:nj) - mp(ni+1,1:nj)=m(ni,1:nj) - endif + if (cyclic_x) then + mp(0,1:nj)=m(ni,1:nj) + mp(ni+1,1:nj)=m(1,1:nj) + else + mp(0,1:nj)=m(1,1:nj) + mp(ni+1,1:nj)=m(ni,1:nj) + endif - mp(1:ni,0)=m(1:ni,1) - if (tripolar_n) then - do i=1,ni - mp(i,nj+1)=m(ni-i+1,nj) - enddo - else - mp(1:ni,nj+1)=m(1:ni,nj) - endif + mp(1:ni,0)=m(1:ni,1) + if (tripolar_n) then + do i=1,ni + mp(i,nj+1)=m(ni-i+1,nj) + enddo + else + mp(1:ni,nj+1)=m(1:ni,nj) + endif + + return - return +end function fill_boundaries_real - end function fill_boundaries_real end module MIDAS_vertmap From f40093b67d3a2e87bd0231d8bf3ded4243d1f29d Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 10 Jul 2018 15:08:21 -0400 Subject: [PATCH 0563/1072] Fixed doxygen errors in MOM_coord_initialization.F90 - Also tidied up other comments --- .../MOM_coord_initialization.F90 | 113 ++++-------------- 1 file changed, 23 insertions(+), 90 deletions(-) diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 5b4c497bcb..140983d0fb 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -24,11 +24,10 @@ module MOM_coord_initialization public MOM_initialize_coord -character(len=40) :: mdl = "MOM_coord_initialization" ! This module's name. +character(len=40) :: mdl = "MOM_coord_initialization" !< This module's name. contains -! ----------------------------------------------------------------------------- !> MOM_initialize_coord sets up time-invariant quantities related to MOM6's !! vertical coordinate. subroutine MOM_initialize_coord(GV, PF, write_geom, output_dir, tv, max_depth) @@ -112,10 +111,10 @@ subroutine MOM_initialize_coord(GV, PF, write_geom, output_dir, tv, max_depth) call callTree_leave('MOM_initialize_coord()') end subroutine MOM_initialize_coord -! ----------------------------------------------------------------------------- -! The set_coord routines deal with initializing aspects of the vertical grid. -! ----------------------------------------------------------------------------- +! The set_coord routines deal with initializing aspects of the vertical grid. + +!> Sets the layer densities (Rlay) and the interface reduced gravities (g). subroutine set_coord_from_gprime(Rlay, g_prime, GV, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). @@ -123,14 +122,7 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, param_file) !! parse for model parameter values. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters -! Arguments: Rlay - the layers' target coordinate values (potential density). -! (out) g_prime - the reduced gravity across the interfaces, in m s-2. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. - -! This subroutine sets the layer densities (Rlay) and the interface ! -! reduced gravities (g). ! + ! Local variables real :: g_int ! Reduced gravities across the internal interfaces, in m s-2. real :: g_fs ! Reduced gravity across the free surface, in m s-2. character(len=40) :: mdl = "set_coord_from_gprime" ! This subroutine's name. @@ -154,9 +146,8 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, param_file) call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_gprime -! ----------------------------------------------------------------------------- -! ----------------------------------------------------------------------------- +!> Sets the layer densities (Rlay) and the interface reduced gravities (g). subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). @@ -164,14 +155,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file) !! in m s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters -! Arguments: Rlay - the layers' target coordinate values (potential density). -! (out) g_prime - the reduced gravity across the interfaces, in m s-2. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. - -! This subroutine sets the layer densities (Rlay) and the interface ! -! reduced gravities (g). ! + ! Local variables real :: g_fs ! Reduced gravity across the free surface, in m s-2. real :: Rlay_Ref! The surface layer's target density, in kg m-3. real :: RLay_range ! The range of densities, in kg m-3. @@ -203,9 +187,8 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file) call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_layer_density -! ----------------------------------------------------------------------------- -! ----------------------------------------------------------------------------- +!> Sets the layer densities (Rlay) and the interface reduced gravities (g) from a profile of g'. subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, param_file, eqn_of_state, & P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values @@ -218,16 +201,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, param_file, eqn_of_state, & type(EOS_type), pointer :: eqn_of_state !< integer selecting the equation of state. real, intent(in) :: P_Ref !< The coordinate-density reference pressure !! in Pa. -! Arguments: Rlay - the layers' target coordinate values (potential density). -! (out) g_prime - the reduced gravity across the interfaces, in m s-2. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) eqn_of_state - integer selecting the equation of state -! (in) P_Ref - The coordinate-density reference pressure in Pa. - -! This subroutine sets the layer densities (Rlay) and the interface ! -! reduced gravities (g). ! + ! Local variables real :: T_ref ! Reference temperature real :: S_ref ! Reference salinity real :: g_int ! Reduced gravities across the internal interfaces, in m s-2. @@ -264,9 +238,8 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, param_file, eqn_of_state, & call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_ref -! ----------------------------------------------------------------------------- -! ----------------------------------------------------------------------------- +!> Sets the layer densities (Rlay) and the interface reduced gravities (g) from a T-S profile. subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, & eqn_of_state, P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values @@ -279,16 +252,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, & type(EOS_type), pointer :: eqn_of_state !< integer that selects equation of state. real, intent(in) :: P_Ref !< The coordinate-density reference pressure !! in Pa. -! Arguments: Rlay - the layers' target coordinate values (potential density). -! (out) g_prime - the reduced gravity across the interfaces, in m s-2. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) eqn_of_state - integer that selects equation of state -! (in) P_Ref - The coordinate-density reference pressure in Pa. - -! This subroutine sets the layer densities (Rlay) and the interface ! -! reduced gravities (g). ! + ! Local variables real, dimension(GV%ke) :: T0, S0, Pref real :: g_fs ! Reduced gravity across the free surface, in m s-2. integer :: k, nz @@ -322,9 +286,8 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, & call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_profile -! ----------------------------------------------------------------------------- -! ----------------------------------------------------------------------------- +!> Sets the layer densities (Rlay) and the interface reduced gravities (g) from a linear T-S profile. subroutine set_coord_from_TS_range(Rlay, g_prime, GV, param_file, & eqn_of_state, P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values @@ -337,16 +300,6 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, param_file, & type(EOS_type), pointer :: eqn_of_state !< integer that selects equation of state real, intent(in) :: P_Ref !< The coordinate-density reference pressure !! in Pa. -! Arguments: Rlay - the layers' target coordinate values (potential density). -! (out) g_prime - the reduced gravity across the interfaces, in m s-2. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) eqn_of_state - integer that selects equation of state -! (in) P_Ref - The coordinate-density reference pressure in Pa. - -! This subroutine sets the layer densities (Rlay) and the interface ! -! reduced gravities (g). ! real, dimension(GV%ke) :: T0, S0, Pref real :: S_Ref, S_Light, S_Dense ! Salinity range parameters in PSU. real :: T_Ref, T_Light, T_Dense ! Temperature range parameters in dec C. @@ -415,9 +368,8 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, param_file, & call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_range -! ----------------------------------------------------------------------------- -! ----------------------------------------------------------------------------- +! Sets the layer densities (Rlay) and the interface reduced gravities (g) from data in file. subroutine set_coord_from_file(Rlay, g_prime, GV, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). @@ -425,14 +377,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, param_file) !! in m s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters -! Arguments: Rlay - the layers' target coordinate values (potential density). -! (out) g_prime - the reduced gravity across the interfaces, in m s-2. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. - -! This subroutine sets the layer densities (Rlay) and the interface ! -! reduced gravities (g). ! + ! Local variables real :: g_fs ! Reduced gravity across the free surface, in m s-2. integer :: k, nz character(len=40) :: mdl = "set_coord_from_file" ! This subroutine's name. @@ -469,9 +414,12 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, param_file) call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_file -! ----------------------------------------------------------------------------- -! ----------------------------------------------------------------------------- +!> Sets the layer densities (Rlay) and the interface +!! reduced gravities (g) according to a linear profile starting at a +!! reference surface layer density and spanning a range of densities +!! to the bottom defined by the parameter RLAY_RANGE +!! (defaulting to 2.0 if not defined) subroutine set_coord_linear(Rlay, g_prime, GV, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). @@ -479,17 +427,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, param_file) !! in m s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters -! Arguments: Rlay - the layers' target coordinate values (potential density). -! (out) g_prime - the reduced gravity across the interfaces, in m s-2. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. - -! This subroutine sets the layer densities (Rlay) and the interface -! reduced gravities (g) according to a linear profile starting at a -! reference surface layer density and spanning a range of densities -! to the bottom defined by the parameter RLAY_RANGE -! (defaulting to 2.0 if not defined) + ! Local variables character(len=40) :: mdl = "set_coord_linear" ! This subroutine real :: Rlay_ref, Rlay_range, g_fs integer :: k, nz @@ -532,6 +470,7 @@ subroutine set_coord_to_none(Rlay, g_prime, GV, param_file) !! parse for model parameter values. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + ! Local variables real :: g_fs ! Reduced gravity across the free surface, in m s-2. character(len=40) :: mdl = "set_coord_to_none" ! This subroutine's name. integer :: k, nz @@ -552,18 +491,13 @@ subroutine set_coord_to_none(Rlay, g_prime, GV, param_file) end subroutine set_coord_to_none -!> This subroutine writes out a file containing any available data related +!> Writes out a file containing any available data related !! to the vertical grid used by the MOM ocean model. subroutine write_vertgrid_file(GV, param_file, directory) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters character(len=*), intent(in) :: directory !< The directory into which to place the file. -! This subroutine writes out a file containing any available data related -! to the vertical grid used by the MOM ocean model. -! Arguments: GV - The container for the vertical grid data. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) directory - The directory into which to place the file. + ! Local variables character(len=240) :: filepath type(vardesc) :: vars(2) type(fieldtype) :: fields(2) @@ -582,6 +516,5 @@ subroutine write_vertgrid_file(GV, param_file, directory) call close_file(unit) end subroutine write_vertgrid_file -! ----------------------------------------------------------------------------- end module MOM_coord_initialization From b3161f5aed9dd9163ccc1a9830080949209cfaa7 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 10 Jul 2018 15:08:46 -0400 Subject: [PATCH 0564/1072] Fixed doxygen errors in MOM_state_initialization.F90 - Also tidied up other comments --- .../MOM_state_initialization.F90 | 184 +++++++++--------- 1 file changed, 89 insertions(+), 95 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 62d89daaa1..0f9c17022d 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -106,7 +106,7 @@ module MOM_state_initialization public MOM_initialize_state -character(len=40) :: mdl = "MOM_state_initialization" ! This module's name. +character(len=40) :: mdl = "MOM_state_initialization" !< This module's name. contains @@ -200,10 +200,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & use_OBC = associated(OBC) if (use_EOS) eos => tv%eqn_of_state -!==================================================================== -! Initialize temporally evolving fields, either as initial -! conditions or by reading them from a restart (or saves) file. -!==================================================================== + !==================================================================== + ! Initialize temporally evolving fields, either as initial + ! conditions or by reading them from a restart (or saves) file. + !==================================================================== if (new_sim) then call MOM_mesg("Run initialized internally.", 3) @@ -229,14 +229,14 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & "longitude grid.", default=.false., do_not_log=just_read) if (from_Z_file) then -! Initialize thickness and T/S from z-coordinate data in a file. + ! Initialize thickness and T/S from z-coordinate data in a file. if (.NOT.use_temperature) call MOM_error(FATAL,"MOM_initialize_state : "//& "use_temperature must be true if INIT_LAYERS_FROM_Z_FILE is true") call MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params=just_read) else -! Initialize thickness, h. + ! Initialize thickness, h. call get_param(PF, mdl, "THICKNESS_CONFIG", config, & "A string that determines how the initial layer \n"//& "thicknesses are specified for a new run: \n"//& @@ -317,7 +317,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & "Unrecognized layer thickness configuration "//trim(config)) end select -! Initialize temperature and salinity (T and S). + ! Initialize temperature and salinity (T and S). if ( use_temperature ) then call get_param(PF, mdl, "TS_CONFIG", config, & "A string that determines how the initial tempertures \n"//& @@ -341,7 +341,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & " \t SCM_CVMix_tests - used in the SCM CVMix tests.\n"//& " \t USER - call a user modified routine.", & fail_if_missing=new_sim, do_not_log=just_read) -! " \t baroclinic_zone - an analytic baroclinic zone. \n"//& +! " \t baroclinic_zone - an analytic baroclinic zone. \n"//& select case (trim(config)) case ("fit"); call initialize_temp_salt_fit(tv%T, tv%S, G, GV, PF, & eos, tv%P_Ref, just_read_params=just_read) @@ -388,7 +388,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & ! The thicknesses in halo points might be needed to initialize the velocities. if (new_sim) call pass_var(h, G%Domain) -! Initialize velocity components, u and v + ! Initialize velocity components, u and v call get_param(PF, mdl, "VELOCITY_CONFIG", config, & "A string that determines how the initial velocities \n"//& "are specified for a new run: \n"//& @@ -426,8 +426,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & call uvchksum("MOM_initialize_state [uv]", u, v, G%HI, haloshift=1) endif -! Optionally convert the thicknesses from m to kg m-2. This is particularly -! useful in a non-Boussinesq model. + ! Optionally convert the thicknesses from m to kg m-2. This is particularly + ! useful in a non-Boussinesq model. call get_param(PF, mdl, "CONVERT_THICKNESS_UNITS", convert, & "If true, convert the thickness initial conditions from \n"//& "units of m to kg m-2 or vice versa, depending on whether \n"//& @@ -438,7 +438,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & ! Convert thicknesses from geomtric distances to mass-per-unit-area. call convert_thickness(h, G, GV, tv) -! Remove the mass that would be displaced by an ice shelf or inverse barometer. + ! Remove the mass that would be displaced by an ice shelf or inverse barometer. call get_param(PF, mdl, "DEPRESS_INITIAL_SURFACE", depress_sfc, & "If true, depress the initial surface to avoid huge \n"//& "tsunamis when a large surface pressure is applied.", & @@ -477,8 +477,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & ! internally at the start of a new run. if (.not.new_sim) then ! This block restores the state from a restart file. - ! This line calls a subroutine that reads the initial conditions ! - ! from a previously generated file. ! + ! This line calls a subroutine that reads the initial conditions + ! from a previously generated file. call restore_state(dirs%input_filename, dirs%restart_input_dir, Time, & G, restart_CS) if (present(Time_in)) Time = Time_in @@ -612,7 +612,7 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. -! This subroutine reads the layer thicknesses from file. + ! Local variables real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) integer :: inconsistent = 0 logical :: correct_thickness @@ -776,10 +776,10 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) !! only read parameters without changing h. ! Local variables character(len=40) :: mdl = "initialize_thickness_uniform" ! This subroutine's name. - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually + ! negative because it is positive upward. + real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface + ! positive upward, in m. logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, nz @@ -799,11 +799,11 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) enddo do j=js,je ; do i=is,ie -! This sets the initial thickness (in m) of the layers. The ! -! thicknesses are set to insure that: 1. each layer is at least an ! -! Angstrom thick, and 2. the interfaces are where they should be ! -! based on the resting depths and interface height perturbations, ! -! as long at this doesn't interfere with 1. ! + ! This sets the initial thickness (in m) of the layers. The + ! thicknesses are set to insure that: 1. each layer is at least an + ! Angstrom thick, and 2. the interfaces are where they should be + ! based on the resting depths and interface height perturbations, + ! as long at this doesn't interfere with 1. eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) @@ -831,10 +831,10 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) !! only read parameters without changing h. ! Local variables character(len=40) :: mdl = "initialize_thickness_list" ! This subroutine's name. - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually + ! negative because it is positive upward. + real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface + ! positive upward, in m. logical :: just_read ! If true, just read parameters but set nothing. character(len=200) :: filename, eta_file, inputdir ! Strings for file/path character(len=72) :: eta_var @@ -877,11 +877,11 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) endif do j=js,je ; do i=is,ie -! This sets the initial thickness (in m) of the layers. The ! -! thicknesses are set to insure that: 1. each layer is at least an ! -! Angstrom thick, and 2. the interfaces are where they should be ! -! based on the resting depths and interface height perturbations, ! -! as long at this doesn't interfere with 1. ! + ! This sets the initial thickness (in m) of the layers. The + ! thicknesses are set to insure that: 1. each layer is at least an + ! Angstrom thick, and 2. the interfaces are where they should be + ! based on the resting depths and interface height perturbations, + ! as long at this doesn't interfere with 1. eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) @@ -1346,7 +1346,7 @@ subroutine initialize_velocity_circular(u, v, G, param_file, just_read_params) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to - !! parse for modelparameter values. + !! parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables @@ -1406,7 +1406,7 @@ subroutine initialize_temp_salt_from_file(T, S, G, param_file, just_read_params) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is being initialized. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + !! only read parameters without changing h. ! Local variables logical :: just_read ! If true, just read parameters but set nothing. character(len=200) :: filename, salt_filename ! Full paths to input files @@ -1441,7 +1441,7 @@ subroutine initialize_temp_salt_from_file(T, S, G, param_file, just_read_params) if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_temp_salt_from_file: Unable to open "//trim(filename)) -! Read the temperatures and salinities from netcdf files. ! + ! Read the temperatures and salinities from netcdf files. call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain) salt_filename = trim(inputdir)//trim(salt_file) @@ -1485,7 +1485,7 @@ subroutine initialize_temp_salt_from_profile(T, S, G, param_file, just_read_para if (.not.file_exists(filename)) call MOM_error(FATAL, & " initialize_temp_salt_from_profile: Unable to open "//trim(filename)) -! Read the temperatures and salinities from a netcdf file. ! + ! Read the temperatures and salinities from a netcdf file. call MOM_read_data(filename, "PTEMP", T0(:)) call MOM_read_data(filename, "SALT", S0(:)) @@ -1514,8 +1514,8 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, param_file, eqn_of_state, P_Ref real :: T_Ref ! Reference Temperature real :: S_Ref ! Reference Salinity real :: pres(SZK_(G)) ! An array of the reference pressure in Pa. - real :: drho_dT(SZK_(G)) ! Derivative of density with temperature in kg m-3 K-1. ! - real :: drho_dS(SZK_(G)) ! Derivative of density with salinity in kg m-3 PSU-1. ! + real :: drho_dT(SZK_(G)) ! Derivative of density with temperature in kg m-3 K-1. + real :: drho_dS(SZK_(G)) ! Derivative of density with salinity in kg m-3 PSU-1. real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 in kg m-3. logical :: fit_salin ! If true, accept the prescribed temperature and fit the salinity. logical :: just_read ! If true, just read parameters but set nothing. @@ -1549,11 +1549,11 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, param_file, eqn_of_state, P_Ref call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,1,eqn_of_state) if (fit_salin) then -! A first guess of the layers' temperatures. + ! A first guess of the layers' temperatures. do k=nz,1,-1 S0(k) = max(0.0, S0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dS(1)) enddo -! Refine the guesses for each layer. + ! Refine the guesses for each layer. do itt=1,6 call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) @@ -1562,7 +1562,7 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, param_file, eqn_of_state, P_Ref enddo enddo else -! A first guess of the layers' temperatures. + ! A first guess of the layers' temperatures. do k=nz,1,-1 T0(k) = T0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dT(1) enddo @@ -1624,7 +1624,7 @@ subroutine initialize_temp_salt_linear(T, S, G, param_file, just_read_params) if (just_read) return ! All run-time parameters have been read, so return. -! ! Prescribe salinity + ! Prescribe salinity ! delta_S = S_range / ( G%ke - 1.0 ) ! S(:,:,1) = S_top ! do k = 2,G%ke @@ -1635,7 +1635,7 @@ subroutine initialize_temp_salt_linear(T, S, G, param_file, just_read_params) T(:,:,k) = T_top - T_range*((real(k)-0.5)/real(G%ke)) enddo -! ! Prescribe temperature + ! Prescribe temperature ! delta_T = T_range / ( G%ke - 1.0 ) ! T(:,:,1) = T_top ! do k = 2,G%ke @@ -1738,17 +1738,16 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, call MOM_read_data(filename, "Idamp", Idamp(:,:), G%Domain) -! Now register all of the fields which are damped in the sponge. ! -! By default, momentum is advected vertically within the sponge, but ! -! momentum is typically not damped within the sponge. ! + ! Now register all of the fields which are damped in the sponge. + ! By default, momentum is advected vertically within the sponge, but + ! momentum is typically not damped within the sponge. filename = trim(inputdir)//trim(state_file) call log_param(param_file, mdl, "INPUTDIR/SPONGE_STATE_FILE", filename) if (.not.file_exists(filename, G%Domain)) & call MOM_error(FATAL, " initialize_sponges: Unable to open "//trim(filename)) - -! The first call to set_up_sponge_field is for the interface heights if in layered mode.! + ! The first call to set_up_sponge_field is for the interface heights if in layered mode.! if (.not. use_ALE) then allocate(eta(isd:ied,jsd:jed,nz+1)) @@ -1761,8 +1760,8 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_z)) & eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_z enddo ; enddo ; enddo -! Set the inverse damping rates so that the model will know where to ! -! apply the sponges, along with the interface heights. ! + ! Set the inverse damping rates so that the model will know where to + ! apply the sponges, along with the interface heights. call initialize_sponge(Idamp, eta, G, param_file, CSp) deallocate(eta) elseif (.not. new_sponges) then ! ALE mode @@ -1771,8 +1770,8 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, if (siz(1) /= G%ieg-G%isg+1 .or. siz(2) /= G%jeg-G%jsg+1) & call MOM_error(FATAL,"initialize_sponge_file: Array size mismatch for sponge data.") -! ALE_CSp%time_dependent_target = .false. -! if (siz(4) > 1) ALE_CSp%time_dependent_target = .true. +! ALE_CSp%time_dependent_target = .false. +! if (siz(4) > 1) ALE_CSp%time_dependent_target = .true. nz_data = siz(3)-1 allocate(eta(isd:ied,jsd:jed,nz_data+1)) allocate(h(isd:ied,jsd:jed,nz_data)) @@ -1798,16 +1797,14 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, call initialize_ALE_sponge(Idamp, G, param_file, ALE_CSp) endif - - -! Now register all of the tracer fields which are damped in the ! -! sponge. By default, momentum is advected vertically within the ! -! sponge, but momentum is typically not damped within the sponge. ! + ! Now register all of the tracer fields which are damped in the + ! sponge. By default, momentum is advected vertically within the + ! sponge, but momentum is typically not damped within the sponge. if ( GV%nkml>0 .and. .not. new_sponges) then -! This call to set_up_sponge_ML_density registers the target values of the -! mixed layer density, which is used in determining which layers can be -! inflated without causing static instabilities. + ! This call to set_up_sponge_ML_density registers the target values of the + ! mixed layer density, which is used in determining which layers can be + ! inflated without causing static instabilities. do i=is-1,ie ; pres(i) = tv%P_Ref ; enddo call MOM_read_data(filename, potemp_var, tmp(:,:,:), G%Domain) @@ -1821,7 +1818,7 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, call set_up_sponge_ML_density(tmp_2d, G, CSp) endif -! The remaining calls to set_up_sponge_field can be in any order. ! + ! The remaining calls to set_up_sponge_field can be in any order. if ( use_temperature .and. .not. new_sponges) then call MOM_read_data(filename, potemp_var, tmp(:,:,:), G%Domain) call set_up_sponge_field(tmp, tv%T, G, nz, CSp) @@ -1889,8 +1886,6 @@ end subroutine set_velocity_depth_min !! layer potential temperatures and salinities directly from a z-space file on !! a latitude-longitude grid. subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) -! This subroutine was written by M. Harrison, with input from R. Hallberg & A. Adcroft. -! type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: h !< Layer thicknesses being initialized, in H @@ -1915,7 +1910,6 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) type(EOS_type), pointer :: eos => NULL() type(thermo_var_ptrs) :: tv_loc ! A temporary thermo_var container type(verticalGrid_type) :: GV_loc ! A temporary vertical grid structure - ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_initialize_layers_from_Z" ! This module's name. @@ -1949,7 +1943,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) logical :: reentrant_x, tripolar_n,dbg logical :: debug = .false. ! manually set this to true for verbose output - !data arrays + ! data arrays real, dimension(:), allocatable :: z_edges_in, z_in, Rb real, dimension(:,:,:), allocatable, target :: temp_z, salt_z, mask_z real, dimension(:,:,:), allocatable :: rho_z @@ -2075,20 +2069,20 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) return ! All run-time parameters have been read, so return. endif -! Read input grid coordinates for temperature and salinity field -! in z-coordinate dataset. The file is REQUIRED to contain the -! following: -! -! dimension variables: -! lon (degrees_E), lat (degrees_N), depth(meters) -! variables: -! ptemp(lon,lat,depth) : degC, potential temperature -! salt (lon,lat,depth) : PSU, salinity -! -! The first record will be read if there are multiple time levels. -! The observation grid MUST tile the model grid. If the model grid extends -! to the North/South Pole past the limits of the input data, they are extrapolated using the average -! value at the northernmost/southernmost latitude. + ! Read input grid coordinates for temperature and salinity field + ! in z-coordinate dataset. The file is REQUIRED to contain the + ! following: + ! + ! dimension variables: + ! lon (degrees_E), lat (degrees_N), depth(meters) + ! variables: + ! ptemp(lon,lat,depth) : degC, potential temperature + ! salt (lon,lat,depth) : PSU, salinity + ! + ! The first record will be read if there are multiple time levels. + ! The observation grid MUST tile the model grid. If the model grid extends + ! to the North/South Pole past the limits of the input data, they are extrapolated using the average + ! value at the northernmost/southernmost latitude. call horiz_interp_and_extrap_tracer(tfilename, potemp_var,1.0,1, & G, temp_z, mask_z, z_in, z_edges_in, missing_value_temp, reentrant_x, tripolar_n, homogenize) @@ -2104,7 +2098,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) press(:) = tv%p_ref - !Convert T&S to Absolute Salinity and Conservative Temperature if using TEOS10 or NEMO + ! Convert T&S to Absolute Salinity and Conservative Temperature if using TEOS10 or NEMO call convert_temp_salt_for_TEOS10(temp_z,salt_z, press, G, kd, mask_z, eos) do k=1,kd @@ -2125,28 +2119,28 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) call MOM_read_data(shelf_file, trim(area_varname), area_shelf_h, G%Domain) - ! initialize frac_shelf_h with zeros (open water everywhere) + ! Initialize frac_shelf_h with zeros (open water everywhere) frac_shelf_h(:,:) = 0.0 - ! compute fractional ice shelf coverage of h + ! Compute fractional ice shelf coverage of h do j=jsd,jed ; do i=isd,ied if (G%areaT(i,j) > 0.0) & frac_shelf_h(i,j) = area_shelf_h(i,j) / G%areaT(i,j) enddo ; enddo - ! pass to the pointer for use as an argument to regridding_main + ! Pass to the pointer for use as an argument to regridding_main shelf_area => frac_shelf_h endif -! Done with horizontal interpolation. -! Now remap to model coordinates + ! Done with horizontal interpolation. + ! Now remap to model coordinates if (useALEremapping) then call cpu_clock_begin(id_clock_ALE) nkd = max(GV%ke, kd) ! The regridding tools (grid generation) are coded to work on model arrays of the same ! vertical shape. We need to re-write the regridding if the model has fewer layers ! than the data. -AJA - !if (kd>nz) call MOM_error(FATAL,"MOM_initialize_state, MOM_temp_salt_initialize_from_Z(): "//& - ! "Data has more levels than the model - this has not been coded yet!") +! if (kd>nz) call MOM_error(FATAL,"MOM_initialize_state, MOM_temp_salt_initialize_from_Z(): "//& +! "Data has more levels than the model - this has not been coded yet!") ! Build the source grid and copy data onto model-shaped arrays with vanished layers allocate( tmp_mask_in(isd:ied,jsd:jed,nkd) ) ; tmp_mask_in(:,:,:) = 0. allocate( h1(isd:ied,jsd:jed,nkd) ) ; h1(:,:,:) = 0. @@ -2236,11 +2230,11 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) else ! remap to isopycnal layer space -! next find interface positions using local arrays -! nlevs contains the number of valid data points in each column + ! Next find interface positions using local arrays + ! nlevs contains the number of valid data points in each column nlevs = sum(mask_z,dim=3) -! Rb contains the layer interface densities + ! Rb contains the layer interface densities allocate(Rb(nz+1)) do k=2,nz ; Rb(k)=0.5*(GV%Rlay(k-1)+GV%Rlay(k)) ; enddo Rb(1) = 0.0 ; Rb(nz+1) = 2.0*GV%Rlay(nz) - GV%Rlay(nz-1) @@ -2288,7 +2282,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) saltAvg =saltAvg + tv%S(i,j,k) endif ; enddo ; enddo - ! Horizontally homogenize data to produce perfectly "flat" initial conditions + ! Horizontally homogenize data to produce perfectly "flat" initial conditions if (homogenize) then call sum_across_PEs(nPoints) call sum_across_PEs(tempAvg) @@ -2304,7 +2298,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) endif ! useALEremapping -! Fill land values + ! Fill land values do k=1,nz ; do j=js,je ; do i=is,ie if (tv%T(i,j,k) == missing_value) then tv%T(i,j,k)=temp_land_fill @@ -2312,7 +2306,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) endif enddo ; enddo ; enddo -! Finally adjust to target density + ! Finally adjust to target density ks=max(0,nkml)+max(0,nkbl)+1 if (adjust_temperature .and. .not. useALEremapping) then From 60031744da791022927a55c953837965a98826dd Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 10 Jul 2018 15:10:45 -0400 Subject: [PATCH 0565/1072] Fixed doxygen errors in MOM_grid_initialize.F90 - Also replaced old boiler plate --- src/initialization/MOM_grid_initialize.F90 | 303 ++++++++------------- 1 file changed, 110 insertions(+), 193 deletions(-) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 78d2a3fb8c..be82ffc33f 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -1,54 +1,8 @@ +!> Initializes horizontal grid module MOM_grid_initialize ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, November 1998 - June 2002 * -!* * -!* This program contains 2 externally callable subroutines. * -!* set_grid_metrics calculates the various metric terms that are used * -!* by MOM. This routine is intended to be modified by the user to * -!* enable the use of any general orthogonal grid. initialize_masks * -!* initializes the land masks; it is in this file because it a key * -!* part of the physical grid description. * -!* * -!* This subroutine is also used by MOM-related preprocessing and * -!* postprocessing codes. * -!* * -!* The metric terms have the form Dzp, IDzp, or DXDYp, where z can * -!* be X or Y, and p can be q, u, v, or h. z describes the direction * -!* of the metric, while p describes the location. IDzp is the * -!* inverse of Dzp, while DXDYp is the product of DXp and DYp except * -!* that areaT is calculated analytically from the latitudes and * -!* longitudes of the surrounding q points. * -!* * -!* On a sphere, a variety of grids can be implemented by defining * -!* analytic expressions for dx_di, dy_dj (where x and y are latitude * -!* and longitude, and i and j are grid indices) and the expressions * -!* for the integrals of their inverses in the four subroutines * -!* dy_dj, Int_dj_dy, dx_di, and Int_di_dx. * -!* * -!* initialize_masks sets up land masks based on the depth field. * -!* The one argument is the minimum ocean depth. Depths that are * -!* less than this are interpreted as land points. * -!* * -!* Macros written all in capital letters are from MOM_memory.h. * -!* * -!* A small fragment of the C-grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q, dxBu, IdxBu, dyBu, IdyBu, etc. * -!* j+1 > o > o > At ^: v, dxCv, IdxCv, dyCv, IdyCv, etc. * -!* j x ^ x ^ x At >: u, dxCu, IdxCu, dyCu, IdyCu, etc. * -!* j > o > o > At o: h, dxT, IdxT, dyT, IdyT, areaT, etc. * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_checksums, only : hchksum, Bchksum use MOM_checksums, only : uvchksum, hchksum_pair, Bchksum_pair use MOM_domains, only : pass_var, pass_vector, pe_here, root_PE, broadcast @@ -69,6 +23,7 @@ module MOM_grid_initialize public set_grid_metrics, initialize_masks, Adcroft_reciprocal +!> Global positioning system (aka container for information to describe the grid) type, public :: GPS ; private real :: len_lon !< The longitudinal or x-direction length of the domain. real :: len_lat !< The latitudinal or y-direction length of the domain. @@ -95,24 +50,13 @@ module MOM_grid_initialize contains - !> set_grid_metrics is used to set the primary values in the model's horizontal -!! grid. The bathymetry, land-sea mask and any restricted channel widths are -!! not known yet, so these are set later. +!! grid. The bathymetry, land-sea mask and any restricted channel widths are +!! not known yet, so these are set later. subroutine set_grid_metrics(G, param_file) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file structure -! Arguments: -! (inout) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. - -! Calculate the values of the metric terms that might be used -! and save them in arrays. -! Within this subroutine, the x- and y- grid spacings and their -! inverses and the cell areas centered on h, q, u, and v points are -! calculated, as are the geographic locations of each of these 4 -! sets of points. + ! Local variables ! This include declares and sets the variable "version". #include "version_variable.h" logical :: debug @@ -147,7 +91,7 @@ subroutine set_grid_metrics(G, param_file) "Unrecognized grid configuration "//trim(config)) end select -! Calculate derived metrics (i.e. reciprocals and products) + ! Calculate derived metrics (i.e. reciprocals and products) call callTree_enter("set_derived_metrics(), MOM_grid_initialize.F90") call set_derived_dyn_horgrid(G) call callTree_leave("set_derived_metrics()") @@ -160,7 +104,7 @@ end subroutine set_grid_metrics ! ------------------------------------------------------------------------------ !> grid_metrics_chksum performs a set of checksums on metrics on the grid for -!! debugging. +!! debugging. subroutine grid_metrics_chksum(parent, G) character(len=*), intent(in) :: parent !< A string identifying the caller type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type @@ -214,17 +158,11 @@ end subroutine grid_metrics_chksum ! ------------------------------------------------------------------------------ -!> set_grid_metrics_from_mosaic sets the grid metrics from a mosaic file. +!> Sets the grid metrics from a mosaic file. subroutine set_grid_metrics_from_mosaic(G, param_file) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file structure -! This subroutine sets the grid metrics from a mosaic file. -! -! Arguments: -! (inout) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. - + ! Local variables real, dimension(G%isd :G%ied ,G%jsd :G%jed ) :: tempH1, tempH2, tempH3, tempH4 real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: tempQ1, tempQ2, tempQ3, tempQ4 real, dimension(G%IsdB:G%IedB,G%jsd :G%jed ) :: tempE1, tempE2 @@ -263,16 +201,16 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) call MOM_error(FATAL," set_grid_metrics_from_mosaic: Unable to open "//& trim(filename)) -! Initialize everything to 0. + ! Initialize everything to 0. dxCu(:,:) = 0.0 ; dyCu(:,:) = 0.0 dxCv(:,:) = 0.0 ; dyCv(:,:) = 0.0 dxBu(:,:) = 0.0 ; dyBu(:,:) = 0.0 ; areaBu(:,:) = 0.0 -! + ! ni = 2*(G%iec-G%isc+1) ! i size of supergrid nj = 2*(G%jec-G%jsc+1) ! j size of supergrid -! Define a domain for the supergrid (SGdom) + ! Define a domain for the supergrid (SGdom) npei = G%domain%layout(1) ; npej = G%domain%layout(2) allocate(exni(npei)) ; allocate(exnj(npej)) call mpp_get_domain_extents(G%domain%mpp_domain, exni, exnj) @@ -308,7 +246,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) deallocate(exni) deallocate(exnj) -! Read X from the supergrid + ! Read X from the supergrid tmpZ(:,:) = 999. call MOM_read_data(filename, 'x', tmpZ, SGdom, position=CORNER) @@ -326,10 +264,10 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) do J=G%JsdB,G%JedB ; do i=G%isd,G%ied ; i2 = 2*i ; j2 = 2*J G%geoLonCv(i,J) = tmpZ(i2-1,j2) enddo ; enddo - ! For some reason, this messes up the solution... - ! call pass_var(G%geoLonBu, G%domain, position=CORNER) + ! For some reason, this messes up the solution... + ! call pass_var(G%geoLonBu, G%domain, position=CORNER) -! Read Y from the supergrid + ! Read Y from the supergrid tmpZ(:,:) = 999. call MOM_read_data(filename, 'y', tmpZ, SGdom, position=CORNER) @@ -348,7 +286,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) G%geoLatCv(i,J) = tmpZ(i2-1,j2) enddo ; enddo -! Read DX,DY from the supergrid + ! Read DX,DY from the supergrid tmpU(:,:) = 0. ; tmpV(:,:) = 0. call MOM_read_data(filename,'dx',tmpV,SGdom,position=NORTH_FACE) call MOM_read_data(filename,'dy',tmpU,SGdom,position=EAST_FACE) @@ -376,7 +314,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) dyBu(I,J) = tmpU(i2,j2) + tmpU(i2,j2+1) enddo ; enddo -! Read AREA from the supergrid + ! Read AREA from the supergrid tmpT(:,:) = 0. call MOM_read_data(filename, 'area', tmpT, SGdom) call pass_var(tmpT, SGdom) @@ -456,21 +394,17 @@ end subroutine set_grid_metrics_from_mosaic ! ------------------------------------------------------------------------------ +!> Calculate the values of the metric terms for a Cartesian grid that +!! might be used and save them in arrays. +!! +!! Within this subroutine, the x- and y- grid spacings and their +!! inverses and the cell areas centered on h, q, u, and v points are +!! calculated, as are the geographic locations of each of these 4 +!! sets of points. subroutine set_grid_metrics_cartesian(G, param_file) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file structure - -! Arguments: -! (inout) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. - -! Calculate the values of the metric terms for a Cartesian grid that -! might be used and save them in arrays. -! Within this subroutine, the x- and y- grid spacings and their -! inverses and the cell areas centered on h, q, u, and v points are -! calculated, as are the geographic locations of each of these 4 -! sets of points. + ! Local variables integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, I1off, J1off integer :: niglobal, njglobal real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB) @@ -593,21 +527,17 @@ end subroutine set_grid_metrics_cartesian ! ------------------------------------------------------------------------------ +!> Calculate the values of the metric terms that might be used +!! and save them in arrays. +!! +!! Within this subroutine, the x- and y- grid spacings and their +!! inverses and the cell areas centered on h, q, u, and v points are +!! calculated, as are the geographic locations of each of these 4 +!! sets of points. subroutine set_grid_metrics_spherical(G, param_file) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file structure - -! Arguments: -! (inout) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. - -! Calculate the values of the metric terms that might be used -! and save them in arrays. -! Within this subroutine, the x- and y- grid spacings and their -! inverses and the cell areas centered on h, q, u, and v points are -! calculated, as are the geographic locations of each of these 4 -! sets of points. + ! Local variables real :: PI, PI_180! PI = 3.1415926... as 4*atan(1) integer :: i, j, isd, ied, jsd, jed integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, IsdB, IedB, JsdB, JedB @@ -684,8 +614,8 @@ subroutine set_grid_metrics_spherical(G, param_file) G%geoLonBu(I,J) = grid_lonB(I) G%geoLatBu(I,J) = grid_latB(J) -! The following line is needed to reproduce the solution from -! set_grid_metrics_mercator when used to generate a simple spherical grid. + ! The following line is needed to reproduce the solution from + ! set_grid_metrics_mercator when used to generate a simple spherical grid. G%dxBu(I,J) = G%Rad_Earth * COS( G%geoLatBu(I,J)*PI_180 ) * dL_di ! G%dxBu(I,J) = G%Rad_Earth * dLon*PI_180 * COS( G%geoLatBu(I,J)*PI_180 ) G%dyBu(I,J) = G%Rad_Earth * dLat*PI_180 @@ -696,8 +626,8 @@ subroutine set_grid_metrics_spherical(G, param_file) G%geoLonCv(i,J) = grid_LonT(i) G%geoLatCv(i,J) = grid_latB(J) -! The following line is needed to reproduce the solution from -! set_grid_metrics_mercator when used to generate a simple spherical grid. + ! The following line is needed to reproduce the solution from + ! set_grid_metrics_mercator when used to generate a simple spherical grid. G%dxCv(i,J) = G%Rad_Earth * COS( G%geoLatCv(i,J)*PI_180 ) * dL_di ! G%dxCv(i,J) = G%Rad_Earth * (dLon*PI_180) * COS( G%geoLatCv(i,J)*PI_180 ) G%dyCv(i,J) = G%Rad_Earth * dLat*PI_180 @@ -707,8 +637,8 @@ subroutine set_grid_metrics_spherical(G, param_file) G%geoLonCu(I,j) = grid_lonB(I) G%geoLatCu(I,j) = grid_LatT(j) -! The following line is needed to reproduce the solution from -! set_grid_metrics_mercator when used to generate a simple spherical grid. + ! The following line is needed to reproduce the solution from + ! set_grid_metrics_mercator when used to generate a simple spherical grid. G%dxCu(I,j) = G%Rad_Earth * COS( G%geoLatCu(I,j)*PI_180 ) * dL_di ! G%dxCu(I,j) = G%Rad_Earth * dLon*PI_180 * COS( latitude ) G%dyCu(I,j) = G%Rad_Earth * dLat*PI_180 @@ -718,8 +648,8 @@ subroutine set_grid_metrics_spherical(G, param_file) G%geoLonT(i,j) = grid_LonT(i) G%geoLatT(i,j) = grid_LatT(j) -! The following line is needed to reproduce the solution from -! set_grid_metrics_mercator when used to generate a simple spherical grid. + ! The following line is needed to reproduce the solution from + ! set_grid_metrics_mercator when used to generate a simple spherical grid. G%dxT(i,j) = G%Rad_Earth * COS( G%geoLatT(i,j)*PI_180 ) * dL_di ! G%dxT(i,j) = G%Rad_Earth * dLon*PI_180 * COS( latitude ) G%dyT(i,j) = G%Rad_Earth * dLat*PI_180 @@ -733,36 +663,23 @@ subroutine set_grid_metrics_spherical(G, param_file) call callTree_leave("set_grid_metrics_spherical()") end subroutine set_grid_metrics_spherical -! ------------------------------------------------------------------------------ - +!> Calculate the values of the metric terms that might be used +!! and save them in arrays. +!! +!! Within this subroutine, the x- and y- grid spacings and their +!! inverses and the cell areas centered on h, q, u, and v points are +!! calculated, as are the geographic locations of each of these 4 +!! sets of points. subroutine set_grid_metrics_mercator(G, param_file) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file structure - -! Arguments: -! (inout) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. - -! Calculate the values of the metric terms that might be used -! and save them in arrays. -! Within this subroutine, the x- and y- grid spacings and their -! inverses and the cell areas centered on h, q, u, and v points are -! calculated, as are the geographic locations of each of these 4 -! sets of points. + ! Local variables integer :: i, j, isd, ied, jsd, jed integer :: I_off, J_off type(GPS) :: GP character(len=128) :: warnmesg character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_mercator" real :: PI, PI_2! PI = 3.1415926... as 4*atan(1), PI_2 = (PI) /2.0 - - -! All of the metric terms should be defined over the domain from -! isd to ied. Outside of the physical domain, both the metrics -! and their inverses may be set to zero. - -! The metric terms within the computational domain are set here. real :: y_q, y_h, jd, x_q, x_h, id real, dimension(G%isd:G%ied,G%jsd:G%jed) :: & xh, yh ! Latitude and longitude of h points in radians. @@ -779,6 +696,9 @@ subroutine set_grid_metrics_mercator(G, param_file) logical :: debug = .FALSE., simple_area = .true. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, IsdB, IedB, JsdB, JedB + ! All of the metric terms should be defined over the domain from + ! isd to ied. Outside of the physical domain, both the metrics + ! and their inverses may be set to zero. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -790,8 +710,8 @@ subroutine set_grid_metrics_mercator(G, param_file) call callTree_enter("set_grid_metrics_mercator(), MOM_grid_initialize.F90") -! Calculate the values of the metric terms that might be used -! and save them in arrays. + ! Calculate the values of the metric terms that might be used + ! and save them in arrays. PI = 4.0*atan(1.0) ; PI_2 = 0.5*PI call get_param(param_file, mdl, "SOUTHLAT", GP%south_lat, & @@ -833,19 +753,19 @@ subroutine set_grid_metrics_mercator(G, param_file) "over which the resolution is enhanced.", units="degrees", & default=0.0) -! With an isotropic grid, the north-south extent of the domain, -! the east-west extent, and the number of grid points in each -! direction are _not_ independent. Here the north-south extent -! will be determined to fit the east-west extent and the number of -! grid points. The grid is perfectly isotropic. + ! With an isotropic grid, the north-south extent of the domain, + ! the east-west extent, and the number of grid points in each + ! direction are _not_ independent. Here the north-south extent + ! will be determined to fit the east-west extent and the number of + ! grid points. The grid is perfectly isotropic. if (GP%equator_reference) then -! With the following expression, the equator will always be placed -! on either h or q points, in a position consistent with the ratio -! GP%south_lat to GP%len_lat. + ! With the following expression, the equator will always be placed + ! on either h or q points, in a position consistent with the ratio + ! GP%south_lat to GP%len_lat. jRef = (G%jsg-1) + 0.5*FLOOR(GP%njglobal*((-1.0*GP%south_lat*2.0)/GP%len_lat)+0.5) fnRef = Int_dj_dy(0.0, GP) else -! The following line sets the reference latitude GP%south_lat at j=js-1 (or -2?) + ! The following line sets the reference latitude GP%south_lat at j=js-1 (or -2?) jRef = (G%jsg-1) fnRef = Int_dj_dy((GP%south_lat*PI/180.0), GP) endif @@ -884,9 +804,9 @@ subroutine set_grid_metrics_mercator(G, param_file) endif enddo -! Determine the longitudes of the various points. + ! Determine the longitudes of the various points. -! These two lines place the western edge of the domain at GP%west_lon. + ! These two lines place the western edge of the domain at GP%west_lon. iRef = (G%isg-1) + GP%niglobal fnRef = Int_di_dx(((GP%west_lon+GP%len_lon)*PI/180.0), GP) @@ -983,13 +903,12 @@ function ds_di(x, y, GP) real, intent(in) :: y !< The latitude in question type(GPS), intent(in) :: GP !< A structure of grid parameters real :: ds_di -! This function returns the grid spacing in the logical x direction. -! Arguments: x - The latitude in question. -! (in) y - The longitude in question. + ! Local variables + ds_di = GP%Rad_Earth * cos(y) * dx_di(x,GP) -! In general, this might be... -! ds_di = GP%Rad_Earth * sqrt( cos(y)*cos(y) * dx_di(x,y,GP)*dx_di(x,y,GP) + & -! dy_di(x,y,GP)*dy_di(x,y,GP)) + ! In general, this might be... + ! ds_di = GP%Rad_Earth * sqrt( cos(y)*cos(y) * dx_di(x,y,GP)*dx_di(x,y,GP) + & + ! dy_di(x,y,GP)*dy_di(x,y,GP)) end function ds_di !> This function returns the grid spacing in the logical y direction. @@ -997,17 +916,15 @@ function ds_dj(x, y, GP) real, intent(in) :: x !< The longitude in question real, intent(in) :: y !< The latitude in question type(GPS), intent(in) :: GP !< A structure of grid parameters + ! Local variables real :: ds_dj -! This function returns the grid spacing in the logical y direction. -! Arguments: x - The latitude in question. -! (in) y - The longitude in question. + ds_dj = GP%Rad_Earth * dy_dj(y,GP) -! In general, this might be... -! ds_dj = GP%Rad_Earth * sqrt( cos(y)*cos(y) * dx_dj(x,y,GP)*dx_dj(x,y,GP) + & -! dy_dj(x,y,GP)*dy_dj(x,y,GP)) + ! In general, this might be... + ! ds_dj = GP%Rad_Earth * sqrt( cos(y)*cos(y) * dx_dj(x,y,GP)*dx_dj(x,y,GP) + & + ! dy_dj(x,y,GP)*dy_dj(x,y,GP)) end function ds_dj - !> This function returns the contribution from the line integral along one of the four sides of a !! cell face to the area of a cell, assuming that the sides follow a linear path in latitude and !! longitude (i.e., on a Mercator grid). @@ -1016,14 +933,8 @@ function dL(x1, x2, y1, y2) real, intent(in) :: x2 !< Segment ending longitude, in degrees E. real, intent(in) :: y1 !< Segment ending latitude, in degrees N. real, intent(in) :: y2 !< Segment ending latitude, in degrees N. + ! Local variables real :: dL -! This subroutine calculates the contribution from the line integral along one -! of the four sides of a cell face to the area of a cell, assuming that the -! sides follow a linear path in latitude and longitude (i.e., on a Mercator grid). -! Argumnts: x1 - Segment starting longitude. -! (in) x2 - Segment ending longitude. -! (in) y1 - Segment ending latitude. -! (in) y2 - Segment ending latitude. real :: r, dy dy = y2 - y1 @@ -1050,11 +961,7 @@ function find_root( fn, dy_df, GP, fnval, y1, ymin, ymax, ittmax) real, intent(in) :: ymin !< The minimum permitted value of y real, intent(in) :: ymax !< The maximum permitted value of y integer, intent(out) :: ittmax !< The number of iterations used to polish the root - -! This subroutine finds and returns the value of y at which the -! monotonically increasing function fn takes the value fnval, also returning -! in ittmax the number of iterations of Newton's method that were -! used to polish the root. + ! Local variables real :: y, y_next real :: ybot, ytop, fnbot, fntop integer :: itt @@ -1160,8 +1067,6 @@ function dx_di(x, GP) real, intent(in) :: x !< The longitude in question type(GPS), intent(in) :: GP !< A structure of grid parameters real :: dx_di -! This subroutine calculates and returns the value of dx/di, where -! x is the longitude in Radians, and i is the integral north-south grid index. dx_di = (GP%len_lon * 4.0*atan(1.0)) / (180.0 * GP%niglobal) @@ -1173,8 +1078,6 @@ function Int_di_dx(x, GP) real, intent(in) :: x !< The longitude in question type(GPS), intent(in) :: GP !< A structure of grid parameters real :: Int_di_dx -! This subroutine calculates and returns the integral of the inverse -! of dx/di to the point x, in radians. Int_di_dx = x * ((180.0 * GP%niglobal) / (GP%len_lon * 4.0*atan(1.0))) @@ -1186,9 +1089,7 @@ function dy_dj(y, GP) real, intent(in) :: y !< The latitude in question type(GPS), intent(in) :: GP !< A structure of grid parameters real :: dy_dj -! This subroutine calculates and returns the value of dy/dj, where -! y is the latitude in Radians, and j is the integral north-south -! grid index. + ! Local variables real :: PI ! 3.1415926... calculated as 4*atan(1) real :: C0 ! The constant that converts the nominal y-spacing in ! gridpoints to the nominal spacing in Radians. @@ -1217,8 +1118,7 @@ function Int_dj_dy(y, GP) real, intent(in) :: y !< The latitude in question type(GPS), intent(in) :: GP !< A structure of grid parameters real :: Int_dj_dy -! This subroutine calculates and returns the integral of the inverse -! of dy/dj to the point y, in radians. + ! Local variables real :: I_C0 = 0.0 ! The inverse of the constant that converts the ! nominal spacing in gridpoints to the nominal ! spacing in Radians. @@ -1256,13 +1156,12 @@ function Int_dj_dy(y, GP) Int_dj_dy = r end function Int_dj_dy -! ------------------------------------------------------------------------------ - -!> extrapolate_metric extrapolates missing metric data into all the halo regions. +!> Extrapolates missing metric data into all the halo regions. subroutine extrapolate_metric(var, jh, missing) real, dimension(:,:), intent(inout) :: var !< The array in which to fill in halos integer, intent(in) :: jh !< The size of the halos to be filled real, optional, intent(in) :: missing !< The missing data fill value, 0 by default. + ! Local variables real :: badval integer :: i,j @@ -1300,19 +1199,18 @@ function Adcroft_reciprocal(val) result(I_val) if (val /= 0.0) I_val = 1.0/val end function Adcroft_reciprocal -!> initialize_masks initializes the grid masks and any metrics that come -!! with masks already applied. +!> Initializes the grid masks and any metrics that come with masks already applied. +!! +!! Initialize_masks sets mask2dT, mask2dCu, mask2dCv, and mask2dBu to mask out +!! flow over any points which are shallower than Dmin and permit an +!! appropriate treatment of the boundary conditions. mask2dCu and mask2dCv +!! are 0.0 at any points adjacent to a land point. mask2dBu is 0.0 at +!! any land or boundary point. For points in the interior, mask2dCu, +!! mask2dCv, and mask2dBu are all 1.0. subroutine initialize_masks(G, PF) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: PF !< Parameter file structure - -! Initialize_masks sets mask2dT, mask2dCu, mask2dCv, and mask2dBu to mask out -! flow over any points which are shallower than Dmin and permit an -! appropriate treatment of the boundary conditions. mask2dCu and mask2dCv -! are 0.0 at any points adjacent to a land point. mask2dBu is 0.0 at -! any land or boundary point. For points in the interior, mask2dCu, -! mask2dCv, and mask2dBu are all 1.0. - + ! Local variables real :: Dmin, min_depth, mask_depth character(len=40) :: mdl = "MOM_grid_init initialize_masks" integer :: i, j @@ -1386,4 +1284,23 @@ subroutine initialize_masks(G, PF) call callTree_leave("initialize_masks()") end subroutine initialize_masks +!> \namespace mom_grid_initialize +!! +!! The metric terms have the form Dzp, IDzp, or DXDYp, where z can +!! be X or Y, and p can be q, u, v, or h. z describes the direction +!! of the metric, while p describes the location. IDzp is the +!! inverse of Dzp, while DXDYp is the product of DXp and DYp except +!! that areaT is calculated analytically from the latitudes and +!! longitudes of the surrounding q points. +!! +!! On a sphere, a variety of grids can be implemented by defining +!! analytic expressions for dx_di, dy_dj (where x and y are latitude +!! and longitude, and i and j are grid indices) and the expressions +!! for the integrals of their inverses in the four subroutines +!! dy_dj, Int_dj_dy, dx_di, and Int_di_dx. +!! +!! initialize_masks sets up land masks based on the depth field. +!! The one argument is the minimum ocean depth. Depths that are +!! less than this are interpreted as land points. + end module MOM_grid_initialize From af88e4bfc6bcc808b506db64b9a4d1cfc70e7581 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 15:27:04 -0400 Subject: [PATCH 0566/1072] Corrected indents in MOM_oda_driver.F90 MOM_oda_driver was using self-inconsistent indenting and 3-point indenting convention are at odds with other MOM6 code. This commit brings the file formatting of MOM_oda_driver.F90 closer to the rest of the MOM6 code. Only whitespace is changed, and all answers are bitwise identical. --- src/ocean_data_assim/MOM_oda_driver.F90 | 1036 +++++++++++------------ 1 file changed, 518 insertions(+), 518 deletions(-) diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 829c6d883d..17cc300bd2 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -2,550 +2,550 @@ module MOM_oda_driver_mod ! This file is part of MOM6. see LICENSE.md for the license. - use fms_mod, only : open_namelist_file, close_file, check_nml_error - use fms_mod, only : error_mesg, FATAL - use mpp_mod, only : stdout, stdlog, mpp_error, npes=>mpp_npes,pe=>mpp_pe - use mpp_mod, only : set_current_pelist => mpp_set_current_pelist - use mpp_mod, only : set_root_pe => mpp_set_root_pe - use mpp_mod, only : mpp_sync_self, mpp_sum, get_pelist=>mpp_get_current_pelist, mpp_root_pe - use mpp_mod, only : set_stack_size=>mpp_set_stack_size, broadcast=>mpp_broadcast - use mpp_io_mod, only : io_set_stack_size=>mpp_io_set_stack_size - use mpp_io_mod, only : MPP_SINGLE,MPP_MULTI - use mpp_domains_mod, only : domain2d, mpp_global_field - use mpp_domains_mod, only : mpp_get_compute_domain, mpp_get_data_domain - use mpp_domains_mod, only : mpp_redistribute, mpp_broadcast_domain - use mpp_domains_mod, only : set_domains_stack_size=>mpp_domains_set_stack_size - use diag_manager_mod, only : register_diag_field, diag_axis_init, send_data - use ensemble_manager_mod, only : get_ensemble_id, get_ensemble_size - use ensemble_manager_mod, only : get_ensemble_pelist, get_ensemble_filter_pelist - use time_manager_mod, only : time_type, decrement_time, increment_time - use time_manager_mod, only : get_date, get_time, operator(>=),operator(/=),operator(==),operator(<) - use constants_mod, only : radius, epsln - ! ODA Modules - use ocean_da_types_mod, only : grid_type, ocean_profile_type, ocean_control_struct - use ocean_da_core_mod, only : ocean_da_core_init, get_profiles - !use eakf_oda_mod, only : ensemble_filter - use write_ocean_obs_mod, only : open_profile_file - use write_ocean_obs_mod, only : write_profile,close_profile_file - use kdtree, only : kd_root !# JEDI - ! MOM Modules - use MOM_io, only : slasher, MOM_read_data - use MOM_diag_mediator, only : diag_ctrl, set_axes_info - use MOM_error_handler, only : FATAL, WARNING, MOM_error, MOM_mesg, is_root_pe - use MOM_get_input, only : get_MOM_input, directories - use MOM_variables, only : thermo_var_ptrs - use MOM_grid, only : ocean_grid_type, MOM_grid_init - use MOM_grid_initialize, only : set_grid_metrics - use MOM_hor_index, only : hor_index_type, hor_index_init - use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid - use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid - use MOM_fixed_initialization, only : MOM_initialize_fixed, MOM_initialize_topography - use MOM_coord_initialization, only : MOM_initialize_coord - use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit - use MOM_file_parser, only : read_param, get_param, param_file_type - use MOM_string_functions, only : lowercase - use MOM_ALE, only : ALE_CS, ALE_initThicknessToCoord, ALE_init, ALE_updateVerticalGridType - use MOM_domains, only : MOM_domains_init, MOM_domain_type, clone_MOM_domain - use MOM_remapping, only : remapping_CS, initialize_remapping, remapping_core_h - use MOM_regridding, only : regridding_CS, initialize_regridding - use MOM_regridding, only : regridding_main, set_regrid_params - - implicit none ; private - - public :: init_oda, oda_end, set_prior_tracer, get_posterior_tracer - public :: set_analysis_time, oda, save_obs_diff, apply_oda_tracer_increments +use fms_mod, only : open_namelist_file, close_file, check_nml_error +use fms_mod, only : error_mesg, FATAL +use mpp_mod, only : stdout, stdlog, mpp_error, npes=>mpp_npes,pe=>mpp_pe +use mpp_mod, only : set_current_pelist => mpp_set_current_pelist +use mpp_mod, only : set_root_pe => mpp_set_root_pe +use mpp_mod, only : mpp_sync_self, mpp_sum, get_pelist=>mpp_get_current_pelist, mpp_root_pe +use mpp_mod, only : set_stack_size=>mpp_set_stack_size, broadcast=>mpp_broadcast +use mpp_io_mod, only : io_set_stack_size=>mpp_io_set_stack_size +use mpp_io_mod, only : MPP_SINGLE,MPP_MULTI +use mpp_domains_mod, only : domain2d, mpp_global_field +use mpp_domains_mod, only : mpp_get_compute_domain, mpp_get_data_domain +use mpp_domains_mod, only : mpp_redistribute, mpp_broadcast_domain +use mpp_domains_mod, only : set_domains_stack_size=>mpp_domains_set_stack_size +use diag_manager_mod, only : register_diag_field, diag_axis_init, send_data +use ensemble_manager_mod, only : get_ensemble_id, get_ensemble_size +use ensemble_manager_mod, only : get_ensemble_pelist, get_ensemble_filter_pelist +use time_manager_mod, only : time_type, decrement_time, increment_time +use time_manager_mod, only : get_date, get_time, operator(>=),operator(/=),operator(==),operator(<) +use constants_mod, only : radius, epsln +! ODA Modules +use ocean_da_types_mod, only : grid_type, ocean_profile_type, ocean_control_struct +use ocean_da_core_mod, only : ocean_da_core_init, get_profiles +!use eakf_oda_mod, only : ensemble_filter +use write_ocean_obs_mod, only : open_profile_file +use write_ocean_obs_mod, only : write_profile,close_profile_file +use kdtree, only : kd_root !# JEDI +! MOM Modules +use MOM_io, only : slasher, MOM_read_data +use MOM_diag_mediator, only : diag_ctrl, set_axes_info +use MOM_error_handler, only : FATAL, WARNING, MOM_error, MOM_mesg, is_root_pe +use MOM_get_input, only : get_MOM_input, directories +use MOM_variables, only : thermo_var_ptrs +use MOM_grid, only : ocean_grid_type, MOM_grid_init +use MOM_grid_initialize, only : set_grid_metrics +use MOM_hor_index, only : hor_index_type, hor_index_init +use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid +use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid +use MOM_fixed_initialization, only : MOM_initialize_fixed, MOM_initialize_topography +use MOM_coord_initialization, only : MOM_initialize_coord +use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit +use MOM_file_parser, only : read_param, get_param, param_file_type +use MOM_string_functions, only : lowercase +use MOM_ALE, only : ALE_CS, ALE_initThicknessToCoord, ALE_init, ALE_updateVerticalGridType +use MOM_domains, only : MOM_domains_init, MOM_domain_type, clone_MOM_domain +use MOM_remapping, only : remapping_CS, initialize_remapping, remapping_core_h +use MOM_regridding, only : regridding_CS, initialize_regridding +use MOM_regridding, only : regridding_main, set_regrid_params + +implicit none ; private + +public :: init_oda, oda_end, set_prior_tracer, get_posterior_tracer +public :: set_analysis_time, oda, save_obs_diff, apply_oda_tracer_increments #include - !> Control structure that contains a transpose of the ocean state across ensemble members. - type, public :: ODA_CS ; private - type(ocean_control_struct), pointer :: Ocean_prior=> NULL() !< ensemble ocean prior states in DA space - type(ocean_control_struct), pointer :: Ocean_posterior=> NULL() !< ensemble ocean posterior states - !! or increments to prior in DA space - integer :: nk !< number of vertical layers used for DA - type(ocean_grid_type), pointer :: Grid => NULL() !< MOM6 grid type and decomposition for the DA - type(ptr_mpp_domain), pointer, dimension(:) :: domains => NULL() !< Pointer to mpp_domain objects - !! for ensemble members - type(verticalGrid_type), pointer :: GV => NULL() !< vertical grid for DA - type(domain2d), pointer :: mpp_domain => NULL() !< Pointer to a mpp domain object for DA - type(grid_type), pointer :: oda_grid !< local tracer grid - real, pointer, dimension(:,:,:) :: h => NULL() ! NULL() !< pointer to thermodynamic variables - integer :: ni !< global i-direction grid size - integer :: nj !< global j-direction grid size - logical :: reentrant_x !< grid is reentrant in the x direction - logical :: reentrant_y !< grid is reentrant in the y direction - logical :: tripolar_N !< grid is folded at its north edge - logical :: symmetric !< Values at C-grid locations are symmetric - integer :: assim_method !< Method: NO_ASSIM,EAKF_ASSIM or OI_ASSIM - integer :: ensemble_size !< Size of the ensemble - integer :: ensemble_id = 0 !< id of the current ensemble member - integer, pointer, dimension(:,:) :: ensemble_pelist !< PE list for ensemble members - integer, pointer, dimension(:) :: filter_pelist !< PE list for ensemble members - integer :: assim_frequency !< analysis interval in hours - ! Profiles local to the analysis domain - type(ocean_profile_type), pointer :: Profiles => NULL() !< pointer to linked list of all available profiles - type(ocean_profile_type), pointer :: CProfiles => NULL()!< pointer to linked list of current profiles - type(kd_root), pointer :: kdroot => NULL() !< A structure for storing nearest neighbors - type(ALE_CS), pointer :: ALE_CS=>NULL() !< ALE control structure for DA - logical :: use_ALE_algorithm !< true is using ALE remapping - type(regridding_CS) :: regridCS !< ALE control structure for regridding - type(remapping_CS) :: remapCS !< ALE control structure for remapping - type(time_type) :: Time !< Current Analysis time - type(diag_ctrl) :: diag_cs ! A structure with a pointer to a domain2d, to allow for the creation of arrays of pointers. - type :: ptr_mpp_domain - type(domain2d), pointer :: mpp_domain => NULL() !< pointer to an mpp domain2d - end type ptr_mpp_domain - - !>@{ DA parameters - integer, parameter :: NO_ASSIM = 0, OI_ASSIM=1, EAKF_ASSIM=2 - !!@} +!> Control structure that contains a transpose of the ocean state across ensemble members. +type, public :: ODA_CS ; private + type(ocean_control_struct), pointer :: Ocean_prior=> NULL() !< ensemble ocean prior states in DA space + type(ocean_control_struct), pointer :: Ocean_posterior=> NULL() !< ensemble ocean posterior states + !! or increments to prior in DA space + integer :: nk !< number of vertical layers used for DA + type(ocean_grid_type), pointer :: Grid => NULL() !< MOM6 grid type and decomposition for the DA + type(ptr_mpp_domain), pointer, dimension(:) :: domains => NULL() !< Pointer to mpp_domain objects + !! for ensemble members + type(verticalGrid_type), pointer :: GV => NULL() !< vertical grid for DA + type(domain2d), pointer :: mpp_domain => NULL() !< Pointer to a mpp domain object for DA + type(grid_type), pointer :: oda_grid !< local tracer grid + real, pointer, dimension(:,:,:) :: h => NULL() ! NULL() !< pointer to thermodynamic variables + integer :: ni !< global i-direction grid size + integer :: nj !< global j-direction grid size + logical :: reentrant_x !< grid is reentrant in the x direction + logical :: reentrant_y !< grid is reentrant in the y direction + logical :: tripolar_N !< grid is folded at its north edge + logical :: symmetric !< Values at C-grid locations are symmetric + integer :: assim_method !< Method: NO_ASSIM,EAKF_ASSIM or OI_ASSIM + integer :: ensemble_size !< Size of the ensemble + integer :: ensemble_id = 0 !< id of the current ensemble member + integer, pointer, dimension(:,:) :: ensemble_pelist !< PE list for ensemble members + integer, pointer, dimension(:) :: filter_pelist !< PE list for ensemble members + integer :: assim_frequency !< analysis interval in hours + ! Profiles local to the analysis domain + type(ocean_profile_type), pointer :: Profiles => NULL() !< pointer to linked list of all available profiles + type(ocean_profile_type), pointer :: CProfiles => NULL()!< pointer to linked list of current profiles + type(kd_root), pointer :: kdroot => NULL() !< A structure for storing nearest neighbors + type(ALE_CS), pointer :: ALE_CS=>NULL() !< ALE control structure for DA + logical :: use_ALE_algorithm !< true is using ALE remapping + type(regridding_CS) :: regridCS !< ALE control structure for regridding + type(remapping_CS) :: remapCS !< ALE control structure for remapping + type(time_type) :: Time !< Current Analysis time + type(diag_ctrl) :: diag_cs ! A structure with a pointer to a domain2d, to allow for the creation of arrays of pointers. +type :: ptr_mpp_domain + type(domain2d), pointer :: mpp_domain => NULL() !< pointer to an mpp domain2d +end type ptr_mpp_domain + +!>@{ DA parameters +integer, parameter :: NO_ASSIM = 0, OI_ASSIM=1, EAKF_ASSIM=2 +!!@} contains !> initialize First_guess (prior) and Analysis grid !! information for all ensemble members - subroutine init_oda(Time, G, GV, CS) - - type(time_type), intent(in) :: Time !< The current model time. - type(ocean_grid_type), pointer :: G !< domain and grid information for ocean model - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(ODA_CS), pointer, intent(inout) :: CS !< The DA control structure - - ! Local variables - type(thermo_var_ptrs) :: tv_dummy - type(dyn_horgrid_type), pointer :: dG=> NULL() - type(hor_index_type), pointer :: HI=> NULL() - type(directories) :: dirs - - type(grid_type), pointer :: T_grid !< global tracer grid - real, dimension(:,:), allocatable :: global2D, global2D_old - real, dimension(:), allocatable :: lon1D, lat1D, glon1D, glat1D - type(param_file_type) :: PF - integer :: n, m, k, i, j, nk - integer :: is,ie,js,je,isd,ied,jsd,jed - integer :: stdout_unit - character(len=32) :: assim_method - integer :: npes_pm, ens_info(6), ni, nj - character(len=128) :: mesg - character(len=32) :: fldnam - character(len=30) :: coord_mode - character(len=200) :: inputdir, basin_file - logical :: reentrant_x, reentrant_y, tripolar_N, symmetric - - if (associated(CS)) call mpp_error(FATAL,'Calling oda_init with associated control structure') - allocate(CS) +subroutine init_oda(Time, G, GV, CS) + + type(time_type), intent(in) :: Time !< The current model time. + type(ocean_grid_type), pointer :: G !< domain and grid information for ocean model + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(ODA_CS), pointer, intent(inout) :: CS !< The DA control structure + +! Local variables + type(thermo_var_ptrs) :: tv_dummy + type(dyn_horgrid_type), pointer :: dG=> NULL() + type(hor_index_type), pointer :: HI=> NULL() + type(directories) :: dirs + + type(grid_type), pointer :: T_grid !< global tracer grid + real, dimension(:,:), allocatable :: global2D, global2D_old + real, dimension(:), allocatable :: lon1D, lat1D, glon1D, glat1D + type(param_file_type) :: PF + integer :: n, m, k, i, j, nk + integer :: is,ie,js,je,isd,ied,jsd,jed + integer :: stdout_unit + character(len=32) :: assim_method + integer :: npes_pm, ens_info(6), ni, nj + character(len=128) :: mesg + character(len=32) :: fldnam + character(len=30) :: coord_mode + character(len=200) :: inputdir, basin_file + logical :: reentrant_x, reentrant_y, tripolar_N, symmetric + + if (associated(CS)) call mpp_error(FATAL,'Calling oda_init with associated control structure') + allocate(CS) ! Use ens1 parameters , this could be changed at a later time ! if it were desirable to have alternate parameters, e.g. for the grid ! for the analysis - call get_MOM_input(PF,dirs,ensemble_num=0) - call get_param(PF, "MOM", "ASSIM_METHOD", assim_method, & - "String which determines the data assimilation method" // & - "Valid methods are: \'EAKF\',\'OI\', and \'NO_ASSIM\'", default='NO_ASSIM') - call get_param(PF, "MOM", "ASSIM_FREQUENCY", CS%assim_frequency, & - "data assimilation frequency in hours") - call get_param(PF, "MOM", "USE_REGRIDDING", CS%use_ALE_algorithm , & - "If True, use the ALE algorithm (regridding/remapping).\n"//& - "If False, use the layered isopycnal algorithm.", default=.false. ) - call get_param(PF, "MOM", "REENTRANT_X", CS%reentrant_x, & - "If true, the domain is zonally reentrant.", default=.true.) - call get_param(PF, "MOM", "REENTRANT_Y", CS%reentrant_y, & - "If true, the domain is meridionally reentrant.", & - default=.false.) - call get_param(PF,"MOM", "TRIPOLAR_N", CS%tripolar_N, & - "Use tripolar connectivity at the northern edge of the \n"//& - "domain. With TRIPOLAR_N, NIGLOBAL must be even.", & - default=.false.) - call get_param(PF,"MOM", "NIGLOBAL", CS%ni, & - "The total number of thickness grid points in the \n"//& - "x-direction in the physical domain.") - call get_param(PF,"MOM", "NJGLOBAL", CS%nj, & - "The total number of thickness grid points in the \n"//& - "y-direction in the physical domain.") - call get_param(PF, 'MOM', "INPUTDIR", inputdir) - inputdir = slasher(inputdir) - - select case(lowercase(trim(assim_method))) - case('eakf') - CS%assim_method = EAKF_ASSIM - case('oi') - CS%assim_method = OI_ASSIM - case('no_assim') - CS%assim_method = NO_ASSIM - case default - call mpp_error(FATAL,'Invalid assimilation method provided') - end select - - ens_info = get_ensemble_size() - CS%ensemble_size = ens_info(1) - npes_pm=ens_info(3) - CS%ensemble_id = get_ensemble_id() - !! Switch to global pelist - allocate(CS%ensemble_pelist(CS%ensemble_size,npes_pm)) - allocate(CS%filter_pelist(CS%ensemble_size*npes_pm)) - call get_ensemble_pelist(CS%ensemble_pelist,'ocean') - call get_ensemble_filter_pelist(CS%filter_pelist,'ocean') - - call set_current_pelist(CS%filter_pelist) - - allocate(CS%domains(CS%ensemble_size)) - CS%domains(CS%ensemble_id)%mpp_domain => G%Domain%mpp_domain - do n=1,CS%ensemble_size - if (.not. associated(CS%domains(n)%mpp_domain)) allocate(CS%domains(n)%mpp_domain) - call set_root_pe(CS%ensemble_pelist(n,1)) - call mpp_broadcast_domain(CS%domains(n)%mpp_domain) - enddo - call set_root_pe(CS%filter_pelist(1)) - allocate(CS%Grid) - ! params NIHALO_ODA, NJHALO_ODA set the DA halo size - call MOM_domains_init(CS%Grid%Domain,PF,param_suffix='_ODA') - allocate(HI) - call hor_index_init(CS%Grid%Domain, HI, PF, & - local_indexing=.false.) ! Use global indexing for DA - call verticalGridInit( PF, CS%GV ) - allocate(dG) - call create_dyn_horgrid(dG,HI) - call clone_MOM_domain(CS%Grid%Domain, dG%Domain,symmetric=.false.) - call set_grid_metrics(dG,PF) - call MOM_initialize_topography(dg%bathyT,dG%max_depth,dG,PF) - call MOM_initialize_coord(CS%GV, PF, .false., & - dirs%output_directory, tv_dummy, dG%max_depth) - call ALE_init(PF, CS%GV, dG%max_depth, CS%ALE_CS) - call MOM_grid_init(CS%Grid, PF, global_indexing=.true.) - call ALE_updateVerticalGridType(CS%ALE_CS,CS%GV) - call copy_dyngrid_to_MOM_grid(dG, CS%Grid) - CS%mpp_domain => CS%Grid%Domain%mpp_domain - CS%Grid%ke = CS%GV%ke - CS%nk = CS%GV%ke - ! initialize storage for prior and posterior - allocate(CS%Ocean_prior) - call init_ocean_ensemble(CS%Ocean_prior,CS%Grid,CS%GV,CS%ensemble_size) - allocate(CS%Ocean_posterior) - call init_ocean_ensemble(CS%Ocean_posterior,CS%Grid,CS%GV,CS%ensemble_size) - allocate(CS%tv) - - call get_param(PF, 'oda_driver', "REGRIDDING_COORDINATE_MODE", coord_mode, & - "Coordinate mode for vertical regridding.", & - default="ZSTAR", fail_if_missing=.false.) - call initialize_regridding(CS%regridCS, CS%GV, dG%max_depth,PF,'oda_driver',coord_mode,'','') - call initialize_remapping(CS%remapCS,'PLM') - call set_regrid_params(CS%regridCS, min_thickness=0.) - call mpp_get_data_domain(G%Domain%mpp_domain,isd,ied,jsd,jed) - if (.not. associated(CS%h)) then - allocate(CS%h(isd:ied,jsd:jed,CS%GV%ke)); CS%h(:,:,:)=0.0 -! assign thicknesses - call ALE_initThicknessToCoord(CS%ALE_CS,G,CS%GV,CS%h) - endif - allocate(CS%tv%T(isd:ied,jsd:jed,CS%GV%ke)); CS%tv%T(:,:,:)=0.0 - allocate(CS%tv%S(isd:ied,jsd:jed,CS%GV%ke)); CS%tv%S(:,:,:)=0.0 - - call set_axes_info(CS%Grid,CS%GV,PF,CS%diag_cs,set_vertical=.true.) - do n=1,CS%ensemble_size - write(fldnam,'(a,i2.2)') 'temp_prior_',n - CS%Ocean_prior%id_t(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & - 'ocean potential temperature','degC') - write(fldnam,'(a,i2.2)') 'salt_prior_',n - CS%Ocean_prior%id_s(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & - 'ocean salinity','psu') - write(fldnam,'(a,i2.2)') 'temp_posterior_',n - CS%Ocean_posterior%id_t(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & - 'ocean potential temperature','degC') - write(fldnam,'(a,i2.2)') 'salt_posterior_',n - CS%Ocean_posterior%id_s(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & - 'ocean salinity','psu') - enddo - - call mpp_get_data_domain(CS%mpp_domain,isd,ied,jsd,jed) - allocate(CS%oda_grid) - CS%oda_grid%x => CS%Grid%geolonT - CS%oda_grid%y => CS%Grid%geolatT - - call get_param(PF, 'oda_driver', "BASIN_FILE", basin_file, & - "A file in which to find the basin masks, in variable 'basin'.", & - default="basin.nc") - basin_file = trim(inputdir) // trim(basin_file) - allocate(CS%oda_grid%basin_mask(isd:ied,jsd:jed)) - CS%oda_grid%basin_mask(:,:) = 0.0 - call MOM_read_data(basin_file,'basin',CS%oda_grid%basin_mask,CS%Grid%domain, timelevel=1) + call get_MOM_input(PF,dirs,ensemble_num=0) + call get_param(PF, "MOM", "ASSIM_METHOD", assim_method, & + "String which determines the data assimilation method" // & + "Valid methods are: \'EAKF\',\'OI\', and \'NO_ASSIM\'", default='NO_ASSIM') + call get_param(PF, "MOM", "ASSIM_FREQUENCY", CS%assim_frequency, & + "data assimilation frequency in hours") + call get_param(PF, "MOM", "USE_REGRIDDING", CS%use_ALE_algorithm , & + "If True, use the ALE algorithm (regridding/remapping).\n"//& + "If False, use the layered isopycnal algorithm.", default=.false. ) + call get_param(PF, "MOM", "REENTRANT_X", CS%reentrant_x, & + "If true, the domain is zonally reentrant.", default=.true.) + call get_param(PF, "MOM", "REENTRANT_Y", CS%reentrant_y, & + "If true, the domain is meridionally reentrant.", & + default=.false.) + call get_param(PF,"MOM", "TRIPOLAR_N", CS%tripolar_N, & + "Use tripolar connectivity at the northern edge of the \n"//& + "domain. With TRIPOLAR_N, NIGLOBAL must be even.", & + default=.false.) + call get_param(PF,"MOM", "NIGLOBAL", CS%ni, & + "The total number of thickness grid points in the \n"//& + "x-direction in the physical domain.") + call get_param(PF,"MOM", "NJGLOBAL", CS%nj, & + "The total number of thickness grid points in the \n"//& + "y-direction in the physical domain.") + call get_param(PF, 'MOM', "INPUTDIR", inputdir) + inputdir = slasher(inputdir) + + select case(lowercase(trim(assim_method))) + case('eakf') + CS%assim_method = EAKF_ASSIM + case('oi') + CS%assim_method = OI_ASSIM + case('no_assim') + CS%assim_method = NO_ASSIM + case default + call mpp_error(FATAL,'Invalid assimilation method provided') + end select + + ens_info = get_ensemble_size() + CS%ensemble_size = ens_info(1) + npes_pm=ens_info(3) + CS%ensemble_id = get_ensemble_id() + !! Switch to global pelist + allocate(CS%ensemble_pelist(CS%ensemble_size,npes_pm)) + allocate(CS%filter_pelist(CS%ensemble_size*npes_pm)) + call get_ensemble_pelist(CS%ensemble_pelist,'ocean') + call get_ensemble_filter_pelist(CS%filter_pelist,'ocean') + + call set_current_pelist(CS%filter_pelist) + + allocate(CS%domains(CS%ensemble_size)) + CS%domains(CS%ensemble_id)%mpp_domain => G%Domain%mpp_domain + do n=1,CS%ensemble_size + if (.not. associated(CS%domains(n)%mpp_domain)) allocate(CS%domains(n)%mpp_domain) + call set_root_pe(CS%ensemble_pelist(n,1)) + call mpp_broadcast_domain(CS%domains(n)%mpp_domain) + enddo + call set_root_pe(CS%filter_pelist(1)) + allocate(CS%Grid) + ! params NIHALO_ODA, NJHALO_ODA set the DA halo size + call MOM_domains_init(CS%Grid%Domain,PF,param_suffix='_ODA') + allocate(HI) + call hor_index_init(CS%Grid%Domain, HI, PF, & + local_indexing=.false.) ! Use global indexing for DA + call verticalGridInit( PF, CS%GV ) + allocate(dG) + call create_dyn_horgrid(dG,HI) + call clone_MOM_domain(CS%Grid%Domain, dG%Domain,symmetric=.false.) + call set_grid_metrics(dG,PF) + call MOM_initialize_topography(dg%bathyT,dG%max_depth,dG,PF) + call MOM_initialize_coord(CS%GV, PF, .false., & + dirs%output_directory, tv_dummy, dG%max_depth) + call ALE_init(PF, CS%GV, dG%max_depth, CS%ALE_CS) + call MOM_grid_init(CS%Grid, PF, global_indexing=.true.) + call ALE_updateVerticalGridType(CS%ALE_CS,CS%GV) + call copy_dyngrid_to_MOM_grid(dG, CS%Grid) + CS%mpp_domain => CS%Grid%Domain%mpp_domain + CS%Grid%ke = CS%GV%ke + CS%nk = CS%GV%ke + ! initialize storage for prior and posterior + allocate(CS%Ocean_prior) + call init_ocean_ensemble(CS%Ocean_prior,CS%Grid,CS%GV,CS%ensemble_size) + allocate(CS%Ocean_posterior) + call init_ocean_ensemble(CS%Ocean_posterior,CS%Grid,CS%GV,CS%ensemble_size) + allocate(CS%tv) + + call get_param(PF, 'oda_driver', "REGRIDDING_COORDINATE_MODE", coord_mode, & + "Coordinate mode for vertical regridding.", & + default="ZSTAR", fail_if_missing=.false.) + call initialize_regridding(CS%regridCS, CS%GV, dG%max_depth,PF,'oda_driver',coord_mode,'','') + call initialize_remapping(CS%remapCS,'PLM') + call set_regrid_params(CS%regridCS, min_thickness=0.) + call mpp_get_data_domain(G%Domain%mpp_domain,isd,ied,jsd,jed) + if (.not. associated(CS%h)) then + allocate(CS%h(isd:ied,jsd:jed,CS%GV%ke)); CS%h(:,:,:)=0.0 + ! assign thicknesses + call ALE_initThicknessToCoord(CS%ALE_CS,G,CS%GV,CS%h) + endif + allocate(CS%tv%T(isd:ied,jsd:jed,CS%GV%ke)); CS%tv%T(:,:,:)=0.0 + allocate(CS%tv%S(isd:ied,jsd:jed,CS%GV%ke)); CS%tv%S(:,:,:)=0.0 + + call set_axes_info(CS%Grid,CS%GV,PF,CS%diag_cs,set_vertical=.true.) + do n=1,CS%ensemble_size + write(fldnam,'(a,i2.2)') 'temp_prior_',n + CS%Ocean_prior%id_t(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & + 'ocean potential temperature','degC') + write(fldnam,'(a,i2.2)') 'salt_prior_',n + CS%Ocean_prior%id_s(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & + 'ocean salinity','psu') + write(fldnam,'(a,i2.2)') 'temp_posterior_',n + CS%Ocean_posterior%id_t(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & + 'ocean potential temperature','degC') + write(fldnam,'(a,i2.2)') 'salt_posterior_',n + CS%Ocean_posterior%id_s(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & + 'ocean salinity','psu') + enddo + + call mpp_get_data_domain(CS%mpp_domain,isd,ied,jsd,jed) + allocate(CS%oda_grid) + CS%oda_grid%x => CS%Grid%geolonT + CS%oda_grid%y => CS%Grid%geolatT + + call get_param(PF, 'oda_driver', "BASIN_FILE", basin_file, & + "A file in which to find the basin masks, in variable 'basin'.", & + default="basin.nc") + basin_file = trim(inputdir) // trim(basin_file) + allocate(CS%oda_grid%basin_mask(isd:ied,jsd:jed)) + CS%oda_grid%basin_mask(:,:) = 0.0 + call MOM_read_data(basin_file,'basin',CS%oda_grid%basin_mask,CS%Grid%domain, timelevel=1) ! get global grid information from ocean_model - allocate(T_grid) - allocate(T_grid%x(CS%ni,CS%nj)) - allocate(T_grid%y(CS%ni,CS%nj)) - allocate(T_grid%basin_mask(CS%ni,CS%nj)) - call mpp_global_field(CS%mpp_domain, CS%Grid%geolonT, T_grid%x) - call mpp_global_field(CS%mpp_domain, CS%Grid%geolatT, T_grid%y) - call mpp_global_field(CS%mpp_domain, CS%oda_grid%basin_mask, T_grid%basin_mask) - T_grid%ni = CS%ni - T_grid%nj = CS%nj - T_grid%nk = CS%nk - allocate(T_grid%mask(CS%ni,CS%nj,CS%nk)) - allocate(T_grid%z(CS%ni,CS%nj,CS%nk)) - allocate(global2D(CS%ni,CS%nj)) - allocate(global2D_old(CS%ni,CS%nj)) - T_grid%mask(:,:,:) = 0.0 - T_grid%z(:,:,:) = 0.0 - - do k = 1, CS%nk - call mpp_global_field(G%Domain%mpp_domain, CS%h(:,:,k), global2D) - do i=1, CS%ni; do j=1, CS%nj - if ( global2D(i,j) > 1 ) then - T_grid%mask(i,j,k) = 1.0 - endif - enddo ; enddo - if (k == 1) then - T_grid%z(:,:,k) = global2D/2 - else - T_grid%z(:,:,k) = T_grid%z(:,:,k-1) + (global2D + global2D_old)/2 - endif - global2D_old = global2D - enddo - - call ocean_da_core_init(CS%mpp_domain, T_grid, CS%Profiles, Time) - - CS%Time=Time - !! switch back to ensemble member pelist - call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:)) - end subroutine init_oda - - !> Copy ensemble member tracers to ensemble vector. - subroutine set_prior_tracer(Time, G, GV, h, tv, CS) - type(time_type), intent(in) :: Time !< The current model time - type(ocean_grid_type), pointer :: G !< domain and grid information for ocean model - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - - type(ODA_CS), pointer :: CS !< ocean DA control structure - real, dimension(:,:,:), allocatable :: T, S - type(ocean_grid_type), pointer :: Grid=>NULL() - integer :: i,j, m, n, ss - integer :: is, ie, js, je - integer :: isc, iec, jsc, jec - integer :: isd, ied, jsd, jed - integer :: id - logical :: used - - ! return if not time for analysis - if (Time < CS%Time) return - - if (.not. associated(CS%Grid)) call MOM_ERROR(FATAL,'ODA_CS ensemble horizontal grid not associated') - if (.not. associated(CS%GV)) call MOM_ERROR(FATAL,'ODA_CS ensemble vertical grid not associated') - - !! switch to global pelist - call set_current_pelist(CS%filter_pelist) - call MOM_mesg('Setting prior') - - isc=CS%Grid%isc;iec=CS%Grid%iec;jsc=CS%Grid%jsc;jec=CS%Grid%jec - call mpp_get_compute_domain(CS%domains(CS%ensemble_id)%mpp_domain,is,ie,js,je) - call mpp_get_data_domain(CS%domains(CS%ensemble_id)%mpp_domain,isd,ied,jsd,jed) - allocate(T(isd:ied,jsd:jed,CS%nk)) - allocate(S(isd:ied,jsd:jed,CS%nk)) - - do j=js,je; do i=is,ie - call remapping_core_h(CS%remapCS, GV%ke, h(i,j,:), tv%T(i,j,:), & - CS%nk, CS%h(i,j,:), T(i,j,:)) - call remapping_core_h(CS%remapCS, GV%ke, h(i,j,:), tv%S(i,j,:), & - CS%nk, CS%h(i,j,:), S(i,j,:)) + allocate(T_grid) + allocate(T_grid%x(CS%ni,CS%nj)) + allocate(T_grid%y(CS%ni,CS%nj)) + allocate(T_grid%basin_mask(CS%ni,CS%nj)) + call mpp_global_field(CS%mpp_domain, CS%Grid%geolonT, T_grid%x) + call mpp_global_field(CS%mpp_domain, CS%Grid%geolatT, T_grid%y) + call mpp_global_field(CS%mpp_domain, CS%oda_grid%basin_mask, T_grid%basin_mask) + T_grid%ni = CS%ni + T_grid%nj = CS%nj + T_grid%nk = CS%nk + allocate(T_grid%mask(CS%ni,CS%nj,CS%nk)) + allocate(T_grid%z(CS%ni,CS%nj,CS%nk)) + allocate(global2D(CS%ni,CS%nj)) + allocate(global2D_old(CS%ni,CS%nj)) + T_grid%mask(:,:,:) = 0.0 + T_grid%z(:,:,:) = 0.0 + + do k = 1, CS%nk + call mpp_global_field(G%Domain%mpp_domain, CS%h(:,:,k), global2D) + do i=1, CS%ni; do j=1, CS%nj + if ( global2D(i,j) > 1 ) then + T_grid%mask(i,j,k) = 1.0 + endif enddo ; enddo - - do m=1,CS%ensemble_size - call mpp_redistribute(CS%domains(m)%mpp_domain, T,& - CS%mpp_domain, CS%Ocean_prior%T(:,:,:,m), complete=.true.) - call mpp_redistribute(CS%domains(m)%mpp_domain, S,& - CS%mpp_domain, CS%Ocean_prior%S(:,:,:,m), complete=.true.) - if (CS%Ocean_prior%id_t(m)>0) & - used=send_data(CS%Ocean_prior%id_t(m), CS%Ocean_prior%T(isc:iec,jsc:jec,:,m), CS%Time) - if (CS%Ocean_prior%id_s(m)>0) & - used=send_data(CS%Ocean_prior%id_s(m), CS%Ocean_prior%S(isc:iec,jsc:jec,:,m), CS%Time) - enddo - deallocate(T,S) - - !! switch back to ensemble member pelist - call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:)) - - return - - end subroutine set_prior_tracer - - !> Returns posterior adjustments or full state - !!Note that only those PEs associated with an ensemble member receive data - subroutine get_posterior_tracer(Time, CS, h, tv, increment) - type(time_type), intent(in) :: Time !< the current model time - type(ODA_CS), pointer :: CS !< ocean DA control structure - real, dimension(:,:,:), pointer :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), pointer :: tv !< A structure pointing to various thermodynamic variables - logical, optional, intent(in) :: increment !< True if returning increment only - - type(ocean_control_struct), pointer :: Ocean_increment=>NULL() - integer :: i, j, m - logical :: used, get_inc - - ! return if not analysis time (retain pointers for h and tv) - if (Time < CS%Time) return - - - !! switch to global pelist - call set_current_pelist(CS%filter_pelist) - call MOM_mesg('Getting posterior') - - get_inc = .true. - if (present(increment)) get_inc = increment - - if (get_inc) then - allocate(Ocean_increment) - call init_ocean_ensemble(Ocean_increment,CS%Grid,CS%GV,CS%ensemble_size) - Ocean_increment%T = CS%Ocean_posterior%T - CS%Ocean_prior%T - Ocean_increment%S = CS%Ocean_posterior%S - CS%Ocean_prior%S - endif - do m=1,CS%ensemble_size - if (get_inc) then - call mpp_redistribute(CS%mpp_domain, Ocean_increment%T(:,:,:,m), & - CS%domains(m)%mpp_domain, CS%tv%T, complete=.true.) - call mpp_redistribute(CS%mpp_domain, Ocean_increment%S(:,:,:,m), & - CS%domains(m)%mpp_domain, CS%tv%S, complete=.true.) - else - call mpp_redistribute(CS%mpp_domain, CS%Ocean_posterior%T(:,:,:,m), & - CS%domains(m)%mpp_domain, CS%tv%T, complete=.true.) - call mpp_redistribute(CS%mpp_domain, CS%Ocean_posterior%S(:,:,:,m), & - CS%domains(m)%mpp_domain, CS%tv%S, complete=.true.) - endif - enddo - - tv => CS%tv - h => CS%h - !! switch back to ensemble member pelist - call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:)) - - end subroutine get_posterior_tracer - - !> Gather observations and sall ODA routines - subroutine oda(Time, CS) - type(time_type), intent(in) :: Time !< the current model time - type(oda_CS), intent(inout) :: CS !< the ocean DA control structure - - integer :: i, j - integer :: m - integer :: yr, mon, day, hr, min, sec - - if ( Time >= CS%Time ) then - - !! switch to global pelist - call set_current_pelist(CS%filter_pelist) - - call get_profiles(Time, CS%Profiles, CS%CProfiles) -#ifdef ENABLE_ECDA - call ensemble_filter(CS%Ocean_prior, CS%Ocean_posterior, CS%CProfiles, CS%kdroot, CS%mpp_domain, CS%oda_grid) -#endif - - !! switch back to ensemble member pelist - call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:)) - - endif - - return - end subroutine oda - - !> Finalize DA module - subroutine oda_end(CS) - type(ODA_CS), intent(inout) :: CS !< the ocean DA control structure - - end subroutine oda_end - - !> Initialize DA module - subroutine init_ocean_ensemble(CS,Grid,GV,ens_size) - type(ocean_control_struct), pointer :: CS !< Pointer to ODA control structure - type(ocean_grid_type), pointer :: Grid !< Pointer to ocean analysis grid - type(verticalGrid_type), pointer :: GV !< Pointer to DA vertical grid - integer, intent(in) :: ens_size !< ensemble size - - integer :: n,is,ie,js,je,nk - - nk=GV%ke - is=Grid%isd;ie=Grid%ied - js=Grid%jsd;je=Grid%jed - CS%ensemble_size=ens_size - allocate(CS%T(is:ie,js:je,nk,ens_size)) - allocate(CS%S(is:ie,js:je,nk,ens_size)) - allocate(CS%SSH(is:ie,js:je,ens_size)) - allocate(CS%id_t(ens_size));CS%id_t(:)=-1 - allocate(CS%id_s(ens_size));CS%id_s(:)=-1 -! allocate(CS%U(is:ie,js:je,nk,ens_size)) -! allocate(CS%V(is:ie,js:je,nk,ens_size)) -! allocate(CS%id_u(ens_size));CS%id_u(:)=-1 -! allocate(CS%id_v(ens_size));CS%id_v(:)=-1 - allocate(CS%id_ssh(ens_size));CS%id_ssh(:)=-1 - - return - end subroutine init_ocean_ensemble - - !> Set the next analysis time - subroutine set_analysis_time(Time,CS) - type(time_type), intent(in) :: Time !< the current model time - type(ODA_CS), pointer, intent(inout) :: CS !< the DA control structure - - character(len=160) :: mesg ! The text of an error message - integer :: yr, mon, day, hr, min, sec - - if (Time >= CS%Time) then - CS%Time=increment_time(CS%Time,CS%assim_frequency*3600) - - call get_date(Time, yr, mon, day, hr, min, sec) - write(mesg,*) 'Model Time: ', yr, mon, day, hr, min, sec - call MOM_mesg("set_analysis_time: "//trim(mesg)) - call get_date(CS%time, yr, mon, day, hr, min, sec) - write(mesg,*) 'Assimilation Time: ', yr, mon, day, hr, min, sec - call MOM_mesg("set_analysis_time: "//trim(mesg)) + if (k == 1) then + T_grid%z(:,:,k) = global2D/2 + else + T_grid%z(:,:,k) = T_grid%z(:,:,k-1) + (global2D + global2D_old)/2 endif - if (CS%Time < Time) then - call MOM_error(FATAL, " set_analysis_time: " // & - "assimilation interval appears to be shorter than " // & - "the model timestep") + global2D_old = global2D + enddo + + call ocean_da_core_init(CS%mpp_domain, T_grid, CS%Profiles, Time) + + CS%Time=Time + !! switch back to ensemble member pelist + call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:)) +end subroutine init_oda + +!> Copy ensemble member tracers to ensemble vector. +subroutine set_prior_tracer(Time, G, GV, h, tv, CS) + type(time_type), intent(in) :: Time !< The current model time + type(ocean_grid_type), pointer :: G !< domain and grid information for ocean model + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables + + type(ODA_CS), pointer :: CS !< ocean DA control structure + real, dimension(:,:,:), allocatable :: T, S + type(ocean_grid_type), pointer :: Grid=>NULL() + integer :: i,j, m, n, ss + integer :: is, ie, js, je + integer :: isc, iec, jsc, jec + integer :: isd, ied, jsd, jed + integer :: id + logical :: used + + ! return if not time for analysis + if (Time < CS%Time) return + + if (.not. associated(CS%Grid)) call MOM_ERROR(FATAL,'ODA_CS ensemble horizontal grid not associated') + if (.not. associated(CS%GV)) call MOM_ERROR(FATAL,'ODA_CS ensemble vertical grid not associated') + + !! switch to global pelist + call set_current_pelist(CS%filter_pelist) + call MOM_mesg('Setting prior') + + isc=CS%Grid%isc;iec=CS%Grid%iec;jsc=CS%Grid%jsc;jec=CS%Grid%jec + call mpp_get_compute_domain(CS%domains(CS%ensemble_id)%mpp_domain,is,ie,js,je) + call mpp_get_data_domain(CS%domains(CS%ensemble_id)%mpp_domain,isd,ied,jsd,jed) + allocate(T(isd:ied,jsd:jed,CS%nk)) + allocate(S(isd:ied,jsd:jed,CS%nk)) + + do j=js,je; do i=is,ie + call remapping_core_h(CS%remapCS, GV%ke, h(i,j,:), tv%T(i,j,:), & + CS%nk, CS%h(i,j,:), T(i,j,:)) + call remapping_core_h(CS%remapCS, GV%ke, h(i,j,:), tv%S(i,j,:), & + CS%nk, CS%h(i,j,:), S(i,j,:)) + enddo ; enddo + + do m=1,CS%ensemble_size + call mpp_redistribute(CS%domains(m)%mpp_domain, T,& + CS%mpp_domain, CS%Ocean_prior%T(:,:,:,m), complete=.true.) + call mpp_redistribute(CS%domains(m)%mpp_domain, S,& + CS%mpp_domain, CS%Ocean_prior%S(:,:,:,m), complete=.true.) + if (CS%Ocean_prior%id_t(m)>0) & + used=send_data(CS%Ocean_prior%id_t(m), CS%Ocean_prior%T(isc:iec,jsc:jec,:,m), CS%Time) + if (CS%Ocean_prior%id_s(m)>0) & + used=send_data(CS%Ocean_prior%id_s(m), CS%Ocean_prior%S(isc:iec,jsc:jec,:,m), CS%Time) + enddo + deallocate(T,S) + + !! switch back to ensemble member pelist + call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:)) + + return + +end subroutine set_prior_tracer + +!> Returns posterior adjustments or full state +!!Note that only those PEs associated with an ensemble member receive data +subroutine get_posterior_tracer(Time, CS, h, tv, increment) + type(time_type), intent(in) :: Time !< the current model time + type(ODA_CS), pointer :: CS !< ocean DA control structure + real, dimension(:,:,:), pointer :: h !< Layer thicknesses, in H (usually m or kg m-2) + type(thermo_var_ptrs), pointer :: tv !< A structure pointing to various thermodynamic variables + logical, optional, intent(in) :: increment !< True if returning increment only + + type(ocean_control_struct), pointer :: Ocean_increment=>NULL() + integer :: i, j, m + logical :: used, get_inc + + ! return if not analysis time (retain pointers for h and tv) + if (Time < CS%Time) return + + + !! switch to global pelist + call set_current_pelist(CS%filter_pelist) + call MOM_mesg('Getting posterior') + + get_inc = .true. + if (present(increment)) get_inc = increment + + if (get_inc) then + allocate(Ocean_increment) + call init_ocean_ensemble(Ocean_increment,CS%Grid,CS%GV,CS%ensemble_size) + Ocean_increment%T = CS%Ocean_posterior%T - CS%Ocean_prior%T + Ocean_increment%S = CS%Ocean_posterior%S - CS%Ocean_prior%S + endif + do m=1,CS%ensemble_size + if (get_inc) then + call mpp_redistribute(CS%mpp_domain, Ocean_increment%T(:,:,:,m), & + CS%domains(m)%mpp_domain, CS%tv%T, complete=.true.) + call mpp_redistribute(CS%mpp_domain, Ocean_increment%S(:,:,:,m), & + CS%domains(m)%mpp_domain, CS%tv%S, complete=.true.) + else + call mpp_redistribute(CS%mpp_domain, CS%Ocean_posterior%T(:,:,:,m), & + CS%domains(m)%mpp_domain, CS%tv%T, complete=.true.) + call mpp_redistribute(CS%mpp_domain, CS%Ocean_posterior%S(:,:,:,m), & + CS%domains(m)%mpp_domain, CS%tv%S, complete=.true.) endif - return + enddo - end subroutine set_analysis_time + tv => CS%tv + h => CS%h + !! switch back to ensemble member pelist + call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:)) - !> Write observation differences to a file - subroutine save_obs_diff(filename,CS) - character(len=*), intent(in) :: filename !< name of output file - type(ODA_CS), pointer, intent(in) :: CS !< pointer to DA control structure +end subroutine get_posterior_tracer - integer :: fid ! profile file handle - type(ocean_profile_type), pointer :: Prof=>NULL() +!> Gather observations and sall ODA routines +subroutine oda(Time, CS) + type(time_type), intent(in) :: Time !< the current model time + type(oda_CS), intent(inout) :: CS !< the ocean DA control structure - fid = open_profile_file(trim(filename), nvar=2, thread=MPP_SINGLE, fset=MPP_SINGLE) - Prof=>CS%CProfiles + integer :: i, j + integer :: m + integer :: yr, mon, day, hr, min, sec + + if ( Time >= CS%Time ) then !! switch to global pelist - !call set_current_pelist(CS%filter_pelist) + call set_current_pelist(CS%filter_pelist) - do while (associated(Prof)) - call write_profile(fid,Prof) - Prof=>Prof%cnext - enddo - call close_profile_file(fid) + call get_profiles(Time, CS%Profiles, CS%CProfiles) +#ifdef ENABLE_ECDA + call ensemble_filter(CS%Ocean_prior, CS%Ocean_posterior, CS%CProfiles, CS%kdroot, CS%mpp_domain, CS%oda_grid) +#endif !! switch back to ensemble member pelist - !call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:)) - - return - end subroutine save_obs_diff - - - !> Apply increments to tracers - subroutine apply_oda_tracer_increments(dt,G,tv,h,CS) - real, intent(in) :: dt !< The tracer timestep (seconds) - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< layer thickness (m or kg/m2) - type(ODA_CS), intent(inout) :: CS !< the data assimilation structure + call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:)) - end subroutine apply_oda_tracer_increments + endif + + return +end subroutine oda + +!> Finalize DA module +subroutine oda_end(CS) + type(ODA_CS), intent(inout) :: CS !< the ocean DA control structure + +end subroutine oda_end + +!> Initialize DA module +subroutine init_ocean_ensemble(CS,Grid,GV,ens_size) + type(ocean_control_struct), pointer :: CS !< Pointer to ODA control structure + type(ocean_grid_type), pointer :: Grid !< Pointer to ocean analysis grid + type(verticalGrid_type), pointer :: GV !< Pointer to DA vertical grid + integer, intent(in) :: ens_size !< ensemble size + + integer :: n,is,ie,js,je,nk + + nk=GV%ke + is=Grid%isd;ie=Grid%ied + js=Grid%jsd;je=Grid%jed + CS%ensemble_size=ens_size + allocate(CS%T(is:ie,js:je,nk,ens_size)) + allocate(CS%S(is:ie,js:je,nk,ens_size)) + allocate(CS%SSH(is:ie,js:je,ens_size)) + allocate(CS%id_t(ens_size));CS%id_t(:)=-1 + allocate(CS%id_s(ens_size));CS%id_s(:)=-1 +! allocate(CS%U(is:ie,js:je,nk,ens_size)) +! allocate(CS%V(is:ie,js:je,nk,ens_size)) +! allocate(CS%id_u(ens_size));CS%id_u(:)=-1 +! allocate(CS%id_v(ens_size));CS%id_v(:)=-1 + allocate(CS%id_ssh(ens_size));CS%id_ssh(:)=-1 + + return +end subroutine init_ocean_ensemble + +!> Set the next analysis time +subroutine set_analysis_time(Time,CS) + type(time_type), intent(in) :: Time !< the current model time + type(ODA_CS), pointer, intent(inout) :: CS !< the DA control structure + + character(len=160) :: mesg ! The text of an error message + integer :: yr, mon, day, hr, min, sec + + if (Time >= CS%Time) then + CS%Time=increment_time(CS%Time,CS%assim_frequency*3600) + + call get_date(Time, yr, mon, day, hr, min, sec) + write(mesg,*) 'Model Time: ', yr, mon, day, hr, min, sec + call MOM_mesg("set_analysis_time: "//trim(mesg)) + call get_date(CS%time, yr, mon, day, hr, min, sec) + write(mesg,*) 'Assimilation Time: ', yr, mon, day, hr, min, sec + call MOM_mesg("set_analysis_time: "//trim(mesg)) + endif + if (CS%Time < Time) then + call MOM_error(FATAL, " set_analysis_time: " // & + "assimilation interval appears to be shorter than " // & + "the model timestep") + endif + return + +end subroutine set_analysis_time + +!> Write observation differences to a file +subroutine save_obs_diff(filename,CS) + character(len=*), intent(in) :: filename !< name of output file + type(ODA_CS), pointer, intent(in) :: CS !< pointer to DA control structure + + integer :: fid ! profile file handle + type(ocean_profile_type), pointer :: Prof=>NULL() + + fid = open_profile_file(trim(filename), nvar=2, thread=MPP_SINGLE, fset=MPP_SINGLE) + Prof=>CS%CProfiles + + !! switch to global pelist + !call set_current_pelist(CS%filter_pelist) + + do while (associated(Prof)) + call write_profile(fid,Prof) + Prof=>Prof%cnext + enddo + call close_profile_file(fid) + + !! switch back to ensemble member pelist + !call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:)) + + return +end subroutine save_obs_diff + + +!> Apply increments to tracers +subroutine apply_oda_tracer_increments(dt,G,tv,h,CS) + real, intent(in) :: dt !< The tracer timestep (seconds) + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< layer thickness (m or kg/m2) + type(ODA_CS), intent(inout) :: CS !< the data assimilation structure + +end subroutine apply_oda_tracer_increments !> \namespace MOM_oda_driver_mod !! From 87c4c60b36ebc07db01cfa87761655a7bfccc5a3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 16:44:37 -0400 Subject: [PATCH 0567/1072] dOyxgenization of types in MOM_set_diffusivity.F90 dOxyGenized comments describing types, the elements of types, and module CPU clock IDs in MOM_set_diffusivity.F90. All answers are bitwise identical. --- .../vertical/MOM_set_diffusivity.F90 | 50 +++++++++++-------- 1 file changed, 28 insertions(+), 22 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index f369409c7c..68bdf75064 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -46,6 +46,7 @@ module MOM_set_diffusivity public set_diffusivity_init public set_diffusivity_end +!> This control structure contains parameters for MOM_set_diffusivity. type, public :: set_diffusivity_CS ; private logical :: debug !< If true, write verbose checksums for debugging. @@ -119,7 +120,7 @@ module MOM_set_diffusivity !! problems (m/s). If the value is small enough, !! this parameter should not affect the solution. real :: TKE_decay !< ratio of natural Ekman depth to TKE decay scale (nondim) - real :: mstar !! ratio of friction velocity cubed to + real :: mstar !< ratio of friction velocity cubed to !! TKE input to the mixed layer (nondim) logical :: ML_use_omega !< If true, use absolute rotation rate instead !! of the vertical component of rotation when @@ -142,41 +143,46 @@ module MOM_set_diffusivity real :: Max_salt_diff_salt_fingers !< max salt diffusivity for salt fingers (m2/s) real :: Kv_molecular !< molecular visc for double diff convect (m2/s) - character(len=200) :: inputdir - type(user_change_diff_CS), pointer :: user_change_diff_CSp => NULL() - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() - type(Kappa_shear_CS), pointer :: kappaShear_CSp => NULL() - type(CVMix_shear_cs), pointer :: CVMix_shear_csp => NULL() - type(CVMix_ddiff_cs), pointer :: CVMix_ddiff_csp => NULL() - type(bkgnd_mixing_cs), pointer :: bkgnd_mixing_csp => NULL() - type(int_tide_CS), pointer :: int_tide_CSp => NULL() - type(tidal_mixing_cs), pointer :: tm_csp => NULL() - + character(len=200) :: inputdir !< The directory in which input files are found + type(user_change_diff_CS), pointer :: user_change_diff_CSp => NULL() !< Control structure for a child module + type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() !< Control structure for a child module + type(Kappa_shear_CS), pointer :: kappaShear_CSp => NULL() !< Control structure for a child module + type(CVMix_shear_cs), pointer :: CVMix_shear_csp => NULL() !< Control structure for a child module + type(CVMix_ddiff_cs), pointer :: CVMix_ddiff_csp => NULL() !< Control structure for a child module + type(bkgnd_mixing_cs), pointer :: bkgnd_mixing_csp => NULL() !< Control structure for a child module + type(int_tide_CS), pointer :: int_tide_CSp => NULL() !< Control structure for a child module + type(tidal_mixing_cs), pointer :: tm_csp => NULL() !< Control structure for a child module + + !>@{ Diagnostic IDs integer :: id_maxTKE = -1, id_TKE_to_Kd = -1, id_Kd_user = -1 integer :: id_Kd_layer = -1, id_Kd_BBL = -1, id_Kd_BBL_z = -1 integer :: id_Kd_user_z = -1, id_N2 = -1, id_N2_z = -1 integer :: id_Kd_Work = -1, id_KT_extra = -1, id_KS_extra = -1 integer :: id_KT_extra_z = -1, id_KS_extra_z = -1 + !!@} end type set_diffusivity_CS +!> This structure has memory for used in calculating diagnostics of diffusivity type diffusivity_diags real, pointer, dimension(:,:,:) :: & - N2_3d => NULL(),& ! squared buoyancy frequency at interfaces (1/s2) - Kd_user => NULL(),& ! user-added diffusivity at interfaces (m2/s) - Kd_BBL => NULL(),& ! BBL diffusivity at interfaces (m2/s) - Kd_work => NULL(),& ! layer integrated work by diapycnal mixing (W/m2) - maxTKE => NULL(),& ! energy required to entrain to h_max (m3/s3) - TKE_to_Kd => NULL(),& ! conversion rate (~1.0 / (G_Earth + dRho_lay)) - ! between TKE dissipated within a layer and Kd - ! in that layer, in m2 s-1 / m3 s-3 = s2 m-1 - KT_extra => NULL(),& ! double diffusion diffusivity for temp (m2/s) - KS_extra => NULL() ! double diffusion diffusivity for saln (m2/s) + N2_3d => NULL(),& !< squared buoyancy frequency at interfaces (1/s2) + Kd_user => NULL(),& !< user-added diffusivity at interfaces (m2/s) + Kd_BBL => NULL(),& !< BBL diffusivity at interfaces (m2/s) + Kd_work => NULL(),& !< layer integrated work by diapycnal mixing (W/m2) + maxTKE => NULL(),& !< energy required to entrain to h_max (m3/s3) + KT_extra => NULL(),& !< double diffusion diffusivity for temp (m2/s) + KS_extra => NULL() !< double diffusion diffusivity for saln (m2/s) + real, pointer, dimension(:,:,:) :: TKE_to_Kd => NULL() + !< conversion rate (~1.0 / (G_Earth + dRho_lay)) + !! between TKE dissipated within a layer and Kd + !! in that layer, in m2 s-1 / m3 s-3 = s2 m-1 end type diffusivity_diags -! Clocks +!>@{ CPU time clocks integer :: id_clock_kappaShear, id_clock_CVMix_ddiff +!!@} contains From 67d54e2f4477e791a66d59e265da9de0b0c9139c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 17:00:24 -0400 Subject: [PATCH 0568/1072] dOyxgenization of type elements in MOM_vert_friction.F90 Added or corrected dOxyGenized comments describing seven elements of types in MOM_oda_driver.F90. All answers are bitwise identical. --- .../vertical/MOM_vert_friction.F90 | 36 +++++++++---------- 1 file changed, 17 insertions(+), 19 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 1c40ce26f9..2945ed2a73 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -29,6 +29,7 @@ module MOM_vert_friction public vertvisc_limit_vel, vertvisc_init, vertvisc_end public updateCFLtruncationValue +!> The control structure with parameters and memory for the MOM_vert_friction module type, public :: vertvisc_CS ; private real :: Hmix !< The mixed layer thickness in m. real :: Hmix_stress !< The mixed layer thickness over which the wind @@ -66,13 +67,10 @@ module MOM_vert_friction a_v !< The v-drag coefficient across an interface, in m s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & h_v !< The effective layer thickness at v-points, m or kg m-2. - !>@{ - !! The surface coupling coefficient under ice shelves - !! in m s-1. Retained to determine stress under shelves. - real, pointer, dimension(:,:) :: & - a1_shelf_u => NULL(), & - a1_shelf_v => NULL() - !>@} + real, pointer, dimension(:,:) :: a1_shelf_u => NULL() !< The u-momentum coupling coefficient under + !! ice shelves in m s-1. Retained to determine stress under shelves. + real, pointer, dimension(:,:) :: a1_shelf_v => NULL() !< The v-momentum coupling coefficient under + !! ice shelves in m s-1. Retained to determine stress under shelves. logical :: split !< If true, use the split time stepping scheme. logical :: bottomdraglaw !< If true, the bottom stress is calculated with a @@ -99,28 +97,28 @@ module MOM_vert_friction !! thickness for viscosity. logical :: debug !< If true, write verbose checksums for debugging purposes. integer :: nkml !< The number of layers in the mixed layer. - integer, pointer :: ntrunc !< The number of times the velocity has been - !! truncated since the last call to write_energy. - !>@{ - !! The complete path to files in which a column's worth of - !! accelerations are written when velocity truncations occur. - character(len=200) :: u_trunc_file - character(len=200) :: v_trunc_file - !>@} + integer, pointer :: ntrunc !< The number of times the velocity has been + !! truncated since the last call to write_energy. + character(len=200) :: u_trunc_file !< The complete path to a file in which a column of + !! u-accelerations are written if velocity truncations occur. + character(len=200) :: v_trunc_file !< The complete path to a file in which a column of + !! v-accelerations are written if velocity truncations occur. + logical :: StokesMixing !< If true, do Stokes drift mixing via the Lagrangian current + !! (Eulerian plus Stokes drift). False by default and set + !! via STOKES_MIXING_COMBINED. type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the !! timing of diagnostic output. - !>@{ - !! Diagnostic identifiers + !>@{ Diagnostic identifiers integer :: id_du_dt_visc = -1, id_dv_dt_visc = -1, id_au_vv = -1, id_av_vv = -1 integer :: id_h_u = -1, id_h_v = -1, id_hML_u = -1 , id_hML_v = -1 integer :: id_Ray_u = -1, id_Ray_v = -1, id_taux_bot = -1, id_tauy_bot = -1 integer :: id_Kv_slow = -1, id_Kv_u = -1, id_Kv_v = -1 !>@} - type(PointAccel_CS), pointer :: PointAccel_CSp => NULL() - logical :: StokesMixing + type(PointAccel_CS), pointer :: PointAccel_CSp => NULL() !< A pointer to the control structure + !! for recording accelerations leading to velocity truncations end type vertvisc_CS contains From 036d706793a154d509eecf34b73e710d849d6706 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 17:13:30 -0400 Subject: [PATCH 0569/1072] dOyxgenization of type elements in MOM_hor_visc.F90 Added or corrected dOxyGenized comments describing elements of types in MOM_hor_visc.F90. All answers are bitwise identical. --- .../lateral/MOM_hor_visc.F90 | 48 +++++++++++-------- 1 file changed, 29 insertions(+), 19 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index f37b91e023..2a166bac09 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -70,43 +70,52 @@ module MOM_hor_visc real :: Kh_aniso !< The anisotropic viscosity in m2 s-1. logical :: dynamic_aniso !< If true, the anisotropic viscosity is recomputed as a function !! of state. This is set depending on ANISOTROPIC_MODE. - real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - Kh_bg_xx, &!< The background Laplacian viscosity at h points, in units + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Kh_bg_xx + !< The background Laplacian viscosity at h points, in units !! of m2 s-1. The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. - Kh_bg_2d, &!< The background Laplacian viscosity at h points, in units + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Kh_bg_2d + !< The background Laplacian viscosity at h points, in units !! of m2 s-1. The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. - Ah_bg_xx, &!< The background biharmonic viscosity at h points, in units + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Ah_bg_xx + !< The background biharmonic viscosity at h points, in units !! of m4 s-1. The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. - Kh_Max_xx, &!< The maximum permitted Laplacian viscosity, m2 s-1. - Ah_Max_xx, &!< The maximum permitted biharmonic viscosity, m4 s-1. - Biharm_Const2_xx,&!< A constant relating the biharmonic viscosity to the + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Biharm_Const2_xx + !< A constant relating the biharmonic viscosity to the !! square of the velocity shear, in m4 s. This value is !! set to be the magnitude of the Coriolis terms once the !! velocity differences reach a value of order 1/2 MAXVEL. - reduction_xx, &!< The amount by which stresses through h points are reduced + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: reduction_xx + !< The amount by which stresses through h points are reduced !! due to partial barriers. Nondimensional. - n1n2_h, &!< Factor n1*n2 in the anisotropic direction tensor at h-points + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & + Kh_Max_xx, & !< The maximum permitted Laplacian viscosity, m2 s-1. + Ah_Max_xx, & !< The maximum permitted biharmonic viscosity, m4 s-1. + n1n2_h, & !< Factor n1*n2 in the anisotropic direction tensor at h-points n1n1_m_n2n2_h !< Factor n1**2-n2**2 in the anisotropic direction tensor at h-points - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - Kh_bg_xy, &!< The background Laplacian viscosity at q points, in units + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Kh_bg_xy + !< The background Laplacian viscosity at q points, in units !! of m2 s-1. The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. - Ah_bg_xy, &!< The background biharmonic viscosity at q points, in units + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Ah_bg_xy + !< The background biharmonic viscosity at q points, in units !! of m4 s-1. The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. - Kh_Max_xy, &!< The maximum permitted Laplacian viscosity, m2 s-1. - Ah_Max_xy, &!< The maximum permitted biharmonic viscosity, m4 s-1. - Biharm_Const2_xy,&!< A constant relating the biharmonic viscosity to the + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Biharm_Const2_xy + !< A constant relating the biharmonic viscosity to the !! square of the velocity shear, in m4 s. This value is !! set to be the magnitude of the Coriolis terms once the !! velocity differences reach a value of order 1/2 MAXVEL. - reduction_xy, &!! The amount by which stresses through q points are reduced + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: reduction_xy + !< The amount by which stresses through q points are reduced !! due to partial barriers. Nondimensional. - n1n2_q, &!< Factor n1*n2 in the anisotropic direction tensor at q-points + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & + Kh_Max_xy, & !< The maximum permitted Laplacian viscosity, m2 s-1. + Ah_Max_xy, & !< The maximum permitted biharmonic viscosity, m4 s-1. + n1n2_q, & !< Factor n1*n2 in the anisotropic direction tensor at q-points n1n1_m_n2n2_q !< Factor n1**2-n2**2 in the anisotropic direction tensor at q-points real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & @@ -123,7 +132,8 @@ module MOM_hor_visc Idx2dyCu, & !< 1/(dx^2 dy) at u points, in m-3 Idxdy2u !< 1/(dx dy^2) at u points, in m-3 real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - Idx2dyCv, Idxdy2v ! 1/(dx^2 dy) and 1/(dx dy^2) at v points, in m-3 + Idx2dyCv, & !< 1/(dx^2 dy) at v points, in m-3 + Idxdy2v !< 1/(dx dy^2) at v points, in m-3 ! The following variables are precalculated time-invariant combinations of ! parameters and metric terms. @@ -139,7 +149,7 @@ module MOM_hor_visc Laplac3_Const_xy, & !< Laplacian metric-dependent constants (nondim) Biharm5_Const_xy !< Biharmonic metric-dependent constants (nondim) - type(diag_ctrl), pointer :: diag => NULL() ! structure to regulate diagnostics + type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostics !>@{ !! Diagnostic id From 2d55746656a9990abf9f5aeb1addbbbd48ab4874 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 17:14:20 -0400 Subject: [PATCH 0570/1072] dOyxgenization of types in MOM_internal_tides.F90 dOxyGenized comments describing types, the elements of types, and module CPU clock IDs in MOM_internal_tides.F90. All answers are bitwise identical. --- src/parameterizations/lateral/MOM_internal_tides.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 17a139819f..3205f81b02 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -35,6 +35,7 @@ module MOM_internal_tides public internal_tides_init, internal_tides_end public get_lowmode_loss +!> This control structure has parameters for the MOM_internal_tides module type, public :: int_tide_CS ; private logical :: do_int_tides !< If true, use the internal tide code. integer :: nFreq = 0 !< The number of internal tide frequency bands @@ -53,7 +54,7 @@ module MOM_internal_tides real, allocatable, dimension(:,:) :: refl_angle !< local coastline/ridge/shelf angles read from file ! (could be in G control structure) - real :: nullangle = -999.9 ! placeholder value in cell with no reflection + real :: nullangle = -999.9 !< placeholder value in cells with no reflection real, allocatable, dimension(:,:) :: refl_pref !< partial reflection coeff for each "coast cell" ! (could be in G control structure) @@ -114,7 +115,8 @@ module MOM_internal_tides type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the !! timing of diagnostic output. - type(wave_structure_CS), pointer :: wave_structure_CSp => NULL() + type(wave_structure_CS), pointer :: wave_structure_CSp => NULL() + !< A pointer to the wave_structure module control structure !>@{ Diag handles ! Diag handles relevant to all modes, frequencies, and angles From c61b73668d041572d687381e798b1c27971d3072 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 17:26:36 -0400 Subject: [PATCH 0571/1072] dOyxgenization of types in solo/coupler_types.F90 dOxyGenized comments describing types and the elements of types in solo_driver/coupler_types.F90. All answers are bitwise identical. --- config_src/solo_driver/coupler_types.F90 | 25 +++++++++++++++++++----- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/config_src/solo_driver/coupler_types.F90 b/config_src/solo_driver/coupler_types.F90 index 99a74e085c..d1264e5d6b 100644 --- a/config_src/solo_driver/coupler_types.F90 +++ b/config_src/solo_driver/coupler_types.F90 @@ -28,9 +28,11 @@ module coupler_types_mod public coupler_type_copy_1d_2d public coupler_type_copy_1d_3d + ! ! 3-d fields ! +!> A type with a 3-d array of values and metadata type, public :: coupler_3d_values_type character(len=48) :: name = ' ' !< The diagnostic name for this array real, pointer, contiguous, dimension(:,:,:) :: values => NULL() !< The pointer to the @@ -47,6 +49,7 @@ module coupler_types_mod !! if it can not be read from a restart file end type coupler_3d_values_type +!> A field with one or more related 3-d variables and collective metadata type, public :: coupler_3d_field_type character(len=48) :: name = ' ' !< name integer :: num_fields = 0 !< num_fields @@ -66,19 +69,24 @@ module coupler_types_mod real :: mol_wt = 0.0 !< mol_wt end type coupler_3d_field_type +!> A collection of 3-D boundary conditions for exchange between components type, public :: coupler_3d_bc_type integer :: num_bcs = 0 !< The number of boundary condition fields type(coupler_3d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary !! condition fields logical :: set = .false. !< If true, this type has been initialized - integer :: isd, isc, iec, ied !< The i-direction data and computational domain index ranges for this type - integer :: jsd, jsc, jec, jed !< The j-direction data and computational domain index ranges for this type - integer :: ks, ke !< The k-direction index ranges for this type + !>@{ The i- and j-direction data and computational domain index ranges for this type + integer :: isd, isc, iec, ied ! The i-direction data and computational domain index ranges for this type + integer :: jsd, jsc, jec, jed ! The j-direction data and computational domain index ranges for this type + !!@} + integer :: ks !< The k-direction start index for this type + integer :: ke !< The k-direction end index for this type end type coupler_3d_bc_type ! ! 2-d fields ! +!> A type with a 2-d array of values and metadata type, public :: coupler_2d_values_type character(len=48) :: name = ' ' !< The diagnostic name for this array real, pointer, contiguous, dimension(:,:) :: values => NULL() !< The pointer to the @@ -95,6 +103,7 @@ module coupler_types_mod !! if it can not be read from a restart file end type coupler_2d_values_type +!> A field with one or more related 2-d variables and collective metadata type, public :: coupler_2d_field_type character(len=48) :: name = ' ' !< name integer :: num_fields = 0 !< num_fields @@ -114,18 +123,22 @@ module coupler_types_mod real :: mol_wt = 0.0 !< mol_wt end type coupler_2d_field_type +!> A collection of 2-D boundary conditions for exchange between components type, public :: coupler_2d_bc_type integer :: num_bcs = 0 !< The number of boundary condition fields type(coupler_2d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary !! condition fields logical :: set = .false. !< If true, this type has been initialized - integer :: isd, isc, iec, ied !< The i-direction data and computational domain index ranges for this type - integer :: jsd, jsc, jec, jed !< The j-direction data and computational domain index ranges for this type + !>@{ The i- and j-direction data and computational domain index ranges for this type + integer :: isd, isc, iec, ied ! The i-direction data and computational domain index ranges for this type + integer :: jsd, jsc, jec, jed ! The j-direction data and computational domain index ranges for this type + !!@} end type coupler_2d_bc_type ! ! 1-d fields ! +!> A type with a 1-d array of values and metadata type, public :: coupler_1d_values_type character(len=48) :: name = ' ' !< The diagnostic name for this array real, pointer, dimension(:) :: values => NULL() !< The pointer to the array of values @@ -139,6 +152,7 @@ module coupler_types_mod !! if it can not be read from a restart file end type coupler_1d_values_type +!> A field with one or more related 1-d variables and collective metadata type, public :: coupler_1d_field_type character(len=48) :: name = ' ' !< name integer :: num_fields = 0 !< num_fields @@ -156,6 +170,7 @@ module coupler_types_mod real :: mol_wt = 0.0 !< mol_wt end type coupler_1d_field_type +!> A collection of 1-D boundary conditions for exchange between components type, public :: coupler_1d_bc_type integer :: num_bcs = 0 !< The number of boundary condition fields type(coupler_1d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary From 009cc22c0bbd6d465b25e82ce304f517ddfb020d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 17:33:20 -0400 Subject: [PATCH 0572/1072] Fixed trailing white space in MOM_vert_friction --- src/parameterizations/vertical/MOM_vert_friction.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 2945ed2a73..88da20bb4d 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -118,7 +118,7 @@ module MOM_vert_friction !>@} type(PointAccel_CS), pointer :: PointAccel_CSp => NULL() !< A pointer to the control structure - !! for recording accelerations leading to velocity truncations + !! for recording accelerations leading to velocity truncations end type vertvisc_CS contains From 044223631377c74a97b2807e66ee0fa944d0eb92 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 18:36:24 -0400 Subject: [PATCH 0573/1072] Added FMS_file_exists Added FMS_file_exists as an interal interface covering the FMS function file_exist, so that dOxyGen will properly document the file_exists interface. All answers are bitwise identical. --- src/framework/MOM_io.F90 | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 6055ae7d1d..21d42ea436 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -17,7 +17,7 @@ module MOM_io use fms_io_mod, only : file_exist, field_size, read_data use fms_io_mod, only : field_exists => field_exist, io_infra_end=>fms_io_exit use fms_io_mod, only : get_filename_appendix => get_filename_appendix -use mpp_domains_mod, only : domain1d, mpp_get_domain_components +use mpp_domains_mod, only : domain1d, domain2d, mpp_get_domain_components use mpp_domains_mod, only : CENTER, CORNER, NORTH_FACE=>NORTH, EAST_FACE=>EAST use mpp_io_mod, only : open_file => mpp_open, close_file => mpp_close use mpp_io_mod, only : mpp_write_meta, write_field => mpp_write, mpp_get_info @@ -65,7 +65,7 @@ module MOM_io !> Indicate whether a file exists, perhaps with domain decomposition interface file_exists - module procedure file_exist + module procedure FMS_file_exists module procedure MOM_file_exists end interface @@ -833,6 +833,19 @@ function MOM_file_exists(filename, MOM_Domain) end function MOM_file_exists +!> Returns true if the named file or its domain-decomposed variant exists. +function FMS_file_exists(filename, domain, no_domain) + character(len=*), intent(in) :: filename !< The name of the file being inquired about + type(domain2d), optional, intent(in) :: domain !< The mpp domain2d that describes the decomposition + logical, optional, intent(in) :: no_domain !< This file does not use domain decomposition +! This function uses the fms_io function file_exist to determine whether +! a named file (or its decomposed variant) exists. + + logical :: FMS_file_exists + + FMS_file_exists = file_exist(filename, domain, no_domain) + +end function FMS_file_exists !> This function uses the fms_io function read_data to read 1-D !! data field named "fieldname" from file "filename". From a9f2cec0bf28611161f219d1cdf14520fc91a8f6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 18:38:12 -0400 Subject: [PATCH 0574/1072] Removed quotes from verticalGrid_type description Eliminated single quotes in comments describing the verticalGrid_type, so that dOxygen does not encounter cpp-related errors. All answers are bitwise identical. --- src/core/MOM_verticalGrid.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 00a5c6981a..1f09110254 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -13,7 +13,7 @@ module MOM_verticalGrid public setVerticalGridAxes public get_flux_units, get_thickness_units, get_tr_flux_units -!> Describes the ocean's vertical grid, including unit conversion factors +!> Describes the vertical ocean grid, including unit conversion factors type, public :: verticalGrid_type ! Commonly used parameters @@ -33,7 +33,7 @@ module MOM_verticalGrid ! The following variables give information about the vertical grid. logical :: Boussinesq !< If true, make the Boussinesq approximation. - real :: Angstrom !< A one-Angstrom thickness in the model's thickness units. + real :: Angstrom !< A one-Angstrom thickness in the model thickness units. real :: Angstrom_z !< A one-Angstrom thickness in m. real :: H_subroundoff !< A thickness that is so small that it can be added to a thickness of !! Angstrom or larger without changing it at the bit level, in thickness units. @@ -54,7 +54,7 @@ module MOM_verticalGrid contains -!> Allocates and initializes the model's vertical grid structure. +!> Allocates and initializes the ocean model vertical grid structure. subroutine verticalGridInit( param_file, GV ) ! This routine initializes the verticalGrid_type structure (GV). ! All memory is allocated but not necessarily set to meaningful values until later. From d9d064dd63ac6b71bdb61725fe4f5546b964f585 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 18:38:50 -0400 Subject: [PATCH 0575/1072] Removed quotes from MOM_dyn_split_RK2_CS comments Eliminated single quotes in comments describing the MOM_dyn_split_RK2_CS, so that dOxygen does not encounter cpp-related errors. Also consolidated four declarations onto single lines to correct dOxyGen comments. All answers are bitwise identical. --- src/core/MOM_dynamics_split_RK2.F90 | 40 ++++++++++++++--------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 8ffafacfba..d02285148a 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -75,26 +75,26 @@ module MOM_dynamics_split_RK2 PFv, & !< PFv = -dM/dy, in m s-2. diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor, in m s-2. - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - visc_rem_u !< Both the fraction of the zonal momentum originally in a - !! layer that remains after a time-step of viscosity, and the - !! fraction of a time-step's worth of a barotropic acceleration - !! that a layer experiences after viscosity is applied. - !! Nondimensional between 0 (at the bottom) and 1 (far above). - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - u_accel_bt !< The layers' zonal accelerations due to the difference between - !! the barotropic accelerations and the baroclinic accelerations - !! that were fed into the barotopic calculation, in m s-2. - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - visc_rem_v !< Both the fraction of the meridional momentum originally in - !! a layer that remains after a time-step of viscosity, and the - !! fraction of a time-step's worth of a barotropic acceleration - !! that a layer experiences after viscosity is applied. - !! Nondimensional between 0 (at the bottom) and 1 (far above). - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - v_accel_bt !< The layers' meridional accelerations due to the difference between - !! the barotropic accelerations and the baroclinic accelerations - !! that were fed into the barotopic calculation, in m s-2. + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: visc_rem_u + !< Both the fraction of the zonal momentum originally in a + !! layer that remains after a time-step of viscosity, and the + !! fraction of a time-step worth of a barotropic acceleration + !! that a layer experiences after viscosity is applied. + !! Nondimensional between 0 (at the bottom) and 1 (far above). + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_accel_bt + !< The zonal layer accelerations due to the difference between + !! the barotropic accelerations and the baroclinic accelerations + !! that were fed into the barotopic calculation, in m s-2. + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: visc_rem_v + !< Both the fraction of the meridional momentum originally in + !! a layer that remains after a time-step of viscosity, and the + !! fraction of a time-step worth of a barotropic acceleration + !! that a layer experiences after viscosity is applied. + !! Nondimensional between 0 (at the bottom) and 1 (far above). + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_accel_bt + !< The meridional layer accelerations due to the difference between + !! the barotropic accelerations and the baroclinic accelerations + !! that were fed into the barotopic calculation, in m s-2. ! The following variables are only used with the split time stepping scheme. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta !< Instantaneous free surface height (in Boussinesq From f965d1ac218b5ce968b3211e4a30815afc6bb409 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 10 Jul 2018 18:48:56 -0400 Subject: [PATCH 0576/1072] Converted 1D arrays from ALLOCABLE_ to allocatable There is no reason to use 1-d static arrays, so for simplicity 5 such arrays in MOM_verticalGrid.F90 and MOM_sum_output.F90 were converted from ALLOCABLE_ to allocatable, with corresponding changes to their allocate and deallocate calls. All answers are bitwise identical. --- src/core/MOM_verticalGrid.F90 | 19 +++++++++---------- src/diagnostics/MOM_sum_output.F90 | 7 +++---- 2 files changed, 12 insertions(+), 14 deletions(-) diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 1f09110254..f1dda828e0 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -27,8 +27,8 @@ module MOM_verticalGrid character(len=40) :: zAxisUnits !< The units that vertical coordinates are written in character(len=40) :: zAxisLongName !< Coordinate name to appear in files, !! e.g. "Target Potential Density" or "Height" - real ALLOCABLE_, dimension(NKMEM_) :: sLayer !< Coordinate values of layer centers - real ALLOCABLE_, dimension(NK_INTERFACE_) :: sInterface !< Coordinate values on interfaces + real, allocatable, dimension(:) :: sLayer !< Coordinate values of layer centers + real, allocatable, dimension(:) :: sInterface !< Coordinate values on interfaces integer :: direction = 1 !< Direction defaults to 1, positive up. ! The following variables give information about the vertical grid. @@ -38,7 +38,7 @@ module MOM_verticalGrid real :: H_subroundoff !< A thickness that is so small that it can be added to a thickness of !! Angstrom or larger without changing it at the bit level, in thickness units. !! If Angstrom is 0 or exceedingly small, this is negligible compared to 1e-17 m. - real ALLOCABLE_, dimension(NK_INTERFACE_) :: & + real, allocatable, dimension(:) :: & g_prime, & !< The reduced gravity at each interface, in m s-2. Rlay !< The target coordinate value (potential density) in each layer in kg m-3. integer :: nkml = 0 !< The number of layers at the top that should be treated @@ -140,11 +140,11 @@ subroutine verticalGridInit( param_file, GV ) call log_param(param_file, mdl, "M to THICKNESS rescaled by 2^-n", GV%m_to_H) call log_param(param_file, mdl, "THICKNESS to M rescaled by 2^n", GV%H_to_m) - ALLOC_( GV%sInterface(nk+1) ) - ALLOC_( GV%sLayer(nk) ) - ALLOC_( GV%g_prime(nk+1) ) ; GV%g_prime(:) = 0.0 + allocate( GV%sInterface(nk+1) ) + allocate( GV%sLayer(nk) ) + allocate( GV%g_prime(nk+1) ) ; GV%g_prime(:) = 0.0 ! The extent of Rlay should be changed to nk? - ALLOC_( GV%Rlay(nk+1) ) ; GV%Rlay(:) = 0.0 + allocate( GV%Rlay(nk+1) ) ; GV%Rlay(:) = 0.0 end subroutine verticalGridInit @@ -279,9 +279,8 @@ subroutine verticalGridEnd( GV ) ! Arguments: G - The ocean's grid structure. type(verticalGrid_type), pointer :: GV !< The ocean's vertical grid structure - DEALLOC_(GV%g_prime) ; DEALLOC_(GV%Rlay) - DEALLOC_( GV%sInterface ) - DEALLOC_( GV%sLayer ) + deallocate( GV%g_prime, GV%Rlay ) + deallocate( GV%sInterface , GV%sLayer ) deallocate( GV ) end subroutine verticalGridEnd diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index baf83f9119..3f23687fef 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -83,7 +83,7 @@ module MOM_sum_output type(Depth_List), pointer, dimension(:) :: DL => NULL() !< The sorted depth list. integer :: list_size !< length of sorting vector <= niglobal*njglobal - integer ALLOCABLE_, dimension(NKMEM_) :: lH + integer, allocatable, dimension(:) :: lH !< This saves the entry in DL with a volume just !! less than the volume of fluid below the interface. logical :: do_APE_calc !< If true, calculate the available potential energy of the @@ -256,7 +256,7 @@ subroutine MOM_sum_output_init(G, param_file, directory, ntrnc, & CS%depth_list_file = trim(slasher(directory))//trim(CS%depth_list_file) endif - ALLOC_(CS%lH(G%ke)) + allocate(CS%lH(G%ke)) call depth_list_setup(G, CS) else CS%list_size = 0 @@ -293,8 +293,7 @@ subroutine MOM_sum_output_end(CS) !! previous call to MOM_sum_output_init. if (associated(CS)) then if (CS%do_APE_calc) then - DEALLOC_(CS%lH) - deallocate(CS%DL) + deallocate(CS%lH, CS%DL) endif deallocate(CS) From 010f10351d519358fcd934b3be1503111d35c20a Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 11 Jul 2018 09:21:22 -0400 Subject: [PATCH 0577/1072] Shortened doxygen titles - Added blank lines after title sentence in description of types so that the full annotated list of types is readable. - Also removed a legacy boiler plate. --- .../solo_driver/Neverland_surface_forcing.F90 | 7 +- .../solo_driver/user_surface_forcing.F90 | 73 ++++++++----------- src/ALE/MOM_ALE.F90 | 8 +- src/core/MOM_forcing_type.F90 | 9 ++- src/core/MOM_variables.F90 | 43 +++++------ src/framework/MOM_coms.F90 | 6 +- src/framework/MOM_diag_mediator.F90 | 1 + src/framework/MOM_diag_remap.F90 | 24 +++--- .../vertical/MOM_ALE_sponge.F90 | 12 +-- src/tracer/ISOMIP_tracer.F90 | 18 ++--- src/tracer/dyed_obc_tracer.F90 | 44 ++++------- 11 files changed, 106 insertions(+), 139 deletions(-) diff --git a/config_src/solo_driver/Neverland_surface_forcing.F90 b/config_src/solo_driver/Neverland_surface_forcing.F90 index 55476f9051..65a5ca1339 100644 --- a/config_src/solo_driver/Neverland_surface_forcing.F90 +++ b/config_src/solo_driver/Neverland_surface_forcing.F90 @@ -22,9 +22,10 @@ module Neverland_surface_forcing public Neverland_surface_forcing_init !> This control structure should be used to store any run-time variables -!! associated with the Neverland forcing. It can be readily modified -!! for a specific case, and because it is private there will be no changes -!! needed in other code (although they will have to be recompiled). +!! associated with the Neverland forcing. +!! +!! It can be readily modified for a specific case, and because it is private there +!! will be no changes needed in other code (although they will have to be recompiled). type, public :: Neverland_surface_forcing_CS ; private logical :: use_temperature !< If true, use temperature and salinity. diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90 index 201723933f..e0136abf0f 100644 --- a/config_src/solo_driver/user_surface_forcing.F90 +++ b/config_src/solo_driver/user_surface_forcing.F90 @@ -1,48 +1,8 @@ +!> Template for user to code up surface forcing. module user_surface_forcing ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* Rewritten by Robert Hallberg, June 2009 * -!* * -!* This file contains the subroutines that a user should modify to * -!* to set the surface wind stresses and fluxes of buoyancy or * -!* temperature and fresh water. They are called when the run-time * -!* parameters WIND_CONFIG or BUOY_CONFIG are set to "USER". The * -!* standard version has simple examples, along with run-time error * -!* messages that will cause the model to abort if this code has not * -!* been modified. This code is intended for use with relatively * -!* simple specifications of the forcing. For more complicated forms, * -!* it is probably a good idea to read the forcing from input files * -!* using "file" for WIND_CONFIG and BUOY_CONFIG. * -!* * -!* USER_wind_forcing should set the surface wind stresses (taux and * -!* tauy) perhaps along with the surface friction velocity (ustar). * -!* * -!* USER_buoyancy forcing is used to set the surface buoyancy * -!* forcing, which may include a number of fresh water flux fields * -!* (evap, lprec, fprec, lrunoff, frunoff, and * -!* vprec) and the surface heat fluxes (sw, lw, latent and sens) * -!* if temperature and salinity are state variables, or it may simply * -!* be the buoyancy flux if it is not. This routine also has coded a * -!* restoring to surface values of temperature and salinity. * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v, tauy * -!* j x ^ x ^ x At >: u, taux * -!* j > o > o > At o: h, fluxes. * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** use MOM_diag_mediator, only : post_data, query_averaging_enabled use MOM_diag_mediator, only : register_diag_field, diag_ctrl, safe_alloc_ptr use MOM_domains, only : pass_var, pass_vector, AGRID @@ -62,9 +22,10 @@ module user_surface_forcing public USER_wind_forcing, USER_buoyancy_forcing, USER_surface_forcing_init !> This control structure should be used to store any run-time variables -!! associated with the user-specified forcing. It can be readily modified -!! for a specific case, and because it is private there will be no changes -!! needed in other code (although they will have to be recompiled). +!! associated with the user-specified forcing. +!! +!! It can be readily modified for a specific case, and because it is private there +!! will be no changes needed in other code (although they will have to be recompiled). type, public :: user_surface_forcing_CS ; private ! The variables in the cannonical example are used for some common ! cases, but do not need to be used. @@ -360,4 +321,28 @@ subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS) end subroutine USER_surface_forcing_init +!! \namespace user_surface_forcing +!! +!! This file contains the subroutines that a user should modify to +!! to set the surface wind stresses and fluxes of buoyancy or +!! temperature and fresh water. They are called when the run-time +!! parameters WIND_CONFIG or BUOY_CONFIG are set to "USER". The +!! standard version has simple examples, along with run-time error +!! messages that will cause the model to abort if this code has no +!! been modified. This code is intended for use with relatively +!! simple specifications of the forcing. For more complicated forms, +!! it is probably a good idea to read the forcing from input files +!! using "file" for WIND_CONFIG and BUOY_CONFIG. +!! +!! USER_wind_forcing() should set the surface wind stresses (taux and +!! tauy) perhaps along with the surface friction velocity (ustar). +!! +!! USER_buoyancy() forcing is used to set the surface buoyancy +!! forcing, which may include a number of fresh water flux fields +!! (evap, lprec, fprec, lrunoff, frunoff, and +!! vprec) and the surface heat fluxes (sw, lw, latent and sens) +!! if temperature and salinity are state variables, or it may simply +!! be the buoyancy flux if it is not. This routine also has coded a +!! restoring to surface values of temperature and salinity. + end module user_surface_forcing diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index eede57808b..a71dfb557c 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -1,8 +1,10 @@ !> This module contains the main regridding routines. +!! !! Regridding comprises two steps: -!! (1) Interpolation and creation of a new grid based on target interface -!! densities (or any other criterion). -!! (2) Remapping of quantities between old grid and new grid. +!! 1. Interpolation and creation of a new grid based on target interface +!! densities (or any other criterion). +!! 2. Remapping of quantities between old grid and new grid. +!! !! Original module written by Laurent White, 2008.06.09 module MOM_ALE diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index fa4295006c..9486967b40 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -33,10 +33,11 @@ module MOM_forcing_type public set_derived_forcing_fields, copy_back_forcing_fields, set_net_mass_forcing !> Structure that contains pointers to the boundary forcing used to drive the -!! liquid ocean simulated by MOM. Data in this type is allocated in the module -!! MOM_surface_forcing.F90, of which there are three: solo, coupled, and -!! ice-shelf. Alternatively, they are allocated in MESO_surface_forcing.F90, -!! which is a special case of solo_driver/MOM_surface_forcing.F90. +!! liquid ocean simulated by MOM. +!! +!! Data in this type is allocated in the module MOM_surface_forcing.F90, of which there +!! are three: solo, coupled, and ice-shelf. Alternatively, they are allocated in +!! MESO_surface_forcing.F90, which is a special case of solo_driver/MOM_surface_forcing.F90. type, public :: forcing ! Pointers in this module should be initialized to NULL. diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 343c5e6793..d176b407d3 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -27,8 +27,7 @@ module MOM_variables real, dimension(:,:), pointer :: p => NULL() !< A pointer to a 2D array end type p2d -!> The following structure contains pointers to various fields -!! which may be used describe the surface state of MOM, and which +!> Pointers to various fields which may be used describe the surface state of MOM, and which !! will be returned to a the calling program type, public :: surface real, allocatable, dimension(:,:) :: & @@ -69,9 +68,8 @@ module MOM_variables !! has had its memory allocated. end type surface -!> The thermo_var_ptrs structure contains pointers to an assortment of -!! thermodynamic fields that may be available, including potential temperature, -!! salinity, heat capacity, and the equation of state control structure. +!> Pointers to an assortment of thermodynamic fields that may be available, including +!! potential temperature, salinity, heat capacity, and the equation of state control structure. type, public :: thermo_var_ptrs ! If allocated, the following variables have nz layers. real, pointer :: T(:,:,:) => NULL() !< Potential temperature in C. @@ -111,9 +109,9 @@ module MOM_variables !! calculate_surface_state, in units of deg C kg m-2. end type thermo_var_ptrs -!> The ocean_internal_state structure contains pointers to all of the prognostic -!! variables allocated in MOM_variables.F90 and MOM.F90. It is useful for -!! sending these variables for diagnostics, and in preparation for ensembles +!> Pointers to all of the prognostic variables allocated in MOM_variables.F90 and MOM.F90. +!! +!! It is useful for sending these variables for diagnostics, and in preparation for ensembles !! later on. All variables have the same names as the local (public) variables !! they refer to in MOM.F90. type, public :: ocean_internal_state @@ -143,11 +141,10 @@ module MOM_variables v_prev => NULL() !< Pointer to meridional velocity at the end of the last timestep end type ocean_internal_state -!> The accel_diag_ptrs structure contains pointers to arrays with accelerations, -!! which can later be used for derived diagnostics, like energy balances. +!> Pointers to arrays with accelerations, which can later be used for derived diagnostics, like energy balances. type, public :: accel_diag_ptrs -! Each of the following fields has nz layers. + ! Each of the following fields has nz layers. real, pointer, dimension(:,:,:) :: & diffu => NULL(), & !< Zonal acceleration due to along isopycnal viscosity, in m s-2. diffv => NULL(), & !< Meridional acceleration due to along isopycnal viscosity, in m s-2. @@ -174,8 +171,7 @@ module MOM_variables end type accel_diag_ptrs -!> The cont_diag_ptrs structure contains pointers to arrays with transports, -!! which can later be used for derived diagnostics, like energy balances. +!> Pointers to arrays with transports, which can later be used for derived diagnostics, like energy balances. type, public :: cont_diag_ptrs ! Each of the following fields has nz layers. @@ -190,8 +186,7 @@ module MOM_variables end type cont_diag_ptrs -!> The vertvisc_type structure contains vertical viscosities, drag -!! coefficients, and related fields. +!> Vertical viscosities, drag coefficients, and related fields. type, public :: vertvisc_type real :: Prandtl_turb !< The Prandtl number for the turbulent diffusion !! that is captured in Kd_shear. @@ -256,8 +251,8 @@ module MOM_variables !! at the interfaces. This is done in find_coupling_coef. end type vertvisc_type -!> The BT_cont_type structure contains information about the summed layer -!! transports and how they will vary as the barotropic velocity is changed. +!> Container for information about the summed layer transports +!! and how they will vary as the barotropic velocity is changed. type, public :: BT_cont_type real, allocatable :: FA_u_EE(:,:) !< The effective open face area for zonal barotropic transport !! drawing from locations far to the east, in H m. @@ -291,8 +286,8 @@ module MOM_variables contains -!> This subroutine allocates the fields for the surface (return) properties of -!! the ocean model. Unused fields are unallocated. +!> Allocates the fields for the surface (return) properties of +!! the ocean model. Unused fields are unallocated. subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & gas_fields_ocn) type(ocean_grid_type), intent(in) :: G !< ocean grid structure @@ -350,7 +345,7 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & end subroutine allocate_surface_state -!> This subroutine deallocates the elements of a surface state type. +!> Deallocates the elements of a surface state type. subroutine deallocate_surface_state(sfc_state) type(surface), intent(inout) :: sfc_state !< ocean surface state type to be deallocated. @@ -374,8 +369,7 @@ subroutine deallocate_surface_state(sfc_state) end subroutine deallocate_surface_state -!> alloc_BT_cont_type allocates the arrays contained within a BT_cont_type and -!! initializes them to 0. +!> Allocates the arrays contained within a BT_cont_type and initializes them to 0. subroutine alloc_BT_cont_type(BT_cont, G, alloc_faces) type(BT_cont_type), pointer :: BT_cont !< The BT_cont_type whose elements will be allocated type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -411,7 +405,7 @@ subroutine alloc_BT_cont_type(BT_cont, G, alloc_faces) end subroutine alloc_BT_cont_type -!> dealloc_BT_cont_type deallocates the arrays contained within a BT_cont_type. +!> Deallocates the arrays contained within a BT_cont_type. subroutine dealloc_BT_cont_type(BT_cont) type(BT_cont_type), pointer :: BT_cont !< The BT_cont_type whose elements will be deallocated. @@ -432,8 +426,7 @@ subroutine dealloc_BT_cont_type(BT_cont) end subroutine dealloc_BT_cont_type -!> MOM_thermovar_chksum does diagnostic checksums on various elements of a -!! thermo_var_ptrs type for debugging. +!> Diagnostic checksums on various elements of a thermo_var_ptrs type for debugging. subroutine MOM_thermovar_chksum(mesg, tv, G) character(len=*), intent(in) :: mesg !< A message that appears in the checksum lines type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables diff --git a/src/framework/MOM_coms.F90 b/src/framework/MOM_coms.F90 index 7b468d1964..40ea23945e 100644 --- a/src/framework/MOM_coms.F90 +++ b/src/framework/MOM_coms.F90 @@ -47,9 +47,11 @@ module MOM_coms end interface reproducing_sum !> The Extended Fixed Point (EFP) type provides a public interface for doing sums -!! and taking differences with this type. The use of this type is documented in +!! and taking differences with this type. +!! +!! The use of this type is documented in !! Hallberg, R. & A. Adcroft, 2014: An Order-invariant Real-to-Integer Conversion Sum. -!! Parallel Computing, 40(5-6), doi:10.1016/j.parco.2014.04.007. +!! Parallel Computing, 40(5-6), doi:10.1016/j.parco.2014.04.007. type, public :: EFP_type ; private integer(kind=8), dimension(ni) :: v !< The value in this type end type EFP_type diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index a309a32a59..b87cc71b7a 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -127,6 +127,7 @@ module MOM_diag_mediator end type diag_grid_storage !> This type is used to represent a diagnostic at the diag_mediator level. +!! !! There can be both 'primary' and 'seconday' diagnostics. The primaries !! reside in the diag_cs%diags array. They have an id which is an index !! into this array. The secondaries are 'variations' on the primary diagnostic. diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index dd21aabe3f..737e7a3fbf 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -1,15 +1,17 @@ -!> This module is used for runtime remapping of diagnostics to z star, sigma and -!! rho vertical coordinates. It defines the diag_remap_ctrl type which -!! represents a remapping of diagnostics to a particular vertical coordinate. -!! The module is used by the diag mediator module in the following way: -!! 1) _init() is called to initialise a diag_remap_ctrl instance. -!! 2) _configure_axes() is called to read the configuration file and set up the +!> provides runtime remapping of diagnostics to z star, sigma and +!! rho vertical coordinates. +!! +!! The diag_remap_ctrl type represents a remapping of diagnostics to a particular +!! vertical coordinate. The module is used by the diag mediator module in the +!! following way: +!! 1. diag_remap_init() is called to initialize a diag_remap_ctrl instance. +!! 2. diag_remap_configure_axes() is called to read the configuration file and set up the !! vertical coordinate / axes definitions. -!! 3) _get_axes_info() returns information needed for the diag mediator to +!! 3. diag_remap_get_axes_info() returns information needed for the diag mediator to !! define new axes for the remapped diagnostics. -!! 4) _update() is called periodically (whenever h, T or S change) to either +!! 4. diag_remap_update() is called periodically (whenever h, T or S change) to either !! create or update the target remapping grids. -!! 5) _do_remap() is called from within a diag post() to do the remapping before +!! 5. diag_remap_do_remap() is called from within a diag post() to do the remapping before !! the diagnostic is written out. module MOM_diag_remap @@ -53,8 +55,8 @@ module MOM_diag_remap public vertically_interpolate_diag_field public horizontally_average_diag_field -!> This type represents remapping of diagnostics to a particular vertical -!! coordinate. +!> Represents remapping of diagnostics to a particular vertical coordinate. +!! !! There is one of these types for each vertical coordinate. The vertical axes !! of a diagnostic will reference an instance of this type indicating how (or !! if) the diagnostic should be vertically remapped when being posted. diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 631adfe57b..ec285072ed 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -1,11 +1,12 @@ !> This module contains the routines used to apply sponge layers when using !! the ALE mode. +!! !! Applying sponges requires the following: -!! (1) initialize_ALE_sponge -!! (2) set_up_ALE_sponge_field (tracers) and set_up_ALE_sponge_vel_field (vel) -!! (3) apply_ALE_sponge -!! (4) init_ALE_sponge_diags (not being used for now) -!! (5) ALE_sponge_end (not being used for now) +!! 1. initialize_ALE_sponge +!! 2. set_up_ALE_sponge_field (tracers) and set_up_ALE_sponge_vel_field (vel) +!! 3. apply_ALE_sponge +!! 4. init_ALE_sponge_diags (not being used for now) +!! 5. ALE_sponge_end (not being used for now) module MOM_ALE_sponge @@ -40,6 +41,7 @@ module MOM_ALE_sponge end interface !> Ddetermine the number of points which are within sponges in this computational domain. +!! !! Only points that have positive values of Iresttime and which mask2dT indicates are ocean !! points are included in the sponges. It also stores the target interface heights. interface initialize_ALE_sponge diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 6864b2ce19..40e8ef6db5 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -1,20 +1,14 @@ -!> This module contains the routines used to set up and use a set of (one for now) -!! dynamically passive tracers. For now, just one passive tracer is injected in +!> Routines used to set up and use a set of (one for now) +!! dynamically passive tracers in the ISOMIP configuration. +!! +!! For now, just one passive tracer is injected in !! the sponge layer. -!! Set up and use passive tracers requires the following: -!! (1) register_ISOMIP_tracer -!! (2) module ISOMIP_tracer ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* Original sample tracer package by Robert Hallberg, 2002 * -!* Adapted to the ISOMIP test case by Gustavo Marques, May 2016 * -!* * -!********+*********+*********+*********+*********+*********+*********+** - +! Original sample tracer package by Robert Hallberg, 2002 +! Adapted to the ISOMIP test case by Gustavo Marques, May 2016 use MOM_diag_mediator, only : diag_ctrl use MOM_diag_to_Z, only : diag_to_Z_CS diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index 2e8da7299f..20a68c9d21 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -268,35 +268,19 @@ subroutine dyed_obc_tracer_end(CS) end subroutine dyed_obc_tracer_end !> \namespace dyed_obc_tracer -!! * -!! By Kate Hedstrom, 2017, copied from DOME tracers and also * -!! dye_example. * -!! * -!! This file contains an example of the code that is needed to set * -!! up and use a set of dynamically passive tracers. These tracers * -!! dye the inflowing water, one per open boundary segment. * -!! * -!! A single subroutine is called from within each file to register * -!! each of the tracers for reinitialization and advection and to * -!! register the subroutine that initializes the tracers and set up * -!! their output and the subroutine that does any tracer physics or * -!! chemistry along with diapycnal mixing (included here because some * -!! tracers may float or swim vertically or dye diapycnal processes). * -!! * -!! Macros written all in capital letters are defined in MOM_memory.h. * -!! * -!! A small fragment of the grid is shown below: * -!! * -!! j+1 x ^ x ^ x At x: q * -!! j+1 > o > o > At ^: v * -!! j x ^ x ^ x At >: u * -!! j > o > o > At o: h, tr * -!! j-1 x ^ x ^ x * -!! i-1 i i+1 At x & ^: * -!! i i+1 At > & o: * -!! * -!! The boundaries always run through q grid points (x). * -!! * -!!*******+*********+*********+*********+*********+*********+*********+** +!! +!! By Kate Hedstrom, 2017, copied from DOME tracers and also +!! dye_example. +!! +!! This file contains an example of the code that is needed to set +!! up and use a set of dynamically passive tracers. These tracers +!! dye the inflowing water, one per open boundary segment. +!! +!! A single subroutine is called from within each file to register +!! each of the tracers for reinitialization and advection and to +!! register the subroutine that initializes the tracers and set up +!! their output and the subroutine that does any tracer physics or +!! chemistry along with diapycnal mixing (included here because some +!! tracers may float or swim vertically or dye diapycnal processes). end module dyed_obc_tracer From ec4fe6e0437bf659230e834feb24f2ef790dcf9c Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 11 Jul 2018 09:31:19 -0400 Subject: [PATCH 0578/1072] Fix CPP-related doxygen errors in MOM_barotropic.F90 - Single quotes throw the pre-processor off when expanding the ALLOCABLE_ macro. --- src/core/MOM_barotropic.F90 | 143 ++++++++++++++++-------------------- 1 file changed, 65 insertions(+), 78 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 1053478d1e..940c99b8be 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1,79 +1,8 @@ +!> Baropotric solver module MOM_barotropic ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, April 1994 - January 2007 * -!* * -!* This program contains the subroutines that time steps the * -!* linearized barotropic equations. btstep is used to actually * -!* time step the barotropic equations, and contains most of the * -!* substance of this module. * -!* * -!* btstep uses a forwards-backwards based scheme to time step * -!* the barotropic equations, returning the layers' accelerations due * -!* to the barotropic changes in the ocean state, the final free * -!* surface height (or column mass), and the volume (or mass) fluxes * -!* summed through the layers and averaged over the baroclinic time * -!* step. As input, btstep takes the initial 3-D velocities, the * -!* inital free surface height, the 3-D accelerations of the layers, * -!* and the external forcing. Everything in btstep is cast in terms * -!* of anomalies, so if everything is in balance, there is explicitly * -!* no acceleration due to btstep. * -!* * -!* The spatial discretization of the continuity equation is second * -!* order accurate. A flux conservative form is used to guarantee * -!* global conservation of volume. The spatial discretization of the * -!* momentum equation is second order accurate. The Coriolis force * -!* is written in a form which does not contribute to the energy * -!* tendency and which conserves linearized potential vorticity, f/D. * -!* These terms are exactly removed from the baroclinic momentum * -!* equations, so the linearization of vorticity advection will not * -!* degrade the overall solution. * -!* * -!* btcalc calculates the fractional thickness of each layer at the * -!* velocity points, for later use in calculating the barotropic * -!* velocities and the averaged accelerations. Harmonic mean * -!* thicknesses (i.e. 2*h_L*h_R/(h_L + h_R)) are used to avoid overly * -!* strong weighting of overly thin layers. This may later be relaxed * -!* to use thicknesses determined from the continuity equations. * -!* * -!* bt_mass_source determines the real mass sources for the * -!* barotropic solver, along with the corrective pseudo-fluxes that * -!* keep the barotropic and baroclinic estimates of the free surface * -!* height close to each other. Given the layer thicknesses and the * -!* free surface height that correspond to each other, it calculates * -!* a corrective mass source that is added to the barotropic continuity* -!* equation, and optionally adjusts a slowly varying correction rate. * -!* Newer algorithmic changes have deemphasized the need for this, but * -!* it is still here to add net water sources to the barotropic solver.* -!* * -!* barotropic_init allocates and initializes any barotropic arrays * -!* that have not been read from a restart file, reads parameters from * -!* the inputfile, and sets up diagnostic fields. * -!* * -!* barotropic_end deallocates anything allocated in barotropic_init * -!* or register_barotropic_restarts. * -!* * -!* register_barotropic_restarts is used to indicate any fields that * -!* are private to the barotropic solver that need to be included in * -!* the restart files, and to ensure that they are read. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q, CoriolisBu * -!* j+1 > o > o > At ^: v_in, vbt, accel_layer_v, vbtav * -!* j x ^ x ^ x At >: u_in, ubt, accel_layer_u, ubtav, amer * -!* j > o > o > At o: eta, h, bathyT, pbce * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 * -!* i i+1 * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_debugging, only : hchksum, uvchksum use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE use MOM_diag_mediator, only : post_data, query_averaging_enabled, register_diag_field @@ -172,10 +101,10 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: lin_drag_u !< A spatially varying linear drag coefficient acting on the zonal barotropic flow, in H s-1. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt_IC - !< The barotropic solver's estimate of the zonal transport as the initial condition for + !< The barotropic solvers estimate of the zonal transport as the initial condition for !! the next call to btstep, in H m2 s-1. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: ubt_IC - !< The barotropic solver's estimate of the zonal velocity that will be the initial + !< The barotropic solvers estimate of the zonal velocity that will be the initial !! condition for the next call to btstep, in m s-1. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: ubtav !< The barotropic zonal velocity averaged over the baroclinic time step, m s-1. @@ -184,10 +113,10 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: lin_drag_v !< A spatially varying linear drag coefficient acting on the zonal barotropic flow, in H s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt_IC - !< The barotropic solver's estimate of the zonal transport as the initial condition for + !< The barotropic solvers estimate of the zonal transport as the initial condition for !! the next call to btstep, in H m2 s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vbt_IC - !< The barotropic solver's estimate of the zonal velocity that will be the initial + !< The barotropic solvers estimate of the zonal velocity that will be the initial !! condition for the next call to btstep, in m s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vbtav !< The barotropic meridional velocity averaged over the baroclinic time step, m s-1. @@ -219,7 +148,7 @@ module MOM_barotropic real, dimension(:,:,:), pointer :: frhatu1 => NULL() !< Predictor step values of frhatu stored for diagnostics. real, dimension(:,:,:), pointer :: frhatv1 => NULL() !< Predictor step values of frhatv stored for diagnostics. - type(BT_OBC_type) :: BT_OBC !< A structure with all of this module's fields + type(BT_OBC_type) :: BT_OBC !< A structure with all of this modules fields !! for applying open boundary conditions. real :: Rho0 !< The density used in the Boussinesq @@ -328,7 +257,7 @@ module MOM_barotropic logical :: use_old_coriolis_bracket_bug !< If True, use an order of operations !! that is not bitwise rotationally symmetric in the !! meridional Coriolis term of the barotropic solver. - type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. + type(time_type), pointer :: Time => NULL() !< A pointer to the ocean models clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate !! the timing of diagnostic output. type(MOM_domain_type), pointer :: BT_Domain => NULL() @@ -4506,4 +4435,62 @@ subroutine register_barotropic_restarts(HI, GV, param_file, CS, restart_CS) end subroutine register_barotropic_restarts +!> \namespace mom_barotropic +!! +!! By Robert Hallberg, April 1994 - January 2007 +!! +!! This program contains the subroutines that time steps the +!! linearized barotropic equations. btstep is used to actually +!! time step the barotropic equations, and contains most of the +!! substance of this module. +!! +!! btstep uses a forwards-backwards based scheme to time step +!! the barotropic equations, returning the layers' accelerations due +!! to the barotropic changes in the ocean state, the final free +!! surface height (or column mass), and the volume (or mass) fluxes +!! summed through the layers and averaged over the baroclinic time +!! step. As input, btstep takes the initial 3-D velocities, the +!! inital free surface height, the 3-D accelerations of the layers, +!! and the external forcing. Everything in btstep is cast in terms +!! of anomalies, so if everything is in balance, there is explicitly +!! no acceleration due to btstep. +!! +!! The spatial discretization of the continuity equation is second +!! order accurate. A flux conservative form is used to guarantee +!! global conservation of volume. The spatial discretization of the +!! momentum equation is second order accurate. The Coriolis force +!! is written in a form which does not contribute to the energy +!! tendency and which conserves linearized potential vorticity, f/D. +!! These terms are exactly removed from the baroclinic momentum +!! equations, so the linearization of vorticity advection will not +!! degrade the overall solution. +!! +!! btcalc calculates the fractional thickness of each layer at the +!! velocity points, for later use in calculating the barotropic +!! velocities and the averaged accelerations. Harmonic mean +!! thicknesses (i.e. 2*h_L*h_R/(h_L + h_R)) are used to avoid overly +!! strong weighting of overly thin layers. This may later be relaxed +!! to use thicknesses determined from the continuity equations. +!! +!! bt_mass_source determines the real mass sources for the +!! barotropic solver, along with the corrective pseudo-fluxes that +!! keep the barotropic and baroclinic estimates of the free surface +!! height close to each other. Given the layer thicknesses and the +!! free surface height that correspond to each other, it calculates +!! a corrective mass source that is added to the barotropic continuity* +!! equation, and optionally adjusts a slowly varying correction rate. +!! Newer algorithmic changes have deemphasized the need for this, but +!! it is still here to add net water sources to the barotropic solver.* +!! +!! barotropic_init allocates and initializes any barotropic arrays +!! that have not been read from a restart file, reads parameters from +!! the inputfile, and sets up diagnostic fields. +!! +!! barotropic_end deallocates anything allocated in barotropic_init +!! or register_barotropic_restarts. +!! +!! register_barotropic_restarts is used to indicate any fields that +!! are private to the barotropic solver that need to be included in +!! the restart files, and to ensure that they are read. + end module MOM_barotropic From 59bb93a7d3ff5fef0680faa3e2e83472da6bc8e1 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 11 Jul 2018 15:35:39 -0400 Subject: [PATCH 0579/1072] Regenerated Doxygen configuration file with v1.8.15 --- docs/Doxyfile_nortd | 134 ++++++++++++++++++++++++++------------------ 1 file changed, 81 insertions(+), 53 deletions(-) diff --git a/docs/Doxyfile_nortd b/docs/Doxyfile_nortd index 507eaf2743..7e1fcc39cf 100644 --- a/docs/Doxyfile_nortd +++ b/docs/Doxyfile_nortd @@ -1,4 +1,4 @@ -# Doxyfile 1.8.12 +# Doxyfile 1.8.15 # This file describes the settings to be used by the documentation system # doxygen (www.doxygen.org) for a project. @@ -17,11 +17,11 @@ # Project related configuration options #--------------------------------------------------------------------------- -# This tag specifies the encoding used for all characters in the config file -# that follow. The default is UTF-8 which is also the encoding used for all text -# before the first occurrence of this tag. Doxygen uses libiconv (or the iconv -# built into libc) for the transcoding. See http://www.gnu.org/software/libiconv -# for the list of possible encodings. +# This tag specifies the encoding used for all characters in the configuration +# file that follow. The default is UTF-8 which is also the encoding used for all +# text before the first occurrence of this tag. Doxygen uses libiconv (or the +# iconv built into libc) for the transcoding. See +# https://www.gnu.org/software/libiconv/ for the list of possible encodings. # The default value is: UTF-8. DOXYFILE_ENCODING = UTF-8 @@ -58,7 +58,7 @@ PROJECT_LOGO = # entered, it will be relative to the location where doxygen was started. If # left blank the current directory will be used. -#OUTPUT_DIRECTORY = +OUTPUT_DIRECTORY = # If the CREATE_SUBDIRS tag is set to YES then doxygen will create 4096 sub- # directories (in 2 levels) under the output directory of each output format and @@ -93,6 +93,14 @@ ALLOW_UNICODE_NAMES = NO OUTPUT_LANGUAGE = English +# The OUTPUT_TEXT_DIRECTION tag is used to specify the direction in which all +# documentation generated by doxygen is written. Doxygen will use this +# information to generate all generated output in the proper direction. +# Possible values are: None, LTR, RTL and Context. +# The default value is: None. + +OUTPUT_TEXT_DIRECTION = None + # If the BRIEF_MEMBER_DESC tag is set to YES, doxygen will include brief member # descriptions after the members that are listed in the file and class # documentation (similar to Javadoc). Set to NO to disable this. @@ -226,7 +234,8 @@ TAB_SIZE = 2 # will allow you to put the command \sideeffect (or @sideeffect) in the # documentation, which will result in a user-defined paragraph with heading # "Side Effects:". You can put \n's in the value part of an alias to insert -# newlines. +# newlines (in the resulting output). You can put ^^ in the value part of an +# alias to insert a newline as if a physical newline was in the original file. ALIASES = @@ -327,7 +336,7 @@ BUILTIN_STL_SUPPORT = NO CPP_CLI_SUPPORT = NO # Set the SIP_SUPPORT tag to YES if your project consists of sip (see: -# http://www.riverbankcomputing.co.uk/software/sip/intro) sources only. Doxygen +# https://www.riverbankcomputing.com/software/sip/intro) sources only. Doxygen # will parse them like normal C++ but will assume all classes use public instead # of private inheritance when no explicit protection keyword is present. # The default value is: NO. @@ -698,7 +707,7 @@ LAYOUT_FILE = layout.xml # The CITE_BIB_FILES tag can be used to specify one or more bib files containing # the reference definitions. This must be a list of .bib files. The .bib # extension is automatically appended if omitted. This requires the bibtex tool -# to be installed. See also http://en.wikipedia.org/wiki/BibTeX for more info. +# to be installed. See also https://en.wikipedia.org/wiki/BibTeX for more info. # For LaTeX the style of the bibliography can be controlled using # LATEX_BIB_STYLE. To use this feature you need bibtex and perl available in the # search path. See also \cite for info how to create references. @@ -743,7 +752,8 @@ WARN_IF_DOC_ERROR = YES # This WARN_NO_PARAMDOC option can be enabled to get warnings for functions that # are documented, but have no documentation for their parameters or return # value. If set to NO, doxygen will only warn about wrong or incomplete -# parameter documentation, but not about the absence of documentation. +# parameter documentation, but not about the absence of documentation. If +# EXTRACT_ALL is set to YES then this flag will automatically be disabled. # The default value is: NO. WARN_NO_PARAMDOC = NO @@ -777,7 +787,7 @@ WARN_LOGFILE = doxygen.log # The INPUT tag is used to specify the files and/or directories that contain # documented source files. You may enter file names like myfile.cpp or # directories like /usr/src/myproject. Separate the files or directories with -# spaces. +# spaces. See also FILE_PATTERNS and EXTENSION_MAPPING # Note: If this tag is empty the current directory is searched. INPUT = ../src \ @@ -790,7 +800,7 @@ INPUT = ../src \ # This tag can be used to specify the character encoding of the source files # that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses # libiconv (or the iconv built into libc) for the transcoding. See the libiconv -# documentation (see: http://www.gnu.org/software/libiconv) for the list of +# documentation (see: https://www.gnu.org/software/libiconv/) for the list of # possible encodings. # The default value is: UTF-8. @@ -807,8 +817,8 @@ INPUT_ENCODING = UTF-8 # If left blank the following patterns are tested:*.c, *.cc, *.cxx, *.cpp, # *.c++, *.java, *.ii, *.ixx, *.ipp, *.i++, *.inl, *.idl, *.ddl, *.odl, *.h, # *.hh, *.hxx, *.hpp, *.h++, *.cs, *.d, *.php, *.php4, *.php5, *.phtml, *.inc, -# *.m, *.markdown, *.md, *.mm, *.dox, *.py, *.pyw, *.f90, *.f, *.for, *.tcl, -# *.vhd, *.vhdl, *.ucf and *.qsf. +# *.m, *.markdown, *.md, *.mm, *.dox, *.py, *.pyw, *.f90, *.f95, *.f03, *.f08, +# *.f, *.for, *.tcl, *.vhd, *.vhdl, *.ucf and *.qsf. FILE_PATTERNS = *.c \ *.cc \ @@ -860,7 +870,9 @@ EXCLUDE_SYMLINKS = NO # Note that the wildcards are matched against the file with absolute path, so to # exclude all test directories for example use the pattern */test/* -EXCLUDE_PATTERNS = makedep.py Makefile INSTALL +EXCLUDE_PATTERNS = makedep.py \ + Makefile \ + INSTALL # The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names # (namespaces, classes, functions, etc.) that should be excluded from the @@ -897,7 +909,8 @@ EXAMPLE_RECURSIVE = NO # that contain images that are to be included in the documentation (see the # \image command). -IMAGE_PATH = images ../src +IMAGE_PATH = images \ + ../src # The INPUT_FILTER tag can be used to specify a program that doxygen should # invoke to filter for each input file. Doxygen will invoke the filter program @@ -982,7 +995,7 @@ INLINE_SOURCES = YES STRIP_CODE_COMMENTS = NO # If the REFERENCED_BY_RELATION tag is set to YES then for each documented -# function all documented functions referencing it will be listed. +# entity all documented functions referencing it will be listed. # The default value is: NO. REFERENCED_BY_RELATION = YES @@ -1014,12 +1027,12 @@ SOURCE_TOOLTIPS = YES # If the USE_HTAGS tag is set to YES then the references to source code will # point to the HTML generated by the htags(1) tool instead of doxygen built-in # source browser. The htags tool is part of GNU's global source tagging system -# (see http://www.gnu.org/software/global/global.html). You will need version +# (see https://www.gnu.org/software/global/global.html). You will need version # 4.8.6 or higher. # # To use it do the following: # - Install the latest version of global -# - Enable SOURCE_BROWSER and USE_HTAGS in the config file +# - Enable SOURCE_BROWSER and USE_HTAGS in the configuration file # - Make sure the INPUT points to the root of the source tree # - Run doxygen as normal # @@ -1159,7 +1172,7 @@ HTML_EXTRA_FILES = # The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. Doxygen # will adjust the colors in the style sheet and background images according to # this color. Hue is specified as an angle on a colorwheel, see -# http://en.wikipedia.org/wiki/Hue for more information. For instance the value +# https://en.wikipedia.org/wiki/Hue for more information. For instance the value # 0 represents red, 60 is yellow, 120 is green, 180 is cyan, 240 is blue, 300 # purple, and 360 is red again. # Minimum value: 0, maximum value: 359, default value: 220. @@ -1189,12 +1202,23 @@ HTML_COLORSTYLE_GAMMA = 80 # If the HTML_TIMESTAMP tag is set to YES then the footer of each generated HTML # page will contain the date and time when the page was generated. Setting this # to YES can help to show when doxygen was last run and thus if the -# to NO can help when comparing the output of multiple runs. -# The default value is: YES. +# documentation is up to date. +# The default value is: NO. # This tag requires that the tag GENERATE_HTML is set to YES. HTML_TIMESTAMP = NO +# If the HTML_DYNAMIC_MENUS tag is set to YES then the generated HTML +# documentation will contain a main index with vertical navigation menus that +# are dynamically created via Javascript. If disabled, the navigation index will +# consists of multiple levels of tabs that are statically embedded in every HTML +# page. Disable this option to support browsers that do not have Javascript, +# like the Qt help browser. +# The default value is: YES. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_DYNAMIC_MENUS = YES + # If the HTML_DYNAMIC_SECTIONS tag is set to YES then the generated HTML # documentation will contain sections that can be hidden and shown after the # page has loaded. @@ -1218,12 +1242,12 @@ HTML_INDEX_NUM_ENTRIES = 900 # If the GENERATE_DOCSET tag is set to YES, additional index files will be # generated that can be used as input for Apple's Xcode 3 integrated development -# environment (see: http://developer.apple.com/tools/xcode/), introduced with +# environment (see: https://developer.apple.com/tools/xcode/), introduced with # OSX 10.5 (Leopard). To create a documentation set, doxygen will generate a # Makefile in the HTML output directory. Running make will produce the docset in # that directory and running make install will install the docset in # ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find it at -# startup. See http://developer.apple.com/tools/creatingdocsetswithdoxygen.html +# startup. See https://developer.apple.com/tools/creatingdocsetswithdoxygen.html # for more information. # The default value is: NO. # This tag requires that the tag GENERATE_HTML is set to YES. @@ -1339,7 +1363,7 @@ QCH_FILE = # The QHP_NAMESPACE tag specifies the namespace to use when generating Qt Help # Project output. For more information please see Qt Help Project / Namespace -# (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#namespace). +# (see: http://doc.qt.io/qt-4.8/qthelpproject.html#namespace). # The default value is: org.doxygen.Project. # This tag requires that the tag GENERATE_QHP is set to YES. @@ -1347,8 +1371,7 @@ QHP_NAMESPACE = org.doxygen.Project # The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating Qt # Help Project output. For more information please see Qt Help Project / Virtual -# Folders (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#virtual- -# folders). +# Folders (see: http://doc.qt.io/qt-4.8/qthelpproject.html#virtual-folders). # The default value is: doc. # This tag requires that the tag GENERATE_QHP is set to YES. @@ -1356,23 +1379,21 @@ QHP_VIRTUAL_FOLDER = doc # If the QHP_CUST_FILTER_NAME tag is set, it specifies the name of a custom # filter to add. For more information please see Qt Help Project / Custom -# Filters (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#custom- -# filters). +# Filters (see: http://doc.qt.io/qt-4.8/qthelpproject.html#custom-filters). # This tag requires that the tag GENERATE_QHP is set to YES. QHP_CUST_FILTER_NAME = # The QHP_CUST_FILTER_ATTRS tag specifies the list of the attributes of the # custom filter to add. For more information please see Qt Help Project / Custom -# Filters (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#custom- -# filters). +# Filters (see: http://doc.qt.io/qt-4.8/qthelpproject.html#custom-filters). # This tag requires that the tag GENERATE_QHP is set to YES. QHP_CUST_FILTER_ATTRS = # The QHP_SECT_FILTER_ATTRS tag specifies the list of the attributes this # project's filter section matches. Qt Help Project / Filter Attributes (see: -# http://qt-project.org/doc/qt-4.8/qthelpproject.html#filter-attributes). +# http://doc.qt.io/qt-4.8/qthelpproject.html#filter-attributes). # This tag requires that the tag GENERATE_QHP is set to YES. QHP_SECT_FILTER_ATTRS = @@ -1465,7 +1486,7 @@ EXT_LINKS_IN_WINDOW = NO FORMULA_FONTSIZE = 10 -# Use the FORMULA_TRANPARENT tag to determine whether or not the images +# Use the FORMULA_TRANSPARENT tag to determine whether or not the images # generated for formulas are transparent PNGs. Transparent PNGs are not # supported properly for IE 6.0, but are supported on all modern browsers. # @@ -1477,7 +1498,7 @@ FORMULA_FONTSIZE = 10 FORMULA_TRANSPARENT = YES # Enable the USE_MATHJAX option to render LaTeX formulas using MathJax (see -# http://www.mathjax.org) which uses client side Javascript for the rendering +# https://www.mathjax.org) which uses client side Javascript for the rendering # instead of using pre-rendered bitmaps. Use this if you do not have LaTeX # installed or if you want to formulas look prettier in the HTML output. When # enabled you may also need to install MathJax separately and configure the path @@ -1504,8 +1525,8 @@ MATHJAX_FORMAT = HTML-CSS # MATHJAX_RELPATH should be ../mathjax. The default value points to the MathJax # Content Delivery Network so you can quickly see the result without installing # MathJax. However, it is strongly recommended to install a local copy of -# MathJax from http://www.mathjax.org before deployment. -# The default value is: http://cdn.mathjax.org/mathjax/latest. +# MathJax from https://www.mathjax.org before deployment. +# The default value is: https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.2/. # This tag requires that the tag USE_MATHJAX is set to YES. MATHJAX_RELPATH = http://cdn.mathjax.org/mathjax/latest @@ -1566,7 +1587,7 @@ SERVER_BASED_SEARCH = NO # # Doxygen ships with an example indexer (doxyindexer) and search engine # (doxysearch.cgi) which are based on the open source search engine library -# Xapian (see: http://xapian.org/). +# Xapian (see: https://xapian.org/). # # See the section "External Indexing and Searching" for details. # The default value is: NO. @@ -1579,7 +1600,7 @@ EXTERNAL_SEARCH = NO # # Doxygen ships with an example indexer (doxyindexer) and search engine # (doxysearch.cgi) which are based on the open source search engine library -# Xapian (see: http://xapian.org/). See the section "External Indexing and +# Xapian (see: https://xapian.org/). See the section "External Indexing and # Searching" for details. # This tag requires that the tag SEARCHENGINE is set to YES. @@ -1631,10 +1652,11 @@ LATEX_OUTPUT = latex # The LATEX_CMD_NAME tag can be used to specify the LaTeX command name to be # invoked. # -# Note that when enabling USE_PDFLATEX this option is only used for generating -# bitmaps for formulas in the HTML output, but not in the Makefile that is -# written to the output directory. -# The default file is: latex. +# Note that when not enabling USE_PDFLATEX the default is latex when enabling +# USE_PDFLATEX the default is pdflatex and when in the later case latex is +# chosen this is overwritten by pdflatex. For specific output languages the +# default can have been set differently, this depends on the implementation of +# the output language. # This tag requires that the tag GENERATE_LATEX is set to YES. LATEX_CMD_NAME = latex @@ -1766,7 +1788,7 @@ LATEX_SOURCE_CODE = NO # The LATEX_BIB_STYLE tag can be used to specify the style to use for the # bibliography, e.g. plainnat, or ieeetr. See -# http://en.wikipedia.org/wiki/BibTeX and \cite for more info. +# https://en.wikipedia.org/wiki/BibTeX and \cite for more info. # The default value is: plain. # This tag requires that the tag GENERATE_LATEX is set to YES. @@ -1819,9 +1841,9 @@ COMPACT_RTF = NO RTF_HYPERLINKS = NO -# Load stylesheet definitions from file. Syntax is similar to doxygen's config -# file, i.e. a series of assignments. You only have to provide replacements, -# missing definitions are set to their default value. +# Load stylesheet definitions from file. Syntax is similar to doxygen's +# configuration file, i.e. a series of assignments. You only have to provide +# replacements, missing definitions are set to their default value. # # See also section "Doxygen usage" for information on how to generate the # default style sheet that doxygen normally uses. @@ -1830,8 +1852,8 @@ RTF_HYPERLINKS = NO RTF_STYLESHEET_FILE = # Set optional variables used in the generation of an RTF document. Syntax is -# similar to doxygen's config file. A template extensions file can be generated -# using doxygen -e rtf extensionFile. +# similar to doxygen's configuration file. A template extensions file can be +# generated using doxygen -e rtf extensionFile. # This tag requires that the tag GENERATE_RTF is set to YES. RTF_EXTENSIONS_FILE = @@ -1949,9 +1971,9 @@ DOCBOOK_PROGRAMLISTING = NO #--------------------------------------------------------------------------- # If the GENERATE_AUTOGEN_DEF tag is set to YES, doxygen will generate an -# AutoGen Definitions (see http://autogen.sf.net) file that captures the -# structure of the code including all documentation. Note that this feature is -# still experimental and incomplete at the moment. +# AutoGen Definitions (see http://autogen.sourceforge.net/) file that captures +# the structure of the code including all documentation. Note that this feature +# is still experimental and incomplete at the moment. # The default value is: NO. GENERATE_AUTOGEN_DEF = NO @@ -2033,7 +2055,8 @@ SEARCH_INCLUDES = YES # preprocessor. # This tag requires that the tag SEARCH_INCLUDES is set to YES. -INCLUDE_PATH = ../src/framework ../config_src/dynamic_symmetric +INCLUDE_PATH = ../src/framework \ + ../config_src/dynamic_symmetric # You can use the INCLUDE_FILE_PATTERNS tag to specify one or more wildcard # patterns (like *.h and *.hpp) to filter out the header-files in the @@ -2373,6 +2396,11 @@ DIAFILE_DIRS = PLANTUML_JAR_PATH = +# When using plantuml, the PLANTUML_CFG_FILE tag can be used to specify a +# configuration file for plantuml. + +PLANTUML_CFG_FILE = + # When using plantuml, the specified paths are searched for files specified by # the !include statement in a plantuml block. From 0da8297070d758fa16098af8ff2977256d495688 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 11 Jul 2018 15:56:58 -0400 Subject: [PATCH 0580/1072] Module dOxyGenization for MOM_variables & vertGrid Added dOxygen comments describing the whole MOM_variables and MOM_verticalGrid modules. All answers are bitwise identical. --- src/core/MOM_variables.F90 | 61 +++++++++++++++++------------------ src/core/MOM_verticalGrid.F90 | 54 +++++++++++-------------------- 2 files changed, 49 insertions(+), 66 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index d176b407d3..4165fb0e11 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -1,3 +1,4 @@ +!> Provides transparent structures with groups of MOM6 variables and supporting routines module MOM_variables ! This file is part of MOM6. See LICENSE.md for the license. @@ -116,29 +117,29 @@ module MOM_variables !! they refer to in MOM.F90. type, public :: ocean_internal_state real, pointer, dimension(:,:,:) :: & - T => NULL(), & !< Pointer to the temperature state variable - S => NULL(), & !< Pointer to the salinity state variable - u => NULL(), & !< Pointer to the zonal velocity - v => NULL(), & !< Pointer to the meridional velocity - h => NULL() !< Pointer to the layer thicknesses + T => NULL(), & !< Pointer to the temperature state variable, in deg C + S => NULL(), & !< Pointer to the salinity state variable, in PSU or g/kg + u => NULL(), & !< Pointer to the zonal velocity, in m s-1 + v => NULL(), & !< Pointer to the meridional velocity, in m s-1 + h => NULL() !< Pointer to the layer thicknesses, in H (often m or kg m-2) real, pointer, dimension(:,:,:) :: & - uh => NULL(), & !< Pointer to zonal transports - vh => NULL() !< Pointer to meridional transports + uh => NULL(), & !< Pointer to zonal transports, in H m2 s-1 + vh => NULL() !< Pointer to meridional transports, in H m2 s-1 real, pointer, dimension(:,:,:) :: & - CAu => NULL(), & !< Pointer to the zonal Coriolis and Advective acceleration - CAv => NULL(), & !< Pointer to the meridional Coriolis and Advective acceleration - PFu => NULL(), & !< Pointer to the zonal Pressure force acceleration - PFv => NULL(), & !< Pointer to the meridional Pressure force acceleration - diffu => NULL(), & !< Pointer to the zonal acceleration due to lateral viscosity - diffv => NULL(), & !< Pointer to the meridional acceleration due to lateral viscosity - pbce => NULL(), & !< Pointer to the baroclinic pressure force dependency on free surface movement - u_accel_bt => NULL(), & !< Pointer to the zonal barotropic-solver acceleration - v_accel_bt => NULL() !< Pointer to the meridional barotropic-solver acceleration + CAu => NULL(), & !< Pointer to the zonal Coriolis and Advective acceleration, in m s-2 + CAv => NULL(), & !< Pointer to the meridional Coriolis and Advective acceleration, in m s-2 + PFu => NULL(), & !< Pointer to the zonal Pressure force acceleration, in m s-2 + PFv => NULL(), & !< Pointer to the meridional Pressure force acceleration, in m s-2 + diffu => NULL(), & !< Pointer to the zonal acceleration due to lateral viscosity, in m s-2 + diffv => NULL(), & !< Pointer to the meridional acceleration due to lateral viscosity, in m s-2 + pbce => NULL(), & !< Pointer to the baroclinic pressure force dependency on free surface movement, in s-2 + u_accel_bt => NULL(), & !< Pointer to the zonal barotropic-solver acceleration, in m s-2 + v_accel_bt => NULL() !< Pointer to the meridional barotropic-solver acceleration, in m s-2 real, pointer, dimension(:,:,:) :: & - u_av => NULL(), & !< Pointer to zonal velocity averaged over the timestep - v_av => NULL(), & !< Pointer to meridional velocity averaged over the timestep - u_prev => NULL(), & !< Pointer to zonal velocity at the end of the last timestep - v_prev => NULL() !< Pointer to meridional velocity at the end of the last timestep + u_av => NULL(), & !< Pointer to zonal velocity averaged over the timestep, in m s-1 + v_av => NULL(), & !< Pointer to meridional velocity averaged over the timestep, in m s-1 + u_prev => NULL(), & !< Pointer to zonal velocity at the end of the last timestep, in m s-1 + v_prev => NULL() !< Pointer to meridional velocity at the end of the last timestep, in m s-1 end type ocean_internal_state !> Pointers to arrays with accelerations, which can later be used for derived diagnostics, like energy balances. @@ -234,8 +235,7 @@ module MOM_variables real, pointer, dimension(:,:,:) :: Kd_shear => NULL() !< The shear-driven turbulent diapycnal diffusivity at the interfaces between layers !! in tracer columns, in m2 s-1. - real, pointer, dimension(:,:,:) :: & - Kv_shear => NULL() + real, pointer, dimension(:,:,:) :: Kv_shear => NULL() !< The shear-driven turbulent vertical viscosity at the interfaces between layers !! in tracer columns, in m2 s-1. real, pointer, dimension(:,:,:) :: Kv_shear_Bu => NULL() @@ -290,13 +290,13 @@ module MOM_variables !! the ocean model. Unused fields are unallocated. subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & gas_fields_ocn) - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(surface), intent(inout) :: sfc_state !< ocean surface state type to be allocated. - logical, optional, intent(in) :: use_temperature !< If true, allocate the space for thermodynamic variables. - logical, optional, intent(in) :: do_integrals !< If true, allocate the space for vertically - !! integrated fields. + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(surface), intent(inout) :: sfc_state !< ocean surface state type to be allocated. + logical, optional, intent(in) :: use_temperature !< If true, allocate the space for thermodynamic variables. + logical, optional, intent(in) :: do_integrals !< If true, allocate the space for vertically + !! integrated fields. type(coupler_1d_bc_type), & - optional, intent(in) :: gas_fields_ocn !< If present, this type describes the ocean + optional, intent(in) :: gas_fields_ocn !< If present, this type describes the ocean !! ocean and surface-ice fields that will participate !! in the calculation of additional gas or other !! tracer fluxes, and can be used to spawn related @@ -327,8 +327,7 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & allocate(sfc_state%v(isd:ied,JsdB:JedB)) ; sfc_state%v(:,:) = 0.0 if (alloc_integ) then - ! Allocate structures for the vertically integrated ocean_mass, ocean_heat, - ! and ocean_salt. + ! Allocate structures for the vertically integrated ocean_mass, ocean_heat, and ocean_salt. allocate(sfc_state%ocean_mass(isd:ied,jsd:jed)) ; sfc_state%ocean_mass(:,:) = 0.0 if (use_temp) then allocate(sfc_state%ocean_heat(isd:ied,jsd:jed)) ; sfc_state%ocean_heat(:,:) = 0.0 @@ -347,7 +346,7 @@ end subroutine allocate_surface_state !> Deallocates the elements of a surface state type. subroutine deallocate_surface_state(sfc_state) - type(surface), intent(inout) :: sfc_state !< ocean surface state type to be deallocated. + type(surface), intent(inout) :: sfc_state !< ocean surface state type to be deallocated here. if (.not.sfc_state%arrays_allocated) return diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index f1dda828e0..4eb972148b 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -1,3 +1,4 @@ +!> Provides a transparent vertical ocean grid type and supporting routines module MOM_verticalGrid ! This file is part of MOM6. See LICENSE.md for the license. @@ -56,14 +57,16 @@ module MOM_verticalGrid !> Allocates and initializes the ocean model vertical grid structure. subroutine verticalGridInit( param_file, GV ) -! This routine initializes the verticalGrid_type structure (GV). -! All memory is allocated but not necessarily set to meaningful values until later. type(param_file_type), intent(in) :: param_file !< Parameter file handle/type type(verticalGrid_type), pointer :: GV !< The container for vertical grid data -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This routine initializes the verticalGrid_type structure (GV). + ! All memory is allocated but not necessarily set to meaningful values until later. + + ! Local variables integer :: nk, H_power real :: rescale_factor + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=16) :: mdl = 'MOM_verticalGrid' if (associated(GV)) call MOM_error(FATAL, & @@ -150,14 +153,11 @@ end subroutine verticalGridInit !> Returns the model's thickness units, usually m or kg/m^2. function get_thickness_units(GV) - character(len=48) :: get_thickness_units + character(len=48) :: get_thickness_units !< The vertical thickness units type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure -! This subroutine returns the appropriate units for thicknesses, -! depending on whether the model is Boussinesq or not and the scaling for -! the vertical thickness. - -! Arguments: G - The ocean's grid structure. -! (ret) get_thickness_units - The model's vertical thickness units. + ! This subroutine returns the appropriate units for thicknesses, + ! depending on whether the model is Boussinesq or not and the scaling for + ! the vertical thickness. if (GV%Boussinesq) then get_thickness_units = "m" @@ -168,14 +168,11 @@ end function get_thickness_units !> Returns the model's thickness flux units, usually m^3/s or kg/s. function get_flux_units(GV) - character(len=48) :: get_flux_units + character(len=48) :: get_flux_units !< The thickness flux units type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure -! This subroutine returns the appropriate units for thickness fluxes, -! depending on whether the model is Boussinesq or not and the scaling for -! the vertical thickness. - -! Arguments: G - The ocean's grid structure. -! (ret) get_flux_units - The model's thickness flux units. + ! This subroutine returns the appropriate units for thickness fluxes, + ! depending on whether the model is Boussinesq or not and the scaling for + ! the vertical thickness. if (GV%Boussinesq) then get_flux_units = "m3 s-1" @@ -201,20 +198,9 @@ function get_tr_flux_units(GV, tr_units, tr_vol_conc_units, tr_mass_conc_units) !! the units are mol kg-1, !! tr_vol_conc_units would be mol. -! This subroutine returns the appropriate units for thicknesses and fluxes, -! depending on whether the model is Boussinesq or not and the scaling for -! the vertical thickness. - -! Arguments: G - The ocean's grid structure. -! One of the following three arguments must be present. -! (in,opt) tr_units - Units for a tracer, for example Celsius or PSU. -! (in,opt) tr_vol_conc_units - The concentration units per unit volume, for -! example if the units are umol m-3, -! tr_vol_conc_units would be umol. -! (in,opt) tr_mass_conc_units - The concentration units per unit mass of sea -! water, for example if the units are mol kg-1, -! tr_vol_conc_units would be mol. -! (ret) get_tr_flux_units - The model's flux units for a tracer. + ! This subroutine returns the appropriate units for thicknesses and fluxes, + ! depending on whether the model is Boussinesq or not and the scaling for + ! the vertical thickness. integer :: cnt cnt = 0 @@ -253,7 +239,6 @@ end function get_tr_flux_units !> This sets the coordinate data for the "layer mode" of the isopycnal model. subroutine setVerticalGridAxes( Rlay, GV ) - ! Arguments type(verticalGrid_type), intent(inout) :: GV !< The container for vertical grid data real, dimension(GV%ke), intent(in) :: Rlay !< The layer target density ! Local variables @@ -276,8 +261,7 @@ end subroutine setVerticalGridAxes !> Deallocates the model's vertical grid structure. subroutine verticalGridEnd( GV ) -! Arguments: G - The ocean's grid structure. - type(verticalGrid_type), pointer :: GV !< The ocean's vertical grid structure + type(verticalGrid_type), pointer :: GV !< The ocean's vertical grid structure deallocate( GV%g_prime, GV%Rlay ) deallocate( GV%sInterface , GV%sLayer ) From c621b54eb7ca5638240c5d5c32108bc3ea73fc02 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 11 Jul 2018 15:57:17 -0400 Subject: [PATCH 0581/1072] Module dOxyGenization for MOM Added dOxygen comments describing the whole MOM module and several subroutines within this module. All answers are bitwise identical. --- src/core/MOM.F90 | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index a49bbd6369..c554e4f92e 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1,3 +1,4 @@ +!> The central module of the MOM6 ocean model module MOM ! This file is part of MOM6. See LICENSE.md for the license. @@ -9,7 +10,6 @@ module MOM use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_COMPONENT, CLOCK_SUBCOMPONENT use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE -use MOM_coord_initialization, only : MOM_initialize_coord use MOM_diag_mediator, only : diag_mediator_init, enable_averaging use MOM_diag_mediator, only : diag_mediator_infrastructure_init use MOM_diag_mediator, only : diag_set_state_ptrs, diag_update_remap_grids @@ -30,7 +30,6 @@ module MOM use MOM_error_handler, only : MOM_set_verbosity, callTree_showQuery use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint use MOM_file_parser, only : read_param, get_param, log_version, param_file_type -use MOM_fixed_initialization, only : MOM_initialize_fixed use MOM_forcing_type, only : forcing, mech_forcing use MOM_forcing_type, only : MOM_forcing_chksum, MOM_mech_forcing_chksum use MOM_get_input, only : Get_MOM_Input, directories @@ -40,7 +39,6 @@ module MOM use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, is_new_run, MOM_restart_CS use MOM_spatial_means, only : global_mass_integral -use MOM_state_initialization, only : MOM_initialize_state use MOM_time_manager, only : time_type, set_time, time_type_to_real, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) use MOM_time_manager, only : operator(>=), increment_date @@ -52,6 +50,7 @@ module MOM use MOM_ALE, only : ALE_getCoordinate, ALE_getCoordinateUnits, ALE_writeCoordinateFile use MOM_ALE, only : ALE_updateVerticalGridType, ALE_remap_init_conds, ALE_register_diags use MOM_boundary_update, only : call_OBC_register, OBC_register_end, update_OBC_CS +use MOM_coord_initialization, only : MOM_initialize_coord use MOM_diabatic_driver, only : diabatic, diabatic_driver_init, diabatic_CS use MOM_diabatic_driver, only : adiabatic, adiabatic_driver_init, diabatic_driver_end use MOM_diabatic_driver, only : legacy_diabatic @@ -72,8 +71,9 @@ module MOM use MOM_dynamics_unsplit_RK2, only : initialize_dyn_unsplit_RK2, end_dyn_unsplit_RK2 use MOM_dynamics_unsplit_RK2, only : MOM_dyn_unsplit_RK2_CS use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid -use MOM_EOS, only : EOS_init, calculate_density use MOM_debugging, only : check_redundant +use MOM_EOS, only : EOS_init, calculate_density +use MOM_fixed_initialization, only : MOM_initialize_fixed use MOM_grid, only : ocean_grid_type, set_first_direction use MOM_grid, only : MOM_grid_init, MOM_grid_end use MOM_hor_index, only : hor_index_type, hor_index_init @@ -91,6 +91,7 @@ module MOM use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_init use MOM_set_visc, only : set_visc_register_restarts, set_visc_CS use MOM_sponge, only : init_sponge_diags, sponge_CS +use MOM_state_initialization, only : MOM_initialize_state use MOM_sum_output, only : write_energy, accumulate_net_input use MOM_sum_output, only : MOM_sum_output_init, sum_output_CS use MOM_ALE_sponge, only : init_ALE_sponge_diags, ALE_sponge_CS @@ -860,6 +861,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & end subroutine step_MOM +!> Time step the ocean dynamics, including the momentum and continuity equations subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & bbl_time_int, CS, Time_local, Waves) type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces @@ -1478,7 +1480,8 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS end subroutine step_offline -!> This subroutine initializes MOM. +!> Initialize MOM, including memory allocation, setting up parameters and diagnostics, +!! initializing the ocean state variables, and initializing subsidiary modules subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & Time_in, offline_tracer_mode, input_restart_file, diag_ptr, & count_calls, tracer_flow_CSp) @@ -2444,7 +2447,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & end subroutine initialize_MOM -!> This subroutine finishes initializing MOM and writes out the initial conditions. +!> Finishe initializing MOM and writes out the initial conditions. subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) type(time_type), intent(in) :: Time !< model time, used in this routine type(directories), intent(in) :: dirs !< structure with directory paths @@ -2518,7 +2521,7 @@ subroutine register_diags(Time, G, GV, IDs, diag) Time, 'Instantaneous Sea Surface Height', 'm') end subroutine register_diags -!> This subroutine sets up clock IDs for timing various subroutines. +!> Set up CPU clock IDs for timing various subroutines. subroutine MOM_timing_init(CS) type(MOM_control_struct), intent(in) :: CS !< control structure set up by initialize_MOM. @@ -2609,7 +2612,7 @@ subroutine set_restart_fields(GV, param_file, CS, restart_CSp) end subroutine set_restart_fields -!> This subroutine applies a correction to the sea surface height to compensate +!> Apply a correction to the sea surface height to compensate !! for the atmospheric pressure (the inverse barometer). subroutine adjust_ssh_for_p_atm(tv, G, GV, ssh, p_atm, use_EOS) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables @@ -2646,8 +2649,8 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, ssh, p_atm, use_EOS) end subroutine adjust_ssh_for_p_atm -!> This subroutine sets the surface (return) properties of the ocean -!! model by setting the appropriate fields in sfc_state. Unused fields +!> Set the surface (return) properties of the ocean model by +!! setting the appropriate fields in sfc_state. Unused fields !! are set to NULL or are unallocated. subroutine extract_surface_state(CS, sfc_state) type(MOM_control_struct), pointer :: CS !< Master MOM control structure @@ -2991,7 +2994,7 @@ subroutine get_ocean_stocks(CS, mass, heat, salt, on_PE_only) end subroutine get_ocean_stocks -!> End of model +!> End of ocean model, including memory deallocation subroutine MOM_end(CS) type(MOM_control_struct), pointer :: CS !< MOM control structure From f3b818b26ab7a9936291b994e3fe5bb15686121d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 11 Jul 2018 15:59:28 -0400 Subject: [PATCH 0582/1072] Module dOxyGenization for MOM_checksum_packages Added dOxygen comments describing the whole module and removed duplicate older-style argument documentation comments from MOM_checksum_packages.F90. All answers are bitwise identical. --- src/core/MOM_checksum_packages.F90 | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 5a0a4d8967..d67695b8e6 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -1,8 +1,9 @@ +!> Provides routines that do checksums of groups of MOM variables module MOM_checksum_packages ! This file is part of MOM6. See LICENSE.md for the license. -! This module provdes a several routines that do check-sums of groups +! This module provides several routines that do check-sums of groups ! of variables in the various dynamic solver routines. use MOM_debugging, only : hchksum, uvchksum @@ -110,10 +111,7 @@ subroutine MOM_thermo_chksum(mesg, tv, G, haloshift) !! thermodynamic variables. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). -! Arguments: mesg - A message that appears on the chksum lines. -! (in) tv - A structure containing pointers to any thermodynamic -! fields that are in use. -! (in) G - The ocean's grid structure. + integer :: is, ie, js, je, nz, hs is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke hs=1; if (present(haloshift)) hs=haloshift From 0431fd736e342a7aaadda0b3441225712e36fb3f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 11 Jul 2018 16:00:17 -0400 Subject: [PATCH 0583/1072] Module dOxyGenization for MOM_dynamics_unsplit Added dOxygen comments describing the whole module and several routines in MOM_dynamics_unsplit.F90 and MOM_dynamics_unsplit_RK2.F90, and consolidated multiline comments with multiline declarations that dOxyGen would interpret incorrectly. All answers are bitwise identical. --- src/core/MOM_dynamics_unsplit.F90 | 126 ++++++-------------------- src/core/MOM_dynamics_unsplit_RK2.F90 | 107 +++++----------------- 2 files changed, 50 insertions(+), 183 deletions(-) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 5f42fc0784..47d3510c5a 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -1,3 +1,4 @@ +!> Time steps the ocean dynamics with an unsplit quasi 3rd order scheme module MOM_dynamics_unsplit ! This file is part of MOM6. See LICENSE.md for the license. @@ -176,17 +177,16 @@ module MOM_dynamics_unsplit ! ============================================================================= +!> Step the MOM6 dynamics using an unsplit mixed 2nd order (for continuity) and +!! 3rd order (for the inviscid momentum equations) order scheme subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, uh, vh, uhtr, vhtr, eta_av, G, GV, CS, & VarMix, MEKE, Waves) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: u !< The zonal velocity, in m s-1. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: v !< The meridional velocity, in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thicknesses, in H. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H. !! (usually m or kg m-2). type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. @@ -196,24 +196,19 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & !! of the time step. real, intent(in) :: dt !< The dynamics time step, in s. type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to the - !! surface pressure at the beginning of this dynamic step, in Pa. - real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the - !! surface pressure at the end of this dynamic step, in Pa. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: uh !< The zonal volume or mass transport, + real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to the surface + !! pressure at the start of this dynamic step, in Pa. + real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the surface + !! pressure at the end of this dynamic step, in Pa. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh !< The zonal volume or mass transport, !! in m3 s-1 or kg s-1. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: vh !< The meridional volume or mass + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh !< The meridional volume or mass !! transport, in m3 s-1 or kg s-1. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: uhtr !< he accumulated zonal volume or mass - !! transport since the last tracer advection, in m3 or kg. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: vhtr !< The accumulated meridional volume or - !! mass transport since the last tracer advection, in m3 or kg. - real, dimension(SZI_(G),SZJ_(G)), & - intent(out) :: eta_av !< The time-mean free surface height or + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< The accumulated zonal volume or mass + !! transport since the last tracer advection, in m3 or kg. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume or mass + !! transport since the last tracer advection, in m3 or kg. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height or !! column mass, in m or kg m-2. type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit. @@ -221,41 +216,10 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & !! that specify the spatially variable viscosities. type(MEKE_type), pointer :: MEKE !< A pointer to a structure containing !! fields related to the Mesoscale Eddy Kinetic Energy. - type(wave_parameters_CS), & - optional, pointer :: Waves !< A pointer to a structure containing + type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing !! fields related to the surface wave conditions -! Arguments: u - The input and output zonal velocity, in m s-1. -! (inout) v - The input and output meridional velocity, in m s-1. -! (inout) h - The input and output layer thicknesses, in m or kg m-2, -! depending on whether the Boussinesq approximation is made. -! (in) tv - a structure pointing to various thermodynamic variables. -! (inout) visc - A structure containing vertical viscosities, bottom drag -! viscosities, and related fields. -! (in) Time_local - The model time at the end of the time step. -! (in) dt - The time step in s. -! (in) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) p_surf_begin - A pointer (perhaps NULL) to the surface pressure -! at the beginning of this dynamic step, in Pa. -! (in) p_surf_end - A pointer (perhaps NULL) to the surface pressure -! at the end of this dynamic step, in Pa. -! (inout) uh - The zonal volume or mass transport, in m3 s-1 or kg s-1. -! (inout) vh - The meridional volume or mass transport, in m3 s-1 or kg s-1. -! (inout) uhtr - The accumulated zonal volume or mass transport since the last -! tracer advection, in m3 or kg. -! (inout) vhtr - The accumulated meridional volume or mass transport since the last -! tracer advection, in m3 or kg. -! (out) eta_av - The time-mean free surface height or column mass, in m or -! kg m-2. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure set up by initialize_dyn_unsplit. -! (in) VarMix - A pointer to a structure with fields that specify the -! spatially variable viscosities. -! (inout) MEKE - A pointer to a structure containing fields related to -! the Mesoscale Eddy Kinetic Energy. - + ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_av, hp real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up, upp real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp, vpp @@ -548,6 +512,11 @@ end subroutine step_MOM_dyn_unsplit ! ============================================================================= +!> Allocate the control structure for this module, allocates memory in it, and registers +!! any auxiliary restart variables that are specific to the unsplit time stepping scheme. +!! +!! All variables registered here should have the ability to be recreated if they are not present +!! in a restart file. subroutine register_restarts_dyn_unsplit(HI, GV, param_file, CS, restart_CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -557,24 +526,14 @@ subroutine register_restarts_dyn_unsplit(HI, GV, param_file, CS, restart_CS) !! initialize_dyn_unsplit. type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. -! This subroutine sets up any auxiliary restart variables that are specific -! to the unsplit time stepping scheme. All variables registered here should -! have the ability to be recreated if they are not present in a restart file. - -! Arguments: HI - A horizontal index type structure. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (inout) CS - The control structure set up by initialize_dyn_unsplit. -! (inout) restart_CS - A pointer to the restart control structure. - + ! Local arguments character(len=40) :: mdl = "MOM_dynamics_unsplit" ! This module's name. character(len=48) :: thickness_units, flux_units integer :: isd, ied, jsd, jed, nz, IsdB, IedB, JsdB, JedB isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke IsdB = HI%IsdB ; IedB = HI%IedB ; JsdB = HI%JsdB ; JedB = HI%JedB -! This is where a control structure that is specific to this module would be allocated. + ! This is where a control structure that is specific to this module is allocated. if (associated(CS)) then call MOM_error(WARNING, "register_restarts_dyn_unsplit called with an associated "// & "control structure.") @@ -648,39 +607,10 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, param_file, diag, CS, & !! records the number of times the velocity !! is truncated (this should be 0). -! Arguments: u - The zonal velocity, in m s-1. -! (inout) v - The meridional velocity, in m s-1. -! (inout) h - The layer thicknesses, in m or kg m-2, depending on whether -! the Boussinesq approximation is made. -! (in) Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (inout) CS - The control structure set up by initialize_dyn_unsplit. -! (in) restart_CS - A pointer to the restart control structure. -! (inout) Accel_diag - A set of pointers to the various accelerations in -! the momentum equations, which can be used for later derived -! diagnostics, like energy budgets. -! (inout) Cont_diag - A structure with pointers to various terms in the -! continuity equations. -! (inout) MIS - The "MOM6 Internal State" structure, used to pass around -! pointers to various arrays for diagnostic purposes. -! (in) OBC - If open boundary conditions are used, this points to the -! ocean_OBC_type that was set up in MOM_initialization. -! (in) update_OBC_CSp - If open boundary condition updates are used, -! this points to the appropriate control structure. -! (in) ALE_CS - This points to the ALE control structure. -! (in) setVisc_CSp - This points to the set_visc control structure. -! (inout) visc - A structure containing vertical viscosities, bottom drag -! viscosities, and related fields. -! (in) dirs - A structure containing several relevant directory paths. -! (in) ntrunc - A target for the variable that records the number of times -! the velocity is truncated (this should be 0). - ! This subroutine initializes all of the variables that are used by this ! dynamic core, including diagnostics and the cpu clocks. + + ! Local variables character(len=40) :: mdl = "MOM_dynamics_unsplit" ! This module's name. character(len=48) :: thickness_units, flux_units real :: H_convert diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 994a02f626..a1615ad413 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -1,3 +1,4 @@ +!> Time steps the ocean dynamics with an unsplit quasi 2nd order Runge-Kutta scheme module MOM_dynamics_unsplit_RK2 ! This file is part of MOM6. See LICENSE.md for the license. @@ -179,22 +180,20 @@ module MOM_dynamics_unsplit_RK2 ! ============================================================================= +!> Step the MOM6 dynamics using an unsplit quasi-2nd order Runge-Kutta scheme subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, uh, vh, uhtr, vhtr, eta_av, G, GV, CS, & VarMix, MEKE) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid !! structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: u_in !< The input and output zonal + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u_in !< The input and output zonal !! velocity, in m s-1. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: v_in !< The input and output meridional + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v_in !< The input and output meridional !! velocity, in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h_in !< The input and output layer - !! thicknesses, in m or kg m-2, depending on - !! whether the Boussinesq approximation is made. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_in !< The input and output layer thicknesses, + !! in m or kg m-2, depending on whether + !! the Boussinesq approximation is made. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical @@ -206,23 +205,19 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! in s. type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to - !! the surface pressure at the beginning - !! of this dynamic step, in Pa. + !! the surface pressure at the beginning + !! of this dynamic step, in Pa. real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to !! the surface pressure at the end of !! this dynamic step, in Pa. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: uh !< The zonal volume or mass transport, + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh !< The zonal volume or mass transport, !! in m3 s-1 or kg s-1. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: vh !< The meridional volume or mass + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh !< The meridional volume or mass !! transport, in m3 s-1 or kg s-1. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: uhtr !< The accumulated zonal volume or + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< The accumulated zonal volume or !! mass transport since the last !! tracer advection, in m3 or kg. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: vhtr !< The accumulated meridional volume + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume !! or mass transport since the last !! tracer advection, in m3 or kg. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height @@ -235,37 +230,8 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, type(MEKE_type), pointer :: MEKE !< A pointer to a structure containing !! fields related to the Mesoscale !! Eddy Kinetic Energy. -! Arguments: u_in - The input and output zonal velocity, in m s-1. -! (inout) v_in - The input and output meridional velocity, in m s-1. -! (inout) h_in - The input and output layer thicknesses, in m or kg m-2, -! depending on whether the Boussinesq approximation is made. -! (in) tv - a structure pointing to various thermodynamic variables. -! (inout) visc - A structure containing vertical viscosities, bottom drag -! viscosities, and related fields. -! (in) Time_local - The model time at the end of the time step. -! (in) dt - The time step in s. -! (in) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) p_surf_begin - A pointer (perhaps NULL) to the surface pressure -! at the beginning of this dynamic step, in Pa. -! (in) p_surf_end - A pointer (perhaps NULL) to the surface pressure -! at the end of this dynamic step, in Pa. -! (inout) uh - The zonal volume or mass transport, in m3 s-1 or kg s-1. -! (inout) vh - The meridional volume or mass transport, in m3 s-1 or kg s-1. -! (inout) uhtr - The accumulated zonal volume or mass transport since the last -! tracer advection, in m3 or kg. -! (inout) vhtr - The accumulated meridional volume or mass transport since the last -! tracer advection, in m3 or kg. -! (out) eta_av - The time-mean free surface height or column mass, in m or -! kg m-2. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure set up by initialize_dyn_unsplit_RK2. -! (in) VarMix - A pointer to a structure with fields that specify the -! spatially variable viscosities. -! (inout) MEKE - A pointer to a structure containing fields related to -! the Mesoscale Eddy Kinetic Energy. + ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_av, hp real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp @@ -490,6 +456,11 @@ end subroutine step_MOM_dyn_unsplit_RK2 ! ============================================================================= +!> Allocate the control structure for this module, allocates memory in it, and registers +!! any auxiliary restart variables that are specific to the unsplit RK2 time stepping scheme. +!! +!! All variables registered here should have the ability to be recreated if they are not present +!! in a restart file. subroutine register_restarts_dyn_unsplit_RK2(HI, GV, param_file, CS, restart_CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -503,13 +474,7 @@ subroutine register_restarts_dyn_unsplit_RK2(HI, GV, param_file, CS, restart_CS) ! to the unsplit time stepping scheme. All variables registered here should ! have the ability to be recreated if they are not present in a restart file. -! Arguments: HI - A horizontal index type structure. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (inout) CS - The control structure set up by initialize_dyn_unsplit_RK2. -! (inout) restart_CS - A pointer to the restart control structure. - + ! Local variables character(len=48) :: thickness_units, flux_units integer :: isd, ied, jsd, jed, nz, IsdB, IedB, JsdB, JedB isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke @@ -587,39 +552,11 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, param_file, diag, CS integer, target, intent(inout) :: ntrunc !< A target for the variable !! that records the number of times the !! velocity is truncated (this should be 0). -! Arguments: u - The zonal velocity, in m s-1. -! (inout) v - The meridional velocity, in m s-1. -! (inout) h - The layer thicknesses, in m or kg m-2, depending on whether -! the Boussinesq approximation is made. -! (in) Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (inout) CS - The control structure set up by initialize_dyn_unsplit_RK2. -! (in) restart_CS - A pointer to the restart control structure. -! (inout) Accel_diag - A set of pointers to the various accelerations in -! the momentum equations, which can be used for later derived -! diagnostics, like energy budgets. -! (inout) Cont_diag - A structure with pointers to various terms in the -! continuity equations. -! (inout) MIS - The "MOM6 Internal State" structure, used to pass around -! pointers to various arrays for diagnostic purposes. -! (in) OBC - If open boundary conditions are used, this points to the -! ocean_OBC_type that was set up in MOM_initialization. -! (in) update_OBC_CSp - If open boundary condition updates are used, -! this points to the appropriate control structure. -! (in) ALE_CS - This points to the ALE control structure. -! (in) setVisc_CSp - This points to the set_visc control structure. -! (inout) visc - A structure containing vertical viscosities, bottom drag -! viscosities, and related fields. -! (in) dirs - A structure containing several relevant directory paths. -! (in) ntrunc - A target for the variable that records the number of times -! the velocity is truncated (this should be 0). ! This subroutine initializes all of the variables that are used by this ! dynamic core, including diagnostics and the cpu clocks. + + ! Local varaibles character(len=40) :: mdl = "MOM_dynamics_unsplit_RK2" ! This module's name. character(len=48) :: thickness_units, flux_units real :: H_convert From de13a2cd152ae2dad2686be1926ac31f9f005a4a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 11 Jul 2018 16:00:39 -0400 Subject: [PATCH 0584/1072] Module dOxyGenization for MOM_transribe_grid Added dOxygen comments describing the whole MOM_transribe_grid module. All answers are bitwise identical. --- src/core/MOM_transcribe_grid.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index 75892d19f3..eea4874f4e 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -1,3 +1,5 @@ +!> Module with routines for copying information from a shared dynamic horizontal +!! grid to an ocean-specific horizontal grid and the reverse. module MOM_transcribe_grid ! This file is part of MOM6. See LICENSE.md for the license. From 574af3333df8bd6fad7ada3b2d527e36382260c1 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 11 Jul 2018 17:13:42 -0400 Subject: [PATCH 0585/1072] Adds module summary lines in src/ALE, src/user, src/parameterizations/vertical - Using an older version of doxygen detected a lot of modules which were missing the one-liner at the top. --- src/ALE/P1M_functions.F90 | 98 +++---- src/ALE/P3M_functions.F90 | 202 ++++++-------- src/ALE/PCM_functions.F90 | 39 +-- src/ALE/PLM_functions.F90 | 67 ++--- src/ALE/PQM_functions.F90 | 141 ++++------ src/ALE/polynomial_functions.F90 | 63 ++--- src/ALE/regrid_edge_slopes.F90 | 74 +++--- src/ALE/regrid_edge_values.F90 | 251 ++++++++---------- src/ALE/regrid_interp.F90 | 19 +- src/ALE/regrid_solvers.F90 | 44 ++- .../MOM_tracer_initialization_from_Z.F90 | 6 +- .../vertical/MOM_bulk_mixed_layer.F90 | 53 ++-- .../vertical/MOM_diabatic_aux.F90 | 72 +++-- .../vertical/MOM_diapyc_energy_req.F90 | 9 +- .../vertical/MOM_energetic_PBL.F90 | 75 +++--- .../vertical/MOM_entrain_diffusive.F90 | 80 +++--- .../vertical/MOM_kappa_shear.F90 | 43 ++- .../vertical/MOM_opacity.F90 | 51 ++-- .../vertical/MOM_regularize_layers.F90 | 104 +------- .../vertical/MOM_set_diffusivity.F90 | 18 +- .../vertical/MOM_shortwave_abs.F90 | 25 +- src/parameterizations/vertical/MOM_sponge.F90 | 86 +++--- src/user/DOME2d_initialization.F90 | 1 + src/user/DOME_initialization.F90 | 6 +- src/user/Kelvin_initialization.F90 | 11 +- src/user/Neverland_initialization.F90 | 40 ++- src/user/Phillips_initialization.F90 | 78 +++--- src/user/benchmark_initialization.F90 | 22 +- src/user/circle_obcs_initialization.F90 | 6 +- src/user/external_gwave_initialization.F90 | 21 +- src/user/lock_exchange_initialization.F90 | 6 +- src/user/seamount_initialization.F90 | 5 +- src/user/shelfwave_initialization.F90 | 5 +- src/user/sloshing_initialization.F90 | 1 + src/user/supercritical_initialization.F90 | 1 + src/user/tidal_bay_initialization.F90 | 6 +- 36 files changed, 685 insertions(+), 1144 deletions(-) diff --git a/src/ALE/P1M_functions.F90 b/src/ALE/P1M_functions.F90 index 75490bee9f..0a0d842581 100644 --- a/src/ALE/P1M_functions.F90 +++ b/src/ALE/P1M_functions.F90 @@ -1,61 +1,30 @@ +!> Linear interpolation functions module P1M_functions ! This file is part of MOM6. See LICENSE.md for the license. -!============================================================================== -! -! Date of creation: 2008.06.09 -! L. White -! -! This module contains p1m (linear) interpolation routines. -! -! p1m interpolation is performed by estimating the edge values and -! linearly interpolating between them. - -! Once the edge values are estimated, the limiting process takes care of -! ensuring that (1) edge values are bounded by neighoring cell averages -! and (2) discontinuous edge values are averaged in order to provide a -! fully continuous interpolant throughout the domain. This last step is -! essential for the regridding problem to yield a unique solution. -! Also, a routine is provided that takes care of linear extrapolation -! within the boundary cells. -! -! The module contains the following routines: -! -! P1M_interpolation (public) -! P1M_boundary_extrapolation (public) -! -!============================================================================== use regrid_edge_values, only : bound_edge_values, average_discontinuous_edge_values implicit none ; private -! ----------------------------------------------------------------------------- ! The following routines are visible to the outside world -! ----------------------------------------------------------------------------- public P1M_interpolation, P1M_boundary_extrapolation contains - -!------------------------------------------------------------------------------ !> Linearly interpolate between edge values +!! +!! The resulting piecewise interpolant is stored in 'ppoly'. +!! See 'ppoly.F90' for a definition of this structure. +!! +!! The edge values MUST have been estimated prior to calling this routine. +!! +!! The estimated edge values must be limited to ensure monotonicity of the +!! interpolant. We also make sure that edge values are NOT discontinuous. +!! +!! It is assumed that the size of the array 'u' is equal to the number of cells +!! defining 'grid' and 'ppoly'. No consistency check is performed here. subroutine P1M_interpolation( N, h, u, ppoly_E, ppoly_coef, h_neglect ) -! ------------------------------------------------------------------------------ -! Linearly interpolate between edge values. -! The resulting piecewise interpolant is stored in 'ppoly'. -! See 'ppoly.F90' for a definition of this structure. -! -! The edge values MUST have been estimated prior to calling this routine. -! -! The estimated edge values must be limited to ensure monotonicity of the -! interpolant. We also make sure that edge values are NOT discontinuous. -! -! It is assumed that the size of the array 'u' is equal to the number of cells -! defining 'grid' and 'ppoly'. No consistency check is performed here. -! ------------------------------------------------------------------------------ - - ! Arguments integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) real, dimension(:), intent(in) :: u !< cell average properties (size N) @@ -66,7 +35,6 @@ subroutine P1M_interpolation( N, h, u, ppoly_E, ppoly_coef, h_neglect ) !! with the same units as u. real, optional, intent(in) :: h_neglect !< A negligibly small width !! in the same units as h. - ! Local variables integer :: k ! loop index real :: u0_l, u0_r ! edge values (left and right) @@ -91,25 +59,14 @@ subroutine P1M_interpolation( N, h, u, ppoly_E, ppoly_coef, h_neglect ) end subroutine P1M_interpolation - -!------------------------------------------------------------------------------ !> Interpolation by linear polynomials within boundary cells +!! +!! The left and right edge values in the left and right boundary cells, +!! respectively, are estimated using a linear extrapolation within the cells. +!! +!! It is assumed that the size of the array 'u' is equal to the number of cells +!! defining 'grid' and 'ppoly'. No consistency check is performed here. subroutine P1M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef ) -!------------------------------------------------------------------------------ -! Interpolation by linear polynomials within boundary cells. -! The left and right edge values in the left and right boundary cells, -! respectively, are estimated using a linear extrapolation within the cells. -! -! N: number of cells in grid -! h: thicknesses of grid cells -! u: cell averages to use in constructing piecewise polynomials -! ppoly_E : edge values of piecewise polynomials -! ppoly_coef : coefficients of piecewise polynomials -! -! It is assumed that the size of the array 'u' is equal to the number of cells -! defining 'grid' and 'ppoly'. No consistency check is performed here. -!------------------------------------------------------------------------------ - ! Arguments integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) @@ -118,7 +75,6 @@ subroutine P1M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef ) !! with the same units as u. real, dimension(:,:), intent(inout) :: ppoly_coef !< coefficients of piecewise polynomials, mainly !! with the same units as u. - ! Local variables real :: u0, u1 ! cell averages real :: h0, h1 ! corresponding cell widths @@ -188,4 +144,22 @@ subroutine P1M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef ) end subroutine P1M_boundary_extrapolation +!> \namespace p1m_functions +!! +!! Date of creation: 2008.06.09 +!! L. White +!! +!! This module contains p1m (linear) interpolation routines. +!! +!! p1m interpolation is performed by estimating the edge values and +!! linearly interpolating between them. +! +!! Once the edge values are estimated, the limiting process takes care of +!! ensuring that (1) edge values are bounded by neighoring cell averages +!! and (2) discontinuous edge values are averaged in order to provide a +!! fully continuous interpolant throughout the domain. This last step is +!! essential for the regridding problem to yield a unique solution. +!! Also, a routine is provided that takes care of linear extrapolation +!! within the boundary cells. + end module P1M_functions diff --git a/src/ALE/P3M_functions.F90 b/src/ALE/P3M_functions.F90 index 3034d2a8b4..1964cd25dd 100644 --- a/src/ALE/P3M_functions.F90 +++ b/src/ALE/P3M_functions.F90 @@ -1,20 +1,8 @@ +!> Cubic interpolation functions module P3M_functions ! This file is part of MOM6. See LICENSE.md for the license. -!============================================================================== -! -! Date of creation: 2008.06.09 -! L. White -! -! This module contains p3m interpolation routines. -! -! p3m interpolation is performed by estimating the edge values and slopes -! and constructing a cubic polynomial. We then make sure that the edge values -! are bounded and continuous and we then modify the slopes to get a monotonic -! cubic curve. -! -!============================================================================== use regrid_edge_values, only : bound_edge_values, average_discontinuous_edge_values implicit none ; private @@ -22,27 +10,23 @@ module P3M_functions public P3M_interpolation public P3M_boundary_extrapolation -real, parameter :: hNeglect_dflt = 1.E-30 -real, parameter :: hNeglect_edge_dflt = 1.E-10 +real, parameter :: hNeglect_dflt = 1.E-30 !< Default value of a negligible cell thickness +real, parameter :: hNeglect_edge_dflt = 1.E-10 !< Default value of a negligible edge thickness contains -!------------------------------------------------------------------------------ -!> Set up a piecewise cubic cubic interpolation from cell averages and estimated +!> Set up a piecewise cubic interpolation from cell averages and estimated !! edge slopes and values +!! +!! Cubic interpolation between edges. +!! +!! The edge values and slopes MUST have been estimated prior to calling +!! this routine. +!! +!! It is assumed that the size of the array 'u' is equal to the number of cells +!! defining 'grid' and 'ppoly'. No consistency check is performed here. subroutine P3M_interpolation( N, h, u, ppoly_E, ppoly_S, ppoly_coef, & h_neglect ) -!------------------------------------------------------------------------------ -! Cubic interpolation between edges. -! -! The edge values and slopes MUST have been estimated prior to calling -! this routine. -! -! It is assumed that the size of the array 'u' is equal to the number of cells -! defining 'grid' and 'ppoly'. No consistency check is performed here. -!------------------------------------------------------------------------------ - - ! Arguments integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) real, dimension(:), intent(in) :: u !< cell averages (size N) @@ -61,30 +45,24 @@ subroutine P3M_interpolation( N, h, u, ppoly_E, ppoly_S, ppoly_coef, & ! This routine could be called directly instead of having to call ! 'P3M_interpolation' first but we do that to provide an homogeneous ! interface. - call P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect ) end subroutine P3M_interpolation - -!------------------------------------------------------------------------------ !> Adust a piecewise cubic reconstruction with a limiter that adjusts the edge !! values and slopes +!! +!! The p3m limiter operates as follows: +!! +!! 1. Edge values are bounded +!! 2. Discontinuous edge values are systematically averaged +!! 3. Loop on cells and do the following +!! a. Build cubic curve +!! b. Check if cubic curve is monotonic +!! c. If not, monotonize cubic curve and rebuild it +!! +!! Step 3 of the monotonization process leaves all edge values unchanged. subroutine P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect ) -!------------------------------------------------------------------------------ -! The p3m limiter operates as follows: -! -! (1) Edge values are bounded -! (2) Discontinuous edge values are systematically averaged -! (3) Loop on cells and do the following -! (a) Build cubic curve -! (b) Check if cubic curve is monotonic -! (c) If not, monotonize cubic curve and rebuild it -! -! Step (3) of the monotonization process leaves all edge values unchanged. -!------------------------------------------------------------------------------ - - ! Arguments integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) real, dimension(:), intent(in) :: u !< cell averages (size N) @@ -96,7 +74,6 @@ subroutine P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect ) real, optional, intent(in) :: h_neglect !< A negligibly small width for !! the purpose of cell reconstructions !! in the same units as h. - ! Local variables integer :: k ! loop index integer :: monotonic ! boolean indicating whether the cubic is monotonic @@ -211,25 +188,21 @@ subroutine P3M_limiter( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect ) end subroutine P3M_limiter -!------------------------------------------------------------------------------ -!> calculate the edge values and slopes at boundary cells as part of building a -!! piecewise peicewise cubic sub-grid scale profiles +!> Calculate the edge values and slopes at boundary cells as part of building a +!! piecewise cubic sub-grid scale profiles +!! +!! The following explanations apply to the left boundary cell. The same +!! reasoning holds for the right boundary cell. +!! +!! A cubic needs to be built in the cell and requires four degrees of freedom, +!! which are the edge values and slopes. The right edge values and slopes are +!! taken to be that of the neighboring cell (i.e., the left edge value and slope +!! of the neighboring cell). The left edge value and slope are determined by +!! computing the parabola based on the cell average and the right edge value +!! and slope. The resulting cubic is not necessarily monotonic and the slopes +!! are subsequently modified to yield a monotonic cubic. subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coef, & h_neglect, h_neglect_edge ) -!------------------------------------------------------------------------------ -! The following explanations apply to the left boundary cell. The same -! reasoning holds for the right boundary cell. -! -! A cubic needs to be built in the cell and requires four degrees of freedom, -! which are the edge values and slopes. The right edge values and slopes are -! taken to be that of the neighboring cell (i.e., the left edge value and slope -! of the neighboring cell). The left edge value and slope are determined by -! computing the parabola based on the cell average and the right edge value -! and slope. The resulting cubic is not necessarily monotonic and the slopes -! are subsequently modified to yield a monotonic cubic. -!------------------------------------------------------------------------------ - - ! Arguments integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) real, dimension(:), intent(in) :: u !< cell averages (size N) @@ -245,7 +218,6 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coef, & real, optional, intent(in) :: h_neglect_edge !< A negligibly small width !! for the purpose of finding edge values !! in the same units as h. - ! Local variables integer :: i0, i1 integer :: monotonic @@ -381,17 +353,13 @@ subroutine P3M_boundary_extrapolation( N, h, u, ppoly_E, ppoly_S, ppoly_coef, & end subroutine P3M_boundary_extrapolation -!------------------------------------------------------------------------------ !> Build cubic interpolant in cell k +!! +!! Given edge values and edge slopes, compute coefficients of cubic in cell k. +!! +!! NOTE: edge values and slopes MUST have been properly calculated prior to +!! calling this routine. subroutine build_cubic_interpolant( h, k, ppoly_E, ppoly_S, ppoly_coef ) -!------------------------------------------------------------------------------ -! Given edge values and edge slopes, compute coefficients of cubic in cell k. -! -! NOTE: edge values and slopes MUST have been properly calculated prior to -! calling this routine. -!------------------------------------------------------------------------------ - - ! Arguments real, dimension(:), intent(in) :: h !< cell widths (size N) integer, intent(in) :: k !< The index of the cell to work on real, dimension(:,:), intent(in) :: ppoly_E !< Edge value of polynomial, @@ -400,7 +368,6 @@ subroutine build_cubic_interpolant( h, k, ppoly_E, ppoly_S, ppoly_coef ) !! in the units of u over the units of h. real, dimension(:,:), intent(inout) :: ppoly_coef !< Coefficients of polynomial, mainly !! with the same units as u. - ! Local variables real :: u0_l, u0_r ! edge values real :: u1_l, u1_r ! edge slopes @@ -428,22 +395,17 @@ subroutine build_cubic_interpolant( h, k, ppoly_E, ppoly_S, ppoly_coef ) end subroutine build_cubic_interpolant -!------------------------------------------------------------------------------ !> Check whether the cubic reconstruction in cell k is monotonic +!! +!! This function checks whether the cubic curve in cell k is monotonic. +!! If so, returns 1. Otherwise, returns 0. +!! +!! The cubic is monotonic if the first derivative is single-signed in [0,1]. +!! Hence, we check whether the roots (if any) lie inside this interval. If there +!! is no root or if both roots lie outside this interval, the cubic is monotonic. integer function is_cubic_monotonic( ppoly_coef, k ) -!------------------------------------------------------------------------------ -! This function checks whether the cubic curve in cell k is monotonic. -! If so, returns 1. Otherwise, returns 0. -! -! The cubic is monotonic if the first derivative is single-signed in [0,1]. -! Hence, we check whether the roots (if any) lie inside this interval. If there -! is no root or if both roots lie outside this interval, the cubic is monotnic. -!------------------------------------------------------------------------------ - - ! Arguments real, dimension(:,:), intent(in) :: ppoly_coef !< Coefficients of cubic polynomial integer, intent(in) :: k !< The index of the cell to work on - ! Local variables integer :: monotonic ! boolean indicating if monotonic or not real :: a0, a1, a2, a3 ! cubic coefficients @@ -497,39 +459,34 @@ integer function is_cubic_monotonic( ppoly_coef, k ) end function is_cubic_monotonic - -!------------------------------------------------------------------------------ !> Monotonize a cubic curve by modifying the edge slopes. -subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r ) -!------------------------------------------------------------------------------ -! This routine takes care of monotonizing a cubic on [0,1] by modifying the -! edge slopes. The edge values are NOT modified. The cubic is entirely -! determined by the four degrees of freedom u0_l, u0_r, u1_l and u1_r. -! -! u1_l and u1_r are the edge slopes expressed in the GLOBAL coordinate system. -! -! The monotonization occurs as follows. - -! 1. The edge slopes are set to 0 if they are inconsistent with the limited -! PLM slope -! 2. We check whether we can find an inflexion point in [0,1]. At most one -! inflexion point may exist. -! (a) If there is no inflexion point, the cubic is monotonic. -! (b) If there is one inflexion point and it lies outside [0,1], the -! cubic is monotonic. -! (c) If there is one inflexion point and it lies in [0,1] and the slope -! at the location of the inflexion point is consistent, the cubic -! is monotonic. -! (d) If the inflexion point lies in [0,1] but the slope is inconsistent, -! we go to (3) to shift the location of the inflexion point to the left -! or to the right. To the left when the 2nd-order left slope is smaller -! than the 2nd order right slope. -! 3. Edge slopes are modified to shift the inflexion point, either onto the left -! edge or onto the right edge. +!! +!! This routine takes care of monotonizing a cubic on [0,1] by modifying the +!! edge slopes. The edge values are NOT modified. The cubic is entirely +!! determined by the four degrees of freedom u0_l, u0_r, u1_l and u1_r. +!! +!! u1_l and u1_r are the edge slopes expressed in the GLOBAL coordinate system. +!! +!! The monotonization occurs as follows. ! -!------------------------------------------------------------------------------ +!! 1. The edge slopes are set to 0 if they are inconsistent with the limited +!! PLM slope +!! 2. We check whether we can find an inflexion point in [0,1]. At most one +!! inflexion point may exist. +!! a. If there is no inflexion point, the cubic is monotonic. +!! b. If there is one inflexion point and it lies outside [0,1], the +!! cubic is monotonic. +!! c. If there is one inflexion point and it lies in [0,1] and the slope +!! at the location of the inflexion point is consistent, the cubic +!! is monotonic. +!! d. If the inflexion point lies in [0,1] but the slope is inconsistent, +!! we go to (3) to shift the location of the inflexion point to the left +!! or to the right. To the left when the 2nd-order left slope is smaller +!! than the 2nd order right slope. +!! 3. Edge slopes are modified to shift the inflexion point, either onto the left +!! edge or onto the right edge. - ! Arguments +subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r ) real, intent(in) :: h !< cell width real, intent(in) :: u0_l !< left edge value real, intent(in) :: u0_r !< right edge value @@ -538,7 +495,6 @@ subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r real, intent(in) :: slope !< limited PLM slope real, intent(inout) :: u1_l !< left edge slopes real, intent(inout) :: u1_r !< right edge slopes - ! Local variables integer :: found_ip integer :: inflexion_l ! bool telling if inflex. pt must be on left @@ -677,4 +633,16 @@ subroutine monotonize_cubic( h, u0_l, u0_r, sigma_l, sigma_r, slope, u1_l, u1_r end subroutine monotonize_cubic +!> \namespace p3m_functions +!! +!! Date of creation: 2008.06.09 +!! L. White +!! +!! This module contains p3m interpolation routines. +!! +!! p3m interpolation is performed by estimating the edge values and slopes +!! and constructing a cubic polynomial. We then make sure that the edge values +!! are bounded and continuous and we then modify the slopes to get a monotonic +!! cubic curve. + end module P3M_functions diff --git a/src/ALE/PCM_functions.F90 b/src/ALE/PCM_functions.F90 index 6d407b0cc5..135f53a8a1 100644 --- a/src/ALE/PCM_functions.F90 +++ b/src/ALE/PCM_functions.F90 @@ -1,44 +1,21 @@ +!> Piecewise constant reconstruction functions module PCM_functions ! This file is part of MOM6. See LICENSE.md for the license. -!============================================================================== -! -! Date of creation: 2008.06.06 -! L. White -! -! This module contains routines that handle one-dimensionnal finite volume -! reconstruction using the piecewise constant method (PCM). -! -!============================================================================== - implicit none ; private public PCM_reconstruction contains -!------------------------------------------------------------------------------ !> Reconstruction by constant polynomials within each cell. There is nothing to !! do but this routine is provided to ensure a homogeneous interface !! throughout the regridding toolbox. +!! +!! It is assumed that the dimension of 'u' is equal to the number of cells +!! defining 'grid' and 'ppoly'. No consistency check is performed. subroutine PCM_reconstruction( N, u, ppoly_E, ppoly_coef ) -!------------------------------------------------------------------------------ -! Reconstruction by constant polynomials within each cell. There is nothing to -! do but this routine is provided to ensure a homogeneous interface -! throughout the regridding toolbox. -! -! N: number of cells in grid -! h: thicknesses of grid cells -! u: cell averages to use in constructing piecewise polynomials -! ppoly_E : edge values of piecewise polynomials -! ppoly_coef : coefficients of piecewise polynomials -! -! It is assumed that the dimension of 'u' is equal to the number of cells -! defining 'grid' and 'ppoly'. No consistency check is performed. -!------------------------------------------------------------------------------ - - ! Arguments integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: u !< cell averages real, dimension(:,:), intent(inout) :: ppoly_E !< Edge value of polynomial, @@ -60,4 +37,12 @@ subroutine PCM_reconstruction( N, u, ppoly_E, ppoly_coef ) end subroutine PCM_reconstruction +!> \namespace PCM_functions +!! +!! Date of creation: 2008.06.06 +!! L. White +!! +!! This module contains routines that handle one-dimensionnal finite volume +!! reconstruction using the piecewise constant method (PCM). + end module PCM_functions diff --git a/src/ALE/PLM_functions.F90 b/src/ALE/PLM_functions.F90 index 12cd558e60..ed82ad1e0b 100644 --- a/src/ALE/PLM_functions.F90 +++ b/src/ALE/PLM_functions.F90 @@ -1,42 +1,21 @@ +!> Piecewise linear reconstruction functions module PLM_functions ! This file is part of MOM6. See LICENSE.md for the license. -!============================================================================== -! -! Date of creation: 2008.06.06 -! L. White -! -! This module contains routines that handle one-dimensionnal finite volume -! reconstruction using the piecewise linear method (PLM). -! -!============================================================================== - implicit none ; private public PLM_reconstruction, PLM_boundary_extrapolation -real, parameter :: hNeglect_dflt = 1.E-30 +real, parameter :: hNeglect_dflt = 1.E-30 !< Default negligible cell thickness contains -!------------------------------------------------------------------------------ !> Reconstruction by linear polynomials within each cell +!! +!! It is assumed that the size of the array 'u' is equal to the number of cells +!! defining 'grid' and 'ppoly'. No consistency check is performed here. subroutine PLM_reconstruction( N, h, u, ppoly_E, ppoly_coef, h_neglect ) -!------------------------------------------------------------------------------ -! Reconstruction by linear polynomials within each cell. -! -! N: number of cells in grid -! h: thicknesses of grid cells -! u: cell averages to use in constructing piecewise polynomials -! ppoly_E : edge values of piecewise polynomials -! ppoly_coef : coefficients of piecewise polynomials -! -! It is assumed that the size of the array 'u' is equal to the number of cells -! defining 'grid' and 'ppoly'. No consistency check is performed here. -!------------------------------------------------------------------------------ - - ! Arguments integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) real, dimension(:), intent(in) :: u !< cell averages (size N) @@ -213,27 +192,17 @@ subroutine PLM_reconstruction( N, h, u, ppoly_E, ppoly_coef, h_neglect ) end subroutine PLM_reconstruction -!------------------------------------------------------------------------------ !> Reconstruction by linear polynomials within boundary cells +!! +!! The left and right edge values in the left and right boundary cells, +!! respectively, are estimated using a linear extrapolation within the cells. +!! +!! This extrapolation is EXACT when the underlying profile is linear. +!! +!! It is assumed that the size of the array 'u' is equal to the number of cells +!! defining 'grid' and 'ppoly'. No consistency check is performed here. + subroutine PLM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef, h_neglect ) -!------------------------------------------------------------------------------ -! Reconstruction by linear polynomials within boundary cells. -! The left and right edge values in the left and right boundary cells, -! respectively, are estimated using a linear extrapolation within the cells. -! -! This extrapolation is EXACT when the underlying profile is linear. -! -! N: number of cells in grid -! h: thicknesses of grid cells -! u: cell averages to use in constructing piecewise polynomials -! ppoly_E : edge values of piecewise polynomials -! ppoly_coef : coefficients of piecewise polynomials -! -! It is assumed that the size of the array 'u' is equal to the number of cells -! defining 'grid' and 'ppoly'. No consistency check is performed here. -!------------------------------------------------------------------------------ - - ! Arguments integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) real, dimension(:), intent(in) :: u !< cell averages (size N) @@ -299,4 +268,12 @@ subroutine PLM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef, h_neglect ) end subroutine PLM_boundary_extrapolation +!> \namespace plm_functions +!! +!! Date of creation: 2008.06.06 +!! L. White +!! +!! This module contains routines that handle one-dimensionnal finite volume +!! reconstruction using the piecewise linear method (PLM). + end module PLM_functions diff --git a/src/ALE/PQM_functions.F90 b/src/ALE/PQM_functions.F90 index 3a4e517e57..4fed4a0c86 100644 --- a/src/ALE/PQM_functions.F90 +++ b/src/ALE/PQM_functions.F90 @@ -1,41 +1,23 @@ +!> Piecewise quartic reconstruction functions module PQM_functions ! This file is part of MOM6. See LICENSE.md for the license. -!============================================================================== -! -! Date of creation: 2008.06.06 -! L. White -! -! This module contains routines that handle one-dimensionnal finite volume -! reconstruction using the piecewise quartic method (PQM). -! -!============================================================================== use regrid_edge_values, only : bound_edge_values, check_discontinuous_edge_values implicit none ; private public PQM_reconstruction, PQM_boundary_extrapolation, PQM_boundary_extrapolation_v1 -real, parameter :: hNeglect_dflt = 1.E-30 +real, parameter :: hNeglect_dflt = 1.E-30 !< Default negligible cell thickness contains -!------------------------------------------------------------------------------ -!> PQM_reconstruction does reconstruction by quartic polynomials within each cell. +!> Reconstruction by quartic polynomials within each cell. +!! +!! It is assumed that the dimension of 'u' is equal to the number of cells +!! defining 'grid' and 'ppoly'. No consistency check is performed. subroutine PQM_reconstruction( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect ) -!------------------------------------------------------------------------------ -! Reconstruction by quartic polynomials within each cell. -! -! grid: one-dimensional grid (see grid.F90) -! ppoly: piecewise quartic polynomial to be reconstructed (see ppoly.F90) -! u: cell averages -! -! It is assumed that the dimension of 'u' is equal to the number of cells -! defining 'grid' and 'ppoly'. No consistency check is performed. -!------------------------------------------------------------------------------ - - ! Arguments integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) real, dimension(:), intent(in) :: u !< cell averages (size N) @@ -87,22 +69,13 @@ subroutine PQM_reconstruction( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect end subroutine PQM_reconstruction - -!------------------------------------------------------------------------------ !> Limit the piecewise quartic method reconstruction +!! +!! Standard PQM limiter (White & Adcroft, JCP 2008). +!! +!! It is assumed that the dimension of 'u' is equal to the number of cells +!! defining 'grid' and 'ppoly'. No consistency check is performed. subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) -!------------------------------------------------------------------------------ -! Standard PQM limiter (White & Adcroft, JCP 2008). -! -! grid: one-dimensional grid (see grid.F90) -! ppoly: piecewise quadratic polynomial to be reconstructed (see ppoly.F90) -! u: cell averages -! -! It is assumed that the dimension of 'u' is equal to the number of cells -! defining 'grid' and 'ppoly'. No consistency check is performed. -!------------------------------------------------------------------------------ - - ! Arguments integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) real, dimension(:), intent(in) :: u !< cell average properties (size N) @@ -113,7 +86,6 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) real, optional, intent(in) :: h_neglect !< A negligibly small width for !! the purpose of cell reconstructions !! in the same units as h - ! Local variables integer :: k ! loop index integer :: inflexion_l @@ -368,33 +340,22 @@ subroutine PQM_limiter( N, h, u, ppoly_E, ppoly_S, h_neglect ) end subroutine PQM_limiter - -!------------------------------------------------------------------------------ -!> piecewise quartic method boundary extrapolation +!> Reconstruction by parabolas within boundary cells. +!! +!! The following explanations apply to the left boundary cell. The same +!! reasoning holds for the right boundary cell. +!! +!! A parabola needs to be built in the cell and requires three degrees of +!! freedom, which are the right edge value and slope and the cell average. +!! The right edge values and slopes are taken to be that of the neighboring +!! cell (i.e., the left edge value and slope of the neighboring cell). +!! The resulting parabola is not necessarily monotonic and the traditional +!! PPM limiter is used to modify one of the edge values in order to yield +!! a monotonic parabola. +!! +!! It is assumed that the size of the array 'u' is equal to the number of cells +!! defining 'grid' and 'ppoly'. No consistency check is performed here. subroutine PQM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef ) -!------------------------------------------------------------------------------ -! Reconstruction by parabolas within boundary cells. -! -! The following explanations apply to the left boundary cell. The same -! reasoning holds for the right boundary cell. -! -! A parabola needs to be built in the cell and requires three degrees of -! freedom, which are the right edge value and slope and the cell average. -! The right edge values and slopes are taken to be that of the neighboring -! cell (i.e., the left edge value and slope of the neighboring cell). -! The resulting parabola is not necessarily monotonic and the traditional -! PPM limiter is used to modify one of the edge values in order to yield -! a monotonic parabola. -! -! grid: one-dimensional grid (properly initialized) -! ppoly: piecewise linear polynomial to be reconstructed (properly initialized) -! u: cell averages -! -! It is assumed that the size of the array 'u' is equal to the number of cells -! defining 'grid' and 'ppoly'. No consistency check is performed here. -!------------------------------------------------------------------------------ - - ! Arguments integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) real, dimension(:), intent(in) :: u !< cell averages (size N) @@ -402,7 +363,6 @@ subroutine PQM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef ) !! with the same units as u. real, dimension(:,:), intent(inout) :: ppoly_coef !< Coefficients of polynomial, mainly !! with the same units as u. - ! Local variables integer :: i0, i1 real :: u0, u1 @@ -529,32 +489,22 @@ subroutine PQM_boundary_extrapolation( N, h, u, ppoly_E, ppoly_coef ) end subroutine PQM_boundary_extrapolation -!------------------------------------------------------------------------------ -!> pqm boundary extrapolation using a rational function +!> Reconstruction by parabolas within boundary cells. +!! +!! The following explanations apply to the left boundary cell. The same +!! reasoning holds for the right boundary cell. +!! +!! A parabola needs to be built in the cell and requires three degrees of +!! freedom, which are the right edge value and slope and the cell average. +!! The right edge values and slopes are taken to be that of the neighboring +!! cell (i.e., the left edge value and slope of the neighboring cell). +!! The resulting parabola is not necessarily monotonic and the traditional +!! PPM limiter is used to modify one of the edge values in order to yield +!! a monotonic parabola. +!! +!! It is assumed that the size of the array 'u' is equal to the number of cells +!! defining 'grid' and 'ppoly'. No consistency check is performed here. subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coef, h_neglect ) -!------------------------------------------------------------------------------ -! Reconstruction by parabolas within boundary cells. -! -! The following explanations apply to the left boundary cell. The same -! reasoning holds for the right boundary cell. -! -! A parabola needs to be built in the cell and requires three degrees of -! freedom, which are the right edge value and slope and the cell average. -! The right edge values and slopes are taken to be that of the neighboring -! cell (i.e., the left edge value and slope of the neighboring cell). -! The resulting parabola is not necessarily monotonic and the traditional -! PPM limiter is used to modify one of the edge values in order to yield -! a monotonic parabola. -! -! grid: one-dimensional grid (properly initialized) -! ppoly: piecewise linear polynomial to be reconstructed (properly initialized) -! u: cell averages -! -! It is assumed that the size of the array 'u' is equal to the number of cells -! defining 'grid' and 'ppoly'. No consistency check is performed here. -!------------------------------------------------------------------------------ - - ! Arguments integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) real, dimension(:), intent(in) :: u !< cell averages (size N) @@ -567,7 +517,6 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coef, real, optional, intent(in) :: h_neglect !< A negligibly small width for !! the purpose of cell reconstructions !! in the same units as h. - ! Local variables integer :: i0, i1 integer :: inflexion_l @@ -889,4 +838,12 @@ subroutine PQM_boundary_extrapolation_v1( N, h, u, ppoly_E, ppoly_S, ppoly_coef, end subroutine PQM_boundary_extrapolation_v1 +!> \namespace pqm_functions +!! +!! Date of creation: 2008.06.06 +!! L. White +!! +!! This module contains routines that handle one-dimensionnal finite volume +!! reconstruction using the piecewise quartic method (PQM). + end module PQM_functions diff --git a/src/ALE/polynomial_functions.F90 b/src/ALE/polynomial_functions.F90 index 78c75f53a0..e5c90fe31d 100644 --- a/src/ALE/polynomial_functions.F90 +++ b/src/ALE/polynomial_functions.F90 @@ -1,43 +1,25 @@ +!> Polynomial functions module polynomial_functions ! This file is part of MOM6. See LICENSE.md for the license. -!============================================================================== -! -! Date of creation: 2008.06.12 -! L. White -! -! This module contains routines that handle polynomials. -! -!============================================================================== - implicit none ; private public :: evaluation_polynomial, integration_polynomial, first_derivative_polynomial -! ----------------------------------------------------------------------------- -! This module contains the following routines -! ----------------------------------------------------------------------------- contains -! ----------------------------------------------------------------------------- !> Pointwise evaluation of a polynomial at x +!! +!! The polynomial is defined by the coefficients contained in the +!! array of the same name, as follows: C(1) + C(2)x + C(3)x^2 + C(4)x^3 + ... +!! where C refers to the array 'coeff'. +!! The number of coefficients is given by ncoef and x +!! is the coordinate where the polynomial is to be evaluated. real function evaluation_polynomial( coeff, ncoef, x ) real, dimension(:), intent(in) :: coeff !< The coefficients of the polynomial integer, intent(in) :: ncoef !< The number of polynomial coefficients real, intent(in) :: x !< The position at which to evaluate the polynomial -! ----------------------------------------------------------------------------- -! The polynomial is defined by the coefficients contained in the -! array of the same name, as follows: C(1) + C(2)x + C(3)x^2 + C(4)x^3 + ... -! where C refers to the array 'coeff'. -! The number of coefficients is given by ncoef and x -! is the coordinate where the polynomial is to be evaluated. -! -! The function returns the value of the polynomial at x. -! ----------------------------------------------------------------------------- - - ! Arguments - ! Local variables integer :: k real :: f ! value of polynomial at x @@ -52,20 +34,16 @@ real function evaluation_polynomial( coeff, ncoef, x ) end function evaluation_polynomial !> Calculates the first derivative of a polynomial evaluated at a point x +!! +!! The polynomial is defined by the coefficients contained in the +!! array of the same name, as follows: C(1) + C(2)x + C(3)x^2 + C(4)x^3 + ... +!! where C refers to the array 'coeff'. +!! The number of coefficients is given by ncoef and x +!! is the coordinate where the polynomial's derivative is to be evaluated. real function first_derivative_polynomial( coeff, ncoef, x ) real, dimension(:), intent(in) :: coeff !< The coefficients of the polynomial integer, intent(in) :: ncoef !< The number of polynomial coefficients real, intent(in) :: x !< The position at which to evaluate the derivative -! ----------------------------------------------------------------------------- -! The polynomial is defined by the coefficients contained in the -! array of the same name, as follows: C(1) + C(2)x + C(3)x^2 + C(4)x^3 + ... -! where C refers to the array 'coeff'. -! The number of coefficients is given by ncoef and x -! is the coordinate where the polynomial's derivative is to be evaluated. -! -! The function returns the first derivative of the polynomial at x. -! ----------------------------------------------------------------------------- - ! Local variables integer :: k real :: f ! value of polynomial at x @@ -79,18 +57,14 @@ real function first_derivative_polynomial( coeff, ncoef, x ) end function first_derivative_polynomial -! ----------------------------------------------------------------------------- !> Exact integration of polynomial of degree npoly +!! +!! The array of coefficients (Coeff) must be of size npoly+1. real function integration_polynomial( xi0, xi1, Coeff, npoly ) real, intent(in) :: xi0 !< The lower bound of the integral real, intent(in) :: xi1 !< The lower bound of the integral real, dimension(:), intent(in) :: Coeff !< The coefficients of the polynomial integer, intent(in) :: npoly !< The degree of the polynomial -! ----------------------------------------------------------------------------- -! Exact integration of a polynomial of degree npoly over the interval [xi0,xi1]. -! The array of coefficients (Coeff) must be of size npoly+1. -! ----------------------------------------------------------------------------- - ! Local variables integer :: k real :: integral @@ -125,4 +99,11 @@ real function integration_polynomial( xi0, xi1, Coeff, npoly ) end function integration_polynomial +!> \namespace polynomial_functions +!! +!! Date of creation: 2008.06.12 +!! L. White +!! +!! This module contains routines that handle polynomials. + end module polynomial_functions diff --git a/src/ALE/regrid_edge_slopes.F90 b/src/ALE/regrid_edge_slopes.F90 index 59d36e3e0e..c22a524683 100644 --- a/src/ALE/regrid_edge_slopes.F90 +++ b/src/ALE/regrid_edge_slopes.F90 @@ -1,36 +1,51 @@ +!> Routines that estimate edge slopes to be used in +!! high-order reconstruction schemes. module regrid_edge_slopes ! This file is part of MOM6. See LICENSE.md for the license. -!============================================================================== -! -! Date of creation: 2008.06.09 -! L. White -! -! This module contains routines that estimate edge slopes to be used in -! high-order reconstruction schemes. -! -!============================================================================== use regrid_solvers, only : solve_linear_system, solve_tridiagonal_system use polynomial_functions, only : evaluation_polynomial - implicit none ; private -! ----------------------------------------------------------------------------- -! The following routines are visible to the outside world -! ----------------------------------------------------------------------------- public edge_slopes_implicit_h3 public edge_slopes_implicit_h5 -! Specifying a dimensional parameter value, as is done here, is a terrible idea. -real, parameter :: hNeglect_dflt = 1.E-30 +! Specifying a dimensional parameter value, as is done here, is a terrible idea. +real, parameter :: hNeglect_dflt = 1.E-30 !< Default negligible cell thickness contains - !------------------------------------------------------------------------------ !> Compute ih4 edge slopes (implicit third order accurate) +!! in the same units as h. +!! +!! Compute edge slopes based on third-order implicit estimates. Note that +!! the estimates are fourth-order accurate on uniform grids +!! +!! Third-order implicit estimates of edge slopes are based on a two-cell +!! stencil. A tridiagonal system is set up and is based on expressing the +!! edge slopes in terms of neighboring cell averages. The generic +!! relationship is +!! +!! \f[ +!! \alpha u'_{i-1/2} + u'_{i+1/2} + \beta u'_{i+3/2} = +!! a \bar{u}_i + b \bar{u}_{i+1} +!! \f] +!! +!! and the stencil looks like this +!! +!! i i+1 +!! ..--o------o------o--.. +!! i-1/2 i+1/2 i+3/2 +!! +!! In this routine, the coefficients \f$\alpha\f$, \f$\beta\f$, a and b are computed, +!! the tridiagonal system is built, boundary conditions are prescribed and +!! the system is solved to yield edge-slope estimates. +!! +!! There are N+1 unknowns and we are able to write N-1 equations. The +!! boundary conditions close the system. subroutine edge_slopes_implicit_h3( N, h, u, edge_slopes, h_neglect ) integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) @@ -38,33 +53,6 @@ subroutine edge_slopes_implicit_h3( N, h, u, edge_slopes, h_neglect ) real, dimension(:,:), intent(inout) :: edge_slopes !< Returned edge slopes, with the !! same units as u divided by the units of h. real, optional, intent(in) :: h_neglect !< A negligibly small width - !! in the same units as h. -! ----------------------------------------------------------------------------- -! Compute edge slopes based on third-order implicit estimates. Note that -! the estimates are fourth-order accurate on uniform grids -! -! Third-order implicit estimates of edge slopes are based on a two-cell -! stencil. A tridiagonal system is set up and is based on expressing the -! edge slopes in terms of neighboring cell averages. The generic -! relationship is -! -! \alpha u'_{i-1/2} + u'_{i+1/2} + \beta u'_{i+3/2} = -! a \bar{u}_i + b \bar{u}_{i+1} -! -! and the stencil looks like this -! -! i i+1 -! ..--o------o------o--.. -! i-1/2 i+1/2 i+3/2 -! -! In this routine, the coefficients \alpha, \beta, a and b are computed, -! the tridiagonal system is built, boundary conditions are prescribed and -! the system is solved to yield edge-slope estimates. -! -! There are N+1 unknowns and we are able to write N-1 equations. The -! boundary conditions close the system. -! ----------------------------------------------------------------------------- - ! Local variables integer :: i, j ! loop indexes real :: h0, h1 ! cell widths diff --git a/src/ALE/regrid_edge_values.F90 b/src/ALE/regrid_edge_values.F90 index 5fe4700c38..d27d69153c 100644 --- a/src/ALE/regrid_edge_values.F90 +++ b/src/ALE/regrid_edge_values.F90 @@ -1,16 +1,8 @@ +!> Edge value estimation for high-order resconstruction module regrid_edge_values ! This file is part of MOM6. See LICENSE.md for the license. -!============================================================================== -! -! Date of creation: 2008.06.09 -! L. White -! -! This module contains routines that estimate edge values to be used in -! high-order reconstruction schemes. -! -!============================================================================== use regrid_solvers, only : solve_linear_system, solve_tridiagonal_system use polynomial_functions, only : evaluation_polynomial @@ -34,16 +26,24 @@ module regrid_edge_values ! to a small enough values such that the eigenvalues of the matrix can not ! be separated. ! Specifying a dimensional parameter value, as is done here, is a terrible idea. -real, parameter :: hNeglect_edge_dflt = 1.e-10 ! The default value for cut-off minimum - ! thickness for sum(h) in edge value inversions -real, parameter :: hNeglect_dflt = 1.e-30 ! The default value for cut-off minimum - ! thickness for sum(h) in other calculations -real, parameter :: hMinFrac = 1.e-5 ! A minimum fraction for min(h)/sum(h) +real, parameter :: hNeglect_edge_dflt = 1.e-10 !< The default value for cut-off minimum + !! thickness for sum(h) in edge value inversions +real, parameter :: hNeglect_dflt = 1.e-30 !< The default value for cut-off minimum + !! thickness for sum(h) in other calculations +real, parameter :: hMinFrac = 1.e-5 !< A minimum fraction for min(h)/sum(h) contains -!------------------------------------------------------------------------------ !> Bound edge values by neighboring cell averages +!! +!! In this routine, we loop on all cells to bound their left and right +!! edge values by the cell averages. That is, the left edge value must lie +!! between the left cell average and the central cell average. A similar +!! reasoning applies to the right edge values. +!! +!! Both boundary edge values are set equal to the boundary cell averages. +!! Any extrapolation scheme is applied after this routine has been called. +!! Therefore, boundary cells are treated as if they were local extrama. subroutine bound_edge_values( N, h, u, edge_val, h_neglect ) integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) @@ -52,17 +52,6 @@ subroutine bound_edge_values( N, h, u, edge_val, h_neglect ) !! with the same units as u. real, optional, intent(in) :: h_neglect !< A negligibly small width !! in the same units as h. -! ------------------------------------------------------------------------------ -! In this routine, we loop on all cells to bound their left and right -! edge values by the cell averages. That is, the left edge value must lie -! between the left cell average and the central cell average. A similar -! reasoning applies to the right edge values. -! -! Both boundary edge values are set equal to the boundary cell averages. -! Any extrapolation scheme is applied after this routine has been called. -! Therefore, boundary cells are treated as if they were local extrama. -! ------------------------------------------------------------------------------ - ! Local variables integer :: k ! loop index integer :: k0, k1, k2 @@ -147,18 +136,14 @@ subroutine bound_edge_values( N, h, u, edge_val, h_neglect ) end subroutine bound_edge_values - -!------------------------------------------------------------------------------ !> Replace discontinuous collocated edge values with their average +!! +!! For each interior edge, check whether the edge values are discontinuous. +!! If so, compute the average and replace the edge values by the average. subroutine average_discontinuous_edge_values( N, edge_val ) integer, intent(in) :: N !< Number of cells real, dimension(:,:), intent(inout) :: edge_val !< Edge values that may be modified !! the second index size is 2. -! ------------------------------------------------------------------------------ -! For each interior edge, check whether the edge values are discontinuous. -! If so, compute the average and replace the edge values by the average. -! ------------------------------------------------------------------------------ - ! Local variables integer :: k ! loop index real :: u0_minus ! left value at given edge @@ -184,18 +169,14 @@ subroutine average_discontinuous_edge_values( N, edge_val ) end subroutine average_discontinuous_edge_values - -!------------------------------------------------------------------------------ !> Check discontinuous edge values and replace them with their average if not monotonic +!! +!! For each interior edge, check whether the edge values are discontinuous. +!! If so and if they are not monotonic, replace each edge value by their average. subroutine check_discontinuous_edge_values( N, u, edge_val ) integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: u !< cell averages (size N) real, dimension(:,:), intent(inout) :: edge_val !< Cell edge values with the same units as u. -! ------------------------------------------------------------------------------ -! For each interior edge, check whether the edge values are discontinuous. -! If so and if they are not monotonic, replace each edge value by their average. -! ------------------------------------------------------------------------------ - ! Local variables integer :: k ! loop index real :: u0_minus ! left value at given edge @@ -231,8 +212,19 @@ subroutine check_discontinuous_edge_values( N, u, edge_val ) end subroutine check_discontinuous_edge_values -!------------------------------------------------------------------------------ !> Compute h2 edge values (explicit second order accurate) +!! in the same units as h. +! +!! Compute edge values based on second-order explicit estimates. +!! These estimates are based on a straight line spanning two cells and evaluated +!! at the location of the middle edge. An interpolant spanning cells +!! k-1 and k is evaluated at edge k-1/2. The estimate for each edge is unique. +!! +!! k-1 k +!! ..--o------o------o--.. +!! k-1/2 +!! +!! Boundary edge values are set to be equal to the boundary cell averages. subroutine edge_values_explicit_h2( N, h, u, edge_val, h_neglect ) integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) @@ -240,20 +232,6 @@ subroutine edge_values_explicit_h2( N, h, u, edge_val, h_neglect ) real, dimension(:,:), intent(inout) :: edge_val !< Returned edge values, with the !! same units as u; the second index size is 2. real, optional, intent(in) :: h_neglect !< A negligibly small width - !! in the same units as h. -! ------------------------------------------------------------------------------ -! Compute edge values based on second-order explicit estimates. -! These estimates are based on a straight line spanning two cells and evaluated -! at the location of the middle edge. An interpolant spanning cells -! k-1 and k is evaluated at edge k-1/2. The estimate for each edge is unique. -! -! k-1 k -! ..--o------o------o--.. -! k-1/2 -! -! Boundary edge values are set to be equal to the boundary cell averages. -! ------------------------------------------------------------------------------ - ! Local variables integer :: k ! loop index real :: h0, h1 ! cell widths @@ -292,9 +270,25 @@ subroutine edge_values_explicit_h2( N, h, u, edge_val, h_neglect ) end subroutine edge_values_explicit_h2 - -!------------------------------------------------------------------------------ !> Compute h4 edge values (explicit fourth order accurate) +!! in the same units as h. +!! +!! Compute edge values based on fourth-order explicit estimates. +!! These estimates are based on a cubic interpolant spanning four cells +!! and evaluated at the location of the middle edge. An interpolant spanning +!! cells i-2, i-1, i and i+1 is evaluated at edge i-1/2. The estimate for +!! each edge is unique. +!! +!! i-2 i-1 i i+1 +!! ..--o------o------o------o------o--.. +!! i-1/2 +!! +!! The first two edge values are estimated by evaluating the first available +!! cubic interpolant, i.e., the interpolant spanning cells 1, 2, 3 and 4. +!! Similarly, the last two edge values are estimated by evaluating the last +!! available interpolant. +!! +!! For this fourth-order scheme, at least four cells must exist. subroutine edge_values_explicit_h4( N, h, u, edge_val, h_neglect ) integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) @@ -302,26 +296,6 @@ subroutine edge_values_explicit_h4( N, h, u, edge_val, h_neglect ) real, dimension(:,:), intent(inout) :: edge_val !< Returned edge values, with the !! same units as u; the second index size is 2. real, optional, intent(in) :: h_neglect !< A negligibly small width - !! in the same units as h. -! ----------------------------------------------------------------------------- -! Compute edge values based on fourth-order explicit estimates. -! These estimates are based on a cubic interpolant spanning four cells -! and evaluated at the location of the middle edge. An interpolant spanning -! cells i-2, i-1, i and i+1 is evaluated at edge i-1/2. The estimate for -! each edge is unique. -! -! i-2 i-1 i i+1 -! ..--o------o------o------o------o--.. -! i-1/2 -! -! The first two edge values are estimated by evaluating the first available -! cubic interpolant, i.e., the interpolant spanning cells 1, 2, 3 and 4. -! Similarly, the last two edge values are estimated by evaluating the last -! available interpolant. -! -! For this fourth-order scheme, at least four cells must exist. -! ----------------------------------------------------------------------------- - ! Local variables integer :: i, j real :: u0, u1, u2, u3 @@ -475,9 +449,32 @@ subroutine edge_values_explicit_h4( N, h, u, edge_val, h_neglect ) end subroutine edge_values_explicit_h4 - -!------------------------------------------------------------------------------ !> Compute ih4 edge values (implicit fourth order accurate) +!! in the same units as h. +!! +!! Compute edge values based on fourth-order implicit estimates. +!! +!! Fourth-order implicit estimates of edge values are based on a two-cell +!! stencil. A tridiagonal system is set up and is based on expressing the +!! edge values in terms of neighboring cell averages. The generic +!! relationship is +!! +!! \f[ +!! \alpha u_{i-1/2} + u_{i+1/2} + \beta u_{i+3/2} = a \bar{u}_i + b \bar{u}_{i+1} +!! \f] +!! +!! and the stencil looks like this +!! +!! i i+1 +!! ..--o------o------o--.. +!! i-1/2 i+1/2 i+3/2 +!! +!! In this routine, the coefficients \f$\alpha\f$, \f$\beta\f$, \f$a\f$ and \f$b\f$ are +!! computed, the tridiagonal system is built, boundary conditions are prescribed and +!! the system is solved to yield edge-value estimates. +!! +!! There are N+1 unknowns and we are able to write N-1 equations. The +!! boundary conditions close the system. subroutine edge_values_implicit_h4( N, h, u, edge_val, h_neglect ) integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) @@ -485,31 +482,6 @@ subroutine edge_values_implicit_h4( N, h, u, edge_val, h_neglect ) real, dimension(:,:), intent(inout) :: edge_val !< Returned edge values, with the !! same units as u; the second index size is 2. real, optional, intent(in) :: h_neglect !< A negligibly small width - !! in the same units as h. -! ----------------------------------------------------------------------------- -! Compute edge values based on fourth-order implicit estimates. -! -! Fourth-order implicit estimates of edge values are based on a two-cell -! stencil. A tridiagonal system is set up and is based on expressing the -! edge values in terms of neighboring cell averages. The generic -! relationship is -! -! \alpha u_{i-1/2} + u_{i+1/2} + \beta u_{i+3/2} = a \bar{u}_i + b \bar{u}_{i+1} -! -! and the stencil looks like this -! -! i i+1 -! ..--o------o------o--.. -! i-1/2 i+1/2 i+3/2 -! -! In this routine, the coefficients \alpha, \beta, a and b are computed, -! the tridiagonal system is built, boundary conditions are prescribed and -! the system is solved to yield edge-value estimates. -! -! There are N+1 unknowns and we are able to write N-1 equations. The -! boundary conditions close the system. -! ----------------------------------------------------------------------------- - ! Local variables integer :: i, j ! loop indexes real :: h0, h1 ! cell widths @@ -621,9 +593,41 @@ subroutine edge_values_implicit_h4( N, h, u, edge_val, h_neglect ) end subroutine edge_values_implicit_h4 - -!------------------------------------------------------------------------------ !> Compute ih6 edge values (implicit sixth order accurate) + !! in the same units as h. +!! +!! Sixth-order implicit estimates of edge values are based on a four-cell, +!! three-edge stencil. A tridiagonal system is set up and is based on +!! expressing the edge values in terms of neighboring cell averages. +!! +!! The generic relationship is +!! +!! \f[ +!! \alpha u_{i-1/2} + u_{i+1/2} + \beta u_{i+3/2} = +!! a \bar{u}_{i-1} + b \bar{u}_i + c \bar{u}_{i+1} + d \bar{u}_{i+2} +!! \f] +!! +!! and the stencil looks like this +!! +!! i-1 i i+1 i+2 +!! ..--o------o------o------o------o--.. +!! i-1/2 i+1/2 i+3/2 +!! +!! In this routine, the coefficients \f$\alpha\f$, \f$\beta\f$, a, b, c and d are +!! computed, the tridiagonal system is built, boundary conditions are +!! prescribed and the system is solved to yield edge-value estimates. +!! +!! Note that the centered stencil only applies to edges 3 to N-1 (edges are +!! numbered 1 to n+1), which yields N-3 equations for N+1 unknowns. Two other +!! equations are written by using a right-biased stencil for edge 2 and a +!! left-biased stencil for edge N. The prescription of boundary conditions +!! (using sixth-order polynomials) closes the system. +!! +!! CAUTION: For each edge, in order to determine the coefficients of the +!! implicit expression, a 6x6 linear system is solved. This may +!! become computationally expensive if regridding is carried out +!! often. Figuring out closed-form expressions for these coefficients +!! on nonuniform meshes turned out to be intractable. subroutine edge_values_implicit_h6( N, h, u, edge_val, h_neglect ) integer, intent(in) :: N !< Number of cells real, dimension(:), intent(in) :: h !< cell widths (size N) @@ -631,40 +635,6 @@ subroutine edge_values_implicit_h6( N, h, u, edge_val, h_neglect ) real, dimension(:,:), intent(inout) :: edge_val !< Returned edge values, with the !! same units as u; the second index size is 2. real, optional, intent(in) :: h_neglect !< A negligibly small width - !! in the same units as h. -! ----------------------------------------------------------------------------- -! Sixth-order implicit estimates of edge values are based on a four-cell, -! three-edge stencil. A tridiagonal system is set up and is based on -! expressing the edge values in terms of neighboring cell averages. -! -! The generic relationship is -! -! \alpha u_{i-1/2} + u_{i+1/2} + \beta u_{i+3/2} = -! a \bar{u}_{i-1} + b \bar{u}_i + c \bar{u}_{i+1} + d \bar{u}_{i+2} -! -! and the stencil looks like this -! -! i-1 i i+1 i+2 -! ..--o------o------o------o------o--.. -! i-1/2 i+1/2 i+3/2 -! -! In this routine, the coefficients \alpha, \beta, a, b, c and d are -! computed, the tridiagonal system is built, boundary conditions are -! prescribed and the system is solved to yield edge-value estimates. -! -! Note that the centered stencil only applies to edges 3 to N-1 (edges are -! numbered 1 to n+1), which yields N-3 equations for N+1 unknowns. Two other -! equations are written by using a right-biased stencil for edge 2 and a -! left-biased stencil for edge N. The prescription of boundary conditions -! (using sixth-order polynomials) closes the system. -! -! CAUTION: For each edge, in order to determine the coefficients of the -! implicit expression, a 6x6 linear system is solved. This may -! become computationally expensive if regridding is carried out -! often. Figuring out closed-form expressions for these coefficients -! on nonuniform meshes turned out to be intractable. -! ----------------------------------------------------------------------------- - ! Local variables integer :: i, j, k ! loop indexes real :: h0, h1, h2, h3 ! cell widths @@ -1116,5 +1086,4 @@ subroutine edge_values_implicit_h6( N, h, u, edge_val, h_neglect ) end subroutine edge_values_implicit_h6 - end module regrid_edge_values diff --git a/src/ALE/regrid_interp.F90 b/src/ALE/regrid_interp.F90 index ec1259874f..9bc794a2ef 100644 --- a/src/ALE/regrid_interp.F90 +++ b/src/ALE/regrid_interp.F90 @@ -1,3 +1,4 @@ +!> Vertical interpolation for regridding module regrid_interp ! This file is part of MOM6. See LICENSE.md for the license. @@ -47,9 +48,10 @@ module regrid_interp integer, parameter :: INTERPOLATION_PQM_IH4IH3 = 8 !< O(h^4) integer, parameter :: INTERPOLATION_PQM_IH6IH5 = 9 !< O(h^5) -!> List of interpolant degrees +!>@{ Interpolant degrees integer, parameter :: DEGREE_1 = 1, DEGREE_2 = 2, DEGREE_3 = 3, DEGREE_4 = 4 integer, public, parameter :: DEGREE_MAX = 5 +!!@} !> When the N-R algorithm produces an estimate that lies outside [0,1], the !! estimate is set to be equal to the boundary location, 0 or 1, plus or minus @@ -64,8 +66,8 @@ module regrid_interp contains -!> Given the set of target values and cell densities, this routine -!! builds an interpolated profile for the densities within each grid cell. +!> Builds an interpolated profile for the densities within each grid cell. +!! !! It may happen that, given a high-order interpolator, the number of !! available layers is insufficient (e.g., there are two available layers for !! a third-order PPM ih4 scheme). In these cases, we resort to the simplest @@ -86,7 +88,7 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & real, optional, intent(in) :: h_neglect_edge !< A negligibly small width !! for the purpose of edge value calculations !! in the same units as h0. - + ! Local variables logical :: extrapolate ! Reset piecewise polynomials @@ -263,7 +265,6 @@ end subroutine regridding_set_ppolys !! are determined by finding the corresponding target interface densities. subroutine interpolate_grid( n0, h0, x0, ppoly0_E, ppoly0_coefs, & target_values, degree, n1, h1, x1 ) - ! Arguments integer, intent(in) :: n0 !< Number of points on source grid real, dimension(:), intent(in) :: h0 !< Thicknesses of source grid cells real, dimension(:), intent(in) :: x0 !< Source interface positions @@ -274,7 +275,6 @@ subroutine interpolate_grid( n0, h0, x0, ppoly0_E, ppoly0_coefs, & integer, intent(in) :: n1 !< Number of points on target grid real, dimension(:), intent(inout) :: h1 !< Thicknesses of target grid cells real, dimension(:), intent(inout) :: x1 !< Target interface positions - ! Local variables integer :: k ! loop index real :: t ! current interface target density @@ -294,6 +294,7 @@ subroutine interpolate_grid( n0, h0, x0, ppoly0_E, ppoly0_coefs, & end subroutine interpolate_grid +!> Build a grid by interpolating for target values subroutine build_and_interpolate_grid(CS, densities, n0, h0, x0, target_values, & n1, h1, x1, h_neglect, h_neglect_edge) type(interp_CS_type), intent(in) :: CS !< A control structure for regrid_interp @@ -338,8 +339,8 @@ end subroutine build_and_interpolate_grid !! !! It is assumed that the number of cells defining 'grid' and 'ppoly' are the !! same. -function get_polynomial_coordinate ( N, h, x_g, ppoly_E, ppoly_coefs, & - target_value, degree ) result ( x_tgt ) +function get_polynomial_coordinate( N, h, x_g, ppoly_E, ppoly_coefs, & + target_value, degree ) result ( x_tgt ) ! Arguments integer, intent(in) :: N !< Number of grid cells real, dimension(:), intent(in) :: h !< Grid cell thicknesses @@ -348,9 +349,7 @@ function get_polynomial_coordinate ( N, h, x_g, ppoly_E, ppoly_coefs, & real, dimension(:,:), intent(in) :: ppoly_coefs !< Coefficients of interpolating polynomials real, intent(in) :: target_value !< Target value to find position for integer, intent(in) :: degree !< Degree of the interpolating polynomials - real :: x_tgt !< The position of x_g at which target_value is found. - ! Local variables integer :: i, k ! loop indices integer :: k_found ! index of target cell diff --git a/src/ALE/regrid_solvers.F90 b/src/ALE/regrid_solvers.F90 index 18ef1e5e0b..8ee7ab29b2 100644 --- a/src/ALE/regrid_solvers.F90 +++ b/src/ALE/regrid_solvers.F90 @@ -1,42 +1,26 @@ +!> Solvers of linear systems. module regrid_solvers ! This file is part of MOM6. See LICENSE.md for the license. -!============================================================================== -! -! Date of creation: 2008.06.12 -! L. White -! -! This module contains solvers of linear systems. -! These routines could (should ?) be replaced later by more efficient ones. -! -! -!============================================================================== - use MOM_error_handler, only : MOM_error, FATAL implicit none ; private public :: solve_linear_system, solve_tridiagonal_system -! ----------------------------------------------------------------------------- -! This module contains the following routines -! ----------------------------------------------------------------------------- contains -! ----------------------------------------------------------------------------- !> Solve the linear system AX = B by Gaussian elimination +!! +!! This routine uses Gauss's algorithm to transform the system's original +!! matrix into an upper triangular matrix. Back substitution yields the answer. +!! The matrix A must be square and its size must be that of the vectors B and X. subroutine solve_linear_system( A, B, X, system_size ) real, dimension(:,:), intent(inout) :: A !< The matrix being inverted real, dimension(:), intent(inout) :: B !< system right-hand side real, dimension(:), intent(inout) :: X !< solution vector integer, intent(in) :: system_size !< The size of the system -! ----------------------------------------------------------------------------- -! This routine uses Gauss's algorithm to transform the system's original -! matrix into an upper triangular matrix. Back substitution yields the answer. -! The matrix A must be square and its size must be that of the vectors B and X. -! ----------------------------------------------------------------------------- - ! Local variables integer :: i, j, k real, parameter :: eps = 0.0 ! Minimum pivot magnitude allowed @@ -122,9 +106,10 @@ subroutine solve_linear_system( A, B, X, system_size ) end subroutine solve_linear_system - -! ----------------------------------------------------------------------------- !> Solve the tridiagonal system AX = B +!! +!! This routine uses Thomas's algorithm to solve the tridiagonal system AX = B. +!! (A is made up of lower, middle and upper diagonals) subroutine solve_tridiagonal_system( Al, Ad, Au, B, X, system_size ) real, dimension(:), intent(inout) :: Ad !< Maxtix center diagonal real, dimension(:), intent(inout) :: Al !< Matrix lower diagonal @@ -132,11 +117,6 @@ subroutine solve_tridiagonal_system( Al, Ad, Au, B, X, system_size ) real, dimension(:), intent(inout) :: B !< system right-hand side real, dimension(:), intent(inout) :: X !< solution vector integer, intent(in) :: system_size !< The size of the system -! ----------------------------------------------------------------------------- -! This routine uses Thomas's algorithm to solve the tridiagonal system AX = B. -! (A is made up of lower, middle and upper diagonals) -! ----------------------------------------------------------------------------- - ! Local variables integer :: k ! Loop index integer :: N ! system size @@ -162,4 +142,12 @@ subroutine solve_tridiagonal_system( Al, Ad, Au, B, X, system_size ) end subroutine solve_tridiagonal_system +!> \namespace regrid_solvers +!! +!! Date of creation: 2008.06.12 +!! L. White +!! +!! This module contains solvers of linear systems. +!! These routines could (should ?) be replaced later by more efficient ones. + end module regrid_solvers diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 0227835a45..67cf7bbd24 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -1,3 +1,4 @@ +!> Initializes hydrography from z-coordinate climatology files module MOM_tracer_initialization_from_Z ! This file is part of MOM6. See LICENSE.md for the license. @@ -32,9 +33,7 @@ module MOM_tracer_initialization_from_Z public :: MOM_initialize_tracer_from_Z -character(len=40) :: mdl = "MOM_tracer_initialization_from_Z" ! This module's name. - -real, parameter :: epsln=1.e-10 +character(len=40) :: mdl = "MOM_tracer_initialization_from_Z" !< This module's name. contains @@ -205,5 +204,4 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, end subroutine MOM_initialize_tracer_from_Z - end module MOM_tracer_initialization_from_Z diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index c2a923d404..1974249df1 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -1,41 +1,8 @@ +!> Build mixed layer parameterization module MOM_bulk_mixed_layer ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, 1997 - 2005. * -!* * -!* This file contains the subroutine (bulkmixedlayer) that * -!* implements a Kraus-Turner-like bulk mixed layer, based on the work * -!* of various people, as described in the review paper by Niiler and * -!* Kraus (1979), with particular attention to the form proposed by * -!* Oberhuber (JPO, 1993, 808-829), with an extension to a refied bulk * -!* mixed layer as described in Hallberg (Aha Huliko'a, 2003). The * -!* physical processes portrayed in this subroutine include convective * -!* adjustment and mixed layer entrainment and detrainment. * -!* Penetrating shortwave radiation and an exponential decay of TKE * -!* fluxes are also supported by this subroutine. Several constants * -!* can alternately be set to give a traditional Kraus-Turner mixed * -!* layer scheme, although that is not the preferred option. The * -!* physical processes and arguments are described in detail below. * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, buoy, T, S, eaml, ebml, etc. * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_alloc use MOM_diag_mediator, only : time_type, diag_ctrl, diag_update_remap_grids @@ -3984,4 +3951,22 @@ function EF4(H, E, L, dR_de) end function EF4 +!> \namespace mom_bulk_mixed_layer +!! +!! By Robert Hallberg, 1997 - 2005. +!! +!! This file contains the subroutine (bulkmixedlayer) that +!! implements a Kraus-Turner-like bulk mixed layer, based on the work +!! of various people, as described in the review paper by Niiler and +!! Kraus (1979), with particular attention to the form proposed by +!! Oberhuber (JPO, 1993, 808-829), with an extension to a refied bulk +!! mixed layer as described in Hallberg (Aha Huliko'a, 2003). The +!! physical processes portrayed in this subroutine include convective +!! adjustment and mixed layer entrainment and detrainment. +!! Penetrating shortwave radiation and an exponential decay of TKE +!! fluxes are also supported by this subroutine. Several constants +!! can alternately be set to give a traditional Kraus-Turner mixed +!! layer scheme, although that is not the preferred option. The +!! physical processes and arguments are described in detail below. + end module MOM_bulk_mixed_layer diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index c848a1de60..f662eda365 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -1,3 +1,5 @@ +!> Provides functions for some diabatic processes such as fraxil, brine rejection, +!! tendency due to surface flux divergence. module MOM_diabatic_aux ! This file is part of MOM6. See LICENSE.md for the license. @@ -1408,48 +1410,34 @@ subroutine diabatic_aux_end(CS) end subroutine diabatic_aux_end -!> \namespace MOM_diabatic_aux +!> \namespace mom_diabatic_aux !! -!! This module contains the subroutines that, along with the * -!! subroutines that it calls, implements diapycnal mass and momentum * -!! fluxes and a bulk mixed layer. The diapycnal diffusion can be * -!! used without the bulk mixed layer. * -!! * -!! diabatic first determines the (diffusive) diapycnal mass fluxes * -!! based on the convergence of the buoyancy fluxes within each layer. * -!! The dual-stream entrainment scheme of MacDougall and Dewar (JPO, * -!! 1997) is used for combined diapycnal advection and diffusion, * -!! calculated implicitly and potentially with the Richardson number * -!! dependent mixing, as described by Hallberg (MWR, 2000). Diapycnal * -!! advection is fundamentally the residual of diapycnal diffusion, * -!! so the fully implicit upwind differencing scheme that is used is * -!! entirely appropriate. The downward buoyancy flux in each layer * -!! is determined from an implicit calculation based on the previously * -!! calculated flux of the layer above and an estimated flux in the * -!! layer below. This flux is subject to the following conditions: * -!! (1) the flux in the top and bottom layers are set by the boundary * -!! conditions, and (2) no layer may be driven below an Angstrom thick-* -!! ness. If there is a bulk mixed layer, the buffer layer is treat- * -!! ed as a fixed density layer with vanishingly small diffusivity. * -!! * -!! diabatic takes 5 arguments: the two velocities (u and v), the * -!! thicknesses (h), a structure containing the forcing fields, and * -!! the length of time over which to act (dt). The velocities and * -!! thickness are taken as inputs and modified within the subroutine. * -!! There is no limit on the time step. * -!! * -!! A small fragment of the grid is shown below: * -!! * -!! j+1 x ^ x ^ x At x: q * -!! j+1 > o > o > At ^: v * -!! j x ^ x ^ x At >: u * -!! j > o > o > At o: h, T, S, buoy, ustar, ea, eb, etc. * -!! j-1 x ^ x ^ x * -!! i-1 i i+1 At x & ^: * -!! i i+1 At > & o: * -!! * -!! The boundaries always run through q grid points (x). * -!! * -!!********+*********+*********+*********+*********+*********+*********+** +!! This module contains the subroutines that, along with the +!! subroutines that it calls, implements diapycnal mass and momentum +!! fluxes and a bulk mixed layer. The diapycnal diffusion can be +!! used without the bulk mixed layer. +!! +!! diabatic first determines the (diffusive) diapycnal mass fluxes +!! based on the convergence of the buoyancy fluxes within each layer. +!! The dual-stream entrainment scheme of MacDougall and Dewar (JPO, +!! 1997) is used for combined diapycnal advection and diffusion, +!! calculated implicitly and potentially with the Richardson number +!! dependent mixing, as described by Hallberg (MWR, 2000). Diapycnal +!! advection is fundamentally the residual of diapycnal diffusion, +!! so the fully implicit upwind differencing scheme that is used is +!! entirely appropriate. The downward buoyancy flux in each layer +!! is determined from an implicit calculation based on the previously +!! calculated flux of the layer above and an estimated flux in the +!! layer below. This flux is subject to the following conditions: +!! (1) the flux in the top and bottom layers are set by the boundary +!! conditions, and (2) no layer may be driven below an Angstrom thick- +!! ness. If there is a bulk mixed layer, the buffer layer is treat- +!! ed as a fixed density layer with vanishingly small diffusivity. +!! +!! diabatic takes 5 arguments: the two velocities (u and v), the +!! thicknesses (h), a structure containing the forcing fields, and +!! the length of time over which to act (dt). The velocities and +!! thickness are taken as inputs and modified within the subroutine. +!! There is no limit on the time step. end module MOM_diabatic_aux diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index ef0ecdc2ea..b3ddad75fd 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -1,14 +1,9 @@ +!> Calculates the energy requirements of mixing. module MOM_diapyc_energy_req ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, May 2015 * -!* * -!* This module calculates the energy requirements of mixing. * -!* * -!********+*********+*********+*********+*********+*********+*********+** +!! \author By Robert Hallberg, May 2015 use MOM_diag_mediator, only : diag_ctrl, Time_type, post_data_1d_k, register_diag_field use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 5e46742a6b..3074faa243 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -1,52 +1,8 @@ +!> Energetically consistent planetary boundary layer parameterization module MOM_energetic_PBL ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, 2015. * -!* * -!* This file contains the subroutine (energetic_PBL) that uses an * -!* integrated boundary layer energy budget (like a bulk- or refined- * -!* bulk mixed layer scheme), but instead of homogenizing this model * -!* calculates a finite diffusivity and viscosity, which in this * -!* regard is conceptually similar to what is done with KPP or various * -!* two-equation closures. However, the scheme that is implemented * -!* here has the big advantage that is entirely implicit, but is * -!* simple enough that it requires only a single vertical pass to * -!* determine the diffusivity. The development of bulk mixed layer * -!* models stems from the work of various people, as described in the * -!* review paper by Niiler and Kraus (1979). The work here draws in * -!* with particular on the form for TKE decay proposed by Oberhuber * -!* (JPO, 1993, 808-829), with an extension to a refined bulk mixed * -!* layer as described in Hallberg (Aha Huliko'a, 2003). The physical * -!* processes portrayed in this subroutine include convectively driven * -!* mixing and mechanically driven mixing. Unlike boundary-layer * -!* mixing, stratified shear mixing is not a one-directional turbulent * -!* process, and it is dealt with elsewhere in the MOM6 code within * -!* the module MOM_kappa_shear.F90. It is assumed that the heat, * -!* mass, and salt fluxes have been applied elsewhere, but that their * -!* implications for the integrated TKE budget have been captured in * -!* an array that is provided as an argument to this subroutine. This * -!* is a full 3-d array due to the effects of penetrating shortwave * -!* radiation. * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, T, S, Kd, etc. * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_alloc use MOM_diag_mediator, only : time_type, diag_ctrl @@ -2403,4 +2359,33 @@ subroutine energetic_PBL_end(CS) end subroutine energetic_PBL_end +!> \namespace MOM_energetic_PBL +!! +!! By Robert Hallberg, 2015. +!! +!! This file contains the subroutine (energetic_PBL) that uses an +!! integrated boundary layer energy budget (like a bulk- or refined- +!! bulk mixed layer scheme), but instead of homogenizing this model +!! calculates a finite diffusivity and viscosity, which in this +!! regard is conceptually similar to what is done with KPP or various +!! two-equation closures. However, the scheme that is implemented +!! here has the big advantage that is entirely implicit, but is +!! simple enough that it requires only a single vertical pass to +!! determine the diffusivity. The development of bulk mixed layer +!! models stems from the work of various people, as described in the +!! review paper by Niiler and Kraus (1979). The work here draws in +!! with particular on the form for TKE decay proposed by Oberhuber +!! (JPO, 1993, 808-829), with an extension to a refined bulk mixed +!! layer as described in Hallberg (Aha Huliko'a, 2003). The physical +!! processes portrayed in this subroutine include convectively driven +!! mixing and mechanically driven mixing. Unlike boundary-layer +!! mixing, stratified shear mixing is not a one-directional turbulent +!! process, and it is dealt with elsewhere in the MOM6 code within +!! the module MOM_kappa_shear.F90. It is assumed that the heat, +!! mass, and salt fluxes have been applied elsewhere, but that their +!! implications for the integrated TKE budget have been captured in +!! an array that is provided as an argument to this subroutine. This +!! is a full 3-d array due to the effects of penetrating shortwave +!! radiation. + end module MOM_energetic_PBL diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index df7afe2e57..03d01ba201 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -1,55 +1,8 @@ +!> Diapycnal mixing and advection in isopycnal mode module MOM_entrain_diffusive ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, September 1997 - July 2000 * -!* * -!* This file contains the subroutines that implement diapycnal * -!* mixing and advection in isopycnal layers. The main subroutine, * -!* calculate_entrainment, returns the entrainment by each layer * -!* across the interfaces above and below it. These are calculated * -!* subject to the constraints that no layers can be driven to neg- * -!* ative thickness and that the each layer maintains its target * -!* density, using the scheme described in Hallberg (MWR 2000). There * -!* may or may not be a bulk mixed layer above the isopycnal layers. * -!* The solution is iterated until the change in the entrainment * -!* between successive iterations is less than some small tolerance. * -!* * -!* The dual-stream entrainment scheme of MacDougall and Dewar * -!* (JPO 1997) is used for combined diapycnal advection and diffusion, * -!* modified as described in Hallberg (MWR 2000) to be solved * -!* implicitly in time. Any profile of diffusivities may be used. * -!* Diapycnal advection is fundamentally the residual of diapycnal * -!* diffusion, so the fully implicit upwind differencing scheme that * -!* is used is entirely appropriate. The downward buoyancy flux in * -!* each layer is determined from an implicit calculation based on * -!* the previously calculated flux of the layer above and an estim- * -!* ated flux in the layer below. This flux is subject to the foll- * -!* owing conditions: (1) the flux in the top and bottom layers are * -!* set by the boundary conditions, and (2) no layer may be driven * -!* below an Angstrom thickness. If there is a bulk mixed layer, the * -!* mixed and buffer layers are treated as Eulerian layers, whose * -!* thicknesses only change due to entrainment by the interior layers. * -!* * -!* In addition, the model may adjust the fluxes to drive the layer * -!* densities (sigma 2?) back toward their targer values. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, buoy, T, S, ea, eb, etc. * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl, time_type use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE @@ -2253,4 +2206,35 @@ subroutine entrain_diffusive_end(CS) end subroutine entrain_diffusive_end +!> \namespace mom_entrain_diffusive +!! +!! By Robert Hallberg, September 1997 - July 2000 +!! +!! This file contains the subroutines that implement diapycnal +!! mixing and advection in isopycnal layers. The main subroutine, +!! calculate_entrainment, returns the entrainment by each layer +!! across the interfaces above and below it. These are calculated +!! subject to the constraints that no layers can be driven to neg- +!! ative thickness and that the each layer maintains its target +!! density, using the scheme described in Hallberg (MWR 2000). There +!! may or may not be a bulk mixed layer above the isopycnal layers. +!! The solution is iterated until the change in the entrainment +!! between successive iterations is less than some small tolerance. +!! +!! The dual-stream entrainment scheme of MacDougall and Dewar +!! (JPO 1997) is used for combined diapycnal advection and diffusion, +!! modified as described in Hallberg (MWR 2000) to be solved +!! implicitly in time. Any profile of diffusivities may be used. +!! Diapycnal advection is fundamentally the residual of diapycnal +!! diffusion, so the fully implicit upwind differencing scheme that +!! is used is entirely appropriate. The downward buoyancy flux in +!! each layer is determined from an implicit calculation based on +!! the previously calculated flux of the layer above and an estim- +!! ated flux in the layer below. This flux is subject to the foll- +!! owing conditions: (1) the flux in the top and bottom layers are +!! set by the boundary conditions, and (2) no layer may be driven +!! below an Angstrom thickness. If there is a bulk mixed layer, the +!! mixed and buffer layers are treated as Eulerian layers, whose +!! thicknesses only change due to entrainment by the interior layers. + end module MOM_entrain_diffusive diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index be02fab00b..0b0ee0a3d7 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -1,29 +1,8 @@ +!> Shear-dependent mixing following Jackson et al. 2008. module MOM_kappa_shear ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Laura Jackson and Robert Hallberg, 2006-2008 * -!* * -!* This file contains the subroutines that determine the diapycnal * -!* diffusivity driven by resolved shears, as specified by the * -!* parameterizations described in Jackson and Hallberg (JPO, 2008). * -!* * -!* The technique by which the 6 equations (for kappa, TKE, u, v, T, * -!* and S) are solved simultaneously has been dramatically revised * -!* from the previous version. The previous version was not converging * -!* in some cases, especially near the surface mixed layer, while the * -!* revised version does. The revised version solves for kappa and * -!* TKE with shear and stratification fixed, then marches the density * -!* and velocities forward with an adaptive (and aggressive) time step * -!* in a predictor-corrector-corrector emulation of a trapezoidal * -!* scheme. Run-time-settable parameters determine the tolerence to * -!* which the kappa and TKE equations are solved and the minimum time * -!* step that can be taken. * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr @@ -2162,4 +2141,24 @@ logical function kappa_shear_at_vertex(param_file) end function kappa_shear_at_vertex +!> \namespace mom_kappa_shear +!! +!! By Laura Jackson and Robert Hallberg, 2006-2008 +!! +!! This file contains the subroutines that determine the diapycnal +!! diffusivity driven by resolved shears, as specified by the +!! parameterizations described in Jackson and Hallberg (JPO, 2008). +!! +!! The technique by which the 6 equations (for kappa, TKE, u, v, T, +!! and S) are solved simultaneously has been dramatically revised +!! from the previous version. The previous version was not converging +!! in some cases, especially near the surface mixed layer, while the +!! revised version does. The revised version solves for kappa and +!! TKE with shear and stratification fixed, then marches the density +!! and velocities forward with an adaptive (and aggressive) time step +!! in a predictor-corrector-corrector emulation of a trapezoidal +!! scheme. Run-time-settable parameters determine the tolerence to +!! which the kappa and TKE equations are solved and the minimum time +!! step that can be taken. + end module MOM_kappa_shear diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 8651f983a9..26a23a0f0d 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -1,40 +1,8 @@ +!> Routines used to calculate the opacity of the ocean. module MOM_opacity ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* This module contains the routines used to calculate the opacity * -!* of the ocean. * -!* * -!* CHL_from_file: * -!* In this routine, the Morel (modified) and Manizza (modified) * -!* schemes use the "blue" band in the paramterizations to determine * -!* the e-folding depth of the incoming shortwave attenuation. The red * -!* portion is lumped into the net heating at the surface. * -!* * -!* Morel, A., 1988: Optical modeling of the upper ocean in relation * -!* to itsbiogenous matter content (case-i waters)., J. Geo. Res., * -!* 93, 10,749-10,768. * -!* * -!* Manizza, M., C. LeQuere, A. J. Watson, and E. T. Buitenhuis, 2005: * -!* Bio-optical feedbacks amoung phytoplankton, upper ocean physics * -!* and sea-ice in a global model, Geophys. Res. Let., 32, L05603, * -!* doi:10.1029/2004GL020778. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, buoy, Rml, eaml, ebml, etc. * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** use MOM_diag_mediator, only : time_type, diag_ctrl, safe_alloc_ptr, post_data use MOM_diag_mediator, only : query_averaging_enabled, register_diag_field use MOM_time_manager, only : get_time @@ -693,4 +661,21 @@ subroutine opacity_end(CS, optics) end subroutine opacity_end +!> \namespace mom_opacity +!! +!! CHL_from_file: +!! In this routine, the Morel (modified) and Manizza (modified) +!! schemes use the "blue" band in the paramterizations to determine +!! the e-folding depth of the incoming shortwave attenuation. The red +!! portion is lumped into the net heating at the surface. +!! +!! Morel, A., 1988: Optical modeling of the upper ocean in relation +!! to itsbiogenous matter content (case-i waters)., J. Geo. Res., +!! 93, 10,749-10,768. +!! +!! Manizza, M., C. LeQuere, A. J. Watson, and E. T. Buitenhuis, 2005: +!! Bio-optical feedbacks amoung phytoplankton, upper ocean physics +!! and sea-ice in a global model, Geophys. Res. Let., 32, L05603, +!! doi:10.1029/2004GL020778. + end module MOM_opacity diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 8ca682c6b9..1b9b1ff6ef 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -1,36 +1,8 @@ +!> Provides regularization of layers in isopycnal mode module MOM_regularize_layers ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg and Alistair Adcroft, 2011. * -!* * -!* This file contains the code to do vertical remapping of mass, * -!* temperature and salinity in MOM. Other tracers and the horizontal * -!* velocity components will be remapped outside of this subroutine * -!* using the values that are stored in ea and eb. * -!* The code that is here now only applies in very limited cases * -!* where the mixed- and buffer-layer structures are problematic, but * -!* future additions will include the ability to emulate arbitrary * -!* vertical coordinates. * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, T, S, ea, eb, etc. * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : time_type, diag_ctrl @@ -93,7 +65,10 @@ module MOM_regularize_layers #endif end type regularize_layers_CS +!>@{ Clock IDs +!! \todo Should these be global? integer :: id_clock_pass, id_clock_EOS +!!@} contains @@ -120,26 +95,7 @@ subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, CS) !! m or kg m-2 (i.e., H). type(regularize_layers_CS), pointer :: CS !< The control structure returned by a previous !! call to regularize_layers_init. - -! This subroutine partially steps the bulk mixed layer model. -! The following processes are executed, in the order listed. - -! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out) -! The units of h are referred to as H below. -! (in/out) tv - A structure containing pointers to any available -! thermodynamic fields. Absent fields have NULL ptrs. -! (in) dt - Time increment, in s. -! (in/out) ea - The amount of fluid moved downward into a layer; this should -! be increased due to mixed layer detrainment, in the same units -! as h - usually m or kg m-2 (i.e., H). -! (in/out) eb - The amount of fluid moved upward into a layer; this should -! be increased due to mixed layer entrainment, in the same units -! as h - usually m or kg m-2 (i.e., H). -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! regularize_layers_init. - + ! Local variables integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -179,26 +135,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) !! m or kg m-2 (i.e., H). type(regularize_layers_CS), pointer :: CS !< The control structure returned by a previous !! call to regularize_layers_init. - -! This subroutine ensures that there is a degree of horizontal smoothness -! in the depths of the near-surface interfaces. - -! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out) -! The units of h are referred to as H below. -! (in/out) tv - A structure containing pointers to any available -! thermodynamic fields. Absent fields have NULL ptrs. -! (in) dt - Time increment, in s. -! (in/out) ea - The amount of fluid moved downward into a layer; this should -! be increased due to mixed layer detrainment, in the same units -! as h - usually m or kg m-2 (i.e., H). -! (in/out) eb - The amount of fluid moved upward into a layer; this should -! be increased due to mixed layer entrainment, in the same units -! as h - usually m or kg m-2 (i.e., H). -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! regularize_layers_init. - + ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & def_rat_u ! The ratio of the thickness deficit to the minimum depth, ND. real, dimension(SZI_(G),SZJB_(G)) :: & @@ -813,25 +750,7 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & !! m-2); if h is not present, vertical !! differences in interface heights are used !! instead. - -! This subroutine determines the amount by which the harmonic mean -! thickness at velocity points differ from the arithmetic means, relative to -! the the arithmetic means, after eliminating thickness variations that are -! solely due to topography and aggregating all interior layers into one. - -! Arguments: e - Interface depths, in m or kg m-2. -! (out) def_rat_u - The thickness deficit ratio at u points, nondim. -! (out) def_rat_v - The thickness deficit ratio at v points, nondim. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! regularize_layers_init. -! (out,opt) def_rat_u_2lay - The thickness deficit ratio at u points when the -! mixed and buffer layers are aggregated into 1 layer, nondim. -! (out,opt) def_rat_v_2lay - The thickness deficit ratio at v pointswhen the -! mixed and buffer layers are aggregated into 1 layer, nondim. -! (in,opt) halo - An extra-wide halo size, 0 by default. -! (in,opt) h - The layer thicknesse; if not present take vertical differences of e. + ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & h_def_u, & ! The vertically summed thickness deficits at u-points, in H. h_norm_u, & ! The vertically summed arithmetic mean thickness by which @@ -956,6 +875,7 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & end subroutine find_deficit_ratios +!> Initializes the regularize_layers control structure subroutine regularize_layers_init(Time, G, param_file, diag, CS) type(time_type), target, intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -965,14 +885,6 @@ subroutine regularize_layers_init(Time, G, param_file, diag, CS) !! diagnostic output. type(regularize_layers_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module. -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module -! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_regularize_layers" ! This module's name. logical :: use_temperature diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 68bdf75064..8d3206303c 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1,3 +1,4 @@ +!> Calculate vertical diffusivity from all mixing processes module MOM_set_diffusivity ! This file is part of MOM6. See LICENSE.md for the license. @@ -36,7 +37,6 @@ module MOM_set_diffusivity use user_change_diffusivity, only : user_change_diff, user_change_diff_init use user_change_diffusivity, only : user_change_diff_end, user_change_diff_CS - implicit none ; private #include @@ -187,11 +187,11 @@ module MOM_set_diffusivity contains !> Sets the interior vertical diffusion of scalars due to the following processes: -!! 1) Shear-driven mixing: two options, Jackson et at. and KPP interior; -!! 2) Background mixing via CVMix (Bryan-Lewis profile) or the scheme described by -!! Harrison & Hallberg, JPO 2008; -!! 3) Double-diffusion, old method and new method via CVMix; -!! 4) Tidal mixing: many options available, see MOM_tidal_mixing.F90; +!! 1. Shear-driven mixing: two options, Jackson et at. and KPP interior; +!! 2. Background mixing via CVMix (Bryan-Lewis profile) or the scheme described by +!! Harrison & Hallberg, JPO 2008; +!! 3. Double-diffusion, old method and new method via CVMix; +!! 4. Tidal mixing: many options available, see MOM_tidal_mixing.F90; !! In addition, this subroutine has the option to set the interior vertical !! viscosity associated with processes 1,2 and 4 listed above, which is stored in !! visc%Kv_slow. Vertical viscosity due to shear-driven mixing is passed via @@ -657,6 +657,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & end subroutine set_diffusivity +!> Convert turbulent kinetic energy to diffusivity subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & TKE_to_Kd, maxTKE, kb) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -681,7 +682,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & !! to its maximum realizable thickness, in m3 s-3 integer, dimension(SZI_(G)), intent(out) :: kb !< Index of lightest layer denser than the buffer !! layer, or -1 without a bulk mixed layer. - + ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & ds_dsp1, & ! coordinate variable (sigma-2) difference across an ! interface divided by the difference across the interface @@ -859,6 +860,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & end subroutine find_TKE_to_Kd +!> Calculate Brunt-Vaisala frequency, N^2. subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & N2_lay, N2_int, N2_bot) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -884,7 +886,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & real, dimension(SZI_(G),SZK_(G)), & intent(out) :: N2_lay !< The squared buoyancy frequency of the layers, in s-2. real, dimension(SZI_(G)), intent(out) :: N2_bot !< The near-bottom squared buoyancy frequency, in s-2. - + ! Local variables real, dimension(SZI_(G),SZK_(G)+1) :: & dRho_int_unfilt, & ! unfiltered density differences across interfaces dRho_dT, & ! partial derivative of density wrt temp (kg m-3 degC-1) diff --git a/src/parameterizations/vertical/MOM_shortwave_abs.F90 b/src/parameterizations/vertical/MOM_shortwave_abs.F90 index 4d07a66dfb..1cf23e9c3e 100644 --- a/src/parameterizations/vertical/MOM_shortwave_abs.F90 +++ b/src/parameterizations/vertical/MOM_shortwave_abs.F90 @@ -1,3 +1,4 @@ +!> Absorption of downwelling shortwave radiation module MOM_shortwave_abs ! This file is part of MOM6. See LICENSE.md for the license. @@ -35,8 +36,10 @@ module MOM_shortwave_abs contains !> Apply shortwave heating below the boundary layer (when running with the bulk mixed layer inhereted -!! from GOLD) or throughout the water column. In addition, it causes all of the remaining SW radiation -!! to be absorbed, provided that the total water column thickness is greater than H_limit_fluxes. +!! from GOLD) or throughout the water column. +!! +!! In addition, it causes all of the remaining SW radiation to be absorbed, provided that the total +!! water column thickness is greater than H_limit_fluxes. !! For thinner water columns, the heating is scaled down proportionately, the assumption being that the !! remaining heating (which is left in Pen_SW) should go into an (absent for now) ocean bottom sediment layer. subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, & @@ -90,7 +93,6 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, !! volume with temperature, in m3 kg-1 K-1. real, dimension(SZI_(G),SZK_(G)), optional, intent(inout) :: TKE !< The TKE sink from mixing the heating !! throughout a layer, in J m-2. - ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & T_chg_above ! A temperature change that will be applied to all the thick @@ -322,22 +324,7 @@ subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & real, dimension(SZI_(G),SZK_(G)+1), & intent(inout) :: netPen !< Net penetrating shortwave heat flux at each !! interface, summed across all bands, in K H. - -! Arguments: -! (in) G = ocean grid structure -! (in) GV = The ocean's vertical grid structure. -! (in) h = layer thickness (units of m or kg/m^2) -! units of h are referred to as H below. -! (in) opacity_band = opacity in each band of penetrating shortwave -! radiation, in m-1. The indicies are band, i, k. -! (in) nsw = number of bands of penetrating shortwave radiation -! (in) j = j-index to work on -! (in) dt = time step (seconds) -! (inout) Pen_SW_bnd = penetrating shortwave heating in each band that -! hits the bottom and will be redistributed through -! the water column (K H units); size nsw x SZI_(G). -! (out) netPen = attenuated flux at interfaces, summed over bands (K H units) - + ! Local variables real :: h_heat(SZI_(G)) ! thickness of the water column that receives ! remaining shortwave radiation, in H. real :: Pen_SW_rem(SZI_(G)) ! sum across all wavelength bands of the diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index 4706db9a3c..d4c5e69ed5 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -1,59 +1,8 @@ +!> Implements sponge regions in isopycnal mode module MOM_sponge ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, March 1999-June 2000 * -!* * -!* This program contains the subroutines that implement sponge * -!* regions, in which the stratification and water mass properties * -!* are damped toward some profiles. There are three externally * -!* callable subroutines in this file. * -!* * -!* initialize_sponge determines the mapping from the model * -!* variables into the arrays of damped columns. This remapping is * -!* done for efficiency and to conserve memory. Only columns which * -!* have positive inverse damping times and which are deeper than a * -!* supplied depth are placed in sponges. The inverse damping * -!* time is also stored in this subroutine, and memory is allocated * -!* for all of the reference profiles which will subsequently be * -!* provided through calls to set_up_sponge_field. The first two * -!* arguments are a two-dimensional array containing the damping * -!* rates, and the interface heights to damp towards. * -!* * -!* set_up_sponge_field is called to provide a reference profile * -!* and the location of the field that will be damped back toward * -!* that reference profile. A third argument, the number of layers * -!* in the field is also provided, but this should always be nz. * -!* * -!* Apply_sponge damps all of the fields that have been registered * -!* with set_up_sponge_field toward their reference profiles. The * -!* four arguments are the thickness to be damped, the amount of time * -!* over which the damping occurs, and arrays to which the movement * -!* of fluid into a layer from above and below will be added. The * -!* effect on momentum of the sponge may be accounted for later using * -!* the movement of water recorded in these later arrays. * -!* * -!* All of the variables operated upon in this file are defined at * -!* the thickness points. * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, T, S, Iresttime, ea, eb * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_coms, only : sum_across_PEs use MOM_diag_mediator, only : post_data, query_averaging_enabled, register_diag_field use MOM_diag_mediator, only : diag_ctrl @@ -671,4 +620,37 @@ subroutine sponge_end(CS) end subroutine sponge_end +!> \namespace mom_sponge +!! +!! By Robert Hallberg, March 1999-June 2000 +!! +!! This program contains the subroutines that implement sponge +!! regions, in which the stratification and water mass properties +!! are damped toward some profiles. There are three externally +!! callable subroutines in this file. +!! +!! initialize_sponge determines the mapping from the model +!! variables into the arrays of damped columns. This remapping is +!! done for efficiency and to conserve memory. Only columns which +!! have positive inverse damping times and which are deeper than a +!! supplied depth are placed in sponges. The inverse damping +!! time is also stored in this subroutine, and memory is allocated +!! for all of the reference profiles which will subsequently be +!! provided through calls to set_up_sponge_field. The first two +!! arguments are a two-dimensional array containing the damping +!! rates, and the interface heights to damp towards. +!! +!! set_up_sponge_field is called to provide a reference profile +!! and the location of the field that will be damped back toward +!! that reference profile. A third argument, the number of layers +!! in the field is also provided, but this should always be nz. +!! +!! Apply_sponge damps all of the fields that have been registered +!! with set_up_sponge_field toward their reference profiles. The +!! four arguments are the thickness to be damped, the amount of time +!! over which the damping occurs, and arrays to which the movement +!! of fluid into a layer from above and below will be added. The +!! effect on momentum of the sponge may be accounted for later using +!! the movement of water recorded in these later arrays. + end module MOM_sponge diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 3b30e2ee31..474a71d683 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -1,3 +1,4 @@ +!> Initialization of the 2D DOME experiment with density water initialized on a coastal shelf. module DOME2d_initialization ! This file is part of MOM6. See LICENSE.md for the license. diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 1963a067cc..e4e35d77e5 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -1,3 +1,5 @@ +!> Configures the model for the "DOME" experiment. +!! DOME = Dynamics of Overflows and Mixing Experiment module DOME_initialization ! This file is part of MOM6. See LICENSE.md for the license. @@ -375,8 +377,4 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg) end subroutine DOME_set_OBC_data -!> \namespace dome_initialization -!! -!! The module configures the model for the "DOME" experiment. -!! DOME = Dynamics of Overflows and Mixing Experiment end module DOME_initialization diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index b2c6f651cd..eeda2e267f 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -1,3 +1,8 @@ +!> Configures the model for the Kelvin wave experiment. +!! +!! Kelvin = coastally-trapped Kelvin waves from the ROMS examples. +!! Initialize with level surfaces and drive the wave in at the west, +!! radiate out at the east. module Kelvin_initialization ! This file is part of MOM6. See LICENSE.md for the license. @@ -312,10 +317,4 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) end subroutine Kelvin_set_OBC_data -!> \class Kelvin_Initialization -!! -!! The module configures the model for the Kelvin wave experiment. -!! Kelvin = coastally-trapped Kelvin waves from the ROMS examples. -!! Initialize with level surfaces and drive the wave in at the west, -!! radiate out at the east. end module Kelvin_initialization diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index 51c8ab7683..0aa80f3c2e 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -1,3 +1,4 @@ +!> Initialization for the "Neverland" configuration module Neverland_initialization ! This file is part of MOM6. See LICENSE.md for the license. @@ -22,7 +23,6 @@ module Neverland_initialization contains -! ----------------------------------------------------------------------------- !> This subroutine sets up the Neverland test case topography. subroutine Neverland_initialize_topography(D, G, param_file, max_depth) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type @@ -30,8 +30,7 @@ subroutine Neverland_initialize_topography(D, G, param_file, max_depth) intent(out) :: D !< Ocean bottom depth in m type(param_file_type), intent(in) :: param_file !< Parameter file structure real, intent(in) :: max_depth !< Maximum depth of model in m - -! This subroutine sets up the Neverland test case topography + ! Local variables real :: PI ! 3.1415926... calculated as 4*atan(1) real :: D0 ! A constant to make the maximum ! ! basin depth MAXIMUM_DEPTH. ! @@ -79,29 +78,26 @@ end subroutine Neverland_initialize_topography ! ----------------------------------------------------------------------------- !> Returns the value of a cosine-bell function evaluated at x/L - real function cosbell(x,L) - - real , intent(in) :: x !< non-dimensional position - real , intent(in) :: L !< non-dimensional width - real :: PI !< 3.1415926... calculated as 4*atan(1) +real function cosbell(x,L) + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI !< 3.1415926... calculated as 4*atan(1) - PI = 4.0*atan(1.0) - cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) - end function cosbell + PI = 4.0*atan(1.0) + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) +end function cosbell !> Returns the value of a sin-spike function evaluated at x/L - real function spike(x,L) +real function spike(x,L) - real , intent(in) :: x !< non-dimensional position - real , intent(in) :: L !< non-dimensional width - real :: PI !< 3.1415926... calculated as 4*atan(1) + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI !< 3.1415926... calculated as 4*atan(1) - PI = 4.0*atan(1.0) - spike = (1 - sin(PI*MIN(ABS(x/L),0.5))) - end function spike + PI = 4.0*atan(1.0) + spike = (1 - sin(PI*MIN(ABS(x/L),0.5))) +end function spike - -! ----------------------------------------------------------------------------- !> This subroutine initializes layer thicknesses for the Neverland test case, !! by finding the depths of interfaces in a specified latitude-dependent !! temperature profile with an exponentially decaying thermocline on top of a @@ -148,9 +144,5 @@ subroutine Neverland_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ enddo ; enddo end subroutine Neverland_initialize_thickness -! ----------------------------------------------------------------------------- -!! \class Neverland_initialization -!! -!! The module configures the model for the Neverland experiment. end module Neverland_initialization diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 83740a1d61..5267b5585b 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -1,3 +1,4 @@ +!> Initialization for the "Phillips" channel configuration module Phillips_initialization ! This file is part of MOM6. See LICENSE.md for the license. @@ -323,49 +324,36 @@ end subroutine Phillips_initialize_topography !> \namespace phillips_initialization !! -!! By Robert Hallberg, April 1994 - June 2002 * -!! * -!! This subroutine initializes the fields for the simulations. * -!! The one argument passed to initialize, Time, is set to the * -!! current time of the simulation. The fields which are initialized * -!! here are: * -!! u - Zonal velocity in m s-1. * -!! v - Meridional velocity in m s-1. * -!! h - Layer thickness in m. (Must be positive.) * -!! D - Basin depth in m. (Must be positive.) * -!! f - The Coriolis parameter, in s-1. * -!! g - The reduced gravity at each interface, in m s-2. * -!! Rlay - Layer potential density (coordinate variable) in kg m-3. * -!! If ENABLE_THERMODYNAMICS is defined: * -!! T - Temperature in C. * -!! S - Salinity in psu. * -!! If SPONGE is defined: * -!! A series of subroutine calls are made to set up the damping * -!! rates and reference profiles for all variables that are damped * -!! in the sponge. * -!! Any user provided tracer code is also first linked through this * -!! subroutine. * -!! * -!! Forcing-related fields (taux, tauy, buoy, ustar, etc.) are set * -!! in MOM_surface_forcing.F90. * -!! * -!! These variables are all set in the set of subroutines (in this * -!! file) Phillips_initialize_thickness, Phillips_initialize_velocity, * -!! Phillips_initialize_topography and Phillips_initialize_sponges * -!! that seet up fields that are specific to the Phillips instability * -!! test case. * -!! * -!! Macros written all in capital letters are defined in MOM_memory.h. * -!! * -!! A small fragment of the grid is shown below: * -!! * -!! j+1 x ^ x ^ x At x: q, f * -!! j+1 > o > o > At ^: v, tauy * -!! j x ^ x ^ x At >: u, taux * -!! j > o > o > At o: h, D, buoy, tr, T, S, ustar * -!! j-1 x ^ x ^ x * -!! i-1 i i+1 At x & ^: * -!! i i+1 At > & o: * -!! * -!! The boundaries always run through q grid points (x). * +!! By Robert Hallberg, April 1994 - June 2002 +!! +!! This subroutine initializes the fields for the simulations. +!! The one argument passed to initialize, Time, is set to the +!! current time of the simulation. The fields which are initialized +!! here are: +!! u - Zonal velocity in m s-1. +!! v - Meridional velocity in m s-1. +!! h - Layer thickness in m. (Must be positive.) +!! D - Basin depth in m. (Must be positive.) +!! f - The Coriolis parameter, in s-1. +!! g - The reduced gravity at each interface, in m s-2. +!! Rlay - Layer potential density (coordinate variable) in kg m-3. +!! If ENABLE_THERMODYNAMICS is defined: +!! T - Temperature in C. +!! S - Salinity in psu. +!! If SPONGE is defined: +!! A series of subroutine calls are made to set up the damping +!! rates and reference profiles for all variables that are damped +!! in the sponge. +!! Any user provided tracer code is also first linked through this +!! subroutine. +!! +!! Forcing-related fields (taux, tauy, buoy, ustar, etc.) are set +!! in MOM_surface_forcing.F90. +!! +!! These variables are all set in the set of subroutines (in this +!! file) Phillips_initialize_thickness, Phillips_initialize_velocity, +!! Phillips_initialize_topography and Phillips_initialize_sponges +!! that seet up fields that are specific to the Phillips instability +!! test case. + end module Phillips_initialization diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index 8d0506eede..b681843002 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -1,3 +1,4 @@ +!> Initialization for the "bench mark" configuration module benchmark_initialization ! This file is part of MOM6. See LICENSE.md for the license. @@ -23,7 +24,6 @@ module benchmark_initialization contains -! ----------------------------------------------------------------------------- !> This subroutine sets up the benchmark test case topography. subroutine benchmark_initialize_topography(D, G, param_file, max_depth) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type @@ -31,8 +31,7 @@ subroutine benchmark_initialize_topography(D, G, param_file, max_depth) intent(out) :: D !< Ocean bottom depth in m type(param_file_type), intent(in) :: param_file !< Parameter file structure real, intent(in) :: max_depth !< Maximum depth of model in m - -! This subroutine sets up the benchmark test case topography + ! Local variables real :: min_depth ! The minimum and maximum depths in m. real :: PI ! 3.1415926... calculated as 4*atan(1) real :: D0 ! A constant to make the maximum ! @@ -67,10 +66,8 @@ subroutine benchmark_initialize_topography(D, G, param_file, max_depth) enddo ; enddo end subroutine benchmark_initialize_topography -! ----------------------------------------------------------------------------- -! ----------------------------------------------------------------------------- -!> This subroutine initializes layer thicknesses for the benchmark test case, +!> Initializes layer thicknesses for the benchmark test case, !! by finding the depths of interfaces in a specified latitude-dependent !! temperature profile with an exponentially decaying thermocline on top of a !! linear stratification. @@ -88,7 +85,7 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & !! reference pressure in Pa. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - + ! Local variables real :: e0(SZK_(GV)+1) ! The resting interface heights, in m, usually ! ! negative because it is positive upward. ! real :: e_pert(SZK_(GV)+1) ! Interface height perturbations, positive ! @@ -193,11 +190,8 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & enddo ; enddo end subroutine benchmark_initialize_thickness -! ----------------------------------------------------------------------------- -! ----------------------------------------------------------------------------- -!> This function puts the initial layer temperatures and salinities -!! into T(:,:,:) and S(:,:,:). +!> Initializes layer temperatures and salinities for benchmark subroutine benchmark_init_temperature_salinity(T, S, G, GV, param_file, & eqn_of_state, P_Ref, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -215,7 +209,7 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, param_file, & !! reference pressure in Pa. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - + ! Local variables real :: T0(SZK_(G)), S0(SZK_(G)) real :: pres(SZK_(G)) ! Reference pressure in kg m-3. ! real :: drho_dT(SZK_(G)) ! Derivative of density with temperature in ! @@ -274,9 +268,5 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, param_file, & enddo ; enddo end subroutine benchmark_init_temperature_salinity -! ----------------------------------------------------------------------------- -!! \namespace benchmark_initialization -!! -!! The module configures the model for the benchmark experiment. end module benchmark_initialization diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index db24fb8afb..fd90e006ad 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -1,3 +1,5 @@ +!> Configures the model for the "circle_obcs" experiment which tests +!! Open Boundary Conditions radiating an SSH anomaly. module circle_obcs_initialization ! This file is part of MOM6. See LICENSE.md for the license. @@ -103,8 +105,4 @@ subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_para end subroutine circle_obcs_initialize_thickness -!> \namespace circle_obcs_initialization -!! -!! The module configures the model for the "circle_obcs" experiment. -!! circle_obcs = Test of Open Boundary Conditions for an SSH anomaly. end module circle_obcs_initialization diff --git a/src/user/external_gwave_initialization.F90 b/src/user/external_gwave_initialization.F90 index e54d3e488e..0882eb510f 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -1,3 +1,4 @@ +!> Initialization for the "external gravity wave wave" configuration module external_gwave_initialization ! This file is part of MOM6. See LICENSE.md for the license. @@ -17,7 +18,6 @@ module external_gwave_initialization contains -! ----------------------------------------------------------------------------- !> This subroutine initializes layer thicknesses for the external_gwave experiment. subroutine external_gwave_initialize_thickness(h, G, GV, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -28,13 +28,13 @@ subroutine external_gwave_initialize_thickness(h, G, GV, param_file, just_read_p !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - - real :: e0(SZK_(G)) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: e_pert(SZK_(G)) ! Interface height perturbations, positive ! - ! upward, in m. ! - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! + ! Local variables + real :: e0(SZK_(G)) ! The resting interface heights, in m, usually + ! negative because it is positive upward. + real :: e_pert(SZK_(G)) ! Interface height perturbations, positive + ! upward, in m. + real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface + ! positive upward, in m. real :: ssh_anomaly_height ! Vertical height of ssh anomaly real :: ssh_anomaly_width ! Lateral width of anomaly logical :: just_read ! If true, just read parameters but set nothing. @@ -77,10 +77,5 @@ subroutine external_gwave_initialize_thickness(h, G, GV, param_file, just_read_p enddo ; enddo end subroutine external_gwave_initialize_thickness -! ----------------------------------------------------------------------------- -!> \namespace external_gwave_initialization -!! -!! The module configures the model for the "external_gwave" experiment. -!! external_gwave = External Gravity Wave end module external_gwave_initialization diff --git a/src/user/lock_exchange_initialization.F90 b/src/user/lock_exchange_initialization.F90 index e897db7c7a..c3e06391cb 100644 --- a/src/user/lock_exchange_initialization.F90 +++ b/src/user/lock_exchange_initialization.F90 @@ -1,3 +1,5 @@ +!> Initialization of the "lock exchange" experiment. +!! lock_exchange = A 2-d density driven hydraulic exchange flow. module lock_exchange_initialization ! This file is part of MOM6. See LICENSE.md for the license. @@ -90,8 +92,4 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, param_file, just_read_pa end subroutine lock_exchange_initialize_thickness ! ----------------------------------------------------------------------------- -!> \namespace lock_exchange_initialization -!! -!! The module configures the model for the "lock_exchange" experiment. -!! lock_exchange = A 2-d density driven hydraulic exchange flow. end module lock_exchange_initialization diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 0b54325e1b..131f73ea3e 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -1,3 +1,4 @@ +!> Configures the model for the idealized seamount test case. module seamount_initialization ! This file is part of MOM6. See LICENSE.md for the license. @@ -273,8 +274,4 @@ subroutine seamount_initialize_temperature_salinity ( T, S, h, G, GV, param_file end subroutine seamount_initialize_temperature_salinity -!> \namespace seamount_initialization -!! -!! The module configures the model for the idealized seamount -!! test case. end module seamount_initialization diff --git a/src/user/shelfwave_initialization.F90 b/src/user/shelfwave_initialization.F90 index e8c2f0ee47..1640c9ec5a 100644 --- a/src/user/shelfwave_initialization.F90 +++ b/src/user/shelfwave_initialization.F90 @@ -1,3 +1,4 @@ +!> Configures the model for the idealized shelfwave test case. module shelfwave_initialization ! This file is part of MOM6. See LICENSE.md for the license. @@ -176,8 +177,4 @@ subroutine shelfwave_set_OBC_data(OBC, CS, G, h, Time) end subroutine shelfwave_set_OBC_data -!> \namespace shelfwave_initialization -!! -!! The module configures the model for the idealized shelfwave -!! test case. end module shelfwave_initialization diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index 891641bb13..a81cf181e6 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -1,3 +1,4 @@ +!> Initialization for the "sloshing" internal waves configuration. module sloshing_initialization ! This file is part of MOM6. See LICENSE.md for the license. diff --git a/src/user/supercritical_initialization.F90 b/src/user/supercritical_initialization.F90 index b9a4bef8b2..6b10664d57 100644 --- a/src/user/supercritical_initialization.F90 +++ b/src/user/supercritical_initialization.F90 @@ -1,3 +1,4 @@ +!> The "super critical" configuration module supercritical_initialization ! This file is part of MOM6. See LICENSE.md for the license. diff --git a/src/user/tidal_bay_initialization.F90 b/src/user/tidal_bay_initialization.F90 index 9b61f6987c..7726dbf171 100644 --- a/src/user/tidal_bay_initialization.F90 +++ b/src/user/tidal_bay_initialization.F90 @@ -1,3 +1,5 @@ +!> Configures the model for the "tidal_bay" experiment. +!! tidal_bay = Tidally resonant bay from Zygmunt Kowalik's class on tides. module tidal_bay_initialization ! This file is part of MOM6. See LICENSE.md for the license. @@ -115,8 +117,4 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, h, Time) end subroutine tidal_bay_set_OBC_data -!> \namespace tidal_bay_initialization -!! -!! The module configures the model for the "tidal_bay" experiment. -!! tidal_bay = Tidally resonant bay from Zygmunt Kowalik's class on tides. end module tidal_bay_initialization From 189d7d3f78ae97e3f2c13294ff1c1cd49f649710 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 11 Jul 2018 17:47:45 -0400 Subject: [PATCH 0586/1072] Corrected whitespace in circle_obcs --- src/user/circle_obcs_initialization.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index fd90e006ad..1ff42509c5 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -1,4 +1,4 @@ -!> Configures the model for the "circle_obcs" experiment which tests +!> Configures the model for the "circle_obcs" experiment which tests !! Open Boundary Conditions radiating an SSH anomaly. module circle_obcs_initialization From 1f1c7c8169afdf45f36e1a09a3312a19a28e503a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 11 Jul 2018 18:58:46 -0400 Subject: [PATCH 0587/1072] Module dOxyGenization for EOS code Added dOxygen comments describing the various equation of state modules and the parameters used by these modules. All answers are bitwise identical. --- src/equation_of_state/MOM_EOS_NEMO.F90 | 271 ++++++++++++----------- src/equation_of_state/MOM_EOS_TEOS10.F90 | 3 +- src/equation_of_state/MOM_EOS_UNESCO.F90 | 5 +- src/equation_of_state/MOM_EOS_Wright.F90 | 3 + src/equation_of_state/MOM_TFreeze.F90 | 1 + 5 files changed, 145 insertions(+), 138 deletions(-) diff --git a/src/equation_of_state/MOM_EOS_NEMO.F90 b/src/equation_of_state/MOM_EOS_NEMO.F90 index a95ff0d39c..c925301607 100644 --- a/src/equation_of_state/MOM_EOS_NEMO.F90 +++ b/src/equation_of_state/MOM_EOS_NEMO.F90 @@ -1,3 +1,4 @@ +!> The equation of state using the expressions of Roquet et al. that are used in NEMO module MOM_EOS_NEMO ! This file is part of MOM6. See LICENSE.md for the license. @@ -34,141 +35,141 @@ module MOM_EOS_NEMO module procedure calculate_density_derivs_scalar_nemo, calculate_density_derivs_array_nemo end interface calculate_density_derivs_nemo - real, parameter :: Pa2db = 1.e-4 - real, parameter :: rdeltaS = 32. - real, parameter :: r1_S0 = 0.875/35.16504 - real, parameter :: r1_T0 = 1./40. - real, parameter :: r1_P0 = 1.e-4 - real, parameter :: R00 = 4.6494977072e+01 - real, parameter :: R01 = -5.2099962525 - real, parameter :: R02 = 2.2601900708e-01 - real, parameter :: R03 = 6.4326772569e-02 - real, parameter :: R04 = 1.5616995503e-02 - real, parameter :: R05 = -1.7243708991e-03 - real, parameter :: EOS000 = 8.0189615746e+02 - real, parameter :: EOS100 = 8.6672408165e+02 - real, parameter :: EOS200 = -1.7864682637e+03 - real, parameter :: EOS300 = 2.0375295546e+03 - real, parameter :: EOS400 = -1.2849161071e+03 - real, parameter :: EOS500 = 4.3227585684e+02 - real, parameter :: EOS600 = -6.0579916612e+01 - real, parameter :: EOS010 = 2.6010145068e+01 - real, parameter :: EOS110 = -6.5281885265e+01 - real, parameter :: EOS210 = 8.1770425108e+01 - real, parameter :: EOS310 = -5.6888046321e+01 - real, parameter :: EOS410 = 1.7681814114e+01 - real, parameter :: EOS510 = -1.9193502195 - real, parameter :: EOS020 = -3.7074170417e+01 - real, parameter :: EOS120 = 6.1548258127e+01 - real, parameter :: EOS220 = -6.0362551501e+01 - real, parameter :: EOS320 = 2.9130021253e+01 - real, parameter :: EOS420 = -5.4723692739 - real, parameter :: EOS030 = 2.1661789529e+01 - real, parameter :: EOS130 = -3.3449108469e+01 - real, parameter :: EOS230 = 1.9717078466e+01 - real, parameter :: EOS330 = -3.1742946532 - real, parameter :: EOS040 = -8.3627885467 - real, parameter :: EOS140 = 1.1311538584e+01 - real, parameter :: EOS240 = -5.3563304045 - real, parameter :: EOS050 = 5.4048723791e-01 - real, parameter :: EOS150 = 4.8169980163e-01 - real, parameter :: EOS060 = -1.9083568888e-01 - real, parameter :: EOS001 = 1.9681925209e+01 - real, parameter :: EOS101 = -4.2549998214e+01 - real, parameter :: EOS201 = 5.0774768218e+01 - real, parameter :: EOS301 = -3.0938076334e+01 - real, parameter :: EOS401 = 6.6051753097 - real, parameter :: EOS011 = -1.3336301113e+01 - real, parameter :: EOS111 = -4.4870114575 - real, parameter :: EOS211 = 5.0042598061 - real, parameter :: EOS311 = -6.5399043664e-01 - real, parameter :: EOS021 = 6.7080479603 - real, parameter :: EOS121 = 3.5063081279 - real, parameter :: EOS221 = -1.8795372996 - real, parameter :: EOS031 = -2.4649669534 - real, parameter :: EOS131 = -5.5077101279e-01 - real, parameter :: EOS041 = 5.5927935970e-01 - real, parameter :: EOS002 = 2.0660924175 - real, parameter :: EOS102 = -4.9527603989 - real, parameter :: EOS202 = 2.5019633244 - real, parameter :: EOS012 = 2.0564311499 - real, parameter :: EOS112 = -2.1311365518e-01 - real, parameter :: EOS022 = -1.2419983026 - real, parameter :: EOS003 = -2.3342758797e-02 - real, parameter :: EOS103 = -1.8507636718e-02 - real, parameter :: EOS013 = 3.7969820455e-01 - real, parameter :: ALP000 = -6.5025362670e-01 - real, parameter :: ALP100 = 1.6320471316 - real, parameter :: ALP200 = -2.0442606277 - real, parameter :: ALP300 = 1.4222011580 - real, parameter :: ALP400 = -4.4204535284e-01 - real, parameter :: ALP500 = 4.7983755487e-02 - real, parameter :: ALP010 = 1.8537085209 - real, parameter :: ALP110 = -3.0774129064 - real, parameter :: ALP210 = 3.0181275751 - real, parameter :: ALP310 = -1.4565010626 - real, parameter :: ALP410 = 2.7361846370e-01 - real, parameter :: ALP020 = -1.6246342147 - real, parameter :: ALP120 = 2.5086831352 - real, parameter :: ALP220 = -1.4787808849 - real, parameter :: ALP320 = 2.3807209899e-01 - real, parameter :: ALP030 = 8.3627885467e-01 - real, parameter :: ALP130 = -1.1311538584 - real, parameter :: ALP230 = 5.3563304045e-01 - real, parameter :: ALP040 = -6.7560904739e-02 - real, parameter :: ALP140 = -6.0212475204e-02 - real, parameter :: ALP050 = 2.8625353333e-02 - real, parameter :: ALP001 = 3.3340752782e-01 - real, parameter :: ALP101 = 1.1217528644e-01 - real, parameter :: ALP201 = -1.2510649515e-01 - real, parameter :: ALP301 = 1.6349760916e-02 - real, parameter :: ALP011 = -3.3540239802e-01 - real, parameter :: ALP111 = -1.7531540640e-01 - real, parameter :: ALP211 = 9.3976864981e-02 - real, parameter :: ALP021 = 1.8487252150e-01 - real, parameter :: ALP121 = 4.1307825959e-02 - real, parameter :: ALP031 = -5.5927935970e-02 - real, parameter :: ALP002 = -5.1410778748e-02 - real, parameter :: ALP102 = 5.3278413794e-03 - real, parameter :: ALP012 = 6.2099915132e-02 - real, parameter :: ALP003 = -9.4924551138e-03 - real, parameter :: BET000 = 1.0783203594e+01 - real, parameter :: BET100 = -4.4452095908e+01 - real, parameter :: BET200 = 7.6048755820e+01 - real, parameter :: BET300 = -6.3944280668e+01 - real, parameter :: BET400 = 2.6890441098e+01 - real, parameter :: BET500 = -4.5221697773 - real, parameter :: BET010 = -8.1219372432e-01 - real, parameter :: BET110 = 2.0346663041 - real, parameter :: BET210 = -2.1232895170 - real, parameter :: BET310 = 8.7994140485e-01 - real, parameter :: BET410 = -1.1939638360e-01 - real, parameter :: BET020 = 7.6574242289e-01 - real, parameter :: BET120 = -1.5019813020 - real, parameter :: BET220 = 1.0872489522 - real, parameter :: BET320 = -2.7233429080e-01 - real, parameter :: BET030 = -4.1615152308e-01 - real, parameter :: BET130 = 4.9061350869e-01 - real, parameter :: BET230 = -1.1847737788e-01 - real, parameter :: BET040 = 1.4073062708e-01 - real, parameter :: BET140 = -1.3327978879e-01 - real, parameter :: BET050 = 5.9929880134e-03 - real, parameter :: BET001 = -5.2937873009e-01 - real, parameter :: BET101 = 1.2634116779 - real, parameter :: BET201 = -1.1547328025 - real, parameter :: BET301 = 3.2870876279e-01 - real, parameter :: BET011 = -5.5824407214e-02 - real, parameter :: BET111 = 1.2451933313e-01 - real, parameter :: BET211 = -2.4409539932e-02 - real, parameter :: BET021 = 4.3623149752e-02 - real, parameter :: BET121 = -4.6767901790e-02 - real, parameter :: BET031 = -6.8523260060e-03 - real, parameter :: BET002 = -6.1618945251e-02 - real, parameter :: BET102 = 6.2255521644e-02 - real, parameter :: BET012 = -2.6514181169e-03 - real, parameter :: BET003 = -2.3025968587e-04 - - +real, parameter :: Pa2db = 1.e-4 !< Conversion factor between Pa and dbar +!>@{ Parameters in the NEMO equation of state +real, parameter :: rdeltaS = 32. +real, parameter :: r1_S0 = 0.875/35.16504 +real, parameter :: r1_T0 = 1./40. +real, parameter :: r1_P0 = 1.e-4 +real, parameter :: R00 = 4.6494977072e+01 +real, parameter :: R01 = -5.2099962525 +real, parameter :: R02 = 2.2601900708e-01 +real, parameter :: R03 = 6.4326772569e-02 +real, parameter :: R04 = 1.5616995503e-02 +real, parameter :: R05 = -1.7243708991e-03 +real, parameter :: EOS000 = 8.0189615746e+02 +real, parameter :: EOS100 = 8.6672408165e+02 +real, parameter :: EOS200 = -1.7864682637e+03 +real, parameter :: EOS300 = 2.0375295546e+03 +real, parameter :: EOS400 = -1.2849161071e+03 +real, parameter :: EOS500 = 4.3227585684e+02 +real, parameter :: EOS600 = -6.0579916612e+01 +real, parameter :: EOS010 = 2.6010145068e+01 +real, parameter :: EOS110 = -6.5281885265e+01 +real, parameter :: EOS210 = 8.1770425108e+01 +real, parameter :: EOS310 = -5.6888046321e+01 +real, parameter :: EOS410 = 1.7681814114e+01 +real, parameter :: EOS510 = -1.9193502195 +real, parameter :: EOS020 = -3.7074170417e+01 +real, parameter :: EOS120 = 6.1548258127e+01 +real, parameter :: EOS220 = -6.0362551501e+01 +real, parameter :: EOS320 = 2.9130021253e+01 +real, parameter :: EOS420 = -5.4723692739 +real, parameter :: EOS030 = 2.1661789529e+01 +real, parameter :: EOS130 = -3.3449108469e+01 +real, parameter :: EOS230 = 1.9717078466e+01 +real, parameter :: EOS330 = -3.1742946532 +real, parameter :: EOS040 = -8.3627885467 +real, parameter :: EOS140 = 1.1311538584e+01 +real, parameter :: EOS240 = -5.3563304045 +real, parameter :: EOS050 = 5.4048723791e-01 +real, parameter :: EOS150 = 4.8169980163e-01 +real, parameter :: EOS060 = -1.9083568888e-01 +real, parameter :: EOS001 = 1.9681925209e+01 +real, parameter :: EOS101 = -4.2549998214e+01 +real, parameter :: EOS201 = 5.0774768218e+01 +real, parameter :: EOS301 = -3.0938076334e+01 +real, parameter :: EOS401 = 6.6051753097 +real, parameter :: EOS011 = -1.3336301113e+01 +real, parameter :: EOS111 = -4.4870114575 +real, parameter :: EOS211 = 5.0042598061 +real, parameter :: EOS311 = -6.5399043664e-01 +real, parameter :: EOS021 = 6.7080479603 +real, parameter :: EOS121 = 3.5063081279 +real, parameter :: EOS221 = -1.8795372996 +real, parameter :: EOS031 = -2.4649669534 +real, parameter :: EOS131 = -5.5077101279e-01 +real, parameter :: EOS041 = 5.5927935970e-01 +real, parameter :: EOS002 = 2.0660924175 +real, parameter :: EOS102 = -4.9527603989 +real, parameter :: EOS202 = 2.5019633244 +real, parameter :: EOS012 = 2.0564311499 +real, parameter :: EOS112 = -2.1311365518e-01 +real, parameter :: EOS022 = -1.2419983026 +real, parameter :: EOS003 = -2.3342758797e-02 +real, parameter :: EOS103 = -1.8507636718e-02 +real, parameter :: EOS013 = 3.7969820455e-01 +real, parameter :: ALP000 = -6.5025362670e-01 +real, parameter :: ALP100 = 1.6320471316 +real, parameter :: ALP200 = -2.0442606277 +real, parameter :: ALP300 = 1.4222011580 +real, parameter :: ALP400 = -4.4204535284e-01 +real, parameter :: ALP500 = 4.7983755487e-02 +real, parameter :: ALP010 = 1.8537085209 +real, parameter :: ALP110 = -3.0774129064 +real, parameter :: ALP210 = 3.0181275751 +real, parameter :: ALP310 = -1.4565010626 +real, parameter :: ALP410 = 2.7361846370e-01 +real, parameter :: ALP020 = -1.6246342147 +real, parameter :: ALP120 = 2.5086831352 +real, parameter :: ALP220 = -1.4787808849 +real, parameter :: ALP320 = 2.3807209899e-01 +real, parameter :: ALP030 = 8.3627885467e-01 +real, parameter :: ALP130 = -1.1311538584 +real, parameter :: ALP230 = 5.3563304045e-01 +real, parameter :: ALP040 = -6.7560904739e-02 +real, parameter :: ALP140 = -6.0212475204e-02 +real, parameter :: ALP050 = 2.8625353333e-02 +real, parameter :: ALP001 = 3.3340752782e-01 +real, parameter :: ALP101 = 1.1217528644e-01 +real, parameter :: ALP201 = -1.2510649515e-01 +real, parameter :: ALP301 = 1.6349760916e-02 +real, parameter :: ALP011 = -3.3540239802e-01 +real, parameter :: ALP111 = -1.7531540640e-01 +real, parameter :: ALP211 = 9.3976864981e-02 +real, parameter :: ALP021 = 1.8487252150e-01 +real, parameter :: ALP121 = 4.1307825959e-02 +real, parameter :: ALP031 = -5.5927935970e-02 +real, parameter :: ALP002 = -5.1410778748e-02 +real, parameter :: ALP102 = 5.3278413794e-03 +real, parameter :: ALP012 = 6.2099915132e-02 +real, parameter :: ALP003 = -9.4924551138e-03 +real, parameter :: BET000 = 1.0783203594e+01 +real, parameter :: BET100 = -4.4452095908e+01 +real, parameter :: BET200 = 7.6048755820e+01 +real, parameter :: BET300 = -6.3944280668e+01 +real, parameter :: BET400 = 2.6890441098e+01 +real, parameter :: BET500 = -4.5221697773 +real, parameter :: BET010 = -8.1219372432e-01 +real, parameter :: BET110 = 2.0346663041 +real, parameter :: BET210 = -2.1232895170 +real, parameter :: BET310 = 8.7994140485e-01 +real, parameter :: BET410 = -1.1939638360e-01 +real, parameter :: BET020 = 7.6574242289e-01 +real, parameter :: BET120 = -1.5019813020 +real, parameter :: BET220 = 1.0872489522 +real, parameter :: BET320 = -2.7233429080e-01 +real, parameter :: BET030 = -4.1615152308e-01 +real, parameter :: BET130 = 4.9061350869e-01 +real, parameter :: BET230 = -1.1847737788e-01 +real, parameter :: BET040 = 1.4073062708e-01 +real, parameter :: BET140 = -1.3327978879e-01 +real, parameter :: BET050 = 5.9929880134e-03 +real, parameter :: BET001 = -5.2937873009e-01 +real, parameter :: BET101 = 1.2634116779 +real, parameter :: BET201 = -1.1547328025 +real, parameter :: BET301 = 3.2870876279e-01 +real, parameter :: BET011 = -5.5824407214e-02 +real, parameter :: BET111 = 1.2451933313e-01 +real, parameter :: BET211 = -2.4409539932e-02 +real, parameter :: BET021 = 4.3623149752e-02 +real, parameter :: BET121 = -4.6767901790e-02 +real, parameter :: BET031 = -6.8523260060e-03 +real, parameter :: BET002 = -6.1618945251e-02 +real, parameter :: BET102 = 6.2255521644e-02 +real, parameter :: BET012 = -2.6514181169e-03 +real, parameter :: BET003 = -2.3025968587e-04 +!!@} contains diff --git a/src/equation_of_state/MOM_EOS_TEOS10.F90 b/src/equation_of_state/MOM_EOS_TEOS10.F90 index b36ae2db07..4a139582a3 100644 --- a/src/equation_of_state/MOM_EOS_TEOS10.F90 +++ b/src/equation_of_state/MOM_EOS_TEOS10.F90 @@ -1,3 +1,4 @@ +!> The equation of state using the TEOS10 expressions module MOM_EOS_TEOS10 ! This file is part of MOM6. See LICENSE.md for the license. @@ -47,7 +48,7 @@ module MOM_EOS_TEOS10 module procedure calculate_density_second_derivs_scalar_teos10, calculate_density_second_derivs_array_teos10 end interface calculate_density_second_derivs_teos10 -real, parameter :: Pa2db = 1.e-4 ! The conversion factor from Pa to dbar. +real, parameter :: Pa2db = 1.e-4 !< The conversion factor from Pa to dbar. contains diff --git a/src/equation_of_state/MOM_EOS_UNESCO.F90 b/src/equation_of_state/MOM_EOS_UNESCO.F90 index 80b31301b0..eaad8d0128 100644 --- a/src/equation_of_state/MOM_EOS_UNESCO.F90 +++ b/src/equation_of_state/MOM_EOS_UNESCO.F90 @@ -1,3 +1,4 @@ +!> The equation of state using the Jackett and McDougall fits to the UNESCO EOS module MOM_EOS_UNESCO ! This file is part of MOM6. See LICENSE.md for the license. @@ -29,7 +30,7 @@ module MOM_EOS_UNESCO module procedure calculate_spec_vol_scalar_UNESCO, calculate_spec_vol_array_UNESCO end interface calculate_spec_vol_UNESCO - +!>@{ Parameters in the UNESCO equation of state ! The following constants are used to calculate rho0. The notation ! is Rab for the contribution to rho0 from T^aS^b. real, parameter :: R00 = 999.842594, R10 = 6.793952e-2, R20 = -9.095290e-3, & @@ -48,7 +49,7 @@ module MOM_EOS_UNESCO Sp30 = 1.956415e-6, Sp01 = 6.704388e-3, Sp11 = -1.847318e-4, Sp21 = 2.059331e-7, & Sp032 = 1.480266e-4, SP000 = 2.102898e-4, SP010 = -1.202016e-5, SP020 = 1.394680e-7, & SP001 = -2.040237e-6, SP011 = 6.128773e-8, SP021 = 6.207323e-10 - +!!@} contains diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index b6b85d9542..d35961b997 100644 --- a/src/equation_of_state/MOM_EOS_Wright.F90 +++ b/src/equation_of_state/MOM_EOS_Wright.F90 @@ -1,3 +1,4 @@ +!> The equation of state using the Wright 1997 expressions module MOM_EOS_Wright ! This file is part of MOM6. See LICENSE.md for the license. @@ -45,6 +46,7 @@ module MOM_EOS_Wright module procedure calculate_density_second_derivs_scalar_wright, calculate_density_second_derivs_array_wright end interface +!>@{ Parameters in the Wright equation of state !real :: a0, a1, a2, b0, b1, b2, b3, b4, b5, c0, c1, c2, c3, c4, c5 ! One of the two following blocks of values should be commented out. ! Following are the values for the full range formula. @@ -62,6 +64,7 @@ module MOM_EOS_Wright real, parameter :: b3 = 2.084372e2, b4 = 5.944068e5, b5 = -9.643486e3 real, parameter :: c0 = 1.704853e5, c1 = 7.904722e2, c2 = -7.984422 ! c0/c1 ~= 216 ; c0/c4 ~= -740 real, parameter :: c3 = 5.140652e-2, c4 = -2.302158e2, c5 = -3.079464 +!!@} contains diff --git a/src/equation_of_state/MOM_TFreeze.F90 b/src/equation_of_state/MOM_TFreeze.F90 index 9f3b47893c..99937181c0 100644 --- a/src/equation_of_state/MOM_TFreeze.F90 +++ b/src/equation_of_state/MOM_TFreeze.F90 @@ -1,3 +1,4 @@ +!> Freezing point expressions module MOM_TFreeze ! This file is part of MOM6. See LICENSE.md for the license. From 4bd838e835a4b1c3dc68f7b75f338ccf49b39b51 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 11 Jul 2018 18:59:08 -0400 Subject: [PATCH 0588/1072] Module dOxyGenization for tracer code Added dOxygen comments describing the various tracer package modules, including extended documentation at the end of these modules. All answers are bitwise identical. --- src/tracer/DOME_tracer.F90 | 53 ++++++++--------------- src/tracer/MOM_OCMIP2_CFC.F90 | 58 +++++--------------------- src/tracer/MOM_tracer_Z_init.F90 | 22 +--------- src/tracer/MOM_tracer_flow_control.F90 | 1 + src/tracer/advection_test_tracer.F90 | 38 +---------------- src/tracer/dye_example.F90 | 43 ++++--------------- src/tracer/dyed_obc_tracer.F90 | 1 + src/tracer/ideal_age_example.F90 | 50 ++++++---------------- src/tracer/oil_tracer.F90 | 53 +++++++---------------- src/tracer/pseudo_salt_tracer.F90 | 44 +++++-------------- src/tracer/tracer_example.F90 | 48 +++++++-------------- 11 files changed, 98 insertions(+), 313 deletions(-) diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index a84e87744e..91b156751f 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -1,3 +1,4 @@ +!> A tracer package that is used as a diagnostic in the DOME experiments module DOME_tracer ! This file is part of MOM6. See LICENSE.md for the license. @@ -30,8 +31,7 @@ module DOME_tracer public register_DOME_tracer, initialize_DOME_tracer public DOME_tracer_column_physics, DOME_tracer_surface_state, DOME_tracer_end -!> ntr is the number of tracers in this module. -integer, parameter :: ntr = 11 +integer, parameter :: ntr = 11 !< The number of tracers in this module. !> The DOME_tracer control structure type, public :: DOME_tracer_CS ; private @@ -375,38 +375,21 @@ subroutine DOME_tracer_end(CS) endif end subroutine DOME_tracer_end -!> \namespace DOME_tracer -!! * -!! By Robert Hallberg, 2002 * -!! * -!! This file contains an example of the code that is needed to set * -!! up and use a set (in this case eleven) of dynamically passive * -!! tracers. These tracers dye the inflowing water or water initially * -!! within a range of latitudes or water initially in a range of * -!! depths. * -!! * -!! A single subroutine is called from within each file to register * -!! each of the tracers for reinitialization and advection and to * -!! register the subroutine that initializes the tracers and set up * -!! their output and the subroutine that does any tracer physics or * -!! chemistry along with diapycnal mixing (included here because some * -!! tracers may float or swim vertically or dye diapycnal processes). * -!! * -!! * -!! Macros written all in capital letters are defined in MOM_memory.h. * -!! * -!! A small fragment of the grid is shown below: * -!! * -!! j+1 x ^ x ^ x At x: q * -!! j+1 > o > o > At ^: v * -!! j x ^ x ^ x At >: u * -!! j > o > o > At o: h, tr * -!! j-1 x ^ x ^ x * -!! i-1 i i+1 At x & ^: * -!! i i+1 At > & o: * -!! * -!! The boundaries always run through q grid points (x). * -!! * -!!*******+*********+*********+*********+*********+*********+*********+** +!> \namespace dome_tracer +!! +!! By Robert Hallberg, 2002 +!! +!! This file contains an example of the code that is needed to set +!! up and use a set (in this case eleven) of dynamically passive +!! tracers. These tracers dye the inflowing water or water initially +!! within a range of latitudes or water initially in a range of +!! depths. +!! +!! A single subroutine is called from within each file to register +!! each of the tracers for reinitialization and advection and to +!! register the subroutine that initializes the tracers and set up +!! their output and the subroutine that does any tracer physics or +!! chemistry along with diapycnal mixing (included here because some +!! tracers may float or swim vertically or dye diapycnal processes). end module DOME_tracer diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index e7577f17e2..e8c3387cea 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -1,52 +1,8 @@ +!> Simulates CFCs using the OCMIP2 protocols module MOM_OCMIP2_CFC ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, 2007 * -!* * -!* This file contains an example of the code that is needed to set * -!* up and use CFC-11 and CFC-12 in a fully coupled or ice-ocean model * -!* context. There are 5 subroutines in this file. * -!* * -!* register_OCMIP2_CFC determines if the module is going to work, * -!* then makes several calls registering tracers to be advected and * -!* read from a restart file. it also sets various run-time parameters * -!* for this module and sets up a "control structure" (CS) to store * -!* all information for this module. * -!* * -!* initialize_OCMIP2_CFC initializes this modules arrays if they * -!* have not been found in a restart file. It also determines which * -!* diagnostics will need to be calculated. * -!* * -!* OCMIP2_CFC_column_physics updates the CFC concentrations, * -!* applying everthing but horizontal advection and diffusion. * -!* Surface fluxes are applied inside an implicit vertical advection * -!* and diffusion tridiagonal solver, and any interior sources and * -!* sinks (not applicable for CFCs) would also be applied here. This * -!* subroutine also sends out any requested interior diagnostics. * -!* * -!* OCMIP2_CFC_surface_state calculates the information required * -!* from the ocean for the FMS coupler to calculate CFC fluxes. * -!* * -!* OCMIP2_CFC_end deallocates the persistent run-time memory used * -!* by this module. * -!* * -!* A small fragment of the horizontal grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v, * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, CFC11, CFC12 * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_diag_mediator, only : diag_ctrl use MOM_diag_to_Z, only : diag_to_Z_CS use MOM_error_handler, only : MOM_error, FATAL, WARNING @@ -78,8 +34,7 @@ module MOM_OCMIP2_CFC public OCMIP2_CFC_stock, OCMIP2_CFC_end -! NTR is the number of tracers in this module. -integer, parameter :: NTR = 2 +integer, parameter :: NTR = 2 !< the number of tracers in this module. !> The control structure for the OCMPI2_CFC tracer package type, public :: OCMIP2_CFC_CS ; private @@ -673,4 +628,13 @@ subroutine OCMIP2_CFC_end(CS) endif end subroutine OCMIP2_CFC_end + +!> \namespace mom_ocmip2_cfc +!! +!! By Robert Hallberg, 2007 +!! +!! This module contains the code that is needed to set +!! up and use CFC-11 and CFC-12 in a fully coupled or ice-ocean model +!! context using the OCMIP2 protocols + end module MOM_OCMIP2_CFC diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index fe3cfe69b5..0f7c5c1224 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -1,28 +1,8 @@ +!> Used to initialize tracers from a depth- (or z*-) space file. module MOM_tracer_Z_init ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, September 2009 * -!* * -!* This file contains a subroutine to initialize tracers into the * -!* MOM vertical grid from a depth- (or z*-) space file. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: * -!* j+1 > o > o > At ^: * -!* j x ^ x ^ x At >: * -!* j > o > o > At o: tr * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_diag_to_Z, only : find_overlap, find_limited_slope use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe ! use MOM_file_parser, only : get_param, log_version, param_file_type diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 279bc22a95..ae9690aca4 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -1,3 +1,4 @@ +!> Orchestrates the registration and calling of tracer packages module MOM_tracer_flow_control ! This file is part of MOM6. See LICENSE.md for the license. diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 0ccf4d95b6..4ed395bac8 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -1,41 +1,8 @@ +!> This tracer package is used to test advection schemes module advection_test_tracer ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, 2002 * -!* * -!* This file contains an example of the code that is needed to set * -!* up and use a set (in this case eleven) of dynamically passive * -!* tracers. These tracers dye the inflowing water or water initially * -!* within a range of latitudes or water initially in a range of * -!* depths. * -!* * -!* A single subroutine is called from within each file to register * -!* each of the tracers for reinitialization and advection and to * -!* register the subroutine that initializes the tracers and set up * -!* their output and the subroutine that does any tracer physics or * -!* chemistry along with diapycnal mixing (included here because some * -!* tracers may float or swim vertically or dye diapycnal processes). * -!* * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, tr * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_diag_mediator, only : diag_ctrl use MOM_diag_to_Z, only : diag_to_Z_CS use MOM_error_handler, only : MOM_error, FATAL, WARNING @@ -64,8 +31,7 @@ module advection_test_tracer public advection_test_tracer_surface_state, advection_test_tracer_end public advection_test_tracer_column_physics, advection_test_stock -! ntr is the number of tracers in this module. -integer, parameter :: NTR = 11 +integer, parameter :: NTR = 11 !< The number of tracers in this module. !> The control structure for the advect_test_tracer module type, public :: advection_test_tracer_CS ; private diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index d29e0534ba..a597b1fc8c 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -1,3 +1,4 @@ +!> A tracer package for using dyes to diagnose regional flows. module regional_dyes ! This file is part of MOM6. See LICENSE.md for the license. @@ -411,39 +412,13 @@ subroutine regional_dyes_end(CS) endif end subroutine regional_dyes_end -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, 2002 * -!* * -!* This file contains an example of the code that is needed to set * -!* up and use a set (in this case two) of dynamically passive tracers * -!* for diagnostic purposes. The tracers here are dye tracers which * -!* are set to 1 within the geographical region specified. The depth * -!* which a tracer is set is determined by calculating the depth from * -!* the seafloor upwards through the column. * -!* * -!* A single subroutine is called from within each file to register * -!* each of the tracers for reinitialization and advection and to * -!* register the subroutine that initializes the tracers and set up * -!* their output and the subroutine that does any tracer physics or * -!* chemistry along with diapycnal mixing (included here because some * -!* tracers may float or swim vertically or dye diapycnal processes). * -!* * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, tr * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** +!> \namespace regional_dyes +!! +!! This file contains an example of the code that is needed to set +!! up and use a set (in this case two) of dynamically passive tracers +!! for diagnostic purposes. The tracers here are dye tracers which +!! are set to 1 within the geographical region specified. The depth +!! which a tracer is set is determined by calculating the depth from +!! the seafloor upwards through the column. end module regional_dyes diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index 20a68c9d21..2102f1cc71 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -1,3 +1,4 @@ +!> This tracer package dyes flow through open boundaries module dyed_obc_tracer ! This file is part of MOM6. See LICENSE.md for the license. diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index b7fe056498..1f77bd639e 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -1,42 +1,8 @@ +!> A tracer package of ideal age tracers module ideal_age_example ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, 2002 * -!* * -!* This file contains an example of the code that is needed to set * -!* up and use a set (in this case two) of dynamically passive tracers * -!* for diagnostic purposes. The tracers here are an ideal age tracer * -!* that ages at a rate of 1/year once it is isolated from the surface,* -!* and a vintage tracer, whose surface concentration grows exponen- * -!* with time with a 30-year timescale (similar to CFCs). * -!* * -!* A single subroutine is called from within each file to register * -!* each of the tracers for reinitialization and advection and to * -!* register the subroutine that initializes the tracers and set up * -!* their output and the subroutine that does any tracer physics or * -!* chemistry along with diapycnal mixing (included here because some * -!* tracers may float or swim vertically or dye diapycnal processes). * -!* * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, tr * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_diag_mediator, only : diag_ctrl use MOM_diag_to_Z, only : diag_to_Z_CS use MOM_error_handler, only : MOM_error, FATAL, WARNING @@ -66,8 +32,7 @@ module ideal_age_example public ideal_age_tracer_column_physics, ideal_age_tracer_surface_state public ideal_age_stock, ideal_age_example_end -! NTR_MAX is the maximum number of tracers in this module. -integer, parameter :: NTR_MAX = 3 +integer, parameter :: NTR_MAX = 3 !< the maximum number of tracers in this module. !> The control structure for the ideal_age_tracer package type, public :: ideal_age_tracer_CS ; private @@ -499,4 +464,15 @@ subroutine ideal_age_example_end(CS) endif end subroutine ideal_age_example_end +!> \namespace ideal_age_example +!! +!! Originally by Robert Hallberg, 2002 +!! +!! This file contains an example of the code that is needed to set +!! up and use a set (in this case two) of dynamically passive tracers +!! for diagnostic purposes. The tracers here are an ideal age tracer +!! that ages at a rate of 1/year once it is isolated from the surface, +!! and a vintage tracer, whose surface concentration grows exponen- +!! with time with a 30-year timescale (similar to CFCs). + end module ideal_age_example diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 0e9ac18174..fd794aff0b 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -1,42 +1,8 @@ +!> A tracer package to mimic dissolved oil. module oil_tracer ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, 2002 * -!* * -!* This file contains an example of the code that is needed to set * -!* up and use a set (in this case two) of dynamically passive tracers * -!* for diagnostic purposes. The tracers here are an ideal age tracer * -!* that ages at a rate of 1/year once it is isolated from the surface,* -!* and a vintage tracer, whose surface concentration grows exponen- * -!* with time with a 30-year timescale (similar to CFCs). * -!* * -!* A single subroutine is called from within each file to register * -!* each of the tracers for reinitialization and advection and to * -!* register the subroutine that initializes the tracers and set up * -!* their output and the subroutine that does any tracer physics or * -!* chemistry along with diapycnal mixing (included here because some * -!* tracers may float or swim vertically or dye diapycnal processes). * -!* * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, tr * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_diag_mediator, only : diag_ctrl use MOM_diag_to_Z, only : diag_to_Z_CS use MOM_error_handler, only : MOM_error, FATAL, WARNING @@ -67,8 +33,7 @@ module oil_tracer public oil_tracer_column_physics, oil_tracer_surface_state public oil_stock, oil_tracer_end -! NTR_MAX is the maximum number of tracers in this module. -integer, parameter :: NTR_MAX = 20 +integer, parameter :: NTR_MAX = 20 !< the maximum number of tracers in this module. !> The control structure for the oil tracer package type, public :: oil_tracer_CS ; private @@ -535,4 +500,18 @@ subroutine oil_tracer_end(CS) endif end subroutine oil_tracer_end +!> \namespace oil_tracer +!! +!! By Alistair Adcroft and Robert Hallberg, 2010 * +!! +!! In the midst of the Deepwater Horizon oil spill, it became evident that +!! models were needed to predict the long-term fate of dissolved oil in the +!! open ocean. This tracer packages mimics the transport, dilution and decay +!! of dissolved oil plumes in the ocean. +!! +!! This tracer package was central to the simulations used by Adcroft et al., +!! GRL 2010, to prove that the Deepwater Horizon spill was an important regional +!! event, with implications for dissolved oxygen levels in the Gulf of Mexico, +!! but not one that would directly impact the East Coast of the U.S. + end module oil_tracer diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index 66e38f24aa..fb0d38d86a 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -1,40 +1,8 @@ +!> A tracer package that mimics salinity module pseudo_salt_tracer ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Andrew Shao, 2016 * -!* * -!* This file contains the routines necessary to model a passive * -!* tracer that uses the same boundary fluxes as salinity. At the * -!* beginning of the run, salt is set to the same as tv%S. Any * -!* deviations between this salt-like tracer and tv%S signifies a * -!* difference between how active and passive tracers are treated. * -!* A single subroutine is called from within each file to register * -!* each of the tracers for reinitialization and advection and to * -!* register the subroutine that initializes the tracers and set up * -!* their output and the subroutine that does any tracer physics or * -!* chemistry along with diapycnal mixing (included here because some * -!* tracers may float or swim vertically or dye diapycnal processes). * -!* * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, tr * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_debugging, only : hchksum use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl @@ -367,4 +335,14 @@ subroutine pseudo_salt_tracer_end(CS) endif end subroutine pseudo_salt_tracer_end +!> \namespace pseudo_salt_tracer +!! +!! By Andrew Shao, 2016 +!! +!! This file contains the routines necessary to model a passive +!! tracer that uses the same boundary fluxes as salinity. At the +!! beginning of the run, salt is set to the same as tv%S. Any +!! deviations between this salt-like tracer and tv%S signifies a +!! difference between how active and passive tracers are treated. + end module pseudo_salt_tracer diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index e7869214dd..966fa07410 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -1,38 +1,8 @@ +!> A sample tracer package that has striped initial conditions module USER_tracer_example ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, 2002 * -!* * -!* This file contains an example of the code that is needed to set * -!* up and use a set (in this case one) of dynamically passive tracers.* -!* * -!* A single subroutine is called from within each file to register * -!* each of the tracers for reinitialization and advection and to * -!* register the subroutine that initializes the tracers and set up * -!* their output and the subroutine that does any tracer physics or * -!* chemistry along with diapycnal mixing (included here because some * -!* tracers may float or swim vertically or dye diapycnal processes). * -!* * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, tr * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_diag_mediator, only : diag_ctrl use MOM_diag_to_Z, only : diag_to_Z_CS use MOM_error_handler, only : MOM_error, FATAL, WARNING @@ -59,8 +29,7 @@ module USER_tracer_example public USER_register_tracer_example, USER_initialize_tracer, USER_tracer_stock public tracer_column_physics, USER_tracer_surface_state, USER_tracer_example_end -! NTR is the number of tracers in this module. -integer, parameter :: NTR = 1 +integer, parameter :: NTR = 1 !< The number of tracers in this module. !> The control structure for the USER_tracer_example module type, public :: USER_tracer_example_CS ; private @@ -479,4 +448,17 @@ subroutine USER_tracer_example_end(CS) endif end subroutine USER_tracer_example_end +!> \namespace user_tracer_example +!! +!! Original by Robert Hallberg, 2002 +!! +!! This file contains an example of the code that is needed to set +!! up and use a set (in this case one) of dynamically passive tracers. +!! +!! A single subroutine is called from within each file to register +!! each of the tracers for reinitialization and advection and to +!! register the subroutine that initializes the tracers and set up +!! their output and the subroutine that does any tracer physics or +!! chemistry along with diapycnal mixing (included here because some +!! tracers may float or swim vertically or dye diapycnal processes). end module USER_tracer_example From 7c4d6841cffe3e433c88596fbd83586b749a0980 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 11 Jul 2018 19:00:53 -0400 Subject: [PATCH 0589/1072] Module dOxyGenization for framework code Added dOxygen comments describing the various MOM6 framework modules, including extended documentation at the end of some of these modules. All answers are bitwise identical. --- src/framework/MOM_checksums.F90 | 11 ++-- src/framework/MOM_coms.F90 | 32 +++++------ src/framework/MOM_diag_mediator.F90 | 8 +-- src/framework/MOM_document.F90 | 15 ++---- src/framework/MOM_domains.F90 | 5 +- src/framework/MOM_dyn_horgrid.F90 | 2 + src/framework/MOM_error_handler.F90 | 35 +++++------- src/framework/MOM_file_parser.F90 | 65 ++++++++++++----------- src/framework/MOM_intrinsic_functions.F90 | 9 +--- src/framework/MOM_restart.F90 | 42 +-------------- src/framework/MOM_spatial_means.F90 | 1 + src/framework/MOM_string_functions.F90 | 19 ++++--- src/framework/MOM_write_cputime.F90 | 27 +++++----- 13 files changed, 107 insertions(+), 164 deletions(-) diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index 5c81c45078..df014dc7a5 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -1,3 +1,4 @@ +!> Routines to calculate checksums of various array and vector types module MOM_checksums ! This file is part of MOM6. See LICENSE.md for the license. @@ -76,11 +77,11 @@ module MOM_checksums module procedure chksum_general_1d, chksum_general_2d, chksum_general_3d end interface -integer, parameter :: default_shift=0 -logical :: calculateStatistics=.true. ! If true, report min, max and mean. -logical :: writeChksums=.true. ! If true, report the bitcount checksum -logical :: checkForNaNs=.true. ! If true, checks array for NaNs and cause - ! FATAL error is any are found +integer, parameter :: default_shift=0 !< The default array shift +logical :: calculateStatistics=.true. !< If true, report min, max and mean. +logical :: writeChksums=.true. !< If true, report the bitcount checksum +logical :: checkForNaNs=.true. !< If true, checks array for NaNs and cause + !! FATAL error is any are found contains diff --git a/src/framework/MOM_coms.F90 b/src/framework/MOM_coms.F90 index 40ea23945e..47601db679 100644 --- a/src/framework/MOM_coms.F90 +++ b/src/framework/MOM_coms.F90 @@ -1,3 +1,5 @@ +!> Interfaces to non-domain-oriented communication subroutines, including the +!! MOM6 reproducing sums facility module MOM_coms ! This file is part of MOM6. See LICENSE.md for the license. @@ -23,23 +25,26 @@ module MOM_coms ! This module provides interfaces to the non-domain-oriented communication ! subroutines. -integer(kind=8), parameter :: prec=2_8**46 ! The precision of each integer. -real, parameter :: r_prec=2.0**46 ! A real version of prec. -real, parameter :: I_prec=1.0/(2.0**46) ! The inverse of prec. +integer(kind=8), parameter :: prec=2_8**46 !< The precision of each integer. +real, parameter :: r_prec=2.0**46 !< A real version of prec. +real, parameter :: I_prec=1.0/(2.0**46) !< The inverse of prec. integer, parameter :: max_count_prec=2**(63-46)-1 - ! The number of values that can be added together - ! with the current value of prec before there will - ! be roundoff problems. + !< The number of values that can be added together + !! with the current value of prec before there will + !! be roundoff problems. -integer, parameter :: ni=6 ! The number of long integers to use to represent - ! a real number. +integer, parameter :: ni=6 !< The number of long integers to use to represent + !< a real number. real, parameter, dimension(ni) :: & pr = (/ r_prec**2, r_prec, 1.0, 1.0/r_prec, 1.0/r_prec**2, 1.0/r_prec**3 /) + !< An array of the real precision of each of the integers real, parameter, dimension(ni) :: & I_pr = (/ 1.0/r_prec**2, 1.0/r_prec, 1.0, r_prec, r_prec**2, r_prec**3 /) + !< An array of the inverse of thereal precision of each of the integers -logical :: overflow_error = .false., NaN_error = .false. -logical :: debug = .false. ! Making this true enables debugging output. +logical :: overflow_error = .false. !< This becomes true if an overflow is encountered. +logical :: NaN_error = .false. !< This becomes true if a NaN is encountered. +logical :: debug = .false. !< Making this true enables debugging output. !> Find an accurate and order-invariant sum of distributed 2d or 3d fields interface reproducing_sum @@ -677,7 +682,7 @@ function real_to_EFP(val, overflow) end function real_to_EFP -!< This subroutine does a sum across PEs of a list of EFP variables, +!> This subroutine does a sum across PEs of a list of EFP variables, !! returning the sums in place, with all overflows carried. subroutine EFP_list_sum_across_PEs(EFPs, nval, errors) type(EFP_type), dimension(:), & @@ -727,12 +732,9 @@ subroutine EFP_list_sum_across_PEs(EFPs, nval, errors) end subroutine EFP_list_sum_across_PEs -!< This subroutine carries out all of the calls required to close out the infrastructure cleanly. +!> This subroutine carries out all of the calls required to close out the infrastructure cleanly. !! This should only be called in ocean-only runs, as the coupler takes care of this in coupled runs. subroutine MOM_infra_end - ! This subroutine should contain all of the calls that are required - ! to close out the infrastructure cleanly. This should only be called - ! in ocean-only runs, as the coupler takes care of this in coupled runs. call print_memuse_stats( 'Memory HiWaterMark', always=.TRUE. ) call fms_end end subroutine MOM_infra_end diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index b87cc71b7a..fb84d4d48d 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -1,13 +1,9 @@ +!> The subroutines here provide convenient wrappers to the fms diag_manager +!! interfaces with additional diagnostic capabilies. module MOM_diag_mediator ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* The subroutines here provide convenient wrappers to the fms * -!* diag_manager interfaces with additional diagnostic capabilies. * -!* * -!********+*********+*********+*********+*********+*********+*********+** use MOM_checksums, only : chksum_general use MOM_coms, only : PE_here use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end diff --git a/src/framework/MOM_document.F90 b/src/framework/MOM_document.F90 index 1280587900..36f43528be 100644 --- a/src/framework/MOM_document.F90 +++ b/src/framework/MOM_document.F90 @@ -1,14 +1,9 @@ +!> The subroutines here provide hooks for document generation functions at +!! various levels of granularity. module MOM_document ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* The subroutines here provide hooks for document generation * -!* functions at various levels of granularity. * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_time_manager, only : time_type use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe @@ -27,7 +22,7 @@ module MOM_document doc_param_time end interface -integer, parameter :: mLen = 1240 ! Length of interface/message strings +integer, parameter :: mLen = 1240 !< Length of interface/message strings !> A structure that controls where the documentation occurs, its veborsity and formatting. type, public :: doc_type ; private @@ -56,8 +51,8 @@ module MOM_document character(len=620) :: msg !< Parameter value and default end type link_msg -character(len=4), parameter :: STRING_TRUE = 'True' -character(len=5), parameter :: STRING_FALSE = 'False' +character(len=4), parameter :: STRING_TRUE = 'True' !< A string for true logicals +character(len=5), parameter :: STRING_FALSE = 'False' !< A string for false logicals contains diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index c8b5fd1714..103b328aa1 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -1,3 +1,4 @@ +!> Describes the decomposed MOM domain and has routines for communications across PEs module MOM_domains ! This file is part of MOM6. See LICENSE.md for the license. @@ -31,8 +32,6 @@ module MOM_domains implicit none ; private -! #include - public :: MOM_domains_init, MOM_infra_init, MOM_infra_end, get_domain_extent public :: MOM_define_domain, MOM_define_io_domain, clone_MOM_domain public :: pass_var, pass_vector, broadcast, PE_here, root_PE, num_PEs @@ -128,7 +127,7 @@ module MOM_domains !! assigned if all logical processors are used. end type MOM_domain_type -integer, parameter :: To_All = To_East + To_West + To_North + To_South +integer, parameter :: To_All = To_East + To_West + To_North + To_South !< A flag for passing in all directions contains diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 05429335ec..403729559d 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -1,3 +1,5 @@ +!> Contains a shareable dynamic type for describing horizontal grids and metric data +!! and utilty routines that work on this type. module MOM_dyn_horgrid ! This file is part of MOM6. See LICENSE.md for the license. diff --git a/src/framework/MOM_error_handler.F90 b/src/framework/MOM_error_handler.F90 index e1a85b52c4..30300d6e33 100644 --- a/src/framework/MOM_error_handler.F90 +++ b/src/framework/MOM_error_handler.F90 @@ -1,16 +1,8 @@ +!> Routines for error handling and I/O management module MOM_error_handler ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By R. Hallberg, 2005-2012. * -!* * -!* This module wraps the mpp_mod error handling code and the * -!* mpp functions stdlog() and stdout() that return open unit numbers. * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use mpp_mod, only : mpp_error, NOTE, WARNING, FATAL use mpp_mod, only : mpp_pe, mpp_root_pe, stdlog, stdout @@ -21,18 +13,19 @@ module MOM_error_handler public callTree_showQuery, callTree_enter, callTree_leave, callTree_waypoint public assert -! Verbosity level: -! 0 - FATAL messages only -! 1 - FATAL + WARNING messages only -! 2 - FATAL + WARNING + NOTE messages only [default] -! 3 - above + informational -! 4 - -! 5 - -! 6 - above + call tree -! 7 - -! 8 - -! 9 - anything and everything (also set with #define DEBUG) integer :: verbosity = 6 +!< Verbosity level: +!! 0 - FATAL messages only +!! 1 - FATAL + WARNING messages only +!! 2 - FATAL + WARNING + NOTE messages only [default] +!! 3 - above + informational +!! 4 - +!! 5 - +!! 6 - above + call tree +!! 7 - +!! 8 - +!! 9 - anything and everything (also set with DEBUG=True) + ! Note that this module default will only hold until the ! VERBOSITY parameter is parsed and the given default imposed. ! We set it to 6 here so that the call tree will print before @@ -41,8 +34,8 @@ module MOM_error_handler ! a type passed by argument (preferred for most data) for convenience ! and to reduce obfuscation of code -! The level of calling within the call tree integer :: callTreeIndentLevel = 0 +!< The level of calling within the call tree contains diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index 5157df0146..ae876b16dd 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -1,33 +1,8 @@ +!> The MOM6 facility to parse input files for runtime parameters module MOM_file_parser ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg and Alistair Adcroft, updated 9/2013. * -!* * -!* The subroutines here parse a set of input files for the value * -!* a named parameter and sets that parameter at run time. Currently * -!* these files use use one of several formats: * -!* #define VAR ! To set the logical VAR to true. * -!* VAR = True ! To set the logical VAR to true. * -!* #undef VAR ! To set the logical VAR to false. * -!* VAR = False ! To set the logical VAR to false. * -!* #define VAR 999 ! To set the real or integer VAR to 999. * -!* VAR = 999 ! To set the real or integer VAR to 999. * -!* #override VAR = 888 ! To override a previously set value. * -!* VAR = 1.1, 2.2, 3.3 ! To set an array of real values. * -!* * -!* In addition, when set by the get_param interface, the values of * -!* parameters are automatically logged, along with defaults, units, * -!* and a description. It is an error for a variable to be overridden * -!* more than once, and MOM6 has a facility to check for unused lines * -!* to set variables, which may indicate miss-spelled or archaic * -!* parameters. Parameter names are case-specific, and lines may use * -!* a F90 or C++ style comment, starting with ! or //. * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_coms, only : root_PE, broadcast use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg use MOM_error_handler, only : is_root_pe, stdlog, stdout @@ -40,20 +15,21 @@ module MOM_file_parser implicit none ; private -integer, parameter, public :: MAX_PARAM_FILES = 5 ! Maximum number of parameter files. -integer, parameter :: INPUT_STR_LENGTH = 320 ! Maximum linelength in parameter file. -integer, parameter :: FILENAME_LENGTH = 200 ! Maximum number of characters in - ! file names. +integer, parameter, public :: MAX_PARAM_FILES = 5 !< Maximum number of parameter files. +integer, parameter :: INPUT_STR_LENGTH = 320 !< Maximum line length in parameter file. +integer, parameter :: FILENAME_LENGTH = 200 !< Maximum number of characters in file names. ! The all_PEs_read option should be eliminated with post-riga shared code. -logical :: all_PEs_read = .false. +logical :: all_PEs_read = .false. !< If true, all PEs read the input files + !! TODO: Eliminate this parameter -! Defaults +!>@{ Default values for parameters logical, parameter :: report_unused_default = .false. logical, parameter :: unused_params_fatal_default = .false. logical, parameter :: log_to_stdout_default = .false. logical, parameter :: complete_doc_default = .true. logical, parameter :: minimal_doc_default = .true. +!!@} !> The valid lines extracted from an input parameter file without comments type, private :: file_data_type ; private @@ -2104,4 +2080,29 @@ function popBlockLevel(oldblockName) endif end function popBlockLevel +!> \namespace mom_file_parser +!! +!! By Robert Hallberg and Alistair Adcroft, updated 9/2013. +!! +!! The subroutines here parse a set of input files for the value +!! a named parameter and sets that parameter at run time. Currently +!! these files use use one of several formats: +!! \#define VAR ! To set the logical VAR to true. +!! VAR = True ! To set the logical VAR to true. +!! \#undef VAR ! To set the logical VAR to false. +!! VAR = False ! To set the logical VAR to false. +!! \#define VAR 999 ! To set the real or integer VAR to 999. +!! VAR = 999 ! To set the real or integer VAR to 999. +!! \#override VAR = 888 ! To override a previously set value. +!! VAR = 1.1, 2.2, 3.3 ! To set an array of real values. + ! Note that in the comments above, dOxygen translates \# to # . +!! +!! In addition, when set by the get_param interface, the values of +!! parameters are automatically logged, along with defaults, units, +!! and a description. It is an error for a variable to be overridden +!! more than once, and MOM6 has a facility to check for unused lines +!! to set variables, which may indicate miss-spelled or archaic +!! parameters. Parameter names are case-specific, and lines may use +!! a F90 or C++ style comment, starting with ! or //. + end module MOM_file_parser diff --git a/src/framework/MOM_intrinsic_functions.F90 b/src/framework/MOM_intrinsic_functions.F90 index 664f87ad3f..fdda8849ae 100644 --- a/src/framework/MOM_intrinsic_functions.F90 +++ b/src/framework/MOM_intrinsic_functions.F90 @@ -1,14 +1,9 @@ +!> A module with intrinsic functions that are used by MOM but are not supported +!! by some compilers. module MOM_intrinsic_functions ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* This module holds intrinsic functions which are used by MOM but * -!* are not supported by some compilers. * -!* * -!********+*********+*********+*********+*********+*********+*********+** - implicit none ; private public :: invcosh diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index bc98f87f52..bf40da4897 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -1,48 +1,8 @@ +!> The MOM6 facility for reading and writing restart files, and querying what has been read. module MOM_restart ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, April 1994 - June 2002 * -!* * -!* This file contains four subroutines associated with saving * -!* restart files or restoring the model state from files. * -!* * -!* register_restart_field is used to specify the fields that will * -!* be written to restart files. * -!* * -!* Save_restart saves a restart file from which a simulation can * -!* be restarted with results that are identical to those which would * -!* have been attained if there had been no interruption. If this * -!* file would be larger than 2 Gbytes, it is broken up into a number * -!* of smaller files. * -!* * -!* The subroutine restore_state initializes the fields for the * -!* simulations from a number of restart files or other NetCDF files. * -!* Each restart field is initialized from the first file in the * -!* list in which it is found. The files are separated by spaces, * -!* and all must be in the specified directory. If 'r' is included * -!* in the list, it is expanded to include all of the restart files * -!* that are found in the directory. * -!* * -!* query_initialized returns true if a field (or the entire restart * -!* file) has been initialized from a restart file and false otherwise.* -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q, CoriolisBu * -!* j+1 > o > o > At ^: v * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, bathyT, tr * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 * -!* i i+1 * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_domains, only : pe_here, num_PEs use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE, is_root_pe use MOM_file_parser, only : get_param, log_param, log_version, param_file_type diff --git a/src/framework/MOM_spatial_means.F90 b/src/framework/MOM_spatial_means.F90 index 81356d6fa7..281b38c10a 100644 --- a/src/framework/MOM_spatial_means.F90 +++ b/src/framework/MOM_spatial_means.F90 @@ -1,3 +1,4 @@ +!> Functions and routines to take area, volume, mass-weighted, layerwise, zonal or meridional means module MOM_spatial_means ! This file is part of MOM6. See LICENSE.md for the license. diff --git a/src/framework/MOM_string_functions.F90 b/src/framework/MOM_string_functions.F90 index 643b150219..0a4058995a 100644 --- a/src/framework/MOM_string_functions.F90 +++ b/src/framework/MOM_string_functions.F90 @@ -1,17 +1,8 @@ +!> Handy functions for manipulating strings module MOM_string_functions ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Alistair Adcroft and Robert Hallberg, last updated Sept. 2013. * -!* * -!* The functions here perform a set of useful manipulations of * -!* character strings. Although they are a part of MOM6, the do not * -!* require any other MOM software to be useful. * -!* * -!********+*********+*********+*********+*********+*********+*********+** - implicit none ; private public lowercase, uppercase @@ -417,4 +408,12 @@ function slasher(dir) endif end function slasher +!> \namespace mom_string_functions +!! +!! By Alistair Adcroft and Robert Hallberg, last updated Sept. 2013. +!! +!! The functions here perform a set of useful manipulations of +!! character strings. Although they are a part of MOM6, the do not +!! require any other MOM software to be useful. + end module MOM_string_functions diff --git a/src/framework/MOM_write_cputime.F90 b/src/framework/MOM_write_cputime.F90 index ca2aeeda1e..c85e3ecb7b 100644 --- a/src/framework/MOM_write_cputime.F90 +++ b/src/framework/MOM_write_cputime.F90 @@ -1,19 +1,8 @@ +!> A module to monitor the overall CPU time used by MOM6 and project when to stop the model module MOM_write_cputime ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, May 2006. * -!* * -!* This file contains the subroutine (write_cputime) that writes * -!* the summed CPU time across all processors to an output file. In * -!* addition, write_cputime estimates how many more time steps can be * -!* taken before 95% of the available CPU time is used, so that the * -!* model can be checkpointed at that time. * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_coms, only : sum_across_PEs, pe_here, num_pes use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, is_root_pe use MOM_io, only : open_file, APPEND_FILE, ASCII_FILE, WRITEONLY_FILE @@ -26,8 +15,8 @@ module MOM_write_cputime !----------------------------------------------------------------------- -integer :: CLOCKS_PER_SEC = 1000 -integer :: MAX_TICKS = 1000 +integer :: CLOCKS_PER_SEC = 1000 !< The number of clock cycles per second, used by the system clock +integer :: MAX_TICKS = 1000 !< The number of ticks per second, used by the system clock !> A control structure that regulates the writing of CPU time type, public :: write_cputime_CS ; private @@ -189,4 +178,14 @@ subroutine write_cputime(day, n, nmax, CS) end subroutine write_cputime +!> \namespace mom_write_cputime +!! +!! By Robert Hallberg, May 2006. +!! +!! This file contains the subroutine (write_cputime) that writes +!! the summed CPU time across all processors to an output file. In +!! addition, write_cputime estimates how many more time steps can be +!! taken before 95% of the available CPU time is used, so that the +!! model can be checkpointed at that time. + end module MOM_write_cputime From f69cbf7a95b7edfe4d13cf126b52a3f45f807130 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Thu, 12 Jul 2018 11:47:14 -0400 Subject: [PATCH 0590/1072] Doxygen config: only process ocean_model_MOM.F90 from coupled_driver - The duplicate files in solo_driver and coupled_driver cause conflicts when running doxygen. This configuration change avoids the duplicate files in coupled_driver. --- docs/Doxyfile_nortd | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/docs/Doxyfile_nortd b/docs/Doxyfile_nortd index 7e1fcc39cf..e07ce4f0b6 100644 --- a/docs/Doxyfile_nortd +++ b/docs/Doxyfile_nortd @@ -793,8 +793,7 @@ WARN_LOGFILE = doxygen.log INPUT = ../src \ front_page.md \ ../config_src/solo_driver \ - ../config_src/dynamic_symmetric \ - ../config_src/coupled_driver/coupler_util.F90 \ + ../config_src/dynamic_symmetric ../config_src/coupled_driver/ocean_model_MOM.F90 # This tag can be used to specify the character encoding of the source files From 6478c0131629fc5771d9bd582cd8c2619d19e40a Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Thu, 12 Jul 2018 11:49:01 -0400 Subject: [PATCH 0591/1072] Fixes for doxumentation using doxygen 1.8.4 - Using the older version of doxygen revealed numerous modules without either the header summary line or any doxumentation at all. The newer versions are deliberately silent on these omissions. --- config_src/coupled_driver/coupler_util.F90 | 61 +++++----- config_src/coupled_driver/ocean_model_MOM.F90 | 104 +++--------------- .../solo_driver/MESO_surface_forcing.F90 | 68 +++++------- config_src/solo_driver/coupler_types.F90 | 11 +- config_src/solo_driver/coupler_util.F90 | 59 +++++----- src/diagnostics/MOM_PointAccel.F90 | 45 ++------ src/diagnostics/MOM_debugging.F90 | 76 +++++-------- src/diagnostics/MOM_diag_to_Z.F90 | 51 ++------- src/diagnostics/MOM_diagnostics.F90 | 25 +---- src/diagnostics/MOM_sum_output.F90 | 67 ++++------- src/diagnostics/MOM_wave_structure.F90 | 89 ++++++--------- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 16 ++- .../lateral/MOM_tidal_forcing.F90 | 74 ++++++------- 13 files changed, 237 insertions(+), 509 deletions(-) diff --git a/config_src/coupled_driver/coupler_util.F90 b/config_src/coupled_driver/coupler_util.F90 index dde67c2976..2c72c56cce 100644 --- a/config_src/coupled_driver/coupler_util.F90 +++ b/config_src/coupled_driver/coupler_util.F90 @@ -1,9 +1,9 @@ +!> Provides a couple of interfaces to allow more transparent and +!! robust extraction of the various fields in the coupler types. module coupler_util ! This file is part of MOM6. See LICENSE.md for the license. -! This code provides a couple of interfaces to allow more transparent and -! robust extraction of the various fields in the coupler types. use MOM_error_handler, only : MOM_error, FATAL, WARNING use coupler_types_mod, only : coupler_2d_bc_type, ind_flux, ind_alpha use coupler_types_mod, only : ind_csurf @@ -15,24 +15,20 @@ module coupler_util contains +!> Extract an array of values in a coupler bc type subroutine extract_coupler_values(BC_struc, BC_index, BC_element, array_out, & is, ie, js, je, conversion) - type(coupler_2d_bc_type), intent(in) :: BC_struc - integer, intent(in) :: BC_index, BC_element - real, dimension(:,:), intent(out) :: array_out - integer, optional, intent(in) :: is, ie, js, je - real, optional, intent(in) :: conversion -! Arguments: BC_struc - The type from which the data is being extracted. -! (in) BC_index - The boundary condition number being extracted. -! (in) BC_element - The element of the boundary condition being extracted. -! This could be ind_csurf, ind_alpha, ind_flux or ind_deposition. -! (out) array_out - The array being filled with the input values. -! (in, opt) is, ie, js, je - The i- and j- limits of array_out to be filled. -! These must match the size of the corresponding value array or an -! error message is issued. -! (in, opt) conversion - A number that every element is multiplied by, to -! permit sign convention or unit conversion. - + type(coupler_2d_bc_type), intent(in) :: BC_struc !< The type from which the data is being extracted. + integer, intent(in) :: BC_index !< The boundary condition number being extracted. + integer, intent(in) :: BC_element !< The element of the boundary condition being extracted. + real, dimension(:,:), intent(out) :: array_out !< The array being filled with the input values. + integer, optional, intent(in) :: is !< Start i-index + integer, optional, intent(in) :: ie !< End i-index + integer, optional, intent(in) :: js !< Start j-index + integer, optional, intent(in) :: je !< End j-index + real, optional, intent(in) :: conversion !< A number that every element is multiplied by, to + !! permit sign convention or unit conversion. + ! Local variables real, pointer, dimension(:,:) :: Array_in real :: conv integer :: i, j, is0, ie0, js0, je0, i_offset, j_offset @@ -78,24 +74,21 @@ subroutine extract_coupler_values(BC_struc, BC_index, BC_element, array_out, & end subroutine extract_coupler_values +!> Set an array of values in a coupler bc type subroutine set_coupler_values(array_in, BC_struc, BC_index, BC_element, & is, ie, js, je, conversion) - real, dimension(:,:), intent(in) :: array_in - type(coupler_2d_bc_type), intent(inout) :: BC_struc - integer, intent(in) :: BC_index, BC_element - integer, optional, intent(in) :: is, ie, js, je - real, optional, intent(in) :: conversion -! Arguments: array_in - The array containing the values to load into the BC. -! (out) BC_struc - The type into which the data is being loaded. -! (in) BC_index - The boundary condition number being extracted. -! (in) BC_element - The element of the boundary condition being extracted. -! This could be ind_csurf, ind_alpha, ind_flux or ind_deposition. -! (in, opt) is, ie, js, je - The i- and j- limits of array_out to be filled. -! These must match the size of the corresponding value array or an -! error message is issued. -! (in, opt) conversion - A number that every element is multiplied by, to -! permit sign convention or unit conversion. - + real, dimension(:,:), intent(in) :: array_in !< The array containing the values to load into the BC. + type(coupler_2d_bc_type), intent(inout) :: BC_struc !< The type from which the data is being extracted. + integer, intent(in) :: BC_index !< The boundary condition number being extracted. + integer, intent(in) :: BC_element !< The element of the boundary condition being extracted. + !! This could be ind_csurf, ind_alpha, ind_flux or ind_deposition. + integer, optional, intent(in) :: is !< Start i-index + integer, optional, intent(in) :: ie !< End i-index + integer, optional, intent(in) :: js !< Start j-index + integer, optional, intent(in) :: je !< End j-index + real, optional, intent(in) :: conversion !< A number that every element is multiplied by, to + !! permit sign convention or unit conversion. + ! Local variables real, pointer, dimension(:,:) :: Array_out real :: conv integer :: i, j, is0, ie0, js0, je0, i_offset, j_offset diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 3b17b54b26..a09a5bfe29 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -1,21 +1,15 @@ +!> Top-level module for the MOM6 ocean model in coupled mode. module ocean_model_mod ! 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 @@ -221,15 +215,12 @@ module ocean_model_mod contains -!======================================================================= -! -! -! -! Initialize the ocean model. -! - !> 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) type(ocean_public_type), target, & intent(inout) :: Ocean_sfc !< A structure containing various publicly @@ -246,11 +237,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) !! in the calculation of additional gas or other !! tracer fluxes, and can be used to spawn related !! internal variables in the ice model. - -! 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. - + ! Local variables real :: Rho0 ! The Boussinesq ocean density, in kg m-3. real :: G_Earth ! The gravitational acceleration in m s-2. ! This include declares and sets the variable "version". @@ -408,17 +395,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) 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. -! -! !> 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 @@ -449,7 +425,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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 @@ -676,20 +652,6 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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. -! -! !> This subroutine writes out the ocean model restart file. subroutine ocean_model_restart(OS, timestamp) @@ -728,13 +690,6 @@ subroutine ocean_model_restart(OS, timestamp) end subroutine ocean_model_restart ! NAME="ocean_model_restart" -!======================================================================= -! -! -! -! Close down the ocean model -! - !> 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) @@ -745,22 +700,11 @@ subroutine ocean_model_end(Ocean_sfc, Ocean_state, Time) !! upon termination. type(time_type), intent(in) :: Time !< The model time, used for writing restarts. -! This subroutine terminates the model run, saving the ocean state in a -! restart file and deallocating any data associated with the ocean. - -! Arguments: Ocean_sfc - An ocean_public_type structure that is to be -! deallocated upon termination. -! (inout) Ocean_state - A pointer to the structure containing the internal -! ocean state to be deallocated upon termination. -! (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) 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. @@ -772,12 +716,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. @@ -804,8 +742,7 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) end subroutine ocean_model_save_restart -!======================================================================= - +!> 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 ocean model domain description @@ -860,6 +797,11 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, end subroutine initialize_ocean_public_type +!> 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. @@ -871,11 +813,7 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z 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. -! 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. + ! Local variables real :: IgR0 character(len=48) :: val_str integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd @@ -968,15 +906,6 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z end subroutine convert_state_to_ocean_type - -!======================================================================= -! -! -! -! This subroutine extracts the surface properties from the ocean's internal -! state and stores them in the ocean type returned to the calling ice model. -! - !> 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 @@ -986,7 +915,6 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) 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 @@ -998,7 +926,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 @@ -1023,9 +950,6 @@ 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. diff --git a/config_src/solo_driver/MESO_surface_forcing.F90 b/config_src/solo_driver/MESO_surface_forcing.F90 index a1c20b635c..eaa11da6c1 100644 --- a/config_src/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/solo_driver/MESO_surface_forcing.F90 @@ -1,48 +1,8 @@ +!> Sets forcing for the MESO configuration module MESO_surface_forcing ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* Rewritten by Robert Hallberg, June 2009 * -!* * -!* This file contains the subroutines that a user should modify to * -!* to set the surface wind stresses and fluxes of buoyancy or * -!* temperature and fresh water. They are called when the run-time * -!* parameters WIND_CONFIG or BUOY_CONFIG are set to "USER". The * -!* standard version has simple examples, along with run-time error * -!* messages that will cause the model to abort if this code has not * -!* been modified. This code is intended for use with relatively * -!* simple specifications of the forcing. For more complicated forms, * -!* it is probably a good idea to read the forcing from input files * -!* using "file" for WIND_CONFIG and BUOY_CONFIG. * -!* * -!* MESO_wind_forcing should set the surface wind stresses (taux and * -!* tauy) perhaps along with the surface friction velocity (ustar). * -!* * -!* MESO_buoyancy forcing is used to set the surface buoyancy * -!* forcing, which may include a number of fresh water flux fields * -!* (evap, liq_precip, froz_precip, liq_runoff, froz_runoff, and * -!* vprec) and the surface heat fluxes (sw, lw, latent and sens) * -!* if temperature and salinity are state variables, or it may simply * -!* be the buoyancy flux if it is not. This routine also has coded a * -!* restoring to surface values of temperature and salinity. * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v, tauy * -!* j x ^ x ^ x At >: u, taux * -!* j > o > o > At o: h, fluxes. * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** use MOM_diag_mediator, only : post_data, query_averaging_enabled use MOM_diag_mediator, only : register_diag_field, diag_ctrl, safe_alloc_ptr use MOM_domains, only : pass_var, pass_vector, AGRID @@ -408,4 +368,30 @@ subroutine MESO_surface_forcing_init(Time, G, param_file, diag, CS) end subroutine MESO_surface_forcing_init +!> \namespace meso_surface_forcing +!! +!! Rewritten by Robert Hallberg, June 2009 +!! +!! This file contains the subroutines that a user should modify to +!! to set the surface wind stresses and fluxes of buoyancy or +!! temperature and fresh water. They are called when the run-time +!! parameters WIND_CONFIG or BUOY_CONFIG are set to "USER". The +!! standard version has simple examples, along with run-time error +!! messages that will cause the model to abort if this code has not +!! been modified. This code is intended for use with relatively +!! simple specifications of the forcing. For more complicated forms, +!! it is probably a good idea to read the forcing from input files +!! using "file" for WIND_CONFIG and BUOY_CONFIG. +!! +!! MESO_wind_forcing should set the surface wind stresses (taux and +!! tauy) perhaps along with the surface friction velocity (ustar). +!! +!! MESO_buoyancy forcing is used to set the surface buoyancy +!! forcing, which may include a number of fresh water flux fields +!! (evap, liq_precip, froz_precip, liq_runoff, froz_runoff, and +!! vprec) and the surface heat fluxes (sw, lw, latent and sens) +!! if temperature and salinity are state variables, or it may simply +!! be the buoyancy flux if it is not. This routine also has coded a +!! restoring to surface values of temperature and salinity. + end module MESO_surface_forcing diff --git a/config_src/solo_driver/coupler_types.F90 b/config_src/solo_driver/coupler_types.F90 index d1264e5d6b..10d22a8eff 100644 --- a/config_src/solo_driver/coupler_types.F90 +++ b/config_src/solo_driver/coupler_types.F90 @@ -1,12 +1,13 @@ +!> This module contains the coupler-type declarations and methods for use in +!! ocean-only configurations of MOM6. +!! +!! It is intended that the version of coupler_types_mod that is avialable from +!! FMS will conform to this version with the FMS city release after warsaw. + module coupler_types_mod ! This file is part of MOM6. See LICENSE.md for the license. -! This module contains the coupler-type declarations and methods for use in -! ocean-only configurations of MOM6. It is intended that the version of -! coupler_types_mod that is avialable from FMS will conform to this version with -! the FMS city release after warsaw. - use fms_io_mod, only: restart_file_type, register_restart_field use fms_io_mod, only: query_initialized, restore_state use time_manager_mod, only: time_type diff --git a/config_src/solo_driver/coupler_util.F90 b/config_src/solo_driver/coupler_util.F90 index dde67c2976..cc63a9563d 100644 --- a/config_src/solo_driver/coupler_util.F90 +++ b/config_src/solo_driver/coupler_util.F90 @@ -1,9 +1,9 @@ +!> Provides a couple of interfaces to allow more transparent and +!! robust extraction of the various fields in the coupler types. module coupler_util ! This file is part of MOM6. See LICENSE.md for the license. -! This code provides a couple of interfaces to allow more transparent and -! robust extraction of the various fields in the coupler types. use MOM_error_handler, only : MOM_error, FATAL, WARNING use coupler_types_mod, only : coupler_2d_bc_type, ind_flux, ind_alpha use coupler_types_mod, only : ind_csurf @@ -15,24 +15,19 @@ module coupler_util contains +!> Extract an array of values in a coupler bc type subroutine extract_coupler_values(BC_struc, BC_index, BC_element, array_out, & is, ie, js, je, conversion) - type(coupler_2d_bc_type), intent(in) :: BC_struc - integer, intent(in) :: BC_index, BC_element - real, dimension(:,:), intent(out) :: array_out - integer, optional, intent(in) :: is, ie, js, je - real, optional, intent(in) :: conversion -! Arguments: BC_struc - The type from which the data is being extracted. -! (in) BC_index - The boundary condition number being extracted. -! (in) BC_element - The element of the boundary condition being extracted. -! This could be ind_csurf, ind_alpha, ind_flux or ind_deposition. -! (out) array_out - The array being filled with the input values. -! (in, opt) is, ie, js, je - The i- and j- limits of array_out to be filled. -! These must match the size of the corresponding value array or an -! error message is issued. -! (in, opt) conversion - A number that every element is multiplied by, to -! permit sign convention or unit conversion. - + type(coupler_2d_bc_type), intent(in) :: BC_struc !< The type from which the data is being extracted. + integer, intent(in) :: BC_index !< The boundary condition number being extracted. + integer, intent(in) :: BC_element !< The element of the boundary condition being extracted. + real, dimension(:,:), intent(out) :: array_out !< The array being filled with the input values. + integer, optional, intent(in) :: is !< Start i-index + integer, optional, intent(in) :: ie !< End i-index + integer, optional, intent(in) :: js !< Start j-index + integer, optional, intent(in) :: je !< End j-index + real, optional, intent(in) :: conversion !< A number that every element is multiplied by, to + ! Local variables real, pointer, dimension(:,:) :: Array_in real :: conv integer :: i, j, is0, ie0, js0, je0, i_offset, j_offset @@ -78,24 +73,20 @@ subroutine extract_coupler_values(BC_struc, BC_index, BC_element, array_out, & end subroutine extract_coupler_values +!> Set an array of values in a coupler bc type subroutine set_coupler_values(array_in, BC_struc, BC_index, BC_element, & is, ie, js, je, conversion) - real, dimension(:,:), intent(in) :: array_in - type(coupler_2d_bc_type), intent(inout) :: BC_struc - integer, intent(in) :: BC_index, BC_element - integer, optional, intent(in) :: is, ie, js, je - real, optional, intent(in) :: conversion -! Arguments: array_in - The array containing the values to load into the BC. -! (out) BC_struc - The type into which the data is being loaded. -! (in) BC_index - The boundary condition number being extracted. -! (in) BC_element - The element of the boundary condition being extracted. -! This could be ind_csurf, ind_alpha, ind_flux or ind_deposition. -! (in, opt) is, ie, js, je - The i- and j- limits of array_out to be filled. -! These must match the size of the corresponding value array or an -! error message is issued. -! (in, opt) conversion - A number that every element is multiplied by, to -! permit sign convention or unit conversion. - + real, dimension(:,:), intent(in) :: array_in !< The array containing the values to load into the BC. + type(coupler_2d_bc_type), intent(inout) :: BC_struc !< The type from which the data is being extracted. + integer, intent(in) :: BC_index !< The boundary condition number being extracted. + integer, intent(in) :: BC_element !< The element of the boundary condition being extracted. + integer, optional, intent(in) :: is !< Start i-index + integer, optional, intent(in) :: ie !< End i-index + integer, optional, intent(in) :: js !< Start j-index + integer, optional, intent(in) :: je !< End j-index + real, optional, intent(in) :: conversion !< A number that every element is multiplied by, to + !! permit sign convention or unit conversion. + ! Local variables real, pointer, dimension(:,:) :: Array_out real :: conv integer :: i, j, is0, ie0, js0, je0, i_offset, j_offset diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 9e33651b86..6f93c7b0f0 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -1,31 +1,14 @@ +!> Debug accelerations at a given point +!! +!! The two subroutines in this file write out all of the terms +!! in the u- or v-momentum balance at a given point. Usually +!! these subroutines are called after the velocities exceed some +!! threshold, in order to determine which term is culpable. +!! often this is done for debugging purposes. module MOM_PointAccel ! This file is part of MOM6. See LICENSE.md for the license. -!*********************************************************************** -!* * -!* The two subroutines in this file write out all of the terms * -!* in the u- or v-momentum balance at a given point. Usually * -!* these subroutines are called after the velocities exceed some * -!* threshold, in order to determine which term is culpable. * -!* often this is done for debugging purposes. * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q, CoriolisBu * -!* j+1 > o > o > At ^: v, PFv, CAv, vh, diffv, vbt, vhtr * -!* j x ^ x ^ x At >: u, PFu, CAu, uh, diffu, ubt, uhtr * -!* j > o > o > At o: h, bathyT, tr, T, S * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_diag_mediator, only : diag_ctrl use MOM_domains, only : pe_here use MOM_error_handler, only : MOM_error, NOTE @@ -106,11 +89,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, !! from vertvisc, in m. - -! This subroutine writes to an output file all of the accelerations -! that have been applied to a column of zonal velocities over the -! previous timestep. This subroutine is called from vertvisc. - + ! Local variables real :: f_eff, CFL real :: Angstrom real :: truncvel, du @@ -438,11 +417,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, !! from vertvisc, in m. - -! This subroutine writes to an output file all of the accelerations -! that have been applied to a column of meridional velocities over -! the previous timestep. This subroutine is called from vertvisc. - + ! Local variables real :: f_eff, CFL real :: Angstrom real :: truncvel, dv @@ -758,7 +733,6 @@ subroutine PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS) !! directory paths. type(PointAccel_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module. - ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_PointAccel" ! This module's name. @@ -801,4 +775,5 @@ subroutine PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS) CS%u_file = -1 ; CS%v_file = -1 ; CS%cols_written = 0 end subroutine PointAccel_init + end module MOM_PointAccel diff --git a/src/diagnostics/MOM_debugging.F90 b/src/diagnostics/MOM_debugging.F90 index 8bc4abea31..768caf0811 100644 --- a/src/diagnostics/MOM_debugging.F90 +++ b/src/diagnostics/MOM_debugging.F90 @@ -1,14 +1,13 @@ +!> Provides checksumming functions for debugging +!! +!! This module contains subroutines that perform various error checking and +!! debugging functions for MOM6. This routine is similar to it counterpart in +!! the SIS2 code, except for the use of the ocean_grid_type and by keeping them +!! separate we retain the ability to set up MOM6 and SIS2 debugging separately. module MOM_debugging ! This file is part of MOM6. See LICENSE.md for the license. -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -! This module contains subroutines that perform various error checking and ! -! debugging functions for MOM6. This routine is similar to it counterpart in ! -! the SIS2 code, except for the use of the ocean_grid_type and by keeping them ! -! separate we retain the ability to set up MOM6 and SIS2 debugging separately. ! -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! - use MOM_checksums, only : hchksum, Bchksum, qchksum, uvchksum use MOM_checksums, only : is_NaN, chksum, MOM_checksums_init use MOM_coms, only : PE_here, root_PE, num_PEs, sum_across_PEs @@ -66,16 +65,16 @@ module MOM_debugging module procedure chksum_vec_A3d, chksum_vec_A2d end interface vec_chksum_A -integer :: max_redundant_prints = 100 -integer :: redundant_prints(3) = 0 -logical :: debug = .false. -logical :: debug_chksums = .true. -logical :: debug_redundant = .true. +! Note: these parameters are module data but ONLY used when debugging and +! so can violate the thread-safe requirement of no module/global data. +integer :: max_redundant_prints = 100 !< Maximum number of times to write redundant messages +integer :: redundant_prints(3) = 0 !< Counters for controlling redundant printing +logical :: debug = .false. !< Write out verbose debugging data +logical :: debug_chksums = .true. !< Perform checksums on arrays +logical :: debug_redundant = .true. !< Check redundant contains -! ===================================================================== - !> MOM_debugging_init initializes the MOM_debugging module, and sets !! the parameterts that control which checks are active for MOM6. subroutine MOM_debugging_init(param_file) @@ -116,7 +115,7 @@ subroutine check_redundant_vC3d(mesg, u_comp, v_comp, G, is, ie, js, je, & integer, optional, intent(in) :: je !< The ending j-index to check integer, optional, intent(in) :: direction !< the direction flag to be !! passed to pass_vector - + ! Local variables character(len=24) :: mesg_k integer :: k @@ -152,9 +151,9 @@ subroutine check_redundant_vC2d(mesg, u_comp, v_comp, G, is, ie, js, je, & real :: u_resym(G%IsdB:G%IedB,G%jsd:G%jed) real :: v_resym(G%isd:G%ied,G%JsdB:G%JedB) character(len=128) :: mesg2 - integer :: i, j, is_ch, ie_ch, js_ch, je_ch integer :: Isq, Ieq, Jsq, Jeq, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + 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 @@ -241,14 +240,13 @@ subroutine check_redundant_sB2d(mesg, array, G, is, ie, js, je) integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check - ! Local variables real :: a_nonsym(G%isd:G%ied,G%jsd:G%jed) real :: a_resym(G%IsdB:G%IedB,G%JsdB:G%JedB) character(len=128) :: mesg2 - integer :: i, j, is_ch, ie_ch, js_ch, je_ch integer :: Isq, Ieq, Jsq, Jeq, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + 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 @@ -306,7 +304,6 @@ subroutine check_redundant_vB3d(mesg, u_comp, v_comp, G, is, ie, js, je, & integer, optional, intent(in) :: je !< The ending j-index to check integer, optional, intent(in) :: direction !< the direction flag to be !! passed to pass_vector - ! Local variables character(len=24) :: mesg_k integer :: k @@ -337,16 +334,15 @@ subroutine check_redundant_vB2d(mesg, u_comp, v_comp, G, is, ie, js, je, & integer, optional, intent(in) :: je !< The ending j-index to check integer, optional, intent(in) :: direction !< the direction flag to be !! passed to pass_vector - ! Local variables real :: u_nonsym(G%isd:G%ied,G%jsd:G%jed) real :: v_nonsym(G%isd:G%ied,G%jsd:G%jed) real :: u_resym(G%IsdB:G%IedB,G%JsdB:G%JedB) real :: v_resym(G%IsdB:G%IedB,G%JsdB:G%JedB) character(len=128) :: mesg2 - integer :: i, j, is_ch, ie_ch, js_ch, je_ch integer :: Isq, Ieq, Jsq, Jeq, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + 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 @@ -409,7 +405,6 @@ subroutine check_redundant_sT3d(mesg, array, G, is, ie, js, je) integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check - ! Local variables character(len=24) :: mesg_k integer :: k @@ -435,7 +430,6 @@ subroutine check_redundant_sT2d(mesg, array, G, is, ie, js, je) integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check - ! Local variables real :: a_nonsym(G%isd:G%ied,G%jsd:G%jed) character(len=128) :: mesg2 @@ -516,13 +510,7 @@ subroutine check_redundant_vT2d(mesg, u_comp, v_comp, G, is, ie, js, je, & integer, optional, intent(in) :: je !< The ending j-index to check integer, optional, intent(in) :: direction !< the direction flag to be !! passed to pass_vector -! Arguments: u_comp - The u-component of the vector being checked. -! (in) v_comp - The v-component of the vector being checked. -! (in) mesg - A message indicating what is being checked. -! (in) G - The ocean's grid structure. -! (in/opt) is, ie, js, je - the i- and j- range of indices to check. -! (in/opt) direction - the direction flag to be passed to pass_vector. - + ! Local variables real :: u_nonsym(G%isd:G%ied,G%jsd:G%jed) real :: v_nonsym(G%isd:G%ied,G%jsd:G%jed) character(len=128) :: mesg2 @@ -571,8 +559,6 @@ subroutine check_redundant_vT2d(mesg, u_comp, v_comp, G, is, ie, js, je, & end subroutine check_redundant_vT2d -! ===================================================================== - !> Do a checksum and redundant point check on a 3d C-grid vector. subroutine chksum_vec_C3d(mesg, u_comp, v_comp, G, halos, scalars) character(len=*), intent(in) :: mesg !< An identifying message @@ -582,7 +568,7 @@ subroutine chksum_vec_C3d(mesg, u_comp, v_comp, G, halos, scalars) integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of !! scalars that are being checked. - + ! Local variables logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars @@ -608,7 +594,7 @@ subroutine chksum_vec_C2d(mesg, u_comp, v_comp, G, halos, scalars) integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of !! scalars that are being checked. - + ! Local variables logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars @@ -634,7 +620,7 @@ subroutine chksum_vec_B3d(mesg, u_comp, v_comp, G, halos, scalars) integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of !! scalars that are being checked. - + ! Local variables logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars @@ -663,7 +649,7 @@ subroutine chksum_vec_B2d(mesg, u_comp, v_comp, G, halos, scalars, symmetric) !! scalars that are being checked. logical, optional, intent(in) :: symmetric !< If true, do the checksums on the !! full symmetric computational domain. - + ! Local variables logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars @@ -690,7 +676,7 @@ subroutine chksum_vec_A3d(mesg, u_comp, v_comp, G, halos, scalars) integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of !! scalars that are being checked. - + ! Local variables logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars @@ -708,7 +694,6 @@ subroutine chksum_vec_A3d(mesg, u_comp, v_comp, G, halos, scalars) end subroutine chksum_vec_A3d - !> Do a checksum and redundant point check on a 2d C-grid vector. subroutine chksum_vec_A2d(mesg, u_comp, v_comp, G, halos, scalars) character(len=*), intent(in) :: mesg !< An identifying message @@ -718,7 +703,7 @@ subroutine chksum_vec_A2d(mesg, u_comp, v_comp, G, halos, scalars) integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of !! scalars that are being checked. - + ! Local variables logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars @@ -736,9 +721,6 @@ subroutine chksum_vec_A2d(mesg, u_comp, v_comp, G, halos, scalars) end subroutine chksum_vec_A2d - -! ===================================================================== - !> This function returns the sum over computational domain of all !! processors of hThick*stuff, where stuff is a 3-d array at tracer points. function totalStuff(HI, hThick, areaT, stuff) @@ -747,7 +729,6 @@ function totalStuff(HI, hThick, areaT, stuff) real, dimension(HI%isd:,HI%jsd:), intent(in) :: areaT !< The array of cell areas in m2 real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: stuff !< The array of stuff to be summed real :: totalStuff !< the globally integrated amoutn of stuff - ! Local variables integer :: i, j, k, nz @@ -760,12 +741,8 @@ function totalStuff(HI, hThick, areaT, stuff) end function totalStuff -! ===================================================================== - !> This subroutine display the total thickness, temperature and salinity !! as well as the change since the last call. -!! NOTE: This subroutine uses "save" data which is not thread safe and is purely -!! for extreme debugging without a proper debugger. subroutine totalTandS(HI, hThick, areaT, temperature, salinity, mesg) type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: hThick !< The array of thicknesses to use as weights @@ -773,11 +750,10 @@ subroutine totalTandS(HI, hThick, areaT, temperature, salinity, mesg) real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: temperature !< The temperature field to sum real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: salinity !< The salinity field to sum character(len=*), intent(in) :: mesg !< An identifying message - ! NOTE: This subroutine uses "save" data which is not thread safe and is purely for ! extreme debugging without a proper debugger. real, save :: totalH = 0., totalT = 0., totalS = 0. - + ! Local variables logical, save :: firstCall = .true. real :: thisH, thisT, thisS, delH, delT, delS integer :: i, j, k, nz @@ -850,8 +826,6 @@ logical function check_column_integrals(nk_1, field_1, nk_2, field_2, missing_va real, dimension(nk_2), intent(in) :: field_2 !< Second field to be summed real, optional, intent(in) :: missing_value !< If column contains missing values, !! mask them from the sum - - ! Local variables real :: u1_sum, error1, u2_sum, error2, misval integer :: k diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index 25178d7d69..77e49442af 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -1,29 +1,11 @@ -Module MOM_diag_to_Z +!> Maps tracers and velocities into depth space for output as diagnostic quantities. +!! +!! Currently, a piecewise linear subgrid structure is used for tracers, while velocities can +!! use either piecewise constant or piecewise linear structures. +module MOM_diag_to_Z ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, July 2006 * -!* * -!* This subroutine maps tracers and velocities into depth space * -!* for output as diagnostic quantities. Currently, a piecewise * -!* linear subgrid structure is used for tracers, while velocities can * -!* use either piecewise constant or piecewise linear structures. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q, CoriolisBu * -!* j+1 > o > o > At ^: v * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, bathyT * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** use MOM_domains, only : pass_var use MOM_coms, only : reproducing_sum use MOM_diag_mediator, only : post_data, post_data_1d_k, register_diag_field, safe_alloc_ptr @@ -98,7 +80,7 @@ Module MOM_diag_to_Z end type diag_to_Z_CS -integer, parameter :: NO_ZSPACE = -1 +integer, parameter :: NO_ZSPACE = -1 !< Flag to enable z-space? contains @@ -110,7 +92,7 @@ function global_z_mean(var,G,CS,tracer) real, dimension(SZI_(G), SZJ_(G), CS%nk_zspace), & intent(in) :: var !< An array with the variable to average integer, intent(in) :: tracer !< The tracer index being worked on - + ! Local variables real, dimension(SZI_(G), SZJ_(G), CS%nk_zspace) :: tmpForSumming, weight real, dimension(CS%nk_zspace) :: global_z_mean, scalarij, weightij real, dimension(CS%nk_zspace) :: global_temp_scalar, global_weight_scalar @@ -170,9 +152,6 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) !! ice shelf, or unassocatiaed if there is no shelf type(diag_to_Z_CS), pointer :: CS !< Control structure returned by a previous call !! to diag_to_Z_init. - -! This subroutine maps tracers and velocities into depth space for diagnostics. - ! Local variables ! Note the deliberately reversed axes in h_f, u_f, v_f, and tr_f. real :: ssh(SZI_(G),SZJ_(G)) ! copy of ssh_in (meter or kg/m2) @@ -524,9 +503,6 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) type(diag_to_Z_CS), pointer :: CS !< Control structure returned by !! previous call to !! diag_to_Z_init. - -! This subroutine maps horizontal transport into depth space for diagnostic output. - ! Local variables real, dimension(SZI_(G), SZJ_(G)) :: & htot, & ! total layer thickness (meter or kg/m2) @@ -690,7 +666,6 @@ subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z real, dimension(:), intent(out) :: z2 !< Depths of the bottom limit of the part of !! a layer that contributes to a depth level, relative to the cell center and normalized !! by the cell thickness (nondim). Note that -1/2 <= z1 < z2 <= 1/2. - ! Local variables real :: Ih, e_c, tot_wt, I_totwt integer :: k @@ -737,9 +712,6 @@ subroutine find_limited_slope(val, e, slope, k) real, dimension(:), intent(in) :: e !< Column interface heights (meter or kg/m2). real, intent(out) :: slope !< Normalized slope in the intracell distribution of val. integer, intent(in) :: k !< Layer whose slope is being determined. - -! This subroutine determines a limited slope for val to be advected with -! a piecewise limited scheme. ! Local variables real :: d1, d2 @@ -770,7 +742,6 @@ subroutine calc_Zint_diags(h, in_ptrs, ids, num_diags, G, GV, CS) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(diag_to_Z_CS), pointer :: CS !< Control structure returned by !! previous call to diag_to_Z_init. - ! Local variables real, dimension(SZI_(G),SZJ_(G),max(CS%nk_zspace+1,1),max(num_diags,1)) :: & diag_on_Z ! diagnostics interpolated to depth space @@ -929,7 +900,6 @@ subroutine register_Z_tracer_low(tr_ptr, name, long_name, units, standard_name, type(time_type), intent(in) :: Time !< Current model time. type(diag_to_Z_CS), pointer :: CS !< Control struct returned by previous call to !! diag_to_Z_init. - ! Local variables character(len=256) :: posted_standard_name integer :: isd, ied, jsd, jed, nk, m, id_test @@ -983,10 +953,8 @@ subroutine MOM_diag_to_Z_init(Time, G, GV, param_file, diag, CS) type(diag_to_Z_CS), pointer :: CS !< Pointer to point to control structure for !! this module, which is allocated and !! populated here. - ! This include declares and sets the variable "version". #include "version_variable.h" - ! Local variables character(len=40) :: mdl = "MOM_diag_to_Z" ! module name character(len=200) :: in_dir, zgrid_file ! strings for directory/file @@ -1084,7 +1052,6 @@ subroutine get_Z_depths(depth_file, int_depth_name, int_depth, cell_depth_name, integer, intent(out) :: z_axis_index !< The cell-center z-axis diagnostic index handle integer, intent(out) :: edge_index !< The interface z-axis diagnostic index handle integer, intent(out) :: nk_out !< The number of layers in the output grid - ! Local variables real, allocatable :: cell_depth(:) character (len=200) :: units, long_name @@ -1216,7 +1183,6 @@ function ocean_register_diag_with_z(tr_ptr, vardesc_tr, G, Time, CS) type(diag_to_Z_CS), pointer :: CS !< Control struct returned by a previous !! call to diag_to_Z_init. integer :: ocean_register_diag_with_z !< The retuned Z-space diagnostic ID - ! Local variables type(vardesc) :: vardesc_z character(len=64) :: var_name ! A variable's name. @@ -1273,7 +1239,6 @@ function register_Z_diag(var_desc, CS, day, missing) !! previous call to diag_to_Z_init. type(time_type), intent(in) :: day !< The current model time real, intent(in) :: missing !< The missing value for this diagnostic - ! Local variables character(len=64) :: var_name ! A variable's name. character(len=48) :: units ! A variable's units. @@ -1328,7 +1293,6 @@ function register_Zint_diag(var_desc, CS, day) type(diag_to_Z_CS), pointer :: CS !< Control structure returned by !! previous call to diag_to_Z_init. type(time_type), intent(in) :: day !< The current model time - ! Local variables character(len=64) :: var_name ! A variable's name. character(len=48) :: units ! A variable's units. @@ -1364,5 +1328,4 @@ function register_Zint_diag(var_desc, CS, day) end function register_Zint_diag - end module MOM_diag_to_Z diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 46019b0c4d..f200a15bed 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1,29 +1,10 @@ +!> Calculates any requested diagnostic quantities +!! that are not calculated in the various subroutines. +!! Diagnostic quantities are requested by allocating them memory. module MOM_diagnostics ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, February 2001 * -!* * -!* This subroutine calculates any requested diagnostic quantities * -!* that are not calculated in the various subroutines. Diagnostic * -!* quantities are requested by allocating them memory. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q, CoriolisBu * -!* j+1 > o > o > At ^: v * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, bathyT * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_coms, only : reproducing_sum use MOM_diag_mediator, only : post_data, post_data_1d_k, get_diag_time_end use MOM_diag_mediator, only : register_diag_field, register_scalar_field diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 3f23687fef..3392f85437 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -1,42 +1,8 @@ +!> Reports integrated quantities for monitoring the model state module MOM_sum_output ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, April 1994 - June 2002 * -!* * -!* This file contains the subroutine (write_energy) that writes * -!* horizontally integrated quantities, such as energies and layer * -!* volumes, and other summary information to an output file. Some * -!* of these quantities (APE or resting interface height) are defined * -!* relative to the global histogram of topography. The subroutine * -!* that compiles that histogram (depth_list_setup) is also included * -!* in this file. * -!* * -!* In addition, if the number of velocity truncations since the * -!* previous call to write_energy exceeds maxtrunc or the total energy * -!* exceeds a very large threshold, a fatal termination is triggered. * -!* * -!* This file also contains a few miscelaneous initialization * -!* calls to FMS-related modules. * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, bathyT * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_coms, only : sum_across_PEs, PE_here, root_PE, num_PEs, max_across_PEs use MOM_coms, only : reproducing_sum, EFP_to_real, real_to_EFP use MOM_coms, only : EFP_type, operator(+), operator(-), assignment(=) @@ -66,9 +32,7 @@ module MOM_sum_output public write_energy, accumulate_net_input, MOM_sum_output_init -!----------------------------------------------------------------------- - -integer, parameter :: NUM_FIELDS = 17 +integer, parameter :: NUM_FIELDS = 17 !< Number of diagnostic fields !> A list of depths and corresponding globally integrated ocean area at each !! depth and the ocean volume below each depth. @@ -323,7 +287,6 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc type(ocean_OBC_type), & optional, pointer :: OBC !< Open boundaries control structure. type(time_type), optional, intent(in) :: dt_forcing !< The forcing time step - ! Local variables real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! The height of interfaces, in m. real :: areaTm(SZI_(G),SZJ_(G)) ! A masked version of areaT, in m2. @@ -949,7 +912,6 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(Sum_output_CS), pointer :: CS !< The control structure returned by a previous call !! to MOM_sum_output_init. - ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & FW_in, & ! The net fresh water input, integrated over a timestep in kg. @@ -1068,11 +1030,7 @@ subroutine depth_list_setup(G, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(Sum_output_CS), pointer :: CS !< The control structure returned by a !! previous call to MOM_sum_output_init. -! This subroutine sets up an ordered list of depths, along with the -! cross sectional areas at each depth and the volume of fluid deeper -! than each depth. This might be read from a previously created file -! or it might be created anew. (For now only new creation occurs. - + ! Local variables integer :: k if (CS%read_depth_list) then @@ -1101,7 +1059,6 @@ subroutine create_depth_list(G, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(Sum_output_CS), pointer :: CS !< The control structure set up in MOM_sum_output_init, !! in which the ordered depth list is stored. - ! Local variables real, dimension(G%Domain%niglobal*G%Domain%njglobal + 1) :: & Dlist, & !< The global list of bottom depths, in m. @@ -1229,7 +1186,6 @@ subroutine write_depth_list(G, CS, filename, list_size) !! previous call to MOM_sum_output_init. character(len=*), intent(in) :: filename !< The path to the depth list file to write. integer, intent(in) :: list_size !< The size of the depth list. - ! Local variables real, allocatable :: tmp(:) integer :: ncid, dimid(1), Did, Aid, Vid, status, k @@ -1310,7 +1266,6 @@ subroutine read_depth_list(G, CS, filename) type(Sum_output_CS), pointer :: CS !< The control structure returned by a !! previous call to MOM_sum_output_init. character(len=*), intent(in) :: filename !< The path to the depth list file to read. - ! Local variables character(len=32) :: mdl character(len=240) :: var_name, var_msg @@ -1393,4 +1348,20 @@ subroutine read_depth_list(G, CS, filename) end subroutine read_depth_list +!> \namespace mom_sum_output +!! +!! By Robert Hallberg, April 1994 - June 2002 +!! +!! This file contains the subroutine (write_energy) that writes +!! horizontally integrated quantities, such as energies and layer +!! volumes, and other summary information to an output file. Some +!! of these quantities (APE or resting interface height) are defined +!! relative to the global histogram of topography. The subroutine +!! that compiles that histogram (depth_list_setup) is also included +!! in this file. +!! +!! In addition, if the number of velocity truncations since the +!! previous call to write_energy exceeds maxtrunc or the total energy +!! exceeds a very large threshold, a fatal termination is triggered. + end module MOM_sum_output diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 6b55717daa..0890006c98 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -1,31 +1,14 @@ +!> Vertical structure functions for first baroclinic mode wave speed module MOM_wave_structure ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Benjamin Mater & Robert Hallberg, 2015 * -!* * -!* The subroutine in this module calculates the vertical structure * -!* functions of the first baroclinic mode internal wave speed. * -!* Calculation of interface values is the same as done in * -!* MOM_wave_speed by Hallberg, 2008. * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v, vh, vav * -!* j x ^ x ^ x At >: u, uh, uav * -!* j > o > o > At o: h * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** +! By Benjamin Mater & Robert Hallberg, 2015 + +! The subroutine in this module calculates the vertical structure +! functions of the first baroclinic mode internal wave speed. +! Calculation of interface values is the same as done in +! MOM_wave_speed by Hallberg, 2008. use MOM_debugging, only : isnan => is_NaN use MOM_diag_mediator, only : post_data, query_averaging_enabled, diag_ctrl @@ -74,6 +57,31 @@ module MOM_wave_structure contains !> This subroutine determines the internal wave velocity structure for any mode. +!! +!! This subroutine solves for the eigen vector [vertical structure, e(k)] associated with +!! the first baroclinic mode speed [i.e., smallest eigen value (lam = 1/c^2)] of the +!! system d2e/dz2 = -(N2/cn2)e, or (A-lam*I)e = 0, where A = -(1/N2)(d2/dz2), lam = 1/c^2, +!! and I is the identity matrix. 2nd order discretization in the vertical lets this system +!! be represented as +!! +!! -Igu(k)*e(k-1) + (Igu(k)+Igl(k)-lam)*e(k) - Igl(k)*e(k+1) = 0.0 +!! +!! with rigid lid boundary conditions e(1) = e(nz+1) = 0.0 giving +!! +!! (Igu(2)+Igl(2)-lam)*e(2) - Igl(2)*e(3) = 0.0 +!! -Igu(nz)*e(nz-1) + (Igu(nz)+Igl(nz)-lam)*e(nz) = 0.0 +!! +!! where, upon noting N2 = reduced gravity/layer thickness, we get +!! Igl(k) = 1.0/(gprime(k)*H(k)) ; Igu(k) = 1.0/(gprime(k)*H(k-1)) +!! +!! The eigen value for this system is approximated using "wave_speed." This subroutine uses +!! these eigen values (mode speeds) to estimate the corresponding eigen vectors (velocity +!! structure) using the "inverse iteration with shift" method. The algorithm is +!! +!! Pick a starting vector reasonably close to mode structure and with unit magnitude, b_guess +!! For n=1,2,3,... +!! Solve (A-lam*I)e = e_guess for e +!! Set e_guess=e/|e| and repeat, with each iteration refining the estimate of e subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid @@ -96,34 +104,6 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) logical,optional, intent(in) :: full_halos !< If true, do the calculation !! over the entire computational !! domain. - -! This subroutine determines the internal wave velocity structure for any mode. -! -! This subroutine solves for the eigen vector [vertical structure, e(k)] associated with -! the first baroclinic mode speed [i.e., smallest eigen value (lam = 1/c^2)] of the -! system d2e/dz2 = -(N2/cn2)e, or (A-lam*I)e = 0, where A = -(1/N2)(d2/dz2), lam = 1/c^2, -! and I is the identity matrix. 2nd order discretization in the vertical lets this system -! be represented as -! -! -Igu(k)*e(k-1) + (Igu(k)+Igl(k)-lam)*e(k) - Igl(k)*e(k+1) = 0.0 -! -! with rigid lid boundary conditions e(1) = e(nz+1) = 0.0 giving -! -! (Igu(2)+Igl(2)-lam)*e(2) - Igl(2)*e(3) = 0.0 -! -Igu(nz)*e(nz-1) + (Igu(nz)+Igl(nz)-lam)*e(nz) = 0.0 -! -! where, upon noting N2 = reduced gravity/layer thickness, we get -! Igl(k) = 1.0/(gprime(k)*H(k)) ; Igu(k) = 1.0/(gprime(k)*H(k-1)) -! -! The eigen value for this system is approximated using "wave_speed." This subroutine uses -! these eigen values (mode speeds) to estimate the corresponding eigen vectors (velocity -! structure) using the "inverse iteration with shift" method. The algorithm is -! -! Pick a starting vector reasonably close to mode structure and with unit magnitude, b_guess -! For n=1,2,3,... -! Solve (A-lam*I)e = e_guess for e -! Set e_guess=e/|e| and repeat, with each iteration refining the estimate of e - ! Local variables real, dimension(SZK_(G)+1) :: & dRho_dT, dRho_dS, & @@ -585,7 +565,7 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) end subroutine wave_structure -!> This subroutine solves a tri-diagonal system Ax=y using either the standard +!> Solves a tri-diagonal system Ax=y using either the standard !! Thomas algorithm (TDMA_T) or its more stable variant that invokes the !! "Hallberg substitution" (TDMA_H). subroutine tridiag_solver(a, b, c, h, y, method, x) @@ -602,7 +582,6 @@ subroutine tridiag_solver(a, b, c, h, y, method, x) real, dimension(:), intent(in) :: y !< vector of known values on right hand side. character(len=*), intent(in) :: method !< A string describing the algorithm to use real, dimension(:), intent(out) :: x !< vector of unknown values to solve for. - ! Local variables integer :: nrow ! number of rows in A matrix real, allocatable, dimension(:,:) :: A_check ! for solution checking @@ -721,7 +700,6 @@ subroutine wave_structure_init(Time, G, param_file, diag, CS) !! diagnostic output. type(wave_structure_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module. - ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_wave_structure" ! This module's name. @@ -757,5 +735,4 @@ subroutine wave_structure_init(Time, G, param_file, diag, CS) end subroutine wave_structure_init - end module MOM_wave_structure diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 8dcacb3e60..ec6ce0fffa 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -1,3 +1,4 @@ +!> Initialize ice shelf variables module MOM_ice_shelf_initialize ! This file is part of MOM6. See LICENSE.md for the license. @@ -12,14 +13,13 @@ module MOM_ice_shelf_initialize #include - !MJHpublic initialize_ice_shelf_boundary, initialize_ice_thickness public initialize_ice_thickness contains -subroutine initialize_ice_thickness (h_shelf, area_shelf_h, hmask, G, PF) - +!> Initialize ice shelf thickness +subroutine initialize_ice_thickness(h_shelf, area_shelf_h, hmask, G, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_shelf !< The ice shelf thickness, in m. @@ -48,9 +48,8 @@ subroutine initialize_ice_thickness (h_shelf, area_shelf_h, hmask, G, PF) end subroutine initialize_ice_thickness - -subroutine initialize_ice_thickness_from_file (h_shelf, area_shelf_h, hmask, G, PF) - +!> Initialize ice shelf thickness from file +subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_shelf !< The ice shelf thickness, in m. @@ -135,9 +134,8 @@ subroutine initialize_ice_thickness_from_file (h_shelf, area_shelf_h, hmask, G, end subroutine initialize_ice_thickness_from_file - -subroutine initialize_ice_thickness_channel (h_shelf, area_shelf_h, hmask, G, PF) - +!> Initialize ice shelf thickness for a channel configuration +subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_shelf !< The ice shelf thickness, in m. diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index c4553e4c87..95c9b10047 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -1,38 +1,8 @@ +!> Tidal contributions to geopotential module MOM_tidal_forcing ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* Code by Robert Hallberg, August 2005, based on C-code by Harper * -!* Simmons, February, 2003, in turn based on code by Brian Arbic. * -!* * -!* The main subroutine in this file calculates the total tidal * -!* contribution to the geopotential, including self-attraction and * -!* loading terms and the astronomical contributions. All options * -!* are selected with entries in a file that is parsed at run-time. * -!* Overall tides are enabled with a line '#define TIDES' in that file.* -!* Tidal constituents must be individually enabled with lines like * -!* '#define TIDE_M2'. This file has default values of amplitude, * -!* frequency, Love number, and phase at time 0 for the Earth's M2, * -!* S2, N2, K2, K1, O1, P1, Q1, MF, and MM tidal constituents, but * -!* the frequency, amplitude and phase ant time 0 for each constituent * -!* can be changed at run time by setting variables like TIDE_M2_FREQ, * -!* TIDE_M2_AMP and TIDE_M2_PHASE_T0 (for M2). * -!* * -!* In addition, the approach to calculating self-attraction and * -!* loading is set at run time. The default is to use the scalar * -!* approximation, with a coefficient TIDE_SAL_SCALAR_VALUE that must * -!* be set in the run-time file (for global runs, 0.094 is typical). * -!* Alternately, TIDAL_SAL_FROM_FILE can be set to read the SAL from * -!* a file containing the results of a previous simulation. To iterate * -!* the SAL to convergence, USE_PREVIOUS_TIDES may be useful (for * -!* details, see Arbic et al., 2004, DSR II). With TIDAL_SAL_FROM_FILE * -!* or USE_PREVIOUS_TIDES,a list of input files must be provided to * -!* describe each constituent's properties from a previous solution. * -!* * -!*********************************************************************** - use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, & CLOCK_MODULE use MOM_domains, only : pass_var @@ -49,8 +19,8 @@ module MOM_tidal_forcing #include -integer, parameter :: MAX_CONSTITUENTS = 10 ! The maximum number of tidal - ! constituents that could be used. +integer, parameter :: MAX_CONSTITUENTS = 10 !< The maximum number of tidal + !! constituents that could be used. !> The control structure for the MOM_tidal_forcing mldule type, public :: tidal_forcing_CS ; private @@ -84,7 +54,7 @@ module MOM_tidal_forcing amp_prev => NULL() !< The amplitude of the previous tidal solution, in m. end type tidal_forcing_CS -integer :: id_clock_tides +integer :: id_clock_tides !< CPU clock for tides contains @@ -99,7 +69,6 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. type(tidal_forcing_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module. - ! Local variables real, dimension(SZI_(G), SZJ_(G)) :: & phase, & ! The phase of some tidal constituent. @@ -379,7 +348,7 @@ subroutine find_in_files(filenames, varname, array, G) character(len=*), intent(in) :: varname !< The name of the variable to read type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G)), intent(out) :: array !< The array to fill with the data - + ! Local variables integer :: nf do nf=1,size(filenames) @@ -411,9 +380,6 @@ subroutine tidal_forcing_sensitivity(G, CS, deta_tidal_deta) type(tidal_forcing_CS), pointer :: CS !< The control structure returned by a previous call to tidal_forcing_init. real, intent(out) :: deta_tidal_deta !< The partial derivative of eta_tidal with !! the local value of eta, nondim. -! This subroutine calculates returns the partial derivative of the local -! geopotential height with the input sea surface height due to self-attraction -! and loading. if (CS%USE_SAL_SCALAR .and. CS%USE_PREV_TIDES) then deta_tidal_deta = 2.0*CS%SAL_SCALAR @@ -442,7 +408,6 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta) real, optional, intent(out) :: deta_tidal_deta !< The partial derivative of !! eta_tidal with the local value of !! eta, nondim. - ! Local variables real :: eta_astro(SZI_(G),SZJ_(G)) real :: eta_SAL(SZI_(G),SZJ_(G)) @@ -534,4 +499,33 @@ subroutine tidal_forcing_end(CS) end subroutine tidal_forcing_end +!> \namespace tidal_forcing +!! +!! Code by Robert Hallberg, August 2005, based on C-code by Harper +!! Simmons, February, 2003, in turn based on code by Brian Arbic. +!! +!! The main subroutine in this file calculates the total tidal +!! contribution to the geopotential, including self-attraction and +!! loading terms and the astronomical contributions. All options +!! are selected with entries in a file that is parsed at run-time. +!! Overall tides are enabled with the run-time parameter 'TIDES=True'. +!! Tidal constituents must be individually enabled with lines like +!! 'TIDE_M2=True'. This file has default values of amplitude, +!! frequency, Love number, and phase at time 0 for the Earth's M2, +!! S2, N2, K2, K1, O1, P1, Q1, MF, and MM tidal constituents, but +!! the frequency, amplitude and phase ant time 0 for each constituent +!! can be changed at run time by setting variables like TIDE_M2_FREQ, +!! TIDE_M2_AMP and TIDE_M2_PHASE_T0 (for M2). +!! +!! In addition, the approach to calculating self-attraction and +!! loading is set at run time. The default is to use the scalar +!! approximation, with a coefficient TIDE_SAL_SCALAR_VALUE that must +!! be set in the run-time file (for global runs, 0.094 is typical). +!! Alternately, TIDAL_SAL_FROM_FILE can be set to read the SAL from +!! a file containing the results of a previous simulation. To iterate +!! the SAL to convergence, USE_PREVIOUS_TIDES may be useful (for +!! details, see Arbic et al., 2004, DSR II). With TIDAL_SAL_FROM_FILE +!! or USE_PREVIOUS_TIDES,a list of input files must be provided to +!! describe each constituent's properties from a previous solution. + end module MOM_tidal_forcing From f7be32d4f5ba702c5a9f123c95245d7e2de6bd11 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Thu, 12 Jul 2018 12:00:35 -0400 Subject: [PATCH 0592/1072] Fixed documentation in MOM_debugging --- src/diagnostics/MOM_debugging.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/diagnostics/MOM_debugging.F90 b/src/diagnostics/MOM_debugging.F90 index 768caf0811..92ee5898d5 100644 --- a/src/diagnostics/MOM_debugging.F90 +++ b/src/diagnostics/MOM_debugging.F90 @@ -71,7 +71,7 @@ module MOM_debugging integer :: redundant_prints(3) = 0 !< Counters for controlling redundant printing logical :: debug = .false. !< Write out verbose debugging data logical :: debug_chksums = .true. !< Perform checksums on arrays -logical :: debug_redundant = .true. !< Check redundant +logical :: debug_redundant = .true. !< Check redundant values on PE boundaries contains From 403f59a8c0a917a772b80db03513fd0751e54e44 Mon Sep 17 00:00:00 2001 From: mvertens Date: Thu, 12 Jul 2018 11:19:11 -0600 Subject: [PATCH 0593/1072] changes needed to get nuopc cap restarting correctly --- config_src/nuopc_driver/MOM_ocean_model.F90 | 25 +- config_src/nuopc_driver/backup/mom_cap.F90.00 | 2245 --------------- config_src/nuopc_driver/backup/mom_cap.F90.02 | 2432 ----------------- .../nuopc_driver/backup/ocn_comp_nuopc.F90.02 | 2218 --------------- config_src/nuopc_driver/mom_cap.F90 | 334 +-- config_src/nuopc_driver/mom_cap_methods.F90 | 117 +- 6 files changed, 220 insertions(+), 7151 deletions(-) delete mode 100644 config_src/nuopc_driver/backup/mom_cap.F90.00 delete mode 100644 config_src/nuopc_driver/backup/mom_cap.F90.02 delete mode 100644 config_src/nuopc_driver/backup/ocn_comp_nuopc.F90.02 diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 23d94212db..2e691e01f8 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -254,6 +254,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i real :: Rho0 ! The Boussinesq ocean density, in kg m-3. real :: G_Earth ! The gravitational acceleration in m s-2. + ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "ocean_model_init" ! This module's name. @@ -511,13 +512,14 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%grid, OS%forcing_CSp) if (OS%fluxes%fluxes_used) then + call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & OS%grid, 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%forces, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) endif if (OS%icebergs_alter_ocean) then call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & @@ -536,13 +538,15 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! Indicate that there are new unused fluxes. OS%fluxes%fluxes_used = .false. OS%fluxes%dt_buoy_accum = dt_coupling + else + OS%flux_tmp%C_p = OS%fluxes%C_p call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & OS%grid, 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%forces, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) endif if (OS%icebergs_alter_ocean) then call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & @@ -559,7 +563,9 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & #ifdef _USE_GENERIC_TRACER call MOM_generic_tracer_fluxes_accumulate(OS%flux_tmp, weight) !weight of the current flux in the running average #endif + endif + call set_derived_forcing_fields(OS%forces, OS%fluxes, OS%grid, OS%GV%Rho0) call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid) @@ -876,6 +882,12 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, end subroutine initialize_ocean_public_type +!======================================================================= +! 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 @@ -885,11 +897,7 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, & type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure real, optional, intent(in) :: patm(:,:) real, optional, intent(in) :: press_to_z -! 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. + real :: IgR0 character(len=48) :: val_str integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd @@ -978,7 +986,6 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, & end subroutine convert_state_to_ocean_type - !======================================================================= ! ! @@ -1006,6 +1013,7 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) 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 !! non-ocean PEs, or PEs that have not yet been initialzed, and it can safely @@ -1029,6 +1037,7 @@ 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.! !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! diff --git a/config_src/nuopc_driver/backup/mom_cap.F90.00 b/config_src/nuopc_driver/backup/mom_cap.F90.00 deleted file mode 100644 index 56c4b5cd35..0000000000 --- a/config_src/nuopc_driver/backup/mom_cap.F90.00 +++ /dev/null @@ -1,2245 +0,0 @@ -!> -!! @mainpage MOM NUOPC Cap -!! @author Fei Liu (fei.liu@gmail.com) -!! @date 5/10/13 Original documentation -!! @author Rocky Dunlap (rocky.dunlap@noaa.gov) -!! @date 1/12/17 Moved to doxygen -!! -!! @tableofcontents -!! -!! @section Overview Overview -!! -!! **This MOM cap has been tested with MOM5 and MOM6.** -!! -!! This document describes the MOM "cap", which is a small software layer that is -!! required when the [MOM ocean model] (http://mom-ocean.org/web) -!! is used in [National Unified Operation Prediction Capability] -!! (http://www.earthsystemcog.org/projects/nuopc) (NUOPC) coupled systems. -!! The NUOPC Layer is a software layer built on top of the [Earth System Modeling -!! Framework] (https://www.earthsystemcog.org/projects/esmf) (ESMF). -!! ESMF is a high-performance modeling framework that provides -!! data structures, interfaces, and operations suited for building coupled models -!! from a set of components. NUOPC refines the capabilities of ESMF by providing -!! a more precise definition of what it means for a model to be a component and -!! how components should interact and share data in a coupled system. The NUOPC -!! Layer software is designed to work with typical high-performance models in the -!! Earth sciences domain, most of which are written in Fortran and are based on a -!! distributed memory model of parallelism (MPI). -!! A NUOPC "cap" is a Fortran module that serves as the interface to a model -!! when it's used in a NUOPC-based coupled system. -!! The term "cap" is used because it is a small software layer that sits on top -!! of model code, making calls into it and exposing model data structures in a -!! standard way. For more information about creating NUOPC caps in general, please -!! see the [Building a NUOPC Model] -!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_howtodoc/) -!! how-to document. -!! -!! The MOM cap package includes the cap itself (mom_cap.F90, a Fortran module), a -!! set of time utilities (time_utils.F90) for converting between ESMF and FMS -!! time types, and two makefiles. Also included are self-describing dependency -!! makefile fragments (mom.mk and mom.mk.template), although these can be generated -!! by the makefiles for specific installations of the MOM cap. -!! -!! @subsection CapSubroutines Cap Subroutines -!! -!! The MOM cap Fortran module contains a set of subroutines that are required -!! by NUOPC. These subroutines are called by the NUOPC infrastructure according -!! to a predefined calling sequence. Some subroutines are called during -!! initialization of the coupled system, some during the run of the coupled -!! system, and some during finalization of the coupled system. The initialization -!! sequence is the most complex and is governed by the NUOPC technical rules. -!! Details about the initialization sequence can be found in the [NUOPC Reference Manual] -!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html#SECTION00034000000000000000). -!! -!! A particularly important part of the NUOPC intialization sequence is to establish -!! field connections between models. Simply put, a field connection is established -!! when a field output by one model can be consumed by another. As an example, the -!! MOM model is able to accept a precipitation rate when coupled to an atmosphere -!! model. In this case a field connection will be established between the precipitation -!! rate exported from the atmosphere and the precipitation rate imported into the -!! MOM model. Because models may uses different variable names for physical -!! quantities, NUOPC relies on a set of standard names and a built-in, extensible -!! standard name dictionary to match fields between models. More information about -!! the use of standard names can be found in the [NUOPC Reference Manual] -!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html#SECTION00032000000000000000). -!! -!! Two key initialization phases that appear in every NUOPC cap, including this MOM -!! cap are the field "advertise" and field "realize" phases. *Advertise* is a special -!! NUOPC term that refers to a model participating in a coupled system -!! providing a list of standard names of required import fields and available export -!! fields. In other words, each model will advertise to the other models which physical fields -!! it needs and which fields it can provide when coupled. NUOPC compares all of the advertised -!! standard names and creates a set of unidirectional links, each from one export field -!! in a model to one import field in another model. When these connections have been established, -!! all models in the coupled system need to provide a description of their geographic -!! grid (e.g., lat-lon, tri-polar, cubed sphere, etc.) and allocate their connected -!! fields on that grid. In NUOPC terms, this is refered to as *realizing* a set of -!! fields. NUOPC relies on ESMF data types for this, such as the [ESMF_Grid] -!! (http://www.earthsystemmodeling.org/esmf_releases/public/last/ESMF_refdoc/node5.html#SECTION05080000000000000000) -!! type, which describes logically rectangular grids and the [ESMF_Field] -!! (http://www.earthsystemmodeling.org/esmf_releases/public/last/ESMF_refdoc/node5.html#SECTION05030000000000000000) -!! type, which wraps a models data arrays and provides basic metadata. Because ESMF supports -!! interpolation between different grids (sometimes called "regridding" or "grid remapping"), -!! it is not necessary that models share a grid. As you will see below -!! the *advertise* and *realize* phases each have a subroutine in the HYCOM cap. -!! -!! The following table summarizes the NUOPC-required subroutines that appear in the -!! MOM cap. The "Phase" column says whether the subroutine is called during the -!! initialization, run, or finalize part of the coupled system run. -!! -!! Phase | MOM Cap Subroutine | Description -!! ---------|--------------------------------------------------------------------|------------------------------------------------------------- -!! Init | [InitializeP0] (@ref mom_cap_mod::initializep0) | Sets the Initialize Phase Definition (IPD) version to use -!! Init | [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) | Advertises standard names of import and export fields -!! Init | [InitializeRealize] (@ref mom_cap_mod::initializerealize) | Creates an ESMF_Grid for the MOM grid as well as ESMF_Fields for import and export fields -!! Run | [ModelAdvance] (@ref mom_cap_mod::modeladvance) | Advances the model by a timestep -!! Final | [Finalize] (@ref mom_cap_mod::ocean_model_finalize) | Cleans up -!! -!! @section UnderlyingModelInterfaces Underlying Model Interfaces -!! -!! -!! @subsection DomainCreation Domain Creation -!! -!! The MOM tripolar grid is represented as a 2D `ESMF_Grid` and coupling fields are placed -!! on this grid. Calls related to creating the grid are located in the [InitializeRealize] -!! (@ref mom_cap_mod::initializerealize) subroutine, which is called by the NUOPC infrastructure -!! during the intialization sequence. -!! -!! The cap determines parameters for setting up the grid by calling subroutines in the -!! `mpp_domains_mod` module. The global domain size is determined by calling `mpp_get_global_domain()`. -!! A check is in place to ensure that there is only a single tile in the domain (the -!! cap is currently limited to one tile; multi-tile mosaics are not supported). The -!! decomposition across processors is determined via calls to `mpp_get_compute_domains()` -!! (to retrieve decomposition block indices) and `mpp_get_pelist()` (to determine how -!! blocks are assigned to processors). -!! -!! The grid is created in several steps: -!! - an `ESMF_DELayout` is created based on the pelist from MOM -!! - an `ESMF_DistGrid` is created over the global index space. Connections are set -!! up so that the index space is periodic in the first dimension and has a -!! fold at the top for the bipole. The decompostion blocks are also passed in -!! along with the `ESMF_DELayout` mentioned above. -!! - an `ESMF_Grid` is then created by passing in the above `ESMF_DistGrid`. -!! -!! Masks, areas, center (tlat, tlon), and corner (ulat, ulon) coordinates are then added to the `ESMF_Grid` -!! by retrieving those fields from MOM with calls to `ocean_model_data_get()`. -!! -!! @subsection Initialization Initialization -!! -!! During the [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) phase, calls are -!! made to MOM's native initialization subroutines, including `fms_init()`, `constants_init()`, -!! `field_manager_init()`, `diag_manager_init()`, and `set_calendar_type()`. The MPI communicator -!! is pulled in through the ESMF VM object for the MOM component. The dt and start time are set -!! from parameters from the incoming ESMF clock with calls to `set_time()` and `set_date().` -!! -!! -!! @subsection Run Run -!! -!! The [ModelAdvance] (@ref mom_cap_mod::modeladvance) subroutine is called by the NUOPC -!! infrastructure when it's time for MOM to advance in time. During this subroutine, there is a -!! call into the MOM update routine: -!! -!! call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_sfc, Time, Time_step_coupled) -!! -!! Prior to this call, the cap performs a few steps: -!! - the `Time` and `Time_step_coupled` parameters, which are based on FMS types, are derived from the incoming ESMF clock -!! - there are calls to two stubs: `ice_ocn_bnd_from_data()` and `external_coupler_sbc_before()` - these are currently -!! inactive, but may be modified to read in import data from file or from an external coupler -!! - diagnostics are optionally written to files `field_ocn_import_*`, one for each import field -!! - import fields are prepared: -!! - the sign is reversed on `mean_evap_rate` and `mean_sensi_heat_flux` -!! - momentum flux vectors are rotated to internal grid -!! - optionally, a call is made to `ocean_model_restart()` at the interval `restart_interval` -!! -!! After the call to `update_ocean_model()`, the cap performs these steps: -!! - the `ocean_mask` export is set to match that of the internal MOM mask -!! - the `freezing_melting_potential` export is converted from J m-2 to W m-2 by dividing by the coupling interval -!! - vector rotations are applied to the `ocean_current_zonal` and `ocean_current_merid` exports, back to lat-lon grid -!! - diagnostics are optionally written to files `field_ocn_export_*`, one for each export field -!! - a call is made to `external_coupler_sbc_after()` to update exports from an external coupler (currently an inactive stub) -!! - calls are made to `dumpMomInternal()` to write files `field_ocn_internal_*` for all internal fields (both import and export) -!! -!! @subsubsection VectorRotations Vector Rotations -!! -!! Vector rotations are applied to incoming momentum fluxes (from regular lat-lon to tripolar grid) and -!! outgoing ocean currents (from tripolar to regular lat-lon). The rotation angles are provided -!! from the native MOM grid by a call to `get_ocean_grid(Ocean_grid)`. -!! The cosine and sine of the rotation angle are: -!! -!! Ocean_grid%cos_rot(i,j) -!! Ocean_grid%sin_rot(i,j) -!! -!! The rotation of momentum flux from regular lat-lon to tripolar is: -!! \f[ -!! \begin{bmatrix} -!! \tau_x' \\ -!! \tau_y' -!! \end{bmatrix} = -!! \begin{bmatrix} -!! cos \theta & sin \theta \\ -!! -sin \theta & cos \theta -!! \end{bmatrix} * -!! \begin{bmatrix} -!! \tau_x \\ -!! \tau_y -!! \end{bmatrix} -!! \f] -!! -!! The rotation of ocean current from tripolar to regular lat-lon is: -!! \f[ -!! \begin{bmatrix} -!! u' \\ -!! v' -!! \end{bmatrix} = -!! \begin{bmatrix} -!! cos \theta & -sin \theta \\ -!! sin \theta & cos \theta -!! \end{bmatrix} * -!! \begin{bmatrix} -!! u \\ -!! v -!! \end{bmatrix} -!! \f] -!! @subsection Finalization Finalization -!! -!! NUOPC infrastructure calls [ocean_model_finalize] (@ref mom_cap_mod::ocean_model_finalize) -!! at the end of the run. This subroutine is a hook to call into MOM's native shutdown -!! procedures: -!! -!! call ocean_model_end (Ocean_sfc, Ocean_State, Time) -!! call diag_manager_end(Time ) -!! call field_manager_end -!! call fms_io_exit -!! call fms_end -!! -!! @section ModelFields Model Fields -!! -!! The following tables list the import and export fields currently set up in the MOM cap. -!! -!! @subsection ImportFields Import Fields -!! -!! Standard Name | Units | Model Variable | Description | Notes -!! ----------------------------------|------------|-----------------|-----------------------------------------------|-------------------------------------- -!! inst_pres_height_surface | Pa | p | pressure of overlying sea ice and atmosphere | | -!! mass_of_overlying_sea_ice | kg | mi | mass of overlying sea ice | | -!! mean_calving_heat_flx | W m-2 | calving_hflx | heat flux, relative to 0C, of frozen land water into ocean | | -!! mean_calving_rate | kg m-2 s-1 | calving | mass flux of frozen runoff | | -!! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | sign reversed (- evap) -!! mean_fprec_rate | kg m-2 s-1 | fprec | mass flux of frozen precip | | -!! mean_merid_moment_flx | Pa | v_flux | j-directed wind stress into ocean | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar -!! mean_net_lw_flx | W m-2 | lw_flux | long wave radiation | | -!! mean_net_sw_ir_dif_flx | W m-2 | sw_flux_nir_dif | diffuse near IR shortwave radiation | | -!! mean_net_sw_ir_dir_flx | W m-2 | sw_flux_nir_dir | direct near IR shortwave radiation | | -!! mean_net_sw_vis_dif_flx | W m-2 | sw_flux_vis_dif | diffuse visible shortware radiation | | -!! mean_net_sw_vis_dir_flx | W m-2 | sw_flux_vis_dir | direct visible shortware radiation | | -!! mean_prec_rate | kg m-2 s-1 | lprec | mass flux of liquid precip | | -!! mean_runoff_heat_flx | W m-2 | runoff_hflx | heat flux, relative to 0C, of liquid land water into ocean | | -!! mean_runoff_rate | kg m-2 s-1 | runoff | mass flux of liquid runoff | | -!! mean_salt_rate | kg m-2 s-1 | salt_flux | salt flux | | -!! mean_sensi_heat_flx | W m-2 | t_flux | sensible heat flux into ocean | sign reversed (- sensi) -!! mean_zonal_moment_flx | Pa | u_flux | j-directed wind stress into ocean | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar -!! -!! -!! @subsection ExportField Export Fields -!! -!! Export fields are populated from the `ocean_sfc` parameter (type `ocean_public_type`) -!! after the call to `update_ocean_model()`. -!! -!! Standard Name | Units | Model Variable | Description | Notes -!! ----------------------------------|------------|-----------------|-------------------------------------------|--------------------------------------------------------------------- -!! freezing_melting_potential | W m-2 | frazil | accumulated heating from frazil formation | cap converts model units (J m-2) to (W m-2) for export -!! ocean_mask | | | ocean mask | | -!! ocn_current_merid | m s-1 | v_surf | j-directed surface velocity on u-cell | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon -!! ocn_current_zonal | m s-1 | u_surf | i-directed surface velocity on u-cell | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon -!! s_surf | psu | s_surf | sea surface salinity on t-cell | | -!! sea_lev | m | sea_lev | sea level | model computation is eta_t + patm/(rho0*grav) - eta_geoid - eta_tide -!! sea_surface_temperature | K | t_surf | sea surface temperature on t-cell | | -!! -!! @subsection MemoryManagement Memory Management -!! -!! The MOM cap has an internal state type with pointers to three -!! types defined by MOM. There is also a small wrapper derived type -!! required to associate an internal state instance -!! with the ESMF/NUOPC component: -!! -!! type ocean_internalstate_type -!! type(ocean_public_type), pointer :: ocean_public_type_ptr -!! type(ocean_state_type), pointer :: ocean_state_type_ptr -!! type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr -!! end type -!! -!! type ocean_internalstate_wrapper -!! type(ocean_internalstate_type), pointer :: ptr -!! end type -!! -!! The member of type `ocean_public_type` stores ocean surface fields used during the coupling. -!! The member of type `ocean_state_type` is required by the ocean driver, -!! although its internals are private (not to be used by the coupling directly). -!! This type is passed to the ocean init and update routines -!! so that it can maintain state there if desired. -!! The member of type `ice_ocean_boundary_type` is populated by this cap -!! with incoming coupling fields from other components. These three derived types are allocated during the -!! [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) phase. Also during that -!! phase, the `ice_ocean_boundary` type members are all allocated using bounds retrieved -!! from `mpp_get_compute_domain()`. -!! -!! During the [InitializeRealize] (@ref mom_cap_mod::initializerealize) phase, -!! `ESMF_Field`s are created for each of the coupling fields in the `ice_ocean_boundary` -!! and `ocean_public_type` members of the internal state. These fields directly reference into the members of -!! the `ice_ocean_boundary` and `ocean_public_type` so that memory-to-memory copies are not required to move -!! data from the cap's import and export states to the memory areas used internally -!! by MOM. -!! -!! @subsection IO I/O -!! -!! The cap can optionally output coupling fields for diagnostic purposes if the ESMF attribute -!! "DumpFields" has been set to "true". In this case the cap will write out NetCDF files -!! with names "field_ocn_import_.nc" and "field_ocn_export_.nc". -!! Additionally, calls will be made to the cap subroutine [dumpMomInternal] -!! (@ref mom_cap_mod::dumpmominternal) to write out model internal fields to files -!! named "field_ocn_internal_.nc". In all cases these NetCDF files will -!! contain a time series of field data. -!! -!! @section BuildingAndInstalling Building and Installing -!! -!! There are two makefiles included with the MOM cap, makefile and makefile.nuopc. -!! The makefile.nuopc file is intended to be used within another build system, such -!! as the NEMSAppBuilder. The regular makefile can be used generally for building -!! and installing the cap. Two variables must be customized at the top: -!! - `INSTALLDIR` - where to copy the cap library and dependent libraries -!! - `NEMSMOMDIR` - location of the MOM library and FMS library -!! -!! To install run: -!! $ make install -!! -!! A makefile fragment, mom.mk, will also be copied into the directory. The fragment -!! defines several variables that can be used by another build system to include the -!! MOM cap and its dependencies. -!! -!! @subsection Dependencies Dependencies -!! -!! The MOM cap is dependent on the MOM library itself (lib_ocean.a) and the FMS -!! library (lib_FMS.a). -!! -!! @section RuntimeConfiguration Runtime Configuration -!! -!! At runtime, the MOM cap can be configured with several options provided -!! as ESMF attributes. Attributes can be set in the cap by the NUOPC Driver -!! above this cap, or in some systems (e.g., NEMS) attributes are set by -!! reading in from a configuration file. The available attributes are: -!! -!! * `DumpFields` - when set to "true", write out diagnostic NetCDF files for import/export/internal fields -!! * `ProfileMemory` - when set to "true", write out memory usage information to the ESMF log files; this -!! information is written when entering and leaving the [ModelAdvance] -!! (@ref mom_cap_mod::modeladvance) subroutine and before and after the call to -!! `update_ocean_model()`. -!! * `OceanSolo` - when set to "true", this option indicates that MOM is being run -!! uncoupled; in this case the vector rotations and other data manipulations -!! on import fields are skipped -!! * `restart_interval` - integer number of seconds indicating the interval at -!! which to call `ocean_model_restart()`; no restarts written if set to 0 -!! * `GridAttachArea` - when set to "true", this option indicates that MOM grid attaches cell area -!! using internal values computed in MOM. The default value is "false", grid cell area will -!! be computed in ESMF. -!! -!! -!! @section Repository -!! The MOM NUOPC cap is maintained in a GitHub repository: -!! https://github.com/feiliuesmf/nems_mom_cap -!! -!! @section References -!! -!! - [MOM Home Page] (http://mom-ocean.org/web) -!! -!! -module mom_cap_mod - use constants_mod, only: constants_init - use data_override_mod, only: data_override_init, data_override - use diag_manager_mod, only: diag_manager_init, diag_manager_end - use field_manager_mod, only: field_manager_init, field_manager_end - use fms_mod, only: fms_init, fms_end, open_namelist_file, check_nml_error - use fms_mod, only: close_file, file_exist, uppercase - use fms_io_mod, only: fms_io_exit - use mpp_domains_mod, only: domain2d, mpp_get_compute_domain, mpp_get_compute_domains - use mpp_domains_mod, only: mpp_get_ntile_count, mpp_get_pelist, mpp_get_global_domain - use mpp_domains_mod, only: mpp_get_domain_npes, mpp_global_field - use mpp_io_mod, only: mpp_open, MPP_RDONLY, MPP_ASCII, MPP_OVERWR, MPP_APPEND, mpp_close, MPP_SINGLE - use mpp_mod, only: input_nml_file, mpp_error, FATAL, NOTE, mpp_pe, mpp_npes, mpp_set_current_pelist - use mpp_mod, only: stdlog, stdout, mpp_root_pe, mpp_clock_id - use mpp_mod, only: mpp_clock_begin, mpp_clock_end, MPP_CLOCK_SYNC - use mpp_mod, only: MPP_CLOCK_DETAILED, CLOCK_COMPONENT, MAXPES - use time_interp_external_mod, only: time_interp_external_init - use time_manager_mod, only: set_calendar_type, time_type, increment_date - use time_manager_mod, only: set_time, set_date, get_time, get_date, month_name - use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR - use time_manager_mod, only: operator( <= ), operator( < ), operator( >= ) - use time_manager_mod, only: operator( + ), operator( - ), operator( / ) - use time_manager_mod, only: operator( * ), operator( /= ), operator( > ) - use time_manager_mod, only: date_to_string - use time_manager_mod, only: fms_get_calendar_type => get_calendar_type - - use ocean_model_mod, only: ocean_model_restart, ocean_public_type, ocean_state_type - use ocean_model_mod, only: ocean_model_data_get - use ocean_model_mod, only: ocean_model_init , update_ocean_model, ocean_model_end, get_ocean_grid -#ifdef MOM6_CAP - use ocean_model_mod, only: ice_ocean_boundary_type - use MOM_grid, only: ocean_grid_type -#else - use ocean_types_mod, only: ice_ocean_boundary_type, ocean_grid_type -#endif - - use ESMF - use NUOPC - use NUOPC_Model, & - model_routine_SS => SetServices, & - model_label_Advance => label_Advance, & - model_label_Finalize => label_Finalize - - use time_utils_mod - - implicit none - private - public SetServices - - type ocean_internalstate_type - type(ocean_public_type), pointer :: ocean_public_type_ptr - type(ocean_state_type), pointer :: ocean_state_type_ptr - type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr - type(ocean_grid_type), pointer :: ocean_grid_ptr - end type - - type ocean_internalstate_wrapper - type(ocean_internalstate_type), pointer :: ptr - end type - - type fld_list_type - character(len=64) :: stdname - character(len=64) :: shortname - character(len=64) :: transferOffer - logical :: assoc ! is the farrayPtr associated with internal data - real(ESMF_KIND_R8), dimension(:,:), pointer :: farrayPtr - end type fld_list_type - - integer,parameter :: fldsMax = 100 - integer :: fldsToOcn_num = 0 - type (fld_list_type) :: fldsToOcn(fldsMax) - integer :: fldsFrOcn_num = 0 - type (fld_list_type) :: fldsFrOcn(fldsMax) - - integer :: import_slice = 1 - integer :: export_slice = 1 - character(len=256) :: tmpstr - integer :: dbrc - - type(ESMF_Grid), save :: mom_grid_i - logical :: write_diagnostics = .true. - logical :: profile_memory = .true. - logical :: ocean_solo = .true. - logical :: grid_attach_area = .false. - integer(ESMF_KIND_I8) :: restart_interval - - contains - !----------------------------------------------------------------------- - !------------------- Solo Ocean code starts here ----------------------- - !----------------------------------------------------------------------- - - !> NUOPC SetService method is the only public entry point. - !! SetServices registers all of the user-provided subroutines - !! in the module with the NUOPC layer. - !! - !! @param gcomp an ESMF_GridComp object - !! @param rc return code - subroutine SetServices(gcomp, rc) - - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - character(len=*),parameter :: subname='(mom_cap:SetServices)' - - rc = ESMF_SUCCESS - - ! the NUOPC model component will register the generic methods - call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! switching to IPD versions - call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - userRoutine=InitializeP0, phase=0, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! set entry point for methods that require specific implementation - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv01p1"/), userRoutine=InitializeAdvertise, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv01p3"/), userRoutine=InitializeRealize, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! attach specializing method(s) - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & - specRoutine=ModelAdvance, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & - specRoutine=ocean_model_finalize, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end subroutine SetServices - - !----------------------------------------------------------------------------- - - !> First initialize subroutine called by NUOPC. The purpose - !! is to set which version of the Initialize Phase Definition (IPD) - !! to use. - !! - !! For this MOM cap, we are using IPDv01. - !! - !! @param gcomp an ESMF_GridComp object - !! @param importState an ESMF_State object for import fields - !! @param exportState an ESMF_State object for export fields - !! @param clock an ESMF_Clock object - !! @param rc return code - subroutine InitializeP0(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=10) :: value - character(len=*),parameter :: subname='(mom_cap:InitializeP0)' - - rc = ESMF_SUCCESS - - ! Switch to IPDv01 by filtering all other phaseMap entries - call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, & - acceptStringList=(/"IPDv01p"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_AttributeGet(gcomp, name="DumpFields", value=value, defaultValue="true", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - write_diagnostics=(trim(value)=="true") - call ESMF_LogWrite('MOM_CAP:DumpFields = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_AttributeGet(gcomp, name="ProfileMemory", value=value, defaultValue="true", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - profile_memory=(trim(value)/="false") - call ESMF_LogWrite('MOM_CAP:ProfileMemory = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_AttributeGet(gcomp, name="OceanSolo", value=value, defaultValue="false", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ocean_solo=(trim(value)=="true") - call ESMF_LogWrite('MOM_CAP:OceanSolo = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) - - ! Retrieve restart_interval in (seconds) - ! A restart_interval value of 0 means no restart will be written. - call ESMF_AttributeGet(gcomp, name="restart_interval", value=value, defaultValue="0", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - restart_interval = ESMF_UtilString2Int(value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if(restart_interval < 0) then - call ESMF_LogSetError(ESMF_RC_NOT_VALID, & - msg="MOM_CAP: OCN attribute: restart_interval cannot be negative.", & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return - endif - call ESMF_LogWrite('MOM_CAP:restart_interval = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_AttributeGet(gcomp, name="GridAttachArea", value=value, defaultValue="false", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - grid_attach_area=(trim(value)=="true") - call ESMF_LogWrite('MOM_CAP:GridAttachArea = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) - - end subroutine - - !----------------------------------------------------------------------------- - - !> Called by NUOPC to advertise import and export fields. "Advertise" - !! simply means that the standard names of all import and export - !! fields are supplied. The NUOPC layer uses these to match fields - !! between components in the coupled system. - !! - !! @param gcomp an ESMF_GridComp object - !! @param importState an ESMF_State object for import fields - !! @param exportState an ESMF_State object for export fields - !! @param clock an ESMF_Clock object - !! @param rc return code - subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - type(ESMF_VM) :: vm - type(ESMF_Time) :: MyTime - type(ESMF_TimeInterval) :: TINT - - type (ocean_public_type), pointer :: Ocean_sfc => NULL() - type (ocean_state_type), pointer :: Ocean_state => NULL() - type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() - type(ocean_internalstate_wrapper) :: ocean_internalstate - - type(time_type) :: Run_len ! length of experiment - type(time_type) :: Time - type(time_type) :: Time_restart - type(time_type) :: DT - integer :: DT_OCEAN - integer :: isc,iec,jsc,jec - integer :: dt_cpld = 86400 - integer :: year=0, month=0, day=0, hour=0, minute=0, second=0 - integer :: mpi_comm_mom - - type(ESMF_Grid) :: gridIn - type(ESMF_Grid) :: gridOut - - integer :: npet, npet_x, npet_y - character(len=*),parameter :: subname='(mom_cap:InitializeAdvertise)' - - rc = ESMF_SUCCESS - - allocate(Ice_ocean_boundary) - !allocate(Ocean_state) ! ocean_model_init allocate this pointer - allocate(Ocean_sfc) - allocate(ocean_internalstate%ptr) - ocean_internalstate%ptr%ice_ocean_boundary_type_ptr => Ice_ocean_boundary - ocean_internalstate%ptr%ocean_public_type_ptr => Ocean_sfc - ocean_internalstate%ptr%ocean_state_type_ptr => Ocean_state - - call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_VMGet(VM, mpiCommunicator=mpi_comm_mom, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_ClockGet(CLOCK, currTIME=MyTime, TimeStep=TINT, RC=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_TimeGet (MyTime, & - YY=YEAR, MM=MONTH, DD=DAY, & - H=HOUR, M =MINUTE, S =SECOND, & - RC=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - CALL ESMF_TimeIntervalGet(TINT, S=DT_OCEAN, RC=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call fms_init(mpi_comm_mom) - call constants_init - call field_manager_init - call set_calendar_type (JULIAN ) - call diag_manager_init - ! this ocean connector will be driven at set interval - dt_cpld = DT_OCEAN - DT = set_time (DT_OCEAN, 0) - Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) - - Ocean_sfc%is_ocean_pe = .true. - call ocean_model_init(Ocean_sfc, Ocean_state, Time, Time) - -!tcx tcraig This results in errors in CESM with help from Alper -! FATAL error "MPP_OPEN: error in OPEN for data_table" -! The subroutine data_override_init shouldn't be called because ALLOW_FLUX_ADJUSTMENTS is set to FALSE -!tcx call data_override_init(Ocean_domain_in = Ocean_sfc%domain) - - call mpp_get_compute_domain(Ocean_sfc%domain, isc, iec, jsc, jec) - - allocate ( Ice_ocean_boundary% u_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% v_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% t_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% q_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% salt_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% lw_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_vis_dir (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_vis_dif (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_nir_dir (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_nir_dif (isc:iec,jsc:jec), & - Ice_ocean_boundary% lprec (isc:iec,jsc:jec), & - Ice_ocean_boundary% fprec (isc:iec,jsc:jec), & - Ice_ocean_boundary% runoff (isc:iec,jsc:jec), & - Ice_ocean_boundary% calving (isc:iec,jsc:jec), & - Ice_ocean_boundary% runoff_hflx (isc:iec,jsc:jec), & - Ice_ocean_boundary% calving_hflx (isc:iec,jsc:jec), & - Ice_ocean_boundary% mi (isc:iec,jsc:jec), & - Ice_ocean_boundary% p (isc:iec,jsc:jec)) - - Ice_ocean_boundary%u_flux = 0.0 - Ice_ocean_boundary%v_flux = 0.0 - Ice_ocean_boundary%t_flux = 0.0 - Ice_ocean_boundary%q_flux = 0.0 - Ice_ocean_boundary%salt_flux = 0.0 - Ice_ocean_boundary%lw_flux = 0.0 - Ice_ocean_boundary%sw_flux_vis_dir = 0.0 - Ice_ocean_boundary%sw_flux_vis_dif = 0.0 - Ice_ocean_boundary%sw_flux_nir_dir = 0.0 - Ice_ocean_boundary%sw_flux_nir_dif = 0.0 - Ice_ocean_boundary%lprec = 0.0 - Ice_ocean_boundary%fprec = 0.0 - Ice_ocean_boundary%runoff = 0.0 - Ice_ocean_boundary%calving = 0.0 - Ice_ocean_boundary%runoff_hflx = 0.0 - Ice_ocean_boundary%calving_hflx = 0.0 - Ice_ocean_boundary%mi = 0.0 - Ice_ocean_boundary%p = 0.0 - - call external_coupler_sbc_init(Ocean_sfc%domain, dt_cpld, Run_len) - - ocean_internalstate%ptr%ocean_state_type_ptr => Ocean_state - call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call MOM_FieldsSetup(ice_ocean_boundary, ocean_sfc) - - call MOM_AdvertiseFields(importState, fldsToOcn_num, fldsToOcn, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call MOM_AdvertiseFields(exportState, fldsFrOcn_num, fldsFrOcn, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - -#ifdef MOM6_CAP - ! When running mom6 solo, the rotation angles are not computed internally - ! in MOM6. We need to - ! calculate cos and sin of rotational angle for MOM6; the values - ! are stored in ocean_internalstate%ptr%ocean_grid_ptr%cos_rot and sin_rot - ! The rotation angles are retrieved during run time to rotate incoming - ! and outgoing vectors - ! - call calculate_rot_angle(Ocean_state, ocean_sfc, & - ocean_internalstate%ptr%ocean_grid_ptr) -#endif - - write(*,*) '----- MOM initialization phase Advertise completed' - - end subroutine InitializeAdvertise - - !----------------------------------------------------------------------------- - - !> Called by NUOPC to realize import and export fields. "Realizing" a field - !! means that its grid has been defined and an ESMF_Field object has been - !! created and put into the import or export State. - !! - !! @param gcomp an ESMF_GridComp object - !! @param importState an ESMF_State object for import fields - !! @param exportState an ESMF_State object for export fields - !! @param clock an ESMF_Clock object - !! @param rc return code - subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - ! Local Variables - type(ESMF_VM) :: vm - type(ESMF_Grid) :: gridIn - type(ESMF_Grid) :: gridOut - type(ESMF_DeLayout) :: delayout - type(ESMF_Distgrid) :: Distgrid - type(ESMF_DistGridConnection), allocatable :: connectionList(:) - type (ocean_public_type), pointer :: Ocean_sfc => NULL() - type (ocean_state_type), pointer :: Ocean_state => NULL() - type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() - type(ocean_internalstate_wrapper) :: ocean_internalstate - integer :: npet, ntiles - integer :: nxg, nyg, cnt - integer :: isc,iec,jsc,jec - integer, allocatable :: xb(:),xe(:),yb(:),ye(:),pe(:) - integer, allocatable :: deBlockList(:,:,:), & - petMap(:),deLabelList(:), & - indexList(:) - integer :: ioff, joff - integer :: i, j, n, i1, j1, n1, icount - integer :: lbnd1,ubnd1,lbnd2,ubnd2 - integer :: lbnd3,ubnd3,lbnd4,ubnd4 - integer :: nblocks_tot - logical :: found - real(ESMF_KIND_R8), allocatable :: ofld(:,:), gfld(:,:) - real(ESMF_KIND_R8), pointer :: t_surf(:,:) - integer(ESMF_KIND_I4), pointer :: dataPtr_mask(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_area(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_xcen(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ycen(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_xcor(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ycor(:,:) - type(ESMF_Field) :: field_t_surf - character(len=*),parameter :: subname='(mom_cap:InitializeRealize)' - - rc = ESMF_SUCCESS - - call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr - Ocean_sfc => ocean_internalstate%ptr%ocean_public_type_ptr - Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr - - call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_VMGet(vm, petCount=npet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !--------------------------------- - ! global mom grid size - !--------------------------------- - - call mpp_get_global_domain(Ocean_sfc%domain, xsize=nxg, ysize=nyg) - write(tmpstr,'(a,2i6)') subname//' nxg,nyg = ',nxg,nyg - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - !--------------------------------- - ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total - !--------------------------------- - - ntiles=mpp_get_ntile_count(Ocean_sfc%domain) ! this is tiles on this pe - if (ntiles /= 1) then - rc = ESMF_FAILURE - call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR, rc=dbrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - ntiles=mpp_get_domain_npes(Ocean_sfc%domain) - write(tmpstr,'(a,1i6)') subname//' ntiles = ',ntiles - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - !--------------------------------- - ! get start and end indices of each tile and their PET - !--------------------------------- - - allocate(xb(ntiles),xe(ntiles),yb(ntiles),ye(ntiles),pe(ntiles)) - call mpp_get_compute_domains(Ocean_sfc%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye) - call mpp_get_pelist(Ocean_sfc%domain, pe) - do n = 1,ntiles - write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - enddo - - !--------------------------------- - ! create delayout and distgrid - !--------------------------------- - - allocate(deBlockList(2,2,ntiles)) - allocate(petMap(ntiles)) - allocate(deLabelList(ntiles)) - - do n = 1, ntiles - deLabelList(n) = n - deBlockList(1,1,n) = xb(n) - deBlockList(1,2,n) = xe(n) - deBlockList(2,1,n) = yb(n) - deBlockList(2,2,n) = ye(n) - petMap(n) = pe(n) - ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side - enddo - - delayout = ESMF_DELayoutCreate(petMap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - allocate(connectionList(2)) - ! bipolar boundary condition at top row: nyg - call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & - tileIndexB=1, positionVector=(/nxg+1, 2*nyg+1/), & - orientationVector=(/-1, -2/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! periodic boundary condition along first dimension - call ESMF_DistGridConnectionSet(connectionList(2), tileIndexA=1, & - tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nxg,nyg/), & -! indexflag = ESMF_INDEX_DELOCAL, & - deBlockList=deBlockList, & -! deLabelList=deLabelList, & - delayout=delayout, & - connectionList=connectionList, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - deallocate(xb,xe,yb,ye,pe) - deallocate(connectionList) - deallocate(deLabelList) - deallocate(deBlockList) - deallocate(petMap) - - call ESMF_DistGridGet(distgrid=distgrid, localDE=0, elementCount=cnt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - allocate(indexList(cnt)) - write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - write(tmpstr,'(a,4i8)') subname//' distgrid list= ',& - indexList(1),indexList(cnt),minval(indexList), maxval(indexList) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - deallocate(IndexList) - - !--------------------------------- - ! create grid - !--------------------------------- - - gridIn = ESMF_GridCreate(distgrid=distgrid, & - gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & - coordSys = ESMF_COORDSYS_SPH_DEG, & - rc = rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - mom_grid_i = gridIn - - call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! Attach area to the Grid optionally. By default the cell areas are computed. - if(grid_attach_area) then - call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - call ESMF_GridGetCoord(gridIn, coordDim=1, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_xcen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridGetCoord(gridIn, coordDim=2, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_ycen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_GridGetCoord(gridIn, coordDim=1, & - staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=dataPtr_xcor, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridGetCoord(gridIn, coordDim=2, & - staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=dataPtr_ycor, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_MASK, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_mask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if(grid_attach_area) then - call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_area, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - !--------------------------------- - ! load up area, mask, center and corner values - ! area, mask, and centers should be same size in mom and esmf grid - ! corner points may not be, need to offset corner points by 1 in i and j - ! for esmf and also need to "make up" j=1 values. use wraparound in i - !--------------------------------- - - call mpp_get_compute_domain(Ocean_sfc%domain, isc, iec, jsc, jec) - - lbnd1 = lbound(dataPtr_mask,1) - ubnd1 = ubound(dataPtr_mask,1) - lbnd2 = lbound(dataPtr_mask,2) - ubnd2 = ubound(dataPtr_mask,2) - - lbnd3 = lbound(dataPtr_xcor,1) - ubnd3 = ubound(dataPtr_xcor,1) - lbnd4 = lbound(dataPtr_xcor,2) - ubnd4 = ubound(dataPtr_xcor,2) - - write(tmpstr,*) subname//' iscjsc = ',isc,iec,jsc,jec - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - write(tmpstr,*) subname//' lbub12 = ',lbnd1,ubnd1,lbnd2,ubnd2 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - write(tmpstr,*) subname//' lbub34 = ',lbnd3,ubnd3,lbnd4,ubnd4 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - if (iec-isc /= ubnd1-lbnd1 .or. jec-jsc /= ubnd2-lbnd2) then - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": fld and grid do not have the same size.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - - allocate(ofld(isc:iec,jsc:jec)) - allocate(gfld(nxg,nyg)) - - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'mask', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld mask = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(Ocean_sfc%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld mask = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_mask(i,j) = nint(ofld(i1,j1)) - enddo - enddo - - if(grid_attach_area) then - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'area', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld area = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(Ocean_sfc%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld area = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_area(i,j) = ofld(i1,j1) - enddo - enddo - endif - - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'tlon', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld xt = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(Ocean_sfc%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld xt = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_xcen(i,j) = ofld(i1,j1) - dataPtr_xcen(i,j) = mod(dataPtr_xcen(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) - enddo - enddo - - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'tlat', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld yt = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(Ocean_sfc%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld yt = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_ycen(i,j) = ofld(i1,j1) - enddo - enddo - -#ifdef MOM5_CAP - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'ulon', ofld, isc, jsc) -#endif - -#ifdef MOM6_CAP - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'geoLonBu', ofld, isc, jsc) -#endif - write(tmpstr,*) subname//' ofld xu = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(Ocean_sfc%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld xu = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - do j = lbnd4, ubnd4 - do i = lbnd3, ubnd3 - j1 = j - lbnd4 + jsc - 1 - i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 - if (j1 == 0) then - dataPtr_xcor(i,j) = 2*gfld(i1,1) - gfld(i1,2) -! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) > 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) - 360. -! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) < 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) + 360. - elseif (j1 >= 1 .and. j1 <= nyg) then - dataPtr_xcor(i,j) = gfld(i1,j1) - else - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": error in xu j1.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - dataPtr_xcor(i,j) = mod(dataPtr_xcor(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) - ! write(tmpstr,*) subname//' ijfld xu = ',i,i1,j,j1,dataPtr_xcor(i,j) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - enddo - enddo - -! The corner latitude values are treated differently because MOM5 runs on B-Grid while -! MOM6 runs on C-Grid. -#ifdef MOM5_CAP - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'ulat', ofld, isc, jsc) -#endif - -#ifdef MOM6_CAP - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'geoLatBu', ofld, isc, jsc) -#endif - - write(tmpstr,*) subname//' ofld yu = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(Ocean_sfc%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld yu = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - do j = lbnd4, ubnd4 - do i = lbnd3, ubnd3 - j1 = j - lbnd4 + jsc - 1 - i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 - if (j1 == 0) then - dataPtr_ycor(i,j) = 2*gfld(i1,1) - gfld(i1,2) - elseif (j1 >= 1 .and. j1 <= nyg) then - dataPtr_ycor(i,j) = gfld(i1,j1) - else - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": error in yu j1.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - ! write(tmpstr,*) subname//' ijfld yu = ',i,i1,j,j1,dataPtr_ycor(i,j) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - enddo - enddo - - write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - if(grid_attach_area) then - write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - endif - - write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - write(tmpstr,*) subname//' ycen = ',minval(dataPtr_ycen),maxval(dataPtr_ycen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - write(tmpstr,*) subname//' xcor = ',minval(dataPtr_xcor),maxval(dataPtr_xcor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - deallocate(gfld) - - gridOut = gridIn ! for now out same as in - - !--------------------------------- - ! realize fields on grid - !--------------------------------- - - call MOM_RealizeFields(importState, gridIn , fldsToOcn_num, fldsToOcn, "Ocn import", rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call MOM_RealizeFields(exportState, gridOut, fldsFrOcn_num, fldsFrOcn, "Ocn export", rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_StateGet(exportState, itemSearch="sea_surface_temperature", itemCount=icount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! Do sst initialization if it's part of export state - if(icount /= 0) then - call ESMF_StateGet(exportState, itemName='sea_surface_temperature', field=field_t_surf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_FieldGet(field_t_surf, localDe=0, farrayPtr=t_surf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'mask', ofld, isc, jsc) - - lbnd1 = lbound(t_surf,1) - ubnd1 = ubound(t_surf,1) - lbnd2 = lbound(t_surf,2) - ubnd2 = ubound(t_surf,2) - - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - if (ofld(i1,j1) == 0.) t_surf(i,j) = 0.0 - enddo - enddo - - deallocate(ofld) - endif - -! tcraig, turn this off for now, have issues with overwriting failures -! call NUOPC_Write(exportState, fileNamePrefix='init_field_ocn_export_', & -! timeslice=1, relaxedFlag=.true., rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out - - write(*,*) '----- MOM initialization phase Realize completed' - - end subroutine InitializeRealize - - !> Called by NUOPC to advance the model a single timestep. - !! - !! @param gcomp an ESMF_GridComp object - !! @param rc return code - subroutine ModelAdvance(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_State) :: importState, exportState - type(ESMF_Time) :: currTime - type(ESMF_TimeInterval) :: timeStep - type(ESMF_Time) :: startTime - type(ESMF_TimeInterval) :: time_elapsed - integer(ESMF_KIND_I8) :: n_interval, time_elapsed_sec - character(len=64) :: timestamp - - type (ocean_public_type), pointer :: Ocean_sfc => NULL() - type (ocean_state_type), pointer :: Ocean_state => NULL() - type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() - type(ocean_internalstate_wrapper) :: ocean_internalstate - - ! define some time types - type(time_type) :: Time - type(time_type) :: Time_step_coupled - type(time_type) :: Time_restart_current - - integer :: dth, dtm, dts, dt_cpld = 86400 - integer :: isc,iec,jsc,jec,lbnd1,ubnd1,lbnd2,ubnd2 - integer :: i,j,i1,j1 - real(ESMF_KIND_R8), allocatable :: ofld(:,:), ocz(:,:), ocm(:,:) - real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) - integer :: nc - real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_mmmf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_mzmf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ocz(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ocm(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) - type(ocean_grid_type), pointer :: Ocean_grid - character(240) :: msgString - character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' - - rc = ESMF_SUCCESS - if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") - - ! query the Component for its clock, importState and exportState - call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & - exportState=exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr - Ocean_sfc => ocean_internalstate%ptr%ocean_public_type_ptr - Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr - - ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep - - call ESMF_ClockPrint(clock, options="currTime", & - preString="------>Advancing OCN from: ", unit=msgString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_ClockGet(clock, startTime=startTime, currTime=currTime, & - timeStep=timeStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_TimePrint(currTime + timeStep, & - preString="--------------------------------> to: ", & - unit=msgString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_TimeIntervalGet(timeStep, h=dth, m=dtm, s=dts, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - Time = esmf2fms_time(currTime) - Time_step_coupled = esmf2fms_time(timeStep) - dt_cpld = dth*3600+dtm*60+dts - - call ice_ocn_bnd_from_data(Ice_ocean_boundary, Time, Time_step_coupled) - - call external_coupler_sbc_before(Ice_ocean_boundary, Ocean_sfc, nc, dt_cpld ) - - if(write_diagnostics) then - call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', & - timeslice=import_slice, relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - import_slice = import_slice + 1 - endif - - ! rotate the lat/lon wind vector (CW) onto local tripolar coordinate system - - call mpp_get_compute_domain(Ocean_sfc%domain, isc, iec, jsc, jec) - - if(.not. ocean_solo) then - call State_getFldPtr(exportState,'ocean_mask',dataPtr_mask,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - lbnd1 = lbound(dataPtr_mask,1) - ubnd1 = ubound(dataPtr_mask,1) - lbnd2 = lbound(dataPtr_mask,2) - ubnd2 = ubound(dataPtr_mask,2) - -#ifdef MOM5_CAP - call get_ocean_grid(Ocean_grid) -#endif -#ifdef MOM6_CAP - Ocean_grid => ocean_internalstate%ptr%ocean_grid_ptr -#endif - - call State_getFldPtr(importState,'mean_zonal_moment_flx',dataPtr_mzmf,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'mean_merid_moment_flx',dataPtr_mmmf,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'mean_evap_rate',dataPtr_evap,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'mean_sensi_heat_flx',dataPtr_sensi,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - dataPtr_evap = - dataPtr_evap - dataPtr_sensi = - dataPtr_sensi - - allocate(mzmf(lbnd1:ubnd1,lbnd2:ubnd2)) - allocate(mmmf(lbnd1:ubnd1,lbnd2:ubnd2)) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc ! work around local vs global indexing - i1 = i - lbnd1 + isc - mzmf(i,j) = Ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - + Ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) - mmmf(i,j) = Ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - - Ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) - enddo - enddo - dataPtr_mzmf = mzmf - dataPtr_mmmf = mmmf - deallocate(mzmf, mmmf) - endif ! not ocean_solo - - !Optionally write restart files when currTime-startTime is integer multiples of restart_interval - if(restart_interval > 0 ) then - time_elapsed = currTime - startTime - call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - n_interval = time_elapsed_sec / restart_interval - if((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then - time_restart_current = esmf2fms_time(currTime) - timestamp = date_to_string(time_restart_current) - call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=dbrc) - write(*,*) 'calling ocean_model_restart' - call ocean_model_restart(Ocean_state, timestamp) - endif - endif - - if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") - call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_sfc, Time, Time_step_coupled) - if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") - - if(.not. ocean_solo) then - allocate(ofld(isc:iec,jsc:jec)) - - call ocean_model_data_get(Ocean_state, Ocean_sfc, 'mask', ofld, isc, jsc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_mask(i,j) = nint(ofld(i1,j1)) - enddo - enddo - deallocate(ofld) - - ! Now rotate ocn current from tripolar grid back to lat/lon grid (CCW) - allocate(ocz(lbnd1:ubnd1,lbnd2:ubnd2)) - allocate(ocm(lbnd1:ubnd1,lbnd2:ubnd2)) - - call State_getFldPtr(exportState,'ocn_current_zonal',dataPtr_ocz,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'ocn_current_merid',dataPtr_ocm,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling - - ocz = dataPtr_ocz - ocm = dataPtr_ocm - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc ! work around local vs global indexing - i1 = i - lbnd1 + isc - dataPtr_ocz(i,j) = Ocean_grid%cos_rot(i1,j1)*ocz(i,j) & - - Ocean_grid%sin_rot(i1,j1)*ocm(i,j) - dataPtr_ocm(i,j) = Ocean_grid%cos_rot(i1,j1)*ocm(i,j) & - + Ocean_grid%sin_rot(i1,j1)*ocz(i,j) - enddo - enddo - deallocate(ocz, ocm) - endif ! not ocean_solo - - call ESMF_LogWrite("Before writing diagnostics", ESMF_LOGMSG_INFO, rc=rc) - if(write_diagnostics) then - call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & - timeslice=export_slice, relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - export_slice = export_slice + 1 - endif - - call ESMF_LogWrite("Before calling sbc forcing", ESMF_LOGMSG_INFO, rc=rc) - call external_coupler_sbc_after(Ice_ocean_boundary, Ocean_sfc, nc, dt_cpld ) - - call ESMF_LogWrite("Before dumpMomInternal", ESMF_LOGMSG_INFO, rc=rc) - !write(*,*) 'MOM: --- run phase called ---' - call dumpMomInternal(mom_grid_i, import_slice, "mean_zonal_moment_flx", "will provide", Ice_ocean_boundary%u_flux) - call dumpMomInternal(mom_grid_i, import_slice, "mean_merid_moment_flx", "will provide", Ice_ocean_boundary%v_flux) - call dumpMomInternal(mom_grid_i, import_slice, "mean_sensi_heat_flx" , "will provide", Ice_ocean_boundary%t_flux) - call dumpMomInternal(mom_grid_i, import_slice, "mean_evap_rate" , "will provide", Ice_ocean_boundary%q_flux) - call dumpMomInternal(mom_grid_i, import_slice, "mean_salt_rate" , "will provide", Ice_ocean_boundary%salt_flux) - call dumpMomInternal(mom_grid_i, import_slice, "mean_net_lw_flx" , "will provide", Ice_ocean_boundary%lw_flux ) - call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dir_flx", "will provide", Ice_ocean_boundary%sw_flux_vis_dir) - call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dif_flx", "will provide", Ice_ocean_boundary%sw_flux_vis_dif) - call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dir_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dir) - call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dif_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dif) - call dumpMomInternal(mom_grid_i, import_slice, "mean_prec_rate" , "will provide", Ice_ocean_boundary%lprec ) - call dumpMomInternal(mom_grid_i, import_slice, "mean_fprec_rate" , "will provide", Ice_ocean_boundary%fprec ) - call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_rate" , "will provide", Ice_ocean_boundary%runoff ) - call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_rate" , "will provide", Ice_ocean_boundary%calving) - call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_heat_flx" , "will provide", Ice_ocean_boundary%runoff_hflx ) - call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_heat_flx", "will provide", Ice_ocean_boundary%calving_hflx) - call dumpMomInternal(mom_grid_i, import_slice, "inst_pres_height_surface" , "will provide", Ice_ocean_boundary%p ) - call dumpMomInternal(mom_grid_i, import_slice, "mass_of_overlying_sea_ice", "will provide", Ice_ocean_boundary%mi) - -!--------- export fields ------------- - - call dumpMomInternal(mom_grid_i, export_slice, "ocean_mask", "will provide", dataPtr_mask) - call dumpMomInternal(mom_grid_i, export_slice, "sea_surface_temperature", "will provide", Ocean_sfc%t_surf) - call dumpMomInternal(mom_grid_i, export_slice, "s_surf" , "will provide", Ocean_sfc%s_surf ) - call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_zonal", "will provide", Ocean_sfc%u_surf ) - call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_merid", "will provide", Ocean_sfc%v_surf ) - call dumpMomInternal(mom_grid_i, export_slice, "sea_lev" , "will provide", Ocean_sfc%sea_lev) - - if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") - - end subroutine ModelAdvance - - !> Called by NUOPC at the end of the run to clean up. - !! - !! @param gcomp an ESMF_GridComp object - !! @param rc return code - subroutine ocean_model_finalize(gcomp, rc) - - ! input arguments - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type (ocean_public_type), pointer :: Ocean_sfc - type (ocean_state_type), pointer :: Ocean_state - type(ocean_internalstate_wrapper) :: ocean_internalstate - type(TIME_TYPE) :: Time - type(ESMF_Clock) :: clock - type(ESMF_Time) :: currTime - character(len=64) :: timestamp - character(len=*),parameter :: subname='(mom_cap:ocean_model_finalize)' - - write(*,*) 'MOM: --- finalize called ---' - rc = ESMF_SUCCESS - - call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - Ocean_sfc => ocean_internalstate%ptr%ocean_public_type_ptr - Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr - - call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_ClockGet(clock, currTime=currTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - Time = esmf2fms_time(currTime) - - call ocean_model_end (Ocean_sfc, Ocean_State, Time) - call diag_manager_end(Time ) - call field_manager_end - - call fms_io_exit - call fms_end - - write(*,*) 'MOM: --- completed ---' - - end subroutine ocean_model_finalize - -!==================================================================== -! get forcing data from data_overide - subroutine ice_ocn_bnd_from_data(x, Time, Time_step_coupled) - - type (ice_ocean_boundary_type) :: x - type(Time_type), intent(in) :: Time, Time_step_coupled - - type(Time_type) :: Time_next - character(len=*),parameter :: subname='(mom_cap:ice_ocn_bnd_from_data)' - - Time_next = Time + Time_step_coupled - - !call data_override('OCN', 't_flux', x%t_flux , Time_next) - !call data_override('OCN', 'u_flux', x%u_flux , Time_next) - !call data_override('OCN', 'v_flux', x%v_flux , Time_next) - !call data_override('OCN', 'q_flux', x%q_flux , Time_next) - !call data_override('OCN', 'salt_flux', x%salt_flux , Time_next) - !call data_override('OCN', 'lw_flux', x%lw_flux , Time_next) - !call data_override('OCN', 'sw_flux_vis_dir', x%sw_flux_vis_dir, Time_next) - !call data_override('OCN', 'sw_flux_vis_dif', x%sw_flux_vis_dif, Time_next) - !call data_override('OCN', 'sw_flux_nir_dir', x%sw_flux_nir_dir, Time_next) - !call data_override('OCN', 'sw_flux_nir_dif', x%sw_flux_nir_dif, Time_next) - !call data_override('OCN', 'lprec', x%lprec , Time_next) - !call data_override('OCN', 'fprec', x%fprec , Time_next) - !call data_override('OCN', 'runoff', x%runoff , Time_next) - !call data_override('OCN', 'calving', x%calving , Time_next) - !call data_override('OCN', 'p', x%p , Time_next) - - end subroutine ice_ocn_bnd_from_data - - -!----------------------------------------------------------------------------------------- -! -! Subroutines for enabling coupling to external programs through a third party coupler -! such as OASIS/PRISM. -! If no external coupler then these will mostly be dummy routines. -! These routines can also serve as spots to call other user defined routines -!----------------------------------------------------------------------------------------- - -!----------------------------------------------------------------------------------------- - -! Dummy subroutines. - - subroutine external_coupler_mpi_init(mom_local_communicator, external_initialization) - implicit none - integer, intent(out) :: mom_local_communicator - logical, intent(out) :: external_initialization - external_initialization = .false. - mom_local_communicator = -100 ! Is there mpp_undefined parameter corresponding to MPI_UNDEFINED? - ! probably wouldn't need logical flag. - return - end subroutine external_coupler_mpi_init - -!----------------------------------------------------------------------------------------- - subroutine external_coupler_sbc_init(Dom, dt_cpld, Run_len) - implicit none - type(domain2d) :: Dom - integer :: dt_cpld - type(time_type) :: Run_len - return - end subroutine external_coupler_sbc_init - - subroutine external_coupler_sbc_before(Ice_ocean_boundary, Ocean_sfc, nsteps, dt_cpld ) - implicit none - type (ice_ocean_boundary_type), intent(INOUT) :: Ice_ocean_boundary - type (ocean_public_type) , intent(INOUT) :: Ocean_sfc - integer , intent(IN) :: nsteps, dt_cpld - return - end subroutine external_coupler_sbc_before - - - subroutine external_coupler_sbc_after(Ice_ocean_boundary, Ocean_sfc, nsteps, dt_cpld ) - type (ice_ocean_boundary_type) :: Ice_ocean_boundary - type (ocean_public_type) :: Ocean_sfc - integer :: nsteps, dt_cpld - return - end subroutine external_coupler_sbc_after - - subroutine external_coupler_restart( dt_cpld, num_cpld_calls ) - implicit none - integer, intent(in) :: dt_cpld, num_cpld_calls - return - end subroutine external_coupler_restart - - subroutine external_coupler_exit - return - end subroutine external_coupler_exit - -!----------------------------------------------------------------------------------------- - subroutine external_coupler_mpi_exit(mom_local_communicator, external_initialization) - implicit none - integer, intent(in) :: mom_local_communicator - logical, intent(in) :: external_initialization - return - end subroutine external_coupler_mpi_exit -!----------------------------------------------------------------------------------------- - subroutine writeSliceFields(state, filename_prefix, slice, rc) - type(ESMF_State) :: state - character(len=*) :: filename_prefix - integer :: slice - integer, intent(out), optional :: rc - - integer :: n, nfields - type(ESMF_Field) :: field - type(ESMF_StateItem_Flag) :: itemType - character(len=40) :: fileName - character(len=64),allocatable :: fieldNameList(:) - character(len=*),parameter :: subname='(mom_cap:writeSliceFields)' - - if (present(rc)) rc = ESMF_SUCCESS - - if (ESMF_IO_PIO_PRESENT .and. & - (ESMF_IO_NETCDF_PRESENT .or. ESMF_IO_PNETCDF_PRESENT)) then - - call ESMF_StateGet(state, itemCount=nfields, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - allocate(fieldNameList(nfields)) - call ESMF_StateGet(state, itemNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - do n=1, size(fieldNameList) - call ESMF_StateGet(state, itemName=fieldNameList(n), & - itemType=itemType, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (itemType /= ESMF_STATEITEM_NOTFOUND) then - ! field is available in the state - call ESMF_StateGet(state, itemName=fieldNameList(n), field=field, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! -> output to file - write (fileName,"(A)") & - filename_prefix//trim(fieldNameList(n))//".nc" - call ESMF_FieldWrite(field, fileName=trim(fileName), & - timeslice=slice, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - enddo - - deallocate(fieldNameList) - - endif - - end subroutine writeSliceFields - - !----------------------------------------------------------------------------- - - subroutine State_GetFldPtr(ST, fldname, fldptr, rc) - type(ESMF_State), intent(in) :: ST - character(len=*), intent(in) :: fldname - real(ESMF_KIND_R8), pointer, intent(in) :: fldptr(:,:) - integer, intent(out), optional :: rc - - ! local variables - type(ESMF_Field) :: lfield - integer :: lrc - character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' - - call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (present(rc)) rc = lrc - - end subroutine State_GetFldPtr - - !----------------------------------------------------------------------------- - subroutine MOM_AdvertiseFields(state, nfields, field_defs, rc) - - type(ESMF_State), intent(inout) :: state - integer,intent(in) :: nfields - type(fld_list_type), intent(inout) :: field_defs(:) - integer, intent(inout) :: rc - - integer :: i - character(len=*),parameter :: subname='(mom_cap:MOM_AdvertiseFields)' - - rc = ESMF_SUCCESS - - do i = 1, nfields - - call NUOPC_Advertise(state, & - standardName=field_defs(i)%stdname, & - name=field_defs(i)%shortname, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - enddo - - end subroutine MOM_AdvertiseFields - - !----------------------------------------------------------------------------- - - subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) - - type(ESMF_State), intent(inout) :: state - type(ESMF_Grid), intent(in) :: grid - integer, intent(in) :: nfields - type(fld_list_type), intent(inout) :: field_defs(:) - character(len=*), intent(in) :: tag - integer, intent(inout) :: rc - - integer :: i - type(ESMF_Field) :: field - integer :: npet, nx, ny, pet, elb(2), eub(2), clb(2), cub(2), tlb(2), tub(2) - type(ESMF_VM) :: vm - character(len=*),parameter :: subname='(mom_cap:MOM_RealizeFields)' - - rc = ESMF_SUCCESS - - do i = 1, nfields - - if (field_defs(i)%assoc) then - write(tmpstr, *) subname, tag, ' Field ', field_defs(i)%shortname, ':', & - lbound(field_defs(i)%farrayPtr,1), ubound(field_defs(i)%farrayPtr,1), & - lbound(field_defs(i)%farrayPtr,2), ubound(field_defs(i)%farrayPtr,2) - call ESMF_LogWrite(tmpstr, ESMF_LOGMSG_INFO, rc=dbrc) - field = ESMF_FieldCreate(grid=grid, & - farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & -! farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - if (NUOPC_IsConnected(state, fieldName=field_defs(i)%shortname)) then - call NUOPC_Realize(state, field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_LogWrite(subname // tag // " Field "// field_defs(i)%stdname // " is connected.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=dbrc) -! call ESMF_FieldPrint(field=field, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out - else - call ESMF_LogWrite(subname // tag // " Field "// field_defs(i)%stdname // " is not connected.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=dbrc) - ! TODO: Initialize the value in the pointer to 0 after proper restart is setup - !if(associated(field_defs(i)%farrayPtr) ) field_defs(i)%farrayPtr = 0.0 - ! remove a not connected Field from State - call ESMF_StateRemove(state, (/field_defs(i)%shortname/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - enddo - - end subroutine MOM_RealizeFields - - !----------------------------------------------------------------------------- - - subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_sfc) - type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary - type(ocean_public_type), intent(in) :: Ocean_sfc - -#ifdef CESMCOUPLED -! type (shr_nuopc_fldList_Type) :: fldsList -#endif - - character(len=*),parameter :: subname='(mom_cap:MOM_FieldsSetup)' - - !!! fld_list_add(num, fldlist, stdname, transferOffer, data(optional), shortname(optional)) - -#ifdef CESMCOUPLED - -! WARNING tcx tcraig -! tcraig this is just a starting point, the fields are not complete or correct here - - !-------------------------------- - ! create import fields list - !-------------------------------- - -! call shr_nuopc_fldList_Zero(fldsList, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - -! call shr_nuopc_fldList_fromflds(fldsList, flds_x2o, flds_x2o_map, "will provide", subname//":flds_x2o", rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - -! call shr_nuopc_fldList_Add(fldsList, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - ! convert to fldsToOcn - - !-------------------------------- - ! create export fields list - !-------------------------------- - -! call shr_nuopc_fldList_Zero(fldsList, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - -! call shr_nuopc_fldList_fromflds(fldsList, flds_o2x, flds_o2x_map, "will provide", subname//":flds_o2x", rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - -! call shr_nuopc_fldList_Add(fldsList, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - -! WARNING tcx tcraig -! tcraig this is just a starting point, the fields are not complete or correct here -! tcraig we will need to figure out whether to adjust the mediator coupling fields for mom or vv or a bit of both - - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide", data=Ice_ocean_boundary%u_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide", data=Ice_ocean_boundary%v_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide", data=Ice_ocean_boundary%t_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide", data=Ice_ocean_boundary%q_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_salt" , "will provide", data=Ice_ocean_boundary%salt_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwdn" , "will provide", data=Ice_ocean_boundary%lw_flux ) -! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dir) -! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dif) -! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swidr", "will provide", data=Ice_ocean_boundary%sw_flux_nir_dir) -! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swidf", "will provide", data=Ice_ocean_boundary%sw_flux_nir_dif) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rain" , "will provide", data=Ice_ocean_boundary%lprec ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_snow" , "will provide", data=Ice_ocean_boundary%fprec ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide", data=Ice_ocean_boundary%runoff ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_meltw", "will provide", data=Ice_ocean_boundary%calving) -! call fld_list_add(fldsToOcn_num, fldsToOcn, "runoff_heat_flux" , "will provide", data=Ice_ocean_boundary%runoff_hflx ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_melth", "will provide", data=Ice_ocean_boundary%calving_hflx) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide", data=Ice_ocean_boundary%p ) -! call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice", "will provide", data=Ice_ocean_boundary%mi) - -!--------- export fields ------------- - - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask", "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t", "will provide", data=Ocean_sfc%t_surf) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide", data=Ocean_sfc%s_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u", "will provide", data=Ocean_sfc%u_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v", "will provide", data=Ocean_sfc%v_surf ) -! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir", "will provide") -! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir", "will provide") -! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=Ocean_sfc%sea_lev) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide", data=Ocean_sfc%frazil) - - -#else -!--------- import fields ------------- - -! tcraig, don't point directly into mom data YET (last field is optional in interface) -! instead, create space for the field when it's "realized". - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx", "will provide", data=Ice_ocean_boundary%u_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx", "will provide", data=Ice_ocean_boundary%v_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide", data=Ice_ocean_boundary%t_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide", data=Ice_ocean_boundary%q_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide", data=Ice_ocean_boundary%salt_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide", data=Ice_ocean_boundary%lw_flux ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dir) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dif) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_nir_dir) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_nir_dif) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide", data=Ice_ocean_boundary%lprec ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide", data=Ice_ocean_boundary%fprec ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide", data=Ice_ocean_boundary%runoff ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide", data=Ice_ocean_boundary%calving) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide", data=Ice_ocean_boundary%runoff_hflx ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx", "will provide", data=Ice_ocean_boundary%calving_hflx) - call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide", data=Ice_ocean_boundary%p ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice", "will provide", data=Ice_ocean_boundary%mi) - -!--------- export fields ------------- - - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask", "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature", "will provide", data=Ocean_sfc%t_surf) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide", data=Ocean_sfc%s_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal", "will provide", data=Ocean_sfc%u_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid", "will provide", data=Ocean_sfc%v_surf ) -! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir", "will provide") -! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir", "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=Ocean_sfc%sea_lev) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=Ocean_sfc%frazil) - -#endif - - end subroutine MOM_FieldsSetup - - !----------------------------------------------------------------------------- - - subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) - ! ---------------------------------------------- - ! Set up a list of field information - ! ---------------------------------------------- - integer, intent(inout) :: num - type(fld_list_type), intent(inout) :: fldlist(:) - character(len=*), intent(in) :: stdname - character(len=*), intent(in) :: transferOffer - real(ESMF_KIND_R8), dimension(:,:), optional, target :: data - character(len=*), intent(in),optional :: shortname - - ! local variables - integer :: rc - character(len=*), parameter :: subname='(mom_cap:fld_list_add)' - - ! fill in the new entry - - num = num + 1 - if (num > fldsMax) then - call ESMF_LogWrite(trim(subname)//": ERROR num gt fldsMax "//trim(stdname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - return - endif - - fldlist(num)%stdname = trim(stdname) - if (present(shortname)) then - fldlist(num)%shortname = trim(shortname) - else - fldlist(num)%shortname = trim(stdname) - endif - fldlist(num)%transferOffer = trim(transferOffer) - if (present(data)) then - fldlist(num)%assoc = .true. - fldlist(num)%farrayPtr => data - else - fldlist(num)%assoc = .false. - endif - - end subroutine fld_list_add - - subroutine dumpMomInternal(grid, slice, stdname, nop, farray) - - type(ESMF_Grid) :: grid - integer, intent(in) :: slice - character(len=*) :: stdname - character(len=*) :: nop - real(ESMF_KIND_R8), dimension(:,:), target :: farray - - type(ESMF_Field) :: field - real(ESMF_KIND_R8), dimension(:,:), pointer :: f2d - integer :: rc - -#ifdef MOM6_CAP - return -#endif - - if(.not. write_diagnostics) return ! nop in production mode - if(ocean_solo) return ! do not dump internal fields in ocean solo mode - - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, & - indexflag=ESMF_INDEX_DELOCAL, & - name=stdname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_FieldGet(field, farrayPtr=f2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - f2d(:,:) = farray(:,:) - - call ESMF_FieldWrite(field, fileName='field_ocn_internal_'//trim(stdname)//'.nc', & - timeslice=slice, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_FieldDestroy(field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end subroutine - -#ifdef MOM6_CAP - subroutine calculate_rot_angle(OS, OSFC, OG) - type(ocean_state_type), intent(in) :: OS - type(ocean_public_type), intent(in) :: OSFC - type(ocean_grid_type), pointer :: OG - - integer :: i,j,ishift,jshift,ilb,iub,jlb,jub - real :: angle, lon_scale - type(ocean_grid_type), pointer :: G - - call get_ocean_grid(OS, G) - - !print *, 'lbound: ', lbound(G%geoLatT), lbound(G%geoLonT), lbound(G%sin_rot) - !print *, 'ubound: ', ubound(G%geoLatT), ubound(G%geoLonT), ubound(G%sin_rot) - - !print *, minval(G%geoLatT), maxval(G%geoLatT) - !print *, minval(G%geoLonT), maxval(G%geoLonT) - !print *, G%isc, G%jsc, G%iec, G%jec - - ! - ! The bounds isc:iec goes from 5-104, isc-ishift:iec-ishift goes from 1:100 - ! - call mpp_get_compute_domain(OSFC%Domain, ilb, iub, jlb, jub) - ishift = ilb-G%isc - jshift = jlb-G%jsc - !print *, 'ilb, iub, jlb, jub', ilb, iub, jlb, jub, ishift, jshift - !print *, 'sizes', iub-ilb, jub-jlb, G%iec-G%isc, G%jec-G%jsc - allocate(OG) - allocate(OG%sin_rot(ilb:iub, jlb:jub)) - allocate(OG%cos_rot(ilb:iub, jlb:jub)) - - ! loop 5-104 - do j=G%jsc,G%jec ; do i=G%isc,G%iec - lon_scale = cos((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J-1 ) + & - G%geoLatBu(I-1,J) + G%geoLatBu(I,J)) * atan(1.0)/180) - angle = atan2((G%geoLonBu(I-1,J) + G%geoLonBu(I,J) - & - G%geoLonBu(I-1,J-1) - G%geoLonBu(I,J-1))*lon_scale, & - G%geoLatBu(I-1,J) + G%geoLatBu(I,J) - & - G%geoLatBu(I-1,J-1) - G%geoLatBu(I,J-1) ) - OG%sin_rot(i+ishift,j+jshift) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean - OG%cos_rot(i+ishift,j+jshift) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) - enddo ; enddo - !print *, minval(OG%sin_rot), maxval(OG%sin_rot) - !print *, minval(OG%cos_rot), maxval(OG%cos_rot) - - end subroutine -#endif - - -end module mom_cap_mod diff --git a/config_src/nuopc_driver/backup/mom_cap.F90.02 b/config_src/nuopc_driver/backup/mom_cap.F90.02 deleted file mode 100644 index 632825be2d..0000000000 --- a/config_src/nuopc_driver/backup/mom_cap.F90.02 +++ /dev/null @@ -1,2432 +0,0 @@ -!> -!! @mainpage MOM NUOPC Cap -!! @author Fei Liu (fei.liu@gmail.com) -!! @date 5/10/13 Original documentation -!! @author Rocky Dunlap (rocky.dunlap@noaa.gov) -!! @date 1/12/17 Moved to doxygen -!! -!! @tableofcontents -!! -!! @section Overview Overview -!! -!! **This MOM cap has been tested with MOM5 and MOM6.** -!! -!! This document describes the MOM "cap", which is a small software layer that is -!! required when the [MOM ocean model] (http://mom-ocean.org/web) -!! is used in [National Unified Operation Prediction Capability] -!! (http://www.earthsystemcog.org/projects/nuopc) (NUOPC) coupled systems. -!! The NUOPC Layer is a software layer built on top of the [Earth System Modeling -!! Framework] (https://www.earthsystemcog.org/projects/esmf) (ESMF). -!! ESMF is a high-performance modeling framework that provides -!! data structures, interfaces, and operations suited for building coupled models -!! from a set of components. NUOPC refines the capabilities of ESMF by providing -!! a more precise definition of what it means for a model to be a component and -!! how components should interact and share data in a coupled system. The NUOPC -!! Layer software is designed to work with typical high-performance models in the -!! Earth sciences domain, most of which are written in Fortran and are based on a -!! distributed memory model of parallelism (MPI). -!! A NUOPC "cap" is a Fortran module that serves as the interface to a model -!! when it's used in a NUOPC-based coupled system. -!! The term "cap" is used because it is a small software layer that sits on top -!! of model code, making calls into it and exposing model data structures in a -!! standard way. For more information about creating NUOPC caps in general, please -!! see the [Building a NUOPC Model] -!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_howtodoc/) -!! how-to document. -!! -!! The MOM cap package includes the cap itself (mom_cap.F90, a Fortran module), a -!! set of time utilities (time_utils.F90) for converting between ESMF and FMS -!! time types, and two makefiles. Also included are self-describing dependency -!! makefile fragments (mom.mk and mom.mk.template), although these can be generated -!! by the makefiles for specific installations of the MOM cap. -!! -!! @subsection CapSubroutines Cap Subroutines -!! -!! The MOM cap Fortran module contains a set of subroutines that are required -!! by NUOPC. These subroutines are called by the NUOPC infrastructure according -!! to a predefined calling sequence. Some subroutines are called during -!! initialization of the coupled system, some during the run of the coupled -!! system, and some during finalization of the coupled system. The initialization -!! sequence is the most complex and is governed by the NUOPC technical rules. -!! Details about the initialization sequence can be found in the [NUOPC Reference Manual] -!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html#SECTION00034000000000000000). -!! -!! A particularly important part of the NUOPC intialization sequence is to establish -!! field connections between models. Simply put, a field connection is established -!! when a field output by one model can be consumed by another. As an example, the -!! MOM model is able to accept a precipitation rate when coupled to an atmosphere -!! model. In this case a field connection will be established between the precipitation -!! rate exported from the atmosphere and the precipitation rate imported into the -!! MOM model. Because models may uses different variable names for physical -!! quantities, NUOPC relies on a set of standard names and a built-in, extensible -!! standard name dictionary to match fields between models. More information about -!! the use of standard names can be found in the [NUOPC Reference Manual] -!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html#SECTION00032000000000000000). -!! -!! Two key initialization phases that appear in every NUOPC cap, including this MOM -!! cap are the field "advertise" and field "realize" phases. *Advertise* is a special -!! NUOPC term that refers to a model participating in a coupled system -!! providing a list of standard names of required import fields and available export -!! fields. In other words, each model will advertise to the other models which physical fields -!! it needs and which fields it can provide when coupled. NUOPC compares all of the advertised -!! standard names and creates a set of unidirectional links, each from one export field -!! in a model to one import field in another model. When these connections have been established, -!! all models in the coupled system need to provide a description of their geographic -!! grid (e.g., lat-lon, tri-polar, cubed sphere, etc.) and allocate their connected -!! fields on that grid. In NUOPC terms, this is refered to as *realizing* a set of -!! fields. NUOPC relies on ESMF data types for this, such as the [ESMF_Grid] -!! (http://www.earthsystemmodeling.org/esmf_releases/public/last/ESMF_refdoc/node5.html#SECTION05080000000000000000) -!! type, which describes logically rectangular grids and the [ESMF_Field] -!! (http://www.earthsystemmodeling.org/esmf_releases/public/last/ESMF_refdoc/node5.html#SECTION05030000000000000000) -!! type, which wraps a models data arrays and provides basic metadata. Because ESMF supports -!! interpolation between different grids (sometimes called "regridding" or "grid remapping"), -!! it is not necessary that models share a grid. As you will see below -!! the *advertise* and *realize* phases each have a subroutine in the HYCOM cap. -!! -!! The following table summarizes the NUOPC-required subroutines that appear in the -!! MOM cap. The "Phase" column says whether the subroutine is called during the -!! initialization, run, or finalize part of the coupled system run. -!! -!! Phase | MOM Cap Subroutine | Description -!! ---------|--------------------------------------------------------------------|------------------------------------------------------------- -!! Init | [InitializeP0] (@ref mom_cap_mod::initializep0) | Sets the Initialize Phase Definition (IPD) version to use -!! Init | [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) | Advertises standard names of import and export fields -!! Init | [InitializeRealize] (@ref mom_cap_mod::initializerealize) | Creates an ESMF_Grid for the MOM grid as well as ESMF_Fields for import and export fields -!! Run | [ModelAdvance] (@ref mom_cap_mod::modeladvance) | Advances the model by a timestep -!! Final | [Finalize] (@ref mom_cap_mod::ocean_model_finalize) | Cleans up -!! -!! @section UnderlyingModelInterfaces Underlying Model Interfaces -!! -!! -!! @subsection DomainCreation Domain Creation -!! -!! The MOM tripolar grid is represented as a 2D `ESMF_Grid` and coupling fields are placed -!! on this grid. Calls related to creating the grid are located in the [InitializeRealize] -!! (@ref mom_cap_mod::initializerealize) subroutine, which is called by the NUOPC infrastructure -!! during the intialization sequence. -!! -!! The cap determines parameters for setting up the grid by calling subroutines in the -!! `mpp_domains_mod` module. The global domain size is determined by calling `mpp_get_global_domain()`. -!! A check is in place to ensure that there is only a single tile in the domain (the -!! cap is currently limited to one tile; multi-tile mosaics are not supported). The -!! decomposition across processors is determined via calls to `mpp_get_compute_domains()` -!! (to retrieve decomposition block indices) and `mpp_get_pelist()` (to determine how -!! blocks are assigned to processors). -!! -!! The grid is created in several steps: -!! - an `ESMF_DELayout` is created based on the pelist from MOM -!! - an `ESMF_DistGrid` is created over the global index space. Connections are set -!! up so that the index space is periodic in the first dimension and has a -!! fold at the top for the bipole. The decompostion blocks are also passed in -!! along with the `ESMF_DELayout` mentioned above. -!! - an `ESMF_Grid` is then created by passing in the above `ESMF_DistGrid`. -!! -!! Masks, areas, center (tlat, tlon), and corner (ulat, ulon) coordinates are then added to the `ESMF_Grid` -!! by retrieving those fields from MOM with calls to `ocean_model_data_get()`. -!! -!! @subsection Initialization Initialization -!! -!! During the [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) phase, calls are -!! made to MOM's native initialization subroutines, including `fms_init()`, `constants_init()`, -!! `field_manager_init()`, `diag_manager_init()`, and `set_calendar_type()`. The MPI communicator -!! is pulled in through the ESMF VM object for the MOM component. The dt and start time are set -!! from parameters from the incoming ESMF clock with calls to `set_time()` and `set_date().` -!! -!! -!! @subsection Run Run -!! -!! The [ModelAdvance] (@ref mom_cap_mod::modeladvance) subroutine is called by the NUOPC -!! infrastructure when it's time for MOM to advance in time. During this subroutine, there is a -!! call into the MOM update routine: -!! -!! call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_public, Time, Time_step_coupled) -!! -!! Prior to this call, the cap performs a few steps: -!! - the `Time` and `Time_step_coupled` parameters, which are based on FMS types, are derived from the incoming ESMF clock -!! - there are calls to two stubs: `ice_ocn_bnd_from_data()` and `external_coupler_sbc_before()` - these are currently -!! inactive, but may be modified to read in import data from file or from an external coupler -!! - diagnostics are optionally written to files `field_ocn_import_*`, one for each import field -!! - import fields are prepared: -!! - the sign is reversed on `mean_evap_rate` and `mean_sensi_heat_flux` -!! - momentum flux vectors are rotated to internal grid -!! - optionally, a call is made to `ocean_model_restart()` at the interval `restart_interval` -!! -!! After the call to `update_ocean_model()`, the cap performs these steps: -!! - the `ocean_mask` export is set to match that of the internal MOM mask -!! - the `freezing_melting_potential` export is converted from J m-2 to W m-2 by dividing by the coupling interval -!! - vector rotations are applied to the `ocean_current_zonal` and `ocean_current_merid` exports, back to lat-lon grid -!! - diagnostics are optionally written to files `field_ocn_export_*`, one for each export field -!! - a call is made to `external_coupler_sbc_after()` to update exports from an external coupler (currently an inactive stub) -!! - calls are made to `dumpMomInternal()` to write files `field_ocn_internal_*` for all internal fields (both import and export) -!! -!! @subsubsection VectorRotations Vector Rotations -!! -!! Vector rotations are applied to incoming momentum fluxes (from regular lat-lon to tripolar grid) and -!! outgoing ocean currents (from tripolar to regular lat-lon). The rotation angles are provided -!! from the native MOM grid by a call to `get_ocean_grid(Ocean_grid)`. -!! The cosine and sine of the rotation angle are: -!! -!! Ocean_grid%cos_rot(i,j) -!! Ocean_grid%sin_rot(i,j) -!! -!! The rotation of momentum flux from regular lat-lon to tripolar is: -!! \f[ -!! \begin{bmatrix} -!! \tau_x' \\ -!! \tau_y' -!! \end{bmatrix} = -!! \begin{bmatrix} -!! cos \theta & sin \theta \\ -!! -sin \theta & cos \theta -!! \end{bmatrix} * -!! \begin{bmatrix} -!! \tau_x \\ -!! \tau_y -!! \end{bmatrix} -!! \f] -!! -!! The rotation of ocean current from tripolar to regular lat-lon is: -!! \f[ -!! \begin{bmatrix} -!! u' \\ -!! v' -!! \end{bmatrix} = -!! \begin{bmatrix} -!! cos \theta & -sin \theta \\ -!! sin \theta & cos \theta -!! \end{bmatrix} * -!! \begin{bmatrix} -!! u \\ -!! v -!! \end{bmatrix} -!! \f] -!! @subsection Finalization Finalization -!! -!! NUOPC infrastructure calls [ocean_model_finalize] (@ref mom_cap_mod::ocean_model_finalize) -!! at the end of the run. This subroutine is a hook to call into MOM's native shutdown -!! procedures: -!! -!! call ocean_model_end (Ocean_public, Ocean_State, Time) -!! call diag_manager_end(Time ) -!! call field_manager_end -!! call fms_io_exit -!! call fms_end -!! -!! @section ModelFields Model Fields -!! -!! The following tables list the import and export fields currently set up in the MOM cap. -!! -!! @subsection ImportFields Import Fields -!! -!! Standard Name | Units | Model Variable | Description | Notes -!! ----------------------------------|------------|-----------------|-----------------------------------------------|-------------------------------------- -!! inst_pres_height_surface | Pa | p | pressure of overlying sea ice and atmosphere | | -!! mass_of_overlying_sea_ice | kg | mi | mass of overlying sea ice | | -!! mean_calving_heat_flx | W m-2 | calving_hflx | heat flux, relative to 0C, of frozen land water into ocean | | -!! mean_calving_rate | kg m-2 s-1 | calving | mass flux of frozen runoff | | -!! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | sign reversed (- evap) -!! mean_fprec_rate | kg m-2 s-1 | fprec | mass flux of frozen precip | | -!! mean_merid_moment_flx | Pa | v_flux | j-directed wind stress into ocean | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar -!! mean_net_lw_flx | W m-2 | lw_flux | long wave radiation | | -!! mean_net_sw_ir_dif_flx | W m-2 | sw_flux_nir_dif | diffuse near IR shortwave radiation | | -!! mean_net_sw_ir_dir_flx | W m-2 | sw_flux_nir_dir | direct near IR shortwave radiation | | -!! mean_net_sw_vis_dif_flx | W m-2 | sw_flux_vis_dif | diffuse visible shortware radiation | | -!! mean_net_sw_vis_dir_flx | W m-2 | sw_flux_vis_dir | direct visible shortware radiation | | -!! mean_prec_rate | kg m-2 s-1 | lprec | mass flux of liquid precip | | -!! mean_runoff_heat_flx | W m-2 | runoff_hflx | heat flux, relative to 0C, of liquid land water into ocean | | -!! mean_runoff_rate | kg m-2 s-1 | runoff | mass flux of liquid runoff | | -!! mean_salt_rate | kg m-2 s-1 | salt_flux | salt flux | | -!! mean_sensi_heat_flx | W m-2 | t_flux | sensible heat flux into ocean | sign reversed (- sensi) -!! mean_zonal_moment_flx | Pa | u_flux | j-directed wind stress into ocean | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar -!! -!! -!! @subsection ExportField Export Fields -!! -!! Export fields are populated from the `ocean_public` parameter (type `ocean_public_type`) -!! after the call to `update_ocean_model()`. -!! -!! Standard Name | Units | Model Variable | Description | Notes -!! ----------------------------------|------------|-----------------|-------------------------------------------|--------------------------------------------------------------------- -!! freezing_melting_potential | W m-2 | frazil | accumulated heating from frazil formation | cap converts model units (J m-2) to (W m-2) for export -!! ocean_mask | | | ocean mask | | -!! ocn_current_merid | m s-1 | v_surf | j-directed surface velocity on u-cell | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon -!! ocn_current_zonal | m s-1 | u_surf | i-directed surface velocity on u-cell | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon -!! s_surf | psu | s_surf | sea surface salinity on t-cell | | -!! sea_lev | m | sea_lev | sea level | model computation is eta_t + patm/(rho0*grav) - eta_geoid - eta_tide -!! sea_surface_temperature | K | t_surf | sea surface temperature on t-cell | | -!! -!! @subsection MemoryManagement Memory Management -!! -!! The MOM cap has an internal state type with pointers to three -!! types defined by MOM. There is also a small wrapper derived type -!! required to associate an internal state instance -!! with the ESMF/NUOPC component: -!! -!! type ocean_internalstate_type -!! type(ocean_public_type), pointer :: ocean_public_type_ptr -!! type(ocean_state_type), pointer :: ocean_state_type_ptr -!! type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr -!! end type -!! -!! type ocean_internalstate_wrapper -!! type(ocean_internalstate_type), pointer :: ptr -!! end type -!! -!! The member of type `ocean_public_type` stores ocean surface fields used during the coupling. -!! The member of type `ocean_state_type` is required by the ocean driver, -!! although its internals are private (not to be used by the coupling directly). -!! This type is passed to the ocean init and update routines -!! so that it can maintain state there if desired. -!! The member of type `ice_ocean_boundary_type` is populated by this cap -!! with incoming coupling fields from other components. These three derived types are allocated during the -!! [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) phase. Also during that -!! phase, the `ice_ocean_boundary` type members are all allocated using bounds retrieved -!! from `mpp_get_compute_domain()`. -!! -!! During the [InitializeRealize] (@ref mom_cap_mod::initializerealize) phase, -!! `ESMF_Field`s are created for each of the coupling fields in the `ice_ocean_boundary` -!! and `ocean_public_type` members of the internal state. These fields directly reference into the members of -!! the `ice_ocean_boundary` and `ocean_public_type` so that memory-to-memory copies are not required to move -!! data from the cap's import and export states to the memory areas used internally -!! by MOM. -!! -!! @subsection IO I/O -!! -!! The cap can optionally output coupling fields for diagnostic purposes if the ESMF attribute -!! "DumpFields" has been set to "true". In this case the cap will write out NetCDF files -!! with names "field_ocn_import_.nc" and "field_ocn_export_.nc". -!! Additionally, calls will be made to the cap subroutine [dumpMomInternal] -!! (@ref mom_cap_mod::dumpmominternal) to write out model internal fields to files -!! named "field_ocn_internal_.nc". In all cases these NetCDF files will -!! contain a time series of field data. -!! -!! @section BuildingAndInstalling Building and Installing -!! -!! There are two makefiles included with the MOM cap, makefile and makefile.nuopc. -!! The makefile.nuopc file is intended to be used within another build system, such -!! as the NEMSAppBuilder. The regular makefile can be used generally for building -!! and installing the cap. Two variables must be customized at the top: -!! - `INSTALLDIR` - where to copy the cap library and dependent libraries -!! - `NEMSMOMDIR` - location of the MOM library and FMS library -!! -!! To install run: -!! $ make install -!! -!! A makefile fragment, mom.mk, will also be copied into the directory. The fragment -!! defines several variables that can be used by another build system to include the -!! MOM cap and its dependencies. -!! -!! @subsection Dependencies Dependencies -!! -!! The MOM cap is dependent on the MOM library itself (lib_ocean.a) and the FMS -!! library (lib_FMS.a). -!! -!! @section RuntimeConfiguration Runtime Configuration -!! -!! At runtime, the MOM cap can be configured with several options provided -!! as ESMF attributes. Attributes can be set in the cap by the NUOPC Driver -!! above this cap, or in some systems (e.g., NEMS) attributes are set by -!! reading in from a configuration file. The available attributes are: -!! -!! * `DumpFields` - when set to "true", write out diagnostic NetCDF files for import/export/internal fields -!! * `ProfileMemory` - when set to "true", write out memory usage information to the ESMF log files; this -!! information is written when entering and leaving the [ModelAdvance] -!! (@ref mom_cap_mod::modeladvance) subroutine and before and after the call to -!! `update_ocean_model()`. -!! * `OceanSolo` - when set to "true", this option indicates that MOM is being run -!! uncoupled; in this case the vector rotations and other data manipulations -!! on import fields are skipped -!! * `restart_interval` - integer number of seconds indicating the interval at -!! which to call `ocean_model_restart()`; no restarts written if set to 0 -!! * `GridAttachArea` - when set to "true", this option indicates that MOM grid attaches cell area -!! using internal values computed in MOM. The default value is "false", grid cell area will -!! be computed in ESMF. -!! -!! -!! @section Repository -!! The MOM NUOPC cap is maintained in a GitHub repository: -!! https://github.com/feiliuesmf/nems_mom_cap -!! -!! @section References -!! -!! - [MOM Home Page] (http://mom-ocean.org/web) -!! -!! -module mom_cap_mod - use constants_mod, only: constants_init - use data_override_mod, only: data_override_init, data_override - use diag_manager_mod, only: diag_manager_init, diag_manager_end - use field_manager_mod, only: field_manager_init, field_manager_end - use fms_mod, only: fms_init, fms_end, open_namelist_file, check_nml_error - use fms_mod, only: close_file, file_exist, uppercase - use fms_io_mod, only: fms_io_exit - use mpp_domains_mod, only: domain2d, mpp_get_compute_domain, mpp_get_compute_domains - use mpp_domains_mod, only: mpp_get_ntile_count, mpp_get_pelist, mpp_get_global_domain - use mpp_domains_mod, only: mpp_get_domain_npes, mpp_global_field - use mpp_io_mod, only: mpp_open, MPP_RDONLY, MPP_ASCII, MPP_OVERWR, MPP_APPEND, mpp_close, MPP_SINGLE - use mpp_mod, only: input_nml_file, mpp_error, FATAL, NOTE, mpp_pe, mpp_npes, mpp_set_current_pelist - use mpp_mod, only: stdlog, stdout, mpp_root_pe, mpp_clock_id - use mpp_mod, only: mpp_clock_begin, mpp_clock_end, MPP_CLOCK_SYNC - use mpp_mod, only: MPP_CLOCK_DETAILED, CLOCK_COMPONENT, MAXPES - use time_interp_external_mod, only: time_interp_external_init - use time_manager_mod, only: set_calendar_type, time_type, increment_date - use time_manager_mod, only: set_time, set_date, get_time, get_date, month_name - use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR - use time_manager_mod, only: operator( <= ), operator( < ), operator( >= ) - use time_manager_mod, only: operator( + ), operator( - ), operator( / ) - use time_manager_mod, only: operator( * ), operator( /= ), operator( > ) - use time_manager_mod, only: date_to_string - use time_manager_mod, only: fms_get_calendar_type => get_calendar_type - use MOM_domains, only: MOM_infra_init, num_pes, root_pe, pe_here - -#ifdef CESMCOUPLED - use ocn_comp_nuopc, only: ocean_public_type, ocean_state_type - use ocn_comp_nuopc, only: update_ocean_model, ocean_model_init - use ocn_comp_nuopc, only: ocn_export, get_ocean_grid, ocean_model_data_get - use ocn_comp_nuopc, only: ocean_model_end, ocean_model_init_sfc -#else - use ocean_model_mod, only: ocean_model_restart, ocean_public_type, ocean_state_type - use ocean_model_mod, only: ocean_model_data_get - use ocean_model_mod, only: ocean_model_init , update_ocean_model, ocean_model_end, get_ocean_grid -#endif - use MOM_file_parser, only: get_param, log_version, param_file_type, close_param_file - use MOM_get_input, only: Get_MOM_Input, directories - use MOM_domains, only: pass_var -#ifdef MOM6_CAP - use ocean_model_mod, only: ice_ocean_boundary_type - use MOM_grid, only: ocean_grid_type -#else - use ocean_types_mod, only: ice_ocean_boundary_type, ocean_grid_type -#endif -#ifdef CESMCOUPLED - use shr_nuopc_flds_mod, only: flds_scalar_name - use shr_nuopc_flds_mod, only: flds_x2o, flds_o2x, flds_x2o_map, flds_o2x_map - use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_SetScalarField, shr_nuopc_fldList_type - use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Advertise, shr_nuopc_fldList_Realize - use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Zero, shr_nuopc_fldList_Add - use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_fromflds -#endif - - use ESMF - use NUOPC - use NUOPC_Model, & - model_routine_SS => SetServices, & - model_label_Advance => label_Advance, & - model_label_Finalize => label_Finalize - - use time_utils_mod - - implicit none - private - public SetServices - - type ocean_internalstate_type - type(ocean_public_type), pointer :: ocean_public_type_ptr - type(ocean_state_type), pointer :: ocean_state_type_ptr - type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr - type(ocean_grid_type), pointer :: ocean_grid_ptr - end type - - type ocean_internalstate_wrapper - type(ocean_internalstate_type), pointer :: ptr - end type - -#ifdef CESMCOUPLED - type (shr_nuopc_fldList_Type) :: fldsToOcn - type (shr_nuopc_fldList_Type) :: fldsFrOcn -#else - type fld_list_type - character(len=64) :: stdname - character(len=64) :: shortname - character(len=64) :: transferOffer - logical :: assoc ! is the farrayPtr associated with internal data - real(ESMF_KIND_R8), dimension(:,:), pointer :: farrayPtr - end type fld_list_type - - integer,parameter :: fldsMax = 100 - integer :: fldsToOcn_num = 0 - type (fld_list_type) :: fldsToOcn(fldsMax) - integer :: fldsFrOcn_num = 0 - type (fld_list_type) :: fldsFrOcn(fldsMax) -#endif - - integer :: import_slice = 1 - integer :: export_slice = 1 - character(len=256) :: tmpstr - integer :: dbrc - - type(ESMF_Grid) :: mom_grid_i - logical :: write_diagnostics = .true. - logical :: profile_memory = .true. - logical :: ocean_solo = .true. - logical :: grid_attach_area = .false. - integer(ESMF_KIND_I8) :: restart_interval - logical :: sw_decomp - real(ESMF_KIND_R8) :: c1, c2, c3, c4 - character(len=*),parameter :: u_file_u = __FILE__ - - contains - !----------------------------------------------------------------------- - !------------------- Solo Ocean code starts here ----------------------- - !----------------------------------------------------------------------- - - !> NUOPC SetService method is the only public entry point. - !! SetServices registers all of the user-provided subroutines - !! in the module with the NUOPC layer. - !! - !! @param gcomp an ESMF_GridComp object - !! @param rc return code - subroutine SetServices(gcomp, rc) - - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - character(len=*),parameter :: subname='(mom_cap:SetServices)' - - rc = ESMF_SUCCESS - - ! the NUOPC model component will register the generic methods - call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! switching to IPD versions - call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - userRoutine=InitializeP0, phase=0, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! set entry point for methods that require specific implementation - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv01p1"/), userRoutine=InitializeAdvertise, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv01p3"/), userRoutine=InitializeRealize, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! attach specializing method(s) - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & - specRoutine=ModelAdvance, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & - specRoutine=ocean_model_finalize, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end subroutine SetServices - - !----------------------------------------------------------------------------- - - !> First initialize subroutine called by NUOPC. The purpose - !! is to set which version of the Initialize Phase Definition (IPD) - !! to use. - !! - !! For this MOM cap, we are using IPDv01. - !! - !! @param gcomp an ESMF_GridComp object - !! @param importState an ESMF_State object for import fields - !! @param exportState an ESMF_State object for export fields - !! @param clock an ESMF_Clock object - !! @param rc return code - subroutine InitializeP0(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=10) :: value - character(len=*),parameter :: subname='(mom_cap:InitializeP0)' - - rc = ESMF_SUCCESS - - ! Switch to IPDv01 by filtering all other phaseMap entries - call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, & - acceptStringList=(/"IPDv01p"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_AttributeGet(gcomp, name="DumpFields", value=value, defaultValue="false", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - write_diagnostics=(trim(value)=="true") - call ESMF_LogWrite('MOM_CAP:DumpFields = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_AttributeGet(gcomp, name="ProfileMemory", value=value, defaultValue="true", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - profile_memory=(trim(value)/="false") - call ESMF_LogWrite('MOM_CAP:ProfileMemory = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_AttributeGet(gcomp, name="OceanSolo", value=value, defaultValue="false", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ocean_solo=(trim(value)=="true") - call ESMF_LogWrite('MOM_CAP:OceanSolo = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) - - ! Retrieve restart_interval in (seconds) - ! A restart_interval value of 0 means no restart will be written. - call ESMF_AttributeGet(gcomp, name="restart_interval", value=value, defaultValue="0", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - restart_interval = ESMF_UtilString2Int(value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if(restart_interval < 0) then - call ESMF_LogSetError(ESMF_RC_NOT_VALID, & - msg="MOM_CAP: OCN attribute: restart_interval cannot be negative.", & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return - endif - call ESMF_LogWrite('MOM_CAP:restart_interval = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_AttributeGet(gcomp, name="GridAttachArea", value=value, defaultValue="false", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - grid_attach_area=(trim(value)=="true") - call ESMF_LogWrite('MOM_CAP:GridAttachArea = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) - - end subroutine - - !----------------------------------------------------------------------------- - - !> Called by NUOPC to advertise import and export fields. "Advertise" - !! simply means that the standard names of all import and export - !! fields are supplied. The NUOPC layer uses these to match fields - !! between components in the coupled system. - !! - !! @param gcomp an ESMF_GridComp object - !! @param importState an ESMF_State object for import fields - !! @param exportState an ESMF_State object for export fields - !! @param clock an ESMF_Clock object - !! @param rc return code - subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - type(ESMF_VM) :: vm - type(ESMF_Time) :: MyTime - type(ESMF_TimeInterval) :: TINT - - type (ocean_public_type), pointer :: Ocean_public => NULL() - type (ocean_state_type), pointer :: Ocean_state => NULL() - type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() - type(ocean_internalstate_wrapper) :: ocean_internalstate - - type(time_type) :: Run_len ! length of experiment - type(time_type) :: Time - type(time_type) :: Time_restart - type(time_type) :: DT - integer :: DT_OCEAN - integer :: isc,iec,jsc,jec - integer :: dt_cpld = 86400 - integer :: year=0, month=0, day=0, hour=0, minute=0, second=0 - integer :: mpi_comm_mom - integer :: npes, pe0, i - - type(ESMF_Grid) :: gridIn - type(ESMF_Grid) :: gridOut - type(param_file_type) :: param_file !< A structure to parse for run-time parameters - type(directories) :: dirs_tmp !< A structure containing several relevant directory paths - character(len=384) :: pointer_filename - integer :: npet, npet_x, npet_y - character(len=*),parameter :: subname='(mom_cap:InitializeAdvertise)' - - rc = ESMF_SUCCESS - - allocate(Ice_ocean_boundary) - !allocate(Ocean_state) ! ocean_model_init allocate this pointer - allocate(Ocean_public) - allocate(ocean_internalstate%ptr) - ocean_internalstate%ptr%ice_ocean_boundary_type_ptr => Ice_ocean_boundary - ocean_internalstate%ptr%ocean_public_type_ptr => Ocean_public - ocean_internalstate%ptr%ocean_state_type_ptr => Ocean_state - - call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_VMGet(VM, mpiCommunicator=mpi_comm_mom, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_ClockGet(CLOCK, currTIME=MyTime, TimeStep=TINT, RC=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_TimeGet (MyTime, & - YY=YEAR, MM=MONTH, DD=DAY, & - H=HOUR, M =MINUTE, S =SECOND, & - RC=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - CALL ESMF_TimeIntervalGet(TINT, S=DT_OCEAN, RC=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - -#ifdef CESMCOUPLED - - ! Initialize MOM6 comm - call MOM_infra_init(mpi_comm_mom) - call set_calendar_type(NOLEAP) !TODO: confirm this - Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) - -! tcx, todo, first coupling period -! ! Compute time_in: time at the beginning of the first ocn coupling interval -! call ESMF_ClockGet(EClock, TimeStep=ocn_cpl_interval, rc=rc) -! if (runtype /= "continue") then -! ! In startup runs, take the one ocn coupling interval lag into account to -! ! compute the initial ocn time. (time_in = time_init + ocn_cpl_interval) -! time_in_ESMF = ESMF_TimeInc(current_time, ocn_cpl_interval) -! else -! time_in_ESMF = current_time -! endif -! call ESMF_TimeGet(time_in_ESMF, yy=year, mm=month, dd=day, h=hour, m=minute, s=seconds, rc=rc) -! time_in = set_date(year, month, day, hour, minute, seconds, err_msg=err_msg) - -! tcx, todo, restart -! if (runtype == "initial") then ! startup (new run) - 'n' is needed below since we don't -! ! specify input_filename in input.nml - call ocean_model_init(ocean_public, ocean_state, time, time, input_restart_file = 'n') -! else ! hybrid or branch or continuos runs -! ! output path root -! call seq_infodata_GetData( glb%infodata, outPathRoot=restartpath ) -! ! read name of restart file in the pointer file -! nu = shr_file_getUnit() -! restart_pointer_file = trim(glb%pointer_filename) -! if (is_root_pe()) write(glb%stdout,*) 'Reading ocn pointer file: ',restart_pointer_file -! open(nu, file=restart_pointer_file, form='formatted', status='unknown') -! read(nu,'(a)') restartfile -! close(nu) -! !restartfile = trim(restartpath) // trim(restartfile) -! if (is_root_pe()) write(glb%stdout,*) 'Reading restart file: ',trim(restartfile) -! !endif -! call shr_file_freeUnit(nu) -! call ocean_model_init(glb%ocean_public, glb%ocn_state, time_init, time_in, input_restart_file=trim(restartfile)) -! endif - - npes = num_pes() - pe0 = root_pe() - - Ocean_public%is_ocean_pe = .true. - allocate(ocean_public%pelist(npes)) - ocean_public%pelist(:) = (/(i,i=pe0,pe0+npes)/) - - ! This include declares and sets the variable "version". - ! read useful runtime params - call get_MOM_Input(param_file, dirs_tmp, check_params=.false.) - !call log_version(param_file, subname, version, "") - call get_param(param_file, subname, "POINTER_FILENAME", pointer_filename, & - "Name of the ascii file that contains the path and filename of" // & - " the latest restart file.", default='rpointer.ocn') - call get_param(param_file, subname, "SW_DECOMP", sw_decomp, & - "If True, read coeffs c1, c2, c3 and c4 and decompose" // & - "the net shortwave radiation (SW) into four components:\n" // & - "visible, direct shortwave = c1 * SW \n" // & - "visible, diffuse shortwave = c2 * SW \n" // & - "near-IR, direct shortwave = c3 * SW \n" // & - "near-IR, diffuse shortwave = c4 * SW", default=.true.) - if (sw_decomp) then - call get_param(param_file, subname, "SW_c1", c1, & - "Coeff. used to convert net shortwave rad. into \n"//& - "visible, direct shortwave.", units="nondim", default=0.285) - call get_param(param_file, subname, "SW_c2", c2, & - "Coeff. used to convert net shortwave rad. into \n"//& - "visible, diffuse shortwave.", units="nondim", default=0.285) - call get_param(param_file, subname, "SW_c3", c3, & - "Coeff. used to convert net shortwave rad. into \n"//& - "near-IR, direct shortwave.", units="nondim", default=0.215) - call get_param(param_file, subname, "SW_c4", c4, & - "Coeff. used to convert net shortwave rad. into \n"//& - "near-IR, diffuse shortwave.", units="nondim", default=0.215) - else - c1 = 0.0; c2 = 0.0; c3 = 0.0; c4 = 0.0 - endif - - ! Initialize ocn_state%state out of sight - call ocean_model_init_sfc(ocean_state, ocean_public) - -#else - call fms_init(mpi_comm_mom) - call constants_init - call field_manager_init - call set_calendar_type (JULIAN ) - call diag_manager_init - ! this ocean connector will be driven at set interval - dt_cpld = DT_OCEAN - DT = set_time (DT_OCEAN, 0) - Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) - - Ocean_public%is_ocean_pe = .true. - call ocean_model_init(Ocean_public, Ocean_state, Time, Time) - -!tcx tcraig This results in errors in CESM with help from Alper -! FATAL error "MPP_OPEN: error in OPEN for data_table" -! The subroutine data_override_init shouldn't be called because ALLOW_FLUX_ADJUSTMENTS is set to FALSE -!tcx call data_override_init(Ocean_domain_in = Ocean_public%domain) - - call mpp_get_compute_domain(Ocean_public%domain, isc, iec, jsc, jec) - - allocate ( Ice_ocean_boundary% u_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% v_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% t_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% q_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% salt_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% lw_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_vis_dir (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_vis_dif (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_nir_dir (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_nir_dif (isc:iec,jsc:jec), & - Ice_ocean_boundary% lprec (isc:iec,jsc:jec), & - Ice_ocean_boundary% fprec (isc:iec,jsc:jec), & - Ice_ocean_boundary% runoff (isc:iec,jsc:jec), & - Ice_ocean_boundary% calving (isc:iec,jsc:jec), & - Ice_ocean_boundary% runoff_hflx (isc:iec,jsc:jec), & - Ice_ocean_boundary% calving_hflx (isc:iec,jsc:jec), & - Ice_ocean_boundary% mi (isc:iec,jsc:jec), & - Ice_ocean_boundary% p (isc:iec,jsc:jec)) - - Ice_ocean_boundary%u_flux = 0.0 - Ice_ocean_boundary%v_flux = 0.0 - Ice_ocean_boundary%t_flux = 0.0 - Ice_ocean_boundary%q_flux = 0.0 - Ice_ocean_boundary%salt_flux = 0.0 - Ice_ocean_boundary%lw_flux = 0.0 - Ice_ocean_boundary%sw_flux_vis_dir = 0.0 - Ice_ocean_boundary%sw_flux_vis_dif = 0.0 - Ice_ocean_boundary%sw_flux_nir_dir = 0.0 - Ice_ocean_boundary%sw_flux_nir_dif = 0.0 - Ice_ocean_boundary%lprec = 0.0 - Ice_ocean_boundary%fprec = 0.0 - Ice_ocean_boundary%runoff = 0.0 - Ice_ocean_boundary%calving = 0.0 - Ice_ocean_boundary%runoff_hflx = 0.0 - Ice_ocean_boundary%calving_hflx = 0.0 - Ice_ocean_boundary%mi = 0.0 - Ice_ocean_boundary%p = 0.0 -#endif - - call external_coupler_sbc_init(Ocean_public%domain, dt_cpld, Run_len) - - ocean_internalstate%ptr%ocean_state_type_ptr => Ocean_state - call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call MOM_FieldsSetup(ice_ocean_boundary, ocean_public) - -#ifdef CESMCOUPLED - call shr_nuopc_fldList_Advertise(importState, fldsToOcn, subname//':MOM6Import', rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - call shr_nuopc_fldList_Advertise(exportState, fldsFrOcn, subname//':MOM6Export', rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return -#else - call MOM_AdvertiseFields(importState, fldsToOcn_num, fldsToOcn, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call MOM_AdvertiseFields(exportState, fldsFrOcn_num, fldsFrOcn, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -#endif - -#ifdef MOM6_CAP - ! When running mom6 solo, the rotation angles are not computed internally - ! in MOM6. We need to - ! calculate cos and sin of rotational angle for MOM6; the values - ! are stored in ocean_internalstate%ptr%ocean_grid_ptr%cos_rot and sin_rot - ! The rotation angles are retrieved during run time to rotate incoming - ! and outgoing vectors - ! - call calculate_rot_angle(Ocean_state, ocean_public, & - ocean_internalstate%ptr%ocean_grid_ptr) -#endif - - write(*,*) '----- MOM initialization phase Advertise completed' - - end subroutine InitializeAdvertise - - !----------------------------------------------------------------------------- - - !> Called by NUOPC to realize import and export fields. "Realizing" a field - !! means that its grid has been defined and an ESMF_Field object has been - !! created and put into the import or export State. - !! - !! @param gcomp an ESMF_GridComp object - !! @param importState an ESMF_State object for import fields - !! @param exportState an ESMF_State object for export fields - !! @param clock an ESMF_Clock object - !! @param rc return code - subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - ! Local Variables - type(ESMF_VM) :: vm - type(ESMF_Grid) :: gridIn - type(ESMF_Grid) :: gridOut - type(ESMF_DeLayout) :: delayout - type(ESMF_Distgrid) :: Distgrid - type(ESMF_DistGridConnection), allocatable :: connectionList(:) - type (ocean_public_type), pointer :: Ocean_public => NULL() - type (ocean_state_type), pointer :: Ocean_state => NULL() - type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() - type(ocean_internalstate_wrapper) :: ocean_internalstate - integer :: npet, ntiles - integer :: nxg, nyg, cnt - integer :: isc,iec,jsc,jec - integer, allocatable :: xb(:),xe(:),yb(:),ye(:),pe(:) - integer, allocatable :: deBlockList(:,:,:), & - petMap(:),deLabelList(:), & - indexList(:) - integer :: ioff, joff - integer :: i, j, n, i1, j1, n1, icount - integer :: lbnd1,ubnd1,lbnd2,ubnd2 - integer :: lbnd3,ubnd3,lbnd4,ubnd4 - integer :: nblocks_tot - logical :: found - real(ESMF_KIND_R8), allocatable :: ofld(:,:), gfld(:,:) - real(ESMF_KIND_R8), pointer :: t_surf(:,:) - integer(ESMF_KIND_I4), pointer :: dataPtr_mask(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_area(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_xcen(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ycen(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_xcor(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ycor(:,:) - type(ESMF_Field) :: field_t_surf - character(len=*),parameter :: subname='(mom_cap:InitializeRealize)' - - rc = ESMF_SUCCESS - - call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr - Ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr - Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr - - call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_VMGet(vm, petCount=npet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !--------------------------------- - ! global mom grid size - !--------------------------------- - - call mpp_get_global_domain(Ocean_public%domain, xsize=nxg, ysize=nyg) - write(tmpstr,'(a,2i6)') subname//' nxg,nyg = ',nxg,nyg - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - !--------------------------------- - ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total - !--------------------------------- - - ntiles=mpp_get_ntile_count(Ocean_public%domain) ! this is tiles on this pe - if (ntiles /= 1) then - rc = ESMF_FAILURE - call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR, rc=dbrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - ntiles=mpp_get_domain_npes(Ocean_public%domain) - write(tmpstr,'(a,1i6)') subname//' ntiles = ',ntiles - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - !--------------------------------- - ! get start and end indices of each tile and their PET - !--------------------------------- - - allocate(xb(ntiles),xe(ntiles),yb(ntiles),ye(ntiles),pe(ntiles)) - call mpp_get_compute_domains(Ocean_public%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye) - call mpp_get_pelist(Ocean_public%domain, pe) - do n = 1,ntiles - write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - enddo - - !--------------------------------- - ! create delayout and distgrid - !--------------------------------- - - allocate(deBlockList(2,2,ntiles)) - allocate(petMap(ntiles)) - allocate(deLabelList(ntiles)) - - do n = 1, ntiles - deLabelList(n) = n - deBlockList(1,1,n) = xb(n) - deBlockList(1,2,n) = xe(n) - deBlockList(2,1,n) = yb(n) - deBlockList(2,2,n) = ye(n) - petMap(n) = pe(n) - ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side - enddo - - delayout = ESMF_DELayoutCreate(petMap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - allocate(connectionList(2)) - ! bipolar boundary condition at top row: nyg - call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & - tileIndexB=1, positionVector=(/nxg+1, 2*nyg+1/), & - orientationVector=(/-1, -2/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! periodic boundary condition along first dimension - call ESMF_DistGridConnectionSet(connectionList(2), tileIndexA=1, & - tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nxg,nyg/), & -! indexflag = ESMF_INDEX_DELOCAL, & - deBlockList=deBlockList, & -! deLabelList=deLabelList, & - delayout=delayout, & - connectionList=connectionList, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - deallocate(xb,xe,yb,ye,pe) - deallocate(connectionList) - deallocate(deLabelList) - deallocate(deBlockList) - deallocate(petMap) - - call ESMF_DistGridGet(distgrid=distgrid, localDE=0, elementCount=cnt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - allocate(indexList(cnt)) - write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - write(tmpstr,'(a,4i8)') subname//' distgrid list= ',& - indexList(1),indexList(cnt),minval(indexList), maxval(indexList) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - deallocate(IndexList) - - !--------------------------------- - ! create grid - !--------------------------------- - - gridIn = ESMF_GridCreate(distgrid=distgrid, & - gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & - coordSys = ESMF_COORDSYS_SPH_DEG, & - rc = rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - mom_grid_i = gridIn - - call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! Attach area to the Grid optionally. By default the cell areas are computed. - if(grid_attach_area) then - call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - call ESMF_GridGetCoord(gridIn, coordDim=1, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_xcen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridGetCoord(gridIn, coordDim=2, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_ycen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_GridGetCoord(gridIn, coordDim=1, & - staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=dataPtr_xcor, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridGetCoord(gridIn, coordDim=2, & - staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=dataPtr_ycor, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_MASK, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_mask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if(grid_attach_area) then - call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_area, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - !--------------------------------- - ! load up area, mask, center and corner values - ! area, mask, and centers should be same size in mom and esmf grid - ! corner points may not be, need to offset corner points by 1 in i and j - ! for esmf and also need to "make up" j=1 values. use wraparound in i - !--------------------------------- - - call mpp_get_compute_domain(Ocean_public%domain, isc, iec, jsc, jec) - - lbnd1 = lbound(dataPtr_mask,1) - ubnd1 = ubound(dataPtr_mask,1) - lbnd2 = lbound(dataPtr_mask,2) - ubnd2 = ubound(dataPtr_mask,2) - - lbnd3 = lbound(dataPtr_xcor,1) - ubnd3 = ubound(dataPtr_xcor,1) - lbnd4 = lbound(dataPtr_xcor,2) - ubnd4 = ubound(dataPtr_xcor,2) - - write(tmpstr,*) subname//' iscjsc = ',isc,iec,jsc,jec - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - write(tmpstr,*) subname//' lbub12 = ',lbnd1,ubnd1,lbnd2,ubnd2 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - write(tmpstr,*) subname//' lbub34 = ',lbnd3,ubnd3,lbnd4,ubnd4 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - if (iec-isc /= ubnd1-lbnd1 .or. jec-jsc /= ubnd2-lbnd2) then - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": fld and grid do not have the same size.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - - allocate(ofld(isc:iec,jsc:jec)) - allocate(gfld(nxg,nyg)) - - call ocean_model_data_get(Ocean_state, Ocean_public, 'mask', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld mask = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(Ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld mask = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_mask(i,j) = nint(ofld(i1,j1)) - enddo - enddo - - if(grid_attach_area) then - call ocean_model_data_get(Ocean_state, Ocean_public, 'area', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld area = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(Ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld area = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_area(i,j) = ofld(i1,j1) - enddo - enddo - endif - - call ocean_model_data_get(Ocean_state, Ocean_public, 'tlon', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld xt = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(Ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld xt = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_xcen(i,j) = ofld(i1,j1) - dataPtr_xcen(i,j) = mod(dataPtr_xcen(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) - enddo - enddo - - call ocean_model_data_get(Ocean_state, Ocean_public, 'tlat', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld yt = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(Ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld yt = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_ycen(i,j) = ofld(i1,j1) - enddo - enddo - -#ifdef MOM5_CAP - call ocean_model_data_get(Ocean_state, Ocean_public, 'ulon', ofld, isc, jsc) -#endif - -#ifdef MOM6_CAP - call ocean_model_data_get(Ocean_state, Ocean_public, 'geoLonBu', ofld, isc, jsc) -#endif - write(tmpstr,*) subname//' ofld xu = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(Ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld xu = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - do j = lbnd4, ubnd4 - do i = lbnd3, ubnd3 - j1 = j - lbnd4 + jsc - 1 - i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 - if (j1 == 0) then - dataPtr_xcor(i,j) = 2*gfld(i1,1) - gfld(i1,2) -! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) > 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) - 360. -! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) < 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) + 360. - elseif (j1 >= 1 .and. j1 <= nyg) then - dataPtr_xcor(i,j) = gfld(i1,j1) - else - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": error in xu j1.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - dataPtr_xcor(i,j) = mod(dataPtr_xcor(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) - ! write(tmpstr,*) subname//' ijfld xu = ',i,i1,j,j1,dataPtr_xcor(i,j) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - enddo - enddo - -! The corner latitude values are treated differently because MOM5 runs on B-Grid while -! MOM6 runs on C-Grid. -#ifdef MOM5_CAP - call ocean_model_data_get(Ocean_state, Ocean_public, 'ulat', ofld, isc, jsc) -#endif - -#ifdef MOM6_CAP - call ocean_model_data_get(Ocean_state, Ocean_public, 'geoLatBu', ofld, isc, jsc) -#endif - - write(tmpstr,*) subname//' ofld yu = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(Ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld yu = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - do j = lbnd4, ubnd4 - do i = lbnd3, ubnd3 - j1 = j - lbnd4 + jsc - 1 - i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 - if (j1 == 0) then - dataPtr_ycor(i,j) = 2*gfld(i1,1) - gfld(i1,2) - elseif (j1 >= 1 .and. j1 <= nyg) then - dataPtr_ycor(i,j) = gfld(i1,j1) - else - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": error in yu j1.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - ! write(tmpstr,*) subname//' ijfld yu = ',i,i1,j,j1,dataPtr_ycor(i,j) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - enddo - enddo - - write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - if(grid_attach_area) then - write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - endif - - write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - write(tmpstr,*) subname//' ycen = ',minval(dataPtr_ycen),maxval(dataPtr_ycen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - write(tmpstr,*) subname//' xcor = ',minval(dataPtr_xcor),maxval(dataPtr_xcor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - deallocate(gfld) - - gridOut = gridIn ! for now out same as in - - !--------------------------------- - ! realize fields on grid - !--------------------------------- - -#ifdef CESMCOUPLED - call shr_nuopc_fldList_Realize(importState, grid=gridIn, fldlist=fldsToOcn, tag=subname//':MOM6Import', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - call shr_nuopc_fldList_Realize(exportState, grid=gridOut, fldlist=fldsFrOcn, tag=subname//':MOM6Export', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return -#else - call MOM_RealizeFields(importState, gridIn , fldsToOcn_num, fldsToOcn, "Ocn import", rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call MOM_RealizeFields(exportState, gridOut, fldsFrOcn_num, fldsFrOcn, "Ocn export", rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -#endif - - call ESMF_StateGet(exportState, itemSearch="sea_surface_temperature", itemCount=icount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! Do sst initialization if it's part of export state - if(icount /= 0) then - call ESMF_StateGet(exportState, itemName='sea_surface_temperature', field=field_t_surf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_FieldGet(field_t_surf, localDe=0, farrayPtr=t_surf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ocean_model_data_get(Ocean_state, Ocean_public, 'mask', ofld, isc, jsc) - - lbnd1 = lbound(t_surf,1) - ubnd1 = ubound(t_surf,1) - lbnd2 = lbound(t_surf,2) - ubnd2 = ubound(t_surf,2) - - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - if (ofld(i1,j1) == 0.) t_surf(i,j) = 0.0 - enddo - enddo - - deallocate(ofld) - endif - -! tcraig, turn this off for now, have issues with overwriting failures -! call NUOPC_Write(exportState, fileNamePrefix='init_field_ocn_export_', & -! timeslice=1, relaxedFlag=.true., rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out - - write(*,*) '----- MOM initialization phase Realize completed' - - end subroutine InitializeRealize - - !> Called by NUOPC to advance the model a single timestep. - !! - !! @param gcomp an ESMF_GridComp object - !! @param rc return code - subroutine ModelAdvance(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_State) :: importState, exportState - type(ESMF_Time) :: currTime - type(ESMF_TimeInterval) :: timeStep - type(ESMF_Time) :: startTime - type(ESMF_TimeInterval) :: time_elapsed - integer(ESMF_KIND_I8) :: n_interval, time_elapsed_sec - character(len=64) :: timestamp - - type (ocean_public_type), pointer :: Ocean_public => NULL() - type (ocean_state_type), pointer :: Ocean_state => NULL() - type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() - type(ocean_internalstate_wrapper) :: ocean_internalstate - - ! define some time types - type(time_type) :: Time - type(time_type) :: Time_step_coupled - type(time_type) :: Time_restart_current - - integer :: dth, dtm, dts, dt_cpld = 86400 - integer :: isc,iec,jsc,jec,lbnd1,ubnd1,lbnd2,ubnd2 - integer :: i,j,i1,j1 - integer :: nc -#ifdef CESMCOUPLED - ! in ocn_import, ocn_export - -#else - real(ESMF_KIND_R8), allocatable :: ofld(:,:), ocz(:,:), ocm(:,:) - real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_mmmf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_mzmf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ocz(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ocm(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) -#endif - type(ocean_grid_type), pointer :: Ocean_grid - character(240) :: msgString - character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' - - rc = ESMF_SUCCESS - if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") - - ! query the Component for its clock, importState and exportState - call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & - exportState=exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr - Ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr - Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr - - ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep - - call ESMF_ClockPrint(clock, options="currTime", & - preString="------>Advancing OCN from: ", unit=msgString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_ClockGet(clock, startTime=startTime, currTime=currTime, & - timeStep=timeStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_TimePrint(currTime + timeStep, & - preString="--------------------------------> to: ", & - unit=msgString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_TimeIntervalGet(timeStep, h=dth, m=dtm, s=dts, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - Time = esmf2fms_time(currTime) - Time_step_coupled = esmf2fms_time(timeStep) - dt_cpld = dth*3600+dtm*60+dts - - call ice_ocn_bnd_from_data(Ice_ocean_boundary, Time, Time_step_coupled) - - call external_coupler_sbc_before(Ice_ocean_boundary, Ocean_public, nc, dt_cpld ) - - if(write_diagnostics) then - call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', & - timeslice=import_slice, relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - import_slice = import_slice + 1 - endif - - ! rotate the lat/lon wind vector (CW) onto local tripolar coordinate system - - call mpp_get_compute_domain(Ocean_public%domain, isc, iec, jsc, jec) - - if(.not. ocean_solo) then - -#ifdef MOM5_CAP - call get_ocean_grid(Ocean_grid) -#endif -#ifdef MOM6_CAP - Ocean_grid => ocean_internalstate%ptr%ocean_grid_ptr -#endif - -#ifdef CESMCOUPLED - ! unpacked in update_ocean_ -#else - call State_getFldPtr(exportState,'ocean_mask',dataPtr_mask,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - lbnd1 = lbound(dataPtr_mask,1) - ubnd1 = ubound(dataPtr_mask,1) - lbnd2 = lbound(dataPtr_mask,2) - ubnd2 = ubound(dataPtr_mask,2) - - call State_getFldPtr(importState,'mean_zonal_moment_flx',dataPtr_mzmf,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'mean_merid_moment_flx',dataPtr_mmmf,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'mean_evap_rate',dataPtr_evap,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'mean_sensi_heat_flx',dataPtr_sensi,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - dataPtr_evap = - dataPtr_evap - dataPtr_sensi = - dataPtr_sensi - - allocate(mzmf(lbnd1:ubnd1,lbnd2:ubnd2)) - allocate(mmmf(lbnd1:ubnd1,lbnd2:ubnd2)) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc ! work around local vs global indexing - i1 = i - lbnd1 + isc - mzmf(i,j) = Ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - + Ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) - mmmf(i,j) = Ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - - Ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) - enddo - enddo - dataPtr_mzmf = mzmf - dataPtr_mmmf = mmmf - deallocate(mzmf, mmmf) -#endif - endif ! not ocean_solo - -#ifdef CESMCOUPLED - ! tcx todo -#else - !Optionally write restart files when currTime-startTime is integer multiples of restart_interval - if(restart_interval > 0 ) then - time_elapsed = currTime - startTime - call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - n_interval = time_elapsed_sec / restart_interval - if((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then - time_restart_current = esmf2fms_time(currTime) - timestamp = date_to_string(time_restart_current) - call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=dbrc) - write(*,*) 'calling ocean_model_restart' - call ocean_model_restart(Ocean_state, timestamp) - endif - endif -#endif - - if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") -#ifdef CESMCOUPLED - call update_ocean_model(ImportState, Ocean_state, Ocean_public, Time, Time_step_coupled, & - sw_decomp, c1, c2, c3, c4) -#else - call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_public, Time, Time_step_coupled) -#endif - if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") - - if(.not. ocean_solo) then - -#ifdef MOM5_CAP - call get_ocean_grid(Ocean_grid) -#endif -#ifdef MOM6_CAP - Ocean_grid => ocean_internalstate%ptr%ocean_grid_ptr -#endif - -#ifdef CESMCOUPLED - call ocn_export(ocean_public, ocean_grid, exportState) -#else - allocate(ofld(isc:iec,jsc:jec)) - - call ocean_model_data_get(Ocean_state, Ocean_public, 'mask', ofld, isc, jsc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_mask(i,j) = nint(ofld(i1,j1)) - enddo - enddo - deallocate(ofld) - - ! Now rotate ocn current from tripolar grid back to lat/lon grid (CCW) - allocate(ocz(lbnd1:ubnd1,lbnd2:ubnd2)) - allocate(ocm(lbnd1:ubnd1,lbnd2:ubnd2)) - - call State_getFldPtr(exportState,'ocn_current_zonal',dataPtr_ocz,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'ocn_current_merid',dataPtr_ocm,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling - - ocz = dataPtr_ocz - ocm = dataPtr_ocm - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc ! work around local vs global indexing - i1 = i - lbnd1 + isc - dataPtr_ocz(i,j) = Ocean_grid%cos_rot(i1,j1)*ocz(i,j) & - - Ocean_grid%sin_rot(i1,j1)*ocm(i,j) - dataPtr_ocm(i,j) = Ocean_grid%cos_rot(i1,j1)*ocm(i,j) & - + Ocean_grid%sin_rot(i1,j1)*ocz(i,j) - enddo - enddo - deallocate(ocz, ocm) - endif ! not ocean_solo - - call ESMF_LogWrite("Before writing diagnostics", dataPtr_model_data_get(Ocean_state, Ocean_public, 'mask', ofld, isc, jsc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_mask(i,j) = nint(ofld(i1,j1)) - enddo - enddo - deallocate(ofld) - - ! Now rotate ocn current from tripolar grid back to lat/lon grid (CCW) - allocate(ocz(lbnd1:ubnd1,lbnd2:ubnd2)) - allocate(ocm(lbnd1:ubnd1,lbnd2:ubnd2)) - - call State_getFldPtr(exportState,'ocn_current_zonal',dataPtr_ocz,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'ocn_current_merid',dataPtr_ocm,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling - - ocz = dataPtr_ocz - ocm = dataPtr_ocm - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc ! work around local vs global indexing - i1 = i - lbnd1 + isc - dataPtr_ocz(i,j) = Ocean_grid%cos_rot(i1,j1)*ocz(i,j) & - - Ocean_grid%sin_rot(i1,j1)*ocm(i,j) - dataPtr_ocm(i,j) = Ocean_grid%cos_rot(i1,j1)*ocm(i,j) & - + Ocean_grid%sin_rot(i1,j1)*ocz(i,j) - enddo - enddo - deallocate(ocz, ocm) - endif ! not ocean_solo - - call ESMF_LogWrite(, rc=rc) - if(write_diagnostics) then - call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & - timeslice=export_slice, relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - export_slice = export_slice + 1 -#endif - endif ! not ocean solo - - call ESMF_LogWrite("Before calling sbc forcing", ESMF_LOGMSG_INFO, rc=rc) - call external_coupler_sbc_after(Ice_ocean_boundary, Ocean_public, nc, dt_cpld ) - - call ESMF_LogWrite("Before dumpMomInternal", ESMF_LOGMSG_INFO, rc=rc) - !write(*,*) 'MOM: --- run phase called ---' - call dumpMomInternal(mom_grid_i, import_slice, "mean_zonal_moment_flx", "will provide", Ice_ocean_boundary%u_flux) - call dumpMomInternal(mom_grid_i, import_slice, "mean_merid_moment_flx", "will provide", Ice_ocean_boundary%v_flux) - call dumpMomInternal(mom_grid_i, import_slice, "mean_sensi_heat_flx" , "will provide", Ice_ocean_boundary%t_flux) - call dumpMomInternal(mom_grid_i, import_slice, "mean_evap_rate" , "will provide", Ice_ocean_boundary%q_flux) - call dumpMomInternal(mom_grid_i, import_slice, "mean_salt_rate" , "will provide", Ice_ocean_boundary%salt_flux) - call dumpMomInternal(mom_grid_i, import_slice, "mean_net_lw_flx" , "will provide", Ice_ocean_boundary%lw_flux ) - call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dir_flx", "will provide", Ice_ocean_boundary%sw_flux_vis_dir) - call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dif_flx", "will provide", Ice_ocean_boundary%sw_flux_vis_dif) - call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dir_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dir) - call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dif_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dif) - call dumpMomInternal(mom_grid_i, import_slice, "mean_prec_rate" , "will provide", Ice_ocean_boundary%lprec ) - call dumpMomInternal(mom_grid_i, import_slice, "mean_fprec_rate" , "will provide", Ice_ocean_boundary%fprec ) - call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_rate" , "will provide", Ice_ocean_boundary%runoff ) - call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_rate" , "will provide", Ice_ocean_boundary%calving) - call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_heat_flx" , "will provide", Ice_ocean_boundary%runoff_hflx ) - call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_heat_flx", "will provide", Ice_ocean_boundary%calving_hflx) - call dumpMomInternal(mom_grid_i, import_slice, "inst_pres_height_surface" , "will provide", Ice_ocean_boundary%p ) - call dumpMomInternal(mom_grid_i, import_slice, "mass_of_overlying_sea_ice", "will provide", Ice_ocean_boundary%mi) - -!--------- export fields ------------- - -! call dumpMomInternal(mom_grid_i, export_slice, "ocean_mask", "will provide", dataPtr_mask) - call dumpMomInternal(mom_grid_i, export_slice, "sea_surface_temperature", "will provide", Ocean_public%t_surf) - call dumpMomInternal(mom_grid_i, export_slice, "s_surf" , "will provide", Ocean_public%s_surf ) - call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_zonal", "will provide", Ocean_public%u_surf ) - call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_merid", "will provide", Ocean_public%v_surf ) - call dumpMomInternal(mom_grid_i, export_slice, "sea_lev" , "will provide", Ocean_public%sea_lev) - - if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") - - end subroutine ModelAdvance - - !> Called by NUOPC at the end of the run to clean up. - !! - !! @param gcomp an ESMF_GridComp object - !! @param rc return code - subroutine ocean_model_finalize(gcomp, rc) - - ! input arguments - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type (ocean_public_type), pointer :: Ocean_public - type (ocean_state_type), pointer :: Ocean_state - type(ocean_internalstate_wrapper) :: ocean_internalstate - type(TIME_TYPE) :: Time - type(ESMF_Clock) :: clock - type(ESMF_Time) :: currTime - character(len=64) :: timestamp - character(len=*),parameter :: subname='(mom_cap:ocean_model_finalize)' - - write(*,*) 'MOM: --- finalize called ---' - rc = ESMF_SUCCESS - - call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - Ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr - Ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr - - call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_ClockGet(clock, currTime=currTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - Time = esmf2fms_time(currTime) - - call ocean_model_end (Ocean_public, Ocean_State, Time) - call diag_manager_end(Time ) - call field_manager_end - - call fms_io_exit - call fms_end - - write(*,*) 'MOM: --- completed ---' - - end subroutine ocean_model_finalize - -!==================================================================== -! get forcing data from data_overide - subroutine ice_ocn_bnd_from_data(x, Time, Time_step_coupled) - - type (ice_ocean_boundary_type) :: x - type(Time_type), intent(in) :: Time, Time_step_coupled - - type(Time_type) :: Time_next - character(len=*),parameter :: subname='(mom_cap:ice_ocn_bnd_from_data)' - - Time_next = Time + Time_step_coupled - - !call data_override('OCN', 't_flux', x%t_flux , Time_next) - !call data_override('OCN', 'u_flux', x%u_flux , Time_next) - !call data_override('OCN', 'v_flux', x%v_flux , Time_next) - !call data_override('OCN', 'q_flux', x%q_flux , Time_next) - !call data_override('OCN', 'salt_flux', x%salt_flux , Time_next) - !call data_override('OCN', 'lw_flux', x%lw_flux , Time_next) - !call data_override('OCN', 'sw_flux_vis_dir', x%sw_flux_vis_dir, Time_next) - !call data_override('OCN', 'sw_flux_vis_dif', x%sw_flux_vis_dif, Time_next) - !call data_override('OCN', 'sw_flux_nir_dir', x%sw_flux_nir_dir, Time_next) - !call data_override('OCN', 'sw_flux_nir_dif', x%sw_flux_nir_dif, Time_next) - !call data_override('OCN', 'lprec', x%lprec , Time_next) - !call data_override('OCN', 'fprec', x%fprec , Time_next) - !call data_override('OCN', 'runoff', x%runoff , Time_next) - !call data_override('OCN', 'calving', x%calving , Time_next) - !call data_override('OCN', 'p', x%p , Time_next) - - end subroutine ice_ocn_bnd_from_data - - -!----------------------------------------------------------------------------------------- -! -! Subroutines for enabling coupling to external programs through a third party coupler -! such as OASIS/PRISM. -! If no external coupler then these will mostly be dummy routines. -! These routines can also serve as spots to call other user defined routines -!----------------------------------------------------------------------------------------- - -!----------------------------------------------------------------------------------------- - -! Dummy subroutines. - - subroutine external_coupler_mpi_init(mom_local_communicator, external_initialization) - implicit none - integer, intent(out) :: mom_local_communicator - logical, intent(out) :: external_initialization - external_initialization = .false. - mom_local_communicator = -100 ! Is there mpp_undefined parameter corresponding to MPI_UNDEFINED? - ! probably wouldn't need logical flag. - return - end subroutine external_coupler_mpi_init - -!----------------------------------------------------------------------------------------- - subroutine external_coupler_sbc_init(Dom, dt_cpld, Run_len) - implicit none - type(domain2d) :: Dom - integer :: dt_cpld - type(time_type) :: Run_len - return - end subroutine external_coupler_sbc_init - - subroutine external_coupler_sbc_before(Ice_ocean_boundary, Ocean_public, nsteps, dt_cpld ) - implicit none - type (ice_ocean_boundary_type), intent(INOUT) :: Ice_ocean_boundary - type (ocean_public_type) , intent(INOUT) :: Ocean_public - integer , intent(IN) :: nsteps, dt_cpld - return - end subroutine external_coupler_sbc_before - - - subroutine external_coupler_sbc_after(Ice_ocean_boundary, Ocean_public, nsteps, dt_cpld ) - type (ice_ocean_boundary_type) :: Ice_ocean_boundary - type (ocean_public_type) :: Ocean_public - integer :: nsteps, dt_cpld - return - end subroutine external_coupler_sbc_after - - subroutine external_coupler_restart( dt_cpld, num_cpld_calls ) - implicit none - integer, intent(in) :: dt_cpld, num_cpld_calls - return - end subroutine external_coupler_restart - - subroutine external_coupler_exit - return - end subroutine external_coupler_exit - -!----------------------------------------------------------------------------------------- - subroutine external_coupler_mpi_exit(mom_local_communicator, external_initialization) - implicit none - integer, intent(in) :: mom_local_communicator - logical, intent(in) :: external_initialization - return - end subroutine external_coupler_mpi_exit -!----------------------------------------------------------------------------------------- - subroutine writeSliceFields(state, filename_prefix, slice, rc) - type(ESMF_State) :: state - character(len=*) :: filename_prefix - integer :: slice - integer, intent(out), optional :: rc - - integer :: n, nfields - type(ESMF_Field) :: field - type(ESMF_StateItem_Flag) :: itemType - character(len=40) :: fileName - character(len=64),allocatable :: fieldNameList(:) - character(len=*),parameter :: subname='(mom_cap:writeSliceFields)' - - if (present(rc)) rc = ESMF_SUCCESS - - if (ESMF_IO_PIO_PRESENT .and. & - (ESMF_IO_NETCDF_PRESENT .or. ESMF_IO_PNETCDF_PRESENT)) then - - call ESMF_StateGet(state, itemCount=nfields, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - allocate(fieldNameList(nfields)) - call ESMF_StateGet(state, itemNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - do n=1, size(fieldNameList) - call ESMF_StateGet(state, itemName=fieldNameList(n), & - itemType=itemType, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (itemType /= ESMF_STATEITEM_NOTFOUND) then - ! field is available in the state - call ESMF_StateGet(state, itemName=fieldNameList(n), field=field, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! -> output to file - write (fileName,"(A)") & - filename_prefix//trim(fieldNameList(n))//".nc" - call ESMF_FieldWrite(field, fileName=trim(fileName), & - timeslice=slice, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - enddo - - deallocate(fieldNameList) - - endif - - end subroutine writeSliceFields - - !----------------------------------------------------------------------------- - - subroutine State_GetFldPtr(ST, fldname, fldptr, rc) - type(ESMF_State), intent(in) :: ST - character(len=*), intent(in) :: fldname - real(ESMF_KIND_R8), pointer, intent(in) :: fldptr(:,:) - integer, intent(out), optional :: rc - - ! local variables - type(ESMF_Field) :: lfield - integer :: lrc - character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' - - call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (present(rc)) rc = lrc - - end subroutine State_GetFldPtr - -#ifndef CESMCOUPLED - !----------------------------------------------------------------------------- - subroutine MOM_AdvertiseFields(state, nfields, field_defs, rc) - - type(ESMF_State), intent(inout) :: state - integer,intent(in) :: nfields - type(fld_list_type), intent(inout) :: field_defs(:) - integer, intent(inout) :: rc - - integer :: i - character(len=*),parameter :: subname='(mom_cap:MOM_AdvertiseFields)' - - rc = ESMF_SUCCESS - - do i = 1, nfields - - call NUOPC_Advertise(state, & - standardName=field_defs(i)%stdname, & - name=field_defs(i)%shortname, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - enddo - - end subroutine MOM_AdvertiseFields - - !----------------------------------------------------------------------------- - - subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) - - type(ESMF_State), intent(inout) :: state - type(ESMF_Grid), intent(in) :: grid - integer, intent(in) :: nfields - type(fld_list_type), intent(inout) :: field_defs(:) - character(len=*), intent(in) :: tag - integer, intent(inout) :: rc - - integer :: i - type(ESMF_Field) :: field - integer :: npet, nx, ny, pet, elb(2), eub(2), clb(2), cub(2), tlb(2), tub(2) - type(ESMF_VM) :: vm - character(len=*),parameter :: subname='(mom_cap:MOM_RealizeFields)' - - rc = ESMF_SUCCESS - - do i = 1, nfields - - if (NUOPC_IsConnected(state, fieldName=field_defs(i)%shortname)) then - - if (field_defs(i)%shortname == flds_scalar_name) then - call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected on root pe.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=dbrc) - call shr_nuopc_fldList_SetScalarField(field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - elseif (field_defs(i)%assoc) then - call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected and associated.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=dbrc) - write(tmpstr,'(a,4i12)') subname//trim(tag)//' Field '//trim(field_defs(i)%shortname)//':', & - lbound(field_defs(i)%farrayPtr,1), ubound(field_defs(i)%farrayPtr,1), & - lbound(field_defs(i)%farrayPtr,2), ubound(field_defs(i)%farrayPtr,2) - call ESMF_LogWrite(tmpstr, ESMF_LOGMSG_INFO, rc=dbrc) - field = ESMF_FieldCreate(grid=grid, & - farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & -! farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else - call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=dbrc) - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - call NUOPC_Realize(state, field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -! call ESMF_FieldPrint(field=field, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out - else - call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is not connected.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=dbrc) - ! TODO: Initialize the value in the pointer to 0 after proper restart is setup - !if(associated(field_defs(i)%farrayPtr) ) field_defs(i)%farrayPtr = 0.0 - ! remove a not connected Field from State - call ESMF_StateRemove(state, (/field_defs(i)%shortname/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - enddo - - end subroutine MOM_RealizeFields -#endif - !----------------------------------------------------------------------------- - - subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_public) - type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary - type(ocean_public_type), intent(in) :: Ocean_public - - integer :: rc - character(len=*),parameter :: subname='(mom_cap:MOM_FieldsSetup)' - - !!! fld_list_add(num, fldlist, stdname, transferOffer, data(optional), shortname(optional)) - -#ifdef CESMCOUPLED - -! WARNING tcx tcraig -! tcraig this is just a starting point, the fields are not complete or correct here - - !-------------------------------- - ! create import fields list - !-------------------------------- - - call shr_nuopc_fldList_Zero(fldsToOcn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - call shr_nuopc_fldList_fromflds(fldsToOcn, flds_x2o, flds_x2o_map, "will provide", subname//":flds_x2o", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - call shr_nuopc_fldList_Add(fldsToOcn, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - ! convert to fldsToOcn - - !-------------------------------- - ! create export fields list - !-------------------------------- - - call shr_nuopc_fldList_Zero(fldsFrOcn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - call shr_nuopc_fldList_fromflds(fldsFrOcn, flds_o2x, flds_o2x_map, "will provide", subname//":flds_o2x", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - call shr_nuopc_fldList_Add(fldsFrOcn, trim(flds_scalar_name), "will provide", subname//":flds_scalar_name", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - -#else -!--------- import fields ------------- - -! tcraig, don't point directly into mom data YET (last field is optional in interface) -! instead, create space for the field when it's "realized". - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx", "will provide", data=Ice_ocean_boundary%u_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx", "will provide", data=Ice_ocean_boundary%v_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide", data=Ice_ocean_boundary%t_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide", data=Ice_ocean_boundary%q_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide", data=Ice_ocean_boundary%salt_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide", data=Ice_ocean_boundary%lw_flux ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dir) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dif) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_nir_dir) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_nir_dif) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide", data=Ice_ocean_boundary%lprec ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide", data=Ice_ocean_boundary%fprec ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide", data=Ice_ocean_boundary%runoff ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide", data=Ice_ocean_boundary%calving) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide", data=Ice_ocean_boundary%runoff_hflx ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx", "will provide", data=Ice_ocean_boundary%calving_hflx) - call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide", data=Ice_ocean_boundary%p ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice", "will provide", data=Ice_ocean_boundary%mi) - -!--------- export fields ------------- - - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask", "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature", "will provide", data=Ocean_public%t_surf) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide", data=Ocean_public%s_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal", "will provide", data=Ocean_public%u_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid", "will provide", data=Ocean_public%v_surf ) -! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir", "will provide") -! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir", "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=Ocean_public%sea_lev) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=Ocean_public%frazil) - -#endif - - end subroutine MOM_FieldsSetup - - !----------------------------------------------------------------------------- -#ifndef CESMCOUPLED - subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) - ! ---------------------------------------------- - ! Set up a list of field information - ! ---------------------------------------------- - integer, intent(inout) :: num - type(fld_list_type), intent(inout) :: fldlist(:) - character(len=*), intent(in) :: stdname - character(len=*), intent(in) :: transferOffer - real(ESMF_KIND_R8), dimension(:,:), optional, target :: data - character(len=*), intent(in),optional :: shortname - - ! local variables - integer :: rc - character(len=*), parameter :: subname='(mom_cap:fld_list_add)' - - ! fill in the new entry - - num = num + 1 - if (num > fldsMax) then - call ESMF_LogWrite(trim(subname)//": ERROR num gt fldsMax "//trim(stdname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - return - endif - - fldlist(num)%stdname = trim(stdname) - if (present(shortname)) then - fldlist(num)%shortname = trim(shortname) - else - fldlist(num)%shortname = trim(stdname) - endif - fldlist(num)%transferOffer = trim(transferOffer) - if (present(data)) then - fldlist(num)%assoc = .true. - fldlist(num)%farrayPtr => data - else - fldlist(num)%assoc = .false. - endif - - end subroutine fld_list_add -#endif - - subroutine dumpMomInternal(grid, slice, stdname, nop, farray) - - type(ESMF_Grid) :: grid - integer, intent(in) :: slice - character(len=*) :: stdname - character(len=*) :: nop - real(ESMF_KIND_R8), dimension(:,:), target :: farray - - type(ESMF_Field) :: field - real(ESMF_KIND_R8), dimension(:,:), pointer :: f2d - integer :: rc - -#ifdef MOM6_CAP - return -#endif - - if(.not. write_diagnostics) return ! nop in production mode - if(ocean_solo) return ! do not dump internal fields in ocean solo mode - - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, & - indexflag=ESMF_INDEX_DELOCAL, & - name=stdname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_FieldGet(field, farrayPtr=f2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - f2d(:,:) = farray(:,:) - - call ESMF_FieldWrite(field, fileName='field_ocn_internal_'//trim(stdname)//'.nc', & - timeslice=slice, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_FieldDestroy(field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end subroutine - -#ifdef MOM6_CAP - subroutine calculate_rot_angle(OS, OSFC, OG) - type(ocean_state_type), intent(in) :: OS - type(ocean_public_type), intent(in) :: OSFC - type(ocean_grid_type), pointer :: OG - - integer :: i,j,ishift,jshift,ilb,iub,jlb,jub - real :: angle, lon_scale - type(ocean_grid_type), pointer :: G - - call get_ocean_grid(OS, G) - - !print *, 'lbound: ', lbound(G%geoLatT), lbound(G%geoLonT), lbound(G%sin_rot) - !print *, 'ubound: ', ubound(G%geoLatT), ubound(G%geoLonT), ubound(G%sin_rot) - - !print *, minval(G%geoLatT), maxval(G%geoLatT) - !print *, minval(G%geoLonT), maxval(G%geoLonT) - !print *, G%isc, G%jsc, G%iec, G%jec - - ! - ! The bounds isc:iec goes from 5-104, isc-ishift:iec-ishift goes from 1:100 - ! - call mpp_get_compute_domain(OSFC%Domain, ilb, iub, jlb, jub) - ishift = ilb-G%isc - jshift = jlb-G%jsc - !print *, 'ilb, iub, jlb, jub', ilb, iub, jlb, jub, ishift, jshift - !print *, 'sizes', iub-ilb, jub-jlb, G%iec-G%isc, G%jec-G%jsc - allocate(OG) - allocate(OG%sin_rot(ilb:iub, jlb:jub)) - allocate(OG%cos_rot(ilb:iub, jlb:jub)) - - ! loop 5-104 - do j=G%jsc,G%jec ; do i=G%isc,G%iec - lon_scale = cos((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J-1 ) + & - G%geoLatBu(I-1,J) + G%geoLatBu(I,J)) * atan(1.0)/180) - angle = atan2((G%geoLonBu(I-1,J) + G%geoLonBu(I,J) - & - G%geoLonBu(I-1,J-1) - G%geoLonBu(I,J-1))*lon_scale, & - G%geoLatBu(I-1,J) + G%geoLatBu(I,J) - & - G%geoLatBu(I-1,J-1) - G%geoLatBu(I,J-1) ) - OG%sin_rot(i+ishift,j+jshift) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean - OG%cos_rot(i+ishift,j+jshift) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) - enddo ; enddo - !print *, minval(OG%sin_rot), maxval(OG%sin_rot) - !print *, minval(OG%cos_rot), maxval(OG%cos_rot) - - end subroutine -#endif - - -end module mom_cap_mod diff --git a/config_src/nuopc_driver/backup/ocn_comp_nuopc.F90.02 b/config_src/nuopc_driver/backup/ocn_comp_nuopc.F90.02 deleted file mode 100644 index 5b7b394c0c..0000000000 --- a/config_src/nuopc_driver/backup/ocn_comp_nuopc.F90.02 +++ /dev/null @@ -1,2218 +0,0 @@ -!> This is the main driver for MOM6 in CIME -module ocn_comp_nuopc - -! This file is part of MOM6. See LICENSE.md for the license. - -! mct modules -use ESMF -use perf_mod, only: t_startf, t_stopf -use shr_kind_mod, only: shr_kind_r8 -use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit, shr_file_setIO, & - shr_file_getLogUnit, shr_file_getLogLevel, & - shr_file_setLogUnit, shr_file_setLogLevel - -! MOM6 modules -use MOM_coms, only : reproducing_sum -use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end -use MOM_cpu_clock, only : CLOCK_SUBCOMPONENT -use MOM, only: initialize_MOM, step_MOM, MOM_control_struct, MOM_end -use MOM, only: calculate_surface_state, allocate_surface_state -use MOM, only: finish_MOM_initialization, step_offline -use MOM_forcing_type, only: forcing, forcing_diags, register_forcing_type_diags -use MOM_forcing_type, only: allocate_forcing_type, deallocate_forcing_type -use MOM_forcing_type, only: mech_forcing_diags, forcing_accumulate, forcing_diagnostics -use MOM_forcing_type, only: mech_forcing, allocate_mech_forcing, copy_back_forcing_fields -use MOM_forcing_type, only: set_net_mass_forcing, set_derived_forcing_fields -use MOM_forcing_type, only: copy_common_forcing_fields -use MOM_restart, only: save_restart -use MOM_domains, only: MOM_infra_init, num_pes, root_pe, pe_here -use MOM_domains, only: pass_vector, BGRID_NE, CGRID_NE, To_All -use MOM_domains, only: pass_var, AGRID, fill_symmetric_edges -use MOM_grid, only: ocean_grid_type, get_global_grid_size -use MOM_verticalGrid, only: verticalGrid_type -use MOM_variables, only: surface -use MOM_error_handler, only: MOM_error, FATAL, is_root_pe, WARNING -use MOM_error_handler, only: callTree_enter, callTree_leave -use MOM_time_manager, only: time_type, set_date, set_time, set_calendar_type, NOLEAP, get_date -use MOM_time_manager, only: operator(+), operator(-), operator(*), operator(/) -use MOM_time_manager, only: operator(/=), operator(>), get_time -use MOM_file_parser, only: get_param, log_version, param_file_type, close_param_file -use MOM_get_input, only: Get_MOM_Input, directories -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_diag_mediator, only: safe_alloc_ptr -use MOM_ice_shelf, only: initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS -use MOM_ice_shelf, only: ice_shelf_end, ice_shelf_save_restart -use MOM_sum_output, only: MOM_sum_output_init, sum_output_CS -use MOM_sum_output, only: write_energy, accumulate_net_input -use MOM_string_functions, only: uppercase -use MOM_constants, only: CELSIUS_KELVIN_OFFSET, hlf, hlv -use MOM_EOS, only: gsw_sp_from_sr, gsw_pt_from_ct -use user_revise_forcing, only : user_alter_forcing, user_revise_forcing_init -use user_revise_forcing, only : user_revise_forcing_CS -use MOM_restart, only : restart_init, MOM_restart_CS -use MOM_restart, only : restart_init_end, save_restart, restore_state -use data_override_mod, only : data_override_init, data_override -use MOM_io, only : slasher, write_version_number -use MOM_spatial_means, only : adjust_area_mean_to_zero - -! FMS modules -use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain, mpp_get_data_domain -use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain -use time_interp_external_mod, only : init_external_field, time_interp_external -use time_interp_external_mod, only : time_interp_external_init -use fms_mod, only : read_data - -! GFDL coupler modules -use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type -use coupler_types_mod, only : coupler_type_spawn -use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data - -! By default make data private -implicit none; private - -#include - -! Public member functions -public :: ocean_model_init -public :: ocean_model_init_sfc -public :: update_ocean_model -public :: ocn_export -public :: ocean_model_data_get -public :: get_ocean_grid -public :: ocean_model_end - -interface ocean_model_data_get - module procedure ocean_model_data1D_get - module procedure ocean_model_data2D_get -end interface - -! Flag for debugging -logical, parameter :: debug=.true. - -!> 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. - 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. - - integer :: stagger = -999 !< The staggering relative to the tracer points - !! of the two velocity components. Valid entries - !! include AGRID, BGRID_NE, CGRID_NE, BGRID_SW, and CGRID_SW, - !! corresponding to the community-standard Arakawa notation. - !! (These are named integers taken from mpp_parameter_mod.) - !! Following MOM, this is BGRID_NE by default when the ocean - !! is initialized, but here it is set to -999 so that a - !! global max across ocean and non-ocean processors can be - !! used to determine its value. - real, pointer, dimension(:,:) :: & - t_surf => NULL(), & !< SST on t-cell (degrees Kelvin) - s_surf => NULL(), & !< SSS on t-cell (psu) - u_surf => NULL(), & !< i-velocity at the locations indicated by stagger, m/s. - v_surf => NULL(), & !< j-velocity at the locations indicated by stagger, m/s. - sea_lev => NULL(), & !< Sea level in m after correction for surface pressure, - !! i.e. dzt(1) + eta_t + patm/rho0/grav (m) - frazil =>NULL(), & !< Accumulated heating (in Joules/m^2) from frazil - !! formation in the ocean. - area => NULL() !< cell area of the ocean surface, in m2. - 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. - integer, dimension(2) :: axes = 0 !< Axis numbers that are available - ! for I/O using this surface data. -end type ocean_public_type - -!> Contains pointers to the forcing fields which may be used to drive MOM. -!! All fluxes are positive downward. -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 - 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 :: 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 - !! structure does not limit the water that can be - !! frozen out of the ocean and the ice-ocean heat - !! fluxes are treated explicitly. - logical :: use_limited_P_SSH !< 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. The default is true. - 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. - gust => NULL(), & !< spatially varying unresolved background - !! 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) - real :: cd_tides !< drag coefficient that applies to the tides (nondimensional) - real :: utide !< constant tidal velocity to use if read_tideamp - !! is false, in 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 :: 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. - logical :: allow_flux_adjustments !< If true, use data_override to obtain flux adjustments - 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 :: 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) - 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 - 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 - 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 - 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 - !### 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 -end type surface_forcing_CS - -!> Contains information about the ocean state, although it is not necessary that -!! this is implemented with all models. This type is private, and can therefore vary -!! between different ocean models. -type, public :: ocean_state_type ; private - 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. - type(time_type) :: energysavedays !< The interval between writing the energies - !! and other integral quantities of the run. - type(time_type) :: write_energy_time !< The next time to write to the energy file. - 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 :: 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 - !! restore sst to a specified value. - real :: press_to_z !< A conversion factor between pressure and ocean - !! depth in m, usually 1/(rho_0*g), in m Pa-1. - real :: C_p !< The heat capacity of seawater, in J K-1 kg-1. - type(directories) :: dirs !< A structure containing several relevant directory paths. - type(mech_forcing) :: forces!< A structure with the driving mechanical forces - type(forcing) :: fluxes !< A structure containing pointers to - !! the 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) :: 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(MOM_control_struct), pointer :: MOM_CSp => NULL() - type(surface_forcing_CS), pointer :: forcing_CSp => NULL() - type(sum_output_CS), pointer :: sum_output_CSp => NULL() -end type ocean_state_type - -integer :: id_clock_forcing -integer :: rc - -contains - - -!> Initializes the ocean model, including registering fields -!! for restarts and reading restart files if appropriate. -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). - 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. - type(time_type), intent(in) :: Time_init !< The start time for the coupled model's calendar - type(time_type), intent(in) :: Time_in !< The time at which to initialize the ocean model. - 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, 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 :: Time_unit !< The time unit in seconds for ENERGYSAVEDAYS. - real :: Rho0 !< The Boussinesq ocean density, in kg m-3. - real :: G_Earth !< The gravitational acceleration in m s-2. - !! This include declares and sets the variable "version". -#include "version_variable.h" - character(len=40) :: mdl = "ocean_model_init" !< This module's name. - character(len=48) :: stagger - integer :: secs, days - type(param_file_type) :: param_file !< A structure to parse for run-time parameters - logical :: offline_tracer_mode - - call callTree_enter("ocean_model_init(), ocn_comp_nuopc.F90") - if (associated(OS)) then - call MOM_error(WARNING, "ocean_model_init called with an associated "// & - "ocean_state_type structure. Model is already initialized.") - return - endif - allocate(OS) - - OS%is_ocean_pe = Ocean_sfc%is_ocean_pe - if (.not.OS%is_ocean_pe) return - - OS%Time = Time_in - call initialize_MOM(OS%Time, param_file, OS%dirs, OS%MOM_CSp, Time_in, & - offline_tracer_mode=offline_tracer_mode, input_restart_file=input_restart_file) - OS%grid => OS%MOM_CSp%G ; OS%GV => OS%MOM_CSp%GV - OS%C_p = OS%MOM_CSp%tv%C_p - OS%fluxes%C_p = OS%MOM_CSp%tv%C_p - - ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mdl, version, "") - call get_param(param_file, mdl, "RESTART_CONTROL", OS%Restart_control, & - "An integer whose bits encode which restart files are \n"//& - "written. Add 2 (bit 1) for a time-stamped file, and odd \n"//& - "(bit 0) for a non-time-stamped file. A restart file \n"//& - "will be saved at the end of the run segment for any \n"//& - "non-negative value.", default=1) - call get_param(param_file, mdl, "TIMEUNIT", Time_unit, & - "The time unit for ENERGYSAVEDAYS.", & - units="s", default=86400.0) - call get_param(param_file, mdl, "ENERGYSAVEDAYS",OS%energysavedays, & - "The interval in units of TIMEUNIT between saves of the \n"//& - "energies of the run and other globally summed diagnostics.", & - default=set_time(0,days=1), timeunit=Time_unit) - - call get_param(param_file, 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', '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.") ; 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"//& - "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"//& - "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"//& - "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, & - "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80) - - 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, & - "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 \n"//& - "below berg are set to zero. Not applied for negative \n"//& - " values.", units="non-dim", default=-1.0) - endif - - OS%press_to_z = 1.0/(Rho0*G_Earth) - - ! 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%state, OS%grid, OS%MOM_CSp%use_temperature, & - do_integrals=.true., gas_fields_ocn=gas_fields_ocn) - - call surface_forcing_init(Time_in, OS%grid, param_file, OS%MOM_CSp%diag, & - OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) - - if (OS%use_ice_shelf) then - call initialize_ice_shelf(param_file, OS%grid, OS%Time, OS%ice_shelf_CSp, & - OS%MOM_CSp%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.) - endif - - call MOM_sum_output_init(OS%grid, param_file, OS%dirs%output_directory, & - OS%MOM_CSp%ntrunc, Time_init, OS%sum_output_CSp) - - ! This call has been moved into the first call to update_ocean_model. -! call write_energy(OS%MOM_CSp%u, OS%MOM_CSp%v, OS%MOM_CSp%h, OS%MOM_CSp%tv, & -! OS%Time, 0, OS%grid, OS%GV, OS%sum_output_CSp, OS%MOM_CSp%tracer_flow_CSp) - - ! write_energy_time is the next integral multiple of energysavedays. - OS%write_energy_time = Time_init + OS%energysavedays * & - (1 + (OS%Time - Time_init) / OS%energysavedays) - - if (ASSOCIATED(OS%grid%Domain%maskmap)) then - call initialize_ocean_public_type(OS%grid%Domain%mpp_domain, Ocean_sfc, & - OS%MOM_CSp%diag, maskmap=OS%grid%Domain%maskmap, & - gas_fields_ocn=gas_fields_ocn) - else - call initialize_ocean_public_type(OS%grid%Domain%mpp_domain, Ocean_sfc, & - OS%MOM_CSp%diag, gas_fields_ocn=gas_fields_ocn) - endif - - ! 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 calculate_surface_state(OS%state, OS%MOM_CSp%u, & - OS%MOM_CSp%v, OS%MOM_CSp%h, OS%MOM_CSp%ave_ssh,& - OS%grid, OS%GV, OS%MOM_CSp) - - call convert_state_to_ocean_type(OS%state, Ocean_sfc, OS%grid, & - OS%MOM_CSp%use_conT_absS) - endif - - call close_param_file(param_file) - call diag_mediator_close_registration(OS%MOM_CSp%diag) - -! if (is_root_pe()) & -! write(glb%stdout,'(/12x,a/)') '======== COMPLETED MOM INITIALIZATION ========' - - call callTree_leave("ocean_model_init(") -end subroutine ocean_model_init - -!> 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 - type(ocean_public_type), intent(inout) :: Ocean_sfc - - integer :: is, ie, js, je - - is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec - call coupler_type_spawn(Ocean_sfc%fields, OS%state%tr_fields, & - (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) - - call calculate_surface_state(OS%state, OS%MOM_CSp%u, & - OS%MOM_CSp%v, OS%MOM_CSp%h, OS%MOM_CSp%ave_ssh,& - OS%grid, OS%GV, OS%MOM_CSp) - - call convert_state_to_ocean_type(OS%state, Ocean_sfc, OS%grid, & - OS%MOM_CSp%use_conT_absS) - -end subroutine ocean_model_init_sfc - -!> Initializes surface forcing: get relevant parameters and allocate arrays. -subroutine surface_forcing_init(Time, G, 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(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 - - ! 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_nuopc" ! This module's name. - character(len=48) :: stagger - character(len=240) :: basin_file - integer :: i, j, isd, ied, jsd, jed - - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - - if (associated(CS)) then - call MOM_error(WARNING, "surface_forcing_init called with an associated "// & - "control structure.") - return - endif - allocate(CS) - - id_clock_forcing=cpu_clock_id('Ocean surface forcing', grain=CLOCK_SUBCOMPONENT) - call cpu_clock_begin(id_clock_forcing) - - CS%diag => diag - - call write_version_number (version) - ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mdl, version, "") - - call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, & - "The directory in which all input files are found.", & - default=".") - CS%inputdir = slasher(CS%inputdir) - call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & - "If true, Temperature and salinity are used as state \n"//& - "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"//& - "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, & - "The latent heat of fusion.", units="J/kg", default=hlf) - 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"//& - "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"//& - "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"//& - "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"//& - "by the ocean (including restoring) to zero.", 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"//& - "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"//& - "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"//& - "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 \n"//& - "staggering of the input wind stress field. Valid \n"//& - "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 - elseif (uppercase(stagger(1:1)) == 'C') then ; CS%wind_stagger = CGRID_NE - else ; call MOM_error(FATAL,"surface_forcing_init: WIND_STAGGER = "// & - trim(stagger)//" is invalid.") ; endif - call get_param(param_file, mdl, "WIND_STRESS_MULTIPLIER", CS%wind_stress_multiplier, & - "A factor multiplying the wind-stress given to the ocean by the\n"//& - "coupler. This is used for testing and should be =1.0 for any\n"//& - "production runs.", default=1.0) - - if (restore_salt) then - call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & - "The constant that relates the restoring surface fluxes \n"//& - "to the relative surface anomalies (akin to a piston \n"//& - "velocity). Note the non-MKS units.", units="m day-1", & - fail_if_missing=.true.) - call get_param(param_file, mdl, "SALT_RESTORE_FILE", CS%salt_restore_file, & - "A file in which to find the surface salinity to use for restoring.", & - default="salt_restore.nc") - call get_param(param_file, mdl, "SALT_RESTORE_VARIABLE", CS%salt_restore_var_name, & - "The name of the surface salinity variable to read from "//& - "SALT_RESTORE_FILE for restoring salinity.", & - default="salt") -! Convert CS%Flux_const from m day-1 to m s-1. - CS%Flux_const = CS%Flux_const / 86400.0 - - call get_param(param_file, mdl, "SRESTORE_AS_SFLUX", CS%salt_restore_as_sflux, & - "If true, the restoring of salinity is applied as a salt \n"//& - "flux instead of as a freshwater flux.", default=.false.) - call get_param(param_file, 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"//& - "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"//& - "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'.", & - default="basin.nc") - 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) - 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 - 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"//& - "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, & - "A file in which to find the surface temperature to use for restoring.", & - default="temp_restore.nc") - call get_param(param_file, mdl, "SST_RESTORE_VARIABLE", CS%temp_restore_var_name, & - "The name of the surface temperature variable to read from "//& - "SST_RESTORE_FILE for restoring sst.", & - default="temp") -! Convert CS%Flux_const from m day-1 to m s-1. - CS%Flux_const = CS%Flux_const / 86400.0 - - call get_param(param_file, mdl, "MAX_DELTA_TRESTORE", CS%max_delta_trestore, & - "The maximum sst difference used in restoring terms.", & - units="degC ", default=999.0) - - endif - -! 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. - call get_param(param_file, mdl, "CD_TIDES", CS%cd_tides, & - "The drag coefficient that applies to the tides.", & - units="nondim", default=1.0e-4) - call get_param(param_file, mdl, "READ_TIDEAMP", CS%read_TIDEAMP, & - "If true, read a file (given by TIDEAMP_FILE) containing \n"//& - "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) - if (CS%read_TIDEAMP) then - call get_param(param_file, mdl, "TIDEAMP_FILE", TideAmp_file, & - "The path to the file containing the spatially varying \n"//& - "tidal amplitudes with INT_TIDE_DISSIPATION.", & - default="tideamp.nc") - CS%utide=0.0 - else - call get_param(param_file, mdl, "UTIDE", CS%utide, & - "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & - units="m s-1", default=0.0) - endif - - call safe_alloc_ptr(CS%TKE_tidal,isd,ied,jsd,jed) - call safe_alloc_ptr(CS%ustar_tidal,isd,ied,jsd,jed) - - 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) - 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) - CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide - enddo ; enddo - else - do j=jsd,jed; do i=isd,ied - utide=CS%utide - CS%TKE_tidal(i,j) = CS%Rho0*CS%cd_tides*(utide*utide*utide) - CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide - enddo ; enddo - endif - - call time_interp_external_init - -! Optionally read a x-y gustiness field in place of a global -! constant. - - call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & - "If true, use a 2-dimensional gustiness supplied from \n"//& - "an input file", default=.false.) - call get_param(param_file, 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"//& - "variable gustiness.") - - 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 - endif - -! 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"//& - "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"//& - "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"//& - "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"//& - "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"//& - "as seen by MOM6.", default=.false.) - call register_forcing_type_diags(Time, diag, CS%use_temperature, CS%handles, & - use_berg_fluxes=iceberg_flux_diags) - - call get_param(param_file, mdl, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, & - "If true, allows flux adjustments to specified via the \n"//& - "data_table using the component name 'OCN'.", default=.false.) - if (CS%allow_flux_adjustments) then - call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) - endif - - 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) - 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) - endif ; endif - - ! Set up any restart fields associated with the forcing. - call restart_init(param_file, CS%restart_CSp, "MOM_forcing.res") -!### call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & -!### CS%restart_CSp) - call restart_init_end(CS%restart_CSp) - - if (associated(CS%restart_CSp)) then - call Get_MOM_Input(dirs=dirs) - - new_sim = .false. - if ((dirs%input_filename(1:1) == 'n') .and. & - (LEN_TRIM(dirs%input_filename) == 1)) new_sim = .true. - if (.not.new_sim) then - call restore_state(dirs%input_filename, dirs%restart_input_dir, Time_frc, & - G, CS%restart_CSp) - endif - endif - -!### call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) - - call user_revise_forcing_init(param_file, CS%urf_CS) - - call cpu_clock_end(id_clock_forcing) -end subroutine surface_forcing_init - -!> Initializes domain and state variables contained in the ocean public 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(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 - integer :: xsz, ysz, layout(2) - integer :: isc, iec, jsc, jec - - call mpp_get_layout(input_domain,layout) - call mpp_get_global_domain(input_domain, xsize=xsz, ysize=ysz) - if(PRESENT(maskmap)) then - call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain, maskmap=maskmap) - else - call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain) - endif - call mpp_get_compute_domain(Ocean_sfc%Domain, isc, iec, jsc, jec) - - allocate ( Ocean_sfc%t_surf (isc:iec,jsc:jec), & - Ocean_sfc%s_surf (isc:iec,jsc:jec), & - Ocean_sfc%u_surf (isc:iec,jsc:jec), & - Ocean_sfc%v_surf (isc:iec,jsc:jec), & - Ocean_sfc%sea_lev(isc:iec,jsc:jec), & - Ocean_sfc%area (isc:iec,jsc:jec), & - Ocean_sfc%frazil (isc:iec,jsc:jec)) - - Ocean_sfc%t_surf = 0.0 ! time averaged sst (Kelvin) passed to atmosphere/ice model - Ocean_sfc%s_surf = 0.0 ! time averaged sss (psu) passed to atmosphere/ice models - Ocean_sfc%u_surf = 0.0 ! time averaged u-current (m/sec) passed to atmosphere/ice models - Ocean_sfc%v_surf = 0.0 ! time averaged v-current (m/sec) passed to atmosphere/ice models - Ocean_sfc%sea_lev = 0.0 ! time averaged thickness of top model grid cell (m) plus patm/rho0/grav - Ocean_sfc%frazil = 0.0 ! time accumulated frazil (J/m^2) passed to ice model - Ocean_sfc%area = 0.0 - Ocean_sfc%axes = diag%axesT1%handles !diag axes to be used by coupler tracer flux diagnostics - - if (present(gas_fields_ocn)) then - call coupler_type_spawn(gas_fields_ocn, Ocean_sfc%fields, (/isc,isc,iec,iec/), & - (/jsc,jsc,jec,jec/), suffix = '_ocn', as_needed=.true.) - endif - -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, use_conT_absS, & - 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 - logical, intent(in) :: use_conT_absS !< If true, , the prognostics - !! T&S are the conservative temperature - real, optional, intent(in) :: patm(:,:) !< Atmospheric pressure. - real, optional, intent(in) :: press_to_z !< Factor to tranform atmospheric - !! pressure to z? - - ! 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 mpp_get_compute_domain(Ocean_sfc%Domain, isc_bnd, iec_bnd, & - jsc_bnd, jec_bnd) - if (present(patm)) then - ! Check that the inidicies in patm are (isc_bnd:iec_bnd,jsc_bnd:jec_bnd). - if (.not.present(press_to_z)) call MOM_error(FATAL, & - 'convert_state_to_ocean_type: press_to_z must be present if patm is.') - endif - - i0 = is - isc_bnd ; j0 = js - jsc_bnd - !If directed convert the surface T&S - !from conservative T to potential T and - !from absolute (reference) salinity to practical salinity - ! - if(use_conT_absS) then - 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%t_surf(i,j) = gsw_pt_from_ct(state%SSS(i+i0,j+j0),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%s_surf(i,j) = 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) - 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) - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) - enddo ; enddo - - 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)) - 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)) - 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) - enddo ; enddo - else - write(val_str, '(I8)') Ocean_sfc%stagger - call MOM_error(FATAL, "convert_state_to_ocean_type: "//& - "Ocean_sfc%stagger has the unrecognized value of "//trim(val_str)) - endif - - if (coupler_type_initialized(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) - endif - -end subroutine convert_state_to_ocean_type - -!> Returns pointers to objects within ocean_state_type -subroutine get_state_pointers(OS, grid, surf) - type(ocean_state_type), pointer :: OS !< Ocean state type - type(ocean_grid_type), optional, pointer :: grid !< Ocean grid - type(surface), optional, pointer :: surf !< Ocean surface state - - if (present(grid)) grid => OS%grid - if (present(surf)) surf=> OS%state - -end subroutine get_state_pointers - -!> Maps outgoing ocean data to MCT buffer. -!! See \ref section_ocn_export for a summary of the data -!! that is transferred from MOM6 to MCT. -subroutine ocn_export(ocn_public, grid, exportState) - type(ocean_public_type), intent(in) :: ocn_public !< Ocean surface state - type(ocean_grid_type), intent(in) :: grid !< Ocean model grid - type(ESMF_State), intent(inout) :: exportState !< outgoing data - ! Local variables - real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo - integer :: i, j, i1, j1, n, ig, jg !< Grid indices - integer :: lbnd1, lbnd2, ubnd1, ubnd2 - real :: slp_L, slp_R, slp_C, slope, u_min, u_max - real(ESMF_KIND_R8), pointer :: dataPtr_omask(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_t(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_s(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_u(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_v(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_q(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_fswpen(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_roce_16O(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_roce_HDO(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_fco2_ocn(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_fdms_ocn(:,:) - - call State_getFldPtr(exportState,"So_omask", dataPtr_omask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"So_t", dataPtr_t, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"So_s", dataPtr_s, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"So_u", dataPtr_u, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"So_v", dataPtr_v, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"Fioo_q", dataPtr_q, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"So_dhdx", dataPtr_dhdx, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"So_dhdy", dataPtr_dhdy, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"So_bldepth", dataPtr_bldepth, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"So_fswpen", dataPtr_fswpen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -! call State_getFldPtr(exportState,"So_roce_16O", dataPtr_roce_16O, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out -! call State_getFldPtr(exportState,"So_roce_HDO", dataPtr_roce_HDO, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out -! call State_getFldPtr(exportState,"Faoo_fco2_ocn", dataPtr_fco2_ocn, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out -! call State_getFldPtr(exportState,"Faoo_fdms_ocn", dataPtr_fdms_ocn, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out - - lbnd1 = lbound(dataPtr_t,1) - ubnd1 = ubound(dataPtr_t,1) - lbnd2 = lbound(dataPtr_t,2) - ubnd2 = ubound(dataPtr_t,2) - - ! Copy from ocn_public to exportstate. ocn_public uses global indexing with no halos. - ! The mask comes from "grid" that uses the usual MOM domain that has halos - ! and does not use global indexing. - do j=grid%jsc, grid%jec - jg = j + grid%jdg_offset - j1 = j + lbnd2 - grid%jsc - do i=grid%isc,grid%iec - ig = i + grid%idg_offset - i1 = i + lbnd1 - grid%isc - ! surface temperature in Kelvin - dataPtr_t(i1,j1) = ocn_public%t_surf(ig,jg) * grid%mask2dT(i,j) - dataPtr_s(i1,j1) = ocn_public%s_surf(ig,jg) * grid%mask2dT(i,j) - dataPtr_u(i1,j1) = ocn_public%u_surf(ig,jg) * grid%mask2dT(i,j) - dataPtr_v(i1,j1) = ocn_public%v_surf(ig,jg) * grid%mask2dT(i,j) - ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain - ! in order to update halos. i.e. does not use global indexing. - ssh(i,j) = ocn_public%sea_lev(ig,jg) - end do - end do - - ! Update halo of ssh so we can calculate gradients - call pass_var(ssh, grid%domain) - - ! d/dx ssh - do j=grid%jsc, grid%jec - j1 = j + lbnd2 - grid%jsc - do i=grid%isc,grid%iec - i1 = i + lbnd1 - grid%isc - ! This is a simple second-order difference - !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) - if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. - slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(I,j) - if (grid%mask2dCu(I+1,j)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - if ( (slp_L * slp_R) > 0.0 ) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - dataPtr_dhdx(i1,j1) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) dataPtr_dhdx(i1,j1) = 0.0 - end do - end do - - ! d/dy ssh - do j=grid%jsc, grid%jec - j1 = j + lbnd2 - grid%jsc - do i=grid%isc,grid%iec - i1 = i + lbnd1 - grid%isc - ! This is a simple second-order difference - !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) - if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. - slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,J) - if (grid%mask2dCv(i,J+1)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R - if ((slp_L * slp_R) > 0.0) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - dataPtr_dhdy(i1,j1) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) dataPtr_dhdy(i1,j1) = 0.0 - end do - end do - -end subroutine ocn_export - - -!> Saves restart fields associated with the 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(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 - 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 - -!> 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. -subroutine update_ocean_model(ImportState, OS, Ocean_sfc, time_start_update, & - Ocean_coupling_time_step, sw_decomp, & - c1, c2, c3, c4) - type(ESMF_State), intent(in) :: ImportState - type(ocean_state_type), pointer :: OS !< Structure containing the internal ocean state - type(ocean_public_type), intent(inout) :: Ocean_sfc !< Structure containing all the publicly - !! visible ocean surface fields after a coupling time step - type(time_type), intent(in) :: time_start_update !< Time at the beginning of the update step - type(time_type), intent(in) :: Ocean_coupling_time_step !< Amount of time over which to - !! advance the ocean - logical, intent(in) :: sw_decomp !< controls if shortwave is - !!decomposed into four components - real(kind=8), intent(in), optional :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition - - ! 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. - real :: weight !< Flux accumulation weight - real :: time_step !< The time step of a call to step_MOM in seconds. - integer :: secs, days - integer :: is, ie, js, je - - call callTree_enter("update_ocean_model(), ocn_comp_nuopc.F90") - call get_time(Ocean_coupling_time_step, secs, days) - time_step = 86400.0*real(days) + real(secs) - - if (time_start_update /= OS%Time) then - call MOM_error(WARNING, "update_ocean_model: internal clock does not "//& - "agree with time_start_update argument.") - endif - - if (.not.associated(OS)) then - call MOM_error(FATAL, "update_ocean_model called with an unassociated "// & - "ocean_state_type structure. ocean_model_init must be "// & - "called first to allocate this structure.") - return - endif - - ! This is benign but not necessary if ocean_model_init_sfc was called or if - ! OS%state%tr_fields was spawnded in ocean_model_init. Consider removing it. - is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec - call coupler_type_spawn(Ocean_sfc%fields, OS%state%tr_fields, & - (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) - - weight = 1.0 - - if (OS%fluxes%fluxes_used) then - ! GMM, is enable_averaging needed now? - call enable_averaging(time_step, OS%Time + Ocean_coupling_time_step, OS%MOM_CSp%diag) - call ocn_import(OS%forces, OS%fluxes, OS%Time, OS%grid, OS%forcing_CSp, OS%state, ImportState, sw_decomp, & - c1, c2, c3, c4, 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 - - ! Add ice shelf fluxes - if (OS%use_ice_shelf) then - call shelf_calc_flux(OS%State, OS%forces, OS%fluxes, OS%Time, time_step, OS%Ice_shelf_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%fluxes,OS%use_ice_shelf,OS%density_iceberg,OS%kv_iceberg, OS%latent_heat_fusion, OS%State, time_step, OS%berg_area_threshold) - !endif - - ! Indicate that there are new unused fluxes. - OS%fluxes%fluxes_used = .false. - OS%fluxes%dt_buoy_accum = time_step - 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 ocn_import(OS%forces, OS%flux_tmp, OS%Time, OS%grid, OS%forcing_CSp, & - OS%state, ImportState, sw_decomp, c1, c2, c3, c4, & - OS%restore_salinity,OS%restore_temp) - - if (OS%use_ice_shelf) then - call shelf_calc_flux(OS%State, OS%forces, OS%flux_tmp, OS%Time, time_step, OS%Ice_shelf_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%State, time_step, 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) - ! 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. - 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 - endif - - call set_derived_forcing_fields(OS%forces, OS%fluxes, OS%grid, OS%GV%Rho0) - call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid) - - if (OS%nstep==0) then - call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%fluxes) - - call write_energy(OS%MOM_CSp%u, OS%MOM_CSp%v, OS%MOM_CSp%h, OS%MOM_CSp%tv, & - OS%Time, 0, OS%grid, OS%GV, OS%sum_output_CSp, & - OS%MOM_CSp%tracer_flow_CSp) - endif - - call disable_averaging(OS%MOM_CSp%diag) - Master_time = OS%Time ; Time1 = OS%Time - - if(OS%MOM_Csp%offline_tracer_mode) then - call step_offline(OS%forces, OS%fluxes, OS%state, Time1, time_step, OS%MOM_CSp) - else - call step_MOM(OS%forces, OS%fluxes, OS%state, Time1, time_step, OS%MOM_CSp) - endif - - OS%Time = Master_time + Ocean_coupling_time_step - OS%nstep = OS%nstep + 1 - - call enable_averaging(time_step, OS%Time, OS%MOM_CSp%diag) - call mech_forcing_diags(OS%forces, OS%fluxes, time_step, OS%grid, & - OS%MOM_CSp%diag, OS%forcing_CSp%handles) - call disable_averaging(OS%MOM_CSp%diag) - - if (OS%fluxes%fluxes_used) then - call enable_averaging(OS%fluxes%dt_buoy_accum, OS%Time, OS%MOM_CSp%diag) - call forcing_diagnostics(OS%fluxes, OS%state, OS%fluxes%dt_buoy_accum, & - OS%grid, OS%MOM_CSp%diag, OS%forcing_CSp%handles) - call accumulate_net_input(OS%fluxes, OS%state, OS%fluxes%dt_buoy_accum, & - OS%grid, OS%sum_output_CSp) - call disable_averaging(OS%MOM_CSp%diag) - endif - -! See if it is time to write out the energy. - if ((OS%Time + ((Ocean_coupling_time_step)/2) > OS%write_energy_time) .and. & - (OS%MOM_CSp%t_dyn_rel_adv==0.0)) then - call write_energy(OS%MOM_CSp%u, OS%MOM_CSp%v, OS%MOM_CSp%h, OS%MOM_CSp%tv, & - OS%Time, OS%nstep, OS%grid, OS%GV, OS%sum_output_CSp, & - OS%MOM_CSp%tracer_flow_CSp) - OS%write_energy_time = OS%write_energy_time + OS%energysavedays - endif - -! Translate state into Ocean. -! call convert_state_to_ocean_type(OS%state, Ocean_sfc, OS%grid, & -! Ice_ocean_boundary%p, OS%press_to_z) - call convert_state_to_ocean_type(OS%state, Ocean_sfc, OS%grid, & - OS%MOM_CSp%use_conT_absS) - - call callTree_leave("update_ocean_model()") -end subroutine update_ocean_model - -!> 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. -subroutine ocn_import(forces, fluxes, Time, G, CS, state, ImportState, sw_decomp, & - c1, c2, c3, c4, restore_salt, restore_temp) - type(mech_forcing), intent(inout) :: forces !< Driving mechanical forces - type(forcing), intent(inout) :: fluxes !< Surface fluxes - type(time_type), intent(in) :: Time !< Model time - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid - type(surface_forcing_CS), pointer :: CS !< control structure returned by - !! a previous call to surface_forcing_init - type(surface), intent(in) :: state !< control structure to ocean - !! surface state fields. - type(ESMF_State), intent(in) :: ImportState !< fluxes from top level - logical, intent(in) :: sw_decomp !< controls if shortwave is - !!decomposed into four components - real(kind=8), intent(in), optional :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition - logical, optional, intent(in) :: restore_salt, restore_temp !< Controls if salt and temp are - !! restored - - ! 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) - - real, dimension(SZI_(G),SZJ_(G)) :: & - taux_at_h, & ! Zonal wind stresses at h points (Pa) - tauy_at_h, & ! Meridional wind stresses at h points (Pa) - 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 - - 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, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0, i1, j1 - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer - integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd - integer :: lbnd1, lbnd2, ubnd1, ubnd2 - - 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(ESMF_KIND_R8), pointer :: dataPtr_p(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ifrac(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_duu10n(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_co2prog(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_co2diag(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lamult(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ustokes(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_vstokes(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_taux(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_tauy(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_sen(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lat(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_osalt(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lwdn(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lwup(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swnet(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_rofl(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_rofi(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_meltw(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_melth(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_iosalt(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_prec(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_rain(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_snow(:,:) - - call cpu_clock_begin(id_clock_forcing) - - 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 - - C_p = fluxes%C_p - Irho0 = 1.0/CS%Rho0 - open_ocn_mask(:,:) = 1.0 - pme_adj(:,:) = 0.0 - fluxes%vPrecGlobalAdj = 0.0 - fluxes%vPrecGlobalScl = 0.0 - fluxes%saltFluxGlobalAdj = 0.0 - fluxes%saltFluxGlobalScl = 0.0 - fluxes%netFWGlobalAdj = 0.0 - fluxes%netFWGlobalScl = 0.0 - - restore_salinity = .false. - if (present(restore_salt)) restore_salinity = restore_salt - restore_sst = .false. - if (present(restore_temp)) restore_sst = restore_temp - - ! if true, allocation and initialization - if (fluxes%dt_buoy_accum < 0) then - call allocate_forcing_type(G, fluxes, water=.true., heat=.true., & - ustar=.true., press=.true.) - call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., & - press=.true.) - call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%sw_nir_dir,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%sw_nir_dif,isd,ied,jsd,jed) - - call safe_alloc_ptr(forces%p_surf,isd,ied,jsd,jed) - call safe_alloc_ptr(forces%p_surf_full,isd,ied,jsd,jed) - call safe_alloc_ptr(forces%p_surf_SSH,isd,ied,jsd,jed) - - call safe_alloc_ptr(fluxes%salt_flux,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%salt_flux_in,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) - - call safe_alloc_ptr(fluxes%TKE_tidal,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%ustar_tidal,isd,ied,jsd,jed) - - if (CS%allow_flux_adjustments) then - call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) - endif - - do j=js-2,je+2 ; do i=is-2,ie+2 - fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) - fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) - enddo; enddo - - 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) - endif - - if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) - - fluxes%dt_buoy_accum = 0.0 - endif ! endif for allocation and initialization - - if (CS%allow_flux_adjustments) then - fluxes%heat_added(:,:)=0.0 - fluxes%salt_flux_added(:,:)=0.0 - endif - - 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) - enddo ; enddo - CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) - endif ! endif for allocation and initialization - - do j=js,je ; do i=is,ie - fluxes%salt_flux(i,j) = 0.0 - fluxes%vprec(i,j) = 0.0 - enddo ; enddo - - ! Salinity restoring logic - if (restore_salinity) then - call time_interp_external(CS%id_srestore,Time,data_restore) - ! open_ocn_mask indicates where to restore salinity (1 means restore, 0 does not) - open_ocn_mask(:,:) = 1.0 - if (CS%mask_srestore_under_ice) then ! Do not restore under sea-ice - do j=js,je ; do i=is,ie - if (state%SST(i,j) .le. -0.0539*state%SSS(i,j)) open_ocn_mask(i,j)=0.0 - enddo; enddo - endif - if (CS%salt_restore_as_sflux) then - do j=js,je ; do i=is,ie - delta_sss = data_restore(i,j)- 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 - enddo; enddo - if (CS%adjust_net_srestore_to_zero) then - if (CS%adjust_net_srestore_by_scaling) then - call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) - fluxes%saltFluxGlobalAdj = 0. - else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf - fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj - endif - endif - fluxes%salt_flux_added(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) ! Diagnostic - else - do j=js,je ; do i=is,ie - if (G%mask2dT(i,j) > 0.5) then - delta_sss = 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))* & - (CS%Rho0*CS%Flux_const) * & - delta_sss / (0.5*(state%SSS(i,j) + data_restore(i,j))) - endif - enddo; enddo - if (CS%adjust_net_srestore_to_zero) then - if (CS%adjust_net_srestore_by_scaling) then - call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) - fluxes%vPrecGlobalAdj = 0. - else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) - fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf - do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) - enddo; enddo - endif - endif - endif - endif - - ! SST restoring logic - if (restore_sst) then - call time_interp_external(CS%id_trestore,Time,data_restore) - do j=js,je ; do i=is,ie - delta_sst = data_restore(i,j)- 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 - enddo; enddo - endif - - ! GMM, CIME uses AGRID. All the BGRID_NE code can be cleaned later - wind_stagger = AGRID - - 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 - endif - if (wind_stagger == AGRID) then - ! This is necessary to fill in the halo points. - taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 - endif - - call State_getFldPtr(importState,'Sa_pslv', dataPtr_p,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'Si_ifrac', dataPtr_ifrac,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"So_duu10n", dataPtr_duu10n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -! call State_getFldPtr(importState,"Sa_co2prog", dataPtr_co2prog, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out -! call State_getFldPtr(importState,"Sa_co2diag", dataPtr_co2diag, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out - call State_getFldPtr(importState,"Sw_lamult", dataPtr_lamult, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Sw_ustokes", dataPtr_ustokes, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Sw_vstokes", dataPtr_vstokes, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_taux" , dataPtr_taux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_tauy" , dataPtr_tauy, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_sen" , dataPtr_sen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_lat" , dataPtr_lat, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_evap" , dataPtr_evap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_salt" , dataPtr_osalt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_lwdn" , dataPtr_lwdn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_lwup" , dataPtr_lwup, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_swnet", dataPtr_swnet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_rofl" , dataPtr_rofl, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_rofi" , dataPtr_rofi, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_meltw", dataPtr_meltw, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_melth", dataPtr_melth, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_salt" , dataPtr_iosalt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_prec" , dataPtr_prec, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_rain" , dataPtr_rain, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_snow" , dataPtr_snow, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - lbnd1 = lbound(dataPtr_p,1) - ubnd1 = ubound(dataPtr_p,1) - lbnd2 = lbound(dataPtr_p,2) - ubnd2 = ubound(dataPtr_p,2) - - do j=js,je ; do i=is,ie - i1 = i + lbnd1 - is - j1 = j + lbnd2 - js - - if (wind_stagger == BGRID_NE) then - taux_at_q(i,j) = dataPtr_taux(i1,j1) * CS%wind_stress_multiplier - tauy_at_q(i,j) = dataPtr_tauy(i1,j1) * CS%wind_stress_multiplier - ! GMM, cime uses AGRID - elseif (wind_stagger == AGRID) then - taux_at_h(i,j) = dataPtr_taux(i1,j1) * CS%wind_stress_multiplier - tauy_at_h(i,j) = dataPtr_tauy(i1,j1) * CS%wind_stress_multiplier - else ! C-grid wind stresses. - forces%taux(I,j) = dataPtr_taux(i1,j1) * CS%wind_stress_multiplier - forces%tauy(i,J) = dataPtr_tauy(i1,j1) * CS%wind_stress_multiplier - endif - - ! liquid precipitation (rain) - if (ASSOCIATED(fluxes%lprec)) & - fluxes%lprec(i,j) = dataPtr_rain(i1,j1) * G%mask2dT(i,j) - - ! frozen precipitation (snow) - if (ASSOCIATED(fluxes%fprec)) & - fluxes%fprec(i,j) = dataPtr_snow(i1,j1) * G%mask2dT(i,j) - - ! evaporation - if (ASSOCIATED(fluxes%evap)) & - fluxes%evap(i,j) = dataPtr_evap(i1,j1) * G%mask2dT(i,j) - - ! river runoff flux - if (ASSOCIATED(fluxes%lrunoff)) & - fluxes%lrunoff(i,j) = dataPtr_rofl(i1,j1) * G%mask2dT(i,j) - - ! ice runoff flux - if (ASSOCIATED(fluxes%frunoff)) & - fluxes%frunoff(i,j) = dataPtr_rofi(i1,j1) * G%mask2dT(i,j) - - ! 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) = 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) - - ! longwave radiation, sum up and down (W/m2) - if (ASSOCIATED(fluxes%LW)) & - fluxes%LW(i,j) = (dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1)) * G%mask2dT(i,j) - - ! sensible heat flux (W/m2) - if (ASSOCIATED(fluxes%sens)) & - fluxes%sens(i,j) = dataPtr_sen(i1,j1) * G%mask2dT(i,j) - - ! latent heat flux (W/m^2) - if (ASSOCIATED(fluxes%latent)) & - fluxes%latent(i,j) = dataPtr_lat(i1,j1) * G%mask2dT(i,j) - - if (sw_decomp) then - ! Use runtime coefficients to decompose net short-wave heat flux into 4 components - ! 1) visible, direct shortwave (W/m2) - if (ASSOCIATED(fluxes%sw_vis_dir)) & - fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c1 - ! 2) visible, diffuse shortwave (W/m2) - if (ASSOCIATED(fluxes%sw_vis_dif)) & - fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c2 - ! 3) near-IR, direct shortwave (W/m2) - if (ASSOCIATED(fluxes%sw_nir_dir)) & - fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c3 - ! 4) near-IR, diffuse shortwave (W/m2) - if (ASSOCIATED(fluxes%sw_nir_dif)) & - fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * dataPtr_swnet(i1,j1)*c4 - - 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) - else - call MOM_error(FATAL,"fill_data_ice_ocean_bnd: this option has not been implemented yet."// & - "Shortwave must be decomposed using coeffs. c1, c2, c3, c4."); - endif - - ! applied surface pressure from atmosphere and cryosphere - ! sea-level pressure (Pa) - if (ASSOCIATED(forces%p_surf_full) .and. ASSOCIATED(forces%p_surf)) then - forces%p_surf_full(i,j) = G%mask2dT(i,j) * dataPtr_p(i1,j1) - if (CS%max_p_surf >= 0.0) then - forces%p_surf(i,j) = MIN(forces%p_surf_full(i,j),CS%max_p_surf) - else - forces%p_surf(i,j) = forces%p_surf_full(i,j) - endif - - if (CS%use_limited_P_SSH) then - forces%p_surf_SSH(i,j) = forces%p_surf(i,j) - else - forces%p_surf_SSH(i,j) = forces%p_surf_full(i,j) - endif - - endif - - ! salt flux - ! more salt restoring logic - if (ASSOCIATED(fluxes%salt_flux)) & - fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(dataPtr_osalt(i1,j1) + fluxes%salt_flux(i,j)) - - if (ASSOCIATED(fluxes%salt_flux_in)) & - fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*dataPtr_iosalt(i1,j1) - - enddo ; enddo - ! ############################ END OF MCT to MOM ############################## - - ! adjust the NET fresh-water flux to zero, if flagged - if (CS%adjust_net_fresh_water_to_zero) then - do j=js,je ; do i=is,ie - net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(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 - 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) - enddo ; enddo - - if (CS%adjust_net_fresh_water_by_scaling) then - call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) - do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)) * G%mask2dT(i,j) - enddo; enddo - else - fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf - do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%netFWGlobalAdj ) * G%mask2dT(i,j) - enddo; enddo - endif - - endif - - ! surface momentum stress related fields as function of staggering - 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) - - do j=js,je ; do I=Isq,Ieq - forces%taux(I,j) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & - forces%taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + & - G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) - enddo ; enddo - - do J=Jsq,Jeq ; do i=is,ie - forces%tauy(i,J) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & - forces%tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + & - G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) - enddo ; enddo - - ! ustar is required for the bulk mixed layer formulation. The background value - ! of 0.02 Pa is a relatively small value intended to give reasonable behavior - ! in regions of very weak winds. - - do j=js,je ; do i=is,ie - tau_mag = 0.0 ; gustiness = CS%gust_const - if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & - (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then - tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & - G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & - (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & - G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & - ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) - if (CS%read_gust_2d) gustiness = CS%gust(i,j) - endif - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) - enddo ; enddo - - elseif (wind_stagger == AGRID) then - call pass_vector(taux_at_h, tauy_at_h, G%Domain,stagger=AGRID) - - do j=js,je ; do I=Isq,Ieq - forces%taux(I,j) = 0.0 - if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & - forces%taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + & - G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & - (G%mask2dT(i,j) + G%mask2dT(i+1,j)) - enddo ; enddo - - do J=Jsq,Jeq ; do i=is,ie - forces%tauy(i,J) = 0.0 - if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & - forces%tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + & - G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & - (G%mask2dT(i,j) + G%mask2dT(i,j+1)) - enddo ; enddo - - do j=js,je ; do i=is,ie - gustiness = CS%gust_const - if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & - sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) - enddo ; enddo - - 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) - - do j=js,je ; do i=is,ie - taux2 = 0.0 - if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & - taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + & - G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) - - tauy2 = 0.0 - if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & - tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + & - G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) - - if (CS%read_gust_2d) then - forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) - else - forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) - endif - enddo ; enddo - - endif ! endif for wind related fields - - - ! sea ice related fields - if (CS%rigid_sea_ice) then - ! The commented out code here and in the following lines is the correct - ! version, but the incorrect version is being retained temporarily to avoid - ! changing answers. - call pass_var(forces%p_surf_full, G%Domain) - I_GEarth = 1.0 / G%G_Earth - Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) - do I=isd,ied-1 ; do j=jsd,jed - mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth - mass_eff = 0.0 - if (mass_ice > CS%rigid_sea_ice_mass) then - mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & - (mass_ice + CS%rigid_sea_ice_mass) - endif - ! CAUTION: with both rigid_sea_ice and ice shelves, we will need to make this - ! a maximum for the second call. - forces%rigidity_ice_u(I,j) = Kv_rho_ice * mass_eff - enddo ; enddo - do i=isd,ied ; do J=jsd,jed-1 - mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i,j+1)) * I_GEarth - mass_eff = 0.0 - if (mass_ice > CS%rigid_sea_ice_mass) then - mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & - (mass_ice + CS%rigid_sea_ice_mass) - endif - forces%rigidity_ice_v(i,J) = Kv_rho_ice * mass_eff - enddo ; enddo - endif - - if (CS%allow_flux_adjustments) then - ! Apply adjustments to fluxes - call apply_flux_adjustments(G, CS, Time, forces, fluxes) - endif - - ! Allow for user-written code to alter fluxes after all the above - call user_alter_forcing(state, fluxes, Time, G, CS%urf_CS) - - call cpu_clock_end(id_clock_forcing) - -end subroutine ocn_import - -!> Adds 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) -subroutine apply_flux_adjustments(G, CS, Time, forces, 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(mech_forcing), intent(inout) :: forces !< Driving mechanical forces - type(forcing), optional, 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) - - integer :: isc, iec, jsc, jec, i, j - real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau - logical :: overrode_x, overrode_y, overrode_h - - 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) - - 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 - - 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) - - - tempx_at_h(:,:) = 0.0 ; tempy_at_h(:,:) = 0.0 - ! Either reads data or leaves contents unchanged - overrode_x = .false. ; overrode_y = .false. - call data_override('OCN', 'taux_adj', tempx_at_h(isc:iec,jsc:jec), Time, override=overrode_x) - call data_override('OCN', 'tauy_adj', tempy_at_h(isc:iec,jsc:jec), Time, override=overrode_y) - - if (overrode_x .or. overrode_y) then - if (.not. (overrode_x .and. overrode_y)) call MOM_error(FATAL,"apply_flux_adjustments: "//& - "Both taux_adj and tauy_adj must be specified, or neither, in data_table") - - ! Rotate winds - call pass_vector(tempx_at_h, tempy_at_h, G%Domain, To_All, AGRID) - do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 - dLonDx = G%geoLonCu(I,j) - G%geoLonCu(I-1,j) - dLonDy = G%geoLonCv(i,J) - G%geoLonCv(i,J-1) - rDlon = sqrt( dLonDx * dLonDx + dLonDy * dLonDy ) - if (rDlon > 0.) rDlon = 1. / rDlon - cosA = dLonDx * rDlon - sinA = dLonDy * rDlon - zonal_tau = tempx_at_h(i,j) - merid_tau = tempy_at_h(i,j) - tempx_at_h(i,j) = cosA * zonal_tau - sinA * merid_tau - tempy_at_h(i,j) = sinA * zonal_tau + cosA * merid_tau - enddo ; enddo - - ! Average to C-grid locations - do j=G%jsc,G%jec ; do I=G%isc-1,G%iec - forces%taux(I,j) = forces%taux(I,j) + 0.5 * ( tempx_at_h(i,j) + tempx_at_h(i+1,j) ) - enddo ; enddo - - do J=G%jsc-1,G%jec ; do i=G%isc,G%iec - forces%tauy(i,J) = forces%tauy(i,J) + 0.5 * ( tempy_at_h(i,j) + tempy_at_h(i,j+1) ) - enddo ; enddo - endif ! overrode_x .or. overrode_y - -end subroutine apply_flux_adjustments - -!> Terminates the model run, saving the ocean state in a -!! restart file 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. - - !if (debug .and. is_root_pe()) write(glb%stdout,*)'Here 1' - !GMM call save_restart(Ocean_state, Time) - call diag_mediator_end(Time, Ocean_state%MOM_CSp%diag) - call MOM_end(Ocean_state%MOM_CSp) - if (Ocean_state%use_ice_shelf) call ice_shelf_end(Ocean_state%Ice_shelf_CSp) - !if (debug .and. is_root_pe()) write(glb%stdout,*)'Here 2' - -end subroutine ocean_model_end - - !----------------------------------------------------------------------------- - - subroutine State_GetFldPtr(ST, fldname, fldptr, rc) - type(ESMF_State), intent(in) :: ST - character(len=*), intent(in) :: fldname - real(ESMF_KIND_R8), pointer, intent(in) :: fldptr(:,:) - integer, intent(out), optional :: rc - - ! local variables - type(ESMF_Field) :: lfield - integer :: lrc - character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' - - call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (present(rc)) rc = lrc - - end subroutine State_GetFldPtr - -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 - - integer :: g_isc, g_iec, g_jsc, g_jec,g_isd, g_ied, g_jsd, g_jed, i, j - - if (.not.associated(OS)) return - if (.not.OS%is_ocean_pe) return - -! The problem is %areaT is on MOM domain but Ice_Ocean_Boundary%... is on mpp domain. -! We want to return the MOM data on the mpp (compute) domain -! Get MOM domain extents - call mpp_get_compute_domain(OS%grid%Domain%mpp_domain, g_isc, g_iec, g_jsc, g_jec) - call mpp_get_data_domain (OS%grid%Domain%mpp_domain, g_isd, g_ied, g_jsd, g_jed) - - g_isc = g_isc-g_isd+1 ; g_iec = g_iec-g_isd+1 ; g_jsc = g_jsc-g_jsd+1 ; g_jec = g_jec-g_jsd+1 - - - select case(name) - case('area') - array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) - case('mask') - array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) -!OR same result -! do j=g_jsc,g_jec; do i=g_isc,g_iec -! array2D(isc+i-g_isc,jsc+j-g_jsc) = OS%grid%mask2dT(i,j) -! enddo; enddo - case('t_surf') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET - case('t_pme') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET - case('t_runoff') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET - case('t_calving') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET - case('btfHeat') - array2D(isc:,jsc:) = 0 - case('tlat') - array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) - case('tlon') - array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) - case('ulat') - array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) - case('ulon') - array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) - case('vlat') - array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) - case('vlon') - array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) - case('geoLatBu') - array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) - case('geoLonBu') - array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) - case('cos_rot') - array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 - 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,'get_ocean_data_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 - - if (.not.associated(OS)) return - if (.not.OS%is_ocean_pe) return - - select case(name) - case('c_p') - value = OS%C_p - case default - call MOM_error(FATAL,'get_ocean_data_data1D: unknown argument name='//name) - end select - - -end subroutine ocean_model_data1D_get - -!####################################################################### -! -! -! -! Obtain the ocean grid. -! -! - subroutine get_ocean_grid(OS, Gridp) - type(ocean_state_type) :: OS - type(ocean_grid_type) , pointer :: Gridp - - Gridp => OS%grid - return - - end subroutine get_ocean_grid -! NAME="get_ocean_grid" - -end module ocn_comp_nuopc diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 36cd3478cf..0483fcbe5f 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -9,7 +9,7 @@ !! !! @section Overview Overview !! -!! **This MOM cap has been tested with MOM5 and MOM6.** +!! **This MOM cap has been tested with MOM6.** !! !! This document describes the MOM "cap", which is a small software layer that is !! required when the [MOM ocean model] (http://mom-ocean.org/web) @@ -383,12 +383,11 @@ module mom_cap_mod use MOM_get_input, only: Get_MOM_Input, directories use MOM_domains, only: pass_var use MOM_error_handler, only: is_root_pe -#ifdef MOM6_CAP use MOM_ocean_model, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type -#else - use ocean_types_mod, only: ice_ocean_boundary_type, ocean_grid_type -#endif + use MOM_ocean_model, only: ocean_model_restart, ocean_public_type, ocean_state_type + use MOM_ocean_model, only: ocean_model_data_get, ocean_model_init_sfc + use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid #ifdef CESMCOUPLED use mom_cap_methods, only: mom_import, mom_export use esmFlds, only: flds_scalar_name, flds_scalar_num @@ -405,9 +404,6 @@ module mom_cap_mod use shr_file_mod, only: shr_file_getLogUnit, shr_file_getLogLevel use shr_file_mod, only: shr_file_setLogUnit, shr_file_setLogLevel #endif - use MOM_ocean_model, only: ocean_model_restart, ocean_public_type, ocean_state_type - use MOM_ocean_model, only: ocean_model_data_get, ocean_model_init_sfc - use MOM_ocean_model, only: ocean_model_init , update_ocean_model, ocean_model_end, get_ocean_grid use ESMF use NUOPC @@ -424,6 +420,7 @@ module mom_cap_mod implicit none private + public SetServices type ocean_internalstate_type @@ -455,17 +452,17 @@ module mom_cap_mod type (fld_list_type) :: fldsFrOcn(fldsMax) #endif - integer :: debug = 0 - integer :: import_slice = 1 - integer :: export_slice = 1 + integer :: debug = 0 + integer :: import_slice = 1 + integer :: export_slice = 1 character(len=256) :: tmpstr - integer :: dbrc + integer :: dbrc + type(ESMF_Grid) :: mom_grid_i - type(ESMF_Grid) :: mom_grid_i #ifdef CESMCOUPLED - integer :: logunit ! logging unit number logical :: write_diagnostics = .false. - character(len=32) :: runtype ! Run type + integer :: logunit ! stdout logging unit number + character(len=32) :: runtype ! run type #else logical :: write_diagnostics = .true. #endif @@ -473,7 +470,6 @@ module mom_cap_mod logical :: grid_attach_area = .false. integer(ESMF_KIND_I8) :: restart_interval logical :: sw_decomp - real(ESMF_KIND_R8) :: c1, c2, c3, c4 character(len=*),parameter :: u_file_u = & __FILE__ @@ -595,6 +591,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out + call ESMF_AttributeGet(gcomp, name="DumpFields", value=value, defaultValue="false", & convention="NUOPC", purpose="Instance", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -613,6 +610,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) profile_memory=(trim(value)/="false") call ESMF_LogWrite('MOM_CAP:ProfileMemory = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) +#ifndef CESMCOUPLED ! Retrieve restart_interval in (seconds) ! A restart_interval value of 0 means no restart will be written. call ESMF_AttributeGet(gcomp, name="restart_interval", value=value, defaultValue="0", & @@ -635,6 +633,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) return endif call ESMF_LogWrite('MOM_CAP:restart_interval = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) +#endif call ESMF_AttributeGet(gcomp, name="GridAttachArea", value=value, defaultValue="false", & convention="NUOPC", purpose="Instance", rc=rc) @@ -688,7 +687,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: nflds logical :: activefld character(len=32) :: starttype ! model start type - integer :: logunit character(len=512) :: diro character(len=512) :: logfile character(len=64) :: cvalue @@ -757,30 +755,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) DT = set_time (DT_OCEAN, 0) Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) - ocean_public%is_ocean_pe = .true. - call ocean_model_init(ocean_public, ocean_state, Time, Time) - -#ifdef CESMCOUPLED - call ocean_model_init_sfc(ocean_state, ocean_public) -#endif - - !tcx tcraig This results in errors in CESM with help from Alper - ! FATAL error "MPP_OPEN: error in OPEN for data_table" - ! The subroutine data_override_init shouldn't be called because ALLOW_FLUX_ADJUSTMENTS is set to FALSE - !tcx call data_override_init(ocean_domain_in = ocean_public%domain) - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - call IOB_allocate(ice_ocean_boundary, isc, iec, jsc, jec) - - call external_coupler_sbc_init(ocean_public%domain, dt_cpld, Run_len) - - ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state - call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - #ifdef CESMCOUPLED ! determine instance information @@ -859,9 +833,12 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) end if if (runtype == "initial") then + ! startup (new run) - 'n' is needed below since we don't specify input_filename in input.nml + ocean_public%is_ocean_pe = .true. call ocean_model_init(ocean_public, ocean_state, Time, Time, input_restart_file = 'n') + else ! hybrid or branch or continuos runs ! read name of restart file in the pointer file @@ -879,10 +856,41 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) write(logunit,*) 'Reading restart file: ',trim(restartfile) end if call shr_file_freeUnit(nu) + + ocean_public%is_ocean_pe = .true. + call ocean_model_init(ocean_public, ocean_state, Time, Time, input_restart_file=trim(restartfile)) + end if + call ocean_model_init_sfc(ocean_state, ocean_public) + +#else + + ocean_public%is_ocean_pe = .true. + call ocean_model_init(ocean_public, ocean_state, Time, Time) + +#endif + + !tcx tcraig This results in errors in CESM with help from Alper + ! FATAL error "MPP_OPEN: error in OPEN for data_table" + ! The subroutine data_override_init shouldn't be called because ALLOW_FLUX_ADJUSTMENTS is set to FALSE + !tcx call data_override_init(ocean_domain_in = ocean_public%domain) + + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + call IOB_allocate(ice_ocean_boundary, isc, iec, jsc, jec) + + call external_coupler_sbc_init(ocean_public%domain, dt_cpld, Run_len) + + ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state + call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + +#ifdef CESMCOUPLED ! create import and export field list needed by data models - call shr_nuopc_fldList_Concat(fldListFr(compocn), fldListTo(compocn), flds_o2x, flds_x2o, flds_scalar_name) + ! call shr_nuopc_fldList_Concat(fldListFr(compocn), fldListTo(compocn), flds_o2x, flds_x2o, flds_scalar_name) ! advertise import and export fields nflds = shr_nuopc_fldList_Getnumflds(fldListFr(compocn)) @@ -909,31 +917,66 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) #else - call MOM_FieldsSetup(ice_ocean_boundary, ocean_public) + ! This sets pointers of the fldsToOcn to the iceocean_boundary_type + ! Don't point directly into mom data YET (last field is optional in interface) + ! instead, create space for the field when it's "realized". - call MOM_AdvertiseFields(importState, fldsToOcn_num, fldsToOcn, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + !--------- import fields ------------- + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx" , "will provide", data=Ice_ocean_boundary%u_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx" , "will provide", data=Ice_ocean_boundary%v_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide", data=Ice_ocean_boundary%t_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide", data=Ice_ocean_boundary%q_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide", data=Ice_ocean_boundary%salt_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide", data=Ice_ocean_boundary%lw_flux ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_vis_dir) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_vis_dif) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_nir_dir) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_nir_dif) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide", data=Ice_ocean_boundary%lprec ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide", data=Ice_ocean_boundary%fprec ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide", data=Ice_ocean_boundary%runoff ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide", data=Ice_ocean_boundary%calving) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide", data=Ice_ocean_boundary%runoff_hflx ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide", data=Ice_ocean_boundary%calving_hflx) + call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide", data=Ice_ocean_boundary%p ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide", data=Ice_ocean_boundary%mi) + + !--------- export fields ------------- + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature" , "will provide", data=ocean_public%t_surf) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide", data=ocean_public%s_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide", data=ocean_public%u_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide", data=ocean_public%v_surf ) + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir" , "will provide") + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=ocean_public%sea_lev) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=ocean_public%frazil) + + do n = 1,fldsToOcn_num + call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + enddo + + do n = 1,fldsFrOcn_num + call NUOPC_Advertise(exportState, standardName=fldsFrOcn(n)%stdname, name=fldsFrOcn(n)(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + enddo - call MOM_AdvertiseFields(exportState, fldsFrOcn_num, fldsFrOcn, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out #endif -!#ifdef MOM6_CAP - ! When running mom6 solo, the rotation angles are not computed internally - ! in MOM6. We need to - ! calculate cos and sin of rotational angle for MOM6; the values - ! are stored in ocean_internalstate%ptr%ocean_grid_ptr%cos_rot and sin_rot - ! The rotation angles are retrieved during run time to rotate incoming - ! and outgoing vectors - ! -! call calculate_rot_angle(ocean_state, ocean_public) -!#endif +! When running mom6 solo, the rotation angles are not computed internally +! in MOM6. We need to calculate cos and sin of rotational angle for MOM6; +! the values are stored in ocean_internalstate%ptr%ocean_grid_ptr%cos_rot and sin_rot +! The rotation angles are retrieved during run time to rotate incoming +! and outgoing vectors +! +! call calculate_rot_angle(ocean_state, ocean_public) ! tcraig, this is handled fine internally and if not, then later call this ! call initialize_grid_rotation_angle(ocean_grid, PF) @@ -1351,13 +1394,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) enddo enddo -#ifdef MOM5_CAP - call ocean_model_data_get(ocean_state, ocean_public, 'ulon', ofld, isc, jsc) -#endif - -#ifdef MOM6_CAP call ocean_model_data_get(ocean_state, ocean_public, 'geoLonBu', ofld, isc, jsc) -#endif write(tmpstr,*) subname//' ofld xu = ',minval(ofld),maxval(ofld) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) call mpp_global_field(ocean_public%domain, ofld, gfld) @@ -1386,16 +1423,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) enddo enddo -! The corner latitude values are treated differently because MOM5 runs on B-Grid while -! MOM6 runs on C-Grid. -#ifdef MOM5_CAP - call ocean_model_data_get(ocean_state, ocean_public, 'ulat', ofld, isc, jsc) -#endif - -#ifdef MOM6_CAP + ! MOM6 runs on C-Grid. call ocean_model_data_get(ocean_state, ocean_public, 'geoLatBu', ofld, isc, jsc) -#endif - write(tmpstr,*) subname//' ofld yu = ',minval(ofld),maxval(ofld) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) call mpp_global_field(ocean_public%domain, ofld, gfld) @@ -1577,7 +1606,7 @@ subroutine DataInitialize(gcomp, rc) ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr call get_ocean_grid(ocean_state, ocean_grid) - call mom_export(ocean_public, ocean_grid, exportState, rc=rc) + call mom_export(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1782,12 +1811,7 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out -!#ifdef MOM5_CAP call get_ocean_grid(ocean_state, ocean_grid) -!#endif -!#ifdef MOM6_CAP -! ocean_grid => ocean_internalstate%ptr%ocean_grid_ptr -!#endif #ifdef CESMCOUPLED ! Reset shr logging to my log file @@ -1852,10 +1876,9 @@ subroutine ModelAdvance(gcomp, rc) dataPtr_mzmf = mzmf dataPtr_mmmf = mmmf deallocate(mzmf, mmmf) -#endif !Optionally write restart files when currTime-startTime is integer multiples of restart_interval - if(restart_interval > 0 ) then + if (restart_interval > 0 ) then time_elapsed = currTime - startTime call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1863,7 +1886,7 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out n_interval = time_elapsed_sec / restart_interval - if((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then + if ((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then time_restart_current = esmf2fms_time(currTime) timestamp = date_to_string(time_restart_current) call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=dbrc) @@ -1871,38 +1894,20 @@ subroutine ModelAdvance(gcomp, rc) call ocean_model_restart(ocean_state, timestamp) endif endif - +#endif + if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled) if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") -!#ifdef MOM5_CAP - call get_ocean_grid(ocean_state, ocean_grid) -!#endif -!#ifdef MOM6_CAP -! ocean_grid => ocean_internalstate%ptr%ocean_grid_ptr -!#endif - #ifdef CESMCOUPLED - call mom_export(ocean_public, ocean_grid, exportState, rc=rc) + + call mom_export(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - !DEBUG - call ESMF_ClockGet(clock, currTIME=MyTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, s=seconds, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - !DEBUG - ! Determine if need to write restart call ESMF_ClockGetAlarm(clock, alarmname='seq_timemgr_alarm_restart', alarm=alarm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1911,12 +1916,10 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - write(6,*)'DEBUG: alarm is ringing' - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out force_restart_now = .true. call ESMF_AlarmRingerOff( alarm, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1931,8 +1934,6 @@ subroutine ModelAdvance(gcomp, rc) write(logunit) subname//' force_restart_now=', force_restart_now end if - write(6,*)'DEBUG: day,seconds,restart= ',day,seconds,force_restart_now - if (force_restart_now) then ! determine restart filename @@ -1954,6 +1955,7 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out seconds = seconds + hour*3600 + minute*60 write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I5.5)') trim(runid), year, month, day, seconds + write(6,*)'DEBUG: runid= ',runid write(6,*)'DEBUG: year,month,day,seconds= ',year,month,day,seconds write(6,*)'DEBUG: restartname= ',trim(restartname) @@ -1979,6 +1981,7 @@ subroutine ModelAdvance(gcomp, rc) call shr_file_setLogLevel(shrloglev) #else + allocate(ofld(isc:iec,jsc:jec)) call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) @@ -2087,9 +2090,11 @@ subroutine ModelAdvance(gcomp, rc) !call ESMF_LogWrite("Before calling sbc forcing", ESMF_LOGMSG_INFO, rc=rc) call external_coupler_sbc_after(Ice_ocean_boundary, ocean_public, nc, dt_cpld ) - !call ESMF_LogWrite("Before dumpMomInternal", ESMF_LOGMSG_INFO, rc=rc) !write(*,*) 'MOM: --- run phase called ---' + + !--------- import fields ------------- + call dumpMomInternal(mom_grid_i, import_slice, "mean_zonal_moment_flx" , "will provide", Ice_ocean_boundary%u_flux) call dumpMomInternal(mom_grid_i, import_slice, "mean_merid_moment_flx" , "will provide", Ice_ocean_boundary%v_flux) call dumpMomInternal(mom_grid_i, import_slice, "mean_sensi_heat_flx" , "will provide", Ice_ocean_boundary%t_flux) @@ -2109,9 +2114,9 @@ subroutine ModelAdvance(gcomp, rc) call dumpMomInternal(mom_grid_i, import_slice, "inst_pres_height_surface" , "will provide", Ice_ocean_boundary%p ) call dumpMomInternal(mom_grid_i, import_slice, "mass_of_overlying_sea_ice" , "will provide", Ice_ocean_boundary%mi) -!--------- export fields ------------- + !--------- export fields ------------- -! call dumpMomInternal(mom_grid_i, export_slice, "ocean_mask" , "will provide", dataPtr_mask) + !call dumpMomInternal(mom_grid_i, export_slice, "ocean_mask" , "will provide", dataPtr_mask) call dumpMomInternal(mom_grid_i, export_slice, "sea_surface_temperature" , "will provide", ocean_public%t_surf) call dumpMomInternal(mom_grid_i, export_slice, "s_surf" , "will provide", ocean_public%s_surf ) call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_zonal" , "will provide", ocean_public%u_surf ) @@ -2505,33 +2510,6 @@ subroutine State_GetFldPtr(ST, fldname, fldptr, rc) end subroutine State_GetFldPtr #ifndef CESMCOUPLED - !----------------------------------------------------------------------------- - subroutine MOM_AdvertiseFields(state, nfields, field_defs, rc) - - type(ESMF_State), intent(inout) :: state - integer,intent(in) :: nfields - type(fld_list_type), intent(inout) :: field_defs(:) - integer, intent(inout) :: rc - - integer :: i - character(len=*),parameter :: subname='(mom_cap:MOM_AdvertiseFields)' - - rc = ESMF_SUCCESS - - do i = 1, nfields - - call NUOPC_Advertise(state, & - standardName=field_defs(i)%stdname, & - name=field_defs(i)%shortname, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - enddo - - end subroutine MOM_AdvertiseFields !----------------------------------------------------------------------------- @@ -2579,7 +2557,7 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) call ESMF_LogWrite(tmpstr, ESMF_LOGMSG_INFO, rc=dbrc) field = ESMF_FieldCreate(grid=grid, & farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & -! farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & + !farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & name=field_defs(i)%shortname, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2604,11 +2582,11 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) line=__LINE__, & file=__FILE__)) & return ! bail out -! call ESMF_FieldPrint(field=field, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out + ! call ESMF_FieldPrint(field=field, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out else call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is not connected.", & ESMF_LOGMSG_INFO, & @@ -2616,7 +2594,7 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) file=__FILE__, & rc=dbrc) ! TODO: Initialize the value in the pointer to 0 after proper restart is setup - !if(associated(field_defs(i)%farrayPtr) ) field_defs(i)%farrayPtr = 0.0 + ! if(associated(field_defs(i)%farrayPtr) ) field_defs(i)%farrayPtr = 0.0 ! remove a not connected Field from State call ESMF_StateRemove(state, (/field_defs(i)%shortname/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -2631,53 +2609,6 @@ end subroutine MOM_RealizeFields !----------------------------------------------------------------------------- - subroutine MOM_FieldsSetup(ice_ocean_boundary,ocean_public) - type(ice_ocean_boundary_type), intent(in) :: Ice_ocean_boundary - type(ocean_public_type), intent(in) :: ocean_public - - integer :: rc - character(len=*),parameter :: subname='(mom_cap:MOM_FieldsSetup)' - - ! fld_list_add(num, fldlist, stdname, transferOffer, data(optional), shortname(optional)) - - !--------- import fields ------------- - ! tcraig, don't point directly into mom data YET (last field is optional in interface) - ! instead, create space for the field when it's "realized". - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx", "will provide", data=Ice_ocean_boundary%u_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx", "will provide", data=Ice_ocean_boundary%v_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide", data=Ice_ocean_boundary%t_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide", data=Ice_ocean_boundary%q_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide", data=Ice_ocean_boundary%salt_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide", data=Ice_ocean_boundary%lw_flux ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dir) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx", "will provide", data=Ice_ocean_boundary%sw_flux_vis_dif) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_nir_dir) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_nir_dif) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide", data=Ice_ocean_boundary%lprec ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide", data=Ice_ocean_boundary%fprec ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide", data=Ice_ocean_boundary%runoff ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide", data=Ice_ocean_boundary%calving) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide", data=Ice_ocean_boundary%runoff_hflx ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx", "will provide", data=Ice_ocean_boundary%calving_hflx) - call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide", data=Ice_ocean_boundary%p ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice", "will provide", data=Ice_ocean_boundary%mi) - - !--------- export fields ------------- - - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask", "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature", "will provide", data=ocean_public%t_surf) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide", data=ocean_public%s_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal", "will provide", data=ocean_public%u_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid", "will provide", data=ocean_public%v_surf ) -! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir", "will provide") -! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir", "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=ocean_public%sea_lev) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=ocean_public%frazil) - - end subroutine MOM_FieldsSetup - - !----------------------------------------------------------------------------- - subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) ! ---------------------------------------------- ! Set up a list of field information @@ -2717,8 +2648,11 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) endif end subroutine fld_list_add + #endif + !----------------------------------------------------------------------------- + subroutine dumpMomInternal(grid, slice, stdname, nop, farray) type(ESMF_Grid) :: grid diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 55809b76f1..0d6ec10155 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -34,18 +34,21 @@ module mom_cap_methods !> Maps outgoing ocean data to ESMF State !! See \ref section_mom_export for a summary of the data !! that is transferred from MOM6 to MCT. - subroutine mom_export(ocean_public, grid, exportState, rc) + subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid type(ESMF_State) , intent(inout) :: exportState !< outgoing data + integer , intent(in) :: logunit + type(ESMF_Clock) , intent(in) :: clock integer , intent(inout) :: rc ! Local variables real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo - integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices - integer :: lbnd1, lbnd2, ubnd1, ubnd2 - real :: slp_L, slp_R, slp_C, slope, u_min, u_max - + integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices + integer :: lbnd1, lbnd2, ubnd1, ubnd2 + real :: slp_L, slp_R, slp_C, slope, u_min, u_max + integer :: day, secs + type(ESMF_time) :: currTime real(ESMF_KIND_R8), pointer :: dataPtr_omask(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_t(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_s(:,:) @@ -60,8 +63,8 @@ subroutine mom_export(ocean_public, grid, exportState, rc) real(ESMF_KIND_R8), pointer :: dataPtr_roce_HDO(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_fco2_ocn(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_fdms_ocn(:,:) - character(len=*), parameter :: subname = '(ocn_export)' - logical :: first_time = .true. + character(len=*), parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" + character(len=*), parameter :: subname = '(mom_export)' !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -106,11 +109,12 @@ subroutine mom_export(ocean_public, grid, exportState, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(exportState,"So_bldepth", dataPtr_bldepth, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + !TODO: need to add the So_bldepth since this is needed for the wave model + ! call State_getFldPtr(exportState,"So_bldepth", dataPtr_bldepth, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out call State_getFldPtr(exportState,"So_fswpen", dataPtr_fswpen, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -244,6 +248,24 @@ subroutine mom_export(ocean_public, grid, exportState, rc) end do end do + if (debug .and. is_root_pe()) then + call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) + call ESMF_TimeGet(CurrTime, d=day, s=secs, rc=rc) + + do j = jsc, jec + j1 = j + lbnd2 - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + write(logunit,F01)'export: day, secs, j, i, t_surf = ',day,secs,j,i,dataPtr_t(i1,j1) + write(logunit,F01)'export: day, secs, j, i, s_surf = ',day,secs,j,i,dataPtr_s(i1,j1) + write(logunit,F01)'export: day, secs, j, i, u_surf = ',day,secs,j,i,dataPtr_u(i1,j1) + write(logunit,F01)'export: day, secs, j, i, v_surf = ',day,secs,j,i,dataPtr_v(i1,j1) + write(logunit,F01)'export: day, secs, j, i, dhdx = ',day,secs,j,i,dataPtr_dhdx(i1,j1) + write(logunit,F01)'export: day, secs, j, i, dhdy = ',day,secs,j,i,dataPtr_dhdy(i1,j1) + end do + end do + end if + end subroutine mom_export !----------------------------------------------------------------------- @@ -304,8 +326,8 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & integer :: day, secs type(ESMF_time) :: currTime logical :: do_import - character(len=*), parameter :: F01 = "('(ocn_import) ',a,4(i6,2x),d21.14)" - character(len=*), parameter :: subname = '(ocn_import)' + character(len=*), parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" + character(len=*), parameter :: subname = '(mom_import)' !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -488,37 +510,36 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & else do_import = .true. end if - write(6,*)'DEBUG: import_cnt, do_import= ',import_cnt, do_import - do j = jsc, jec - j1 = j + lbnd2 - jsc - jg = j + grid%jsc - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + grid%jsc - isc - - ! ice_ocean_boundary%p(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%u_flux(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%v_flux(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%t_flux(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%q_flux(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%lw_flux(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%sw_flux_vis_dir(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%sw_flux_vis_dif(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%sw_flux_nir_dir(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%sw_flux_nir_dif(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%lprec(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%fprec(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%runoff(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%runoff_hflx(i,j) = 0.0 * GRID%mask2dT(ig,jg) - ! ice_ocean_boundary%calving(i,j) = 0.0 * GRID%mask2dT(ig,jg) - ! ice_ocean_boundary%calving_hflx(i,j) = 0.0 * GRID%mask2dT(ig,jg) - ! ice_ocean_boundary%ustar_berg(i,j) = 0.0 * GRID%mask2dT(ig,jg) - ! ice_ocean_boundary%area_berg(i,j) = 0.0 * GRID%mask2dT(ig,jg) - ! ice_ocean_boundary%mass_berg(i,j) = 0.0 * GRID%mask2dT(ig,jg) - ! ice_ocean_boundary%mi(i,j) = 0.0 * GRID%mask2dT(ig,jg) - - if (do_import) then + if (do_import) then + do j = jsc, jec + j1 = j + lbnd2 - jsc + jg = j + grid%jsc - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + ig = i + grid%jsc - isc + + ! ice_ocean_boundary%p(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%u_flux(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%v_flux(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%t_flux(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%q_flux(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%lw_flux(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%sw_flux_vis_dir(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%sw_flux_vis_dif(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%sw_flux_nir_dir(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%sw_flux_nir_dif(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%lprec(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%fprec(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%runoff(i,j) = 0.0_ESMF_KIND_R8 + ! ice_ocean_boundary%runoff_hflx(i,j) = 0.0 * GRID%mask2dT(ig,jg) + ! ice_ocean_boundary%calving(i,j) = 0.0 * GRID%mask2dT(ig,jg) + ! ice_ocean_boundary%calving_hflx(i,j) = 0.0 * GRID%mask2dT(ig,jg) + ! ice_ocean_boundary%ustar_berg(i,j) = 0.0 * GRID%mask2dT(ig,jg) + ! ice_ocean_boundary%area_berg(i,j) = 0.0 * GRID%mask2dT(ig,jg) + ! ice_ocean_boundary%mass_berg(i,j) = 0.0 * GRID%mask2dT(ig,jg) + ! ice_ocean_boundary%mi(i,j) = 0.0 * GRID%mask2dT(ig,jg) + ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) * GRID%mask2dT(ig,jg) ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) * GRID%mask2dT(ig,jg) ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) * GRID%mask2dT(ig,jg) @@ -537,13 +558,12 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & !ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(i1,j1) * GRID%mask2dT(ig,jg) !ice_ocean_boundary%u_flux(i,j) = (GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1)) !ice_ocean_boundary%v_flux(i,j) = (GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1)) - endif - + enddo enddo - enddo + end if ! debug output - if (import_cnt > 2 .and. debug .and. is_root_pe()) then + if (do_import .and. debug .and. is_root_pe()) then call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) call ESMF_TimeGet(CurrTime, d=day, s=secs, rc=rc) @@ -572,6 +592,7 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & end subroutine mom_import !----------------------------------------------------------------------------- + subroutine State_GetFldPtr(ST, fldname, fldptr, rc) type(ESMF_State) , intent(in) :: ST character(len=*) , intent(in) :: fldname From 450f87cbc2800e23a9fcf9dfad0b95ef343b41b7 Mon Sep 17 00:00:00 2001 From: mvertens Date: Thu, 12 Jul 2018 15:01:27 -0600 Subject: [PATCH 0594/1072] more changes to get the nuopc cap working --- config_src/nuopc_driver/MOM_ocean_model.F90 | 66 ++++---- config_src/nuopc_driver/mom_cap.F90 | 171 ++++++-------------- config_src/nuopc_driver/mom_cap_methods.F90 | 31 ++-- 3 files changed, 99 insertions(+), 169 deletions(-) diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 2e691e01f8..0dab588973 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -687,13 +687,13 @@ end subroutine update_ocean_model ! the any restart file name as a prefix. ! 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 + 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 "//& @@ -706,9 +706,6 @@ subroutine ocean_model_restart(OS, timestamp, restartname) if (present(restartname)) then - write(6,*)'DEBUG: calling save_restart with restartname= ',restartname - write(6,*)'DEBUG: restart_outputdir is ',OS%dirs%restart_output_dir - call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & OS%restart_CSp, GV=OS%GV, filename=restartname) @@ -753,47 +750,47 @@ end subroutine ocean_model_restart ! ! ! -! Close down the ocean model -! - -!> 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 !< 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. - -! This subroutine terminates the model run, saving the ocean state in a -! restart file and deallocating any data associated with the ocean. +! Close down the ocean model. Terminate the model run, optionally +! saving the ocean state in a restart file and deallocating any data +! associated with the ocean. ! Arguments: Ocean_sfc - An ocean_public_type structure that is to be ! deallocated upon termination. ! (inout) Ocean_state - A pointer to the structure containing the internal ! ocean state to be deallocated upon termination. ! (in) Time - The model time, used for writing restarts. - - call ocean_model_save_restart(Ocean_state, Time) +! (in) write_restart - Write restart file if true +! +subroutine ocean_model_end(Ocean_sfc, Ocean_state, Time, write_restart) + 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. + logical, intent(in) :: write_restart !< true => write restart file + + if (write_restart) then + call ocean_model_save_restart(Ocean_state, Time) + end if call diag_mediator_end(Time, Ocean_state%diag) 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. subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) - type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the - !! internal ocean state (in). - type(time_type), intent(in) :: Time !< The model time at this call, needed for mpp_write calls. - character(len=*), optional, intent(in) :: directory !< An optional directory into which to - !! write these restart files. + type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the + !! internal ocean state (in). + type(time_type), intent(in) :: Time !< The model time at this call, needed for mpp_write calls. + character(len=*), optional, intent(in) :: directory !< An optional directory into which to + !! 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. + !! 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. @@ -809,6 +806,7 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) call MOM_error(WARNING, "ocean_model_save_restart called with inconsistent "//& "dynamics and advective times. Additional restart fields "//& "that have not been coded yet would be required for reproducibility.") + if (.not.OS%fluxes%fluxes_used) call MOM_error(FATAL, "ocean_model_save_restart "//& "was called with unused buoyancy fluxes. For conservation, the ocean "//& "restart files can only be created after the buoyancy forcing is applied.") diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 0483fcbe5f..bf8af0b75f 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -157,7 +157,6 @@ !! - vector rotations are applied to the `ocean_current_zonal` and `ocean_current_merid` exports, back to lat-lon grid !! - diagnostics are optionally written to files `field_ocn_export_*`, one for each export field !! - a call is made to `external_coupler_sbc_after()` to update exports from an external coupler (currently an inactive stub) -!! - calls are made to `dumpMomInternal()` to write files `field_ocn_internal_*` for all internal fields (both import and export) !! !! @subsubsection VectorRotations Vector Rotations !! @@ -333,9 +332,6 @@ !! information is written when entering and leaving the [ModelAdvance] !! (@ref mom_cap_mod::modeladvance) subroutine and before and after the call to !! `update_ocean_model()`. -!! * `OceanSolo` - when set to "true", this option indicates that MOM is being run -!! uncoupled; in this case the vector rotations and other data manipulations -!! on import fields are skipped !! * `restart_interval` - integer number of seconds indicating the interval at !! which to call `ocean_model_restart()`; no restarts written if set to 0 !! * `GridAttachArea` - when set to "true", this option indicates that MOM grid attaches cell area @@ -433,10 +429,6 @@ module mom_cap_mod type(ocean_internalstate_type), pointer :: ptr end type -#ifdef CESMCOUPLED - character(len=4096) :: flds_o2x = '' - character(len=4096) :: flds_x2o = '' -#else type fld_list_type character(len=64) :: stdname character(len=64) :: shortname @@ -450,14 +442,13 @@ module mom_cap_mod type (fld_list_type) :: fldsToOcn(fldsMax) integer :: fldsFrOcn_num = 0 type (fld_list_type) :: fldsFrOcn(fldsMax) -#endif - integer :: debug = 0 - integer :: import_slice = 1 - integer :: export_slice = 1 - character(len=256) :: tmpstr - integer :: dbrc - type(ESMF_Grid) :: mom_grid_i + integer :: debug = 0 + integer :: import_slice = 1 + integer :: export_slice = 1 + character(len=256) :: tmpstr + integer :: dbrc + type(ESMF_Grid) :: mom_grid_i #ifdef CESMCOUPLED logical :: write_diagnostics = .false. @@ -1203,7 +1194,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out write(tmpstr,'(a,4i8)') subname//' distgrid list= ',& - indexList(1),indexList(cnt),minval(indexList), maxval(indexList) + indexList(1),indexList(cnt),minval(indexList), maxval(indexList) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) deallocate(IndexList) @@ -1700,7 +1691,6 @@ subroutine ModelAdvance(gcomp, rc) integer :: shrloglev ! original log level integer :: logunit ! i/o unit for stdout integer :: nu ! i/o unit to write pointer file - logical :: force_restart_now character(ESMF_MAXSTR) :: cvalue character(ESMF_MAXSTR) :: runid ! Run ID character(len=384) :: restartname ! restart file name (no dir) @@ -1805,12 +1795,6 @@ subroutine ModelAdvance(gcomp, rc) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - call ESMF_LogWrite(subname//' tcx in not ocean_solo', ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call get_ocean_grid(ocean_state, ocean_grid) #ifdef CESMCOUPLED @@ -1896,6 +1880,8 @@ subroutine ModelAdvance(gcomp, rc) endif #endif + ! Update MOM6 + if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled) if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") @@ -1908,7 +1894,7 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out - ! Determine if need to write restart + ! If restart alarm is ringing - write restart file call ESMF_ClockGetAlarm(clock, alarmname='seq_timemgr_alarm_restart', alarm=alarm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1920,46 +1906,35 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - force_restart_now = .true. + call ESMF_AlarmRingerOff( alarm, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - else - force_restart_now = .false. - endif - - if (debug > 0 .and. is_root_pe()) then - write(logunit) subname//' force_restart_now=', force_restart_now - end if - - if (force_restart_now) then ! determine restart filename + ! Need to use next time step since clock is not advanced until the end of the time interval call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out read(cvalue,*) runid - call ESMF_ClockGet(clock, currTIME=MyTime, rc=rc) + + call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, h=hour, m=minute, s=seconds, rc=rc ) + + call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, s=seconds, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - seconds = seconds + hour*3600 + minute*60 write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I5.5)') trim(runid), year, month, day, seconds - write(6,*)'DEBUG: runid= ',runid - write(6,*)'DEBUG: year,month,day,seconds= ',year,month,day,seconds - write(6,*)'DEBUG: restartname= ',trim(restartname) - ! write name of restart file in the rpointer file nu = shr_file_getUnit() if (is_root_pe()) then @@ -1974,6 +1949,9 @@ subroutine ModelAdvance(gcomp, rc) ! write restart file(s) call ocean_model_restart(ocean_state, restartname=restartname) + if (is_root_pe()) then + write(logunit,*) subname//' writing restart file ',trim(restartname) + end if endif ! reset shr logging to my original values @@ -2095,33 +2073,33 @@ subroutine ModelAdvance(gcomp, rc) !--------- import fields ------------- - call dumpMomInternal(mom_grid_i, import_slice, "mean_zonal_moment_flx" , "will provide", Ice_ocean_boundary%u_flux) - call dumpMomInternal(mom_grid_i, import_slice, "mean_merid_moment_flx" , "will provide", Ice_ocean_boundary%v_flux) - call dumpMomInternal(mom_grid_i, import_slice, "mean_sensi_heat_flx" , "will provide", Ice_ocean_boundary%t_flux) - call dumpMomInternal(mom_grid_i, import_slice, "mean_evap_rate" , "will provide", Ice_ocean_boundary%q_flux) - call dumpMomInternal(mom_grid_i, import_slice, "mean_salt_rate" , "will provide", Ice_ocean_boundary%salt_flux) - call dumpMomInternal(mom_grid_i, import_slice, "mean_net_lw_flx" , "will provide", Ice_ocean_boundary%lw_flux ) - call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dir_flx" , "will provide", Ice_ocean_boundary%sw_flux_vis_dir) - call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dif_flx" , "will provide", Ice_ocean_boundary%sw_flux_vis_dif) - call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dir_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dir) - call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dif_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dif) - call dumpMomInternal(mom_grid_i, import_slice, "mean_prec_rate" , "will provide", Ice_ocean_boundary%lprec ) - call dumpMomInternal(mom_grid_i, import_slice, "mean_fprec_rate" , "will provide", Ice_ocean_boundary%fprec ) - call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_rate" , "will provide", Ice_ocean_boundary%runoff ) - call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_rate" , "will provide", Ice_ocean_boundary%calving) - call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_heat_flx" , "will provide", Ice_ocean_boundary%runoff_hflx ) - call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_heat_flx" , "will provide", Ice_ocean_boundary%calving_hflx) - call dumpMomInternal(mom_grid_i, import_slice, "inst_pres_height_surface" , "will provide", Ice_ocean_boundary%p ) - call dumpMomInternal(mom_grid_i, import_slice, "mass_of_overlying_sea_ice" , "will provide", Ice_ocean_boundary%mi) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_zonal_moment_flx" , "will provide", Ice_ocean_boundary%u_flux) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_merid_moment_flx" , "will provide", Ice_ocean_boundary%v_flux) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_sensi_heat_flx" , "will provide", Ice_ocean_boundary%t_flux) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_evap_rate" , "will provide", Ice_ocean_boundary%q_flux) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_salt_rate" , "will provide", Ice_ocean_boundary%salt_flux) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_lw_flx" , "will provide", Ice_ocean_boundary%lw_flux ) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dir_flx" , "will provide", Ice_ocean_boundary%sw_flux_vis_dir) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dif_flx" , "will provide", Ice_ocean_boundary%sw_flux_vis_dif) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dir_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dir) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dif_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dif) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_prec_rate" , "will provide", Ice_ocean_boundary%lprec ) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_fprec_rate" , "will provide", Ice_ocean_boundary%fprec ) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_rate" , "will provide", Ice_ocean_boundary%runoff ) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_rate" , "will provide", Ice_ocean_boundary%calving) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_heat_flx" , "will provide", Ice_ocean_boundary%runoff_hflx ) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_heat_flx" , "will provide", Ice_ocean_boundary%calving_hflx) + ! call dumpMomInternal(mom_grid_i, import_slice, "inst_pres_height_surface" , "will provide", Ice_ocean_boundary%p ) + ! call dumpMomInternal(mom_grid_i, import_slice, "mass_of_overlying_sea_ice" , "will provide", Ice_ocean_boundary%mi) !--------- export fields ------------- - !call dumpMomInternal(mom_grid_i, export_slice, "ocean_mask" , "will provide", dataPtr_mask) - call dumpMomInternal(mom_grid_i, export_slice, "sea_surface_temperature" , "will provide", ocean_public%t_surf) - call dumpMomInternal(mom_grid_i, export_slice, "s_surf" , "will provide", ocean_public%s_surf ) - call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_zonal" , "will provide", ocean_public%u_surf ) - call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_merid" , "will provide", ocean_public%v_surf ) - call dumpMomInternal(mom_grid_i, export_slice, "sea_lev" , "will provide", ocean_public%sea_lev) + ! call dumpMomInternal(mom_grid_i, export_slice, "ocean_mask" , "will provide", dataPtr_mask) + ! call dumpMomInternal(mom_grid_i, export_slice, "sea_surface_temperature" , "will provide", ocean_public%t_surf) + ! call dumpMomInternal(mom_grid_i, export_slice, "s_surf" , "will provide", ocean_public%s_surf ) + ! call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_zonal" , "will provide", ocean_public%u_surf ) + ! call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_merid" , "will provide", ocean_public%v_surf ) + ! call dumpMomInternal(mom_grid_i, export_slice, "sea_lev" , "will provide", ocean_public%sea_lev) if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") @@ -2295,8 +2273,8 @@ subroutine ocean_model_finalize(gcomp, rc) file=__FILE__)) & return ! bail out - ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr - ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -2311,8 +2289,11 @@ subroutine ocean_model_finalize(gcomp, rc) return ! bail out Time = esmf2fms_time(currTime) - call ocean_model_end (ocean_public, ocean_State, Time) - call diag_manager_end(Time ) +#ifdef CESMCOUPLED + call ocean_model_end (ocean_public, ocean_State, Time, write_restart=.false.) +#else + call ocean_model_end (ocean_public, ocean_State, Time, write_restart=.true.) +#endif call field_manager_end call fms_io_exit @@ -2642,6 +2623,7 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) fldlist(num)%transferOffer = trim(transferOffer) if (present(data)) then fldlist(num)%assoc = .true. + ! The following sets up the data pointer that will be used in the realize call fldlist(num)%farrayPtr => data else fldlist(num)%assoc = .false. @@ -2653,57 +2635,7 @@ end subroutine fld_list_add !----------------------------------------------------------------------------- - subroutine dumpMomInternal(grid, slice, stdname, nop, farray) - - type(ESMF_Grid) :: grid - integer, intent(in) :: slice - character(len=*) :: stdname - character(len=*) :: nop - real(ESMF_KIND_R8), dimension(:,:), target :: farray - - type(ESMF_Field) :: field - real(ESMF_KIND_R8), dimension(:,:), pointer :: f2d - integer :: rc - -#ifdef MOM6_CAP - return -#endif - - if(.not. write_diagnostics) return ! nop in production mode - - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, & - indexflag=ESMF_INDEX_DELOCAL, & - name=stdname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_FieldGet(field, farrayPtr=f2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - f2d(:,:) = farray(:,:) - - call ESMF_FieldWrite(field, fileName='field_ocn_internal_'//trim(stdname)//'.nc', & - timeslice=slice, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_FieldDestroy(field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end subroutine - #if (1 == 0) -#ifdef MOM6_CAP subroutine calculate_rot_angle(OS, OSFC) type(ocean_state_type), intent(in) :: OS type(ocean_public_type), intent(in) :: OSFC @@ -2748,6 +2680,5 @@ subroutine calculate_rot_angle(OS, OSFC) end subroutine #endif -#endif end module mom_cap_mod diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 0d6ec10155..702b188e5f 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -110,11 +110,11 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) file=__FILE__)) & return ! bail out !TODO: need to add the So_bldepth since this is needed for the wave model - ! call State_getFldPtr(exportState,"So_bldepth", dataPtr_bldepth, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out + call State_getFldPtr(exportState,"So_bldepth", dataPtr_bldepth, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(exportState,"So_fswpen", dataPtr_fswpen, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -157,16 +157,17 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) do i = isc, iec i1 = i + lbnd1 - isc ig = i + grid%isc - isc - dataPtr_omask(i1,j1) = grid%mask2dT(ig,jg) - dataPtr_t(i1,j1) = ocean_public%t_surf(i,j) * grid%mask2dT(ig,jg) ! surface temp is in K - dataPtr_s(i1,j1) = ocean_public%s_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_u(i1,j1) = ocean_public%u_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_v(i1,j1) = ocean_public%v_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_q(i1,j1) = 0. - !dataPtr_u(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%u_surf(i,j) & - ! - grid%sin_rot(ig,jg) * ocean_public%v_surf(i,j)) * grid%mask2dT(ig,jg) - !dataPtr_v(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%v_surf(i,j) & - ! + grid%sin_rot(ig,jg) * ocean_public%u_surf(i,j)) * grid%mask2dT(ig,jg) + dataPtr_omask(i1,j1) = grid%mask2dT(ig,jg) + dataPtr_t(i1,j1) = ocean_public%t_surf(i,j) * grid%mask2dT(ig,jg) ! surface temp is in K + dataPtr_s(i1,j1) = ocean_public%s_surf(i,j) * grid%mask2dT(ig,jg) + dataPtr_u(i1,j1) = ocean_public%u_surf(i,j) * grid%mask2dT(ig,jg) + dataPtr_v(i1,j1) = ocean_public%v_surf(i,j) * grid%mask2dT(ig,jg) + dataPtr_q(i1,j1) = 0. + dataPtr_bldepth(i1,j1) = 0. ! TODO: this needs to be generalized + !dataPtr_u(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%u_surf(i,j) & + ! - grid%sin_rot(ig,jg) * ocean_public%v_surf(i,j)) * grid%mask2dT(ig,jg) + !dataPtr_v(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%v_surf(i,j) & + ! + grid%sin_rot(ig,jg) * ocean_public%u_surf(i,j)) * grid%mask2dT(ig,jg) end do end do From f49c205eb269b3b018a5f1ff9c9d01a5c074c3f8 Mon Sep 17 00:00:00 2001 From: mvertens Date: Thu, 12 Jul 2018 15:41:49 -0600 Subject: [PATCH 0595/1072] more cleanup of cesm cap --- config_src/nuopc_driver/mom_cap_methods.F90 | 73 +++++---------------- 1 file changed, 18 insertions(+), 55 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 702b188e5f..2682404ad7 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -489,22 +489,6 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - !tcx - ! write(tmpstr,'(a,6i8)') subname//'tcx1',lbnd1,ubnd1,lbnd2,ubnd2 - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx2',isc,iec,jsc,jec - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx3',i,j,i1,j1 - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx4',lbound(ice_ocean_boundary%p,1),ubound(ice_ocean_boundary%p,1),& - ! lbound(ice_ocean_boundary%p,2),ubound(ice_ocean_boundary%p,2) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,6i8)') subname//'tcx5',lbound(grid%mask2dT,1),ubound(grid%mask2dT,1),& - ! lbound(grid%mask2dT,2),ubound(grid%mask2dT,2) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,i8)') subname//' tcx import_cnt ',import_cnt - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - if ((trim(runtype) == 'initial' .and. import_cnt <= 2)) then ! This will skip the first time import information is given do_import = .false. @@ -520,45 +504,24 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & i1 = i + lbnd1 - isc ig = i + grid%jsc - isc - ! ice_ocean_boundary%p(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%u_flux(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%v_flux(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%t_flux(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%q_flux(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%lw_flux(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%sw_flux_vis_dir(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%sw_flux_vis_dif(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%sw_flux_nir_dir(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%sw_flux_nir_dif(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%lprec(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%fprec(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%runoff(i,j) = 0.0_ESMF_KIND_R8 - ! ice_ocean_boundary%runoff_hflx(i,j) = 0.0 * GRID%mask2dT(ig,jg) - ! ice_ocean_boundary%calving(i,j) = 0.0 * GRID%mask2dT(ig,jg) - ! ice_ocean_boundary%calving_hflx(i,j) = 0.0 * GRID%mask2dT(ig,jg) - ! ice_ocean_boundary%ustar_berg(i,j) = 0.0 * GRID%mask2dT(ig,jg) - ! ice_ocean_boundary%area_berg(i,j) = 0.0 * GRID%mask2dT(ig,jg) - ! ice_ocean_boundary%mass_berg(i,j) = 0.0 * GRID%mask2dT(ig,jg) - ! ice_ocean_boundary%mi(i,j) = 0.0 * GRID%mask2dT(ig,jg) - - ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%t_flux(i,j) = -dataPtr_sen(i1,j1) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%lw_flux(i,j) = (dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1)) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(i1,j1) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%salt_flux(i,j) = dataPtr_iosalt(i1,j1) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%runoff(i,j) = (dataPtr_rofl(i1,j1) + dataPtr_rofi(i1,j1)) * GRID%mask2dT(ig,jg) - !ice_ocean_boundary%salt_flux(i,j) = (dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j)) * GRID%mask2dT(ig,jg) - !ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(i1,j1) * GRID%mask2dT(ig,jg) - !ice_ocean_boundary%u_flux(i,j) = (GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1)) - !ice_ocean_boundary%v_flux(i,j) = (GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1)) + ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) + ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) + ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) + ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) + ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) + ice_ocean_boundary%t_flux(i,j) = -dataPtr_sen(i1,j1) + ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) + ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1) + ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(i1,j1) + ice_ocean_boundary%salt_flux(i,j) = dataPtr_iosalt(i1,j1) + ice_ocean_boundary%runoff(i,j) = dataPtr_rofl(i1,j1) + dataPtr_rofi(i1,j1) + !ice_ocean_boundary%salt_flux(i,j) = dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j) + !ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(i1,j1) + !ice_ocean_boundary%u_flux(i,j) = GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1) + !ice_ocean_boundary%v_flux(i,j) = GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1) enddo enddo end if From 7fb01ffe9c4d940dde256c1cfce96e24311e3c98 Mon Sep 17 00:00:00 2001 From: mvertens Date: Thu, 12 Jul 2018 16:50:11 -0600 Subject: [PATCH 0596/1072] removed trailing whitespace --- config_src/mct_driver/MOM_ocean_model.F90 | 18 +- config_src/mct_driver/MOM_surface_forcing.F90 | 4 +- config_src/nuopc_driver/MOM_ocean_model.F90 | 14 +- .../nuopc_driver/MOM_surface_forcing.F90 | 2 +- config_src/nuopc_driver/mom_cap.F90 | 178 +++++++++--------- config_src/nuopc_driver/mom_cap_methods.F90 | 60 +++--- config_src/nuopc_driver/time_utils.F90 | 6 +- 7 files changed, 141 insertions(+), 141 deletions(-) diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 7bed0ff3cb..b8ee6734d6 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -42,7 +42,7 @@ module MOM_ocean_model 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 : surface_forcing_init use MOM_surface_forcing, only : 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 @@ -150,7 +150,7 @@ module MOM_ocean_model !> 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 +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 @@ -285,15 +285,15 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i "staggering of the surface velocity field that is \n"//& "returned to the coupler. Valid values include \n"//& "'A', 'B', or 'C'.", default="C") - if (uppercase(stagger(1:1)) == 'A') then + if (uppercase(stagger(1:1)) == 'A') then Ocean_sfc%stagger = AGRID - elseif (uppercase(stagger(1:1)) == 'B') then + elseif (uppercase(stagger(1:1)) == 'B') then Ocean_sfc%stagger = BGRID_NE - elseif (uppercase(stagger(1:1)) == 'C') then + elseif (uppercase(stagger(1:1)) == 'C') then Ocean_sfc%stagger = CGRID_NE - else + else call MOM_error(FATAL,"ocean_model_init: OCEAN_SURFACE_STAGGER = "// & - trim(stagger)//" is invalid.") + trim(stagger)//" is invalid.") end if call get_param(param_file, mdl, "RESTORE_SALINITY",OS%restore_salinity, & @@ -662,8 +662,8 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) if (present(directory)) then restart_dir = directory - else - restart_dir = OS%dirs%restart_output_dir + else + restart_dir = OS%dirs%restart_output_dir endif call save_restart(restart_dir, Time, OS%grid, OS%restart_CSp, GV=OS%GV) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index cf2bb14d41..b155f360a7 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -59,7 +59,7 @@ module MOM_surface_forcing !> 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 ; 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 @@ -604,7 +604,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) endif end if end do; end do - + ! GMM, CIME uses AGRID. All the BGRID_NE code can be cleaned later wind_stagger = AGRID diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 0dab588973..2c47d9e91a 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -691,7 +691,7 @@ subroutine ocean_model_restart(OS, timestamp, restartname) !! 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 + character(len=*), optional, intent(in) :: restartname !< Name of restart file to use !! This option distinguishes the cesm interface from the !! non-cesm interface @@ -715,7 +715,7 @@ subroutine ocean_model_restart(OS, timestamp, restartname) 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 @@ -733,7 +733,7 @@ subroutine ocean_model_restart(OS, timestamp, restartname) 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 @@ -768,7 +768,7 @@ subroutine ocean_model_end(Ocean_sfc, Ocean_state, Time, write_restart) !! the internal ocean state to be deallocated !! upon termination. type(time_type), intent(in) :: Time !< The model time, used for writing restarts. - logical, intent(in) :: write_restart !< true => write restart file + logical, intent(in) :: write_restart !< true => write restart file if (write_restart) then call ocean_model_save_restart(Ocean_state, Time) @@ -811,10 +811,10 @@ 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 + if (present(directory)) then restart_dir = directory - else - restart_dir = OS%dirs%restart_output_dir + else + restart_dir = OS%dirs%restart_output_dir endif call save_restart(restart_dir, Time, OS%grid, OS%restart_CSp, GV=OS%GV) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index b6a8f9ac5c..e601e83347 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -590,7 +590,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) 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) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index bf8af0b75f..526b1e2b7f 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -11,27 +11,27 @@ !! !! **This MOM cap has been tested with MOM6.** !! -!! This document describes the MOM "cap", which is a small software layer that is -!! required when the [MOM ocean model] (http://mom-ocean.org/web) -!! is used in [National Unified Operation Prediction Capability] +!! This document describes the MOM "cap", which is a small software layer that is +!! required when the [MOM ocean model] (http://mom-ocean.org/web) +!! is used in [National Unified Operation Prediction Capability] !! (http://www.earthsystemcog.org/projects/nuopc) (NUOPC) coupled systems. -!! The NUOPC Layer is a software layer built on top of the [Earth System Modeling -!! Framework] (https://www.earthsystemcog.org/projects/esmf) (ESMF). +!! The NUOPC Layer is a software layer built on top of the [Earth System Modeling +!! Framework] (https://www.earthsystemcog.org/projects/esmf) (ESMF). !! ESMF is a high-performance modeling framework that provides !! data structures, interfaces, and operations suited for building coupled models !! from a set of components. NUOPC refines the capabilities of ESMF by providing -!! a more precise definition of what it means for a model to be a component and +!! a more precise definition of what it means for a model to be a component and !! how components should interact and share data in a coupled system. The NUOPC !! Layer software is designed to work with typical high-performance models in the -!! Earth sciences domain, most of which are written in Fortran and are based on a -!! distributed memory model of parallelism (MPI). -!! A NUOPC "cap" is a Fortran module that serves as the interface to a model -!! when it's used in a NUOPC-based coupled system. -!! The term "cap" is used because it is a small software layer that sits on top -!! of model code, making calls into it and exposing model data structures in a +!! Earth sciences domain, most of which are written in Fortran and are based on a +!! distributed memory model of parallelism (MPI). +!! A NUOPC "cap" is a Fortran module that serves as the interface to a model +!! when it's used in a NUOPC-based coupled system. +!! The term "cap" is used because it is a small software layer that sits on top +!! of model code, making calls into it and exposing model data structures in a !! standard way. For more information about creating NUOPC caps in general, please -!! see the [Building a NUOPC Model] -!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_howtodoc/) +!! see the [Building a NUOPC Model] +!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_howtodoc/) !! how-to document. !! !! The MOM cap package includes the cap itself (mom_cap.F90, a Fortran module), a @@ -65,7 +65,7 @@ !! !! Two key initialization phases that appear in every NUOPC cap, including this MOM !! cap are the field "advertise" and field "realize" phases. *Advertise* is a special -!! NUOPC term that refers to a model participating in a coupled system +!! NUOPC term that refers to a model participating in a coupled system !! providing a list of standard names of required import fields and available export !! fields. In other words, each model will advertise to the other models which physical fields !! it needs and which fields it can provide when coupled. NUOPC compares all of the advertised @@ -79,13 +79,13 @@ !! type, which describes logically rectangular grids and the [ESMF_Field] !! (http://www.earthsystemmodeling.org/esmf_releases/public/last/ESMF_refdoc/node5.html#SECTION05030000000000000000) !! type, which wraps a models data arrays and provides basic metadata. Because ESMF supports -!! interpolation between different grids (sometimes called "regridding" or "grid remapping"), +!! interpolation between different grids (sometimes called "regridding" or "grid remapping"), !! it is not necessary that models share a grid. As you will see below !! the *advertise* and *realize* phases each have a subroutine in the HYCOM cap. -!! +!! !! The following table summarizes the NUOPC-required subroutines that appear in the !! MOM cap. The "Phase" column says whether the subroutine is called during the -!! initialization, run, or finalize part of the coupled system run. +!! initialization, run, or finalize part of the coupled system run. !! !! Phase | MOM Cap Subroutine | Description !! ---------|--------------------------------------------------------------------|------------------------------------------------------------- @@ -122,7 +122,7 @@ !! - an `ESMF_Grid` is then created by passing in the above `ESMF_DistGrid`. !! !! Masks, areas, center (tlat, tlon), and corner (ulat, ulon) coordinates are then added to the `ESMF_Grid` -!! by retrieving those fields from MOM with calls to `ocean_model_data_get()`. +!! by retrieving those fields from MOM with calls to `ocean_model_data_get()`. !! !! @subsection Initialization Initialization !! @@ -132,7 +132,7 @@ !! is pulled in through the ESMF VM object for the MOM component. The dt and start time are set !! from parameters from the incoming ESMF clock with calls to `set_time()` and `set_date().` !! -!! +!! !! @subsection Run Run !! !! The [ModelAdvance] (@ref mom_cap_mod::modeladvance) subroutine is called by the NUOPC @@ -215,7 +215,7 @@ !! !! The following tables list the import and export fields currently set up in the MOM cap. !! -!! @subsection ImportFields Import Fields +!! @subsection ImportFields Import Fields !! !! Standard Name | Units | Model Variable | Description | Notes !! ----------------------------------|------------|-----------------|-----------------------------------------------|-------------------------------------- @@ -259,7 +259,7 @@ !! The MOM cap has an internal state type with pointers to three !! types defined by MOM. There is also a small wrapper derived type !! required to associate an internal state instance -!! with the ESMF/NUOPC component: +!! with the ESMF/NUOPC component: !! !! type ocean_internalstate_type !! type(ocean_public_type), pointer :: ocean_public_type_ptr @@ -298,7 +298,7 @@ !! (@ref mom_cap_mod::dumpmominternal) to write out model internal fields to files !! named "field_ocn_internal_.nc". In all cases these NetCDF files will !! contain a time series of field data. -!! +!! !! @section BuildingAndInstalling Building and Installing !! !! There are two makefiles included with the MOM cap, makefile and makefile.nuopc. @@ -319,7 +319,7 @@ !! !! The MOM cap is dependent on the MOM library itself (lib_ocean.a) and the FMS !! library (lib_FMS.a). -!! +!! !! @section RuntimeConfiguration Runtime Configuration !! !! At runtime, the MOM cap can be configured with several options provided @@ -337,14 +337,14 @@ !! * `GridAttachArea` - when set to "true", this option indicates that MOM grid attaches cell area !! using internal values computed in MOM. The default value is "false", grid cell area will !! be computed in ESMF. -!! -!! +!! +!! !! @section Repository !! The MOM NUOPC cap is maintained in a GitHub repository: !! https://github.com/feiliuesmf/nems_mom_cap !! -!! @section References -!! +!! @section References +!! !! - [MOM Home Page] (http://mom-ocean.org/web) !! !! @@ -385,7 +385,7 @@ module mom_cap_mod use MOM_ocean_model, only: ocean_model_data_get, ocean_model_init_sfc use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid #ifdef CESMCOUPLED - use mom_cap_methods, only: mom_import, mom_export + use mom_cap_methods, only: mom_import, mom_export use esmFlds, only: flds_scalar_name, flds_scalar_num use esmFlds, only: fldListFr, fldListTo, compocn, compname use esmFlds, only: flds_scalar_index_nx, flds_scalar_index_ny @@ -472,7 +472,7 @@ module mom_cap_mod !! in the module with the NUOPC layer. !! !! @param gcomp an ESMF_GridComp object - !! @param rc return code + !! @param rc return code subroutine SetServices(gcomp, rc) type(ESMF_GridComp) :: gcomp @@ -480,14 +480,14 @@ subroutine SetServices(gcomp, rc) character(len=*),parameter :: subname='(mom_cap:SetServices)' rc = ESMF_SUCCESS - + ! the NUOPC model component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + ! switching to IPD versions call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & userRoutine=InitializeP0, phase=0, rc=rc) @@ -509,7 +509,7 @@ subroutine SetServices(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + !------------------ ! attach specializing method(s) !------------------ @@ -569,7 +569,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc - + character(len=10) :: value character(len=*),parameter :: subname='(mom_cap:InitializeP0)' @@ -590,7 +590,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out ! write_diagnostics=(trim(value)=="true") - call ESMF_LogWrite('MOM_CAP:DumpFields = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite('MOM_CAP:DumpFields = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) call ESMF_AttributeGet(gcomp, name="ProfileMemory", value=value, defaultValue="true", & convention="NUOPC", purpose="Instance", rc=rc) @@ -599,7 +599,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out profile_memory=(trim(value)/="false") - call ESMF_LogWrite('MOM_CAP:ProfileMemory = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite('MOM_CAP:ProfileMemory = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) #ifndef CESMCOUPLED ! Retrieve restart_interval in (seconds) @@ -623,7 +623,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) file=__FILE__, rcToReturn=rc) return endif - call ESMF_LogWrite('MOM_CAP:restart_interval = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite('MOM_CAP:restart_interval = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) #endif call ESMF_AttributeGet(gcomp, name="GridAttachArea", value=value, defaultValue="false", & @@ -633,10 +633,10 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out grid_attach_area=(trim(value)=="true") - call ESMF_LogWrite('MOM_CAP:GridAttachArea = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) - + call ESMF_LogWrite('MOM_CAP:GridAttachArea = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + end subroutine - + !=============================================================================== !> Called by NUOPC to advertise import and export fields. "Advertise" @@ -663,8 +663,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() type(ocean_internalstate_wrapper) :: ocean_internalstate type(ocean_grid_type), pointer :: ocean_grid => NULL() - type(time_type) :: Run_len ! length of experiment - type(time_type) :: Time + type(time_type) :: Run_len ! length of experiment + type(time_type) :: Time type(time_type) :: Time_restart type(time_type) :: DT integer :: DT_OCEAN @@ -675,7 +675,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: i,n character(80) :: stdname, shortname #ifdef CESMCOUPLED - integer :: nflds + integer :: nflds logical :: activefld character(len=32) :: starttype ! model start type character(len=512) :: diro @@ -743,12 +743,12 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! this ocean connector will be driven at set interval dt_cpld = DT_OCEAN - DT = set_time (DT_OCEAN, 0) + DT = set_time (DT_OCEAN, 0) Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) #ifdef CESMCOUPLED - ! determine instance information + ! determine instance information call NUOPC_CompAttributeGet(gcomp, name="inst_name", value=inst_name, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -760,7 +760,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - read(cvalue,*) inst_index + read(cvalue,*) inst_index call ESMF_AttributeGet(gcomp, name="inst_suffix", isPresent=isPresent, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -815,7 +815,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) else if (trim(starttype) == trim('branch')) then runtype = "continue" else - call ESMF_LogWrite(subname//' ERROR: unknown starttype '//trim(starttype), ESMF_LOGMSG_ERROR, rc=dbrc) + call ESMF_LogWrite(subname//' ERROR: unknown starttype '//trim(starttype), ESMF_LOGMSG_ERROR, rc=dbrc) rc = ESMF_FAILURE if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -823,7 +823,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) return ! bail out end if - if (runtype == "initial") then + if (runtype == "initial") then ! startup (new run) - 'n' is needed below since we don't specify input_filename in input.nml ocean_public%is_ocean_pe = .true. @@ -890,7 +890,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (activefld) then call NUOPC_Advertise(exportState, standardName=stdname, shortname=shortname, name=shortname, & TransferOfferGeomObject='will provide', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return end if call ESMF_LogWrite(subname//':Fr_'//trim(compname(compocn))//': '//trim(shortname), ESMF_LOGMSG_INFO) end do @@ -901,7 +901,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (activefld) then call NUOPC_Advertise(importState, standardName=stdname, shortname=shortname, name=shortname, & TransferOfferGeomObject='will provide', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_file_u)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_file_u)) return end if call ESMF_LogWrite(subname//':To_'//trim(compname(compocn))//': '//trim(shortname), ESMF_LOGMSG_INFO) end do @@ -974,7 +974,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) write(*,*) '----- MOM initialization phase Advertise completed' end subroutine InitializeAdvertise - + !=============================================================================== !> Called by NUOPC to realize import and export fields. "Realizing" a field @@ -1041,7 +1041,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) #endif character(len=*),parameter :: subname='(mom_cap:InitializeRealize)' !-------------------------------- - + rc = ESMF_SUCCESS !---------------------------------------------------------------------------- @@ -1080,7 +1080,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call mpp_get_global_domain(ocean_public%domain, xsize=nxg, ysize=nyg) write(tmpstr,'(a,2i6)') subname//' nxg,nyg = ',nxg,nyg - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) !--------------------------------- ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total @@ -1089,7 +1089,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ntiles=mpp_get_ntile_count(ocean_public%domain) ! this is tiles on this pe if (ntiles /= 1) then rc = ESMF_FAILURE - call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR, rc=dbrc) + call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR, rc=dbrc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1097,7 +1097,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) endif ntiles=mpp_get_domain_npes(ocean_public%domain) write(tmpstr,'(a,1i6)') subname//' ntiles = ',ntiles - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) !--------------------------------- ! get start and end indices of each tile and their PET @@ -1109,7 +1109,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (debug > 0) then do n = 1,ntiles write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) enddo end if @@ -1142,7 +1142,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + allocate(connectionList(2)) ! bipolar boundary condition at top row: nyg @@ -1490,7 +1490,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, mpicom, & flds_scalar_name, flds_scalar_num, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1515,7 +1515,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + ! Do sst initialization if it's part of export state if(icount /= 0) then call ESMF_StateGet(exportState, itemName='sea_surface_temperature', field=field_t_surf, rc=rc) @@ -1549,7 +1549,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! tcraig, turn this off for now, have issues with overwriting failures ! call NUOPC_Write(exportState, fileNamePrefix='init_field_ocn_export_', & -! timeslice=1, relaxedFlag=.true., rc=rc) +! timeslice=1, relaxedFlag=.true., rc=rc) ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & ! line=__LINE__, & ! file=__FILE__)) & @@ -1558,7 +1558,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) write(*,*) '----- MOM initialization phase Realize completed' end subroutine InitializeRealize - + !=============================================================================== subroutine DataInitialize(gcomp, rc) @@ -1631,7 +1631,7 @@ subroutine DataInitialize(gcomp, rc) end do deallocate(fieldNameList) - ! check whether all Fields in the exportState are "Updated" + ! check whether all Fields in the exportState are "Updated" if (NUOPC_IsUpdated(exportState)) then call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) @@ -1644,7 +1644,7 @@ subroutine DataInitialize(gcomp, rc) if(write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_init_ocn_export_', & - timeslice=import_slice, relaxedFlag=.true., rc=rc) + timeslice=import_slice, relaxedFlag=.true., rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1656,13 +1656,13 @@ end subroutine DataInitialize !=============================================================================== !> Called by NUOPC to advance the model a single timestep. - !! + !! !! @param gcomp an ESMF_GridComp object !! @param rc return code subroutine ModelAdvance(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - + ! local variables type(ESMF_Clock) :: clock type(ESMF_Alarm) :: alarm @@ -1677,7 +1677,7 @@ subroutine ModelAdvance(gcomp, rc) type (ocean_state_type), pointer :: ocean_state => NULL() type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() type(ocean_internalstate_wrapper) :: ocean_internalstate - type(time_type) :: Time + type(time_type) :: Time type(time_type) :: Time_step_coupled type(time_type) :: Time_restart_current integer :: dth, dtm, dts, dt_cpld = 86400 @@ -1702,7 +1702,7 @@ subroutine ModelAdvance(gcomp, rc) real(ESMF_KIND_R8), pointer :: dataPtr_mmmf(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_mzmf(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_ocz(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ocm(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ocm(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) @@ -1714,7 +1714,7 @@ subroutine ModelAdvance(gcomp, rc) rc = ESMF_SUCCESS if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") - + ! query the Component for its clock, importState and exportState call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & exportState=exportState, rc=rc) @@ -1734,7 +1734,7 @@ subroutine ModelAdvance(gcomp, rc) ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep - + call ESMF_ClockPrint(clock, options="currTime", & preString="------>Advancing OCN from: ", unit=msgString, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1746,14 +1746,14 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_ClockGet(clock, startTime=startTime, currTime=currTime, & timeStep=timeStep, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_TimePrint(currTime + timeStep, & preString="--------------------------------> to: ", & unit=msgString, rc=rc) @@ -1783,7 +1783,7 @@ subroutine ModelAdvance(gcomp, rc) if(write_diagnostics) then call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', & - timeslice=import_slice, relaxedFlag=.true., rc=rc) + timeslice=import_slice, relaxedFlag=.true., rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1879,7 +1879,7 @@ subroutine ModelAdvance(gcomp, rc) endif endif #endif - + ! Update MOM6 if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") @@ -1947,7 +1947,7 @@ subroutine ModelAdvance(gcomp, rc) call shr_file_freeUnit(nu) ! write restart file(s) - call ocean_model_restart(ocean_state, restartname=restartname) + call ocean_model_restart(ocean_state, restartname=restartname) if (is_root_pe()) then write(logunit,*) subname//' writing restart file ',trim(restartname) @@ -2058,7 +2058,7 @@ subroutine ModelAdvance(gcomp, rc) if (write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & - timeslice=export_slice, relaxedFlag=.true., rc=rc) + timeslice=export_slice, relaxedFlag=.true., rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -2170,9 +2170,9 @@ subroutine ModelSetRunClock(gcomp, rc) rc=ESMF_Failure endif - !-------------------------------- - ! force model clock currtime and timestep to match driver and set stoptime - !-------------------------------- + !-------------------------------- + ! force model clock currtime and timestep to match driver and set stoptime + !-------------------------------- mstoptime = mcurrtime + dtimestep @@ -2224,9 +2224,9 @@ subroutine ModelSetRunClock(gcomp, rc) deallocate(alarmList) endif - !-------------------------------- - ! Advance model clock to trigger alarms then reset model clock back to currtime - !-------------------------------- + !-------------------------------- + ! Advance model clock to trigger alarms then reset model clock back to currtime + !-------------------------------- call ESMF_ClockAdvance(mclock,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -2253,12 +2253,12 @@ subroutine ocean_model_finalize(gcomp, rc) ! input arguments type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - + ! local variables - type (ocean_public_type), pointer :: ocean_public + type (ocean_public_type), pointer :: ocean_public type (ocean_state_type), pointer :: ocean_state type(ocean_internalstate_wrapper) :: ocean_internalstate - type(TIME_TYPE) :: Time + type(TIME_TYPE) :: Time type(ESMF_Clock) :: clock type(ESMF_Time) :: currTime character(len=64) :: timestamp @@ -2305,7 +2305,7 @@ end subroutine ocean_model_finalize !==================================================================== - ! get forcing data from data_overide + ! get forcing data from data_overide subroutine ice_ocn_bnd_from_data(x, Time, Time_step_coupled) type (ice_ocean_boundary_type) :: x @@ -2331,11 +2331,11 @@ subroutine ice_ocn_bnd_from_data(x, Time, Time_step_coupled) !call data_override('OCN', 'runoff', x%runoff , Time_next) !call data_override('OCN', 'calving', x%calving , Time_next) !call data_override('OCN', 'p', x%p , Time_next) - + end subroutine ice_ocn_bnd_from_data !----------------------------------------------------------------------------------------- -! +! ! Subroutines for enabling coupling to external programs through a third party coupler ! such as OASIS/PRISM. ! If no external coupler then these will mostly be dummy routines. @@ -2413,7 +2413,7 @@ subroutine writeSliceFields(state, filename_prefix, slice, rc) character(len=*),parameter :: subname='(mom_cap:writeSliceFields)' if (present(rc)) rc = ESMF_SUCCESS - + if (ESMF_IO_PIO_PRESENT .and. & (ESMF_IO_NETCDF_PRESENT .or. ESMF_IO_PNETCDF_PRESENT)) then @@ -2508,7 +2508,7 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) integer :: npet, nx, ny, pet, elb(2), eub(2), clb(2), cub(2), tlb(2), tub(2) type(ESMF_VM) :: vm character(len=*),parameter :: subname='(mom_cap:MOM_RealizeFields)' - + rc = ESMF_SUCCESS do i = 1, nfields diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 2682404ad7..942570cb45 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -38,9 +38,9 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid type(ESMF_State) , intent(inout) :: exportState !< outgoing data - integer , intent(in) :: logunit + integer , intent(in) :: logunit type(ESMF_Clock) , intent(in) :: clock - integer , intent(inout) :: rc + integer , intent(inout) :: rc ! Local variables real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo @@ -48,7 +48,7 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) integer :: lbnd1, lbnd2, ubnd1, ubnd2 real :: slp_L, slp_R, slp_C, slope, u_min, u_max integer :: day, secs - type(ESMF_time) :: currTime + type(ESMF_time) :: currTime real(ESMF_KIND_R8), pointer :: dataPtr_omask(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_t(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_s(:,:) @@ -162,7 +162,7 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) dataPtr_s(i1,j1) = ocean_public%s_surf(i,j) * grid%mask2dT(ig,jg) dataPtr_u(i1,j1) = ocean_public%u_surf(i,j) * grid%mask2dT(ig,jg) dataPtr_v(i1,j1) = ocean_public%v_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_q(i1,j1) = 0. + dataPtr_q(i1,j1) = 0. dataPtr_bldepth(i1,j1) = 0. ! TODO: this needs to be generalized !dataPtr_u(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%u_surf(i,j) & ! - grid%sin_rot(ig,jg) * ocean_public%v_surf(i,j)) * grid%mask2dT(ig,jg) @@ -285,17 +285,17 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & type(ESMF_State) , intent(inout) :: importState !< incoming data type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing type(ESMF_Clock) , intent(in) :: clock - integer , intent(in) :: logunit + integer , intent(in) :: logunit character(len=*) , intent(in) :: runtype - integer , intent(inout) :: rc + integer , intent(inout) :: rc ! Local Variables integer :: i, j, i1, j1, ig, jg ! Grid indices integer :: isc, iec, jsc, jec ! Grid indices - integer :: isc_bnd, jsc_bnd, ise_bnd, jse_bnd + integer :: isc_bnd, jsc_bnd, ise_bnd, jse_bnd integer :: lbnd1, lbnd2, ubnd1, ubnd2 integer :: i0, j0, is, js, ie, je - real(ESMF_KIND_R8), pointer :: dataPtr_p(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_p(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_ifrac(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_duu10n(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_co2prog(:,:) @@ -325,7 +325,7 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & real(ESMF_KIND_R8), pointer :: dataPtr_rain(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_snow(:,:) integer :: day, secs - type(ESMF_time) :: currTime + type(ESMF_time) :: currTime logical :: do_import character(len=*), parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" character(len=*), parameter :: subname = '(mom_import)' @@ -504,22 +504,22 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & i1 = i + lbnd1 - isc ig = i + grid%jsc - isc - ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) - ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) - ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) - ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) - ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) - ice_ocean_boundary%t_flux(i,j) = -dataPtr_sen(i1,j1) - ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) - ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1) - ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(i1,j1) - ice_ocean_boundary%salt_flux(i,j) = dataPtr_iosalt(i1,j1) - ice_ocean_boundary%runoff(i,j) = dataPtr_rofl(i1,j1) + dataPtr_rofi(i1,j1) - !ice_ocean_boundary%salt_flux(i,j) = dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j) - !ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(i1,j1) + ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) + ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) + ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) + ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) + ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) + ice_ocean_boundary%t_flux(i,j) = -dataPtr_sen(i1,j1) + ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) + ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1) + ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(i1,j1) + ice_ocean_boundary%salt_flux(i,j) = dataPtr_iosalt(i1,j1) + ice_ocean_boundary%runoff(i,j) = dataPtr_rofl(i1,j1) + dataPtr_rofi(i1,j1) + !ice_ocean_boundary%salt_flux(i,j) = dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j) + !ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(i1,j1) !ice_ocean_boundary%u_flux(i,j) = GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1) !ice_ocean_boundary%v_flux(i,j) = GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1) enddo @@ -531,7 +531,7 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) call ESMF_TimeGet(CurrTime, d=day, s=secs, rc=rc) - i0 = GRID%isc - isc + i0 = GRID%isc - isc j0 = GRID%jsc - jsc do j = GRID%jsc, GRID%jec do i = GRID%isc, GRID%iec @@ -555,7 +555,7 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & end subroutine mom_import - !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- subroutine State_GetFldPtr(ST, fldname, fldptr, rc) type(ESMF_State) , intent(in) :: ST @@ -563,7 +563,7 @@ subroutine State_GetFldPtr(ST, fldname, fldptr, rc) real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:,:) integer, optional , intent(out) :: rc - ! local variables + ! local variables type(ESMF_Field) :: lfield integer :: lrc character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' @@ -572,12 +572,12 @@ subroutine State_GetFldPtr(ST, fldname, fldptr, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return ! bail out + return ! bail out call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return ! bail out + return ! bail out if (present(rc)) rc = lrc diff --git a/config_src/nuopc_driver/time_utils.F90 b/config_src/nuopc_driver/time_utils.F90 index 52889e3252..f704304e02 100644 --- a/config_src/nuopc_driver/time_utils.F90 +++ b/config_src/nuopc_driver/time_utils.F90 @@ -6,7 +6,7 @@ module time_utils_mod use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR use time_manager_mod, only: fms_get_calendar_type => get_calendar_type use ESMF - + implicit none private @@ -49,7 +49,7 @@ function fms2esmf_cal_c(calendar) case default call mpp_error(FATAL, & 'ocean_solo: ocean_solo_nml entry calendar must be one of GREGORIAN|JULIAN|NOLEAP|THIRTY_DAY|NO_CALENDAR.' ) - end select + end select end function fms2esmf_cal_c function fms2esmf_cal_i(calendar) @@ -150,7 +150,7 @@ function string_to_date(string, rc) type(time_type) :: string_to_date integer :: yr,mon,day,hr,min,sec - + if(present(rc)) rc = ESMF_SUCCESS read(string, '(I4.4,I2.2,I2.2,".",I2.2,I2.2,I2.2)') yr, mon, day, hr, min, sec From d32333e07e108b688fb24b717f2a556ae200140d Mon Sep 17 00:00:00 2001 From: mvertens Date: Thu, 12 Jul 2018 18:24:52 -0600 Subject: [PATCH 0597/1072] fixed trailing white space --- config_src/mct_driver/ocn_cap_methods.F90 | 40 +++++++++++------------ 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 712738bb4d..30d6faae3b 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -33,9 +33,9 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, ! Local variables integer :: i, j, ig, jg, isc, iec, jsc, jec ! Grid indices - integer :: k + integer :: k integer :: day, secs, rc - type(ESMF_time) :: currTime + type(ESMF_time) :: currTime character(*), parameter :: F01 = "('(ocn_import) ',a,4(i6,2x),d21.14)" !----------------------------------------------------------------------- @@ -49,19 +49,19 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, k = k + 1 ! Increment position within gindex ! taux - ice_ocean_boundary%u_flux(i,j) = x2o(ind%x2o_Foxx_taux,k) + ice_ocean_boundary%u_flux(i,j) = x2o(ind%x2o_Foxx_taux,k) ! tauy - ice_ocean_boundary%v_flux(i,j) = x2o(ind%x2o_Foxx_tauy,k) + ice_ocean_boundary%v_flux(i,j) = x2o(ind%x2o_Foxx_tauy,k) ! liquid precipitation (rain) - ice_ocean_boundary%lprec(i,j) = x2o(ind%x2o_Faxa_rain,k) + ice_ocean_boundary%lprec(i,j) = x2o(ind%x2o_Faxa_rain,k) ! frozen precipitation (snow) - ice_ocean_boundary%fprec(i,j) = x2o(ind%x2o_Faxa_snow,k) + ice_ocean_boundary%fprec(i,j) = x2o(ind%x2o_Faxa_snow,k) ! longwave radiation, sum up and down (W/m2) - ice_ocean_boundary%lw_flux(i,j) = (x2o(ind%x2o_Faxa_lwdn,k) + x2o(ind%x2o_Foxx_lwup,k)) + ice_ocean_boundary%lw_flux(i,j) = (x2o(ind%x2o_Faxa_lwdn,k) + x2o(ind%x2o_Foxx_lwup,k)) ! specific humitidy flux ice_ocean_boundary%q_flux(i,j) = x2o(ind%x2o_Foxx_evap,k) !???TODO: should this be a minus sign @@ -73,16 +73,16 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, ice_ocean_boundary%latent_flux(i,j) = x2o(ind%x2o_Foxx_lat,k) !???TODO: should this be a minus sign ! liquid runoff - ice_ocean_boundary%rofl_flux(i,j) = x2o(ind%x2o_Foxx_rofl,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%rofl_flux(i,j) = x2o(ind%x2o_Foxx_rofl,k) * GRID%mask2dT(ig,jg) ! ice runoff - ice_ocean_boundary%rofi_flux(i,j) = x2o(ind%x2o_Foxx_rofi,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%rofi_flux(i,j) = x2o(ind%x2o_Foxx_rofi,k) * GRID%mask2dT(ig,jg) ! surface pressure - ice_ocean_boundary%p(i,j) = x2o(ind%x2o_Sa_pslv,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%p(i,j) = x2o(ind%x2o_Sa_pslv,k) * GRID%mask2dT(ig,jg) ! salt flux - ice_ocean_boundary%salt_flux(i,j) = x2o(ind%x2o_Fioi_salt,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%salt_flux(i,j) = x2o(ind%x2o_Fioi_salt,k) * GRID%mask2dT(ig,jg) ! 1) visible, direct shortwave (W/m2) ! 2) visible, diffuse shortwave (W/m2) @@ -90,15 +90,15 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, ! 4) near-IR, diffuse shortwave (W/m2) if (present(c1) .and. present(c2) .and. present(c3) .and. present(c4)) then ! Use runtime coefficients to decompose net short-wave heat flux into 4 components - ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c1 * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c2 * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c3 * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c4 * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c1 * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c2 * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c3 * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c4 * GRID%mask2dT(ig,jg) else - ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Faxa_swvdr,k) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Faxa_swvdf,k) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Faxa_swndr,k) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Faxa_swndf,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Faxa_swvdr,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Faxa_swvdf,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Faxa_swndr,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Faxa_swndf,k) * GRID%mask2dT(ig,jg) end if end do end do @@ -116,7 +116,7 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, write(logunit,F01)'import: day, secs, j, i, q_flux = ',day,secs,j,i,ice_ocean_boundary%q_flux(i,j) write(logunit,F01)'import: day, secs, j, i, t_flux = ',day,secs,j,i,ice_ocean_boundary%t_flux(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, 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 = ',day,secs,j,i,ice_ocean_boundary%p(i,j) write(logunit,F01)'import: day, secs, j, i, salt_flux = ',day,secs,j,i,ice_ocean_boundary%salt_flux(i,j) write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dir = ',day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dir(i,j) From 8606be9df2ec9d36431fe1eb6e1d4e95824a5bcc Mon Sep 17 00:00:00 2001 From: mvertens Date: Thu, 12 Jul 2018 19:59:30 -0600 Subject: [PATCH 0598/1072] removed more trailing white space --- config_src/mct_driver/ocn_comp_mct.F90 | 8 ++++---- config_src/mct_driver/ocn_cpl_indices.F90 | 4 ++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index b3a48f5757..162cb0eed5 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -7,7 +7,7 @@ module ocn_comp_mct use ESMF, only: ESMF_clock, ESMF_time, ESMF_timeInterval use ESMF, only: ESMF_ClockGet, ESMF_TimeGet, ESMF_TimeIntervalGet use seq_cdata_mod, only: seq_cdata, seq_cdata_setptrs -use seq_flds_mod, only: seq_flds_x2o_fields, seq_flds_o2x_fields +use seq_flds_mod, only: seq_flds_x2o_fields, seq_flds_o2x_fields use mct_mod, only: mct_gsMap, mct_gsmap_init, mct_gsMap_lsize, & mct_gsmap_orderedpoints use mct_mod, only: mct_aVect, mct_aVect_init, mct_aVect_zero, & @@ -38,11 +38,11 @@ module ocn_comp_mct use MOM_time_manager, only: time_type, set_date, set_time, set_calendar_type, NOLEAP use MOM_time_manager, only: operator(+), operator(-), operator(*), operator(/) use MOM_time_manager, only: operator(==), operator(/=), operator(>), get_time -use MOM_file_parser, only: get_param, log_version, param_file_type +use MOM_file_parser, only: get_param, log_version, param_file_type use MOM_get_input, only: Get_MOM_Input, directories use MOM_EOS, only: gsw_sp_from_sr, gsw_pt_from_ct use MOM_constants, only: CELSIUS_KELVIN_OFFSET -use MOM_domains, only: AGRID, BGRID_NE, CGRID_NE, pass_vector +use MOM_domains, only: AGRID, BGRID_NE, CGRID_NE, pass_vector use mpp_domains_mod, only: mpp_get_compute_domain ! Previously inlined - now in separate modules @@ -279,7 +279,7 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) ! Initialize the MOM6 model runtype = get_runtype() - if (runtype == "initial") then + if (runtype == "initial") then ! startup (new run) - 'n' is needed below since we don't specify input_filename in input.nml call ocean_model_init(glb%ocn_public, glb%ocn_state, time0, time0, input_restart_file = 'n') else ! hybrid or branch or continuos runs diff --git a/config_src/mct_driver/ocn_cpl_indices.F90 b/config_src/mct_driver/ocn_cpl_indices.F90 index 1c3d733812..85b9a6de40 100644 --- a/config_src/mct_driver/ocn_cpl_indices.F90 +++ b/config_src/mct_driver/ocn_cpl_indices.F90 @@ -2,8 +2,8 @@ module ocn_cpl_indices use mct_mod, only: mct_avect_init, mct_avect_indexra, mct_aVect_clean, mct_aVect use seq_flds_mod, only: ice_ncat, seq_flds_i2o_per_cat - use seq_flds_mod, only: seq_flds_x2o_fields, seq_flds_o2x_fields - + use seq_flds_mod, only: seq_flds_x2o_fields, seq_flds_o2x_fields + implicit none ; public !> Structure with indices needed for MCT attribute vectors From c2655b3ab5d8ad0d7399352f9c748acbc6b57f4c Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Fri, 13 Jul 2018 14:51:01 -0600 Subject: [PATCH 0599/1072] fix call to shelf_calc_flux --- config_src/mct_driver/MOM_ocean_model.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index b8ee6734d6..0f8be2d9bb 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -56,7 +56,7 @@ module MOM_ocean_model 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 : ice_shelf_end, ice_shelf_save_restart +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 @@ -472,7 +472,8 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! Add ice shelf fluxes if (OS%use_ice_shelf) then - call shelf_calc_flux(OS%sfc_state, OS%forces, OS%fluxes, OS%Time, time_step, OS%Ice_shelf_CSp) + 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) endif ! GMM, check ocean_model_MOM.F90 to enable the following option @@ -495,7 +496,8 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%sfc_state, OS%restore_salinity, OS%restore_temp) if (OS%use_ice_shelf) then - call shelf_calc_flux(OS%sfc_state, OS%forces, OS%flux_tmp, OS%Time, time_step, OS%Ice_shelf_CSp) + 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) endif ! GMM, check ocean_model_MOM.F90 to enable the following option From 50b850d6198e7c37d0c45fb1380b1a123fcb7f40 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 13 Jul 2018 17:20:28 -0400 Subject: [PATCH 0600/1072] Corrected two openMP directives Corrected openMP directives in two places, so MOM6 now compiles with openMP enabled. The variable local_strain had recently been added to horizontal_viscosity, but it was omitted from an openMP directive. A recent change had left an incomplete openMP directive around KPP_get_BLD in diabatic. All solutions (at least without openMP on) are bitwise identical. --- .../lateral/MOM_hor_visc.F90 | 22 +++++++++---------- .../vertical/MOM_diabatic_driver.F90 | 3 ++- 2 files changed, 13 insertions(+), 12 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 2a166bac09..3be015faa4 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -316,17 +316,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, ! Toggle whether to use a Laplacian viscosity derived from MEKE use_MEKE_Ku = associated(MEKE%Ku) -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,CS,G,GV,u,v,is,js,ie,je,h, & -!$OMP rescale_Kh,VarMix,h_neglect,h_neglect3, & -!$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,apply_OBC,OBC,diffv, & -!$OMP find_FrictWork,FrictWork,use_MEKE_Ku,MEKE, & -!$OMP mod_Leith, legacy_bound) & -!$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & -!$OMP sh_xy, str_xy, Ah, Kh, AhSm, KhSm, dvdx, dudy, & -!$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv, h_u, h_v, & -!$OMP vort_xy,vort_xy_dx,vort_xy_dy,Vort_mag,AhLth,KhLth, & -!$OMP div_xx, div_xx_dx, div_xx_dy, & -!$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min) + !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,CS,G,GV,u,v,is,js,ie,je,h, & + !$OMP rescale_Kh,VarMix,h_neglect,h_neglect3, & + !$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,apply_OBC,OBC,diffv, & + !$OMP find_FrictWork,FrictWork,use_MEKE_Ku,MEKE, & + !$OMP mod_Leith, legacy_bound) & + !$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & + !$OMP sh_xy, str_xy, Ah, Kh, AhSm, KhSm, dvdx, dudy, & + !$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv, h_u, h_v, & + !$OMP vort_xy,vort_xy_dx,vort_xy_dy,Vort_mag,AhLth,KhLth, & + !$OMP div_xx, div_xx_dx, div_xx_dy, local_strain, & + !$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min) do k=1,nz ! The following are the forms of the horizontal tension and horizontal diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 8a16e79ecd..188ba9c8f3 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -610,10 +610,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call KPP_calculate(CS%KPP_CSp, G, GV, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) -!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,G,Kd_heat,Hml) if (associated(Hml)) then + !$OMP parallel default(shared) call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G) + !$OMP end parallel call pass_var(Hml, G%domain, halo=1) endif From ad3961c2dfed77b5525dbf5ce67ba0b1b15bda2c Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Sun, 15 Jul 2018 12:07:37 -0800 Subject: [PATCH 0601/1072] Time-filter on oblique OBCs. - also set default OBC vorticity, strain to freeslip. --- src/core/MOM_open_boundary.F90 | 101 +++++++++++++++++++++++++-------- 1 file changed, 78 insertions(+), 23 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 38a945233b..3c9343d1c4 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -156,6 +156,8 @@ module MOM_open_boundary !! for normal velocity real, pointer, dimension(:,:,:) :: ry_normal=>NULL() !< The tangential value for radiation coeff !! for normal velocity + real, pointer, dimension(:,:,:) :: cff_normal=>NULL() !< The denominator for oblique radiation + !! for normal velocity real, pointer, dimension(:,:,:) :: nudged_normal_vel=>NULL() !< The layer velocity normal to the OB segment !! that values should be nudged towards (m s-1). real, pointer, dimension(:,:,:) :: nudged_tangential_vel=>NULL() !< The layer velocity tangential to the OB segment @@ -237,6 +239,7 @@ module MOM_open_boundary type(OBC_registry_type), pointer :: OBC_Reg => NULL() !< Registry type for boundaries real, pointer, dimension(:,:,:) :: rx_normal => NULL() !< Array storage for restarts real, pointer, dimension(:,:,:) :: ry_normal => NULL() !< Array storage for restarts + real, pointer, dimension(:,:,:) :: cff_normal => NULL() !< Array storage for restarts real :: silly_h !< A silly value of thickness outside of the domain that !! can be used to test the independence of the OBCs to !! this external data, in m. @@ -315,7 +318,7 @@ subroutine open_boundary_config(G, param_file, OBC) call get_param(param_file, mdl, "OBC_FREESLIP_VORTICITY", OBC%freeslip_vorticity, & "If true, sets the normal gradient of tangential velocity to\n"// & "zero in the relative vorticity on open boundaries. This cannot\n"// & - "be true if another OBC_XXX_VORTICITY option is True.", default=.false.) + "be true if another OBC_XXX_VORTICITY option is True.", default=.true.) call get_param(param_file, mdl, "OBC_COMPUTED_VORTICITY", OBC%computed_vorticity, & "If true, uses the external values of tangential velocity\n"// & "in the relative vorticity on open boundaries. This cannot\n"// & @@ -339,7 +342,7 @@ subroutine open_boundary_config(G, param_file, OBC) call get_param(param_file, mdl, "OBC_FREESLIP_STRAIN", OBC%freeslip_strain, & "If true, sets the normal gradient of tangential velocity to\n"// & "zero in the strain use in the stress tensor on open boundaries. This cannot\n"// & - "be true if another OBC_XXX_STRAIN option is True.", default=.false.) + "be true if another OBC_XXX_STRAIN option is True.", default=.true.) call get_param(param_file, mdl, "OBC_COMPUTED_STRAIN", OBC%computed_strain, & "If true, sets the normal gradient of tangential velocity to\n"// & "zero in the strain use in the stress tensor on open boundaries. This cannot\n"// & @@ -431,7 +434,7 @@ subroutine open_boundary_config(G, param_file, OBC) ! if (open_boundary_query(OBC, needs_ext_seg_data=.true.)) & call initialize_segment_data(G, OBC, param_file) - if (open_boundary_query(OBC, apply_Flather_OBC=.true.)) then + if (open_boundary_query(OBC, apply_open_OBC=.true.)) then call get_param(param_file, mdl, "OBC_RADIATION_MAX", OBC%rx_max, & "The maximum magnitude of the baroclinic radiation \n"//& "velocity (or speed of characteristics). This is only \n"//& @@ -1499,6 +1502,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) real :: rx_max, ry_max ! coefficients for radiation real :: rx_new, rx_avg ! coefficients for radiation real :: ry_new, ry_avg ! coefficients for radiation + real :: cff_new, cff_avg ! denominator in oblique real, pointer, dimension(:,:,:) :: rx_tangential=>NULL() real, pointer, dimension(:,:,:) :: ry_tangential=>NULL() real, parameter :: eps = 1.0e-20 @@ -1540,6 +1544,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do j=segment%HI%jsd,segment%HI%jed segment%rx_normal(I,j,k) = OBC%rx_normal(I,j,k) segment%ry_normal(I,j,k) = OBC%ry_normal(I,j,k) + segment%cff_normal(I,j,k) = OBC%cff_normal(I,j,k) enddo enddo elseif (segment%is_N_or_S .and. segment%oblique) then @@ -1548,6 +1553,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do i=segment%HI%isd,segment%HI%ied segment%rx_normal(i,J,k) = OBC%rx_normal(i,J,k) segment%ry_normal(i,J,k) = OBC%ry_normal(i,J,k) + segment%cff_normal(i,J,k) = OBC%cff_normal(i,J,k) enddo enddo endif @@ -1588,11 +1594,21 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) dhdy = segment%grad_normal(J,1,k) endif if (dhdt*dhdx < 0.0) dhdt = 0.0 - Cx = dhdt*dhdx - cff = max(dhdx*dhdx + dhdy*dhdy, eps) - Cy = min(cff,max(dhdt*dhdy,-cff)) - segment%normal_vel(I,j,k) = ((cff*u_new(I,j,k) + Cx*u_new(I-1,j,k)) - & - (max(Cy,0.0)*segment%grad_normal(J-1,2,k) + min(Cy,0.0)*segment%grad_normal(J,2,k))) / (cff + Cx) + rx_new = dhdt*dhdx + cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + ry_new = min(cff,max(dhdt*dhdy,-cff)) + rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new + ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new + cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new + segment%rx_normal(I,j,k) = rx_avg + segment%ry_normal(i,J,k) = ry_avg + segment%cff_normal(i,J,k) = cff_avg + segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) - & + (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & + (cff_avg + rx_avg) + OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) + OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) + OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) elseif (segment%gradient) then segment%normal_vel(I,j,k) = u_new(I-1,j,k) endif @@ -1698,11 +1714,21 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) dhdy = segment%grad_normal(J,1,k) endif if (dhdt*dhdx < 0.0) dhdt = 0.0 - Cx = dhdt*dhdx - cff = max(dhdx*dhdx + dhdy*dhdy, eps) - Cy = min(cff,max(dhdt*dhdy,-cff)) - segment%normal_vel(I,j,k) = ((cff*u_new(I,j,k) + Cx*u_new(I+1,j,k)) - & - (max(Cy,0.0)*segment%grad_normal(J-1,2,k) + min(Cy,0.0)*segment%grad_normal(J,2,k))) / (cff + Cx) + rx_new = dhdt*dhdx + cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + ry_new = min(cff,max(dhdt*dhdy,-cff)) + rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new + ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new + cff_avg = (1.0-gamma_u)*segment%cff_normal(I,j,k) + gamma_u*cff_new + segment%rx_normal(I,j,k) = rx_avg + segment%ry_normal(i,J,k) = ry_avg + segment%cff_normal(i,J,k) = cff_avg + segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) - & + (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & + (cff_avg + rx_avg) + OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) + OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) + OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) elseif (segment%gradient) then segment%normal_vel(I,j,k) = u_new(I+1,j,k) endif @@ -1809,11 +1835,21 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) dhdx = segment%grad_normal(I,1,k) endif if (dhdt*dhdy < 0.0) dhdt = 0.0 - Cy = dhdt*dhdy - cff = max(dhdx*dhdx + dhdy*dhdy, eps) - Cx = min(cff,max(dhdt*dhdx,-cff)) - segment%normal_vel(i,J,k) = ((cff*v_new(i,J,k) + Cy*v_new(i,J-1,k)) - & - (max(Cx,0.0)*segment%grad_normal(I-1,2,k) + min(Cx,0.0)*segment%grad_normal(I,2,k))) / (cff + Cy) + ry_new = dhdt*dhdy + cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + rx_new = min(cff,max(dhdt*dhdx,-cff)) + rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new + ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new + cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new + segment%rx_normal(I,j,k) = rx_avg + segment%ry_normal(i,J,k) = ry_avg + segment%cff_normal(i,J,k) = cff_avg + segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - & + (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & + (cff_avg + ry_avg) + OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) + OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) + OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) elseif (segment%gradient) then segment%normal_vel(i,J,k) = v_new(i,J-1,k) endif @@ -1920,11 +1956,21 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) dhdx = segment%grad_normal(I,1,k) endif if (dhdt*dhdy < 0.0) dhdt = 0.0 - Cy = dhdt*dhdy - cff = max(dhdx*dhdx + dhdy*dhdy, eps) - Cx = min(cff,max(dhdt*dhdx,-cff)) - segment%normal_vel(i,J,k) = ((cff*v_new(i,J,k) + Cy*v_new(i,J+1,k)) - & - (max(Cx,0.0)*segment%grad_normal(I-1,2,k) + min(Cx,0.0)*segment%grad_normal(I,2,k))) / (cff + Cy) + ry_new = dhdt*dhdy + cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) + rx_new = min(cff,max(dhdt*dhdx,-cff)) + rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new + ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new + cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new + segment%rx_normal(I,j,k) = rx_avg + segment%ry_normal(i,J,k) = ry_avg + segment%cff_normal(i,J,k) = cff_avg + segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) - & + (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & + (cff_avg + ry_avg) + OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) + OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) + OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) elseif (segment%gradient) then segment%normal_vel(i,J,k) = v_new(i,J+1,k) endif @@ -2286,6 +2332,7 @@ subroutine allocate_OBC_segment_data(OBC, segment) allocate(segment%grad_normal(JsdB:JedB,2,OBC%ke)); segment%grad_normal(:,:,:) = 0.0 allocate(segment%rx_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%rx_normal(:,:,:)=0.0 allocate(segment%ry_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%ry_normal(:,:,:)=0.0 + allocate(segment%cff_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%cff_normal(:,:,:)=0.0 endif endif @@ -2321,6 +2368,7 @@ subroutine allocate_OBC_segment_data(OBC, segment) allocate(segment%grad_normal(IsdB:IedB,2,OBC%ke)); segment%grad_normal(:,:,:) = 0.0 allocate(segment%rx_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%rx_normal(:,:,:)=0.0 allocate(segment%ry_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%ry_normal(:,:,:)=0.0 + allocate(segment%cff_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%cff_normal(:,:,:)=0.0 endif endif @@ -2341,6 +2389,7 @@ subroutine deallocate_OBC_segment_data(OBC, segment) if (associated (segment%eta)) deallocate(segment%eta) if (associated (segment%rx_normal)) deallocate(segment%rx_normal) if (associated (segment%ry_normal)) deallocate(segment%ry_normal) + if (associated (segment%cff_normal)) deallocate(segment%cff_normal) if (associated (segment%normal_vel)) deallocate(segment%normal_vel) if (associated (segment%normal_vel_bt)) deallocate(segment%normal_vel_bt) if (associated (segment%normal_trans)) deallocate(segment%normal_trans) @@ -3473,6 +3522,12 @@ subroutine open_boundary_register_restarts(HI, GV, OBC_CS,restart_CSp) vd = var_desc("ry_normal","m s-1", "Normal Phase Speed for NS OBCs",'v','L') call register_restart_field(OBC_CS%ry_normal, vd, .true., restart_CSp) endif + if (OBC_CS%oblique_BCs_exist_globally) then + allocate(OBC_CS%cff_normal(HI%IsdB:HI%IedB,HI%jsdB:HI%jedB,GV%ke)) + OBC_CS%cff_normal(:,:,:) = 0.0 + vd = var_desc("cff_normal","m s-1", "denominator for oblique OBCs",'q','L') + call register_restart_field(OBC_CS%cff_normal, vd, .true., restart_CSp) + endif end subroutine open_boundary_register_restarts From a2c6a7a2f2a626611543b8e863d1ce4108fad200 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 17 Jul 2018 11:26:57 -0600 Subject: [PATCH 0602/1072] improve tab width consistency --- config_src/mct_driver/MOM_ocean_model.F90 | 98 +- config_src/mct_driver/MOM_surface_forcing.F90 | 931 +++++++++--------- config_src/mct_driver/ocn_cap_methods.F90 | 278 +++--- config_src/mct_driver/ocn_comp_mct.F90 | 52 +- config_src/mct_driver/ocn_cpl_indices.F90 | 150 +-- config_src/nuopc_driver/MOM_ocean_model.F90 | 136 +-- config_src/nuopc_driver/mom_cap.F90 | 576 +++++------ config_src/nuopc_driver/mom_cap_methods.F90 | 528 +++++----- config_src/nuopc_driver/time_utils.F90 | 14 +- 9 files changed, 1381 insertions(+), 1382 deletions(-) diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 0f8be2d9bb..78b90ff7bf 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -205,7 +205,7 @@ module MOM_ocean_model diag => NULL() !< A pointer to the diagnostic regulatory structure end type ocean_state_type - integer :: id_clock_forcing +integer :: id_clock_forcing !======================================================================= contains @@ -286,14 +286,14 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i "returned to the coupler. Valid values include \n"//& "'A', 'B', or 'C'.", default="C") if (uppercase(stagger(1:1)) == 'A') then - Ocean_sfc%stagger = AGRID + Ocean_sfc%stagger = AGRID elseif (uppercase(stagger(1:1)) == 'B') then - Ocean_sfc%stagger = BGRID_NE + Ocean_sfc%stagger = BGRID_NE elseif (uppercase(stagger(1:1)) == 'C') then - Ocean_sfc%stagger = CGRID_NE + Ocean_sfc%stagger = CGRID_NE else - call MOM_error(FATAL,"ocean_model_init: OCEAN_SURFACE_STAGGER = "// & - trim(stagger)//" is invalid.") + call MOM_error(FATAL,"ocean_model_init: OCEAN_SURFACE_STAGGER = "// & + trim(stagger)//" is invalid.") end if call get_param(param_file, mdl, "RESTORE_SALINITY",OS%restore_salinity, & @@ -663,9 +663,9 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) "restart files can only be created after the buoyancy forcing is applied.") if (present(directory)) then - restart_dir = directory + restart_dir = directory else - restart_dir = OS%dirs%restart_output_dir + restart_dir = OS%dirs%restart_output_dir endif call save_restart(restart_dir, Time, OS%grid, OS%restart_CSp, GV=OS%GV) @@ -700,9 +700,9 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, call mpp_get_layout(input_domain,layout) call mpp_get_global_domain(input_domain, xsize=xsz, ysize=ysz) if(PRESENT(maskmap)) then - call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain, maskmap=maskmap) + call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain, maskmap=maskmap) else - call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain) + call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain) endif call mpp_get_compute_domain(Ocean_sfc%Domain, isc, iec, jsc, jec) @@ -942,45 +942,45 @@ subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc) select case(name) case('area') - array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) case('mask') - array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) !OR same result ! do j=g_jsc,g_jec ; do i=g_isc,g_iec ! array2D(isc+i-g_isc,jsc+j-g_jsc) = OS%grid%mask2dT(i,j) ! enddo ; enddo case('t_surf') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('t_pme') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('t_runoff') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('t_calving') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('btfHeat') - array2D(isc:,jsc:) = 0 + array2D(isc:,jsc:) = 0 case('tlat') - array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) case('tlon') - array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) case('ulat') - array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) case('ulon') - array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) case('vlat') - array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) case('vlon') - array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) case('geoLatBu') - array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) case('geoLonBu') - array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) case('cos_rot') - array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 + array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 case('sin_rot') - array2D(isc:,jsc:) = OS%grid%sin_rot(g_isc:g_iec,g_jsc:g_jec) ! =0 + 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,'ocean_model_data2D_get: unknown argument name='//name) end select end subroutine ocean_model_data2D_get @@ -995,30 +995,30 @@ subroutine ocean_model_data1D_get(OS,Ocean, name, value) 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,'ocean_model_data1D_get: unknown argument name='//name) end select end subroutine ocean_model_data1D_get 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 + integer , intent(in) :: timestep + type(ocean_public_type), intent(in) :: ocn + integer :: n,m, outunit - outunit = stdout() + outunit = stdout() - write(outunit,*) "BEGIN CHECKSUM(ocean_type):: ", id, timestep - write(outunit,100) 'ocean%t_surf ',mpp_chksum(ocn%t_surf ) - write(outunit,100) 'ocean%s_surf ',mpp_chksum(ocn%s_surf ) - write(outunit,100) 'ocean%u_surf ',mpp_chksum(ocn%u_surf ) - 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,*) "BEGIN CHECKSUM(ocean_type):: ", id, timestep + write(outunit,100) 'ocean%t_surf ',mpp_chksum(ocn%t_surf ) + write(outunit,100) 'ocean%s_surf ',mpp_chksum(ocn%s_surf ) + write(outunit,100) 'ocean%u_surf ',mpp_chksum(ocn%u_surf ) + 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 ) - call coupler_type_write_chksums(ocn%fields, outunit, 'ocean%') + call coupler_type_write_chksums(ocn%fields, outunit, 'ocean%') 100 FORMAT(" CHECKSUM::",A20," = ",Z20) end subroutine ocean_public_type_chksum @@ -1029,14 +1029,14 @@ end subroutine ocean_public_type_chksum ! Obtain the ocean grid. ! ! - subroutine get_ocean_grid(OS, Gridp) - type(ocean_state_type) :: OS - type(ocean_grid_type) , pointer :: Gridp +subroutine get_ocean_grid(OS, Gridp) + type(ocean_state_type) :: OS + type(ocean_grid_type) , pointer :: Gridp - Gridp => OS%grid - return + Gridp => OS%grid + return - end subroutine get_ocean_grid +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 b155f360a7..07bf80d54a 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -196,321 +196,320 @@ module MOM_surface_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. - subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & - sfc_state, restore_salt, restore_temp) - - type(ice_ocean_boundary_type), & - target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive - !! the ocean in a coupled model +!> 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. +subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & + sfc_state, restore_salt, restore_temp) + + type(ice_ocean_boundary_type), & + 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. + !! Unused fields have NULL ptrs. + + 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 + type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a + !! previous call to surface_forcing_init. + type(surface), intent(in) :: sfc_state !< A structure containing fields that describe the + !! surface state of the ocean. + 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 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 + 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 + + real :: C_p ! heat capacity of seawater ( J/(K kg) ) + + call cpu_clock_begin(id_clock_forcing) + + 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 + + C_p = fluxes%C_p + open_ocn_mask(:,:) = 1.0 + pme_adj(:,:) = 0.0 + fluxes%vPrecGlobalAdj = 0.0 + fluxes%vPrecGlobalScl = 0.0 + fluxes%saltFluxGlobalAdj = 0.0 + fluxes%saltFluxGlobalScl = 0.0 + fluxes%netFWGlobalAdj = 0.0 + fluxes%netFWGlobalScl = 0.0 + + restore_salinity = .false. + if (present(restore_salt)) restore_salinity = restore_salt + restore_sst = .false. + if (present(restore_temp)) restore_sst = restore_temp + + ! allocation and initialization if this is the first time that this + ! flux type has been used. + if (fluxes%dt_buoy_accum < 0) then + call allocate_forcing_type(G, fluxes, water=.true., heat=.true., & + ustar=.true., press=.true.) + + call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%sw_nir_dir,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%sw_nir_dif,isd,ied,jsd,jed) - type(forcing), intent(inout) :: fluxes !< A structure containing pointers to - !! all possible mass, heat or salt flux forcing fields. - !! Unused fields have NULL ptrs. - - 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 - type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a - !! previous call to surface_forcing_init. - type(surface), intent(in) :: sfc_state !< A structure containing fields that describe the - !! surface state of the ocean. - 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 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 - 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 - - real :: C_p ! heat capacity of seawater ( J/(K kg) ) - - call cpu_clock_begin(id_clock_forcing) - - 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 - - C_p = fluxes%C_p - open_ocn_mask(:,:) = 1.0 - pme_adj(:,:) = 0.0 - fluxes%vPrecGlobalAdj = 0.0 - fluxes%vPrecGlobalScl = 0.0 - fluxes%saltFluxGlobalAdj = 0.0 - fluxes%saltFluxGlobalScl = 0.0 - fluxes%netFWGlobalAdj = 0.0 - fluxes%netFWGlobalScl = 0.0 - - restore_salinity = .false. - if (present(restore_salt)) restore_salinity = restore_salt - restore_sst = .false. - if (present(restore_temp)) restore_sst = restore_temp - - ! allocation and initialization if this is the first time that this - ! flux type has been used. - if (fluxes%dt_buoy_accum < 0) then - call allocate_forcing_type(G, fluxes, water=.true., heat=.true., & - ustar=.true., press=.true.) - - call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%sw_nir_dir,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%sw_nir_dif,isd,ied,jsd,jed) - - call safe_alloc_ptr(fluxes%p_surf,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%p_surf_full,isd,ied,jsd,jed) - - call safe_alloc_ptr(fluxes%salt_flux,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%salt_flux_in,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) - - call safe_alloc_ptr(fluxes%TKE_tidal,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%ustar_tidal,isd,ied,jsd,jed) - - if (CS%allow_flux_adjustments) then - call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) - endif - - do j=js-2,je+2 ; do i=is-2,ie+2 - fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) - fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) - enddo; enddo - - if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) - - fluxes%dt_buoy_accum = 0.0 - endif ! endif for allocation and initialization + call safe_alloc_ptr(fluxes%p_surf,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%p_surf_full,isd,ied,jsd,jed) + + call safe_alloc_ptr(fluxes%salt_flux,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%salt_flux_in,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) + + call safe_alloc_ptr(fluxes%TKE_tidal,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%ustar_tidal,isd,ied,jsd,jed) if (CS%allow_flux_adjustments) then - fluxes%heat_added(:,:)=0.0 - fluxes%salt_flux_added(:,:)=0.0 + call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) + call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) endif - 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) - enddo; enddo - CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) - endif ! endif for allocation and initialization + do j=js-2,je+2 ; do i=is-2,ie+2 + fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) + fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) + enddo; enddo + + if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) + + fluxes%dt_buoy_accum = 0.0 + endif ! endif for allocation and initialization + + if (CS%allow_flux_adjustments) then + fluxes%heat_added(:,:)=0.0 + fluxes%salt_flux_added(:,:)=0.0 + endif + if (CS%area_surf < 0.0) then do j=js,je ; do i=is,ie - fluxes%salt_flux(i,j) = 0.0 - fluxes%vprec(i,j) = 0.0 + work_sum(i,j) = G%areaT(i,j) * G%mask2dT(i,j) enddo; enddo + CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) + endif ! endif for allocation and initialization - ! Salinity restoring logic - if (restore_salinity) then - call time_interp_external(CS%id_srestore,Time,data_restore) - ! open_ocn_mask indicates where to restore salinity (1 means restore, 0 does not) - open_ocn_mask(:,:) = 1.0 - if (CS%mask_srestore_under_ice) then ! Do not restore under sea-ice - do j=js,je ; do i=is,ie - if (sfc_state%SST(i,j) .le. -0.0539*sfc_state%SSS(i,j)) open_ocn_mask(i,j)=0.0 - enddo; enddo - endif - if (CS%salt_restore_as_sflux) then - do j=js,je ; do i=is,ie - 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 - enddo; enddo - if (CS%adjust_net_srestore_to_zero) then - if (CS%adjust_net_srestore_by_scaling) then - call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) - fluxes%saltFluxGlobalAdj = 0. - else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf - fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj - endif - endif - fluxes%salt_flux_added(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) ! Diagnostic - else + do j=js,je ; do i=is,ie + fluxes%salt_flux(i,j) = 0.0 + fluxes%vprec(i,j) = 0.0 + enddo; enddo + + ! Salinity restoring logic + if (restore_salinity) then + call time_interp_external(CS%id_srestore,Time,data_restore) + ! open_ocn_mask indicates where to restore salinity (1 means restore, 0 does not) + open_ocn_mask(:,:) = 1.0 + if (CS%mask_srestore_under_ice) then ! Do not restore under sea-ice + do j=js,je ; do i=is,ie + if (sfc_state%SST(i,j) <= -0.0539*sfc_state%SSS(i,j)) open_ocn_mask(i,j)=0.0 + enddo; enddo + endif + if (CS%salt_restore_as_sflux) then + do j=js,je ; do i=is,ie + 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 + enddo; enddo + if (CS%adjust_net_srestore_to_zero) then + if (CS%adjust_net_srestore_by_scaling) then + call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) + fluxes%saltFluxGlobalAdj = 0. + else + work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) + fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf + fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj + endif + endif + fluxes%salt_flux_added(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) ! Diagnostic + else + do j=js,je ; do i=is,ie + 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))* & + (CS%Rho0*CS%Flux_const) * & + delta_sss / (0.5*(sfc_state%SSS(i,j) + data_restore(i,j))) + endif + enddo; enddo + if (CS%adjust_net_srestore_to_zero) then + if (CS%adjust_net_srestore_by_scaling) then + call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) + fluxes%vPrecGlobalAdj = 0. + else + work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) + fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf do j=js,je ; do i=is,ie - 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))* & - (CS%Rho0*CS%Flux_const) * & - delta_sss / (0.5*(sfc_state%SSS(i,j) + data_restore(i,j))) - endif + fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) enddo; enddo - if (CS%adjust_net_srestore_to_zero) then - if (CS%adjust_net_srestore_by_scaling) then - call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) - fluxes%vPrecGlobalAdj = 0. - else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) - fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf - do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) - enddo; enddo - endif - endif - endif + endif + endif endif + endif - ! SST restoring logic - if (restore_sst) then - call time_interp_external(CS%id_trestore,Time,data_restore) - 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 - enddo; enddo - endif + ! SST restoring logic + if (restore_sst) then + call time_interp_external(CS%id_trestore,Time,data_restore) + 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 + enddo; enddo + endif - !i0 = is - isc_bnd ; j0 = js - jsc_bnd ??? - i0 = 0; j0 = 0 ! TODO: is this right? + !i0 = is - isc_bnd ; j0 = js - jsc_bnd ??? + i0 = 0; j0 = 0 ! TODO: is this right? + 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) + + ! frozen precipitation (snow) + if (associated(fluxes%fprec)) & + fluxes%fprec(i,j) = G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0) + + ! evaporation + if (associated(fluxes%evap)) & + fluxes%evap(i,j) = G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0) + + ! river runoff flux + if (associated(fluxes%lrunoff)) & + fluxes%lrunoff(i,j) = G%mask2dT(i,j) * IOB%rofl_flux(i-i0,j-j0) + + ! 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) = 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) + + ! 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) + + ! sensible heat flux (W/m2) + if (associated(fluxes%sens)) & + fluxes%sens(i,j) = G%mask2dT(i,j) * IOB%t_flux(i-i0,j-j0) + + ! latent heat flux (W/m^2) + if (associated(fluxes%latent)) & + fluxes%latent(i,j) = G%mask2dT(i,j) * IOB%latent_flux(i-i0,j-j0) + + 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)*(IOB%salt_flux(i-i0,j-j0) + fluxes%salt_flux(i,j)) + + if (associated(fluxes%salt_flux_in)) & + fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*IOB%salt_flux(i-i0,j-j0) + + enddo; enddo + + ! adjust the NET fresh-water flux to zero, if flagged + if (CS%adjust_net_fresh_water_to_zero) then 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) - - ! frozen precipitation (snow) - if (associated(fluxes%fprec)) & - fluxes%fprec(i,j) = G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0) - - ! evaporation - if (associated(fluxes%evap)) & - fluxes%evap(i,j) = G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0) - - ! river runoff flux - if (associated(fluxes%lrunoff)) & - fluxes%lrunoff(i,j) = G%mask2dT(i,j) * IOB%rofl_flux(i-i0,j-j0) - - ! 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) = 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) - - ! 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) - - ! sensible heat flux (W/m2) - if (associated(fluxes%sens)) & - fluxes%sens(i,j) = G%mask2dT(i,j) * IOB%t_flux(i-i0,j-j0) - - ! latent heat flux (W/m^2) - if (associated(fluxes%latent)) & - fluxes%latent(i,j) = G%mask2dT(i,j) * IOB%latent_flux(i-i0,j-j0) - - 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)*(IOB%salt_flux(i-i0,j-j0) + fluxes%salt_flux(i,j)) - - if (associated(fluxes%salt_flux_in)) & - fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*IOB%salt_flux(i-i0,j-j0) - + net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(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 + 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 - ! adjust the NET fresh-water flux to zero, if flagged - if (CS%adjust_net_fresh_water_to_zero) then - do j=js,je ; do i=is,ie - net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(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 - 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 - - if (CS%adjust_net_fresh_water_by_scaling) then - call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) - do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) - enddo; enddo - else - fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf - do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%netFWGlobalAdj ) * G%mask2dT(i,j) - enddo; enddo - endif + if (CS%adjust_net_fresh_water_by_scaling) then + call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) + do j=js,je ; do i=is,ie + fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) + enddo; enddo + else + fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf + do j=js,je ; do i=is,ie + fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%netFWGlobalAdj ) * G%mask2dT(i,j) + enddo; enddo endif + endif - if (CS%allow_flux_adjustments) then - ! Apply adjustments to fluxes - call apply_flux_adjustments(G, CS, Time, fluxes) - endif + if (CS%allow_flux_adjustments) then + ! Apply adjustments to fluxes + call apply_flux_adjustments(G, CS, Time, fluxes) + endif - ! Allow for user-written code to alter fluxes after all the above - call user_alter_forcing(sfc_state, fluxes, Time, G, CS%urf_CS) + ! Allow for user-written code to alter fluxes after all the above + call user_alter_forcing(sfc_state, fluxes, Time, G, CS%urf_CS) - call cpu_clock_end(id_clock_forcing) + call cpu_clock_end(id_clock_forcing) - end subroutine convert_IOB_to_fluxes +end subroutine convert_IOB_to_fluxes !======================================================================= @@ -588,21 +587,21 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) !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 (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 - forces%p_surf(i,j) = MIN(forces%p_surf_full(i,j),CS%max_p_surf) - else - forces%p_surf(i,j) = forces%p_surf_full(i,j) - endif + if (CS%max_p_surf >= 0.0) then + forces%p_surf(i,j) = MIN(forces%p_surf_full(i,j),CS%max_p_surf) + else + forces%p_surf(i,j) = forces%p_surf_full(i,j) + endif - if (CS%use_limited_P_SSH) then - forces%p_surf_SSH => forces%p_surf - else - forces%p_surf_SSH => forces%p_surf_full - endif - end if + if (CS%use_limited_P_SSH) then + forces%p_surf_SSH => forces%p_surf + else + forces%p_surf_SSH => forces%p_surf_full + endif + end if end do; end do ! GMM, CIME uses AGRID. All the BGRID_NE code can be cleaned later @@ -634,92 +633,92 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) ! surface momentum stress related fields as function of staggering 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) - - do j=js,je ; do I=Isq,Ieq - forces%taux(I,j) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & - forces%taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + & - G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) - enddo; enddo - - do J=Jsq,Jeq ; do i=is,ie - forces%tauy(i,J) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & - forces%tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + & - G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) - enddo; enddo - - ! ustar is required for the bulk mixed layer formulation. The background value - ! of 0.02 Pa is a relatively small value intended to give reasonable behavior - ! in regions of very weak winds. - - do j=js,je ; do i=is,ie - tau_mag = 0.0 ; gustiness = CS%gust_const - if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & - (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then - tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & - G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & - (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & - G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & - ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) - if (CS%read_gust_2d) gustiness = CS%gust(i,j) - endif - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) - enddo; enddo + 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) + + do j=js,je ; do I=Isq,Ieq + forces%taux(I,j) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & + forces%taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + & + G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) + enddo; enddo + + do J=Jsq,Jeq ; do i=is,ie + forces%tauy(i,J) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & + forces%tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + & + G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) + enddo; enddo + + ! ustar is required for the bulk mixed layer formulation. The background value + ! of 0.02 Pa is a relatively small value intended to give reasonable behavior + ! in regions of very weak winds. + + do j=js,je ; do i=is,ie + tau_mag = 0.0 ; gustiness = CS%gust_const + if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then + tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & + G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & + (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & + G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & + ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) + if (CS%read_gust_2d) gustiness = CS%gust(i,j) + endif + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) + enddo; enddo elseif (wind_stagger == AGRID) then - call pass_vector(taux_at_h, tauy_at_h, G%Domain,stagger=AGRID) - - do j=js,je ; do I=Isq,Ieq - forces%taux(I,j) = 0.0 - if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & - forces%taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + & - G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & - (G%mask2dT(i,j) + G%mask2dT(i+1,j)) - enddo; enddo - - do J=Jsq,Jeq ; do i=is,ie - forces%tauy(i,J) = 0.0 - if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & - forces%tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + & - G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & - (G%mask2dT(i,j) + G%mask2dT(i,j+1)) - enddo; enddo - - do j=js,je ; do i=is,ie - gustiness = CS%gust_const - if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & - sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) - enddo; enddo + call pass_vector(taux_at_h, tauy_at_h, G%Domain,stagger=AGRID) + + do j=js,je ; do I=Isq,Ieq + forces%taux(I,j) = 0.0 + if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & + forces%taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + & + G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & + (G%mask2dT(i,j) + G%mask2dT(i+1,j)) + enddo; enddo + + do J=Jsq,Jeq ; do i=is,ie + forces%tauy(i,J) = 0.0 + if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & + forces%tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + & + G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & + (G%mask2dT(i,j) + G%mask2dT(i,j+1)) + enddo; enddo + + do j=js,je ; do i=is,ie + gustiness = CS%gust_const + if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & + sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) + enddo; enddo 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) - - do j=js,je ; do i=is,ie - taux2 = 0.0 - if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & - taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + & - G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) - - tauy2 = 0.0 - if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & - tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + & - G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) - - if (CS%read_gust_2d) then - forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) - else - forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) - endif - enddo; enddo + if (G%symmetric) & + call fill_symmetric_edges(forces%taux, forces%tauy, G%Domain) + call pass_vector(forces%taux, forces%tauy, G%Domain) + + do j=js,je ; do i=is,ie + taux2 = 0.0 + if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & + taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + & + G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) + + tauy2 = 0.0 + if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & + tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + & + G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) + + if (CS%read_gust_2d) then + forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) + else + forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) + endif + enddo; enddo endif ! endif for wind related fields @@ -765,55 +764,55 @@ 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% 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% runoff (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%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%runoff = 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 + 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% 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% runoff (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%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%runoff = 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 @@ -1299,38 +1298,38 @@ end subroutine surface_forcing_end 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 - 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%q_flux ', mpp_chksum( iobt%q_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%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 ) - if (associated(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 ) + character(len=*), intent(in) :: id + integer , intent(in) :: timestep + type(ice_ocean_boundary_type), intent(in) :: iobt + 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%q_flux ', mpp_chksum( iobt%q_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%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 ) + if (associated(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 ) 100 FORMAT(" CHECKSUM::",A20," = ",Z20) - call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%') + call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%') end subroutine ice_ocn_bnd_type_chksum diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 30d6faae3b..8df3e8b7f1 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -43,88 +43,88 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, k = 0 do j = jsc, jec - jg = j + grid%jsc - jsc - do i = isc, iec - ig = i + grid%jsc - isc - k = k + 1 ! Increment position within gindex - - ! taux - ice_ocean_boundary%u_flux(i,j) = x2o(ind%x2o_Foxx_taux,k) - - ! tauy - ice_ocean_boundary%v_flux(i,j) = x2o(ind%x2o_Foxx_tauy,k) - - ! liquid precipitation (rain) - ice_ocean_boundary%lprec(i,j) = x2o(ind%x2o_Faxa_rain,k) - - ! frozen precipitation (snow) - ice_ocean_boundary%fprec(i,j) = x2o(ind%x2o_Faxa_snow,k) - - ! longwave radiation, sum up and down (W/m2) - ice_ocean_boundary%lw_flux(i,j) = (x2o(ind%x2o_Faxa_lwdn,k) + x2o(ind%x2o_Foxx_lwup,k)) - - ! specific humitidy flux - ice_ocean_boundary%q_flux(i,j) = x2o(ind%x2o_Foxx_evap,k) !???TODO: should this be a minus sign - - ! sensible heat flux (W/m2) - ice_ocean_boundary%t_flux(i,j) = x2o(ind%x2o_Foxx_sen,k) !???TODO: should this be a minus sign - - ! latent heat flux (W/m^2) - ice_ocean_boundary%latent_flux(i,j) = x2o(ind%x2o_Foxx_lat,k) !???TODO: should this be a minus sign - - ! liquid runoff - ice_ocean_boundary%rofl_flux(i,j) = x2o(ind%x2o_Foxx_rofl,k) * GRID%mask2dT(ig,jg) - - ! ice runoff - ice_ocean_boundary%rofi_flux(i,j) = x2o(ind%x2o_Foxx_rofi,k) * GRID%mask2dT(ig,jg) - - ! surface pressure - ice_ocean_boundary%p(i,j) = x2o(ind%x2o_Sa_pslv,k) * GRID%mask2dT(ig,jg) - - ! salt flux - ice_ocean_boundary%salt_flux(i,j) = x2o(ind%x2o_Fioi_salt,k) * GRID%mask2dT(ig,jg) - - ! 1) visible, direct shortwave (W/m2) - ! 2) visible, diffuse shortwave (W/m2) - ! 3) near-IR, direct shortwave (W/m2) - ! 4) near-IR, diffuse shortwave (W/m2) - if (present(c1) .and. present(c2) .and. present(c3) .and. present(c4)) then - ! Use runtime coefficients to decompose net short-wave heat flux into 4 components - ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c1 * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c2 * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c3 * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c4 * GRID%mask2dT(ig,jg) - else - ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Faxa_swvdr,k) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Faxa_swvdf,k) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Faxa_swndr,k) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Faxa_swndf,k) * GRID%mask2dT(ig,jg) - end if - end do + jg = j + grid%jsc - jsc + do i = isc, iec + ig = i + grid%jsc - isc + k = k + 1 ! Increment position within gindex + + ! taux + ice_ocean_boundary%u_flux(i,j) = x2o(ind%x2o_Foxx_taux,k) + + ! tauy + ice_ocean_boundary%v_flux(i,j) = x2o(ind%x2o_Foxx_tauy,k) + + ! liquid precipitation (rain) + ice_ocean_boundary%lprec(i,j) = x2o(ind%x2o_Faxa_rain,k) + + ! frozen precipitation (snow) + ice_ocean_boundary%fprec(i,j) = x2o(ind%x2o_Faxa_snow,k) + + ! longwave radiation, sum up and down (W/m2) + ice_ocean_boundary%lw_flux(i,j) = (x2o(ind%x2o_Faxa_lwdn,k) + x2o(ind%x2o_Foxx_lwup,k)) + + ! specific humitidy flux + ice_ocean_boundary%q_flux(i,j) = x2o(ind%x2o_Foxx_evap,k) !???TODO: should this be a minus sign + + ! sensible heat flux (W/m2) + ice_ocean_boundary%t_flux(i,j) = x2o(ind%x2o_Foxx_sen,k) !???TODO: should this be a minus sign + + ! latent heat flux (W/m^2) + ice_ocean_boundary%latent_flux(i,j) = x2o(ind%x2o_Foxx_lat,k) !???TODO: should this be a minus sign + + ! liquid runoff + ice_ocean_boundary%rofl_flux(i,j) = x2o(ind%x2o_Foxx_rofl,k) * GRID%mask2dT(ig,jg) + + ! ice runoff + ice_ocean_boundary%rofi_flux(i,j) = x2o(ind%x2o_Foxx_rofi,k) * GRID%mask2dT(ig,jg) + + ! surface pressure + ice_ocean_boundary%p(i,j) = x2o(ind%x2o_Sa_pslv,k) * GRID%mask2dT(ig,jg) + + ! salt flux + ice_ocean_boundary%salt_flux(i,j) = x2o(ind%x2o_Fioi_salt,k) * GRID%mask2dT(ig,jg) + + ! 1) visible, direct shortwave (W/m2) + ! 2) visible, diffuse shortwave (W/m2) + ! 3) near-IR, direct shortwave (W/m2) + ! 4) near-IR, diffuse shortwave (W/m2) + if (present(c1) .and. present(c2) .and. present(c3) .and. present(c4)) then + ! Use runtime coefficients to decompose net short-wave heat flux into 4 components + ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c1 * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c2 * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c3 * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c4 * GRID%mask2dT(ig,jg) + else + ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Faxa_swvdr,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Faxa_swvdf,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Faxa_swndr,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Faxa_swndf,k) * GRID%mask2dT(ig,jg) + end if + end do end do if (debug .and. is_root_pe()) then - call ESMF_ClockGet(EClock, CurrTime=CurrTime, rc=rc) - call ESMF_TimeGet(CurrTime, d=day, s=secs, rc=rc) - - do j = GRID%jsc, GRID%jec - do i = GRID%isc, GRID%iec - write(logunit,F01)'import: day, secs, j, i, u_flux = ',day,secs,j,i,ice_ocean_boundary%u_flux(i,j) - write(logunit,F01)'import: day, secs, j, i, v_flux = ',day,secs,j,i,ice_ocean_boundary%v_flux(i,j) - write(logunit,F01)'import: day, secs, j, i, lprec = ',day,secs,j,i,ice_ocean_boundary%lprec(i,j) - write(logunit,F01)'import: day, secs, j, i, lwrad = ',day,secs,j,i,ice_ocean_boundary%lw_flux(i,j) - write(logunit,F01)'import: day, secs, j, i, q_flux = ',day,secs,j,i,ice_ocean_boundary%q_flux(i,j) - write(logunit,F01)'import: day, secs, j, i, t_flux = ',day,secs,j,i,ice_ocean_boundary%t_flux(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 = ',day,secs,j,i,ice_ocean_boundary%p(i,j) - write(logunit,F01)'import: day, secs, j, i, salt_flux = ',day,secs,j,i,ice_ocean_boundary%salt_flux(i,j) - write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dir = ',day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dir(i,j) - write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dif = ',day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dif(i,j) - write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dir = ',day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i,j) - write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dif = ',day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i,j) - end do - end do + call ESMF_ClockGet(EClock, CurrTime=CurrTime, rc=rc) + call ESMF_TimeGet(CurrTime, d=day, s=secs, rc=rc) + + do j = GRID%jsc, GRID%jec + do i = GRID%isc, GRID%iec + write(logunit,F01)'import: day, secs, j, i, u_flux = ',day,secs,j,i,ice_ocean_boundary%u_flux(i,j) + write(logunit,F01)'import: day, secs, j, i, v_flux = ',day,secs,j,i,ice_ocean_boundary%v_flux(i,j) + write(logunit,F01)'import: day, secs, j, i, lprec = ',day,secs,j,i,ice_ocean_boundary%lprec(i,j) + write(logunit,F01)'import: day, secs, j, i, lwrad = ',day,secs,j,i,ice_ocean_boundary%lw_flux(i,j) + write(logunit,F01)'import: day, secs, j, i, q_flux = ',day,secs,j,i,ice_ocean_boundary%q_flux(i,j) + write(logunit,F01)'import: day, secs, j, i, t_flux = ',day,secs,j,i,ice_ocean_boundary%t_flux(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 = ',day,secs,j,i,ice_ocean_boundary%p(i,j) + write(logunit,F01)'import: day, secs, j, i, salt_flux = ',day,secs,j,i,ice_ocean_boundary%salt_flux(i,j) + write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dir = ',day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dir(i,j) + write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dif = ',day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dif(i,j) + write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dir = ',day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i,j) + write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dif = ',day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i,j) + end do + end do end if end subroutine ocn_import @@ -150,19 +150,19 @@ subroutine ocn_export(ind, ocn_public, grid, o2x) n = 0 do j=grid%jsc, grid%jec - jg = j + grid%jdg_offset - do i=grid%isc,grid%iec - n = n+1 - ig = i + grid%idg_offset - ! surface temperature in Kelvin - o2x(ind%o2x_So_t, n) = ocn_public%t_surf(ig,jg) * grid%mask2dT(i,j) - o2x(ind%o2x_So_s, n) = ocn_public%s_surf(ig,jg) * grid%mask2dT(i,j) - o2x(ind%o2x_So_u, n) = ocn_public%u_surf(ig,jg) * grid%mask2dT(i,j) - o2x(ind%o2x_So_v, n) = ocn_public%v_surf(ig,jg) * grid%mask2dT(i,j) - ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain - ! in order to update halos. i.e. does not use global indexing. - ssh(i,j) = ocn_public%sea_lev(ig,jg) - end do + jg = j + grid%jdg_offset + do i=grid%isc,grid%iec + n = n+1 + ig = i + grid%idg_offset + ! surface temperature in Kelvin + o2x(ind%o2x_So_t, n) = ocn_public%t_surf(ig,jg) * grid%mask2dT(i,j) + o2x(ind%o2x_So_s, n) = ocn_public%s_surf(ig,jg) * grid%mask2dT(i,j) + o2x(ind%o2x_So_u, n) = ocn_public%u_surf(ig,jg) * grid%mask2dT(i,j) + o2x(ind%o2x_So_v, n) = ocn_public%v_surf(ig,jg) * grid%mask2dT(i,j) + ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain + ! in order to update halos. i.e. does not use global indexing. + ssh(i,j) = ocn_public%sea_lev(ig,jg) + end do end do ! Update halo of ssh so we can calculate gradients @@ -171,58 +171,58 @@ subroutine ocn_export(ind, ocn_public, grid, o2x) ! d/dx ssh n = 0 do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec - n = n+1 - ! This is a simple second-order difference - ! o2x(ind%o2x_So_dhdx, n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) - if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. - slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(I,j) - if (grid%mask2dCu(I+1,j)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - if ( (slp_L * slp_R) > 0.0 ) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - o2x(ind%o2x_So_dhdx, n) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdx, n) = 0.0 + n = n+1 + ! This is a simple second-order difference + ! o2x(ind%o2x_So_dhdx, n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) + if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(I,j) + if (grid%mask2dCu(I+1,j)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + if ( (slp_L * slp_R) > 0.0 ) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + o2x(ind%o2x_So_dhdx, n) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdx, n) = 0.0 end do; end do ! d/dy ssh n = 0 do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec - n = n+1 - ! This is a simple second-order difference - ! o2x(ind%o2x_So_dhdy, n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) - if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. - - slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,J) - if (grid%mask2dCv(i,J+1)==0.) slp_R = 0. - - slp_C = 0.5 * (slp_L + slp_R) - !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R - if ((slp_L * slp_R) > 0.0) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - o2x(ind%o2x_So_dhdy, n) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdy, n) = 0.0 + n = n+1 + ! This is a simple second-order difference + ! o2x(ind%o2x_So_dhdy, n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) + if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. + + slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,J) + if (grid%mask2dCv(i,J+1)==0.) slp_R = 0. + + slp_C = 0.5 * (slp_L + slp_R) + !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R + if ((slp_L * slp_R) > 0.0) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + o2x(ind%o2x_So_dhdy, n) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdy, n) = 0.0 end do; end do end subroutine ocn_export diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 162cb0eed5..f97c9d1747 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -280,27 +280,27 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) ! Initialize the MOM6 model runtype = get_runtype() if (runtype == "initial") then - ! startup (new run) - 'n' is needed below since we don't specify input_filename in input.nml - call ocean_model_init(glb%ocn_public, glb%ocn_state, time0, time0, input_restart_file = 'n') + ! startup (new run) - 'n' is needed below since we don't specify input_filename in input.nml + call ocean_model_init(glb%ocn_public, glb%ocn_state, time0, time0, input_restart_file = 'n') else ! hybrid or branch or continuos runs - ! get output path root - call seq_infodata_GetData( glb%infodata, outPathRoot=restartpath ) - ! read name of restart file in the pointer file - nu = shr_file_getUnit() - restart_pointer_file = trim(glb%pointer_filename) - if (is_root_pe()) write(glb%stdout,*) 'Reading ocn pointer file: ',restart_pointer_file - open(nu, file=restart_pointer_file, form='formatted', status='unknown') - read(nu,'(a)') restartfile - close(nu) - !restartfile = trim(restartpath) // trim(restartfile) - if (is_root_pe()) then - write(glb%stdout,*) 'Reading restart file: ',trim(restartfile) - end if - call shr_file_freeUnit(nu) - call ocean_model_init(glb%ocn_public, glb%ocn_state, time0, time0, input_restart_file=trim(restartfile)) + ! get output path root + call seq_infodata_GetData( glb%infodata, outPathRoot=restartpath ) + ! read name of restart file in the pointer file + nu = shr_file_getUnit() + restart_pointer_file = trim(glb%pointer_filename) + if (is_root_pe()) write(glb%stdout,*) 'Reading ocn pointer file: ',restart_pointer_file + open(nu, file=restart_pointer_file, form='formatted', status='unknown') + read(nu,'(a)') restartfile + close(nu) + !restartfile = trim(restartpath) // trim(restartfile) + if (is_root_pe()) then + write(glb%stdout,*) 'Reading restart file: ',trim(restartfile) + end if + call shr_file_freeUnit(nu) + call ocean_model_init(glb%ocn_public, glb%ocn_state, time0, time0, input_restart_file=trim(restartfile)) endif if (is_root_pe()) then - write(glb%stdout,'(/12x,a/)') '======== COMPLETED MOM INITIALIZATION ========' + write(glb%stdout,'(/12x,a/)') '======== COMPLETED MOM INITIALIZATION ========' end if ! Initialize ocn_state%sfc_state out of sight @@ -361,8 +361,8 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) ncouple_per_day = seconds_in_day / ocn_cpl_dt mom_cpl_dt = seconds_in_day / ncouple_per_day if (mom_cpl_dt /= ocn_cpl_dt) then - write(glb%stdout,*) 'ERROR mom_cpl_dt and ocn_cpl_dt must be identical' - call exit(0) + write(glb%stdout,*) 'ERROR mom_cpl_dt and ocn_cpl_dt must be identical' + call exit(0) end if ! send initial state to driver @@ -382,10 +382,10 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) if (debug .and. root_pe().eq.pe_here()) print *, "calling seq_infodata_putdata" - call seq_infodata_PutData( glb%infodata, & - ocn_nx = ni , ocn_ny = nj) - call seq_infodata_PutData( glb%infodata, & - ocn_prognostic=.true., ocnrof_prognostic=.true.) + call seq_infodata_PutData( glb%infodata, & + ocn_nx = ni , ocn_ny = nj) + call seq_infodata_PutData( glb%infodata, & + ocn_prognostic=.true., ocnrof_prognostic=.true.) if (debug .and. root_pe().eq.pe_here()) print *, "leaving ocean_init_mct" @@ -492,10 +492,10 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o) !glb%sw_decomp = .false. !END TODO: if (glb%sw_decomp) then - call ocn_import(x2o_o%rattr, glb%ind, glb%grid, Ice_ocean_boundary, glb%ocn_public, glb%stdout, Eclock, & + call ocn_import(x2o_o%rattr, glb%ind, glb%grid, Ice_ocean_boundary, glb%ocn_public, glb%stdout, Eclock, & c1=glb%c1, c2=glb%c2, c3=glb%c3, c4=glb%c4) else - call ocn_import(x2o_o%rattr, glb%ind, glb%grid, Ice_ocean_boundary, glb%ocn_public, glb%stdout, Eclock ) + call ocn_import(x2o_o%rattr, glb%ind, glb%grid, Ice_ocean_boundary, glb%ocn_public, glb%stdout, Eclock ) end if ! Update internal ocean diff --git a/config_src/mct_driver/ocn_cpl_indices.F90 b/config_src/mct_driver/ocn_cpl_indices.F90 index 85b9a6de40..4ea12eb8cc 100644 --- a/config_src/mct_driver/ocn_cpl_indices.F90 +++ b/config_src/mct_driver/ocn_cpl_indices.F90 @@ -8,69 +8,69 @@ module ocn_cpl_indices !> Structure with indices needed for MCT attribute vectors type cpl_indices_type - ! ocean to coupler - integer :: o2x_So_t !< Surface potential temperature (deg C) - integer :: o2x_So_u !< Surface zonal velocity (m/s) - integer :: o2x_So_v !< Surface meridional velocity (m/s) - integer :: o2x_So_s !< Surface salinity (PSU) - integer :: o2x_So_dhdx !< Zonal slope in the sea surface height - integer :: o2x_So_dhdy !< Meridional lope in the sea surface height - integer :: o2x_So_bldepth !< Boundary layer depth (m) - integer :: o2x_Fioo_q !< Heat flux? - integer :: o2x_Faoo_fco2_ocn !< CO2 flux - integer :: o2x_Faoo_fdms_ocn !< DMS flux - - ! coupler to ocean - integer :: x2o_Si_ifrac !< Fractional ice wrt ocean - integer :: x2o_So_duu10n !< 10m wind speed squared (m^2/s^2) - integer :: x2o_Sa_pslv !< Sea-level pressure (Pa) - integer :: x2o_Sa_co2prog !< Bottom atm level prognostic CO2 - integer :: x2o_Sa_co2diag !< Bottom atm level diagnostic CO2 - integer :: x2o_Sw_lamult !< Wave model langmuir multiplier - integer :: x2o_Sw_ustokes !< Surface Stokes drift, x-component - integer :: x2o_Sw_vstokes !< Surface Stokes drift, y-component - integer :: x2o_Foxx_taux !< Zonal wind stress (W/m2) - integer :: x2o_Foxx_tauy !< Meridonal wind stress (W/m2) - integer :: x2o_Foxx_swnet !< Net short-wave heat flux (W/m2) - integer :: x2o_Foxx_sen !< Sensible heat flux (W/m2) - integer :: x2o_Foxx_lat !< Latent heat flux (W/m2) - integer :: x2o_Foxx_lwup !< Longwave radiation, up (W/m2) - integer :: x2o_Faxa_lwdn !< Longwave radiation, down (W/m2) - integer :: x2o_Faxa_swvdr !< Visible, direct shortwave (W/m2) - integer :: x2o_Faxa_swvdf !< Visible, diffuse shortwave (W/m2) - integer :: x2o_Faxa_swndr !< near-IR, direct shortwave (W/m2) - integer :: x2o_Faxa_swndf !< near-IR, direct shortwave (W/m2) - integer :: x2o_Fioi_melth !< Heat flux from snow & ice melt (W/m2) - integer :: x2o_Fioi_meltw !< Snow melt flux (kg/m2/s) - integer :: x2o_Fioi_bcpho !< Black Carbon hydrophobic release from sea ice component - integer :: x2o_Fioi_bcphi !< Black Carbon hydrophilic release from sea ice component - integer :: x2o_Fioi_flxdst !< Dust release from sea ice component - integer :: x2o_Fioi_salt !< Salt flux (kg(salt)/m2/s) - integer :: x2o_Foxx_evap !< Evaporation flux (kg/m2/s) - integer :: x2o_Faxa_prec !< Total precipitation flux (kg/m2/s) - integer :: x2o_Faxa_snow !< Water flux due to snow (kg/m2/s) - integer :: x2o_Faxa_rain !< Water flux due to rain (kg/m2/s) - integer :: x2o_Faxa_bcphidry !< Black Carbon hydrophilic dry deposition - integer :: x2o_Faxa_bcphodry !< Black Carbon hydrophobic dry deposition - integer :: x2o_Faxa_bcphiwet !< Black Carbon hydrophilic wet deposition - integer :: x2o_Faxa_ocphidry !< Organic Carbon hydrophilic dry deposition - integer :: x2o_Faxa_ocphodry !< Organic Carbon hydrophobic dry deposition - integer :: x2o_Faxa_ocphiwet !< Organic Carbon hydrophilic dry deposition - integer :: x2o_Faxa_dstwet1 !< Size 1 dust -- wet deposition - integer :: x2o_Faxa_dstwet2 !< Size 2 dust -- wet deposition - integer :: x2o_Faxa_dstwet3 !< Size 3 dust -- wet deposition - integer :: x2o_Faxa_dstwet4 !< Size 4 dust -- wet deposition - integer :: x2o_Faxa_dstdry1 !< Size 1 dust -- dry deposition - integer :: x2o_Faxa_dstdry2 !< Size 2 dust -- dry deposition - integer :: x2o_Faxa_dstdry3 !< Size 3 dust -- dry deposition - integer :: x2o_Faxa_dstdry4 !< Size 4 dust -- dry deposition - integer :: x2o_Foxx_rofl !< River runoff flux (kg/m2/s) - integer :: x2o_Foxx_rofi !< Ice runoff flux (kg/m2/s) - - ! optional per thickness category fields - integer, dimension(:), allocatable :: x2o_frac_col !< Fraction of ocean cell, per column - integer, dimension(:), allocatable :: x2o_fracr_col !< Fraction of ocean cell used in radiation computations, per column - integer, dimension(:), allocatable :: x2o_qsw_fracr_col !< qsw * fracr, per column + ! ocean to coupler + integer :: o2x_So_t !< Surface potential temperature (deg C) + integer :: o2x_So_u !< Surface zonal velocity (m/s) + integer :: o2x_So_v !< Surface meridional velocity (m/s) + integer :: o2x_So_s !< Surface salinity (PSU) + integer :: o2x_So_dhdx !< Zonal slope in the sea surface height + integer :: o2x_So_dhdy !< Meridional lope in the sea surface height + integer :: o2x_So_bldepth !< Boundary layer depth (m) + integer :: o2x_Fioo_q !< Heat flux? + integer :: o2x_Faoo_fco2_ocn !< CO2 flux + integer :: o2x_Faoo_fdms_ocn !< DMS flux + + ! coupler to ocean + integer :: x2o_Si_ifrac !< Fractional ice wrt ocean + integer :: x2o_So_duu10n !< 10m wind speed squared (m^2/s^2) + integer :: x2o_Sa_pslv !< Sea-level pressure (Pa) + integer :: x2o_Sa_co2prog !< Bottom atm level prognostic CO2 + integer :: x2o_Sa_co2diag !< Bottom atm level diagnostic CO2 + integer :: x2o_Sw_lamult !< Wave model langmuir multiplier + integer :: x2o_Sw_ustokes !< Surface Stokes drift, x-component + integer :: x2o_Sw_vstokes !< Surface Stokes drift, y-component + integer :: x2o_Foxx_taux !< Zonal wind stress (W/m2) + integer :: x2o_Foxx_tauy !< Meridonal wind stress (W/m2) + integer :: x2o_Foxx_swnet !< Net short-wave heat flux (W/m2) + integer :: x2o_Foxx_sen !< Sensible heat flux (W/m2) + integer :: x2o_Foxx_lat !< Latent heat flux (W/m2) + integer :: x2o_Foxx_lwup !< Longwave radiation, up (W/m2) + integer :: x2o_Faxa_lwdn !< Longwave radiation, down (W/m2) + integer :: x2o_Faxa_swvdr !< Visible, direct shortwave (W/m2) + integer :: x2o_Faxa_swvdf !< Visible, diffuse shortwave (W/m2) + integer :: x2o_Faxa_swndr !< near-IR, direct shortwave (W/m2) + integer :: x2o_Faxa_swndf !< near-IR, direct shortwave (W/m2) + integer :: x2o_Fioi_melth !< Heat flux from snow & ice melt (W/m2) + integer :: x2o_Fioi_meltw !< Snow melt flux (kg/m2/s) + integer :: x2o_Fioi_bcpho !< Black Carbon hydrophobic release from sea ice component + integer :: x2o_Fioi_bcphi !< Black Carbon hydrophilic release from sea ice component + integer :: x2o_Fioi_flxdst !< Dust release from sea ice component + integer :: x2o_Fioi_salt !< Salt flux (kg(salt)/m2/s) + integer :: x2o_Foxx_evap !< Evaporation flux (kg/m2/s) + integer :: x2o_Faxa_prec !< Total precipitation flux (kg/m2/s) + integer :: x2o_Faxa_snow !< Water flux due to snow (kg/m2/s) + integer :: x2o_Faxa_rain !< Water flux due to rain (kg/m2/s) + integer :: x2o_Faxa_bcphidry !< Black Carbon hydrophilic dry deposition + integer :: x2o_Faxa_bcphodry !< Black Carbon hydrophobic dry deposition + integer :: x2o_Faxa_bcphiwet !< Black Carbon hydrophilic wet deposition + integer :: x2o_Faxa_ocphidry !< Organic Carbon hydrophilic dry deposition + integer :: x2o_Faxa_ocphodry !< Organic Carbon hydrophobic dry deposition + integer :: x2o_Faxa_ocphiwet !< Organic Carbon hydrophilic dry deposition + integer :: x2o_Faxa_dstwet1 !< Size 1 dust -- wet deposition + integer :: x2o_Faxa_dstwet2 !< Size 2 dust -- wet deposition + integer :: x2o_Faxa_dstwet3 !< Size 3 dust -- wet deposition + integer :: x2o_Faxa_dstwet4 !< Size 4 dust -- wet deposition + integer :: x2o_Faxa_dstdry1 !< Size 1 dust -- dry deposition + integer :: x2o_Faxa_dstdry2 !< Size 2 dust -- dry deposition + integer :: x2o_Faxa_dstdry3 !< Size 3 dust -- dry deposition + integer :: x2o_Faxa_dstdry4 !< Size 4 dust -- dry deposition + integer :: x2o_Foxx_rofl !< River runoff flux (kg/m2/s) + integer :: x2o_Foxx_rofi !< Ice runoff flux (kg/m2/s) + + ! optional per thickness category fields + integer, dimension(:), allocatable :: x2o_frac_col !< Fraction of ocean cell, per column + integer, dimension(:), allocatable :: x2o_fracr_col !< Fraction of ocean cell used in radiation computations, per column + integer, dimension(:), allocatable :: x2o_qsw_fracr_col !< qsw * fracr, per column end type cpl_indices_type public :: cpl_indices_init @@ -161,24 +161,24 @@ subroutine cpl_indices_init(ind) lmcog_flds_sent = seq_flds_i2o_per_cat if (seq_flds_i2o_per_cat) then - mcog_ncols = ice_ncat+1 - allocate(ind%x2o_frac_col(mcog_ncols)) - allocate(ind%x2o_fracr_col(mcog_ncols)) - allocate(ind%x2o_qsw_fracr_col(mcog_ncols)) - ncol = 1 - ind%x2o_frac_col(ncol) = mct_avect_indexra(x2o,'Sf_afrac') - ind%x2o_fracr_col(ncol) = mct_avect_indexra(x2o,'Sf_afracr') - ind%x2o_qsw_fracr_col(ncol) = mct_avect_indexra(x2o,'Foxx_swnet_afracr') - - do ncat = 1, ice_ncat + mcog_ncols = ice_ncat+1 + allocate(ind%x2o_frac_col(mcog_ncols)) + allocate(ind%x2o_fracr_col(mcog_ncols)) + allocate(ind%x2o_qsw_fracr_col(mcog_ncols)) + ncol = 1 + ind%x2o_frac_col(ncol) = mct_avect_indexra(x2o,'Sf_afrac') + ind%x2o_fracr_col(ncol) = mct_avect_indexra(x2o,'Sf_afracr') + ind%x2o_qsw_fracr_col(ncol) = mct_avect_indexra(x2o,'Foxx_swnet_afracr') + + do ncat = 1, ice_ncat write(cncat,'(i2.2)') ncat ncol = ncat+1 ind%x2o_frac_col(ncol) = mct_avect_indexra(x2o,'Si_ifrac_'//cncat) ind%x2o_fracr_col(ncol) = ind%x2o_frac_col(ncol) ind%x2o_qsw_fracr_col(ncol) = mct_avect_indexra(x2o,'PFioi_swpen_ifrac_'//cncat) - enddo + enddo else - mcog_ncols = 1 + mcog_ncols = 1 endif call mct_aVect_clean(x2o) diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 2c47d9e91a..94dd64efed 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -706,40 +706,40 @@ subroutine ocean_model_restart(OS, timestamp, restartname) 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 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? + 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 + 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) + 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.) + 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 (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) + 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 + 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 @@ -812,9 +812,9 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) "restart files can only be created after the buoyancy forcing is applied.") if (present(directory)) then - restart_dir = directory + restart_dir = directory else - restart_dir = OS%dirs%restart_output_dir + restart_dir = OS%dirs%restart_output_dir endif call save_restart(restart_dir, Time, OS%grid, OS%restart_CSp, GV=OS%GV) @@ -850,9 +850,9 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, call mpp_get_layout(input_domain,layout) call mpp_get_global_domain(input_domain, xsize=xsz, ysize=ysz) if (PRESENT(maskmap)) then - call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain, maskmap=maskmap) + call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain, maskmap=maskmap) else - call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain) + call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain) endif call mpp_get_compute_domain(Ocean_sfc%Domain, isc, iec, jsc, jec) @@ -1105,45 +1105,45 @@ subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc) select case(name) case('area') - array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) case('mask') - array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) !OR same result ! do j=g_jsc,g_jec ; do i=g_isc,g_iec ! array2D(isc+i-g_isc,jsc+j-g_jsc) = OS%grid%mask2dT(i,j) ! enddo ; enddo case('t_surf') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('t_pme') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('t_runoff') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('t_calving') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('btfHeat') - array2D(isc:,jsc:) = 0 + array2D(isc:,jsc:) = 0 case('tlat') - array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) case('tlon') - array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) case('ulat') - array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) case('ulon') - array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) case('vlat') - array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) case('vlon') - array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) case('geoLatBu') - array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) case('geoLonBu') - array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) case('cos_rot') - array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 + array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 case('sin_rot') - array2D(isc:,jsc:) = OS%grid%sin_rot(g_isc:g_iec,g_jsc:g_jec) ! =0 + 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,'ocean_model_data2D_get: unknown argument name='//name) end select @@ -1160,9 +1160,9 @@ subroutine ocean_model_data1D_get(OS,Ocean, name, value) 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,'ocean_model_data1D_get: unknown argument name='//name) end select @@ -1170,22 +1170,22 @@ end subroutine ocean_model_data1D_get 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 + integer , intent(in) :: timestep + type(ocean_public_type), intent(in) :: ocn + integer :: n,m, outunit - outunit = stdout() + outunit = stdout() - write(outunit,*) "BEGIN CHECKSUM(ocean_type):: ", id, timestep - write(outunit,100) 'ocean%t_surf ',mpp_chksum(ocn%t_surf ) - write(outunit,100) 'ocean%s_surf ',mpp_chksum(ocn%s_surf ) - write(outunit,100) 'ocean%u_surf ',mpp_chksum(ocn%u_surf ) - 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,*) "BEGIN CHECKSUM(ocean_type):: ", id, timestep + write(outunit,100) 'ocean%t_surf ',mpp_chksum(ocn%t_surf ) + write(outunit,100) 'ocean%s_surf ',mpp_chksum(ocn%s_surf ) + write(outunit,100) 'ocean%u_surf ',mpp_chksum(ocn%u_surf ) + 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 ) - call coupler_type_write_chksums(ocn%fields, outunit, 'ocean%') + call coupler_type_write_chksums(ocn%fields, outunit, 'ocean%') 100 FORMAT(" CHECKSUM::",A20," = ",Z20) end subroutine ocean_public_type_chksum @@ -1197,14 +1197,14 @@ end subroutine ocean_public_type_chksum ! Obtain the ocean grid. ! ! - subroutine get_ocean_grid(OS, Gridp) - type(ocean_state_type) :: OS - type(ocean_grid_type) , pointer :: Gridp +subroutine get_ocean_grid(OS, Gridp) + type(ocean_state_type) :: OS + type(ocean_grid_type) , pointer :: Gridp - Gridp => OS%grid - return + Gridp => OS%grid + return - end subroutine get_ocean_grid +end subroutine get_ocean_grid ! NAME="get_ocean_grid" end module MOM_ocean_model diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 526b1e2b7f..ddc6bc1a18 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -768,32 +768,32 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out if (isPresent) then - call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", value=inst_suffix, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", value=inst_suffix, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out else inst_suffix = '' end if ! reset shr logging to my log file if (is_root_pe()) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - logunit = shr_file_getUnit() - open(logunit,file=trim(diro)//"/"//trim(logfile)) + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + logunit = shr_file_getUnit() + open(logunit,file=trim(diro)//"/"//trim(logfile)) else - logunit = 6 + logunit = 6 endif call shr_file_getLogUnit (shrlogunit) @@ -803,17 +803,17 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out read(cvalue,*) starttype if (trim(starttype) == trim('startup')) then - runtype = "initial" + runtype = "initial" else if (trim(starttype) == trim('continue') ) then - runtype = "continue" + runtype = "continue" else if (trim(starttype) == trim('branch')) then - runtype = "continue" + runtype = "continue" else call ESMF_LogWrite(subname//' ERROR: unknown starttype '//trim(starttype), ESMF_LOGMSG_ERROR, rc=dbrc) rc = ESMF_FAILURE @@ -825,31 +825,31 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (runtype == "initial") then - ! startup (new run) - 'n' is needed below since we don't specify input_filename in input.nml - ocean_public%is_ocean_pe = .true. - call ocean_model_init(ocean_public, ocean_state, Time, Time, input_restart_file = 'n') + ! startup (new run) - 'n' is needed below since we don't specify input_filename in input.nml + ocean_public%is_ocean_pe = .true. + call ocean_model_init(ocean_public, ocean_state, Time, Time, input_restart_file = 'n') else ! hybrid or branch or continuos runs - ! read name of restart file in the pointer file - nu = shr_file_getUnit() - restart_pointer_file = 'rpointer.ocn' - if (is_root_pe()) then - write(logunit,*) 'Reading ocn pointer file: ',restart_pointer_file - end if - open(nu, file=restart_pointer_file, form='formatted', status='unknown') - read(nu,'(a)') restartfile - close(nu) - - ! initialize from restart file - if (is_root_pe()) then - write(logunit,*) 'Reading restart file: ',trim(restartfile) - end if - call shr_file_freeUnit(nu) - - ocean_public%is_ocean_pe = .true. - call ocean_model_init(ocean_public, ocean_state, Time, Time, input_restart_file=trim(restartfile)) + ! read name of restart file in the pointer file + nu = shr_file_getUnit() + restart_pointer_file = 'rpointer.ocn' + if (is_root_pe()) then + write(logunit,*) 'Reading ocn pointer file: ',restart_pointer_file + end if + open(nu, file=restart_pointer_file, form='formatted', status='unknown') + read(nu,'(a)') restartfile + close(nu) + + ! initialize from restart file + if (is_root_pe()) then + write(logunit,*) 'Reading restart file: ',trim(restartfile) + end if + call shr_file_freeUnit(nu) + + ocean_public%is_ocean_pe = .true. + call ocean_model_init(ocean_public, ocean_state, Time, Time, input_restart_file=trim(restartfile)) end if call ocean_model_init_sfc(ocean_state, ocean_public) @@ -886,24 +886,24 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! advertise import and export fields nflds = shr_nuopc_fldList_Getnumflds(fldListFr(compocn)) do n = 1,nflds - call shr_nuopc_fldList_Getfldinfo(fldListFr(compocn), n, activefld, stdname, shortname) - if (activefld) then - call NUOPC_Advertise(exportState, standardName=stdname, shortname=shortname, name=shortname, & - TransferOfferGeomObject='will provide', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end if - call ESMF_LogWrite(subname//':Fr_'//trim(compname(compocn))//': '//trim(shortname), ESMF_LOGMSG_INFO) + call shr_nuopc_fldList_Getfldinfo(fldListFr(compocn), n, activefld, stdname, shortname) + if (activefld) then + call NUOPC_Advertise(exportState, standardName=stdname, shortname=shortname, name=shortname, & + TransferOfferGeomObject='will provide', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if + call ESMF_LogWrite(subname//':Fr_'//trim(compname(compocn))//': '//trim(shortname), ESMF_LOGMSG_INFO) end do nflds = shr_nuopc_fldList_Getnumflds(fldListTo(compocn)) do n = 1,nflds - call shr_nuopc_fldList_Getfldinfo(fldListTo(compocn), n, activefld, stdname, shortname) - if (activefld) then - call NUOPC_Advertise(importState, standardName=stdname, shortname=shortname, name=shortname, & - TransferOfferGeomObject='will provide', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_file_u)) return - end if - call ESMF_LogWrite(subname//':To_'//trim(compname(compocn))//': '//trim(shortname), ESMF_LOGMSG_INFO) + call shr_nuopc_fldList_Getfldinfo(fldListTo(compocn), n, activefld, stdname, shortname) + if (activefld) then + call NUOPC_Advertise(importState, standardName=stdname, shortname=shortname, name=shortname, & + TransferOfferGeomObject='will provide', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_file_u)) return + end if + call ESMF_LogWrite(subname//':To_'//trim(compname(compocn))//': '//trim(shortname), ESMF_LOGMSG_INFO) end do #else @@ -944,19 +944,19 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=ocean_public%frazil) do n = 1,fldsToOcn_num - call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out enddo do n = 1,fldsFrOcn_num - call NUOPC_Advertise(exportState, standardName=fldsFrOcn(n)%stdname, name=fldsFrOcn(n)(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call NUOPC_Advertise(exportState, standardName=fldsFrOcn(n)%stdname, name=fldsFrOcn(n)(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out enddo #endif @@ -1107,10 +1107,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call mpp_get_compute_domains(ocean_public%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye) call mpp_get_pelist(ocean_public%domain, pe) if (debug > 0) then - do n = 1,ntiles - write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - enddo + do n = 1,ntiles + write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + enddo end if !--------------------------------- @@ -1122,19 +1122,19 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) allocate(deLabelList(ntiles)) do n = 1, ntiles - deLabelList(n) = n - deBlockList(1,1,n) = xb(n) - deBlockList(1,2,n) = xe(n) - deBlockList(2,1,n) = yb(n) - deBlockList(2,2,n) = ye(n) - petMap(n) = pe(n) - ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side + deLabelList(n) = n + deBlockList(1,1,n) = xb(n) + deBlockList(1,2,n) = xe(n) + deBlockList(2,1,n) = yb(n) + deBlockList(2,2,n) = ye(n) + petMap(n) = pe(n) + ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side enddo delayout = ESMF_DELayoutCreate(petMap, rc=rc) @@ -1203,9 +1203,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !--------------------------------- gridIn = ESMF_GridCreate(distgrid=distgrid, & - gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & - coordSys = ESMF_COORDSYS_SPH_DEG, & - rc = rc) + gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & + coordSys = ESMF_COORDSYS_SPH_DEG, & + rc = rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1233,7 +1233,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Attach area to the Grid optionally. By default the cell areas are computed. if(grid_attach_area) then call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1316,11 +1316,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) if (iec-isc /= ubnd1-lbnd1 .or. jec-jsc /= ubnd2-lbnd2) then - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": fld and grid do not have the same size.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out + rc=ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": fld and grid do not have the same size.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out endif allocate(ofld(isc:iec,jsc:jec)) @@ -1334,9 +1334,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_mask(i,j) = nint(ofld(i1,j1)) + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_mask(i,j) = nint(ofld(i1,j1)) enddo enddo @@ -1349,9 +1349,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_area(i,j) = ofld(i1,j1) + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_area(i,j) = ofld(i1,j1) enddo enddo endif @@ -1364,10 +1364,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_xcen(i,j) = ofld(i1,j1) - dataPtr_xcen(i,j) = mod(dataPtr_xcen(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_xcen(i,j) = ofld(i1,j1) + dataPtr_xcen(i,j) = mod(dataPtr_xcen(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) enddo enddo @@ -1379,9 +1379,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_ycen(i,j) = ofld(i1,j1) + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_ycen(i,j) = ofld(i1,j1) enddo enddo @@ -1393,24 +1393,24 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) do j = lbnd4, ubnd4 do i = lbnd3, ubnd3 - j1 = j - lbnd4 + jsc - 1 - i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 - if (j1 == 0) then - dataPtr_xcor(i,j) = 2*gfld(i1,1) - gfld(i1,2) -! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) > 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) - 360. -! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) < 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) + 360. - elseif (j1 >= 1 .and. j1 <= nyg) then - dataPtr_xcor(i,j) = gfld(i1,j1) - else - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": error in xu j1.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - dataPtr_xcor(i,j) = mod(dataPtr_xcor(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) - ! write(tmpstr,*) subname//' ijfld xu = ',i,i1,j,j1,dataPtr_xcor(i,j) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + j1 = j - lbnd4 + jsc - 1 + i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 + if (j1 == 0) then + dataPtr_xcor(i,j) = 2*gfld(i1,1) - gfld(i1,2) +! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) > 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) - 360. +! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) < 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) + 360. + elseif (j1 >= 1 .and. j1 <= nyg) then + dataPtr_xcor(i,j) = gfld(i1,j1) + else + rc=ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": error in xu j1.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + dataPtr_xcor(i,j) = mod(dataPtr_xcor(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) + ! write(tmpstr,*) subname//' ijfld xu = ',i,i1,j,j1,dataPtr_xcor(i,j) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) enddo enddo @@ -1423,21 +1423,21 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) do j = lbnd4, ubnd4 do i = lbnd3, ubnd3 - j1 = j - lbnd4 + jsc - 1 - i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 - if (j1 == 0) then - dataPtr_ycor(i,j) = 2*gfld(i1,1) - gfld(i1,2) - elseif (j1 >= 1 .and. j1 <= nyg) then - dataPtr_ycor(i,j) = gfld(i1,j1) - else - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": error in yu j1.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - ! write(tmpstr,*) subname//' ijfld yu = ',i,i1,j,j1,dataPtr_ycor(i,j) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + j1 = j - lbnd4 + jsc - 1 + i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 + if (j1 == 0) then + dataPtr_ycor(i,j) = 2*gfld(i1,1) - gfld(i1,2) + elseif (j1 >= 1 .and. j1 <= nyg) then + dataPtr_ycor(i,j) = gfld(i1,j1) + else + rc=ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": error in yu j1.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + ! write(tmpstr,*) subname//' ijfld yu = ',i,i1,j,j1,dataPtr_ycor(i,j) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) enddo enddo @@ -1473,30 +1473,30 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call shr_nuopc_fldList_Realize(importState, fldListTo(compocn), flds_scalar_name, flds_scalar_num, & grid=gridIn, tag=subname//':MOM6Import', rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call shr_nuopc_fldList_Realize(exportState, fldListFr(compocn), flds_scalar_name, flds_scalar_num, & - grid=gridOut, tag=subname//':MOM6Export', rc=rc) + grid=gridOut, tag=subname//':MOM6Export', rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, mpicom, & - flds_scalar_name, flds_scalar_num, rc) + flds_scalar_name, flds_scalar_num, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, mpicom, & - flds_scalar_name, flds_scalar_num, rc) + flds_scalar_name, flds_scalar_num, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out #else call MOM_RealizeFields(importState, gridIn , fldsToOcn_num, fldsToOcn, "Ocn import", rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1538,9 +1538,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - if (ofld(i1,j1) == 0.) t_surf(i,j) = 0.0 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + if (ofld(i1,j1) == 0.) t_surf(i,j) = 0.0 enddo enddo @@ -1617,29 +1617,29 @@ subroutine DataInitialize(gcomp, rc) return ! bail out do n=1, fieldCount - call ESMF_StateGet(exportState, itemName=fieldNameList(n), field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call NUOPC_SetAttribute(field, name="Updated", value="true", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_StateGet(exportState, itemName=fieldNameList(n), field=field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call NUOPC_SetAttribute(field, name="Updated", value="true", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out end do deallocate(fieldNameList) ! check whether all Fields in the exportState are "Updated" if (NUOPC_IsUpdated(exportState)) then - call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) + call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) - call ESMF_LogWrite("MOM6 - Initialize-Data-Dependency SATISFIED!!!", ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_LogWrite("MOM6 - Initialize-Data-Dependency SATISFIED!!!", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out end if if(write_diagnostics) then @@ -1897,61 +1897,61 @@ subroutine ModelAdvance(gcomp, rc) ! If restart alarm is ringing - write restart file call ESMF_ClockGetAlarm(clock, alarmname='seq_timemgr_alarm_restart', alarm=alarm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call ESMF_AlarmRingerOff( alarm, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_AlarmRingerOff( alarm, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ! determine restart filename - ! Need to use next time step since clock is not advanced until the end of the time interval - call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - read(cvalue,*) runid + ! determine restart filename + ! Need to use next time step since clock is not advanced until the end of the time interval + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + read(cvalue,*) runid - call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, s=seconds, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I5.5)') trim(runid), year, month, day, seconds - - ! write name of restart file in the rpointer file - nu = shr_file_getUnit() - if (is_root_pe()) then - restart_pointer_file = 'rpointer.ocn' - open(nu, file=restart_pointer_file, form='formatted', status='unknown') - write(nu,'(a)') trim(restartname) //'.nc' - close(nu) - write(logunit,*) 'ocn restart pointer file written: ',trim(restartname) - endif - call shr_file_freeUnit(nu) - - ! write restart file(s) - call ocean_model_restart(ocean_state, restartname=restartname) - - if (is_root_pe()) then - write(logunit,*) subname//' writing restart file ',trim(restartname) - end if + call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, s=seconds, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I5.5)') trim(runid), year, month, day, seconds + + ! write name of restart file in the rpointer file + nu = shr_file_getUnit() + if (is_root_pe()) then + restart_pointer_file = 'rpointer.ocn' + open(nu, file=restart_pointer_file, form='formatted', status='unknown') + write(nu,'(a)') trim(restartname) //'.nc' + close(nu) + write(logunit,*) 'ocn restart pointer file written: ',trim(restartname) + endif + call shr_file_freeUnit(nu) + + ! write restart file(s) + call ocean_model_restart(ocean_state, restartname=restartname) + + if (is_root_pe()) then + write(logunit,*) subname//' writing restart file ',trim(restartname) + end if endif ! reset shr logging to my original values @@ -1965,9 +1965,9 @@ subroutine ModelAdvance(gcomp, rc) call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_mask(i,j) = nint(ofld(i1,j1)) + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_mask(i,j) = nint(ofld(i1,j1)) enddo enddo deallocate(ofld) @@ -2011,9 +2011,9 @@ subroutine ModelAdvance(gcomp, rc) !call ESMF_LogWrite("Before writing diagnostics", dataPtr_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc)) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_mask(i,j) = nint(ofld(i1,j1)) + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_mask(i,j) = nint(ofld(i1,j1)) enddo enddo deallocate(ofld) @@ -2151,22 +2151,22 @@ subroutine ModelSetRunClock(gcomp, rc) if (mcurrtime /= dcurrtime) then call ESMF_TimeGet(dcurrtime, timeString=dtimestring, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call ESMF_TimeGet(mcurrtime, timeString=mtimestring, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call ESMF_LogWrite(subname//" ERROR in time consistency; "//trim(dtimestring)//" ne "//trim(mtimestring), & - ESMF_LOGMSG_ERROR, rc=dbrc) + ESMF_LOGMSG_ERROR, rc=dbrc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out rc=ESMF_Failure endif @@ -2195,30 +2195,30 @@ subroutine ModelSetRunClock(gcomp, rc) if (alarmCount == 0) then call ESMF_ClockGetAlarmList(dclock, alarmlistflag=ESMF_ALARMLIST_ALL, alarmCount=alarmCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out allocate(alarmList(alarmCount)) call ESMF_ClockGetAlarmList(dclock, alarmlistflag=ESMF_ALARMLIST_ALL, alarmList=alarmList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out do n = 1, alarmCount - ! call ESMF_AlarmPrint(alarmList(n), rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - dalarm = ESMF_AlarmCreate(alarmList(n), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_AlarmSet(dalarm, clock=mclock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! call ESMF_AlarmPrint(alarmList(n), rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + dalarm = ESMF_AlarmCreate(alarmList(n), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_AlarmSet(dalarm, clock=mclock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out enddo deallocate(alarmList) @@ -2230,15 +2230,15 @@ subroutine ModelSetRunClock(gcomp, rc) call ESMF_ClockAdvance(mclock,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out end subroutine ModelSetRunClock @@ -2308,29 +2308,29 @@ end subroutine ocean_model_finalize ! get forcing data from data_overide subroutine ice_ocn_bnd_from_data(x, Time, Time_step_coupled) - type (ice_ocean_boundary_type) :: x - type(Time_type), intent(in) :: Time, Time_step_coupled - - type(Time_type) :: Time_next - character(len=*),parameter :: subname='(mom_cap:ice_ocn_bnd_from_data)' - - Time_next = Time + Time_step_coupled - - !call data_override('OCN', 't_flux', x%t_flux , Time_next) - !call data_override('OCN', 'u_flux', x%u_flux , Time_next) - !call data_override('OCN', 'v_flux', x%v_flux , Time_next) - !call data_override('OCN', 'q_flux', x%q_flux , Time_next) - !call data_override('OCN', 'salt_flux', x%salt_flux , Time_next) - !call data_override('OCN', 'lw_flux', x%lw_flux , Time_next) - !call data_override('OCN', 'sw_flux_vis_dir', x%sw_flux_vis_dir, Time_next) - !call data_override('OCN', 'sw_flux_vis_dif', x%sw_flux_vis_dif, Time_next) - !call data_override('OCN', 'sw_flux_nir_dir', x%sw_flux_nir_dir, Time_next) - !call data_override('OCN', 'sw_flux_nir_dif', x%sw_flux_nir_dif, Time_next) - !call data_override('OCN', 'lprec', x%lprec , Time_next) - !call data_override('OCN', 'fprec', x%fprec , Time_next) - !call data_override('OCN', 'runoff', x%runoff , Time_next) - !call data_override('OCN', 'calving', x%calving , Time_next) - !call data_override('OCN', 'p', x%p , Time_next) + type (ice_ocean_boundary_type) :: x + type(Time_type), intent(in) :: Time, Time_step_coupled + + type(Time_type) :: Time_next + character(len=*),parameter :: subname='(mom_cap:ice_ocn_bnd_from_data)' + + Time_next = Time + Time_step_coupled + + !call data_override('OCN', 't_flux', x%t_flux , Time_next) + !call data_override('OCN', 'u_flux', x%u_flux , Time_next) + !call data_override('OCN', 'v_flux', x%v_flux , Time_next) + !call data_override('OCN', 'q_flux', x%q_flux , Time_next) + !call data_override('OCN', 'salt_flux', x%salt_flux , Time_next) + !call data_override('OCN', 'lw_flux', x%lw_flux , Time_next) + !call data_override('OCN', 'sw_flux_vis_dir', x%sw_flux_vis_dir, Time_next) + !call data_override('OCN', 'sw_flux_vis_dif', x%sw_flux_vis_dif, Time_next) + !call data_override('OCN', 'sw_flux_nir_dir', x%sw_flux_nir_dir, Time_next) + !call data_override('OCN', 'sw_flux_nir_dif', x%sw_flux_nir_dif, Time_next) + !call data_override('OCN', 'lprec', x%lprec , Time_next) + !call data_override('OCN', 'fprec', x%fprec , Time_next) + !call data_override('OCN', 'runoff', x%runoff , Time_next) + !call data_override('OCN', 'calving', x%calving , Time_next) + !call data_override('OCN', 'p', x%p , Time_next) end subroutine ice_ocn_bnd_from_data diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 942570cb45..d6bb747feb 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -71,55 +71,55 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) call State_getFldPtr(exportState,"So_omask", dataPtr_omask, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(exportState,"So_t", dataPtr_t, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(exportState,"So_s", dataPtr_s, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(exportState,"So_u", dataPtr_u, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(exportState,"So_v", dataPtr_v, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(exportState,"Fioo_q", dataPtr_q, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(exportState,"So_dhdx", dataPtr_dhdx, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(exportState,"So_dhdy", dataPtr_dhdy, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !TODO: need to add the So_bldepth since this is needed for the wave model call State_getFldPtr(exportState,"So_bldepth", dataPtr_bldepth, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(exportState,"So_fswpen", dataPtr_fswpen, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! call State_getFldPtr(exportState,"So_roce_16O", dataPtr_roce_16O, rc=rc) ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & ! line=__LINE__, & @@ -152,33 +152,33 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) !The mask comes from "grid" that uses the usual MOM domain that has halos !and does not use global indexing. do j = jsc, jec - j1 = j + lbnd2 - jsc - jg = j + grid%jsc - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + grid%isc - isc - dataPtr_omask(i1,j1) = grid%mask2dT(ig,jg) - dataPtr_t(i1,j1) = ocean_public%t_surf(i,j) * grid%mask2dT(ig,jg) ! surface temp is in K - dataPtr_s(i1,j1) = ocean_public%s_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_u(i1,j1) = ocean_public%u_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_v(i1,j1) = ocean_public%v_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_q(i1,j1) = 0. - dataPtr_bldepth(i1,j1) = 0. ! TODO: this needs to be generalized - !dataPtr_u(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%u_surf(i,j) & - ! - grid%sin_rot(ig,jg) * ocean_public%v_surf(i,j)) * grid%mask2dT(ig,jg) - !dataPtr_v(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%v_surf(i,j) & - ! + grid%sin_rot(ig,jg) * ocean_public%u_surf(i,j)) * grid%mask2dT(ig,jg) - end do + j1 = j + lbnd2 - jsc + jg = j + grid%jsc - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + ig = i + grid%isc - isc + dataPtr_omask(i1,j1) = grid%mask2dT(ig,jg) + dataPtr_t(i1,j1) = ocean_public%t_surf(i,j) * grid%mask2dT(ig,jg) ! surface temp is in K + dataPtr_s(i1,j1) = ocean_public%s_surf(i,j) * grid%mask2dT(ig,jg) + dataPtr_u(i1,j1) = ocean_public%u_surf(i,j) * grid%mask2dT(ig,jg) + dataPtr_v(i1,j1) = ocean_public%v_surf(i,j) * grid%mask2dT(ig,jg) + dataPtr_q(i1,j1) = 0. + dataPtr_bldepth(i1,j1) = 0. ! TODO: this needs to be generalized + !dataPtr_u(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%u_surf(i,j) & + ! - grid%sin_rot(ig,jg) * ocean_public%v_surf(i,j)) * grid%mask2dT(ig,jg) + !dataPtr_v(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%v_surf(i,j) & + ! + grid%sin_rot(ig,jg) * ocean_public%u_surf(i,j)) * grid%mask2dT(ig,jg) + end do end do ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain ! in order to update halos. i.e. does not use global indexing. do j=grid%jsc, grid%jec - jg = j + grid%jdg_offset - do i=grid%isc,grid%iec - ig = i + grid%idg_offset - ssh(i,j) = ocean_public%sea_lev(ig,jg) - end do + jg = j + grid%jdg_offset + do i=grid%isc,grid%iec + ig = i + grid%idg_offset + ssh(i,j) = ocean_public%sea_lev(ig,jg) + end do end do ! Update halo of ssh so we can calculate gradients @@ -186,85 +186,85 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) ! d/dx ssh do jg = jsc, jec - j = jg + grid%jsc - jsc - j1 = jg + lbnd2 - jsc - do ig = isc,iec - i = ig + grid%isc - isc - i1 = ig + lbnd1 - isc - - ! This is a simple second-order difference - !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(ig,jg) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(i-1,j) - if (grid%mask2dCu(i-1,j)==0.) slp_L = 0. - slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(i,j) - if (grid%mask2dCu(i+1,j)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - if ( (slp_L * slp_R) > 0.0 ) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - dataPtr_dhdx(i1,j1) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) dataPtr_dhdx(i1,j1) = 0.0 - end do + j = jg + grid%jsc - jsc + j1 = jg + lbnd2 - jsc + do ig = isc,iec + i = ig + grid%isc - isc + i1 = ig + lbnd1 - isc + + ! This is a simple second-order difference + !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(ig,jg) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(i-1,j) + if (grid%mask2dCu(i-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(i,j) + if (grid%mask2dCu(i+1,j)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + if ( (slp_L * slp_R) > 0.0 ) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + dataPtr_dhdx(i1,j1) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) dataPtr_dhdx(i1,j1) = 0.0 + end do end do ! d/dy ssh do jg = jsc, jec - j = jg + grid%jsc - jsc - j1 = jg + lbnd2 - jsc - do ig = isc,iec - i = ig + grid%isc - isc - i1 = ig + lbnd1 - isc - - ! This is a simple second-order difference - !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(ig,jg) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,j-1) - if (grid%mask2dCv(i,j-1)==0.) slp_L = 0. - slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,j) - if (grid%mask2dCv(i,j+1)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R - if ((slp_L * slp_R) > 0.0) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - dataPtr_dhdy(i1,j1) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) dataPtr_dhdy(i1,j1) = 0.0 - end do + j = jg + grid%jsc - jsc + j1 = jg + lbnd2 - jsc + do ig = isc,iec + i = ig + grid%isc - isc + i1 = ig + lbnd1 - isc + + ! This is a simple second-order difference + !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(ig,jg) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,j-1) + if (grid%mask2dCv(i,j-1)==0.) slp_L = 0. + slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,j) + if (grid%mask2dCv(i,j+1)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R + if ((slp_L * slp_R) > 0.0) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + dataPtr_dhdy(i1,j1) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) dataPtr_dhdy(i1,j1) = 0.0 + end do end do if (debug .and. is_root_pe()) then - call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) - call ESMF_TimeGet(CurrTime, d=day, s=secs, rc=rc) - - do j = jsc, jec - j1 = j + lbnd2 - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - write(logunit,F01)'export: day, secs, j, i, t_surf = ',day,secs,j,i,dataPtr_t(i1,j1) - write(logunit,F01)'export: day, secs, j, i, s_surf = ',day,secs,j,i,dataPtr_s(i1,j1) - write(logunit,F01)'export: day, secs, j, i, u_surf = ',day,secs,j,i,dataPtr_u(i1,j1) - write(logunit,F01)'export: day, secs, j, i, v_surf = ',day,secs,j,i,dataPtr_v(i1,j1) - write(logunit,F01)'export: day, secs, j, i, dhdx = ',day,secs,j,i,dataPtr_dhdx(i1,j1) - write(logunit,F01)'export: day, secs, j, i, dhdy = ',day,secs,j,i,dataPtr_dhdy(i1,j1) - end do - end do + call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) + call ESMF_TimeGet(CurrTime, d=day, s=secs, rc=rc) + + do j = jsc, jec + j1 = j + lbnd2 - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + write(logunit,F01)'export: day, secs, j, i, t_surf = ',day,secs,j,i,dataPtr_t(i1,j1) + write(logunit,F01)'export: day, secs, j, i, s_surf = ',day,secs,j,i,dataPtr_s(i1,j1) + write(logunit,F01)'export: day, secs, j, i, u_surf = ',day,secs,j,i,dataPtr_u(i1,j1) + write(logunit,F01)'export: day, secs, j, i, v_surf = ',day,secs,j,i,dataPtr_v(i1,j1) + write(logunit,F01)'export: day, secs, j, i, dhdx = ',day,secs,j,i,dataPtr_dhdx(i1,j1) + write(logunit,F01)'export: day, secs, j, i, dhdy = ',day,secs,j,i,dataPtr_dhdy(i1,j1) + end do + end do end if end subroutine mom_export @@ -338,19 +338,19 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & call State_getFldPtr(importState,'Sa_pslv', dataPtr_p,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,'Si_ifrac', dataPtr_ifrac,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"So_duu10n", dataPtr_duu10n, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! call State_getFldPtr(importState,"Sa_co2prog", dataPtr_co2prog, rc=rc) ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & ! line=__LINE__, & @@ -363,124 +363,124 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & ! return ! bail out call State_getFldPtr(importState,"Sw_lamult", dataPtr_lamult, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Sw_ustokes", dataPtr_ustokes, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Sw_vstokes", dataPtr_vstokes, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Faxa_swndr" , dataPtr_swndr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Faxa_swndf" , dataPtr_swndf, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Faxa_swvdr" , dataPtr_swvdr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Faxa_swvdf" , dataPtr_swvdf, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Foxx_taux" , dataPtr_taux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Foxx_tauy" , dataPtr_tauy, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Foxx_sen" , dataPtr_sen, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Foxx_lat" , dataPtr_lat, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Foxx_evap" , dataPtr_evap, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Fioi_salt" , dataPtr_osalt, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Faxa_lwdn" , dataPtr_lwdn, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Foxx_lwup" , dataPtr_lwup, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Foxx_swnet", dataPtr_swnet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Foxx_rofl" , dataPtr_rofl, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Foxx_rofi" , dataPtr_rofi, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Fioi_meltw", dataPtr_meltw, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Fioi_melth", dataPtr_melth, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Fioi_salt" , dataPtr_iosalt, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Faxa_prec" , dataPtr_prec, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Faxa_rain" , dataPtr_rain, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call State_getFldPtr(importState,"Faxa_snow" , dataPtr_snow, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out lbnd1 = lbound(dataPtr_p,1) ubnd1 = ubound(dataPtr_p,1) @@ -490,67 +490,67 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) if ((trim(runtype) == 'initial' .and. import_cnt <= 2)) then - ! This will skip the first time import information is given - do_import = .false. + ! This will skip the first time import information is given + do_import = .false. else - do_import = .true. + do_import = .true. end if if (do_import) then - do j = jsc, jec - j1 = j + lbnd2 - jsc - jg = j + grid%jsc - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + grid%jsc - isc - - ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) - ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) - ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) - ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) - ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) - ice_ocean_boundary%t_flux(i,j) = -dataPtr_sen(i1,j1) - ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) - ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1) - ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(i1,j1) - ice_ocean_boundary%salt_flux(i,j) = dataPtr_iosalt(i1,j1) - ice_ocean_boundary%runoff(i,j) = dataPtr_rofl(i1,j1) + dataPtr_rofi(i1,j1) - !ice_ocean_boundary%salt_flux(i,j) = dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j) - !ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(i1,j1) - !ice_ocean_boundary%u_flux(i,j) = GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1) - !ice_ocean_boundary%v_flux(i,j) = GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1) - enddo - enddo + do j = jsc, jec + j1 = j + lbnd2 - jsc + jg = j + grid%jsc - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + ig = i + grid%jsc - isc + + ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) + ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) + ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) + ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) + ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) + ice_ocean_boundary%t_flux(i,j) = -dataPtr_sen(i1,j1) + ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) + ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1) + ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(i1,j1) + ice_ocean_boundary%salt_flux(i,j) = dataPtr_iosalt(i1,j1) + ice_ocean_boundary%runoff(i,j) = dataPtr_rofl(i1,j1) + dataPtr_rofi(i1,j1) + !ice_ocean_boundary%salt_flux(i,j) = dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j) + !ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(i1,j1) + !ice_ocean_boundary%u_flux(i,j) = GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1) + !ice_ocean_boundary%v_flux(i,j) = GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1) + enddo + enddo end if ! debug output if (do_import .and. debug .and. is_root_pe()) then - call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) - call ESMF_TimeGet(CurrTime, d=day, s=secs, rc=rc) - - i0 = GRID%isc - isc - j0 = GRID%jsc - jsc - do j = GRID%jsc, GRID%jec - do i = GRID%isc, GRID%iec - write(logunit,F01)'import: day, secs, j, i, u_flux = ',day,secs,j,i,ice_ocean_boundary%u_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, v_flux = ',day,secs,j,i,ice_ocean_boundary%v_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, lprec = ',day,secs,j,i,ice_ocean_boundary%lprec(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, lwrad = ',day,secs,j,i,ice_ocean_boundary%lw_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, q_flux = ',day,secs,j,i,ice_ocean_boundary%q_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, t_flux = ',day,secs,j,i,ice_ocean_boundary%t_flux(i-i0,j-j0) - !write(logunit,F01)'import: day, secs, j, i, latent_flux = ',day,secs,j,i,ice_ocean_boundary%latent_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, runoff = ',day,secs,j,i,ice_ocean_boundary%runoff(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, psurf = ',day,secs,j,i,ice_ocean_boundary%p(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, salt_flux = ',day,secs,j,i,ice_ocean_boundary%salt_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dir = ',day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dir(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dif = ',day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dif(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dir = ',day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dif = ',day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i-i0,j-j0) - end do - end do + call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) + call ESMF_TimeGet(CurrTime, d=day, s=secs, rc=rc) + + i0 = GRID%isc - isc + j0 = GRID%jsc - jsc + do j = GRID%jsc, GRID%jec + do i = GRID%isc, GRID%iec + write(logunit,F01)'import: day, secs, j, i, u_flux = ',day,secs,j,i,ice_ocean_boundary%u_flux(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, v_flux = ',day,secs,j,i,ice_ocean_boundary%v_flux(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, lprec = ',day,secs,j,i,ice_ocean_boundary%lprec(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, lwrad = ',day,secs,j,i,ice_ocean_boundary%lw_flux(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, q_flux = ',day,secs,j,i,ice_ocean_boundary%q_flux(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, t_flux = ',day,secs,j,i,ice_ocean_boundary%t_flux(i-i0,j-j0) + !write(logunit,F01)'import: day, secs, j, i, latent_flux = ',day,secs,j,i,ice_ocean_boundary%latent_flux(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, runoff = ',day,secs,j,i,ice_ocean_boundary%runoff(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, psurf = ',day,secs,j,i,ice_ocean_boundary%p(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, salt_flux = ',day,secs,j,i,ice_ocean_boundary%salt_flux(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dir = ',day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dir(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dif = ',day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dif(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dir = ',day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dif = ',day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i-i0,j-j0) + end do + end do end if end subroutine mom_import @@ -570,14 +570,14 @@ subroutine State_GetFldPtr(ST, fldname, fldptr, rc) call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out if (present(rc)) rc = lrc diff --git a/config_src/nuopc_driver/time_utils.F90 b/config_src/nuopc_driver/time_utils.F90 index f704304e02..f009a72e8e 100644 --- a/config_src/nuopc_driver/time_utils.F90 +++ b/config_src/nuopc_driver/time_utils.F90 @@ -37,18 +37,18 @@ function fms2esmf_cal_c(calendar) select case( uppercase(trim(calendar)) ) case( 'GREGORIAN' ) - fms2esmf_cal_c = ESMF_CALKIND_GREGORIAN + fms2esmf_cal_c = ESMF_CALKIND_GREGORIAN case( 'JULIAN' ) - fms2esmf_cal_c = ESMF_CALKIND_JULIAN + fms2esmf_cal_c = ESMF_CALKIND_JULIAN case( 'NOLEAP' ) - fms2esmf_cal_c = ESMF_CALKIND_NOLEAP + fms2esmf_cal_c = ESMF_CALKIND_NOLEAP case( 'THIRTY_DAY' ) - fms2esmf_cal_c = ESMF_CALKIND_360DAY + fms2esmf_cal_c = ESMF_CALKIND_360DAY case( 'NO_CALENDAR' ) - fms2esmf_cal_c = ESMF_CALKIND_NOCALENDAR + fms2esmf_cal_c = ESMF_CALKIND_NOCALENDAR case default - call mpp_error(FATAL, & - 'ocean_solo: ocean_solo_nml entry calendar must be one of GREGORIAN|JULIAN|NOLEAP|THIRTY_DAY|NO_CALENDAR.' ) + call mpp_error(FATAL, & + 'ocean_solo: ocean_solo_nml entry calendar must be one of GREGORIAN|JULIAN|NOLEAP|THIRTY_DAY|NO_CALENDAR.' ) end select end function fms2esmf_cal_c From ad1a2957d8910cae9db99a9f249fd2391cee81ef Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 17 Jul 2018 11:55:49 -0600 Subject: [PATCH 0603/1072] limit line widths to 120 chars --- config_src/mct_driver/ocn_cap_methods.F90 | 24 ++- config_src/mct_driver/ocn_comp_mct.F90 | 4 +- config_src/mct_driver/ocn_cpl_indices.F90 | 3 +- config_src/nuopc_driver/mom_cap.F90 | 224 ++++++++++++-------- config_src/nuopc_driver/mom_cap_methods.F90 | 48 +++-- 5 files changed, 193 insertions(+), 110 deletions(-) diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 8df3e8b7f1..ccee291eb9 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -115,14 +115,22 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, write(logunit,F01)'import: day, secs, j, i, lwrad = ',day,secs,j,i,ice_ocean_boundary%lw_flux(i,j) write(logunit,F01)'import: day, secs, j, i, q_flux = ',day,secs,j,i,ice_ocean_boundary%q_flux(i,j) write(logunit,F01)'import: day, secs, j, i, t_flux = ',day,secs,j,i,ice_ocean_boundary%t_flux(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 = ',day,secs,j,i,ice_ocean_boundary%p(i,j) - write(logunit,F01)'import: day, secs, j, i, salt_flux = ',day,secs,j,i,ice_ocean_boundary%salt_flux(i,j) - write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dir = ',day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dir(i,j) - write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dif = ',day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dif(i,j) - write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dir = ',day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i,j) - write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dif = ',day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(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 = ',& + day,secs,j,i,ice_ocean_boundary%p(i,j) + write(logunit,F01)'import: day, secs, j, i, salt_flux = ',& + day,secs,j,i,ice_ocean_boundary%salt_flux(i,j) + write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dir = ',& + day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dir(i,j) + write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dif = ',& + day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dif(i,j) + write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dir = ',& + day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i,j) + write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dif = ',& + day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i,j) end do end do end if diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index f97c9d1747..81aee619c6 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -88,9 +88,9 @@ module ocn_comp_mct type(ocean_grid_type), pointer :: grid => NULL() !< The grid structure type(seq_infodata_type), pointer :: infodata !< The input info type type(cpl_indices_type) :: ind !< Variable IDs - logical :: sw_decomp !< Controls whether shortwave is decomposed into four components + logical :: sw_decomp !< Controls whether shortwave is decomposed into 4 components real :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition i/o - integer :: stdout !< standard output unit. (by default, it should point to ocn.log.* file) + integer :: stdout !< standard output unit. (by default, points to ocn.log.* ) character(len=384) :: pointer_filename !< Name of the ascii file that contains the path !! and filename of the latest restart file. end type MCT_MOM_Data diff --git a/config_src/mct_driver/ocn_cpl_indices.F90 b/config_src/mct_driver/ocn_cpl_indices.F90 index 4ea12eb8cc..4bd9c1f383 100644 --- a/config_src/mct_driver/ocn_cpl_indices.F90 +++ b/config_src/mct_driver/ocn_cpl_indices.F90 @@ -69,7 +69,8 @@ module ocn_cpl_indices ! optional per thickness category fields integer, dimension(:), allocatable :: x2o_frac_col !< Fraction of ocean cell, per column - integer, dimension(:), allocatable :: x2o_fracr_col !< Fraction of ocean cell used in radiation computations, per column + integer, dimension(:), allocatable :: x2o_fracr_col !< Fraction of ocean cell used in radiation computations, + !! per column integer, dimension(:), allocatable :: x2o_qsw_fracr_col !< qsw * fracr, per column end type cpl_indices_type diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index ddc6bc1a18..fdaa4ccd11 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -49,7 +49,8 @@ !! system, and some during finalization of the coupled system. The initialization !! sequence is the most complex and is governed by the NUOPC technical rules. !! Details about the initialization sequence can be found in the [NUOPC Reference Manual] -!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html#SECTION00034000000000000000). +!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html +!! #SECTION00034000000000000000). !! !! A particularly important part of the NUOPC intialization sequence is to establish !! field connections between models. Simply put, a field connection is established @@ -61,7 +62,8 @@ !! quantities, NUOPC relies on a set of standard names and a built-in, extensible !! standard name dictionary to match fields between models. More information about !! the use of standard names can be found in the [NUOPC Reference Manual] -!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html#SECTION00032000000000000000). +!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html +!! #SECTION00032000000000000000). !! !! Two key initialization phases that appear in every NUOPC cap, including this MOM !! cap are the field "advertise" and field "realize" phases. *Advertise* is a special @@ -88,10 +90,14 @@ !! initialization, run, or finalize part of the coupled system run. !! !! Phase | MOM Cap Subroutine | Description -!! ---------|--------------------------------------------------------------------|------------------------------------------------------------- -!! Init | [InitializeP0] (@ref mom_cap_mod::initializep0) | Sets the Initialize Phase Definition (IPD) version to use -!! Init | [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) | Advertises standard names of import and export fields -!! Init | [InitializeRealize] (@ref mom_cap_mod::initializerealize) | Creates an ESMF_Grid for the MOM grid as well as ESMF_Fields for import and export fields +!! ---------|--------------------------------------------------------------------|-------------------------------------- +!! Init | [InitializeP0] (@ref mom_cap_mod::initializep0) | Sets the Initialize Phase Definition +!! | (IPD) version to use +!! Init | [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) | Advertises standard names of import +!! | and export fields +!! Init | [InitializeRealize] (@ref mom_cap_mod::initializerealize) | Creates an ESMF_Grid for the MOM grid +!! | as well as ESMF_Fields for import +!! | and export fields !! Run | [ModelAdvance] (@ref mom_cap_mod::modeladvance) | Advances the model by a timestep !! Final | [Finalize] (@ref mom_cap_mod::ocean_model_finalize) | Cleans up !! @@ -142,7 +148,7 @@ !! call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_public, Time, Time_step_coupled) !! !! Prior to this call, the cap performs a few steps: -!! - the `Time` and `Time_step_coupled` parameters, which are based on FMS types, are derived from the incoming ESMF clock +!! - the `Time` and `Time_step_coupled` parameters, based on FMS types, are derived from the incoming ESMF clock !! - there are calls to two stubs: `ice_ocn_bnd_from_data()` and `external_coupler_sbc_before()` - these are currently !! inactive, but may be modified to read in import data from file or from an external coupler !! - diagnostics are optionally written to files `field_ocn_import_*`, one for each import field @@ -156,7 +162,8 @@ !! - the `freezing_melting_potential` export is converted from J m-2 to W m-2 by dividing by the coupling interval !! - vector rotations are applied to the `ocean_current_zonal` and `ocean_current_merid` exports, back to lat-lon grid !! - diagnostics are optionally written to files `field_ocn_export_*`, one for each export field -!! - a call is made to `external_coupler_sbc_after()` to update exports from an external coupler (currently an inactive stub) +!! - a call is made to `external_coupler_sbc_after()` to update exports from an external coupler (currently an inactive +!! stub) !! !! @subsubsection VectorRotations Vector Rotations !! @@ -217,26 +224,28 @@ !! !! @subsection ImportFields Import Fields !! -!! Standard Name | Units | Model Variable | Description | Notes -!! ----------------------------------|------------|-----------------|-----------------------------------------------|-------------------------------------- -!! inst_pres_height_surface | Pa | p | pressure of overlying sea ice and atmosphere | | -!! mass_of_overlying_sea_ice | kg | mi | mass of overlying sea ice | | -!! mean_calving_heat_flx | W m-2 | calving_hflx | heat flux, relative to 0C, of frozen land water into ocean | | -!! mean_calving_rate | kg m-2 s-1 | calving | mass flux of frozen runoff | | -!! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | sign reversed (- evap) -!! mean_fprec_rate | kg m-2 s-1 | fprec | mass flux of frozen precip | | -!! mean_merid_moment_flx | Pa | v_flux | j-directed wind stress into ocean | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar -!! mean_net_lw_flx | W m-2 | lw_flux | long wave radiation | | -!! mean_net_sw_ir_dif_flx | W m-2 | sw_flux_nir_dif | diffuse near IR shortwave radiation | | -!! mean_net_sw_ir_dir_flx | W m-2 | sw_flux_nir_dir | direct near IR shortwave radiation | | -!! mean_net_sw_vis_dif_flx | W m-2 | sw_flux_vis_dif | diffuse visible shortware radiation | | -!! mean_net_sw_vis_dir_flx | W m-2 | sw_flux_vis_dir | direct visible shortware radiation | | -!! mean_prec_rate | kg m-2 s-1 | lprec | mass flux of liquid precip | | -!! mean_runoff_heat_flx | W m-2 | runoff_hflx | heat flux, relative to 0C, of liquid land water into ocean | | -!! mean_runoff_rate | kg m-2 s-1 | runoff | mass flux of liquid runoff | | -!! mean_salt_rate | kg m-2 s-1 | salt_flux | salt flux | | -!! mean_sensi_heat_flx | W m-2 | t_flux | sensible heat flux into ocean | sign reversed (- sensi) -!! mean_zonal_moment_flx | Pa | u_flux | j-directed wind stress into ocean | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar +!! Standard Name | Units | Model Variable | Description | Notes +!! --------------------------|------------|-----------------|---------------------------------------|------------------- +!! inst_pres_height_surface | Pa | p | pressure of overlying sea ice and atmosphere +!! mass_of_overlying_sea_ice | kg | mi | mass of overlying sea ice | | +!! mean_calving_heat_flx | W m-2 | calving_hflx | heat flux, relative to 0C, of frozen land water into ocean +!! mean_calving_rate | kg m-2 s-1 | calving | mass flux of frozen runoff | | +!! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | sign reversed (- evap) +!! mean_fprec_rate | kg m-2 s-1 | fprec | mass flux of frozen precip | | +!! mean_merid_moment_flx | Pa | v_flux | j-directed wind stress into ocean +!! | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar +!! mean_net_lw_flx | W m-2 | lw_flux | long wave radiation | | +!! mean_net_sw_ir_dif_flx | W m-2 | sw_flux_nir_dif | diffuse near IR shortwave radiation| | +!! mean_net_sw_ir_dir_flx | W m-2 | sw_flux_nir_dir | direct near IR shortwave radiation| | +!! mean_net_sw_vis_dif_flx | W m-2 | sw_flux_vis_dif | diffuse visible shortware radiation| | +!! mean_net_sw_vis_dir_flx | W m-2 | sw_flux_vis_dir | direct visible shortware radiation| | +!! mean_prec_rate | kg m-2 s-1 | lprec | mass flux of liquid precip | | +!! mean_runoff_heat_flx | W m-2 | runoff_hflx | heat flux, relative to 0C, of liquid land water into ocean +!! mean_runoff_rate | kg m-2 s-1 | runoff | mass flux of liquid runoff | | +!! mean_salt_rate | kg m-2 s-1 | salt_flux | salt flux | | +!! mean_sensi_heat_flx | W m-2 | t_flux | sensible heat flux into ocean | sign reversed (- sensi) +!! mean_zonal_moment_flx | Pa | u_flux | j-directed wind stress into ocean +!! | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar !! !! !! @subsection ExportField Export Fields @@ -244,15 +253,19 @@ !! Export fields are populated from the `ocean_public` parameter (type `ocean_public_type`) !! after the call to `update_ocean_model()`. !! -!! Standard Name | Units | Model Variable | Description | Notes -!! ----------------------------------|------------|-----------------|-------------------------------------------|--------------------------------------------------------------------- -!! freezing_melting_potential | W m-2 | frazil | accumulated heating from frazil formation | cap converts model units (J m-2) to (W m-2) for export -!! ocean_mask | | | ocean mask | | -!! ocn_current_merid | m s-1 | v_surf | j-directed surface velocity on u-cell | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon -!! ocn_current_zonal | m s-1 | u_surf | i-directed surface velocity on u-cell | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon -!! s_surf | psu | s_surf | sea surface salinity on t-cell | | -!! sea_lev | m | sea_lev | sea level | model computation is eta_t + patm/(rho0*grav) - eta_geoid - eta_tide -!! sea_surface_temperature | K | t_surf | sea surface temperature on t-cell | | +!! Standard Name | Units | Model Variable | Description | Notes +!! ---------------------------|-------|----------------|-------------------------------------------|-------------------- +!! freezing_melting_potential | W m-2 | frazil | accumulated heating from frazil formation +!! | cap converts model units (J m-2) to (W m-2) for export +!! ocean_mask | | | ocean mask | | +!! ocn_current_merid | m s-1 | v_surf | j-directed surface velocity on u-cell +!! | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon +!! ocn_current_zonal | m s-1 | u_surf | i-directed surface velocity on u-cell +!! | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon +!! s_surf | psu | s_surf | sea surface salinity on t-cell | | +!! sea_lev | m | sea_lev | sea level +!! | model computation is eta_t + patm/(rho0*grav) - eta_geoid - eta_tide +!! sea_surface_temperature | K | t_surf | sea surface temperature on t-cell | | !! !! @subsection MemoryManagement Memory Management !! @@ -685,7 +698,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: shrloglev ! original log level integer :: inst_index ! number of current instance (ie. 1) character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") + character(len=16) :: inst_suffix = "" ! char string associated with instance + ! (ie. "_0001" or "") logical :: isPresent character(len=384) :: restart_pointer_file ! File name for restart pointer file character(len=384) :: restartfile ! Path/Name of restart file @@ -913,35 +927,59 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! instead, create space for the field when it's "realized". !--------- import fields ------------- - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx" , "will provide", data=Ice_ocean_boundary%u_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx" , "will provide", data=Ice_ocean_boundary%v_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide", data=Ice_ocean_boundary%t_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide", data=Ice_ocean_boundary%q_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide", data=Ice_ocean_boundary%salt_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide", data=Ice_ocean_boundary%lw_flux ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_vis_dir) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_vis_dif) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_nir_dir) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide", data=Ice_ocean_boundary%sw_flux_nir_dif) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide", data=Ice_ocean_boundary%lprec ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide", data=Ice_ocean_boundary%fprec ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide", data=Ice_ocean_boundary%runoff ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide", data=Ice_ocean_boundary%calving) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide", data=Ice_ocean_boundary%runoff_hflx ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide", data=Ice_ocean_boundary%calving_hflx) - call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide", data=Ice_ocean_boundary%p ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide", data=Ice_ocean_boundary%mi) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx" , "will provide",& + data=Ice_ocean_boundary%u_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx" , "will provide",& + data=Ice_ocean_boundary%v_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide",& + data=Ice_ocean_boundary%t_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide",& + data=Ice_ocean_boundary%q_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide",& + data=Ice_ocean_boundary%salt_flux) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide",& + data=Ice_ocean_boundary%lw_flux ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide",& + data=Ice_ocean_boundary%sw_flux_vis_dir) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide",& + data=Ice_ocean_boundary%sw_flux_vis_dif) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide",& + data=Ice_ocean_boundary%sw_flux_nir_dir) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide",& + data=Ice_ocean_boundary%sw_flux_nir_dif) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide",& + data=Ice_ocean_boundary%lprec ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide",& + data=Ice_ocean_boundary%fprec ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide",& + data=Ice_ocean_boundary%runoff ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide",& + data=Ice_ocean_boundary%calving) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide",& + data=Ice_ocean_boundary%runoff_hflx ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide",& + data=Ice_ocean_boundary%calving_hflx) + call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide",& + data=Ice_ocean_boundary%p ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide",& + data=Ice_ocean_boundary%mi) !--------- export fields ------------- call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature" , "will provide", data=ocean_public%t_surf) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide", data=ocean_public%s_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide", data=ocean_public%u_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide", data=ocean_public%v_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature" , "will provide",& + data=ocean_public%t_surf) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide",& + data=ocean_public%s_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide",& + data=ocean_public%u_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide",& + data=ocean_public%v_surf ) !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir" , "will provide") !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=ocean_public%sea_lev) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=ocean_public%frazil) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide",& + data=ocean_public%sea_lev) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide",& + data=ocean_public%frazil) do n = 1,fldsToOcn_num call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)(i)%shortname, rc=rc) @@ -1033,7 +1071,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: shrloglev ! original log level integer :: inst_index ! number of current instance (ie. 1) character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") + character(len=16) :: inst_suffix = "" ! char string associated with instance + ! (ie. "_0001" or "") character(len=64) :: cvalue character(len=512) :: diro character(len=512) :: logfile @@ -2008,7 +2047,7 @@ subroutine ModelAdvance(gcomp, rc) enddo deallocate(ocz, ocm) - !call ESMF_LogWrite("Before writing diagnostics", dataPtr_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc)) + !call ESMF_LogWrite("B4 writing diags", dataPtr_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc)) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 j1 = j - lbnd2 + jsc @@ -2073,24 +2112,42 @@ subroutine ModelAdvance(gcomp, rc) !--------- import fields ------------- - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_zonal_moment_flx" , "will provide", Ice_ocean_boundary%u_flux) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_merid_moment_flx" , "will provide", Ice_ocean_boundary%v_flux) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_sensi_heat_flx" , "will provide", Ice_ocean_boundary%t_flux) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_evap_rate" , "will provide", Ice_ocean_boundary%q_flux) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_salt_rate" , "will provide", Ice_ocean_boundary%salt_flux) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_lw_flx" , "will provide", Ice_ocean_boundary%lw_flux ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dir_flx" , "will provide", Ice_ocean_boundary%sw_flux_vis_dir) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dif_flx" , "will provide", Ice_ocean_boundary%sw_flux_vis_dif) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dir_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dir) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dif_flx" , "will provide", Ice_ocean_boundary%sw_flux_nir_dif) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_prec_rate" , "will provide", Ice_ocean_boundary%lprec ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_fprec_rate" , "will provide", Ice_ocean_boundary%fprec ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_rate" , "will provide", Ice_ocean_boundary%runoff ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_rate" , "will provide", Ice_ocean_boundary%calving) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_heat_flx" , "will provide", Ice_ocean_boundary%runoff_hflx ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_heat_flx" , "will provide", Ice_ocean_boundary%calving_hflx) - ! call dumpMomInternal(mom_grid_i, import_slice, "inst_pres_height_surface" , "will provide", Ice_ocean_boundary%p ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mass_of_overlying_sea_ice" , "will provide", Ice_ocean_boundary%mi) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_zonal_moment_flx" , "will provide",& + ! Ice_ocean_boundary%u_flux) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_merid_moment_flx" , "will provide",& + ! Ice_ocean_boundary%v_flux) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_sensi_heat_flx" , "will provide",& + ! Ice_ocean_boundary%t_flux) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_evap_rate" , "will provide",& + ! Ice_ocean_boundary%q_flux) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_salt_rate" , "will provide",& + ! Ice_ocean_boundary%salt_flux) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_lw_flx" , "will provide",& + ! Ice_ocean_boundary%lw_flux ) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dir_flx" , "will provide",& + ! Ice_ocean_boundary%sw_flux_vis_dir) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dif_flx" , "will provide",& + ! Ice_ocean_boundary%sw_flux_vis_dif) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dir_flx" , "will provide",& + ! Ice_ocean_boundary%sw_flux_nir_dir) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dif_flx" , "will provide",& + ! Ice_ocean_boundary%sw_flux_nir_dif) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_prec_rate" , "will provide",& + ! Ice_ocean_boundary%lprec ) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_fprec_rate" , "will provide",& + ! Ice_ocean_boundary%fprec ) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_rate" , "will provide",& + ! Ice_ocean_boundary%runoff ) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_rate" , "will provide",& + ! Ice_ocean_boundary%calving) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_heat_flx" , "will provide",& + ! Ice_ocean_boundary%runoff_hflx ) + ! call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_heat_flx" , "will provide",& + ! Ice_ocean_boundary%calving_hflx) + ! call dumpMomInternal(mom_grid_i, import_slice, "inst_pres_height_surface" , "will provide",& + ! Ice_ocean_boundary%p ) + ! call dumpMomInternal(mom_grid_i, import_slice, "mass_of_overlying_sea_ice" , "will provide",& + ! Ice_ocean_boundary%mi) !--------- export fields ------------- @@ -2527,7 +2584,8 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) file=__FILE__)) & return ! bail out elseif (field_defs(i)%assoc) then - call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected and associated.", & + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname)& + // " is connected and associated.", & ESMF_LOGMSG_INFO, & line=__LINE__, & file=__FILE__, & diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index d6bb747feb..1e88dfc5a4 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -520,8 +520,10 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & ice_ocean_boundary%runoff(i,j) = dataPtr_rofl(i1,j1) + dataPtr_rofi(i1,j1) !ice_ocean_boundary%salt_flux(i,j) = dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j) !ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(i1,j1) - !ice_ocean_boundary%u_flux(i,j) = GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1) - !ice_ocean_boundary%v_flux(i,j) = GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1) + !ice_ocean_boundary%u_flux(i,j) =& + ! GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1) + !ice_ocean_boundary%v_flux(i,j) =& + ! GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1) enddo enddo end if @@ -535,20 +537,34 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & j0 = GRID%jsc - jsc do j = GRID%jsc, GRID%jec do i = GRID%isc, GRID%iec - write(logunit,F01)'import: day, secs, j, i, u_flux = ',day,secs,j,i,ice_ocean_boundary%u_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, v_flux = ',day,secs,j,i,ice_ocean_boundary%v_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, lprec = ',day,secs,j,i,ice_ocean_boundary%lprec(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, lwrad = ',day,secs,j,i,ice_ocean_boundary%lw_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, q_flux = ',day,secs,j,i,ice_ocean_boundary%q_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, t_flux = ',day,secs,j,i,ice_ocean_boundary%t_flux(i-i0,j-j0) - !write(logunit,F01)'import: day, secs, j, i, latent_flux = ',day,secs,j,i,ice_ocean_boundary%latent_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, runoff = ',day,secs,j,i,ice_ocean_boundary%runoff(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, psurf = ',day,secs,j,i,ice_ocean_boundary%p(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, salt_flux = ',day,secs,j,i,ice_ocean_boundary%salt_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dir = ',day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dir(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dif = ',day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dif(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dir = ',day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dif = ',day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, u_flux = '& + ,day,secs,j,i,ice_ocean_boundary%u_flux(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, v_flux = '& + ,day,secs,j,i,ice_ocean_boundary%v_flux(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, lprec = '& + ,day,secs,j,i,ice_ocean_boundary%lprec(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, lwrad = '& + ,day,secs,j,i,ice_ocean_boundary%lw_flux(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, q_flux = '& + ,day,secs,j,i,ice_ocean_boundary%q_flux(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, t_flux = '& + ,day,secs,j,i,ice_ocean_boundary%t_flux(i-i0,j-j0) + !write(logunit,F01)'import: day, secs, j, i, latent_flux = '& + ,day,secs,j,i,ice_ocean_boundary%latent_flux(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, runoff = '& + ,day,secs,j,i,ice_ocean_boundary%runoff(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, psurf = '& + ,day,secs,j,i,ice_ocean_boundary%p(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, salt_flux = '& + ,day,secs,j,i,ice_ocean_boundary%salt_flux(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dir = '& + ,day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dir(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dif = '& + ,day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dif(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dir = '& + ,day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i-i0,j-j0) + write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dif = '& + ,day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i-i0,j-j0) end do end do end if From 290d4f5e42d51c0d23bdf50831b2203ea24a3b94 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 17 Jul 2018 14:31:44 -0600 Subject: [PATCH 0604/1072] add only keywords --- config_src/mct_driver/ocn_cap_methods.F90 | 2 +- config_src/nuopc_driver/mom_cap.F90 | 8 ++++---- config_src/nuopc_driver/mom_cap_methods.F90 | 6 ++++-- 3 files changed, 9 insertions(+), 7 deletions(-) diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index ccee291eb9..587433b4fe 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -1,6 +1,6 @@ module ocn_cap_methods - use ESMF + use ESMF, only: ESMF_clock, ESMF_time, ESMF_ClockGet, ESMF_TimeGet use MOM_ocean_model, only: ocean_public_type, ocean_state_type use MOM_surface_forcing, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index fdaa4ccd11..51f90aef35 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -414,9 +414,9 @@ module mom_cap_mod use shr_file_mod, only: shr_file_setLogUnit, shr_file_setLogLevel #endif - use ESMF - use NUOPC - use NUOPC_Model, & + use ESMF ! TODO: only: ... + use NUOPC ! TODO: only: ... + use NUOPC_Model, & ! TODO: only: ... model_routine_SS => SetServices, & model_label_DataInitialize => label_DataInitialize, & model_label_Advance => label_Advance, & @@ -425,7 +425,7 @@ module mom_cap_mod #endif model_label_Finalize => label_Finalize - use time_utils_mod + use time_utils_mod, only: esmf2fms_time implicit none private diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 1e88dfc5a4..af8013efda 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -4,7 +4,9 @@ module mom_cap_methods ! This file is part of MOM6. See LICENSE.md for the license. ! mct modules - use ESMF + use ESMF, only: ESMF_time, ESMF_ClockGet, ESMF_TimeGet, ESMF_State, ESMF_Clock + use ESMF, only: ESMF_KIND_R8, ESMF_Field, ESMF_SUCCESS, ESMF_LogFoundError + use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_StateGet, ESMF_FieldGet use perf_mod, only: t_startf, t_stopf use MOM_ocean_model, only: ocean_public_type, ocean_state_type use MOM_surface_forcing, only: ice_ocean_boundary_type @@ -550,7 +552,7 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & write(logunit,F01)'import: day, secs, j, i, t_flux = '& ,day,secs,j,i,ice_ocean_boundary%t_flux(i-i0,j-j0) !write(logunit,F01)'import: day, secs, j, i, latent_flux = '& - ,day,secs,j,i,ice_ocean_boundary%latent_flux(i-i0,j-j0) + ! ,day,secs,j,i,ice_ocean_boundary%latent_flux(i-i0,j-j0) write(logunit,F01)'import: day, secs, j, i, runoff = '& ,day,secs,j,i,ice_ocean_boundary%runoff(i-i0,j-j0) write(logunit,F01)'import: day, secs, j, i, psurf = '& From 838de5293681c0d8e16f22d50232a6bc1646f67c Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 17 Jul 2018 14:44:39 -0600 Subject: [PATCH 0605/1072] improve mct cap doxumentation --- config_src/mct_driver/MOM_ocean_model.F90 | 23 ++++++++----------- config_src/mct_driver/MOM_surface_forcing.F90 | 2 ++ config_src/mct_driver/ocn_cap_methods.F90 | 17 +++++++------- config_src/mct_driver/ocn_comp_mct.F90 | 2 +- 4 files changed, 21 insertions(+), 23 deletions(-) diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 78b90ff7bf..c894f42270 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -105,8 +105,8 @@ module MOM_ocean_model 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". +!! 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. @@ -821,19 +821,14 @@ subroutine convert_state_to_ocean_type(state, Ocean_sfc, G, patm, press_to_z) end subroutine convert_state_to_ocean_type -!======================================================================= -! -! -! -! This subroutine extracts the surface properties from the ocean's internal -! state and stores them in the ocean type returned to the calling ice model. -! It has to be separate from the ocean_initialization call because the coupler -! module allocates the space for some of these variables. -! - +!> 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 - type(ocean_public_type), intent(inout) :: 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 integer :: is, ie, js, je diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 07bf80d54a..5c4a43bfc0 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -760,6 +760,7 @@ 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 @@ -1277,6 +1278,7 @@ end subroutine surface_forcing_init !======================================================================= +!> Finalizes surface forcing: deallocate surface forcing control structure subroutine surface_forcing_end(CS, fluxes) type(surface_forcing_CS), pointer :: CS type(forcing), optional, intent(inout) :: fluxes diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 587433b4fe..cc214306f0 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -21,15 +21,16 @@ module ocn_cap_methods contains !======================================================================= + !> Maps incomping ocean data to MOM6 data structures subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, Eclock, c1, c2, c3, c4) - real(kind=8) , intent(in) :: x2o(:,:) ! incoming data - type(cpl_indices_type) , intent(in) :: ind ! Structure with MCT attribute vects and indices - type(ocean_grid_type) , intent(in) :: grid ! Ocean model grid - type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary ! Ocean boundary forcing - type(ocean_public_type) , intent(in) :: ocean_public ! Ocean surface state - integer , intent(in) :: logunit ! Unit for stdout output - type(ESMF_Clock) , intent(in) :: EClock ! Time and time step ? \todo Why must this - real(kind=8), optional , intent(in) :: c1, c2, c3, c4 ! Coeffs. used in the shortwave decomposition + real(kind=8) , intent(in) :: x2o(:,:) !< incoming data + type(cpl_indices_type) , intent(in) :: ind !< Structure with MCT attribute vects and indices + type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid + type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing + type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state + integer , intent(in) :: logunit !< Unit for stdout output + type(ESMF_Clock) , intent(in) :: EClock !< Time and time step ? \todo Why must this + real(kind=8), optional , intent(in) :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition ! Local variables integer :: i, j, ig, jg, isc, iec, jsc, jec ! Grid indices diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 81aee619c6..63a24b153d 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -723,7 +723,7 @@ end subroutine ocn_domain_mct !======================================================================= -!! It has to be separate from the ocean_initialization call because the coupler +!> 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 From 116fdfba4c8526a7b231e73d9b0cbb8ab0fefc6e Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 17 Jul 2018 15:41:00 -0600 Subject: [PATCH 0606/1072] rm trailing spaces --- config_src/nuopc_driver/mom_cap.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 51f90aef35..b14c947fca 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -93,10 +93,10 @@ !! ---------|--------------------------------------------------------------------|-------------------------------------- !! Init | [InitializeP0] (@ref mom_cap_mod::initializep0) | Sets the Initialize Phase Definition !! | (IPD) version to use -!! Init | [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) | Advertises standard names of import +!! Init | [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) | Advertises standard names of import !! | and export fields !! Init | [InitializeRealize] (@ref mom_cap_mod::initializerealize) | Creates an ESMF_Grid for the MOM grid -!! | as well as ESMF_Fields for import +!! | as well as ESMF_Fields for import !! | and export fields !! Run | [ModelAdvance] (@ref mom_cap_mod::modeladvance) | Advances the model by a timestep !! Final | [Finalize] (@ref mom_cap_mod::ocean_model_finalize) | Cleans up @@ -232,7 +232,7 @@ !! mean_calving_rate | kg m-2 s-1 | calving | mass flux of frozen runoff | | !! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | sign reversed (- evap) !! mean_fprec_rate | kg m-2 s-1 | fprec | mass flux of frozen precip | | -!! mean_merid_moment_flx | Pa | v_flux | j-directed wind stress into ocean +!! mean_merid_moment_flx | Pa | v_flux | j-directed wind stress into ocean !! | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar !! mean_net_lw_flx | W m-2 | lw_flux | long wave radiation | | !! mean_net_sw_ir_dif_flx | W m-2 | sw_flux_nir_dif | diffuse near IR shortwave radiation| | @@ -255,15 +255,15 @@ !! !! Standard Name | Units | Model Variable | Description | Notes !! ---------------------------|-------|----------------|-------------------------------------------|-------------------- -!! freezing_melting_potential | W m-2 | frazil | accumulated heating from frazil formation +!! freezing_melting_potential | W m-2 | frazil | accumulated heating from frazil formation !! | cap converts model units (J m-2) to (W m-2) for export !! ocean_mask | | | ocean mask | | -!! ocn_current_merid | m s-1 | v_surf | j-directed surface velocity on u-cell +!! ocn_current_merid | m s-1 | v_surf | j-directed surface velocity on u-cell !! | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon -!! ocn_current_zonal | m s-1 | u_surf | i-directed surface velocity on u-cell +!! ocn_current_zonal | m s-1 | u_surf | i-directed surface velocity on u-cell !! | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon !! s_surf | psu | s_surf | sea surface salinity on t-cell | | -!! sea_lev | m | sea_lev | sea level +!! sea_lev | m | sea_lev | sea level !! | model computation is eta_t + patm/(rho0*grav) - eta_geoid - eta_tide !! sea_surface_temperature | K | t_surf | sea surface temperature on t-cell | | !! From 12410a1ec688b88fb34bf2e6b3c39eaa3e315397 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 18 Jul 2018 16:15:58 -0800 Subject: [PATCH 0607/1072] Fix nudging with oblique OBCs. --- src/core/MOM_open_boundary.F90 | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 3c9343d1c4..259714e984 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1613,7 +1613,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%normal_vel(I,j,k) = u_new(I-1,j,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then - if (dhdt*dhdx < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (dhdt*dhdx <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1733,7 +1734,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%normal_vel(I,j,k) = u_new(I+1,j,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then - if (dhdt*dhdx < 0.0) then + ! dhdt gets set to 0. on inflow in oblique case + if (dhdt*dhdx <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1854,7 +1856,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%normal_vel(i,J,k) = v_new(i,J-1,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then - if (dhdt*dhdy < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (dhdt*dhdx <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1975,7 +1978,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%normal_vel(i,J,k) = v_new(i,J+1,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then - if (dhdt*dhdy < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (dhdt*dhdx <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out From e0ca46b0728d14a7fffd6d661a74c5199a7c310e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 20 Jul 2018 17:47:16 -0400 Subject: [PATCH 0608/1072] +Added stress_mag to ice_ocean_boundary_type Added a new element, stress_mag, with the time-mean of the magnitude of the wind stresses at tracer points, to the ice_ocean_boundary_type. It is not yet being used, so all answers are bitwise identical. --- config_src/coupled_driver/MOM_surface_forcing.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 19a0ddbf86..02b54daefe 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -166,6 +166,7 @@ module MOM_surface_forcing 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(:,:) :: stress_mag =>NULL() !< The time-mean magnitude of the stress on the ocean (Pa) 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) From 25873994d96a33c8a2986627a8d147046c09f784 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Mon, 23 Jul 2018 17:32:37 -0600 Subject: [PATCH 0609/1072] rename mom_cap --- .../{mom_cap.F90 => ocn_comp_nuopc.F90} | 30 +++++++++---------- 1 file changed, 15 insertions(+), 15 deletions(-) rename config_src/nuopc_driver/{mom_cap.F90 => ocn_comp_nuopc.F90} (98%) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/ocn_comp_nuopc.F90 similarity index 98% rename from config_src/nuopc_driver/mom_cap.F90 rename to config_src/nuopc_driver/ocn_comp_nuopc.F90 index b14c947fca..4f484efa82 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/ocn_comp_nuopc.F90 @@ -91,15 +91,15 @@ !! !! Phase | MOM Cap Subroutine | Description !! ---------|--------------------------------------------------------------------|-------------------------------------- -!! Init | [InitializeP0] (@ref mom_cap_mod::initializep0) | Sets the Initialize Phase Definition +!! Init | [InitializeP0] (@ref ocn_comp_nuopc::initializep0) | Sets the Initialize Phase Definition !! | (IPD) version to use -!! Init | [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) | Advertises standard names of import +!! Init | [InitializeAdvertise] (@ref ocn_comp_nuopc::initializeadvertise) | Advertises standard names of import !! | and export fields -!! Init | [InitializeRealize] (@ref mom_cap_mod::initializerealize) | Creates an ESMF_Grid for the MOM grid +!! Init | [InitializeRealize] (@ref ocn_comp_nuopc::initializerealize) | Creates an ESMF_Grid for the MOM grid !! | as well as ESMF_Fields for import !! | and export fields -!! Run | [ModelAdvance] (@ref mom_cap_mod::modeladvance) | Advances the model by a timestep -!! Final | [Finalize] (@ref mom_cap_mod::ocean_model_finalize) | Cleans up +!! Run | [ModelAdvance] (@ref ocn_comp_nuopc::modeladvance) | Advances the model by a timestep +!! Final | [Finalize] (@ref ocn_comp_nuopc::ocean_model_finalize) | Cleans up !! !! @section UnderlyingModelInterfaces Underlying Model Interfaces !! @@ -108,7 +108,7 @@ !! !! The MOM tripolar grid is represented as a 2D `ESMF_Grid` and coupling fields are placed !! on this grid. Calls related to creating the grid are located in the [InitializeRealize] -!! (@ref mom_cap_mod::initializerealize) subroutine, which is called by the NUOPC infrastructure +!! (@ref ocn_comp_nuopc::initializerealize) subroutine, which is called by the NUOPC infrastructure !! during the intialization sequence. !! !! The cap determines parameters for setting up the grid by calling subroutines in the @@ -132,7 +132,7 @@ !! !! @subsection Initialization Initialization !! -!! During the [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) phase, calls are +!! During the [InitializeAdvertise] (@ref ocn_comp_nuopc::initializeadvertise) phase, calls are !! made to MOM's native initialization subroutines, including `fms_init()`, `constants_init()`, !! `field_manager_init()`, `diag_manager_init()`, and `set_calendar_type()`. The MPI communicator !! is pulled in through the ESMF VM object for the MOM component. The dt and start time are set @@ -141,7 +141,7 @@ !! !! @subsection Run Run !! -!! The [ModelAdvance] (@ref mom_cap_mod::modeladvance) subroutine is called by the NUOPC +!! The [ModelAdvance] (@ref ocn_comp_nuopc::modeladvance) subroutine is called by the NUOPC !! infrastructure when it's time for MOM to advance in time. During this subroutine, there is a !! call into the MOM update routine: !! @@ -208,7 +208,7 @@ !! \f] !! @subsection Finalization Finalization !! -!! NUOPC infrastructure calls [ocean_model_finalize] (@ref mom_cap_mod::ocean_model_finalize) +!! NUOPC infrastructure calls [ocean_model_finalize] (@ref ocn_comp_nuopc::ocean_model_finalize) !! at the end of the run. This subroutine is a hook to call into MOM's native shutdown !! procedures: !! @@ -291,11 +291,11 @@ !! so that it can maintain state there if desired. !! The member of type `ice_ocean_boundary_type` is populated by this cap !! with incoming coupling fields from other components. These three derived types are allocated during the -!! [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) phase. Also during that +!! [InitializeAdvertise] (@ref ocn_comp_nuopc::initializeadvertise) phase. Also during that !! phase, the `ice_ocean_boundary` type members are all allocated using bounds retrieved !! from `mpp_get_compute_domain()`. !! -!! During the [InitializeRealize] (@ref mom_cap_mod::initializerealize) phase, +!! During the [InitializeRealize] (@ref ocn_comp_nuopc::initializerealize) phase, !! `ESMF_Field`s are created for each of the coupling fields in the `ice_ocean_boundary` !! and `ocean_public_type` members of the internal state. These fields directly reference into the members of !! the `ice_ocean_boundary` and `ocean_public_type` so that memory-to-memory copies are not required to move @@ -308,7 +308,7 @@ !! "DumpFields" has been set to "true". In this case the cap will write out NetCDF files !! with names "field_ocn_import_.nc" and "field_ocn_export_.nc". !! Additionally, calls will be made to the cap subroutine [dumpMomInternal] -!! (@ref mom_cap_mod::dumpmominternal) to write out model internal fields to files +!! (@ref ocn_comp_nuopc::dumpmominternal) to write out model internal fields to files !! named "field_ocn_internal_.nc". In all cases these NetCDF files will !! contain a time series of field data. !! @@ -343,7 +343,7 @@ !! * `DumpFields` - when set to "true", write out diagnostic NetCDF files for import/export/internal fields !! * `ProfileMemory` - when set to "true", write out memory usage information to the ESMF log files; this !! information is written when entering and leaving the [ModelAdvance] -!! (@ref mom_cap_mod::modeladvance) subroutine and before and after the call to +!! (@ref ocn_comp_nuopc::modeladvance) subroutine and before and after the call to !! `update_ocean_model()`. !! * `restart_interval` - integer number of seconds indicating the interval at !! which to call `ocean_model_restart()`; no restarts written if set to 0 @@ -361,7 +361,7 @@ !! - [MOM Home Page] (http://mom-ocean.org/web) !! !! -module mom_cap_mod +module ocn_comp_nuopc use constants_mod, only: constants_init use data_override_mod, only: data_override_init, data_override use diag_manager_mod, only: diag_manager_init, diag_manager_end @@ -2739,4 +2739,4 @@ subroutine calculate_rot_angle(OS, OSFC) end subroutine #endif -end module mom_cap_mod +end module ocn_comp_nuopc From 02d9be2f953ac8836cd1debf11c78de6d60981b6 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 25 Jul 2018 14:28:32 -0600 Subject: [PATCH 0610/1072] rm temporarily the noupc cap --- config_src/nuopc_driver/MOM_ocean_model.F90 | 1210 -------- .../nuopc_driver/MOM_surface_forcing.F90 | 1417 --------- config_src/nuopc_driver/mom_cap_methods.F90 | 604 ---- config_src/nuopc_driver/ocn_comp_nuopc.F90 | 2742 ----------------- config_src/nuopc_driver/time_utils.F90 | 161 - 5 files changed, 6134 deletions(-) delete mode 100644 config_src/nuopc_driver/MOM_ocean_model.F90 delete mode 100644 config_src/nuopc_driver/MOM_surface_forcing.F90 delete mode 100644 config_src/nuopc_driver/mom_cap_methods.F90 delete mode 100644 config_src/nuopc_driver/ocn_comp_nuopc.F90 delete mode 100644 config_src/nuopc_driver/time_utils.F90 diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 deleted file mode 100644 index 94dd64efed..0000000000 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ /dev/null @@ -1,1210 +0,0 @@ -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 -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_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 : 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 - -#ifdef _USE_GENERIC_TRACER -use MOM_generic_tracer, only : MOM_generic_tracer_fluxes_accumulate -#endif - -implicit none ; private - -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 - -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. - 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. - - integer :: stagger = -999 !< The staggering relative to the tracer points - !! points of the two velocity components. Valid entries - !! include AGRID, BGRID_NE, CGRID_NE, BGRID_SW, and CGRID_SW, - !! corresponding to the community-standard Arakawa notation. - !! (These are named integers taken from mpp_parameter_mod.) - !! Following MOM5, stagger is BGRID_NE by default when the - !! ocean is initialized, but here it is set to -999 so that - !! a global max across ocean and non-ocean processors can be - !! used to determine its value. - real, pointer, dimension(:,:) :: & - t_surf => NULL(), & !< SST on t-cell (degrees Kelvin) - s_surf => NULL(), & !< SSS on t-cell (psu) - u_surf => NULL(), & !< i-velocity at the locations indicated by stagger, m/s. - v_surf => NULL(), & !< j-velocity at the locations indicated by stagger, m/s. - sea_lev => NULL(), & !< Sea level in m after correction for surface pressure, - !! i.e. dzt(1) + eta_t + patm/rho0/grav (m) - frazil =>NULL(), & !< Accumulated heating (in Joules/m^2) from frazil - !! formation in the ocean. - area => NULL() !< cell area of the ocean surface, in m2. - 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. -end type ocean_public_type - - -!> 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 ; private - ! 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 :: 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 - !! restore sst to a specified value. - real :: press_to_z !< A conversion factor between pressure and ocean - !! depth in m, usually 1/(rho_0*g), in m Pa-1. - real :: C_p !< The heat capacity of seawater, in J K-1 kg-1. - logical :: offline_tracer_mode = .false. !< If false, use the model in prognostic mode - !! with the barotropic and baroclinic dynamics, thermodynamics, - !! etc. stepped forward integrated in time. - !! If true, all of the above are bypassed with all - !! fields necessary to integrate only the tracer advection - !! and diffusion equation read in from files stored from - !! a previous integration of the prognostic model. - - 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 - !! 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 structure containing information - !! about the vertical grid. - 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. - type(diag_ctrl), pointer :: & - diag => NULL() !< A pointer to the diagnostic regulatory structure -end type ocean_state_type - -contains - -!======================================================================= -! -! -! -! Initialize the ocean model. -! - -!> ocean_model_init initializes the ocean model, including registering fields -!! for restarts and reading restart files if appropriate. -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). - 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. - type(time_type), intent(in) :: Time_init !< The start time for the coupled model's calendar - type(time_type), intent(in) :: Time_in !< The time at which to initialize the ocean model. - 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, 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, in kg m-3. - real :: G_Earth ! The gravitational acceleration in m s-2. - -! This include declares and sets the variable "version". -#include "version_variable.h" - character(len=40) :: mdl = "ocean_model_init" ! This module's name. - character(len=48) :: stagger - integer :: secs, days - type(param_file_type) :: param_file !< A structure to parse for run-time parameters - 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 - call MOM_error(WARNING, "ocean_model_init called with an associated "// & - "ocean_state_type structure. Model is already initialized.") - return - endif - allocate(OS) - - OS%is_ocean_pe = Ocean_sfc%is_ocean_pe - if (.not.OS%is_ocean_pe) return - - 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, C_p=OS%C_p, & - use_temp=use_temperature) - 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 \n"//& - "including both dynamics and thermodynamics. If false, \n"//& - "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"//& - "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"//& - "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"//& - "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"//& - "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"//& - "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', '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.") ; 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"//& - "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"//& - "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"//& - "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, & - "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80) - - 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_alter_ocean, & - "If true, allows icebergs to change boundary condition felt by ocean", default=.false.) - - OS%press_to_z = 1.0/(Rho0*G_Earth) - - ! 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) - - call surface_forcing_init(Time_in, OS%grid, param_file, OS%diag, & - OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) - - if (OS%use_ice_shelf) then - call initialize_ice_shelf(param_file, OS%grid, OS%Time, OS%ice_shelf_CSp, & - OS%diag, OS%forces, OS%fluxes) - endif - if (OS%icebergs_alter_ocean) then - call marine_ice_init(OS%Time, OS%grid, param_file, OS%diag, OS%marine_ice_CSp) - if (.not. OS%use_ice_shelf) & - 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, param_file, OS%Waves, OS%diag) - else - call MOM_wave_interface_init_lite(param_file) - 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, & - gas_fields_ocn=gas_fields_ocn) - else - call initialize_ocean_public_type(OS%grid%Domain%mpp_domain, Ocean_sfc, & - OS%diag, gas_fields_ocn=gas_fields_ocn) - endif - - ! 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) - - endif - - call close_param_file(param_file) - call diag_mediator_close_registration(OS%diag) - - 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. -! -! - -!> 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, & - 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. - 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-ocn 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) - 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 "//& - "agree with time_start_update argument.") - endif - if (.not.associated(OS)) then - call MOM_error(FATAL, "update_ocean_model called with an unassociated "// & - "ocean_state_type structure. ocean_model_init must be "// & - "called first to allocate this structure.") - 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 - call coupler_type_spawn(Ocean_sfc%fields, OS%sfc_state%tr_fields, & - (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) - - ! Translate Ice_ocean_boundary into fluxes. - call mpp_get_compute_domain(Ocean_sfc%Domain, index_bnds(1), index_bnds(2), & - index_bnds(3), index_bnds(4)) - - weight = 1.0 - - call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp) - - if (OS%fluxes%fluxes_used) then - - call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & - OS%grid, 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, dt_coupling, OS%Ice_shelf_CSp) - endif - if (OS%icebergs_alter_ocean) then - call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) - call iceberg_fluxes(OS%grid, OS%fluxes, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) - 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, skip_pres=.true.) - -#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 = dt_coupling - - else - - OS%flux_tmp%C_p = OS%fluxes%C_p - call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & - OS%grid, 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, dt_coupling, OS%Ice_shelf_CSp) - endif - if (OS%icebergs_alter_ocean) then - call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) - call iceberg_fluxes(OS%grid, OS%flux_tmp, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) - 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 - ! 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 - - endif - - call set_derived_forcing_fields(OS%forces, OS%fluxes, OS%grid, 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%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 - - call disable_averaging(OS%diag) - Master_time = OS%Time ; Time1 = OS%Time - - if (OS%offline_tracer_mode) then - 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) - !### What to do with these? , start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) - - 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 - 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(dt_coupling, OS%Time, OS%diag) - call mech_forcing_diags(OS%forces, OS%fluxes, dt_coupling, OS%grid, & - OS%diag, OS%forcing_CSp%handles) - call disable_averaging(OS%diag) - - if (OS%fluxes%fluxes_used) then - call enable_averaging(OS%fluxes%dt_buoy_accum, OS%Time, OS%diag) - call forcing_diagnostics(OS%fluxes, OS%sfc_state, OS%fluxes%dt_buoy_accum, & - OS%grid, OS%diag, OS%forcing_CSp%handles) - call disable_averaging(OS%diag) - endif - -! Translate state into Ocean. -! 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, 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 "//& - "dynamics and advective times. Additional restart fields "//& - "that have not been coded yet would be required for reproducibility.") - - if (.not.OS%fluxes%fluxes_used) call MOM_error(FATAL, "ocean_model_restart "//& - "was called with unused buoyancy fluxes. For conservation, the ocean "//& - "restart files can only be created after the buoyancy forcing is applied.") - - 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. Terminate the model run, optionally -! saving the ocean state in a restart file and deallocating any data -! associated with the ocean. - -! Arguments: Ocean_sfc - An ocean_public_type structure that is to be -! deallocated upon termination. -! (inout) Ocean_state - A pointer to the structure containing the internal -! ocean state to be deallocated upon termination. -! (in) Time - The model time, used for writing restarts. -! (in) write_restart - Write restart file if true -! -subroutine ocean_model_end(Ocean_sfc, Ocean_state, Time, write_restart) - 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. - logical, intent(in) :: write_restart !< true => write restart file - - if (write_restart) then - call ocean_model_save_restart(Ocean_state, Time) - end if - call diag_mediator_end(Time, Ocean_state%diag) - 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. -subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) - type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the - !! internal ocean state (in). - type(time_type), intent(in) :: Time !< The model time at this call, needed for mpp_write calls. - character(len=*), optional, intent(in) :: directory !< An optional directory into which to - !! 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. - character(len=200) :: restart_dir - - if (.not.MOM_state_is_synchronized(OS%MOM_CSp)) & - call MOM_error(WARNING, "ocean_model_save_restart called with inconsistent "//& - "dynamics and advective times. Additional restart fields "//& - "that have not been coded yet would be required for reproducibility.") - - if (.not.OS%fluxes%fluxes_used) call MOM_error(FATAL, "ocean_model_save_restart "//& - "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 - - call save_restart(restart_dir, Time, OS%grid, OS%restart_CSp, GV=OS%GV) - - call forcing_save_restart(OS%forcing_CSp, OS%grid, Time, restart_dir) - - if (OS%use_ice_shelf) then - call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir) - endif - -end subroutine ocean_model_save_restart - -!======================================================================= - -subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, & - gas_fields_ocn) - type(domain2D), intent(in) :: input_domain - type(ocean_public_type), intent(inout) :: Ocean_sfc - type(diag_ctrl), intent(in) :: diag - logical, dimension(:,:), & - optional, intent(in) :: maskmap - 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. - - 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) - call mpp_get_global_domain(input_domain, xsize=xsz, ysize=ysz) - if (PRESENT(maskmap)) then - call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain, maskmap=maskmap) - else - call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain) - endif - call mpp_get_compute_domain(Ocean_sfc%Domain, isc, iec, jsc, jec) - - allocate ( Ocean_sfc%t_surf (isc:iec,jsc:jec), & - Ocean_sfc%s_surf (isc:iec,jsc:jec), & - Ocean_sfc%u_surf (isc:iec,jsc:jec), & - Ocean_sfc%v_surf (isc:iec,jsc:jec), & - Ocean_sfc%sea_lev(isc:iec,jsc:jec), & - Ocean_sfc%area (isc:iec,jsc:jec), & - Ocean_sfc%frazil (isc:iec,jsc:jec)) - - Ocean_sfc%t_surf = 0.0 ! time averaged sst (Kelvin) passed to atmosphere/ice model - Ocean_sfc%s_surf = 0.0 ! time averaged sss (psu) passed to atmosphere/ice models - Ocean_sfc%u_surf = 0.0 ! time averaged u-current (m/sec) passed to atmosphere/ice models - Ocean_sfc%v_surf = 0.0 ! time averaged v-current (m/sec) passed to atmosphere/ice models - Ocean_sfc%sea_lev = 0.0 ! time averaged thickness of top model grid cell (m) plus patm/rho0/grav - Ocean_sfc%frazil = 0.0 ! time accumulated frazil (J/m^2) passed to ice model - Ocean_sfc%area = 0.0 - Ocean_sfc%axes = diag%axesT1%handles !diag axes to be used by coupler tracer flux diagnostics - - if (present(gas_fields_ocn)) then - call coupler_type_spawn(gas_fields_ocn, Ocean_sfc%fields, (/isc,isc,iec,iec/), & - (/jsc,jsc,jec,jec/), suffix = '_ocn', as_needed=.true.) - endif - -end subroutine initialize_ocean_public_type - -!======================================================================= -! 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 - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, optional, intent(in) :: patm(:,:) - real, optional, intent(in) :: press_to_z - - 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(sfc_state%u, sfc_state%v, G%Domain) - - call mpp_get_compute_domain(Ocean_sfc%Domain, isc_bnd, iec_bnd, & - jsc_bnd, jec_bnd) - if (present(patm)) then - ! Check that the inidicies in patm are (isc_bnd:iec_bnd,jsc_bnd:jec_bnd). - if (.not.present(press_to_z)) call MOM_error(FATAL, & - 'convert_state_to_ocean_type: press_to_z must be present if patm is.') - endif - - i0 = is - isc_bnd ; j0 = js - jsc_bnd - 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(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) = sfc_state%SST(i+i0,j+j0) + CELSIUS_KELVIN_OFFSET - enddo ; enddo - endif - 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(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) = sfc_state%SSS(i+i0,j+j0) - enddo ; enddo - endif - - 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 (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*(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*(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)*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 - call MOM_error(FATAL, "convert_state_to_ocean_type: "//& - "Ocean_sfc%stagger has the unrecognized value of "//trim(val_str)) - endif - - 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(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 -! 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 - type(ocean_public_type), intent(inout) :: Ocean_sfc - - integer :: is, ie, js, je - - is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec - call coupler_type_spawn(Ocean_sfc%fields, OS%sfc_state%tr_fields, & - (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) - - call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - - 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 -!! non-ocean PEs, or PEs that have not yet been initialzed, and it can safely -!! be called multiple times. -subroutine ocean_model_flux_init(OS, verbosity) - type(ocean_state_type), optional, pointer :: OS !< An optional pointer to the ocean state, - !! used to figure out if this is an ocean PE that - !! has already been initialized. - integer, optional, intent(in) :: verbosity !< A 0-9 integer indicating a level of verbosity. - - logical :: OS_is_set - integer :: verbose - - OS_is_set = .false. ; if (present(OS)) OS_is_set = associated(OS) - - ! Use this to control the verbosity of output; consider rethinking this logic later. - verbose = 5 ; if (OS_is_set) verbose = 3 - if (present(verbosity)) verbose = verbosity - - call call_tracer_flux_init(verbosity=verbose) - -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). - 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 - !! interfacial compatibility with other models. -! Arguments: OS - A structure containing the internal ocean state. -! (in) index - Index of conservation quantity of interest. -! (in) value - Sum returned for the conservation quantity of interest. -! (in,opt) time_index - Index for time level to use if this is necessary. - - real :: salt - - value = 0.0 - if (.not.associated(OS)) return - if (.not.OS%is_ocean_pe) return - - select case (index) - case (ISTOCK_WATER) ! Return the mass of fresh water in the ocean in kg. - if (OS%GV%Boussinesq) then - call get_ocean_stocks(OS%MOM_CSp, mass=value, on_PE_only=.true.) - else ! In non-Boussinesq mode, the mass of salt needs to be subtracted. - call get_ocean_stocks(OS%MOM_CSp, mass=value, salt=salt, on_PE_only=.true.) - value = value - salt - endif - case (ISTOCK_HEAT) ! Return the heat content of the ocean in J. - call get_ocean_stocks(OS%MOM_CSp, heat=value, on_PE_only=.true.) - case (ISTOCK_SALT) ! Return the mass of the salt in the ocean in kg. - call get_ocean_stocks(OS%MOM_CSp, salt=value, on_PE_only=.true.) - case default ; value = 0.0 - end select - ! If the FMS coupler is changed so that Ocean_stock_PE is only called on - ! ocean PEs, uncomment the following and eliminate the on_PE_only flags above. - ! if (.not.is_root_pe()) value = 0.0 - -end subroutine Ocean_stock_pe - -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 - - integer :: g_isc, g_iec, g_jsc, g_jec,g_isd, g_ied, g_jsd, g_jed, i, j - - if (.not.associated(OS)) return - if (.not.OS%is_ocean_pe) return - -! The problem is %areaT is on MOM domain but Ice_Ocean_Boundary%... is on mpp domain. -! We want to return the MOM data on the mpp (compute) domain -! Get MOM domain extents - call mpp_get_compute_domain(OS%grid%Domain%mpp_domain, g_isc, g_iec, g_jsc, g_jec) - call mpp_get_data_domain (OS%grid%Domain%mpp_domain, g_isd, g_ied, g_jsd, g_jed) - - g_isc = g_isc-g_isd+1 ; g_iec = g_iec-g_isd+1 ; g_jsc = g_jsc-g_jsd+1 ; g_jec = g_jec-g_jsd+1 - - - select case(name) - case('area') - array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) - case('mask') - array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) -!OR same result -! do j=g_jsc,g_jec ; do i=g_isc,g_iec -! array2D(isc+i-g_isc,jsc+j-g_jsc) = OS%grid%mask2dT(i,j) -! enddo ; enddo - case('t_surf') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET - case('t_pme') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET - case('t_runoff') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET - case('t_calving') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET - case('btfHeat') - array2D(isc:,jsc:) = 0 - case('tlat') - array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) - case('tlon') - array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) - case('ulat') - array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) - case('ulon') - array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) - case('vlat') - array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) - case('vlon') - array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) - case('geoLatBu') - array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) - case('geoLonBu') - array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) - case('cos_rot') - array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 - 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) - 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 - - if (.not.associated(OS)) return - if (.not.OS%is_ocean_pe) return - - select case(name) - case('c_p') - value = OS%C_p - case default - call MOM_error(FATAL,'ocean_model_data1D_get: unknown argument name='//name) - end select - - -end subroutine ocean_model_data1D_get - -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 - - outunit = stdout() - - write(outunit,*) "BEGIN CHECKSUM(ocean_type):: ", id, timestep - write(outunit,100) 'ocean%t_surf ',mpp_chksum(ocn%t_surf ) - write(outunit,100) 'ocean%s_surf ',mpp_chksum(ocn%s_surf ) - write(outunit,100) 'ocean%u_surf ',mpp_chksum(ocn%u_surf ) - 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 ) - - 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) - type(ocean_state_type) :: OS - 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/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 deleted file mode 100644 index e601e83347..0000000000 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ /dev/null @@ -1,1417 +0,0 @@ -module MOM_surface_forcing - -! This file is part of MOM6. See LICENSE.md for the license. - -!### use MOM_controlled_forcing, only : apply_ctrl_forcing, register_ctrl_forcing_restarts -!### use MOM_controlled_forcing, only : controlled_forcing_init, controlled_forcing_end -!### use MOM_controlled_forcing, only : ctrl_forcing_CS -use MOM_coms, only : reproducing_sum -use MOM_constants, only : hlv, hlf -use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end -use MOM_cpu_clock, only : CLOCK_SUBCOMPONENT -use MOM_diag_mediator, only : diag_ctrl -use MOM_diag_mediator, only : safe_alloc_ptr, time_type -use MOM_domains, only : pass_vector, pass_var, fill_symmetric_edges -use MOM_domains, only : global_field_sum, BITWISE_EXACT_SUM -use MOM_domains, only : AGRID, BGRID_NE, CGRID_NE, To_All -use MOM_domains, only : To_North, To_East, Omit_Corners -use MOM_error_handler, only : MOM_error, WARNING, FATAL, is_root_pe, MOM_mesg -use MOM_file_parser, only : get_param, log_version, param_file_type -use MOM_forcing_type, only : forcing, mech_forcing -use MOM_forcing_type, only : forcing_diags, mech_forcing_diags, register_forcing_type_diags -use MOM_forcing_type, only : allocate_forcing_type, deallocate_forcing_type -use MOM_forcing_type, only : allocate_mech_forcing, deallocate_mech_forcing -use MOM_get_input, only : Get_MOM_Input, directories -use MOM_grid, only : ocean_grid_type -use MOM_io, only : slasher, write_version_number, MOM_read_data -use MOM_restart, only : register_restart_field, restart_init, MOM_restart_CS -use MOM_restart, only : restart_init_end, save_restart, restore_state -use MOM_string_functions, only : uppercase -use MOM_spatial_means, only : adjust_area_mean_to_zero -use MOM_variables, only : surface -use user_revise_forcing, only : user_alter_forcing, user_revise_forcing_init -use user_revise_forcing, only : user_revise_forcing_CS - -use coupler_types_mod, only : coupler_2d_bc_type, coupler_type_write_chksums -use coupler_types_mod, only : coupler_type_initialized, coupler_type_spawn -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 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 - -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 - - -! surface_forcing_CS is a structure containing pointers to the forcing fields -! which may be used to drive MOM. All fluxes are positive downward. -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. - 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 :: 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 - ! structure does not limit the water that can be - ! frozen out of the ocean and the ice-ocean heat - ! fluxes are treated explicitly. - logical :: use_limited_P_SSH ! 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. The default is true. - - 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. - gust => NULL(), & ! spatially varying unresolved background - ! 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) - real :: cd_tides ! drag coefficient that applies to the tides (nondimensional) - real :: utide ! constant tidal velocity to use if read_tideamp - ! is false, in 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 :: 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. - logical :: allow_flux_adjustments ! If true, use data_override to obtain flux adjustments - - 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 :: 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) - 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 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 - 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 - integer :: id_srestore = -1 ! id number for time_interp_external. - integer :: id_trestore = -1 ! id number for time_interp_external. - - ! Diagnostics handles - type(forcing_diags), public :: handles - -!### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() - 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. -type, public :: ice_ocean_boundary_type - 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(:,:) :: 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 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, CS, & - sfc_state, restore_salt, restore_temp) - type(ice_ocean_boundary_type), & - 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. - !! 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 - type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a - !! previous call to surface_forcing_init. - type(surface), intent(in) :: sfc_state !< A structure containing fields that describe the - !! surface state of the ocean. - 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 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, 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 - - 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 - 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 - - C_p = fluxes%C_p - open_ocn_mask(:,:) = 1.0 - pme_adj(:,:) = 0.0 - fluxes%vPrecGlobalAdj = 0.0 - fluxes%vPrecGlobalScl = 0.0 - fluxes%saltFluxGlobalAdj = 0.0 - fluxes%saltFluxGlobalScl = 0.0 - fluxes%netFWGlobalAdj = 0.0 - fluxes%netFWGlobalScl = 0.0 - - restore_salinity = .false. - if (present(restore_salt)) restore_salinity = restore_salt - restore_sst = .false. - if (present(restore_temp)) restore_sst = restore_temp - - ! allocation and initialization if this is the first time that this - ! flux type has been used. - if (fluxes%dt_buoy_accum < 0) then - call allocate_forcing_type(G, fluxes, water=.true., heat=.true., & - ustar=.true., press=.true.) - - call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%sw_nir_dir,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%sw_nir_dif,isd,ied,jsd,jed) - - 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) - call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) - - call safe_alloc_ptr(fluxes%TKE_tidal,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%ustar_tidal,isd,ied,jsd,jed) - - if (CS%allow_flux_adjustments) then - call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) - call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) - endif - - do j=js-2,je+2 ; do i=is-2,ie+2 - fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) - fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) - enddo ; enddo - - if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) - - 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) - enddo ; enddo - CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) - endif ! endif for allocation and initialization - - do j=js,je ; do i=is,ie - fluxes%salt_flux(i,j) = 0.0 - fluxes%vprec(i,j) = 0.0 - enddo ; enddo - - ! Salinity restoring logic - if (restore_salinity) then - call time_interp_external(CS%id_srestore,Time,data_restore) - ! open_ocn_mask indicates where to restore salinity (1 means restore, 0 does not) - open_ocn_mask(:,:) = 1.0 - if (CS%mask_srestore_under_ice) then ! Do not restore under sea-ice - do j=js,je ; do i=is,ie - if (sfc_state%SST(i,j) <= -0.0539*sfc_state%SSS(i,j)) open_ocn_mask(i,j)=0.0 - enddo ; enddo - endif - if (CS%salt_restore_as_sflux) then - do j=js,je ; do i=is,ie - 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)*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 - call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) - fluxes%saltFluxGlobalAdj = 0. - else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf - fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj - endif - endif - fluxes%salt_flux_added(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) ! Diagnostic - else - do j=js,je ; do i=is,ie - 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)*CS%srestore_mask(i,j))* & - (CS%Rho0*CS%Flux_const) * & - delta_sss / (0.5*(sfc_state%SSS(i,j) + data_restore(i,j))) - endif - enddo ; enddo - if (CS%adjust_net_srestore_to_zero) then - if (CS%adjust_net_srestore_by_scaling) then - call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) - fluxes%vPrecGlobalAdj = 0. - else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) - fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf - do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) - enddo ; enddo - endif - endif - endif - endif - - ! SST restoring logic - if (restore_sst) then - call time_interp_external(CS%id_trestore,Time,data_restore) - 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%trestore_mask(i,j) * & - (CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2 - enddo ; enddo - endif - - - ! obtain fluxes from IOB; note the staggering of indices - i0 = is - isc_bnd ; j0 = js - jsc_bnd - do j=js,je ; do i=is,ie - - if (associated(IOB%lprec)) & - fluxes%lprec(i,j) = IOB%lprec(i-i0,j-j0) * G%mask2dT(i,j) - - if (associated(IOB%fprec)) & - fluxes%fprec(i,j) = IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j) - - if (associated(IOB%q_flux)) & - fluxes%evap(i,j) = - IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) - - if (associated(IOB%runoff)) & - fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) - - if (associated(IOB%calving)) & - fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) - - if (associated(IOB%ustar_berg)) & - fluxes%ustar_berg(i,j) = 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%runoff_hflx)) & - fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * 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) - - if (associated(IOB%lw_flux)) & - fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) - - if (associated(IOB%t_flux)) & - fluxes%sens(i,j) = - IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) - - fluxes%latent(i,j) = 0.0 - 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 - if (associated(IOB%calving)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion - fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion - endif - if (associated(IOB%q_flux)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor - fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor - endif - - fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) - - 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) - - enddo ; enddo - - ! 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 - endif - - ! more salt restoring logic - 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 - -!### if (associated(CS%ctrl_forcing_CSp)) then -!### do j=js,je ; do i=is,ie -!### SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) -!### SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) -!### SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) -!### enddo ; enddo -!### call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_restore, & -!### fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) -!### endif - - ! adjust the NET fresh-water flux to zero, if flagged - if (CS%adjust_net_fresh_water_to_zero) then - sign_for_net_FW_bug = 1. - if (CS%use_net_FW_adjustment_sign_bug) sign_for_net_FW_bug = -1. - do j=js,je ; do i=is,ie - net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(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 - 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 - - if (CS%adjust_net_fresh_water_by_scaling) then - call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) - do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) - enddo ; enddo - else - fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf - do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%netFWGlobalAdj ) * G%mask2dT(i,j) - enddo ; enddo - 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) - endif - - ! Allow for user-written code to alter fluxes after all the above - call user_alter_forcing(sfc_state, fluxes, Time, G, CS%urf_CS) - - call cpu_clock_end(id_clock_forcing) - -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. -subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) - type(ice_ocean_boundary_type), & - target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive - !! the ocean in a coupled model - type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - 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 - type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a - !! previous call to surface_forcing_init. - - - 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) - - 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) - 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 - i0 = is - isc_bnd ; j0 = js - jsc_bnd - - 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 safe_alloc_ptr(forces%p_surf,isd,ied,jsd,jed) - call safe_alloc_ptr(forces%p_surf_full,isd,ied,jsd,jed) - 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 (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) - endif - - 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 - - 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 - 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) - 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) - enddo ; enddo - endif - endif - - wind_stagger = CS%wind_stagger - 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 - endif - if (wind_stagger == AGRID) then - ! This is necessary to fill in the halo points. - taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 - endif - - ! 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 - elseif (wind_stagger == AGRID) then - if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - else ! C-grid wind stresses. - if (associated(IOB%u_flux)) forces%taux(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) forces%tauy(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - endif - - enddo ; enddo - - ! surface momentum stress related fields as function of staggering - 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, halo=1) - - do j=js,je ; do I=Isq,Ieq - forces%taux(I,j) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & - forces%taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + & - G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) - enddo ; enddo - - do J=Jsq,Jeq ; do i=is,ie - forces%tauy(i,J) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & - forces%tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + & - G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) - enddo ; enddo - - ! ustar is required for the bulk mixed layer formulation. The background value - ! of 0.02 Pa is a relatively small value intended to give reasonable behavior - ! in regions of very weak winds. - - do j=js,je ; do i=is,ie - tau_mag = 0.0 ; gustiness = CS%gust_const - if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & - (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then - tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & - G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & - (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & - G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & - ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) - if (CS%read_gust_2d) gustiness = CS%gust(i,j) - endif - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) - enddo ; enddo - - elseif (wind_stagger == AGRID) then - 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 - if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & - forces%taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + & - G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & - (G%mask2dT(i,j) + G%mask2dT(i+1,j)) - enddo ; enddo - - do J=Jsq,Jeq ; do i=is,ie - forces%tauy(i,J) = 0.0 - if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & - forces%tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + & - G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & - (G%mask2dT(i,j) + G%mask2dT(i,j+1)) - enddo ; enddo - - do j=js,je ; do i=is,ie - gustiness = CS%gust_const - if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & - sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) - enddo ; enddo - - 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, halo=1) - - do j=js,je ; do i=is,ie - taux2 = 0.0 - if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & - taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + & - G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) - - tauy2 = 0.0 - if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & - tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + & - G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) - - if (CS%read_gust_2d) then - forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) - else - forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) - endif - enddo ; enddo - - 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 - Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) - do I=is-1,ie ; do j=js,je - mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth - mass_eff = 0.0 - if (mass_ice > CS%rigid_sea_ice_mass) then - mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & - (mass_ice + CS%rigid_sea_ice_mass) - endif - forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + Kv_rho_ice * mass_eff - enddo ; enddo - do i=is,ie ; do J=js-1,je - mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i,j+1)) * I_GEarth - mass_eff = 0.0 - if (mass_ice > CS%rigid_sea_ice_mass) then - mass_eff = (mass_ice - CS%rigid_sea_ice_mass) **2 / & - (mass_ice + CS%rigid_sea_ice_mass) - endif - forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + Kv_rho_ice * mass_eff - enddo ; enddo - endif - - if (CS%allow_flux_adjustments) then - ! Apply adjustments to forces - call apply_force_adjustments(G, CS, Time, forces) - endif - -!### ! Allow for user-written code to alter fluxes after all the above -!### call user_alter_mech_forcing(forces, Time, G, CS%urf_CS) - - call cpu_clock_end(id_clock_forcing) -end subroutine convert_IOB_to_forces - -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% u_flux (isc:iec,jsc:jec), & - IOB% v_flux (isc:iec,jsc:jec), & - IOB% t_flux (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% runoff (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%u_flux = 0.0 - IOB%v_flux = 0.0 - IOB%t_flux = 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%runoff = 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 thermodynamic flux adjustments obtained via data_override -!! Component name is 'OCN' -!! Available adjustments are: -!! - 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), intent(inout) :: fluxes !< Surface fluxes structure - - ! Local variables - 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 - logical :: overrode_h - - 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=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=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) - - 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=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: -!! - taux_adj (Zonal wind stress delta, positive to the east, in Pa) -!! - tauy_adj (Meridional wind stress delta, positive to the north, in Pa) -subroutine apply_force_adjustments(G, CS, Time, forces) - 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(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) - - integer :: isc, iec, jsc, jec, i, j - real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau - logical :: overrode_x, overrode_y - - isc = G%isc; iec = G%iec ; jsc = G%jsc; jec = G%jec - - tempx_at_h(:,:) = 0.0 ; tempy_at_h(:,:) = 0.0 - ! Either reads data or leaves contents unchanged - overrode_x = .false. ; overrode_y = .false. - call data_override('OCN', 'taux_adj', tempx_at_h(isc:iec,jsc:jec), Time, override=overrode_x) - call data_override('OCN', 'tauy_adj', tempy_at_h(isc:iec,jsc:jec), Time, override=overrode_y) - - if (overrode_x .or. overrode_y) then - if (.not. (overrode_x .and. overrode_y)) call MOM_error(FATAL,"apply_flux_adjustments: "//& - "Both taux_adj and tauy_adj must be specified, or neither, in data_table") - - ! Rotate winds - call pass_vector(tempx_at_h, tempy_at_h, G%Domain, To_All, AGRID, halo=1) - do j=jsc-1,jec+1 ; do i=isc-1,iec+1 - dLonDx = G%geoLonCu(I,j) - G%geoLonCu(I-1,j) - dLonDy = G%geoLonCv(i,J) - G%geoLonCv(i,J-1) - rDlon = sqrt( dLonDx * dLonDx + dLonDy * dLonDy ) - if (rDlon > 0.) rDlon = 1. / rDlon - cosA = dLonDx * rDlon - sinA = dLonDy * rDlon - zonal_tau = tempx_at_h(i,j) - merid_tau = tempy_at_h(i,j) - tempx_at_h(i,j) = cosA * zonal_tau - sinA * merid_tau - tempy_at_h(i,j) = sinA * zonal_tau + cosA * merid_tau - enddo ; enddo - - ! Average to C-grid locations - do j=jsc,jec ; do I=isc-1,iec - forces%taux(I,j) = forces%taux(I,j) + 0.5 * ( tempx_at_h(i,j) + tempx_at_h(i+1,j) ) - enddo ; enddo - - do J=jsc-1,jec ; do i=isc,iec - forces%tauy(i,J) = forces%tauy(i,J) + 0.5 * ( tempy_at_h(i,j) + tempy_at_h(i,j+1) ) - enddo ; enddo - endif ! overrode_x .or. overrode_y - -end subroutine apply_force_adjustments - -subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & - filename_suffix) - type(surface_forcing_CS), pointer :: CS - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(time_type), intent(in) :: Time - character(len=*), intent(in) :: directory - logical, optional, intent(in) :: time_stamped - character(len=*), optional, intent(in) :: filename_suffix -! Arguments: CS - A pointer to the control structure returned by a previous -! call to surface_forcing_init. -! (in) G - The ocean's grid structure. -! (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) time_stamped - If true, the restart file names include -! a unique time stamp. The default is false. -! (in, opt) 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 - -subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, restore_temp) - type(time_type), intent(in) :: Time - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(inout) :: diag - type(surface_forcing_CS), pointer :: CS - logical, optional, intent(in) :: restore_salt, restore_temp -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module -! (in) restore_salt - If present and true, salinity restoring will be -! applied in this model. - 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 = "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 - - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - - if (associated(CS)) then - call MOM_error(WARNING, "surface_forcing_init called with an associated "// & - "control structure.") - return - endif - allocate(CS) - - id_clock_forcing=cpu_clock_id('Ocean surface forcing', grain=CLOCK_SUBCOMPONENT) - call cpu_clock_begin(id_clock_forcing) - - CS%diag => diag - - call write_version_number(version) - ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mdl, version, "") - - call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, & - "The directory in which all input files are found.", & - default=".") - CS%inputdir = slasher(CS%inputdir) - call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & - "If true, Temperature and salinity are used as state \n"//& - "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"//& - "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, & - "The latent heat of fusion.", units="J/kg", default=hlf) - 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"//& - "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"//& - "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"//& - "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"//& - "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"//& - "the net fresh-water.", default=.true.) - call get_param(param_file, mdl, "ADJUST_NET_FRESH_WATER_BY_SCALING", & - CS%adjust_net_fresh_water_by_scaling, & - "If true, adjustments to net fresh water to achieve zero net are\n"//& - "made by scaling values without moving the zero contour.",& - default=.false.) - call get_param(param_file, mdl, "ICE_SALT_CONCENTRATION", & - CS%ice_salt_concentration, & - "The assumed sea-ice salinity needed to reverse engineer the \n"//& - "melt flux (or ice-ocean fresh-water flux).", & - units="kg/kg", default=0.005) - call get_param(param_file, 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"//& - "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 \n"//& - "staggering of the input wind stress field. Valid \n"//& - "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 - elseif (uppercase(stagger(1:1)) == 'C') then ; CS%wind_stagger = CGRID_NE - else ; call MOM_error(FATAL,"surface_forcing_init: WIND_STAGGER = "// & - trim(stagger)//" is invalid.") ; endif - call get_param(param_file, mdl, "WIND_STRESS_MULTIPLIER", CS%wind_stress_multiplier, & - "A factor multiplying the wind-stress given to the ocean by the\n"//& - "coupler. This is used for testing and should be =1.0 for any\n"//& - "production runs.", default=1.0) - - if (restore_salt) then - call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & - "The constant that relates the restoring surface fluxes \n"//& - "to the relative surface anomalies (akin to a piston \n"//& - "velocity). Note the non-MKS units.", units="m day-1", & - fail_if_missing=.true.) - call get_param(param_file, mdl, "SALT_RESTORE_FILE", CS%salt_restore_file, & - "A file in which to find the surface salinity to use for restoring.", & - default="salt_restore.nc") - call get_param(param_file, mdl, "SALT_RESTORE_VARIABLE", CS%salt_restore_var_name, & - "The name of the surface salinity variable to read from "//& - "SALT_RESTORE_FILE for restoring salinity.", & - default="salt") -! Convert CS%Flux_const from m day-1 to m s-1. - CS%Flux_const = CS%Flux_const / 86400.0 - - call get_param(param_file, mdl, "SRESTORE_AS_SFLUX", CS%salt_restore_as_sflux, & - "If true, the restoring of salinity is applied as a salt \n"//& - "flux instead of as a freshwater flux.", default=.false.) - call get_param(param_file, 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"//& - "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"//& - "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'.", & - default="basin.nc") - 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 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 \n"//& - "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"//& - "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, & - "A file in which to find the surface temperature to use for restoring.", & - default="temp_restore.nc") - call get_param(param_file, mdl, "SST_RESTORE_VARIABLE", CS%temp_restore_var_name, & - "The name of the surface temperature variable to read from "//& - "SST_RESTORE_FILE for restoring sst.", & - default="temp") -! Convert CS%Flux_const from m day-1 to m s-1. - CS%Flux_const = CS%Flux_const / 86400.0 - - call get_param(param_file, 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 \n"//& - "a mask for SST restoring.", default=.false.) - - endif - -! 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. - call get_param(param_file, mdl, "CD_TIDES", CS%cd_tides, & - "The drag coefficient that applies to the tides.", & - units="nondim", default=1.0e-4) - call get_param(param_file, mdl, "READ_TIDEAMP", CS%read_TIDEAMP, & - "If true, read a file (given by TIDEAMP_FILE) containing \n"//& - "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) - if (CS%read_TIDEAMP) then - call get_param(param_file, mdl, "TIDEAMP_FILE", TideAmp_file, & - "The path to the file containing the spatially varying \n"//& - "tidal amplitudes with INT_TIDE_DISSIPATION.", & - default="tideamp.nc") - CS%utide=0.0 - else - call get_param(param_file, mdl, "UTIDE", CS%utide, & - "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & - units="m s-1", default=0.0) - endif - - call safe_alloc_ptr(CS%TKE_tidal,isd,ied,jsd,jed) - call safe_alloc_ptr(CS%ustar_tidal,isd,ied,jsd,jed) - - if (CS%read_TIDEAMP) then - TideAmp_file = trim(CS%inputdir) // trim(TideAmp_file) - 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) - CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide - enddo ; enddo - else - do j=jsd,jed; do i=isd,ied - utide=CS%utide - CS%TKE_tidal(i,j) = CS%Rho0*CS%cd_tides*(utide*utide*utide) - CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide - enddo ; enddo - endif - - call time_interp_external_init - -! Optionally read a x-y gustiness field in place of a global -! constant. - - call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & - "If true, use a 2-dimensional gustiness supplied from \n"//& - "an input file", default=.false.) - call get_param(param_file, 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"//& - "variable gustiness.") - - call safe_alloc_ptr(CS%gust,isd,ied,jsd,jed) - gust_file = trim(CS%inputdir) // trim(gust_file) - 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. - call get_param(param_file, mdl, "USE_RIGID_SEA_ICE", CS%rigid_sea_ice, & - "If true, sea-ice is rigid enough to exert a \n"//& - "nonhydrostatic pressure that resist vertical motion.", & - default=.false.) - if (CS%rigid_sea_ice) then - call get_param(param_file, mdl, "SEA_ICE_MEAN_DENSITY", CS%density_sea_ice, & - "A typical density of sea ice, used with the kinematic \n"//& - "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & - default=900.0) - call get_param(param_file, mdl, "SEA_ICE_VISCOSITY", CS%Kv_sea_ice, & - "The kinematic viscosity of sufficiently thick sea ice \n"//& - "for use in calculating the rigidity of sea ice.", & - units="m2 s-1", default=1.0e9) - call get_param(param_file, mdl, "SEA_ICE_RIGID_MASS", CS%rigid_sea_ice_mass, & - "The mass of sea-ice per unit area at which the sea-ice \n"//& - "starts to exhibit rigidity", units="kg m-2", default=1000.0) - endif - - call get_param(param_file, mdl, "ALLOW_ICEBERG_FLUX_DIAGNOSTICS", iceberg_flux_diags, & - "If true, makes available diagnostics of fluxes from icebergs\n"//& - "as seen by MOM6.", default=.false.) - call register_forcing_type_diags(Time, diag, CS%use_temperature, CS%handles, & - use_berg_fluxes=iceberg_flux_diags) - - call get_param(param_file, mdl, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, & - "If true, allows flux adjustments to specified via the \n"//& - "data_table using the component name 'OCN'.", default=.false.) - if (CS%allow_flux_adjustments) then - call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) - endif - - 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. - call restart_init(param_file, CS%restart_CSp, "MOM_forcing.res") -!### call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & -!### CS%restart_CSp) - call restart_init_end(CS%restart_CSp) - - if (associated(CS%restart_CSp)) then - call Get_MOM_Input(dirs=dirs) - - new_sim = .false. - if ((dirs%input_filename(1:1) == 'n') .and. & - (LEN_TRIM(dirs%input_filename) == 1)) new_sim = .true. - if (.not.new_sim) then - call restore_state(dirs%input_filename, dirs%restart_input_dir, Time_frc, & - G, CS%restart_CSp) - endif - endif - -!### call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) - - call user_revise_forcing_init(param_file, CS%urf_CS) - - call cpu_clock_end(id_clock_forcing) -end subroutine surface_forcing_init - -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. - - if (present(fluxes)) call deallocate_forcing_type(fluxes) - -!### call controlled_forcing_end(CS%ctrl_forcing_CSp) - - if (associated(CS)) deallocate(CS) - CS => NULL() - -end subroutine surface_forcing_end - -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 - 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%q_flux ', mpp_chksum( iobt%q_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%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 ) - if (associated(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 ) -100 FORMAT(" CHECKSUM::",A20," = ",Z20) - - call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%') - -end subroutine ice_ocn_bnd_type_chksum - -end module MOM_surface_forcing diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 deleted file mode 100644 index af8013efda..0000000000 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ /dev/null @@ -1,604 +0,0 @@ -module mom_cap_methods - - ! This is the main driver for MOM6 in CIME - ! This file is part of MOM6. See LICENSE.md for the license. - - ! mct modules - use ESMF, only: ESMF_time, ESMF_ClockGet, ESMF_TimeGet, ESMF_State, ESMF_Clock - use ESMF, only: ESMF_KIND_R8, ESMF_Field, ESMF_SUCCESS, ESMF_LogFoundError - use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_StateGet, ESMF_FieldGet - use perf_mod, only: t_startf, t_stopf - use MOM_ocean_model, only: ocean_public_type, ocean_state_type - use MOM_surface_forcing, only: ice_ocean_boundary_type - use MOM_grid, only: ocean_grid_type - use MOM_domains, only: pass_var - use MOM_error_handler, only: is_root_pe - use mpp_domains_mod, only: mpp_get_compute_domain - - ! By default make data private - implicit none - private - - ! Public member functions - public :: mom_export - public :: mom_import - - integer :: rc,dbrc - integer :: import_cnt = 0 - character(len=1024) :: tmpstr - - logical, parameter :: debug=.false. - -!----------------------------------------------------------------------- -contains -!----------------------------------------------------------------------- - - !> Maps outgoing ocean data to ESMF State - !! See \ref section_mom_export for a summary of the data - !! that is transferred from MOM6 to MCT. - subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) - type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state - type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid - type(ESMF_State) , intent(inout) :: exportState !< outgoing data - integer , intent(in) :: logunit - type(ESMF_Clock) , intent(in) :: clock - integer , intent(inout) :: rc - - ! Local variables - real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo - integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices - integer :: lbnd1, lbnd2, ubnd1, ubnd2 - real :: slp_L, slp_R, slp_C, slope, u_min, u_max - integer :: day, secs - type(ESMF_time) :: currTime - real(ESMF_KIND_R8), pointer :: dataPtr_omask(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_t(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_s(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_u(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_v(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_q(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_fswpen(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_roce_16O(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_roce_HDO(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_fco2_ocn(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_fdms_ocn(:,:) - character(len=*), parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" - character(len=*), parameter :: subname = '(mom_export)' - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - call State_getFldPtr(exportState,"So_omask", dataPtr_omask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"So_t", dataPtr_t, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"So_s", dataPtr_s, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"So_u", dataPtr_u, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"So_v", dataPtr_v, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"Fioo_q", dataPtr_q, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"So_dhdx", dataPtr_dhdx, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"So_dhdy", dataPtr_dhdy, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - !TODO: need to add the So_bldepth since this is needed for the wave model - call State_getFldPtr(exportState,"So_bldepth", dataPtr_bldepth, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,"So_fswpen", dataPtr_fswpen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! call State_getFldPtr(exportState,"So_roce_16O", dataPtr_roce_16O, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! call State_getFldPtr(exportState,"So_roce_HDO", dataPtr_roce_HDO, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! call State_getFldPtr(exportState,"Faoo_fco2_ocn", dataPtr_fco2_ocn, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! call State_getFldPtr(exportState,"Faoo_fdms_ocn", dataPtr_fdms_ocn, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - - lbnd1 = lbound(dataPtr_t,1) - ubnd1 = ubound(dataPtr_t,1) - lbnd2 = lbound(dataPtr_t,2) - ubnd2 = ubound(dataPtr_t,2) - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - - !Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. - !The mask comes from "grid" that uses the usual MOM domain that has halos - !and does not use global indexing. - do j = jsc, jec - j1 = j + lbnd2 - jsc - jg = j + grid%jsc - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + grid%isc - isc - dataPtr_omask(i1,j1) = grid%mask2dT(ig,jg) - dataPtr_t(i1,j1) = ocean_public%t_surf(i,j) * grid%mask2dT(ig,jg) ! surface temp is in K - dataPtr_s(i1,j1) = ocean_public%s_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_u(i1,j1) = ocean_public%u_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_v(i1,j1) = ocean_public%v_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_q(i1,j1) = 0. - dataPtr_bldepth(i1,j1) = 0. ! TODO: this needs to be generalized - !dataPtr_u(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%u_surf(i,j) & - ! - grid%sin_rot(ig,jg) * ocean_public%v_surf(i,j)) * grid%mask2dT(ig,jg) - !dataPtr_v(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%v_surf(i,j) & - ! + grid%sin_rot(ig,jg) * ocean_public%u_surf(i,j)) * grid%mask2dT(ig,jg) - end do - end do - - ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain - ! in order to update halos. i.e. does not use global indexing. - do j=grid%jsc, grid%jec - jg = j + grid%jdg_offset - do i=grid%isc,grid%iec - ig = i + grid%idg_offset - ssh(i,j) = ocean_public%sea_lev(ig,jg) - end do - end do - - ! Update halo of ssh so we can calculate gradients - call pass_var(ssh, grid%domain) - - ! d/dx ssh - do jg = jsc, jec - j = jg + grid%jsc - jsc - j1 = jg + lbnd2 - jsc - do ig = isc,iec - i = ig + grid%isc - isc - i1 = ig + lbnd1 - isc - - ! This is a simple second-order difference - !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(ig,jg) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(i-1,j) - if (grid%mask2dCu(i-1,j)==0.) slp_L = 0. - slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(i,j) - if (grid%mask2dCu(i+1,j)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - if ( (slp_L * slp_R) > 0.0 ) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - dataPtr_dhdx(i1,j1) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) dataPtr_dhdx(i1,j1) = 0.0 - end do - end do - - ! d/dy ssh - do jg = jsc, jec - j = jg + grid%jsc - jsc - j1 = jg + lbnd2 - jsc - do ig = isc,iec - i = ig + grid%isc - isc - i1 = ig + lbnd1 - isc - - ! This is a simple second-order difference - !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(ig,jg) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,j-1) - if (grid%mask2dCv(i,j-1)==0.) slp_L = 0. - slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,j) - if (grid%mask2dCv(i,j+1)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R - if ((slp_L * slp_R) > 0.0) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - dataPtr_dhdy(i1,j1) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) dataPtr_dhdy(i1,j1) = 0.0 - end do - end do - - if (debug .and. is_root_pe()) then - call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) - call ESMF_TimeGet(CurrTime, d=day, s=secs, rc=rc) - - do j = jsc, jec - j1 = j + lbnd2 - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - write(logunit,F01)'export: day, secs, j, i, t_surf = ',day,secs,j,i,dataPtr_t(i1,j1) - write(logunit,F01)'export: day, secs, j, i, s_surf = ',day,secs,j,i,dataPtr_s(i1,j1) - write(logunit,F01)'export: day, secs, j, i, u_surf = ',day,secs,j,i,dataPtr_u(i1,j1) - write(logunit,F01)'export: day, secs, j, i, v_surf = ',day,secs,j,i,dataPtr_v(i1,j1) - write(logunit,F01)'export: day, secs, j, i, dhdx = ',day,secs,j,i,dataPtr_dhdx(i1,j1) - write(logunit,F01)'export: day, secs, j, i, dhdy = ',day,secs,j,i,dataPtr_dhdy(i1,j1) - end do - end do - end if - - end subroutine mom_export - -!----------------------------------------------------------------------- - - !> 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. - subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & - logunit, runtype, clock, rc) - - type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state - type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid - type(ESMF_State) , intent(inout) :: importState !< incoming data - type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing - type(ESMF_Clock) , intent(in) :: clock - integer , intent(in) :: logunit - character(len=*) , intent(in) :: runtype - integer , intent(inout) :: rc - - ! Local Variables - integer :: i, j, i1, j1, ig, jg ! Grid indices - integer :: isc, iec, jsc, jec ! Grid indices - integer :: isc_bnd, jsc_bnd, ise_bnd, jse_bnd - integer :: lbnd1, lbnd2, ubnd1, ubnd2 - integer :: i0, j0, is, js, ie, je - real(ESMF_KIND_R8), pointer :: dataPtr_p(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ifrac(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_duu10n(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_co2prog(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_co2diag(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lamult(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ustokes(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_vstokes(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_taux(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_tauy(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_sen(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lat(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_osalt(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lwdn(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lwup(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swvdr(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swvdf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swndr(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swndf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swnet(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_rofl(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_rofi(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_meltw(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_melth(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_iosalt(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_prec(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_rain(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_snow(:,:) - integer :: day, secs - type(ESMF_time) :: currTime - logical :: do_import - character(len=*), parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" - character(len=*), parameter :: subname = '(mom_import)' - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! import_cnt is used to skip using the import state at the first count - import_cnt = import_cnt + 1 - - call State_getFldPtr(importState,'Sa_pslv', dataPtr_p,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'Si_ifrac', dataPtr_ifrac,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"So_duu10n", dataPtr_duu10n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! call State_getFldPtr(importState,"Sa_co2prog", dataPtr_co2prog, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! call State_getFldPtr(importState,"Sa_co2diag", dataPtr_co2diag, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - call State_getFldPtr(importState,"Sw_lamult", dataPtr_lamult, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Sw_ustokes", dataPtr_ustokes, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Sw_vstokes", dataPtr_vstokes, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Faxa_swndr" , dataPtr_swndr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Faxa_swndf" , dataPtr_swndf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Faxa_swvdr" , dataPtr_swvdr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Faxa_swvdf" , dataPtr_swvdf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_taux" , dataPtr_taux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_tauy" , dataPtr_tauy, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_sen" , dataPtr_sen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_lat" , dataPtr_lat, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_evap" , dataPtr_evap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Fioi_salt" , dataPtr_osalt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Faxa_lwdn" , dataPtr_lwdn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_lwup" , dataPtr_lwup, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_swnet", dataPtr_swnet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_rofl" , dataPtr_rofl, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_rofi" , dataPtr_rofi, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Fioi_meltw", dataPtr_meltw, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Fioi_melth", dataPtr_melth, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Fioi_salt" , dataPtr_iosalt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Faxa_prec" , dataPtr_prec, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Faxa_rain" , dataPtr_rain, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Faxa_snow" , dataPtr_snow, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - lbnd1 = lbound(dataPtr_p,1) - ubnd1 = ubound(dataPtr_p,1) - lbnd2 = lbound(dataPtr_p,2) - ubnd2 = ubound(dataPtr_p,2) - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - - if ((trim(runtype) == 'initial' .and. import_cnt <= 2)) then - ! This will skip the first time import information is given - do_import = .false. - else - do_import = .true. - end if - - if (do_import) then - do j = jsc, jec - j1 = j + lbnd2 - jsc - jg = j + grid%jsc - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + grid%jsc - isc - - ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) - ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) - ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) - ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) - ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) - ice_ocean_boundary%t_flux(i,j) = -dataPtr_sen(i1,j1) - ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) - ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1) - ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(i1,j1) - ice_ocean_boundary%salt_flux(i,j) = dataPtr_iosalt(i1,j1) - ice_ocean_boundary%runoff(i,j) = dataPtr_rofl(i1,j1) + dataPtr_rofi(i1,j1) - !ice_ocean_boundary%salt_flux(i,j) = dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j) - !ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(i1,j1) - !ice_ocean_boundary%u_flux(i,j) =& - ! GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1) - !ice_ocean_boundary%v_flux(i,j) =& - ! GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1) - enddo - enddo - end if - - ! debug output - if (do_import .and. debug .and. is_root_pe()) then - call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) - call ESMF_TimeGet(CurrTime, d=day, s=secs, rc=rc) - - i0 = GRID%isc - isc - j0 = GRID%jsc - jsc - do j = GRID%jsc, GRID%jec - do i = GRID%isc, GRID%iec - write(logunit,F01)'import: day, secs, j, i, u_flux = '& - ,day,secs,j,i,ice_ocean_boundary%u_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, v_flux = '& - ,day,secs,j,i,ice_ocean_boundary%v_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, lprec = '& - ,day,secs,j,i,ice_ocean_boundary%lprec(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, lwrad = '& - ,day,secs,j,i,ice_ocean_boundary%lw_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, q_flux = '& - ,day,secs,j,i,ice_ocean_boundary%q_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, t_flux = '& - ,day,secs,j,i,ice_ocean_boundary%t_flux(i-i0,j-j0) - !write(logunit,F01)'import: day, secs, j, i, latent_flux = '& - ! ,day,secs,j,i,ice_ocean_boundary%latent_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, runoff = '& - ,day,secs,j,i,ice_ocean_boundary%runoff(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, psurf = '& - ,day,secs,j,i,ice_ocean_boundary%p(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, salt_flux = '& - ,day,secs,j,i,ice_ocean_boundary%salt_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dir = '& - ,day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dir(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dif = '& - ,day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dif(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dir = '& - ,day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dif = '& - ,day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i-i0,j-j0) - end do - end do - end if - - end subroutine mom_import - - !----------------------------------------------------------------------------- - - subroutine State_GetFldPtr(ST, fldname, fldptr, rc) - type(ESMF_State) , intent(in) :: ST - character(len=*) , intent(in) :: fldname - real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:,:) - integer, optional , intent(out) :: rc - - ! local variables - type(ESMF_Field) :: lfield - integer :: lrc - character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' - - call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (present(rc)) rc = lrc - - end subroutine State_GetFldPtr - -end module mom_cap_methods diff --git a/config_src/nuopc_driver/ocn_comp_nuopc.F90 b/config_src/nuopc_driver/ocn_comp_nuopc.F90 deleted file mode 100644 index 4f484efa82..0000000000 --- a/config_src/nuopc_driver/ocn_comp_nuopc.F90 +++ /dev/null @@ -1,2742 +0,0 @@ -!> -!! @mainpage MOM NUOPC Cap -!! @author Fei Liu (fei.liu@gmail.com) -!! @date 5/10/13 Original documentation -!! @author Rocky Dunlap (rocky.dunlap@noaa.gov) -!! @date 1/12/17 Moved to doxygen -!! -!! @tableofcontents -!! -!! @section Overview Overview -!! -!! **This MOM cap has been tested with MOM6.** -!! -!! This document describes the MOM "cap", which is a small software layer that is -!! required when the [MOM ocean model] (http://mom-ocean.org/web) -!! is used in [National Unified Operation Prediction Capability] -!! (http://www.earthsystemcog.org/projects/nuopc) (NUOPC) coupled systems. -!! The NUOPC Layer is a software layer built on top of the [Earth System Modeling -!! Framework] (https://www.earthsystemcog.org/projects/esmf) (ESMF). -!! ESMF is a high-performance modeling framework that provides -!! data structures, interfaces, and operations suited for building coupled models -!! from a set of components. NUOPC refines the capabilities of ESMF by providing -!! a more precise definition of what it means for a model to be a component and -!! how components should interact and share data in a coupled system. The NUOPC -!! Layer software is designed to work with typical high-performance models in the -!! Earth sciences domain, most of which are written in Fortran and are based on a -!! distributed memory model of parallelism (MPI). -!! A NUOPC "cap" is a Fortran module that serves as the interface to a model -!! when it's used in a NUOPC-based coupled system. -!! The term "cap" is used because it is a small software layer that sits on top -!! of model code, making calls into it and exposing model data structures in a -!! standard way. For more information about creating NUOPC caps in general, please -!! see the [Building a NUOPC Model] -!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_howtodoc/) -!! how-to document. -!! -!! The MOM cap package includes the cap itself (mom_cap.F90, a Fortran module), a -!! set of time utilities (time_utils.F90) for converting between ESMF and FMS -!! time types, and two makefiles. Also included are self-describing dependency -!! makefile fragments (mom.mk and mom.mk.template), although these can be generated -!! by the makefiles for specific installations of the MOM cap. -!! -!! @subsection CapSubroutines Cap Subroutines -!! -!! The MOM cap Fortran module contains a set of subroutines that are required -!! by NUOPC. These subroutines are called by the NUOPC infrastructure according -!! to a predefined calling sequence. Some subroutines are called during -!! initialization of the coupled system, some during the run of the coupled -!! system, and some during finalization of the coupled system. The initialization -!! sequence is the most complex and is governed by the NUOPC technical rules. -!! Details about the initialization sequence can be found in the [NUOPC Reference Manual] -!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html -!! #SECTION00034000000000000000). -!! -!! A particularly important part of the NUOPC intialization sequence is to establish -!! field connections between models. Simply put, a field connection is established -!! when a field output by one model can be consumed by another. As an example, the -!! MOM model is able to accept a precipitation rate when coupled to an atmosphere -!! model. In this case a field connection will be established between the precipitation -!! rate exported from the atmosphere and the precipitation rate imported into the -!! MOM model. Because models may uses different variable names for physical -!! quantities, NUOPC relies on a set of standard names and a built-in, extensible -!! standard name dictionary to match fields between models. More information about -!! the use of standard names can be found in the [NUOPC Reference Manual] -!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html -!! #SECTION00032000000000000000). -!! -!! Two key initialization phases that appear in every NUOPC cap, including this MOM -!! cap are the field "advertise" and field "realize" phases. *Advertise* is a special -!! NUOPC term that refers to a model participating in a coupled system -!! providing a list of standard names of required import fields and available export -!! fields. In other words, each model will advertise to the other models which physical fields -!! it needs and which fields it can provide when coupled. NUOPC compares all of the advertised -!! standard names and creates a set of unidirectional links, each from one export field -!! in a model to one import field in another model. When these connections have been established, -!! all models in the coupled system need to provide a description of their geographic -!! grid (e.g., lat-lon, tri-polar, cubed sphere, etc.) and allocate their connected -!! fields on that grid. In NUOPC terms, this is refered to as *realizing* a set of -!! fields. NUOPC relies on ESMF data types for this, such as the [ESMF_Grid] -!! (http://www.earthsystemmodeling.org/esmf_releases/public/last/ESMF_refdoc/node5.html#SECTION05080000000000000000) -!! type, which describes logically rectangular grids and the [ESMF_Field] -!! (http://www.earthsystemmodeling.org/esmf_releases/public/last/ESMF_refdoc/node5.html#SECTION05030000000000000000) -!! type, which wraps a models data arrays and provides basic metadata. Because ESMF supports -!! interpolation between different grids (sometimes called "regridding" or "grid remapping"), -!! it is not necessary that models share a grid. As you will see below -!! the *advertise* and *realize* phases each have a subroutine in the HYCOM cap. -!! -!! The following table summarizes the NUOPC-required subroutines that appear in the -!! MOM cap. The "Phase" column says whether the subroutine is called during the -!! initialization, run, or finalize part of the coupled system run. -!! -!! Phase | MOM Cap Subroutine | Description -!! ---------|--------------------------------------------------------------------|-------------------------------------- -!! Init | [InitializeP0] (@ref ocn_comp_nuopc::initializep0) | Sets the Initialize Phase Definition -!! | (IPD) version to use -!! Init | [InitializeAdvertise] (@ref ocn_comp_nuopc::initializeadvertise) | Advertises standard names of import -!! | and export fields -!! Init | [InitializeRealize] (@ref ocn_comp_nuopc::initializerealize) | Creates an ESMF_Grid for the MOM grid -!! | as well as ESMF_Fields for import -!! | and export fields -!! Run | [ModelAdvance] (@ref ocn_comp_nuopc::modeladvance) | Advances the model by a timestep -!! Final | [Finalize] (@ref ocn_comp_nuopc::ocean_model_finalize) | Cleans up -!! -!! @section UnderlyingModelInterfaces Underlying Model Interfaces -!! -!! -!! @subsection DomainCreation Domain Creation -!! -!! The MOM tripolar grid is represented as a 2D `ESMF_Grid` and coupling fields are placed -!! on this grid. Calls related to creating the grid are located in the [InitializeRealize] -!! (@ref ocn_comp_nuopc::initializerealize) subroutine, which is called by the NUOPC infrastructure -!! during the intialization sequence. -!! -!! The cap determines parameters for setting up the grid by calling subroutines in the -!! `mpp_domains_mod` module. The global domain size is determined by calling `mpp_get_global_domain()`. -!! A check is in place to ensure that there is only a single tile in the domain (the -!! cap is currently limited to one tile; multi-tile mosaics are not supported). The -!! decomposition across processors is determined via calls to `mpp_get_compute_domains()` -!! (to retrieve decomposition block indices) and `mpp_get_pelist()` (to determine how -!! blocks are assigned to processors). -!! -!! The grid is created in several steps: -!! - an `ESMF_DELayout` is created based on the pelist from MOM -!! - an `ESMF_DistGrid` is created over the global index space. Connections are set -!! up so that the index space is periodic in the first dimension and has a -!! fold at the top for the bipole. The decompostion blocks are also passed in -!! along with the `ESMF_DELayout` mentioned above. -!! - an `ESMF_Grid` is then created by passing in the above `ESMF_DistGrid`. -!! -!! Masks, areas, center (tlat, tlon), and corner (ulat, ulon) coordinates are then added to the `ESMF_Grid` -!! by retrieving those fields from MOM with calls to `ocean_model_data_get()`. -!! -!! @subsection Initialization Initialization -!! -!! During the [InitializeAdvertise] (@ref ocn_comp_nuopc::initializeadvertise) phase, calls are -!! made to MOM's native initialization subroutines, including `fms_init()`, `constants_init()`, -!! `field_manager_init()`, `diag_manager_init()`, and `set_calendar_type()`. The MPI communicator -!! is pulled in through the ESMF VM object for the MOM component. The dt and start time are set -!! from parameters from the incoming ESMF clock with calls to `set_time()` and `set_date().` -!! -!! -!! @subsection Run Run -!! -!! The [ModelAdvance] (@ref ocn_comp_nuopc::modeladvance) subroutine is called by the NUOPC -!! infrastructure when it's time for MOM to advance in time. During this subroutine, there is a -!! call into the MOM update routine: -!! -!! call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_public, Time, Time_step_coupled) -!! -!! Prior to this call, the cap performs a few steps: -!! - the `Time` and `Time_step_coupled` parameters, based on FMS types, are derived from the incoming ESMF clock -!! - there are calls to two stubs: `ice_ocn_bnd_from_data()` and `external_coupler_sbc_before()` - these are currently -!! inactive, but may be modified to read in import data from file or from an external coupler -!! - diagnostics are optionally written to files `field_ocn_import_*`, one for each import field -!! - import fields are prepared: -!! - the sign is reversed on `mean_evap_rate` and `mean_sensi_heat_flux` -!! - momentum flux vectors are rotated to internal grid -!! - optionally, a call is made to `ocean_model_restart()` at the interval `restart_interval` -!! -!! After the call to `update_ocean_model()`, the cap performs these steps: -!! - the `ocean_mask` export is set to match that of the internal MOM mask -!! - the `freezing_melting_potential` export is converted from J m-2 to W m-2 by dividing by the coupling interval -!! - vector rotations are applied to the `ocean_current_zonal` and `ocean_current_merid` exports, back to lat-lon grid -!! - diagnostics are optionally written to files `field_ocn_export_*`, one for each export field -!! - a call is made to `external_coupler_sbc_after()` to update exports from an external coupler (currently an inactive -!! stub) -!! -!! @subsubsection VectorRotations Vector Rotations -!! -!! Vector rotations are applied to incoming momentum fluxes (from regular lat-lon to tripolar grid) and -!! outgoing ocean currents (from tripolar to regular lat-lon). The rotation angles are provided -!! from the native MOM grid by a call to `get_ocean_grid(Ocean_grid)`. -!! The cosine and sine of the rotation angle are: -!! -!! ocean_grid%cos_rot(i,j) -!! ocean_grid%sin_rot(i,j) -!! -!! The rotation of momentum flux from regular lat-lon to tripolar is: -!! \f[ -!! \begin{bmatrix} -!! \tau_x' \\ -!! \tau_y' -!! \end{bmatrix} = -!! \begin{bmatrix} -!! cos \theta & sin \theta \\ -!! -sin \theta & cos \theta -!! \end{bmatrix} * -!! \begin{bmatrix} -!! \tau_x \\ -!! \tau_y -!! \end{bmatrix} -!! \f] -!! -!! The rotation of ocean current from tripolar to regular lat-lon is: -!! \f[ -!! \begin{bmatrix} -!! u' \\ -!! v' -!! \end{bmatrix} = -!! \begin{bmatrix} -!! cos \theta & -sin \theta \\ -!! sin \theta & cos \theta -!! \end{bmatrix} * -!! \begin{bmatrix} -!! u \\ -!! v -!! \end{bmatrix} -!! \f] -!! @subsection Finalization Finalization -!! -!! NUOPC infrastructure calls [ocean_model_finalize] (@ref ocn_comp_nuopc::ocean_model_finalize) -!! at the end of the run. This subroutine is a hook to call into MOM's native shutdown -!! procedures: -!! -!! call ocean_model_end (ocean_public, ocean_State, Time) -!! call diag_manager_end(Time ) -!! call field_manager_end -!! call fms_io_exit -!! call fms_end -!! -!! @section ModelFields Model Fields -!! -!! The following tables list the import and export fields currently set up in the MOM cap. -!! -!! @subsection ImportFields Import Fields -!! -!! Standard Name | Units | Model Variable | Description | Notes -!! --------------------------|------------|-----------------|---------------------------------------|------------------- -!! inst_pres_height_surface | Pa | p | pressure of overlying sea ice and atmosphere -!! mass_of_overlying_sea_ice | kg | mi | mass of overlying sea ice | | -!! mean_calving_heat_flx | W m-2 | calving_hflx | heat flux, relative to 0C, of frozen land water into ocean -!! mean_calving_rate | kg m-2 s-1 | calving | mass flux of frozen runoff | | -!! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | sign reversed (- evap) -!! mean_fprec_rate | kg m-2 s-1 | fprec | mass flux of frozen precip | | -!! mean_merid_moment_flx | Pa | v_flux | j-directed wind stress into ocean -!! | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar -!! mean_net_lw_flx | W m-2 | lw_flux | long wave radiation | | -!! mean_net_sw_ir_dif_flx | W m-2 | sw_flux_nir_dif | diffuse near IR shortwave radiation| | -!! mean_net_sw_ir_dir_flx | W m-2 | sw_flux_nir_dir | direct near IR shortwave radiation| | -!! mean_net_sw_vis_dif_flx | W m-2 | sw_flux_vis_dif | diffuse visible shortware radiation| | -!! mean_net_sw_vis_dir_flx | W m-2 | sw_flux_vis_dir | direct visible shortware radiation| | -!! mean_prec_rate | kg m-2 s-1 | lprec | mass flux of liquid precip | | -!! mean_runoff_heat_flx | W m-2 | runoff_hflx | heat flux, relative to 0C, of liquid land water into ocean -!! mean_runoff_rate | kg m-2 s-1 | runoff | mass flux of liquid runoff | | -!! mean_salt_rate | kg m-2 s-1 | salt_flux | salt flux | | -!! mean_sensi_heat_flx | W m-2 | t_flux | sensible heat flux into ocean | sign reversed (- sensi) -!! mean_zonal_moment_flx | Pa | u_flux | j-directed wind stress into ocean -!! | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar -!! -!! -!! @subsection ExportField Export Fields -!! -!! Export fields are populated from the `ocean_public` parameter (type `ocean_public_type`) -!! after the call to `update_ocean_model()`. -!! -!! Standard Name | Units | Model Variable | Description | Notes -!! ---------------------------|-------|----------------|-------------------------------------------|-------------------- -!! freezing_melting_potential | W m-2 | frazil | accumulated heating from frazil formation -!! | cap converts model units (J m-2) to (W m-2) for export -!! ocean_mask | | | ocean mask | | -!! ocn_current_merid | m s-1 | v_surf | j-directed surface velocity on u-cell -!! | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon -!! ocn_current_zonal | m s-1 | u_surf | i-directed surface velocity on u-cell -!! | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon -!! s_surf | psu | s_surf | sea surface salinity on t-cell | | -!! sea_lev | m | sea_lev | sea level -!! | model computation is eta_t + patm/(rho0*grav) - eta_geoid - eta_tide -!! sea_surface_temperature | K | t_surf | sea surface temperature on t-cell | | -!! -!! @subsection MemoryManagement Memory Management -!! -!! The MOM cap has an internal state type with pointers to three -!! types defined by MOM. There is also a small wrapper derived type -!! required to associate an internal state instance -!! with the ESMF/NUOPC component: -!! -!! type ocean_internalstate_type -!! type(ocean_public_type), pointer :: ocean_public_type_ptr -!! type(ocean_state_type), pointer :: ocean_state_type_ptr -!! type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr -!! end type -!! -!! type ocean_internalstate_wrapper -!! type(ocean_internalstate_type), pointer :: ptr -!! end type -!! -!! The member of type `ocean_public_type` stores ocean surface fields used during the coupling. -!! The member of type `ocean_state_type` is required by the ocean driver, -!! although its internals are private (not to be used by the coupling directly). -!! This type is passed to the ocean init and update routines -!! so that it can maintain state there if desired. -!! The member of type `ice_ocean_boundary_type` is populated by this cap -!! with incoming coupling fields from other components. These three derived types are allocated during the -!! [InitializeAdvertise] (@ref ocn_comp_nuopc::initializeadvertise) phase. Also during that -!! phase, the `ice_ocean_boundary` type members are all allocated using bounds retrieved -!! from `mpp_get_compute_domain()`. -!! -!! During the [InitializeRealize] (@ref ocn_comp_nuopc::initializerealize) phase, -!! `ESMF_Field`s are created for each of the coupling fields in the `ice_ocean_boundary` -!! and `ocean_public_type` members of the internal state. These fields directly reference into the members of -!! the `ice_ocean_boundary` and `ocean_public_type` so that memory-to-memory copies are not required to move -!! data from the cap's import and export states to the memory areas used internally -!! by MOM. -!! -!! @subsection IO I/O -!! -!! The cap can optionally output coupling fields for diagnostic purposes if the ESMF attribute -!! "DumpFields" has been set to "true". In this case the cap will write out NetCDF files -!! with names "field_ocn_import_.nc" and "field_ocn_export_.nc". -!! Additionally, calls will be made to the cap subroutine [dumpMomInternal] -!! (@ref ocn_comp_nuopc::dumpmominternal) to write out model internal fields to files -!! named "field_ocn_internal_.nc". In all cases these NetCDF files will -!! contain a time series of field data. -!! -!! @section BuildingAndInstalling Building and Installing -!! -!! There are two makefiles included with the MOM cap, makefile and makefile.nuopc. -!! The makefile.nuopc file is intended to be used within another build system, such -!! as the NEMSAppBuilder. The regular makefile can be used generally for building -!! and installing the cap. Two variables must be customized at the top: -!! - `INSTALLDIR` - where to copy the cap library and dependent libraries -!! - `NEMSMOMDIR` - location of the MOM library and FMS library -!! -!! To install run: -!! $ make install -!! -!! A makefile fragment, mom.mk, will also be copied into the directory. The fragment -!! defines several variables that can be used by another build system to include the -!! MOM cap and its dependencies. -!! -!! @subsection Dependencies Dependencies -!! -!! The MOM cap is dependent on the MOM library itself (lib_ocean.a) and the FMS -!! library (lib_FMS.a). -!! -!! @section RuntimeConfiguration Runtime Configuration -!! -!! At runtime, the MOM cap can be configured with several options provided -!! as ESMF attributes. Attributes can be set in the cap by the NUOPC Driver -!! above this cap, or in some systems (e.g., NEMS) attributes are set by -!! reading in from a configuration file. The available attributes are: -!! -!! * `DumpFields` - when set to "true", write out diagnostic NetCDF files for import/export/internal fields -!! * `ProfileMemory` - when set to "true", write out memory usage information to the ESMF log files; this -!! information is written when entering and leaving the [ModelAdvance] -!! (@ref ocn_comp_nuopc::modeladvance) subroutine and before and after the call to -!! `update_ocean_model()`. -!! * `restart_interval` - integer number of seconds indicating the interval at -!! which to call `ocean_model_restart()`; no restarts written if set to 0 -!! * `GridAttachArea` - when set to "true", this option indicates that MOM grid attaches cell area -!! using internal values computed in MOM. The default value is "false", grid cell area will -!! be computed in ESMF. -!! -!! -!! @section Repository -!! The MOM NUOPC cap is maintained in a GitHub repository: -!! https://github.com/feiliuesmf/nems_mom_cap -!! -!! @section References -!! -!! - [MOM Home Page] (http://mom-ocean.org/web) -!! -!! -module ocn_comp_nuopc - use constants_mod, only: constants_init - use data_override_mod, only: data_override_init, data_override - use diag_manager_mod, only: diag_manager_init, diag_manager_end - use field_manager_mod, only: field_manager_init, field_manager_end - use fms_mod, only: fms_init, fms_end, open_namelist_file, check_nml_error - use fms_mod, only: close_file, file_exist, uppercase - use fms_io_mod, only: fms_io_exit - use mpp_domains_mod, only: domain2d, mpp_get_compute_domain, mpp_get_compute_domains - use mpp_domains_mod, only: mpp_get_ntile_count, mpp_get_pelist, mpp_get_global_domain - use mpp_domains_mod, only: mpp_get_domain_npes, mpp_global_field - use mpp_io_mod, only: mpp_open, MPP_RDONLY, MPP_ASCII, MPP_OVERWR, MPP_APPEND, mpp_close, MPP_SINGLE - use mpp_mod, only: input_nml_file, mpp_error, FATAL, NOTE, mpp_pe, mpp_npes, mpp_set_current_pelist - use mpp_mod, only: stdlog, stdout, mpp_root_pe, mpp_clock_id - use mpp_mod, only: mpp_clock_begin, mpp_clock_end, MPP_CLOCK_SYNC - use mpp_mod, only: MPP_CLOCK_DETAILED, CLOCK_COMPONENT, MAXPES - use time_interp_external_mod, only: time_interp_external_init - use time_manager_mod, only: set_calendar_type, time_type, increment_date - use time_manager_mod, only: set_time, set_date, get_time, get_date, month_name - use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR - use time_manager_mod, only: operator( <= ), operator( < ), operator( >= ) - use time_manager_mod, only: operator( + ), operator( - ), operator( / ) - use time_manager_mod, only: operator( * ), operator( /= ), operator( > ) - use time_manager_mod, only: date_to_string - use time_manager_mod, only: fms_get_calendar_type => get_calendar_type - use MOM_domains, only: MOM_infra_init, num_pes, root_pe, pe_here - use MOM_surface_forcing, only: IOB_allocate - use MOM_file_parser, only: get_param, log_version, param_file_type, close_param_file - use MOM_get_input, only: Get_MOM_Input, directories - use MOM_domains, only: pass_var - use MOM_error_handler, only: is_root_pe - use MOM_ocean_model, only: ice_ocean_boundary_type - use MOM_grid, only: ocean_grid_type - use MOM_ocean_model, only: ocean_model_restart, ocean_public_type, ocean_state_type - use MOM_ocean_model, only: ocean_model_data_get, ocean_model_init_sfc - use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid -#ifdef CESMCOUPLED - use mom_cap_methods, only: mom_import, mom_export - use esmFlds, only: flds_scalar_name, flds_scalar_num - use esmFlds, only: fldListFr, fldListTo, compocn, compname - use esmFlds, only: flds_scalar_index_nx, flds_scalar_index_ny - use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Realize - use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Concat - use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Getnumflds - use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Getfldinfo - use shr_nuopc_methods_mod, only: shr_nuopc_methods_State_SetScalar - use shr_nuopc_methods_mod, only: shr_nuopc_methods_State_GetScalar - use shr_nuopc_methods_mod, only: shr_nuopc_methods_State_Diagnose - use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit, shr_file_setIO - use shr_file_mod, only: shr_file_getLogUnit, shr_file_getLogLevel - use shr_file_mod, only: shr_file_setLogUnit, shr_file_setLogLevel -#endif - - use ESMF ! TODO: only: ... - use NUOPC ! TODO: only: ... - use NUOPC_Model, & ! TODO: only: ... - model_routine_SS => SetServices, & - model_label_DataInitialize => label_DataInitialize, & - model_label_Advance => label_Advance, & -#ifdef CESMCOUPLED - model_label_SetRunClock => label_SetRunClock, & -#endif - model_label_Finalize => label_Finalize - - use time_utils_mod, only: esmf2fms_time - - implicit none - private - - public SetServices - - type ocean_internalstate_type - type(ocean_public_type), pointer :: ocean_public_type_ptr - type(ocean_state_type), pointer :: ocean_state_type_ptr - type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr - end type - - type ocean_internalstate_wrapper - type(ocean_internalstate_type), pointer :: ptr - end type - - type fld_list_type - character(len=64) :: stdname - character(len=64) :: shortname - character(len=64) :: transferOffer - logical :: assoc ! is the farrayPtr associated with internal data - real(ESMF_KIND_R8), dimension(:,:), pointer :: farrayPtr - end type fld_list_type - - integer,parameter :: fldsMax = 100 - integer :: fldsToOcn_num = 0 - type (fld_list_type) :: fldsToOcn(fldsMax) - integer :: fldsFrOcn_num = 0 - type (fld_list_type) :: fldsFrOcn(fldsMax) - - integer :: debug = 0 - integer :: import_slice = 1 - integer :: export_slice = 1 - character(len=256) :: tmpstr - integer :: dbrc - type(ESMF_Grid) :: mom_grid_i - -#ifdef CESMCOUPLED - logical :: write_diagnostics = .false. - integer :: logunit ! stdout logging unit number - character(len=32) :: runtype ! run type -#else - logical :: write_diagnostics = .true. -#endif - logical :: profile_memory = .true. - logical :: grid_attach_area = .false. - integer(ESMF_KIND_I8) :: restart_interval - logical :: sw_decomp - character(len=*),parameter :: u_file_u = & - __FILE__ - -contains - - !=============================================================================== - !> NUOPC SetService method is the only public entry point. - !! SetServices registers all of the user-provided subroutines - !! in the module with the NUOPC layer. - !! - !! @param gcomp an ESMF_GridComp object - !! @param rc return code - subroutine SetServices(gcomp, rc) - - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - character(len=*),parameter :: subname='(mom_cap:SetServices)' - - rc = ESMF_SUCCESS - - ! the NUOPC model component will register the generic methods - call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! switching to IPD versions - call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - userRoutine=InitializeP0, phase=0, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! set entry point for methods that require specific implementation - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv01p1"/), userRoutine=InitializeAdvertise, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv01p3"/), userRoutine=InitializeRealize, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !------------------ - ! attach specializing method(s) - !------------------ - - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_DataInitialize, & - specRoutine=DataInitialize, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & - specRoutine=ModelAdvance, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - -#ifdef CESMCOUPLED - call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, & - specRoutine=ModelSetRunClock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -#endif - - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & - specRoutine=ocean_model_finalize, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end subroutine SetServices - - !=============================================================================== - - !> First initialize subroutine called by NUOPC. The purpose - !! is to set which version of the Initialize Phase Definition (IPD) - !! to use. - !! - !! For this MOM cap, we are using IPDv01. - !! - !! @param gcomp an ESMF_GridComp object - !! @param importState an ESMF_State object for import fields - !! @param exportState an ESMF_State object for export fields - !! @param clock an ESMF_Clock object - !! @param rc return code - subroutine InitializeP0(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - character(len=10) :: value - character(len=*),parameter :: subname='(mom_cap:InitializeP0)' - - rc = ESMF_SUCCESS - - ! Switch to IPDv01 by filtering all other phaseMap entries - call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, & - acceptStringList=(/"IPDv01p"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_AttributeGet(gcomp, name="DumpFields", value=value, defaultValue="false", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! write_diagnostics=(trim(value)=="true") - call ESMF_LogWrite('MOM_CAP:DumpFields = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_AttributeGet(gcomp, name="ProfileMemory", value=value, defaultValue="true", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - profile_memory=(trim(value)/="false") - call ESMF_LogWrite('MOM_CAP:ProfileMemory = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) - -#ifndef CESMCOUPLED - ! Retrieve restart_interval in (seconds) - ! A restart_interval value of 0 means no restart will be written. - call ESMF_AttributeGet(gcomp, name="restart_interval", value=value, defaultValue="0", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - restart_interval = ESMF_UtilString2Int(value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if(restart_interval < 0) then - call ESMF_LogSetError(ESMF_RC_NOT_VALID, & - msg="MOM_CAP: OCN attribute: restart_interval cannot be negative.", & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return - endif - call ESMF_LogWrite('MOM_CAP:restart_interval = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) -#endif - - call ESMF_AttributeGet(gcomp, name="GridAttachArea", value=value, defaultValue="false", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - grid_attach_area=(trim(value)=="true") - call ESMF_LogWrite('MOM_CAP:GridAttachArea = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) - - end subroutine - - !=============================================================================== - - !> Called by NUOPC to advertise import and export fields. "Advertise" - !! simply means that the standard names of all import and export - !! fields are supplied. The NUOPC layer uses these to match fields - !! between components in the coupled system. - !! - !! @param gcomp an ESMF_GridComp object - !! @param importState an ESMF_State object for import fields - !! @param exportState an ESMF_State object for export fields - !! @param clock an ESMF_Clock object - !! @param rc return code - subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - type(ESMF_VM) :: vm - type(ESMF_Time) :: MyTime - type(ESMF_TimeInterval) :: TINT - type (ocean_public_type), pointer :: ocean_public => NULL() - type (ocean_state_type), pointer :: ocean_state => NULL() - type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() - type(ocean_internalstate_wrapper) :: ocean_internalstate - type(ocean_grid_type), pointer :: ocean_grid => NULL() - type(time_type) :: Run_len ! length of experiment - type(time_type) :: Time - type(time_type) :: Time_restart - type(time_type) :: DT - integer :: DT_OCEAN - integer :: isc,iec,jsc,jec - integer :: dt_cpld = 86400 - integer :: year=0, month=0, day=0, hour=0, minute=0, second=0 - integer :: mpi_comm_mom - integer :: i,n - character(80) :: stdname, shortname -#ifdef CESMCOUPLED - integer :: nflds - logical :: activefld - character(len=32) :: starttype ! model start type - character(len=512) :: diro - character(len=512) :: logfile - character(len=64) :: cvalue - integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - integer :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix = "" ! char string associated with instance - ! (ie. "_0001" or "") - logical :: isPresent - character(len=384) :: restart_pointer_file ! File name for restart pointer file - character(len=384) :: restartfile ! Path/Name of restart file - character(len=384) :: restartname ! The restart file name (no dir) - integer :: nu ! i/o unit to read pointer file -#endif - character(len=*),parameter :: subname='(mom_cap:InitializeAdvertise)' - !-------------------------------- - - rc = ESMF_SUCCESS - - allocate(Ice_ocean_boundary) - !allocate(ocean_state) ! ocean_model_init allocate this pointer - allocate(ocean_public) - allocate(ocean_internalstate%ptr) - ocean_internalstate%ptr%ice_ocean_boundary_type_ptr => Ice_ocean_boundary - ocean_internalstate%ptr%ocean_public_type_ptr => ocean_public - ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state - - call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_VMGet(VM, mpiCommunicator=mpi_comm_mom, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_ClockGet(CLOCK, currTIME=MyTime, TimeStep=TINT, RC=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_TimeGet (MyTime, YY=YEAR, MM=MONTH, DD=DAY, H=HOUR, M=MINUTE, S=SECOND, RC=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - CALL ESMF_TimeIntervalGet(TINT, S=DT_OCEAN, RC=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call fms_init(mpi_comm_mom) - call constants_init - call field_manager_init - call set_calendar_type (JULIAN) - call diag_manager_init - - ! this ocean connector will be driven at set interval - dt_cpld = DT_OCEAN - DT = set_time (DT_OCEAN, 0) - Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) - -#ifdef CESMCOUPLED - - ! determine instance information - call NUOPC_CompAttributeGet(gcomp, name="inst_name", value=inst_name, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call NUOPC_CompAttributeGet(gcomp, name="inst_index", value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - read(cvalue,*) inst_index - - call ESMF_AttributeGet(gcomp, name="inst_suffix", isPresent=isPresent, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (isPresent) then - call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", value=inst_suffix, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else - inst_suffix = '' - end if - - ! reset shr logging to my log file - if (is_root_pe()) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - logunit = shr_file_getUnit() - open(logunit,file=trim(diro)//"/"//trim(logfile)) - else - logunit = 6 - endif - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) - call shr_file_setLogUnit (logunit) - - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - read(cvalue,*) starttype - - if (trim(starttype) == trim('startup')) then - runtype = "initial" - else if (trim(starttype) == trim('continue') ) then - runtype = "continue" - else if (trim(starttype) == trim('branch')) then - runtype = "continue" - else - call ESMF_LogWrite(subname//' ERROR: unknown starttype '//trim(starttype), ESMF_LOGMSG_ERROR, rc=dbrc) - rc = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if - - if (runtype == "initial") then - - ! startup (new run) - 'n' is needed below since we don't specify input_filename in input.nml - ocean_public%is_ocean_pe = .true. - call ocean_model_init(ocean_public, ocean_state, Time, Time, input_restart_file = 'n') - - - else ! hybrid or branch or continuos runs - - ! read name of restart file in the pointer file - nu = shr_file_getUnit() - restart_pointer_file = 'rpointer.ocn' - if (is_root_pe()) then - write(logunit,*) 'Reading ocn pointer file: ',restart_pointer_file - end if - open(nu, file=restart_pointer_file, form='formatted', status='unknown') - read(nu,'(a)') restartfile - close(nu) - - ! initialize from restart file - if (is_root_pe()) then - write(logunit,*) 'Reading restart file: ',trim(restartfile) - end if - call shr_file_freeUnit(nu) - - ocean_public%is_ocean_pe = .true. - call ocean_model_init(ocean_public, ocean_state, Time, Time, input_restart_file=trim(restartfile)) - - end if - call ocean_model_init_sfc(ocean_state, ocean_public) - -#else - - ocean_public%is_ocean_pe = .true. - call ocean_model_init(ocean_public, ocean_state, Time, Time) - -#endif - - !tcx tcraig This results in errors in CESM with help from Alper - ! FATAL error "MPP_OPEN: error in OPEN for data_table" - ! The subroutine data_override_init shouldn't be called because ALLOW_FLUX_ADJUSTMENTS is set to FALSE - !tcx call data_override_init(ocean_domain_in = ocean_public%domain) - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - call IOB_allocate(ice_ocean_boundary, isc, iec, jsc, jec) - - call external_coupler_sbc_init(ocean_public%domain, dt_cpld, Run_len) - - ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state - call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - -#ifdef CESMCOUPLED - - ! create import and export field list needed by data models - ! call shr_nuopc_fldList_Concat(fldListFr(compocn), fldListTo(compocn), flds_o2x, flds_x2o, flds_scalar_name) - - ! advertise import and export fields - nflds = shr_nuopc_fldList_Getnumflds(fldListFr(compocn)) - do n = 1,nflds - call shr_nuopc_fldList_Getfldinfo(fldListFr(compocn), n, activefld, stdname, shortname) - if (activefld) then - call NUOPC_Advertise(exportState, standardName=stdname, shortname=shortname, name=shortname, & - TransferOfferGeomObject='will provide', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end if - call ESMF_LogWrite(subname//':Fr_'//trim(compname(compocn))//': '//trim(shortname), ESMF_LOGMSG_INFO) - end do - - nflds = shr_nuopc_fldList_Getnumflds(fldListTo(compocn)) - do n = 1,nflds - call shr_nuopc_fldList_Getfldinfo(fldListTo(compocn), n, activefld, stdname, shortname) - if (activefld) then - call NUOPC_Advertise(importState, standardName=stdname, shortname=shortname, name=shortname, & - TransferOfferGeomObject='will provide', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_file_u)) return - end if - call ESMF_LogWrite(subname//':To_'//trim(compname(compocn))//': '//trim(shortname), ESMF_LOGMSG_INFO) - end do - -#else - - ! This sets pointers of the fldsToOcn to the iceocean_boundary_type - ! Don't point directly into mom data YET (last field is optional in interface) - ! instead, create space for the field when it's "realized". - - !--------- import fields ------------- - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx" , "will provide",& - data=Ice_ocean_boundary%u_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx" , "will provide",& - data=Ice_ocean_boundary%v_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide",& - data=Ice_ocean_boundary%t_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide",& - data=Ice_ocean_boundary%q_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide",& - data=Ice_ocean_boundary%salt_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide",& - data=Ice_ocean_boundary%lw_flux ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide",& - data=Ice_ocean_boundary%sw_flux_vis_dir) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide",& - data=Ice_ocean_boundary%sw_flux_vis_dif) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide",& - data=Ice_ocean_boundary%sw_flux_nir_dir) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide",& - data=Ice_ocean_boundary%sw_flux_nir_dif) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide",& - data=Ice_ocean_boundary%lprec ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide",& - data=Ice_ocean_boundary%fprec ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide",& - data=Ice_ocean_boundary%runoff ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide",& - data=Ice_ocean_boundary%calving) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide",& - data=Ice_ocean_boundary%runoff_hflx ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide",& - data=Ice_ocean_boundary%calving_hflx) - call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide",& - data=Ice_ocean_boundary%p ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide",& - data=Ice_ocean_boundary%mi) - - !--------- export fields ------------- - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature" , "will provide",& - data=ocean_public%t_surf) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide",& - data=ocean_public%s_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide",& - data=ocean_public%u_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide",& - data=ocean_public%v_surf ) - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir" , "will provide") - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide",& - data=ocean_public%sea_lev) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide",& - data=ocean_public%frazil) - - do n = 1,fldsToOcn_num - call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - enddo - - do n = 1,fldsFrOcn_num - call NUOPC_Advertise(exportState, standardName=fldsFrOcn(n)%stdname, name=fldsFrOcn(n)(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - enddo - -#endif - -! When running mom6 solo, the rotation angles are not computed internally -! in MOM6. We need to calculate cos and sin of rotational angle for MOM6; -! the values are stored in ocean_internalstate%ptr%ocean_grid_ptr%cos_rot and sin_rot -! The rotation angles are retrieved during run time to rotate incoming -! and outgoing vectors -! -! call calculate_rot_angle(ocean_state, ocean_public) -! tcraig, this is handled fine internally and if not, then later call this -! call initialize_grid_rotation_angle(ocean_grid, PF) - - write(*,*) '----- MOM initialization phase Advertise completed' - - end subroutine InitializeAdvertise - - !=============================================================================== - - !> Called by NUOPC to realize import and export fields. "Realizing" a field - !! means that its grid has been defined and an ESMF_Field object has been - !! created and put into the import or export State. - !! - !! @param gcomp an ESMF_GridComp object - !! @param importState an ESMF_State object for import fields - !! @param exportState an ESMF_State object for export fields - !! @param clock an ESMF_Clock object - !! @param rc return code - subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - ! Local Variables - type(ESMF_VM) :: vm - type(ESMF_Grid) :: gridIn - type(ESMF_Grid) :: gridOut - type(ESMF_DeLayout) :: delayout - type(ESMF_Distgrid) :: Distgrid - type(ESMF_DistGridConnection), allocatable :: connectionList(:) - type (ocean_public_type), pointer :: ocean_public => NULL() - type (ocean_state_type), pointer :: ocean_state => NULL() - type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() - type(ocean_internalstate_wrapper) :: ocean_internalstate - integer :: npet, ntiles - integer :: nxg, nyg, cnt - integer :: isc,iec,jsc,jec - integer, allocatable :: xb(:),xe(:),yb(:),ye(:),pe(:) - integer, allocatable :: deBlockList(:,:,:) - integer, allocatable :: petMap(:) - integer, allocatable :: deLabelList(:) - integer, allocatable :: indexList(:) - integer :: ioff, joff - integer :: i, j, n, i1, j1, n1, icount - integer :: lbnd1,ubnd1,lbnd2,ubnd2 - integer :: lbnd3,ubnd3,lbnd4,ubnd4 - integer :: nblocks_tot - logical :: found - real(ESMF_KIND_R8), allocatable :: ofld(:,:), gfld(:,:) - real(ESMF_KIND_R8), pointer :: t_surf(:,:) - integer(ESMF_KIND_I4), pointer :: dataPtr_mask(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_area(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_xcen(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ycen(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_xcor(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ycor(:,:) - type(ESMF_Field) :: field_t_surf - integer :: mpicom - integer :: localPet -#ifdef CESMCOUPLED - integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - integer :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix = "" ! char string associated with instance - ! (ie. "_0001" or "") - character(len=64) :: cvalue - character(len=512) :: diro - character(len=512) :: logfile - logical :: isPresent -#endif - character(len=*),parameter :: subname='(mom_cap:InitializeRealize)' - !-------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------------------------------------------------------- - ! Get pointers to ocean internal state - !---------------------------------------------------------------------------- - - call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr - ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr - ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr - - !---------------------------------------------------------------------------- - ! Get mpi information - !---------------------------------------------------------------------------- - - call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_VMGet(vm, petCount=npet, mpiCommunicator=mpicom, localPet=localPet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !--------------------------------- - ! global mom grid size - !--------------------------------- - - call mpp_get_global_domain(ocean_public%domain, xsize=nxg, ysize=nyg) - write(tmpstr,'(a,2i6)') subname//' nxg,nyg = ',nxg,nyg - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - !--------------------------------- - ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total - !--------------------------------- - - ntiles=mpp_get_ntile_count(ocean_public%domain) ! this is tiles on this pe - if (ntiles /= 1) then - rc = ESMF_FAILURE - call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR, rc=dbrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - ntiles=mpp_get_domain_npes(ocean_public%domain) - write(tmpstr,'(a,1i6)') subname//' ntiles = ',ntiles - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - !--------------------------------- - ! get start and end indices of each tile and their PET - !--------------------------------- - - allocate(xb(ntiles),xe(ntiles),yb(ntiles),ye(ntiles),pe(ntiles)) - call mpp_get_compute_domains(ocean_public%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye) - call mpp_get_pelist(ocean_public%domain, pe) - if (debug > 0) then - do n = 1,ntiles - write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - enddo - end if - - !--------------------------------- - ! create delayout and distgrid - !--------------------------------- - - allocate(deBlockList(2,2,ntiles)) - allocate(petMap(ntiles)) - allocate(deLabelList(ntiles)) - - do n = 1, ntiles - deLabelList(n) = n - deBlockList(1,1,n) = xb(n) - deBlockList(1,2,n) = xe(n) - deBlockList(2,1,n) = yb(n) - deBlockList(2,2,n) = ye(n) - petMap(n) = pe(n) - ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side - enddo - - delayout = ESMF_DELayoutCreate(petMap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - allocate(connectionList(2)) - - ! bipolar boundary condition at top row: nyg - call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & - tileIndexB=1, positionVector=(/nxg+1, 2*nyg+1/), & - orientationVector=(/-1, -2/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! periodic boundary condition along first dimension - call ESMF_DistGridConnectionSet(connectionList(2), tileIndexA=1, & - tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nxg,nyg/), & -! indexflag = ESMF_INDEX_DELOCAL, & - deBlockList=deBlockList, & -! deLabelList=deLabelList, & - delayout=delayout, & - connectionList=connectionList, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - deallocate(xb,xe,yb,ye,pe) - deallocate(connectionList) - deallocate(deLabelList) - deallocate(deBlockList) - deallocate(petMap) - - call ESMF_DistGridGet(distgrid=distgrid, localDE=0, elementCount=cnt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - allocate(indexList(cnt)) - write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - write(tmpstr,'(a,4i8)') subname//' distgrid list= ',& - indexList(1),indexList(cnt),minval(indexList), maxval(indexList) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - deallocate(IndexList) - - !--------------------------------- - ! create grid - !--------------------------------- - - gridIn = ESMF_GridCreate(distgrid=distgrid, & - gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & - coordSys = ESMF_COORDSYS_SPH_DEG, & - rc = rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - mom_grid_i = gridIn - - call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! Attach area to the Grid optionally. By default the cell areas are computed. - if(grid_attach_area) then - call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - call ESMF_GridGetCoord(gridIn, coordDim=1, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_xcen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridGetCoord(gridIn, coordDim=2, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_ycen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_GridGetCoord(gridIn, coordDim=1, & - staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=dataPtr_xcor, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridGetCoord(gridIn, coordDim=2, & - staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=dataPtr_ycor, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_MASK, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_mask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if(grid_attach_area) then - call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_area, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - !--------------------------------- - ! load up area, mask, center and corner values - ! area, mask, and centers should be same size in mom and esmf grid - ! corner points may not be, need to offset corner points by 1 in i and j - ! for esmf and also need to "make up" j=1 values. use wraparound in i - !--------------------------------- - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - - lbnd1 = lbound(dataPtr_mask,1) - ubnd1 = ubound(dataPtr_mask,1) - lbnd2 = lbound(dataPtr_mask,2) - ubnd2 = ubound(dataPtr_mask,2) - - lbnd3 = lbound(dataPtr_xcor,1) - ubnd3 = ubound(dataPtr_xcor,1) - lbnd4 = lbound(dataPtr_xcor,2) - ubnd4 = ubound(dataPtr_xcor,2) - - write(tmpstr,*) subname//' iscjsc = ',isc,iec,jsc,jec - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - write(tmpstr,*) subname//' lbub12 = ',lbnd1,ubnd1,lbnd2,ubnd2 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - write(tmpstr,*) subname//' lbub34 = ',lbnd3,ubnd3,lbnd4,ubnd4 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - if (iec-isc /= ubnd1-lbnd1 .or. jec-jsc /= ubnd2-lbnd2) then - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": fld and grid do not have the same size.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - - allocate(ofld(isc:iec,jsc:jec)) - allocate(gfld(nxg,nyg)) - - call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld mask = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld mask = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_mask(i,j) = nint(ofld(i1,j1)) - enddo - enddo - - if(grid_attach_area) then - call ocean_model_data_get(ocean_state, ocean_public, 'area', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld area = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld area = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_area(i,j) = ofld(i1,j1) - enddo - enddo - endif - - call ocean_model_data_get(ocean_state, ocean_public, 'tlon', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld xt = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld xt = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_xcen(i,j) = ofld(i1,j1) - dataPtr_xcen(i,j) = mod(dataPtr_xcen(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) - enddo - enddo - - call ocean_model_data_get(ocean_state, ocean_public, 'tlat', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld yt = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld yt = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_ycen(i,j) = ofld(i1,j1) - enddo - enddo - - call ocean_model_data_get(ocean_state, ocean_public, 'geoLonBu', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld xu = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld xu = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - do j = lbnd4, ubnd4 - do i = lbnd3, ubnd3 - j1 = j - lbnd4 + jsc - 1 - i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 - if (j1 == 0) then - dataPtr_xcor(i,j) = 2*gfld(i1,1) - gfld(i1,2) -! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) > 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) - 360. -! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) < 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) + 360. - elseif (j1 >= 1 .and. j1 <= nyg) then - dataPtr_xcor(i,j) = gfld(i1,j1) - else - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": error in xu j1.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - dataPtr_xcor(i,j) = mod(dataPtr_xcor(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) - ! write(tmpstr,*) subname//' ijfld xu = ',i,i1,j,j1,dataPtr_xcor(i,j) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - enddo - enddo - - ! MOM6 runs on C-Grid. - call ocean_model_data_get(ocean_state, ocean_public, 'geoLatBu', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld yu = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld yu = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - do j = lbnd4, ubnd4 - do i = lbnd3, ubnd3 - j1 = j - lbnd4 + jsc - 1 - i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 - if (j1 == 0) then - dataPtr_ycor(i,j) = 2*gfld(i1,1) - gfld(i1,2) - elseif (j1 >= 1 .and. j1 <= nyg) then - dataPtr_ycor(i,j) = gfld(i1,j1) - else - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": error in yu j1.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - ! write(tmpstr,*) subname//' ijfld yu = ',i,i1,j,j1,dataPtr_ycor(i,j) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - enddo - enddo - - write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - if(grid_attach_area) then - write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - endif - - write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - write(tmpstr,*) subname//' ycen = ',minval(dataPtr_ycen),maxval(dataPtr_ycen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - write(tmpstr,*) subname//' xcor = ',minval(dataPtr_xcor),maxval(dataPtr_xcor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - deallocate(gfld) - - gridOut = gridIn ! for now out same as in - - !--------------------------------- - ! realize fields on grid - !--------------------------------- - -#ifdef CESMCOUPLED - call shr_nuopc_fldList_Realize(importState, fldListTo(compocn), flds_scalar_name, flds_scalar_num, & - grid=gridIn, tag=subname//':MOM6Import', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call shr_nuopc_fldList_Realize(exportState, fldListFr(compocn), flds_scalar_name, flds_scalar_num, & - grid=gridOut, tag=subname//':MOM6Export', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, mpicom, & - flds_scalar_name, flds_scalar_num, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, mpicom, & - flds_scalar_name, flds_scalar_num, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -#else - call MOM_RealizeFields(importState, gridIn , fldsToOcn_num, fldsToOcn, "Ocn import", rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call MOM_RealizeFields(exportState, gridOut, fldsFrOcn_num, fldsFrOcn, "Ocn export", rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -#endif - - call ESMF_StateGet(exportState, itemSearch="sea_surface_temperature", itemCount=icount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! Do sst initialization if it's part of export state - if(icount /= 0) then - call ESMF_StateGet(exportState, itemName='sea_surface_temperature', field=field_t_surf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_FieldGet(field_t_surf, localDe=0, farrayPtr=t_surf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) - - lbnd1 = lbound(t_surf,1) - ubnd1 = ubound(t_surf,1) - lbnd2 = lbound(t_surf,2) - ubnd2 = ubound(t_surf,2) - - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - if (ofld(i1,j1) == 0.) t_surf(i,j) = 0.0 - enddo - enddo - - deallocate(ofld) - endif - -! tcraig, turn this off for now, have issues with overwriting failures -! call NUOPC_Write(exportState, fileNamePrefix='init_field_ocn_export_', & -! timeslice=1, relaxedFlag=.true., rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out - - write(*,*) '----- MOM initialization phase Realize completed' - - end subroutine InitializeRealize - - !=============================================================================== - - subroutine DataInitialize(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_State) :: importState, exportState - type (ocean_public_type), pointer :: ocean_public => NULL() - type (ocean_state_type), pointer :: ocean_state => NULL() - type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() - type(ocean_internalstate_wrapper) :: ocean_internalstate - type(ocean_grid_type), pointer :: ocean_grid - character(240) :: msgString - integer :: fieldCount, n - type(ESMF_Field) :: field - character(len=64),allocatable :: fieldNameList(:) - character(len=*),parameter :: subname='(mom_cap:DataInitialize)' - - ! query the Component for its clock, importState and exportState - call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, exportState=exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr - ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr - ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr - call get_ocean_grid(ocean_state, ocean_grid) - - call mom_export(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - allocate(fieldNameList(fieldCount)) - call ESMF_StateGet(exportState, itemNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - do n=1, fieldCount - call ESMF_StateGet(exportState, itemName=fieldNameList(n), field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call NUOPC_SetAttribute(field, name="Updated", value="true", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end do - deallocate(fieldNameList) - - ! check whether all Fields in the exportState are "Updated" - if (NUOPC_IsUpdated(exportState)) then - call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) - - call ESMF_LogWrite("MOM6 - Initialize-Data-Dependency SATISFIED!!!", ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if - - if(write_diagnostics) then - call NUOPC_Write(exportState, fileNamePrefix='field_init_ocn_export_', & - timeslice=import_slice, relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - end subroutine DataInitialize - - !=============================================================================== - - !> Called by NUOPC to advance the model a single timestep. - !! - !! @param gcomp an ESMF_GridComp object - !! @param rc return code - subroutine ModelAdvance(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_Alarm) :: alarm - type(ESMF_State) :: importState, exportState - type(ESMF_Time) :: currTime - type(ESMF_TimeInterval) :: timeStep - type(ESMF_Time) :: startTime - type(ESMF_TimeInterval) :: time_elapsed - integer(ESMF_KIND_I8) :: n_interval, time_elapsed_sec - character(len=64) :: timestamp - type (ocean_public_type), pointer :: ocean_public => NULL() - type (ocean_state_type), pointer :: ocean_state => NULL() - type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() - type(ocean_internalstate_wrapper) :: ocean_internalstate - type(time_type) :: Time - type(time_type) :: Time_step_coupled - type(time_type) :: Time_restart_current - integer :: dth, dtm, dts, dt_cpld = 86400 - integer :: isc,iec,jsc,jec,lbnd1,ubnd1,lbnd2,ubnd2 - integer :: i,j,i1,j1 - integer :: nc -#ifdef CESMCOUPLED - type(ESMF_Time) :: MyTime - integer :: seconds, day, year, month, hour, minute - integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - integer :: logunit ! i/o unit for stdout - integer :: nu ! i/o unit to write pointer file - character(ESMF_MAXSTR) :: cvalue - character(ESMF_MAXSTR) :: runid ! Run ID - character(len=384) :: restartname ! restart file name (no dir) - character(len=384) :: restart_pointer_file ! file name for restart pointer file -#else - real(ESMF_KIND_R8), allocatable :: ofld(:,:), ocz(:,:), ocm(:,:) - real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_mmmf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_mzmf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ocz(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ocm(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) -#endif - type(ocean_grid_type), pointer :: ocean_grid - character(240) :: msgString - character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' - !-------------------------------- - - rc = ESMF_SUCCESS - if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") - - ! query the Component for its clock, importState and exportState - call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & - exportState=exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr - ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr - ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr - - ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep - - call ESMF_ClockPrint(clock, options="currTime", & - preString="------>Advancing OCN from: ", unit=msgString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_LogWrite(subname//trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_ClockGet(clock, startTime=startTime, currTime=currTime, & - timeStep=timeStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_TimePrint(currTime + timeStep, & - preString="--------------------------------> to: ", & - unit=msgString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_TimeIntervalGet(timeStep, h=dth, m=dtm, s=dts, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - Time = esmf2fms_time(currTime) - Time_step_coupled = esmf2fms_time(timeStep) - dt_cpld = dth*3600+dtm*60+dts - - call ice_ocn_bnd_from_data(Ice_ocean_boundary, Time, Time_step_coupled) - - call external_coupler_sbc_before(Ice_ocean_boundary, ocean_public, nc, dt_cpld ) - - if(write_diagnostics) then - call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', & - timeslice=import_slice, relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - import_slice = import_slice + 1 - endif - - ! rotate the lat/lon wind vector (CW) onto local tripolar coordinate system - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - - call get_ocean_grid(ocean_state, ocean_grid) - -#ifdef CESMCOUPLED - ! Reset shr logging to my log file - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) - call shr_file_setLogUnit (logunit) - - call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, logunit, runtype, clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -#else - call State_getFldPtr(exportState,'ocean_mask',dataPtr_mask,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - lbnd1 = lbound(dataPtr_mask,1) - ubnd1 = ubound(dataPtr_mask,1) - lbnd2 = lbound(dataPtr_mask,2) - ubnd2 = ubound(dataPtr_mask,2) - - call State_getFldPtr(importState,'mean_zonal_moment_flx',dataPtr_mzmf,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'mean_merid_moment_flx',dataPtr_mmmf,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'mean_evap_rate',dataPtr_evap,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'mean_sensi_heat_flx',dataPtr_sensi,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - dataPtr_evap = - dataPtr_evap - dataPtr_sensi = - dataPtr_sensi - - allocate(mzmf(lbnd1:ubnd1,lbnd2:ubnd2)) - allocate(mmmf(lbnd1:ubnd1,lbnd2:ubnd2)) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc ! work around local vs global indexing - i1 = i - lbnd1 + isc - mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - + ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) - mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - - ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) - enddo - enddo - dataPtr_mzmf = mzmf - dataPtr_mmmf = mmmf - deallocate(mzmf, mmmf) - - !Optionally write restart files when currTime-startTime is integer multiples of restart_interval - if (restart_interval > 0 ) then - time_elapsed = currTime - startTime - call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - n_interval = time_elapsed_sec / restart_interval - if ((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then - time_restart_current = esmf2fms_time(currTime) - timestamp = date_to_string(time_restart_current) - call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=dbrc) - write(*,*) 'calling ocean_model_restart' - call ocean_model_restart(ocean_state, timestamp) - endif - endif -#endif - - ! Update MOM6 - - if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") - call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled) - if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") - -#ifdef CESMCOUPLED - - call mom_export(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! If restart alarm is ringing - write restart file - call ESMF_ClockGetAlarm(clock, alarmname='seq_timemgr_alarm_restart', alarm=alarm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_AlarmRingerOff( alarm, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! determine restart filename - ! Need to use next time step since clock is not advanced until the end of the time interval - call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - read(cvalue,*) runid - - call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, s=seconds, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I5.5)') trim(runid), year, month, day, seconds - - ! write name of restart file in the rpointer file - nu = shr_file_getUnit() - if (is_root_pe()) then - restart_pointer_file = 'rpointer.ocn' - open(nu, file=restart_pointer_file, form='formatted', status='unknown') - write(nu,'(a)') trim(restartname) //'.nc' - close(nu) - write(logunit,*) 'ocn restart pointer file written: ',trim(restartname) - endif - call shr_file_freeUnit(nu) - - ! write restart file(s) - call ocean_model_restart(ocean_state, restartname=restartname) - - if (is_root_pe()) then - write(logunit,*) subname//' writing restart file ',trim(restartname) - end if - endif - - ! reset shr logging to my original values - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - -#else - - allocate(ofld(isc:iec,jsc:jec)) - - call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_mask(i,j) = nint(ofld(i1,j1)) - enddo - enddo - deallocate(ofld) - - ! Now rotate ocn current from tripolar grid back to lat/lon grid (CCW) - allocate(ocz(lbnd1:ubnd1,lbnd2:ubnd2)) - allocate(ocm(lbnd1:ubnd1,lbnd2:ubnd2)) - - call State_getFldPtr(exportState,'ocn_current_zonal',dataPtr_ocz,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'ocn_current_merid',dataPtr_ocm,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling - - ocz = dataPtr_ocz - ocm = dataPtr_ocm - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc ! work around local vs global indexing - i1 = i - lbnd1 + isc - dataPtr_ocz(i,j) = ocean_grid%cos_rot(i1,j1)*ocz(i,j) & - - ocean_grid%sin_rot(i1,j1)*ocm(i,j) - dataPtr_ocm(i,j) = ocean_grid%cos_rot(i1,j1)*ocm(i,j) & - + ocean_grid%sin_rot(i1,j1)*ocz(i,j) - enddo - enddo - deallocate(ocz, ocm) - - !call ESMF_LogWrite("B4 writing diags", dataPtr_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc)) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_mask(i,j) = nint(ofld(i1,j1)) - enddo - enddo - deallocate(ofld) - - ! Now rotate ocn current from tripolar grid back to lat/lon grid (CCW) - allocate(ocz(lbnd1:ubnd1,lbnd2:ubnd2)) - allocate(ocm(lbnd1:ubnd1,lbnd2:ubnd2)) - - call State_getFldPtr(exportState,'ocn_current_zonal',dataPtr_ocz,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'ocn_current_merid',dataPtr_ocm,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling - - ocz = dataPtr_ocz - ocm = dataPtr_ocm - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc ! work around local vs global indexing - i1 = i - lbnd1 + isc - dataPtr_ocz(i,j) = ocean_grid%cos_rot(i1,j1)*ocz(i,j) & - - ocean_grid%sin_rot(i1,j1)*ocm(i,j) - dataPtr_ocm(i,j) = ocean_grid%cos_rot(i1,j1)*ocm(i,j) & - + ocean_grid%sin_rot(i1,j1)*ocz(i,j) - enddo - enddo - deallocate(ocz, ocm) - -#endif - - if (write_diagnostics) then - call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & - timeslice=export_slice, relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - export_slice = export_slice + 1 - endif - - !call ESMF_LogWrite("Before calling sbc forcing", ESMF_LOGMSG_INFO, rc=rc) - call external_coupler_sbc_after(Ice_ocean_boundary, ocean_public, nc, dt_cpld ) - !call ESMF_LogWrite("Before dumpMomInternal", ESMF_LOGMSG_INFO, rc=rc) - !write(*,*) 'MOM: --- run phase called ---' - - !--------- import fields ------------- - - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_zonal_moment_flx" , "will provide",& - ! Ice_ocean_boundary%u_flux) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_merid_moment_flx" , "will provide",& - ! Ice_ocean_boundary%v_flux) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_sensi_heat_flx" , "will provide",& - ! Ice_ocean_boundary%t_flux) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_evap_rate" , "will provide",& - ! Ice_ocean_boundary%q_flux) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_salt_rate" , "will provide",& - ! Ice_ocean_boundary%salt_flux) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_lw_flx" , "will provide",& - ! Ice_ocean_boundary%lw_flux ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dir_flx" , "will provide",& - ! Ice_ocean_boundary%sw_flux_vis_dir) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dif_flx" , "will provide",& - ! Ice_ocean_boundary%sw_flux_vis_dif) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dir_flx" , "will provide",& - ! Ice_ocean_boundary%sw_flux_nir_dir) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dif_flx" , "will provide",& - ! Ice_ocean_boundary%sw_flux_nir_dif) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_prec_rate" , "will provide",& - ! Ice_ocean_boundary%lprec ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_fprec_rate" , "will provide",& - ! Ice_ocean_boundary%fprec ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_rate" , "will provide",& - ! Ice_ocean_boundary%runoff ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_rate" , "will provide",& - ! Ice_ocean_boundary%calving) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_heat_flx" , "will provide",& - ! Ice_ocean_boundary%runoff_hflx ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_heat_flx" , "will provide",& - ! Ice_ocean_boundary%calving_hflx) - ! call dumpMomInternal(mom_grid_i, import_slice, "inst_pres_height_surface" , "will provide",& - ! Ice_ocean_boundary%p ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mass_of_overlying_sea_ice" , "will provide",& - ! Ice_ocean_boundary%mi) - - !--------- export fields ------------- - - ! call dumpMomInternal(mom_grid_i, export_slice, "ocean_mask" , "will provide", dataPtr_mask) - ! call dumpMomInternal(mom_grid_i, export_slice, "sea_surface_temperature" , "will provide", ocean_public%t_surf) - ! call dumpMomInternal(mom_grid_i, export_slice, "s_surf" , "will provide", ocean_public%s_surf ) - ! call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_zonal" , "will provide", ocean_public%u_surf ) - ! call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_merid" , "will provide", ocean_public%v_surf ) - ! call dumpMomInternal(mom_grid_i, export_slice, "sea_lev" , "will provide", ocean_public%sea_lev) - - if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") - - end subroutine ModelAdvance - - !=============================================================================== - - subroutine ModelSetRunClock(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: mclock, dclock - type(ESMF_Time) :: mcurrtime, dcurrtime - type(ESMF_Time) :: mstoptime - type(ESMF_TimeInterval) :: mtimestep, dtimestep - character(len=128) :: mtimestring, dtimestring - type(ESMF_Alarm),pointer :: alarmList(:) - type(ESMF_Alarm) :: dalarm - integer :: alarmcount, n - character(len=*),parameter :: subname='mom_cap:(ModelSetRunClock) ' - !-------------------------------- - - rc = ESMF_SUCCESS - - ! query the Component for its clock, importState and exportState - call NUOPC_ModelGet(gcomp, driverClock=dclock, modelClock=mclock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_ClockGet(dclock, currTime=dcurrtime, timeStep=dtimestep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_ClockGet(mclock, currTime=mcurrtime, timeStep=mtimestep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !-------------------------------- - ! check that the current time in the model and driver are the same - !-------------------------------- - - if (mcurrtime /= dcurrtime) then - call ESMF_TimeGet(dcurrtime, timeString=dtimestring, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_TimeGet(mcurrtime, timeString=mtimestring, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_LogWrite(subname//" ERROR in time consistency; "//trim(dtimestring)//" ne "//trim(mtimestring), & - ESMF_LOGMSG_ERROR, rc=dbrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - rc=ESMF_Failure - endif - - !-------------------------------- - ! force model clock currtime and timestep to match driver and set stoptime - !-------------------------------- - - mstoptime = mcurrtime + dtimestep - - call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !-------------------------------- - ! copy alarms from driver to model clock if model clock has no alarms (do this only once!) - !-------------------------------- - - call ESMF_ClockGetAlarmList(mclock, alarmlistflag=ESMF_ALARMLIST_ALL, alarmCount=alarmCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (alarmCount == 0) then - call ESMF_ClockGetAlarmList(dclock, alarmlistflag=ESMF_ALARMLIST_ALL, alarmCount=alarmCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - allocate(alarmList(alarmCount)) - call ESMF_ClockGetAlarmList(dclock, alarmlistflag=ESMF_ALARMLIST_ALL, alarmList=alarmList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - do n = 1, alarmCount - ! call ESMF_AlarmPrint(alarmList(n), rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - dalarm = ESMF_AlarmCreate(alarmList(n), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_AlarmSet(dalarm, clock=mclock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - enddo - - deallocate(alarmList) - endif - - !-------------------------------- - ! Advance model clock to trigger alarms then reset model clock back to currtime - !-------------------------------- - - call ESMF_ClockAdvance(mclock,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end subroutine ModelSetRunClock - - !=============================================================================== - - !> Called by NUOPC at the end of the run to clean up. - !! - !! @param gcomp an ESMF_GridComp object - !! @param rc return code - subroutine ocean_model_finalize(gcomp, rc) - - ! input arguments - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type (ocean_public_type), pointer :: ocean_public - type (ocean_state_type), pointer :: ocean_state - type(ocean_internalstate_wrapper) :: ocean_internalstate - type(TIME_TYPE) :: Time - type(ESMF_Clock) :: clock - type(ESMF_Time) :: currTime - character(len=64) :: timestamp - character(len=*),parameter :: subname='(mom_cap:ocean_model_finalize)' - - write(*,*) 'MOM: --- finalize called ---' - rc = ESMF_SUCCESS - - call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr - ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr - - call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_ClockGet(clock, currTime=currTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - Time = esmf2fms_time(currTime) - -#ifdef CESMCOUPLED - call ocean_model_end (ocean_public, ocean_State, Time, write_restart=.false.) -#else - call ocean_model_end (ocean_public, ocean_State, Time, write_restart=.true.) -#endif - call field_manager_end - - call fms_io_exit - call fms_end - - write(*,*) 'MOM: --- completed ---' - - end subroutine ocean_model_finalize - - !==================================================================== - - ! get forcing data from data_overide - subroutine ice_ocn_bnd_from_data(x, Time, Time_step_coupled) - - type (ice_ocean_boundary_type) :: x - type(Time_type), intent(in) :: Time, Time_step_coupled - - type(Time_type) :: Time_next - character(len=*),parameter :: subname='(mom_cap:ice_ocn_bnd_from_data)' - - Time_next = Time + Time_step_coupled - - !call data_override('OCN', 't_flux', x%t_flux , Time_next) - !call data_override('OCN', 'u_flux', x%u_flux , Time_next) - !call data_override('OCN', 'v_flux', x%v_flux , Time_next) - !call data_override('OCN', 'q_flux', x%q_flux , Time_next) - !call data_override('OCN', 'salt_flux', x%salt_flux , Time_next) - !call data_override('OCN', 'lw_flux', x%lw_flux , Time_next) - !call data_override('OCN', 'sw_flux_vis_dir', x%sw_flux_vis_dir, Time_next) - !call data_override('OCN', 'sw_flux_vis_dif', x%sw_flux_vis_dif, Time_next) - !call data_override('OCN', 'sw_flux_nir_dir', x%sw_flux_nir_dir, Time_next) - !call data_override('OCN', 'sw_flux_nir_dif', x%sw_flux_nir_dif, Time_next) - !call data_override('OCN', 'lprec', x%lprec , Time_next) - !call data_override('OCN', 'fprec', x%fprec , Time_next) - !call data_override('OCN', 'runoff', x%runoff , Time_next) - !call data_override('OCN', 'calving', x%calving , Time_next) - !call data_override('OCN', 'p', x%p , Time_next) - - end subroutine ice_ocn_bnd_from_data - -!----------------------------------------------------------------------------------------- -! -! Subroutines for enabling coupling to external programs through a third party coupler -! such as OASIS/PRISM. -! If no external coupler then these will mostly be dummy routines. -! These routines can also serve as spots to call other user defined routines -!----------------------------------------------------------------------------------------- - -!----------------------------------------------------------------------------------------- - -! Dummy subroutines. - - subroutine external_coupler_mpi_init(mom_local_communicator, external_initialization) - implicit none - integer, intent(out) :: mom_local_communicator - logical, intent(out) :: external_initialization - external_initialization = .false. - mom_local_communicator = -100 ! Is there mpp_undefined parameter corresponding to MPI_UNDEFINED? - ! probably wouldn't need logical flag. - return - end subroutine external_coupler_mpi_init - -!----------------------------------------------------------------------------------------- - subroutine external_coupler_sbc_init(Dom, dt_cpld, Run_len) - implicit none - type(domain2d) :: Dom - integer :: dt_cpld - type(time_type) :: Run_len - return - end subroutine external_coupler_sbc_init - - subroutine external_coupler_sbc_before(Ice_ocean_boundary, ocean_public, nsteps, dt_cpld ) - implicit none - type (ice_ocean_boundary_type), intent(INOUT) :: Ice_ocean_boundary - type (ocean_public_type) , intent(INOUT) :: ocean_public - integer , intent(IN) :: nsteps, dt_cpld - return - end subroutine external_coupler_sbc_before - - - subroutine external_coupler_sbc_after(Ice_ocean_boundary, ocean_public, nsteps, dt_cpld ) - type (ice_ocean_boundary_type) :: Ice_ocean_boundary - type (ocean_public_type) :: ocean_public - integer :: nsteps, dt_cpld - return - end subroutine external_coupler_sbc_after - - subroutine external_coupler_restart( dt_cpld, num_cpld_calls ) - implicit none - integer, intent(in) :: dt_cpld, num_cpld_calls - return - end subroutine external_coupler_restart - - subroutine external_coupler_exit - return - end subroutine external_coupler_exit - -!----------------------------------------------------------------------------------------- - subroutine external_coupler_mpi_exit(mom_local_communicator, external_initialization) - implicit none - integer, intent(in) :: mom_local_communicator - logical, intent(in) :: external_initialization - return - end subroutine external_coupler_mpi_exit -!----------------------------------------------------------------------------------------- - subroutine writeSliceFields(state, filename_prefix, slice, rc) - type(ESMF_State) :: state - character(len=*) :: filename_prefix - integer :: slice - integer, intent(out), optional :: rc - - integer :: n, nfields - type(ESMF_Field) :: field - type(ESMF_StateItem_Flag) :: itemType - character(len=40) :: fileName - character(len=64),allocatable :: fieldNameList(:) - character(len=*),parameter :: subname='(mom_cap:writeSliceFields)' - - if (present(rc)) rc = ESMF_SUCCESS - - if (ESMF_IO_PIO_PRESENT .and. & - (ESMF_IO_NETCDF_PRESENT .or. ESMF_IO_PNETCDF_PRESENT)) then - - call ESMF_StateGet(state, itemCount=nfields, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - allocate(fieldNameList(nfields)) - call ESMF_StateGet(state, itemNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - do n=1, size(fieldNameList) - call ESMF_StateGet(state, itemName=fieldNameList(n), & - itemType=itemType, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (itemType /= ESMF_STATEITEM_NOTFOUND) then - ! field is available in the state - call ESMF_StateGet(state, itemName=fieldNameList(n), field=field, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! -> output to file - write (fileName,"(A)") & - filename_prefix//trim(fieldNameList(n))//".nc" - call ESMF_FieldWrite(field, fileName=trim(fileName), & - timeslice=slice, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - enddo - - deallocate(fieldNameList) - - endif - - end subroutine writeSliceFields - - !----------------------------------------------------------------------------- - - subroutine State_GetFldPtr(ST, fldname, fldptr, rc) - type(ESMF_State), intent(in) :: ST - character(len=*), intent(in) :: fldname - real(ESMF_KIND_R8), pointer, intent(in) :: fldptr(:,:) - integer, intent(out), optional :: rc - - ! local variables - type(ESMF_Field) :: lfield - integer :: lrc - character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' - - call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (present(rc)) rc = lrc - - end subroutine State_GetFldPtr - -#ifndef CESMCOUPLED - - !----------------------------------------------------------------------------- - - subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) - - type(ESMF_State), intent(inout) :: state - type(ESMF_Grid), intent(in) :: grid - integer, intent(in) :: nfields - type(fld_list_type), intent(inout) :: field_defs(:) - character(len=*), intent(in) :: tag - integer, intent(inout) :: rc - - integer :: i - type(ESMF_Field) :: field - integer :: npet, nx, ny, pet, elb(2), eub(2), clb(2), cub(2), tlb(2), tub(2) - type(ESMF_VM) :: vm - character(len=*),parameter :: subname='(mom_cap:MOM_RealizeFields)' - - rc = ESMF_SUCCESS - - do i = 1, nfields - - if (NUOPC_IsConnected(state, fieldName=field_defs(i)%shortname)) then - - if (field_defs(i)%shortname == flds_scalar_name) then - call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected on root pe.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=dbrc) - call shr_nuopc_fldList_SetScalarField(field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - elseif (field_defs(i)%assoc) then - call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname)& - // " is connected and associated.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=dbrc) - write(tmpstr,'(a,4i12)') subname//trim(tag)//' Field '//trim(field_defs(i)%shortname)//':', & - lbound(field_defs(i)%farrayPtr,1), ubound(field_defs(i)%farrayPtr,1), & - lbound(field_defs(i)%farrayPtr,2), ubound(field_defs(i)%farrayPtr,2) - call ESMF_LogWrite(tmpstr, ESMF_LOGMSG_INFO, rc=dbrc) - field = ESMF_FieldCreate(grid=grid, & - farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & - !farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else - call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=dbrc) - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - call NUOPC_Realize(state, field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! call ESMF_FieldPrint(field=field, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - else - call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is not connected.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=dbrc) - ! TODO: Initialize the value in the pointer to 0 after proper restart is setup - ! if(associated(field_defs(i)%farrayPtr) ) field_defs(i)%farrayPtr = 0.0 - ! remove a not connected Field from State - call ESMF_StateRemove(state, (/field_defs(i)%shortname/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - enddo - - end subroutine MOM_RealizeFields - - !----------------------------------------------------------------------------- - - subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) - ! ---------------------------------------------- - ! Set up a list of field information - ! ---------------------------------------------- - integer, intent(inout) :: num - type(fld_list_type), intent(inout) :: fldlist(:) - character(len=*), intent(in) :: stdname - character(len=*), intent(in) :: transferOffer - real(ESMF_KIND_R8), dimension(:,:), optional, target :: data - character(len=*), intent(in),optional :: shortname - - ! local variables - integer :: rc - character(len=*), parameter :: subname='(mom_cap:fld_list_add)' - - ! fill in the new entry - - num = num + 1 - if (num > fldsMax) then - call ESMF_LogWrite(trim(subname)//": ERROR num gt fldsMax "//trim(stdname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - return - endif - - fldlist(num)%stdname = trim(stdname) - if (present(shortname)) then - fldlist(num)%shortname = trim(shortname) - else - fldlist(num)%shortname = trim(stdname) - endif - fldlist(num)%transferOffer = trim(transferOffer) - if (present(data)) then - fldlist(num)%assoc = .true. - ! The following sets up the data pointer that will be used in the realize call - fldlist(num)%farrayPtr => data - else - fldlist(num)%assoc = .false. - endif - - end subroutine fld_list_add - -#endif - - !----------------------------------------------------------------------------- - -#if (1 == 0) - subroutine calculate_rot_angle(OS, OSFC) - type(ocean_state_type), intent(in) :: OS - type(ocean_public_type), intent(in) :: OSFC - - integer :: i,j,ishift,jshift,ilb,iub,jlb,jub - real :: angle, lon_scale - type(ocean_grid_type), pointer :: grid - - call get_ocean_grid(OS, grid) - - !print *, 'lbound: ', lbound(grid%geoLatT), lbound(grid%geoLonT), lbound(grid%sin_rot) - !print *, 'ubound: ', ubound(grid%geoLatT), ubound(grid%geoLonT), ubound(grid%sin_rot) - - !print *, minval(grid%geoLatT), maxval(grid%geoLatT) - !print *, minval(grid%geoLonT), maxval(grid%geoLonT) - !print *, grid%isc, grid%jsc, grid%iec, grid%jec - - ! - ! The bounds isc:iec goes from 5-104, isc-ishift:iec-ishift goes from 1:100 - ! - call mpp_get_compute_domain(OSFC%Domain, ilb, iub, jlb, jub) - ishift = ilb-grid%isc - jshift = jlb-grid%jsc - !print *, 'ilb, iub, jlb, jub', ilb, iub, jlb, jub, ishift, jshift - !print *, 'sizes', iub-ilb, jub-jlb, grid%iec-grid%isc, grid%jec-grid%jsc -! allocate(grid%sin_rot(ilb:iub, jlb:jub)) -! allocate(grid%cos_rot(ilb:iub, jlb:jub)) - - ! loop 5-104 - do j=grid%jsc,grid%jec ; do i=grid%isc,grid%iec - lon_scale = cos((grid%geoLatBu(I-1,J-1) + grid%geoLatBu(I,J-1 ) + & - grid%geoLatBu(I-1,J) + grid%geoLatBu(I,J)) * atan(1.0)/180) - angle = atan2((grid%geoLonBu(I-1,J) + grid%geoLonBu(I,J) - & - grid%geoLonBu(I-1,J-1) - grid%geoLonBu(I,J-1))*lon_scale, & - grid%geoLatBu(I-1,J) + grid%geoLatBu(I,J) - & - grid%geoLatBu(I-1,J-1) - grid%geoLatBu(I,J-1) ) - grid%sin_rot(i+ishift,j+jshift) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean - grid%cos_rot(i+ishift,j+jshift) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) - enddo ; enddo - !print *, minval(grid%sin_rot), maxval(grid%sin_rot) - !print *, minval(grid%cos_rot), maxval(grid%cos_rot) - - end subroutine -#endif - -end module ocn_comp_nuopc diff --git a/config_src/nuopc_driver/time_utils.F90 b/config_src/nuopc_driver/time_utils.F90 deleted file mode 100644 index f009a72e8e..0000000000 --- a/config_src/nuopc_driver/time_utils.F90 +++ /dev/null @@ -1,161 +0,0 @@ -module time_utils_mod - - use fms_mod, only: uppercase - use mpp_mod, only: mpp_error, FATAL - use time_manager_mod, only: time_type, set_time, set_date, get_date - use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR - use time_manager_mod, only: fms_get_calendar_type => get_calendar_type - use ESMF - - implicit none - private - - !-------------------- interface blocks --------------------- - interface fms2esmf_cal - module procedure fms2esmf_cal_c - module procedure fms2esmf_cal_i - end interface fms2esmf_cal - interface esmf2fms_time - module procedure esmf2fms_time_t - module procedure esmf2fms_timestep - end interface esmf2fms_time - - public fms2esmf_cal - public esmf2fms_time - public fms2esmf_time - public string_to_date - - contains - - !-------------------- module code --------------------- - - function fms2esmf_cal_c(calendar) -! ! Return Value: - type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_c -! ! Arguments: - character(len=*), intent(in) :: calendar - - select case( uppercase(trim(calendar)) ) - case( 'GREGORIAN' ) - fms2esmf_cal_c = ESMF_CALKIND_GREGORIAN - case( 'JULIAN' ) - fms2esmf_cal_c = ESMF_CALKIND_JULIAN - case( 'NOLEAP' ) - fms2esmf_cal_c = ESMF_CALKIND_NOLEAP - case( 'THIRTY_DAY' ) - fms2esmf_cal_c = ESMF_CALKIND_360DAY - case( 'NO_CALENDAR' ) - fms2esmf_cal_c = ESMF_CALKIND_NOCALENDAR - case default - call mpp_error(FATAL, & - 'ocean_solo: ocean_solo_nml entry calendar must be one of GREGORIAN|JULIAN|NOLEAP|THIRTY_DAY|NO_CALENDAR.' ) - end select - end function fms2esmf_cal_c - - function fms2esmf_cal_i(calendar) -! ! Return Value: - type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_i -! ! Arguments: - integer, intent(in) :: calendar - - select case(calendar) - case(THIRTY_DAY_MONTHS) - fms2esmf_cal_i = ESMF_CALKIND_360DAY - case(GREGORIAN) - fms2esmf_cal_i = ESMF_CALKIND_GREGORIAN - case(JULIAN) - fms2esmf_cal_i = ESMF_CALKIND_JULIAN - case(NOLEAP) - fms2esmf_cal_i = ESMF_CALKIND_NOLEAP - case(NO_CALENDAR) - fms2esmf_cal_i = ESMF_CALKIND_NOCALENDAR - end select - end function fms2esmf_cal_i - - function esmf2fms_time_t(time) - ! Return Value - type(Time_type) :: esmf2fms_time_t - ! Input Arguments - type(ESMF_Time), intent(in) :: time - ! Local Variables - integer :: yy, mm, dd, h, m, s - type(ESMF_CALKIND_FLAG) :: calkind - - integer :: rc - - call ESMF_TimeGet(time, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, & - calkindflag=calkind, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - esmf2fms_time_t = Set_date(yy, mm, dd, h, m, s) - - end function esmf2fms_time_t - - function esmf2fms_timestep(timestep) - ! Return Value - type(Time_type) :: esmf2fms_timestep - ! Input Arguments - type(ESMF_TimeInterval), intent(in):: timestep - ! Local Variables - integer :: s - type(ESMF_CALKIND_FLAG) :: calkind - - integer :: rc - - call ESMF_TimeIntervalGet(timestep, s=s, calkindflag=calkind, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - esmf2fms_timestep = set_time(s, 0) - - end function esmf2fms_timestep - - function fms2esmf_time(time, calkind) - ! Return Value - type(ESMF_Time) :: fms2esmf_time - ! Input Arguments - type(Time_type), intent(in) :: time - type(ESMF_CALKIND_FLAG), intent(in), optional :: calkind - ! Local Variables - integer :: yy, mm, d, h, m, s - type(ESMF_CALKIND_FLAG) :: l_calkind - - integer :: rc - - if(present(calkind)) then - l_calkind = calkind - else - l_calkind = fms2esmf_cal(fms_get_calendar_type()) - endif - - call get_date(time, yy, mm, d, h, m, s) - - call ESMF_TimeSet(fms2esmf_time, yy=yy, mm=mm, d=d, h=h, m=m, s=s, & - calkindflag=l_calkind, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end function fms2esmf_time - - function string_to_date(string, rc) - character(len=15), intent(in) :: string - integer, intent(out), optional :: rc - type(time_type) :: string_to_date - - integer :: yr,mon,day,hr,min,sec - - if(present(rc)) rc = ESMF_SUCCESS - - read(string, '(I4.4,I2.2,I2.2,".",I2.2,I2.2,I2.2)') yr, mon, day, hr, min, sec - string_to_date = set_date(yr, mon, day, hr, min, sec) - - end function string_to_date - -end module time_utils_mod From 04b9bbac4908064a66c6c153046d9806686f9cbc Mon Sep 17 00:00:00 2001 From: mvertens Date: Thu, 26 Jul 2018 15:17:48 -0600 Subject: [PATCH 0611/1072] unification with EMC addflds, etc --- config_src/nuopc_driver/mom_cap.F90 | 374 ++++++++++++-------- config_src/nuopc_driver/mom_cap_methods.F90 | 136 +------ 2 files changed, 249 insertions(+), 261 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index b14c947fca..402d51b5a5 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -400,16 +400,8 @@ module mom_cap_mod #ifdef CESMCOUPLED use mom_cap_methods, only: mom_import, mom_export use esmFlds, only: flds_scalar_name, flds_scalar_num - use esmFlds, only: fldListFr, fldListTo, compocn, compname use esmFlds, only: flds_scalar_index_nx, flds_scalar_index_ny - use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Realize - use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Concat - use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Getnumflds - use shr_nuopc_fldList_mod, only: shr_nuopc_fldList_Getfldinfo - use shr_nuopc_methods_mod, only: shr_nuopc_methods_State_SetScalar - use shr_nuopc_methods_mod, only: shr_nuopc_methods_State_GetScalar - use shr_nuopc_methods_mod, only: shr_nuopc_methods_State_Diagnose - use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit, shr_file_setIO + use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit use shr_file_mod, only: shr_file_getLogUnit, shr_file_getLogLevel use shr_file_mod, only: shr_file_setLogUnit, shr_file_setLogLevel #endif @@ -689,7 +681,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(80) :: stdname, shortname #ifdef CESMCOUPLED integer :: nflds - logical :: activefld character(len=32) :: starttype ! model start type character(len=512) :: diro character(len=512) :: logfile @@ -894,31 +885,121 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) #ifdef CESMCOUPLED - ! create import and export field list needed by data models - ! call shr_nuopc_fldList_Concat(fldListFr(compocn), fldListTo(compocn), flds_o2x, flds_x2o, flds_scalar_name) - - ! advertise import and export fields - nflds = shr_nuopc_fldList_Getnumflds(fldListFr(compocn)) - do n = 1,nflds - call shr_nuopc_fldList_Getfldinfo(fldListFr(compocn), n, activefld, stdname, shortname) - if (activefld) then - call NUOPC_Advertise(exportState, standardName=stdname, shortname=shortname, name=shortname, & - TransferOfferGeomObject='will provide', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end if - call ESMF_LogWrite(subname//':Fr_'//trim(compname(compocn))//': '//trim(shortname), ESMF_LOGMSG_INFO) - end do + !--------- import fields ------------- + call fld_list_add(fldsToOcn_num, fldsToOcn, trim(flds_scalar_name), "will_provide") ! not in EMC + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface + + ! EMC fields not used + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") ! not in CESM + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") ! not in CESM + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") ! not in CESM + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") ! not in CESM + + ! CESM currently not used + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphidry" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphodry" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphiwet" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet1" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet2" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet3" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet4" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry1" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry2" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry3" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry4" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_bcphi" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_bcpho" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_flxdst" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "So_duu10n" , "will provide") + + ! Optional CESM fields currently not used + ! call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) flds_co2a + ! call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + ! call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) flds_co2c + ! call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + ! if (flds_co2a .or. flds_co2c) then + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_co2prog" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_co2diag" , "will provide") + ! end if + ! call NUOPC_CompAttributeGet(gcomp, name='ice_ncat', value=cvalue, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) ice_ncat + ! call ESMF_LogWrite('ice_ncat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + ! call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) flds_i2o_per_cat + ! call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + ! if (flds_i2o_per_cat) then + ! do num = 1, ice_ncat + ! name = 'Si_ifrac_' // cnum + ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") + ! name = 'PFioi_swpen_ifrac_' // cnum + ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") + ! end do + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sf_afrac" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sf_afracr" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_afracr", "will provide") + ! end if + ! do n = 1,shr_string_listGetNum(ndep_fields) + ! call shr_string_listGetName(ndep_fields, n, name) + ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") + ! end do + + !--------- export fields ------------- + call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(flds_scalar_name), "will_provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask" , "will provide") ! -> ocean_mask + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t" , "will provide") ! -> sea_surface_temperature + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide") ! -> s_surf + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u" , "will provide") ! -> ocn_current_zonal + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! not in EMC + + ! EMC fields not used + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") ! not in CESM + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") ! not in CESM + + ! Optional CESM fields currently not used + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen" , "will provide") ! not in EMC + ! if (flds_co2c) then + ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") + ! end if - nflds = shr_nuopc_fldList_Getnumflds(fldListTo(compocn)) - do n = 1,nflds - call shr_nuopc_fldList_Getfldinfo(fldListTo(compocn), n, activefld, stdname, shortname) - if (activefld) then - call NUOPC_Advertise(importState, standardName=stdname, shortname=shortname, name=shortname, & - TransferOfferGeomObject='will provide', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_file_u)) return - end if - call ESMF_LogWrite(subname//':To_'//trim(compname(compocn))//': '//trim(shortname), ESMF_LOGMSG_INFO) - end do #else @@ -981,8 +1062,13 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide",& data=ocean_public%frazil) +#endif + + write(6,*)'DEBUG: fldstoocn_num= ',fldstoocn_num + write(6,*)'DEBUG: fldsfrocn_num= ',fldsfrocn_num do n = 1,fldsToOcn_num - call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)(i)%shortname, rc=rc) + write(6,*)'DEBUG: n, stdname',n,trim(fldsToOcn(n)%stdname) + call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)%shortname, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -990,24 +1076,21 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) enddo do n = 1,fldsFrOcn_num - call NUOPC_Advertise(exportState, standardName=fldsFrOcn(n)%stdname, name=fldsFrOcn(n)(i)%shortname, rc=rc) + call NUOPC_Advertise(exportState, standardName=fldsFrOcn(n)%stdname, name=fldsFrOcn(n)%shortname, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out enddo -#endif - -! When running mom6 solo, the rotation angles are not computed internally -! in MOM6. We need to calculate cos and sin of rotational angle for MOM6; -! the values are stored in ocean_internalstate%ptr%ocean_grid_ptr%cos_rot and sin_rot -! The rotation angles are retrieved during run time to rotate incoming -! and outgoing vectors -! -! call calculate_rot_angle(ocean_state, ocean_public) -! tcraig, this is handled fine internally and if not, then later call this -! call initialize_grid_rotation_angle(ocean_grid, PF) + ! When running mom6 solo, the rotation angles are not computed internally + ! in MOM6. We need to calculate cos and sin of rotational angle for MOM6; + ! the values are stored in ocean_internalstate%ptr%ocean_grid_ptr%cos_rot and sin_rot + ! The rotation angles are retrieved during run time to rotate incoming + ! and outgoing vectors + ! call calculate_rot_angle(ocean_state, ocean_public) + ! tcraig, this is handled fine internally and if not, then later call this + ! call initialize_grid_rotation_angle(ocean_grid, PF) write(*,*) '----- MOM initialization phase Advertise completed' @@ -1074,8 +1157,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) character(len=16) :: inst_suffix = "" ! char string associated with instance ! (ie. "_0001" or "") character(len=64) :: cvalue - character(len=512) :: diro - character(len=512) :: logfile logical :: isPresent #endif character(len=*),parameter :: subname='(mom_cap:InitializeRealize)' @@ -1508,45 +1589,33 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! realize fields on grid !--------------------------------- -#ifdef CESMCOUPLED - call shr_nuopc_fldList_Realize(importState, fldListTo(compocn), flds_scalar_name, flds_scalar_num, & - grid=gridIn, tag=subname//':MOM6Import', rc=rc) + + call MOM_RealizeFields(importState, gridIn , fldsToOcn_num, fldsToOcn, "Ocn import", rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call shr_nuopc_fldList_Realize(exportState, fldListFr(compocn), flds_scalar_name, flds_scalar_num, & - grid=gridOut, tag=subname//':MOM6Export', rc=rc) + call MOM_RealizeFields(exportState, gridOut, fldsFrOcn_num, fldsFrOcn, "Ocn export", rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, mpicom, & +#ifdef CESMCOUPLED + call State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, localPet, & flds_scalar_name, flds_scalar_num, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, mpicom, & + call State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, localPet, & flds_scalar_name, flds_scalar_num, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out -#else - call MOM_RealizeFields(importState, gridIn , fldsToOcn_num, fldsToOcn, "Ocn import", rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call MOM_RealizeFields(exportState, gridOut, fldsFrOcn_num, fldsFrOcn, "Ocn export", rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out #endif call ESMF_StateGet(exportState, itemSearch="sea_surface_temperature", itemCount=icount, rc=rc) @@ -1557,6 +1626,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Do sst initialization if it's part of export state if(icount /= 0) then + call ESMF_StateGet(exportState, itemName='sea_surface_temperature', field=field_t_surf, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2110,54 +2180,6 @@ subroutine ModelAdvance(gcomp, rc) !call ESMF_LogWrite("Before dumpMomInternal", ESMF_LOGMSG_INFO, rc=rc) !write(*,*) 'MOM: --- run phase called ---' - !--------- import fields ------------- - - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_zonal_moment_flx" , "will provide",& - ! Ice_ocean_boundary%u_flux) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_merid_moment_flx" , "will provide",& - ! Ice_ocean_boundary%v_flux) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_sensi_heat_flx" , "will provide",& - ! Ice_ocean_boundary%t_flux) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_evap_rate" , "will provide",& - ! Ice_ocean_boundary%q_flux) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_salt_rate" , "will provide",& - ! Ice_ocean_boundary%salt_flux) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_lw_flx" , "will provide",& - ! Ice_ocean_boundary%lw_flux ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dir_flx" , "will provide",& - ! Ice_ocean_boundary%sw_flux_vis_dir) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_vis_dif_flx" , "will provide",& - ! Ice_ocean_boundary%sw_flux_vis_dif) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dir_flx" , "will provide",& - ! Ice_ocean_boundary%sw_flux_nir_dir) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_net_sw_ir_dif_flx" , "will provide",& - ! Ice_ocean_boundary%sw_flux_nir_dif) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_prec_rate" , "will provide",& - ! Ice_ocean_boundary%lprec ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_fprec_rate" , "will provide",& - ! Ice_ocean_boundary%fprec ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_rate" , "will provide",& - ! Ice_ocean_boundary%runoff ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_rate" , "will provide",& - ! Ice_ocean_boundary%calving) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_runoff_heat_flx" , "will provide",& - ! Ice_ocean_boundary%runoff_hflx ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mean_calving_heat_flx" , "will provide",& - ! Ice_ocean_boundary%calving_hflx) - ! call dumpMomInternal(mom_grid_i, import_slice, "inst_pres_height_surface" , "will provide",& - ! Ice_ocean_boundary%p ) - ! call dumpMomInternal(mom_grid_i, import_slice, "mass_of_overlying_sea_ice" , "will provide",& - ! Ice_ocean_boundary%mi) - - !--------- export fields ------------- - - ! call dumpMomInternal(mom_grid_i, export_slice, "ocean_mask" , "will provide", dataPtr_mask) - ! call dumpMomInternal(mom_grid_i, export_slice, "sea_surface_temperature" , "will provide", ocean_public%t_surf) - ! call dumpMomInternal(mom_grid_i, export_slice, "s_surf" , "will provide", ocean_public%s_surf ) - ! call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_zonal" , "will provide", ocean_public%u_surf ) - ! call dumpMomInternal(mom_grid_i, export_slice, "ocn_current_merid" , "will provide", ocean_public%v_surf ) - ! call dumpMomInternal(mom_grid_i, export_slice, "sea_lev" , "will provide", ocean_public%sea_lev) - if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") end subroutine ModelAdvance @@ -2522,14 +2544,14 @@ end subroutine writeSliceFields !----------------------------------------------------------------------------- subroutine State_GetFldPtr(ST, fldname, fldptr, rc) - type(ESMF_State), intent(in) :: ST - character(len=*), intent(in) :: fldname - real(ESMF_KIND_R8), pointer, intent(in) :: fldptr(:,:) - integer, intent(out), optional :: rc + type(ESMF_State) , intent(in) :: ST + character(len=*) , intent(in) :: fldname + real(ESMF_KIND_R8) , pointer, intent(in) :: fldptr(:,:) + integer , intent(out), optional :: rc ! local variables type(ESMF_Field) :: lfield - integer :: lrc + integer :: lrc character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) @@ -2547,23 +2569,63 @@ subroutine State_GetFldPtr(ST, fldname, fldptr, rc) end subroutine State_GetFldPtr -#ifndef CESMCOUPLED + !----------------------------------------------------------------------------- + + subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_num, rc) + ! ---------------------------------------------- + ! Set scalar data from State for a particular name + ! ---------------------------------------------- + real(ESMF_KIND_R8),intent(in) :: value + integer, intent(in) :: scalar_id + type(ESMF_State), intent(inout) :: State + integer, intent(in) :: mytask + character(len=*), intent(in) :: scalar_name + integer, intent(in) :: scalar_num + integer, intent(inout) :: rc + + ! local variables + integer :: ierr, len + type(ESMF_Field) :: field + real(ESMF_KIND_R8), pointer :: farrayptr(:,:) + character(len=*), parameter :: subname='(mom_cap:State_SetScalar)' + + rc = ESMF_SUCCESS + + call ESMF_StateGet(State, itemName=trim(scalar_name), field=field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + if (mytask == 0) then + call ESMF_FieldGet(field, farrayPtr=farrayptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + if (scalar_id < 0 .or. scalar_id > scalar_num) then + call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", & + ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + endif + + farrayptr(1,scalar_id) = value + endif + + end subroutine State_SetScalar !----------------------------------------------------------------------------- subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) - type(ESMF_State), intent(inout) :: state - type(ESMF_Grid), intent(in) :: grid - integer, intent(in) :: nfields - type(fld_list_type), intent(inout) :: field_defs(:) - character(len=*), intent(in) :: tag - integer, intent(inout) :: rc - - integer :: i - type(ESMF_Field) :: field - integer :: npet, nx, ny, pet, elb(2), eub(2), clb(2), cub(2), tlb(2), tub(2) - type(ESMF_VM) :: vm + type(ESMF_State) , intent(inout) :: state + type(ESMF_Grid) , intent(in) :: grid + integer , intent(in) :: nfields + type(fld_list_type) , intent(inout) :: field_defs(:) + character(len=*) , intent(in) :: tag + integer , intent(inout) :: rc + + integer :: i + type(ESMF_Field) :: field + integer :: npet, nx, ny, pet + integer :: elb(2), eub(2), clb(2), cub(2), tlb(2), tub(2) + type(ESMF_VM) :: vm character(len=*),parameter :: subname='(mom_cap:MOM_RealizeFields)' rc = ESMF_SUCCESS @@ -2578,7 +2640,7 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) line=__LINE__, & file=__FILE__, & rc=dbrc) - call shr_nuopc_fldList_SetScalarField(field, rc=rc) + call SetScalarField(field, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -2648,6 +2710,38 @@ end subroutine MOM_RealizeFields !----------------------------------------------------------------------------- + subroutine SetScalarField(field, rc) + ! ---------------------------------------------- + ! create a field with scalar data on the root pe + ! ---------------------------------------------- + type(ESMF_Field), intent(inout) :: field + integer, intent(inout) :: rc + + ! local variables + type(ESMF_Distgrid) :: distgrid + type(ESMF_Grid) :: grid + character(len=*), parameter :: subname='(mom_cap:SetScalarField)' + + rc = ESMF_SUCCESS + + ! create a DistGrid with a single index space element, which gets mapped onto DE 0. + distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/1/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + grid = ESMF_GridCreate(distgrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + field = ESMF_FieldCreate(name=trim(flds_scalar_name), grid=grid, & + typekind=ESMF_TYPEKIND_R8, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/flds_scalar_num/), & ! num of scalar values + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + end subroutine SetScalarField + + !----------------------------------------------------------------------------- + subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) ! ---------------------------------------------- ! Set up a list of field information @@ -2689,8 +2783,6 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) end subroutine fld_list_add -#endif - !----------------------------------------------------------------------------- #if (1 == 0) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index af8013efda..f40e0e0177 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -1,13 +1,8 @@ module mom_cap_methods - ! This is the main driver for MOM6 in CIME - ! This file is part of MOM6. See LICENSE.md for the license. - - ! mct modules use ESMF, only: ESMF_time, ESMF_ClockGet, ESMF_TimeGet, ESMF_State, ESMF_Clock use ESMF, only: ESMF_KIND_R8, ESMF_Field, ESMF_SUCCESS, ESMF_LogFoundError use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_StateGet, ESMF_FieldGet - use perf_mod, only: t_startf, t_stopf use MOM_ocean_model, only: ocean_public_type, ocean_state_type use MOM_surface_forcing, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type @@ -23,10 +18,8 @@ module mom_cap_methods public :: mom_export public :: mom_import - integer :: rc,dbrc - integer :: import_cnt = 0 - character(len=1024) :: tmpstr - + integer :: rc,dbrc + integer :: import_cnt = 0 logical, parameter :: debug=.false. !----------------------------------------------------------------------- @@ -47,7 +40,7 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) ! Local variables real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices - integer :: lbnd1, lbnd2, ubnd1, ubnd2 + integer :: lbnd1, lbnd2 real :: slp_L, slp_R, slp_C, slope, u_min, u_max integer :: day, secs type(ESMF_time) :: currTime @@ -60,11 +53,6 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_fswpen(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_roce_16O(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_roce_HDO(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_fco2_ocn(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_fdms_ocn(:,:) character(len=*), parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" character(len=*), parameter :: subname = '(mom_export)' !----------------------------------------------------------------------- @@ -117,42 +105,15 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(exportState,"So_fswpen", dataPtr_fswpen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! call State_getFldPtr(exportState,"So_roce_16O", dataPtr_roce_16O, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! call State_getFldPtr(exportState,"So_roce_HDO", dataPtr_roce_HDO, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! call State_getFldPtr(exportState,"Faoo_fco2_ocn", dataPtr_fco2_ocn, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! call State_getFldPtr(exportState,"Faoo_fdms_ocn", dataPtr_fdms_ocn, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out lbnd1 = lbound(dataPtr_t,1) - ubnd1 = ubound(dataPtr_t,1) lbnd2 = lbound(dataPtr_t,2) - ubnd2 = ubound(dataPtr_t,2) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - !Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. - !The mask comes from "grid" that uses the usual MOM domain that has halos - !and does not use global indexing. + ! Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. + ! The mask comes from "grid" that uses the usual MOM domain that has halos + ! and does not use global indexing. do j = jsc, jec j1 = j + lbnd2 - jsc jg = j + grid%jsc - jsc @@ -294,17 +255,9 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & ! Local Variables integer :: i, j, i1, j1, ig, jg ! Grid indices integer :: isc, iec, jsc, jec ! Grid indices - integer :: isc_bnd, jsc_bnd, ise_bnd, jse_bnd - integer :: lbnd1, lbnd2, ubnd1, ubnd2 integer :: i0, j0, is, js, ie, je + integer :: lbnd1, lbnd2 real(ESMF_KIND_R8), pointer :: dataPtr_p(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ifrac(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_duu10n(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_co2prog(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_co2diag(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lamult(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ustokes(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_vstokes(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_taux(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_tauy(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_sen(:,:) @@ -317,15 +270,14 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & real(ESMF_KIND_R8), pointer :: dataPtr_swvdf(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_swndr(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_swndf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swnet(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_rofl(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_rofi(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_meltw(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_melth(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_iosalt(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_prec(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_rain(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_snow(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lamult(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ustokes(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_vstokes(:,:) integer :: day, secs type(ESMF_time) :: currTime logical :: do_import @@ -335,45 +287,7 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & rc = ESMF_SUCCESS - ! import_cnt is used to skip using the import state at the first count - import_cnt = import_cnt + 1 - call State_getFldPtr(importState,'Sa_pslv', dataPtr_p,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'Si_ifrac', dataPtr_ifrac,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"So_duu10n", dataPtr_duu10n, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! call State_getFldPtr(importState,"Sa_co2prog", dataPtr_co2prog, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! call State_getFldPtr(importState,"Sa_co2diag", dataPtr_co2diag, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - call State_getFldPtr(importState,"Sw_lamult", dataPtr_lamult, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Sw_ustokes", dataPtr_ustokes, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Sw_vstokes", dataPtr_vstokes, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -434,11 +348,6 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & file=__FILE__)) & return ! bail out call State_getFldPtr(importState,"Foxx_lwup" , dataPtr_lwup, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_swnet", dataPtr_swnet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -449,26 +358,11 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & file=__FILE__)) & return ! bail out call State_getFldPtr(importState,"Foxx_rofi" , dataPtr_rofi, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Fioi_meltw", dataPtr_meltw, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Fioi_melth", dataPtr_melth, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out call State_getFldPtr(importState,"Fioi_salt" , dataPtr_iosalt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Faxa_prec" , dataPtr_prec, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -485,12 +379,13 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & return ! bail out lbnd1 = lbound(dataPtr_p,1) - ubnd1 = ubound(dataPtr_p,1) lbnd2 = lbound(dataPtr_p,2) - ubnd2 = ubound(dataPtr_p,2) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + ! import_cnt is used to skip using the import state at the first count + import_cnt = import_cnt + 1 + if ((trim(runtype) == 'initial' .and. import_cnt <= 2)) then ! This will skip the first time import information is given do_import = .false. @@ -522,9 +417,10 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & ice_ocean_boundary%runoff(i,j) = dataPtr_rofl(i1,j1) + dataPtr_rofi(i1,j1) !ice_ocean_boundary%salt_flux(i,j) = dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j) !ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(i1,j1) - !ice_ocean_boundary%u_flux(i,j) =& + + !ice_ocean_boundary%u_flux(i,j) = & ! GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1) - !ice_ocean_boundary%v_flux(i,j) =& + !ice_ocean_boundary%v_flux(i,j) = & ! GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1) enddo enddo From 8fd077b35cc3e5fbc652a876feab81e351437899 Mon Sep 17 00:00:00 2001 From: mvertens Date: Sat, 28 Jul 2018 13:19:53 -0600 Subject: [PATCH 0612/1072] steps to unify the ncar and emc nuopc caps --- config_src/nuopc_driver/mom_cap.F90 | 100 ++++---- config_src/nuopc_driver/mom_cap_methods.F90 | 253 +++++++++++++++++--- config_src/nuopc_driver/ocn_comp_nuopc.F90 | 3 + 3 files changed, 271 insertions(+), 85 deletions(-) create mode 100644 config_src/nuopc_driver/ocn_comp_nuopc.F90 diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 402d51b5a5..1ec7d0062f 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -404,6 +404,7 @@ module mom_cap_mod use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit use shr_file_mod, only: shr_file_getLogUnit, shr_file_getLogLevel use shr_file_mod, only: shr_file_setLogUnit, shr_file_setLogLevel + use shr_nuopc_time_mod, only: shr_nuopc_time_alarmInit #endif use ESMF ! TODO: only: ... @@ -1064,10 +1065,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) #endif - write(6,*)'DEBUG: fldstoocn_num= ',fldstoocn_num - write(6,*)'DEBUG: fldsfrocn_num= ',fldsfrocn_num do n = 1,fldsToOcn_num - write(6,*)'DEBUG: n, stdname',n,trim(fldsToOcn(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)%shortname, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2004,7 +2002,7 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out ! If restart alarm is ringing - write restart file - call ESMF_ClockGetAlarm(clock, alarmname='seq_timemgr_alarm_restart', alarm=alarm, rc=rc) + call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -2196,9 +2194,12 @@ subroutine ModelSetRunClock(gcomp, rc) type(ESMF_Time) :: mstoptime type(ESMF_TimeInterval) :: mtimestep, dtimestep character(len=128) :: mtimestring, dtimestring - type(ESMF_Alarm),pointer :: alarmList(:) - type(ESMF_Alarm) :: dalarm - integer :: alarmcount, n + character(len=256) :: cvalue + character(len=256) :: restart_option ! Restart option units + integer :: restart_n ! Number until restart interval + integer :: restart_ymd ! Restart date (YYYYMMDD) + type(ESMF_ALARM) :: restart_alarm + logical :: first_time = .true. character(len=*),parameter :: subname='mom_cap:(ModelSetRunClock) ' !-------------------------------- @@ -2242,11 +2243,8 @@ subroutine ModelSetRunClock(gcomp, rc) call ESMF_LogWrite(subname//" ERROR in time consistency; "//trim(dtimestring)//" ne "//trim(mtimestring), & ESMF_LOGMSG_ERROR, rc=dbrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - rc=ESMF_Failure + rc = ESMF_FAILURE + return endif !-------------------------------- @@ -2261,47 +2259,49 @@ subroutine ModelSetRunClock(gcomp, rc) file=__FILE__)) & return ! bail out - !-------------------------------- - ! copy alarms from driver to model clock if model clock has no alarms (do this only once!) - !-------------------------------- - - call ESMF_ClockGetAlarmList(mclock, alarmlistflag=ESMF_ALARMLIST_ALL, alarmCount=alarmCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (alarmCount == 0) then - call ESMF_ClockGetAlarmList(dclock, alarmlistflag=ESMF_ALARMLIST_ALL, alarmCount=alarmCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (first_time) then + !-------------------------------- + ! set restart alarm + !-------------------------------- + call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - allocate(alarmList(alarmCount)) - call ESMF_ClockGetAlarmList(dclock, alarmlistflag=ESMF_ALARMLIST_ALL, alarmList=alarmList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + read(cvalue,*) restart_n - do n = 1, alarmCount - ! call ESMF_AlarmPrint(alarmList(n), rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - dalarm = ESMF_AlarmCreate(alarmList(n), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_AlarmSet(dalarm, clock=mclock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - enddo + call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + read(cvalue,*) restart_ymd + + call shr_nuopc_time_alarmInit(mclock, & + alarm = restart_alarm, & + option = trim(restart_option), & + opt_n = restart_n, & + opt_ymd = restart_ymd, & + RefTime = mcurrTime, & + alarmname = 'alarm_restart', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - deallocate(alarmList) - endif + call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + first_time = .false. + end if !-------------------------------- ! Advance model clock to trigger alarms then reset model clock back to currtime diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index f40e0e0177..a826aadae4 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -17,6 +17,7 @@ module mom_cap_methods ! Public member functions public :: mom_export public :: mom_import + public :: mom_import_nems integer :: rc,dbrc integer :: import_cnt = 0 @@ -333,11 +334,6 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & file=__FILE__)) & return ! bail out call State_getFldPtr(importState,"Foxx_evap" , dataPtr_evap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Fioi_salt" , dataPtr_osalt, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -394,36 +390,40 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & end if if (do_import) then - do j = jsc, jec - j1 = j + lbnd2 - jsc - jg = j + grid%jsc - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + grid%jsc - isc - - ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) - ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) - ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) - ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) - ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) - ice_ocean_boundary%t_flux(i,j) = -dataPtr_sen(i1,j1) - ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) - ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1) - ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(i1,j1) - ice_ocean_boundary%salt_flux(i,j) = dataPtr_iosalt(i1,j1) - ice_ocean_boundary%runoff(i,j) = dataPtr_rofl(i1,j1) + dataPtr_rofi(i1,j1) - !ice_ocean_boundary%salt_flux(i,j) = dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j) - !ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(i1,j1) - - !ice_ocean_boundary%u_flux(i,j) = & - ! GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1) - !ice_ocean_boundary%v_flux(i,j) = & - ! GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1) - enddo - enddo + do j = jsc, jec + j1 = j + lbnd2 - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + + ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) + ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) + ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) + ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) + ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) + ice_ocean_boundary%t_flux(i,j) = -dataPtr_sen(i1,j1) + ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) + ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1) + ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(i1,j1) + ice_ocean_boundary%salt_flux(i,j) = dataPtr_iosalt(i1,j1) + ice_ocean_boundary%runoff(i,j) = dataPtr_rofl(i1,j1) + dataPtr_rofi(i1,j1) + !ice_ocean_boundary%salt_flux(i,j) = dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j) + !ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(i1,j1) + enddo + enddo + + ! do j = jsc, jec + ! jg = j + grid%jsc - jsc + ! do i = isc, iec + ! ig = i + grid%jsc - isc + ! ice_ocean_boundary%u_flux(i,j) = & + ! GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1) + ! ice_ocean_boundary%v_flux(i,j) = & + ! GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1) + ! end do + ! end do end if ! debug output @@ -471,6 +471,189 @@ end subroutine mom_import !----------------------------------------------------------------------------- + subroutine mom_import_nems(ocean_public, grid, importState, ice_ocean_boundary, rc) + + type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state + type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid + type(ESMF_State) , intent(inout) :: importState !< incoming data + type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing + integer , intent(inout) :: rc + + ! Local Variables + integer :: i, j, i1, j1, ig, jg ! Grid indices + integer :: isc, iec, jsc, jec ! Grid indices + integer :: i0, j0, is, js, ie, je + integer :: lbnd1, lbnd2 + integer :: ubnd1, ubnd2 + real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_p(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_mmmf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_mzmf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_salt(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_lwflux(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_swvdr(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_swvdf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_swndr(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_swndf(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_runoff(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_rain(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_snow(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_calving(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_runoff_hflx(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_calving_hflx(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_mi(:,:) + + real(ESMF_KIND_R8), allocatable :: ofld(:,:), ocz(:,:), ocm(:,:) + real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) + integer :: day, secs + type(ESMF_time) :: currTime + logical :: do_import + character(len=*), parameter :: subname = '(mom_import_nems)' + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call State_getFldPtr(importState,"mean_zonal_moment_flx", dataPtr_mzmf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_merid_moment_flx", dataPtr_mmmf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_sensi_heat_flx", dataPtr_sensi, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_evap_rate" , dataPtr_evap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_salt_rate" , dataPtr_salt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_net_sw_ir_dif_flx" , dataPtr_swndr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_net_sw_ir_dir_flx" , dataPtr_swndf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_net_sw_vis_dir_flx" , dataPtr_swvdr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_net_sw_vis_dif_flx" , dataPtr_swvdf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_prec_rate" , dataPtr_rain, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_fprec_rate" , dataPtr_snow, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_runoff_rate" , dataPtr_runoff, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_calving_rate" , dataPtr_calving, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_runoff_heat_flux" , dataPtr_runoff_hflx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mean_calving_heat_flux" , dataPtr_calving_hflx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,'inst_pres_height_surface', dataPtr_p,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(importState,"mass_of_overlying_ice" , dataPtr_mi, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr_p,1) + ubnd1 = ubound(dataPtr_p,1) + lbnd2 = lbound(dataPtr_p,2) + ubnd2 = ubound(dataPtr_p,2) + + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + + allocate(mzmf(lbnd1:ubnd1,lbnd2:ubnd2)) + allocate(mmmf(lbnd1:ubnd1,lbnd2:ubnd2)) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc ! work around local vs global indexing + i1 = i - lbnd1 + isc + mzmf(i,j) = grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & + + grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) + mmmf(i,j) = grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & + - grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) + enddo + enddo + dataPtr_mzmf = mzmf + dataPtr_mmmf = mmmf + deallocate(mzmf, mmmf) + + do j = jsc, jec + j1 = j + lbnd2 - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + + ice_ocean_boundary%u_flux(i,j) = dataPtr_mzmf(i1,j1) + ice_ocean_boundary%v_flux(i,j) = dataPtr_mmmf(i1,j1) + ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) + ice_ocean_boundary%t_flux(i,j) = -dataPtr_sensi(i1,j1) + ice_ocean_boundary%salt_flux(i,j) = dataPtr_salt(i1,j1) + ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwflux(i1,j1) + ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(i1,j1) + ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) + ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) + ice_ocean_boundary%runoff(i,j) = dataPtr_runoff(i1,j1) + ice_ocean_boundary%calving(i,j) = dataPtr_calving(i1,j1) + ice_ocean_boundary%runoff_hflx(i,j) = dataPtr_runoff_hflx(i1,j1) + ice_ocean_boundary%calving_hflx(i,j) = dataPtr_calving_hflx(i1,j1) + ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) + ice_ocean_boundary%mi(i,j) = dataPtr_mi(i1,j1) + enddo + enddo + + end subroutine mom_import_nems + + !----------------------------------------------------------------------------- + subroutine State_GetFldPtr(ST, fldname, fldptr, rc) type(ESMF_State) , intent(in) :: ST character(len=*) , intent(in) :: fldname diff --git a/config_src/nuopc_driver/ocn_comp_nuopc.F90 b/config_src/nuopc_driver/ocn_comp_nuopc.F90 new file mode 100644 index 0000000000..51b8a85c26 --- /dev/null +++ b/config_src/nuopc_driver/ocn_comp_nuopc.F90 @@ -0,0 +1,3 @@ +module ocn_comp_nuopc + use mom_cap_mod +end module ocn_comp_nuopc From a840dc0f45810d363713568b90f17606839b970f Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 30 Jul 2018 07:12:23 -0600 Subject: [PATCH 0613/1072] Pass melt potential (o2x_Fioo_q) via mct driver --- config_src/mct_driver/MOM_ocean_model.F90 | 30 ++++++++++++++--------- config_src/mct_driver/ocn_cap_methods.F90 | 18 +++++++++++++- config_src/mct_driver/ocn_comp_mct.F90 | 11 +++++++-- config_src/mct_driver/ocn_cpl_indices.F90 | 2 +- 4 files changed, 45 insertions(+), 16 deletions(-) diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index c894f42270..f7092865c6 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -139,7 +139,8 @@ 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. - area => NULL() !< cell area of the ocean surface, in m2. + melt_potential => NULL(), & !< Accumulated heat used to melt sea ice (in W/m^2) + area => NULL() !< cell area of the ocean surface, in m2. 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. @@ -337,8 +338,8 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! 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) + call allocate_surface_state(OS%sfc_state, OS%grid, use_temperature, do_integrals=.true., & + gas_fields_ocn=gas_fields_ocn, use_meltpot=.true.) call surface_forcing_init(Time_in, OS%grid, param_file, OS%diag, & OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) @@ -706,13 +707,14 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, endif call mpp_get_compute_domain(Ocean_sfc%Domain, isc, iec, jsc, jec) - allocate ( Ocean_sfc%t_surf (isc:iec,jsc:jec), & - Ocean_sfc%s_surf (isc:iec,jsc:jec), & - Ocean_sfc%u_surf (isc:iec,jsc:jec), & - Ocean_sfc%v_surf (isc:iec,jsc:jec), & - Ocean_sfc%sea_lev(isc:iec,jsc:jec), & - Ocean_sfc%area (isc:iec,jsc:jec), & - Ocean_sfc%frazil (isc:iec,jsc:jec)) + allocate (Ocean_sfc%t_surf (isc:iec,jsc:jec), & + Ocean_sfc%s_surf (isc:iec,jsc:jec), & + Ocean_sfc%u_surf (isc:iec,jsc:jec), & + Ocean_sfc%v_surf (isc:iec,jsc:jec), & + Ocean_sfc%sea_lev(isc:iec,jsc:jec), & + Ocean_sfc%area (isc:iec,jsc:jec), & + Ocean_sfc%melt_potential(isc:iec,jsc:jec), & + Ocean_sfc%frazil (isc:iec,jsc:jec)) Ocean_sfc%t_surf = 0.0 ! time averaged sst (Kelvin) passed to atmosphere/ice model Ocean_sfc%s_surf = 0.0 ! time averaged sss (psu) passed to atmosphere/ice models @@ -720,6 +722,7 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, Ocean_sfc%v_surf = 0.0 ! time averaged v-current (m/sec) passed to atmosphere/ice models Ocean_sfc%sea_lev = 0.0 ! time averaged thickness of top model grid cell (m) plus patm/rho0/grav Ocean_sfc%frazil = 0.0 ! time accumulated frazil (J/m^2) passed to ice model + Ocean_sfc%melt_potential = 0.0 ! time accumulated melt potential (W/m^2) passed to ice model Ocean_sfc%area = 0.0 Ocean_sfc%axes = diag%axesT1%handles !diag axes to be used by coupler tracer flux diagnostics @@ -783,11 +786,13 @@ subroutine convert_state_to_ocean_type(state, Ocean_sfc, G, patm, press_to_z) 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)) & + if (associated(state%frazil)) & Ocean_sfc%frazil(i,j) = state%frazil(i+i0,j+j0) - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + if (allocated(state%melt_potential)) & + Ocean_sfc%melt_potential(i,j) = state%melt_potential(i+i0,j+j0) enddo ; enddo if (Ocean_sfc%stagger == AGRID) then @@ -1012,6 +1017,7 @@ 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%melt_potential ',mpp_chksum(ocn%melt_potential) call coupler_type_write_chksums(ocn%fields, outunit, 'ocean%') 100 FORMAT(" CHECKSUM::",A20," = ",Z20) diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index cc214306f0..fdc1a619b4 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -141,18 +141,26 @@ end subroutine ocn_import !======================================================================= !> Maps outgoing ocean data to MCT attribute vector real array - subroutine ocn_export(ind, ocn_public, grid, o2x) + subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) type(cpl_indices_type), intent(inout) :: ind !< Structure with coupler indices and vectors type(ocean_public_type), intent(in) :: ocn_public !< Ocean surface state type(ocean_grid_type), intent(in) :: grid !< Ocean model grid real(kind=8), intent(inout) :: o2x(:,:) !< MCT outgoing bugger + real(kind=8), intent(in) :: dt_int !< Amount of time over which to advance the + !! ocean (ocean_coupling_time_step), in sec + integer, intent(in) :: ncouple_per_day !< Number of ocean coupling calls per day ! Local variables real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo integer :: i, j, n, ig, jg !< Grid indices real :: slp_L, slp_R, slp_C, slope, u_min, u_max + real :: I_time_int !< The inverse of coupling time interval in s-1. + !----------------------------------------------------------------------- + ! Use Adcroft's rule of reciprocals; it does the right thing here. + I_time_int = 0.0 ; if (dt_int > 0.0) I_time_int = 1.0 / dt_int + ! Copy from ocn_public to o2x. ocn_public uses global indexing with no halos. ! The mask comes from "grid" that uses the usual MOM domain that has halos ! and does not use global indexing. @@ -168,6 +176,14 @@ subroutine ocn_export(ind, ocn_public, grid, o2x) o2x(ind%o2x_So_s, n) = ocn_public%s_surf(ig,jg) * grid%mask2dT(i,j) o2x(ind%o2x_So_u, n) = ocn_public%u_surf(ig,jg) * grid%mask2dT(i,j) o2x(ind%o2x_So_v, n) = ocn_public%v_surf(ig,jg) * grid%mask2dT(i,j) + ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 + if (ocn_public%frazil(ig,jg) > 0.0) then + ! Frazil: change from J/m^2 to W/m^2 + o2x(ind%o2x_Fioo_q, n) = ocn_public%frazil(ig,jg) * grid%mask2dT(i,j) * I_time_int + else + ! Melt_potential already is in W/m^2 (ncouple_per_day is unitless) + o2x(ind%o2x_Fioo_q, n) = -ocn_public%melt_potential(ig,jg) * grid%mask2dT(i,j) * ncouple_per_day + endif ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain ! in order to update halos. i.e. does not use global indexing. ssh(i,j) = ocn_public%sea_lev(ig,jg) diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 63a24b153d..f924f50078 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -423,6 +423,10 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o) integer :: shrlogunit ! original log file unit integer :: shrloglev ! original log level logical, save :: firstCall = .true. + real (kind=8), parameter :: seconds_in_day = 86400.0 !< number of seconds in one day + integer :: ocn_cpl_dt !< one ocn coupling interval in seconds. (to be received from cesm) + real (kind=8) :: mom_cpl_dt !< one ocn coupling interval in seconds. (internal) + integer :: ncouple_per_day !< number of ocean coupled call in one day (non-dim) ! reset shr logging to ocn log file: if (is_root_pe()) then @@ -441,6 +445,10 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o) call ESMF_TimeIntervalGet(ocn_cpl_interval, yy=year, mm=month, d=day, s=seconds, sn=seconds_n, sd=seconds_d, rc=rc) coupling_timestep = set_time(seconds, days=day, err_msg=err_msg) + call seq_timemgr_EClockGetData(EClock, dtime=ocn_cpl_dt) + ncouple_per_day = seconds_in_day / ocn_cpl_dt + mom_cpl_dt = seconds_in_day / ncouple_per_day + ! The following if-block is to correct monthly mean outputs: ! With this change, MOM6 starts at the same date as the other components, and runs for the same ! duration as other components, unlike POP, which would have one missing interval due to ocean @@ -502,7 +510,7 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o) call update_ocean_model(ice_ocean_boundary, glb%ocn_state, glb%ocn_public, time_start, coupling_timestep) ! Return export state to driver - call ocn_export(glb%ind, glb%ocn_public, glb%grid, o2x_o%rattr) + call ocn_export(glb%ind, glb%ocn_public, glb%grid, o2x_o%rattr, mom_cpl_dt, ncouple_per_day) !--- write out intermediate restart file when needed. ! Check alarms for flag to write restart at end of day @@ -806,6 +814,5 @@ end subroutine ocean_model_init_sfc !! Boundary layer depth !! CO2 !! DMS -!! o2x_Fioo_q !< Heat flux? end module ocn_comp_mct diff --git a/config_src/mct_driver/ocn_cpl_indices.F90 b/config_src/mct_driver/ocn_cpl_indices.F90 index 4bd9c1f383..52f94f6106 100644 --- a/config_src/mct_driver/ocn_cpl_indices.F90 +++ b/config_src/mct_driver/ocn_cpl_indices.F90 @@ -16,7 +16,7 @@ module ocn_cpl_indices integer :: o2x_So_dhdx !< Zonal slope in the sea surface height integer :: o2x_So_dhdy !< Meridional lope in the sea surface height integer :: o2x_So_bldepth !< Boundary layer depth (m) - integer :: o2x_Fioo_q !< Heat flux? + integer :: o2x_Fioo_q !< Ocean melt and freeze potential (W/m2) integer :: o2x_Faoo_fco2_ocn !< CO2 flux integer :: o2x_Faoo_fdms_ocn !< DMS flux From 3cdd97bfab98e62ccb6b1dbd2eb21334975d9d2d Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 30 Jul 2018 07:22:49 -0600 Subject: [PATCH 0614/1072] Add option to calculate melt potential --- src/core/MOM.F90 | 47 ++++++++++++++++++++++++++++++++--------------- 1 file changed, 32 insertions(+), 15 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index bdd1f159cf..f3abb6bc69 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -72,7 +72,7 @@ module MOM use MOM_dynamics_unsplit_RK2, only : initialize_dyn_unsplit_RK2, end_dyn_unsplit_RK2 use MOM_dynamics_unsplit_RK2, only : MOM_dyn_unsplit_RK2_CS use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid -use MOM_EOS, only : EOS_init, calculate_density +use MOM_EOS, only : EOS_init, calculate_density, calculate_TFreeze use MOM_debugging, only : check_redundant use MOM_grid, only : ocean_grid_type, set_first_direction use MOM_grid, only : MOM_grid_init, MOM_grid_end @@ -807,7 +807,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & endif if (showCallTree) call callTree_waypoint("calling extract_surface_state (step_MOM)") - call extract_surface_state(CS, sfc_state) + call extract_surface_state(CS, sfc_state, dt) ! Do diagnostics that only occur at the end of a complete forcing step. if (cycle_end) then @@ -2631,28 +2631,29 @@ end subroutine adjust_ssh_for_p_atm !> This subroutine sets the surface (return) properties of the ocean !! model by setting the appropriate fields in sfc_state. Unused fields !! are set to NULL or are unallocated. -subroutine extract_surface_state(CS, sfc_state) +subroutine extract_surface_state(CS, sfc_state, dt) type(MOM_control_struct), pointer :: CS !< Master MOM control structure type(surface), intent(inout) :: sfc_state !< transparent ocean surface state !! structure shared with the calling routine !! data in this structure is intent out. + real, optional, intent(in) :: dt !< Thermodynamic time step, in s. ! local real :: hu, hv - type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing - ! metrics and related information + type(ocean_grid_type), pointer :: G => NULL() !< pointer to a structure containing + !! metrics and related information type(verticalGrid_type), pointer :: GV => NULL() real, dimension(:,:,:), pointer :: & - u => NULL(), & ! u : zonal velocity component (m/s) - v => NULL(), & ! v : meridional velocity component (m/s) - h => NULL() ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) - real :: depth(SZI_(CS%G)) ! distance from the surface (meter) - real :: depth_ml ! depth over which to average to - ! determine mixed layer properties (meter) - real :: dh ! thickness of a layer within mixed layer (meter) - real :: mass ! mass per unit area of a layer (kg/m2) - - logical :: use_temperature ! If true, temp and saln used as state variables. + u => NULL(), & !< u : zonal velocity component (m/s) + v => NULL(), & !< v : meridional velocity component (m/s) + h => NULL() !< h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) + real :: depth(SZI_(CS%G)) !< distance from the surface (meter) + real :: depth_ml !< depth over which to average to + !< determine mixed layer properties (meter) + real :: dh !< thickness of a layer within mixed layer (meter) + real :: mass !< mass per unit area of a layer (kg/m2) + real :: T_freeze !< freezing temperature (oC) + logical :: use_temperature !< If true, temp and saln used as state variables. integer :: i, j, k, is, ie, js, je, nz, numberOfErrors integer :: isd, ied, jsd, jed integer :: iscB, iecB, jscB, jecB, isdB, iedB, jsdB, jedB @@ -2810,6 +2811,22 @@ subroutine extract_surface_state(CS, sfc_state) endif endif ! (CS%Hmix >= 0.0) + if (allocated(sfc_state%melt_potential)) then + !$OMP parallel do default(shared) + do j=js,je ; do i=is,ie + ! set melt_potential to zero to avoid passing values set previously + sfc_state%melt_potential(i,j) = 0.0 + ! calculate freezing temp. + call calculate_TFreeze(sfc_state%SSS(i,j), CS%tv%P_Ref, T_freeze, CS%tv%eqn_of_state) + if (present(dt)) then + ! melt_potential, in W/m^2 + sfc_state%melt_potential(i,j) = CS%tv%C_p * CS%GV%Rho0 * (sfc_state%SST(i,j) - T_freeze) * sfc_state%Hml(i,j)/dt + else + sfc_state%melt_potential(i,j) = 0.0 + endif + enddo ; enddo + endif + if (allocated(sfc_state%salt_deficit) .and. associated(CS%tv%salt_deficit)) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie From b52db1ff5dfc0e06b879e53ba7062c06c9649950 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 30 Jul 2018 07:40:16 -0600 Subject: [PATCH 0615/1072] Allocate/deallocate melt_potential --- src/core/MOM_variables.F90 | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 02b0b622a3..32a1f75c0c 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -38,6 +38,8 @@ module MOM_variables v, & !< The mixed layer meridional velocity in m s-1. sea_lev, & !< The sea level in m. If a reduced surface gravity is !! used, that is compensated for in sea_lev. + melt_potential, & !< Instantaneous amount of heat that can be used to melt sea ice, + !! in J m-2. This is computed w.r.t. the freezing temperature. ocean_mass, & !< The total mass of the ocean in kg m-2. ocean_heat, & !< The total heat content of the ocean in C kg m-2. ocean_salt, & !< The total salt content of the ocean in kgSalt m-2. @@ -280,7 +282,7 @@ module MOM_variables !> This subroutine allocates the fields for the surface (return) properties of !! the ocean model. Unused fields are unallocated. subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & - gas_fields_ocn) + gas_fields_ocn, use_meltpot) type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(surface), intent(inout) :: sfc_state !< ocean surface state type to be allocated. logical, optional, intent(in) :: use_temperature !< If true, allocate the space for thermodynamic variables. @@ -292,8 +294,10 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & !! in the calculation of additional gas or other !! tracer fluxes, and can be used to spawn related !! internal variables in the ice model. + logical, optional, intent(in) :: use_meltpot !< If true, allocate the space for melt potential - logical :: use_temp, alloc_integ + ! local variables + logical :: use_temp, alloc_integ, use_melt_potential integer :: is, ie, js, je, isd, ied, jsd, jed integer :: isdB, iedB, jsdB, jedB @@ -303,6 +307,7 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & use_temp = .true. ; if (present(use_temperature)) use_temp = use_temperature alloc_integ = .true. ; if (present(do_integrals)) alloc_integ = do_integrals + use_melt_potential = .false. ; if (present(use_meltpot)) use_melt_potential = use_meltpot if (sfc_state%arrays_allocated) return @@ -317,6 +322,10 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & allocate(sfc_state%u(IsdB:IedB,jsd:jed)) ; sfc_state%u(:,:) = 0.0 allocate(sfc_state%v(isd:ied,JsdB:JedB)) ; sfc_state%v(:,:) = 0.0 + if (use_melt_potential) then + allocate(sfc_state%melt_potential(isd:ied,jsd:jed)) ; sfc_state%melt_potential(:,:) = 0.0 + endif + if (alloc_integ) then ! Allocate structures for the vertically integrated ocean_mass, ocean_heat, ! and ocean_salt. @@ -342,6 +351,7 @@ subroutine deallocate_surface_state(sfc_state) if (.not.sfc_state%arrays_allocated) return + if (allocated(sfc_state%melt_potential)) deallocate(sfc_state%melt_potential) if (allocated(sfc_state%SST)) deallocate(sfc_state%SST) if (allocated(sfc_state%SSS)) deallocate(sfc_state%SSS) if (allocated(sfc_state%sfc_density)) deallocate(sfc_state%sfc_density) From d981745f8d87b7d3ad7381df7409a38203c631b3 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 30 Jul 2018 09:11:37 -0600 Subject: [PATCH 0616/1072] Fix a call to ocn_export --- config_src/mct_driver/ocn_comp_mct.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index f924f50078..7608ef4579 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -373,7 +373,7 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) ! end if if (debug .and. root_pe().eq.pe_here()) print *, "calling ocn_export" - call ocn_export(glb%ind, glb%ocn_public, glb%grid, o2x_o%rattr) + call ocn_export(glb%ind, glb%ocn_public, glb%grid, o2x_o%rattr, mom_cpl_dt, ncouple_per_day) call t_stopf('MOM_mct_init') From 60eb7ec30667a000f23c9ab5af751b058cce1906 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 30 Jul 2018 09:21:43 -0600 Subject: [PATCH 0617/1072] Add comment about icefrq used in Hycom --- config_src/mct_driver/ocn_cap_methods.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index fdc1a619b4..36a4faef09 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -182,6 +182,7 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) o2x(ind%o2x_Fioo_q, n) = ocn_public%frazil(ig,jg) * grid%mask2dT(i,j) * I_time_int else ! Melt_potential already is in W/m^2 (ncouple_per_day is unitless) + ! GMM - Hycom cap uses icefrq rather than oceanfrq (ncouple_per_day) o2x(ind%o2x_Fioo_q, n) = -ocn_public%melt_potential(ig,jg) * grid%mask2dT(i,j) * ncouple_per_day endif ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain From 8d794eff5ccd57d26d481b7bceea6f097c90c99a Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 1 Aug 2018 10:51:18 -0800 Subject: [PATCH 0618/1072] Adding OBLIQUE_TAN and OBLIQUE_GRAD options. --- src/core/MOM_open_boundary.F90 | 454 +++++++++++++++++++++++++++++++-- 1 file changed, 438 insertions(+), 16 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 259714e984..de8c2fe174 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -112,6 +112,10 @@ module MOM_open_boundary logical :: radiation_grad !< If true, 1D Orlanksi radiation boundary conditions are applied to !! dudv and dvdx. logical :: oblique !< Oblique waves supported at radiation boundary. + logical :: oblique_tan !< If true, 2D radiation boundary conditions are applied to + !! tangential flows. + logical :: oblique_grad !< If true, 2D radiation boundary conditions are applied to + !! dudv and dvdx. logical :: nudged !< Optional supplement to radiation boundary. logical :: nudged_tan !< Optional supplement to nudge tangential velocity. logical :: nudged_grad !< Optional supplement to nudge normal gradient of tangential velocity. @@ -151,7 +155,11 @@ module MOM_open_boundary !! the OB segment (m s-1). real, pointer, dimension(:,:) :: eta=>NULL() !< The sea-surface elevation along the segment (m). real, pointer, dimension(:,:,:) :: grad_normal=>NULL() !< The gradient of the normal flow along the - !! segment (m s-1) + !! segment (s-1) + real, pointer, dimension(:,:,:) :: grad_tan=>NULL() !< The gradient of the tangential flow along the + !! segment (s-1) + real, pointer, dimension(:,:,:) :: grad_gradient=>NULL() !< The gradient of the gradient of tangential flow along the + !! segment (m-1 s-1) real, pointer, dimension(:,:,:) :: rx_normal=>NULL() !< The rx_old_u value for radiation coeff !! for normal velocity real, pointer, dimension(:,:,:) :: ry_normal=>NULL() !< The tangential value for radiation coeff @@ -397,6 +405,8 @@ subroutine open_boundary_config(G, param_file, OBC) OBC%segment(l)%radiation_tan = .false. OBC%segment(l)%radiation_grad = .false. OBC%segment(l)%oblique = .false. + OBC%segment(l)%oblique_tan = .false. + OBC%segment(l)%oblique_grad = .false. OBC%segment(l)%nudged = .false. OBC%segment(l)%nudged_tan = .false. OBC%segment(l)%nudged_grad = .false. @@ -818,6 +828,13 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_y) OBC%segment(l_seg)%open = .true. OBC%oblique_BCs_exist_globally = .true. OBC%open_u_BCs_exist_globally = .true. + elseif (trim(action_str(a_loop)) == 'OBLIQUE_TAN') then + OBC%segment(l_seg)%oblique = .true. + OBC%segment(l_seg)%oblique_tan = .true. + OBC%oblique_BCs_exist_globally = .true. + elseif (trim(action_str(a_loop)) == 'OBLIQUE_GRAD') then + OBC%segment(l_seg)%oblique = .true. + OBC%segment(l_seg)%oblique_grad = .true. elseif (trim(action_str(a_loop)) == 'NUDGED') then OBC%segment(l_seg)%nudged = .true. OBC%nudged_u_BCs_exist_globally = .true. @@ -871,6 +888,10 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_y) OBC%segment(l_seg)%Je_obc = Je_obc call allocate_OBC_segment_data(OBC, OBC%segment(l_seg)) + if (OBC%segment(l_seg)%oblique .and. OBC%segment(l_seg)%radiation) & + call MOM_error(FATAL, "MOM_open_boundary.F90, setup_u_point_obc:\n"//& + "Orlanski and Oblique OBC options cannot be used together on one segment.") + end subroutine setup_u_point_obc !> Parse an OBC_SEGMENT_%%% string starting with "J=" and configure placement and type of OBC accordingly @@ -931,6 +952,13 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_x) OBC%segment(l_seg)%open = .true. OBC%oblique_BCs_exist_globally = .true. OBC%open_v_BCs_exist_globally = .true. + elseif (trim(action_str(a_loop)) == 'OBLIQUE_TAN') then + OBC%segment(l_seg)%oblique = .true. + OBC%segment(l_seg)%oblique_tan = .true. + OBC%oblique_BCs_exist_globally = .true. + elseif (trim(action_str(a_loop)) == 'OBLIQUE_GRAD') then + OBC%segment(l_seg)%oblique = .true. + OBC%segment(l_seg)%oblique_grad = .true. elseif (trim(action_str(a_loop)) == 'NUDGED') then OBC%segment(l_seg)%nudged = .true. OBC%nudged_v_BCs_exist_globally = .true. @@ -984,6 +1012,10 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_x) OBC%segment(l_seg)%Je_obc = J_obc call allocate_OBC_segment_data(OBC, OBC%segment(l_seg)) + if (OBC%segment(l_seg)%oblique .and. OBC%segment(l_seg)%radiation) & + call MOM_error(FATAL, "MOM_open_boundary.F90, setup_v_point_obc:\n"//& + "Orlanski and Oblique OBC options cannot be used together on one segment.") + end subroutine setup_v_point_obc !> Parse an OBC_SEGMENT_%%% string @@ -1505,6 +1537,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) real :: cff_new, cff_avg ! denominator in oblique real, pointer, dimension(:,:,:) :: rx_tangential=>NULL() real, pointer, dimension(:,:,:) :: ry_tangential=>NULL() + real, pointer, dimension(:,:,:) :: cff_tangential=>NULL() real, parameter :: eps = 1.0e-20 type(OBC_segment_type), pointer :: segment => NULL() integer :: i, j, k, is, ie, js, je, nz, n @@ -1606,6 +1639,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) - & (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & (cff_avg + rx_avg) + ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues + ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) @@ -1642,7 +1677,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif if (segment%nudged_tan) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1672,7 +1708,77 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif if (segment%nudged_grad) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo ; enddo + endif + deallocate(rx_tangential) + endif + if (segment%oblique_tan .or. segment%oblique_grad) then + I=segment%HI%IsdB + allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(ry_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + rx_tangential(I,segment%HI%JsdB,k) = segment%rx_normal(I,segment%HI%jsd,k) + rx_tangential(I,segment%HI%JedB,k) = segment%rx_normal(I,segment%HI%jed,k) + ry_tangential(I,segment%HI%JsdB,k) = segment%ry_normal(I,segment%HI%jsd,k) + ry_tangential(I,segment%HI%JedB,k) = segment%ry_normal(I,segment%HI%jed,k) + cff_tangential(I,segment%HI%JsdB,k) = segment%cff_normal(I,segment%HI%jsd,k) + cff_tangential(I,segment%HI%JedB,k) = segment%cff_normal(I,segment%HI%jed,k) + do J=segment%HI%JsdB+1,segment%HI%JedB-1 + rx_tangential(I,J,k) = 0.5*(segment%rx_normal(I,j,k) + segment%rx_normal(I,j+1,k)) + ry_tangential(I,J,k) = 0.5*(segment%ry_normal(I,j,k) + segment%ry_normal(I,j+1,k)) + cff_tangential(I,J,k) = 0.5*(segment%cff_normal(I,j,k) + segment%cff_normal(I,j+1,k)) + enddo + enddo + if (segment%oblique_tan) then + do k=1,nz ; do J=segment%HI%JsdB+1,segment%HI%JedB-1 + rx_avg = rx_tangential(I,J,k) + ry_avg = ry_tangential(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i,J,k) + rx_avg*v_new(i-1,J,k)) - & + (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & + (cff_avg + rx_avg) + enddo ; enddo + endif + if (segment%nudged_tan) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_vel(I,J,k) = (1 - gamma_2) * segment%tangential_vel(I,J,k) + & + gamma_2 * segment%nudged_tangential_vel(I,J,k) + enddo ; enddo + endif + if (segment%oblique_grad) then + Js_obc = max(segment%HI%JsdB,G%jsd+1) + Je_obc = min(segment%HI%JedB,G%jed-1) + do k=1,nz ; do J=segment%HI%JsdB+1,segment%HI%JedB-1 + rx_avg = rx_tangential(I,J,k) + ry_avg = ry_tangential(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_grad(I,J,k) = ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) & + + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) - & + (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & + (cff_avg + rx_avg) + enddo ; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1683,6 +1789,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) enddo ; enddo endif deallocate(rx_tangential) + deallocate(ry_tangential) + deallocate(cff_tangential) endif endif @@ -1727,6 +1835,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) - & (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & (cff_avg + rx_avg) + ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues + ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) @@ -1758,12 +1868,13 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (segment%radiation_tan) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = (v_new(I+1,J,k) + rx_avg*v_new(I+2,J,k)) / (1.0+rx_avg) + segment%tangential_vel(I,J,k) = (v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_tan) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1793,7 +1904,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif if (segment%nudged_grad) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1805,6 +1917,77 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif deallocate(rx_tangential) endif + if (segment%oblique_tan .or. segment%oblique_grad) then + I=segment%HI%IsdB + allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(ry_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + rx_tangential(I,segment%HI%JsdB,k) = segment%rx_normal(I,segment%HI%jsd,k) + rx_tangential(I,segment%HI%JedB,k) = segment%rx_normal(I,segment%HI%jed,k) + ry_tangential(I,segment%HI%JsdB,k) = segment%ry_normal(I,segment%HI%jsd,k) + ry_tangential(I,segment%HI%JedB,k) = segment%ry_normal(I,segment%HI%jed,k) + cff_tangential(I,segment%HI%JsdB,k) = segment%cff_normal(I,segment%HI%jsd,k) + cff_tangential(I,segment%HI%JedB,k) = segment%cff_normal(I,segment%HI%jed,k) + do J=segment%HI%JsdB+1,segment%HI%JedB-1 + rx_tangential(I,J,k) = 0.5*(segment%rx_normal(I,j,k) + segment%rx_normal(I,j+1,k)) + ry_tangential(I,J,k) = 0.5*(segment%ry_normal(I,j,k) + segment%ry_normal(I,j+1,k)) + cff_tangential(I,J,k) = 0.5*(segment%cff_normal(I,j,k) + segment%cff_normal(I,j+1,k)) + enddo + enddo + if (segment%oblique_tan) then + do k=1,nz ; do J=segment%HI%JsdB+1,segment%HI%JedB-1 + rx_avg = rx_tangential(I,J,k) + ry_avg = ry_tangential(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) - & + (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & + (cff_avg + rx_avg) + enddo ; enddo + endif + if (segment%nudged_tan) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_vel(I,J,k) = (1 - gamma_2) * segment%tangential_vel(I,J,k) + & + gamma_2 * segment%nudged_tangential_vel(I,J,k) + enddo ; enddo + endif + if (segment%oblique_grad) then + Js_obc = max(segment%HI%JsdB,G%jsd+1) + Je_obc = min(segment%HI%JedB,G%jed-1) + do k=1,nz ; do J=segment%HI%JsdB+1,segment%HI%JedB-1 + rx_avg = rx_tangential(I,J,k) + ry_avg = ry_tangential(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_grad(I,J,k) = ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) & + + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) - & + (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & + (cff_avg + rx_avg) + enddo ; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo ; enddo + endif + deallocate(rx_tangential) + deallocate(ry_tangential) + deallocate(cff_tangential) + endif endif if (segment%direction == OBC_DIRECTION_N) then @@ -1849,6 +2032,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - & (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & (cff_avg + ry_avg) + ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues + ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) @@ -1857,7 +2042,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then ! dhdt gets set to 0 on inflow in oblique case - if (dhdt*dhdx <= 0.0) then + if (dhdt*dhdy <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1885,7 +2070,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif if (segment%nudged_tan) then do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1909,13 +2095,14 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = ((u_new(I,j,k) - u_new(I-1,j,k))*G%IdyBu(I,J-1) + & + segment%tangential_grad(I,J,k) = ((u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_grad) then do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -1927,9 +2114,79 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif deallocate(rx_tangential) endif + if (segment%oblique_tan .or. segment%oblique_grad) then + J=segment%HI%JsdB + allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(ry_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + rx_tangential(segment%HI%IsdB,J,k) = segment%ry_normal(segment%HI%isd,J,k) + rx_tangential(segment%HI%IedB,J,k) = segment%ry_normal(segment%HI%ied,J,k) + ry_tangential(segment%HI%IsdB,J,k) = segment%rx_normal(segment%HI%isd,J,k) + ry_tangential(segment%HI%IedB,J,k) = segment%rx_normal(segment%HI%ied,J,k) + cff_tangential(segment%HI%IsdB,J,k) = segment%cff_normal(segment%HI%isd,J,k) + cff_tangential(segment%HI%IedB,J,k) = segment%cff_normal(segment%HI%ied,J,k) + do I=segment%HI%IsdB+1,segment%HI%IedB-1 + rx_tangential(I,J,k) = 0.5*(segment%ry_normal(i,J,k) + segment%ry_normal(i+1,J,k)) + ry_tangential(I,J,k) = 0.5*(segment%rx_normal(i,J,k) + segment%rx_normal(i+1,J,k)) + cff_tangential(I,J,k) = 0.5*(segment%cff_normal(i,J,k) + segment%cff_normal(i+1,J,k)) + enddo + enddo + if (segment%oblique_tan) then + do k=1,nz ; do I=segment%HI%IsdB+1,segment%HI%IedB-1 + rx_avg = rx_tangential(I,J,k) + ry_avg = ry_tangential(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_vel(I,J,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) - & + (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & + (cff_avg + rx_avg) + enddo ; enddo + endif + if (segment%nudged_tan) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_vel(I,J,k) = (1 - gamma_2) * segment%tangential_vel(I,J,k) + & + gamma_2 * segment%nudged_tangential_vel(I,J,k) + enddo ; enddo + endif + if (segment%oblique_grad) then + Is_obc = max(segment%HI%IsdB,G%isd+1) + Ie_obc = min(segment%HI%IedB,G%ied-1) + do k=1,nz ; do I=segment%HI%IsdB+1,segment%HI%IedB-1 + rx_avg = rx_tangential(I,J,k) + ry_avg = ry_tangential(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_grad(I,J,k) = ((cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) & + + rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) - & + (max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & + (cff_avg + rx_avg) + enddo ; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo ; enddo + endif + deallocate(rx_tangential) + deallocate(ry_tangential) + deallocate(cff_tangential) + endif endif - if (segment%direction == OBC_DIRECTION_S) then J=segment%HI%JsdB if (J>G%HI%JecB) cycle @@ -1971,6 +2228,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) - & (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & (cff_avg + ry_avg) + ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues + ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) @@ -1979,7 +2238,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then ! dhdt gets set to 0 on inflow in oblique case - if (dhdt*dhdx <= 0.0) then + if (dhdt*dhdy <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -2007,7 +2266,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif if (segment%nudged_tan) then do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (rx_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -2037,7 +2297,77 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif if (segment%nudged_grad) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB - if (rx_tangential(I,J,k) < 0.0) then + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_grad(I,J,k) = (1 - gamma_2) * segment%tangential_grad(I,J,k) + & + gamma_2 * segment%nudged_tangential_grad(I,J,k) + enddo ; enddo + endif + deallocate(rx_tangential) + endif + if (segment%oblique_tan .or. segment%oblique_grad) then + J=segment%HI%JsdB + allocate(rx_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(ry_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + allocate(cff_tangential(segment%HI%IsdB:segment%HI%IedB,segment%HI%JsdB:segment%HI%JedB,nz)) + do k=1,nz + rx_tangential(segment%HI%IsdB,J,k) = segment%ry_normal(segment%HI%isd,J,k) + rx_tangential(segment%HI%IedB,J,k) = segment%ry_normal(segment%HI%ied,J,k) + ry_tangential(segment%HI%IsdB,J,k) = segment%rx_normal(segment%HI%isd,J,k) + ry_tangential(segment%HI%IedB,J,k) = segment%rx_normal(segment%HI%ied,J,k) + cff_tangential(segment%HI%IsdB,J,k) = segment%cff_normal(segment%HI%isd,J,k) + cff_tangential(segment%HI%IedB,J,k) = segment%cff_normal(segment%HI%ied,J,k) + do I=segment%HI%IsdB+1,segment%HI%IedB-1 + rx_tangential(I,J,k) = 0.5*(segment%ry_normal(i,J,k) + segment%ry_normal(i+1,J,k)) + ry_tangential(I,J,k) = 0.5*(segment%rx_normal(i,J,k) + segment%rx_normal(i+1,J,k)) + cff_tangential(I,J,k) = 0.5*(segment%cff_normal(i,J,k) + segment%cff_normal(i+1,J,k)) + enddo + enddo + if (segment%oblique_tan) then + do k=1,nz ; do I=segment%HI%IsdB+1,segment%HI%IedB-1 + rx_avg = rx_tangential(I,J,k) + ry_avg = ry_tangential(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_vel(I,J,k) = ((cff_avg*u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) - & + (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & + (cff_avg + rx_avg) + enddo ; enddo + endif + if (segment%nudged_tan) then + do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tangential(I,J,k) <= 0.0) then + tau = segment%Velocity_nudging_timescale_in + else + tau = segment%Velocity_nudging_timescale_out + endif + gamma_2 = dt / (tau + dt) + segment%tangential_vel(I,J,k) = (1 - gamma_2) * segment%tangential_vel(I,J,k) + & + gamma_2 * segment%nudged_tangential_vel(I,J,k) + enddo ; enddo + endif + if (segment%oblique_grad) then + Is_obc = max(segment%HI%IsdB,G%isd+1) + Ie_obc = min(segment%HI%IedB,G%ied-1) + do k=1,nz ; do I=segment%HI%IsdB+1,segment%HI%IedB-1 + rx_avg = rx_tangential(I,J,k) + ry_avg = ry_tangential(I,J,k) + cff_avg = cff_tangential(I,J,k) + segment%tangential_grad(I,J,k) = ((cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) & + + rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) - & + (max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & + (cff_avg + rx_avg) + enddo ; enddo + endif + if (segment%nudged_grad) then + do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB + ! dhdt gets set to 0 on inflow in oblique case + if (ry_tangential(I,J,k) <= 0.0) then tau = segment%Velocity_nudging_timescale_in else tau = segment%Velocity_nudging_timescale_out @@ -2048,6 +2378,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) enddo ; enddo endif deallocate(rx_tangential) + deallocate(ry_tangential) + deallocate(cff_tangential) endif endif enddo @@ -2144,6 +2476,24 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) segment%grad_normal(J,2,k) = (uvel(I,j+1,k)-uvel(I,j,k)) * G%mask2dBu(I,J) enddo enddo + if (segment%oblique_tan) then + do k=1,G%ke + do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1) + segment%grad_tan(j,1,k) = (vvel(i-1,J,k)-vvel(i-1,J-1,k)) * G%mask2dT(i-1,j) + segment%grad_tan(j,2,k) = (vvel(i,J,k)-vvel(i,J-1,k)) * G%mask2dT(i,j) + enddo + enddo + endif + if (segment%oblique_grad) then + do k=1,G%ke + do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1) + segment%grad_gradient(j,1,k) = (((vvel(i-1,J,k) - vvel(i-2,J,k))*G%IdxBu(I-2,J)) - & + (vvel(i-1,J-1,k) - vvel(i-2,J-1,k))*G%IdxBu(I-2,J-1)) * G%mask2dCu(I-1,j) + segment%grad_gradient(j,2,k) = (((vvel(i,J,k) - vvel(i-1,J,k))*G%IdxBu(I-1,J)) - & + (vvel(i,J-1,k) - vvel(i-1,J-1,k))*G%IdxBu(I-1,J-1)) * G%mask2dCu(I,j) + enddo + enddo + endif else ! western segment I=segment%HI%isdB do k=1,G%ke @@ -2152,6 +2502,24 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) segment%grad_normal(J,2,k) = (uvel(I,j+1,k)-uvel(I,j,k)) * G%mask2dBu(I,J) enddo enddo + if (segment%oblique_tan) then + do k=1,G%ke + do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1) + segment%grad_tan(j,1,k) = (vvel(i+2,J,k)-vvel(i+2,J-1,k)) * G%mask2dT(i+2,j) + segment%grad_tan(j,2,k) = (vvel(i+1,J,k)-vvel(i+1,J-1,k)) * G%mask2dT(i+1,j) + enddo + enddo + endif + if (segment%oblique_grad) then + do k=1,G%ke + do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1) + segment%grad_gradient(j,1,k) = (((vvel(i+3,J,k) - vvel(i+2,J,k))*G%IdxBu(I+2,J)) - & + (vvel(i+3,J-1,k) - vvel(i+2,J-1,k))*G%IdxBu(I+2,J-1)) * G%mask2dCu(I+2,j) + segment%grad_gradient(j,2,k) = (((vvel(i+2,J,k) - vvel(i+1,J,k))*G%IdxBu(I+1,J)) - & + (vvel(i+2,J-1,k) - vvel(i+1,J-1,k))*G%IdxBu(I+1,J-1)) * G%mask2dCu(I+1,j) + enddo + enddo + endif endif elseif (segment%is_N_or_S) then if (segment%direction == OBC_DIRECTION_N) then @@ -2162,6 +2530,24 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) segment%grad_normal(I,2,k) = (vvel(i+1,J,k)-vvel(i,J,k)) * G%mask2dBu(I,J) enddo enddo + if (segment%oblique_tan) then + do k=1,G%ke + do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) + segment%grad_tan(i,1,k) = (uvel(I,j-1,k)-uvel(I-1,j-1,k)) * G%mask2dT(i,j-1) + segment%grad_tan(i,2,k) = (uvel(I,j,k)-uvel(I-1,j,k)) * G%mask2dT(i,j) + enddo + enddo + endif + if (segment%oblique_grad) then + do k=1,G%ke + do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) + segment%grad_gradient(i,1,k) = (((uvel(I,j-1,k) - uvel(I,j-2,k))*G%IdxBu(I,J-2)) - & + (uvel(I-1,j-1,k) - uvel(I-1,j-2,k))*G%IdxBu(I-1,J-2)) * G%mask2dCv(I,j-1) + segment%grad_gradient(i,2,k) = (((uvel(I,j,k) - uvel(I,j-1,k))*G%IdyBu(I,J-1)) - & + (uvel(I-1,j,k) - uvel(I-1,j-1,k))*G%IdyBu(I-1,J-1)) * G%mask2dCv(i,J) + enddo + enddo + endif else ! south segment J=segment%HI%jsdB do k=1,G%ke @@ -2170,6 +2556,24 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) segment%grad_normal(I,2,k) = (vvel(i+1,J,k)-vvel(i,J,k)) * G%mask2dBu(I,J) enddo enddo + if (segment%oblique_tan) then + do k=1,G%ke + do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) + segment%grad_tan(i,1,k) = (uvel(I,j+2,k)-uvel(I-1,j+2,k)) * G%mask2dT(i,j+2) + segment%grad_tan(i,2,k) = (uvel(I,j+1,k)-uvel(I-1,j+1,k)) * G%mask2dT(i,j+1) + enddo + enddo + endif + if (segment%oblique_grad) then + do k=1,G%ke + do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) + segment%grad_gradient(i,1,k) = (((uvel(I,j+3,k) - uvel(I,j+2,k))*G%IdxBu(I,J+2)) - & + (uvel(I-1,j+3,k) - uvel(I-1,j+2,k))*G%IdyBu(I-1,J+2)) * G%mask2dCv(i,J+2) + segment%grad_gradient(i,2,k) = (((uvel(I,j+2,k) - uvel(I,j+1,k))*G%IdxBu(I,J+1)) - & + (uvel(I-1,j+2,k) - uvel(I-1,j+1,k))*G%IdyBu(I-1,J+1)) * G%mask2dCv(i,J+1) + enddo + enddo + endif endif endif @@ -2329,7 +2733,8 @@ subroutine allocate_OBC_segment_data(OBC, segment) if (segment%nudged_grad) then allocate(segment%nudged_tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_grad(:,:,:)=0.0 endif - if (OBC%specified_vorticity .or. OBC%specified_strain .or. segment%radiation_grad) then + if (OBC%specified_vorticity .or. OBC%specified_strain .or. segment%radiation_grad .or. & + segment%oblique_grad) then allocate(segment%tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_grad(:,:,:)=0.0 endif if (segment%oblique) then @@ -2338,6 +2743,12 @@ subroutine allocate_OBC_segment_data(OBC, segment) allocate(segment%ry_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%ry_normal(:,:,:)=0.0 allocate(segment%cff_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%cff_normal(:,:,:)=0.0 endif + if (segment%oblique_tan) then + allocate(segment%grad_tan(jsd:jed,2,OBC%ke)); segment%grad_tan(:,:,:) = 0.0 + endif + if (segment%oblique_grad) then + allocate(segment%grad_gradient(jsd:jed,2,OBC%ke)); segment%grad_gradient(:,:,:) = 0.0 + endif endif if (segment%is_N_or_S) then @@ -2365,7 +2776,8 @@ subroutine allocate_OBC_segment_data(OBC, segment) if (segment%nudged_grad) then allocate(segment%nudged_tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_grad(:,:,:)=0.0 endif - if (OBC%specified_vorticity .or. OBC%specified_strain .or. segment%radiation_grad) then + if (OBC%specified_vorticity .or. OBC%specified_strain .or. segment%radiation_grad .or. & + segment%oblique_grad) then allocate(segment%tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_grad(:,:,:)=0.0 endif if (segment%oblique) then @@ -2374,6 +2786,12 @@ subroutine allocate_OBC_segment_data(OBC, segment) allocate(segment%ry_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%ry_normal(:,:,:)=0.0 allocate(segment%cff_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%cff_normal(:,:,:)=0.0 endif + if (segment%oblique_tan) then + allocate(segment%grad_tan(isd:ied,2,OBC%ke)); segment%grad_tan(:,:,:) = 0.0 + endif + if (segment%oblique_grad) then + allocate(segment%grad_gradient(isd:ied,2,OBC%ke)); segment%grad_gradient(:,:,:) = 0.0 + endif endif end subroutine allocate_OBC_segment_data @@ -2394,12 +2812,16 @@ subroutine deallocate_OBC_segment_data(OBC, segment) if (associated (segment%rx_normal)) deallocate(segment%rx_normal) if (associated (segment%ry_normal)) deallocate(segment%ry_normal) if (associated (segment%cff_normal)) deallocate(segment%cff_normal) + if (associated (segment%grad_normal)) deallocate(segment%grad_normal) + if (associated (segment%grad_tan)) deallocate(segment%grad_tan) + if (associated (segment%grad_gradient)) deallocate(segment%grad_gradient) if (associated (segment%normal_vel)) deallocate(segment%normal_vel) if (associated (segment%normal_vel_bt)) deallocate(segment%normal_vel_bt) if (associated (segment%normal_trans)) deallocate(segment%normal_trans) if (associated (segment%nudged_normal_vel)) deallocate(segment%nudged_normal_vel) if (associated (segment%tangential_vel)) deallocate(segment%tangential_vel) if (associated (segment%nudged_tangential_vel)) deallocate(segment%nudged_tangential_vel) + if (associated (segment%nudged_tangential_grad)) deallocate(segment%nudged_tangential_grad) if (associated (segment%tangential_grad)) deallocate(segment%tangential_grad) if (associated (segment%tr_Reg)) call segment_tracer_registry_end(segment%tr_Reg) From 4e5bf74943a363dc84710b0ffee0cb2d39187209 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 1 Aug 2018 13:09:49 -0600 Subject: [PATCH 0619/1072] Change calculation of melt_potential sfc_state%melt_potential is now accumulated over time_in_thermo_cycle. --- config_src/mct_driver/MOM_ocean_model.F90 | 2 +- config_src/mct_driver/ocn_cap_methods.F90 | 5 ++--- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index f7092865c6..9971747afd 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -722,7 +722,7 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, Ocean_sfc%v_surf = 0.0 ! time averaged v-current (m/sec) passed to atmosphere/ice models Ocean_sfc%sea_lev = 0.0 ! time averaged thickness of top model grid cell (m) plus patm/rho0/grav Ocean_sfc%frazil = 0.0 ! time accumulated frazil (J/m^2) passed to ice model - Ocean_sfc%melt_potential = 0.0 ! time accumulated melt potential (W/m^2) passed to ice model + Ocean_sfc%melt_potential = 0.0 ! time accumulated melt potential (J/m^2) passed to ice model Ocean_sfc%area = 0.0 Ocean_sfc%axes = diag%axesT1%handles !diag axes to be used by coupler tracer flux diagnostics diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 36a4faef09..5d2aac1317 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -181,9 +181,8 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) ! Frazil: change from J/m^2 to W/m^2 o2x(ind%o2x_Fioo_q, n) = ocn_public%frazil(ig,jg) * grid%mask2dT(i,j) * I_time_int else - ! Melt_potential already is in W/m^2 (ncouple_per_day is unitless) - ! GMM - Hycom cap uses icefrq rather than oceanfrq (ncouple_per_day) - o2x(ind%o2x_Fioo_q, n) = -ocn_public%melt_potential(ig,jg) * grid%mask2dT(i,j) * ncouple_per_day + ! Melt_potential: change from J/m^2 to W/m^2 + o2x(ind%o2x_Fioo_q, n) = -ocn_public%melt_potential(ig,jg) * grid%mask2dT(i,j) * I_time_int endif ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain ! in order to update halos. i.e. does not use global indexing. From 7347ad973cc518173e02f04e28bb27c17d56887c Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 1 Aug 2018 13:12:22 -0600 Subject: [PATCH 0620/1072] Update calculation of melt_potential --- src/core/MOM.F90 | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index f3abb6bc69..73b09820b6 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -195,7 +195,6 @@ module MOM !! bottom drag viscosities, and related fields type(MEKE_type), pointer :: MEKE => NULL() !< structure containing fields !! related to the Mesoscale Eddy Kinetic Energy - logical :: adiabatic !< If true, there are no diapycnal mass fluxes, and no calls !! to routines to calculate or apply diapycnal fluxes. logical :: use_legacy_diabatic_driver!< If true (default), use the a legacy version of the @@ -526,6 +525,8 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (therm_reset) then CS%time_in_thermo_cycle = 0.0 + ! GMM + if (allocated(sfc_state%melt_potential)) sfc_state%melt_potential(:,:) = 0.0 if (associated(CS%tv%frazil)) CS%tv%frazil(:,:) = 0.0 if (associated(CS%tv%salt_deficit)) CS%tv%salt_deficit(:,:) = 0.0 if (associated(CS%tv%TempxPmE)) CS%tv%TempxPmE(:,:) = 0.0 @@ -807,7 +808,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & endif if (showCallTree) call callTree_waypoint("calling extract_surface_state (step_MOM)") - call extract_surface_state(CS, sfc_state, dt) + call extract_surface_state(CS, sfc_state, dt_therm) ! Do diagnostics that only occur at the end of a complete forcing step. if (cycle_end) then @@ -2815,15 +2816,17 @@ subroutine extract_surface_state(CS, sfc_state, dt) !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ! set melt_potential to zero to avoid passing values set previously - sfc_state%melt_potential(i,j) = 0.0 - ! calculate freezing temp. - call calculate_TFreeze(sfc_state%SSS(i,j), CS%tv%P_Ref, T_freeze, CS%tv%eqn_of_state) + if (G%mask2dT(i,j)>0.) then + ! calculate freezing pot. temp. @ surface + call calculate_TFreeze(sfc_state%SSS(i,j), 0.0, T_freeze, CS%tv%eqn_of_state) if (present(dt)) then - ! melt_potential, in W/m^2 - sfc_state%melt_potential(i,j) = CS%tv%C_p * CS%GV%Rho0 * (sfc_state%SST(i,j) - T_freeze) * sfc_state%Hml(i,j)/dt + ! time accumulated melt_potential, in J/m^2 + sfc_state%melt_potential(i,j) = sfc_state%melt_potential(i,j) + (CS%tv%C_p * CS%GV%Rho0 * & + (sfc_state%SST(i,j) - T_freeze) * CS%Hmix) else sfc_state%melt_potential(i,j) = 0.0 endif + endif! G%mask2dT enddo ; enddo endif From 05d6c805abc50fbb6dc61d62ed128400c1f0c108 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 1 Aug 2018 14:26:33 -0600 Subject: [PATCH 0621/1072] Update melt_potential again, but values are still ~ 3 x smaller --- config_src/mct_driver/ocn_cap_methods.F90 | 2 +- src/core/MOM.F90 | 5 ++--- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 5d2aac1317..5b7c341424 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -182,7 +182,7 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) o2x(ind%o2x_Fioo_q, n) = ocn_public%frazil(ig,jg) * grid%mask2dT(i,j) * I_time_int else ! Melt_potential: change from J/m^2 to W/m^2 - o2x(ind%o2x_Fioo_q, n) = -ocn_public%melt_potential(ig,jg) * grid%mask2dT(i,j) * I_time_int + o2x(ind%o2x_Fioo_q, n) = -ocn_public%melt_potential(ig,jg) * grid%mask2dT(i,j) !* I_time_int * ncouple_per_day endif ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain ! in order to update halos. i.e. does not use global indexing. diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 73b09820b6..2c7201028d 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -525,7 +525,6 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (therm_reset) then CS%time_in_thermo_cycle = 0.0 - ! GMM if (allocated(sfc_state%melt_potential)) sfc_state%melt_potential(:,:) = 0.0 if (associated(CS%tv%frazil)) CS%tv%frazil(:,:) = 0.0 if (associated(CS%tv%salt_deficit)) CS%tv%salt_deficit(:,:) = 0.0 @@ -2820,9 +2819,9 @@ subroutine extract_surface_state(CS, sfc_state, dt) ! calculate freezing pot. temp. @ surface call calculate_TFreeze(sfc_state%SSS(i,j), 0.0, T_freeze, CS%tv%eqn_of_state) if (present(dt)) then - ! time accumulated melt_potential, in J/m^2 + ! time accumulated melt_potential, in W/m^2 sfc_state%melt_potential(i,j) = sfc_state%melt_potential(i,j) + (CS%tv%C_p * CS%GV%Rho0 * & - (sfc_state%SST(i,j) - T_freeze) * CS%Hmix) + (sfc_state%SST(i,j) - T_freeze) * CS%Hmix)/dt else sfc_state%melt_potential(i,j) = 0.0 endif From c95d513194bade848ba75a460bd63ba5a6c9cc5b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 3 Aug 2018 03:18:31 -0400 Subject: [PATCH 0622/1072] +Use stress_mag to set ustar Added code to use IOB%stress_mag to set ustar if is allocated. The code to set stress_mag in SIS2 is equivalent to that in MOM6, so the answers are currently unchanged if this new option is used. Also rearranged the code setting the wind stresses, ustar, and other forcing fields so they are more logically grouped. All answers are bitwise identical in test cases, but there are new options to allow the sea-ice or coupler to set ustar differently. --- .../coupled_driver/MOM_surface_forcing.F90 | 133 ++++++++++-------- 1 file changed, 72 insertions(+), 61 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 02b54daefe..693a200c18 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -324,7 +324,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & ! 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 @@ -576,7 +575,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, 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) @@ -611,7 +610,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 i0 = is - isc_bnd ; j0 = js - jsc_bnd - Irho0 = 1.0/CS%Rho0 + Irho0 = 1.0/CS%Rho0 ! allocation and initialization if this is the first time that this ! mechanical forcing type has been used. @@ -638,6 +637,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) 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) @@ -672,41 +672,16 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) wind_stagger = CS%wind_stagger if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. & (IOB%wind_stagger == CGRID_NE)) wind_stagger = IOB%wind_stagger + + ! Set surface momentum stress related fields as a function of staggering. 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 - endif - if (wind_stagger == AGRID) then - ! This is necessary to fill in the halo points. - taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 - endif - - ! 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 + ! obtain fluxes from IOB; note the staggering of indices + do j=js,je ; do i=is,ie 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 - elseif (wind_stagger == AGRID) then - if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - else ! C-grid wind stresses. - if (associated(IOB%u_flux)) forces%taux(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) forces%tauy(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - endif - - enddo ; enddo - - ! surface momentum stress related fields as function of staggering - if (wind_stagger == BGRID_NE) then + enddo ; enddo 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, halo=1) @@ -727,25 +702,14 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) enddo ; enddo - ! ustar is required for the bulk mixed layer formulation. The background value - ! of 0.02 Pa is a relatively small value intended to give reasonable behavior - ! in regions of very weak winds. - + elseif (wind_stagger == AGRID) then + ! This is necessary to fill in the halo points. + taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 + ! obtain fluxes from IOB; note the staggering of indices do j=js,je ; do i=is,ie - tau_mag = 0.0 ; gustiness = CS%gust_const - if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & - (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then - tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & - G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & - (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & - G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & - ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) - if (CS%read_gust_2d) gustiness = CS%gust(i,j) - endif - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) + if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier enddo ; enddo - - elseif (wind_stagger == AGRID) then call pass_vector(taux_at_h, tauy_at_h, G%Domain, To_All+Omit_Corners, & stagger=AGRID, halo=1) @@ -765,25 +729,61 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) (G%mask2dT(i,j) + G%mask2dT(i,j+1)) enddo ; enddo + else ! C-grid wind stresses. do j=js,je ; do i=is,ie - gustiness = CS%gust_const - if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & - sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) + if (associated(IOB%u_flux)) forces%taux(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%v_flux)) forces%tauy(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier enddo ; enddo - - 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, halo=1) + endif ! endif for wind stress fields + ! Set surface friction velocity directly or as a function of staggering. + ! ustar is required for the bulk mixed layer formulation and other turbulent mixing + ! parametizations. The background gustiness (for example with a relatively small value + ! of 0.02 Pa) is intended to give reasonable behavior in regions of very weak winds. + if (associated(IOB%stress_mag)) then + do j=js,je ; do i=is,ie + gustiness = CS%gust_const + !### SIMPLIFY THE TREATMENT OF GUSTINESS! + if (CS%read_gust_2d) then + if ((wind_stagger == CGRID_NE) .or. & + ((wind_stagger == AGRID) .and. (G%mask2dT(i,j) > 0)) .or. & + ((wind_stagger == BGRID_NE) .and. & + (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0)) ) & + gustiness = CS%gust(i,j) + endif + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*IOB%stress_mag(i-i0,j-j0)) + enddo ; enddo + elseif (wind_stagger == BGRID_NE) then + do j=js,je ; do i=is,ie + tau_mag = 0.0 ; gustiness = CS%gust_const + if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then + tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & + G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & + (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & + G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & + ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) + if (CS%read_gust_2d) gustiness = CS%gust(i,j) + endif + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) + enddo ; enddo + elseif (wind_stagger == AGRID) then + do j=js,je ; do i=is,ie + gustiness = CS%gust_const + if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) + forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & + sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) + enddo ; enddo + else ! C-grid wind stresses. do j=js,je ; do i=is,ie - taux2 = 0.0 + taux2 = 0.0 ; tauy2 = 0.0 if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + & G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) - - tauy2 = 0.0 if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + & G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) @@ -794,11 +794,22 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) endif enddo ; enddo + endif ! endif for wind friction velocity fields - endif ! endif for wind related fields + ! Obtain optional ice-berg related fluxes from the IOB type: + if (associated(IOB%area_berg)) then ; do j=js,je ; do i=is,ie + forces%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) + enddo ; enddo ; endif - ! sea ice related dynamic fields + if (associated(IOB%mass_berg)) then ; do j=js,je ; do i=is,ie + forces%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) + enddo ; enddo ; endif + + ! Obtain sea ice related dynamic fields if (associated(IOB%ice_rigidity)) then + do j=js,je ; do i=is,ie + rigidity_at_h(i,j) = IOB%ice_rigidity(i-i0,j-j0) * G%mask2dT(i,j) + enddo ; enddo 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) + & From e1762f57d14e4f01ce2bc9b63fa42818163618fc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 3 Aug 2018 12:49:41 -0400 Subject: [PATCH 0623/1072] +Added extract_IOB_stresses Added a new subroutine, extract_IOB_stresses, to obtain the wind stresses and friction velocities from the ice-ocean-boundary type into simple arrays that are provided as optional arguments. All answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 209 ++++++++++++++++++ 1 file changed, 209 insertions(+) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 693a200c18..996455d26c 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -856,6 +856,215 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) call cpu_clock_end(id_clock_forcing) end subroutine convert_IOB_to_forces + +!> This subroutine extracts the wind stresses and related fields like ustar from an +!! Ice_ocean_boundary_type into optional argument arrays, including changes of units, sign +!! conventions, and putting the fields into arrays with MOM-standard sized halos. +subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, ustar, gustless_ustar) + type(ice_ocean_boundary_type), & + target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive + !! the ocean in a coupled model + 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 + type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a + !! previous call to surface_forcing_init. + real, dimension(SZIB_(G),SZJ_(G)), & + optional, intent(out) :: taux !< The zonal wind stresses on a C-grid, in Pa. + real, dimension(SZI_(G),SZJB_(G)), & + optional, intent(out) :: tauy !< The meridional wind stresses on a C-grid, in Pa. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(out) :: ustar !< The surface friction velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(out) :: gustless_ustar !< The surface friction velocity without + !! any contributions from gustiness, in m s-1. + + ! Local variables + real, dimension(SZIB_(G),SZJ_(G)) :: & + taux_at_u ! Zonal wind stresses at u points (Pa) + real, dimension(SZI_(G),SZJB_(G)) :: & + tauy_at_v ! Meridional wind stresses at V points (Pa) + 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) + + real, dimension(SZI_(G),SZJ_(G)) :: & + 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) + + logical :: do_ustar, do_gustless + 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 + i0 = is - isc_bnd ; j0 = js - jsc_bnd + + Irho0 = 1.0/CS%Rho0 + + do_ustar = present(ustar) ; do_gustless = present(gustless_ustar) + + wind_stagger = CS%wind_stagger + if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. & + (IOB%wind_stagger == CGRID_NE)) wind_stagger = IOB%wind_stagger + + ! Set surface momentum stress related fields as a function of staggering. + if (present(taux) .or. present(tauy) .or. & + ((do_ustar.or.do_gustless) .and. .not.associated(IOB%stress_mag)) ) then + 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 + ! obtain fluxes from IOB; note the staggering of indices + do j=js,je ; do i=is,ie + 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 + enddo ; enddo + 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, halo=1) + + if (present(taux)) then ; do j=js,je ; do I=Isq,Ieq + taux(I,j) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & + taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) + enddo ; enddo ; endif + + if (present(tauy)) then ; do J=Jsq,Jeq ; do i=is,ie + tauy(i,J) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & + tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) + enddo ; enddo ; endif + + elseif (wind_stagger == AGRID) then + ! This is necessary to fill in the halo points. + taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 + ! obtain fluxes from IOB; note the staggering of indices + do j=js,je ; do i=is,ie + if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + enddo ; enddo + call pass_vector(taux_at_h, tauy_at_h, G%Domain, To_All+Omit_Corners, & + stagger=AGRID, halo=1) + + if (present(taux)) then ; do j=js,je ; do I=Isq,Ieq + taux(I,j) = 0.0 + if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & + taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & + (G%mask2dT(i,j) + G%mask2dT(i+1,j)) + enddo ; enddo ; endif + + if (present(tauy)) then ; do J=Jsq,Jeq ; do i=is,ie + tauy(i,J) = 0.0 + if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & + tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & + (G%mask2dT(i,j) + G%mask2dT(i,j+1)) + enddo ; enddo ; endif + + else ! C-grid wind stresses. + do j=js,je ; do i=is,ie + if (associated(IOB%u_flux)) taux_at_u(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%v_flux)) tauy_at_v(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + enddo ; enddo + if (G%symmetric) & + call fill_symmetric_edges(taux_at_u, tauy_at_v, G%Domain) + call pass_vector(taux_at_u, tauy_at_v, G%Domain, halo=1) + + if (present(taux)) then ; do j=js,je ; do I=Isq,Ieq + taux(I,j) = G%mask2dCu(I,j)*taux_at_u(I,j) + enddo ; enddo ; endif + + if (present(tauy)) then ; do J=Jsq,Jeq ; do i=is,ie + tauy(i,J) = G%mask2dCv(i,J)*tauy_at_v(i,J) + enddo ; enddo ; endif + + endif ! endif for extracting wind stress fields with various staggerings + endif + + if (do_ustar .or. do_gustless) then + ! Set surface friction velocity directly or as a function of staggering. + ! ustar is required for the bulk mixed layer formulation and other turbulent mixing + ! parametizations. The background gustiness (for example with a relatively small value + ! of 0.02 Pa) is intended to give reasonable behavior in regions of very weak winds. + if (associated(IOB%stress_mag)) then + if (do_ustar) then ; do j=js,je ; do i=is,ie + gustiness = CS%gust_const + !### SIMPLIFY THE TREATMENT OF GUSTINESS! + if (CS%read_gust_2d) then + if ((wind_stagger == CGRID_NE) .or. & + ((wind_stagger == AGRID) .and. (G%mask2dT(i,j) > 0)) .or. & + ((wind_stagger == BGRID_NE) .and. & + (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0)) ) & + gustiness = CS%gust(i,j) + endif + ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*IOB%stress_mag(i-i0,j-j0)) + enddo ; enddo ; endif + if (do_gustless) then ; do j=js,je ; do i=is,ie + gustless_ustar(i,j) = sqrt(Irho0*IOB%stress_mag(i-i0,j-j0)) + enddo ; enddo ; endif + elseif (wind_stagger == BGRID_NE) then + do j=js,je ; do i=is,ie + tau_mag = 0.0 ; gustiness = CS%gust_const + if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then + tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & + G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & + (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & + G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & + ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) + if (CS%read_gust_2d) gustiness = CS%gust(i,j) + endif + if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) + if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0*tau_mag) + enddo ; enddo + elseif (wind_stagger == AGRID) then + do j=js,je ; do i=is,ie + tau_mag = G%mask2dT(i,j) * sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2) + gustiness = CS%gust_const + if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) + if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) + if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0*tau_mag) + enddo ; enddo + else ! C-grid wind stresses. + do j=js,je ; do i=is,ie + taux2 = 0.0 ; tauy2 = 0.0 + if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & + taux2 = (G%mask2dCu(I-1,j)*taux_at_u(I-1,j)**2 + & + G%mask2dCu(I,j)*taux_at_u(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) + if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & + tauy2 = (G%mask2dCv(i,J-1)*tauy_at_v(i,J-1)**2 + & + G%mask2dCv(i,J)*tauy_at_v(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) + tau_mag = sqrt(taux2 + tauy2) + + gustiness = CS%gust_const + if (CS%read_gust_2d) gustiness = CS%gust(i,j) + + if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) + if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0*tau_mag) + enddo ; enddo + endif ! endif for wind friction velocity fields + endif + +end subroutine extract_IOB_stresses + + !> Adds thermodynamic flux adjustments obtained via data_override !! Component name is 'OCN' !! Available adjustments are: From be0e7a844aada4541cc9f8dec341b5406bc4bccd Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 3 Aug 2018 16:48:24 -0600 Subject: [PATCH 0624/1072] Remove dt from extract_surface_state --- src/core/MOM.F90 | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 2c7201028d..a6206c2fec 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -807,7 +807,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & endif if (showCallTree) call callTree_waypoint("calling extract_surface_state (step_MOM)") - call extract_surface_state(CS, sfc_state, dt_therm) + call extract_surface_state(CS, sfc_state) ! Do diagnostics that only occur at the end of a complete forcing step. if (cycle_end) then @@ -2631,12 +2631,11 @@ end subroutine adjust_ssh_for_p_atm !> This subroutine sets the surface (return) properties of the ocean !! model by setting the appropriate fields in sfc_state. Unused fields !! are set to NULL or are unallocated. -subroutine extract_surface_state(CS, sfc_state, dt) +subroutine extract_surface_state(CS, sfc_state) type(MOM_control_struct), pointer :: CS !< Master MOM control structure type(surface), intent(inout) :: sfc_state !< transparent ocean surface state !! structure shared with the calling routine !! data in this structure is intent out. - real, optional, intent(in) :: dt !< Thermodynamic time step, in s. ! local real :: hu, hv @@ -2818,13 +2817,11 @@ subroutine extract_surface_state(CS, sfc_state, dt) if (G%mask2dT(i,j)>0.) then ! calculate freezing pot. temp. @ surface call calculate_TFreeze(sfc_state%SSS(i,j), 0.0, T_freeze, CS%tv%eqn_of_state) - if (present(dt)) then - ! time accumulated melt_potential, in W/m^2 - sfc_state%melt_potential(i,j) = sfc_state%melt_potential(i,j) + (CS%tv%C_p * CS%GV%Rho0 * & - (sfc_state%SST(i,j) - T_freeze) * CS%Hmix)/dt - else + ! time accumulated melt_potential, in W/m^2 + sfc_state%melt_potential(i,j) = sfc_state%melt_potential(i,j) + (CS%tv%C_p * CS%GV%Rho0 * & + (sfc_state%SST(i,j) - T_freeze) * CS%Hmix) + else sfc_state%melt_potential(i,j) = 0.0 - endif endif! G%mask2dT enddo ; enddo endif From eb2c69f1dde9c955257f98fc183d62f606cf3e64 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 3 Aug 2018 16:53:25 -0600 Subject: [PATCH 0625/1072] Replace units (W/m^2 to J/m^2) in the comments --- src/core/MOM.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index a6206c2fec..5a648c4c9c 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2817,7 +2817,7 @@ subroutine extract_surface_state(CS, sfc_state) if (G%mask2dT(i,j)>0.) then ! calculate freezing pot. temp. @ surface call calculate_TFreeze(sfc_state%SSS(i,j), 0.0, T_freeze, CS%tv%eqn_of_state) - ! time accumulated melt_potential, in W/m^2 + ! time accumulated melt_potential, in J/m^2 sfc_state%melt_potential(i,j) = sfc_state%melt_potential(i,j) + (CS%tv%C_p * CS%GV%Rho0 * & (sfc_state%SST(i,j) - T_freeze) * CS%Hmix) else From 4b859d488ef76ec0a1fdc9b4cbfabdc2d100288d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 3 Aug 2018 18:53:49 -0400 Subject: [PATCH 0626/1072] Always set G%Domain_aux G%Domain_aux points to a non-symmetric MOM6 domain. It had previously only been set if G%Domain is symmetric, but was otherwise not associated. Now if G%domain is itself non-symmetric, G%domain_aux simply points back to G%domain. G%domain_aux can now be used more widely without causing problems. All answers are bitwise identical. --- src/core/MOM.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c554e4f92e..ce23880906 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2135,8 +2135,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Set a few remaining fields that are specific to the ocean grid type. call set_first_direction(G, first_direction) ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. - if (CS%debug .or. G%symmetric) & + if (CS%debug .or. G%symmetric) then call clone_MOM_domain(G%Domain, G%Domain_aux, symmetric=.false.) + else ; G%Domain_aux => G%Domain ; endif ! Copy common variables from the vertical grid to the horizontal grid. ! Consider removing this later? G%ke = GV%ke ; G%g_Earth = GV%g_Earth @@ -2165,8 +2166,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call MOM_grid_end(G) ; deallocate(G) G => CS%G - if (CS%debug .or. CS%G%symmetric) & + if (CS%debug .or. CS%G%symmetric) then call clone_MOM_domain(CS%G%Domain, CS%G%Domain_aux, symmetric=.false.) + else ; CS%G%Domain_aux => CS%G%Domain ;endif G%ke = GV%ke ; G%g_Earth = GV%g_Earth endif From 7507e2d8d373f5562876de47b829bf07ebb5c868 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 3 Aug 2018 18:54:32 -0400 Subject: [PATCH 0627/1072] Set stresses via extract_IOB_stresses Replaced the code setting the wind stresses in code_IOB_to_forces with a call to extract_IOB_stresses. Also streamlined extract_IOB_stresses to avoid extra unnecessary communications. All answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 198 ++++-------------- 1 file changed, 35 insertions(+), 163 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 996455d26c..c963670ee3 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -669,132 +669,9 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) endif forces%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. - wind_stagger = CS%wind_stagger - if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. & - (IOB%wind_stagger == CGRID_NE)) wind_stagger = IOB%wind_stagger - - ! Set surface momentum stress related fields as a function of staggering. - 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 - ! obtain fluxes from IOB; note the staggering of indices - do j=js,je ; do i=is,ie - 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 - enddo ; enddo - 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, halo=1) - - do j=js,je ; do I=Isq,Ieq - forces%taux(I,j) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & - forces%taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + & - G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) - enddo ; enddo - - do J=Jsq,Jeq ; do i=is,ie - forces%tauy(i,J) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & - forces%tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + & - G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) - enddo ; enddo - - elseif (wind_stagger == AGRID) then - ! This is necessary to fill in the halo points. - taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 - ! obtain fluxes from IOB; note the staggering of indices - do j=js,je ; do i=is,ie - if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - enddo ; enddo - 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 - if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & - forces%taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + & - G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & - (G%mask2dT(i,j) + G%mask2dT(i+1,j)) - enddo ; enddo - - do J=Jsq,Jeq ; do i=is,ie - forces%tauy(i,J) = 0.0 - if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & - forces%tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + & - G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & - (G%mask2dT(i,j) + G%mask2dT(i,j+1)) - enddo ; enddo - - else ! C-grid wind stresses. - do j=js,je ; do i=is,ie - if (associated(IOB%u_flux)) forces%taux(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) forces%tauy(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - enddo ; enddo - if (G%symmetric) & - call fill_symmetric_edges(forces%taux, forces%tauy, G%Domain) - call pass_vector(forces%taux, forces%tauy, G%Domain, halo=1) - endif ! endif for wind stress fields - - ! Set surface friction velocity directly or as a function of staggering. - ! ustar is required for the bulk mixed layer formulation and other turbulent mixing - ! parametizations. The background gustiness (for example with a relatively small value - ! of 0.02 Pa) is intended to give reasonable behavior in regions of very weak winds. - if (associated(IOB%stress_mag)) then - do j=js,je ; do i=is,ie - gustiness = CS%gust_const - !### SIMPLIFY THE TREATMENT OF GUSTINESS! - if (CS%read_gust_2d) then - if ((wind_stagger == CGRID_NE) .or. & - ((wind_stagger == AGRID) .and. (G%mask2dT(i,j) > 0)) .or. & - ((wind_stagger == BGRID_NE) .and. & - (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & - (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0)) ) & - gustiness = CS%gust(i,j) - endif - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*IOB%stress_mag(i-i0,j-j0)) - enddo ; enddo - elseif (wind_stagger == BGRID_NE) then - do j=js,je ; do i=is,ie - tau_mag = 0.0 ; gustiness = CS%gust_const - if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & - (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then - tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & - G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & - (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & - G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & - ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) - if (CS%read_gust_2d) gustiness = CS%gust(i,j) - endif - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) - enddo ; enddo - elseif (wind_stagger == AGRID) then - do j=js,je ; do i=is,ie - gustiness = CS%gust_const - if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & - sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) - enddo ; enddo - else ! C-grid wind stresses. - do j=js,je ; do i=is,ie - taux2 = 0.0 ; tauy2 = 0.0 - if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & - taux2 = (G%mask2dCu(I-1,j)*forces%taux(I-1,j)**2 + & - G%mask2dCu(I,j)*forces%taux(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) - if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & - tauy2 = (G%mask2dCv(i,J-1)*forces%tauy(i,J-1)**2 + & - G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) - - if (CS%read_gust_2d) then - forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) - else - forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) - endif - enddo ; enddo - endif ! endif for wind friction velocity fields + ! Set the wind stresses and ustar. + call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux=forces%taux, tauy=forces%tauy, & + ustar=forces%ustar, tau_halo=1) ! Obtain optional ice-berg related fluxes from the IOB type: if (associated(IOB%area_berg)) then ; do j=js,je ; do i=is,ie @@ -860,7 +737,8 @@ end subroutine convert_IOB_to_forces !> This subroutine extracts the wind stresses and related fields like ustar from an !! Ice_ocean_boundary_type into optional argument arrays, including changes of units, sign !! conventions, and putting the fields into arrays with MOM-standard sized halos. -subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, ustar, gustless_ustar) +subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, ustar, & + gustless_ustar, tau_halo) type(ice_ocean_boundary_type), & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive !! the ocean in a coupled model @@ -871,23 +749,24 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(out) :: taux !< The zonal wind stresses on a C-grid, in Pa. + optional, intent(inout) :: taux !< The zonal wind stresses on a C-grid, in Pa. real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(out) :: tauy !< The meridional wind stresses on a C-grid, in Pa. + optional, intent(inout) :: tauy !< The meridional wind stresses on a C-grid, in Pa. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(out) :: ustar !< The surface friction velocity, in m s-1. + optional, intent(inout) :: ustar !< The surface friction velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(out) :: gustless_ustar !< The surface friction velocity without !! any contributions from gustiness, in m s-1. + integer, optional, intent(in) :: tau_halo !< The halo size of wind stresses to set, 0 by default. ! Local variables - real, dimension(SZIB_(G),SZJ_(G)) :: & - taux_at_u ! Zonal wind stresses at u points (Pa) - real, dimension(SZI_(G),SZJB_(G)) :: & - tauy_at_v ! Meridional wind stresses at V points (Pa) - 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) + real, dimension(SZI_(G),SZJ_(G)) :: & + taux_at_u ! Zonal wind stresses at u points (Pa) with non-symmetric memory + real, dimension(SZI_(G),SZJ_(G)) :: & + tauy_at_v ! Meridional wind stresses at V points (Pa) with non-symmetric memory + real, dimension(SZI_(G),SZJ_(G)) :: & + taux_at_q, & ! Zonal wind stresses at q points (Pa) with non-symmetric memory + tauy_at_q ! Meridional wind stresses at q points (Pa) with non-symmetric memory real, dimension(SZI_(G),SZJ_(G)) :: & taux_at_h, & ! Zonal wind stresses at h points (Pa) @@ -900,20 +779,13 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta logical :: do_ustar, do_gustless 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) + integer :: i, j, is, ie, js, je, ish, ieh, jsh, jeh, Isqh, Ieqh, Jsqh, Jeqh, i0, j0, halo - isc_bnd = index_bounds(1) ; iec_bnd = index_bounds(2) - jsc_bnd = index_bounds(3) ; jec_bnd = index_bounds(4) + halo = 0 ; if (present(tau_halo)) halo = tau_halo 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 - i0 = is - isc_bnd ; j0 = js - jsc_bnd + ish = G%isc-halo ; ieh = G%iec+halo ; jsh = G%jsc-halo ; jeh = G%jec+halo + Isqh = G%IscB-halo ; Ieqh = G%IecB+halo ; Jsqh = G%JscB-halo ; Jeqh = G%JecB+halo + i0 = is - index_bounds(1) ; j0 = js - index_bounds(3) Irho0 = 1.0/CS%Rho0 @@ -934,18 +806,16 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta 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 enddo ; enddo - 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, halo=1) + call pass_vector(taux_at_q, tauy_at_q, G%Domain_aux, stagger=BGRID_NE, halo=1+halo) - if (present(taux)) then ; do j=js,je ; do I=Isq,Ieq + if (present(taux)) then ; do j=jsh,jeh ; do I=Isqh,Ieqh taux(I,j) = 0.0 if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) enddo ; enddo ; endif - if (present(tauy)) then ; do J=Jsq,Jeq ; do i=is,ie + if (present(tauy)) then ; do J=Jsqh,Jeqh ; do i=ish,ieh tauy(i,J) = 0.0 if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & @@ -960,17 +830,20 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier enddo ; enddo - call pass_vector(taux_at_h, tauy_at_h, G%Domain, To_All+Omit_Corners, & - stagger=AGRID, halo=1) + if (halo == 0) then + call pass_vector(taux_at_h, tauy_at_h, G%Domain, To_All+Omit_Corners, stagger=AGRID, halo=1) + else + call pass_vector(taux_at_h, tauy_at_h, G%Domain, stagger=AGRID, halo=1+halo) + endif - if (present(taux)) then ; do j=js,je ; do I=Isq,Ieq + if (present(taux)) then ; do j=jsh,jeh ; do I=Isqh,Ieqh taux(I,j) = 0.0 if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & (G%mask2dT(i,j) + G%mask2dT(i+1,j)) enddo ; enddo ; endif - if (present(tauy)) then ; do J=Jsq,Jeq ; do i=is,ie + if (present(tauy)) then ; do J=Jsqh,Jeqh ; do i=ish,ieh tauy(i,J) = 0.0 if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & @@ -978,19 +851,18 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta enddo ; enddo ; endif else ! C-grid wind stresses. + taux_at_u(:,:) = 0.0 ; tauy_at_v(:,:) = 0.0 do j=js,je ; do i=is,ie if (associated(IOB%u_flux)) taux_at_u(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier if (associated(IOB%v_flux)) tauy_at_v(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier enddo ; enddo - if (G%symmetric) & - call fill_symmetric_edges(taux_at_u, tauy_at_v, G%Domain) - call pass_vector(taux_at_u, tauy_at_v, G%Domain, halo=1) + call pass_vector(taux_at_u, tauy_at_v, G%Domain_aux, halo=1+halo) - if (present(taux)) then ; do j=js,je ; do I=Isq,Ieq + if (present(taux)) then ; do j=jsh,jeh ; do I=Isqh,Ieqh taux(I,j) = G%mask2dCu(I,j)*taux_at_u(I,j) enddo ; enddo ; endif - if (present(tauy)) then ; do J=Jsq,Jeq ; do i=is,ie + if (present(tauy)) then ; do J=Jsqh,Jeqh ; do i=ish,ieh tauy(i,J) = G%mask2dCv(i,J)*tauy_at_v(i,J) enddo ; enddo ; endif From c6b253400839a91678d4278519ad9c62131e47f9 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 3 Aug 2018 17:02:21 -0600 Subject: [PATCH 0628/1072] Pass melt/freeze potential to coupler; reset melt_potential --- config_src/mct_driver/ocn_cap_methods.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 5b7c341424..6e3317f376 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -182,7 +182,9 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) o2x(ind%o2x_Fioo_q, n) = ocn_public%frazil(ig,jg) * grid%mask2dT(i,j) * I_time_int else ! Melt_potential: change from J/m^2 to W/m^2 - o2x(ind%o2x_Fioo_q, n) = -ocn_public%melt_potential(ig,jg) * grid%mask2dT(i,j) !* I_time_int * ncouple_per_day + o2x(ind%o2x_Fioo_q, n) = -ocn_public%melt_potential(ig,jg) * grid%mask2dT(i,j) * I_time_int !* ncouple_per_day + ! reset melt_potential + ocn_public%melt_potential(ig,jg) = 0.0 endif ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain ! in order to update halos. i.e. does not use global indexing. From 0d1894635bedf9275905debea05bdb0ea762a73a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 3 Aug 2018 19:13:53 -0400 Subject: [PATCH 0629/1072] Code cleanup in MOM_surface_forcing.F90 Code cleanup in MOM_surface_forcing.F90 to reduce memory use. All answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 95 +++++++------------ 1 file changed, 34 insertions(+), 61 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index c963670ee3..a341a34b42 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -576,25 +576,14 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) !! 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) - 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) + rigidity_at_h ! Ice rigidity at tracer points (m3 s-1) - 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 @@ -610,8 +599,6 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 i0 = is - isc_bnd ; j0 = js - jsc_bnd - 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 @@ -761,16 +748,11 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - taux_at_u ! Zonal wind stresses at u points (Pa) with non-symmetric memory - real, dimension(SZI_(G),SZJ_(G)) :: & - tauy_at_v ! Meridional wind stresses at V points (Pa) with non-symmetric memory - real, dimension(SZI_(G),SZJ_(G)) :: & - taux_at_q, & ! Zonal wind stresses at q points (Pa) with non-symmetric memory - tauy_at_q ! Meridional wind stresses at q points (Pa) with non-symmetric memory - + taux_in ! Zonal wind stresses (in Pa) at u, h, or q points, depending on the value of + ! wind_stagger, always with non-symmetric memory to permit array reuse. real, dimension(SZI_(G),SZJ_(G)) :: & - taux_at_h, & ! Zonal wind stresses at h points (Pa) - tauy_at_h ! Meridional wind stresses at h points (Pa) + tauy_in ! Meridional wind stresses (in Pa) at v, h, or q points, depending on the value of + ! wind_stagger, always with non-symmetric memory to permit array reuse. real :: gustiness ! unresolved gustiness that contributes to ustar (Pa) real :: Irho0 ! inverse of the mean density in (m^3/kg) @@ -798,72 +780,63 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta ! Set surface momentum stress related fields as a function of staggering. if (present(taux) .or. present(tauy) .or. & ((do_ustar.or.do_gustless) .and. .not.associated(IOB%stress_mag)) ) then + + ! This is necessary to fill in the halo points. + taux_in(:,:) = 0.0 ; tauy_in(:,:) = 0.0 + ! Obtain stress from IOB; note that the staggering locations of taux_in and tauy_in depend + ! on the values of wind_stagger, so the case-sensitive index convention is not used here. + do j=js,je ; do i=is,ie + if (associated(IOB%u_flux)) taux_in(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + if (associated(IOB%v_flux)) tauy_in(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + enddo ; enddo + 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 - ! obtain fluxes from IOB; note the staggering of indices - do j=js,je ; do i=is,ie - 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 - enddo ; enddo - call pass_vector(taux_at_q, tauy_at_q, G%Domain_aux, stagger=BGRID_NE, halo=1+halo) + call pass_vector(taux_in, tauy_in, G%Domain_aux, stagger=BGRID_NE, halo=1+halo) if (present(taux)) then ; do j=jsh,jeh ; do I=Isqh,Ieqh taux(I,j) = 0.0 if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & - taux(I,j) = (G%mask2dBu(I,J)*taux_at_q(I,J) + G%mask2dBu(I,J-1)*taux_at_q(I,J-1)) / & + taux(I,j) = (G%mask2dBu(I,J)*taux_in(I,J) + G%mask2dBu(I,J-1)*taux_in(I,J-1)) / & (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) enddo ; enddo ; endif if (present(tauy)) then ; do J=Jsqh,Jeqh ; do i=ish,ieh tauy(i,J) = 0.0 if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & - tauy(i,J) = (G%mask2dBu(I,J)*tauy_at_q(I,J) + G%mask2dBu(I-1,J)*tauy_at_q(I-1,J)) / & + tauy(i,J) = (G%mask2dBu(I,J)*tauy_in(I,J) + G%mask2dBu(I-1,J)*tauy_in(I-1,J)) / & (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) enddo ; enddo ; endif elseif (wind_stagger == AGRID) then - ! This is necessary to fill in the halo points. - taux_at_h(:,:) = 0.0 ; tauy_at_h(:,:) = 0.0 - ! obtain fluxes from IOB; note the staggering of indices - do j=js,je ; do i=is,ie - if (associated(IOB%u_flux)) taux_at_h(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) tauy_at_h(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - enddo ; enddo if (halo == 0) then - call pass_vector(taux_at_h, tauy_at_h, G%Domain, To_All+Omit_Corners, stagger=AGRID, halo=1) + call pass_vector(taux_in, tauy_in, G%Domain, To_All+Omit_Corners, stagger=AGRID, halo=1) else - call pass_vector(taux_at_h, tauy_at_h, G%Domain, stagger=AGRID, halo=1+halo) + call pass_vector(taux_in, tauy_in, G%Domain, stagger=AGRID, halo=1+halo) endif if (present(taux)) then ; do j=jsh,jeh ; do I=Isqh,Ieqh taux(I,j) = 0.0 if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & - taux(I,j) = (G%mask2dT(i,j)*taux_at_h(i,j) + G%mask2dT(i+1,j)*taux_at_h(i+1,j)) / & + taux(I,j) = (G%mask2dT(i,j)*taux_in(i,j) + G%mask2dT(i+1,j)*taux_in(i+1,j)) / & (G%mask2dT(i,j) + G%mask2dT(i+1,j)) enddo ; enddo ; endif if (present(tauy)) then ; do J=Jsqh,Jeqh ; do i=ish,ieh tauy(i,J) = 0.0 if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & - tauy(i,J) = (G%mask2dT(i,j)*tauy_at_h(i,j) + G%mask2dT(i,J+1)*tauy_at_h(i,j+1)) / & + tauy(i,J) = (G%mask2dT(i,j)*tauy_in(i,j) + G%mask2dT(i,J+1)*tauy_in(i,j+1)) / & (G%mask2dT(i,j) + G%mask2dT(i,j+1)) enddo ; enddo ; endif else ! C-grid wind stresses. - taux_at_u(:,:) = 0.0 ; tauy_at_v(:,:) = 0.0 - do j=js,je ; do i=is,ie - if (associated(IOB%u_flux)) taux_at_u(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) tauy_at_v(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - enddo ; enddo - call pass_vector(taux_at_u, tauy_at_v, G%Domain_aux, halo=1+halo) + call pass_vector(taux_in, tauy_in, G%Domain_aux, halo=1+halo) if (present(taux)) then ; do j=jsh,jeh ; do I=Isqh,Ieqh - taux(I,j) = G%mask2dCu(I,j)*taux_at_u(I,j) + taux(I,j) = G%mask2dCu(I,j)*taux_in(I,j) enddo ; enddo ; endif if (present(tauy)) then ; do J=Jsqh,Jeqh ; do i=ish,ieh - tauy(i,J) = G%mask2dCv(i,J)*tauy_at_v(i,J) + tauy(i,J) = G%mask2dCv(i,J)*tauy_in(i,J) enddo ; enddo ; endif endif ! endif for extracting wind stress fields with various staggerings @@ -896,10 +869,10 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta tau_mag = 0.0 ; gustiness = CS%gust_const if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then - tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_at_q(I,J)**2 + tauy_at_q(I,J)**2) + & - G%mask2dBu(I-1,J-1)*(taux_at_q(I-1,J-1)**2 + tauy_at_q(I-1,J-1)**2)) + & - (G%mask2dBu(I,J-1)*(taux_at_q(I,J-1)**2 + tauy_at_q(I,J-1)**2) + & - G%mask2dBu(I-1,J)*(taux_at_q(I-1,J)**2 + tauy_at_q(I-1,J)**2)) ) / & + tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_in(I,J)**2 + tauy_in(I,J)**2) + & + G%mask2dBu(I-1,J-1)*(taux_in(I-1,J-1)**2 + tauy_in(I-1,J-1)**2)) + & + (G%mask2dBu(I,J-1)*(taux_in(I,J-1)**2 + tauy_in(I,J-1)**2) + & + G%mask2dBu(I-1,J)*(taux_in(I-1,J)**2 + tauy_in(I-1,J)**2)) ) / & ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif @@ -908,7 +881,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta enddo ; enddo elseif (wind_stagger == AGRID) then do j=js,je ; do i=is,ie - tau_mag = G%mask2dT(i,j) * sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2) + tau_mag = G%mask2dT(i,j) * sqrt(taux_in(i,j)**2 + tauy_in(i,j)**2) gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) @@ -918,11 +891,11 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta do j=js,je ; do i=is,ie taux2 = 0.0 ; tauy2 = 0.0 if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & - taux2 = (G%mask2dCu(I-1,j)*taux_at_u(I-1,j)**2 + & - G%mask2dCu(I,j)*taux_at_u(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) + taux2 = (G%mask2dCu(I-1,j)*taux_in(I-1,j)**2 + & + G%mask2dCu(I,j)*taux_in(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & - tauy2 = (G%mask2dCv(i,J-1)*tauy_at_v(i,J-1)**2 + & - G%mask2dCv(i,J)*tauy_at_v(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) + tauy2 = (G%mask2dCv(i,J-1)*tauy_in(i,J-1)**2 + & + G%mask2dCv(i,J)*tauy_in(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) tau_mag = sqrt(taux2 + tauy2) gustiness = CS%gust_const From b15f514126eeb3a9d03a4627a3f9db2c123bfdc8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 6 Aug 2018 15:04:55 -0400 Subject: [PATCH 0630/1072] Set ustar in fluxes via extract_IOB_stresses Set ustar in fluxes via extract_IOB_stresses, using sub-optimal expressions involving division by mean density rather than multiplication by its reciprocal to reproduce what had been done in set_derived_forcing_fields. All answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 26 ++++++++++++++++--- 1 file changed, 22 insertions(+), 4 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index a341a34b42..71e7f611aa 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -544,6 +544,16 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & endif + ! Set the wind stresses and ustar. + if (associated(fluxes%ustar) .and. associated(fluxes%ustar_gustless)) then + call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, ustar=fluxes%ustar, & + gustless_ustar=fluxes%ustar_gustless) + elseif (associated(fluxes%ustar)) then + call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, ustar=fluxes%ustar) + elseif (associated(fluxes%ustar_gustless)) then + call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, gustless_ustar=fluxes%ustar_gustless) + endif + if (coupler_type_initialized(fluxes%tr_fluxes) .and. & coupler_type_initialized(IOB%fluxes)) & call coupler_type_copy_data(IOB%fluxes, fluxes%tr_fluxes) @@ -862,7 +872,9 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*IOB%stress_mag(i-i0,j-j0)) enddo ; enddo ; endif if (do_gustless) then ; do j=js,je ; do i=is,ie - gustless_ustar(i,j) = sqrt(Irho0*IOB%stress_mag(i-i0,j-j0)) + gustless_ustar(i,j) = sqrt(IOB%stress_mag(i-i0,j-j0) / CS%Rho0) +!### Change to: +! gustless_ustar(i,j) = sqrt(Irho0 * IOB%stress_mag(i-i0,j-j0)) enddo ; enddo ; endif elseif (wind_stagger == BGRID_NE) then do j=js,je ; do i=is,ie @@ -877,7 +889,9 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0*tau_mag) + if (do_gustless) gustless_ustar(i,j) = sqrt(tau_mag / CS%Rho0) +!### Change to: +! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) enddo ; enddo elseif (wind_stagger == AGRID) then do j=js,je ; do i=is,ie @@ -885,7 +899,9 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0*tau_mag) + if (do_gustless) gustless_ustar(i,j) = sqrt(tau_mag / CS%Rho0) +!### Change to: +! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) enddo ; enddo else ! C-grid wind stresses. do j=js,je ; do i=is,ie @@ -902,7 +918,9 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta if (CS%read_gust_2d) gustiness = CS%gust(i,j) if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0*tau_mag) + if (do_gustless) gustless_ustar(i,j) = sqrt(tau_mag / CS%Rho0) +!### Change to: +! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) enddo ; enddo endif ! endif for wind friction velocity fields endif From f20c3f1e04b822af8a97489a850b766a54f7da2c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 6 Aug 2018 15:05:23 -0400 Subject: [PATCH 0631/1072] +Changed interface to forcing_accumulate Turned forces into an optional argument to forcing_accumulate and changed the order of the list of arguments. Forces is no longer needed when the pressure and ustar fields are properly set in the temporary fluxes array. The forces argument is now omitted from the call to forcing_accumulate in update_ocean_model, and the call to set_derived_forcing_fields has been eliminated. All answers are bitwise identical. --- config_src/coupled_driver/ocean_model_MOM.F90 | 13 ++--- src/core/MOM_forcing_type.F90 | 51 +++++++++++++------ 2 files changed, 40 insertions(+), 24 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index a09a5bfe29..dde127b146 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -505,9 +505,6 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) 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, skip_pres=.true.) - #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 @@ -516,6 +513,8 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%fluxes%fluxes_used = .false. OS%fluxes%dt_buoy_accum = dt_coupling else + ! The previous fluxes have not been used yet, so translate the input fluxes + ! into a temporary type and then accumulate them in about 20 lines. OS%flux_tmp%C_p = OS%fluxes%C_p if (do_thermo) & call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & @@ -536,16 +535,15 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif - call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, dt_coupling, OS%grid, weight) + call forcing_accumulate(OS%flux_tmp, OS%fluxes, dt_coupling, OS%grid, weight) ! Some of the fields that exist in both the forcing and mech_forcing types - ! (e.g., ustar) are time-averages must be copied back to the forces type. + ! (now just 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 endif - call set_derived_forcing_fields(OS%forces, OS%fluxes, OS%grid, OS%GV%Rho0) call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid) if (OS%use_waves) then @@ -573,8 +571,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & else 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)) + 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) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 9486967b40..4235c2a82f 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -1742,15 +1742,15 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use end subroutine register_forcing_type_diags !> Accumulate the forcing over time steps -subroutine forcing_accumulate(flux_tmp, forces, fluxes, dt, G, wt2) - type(forcing), intent(in) :: flux_tmp !< A temporary structure with current - !!thermodynamic forcing fields - type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - type(forcing), intent(inout) :: fluxes !< A structure containing time-averaged - !! thermodynamic forcing fields - real, intent(in) :: dt !< The elapsed time since the last call to this subroutine, in s - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, intent(out) :: wt2 !< The relative weight of the new fluxes +subroutine forcing_accumulate(flux_tmp, fluxes, dt, G, wt2, forces) + type(forcing), intent(in) :: flux_tmp !< A temporary structure with current + !! thermodynamic forcing fields + type(forcing), intent(inout) :: fluxes !< A structure containing time-averaged + !! thermodynamic forcing fields + real, intent(in) :: dt !< The elapsed time since the last call to this subroutine, in s + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + real, intent(out) :: wt2 !< The relative weight of the new fluxes + type(mech_forcing), optional, intent(in) :: forces !< A structure with the driving mechanical forces ! This subroutine copies mechancal forcing from flux_tmp to fluxes and ! stores the time-weighted averages of the various buoyancy fluxes in fluxes, @@ -1774,15 +1774,29 @@ subroutine forcing_accumulate(flux_tmp, forces, fluxes, dt, G, wt2) wt2 = 1.0 - wt1 ! = dt / (fluxes%dt_buoy_accum + dt) fluxes%dt_buoy_accum = fluxes%dt_buoy_accum + dt - ! Copy over the pressure fields. - do j=js,je ; do i=is,ie - fluxes%p_surf(i,j) = forces%p_surf(i,j) - fluxes%p_surf_full(i,j) = forces%p_surf_full(i,j) - enddo ; enddo + ! Copy over the pressure fields and accumulate averages of ustar, either from the forcing + ! type or from the temporary fluxes type. + if (present(forces)) then + do j=js,je ; do i=is,ie + fluxes%p_surf(i,j) = forces%p_surf(i,j) + fluxes%p_surf_full(i,j) = forces%p_surf_full(i,j) + + fluxes%ustar(i,j) = wt1*fluxes%ustar(i,j) + wt2*forces%ustar(i,j) + enddo ; enddo + else + do j=js,je ; do i=is,ie + fluxes%p_surf(i,j) = flux_tmp%p_surf(i,j) + fluxes%p_surf_full(i,j) = flux_tmp%p_surf_full(i,j) + + fluxes%ustar(i,j) = wt1*fluxes%ustar(i,j) + wt2*flux_tmp%ustar(i,j) + enddo ; enddo + endif ! Average the water, heat, and salt fluxes, and ustar. do j=js,je ; do i=is,ie - fluxes%ustar(i,j) = wt1*fluxes%ustar(i,j) + wt2*forces%ustar(i,j) +!### Replace the expression for ustar_gustless with this one... +! fluxes%ustar_gustless(i,j) = wt1*fluxes%ustar_gustless(i,j) + wt2*flux_tmp%ustar_gustless(i,j) + fluxes%ustar_gustless(i,j) = flux_tmp%ustar_gustless(i,j) fluxes%evap(i,j) = wt1*fluxes%evap(i,j) + wt2*flux_tmp%evap(i,j) fluxes%lprec(i,j) = wt1*fluxes%lprec(i,j) + wt2*flux_tmp%lprec(i,j) @@ -1922,9 +1936,12 @@ subroutine set_derived_forcing_fields(forces, fluxes, G, Rho0) !! as used to calculate ustar. real :: taux2, tauy2 ! Squared wind stress components, in Pa^2. + real :: Irho0 ! Inverse of the mean density in (m^3/kg) integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + Irho0 = 1.0/Rho0 + if (associated(forces%taux) .and. associated(forces%tauy) .and. & associated(fluxes%ustar_gustless)) then do j=js,je ; do i=is,ie @@ -1940,13 +1957,15 @@ subroutine set_derived_forcing_fields(forces, fluxes, G, Rho0) (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) fluxes%ustar_gustless(i,j) = sqrt(sqrt(taux2 + tauy2) / Rho0) +!### Change to: +! fluxes%ustar_gustless(i,j) = sqrt(sqrt(taux2 + tauy2) * Irho0) enddo ; enddo endif end subroutine set_derived_forcing_fields -!> This subroutine calculates determines the net mass source to th eocean from +!> This subroutine calculates determines the net mass source to the ocean from !! a (thermodynamic) forcing type and stores it in a mech_forcing type. subroutine set_net_mass_forcing(fluxes, forces, G) type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields From d0bc3bc2fcbfec4a6646bd3f21475e5c87d5f230 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 6 Aug 2018 14:25:49 -0600 Subject: [PATCH 0632/1072] Fix bug and make sure melt potential is always <= 0 --- config_src/mct_driver/ocn_cap_methods.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 6e3317f376..17894dc966 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -183,8 +183,8 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) else ! Melt_potential: change from J/m^2 to W/m^2 o2x(ind%o2x_Fioo_q, n) = -ocn_public%melt_potential(ig,jg) * grid%mask2dT(i,j) * I_time_int !* ncouple_per_day - ! reset melt_potential - ocn_public%melt_potential(ig,jg) = 0.0 + ! make sure Melt_potential is always <= 0 + if (o2x(ind%o2x_Fioo_q, n) > 0.0) o2x(ind%o2x_Fioo_q, n) = 0.0 endif ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain ! in order to update halos. i.e. does not use global indexing. From c02b134bd143f8ce595312ee50ae6fbd8ba92bb8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 6 Aug 2018 19:04:08 -0400 Subject: [PATCH 0633/1072] (+)Restored the interface to forcing_accumulate Restored the interface to forcing_accumulate to what it had been previously, and added a new subroutine, fluxes_accumulate, that uses the newer interface, with the new forcing_accumulate calling fluxes_accumulate. This new interface is now in use in update_ocean_model. In addition, set_net_mass_forcing now calls get_net_mass_forcing to eliminate duplicated code. All answers are bitwise identical, and slightly older public interfaces have been restored to avoid code conflicts with MOM6 drivers outside of coupled_driver. --- config_src/coupled_driver/ocean_model_MOM.F90 | 13 ++- src/core/MOM_forcing_type.F90 | 92 +++++++++++++------ 2 files changed, 69 insertions(+), 36 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index dde127b146..a2d87c6624 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -23,11 +23,9 @@ module ocean_model_mod 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, mech_forcing, allocate_forcing_type +use MOM_forcing_type, only : fluxes_accumulate, get_net_mass_forcing +use MOM_forcing_type, only : copy_back_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 @@ -535,7 +533,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif - call forcing_accumulate(OS%flux_tmp, OS%fluxes, dt_coupling, OS%grid, weight) + call fluxes_accumulate(OS%flux_tmp, OS%fluxes, dt_coupling, OS%grid, weight) ! Some of the fields that exist in both the forcing and mech_forcing types ! (now just ustar) are time-averages must be copied back to the forces type. call copy_back_forcing_fields(OS%fluxes, OS%forces, OS%grid) @@ -544,7 +542,8 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call MOM_generic_tracer_fluxes_accumulate(OS%flux_tmp, weight) !weight of the current flux in the running average #endif endif - call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid) + if (associated(OS%forces%net_mass_src)) & + call get_net_mass_forcing(OS%fluxes, OS%grid, OS%forces%net_mass_src) if (OS%use_waves) then call Update_Surface_Waves(OS%grid, OS%GV, OS%time, ocean_coupling_time_step, OS%waves) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 4235c2a82f..6aa0487439 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -26,11 +26,13 @@ module MOM_forcing_type public extractFluxes1d, extractFluxes2d, optics_type public MOM_forcing_chksum, MOM_mech_forcing_chksum -public calculateBuoyancyFlux1d, calculateBuoyancyFlux2d, forcing_accumulate +public calculateBuoyancyFlux1d, calculateBuoyancyFlux2d +public forcing_accumulate, fluxes_accumulate public forcing_SinglePointPrint, mech_forcing_diags, forcing_diagnostics public register_forcing_type_diags, allocate_forcing_type, deallocate_forcing_type public copy_common_forcing_fields, allocate_mech_forcing, deallocate_mech_forcing -public set_derived_forcing_fields, copy_back_forcing_fields, set_net_mass_forcing +public set_derived_forcing_fields, copy_back_forcing_fields +public set_net_mass_forcing, get_net_mass_forcing !> Structure that contains pointers to the boundary forcing used to drive the !! liquid ocean simulated by MOM. @@ -1741,8 +1743,29 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use end subroutine register_forcing_type_diags -!> Accumulate the forcing over time steps -subroutine forcing_accumulate(flux_tmp, fluxes, dt, G, wt2, forces) +!> Accumulate the forcing over time steps, taking input from a mechanical forcing type +!! and a temporary forcing-flux type. +subroutine forcing_accumulate(flux_tmp, forces, fluxes, dt, G, wt2) + type(forcing), intent(in) :: flux_tmp !< A temporary structure with current + !!thermodynamic forcing fields + type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces + type(forcing), intent(inout) :: fluxes !< A structure containing time-averaged + !! thermodynamic forcing fields + real, intent(in) :: dt !< The elapsed time since the last call to this subroutine, in s + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + real, intent(out) :: wt2 !< The relative weight of the new fluxes + + ! This subroutine copies mechancal forcing from flux_tmp to fluxes and + ! stores the time-weighted averages of the various buoyancy fluxes in fluxes, + ! and increments the amount of time over which the buoyancy forcing should be + ! applied, all via a call to fluxes accumulate. + + call fluxes_accumulate(flux_tmp, fluxes, dt, G, wt2, forces) + +end subroutine forcing_accumulate + +!> Accumulate the thermodynamic fluxes over time steps +subroutine fluxes_accumulate(flux_tmp, fluxes, dt, G, wt2, forces) type(forcing), intent(in) :: flux_tmp !< A temporary structure with current !! thermodynamic forcing fields type(forcing), intent(inout) :: fluxes !< A structure containing time-averaged @@ -1880,7 +1903,7 @@ subroutine forcing_accumulate(flux_tmp, fluxes, dt, G, wt2, forces) call coupler_type_increment_data(flux_tmp%tr_fluxes, fluxes%tr_fluxes, & scale_factor=wt2, scale_prev=wt1) -end subroutine forcing_accumulate +end subroutine fluxes_accumulate !> This subroutine copies the computational domains of common forcing fields !! from a mech_forcing type to a (thermodynamic) forcing type. @@ -1970,34 +1993,45 @@ end subroutine set_derived_forcing_fields subroutine set_net_mass_forcing(fluxes, forces, G) type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(ocean_grid_type), intent(in) :: G !< grid type + type(ocean_grid_type), intent(in) :: G !< The ocean grid type + + if (associated(forces%net_mass_src)) & + call get_net_mass_forcing(fluxes, G, forces%net_mass_src) + +end subroutine set_net_mass_forcing + +!> This subroutine calculates determines the net mass source to the ocean from +!! a (thermodynamic) forcing type and stores it in a provided array. +subroutine get_net_mass_forcing(fluxes, G, net_mass_src) + type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields + type(ocean_grid_type), intent(in) :: G !< The ocean grid type + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_mass_src !< The net mass flux of water into the ocean + !! in kg m-2 s-1. integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - if (associated(forces%net_mass_src)) then - forces%net_mass_src(:,:) = 0.0 - if (associated(fluxes%lprec)) then ; do j=js,je ; do i=is,ie - forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%lprec(i,j) - enddo ; enddo ; endif - if (associated(fluxes%fprec)) then ; do j=js,je ; do i=is,ie - forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%fprec(i,j) - enddo ; enddo ; endif - if (associated(fluxes%vprec)) then ; do j=js,je ; do i=is,ie - forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%vprec(i,j) - enddo ; enddo ; endif - if (associated(fluxes%lrunoff)) then ; do j=js,je ; do i=is,ie - forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%lrunoff(i,j) - enddo ; enddo ; endif - if (associated(fluxes%frunoff)) then ; do j=js,je ; do i=is,ie - forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%frunoff(i,j) - enddo ; enddo ; endif - if (associated(fluxes%evap)) then ; do j=js,je ; do i=is,ie - forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%evap(i,j) - enddo ; enddo ; endif - endif - -end subroutine set_net_mass_forcing + net_mass_src(:,:) = 0.0 + if (associated(fluxes%lprec)) then ; do j=js,je ; do i=is,ie + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%lprec(i,j) + enddo ; enddo ; endif + if (associated(fluxes%fprec)) then ; do j=js,je ; do i=is,ie + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%fprec(i,j) + enddo ; enddo ; endif + if (associated(fluxes%vprec)) then ; do j=js,je ; do i=is,ie + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%vprec(i,j) + enddo ; enddo ; endif + if (associated(fluxes%lrunoff)) then ; do j=js,je ; do i=is,ie + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%lrunoff(i,j) + enddo ; enddo ; endif + if (associated(fluxes%frunoff)) then ; do j=js,je ; do i=is,ie + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%frunoff(i,j) + enddo ; enddo ; endif + if (associated(fluxes%evap)) then ; do j=js,je ; do i=is,ie + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%evap(i,j) + enddo ; enddo ; endif + +end subroutine get_net_mass_forcing !> This subroutine copies the computational domains of common forcing fields !! from a mech_forcing type to a (thermodynamic) forcing type. From 13f9303ced1ace1a33397b3ce3af81ac6439cbeb Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 7 Aug 2018 11:23:37 -0400 Subject: [PATCH 0634/1072] +Added optional arguments to convert_IOB_to_forces Added two new optional arguments to convert_IOB_to_forces to allow it to do a running time average of ustar, matching what had previously been done only for ustar in the fluxes type. Also added the new element dt_force_accum to the mech_forcing type to enable this averaging. All answers are bitwise identical, although there are new optional arguments to a publicly visible routine. --- .../coupled_driver/MOM_surface_forcing.F90 | 40 +++++++++++++++++-- src/core/MOM_forcing_type.F90 | 9 ++--- 2 files changed, 40 insertions(+), 9 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 71e7f611aa..a4cd1162d7 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -573,7 +573,7 @@ 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. -subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) +subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS, dt_forcing, reset_avg) type(ice_ocean_boundary_type), & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive !! the ocean in a coupled model @@ -584,15 +584,22 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. + real, optional, intent(in) :: dt_forcing !< A time interval over which to apply the + !! current value of ustar as a weighted running + !! average, in s, or if 0 do not average ustar. + !! Missing is equivalent to 0. + logical, optional, intent(in) :: reset_avg !< If true, reset the time average. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - rigidity_at_h ! Ice rigidity at tracer points (m3 s-1) + rigidity_at_h, & ! Ice rigidity at tracer points (m3 s-1) + ustar_tmp ! A temporary array of ustars. 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) + real :: wt1, wt2 ! Relative weights of previous and current values of ustar, ND. 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 @@ -645,6 +652,23 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) if (associated(forces%rigidity_ice_u)) forces%rigidity_ice_u(:,:) = 0.0 if (associated(forces%rigidity_ice_v)) forces%rigidity_ice_v(:,:) = 0.0 + ! Set the weights for forcing fields that use running time averages. + if (present(reset_avg)) then ; if (reset_avg) forces%dt_force_accum = 0.0 ; endif + wt1 = 0.0 ; wt2 = 1.0 + if (present(dt_forcing)) then + if ((forces%dt_force_accum > 0.0) .and. (dt_forcing > 0.0)) then + wt1 = forces%dt_force_accum / (forces%dt_force_accum + dt_forcing) + wt2 = 1.0 - wt1 + endif + if (dt_forcing > 0.0) then + forces%dt_force_accum = max(forces%dt_force_accum, 0.0) + dt_forcing + else + forces%dt_force_accum = 0.0 ! Reset the averaging time interval. + endif + else + forces%dt_force_accum = 0.0 ! Reset the averaging time interval. + endif + ! applied surface pressure from atmosphere and cryosphere if (associated(IOB%p)) then if (CS%max_p_surf >= 0.0) then @@ -667,8 +691,16 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) forces%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. ! Set the wind stresses and ustar. - call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux=forces%taux, tauy=forces%tauy, & - ustar=forces%ustar, tau_halo=1) + if (wt1 <= 0.0) then + call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux=forces%taux, tauy=forces%tauy, & + ustar=forces%ustar, tau_halo=1) + else + call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux=forces%taux, tauy=forces%tauy, & + ustar=ustar_tmp, tau_halo=1) + do j=js,je ; do i=is,ie + forces%ustar(i,j) = wt1*forces%ustar(i,j) + wt2*ustar_tmp(i,j) + enddo ; enddo + endif ! Obtain optional ice-berg related fluxes from the IOB type: if (associated(IOB%area_berg)) then ; do j=js,je ; do i=is,ie diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 6aa0487439..1df0fe1473 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -42,8 +42,6 @@ module MOM_forcing_type !! MESO_surface_forcing.F90, which is a special case of solo_driver/MOM_surface_forcing.F90. type, public :: forcing - ! Pointers in this module should be initialized to NULL. - ! surface stress components and turbulent velocity scale real, pointer, dimension(:,:) :: & ustar => NULL(), & !< surface friction velocity scale (m/s) @@ -154,11 +152,10 @@ module MOM_forcing_type logical :: fluxes_used = .true. !< If true, all of the heat, salt, and mass !! fluxes have been applied to the ocean. - real :: dt_buoy_accum = -1.0 !< The amount of time over which the buoyancy fluxes + real :: dt_buoy_accum = -1.0 !< The amount of time over which the buoyancy fluxes !! should be applied, in s. If negative, this forcing !! type variable has not yet been inialized. - ! heat capacity real :: C_p !< heat capacity of seawater ( J/(K kg) ). !! C_p is is the same value as in thermovar_ptrs_type. @@ -169,7 +166,7 @@ module MOM_forcing_type !! This is not a convenient convention, but imposed on MOM6 by the coupler. ! For internal error tracking - integer :: num_msg = 0 !< Number of messages issues about excessive SW penetration + integer :: num_msg = 0 !< Number of messages issued about excessive SW penetration integer :: max_msg = 2 !< Maximum number of messages to issue about excessive SW penetration end type forcing @@ -213,6 +210,8 @@ module MOM_forcing_type real, pointer, dimension(:,:) :: & rigidity_ice_u => NULL(), & !< Depth-integrated lateral viscosity of ice shelves or sea ice at u-points (m3/s) rigidity_ice_v => NULL() !< Depth-integrated lateral viscosity of ice shelves or sea ice at v-points (m3/s) + real :: dt_force_accum = -1.0 !< The amount of time over which the mechanical forcing fluxes + !! have been averaged, in s. logical :: accumulate_p_surf = .false. !< If true, the surface pressure due to the atmosphere !! and various types of ice needs to be accumulated, and the !! surface pressure explicitly reset to zero at the driver level From 5f253d4ed91889250d04992386eafce5a6dd530c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 7 Aug 2018 11:23:55 -0400 Subject: [PATCH 0635/1072] Consolidate dynamic & thermodynamic forcing setup Consolidated the code in update_ocean_model that set up the dynamic and thermodynamic forcing structures. This takes advantage of the recently added optional arguments to convert_IOB_to_forces to do time averaging of ustar. All answers are bitwise identical. --- config_src/coupled_driver/ocean_model_MOM.F90 | 104 ++++++++---------- 1 file changed, 47 insertions(+), 57 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index a2d87c6624..d1a15bc496 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -241,11 +241,12 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) ! 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=48) :: stagger - integer :: secs, days + character(len=48) :: stagger ! A string indicating the staggering locations for the + ! surface velocities returned to the coupler. +! 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 +! type(time_type) :: dt_geometric, dt_savedays, dt_from_base call callTree_enter("ocean_model_init(), ocean_model_MOM.F90") if (associated(OS)) then @@ -430,7 +431,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! 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 :: weight ! Flux accumulation weight of the current fluxes. real :: dt_coupling ! The coupling time step in seconds. integer :: nts ! The number of baroclinic dynamics time steps ! within dt_coupling. @@ -444,13 +445,14 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! 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 + logical :: step_thermo ! If true, take a thermodynamic step. + integer :: secs, days ! Integer number of days and seconds in the timestep. integer :: is, ie, js, je call callTree_enter("update_ocean_model(), ocean_model_MOM.F90") call get_time(Ocean_coupling_time_step, secs, days) dt_coupling = 86400.0*real(days) + real(secs) +!### dt_coupling = time_type_to_real(Ocean_coupling_time_step) if (time_start_update /= OS%Time) then call MOM_error(WARNING, "update_ocean_model: internal clock does not "//& @@ -472,75 +474,59 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call coupler_type_spawn(Ocean_sfc%fields, OS%sfc_state%tr_fields, & (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) - ! Translate Ice_ocean_boundary into fluxes. + ! Translate Ice_ocean_boundary into fluxes and forces. call mpp_get_compute_domain(Ocean_sfc%Domain, index_bnds(1), index_bnds(2), & index_bnds(3), index_bnds(4)) - weight = 1.0 - - call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp) + if (do_dyn) then + call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time, OS%grid, & + OS%forcing_CSp, dt_forcing=dt_coupling, reset_avg=OS%fluxes%fluxes_used) + if (OS%use_ice_shelf) & + call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + if (OS%icebergs_alter_ocean) & + call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + endif - if (OS%fluxes%fluxes_used) then - if (do_thermo) & + if (do_thermo) then + if (OS%fluxes%fluxes_used) then call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp, OS%sfc_state, & - OS%restore_salinity, OS%restore_temp) + OS%grid, 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) & + ! Add ice shelf fluxes + if (OS%use_ice_shelf) & 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) & + if (OS%icebergs_alter_ocean) & call iceberg_fluxes(OS%grid, OS%fluxes, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) - endif + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) #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 + call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? + call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, 1.0) !here weight=1, so just saving the current fluxes #endif - ! Indicate that there are new unused fluxes. - OS%fluxes%fluxes_used = .false. - OS%fluxes%dt_buoy_accum = dt_coupling - else - ! The previous fluxes have not been used yet, so translate the input fluxes - ! into a temporary type and then accumulate them in about 20 lines. - OS%flux_tmp%C_p = OS%fluxes%C_p - if (do_thermo) & + ! Indicate that there are new unused fluxes. + OS%fluxes%fluxes_used = .false. + OS%fluxes%dt_buoy_accum = dt_coupling + else + ! The previous fluxes have not been used yet, so translate the input fluxes + ! into a temporary type and then accumulate them in about 20 lines. + OS%flux_tmp%C_p = OS%fluxes%C_p call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity,OS%restore_temp) + OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity, & + OS%restore_temp) - if (OS%use_ice_shelf) then - if (do_thermo) & + if (OS%use_ice_shelf) & 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) & + if (OS%icebergs_alter_ocean) & call iceberg_fluxes(OS%grid, OS%flux_tmp, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) - endif - - call fluxes_accumulate(OS%flux_tmp, OS%fluxes, dt_coupling, OS%grid, weight) - ! Some of the fields that exist in both the forcing and mech_forcing types - ! (now just ustar) are time-averages must be copied back to the forces type. - call copy_back_forcing_fields(OS%fluxes, OS%forces, OS%grid) + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + call fluxes_accumulate(OS%flux_tmp, OS%fluxes, dt_coupling, OS%grid, weight) #ifdef _USE_GENERIC_TRACER - call MOM_generic_tracer_fluxes_accumulate(OS%flux_tmp, weight) !weight of the current flux in the running average + call MOM_generic_tracer_fluxes_accumulate(OS%flux_tmp, weight) !weight of the current flux in the running average #endif + endif endif if (associated(OS%forces%net_mass_src)) & call get_net_mass_forcing(OS%fluxes, OS%grid, OS%forces%net_mass_src) @@ -613,6 +599,8 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (step_thermo) then ! Back up Time2 to the start of the thermodynamic segment. + !### Use ticks here for more precision. + !Time2 = Time2 - real_to_time_type(dtdia - dt_dyn) 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., & @@ -621,6 +609,8 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & endif t_elapsed_seg = t_elapsed_seg + dt_dyn + !### Use ticks here for more precision. + ! Time2 = Time1 + real_to_time_type(t_elapsed_seg) Time2 = Time1 + set_time(int(floor(t_elapsed_seg + 0.5))) enddo endif From c54a25aca7e36cde16ca8dff7e9c6c94dfd3def6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 7 Aug 2018 12:46:40 -0400 Subject: [PATCH 0636/1072] (*)Allow for fractional second coupling timesteps By replacing several set_time calls that quantize times at whole numbers of seconds with calls to real_to_time_type, the MOM6 coupled timesteps can now be integer numbers of ticks (fractional seconds). This could change answers if MOM6 were called with non-integer second timesteps, but in all existing test cases this is not the case, so the answers are bitwise identical. --- config_src/coupled_driver/ocean_model_MOM.F90 | 25 ++++++------------- config_src/solo_driver/MOM_driver.F90 | 11 ++++---- 2 files changed, 14 insertions(+), 22 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index d1a15bc496..e3fd612c70 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -37,10 +37,10 @@ module ocean_model_mod 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_time_manager, only : time_type, operator(>), operator(+), operator(-) +use MOM_time_manager, only : operator(*), operator(/), operator(/=) +use MOM_time_manager, only : operator(<=), operator(>=), operator(<) +use MOM_time_manager, only : 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_variables, only : surface @@ -243,10 +243,8 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) character(len=40) :: mdl = "ocean_model_init" ! This module's name. character(len=48) :: stagger ! A string indicating the staggering locations for the ! surface velocities returned to the coupler. -! 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 + logical :: use_temperature ! If true, temperature and salinity are state variables. call callTree_enter("ocean_model_init(), ocean_model_MOM.F90") if (associated(OS)) then @@ -446,13 +444,10 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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 number of days and seconds in the timestep. integer :: is, ie, js, je call callTree_enter("update_ocean_model(), ocean_model_MOM.F90") - call get_time(Ocean_coupling_time_step, secs, days) - dt_coupling = 86400.0*real(days) + real(secs) -!### dt_coupling = time_type_to_real(Ocean_coupling_time_step) + dt_coupling = time_type_to_real(Ocean_coupling_time_step) if (time_start_update /= OS%Time) then call MOM_error(WARNING, "update_ocean_model: internal clock does not "//& @@ -599,9 +594,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (step_thermo) then ! Back up Time2 to the start of the thermodynamic segment. - !### Use ticks here for more precision. - !Time2 = Time2 - real_to_time_type(dtdia - dt_dyn) - Time2 = Time2 - set_time(int(floor((dtdia - dt_dyn) + 0.5))) + Time2 = Time2 - real_to_time_type(dtdia - dt_dyn) 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) @@ -609,9 +602,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & endif t_elapsed_seg = t_elapsed_seg + dt_dyn - !### Use ticks here for more precision. - ! Time2 = Time1 + real_to_time_type(t_elapsed_seg) - Time2 = Time1 + set_time(int(floor(t_elapsed_seg + 0.5))) + Time2 = Time1 + real_to_time_type(t_elapsed_seg) enddo endif diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 61c3f4a509..7dd60403c2 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -48,7 +48,8 @@ program MOM_main use MOM_string_functions,only : uppercase use MOM_surface_forcing, only : set_forcing, forcing_save_restart use MOM_surface_forcing, only : surface_forcing_init, surface_forcing_CS - use MOM_time_manager, only : time_type, set_date, set_time, get_date, time_type_to_real + use MOM_time_manager, only : time_type, set_date, set_time, get_date + use MOM_time_manager, only : real_to_time_type, time_type_to_real use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) use MOM_time_manager, only : operator(>), operator(<), operator(>=) use MOM_time_manager, only : increment_date, set_calendar_type, month_name @@ -356,7 +357,7 @@ program MOM_main endif ntstep = MAX(1,ceiling(dt_forcing/dt - 0.001)) - Time_step_ocean = set_time(int(floor(dt_forcing+0.5))) + Time_step_ocean = real_to_time_type(dt_forcing) elapsed_time_master = (abs(dt_forcing - time_type_to_real(Time_step_ocean)) > 1.0e-12*dt_forcing) if (elapsed_time_master) & call MOM_mesg("Using real elapsed time for the master clock.", 2) @@ -532,7 +533,7 @@ program MOM_main dtdia = dt_dyn*(n - n_last_thermo) ! Back up Time2 to the start of the thermodynamic segment. if (n > n_last_thermo+1) & - Time2 = Time2 - set_time(int(floor((dtdia - dt_dyn) + 0.5))) + Time2 = Time2 - real_to_time_type(dtdia - dt_dyn) call step_MOM(forces, fluxes, sfc_state, Time2, dtdia, MOM_CSp, & do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_forcing) @@ -541,7 +542,7 @@ program MOM_main endif t_elapsed_seg = t_elapsed_seg + dt_dyn - Time2 = Time1 + set_time(int(floor(t_elapsed_seg + 0.5))) + Time2 = Time1 + real_to_time_type(t_elapsed_seg) enddo endif @@ -559,7 +560,7 @@ program MOM_main elapsed_time = elapsed_time - floor(elapsed_time) endif if (elapsed_time_master) then - Master_Time = segment_start_time + set_time(int(floor(elapsed_time+0.5))) + Master_Time = segment_start_time + real_to_time_type(elapsed_time) else Master_Time = Master_Time + Time_step_ocean endif From d9e9457b19cd27de5028b9ff34cb777cac564d27 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 7 Aug 2018 13:32:41 -0400 Subject: [PATCH 0637/1072] Use real_to_time_type in 63+year segment clock cor Use real_to_time_type in long-time (>63 year segment) ocean-only model clock correction for improved accuracy with fractional timesteps and very long run segments. All answers are bitwise identical in existing test cases. --- config_src/solo_driver/MOM_driver.F90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 7dd60403c2..f30a740254 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -138,7 +138,7 @@ program MOM_main real :: dt_dyn, dtdia, t_elapsed_seg integer :: n, n_max, nts, n_last_thermo logical :: diabatic_first, single_step_call - type(time_type) :: Time2 + type(time_type) :: Time2, time_chg integer :: Restart_control ! An integer that is bit-tested to determine whether ! incremental restart files are saved and whether they @@ -388,7 +388,7 @@ program MOM_main endif call get_param(param_file, mod_name, "SINGLE_STEPPING_CALL", single_step_call, & - "If true, advance the state of MOM with a single step \n"//& + "If true, advance the state of MOMtime_chg with a single step \n"//& "including both dynamics and thermodynamics. If false \n"//& "the two phases are advanced with separate calls.", default=.true.) call get_param(param_file, mod_name, "DT_THERM", dt_therm, & @@ -550,14 +550,14 @@ program MOM_main ! This is here to enable fractional-second time steps. elapsed_time = elapsed_time + dt_forcing if (elapsed_time > 2e9) then - ! This is here to ensure that the conversion from a real to an integer - ! can be accurately represented in long runs (longer than ~63 years). - ! It will also ensure that elapsed time does not lose resolution of order - ! the timetype's resolution, provided that the timestep and tick are - ! larger than 10-5 seconds. If a clock with a finer resolution is used, - ! a smaller value would be required. - segment_start_time = segment_start_time + set_time(int(floor(elapsed_time))) - elapsed_time = elapsed_time - floor(elapsed_time) + ! This is here to ensure that the conversion from a real to an integer can be accurately + ! represented in long runs (longer than ~63 years). It will also ensure that elapsed time + ! does not lose resolution of order the timetype's resolution, provided that the timestep and + ! tick are larger than 10-5 seconds. If a clock with a finer resolution is used, a smaller + ! value would be required. + time_chg = real_to_time_type(elapsed_time) + segment_start_time = segment_start_time + time_chg + elapsed_time = elapsed_time - time_type_to_real(time_chg) endif if (elapsed_time_master) then Master_Time = segment_start_time + real_to_time_type(elapsed_time) From 974662e499e89e88955360ab474527a4a11b1844 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 7 Aug 2018 19:19:48 -0400 Subject: [PATCH 0638/1072] Corrected description of SINGLE_STEPPING_CALL Corrected the documentation in the get_param call for SINGLE_STEPPING_CALL, that was inadvertently messed up two commits ago. All answers are bitwise identical, and inadvertent changes to the MOM_parameter_doc files have been reversed. --- config_src/solo_driver/MOM_driver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index f30a740254..19901f9a0c 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -388,7 +388,7 @@ program MOM_main endif call get_param(param_file, mod_name, "SINGLE_STEPPING_CALL", single_step_call, & - "If true, advance the state of MOMtime_chg with a single step \n"//& + "If true, advance the state of MOM with a single step \n"//& "including both dynamics and thermodynamics. If false \n"//& "the two phases are advanced with separate calls.", default=.true.) call get_param(param_file, mod_name, "DT_THERM", dt_therm, & From a30575d192ff9f75dd825e3966ef0e414e6faac8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 8 Aug 2018 16:13:14 -0400 Subject: [PATCH 0639/1072] +Added APPROX_NET_MASS_SRC & moved RESTORE_SALINITY Added code to store an estimate of the net mass source in the mech_forcing type, along with the new run time parameter APPROX_NET_MASS_SRC that controls this behavior. This estimate should be correct for coupled models, but may be off with data overrides or restoring. Because forces%net_mass_src is not yet used in the solution, that answers are invariant to the use of this option. Also moved the get_param calls for RESTORE_SALINITY and RESTORE_TEMPERATURE into surface_forcing_init, and eliminated the corresponding arguments from surface_forcing_init and convert_IOB_to_fluxes, because these parameters were not used in the top-level MOM6 code. Also added a new flag, net_mass_src_set, to the mech_forcing type and dOxygenized the comments in and surrounding the surface_forcing_CS. By default, all answers are bitwise identical, but there is a new run-time parameter, changes to publicly visible interfaces, and the MOM_parameter_doc files change. --- .../coupled_driver/MOM_surface_forcing.F90 | 287 ++++++++++-------- config_src/coupled_driver/ocean_model_MOM.F90 | 22 +- src/core/MOM_forcing_type.F90 | 1 + 3 files changed, 161 insertions(+), 149 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index a4cd1162d7..532ed8081b 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -50,107 +50,106 @@ module MOM_surface_forcing public ice_ocn_bnd_type_chksum public forcing_save_restart - -! surface_forcing_CS is a structure containing pointers to the forcing fields -! which may be used to drive MOM. All fluxes are positive downward. +!> surface_forcing_CS is a structure containing pointers to the forcing fields +!! which may be used to drive MOM. All fluxes are positive downward. 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. - logical :: use_temperature ! If true, temp and saln used as state variables + 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. + logical :: use_temperature !< If true, temp and saln used as state variables real :: wind_stress_multiplier !< A multiplier applied to incoming wind stress (nondim). - 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 - ! structure does not limit the water that can be - ! frozen out of the ocean and the ice-ocean heat - ! fluxes are treated explicitly. - logical :: use_limited_P_SSH ! 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. The default is true. - - 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 :: 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 !< The maximum surface pressure that can be + !! exerted by the atmosphere and floating sea-ice, + !! in Pa. 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. + logical :: use_limited_P_SSH !< 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. The default is true. + logical :: approx_net_mass_src !< If true, use the net mass sources from the ice-ocean boundary + !! type without any further adjustments to drive the ocean dynamics. + !! The actual net mass source may differ due to corrections. + + 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. 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. - gust => NULL(), & ! spatially varying unresolved background - ! 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) - real :: cd_tides ! drag coefficient that applies to the tides (nondimensional) - real :: utide ! constant tidal velocity to use if read_tideamp - ! is false, in 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 :: 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. - logical :: allow_flux_adjustments ! If true, use data_override to obtain flux adjustments - - 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 :: 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) - 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 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 - 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 - integer :: id_srestore = -1 ! id number for time_interp_external. - integer :: id_trestore = -1 ! id number for time_interp_external. - - ! Diagnostics handles - type(forcing_diags), public :: handles + gust => NULL() !< A spatially varying unresolved background gustiness that + !! contributes to ustar (Pa). gust is used when read_gust_2d is true. + real, pointer, dimension(:,:) :: & + 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, in 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 :: 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. + logical :: allow_flux_adjustments !< If true, use data_override to obtain flux adjustments + + logical :: restore_salt !< If true, the coupled MOM driver adds a term to restore surface + !! salinity to a specified value. + logical :: restore_temp !< If true, the coupled MOM driver adds a term to restore sea + !! surface temperature to a specified value. + 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 (with restoring) to zero + 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) + 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 surface salinity restoring by basin + + type(diag_ctrl), pointer :: diag => NULL() !< 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 + 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 + integer :: id_srestore = -1 !< An id number for time_interp_external. + integer :: id_trestore = -1 !< An id number for time_interp_external. + + type(forcing_diags), public :: handles !< Diagnostics handles !### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() - type(MOM_restart_CS), pointer :: restart_CSp => NULL() - type(user_revise_forcing_CS), pointer :: urf_CS => NULL() + type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure + type(user_revise_forcing_CS), pointer :: urf_CS => NULL() !< A control structure for user forcing revisions 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. +!> ice_ocean_boundary_type is a structure corresponding to forcing, but with the elements, units, +!! and conventions that exactly conform to the use for MOM6-based coupled models. type, public :: ice_ocean_boundary_type real, pointer, dimension(:,:) :: u_flux =>NULL() !< i-direction wind stress (Pa) real, pointer, dimension(:,:) :: v_flux =>NULL() !< j-direction wind stress (Pa) @@ -179,25 +178,23 @@ module MOM_surface_forcing !! 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. + 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 +integer :: id_clock_forcing !< A CPU time clock contains !> 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, CS, & - sfc_state, restore_salt, restore_temp) +subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, sfc_state) type(ice_ocean_boundary_type), & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive !! the ocean in a coupled model @@ -212,9 +209,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & !! previous call to surface_forcing_init. type(surface), intent(in) :: sfc_state !< A structure containing fields that describe the !! surface state of the ocean. - 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. - real, dimension(SZI_(G),SZJ_(G)) :: & data_restore, & ! The surface value toward which to restore (g/kg or degC) @@ -234,10 +228,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & 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 @@ -264,11 +254,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & fluxes%netFWGlobalAdj = 0.0 fluxes%netFWGlobalScl = 0.0 - restore_salinity = .false. - if (present(restore_salt)) restore_salinity = restore_salt - restore_sst = .false. - if (present(restore_temp)) restore_sst = restore_temp - ! allocation and initialization if this is the first time that this ! flux type has been used. if (fluxes%dt_buoy_accum < 0) then @@ -305,7 +290,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) enddo ; enddo - if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) + if (CS%restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) fluxes%dt_buoy_accum = 0.0 endif ! endif for allocation and initialization @@ -343,7 +328,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & enddo ; enddo ! Salinity restoring logic - if (restore_salinity) then + if (CS%restore_salt) then call time_interp_external(CS%id_srestore,Time,data_restore) ! open_ocn_mask indicates where to restore salinity (1 means restore, 0 does not) open_ocn_mask(:,:) = 1.0 @@ -396,7 +381,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & endif ! SST restoring logic - if (restore_sst) then + if (CS%restore_temp) then call time_interp_external(CS%id_trestore,Time,data_restore) do j=js,je ; do i=is,ie delta_sst = data_restore(i,j)- sfc_state%SST(i,j) @@ -593,7 +578,8 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS, dt_forc ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & rigidity_at_h, & ! Ice rigidity at tracer points (m3 s-1) - ustar_tmp ! A temporary array of ustars. + net_mass_src, & ! A temporary of net mass sources, in kg m-2 s-1. + ustar_tmp ! A temporary array of ustar values, in m s-1. 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) ) @@ -702,6 +688,36 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS, dt_forc enddo ; enddo endif + ! Find the net mass source in the input forcing without other adjustments. + if (CS%approx_net_mass_src .and. associated(forces%net_mass_src)) then + net_mass_src(:,:) = 0.0 + i0 = is - isc_bnd ; j0 = js - jsc_bnd + do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then + if (associated(IOB%lprec)) & + net_mass_src(i,j) = net_mass_src(i,j) + IOB%lprec(i-i0,j-j0) + if (associated(IOB%fprec)) & + net_mass_src(i,j) = net_mass_src(i,j) + IOB%fprec(i-i0,j-j0) + if (associated(IOB%runoff)) & + net_mass_src(i,j) = net_mass_src(i,j) + IOB%runoff(i-i0,j-j0) + if (associated(IOB%calving)) & + net_mass_src(i,j) = net_mass_src(i,j) + IOB%calving(i-i0,j-j0) + if (associated(IOB%q_flux)) & + net_mass_src(i,j) = net_mass_src(i,j) - IOB%q_flux(i-i0,j-j0) + endif ; enddo ; enddo + if (wt1 <= 0.0) then + do j=js,je ; do i=is,ie + forces%net_mass_src(i,j) = wt2*net_mass_src(i,j) + enddo ; enddo + else + do j=js,je ; do i=is,ie + forces%net_mass_src(i,j) = wt1*forces%net_mass_src(i,j) + wt2*net_mass_src(i,j) + enddo ; enddo + endif + forces%net_mass_src_set = .true. + else + forces%net_mass_src_set = .false. + endif + ! Obtain optional ice-berg related fluxes from the IOB type: if (associated(IOB%area_berg)) then ; do j=js,je ; do i=is,ie forces%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) @@ -1084,7 +1100,7 @@ subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & end subroutine forcing_save_restart !> Initialize the surface forcing, including setting parameters and allocating permanent memory. -subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, restore_temp) +subroutine surface_forcing_init(Time, G, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters @@ -1092,10 +1108,6 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res !! 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, in m s-1. @@ -1154,11 +1166,19 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res "the ice-ocean heat fluxes are treated explicitly. No \n"//& "limit is applied if a negative value is used.", units="Pa", & default=-1.0) + call get_param(param_file, mdl, "RESTORE_SALINITY", CS%restore_salt, & + "If true, the coupled driver will add a globally-balanced \n"//& + "fresh-water flux that drives sea-surface salinity \n"//& + "toward specified values.", default=.false.) + call get_param(param_file, mdl, "RESTORE_TEMPERATURE", CS%restore_temp, & + "If true, the coupled driver will add a \n"//& + "heat flux that drives sea-surface temperauture \n"//& + "toward specified values.", default=.false.) call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_TO_ZERO", & CS%adjust_net_srestore_to_zero, & "If true, adjusts the salinity restoring seen to zero\n"//& "whether restoring is via a salt flux or virtual precip.",& - default=restore_salt) + default=CS%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"//& @@ -1188,6 +1208,11 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res "correction for the atmospheric (and sea-ice) pressure \n"//& "limited by max_p_surf instead of the full atmospheric \n"//& "pressure.", default=.true.) + call get_param(param_file, mdl, "APPROX_NET_MASS_SRC", CS%approx_net_mass_src, & + "If true, use the net mass sources from the ice-ocean \n"//& + "boundary type without any further adjustments to drive \n"//& + "the ocean dynamics. The actual net mass source may differ \n"//& + "due to internal corrections.", default=.false.) call get_param(param_file, mdl, "WIND_STAGGER", stagger, & "A case-insensitive character string to indicate the \n"//& @@ -1203,7 +1228,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res "coupler. This is used for testing and should be =1.0 for any\n"//& "production runs.", default=1.0) - if (restore_salt) then + if (CS%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"//& @@ -1251,7 +1276,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res "a mask for SSS restoring.", default=.false.) endif - if (restore_temp) then + if (CS%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"//& @@ -1370,7 +1395,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) endif - if (present(restore_salt)) then ; if (restore_salt) then + if (CS%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 @@ -1378,9 +1403,9 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res flnam = trim(CS%inputdir) // 'salt_restore_mask.nc' call MOM_read_data(flnam,'mask', CS%srestore_mask, G%domain, timelevel=1) endif - endif ; endif + endif - if (present(restore_temp)) then ; if (restore_temp) then + if (CS%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 @@ -1388,7 +1413,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res flnam = trim(CS%inputdir) // 'temp_restore_mask.nc' call MOM_read_data(flnam, 'mask', CS%trestore_mask, G%domain, timelevel=1) endif - endif ; endif + endif ! Set up any restart fields associated with the forcing. call restart_init(param_file, CS%restart_CSp, "MOM_forcing.res") diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index e3fd612c70..44d94a77f6 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -149,10 +149,6 @@ module ocean_model_mod 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 - !! restore sst to a specified value. real :: press_to_z !< A conversion factor between pressure and ocean !! depth in m, usually 1/(rho_0*g), in m Pa-1. real :: C_p !< The heat capacity of seawater, in J K-1 kg-1. @@ -311,14 +307,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) 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 \n"//& - "fresh-water flux that drives sea-surface salinity \n"//& - "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"//& - "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"//& @@ -343,7 +331,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) do_integrals=.true., gas_fields_ocn=gas_fields_ocn) call surface_forcing_init(Time_in, OS%grid, param_file, OS%diag, & - OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) + OS%forcing_CSp) if (OS%use_ice_shelf) then call initialize_ice_shelf(param_file, OS%grid, OS%Time, OS%ice_shelf_CSp, & @@ -486,8 +474,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (do_thermo) then if (OS%fluxes%fluxes_used) then call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity, & - OS%restore_temp) + OS%grid, OS%forcing_CSp, OS%sfc_state) ! Add ice shelf fluxes if (OS%use_ice_shelf) & @@ -508,8 +495,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! into a temporary type and then accumulate them in about 20 lines. OS%flux_tmp%C_p = OS%fluxes%C_p call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity, & - OS%restore_temp) + OS%grid, OS%forcing_CSp, OS%sfc_state) if (OS%use_ice_shelf) & call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) @@ -523,7 +509,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & #endif endif endif - if (associated(OS%forces%net_mass_src)) & + if (associated(OS%forces%net_mass_src) .and. .not.OS%forces%net_mass_src_set) & call get_net_mass_forcing(OS%fluxes, OS%grid, OS%forces%net_mass_src) if (OS%use_waves) then diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 1df0fe1473..ba170c63f4 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -212,6 +212,7 @@ module MOM_forcing_type rigidity_ice_v => NULL() !< Depth-integrated lateral viscosity of ice shelves or sea ice at v-points (m3/s) real :: dt_force_accum = -1.0 !< The amount of time over which the mechanical forcing fluxes !! have been averaged, in s. + logical :: net_mass_src_set = .false. !< If true, an estimate of net_mass_src has been provided. logical :: accumulate_p_surf = .false. !< If true, the surface pressure due to the atmosphere !! and various types of ice needs to be accumulated, and the !! surface pressure explicitly reset to zero at the driver level From 6c4681130b9bec8abffe9372de09649627e15ed9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 8 Aug 2018 18:51:27 -0400 Subject: [PATCH 0640/1072] +Removed forcing type arg from mech_forcing_diags Moved 4 diagnostics from mech_forcing_diags to forcing_diagnostics and removed the now unused (thermodynamic) forcing type argument fluxes from mech_forcing_diags, so that the location of the diagnostics better reflects their use in stepping MOM6. All calls to mech_forcing_diags in the drivers were changed accordingly. Also, a new element, nstep_thermo, was added to the ocean_state_type to allow dynamic and thermodynamic calls to update_ocean_model to be counted separately, and some additional calls now only occur if the dynamics or thermodynamics are being stepped. All answers are bitwise identical, but one publicly visible interface has changed. --- config_src/coupled_driver/ocean_model_MOM.F90 | 40 +++++++++++------- config_src/mct_driver/ocn_comp_mct.F90 | 3 +- config_src/solo_driver/MOM_driver.F90 | 3 +- src/core/MOM_forcing_type.F90 | 42 ++++++++++++------- 4 files changed, 52 insertions(+), 36 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 44d94a77f6..37df04d8e7 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -20,7 +20,7 @@ module ocean_model_mod use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE use MOM_domains, only : TO_ALL, Omit_Corners -use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type use MOM_forcing_type, only : forcing, mech_forcing, allocate_forcing_type @@ -143,7 +143,8 @@ module ocean_model_mod !! 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. + integer :: nstep = 0 !< The number of calls to update_ocean that update the dynamics. + integer :: nstep_thermo = 0 !< The number of calls to update_ocean that update the thermodynamics. logical :: use_ice_shelf !< If true, the ice shelf model is enabled. logical :: use_waves !< If true use wave coupling. @@ -375,8 +376,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) call close_param_file(param_file) call diag_mediator_close_registration(OS%diag) - if (is_root_pe()) & - write(*,'(/12x,a/)') '======== COMPLETED MOM INITIALIZATION ========' + call MOM_mesg('==== Completed MOM6 Coupled Initialization ====', 2) call callTree_leave("ocean_model_init(") end subroutine ocean_model_init @@ -485,7 +485,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & #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, 1.0) !here weight=1, so just saving the current fluxes + call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, 1.0) ! Here weight=1, so just store the current fluxes #endif ! Indicate that there are new unused fluxes. OS%fluxes%fluxes_used = .false. @@ -505,25 +505,31 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call fluxes_accumulate(OS%flux_tmp, OS%fluxes, dt_coupling, OS%grid, weight) #ifdef _USE_GENERIC_TRACER - call MOM_generic_tracer_fluxes_accumulate(OS%flux_tmp, weight) !weight of the current flux in the running average + ! Incorporate the current tracer fluxes into the running averages + call MOM_generic_tracer_fluxes_accumulate(OS%flux_tmp, weight) #endif endif endif - if (associated(OS%forces%net_mass_src) .and. .not.OS%forces%net_mass_src_set) & + + ! The net mass forcing is not currently used in the MOM6 dynamics solvers, so this is may be unnecessary. + if (do_dyn .and. associated(OS%forces%net_mass_src) .and. .not.OS%forces%net_mass_src_set) & call get_net_mass_forcing(OS%fluxes, OS%grid, OS%forces%net_mass_src) - if (OS%use_waves) then + if (OS%use_waves .and. do_thermo) then + ! For now, the waves are only updated on the thermodynamics steps, because that is where + ! the wave intensities are actually used to drive mixing. At some point, the wave updates + ! might also need to become a part of the ocean dynamics, according to B. Reichl. call Update_Surface_Waves(OS%grid, OS%GV, OS%time, ocean_coupling_time_step, OS%waves) endif - if (OS%nstep==0) then + if ((OS%nstep==0) .and. (OS%nstep_thermo==0)) then call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%restart_CSp) endif call disable_averaging(OS%diag) Master_time = OS%Time ; Time1 = OS%Time - if (OS%offline_tracer_mode) then + if (OS%offline_tracer_mode .and. do_thermo) then 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. @@ -593,14 +599,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & endif OS%Time = Master_time + Ocean_coupling_time_step - OS%nstep = OS%nstep + 1 + if (do_dyn) OS%nstep = OS%nstep + 1 + if (do_thermo) OS%nstep_thermo = OS%nstep_thermo + 1 - call enable_averaging(dt_coupling, OS%Time, OS%diag) - call mech_forcing_diags(OS%forces, OS%fluxes, dt_coupling, OS%grid, & - OS%diag, OS%forcing_CSp%handles) - call disable_averaging(OS%diag) + if (do_dyn) then + 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) + endif - if (OS%fluxes%fluxes_used) then + if (OS%fluxes%fluxes_used .and. do_thermo) then call enable_averaging(OS%fluxes%dt_buoy_accum, OS%Time, OS%diag) call forcing_diagnostics(OS%fluxes, OS%sfc_state, OS%fluxes%dt_buoy_accum, & OS%grid, OS%diag, OS%forcing_CSp%handles) diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index d294c29656..d2de157a49 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -1790,8 +1790,7 @@ subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, & OS%nstep = OS%nstep + 1 call enable_averaging(time_step, OS%Time, OS%diag) - call mech_forcing_diags(OS%forces, OS%fluxes, time_step, OS%grid, & - OS%diag, OS%forcing_CSp%handles) + call mech_forcing_diags(OS%forces, time_step, OS%grid, OS%diag, OS%forcing_CSp%handles) call disable_averaging(OS%diag) if (OS%fluxes%fluxes_used) then diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 19901f9a0c..da0f77d935 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -571,8 +571,7 @@ program MOM_main endif ; endif call enable_averaging(dt_forcing, Time, diag) - call mech_forcing_diags(forces, fluxes, dt_forcing, grid, diag, & - surface_forcing_CSp%handles) + call mech_forcing_diags(forces, dt_forcing, grid, diag, surface_forcing_CSp%handles) call disable_averaging(diag) if (.not. offline_tracer_mode) then diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index ba170c63f4..857979f61d 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -298,7 +298,7 @@ module MOM_forcing_type integer :: id_netFWGlobalAdj = -1 integer :: id_netFWGlobalScl = -1 - ! momentum flux amd forcing diagnostic handles + ! momentum flux and forcing diagnostic handles integer :: id_taux = -1 integer :: id_tauy = -1 integer :: id_ustar = -1 @@ -1038,6 +1038,11 @@ subroutine MOM_mech_forcing_chksum(mesg, forces, G, haloshift) haloshift=hshift, symmetric=.true.) if (associated(forces%p_surf)) & call hchksum(forces%p_surf, mesg//" forces%p_surf",G%HI,haloshift=hshift) + if (associated(forces%ustar)) & + call hchksum(forces%ustar, mesg//" forces%ustar",G%HI,haloshift=hshift) + if (associated(forces%rigidity_ice_u) .and. associated(forces%rigidity_ice_v)) & + call uvchksum(mesg//" forces%rigidity_ice_[uv]", forces%rigidity_ice_u, & + forces%rigidity_ice_v, G%HI, haloshift=hshift, symmetric=.true.) end subroutine MOM_mech_forcing_chksum @@ -2054,9 +2059,8 @@ end subroutine copy_back_forcing_fields !> Offer mechanical forcing fields for diagnostics for those !! fields registered as part of register_forcing_type_diags. -subroutine mech_forcing_diags(forces, fluxes, dt, G, diag, handles) +subroutine mech_forcing_diags(forces, dt, G, diag, handles) type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields real, intent(in) :: dt !< time step type(ocean_grid_type), intent(in) :: G !< grid type type(diag_ctrl), intent(in) :: diag !< diagnostic type @@ -2071,20 +2075,15 @@ subroutine mech_forcing_diags(forces, fluxes, dt, G, diag, handles) if ((handles%id_taux > 0) .and. associated(forces%taux)) & call post_data(handles%id_taux, forces%taux, diag) + if ((handles%id_tauy > 0) .and. associated(forces%tauy)) & call post_data(handles%id_tauy, forces%tauy, diag) - if ((handles%id_ustar > 0) .and. associated(fluxes%ustar)) & - call post_data(handles%id_ustar, fluxes%ustar, diag) - if (handles%id_ustar_berg > 0) & - call post_data(handles%id_ustar_berg, fluxes%ustar_berg, diag) - if (handles%id_area_berg > 0) & - call post_data(handles%id_area_berg, fluxes%area_berg, diag) - if (handles%id_mass_berg > 0) & - call post_data(handles%id_mass_berg, fluxes%mass_berg, diag) - if (handles%id_frac_ice_cover > 0) & - call post_data(handles%id_frac_ice_cover, fluxes%frac_shelf_h, diag) - if (handles%id_ustar_ice_cover > 0) & - call post_data(handles%id_ustar_ice_cover, fluxes%ustar_shelf, diag) + + if ((handles%id_mass_berg > 0) .and. associated(forces%mass_berg)) & + call post_data(handles%id_mass_berg, forces%mass_berg, diag) + + if ((handles%id_area_berg > 0) .and. associated(forces%area_berg)) & + call post_data(handles%id_area_berg, forces%area_berg, diag) endif @@ -2575,8 +2574,19 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if ((handles%id_buoy > 0) .and. associated(fluxes%buoy)) & call post_data(handles%id_buoy, fluxes%buoy, diag) + if ((handles%id_ustar > 0) .and. associated(fluxes%ustar)) & + call post_data(handles%id_ustar, fluxes%ustar, diag) - endif + if ((handles%id_ustar_berg > 0) .and. associated(fluxes%ustar_berg)) & + call post_data(handles%id_ustar_berg, fluxes%ustar_berg, diag) + + if ((handles%id_frac_ice_cover > 0) .and. associated(fluxes%frac_shelf_h)) & + call post_data(handles%id_frac_ice_cover, fluxes%frac_shelf_h, diag) + + if ((handles%id_ustar_ice_cover > 0) .and. associated(fluxes%ustar_shelf)) & + call post_data(handles%id_ustar_ice_cover, fluxes%ustar_shelf, diag) + + endif ! query_averaging_enabled call cpu_clock_end(handles%id_clock_forcing) end subroutine forcing_diagnostics From 0cb2d87ab0a44c030b839ac72f75733aebf29454 Mon Sep 17 00:00:00 2001 From: "Jessica.Liptak" Date: Thu, 9 Aug 2018 16:09:44 -0400 Subject: [PATCH 0641/1072] removed underscore from allocated statement in MOM_generic_tracer_column_physics routine --- src/tracer/MOM_generic_tracer.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index d06ffe0e2c..48b8e4512c 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -498,7 +498,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, ! g_tracer=>CS%g_tracer_list do - if (_allocated(g_tracer%trunoff)) then + if (allocated(g_tracer%trunoff)) then call g_tracer_get_alias(g_tracer,g_tracer_name) call g_tracer_get_pointer(g_tracer,g_tracer_name,'stf', stf_array) call g_tracer_get_pointer(g_tracer,g_tracer_name,'trunoff',trunoff_array) From 0bd868837b866211e3eaf899079fe5aceb858849 Mon Sep 17 00:00:00 2001 From: Raymond Menzel Date: Thu, 9 Aug 2018 17:18:33 -0400 Subject: [PATCH 0642/1072] Allocate surface tracers on the compute domain instead of the data domain. --- src/core/MOM_variables.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 4165fb0e11..4a2dbbea54 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -338,7 +338,7 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & if (present(gas_fields_ocn)) & call coupler_type_spawn(gas_fields_ocn, sfc_state%tr_fields, & - (/isd,is,ie,ied/), (/jsd,js,je,jed/), as_needed=.true.) + (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) sfc_state%arrays_allocated = .true. From c4529f3de50ced17375d1595b68f608742cb80c0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 10 Aug 2018 19:24:16 -0400 Subject: [PATCH 0643/1072] +Added optional arguments to updaet_ocean_model Added optional start_cycle, end_cycle, and cycle_length arguments to update_ocean_model, for use with dynamics- or thermodynamics-only steps. Also added a separate clock to the ocean_state_type for the ocean dynamics, to keep track of time when the dynamics and thermodynamics are updated separately. Also cleaned up comments describing local variables and eliminated a redundant variable. All answers are bitwise identical, even when there are separate calls to step the ocean dynamics and thermodynamics. --- config_src/coupled_driver/ocean_model_MOM.F90 | 131 ++++++++++-------- 1 file changed, 74 insertions(+), 57 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 37df04d8e7..742688506f 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -136,6 +136,8 @@ module ocean_model_mod ! 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. + type(time_type) :: Time_dyn !< The ocean model's time for the dynamics. Time and Time_dyn + !! should be the same after a full time step. 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 @@ -254,7 +256,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) OS%is_ocean_pe = Ocean_sfc%is_ocean_pe if (.not.OS%is_ocean_pe) return - OS%Time = Time_in + OS%Time = Time_in ; OS%Time_dyn = 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, & diag_ptr=OS%diag, count_calls=.true.) @@ -386,23 +388,22 @@ end subroutine ocean_model_init !! 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, & - update_dyn, update_thermo, Ocn_fluxes_used) +subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_update, & + Ocean_coupling_time_step, update_dyn, update_thermo, & + Ocn_fluxes_used, start_cycle, end_cycle, cycle_length) type(ice_ocean_boundary_type), & - intent(in) :: Ice_ocean_boundary !< A structure containing the - !! various forcing fields coming from the ice. + intent(in) :: Ice_ocean_boundary !< A structure containing the various + !! forcing fields coming from the ice and atmosphere. type(ocean_state_type), & - pointer :: OS !< A pointer to a private structure containing - !! the internal ocean state. + 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. + 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. + type(time_type), intent(in) :: Ocean_coupling_time_step !< The amount of time over which to + !! advance the ocean. 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 @@ -410,37 +411,38 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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. + logical, optional, intent(in) :: start_cycle !< This indicates whether this call is to be + !! treated as the first call to step_MOM in a + !! time-stepping cycle; missing is like true. + logical, optional, intent(in) :: end_cycle !< This indicates whether this call is to be + !! treated as the last call to step_MOM in a + !! time-stepping cycle; missing is like true. + real, optional, intent(in) :: cycle_length !< The duration of a coupled time stepping cycle, in s. + ! 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 of the current fluxes. - 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. + type(time_type) :: Time_seg_start ! Stores the ocean model time at the start of this call to allow + ! step_MOM to temporarily change the time as 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 of the current fluxes. + real :: dt_coupling ! The coupling time step in seconds. + 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 ! The internal iteration counter. + integer :: nts ! The number of baroclinic dynamics time steps in a thermodynamic step. + integer :: n_max ! The number of calls to step_MOM dynamics in this call to update_ocean_model. + integer :: n_last_thermo ! The iteration number the last time thermodynamics were updated. + 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 :: is, ie, js, je call callTree_enter("update_ocean_model(), ocean_model_MOM.F90") dt_coupling = time_type_to_real(Ocean_coupling_time_step) - if (time_start_update /= OS%Time) then - call MOM_error(WARNING, "update_ocean_model: internal clock does not "//& - "agree with time_start_update argument.") - endif if (.not.associated(OS)) then call MOM_error(FATAL, "update_ocean_model called with an unassociated "// & "ocean_state_type structure. ocean_model_init must be "// & @@ -451,6 +453,18 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & do_dyn = .true. ; if (present(update_dyn)) do_dyn = update_dyn do_thermo = .true. ; if (present(update_thermo)) do_thermo = update_thermo + if (do_thermo .and. (time_start_update /= OS%Time)) & + call MOM_error(WARNING, "update_ocean_model: internal clock does not "//& + "agree with time_start_update argument.") + if (do_dyn .and. (time_start_update /= OS%Time_dyn)) & + call MOM_error(WARNING, "update_ocean_model: internal dynamics clock does not "//& + "agree with time_start_update argument.") + + if (.not.(do_dyn .or. do_thermo)) call MOM_error(FATAL, & + "update_ocean_model called without updating either dynamics or thermodynamics.") + if (do_dyn .and. do_thermo .and. (OS%Time /= OS%Time_dyn)) call MOM_error(FATAL, & + "update_ocean_model called to update both dynamics and thermodynamics with inconsistent clocks.") + ! 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 @@ -462,7 +476,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & index_bnds(3), index_bnds(4)) if (do_dyn) then - call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time, OS%grid, & + call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time_dyn, OS%grid, & OS%forcing_CSp, dt_forcing=dt_coupling, reset_avg=OS%fluxes%fluxes_used) if (OS%use_ice_shelf) & call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) @@ -486,6 +500,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & #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, 1.0) ! Here weight=1, so just store the current fluxes + call disable_averaging(OS%diag) #endif ! Indicate that there are new unused fluxes. OS%fluxes%fluxes_used = .false. @@ -522,22 +537,21 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call Update_Surface_Waves(OS%grid, OS%GV, OS%time, ocean_coupling_time_step, OS%waves) endif - if ((OS%nstep==0) .and. (OS%nstep_thermo==0)) then + if ((OS%nstep==0) .and. (OS%nstep_thermo==0)) then ! This is the first call to update_ocean_model. call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%restart_CSp) endif - call disable_averaging(OS%diag) - Master_time = OS%Time ; Time1 = OS%Time + Time_seg_start = OS%Time ; if (do_dyn) Time_seg_start = OS%Time_dyn + Time1 = Time_seg_start if (OS%offline_tracer_mode .and. do_thermo) then 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, & + Waves=OS%Waves, do_dynamics=do_dyn, do_thermodynamics=do_thermo, & + start_cycle=start_cycle, end_cycle=end_cycle, cycle_length=cycle_length, & reset_therm=Ocn_fluxes_used) - !### What to do with these? , start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) - 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 @@ -553,7 +567,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & n_last_thermo = 0 endif - Time2 = Time1 ; t_elapsed_seg = 0.0 + Time1 = Time_seg_start ; t_elapsed_seg = 0.0 do n=1,n_max if (OS%diabatic_first) then if (thermo_does_span_coupling) call MOM_error(FATAL, & @@ -561,16 +575,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & "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, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, 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, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, 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, & + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, 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) @@ -585,25 +599,27 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & endif if (step_thermo) then - ! Back up Time2 to the start of the thermodynamic segment. - Time2 = Time2 - real_to_time_type(dtdia - dt_dyn) - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & + ! Back up Time1 to the start of the thermodynamic segment. + Time1 = Time1 - real_to_time_type(dtdia - dt_dyn) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, 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 + real_to_time_type(t_elapsed_seg) + Time1 = Time_seg_start + real_to_time_type(t_elapsed_seg) enddo endif - OS%Time = Master_time + Ocean_coupling_time_step + if (do_dyn) OS%Time_dyn = Time_seg_start + Ocean_coupling_time_step if (do_dyn) OS%nstep = OS%nstep + 1 + OS%Time = Time_seg_start ! Reset the clock to compensate for shared pointers. + if (do_thermo) OS%Time = OS%Time + Ocean_coupling_time_step if (do_thermo) OS%nstep_thermo = OS%nstep_thermo + 1 if (do_dyn) then - call enable_averaging(dt_coupling, OS%Time, OS%diag) + call enable_averaging(dt_coupling, OS%Time_dyn, OS%diag) call mech_forcing_diags(OS%forces, dt_coupling, OS%grid, OS%diag, OS%forcing_CSp%handles) call disable_averaging(OS%diag) endif @@ -619,7 +635,8 @@ 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) + Time1 = OS%Time ; if (do_dyn) Time1 = OS%Time_dyn + call coupler_type_send_data(Ocean_sfc%fields, Time1) call callTree_leave("update_ocean_model()") end subroutine update_ocean_model From 40466156dec6f9ed43185a2d11d8cb9bf3398cbb Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 11 Aug 2018 14:31:56 -0400 Subject: [PATCH 0644/1072] Removed trailing white space --- config_src/coupled_driver/MOM_surface_forcing.F90 | 2 +- src/core/MOM_forcing_type.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 532ed8081b..bbaac1df07 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -642,7 +642,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS, dt_forc if (present(reset_avg)) then ; if (reset_avg) forces%dt_force_accum = 0.0 ; endif wt1 = 0.0 ; wt2 = 1.0 if (present(dt_forcing)) then - if ((forces%dt_force_accum > 0.0) .and. (dt_forcing > 0.0)) then + if ((forces%dt_force_accum > 0.0) .and. (dt_forcing > 0.0)) then wt1 = forces%dt_force_accum / (forces%dt_force_accum + dt_forcing) wt2 = 1.0 - wt1 endif diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 857979f61d..9ac616dac0 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -1998,7 +1998,7 @@ end subroutine set_derived_forcing_fields subroutine set_net_mass_forcing(fluxes, forces, G) type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(ocean_grid_type), intent(in) :: G !< The ocean grid type + type(ocean_grid_type), intent(in) :: G !< The ocean grid type if (associated(forces%net_mass_src)) & call get_net_mass_forcing(fluxes, G, forces%net_mass_src) From 3bf78bd416a64497bc7b283c8a7efa7b6d4e267e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 13 Aug 2018 17:34:08 -0400 Subject: [PATCH 0645/1072] Avoid NaNs on land in ALE diagnostics Some of the temporary arrays used to calculate ALE tendencies were not being initialized, so there could be NaNs or other silly values reported over land. The needed array initialization calls were removed with NOAA-GFDL/MOM6@11c2a91, but have now been restored, and the diagnostics are only calculated and offered if remap_all_state_vars are given a diagnostic time-step (without which the diagnostics make no sense). This commit addresses issue number github.com/NOAA-GFDL/MOM6/issues/829. All answers are bitwise identical. --- src/ALE/MOM_ALE.F90 | 41 ++++++++++++++++++++--------------------- 1 file changed, 20 insertions(+), 21 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index a71dfb557c..7e2885fd6f 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -760,14 +760,12 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, nz = GV%ke ppt2mks = 0.001 - if (associated(Reg)) then - ntr = Reg%ntr - else - ntr = 0 - endif + ntr = 0 ; if (associated(Reg)) ntr = Reg%ntr if (present(dt)) then Idt = 1.0/dt + work_conc(:,:,:) = 0.0 + work_cont(:,:,:) = 0.0 endif ! Remap tracer @@ -801,22 +799,23 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, endif ; enddo ; enddo ! tendency diagnostics. - if (Tr%id_remap_conc > 0) then - call post_data(Tr%id_remap_conc, work_conc, CS_ALE%diag) - endif - if (Tr%id_remap_cont > 0) then - call post_data(Tr%id_remap_cont, work_cont, CS_ALE%diag) - endif - if (Tr%id_remap_cont_2d > 0) then - do j = G%jsc,G%jec ; do i = G%isc,G%iec - work_2d(i,j) = 0.0 - do k = 1,GV%ke - work_2d(i,j) = work_2d(i,j) + work_cont(i,j,k) - enddo - enddo ; enddo - call post_data(Tr%id_remap_cont_2d, work_2d, CS_ALE%diag) + if (present(dt)) then + if (Tr%id_remap_conc > 0) then + call post_data(Tr%id_remap_conc, work_conc, CS_ALE%diag) + endif + if (Tr%id_remap_cont > 0) then + call post_data(Tr%id_remap_cont, work_cont, CS_ALE%diag) + endif + if (Tr%id_remap_cont_2d > 0) then + do j = G%jsc,G%jec ; do i = G%isc,G%iec + work_2d(i,j) = 0.0 + do k = 1,GV%ke + work_2d(i,j) = work_2d(i,j) + work_cont(i,j,k) + enddo + enddo ; enddo + call post_data(Tr%id_remap_cont_2d, work_2d, CS_ALE%diag) + endif endif - enddo ! m=1,ntr endif ! endif for ntr > 0 @@ -866,7 +865,7 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, endif if (CS_ALE%id_vert_remap_h > 0) call post_data(CS_ALE%id_vert_remap_h, h_old, CS_ALE%diag) - if (CS_ALE%id_vert_remap_h_tendency > 0) then + if ((CS_ALE%id_vert_remap_h_tendency > 0) .and. present(dt)) then do k = 1, nz ; do j = G%jsc,G%jec ; do i = G%isc,G%iec work_cont(i,j,k) = (h_new(i,j,k) - h_old(i,j,k))*Idt enddo ; enddo ; enddo From ac757ef71f3036a147b8008381491cfe7dd8508d Mon Sep 17 00:00:00 2001 From: "Jessica.Liptak" Date: Tue, 14 Aug 2018 10:12:46 -0400 Subject: [PATCH 0646/1072] Capitalized _allocated in MOM_generic tracer to fix bug with intel16 -O0 (debug). --- src/tracer/MOM_generic_tracer.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 48b8e4512c..42db298632 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -498,7 +498,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, ! g_tracer=>CS%g_tracer_list do - if (allocated(g_tracer%trunoff)) then + if (_ALLOCATED(g_tracer%trunoff)) then call g_tracer_get_alias(g_tracer,g_tracer_name) call g_tracer_get_pointer(g_tracer,g_tracer_name,'stf', stf_array) call g_tracer_get_pointer(g_tracer,g_tracer_name,'trunoff',trunoff_array) From e3dc939f93b7dd817deaf8e1a0e9252ca8c97204 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 14 Aug 2018 11:31:05 -0400 Subject: [PATCH 0647/1072] (*)Increase precision of time handling Replaced the use of set_time and get_time with real_to_time_type and time_type_to_real to increase the precision of handling time by allowing the sub-second ticks to be used effectively, and thereby permitting the use of fractional second timesteps within MOM6. This modification could change answers in cases where times are not an integer number of seconds. However, all existing test cases only use times that are an integer number of seconds, so the answers are bitwise identical in the test cases. --- src/core/MOM.F90 | 35 +++++++++---------- src/core/MOM_barotropic.F90 | 6 ++-- src/core/MOM_dynamics_split_RK2.F90 | 2 +- src/core/MOM_dynamics_unsplit.F90 | 4 +-- src/core/MOM_dynamics_unsplit_RK2.F90 | 2 +- src/framework/MOM_file_parser.F90 | 10 +++--- src/framework/MOM_horizontal_regridding.F90 | 2 +- src/framework/MOM_restart.F90 | 17 ++++----- src/ice_shelf/MOM_ice_shelf.F90 | 2 +- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 10 +++--- .../MOM_state_initialization.F90 | 2 +- .../MOM_tracer_initialization_from_Z.F90 | 1 - src/ocean_data_assim/MOM_oda_driver.F90 | 2 +- .../lateral/MOM_internal_tides.F90 | 10 ++---- .../vertical/MOM_diabatic_driver.F90 | 7 ++-- .../vertical/MOM_opacity.F90 | 3 -- src/tracer/DOME_tracer.F90 | 2 +- src/tracer/ISOMIP_tracer.F90 | 2 +- src/tracer/MOM_OCMIP2_CFC.F90 | 2 +- src/tracer/MOM_generic_tracer.F90 | 2 +- src/tracer/advection_test_tracer.F90 | 2 +- src/tracer/boundary_impulse_tracer.F90 | 2 +- src/tracer/dye_example.F90 | 2 +- src/tracer/dyed_obc_tracer.F90 | 2 +- src/tracer/ideal_age_example.F90 | 6 ++-- src/tracer/oil_tracer.F90 | 8 ++--- src/tracer/pseudo_salt_tracer.F90 | 2 +- src/tracer/tracer_example.F90 | 2 +- src/user/BFB_surface_forcing.F90 | 2 +- src/user/Kelvin_initialization.F90 | 2 +- src/user/MOM_controlled_forcing.F90 | 6 ++-- src/user/MOM_wave_interface.F90 | 4 +-- src/user/SCM_CVmix_tests.F90 | 7 ++-- src/user/SCM_idealized_hurricane.F90 | 3 +- src/user/dumbbell_surface_forcing.F90 | 1 + src/user/dyed_channel_initialization.F90 | 2 +- src/user/shelfwave_initialization.F90 | 2 +- src/user/supercritical_initialization.F90 | 2 +- src/user/tidal_bay_initialization.F90 | 2 +- src/user/user_revise_forcing.F90 | 2 +- 40 files changed, 80 insertions(+), 104 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c554e4f92e..bf47d7b08c 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -39,7 +39,7 @@ module MOM use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, is_new_run, MOM_restart_CS use MOM_spatial_means, only : global_mass_integral -use MOM_time_manager, only : time_type, set_time, time_type_to_real, operator(+) +use MOM_time_manager, only : time_type, real_to_time_type, time_type_to_real, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) use MOM_time_manager, only : operator(>=), increment_date use MOM_unit_tests, only : unit_tests @@ -556,7 +556,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & do j=js,je ; do i=is,ie ; CS%ssh_rint(i,j) = 0.0 ; enddo ; enddo if (associated(CS%VarMix)) then - call enable_averaging(cycle_time, Time_start+set_time(int(cycle_time)), & + call enable_averaging(cycle_time, Time_start + real_to_time_type(cycle_time), & CS%diag) call calc_resoln_function(h, CS%tv, G, GV, CS%VarMix) call disable_averaging(CS%diag) @@ -582,7 +582,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (CS%UseWaves) then ! Update wave information, which is presently kept static over each call to step_mom - call enable_averaging(time_interval, Time_start + set_time(int(floor(time_interval+0.5))), CS%diag) + call enable_averaging(time_interval, Time_start + real_to_time_type(time_interval), CS%diag) call Update_Stokes_Drift(G, GV, Waves, h, forces%ustar) call disable_averaging(CS%diag) endif @@ -604,9 +604,9 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & do n=1,n_max rel_time = rel_time + dt ! The relative time at the end of the step. ! Set the universally visible time to the middle of the time step. - CS%Time = Time_start + set_time(int(floor(0.5 + rel_time - 0.5*dt))) + CS%Time = Time_start + real_to_time_type(rel_time - 0.5*dt) ! Set the local time to the end of the time step. - Time_local = Time_start + set_time(int(floor(rel_time+0.5))) + Time_local = Time_start + real_to_time_type(rel_time) if (showCallTree) call callTree_enter("DT cycles (step_MOM) n=",n) @@ -633,10 +633,10 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (dtdia > dt) then ! If necessary, temporarily reset CS%Time to the center of the period covered ! by the call to step_MOM_thermo, noting that they begin at the same time. - CS%Time = CS%Time + set_time(int(floor(0.5*(dtdia-dt) + 0.5))) + CS%Time = CS%Time + real_to_time_type(0.5*(dtdia-dt)) ! The end-time of the diagnostic interval needs to be set ahead if there ! are multiple dynamic time steps worth of thermodynamics applied here. - end_time_thermo = Time_local + set_time(int(floor(dtdia-dt+0.5))) + end_time_thermo = Time_local + real_to_time_type(dtdia-dt) endif ! Apply diabatic forcing, do mixing, and regrid. @@ -649,7 +649,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (showCallTree) call callTree_waypoint("finished diabatic_first (step_MOM)") if (dtdia > dt) & ! Reset CS%Time to its previous value. - CS%Time = Time_start + set_time(int(floor(0.5 + rel_time - 0.5*dt))) + CS%Time = Time_start + real_to_time_type(rel_time - 0.5*dt) endif ! end of block "(CS%diabatic_first .and. (CS%t_dyn_rel_adv==0.0))" if (do_dyn) then @@ -731,7 +731,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ! If necessary, temporarily reset CS%Time to the center of the period covered ! by the call to step_MOM_thermo, noting that they end at the same time. - if (dtdia > dt) CS%Time = CS%Time - set_time(int(floor(0.5*(dtdia-dt) + 0.5))) + if (dtdia > dt) CS%Time = CS%Time - real_to_time_type(0.5*(dtdia-dt)) ! Apply diabatic forcing, do mixing, and regrid. call step_MOM_thermo(CS, G, GV, u, v, h, CS%tv, fluxes, dtdia, & @@ -740,7 +740,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & CS%t_dyn_rel_thermo = 0.0 if (dtdia > dt) & ! Reset CS%Time to its previous value. - CS%Time = Time_start + set_time(int(floor(0.5 + rel_time - 0.5*dt))) + CS%Time = Time_start + real_to_time_type(rel_time - 0.5*dt) endif if (do_dyn) then @@ -774,7 +774,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & CS%t_dyn_rel_diag = 0.0 call cpu_clock_begin(id_clock_Z_diag) - if (Time_local + set_time(int(0.5*dt_therm)) > CS%Z_diag_time) then + if (Time_local + real_to_time_type(0.5*dt_therm) > CS%Z_diag_time) then call enable_averaging(real(time_type_to_real(CS%Z_diag_interval)), & CS%Z_diag_time, CS%diag) !### This is the one place where fluxes might used if do_thermo=.false. Is this correct? @@ -852,7 +852,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (MOM_state_is_synchronized(CS)) & call write_energy(CS%u, CS%v, CS%h, CS%tv, Time_local, CS%nstep_tot, & G, GV, CS%sum_output_CSp, CS%tracer_flow_CSp, & - dt_forcing=set_time(int(floor(time_interval+0.5))) ) + dt_forcing=real_to_time_type(time_interval) ) call cpu_clock_end(id_clock_other) @@ -912,7 +912,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if ((CS%t_dyn_rel_adv == 0.0) .and. CS%thickness_diffuse .and. CS%thickness_diffuse_first) then - call enable_averaging(dt_thermo, Time_local+set_time(int(floor(dt_thermo-dt+0.5))), CS%diag) + call enable_averaging(dt_thermo, Time_local+real_to_time_type(dt_thermo-dt), CS%diag) call cpu_clock_begin(id_clock_thick_diff) if (associated(CS%VarMix)) & call calc_slope_functions(h, CS%tv, dt, G, GV, CS%VarMix) @@ -931,7 +931,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & ! The bottom boundary layer properties need to be recalculated. if (bbl_time_int > 0.0) then call enable_averaging(bbl_time_int, & - Time_local + set_time(int(bbl_time_int-dt+0.5)), CS%diag) + Time_local + real_to_time_type(bbl_time_int-dt), CS%diag) ! Calculate the BBL properties and store them inside visc (u,h). call cpu_clock_begin(id_clock_BBL_visc) call set_viscous_BBL(CS%u, CS%v, CS%h, CS%tv, CS%visc, G, GV, & @@ -2286,7 +2286,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%OBC, CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, & CS%visc, dirs, CS%ntrunc, calc_dtbt=calc_dtbt) if (CS%dtbt_reset_period > 0.0) then - CS%dtbt_reset_interval = set_time(int(floor(CS%dtbt_reset_period))) + CS%dtbt_reset_interval = real_to_time_type(CS%dtbt_reset_period) ! Set dtbt_reset_time to be the next even multiple of dtbt_reset_interval. CS%dtbt_reset_time = Time_init + CS%dtbt_reset_interval * & ((Time - Time_init) / CS%dtbt_reset_interval) @@ -2325,11 +2325,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & param_file, diag, CS%diagnostics_CSp, CS%tv) call diag_copy_diag_to_storage(CS%diag_pre_sync, CS%h, CS%diag) - CS%Z_diag_interval = set_time(int((CS%dt_therm) * & - max(1,floor(0.01 + Z_diag_int/(CS%dt_therm))))) + CS%Z_diag_interval = real_to_time_type(CS%dt_therm * max(1,floor(0.01 + Z_diag_int/CS%dt_therm))) call MOM_diag_to_Z_init(Time, G, GV, param_file, diag, CS%diag_to_Z_CSp) CS%Z_diag_time = Start_time + CS%Z_diag_interval * (1 + & - ((Time + set_time(int(CS%dt_therm))) - Start_time) / CS%Z_diag_interval) + ((Time + real_to_time_type(CS%dt_therm)) - Start_time) / CS%Z_diag_interval) if (associated(CS%sponge_CSp)) & call init_sponge_diags(Time, G, diag, CS%sponge_CSp) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 940c99b8be..c423b2d0c1 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -22,7 +22,7 @@ module MOM_barotropic use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S, OBC_segment_type use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_tidal_forcing, only : tidal_forcing_sensitivity, tidal_forcing_CS -use MOM_time_manager, only : time_type, set_time, operator(+), operator(-) +use MOM_time_manager, only : time_type, real_to_time_type, operator(+), operator(-) use MOM_variables, only : BT_cont_type, alloc_bt_cont_type use MOM_verticalGrid, only : verticalGrid_type @@ -723,7 +723,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & (CS%id_uhbt_hifreq > 0) .or. (CS%id_vhbt_hifreq > 0)) then do_hifreq_output = query_averaging_enabled(CS%diag, time_int_in, time_end_in) if (do_hifreq_output) & - time_bt_start = time_end_in - set_time(int(floor(dt+0.5))) + time_bt_start = time_end_in - real_to_time_type(dt) endif !--- begin setup for group halo update @@ -2008,7 +2008,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & enddo ; enddo if (do_hifreq_output) then - time_step_end = time_bt_start + set_time(int(floor(n*dtbt+0.5))) + time_step_end = time_bt_start + real_to_time_type(n*dtbt) call enable_averaging(dtbt, time_step_end, CS%diag) if (CS%id_ubt_hifreq > 0) call post_data(CS%id_ubt_hifreq, ubt(IsdB:IedB,jsd:jed), CS%diag) if (CS%id_vbt_hifreq > 0) call post_data(CS%id_vbt_hifreq, vbt(isd:ied,JsdB:JedB), CS%diag) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index d02285148a..0f4bd88111 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -30,7 +30,7 @@ module MOM_dynamics_split_RK2 use MOM_io, only : MOM_io_init, vardesc, var_desc use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, is_new_run, MOM_restart_CS -use MOM_time_manager, only : time_type, set_time, time_type_to_real, operator(+) +use MOM_time_manager, only : time_type, time_type_to_real, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) use MOM_ALE, only : ALE_CS diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 47d3510c5a..506dd3624b 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -72,7 +72,7 @@ module MOM_dynamics_unsplit use MOM_io, only : MOM_io_init use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, MOM_restart_CS -use MOM_time_manager, only : time_type, set_time, time_type_to_real, operator(+) +use MOM_time_manager, only : time_type, real_to_time_type, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) use MOM_ALE, only : ALE_CS @@ -267,7 +267,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) - call enable_averaging(0.5*dt,Time_local-set_time(int(0.5*dt)), CS%diag) + call enable_averaging(0.5*dt,Time_local-real_to_time_type(0.5*dt), CS%diag) ! Here the first half of the thickness fluxes are offered for averaging. if (CS%id_uh > 0) call post_data(CS%id_uh, uh, CS%diag) if (CS%id_vh > 0) call post_data(CS%id_vh, vh, CS%diag) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index a1615ad413..0f6d61905e 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -70,7 +70,7 @@ module MOM_dynamics_unsplit_RK2 use MOM_io, only : MOM_io_init use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, MOM_restart_CS -use MOM_time_manager, only : time_type, set_time, time_type_to_real, operator(+) +use MOM_time_manager, only : time_type, time_type_to_real, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) use MOM_ALE, only : ALE_CS diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index ae876b16dd..70f3b9a941 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -6,8 +6,8 @@ module MOM_file_parser use MOM_coms, only : root_PE, broadcast use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg use MOM_error_handler, only : is_root_pe, stdlog, stdout -use MOM_time_manager, only : set_time, get_time, time_type, get_ticks_per_second -use MOM_time_manager, only : set_date, get_date +use MOM_time_manager, only : get_time, time_type, get_ticks_per_second +use MOM_time_manager, only : set_date, get_date, real_to_time_type use MOM_document, only : doc_param, doc_module, doc_init, doc_end, doc_type use MOM_document, only : doc_openBlock, doc_closeBlock use MOM_string_functions, only : left_int, left_ints, slasher @@ -821,7 +821,7 @@ subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing, date_f character(len=240) :: err_msg logical :: found, defined real :: real_time, time_unit - integer :: days, secs, vals(7) + integer :: vals(7) if (present(date_format)) date_format = .false. @@ -854,9 +854,7 @@ subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing, date_f else time_unit = 1.0 ; if (present(timeunit)) time_unit = timeunit read( value_string(1), *) real_time - days = int(real_time*(time_unit/86400.0)) - secs = int(floor((real_time*(time_unit/86400.0)-days)*86400.0 + 0.5)) - value = set_time(secs, days) + value = real_to_time_type(real_time*time_unit) endif else if (present(fail_if_missing)) then ; if (fail_if_missing) then diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 19b73ee07f..c7befad3b3 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -19,7 +19,7 @@ module MOM_horizontal_regridding use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE, MULTIPLE use MOM_io, only : slasher, vardesc, write_field use MOM_string_functions, only : uppercase -use MOM_time_manager, only : time_type, set_time, get_external_field_size +use MOM_time_manager, only : time_type, get_external_field_size use MOM_time_manager, only : init_external_field, time_interp_external use MOM_time_manager, only : get_external_field_axes, get_external_field_missing use MOM_variables, only : thermo_var_ptrs diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index bf40da4897..436d514125 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -14,8 +14,8 @@ module MOM_restart use MOM_io, only : vardesc, var_desc, query_vardesc, modify_vardesc use MOM_io, only : MULTIPLE, NETCDF_FILE, READONLY_FILE, SINGLE_FILE use MOM_io, only : CENTER, CORNER, NORTH_FACE, EAST_FACE -use MOM_time_manager, only : time_type, get_time, get_date, set_date, set_time -use MOM_time_manager, only : days_in_month +use MOM_time_manager, only : time_type, time_type_to_real, real_to_time_type +use MOM_time_manager, only : days_in_month, get_date, set_date use MOM_verticalGrid, only : verticalGrid_type use mpp_mod, only: mpp_chksum use mpp_io_mod, only: mpp_attribute_exist, mpp_get_atts @@ -801,15 +801,14 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV) ! With parallel read & write, it is possible to disable the following... -! jgj: this was set to 4294967292, changed to 4294967295 (see mpp_parameter.F90) - if (CS%large_file_support) max_file_size = 4294967295_8 + ! The maximum file size is 4294967292, according to the NetCDF documentation. + if (CS%large_file_support) max_file_size = 4294967292_8 num_files = 0 next_var = 0 nz = 1 ; if (present(GV)) nz = GV%ke - call get_time(time,seconds,days) - restart_time = real(days) + real(seconds)/86400.0 + restart_time = time_type_to_real(time) restartname = trim(CS%restartfile) if (present(filename)) restartname = trim(filename) @@ -982,7 +981,7 @@ subroutine restore_state(filename, directory, day, G, CS) character(len=80) :: varname ! A variable's name. integer :: num_file ! The number of files (restart files and others ! explicitly in filename) that are open. - integer :: i, n, m, start_of_day, num_days, missing_fields + integer :: i, n, m, missing_fields integer :: isL, ieL, jsL, jeL, is0, js0 integer :: sizes(7) integer :: ndim, nvar, natt, ntime, pos @@ -1028,9 +1027,7 @@ subroutine restore_state(filename, directory, day, G, CS) t1 = time_vals(1) deallocate(time_vals) - start_of_day = INT((t1 - INT(t1)) *86400) ! Number of seconds. - num_days = INT(t1) - day = set_time(start_of_day, num_days) + day = real_to_time_type(t1) exit enddo diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index e1a61f355c..7e3c4ac606 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -25,7 +25,7 @@ module MOM_ice_shelf use MOM_io, only : write_field, close_file, SINGLE_FILE, MULTIPLE use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, restore_state, MOM_restart_CS -use MOM_time_manager, only : time_type, set_time, time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid use MOM_variables, only : surface use MOM_forcing_type, only : forcing, allocate_forcing_type, MOM_forcing_chksum diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index e504db90c7..9d25d8c8a3 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -17,7 +17,7 @@ module MOM_ice_shelf_dynamics use MOM_io, only : file_exists, slasher, MOM_read_data use MOM_restart, only : register_restart_field, query_initialized use MOM_restart, only : MOM_restart_CS -use MOM_time_manager, only : time_type, set_time, time_type_to_real +use MOM_time_manager, only : time_type, set_time !MJH use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary use MOM_ice_shelf_state, only : ice_shelf_state use MOM_coms, only : reproducing_sum, sum_across_PEs, max_across_PEs, min_across_PEs @@ -523,13 +523,13 @@ subroutine initialize_diagnostic_fields(CS, ISS, G, Time) type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. type(time_type), intent(in) :: Time !< The current model time - integer :: i, j, iters, isd, ied, jsd, jed - real :: rhoi, rhow, OD - type(time_type) :: dummy_time + integer :: i, j, iters, isd, ied, jsd, jed + real :: rhoi, rhow, OD + type(time_type) :: dummy_time rhoi = CS%density_ice rhow = CS%density_ocean_avg - dummy_time = set_time (0,0) + dummy_time = set_time(0,0) isd=G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed do j=jsd,jed diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 0f9c17022d..57820accc0 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -34,7 +34,7 @@ module MOM_state_initialization use MOM_ALE_sponge, only : set_up_ALE_sponge_field, initialize_ALE_sponge use MOM_ALE_sponge, only : ALE_sponge_CS use MOM_string_functions, only : uppercase, lowercase -use MOM_time_manager, only : time_type, set_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : tracer_registry_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : setVerticalGridAxes, verticalGrid_type diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 67cf7bbd24..07be1ee340 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -16,7 +16,6 @@ module MOM_tracer_initialization_from_Z use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type, isPointInCell use MOM_string_functions, only : uppercase -use MOM_time_manager, only : time_type, set_time use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : setVerticalGridAxes use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 17cc300bd2..f9dae9b246 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -19,7 +19,7 @@ module MOM_oda_driver_mod use ensemble_manager_mod, only : get_ensemble_id, get_ensemble_size use ensemble_manager_mod, only : get_ensemble_pelist, get_ensemble_filter_pelist use time_manager_mod, only : time_type, decrement_time, increment_time -use time_manager_mod, only : get_date, get_time, operator(>=),operator(/=),operator(==),operator(<) +use time_manager_mod, only : get_date, operator(>=),operator(/=),operator(==),operator(<) use constants_mod, only : radius, epsln ! ODA Modules use ocean_da_types_mod, only : grid_type, ocean_profile_type, ocean_control_struct diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 3205f81b02..822c11470e 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -18,9 +18,7 @@ module MOM_internal_tides use MOM_io, only : slasher, vardesc, MOM_read_data use MOM_restart, only : register_restart_field, MOM_restart_CS, restart_init, save_restart use MOM_spatial_means, only : global_area_mean -use MOM_time_manager, only : time_type, operator(+), operator(/), operator(-) -use MOM_time_manager, only : get_time, get_date, set_time, set_date -use MOM_time_manager, only : time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real, operator(+), operator(/), operator(-) use MOM_variables, only : surface, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_structure, only: wave_structure_init, wave_structure, wave_structure_CS @@ -592,13 +590,8 @@ subroutine sum_En(G, CS, En, label) integer :: m,fr,a real :: En_sum, tmpForSumming, En_sum_diff, En_sum_pdiff character(len=160) :: mesg ! The text of an error message - integer :: seconds - real :: Isecs_per_day = 1.0 / 86400.0 real :: days - call get_time(CS%Time, seconds) - days = real(seconds) * Isecs_per_day - En_sum = 0.0 tmpForSumming = 0.0 do a=1,CS%nAngle @@ -614,6 +607,7 @@ subroutine sum_En(G, CS, En, label) CS%En_sum = En_sum !! Print to screen !if (is_root_pe()) then + ! days = time_type_to_real(CS%Time) / 86400.0 ! write(mesg,*) trim(label)//': days =', days, ', En_sum=', En_sum, & ! ', En_sum_diff=', En_sum_diff, ', Percent change=', En_sum_pdiff, '%' ! call MOM_mesg(mesg) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 188ba9c8f3..846e27de8b 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -61,8 +61,7 @@ module MOM_diabatic_driver use MOM_shortwave_abs, only : absorbRemainingSW, optics_type use MOM_sponge, only : apply_sponge, sponge_CS use MOM_ALE_sponge, only : apply_ALE_sponge, ALE_sponge_CS -use MOM_time_manager, only : operator(-), set_time -use MOM_time_manager, only : operator(<=), time_type ! for testing itides (BDM) +use MOM_time_manager, only : time_type, real_to_time_type, operator(-), operator(<=) use MOM_tracer_flow_control, only : call_tracer_column_fns, tracer_flow_control_CS use MOM_tracer_diabatic, only : tracer_vertdiff use MOM_variables, only : thermo_var_ptrs, vertvisc_type, accel_diag_ptrs @@ -440,7 +439,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! the end of the diabatic processes. if (associated(tv%T) .AND. associated(tv%frazil)) then ! For frazil diagnostic, the first call covers the first half of the time step - call enable_averaging(0.5*dt, Time_end - set_time(int(floor(0.5*dt+0.5))), CS%diag) + call enable_averaging(0.5*dt, Time_end - real_to_time_type(0.5*dt), CS%diag) if (CS%frazil_tendency_diag) then do k=1,nz ; do j=js,je ; do i=is,ie temp_diag(i,j,k) = tv%T(i,j,k) @@ -1316,7 +1315,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! the end of the diabatic processes. if (associated(tv%T) .AND. associated(tv%frazil)) then ! For frazil diagnostic, the first call covers the first half of the time step - call enable_averaging(0.5*dt, Time_end - set_time(int(floor(0.5*dt+0.5))), CS%diag) + call enable_averaging(0.5*dt, Time_end - real_to_time_type(0.5*dt), CS%diag) if (CS%frazil_tendency_diag) then do k=1,nz ; do j=js,je ; do i=is,ie temp_diag(i,j,k) = tv%T(i,j,k) diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 26a23a0f0d..ca2afdc655 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -5,7 +5,6 @@ module MOM_opacity use MOM_diag_mediator, only : time_type, diag_ctrl, safe_alloc_ptr, post_data use MOM_diag_mediator, only : query_averaging_enabled, register_diag_field -use MOM_time_manager, only : get_time use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_string_functions, only : uppercase @@ -225,7 +224,6 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) ! radiation, in W m-2. type(time_type) :: day character(len=128) :: mesg - integer :: days, seconds integer :: i, j, k, n, is, ie, js, je, nz, nbands logical :: multiband_vis_input, multiband_nir_input @@ -271,7 +269,6 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) else ! Only the 2-d surface chlorophyll can be read in from a file. The ! same value is assumed for all layers. - call get_time(CS%Time,seconds,days) call time_interp_external(CS%sbc_chl, CS%Time, chl_data) do j=js,je ; do i=is,ie if ((G%mask2dT(i,j) > 0.5) .and. (chl_data(i,j) < 0.0)) then diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 91b156751f..0354f90a51 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -15,7 +15,7 @@ module DOME_tracer use MOM_open_boundary, only : OBC_segment_type, register_segment_tracer use MOM_restart, only : MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_variables, only : surface diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 40e8ef6db5..0707b54fb3 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -20,7 +20,7 @@ module ISOMIP_tracer use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc, query_vardesc use MOM_restart, only : MOM_restart_CS use MOM_ALE_sponge, only : set_up_ALE_sponge_field, ALE_sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_variables, only : surface diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index e8c3387cea..ebff38508c 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -14,7 +14,7 @@ module MOM_OCMIP2_CFC use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index d06ffe0e2c..66dd26fca0 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -35,7 +35,7 @@ module MOM_generic_tracer use MOM_spatial_means, only : global_area_mean use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_ALE_sponge, only : set_up_ALE_sponge_field, ALE_sponge_CS - use MOM_time_manager, only : time_type, get_time, set_time + use MOM_time_manager, only : time_type, set_time use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_Z_init, only : tracer_Z_init diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 4ed395bac8..aeb1b3aae9 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -14,7 +14,7 @@ module advection_test_tracer use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_variables, only : surface diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 7995b712e3..9b785fe41d 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -14,7 +14,7 @@ module boundary_impulse_tracer use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index a597b1fc8c..0e1b9a06b9 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -14,7 +14,7 @@ module regional_dyes use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index 2102f1cc71..af69a39c52 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -13,7 +13,7 @@ module dyed_obc_tracer use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc, query_vardesc use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : MOM_restart_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_variables, only : surface diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index 1f77bd639e..d7fcb53324 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -14,7 +14,7 @@ module ideal_age_example use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type, time_type_to_real use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init @@ -317,7 +317,6 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, real :: sfc_val ! The surface value for the tracers. real :: Isecs_per_year ! The number of seconds in a year. real :: year ! The time in years. - integer :: secs, days ! Integer components of the time type. integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -342,8 +341,7 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, Isecs_per_year = 1.0 / (365.0*86400.0) ! Set the surface value of tracer 1 to increase exponentially ! with a 30 year time scale. - call get_time(CS%Time, secs, days) - year = (86400.0*days + real(secs)) * Isecs_per_year + year = time_type_to_real(CS%Time) * Isecs_per_year do m=1,CS%ntr if (CS%sfc_growth_rate(m) == 0.0) then diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index fd794aff0b..3b98c19a73 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -14,7 +14,7 @@ module oil_tracer use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type, time_type_to_real use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init @@ -334,7 +334,6 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified real :: Isecs_per_year = 1.0 / (365.0*86400.0) real :: year, h_total, ldecay - integer :: secs, days integer :: i, j, k, is, ie, js, je, nz, m, k_max is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -356,10 +355,7 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS enddo endif - ! Set the surface value of tracer 1 to increase exponentially - ! with a 30 year time scale. - call get_time(CS%Time, secs, days) - year = (86400.0*days + real(secs)) * Isecs_per_year + year = time_type_to_real(CS%Time) * Isecs_per_year ! Decay tracer (limit decay rate to 1/dt - just in case) do m=2,CS%ntr diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index fb0d38d86a..d9f4d3f682 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -16,7 +16,7 @@ module pseudo_salt_tracer use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 966fa07410..bf6b504658 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -14,7 +14,7 @@ module USER_tracer_example use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 27168618be..edcdb002cf 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -12,7 +12,7 @@ module BFB_surface_forcing use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, read_data use MOM_safe_alloc, only : safe_alloc_ptr -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_time_manager, only : time_type, operator(+), operator(/) use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS use MOM_variables, only : surface diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index eeda2e267f..8cf56a42ac 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -17,7 +17,7 @@ module Kelvin_initialization use MOM_open_boundary, only : OBC_DIRECTION_S, OBC_DIRECTION_W use MOM_open_boundary, only : OBC_registry_type use MOM_verticalGrid, only : verticalGrid_type -use MOM_time_manager, only : time_type, set_time, time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real implicit none ; private diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index c361a37176..05ea1edd88 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -18,8 +18,8 @@ module MOM_controlled_forcing use MOM_io, only : vardesc, var_desc use MOM_restart, only : register_restart_field, MOM_restart_CS use MOM_time_manager, only : time_type, operator(+), operator(/), operator(-) -use MOM_time_manager, only : get_time, get_date, set_time, set_date -use MOM_time_manager, only : time_type_to_real +use MOM_time_manager, only : get_date, set_date +use MOM_time_manager, only : time_type_to_real, real_to_time_type use MOM_variables, only : surface implicit none ; private @@ -121,7 +121,7 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec if (.not.associated(CS)) return if ((CS%num_cycle <= 0) .and. (.not.CS%do_integrated)) return - day_end = day_start + set_time(floor(dt+0.5)) + day_end = day_start + real_to_time_type(dt) do j=js,je ; do i=is,ie virt_heat(i,j) = 0.0 ; virt_precip(i,j) = 0.0 diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 950fe4729d..5a1be3f50b 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -12,8 +12,8 @@ module MOM_wave_interface use MOM_grid, only : ocean_grid_type use MOM_verticalgrid, only : verticalGrid_type use MOM_safe_alloc, only : safe_alloc_ptr -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time,& - time_type_to_real,real_to_time_type +use MOM_time_manager, only : time_type, operator(+), operator(/) +use MOM_time_manager, only : time_type_to_real, real_to_time_type use MOM_variables, only : thermo_var_ptrs, surface use data_override_mod, only : data_override_init, data_override diff --git a/src/user/SCM_CVmix_tests.F90 b/src/user/SCM_CVmix_tests.F90 index 2f2026c848..fca5ffa1d2 100644 --- a/src/user/SCM_CVmix_tests.F90 +++ b/src/user/SCM_CVmix_tests.F90 @@ -8,11 +8,10 @@ module SCM_CVMix_tests use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_forcing_type, only : forcing, mech_forcing use MOM_grid, only : ocean_grid_type -use MOM_verticalgrid, only: verticalGrid_type +use MOM_verticalgrid, only : verticalGrid_type use MOM_safe_alloc, only : safe_alloc_ptr -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time,& - time_type_to_real -use MOM_variables, only : thermo_var_ptrs, surface +use MOM_time_manager, only : time_type, operator(+), operator(/), time_type_to_real +use MOM_variables, only : thermo_var_ptrs, surface implicit none ; private #include diff --git a/src/user/SCM_idealized_hurricane.F90 b/src/user/SCM_idealized_hurricane.F90 index f688c40ec6..2bb04b30f9 100644 --- a/src/user/SCM_idealized_hurricane.F90 +++ b/src/user/SCM_idealized_hurricane.F90 @@ -10,8 +10,7 @@ module SCM_idealized_hurricane use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing use MOM_grid, only : ocean_grid_type use MOM_safe_alloc, only : safe_alloc_ptr -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time,& - time_type_to_real +use MOM_time_manager, only : time_type, operator(+), operator(/), time_type_to_real use MOM_variables, only : thermo_var_ptrs, surface use MOM_verticalGrid, only : verticalGrid_type diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index 0718ceb09c..d206914e2a 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -162,6 +162,7 @@ subroutine dumbbell_dynamic_forcing(state, fluxes, day, dt, G, CS) call get_time(day,isecs,idays) rdays = real(idays) + real(isecs)/8.64e4 + ! This could be: rdays = time_type_to_real(day)/8.64e4 ! Allocate and zero out the forcing arrays, as necessary. call safe_alloc_ptr(fluxes%p_surf, isd, ied, jsd, jed) diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90 index 133b5388cb..cb1b9a6b2f 100644 --- a/src/user/dyed_channel_initialization.F90 +++ b/src/user/dyed_channel_initialization.F90 @@ -11,7 +11,7 @@ module dyed_channel_initialization use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE use MOM_open_boundary, only : OBC_segment_type, register_segment_tracer use MOM_open_boundary, only : OBC_registry_type, register_OBC -use MOM_time_manager, only : time_type, set_time, time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real use MOM_tracer_registry, only : tracer_registry_type, tracer_name_lookup use MOM_tracer_registry, only : tracer_type use MOM_variables, only : thermo_var_ptrs diff --git a/src/user/shelfwave_initialization.F90 b/src/user/shelfwave_initialization.F90 index 1640c9ec5a..9207830032 100644 --- a/src/user/shelfwave_initialization.F90 +++ b/src/user/shelfwave_initialization.F90 @@ -11,7 +11,7 @@ module shelfwave_initialization use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_DIRECTION_W use MOM_open_boundary, only : OBC_segment_type, register_OBC use MOM_open_boundary, only : OBC_registry_type -use MOM_time_manager, only : time_type, set_time, time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real implicit none ; private diff --git a/src/user/supercritical_initialization.F90 b/src/user/supercritical_initialization.F90 index 6b10664d57..f12378c3d9 100644 --- a/src/user/supercritical_initialization.F90 +++ b/src/user/supercritical_initialization.F90 @@ -9,7 +9,7 @@ module supercritical_initialization use MOM_grid, only : ocean_grid_type use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE, OBC_segment_type use MOM_verticalGrid, only : verticalGrid_type -use MOM_time_manager, only : time_type, set_time, time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real implicit none ; private diff --git a/src/user/tidal_bay_initialization.F90 b/src/user/tidal_bay_initialization.F90 index 7726dbf171..161ad25c11 100644 --- a/src/user/tidal_bay_initialization.F90 +++ b/src/user/tidal_bay_initialization.F90 @@ -13,7 +13,7 @@ module tidal_bay_initialization use MOM_open_boundary, only : OBC_segment_type, register_OBC use MOM_open_boundary, only : OBC_registry_type use MOM_verticalGrid, only : verticalGrid_type -use MOM_time_manager, only : time_type, set_time, time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real implicit none ; private diff --git a/src/user/user_revise_forcing.F90 b/src/user/user_revise_forcing.F90 index f2e381cc4a..d1be729734 100644 --- a/src/user/user_revise_forcing.F90 +++ b/src/user/user_revise_forcing.F90 @@ -10,7 +10,7 @@ module user_revise_forcing use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, read_data use MOM_restart, only : register_restart_field, MOM_restart_CS -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_time_manager, only : time_type, operator(+), operator(/) use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS use MOM_variables, only : surface From 5f6384cbeb921dea08b44fcaca336f523c9b7420 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 14 Aug 2018 16:25:09 -0400 Subject: [PATCH 0648/1072] (*)Corrected time units in MOM6 restart files The previous commit wrote and read the real time written to the restart files in seconds, not units of days (86400 seconds) as was traditionally done. This meant that while the restarts were internally consistent, they were incompatible with the restart files from any other versions of MOM6. The real times written to and read from the restart files have been reverted to be in days (i.e. 86400 seconds). All answers are bitwise identical. --- src/framework/MOM_restart.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 436d514125..e491c297aa 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -808,7 +808,7 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV) next_var = 0 nz = 1 ; if (present(GV)) nz = GV%ke - restart_time = time_type_to_real(time) + restart_time = time_type_to_real(time) / 86400.0 restartname = trim(CS%restartfile) if (present(filename)) restartname = trim(filename) @@ -1027,7 +1027,7 @@ subroutine restore_state(filename, directory, day, G, CS) t1 = time_vals(1) deallocate(time_vals) - day = real_to_time_type(t1) + day = real_to_time_type(t1*86400.0) exit enddo From f579e9ee1d8a27f7ddc7535bca003213aaf0ce84 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 15 Aug 2018 10:41:18 -0400 Subject: [PATCH 0649/1072] +(*)Add real_to_time Added an alternate implementation of the FMS function real_to_time_type that is accurate over a larger range of input values. With 32 bit signed integers, this new version should work over the entire valid range (2^31 days or ~5.8835 million years) of time_types, whereas the standard version in the FMS time_manager stops working correctly for conversions of times greater than 2^31 seconds (~68.1 years). At some point the FMS version should be upgraded, at which point real_to_time could become a wrapper to the FMS version. All answers in the test cases are bitwise identical, but there is a new public interface. --- src/framework/MOM_time_manager.F90 | 30 ++++++++++++++++++++++++++++-- 1 file changed, 28 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_time_manager.F90 b/src/framework/MOM_time_manager.F90 index 25c367c1ef..229c3ded3a 100644 --- a/src/framework/MOM_time_manager.F90 +++ b/src/framework/MOM_time_manager.F90 @@ -20,8 +20,9 @@ module MOM_time_manager implicit none ; private -public :: time_type, get_time, set_time, time_type_to_real, real_to_time_type -public :: set_ticks_per_second , get_ticks_per_second +public :: time_type, get_time, set_time +public :: time_type_to_real, real_to_time_type, real_to_time +public :: set_ticks_per_second, get_ticks_per_second public :: operator(+), operator(-), operator(*), operator(/) public :: operator(>), operator(<), operator(>=), operator(<=) public :: operator(==), operator(/=), operator(//) @@ -35,4 +36,29 @@ module MOM_time_manager public :: get_external_field_axes public :: get_external_field_missing +contains + +!> This is an alternate implementation of the FMS function real_to_time_type that is accurate over +!! a larger range of input values. With 32 bit signed integers, this version should work over the +!! entire valid range (2^31 days or ~5.8835 million years) of time_types, whereas the standard +!! version in the FMS time_manager stops working for conversions of times greater than 2^31 seconds, +!! or ~68.1 years. +function real_to_time(x, err_msg) + type(time_type) :: real_to_time !< The output time as a time_type + real, intent(in) :: x !< The input time in real seconds. + character(len=*), intent(out), optional :: err_msg !< An optional returned error message. + + ! Local variables + integer :: seconds, days, ticks + real :: real_subsecond_remainder + + days = floor(x/86400.) + seconds = floor(x - 86400.*days) + real_subsecond_remainder = x - (days*86400. + seconds) + ticks = nint(real_subsecond_remainder * get_ticks_per_second()) + + real_to_time = set_time(seconds=seconds, days=days, ticks=ticks, err_msg=err_msg) +end function real_to_time + + end module MOM_time_manager From 97479d85f5745716d9e519173ba4b84fa2fcf513 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 15 Aug 2018 10:54:41 -0400 Subject: [PATCH 0650/1072] (*)Use real_to_time Use the new function real_to_time in place of the equivalent FMS function real_to_time_type throughout the MOM6 code. In some cases, the module use statements needed to be change dto go via the MOM_time_manager, rather than directly to the FMS time_manager_mod. All answers in the test cases are bitwise identical, and any problems with long times due to the previous commit using real_to_time_type should be averted. --- src/core/MOM.F90 | 34 +++++++++---------- src/core/MOM_barotropic.F90 | 6 ++-- src/core/MOM_dynamics_unsplit.F90 | 4 +-- src/framework/MOM_file_parser.F90 | 6 ++-- src/framework/MOM_restart.F90 | 4 +-- src/ice_shelf/MOM_ice_shelf.F90 | 6 ++-- .../vertical/MOM_diabatic_driver.F90 | 6 ++-- src/user/MOM_controlled_forcing.F90 | 4 +-- src/user/MOM_wave_interface.F90 | 1 - 9 files changed, 35 insertions(+), 36 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index bf47d7b08c..cccc460751 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -39,7 +39,7 @@ module MOM use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, is_new_run, MOM_restart_CS use MOM_spatial_means, only : global_mass_integral -use MOM_time_manager, only : time_type, real_to_time_type, time_type_to_real, operator(+) +use MOM_time_manager, only : time_type, real_to_time, time_type_to_real, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) use MOM_time_manager, only : operator(>=), increment_date use MOM_unit_tests, only : unit_tests @@ -556,7 +556,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & do j=js,je ; do i=is,ie ; CS%ssh_rint(i,j) = 0.0 ; enddo ; enddo if (associated(CS%VarMix)) then - call enable_averaging(cycle_time, Time_start + real_to_time_type(cycle_time), & + call enable_averaging(cycle_time, Time_start + real_to_time(cycle_time), & CS%diag) call calc_resoln_function(h, CS%tv, G, GV, CS%VarMix) call disable_averaging(CS%diag) @@ -582,7 +582,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (CS%UseWaves) then ! Update wave information, which is presently kept static over each call to step_mom - call enable_averaging(time_interval, Time_start + real_to_time_type(time_interval), CS%diag) + call enable_averaging(time_interval, Time_start + real_to_time(time_interval), CS%diag) call Update_Stokes_Drift(G, GV, Waves, h, forces%ustar) call disable_averaging(CS%diag) endif @@ -604,9 +604,9 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & do n=1,n_max rel_time = rel_time + dt ! The relative time at the end of the step. ! Set the universally visible time to the middle of the time step. - CS%Time = Time_start + real_to_time_type(rel_time - 0.5*dt) + CS%Time = Time_start + real_to_time(rel_time - 0.5*dt) ! Set the local time to the end of the time step. - Time_local = Time_start + real_to_time_type(rel_time) + Time_local = Time_start + real_to_time(rel_time) if (showCallTree) call callTree_enter("DT cycles (step_MOM) n=",n) @@ -633,10 +633,10 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (dtdia > dt) then ! If necessary, temporarily reset CS%Time to the center of the period covered ! by the call to step_MOM_thermo, noting that they begin at the same time. - CS%Time = CS%Time + real_to_time_type(0.5*(dtdia-dt)) + CS%Time = CS%Time + real_to_time(0.5*(dtdia-dt)) ! The end-time of the diagnostic interval needs to be set ahead if there ! are multiple dynamic time steps worth of thermodynamics applied here. - end_time_thermo = Time_local + real_to_time_type(dtdia-dt) + end_time_thermo = Time_local + real_to_time(dtdia-dt) endif ! Apply diabatic forcing, do mixing, and regrid. @@ -649,7 +649,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (showCallTree) call callTree_waypoint("finished diabatic_first (step_MOM)") if (dtdia > dt) & ! Reset CS%Time to its previous value. - CS%Time = Time_start + real_to_time_type(rel_time - 0.5*dt) + CS%Time = Time_start + real_to_time(rel_time - 0.5*dt) endif ! end of block "(CS%diabatic_first .and. (CS%t_dyn_rel_adv==0.0))" if (do_dyn) then @@ -731,7 +731,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ! If necessary, temporarily reset CS%Time to the center of the period covered ! by the call to step_MOM_thermo, noting that they end at the same time. - if (dtdia > dt) CS%Time = CS%Time - real_to_time_type(0.5*(dtdia-dt)) + if (dtdia > dt) CS%Time = CS%Time - real_to_time(0.5*(dtdia-dt)) ! Apply diabatic forcing, do mixing, and regrid. call step_MOM_thermo(CS, G, GV, u, v, h, CS%tv, fluxes, dtdia, & @@ -740,7 +740,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & CS%t_dyn_rel_thermo = 0.0 if (dtdia > dt) & ! Reset CS%Time to its previous value. - CS%Time = Time_start + real_to_time_type(rel_time - 0.5*dt) + CS%Time = Time_start + real_to_time(rel_time - 0.5*dt) endif if (do_dyn) then @@ -774,7 +774,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & CS%t_dyn_rel_diag = 0.0 call cpu_clock_begin(id_clock_Z_diag) - if (Time_local + real_to_time_type(0.5*dt_therm) > CS%Z_diag_time) then + if (Time_local + real_to_time(0.5*dt_therm) > CS%Z_diag_time) then call enable_averaging(real(time_type_to_real(CS%Z_diag_interval)), & CS%Z_diag_time, CS%diag) !### This is the one place where fluxes might used if do_thermo=.false. Is this correct? @@ -852,7 +852,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (MOM_state_is_synchronized(CS)) & call write_energy(CS%u, CS%v, CS%h, CS%tv, Time_local, CS%nstep_tot, & G, GV, CS%sum_output_CSp, CS%tracer_flow_CSp, & - dt_forcing=real_to_time_type(time_interval) ) + dt_forcing=real_to_time(time_interval) ) call cpu_clock_end(id_clock_other) @@ -912,7 +912,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if ((CS%t_dyn_rel_adv == 0.0) .and. CS%thickness_diffuse .and. CS%thickness_diffuse_first) then - call enable_averaging(dt_thermo, Time_local+real_to_time_type(dt_thermo-dt), CS%diag) + call enable_averaging(dt_thermo, Time_local+real_to_time(dt_thermo-dt), CS%diag) call cpu_clock_begin(id_clock_thick_diff) if (associated(CS%VarMix)) & call calc_slope_functions(h, CS%tv, dt, G, GV, CS%VarMix) @@ -931,7 +931,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & ! The bottom boundary layer properties need to be recalculated. if (bbl_time_int > 0.0) then call enable_averaging(bbl_time_int, & - Time_local + real_to_time_type(bbl_time_int-dt), CS%diag) + Time_local + real_to_time(bbl_time_int-dt), CS%diag) ! Calculate the BBL properties and store them inside visc (u,h). call cpu_clock_begin(id_clock_BBL_visc) call set_viscous_BBL(CS%u, CS%v, CS%h, CS%tv, CS%visc, G, GV, & @@ -2286,7 +2286,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%OBC, CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, & CS%visc, dirs, CS%ntrunc, calc_dtbt=calc_dtbt) if (CS%dtbt_reset_period > 0.0) then - CS%dtbt_reset_interval = real_to_time_type(CS%dtbt_reset_period) + CS%dtbt_reset_interval = real_to_time(CS%dtbt_reset_period) ! Set dtbt_reset_time to be the next even multiple of dtbt_reset_interval. CS%dtbt_reset_time = Time_init + CS%dtbt_reset_interval * & ((Time - Time_init) / CS%dtbt_reset_interval) @@ -2325,10 +2325,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & param_file, diag, CS%diagnostics_CSp, CS%tv) call diag_copy_diag_to_storage(CS%diag_pre_sync, CS%h, CS%diag) - CS%Z_diag_interval = real_to_time_type(CS%dt_therm * max(1,floor(0.01 + Z_diag_int/CS%dt_therm))) + CS%Z_diag_interval = real_to_time(CS%dt_therm * max(1,floor(0.01 + Z_diag_int/CS%dt_therm))) call MOM_diag_to_Z_init(Time, G, GV, param_file, diag, CS%diag_to_Z_CSp) CS%Z_diag_time = Start_time + CS%Z_diag_interval * (1 + & - ((Time + real_to_time_type(CS%dt_therm)) - Start_time) / CS%Z_diag_interval) + ((Time + real_to_time(CS%dt_therm)) - Start_time) / CS%Z_diag_interval) if (associated(CS%sponge_CSp)) & call init_sponge_diags(Time, G, diag, CS%sponge_CSp) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index c423b2d0c1..674f6f1bff 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -22,7 +22,7 @@ module MOM_barotropic use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S, OBC_segment_type use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_tidal_forcing, only : tidal_forcing_sensitivity, tidal_forcing_CS -use MOM_time_manager, only : time_type, real_to_time_type, operator(+), operator(-) +use MOM_time_manager, only : time_type, real_to_time, operator(+), operator(-) use MOM_variables, only : BT_cont_type, alloc_bt_cont_type use MOM_verticalGrid, only : verticalGrid_type @@ -723,7 +723,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & (CS%id_uhbt_hifreq > 0) .or. (CS%id_vhbt_hifreq > 0)) then do_hifreq_output = query_averaging_enabled(CS%diag, time_int_in, time_end_in) if (do_hifreq_output) & - time_bt_start = time_end_in - real_to_time_type(dt) + time_bt_start = time_end_in - real_to_time(dt) endif !--- begin setup for group halo update @@ -2008,7 +2008,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & enddo ; enddo if (do_hifreq_output) then - time_step_end = time_bt_start + real_to_time_type(n*dtbt) + time_step_end = time_bt_start + real_to_time(n*dtbt) call enable_averaging(dtbt, time_step_end, CS%diag) if (CS%id_ubt_hifreq > 0) call post_data(CS%id_ubt_hifreq, ubt(IsdB:IedB,jsd:jed), CS%diag) if (CS%id_vbt_hifreq > 0) call post_data(CS%id_vbt_hifreq, vbt(isd:ied,JsdB:JedB), CS%diag) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 506dd3624b..3965758510 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -72,7 +72,7 @@ module MOM_dynamics_unsplit use MOM_io, only : MOM_io_init use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, MOM_restart_CS -use MOM_time_manager, only : time_type, real_to_time_type, operator(+) +use MOM_time_manager, only : time_type, real_to_time, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) use MOM_ALE, only : ALE_CS @@ -267,7 +267,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) - call enable_averaging(0.5*dt,Time_local-real_to_time_type(0.5*dt), CS%diag) + call enable_averaging(0.5*dt,Time_local-real_to_time(0.5*dt), CS%diag) ! Here the first half of the thickness fluxes are offered for averaging. if (CS%id_uh > 0) call post_data(CS%id_uh, uh, CS%diag) if (CS%id_vh > 0) call post_data(CS%id_vh, vh, CS%diag) diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index 70f3b9a941..72944c4f7a 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -7,7 +7,7 @@ module MOM_file_parser use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg use MOM_error_handler, only : is_root_pe, stdlog, stdout use MOM_time_manager, only : get_time, time_type, get_ticks_per_second -use MOM_time_manager, only : set_date, get_date, real_to_time_type +use MOM_time_manager, only : set_date, get_date, real_to_time, operator(-), set_time use MOM_document, only : doc_param, doc_module, doc_init, doc_end, doc_type use MOM_document, only : doc_openBlock, doc_closeBlock use MOM_string_functions, only : left_int, left_ints, slasher @@ -854,8 +854,8 @@ subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing, date_f else time_unit = 1.0 ; if (present(timeunit)) time_unit = timeunit read( value_string(1), *) real_time - value = real_to_time_type(real_time*time_unit) - endif + value = real_to_time(real_time*time_unit) + endif else if (present(fail_if_missing)) then ; if (fail_if_missing) then if (.not.found) then diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index e491c297aa..8d5819f945 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -14,7 +14,7 @@ module MOM_restart use MOM_io, only : vardesc, var_desc, query_vardesc, modify_vardesc use MOM_io, only : MULTIPLE, NETCDF_FILE, READONLY_FILE, SINGLE_FILE use MOM_io, only : CENTER, CORNER, NORTH_FACE, EAST_FACE -use MOM_time_manager, only : time_type, time_type_to_real, real_to_time_type +use MOM_time_manager, only : time_type, time_type_to_real, real_to_time use MOM_time_manager, only : days_in_month, get_date, set_date use MOM_verticalGrid, only : verticalGrid_type use mpp_mod, only: mpp_chksum @@ -1027,7 +1027,7 @@ subroutine restore_state(filename, directory, day, G, CS) t1 = time_vals(1) deallocate(time_vals) - day = real_to_time_type(t1*86400.0) + day = real_to_time(t1*86400.0) exit enddo diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 7e3c4ac606..e6989caa54 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -25,7 +25,7 @@ module MOM_ice_shelf use MOM_io, only : write_field, close_file, SINGLE_FILE, MULTIPLE use MOM_restart, only : register_restart_field, query_initialized, save_restart use MOM_restart, only : restart_init, restore_state, MOM_restart_CS -use MOM_time_manager, only : time_type, time_type_to_real +use MOM_time_manager, only : time_type, time_type_to_real, time_type_to_real, real_to_time use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid use MOM_variables, only : surface use MOM_forcing_type, only : forcing, allocate_forcing_type, MOM_forcing_chksum @@ -47,7 +47,7 @@ module MOM_ice_shelf use MOM_checksums, only : hchksum, qchksum, chksum, uchksum, vchksum, uvchksum use time_interp_external_mod, only : init_external_field, time_interp_external use time_interp_external_mod, only : time_interp_external_init -use time_manager_mod, only : print_time, time_type_to_real, real_to_time_type +use time_manager_mod, only : print_time implicit none ; private #include @@ -979,7 +979,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) ! just compute changes in mass after first time step if (t0>0.0) then - Time0 = real_to_time_type(t0) + Time0 = real_to_time(t0) last_hmask(:,:) = ISS%hmask(:,:) ; last_area_shelf_h(:,:) = ISS%area_shelf_h(:,:) call time_interp_external(CS%id_read_mass, Time0, last_mass_shelf) last_h_shelf = last_mass_shelf/CS%density_ice diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 846e27de8b..e3806fd684 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -61,7 +61,7 @@ module MOM_diabatic_driver use MOM_shortwave_abs, only : absorbRemainingSW, optics_type use MOM_sponge, only : apply_sponge, sponge_CS use MOM_ALE_sponge, only : apply_ALE_sponge, ALE_sponge_CS -use MOM_time_manager, only : time_type, real_to_time_type, operator(-), operator(<=) +use MOM_time_manager, only : time_type, real_to_time, operator(-), operator(<=) use MOM_tracer_flow_control, only : call_tracer_column_fns, tracer_flow_control_CS use MOM_tracer_diabatic, only : tracer_vertdiff use MOM_variables, only : thermo_var_ptrs, vertvisc_type, accel_diag_ptrs @@ -439,7 +439,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! the end of the diabatic processes. if (associated(tv%T) .AND. associated(tv%frazil)) then ! For frazil diagnostic, the first call covers the first half of the time step - call enable_averaging(0.5*dt, Time_end - real_to_time_type(0.5*dt), CS%diag) + call enable_averaging(0.5*dt, Time_end - real_to_time(0.5*dt), CS%diag) if (CS%frazil_tendency_diag) then do k=1,nz ; do j=js,je ; do i=is,ie temp_diag(i,j,k) = tv%T(i,j,k) @@ -1315,7 +1315,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! the end of the diabatic processes. if (associated(tv%T) .AND. associated(tv%frazil)) then ! For frazil diagnostic, the first call covers the first half of the time step - call enable_averaging(0.5*dt, Time_end - real_to_time_type(0.5*dt), CS%diag) + call enable_averaging(0.5*dt, Time_end - real_to_time(0.5*dt), CS%diag) if (CS%frazil_tendency_diag) then do k=1,nz ; do j=js,je ; do i=is,ie temp_diag(i,j,k) = tv%T(i,j,k) diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index 05ea1edd88..2034a16bb4 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -19,7 +19,7 @@ module MOM_controlled_forcing use MOM_restart, only : register_restart_field, MOM_restart_CS use MOM_time_manager, only : time_type, operator(+), operator(/), operator(-) use MOM_time_manager, only : get_date, set_date -use MOM_time_manager, only : time_type_to_real, real_to_time_type +use MOM_time_manager, only : time_type_to_real, real_to_time use MOM_variables, only : surface implicit none ; private @@ -121,7 +121,7 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec if (.not.associated(CS)) return if ((CS%num_cycle <= 0) .and. (.not.CS%do_integrated)) return - day_end = day_start + real_to_time_type(dt) + day_end = day_start + real_to_time(dt) do j=js,je ; do i=is,ie virt_heat(i,j) = 0.0 ; virt_precip(i,j) = 0.0 diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 5a1be3f50b..c8ce37ad55 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -13,7 +13,6 @@ module MOM_wave_interface use MOM_verticalgrid, only : verticalGrid_type use MOM_safe_alloc, only : safe_alloc_ptr use MOM_time_manager, only : time_type, operator(+), operator(/) -use MOM_time_manager, only : time_type_to_real, real_to_time_type use MOM_variables, only : thermo_var_ptrs, surface use data_override_mod, only : data_override_init, data_override From dba64e84b02cb9e0174dcaacb9881c2139c2f15e Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 15 Aug 2018 14:14:29 -0800 Subject: [PATCH 0651/1072] Fix to soliton initialization. - Now seems to work with PR #833. --- src/user/soliton_initialization.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index c9e7eec40e..6f4b2898c5 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -53,7 +53,7 @@ subroutine soliton_initialize_thickness(h, G, GV) y = G%geoLatT(i,j)-y0 val3 = exp(-val1*x) val4 = val2*((2.0*val3/(1.0+(val3*val3)))**2) - h(i,j,k) = GV%m_to_H * (0.25*val4 * (6.0*y*y+3.0) * exp(-0.5*y*y)) + h(i,j,k) = GV%m_to_H * (0.25*val4 * (6.0*y*y+3.0) * exp(-0.5*y*y)) + G%bathyT(i,j) enddo enddo ; enddo From 22fbe6f3ae20f84da850e5f87438f72a1d9813d3 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 15 Aug 2018 14:19:56 -0800 Subject: [PATCH 0652/1072] Fix soliton initialization with GV%m_to_H --- src/user/soliton_initialization.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index 6f4b2898c5..e258b87bf1 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -53,7 +53,7 @@ subroutine soliton_initialize_thickness(h, G, GV) y = G%geoLatT(i,j)-y0 val3 = exp(-val1*x) val4 = val2*((2.0*val3/(1.0+(val3*val3)))**2) - h(i,j,k) = GV%m_to_H * (0.25*val4 * (6.0*y*y+3.0) * exp(-0.5*y*y)) + G%bathyT(i,j) + h(i,j,k) = GV%m_to_H * (0.25*val4 * (6.0*y*y+3.0) * exp(-0.5*y*y) + G%bathyT(i,j)) enddo enddo ; enddo From 731f2cfb72b0b8e5129aed752406ce6535608889 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 16 Aug 2018 18:23:12 -0400 Subject: [PATCH 0653/1072] Eliminated unused variables in forcing modules Eliminated unused variables, duplicate comment blocks, and module use statements for get_time. All answers are bitwise identical. --- .../solo_driver/Neverland_surface_forcing.F90 | 42 ++++++++--------- .../solo_driver/user_surface_forcing.F90 | 45 +++---------------- 2 files changed, 26 insertions(+), 61 deletions(-) diff --git a/config_src/solo_driver/Neverland_surface_forcing.F90 b/config_src/solo_driver/Neverland_surface_forcing.F90 index 65a5ca1339..e6111b2a19 100644 --- a/config_src/solo_driver/Neverland_surface_forcing.F90 +++ b/config_src/solo_driver/Neverland_surface_forcing.F90 @@ -12,7 +12,7 @@ module Neverland_surface_forcing use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, read_data, slasher -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_time_manager, only : time_type, operator(+), operator(/) use MOM_variables, only : surface implicit none ; private @@ -48,15 +48,15 @@ module Neverland_surface_forcing !! Neverland forcing configuration. subroutine Neverland_wind_forcing(sfc_state, forces, day, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that - !! describe the surface state of the ocean. + !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), intent(in) :: day !< Time used for determining the fluxes. - type(ocean_grid_type), intent(inout) :: G !< Grid structure. - type(Neverland_surface_forcing_CS), pointer :: CS !< Control structure for this module. - ! Local variable + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(Neverland_surface_forcing_CS), pointer :: CS !< Control structure for this module. + + ! Local variables integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - real :: x, y real :: PI real :: tau_max, off @@ -110,26 +110,26 @@ subroutine Neverland_wind_forcing(sfc_state, forces, day, G, CS) end subroutine Neverland_wind_forcing !> Returns the value of a cosine-bell function evaluated at x/L - real function cosbell(x,L) +real function cosbell(x,L) - real , intent(in) :: x !< non-dimensional position - real , intent(in) :: L !< non-dimensional width - real :: PI !< 3.1415926... calculated as 4*atan(1) + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI !< 3.1415926... calculated as 4*atan(1) - PI = 4.0*atan(1.0) - cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) - end function cosbell + PI = 4.0*atan(1.0) + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) +end function cosbell !> Returns the value of a sin-spike function evaluated at x/L - real function spike(x,L) +real function spike(x,L) - real , intent(in) :: x !< non-dimensional position - real , intent(in) :: L !< non-dimensional width - real :: PI !< 3.1415926... calculated as 4*atan(1) + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI !< 3.1415926... calculated as 4*atan(1) - PI = 4.0*atan(1.0) - spike = (1 - sin(PI*MIN(ABS(x/L),0.5))) - end function spike + PI = 4.0*atan(1.0) + spike = (1 - sin(PI*MIN(ABS(x/L),0.5))) +end function spike !> Surface fluxes of buoyancy for the Neverland configurations. diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90 index e0136abf0f..7a27c75e18 100644 --- a/config_src/solo_driver/user_surface_forcing.F90 +++ b/config_src/solo_driver/user_surface_forcing.F90 @@ -12,7 +12,7 @@ module user_surface_forcing use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, read_data -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_time_manager, only : time_type, operator(+), operator(/) use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS use MOM_variables, only : surface @@ -49,30 +49,15 @@ module user_surface_forcing !! direction as the u- and v- velocities.) They are both in Pa. subroutine USER_wind_forcing(sfc_state, forces, day, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that - !! describe the surface state of the ocean. + !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(time_type), intent(in) :: day !< The time of the fluxes type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned !! by a previous call to user_surface_forcing_init -! This subroutine sets the surface wind stresses, forces%taux and forces%tauy. -! These are the stresses in the direction of the model grid (i.e. the same -! direction as the u- and v- velocities.) They are both in Pa. -! In addition, this subroutine can be used to set the surface friction -! velocity, forces%ustar, in m s-1. This is needed with a bulk mixed layer. -! -! Arguments: state - A structure containing fields that describe the -! surface state of the ocean. -! (out) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) day - Time of the fluxes. -! (in) G - The ocean's grid structure. -! (in) CS - A pointer to the control structure returned by a previous -! call to user_surface_forcing_init - + ! Local variables integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB ! When modifying the code, comment out this error message. It is here ! so that the original (unmodified) version is not accidentally used. @@ -81,8 +66,6 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, CS) 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 ! Allocate the forcing arrays, if necessary. call allocate_mech_forcing(G, forces, stress=.true., ustar=.true.) @@ -138,22 +121,12 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! are in W m-2 and positive for heat going into the ocean. All fresh water ! fluxes are in kg m-2 s-1 and positive for water moving into the ocean. -! Arguments: state - A structure containing fields that describe the -! surface state of the ocean. -! (out) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) day_start - Start time of the fluxes. -! (in) day_interval - Length of time over which these fluxes -! will be applied. -! (in) G - The ocean's grid structure. -! (in) CS - A pointer to the control structure returned by a previous -! call to user_surface_forcing_init - + ! Local variables real :: Temp_restore ! The temperature that is being restored toward, in C. real :: Salin_restore ! The salinity that is being restored toward, in PSU. real :: density_restore ! The potential density that is being restored ! toward, in kg m-3. - real :: rhoXcp ! The mean density times the heat capacity, in J m-3 K-1. + real :: rhoXcp ! The mean density times the heat capacity, in J m-3 K-1. real :: buoy_rest_const ! A constant relating density anomalies to the ! restoring buoyancy flux, in m5 s-3 kg-1. @@ -266,14 +239,6 @@ subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS) type(user_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to !! the control structure for this module -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module - ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "user_surface_forcing" ! This module's name. From 904b5fe9b954304bb2537f711a20c9baaaa178d9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 16 Aug 2018 18:24:42 -0400 Subject: [PATCH 0654/1072] +Removed MESO_wind_forcing MESO_wind_forcing was never actually being used, so I eliminated it and removed the call to it from set_forcing. Also eliminated unused variables and simplified the code converting day_interval to dt in set_forcing. Duplicate comment blocks were also eliminated in MESO_forcing.F90. All answers are bitwise identical. --- .../solo_driver/MESO_surface_forcing.F90 | 95 +------------------ .../solo_driver/MOM_surface_forcing.F90 | 33 ++----- 2 files changed, 9 insertions(+), 119 deletions(-) diff --git a/config_src/solo_driver/MESO_surface_forcing.F90 b/config_src/solo_driver/MESO_surface_forcing.F90 index eaa11da6c1..68852f89d9 100644 --- a/config_src/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/solo_driver/MESO_surface_forcing.F90 @@ -12,14 +12,14 @@ module MESO_surface_forcing use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, MOM_read_data, slasher -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_time_manager, only : time_type, operator(+), operator(/) use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS use MOM_variables, only : surface implicit none ; private -public MESO_wind_forcing, MESO_buoyancy_forcing, MESO_surface_forcing_init +public MESO_buoyancy_forcing, MESO_surface_forcing_init !> This control structure is used to store parameters associated with the MESO forcing. type, public :: MESO_surface_forcing_CS ; private @@ -52,71 +52,6 @@ module MESO_surface_forcing contains -!### This subroutine sets zero surface wind stresses, but it is not even -!### used by the MESO experimeents. This subroutine can be deleted. -RWH -subroutine MESO_wind_forcing(sfc_state, forces, day, G, CS) - type(surface), intent(inout) :: sfc_state !< A structure containing fields that - !! describe the surface state of the ocean. - type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), intent(in) :: day !< The time of the fluxes - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(MESO_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by a previous - !! call to MESO_surface_forcing_init - -! This subroutine sets the surface wind stresses, forces%taux and forces%tauy. -! These are the stresses in the direction of the model grid (i.e. the same -! direction as the u- and v- velocities.) They are both in Pa. -! In addition, this subroutine can be used to set the surface friction -! velocity, forces%ustar, in m s-1. This is needed with a bulk mixed layer. -! -! Arguments: state - A structure containing fields that describe the -! surface state of the ocean. -! (out) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) day - Time of the fluxes. -! (in) G - The ocean's grid structure. -! (in) CS - A pointer to the control structure returned by a previous -! call to MESO_surface_forcing_init - - integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - - ! When modifying the code, comment out this error message. It is here - ! so that the original (unmodified) version is not accidentally used. - call MOM_error(FATAL, "MESO_wind_surface_forcing: " // & - "User forcing routine called without modification." ) - - 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 - - ! Allocate the forcing arrays, if necessary. - call allocate_mech_forcing(G, forces, stress=.true., ustar=.true.) - - ! Set the surface wind stresses, in units of Pa. A positive taux - ! accelerates the ocean to the (pseudo-)east. - - ! The i-loop extends to is-1 so that taux can be used later in the - ! calculation of ustar - otherwise the lower bound would be Isq. - do j=js,je ; do I=is-1,Ieq - forces%taux(I,j) = G%mask2dCu(I,j) * 0.0 ! Change this to the desired expression. - enddo ; enddo - do J=js-1,Jeq ; do i=is,ie - forces%tauy(i,J) = G%mask2dCv(i,J) * 0.0 ! Change this to the desired expression. - enddo ; enddo - - ! Set the surface friction velocity, in units of m s-1. ustar - ! is always positive. - if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & - sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & - 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) - enddo ; enddo ; endif - -end subroutine MESO_wind_forcing - !> This subroutine sets up the MESO buoyancy forcing, which uses control-theory style !! specification restorative buoyancy fluxes at large scales. subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) @@ -130,10 +65,6 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) type(MESO_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by !! a previous call to MESO_surface_forcing_init -! This subroutine specifies the current surface fluxes of buoyancy or -! temperature and fresh water. It may also be modified to add -! surface fluxes of user provided tracers. - ! When temperature is used, there are long list of fluxes that need to be ! set - essentially the same as for a full coupled model, but most of these ! can be simply set to zero. The net fresh water flux should probably be @@ -144,17 +75,6 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! are in W m-2 and positive for heat going into the ocean. All fresh water ! fluxes are in kg m-2 s-1 and positive for water moving into the ocean. -! Arguments: state - A structure containing fields that describe the -! surface state of the ocean. -! (out) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) day_start - Start time of the fluxes. -! (in) day_interval - Length of time over which these fluxes -! will be applied. -! (in) G - The ocean's grid structure. -! (in) CS - A pointer to the control structure returned by a previous -! call to MESO_surface_forcing_init - real :: Temp_restore ! The temperature that is being restored toward, in C. real :: Salin_restore ! The salinity that is being restored toward, in PSU. real :: density_restore ! The potential density that is being restored @@ -293,14 +213,6 @@ subroutine MESO_surface_forcing_init(Time, G, param_file, diag, CS) type(MESO_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module - ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MESO_surface_forcing" ! This module's name. @@ -383,9 +295,6 @@ end subroutine MESO_surface_forcing_init !! it is probably a good idea to read the forcing from input files !! using "file" for WIND_CONFIG and BUOY_CONFIG. !! -!! MESO_wind_forcing should set the surface wind stresses (taux and -!! tauy) perhaps along with the surface friction velocity (ustar). -!! !! MESO_buoyancy forcing is used to set the surface buoyancy !! forcing, which may include a number of fresh water flux fields !! (evap, liq_precip, froz_precip, liq_runoff, froz_runoff, and diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 351b149830..a3a9a12204 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -32,11 +32,11 @@ module MOM_surface_forcing use MOM_io, only : EAST_FACE, NORTH_FACE, num_timelevels use MOM_restart, only : register_restart_field, restart_init, MOM_restart_CS use MOM_restart, only : restart_init_end, save_restart, restore_state -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time, set_time +use MOM_time_manager, only : time_type, operator(+), operator(/), get_time, time_type_to_real use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS use MOM_variables, only : surface -use MESO_surface_forcing, only : MESO_wind_forcing, MESO_buoyancy_forcing +use MESO_surface_forcing, only : MESO_buoyancy_forcing use MESO_surface_forcing, only : MESO_surface_forcing_init, MESO_surface_forcing_CS use Neverland_surface_forcing, only : Neverland_wind_forcing, Neverland_buoyancy_forcing use Neverland_surface_forcing, only : Neverland_surface_forcing_init, Neverland_surface_forcing_CS @@ -226,7 +226,6 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS ! Local variables real :: dt ! length of time in seconds over which fluxes applied type(time_type) :: day_center ! central time of the fluxes. - integer :: intdt integer :: isd, ied, jsd, jed isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -234,8 +233,7 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call callTree_enter("set_forcing, MOM_surface_forcing.F90") day_center = day_start + day_interval/2 - call get_time(day_interval, intdt) - dt = real(intdt) + dt = time_type_to_real(day_interval) if (CS%first_call_set_forcing) then ! Allocate memory for the mechanical and thermodyanmic forcing fields. @@ -275,8 +273,6 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call wind_forcing_const(sfc_state, forces, 0., 0., day_center, G, CS) elseif (trim(CS%wind_config) == "const") then call wind_forcing_const(sfc_state, forces, CS%tau_x0, CS%tau_y0, day_center, G, CS) - elseif (trim(CS%wind_config) == "MESO") then - call MESO_wind_forcing(sfc_state, forces, day_center, G, CS%MESO_forcing_CSp) elseif (trim(CS%wind_config) == "Neverland") then call Neverland_wind_forcing(sfc_state, forces, day_center, G, CS%Neverland_forcing_CSp) elseif (trim(CS%wind_config) == "SCM_ideal_hurr") then @@ -369,13 +365,10 @@ subroutine wind_forcing_const(sfc_state, forces, tau_x0, tau_y0, day, G, CS) ! Local variables real :: mag_tau integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB call callTree_enter("wind_forcing_const, MOM_surface_forcing.F90") 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 !set steady surface wind stresses, in units of Pa. mag_tau = sqrt( tau_x0**2 + tau_y0**2) @@ -414,13 +407,10 @@ subroutine wind_forcing_2gyre(sfc_state, forces, day, G, CS) ! Local variables real :: PI integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB call callTree_enter("wind_forcing_2gyre, MOM_surface_forcing.F90") 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 !set the steady surface wind stresses, in units of Pa. PI = 4.0*atan(1.0) @@ -450,13 +440,10 @@ subroutine wind_forcing_1gyre(sfc_state, forces, day, G, CS) ! Local variables real :: PI integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB call callTree_enter("wind_forcing_1gyre, MOM_surface_forcing.F90") 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 ! set the steady surface wind stresses, in units of Pa. PI = 4.0*atan(1.0) @@ -484,25 +471,22 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, CS) ! Local variables real :: PI, y integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB call callTree_enter("wind_forcing_gyres, MOM_surface_forcing.F90") 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 ! steady surface wind stresses (Pa) PI = 4.0*atan(1.0) - do j=jsd,jed ; do I=is-1,IedB + do j=js-1,je+1 ; do I=is-1,Ieq y = (G%geoLatCu(I,j)-CS%South_lat)/CS%len_lat forces%taux(I,j) = CS%gyres_taux_const + & ( CS%gyres_taux_sin_amp*sin(CS%gyres_taux_n_pis*PI*y) & + CS%gyres_taux_cos_amp*cos(CS%gyres_taux_n_pis*PI*y) ) enddo ; enddo - do J=js-1,JedB ; do i=isd,ied + do J=js-1,Jeq ; do i=is-1,ie+1 forces%tauy(i,J) = 0.0 enddo ; enddo @@ -535,16 +519,13 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, CS) integer :: time_lev ! The time level that is used for a field. integer :: days, seconds integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB logical :: read_Ustar call callTree_enter("wind_forcing_from_file, MOM_surface_forcing.F90") 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 - call get_time(day,seconds,days) + call get_time(day, seconds, days) time_lev_daily = days - 365*floor(real(days) / 365.0) if (time_lev_daily < 31) then ; time_lev_monthly = 0 @@ -774,7 +755,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) Irho0 = 1.0/CS%Rho0 ! Read the buoyancy forcing file - call get_time(day,seconds,days) + call get_time(day, seconds, days) time_lev_daily = days - 365*floor(real(days) / 365.0) From 396e19348e20764b07f402db17be293615d4bb4c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 16 Aug 2018 18:25:30 -0400 Subject: [PATCH 0655/1072] (*)Use real_to_time in driver code Replaced real_to_time_type with real_to_time in the coupled and ocean-only driver code to avoid problems when converting large times. All answers are bitwise identical in the test cases. --- config_src/coupled_driver/ocean_model_MOM.F90 | 6 +++--- config_src/solo_driver/MOM_driver.F90 | 20 +++++++++---------- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 742688506f..70437d0e4c 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -40,7 +40,7 @@ module ocean_model_mod use MOM_time_manager, only : time_type, operator(>), operator(+), operator(-) use MOM_time_manager, only : operator(*), operator(/), operator(/=) use MOM_time_manager, only : operator(<=), operator(>=), operator(<) -use MOM_time_manager, only : real_to_time_type, time_type_to_real +use MOM_time_manager, only : real_to_time, 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_variables, only : surface @@ -600,7 +600,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda if (step_thermo) then ! Back up Time1 to the start of the thermodynamic segment. - Time1 = Time1 - real_to_time_type(dtdia - dt_dyn) + Time1 = Time1 - real_to_time(dtdia - dt_dyn) call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, 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) @@ -608,7 +608,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda endif t_elapsed_seg = t_elapsed_seg + dt_dyn - Time1 = Time_seg_start + real_to_time_type(t_elapsed_seg) + Time1 = Time_seg_start + real_to_time(t_elapsed_seg) enddo endif diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index da0f77d935..4933f29182 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -48,8 +48,8 @@ program MOM_main use MOM_string_functions,only : uppercase use MOM_surface_forcing, only : set_forcing, forcing_save_restart use MOM_surface_forcing, only : surface_forcing_init, surface_forcing_CS - use MOM_time_manager, only : time_type, set_date, set_time, get_date - use MOM_time_manager, only : real_to_time_type, time_type_to_real + use MOM_time_manager, only : time_type, set_date, get_date + use MOM_time_manager, only : real_to_time, time_type_to_real use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) use MOM_time_manager, only : operator(>), operator(<), operator(>=) use MOM_time_manager, only : increment_date, set_calendar_type, month_name @@ -291,7 +291,7 @@ program MOM_main Start_time = set_date(date_init(1),date_init(2), date_init(3), & date_init(4),date_init(5),date_init(6)) else - Start_time = set_time(0,days=0) + Start_time = real_to_time(0.0) endif call time_interp_external_init @@ -357,7 +357,7 @@ program MOM_main endif ntstep = MAX(1,ceiling(dt_forcing/dt - 0.001)) - Time_step_ocean = real_to_time_type(dt_forcing) + Time_step_ocean = real_to_time(dt_forcing) elapsed_time_master = (abs(dt_forcing - time_type_to_real(Time_step_ocean)) > 1.0e-12*dt_forcing) if (elapsed_time_master) & call MOM_mesg("Using real elapsed time for the master clock.", 2) @@ -416,7 +416,7 @@ program MOM_main call get_param(param_file, mod_name, "RESTINT", restint, & "The interval between saves of the restart file in units \n"//& "of TIMEUNIT. Use 0 (the default) to not save \n"//& - "incremental restart files at all.", default=set_time(0), & + "incremental restart files at all.", default=real_to_time(0.0), & timeunit=Time_unit) call get_param(param_file, mod_name, "WRITE_CPU_STEPS", cpu_steps, & "The number of coupled timesteps between writing the cpu \n"//& @@ -455,7 +455,7 @@ program MOM_main if (((.not.BTEST(Restart_control,1)) .and. (.not.BTEST(Restart_control,0))) & .or. (Restart_control < 0)) permit_incr_restart = .false. - if (restint > set_time(0)) then + if (restint > real_to_time(0.0)) then ! restart_time is the next integral multiple of restint. restart_time = Start_time + restint * & (1 + ((Time + Time_step_ocean) - Start_time) / restint) @@ -533,7 +533,7 @@ program MOM_main dtdia = dt_dyn*(n - n_last_thermo) ! Back up Time2 to the start of the thermodynamic segment. if (n > n_last_thermo+1) & - Time2 = Time2 - real_to_time_type(dtdia - dt_dyn) + Time2 = Time2 - real_to_time(dtdia - dt_dyn) call step_MOM(forces, fluxes, sfc_state, Time2, dtdia, MOM_CSp, & do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_forcing) @@ -542,7 +542,7 @@ program MOM_main endif t_elapsed_seg = t_elapsed_seg + dt_dyn - Time2 = Time1 + real_to_time_type(t_elapsed_seg) + Time2 = Time1 + real_to_time(t_elapsed_seg) enddo endif @@ -555,12 +555,12 @@ program MOM_main ! does not lose resolution of order the timetype's resolution, provided that the timestep and ! tick are larger than 10-5 seconds. If a clock with a finer resolution is used, a smaller ! value would be required. - time_chg = real_to_time_type(elapsed_time) + time_chg = real_to_time(elapsed_time) segment_start_time = segment_start_time + time_chg elapsed_time = elapsed_time - time_type_to_real(time_chg) endif if (elapsed_time_master) then - Master_Time = segment_start_time + real_to_time_type(elapsed_time) + Master_Time = segment_start_time + real_to_time(elapsed_time) else Master_Time = Master_Time + Time_step_ocean endif From bb7612a341508d967bfd10132eb0d2d0bf4a797a Mon Sep 17 00:00:00 2001 From: "brandon.reichl" Date: Thu, 16 Aug 2018 20:03:42 -0400 Subject: [PATCH 0656/1072] Updates to idealized hurricane routine for non-SCM (full domain) simulations - Changed names of module and subroutine to remove "SCM" - Changed name of SCM ideal hurricane state initializations - Major modifications to user/SCM_ideal_hurricane file --- .../solo_driver/MOM_surface_forcing.F90 | 16 +- .../MOM_state_initialization.F90 | 4 +- src/user/SCM_idealized_hurricane.F90 | 646 +++++++++++------- 3 files changed, 420 insertions(+), 246 deletions(-) diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 351b149830..cac8fb618b 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -44,9 +44,9 @@ module MOM_surface_forcing use user_surface_forcing, only : USER_surface_forcing_init, user_surface_forcing_CS use user_revise_forcing, only : user_alter_forcing, user_revise_forcing_init use user_revise_forcing, only : user_revise_forcing_CS -use SCM_idealized_hurricane, only : SCM_idealized_hurricane_wind_init -use SCM_idealized_hurricane, only : SCM_idealized_hurricane_wind_forcing -use SCM_idealized_hurricane, only : SCM_idealized_hurricane_CS +use idealized_hurricane, only : idealized_hurricane_wind_init +use idealized_hurricane, only : idealized_hurricane_wind_forcing +use idealized_hurricane, only : idealized_hurricane_CS use SCM_CVmix_tests, only : SCM_CVmix_tests_surface_forcing_init use SCM_CVmix_tests, only : SCM_CVmix_tests_wind_forcing use SCM_CVmix_tests, only : SCM_CVmix_tests_buoyancy_forcing @@ -199,7 +199,7 @@ module MOM_surface_forcing type(dumbbell_surface_forcing_CS), pointer :: dumbbell_forcing_CSp => NULL() type(MESO_surface_forcing_CS), pointer :: MESO_forcing_CSp => NULL() type(Neverland_surface_forcing_CS), pointer :: Neverland_forcing_CSp => NULL() - type(SCM_idealized_hurricane_CS), pointer :: SCM_idealized_hurricane_CSp => NULL() + type(idealized_hurricane_CS), pointer :: idealized_hurricane_CSp => NULL() type(SCM_CVmix_tests_CS), pointer :: SCM_CVmix_tests_CSp => NULL() !!@} @@ -279,8 +279,8 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call MESO_wind_forcing(sfc_state, forces, day_center, G, CS%MESO_forcing_CSp) elseif (trim(CS%wind_config) == "Neverland") then call Neverland_wind_forcing(sfc_state, forces, day_center, G, CS%Neverland_forcing_CSp) - elseif (trim(CS%wind_config) == "SCM_ideal_hurr") then - call SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day_center, G, CS%SCM_idealized_hurricane_CSp) + elseif (trim(CS%wind_config) == "ideal_hurr") then + call idealized_hurricane_wind_forcing(sfc_state, forces, day_center, G, CS%idealized_hurricane_CSp) elseif (trim(CS%wind_config) == "SCM_CVmix_tests") then call SCM_CVmix_tests_wind_forcing(sfc_state, forces, day_center, G, CS%SCM_CVmix_tests_CSp) elseif (trim(CS%wind_config) == "USER") then @@ -1704,8 +1704,8 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) call MESO_surface_forcing_init(Time, G, param_file, diag, CS%MESO_forcing_CSp) elseif (trim(CS%wind_config) == "Neverland") then call Neverland_surface_forcing_init(Time, G, param_file, diag, CS%Neverland_forcing_CSp) - elseif (trim(CS%wind_config) == "SCM_ideal_hurr") then - call SCM_idealized_hurricane_wind_init(Time, G, param_file, CS%SCM_idealized_hurricane_CSp) + elseif (trim(CS%wind_config) == "ideal_hurr") then + call idealized_hurricane_wind_init(Time, G, param_file, CS%idealized_hurricane_CSp) elseif (trim(CS%wind_config) == "const") then call get_param(param_file, mdl, "CONST_WIND_TAUX", CS%tau_x0, & "With wind_config const, this is the constant zonal\n"//& diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 0f9c17022d..6ec862ace3 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -75,7 +75,7 @@ module MOM_state_initialization use Rossby_front_2d_initialization, only : Rossby_front_initialize_thickness use Rossby_front_2d_initialization, only : Rossby_front_initialize_temperature_salinity use Rossby_front_2d_initialization, only : Rossby_front_initialize_velocity -use SCM_idealized_hurricane, only : SCM_idealized_hurricane_TS_init +use idealized_hurricane, only : idealized_hurricane_TS_init use SCM_CVMix_tests, only: SCM_CVMix_tests_TS_init use dyed_channel_initialization, only : dyed_channel_set_OBC_tracer_data use dyed_obcs_initialization, only : dyed_obcs_set_OBC_data @@ -369,7 +369,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & tv%S, h, G, GV, PF, eos, just_read_params=just_read) case ("rossby_front"); call Rossby_front_initialize_temperature_salinity ( tv%T, & tv%S, h, G, GV, PF, eos, just_read_params=just_read) - case ("SCM_ideal_hurr"); call SCM_idealized_hurricane_TS_init ( tv%T, & + case ("SCM_ideal_hurr"); call idealized_hurricane_TS_init ( tv%T, & tv%S, h, G, GV, PF, just_read_params=just_read) case ("SCM_CVMix_tests"); call SCM_CVMix_tests_TS_init (tv%T, & tv%S, h, G, GV, PF, just_read_params=just_read) diff --git a/src/user/SCM_idealized_hurricane.F90 b/src/user/SCM_idealized_hurricane.F90 index f688c40ec6..2b9b7fbd22 100644 --- a/src/user/SCM_idealized_hurricane.F90 +++ b/src/user/SCM_idealized_hurricane.F90 @@ -1,65 +1,111 @@ -!> Initial conditions and forcing for the single column model (SCM) idealized -!! hurricane example. -module SCM_idealized_hurricane +!> Initial conditions and forcing for the idealized hurricane example. +module Idealized_hurricane +! Renamed from SCM_idealized_hurricane to idealizeD_hurricane +! This module is no longer exclusively for use in SCM mode. ! This file is part of MOM6. See LICENSE.md for the license. use MOM_error_handler, only : MOM_error, FATAL -use MOM_file_parser, only : get_param, log_version, param_file_type -use MOM_forcing_type, only : forcing, mech_forcing -use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing -use MOM_grid, only : ocean_grid_type -use MOM_safe_alloc, only : safe_alloc_ptr -use MOM_time_manager, only : time_type, operator(+), operator(/), get_time,& - time_type_to_real -use MOM_variables, only : thermo_var_ptrs, surface -use MOM_verticalGrid, only : verticalGrid_type - -implicit none ; private +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing +use MOM_grid, only : ocean_grid_type +use MOM_safe_alloc, only : safe_alloc_ptr +use MOM_time_manager, only : time_type, operator(+), operator(/), get_time,& + time_type_to_real +use MOM_variables, only : thermo_var_ptrs, surface +use MOM_verticalGrid, only : verticalGrid_type + +implicit none + +private #include -public SCM_idealized_hurricane_TS_init -public SCM_idealized_hurricane_wind_init -public SCM_idealized_hurricane_wind_forcing -public SCM_idealized_hurricane_CS +public idealized_hurricane_TS_init !Public interface to initialize TS as vertically + ! uniform with prescribed vertical for hurricane + ! experiments. Used for other idealized + ! configurations. +public idealized_hurricane_wind_init !Public interface to intialize the idealized + ! hurricane wind profile. +public idealized_hurricane_wind_forcing !Public interface to update the idealized + ! hurricane wind profile. !> Container for parameters describing idealized wind structure -type SCM_idealized_hurricane_CS ; private - real :: rho_a !< Air density - real :: p_n !< Ambient pressure - real :: p_c !< Central pressure - real :: r_max !< Radius of maximum winds - real :: U_max !< Maximum wind speeds - real :: YY !< Distance (positive north) of storm center - real :: tran_speed !< Hurricane translation speed - real :: gust_const !< Gustiness (used in u*) - real :: Rho0 !< A reference ocean density in kg/m3 +type, public :: idealized_hurricane_CS ; private + + ! Parameters used to compute Holland radial wind profile + real :: rho_a !< Mean air density [kg/m3] + real :: pressure_ambient !< Pressure at surface of ambient air [Pa] + real :: pressure_central !< Pressure at surface at hurricane center [Pa] + real :: rad_max_wind !< Radius of maximum winds [m] + real :: max_windspeed !< Maximum wind speeds [m/s] + real :: hurr_translation_spd !< Hurricane translation speed [m/s] + real :: hurr_translation_dir !< Hurricane translation speed [m/s] + real :: gustiness !< Gustiness (optional, used in u*) [m/s] + real :: Rho0 !< A reference ocean density [kg/m3] + real :: Hurr_cen_Y0 !< The initial y position of the hurricane + !! This experiment is conducted in a Cartesian + !! grid and this is assumed to be in meters [m] + real :: Hurr_cen_X0 !< The initial x position of the hurricane + !! This experiment is conducted in a Cartesian + !! grid and this is assumed to be in meters [m] + real :: Holland_A !< Parameter 'A' from the Holland formula + real :: Holland_B !< Parameter 'B' from the Holland formula + real :: Holland_AxBxDP !< 'A' x 'B' x (Pressure Ambient-Pressure central) + !! for the Holland prorfile calculation + logical :: relative_tau !< A logical to take difference between wind + !! and surface currents to compute the stress + + + ! Parameters used if in SCM (single column model) mode + logical :: SCM_mode !< Single Column Model Mode [nd] + logical :: BR_BENCH !< A "benchmark" configuration (which is meant to + !! provide identical wind to reproduce a previous + !! experiment, where that wind formula contained + !! an error) + real :: DY_from_center !< (Fixed) distance in y from storm center path [m] + + ! Par + real :: PI + real :: Deg2Rad + end type ! This include declares and sets the variable "version". #include "version_variable.h" -character(len=40) :: mdl = "SCM_idealized_hurricane" !< This module's name. +character(len=40) :: mdl = "idealized_hurricane" !< This module's name. contains -!> Initializes temperature and salinity for the SCM idealized hurricane example -subroutine SCM_idealized_hurricane_TS_init(T, S, h, G, GV, param_file, just_read_params) - type(ocean_grid_type), intent(in) :: G !< Grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature (degC) - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity (psu) - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness in H (m or Pa) - type(param_file_type), intent(in) :: param_file !< Input parameter structure - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. +!> Initializes temperature and salinity for the idealized hurricane example +subroutine idealized_hurricane_TS_init(T, S, h, G, GV, param_file, just_read_params) + type(ocean_grid_type), & + intent(in) :: G !< Grid structure + type(verticalGrid_type), & + intent(in) :: GV !< Vertical grid structure + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & + intent(out) :: T !< Potential temperature (degC) + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & + intent(out) :: S !< Salinity (psu) + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & + intent(in) :: h !< Layer thickness in H (m or Pa) + type(param_file_type), & + intent(in) :: param_file !< Input parameter structure + logical, optional, & + intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. ! Local variables - real :: eta(SZK_(G)+1) ! The 1-d nominal positions of the interfaces. + real :: top ! The 1-d nominal positions of the upper interface. + real :: bot ! The 1-d nominal positions of the lower interface. real :: S_ref, SST_ref, dTdZ, MLD real :: zC logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz + real :: Tbot + + Tbot = 4.0 is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -67,263 +113,391 @@ subroutine SCM_idealized_hurricane_TS_init(T, S, h, G, GV, param_file, just_read just_read = .false. ; if (present(just_read_params)) just_read = just_read_params if (.not.just_read) call log_version(param_file, mdl, version) - call get_param(param_file, mdl,"SCM_S_REF",S_ref, & - 'Reference salinity', units='1e-3',default=35.0, do_not_log=just_read) - call get_param(param_file, mdl,"SCM_SST_REF",SST_ref, & + call get_param(param_file, mdl,"SALT_REF",S_ref, & + 'Reference salinity', units='1e-3',default=35.0, & + do_not_log=just_read) + call get_param(param_file, mdl,"TEMP_REF",SST_ref, & 'Reference surface temperature', units='C', & fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl,"SCM_DTDZ",dTdZ, & + call get_param(param_file, mdl,"INTERIOR_DTDZ",dTdZ, & 'Initial temperature stratification below mixed layer', & units='C/m', fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl,"SCM_MLD",MLD, & + call get_param(param_file, mdl,"REF_LAYER_DEPTH",MLD, & 'Initial mixed layer depth', units='m', & fail_if_missing=.not.just_read, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. - do j=js,je ; do i=is,ie - eta(1) = 0. ! Reference to surface - do k=1,nz - eta(K+1) = eta(K) - h(i,j,k)*GV%H_to_m ! Interface below layer (in m) - zC = 0.5*( eta(K) + eta(K+1) ) ! Z of middle of layer (in m) - T(i,j,k) = SST_ref + dTdz * min(0., zC + MLD) - S(i,j,k) = S_ref - enddo ! k - enddo ; enddo + T(:,:,:) = 0.0 + S(:,:,:) = 0.0 + + do j=jsd,jed + do i=isd,ied + top = 0. + bot = 0. + do k=1,nz + ! Compute next interface + bot = bot - h(i,j,k)*GV%H_to_m + ! Depth of middle of layer + zC = 0.5*( top + bot ) + ! Compute Temperature and Salinity based on decay rates + T(i,j,k) = max(Tbot,SST_ref + dTdz * min(0., zC + MLD)) + S(i,j,k) = S_ref + top = bot + enddo ! k + enddo + enddo -end subroutine SCM_idealized_hurricane_TS_init +end subroutine idealized_hurricane_TS_init !> Initializes wind profile for the SCM idealized hurricane example -subroutine SCM_idealized_hurricane_wind_init(Time, G, param_file, CS) - type(time_type), intent(in) :: Time !< Model time - type(ocean_grid_type), intent(in) :: G !< Grid structure - type(param_file_type), intent(in) :: param_file !< Input parameter structure - type(SCM_idealized_hurricane_CS), pointer :: CS !< Parameter container +subroutine idealized_hurricane_wind_init(Time, G, param_file, CS) + type(time_type), & + intent(in) :: Time !< Model time + type(ocean_grid_type), & + intent(in) :: G !< Grid structure + type(param_file_type), & + intent(in) :: param_file !< Input parameter structure + type(idealized_hurricane_CS), & + pointer :: CS !< Parameter container + + real :: DP, C ! This include declares and sets the variable "version". #include "version_variable.h" if (associated(CS)) then - call MOM_error(FATAL, "SCM_idealized_hurricane_wind_init called with an associated "// & - "control structure.") + call MOM_error(FATAL, "idealized_hurricane_wind_init called "// & + "with an associated control structure.") return endif + allocate(CS) + CS%pi = 4.0*atan(1.0) + CS%Deg2Rad = CS%pi/180. + ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") - call get_param(param_file, mdl, "SCM_RHO_AIR", CS%rho_a, & - "Air density "// & - "used in the SCM idealized hurricane wind profile.", & - units='kg/m3', default=1.2) - call get_param(param_file, mdl, "SCM_AMBIENT_PRESSURE", CS%p_n, & - "Ambient pressure "// & - "used in the SCM idealized hurricane wind profile.", & - units='Pa', default=101200.) - call get_param(param_file, mdl, "SCM_CENTRAL_PRESSURE", CS%p_c, & - "Central pressure "// & - "used in the SCM idealized hurricane wind profile.", & - units='Pa', default=96800.) - call get_param(param_file, mdl, "SCM_RADIUS_MAX_WINDS", CS%r_max, & - "Radius of maximum winds "// & - "used in the SCM idealized hurricane wind profile.", & - units='m', default=50.e3) - call get_param(param_file, mdl, "SCM_MAX_WIND_SPEED", CS%U_max, & - "Maximum wind speed "// & - "used in the SCM idealized hurricane wind profile.", & - units='m/s', default=65.) - call get_param(param_file, mdl, "SCM_YY", CS%YY, & - "Y distance of station "// & - "used in the SCM idealized hurricane wind profile.", & - units='m', default=50.e3) - call get_param(param_file, mdl, "SCM_TRAN_SPEED", CS%TRAN_SPEED, & - "Translation speed of hurricane"// & + + ! Parameters for computing a wind profile + call get_param(param_file, mdl, "IDL_HURR_RHO_AIR", CS%rho_a, & + "Air density used to compute the idealized hurricane"// & + "wind profile.", units='kg/m3', default=1.2) + call get_param(param_file, mdl, "IDL_HURR_AMBIENT_PRESSURE", & + CS%pressure_ambient, "Ambient pressure used in the "// & + "idealized hurricane wind profile.", units='Pa', & + default=101200.) + call get_param(param_file, mdl, "IDL_HURR_CENTRAL_PRESSURE", & + CS%pressure_central, "Central pressure used in the "// & + "idealized hurricane wind profile.", units='Pa', & + default=96800.) + call get_param(param_file, mdl, "IDL_HURR_RAD_MAX_WIND", & + CS%rad_max_wind, "Radius of maximum winds used in the"// & + "idealized hurricane wind profile.", units='m', & + default=50.e3) + call get_param(param_file, mdl, "IDL_HURR_MAX_WIND", CS%max_windspeed, & + "Maximum wind speed used in the idealized hurricane"// & + "wind profile.", units='m/s', default=65.) + call get_param(param_file, mdl, "IDL_HURR_TRAN_SPEED", CS%hurr_translation_spd, & + "Translation speed of hurricane used in the idealized"// & + "hurricane wind profile.", units='m/s', default=5.0) + call get_param(param_file, mdl, "IDL_HURR_TRAN_DIR", CS%hurr_translation_dir, & + "Translation direction (towards) of hurricane used in the "//& + "idealized hurricane wind profile.", units='degrees', & + default=180.0) + CS%hurr_translation_dir = CS%hurr_translation_dir * CS%Deg2Rad + call get_param(param_file, mdl, "IDL_HURR_X0", CS%Hurr_cen_X0, & + "Idealized Hurricane initial X position", & + units='m', default=0.) + call get_param(param_file, mdl, "IDL_HURR_Y0", CS%Hurr_cen_Y0, & + "Idealized Hurricane initial Y position", & + units='m', default=0.) + call get_param(param_file, mdl, "IDL_HURR_TAU_CURR_REL", CS%relative_tau, & + "Current relative stress switch"// & + "used in the idealized hurricane wind profile.", & + units='', default=.false.) + + ! Parameters for SCM mode + call get_param(param_file, mdl, "IDL_HURR_SCM_BR_BENCH", CS%BR_BENCH, & + "Single column mode benchmark case switch, which is "// & + "invoking a modification (bug) in the wind profile meant to "//& + "reproduce a previous implementation.", units='', default=.false.) + call get_param(param_file, mdl, "IDL_HURR_SCM", CS%SCM_MODE, & + "Single Column mode switch"// & "used in the SCM idealized hurricane wind profile.", & - units='m/s', default=5.0) + units='', default=.false.) + call get_param(param_file, mdl, "IDL_HURR_SCM_LOCY", CS%DY_from_center, & + "Y distance of station used in the SCM idealized hurricane "// & + "wind profile.", units='m', default=50.e3) + + ! The following parameters are model run-time parameters which are used + ! and logged elsewhere and so should not be logged here. The default + ! value should be consistent with the rest of the model. call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to \n"//& "calculate accelerations and the mass for conservation \n"//& "properties, or with BOUSSINSEQ false to convert some \n"//& "parameters from vertical units of m to kg m-2.", & - units="kg m-3", default=1035.0) - ! The following parameter is a model run-time parameter which is used - ! and logged elsewhere and so should not be logged here. The default - ! value should be consistent with the rest of the model. - call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & + units="kg m-3", default=1035.0, do_not_log=.true.) + call get_param(param_file, mdl, "GUST_CONST", CS%gustiness, & "The background gustiness in the winds.", units="Pa", & default=0.00, do_not_log=.true.) -end subroutine SCM_idealized_hurricane_wind_init + if (CS%BR_BENCH) then + CS%rho_a = 1.2 + endif + DP = CS%pressure_ambient - CS%pressure_central + C = CS%max_windspeed / sqrt( DP ) + CS%Holland_B = C**2 * CS%rho_a * exp(1.0) + CS%Holland_A = (CS%rad_max_wind)**CS%Holland_B + CS%Holland_AxBxDP = CS%Holland_A*CS%Holland_B*DP + + return +end subroutine idealized_hurricane_wind_init + +!> Computes the surface wind for the idealized hurricane test cases +subroutine idealized_hurricane_wind_forcing(state, forces, day, G, CS) + type(surface), & + intent(in) :: state !< Surface state structure + type(mech_forcing), & + intent(inout) :: forces !< A structure with the driving mechanical forces + type(time_type), & + intent(in) :: day !< Time in days + type(ocean_grid_type), & + intent(inout) :: G !< Grid structure + type(idealized_hurricane_CS), & + pointer :: CS !< Container for idealized hurricane parameters -subroutine SCM_idealized_hurricane_wind_forcing(state, forces, day, G, CS) - type(surface), intent(in) :: state !< Surface state structure - type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), intent(in) :: day !< Time in days - type(ocean_grid_type), intent(inout) :: G !< Grid structure - type(SCM_idealized_hurricane_CS), pointer :: CS !< Container for SCM parameters ! Local variables integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - real :: pie, Deg2Rad - real :: U10, A, B, C, r, f, du10, rkm ! For wind profile expression - real :: xx, t0 !for location - real :: dp, rB - real :: Cd ! Air-sea drag coefficient - real :: Uocn, Vocn ! Surface ocean velocity components - real :: dU, dV ! Air-sea differential motion - !Wind angle variables - real :: Alph,Rstr, A0, A1, P1, Adir, transdir, V_TS, U_TS - logical :: BR_Bench + + real :: TX,TY !< wind stress + real :: Uocn, Vocn !< Surface ocean velocity components + real :: LAT, LON !< Grid location + real :: YY, XX !< storm relative position + real :: XC, YC !< Storm center location + real :: f !< Coriolis + real :: fbench !< The benchmark 'f' value + real :: fbench_fac !< A factor that is set to 0 to use the + !! benchmark 'f' value + real :: rel_tau_fac !< A factor that is set to 0 to disable + !! current relative stress calculation + ! Bounds for loops and memory allocation - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + 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 ! Allocate the forcing arrays, if necessary. call allocate_mech_forcing(G, forces, stress=.true., ustar=.true.) - pie = 4.0*atan(1.0) ; Deg2Rad = pie/180. - - !/ BR - ! Implementing Holland (1980) parameteric wind profile - !------------------------------------------------------| - BR_Bench = .true. !true if comparing to LES runs | - t0 = 129600. !TC 'eye' crosses (0,0) at 36 hours| - transdir = pie !translation direction (-x) | - !------------------------------------------------------| - dp = CS%p_n - CS%p_c - C = CS%U_max / sqrt( dp ) - B = C**2 * CS%rho_a * exp(1.0) - if (BR_Bench) then - ! rho_a reset to value used in generated wind for benchmark test - B = C**2 * 1.2 * exp(1.0) + if (CS%relative_tau) then + REL_TAU_FAC = 1. + else + REL_TAU_FAC = 0. !Multiplied to 0 surface current endif - A = (CS%r_max/1000.)**B - f =G%CoriolisBu(is,js) ! f=f(x,y) but in the SCM is constant - if (BR_Bench) then + + !> Compute storm center location + XC = CS%Hurr_cen_X0 + (time_type_to_real(day)*CS%hurr_translation_spd*& + cos(CS%hurr_translation_dir)) + YC = CS%Hurr_cen_Y0 + (time_type_to_real(day)*CS%hurr_translation_spd*& + sin(CS%hurr_translation_dir)) + + if (CS%BR_Bench) then ! f reset to value used in generated wind for benchmark test - f = 5.5659e-05 + fbench = 5.5659e-05 + fbench_fac = 0.0 + else + fbench = 0.0 + fbench_fac = 1.0 endif - !/ BR - ! Calculate x position as a function of time. - xx = ( t0 - time_type_to_real(day)) * CS%tran_speed * cos(transdir) - r = sqrt(xx**2.+CS%YY**2.) - !/ BR + + !> Computes taux + do j=js,je + do I=is-1,Ieq + Uocn = state%u(I,j)*REL_TAU_FAC + Vocn = 0.25*(state%v(i,J)+state%v(i+1,J-1)& + +state%v(i+1,J)+state%v(i,J-1))*REL_TAU_FAC + f = abs(0.5*(G%CoriolisBu(I,J)+G%CoriolisBu(I,J-1)))*fbench_fac & + + fbench + ! Calculate position as a function of time. + if (CS%SCM_mode) then + YY = YC + XX = XC + else + LAT = G%geoLatCu(I,j)*1000. !KM_to_m + LON = G%geoLonCu(I,j)*1000. !KM_to_m + YY = LAT - YC + XX = LON - XC + endif + call idealized_hurricane_wind_profile(& + CS,f,YY,XX,Uocn,Vocn,TX,TY) + forces%taux(I,j) = G%mask2dCu(I,j) * TX + enddo + enddo + !> Computes tauy + do J=js-1,Jeq + do i=is,ie + Uocn = 0.25*(state%u(I,j)+state%u(I-1,j+1)& + +state%u(I-1,j)+state%u(I,j+1))*REL_TAU_FAC + Vocn = state%v(i,J)*REL_TAU_FAC + f = abs(0.5*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))*fbench_fac & + + fbench + ! Calculate position as a function of time. + if (CS%SCM_mode) then + YY = YC + XX = XC + else + LAT = G%geoLatCv(i,J)*1000. !KM_to_m + LON = G%geoLonCv(i,J)*1000. !KM_to_m + YY = LAT - YC + XX = LON - XC + endif + call idealized_hurricane_wind_profile(& + CS,f,YY,XX,Uocn,Vocn,TX,TY) + forces%tauy(i,J) = G%mask2dCv(i,J) * TY + enddo + enddo + + !> Get Ustar + do j=js,je + do i=is,ie + ! This expression can be changed if desired, but need not be. + forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(CS%gustiness/CS%Rho0 + & + sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & + 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) + enddo + enddo + + return +end subroutine idealized_hurricane_wind_forcing + +!> Calculate the wind speed at a location as a function of time. +subroutine idealized_hurricane_wind_profile(CS,absf,YY,XX,UOCN,VOCN,Tx,Ty) + ! Author: Brandon Reichl + ! Date: Nov-20-2014 + ! Aug-14-2018 Generalized for non-SCM configuration + + ! Input parameters + type(idealized_hurricane_CS), & + pointer :: CS !< Container for SCM parameters + real, intent(in) :: absf ! 0.001 .AND. r/CS%r_max < 10.) then - U10 = sqrt( A*B*dp*exp(-A/rB)/(1.2*rB) + 0.25*(rkm*f)**2 ) - 0.5*rkm*f - elseif (r/CS%r_max > 10. .AND. r/CS%r_max < 12.) then - r=CS%r_max*10. - if (BR_Bench) then - rkm = r/1000. - rB=rkm**B - else - rkm = r - rB = r**B - endif - U10 = ( sqrt( A*B*dp*exp(-A/rB)/(1.2*rB) + 0.25*(rkm*f)**2 ) - 0.5*rkm*f) & - * (12. - r/CS%r_max)/2. + if ( (radius/CS%rad_max_wind .gt. 0.001) .and. & + (radius/CS%rad_max_wind .lt. 10.) ) then + U10 = sqrt(CS%Holland_AxBxDP*exp(-CS%Holland_A/radiusB)/(CS%rho_A*radiusB)& + +0.25*(radius_km*absf)**2) - 0.5*radius_km*absf + elseif ( (radius/CS%rad_max_wind .gt. 10.) .and. & + (radius/CS%rad_max_wind .lt. 12.) ) then + radius = CS%rad_max_wind*10. + if (CS%BR_Bench) then + radius_km = radius/1000. + else + radius_km = radius + endif + radiusB=radius**CS%Holland_B + + U10 = (sqrt(CS%Holland_AxBxDp*exp(-CS%Holland_A/radiusB)/(CS%rho_A*radiusB)& + +0.25*(radius_km*absf)**2)-0.5*radius_km*absf) & + * (12.-radius/CS%rad_max_wind)/2. else - U10 = 0. + U10 = 0. endif - Adir = atan2(CS%YY,xx) + Adir = atan2(YY,xx) + !\ - !/ BR ! Wind angle model following Zhang and Ulhorn (2012) ! ALPH is inflow angle positive outward. - RSTR = min(10.,r / CS%r_max) - A0 = -0.9*RSTR -0.09*CS%U_max -14.33 - A1 = -A0 *(0.04*RSTR +0.05*CS%tran_speed+0.14) - P1 = (6.88*RSTR -9.60*CS%tran_speed+85.31)*pie/180. - ALPH = A0 - A1*cos( (TRANSDIR - ADIR ) - P1) - if (r/CS%r_max > 10. .AND. r/CS%r_max < 12.) then - ALPH = ALPH* (12. - r/CS%r_max)/2. - elseif (r/CS%r_max > 12.) then + RSTR = min(10.,radius / CS%rad_max_wind) + A0 = -0.9*RSTR - 0.09*CS%max_windspeed - 14.33 + A1 = -A0*(0.04*RSTR + 0.05*CS%Hurr_translation_spd + 0.14) + P1 = (6.88*RSTR - 9.60*CS%Hurr_translation_spd + 85.31) * CS%Deg2Rad + ALPH = A0 - A1*cos(CS%hurr_translation_dir-Adir-P1) + if ( (radius/CS%rad_max_wind.gt.10.) .and.& + (radius/CS%rad_max_wind.lt.12.) ) then + ALPH = ALPH*(12.0-radius/CS%rad_max_wind)/2. + elseif (radius/CS%rad_max_wind.gt.12.) then ALPH = 0.0 endif - ALPH = ALPH * Deg2Rad - - !/BR - ! Prepare for wind calculation - ! X_TS is component of translation speed added to wind vector - ! due to background steering wind. - U_TS = CS%tran_speed/2.*cos(transdir) - V_TS = CS%tran_speed/2.*sin(transdir) - - ! Set the surface wind stresses, in units of Pa. A positive taux - ! accelerates the ocean to the (pseudo-)east. - ! The i-loop extends to is-1 so that taux can be used later in the - ! calculation of ustar - otherwise the lower bound would be Isq. - do j=js,je ; do I=is-1,Ieq - !/BR - ! Turn off surface current for stress calculation to be - ! consistent with test case. - Uocn = 0.!state%u(I,j) - Vocn = 0.!0.25*( (state%v(i,J) + state%v(i+1,J-1)) & - ! +(state%v(i+1,J) + state%v(i,J-1)) ) - !/BR - ! Wind vector calculated from location/direction (sin/cos flipped b/c - ! cyclonic wind is 90 deg. phase shifted from position angle). - dU = U10*sin(Adir-pie-Alph) - Uocn + U_TS - dV = U10*cos(Adir-Alph) - Vocn + V_TS - !/----------------------------------------------------| - !BR - ! Add a simple drag coefficient as a function of U10 | - !/----------------------------------------------------| - du10=sqrt(du**2+dv**2) - if (du10 < 11.) then - Cd = 1.2e-3 - elseif (du10 < 20.) then - Cd = (0.49 + 0.065 * U10 )*0.001 - else - Cd = 0.0018 - endif - forces%taux(I,j) = CS%rho_a * G%mask2dCu(I,j) * Cd*sqrt(du**2+dV**2)*dU - enddo ; enddo - !/BR - ! See notes above - do J=js-1,Jeq ; do i=is,ie - Uocn = 0.!0.25*( (state%u(I,j) + state%u(I-1,j+1)) & - ! +(state%u(I-1,j) + state%u(I,j+1)) ) - Vocn = 0.!state%v(i,J) - dU = U10*sin(Adir-pie-Alph) - Uocn + U_TS - dV = U10*cos(Adir-Alph) - Vocn + V_TS - du10=sqrt(du**2+dv**2) - if (du10 < 11.) then - Cd = 1.2e-3 - elseif (du10 < 20.) then - Cd = (0.49 + 0.065 * U10 )*0.001 - else - Cd = 0.0018 - endif - forces%tauy(I,j) = CS%rho_a * G%mask2dCv(I,j) * Cd*du10*dV - enddo ; enddo - ! Set the surface friction velocity, in units of m s-1. ustar is always positive. - do j=js,je ; do i=is,ie - ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & - sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & - 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) - enddo ; enddo + ALPH = ALPH * CS%Deg2Rad + + ! Calculate translation speed components + U_TS = CS%hurr_translation_spd/2.*cos(CS%hurr_translation_dir) + V_TS = CS%hurr_translation_spd/2.*sin(CS%hurr_translation_dir) + + ! Set output (relative) winds + dU = U10*sin(Adir-CS%Pi-Alph) - UOCN + U_TS + dV = U10*cos(Adir-Alph) - VOCN + V_TS + + ! Use a simple drag coefficient as a function of U10 (from Sullivan et al., 2010) + du10 = sqrt(du**2+dv**2) + if (du10.lt.11.) then + Cd = 1.2e-3 + elseif (du10.lt.20.0) then + Cd = (0.49 + 0.065*U10)*1.e-3 + else + Cd = 1.8e-3 + endif + + ! Compute stress vector + TX = CS%rho_A * Cd * sqrt(du**2+dV**2) * dU + TY = CS%rho_A * Cd * sqrt(du**2+dV**2) * dV -end subroutine SCM_idealized_hurricane_wind_forcing + return +end subroutine idealized_hurricane_wind_profile -end module SCM_idealized_hurricane +end module idealized_hurricane From 9252394b1f5605b911b09de86fc065a8f5b47713 Mon Sep 17 00:00:00 2001 From: Raymond Menzel Date: Tue, 21 Aug 2018 14:31:20 -0400 Subject: [PATCH 0657/1072] Reordered loops to address a bug when compiled with -O3 using the intel compiler version 16.0.3.210 --- .../vertical/MOM_vert_friction.F90 | 55 ++++++++++--------- 1 file changed, 29 insertions(+), 26 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 88da20bb4d..c345818493 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -217,14 +217,15 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & Idt = 1.0 / dt !Check if Stokes mixing allowed if requested (present and associated) + DoStokesMixing=.false. if (CS%StokesMixing) then - DoStokesMixing=(present(Waves) .and. associated(Waves)) - if (.not.DoStokesMixing) then - call MOM_error(FATAL,"Stokes Mixing called without allocated"//& - "Waves Control Structure") + if (present(Waves)) then + DoStokesMixing = associated(Waves) + if (.not. DoStokesMixing) then + call MOM_error(FATAL,"Stokes Mixing called without allocated"//& + "Waves Control Structure") + endif endif - else - DoStokesMixing=.false. endif do k=1,nz ; do i=Isq,Ieq ; Ray(i,k) = 0.0 ; enddo ; enddo @@ -232,17 +233,17 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & ! Update the zonal velocity component using a modification of a standard ! tridagonal solver. - ! When mixing down Eulerian current + Stokes drift add before calling solver - if (DoStokesMixing) then ; do k=1,nz ; do j=G%jsc,G%jec ; do I=Isq,Ieq - if (G%mask2dCu(I,j) > 0) u(I,j,k) = u(I,j,k) + Waves%Us_x(I,j,k) - enddo ; enddo ; enddo ; endif - !$OMP parallel do default(shared) firstprivate(Ray) & !$OMP private(do_i,surface_stress,zDS,stress,h_a,hfr, & !$OMP b_denom_1,b1,d1,c1) do j=G%jsc,G%jec do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo + ! When mixing down Eulerian current + Stokes drift add before calling solver + if (DoStokesMixing) then ; do k=1,nz ; do I=Isq,Ieq + if (do_i(I)) u(I,j,k) = u(I,j,k) + Waves%Us_x(I,j,k) + enddo ; enddo ; endif + if (associated(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq ADp%du_dt_visc(I,j,k) = u(I,j,k) enddo ; enddo ; endif @@ -330,19 +331,15 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & taux_bot(I,j) = taux_bot(I,j) + Rho0 * (Ray(I,k)*u(I,j,k)) enddo ; enddo ; endif endif - enddo ! end u-component j loop - ! When mixing down Eulerian current + Stokes drift subtract after calling solver - if (DoStokesMixing) then ; do k=1,nz ; do j=G%jsc,G%jec ; do I=Isq,Ieq - if (G%mask2dCu(I,j) > 0) u(I,j,k) = u(I,j,k) - Waves%Us_x(I,j,k) - enddo ; enddo ; enddo ; endif + ! When mixing down Eulerian current + Stokes drift subtract after calling solver + if (DoStokesMixing) then ; do k=1,nz ; do I=Isq,Ieq + if (do_i(I)) u(I,j,k) = u(I,j,k) - Waves%Us_x(I,j,k) + enddo ; enddo ; endif + + enddo ! end u-component j loop ! Now work on the meridional velocity component. - ! When mixing down Eulerian current + Stokes drift add before calling solver - if (DoStokesMixing) then ; do k=1,nz ; do j=Jsq,Jeq ; do I=Is,Ie - if (G%mask2dCv(I,j) > 0) & - v(i,j,k) = v(i,j,k) + Waves%Us_y(i,j,k) - enddo ; enddo ; enddo ; endif !$OMP parallel do default(shared) firstprivate(Ray) & !$OMP private(do_i,surface_stress,zDS,stress,h_a,hfr, & @@ -350,6 +347,11 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & do J=Jsq,Jeq do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0) ; enddo + ! When mixing down Eulerian current + Stokes drift add before calling solver + if (DoStokesMixing) then ; do k=1,nz ; do i=is,ie + if (do_i(i)) v(i,j,k) = v(i,j,k) + Waves%Us_y(i,j,k) + enddo ; enddo ; endif + if (associated(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie ADp%dv_dt_visc(i,J,k) = v(i,J,k) enddo ; enddo ; endif @@ -411,12 +413,13 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & tauy_bot(i,J) = tauy_bot(i,J) + Rho0 * (Ray(i,k)*v(i,J,k)) enddo ; enddo ; endif endif - enddo ! end of v-component J loop - ! When mixing down Eulerian current + Stokes drift subtract after calling solver - if (DoStokesMixing) then ; do k=1,nz ; do J=Jsq,Jeq ; do i=Is,Ie - if (G%mask2dCv(i,J) > 0) v(i,J,k) = v(i,J,k) - Waves%Us_y(i,J,k) - enddo ; enddo ; enddo ; endif + ! When mixing down Eulerian current + Stokes drift subtract after calling solver + if (DoStokesMixing) then ; do k=1,nz ; do i=is,ie + if (do_i(i)) v(i,J,k) = v(i,J,k) - Waves%Us_y(i,J,k) + enddo ; enddo ; endif + + enddo ! end of v-component J loop call vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, CS) From e3ea419953d49623653c7f277389aefc424742d6 Mon Sep 17 00:00:00 2001 From: Raymond Menzel Date: Tue, 21 Aug 2018 15:31:03 -0400 Subject: [PATCH 0658/1072] Fixed logic, made ifs one-liners. --- src/parameterizations/vertical/MOM_vert_friction.F90 | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index c345818493..6b5fcb3202 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -219,13 +219,10 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & !Check if Stokes mixing allowed if requested (present and associated) DoStokesMixing=.false. if (CS%StokesMixing) then - if (present(Waves)) then - DoStokesMixing = associated(Waves) - if (.not. DoStokesMixing) then - call MOM_error(FATAL,"Stokes Mixing called without allocated"//& - "Waves Control Structure") - endif - endif + if (present(Waves)) DoStokesMixing = associated(Waves) + if (.not. DoStokesMixing) & + call MOM_error(FATAL,"Stokes Mixing called without allocated"//& + "Waves Control Structure") endif do k=1,nz ; do i=Isq,Ieq ; Ray(i,k) = 0.0 ; enddo ; enddo From 24f3c3fb6986a66f48d69515adc22d892b3f1c8d Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Tue, 21 Aug 2018 16:08:59 -0400 Subject: [PATCH 0659/1072] Added grid rotation angle to the list of available static diagnostics --- src/diagnostics/MOM_diagnostics.F90 | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index f200a15bed..2c1b92b896 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1952,6 +1952,14 @@ subroutine write_static_fields(G, GV, tv, diag) 'Open zonal grid spacing at v points (meter)', 'm', interp_method='none') if (id > 0) call post_data(id, G%dx_Cv, diag, .true.) + id = register_static_field('ocean_model', 'sin_rot', diag%axesT1, & + 'sine of the clockwise angle of the ocean grid north to true north', 'radians') + if (id > 0) call post_data(id, G%sin_rot, diag, .true.) + + id = register_static_field('ocean_model', 'cos_rot', diag%axesT1, & + 'cosine of the clockwise angle of the ocean grid north to true north', 'radians') + if (id > 0) call post_data(id, G%cos_rot, diag, .true.) + ! This static diagnostic is from CF 1.8, and is the fraction of a cell ! covered by ocean, given as a percentage (poorly named). From e3923d3436c67fe8be30c742ce31a516ad6166c0 Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Tue, 21 Aug 2018 16:55:02 -0400 Subject: [PATCH 0660/1072] correct units for sin/cos grid rotation --- src/diagnostics/MOM_diagnostics.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 2c1b92b896..8e18ed5a01 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1953,11 +1953,11 @@ subroutine write_static_fields(G, GV, tv, diag) if (id > 0) call post_data(id, G%dx_Cv, diag, .true.) id = register_static_field('ocean_model', 'sin_rot', diag%axesT1, & - 'sine of the clockwise angle of the ocean grid north to true north', 'radians') + 'sine of the clockwise angle of the ocean grid north to true north', 'none') if (id > 0) call post_data(id, G%sin_rot, diag, .true.) id = register_static_field('ocean_model', 'cos_rot', diag%axesT1, & - 'cosine of the clockwise angle of the ocean grid north to true north', 'radians') + 'cosine of the clockwise angle of the ocean grid north to true north', 'none') if (id > 0) call post_data(id, G%cos_rot, diag, .true.) From 8da88521c841d6275e9463fe6b6869f8fe8a375f Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 22 Aug 2018 15:50:37 -0400 Subject: [PATCH 0661/1072] Fixes reading a scalar on restart when restart files are distributed - The mpp_domain is still needed for reading a scalar from a restart file because the io_layout describing the restart files is needed. --- src/framework/MOM_restart.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 8d5819f945..4a1ad4878e 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -1102,7 +1102,7 @@ subroutine restore_state(filename, directory, day, G, CS) if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr1d(m)%p) elseif (associated(CS%var_ptr0d(m)%p)) then ! Read a scalar... call read_data(unit_path(n), varname, CS%var_ptr0d(m)%p, & - no_domain=.true., timelevel=1) + G%Domain%mpp_domain, timelevel=1) if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr0d(m)%p) elseif ((pos == 0) .and. associated(CS%var_ptr2d(m)%p)) then ! Read a non-decomposed 2d array. ! Probably should query the field type to make sure that the sizes are right. From f13dc1b251ebe65567cc3e8d876c68490b428c55 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 22 Aug 2018 16:54:05 -0400 Subject: [PATCH 0662/1072] Fixes an OOB when processing the restart filename variable - A combined conditional in a logical test can trigger an out-of-bounds index even though the logic is correct. This re-arrangement allows debug executables to get past the test. --- src/framework/MOM_restart.F90 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 8d5819f945..a773405897 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -1368,8 +1368,12 @@ function open_restart_units(filename, directory, G, CS, units, file_paths, & enddo fname = filename(start_char:m-1) start_char = m - do while ((start_char <= len_trim(filename)) .and. (filename(start_char:start_char) == ' ')) - start_char = start_char + 1 + do while (start_char <= len_trim(filename)) + if (filename(start_char:start_char) == ' ') then + start_char = start_char + 1 + else + exit + endif enddo if ((fname(1:1)=='r') .and. ( len_trim(fname) == 1)) then From 62f2e96b2d3d12db093bf4354c4fc225996d0de9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 23 Aug 2018 17:56:59 -0400 Subject: [PATCH 0663/1072] +Eliminated use_io_layout from the MOM_domain_type Eliminated the logical element use_io_layout from the MOM_domain_type, as this variable is always true. As a result, several logical tests were simplified and an extensive block of code in restore_state that is never executed was eliminated, and the remaining portions were simplified. As a further result, there is no longer any MOM6 code calling read_field, so that interface (which is a simple pass-through wrapper for mpp_read) was eliminated. In addition, one misspelling and an incorrect parameter description were corrected in MOM_domains, which minorly changes entries in the MOM_parameter_doc.layout files. All answers are bitwise identical. --- src/framework/MOM_domains.F90 | 7 +- src/framework/MOM_io.F90 | 14 +- src/framework/MOM_restart.F90 | 154 +++++---------------- src/initialization/MOM_grid_initialize.F90 | 4 +- 4 files changed, 43 insertions(+), 136 deletions(-) diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index 103b328aa1..a38facf79a 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -118,7 +118,6 @@ module MOM_domains !! domain in the i-direction in a define_domain call. integer :: Y_FLAGS !< Flag that specifies the properties of the !! domain in the j-direction in a define_domain call. - logical :: use_io_layout !< True if an I/O layout is available. logical, pointer :: maskmap(:,:) => NULL() !< A pointer to an array indicating !! which logical processors are actually used for !! the ocean code. The other logical processors @@ -1401,11 +1400,11 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & "STATIC_MEMORY_ this is set in "//trim(inc_nm)//" at compile time.",& layoutParam=.true.) call log_param(param_file, mdl, trim(njproc_nm), layout(2), & - "The number of processors in the x-direction. With \n"//& !### FIX THIS COMMENT + "The number of processors in the y-direction. With \n"//& "STATIC_MEMORY_ this is set in "//trim(inc_nm)//" at compile time.",& layoutParam=.true.) call log_param(param_file, mdl, trim(layout_nm), layout, & - "The processor layout that was acutally used.",& + "The processor layout that was actually used.",& layoutParam=.true.) ! Idiot check that fewer PEs than columns have been requested @@ -1490,7 +1489,6 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & MOM_dom%Y_FLAGS = Y_FLAGS MOM_dom%layout = layout MOM_dom%io_layout = io_layout - MOM_dom%use_io_layout = (io_layout(1) + io_layout(2) > 0) if (is_static) then ! A requirement of equal sized compute domains is necessary when STATIC_MEMORY_ @@ -1554,7 +1552,6 @@ subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, & MOM_dom%X_FLAGS = MD_in%X_FLAGS ; MOM_dom%Y_FLAGS = MD_in%Y_FLAGS MOM_dom%layout(:) = MD_in%layout(:) ; MOM_dom%io_layout(:) = MD_in%io_layout(:) - MOM_dom%use_io_layout = (MOM_dom%io_layout(1) + MOM_dom%io_layout(2) > 0) if (associated(MD_in%maskmap)) then mask_table_exists = .true. diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 21d42ea436..e523270802 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -30,7 +30,7 @@ module MOM_io use mpp_io_mod, only : MPP_APPEND, MPP_MULTI, MPP_OVERWR, MPP_NETCDF, MPP_RDONLY use mpp_io_mod, only : get_file_info=>mpp_get_info, get_file_atts=>mpp_get_atts use mpp_io_mod, only : get_file_fields=>mpp_get_fields, get_file_times=>mpp_get_times -use mpp_io_mod, only : read_field=>mpp_read, io_infra_init=>mpp_io_init +use mpp_io_mod, only : io_infra_init=>mpp_io_init use netcdf @@ -38,7 +38,7 @@ module MOM_io public :: close_file, create_file, field_exists, field_size, fieldtype, get_filename_appendix public :: file_exists, flush_file, get_file_info, get_file_atts, get_file_fields -public :: get_file_times, open_file, read_axis_data, read_data, read_field +public :: get_file_times, open_file, read_axis_data, read_data public :: num_timelevels, MOM_read_data, MOM_read_vector, ensembler public :: reopen_file, slasher, write_field, write_version_number, MOM_io_init public :: open_namelist_file, check_nml_error, io_infra_init, io_infra_end @@ -154,9 +154,7 @@ subroutine create_file(unit, filename, vars, novars, fields, threading, timeunit endif one_file = .true. - if (domain_set) then - one_file = ((thread == SINGLE_FILE) .or. .not.Domain%use_io_layout) - endif + if (domain_set) one_file = (thread == SINGLE_FILE) if (one_file) then call open_file(unit, filename, MPP_OVERWR, MPP_NETCDF, threading=thread) @@ -398,9 +396,7 @@ subroutine reopen_file(unit, filename, vars, novars, fields, threading, timeunit endif one_file = .true. - if (domain_set) then - one_file = ((thread == SINGLE_FILE) .or. .not.Domain%use_io_layout) - endif + if (domain_set) one_file = (thread == SINGLE_FILE) if (one_file) then call open_file(unit, filename, MPP_APPEND, MPP_NETCDF, threading=thread) @@ -1012,7 +1008,7 @@ end subroutine MOM_io_init !! !! * write_field: write a field to an open file. !! * write_time: write a value of the time axis to an open file. -!! * read_field: read a field from an open file. +!! * read_data: read a variable from an open file. !! * read_time: read a time from an open file. !! !! * name_output_file: provide a name for an output file based on a diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index efa03ab8a8..a98f815bc9 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -9,7 +9,7 @@ module MOM_restart use MOM_string_functions, only : lowercase use MOM_grid, only : ocean_grid_type use MOM_io, only : create_file, fieldtype, file_exists, open_file, close_file -use MOM_io, only : read_field, write_field, MOM_read_data, read_data, get_filename_appendix +use MOM_io, only : write_field, MOM_read_data, read_data, get_filename_appendix use MOM_io, only : get_file_info, get_file_atts, get_file_fields, get_file_times use MOM_io, only : vardesc, var_desc, query_vardesc, modify_vardesc use MOM_io, only : MULTIPLE, NETCDF_FILE, READONLY_FILE, SINGLE_FILE @@ -1093,117 +1093,46 @@ subroutine restore_state(filename, directory, day, G, CS) call mpp_get_atts(fields(i),checksum=checksum_file) is_there_a_checksum = .true. endif - if (.NOT. CS%checksum_required ) is_there_a_checksum = .false. ! Do not need to do data checksumming. + if (.NOT. CS%checksum_required) is_there_a_checksum = .false. ! Do not need to do data checksumming. if (associated(CS%var_ptr1d(m)%p)) then ! Read a 1d array, which should be invariant to domain decomposition. call read_data(unit_path(n), varname, CS%var_ptr1d(m)%p, & - no_domain=.true., timelevel=1) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr1d(m)%p) + G%Domain%mpp_domain, timelevel=1) + if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr1d(m)%p) elseif (associated(CS%var_ptr0d(m)%p)) then ! Read a scalar... call read_data(unit_path(n), varname, CS%var_ptr0d(m)%p, & G%Domain%mpp_domain, timelevel=1) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr0d(m)%p) - elseif ((pos == 0) .and. associated(CS%var_ptr2d(m)%p)) then ! Read a non-decomposed 2d array. - ! Probably should query the field type to make sure that the sizes are right. - call read_data(unit_path(n), varname, CS%var_ptr2d(m)%p, & - no_domain=.true., timelevel=1) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL)) - elseif ((pos == 0) .and. associated(CS%var_ptr3d(m)%p)) then ! Read a non-decomposed 3d array. - ! Probably should query the field type to make sure that the sizes are right. - call read_data(unit_path(n), varname, CS%var_ptr3d(m)%p, & - no_domain=.true., timelevel=1) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:)) - elseif ((pos == 0) .and. associated(CS%var_ptr4d(m)%p)) then ! Read a non-decomposed 4d array. - ! Probably should query the field type to make sure that the sizes are right. - call read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, & - no_domain=.true., timelevel=1) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:)) - elseif (unit_is_global(n) .or. G%Domain%use_io_layout) then - if (associated(CS%var_ptr3d(m)%p)) then - ! Read 3d array... Time level 1 is always used. - call MOM_read_data(unit_path(n), varname, CS%var_ptr3d(m)%p, & - G%Domain, 1, position=pos) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:)) - elseif (associated(CS%var_ptr2d(m)%p)) then ! Read 2d array... + if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr0d(m)%p) + elseif (associated(CS%var_ptr2d(m)%p)) then ! Read a 2d array. + if (pos /= 0) then call MOM_read_data(unit_path(n), varname, CS%var_ptr2d(m)%p, & - G%Domain, 1, position=pos) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL)) - elseif (associated(CS%var_ptr4d(m)%p)) then ! Read 4d array... - call MOM_read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, & - G%Domain, 1, position=pos) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:)) - else - call MOM_error(FATAL, "MOM_restart restore_state: "//& - "No pointers set for "//trim(varname)) - endif - else ! Do not use an io_layout. !### GET RID OF THIS BRANCH ONCE read_data_4d_new IS AVAILABLE. - ! This file is decomposed onto the current processors. We need - ! to check whether the sizes look right, and abort if not. - call get_file_atts(fields(i),ndim=ndim,siz=sizes) - - ! NOTE: The index ranges f var_ptrs always start with 1, so with - ! symmetric memory the staggering is swapped from NE to SW! - is0 = 1-G%isd - if ((pos == EAST_FACE) .or. (pos == CORNER)) is0 = 1-G%IsdB - if (sizes(1) == G%iec-G%isc+1) then - isL = G%isc+is0 ; ieL = G%iec+is0 - elseif (sizes(1) == G%IecB-G%IscB+1) then - isL = G%IscB+is0 ; ieL = G%IecB+is0 - elseif (((pos == EAST_FACE) .or. (pos == CORNER)) .and. & - (G%IscB == G%isc) .and. (sizes(1) == G%iec-G%isc+2)) then - ! This is reading a symmetric file in a non-symmetric model. - isL = G%isc-1+is0 ; ieL = G%iec+is0 - else - call MOM_error(WARNING, "MOM_restart restore_state, "//trim(varname)//& - " has the wrong i-size in "//trim(unit_path(n))) - exit + G%Domain, timelevel=1, position=pos) + else ! This array is not domain-decomposed. This variant may be under-tested. + call read_data(unit_path(n), varname, CS%var_ptr2d(m)%p, & + no_domain=.true., timelevel=1) endif - - js0 = 1-G%jsd - if ((pos == NORTH_FACE) .or. (pos == CORNER)) js0 = 1-G%JsdB - if (sizes(2) == G%jec-G%jsc+1) then - jsL = G%jsc+js0 ; jeL = G%jec+js0 - elseif (sizes(2) == G%jecB-G%jscB+1) then - jsL = G%jscB+js0 ; jeL = G%jecB+js0 - elseif (((pos == NORTH_FACE) .or. (pos == CORNER)) .and. & - (G%JscB == G%jsc) .and. (sizes(2) == G%jec-G%jsc+2)) then - ! This is reading a symmetric file in a non-symmetric model. - jsL = G%jsc-1+js0 ; jeL = G%jec+js0 - else - call MOM_error(WARNING, "MOM_restart restore_state, "//trim(varname)//& - " has the wrong j-size in "//trim(unit_path(n))) - exit + if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL)) + elseif (associated(CS%var_ptr3d(m)%p)) then ! Read a 3d array. + if (pos /= 0) then + call MOM_read_data(unit_path(n), varname, CS%var_ptr3d(m)%p, & + G%Domain, timelevel=1, position=pos) + else ! This array is not domain-decomposed. This variant may be under-tested. + call read_data(unit_path(n), varname, CS%var_ptr3d(m)%p, & + no_domain=.true., timelevel=1) endif - - if (associated(CS%var_ptr3d(m)%p)) then - if (ntime == 0) then - call read_field(unit(n), fields(i), & - CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:)) - else - call read_field(unit(n), fields(i), & - CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:), 1) - endif - elseif (associated(CS%var_ptr2d(m)%p)) then - if (ntime == 0) then - call read_field(unit(n), fields(i), & - CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL)) - else - call read_field(unit(n), fields(i), & - CS%var_ptr2d(m)%p(isL:ieL,jsL:jeL), 1) - endif - elseif (associated(CS%var_ptr4d(m)%p)) then - if (ntime == 0) then - call read_field(unit(n), fields(i), & - CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:)) - else - call read_field(unit(n), fields(i), & - CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:), 1) - endif - else - call MOM_error(FATAL, "MOM_restart restore_state: "//& - "No pointers set for "//trim(varname)) + if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr3d(m)%p(isL:ieL,jsL:jeL,:)) + elseif (associated(CS%var_ptr4d(m)%p)) then ! Read a 4d array. + if (pos /= 0) then + call MOM_read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, & + G%Domain, timelevel=1, position=pos) + else ! This array is not domain-decomposed. This variant may be under-tested. + call read_data(unit_path(n), varname, CS%var_ptr4d(m)%p, & + no_domain=.true., timelevel=1) endif + if (is_there_a_checksum) checksum_data = mpp_chksum(CS%var_ptr4d(m)%p(isL:ieL,jsL:jeL,:,:)) + else + call MOM_error(FATAL, "MOM_restart restore_state: No pointers set for "//trim(varname)) endif if (is_root_pe() .and. is_there_a_checksum .and. (checksum_file(1) /= checksum_data)) then @@ -1412,24 +1341,11 @@ function open_restart_units(filename, directory, G, CS, units, file_paths, & threading = MULTIPLE, fileset = SINGLE_FILE) if (present(global_files)) global_files(n) = .true. elseif (CS%parallel_restartfiles) then - if (G%Domain%use_io_layout) then - ! Look for decomposed files using the I/O Layout. - fexists = file_exists(filepath, G%Domain) - if (fexists .and. (present(units))) & - call open_file(units(n), trim(filepath), READONLY_FILE, NETCDF_FILE, & - domain=G%Domain%mpp_domain) - else - ! Look for any PE-specific files of the form NAME.nc.####. - if (num_PEs()>10000) then - write(filepath, '(a,i6.6)' ) trim(filepath)//'.', pe_here() - else - write(filepath, '(a,i4.4)' ) trim(filepath)//'.', pe_here() - endif - inquire(file=filepath, exist=fexists) - if (fexists .and. (present(units))) & - call open_file(units(n), trim(filepath), READONLY_FILE, NETCDF_FILE, & - threading = MULTIPLE, fileset = SINGLE_FILE) - endif + ! Look for decomposed files using the I/O Layout. + fexists = file_exists(filepath, G%Domain) + if (fexists .and. (present(units))) & + call open_file(units(n), trim(filepath), READONLY_FILE, NETCDF_FILE, & + domain=G%Domain%mpp_domain) if (fexists .and. present(global_files)) global_files(n) = .false. endif diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index be82ffc33f..9f7c5dcc28 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -220,7 +220,6 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) SGdom%niglobal = 2*G%domain%niglobal SGdom%njglobal = 2*G%domain%njglobal SGdom%layout(:) = G%domain%layout(:) - SGdom%use_io_layout = G%domain%use_io_layout SGdom%io_layout(:) = G%domain%io_layout(:) global_indices(1) = 1+SGdom%nihalo global_indices(2) = SGdom%niglobal+SGdom%nihalo @@ -241,8 +240,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) symmetry=.true., name="MOM_MOSAIC") endif - if (SGdom%use_io_layout) & - call MOM_define_IO_domain(SGdom%mpp_domain, SGdom%io_layout) + call MOM_define_IO_domain(SGdom%mpp_domain, SGdom%io_layout) deallocate(exni) deallocate(exnj) From fd733157c0591fd6c21b08cf68bae1cedc42e826 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Fri, 24 Aug 2018 10:21:50 -0400 Subject: [PATCH 0664/1072] Fix scalar restart variable checksums - For scalar variables mpp_chksum has to be called with passing the pelist argument equal to the current pe, otherwise checksums will not agree on different pes - This fixes the symptom of checksum mismatch for scalar var BTDT for different layouts. --- src/framework/MOM_restart.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index efa03ab8a8..cae8001032 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -17,7 +17,7 @@ module MOM_restart use MOM_time_manager, only : time_type, time_type_to_real, real_to_time use MOM_time_manager, only : days_in_month, get_date, set_date use MOM_verticalGrid, only : verticalGrid_type -use mpp_mod, only: mpp_chksum +use mpp_mod, only: mpp_chksum,mpp_pe use mpp_io_mod, only: mpp_attribute_exist, mpp_get_atts implicit none ; private @@ -917,7 +917,7 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV) elseif (associated(CS%var_ptr1d(m)%p)) then check_val(m-start_var+1,1) = mpp_chksum(CS%var_ptr1d(m)%p) elseif (associated(CS%var_ptr0d(m)%p)) then - check_val(m-start_var+1,1) = mpp_chksum(CS%var_ptr0d(m)%p) + check_val(m-start_var+1,1) = mpp_chksum(CS%var_ptr0d(m)%p,pelist=(/mpp_pe()/)) endif enddo @@ -1103,7 +1103,7 @@ subroutine restore_state(filename, directory, day, G, CS) elseif (associated(CS%var_ptr0d(m)%p)) then ! Read a scalar... call read_data(unit_path(n), varname, CS%var_ptr0d(m)%p, & G%Domain%mpp_domain, timelevel=1) - if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr0d(m)%p) + if ( is_there_a_checksum ) checksum_data = mpp_chksum(CS%var_ptr0d(m)%p,pelist=(/mpp_pe()/)) elseif ((pos == 0) .and. associated(CS%var_ptr2d(m)%p)) then ! Read a non-decomposed 2d array. ! Probably should query the field type to make sure that the sizes are right. call read_data(unit_path(n), varname, CS%var_ptr2d(m)%p, & From 0dac02a3e5310cbc35b48393f37075e0ec6325b5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 24 Aug 2018 12:04:33 -0400 Subject: [PATCH 0665/1072] Shortened excessively long comment lines Split comments on lines exceeding 120 characters in length. All answers are bitwise identical. --- src/initialization/midas_vertmap.F90 | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index 95c7b9fa3f..4da55554d3 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -71,7 +71,8 @@ end function wright_eos_2d function alpha_wright_eos_2d(T,S,p) result(drho_dT) real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and Salinity (psu) real, intent(in) :: p !< pressure (Pa) - real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dT !< partial derivative of density with respect to temperature (kg m-3 C-1) + real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dT !< partial derivative of density with + !! respect to temperature (kg m-3 C-1) ! Local variables real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5 real(kind=8) :: al0,lam,p0,I_denom,I_denom2 @@ -110,7 +111,8 @@ end function alpha_wright_eos_2d function beta_wright_eos_2d(T,S,p) result(drho_dS) real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and salinity (psu) real, intent(in) :: p !< pressure (Pa) - real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dS !< partial derivative of density with respect to salinity (kg m-3 PSU-1) + real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dS !< partial derivative of density with + !! respect to salinity (kg m-3 PSU-1) ! Local variables real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5 real(kind=8) :: al0,lam,p0,I_denom,I_denom2 @@ -150,7 +152,8 @@ function tracer_z_init(tr_in,z_edges,e,nkml,nkbl,land_fill,wet,nlay,nlevs,debug, integer, intent(in) :: nkbl !< The number of buffer layers real, intent(in) :: land_fill !< fill in data over land (1) real, dimension(size(tr_in,1),size(tr_in,2)), intent(in) :: wet !< The wet mask for the source data (valid points) - real, dimension(size(tr_in,1),size(tr_in,2)), optional, intent(in) ::nlevs !< The number of input levels with valid data + real, dimension(size(tr_in,1),size(tr_in,2)), & + optional, intent(in) :: nlevs !< The number of input levels with valid data logical, optional, intent(in) :: debug !< optional debug flag integer, optional, intent(in) :: i_debug !< i-index of point for debugging integer, optional, intent(in) :: j_debug !< j-index of point for debugging @@ -283,14 +286,12 @@ function tracer_z_init(tr_in,z_edges,e,nkml,nkbl,land_fill,wet,nlay,nlevs,debug, ! For the piecewise parabolic form add the following... ! + C1_3*cur_tr*(z2(kz)**2 + z2(kz)*z1(kz) + z1(kz)**2)) - if (debug_) then - if (PRESENT(i_debug)) then - if (i == i_debug.and.j == j_debug) then - print *,'0004 k,kz,nlevs,sl_tr,tr = ',k,kz,nlevs_data(i,j),sl_tr,tr(i,j,k) - print *,'0005 k,kz,tr(kz),tr(kz-1),tr(kz+1) = ',k,kz,tr_1d(kz),tr_1d(kz-1),tr_1d(kz+1),z_edges(kz+2) - endif - endif - endif + if (debug_) then ; if (PRESENT(i_debug)) then + if (i == i_debug.and.j == j_debug) then + print *,'0004 k,kz,nlevs,sl_tr,tr = ',k,kz,nlevs_data(i,j),sl_tr,tr(i,j,k) + print *,'0005 k,kz,tr(kz),tr(kz-1),tr(kz+1) = ',k,kz,tr_1d(kz),tr_1d(kz-1),tr_1d(kz+1),z_edges(kz+2) + endif + endif ; endif endif k_bot_prev = k_bot From a12d07791ddb4d47314ef853fed496fd83bdb09e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 24 Aug 2018 12:05:34 -0400 Subject: [PATCH 0666/1072] +Renamed GV%Angstrom to GV%Angstrom_H Renamed two elements of the vertical grid type, Angstrom and Angstrom_z, to Angstrom_H and Angstrom_m, for greater clarity and in preparation for adding an additional Angstrom element for then new vertical distance units. All answers are bitwise identical, although names of elements in a transparent type have changed. --- src/core/MOM.F90 | 2 +- src/core/MOM_CoriolisAdv.F90 | 2 +- src/core/MOM_barotropic.F90 | 2 +- src/core/MOM_continuity_PPM.F90 | 8 ++-- src/core/MOM_dynamics_split_RK2.F90 | 2 +- src/core/MOM_forcing_type.F90 | 2 +- src/core/MOM_verticalGrid.F90 | 12 ++--- src/diagnostics/MOM_PointAccel.F90 | 4 +- src/diagnostics/MOM_diag_to_Z.F90 | 2 +- .../MOM_state_initialization.F90 | 46 +++++++++---------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 6 +-- .../lateral/MOM_mixed_layer_restrat.F90 | 4 +- .../lateral/MOM_thickness_diffuse.F90 | 6 +-- .../vertical/MOM_bulk_mixed_layer.F90 | 14 +++--- .../vertical/MOM_diabatic_aux.F90 | 8 ++-- .../vertical/MOM_diabatic_driver.F90 | 14 +++--- .../vertical/MOM_energetic_PBL.F90 | 2 +- .../vertical/MOM_entrain_diffusive.F90 | 30 ++++++------ .../vertical/MOM_geothermal.F90 | 13 +++--- .../vertical/MOM_opacity.F90 | 4 +- .../vertical/MOM_regularize_layers.F90 | 18 ++++---- .../vertical/MOM_set_diffusivity.F90 | 16 +++---- .../vertical/MOM_set_viscosity.F90 | 22 ++++----- .../vertical/MOM_shortwave_abs.F90 | 4 +- src/parameterizations/vertical/MOM_sponge.F90 | 14 +++--- .../vertical/MOM_vert_friction.F90 | 2 +- src/tracer/DOME_tracer.F90 | 2 +- src/tracer/MOM_generic_tracer.F90 | 2 +- src/tracer/MOM_offline_aux.F90 | 14 +++--- src/tracer/MOM_offline_main.F90 | 6 +-- src/tracer/MOM_tracer_advect.F90 | 4 +- src/tracer/MOM_tracer_hor_diff.F90 | 2 +- src/user/BFB_initialization.F90 | 4 +- src/user/DOME2d_initialization.F90 | 26 +++++------ src/user/DOME_initialization.F90 | 12 ++--- src/user/ISOMIP_initialization.F90 | 12 ++--- src/user/Neverland_initialization.F90 | 2 +- src/user/Phillips_initialization.F90 | 6 +-- src/user/benchmark_initialization.F90 | 10 ++-- src/user/circle_obcs_initialization.F90 | 6 +-- src/user/dense_water_initialization.F90 | 6 +-- src/user/dumbbell_initialization.F90 | 8 ++-- src/user/lock_exchange_initialization.F90 | 4 +- src/user/seamount_initialization.F90 | 8 ++-- src/user/sloshing_initialization.F90 | 4 +- 45 files changed, 199 insertions(+), 198 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 54b5197ad9..3d869f6681 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1966,7 +1966,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & IsdB = dG%IsdB ; IedB = dG%IedB ; JsdB = dG%JsdB ; JedB = dG%JedB ALLOC_(CS%u(IsdB:IedB,jsd:jed,nz)) ; CS%u(:,:,:) = 0.0 ALLOC_(CS%v(isd:ied,JsdB:JedB,nz)) ; CS%v(:,:,:) = 0.0 - ALLOC_(CS%h(isd:ied,jsd:jed,nz)) ; CS%h(:,:,:) = GV%Angstrom + ALLOC_(CS%h(isd:ied,jsd:jed,nz)) ; CS%h(:,:,:) = GV%Angstrom_H ALLOC_(CS%uh(IsdB:IedB,jsd:jed,nz)) ; CS%uh(:,:,:) = 0.0 ALLOC_(CS%vh(isd:ied,JsdB:JedB,nz)) ; CS%vh(:,:,:) = 0.0 if (use_temperature) then diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 7bff7a68b7..948901ac63 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -222,7 +222,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke h_neglect = GV%H_subroundoff - h_tiny = GV%Angstrom ! Perhaps this should be set to h_neglect instead. + h_tiny = GV%Angstrom_H ! Perhaps this should be set to h_neglect instead. !$OMP parallel do default(private) shared(Isq,Ieq,Jsq,Jeq,G,Area_h) do j=Jsq-1,Jeq+2 ; do I=Isq-1,Ieq+2 diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 674f6f1bff..68ef858090 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -4056,7 +4056,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ! IareaT, IdxCu, and IdyCv need to be allocated with wide halos. ALLOC_(CS%IareaT(CS%isdw:CS%iedw,CS%jsdw:CS%jedw)) ; CS%IareaT(:,:) = 0.0 - ALLOC_(CS%bathyT(CS%isdw:CS%iedw,CS%jsdw:CS%jedw)) ; CS%bathyT(:,:) = GV%Angstrom_z !### Change to 0.0? + ALLOC_(CS%bathyT(CS%isdw:CS%iedw,CS%jsdw:CS%jedw)) ; CS%bathyT(:,:) = GV%Angstrom_m !### Change to 0.0? ALLOC_(CS%IdxCu(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%IdxCu(:,:) = 0.0 ALLOC_(CS%IdyCv(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) ; CS%IdyCv(:,:) = 0.0 ALLOC_(CS%dy_Cu(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%dy_Cu(:,:) = 0.0 diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 131ecfbe13..faa5ec79e2 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -144,7 +144,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, logical :: x_first is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - h_min = GV%Angstrom + h_min = GV%Angstrom_H if (.not.associated(CS)) call MOM_error(FATAL, & "MOM_continuity_PPM: Module must be initialized before it is used.") @@ -312,7 +312,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & enddo ; enddo else call PPM_reconstruction_x(h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), G, LB, & - 2.0*GV%Angstrom, CS%monotonic, simple_2nd=CS%simple_2nd, OBC=OBC) + 2.0*GV%Angstrom_H, CS%monotonic, simple_2nd=CS%simple_2nd, OBC=OBC) endif do I=ish-1,ieh ; visc_rem(I,k) = 1.0 ; enddo enddo @@ -1129,7 +1129,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & enddo ; enddo else call PPM_reconstruction_y(h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), G, LB, & - 2.0*GV%Angstrom, CS%monotonic, simple_2nd=CS%simple_2nd, OBC=OBC) + 2.0*GV%Angstrom_H, CS%monotonic, simple_2nd=CS%simple_2nd, OBC=OBC) endif do i=ish,ieh ; visc_rem(i,k) = 1.0 ; enddo enddo @@ -2255,7 +2255,7 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) "tolerance for SSH is 4 times this value. The default \n"//& "is 0.5*NK*ANGSTROM, and this should not be set less x\n"//& "than about 10^-15*MAXIMUM_DEPTH.", units="m", & - default=0.5*G%ke*GV%Angstrom_z) + default=0.5*G%ke*GV%Angstrom_m) call get_param(param_file, mdl, "ETA_TOLERANCE_AUX", CS%tol_eta_aux, & "The tolerance for free-surface height discrepancies \n"//& diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 0f4bd88111..cf248f5103 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -909,7 +909,7 @@ subroutine register_restarts_dyn_split_RK2(HI, GV, param_file, CS, restart_CS, u ALLOC_(CS%eta(isd:ied,jsd:jed)) ; CS%eta(:,:) = 0.0 ALLOC_(CS%u_av(IsdB:IedB,jsd:jed,nz)) ; CS%u_av(:,:,:) = 0.0 ALLOC_(CS%v_av(isd:ied,JsdB:JedB,nz)) ; CS%v_av(:,:,:) = 0.0 - ALLOC_(CS%h_av(isd:ied,jsd:jed,nz)) ; CS%h_av(:,:,:) = GV%Angstrom + ALLOC_(CS%h_av(isd:ied,jsd:jed,nz)) ; CS%h_av(:,:,:) = GV%Angstrom_H thickness_units = get_thickness_units(GV) flux_units = get_flux_units(GV) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 9ac616dac0..443ae86cd7 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -856,7 +856,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, fluxes, optics, h, Temp, Salt, tv, j, useRiverHeatContent = .False. useCalvingHeatContent = .False. - depthBeforeScalingFluxes = max( GV%Angstrom, 1.e-30*GV%m_to_H ) + depthBeforeScalingFluxes = max( GV%Angstrom_H, 1.e-30*GV%m_to_H ) pressure(:) = 0. ! Ignore atmospheric pressure GoRho = GV%g_Earth / GV%Rho0 start = 1 + G%isc - G%isd diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 4eb972148b..e66c137d88 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -34,8 +34,8 @@ module MOM_verticalGrid ! The following variables give information about the vertical grid. logical :: Boussinesq !< If true, make the Boussinesq approximation. - real :: Angstrom !< A one-Angstrom thickness in the model thickness units. - real :: Angstrom_z !< A one-Angstrom thickness in m. + real :: Angstrom_H !< A one-Angstrom thickness in the model thickness units. + real :: Angstrom_m !< A one-Angstrom thickness in m. real :: H_subroundoff !< A thickness that is so small that it can be added to a thickness of !! Angstrom or larger without changing it at the bit level, in thickness units. !! If Angstrom is 0 or exceedingly small, this is negligible compared to 1e-17 m. @@ -87,7 +87,7 @@ subroutine verticalGridInit( param_file, GV ) units="kg m-3", default=1035.0) call get_param(param_file, mdl, "BOUSSINESQ", GV%Boussinesq, & "If true, make the Boussinesq approximation.", default=.true.) - call get_param(param_file, mdl, "ANGSTROM", GV%Angstrom_z, & + call get_param(param_file, mdl, "ANGSTROM", GV%Angstrom_m, & "The minumum layer thickness, usually one-Angstrom.", & units="m", default=1.0e-10) call get_param(param_file, mdl, "H_RESCALE_POWER", H_power, & @@ -128,14 +128,14 @@ subroutine verticalGridInit( param_file, GV ) GV%H_to_kg_m2 = GV%Rho0 * GV%H_to_m GV%kg_m2_to_H = 1.0 / GV%H_to_kg_m2 GV%m_to_H = 1.0 / GV%H_to_m - GV%Angstrom = GV%m_to_H * GV%Angstrom_z + GV%Angstrom_H = GV%m_to_H * GV%Angstrom_m else GV%kg_m2_to_H = 1.0 / GV%H_to_kg_m2 GV%m_to_H = GV%Rho0 * GV%kg_m2_to_H GV%H_to_m = GV%H_to_kg_m2 / GV%Rho0 - GV%Angstrom = GV%Angstrom_z*1000.0*GV%kg_m2_to_H + GV%Angstrom_H = GV%Angstrom_m*1000.0*GV%kg_m2_to_H endif - GV%H_subroundoff = 1e-20 * max(GV%Angstrom,GV%m_to_H*1e-17) + GV%H_subroundoff = 1e-20 * max(GV%Angstrom_H,GV%m_to_H*1e-17) GV%H_to_Pa = GV%g_Earth * GV%H_to_kg_m2 ! Log derivative values. diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 6f93c7b0f0..639e52a8b7 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -102,7 +102,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a logical :: prev_avail integer :: file - Angstrom = GV%Angstrom + GV%H_subroundoff + Angstrom = GV%Angstrom_H + GV%H_subroundoff ! if (.not.associated(CS)) return nz = G%ke @@ -430,7 +430,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a logical :: prev_avail integer :: file - Angstrom = GV%Angstrom + GV%H_subroundoff + Angstrom = GV%Angstrom_H + GV%H_subroundoff ! if (.not.associated(CS)) return nz = G%ke diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index 77e49442af..cc272049d6 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -190,7 +190,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB IsgB = G%IsgB ; IegB = G%IegB ; JsgB = G%JsgB ; JegB = G%JegB nkml = max(GV%nkml, 1) - Angstrom = GV%Angstrom + Angstrom = GV%Angstrom_H ssh(:,:) = ssh_in linear_velocity_profiles = .true. ! Update the halos diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 57820accc0..c612970361 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -660,9 +660,9 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne call adjustEtaToFitBathymetry(G, GV, eta, h) else do k=nz,1,-1 ; do j=js,je ; do i=is,ie - if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_z)) then - eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_m)) then + eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else h(i,j,k) = GV%m_to_H * (eta(i,j,K) - eta(i,j,K+1)) endif @@ -688,7 +688,7 @@ end subroutine initialize_thickness_from_file !> Adjust interface heights to fit the bathymetry and diagnose layer thickness. !! !! If the bottom most interface is below the topography then the bottom-most -!! layers are contracted to GV%Angstrom_z. +!! layers are contracted to GV%Angstrom_m. !! If the bottom most interface is above the topography then the entire column !! is dilated (expanded) to fill the void. !! @remark{There is a (hard-wired) "tolerance" parameter such that the @@ -725,9 +725,9 @@ subroutine adjustEtaToFitBathymetry(G, GV, eta, h) do k=nz,1,-1 ; do j=js,je ; do i=is,ie ! Collapse layers to thinnest possible if the thickness less than ! the thinnest possible (or negative). - if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_z)) then - eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom_z + if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_m)) then + eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_m else h(i,j,k) = (eta(i,j,K) - eta(i,j,K+1)) endif @@ -807,9 +807,9 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_z)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) endif @@ -885,9 +885,9 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_z)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) endif @@ -1055,9 +1055,9 @@ subroutine depress_surface(h, G, GV, param_file, tv, just_read_params) do k=1,nz if (eta(i,j,K) <= eta_sfc(i,j)) exit if (eta(i,j,K+1) >= eta_sfc(i,j)) then - h(i,j,k) = GV%Angstrom + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = max(GV%Angstrom, h(i,j,k) * & + h(i,j,k) = max(GV%Angstrom_H, h(i,j,k) * & (eta_sfc(i,j) - eta(i,j,K+1)) / (eta(i,j,K) - eta(i,j,K+1)) ) endif enddo @@ -1757,8 +1757,8 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, eta(i,j,nz+1) = -G%bathyT(i,j) enddo ; enddo do k=nz,1,-1 ; do j=js,je ; do i=is,ie - if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_z)) & - eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_z + if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_m)) & + eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_m enddo ; enddo ; enddo ! Set the inverse damping rates so that the model will know where to ! apply the sponges, along with the interface heights. @@ -1783,8 +1783,8 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, enddo ; enddo do k=nz,1,-1 ; do j=js,je ; do i=is,ie - if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_z)) & - eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_z + if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_m)) & + eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_m enddo ; enddo ; enddo do k=1,nz; do j=js,je ; do i=is,ie h(i,j,k) = eta(i,j,k)-eta(i,j,k+1) @@ -2246,9 +2246,9 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) call adjustEtaToFitBathymetry(G, GV, zi, h) else do k=nz,1,-1 ; do j=js,je ; do i=is,ie - if (zi(i,j,K) < (zi(i,j,K+1) + GV%Angstrom_z)) then - zi(i,j,K) = zi(i,j,K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (zi(i,j,K) < (zi(i,j,K+1) + GV%Angstrom_m)) then + zi(i,j,K) = zi(i,j,K+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else h(i,j,k) = GV%m_to_H * (zi(i,j,K) - zi(i,j,K+1)) endif @@ -2374,7 +2374,7 @@ subroutine MOM_state_init_tests(G, GV, tv) write(0,*) ' ==================================================================== ' write(0,*) '' write(0,*) h - call cut_off_column_top(nk, tv, GV%Rho0, GV%g_Earth, -e(nk+1), GV%Angstrom, & + call cut_off_column_top(nk, tv, GV%Rho0, GV%g_Earth, -e(nk+1), GV%Angstrom_H, & T, T_t, T_b, S, S_t, S_b, 0.5*P_tot, h, remap_CS) write(0,*) h diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index ecc586d025..738c6dd2f0 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -618,7 +618,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) one_meter = 1.0 * GV%m_to_H h_neglect = GV%H_subroundoff - H_cutoff = real(2*nz) * (GV%Angstrom + h_neglect) + H_cutoff = real(2*nz) * (GV%Angstrom_H + h_neglect) !$OMP parallel default(none) shared(is,ie,js,je,CS,nz,e,G,GV,h,H_cutoff,h_neglect, & !$OMP one_meter,SN_u_local,SN_v_local,calculate_slopes) & @@ -691,7 +691,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) enddo ; enddo ! SN above contains S^2*N^2*H, convert to vertical average of S*N do I=is-1,ie - !SN_u(I,j) = sqrt( SN_u(I,j) / ( max(G%bathyT(I,j), G%bathyT(I+1,j)) + GV%Angstrom ) ) + !SN_u(I,j) = sqrt( SN_u(I,j) / ( max(G%bathyT(I,j), G%bathyT(I+1,j)) + GV%Angstrom_H ) ) !The code below behaves better than the line above. Not sure why? AJA if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_m ) then CS%SN_u(I,j) = G%mask2dCu(I,j) * sqrt( CS%SN_u(I,j) / max(G%bathyT(I,j), G%bathyT(I+1,j)) ) @@ -706,7 +706,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) CS%SN_v(i,J) = CS%SN_v(i,J) + SN_v_local(i,J,k) enddo ; enddo do i=is,ie - !SN_v(i,J) = sqrt( SN_v(i,J) / ( max(G%bathyT(i,J), G%bathyT(i,J+1)) + GV%Angstrom ) ) + !SN_v(i,J) = sqrt( SN_v(i,J) / ( max(G%bathyT(i,J), G%bathyT(i,J+1)) + GV%Angstrom_H ) ) !The code below behaves better than the line above. Not sure why? AJA if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_m ) then CS%SN_v(i,J) = G%mask2dCv(i,J) * sqrt( CS%SN_v(i,J) / max(G%bathyT(i,J), G%bathyT(i,J+1)) ) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index f37b298edc..1d156620a0 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -304,7 +304,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var keep_going = .true. do k=1,nz do i=is-1,ie+1 - h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom),0.0) + h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) enddo if (keep_going) then call calculate_density(tv%T(:,j,k),tv%S(:,j,k),p0,rho_ml(:),is-1,ie-is+3,tv%eqn_of_state) @@ -625,7 +625,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) do i=is-1,ie+1 Rml_av(i,j) = Rml_av(i,j) + h(i,j,k)*Rho0(i) htot(i,j) = htot(i,j) + h(i,j,k) - h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom),0.0) + h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) enddo enddo diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index fd05c4a5a2..0cf6880e7c 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -376,7 +376,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS do j=js,je ; do i=is,ie h(i,j,k) = h(i,j,k) - dt * G%IareaT(i,j) * & ((uhD(I,j,k) - uhD(I-1,j,k)) + (vhD(i,J,k) - vhD(i,J-1,k))) - if (h(i,j,k) < GV%Angstrom) h(i,j,k) = GV%Angstrom + if (h(i,j,k) < GV%Angstrom_H) h(i,j,k) = GV%Angstrom_H enddo ; enddo enddo @@ -552,7 +552,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV h_avail_rsum(i,j,1) = 0.0 pres(i,j,1) = 0.0 ! ### This should be atmospheric pressure. - h_avail(i,j,1) = max(I4dt*G%areaT(i,j)*(h(i,j,1)-GV%Angstrom),0.0) + h_avail(i,j,1) = max(I4dt*G%areaT(i,j)*(h(i,j,1)-GV%Angstrom_H),0.0) h_avail_rsum(i,j,2) = h_avail(i,j,1) h_frac(i,j,1) = 1.0 pres(i,j,2) = pres(i,j,1) + GV%H_to_Pa*h(i,j,1) @@ -560,7 +560,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !$OMP do do j=js-1,je+1 do k=2,nz ; do i=is-1,ie+1 - h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom),0.0) + h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) h_avail_rsum(i,j,k+1) = h_avail_rsum(i,j,k) + h_avail(i,j,k) h_frac(i,j,k) = 0.0 ; if (h_avail(i,j,k) > 0.0) & h_frac(i,j,k) = h_avail(i,j,k) / h_avail_rsum(i,j,k+1) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 1974249df1..ab05237607 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -503,7 +503,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & do k=1,nz ; do i=is,ie h(i,k) = h_3d(i,j,k) ; u(i,k) = u_3d(i,j,k) ; v(i,k) = v_3d(i,j,k) h_orig(i,k) = h_3d(i,j,k) - eps(i,k) = 0.0 ; if (k > nkmb) eps(i,k) = GV%Angstrom + eps(i,k) = 0.0 ; if (k > nkmb) eps(i,k) = GV%Angstrom_H T(i,k) = tv%T(i,j,k) ; S(i,k) = tv%S(i,j,k) do n=1,nsw opacity_band(n,i,k) = GV%H_to_m*optics%opacity_band(n,i,j,k) @@ -1169,7 +1169,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & C2, & ! Temporary variable with units of kg m-3 H-1. r_SW_top ! Temporary variables with units of H kg m-3. - Angstrom = GV%Angstrom + Angstrom = GV%Angstrom_H C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 g_H2_2Rho0 = (GV%g_Earth * GV%H_to_m**2) / (2.0 * GV%Rho0) Idt = 1.0/dt @@ -1931,7 +1931,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & endif h_ent = h_ent + dh_Newt - if (ABS(dh_Newt) < 0.2*GV%Angstrom) exit + if (ABS(dh_Newt) < 0.2*GV%Angstrom_H) exit enddo endif @@ -2597,7 +2597,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, Rho0xG = GV%Rho0 * GV%g_Earth Idt_H2 = GV%H_to_m**2 / dt_diag I2Rho0 = 0.5 / GV%Rho0 - Angstrom = GV%Angstrom + Angstrom = GV%Angstrom_H ! This is hard coding of arbitrary and dimensional numbers. h_min_bl_thick = 5.0 * GV%m_to_H @@ -3532,10 +3532,10 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e ! temperature and salinity. If none is available a pseudo-orthogonal ! extrapolation is used. The 10.0 and 0.9 in the following are ! arbitrary but probably about right. - if ((h(i,k+1) < 10.0*GV%Angstrom) .or. & + if ((h(i,k+1) < 10.0*GV%Angstrom_H) .or. & ((RcvTgt(k+1)-Rcv(i,nkmb)) >= 0.9*(Rcv(i,k1) - Rcv(i,0)))) then if (k>=nz-1) then ; orthogonal_extrap = .true. - elseif ((h(i,k+2) <= 10.0*GV%Angstrom) .and. & + elseif ((h(i,k+2) <= 10.0*GV%Angstrom_H) .and. & ((RcvTgt(k+1)-Rcv(i,nkmb)) < 0.9*(Rcv(i,k+2)-Rcv(i,0)))) then k1 = k+2 else ; orthogonal_extrap = .true. ; endif @@ -3782,7 +3782,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) "layers before sorting when ML_RESORT is true.", & units="nondim", default=0, fail_if_missing=.true.) ! Fail added by AJA. ! This gives a minimum decay scale that is typically much less than Angstrom. - ustar_min_dflt = 2e-4*CS%omega*(GV%Angstrom_z + GV%H_to_m*GV%H_subroundoff) + ustar_min_dflt = 2e-4*CS%omega*(GV%Angstrom_m + GV%H_to_m*GV%H_subroundoff) call get_param(param_file, mdl, "BML_USTAR_MIN", CS%ustar_min, & "The minimum value of ustar that should be used by the \n"//& "bulk mixed layer model in setting vertical TKE decay \n"//& diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index f662eda365..def2d87323 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -177,7 +177,7 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf) endif hc = (tv%C_p*GV%H_to_kg_m2) * h(i,j,k) - if (h(i,j,k) <= 10.0*GV%Angstrom) then + if (h(i,j,k) <= 10.0*GV%Angstrom_H) then ! Very thin layers should not be cooled by the frazil flux. if (tv%T(i,j,k) < T_freeze(i)) then fraz_col(i) = fraz_col(i) + hc * (T_freeze(i) - tv%T(i,j,k)) @@ -340,7 +340,7 @@ subroutine adjust_salt(h, tv, G, GV, CS) if ((G%mask2dT(i,j) > 0.0) .and. & ((tv%S(i,j,k) < S_min) .or. (salt_add_col(i,j) > 0.0))) then mc = GV%H_to_kg_m2 * h(i,j,k) - if (h(i,j,k) <= 10.0*GV%Angstrom) then + if (h(i,j,k) <= 10.0*GV%Angstrom_H) then ! Very thin layers should not be adjusted by the salt flux if (tv%S(i,j,k) < S_min) then salt_add_col(i,j) = salt_add_col(i,j) + mc * (S_min - tv%S(i,j,k)) @@ -421,7 +421,7 @@ subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) do i=is,ie T(i,k)=tv%T(i,j,k); S(i,k)=tv%S(i,j,k) ! avoid very small thickness - h_2d(i,k)=MAX(h(i,j,k), GV%Angstrom) + h_2d(i,k)=MAX(h(i,j,k), GV%Angstrom_H) enddo call calculate_density(T(:,k), S(:,k), p_ref_cv, Rcv(:,k), is, & @@ -845,7 +845,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & ! To accommodate vanishing upper layers, we need to allow for an instantaneous ! distribution of forcing over some finite vertical extent. The bulk mixed layer ! code handles this issue properly. - H_limit_fluxes = max(GV%Angstrom, 1.E-30*GV%m_to_H) + H_limit_fluxes = max(GV%Angstrom_H, 1.E-30*GV%m_to_H) ! diagnostic to see if need to create mass to avoid grounding if (CS%id_createdH>0) CS%createdH(:,:) = 0. diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index e3806fd684..719c4cc184 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1783,10 +1783,10 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en hold(i,j,nz) = h(i,j,nz) h(i,j,nz) = h(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)) if (h(i,j,1) <= 0.0) then - h(i,j,1) = GV%Angstrom + h(i,j,1) = GV%Angstrom_H endif if (h(i,j,nz) <= 0.0) then - h(i,j,nz) = GV%Angstrom + h(i,j,nz) = GV%Angstrom_H endif enddo do k=2,nz-1 ; do i=is,ie @@ -1794,7 +1794,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en h(i,j,k) = h(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & (eb(i,j,k) - ea(i,j,k+1))) if (h(i,j,k) <= 0.0) then - h(i,j,k) = GV%Angstrom + h(i,j,k) = GV%Angstrom_H endif enddo ; enddo enddo @@ -2228,12 +2228,12 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !$OMP parallel do default(shared) do k=1,nz do i=is-1,ie+1 - hold(i,js-1,k) = GV%Angstrom ; ea(i,js-1,k) = 0.0 ; eb(i,js-1,k) = 0.0 - hold(i,je+1,k) = GV%Angstrom ; ea(i,je+1,k) = 0.0 ; eb(i,je+1,k) = 0.0 + hold(i,js-1,k) = GV%Angstrom_H ; ea(i,js-1,k) = 0.0 ; eb(i,js-1,k) = 0.0 + hold(i,je+1,k) = GV%Angstrom_H ; ea(i,je+1,k) = 0.0 ; eb(i,je+1,k) = 0.0 enddo do j=js,je - hold(is-1,j,k) = GV%Angstrom ; ea(is-1,j,k) = 0.0 ; eb(is-1,j,k) = 0.0 - hold(ie+1,j,k) = GV%Angstrom ; ea(ie+1,j,k) = 0.0 ; eb(ie+1,j,k) = 0.0 + hold(is-1,j,k) = GV%Angstrom_H ; ea(is-1,j,k) = 0.0 ; eb(is-1,j,k) = 0.0 + hold(ie+1,j,k) = GV%Angstrom_H ; ea(ie+1,j,k) = 0.0 ; eb(ie+1,j,k) = 0.0 enddo enddo diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 3074faa243..22204ae3f6 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -2227,7 +2227,7 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) units="nondim", default=0.95) endif ! This gives a minimum decay scale that is typically much less than Angstrom. - CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_z + GV%H_to_m*GV%H_subroundoff) + CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_m + GV%H_to_m*GV%H_subroundoff) call log_param(param_file, mdl, "EPBL_USTAR_MIN", CS%ustar_min, & "The (tiny) minimum friction velocity used within the \n"//& "ePBL code, derived from OMEGA and ANGSTROM.", units="m s-1") diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 03d01ba201..df3783fa32 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -204,7 +204,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & integer :: kb_min_act ! The minimum active value of kb in the current j-row. integer :: is1, ie1 ! The minimum and maximum active values of i in the current j-row. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - Angstrom = GV%Angstrom + Angstrom = GV%Angstrom_H h_neglect = GV%H_subroundoff if (.not. associated(CS)) call MOM_error(FATAL, & @@ -964,7 +964,7 @@ subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb, ea(i,j,k) = ea(i,j,k+1) ! Add the entrainment of the thin interior layers to eb going ! up into the buffer layer. - eb(i,j,k) = eb(i,j,k+1) + max(0.0, h(i,j,k+1) - GV%Angstrom) + eb(i,j,k) = eb(i,j,k+1) + max(0.0, h(i,j,k+1) - GV%Angstrom_H) endif endif ; enddo ; enddo k = kmb @@ -972,10 +972,10 @@ subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb, ! Adjust the previously calculated entrainment from below by the deepest ! buffer layer to account for entrainment of thin interior layers . if (kb(i) > kmb+1) & - eb(i,j,k) = eb(i,j,k+1) + max(0.0, h(i,j,k+1) - GV%Angstrom) + eb(i,j,k) = eb(i,j,k+1) + max(0.0, h(i,j,k+1) - GV%Angstrom_H) ! Determine the entrainment from above for each buffer layer. - h1 = (h(i,j,k) - GV%Angstrom) + (eb(i,j,k) - ea(i,j,k+1)) + h1 = (h(i,j,k) - GV%Angstrom_H) + (eb(i,j,k) - ea(i,j,k+1)) ea(i,j,k) = MAX(Ent_bl(i,K), Ent_bl(i,K)-0.5*h1, -h1) endif ; enddo do k=kmb-1,2,-1 ; do i=is,ie ; if (do_i(i)) then @@ -983,7 +983,7 @@ subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb, eb(i,j,k) = max(2.0*Ent_bl(i,K+1) - ea(i,j,k+1), 0.0) ! Determine the entrainment from above for each buffer layer. - h1 = (h(i,j,k) - GV%Angstrom) + (eb(i,j,k) - ea(i,j,k+1)) + h1 = (h(i,j,k) - GV%Angstrom_H) + (eb(i,j,k) - ea(i,j,k+1)) ea(i,j,k) = MAX(Ent_bl(i,K), Ent_bl(i,K)-0.5*h1, -h1) ! if (h1 >= 0.0) then ; ea(i,j,k) = Ent_bl(i,K) ! elseif (Ent_bl(i,K)+0.5*h1 >= 0.0) then ; ea(i,j,k) = Ent_bl(i,K)-0.5*h1 @@ -1089,7 +1089,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke -! max_ent = 1.0e14*GV%Angstrom ! This is set to avoid roundoff problems. +! max_ent = 1.0e14*GV%Angstrom_H ! This is set to avoid roundoff problems. max_ent = 1.0e4*GV%m_to_H h_neglect = GV%H_subroundoff @@ -1143,9 +1143,9 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref do k=kmb+1,nz ; do i=is,ie ; if (do_i(i)) then if ((k == kb(i)) .and. (S_est(i,kmb) > (GV%Rlay(k) - 1000.0))) then if (4.0*dtKd_int(i,Kmb+1)*frac_rem(i) > & - (h_bl(i,kmb) + h(i,j,k)) * (h(i,j,k) - GV%Angstrom)) then + (h_bl(i,kmb) + h(i,j,k)) * (h(i,j,k) - GV%Angstrom_H)) then ! Entrain this layer into the buffer layer and move kb down. - dh = max((h(i,j,k) - GV%Angstrom), 0.0) + dh = max((h(i,j,k) - GV%Angstrom_H), 0.0) if (dh > 0.0) then frac_rem(i) = frac_rem(i) - ((h_bl(i,kmb) + h(i,j,k)) * dh) / & (4.0*dtKd_int(i,Kmb+1)) @@ -1163,7 +1163,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref ! This is where variables are be set up with a different vertical grid ! in which the (newly?) massless layers are taken out. do k=nz,kmb+1,-1 ; do i=is,ie - if (k >= kb(i)) h_interior(i) = h_interior(i) + (h(i,j,k)-GV%Angstrom) + if (k >= kb(i)) h_interior(i) = h_interior(i) + (h(i,j,k)-GV%Angstrom_H) if (k==kb(i)) then h_bl(i,kmb+1) = h(i,j,k) ; Sref(i,kmb+1) = GV%Rlay(k) - 1000.0 elseif (k==kb(i)+1) then @@ -1173,7 +1173,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref do i=is,ie ; if (kb(i) >= nz) then h_bl(i,kmb+1) = h(i,j,nz) Sref(i,kmb+1) = GV%Rlay(nz) - 1000.0 - h_bl(i,kmb+2) = GV%Angstrom + h_bl(i,kmb+2) = GV%Angstrom_H Sref(i,kmb+2) = Sref(i,kmb+1) + (GV%Rlay(nz) - GV%Rlay(nz-1)) endif ; enddo @@ -1328,7 +1328,7 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & endif ! Determine the entrainment from above for each buffer layer. - h1 = (h_bl(i,k) - GV%Angstrom) + (eb(i,k) - ea(i,k+1)) + h1 = (h_bl(i,k) - GV%Angstrom_H) + (eb(i,k) - ea(i,k+1)) if (h1 >= 0.0) then ea(i,k) = Ent_bl(i,K) ; dea_dE(i,k) = 0.0 elseif (Ent_bl(i,K) + 0.5*h1 >= 0.0) then @@ -1411,7 +1411,7 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & if (present(dSLay)) then dz_drat = 1000.0 ! The limit of large dz_drat the same as choosing a ! Heaviside function. - eps_dSLay = 1.0e-10 ! Should be ~= GV%Angstrom / sqrt(Kd*dt) + eps_dSLay = 1.0e-10 ! Should be ~= GV%Angstrom_H / sqrt(Kd*dt) do i=is,ie ; if (do_i(i)) then dS_kbp1 = Sref(i,kmb+2) - Sref(i,kmb+1) IdS_kbp1 = 1.0 / (Sref(i,kmb+2) - Sref(i,kmb+1)) @@ -1758,7 +1758,7 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & fa = (1.0 + eL) + dS_kb(i)*I_dSkbp1(i) fk = dtKd_kb(i) * (dS_Lay(i)/dS_kb(i)) fm = (ea_kbp1(i) - h_bl(i,kmb+1)) + eL*2.0*Ent_bl(i,Kmb+1) - if (fm > -GV%Angstrom) fm = fm + GV%Angstrom ! This could be smooth if need be. + if (fm > -GV%Angstrom_H) fm = fm + GV%Angstrom_H ! This could be smooth if need be. err(i) = (fa * Ent(i)**2 - fm * Ent(i)) - fk derror_dE(i) = ((2.0*fa + (ddSkb_dE(i)*I_dSkbp1(i))*Ent(i))*Ent(i) - fm) - & dtKd_kb(i) * (ddSlay_dE(i)*dS_kb(i) - ddSkb_dE(i)*dS_Lay(i))/(dS_kb(i)**2) @@ -2185,10 +2185,10 @@ subroutine entrain_diffusive_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mod, "DT", dt, & "The (baroclinic) dynamics time step.", units = "s", & fail_if_missing=.true.) -! CS%Tolerance_Ent = MAX(100.0*GV%Angstrom,1.0e-4*sqrt(dt*Kd)) ! +! CS%Tolerance_Ent = MAX(100.0*GV%Angstrom_H,1.0e-4*sqrt(dt*Kd)) ! call get_param(param_file, mod, "TOLERANCE_ENT", CS%Tolerance_Ent, & "The tolerance with which to solve for entrainment values.", & - units="m", default=MAX(100.0*GV%Angstrom_Z,1.0e-4*sqrt(dt*Kd))) + units="m", default=MAX(100.0*GV%Angstrom_m,1.0e-4*sqrt(dt*Kd))) CS%id_Kd = register_diag_field('ocean_model', 'Kd_effective', diag%axesTL, Time, & 'Diapycnal diffusivity as applied', 'm2 s-1') diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 360c3a791d..aede558414 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -112,7 +112,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS) nkmb = GV%nk_rho_varies Irho_cp = 1.0 / (GV%H_to_kg_m2 * tv%C_p) - Angstrom = GV%Angstrom + Angstrom = GV%Angstrom_H H_neglect = GV%H_subroundoff p_ref(:) = tv%P_Ref @@ -400,10 +400,11 @@ end subroutine geothermal_end !> \namespace mom_geothermal !! -!! Geothermal heating can be added either in a layered isopycnal mode, in which the heating raises the density of the layer to the -!! target density of the layer above, and then moves the water into that layer, or in a simple Eulerian mode, in which the bottommost -!! GEOTHERMAL_THICKNESS are heated. Geothermal heating will also provide a buoyant source of bottom TKE that can be used to further -!! mix the near-bottom water. In cold fresh water lakes where heating increases density, water should be moved into deeper layers, but -!! this is not implemented yet. +!! Geothermal heating can be added either in a layered isopycnal mode, in which the heating raises the density +!! of the layer to the target density of the layer above, and then moves the water into that layer, or in a +!! simple Eulerian mode, in which the bottommost GEOTHERMAL_THICKNESS are heated. Geothermal heating will also +!! provide a buoyant source of bottom TKE that can be used to further mix the near-bottom water. In cold fresh +!! water lakes where heating increases density, water should be moved into deeper layers, but this is not +!! implemented yet. end module MOM_geothermal diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index ca2afdc655..db90deeaca 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -115,14 +115,14 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) else ; Inv_nbands = 1.0 / real(optics%nbands) ; endif ! Make sure there is no division by 0. - inv_sw_pen_scale = 1.0 / max(CS%pen_sw_scale, 0.1*GV%Angstrom_z, & + inv_sw_pen_scale = 1.0 / max(CS%pen_sw_scale, 0.1*GV%Angstrom_m, & GV%H_to_m*GV%H_subroundoff) if ( CS%Opacity_scheme == DOUBLE_EXP ) then !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie optics%opacity_band(1,i,j,k) = inv_sw_pen_scale optics%opacity_band(2,i,j,k) = 1.0 / max(CS%pen_sw_scale_2nd, & - 0.1*GV%Angstrom_z,GV%H_to_m*GV%H_subroundoff) + 0.1*GV%Angstrom_m,GV%H_to_m*GV%H_subroundoff) enddo ; enddo ; enddo if (.not.associated(fluxes%sw) .or. (CS%pen_SW_scale <= 0.0)) then !$OMP parallel do default(shared) diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 1b9b1ff6ef..2b5aa4802b 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -337,20 +337,20 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) do K=1,nz_filt ; do i=is,ie ; if (do_i(i)) then if (G%mask2dCu(I,j) <= 0.0) then ; e_e = e(i,j,K) ; else e_e = max(e(i+1,j,K) + min(e(i,j,K) - e(i+1,j,nz+1), 0.0), & - e(i,j,nz+1) + (nz+1-k)*GV%Angstrom) + e(i,j,nz+1) + (nz+1-k)*GV%Angstrom_H) endif if (G%mask2dCu(I-1,j) <= 0.0) then ; e_w = e(i,j,K) ; else e_w = max(e(i-1,j,K) + min(e(i,j,K) - e(i-1,j,nz+1), 0.0), & - e(i,j,nz+1) + (nz+1-k)*GV%Angstrom) + e(i,j,nz+1) + (nz+1-k)*GV%Angstrom_H) endif if (G%mask2dCv(i,J) <= 0.0) then ; e_n = e(i,j,K) ; else e_n = max(e(i,j+1,K) + min(e(i,j,K) - e(i,j+1,nz+1), 0.0), & - e(i,j,nz+1) + (nz+1-k)*GV%Angstrom) + e(i,j,nz+1) + (nz+1-k)*GV%Angstrom_H) endif if (G%mask2dCv(i,J-1) <= 0.0) then ; e_s = e(i,j,K) ; else e_s = max(e(i,j-1,K) + min(e(i,j,K) - e(i,j-1,nz+1), 0.0), & - e(i,j,nz+1) + (nz+1-k)*GV%Angstrom) + e(i,j,nz+1) + (nz+1-k)*GV%Angstrom_H) endif wt = max(0.0, min(1.0, I_dtol*(def_rat_h(i,j)-CS%h_def_tol1))) @@ -386,10 +386,10 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) do k=nkmb+1,nz cols_left = .false. do i=is,ie ; if (more_ent_i(i)) then - if (h_2d(i,k) - GV%Angstrom > h_neglect) then - if (e_2d(i,nkmb+1)-e_filt(i,nkmb+1) > h_2d(i,k) - GV%Angstrom) then - h_add = h_2d(i,k) - GV%Angstrom - h_2d(i,k) = GV%Angstrom + if (h_2d(i,k) - GV%Angstrom_H > h_neglect) then + if (e_2d(i,nkmb+1)-e_filt(i,nkmb+1) > h_2d(i,k) - GV%Angstrom_H) then + h_add = h_2d(i,k) - GV%Angstrom_H + h_2d(i,k) = GV%Angstrom_H else h_add = e_2d(i,nkmb+1)-e_filt(i,nkmb+1) h_2d(i,k) = h_2d(i,k) - h_add @@ -644,7 +644,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) h_predicted = h_2d_init(i,k) + ((d_ea(i,k) - d_eb(i,k-1)) + & (d_eb(i,k) - d_ea(i,k+1))) endif - if (abs(h(i,j,k) - h_predicted) > MAX(1e-9*abs(h_predicted),GV%Angstrom)) & + if (abs(h(i,j,k) - h_predicted) > MAX(1e-9*abs(h_predicted),GV%Angstrom_H)) & call MOM_error(FATAL, "regularize_surface: d_ea mismatch.") endif ; enddo ; enddo do i=is,ie ; if (do_i(i)) then diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 8d3206303c..ce5ea313d8 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -762,7 +762,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & ! in sigma-0. do k=kb(i)-1,kmb+1,-1 if (rho_0(i,kmb) > rho_0(i,k)) exit - if (h(i,j,k)>2.0*GV%Angstrom) kb(i) = k + if (h(i,j,k)>2.0*GV%Angstrom_H) kb(i) = k enddo enddo @@ -786,15 +786,15 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & htot(i) = GV%H_to_m*h(i,j,kmb) mFkb(i) = 0.0 if (kb(i) < nz) & - mFkb(i) = ds_dsp1(i,kb(i)) * (GV%H_to_m*(h(i,j,kmb) - GV%Angstrom)) + mFkb(i) = ds_dsp1(i,kb(i)) * (GV%H_to_m*(h(i,j,kmb) - GV%Angstrom_H)) enddo do k=1,kmb-1 ; do i=is,ie htot(i) = htot(i) + GV%H_to_m*h(i,j,k) - mFkb(i) = mFkb(i) + ds_dsp1(i,k+1)*(GV%H_to_m*(h(i,j,k) - GV%Angstrom)) + mFkb(i) = mFkb(i) + ds_dsp1(i,k+1)*(GV%H_to_m*(h(i,j,k) - GV%Angstrom_H)) enddo ; enddo else do i=is,i - maxEnt(i,1) = 0.0 ; htot(i) = GV%H_to_m*(h(i,j,1) - GV%Angstrom) + maxEnt(i,1) = 0.0 ; htot(i) = GV%H_to_m*(h(i,j,1) - GV%Angstrom_H) enddo endif do k=kb_min,nz-1 ; do i=is,ie @@ -803,12 +803,12 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & elseif (k > kb(i)) then maxEnt(i,k) = (1.0/dsp1_ds(i,k))*(maxEnt(i,k-1) + htot(i)) ! maxEnt(i,k) = ds_dsp1(i,k)*(maxEnt(i,k-1) + htot(i)) ! BITWISE CHG - htot(i) = htot(i) + GV%H_to_m*(h(i,j,k) - GV%Angstrom) + htot(i) = htot(i) + GV%H_to_m*(h(i,j,k) - GV%Angstrom_H) endif enddo ; enddo do i=is,ie - htot(i) = GV%H_to_m*(h(i,j,nz) - GV%Angstrom) ; maxEnt(i,nz) = 0.0 + htot(i) = GV%H_to_m*(h(i,j,nz) - GV%Angstrom_H) ; maxEnt(i,nz) = 0.0 do_i(i) = (G%mask2dT(i,j) > 0.5) enddo do k=nz-1,kb_min,-1 @@ -817,7 +817,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & if (k=CS%Hbbl) exit ! terminate the k loop hweight = MIN(CS%Hbbl - htot_vel, h_at_vel(i,k)) - if (hweight < 1.5*GV%Angstrom + h_neglect) cycle + if (hweight < 1.5*GV%Angstrom_H + h_neglect) cycle htot_vel = htot_vel + h_at_vel(i,k) hwtot = hwtot + hweight @@ -795,18 +795,18 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) dV_dL2 = 0.5*(slope+a) - a*L0 ; dVol = (vol-Vol_0) ! dV_dL2 = 0.5*(slope+a) - a*L0 ; dVol = max(vol-Vol_0, 0.0) - !### The following code is more robust when GV%Angstrom=0, but it + !### The following code is more robust when GV%Angstrom_H=0, but it !### changes answers. - ! Vol_tol = max(0.5*GV%Angstrom + GV%H_subroundoff, 1e-14*vol) - ! Vol_quit = max(0.9*GV%Angstrom + GV%H_subroundoff, 1e-14*vol) + ! Vol_tol = max(0.5*GV%Angstrom_H + GV%H_subroundoff, 1e-14*vol) + ! Vol_quit = max(0.9*GV%Angstrom_H + GV%H_subroundoff, 1e-14*vol) ! if (dVol <= 0.0) then ! L(K) = L0 ! Vol_err = 0.5*(L(K)*L(K))*(slope + a_3*(3.0-4.0*L(K))) - vol ! elseif (a*a*dVol**3 < Vol_tol*dV_dL2**2 * & ! (dV_dL2*Vol_tol - 2.0*a*L0*dVol)) then - if (a*a*dVol**3 < GV%Angstrom*dV_dL2**2 * & - (0.25*dV_dL2*GV%Angstrom - a*L0*dVol)) then + if (a*a*dVol**3 < GV%Angstrom_H*dV_dL2**2 * & + (0.25*dV_dL2*GV%Angstrom_H - a*L0*dVol)) then ! One iteration of Newton's method should give an estimate ! that is accurate to within Vol_tol. L(K) = sqrt(L0*L0 + dVol / dV_dL2) @@ -1159,7 +1159,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) use_EOS = associated(tv%eqn_of_state) dt_Rho0 = dt/GV%H_to_kg_m2 h_neglect = GV%H_subroundoff - h_tiny = 2.0*GV%Angstrom + h_neglect + h_tiny = 2.0*GV%Angstrom_H + h_neglect g_H_Rho0 = (GV%g_Earth * GV%H_to_m) / GV%Rho0 H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H @@ -1346,7 +1346,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) if (use_EOS .or. .not.CS%linear_drag) then ; do k=1,nz if (htot_vel>=CS%Htbl_shelf) exit ! terminate the k loop hweight = MIN(CS%Htbl_shelf - htot_vel, h_at_vel(i,k)) - if (hweight <= 1.5*GV%Angstrom + h_neglect) cycle + if (hweight <= 1.5*GV%Angstrom_H + h_neglect) cycle htot_vel = htot_vel + h_at_vel(i,k) hwtot = hwtot + hweight @@ -1591,7 +1591,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) if (use_EOS .or. .not.CS%linear_drag) then ; do k=1,nz if (htot_vel>=CS%Htbl_shelf) exit ! terminate the k loop hweight = MIN(CS%Htbl_shelf - htot_vel, h_at_vel(i,k)) - if (hweight <= 1.5*GV%Angstrom + h_neglect) cycle + if (hweight <= 1.5*GV%Angstrom_H + h_neglect) cycle htot_vel = htot_vel + h_at_vel(i,k) hwtot = hwtot + hweight @@ -1910,7 +1910,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) "The rotation rate of the earth.", units="s-1", & default=7.2921e-5) ! This give a minimum decay scale that is typically much less than Angstrom. - CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_z + GV%H_to_m*GV%H_subroundoff) + CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_m + GV%H_to_m*GV%H_subroundoff) else call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", units="s-1", & diff --git a/src/parameterizations/vertical/MOM_shortwave_abs.F90 b/src/parameterizations/vertical/MOM_shortwave_abs.F90 index 1cf23e9c3e..a81a7803da 100644 --- a/src/parameterizations/vertical/MOM_shortwave_abs.F90 +++ b/src/parameterizations/vertical/MOM_shortwave_abs.F90 @@ -143,7 +143,7 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, min_SW_heating = 2.5e-11 - h_min_heat = 2.0*GV%Angstrom + GV%H_subroundoff + h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff is = G%isc ; ie = G%iec ; nz = G%ke C1_6 = 1.0 / 6.0 ; C1_60 = 1.0 / 60.0 @@ -348,7 +348,7 @@ subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & integer :: is, ie, nz, i, k, ks, n SW_Remains = .false. - h_min_heat = 2.0*GV%Angstrom + GV%H_subroundoff + h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff is = G%isc ; ie = G%iec ; nz = G%ke pen_SW_bnd(:,:) = iPen_SW_bnd(:,:) diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index d4c5e69ed5..ce7471f9e1 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -441,10 +441,10 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) h_above(i,1) = 0.0 ; h_below(i,nz+1) = 0.0 enddo do K=nz,1,-1 ; do i=is,ie - h_below(i,K) = h_below(i,K+1) + max(h(i,j,k)-GV%Angstrom, 0.0) + h_below(i,K) = h_below(i,K+1) + max(h(i,j,k)-GV%Angstrom_H, 0.0) enddo ; enddo do K=2,nz+1 ; do i=is,ie - h_above(i,K) = h_above(i,K-1) + max(h(i,j,k-1)-GV%Angstrom, 0.0) + h_above(i,K) = h_above(i,K-1) + max(h(i,j,k-1)-GV%Angstrom_H, 0.0) enddo ; enddo do K=2,nz ! w is positive for an upward (lightward) flux of mass, resulting @@ -471,7 +471,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) enddo h(i,j,k) = max(h(i,j,k) + (w_int(i,j,K+1) - w_int(i,j,K)), & - min(h(i,j,k), GV%Angstrom)) + min(h(i,j,k), GV%Angstrom_H)) enddo ; enddo endif ; enddo @@ -506,7 +506,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) do k=nz,nkmb+1,-1 if (GV%Rlay(k) > Rcv_ml(i,j)) then w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*GV%m_to_H, & - ((wb + h(i,j,k)) - GV%Angstrom)) + ((wb + h(i,j,k)) - GV%Angstrom_H)) wm = 0.5*(w-ABS(w)) do m=1,CS%fldno CS%var(m)%p(i,j,k) = (h(i,j,k)*CS%var(m)%p(i,j,k) + & @@ -518,7 +518,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) CS%var(m)%p(i,j,k) = I1pdamp * & (CS%var(m)%p(i,j,k) + CS%Ref_val(m)%p(k,c)*damp) enddo - w = wb + (h(i,j,k) - GV%Angstrom) + w = wb + (h(i,j,k) - GV%Angstrom_H) wm = 0.5*(w-ABS(w)) endif eb(i,j,k) = eb(i,j,k) + wpb @@ -530,7 +530,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) if (wb < 0) then do k=nkmb,1,-1 - w = MIN((wb + (h(i,j,k) - GV%Angstrom)),0.0) + w = MIN((wb + (h(i,j,k) - GV%Angstrom_H)),0.0) h(i,j,k) = h(i,j,k) + (wb - w) ea(i,j,k) = ea(i,j,k) - w wb = w @@ -562,7 +562,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) wb = 0.0 do k=nz,1,-1 w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*GV%m_to_H, & - ((wb + h(i,j,k)) - GV%Angstrom)) + ((wb + h(i,j,k)) - GV%Angstrom_H)) wm = 0.5*(w - ABS(w)) do m=1,CS%fldno CS%var(m)%p(i,j,k) = (h(i,j,k)*CS%var(m)%p(i,j,k) + & diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 6b5fcb3202..69d7f4b7e2 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1387,7 +1387,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, CS) maxvel = CS%maxvel truncvel = 0.9*maxvel - H_report = 6.0 * GV%Angstrom + H_report = 6.0 * GV%Angstrom_H dt_Rho0 = dt / GV%Rho0 if (len_trim(CS%u_trunc_file) > 0) then diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 0354f90a51..749962b17f 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -232,7 +232,7 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, h, diag, OBC, CS, & else d_tr = 0.0 endif - if (h(i,j,k) < 2.0*GV%Angstrom) d_tr=0.0 + if (h(i,j,k) < 2.0*GV%Angstrom_H) d_tr=0.0 CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + d_tr enddo enddo diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index b373fc064a..ee1f038180 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -519,7 +519,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, !Prepare input arrays for source update ! - rho_dzt(:,:,:) = GV%H_to_kg_m2 * GV%Angstrom + rho_dzt(:,:,:) = GV%H_to_kg_m2 * GV%Angstrom_H do k = 1, nk ; do j = jsc, jec ; do i = isc, iec !{ rho_dzt(i,j,k) = GV%H_to_kg_m2 * h_old(i,j,k) enddo ; enddo ; enddo !} diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index ffff913eff..dc616e8a49 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -70,7 +70,7 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) ! add a bit of mass to avoid truncation errors. This will lead to ! non-conservation of tracers h_new(i,j,k) = h_new(i,j,k) + & - max(GV%Angstrom, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) + max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) ! Convert back to thickness h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j) @@ -294,7 +294,7 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) endif ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - uh_neglect = GV%Angstrom*min(G%areaT(i,j),G%areaT(i+1,j)) + uh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i+1,j)) if ( abs(sum(uh2d(I,:))-uh2d_sum(I)) > uh_neglect) & call MOM_error(WARNING,"Column integral of uh does not match after "//& "barotropic redistribution") @@ -364,7 +364,7 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) endif ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - vh_neglect = GV%Angstrom*min(G%areaT(i,j),G%areaT(i,j+1)) + vh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i,j+1)) if ( abs(sum(vh2d(J,:))-vh2d_sum(J)) > vh_neglect) then call MOM_error(WARNING,"Column integral of vh does not match after "//& "barotropic redistribution") @@ -400,7 +400,7 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) ! Set index-related variables for fields on T-grid is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - min_h = GV%Angstrom*0.1 + min_h = GV%Angstrom_H*0.1 do j=js,je ! Copy over uh and cell volume to working arrays @@ -460,7 +460,7 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - uh_neglect = GV%Angstrom*min(G%areaT(i,j),G%areaT(i+1,j)) + uh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i+1,j)) if (abs(uh_col - sum(uh2d(I,:)))>uh_neglect) then call MOM_error(WARNING,"Column integral of uh does not match after "//& "upwards redistribution") @@ -498,7 +498,7 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) ! Set index-related variables for fields on T-grid is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - min_h = 0.1*GV%Angstrom + min_h = 0.1*GV%Angstrom_H do i=is,ie ! Copy over uh and cell volume to working arrays @@ -558,7 +558,7 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - vh_neglect = GV%Angstrom*min(G%areaT(i,j),G%areaT(i,j+1)) + vh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i,j+1)) if ( ABS(vh_col-SUM(vh2d(J,:))) > vh_neglect) then call MOM_error(WARNING,"Column integral of vh does not match after "//& "upwards redistribution") diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 0d90d890fd..8a59f69a61 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -450,7 +450,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) if (CS%id_eta_pre_distribute>0) then eta_work(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - if (h_pre(i,j,k)>GV%Angstrom) then + if (h_pre(i,j,k)>GV%Angstrom_H) then eta_work(i,j) = eta_work(i,j) + h_pre(i,j,k) endif enddo ; enddo ; enddo @@ -583,7 +583,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) if (CS%id_eta_post_distribute>0) then eta_work(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - if (h_pre(i,j,k)>GV%Angstrom) then + if (h_pre(i,j,k)>GV%Angstrom_H) then eta_work(i,j) = eta_work(i,j) + h_pre(i,j,k) endif enddo ; enddo ; enddo @@ -1057,7 +1057,7 @@ subroutine update_offline_fields(CS, h, fluxes, do_ale) ! Apply masks/factors at T, U, and V points do k=1,nz ; do j=js,je ; do i=is,ie if (CS%G%mask2dT(i,j)<1.0) then - CS%h_end(i,j,k) = CS%GV%Angstrom + CS%h_end(i,j,k) = CS%GV%Angstrom_H endif enddo ; enddo ; enddo diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 0370aeaee4..589ad07e19 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -382,7 +382,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & stencil = 1 if (usePPM .and. .not. useHuynh) stencil = 2 - min_h = 0.1*GV%Angstrom + min_h = 0.1*GV%Angstrom_H h_neglect = GV%H_subroundoff dt=1.0/Idt @@ -711,7 +711,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & stencil = 1 if (usePPM .and. .not. useHuynh) stencil = 2 - min_h = 0.1*GV%Angstrom + min_h = 0.1*GV%Angstrom_H h_neglect = GV%H_subroundoff dt=1.0/Idt !do i=is,ie ; ts2(i) = 0.0 ; enddo diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 99aa562a60..597b0fc822 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -696,7 +696,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & enddo ; enddo if (PEmax_kRho > nz) PEmax_kRho = nz ! PEmax_kRho could have been nz+1. - h_exclude = 10.0*(GV%Angstrom + GV%H_subroundoff) + h_exclude = 10.0*(GV%Angstrom_H + GV%H_subroundoff) !$OMP parallel default(none) shared(is,ie,js,je,nkmb,G,GV,h,h_exclude,num_srt,k0_srt, & !$OMP rho_srt,h_srt,PEmax_kRho,k_end_srt,rho_coord,max_srt) & !$OMP private(ns,tmp,itmp) diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 972c475683..605d4706ca 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -137,11 +137,11 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, ! do k = 1,nz; eta(i,j,k) = H0(k); enddo ! if (G%geoLatT(i,j) > 40.0) then ! do k = 1,nz - ! eta(i,j,k) = -G%Angstrom_z*(k-1) + ! eta(i,j,k) = -G%Angstrom_m*(k-1) ! enddo ! elseif (G%geoLatT(i,j) > 20.0) then ! do k = 1,nz - ! eta(i,j,k) = min(H0(k) + (G%geoLatT(i,j) - 20.0)*(G%max_depth - nz*G%Angstrom_z)/20.0, -(k-1)*G%angstrom_z) + ! eta(i,j,k) = min(H0(k) + (G%geoLatT(i,j) - 20.0)*(G%max_depth - nz*G%Angstrom_m)/20.0, -(k-1)*G%Angstrom_m) ! enddo ! endif eta(i,j,nz+1) = -G%max_depth diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 474a71d683..1c5c1e5b7f 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -146,9 +146,9 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) endif @@ -156,8 +156,8 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - h(i,j,1:nz-1) = GV%Angstrom - h(i,j,nz) = GV%m_to_H * dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom + h(i,j,1:nz-1) = GV%Angstrom_H + h(i,j,nz) = GV%m_to_H * dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_H endif enddo ; enddo @@ -447,9 +447,9 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom_z + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_m else h(i,j,k) = eta1D(k) - eta1D(k+1) endif @@ -485,9 +485,9 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom_z + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_m else h(i,j,k) = eta1D(k) - eta1D(k+1) endif @@ -495,8 +495,8 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - h(i,j,1:nz-1) = GV%Angstrom - h(i,j,nz) = dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom + h(i,j,1:nz-1) = GV%Angstrom_H + h(i,j,nz) = dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_H endif eta(i,j,nz+1) = -G%bathyT(i,j) diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index e4e35d77e5..03274c0d8c 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -116,9 +116,9 @@ subroutine DOME_initialize_thickness(h, G, GV, param_file, just_read_params) eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_z)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) endif @@ -190,12 +190,12 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) ! depth space for Boussinesq or non-Boussinesq models. eta(i,j,1) = 0.0 do k=2,nz -! eta(i,j,K)=max(H0(k), -G%bathyT(i,j), GV%Angstrom_z*(nz-k+1)-G%bathyT(i,j)) +! eta(i,j,K)=max(H0(k), -G%bathyT(i,j), GV%Angstrom_m*(nz-k+1)-G%bathyT(i,j)) e_dense = -G%bathyT(i,j) if (e_dense >= H0(k)) then ; eta(i,j,K) = e_dense else ; eta(i,j,K) = H0(k) ; endif - if (eta(i,j,K) < GV%Angstrom_z*(nz-k+1)-G%bathyT(i,j)) & - eta(i,j,K) = GV%Angstrom_z*(nz-k+1)-G%bathyT(i,j) + if (eta(i,j,K) < GV%Angstrom_m*(nz-k+1)-G%bathyT(i,j)) & + eta(i,j,K) = GV%Angstrom_m*(nz-k+1)-G%bathyT(i,j) enddo eta(i,j,nz+1) = -G%bathyT(i,j) diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index d0b87d518f..f65ba242b0 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -195,9 +195,9 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) endif @@ -539,9 +539,9 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom_z + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_m else h(i,j,k) = eta1D(k) - eta1D(k+1) endif diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index 0aa80f3c2e..40c0f81ff4 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -137,7 +137,7 @@ subroutine Neverland_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ do j=js,je ; do i=is,ie e_interface = -G%bathyT(i,j) do k=nz,1,-1 - h(i,j,k) = max( GV%Angstrom, GV%m_to_H * (e0(k) - e_interface) ) + h(i,j,k) = max( GV%Angstrom_H, GV%m_to_H * (e0(k) - e_interface) ) e_interface = max( e0(k), e_interface - GV%H_to_m * h(i,j,k) ) enddo diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 5267b5585b..6d2aa72e90 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -98,9 +98,9 @@ subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = eta_im(j,K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_z)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) endif diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index b681843002..8823f211c0 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -158,7 +158,7 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & ! This sets the initial thickness (in m) of the layers. The ! ! thicknesses are set to insure that: 1. each layer is at least ! -! Gv%Angstrom_z thick, and 2. the interfaces are where they should be ! +! Gv%Angstrom_m thick, and 2. the interfaces are where they should be ! ! based on the resting depths and interface height perturbations, ! ! as long at this doesn't interfere with 1. ! eta1D(nz+1) = -1.0*G%bathyT(i,j) @@ -180,12 +180,12 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & if (eta1D(K) > -ML_depth) eta1D(K) = -ML_depth - if (eta1D(K) < eta1D(K+1) + GV%Angstrom_z) & - eta1D(K) = eta1D(K+1) + GV%Angstrom_z + if (eta1D(K) < eta1D(K+1) + GV%Angstrom_m) & + eta1D(K) = eta1D(K+1) + GV%Angstrom_m - h(i,j,k) = max(GV%m_to_H * (eta1D(K) - eta1D(K+1)), GV%Angstrom) + h(i,j,k) = max(GV%m_to_H * (eta1D(K) - eta1D(K+1)), GV%Angstrom_H) enddo - h(i,j,1) = max(GV%m_to_H * (0.0 - eta1D(2)), GV%Angstrom) + h(i,j,1) = max(GV%m_to_H * (0.0 - eta1D(2)), GV%Angstrom_H) enddo ; enddo diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index 1ff42509c5..5c8d67d937 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -73,9 +73,9 @@ subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_para eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_z)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) endif diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index 30625377cc..59f11dd98d 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -229,10 +229,10 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A do k = nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then ! is this layer vanished? - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom_z + eta1D(k) = eta1D(k+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_m else h(i,j,k) = eta1D(k) - eta1D(k+1) endif diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index de9f88c094..d0109a8b6c 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -135,16 +135,16 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * & ( (real(K)-1.5) / real(nz-1) ) ) / S_range e0(K) = nint(2048.*e0(K))/2048. ! Force round numbers ... the above expression has irrational factors ... - e0(K) = min(real(1-K)*GV%Angstrom_z, e0(K)) ! Bound by surface + e0(K) = min(real(1-K)*GV%Angstrom_m, e0(K)) ! Bound by surface e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom enddo do j=js,je ; do i=is,ie eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom_z + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_m else h(i,j,k) = eta1D(k) - eta1D(k+1) endif diff --git a/src/user/lock_exchange_initialization.F90 b/src/user/lock_exchange_initialization.F90 index c3e06391cb..3c48bc9b9a 100644 --- a/src/user/lock_exchange_initialization.F90 +++ b/src/user/lock_exchange_initialization.F90 @@ -78,11 +78,11 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, param_file, just_read_pa enddo eta1D(nz+1) = -G%max_depth ! Force bottom interface to bottom do k=nz,2,-1 ! Make sure interfaces increase upwards - eta1D(K) = max( eta1D(K), eta1D(K+1) + GV%Angstrom_Z ) + eta1D(K) = max( eta1D(K), eta1D(K+1) + GV%Angstrom_m ) enddo eta1D(1) = 0. ! Force bottom interface to bottom do k=2,nz ! Make sure interfaces decrease downwards - eta1D(K) = min( eta1D(K), eta1D(K-1) - GV%Angstrom_Z ) + eta1D(K) = min( eta1D(K), eta1D(K-1) - GV%Angstrom_m ) enddo do k=nz,1,-1 h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 131f73ea3e..3243c94d0f 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -138,16 +138,16 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * & ( (real(K)-1.5) / real(nz-1) ) ) / S_range e0(K) = nint(2048.*e0(K))/2048. ! Force round numbers ... the above expression has irrational factors ... - e0(K) = min(real(1-K)*GV%Angstrom_z, e0(K)) ! Bound by surface + e0(K) = min(real(1-K)*GV%Angstrom_m, e0(K)) ! Bound by surface e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom enddo do j=js,je ; do i=is,ie eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_z - h(i,j,k) = GV%Angstrom + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) endif diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index a81cf181e6..f70bbc1619 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -153,8 +153,8 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param ! are strictly positive do k = nz,1,-1 - if ( z_inter(k) < (z_inter(k+1) + GV%Angstrom_Z) ) then - z_inter(k) = z_inter(k+1) + GV%Angstrom_Z + if ( z_inter(k) < (z_inter(k+1) + GV%Angstrom_m) ) then + z_inter(k) = z_inter(k+1) + GV%Angstrom_m endif enddo From b3fe50afc23cefae798cd1213e541e605d68a690 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 24 Aug 2018 15:58:32 -0400 Subject: [PATCH 0667/1072] Avoid use of %Domain_aux to avoid intermittent MPI sync problem - The combination of coverage instrumentation, O2 optimization and the use of Domain_aux for halo-updates of data passed from the coupler was leading to MPI errors about inconsistent messages. This could very easily be a compiler issue but there might very well be an issue in Domain_aux. --- .../coupled_driver/MOM_surface_forcing.F90 | 124 +++++++++++------- 1 file changed, 73 insertions(+), 51 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index bbaac1df07..57eb9cfcbc 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -805,12 +805,12 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta integer, optional, intent(in) :: tau_halo !< The halo size of wind stresses to set, 0 by default. ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: & - taux_in ! Zonal wind stresses (in Pa) at u, h, or q points, depending on the value of - ! wind_stagger, always with non-symmetric memory to permit array reuse. - real, dimension(SZI_(G),SZJ_(G)) :: & - tauy_in ! Meridional wind stresses (in Pa) at v, h, or q points, depending on the value of - ! wind_stagger, always with non-symmetric memory to permit array reuse. + real, dimension(SZI_(G),SZJ_(G)) :: taux_in_A ! Zonal wind stresses (in Pa) at h points + real, dimension(SZI_(G),SZJ_(G)) :: tauy_in_A ! Meridional wind stresses (in Pa) at h points + real, dimension(SZIB_(G),SZJ_(G)) :: taux_in_C ! Zonal wind stresses (in Pa) at u points + real, dimension(SZI_(G),SZJB_(G)) :: tauy_in_C ! Meridional wind stresses (in Pa) at v points + real, dimension(SZIB_(G),SZJB_(G)) :: taux_in_B ! Zonal wind stresses (in Pa) at q points + real, dimension(SZIB_(G),SZJB_(G)) :: tauy_in_B ! Meridional wind stresses (in Pa) at q points real :: gustiness ! unresolved gustiness that contributes to ustar (Pa) real :: Irho0 ! inverse of the mean density in (m^3/kg) @@ -835,68 +835,90 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. & (IOB%wind_stagger == CGRID_NE)) wind_stagger = IOB%wind_stagger + if (associated(IOB%u_flux).neqv.associated(IOB%v_flux)) call MOM_error(FATAL,"extract_IOB_stresses: "//& + "associated(IOB%u_flux) /= associated(IOB%v_flux !!!") + if (present(taux).neqv.present(tauy)) call MOM_error(FATAL,"extract_IOB_stresses: "//& + "present(taux) /= present(tauy) !!!") + ! Set surface momentum stress related fields as a function of staggering. if (present(taux) .or. present(tauy) .or. & ((do_ustar.or.do_gustless) .and. .not.associated(IOB%stress_mag)) ) then - ! This is necessary to fill in the halo points. - taux_in(:,:) = 0.0 ; tauy_in(:,:) = 0.0 - ! Obtain stress from IOB; note that the staggering locations of taux_in and tauy_in depend - ! on the values of wind_stagger, so the case-sensitive index convention is not used here. - do j=js,je ; do i=is,ie - if (associated(IOB%u_flux)) taux_in(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier - if (associated(IOB%v_flux)) tauy_in(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier - enddo ; enddo - if (wind_stagger == BGRID_NE) then - call pass_vector(taux_in, tauy_in, G%Domain_aux, stagger=BGRID_NE, halo=1+halo) - - if (present(taux)) then ; do j=jsh,jeh ; do I=Isqh,Ieqh - taux(I,j) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & - taux(I,j) = (G%mask2dBu(I,J)*taux_in(I,J) + G%mask2dBu(I,J-1)*taux_in(I,J-1)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) - enddo ; enddo ; endif - - if (present(tauy)) then ; do J=Jsqh,Jeqh ; do i=ish,ieh - tauy(i,J) = 0.0 - if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & - tauy(i,J) = (G%mask2dBu(I,J)*tauy_in(I,J) + G%mask2dBu(I-1,J)*tauy_in(I-1,J)) / & - (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) - enddo ; enddo ; endif + taux_in_B(:,:) = 0.0 ; tauy_in_B(:,:) = 0.0 + if (associated(IOB%u_flux).and.associated(IOB%v_flux)) then + do J=js,je ; do I=is,ie + taux_in_B(I,J) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + tauy_in_B(I,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + enddo ; enddo + endif + if (G%symmetric) call fill_symmetric_edges(taux_in_B, tauy_in_B, G%Domain, stagger=BGRID_NE) + call pass_vector(taux_in_B, tauy_in_B, G%Domain, stagger=BGRID_NE, halo=max(1,halo)) + + if (present(taux).and.present(tauy)) then + do j=jsh,jeh ; do I=Isqh,Ieqh + taux(I,j) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) > 0) & + taux(I,j) = (G%mask2dBu(I,J)*taux_in_B(I,J) + G%mask2dBu(I,J-1)*taux_in_B(I,J-1)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I,J-1)) + enddo ; enddo + do J=Jsqh,Jeqh ; do i=ish,ieh + tauy(i,J) = 0.0 + if ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) > 0) & + tauy(i,J) = (G%mask2dBu(I,J)*tauy_in_B(I,J) + G%mask2dBu(I-1,J)*tauy_in_B(I-1,J)) / & + (G%mask2dBu(I,J) + G%mask2dBu(I-1,J)) + enddo ; enddo + endif elseif (wind_stagger == AGRID) then + taux_in_A(:,:) = 0.0 ; tauy_in_A(:,:) = 0.0 + if (associated(IOB%u_flux).and.associated(IOB%v_flux)) then + do j=js,je ; do i=is,ie + taux_in_A(i,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + tauy_in_A(i,j) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + enddo ; enddo + endif + if (halo == 0) then - call pass_vector(taux_in, tauy_in, G%Domain, To_All+Omit_Corners, stagger=AGRID, halo=1) + call pass_vector(taux_in_A, tauy_in_A, G%Domain, To_All+Omit_Corners, stagger=AGRID, halo=1) else - call pass_vector(taux_in, tauy_in, G%Domain, stagger=AGRID, halo=1+halo) + call pass_vector(taux_in_A, tauy_in_A, G%Domain, stagger=AGRID, halo=max(1,halo)) endif if (present(taux)) then ; do j=jsh,jeh ; do I=Isqh,Ieqh taux(I,j) = 0.0 if ((G%mask2dT(i,j) + G%mask2dT(i+1,j)) > 0) & - taux(I,j) = (G%mask2dT(i,j)*taux_in(i,j) + G%mask2dT(i+1,j)*taux_in(i+1,j)) / & + taux(I,j) = (G%mask2dT(i,j)*taux_in_A(i,j) + G%mask2dT(i+1,j)*taux_in_A(i+1,j)) / & (G%mask2dT(i,j) + G%mask2dT(i+1,j)) enddo ; enddo ; endif if (present(tauy)) then ; do J=Jsqh,Jeqh ; do i=ish,ieh tauy(i,J) = 0.0 if ((G%mask2dT(i,j) + G%mask2dT(i,j+1)) > 0) & - tauy(i,J) = (G%mask2dT(i,j)*tauy_in(i,j) + G%mask2dT(i,J+1)*tauy_in(i,j+1)) / & + tauy(i,J) = (G%mask2dT(i,j)*tauy_in_A(i,j) + G%mask2dT(i,J+1)*tauy_in_A(i,j+1)) / & (G%mask2dT(i,j) + G%mask2dT(i,j+1)) enddo ; enddo ; endif else ! C-grid wind stresses. - call pass_vector(taux_in, tauy_in, G%Domain_aux, halo=1+halo) - - if (present(taux)) then ; do j=jsh,jeh ; do I=Isqh,Ieqh - taux(I,j) = G%mask2dCu(I,j)*taux_in(I,j) - enddo ; enddo ; endif + taux_in_C(:,:) = 0.0 ; tauy_in_C(:,:) = 0.0 + if (associated(IOB%u_flux).and.associated(IOB%v_flux)) then + do j=js,je ; do i=is,ie + taux_in_C(I,j) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier + tauy_in_C(i,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier + enddo ; enddo + endif - if (present(tauy)) then ; do J=Jsqh,Jeqh ; do i=ish,ieh - tauy(i,J) = G%mask2dCv(i,J)*tauy_in(i,J) - enddo ; enddo ; endif + if (G%symmetric) call fill_symmetric_edges(taux_in_C, tauy_in_C, G%Domain) + call pass_vector(taux_in_C, tauy_in_C, G%Domain, halo=max(1,halo)) + if (present(taux).and.present(tauy)) then + do j=jsh,jeh ; do I=Isqh,Ieqh + taux(I,j) = G%mask2dCu(I,j)*taux_in_C(I,j) + enddo ; enddo + do J=Jsqh,Jeqh ; do i=ish,ieh + tauy(i,J) = G%mask2dCv(i,J)*tauy_in_C(i,J) + enddo ; enddo + endif endif ! endif for extracting wind stress fields with various staggerings endif @@ -929,10 +951,10 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta tau_mag = 0.0 ; gustiness = CS%gust_const if (((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + & (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0) then - tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_in(I,J)**2 + tauy_in(I,J)**2) + & - G%mask2dBu(I-1,J-1)*(taux_in(I-1,J-1)**2 + tauy_in(I-1,J-1)**2)) + & - (G%mask2dBu(I,J-1)*(taux_in(I,J-1)**2 + tauy_in(I,J-1)**2) + & - G%mask2dBu(I-1,J)*(taux_in(I-1,J)**2 + tauy_in(I-1,J)**2)) ) / & + tau_mag = sqrt(((G%mask2dBu(I,J)*(taux_in_B(I,J)**2 + tauy_in_B(I,J)**2) + & + G%mask2dBu(I-1,J-1)*(taux_in_B(I-1,J-1)**2 + tauy_in_B(I-1,J-1)**2)) + & + (G%mask2dBu(I,J-1)*(taux_in_B(I,J-1)**2 + tauy_in_B(I,J-1)**2) + & + G%mask2dBu(I-1,J)*(taux_in_B(I-1,J)**2 + tauy_in_B(I-1,J)**2)) ) / & ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif @@ -943,7 +965,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta enddo ; enddo elseif (wind_stagger == AGRID) then do j=js,je ; do i=is,ie - tau_mag = G%mask2dT(i,j) * sqrt(taux_in(i,j)**2 + tauy_in(i,j)**2) + tau_mag = G%mask2dT(i,j) * sqrt(taux_in_A(i,j)**2 + tauy_in_A(i,j)**2) gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) @@ -955,11 +977,11 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta do j=js,je ; do i=is,ie taux2 = 0.0 ; tauy2 = 0.0 if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & - taux2 = (G%mask2dCu(I-1,j)*taux_in(I-1,j)**2 + & - G%mask2dCu(I,j)*taux_in(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) + taux2 = (G%mask2dCu(I-1,j)*taux_in_C(I-1,j)**2 + & + G%mask2dCu(I,j)*taux_in_C(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & - tauy2 = (G%mask2dCv(i,J-1)*tauy_in(i,J-1)**2 + & - G%mask2dCv(i,J)*tauy_in(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) + tauy2 = (G%mask2dCv(i,J-1)*tauy_in_C(i,J-1)**2 + & + G%mask2dCv(i,J)*tauy_in_C(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) tau_mag = sqrt(taux2 + tauy2) gustiness = CS%gust_const From 64665e07c54ba8bad08b6c1014c662cb800297b3 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 26 Aug 2018 11:22:22 -0600 Subject: [PATCH 0668/1072] minor fixes for generalization --- config_src/nuopc_driver/mom_cap.F90 | 22 ++++++++++----------- config_src/nuopc_driver/mom_cap_methods.F90 | 2 +- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 1ec7d0062f..0088eac6e7 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -399,8 +399,8 @@ module mom_cap_mod use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid #ifdef CESMCOUPLED use mom_cap_methods, only: mom_import, mom_export - use esmFlds, only: flds_scalar_name, flds_scalar_num - use esmFlds, only: flds_scalar_index_nx, flds_scalar_index_ny + use shr_nuopc_scalars_mod, only: flds_scalar_name, flds_scalar_num + use shr_nuopc_scalars_mod, only: flds_scalar_index_nx, flds_scalar_index_ny use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit use shr_file_mod, only: shr_file_getLogUnit, shr_file_getLogLevel use shr_file_mod, only: shr_file_setLogUnit, shr_file_setLogLevel @@ -893,7 +893,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx @@ -905,7 +905,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - + ! EMC fields not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn @@ -922,7 +922,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") @@ -988,7 +988,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! not in EMC call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! not in EMC ! EMC fields not used @@ -998,7 +998,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Optional CESM fields currently not used ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen" , "will provide") ! not in EMC ! if (flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") ! end if @@ -2260,9 +2260,9 @@ subroutine ModelSetRunClock(gcomp, rc) return ! bail out if (first_time) then - !-------------------------------- + !-------------------------------- ! set restart alarm - !-------------------------------- + !-------------------------------- call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2579,8 +2579,8 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ integer, intent(in) :: scalar_id type(ESMF_State), intent(inout) :: State integer, intent(in) :: mytask - character(len=*), intent(in) :: scalar_name - integer, intent(in) :: scalar_num + character(len=*), intent(in) :: scalar_name + integer, intent(in) :: scalar_num integer, intent(inout) :: rc ! local variables diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index a826aadae4..be9cd4e966 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -634,7 +634,7 @@ subroutine mom_import_nems(ocean_public, grid, importState, ice_ocean_boundary, ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) ice_ocean_boundary%t_flux(i,j) = -dataPtr_sensi(i1,j1) ice_ocean_boundary%salt_flux(i,j) = dataPtr_salt(i1,j1) - ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwflux(i1,j1) + ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwflux(i1,j1) ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) From fd369095795436bb3aba36fb1065605f65434a37 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Mon, 27 Aug 2018 13:44:08 -0400 Subject: [PATCH 0669/1072] Fix data_override issue introduced by present(gas_fields_ocn) - commit 515d9283 in ocean_model_MOM.F90 has introduced a new path that initialization takes before the data_override_init() is being called. This leads to some ocean-ice-biogeochemistry model to crash because they call data_override before init is called for it: Image PC Routine Line Source fms_MOM6_SIS2_com 000000000177DD86 mpp_mod_mp_mpp_er 69 mpp_util_mpi.inc fms_MOM6_SIS2_com 0000000001657BCC data_override_mod 581 data_override.F90 fms_MOM6_SIS2_com 000000000165127F data_override_mod 762 data_override.F90 fms_MOM6_SIS2_com 000000000165733F data_override_mod 636 data_override.F90 fms_MOM6_SIS2_com 0000000000F673EF generic_abiotic_m 1043 generic_abiotic.F90 fms_MOM6_SIS2_com 0000000000DF4A2F generic_tracer_mp 718 generic_tracer.F90 fms_MOM6_SIS2_com 0000000000C6E1A7 mom_generic_trace 872 MOM_generic_tracer.F90 fms_MOM6_SIS2_com 0000000000DF6488 mom_tracer_flow_c 835 MOM_tracer_flow_control.F90 fms_MOM6_SIS2_com 000000000078EAE7 mom_mp_extract_su 2889 MOM.F90 fms_MOM6_SIS2_com 0000000000772E28 ocean_model_mod_m 372 ocean_model_MOM.F90 fms_MOM6_SIS2_com 000000000041385A coupler_main_IP_c 1837 coupler_main.F90 fms_MOM6_SIS2_com 000000000040A7BB MAIN__ 611 coupler_main.F90 - To fix this issue we leverage an existing data_override_init call which is being done at the right place, but only if some parameters are set. --- config_src/coupled_driver/MOM_surface_forcing.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 57eb9cfcbc..51d3e0c7b7 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -1413,9 +1413,8 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS) call get_param(param_file, mdl, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, & "If true, allows flux adjustments to specified via the \n"//& "data_table using the component name 'OCN'.", default=.false.) - if (CS%allow_flux_adjustments) then - call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) - endif + + call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) if (CS%restore_salt) then salt_file = trim(CS%inputdir) // trim(CS%salt_restore_file) From ddc9ed1c33a1b7357b213929118ecaa19ae63f9f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 28 Aug 2018 14:52:20 -0400 Subject: [PATCH 0670/1072] +Added rescale_grid_bathymetry and G%Zd_to_m Added new public subroutines, rescale_grid_bathymetry and rescale_dyn_horgrid_bathymetry to change then internal representation of bathymetry, along with new elements Zd_to_m in the ocean_grid_type and dyn_horgrid_type to record the depth units. Also copy over the vertical depth units in copy_dyngrid_to_MOM_grid and copy_MOM_grid_to_dyngrid. All answers are bitwise identical, but there are new public interfaces and transparent types have new elements. --- src/core/MOM_grid.F90 | 45 ++++++++++++++++++++++++++----- src/core/MOM_transcribe_grid.F90 | 2 ++ src/framework/MOM_dyn_horgrid.F90 | 45 +++++++++++++++++++++++++++---- 3 files changed, 81 insertions(+), 11 deletions(-) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index e72038a252..c92730ec33 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -14,7 +14,7 @@ module MOM_grid #include public MOM_grid_init, MOM_grid_end, set_derived_metrics, set_first_direction -public isPointInCell, hor_index_type, get_global_grid_size +public isPointInCell, hor_index_type, get_global_grid_size, rescale_grid_bathymetry !> Ocean grid type. See mom_grid for details. type, public :: ocean_grid_type @@ -131,17 +131,18 @@ module MOM_grid y_axis_units !< The units that are used in labeling the y coordinate axes. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - bathyT !< Ocean bottom depth at tracer points, in m. + bathyT !< Ocean bottom depth at tracer points, in depth units. + real :: Zd_to_m = 1.0 !< The conversion factor between the units of bathyT and m. logical :: bathymetry_at_vel !< If true, there are separate values for the !! basin depths at velocity points. Otherwise the effects of !! of topography are entirely determined from thickness points. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & - Dblock_u, & !< Topographic depths at u-points at which the flow is blocked, in m. - Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu, in m. + Dblock_u, & !< Topographic depths at u-points at which the flow is blocked, in depth units. + Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu, in depth units. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - Dblock_v, & !< Topographic depths at v-points at which the flow is blocked, in m. - Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv, in m. + Dblock_v, & !< Topographic depths at v-points at which the flow is blocked, in depth units. + Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv, in depth units. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & CoriolisBu !< The Coriolis parameter at corner points, in s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & @@ -345,6 +346,38 @@ subroutine MOM_grid_init(G, param_file, HI, global_indexing, bathymetry_at_vel) end subroutine MOM_grid_init +!> rescale_grid_bathymetry permits a change in the internal units for the bathymetry on the grid, +!! both rescaling the depths and recording the new internal units. +subroutine rescale_grid_bathymetry(G, m_in_new_units) + type(ocean_grid_type), intent(inout) :: G !< The horizontal grid structure + real, intent(in) :: m_in_new_units !< The new internal representation of 1 m depth. + + ! Local variables + real :: rescale + integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + if (m_in_new_units == G%Zd_to_m) return + if (m_in_new_units < 0.0) & + call MOM_error(FATAL, "rescale_grid_bathymetry: Negative depth units are not permitted.") + if (m_in_new_units == 0.0) & + call MOM_error(FATAL, "rescale_grid_bathymetry: Zero depth units are not permitted.") + + rescale = G%Zd_to_m / m_in_new_units + do j=jsd,jed ; do i=isd,ied + G%bathyT(i,j) = rescale*G%bathyT(i,j) + enddo ; enddo + if (G%bathymetry_at_vel) then ; do j=jsd,jed ; do I=IsdB,IedB + G%Dblock_u(I,j) = rescale*G%Dblock_u(I,j) ; G%Dopen_u(I,j) = rescale*G%Dopen_u(I,j) + enddo ; enddo ; endif + if (G%bathymetry_at_vel) then ; do J=JsdB,JedB ; do i=isd,ied + G%Dblock_v(i,J) = rescale*G%Dblock_v(i,J) ; G%Dopen_v(i,J) = rescale*G%Dopen_v(i,J) + enddo ; enddo ; endif + G%Zd_to_m = m_in_new_units + +end subroutine rescale_grid_bathymetry !> set_derived_metrics calculates metric terms that are derived from other metrics. subroutine set_derived_metrics(G) diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index eea4874f4e..649d481dc9 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -44,6 +44,7 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG) if ((isd > oG%isc) .or. (ied < oG%ied) .or. (jsd > oG%jsc) .or. (jed > oG%jed)) & call MOM_error(FATAL, "copy_dyngrid_to_MOM_grid called with incompatible grids.") + oG%Zd_to_m = dG%Zd_to_m do i=isd,ied ; do j=jsd,jed oG%geoLonT(i,j) = dG%geoLonT(i+ido,j+jdo) oG%geoLatT(i,j) = dG%geoLatT(i+ido,j+jdo) @@ -187,6 +188,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG) if ((isd > dG%isc) .or. (ied < dG%ied) .or. (jsd > dG%jsc) .or. (jed > dG%jed)) & call MOM_error(FATAL, "copy_dyngrid_to_MOM_grid called with incompatible grids.") + dG%Zd_to_m = oG%Zd_to_m do i=isd,ied ; do j=jsd,jed dG%geoLonT(i,j) = oG%geoLonT(i+ido,j+jdo) dG%geoLatT(i,j) = oG%geoLatT(i+ido,j+jdo) diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 403729559d..2ff129ce66 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -11,6 +11,7 @@ module MOM_dyn_horgrid implicit none ; private public create_dyn_horgrid, destroy_dyn_horgrid, set_derived_dyn_horgrid +public rescale_dyn_horgrid_bathymetry !> Describes the horizontal ocean grid with only dynamic memory arrays type, public :: dyn_horgrid_type @@ -130,17 +131,18 @@ module MOM_dyn_horgrid ! Except on a Cartesian grid, these are usually some variant of "degrees". real, allocatable, dimension(:,:) :: & - bathyT !< Ocean bottom depth at tracer points, in m. + bathyT !< Ocean bottom depth at tracer points, in depth units. + real :: Zd_to_m = 1.0 !< The conversion factor between the units of bathyT and m. logical :: bathymetry_at_vel !< If true, there are separate values for the !! basin depths at velocity points. Otherwise the effects of !! of topography are entirely determined from thickness points. real, allocatable, dimension(:,:) :: & - Dblock_u, & !< Topographic depths at u-points at which the flow is blocked, in m. - Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu, in m. + Dblock_u, & !< Topographic depths at u-points at which the flow is blocked, in depth units. + Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu, in depth units. real, allocatable, dimension(:,:) :: & - Dblock_v, & !< Topographic depths at v-points at which the flow is blocked, in m. - Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv, in m. + Dblock_v, & !< Topographic depths at v-points at which the flow is blocked, in depth units. + Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv, in depth units. real, allocatable, dimension(:,:) :: & CoriolisBu !< The Coriolis parameter at corner points, in s-1. real, allocatable, dimension(:,:) :: & @@ -272,6 +274,39 @@ subroutine create_dyn_horgrid(G, HI, bathymetry_at_vel) end subroutine create_dyn_horgrid +!> rescale_dyn_horgrid_bathymetry permits a change in the internal units for the bathymetry on the +!! grid, both rescaling the depths and recording the new internal depth units. +subroutine rescale_dyn_horgrid_bathymetry(G, m_in_new_units) + type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type + real, intent(in) :: m_in_new_units !< The new internal representation of 1 m depth. + + ! Local variables + real :: rescale + integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + if (m_in_new_units == G%Zd_to_m) return + if (m_in_new_units < 0.0) & + call MOM_error(FATAL, "rescale_grid_bathymetry: Negative depth units are not permitted.") + if (m_in_new_units == 0.0) & + call MOM_error(FATAL, "rescale_grid_bathymetry: Zero depth units are not permitted.") + + rescale = G%Zd_to_m / m_in_new_units + do j=jsd,jed ; do i=isd,ied + G%bathyT(i,j) = rescale*G%bathyT(i,j) + enddo ; enddo + if (G%bathymetry_at_vel) then ; do j=jsd,jed ; do I=IsdB,IedB + G%Dblock_u(I,j) = rescale*G%Dblock_u(I,j) ; G%Dopen_u(I,j) = rescale*G%Dopen_u(I,j) + enddo ; enddo ; endif + if (G%bathymetry_at_vel) then ; do J=JsdB,JedB ; do i=isd,ied + G%Dblock_v(i,J) = rescale*G%Dblock_v(i,J) ; G%Dopen_v(i,J) = rescale*G%Dopen_v(i,J) + enddo ; enddo ; endif + G%Zd_to_m = m_in_new_units + +end subroutine rescale_dyn_horgrid_bathymetry + !> set_derived_dyn_horgrid calculates metric terms that are derived from other metrics. subroutine set_derived_dyn_horgrid(G) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type From 62b292621309de88d737405f09a7bc9ac08a3b00 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 28 Aug 2018 14:52:46 -0400 Subject: [PATCH 0671/1072] +Added Z_RESCALE_POWER & m_to_Z Added a new runtime argument, Z_RESCALE_POWER, to facilate power-of-two changes in the internal representation of vertical distances, plus four new elements (m_to_Z, Z_to_m, H_to_Z and Z_to_H) of the verticalGrid_type. All answers are bitwise identical, but the MOM_parameter_doc.debugging files have a new entry. --- src/core/MOM_verticalGrid.F90 | 33 ++++++++++++++++++++++++++------- 1 file changed, 26 insertions(+), 7 deletions(-) diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index e66c137d88..0fbef525af 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -35,6 +35,7 @@ module MOM_verticalGrid ! The following variables give information about the vertical grid. logical :: Boussinesq !< If true, make the Boussinesq approximation. real :: Angstrom_H !< A one-Angstrom thickness in the model thickness units. + real :: Angstrom_Z !< A one-Angstrom thickness in the model depth units. real :: Angstrom_m !< A one-Angstrom thickness in m. real :: H_subroundoff !< A thickness that is so small that it can be added to a thickness of !! Angstrom or larger without changing it at the bit level, in thickness units. @@ -51,6 +52,10 @@ module MOM_verticalGrid real :: m_to_H !< A constant that translates distances in m to the units of thickness. real :: H_to_m !< A constant that translates distances in the units of thickness to m. real :: H_to_Pa !< A constant that translates the units of thickness to pressure in Pa. + real :: m_to_Z !< A constant that translates distances in m to the units of depth. + real :: Z_to_m !< A constant that translates distances in the units of depth to m. + real :: H_to_Z !< A constant that translates thickness units to the units of depth. + real :: Z_to_H !< A constant that translates depth units to thickness units. end type verticalGrid_type contains @@ -63,8 +68,8 @@ subroutine verticalGridInit( param_file, GV ) ! All memory is allocated but not necessarily set to meaningful values until later. ! Local variables - integer :: nk, H_power - real :: rescale_factor + integer :: nk, H_power, Z_power + real :: H_rescale_factor, Z_rescale_factor ! This include declares and sets the variable "version". # include "version_variable.h" character(len=16) :: mdl = 'MOM_verticalGrid' @@ -96,20 +101,30 @@ subroutine verticalGridInit( param_file, GV ) units="nondim", default=0, debuggingParam=.true.) if (abs(H_power) > 300) call MOM_error(FATAL, "verticalGridInit: "//& "H_RESCALE_POWER is outside of the valid range of -300 to 300.") - rescale_factor = 1.0 - if (H_power /= 0) rescale_factor = 2.0**H_power + H_rescale_factor = 1.0 + if (H_power /= 0) H_rescale_factor = 2.0**H_power if (.not.GV%Boussinesq) then call get_param(param_file, mdl, "H_TO_KG_M2", GV%H_to_kg_m2,& "A constant that translates thicknesses from the model's \n"//& "internal units of thickness to kg m-2.", units="kg m-2 H-1", & default=1.0) - GV%H_to_kg_m2 = GV%H_to_kg_m2 * rescale_factor + GV%H_to_kg_m2 = GV%H_to_kg_m2 * H_rescale_factor else call get_param(param_file, mdl, "H_TO_M", GV%H_to_m, & "A constant that translates the model's internal \n"//& "units of thickness into m.", units="m H-1", default=1.0) - GV%H_to_m = GV%H_to_m * rescale_factor + GV%H_to_m = GV%H_to_m * H_rescale_factor endif + call get_param(param_file, mdl, "Z_RESCALE_POWER", Z_power, & + "An integer power of 2 that is used to rescale the model's \n"//& + "intenal units of depths and heights. Valid values range from -300 to 300.", & + units="nondim", default=0, debuggingParam=.true.) + if (abs(Z_power) > 300) call MOM_error(FATAL, "verticalGridInit: "//& + "Z_RESCALE_POWER is outside of the valid range of -300 to 300.") + Z_rescale_factor = 1.0 + if (Z_power /= 0) Z_rescale_factor = 2.0**Z_power + GV%Z_to_m = 1.0 * Z_rescale_factor + GV%m_to_Z = 1.0 / Z_rescale_factor #ifdef STATIC_MEMORY_ ! Here NK_ is a macro, while nk is a variable. call get_param(param_file, mdl, "NK", nk, & @@ -138,8 +153,12 @@ subroutine verticalGridInit( param_file, GV ) GV%H_subroundoff = 1e-20 * max(GV%Angstrom_H,GV%m_to_H*1e-17) GV%H_to_Pa = GV%g_Earth * GV%H_to_kg_m2 + GV%H_to_Z = GV%H_to_m * GV%m_to_Z + GV%Z_to_H = GV%Z_to_m * GV%m_to_H + GV%Angstrom_Z = GV%m_to_Z * GV%Angstrom_m + ! Log derivative values. - call log_param(param_file, mdl, "M to THICKNESS", GV%m_to_H*rescale_factor) + call log_param(param_file, mdl, "M to THICKNESS", GV%m_to_H*H_rescale_factor) call log_param(param_file, mdl, "M to THICKNESS rescaled by 2^-n", GV%m_to_H) call log_param(param_file, mdl, "THICKNESS to M rescaled by 2^n", GV%H_to_m) From ada60cc9b304c579e1c2e76cff57b214e4c2d742 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 28 Aug 2018 15:03:33 -0400 Subject: [PATCH 0672/1072] Test dimensional consistency of bathymetry Apply rescaling factors to bathymetry throughout the MOM6 code, which demonstrate the dimensional consistency of expressions with bathymetry. A minor bug in the sloshing initialization and a hard-coded dimensional number were identified and commented on in this process. All answers in the existing test suite are identical for nor rescaling or rescaling by 2^93 or 2^-93. --- src/ALE/MOM_ALE.F90 | 2 +- src/ALE/MOM_regridding.F90 | 14 ++-- src/ALE/coord_adapt.F90 | 2 +- src/core/MOM.F90 | 19 +++-- src/core/MOM_PressureForce_Montgomery.F90 | 12 ++-- src/core/MOM_PressureForce_analytic_FV.F90 | 12 ++-- src/core/MOM_PressureForce_blocked_AFV.F90 | 12 ++-- src/core/MOM_barotropic.F90 | 72 ++++++++++--------- src/core/MOM_dynamics_split_RK2.F90 | 2 +- src/core/MOM_dynamics_unsplit.F90 | 2 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 2 +- src/core/MOM_interface_heights.F90 | 16 ++--- src/core/MOM_open_boundary.F90 | 5 +- src/diagnostics/MOM_PointAccel.F90 | 12 ++-- src/diagnostics/MOM_diag_to_Z.F90 | 18 ++--- src/diagnostics/MOM_diagnostics.F90 | 18 +++-- src/diagnostics/MOM_sum_output.F90 | 8 +-- src/diagnostics/MOM_wave_speed.F90 | 3 +- src/framework/MOM_diag_remap.F90 | 10 +-- src/framework/MOM_horizontal_regridding.F90 | 10 +-- src/ice_shelf/MOM_ice_shelf.F90 | 2 + src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 22 +++--- .../MOM_fixed_initialization.F90 | 4 +- src/initialization/MOM_grid_initialize.F90 | 7 +- .../MOM_shared_initialization.F90 | 11 ++- .../MOM_state_initialization.F90 | 38 +++++----- .../MOM_tracer_initialization_from_Z.F90 | 9 +-- src/initialization/midas_vertmap.F90 | 2 +- src/parameterizations/lateral/MOM_MEKE.F90 | 4 +- .../lateral/MOM_internal_tides.F90 | 5 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 14 ++-- .../vertical/MOM_ALE_sponge.F90 | 12 ++-- .../vertical/MOM_internal_tide_input.F90 | 7 +- .../vertical/MOM_set_viscosity.F90 | 6 +- src/parameterizations/vertical/MOM_sponge.F90 | 23 ++---- .../vertical/MOM_tidal_mixing.F90 | 23 +++--- .../vertical/MOM_vert_friction.F90 | 18 ++--- src/tracer/DOME_tracer.F90 | 2 +- src/tracer/MOM_tracer_Z_init.F90 | 8 +-- src/tracer/dye_example.F90 | 4 +- src/user/BFB_initialization.F90 | 2 +- src/user/DOME2d_initialization.F90 | 23 +++--- src/user/DOME_initialization.F90 | 14 ++-- src/user/ISOMIP_initialization.F90 | 43 ++++++----- src/user/Kelvin_initialization.F90 | 30 +++++--- src/user/Neverland_initialization.F90 | 2 +- src/user/Phillips_initialization.F90 | 2 +- src/user/adjustment_initialization.F90 | 2 +- src/user/baroclinic_zone_initialization.F90 | 2 +- src/user/benchmark_initialization.F90 | 2 +- src/user/circle_obcs_initialization.F90 | 2 +- src/user/dense_water_initialization.F90 | 2 +- src/user/dumbbell_initialization.F90 | 9 ++- src/user/seamount_initialization.F90 | 7 +- src/user/sloshing_initialization.F90 | 40 +++++------ src/user/soliton_initialization.F90 | 2 +- 56 files changed, 334 insertions(+), 322 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 7e2885fd6f..a7ac3cc4c7 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -1225,7 +1225,7 @@ subroutine ALE_initThicknessToCoord( CS, G, GV, h ) integer :: i, j, k do j = G%jsd,G%jed ; do i = G%isd,G%ied - h(i,j,:) = GV%m_to_H * getStaticThickness( CS%regridCS, 0., G%bathyT(i,j) ) + h(i,j,:) = GV%m_to_H * getStaticThickness( CS%regridCS, 0., G%Zd_to_m*G%bathyT(i,j) ) enddo ; enddo end subroutine ALE_initThicknessToCoord diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 9f756346bf..16dfb9140e 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -904,7 +904,7 @@ subroutine check_remapping_grid( G, GV, h, dzInterface, msg ) !$OMP parallel do default(shared) do j = G%jsc-1,G%jec+1 do i = G%isc-1,G%iec+1 - if (G%mask2dT(i,j)>0.) call check_grid_column( GV%ke, G%bathyT(i,j), h(i,j,:), dzInterface(i,j,:), msg ) + if (G%mask2dT(i,j)>0.) call check_grid_column( GV%ke, G%Zd_to_m*G%bathyT(i,j), h(i,j,:), dzInterface(i,j,:), msg ) enddo enddo @@ -1147,7 +1147,7 @@ subroutine build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h) endif ! Local depth (G%bathyT is positive) - nominalDepth = G%bathyT(i,j)*GV%m_to_H + nominalDepth = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H ! Determine water column thickness totalThickness = 0.0 @@ -1236,7 +1236,7 @@ subroutine build_sigma_grid( CS, G, GV, h, dzInterface ) endif ! The rest of the model defines grids integrating up from the bottom - nominalDepth = G%bathyT(i,j)*GV%m_to_H + nominalDepth = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H ! Determine water column height totalThickness = 0.0 @@ -1340,7 +1340,7 @@ subroutine build_rho_grid( G, GV, h, tv, dzInterface, remapCS, CS ) ! Local depth (G%bathyT is positive) - nominalDepth = G%bathyT(i,j)*GV%m_to_H + nominalDepth = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H call build_rho_column(CS%rho_CS, nz, nominalDepth, h(i, j, :), & tv%T(i, j, :), tv%S(i, j, :), tv%eqn_of_state, zNew, & @@ -1445,7 +1445,7 @@ subroutine build_grid_HyCOM1( G, GV, h, tv, h_new, dzInterface, CS ) do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 if (G%mask2dT(i,j)>0.) then - depth = G%bathyT(i,j) * GV%m_to_H + depth = G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H z_col(1) = 0. ! Work downward rather than bottom up do K = 1, GV%ke @@ -1576,7 +1576,7 @@ subroutine build_grid_SLight(G, GV, h, tv, dzInterface, CS) do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 if (G%mask2dT(i,j)>0.) then - depth = G%bathyT(i,j) * GV%m_to_H + depth = G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H z_col(1) = 0. ! Work downward rather than bottom up do K=1,nz z_col(K+1) = z_col(K) + h(i, j, k) ! Work in units of h (m or Pa) @@ -1704,7 +1704,7 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) do i = G%isc-1,G%iec+1 ! Local depth - local_depth = G%bathyT(i,j)*GV%m_to_H + local_depth = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H ! Determine water column height total_height = 0.0 diff --git a/src/ALE/coord_adapt.F90 b/src/ALE/coord_adapt.F90 index 5b17c3b57c..91ba50fab7 100644 --- a/src/ALE/coord_adapt.F90 +++ b/src/ALE/coord_adapt.F90 @@ -126,7 +126,7 @@ subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) zNext(nz+1) = zInt(i,j,nz+1) ! local depth for scaling diffusivity - depth = G%bathyT(i,j) * GV%m_to_H + depth = G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H ! initialize del2sigma to zero del2sigma(:) = 0. diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 3d869f6681..eb7d8925b6 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -71,11 +71,12 @@ module MOM use MOM_dynamics_unsplit_RK2, only : initialize_dyn_unsplit_RK2, end_dyn_unsplit_RK2 use MOM_dynamics_unsplit_RK2, only : MOM_dyn_unsplit_RK2_CS use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid +use MOM_dyn_horgrid, only : rescale_dyn_horgrid_bathymetry use MOM_debugging, only : check_redundant use MOM_EOS, only : EOS_init, calculate_density use MOM_fixed_initialization, only : MOM_initialize_fixed -use MOM_grid, only : ocean_grid_type, set_first_direction -use MOM_grid, only : MOM_grid_init, MOM_grid_end +use MOM_grid, only : ocean_grid_type, MOM_grid_init, MOM_grid_end +use MOM_grid, only : set_first_direction, rescale_grid_bathymetry use MOM_hor_index, only : hor_index_type, hor_index_init use MOM_interface_heights, only : find_eta use MOM_lateral_mixing_coeffs, only : calc_slope_functions, VarMix_init @@ -1956,6 +1957,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Allocate initialize time-invariant MOM variables. call MOM_initialize_fixed(dG, CS%OBC, param_file, write_geom_files, dirs%output_directory) call callTree_waypoint("returned from MOM_initialize_fixed() (initialize_MOM)") + ! This could replace a later call to rescale_grid_bathymetry. + if (dG%Zd_to_m /= GV%Z_to_m) call rescale_dyn_horgrid_bathymetry(dG, GV%Z_to_m) + if (associated(CS%OBC)) call call_OBC_register(param_file, CS%update_OBC_CSp, CS%OBC) call tracer_registry_init(param_file, CS%tracer_Reg) @@ -2132,6 +2136,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call copy_dyngrid_to_MOM_grid(dG, G) call destroy_dyn_horgrid(dG) + ! This could be moved earlier, perhaps just after MOM_initialize_fixed. +! if (G%Zd_to_m /= GV%Z_to_m) call rescale_grid_bathymetry(G, GV%Z_to_m) + ! Set a few remaining fields that are specific to the ocean grid type. call set_first_direction(G, first_direction) ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. @@ -2893,10 +2900,10 @@ subroutine extract_surface_state(CS, sfc_state) numberOfErrors=0 ! count number of errors do j=js,je; do i=is,ie if (G%mask2dT(i,j)>0.) then - localError = sfc_state%sea_lev(i,j)<=-G%bathyT(i,j) & + localError = sfc_state%sea_lev(i,j)<=-G%Zd_to_m*G%bathyT(i,j) & .or. sfc_state%sea_lev(i,j)>= CS%bad_val_ssh_max & .or. sfc_state%sea_lev(i,j)<=-CS%bad_val_ssh_max & - .or. sfc_state%sea_lev(i,j)+G%bathyT(i,j) < CS%bad_vol_col_thick + .or. sfc_state%sea_lev(i,j) + G%Zd_to_m*G%bathyT(i,j) < CS%bad_vol_col_thick if (use_temperature) localError = localError & .or. sfc_state%SSS(i,j)<0. & .or. sfc_state%SSS(i,j)>=CS%bad_val_sss_max & @@ -2909,7 +2916,7 @@ subroutine extract_surface_state(CS, sfc_state) write(msg(1:240),'(2(a,i4,x),2(a,f8.3,x),8(a,es11.4,x))') & 'Extreme surface sfc_state detected: i=',i,'j=',j, & 'x=',G%geoLonT(i,j), 'y=',G%geoLatT(i,j), & - 'D=',G%bathyT(i,j), 'SSH=',sfc_state%sea_lev(i,j), & + 'D=',G%Zd_to_m*G%bathyT(i,j), 'SSH=',sfc_state%sea_lev(i,j), & 'SST=',sfc_state%SST(i,j), 'SSS=',sfc_state%SSS(i,j), & 'U-=',sfc_state%u(I-1,j), 'U+=',sfc_state%u(I,j), & 'V-=',sfc_state%v(i,J-1), 'V+=',sfc_state%v(i,J) @@ -2917,7 +2924,7 @@ subroutine extract_surface_state(CS, sfc_state) write(msg(1:240),'(2(a,i4,x),2(a,f8.3,x),6(a,es11.4))') & 'Extreme surface sfc_state detected: i=',i,'j=',j, & 'x=',G%geoLonT(i,j), 'y=',G%geoLatT(i,j), & - 'D=',G%bathyT(i,j), 'SSH=',sfc_state%sea_lev(i,j), & + 'D=',G%Zd_to_m*G%bathyT(i,j), 'SSH=',sfc_state%sea_lev(i,j), & 'U-=',sfc_state%u(I-1,j), 'U+=',sfc_state%u(I,j), & 'V-=',sfc_state%v(i,J-1), 'V+=',sfc_state%v(i,J) endif diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index c68ac56305..1e9e41eb9a 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -186,7 +186,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, !$OMP I_gEarth,h,alpha_Lay) !$OMP do do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - SSH(i,j) = -G%bathyT(i,j) + SSH(i,j) = -G%Zd_to_m*G%bathyT(i,j) enddo ; enddo if (use_EOS) then !$OMP do @@ -209,12 +209,12 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp) !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,geopot_bot,G,GV,e_tidal) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - geopot_bot(i,j) = -GV%g_Earth*(e_tidal(i,j) + G%bathyT(i,j)) + geopot_bot(i,j) = -GV%g_Earth*(e_tidal(i,j) + G%Zd_to_m*G%bathyT(i,j)) enddo ; enddo else !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,geopot_bot,G,GV) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - geopot_bot(i,j) = -GV%g_Earth*G%bathyT(i,j) + geopot_bot(i,j) = -GV%g_Earth*G%Zd_to_m*G%bathyT(i,j) enddo ; enddo endif @@ -453,7 +453,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! barotropic tides. !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,h,G,GV) do j=Jsq,Jeq+1 - do i=Isq,Ieq+1 ; e(i,j,1) = -1.0*G%bathyT(i,j) ; enddo + do i=Isq,Ieq+1 ; e(i,j,1) = -G%Zd_to_m*G%bathyT(i,j) ; enddo do k=1,nz ; do i=Isq,Ieq+1 e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_m enddo ; enddo @@ -466,12 +466,12 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta if (CS%tides) then !$OMP do do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -1.0*G%bathyT(i,j) - e_tidal(i,j) + e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) - e_tidal(i,j) enddo ; enddo else !$OMP do do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -1.0*G%bathyT(i,j) + e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) enddo ; enddo endif !$OMP do diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index c5e783cec3..9a50cd78e6 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -302,7 +302,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*G%bathyT(i,j) + za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*G%Zd_to_m*G%bathyT(i,j) enddo do k=nz,1,-1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) + dza(i,j,k) @@ -533,7 +533,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - e(i,j,1) = -1.0*G%bathyT(i,j) + e(i,j,1) = -G%Zd_to_m*G%bathyT(i,j) enddo do k=1,nz ; do i=Isq,Ieq+1 e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_m @@ -546,12 +546,12 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p if (CS%tides) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -1.0*G%bathyT(i,j) - e_tidal(i,j) + e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) - e_tidal(i,j) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -1.0*G%bathyT(i,j) + e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) enddo ; enddo endif !$OMP parallel do default(shared) @@ -668,7 +668,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth, & - dz_neglect, G%bathyT, G%HI, G%HI, & + dz_neglect, G%Zd_to_m*G%bathyT(:,:), G%HI, G%HI, & tv%eqn_of_state, dpa, intz_dpa, intx_dpa, inty_dpa, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then @@ -683,7 +683,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth, G%HI, G%HI, tv%eqn_of_state, & dpa, intz_dpa, intx_dpa, inty_dpa, & - G%bathyT, dz_neglect, CS%useMassWghtInterp) + G%Zd_to_m*G%bathyT(:,:), dz_neglect, CS%useMassWghtInterp) endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index ac1938449f..318f4126f1 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -269,7 +269,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*G%bathyT(i,j) + za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*G%Zd_to_m*G%bathyT(i,j) enddo do k=nz,1,-1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) + dza(i,j,k) @@ -518,7 +518,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - e(i,j,1) = -1.0*G%bathyT(i,j) + e(i,j,1) = -G%Zd_to_m*G%bathyT(i,j) enddo do k=1,nz ; do i=Isq,Ieq+1 e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_m @@ -531,12 +531,12 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at if (CS%tides) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -1.0*G%bathyT(i,j) - e_tidal(i,j) + e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) - e_tidal(i,j) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -1.0*G%bathyT(i,j) + e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) enddo ; enddo endif !$OMP parallel do default(shared) @@ -666,7 +666,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth, & - dz_neglect, G%bathyT, G%HI, G%Block(n), & + dz_neglect, G%Zd_to_m*G%bathyT(:,:), G%HI, G%Block(n), & tv%eqn_of_state, dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then @@ -681,7 +681,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth, G%HI, G%Block(n), tv%eqn_of_state, & dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & - G%bathyT, dz_neglect, CS%useMassWghtInterp) + G%Zd_to_m*G%bathyT(:,:), dz_neglect, CS%useMassWghtInterp) endif do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 intz_dpa_bk(ib,jb) = intz_dpa_bk(ib,jb)*GV%m_to_H diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 68ef858090..7e5045a087 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -130,7 +130,8 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: & ua_polarity, & !< Test vector components for checking grid polarity. va_polarity, & !< Test vector components for checking grid polarity. - bathyT !< A copy of bathyT (ocean bottom depth) with wide halos. + bathyT !< A copy of bathyT (ocean bottom depth) with wide halos, in depth units + real :: Zd_to_m = 1.0 !< The conversion factor between the units of bathyT and m. real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: IareaT !< This is a copy of G%IareaT with wide halos, but will !! still utilize the macro IareaT when referenced, m-2. @@ -804,18 +805,18 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & ! ### bathyT here should be replaced with bathyT+eta(Bous) or eta(non-Bous). !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - DCor_u(I,j) = 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j)) + DCor_u(I,j) = 0.5 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j)) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - DCor_v(i,J) = 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j)) + DCor_v(i,J) = 0.5 * G%Zd_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j)) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do I=is-1,ie q(I,J) = 0.25 * G%CoriolisBu(I,J) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & - ((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & - (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1))) + (G%Zd_to_m*((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & + (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)))) enddo ; enddo ! With very wide halos, q and D need to be calculated on the available data @@ -1291,7 +1292,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & do j=js,je ; do I=is-1,ie ; if (CS%lin_drag_u(I,j) > 0.0) then Htot = 0.5 * (eta(i,j) + eta(i+1,j)) if (GV%Boussinesq) & - Htot = Htot + 0.5*GV%m_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j)) + Htot = Htot + 0.5*CS%Zd_to_m*GV%m_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j)) bt_rem_u(I,j) = bt_rem_u(I,j) * (Htot / (Htot + CS%lin_drag_u(I,j) * dtbt)) Rayleigh_u(I,j) = CS%lin_drag_u(I,j) / Htot @@ -1300,7 +1301,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & do J=js-1,je ; do i=is,ie ; if (CS%lin_drag_v(i,J) > 0.0) then Htot = 0.5 * (eta(i,j) + eta(i,j+1)) if (GV%Boussinesq) & - Htot = Htot + 0.5*GV%m_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j+1)) + Htot = Htot + 0.5*CS%Zd_to_m*GV%m_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j+1)) bt_rem_v(i,J) = bt_rem_v(i,J) * (Htot / (Htot + CS%lin_drag_v(i,J) * dtbt)) Rayleigh_v(i,J) = CS%lin_drag_v(i,J) / Htot @@ -1353,7 +1354,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & ! Limit the sink (inward) correction to the amount of mass that is already ! inside the cell. Htot = eta(i,j) - if (GV%Boussinesq) Htot = CS%bathyT(i,j)*GV%m_to_H + eta(i,j) + if (GV%Boussinesq) Htot = CS%bathyT(i,j)*CS%Zd_to_m*GV%m_to_H + eta(i,j) CS%eta_cor(i,j) = max(CS%eta_cor(i,j), -max(0.0,Htot)) endif @@ -2633,17 +2634,17 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co else ! This is assuming Flather as only other option if (GV%Boussinesq) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - BT_OBC%H_u(I,j) = G%bathyT(i,j)*GV%m_to_H + eta(i,j) + BT_OBC%H_u(I,j) = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H + eta(i,j) elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - BT_OBC%H_u(I,j) = G%bathyT(i+1,j)*GV%m_to_H + eta(i+1,j) + BT_OBC%H_u(I,j) = G%bathyT(i+1,j)*G%Zd_to_m*GV%m_to_H + eta(i+1,j) endif else if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then BT_OBC%H_u(i,j) = eta(i,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j) + eta(i,j))) + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%Zd_to_m*G%bathyT(i,j) + eta(i,j))) elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then BT_OBC%H_u(i,j) = eta(i+1,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i+1,j) + eta(i+1,j))) + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%Zd_to_m*G%bathyT(i+1,j) + eta(i+1,j))) endif endif if (GV%Boussinesq) then @@ -2689,17 +2690,17 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co else ! This is assuming Flather as only other option if (GV%Boussinesq) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - BT_OBC%H_v(i,J) = G%bathyT(i,j)*GV%m_to_H + eta(i,j) + BT_OBC%H_v(i,J) = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H + eta(i,j) elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then - BT_OBC%H_v(i,J) = G%bathyT(i,j+1)*GV%m_to_H + eta(i,j+1) + BT_OBC%H_v(i,J) = G%bathyT(i,j+1)*G%Zd_to_m*GV%m_to_H + eta(i,j+1) endif else if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then BT_OBC%H_v(i,J) = eta(i,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j) + eta(i,j))) + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%Zd_to_m*G%bathyT(i,j) + eta(i,j))) elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then BT_OBC%H_v(i,J) = eta(i,j+1) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j+1) + eta(i,j+1))) + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%Zd_to_m*G%bathyT(i,j+1) + eta(i,j+1))) endif endif if (GV%Boussinesq) then @@ -2857,8 +2858,8 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) enddo ; enddo elseif (CS%hvel_scheme == HYBRID .or. use_default) then do I=is-1,ie - e_u(I,nz+1) = -0.5 * GV%m_to_H * (G%bathyT(i+1,j) + G%bathyT(i,j)) - D_shallow_u(I) = -GV%m_to_H * min(G%bathyT(i+1,j), G%bathyT(i,j)) + e_u(I,nz+1) = -0.5 * G%Zd_to_m*GV%m_to_H * (G%bathyT(i+1,j) + G%bathyT(i,j)) + D_shallow_u(I) = -G%Zd_to_m*GV%m_to_H * min(G%bathyT(i+1,j), G%bathyT(i,j)) hatutot(I) = 0.0 enddo do k=nz,1,-1 ; do I=is-1,ie @@ -2920,8 +2921,8 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) enddo ; enddo elseif (CS%hvel_scheme == HYBRID .or. use_default) then do i=is,ie - e_v(i,nz+1) = -0.5 * GV%m_to_H * (G%bathyT(i,j+1) + G%bathyT(i,j)) - D_shallow_v(I) = -GV%m_to_H * min(G%bathyT(i,j+1), G%bathyT(i,j)) + e_v(i,nz+1) = -0.5 * G%Zd_to_m*GV%m_to_H * (G%bathyT(i,j+1) + G%bathyT(i,j)) + D_shallow_v(I) = -G%Zd_to_m*GV%m_to_H * min(G%bathyT(i,j+1), G%bathyT(i,j)) hatvtot(I) = 0.0 enddo do k=nz,1,-1 ; do i=is,ie @@ -3557,14 +3558,14 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) if (GV%Boussinesq) then !$OMP do do j=js-hs,je+hs ; do I=is-1-hs,ie+hs - H1 = CS%bathyT(i,j)*GV%m_to_H + eta(i,j) ; H2 = CS%bathyT(i+1,j)*GV%m_to_H + eta(i+1,j) + H1 = CS%bathyT(i,j)*CS%Zd_to_m*GV%m_to_H + eta(i,j) ; H2 = CS%bathyT(i+1,j)*CS%Zd_to_m*GV%m_to_H + eta(i+1,j) Datu(I,j) = 0.0 ; if ((H1 > 0.0) .and. (H2 > 0.0)) & Datu(I,j) = CS%dy_Cu(I,j) * (2.0 * H1 * H2) / (H1 + H2) ! Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (H1 + H2) enddo ; enddo !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs - H1 = CS%bathyT(i,j)*GV%m_to_H + eta(i,j) ; H2 = CS%bathyT(i,j+1)*GV%m_to_H + eta(i,j+1) + H1 = CS%bathyT(i,j)*CS%Zd_to_m*GV%m_to_H + eta(i,j) ; H2 = CS%bathyT(i,j+1)*CS%Zd_to_m*GV%m_to_H + eta(i,j+1) Datv(i,J) = 0.0 ; if ((H1 > 0.0) .and. (H2 > 0.0)) & Datv(i,J) = CS%dx_Cv(i,J) * (2.0 * H1 * H2) / (H1 + H2) ! Datv(i,J) = CS%dy_v(i,J) * 0.5 * (H1 + H2) @@ -3589,12 +3590,12 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) !$OMP do do j=js-hs,je+hs ; do I=is-1-hs,ie+hs Datu(I,j) = CS%dy_Cu(I,j) * GV%m_to_H * & - (max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + add_max) + (CS%Zd_to_m*max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + add_max) enddo ; enddo !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs Datv(i,J) = CS%dx_Cv(i,J) * GV%m_to_H * & - (max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + add_max) + (CS%Zd_to_m*max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + add_max) enddo ; enddo else !$OMP do @@ -3602,7 +3603,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) Datu(I, j) = 0.0 !Would be "if (G%mask2dCu(I,j)>0.) &" is G was valid on BT domain if (CS%bathyT(i+1,j)+CS%bathyT(i,j)>0.) & - Datu(I,j) = 2.0*CS%dy_Cu(I,j) * GV%m_to_H * & + Datu(I,j) = 2.0*CS%dy_Cu(I,j) * CS%Zd_to_m*GV%m_to_H * & (CS%bathyT(i+1,j) * CS%bathyT(i,j)) / & (CS%bathyT(i+1,j) + CS%bathyT(i,j)) enddo ; enddo @@ -3611,7 +3612,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) Datv(i, J) = 0.0 !Would be "if (G%mask2dCv(i,J)>0.) &" is G was valid on BT domain if (CS%bathyT(i,j+1)+CS%bathyT(i,j)>0.) & - Datv(i,J) = 2.0*CS%dx_Cv(i,J) * GV%m_to_H * & + Datv(i,J) = 2.0*CS%dx_Cv(i,J) * CS%Zd_to_m*GV%m_to_H * & (CS%bathyT(i,j+1) * CS%bathyT(i,j)) / & (CS%bathyT(i,j+1) + CS%bathyT(i,j)) enddo ; enddo @@ -3658,7 +3659,7 @@ subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) do j=js,je do i=is,ie ; h_tot(i) = h(i,j,1) ; enddo if (GV%Boussinesq) then - do i=is,ie ; eta_h(i) = h(i,j,1) - G%bathyT(i,j)*GV%m_to_H ; enddo + do i=is,ie ; eta_h(i) = h(i,j,1) - G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H ; enddo else do i=is,ie ; eta_h(i) = h(i,j,1) ; enddo endif @@ -4065,6 +4066,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & CS%IareaT(i,j) = G%IareaT(i,j) CS%bathyT(i,j) = G%bathyT(i,j) enddo ; enddo + CS%Zd_to_m = G%Zd_to_m ! Note: G%IdxCu & G%IdyCv may be smaller than CS%IdxCu & CS%IdyCv, even without ! wide halos. do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB @@ -4087,17 +4089,17 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ALLOC_(CS%D_v_Cor(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) CS%q_D(:,:) = 0.0 ; CS%D_u_Cor(:,:) = 0.0 ; CS%D_v_Cor(:,:) = 0.0 do j=js,je ; do I=is-1,ie - CS%D_u_Cor(I,j) = 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j)) + CS%D_u_Cor(I,j) = 0.5 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j)) enddo ; enddo do J=js-1,je ; do i=is,ie - CS%D_v_Cor(i,J) = 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j)) + CS%D_v_Cor(i,J) = 0.5 * G%Zd_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j)) enddo ; enddo do J=js-1,je ; do I=is-1,ie if (G%mask2dT(i,j)+G%mask2dT(i,j+1)+G%mask2dT(i+1,j)+G%mask2dT(i+1,j+1)>0.) then CS%q_D(I,J) = 0.25 * G%CoriolisBu(I,J) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & - ((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & - (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1))) + (G%Zd_to_m*((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & + (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)))) else ! All four h points are masked out so q_D(I,J) will is meaningless CS%q_D(I,J) = 0. endif @@ -4294,24 +4296,24 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ! if (GV%Boussinesq) then do j=js,je ; do I=is-1,ie if (G%mask2dCu(I,j)>0.) then - CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (G%bathyT(i+1,j) + G%bathyT(i,j)) + CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j))) else ! Both neighboring H points are masked out so IDatu(I,j) is meaningless CS%IDatu(I,j) = 0. endif enddo ; enddo do J=js-1,je ; do i=is,ie if (G%mask2dCv(i,J)>0.) then - CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (G%bathyT(i,j+1) + G%bathyT(i,j)) + CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (G%Zd_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j))) else ! Both neighboring H points are masked out so IDatu(I,j) is meaningless CS%IDatv(i,J) = 0. endif enddo ; enddo ! else ! do j=js,je ; do I=is-1,ie -! CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (GV%Rho0*(G%bathyT(i+1,j) + G%bathyT(i,j))) +! CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (G%Zd_to_m*GV%Rho0*(G%bathyT(i+1,j) + G%bathyT(i,j))) ! enddo ; enddo ! do J=js-1,je ; do i=is,ie -! CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (GV%Rho0*(G%bathyT(i,j+1) + G%bathyT(i,j))) +! CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (G%Zd_to_m*GV%Rho0*(G%bathyT(i,j+1) + G%bathyT(i,j))) ! enddo ; enddo ! endif diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index cf248f5103..df60234ca3 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -1110,7 +1110,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil ! dimensions as h, either m or kg m-3. ! CS%eta(:,:) = 0.0 already from initialization. if (GV%Boussinesq) then - do j=js,je ; do i=is,ie ; CS%eta(i,j) = -G%bathyT(i,j) * GV%m_to_H ; enddo ; enddo + do j=js,je ; do i=is,ie ; CS%eta(i,j) = -G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H ; enddo ; enddo endif do k=1,nz ; do j=js,je ; do i=is,ie CS%eta(i,j) = CS%eta(i,j) + h(i,j,k) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 3965758510..96d78fccde 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -491,7 +491,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & endif if (GV%Boussinesq) then - do j=js,je ; do i=is,ie ; eta_av(i,j) = -G%bathyT(i,j) ; enddo ; enddo + do j=js,je ; do i=is,ie ; eta_av(i,j) = -G%Zd_to_m*G%bathyT(i,j) ; enddo ; enddo else do j=js,je ; do i=is,ie ; eta_av(i,j) = 0.0 ; enddo ; enddo endif diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 0f6d61905e..aef20292f8 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -431,7 +431,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, endif if (GV%Boussinesq) then - do j=js,je ; do i=is,ie ; eta_av(i,j) = -G%bathyT(i,j) ; enddo ; enddo + do j=js,je ; do i=is,ie ; eta_av(i,j) = -G%Zd_to_m*G%bathyT(i,j) ; enddo ; enddo else do j=js,je ; do i=is,ie ; eta_av(i,j) = 0.0 ; enddo ; enddo endif diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index f30bcda8cb..1ae571a733 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -70,7 +70,7 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) !$OMP G_Earth,dz_geo,halo,I_gEarth) & !$OMP private(dilate,htot) !$OMP do - do j=jsv,jev ; do i=isv,iev ; eta(i,j,nz+1) = -G%bathyT(i,j) ; enddo ; enddo + do j=jsv,jev ; do i=isv,iev ; eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) ; enddo ; enddo if (GV%Boussinesq) then !$OMP do @@ -83,11 +83,11 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) !$OMP do do j=jsv,jev do i=isv,iev - dilate(i) = (eta_bt(i,j)*GV%H_to_m + G%bathyT(i,j)) / & - (eta(i,j,1) + G%bathyT(i,j)) + dilate(i) = (eta_bt(i,j)*GV%H_to_m + G%Zd_to_m*G%bathyT(i,j)) / & + (eta(i,j,1) + G%Zd_to_m*G%bathyT(i,j)) enddo do k=1,nz ; do i=isv,iev - eta(i,j,K) = dilate(i) * (eta(i,j,K) + G%bathyT(i,j)) - G%bathyT(i,j) + eta(i,j,K) = dilate(i) * (eta(i,j,K) + G%Zd_to_m*G%bathyT(i,j)) - G%Zd_to_m*G%bathyT(i,j) enddo ; enddo enddo endif @@ -127,7 +127,7 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) do k=1,nz ; do i=isv,iev ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo do i=isv,iev ; dilate(i) = eta_bt(i,j) / htot(i) ; enddo do k=1,nz ; do i=isv,iev - eta(i,j,K) = dilate(i) * (eta(i,j,K) + G%bathyT(i,j)) - G%bathyT(i,j) + eta(i,j,K) = dilate(i) * (eta(i,j,K) + G%Zd_to_m*G%bathyT(i,j)) - G%Zd_to_m*G%bathyT(i,j) enddo ; enddo enddo endif @@ -178,7 +178,7 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) !$OMP G_Earth,dz_geo,halo,I_gEarth) & !$OMP private(htot) !$OMP do - do j=js,je ; do i=is,ie ; eta(i,j) = -G%bathyT(i,j) ; enddo ; enddo + do j=js,je ; do i=is,ie ; eta(i,j) = -G%Zd_to_m*G%bathyT(i,j) ; enddo ; enddo if (GV%Boussinesq) then if (present(eta_bt)) then @@ -225,8 +225,8 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) do i=is,ie ; htot(i) = GV%H_subroundoff ; enddo do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo do i=is,ie - eta(i,j) = (eta_bt(i,j) / htot(i)) * (eta(i,j) + G%bathyT(i,j)) - & - G%bathyT(i,j) + eta(i,j) = (eta_bt(i,j) / htot(i)) * (eta(i,j) + G%Zd_to_m*G%bathyT(i,j)) - & + G%Zd_to_m*G%bathyT(i,j) enddo enddo endif diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index de8c2fe174..bd23331e14 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -2977,7 +2977,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (segment%direction == OBC_DIRECTION_W) ishift=1 I=segment%HI%IsdB do j=segment%HI%jsd,segment%HI%jed - segment%Cg(I,j) = sqrt(GV%g_prime(1)*G%bathyT(i+ishift,j)) + segment%Cg(I,j) = sqrt(GV%g_prime(1)*G%Zd_to_m*G%bathyT(i+ishift,j)) segment%Htot(I,j)=0.0 do k=1,G%ke segment%h(I,j,k) = h(i+ishift,j,k) @@ -2990,7 +2990,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (segment%direction == OBC_DIRECTION_S) jshift=1 J=segment%HI%JsdB do i=segment%HI%isd,segment%HI%ied - segment%Cg(i,J) = sqrt(GV%g_prime(1)*G%bathyT(i,j+jshift)) + segment%Cg(i,J) = sqrt(GV%g_prime(1)*G%Zd_to_m*G%bathyT(i,j+jshift)) segment%Htot(i,J)=0.0 do k=1,G%ke segment%h(i,J,k) = h(i,j+jshift,k) @@ -3710,6 +3710,7 @@ subroutine mask_outside_OBCs(G, param_file, OBC) call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & default=0.0, do_not_log=.true.) + min_depth = min_depth / G%Zd_to_m allocate(color(G%isd:G%ied, G%jsd:G%jed)) ; color = 0 allocate(color2(G%isd:G%ied, G%jsd:G%jed)) ; color2 = 0 diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 639e52a8b7..29fb308dd3 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -244,13 +244,13 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (hin(i+1,j+1,k)); enddo - e(nz+1) = -G%bathyT(i,j) + e(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 ; e(K) = e(K+1) + hin(i,j,k) ; enddo write(file,'(/,"e-: ",$)') write(file,'(ES10.3," ",$)') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo - e(nz+1) = -G%bathyT(i+1,j) + e(nz+1) = -G%Zd_to_m*G%bathyT(i+1,j) do k=nz,1,-1 ; e(K) = e(K+1) + hin(i+1,j,k) ; enddo write(file,'(/,"e+: ",$)') write(file,'(ES10.3," ",$)') e(ks) @@ -327,7 +327,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a (0.5*CS%v_av(i+1,J,k)*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo endif - write(file,'(/,"D: ",2(ES10.3))') G%bathyT(i,j),G%bathyT(i+1,j) + write(file,'(/,"D: ",2(ES10.3))') G%Zd_to_m*G%bathyT(i,j),G%Zd_to_m*G%bathyT(i+1,j) ! From here on, the normalized accelerations are written. if (prev_avail) then @@ -575,13 +575,13 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a write(file,'(/,"h++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') hin(i+1,j+1,k); enddo - e(nz+1) = -G%bathyT(i,j) + e(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 ; e(K) = e(K+1) + hin(i,j,k); enddo write(file,'(/,"e-: ",$)') write(file,'(ES10.3," ",$)') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo - e(nz+1) = -G%bathyT(i,j+1) + e(nz+1) = -G%Zd_to_m*G%bathyT(i,j+1) do k=nz,1,-1 ; e(K) = e(K+1) + hin(i,j+1,k) ; enddo write(file,'(/,"e+: ",$)') write(file,'(ES10.3," ",$)') e(ks) @@ -658,7 +658,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a (0.5*CS%u_prev(I,j+1,k)*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo endif - write(file,'(/,"D: ",2(ES10.3))') G%bathyT(i,j),G%bathyT(i,j+1) + write(file,'(/,"D: ",2(ES10.3))') G%Zd_to_m*G%bathyT(i,j),G%Zd_to_m*G%bathyT(i,j+1) ! From here on, the normalized accelerations are written. if (prev_avail) then diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index cc272049d6..2a4b1b1ec3 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -107,7 +107,7 @@ function global_z_mean(var,G,CS,tracer) do k=1,nz ; do j=js,je ; do i=is,ie valid_point = 1.0 ! Weight factor for partial bottom cells - depth_weight = min( max( (-1.*G%bathyT(i,j)), CS%Z_int(k+1) ) - CS%Z_int(k), 0.) + depth_weight = min( max( (-G%Zd_to_m*G%bathyT(i,j)), CS%Z_int(k+1) ) - CS%Z_int(k), 0.) ! Flag the point as invalid if it contains missing data, or is below the bathymetry if (var(i,j,k) == CS%missing_tr(tracer)) valid_point = 0. @@ -217,7 +217,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) ! Remove all massless layers. do I=Isq,Ieq nk_valid(I) = 0 - D_pt(I) = 0.5*(G%bathyT(i+1,j)+G%bathyT(i,j)) + D_pt(I) = 0.5*G%Zd_to_m*(G%bathyT(i+1,j)+G%bathyT(i,j)) if (ice_shelf) then if (frac_shelf_h(i,j)+frac_shelf_h(i+1,j) > 0.) then ! under shelf shelf_depth(I) = abs(0.5*(ssh(i+1,j)+ssh(i,j))) @@ -314,7 +314,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) shelf_depth(:) = 0.0 ! initially all is open ocean ! Remove all massless layers. do i=is,ie - nk_valid(i) = 0 ; D_pt(i) = 0.5*(G%bathyT(i,j)+G%bathyT(i,j+1)) + nk_valid(i) = 0 ; D_pt(i) = 0.5*G%Zd_to_m*(G%bathyT(i,j)+G%bathyT(i,j+1)) if (ice_shelf) then if (frac_shelf_h(i,j)+frac_shelf_h(i,j+1) > 0.) then ! under shelf shelf_depth(i) = abs(0.5*(ssh(i,j)+ssh(i,j+1))) @@ -406,7 +406,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) shelf_depth(:) = 0.0 ! initially all is open ocean ! Remove all massless layers. do i=is,ie - nk_valid(i) = 0 ; D_pt(i) = G%bathyT(i,j) + nk_valid(i) = 0 ; D_pt(i) = G%Zd_to_m*G%bathyT(i,j) if (ice_shelf) then if (frac_shelf_h(i,j) > 0.) then ! under shelf shelf_depth(i) = abs(ssh(i,j)) @@ -556,13 +556,13 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) htot(i,j) = htot(i,j) + h(i,j,k) enddo ; enddo ; enddo do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - dilate(i,j) = G%bathyT(i,j) / htot(i,j) + dilate(i,j) = G%Zd_to_m*G%bathyT(i,j) / htot(i,j) enddo ; enddo ! zonal transport if (CS%id_uh_Z > 0) then ; do j=js,je do I=Isq,Ieq - kz(I) = nk_z ; z_int_above(I) = -0.5*(G%bathyT(i,j)+G%bathyT(i+1,j)) + kz(I) = nk_z ; z_int_above(I) = -0.5*G%Zd_to_m*(G%bathyT(i,j)+G%bathyT(i+1,j)) enddo do k=nk_z,1,-1 ; do I=Isq,Ieq uh_Z(I,k) = 0.0 @@ -597,7 +597,7 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) ! meridional transport if (CS%id_vh_Z > 0) then ; do J=Jsq,Jeq do i=is,ie - kz(i) = nk_z ; z_int_above(i) = -0.5*(G%bathyT(i,j)+G%bathyT(i,j+1)) + kz(i) = nk_z ; z_int_above(i) = -0.5*G%Zd_to_m*(G%bathyT(i,j)+G%bathyT(i,j+1)) enddo do k=nk_z,1,-1 ; do i=is,ie vh_Z(i,k) = 0.0 @@ -769,8 +769,8 @@ subroutine calc_Zint_diags(h, in_ptrs, ids, num_diags, G, GV, CS) do k=1,nk ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo do i=is,ie dilate(i) = 0.0 - if (htot(i)*GV%H_to_m > 0.5) dilate(i) = (G%bathyT(i,j) - 0.0) / htot(i) - e(i,nk+1) = -G%bathyT(i,j) + if (htot(i)*GV%H_to_m > 0.5) dilate(i) = (G%Zd_to_m*G%bathyT(i,j) - 0.0) / htot(i) + e(i,nk+1) = -G%Zd_to_m*G%bathyT(i,j) enddo do k=nk,1,-1 ; do i=is,ie e(i,k) = e(i,k+1) + h(i,j,k) * dilate(i) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 8e18ed5a01..5e40fad81e 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -291,12 +291,12 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (associated(CS%e_D)) then if (associated(CS%e)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie - CS%e_D(i,j,k) = CS%e(i,j,k) + G%bathyT(i,j) + CS%e_D(i,j,k) = CS%e(i,j,k) + G%Zd_to_m*G%bathyT(i,j) enddo ; enddo ; enddo else call find_eta(h, tv, GV%g_Earth, G, GV, CS%e_D, eta_bt) do k=1,nz+1 ; do j=js,je ; do i=is,ie - CS%e_D(i,j,k) = CS%e_D(i,j,k) + G%bathyT(i,j) + CS%e_D(i,j,k) = CS%e_D(i,j,k) + G%Zd_to_m*G%bathyT(i,j) enddo ; enddo ; enddo endif @@ -810,7 +810,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) if (CS%id_col_ht > 0) then call find_eta(h, tv, GV%g_Earth, G, GV, z_top) do j=js,je ; do i=is,ie - z_bot(i,j) = z_top(i,j) + G%bathyT(i,j) + z_bot(i,j) = z_top(i,j) + G%Zd_to_m*G%bathyT(i,j) enddo ; enddo call post_data(CS%id_col_ht, z_bot, CS%diag) endif @@ -1209,7 +1209,7 @@ subroutine post_surface_thermo_diags(IDs, G, GV, diag, dt_int, sfc_state, tv, & ! post total volume of the liquid ocean if (IDs%id_volo > 0) then do j=js,je ; do i=is,ie - work_2d(i,j) = G%mask2dT(i,j)*(ssh(i,j) + G%bathyT(i,j)) + work_2d(i,j) = G%mask2dT(i,j)*(ssh(i,j) + G%Zd_to_m*G%bathyT(i,j)) enddo ; enddo volo = global_area_integral(work_2d, G) call post_data(IDs%id_volo, volo, diag) @@ -1898,7 +1898,15 @@ subroutine write_static_fields(G, GV, tv, diag) cmor_standard_name='sea_floor_depth_below_geoid',& area=diag%axesT1%id_area, & x_cell_method='mean', y_cell_method='mean', area_cell_method='mean') - if (id > 0) call post_data(id, G%bathyT, diag, .true., mask=G%mask2dT) + if (id > 0) then + if (G%Zd_to_m == 1.0) then + call post_data(id, G%bathyT, diag, .true., mask=G%mask2dT) + else + tmp_h(:,:) = 0. + tmp_h(G%isc:G%iec,G%jsc:G%jec) = G%bathyT(G%isc:G%iec,G%jsc:G%jec) / G%Zd_to_m + call post_data(id, tmp_h, diag, .true., mask=G%mask2dT) + endif + endif id = register_static_field('ocean_model', 'wet', diag%axesT1, & '0 if land, 1 if ocean at tracer points', 'none', area=diag%axesT1%id_area) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 3392f85437..e21fb3da3d 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -640,8 +640,8 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc hbelow = 0.0 do k=nz,1,-1 hbelow = hbelow + h(i,j,k) * H_to_m - hint = H_0APE(K) + (hbelow - G%bathyT(i,j)) - hbot = H_0APE(K) - G%bathyT(i,j) + hint = H_0APE(K) + (hbelow - G%Zd_to_m*G%bathyT(i,j)) + hbot = H_0APE(K) - G%Zd_to_m*G%bathyT(i,j) hbot = (hbot + ABS(hbot)) * 0.5 PE_pt(i,j,K) = 0.5 * areaTm(i,j) * (GV%Rho0*GV%g_prime(K)) * & (hint * hint - hbot * hbot) @@ -652,7 +652,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc hbelow = 0.0 do k=nz,1,-1 hint = H_0APE(K) + eta(i,j,K) ! eta and H_0 have opposite signs. - hbot = max(H_0APE(K) - G%bathyT(i,j), 0.0) + hbot = max(H_0APE(K) - G%Zd_to_m*G%bathyT(i,j), 0.0) PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * (GV%Rho0*GV%g_prime(K))) * & (hint * hint - hbot * hbot) enddo @@ -1088,7 +1088,7 @@ subroutine create_depth_list(G, CS) i_global = i + G%idg_offset - (G%isg-1) list_pos = (j_global-1)*G%Domain%niglobal + i_global - Dlist(list_pos) = G%bathyT(i,j) + Dlist(list_pos) = G%Zd_to_m*G%bathyT(i,j) Arealist(list_pos) = G%mask2dT(i,j)*G%areaT(i,j) enddo ; enddo diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 0ca8201ebe..29ea15021c 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -318,7 +318,8 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & hw = 0.5*(Hc(k-1)+Hc(k)) gp = gprime(K) if (l_mono_N2_column_fraction>0. .or. l_mono_N2_depth>=0.) then - if (G%bathyT(i,j)-sum_hcN2min*hw) then + if (G%Zd_to_m*G%bathyT(i,j)-sum_hc < l_mono_N2_column_fraction*G%Zd_to_m*G%bathyT(i,j) .and. & + gp>N2min*hw) then ! Filters out regions where N2 increases with depth but only in a lower fraction of water column gp = N2min/hw elseif (l_mono_N2_depth>=0. .and. sum_hc>l_mono_N2_depth .and. gp>N2min*hw) then diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 737e7a3fbf..7f311811e4 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -269,22 +269,22 @@ subroutine diag_remap_update(remap_cs, G, GV, h, T, S, eqn_of_state) if (remap_cs%vertical_coord == coordinateMode('ZSTAR')) then call build_zstar_column(get_zlike_CS(remap_cs%regrid_cs), & - G%bathyT(i,j)*GV%m_to_H, sum(h(i,j,:)), & + G%Zd_to_m*GV%m_to_H*G%bathyT(i,j), sum(h(i,j,:)), & zInterfaces, zScale=GV%m_to_H) elseif (remap_cs%vertical_coord == coordinateMode('SIGMA')) then call build_sigma_column(get_sigma_CS(remap_cs%regrid_cs), & - GV%m_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) + G%Zd_to_m*GV%m_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) elseif (remap_cs%vertical_coord == coordinateMode('RHO')) then call build_rho_column(get_rho_CS(remap_cs%regrid_cs), G%ke, & - G%bathyT(i,j), h(i,j,:), T(i, j, :), S(i, j, :), & + G%Zd_to_m*G%bathyT(i,j), h(i,j,:), T(i, j, :), S(i, j, :), & eqn_of_state, zInterfaces, h_neglect, h_neglect_edge) elseif (remap_cs%vertical_coord == coordinateMode('SLIGHT')) then ! call build_slight_column(remap_cs%regrid_cs,remap_cs%remap_cs, nz, & -! G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) +! G%Zd_to_m*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) call MOM_error(FATAL,"diag_remap_update: SLIGHT coordinate not coded for diagnostics yet!") elseif (remap_cs%vertical_coord == coordinateMode('HYCOM1')) then ! call build_hycom1_column(remap_cs%regrid_cs, nz, & -! G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) +! G%Zd_to_m*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) call MOM_error(FATAL,"diag_remap_update: HYCOM1 coordinate not coded for diagnostics yet!") endif remap_cs%h(i,j,:) = zInterfaces(1:nz) - zInterfaces(2:nz+1) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index c7befad3b3..afadf6bdfa 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -446,7 +446,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, allocate(mask_in(id,jdp)) ; mask_in(:,:)=0.0 allocate(last_row(id)) ; last_row(:)=0.0 - max_depth = maxval(G%bathyT) + max_depth = G%Zd_to_m*maxval(G%bathyT) call mpp_max(max_depth) if (z_edges_in(kd+1)= 0) then ! ice thickness does not take up whole ocean column -> floating CS%OD_av(i,j) = OD @@ -829,7 +829,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) do k=0,1 do l=0,1 if ((ISS%hmask(i,j) == 1) .and. & - (rhoi/rhow * H_node(i-1+k,j-1+l) - G%bathyT(i,j) <= 0)) then + (rhoi/rhow * H_node(i-1+k,j-1+l) - G%Zd_to_m*G%bathyT(i,j) <= 0)) then nodefloat = nodefloat + 1 endif enddo @@ -888,7 +888,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) Au(:,:) = 0.0 ; Av(:,:) = 0.0 call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & - CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, G%areaT, & + CS%ice_visc, float_cond, G%Zd_to_m*G%bathyT(:,:), CS%taub_beta_eff, G%areaT, & G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) err_init = 0 ; err_tempu = 0; err_tempv = 0 @@ -947,7 +947,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) Au(:,:) = 0 ; Av(:,:) = 0 call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & - CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, G%areaT, & + CS%ice_visc, float_cond, G%Zd_to_m*G%bathyT(:,:), CS%taub_beta_eff, G%areaT, & G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) err_max = 0 @@ -1111,7 +1111,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c call pass_vector(DIAGu, DIAGv, G%domain, TO_ALL, BGRID_NE) call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, hmask, & - H_node, CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, & + H_node, CS%ice_visc, float_cond, G%Zd_to_m*G%bathyT(:,:), CS%taub_beta_eff, & G%areaT, G, isc-1, iec+1, jsc-1, jec+1, CS%density_ice/CS%density_ocean_avg) call pass_vector(Au, Av, G%domain, TO_ALL, BGRID_NE) @@ -1182,7 +1182,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c Au(:,:) = 0 ; Av(:,:) = 0 call CG_action(Au, Av, Du, Dv, Phi, Phisub, CS%umask, CS%vmask, hmask, & - H_node, CS%ice_visc, float_cond, G%bathyT, CS%taub_beta_eff, & + H_node, CS%ice_visc, float_cond, G%Zd_to_m*G%bathyT(:,:), CS%taub_beta_eff, & G%areaT, G, is, ie, js, je, CS%density_ice/CS%density_ocean_avg) ! Au, Av valid region moves in by 1 @@ -2123,7 +2123,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) ! prelim - go through and calculate S ! or is this faster? - BASE(:,:) = -G%bathyT(:,:) + OD(:,:) + BASE(:,:) = -G%Zd_to_m*G%bathyT(:,:) + OD(:,:) S(:,:) = BASE(:,:) + ISS%h_shelf(:,:) do j=jsc-1,jec+1 @@ -2222,7 +2222,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) taud_y(I,J) = taud_y(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * dxdyh if (CS%float_frac(i,j) == 1) then - neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j) ** 2 - rhow * G%bathyT(i,j) ** 2) + neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j) ** 2 - rhow * (G%Zd_to_m*G%bathyT(i,j)) ** 2) else neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j) ** 2 endif @@ -2738,7 +2738,7 @@ subroutine matrix_diagonal(CS, G, float_cond, H_node, nu, beta, hmask, dens_rati enddo ; enddo enddo ; enddo if (float_cond(i,j) == 1) then - Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%bathyT(i,j) + Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%Zd_to_m*G%bathyT(i,j) Hcell(:,:) = H_node(i-1:i,j-1:j) call CG_diagonal_subgrid_basal & (Phisub, Hcell, dxdyh, basel, dens_ratio, Usubcontr, Vsubcontr) @@ -2953,7 +2953,7 @@ subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, flo enddo ; enddo if (float_cond(i,j) == 1) then - Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%bathyT(i,j) + Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%Zd_to_m*G%bathyT(i,j) Ucell(:,:) = CS%u_bdry_val(i-1:i,j-1:j) ; Vcell(:,:) = CS%v_bdry_val(i-1:i,j-1:j) Hcell(:,:) = H_node(i-1:i,j-1:j) call CG_action_subgrid_basal & @@ -3089,7 +3089,7 @@ subroutine update_OD_ffrac_uncoupled(CS, G, h_shelf) do j=jsd,jed do i=isd,ied - OD = G%bathyT(i,j) - rhoi/rhow * h_shelf(i,j) + OD = G%Zd_to_m*G%bathyT(i,j) - rhoi/rhow * h_shelf(i,j) if (OD >= 0) then ! ice thickness does not take up whole ocean column -> floating CS%OD_av(i,j) = OD diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index ba64d8e75c..b754b19bcb 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -165,7 +165,8 @@ subroutine MOM_initialize_fixed(G, OBC, PF, write_geom, output_dir) end subroutine MOM_initialize_fixed -!> MOM_initialize_topography makes the appropriate call to set up the bathymetry. +!> MOM_initialize_topography makes the appropriate call to set up the bathymetry. At this +!! point the topography is in units of m, but this can be changed later. subroutine MOM_initialize_topography(D, max_depth, G, PF) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & @@ -176,7 +177,6 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) ! This subroutine makes the appropriate call to set up the bottom depth. ! This is a separate subroutine so that it can be made public and shared with ! the ice-sheet code or other components. -! Set up the bottom depth, G%bathyT either analytically or from file character(len=40) :: mdl = "MOM_initialize_topography" ! This subroutine's name. character(len=200) :: config diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 9f7c5dcc28..f0626cbd02 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -1209,7 +1209,8 @@ subroutine initialize_masks(G, PF) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: PF !< Parameter file structure ! Local variables - real :: Dmin, min_depth, mask_depth + real :: Dmin ! The depth for masking in the same units as G%bathyT. + real :: min_depth, mask_depth ! Depths in m. character(len=40) :: mdl = "MOM_grid_init initialize_masks" integer :: i, j @@ -1225,8 +1226,8 @@ subroutine initialize_masks(G, PF) "fluxes are zeroed out. MASKING_DEPTH is ignored if negative.", & units="m", default=-9999.0) - Dmin = min_depth - if (mask_depth>=0.) Dmin = mask_depth + Dmin = min_depth / G%Zd_to_m + if (mask_depth>=0.) Dmin = mask_depth / G%Zd_to_m G%mask2dCu(:,:) = 0.0 ; G%mask2dCv(:,:) = 0.0 ; G%mask2dBu(:,:) = 0.0 diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index e818c33acd..2554d86cfd 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -1099,12 +1099,8 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file) character(len=*), intent(in) :: directory !< The directory into which to place the geometry file. character(len=*), optional, intent(in) :: geom_file !< If present, the name of the geometry file !! (otherwise the file is "ocean_geometry") -! This subroutine writes out a file containing all of the ocean geometry -! and grid data uses by the MOM ocean model. -! Arguments: G - The ocean's grid structure. Effectively intent in. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) directory - The directory into which to place the file. + + ! Local variables. character(len=240) :: filepath character(len=40) :: mdl = "write_ocean_geometry_file" integer, parameter :: nFlds=23 @@ -1194,7 +1190,8 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file) call write_field(unit, fields(3), G%Domain%mpp_domain, G%geoLatT) call write_field(unit, fields(4), G%Domain%mpp_domain, G%geoLonT) - call write_field(unit, fields(5), G%Domain%mpp_domain, G%bathyT) + do j=js,je ; do i=is,ie ; out_h(i,j) = G%Zd_to_m*G%bathyT(i,j) ; enddo ; enddo + call write_field(unit, fields(5), G%Domain%mpp_domain, out_h) call write_field(unit, fields(6), G%Domain%mpp_domain, G%CoriolisBu) ! I think that all of these copies are holdovers from a much earlier diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index c612970361..120f990224 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -669,7 +669,7 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne enddo ; enddo ; enddo do j=js,je ; do i=is,ie - if (abs(eta(i,j,nz+1) + G%bathyT(i,j)) > 1.0) & + if (abs(eta(i,j,nz+1) + G%Zd_to_m*G%bathyT(i,j)) > 1.0) & inconsistent = inconsistent + 1 enddo ; enddo call sum_across_PEs(inconsistent) @@ -708,8 +708,8 @@ subroutine adjustEtaToFitBathymetry(G, GV, eta, h) contractions = 0 do j=js,je ; do i=is,ie - if (-eta(i,j,nz+1) > G%bathyT(i,j) + hTolerance) then - eta(i,j,nz+1) = -G%bathyT(i,j) + if (-eta(i,j,nz+1) > G%Zd_to_m*G%bathyT(i,j) + hTolerance) then + eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) contractions = contractions + 1 endif enddo ; enddo @@ -738,12 +738,12 @@ subroutine adjustEtaToFitBathymetry(G, GV, eta, h) ! The whole column is dilated to accommodate deeper topography than ! the bathymetry would indicate. ! This should be... if ((G%mask2dt(i,j)*(eta(i,j,1)-eta(i,j,nz+1)) > 0.0) .and. & - if (-eta(i,j,nz+1) < G%bathyT(i,j) - hTolerance) then + if (-eta(i,j,nz+1) < G%Zd_to_m*G%bathyT(i,j) - hTolerance) then dilations = dilations + 1 if (eta(i,j,1) <= eta(i,j,nz+1)) then - do k=1,nz ; h(i,j,k) = (eta(i,j,1)+G%bathyT(i,j)) / real(nz) ; enddo + do k=1,nz ; h(i,j,k) = (eta(i,j,1) + G%Zd_to_m*G%bathyT(i,j)) / real(nz) ; enddo else - dilate = (eta(i,j,1)+G%bathyT(i,j)) / (eta(i,j,1)-eta(i,j,nz+1)) + dilate = (eta(i,j,1) + G%Zd_to_m*G%bathyT(i,j)) / (eta(i,j,1) - eta(i,j,nz+1)) do k=1,nz ; h(i,j,k) = h(i,j,k) * dilate ; enddo endif do k=nz,2,-1 ; eta(i,j,K) = eta(i,j,K+1) + h(i,j,k) ; enddo @@ -804,7 +804,7 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) ! Angstrom thick, and 2. the interfaces are where they should be ! based on the resting depths and interface height perturbations, ! as long at this doesn't interfere with 1. - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then @@ -882,7 +882,7 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) ! Angstrom thick, and 2. the interfaces are where they should be ! based on the resting depths and interface height perturbations, ! as long at this doesn't interfere with 1. - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then @@ -1134,9 +1134,9 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) endif do j=G%jsc,G%jec ; do i=G%isc,G%iec - call cut_off_column_top(GV%ke, tv, GV%Rho0, GV%g_Earth, G%bathyT(i,j), min_thickness, & - tv%T(i,j,:), T_t(i,j,:), T_b(i,j,:), tv%S(i,j,:), S_t(i,j,:), S_b(i,j,:), & - p_surf(i,j), h(i,j,:), remap_CS) + call cut_off_column_top(GV%ke, tv, GV%Rho0, GV%g_Earth, G%Zd_to_m*G%bathyT(i,j), & + min_thickness, tv%T(i,j,:), T_t(i,j,:), T_b(i,j,:), & + tv%S(i,j,:), S_t(i,j,:), S_b(i,j,:), p_surf(i,j), h(i,j,:), remap_CS) enddo ; enddo end subroutine trim_for_ice @@ -1754,7 +1754,7 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) do j=js,je ; do i=is,ie - eta(i,j,nz+1) = -G%bathyT(i,j) + eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) enddo ; enddo do k=nz,1,-1 ; do j=js,je ; do i=is,ie if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_m)) & @@ -1779,7 +1779,7 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) do j=js,je ; do i=is,ie - eta(i,j,nz+1) = -G%bathyT(i,j) + eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) enddo ; enddo do k=nz,1,-1 ; do j=js,je ; do i=is,ie @@ -2152,11 +2152,11 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) tmp_mask_in(i,j,1:kd) = mask_z(i,j,:) do k = 1, nkd if (tmp_mask_in(i,j,k)>0. .and. k<=kd) then - zBottomOfCell = max( -z_edges_in(k+1), -G%bathyT(i,j) ) + zBottomOfCell = max( -z_edges_in(k+1), -G%Zd_to_m*G%bathyT(i,j) ) tmpT1dIn(i,j,k) = temp_z(i,j,k) tmpS1dIn(i,j,k) = salt_z(i,j,k) elseif (k>1) then - zBottomOfCell = -G%bathyT(i,j) + zBottomOfCell = -G%Zd_to_m*G%bathyT(i,j) tmpT1dIn(i,j,k) = tmpT1dIn(i,j,k-1) tmpS1dIn(i,j,k) = tmpS1dIn(i,j,k-1) else ! This next block should only ever be reached over land @@ -2166,7 +2166,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) h1(i,j,k) = GV%m_to_H * (zTopOfCell - zBottomOfCell) zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo - h1(i,j,kd) = h1(i,j,kd) + GV%m_to_H * max(0., zTopOfCell + G%bathyT(i,j) ) + h1(i,j,kd) = h1(i,j,kd) + GV%m_to_H * max(0., zTopOfCell + G%Zd_to_m*G%bathyT(i,j) ) ! The max here is in case the data data is shallower than model endif ! mask2dT enddo ; enddo @@ -2189,7 +2189,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) ! Build the target grid combining hTarget and topography zTopOfCell = 0. ; zBottomOfCell = 0. do k = 1, nz - zBottomOfCell = max( zTopOfCell - hTarget(k), -G%bathyT(i,j) ) + zBottomOfCell = max( zTopOfCell - hTarget(k), -G%Zd_to_m*G%bathyT(i,j) ) h(i,j,k) = GV%m_to_H * (zTopOfCell - zBottomOfCell) zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo @@ -2239,7 +2239,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) do k=2,nz ; Rb(k)=0.5*(GV%Rlay(k-1)+GV%Rlay(k)) ; enddo Rb(1) = 0.0 ; Rb(nz+1) = 2.0*GV%Rlay(nz) - GV%Rlay(nz-1) - zi(is:ie,js:je,:) = find_interfaces(rho_z(is:ie,js:je,:), z_in, Rb, G%bathyT(is:ie,js:je), & + zi(is:ie,js:je,:) = find_interfaces(rho_z(is:ie,js:je,:), z_in, Rb, G%Zd_to_m*G%bathyT(is:ie,js:je), & nlevs(is:ie,js:je), nkml, nkbl, min_depth) if (correct_thickness) then @@ -2255,7 +2255,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) enddo ; enddo ; enddo inconsistent=0 do j=js,je ; do i=is,ie - if (abs(zi(i,j,nz+1) + G%bathyT(i,j)) > 1.0) & + if (abs(zi(i,j,nz+1) + G%Zd_to_m*G%bathyT(i,j)) > 1.0) & inconsistent = inconsistent + 1 enddo ; enddo call sum_across_PEs(inconsistent) diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 07be1ee340..95041d814d 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -82,7 +82,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, ! Local variables for ALE remapping real, dimension(:), allocatable :: h1, h2, hTarget, deltaE, tmpT1d real, dimension(:), allocatable :: tmpT1dIn - real :: zTopOfCell, zBottomOfCell + real :: zTopOfCell, zBottomOfCell, z_bathy ! Heights in m. type(remapping_CS) :: remapCS ! Remapping parameters and work arrays real, dimension(:,:,:), allocatable :: hSrc @@ -154,12 +154,13 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, if (G%mask2dT(i,j)>0.) then ! Build the source grid zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0 + z_bathy = G%Zd_to_m*G%bathyT(i,j) do k = 1, kd if (mask_z(i,j,k) > 0.) then - zBottomOfCell = -min( z_edges_in(k+1), G%bathyT(i,j) ) + zBottomOfCell = -min( z_edges_in(k+1), z_bathy ) tmpT1dIn(k) = tr_z(i,j,k) elseif (k>1) then - zBottomOfCell = -G%bathyT(i,j) + zBottomOfCell = -z_bathy tmpT1dIn(k) = tmpT1dIn(k-1) else ! This next block should only ever be reached over land tmpT1dIn(k) = -99.9 @@ -168,7 +169,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, if (h1(k)>0.) nPoints = nPoints + 1 zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo - h1(kd) = h1(kd) + ( zTopOfCell + G%bathyT(i,j) ) ! In case data is deeper than model + h1(kd) = h1(kd) + ( zTopOfCell + z_bathy ) ! In case data is deeper than model else tr(i,j,:) = 0. endif ! mask2dT diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index 4da55554d3..ccc71fa5e1 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -111,7 +111,7 @@ end function alpha_wright_eos_2d function beta_wright_eos_2d(T,S,p) result(drho_dS) real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and salinity (psu) real, intent(in) :: p !< pressure (Pa) - real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dS !< partial derivative of density with + real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dS !< partial derivative of density with !! respect to salinity (kg m-3 PSU-1) ! Local variables real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5 diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 7e68eac52a..21d6c21328 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -612,7 +612,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, SN_u, SN_v, drag_rate_visc, I_mass) do while (resid>0.) n1 = n1 + 1 EKE = EKEmax - call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & + call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%Zd_to_m*G%bathyT(i,j), & MEKE%Rd_dx_h(i,j), SN, EKE, & bottomFac2, barotrFac2, LmixScale, & Lrhines, Leady) @@ -717,7 +717,7 @@ subroutine MEKE_lengthScales(CS, MEKE, G, SN_u, SN_v, & beta = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) endif ! Returns bottomFac2, barotrFac2 and LmixScale - call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & + call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%Zd_to_m*G%bathyT(i,j), & MEKE%Rd_dx_h(i,j), SN, MEKE%MEKE(i,j), & bottomFac2(i,j), barotrFac2(i,j), LmixScale(i,j), & Lrhines(i,j), Leady(i,j)) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 822c11470e..ed8245d2be 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -348,7 +348,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Extract the energy for mixing due to bottom drag------------------------------- if (CS%apply_bottom_drag) then do j=jsd,jed ; do i=isd,ied - I_D_here = 1.0 / max(G%bathyT(i,j), 1.0) + ! Note the 1 m dimensional scale here. Should this be a parameter? + I_D_here = 1.0 / (GV%Z_to_m*max(G%bathyT(i,j), 1.0*GV%m_to_Z)) drag_scale(i,j) = CS%cdrag * sqrt(max(0.0, vel_btTide(i,j)**2 + & tot_En(i,j) * I_rho0 * I_D_here)) * I_D_here enddo ; enddo @@ -2312,7 +2313,7 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS) call MOM_read_data(filename, 'h2', h2, G%domain, timelevel=1) do j=G%jsc,G%jec ; do i=G%isc,G%iec ! Restrict rms topo to 10 percent of column depth. - h2(i,j) = min(0.01*G%bathyT(i,j)**2, h2(i,j)) + h2(i,j) = min(0.01*(G%Zd_to_m*G%bathyT(i,j))**2, h2(i,j)) ! Compute the fixed part; units are [kg m-2] here ! will be multiplied by N and En to get into [W m-2] CS%TKE_itidal_loss_fixed(i,j) = 0.5*kappa_h2_factor*GV%Rho0*& diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 738c6dd2f0..34a5436f34 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -691,10 +691,11 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) enddo ; enddo ! SN above contains S^2*N^2*H, convert to vertical average of S*N do I=is-1,ie - !SN_u(I,j) = sqrt( SN_u(I,j) / ( max(G%bathyT(I,j), G%bathyT(I+1,j)) + GV%Angstrom_H ) ) + !SN_u(I,j) = sqrt( SN_u(I,j) / (G%Zd_to_m*( max(G%bathyT(I,j), G%bathyT(I+1,j)) + GV%Angstrom_Z ) )) !The code below behaves better than the line above. Not sure why? AJA - if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_m ) then - CS%SN_u(I,j) = G%mask2dCu(I,j) * sqrt( CS%SN_u(I,j) / max(G%bathyT(I,j), G%bathyT(I+1,j)) ) + if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_Z ) then + CS%SN_u(I,j) = G%mask2dCu(I,j) * sqrt( CS%SN_u(I,j) / & + (G%Zd_to_m*max(G%bathyT(I,j), G%bathyT(I+1,j))) ) else CS%SN_u(I,j) = 0.0 endif @@ -706,10 +707,11 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) CS%SN_v(i,J) = CS%SN_v(i,J) + SN_v_local(i,J,k) enddo ; enddo do i=is,ie - !SN_v(i,J) = sqrt( SN_v(i,J) / ( max(G%bathyT(i,J), G%bathyT(i,J+1)) + GV%Angstrom_H ) ) + !SN_v(i,J) = sqrt( SN_v(i,J) / (G%Zd_to_m*( max(G%bathyT(i,J), G%bathyT(i,J+1)) + GV%Angstrom_Z ) )) !The code below behaves better than the line above. Not sure why? AJA - if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_m ) then - CS%SN_v(i,J) = G%mask2dCv(i,J) * sqrt( CS%SN_v(i,J) / max(G%bathyT(i,J), G%bathyT(i,J+1)) ) + if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_Z ) then + CS%SN_v(i,J) = G%mask2dCv(i,J) * sqrt( CS%SN_v(i,J) / & + (G%Zd_to_m*max(G%bathyT(i,J), G%bathyT(i,J+1))) ) else CS%SN_v(I,j) = 0.0 endif diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index ec285072ed..97d7d12f7e 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -18,10 +18,11 @@ module MOM_ALE_sponge use MOM_error_handler, only : MOM_error, FATAL, NOTE, WARNING, is_root_pe use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type +use MOM_horizontal_regridding, only : horiz_interp_and_extrap_tracer use MOM_spatial_means, only : global_i_mean use MOM_time_manager, only : time_type, init_external_field, get_external_field_size, time_interp_external_init use MOM_remapping, only : remapping_cs, remapping_core_h, initialize_remapping -use MOM_horizontal_regridding, only : horiz_interp_and_extrap_tracer +use MOM_verticalGrid, only : verticalGrid_type ! GMM - Planned extension: Support for time varying sponge targets. implicit none ; private @@ -666,10 +667,10 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr, zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0; hsrc(:) = 0.0; tmpT1d(:) = -99.9 do k=1,nz_data if (mask_z(CS%col_i(col),CS%col_j(col),k) == 1.0) then - zBottomOfCell = -min( z_edges_in(k+1), G%bathyT(CS%col_i(col),CS%col_j(col)) ) + zBottomOfCell = -min( z_edges_in(k+1), G%Zd_to_m*G%bathyT(CS%col_i(col),CS%col_j(col)) ) ! tmpT1d(k) = sp_val(CS%col_i(col),CS%col_j(col),k) elseif (k>1) then - zBottomOfCell = -G%bathyT(CS%col_i(col),CS%col_j(col)) + zBottomOfCell = -G%Zd_to_m*G%bathyT(CS%col_i(col),CS%col_j(col)) ! tmpT1d(k) = tmpT1d(k-1) ! else ! This next block should only ever be reached over land ! tmpT1d(k) = -99.9 @@ -679,7 +680,7 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr, zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo ! In case data is deeper than model - hsrc(nz_data) = hsrc(nz_data) + ( zTopOfCell + G%bathyT(CS%col_i(col),CS%col_j(col)) ) + hsrc(nz_data) = hsrc(nz_data) + ( zTopOfCell + G%Zd_to_m*G%bathyT(CS%col_i(col),CS%col_j(col)) ) CS%Ref_val(CS%fldno)%h(1:nz_data,col) = 0. CS%Ref_val(CS%fldno)%p(1:nz_data,col) = -1.e24 CS%Ref_val(CS%fldno)%h(1:nz_data,col) = hsrc(1:nz_data) @@ -736,7 +737,8 @@ end subroutine set_up_ALE_sponge_vel_field_fixed !> This subroutine stores the reference profile at uand v points for the variable !! whose address is given by u_ptr and v_ptr. -subroutine set_up_ALE_sponge_vel_field_varying(filename_u,fieldname_u,filename_v,fieldname_v, Time, G, CS, u_ptr, v_ptr) +subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename_v, fieldname_v, & + Time, G, CS, u_ptr, v_ptr) character(len=*), intent(in) :: filename_u !< File name for u field character(len=*), intent(in) :: fieldname_u !< Name of u variable in file character(len=*), intent(in) :: filename_v !< File name for v field diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 55834769aa..b05dfed2aa 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -255,8 +255,7 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide) ! tidal amplitude file is not present. real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height. real :: kappa_itides ! topographic wavenumber and non-dimensional scaling - real :: min_zbot_itides ! Minimum ocean depth for internal tide conversion, - ! in m. + real :: min_zbot_itides ! Minimum ocean depth for internal tide conversion, in m. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed if (associated(CS)) then @@ -334,12 +333,12 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide) do j=js,je ; do i=is,ie mask_itidal = 1.0 - if (G%bathyT(i,j) < min_zbot_itides) mask_itidal = 0.0 + if (G%bathyT(i,j) < min_zbot_itides*GV%m_to_Z) mask_itidal = 0.0 itide%tideamp(i,j) = itide%tideamp(i,j) * mask_itidal * G%mask2dT(i,j) ! Restrict rms topo to 10 percent of column depth. - itide%h2(i,j) = min(0.01*G%bathyT(i,j)**2, itide%h2(i,j)) + itide%h2(i,j) = min(0.01*(G%bathyT(i,j)*G%Zd_to_m)**2, itide%h2(i,j)) ! Compute the fixed part of internal tidal forcing; units are [J m-2] here. CS%TKE_itidal_coef(i,j) = 0.5*kappa_h2_factor*GV%Rho0*& diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 96ed14280c..8f9e325ddc 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -160,11 +160,11 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) real :: Rhtot ! Running sum of thicknesses times the ! layer potential densities in H kg m-3. real, dimension(SZIB_(G),SZJ_(G)) :: & - D_u, & ! Bottom depth interpolated to u points, in m. + D_u, & ! Bottom depth interpolated to u points, in depth units (m). mask_u ! A mask that disables any contributions from u points that ! are land or past open boundary conditions, nondim., 0 or 1. real, dimension(SZI_(G),SZJB_(G)) :: & - D_v, & ! Bottom depth interpolated to v points, in m. + D_v, & ! Bottom depth interpolated to v points, in depth units (m). mask_v ! A mask that disables any contributions from v points that ! are land or past open boundary conditions, nondim., 0 or 1. real, dimension(SZIB_(G),SZK_(G)) :: & @@ -696,7 +696,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (Dm > Dp) then ; tmp = Dp ; Dp = Dm ; Dm = tmp ; endif ! Convert the D's to the units of thickness. - Dp = m_to_H*Dp ; Dm = m_to_H*Dm ; D_vel = m_to_H*D_vel + Dp = GV%Z_to_H*Dp ; Dm = GV%Z_to_H*Dm ; D_vel = GV%Z_to_H*D_vel a_3 = (Dp + Dm - 2.0*D_vel) ; a = 3.0*a_3 ; a_12 = 0.25*a_3 slope = Dp - Dm diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index ce7471f9e1..77a2d109d6 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -334,25 +334,12 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) ! layer buoyancy, and a variety of tracers for every column where ! there is damping. -! Arguments: h - Layer thickness, in m. -! (in) dt - The amount of time covered by this call, in s. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (out) ea - an array to which the amount of fluid entrained -! from the layer above during this call will be -! added, in H. -! (out) eb - an array to which the amount of fluid entrained -! from the layer below during this call will be -! added, in H. -! (in) CS - A pointer to the control structure for this module that is -! set by a previous call to initialize_sponge. -! (inout,opt) Rcv_ml - The coordinate density of the mixed layer. - + ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & w_int, & ! Water moved upward across an interface within a timestep, ! in H. e_D ! Interface heights that are dilated to have a value of 0 - ! at the surface, in m. + ! at the surface, in the same units as G%bathyT (m or Z). real, dimension(SZI_(G), SZJ_(G)) :: & eta_anom, & ! Anomalies in the interface height, relative to the i-mean ! target value, in m. @@ -407,7 +394,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) do j=js,je ; do i=is,ie ; e_D(i,j,nz+1) = -G%bathyT(i,j) ; enddo ; enddo do k=nz,1,-1 ; do j=js,je ; do i=is,ie - e_D(i,j,K) = e_D(i,j,K+1) + h(i,j,k)*GV%H_to_m + e_D(i,j,K) = e_D(i,j,K+1) + h(i,j,k)*GV%H_to_Z enddo ; enddo ; enddo do j=js,je do i=is,ie @@ -420,8 +407,8 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) do k=2,nz do j=js,je ; do i=is,ie - eta_anom(i,j) = e_D(i,j,k) - CS%Ref_eta_im(j,k) - if (CS%Ref_eta_im(j,K) < -G%bathyT(i,j)) eta_anom(i,j) = 0.0 + eta_anom(i,j) = e_D(i,j,k)*G%Zd_to_m - CS%Ref_eta_im(j,k) + if (CS%Ref_eta_im(j,K) < -G%bathyT(i,j)*G%Zd_to_m) eta_anom(i,j) = 0.0 enddo ; enddo call global_i_mean(eta_anom(:,:), eta_mean_anom(:,K), G) enddo diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 7c712e8010..cc6d73e3eb 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -205,7 +205,6 @@ module MOM_tidal_mixing !> Initializes internal tidal dissipation scheme for diapycnal mixing logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, CS) - type(time_type), intent(in) :: Time !< The current time. type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. @@ -452,11 +451,11 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, call MOM_read_data(filename, 'h2', CS%h2, G%domain, timelevel=1) do j=js,je ; do i=is,ie - if (G%bathyT(i,j) < CS%min_zbot_itides) CS%mask_itidal(i,j) = 0.0 + if (G%bathyT(i,j)*G%Zd_to_m < CS%min_zbot_itides) CS%mask_itidal(i,j) = 0.0 CS%tideamp(i,j) = CS%tideamp(i,j) * CS%mask_itidal(i,j) * G%mask2dT(i,j) ! Restrict rms topo to 10 percent of column depth. - zbot = G%bathyT(i,j) + zbot = G%bathyT(i,j)*G%Zd_to_m hamp = sqrt(CS%h2(i,j)) hamp = min(0.1*zbot,hamp) CS%h2(i,j) = hamp*hamp @@ -1500,10 +1499,10 @@ end subroutine post_tidal_diagnostics ! TODO: move this subroutine to MOM_internal_tide_input module (?) !> This subroutine read tidal energy inputs from a file. subroutine read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - character(len=20), intent(in) :: tidal_energy_type !< The type of tidal energy inputs to read - character(len=200), intent(in) :: tidal_energy_file !< The file from which to read tidalinputs - type(tidal_mixing_cs), pointer :: CS !< The control structure for this module + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + character(len=20), intent(in) :: tidal_energy_type !< The type of tidal energy inputs to read + character(len=200), intent(in) :: tidal_energy_file !< The file from which to read tidalinputs + type(tidal_mixing_cs), pointer :: CS !< The control structure for this module ! local integer :: isd, ied, jsd, jed, nz real, allocatable, dimension(:,:) :: tidal_energy_flux_2d ! input tidal energy flux at T-grid points (W/m^2) @@ -1571,6 +1570,7 @@ subroutine read_tidal_constituents(G, tidal_energy_file, CS) call MOM_read_data(tidal_energy_file, 'z_t', z_t) call MOM_read_data(tidal_energy_file, 'z_w', z_w) + !### THE USE OF WHERE STTAEMENTS IS STRONGLY DISCOURAGED IN MOM6! where (abs(G%geoLatT(:,:)) < 30.0) tidal_qk1(:,:) = p33 tidal_qo1(:,:) = p33 @@ -1584,7 +1584,8 @@ subroutine read_tidal_constituents(G, tidal_energy_file, CS) ! input cell thickness CS%h_src(k) = (z_t(k)-z_w(k))*2.0 *1e-2 ! form tidal_qe_3d_in from weighted tidal constituents - where ( (z_t(k)*1e-2) <= G%bathyT(:,:) .and. (z_w(k)*1e-2) > CS%tidal_diss_lim_tc) + !### THE USE OF WHERE STATEMENTS IS STRONGLY DISCOURAGED IN MOM6! + where (((z_t(k)*1e-2) <= G%bathyT(:,:)*G%Zd_to_m) .and. (z_w(k)*1e-2 > CS%tidal_diss_lim_tc)) CS%tidal_qe_3d_in(:,:,k) = p33*tc_m2(:,:,k) + p33*tc_s2(:,:,k) + & tidal_qk1*tc_k1(:,:,k) + tidal_qo1*tc_o1(:,:,k) endwhere @@ -1598,7 +1599,7 @@ subroutine read_tidal_constituents(G, tidal_energy_file, CS) ! do k=50,nz_in(1) ! write(1905,*) i,j,k ! write(1905,*) CS%tidal_qe_3d_in(i,j,k), tc_m2(i,j,k) - ! write(1905,*) z_t(k), G%bathyT(i,j), z_w(k),CS%tidal_diss_lim_tc + ! write(1905,*) z_t(k), G%bathyT(i,j)*G%Zd_to_m, z_w(k),CS%tidal_diss_lim_tc ! end do ! endif ! enddo @@ -1607,13 +1608,13 @@ subroutine read_tidal_constituents(G, tidal_energy_file, CS) ! test if qE is positive if (any(CS%tidal_qe_3d_in<0.0)) then - call MOM_error(FATAL, "read_tidal_constituents: Negative tidal_qe_3d_in terms.") + call MOM_error(FATAL, "read_tidal_constituents: Negative tidal_qe_3d_in terms.") endif !! collapse 3D q*E to 2D q*E !CS%tidal_qe_2d = 0.0 !do k=1,nz_in(1) - ! where (z_t(k) <= G%bathyT(:,:)) + ! where (z_t(k) <= G%bathyT(:,:)*G%Zd_to_m) ! CS%tidal_qe_2d(:,:) = CS%tidal_qe_2d(:,:) + CS%tidal_qe_3d_in(:,:,k) ! endwhere !enddo diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 69d7f4b7e2..cb8f784615 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -691,7 +691,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) h_delta(I,k) = h(i+1,j,k) - h(i,j,k) endif ; enddo ; enddo do I=Isq,Ieq - Dmin(I) = min(G%bathyT(i,j), G%bathyT(i+1,j)) * m_to_H + Dmin(I) = min(G%bathyT(i,j), G%bathyT(i+1,j)) * G%Zd_to_m*GV%m_to_H zi_dir(I) = 0 enddo @@ -700,11 +700,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) do I=Isq,Ieq ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then do k=1,nz ; h_harm(I,k) = h(i,j,k) ; h_arith(I,k) = h(i,j,k) ; h_delta(I,k) = 0. ; enddo - Dmin(I) = G%bathyT(i,j) * m_to_H + Dmin(I) = G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H zi_dir(I) = -1 elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then do k=1,nz ; h_harm(I,k) = h(i+1,j,k) ; h_arith(I,k) = h(i+1,j,k) ; h_delta(I,k) = 0. ; enddo - Dmin(I) = G%bathyT(i+1,j) * m_to_H + Dmin(I) = G%bathyT(i+1,j) * G%Zd_to_m*GV%m_to_H zi_dir(I) = 1 endif endif ; enddo @@ -727,7 +727,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) endif ; enddo ; enddo ! i & k loops else ! Not harmonic_visc do I=Isq,Ieq ; zh(I) = 0.0 ; z_i(I,nz+1) = 0.0 ; enddo - do i=Isq,Ieq+1 ; zcol(i) = -G%bathyT(i,j) * m_to_H ; enddo + do i=Isq,Ieq+1 ; zcol(i) = -G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H ; enddo do k=nz,1,-1 do i=Isq,Ieq+1 ; zcol(i) = zcol(i) + h(i,j,k) ; enddo do I=Isq,Ieq ; if (do_i(I)) then @@ -858,7 +858,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) h_delta(i,k) = h(i,j+1,k) - h(i,j,k) endif ; enddo ; enddo do i=is,ie - Dmin(i) = min(G%bathyT(i,j), G%bathyT(i,j+1)) * m_to_H + Dmin(i) = min(G%bathyT(i,j), G%bathyT(i,j+1)) * G%Zd_to_m*GV%m_to_H zi_dir(i) = 0 enddo @@ -867,11 +867,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then do k=1,nz ; h_harm(I,k) = h(i,j,k) ; h_arith(I,k) = h(i,j,k) ; h_delta(i,k) = 0. ; enddo - Dmin(I) = G%bathyT(i,j) * m_to_H + Dmin(I) = G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H zi_dir(I) = -1 elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then do k=1,nz ; h_harm(i,k) = h(i,j+1,k) ; h_arith(i,k) = h(i,j+1,k) ; h_delta(i,k) = 0. ; enddo - Dmin(i) = G%bathyT(i,j+1) * m_to_H + Dmin(i) = G%bathyT(i,j+1) * G%Zd_to_m*GV%m_to_H zi_dir(i) = 1 endif endif ; enddo @@ -896,8 +896,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) else ! Not harmonic_visc do i=is,ie zh(i) = 0.0 ; z_i(i,nz+1) = 0.0 - zcol1(i) = -G%bathyT(i,j) * m_to_H - zcol2(i) = -G%bathyT(i,j+1) * m_to_H + zcol1(i) = -G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H + zcol2(i) = -G%bathyT(i,j+1) * G%Zd_to_m*GV%m_to_H enddo do k=nz,1,-1 ; do i=is,ie ; if (do_i(i)) then zh(i) = zh(i) + h_harm(i,k) diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 749962b17f..0a59eb1c92 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -213,7 +213,7 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, h, diag, OBC, CS, & if (NTR > 7) then do j=js,je ; do i=is,ie - e(nz+1) = -G%bathyT(i,j) + e(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 e(K) = e(K+1) + h(i,j,k)*GV%H_to_m do m=7,NTR diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index 0f7c5c1224..88b1ba37ce 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -128,8 +128,8 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val) do i=is,ie ; if (G%mask2dT(i,j)*htot(i) > 0.0) then ! Determine the z* heights of the model interfaces. - dilate = (G%bathyT(i,j) - 0.0) / htot(i) - e(nz+1) = -G%bathyT(i,j) + dilate = (G%Zd_to_m*G%bathyT(i,j) - 0.0) / htot(i) + e(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 ; e(K) = e(K+1) + dilate * h(i,j,k) ; enddo ! Create a single-column copy of tr_in. ### CHANGE THIS LATER? @@ -203,8 +203,8 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val) do i=is,ie ; if (G%mask2dT(i,j)*htot(i) > 0.0) then ! Determine the z* heights of the model interfaces. - dilate = (G%bathyT(i,j) - 0.0) / htot(i) - e(nz+1) = -G%bathyT(i,j) + dilate = (G%Zd_to_m*G%bathyT(i,j) - 0.0) / htot(i) + e(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 ; e(K) = e(K+1) + dilate * h(i,j,k) ; enddo ! Create a single-column copy of tr_in. ### CHANGE THIS LATER? diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 0e1b9a06b9..489fba76fa 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -222,7 +222,7 @@ subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_C CS%dye_source_minlat(m)=G%geoLatT(i,j) .and. & G%mask2dT(i,j) > 0.0 ) then - z_bot = -G%bathyT(i,j) + z_bot = -G%Zd_to_m*G%bathyT(i,j) do k = GV%ke, 1, -1 z_center = z_bot + 0.5*h(i,j,k)*GV%H_to_m if ( z_center > -CS%dye_source_maxdepth(m) .and. & @@ -305,7 +305,7 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS CS%dye_source_minlat(m)=G%geoLatT(i,j) .and. & G%mask2dT(i,j) > 0.0 ) then - z_bot = -G%bathyT(i,j) + z_bot = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 z_center = z_bot + 0.5*h_new(i,j,k)*GV%H_to_m if ( z_center > -CS%dye_source_maxdepth(m) .and. & diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 605d4706ca..b76aeb0c5b 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -146,7 +146,7 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, ! endif eta(i,j,nz+1) = -G%max_depth - if (G%bathyT(i,j) > min_depth) then + if (G%Zd_to_m*G%bathyT(i,j) > min_depth) then Idamp(i,j) = damp/86400.0 else ; Idamp(i,j) = 0.0 ; endif enddo ; enddo diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 1c5c1e5b7f..cb49286887 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -143,7 +143,7 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params case ( REGRIDDING_LAYER, REGRIDDING_RHO ) do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then @@ -165,7 +165,7 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params ! case ( IC_RHO_C ) ! ! do j=js,je ; do i=is,ie - ! eta1D(nz+1) = -1.0*G%bathyT(i,j) + ! eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) ! do k=nz,1,-1 ! eta1D(k) = e0(k) ! if (eta1D(k) < (eta1D(k+1) + min_thickness)) then @@ -187,7 +187,7 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params case ( REGRIDDING_ZSTAR ) do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -GV%Z_to_H*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then @@ -201,8 +201,7 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params case ( REGRIDDING_SIGMA ) do j=js,je ; do i=is,ie - delta_h = G%bathyT(i,j) / nz - h(i,j,:) = GV%m_to_H * delta_h + h(i,j,:) = GV%Z_to_H*G%bathyT(i,j) / nz enddo ; enddo case default @@ -359,7 +358,7 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) real :: T(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for temp real :: S(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for salt real :: RHO(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for RHO - real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness + real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness, in m. real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for thickness real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. real :: S_ref, T_ref ! Reference salinity and temerature within surface layer @@ -444,7 +443,7 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) enddo e0(nz+1) = -G%max_depth do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then @@ -461,7 +460,7 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) ! Construct temperature and salinity on the arbitrary grid T(:,:,:) = 0.0 ; S(:,:,:) = 0.0 do j=js,je ; do i=is,ie - z = -G%bathyT(i,j) + z = -G%Zd_to_m*G%bathyT(i,j) do k = nz,1,-1 z = z + 0.5 * h(i,j,k) ! Position of the center of layer k S(i,j,k) = 34.0 - 1.0 * (z/G%max_depth) @@ -482,7 +481,7 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) ! Construct thicknesses to restore to do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then @@ -495,11 +494,11 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - h(i,j,1:nz-1) = GV%Angstrom_H - h(i,j,nz) = dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_H + h(i,j,1:nz-1) = GV%Angstrom_m + h(i,j,nz) = dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_m endif - eta(i,j,nz+1) = -G%bathyT(i,j) + eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) do K=nz,1,-1 eta(i,j,K) = eta(i,j,K+1) + h(i,j,k) enddo diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 03274c0d8c..661b6a9978 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -113,7 +113,7 @@ subroutine DOME_initialize_thickness(h, G, GV, param_file, just_read_params) ! Angstrom thick, and 2. the interfaces are where they should be ! ! based on the resting depths and interface height perturbations, ! ! as long at this doesn't interfere with 1. ! - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then @@ -190,16 +190,16 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) ! depth space for Boussinesq or non-Boussinesq models. eta(i,j,1) = 0.0 do k=2,nz -! eta(i,j,K)=max(H0(k), -G%bathyT(i,j), GV%Angstrom_m*(nz-k+1)-G%bathyT(i,j)) - e_dense = -G%bathyT(i,j) +! eta(i,j,K)=max(H0(k), -G%Zd_to_m*G%bathyT(i,j), GV%Angstrom_m*(nz-k+1)-G%bathyT(i,j)) + e_dense = -G%Zd_to_m*G%bathyT(i,j) if (e_dense >= H0(k)) then ; eta(i,j,K) = e_dense else ; eta(i,j,K) = H0(k) ; endif - if (eta(i,j,K) < GV%Angstrom_m*(nz-k+1)-G%bathyT(i,j)) & - eta(i,j,K) = GV%Angstrom_m*(nz-k+1)-G%bathyT(i,j) + if (eta(i,j,K) < GV%Angstrom_m*(nz-k+1) - G%Zd_to_m*G%bathyT(i,j)) & + eta(i,j,K) = GV%Angstrom_m*(nz-k+1) - G%Zd_to_m*G%bathyT(i,j) enddo - eta(i,j,nz+1) = -G%bathyT(i,j) + eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) - if (G%bathyT(i,j) > min_depth) then + if (G%Zd_to_m*G%bathyT(i,j) > min_depth) then Idamp(i,j) = damp/86400.0 else ; Idamp(i,j) = 0.0 ; endif enddo ; enddo diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index f65ba242b0..ad65384750 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -136,7 +136,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par ! positive upward, in m. ! integer :: i, j, k, is, ie, js, je, nz, tmp1 real :: x - real :: delta_h, rho_range + real :: rho_range real :: min_thickness, s_sur, s_bot, t_sur, t_bot, rho_sur, rho_bot logical :: just_read ! If true, just read parameters but set nothing. character(len=256) :: mesg ! The text of an error message @@ -192,7 +192,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par ! Calculate thicknesses do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then @@ -207,7 +207,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then @@ -222,8 +222,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - delta_h = G%bathyT(i,j) / dfloat(nz) - h(i,j,:) = GV%m_to_H * delta_h + h(i,j,:) = GV%m_to_H * G%Zd_to_m*G%bathyT(i,j) / dfloat(nz) enddo ; enddo case default @@ -249,7 +248,8 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, ! Local variables integer :: i, j, k, is, ie, js, je, nz, itt real :: x, ds, dt, rho_sur, rho_bot - real :: xi0, xi1, dxi, r, S_sur, T_sur, S_bot, T_bot, S_range, T_range + real :: xi0, xi1, dxi ! Heights in m., r + real :: S_sur, T_sur, S_bot, T_bot, S_range, T_range real :: z ! vertical position in z space character(len=256) :: mesg ! The text of an error message character(len=40) :: verticalCoordinate, density_profile @@ -298,7 +298,7 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, S_range = S_range / G%max_depth ! Convert S_range into dS/dz T_range = T_range / G%max_depth ! Convert T_range into dT/dz do j=js,je ; do i=is,ie - xi0 = -G%bathyT(i,j) + xi0 = -G%Zd_to_m * G%bathyT(i,j) do k = nz,1,-1 xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_m ! Depth in middle of layer S(i,j,k) = S_sur + S_range * xi0 @@ -339,13 +339,13 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, do j=js,je ; do i=is,ie xi0 = 0.0 do k = 1,nz - !T0(k) = T_Ref; S0(k) = S_Ref - xi1 = xi0 + 0.5 * h(i,j,k) * GV%H_to_m - S0(k) = S_sur + S_range * xi1 - T0(k) = T_sur + T_range * xi1 - xi0 = xi0 + h(i,j,k) * GV%H_to_m - ! write(mesg,*) 'S,T,xi0,xi1,k',S0(k),T0(k),xi0,xi1,k - ! call MOM_mesg(mesg,5) + !T0(k) = T_Ref; S0(k) = S_Ref + xi1 = xi0 + 0.5 * h(i,j,k) * GV%H_to_m + S0(k) = S_sur + S_range * xi1 + T0(k) = T_sur + T_range * xi1 + xi0 = xi0 + h(i,j,k) * GV%H_to_m + ! write(mesg,*) 'S,T,xi0,xi1,k',S0(k),T0(k),xi0,xi1,k + ! call MOM_mesg(mesg,5) enddo call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,1,eqn_of_state) @@ -439,7 +439,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta. ! positive upward, in m. - real :: min_depth, dummy1, z, delta_h + real :: min_depth, dummy1, z real :: damp, rho_dummy, min_thickness, rho_tmp, xi0 character(len=40) :: verticalCoordinate, filename, state_file character(len=40) :: temp_var, salt_var, eta_var, inputdir @@ -500,8 +500,8 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) endif ! convert to 1 / seconds - if (G%bathyT(i,j) > min_depth) then - Idamp(i,j) = damp/86400.0 + if (G%Zd_to_m * G%bathyT(i,j) > min_depth) then + Idamp(i,j) = damp/86400.0 else ; Idamp(i,j) = 0.0 ; endif @@ -536,7 +536,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) ! Calculate thicknesses do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then @@ -550,7 +550,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then @@ -564,8 +564,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates do j=js,je ; do i=is,ie - delta_h = G%bathyT(i,j) / dfloat(nz) - h(i,j,:) = delta_h + h(i,j,:) = G%Zd_to_m * (G%bathyT(i,j) / dfloat(nz)) enddo ; enddo case default @@ -580,7 +579,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) S_range = S_range / G%max_depth ! Convert S_range into dS/dz T_range = T_range / G%max_depth ! Convert T_range into dT/dz do j=js,je ; do i=is,ie - xi0 = -G%bathyT(i,j) + xi0 = -G%Zd_to_m * G%bathyT(i,j) do k = nz,1,-1 xi0 = xi0 + 0.5 * h(i,j,k) ! Depth in middle of layer S(i,j,k) = S_sur + S_range * xi0 diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 8cf56a42ac..92f25463aa 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -223,11 +223,11 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then - cff = sqrt(G%g_Earth * 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) + cff = sqrt(G%g_Earth * 0.5 * G%Zd_to_m * (G%bathyT(i+1,j) + G%bathyT(i,j))) val2 = fac * exp(- CS%F_0 * y / cff) segment%eta(I,j) = val2 * cos(CS%omega * time_sec) segment%normal_vel_bt(I,j) = val1 * cff * cosa / & - (0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) * val2 + (0.5 * G%Zd_to_m * (G%bathyT(i+1,j) + G%bathyT(i,j))) * val2 else ! Not rotated yet segment%eta(I,j) = 0.0 @@ -257,9 +257,13 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then do k=1,nz - segment%tangential_vel(I,J,k) = val1 * cff * sina / & - (0.25 * (G%bathyT(i+1,j) + G%bathyT(i,j) + & - G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) * val2 + segment%tangential_vel(I,J,k) = val1 * cff * sina / & + (0.25 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j) + & + G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) * val2 +!### This should be: +! segment%tangential_vel(I,J,k) = val1 * cff * sina / & +! ( 0.25*G%Zd_to_m*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) +& +! (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) * val2 enddo endif enddo ; enddo @@ -273,11 +277,11 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then - cff = sqrt(G%g_Earth * 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j))) + cff = sqrt(G%g_Earth * 0.5 * G%Zd_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j))) val2 = fac * exp(- 0.5 * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * y / cff) segment%eta(I,j) = val2 * cos(CS%omega * time_sec) - segment%normal_vel_bt(I,j) = val1 * cff * sina / & - (0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) * val2 + segment%normal_vel_bt(I,j) = val1 * cff * sina / & + (0.5 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j))) * val2 else ! Not rotated yet segment%eta(i,J) = 0.0 @@ -305,9 +309,13 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then do k=1,nz - segment%tangential_vel(I,J,k) = val1 * cff * sina / & - (0.25 * (G%bathyT(i+1,j) + G%bathyT(i,j) + & - G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) * val2 + segment%tangential_vel(I,J,k) = val1 * cff * sina / & + (0.25 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j) + & + G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) * val2 +!### This should be: +! segment%tangential_vel(I,J,k) = val1 * cff * sina / & +! ( 0.25*G%Zd_to_m*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) +& +! (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) * val2 enddo endif enddo ; enddo diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index 40c0f81ff4..11271543b9 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -135,7 +135,7 @@ subroutine Neverland_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ enddo do j=js,je ; do i=is,ie - e_interface = -G%bathyT(i,j) + e_interface = -G%Zd_to_m * G%bathyT(i,j) do k=nz,1,-1 h(i,j,k) = max( GV%Angstrom_H, GV%m_to_H * (e0(k) - e_interface) ) e_interface = max( e0(k), e_interface - GV%H_to_m * h(i,j,k) ) diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 6d2aa72e90..ebd20c7f7d 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -95,7 +95,7 @@ subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) ! Angstrom thick, and 2. the interfaces are where they should be ! ! based on the resting depths and interface height perturbations, ! ! as long at this doesn't interfere with 1. ! - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = eta_im(j,K) if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index cd65def7d7..6049aa971a 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -241,7 +241,7 @@ subroutine adjustment_initialize_temperature_salinity ( T, S, h, G, GV, param_fi case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA ) dSdz = -delta_S_strat/G%max_depth do j=js,je ; do i=is,ie - eta1d(nz+1) = -G%bathyT(i,j) + eta1d(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 eta1d(k) = eta1d(k+1) + h(i,j,k)*GV%H_to_m enddo diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index 708c412c65..381828e49c 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -97,7 +97,7 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, param_file, PI = 4.*atan(1.) do j = G%jsc,G%jec ; do i = G%isc,G%iec - zi = -G%bathyT(i,j) + zi = -G%Zd_to_m*G%bathyT(i,j) x = G%geoLonT(i,j) - (G%west_lon + 0.5*G%len_lon) ! Relative to center of domain xd = x / G%len_lon ! -1/2 < xd 1/2 y = G%geoLatT(i,j) - (G%south_lat + 0.5*G%len_lat) ! Relative to center of domain diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index 8823f211c0..04e8cd014b 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -161,7 +161,7 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & ! Gv%Angstrom_m thick, and 2. the interfaces are where they should be ! ! based on the resting depths and interface height perturbations, ! ! as long at this doesn't interfere with 1. ! - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,2,-1 T_int = 0.5*(T0(k) + T0(k-1)) diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index 5c8d67d937..1d6611035e 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -70,7 +70,7 @@ subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_para ! Uniform thicknesses for base state do j=js,je ; do i=is,ie ! - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index 59f11dd98d..913bb108c9 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -225,7 +225,7 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A do j = G%jsc,G%jec do i = G%isc,G%iec - eta1D(nz+1) = -G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k = nz,1,-1 eta1D(k) = e0(k) diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index d0109a8b6c..7acf5c09af 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -139,7 +139,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom enddo do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then @@ -154,7 +154,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param case ( REGRIDDING_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then @@ -169,8 +169,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - delta_h = G%bathyT(i,j) / dfloat(nz) - h(i,j,:) = delta_h + h(i,j,:) = G%Zd_to_m * G%bathyT(i,j) / dfloat(nz) enddo ; enddo end select @@ -305,7 +304,7 @@ subroutine dumbbell_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp if (use_ALE) then ! construct a uniform grid for the sponge do j=G%jsc,G%jec ; do i=G%isc,G%iec - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 3243c94d0f..0e32bb1e7e 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -142,7 +142,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom enddo do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then @@ -157,7 +157,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param case ( REGRIDDING_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - eta1D(nz+1) = -1.0*G%bathyT(i,j) + eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then @@ -172,8 +172,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - delta_h = G%bathyT(i,j) / dfloat(nz) - h(i,j,:) = GV%m_to_H * delta_h + h(i,j,:) = G%Zd_to_m * GV%m_to_H * (G%bathyT(i,j) / dfloat(nz)) enddo ; enddo end select diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index f70bbc1619..c204d049bc 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -39,13 +39,9 @@ subroutine sloshing_initialize_topography ( D, G, param_file, max_depth ) ! Local variables integer :: i, j - do i=G%isc,G%iec - do j=G%jsc,G%jec - - D(i,j) = max_depth - - enddo - enddo + do i=G%isc,G%iec ; do j=G%jsc,G%jec + D(i,j) = max_depth + enddo ; enddo end subroutine sloshing_initialize_topography @@ -69,11 +65,11 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param !! only read parameters without changing h. real :: displ(SZK_(G)+1) - real :: z_unif(SZK_(G)+1) - real :: z_inter(SZK_(G)+1) + real :: z_unif(SZK_(G)+1) ! Fractional uniform interface heights, nondim. + real :: z_inter(SZK_(G)+1) ! Interface heights, in depth units. real :: x real :: a0 - real :: deltah + real :: m_to_Z ! A conversion factor from m to depth units. real :: total_height real :: weight_z real :: x1, y1, x2, y2 @@ -86,10 +82,9 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (just_read) return ! This subroutine has no run-time parameters. - deltah = G%max_depth / nz + m_to_Z = 1.0 / G%Zd_to_m ! Define thicknesses do j=G%jsc,G%jec ; do i=G%isc,G%iec @@ -121,18 +116,19 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param t = - z_unif(k) - z_inter(k) = -t * G%max_depth + z_inter(k) = -t * (G%max_depth * GV%m_to_Z) enddo ! 2. Define displacement - a0 = 75.0; ! Displacement amplitude (meters) + a0 = 75.0 * m_to_Z ! 75m Displacement amplitude in depth units. do k = 1,nz+1 - weight_z = - 4.0 * ( z_unif(k) + 0.5 )**2 + 1 + weight_z = - 4.0 * ( z_unif(k) + 0.5 )**2 + 1.0 x = G%geoLonT(i,j) / G%len_lon - displ(k) = a0 * cos(acos(-1.0)*x) + weight_z + !### Perhaps the '+ weight_z' here should be '* weight_z' - RWH + displ(k) = a0 * cos(acos(-1.0)*x) + weight_z * m_to_Z if ( k == 1 ) then displ(k) = 0.0 @@ -149,12 +145,11 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param ! 3. The last interface must coincide with the seabed z_inter(nz+1) = -G%bathyT(i,j) - ! Modify interface heights to make sure all thicknesses - ! are strictly positive + ! Modify interface heights to make sure all thicknesses are strictly positive do k = nz,1,-1 - if ( z_inter(k) < (z_inter(k+1) + GV%Angstrom_m) ) then - z_inter(k) = z_inter(k+1) + GV%Angstrom_m + if ( z_inter(k) < (z_inter(k+1) + GV%Angstrom_Z) ) then + z_inter(k) = z_inter(k+1) + GV%Angstrom_Z endif enddo @@ -162,7 +157,7 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param ! 4. Define layers total_height = 0.0 do k = 1,nz - h(i,j,k) = GV%m_to_H * (z_inter(k) - z_inter(k+1)) + h(i,j,k) = G%Zd_to_m*GV%m_to_H * (z_inter(k) - z_inter(k+1)) total_height = total_height + h(i,j,k) enddo @@ -255,6 +250,5 @@ end subroutine sloshing_initialize_temperature_salinity !> \namespace sloshing_initialization !! -!! The module configures the model for the non-rotating sloshing -!! test case. +!! The module configures the model for the non-rotating sloshing test case. end module sloshing_initialization diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index e258b87bf1..4d463803f3 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -53,7 +53,7 @@ subroutine soliton_initialize_thickness(h, G, GV) y = G%geoLatT(i,j)-y0 val3 = exp(-val1*x) val4 = val2*((2.0*val3/(1.0+(val3*val3)))**2) - h(i,j,k) = GV%m_to_H * (0.25*val4 * (6.0*y*y+3.0) * exp(-0.5*y*y) + G%bathyT(i,j)) + h(i,j,k) = GV%m_to_H * (0.25*val4 * (6.0*y*y+3.0) * exp(-0.5*y*y) + G%Zd_to_m*G%bathyT(i,j)) enddo enddo ; enddo From 10487f4081d60d0239ab9daea56a32cab732c2cb Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 28 Aug 2018 17:58:53 -0400 Subject: [PATCH 0673/1072] Restructured code to avoid array syntax multiplies Mildly restructured the code in PressureForce_AFV_Bouss and write_static_fields to avoid doing array syntax multiplication. All answers are bitwise identical. --- src/core/MOM_PressureForce_analytic_FV.F90 | 16 ++++++++++------ src/core/MOM_PressureForce_blocked_AFV.F90 | 12 ++++++++---- src/diagnostics/MOM_diagnostics.F90 | 12 ++++++++---- 3 files changed, 26 insertions(+), 14 deletions(-) diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 9a50cd78e6..9bf98856d8 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -455,6 +455,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading, in m. + z_bathy, & ! The height of the bathymetry, in m. dM ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. real, dimension(SZI_(G)) :: & @@ -525,6 +526,10 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p G_Rho0 = GV%g_Earth/GV%Rho0 rho_ref = CS%Rho0 + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + z_bathy(i,j) = G%Zd_to_m*G%bathyT(i,j) + enddo ; enddo + if (CS%tides) then ! Determine the surface height anomaly for calculating self attraction ! and loading. This should really be based on bottom pressure anomalies, @@ -667,23 +672,22 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p if ( CS%Recon_Scheme == 1 ) then call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth, & - dz_neglect, G%Zd_to_m*G%bathyT(:,:), G%HI, G%HI, & + rho_ref, CS%Rho0, GV%g_Earth, & + dz_neglect, z_bathy, G%HI, G%HI, & tv%eqn_of_state, dpa, intz_dpa, intx_dpa, inty_dpa, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then call int_density_dz_generic_ppm( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), & tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth, & - G%HI, G%HI, tv%eqn_of_state, dpa, intz_dpa, & + G%HI, G%HI, tv%eqn_of_state, dpa, intz_dpa, & intx_dpa, inty_dpa) endif else - call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), & - e(:,:,K), e(:,:,K+1), & + call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth, G%HI, G%HI, tv%eqn_of_state, & dpa, intz_dpa, intx_dpa, inty_dpa, & - G%Zd_to_m*G%bathyT(:,:), dz_neglect, CS%useMassWghtInterp) + z_bathy, dz_neglect, CS%useMassWghtInterp) endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 318f4126f1..1d2d84e98c 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -438,6 +438,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading, in m. + z_bathy, & ! The height of the bathymetry, in m. dM ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. real, dimension(SZI_(G)) :: & @@ -510,6 +511,10 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at G_Rho0 = GV%g_Earth/GV%Rho0 rho_ref = CS%Rho0 + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + z_bathy(i,j) = G%Zd_to_m*G%bathyT(i,j) + enddo ; enddo + if (CS%tides) then ! Determine the surface height anomaly for calculating self attraction ! and loading. This should really be based on bottom pressure anomalies, @@ -666,7 +671,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth, & - dz_neglect, G%Zd_to_m*G%bathyT(:,:), G%HI, G%Block(n), & + dz_neglect, z_bathy, G%HI, G%Block(n), & tv%eqn_of_state, dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then @@ -677,11 +682,10 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at intx_dpa_bk, inty_dpa_bk) endif else - call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), & - e(:,:,K), e(:,:,K+1), & + call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth, G%HI, G%Block(n), tv%eqn_of_state, & dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & - G%Zd_to_m*G%bathyT(:,:), dz_neglect, CS%useMassWghtInterp) + z_bathy, dz_neglect, CS%useMassWghtInterp) endif do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 intz_dpa_bk(ib,jb) = intz_dpa_bk(ib,jb)*GV%m_to_H diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 5e40fad81e..e5ffdbff02 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1822,6 +1822,8 @@ subroutine write_static_fields(G, GV, tv, diag) real :: tmp_h(SZI_(G),SZJ_(G)) integer :: id, i, j + tmp_h(:,:) = 0.0 + id = register_static_field('ocean_model', 'geolat', diag%axesT1, & 'Latitude of tracer (T) points', 'degrees_north') if (id > 0) call post_data(id, G%geoLatT, diag, .true.) @@ -1902,8 +1904,9 @@ subroutine write_static_fields(G, GV, tv, diag) if (G%Zd_to_m == 1.0) then call post_data(id, G%bathyT, diag, .true., mask=G%mask2dT) else - tmp_h(:,:) = 0. - tmp_h(G%isc:G%iec,G%jsc:G%jec) = G%bathyT(G%isc:G%iec,G%jsc:G%jec) / G%Zd_to_m + do j=G%jsc,G%jec ; do i=G%isc,G%iec + tmp_h(i,j) = G%bathyT(i,j) * G%Zd_to_m + enddo ; enddo call post_data(id, tmp_h, diag, .true., mask=G%mask2dT) endif endif @@ -1977,8 +1980,9 @@ subroutine write_static_fields(G, GV, tv, diag) cmor_long_name='Sea Area Fraction', & x_cell_method='mean', y_cell_method='mean', area_cell_method='mean') if (id > 0) then - tmp_h(:,:) = 0. - tmp_h(G%isc:G%iec,G%jsc:G%jec) = 100. * G%mask2dT(G%isc:G%iec,G%jsc:G%jec) + do j=G%jsc,G%jec ; do i=G%isc,G%iec + tmp_h(i,j) = 100. * G%mask2dT(i,j) + enddo ; enddo call post_data(id, tmp_h, diag, .true.) endif From b858a190de3b7d7e19a7a686f2ff5bdd3c38add4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 28 Aug 2018 18:00:50 -0400 Subject: [PATCH 0674/1072] Removed Zd_to_m from the barotropic_CS Removed Zd_to_m from the barotropic_CS. Also combined unit conversion factors to go directly from Z to H, and standardized the conversion factors to come from the verticalGrid_type. All answers are bitwise identical. --- src/core/MOM_barotropic.F90 | 71 ++++++++++++++++++------------------- 1 file changed, 35 insertions(+), 36 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 7e5045a087..15dee28aeb 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -131,7 +131,6 @@ module MOM_barotropic ua_polarity, & !< Test vector components for checking grid polarity. va_polarity, & !< Test vector components for checking grid polarity. bathyT !< A copy of bathyT (ocean bottom depth) with wide halos, in depth units - real :: Zd_to_m = 1.0 !< The conversion factor between the units of bathyT and m. real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: IareaT !< This is a copy of G%IareaT with wide halos, but will !! still utilize the macro IareaT when referenced, m-2. @@ -805,17 +804,17 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & ! ### bathyT here should be replaced with bathyT+eta(Bous) or eta(non-Bous). !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - DCor_u(I,j) = 0.5 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j)) + DCor_u(I,j) = 0.5 * GV%Z_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j)) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - DCor_v(i,J) = 0.5 * G%Zd_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j)) + DCor_v(i,J) = 0.5 * GV%Z_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j)) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do I=is-1,ie q(I,J) = 0.25 * G%CoriolisBu(I,J) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & - (G%Zd_to_m*((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & + (GV%Z_to_m*((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)))) enddo ; enddo @@ -1292,7 +1291,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & do j=js,je ; do I=is-1,ie ; if (CS%lin_drag_u(I,j) > 0.0) then Htot = 0.5 * (eta(i,j) + eta(i+1,j)) if (GV%Boussinesq) & - Htot = Htot + 0.5*CS%Zd_to_m*GV%m_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j)) + Htot = Htot + 0.5*GV%Z_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j)) bt_rem_u(I,j) = bt_rem_u(I,j) * (Htot / (Htot + CS%lin_drag_u(I,j) * dtbt)) Rayleigh_u(I,j) = CS%lin_drag_u(I,j) / Htot @@ -1301,7 +1300,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & do J=js-1,je ; do i=is,ie ; if (CS%lin_drag_v(i,J) > 0.0) then Htot = 0.5 * (eta(i,j) + eta(i,j+1)) if (GV%Boussinesq) & - Htot = Htot + 0.5*CS%Zd_to_m*GV%m_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j+1)) + Htot = Htot + 0.5*GV%Z_to_H * (CS%bathyT(i,j) + CS%bathyT(i+1,j+1)) bt_rem_v(i,J) = bt_rem_v(i,J) * (Htot / (Htot + CS%lin_drag_v(i,J) * dtbt)) Rayleigh_v(i,J) = CS%lin_drag_v(i,J) / Htot @@ -1354,7 +1353,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & ! Limit the sink (inward) correction to the amount of mass that is already ! inside the cell. Htot = eta(i,j) - if (GV%Boussinesq) Htot = CS%bathyT(i,j)*CS%Zd_to_m*GV%m_to_H + eta(i,j) + if (GV%Boussinesq) Htot = CS%bathyT(i,j)*GV%Z_to_H + eta(i,j) CS%eta_cor(i,j) = max(CS%eta_cor(i,j), -max(0.0,Htot)) endif @@ -2634,21 +2633,21 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co else ! This is assuming Flather as only other option if (GV%Boussinesq) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - BT_OBC%H_u(I,j) = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H + eta(i,j) + BT_OBC%H_u(I,j) = G%bathyT(i,j)*GV%Z_to_H + eta(i,j) elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - BT_OBC%H_u(I,j) = G%bathyT(i+1,j)*G%Zd_to_m*GV%m_to_H + eta(i+1,j) + BT_OBC%H_u(I,j) = G%bathyT(i+1,j)*GV%Z_to_H + eta(i+1,j) endif else if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then BT_OBC%H_u(i,j) = eta(i,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%Zd_to_m*G%bathyT(i,j) + eta(i,j))) + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (GV%Z_to_m*G%bathyT(i,j) + eta(i,j))) !### * GV%H_to_m? elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then BT_OBC%H_u(i,j) = eta(i+1,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%Zd_to_m*G%bathyT(i+1,j) + eta(i+1,j))) + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (GV%Z_to_m*G%bathyT(i+1,j) + eta(i+1,j))) !### * GV%H_to_m? endif endif if (GV%Boussinesq) then - BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1) * BT_OBC%H_u(i,j)) + BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1) * BT_OBC%H_u(i,j)) !### * GV%H_to_m? endif endif endif ; enddo ; enddo @@ -2690,21 +2689,21 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co else ! This is assuming Flather as only other option if (GV%Boussinesq) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - BT_OBC%H_v(i,J) = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H + eta(i,j) + BT_OBC%H_v(i,J) = G%bathyT(i,j)*GV%Z_to_H + eta(i,j) elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then - BT_OBC%H_v(i,J) = G%bathyT(i,j+1)*G%Zd_to_m*GV%m_to_H + eta(i,j+1) + BT_OBC%H_v(i,J) = G%bathyT(i,j+1)*GV%Z_to_H + eta(i,j+1) endif else if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then BT_OBC%H_v(i,J) = eta(i,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%Zd_to_m*G%bathyT(i,j) + eta(i,j))) + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (GV%Z_to_m*G%bathyT(i,j) + eta(i,j))) !### * GV%H_to_m? elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then BT_OBC%H_v(i,J) = eta(i,j+1) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%Zd_to_m*G%bathyT(i,j+1) + eta(i,j+1))) + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (GV%Z_to_m*G%bathyT(i,j+1) + eta(i,j+1))) !### * GV%H_to_m? endif endif if (GV%Boussinesq) then - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * BT_OBC%H_v(i,J)) + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * BT_OBC%H_v(i,J)) !### * GV%H_to_m? endif endif endif ; enddo ; enddo @@ -2858,8 +2857,8 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) enddo ; enddo elseif (CS%hvel_scheme == HYBRID .or. use_default) then do I=is-1,ie - e_u(I,nz+1) = -0.5 * G%Zd_to_m*GV%m_to_H * (G%bathyT(i+1,j) + G%bathyT(i,j)) - D_shallow_u(I) = -G%Zd_to_m*GV%m_to_H * min(G%bathyT(i+1,j), G%bathyT(i,j)) + e_u(I,nz+1) = -0.5 * GV%Z_to_H * (G%bathyT(i+1,j) + G%bathyT(i,j)) + D_shallow_u(I) = -GV%Z_to_H * min(G%bathyT(i+1,j), G%bathyT(i,j)) hatutot(I) = 0.0 enddo do k=nz,1,-1 ; do I=is-1,ie @@ -2921,8 +2920,8 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) enddo ; enddo elseif (CS%hvel_scheme == HYBRID .or. use_default) then do i=is,ie - e_v(i,nz+1) = -0.5 * G%Zd_to_m*GV%m_to_H * (G%bathyT(i,j+1) + G%bathyT(i,j)) - D_shallow_v(I) = -G%Zd_to_m*GV%m_to_H * min(G%bathyT(i,j+1), G%bathyT(i,j)) + e_v(i,nz+1) = -0.5 * GV%Z_to_H * (G%bathyT(i,j+1) + G%bathyT(i,j)) + D_shallow_v(I) = -GV%Z_to_H * min(G%bathyT(i,j+1), G%bathyT(i,j)) hatvtot(I) = 0.0 enddo do k=nz,1,-1 ; do i=is,ie @@ -3558,14 +3557,14 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) if (GV%Boussinesq) then !$OMP do do j=js-hs,je+hs ; do I=is-1-hs,ie+hs - H1 = CS%bathyT(i,j)*CS%Zd_to_m*GV%m_to_H + eta(i,j) ; H2 = CS%bathyT(i+1,j)*CS%Zd_to_m*GV%m_to_H + eta(i+1,j) + H1 = CS%bathyT(i,j)*GV%Z_to_H + eta(i,j) ; H2 = CS%bathyT(i+1,j)*GV%Z_to_H + eta(i+1,j) Datu(I,j) = 0.0 ; if ((H1 > 0.0) .and. (H2 > 0.0)) & Datu(I,j) = CS%dy_Cu(I,j) * (2.0 * H1 * H2) / (H1 + H2) ! Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (H1 + H2) enddo ; enddo !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs - H1 = CS%bathyT(i,j)*CS%Zd_to_m*GV%m_to_H + eta(i,j) ; H2 = CS%bathyT(i,j+1)*CS%Zd_to_m*GV%m_to_H + eta(i,j+1) + H1 = CS%bathyT(i,j)*GV%Z_to_H + eta(i,j) ; H2 = CS%bathyT(i,j+1)*GV%Z_to_H + eta(i,j+1) Datv(i,J) = 0.0 ; if ((H1 > 0.0) .and. (H2 > 0.0)) & Datv(i,J) = CS%dx_Cv(i,J) * (2.0 * H1 * H2) / (H1 + H2) ! Datv(i,J) = CS%dy_v(i,J) * 0.5 * (H1 + H2) @@ -3590,12 +3589,12 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) !$OMP do do j=js-hs,je+hs ; do I=is-1-hs,ie+hs Datu(I,j) = CS%dy_Cu(I,j) * GV%m_to_H * & - (CS%Zd_to_m*max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + add_max) + (GV%Z_to_m*max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + add_max) enddo ; enddo !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs Datv(i,J) = CS%dx_Cv(i,J) * GV%m_to_H * & - (CS%Zd_to_m*max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + add_max) + (GV%Z_to_m*max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + add_max) enddo ; enddo else !$OMP do @@ -3603,7 +3602,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) Datu(I, j) = 0.0 !Would be "if (G%mask2dCu(I,j)>0.) &" is G was valid on BT domain if (CS%bathyT(i+1,j)+CS%bathyT(i,j)>0.) & - Datu(I,j) = 2.0*CS%dy_Cu(I,j) * CS%Zd_to_m*GV%m_to_H * & + Datu(I,j) = 2.0*CS%dy_Cu(I,j) * GV%Z_to_H * & (CS%bathyT(i+1,j) * CS%bathyT(i,j)) / & (CS%bathyT(i+1,j) + CS%bathyT(i,j)) enddo ; enddo @@ -3612,7 +3611,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) Datv(i, J) = 0.0 !Would be "if (G%mask2dCv(i,J)>0.) &" is G was valid on BT domain if (CS%bathyT(i,j+1)+CS%bathyT(i,j)>0.) & - Datv(i,J) = 2.0*CS%dx_Cv(i,J) * CS%Zd_to_m*GV%m_to_H * & + Datv(i,J) = 2.0*CS%dx_Cv(i,J) * GV%Z_to_H * & (CS%bathyT(i,j+1) * CS%bathyT(i,j)) / & (CS%bathyT(i,j+1) + CS%bathyT(i,j)) enddo ; enddo @@ -3659,7 +3658,7 @@ subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) do j=js,je do i=is,ie ; h_tot(i) = h(i,j,1) ; enddo if (GV%Boussinesq) then - do i=is,ie ; eta_h(i) = h(i,j,1) - G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H ; enddo + do i=is,ie ; eta_h(i) = h(i,j,1) - G%bathyT(i,j)*GV%Z_to_H ; enddo else do i=is,ie ; eta_h(i) = h(i,j,1) ; enddo endif @@ -4066,7 +4065,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & CS%IareaT(i,j) = G%IareaT(i,j) CS%bathyT(i,j) = G%bathyT(i,j) enddo ; enddo - CS%Zd_to_m = G%Zd_to_m + ! Note: G%IdxCu & G%IdyCv may be smaller than CS%IdxCu & CS%IdyCv, even without ! wide halos. do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB @@ -4089,16 +4088,16 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ALLOC_(CS%D_v_Cor(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) CS%q_D(:,:) = 0.0 ; CS%D_u_Cor(:,:) = 0.0 ; CS%D_v_Cor(:,:) = 0.0 do j=js,je ; do I=is-1,ie - CS%D_u_Cor(I,j) = 0.5 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j)) + CS%D_u_Cor(I,j) = 0.5 * GV%Z_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j)) enddo ; enddo do J=js-1,je ; do i=is,ie - CS%D_v_Cor(i,J) = 0.5 * G%Zd_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j)) + CS%D_v_Cor(i,J) = 0.5 * GV%Z_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j)) enddo ; enddo do J=js-1,je ; do I=is-1,ie if (G%mask2dT(i,j)+G%mask2dT(i,j+1)+G%mask2dT(i+1,j)+G%mask2dT(i+1,j+1)>0.) then CS%q_D(I,J) = 0.25 * G%CoriolisBu(I,J) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & - (G%Zd_to_m*((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & + (GV%Z_to_m*((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)))) else ! All four h points are masked out so q_D(I,J) will is meaningless CS%q_D(I,J) = 0. @@ -4296,24 +4295,24 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ! if (GV%Boussinesq) then do j=js,je ; do I=is-1,ie if (G%mask2dCu(I,j)>0.) then - CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j))) + CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (GV%Z_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j))) else ! Both neighboring H points are masked out so IDatu(I,j) is meaningless CS%IDatu(I,j) = 0. endif enddo ; enddo do J=js-1,je ; do i=is,ie if (G%mask2dCv(i,J)>0.) then - CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (G%Zd_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j))) + CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (GV%Z_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j))) else ! Both neighboring H points are masked out so IDatu(I,j) is meaningless CS%IDatv(i,J) = 0. endif enddo ; enddo ! else ! do j=js,je ; do I=is-1,ie -! CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (G%Zd_to_m*GV%Rho0*(G%bathyT(i+1,j) + G%bathyT(i,j))) +! CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (GV%Z_to_m*GV%Rho0*(G%bathyT(i+1,j) + G%bathyT(i,j))) ! enddo ; enddo ! do J=js-1,je ; do i=is,ie -! CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (G%Zd_to_m*GV%Rho0*(G%bathyT(i,j+1) + G%bathyT(i,j))) +! CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (GV%Z_to_m*GV%Rho0*(G%bathyT(i,j+1) + G%bathyT(i,j))) ! enddo ; enddo ! endif From 096d9a35298c329c0171be47b0d6c8839b247b91 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 28 Aug 2018 18:04:18 -0400 Subject: [PATCH 0675/1072] Combined unit conversion factors Combined unit conversion factors to go directly from Z to H, and standardized the conversion factors to come from the verticalGrid_type. Also use G%max_depth in place of GV%max_depth in several places. All answers are bitwise identical. --- src/ALE/MOM_regridding.F90 | 12 +++---- src/core/MOM.F90 | 4 +-- src/core/MOM_dynamics_split_RK2.F90 | 2 +- src/framework/MOM_diag_remap.F90 | 6 ++-- .../vertical/MOM_full_convection.F90 | 2 +- .../vertical/MOM_vert_friction.F90 | 27 +++++++------- src/user/ISOMIP_initialization.F90 | 6 ++-- src/user/dense_water_initialization.F90 | 8 ++--- src/user/seamount_initialization.F90 | 6 ++-- src/user/sloshing_initialization.F90 | 35 ++++++------------- 10 files changed, 47 insertions(+), 61 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 16dfb9140e..cfdbd45812 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -1147,7 +1147,7 @@ subroutine build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h) endif ! Local depth (G%bathyT is positive) - nominalDepth = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H + nominalDepth = G%bathyT(i,j)*GV%Z_to_H ! Determine water column thickness totalThickness = 0.0 @@ -1236,7 +1236,7 @@ subroutine build_sigma_grid( CS, G, GV, h, dzInterface ) endif ! The rest of the model defines grids integrating up from the bottom - nominalDepth = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H + nominalDepth = G%bathyT(i,j)*GV%Z_to_H ! Determine water column height totalThickness = 0.0 @@ -1340,7 +1340,7 @@ subroutine build_rho_grid( G, GV, h, tv, dzInterface, remapCS, CS ) ! Local depth (G%bathyT is positive) - nominalDepth = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H + nominalDepth = G%bathyT(i,j)*GV%Z_to_H call build_rho_column(CS%rho_CS, nz, nominalDepth, h(i, j, :), & tv%T(i, j, :), tv%S(i, j, :), tv%eqn_of_state, zNew, & @@ -1445,7 +1445,7 @@ subroutine build_grid_HyCOM1( G, GV, h, tv, h_new, dzInterface, CS ) do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 if (G%mask2dT(i,j)>0.) then - depth = G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H + depth = G%bathyT(i,j) * GV%Z_to_H z_col(1) = 0. ! Work downward rather than bottom up do K = 1, GV%ke @@ -1576,7 +1576,7 @@ subroutine build_grid_SLight(G, GV, h, tv, dzInterface, CS) do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 if (G%mask2dT(i,j)>0.) then - depth = G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H + depth = G%bathyT(i,j) * GV%Z_to_H z_col(1) = 0. ! Work downward rather than bottom up do K=1,nz z_col(K+1) = z_col(K) + h(i, j, k) ! Work in units of h (m or Pa) @@ -1704,7 +1704,7 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) do i = G%isc-1,G%iec+1 ! Local depth - local_depth = G%bathyT(i,j)*G%Zd_to_m*GV%m_to_H + local_depth = G%bathyT(i,j)*GV%Z_to_H ! Determine water column height total_height = 0.0 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index eb7d8925b6..0f2334a290 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2136,8 +2136,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call copy_dyngrid_to_MOM_grid(dG, G) call destroy_dyn_horgrid(dG) - ! This could be moved earlier, perhaps just after MOM_initialize_fixed. -! if (G%Zd_to_m /= GV%Z_to_m) call rescale_grid_bathymetry(G, GV%Z_to_m) + ! This could replace an earlier call to rescale_dyn_horgrid_bathymetry just after MOM_initialize_fixed. + ! if (G%Zd_to_m /= GV%Z_to_m) call rescale_grid_bathymetry(G, GV%Z_to_m) ! Set a few remaining fields that are specific to the ocean grid type. call set_first_direction(G, first_direction) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index df60234ca3..30db43cc0c 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -1110,7 +1110,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil ! dimensions as h, either m or kg m-3. ! CS%eta(:,:) = 0.0 already from initialization. if (GV%Boussinesq) then - do j=js,je ; do i=is,ie ; CS%eta(i,j) = -G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H ; enddo ; enddo + do j=js,je ; do i=is,ie ; CS%eta(i,j) = -GV%Z_to_H * G%bathyT(i,j) ; enddo ; enddo endif do k=1,nz ; do j=js,je ; do i=is,ie CS%eta(i,j) = CS%eta(i,j) + h(i,j,k) diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 7f311811e4..be3a02f777 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -269,14 +269,14 @@ subroutine diag_remap_update(remap_cs, G, GV, h, T, S, eqn_of_state) if (remap_cs%vertical_coord == coordinateMode('ZSTAR')) then call build_zstar_column(get_zlike_CS(remap_cs%regrid_cs), & - G%Zd_to_m*GV%m_to_H*G%bathyT(i,j), sum(h(i,j,:)), & + GV%Z_to_H*G%bathyT(i,j), sum(h(i,j,:)), & zInterfaces, zScale=GV%m_to_H) elseif (remap_cs%vertical_coord == coordinateMode('SIGMA')) then call build_sigma_column(get_sigma_CS(remap_cs%regrid_cs), & - G%Zd_to_m*GV%m_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) + GV%Z_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) elseif (remap_cs%vertical_coord == coordinateMode('RHO')) then call build_rho_column(get_rho_CS(remap_cs%regrid_cs), G%ke, & - G%Zd_to_m*G%bathyT(i,j), h(i,j,:), T(i, j, :), S(i, j, :), & + G%Zd_to_m*G%bathyT(i,j), h(i,j,:), T(i,j,:), S(i,j,:), & eqn_of_state, zInterfaces, h_neglect, h_neglect_edge) elseif (remap_cs%vertical_coord == coordinateMode('SLIGHT')) then ! call build_slight_column(remap_cs%regrid_cs,remap_cs%remap_cs, nz, & diff --git a/src/parameterizations/vertical/MOM_full_convection.F90 b/src/parameterizations/vertical/MOM_full_convection.F90 index 75e6cd8570..55ea1cabe9 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -99,7 +99,7 @@ subroutine full_convection(G, GV, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, & h_neglect = GV%H_subroundoff kap_dt_x2 = 0.0 if (present(Kddt_convect)) kap_dt_x2 = 2.0*Kddt_convect - mix_len = (1.0e20 * nz) * (GV%max_depth * GV%m_to_H) + mix_len = (1.0e20 * nz) * (G%max_depth * GV%m_to_H) h0 = 1.0e-16*sqrt(Kddt_smooth) + h_neglect do j=js,je diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index cb8f784615..a19ec5c215 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -614,10 +614,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) zh, & ! An estimate of the interface's distance from the bottom ! based on harmonic mean thicknesses, in m or kg m-2. h_ml ! The mixed layer depth, in m or kg m-2. - real, allocatable, dimension(:,:) :: hML_u, hML_v - real, allocatable, dimension(:,:,:) :: Kv_v, & !< Total vertical viscosity at u-points - Kv_u !< Total vertical viscosity at v-points - real :: zcol(SZI_(G)) ! The height of an interface at h-points, in m or kg m-2. + real, allocatable, dimension(:,:) :: hML_u ! Diagnostic of the mixed layer depth at u points, in m. + real, allocatable, dimension(:,:) :: hML_v ! Diagnostic of the mixed layer depth at v points, in m. + real, allocatable, dimension(:,:,:) :: Kv_u !< Total vertical viscosity at u-points, in m2 s-1. + real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points, in m2 s-1. + real :: zcol(SZI_(G)) ! The height of an interface at h-points, in H (m or kg m-2). real :: botfn ! A function which goes from 1 at the bottom to 0 much more ! than Hbbl into the interior. real :: topfn ! A function which goes from 1 at the top to 0 much more @@ -691,7 +692,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) h_delta(I,k) = h(i+1,j,k) - h(i,j,k) endif ; enddo ; enddo do I=Isq,Ieq - Dmin(I) = min(G%bathyT(i,j), G%bathyT(i+1,j)) * G%Zd_to_m*GV%m_to_H + Dmin(I) = min(G%bathyT(i,j), G%bathyT(i+1,j)) * GV%Z_to_H zi_dir(I) = 0 enddo @@ -700,11 +701,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) do I=Isq,Ieq ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then do k=1,nz ; h_harm(I,k) = h(i,j,k) ; h_arith(I,k) = h(i,j,k) ; h_delta(I,k) = 0. ; enddo - Dmin(I) = G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H + Dmin(I) = G%bathyT(i,j) * GV%Z_to_H zi_dir(I) = -1 elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then do k=1,nz ; h_harm(I,k) = h(i+1,j,k) ; h_arith(I,k) = h(i+1,j,k) ; h_delta(I,k) = 0. ; enddo - Dmin(I) = G%bathyT(i+1,j) * G%Zd_to_m*GV%m_to_H + Dmin(I) = G%bathyT(i+1,j) * GV%Z_to_H zi_dir(I) = 1 endif endif ; enddo @@ -727,7 +728,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) endif ; enddo ; enddo ! i & k loops else ! Not harmonic_visc do I=Isq,Ieq ; zh(I) = 0.0 ; z_i(I,nz+1) = 0.0 ; enddo - do i=Isq,Ieq+1 ; zcol(i) = -G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H ; enddo + do i=Isq,Ieq+1 ; zcol(i) = -G%bathyT(i,j) * GV%Z_to_H ; enddo do k=nz,1,-1 do i=Isq,Ieq+1 ; zcol(i) = zcol(i) + h(i,j,k) ; enddo do I=Isq,Ieq ; if (do_i(I)) then @@ -858,7 +859,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) h_delta(i,k) = h(i,j+1,k) - h(i,j,k) endif ; enddo ; enddo do i=is,ie - Dmin(i) = min(G%bathyT(i,j), G%bathyT(i,j+1)) * G%Zd_to_m*GV%m_to_H + Dmin(i) = min(G%bathyT(i,j), G%bathyT(i,j+1)) * GV%Z_to_H zi_dir(i) = 0 enddo @@ -867,11 +868,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then do k=1,nz ; h_harm(I,k) = h(i,j,k) ; h_arith(I,k) = h(i,j,k) ; h_delta(i,k) = 0. ; enddo - Dmin(I) = G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H + Dmin(I) = G%bathyT(i,j) * GV%Z_to_H zi_dir(I) = -1 elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then do k=1,nz ; h_harm(i,k) = h(i,j+1,k) ; h_arith(i,k) = h(i,j+1,k) ; h_delta(i,k) = 0. ; enddo - Dmin(i) = G%bathyT(i,j+1) * G%Zd_to_m*GV%m_to_H + Dmin(i) = G%bathyT(i,j+1) * GV%Z_to_H zi_dir(i) = 1 endif endif ; enddo @@ -896,8 +897,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) else ! Not harmonic_visc do i=is,ie zh(i) = 0.0 ; z_i(i,nz+1) = 0.0 - zcol1(i) = -G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H - zcol2(i) = -G%bathyT(i,j+1) * G%Zd_to_m*GV%m_to_H + zcol1(i) = -G%bathyT(i,j) * GV%Z_to_H + zcol2(i) = -G%bathyT(i,j+1) * GV%Z_to_H enddo do k=nz,1,-1 ; do i=is,ie ; if (do_i(i)) then zh(i) = zh(i) + h_harm(i,k) diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index ad65384750..8ddd12bed3 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -169,10 +169,10 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par if (just_read) return ! All run-time parameters have been read, so return. ! Compute min/max density using T_SUR/S_SUR and T_BOT/S_BOT - call calculate_density(t_sur,s_sur,0.0,rho_sur,tv%eqn_of_state) + call calculate_density(t_sur, s_sur, 0.0, rho_sur, tv%eqn_of_state) ! write(mesg,*) 'Surface density is:', rho_sur ! call MOM_mesg(mesg,5) - call calculate_density(t_bot,s_bot,0.0,rho_bot,tv%eqn_of_state) + call calculate_density(t_bot, s_bot, 0.0, rho_bot, tv%eqn_of_state) ! write(mesg,*) 'Bottom density is:', rho_bot ! call MOM_mesg(mesg,5) rho_range = rho_bot - rho_sur @@ -222,7 +222,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - h(i,j,:) = GV%m_to_H * G%Zd_to_m*G%bathyT(i,j) / dfloat(nz) + h(i,j,:) = GV%Z_to_H * G%bathyT(i,j) / dfloat(nz) enddo ; enddo case default diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index 913bb108c9..fed83a382b 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -219,9 +219,9 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A if (use_ALE) then ! construct a uniform grid for the sponge do k = 1,nz - e0(k) = -GV%max_depth * (real(k - 1) / real(nz)) + e0(k) = -G%max_depth * (real(k - 1) / real(nz)) enddo - e0(nz+1) = -GV%max_depth + e0(nz+1) = -G%max_depth do j = G%jsc,G%jec do i = G%isc,G%iec @@ -253,7 +253,7 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A x = (G%geoLonT(i,j) - G%west_lon) / G%len_lon do k = 1,nz ! nondimensional middle of layer - zmid = zi + 0.5 * h(i,j,k) / GV%max_depth + zmid = zi + 0.5 * h(i,j,k) / G%max_depth if (x > (1. - east_sponge_width)) then !if (zmid >= 0.9 * sill_height) & @@ -264,7 +264,7 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A S(i,j,k) = S_ref + S_range * (zmid - mld) / (1.0 - mld) endif - zi = zi + h(i,j,k) / GV%max_depth + zi = zi + h(i,j,k) / G%max_depth enddo enddo enddo diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 0e32bb1e7e..5f6e66d5be 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -87,12 +87,10 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param ! negative because it is positive upward. ! real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! ! positive upward, in m. ! - integer :: i, j, k, is, ie, js, je, nz - real :: x - real :: delta_h real :: min_thickness, S_surf, S_range, S_ref, S_light, S_dense character(len=20) :: verticalCoordinate logical :: just_read ! If true, just read parameters but set nothing. + integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -172,7 +170,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - h(i,j,:) = G%Zd_to_m * GV%m_to_H * (G%bathyT(i,j) / dfloat(nz)) + h(i,j,:) = GV%Z_to_H * G%bathyT(i,j) / dfloat(nz) enddo ; enddo end select diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index c204d049bc..1237ae3c14 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -64,18 +64,14 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: displ(SZK_(G)+1) - real :: z_unif(SZK_(G)+1) ! Fractional uniform interface heights, nondim. - real :: z_inter(SZK_(G)+1) ! Interface heights, in depth units. - real :: x - real :: a0 - real :: m_to_Z ! A conversion factor from m to depth units. - real :: total_height - real :: weight_z - real :: x1, y1, x2, y2 - real :: t - logical :: just_read ! If true, just read parameters but set nothing. - integer :: n + real :: displ(SZK_(G)+1) ! The interface displacement in depth units. + real :: z_unif(SZK_(G)+1) ! Fractional uniform interface heights, nondim. + real :: z_inter(SZK_(G)+1) ! Interface heights, in depth units. + real :: a0 ! The displacement amplitude in depth units. + real :: weight_z ! A (misused?) depth-space weighting, in inconsistent units. + real :: x1, y1, x2, y2 ! Dimensonless parameters. + real :: x, t ! Dimensionless depth coordinates? + logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, nx, nz @@ -84,8 +80,6 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param just_read = .false. ; if (present(just_read_params)) just_read = just_read_params if (just_read) return ! This subroutine has no run-time parameters. - m_to_Z = 1.0 / G%Zd_to_m - ! Define thicknesses do j=G%jsc,G%jec ; do i=G%isc,G%iec @@ -95,7 +89,6 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param enddo ! 1. Define stratification - n = 3 do k = 1,nz+1 ! Thin pycnocline in the middle @@ -121,14 +114,14 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param enddo ! 2. Define displacement - a0 = 75.0 * m_to_Z ! 75m Displacement amplitude in depth units. + a0 = 75.0 * GV%m_to_Z ! 75m Displacement amplitude in depth units. do k = 1,nz+1 weight_z = - 4.0 * ( z_unif(k) + 0.5 )**2 + 1.0 x = G%geoLonT(i,j) / G%len_lon !### Perhaps the '+ weight_z' here should be '* weight_z' - RWH - displ(k) = a0 * cos(acos(-1.0)*x) + weight_z * m_to_Z + displ(k) = a0 * cos(acos(-1.0)*x) + weight_z * GV%m_to_Z if ( k == 1 ) then displ(k) = 0.0 @@ -144,22 +137,16 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param ! 3. The last interface must coincide with the seabed z_inter(nz+1) = -G%bathyT(i,j) - ! Modify interface heights to make sure all thicknesses are strictly positive do k = nz,1,-1 - if ( z_inter(k) < (z_inter(k+1) + GV%Angstrom_Z) ) then z_inter(k) = z_inter(k+1) + GV%Angstrom_Z endif - enddo ! 4. Define layers - total_height = 0.0 do k = 1,nz - h(i,j,k) = G%Zd_to_m*GV%m_to_H * (z_inter(k) - z_inter(k+1)) - - total_height = total_height + h(i,j,k) + h(i,j,k) = GV%Z_to_H * (z_inter(k) - z_inter(k+1)) enddo enddo ; enddo From 59c7e221c11db7681a613c0ca5bb2a4a66bb929c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 29 Aug 2018 10:50:16 -0400 Subject: [PATCH 0676/1072] +Rescaled G%max_depth into depth units Changed the internal units of G%max_depth from m to depth units, which can be rescaled back to m by multiplication by G%Zd_to_m or GV%Z_to_m. In many initialization routines, this also involved recasting internal calculations from units of m to depth units. All answers are bitwise identical for no Z-rescaling or for rescaling by 2^93 or 2^-93. --- src/ALE/MOM_regridding.F90 | 8 +- src/core/MOM.F90 | 4 +- src/core/MOM_barotropic.F90 | 2 +- src/core/MOM_grid.F90 | 3 +- src/framework/MOM_dyn_horgrid.F90 | 3 +- .../MOM_state_initialization.F90 | 14 +- .../vertical/MOM_full_convection.F90 | 2 +- src/user/BFB_initialization.F90 | 9 +- src/user/DOME2d_initialization.F90 | 65 ++-- src/user/DOME_initialization.F90 | 18 +- src/user/ISOMIP_initialization.F90 | 335 +++++++++--------- src/user/Phillips_initialization.F90 | 47 +-- src/user/Rossby_front_2d_initialization.F90 | 8 +- src/user/adjustment_initialization.F90 | 60 ++-- src/user/benchmark_initialization.F90 | 2 +- src/user/circle_obcs_initialization.F90 | 16 +- src/user/dense_water_initialization.F90 | 16 +- src/user/dumbbell_initialization.F90 | 46 +-- src/user/external_gwave_initialization.F90 | 9 +- src/user/lock_exchange_initialization.F90 | 13 +- src/user/seamount_initialization.F90 | 22 +- src/user/sloshing_initialization.F90 | 4 +- 22 files changed, 357 insertions(+), 349 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index cfdbd45812..9cf69a2485 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -1677,7 +1677,7 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) ! Arguments type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(in) :: h !< Original ayer thicknesses, in H + real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(in) :: h !< Original layer thicknesses, in H real, dimension(SZI_(G),SZJ_(G), SZK_(GV)+1), intent(inout) :: dzInterface !< The change in interface depth in H real, intent(inout) :: h_new !< New layer thicknesses, in H type(regridding_CS), intent(in) :: CS !< Regridding control structure @@ -1697,8 +1697,8 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) nz = GV%ke - max_depth = G%max_depth - min_thickness = CS%min_thickness + max_depth = G%max_depth*GV%Z_to_H + min_thickness = CS%min_thickness !### May need *GV%m_to_H ? do j = G%jsc-1,G%jec+1 do i = G%isc-1,G%iec+1 @@ -1998,7 +1998,7 @@ subroutine set_regrid_max_depths( CS, max_depths, units_to_H ) if (.not.allocated(CS%max_interface_depths)) allocate(CS%max_interface_depths(1:CS%nk+1)) - val_to_H = 1.0 ; if (present( units_to_H)) val_to_H = units_to_H + val_to_H = 1.0 ; if (present(units_to_H)) val_to_H = units_to_H if (max_depths(CS%nk+1) < max_depths(1)) val_to_H = -1.0*val_to_H ! Check for sign reversals in the depths. diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 0f2334a290..f004bfcbd3 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2120,11 +2120,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Initialize dynamically evolving fields, perhaps from restart files. call cpu_clock_begin(id_clock_MOM_init) call MOM_initialize_coord(GV, param_file, write_geom_files, & - dirs%output_directory, CS%tv, dG%max_depth) + dirs%output_directory, CS%tv, dG%max_depth*dG%Zd_to_m) call callTree_waypoint("returned from MOM_initialize_coord() (initialize_MOM)") if (CS%use_ALE_algorithm) then - call ALE_init(param_file, GV, dG%max_depth, CS%ALE_CSp) + call ALE_init(param_file, GV, dG%max_depth*dG%Zd_to_m, CS%ALE_CSp) call callTree_waypoint("returned from ALE_init() (initialize_MOM)") endif diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 15dee28aeb..0168af9df4 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -3958,7 +3958,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & "An estimate of how much higher SSH might get, for use \n"//& "in calculating the safe external wave speed. The \n"//& "default is the minimum of 10 m or 5% of MAXIMUM_DEPTH.", & - units="m", default=min(10.0,0.05*G%max_depth)) + units="m", default=min(10.0,0.05*G%max_depth*GV%Z_to_m)) call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index c92730ec33..c0ca264d68 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -165,7 +165,7 @@ module MOM_grid real :: len_lat = 0. !< The latitudinal (or y-coord) extent of physical domain real :: len_lon = 0. !< The longitudinal (or x-coord) extent of physical domain real :: Rad_Earth = 6.378e6 !< The radius of the planet in meters. - real :: max_depth !< The maximum depth of the ocean in meters. + real :: max_depth !< The maximum depth of the ocean in depth units (scaled by Zd_to_m). end type ocean_grid_type contains @@ -375,6 +375,7 @@ subroutine rescale_grid_bathymetry(G, m_in_new_units) if (G%bathymetry_at_vel) then ; do J=JsdB,JedB ; do i=isd,ied G%Dblock_v(i,J) = rescale*G%Dblock_v(i,J) ; G%Dopen_v(i,J) = rescale*G%Dopen_v(i,J) enddo ; enddo ; endif + G%max_depth = rescale*G%max_depth G%Zd_to_m = m_in_new_units end subroutine rescale_grid_bathymetry diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 2ff129ce66..37500d31c2 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -160,7 +160,7 @@ module MOM_dyn_horgrid real :: len_lat = 0. !< The latitudinal (or y-coord) extent of physical domain real :: len_lon = 0. !< The longitudinal (or x-coord) extent of physical domain real :: Rad_Earth = 6.378e6 !< The radius of the planet in meters. - real :: max_depth !< The maximum depth of the ocean in meters. + real :: max_depth !< The maximum depth of the ocean in depth units (scaled by Zd_to_m). end type dyn_horgrid_type contains @@ -303,6 +303,7 @@ subroutine rescale_dyn_horgrid_bathymetry(G, m_in_new_units) if (G%bathymetry_at_vel) then ; do J=JsdB,JedB ; do i=isd,ied G%Dblock_v(i,J) = rescale*G%Dblock_v(i,J) ; G%Dopen_v(i,J) = rescale*G%Dopen_v(i,J) enddo ; enddo ; endif + G%max_depth = rescale*G%max_depth G%Zd_to_m = m_in_new_units end subroutine rescale_dyn_horgrid_bathymetry diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 120f990224..a9745c0064 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -776,10 +776,10 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) !! only read parameters without changing h. ! Local variables character(len=40) :: mdl = "initialize_thickness_uniform" ! This subroutine's name. - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units, usually ! negative because it is positive upward. real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in m. + ! positive upward, in depth units. logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, nz @@ -804,14 +804,14 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) ! Angstrom thick, and 2. the interfaces are where they should be ! based on the resting depths and interface height perturbations, ! as long at this doesn't interfere with 1. - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_m + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) endif enddo enddo ; enddo @@ -2177,7 +2177,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) ! Build the target grid (and set the model thickness to it) ! This call can be more general but is hard-coded for z* coordinates... ???? - call ALE_initRegridding( GV, G%max_depth, PF, mdl, regridCS ) ! sets regridCS + call ALE_initRegridding( GV, GV%Z_to_m*G%max_depth, PF, mdl, regridCS ) ! sets regridCS if (.not. remap_general) then ! This is the old way of initializing to z* coordinates only diff --git a/src/parameterizations/vertical/MOM_full_convection.F90 b/src/parameterizations/vertical/MOM_full_convection.F90 index 55ea1cabe9..299c230e0b 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -99,7 +99,7 @@ subroutine full_convection(G, GV, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, & h_neglect = GV%H_subroundoff kap_dt_x2 = 0.0 if (present(Kddt_convect)) kap_dt_x2 = 2.0*Kddt_convect - mix_len = (1.0e20 * nz) * (G%max_depth * GV%m_to_H) + mix_len = (1.0e20 * nz) * (G%max_depth * GV%Z_to_H) h0 = 1.0e-16*sqrt(Kddt_smooth) + h_neglect do j=js,je diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index b76aeb0c5b..76d3484563 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -115,10 +115,10 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, call get_param(param_file, mdl, "LENLON", lenlon, & "The longitudinal length of the domain.", units="degrees") nlat = slat + lenlat - do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz) ; enddo + do k=1,nz ; H0(k) = -G%Zd_to_m*G%max_depth * real(k-1) / real(nz) ; enddo ! Use for meridional thickness profile initialization -! do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz-1) ; enddo +! do k=1,nz ; H0(k) = -G%Zd_to_m*G%max_depth * real(k-1) / real(nz-1) ; enddo do i=is,ie; do j=js,je if (G%geoLatT(i,j) < slat+2.0) then ; damp = 1.0 @@ -141,10 +141,11 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, ! enddo ! elseif (G%geoLatT(i,j) > 20.0) then ! do k = 1,nz - ! eta(i,j,k) = min(H0(k) + (G%geoLatT(i,j) - 20.0)*(G%max_depth - nz*G%Angstrom_m)/20.0, -(k-1)*G%Angstrom_m) + ! eta(i,j,k) = min(H0(k) + (G%geoLatT(i,j) - 20.0)*(GV%Z_to_m*G%max_depth - nz*G%Angstrom_m)/20.0, & + ! -(k-1)*G%Angstrom_m) ! enddo ! endif - eta(i,j,nz+1) = -G%max_depth + eta(i,j,nz+1) = -G%Zd_to_m*G%max_depth if (G%Zd_to_m*G%bathyT(i,j) > min_depth) then Idamp(i,j) = damp/86400.0 diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index cb49286887..d5b789d266 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -95,10 +95,10 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(GV)) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(GV)) ! The resting interface heights, in depth units (Z), usually + ! negative because it is positive upward. + real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface + ! positive upward, in depth units (Z). integer :: i, j, k, is, ie, js, je, nz real :: x real :: delta_h @@ -115,7 +115,8 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params call MOM_mesg("MOM_initialization.F90, DOME2d_initialize_thickness: setting thickness") call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & - default=1.e-3, do_not_log=.true.) + default=1.e-3, units="m", do_not_log=.true.) + min_thickness = GV%m_to_Z*min_thickness call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & @@ -143,21 +144,21 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params case ( REGRIDDING_LAYER, REGRIDDING_RHO ) do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_m + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then h(i,j,1:nz-1) = GV%Angstrom_H - h(i,j,nz) = GV%m_to_H * dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_H + h(i,j,nz) = GV%Z_to_H * dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_H endif enddo ; enddo @@ -165,21 +166,21 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params ! case ( IC_RHO_C ) ! ! do j=js,je ; do i=is,ie - ! eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + ! eta1D(nz+1) = -G%bathyT(i,j) ! do k=nz,1,-1 ! eta1D(k) = e0(k) ! if (eta1D(k) < (eta1D(k+1) + min_thickness)) then ! eta1D(k) = eta1D(k+1) + min_thickness - ! h(i,j,k) = GV%m_to_H * min_thickness + ! h(i,j,k) = GV%Z_to_H * min_thickness ! else - ! h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + ! h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) ! endif ! enddo ! ! x = G%geoLonT(i,j) / G%len_lon ! if ( x <= dome2d_width_bay ) then - ! h(i,j,1:nz-1) = GV%m_to_H * min_thickness - ! h(i,j,nz) = GV%m_to_H * (dome2d_depth_bay * G%max_depth - (nz-1) * min_thickness) + ! h(i,j,1:nz-1) = GV%Z_to_H * min_thickness + ! h(i,j,nz) = GV%Z_to_H * (dome2d_depth_bay * G%max_depth - (nz-1) * min_thickness) ! endif ! ! enddo ; enddo @@ -187,14 +188,14 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params case ( REGRIDDING_ZSTAR ) do j=js,je ; do i=is,ie - eta1D(nz+1) = -GV%Z_to_H*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = GV%m_to_H * min_thickness + h(i,j,k) = GV%Z_to_H * min_thickness else - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo @@ -273,7 +274,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, do j=js,je ; do i=is,ie xi0 = 0.0 do k = 1,nz - xi1 = xi0 + (GV%H_to_m * h(i,j,k)) / G%max_depth + xi1 = xi0 + (GV%H_to_Z * h(i,j,k)) / G%max_depth S(i,j,k) = 34.0 + 0.5 * S_range * (xi0 + xi1) xi0 = xi1 enddo @@ -284,7 +285,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, do j=js,je ; do i=is,ie xi0 = 0.0 do k = 1,nz - xi1 = xi0 + (GV%H_to_m * h(i,j,k)) / G%max_depth + xi1 = xi0 + (GV%H_to_Z * h(i,j,k)) / G%max_depth S(i,j,k) = 34.0 + 0.5 * S_range * (xi0 + xi1) xi0 = xi1 enddo @@ -443,14 +444,14 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) enddo e0(nz+1) = -G%max_depth do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_m + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_m else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_m * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo @@ -460,13 +461,13 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) ! Construct temperature and salinity on the arbitrary grid T(:,:,:) = 0.0 ; S(:,:,:) = 0.0 do j=js,je ; do i=is,ie - z = -G%Zd_to_m*G%bathyT(i,j) + z = -G%bathyT(i,j) do k = nz,1,-1 - z = z + 0.5 * h(i,j,k) ! Position of the center of layer k + z = z + 0.5 * GV%m_to_Z * h(i,j,k) ! Position of the center of layer k S(i,j,k) = 34.0 - 1.0 * (z/G%max_depth) if ( ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon < dome2d_west_sponge_width ) & S(i,j,k) = S_ref + S_range - z = z + 0.5 * h(i,j,k) ! Position of the interface k + z = z + 0.5 * GV%m_to_Z *h(i,j,k) ! Position of the interface k enddo enddo ; enddo @@ -481,21 +482,21 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) ! Construct thicknesses to restore to do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_m + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_m else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_m * (eta1D(k) - eta1D(k+1)) endif enddo x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then h(i,j,1:nz-1) = GV%Angstrom_m - h(i,j,nz) = dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_m + h(i,j,nz) = dome2d_depth_bay * GV%Z_to_m*G%max_depth - (nz-1) * GV%Angstrom_m endif eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 661b6a9978..20cdfc388d 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -86,10 +86,10 @@ subroutine DOME_initialize_thickness(h, G, GV, param_file, just_read_params) logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: e0(SZK_(GV)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(GV)+1) ! The resting interface heights, in m, usually + ! negative because it is positive upward, in depth units (Z). + real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface + ! positive upward, in depth units (Z). logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "DOME_initialize_thickness" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, nz @@ -113,14 +113,14 @@ subroutine DOME_initialize_thickness(h, G, GV, param_file, just_read_params) ! Angstrom thick, and 2. the interfaces are where they should be ! ! based on the resting depths and interface height perturbations, ! ! as long at this doesn't interfere with 1. ! - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_m + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) endif enddo enddo ; enddo @@ -170,7 +170,7 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) "The minimum depth of the ocean.", units="m", default=0.0) H0(1) = 0.0 - do k=2,nz ; H0(k) = -(real(k-1)-0.5)*G%max_depth/real(nz-1) ; enddo + do k=2,nz ; H0(k) = -(real(k-1)-0.5)*(GV%Z_to_m*G%max_depth) / real(nz-1) ; enddo do i=is,ie; do j=js,je if (G%geoLonT(i,j) < 100.0) then ; damp = 10.0 elseif (G%geoLonT(i,j) < 200.0) then diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 8ddd12bed3..5376dcca21 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -130,10 +130,10 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), + ! usually negative because it is positive upward. + real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface + ! positive upward, in depth units (Z). integer :: i, j, k, is, ie, js, je, nz, tmp1 real :: x real :: rho_range @@ -153,6 +153,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par 'Minimum layer thickness', units='m', default=1.e-3, do_not_log=just_read) call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) + min_thickness = GV%m_to_Z*min_thickness select case ( coordinateMode(verticalCoordinate) ) @@ -192,14 +193,14 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par ! Calculate thicknesses do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_m + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo @@ -207,14 +208,14 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = GV%m_to_H * min_thickness + h(i,j,k) = GV%Z_to_H * min_thickness else - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo @@ -248,8 +249,9 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, ! Local variables integer :: i, j, k, is, ie, js, je, nz, itt real :: x, ds, dt, rho_sur, rho_bot - real :: xi0, xi1, dxi ! Heights in m., r - real :: S_sur, T_sur, S_bot, T_bot, S_range, T_range + real :: xi0, xi1 ! Heights in depth units (Z). + real :: S_sur, T_sur, S_bot, T_bot + real :: dT_dz, dS_dz ! Gradients of T and S in degC/Z and PPT/Z. real :: z ! vertical position in z space character(len=256) :: mesg ! The text of an error message character(len=40) :: verticalCoordinate, density_profile @@ -290,105 +292,96 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, case ( REGRIDDING_RHO, REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR, REGRIDDING_SIGMA ) if (just_read) return ! All run-time parameters have been read, so return. - S_range = s_sur - s_bot - T_range = t_sur - t_bot - ! write(mesg,*) 'S_range,T_range',S_range,T_range - ! call MOM_mesg(mesg,5) - - S_range = S_range / G%max_depth ! Convert S_range into dS/dz - T_range = T_range / G%max_depth ! Convert T_range into dT/dz + dS_dz = (s_sur - s_bot) / G%max_depth + dT_dz = (t_sur - t_bot) / G%max_depth do j=js,je ; do i=is,ie xi0 = -G%Zd_to_m * G%bathyT(i,j) do k = nz,1,-1 - xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_m ! Depth in middle of layer - S(i,j,k) = S_sur + S_range * xi0 - T(i,j,k) = T_sur + T_range * xi0 - xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_m ! Depth at top of layer + xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth in middle of layer + S(i,j,k) = S_sur + dS_dz * xi0 + T(i,j,k) = T_sur + dT_dz * xi0 + xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth at top of layer enddo enddo ; enddo case ( REGRIDDING_LAYER ) - call get_param(param_file, mdl, "FIT_SALINITY", fit_salin, & - "If true, accept the prescribed temperature and fit the \n"//& - "salinity; otherwise take salinity and fit temperature.", & - default=.false., do_not_log=just_read) - call get_param(param_file, mdl, "DRHO_DS", drho_dS1, & - "Partial derivative of density with salinity.", & - units="kg m-3 PSU-1", fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl, "DRHO_DT", drho_dT1, & - "Partial derivative of density with temperature.", & - units="kg m-3 K-1", fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl, "T_REF", T_Ref, & - "A reference temperature used in initialization.", & - units="degC", fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl, "S_REF", S_Ref, & - "A reference salinity used in initialization.", units="PSU", & - default=35.0, do_not_log=just_read) - if (just_read) return ! All run-time parameters have been read, so return. - - ! write(mesg,*) 'read drho_dS, drho_dT', drho_dS1, drho_dT1 - ! call MOM_mesg(mesg,5) - - S_range = s_bot - s_sur - T_range = t_bot - t_sur - ! write(mesg,*) 'S_range,T_range',S_range,T_range - ! call MOM_mesg(mesg,5) - S_range = S_range / G%max_depth ! Convert S_range into dS/dz - T_range = T_range / G%max_depth ! Convert T_range into dT/dz - - do j=js,je ; do i=is,ie - xi0 = 0.0 - do k = 1,nz - !T0(k) = T_Ref; S0(k) = S_Ref - xi1 = xi0 + 0.5 * h(i,j,k) * GV%H_to_m - S0(k) = S_sur + S_range * xi1 - T0(k) = T_sur + T_range * xi1 - xi0 = xi0 + h(i,j,k) * GV%H_to_m - ! write(mesg,*) 'S,T,xi0,xi1,k',S0(k),T0(k),xi0,xi1,k - ! call MOM_mesg(mesg,5) - enddo + call get_param(param_file, mdl, "FIT_SALINITY", fit_salin, & + "If true, accept the prescribed temperature and fit the \n"//& + "salinity; otherwise take salinity and fit temperature.", & + default=.false., do_not_log=just_read) + call get_param(param_file, mdl, "DRHO_DS", drho_dS1, & + "Partial derivative of density with salinity.", & + units="kg m-3 PSU-1", fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "DRHO_DT", drho_dT1, & + "Partial derivative of density with temperature.", & + units="kg m-3 K-1", fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "T_REF", T_Ref, & + "A reference temperature used in initialization.", & + units="degC", fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "S_REF", S_Ref, & + "A reference salinity used in initialization.", units="PSU", & + default=35.0, do_not_log=just_read) + if (just_read) return ! All run-time parameters have been read, so return. - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,1,eqn_of_state) - ! write(mesg,*) 'computed drho_dS, drho_dT', drho_dS(1), drho_dT(1) - ! call MOM_mesg(mesg,5) - call calculate_density(T0(1),S0(1),0.,rho_guess(1),eqn_of_state) + ! write(mesg,*) 'read drho_dS, drho_dT', drho_dS1, drho_dT1 + ! call MOM_mesg(mesg,5) - if (fit_salin) then - ! A first guess of the layers' salinity. - do k=nz,1,-1 - S0(k) = max(0.0, S0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dS1) - enddo - ! Refine the guesses for each layer. - do itt=1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) - do k=1,nz - S0(k) = max(0.0, S0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dS1) - enddo - enddo + dS_dz = (s_sur - s_bot) / G%max_depth + dT_dz = (t_sur - t_bot) / G%max_depth - else - ! A first guess of the layers' temperatures. - do k=nz,1,-1 - T0(k) = T0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dT1 - enddo + do j=js,je ; do i=is,ie + xi0 = 0.0 + do k = 1,nz + !T0(k) = T_Ref; S0(k) = S_Ref + xi1 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z + S0(k) = S_sur + dS_dz * xi1 + T0(k) = T_sur + dT_dz * xi1 + xi0 = xi0 + h(i,j,k) * GV%H_to_Z + ! write(mesg,*) 'S,T,xi0,xi1,k',S0(k),T0(k),xi0,xi1,k + ! call MOM_mesg(mesg,5) + enddo - do itt=1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) - do k=1,nz - T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) - enddo - enddo - endif + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,1,eqn_of_state) + ! write(mesg,*) 'computed drho_dS, drho_dT', drho_dS(1), drho_dT(1) + ! call MOM_mesg(mesg,5) + call calculate_density(T0(1),S0(1),0.,rho_guess(1),eqn_of_state) + + if (fit_salin) then + ! A first guess of the layers' salinity. + do k=nz,1,-1 + S0(k) = max(0.0, S0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dS1) + enddo + ! Refine the guesses for each layer. + do itt=1,6 + call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) + do k=1,nz + S0(k) = max(0.0, S0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dS1) + enddo + enddo - do k=1,nz - T(i,j,k) = T0(k) ; S(i,j,k) = S0(k) - enddo + else + ! A first guess of the layers' temperatures. + do k=nz,1,-1 + T0(k) = T0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dT1 + enddo + + do itt=1,6 + call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) + do k=1,nz + T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) + enddo + enddo + endif + + do k=1,nz + T(i,j,k) = T0(k) ; S(i,j,k) = S0(k) + enddo - enddo ; enddo + enddo ; enddo - case default + case default call MOM_error(FATAL,"isomip_initialize: "// & "Unrecognized i.c. setup - set REGRIDDING_COORDINATE_MODE") @@ -428,10 +421,11 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. real :: TNUDG ! Nudging time scale, days - real :: S_sur, T_sur; ! Surface salinity and temerature in sponge - real :: S_bot, T_bot; ! Bottom salinity and temerature in sponge - real :: t_ref, s_ref ! reference T and S - real :: rho_sur, rho_bot, rho_range, t_range, s_range + real :: S_sur, T_sur ! Surface salinity and temerature in sponge + real :: S_bot, T_bot ! Bottom salinity and temerature in sponge + real :: t_ref, s_ref ! reference T and S + real :: rho_sur, rho_bot, rho_range + real :: dT_dz, dS_dz ! Gradients of T and S in degC/Z and PPT/Z. real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! ! negative because it is positive upward. ! @@ -451,6 +445,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed call get_param(PF, mdl,"MIN_THICKNESS",min_thickness,'Minimum layer thickness',units='m',default=1.e-3) + min_thickness = GV%m_to_Z * min_thickness call get_param(PF, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE) @@ -463,17 +458,15 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) call get_param(PF, mdl, "S_REF", s_ref, 'Reference salinity', default=35.0,& do_not_log=.true.) - call get_param(PF, mdl, "ISOMIP_S_SUR_SPONGE", s_sur, 'Surface salinity in sponge layer.', default=s_ref) + call get_param(PF, mdl, "ISOMIP_S_SUR_SPONGE", s_sur, 'Surface salinity in sponge layer.', default=s_ref) - call get_param(PF, mdl, "ISOMIP_S_BOT_SPONGE", s_bot, 'Bottom salinity in sponge layer.', default=s_ref) + call get_param(PF, mdl, "ISOMIP_S_BOT_SPONGE", s_bot, 'Bottom salinity in sponge layer.', default=s_ref) - call get_param(PF, mdl, "ISOMIP_T_SUR_SPONGE", t_sur, 'Surface temperature in sponge layer.', default=t_ref) + call get_param(PF, mdl, "ISOMIP_T_SUR_SPONGE", t_sur, 'Surface temperature in sponge layer.', default=t_ref) - call get_param(PF, mdl, "ISOMIP_T_BOT_SPONGE", t_bot, 'Bottom temperature in sponge layer.', default=t_ref) + call get_param(PF, mdl, "ISOMIP_T_BOT_SPONGE", t_bot, 'Bottom temperature in sponge layer.', default=t_ref) T(:,:,:) = 0.0 ; S(:,:,:) = 0.0 ; Idamp(:,:) = 0.0; RHO(:,:,:) = 0.0 - S_range = s_sur - s_bot - T_range = t_sur - t_bot ! Set up sponges for ISOMIP configuration call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & @@ -504,7 +497,6 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) Idamp(i,j) = damp/86400.0 else ; Idamp(i,j) = 0.0 ; endif - enddo ; enddo ! Compute min/max density using T_SUR/S_SUR and T_BOT/S_BOT @@ -536,55 +528,56 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) ! Calculate thicknesses do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_m + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_m else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_m*(eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = min_thickness + h(i,j,k) = min_thickness * GV%Z_to_m else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_m*(eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates - do j=js,je ; do i=is,ie - h(i,j,:) = G%Zd_to_m * (G%bathyT(i,j) / dfloat(nz)) - enddo ; enddo + do j=js,je ; do i=is,ie + h(i,j,:) = G%Zd_to_m * (G%bathyT(i,j) / dfloat(nz)) + enddo ; enddo case default call MOM_error(FATAL,"ISOMIP_initialize_sponges: "// & "Unrecognized i.c. setup - set REGRIDDING_COORDINATE_MODE") end select + ! This call sets up the damping rates and interface heights. ! This sets the inverse damping timescale fields in the sponges. call initialize_ALE_sponge(Idamp, G, PF, ACSp, h, nz) - S_range = S_range / G%max_depth ! Convert S_range into dS/dz - T_range = T_range / G%max_depth ! Convert T_range into dT/dz + dS_dz = (s_sur - s_bot) / G%max_depth + dT_dz = (t_sur - t_bot) / G%max_depth do j=js,je ; do i=is,ie xi0 = -G%Zd_to_m * G%bathyT(i,j) do k = nz,1,-1 - xi0 = xi0 + 0.5 * h(i,j,k) ! Depth in middle of layer - S(i,j,k) = S_sur + S_range * xi0 - T(i,j,k) = T_sur + T_range * xi0 - xi0 = xi0 + 0.5 * h(i,j,k) ! Depth at top of layer + xi0 = xi0 + 0.5 * h(i,j,k) * GV%m_to_Z ! Depth in middle of layer + S(i,j,k) = S_sur + dS_dz * xi0 + T(i,j,k) = T_sur + dT_dz * xi0 + xi0 = xi0 + 0.5 * h(i,j,k) * GV%m_to_Z ! Depth at top of layer enddo enddo ; enddo ! for debugging @@ -601,57 +594,57 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) ! The remaining calls to set_up_sponge_field can be in any order. ! if ( associated(tv%T) ) then - call set_up_ALE_sponge_field(T,G,tv%T,ACSp) + call set_up_ALE_sponge_field(T, G, tv%T, ACSp) endif if ( associated(tv%S) ) then - call set_up_ALE_sponge_field(S,G,tv%S,ACSp) + call set_up_ALE_sponge_field(S, G, tv%S, ACSp) endif else ! layer mode - ! 1) Read eta, salt and temp from IC file - call get_param(PF, mdl, "INPUTDIR", inputdir, default=".") - inputdir = slasher(inputdir) - ! GM: get two different files, one with temp and one with salt values - ! this is work around to avoid having wrong values near the surface - ! because of the FIT_SALINITY option. To get salt values right in the - ! sponge, FIT_SALINITY=False. The oposite is true for temp. One can - ! combined the *correct* temp and salt values in one file instead. - call get_param(PF, mdl, "ISOMIP_SPONGE_FILE", state_file, & - "The name of the file with temps., salts. and interfaces to \n"// & - " damp toward.", fail_if_missing=.true.) - call get_param(PF, mdl, "SPONGE_PTEMP_VAR", temp_var, & - "The name of the potential temperature variable in \n"//& - "SPONGE_STATE_FILE.", default="Temp") - call get_param(PF, mdl, "SPONGE_SALT_VAR", salt_var, & - "The name of the salinity variable in \n"//& - "SPONGE_STATE_FILE.", default="Salt") - call get_param(PF, mdl, "SPONGE_ETA_VAR", eta_var, & - "The name of the interface height variable in \n"//& - "SPONGE_STATE_FILE.", default="eta") - - !read temp and eta - filename = trim(inputdir)//trim(state_file) - if (.not.file_exists(filename, G%Domain)) & - call MOM_error(FATAL, " ISOMIP_initialize_sponges: Unable to open "//trim(filename)) - call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) - call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain) - call MOM_read_data(filename, salt_var, S(:,:,:), G%Domain) - - ! for debugging - !i=G%iec; j=G%jec - !do k = 1,nz - ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,tv%eqn_of_state) - ! write(mesg,*) 'Sponge - k,eta,T,S,rho,Rlay',k,eta(i,j,k),T(i,j,k),& - ! S(i,j,k),rho_tmp,GV%Rlay(k) - ! call MOM_mesg(mesg,5) - !enddo - - ! Set the inverse damping rates so that the model will know where to - ! apply the sponges, along with the interface heights. - call initialize_sponge(Idamp, eta, G, PF, CSp) - ! Apply sponge in tracer fields - call set_up_sponge_field(T, tv%T, G, nz, CSp) - call set_up_sponge_field(S, tv%S, G, nz, CSp) + ! 1) Read eta, salt and temp from IC file + call get_param(PF, mdl, "INPUTDIR", inputdir, default=".") + inputdir = slasher(inputdir) + ! GM: get two different files, one with temp and one with salt values + ! this is work around to avoid having wrong values near the surface + ! because of the FIT_SALINITY option. To get salt values right in the + ! sponge, FIT_SALINITY=False. The oposite is true for temp. One can + ! combined the *correct* temp and salt values in one file instead. + call get_param(PF, mdl, "ISOMIP_SPONGE_FILE", state_file, & + "The name of the file with temps., salts. and interfaces to \n"// & + " damp toward.", fail_if_missing=.true.) + call get_param(PF, mdl, "SPONGE_PTEMP_VAR", temp_var, & + "The name of the potential temperature variable in \n"//& + "SPONGE_STATE_FILE.", default="Temp") + call get_param(PF, mdl, "SPONGE_SALT_VAR", salt_var, & + "The name of the salinity variable in \n"//& + "SPONGE_STATE_FILE.", default="Salt") + call get_param(PF, mdl, "SPONGE_ETA_VAR", eta_var, & + "The name of the interface height variable in \n"//& + "SPONGE_STATE_FILE.", default="eta") + + !read temp and eta + filename = trim(inputdir)//trim(state_file) + if (.not.file_exists(filename, G%Domain)) & + call MOM_error(FATAL, " ISOMIP_initialize_sponges: Unable to open "//trim(filename)) + call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) + call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain) + call MOM_read_data(filename, salt_var, S(:,:,:), G%Domain) + + ! for debugging + !i=G%iec; j=G%jec + !do k = 1,nz + ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,tv%eqn_of_state) + ! write(mesg,*) 'Sponge - k,eta,T,S,rho,Rlay',k,eta(i,j,k),T(i,j,k),& + ! S(i,j,k),rho_tmp,GV%Rlay(k) + ! call MOM_mesg(mesg,5) + !enddo + + ! Set the inverse damping rates so that the model will know where to + ! apply the sponges, along with the interface heights. + call initialize_sponge(Idamp, eta, G, PF, CSp) + ! Apply sponge in tracer fields + call set_up_sponge_field(T, tv%T, G, nz, CSp) + call set_up_sponge_field(S, tv%S, G, nz, CSp) endif diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index ebd20c7f7d..5832df78fc 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -39,10 +39,10 @@ subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces. - real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta, m. + real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces, in depth units (Z). + real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta, in depth units (Z). real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface - ! positive upward, in m. + ! positive upward, in in depth units (Z). real :: damp_rate, jet_width, jet_height, y_2 real :: half_strat, half_depth logical :: just_read ! If true, just read parameters but set nothing. @@ -70,6 +70,7 @@ subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) if (just_read) return ! All run-time parameters have been read, so return. + jet_height = jet_height*GV%m_to_Z half_depth = G%max_depth*half_strat eta0(1) = 0.0 ; eta0(nz+1) = -G%max_depth do k=2,1+nz/2 ; eta0(k) = -half_depth*(2.0*(k-1)/real(nz)) ; enddo @@ -82,27 +83,26 @@ subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) enddo do K=2,nz ; do j=js,je y_2 = G%geoLatT(is,j) - G%south_lat - 0.5*G%len_lat - eta_im(j,K) = eta0(k) + & - jet_height * tanh(y_2 / jet_width) -! jet_height * atan(y_2 / jet_width) + eta_im(j,K) = eta0(k) + jet_height * tanh(y_2 / jet_width) + ! or ... + jet_height * atan(y_2 / jet_width) if (eta_im(j,K) > 0.0) eta_im(j,K) = 0.0 if (eta_im(j,K) < -G%max_depth) eta_im(j,K) = -G%max_depth enddo ; enddo do j=js,je ; do i=is,ie -! This sets the initial thickness (in m) of the layers. The ! +! This sets the initial thickness (in H) of the layers. The ! ! thicknesses are set to insure that: 1. each layer is at least an ! ! Angstrom thick, and 2. the interfaces are where they should be ! ! based on the resting depths and interface height perturbations, ! ! as long at this doesn't interfere with 1. ! - eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = eta_im(j,K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_m + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) endif enddo enddo ; enddo @@ -200,16 +200,20 @@ subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, type(sponge_CS), pointer :: CSp !< A pointer that is set to point to !! the control structure for the !! sponge module. - real, intent(in), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: h !< Thickness field. + real, intent(in), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: h !< Thickness field, in units of H. real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces. real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, m. - real :: temp(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for other variables. ! + real :: temp(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for other variables. real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta, m. real :: Idamp_im(SZJ_(G)) ! The inverse zonal-mean damping rate, in s-1. - real :: damp_rate, jet_width, jet_height, y_2 - real :: half_strat, half_depth + real :: damp_rate ! The inverse zonal-mean damping rate, in s-1. + real :: jet_width ! The width of the zonal mean jet, in km. + real :: jet_height ! The interface height scale associated with the zonal-mean jet, in depth units. + real :: y_2 ! The y-position relative to the channel center, in km. + real :: half_strat ! The fractional depth where the straficiation is centered, ND. + real :: half_depth ! The depth where the stratification is centered, in depth units. character(len=40) :: mdl = "Phillips_initialize_sponges" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz @@ -224,8 +228,8 @@ subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, if (first_call) call log_version(param_file, mdl, version) first_call = .false. call get_param(param_file, mdl, "HALF_STRAT_DEPTH", half_strat, & - "The maximum depth of the ocean.", units="nondim", & - default = 0.5) + "The fractional depth where the stratificaiton is centered.", & + units="nondim", default = 0.5) call get_param(param_file, mdl, "SPONGE_RATE", damp_rate, & "The rate at which the zonal-mean sponges damp.", units="s-1", & default = 1.0/(10.0*86400.0)) @@ -238,6 +242,7 @@ subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, "zonal-mean jet.", units="m", & fail_if_missing=.true.) + jet_height = jet_height / G%Zd_to_m half_depth = G%max_depth*half_strat eta0(1) = 0.0 ; eta0(nz+1) = -G%max_depth do k=2,1+nz/2 ; eta0(k) = -half_depth*(2.0*(k-1)/real(nz)) ; enddo @@ -247,15 +252,15 @@ subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, do j=js,je Idamp_im(j) = damp_rate - eta_im(j,1) = 0.0 ; eta_im(j,nz+1) = -G%max_depth + eta_im(j,1) = 0.0 ; eta_im(j,nz+1) = -G%Zd_to_m*G%max_depth enddo do K=2,nz ; do j=js,je y_2 = G%geoLatT(is,j) - G%south_lat - 0.5*G%len_lat - eta_im(j,K) = eta0(k) + & - jet_height * tanh(y_2 / jet_width) + eta_im(j,K) = eta0(k) + jet_height * tanh(y_2 / jet_width) ! jet_height * atan(y_2 / jet_width) if (eta_im(j,K) > 0.0) eta_im(j,K) = 0.0 if (eta_im(j,K) < -G%max_depth) eta_im(j,K) = -G%max_depth + eta_im(j,K) = eta_im(j,K) * G%Zd_to_m enddo ; enddo call initialize_sponge(Idamp, eta, G, param_file, CSp, Idamp_im, eta_im) @@ -295,7 +300,7 @@ subroutine Phillips_initialize_topography(D, G, param_file, max_depth) call get_param(param_file, mdl, "PHILLIPS_HTOP", Htop, & "The maximum height of the topography.", units="m", & fail_if_missing=.true.) -! Htop=0.375*G%max_depth ! max height of topog. above max_depth +! Htop=0.375*max_depth ! max height of topog. above max_depth Wtop=0.5*G%len_lat ! meridional width of drake and mount Ltop=0.25*G%len_lon ! zonal width of topographic features offset=0.1*G%len_lat ! meridional offset from center diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index b2e4f35881..6c1410da3f 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -81,7 +81,7 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, param_file, just_read_par stretch = ( ( G%max_depth + eta ) / G%max_depth ) h0 = ( G%max_depth / real(nz) ) * stretch do k = 1, nz - h(i,j,k) = h0 * GV%m_to_H + h(i,j,k) = h0 * GV%Z_to_H enddo enddo ; enddo @@ -92,7 +92,7 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, param_file, just_read_par stretch = ( ( G%max_depth + eta ) / G%max_depth ) h0 = ( G%max_depth / real(nz) ) * stretch do k = 1, nz - h(i,j,k) = h0 * GV%m_to_H + h(i,j,k) = h0 * GV%Z_to_H enddo enddo ; enddo @@ -149,7 +149,7 @@ subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, & zi = 0. do k = 1, nz zi = zi - h(i,j,k) ! Bottom interface position - zc = GV%H_to_m * (zi - 0.5*h(i,j,k)) ! Position of middle of cell + zc = GV%H_to_Z * (zi - 0.5*h(i,j,k)) ! Position of middle of cell zc = min( zc, -Hml(G, G%geoLatT(i,j)) ) ! Bound by depth of mixed layer T(i,j,k) = T_ref + dTdz * zc ! Linear temperature profile enddo @@ -203,7 +203,7 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, param_file, just_rea f = 0.5*( G%CoriolisBu(I,j) + G%CoriolisBu(I,j-1) ) dUdT = 0.0 ; if (abs(f) > 0.0) & dUdT = ( GV%g_Earth * dRho_dT ) / ( f * GV%Rho0 ) - Dml = Hml( G, G%geoLatT(i,j) ) + Dml = GV%Z_to_m*Hml( G, G%geoLatT(i,j) ) Ty = dTdy( G, T_range, G%geoLatT(i,j) ) zi = 0. do k = 1, nz diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index 6049aa971a..e33b1d17ed 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -36,10 +36,10 @@ subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_par logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), usually + ! negative because it is positive upward. + real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface + ! positive upward, in depth units (Z). real :: x, y, yy, delta_S_strat, dSdz, delta_S, S_ref real :: min_thickness, adjustment_width, adjustment_delta, adjustment_deltaS real :: front_wave_amp, front_wave_length, front_wave_asym @@ -61,7 +61,8 @@ subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_par if (.not.just_read) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl,"S_REF",S_ref,fail_if_missing=.true.,do_not_log=.true.) call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness,'Minimum layer thickness', & - units='m',default=1.0e-3, do_not_log=just_read) + units='m', default=1.0e-3, do_not_log=just_read) + min_thickness = min_thickness*GV%m_to_Z ! Parameters specific to this experiment configuration call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & @@ -95,28 +96,29 @@ subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_par ! vanished and the other thicknesses uniformly distributed, use: ! e0(k) = -G%max_depth * real(k-1) / real(nz-1) - dSdz = -delta_S_strat/G%max_depth + dSdz = -delta_S_strat / G%max_depth select case ( coordinateMode(verticalCoordinate) ) case ( REGRIDDING_LAYER, REGRIDDING_RHO ) if (delta_S_strat /= 0.) then - adjustment_delta = adjustment_deltaS / delta_S_strat * G%max_depth + ! This was previously coded ambiguously. + adjustment_delta = (adjustment_deltaS / delta_S_strat) * G%max_depth do k=1,nz+1 - e0(k) = adjustment_delta-(G%max_depth+2*adjustment_delta) * (real(k-1) / real(nz)) + e0(k) = adjustment_delta - (G%max_depth + 2*adjustment_delta) * (real(k-1) / real(nz)) enddo else adjustment_delta = 2.*G%max_depth do k=1,nz+1 - e0(k) = -(G%max_depth) * (real(k-1) / real(nz)) + e0(k) = -G%max_depth * (real(k-1) / real(nz)) enddo endif - target_values(1) = GV%Rlay(1)+0.5*(GV%Rlay(1)-GV%Rlay(2)) - target_values(nz+1) = GV%Rlay(nz)+0.5*(GV%Rlay(nz)-GV%Rlay(nz-1)) + target_values(1) = GV%Rlay(1) + 0.5*(GV%Rlay(1)-GV%Rlay(2)) + target_values(nz+1) = GV%Rlay(nz) + 0.5*(GV%Rlay(nz)-GV%Rlay(nz-1)) do k = 2,nz target_values(k) = target_values(k-1) + ( GV%Rlay(nz) - GV%Rlay(1) ) / (nz-1) enddo - target_values = target_values - 1000. + target_values(:) = target_values(:) - 1000. do j=js,je ; do i=is,ie if (front_wave_length /= 0.) then y = ( 0.125 + G%geoLatT(i,j) / front_wave_length ) * ( 4. * acos(0.) ) @@ -140,28 +142,28 @@ subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_par eta1D(k) = max( eta1D(k), -G%max_depth ) eta1D(k) = min( eta1D(k), 0. ) enddo - eta1D(1)=0.; eta1D(nz+1)=-G%max_depth + eta1D(1) = 0.; eta1D(nz+1) = -G%max_depth do k=nz,1,-1 if (eta1D(k) > 0.) then eta1D(k) = max( eta1D(k+1) + min_thickness, 0. ) - h(i,j,k) = GV%m_to_H * max( eta1D(k) - eta1D(k+1), min_thickness ) + h(i,j,k) = GV%Z_to_H * max( eta1D(k) - eta1D(k+1), min_thickness ) elseif (eta1D(k) <= (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = GV%m_to_H * min_thickness + h(i,j,k) = GV%Z_to_H * min_thickness else - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA ) do k=1,nz+1 - eta1D(k) = -(G%max_depth) * (real(k-1) / real(nz)) - eta1D(k) = max(min(eta1D(k),0.),-G%max_depth) + eta1D(k) = -G%max_depth * (real(k-1) / real(nz)) + eta1D(k) = max(min(eta1D(k), 0.), -G%max_depth) enddo do j=js,je ; do i=is,ie do k=nz,1,-1 - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) enddo enddo ; enddo @@ -174,15 +176,15 @@ subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_par end subroutine adjustment_initialize_thickness !> Initialization of temperature and salinity in the adjustment test case -subroutine adjustment_initialize_temperature_salinity ( T, S, h, G, GV, param_file, & - eqn_of_state, just_read_params) +subroutine adjustment_initialize_temperature_salinity(T, S, h, G, GV, param_file, & + eqn_of_state, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< The temperature that is being initialized. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< The salinity that is being initialized. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< The model thicknesses in H (m or kg m-2). - type(param_file_type), intent(in) :: param_file !< A structure indicating the - !! open file to parse for model parameter values. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to + !! parse for model parameter values. type(EOS_type), pointer :: eqn_of_state !< Equation of state. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing T & S. @@ -226,7 +228,7 @@ subroutine adjustment_initialize_temperature_salinity ( T, S, h, G, GV, param_fi call get_param(param_file, mdl,"FRONT_WAVE_AMP", front_wave_amp, default=0., & do_not_log=.true.) call get_param(param_file, mdl,"FRONT_WAVE_LENGTH",front_wave_length, & - default=0.,do_not_log=.true.) + default=0., do_not_log=.true.) call get_param(param_file, mdl,"FRONT_WAVE_ASYM", front_wave_asym, default=0., & do_not_log=.true.) @@ -239,11 +241,11 @@ subroutine adjustment_initialize_temperature_salinity ( T, S, h, G, GV, param_fi select case ( coordinateMode(verticalCoordinate) ) case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA ) - dSdz = -delta_S_strat/G%max_depth + dSdz = -delta_S_strat / G%max_depth do j=js,je ; do i=is,ie - eta1d(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1d(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 - eta1d(k) = eta1d(k+1) + h(i,j,k)*GV%H_to_m + eta1d(k) = eta1d(k+1) + h(i,j,k)*GV%H_to_Z enddo if (front_wave_length /= 0.) then y = ( 0.125 + G%geoLatT(i,j) / front_wave_length ) * ( 4. * acos(0.) ) @@ -264,8 +266,8 @@ subroutine adjustment_initialize_temperature_salinity ( T, S, h, G, GV, param_fi x = 1. - min(1., x) T(i,j,k) = x enddo - ! x=sum(T(i,j,:)*h(i,j,:)) - ! T(i,j,:)=T(i,j,:)/x*(G%max_depth*1.5/real(nz)) + ! x = GV%H_to_Z*sum(T(i,j,:)*h(i,j,:)) + ! T(i,j,:) = (T(i,j,:) / x) * (G%max_depth*1.5/real(nz)) enddo ; enddo case ( REGRIDDING_LAYER, REGRIDDING_RHO ) diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index 04e8cd014b..decb94963c 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -147,7 +147,7 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & pi = 4.0*atan(1.0) I_ts = 1.0 / thermocline_scale - I_md = 1.0 / G%max_depth + I_md = 1.0 / (G%max_depth * GV%Z_to_m) do j=js,je ; do i=is,ie SST = 0.5*(T0(k1)+T0(nz)) - 0.9*0.5*(T0(k1)-T0(nz)) * & cos(pi*(G%geoLatT(i,j)-G%south_lat)/(G%len_lat)) diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index 1d6611035e..f72a6e1830 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -33,10 +33,10 @@ subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_para logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: e0(SZK_(GV)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units (Z), usually + ! negative because it is positive upward. + real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface + ! positive upward, in in depth units (Z). real :: diskrad, rad, xCenter, xRadius, lonC, latC, xOffset logical :: just_read ! This include declares and sets the variable "version". @@ -70,14 +70,14 @@ subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_para ! Uniform thicknesses for base state do j=js,je ; do i=is,ie ! - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_m + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) endif enddo enddo ; enddo diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index fed83a382b..260caf2f53 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -129,7 +129,7 @@ subroutine dense_water_initialize_TS(G, GV, param_file, eqn_of_state, T, S, h, j zi = 0. do k = 1,nz ! nondimensional middle of layer - zmid = zi + 0.5 * h(i,j,k) / G%max_depth + zmid = zi + 0.5 * h(i,j,k) / (GV%Z_to_H * G%max_depth) if (zmid < mld) then ! use reference salinity in the mixed layer @@ -139,7 +139,7 @@ subroutine dense_water_initialize_TS(G, GV, param_file, eqn_of_state, T, S, h, j S(i,j,k) = S_ref + S_range * (zmid - mld) / (1.0 - mld) endif - zi = zi + h(i,j,k) / G%max_depth + zi = zi + h(i,j,k) / (GV%Z_to_H * G%max_depth) enddo enddo enddo @@ -225,16 +225,16 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A do j = G%jsc,G%jec do i = G%isc,G%iec - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k = nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then ! is this layer vanished? - eta1D(k) = eta1D(k+1) + GV%Angstrom_m + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_m else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_m * (eta1D(k) - eta1D(k+1)) endif enddo enddo @@ -253,7 +253,7 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A x = (G%geoLonT(i,j) - G%west_lon) / G%len_lon do k = 1,nz ! nondimensional middle of layer - zmid = zi + 0.5 * h(i,j,k) / G%max_depth + zmid = zi + 0.5 * h(i,j,k) / (GV%Z_to_m * G%max_depth) if (x > (1. - east_sponge_width)) then !if (zmid >= 0.9 * sill_height) & @@ -264,7 +264,7 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A S(i,j,k) = S_ref + S_range * (zmid - mld) / (1.0 - mld) endif - zi = zi + h(i,j,k) / G%max_depth + zi = zi + h(i,j,k) / (GV%Z_to_m * G%max_depth) enddo enddo enddo diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 7acf5c09af..51a0776900 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -55,12 +55,12 @@ subroutine dumbbell_initialize_topography ( D, G, param_file, max_depth ) dblen=dblen*1.e3 endif - do i=G%isc,G%iec + do i=G%isc,G%iec do j=G%jsc,G%jec ! Compute normalized zonal coordinates (x,y=0 at center of domain) x = ( G%geoLonT(i,j) ) / dblen y = ( G%geoLatT(i,j) ) / G%len_lat - D(i,j)=G%max_depth + D(i,j) = G%max_depth if ((x>=-0.25 .and. x<=0.25) .and. (y <= -0.5*dbfrac .or. y >= 0.5*dbfrac)) then D(i,j) = 0.0 endif @@ -80,10 +80,10 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), usually + ! negative because it is positive upward. + real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface + ! positive upward, in depth units (Z). integer :: i, j, k, is, ie, js, je, nz real :: x real :: delta_h @@ -98,10 +98,10 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param if (.not.just_read) & call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness") - call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & + call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & 'Minimum thickness for layer',& units='m', default=1.0e-3, do_not_log=just_read) - call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & + call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) ! WARNING: this routine specifies the interface heights so that the last layer @@ -134,34 +134,36 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param ! Equating: z/max_depth = - ( S_light - S_surf + (K-3/2)/(nz-1) * (S_dense - S_light) ) / S_range e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * & ( (real(K)-1.5) / real(nz-1) ) ) / S_range - e0(K) = nint(2048.*e0(K))/2048. ! Force round numbers ... the above expression has irrational factors ... - e0(K) = min(real(1-K)*GV%Angstrom_m, e0(K)) ! Bound by surface + ! Force round numbers ... the above expression has irrational factors ... + e0(K) = nint(2048.*GV%Z_to_m*e0(K)) / (2048.*GV%Z_to_m) + e0(K) = min(real(1-K)*GV%Angstrom_Z, e0(K)) ! Bound by surface e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom enddo do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_m - h(i,j,k) = GV%Angstrom_m + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo case ( REGRIDDING_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. + min_thickness = GV%m_to_Z * min_thickness do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness h(i,j,k) = min_thickness else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo @@ -169,7 +171,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - h(i,j,:) = G%Zd_to_m * G%bathyT(i,j) / dfloat(nz) + h(i,j,:) = GV%Z_to_m * G%bathyT(i,j) / dfloat(nz) enddo ; enddo end select @@ -278,7 +280,7 @@ subroutine dumbbell_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp units="s", default=0.) call get_param(param_file, mdl, "DUMBBELL_SREF", S_ref, do_not_log=.true.) call get_param(param_file, mdl, "DUMBBELL_S_RANGE", S_range, do_not_log=.true.) - call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & + call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & 'Minimum thickness for layer',& units='m', default=1.0e-3, do_not_log=.true.) @@ -304,14 +306,14 @@ subroutine dumbbell_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp if (use_ALE) then ! construct a uniform grid for the sponge do j=G%jsc,G%jec ; do i=G%isc,G%iec - eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) + eta1D(nz+1) = -GV%Z_to_m * G%bathyT(i,j) do k=nz,1,-1 - eta1D(k) = -G%max_depth * real(k-1) / real(nz) + eta1D(k) = -GV%Z_to_m*G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness h(i,j,k) = min_thickness else - h(i,j,k) = eta1D(k) - eta1D(k+1) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo diff --git a/src/user/external_gwave_initialization.F90 b/src/user/external_gwave_initialization.F90 index 0882eb510f..139f4c1945 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -29,12 +29,8 @@ subroutine external_gwave_initialize_thickness(h, G, GV, param_file, just_read_p logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(G)) ! The resting interface heights, in m, usually - ! negative because it is positive upward. - real :: e_pert(SZK_(G)) ! Interface height perturbations, positive - ! upward, in m. real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in m. + ! positive upward, in depth units (Z). real :: ssh_anomaly_height ! Vertical height of ssh anomaly real :: ssh_anomaly_width ! Lateral width of anomaly logical :: just_read ! If true, just read parameters but set nothing. @@ -62,6 +58,7 @@ subroutine external_gwave_initialize_thickness(h, G, GV, param_file, just_read_p if (just_read) return ! All run-time parameters have been read, so return. PI = 4.0*atan(1.0) + ssh_anomaly_height = GV%m_to_Z*ssh_anomaly_height do j=G%jsc,G%jec ; do i=G%isc,G%iec Xnondim = (G%geoLonT(i,j)-G%west_lon-0.5*G%len_lon) / ssh_anomaly_width Xnondim = min(1., abs(Xnondim)) @@ -72,7 +69,7 @@ subroutine external_gwave_initialize_thickness(h, G, GV, param_file, just_read_p enddo eta1D(nz+1) = -G%max_depth ! Force bottom interface to bottom do k=1,nz - h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) enddo enddo ; enddo diff --git a/src/user/lock_exchange_initialization.F90 b/src/user/lock_exchange_initialization.F90 index 3c48bc9b9a..b4bb1e296f 100644 --- a/src/user/lock_exchange_initialization.F90 +++ b/src/user/lock_exchange_initialization.F90 @@ -66,26 +66,29 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, param_file, just_read_pa if (just_read) return ! All run-time parameters have been read, so return. + thermocline_thickness = GV%m_to_Z*thermocline_thickness + front_displacement = GV%m_to_Z*front_displacement + do j=G%jsc,G%jec ; do i=G%isc,G%iec do k=2,nz eta1D(K) = -0.5 * G%max_depth & ! Middle of column - thermocline_thickness * ( (real(k-1))/real(nz) -0.5 ) ! Stratification if (G%geoLonT(i,j)-G%west_lon < 0.5 * G%len_lon) then - eta1D(K)=eta1D(K) + 0.5 * front_displacement + eta1D(K) = eta1D(K) + 0.5 * front_displacement elseif (G%geoLonT(i,j)-G%west_lon > 0.5 * G%len_lon) then - eta1D(K)=eta1D(K) - 0.5 * front_displacement + eta1D(K) = eta1D(K) - 0.5 * front_displacement endif enddo eta1D(nz+1) = -G%max_depth ! Force bottom interface to bottom do k=nz,2,-1 ! Make sure interfaces increase upwards - eta1D(K) = max( eta1D(K), eta1D(K+1) + GV%Angstrom_m ) + eta1D(K) = max( eta1D(K), eta1D(K+1) + GV%Angstrom_Z ) enddo eta1D(1) = 0. ! Force bottom interface to bottom do k=2,nz ! Make sure interfaces decrease downwards - eta1D(K) = min( eta1D(K), eta1D(K-1) - GV%Angstrom_m ) + eta1D(K) = min( eta1D(K), eta1D(K-1) - GV%Angstrom_Z ) enddo do k=nz,1,-1 - h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) enddo enddo ; enddo diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 5f6e66d5be..f4411f749d 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -135,34 +135,36 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param ! Equating: z/max_depth = - ( S_light - S_surf + (K-3/2)/(nz-1) * (S_dense - S_light) ) / S_range e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * & ( (real(K)-1.5) / real(nz-1) ) ) / S_range - e0(K) = nint(2048.*e0(K))/2048. ! Force round numbers ... the above expression has irrational factors ... - e0(K) = min(real(1-K)*GV%Angstrom_m, e0(K)) ! Bound by surface + ! Force round numbers ... the above expression has irrational factors ... + e0(K) = nint(2048.*GV%Z_to_m*e0(K))/(2048.*GV%Z_to_m) + e0(K) = min(real(1-K)*GV%Angstrom_Z, e0(K)) ! Bound by surface e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom enddo do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_m)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_m + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo case ( REGRIDDING_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. + min_thickness = min_thickness * GV%m_to_Z do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%Zd_to_m * G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = GV%m_to_H * min_thickness + h(i,j,k) = GV%Z_to_H * min_thickness else - h(i,j,k) = GV%m_to_H * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo @@ -248,7 +250,7 @@ subroutine seamount_initialize_temperature_salinity ( T, S, h, G, GV, param_file do j=js,je ; do i=is,ie xi0 = 0.0 do k = 1,nz - xi1 = xi0 + GV%H_to_m * h(i,j,k) / G%max_depth + xi1 = xi0 + GV%H_to_Z * h(i,j,k) / G%max_depth select case ( trim(density_profile) ) case ('linear') !S(i,j,k) = S_surf + S_range * 0.5 * (xi0 + xi1) diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index 1237ae3c14..4340d9dcda 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -109,7 +109,7 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param t = - z_unif(k) - z_inter(k) = -t * (G%max_depth * GV%m_to_Z) + z_inter(k) = -t * G%max_depth enddo @@ -217,7 +217,7 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file do j=js,je ; do i=is,ie xi0 = 0.0 do k = 1,nz - xi1 = xi0 + deltah / G%max_depth + xi1 = xi0 + deltah / G%max_depth ! = xi0 + 1.0 / real(nz) S(i,j,k) = 34.0 + 0.5 * S_range * (xi0 + xi1) xi0 = xi1 enddo From 9c8b3c5da1a306d9c71cc2d80f268724d580586c Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 29 Aug 2018 11:15:46 -0600 Subject: [PATCH 0677/1072] Comment DEBUG message --- config_src/mct_driver/ocn_comp_mct.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 7608ef4579..97692ccc65 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -310,7 +310,7 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) glb%grid => glb%ocn_state%grid ! Allocate IOB data type (needs to be called after glb%grid is set) - write(6,*)'DEBUG: isc,iec,jsc,jec= ',glb%grid%isc, glb%grid%iec, glb%grid%jsc, glb%grid%jec + !write(6,*)'DEBUG: isc,iec,jsc,jec= ',glb%grid%isc, glb%grid%iec, glb%grid%jsc, glb%grid%jec call IOB_allocate(ice_ocean_boundary, glb%grid%isc, glb%grid%iec, glb%grid%jsc, glb%grid%jec) call t_stopf('MOM_init') From f1445de5f63d7efc4bec528c634a914580dffe16 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 29 Aug 2018 11:16:57 -0600 Subject: [PATCH 0678/1072] Add option to use melt potential in mct and couple_driver --- config_src/coupled_driver/ocean_model_MOM.F90 | 22 +++++++++++++-- config_src/mct_driver/MOM_ocean_model.F90 | 27 ++++++++++++++++--- 2 files changed, 43 insertions(+), 6 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index a09a5bfe29..595848e948 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -240,6 +240,12 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) ! 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. @@ -342,8 +348,20 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) ! 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) + 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"//& + "melt potential will not be computed.", units="m", default=-1.0, do_not_log=.true.) + + if (HFrz .gt. 0.0) then + use_melt_pot=.true. + else + 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) call surface_forcing_init(Time_in, OS%grid, param_file, OS%diag, & OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 9971747afd..1658002d38 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -243,9 +243,15 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! 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, in kg m-3. - real :: G_Earth !< The gravitational acceleration in m s-2. - !! This include declares and sets the variable "version". + real :: Rho0 !< The Boussinesq ocean density, in kg m-3. + real :: G_Earth !< The gravitational acceleration in 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. + logical :: use_melt_pot!< If true, allocate melt_potential array + #include "version_variable.h" character(len=40) :: mdl = "ocean_model_init" !< This module's name. character(len=48) :: stagger @@ -338,8 +344,21 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! 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 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"//& + "melt potential will not be computed.", units="m", default=-1.0, do_not_log=.true.) + + if (HFrz .gt. 0.0) then + use_melt_pot=.true. + else + 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=.true.) + gas_fields_ocn=gas_fields_ocn, use_meltpot=use_melt_pot) call surface_forcing_init(Time_in, OS%grid, param_file, OS%diag, & OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) From d3d8215bdc8de686f210fa8248f62ea40a9a7874 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 29 Aug 2018 11:19:06 -0600 Subject: [PATCH 0679/1072] Add a new implementation for the melt potential calculation --- src/core/MOM.F90 | 58 ++++++++++++++++++++++++++++++++++++------------ 1 file changed, 44 insertions(+), 14 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index dbe20bd861..185413fc88 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -275,6 +275,10 @@ module MOM !! average surface tracer properties (in meter) when !! bulk mixed layer is not used, or a negative value !! if a bulk mixed layer is being used. + real :: HFrz !< If HFrz > 0, 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. real :: Hmix_UV !< Depth scale over which to average surface flow to !! feedback to the coupler/driver (m) when !! bulk mixed layer is not used, or a negative value @@ -1757,6 +1761,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "SSU, SSV. A non-positive value indicates no averaging.", & units="m", default=0.) endif + call get_param(param_file, "MOM", "HFREEZE", CS%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"//& + "melt potential will not be computed.", units="m", default=-1.0) call get_param(param_file, "MOM", "MIN_Z_DIAG_INTERVAL", Z_diag_int, & "The minimum amount of time in seconds between \n"//& "calculations of depth-space diagnostics. Making this \n"//& @@ -2673,6 +2682,7 @@ subroutine extract_surface_state(CS, sfc_state) real :: dh !< thickness of a layer within mixed layer (meter) real :: mass !< mass per unit area of a layer (kg/m2) real :: T_freeze !< freezing temperature (oC) + real :: delT(SZI_(CS%G)) !< T-T_freeze (oC) logical :: use_temperature !< If true, temp and saln used as state variables. integer :: i, j, k, is, ie, js, je, nz, numberOfErrors integer :: isd, ied, jsd, jed @@ -2831,21 +2841,41 @@ subroutine extract_surface_state(CS, sfc_state) endif endif ! (CS%Hmix >= 0.0) + if (allocated(sfc_state%melt_potential)) then - !$OMP parallel do default(shared) - do j=js,je ; do i=is,ie - ! set melt_potential to zero to avoid passing values set previously - if (G%mask2dT(i,j)>0.) then - ! calculate freezing pot. temp. @ surface - call calculate_TFreeze(sfc_state%SSS(i,j), 0.0, T_freeze, CS%tv%eqn_of_state) - ! time accumulated melt_potential, in J/m^2 - sfc_state%melt_potential(i,j) = sfc_state%melt_potential(i,j) + (CS%tv%C_p * CS%GV%Rho0 * & - (sfc_state%SST(i,j) - T_freeze) * CS%Hmix) - else - sfc_state%melt_potential(i,j) = 0.0 - endif! G%mask2dT - enddo ; enddo - endif + !$OMP parallel do default(shared) + do j=js,je + do i=is,ie + depth(i) = 0.0 + delT(i) = 0.0 + enddo + + do k=1,nz ; do i=is,ie + depth_ml = min(CS%HFrz,CS%visc%MLD(i,j)) + if (depth(i) + h(i,j,k)*GV%H_to_m < depth_ml) then + dh = h(i,j,k)*GV%H_to_m + elseif (depth(i) < depth_ml) then + dh = depth_ml - depth(i) + else + dh = 0.0 + endif + + ! p=0 OK, HFrz ~ 10 to 20m + call calculate_TFreeze(CS%tv%S(i,j,k), 0.0, T_freeze, CS%tv%eqn_of_state) + depth(i) = depth(i) + dh + delT(i) = delT(i) + dh * (CS%tv%T(i,j,k) - T_freeze) + enddo ; enddo + + do i=is,ie + if (G%mask2dT(i,j)>0.) then + ! time accumulated melt_potential, in J/m^2 + sfc_state%melt_potential(i,j) = sfc_state%melt_potential(i,j) + (CS%tv%C_p * CS%GV%Rho0 * delT(i)) + else + sfc_state%melt_potential(i,j) = 0.0 + endif! G%mask2dT + enddo + enddo ! end of j loop + endif ! melt_potential if (allocated(sfc_state%salt_deficit) .and. associated(CS%tv%salt_deficit)) then !$OMP parallel do default(shared) From ddccc44c90b738df18929120b20eafc029b1ae14 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 29 Aug 2018 11:20:10 -0600 Subject: [PATCH 0680/1072] Copy OBLD to visc%MLD when using KPP --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 8a16e79ecd..4958b957ae 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -615,6 +615,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (associated(Hml)) then call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G) call pass_var(Hml, G%domain, halo=1) + ! If visc%MLD exists, copy KPP's BLD into it + if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) endif call cpu_clock_end(id_clock_kpp) @@ -1532,6 +1534,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (associated(Hml)) then call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G) call pass_var(Hml, G%domain, halo=1) + ! If visc%MLD exists, copy KPP's BLD into it + if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) endif if (.not. CS%KPPisPassive) then From d32386dc522ab8f0daa6e5d9583d53409d29de50 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 29 Aug 2018 11:21:10 -0600 Subject: [PATCH 0681/1072] Allocates visc%MLD when hfreeze >= 0.0 --- src/parameterizations/vertical/MOM_set_viscosity.F90 | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 31dfb89cb8..035849b37f 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1723,6 +1723,7 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) logical :: adiabatic, useKPP, useEPBL logical :: use_CVMix_shear, MLE_use_PBL_MLD, use_CVMix_conv integer :: isd, ied, jsd, jed, nz + real :: hfreeze !< If hfreeze > 0 (m), melt potential will be computed. character(len=40) :: mdl = "MOM_set_visc" ! This module's name. isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke @@ -1779,15 +1780,24 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) "Vertical turbulent viscosity at interfaces due to slow processes", & "m2 s-1", z_grid='i') - ! visc%MLD is used to communicate the state of the (e)PBL to the rest of the model + ! visc%MLD is used to communicate the state of the (e)PBL or KPP to the rest of the model call get_param(param_file, mdl, "MLE_USE_PBL_MLD", MLE_use_PBL_MLD, & default=.false., do_not_log=.true.) + ! visc%MLD needs to be allocated when melt potential is computed (HFREEZE>0) + call get_param(param_file, mdl, "HFREEZE", hfreeze, & + default=-1.0, do_not_log=.true.) + if (MLE_use_PBL_MLD) then call safe_alloc_ptr(visc%MLD, isd, ied, jsd, jed) call register_restart_field(visc%MLD, "MLD", .false., restart_CS, & "Instantaneous active mixing layer depth", "m") endif + if (hfreeze >= 0.0 .and. .not.MLE_use_PBL_MLD) then + call safe_alloc_ptr(visc%MLD, isd, ied, jsd, jed) + endif + + end subroutine set_visc_register_restarts !> Initializes the MOM_set_visc control structure From b4e8fe21e7b7fc45d7b6f26f9344116cee350f7f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 30 Aug 2018 10:07:12 -0400 Subject: [PATCH 0682/1072] +Use interface heights in Z units in sponges Changed the MOM_sponge code to use interface heights in Z units instead of m, and added an optional vertical grid type argument to initalize_sponge. To supply this, several of the ..._initialize_sponges have a new GV argument. All answers are bitwise identical for no Z-rescaling or for rescaling by 2^93 or 2^-93, but there are interface changes in the optional argument lists to initialize_sponge and an argument added to several of the user sponge initialization routines that call it. --- .../MOM_state_initialization.F90 | 33 ++--- src/parameterizations/vertical/MOM_sponge.F90 | 58 +++++---- src/user/BFB_initialization.F90 | 34 ++--- src/user/DOME2d_initialization.F90 | 37 +++--- src/user/DOME_initialization.F90 | 23 ++-- src/user/ISOMIP_initialization.F90 | 119 +++++++++--------- src/user/Phillips_initialization.F90 | 32 ++--- src/user/user_initialization.F90 | 54 ++++---- 8 files changed, 202 insertions(+), 188 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index a9745c0064..30d6c88ab6 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -523,19 +523,17 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & case ("DOME2D"); call DOME2d_initialize_sponges(G, GV, tv, PF, useALE, & sponge_CSp, ALE_sponge_CSp) case ("ISOMIP"); call ISOMIP_initialize_sponges(G, GV, tv, PF, useALE, & - sponge_CSp, ALE_sponge_CSp) - case ("USER"); call user_initialize_sponges(G, use_temperature, tv, & - PF, sponge_CSp, h) - case ("BFB"); call BFB_initialize_sponges_southonly(G, use_temperature, tv, & - PF, sponge_CSp, h) - case ("DUMBBELL"); call dumbbell_initialize_sponges(G, GV, tv, & - PF, useALE, sponge_CSp, ALE_sponge_CSp) - case ("phillips"); call Phillips_initialize_sponges(G, use_temperature, tv, & - PF, sponge_CSp, h) + sponge_CSp, ALE_sponge_CSp) + case ("USER"); call user_initialize_sponges(G, GV, use_temperature, tv, PF, sponge_CSp, h) + case ("BFB"); call BFB_initialize_sponges_southonly(G, GV, use_temperature, tv, PF, & + sponge_CSp, h) + case ("DUMBBELL"); call dumbbell_initialize_sponges(G, GV, tv, PF, useALE, & + sponge_CSp, ALE_sponge_CSp) + case ("phillips"); call Phillips_initialize_sponges(G, GV, tv, PF, sponge_CSp, h) case ("dense"); call dense_water_initialize_sponges(G, GV, tv, PF, useALE, & - sponge_CSp, ALE_sponge_CSp) - case ("file"); call initialize_sponges_file(G, GV, use_temperature, tv, & - PF, sponge_CSp, ALE_sponge_CSp, Time) + sponge_CSp, ALE_sponge_CSp) + case ("file"); call initialize_sponges_file(G, GV, use_temperature, tv, PF, & + sponge_CSp, ALE_sponge_CSp, Time) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized sponge configuration "//trim(config)) end select @@ -1752,17 +1750,20 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, if (.not. use_ALE) then allocate(eta(isd:ied,jsd:jed,nz+1)) call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) + if (GV%m_to_Z /= 1.0) then ; do k=1,nz+1 ; do j=js,je ; do i=is,ie + eta(i,j,k) = GV%m_to_Z*eta(i,j,k) + enddo ; enddo ; enddo ; endif do j=js,je ; do i=is,ie - eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta(i,j,nz+1) = -G%bathyT(i,j) enddo ; enddo do k=nz,1,-1 ; do j=js,je ; do i=is,ie - if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_m)) & - eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_m + if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) & + eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_Z enddo ; enddo ; enddo ! Set the inverse damping rates so that the model will know where to ! apply the sponges, along with the interface heights. - call initialize_sponge(Idamp, eta, G, param_file, CSp) + call initialize_sponge(Idamp, eta, G, param_file, CSp, GV) deallocate(eta) elseif (.not. new_sponges) then ! ALE mode diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index 77a2d109d6..70f7a9216d 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -53,7 +53,8 @@ module MOM_sponge real, pointer :: Rcv_ml_ref(:) => NULL() !< The value toward which the mixed layer !! coordinate-density is being damped, in kg m-3. real, pointer :: Ref_eta(:,:) => NULL() !< The value toward which the interface - !! heights are being damped, in m. + !! heights are being damped, in depth units (Z). + real :: eta_Z_to_m !< The conversion factor between the units for depths (Z) and m. type(p3d) :: var(MAX_FIELDS_) !< Pointers to the fields that are being damped. type(p2d) :: Ref_val(MAX_FIELDS_) !< The values to which the fields are damped. @@ -63,7 +64,7 @@ module MOM_sponge real, pointer :: Rcv_ml_ref_im(:) => NULL() !! The value toward which the i-mean !< mixed layer coordinate-density is being damped, in kg m-3. real, pointer :: Ref_eta_im(:,:) => NULL() !< The value toward which the i-mean - !! interface heights are being damped, in m. + !! interface heights are being damped, in depth units (Z). type(p2d) :: Ref_val_im(MAX_FIELDS_) !< The values toward which the i-means of !! fields are damped. @@ -79,22 +80,24 @@ module MOM_sponge !! positive values of Iresttime and which mask2dT indicates are ocean !! points are included in the sponges. It also stores the target interface !! heights. -subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, & +subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & Iresttime_i_mean, int_height_i_mean) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: Iresttime !< The inverse of the restoring time, in s-1. + intent(in) :: Iresttime !< The inverse of the restoring time, in s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - intent(in) :: int_height !< The interface heights to damp back toward, in m. - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(sponge_CS), pointer :: CS !< A pointer that is set to point to the control - !! structure for this module + intent(in) :: int_height !< The interface heights to damp back toward, in depth units (Z). + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(sponge_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module + type(verticalGrid_type), & + optional, intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZJ_(G)), & - optional, intent(in) :: Iresttime_i_mean !< The inverse of the restoring time for - !! the zonal mean properties, in s-1. + optional, intent(in) :: Iresttime_i_mean !< The inverse of the restoring time for + !! the zonal mean properties, in s-1. real, dimension(SZJ_(G),SZK_(G)+1), & - optional, intent(in) :: int_height_i_mean !< The interface heights toward which to - !! damp the zonal mean heights, in m. + optional, intent(in) :: int_height_i_mean !< The interface heights toward which to + !! damp the zonal mean heights, in depth units (Z). ! This include declares and sets the variable "version". @@ -132,6 +135,8 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, & ! CS%bulkmixedlayer may be set later via a call to set_up_sponge_ML_density. CS%bulkmixedlayer = .false. + CS%eta_Z_to_m = 1.0 ; if (present(GV)) CS%eta_Z_to_m = GV%Z_to_m + CS%num_col = 0 ; CS%fldno = 0 do j=G%jsc,G%jec ; do i=G%isc,G%iec if ((Iresttime(i,j)>0.0) .and. (G%mask2dT(i,j)>0)) & @@ -342,11 +347,11 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) ! at the surface, in the same units as G%bathyT (m or Z). real, dimension(SZI_(G), SZJ_(G)) :: & eta_anom, & ! Anomalies in the interface height, relative to the i-mean - ! target value, in m. + ! target value, in depth units (Z). fld_anom ! Anomalies in a tracer concentration, relative to the ! i-mean target value. real, dimension(SZJ_(G), SZK_(G)+1) :: & - eta_mean_anom ! The i-mean interface height anomalies, in m. + eta_mean_anom ! The i-mean interface height anomalies, in Z. real, allocatable, dimension(:,:,:) :: & fld_mean_anom ! THe i-mean tracer concentration anomalies. real, dimension(SZI_(G), SZK_(G)+1) :: & @@ -356,8 +361,8 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) dilate ! A nondimensional factor by which to dilate layers to ! give 0 at the surface. - real :: e(SZK_(G)+1) ! The interface heights, in m, usually negative. - real :: e0 ! The height of the free surface in m. + real :: e(SZK_(G)+1) ! The interface heights, in Z, usually negative. + real :: e0 ! The height of the free surface in Z. real :: e_str ! A nondimensional amount by which the reference ! profile must be stretched for the free surfaces ! heights in the two profiles to agree. @@ -380,6 +385,9 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) call MOM_error(FATAL, "Rml must be provided to apply_sponge when using "//& "a bulk mixed layer.") + if (CS%eta_Z_to_m /= GV%Z_to_m) call MOM_error(FATAL, & + "There are inconsistent depth units between calls to set_up_sponge and apply_sponge.") + if ((CS%id_w_sponge > 0) .or. CS%do_i_mean_sponge) then do k=1,nz+1 ; do j=js,je ; do i=is,ie w_int(i,j,K) = 0.0 @@ -407,8 +415,8 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) do k=2,nz do j=js,je ; do i=is,ie - eta_anom(i,j) = e_D(i,j,k)*G%Zd_to_m - CS%Ref_eta_im(j,k) - if (CS%Ref_eta_im(j,K) < -G%bathyT(i,j)*G%Zd_to_m) eta_anom(i,j) = 0.0 + eta_anom(i,j) = e_D(i,j,k) - CS%Ref_eta_im(j,k) + if (CS%Ref_eta_im(j,K) < -G%bathyT(i,j)) eta_anom(i,j) = 0.0 enddo ; enddo call global_i_mean(eta_anom(:,:), eta_mean_anom(:,K), G) enddo @@ -436,7 +444,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) do K=2,nz ! w is positive for an upward (lightward) flux of mass, resulting ! in the downward movement of an interface. - w = damp_1pdamp * eta_mean_anom(j,K) * GV%m_to_H + w = damp_1pdamp * eta_mean_anom(j,K) * GV%Z_to_H do i=is,ie if (w > 0.0) then w_int(i,j,K) = min(w, h_below(i,K)) @@ -474,7 +482,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) e(1) = 0.0 ; e0 = 0.0 do K=1,nz - e(K+1) = e(K) - h(i,j,k)*GV%H_to_m + e(K+1) = e(K) - h(i,j,k)*GV%H_to_Z enddo e_str = e(nz+1) / CS%Ref_eta(nz+1,c) @@ -492,7 +500,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) wpb = 0.0; wb = 0.0 do k=nz,nkmb+1,-1 if (GV%Rlay(k) > Rcv_ml(i,j)) then - w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*GV%m_to_H, & + w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*GV%Z_to_H, & ((wb + h(i,j,k)) - GV%Angstrom_H)) wm = 0.5*(w-ABS(w)) do m=1,CS%fldno @@ -548,7 +556,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) wpb = 0.0 wb = 0.0 do k=nz,1,-1 - w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*GV%m_to_H, & + w = MIN((((e(K)-e0) - e_str*CS%Ref_eta(K,c)) * damp)*GV%Z_to_H, & ((wb + h(i,j,k)) - GV%Angstrom_H)) wm = 0.5*(w - ABS(w)) do m=1,CS%fldno @@ -568,9 +576,9 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) if (associated(CS%diag)) then ; if (query_averaging_enabled(CS%diag)) then if (CS%id_w_sponge > 0) then - Idt = 1.0 / dt + Idt = GV%H_to_m / dt do k=1,nz+1 ; do j=js,je ; do i=is,ie - w_int(i,j,K) = w_int(i,j,K) * Idt * GV%H_to_m ! Scale values by clobbering array since it is local + w_int(i,j,K) = w_int(i,j,K) * Idt ! Scale values by clobbering array since it is local enddo ; enddo ; enddo call post_data(CS%id_w_sponge, w_int(:,:,:), CS%diag) endif diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 76d3484563..20cf21f07b 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -70,19 +70,18 @@ end subroutine BFB_set_coord !> This subroutine sets up the sponges for the southern bouundary of the domain. Maximum damping occurs !! within 2 degrees lat of the boundary. The damping linearly decreases northward over the next 2 degrees. -subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, CSp, h) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - logical, intent(in) :: use_temperature !< If true, temperature and salinity are used as +subroutine BFB_initialize_sponges_southonly(G, GV, use_temperature, tv, param_file, CSp, h) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + logical, intent(in) :: use_temperature !< If true, temperature and salinity are used as !! state variables. - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(sponge_CS), pointer :: CSp !< A pointer to the sponge control structure + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(sponge_CS), pointer :: CSp !< A pointer to the sponge control structure real, dimension(NIMEM_, NJMEM_, NKMEM_), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - !call MOM_error(FATAL, & - ! "BFB_initialization.F90, BFB_initialize_sponges: " // & - ! "Unmodified user routine called - you must edit the routine to use it") + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + ! Local variables real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta. real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. @@ -105,6 +104,7 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, ! Set up sponges for DOME configuration call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0) + min_depth = GV%m_to_Z*min_depth call get_param(param_file, mdl, "SOUTHLAT", slat, & "The southern latitude of the domain.", units="degrees") @@ -115,7 +115,7 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, call get_param(param_file, mdl, "LENLON", lenlon, & "The longitudinal length of the domain.", units="degrees") nlat = slat + lenlat - do k=1,nz ; H0(k) = -G%Zd_to_m*G%max_depth * real(k-1) / real(nz) ; enddo + do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz) ; enddo ! Use for meridional thickness profile initialization ! do k=1,nz ; H0(k) = -G%Zd_to_m*G%max_depth * real(k-1) / real(nz-1) ; enddo @@ -137,24 +137,24 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, ! do k = 1,nz; eta(i,j,k) = H0(k); enddo ! if (G%geoLatT(i,j) > 40.0) then ! do k = 1,nz - ! eta(i,j,k) = -G%Angstrom_m*(k-1) + ! eta(i,j,k) = -G%Angstrom_Z*(k-1) ! enddo ! elseif (G%geoLatT(i,j) > 20.0) then ! do k = 1,nz - ! eta(i,j,k) = min(H0(k) + (G%geoLatT(i,j) - 20.0)*(GV%Z_to_m*G%max_depth - nz*G%Angstrom_m)/20.0, & - ! -(k-1)*G%Angstrom_m) + ! eta(i,j,k) = min(H0(k) + (G%geoLatT(i,j) - 20.0)*(G%max_depth - nz*G%Angstrom_Z)/20.0, & + ! -(k-1)*G%Angstrom_Z) ! enddo ! endif - eta(i,j,nz+1) = -G%Zd_to_m*G%max_depth + eta(i,j,nz+1) = -G%max_depth - if (G%Zd_to_m*G%bathyT(i,j) > min_depth) then + if (G%bathyT(i,j) > min_depth) then Idamp(i,j) = damp/86400.0 else ; Idamp(i,j) = 0.0 ; endif enddo ; enddo ! This call sets up the damping rates and interface heights. ! This sets the inverse damping timescale fields in the sponges. ! - call initialize_sponge(Idamp, eta, G, param_file, CSp) + call initialize_sponge(Idamp, eta, G, param_file, CSp, GV) ! Now register all of the fields which are damped in the sponge. ! ! By default, momentum is advected vertically within the sponge, but ! diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index d5b789d266..1e0f34f9a0 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -364,10 +364,11 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. real :: S_ref, T_ref ! Reference salinity and temerature within surface layer real :: S_range, T_range ! Range of salinities and temperatures over the vertical - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface ! - ! positive upward, in m. + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), + ! usually negative because it is positive upward. + real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface + ! positive upward, in Z. + real :: d_eta(SZK_(G)) ! The layer thickness in a column, in Z. real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay real :: dome2d_west_sponge_time_scale, dome2d_east_sponge_time_scale real :: dome2d_west_sponge_width, dome2d_east_sponge_width @@ -467,44 +468,44 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) S(i,j,k) = 34.0 - 1.0 * (z/G%max_depth) if ( ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon < dome2d_west_sponge_width ) & S(i,j,k) = S_ref + S_range - z = z + 0.5 * GV%m_to_Z *h(i,j,k) ! Position of the interface k + z = z + 0.5 * GV%m_to_Z * h(i,j,k) ! Position of the interface k enddo enddo ; enddo if ( associated(tv%T) ) then - call set_up_ALE_sponge_field(T,G,tv%T,ACSp) + call set_up_ALE_sponge_field(T, G, tv%T, ACSp) endif if ( associated(tv%S) ) then - call set_up_ALE_sponge_field(S,G,tv%S,ACSp) + call set_up_ALE_sponge_field(S, G, tv%S, ACSp) endif else - ! Construct thicknesses to restore to + ! Construct interface heights to restore toward do j=js,je ; do i=is,ie eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 - eta1D(k) = -G%max_depth * real(k-1) / real(nz) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_m + eta1D(K) = -G%max_depth * real(k-1) / real(nz) + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_Z + d_eta(k) = GV%Angstrom_Z else - h(i,j,k) = GV%Z_to_m * (eta1D(k) - eta1D(k+1)) + d_eta(k) = (eta1D(K) - eta1D(K+1)) endif enddo x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - h(i,j,1:nz-1) = GV%Angstrom_m - h(i,j,nz) = dome2d_depth_bay * GV%Z_to_m*G%max_depth - (nz-1) * GV%Angstrom_m + do k=1,nz-1 ; d_eta(k) = GV%Angstrom_Z ; enddo + d_eta(nz) = dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_Z endif - eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta(i,j,nz+1) = -G%bathyT(i,j) do K=nz,1,-1 - eta(i,j,K) = eta(i,j,K+1) + h(i,j,k) + eta(i,j,K) = eta(i,j,K+1) + d_eta(k) enddo enddo ; enddo - call initialize_sponge(Idamp, eta, G, param_file, CSp) + call initialize_sponge(Idamp, eta, G, param_file, CSp, GV) endif diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 20cdfc388d..bcb6a83dd9 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -138,8 +138,8 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available - !! thermodynamic fields, including potential temperature and - !! salinity or mixed layer density. Absent fields have NULL ptrs. + !! thermodynamic fields, including potential temperature and + !! salinity or mixed layer density. Absent fields have NULL ptrs. type(param_file_type), intent(in) :: PF !< A structure indicating the open file to !! parse for model parameter values. type(sponge_CS), pointer :: CSp !< A pointer that is set to point to the control @@ -149,7 +149,7 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) real :: temp(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for other variables. ! real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. - real :: H0(SZK_(G)) + real :: H0(SZK_(G)) ! Interface heights in depth units (Z) real :: min_depth real :: damp, e_dense, damp_new character(len=40) :: mdl = "DOME_initialize_sponges" ! This subroutine's name. @@ -168,9 +168,10 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) ! Set up sponges for DOME configuration call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0) + min_depth = GV%m_to_Z * min_depth H0(1) = 0.0 - do k=2,nz ; H0(k) = -(real(k-1)-0.5)*(GV%Z_to_m*G%max_depth) / real(nz-1) ; enddo + do k=2,nz ; H0(k) = -(real(k-1)-0.5)*G%max_depth / real(nz-1) ; enddo do i=is,ie; do j=js,je if (G%geoLonT(i,j) < 100.0) then ; damp = 10.0 elseif (G%geoLonT(i,j) < 200.0) then @@ -190,23 +191,23 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) ! depth space for Boussinesq or non-Boussinesq models. eta(i,j,1) = 0.0 do k=2,nz -! eta(i,j,K)=max(H0(k), -G%Zd_to_m*G%bathyT(i,j), GV%Angstrom_m*(nz-k+1)-G%bathyT(i,j)) - e_dense = -G%Zd_to_m*G%bathyT(i,j) +! eta(i,j,K)=max(H0(k), -G%bathyT(i,j), GV%Angstrom_Z*(nz-k+1) - G%bathyT(i,j)) + e_dense = -G%bathyT(i,j) if (e_dense >= H0(k)) then ; eta(i,j,K) = e_dense else ; eta(i,j,K) = H0(k) ; endif - if (eta(i,j,K) < GV%Angstrom_m*(nz-k+1) - G%Zd_to_m*G%bathyT(i,j)) & - eta(i,j,K) = GV%Angstrom_m*(nz-k+1) - G%Zd_to_m*G%bathyT(i,j) + if (eta(i,j,K) < GV%Angstrom_Z*(nz-k+1) - G%bathyT(i,j)) & + eta(i,j,K) = GV%Angstrom_Z*(nz-k+1) - G%bathyT(i,j) enddo - eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta(i,j,nz+1) = -G%bathyT(i,j) - if (G%Zd_to_m*G%bathyT(i,j) > min_depth) then + if (G%bathyT(i,j) > min_depth) then Idamp(i,j) = damp/86400.0 else ; Idamp(i,j) = 0.0 ; endif enddo ; enddo ! This call sets up the damping rates and interface heights. ! This sets the inverse damping timescale fields in the sponges. ! - call initialize_sponge(Idamp, eta, G, PF, CSp) + call initialize_sponge(Idamp, eta, G, PF, CSp, GV) ! Now register all of the fields which are damped in the sponge. ! ! By default, momentum is advected vertically within the sponge, but ! diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 5376dcca21..0ace62ddc0 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -472,32 +472,32 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0) - if (associated(CSp)) call MOM_error(FATAL, & - "ISOMIP_initialize_sponges called with an associated control structure.") - if (associated(ACSp)) call MOM_error(FATAL, & - "ISOMIP_initialize_sponges called with an associated ALE-sponge control structure.") + if (associated(CSp)) call MOM_error(FATAL, & + "ISOMIP_initialize_sponges called with an associated control structure.") + if (associated(ACSp)) call MOM_error(FATAL, & + "ISOMIP_initialize_sponges called with an associated ALE-sponge control structure.") ! Here the inverse damping time, in s-1, is set. Set Idamp to 0 ! ! wherever there is no sponge, and the subroutines that are called ! ! will automatically set up the sponges only where Idamp is positive! ! and mask2dT is 1. - do i=is,ie; do j=js,je - if (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then + do i=is,ie; do j=js,je + if (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then ! 1 / day - dummy1=(G%geoLonT(i,j)-790.0)/(800.0-790.0) - damp = 1.0/TNUDG * max(0.0,dummy1) + dummy1=(G%geoLonT(i,j)-790.0)/(800.0-790.0) + damp = 1.0/TNUDG * max(0.0,dummy1) - else ; damp=0.0 - endif + else ; damp=0.0 + endif ! convert to 1 / seconds - if (G%Zd_to_m * G%bathyT(i,j) > min_depth) then - Idamp(i,j) = damp/86400.0 - else ; Idamp(i,j) = 0.0 ; endif + if (G%Zd_to_m * G%bathyT(i,j) > min_depth) then + Idamp(i,j) = damp/86400.0 + else ; Idamp(i,j) = 0.0 ; endif - enddo ; enddo + enddo ; enddo ! Compute min/max density using T_SUR/S_SUR and T_BOT/S_BOT call calculate_density(t_sur,s_sur,0.0,rho_sur,tv%eqn_of_state) @@ -601,50 +601,53 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) endif else ! layer mode - ! 1) Read eta, salt and temp from IC file - call get_param(PF, mdl, "INPUTDIR", inputdir, default=".") - inputdir = slasher(inputdir) - ! GM: get two different files, one with temp and one with salt values - ! this is work around to avoid having wrong values near the surface - ! because of the FIT_SALINITY option. To get salt values right in the - ! sponge, FIT_SALINITY=False. The oposite is true for temp. One can - ! combined the *correct* temp and salt values in one file instead. - call get_param(PF, mdl, "ISOMIP_SPONGE_FILE", state_file, & - "The name of the file with temps., salts. and interfaces to \n"// & - " damp toward.", fail_if_missing=.true.) - call get_param(PF, mdl, "SPONGE_PTEMP_VAR", temp_var, & - "The name of the potential temperature variable in \n"//& - "SPONGE_STATE_FILE.", default="Temp") - call get_param(PF, mdl, "SPONGE_SALT_VAR", salt_var, & - "The name of the salinity variable in \n"//& - "SPONGE_STATE_FILE.", default="Salt") - call get_param(PF, mdl, "SPONGE_ETA_VAR", eta_var, & - "The name of the interface height variable in \n"//& - "SPONGE_STATE_FILE.", default="eta") - - !read temp and eta - filename = trim(inputdir)//trim(state_file) - if (.not.file_exists(filename, G%Domain)) & - call MOM_error(FATAL, " ISOMIP_initialize_sponges: Unable to open "//trim(filename)) - call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) - call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain) - call MOM_read_data(filename, salt_var, S(:,:,:), G%Domain) - - ! for debugging - !i=G%iec; j=G%jec - !do k = 1,nz - ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,tv%eqn_of_state) - ! write(mesg,*) 'Sponge - k,eta,T,S,rho,Rlay',k,eta(i,j,k),T(i,j,k),& - ! S(i,j,k),rho_tmp,GV%Rlay(k) - ! call MOM_mesg(mesg,5) - !enddo - - ! Set the inverse damping rates so that the model will know where to - ! apply the sponges, along with the interface heights. - call initialize_sponge(Idamp, eta, G, PF, CSp) - ! Apply sponge in tracer fields - call set_up_sponge_field(T, tv%T, G, nz, CSp) - call set_up_sponge_field(S, tv%S, G, nz, CSp) + ! 1) Read eta, salt and temp from IC file + call get_param(PF, mdl, "INPUTDIR", inputdir, default=".") + inputdir = slasher(inputdir) + ! GM: get two different files, one with temp and one with salt values + ! this is work around to avoid having wrong values near the surface + ! because of the FIT_SALINITY option. To get salt values right in the + ! sponge, FIT_SALINITY=False. The oposite is true for temp. One can + ! combined the *correct* temp and salt values in one file instead. + call get_param(PF, mdl, "ISOMIP_SPONGE_FILE", state_file, & + "The name of the file with temps., salts. and interfaces to \n"// & + "damp toward.", fail_if_missing=.true.) + call get_param(PF, mdl, "SPONGE_PTEMP_VAR", temp_var, & + "The name of the potential temperature variable in \n"//& + "SPONGE_STATE_FILE.", default="Temp") + call get_param(PF, mdl, "SPONGE_SALT_VAR", salt_var, & + "The name of the salinity variable in \n"//& + "SPONGE_STATE_FILE.", default="Salt") + call get_param(PF, mdl, "SPONGE_ETA_VAR", eta_var, & + "The name of the interface height variable in \n"//& + "SPONGE_STATE_FILE.", default="eta") + + !read temp and eta + filename = trim(inputdir)//trim(state_file) + if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & + "ISOMIP_initialize_sponges: Unable to open "//trim(filename)) + call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) + if (GV%m_to_Z /= 1.0) then ; do k=1,nz+1 ; do j=js,je ; do i=is,ie + eta(i,j,k) = GV%m_to_Z*eta(i,j,k) + enddo ; enddo ; enddo ; endif + call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain) + call MOM_read_data(filename, salt_var, S(:,:,:), G%Domain) + + ! for debugging + !i=G%iec; j=G%jec + !do k = 1,nz + ! call calculate_density(T(i,j,k),S(i,j,k),0.0,rho_tmp,tv%eqn_of_state) + ! write(mesg,*) 'Sponge - k,eta,T,S,rho,Rlay',k,eta(i,j,k),T(i,j,k),& + ! S(i,j,k),rho_tmp,GV%Rlay(k) + ! call MOM_mesg(mesg,5) + !enddo + + ! Set the inverse damping rates so that the model will know where to + ! apply the sponges, along with the interface heights. + call initialize_sponge(Idamp, eta, G, PF, CSp, GV) + ! Apply sponge in tracer fields + call set_up_sponge_field(T, tv%T, G, nz, CSp) + call set_up_sponge_field(S, tv%S, G, nz, CSp) endif diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 5832df78fc..5dfbb78914 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -28,7 +28,7 @@ module Phillips_initialization contains -!> Initialize thickness field. +!> Initialize the thickness field for the Phillips model test case. subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -109,7 +109,7 @@ subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) end subroutine Phillips_initialize_thickness -!> Initialize velocity fields. +!> Initialize the velocity fields for the Phillips model test case subroutine Phillips_initialize_velocity(u, v, G, GV, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -183,12 +183,12 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, param_file, just_read_param end subroutine Phillips_initialize_velocity -!> Sets up the the inverse restoration time (Idamp), and -! the values towards which the interface heights and an arbitrary -! number of tracers should be restored within each sponge. -subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, h) +!> Sets up the the inverse restoration time (Idamp), and the values towards which the interface +!! heights and an arbitrary number of tracers should be restored within each sponge for the Phillips +!! model test case +subroutine Phillips_initialize_sponges(G, GV, tv, param_file, CSp, h) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - logical, intent(in) :: use_temperature !< Switch for temperature. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers !! to any available thermodynamic !! fields, potential temperature and @@ -200,20 +200,21 @@ subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, type(sponge_CS), pointer :: CSp !< A pointer that is set to point to !! the control structure for the !! sponge module. - real, intent(in), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: h !< Thickness field, in units of H. + real, intent(in), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< Thickness field, in units of H. + ! Local variables real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces. - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, m. + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in depth units (Z). real :: temp(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for other variables. real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. - real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta, m. + real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta, in Z. real :: Idamp_im(SZJ_(G)) ! The inverse zonal-mean damping rate, in s-1. real :: damp_rate ! The inverse zonal-mean damping rate, in s-1. real :: jet_width ! The width of the zonal mean jet, in km. - real :: jet_height ! The interface height scale associated with the zonal-mean jet, in depth units. + real :: jet_height ! The interface height scale associated with the zonal-mean jet, in Z. real :: y_2 ! The y-position relative to the channel center, in km. real :: half_strat ! The fractional depth where the straficiation is centered, ND. - real :: half_depth ! The depth where the stratification is centered, in depth units. + real :: half_depth ! The depth where the stratification is centered, in Z. character(len=40) :: mdl = "Phillips_initialize_sponges" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz @@ -241,8 +242,8 @@ subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, "The interface height scale associated with the \n"//& "zonal-mean jet.", units="m", & fail_if_missing=.true.) + jet_height = jet_height * GV%m_to_Z - jet_height = jet_height / G%Zd_to_m half_depth = G%max_depth*half_strat eta0(1) = 0.0 ; eta0(nz+1) = -G%max_depth do k=2,1+nz/2 ; eta0(k) = -half_depth*(2.0*(k-1)/real(nz)) ; enddo @@ -252,7 +253,7 @@ subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, do j=js,je Idamp_im(j) = damp_rate - eta_im(j,1) = 0.0 ; eta_im(j,nz+1) = -G%Zd_to_m*G%max_depth + eta_im(j,1) = 0.0 ; eta_im(j,nz+1) = -G%max_depth enddo do K=2,nz ; do j=js,je y_2 = G%geoLatT(is,j) - G%south_lat - 0.5*G%len_lat @@ -260,10 +261,9 @@ subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, ! jet_height * atan(y_2 / jet_width) if (eta_im(j,K) > 0.0) eta_im(j,K) = 0.0 if (eta_im(j,K) < -G%max_depth) eta_im(j,K) = -G%max_depth - eta_im(j,K) = eta_im(j,K) * G%Zd_to_m enddo ; enddo - call initialize_sponge(Idamp, eta, G, param_file, CSp, Idamp_im, eta_im) + call initialize_sponge(Idamp, eta, G, param_file, CSp, GV, Idamp_im, eta_im) end subroutine Phillips_initialize_sponges diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index b7e1efe6b1..3564ff9f3f 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -44,8 +44,8 @@ subroutine USER_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) !! equation of state. call MOM_error(FATAL, & - "USER_initialization.F90, USER_set_coord: " // & - "Unmodified user routine called - you must edit the routine to use it") + "USER_initialization.F90, USER_set_coord: " // & + "Unmodified user routine called - you must edit the routine to use it") Rlay(:) = 0.0 g_prime(:) = 0.0 @@ -62,8 +62,8 @@ subroutine USER_initialize_topography(D, G, param_file, max_depth) real, intent(in) :: max_depth !< Maximum depth of model in m call MOM_error(FATAL, & - "USER_initialization.F90, USER_initialize_topography: " // & - "Unmodified user routine called - you must edit the routine to use it") + "USER_initialization.F90, USER_initialize_topography: " // & + "Unmodified user routine called - you must edit the routine to use it") D(:,:) = 0.0 @@ -85,8 +85,8 @@ subroutine USER_initialize_thickness(h, G, GV, param_file, just_read_params) logical :: just_read ! If true, just read parameters but set nothing. call MOM_error(FATAL, & - "USER_initialization.F90, USER_initialize_thickness: " // & - "Unmodified user routine called - you must edit the routine to use it") + "USER_initialization.F90, USER_initialize_thickness: " // & + "Unmodified user routine called - you must edit the routine to use it") just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -112,8 +112,8 @@ subroutine USER_initialize_velocity(u, v, G, param_file, just_read_params) logical :: just_read ! If true, just read parameters but set nothing. call MOM_error(FATAL, & - "USER_initialization.F90, USER_initialize_velocity: " // & - "Unmodified user routine called - you must edit the routine to use it") + "USER_initialization.F90, USER_initialize_velocity: " // & + "Unmodified user routine called - you must edit the routine to use it") just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -137,14 +137,14 @@ subroutine USER_init_temperature_salinity(T, S, G, param_file, eqn_of_state, jus !! parameter values. type(EOS_type), pointer :: eqn_of_state !< Integer that selects the !! equation of state. - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will only + !! read parameters without changing T & S. logical :: just_read ! If true, just read parameters but set nothing. call MOM_error(FATAL, & - "USER_initialization.F90, USER_init_temperature_salinity: " // & - "Unmodified user routine called - you must edit the routine to use it") + "USER_initialization.F90, USER_init_temperature_salinity: " // & + "Unmodified user routine called - you must edit the routine to use it") just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -158,24 +158,24 @@ subroutine USER_init_temperature_salinity(T, S, G, param_file, eqn_of_state, jus end subroutine USER_init_temperature_salinity !> Set up the sponges. -subroutine USER_initialize_sponges(G, use_temperature, tv, param_file, CSp, h) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. - logical, intent(in) :: use_temperature !< Whether to use potential - !! temperature. - type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers +subroutine USER_initialize_sponges(G, GV, use_temp, tv, param_file, CSp, h) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + logical, intent(in) :: use_temp !< If true, temperature and salinity are state variables. + type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers !! to any available thermodynamic !! fields, potential temperature and !! salinity or mixed layer density. !! Absent fields have NULL ptrs. - type(param_file_type), intent(in) :: param_file !< A structure indicating the + type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. - type(sponge_CS), pointer :: CSp !< A pointer to the sponge control - !! structure. - real, dimension(SZI_(G), SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thicknesses. + type(sponge_CS), pointer :: CSp !< A pointer to the sponge control structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h !< Layer thicknesses, in units of H (m or kg m-2). call MOM_error(FATAL, & - "USER_initialization.F90, USER_initialize_sponges: " // & - "Unmodified user routine called - you must edit the routine to use it") + "USER_initialization.F90, USER_initialize_sponges: " // & + "Unmodified user routine called - you must edit the routine to use it") if (first_call) call write_user_log(param_file) @@ -207,8 +207,8 @@ subroutine USER_set_rotation(G, param_file) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters call MOM_error(FATAL, & - "USER_initialization.F90, USER_set_rotation: " // & - "Unmodified user routine called - you must edit the routine to use it") + "USER_initialization.F90, USER_set_rotation: " // & + "Unmodified user routine called - you must edit the routine to use it") if (first_call) call write_user_log(param_file) @@ -237,8 +237,8 @@ end subroutine write_user_log !! here are: !! - u - Zonal velocity in m s-1. !! - v - Meridional velocity in m s-1. -!! - h - Layer thickness in m. (Must be positive.) -!! - G%bathyT - Basin depth in m. (Must be positive.) +!! - h - Layer thickness in H. (Must be positive.) +!! - G%bathyT - Basin depth in Z. (Must be positive.) !! - G%CoriolisBu - The Coriolis parameter, in s-1. !! - GV%g_prime - The reduced gravity at each interface, in m s-2. !! - GV%Rlay - Layer potential density (coordinate variable), kg m-3. From ac0a7d3a9fb0ace1d906c897a53160dc74a5c447 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 30 Aug 2018 13:44:45 -0400 Subject: [PATCH 0683/1072] Work in Z units in thickness init routines Modified thickness initialization routines to work in depth units instead of m for automated dimensional unit checking. All answers are bitwise identical for no Z-rescaling or for rescaling by 2^93 or 2^-93. --- .../MOM_state_initialization.F90 | 46 +++++++++---------- src/user/BFB_initialization.F90 | 9 ++-- src/user/Kelvin_initialization.F90 | 6 ++- src/user/Neverland_initialization.F90 | 19 ++++---- src/user/Phillips_initialization.F90 | 2 +- src/user/baroclinic_zone_initialization.F90 | 10 ++-- src/user/benchmark_initialization.F90 | 44 +++++++++--------- src/user/soliton_initialization.F90 | 12 ++--- 8 files changed, 74 insertions(+), 74 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 30d6c88ab6..756e192196 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -611,7 +611,7 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne !! only read parameters without changing h. ! Local variables - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! Interface heights, in depth units. integer :: inconsistent = 0 logical :: correct_thickness logical :: just_read ! If true, just read parameters but set nothing. @@ -653,6 +653,7 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne if (just_read) return ! All run-time parameters have been read, so return. call MOM_read_data(filename, "eta", eta(:,:,:), G%Domain) + ! if (GV%m_to_Z /= 1.0) eta(:,:,:) = GV%m_to_Z*eta(:,:,:) if (correct_thickness) then call adjustEtaToFitBathymetry(G, GV, eta, h) @@ -829,10 +830,10 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) !! only read parameters without changing h. ! Local variables character(len=40) :: mdl = "initialize_thickness_list" ! This subroutine's name. - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually - ! negative because it is positive upward. + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), + ! usually negative because it is positive upward. real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in m. + ! positive upward, in depth units (Z). logical :: just_read ! If true, just read parameters but set nothing. character(len=200) :: filename, eta_file, inputdir ! Strings for file/path character(len=72) :: eta_var @@ -860,6 +861,7 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) e0(:) = 0.0 call MOM_read_data(filename, eta_var, e0(:)) + do k=1,nz+1 ; e0(k) = GV%m_to_Z*e0(k) ; enddo if ((abs(e0(1)) - 0.0) > 0.001) then ! This list probably starts with the interior interface, so shift it up. @@ -867,11 +869,8 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) e0(1) = 0.0 endif - if (e0(2) > e0(1)) then - ! Switch to the convention for interface heights increasing upward. - do k=1,nz - e0(K) = -e0(K) - enddo + if (e0(2) > e0(1)) then ! Switch to the convention for interface heights increasing upward. + do k=1,nz ; e0(K) = -e0(K) ; enddo endif do j=js,je ; do i=is,ie @@ -880,14 +879,14 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) ! Angstrom thick, and 2. the interfaces are where they should be ! based on the resting depths and interface height perturbations, ! as long at this doesn't interfere with 1. - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = e0(K) - if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_m)) then - eta1D(K) = eta1D(K+1) + GV%Angstrom_m + if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then + eta1D(K) = eta1D(K+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta1D(K) - eta1D(K+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(K) - eta1D(K+1)) endif enddo enddo ; enddo @@ -1897,6 +1896,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. + ! Local variables character(len=200) :: filename !< The name of an input file containing temperature !! and salinity in z-space; also used for ice shelf area. @@ -1911,8 +1911,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) type(EOS_type), pointer :: eos => NULL() type(thermo_var_ptrs) :: tv_loc ! A temporary thermo_var container type(verticalGrid_type) :: GV_loc ! A temporary vertical grid structure -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_initialize_layers_from_Z" ! This module's name. integer :: is, ie, js, je, nz ! compute domain indices @@ -2085,10 +2085,10 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) ! to the North/South Pole past the limits of the input data, they are extrapolated using the average ! value at the northernmost/southernmost latitude. - call horiz_interp_and_extrap_tracer(tfilename, potemp_var,1.0,1, & + call horiz_interp_and_extrap_tracer(tfilename, potemp_var, 1.0, 1, & G, temp_z, mask_z, z_in, z_edges_in, missing_value_temp, reentrant_x, tripolar_n, homogenize) - call horiz_interp_and_extrap_tracer(sfilename, salin_var,1.0,1, & + call horiz_interp_and_extrap_tracer(sfilename, salin_var, 1.0, 1, & G, salt_z, mask_z, z_in, z_edges_in, missing_value_salt, reentrant_x, tripolar_n, homogenize) kd = size(z_in,1) @@ -2100,13 +2100,11 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) press(:) = tv%p_ref ! Convert T&S to Absolute Salinity and Conservative Temperature if using TEOS10 or NEMO - call convert_temp_salt_for_TEOS10(temp_z,salt_z, press, G, kd, mask_z, eos) + call convert_temp_salt_for_TEOS10(temp_z, salt_z, press, G, kd, mask_z, eos) - do k=1,kd - do j=js,je - call calculate_density(temp_z(:,j,k),salt_z(:,j,k), press, rho_z(:,j,k), is, ie, eos) - enddo - enddo ! kd + do k=1,kd ; do j=js,je + call calculate_density(temp_z(:,j,k), salt_z(:,j,k), press, rho_z(:,j,k), is, ie, eos) + enddo ; enddo call pass_var(temp_z,G%Domain) call pass_var(salt_z,G%Domain) @@ -2316,7 +2314,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) endif - deallocate(z_in,z_edges_in,temp_z,salt_z,mask_z) + deallocate(z_in, z_edges_in, temp_z, salt_z, mask_z) deallocate(rho_z) ; deallocate(area_shelf_h, frac_shelf_h) call pass_var(h, G%Domain) diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 20cf21f07b..2a14f502ef 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -82,11 +82,10 @@ subroutine BFB_initialize_sponges_southonly(G, GV, use_temperature, tv, param_fi intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) ! Local variables - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta. + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in depth units (Z). real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. - - real :: H0(SZK_(G)) - real :: min_depth + real :: H0(SZK_(G)) ! Resting layer thickesses in depth units (Z). + real :: min_depth ! The minimum ocean depth in depth units (Z). real :: damp, e_dense, damp_new, slat, wlon, lenlat, lenlon, nlat character(len=40) :: mdl = "BFB_initialize_sponges_southonly" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz @@ -118,7 +117,7 @@ subroutine BFB_initialize_sponges_southonly(G, GV, use_temperature, tv, param_fi do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz) ; enddo ! Use for meridional thickness profile initialization -! do k=1,nz ; H0(k) = -G%Zd_to_m*G%max_depth * real(k-1) / real(nz-1) ; enddo +! do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz-1) ; enddo do i=is,ie; do j=js,je if (G%geoLatT(i,j) < slat+2.0) then ; damp = 1.0 diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 92f25463aa..8315833391 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -255,12 +255,14 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) y1 = 1000. * G%geoLatBu(I,J) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa + !### Problem: val2 & cff could be a functions of space, but are not set in this loop. + !### Problem: Is val2 in the numerator or denominator below? if (CS%mode == 0) then do k=1,nz segment%tangential_vel(I,J,k) = val1 * cff * sina / & (0.25 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j) + & G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) * val2 -!### This should be: +!### For rotational symmetry, this should be: ! segment%tangential_vel(I,J,k) = val1 * cff * sina / & ! ( 0.25*G%Zd_to_m*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) +& ! (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) * val2 @@ -307,6 +309,8 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) y1 = 1000. * G%geoLatBu(I,J) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa + !### Problem: val2 & cff could be a functions of space, but are not set in this loop. + !### Problem: Is val2 in the numerator or denominator below? if (CS%mode == 0) then do k=1,nz segment%tangential_vel(I,J,k) = val1 * cff * sina / & diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index 11271543b9..cb641c9cb9 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -78,7 +78,7 @@ end subroutine Neverland_initialize_topography ! ----------------------------------------------------------------------------- !> Returns the value of a cosine-bell function evaluated at x/L -real function cosbell(x,L) +real function cosbell(x, L) real , intent(in) :: x !< non-dimensional position real , intent(in) :: L !< non-dimensional width real :: PI !< 3.1415926... calculated as 4*atan(1) @@ -88,7 +88,7 @@ real function cosbell(x,L) end function cosbell !> Returns the value of a sin-spike function evaluated at x/L -real function spike(x,L) +real function spike(x, L) real , intent(in) :: x !< non-dimensional position real , intent(in) :: L !< non-dimensional width @@ -115,8 +115,8 @@ subroutine Neverland_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ real, intent(in) :: P_Ref !< The coordinate-density !! reference pressure in Pa. ! Local variables - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), + ! usually negative because it is positive upward. real, dimension(SZK_(G)) :: h_profile ! Vector of initial thickness profile (m) real :: e_interface ! Current interface positoin (m) character(len=40) :: mod = "Neverland_initialize_thickness" ! This subroutine's name. @@ -128,19 +128,18 @@ subroutine Neverland_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ call get_param(param_file, mod, "INIT_THICKNESS_PROFILE", h_profile, & "Profile of initial layer thicknesses.", units="m", fail_if_missing=.true.) -! e0 is the notional position of interfaces + ! e0 is the notional position of interfaces e0(1) = 0. ! The surface do k=1,nz - e0(k+1) = e0(k) - h_profile(k) + e0(k+1) = e0(k) - GV%m_to_Z*h_profile(k) enddo do j=js,je ; do i=is,ie - e_interface = -G%Zd_to_m * G%bathyT(i,j) + e_interface = -G%bathyT(i,j) do k=nz,1,-1 - h(i,j,k) = max( GV%Angstrom_H, GV%m_to_H * (e0(k) - e_interface) ) - e_interface = max( e0(k), e_interface - GV%H_to_m * h(i,j,k) ) + h(i,j,k) = max( GV%Angstrom_H, GV%Z_to_H * (e0(k) - e_interface) ) + e_interface = max( e0(k), e_interface - GV%H_to_Z * h(i,j,k) ) enddo - enddo ; enddo end subroutine Neverland_initialize_thickness diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 5dfbb78914..719b9cd6ee 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -200,7 +200,7 @@ subroutine Phillips_initialize_sponges(G, GV, tv, param_file, CSp, h) type(sponge_CS), pointer :: CSp !< A pointer that is set to point to !! the control structure for the !! sponge module. - real, intent(in), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< Thickness field, in units of H. + real, intent(in), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< Thickness field, in units of H. ! Local variables real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces. diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index 381828e49c..1a9f99b840 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -81,7 +81,8 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, param_file, real :: T_ref, dTdz, dTdx, delta_T ! Parameters describing temperature distribution real :: S_ref, dSdz, dSdx, delta_S ! Parameters describing salinity distribution real :: L_zone ! Width of baroclinic zone - real :: zc, zi, x, xd, xs, y, yd, fn + real :: zc, zi ! Depths in depth units (Z). + real :: x, xd, xs, y, yd, fn real :: PI ! 3.1415926... calculated as 4*atan(1) logical :: just_read ! If true, just read parameters but set nothing. @@ -89,6 +90,7 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, param_file, just_read = .false. ; if (present(just_read_params)) just_read = just_read_params call bcz_params(G, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, delta_T, dTdx, L_zone, just_read_params) + dTdz = GV%Z_to_m*dTdz ; dSdz = GV%Z_to_m*dSdz if (just_read) return ! All run-time parameters have been read, so return. @@ -97,7 +99,7 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, param_file, PI = 4.*atan(1.) do j = G%jsc,G%jec ; do i = G%isc,G%iec - zi = -G%Zd_to_m*G%bathyT(i,j) + zi = -G%bathyT(i,j) x = G%geoLonT(i,j) - (G%west_lon + 0.5*G%len_lon) ! Relative to center of domain xd = x / G%len_lon ! -1/2 < xd 1/2 y = G%geoLatT(i,j) - (G%south_lat + 0.5*G%len_lat) ! Relative to center of domain @@ -110,8 +112,8 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, param_file, fn = xs endif do k = nz, 1, -1 - zc = zi + 0.5*h(i,j,k)*GV%H_to_m ! Position of middle of cell - zi = zi + h(i,j,k)*GV%H_to_m ! Top interface position + zc = zi + 0.5*h(i,j,k)*GV%H_to_Z ! Position of middle of cell + zi = zi + h(i,j,k)*GV%H_to_Z ! Top interface position T(i,j,k) = T_ref + dTdz * zc & ! Linear temperature stratification + dTdx * x & ! Linear gradient + delta_T * fn ! Smooth fn of width L_zone diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index decb94963c..8e0e03ad94 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -86,19 +86,19 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(GV)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: e_pert(SZK_(GV)+1) ! Interface height perturbations, positive ! - ! upward, in m. ! - real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units (Z), + ! usually negative because it is positive upward. + real :: e_pert(SZK_(GV)+1) ! Interface height perturbations, positive upward, + ! in depth units (Z). + real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface + ! positive upward, in depth units (Z). real :: SST ! The initial sea surface temperature, in deg C. real :: T_int ! The initial temperature of an interface, in deg C. - real :: ML_depth ! The specified initial mixed layer depth, in m. - real :: thermocline_scale ! The e-folding scale of the thermocline, in m. + real :: ML_depth ! The specified initial mixed layer depth, in depth units (Z). + real :: thermocline_scale ! The e-folding scale of the thermocline, in depth units (Z). real, dimension(SZK_(GV)) :: T0, pres, S0, rho_guess, drho, drho_dT, drho_dS real :: a_exp ! The fraction of the overall stratification that is exponential. - real :: I_ts, I_md ! Inverse lengthscales in m-1. + real :: I_ts, I_md ! Inverse lengthscales in Z-1. real :: T_frac ! A ratio of the interface temperature to the range ! between SST and the bottom temperature. real :: err, derr_dz ! The error between the profile's temperature and the @@ -118,8 +118,8 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & k1 = GV%nk_rho_varies + 1 - ML_depth = 50.0 - thermocline_scale = 500.0 + ML_depth = 50.0 * GV%m_to_Z + thermocline_scale = 500.0 * GV%m_to_Z a_exp = 0.9 ! This block calculates T0(k) for the purpose of diagnosing where the @@ -128,8 +128,8 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & pres(k) = P_Ref ; S0(k) = 35.0 enddo T0(k1) = 29.0 - call calculate_density(T0(k1),S0(k1),pres(k1),rho_guess(k1),eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,k1,1,eqn_of_state) + call calculate_density(T0(k1), S0(k1), pres(k1), rho_guess(k1), eqn_of_state) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, k1, 1, eqn_of_state) ! A first guess of the layers' temperatures. do k=1,nz @@ -138,8 +138,8 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & ! Refine the guesses for each layer. do itt=1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) + call calculate_density(T0, S0, pres, rho_guess, 1, nz, eqn_of_state) + call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, 1, nz, eqn_of_state) do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) enddo @@ -147,7 +147,7 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & pi = 4.0*atan(1.0) I_ts = 1.0 / thermocline_scale - I_md = 1.0 / (G%max_depth * GV%Z_to_m) + I_md = 1.0 / G%max_depth do j=js,je ; do i=is,ie SST = 0.5*(T0(k1)+T0(nz)) - 0.9*0.5*(T0(k1)-T0(nz)) * & cos(pi*(G%geoLatT(i,j)-G%south_lat)/(G%len_lat)) @@ -156,12 +156,12 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & ! The remainder of this subroutine should not be changed. ! -! This sets the initial thickness (in m) of the layers. The ! +! This sets the initial thickness (in H) of the layers. The ! ! thicknesses are set to insure that: 1. each layer is at least ! ! Gv%Angstrom_m thick, and 2. the interfaces are where they should be ! ! based on the resting depths and interface height perturbations, ! ! as long at this doesn't interfere with 1. ! - eta1D(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,2,-1 T_int = 0.5*(T0(k) + T0(k-1)) @@ -180,12 +180,12 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & if (eta1D(K) > -ML_depth) eta1D(K) = -ML_depth - if (eta1D(K) < eta1D(K+1) + GV%Angstrom_m) & - eta1D(K) = eta1D(K+1) + GV%Angstrom_m + if (eta1D(K) < eta1D(K+1) + GV%Angstrom_Z) & + eta1D(K) = eta1D(K+1) + GV%Angstrom_Z - h(i,j,k) = max(GV%m_to_H * (eta1D(K) - eta1D(K+1)), GV%Angstrom_H) + h(i,j,k) = max(GV%Z_to_H * (eta1D(K) - eta1D(K+1)), GV%Angstrom_H) enddo - h(i,j,1) = max(GV%m_to_H * (0.0 - eta1D(2)), GV%Angstrom_H) + h(i,j,1) = max(GV%Z_to_H * (0.0 - eta1D(2)), GV%Angstrom_H) enddo ; enddo diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index 4d463803f3..96e7170bb6 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -45,15 +45,15 @@ subroutine soliton_initialize_thickness(h, G, GV) x0 = 2.0*G%len_lon/3.0 y0 = 0.0 val1 = 0.395 - val2 = 0.771*(val1*val1) + val2 = GV%m_to_Z * 0.771*(val1*val1) do j = G%jsc,G%jec ; do i = G%isc,G%iec do k = 1, nz x = G%geoLonT(i,j)-x0 y = G%geoLatT(i,j)-y0 val3 = exp(-val1*x) - val4 = val2*((2.0*val3/(1.0+(val3*val3)))**2) - h(i,j,k) = GV%m_to_H * (0.25*val4 * (6.0*y*y+3.0) * exp(-0.5*y*y) + G%Zd_to_m*G%bathyT(i,j)) + val4 = val2 * ( 2.0*val3 / (1.0 + (val3*val3)) )**2 + h(i,j,k) = GV%Z_to_H * (0.25*val4*(6.0*y*y + 3.0) * exp(-0.5*y*y) + G%bathyT(i,j)) enddo enddo ; enddo @@ -87,8 +87,7 @@ subroutine soliton_initialize_velocity(u, v, h, G) y = 0.5*(G%geoLatT(i+1,j)+G%geoLatT(i,j))-y0 val3 = exp(-val1*x) val4 = val2*((2.0*val3/(1.0+(val3*val3)))**2) - u(I,j,k) = 0.25*val4*(6.0*y*y-9.0)* & - exp(-0.5*y*y) + u(I,j,k) = 0.25*val4*(6.0*y*y-9.0) * exp(-0.5*y*y) enddo enddo ; enddo do j = G%jsc-1,G%jec+1 ; do I = G%isc,G%iec @@ -97,8 +96,7 @@ subroutine soliton_initialize_velocity(u, v, h, G) y = 0.5*(G%geoLatT(i,j+1)+G%geoLatT(i,j))-y0 val3 = exp(-val1*x) val4 = val2*((2.0*val3/(1.0+(val3*val3)))**2) - v(i,J,k) = 2.0*val4*y*(-2.0*val1*tanh(val1*x))* & - exp(-0.5*y*y) + v(i,J,k) = 2.0*val4*y*(-2.0*val1*tanh(val1*x)) * exp(-0.5*y*y) enddo enddo ; enddo From c0f79021120dc476075167ff3e29a3b33545567a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 30 Aug 2018 15:13:28 -0400 Subject: [PATCH 0684/1072] Code cleanup in midas_vertmap Cleaned up code in determine_temperature, find_overlap, and find_limite_slope to follow MOM6 standards for indents and spacing, and to avoid unneccessary temporary variables. All answers are bitwise identical. --- src/initialization/midas_vertmap.F90 | 255 ++++++++++++--------------- 1 file changed, 113 insertions(+), 142 deletions(-) diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index ccc71fa5e1..0124c767b5 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -361,10 +361,9 @@ end function bisect_fast #ifdef PY_SOLO ! Only for stand-alone python -!> This subroutine determines the potential temperature and -!! salinity that is consistent with the target density -!! using provided initial guess -subroutine determine_temperature(temp,salt,R,p_ref,niter,land_fill,h,k_start) +!> This subroutine determines the potential temperature and salinity that +!! is consistent with the target density using provided initial guess +subroutine determine_temperature(temp, salt, R, p_ref, niter, land_fill, h, k_start) real(kind=8), dimension(:,:,:), intent(inout) :: temp !< potential temperature (degC) real(kind=8), dimension(:,:,:), intent(inout) :: salt !< salinity (PSU) real(kind=8), dimension(size(temp,3)), intent(in) :: R !< desired potential density, in kg m-3. @@ -373,49 +372,40 @@ subroutine determine_temperature(temp,salt,R,p_ref,niter,land_fill,h,k_start) integer, intent(in) :: k_start !< starting index (i.e. below the buffer layer) real, intent(in) :: land_fill !< land fill value real(kind=8), dimension(:,:,:), intent(in) :: h !< layer thickness . Do not iterate for massless layers + ! Local variables - real(kind=8), dimension(size(temp,1),size(temp,3)) :: T,S,dT,dS,rho,hin - real(kind=8), dimension(size(temp,1),size(temp,3)) :: drho_dT,drho_dS - real(kind=8), dimension(size(temp,1)) :: press - integer :: nx,ny,nz,nt,i,j,k,n,itt - logical :: adjust_salt , old_fit - real :: dT_dS real, parameter :: T_max = 35.0, T_min = -2.0 - real, parameter :: S_min = 0.5, S_max=65.0 - real, parameter :: tol=1.e-4, max_t_adj=1.0, max_s_adj = 0.5 #else -!> This subroutine determines the potential temperature and -!! salinity that is consistent with the target density -!! using provided initial guess -subroutine determine_temperature(temp,salt,R,p_ref,niter,land_fill,h,k_start,eos) - real, dimension(:,:,:), intent(inout) :: temp !< potential temperature (degC) - real, dimension(:,:,:), intent(inout) :: salt !< salinity (PSU) - real, dimension(size(temp,3)), intent(in) :: R !< desired potential density, in kg m-3. - real, intent(in) :: p_ref !< reference pressure, in Pa. - integer, intent(in) :: niter !< maximum number of iterations - integer, intent(in) :: k_start !< starting index (i.e. below the buffer layer) - real, intent(in) :: land_fill !< land fill value - real, dimension(:,:,:), intent(in) :: h !< layer thickness . Do not iterate for massless layers - type(eos_type), pointer :: eos !< seawater equation of state control structure - ! Local variables - real(kind=8), dimension(size(temp,1),size(temp,3)) :: T,S,dT,dS,rho,hin - real(kind=8), dimension(size(temp,1),size(temp,3)) :: drho_dT,drho_dS +!> This subroutine determines the potential temperature and salinity that +!! is consistent with the target density using provided initial guess +subroutine determine_temperature(temp, salt, R, p_ref, niter, land_fill, h, k_start, eos) + real, dimension(:,:,:), intent(inout) :: temp !< potential temperature (degC) + real, dimension(:,:,:), intent(inout) :: salt !< salinity (PSU) + real, dimension(size(temp,3)), intent(in) :: R !< desired potential density, in kg m-3. + real, intent(in) :: p_ref !< reference pressure, in Pa. + integer, intent(in) :: niter !< maximum number of iterations + integer, intent(in) :: k_start !< starting index (i.e. below the buffer layer) + real, intent(in) :: land_fill !< land fill value + real, dimension(:,:,:), intent(in) :: h !< layer thickness, used only to avoid working on massless layers + type(eos_type), pointer :: eos !< seawater equation of state control structure + + real, parameter :: T_max = 31.0, T_min = -2.0 +#endif + ! Local variables (All of which need documentation!) + real(kind=8), dimension(size(temp,1),size(temp,3)) :: T, S, dT, dS, rho, hin + real(kind=8), dimension(size(temp,1),size(temp,3)) :: drho_dT, drho_dS real(kind=8), dimension(size(temp,1)) :: press - integer :: nx,ny,nz,nt,i,j,k,n,itt + integer :: nx, ny, nz, nt, i, j, k, n, itt real :: dT_dS - logical :: adjust_salt , old_fit - real, parameter :: T_max = 31.0, T_min = -2.0 + logical :: adjust_salt, old_fit real, parameter :: S_min = 0.5, S_max=65.0 real, parameter :: tol=1.e-4, max_t_adj=1.0, max_s_adj = 0.5 -#endif old_fit = .true. ! reproduces siena behavior - ! will switch to the newer - ! method which simultaneously adjusts - ! temp and salt based on the ratio - ! of the thermal and haline coefficients. + ! will switch to the newer method which simultaneously adjusts + ! temp and salt based on the ratio of the thermal and haline coefficients. - nx=size(temp,1);ny=size(temp,2); nz=size(temp,3) + nx=size(temp,1) ; ny=size(temp,2) ; nz=size(temp,3) press(:) = p_ref @@ -432,72 +422,59 @@ subroutine determine_temperature(temp,salt,R,p_ref,niter,land_fill,h,k_start,eos drho_dT=alpha_wright_eos_2d(T,S,p_ref) #else do k=1, nz - call calculate_density(T(:,k),S(:,k),press,rho(:,k),1,nx,eos) - call calculate_density_derivs(T(:,k),S(:,k),press,drho_dT(:,k),drho_dS(:,k),1,nx,eos) + call calculate_density(T(:,k), S(:,k), press, rho(:,k), 1, nx, eos) + call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), 1, nx, eos) enddo #endif - do k=k_start,nz - do i=1,nx - -! if (abs(rho(i,k)-R(k))>tol .and. hin(i,k)>epsln .and. abs(T(i,k)-land_fill) < epsln) then - if (abs(rho(i,k)-R(k))>tol) then - if (old_fit) then - dT(i,k)=(R(k)-rho(i,k))/drho_dT(i,k) - if (dT(i,k)>max_t_adj) dT(i,k)=max_t_adj - if (dT(i,k)<-1.0*max_t_adj) dT(i,k)=-1.0*max_t_adj - T(i,k)=max(min(T(i,k)+dT(i,k),T_max),T_min) - else - dT_dS = 10.0 - min(-drho_dT(i,k)/drho_dS(i,k),10.) - dS(i,k) = (R(k)-rho(i,k))/(drho_dS(i,k) - drho_dT(i,k)*dT_dS ) - dT(i,k)= -dT_dS*dS(i,k) -! if (dT(i,k)>max_t_adj) dT(i,k)=max_t_adj -! if (dT(i,k)<-1.0*max_t_adj) dT(i,k)=-1.0*max_t_adj - T(i,k)=max(min(T(i,k)+dT(i,k),T_max),T_min) - S(i,k)=max(min(S(i,k)+dS(i,k),S_max),S_min) - endif + do k=k_start,nz ; do i=1,nx + +! if (abs(rho(i,k)-R(k))>tol .and. hin(i,k)>epsln .and. abs(T(i,k)-land_fill) < epsln) then + if (abs(rho(i,k)-R(k))>tol) then + if (old_fit) then + dT(i,k) = max(min((R(k)-rho(i,k)) / drho_dT(i,k), max_t_adj), -max_t_adj) + T(i,k) = max(min(T(i,k)+dT(i,k), T_max), T_min) + else + dT_dS = 10.0 - min(-drho_dT(i,k)/drho_dS(i,k),10.) + !### RWH: Based on the dimensions alone, the expression above should be: + ! dT_dS = 10.0 - min(-drho_dS(i,k)/drho_dT(i,k),10.) + dS(i,k) = (R(k)-rho(i,k)) / (drho_dS(i,k) - drho_dT(i,k)*dT_dS ) + dT(i,k) = -dT_dS*dS(i,k) + ! dT(i,k) = max(min(dT(i,k), max_t_adj), -max_t_adj) + T(i,k) = max(min(T(i,k)+dT(i,k), T_max), T_min) + S(i,k) = max(min(S(i,k)+dS(i,k), S_max), S_min) endif - enddo - enddo + endif + enddo ; enddo if (maxval(abs(dT)) < tol) then adjust_salt = .false. exit iter_loop endif enddo iter_loop - if (adjust_salt .and. old_fit) then - iter_loop2: do itt = 1,niter + if (adjust_salt .and. old_fit) then ; do itt = 1,niter #ifdef PY_SOLO - rho=wright_eos_2d(T,S,p_ref) - drho_dS=beta_wright_eos_2d(T,S,p_ref) + rho = wright_eos_2d(T,S,p_ref) + drho_dS = beta_wright_eos_2d(T,S,p_ref) #else - do k=1, nz - call calculate_density(T(:,k),S(:,k),press,rho(:,k),1,nx,eos) - call calculate_density_derivs(T(:,k),S(:,k),press,drho_dT(:,k),drho_dS(:,k),1,nx,eos) - enddo + do k=1, nz + call calculate_density(T(:,k),S(:,k),press,rho(:,k),1,nx,eos) + call calculate_density_derivs(T(:,k),S(:,k),press,drho_dT(:,k),drho_dS(:,k),1,nx,eos) + enddo #endif - do k=k_start,nz - do i=1,nx -! if (abs(rho(i,k)-R(k))>tol .and. hin(i,k)>epsln .and. abs(T(i,k)-land_fill) < epsln ) then - if (abs(rho(i,k)-R(k))>tol ) then - dS(i,k)=(R(k)-rho(i,k))/drho_dS(i,k) - if (dS(i,k)>max_s_adj) dS(i,k)=max_s_adj - if (dS(i,k)<-1.0*max_s_adj) dS(i,k)=-1.0*max_s_adj - S(i,k)=max(min(S(i,k)+dS(i,k),S_max),S_min) - endif - enddo - enddo - if (maxval(abs(dS)) < tol) then - exit iter_loop2 - endif - enddo iter_loop2 - endif + do k=k_start,nz ; do i=1,nx +! if (abs(rho(i,k)-R(k))>tol .and. hin(i,k)>epsln .and. abs(T(i,k)-land_fill) < epsln ) then + if (abs(rho(i,k)-R(k)) > tol) then + dS(i,k) = max(min((R(k)-rho(i,k)) / drho_dS(i,k), max_s_adj), -max_s_adj) + S(i,k) = max(min(S(i,k)+dS(i,k), S_max), S_min) + endif + enddo ; enddo + if (maxval(abs(dS)) < tol) exit + enddo ; endif temp(:,j,:)=T(:,:) salt(:,j,:)=S(:,:) enddo - return - end subroutine determine_temperature !> This subroutine determines the layers bounded by interfaces e that overlap @@ -520,43 +497,42 @@ subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z real :: Ih, e_c, tot_wt, I_totwt integer :: k - wt(:)=0.0; z1(:)=0.0; z2(:)=0.0 - k_top = k_start; k_bot= k_start; wt(1) = 1.0; z1(1)=-0.5; z2(1) = 0.5 - - do k=k_start,k_max ;if (e(k+1)k_max) return - - ! Determine the fractional weights of each layer. - ! Note that by convention, e and Z_int decrease with increasing k. - if (e(k+1)<=Z_bot) then - wt(k) = 1.0 ; k_bot = k - Ih = 1.0 / (e(k)-e(k+1)) - e_c = 0.5*(e(k)+e(k+1)) - z1(k) = (e_c - MIN(e(k),Z_top)) * Ih - z2(k) = (e_c - Z_bot) * Ih - else - wt(k) = MIN(e(k),Z_top) - e(k+1) ; tot_wt = wt(k) ! These are always > 0. - z1(k) = (0.5*(e(k)+e(k+1)) - MIN(e(k),Z_top)) / (e(k)-e(k+1)) - z2(k) = 0.5 - k_bot = k_max - do k=k_top+1,k_max - if (e(k+1)<=Z_bot) then - k_bot = k - wt(k) = e(k) - Z_bot ; z1(k) = -0.5 - z2(k) = (0.5*(e(k)+e(k+1)) - Z_bot) / (e(k)-e(k+1)) - else - wt(k) = e(k) - e(k+1) ; z1(k) = -0.5 ; z2(k) = 0.5 - endif - tot_wt = tot_wt + wt(k) ! wt(k) is always > 0. - if (k>=k_bot) exit - enddo - - I_totwt = 1.0 / tot_wt - do k=k_top,k_bot ; wt(k) = I_totwt*wt(k) ; enddo + wt(:)=0.0 ; z1(:)=0.0 ; z2(:)=0.0 + k_top = k_start ; k_bot = k_start ; wt(1) = 1.0 ; z1(1) = -0.5 ; z2(1) = 0.5 + + do k=k_start,k_max ; if (e(k+1) < Z_top) exit ; enddo + k_top = k + + if (k>k_max) return + + ! Determine the fractional weights of each layer. + ! Note that by convention, e and Z_int decrease with increasing k. + if (e(k+1) <= Z_bot) then + wt(k) = 1.0 ; k_bot = k + Ih = 1.0 / (e(k)-e(k+1)) + e_c = 0.5*(e(k)+e(k+1)) + z1(k) = (e_c - MIN(e(k),Z_top)) * Ih + z2(k) = (e_c - Z_bot) * Ih + else + wt(k) = MIN(e(k),Z_top) - e(k+1) ; tot_wt = wt(k) ! These are always > 0. + z1(k) = (0.5*(e(k)+e(k+1)) - MIN(e(k),Z_top)) / (e(k)-e(k+1)) + z2(k) = 0.5 + k_bot = k_max + do k=k_top+1,k_max + if (e(k+1) <= Z_bot) then + k_bot = k + wt(k) = e(k) - Z_bot ; z1(k) = -0.5 + z2(k) = (0.5*(e(k)+e(k+1)) - Z_bot) / (e(k)-e(k+1)) + else + wt(k) = e(k) - e(k+1) ; z1(k) = -0.5 ; z2(k) = 0.5 endif + tot_wt = tot_wt + wt(k) ! wt(k) is always > 0. + if (k>=k_bot) exit + enddo - return + I_totwt = 0.0 ; if (tot_wt > 0.0) I_totwt = 1.0 / tot_wt + do k=k_top,k_bot ; wt(k) = I_totwt*wt(k) ; enddo + endif end subroutine find_overlap @@ -564,33 +540,28 @@ end subroutine find_overlap !! a piecewise limited scheme. function find_limited_slope(val, e, k) result(slope) real, dimension(:), intent(in) :: val !< An column the values that are being interpolated. - real, dimension(:), intent(in) :: e !< A column's interface heights, in m. - integer, intent(in) :: k !< The layer whose slope is being determined. + real, dimension(:), intent(in) :: e !< A column's interface heights, in m. + integer, intent(in) :: k !< The layer whose slope is being determined. real :: slope !< The normalized slope in the intracell distribution of val. ! Local variables - real :: amx,bmx,amn,bmn,cmn,dmn + real :: amn, cmn real :: d1, d2 if ((val(k)-val(k-1)) * (val(k)-val(k+1)) >= 0.0) then - slope = 0.0 ! ; curvature = 0.0 + slope = 0.0 ! ; curvature = 0.0 else - d1 = 0.5*(e(k-1)-e(k+1)) ; d2 = 0.5*(e(k)-e(k+2)) - slope = ((d1**2)*(val(k+1) - val(k)) + (d2**2)*(val(k) - val(k-1))) * & - (e(k) - e(k+1)) / (d1*d2*(d1+d2)) - ! slope = 0.5*(val(k+1) - val(k-1)) - ! This is S.J. Lin's form of the PLM limiter. - amx=max(val(k-1),val(k)) - bmx = max(amx,val(k+1)) - amn = min(abs(slope),2.0*(bmx-val(k))) - bmn = min(val(k-1),val(k)) - cmn = 2.0*(val(k)-min(bmn,val(k+1))) - dmn = min(amn,cmn) - slope = sign(1.0,slope) * dmn - - ! min(abs(slope), & - ! 2.0*(max(val(k-1),val(k),val(k+1)) - val(k)), & - ! 2.0*(val(k) - min(val(k-1),val(k),val(k+1)))) - ! curvature = 0.0 + d1 = 0.5*(e(k-1)-e(k+1)) ; d2 = 0.5*(e(k)-e(k+2)) + slope = ((d1**2)*(val(k+1) - val(k)) + (d2**2)*(val(k) - val(k-1))) * & + (e(k) - e(k+1)) / (d1*d2*(d1+d2)) + ! slope = 0.5*(val(k+1) - val(k-1)) + ! This is S.J. Lin's form of the PLM limiter. + amn = min(abs(slope), 2.0*(max(val(k-1), val(k), val(k+1)) - val(k))) + cmn = 2.0*(val(k) - min(val(k-1), val(k), val(k+1))) + slope = sign(1.0, slope) * min(amn, cmn) + + ! min(abs(slope), 2.0*(max(val(k-1),val(k),val(k+1)) - val(k)), & + ! 2.0*(val(k) - min(val(k-1),val(k),val(k+1)))) + ! curvature = 0.0 endif return From 953df9d8cc433302a5863c02f8e1308cbb097beb Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 30 Aug 2018 16:55:58 -0400 Subject: [PATCH 0685/1072] +Added optional arg. m_to_Z to calc_tidal_forcing Added a new optional argument, m_to_Z, to calc_tidal_forcing to enable the interface height and tidal height anomaly to use units other than m. All answers are bitwise identical, but there is a new optional argument. --- .../lateral/MOM_tidal_forcing.F90 | 31 +++++++++++-------- 1 file changed, 18 insertions(+), 13 deletions(-) diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index 95c9b10047..a552bfe1ca 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -393,28 +393,31 @@ end subroutine tidal_forcing_sensitivity !> This subroutine calculates the geopotential anomalies that drive the tides, !! including self-attraction and loading. Optionally, it also returns the !! partial derivative of the local geopotential height with the input sea surface -!! height. For now, eta and eta_tidal are both geopotential heights in m, but -!! probably the input for eta should really be replaced with the column mass -!! anomalies. -subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta) +!! height. For now, eta and eta_tidal are both geopotential heights in depth +!! units, but probably the input for eta should really be replaced with the +!! column mass anomalies. +subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta, m_to_Z) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(time_type), intent(in) :: Time !< The time for the caluculation. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The sea surface height anomaly from - !! a time-mean geoid in m. - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_tidal !< The tidal forcing geopotential - !! anomalies, in m. + !! a time-mean geoid in depth units (Z). + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_tidal !< The tidal forcing geopotential height + !! anomalies, in depth units (Z). type(tidal_forcing_CS), pointer :: CS !< The control structure returned by a !! previous call to tidal_forcing_init. real, optional, intent(out) :: deta_tidal_deta !< The partial derivative of !! eta_tidal with the local value of !! eta, nondim. + real, optional, intent(in) :: m_to_Z !< A scaling factor from m to the units of eta. + ! Local variables real :: eta_astro(SZI_(G),SZJ_(G)) real :: eta_SAL(SZI_(G),SZJ_(G)) real :: now ! The relative time in seconds. real :: amp_cosomegat, amp_sinomegat real :: cosomegat, sinomegat - real :: eta_prop + real :: m_Z ! A scaling factor from m to depth units. + real :: eta_prop ! The nondimenional constant of proportionality beteen eta and eta_tidal. integer :: i, j, c, m, is, ie, js, je, Isq, Ieq, Jsq, Jeq is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -447,10 +450,12 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta) enddo ; enddo endif + m_Z = 1.0 ; if (present(m_to_Z)) m_Z = m_to_Z + do c=1,CS%nc m = CS%struct(c) - amp_cosomegat = CS%amp(c)*CS%love_no(c)*cos(CS%freq(c)*now + CS%phase0(c)) - amp_sinomegat = CS%amp(c)*CS%love_no(c)*sin(CS%freq(c)*now + CS%phase0(c)) + amp_cosomegat = m_Z*CS%amp(c)*CS%love_no(c) * cos(CS%freq(c)*now + CS%phase0(c)) + amp_sinomegat = m_Z*CS%amp(c)*CS%love_no(c) * sin(CS%freq(c)*now + CS%phase0(c)) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 eta_tidal(i,j) = eta_tidal(i,j) + (amp_cosomegat*CS%cos_struct(i,j,m) + & amp_sinomegat*CS%sin_struct(i,j,m)) @@ -461,7 +466,7 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta) cosomegat = cos(CS%freq(c)*now) sinomegat = sin(CS%freq(c)*now) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta_tidal(i,j) = eta_tidal(i,j) + CS%ampsal(i,j,c) * & + eta_tidal(i,j) = eta_tidal(i,j) + m_Z*CS%ampsal(i,j,c) * & (cosomegat*CS%cosphasesal(i,j,c) + sinomegat*CS%sinphasesal(i,j,c)) enddo ; enddo enddo ; endif @@ -470,8 +475,8 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta) cosomegat = cos(CS%freq(c)*now) sinomegat = sin(CS%freq(c)*now) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta_tidal(i,j) = eta_tidal(i,j) - CS%SAL_SCALAR*CS%amp_prev(i,j,c) * & - (cosomegat*CS%cosphase_prev(i,j,c)+sinomegat*CS%sinphase_prev(i,j,c)) + eta_tidal(i,j) = eta_tidal(i,j) - m_Z*CS%SAL_SCALAR*CS%amp_prev(i,j,c) * & + (cosomegat*CS%cosphase_prev(i,j,c) + sinomegat*CS%sinphase_prev(i,j,c)) enddo ; enddo enddo ; endif From caf426313ef3fbb8cf51af8dbb82b930b9de7912 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 30 Aug 2018 16:59:50 -0400 Subject: [PATCH 0686/1072] Calculate e_tidal in depth units Change e_tidal from m to depth units in the Boussinesq pressure gradient force calculations. Also simplified MOM_PressureForce_Montgomery openMP directives. All answers are bitwise identical for no Z-rescaling or for rescaling by 2^93 or 2^-93. --- src/core/MOM_PressureForce.F90 | 2 +- src/core/MOM_PressureForce_Montgomery.F90 | 108 +++++++++------------ src/core/MOM_PressureForce_analytic_FV.F90 | 22 ++--- src/core/MOM_PressureForce_blocked_AFV.F90 | 20 ++-- 4 files changed, 66 insertions(+), 86 deletions(-) diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index d1a2a41a38..ebefd38bcf 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -16,7 +16,7 @@ module MOM_PressureForce use MOM_PressureForce_Mont, only : PressureForce_Mont_Bouss, PressureForce_Mont_nonBouss use MOM_PressureForce_Mont, only : PressureForce_Mont_init, PressureForce_Mont_end use MOM_PressureForce_Mont, only : PressureForce_Mont_CS -use MOM_tidal_forcing, only : calc_tidal_forcing, tidal_forcing_CS +use MOM_tidal_forcing, only : tidal_forcing_CS use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_ALE, only: ALE_CS diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 1e9e41eb9a..0548cc0dd2 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -143,36 +143,30 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, I_gEarth = 1.0 / GV%g_Earth dp_neglect = GV%H_to_Pa * GV%H_subroundoff -!$OMP parallel default(none) shared(nz,alpha_Lay,GV,dalpha_int) -!$OMP do do k=1,nz ; alpha_Lay(k) = 1.0 / GV%Rlay(k) ; enddo -!$OMP do do k=2,nz ; dalpha_int(K) = alpha_Lay(k-1) - alpha_Lay(k) ; enddo -!$OMP end parallel -!$OMP parallel default(none) shared(Isq,Ieq,Jsq,Jeq,nz,p,p_atm,GV,h,use_p_atm) if (use_p_atm) then -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ; p(i,j,1) = p_atm(i,j) ; enddo ; enddo else -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ; p(i,j,1) = 0.0 ; enddo ; enddo endif -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=1,nz ; do i=Isq,Ieq+1 p(i,j,K+1) = p(i,j,K) + GV%H_to_Pa * h(i,j,k) enddo ; enddo ; enddo -!$OMP end parallel if (present(eta)) then Pa_to_H = 1.0 / GV%H_to_Pa if (use_p_atm) then -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,eta,p,p_atm,Pa_to_H) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 eta(i,j) = (p(i,j,nz+1) - p_atm(i,j))*Pa_to_H ! eta has the same units as h. enddo ; enddo else -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,eta,p,Pa_to_H) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 eta(i,j) = p(i,j,nz+1)*Pa_to_H ! eta has the same units as h. enddo ; enddo @@ -182,39 +176,36 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, if (CS%tides) then ! Determine the sea surface height anomalies, to enable the calculation ! of self-attraction and loading. -!$OMP parallel default(none) shared(Isq,Ieq,Jsq,Jeq,nz,SSH,G,GV,use_EOS,tv,p,dz_geo, & -!$OMP I_gEarth,h,alpha_Lay) -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - SSH(i,j) = -G%Zd_to_m*G%bathyT(i,j) + SSH(i,j) = -GV%Z_to_m*G%bathyT(i,j) enddo ; enddo if (use_EOS) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz call int_specific_vol_dp(tv%T(:,:,k), tv%S(:,:,k), p(:,:,k), p(:,:,k+1), & 0.0, G%HI, tv%eqn_of_state, dz_geo(:,:,k), halo_size=1) enddo -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=1,nz; do i=Isq,Ieq+1 SSH(i,j) = SSH(i,j) + I_gEarth * dz_geo(i,j,k) enddo ; enddo ; enddo else -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=1,nz ; do i=Isq,Ieq+1 SSH(i,j) = SSH(i,j) + GV%H_to_kg_m2*h(i,j,k)*alpha_Lay(k) enddo ; enddo ; enddo endif -!$OMP end parallel - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp) -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,geopot_bot,G,GV,e_tidal) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=1.0) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - geopot_bot(i,j) = -GV%g_Earth*(e_tidal(i,j) + G%Zd_to_m*G%bathyT(i,j)) + geopot_bot(i,j) = -GV%g_Earth*(e_tidal(i,j) + GV%Z_to_m*G%bathyT(i,j)) enddo ; enddo else -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,geopot_bot,G,GV) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - geopot_bot(i,j) = -GV%g_Earth*G%Zd_to_m*G%bathyT(i,j) + geopot_bot(i,j) = -GV%g_Earth*GV%Z_to_m*G%bathyT(i,j) enddo ; enddo endif @@ -229,8 +220,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, tv_tmp%T => T_tmp ; tv_tmp%S => S_tmp tv_tmp%eqn_of_state => tv%eqn_of_state do i=Isq,Ieq+1 ; p_ref(i) = tv%P_Ref ; enddo -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,nkmb,tv_tmp,tv,p_ref,GV) & -!$OMP private(Rho_cv_BL) + !$OMP parallel do default(shared) private(Rho_cv_BL) do j=Jsq,Jeq+1 do k=1,nkmb ; do i=Isq,Ieq+1 tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k) @@ -250,8 +240,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, tv_tmp%eqn_of_state => tv%eqn_of_state do i=Isq,Ieq+1 ; p_ref(i) = 0 ; enddo endif -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,tv_tmp,p_ref,tv,alpha_star) & -!$OMP private(rho_in_situ) + !$OMP parallel do default(shared) private(rho_in_situ) do k=1,nz ; do j=Jsq,Jeq+1 call calculate_density(tv_tmp%T(:,j,k),tv_tmp%S(:,j,k),p_ref, & rho_in_situ,Isq,Ieq-Isq+2,tv%eqn_of_state) @@ -260,7 +249,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, endif ! use_EOS if (use_EOS) then -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,M,geopot_bot,p,alpha_star) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 M(i,j,nz) = geopot_bot(i,j) + p(i,j,nz+1) * alpha_star(i,j,nz) @@ -270,8 +259,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, enddo ; enddo enddo else ! not use_EOS -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,M,geopot_bot,p,& -!$OMP alpha_Lay,dalpha_int) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 M(i,j,nz) = geopot_bot(i,j) + p(i,j,nz+1) * alpha_Lay(nz) @@ -284,11 +272,11 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, if (CS%GFS_scale < 1.0) then ! Adjust the Montgomery potential to make this a reduced gravity model. -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,dM,CS,M) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * M(i,j,1) enddo ; enddo -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,dM,M) + !$OMP parallel do default(shared) do k=1,nz ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 M(i,j,k) = M(i,j,k) + dM(i,j) enddo ; enddo ; enddo @@ -319,9 +307,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, ! Calculate the pressure force. On a Cartesian grid, ! PFu = - dM/dx and PFv = - dM/dy. if (use_EOS) then -!$OMP parallel do default(none) shared(is,ie,js,je,Isq,Ieq,Jsq,Jeq,nz,p,dp_neglect, & -!$OMP alpha_star,G,PFu,PFv,M,CS) & -!$OMP private(dp_star,PFu_bc,PFv_bc) + !$OMP parallel do default(shared) private(dp_star,PFu_bc,PFv_bc) do k=1,nz do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 dp_star(i,j) = (p(i,j,K+1) - p(i,j,K)) + dp_neglect @@ -343,7 +329,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, enddo ; enddo enddo ! k-loop else ! .not. use_EOS -!$OMP parallel do default(none) shared(is,ie,js,je,Isq,Ieq,Jsq,Jeq,nz,PFu,PFv,M,G) + !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) @@ -405,7 +391,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! for compressibility, in m. real :: e_tidal(SZI_(G),SZJ_(G)) ! Bottom geopotential anomaly due to tidal ! forces from astronomical sources and self- - ! attraction and loading, in m. + ! attraction and loading, in depth units (Z). real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, in Pa (usually 2e7 Pa = 2000 dbar). real :: I_Rho0 ! 1/Rho0. @@ -451,36 +437,34 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! and loading. This should really be based on bottom pressure anomalies, ! but that is not yet implemented, and the current form is correct for ! barotropic tides. -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,h,G,GV) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 - do i=Isq,Ieq+1 ; e(i,j,1) = -G%Zd_to_m*G%bathyT(i,j) ; enddo + do i=Isq,Ieq+1 ; e(i,j,1) = -G%bathyT(i,j) ; enddo do k=1,nz ; do i=Isq,Ieq+1 - e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_m + e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_Z enddo ; enddo enddo - call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp) + call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) endif ! Here layer interface heights, e, are calculated. -!$OMP parallel default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,h,G,GV,e_tidal,CS) if (CS%tides) then -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) - e_tidal(i,j) + e(i,j,nz+1) = -GV%Z_to_m*(G%bathyT(i,j) + e_tidal(i,j)) enddo ; enddo else -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) + e(i,j,nz+1) = -GV%Z_to_m*G%bathyT(i,j) enddo ; enddo endif -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=nz,1,-1 ; do i=Isq,Ieq+1 e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_m enddo ; enddo ; enddo -!$OMP end parallel - if (use_EOS) then + if (use_EOS) then ! Calculate in-situ densities (rho_star). ! With a bulk mixed layer, replace the T & S of any layers that are @@ -493,8 +477,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta tv_tmp%eqn_of_state => tv%eqn_of_state do i=Isq,Ieq+1 ; p_ref(i) = tv%P_Ref ; enddo -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,nkmb,tv_tmp,tv,p_ref,GV) & -!$OMP private(Rho_cv_BL) + !$OMP parallel do default(shared) private(Rho_cv_BL) do j=Jsq,Jeq+1 do k=1,nkmb ; do i=Isq,Ieq+1 tv_tmp%T(i,j,k) = tv%T(i,j,k) ; tv_tmp%S(i,j,k) = tv%S(i,j,k) @@ -518,7 +501,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! This no longer includes any pressure dependency, since this routine ! will come down with a fatal error if there is any compressibility. -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,tv_tmp,p_ref,rho_star,tv,G_Rho0) + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=Jsq,Jeq+1 call calculate_density(tv_tmp%T(:,j,k), tv_tmp%S(:,j,k), p_ref, rho_star(:,j,k), & Isq,Ieq-Isq+2,tv%eqn_of_state) @@ -528,8 +511,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! Here the layer Montgomery potentials, M, are calculated. if (use_EOS) then -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,M,CS,rho_star,e,use_p_atm, & -!$OMP p_atm,I_Rho0) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 M(i,j,1) = CS%GFS_scale * (rho_star(i,j,1) * e(i,j,1)) @@ -540,7 +522,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta enddo ; enddo enddo else ! not use_EOS -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,M,GV,e,use_p_atm,p_atm,I_Rho0) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 M(i,j,1) = GV%g_prime(1) * e(i,j,1) @@ -560,9 +542,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! Calculate the pressure force. On a Cartesian grid, ! PFu = - dM/dx and PFv = - dM/dy. if (use_EOS) then -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,js,je,is,ie,nz,e,h_neglect, & -!$OMP rho_star,G,PFu,CS,PFv,M) & -!$OMP private(h_star,PFu_bc,PFv_bc) + !$OMP parallel do default(shared) private(h_star,PFu_bc,PFv_bc) do k=1,nz do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 h_star(i,j) = (e(i,j,K) - e(i,j,K+1)) + h_neglect @@ -583,7 +563,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta enddo ; enddo enddo ! k-loop else ! .not. use_EOS -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,is,ie,js,je,nz,PFu,PFv,M,G) + !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) @@ -599,12 +579,12 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! eta is the sea surface height relative to a time-invariant geoid, for ! comparison with what is used for eta in btstep. See how e was calculated ! about 200 lines above. -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,eta,e,e_tidal,GV) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + e_tidal(i,j)*GV%m_to_H + eta(i,j) = e(i,j,1)*GV%m_to_H + e_tidal(i,j)*GV%Z_to_H enddo ; enddo else -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,eta,e,GV) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 eta(i,j) = e(i,j,1)*GV%m_to_H enddo ; enddo @@ -613,7 +593,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta if (CS%id_PFu_bc>0) call post_data(CS%id_PFu_bc, CS%PFu_bc, CS%diag) if (CS%id_PFv_bc>0) call post_data(CS%id_PFv_bc, CS%PFv_bc, CS%diag) - if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, e_tidal, CS%diag) + if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, GV%Z_to_m*e_tidal(:,:), CS%diag) end subroutine PressureForce_Mont_Bouss diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 9bf98856d8..2158d98b3f 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -302,7 +302,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*G%Zd_to_m*G%bathyT(i,j) + za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*GV%Z_to_m*G%bathyT(i,j) enddo do k=nz,1,-1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) + dza(i,j,k) @@ -315,7 +315,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth enddo ; enddo - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=1.0) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) - GV%g_Earth*e_tidal(i,j) @@ -455,7 +455,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading, in m. - z_bathy, & ! The height of the bathymetry, in m. + z_bathy, & ! The height of the bathymetry, in depth units (Z). dM ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. real, dimension(SZI_(G)) :: & @@ -527,7 +527,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p rho_ref = CS%Rho0 do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - z_bathy(i,j) = G%Zd_to_m*G%bathyT(i,j) + z_bathy(i,j) = GV%Z_to_m*G%bathyT(i,j) enddo ; enddo if (CS%tides) then @@ -538,25 +538,25 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - e(i,j,1) = -G%Zd_to_m*G%bathyT(i,j) + e(i,j,1) = -G%bathyT(i,j) enddo do k=1,nz ; do i=Isq,Ieq+1 - e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_m + e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_Z enddo ; enddo enddo - call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp) + call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) endif ! Here layer interface heights, e, are calculated. if (CS%tides) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) - e_tidal(i,j) + e(i,j,nz+1) = -GV%Z_to_m*(G%bathyT(i,j) + e_tidal(i,j)) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) + e(i,j,nz+1) = -GV%Z_to_m*G%bathyT(i,j) enddo ; enddo endif !$OMP parallel do default(shared) @@ -762,7 +762,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p ! about 200 lines above. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + e_tidal(i,j)*GV%m_to_H + eta(i,j) = e(i,j,1)*GV%m_to_H + e_tidal(i,j)*GV%Z_to_H enddo ; enddo else !$OMP parallel do default(shared) @@ -772,7 +772,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p endif endif - if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, e_tidal, CS%diag) + if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, GV%Z_to_m*e_tidal(:,:), CS%diag) end subroutine PressureForce_AFV_Bouss diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 1d2d84e98c..8c173fff4b 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -269,7 +269,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*G%Zd_to_m*G%bathyT(i,j) + za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*GV%Z_to_m*G%bathyT(i,j) enddo do k=nz,1,-1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) + dza(i,j,k) @@ -282,7 +282,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth enddo ; enddo - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=1.0) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) - GV%g_Earth*e_tidal(i,j) @@ -437,7 +437,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in m. real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in m. + ! astronomical sources and self-attraction and loading, in depth units (Z). z_bathy, & ! The height of the bathymetry, in m. dM ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. @@ -512,7 +512,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at rho_ref = CS%Rho0 do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - z_bathy(i,j) = G%Zd_to_m*G%bathyT(i,j) + z_bathy(i,j) = GV%Z_to_m*G%bathyT(i,j) enddo ; enddo if (CS%tides) then @@ -523,25 +523,25 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - e(i,j,1) = -G%Zd_to_m*G%bathyT(i,j) + e(i,j,1) = -GV%Z_to_m*G%bathyT(i,j) enddo do k=1,nz ; do i=Isq,Ieq+1 e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_m enddo ; enddo enddo - call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp) + call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) endif ! Here layer interface heights, e, are calculated. if (CS%tides) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) - e_tidal(i,j) + e(i,j,nz+1) = -GV%Z_to_m*(G%bathyT(i,j) + e_tidal(i,j)) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) + e(i,j,nz+1) = -GV%Z_to_m*G%bathyT(i,j) enddo ; enddo endif !$OMP parallel do default(shared) @@ -755,7 +755,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at ! about 200 lines above. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + e_tidal(i,j)*GV%m_to_H + eta(i,j) = e(i,j,1)*GV%m_to_H + e_tidal(i,j)*GV%Z_to_H enddo ; enddo else !$OMP parallel do default(shared) @@ -765,7 +765,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at endif endif - if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, e_tidal, CS%diag) + if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, GV%Z_to_m*e_tidal(:,:), CS%diag) end subroutine PressureForce_blk_AFV_Bouss From 5907c9e14150e23560b0b246a77253bbeb7fc7f1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 1 Sep 2018 07:45:40 -0400 Subject: [PATCH 0687/1072] +Boussinesq Montgomery Press Force in depth units Changed the calculatios in PressureForce_Mont_Bouss to work in depth units and added an optional argument to Set_pbce_Bouss to specify the units of the interface height arguments. All answers are bitwise identical for no Z-rescaling or for rescaling by 2^93 or 2^-93. --- src/core/MOM_PressureForce_Montgomery.F90 | 44 +++++++++++++---------- 1 file changed, 25 insertions(+), 19 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 0548cc0dd2..cdff786c15 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -428,7 +428,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta "can no longer be used with a compressible EOS. Use #define ANALYTIC_FV_PGF.") endif - h_neglect = GV%H_subroundoff * GV%H_to_m + h_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/CS%Rho0 G_Rho0 = GV%g_Earth/GV%Rho0 @@ -451,17 +451,17 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta if (CS%tides) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -GV%Z_to_m*(G%bathyT(i,j) + e_tidal(i,j)) + e(i,j,nz+1) = -(G%bathyT(i,j) + e_tidal(i,j)) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -GV%Z_to_m*G%bathyT(i,j) + e(i,j,nz+1) = -G%bathyT(i,j) enddo ; enddo endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=nz,1,-1 ; do i=Isq,Ieq+1 - e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_m + e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_Z enddo ; enddo ; enddo if (use_EOS) then @@ -505,7 +505,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta do k=1,nz+1 ; do j=Jsq,Jeq+1 call calculate_density(tv_tmp%T(:,j,k), tv_tmp%S(:,j,k), p_ref, rho_star(:,j,k), & Isq,Ieq-Isq+2,tv%eqn_of_state) - do i=Isq,Ieq+1 ; rho_star(i,j,k) = G_Rho0*rho_star(i,j,k) ; enddo + do i=Isq,Ieq+1 ; rho_star(i,j,k) = GV%Z_to_m*G_Rho0*rho_star(i,j,k) ; enddo enddo ; enddo endif ! use_EOS @@ -525,18 +525,18 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - M(i,j,1) = GV%g_prime(1) * e(i,j,1) + M(i,j,1) = GV%g_prime(1) * GV%Z_to_m*e(i,j,1) if (use_p_atm) M(i,j,1) = M(i,j,1) + p_atm(i,j) * I_Rho0 enddo do k=2,nz ; do i=Isq,Ieq+1 - M(i,j,k) = M(i,j,k-1) + GV%g_prime(K) * e(i,j,K) + M(i,j,k) = M(i,j,k-1) + GV%g_prime(K) * GV%Z_to_m*e(i,j,K) enddo ; enddo enddo endif ! use_EOS if (present(pbce)) then call Set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce, & - rho_star) + rho_star, GV%m_to_Z) endif ! Calculate the pressure force. On a Cartesian grid, @@ -581,12 +581,12 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! about 200 lines above. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + e_tidal(i,j)*GV%Z_to_H + eta(i,j) = e(i,j,1)*GV%Z_to_H + e_tidal(i,j)*GV%Z_to_H enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + eta(i,j) = e(i,j,1)*GV%Z_to_H enddo ; enddo endif endif @@ -599,10 +599,10 @@ end subroutine PressureForce_Mont_Bouss !> Determines the partial derivative of the acceleration due !! to pressure forces with the free surface height. -subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star) +subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star, m_to_Z) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height, in H. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height, in Z. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, intent(in) :: g_Earth !< The gravitational acceleration, in m s-2. real, intent(in) :: Rho0 !< The "Boussinesq" ocean density, in kg m-3. @@ -613,8 +613,10 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star intent(out) :: pbce !< The baroclinic pressure anomaly in each layer due !! to free surface height anomalies, in m2 H-1 s-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - optional, intent(in) :: rho_star !< The layer densities (maybe compressibility - !! compensated), times g/rho_0, in m s-2. + optional, intent(in) :: rho_star !< The layer densities (maybe compressibility + !! compensated), times g/rho_0, in m2 Z-1 s-2. + real, optional, intent(in) :: m_to_Z !< The conversion factor from m to the units of e. + ! Local variables real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer ! thicknesses, in m-1. @@ -628,16 +630,20 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star real :: Rho0xG ! g_Earth * Rho0 in kg s-2 m-2. logical :: use_EOS ! If true, density is calculated from T & S using ! an equation of state. + real :: m_Z ! The conversion factor from m to depth units + real :: Z_to_m ! The conversion factor from depth units to m real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m. + ! in roundoff and can be neglected, in Z. integer :: Isq, Ieq, Jsq, Jeq, nz, i, j, k Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke - Rho0xG = Rho0*g_Earth + m_Z = 1.0 ; if (present(m_to_Z)) m_Z = m_to_Z + Z_to_m = 1.0 ; if (present(m_to_Z)) Z_to_m = 1.0 / m_to_Z + Rho0xG = Rho0*g_Earth*Z_to_m G_Rho0 = g_Earth/Rho0 use_EOS = associated(tv%eqn_of_state) - h_neglect = GV%H_subroundoff*GV%H_to_m + h_neglect = GV%H_subroundoff*GV%H_to_m*m_Z if (use_EOS) then if (present(rho_star)) then @@ -646,8 +652,8 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star !$OMP private(Ihtot) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - Ihtot(i) = 1.0 / (((e(i,j,1)-e(i,j,nz+1)) + h_neglect) * GV%m_to_H) - pbce(i,j,1) = GFS_scale * rho_star(i,j,1) * GV%H_to_m + Ihtot(i) = (GV%H_to_m * m_Z) / ((e(i,j,1)-e(i,j,nz+1)) + h_neglect) + pbce(i,j,1) = GFS_scale * rho_star(i,j,1) * (GV%H_to_m * m_Z) enddo do k=2,nz ; do i=Isq,Ieq+1 pbce(i,j,k) = pbce(i,j,k-1) + (rho_star(i,j,k)-rho_star(i,j,k-1)) * & From a60e67dcb4f5161279d93cc14b753a1b0146ec80 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 1 Sep 2018 07:51:26 -0400 Subject: [PATCH 0688/1072] Boussinesq analytic_FV Press Force in depth units Changed the calculations to use depth units in PressureForce_AFV_Bouss and PressureForce_blk_AFV_Bouss. All answers are bitwise identical for no Z-rescaling or for rescaling by 2^93 or 2^-93. --- src/core/MOM_PressureForce_analytic_FV.F90 | 48 ++++++++++----------- src/core/MOM_PressureForce_blocked_AFV.F90 | 49 +++++++++++----------- 2 files changed, 47 insertions(+), 50 deletions(-) diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 2158d98b3f..d3f74c7f0c 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -451,10 +451,10 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p !! calculate PFu and PFv, in H, with any tidal !! contributions or compressibility compensation. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in m. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in depth units (Z). real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in m. + ! astronomical sources and self-attraction and loading, in Z. z_bathy, & ! The height of the bathymetry, in depth units (Z). dM ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. @@ -489,17 +489,16 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p real :: rho_in_situ(SZI_(G)) ! The in situ density, in kg m-3. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, in Pa (usually 2e7 Pa = 2000 dbar). - real :: p0(SZI_(G)) ! An array of zeros to use for pressure in Pa. + real :: p0(SZI_(G)) ! An array of zeros to use for pressure in Pa. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in m. real :: I_Rho0 ! 1/Rho0. - real :: G_Rho0 ! G_Earth / Rho0 in m4 s-2 kg-1. + real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. real :: Rho_ref ! The reference density in kg m-3. - real :: dz_neglect ! A minimal thickness in m, like e. + real :: dz_neglect ! A minimal thickness in Z, like e. logical :: use_p_atm ! If true, use the atmospheric pressure. logical :: use_ALE ! If true, use an ALE pressure reconstruction. - logical :: use_EOS ! If true, density is calculated from T & S using an - ! equation of state. + logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. real, parameter :: C1_6 = 1.0/6.0 @@ -521,13 +520,13 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p if (associated(ALE_CSp)) use_ALE = CS%reconstruct .and. use_EOS h_neglect = GV%H_subroundoff - dz_neglect = GV%H_subroundoff * GV%H_to_m + dz_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/GV%Rho0 - G_Rho0 = GV%g_Earth/GV%Rho0 + G_Rho0 = GV%Z_to_m*GV%g_Earth/GV%Rho0 rho_ref = CS%Rho0 do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - z_bathy(i,j) = GV%Z_to_m*G%bathyT(i,j) + z_bathy(i,j) = G%bathyT(i,j) enddo ; enddo if (CS%tides) then @@ -551,20 +550,19 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p if (CS%tides) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -GV%Z_to_m*(G%bathyT(i,j) + e_tidal(i,j)) + e(i,j,nz+1) = -(G%bathyT(i,j) + e_tidal(i,j)) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -GV%Z_to_m*G%bathyT(i,j) + e(i,j,nz+1) = -G%bathyT(i,j) enddo ; enddo endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1; do k=nz,1,-1 ; do i=Isq,Ieq+1 - e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_m + e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_Z enddo ; enddo ; enddo - if (use_EOS) then ! With a bulk mixed layer, replace the T & S of any layers that are ! lighter than the the buffer layer with the properties of the buffer @@ -641,12 +639,12 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p if (use_p_atm) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - pa(i,j) = (rho_ref*GV%g_Earth)*e(i,j,1) + p_atm(i,j) + pa(i,j) = (rho_ref*GV%g_Earth*GV%Z_to_m)*e(i,j,1) + p_atm(i,j) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - pa(i,j) = (rho_ref*GV%g_Earth)*e(i,j,1) + pa(i,j) = (rho_ref*GV%g_Earth*GV%Z_to_m)*e(i,j,1) enddo ; enddo endif !$OMP parallel do default(shared) @@ -672,26 +670,26 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p if ( CS%Recon_Scheme == 1 ) then call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth, & + rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, & dz_neglect, z_bathy, G%HI, G%HI, & tv%eqn_of_state, dpa, intz_dpa, intx_dpa, inty_dpa, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then call int_density_dz_generic_ppm( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), & tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth, & + rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, & G%HI, G%HI, tv%eqn_of_state, dpa, intz_dpa, & intx_dpa, inty_dpa) endif else call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth, G%HI, G%HI, tv%eqn_of_state, & + rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, G%HI, G%HI, tv%eqn_of_state, & dpa, intz_dpa, intx_dpa, inty_dpa, & z_bathy, dz_neglect, CS%useMassWghtInterp) endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - intz_dpa(i,j) = intz_dpa(i,j)*GV%m_to_H + intz_dpa(i,j) = intz_dpa(i,j)*GV%Z_to_H enddo ; enddo else !$OMP parallel do default(shared) @@ -716,7 +714,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p PFu(I,j,k) = (((pa(i,j)*h(i,j,k) + intz_dpa(i,j)) - & (pa(i+1,j)*h(i+1,j,k) + intz_dpa(i+1,j))) + & ((h(i+1,j,k) - h(i,j,k)) * intx_pa(I,j) - & - (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa(I,j) * GV%m_to_H)) * & + (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa(I,j) * GV%Z_to_H)) * & ((2.0*I_Rho0*G%IdxCu(I,j)) / & ((h(i,j,k) + h(i+1,j,k)) + h_neglect)) intx_pa(I,j) = intx_pa(I,j) + intx_dpa(I,j) @@ -727,7 +725,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p PFv(i,J,k) = (((pa(i,j)*h(i,j,k) + intz_dpa(i,j)) - & (pa(i,j+1)*h(i,j+1,k) + intz_dpa(i,j+1))) + & ((h(i,j+1,k) - h(i,j,k)) * inty_pa(i,J) - & - (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa(i,J) * GV%m_to_H)) * & + (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa(i,J) * GV%Z_to_H)) * & ((2.0*I_Rho0*G%IdyCv(i,J)) / & ((h(i,j,k) + h(i,j+1,k)) + h_neglect)) inty_pa(i,J) = inty_pa(i,J) + inty_dpa(i,J) @@ -752,7 +750,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p endif if (present(pbce)) then - call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce) + call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce, m_to_Z=GV%m_to_Z) endif if (present(eta)) then @@ -762,12 +760,12 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p ! about 200 lines above. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + e_tidal(i,j)*GV%Z_to_H + eta(i,j) = e(i,j,1)*GV%Z_to_H + e_tidal(i,j)*GV%Z_to_H enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + eta(i,j) = e(i,j,1)*GV%Z_to_H enddo ; enddo endif endif diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 8c173fff4b..48b38a3a4e 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -419,7 +419,7 @@ end subroutine PressureForce_blk_AFV_nonBouss subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, pbce, eta) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg/m2) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration (m/s2) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration (m/s2) @@ -434,7 +434,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at !! calculate PFu and PFv, in H, with any tidal !! contributions or compressibility compensation. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in m. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in depth units (Z). real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading, in depth units (Z). @@ -474,11 +474,11 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at ! density, in Pa (usually 2e7 Pa = 2000 dbar). real :: p0(SZI_(G)) ! An array of zeros to use for pressure in Pa. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m. + ! in roundoff and can be neglected, in H. real :: I_Rho0 ! 1/Rho0. - real :: G_Rho0 ! G_Earth / Rho0 in m4 s-2 kg-1. + real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. real :: Rho_ref ! The reference density in kg m-3. - real :: dz_neglect ! A minimal thickness in m, like e. + real :: dz_neglect ! A minimal thickness in Z, like e. logical :: use_p_atm ! If true, use the atmospheric pressure. logical :: use_ALE ! If true, use an ALE pressure reconstruction. logical :: use_EOS ! If true, density is calculated from T & S using an @@ -506,13 +506,13 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at if (associated(ALE_CSp)) use_ALE = CS%reconstruct .and. use_EOS h_neglect = GV%H_subroundoff - dz_neglect = GV%H_subroundoff * GV%H_to_m + dz_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/GV%Rho0 - G_Rho0 = GV%g_Earth/GV%Rho0 + G_Rho0 = GV%Z_to_m*GV%g_Earth/GV%Rho0 rho_ref = CS%Rho0 do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - z_bathy(i,j) = GV%Z_to_m*G%bathyT(i,j) + z_bathy(i,j) = G%bathyT(i,j) enddo ; enddo if (CS%tides) then @@ -523,10 +523,10 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - e(i,j,1) = -GV%Z_to_m*G%bathyT(i,j) + e(i,j,1) = -G%bathyT(i,j) enddo do k=1,nz ; do i=Isq,Ieq+1 - e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_m + e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_Z enddo ; enddo enddo call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) @@ -536,20 +536,19 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at if (CS%tides) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -GV%Z_to_m*(G%bathyT(i,j) + e_tidal(i,j)) + e(i,j,nz+1) = -(G%bathyT(i,j) + e_tidal(i,j)) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - e(i,j,nz+1) = -GV%Z_to_m*G%bathyT(i,j) + e(i,j,nz+1) = -G%bathyT(i,j) enddo ; enddo endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1; do k=nz,1,-1 ; do i=Isq,Ieq+1 - e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_m + e(i,j,K) = e(i,j,K+1) + h(i,j,k)*GV%H_to_Z enddo ; enddo ; enddo - if (use_EOS) then ! With a bulk mixed layer, replace the T & S of any layers that are ! lighter than the the buffer layer with the properties of the buffer @@ -641,12 +640,12 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at if (use_p_atm) then do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 i = ib+ioff_bk ; j = jb+joff_bk - pa_bk(ib,jb) = (rho_ref*GV%g_Earth)*e(i,j,1) + p_atm(i,j) + pa_bk(ib,jb) = (rho_ref*GV%g_Earth*GV%Z_to_m)*e(i,j,1) + p_atm(i,j) enddo ; enddo else do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 i = ib+ioff_bk ; j = jb+joff_bk - pa_bk(ib,jb) = (rho_ref*GV%g_Earth)*e(i,j,1) + pa_bk(ib,jb) = (rho_ref*GV%g_Earth*GV%Z_to_m)*e(i,j,1) enddo ; enddo endif do jb=js_bk,je_bk ; do Ib=Isq_bk,Ieq_bk @@ -670,25 +669,25 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at if ( CS%Recon_Scheme == 1 ) then call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth, & + rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, & dz_neglect, z_bathy, G%HI, G%Block(n), & tv%eqn_of_state, dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then call int_density_dz_generic_ppm( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), & tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth, & + rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, & G%HI, G%Block(n), tv%eqn_of_state, dpa_bk, intz_dpa_bk, & intx_dpa_bk, inty_dpa_bk) endif else call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth, G%HI, G%Block(n), tv%eqn_of_state, & + rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, G%HI, G%Block(n), tv%eqn_of_state, & dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & z_bathy, dz_neglect, CS%useMassWghtInterp) endif do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 - intz_dpa_bk(ib,jb) = intz_dpa_bk(ib,jb)*GV%m_to_H + intz_dpa_bk(ib,jb) = intz_dpa_bk(ib,jb)*GV%Z_to_H enddo ; enddo else do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 @@ -711,7 +710,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at PFu(I,j,k) = (((pa_bk(ib,jb)*h(i,j,k) + intz_dpa_bk(ib,jb)) - & (pa_bk(ib+1,jb)*h(i+1,j,k) + intz_dpa_bk(ib+1,jb))) + & ((h(i+1,j,k) - h(i,j,k)) * intx_pa_bk(Ib,jb) - & - (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa_bk(Ib,jb) * GV%m_to_H)) * & + (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa_bk(Ib,jb) * GV%Z_to_H)) * & ((2.0*I_Rho0*G%IdxCu(I,j)) / & ((h(i,j,k) + h(i+1,j,k)) + h_neglect)) intx_pa_bk(Ib,jb) = intx_pa_bk(Ib,jb) + intx_dpa_bk(Ib,jb) @@ -722,7 +721,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at PFv(i,J,k) = (((pa_bk(ib,jb)*h(i,j,k) + intz_dpa_bk(ib,jb)) - & (pa_bk(ib,jb+1)*h(i,j+1,k) + intz_dpa_bk(ib,jb+1))) + & ((h(i,j+1,k) - h(i,j,k)) * inty_pa_bk(ib,Jb) - & - (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa_bk(ib,Jb) * GV%m_to_H)) * & + (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa_bk(ib,Jb) * GV%Z_to_H)) * & ((2.0*I_Rho0*G%IdyCv(i,J)) / & ((h(i,j,k) + h(i,j+1,k)) + h_neglect)) inty_pa_bk(ib,Jb) = inty_pa_bk(ib,Jb) + inty_dpa_bk(ib,Jb) @@ -745,7 +744,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at enddo if (present(pbce)) then - call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce) + call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce, m_to_Z=GV%m_to_Z) endif if (present(eta)) then @@ -755,12 +754,12 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at ! about 200 lines above. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + e_tidal(i,j)*GV%Z_to_H + eta(i,j) = e(i,j,1)*GV%Z_to_H + e_tidal(i,j)*GV%Z_to_H enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta(i,j) = e(i,j,1)*GV%m_to_H + eta(i,j) = e(i,j,1)*GV%Z_to_H enddo ; enddo endif endif From 16cd71efd3dbc8c1770217988cd19c724d9a3d3a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 1 Sep 2018 10:37:38 -0400 Subject: [PATCH 0689/1072] +Removed m_to_Z optional arg from set_pbce_Bouss Removed optional argument m_to_Z from set_pbce_Bouss, and cleaned up code in all of the MOM_PressureForce codes. All answers are bitwise identical. --- src/core/MOM_PressureForce_Montgomery.F90 | 32 +++++++++------------- src/core/MOM_PressureForce_analytic_FV.F90 | 27 ++++++++---------- src/core/MOM_PressureForce_blocked_AFV.F90 | 11 ++------ 3 files changed, 28 insertions(+), 42 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index cdff786c15..079bab6b19 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -535,8 +535,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta endif ! use_EOS if (present(pbce)) then - call Set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce, & - rho_star, GV%m_to_Z) + call Set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce, rho_star) endif ! Calculate the pressure force. On a Cartesian grid, @@ -599,7 +598,7 @@ end subroutine PressureForce_Mont_Bouss !> Determines the partial derivative of the acceleration due !! to pressure forces with the free surface height. -subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star, m_to_Z) +subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height, in Z. @@ -615,7 +614,6 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: rho_star !< The layer densities (maybe compressibility !! compensated), times g/rho_0, in m2 Z-1 s-2. - real, optional, intent(in) :: m_to_Z !< The conversion factor from m to the units of e. ! Local variables real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer @@ -627,33 +625,29 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star real :: dR_dS(SZI_(G)) ! and salinity in kg m-3 K-1 and kg m-3 PSU-1. real :: rho_in_situ(SZI_(G)) !In-situ density at the top of a layer. real :: G_Rho0 ! g_Earth / Rho0 in m4 s-2 kg-1. - real :: Rho0xG ! g_Earth * Rho0 in kg s-2 m-2. + real :: Rho0xG ! g_Earth * Rho0 in kg s-2 m-1 Z-1. logical :: use_EOS ! If true, density is calculated from T & S using ! an equation of state. - real :: m_Z ! The conversion factor from m to depth units - real :: Z_to_m ! The conversion factor from depth units to m - real :: h_neglect ! A thickness that is so small it is usually lost + real :: z_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in Z. integer :: Isq, Ieq, Jsq, Jeq, nz, i, j, k Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke - m_Z = 1.0 ; if (present(m_to_Z)) m_Z = m_to_Z - Z_to_m = 1.0 ; if (present(m_to_Z)) Z_to_m = 1.0 / m_to_Z - Rho0xG = Rho0*g_Earth*Z_to_m + Rho0xG = Rho0*g_Earth*GV%Z_to_m G_Rho0 = g_Earth/Rho0 use_EOS = associated(tv%eqn_of_state) - h_neglect = GV%H_subroundoff*GV%H_to_m*m_Z + z_neglect = GV%H_subroundoff*GV%H_to_Z if (use_EOS) then if (present(rho_star)) then -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,h_neglect,pbce,rho_star,& +!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,z_neglect,pbce,rho_star,& !$OMP GFS_scale,GV) & !$OMP private(Ihtot) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - Ihtot(i) = (GV%H_to_m * m_Z) / ((e(i,j,1)-e(i,j,nz+1)) + h_neglect) - pbce(i,j,1) = GFS_scale * rho_star(i,j,1) * (GV%H_to_m * m_Z) + Ihtot(i) = GV%H_to_Z / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) + pbce(i,j,1) = GFS_scale * rho_star(i,j,1) * GV%H_to_Z enddo do k=2,nz ; do i=Isq,Ieq+1 pbce(i,j,k) = pbce(i,j,k-1) + (rho_star(i,j,k)-rho_star(i,j,k-1)) * & @@ -661,12 +655,12 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star enddo ; enddo enddo ! end of j loop else -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,tv,h_neglect,G_Rho0,Rho0xG,& +!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,tv,z_neglect,G_Rho0,Rho0xG,& !$OMP pbce,GFS_scale,GV) & !$OMP private(Ihtot,press,rho_in_situ,T_int,S_int,dR_dT,dR_dS) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - Ihtot(i) = 1.0 / (((e(i,j,1)-e(i,j,nz+1)) + h_neglect) * GV%m_to_H) + Ihtot(i) = GV%H_to_m / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) press(i) = -Rho0xG*e(i,j,1) enddo call calculate_density(tv%T(:,j,1), tv%S(:,j,1), press, rho_in_situ, & @@ -692,10 +686,10 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star enddo ! end of j loop endif else ! not use_EOS -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,GV,h_neglect,pbce) private(Ihtot) +!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,GV,z_neglect,pbce) private(Ihtot) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - Ihtot(i) = 1.0 / (((e(i,j,1)-e(i,j,nz+1)) + h_neglect) * GV%m_to_H) + Ihtot(i) = GV%H_to_m / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) pbce(i,j,1) = GV%g_prime(1) * GV%H_to_m enddo do k=2,nz ; do i=Isq,Ieq+1 diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index d3f74c7f0c..99ffda6a88 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -455,7 +455,6 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading, in Z. - z_bathy, & ! The height of the bathymetry, in depth units (Z). dM ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. real, dimension(SZI_(G)) :: & @@ -492,6 +491,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p real :: p0(SZI_(G)) ! An array of zeros to use for pressure in Pa. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in m. + real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2. real :: I_Rho0 ! 1/Rho0. real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. real :: Rho_ref ! The reference density in kg m-3. @@ -522,13 +522,10 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/GV%Rho0 - G_Rho0 = GV%Z_to_m*GV%g_Earth/GV%Rho0 + g_Earth_z = GV%g_Earth*GV%Z_to_m + G_Rho0 = g_Earth_z/GV%Rho0 rho_ref = CS%Rho0 - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - z_bathy(i,j) = G%bathyT(i,j) - enddo ; enddo - if (CS%tides) then ! Determine the surface height anomaly for calculating self attraction ! and loading. This should really be based on bottom pressure anomalies, @@ -639,12 +636,12 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p if (use_p_atm) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - pa(i,j) = (rho_ref*GV%g_Earth*GV%Z_to_m)*e(i,j,1) + p_atm(i,j) + pa(i,j) = (rho_ref*g_Earth_z)*e(i,j,1) + p_atm(i,j) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - pa(i,j) = (rho_ref*GV%g_Earth*GV%Z_to_m)*e(i,j,1) + pa(i,j) = (rho_ref*g_Earth_z)*e(i,j,1) enddo ; enddo endif !$OMP parallel do default(shared) @@ -670,22 +667,22 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p if ( CS%Recon_Scheme == 1 ) then call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, & - dz_neglect, z_bathy, G%HI, G%HI, & + rho_ref, CS%Rho0, g_Earth_z, & + dz_neglect, G%bathyT, G%HI, G%HI, & tv%eqn_of_state, dpa, intz_dpa, intx_dpa, inty_dpa, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then call int_density_dz_generic_ppm( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), & tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, & + rho_ref, CS%Rho0, g_Earth_z, & G%HI, G%HI, tv%eqn_of_state, dpa, intz_dpa, & intx_dpa, inty_dpa) endif else call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, G%HI, G%HI, tv%eqn_of_state, & + rho_ref, CS%Rho0, g_Earth_z, G%HI, G%HI, tv%eqn_of_state, & dpa, intz_dpa, intx_dpa, inty_dpa, & - z_bathy, dz_neglect, CS%useMassWghtInterp) + G%bathyT, dz_neglect, CS%useMassWghtInterp) endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -694,7 +691,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - dz(i,j) = GV%g_Earth*GV%H_to_m*h(i,j,k) + dz(i,j) = g_Earth_z * GV%H_to_Z*h(i,j,k) dpa(i,j) = (GV%Rlay(k) - rho_ref)*dz(i,j) intz_dpa(i,j) = 0.5*(GV%Rlay(k) - rho_ref)*dz(i,j)*h(i,j,k) enddo ; enddo @@ -750,7 +747,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p endif if (present(pbce)) then - call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce, m_to_Z=GV%m_to_Z) + call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce) endif if (present(eta)) then diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 48b38a3a4e..cb64f16d48 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -438,7 +438,6 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading, in depth units (Z). - z_bathy, & ! The height of the bathymetry, in m. dM ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. real, dimension(SZI_(G)) :: & @@ -511,10 +510,6 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at G_Rho0 = GV%Z_to_m*GV%g_Earth/GV%Rho0 rho_ref = CS%Rho0 - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - z_bathy(i,j) = G%bathyT(i,j) - enddo ; enddo - if (CS%tides) then ! Determine the surface height anomaly for calculating self attraction ! and loading. This should really be based on bottom pressure anomalies, @@ -670,7 +665,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, & - dz_neglect, z_bathy, G%HI, G%Block(n), & + dz_neglect, G%bathyT, G%HI, G%Block(n), & tv%eqn_of_state, dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then @@ -684,7 +679,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, G%HI, G%Block(n), tv%eqn_of_state, & dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & - z_bathy, dz_neglect, CS%useMassWghtInterp) + G%bathyT, dz_neglect, CS%useMassWghtInterp) endif do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 intz_dpa_bk(ib,jb) = intz_dpa_bk(ib,jb)*GV%Z_to_H @@ -744,7 +739,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at enddo if (present(pbce)) then - call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce, m_to_Z=GV%m_to_Z) + call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce) endif if (present(eta)) then From efc2f450460c027c51e3e1479b178c2d06fcce17 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 1 Sep 2018 12:23:42 -0400 Subject: [PATCH 0690/1072] Code cleanup in MOM_PressureForce_blocked_AFV Cleaned up the code in PressureForce_blk_AFV_Bouss by adding new simplifying variables. All answers are bitwise identical. --- src/core/MOM_PressureForce_blocked_AFV.F90 | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index cb64f16d48..7119426871 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -475,6 +475,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. real :: I_Rho0 ! 1/Rho0. + real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2. real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. real :: Rho_ref ! The reference density in kg m-3. real :: dz_neglect ! A minimal thickness in Z, like e. @@ -507,7 +508,8 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/GV%Rho0 - G_Rho0 = GV%Z_to_m*GV%g_Earth/GV%Rho0 + g_Earth_z = GV%g_Earth*GV%Z_to_m + G_Rho0 = g_Earth_z / GV%Rho0 rho_ref = CS%Rho0 if (CS%tides) then @@ -635,12 +637,12 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at if (use_p_atm) then do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 i = ib+ioff_bk ; j = jb+joff_bk - pa_bk(ib,jb) = (rho_ref*GV%g_Earth*GV%Z_to_m)*e(i,j,1) + p_atm(i,j) + pa_bk(ib,jb) = (rho_ref*g_Earth_z)*e(i,j,1) + p_atm(i,j) enddo ; enddo else do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 i = ib+ioff_bk ; j = jb+joff_bk - pa_bk(ib,jb) = (rho_ref*GV%g_Earth*GV%Z_to_m)*e(i,j,1) + pa_bk(ib,jb) = (rho_ref*g_Earth_z)*e(i,j,1) enddo ; enddo endif do jb=js_bk,je_bk ; do Ib=Isq_bk,Ieq_bk @@ -664,20 +666,20 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at if ( CS%Recon_Scheme == 1 ) then call int_density_dz_generic_plm( T_t(:,:,k), T_b(:,:,k), & S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, & + rho_ref, CS%Rho0, g_Earth_z, & dz_neglect, G%bathyT, G%HI, G%Block(n), & tv%eqn_of_state, dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & useMassWghtInterp = CS%useMassWghtInterp) elseif ( CS%Recon_Scheme == 2 ) then call int_density_dz_generic_ppm( tv%T(:,:,k), T_t(:,:,k), T_b(:,:,k), & tv%S(:,:,k), S_t(:,:,k), S_b(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, & + rho_ref, CS%Rho0, g_Earth_z, & G%HI, G%Block(n), tv%eqn_of_state, dpa_bk, intz_dpa_bk, & intx_dpa_bk, inty_dpa_bk) endif else call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & - rho_ref, CS%Rho0, GV%g_Earth*GV%Z_to_m, G%HI, G%Block(n), tv%eqn_of_state, & + rho_ref, CS%Rho0, g_Earth_z, G%HI, G%Block(n), tv%eqn_of_state, & dpa_bk, intz_dpa_bk, intx_dpa_bk, inty_dpa_bk, & G%bathyT, dz_neglect, CS%useMassWghtInterp) endif @@ -687,7 +689,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at else do jb=Jsq_bk,Jeq_bk+1 ; do ib=Isq_bk,Ieq_bk+1 i = ib+ioff_bk ; j = jb+joff_bk - dz_bk(ib,jb) = GV%g_Earth*GV%H_to_m*h(i,j,k) + dz_bk(ib,jb) = g_Earth_z*GV%H_to_Z*h(i,j,k) dpa_bk(ib,jb) = (GV%Rlay(k) - rho_ref)*dz_bk(ib,jb) intz_dpa_bk(ib,jb) = 0.5*(GV%Rlay(k) - rho_ref)*dz_bk(ib,jb)*h(i,j,k) enddo ; enddo From 2edb677558d8b644c19c0654ece07cfa3ef232bd Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 1 Sep 2018 12:24:56 -0400 Subject: [PATCH 0691/1072] Dimensional consistency testing in MOM_barotropic Changed the calculations and several variables in MOM_barotropic to work in depth units, for improved dimensional consistency testing. All answers are bitwise identical for no Z-rescaling or for rescaling by 2^93 or 2^-93. --- src/core/MOM_barotropic.F90 | 66 ++++++++++++++++++------------------- 1 file changed, 33 insertions(+), 33 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 0168af9df4..f240f4318c 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -97,7 +97,7 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: frhatv !< The fraction of the total column thickness interpolated to v grid points in each layer, nondim. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: IDatu - !< Inverse of the basin depth at u grid points, in m-1. + !< Inverse of the basin depth at u grid points, in Z-1. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: lin_drag_u !< A spatially varying linear drag coefficient acting on the zonal barotropic flow, in H s-1. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt_IC @@ -109,7 +109,7 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: ubtav !< The barotropic zonal velocity averaged over the baroclinic time step, m s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: IDatv - !< Inverse of the basin depth at v grid points, in m-1. + !< Inverse of the basin depth at v grid points, in Z-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: lin_drag_v !< A spatially varying linear drag coefficient acting on the zonal barotropic flow, in H s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt_IC @@ -135,15 +135,15 @@ module MOM_barotropic !< This is a copy of G%IareaT with wide halos, but will !! still utilize the macro IareaT when referenced, m-2. real ALLOCABLE_, dimension(NIMEMBW_,NJMEMW_) :: & - D_u_Cor, & !< A simply averaged depth at u points, in m. + D_u_Cor, & !< A simply averaged depth at u points, in Z. dy_Cu, & !< A copy of G%dy_Cu with wide halos, in m. IdxCu !< A copy of G%IdxCu with wide halos, in m-1. real ALLOCABLE_, dimension(NIMEMW_,NJMEMBW_) :: & - D_v_Cor, & !< A simply averaged depth at v points, in m. + D_v_Cor, & !< A simply averaged depth at v points, in Z. dx_Cv, & !< A copy of G%dx_Cv with wide halos, in m. IdyCv !< A copy of G%IdyCv with wide halos, in m-1. real ALLOCABLE_, dimension(NIMEMBW_,NJMEMBW_) :: & - q_D !< f / D at PV points, in m-1 s-1. + q_D !< f / D at PV points, in Z-1 s-1. real, dimension(:,:,:), pointer :: frhatu1 => NULL() !< Predictor step values of frhatu stored for diagnostics. real, dimension(:,:,:), pointer :: frhatv1 => NULL() !< Predictor step values of frhatv stored for diagnostics. @@ -496,7 +496,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & Rayleigh_u, & ! A Rayleigh drag timescale operating at u-points, in s-1. PFu_bt_sum, & ! The summed zonal barotropic pressure gradient force, in m s-2. Coru_bt_sum, & ! The summed zonal barotropic Coriolis acceleration, in m s-2. - DCor_u, & ! A simply averaged depth at u points, in m. + DCor_u, & ! A simply averaged depth at u points, in Z. Datu ! Basin depth at u-velocity grid points times the y-grid ! spacing, in H m. real, dimension(SZIW_(CS),SZJBW_(CS)) :: & @@ -527,7 +527,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & ! in m s-2. Corv_bt_sum, & ! The summed meridional barotropic Coriolis acceleration, ! in m s-2. - DCor_v, & ! A simply averaged depth at v points, in m. + DCor_v, & ! A simply averaged depth at v points, in Z. Datv ! Basin depth at v-velocity grid points times the x-grid ! spacing, in H m. real, target, dimension(SZIW_(CS),SZJW_(CS)) :: & @@ -568,7 +568,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & real, dimension(SZIW_(CS),SZJBW_(CS)) :: & vbt_prev, vhbt_prev, vbt_sum_prev, vhbt_sum_prev, vbt_wtd_prev ! for OBC - real :: I_Rho0 ! The inverse of the mean density (Rho0), in m3 kg-1. + real :: mass_to_Z ! The depth unit converison divided by the mean density (Rho0), in m3 kg-1. real :: visc_rem ! A work variable that may equal visc_rem_[uv]. Nondim. real :: vel_prev ! The previous velocity in m s-1. real :: dtbt ! The barotropic time step in s. @@ -708,7 +708,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & dtbt = dt * Instep bebt = CS%bebt be_proj = CS%bebt - I_Rho0 = 1.0/GV%Rho0 + mass_to_Z = GV%m_to_Z / GV%Rho0 !--- setup the weight when computing vbt_trans and ubt_trans if (project_velocity) then @@ -804,18 +804,18 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & ! ### bathyT here should be replaced with bathyT+eta(Bous) or eta(non-Bous). !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - DCor_u(I,j) = 0.5 * GV%Z_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j)) + DCor_u(I,j) = 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j)) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - DCor_v(i,J) = 0.5 * GV%Z_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j)) + DCor_v(i,J) = 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j)) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do I=is-1,ie q(I,J) = 0.25 * G%CoriolisBu(I,J) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & - (GV%Z_to_m*((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & - (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)))) + ((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & + (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)) ) enddo ; enddo ! With very wide halos, q and D need to be calculated on the available data @@ -972,24 +972,24 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & ! ### IDatu here should be replaced with 1/D+eta(Bous) or 1/eta(non-Bous). ! ### although with BT_cont_types IDatu should be replaced by ! ### CS%dy_Cu(I,j) / (d(uhbt)/du) (with appropriate bounds). - BT_force_u(I,j) = forces%taux(I,j) * I_rho0*CS%IDatu(I,j)*visc_rem_u(I,j,1) + BT_force_u(I,j) = forces%taux(I,j) * mass_to_Z *CS%IDatu(I,j)*visc_rem_u(I,j,1) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie ! ### IDatv here should be replaced with 1/D+eta(Bous) or 1/eta(non-Bous). ! ### although with BT_cont_types IDatv should be replaced by ! ### CS%dx_Cv(I,j) / (d(vhbt)/dv) (with appropriate bounds). - BT_force_v(i,J) = forces%tauy(i,J) * I_rho0*CS%IDatv(i,J)*visc_rem_v(i,J,1) + BT_force_v(i,J) = forces%tauy(i,J) * mass_to_Z *CS%IDatv(i,J)*visc_rem_v(i,J,1) enddo ; enddo if (present(taux_bot) .and. present(tauy_bot)) then if (associated(taux_bot) .and. associated(tauy_bot)) then !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - BT_force_u(I,j) = BT_force_u(I,j) - taux_bot(I,j) * I_rho0 * CS%IDatu(I,j) + BT_force_u(I,j) = BT_force_u(I,j) - taux_bot(I,j) * mass_to_Z * CS%IDatu(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - BT_force_v(i,J) = BT_force_v(i,J) - tauy_bot(i,J) * I_rho0 * CS%IDatv(i,J) + BT_force_v(i,J) = BT_force_v(i,J) - tauy_bot(i,J) * mass_to_Z * CS%IDatv(i,J) enddo ; enddo endif endif @@ -1459,7 +1459,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & call uvchksum("BT frhat[uv]", CS%frhatu, CS%frhatv, G%HI, 0, .true., .true.) call uvchksum("BT bc_accel_[uv]", bc_accel_u, bc_accel_v, & G%HI, haloshift=0) - call uvchksum("BT IDat[uv]", CS%IDatu, CS%IDatv, G%HI, haloshift=0) + call uvchksum("BT IDat[uv]", CS%IDatu, CS%IDatv, G%HI, haloshift=0, scale=GV%m_to_Z) call uvchksum("BT visc_rem_[uv]", visc_rem_u, visc_rem_v, & G%HI, haloshift=1) endif @@ -2323,7 +2323,7 @@ subroutine set_dtbt(G, GV, CS, eta, pbce, BT_cont, gtot_est, SSH_add) elseif (CS%Nonlinear_continuity .and. present(eta)) then call find_face_areas(Datu, Datv, G, GV, CS, MS, eta=eta, halo=0) else - call find_face_areas(Datu, Datv, G, GV, CS, MS, halo=0, add_max=add_SSH) + call find_face_areas(Datu, Datv, G, GV, CS, MS, halo=0, add_max=add_SSH*GV%m_to_Z) endif det_de = 0.0 @@ -3542,7 +3542,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) !! or column mass anomaly, in H (m or kg m-2). integer, optional, intent(in) :: halo !< The halo size to use, default = 1. real, optional, intent(in) :: add_max !< A value to add to the maximum depth (used - !! to overestimate the external wave speed) in m. + !! to overestimate the external wave speed) in Z. ! Local variables real :: H1, H2 ! Temporary total thicknesses, in m or kg m-2. @@ -3588,13 +3588,13 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) elseif (present(add_max)) then !$OMP do do j=js-hs,je+hs ; do I=is-1-hs,ie+hs - Datu(I,j) = CS%dy_Cu(I,j) * GV%m_to_H * & - (GV%Z_to_m*max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + add_max) + Datu(I,j) = CS%dy_Cu(I,j) * GV%Z_to_H * & + (max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + add_max) enddo ; enddo !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs - Datv(i,J) = CS%dx_Cv(i,J) * GV%m_to_H * & - (GV%Z_to_m*max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + add_max) + Datv(i,J) = CS%dx_Cv(i,J) * GV%Z_to_H * & + (max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + add_max) enddo ; enddo else !$OMP do @@ -4088,17 +4088,17 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ALLOC_(CS%D_v_Cor(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) CS%q_D(:,:) = 0.0 ; CS%D_u_Cor(:,:) = 0.0 ; CS%D_v_Cor(:,:) = 0.0 do j=js,je ; do I=is-1,ie - CS%D_u_Cor(I,j) = 0.5 * GV%Z_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j)) + CS%D_u_Cor(I,j) = 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j)) enddo ; enddo do J=js-1,je ; do i=is,ie - CS%D_v_Cor(i,J) = 0.5 * GV%Z_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j)) + CS%D_v_Cor(i,J) = 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j)) enddo ; enddo do J=js-1,je ; do I=is-1,ie if (G%mask2dT(i,j)+G%mask2dT(i,j+1)+G%mask2dT(i+1,j)+G%mask2dT(i+1,j+1)>0.) then CS%q_D(I,J) = 0.25 * G%CoriolisBu(I,J) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & - (GV%Z_to_m*((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & - (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)))) + ((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & + (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)) ) else ! All four h points are masked out so q_D(I,J) will is meaningless CS%q_D(I,J) = 0. endif @@ -4295,24 +4295,24 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ! if (GV%Boussinesq) then do j=js,je ; do I=is-1,ie if (G%mask2dCu(I,j)>0.) then - CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (GV%Z_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j))) + CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (G%bathyT(i+1,j) + G%bathyT(i,j)) else ! Both neighboring H points are masked out so IDatu(I,j) is meaningless CS%IDatu(I,j) = 0. endif enddo ; enddo do J=js-1,je ; do i=is,ie if (G%mask2dCv(i,J)>0.) then - CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (GV%Z_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j))) - else ! Both neighboring H points are masked out so IDatu(I,j) is meaningless + CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (G%bathyT(i,j+1) + G%bathyT(i,j)) + else ! Both neighboring H points are masked out so IDatv(I,j) is meaningless CS%IDatv(i,J) = 0. endif enddo ; enddo ! else ! do j=js,je ; do I=is-1,ie -! CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (GV%Z_to_m*GV%Rho0*(G%bathyT(i+1,j) + G%bathyT(i,j))) +! CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (GV%Rho0*(G%bathyT(i+1,j) + G%bathyT(i,j))) ! enddo ; enddo ! do J=js-1,je ; do i=is,ie -! CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (GV%Z_to_m*GV%Rho0*(G%bathyT(i,j+1) + G%bathyT(i,j))) +! CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (GV%Rho0*(G%bathyT(i,j+1) + G%bathyT(i,j))) ! enddo ; enddo ! endif From cea4c426e7ad1e590ba37b2778336134076422b8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 4 Sep 2018 16:32:54 -0400 Subject: [PATCH 0692/1072] Updated comments in int_density_dz routines Updated comments in the various int_density_dz routines to reflect the flexibility of these routines to use different internal representations of the vertical coordinates. Only comments were changed, and all answers are bitwise identical. --- src/equation_of_state/MOM_EOS.F90 | 137 ++++++++++------------- src/equation_of_state/MOM_EOS_Wright.F90 | 35 +++--- src/equation_of_state/MOM_EOS_linear.F90 | 36 +++--- 3 files changed, 91 insertions(+), 117 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 30ac795c56..7748a8b505 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -625,21 +625,21 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, & real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S !< Salinity (PSU) real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in m. + intent(in) :: z_t !< Height at the top of the layer in depth units (Z). real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the bottom of the layer in m. + intent(in) :: z_b !< Height at the bottom of the layer in Z. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to !! reduce the magnitude of each of the integrals. real, intent(in) :: rho_0 !< A density, in kg m-3, that is used to calculate the !! pressure (as p~=-z*rho_0*G_e) used in the equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2. type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly across the layer, in Pa. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer of !! the pressure anomaly relative to the anomaly at the - !! top of the layer, in Pa m. + !! top of the layer, in Pa Z. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the layer @@ -649,9 +649,8 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, & !! pressure anomaly at the top and bottom of the layer !! divided by the y grid spacing, in Pa. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - optional, intent(in) :: bathyT !< The depth of the bathymetry in m - real, optional, intent(in) :: dz_neglect !< A miniscule thickness change with the - !! same units as z_t + optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change, in Z. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. @@ -877,16 +876,16 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S !< Salinity of the layer in PSU. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in m. + intent(in) :: z_t !< Height at the top of the layer in depth units (Z). real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the bottom of the layer in m. + intent(in) :: z_b !< Height at the bottom of the layer in Z. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is !! subtracted out to reduce the magnitude !! of each of the integrals. real, intent(in) :: rho_0 !< A density, in kg m-3, that is used !! to calculate the pressure (as p~=-z*rho_0*G_e) !! used in the equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2. type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly @@ -894,7 +893,7 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the !! layer of the pressure anomaly relative to the - !! anomaly at the top of the layer, in Pa m. + !! anomaly at the top of the layer, in Pa Z. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between !! the pressure anomaly at the top and bottom of the @@ -904,9 +903,8 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, !! the pressure anomaly at the top and bottom of the !! layer divided by the y grid spacing, in Pa. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - optional, intent(in) :: bathyT !< The depth of the bathymetry in m - real, optional, intent(in) :: dz_neglect !< A miniscule thickness change with the - !! same units as z_t + optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change, in Z. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. real :: T5(5), S5(5), p5(5), r5(5) @@ -914,16 +912,16 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real :: w_left, w_right real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. real :: GxRho, I_Rho - real :: dz ! The layer thickness, in m. - real :: hWght ! A pressure-thickness below topography, in m. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in m. - real :: iDenom ! The inverse of the denominator in the wieghts, in m-2. + real :: dz ! The layer thickness, in Z. + real :: hWght ! A pressure-thickness below topography, in Z. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Z. + real :: iDenom ! The inverse of the denominator in the weights, in Z-2. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear wieghts of the left and right columns, nonDim. + real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. - real :: intz(5) ! The integrals of density with height at the - ! 5 sub-column locations, in m2 s-2. + real :: intz(5) ! The gravitational acceleration times the integrals of density + ! with height at the 5 sub-column locations, in Pa. logical :: do_massWeight ! Indicates whether to do mass weighting. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j, m, n, ioff, joff @@ -1054,7 +1052,6 @@ end subroutine int_density_dz_generic ! ========================================================================== !> Compute pressure gradient force integrals by quadrature for the case where !! T and S are linear profiles. -! ========================================================================== subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & rho_0, G_e, dz_subroundoff, bathyT, HII, HIO, EOS, dpa, & intz_dpa, intx_dpa, inty_dpa, & @@ -1070,27 +1067,26 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S_b !< Salinity at the cell bottom (ppt) real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< The geometric height at the top - !! of the layer, usually in m + intent(in) :: z_t !< The geometric height at the top of the layer, + !! in depth units (Z), usually m. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< The geometric height at the bottom - !! of the layer, usually in m + intent(in) :: z_b !< The geometric height at the bottom of the layer in Z. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to !! reduce the magnitude of each of the integrals. real, intent(in) :: rho_0 !< A density, in kg m-3, that is used to calculate the !! pressure (as p~=-z*rho_0*G_e) used in the equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2. real, intent(in) :: dz_subroundoff !< A miniscule thickness !! change with the same units as z_t real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: bathyT !< The depth of the bathymetry in m + intent(in) :: bathyT !< The depth of the bathymetry in units of Z. type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly across the layer, in Pa. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer of !! the pressure anomaly relative to the anomaly at the - !! top of the layer, in Pa m. + !! top of the layer, in Pa Z. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the layer @@ -1111,53 +1107,34 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & ! It is assumed that the salinity and temperature profiles are linear in the ! vertical. The top and bottom values within each layer are provided and ! a linear interpolation is used to compute intermediate values. -! -! Arguments: T - potential temperature relative to the surface in C -! (the 't' and 'b' subscripts refer to the values at -! the top and the bottom of each layer) -! (in) S - salinity in PSU. -! (the 't' and 'b' subscripts refer to the values at -! the top and the bottom of each layer) -! (in) z_t - height at the top of the layer in m. -! (in) z_b - height at the top of the layer in m. -! (in) rho_ref - A mean density, in kg m-3, that is subtracted out to reduce -! the magnitude of each of the integrals. -! (The pressure is calucated as p~=-z*rho_0*G_e.) -! (in) rho_0 - A density, in kg m-3, that is used to calculate the pressure -! (as p~=-z*rho_0*G_e) used in the equation of state. -! (in) G_e - The Earth's gravitational acceleration, in m s-2. -! (in) G - The ocean's grid structure. -! (in) form_of_eos - integer that selects the eqn of state. -! (out) dpa - The change in the pressure anomaly across the layer, -! in Pa. -! (out,opt) intz_dpa - The integral through the thickness of the layer of the -! pressure anomaly relative to the anomaly at the top of -! the layer, in Pa m. -! (out,opt) intx_dpa - The integral in x of the difference between the -! pressure anomaly at the top and bottom of the layer -! divided by the x grid spacing, in Pa. -! (out,opt) inty_dpa - The integral in y of the difference between the -! pressure anomaly at the top and bottom of the layer -! divided by the y grid spacing, in Pa. -! (in,opt) useMassWghtInterp - If true, uses mass weighting to interpolate -! T/S for top and bottom integrals. - - real :: T5((5*HIO%iscB+1):(5*(HIO%iecB+2))) - real :: S5((5*HIO%iscB+1):(5*(HIO%iecB+2))) - real :: p5((5*HIO%iscB+1):(5*(HIO%iecB+2))) - real :: r5((5*HIO%iscB+1):(5*(HIO%iecB+2))) - real :: T15((15*HIO%iscB+1):(15*(HIO%iecB+1))) - real :: S15((15*HIO%iscB+1):(15*(HIO%iecB+1))) - real :: p15((15*HIO%iscB+1):(15*(HIO%iecB+1))) - real :: r15((15*HIO%iscB+1):(15*(HIO%iecB+1))) - real :: wt_t(5), wt_b(5) - real :: rho_anom - real :: w_left, w_right, intz(5) - real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. - real :: GxRho, I_Rho - real :: dz(HIO%iscB:HIO%iecB+1), dz_x(5,HIO%iscB:HIO%iecB), dz_y(5,HIO%isc:HIO%iec) - real :: weight_t, weight_b, hWght, massWeightToggle - real :: Ttl, Tbl, Ttr, Tbr, Stl, Sbl, Str, Sbr, hL, hR, iDenom + + ! Local variables + real :: T5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Temperatures along a line of subgrid locations, in degC + real :: S5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Salinities along a line of subgrid locations, in ppt + real :: p5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Pressures along a line of subgrid locations, in Pa + real :: r5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Densities along a line of subgrid locations, in kg m-3 + real :: T15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Temperatures at an array of subgrid locations, in degC + real :: S15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Salinities at an array of subgrid locations, in ppt + real :: p15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Pressures at an array of subgrid locations, in Pa + real :: r15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Densities at an array of subgrid locations, in kg m-3 + real :: wt_t(5), wt_b(5) ! Top and bottom weights, ND. + real :: rho_anom ! A density anomaly in kg m-3. + real :: w_left, w_right ! Left and right weights, ND. + real :: intz(5) ! The gravitational acceleration times the integrals of density + ! with height at the 5 sub-column locations, in Pa. + real, parameter :: C1_90 = 1.0/90.0 ! A rational constant, ND. + real :: GxRho ! Gravitational acceleration times density, in kg m-1 Z-1 s-2. + real :: I_Rho ! The inverse of the reference density, in m3 kg-1. + real :: dz(HIO%iscB:HIO%iecB+1) ! Layer thicknesses at tracer points in Z. + real :: dz_x(5,HIO%iscB:HIO%iecB) ! Layer thicknesses along an x-line of subrid locations, in Z. + real :: dz_y(5,HIO%isc:HIO%iec) ! Layer thicknesses along a y-line of subrid locations, in Z. + real :: weight_t, weight_b ! Nondimensional wieghts of the top and bottom. + real :: massWeightToggle ! A nondimensional toggle factor (0 or 1). + real :: Ttl, Tbl, Ttr, Tbr ! Temperatures at the velocity cell corners, in degC. + real :: Stl, Sbl, Str, Sbr ! Salinities at the velocity cell corners, in ppt. + real :: hWght ! A topographically limited thicknes weight, in Z. + real :: hL, hR ! Thicknesses to the left and right, in Z. + real :: iDenom ! The denominator of the thickness weight expressions, in Z-2. integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n integer :: iin, jin, ioff, joff integer :: pos @@ -2009,10 +1986,10 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, & ! real :: dp_90(2:4) ! The pressure change through a layer divided by 90, in Pa. real :: hWght ! A pressure-thickness below topography, in Pa. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Pa. - real :: iDenom ! The inverse of the denominator in the wieghts, in Pa-2. + real :: iDenom ! The inverse of the denominator in the weights, in Pa-2. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear wieghts of the left and right columns, nonDim. + real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. real :: intp(5) ! The integrals of specific volume with pressure at the ! 5 sub-column locations, in m2 s-2. @@ -2206,10 +2183,10 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, real :: dp_90(2:4) ! The pressure change through a layer divided by 90, in Pa. real :: hWght ! A pressure-thickness below topography, in Pa. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Pa. - real :: iDenom ! The inverse of the denominator in the wieghts, in Pa-2. + real :: iDenom ! The inverse of the denominator in the weights, in Pa-2. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear wieghts of the left and right columns, nonDim. + real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. real :: intp(5) ! The integrals of specific volume with pressure at the ! 5 sub-column locations, in m2 s-2. diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index d35961b997..a4535ec961 100644 --- a/src/equation_of_state/MOM_EOS_Wright.F90 +++ b/src/equation_of_state/MOM_EOS_Wright.F90 @@ -402,23 +402,23 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S !< Salinity in PSU. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in m. + intent(in) :: z_t !< Height at the top of the layer in depth units (Z). real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the top of the layer in m. + intent(in) :: z_b !< Height at the top of the layer in Z. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out !! to reduce the magnitude of each of the integrals. !! (The pressure is calucated as p~=-z*rho_0*G_e.) real, intent(in) :: rho_0 !< Density, in kg m-3, that is used to calculate the !! pressure (as p~=-z*rho_0*G_e) used in the !! equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly across the !! layer, in Pa. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer !! of the pressure anomaly relative to the anomaly - !! at the top of the layer, in Pa m. + !! at the top of the layer, in Pa Z. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the @@ -428,11 +428,10 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, !! pressure anomaly at the top and bottom of the !! layer divided by the y grid spacing, in Pa. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - optional, intent(in) :: bathyT !< The depth of the bathymetry in m - real, optional, intent(in) :: dz_neglect !< A miniscule thickness change with the - !! same units as z_t + optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change in Z. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to - !! interpolate T/S for top and bottom integrals. + !! interpolate T/S for top and bottom integrals. ! Local variables real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed) :: al0_2d, p0_2d, lambda_2d @@ -441,16 +440,16 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real :: eps, eps2, rem real :: GxRho, I_Rho real :: p_ave, I_al0, I_Lzz - real :: dz ! The layer thickness, in m. - real :: hWght ! A pressure-thickness below topography, in m. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in m. - real :: iDenom ! The inverse of the denominator in the wieghts, in m-2. + real :: dz ! The layer thickness, in Z. + real :: hWght ! A pressure-thickness below topography, in Z. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Z. + real :: iDenom ! The inverse of the denominator in the weights, in m-Z. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear wieghts of the left and right columns, nonDim. + real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. real :: intz(5) ! The integrals of density with height at the - ! 5 sub-column locations, in m2 s-2. + ! 5 sub-column locations, in Pa. logical :: do_massWeight ! Indicates whether to do mass weighting. real, parameter :: C1_3 = 1.0/3.0, C1_7 = 1.0/7.0 ! Rational constants. real, parameter :: C1_9 = 1.0/9.0, C1_90 = 1.0/90.0 ! Rational constants. @@ -634,9 +633,9 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate !! dza. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - optional, intent(in) :: bathyP !< The pressure at the bathymetry in Pa + optional, intent(in) :: bathyP !< The pressure at the bathymetry in Pa real, optional, intent(in) :: dP_neglect !< A miniscule pressure change with - !! the same units as p_t (Pa?) + !! the same units as p_t (Pa?) logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting !! to interpolate T/S for top and bottom integrals. @@ -649,10 +648,10 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & real :: dp ! The pressure change through a layer, in Pa. real :: hWght ! A pressure-thickness below topography, in Pa. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Pa. - real :: iDenom ! The inverse of the denominator in the wieghts, in Pa-2. + real :: iDenom ! The inverse of the denominator in the weights, in Pa-2. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear wieghts of the left and right columns, nonDim. + real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. real :: intp(5) ! The integrals of specific volume with pressure at the ! 5 sub-column locations, in m2 s-2. diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90 index 7168e2f2f7..d63929bd62 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -323,9 +323,9 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S !< Salinity in PSU. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in m. + intent(in) :: z_t !< Height at the top of the layer in depth units (Z). real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the top of the layer in m. + intent(in) :: z_b !< Height at the top of the layer in Z. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted !! out to reduce the magnitude of each of the !! integrals. @@ -333,8 +333,7 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, !! the pressure (as p~=-z*rho_0_pres*G_e) used in !! the equation of state. rho_0_pres is not used !! here. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, - !! in m s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2. real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. real, intent(in) :: dRho_dT !< The derivative of density with temperature, !! in kg m-3 C-1. @@ -346,7 +345,7 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer !! of the pressure anomaly relative to the anomaly - !! at the top of the layer, in Pa m. + !! at the top of the layer, in Pa Z. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the @@ -356,24 +355,23 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, !! pressure anomaly at the top and bottom of the !! layer divided by the y grid spacing, in Pa. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - optional, intent(in) :: bathyT !< The depth of the bathymetry in m - real, optional, intent(in) :: dz_neglect !< A miniscule thickness change with the - !! same units as z_t + optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change in Z. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to - !! interpolate T/S for top and bottom integrals. + !! interpolate T/S for top and bottom integrals. ! Local variables real :: rho_anom ! The density anomaly from rho_ref, in kg m-3. real :: raL, raR ! rho_anom to the left and right, in kg m-3. - real :: dz, dzL, dzR ! Layer thicknesses in m. - real :: hWght ! A pressure-thickness below topography, in m. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in m. - real :: iDenom ! The inverse of the denominator in the wieghts, in m-2. + real :: dz, dzL, dzR ! Layer thicknesses in Z. + real :: hWght ! A pressure-thickness below topography, in Z. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Z. + real :: iDenom ! The inverse of the denominator in the weights, in Z-2. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear wieghts of the left and right columns, nonDim. + real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. real :: intz(5) ! The integrals of density with height at the - ! 5 sub-column locations, in m2 s-2. + ! 5 sub-column locations, in Pa. logical :: do_massWeight ! Indicates whether to do mass weighting. real, parameter :: C1_6 = 1.0/6.0, C1_90 = 1.0/90.0 ! Rational constants. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j, ioff, joff, m @@ -529,9 +527,9 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, & !! in m2 s-2. integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate dza. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - optional, intent(in) :: bathyP !< The pressure at the bathymetry in Pa + optional, intent(in) :: bathyP !< The pressure at the bathymetry in Pa real, optional, intent(in) :: dP_neglect !< A miniscule pressure change with - !! the same units as p_t (Pa?) + !! the same units as p_t (Pa?) logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting !! to interpolate T/S for top and bottom integrals. ! Local variables @@ -541,10 +539,10 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, & real :: dp, dpL, dpR ! Layer pressure thicknesses in Pa. real :: hWght ! A pressure-thickness below topography, in Pa. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Pa. - real :: iDenom ! The inverse of the denominator in the wieghts, in Pa-2. + real :: iDenom ! The inverse of the denominator in the weights, in Pa-2. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear wieghts of the left and right columns, nonDim. + real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. real :: intp(5) ! The integrals of specific volume with pressure at the ! 5 sub-column locations, in m2 s-2. From 626d70563744c2f4337d72c36263c0e2820869a4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 5 Sep 2018 10:54:58 -0400 Subject: [PATCH 0693/1072] +Added scale argument to read_ & get_param_real Added scale argument to get_param_real, read_param_real, get_param_real_array and read_param_real array, so that parameters can be rescaled immediately before being returned. Also removed duplicative comments. All answers are bitwise identical, although there is a new optional argument for 4 publicly visible routines. --- src/framework/MOM_file_parser.F90 | 260 ++++++++++++++---------------- 1 file changed, 124 insertions(+), 136 deletions(-) diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index 72944c4f7a..a4daaa7c40 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -124,6 +124,7 @@ subroutine open_param_file(filename, CS, checkable, component, doc_file_dir) character(len=*), optional, intent(in) :: doc_file_dir !< An optional directory in which to write out !! the documentation files. The default is effectively './'. + ! Local variables logical :: file_exists, unit_in_use, Netcdf_file, may_check integer :: ios, iounit, strlen, i character(len=240) :: doc_path @@ -247,8 +248,8 @@ subroutine close_param_file(CS, quiet_close, component) ! Local variables character(len=128) :: docfile_default character(len=40) :: mdl ! This module's name. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" integer :: i, n, num_unused if (present(quiet_close)) then ; if (quiet_close) then @@ -339,13 +340,14 @@ subroutine populate_param_data(iounit, filename, param_data) type(file_data_type), intent(inout) :: param_data !< A list of the input lines that set parameters !! after comments have been stripped out. + ! Local variables character(len=INPUT_STR_LENGTH) :: line integer :: num_lines logical :: inMultiLineComment -! Find the number of keyword lines in a parameter file -! Allocate the space to hold the lines in param_data%line -! Populate param_data%line with the keyword lines from parameter file + ! Find the number of keyword lines in a parameter file + ! Allocate the space to hold the lines in param_data%line + ! Populate param_data%line with the keyword lines from parameter file if (iounit <= 0) return @@ -434,8 +436,10 @@ end subroutine populate_param_data function openMultiLineComment(string) character(len=*), intent(in) :: string !< The input string to process logical :: openMultiLineComment -! True if a /* appears on this line without a closing */ + + ! Local variables integer :: icom, last + openMultiLineComment = .false. last = lastNonCommentIndex(string)+1 icom = index(string(last:), "/*") @@ -460,9 +464,11 @@ end function closeMultiLineComment function lastNonCommentIndex(string) character(len=*), intent(in) :: string !< The input string to process integer :: lastNonCommentIndex -! Find position of last character before any comments -! This s/r is the only place where a comment needs to be defined + + ! Local variables integer :: icom, last + + ! This subroutine is the only place where a comment needs to be defined last = len_trim(string) icom = index(string(:last), "!") ; if (icom > 0) last = icom-1 ! F90 style icom = index(string(:last), "//") ; if (icom > 0) last = icom-1 ! C++ style @@ -474,7 +480,7 @@ end function lastNonCommentIndex function lastNonCommentNonBlank(string) character(len=*), intent(in) :: string !< The input string to process integer :: lastNonCommentNonBlank -! Find position of last non-blank character before any comments + lastNonCommentNonBlank = len_trim(string(:lastNonCommentIndex(string))) ! Ignore remaining trailing blanks end function lastNonCommentNonBlank @@ -482,8 +488,9 @@ end function lastNonCommentNonBlank function replaceTabs(string) character(len=*), intent(in) :: string !< The input string to process character(len=len(string)) :: replaceTabs -! Returns string with tabs replaced by a blank + integer :: i + do i=1, len(string) if (string(i:i)==achar(9)) then replaceTabs(i:i)=" " @@ -497,8 +504,9 @@ end function replaceTabs function removeComments(string) character(len=*), intent(in) :: string !< The input string to process character(len=len(string)) :: removeComments -! Trims comments and leading blanks from string + integer :: last + removeComments=repeat(" ",len(string)) last = lastNonCommentNonBlank(string) removeComments(:last)=adjustl(string(:last)) ! Copy only the non-comment part of string @@ -509,11 +517,12 @@ end function removeComments function simplifyWhiteSpace(string) character(len=*), intent(in) :: string !< A string to modify to simpify white space character(len=len(string)+16) :: simplifyWhiteSpace -! Constructs a string with all repeated whitespace replaced with single blanks -! and insert white space where it helps delineate tokens (e.g. around =) + + ! Local variables integer :: i,j logical :: nonBlank = .false., insideString = .false. character(len=1) :: quoteChar=" " + nonBlank = .false.; insideString = .false. ! NOTE: For some reason this line is needed?? i=0 simplifyWhiteSpace=repeat(" ",len(string)+16) @@ -567,11 +576,7 @@ subroutine read_param_int(CS, varname, value, fail_if_missing) !! read from the parameter file logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file -! This subroutine determines the value of an integer model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1) logical :: found, defined @@ -603,11 +608,7 @@ subroutine read_param_int_array(CS, varname, value, fail_if_missing) !! read from the parameter file logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file -! This subroutine determines the value of an integer model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1) logical :: found, defined @@ -632,25 +633,25 @@ subroutine read_param_int_array(CS, varname, value, fail_if_missing) end subroutine read_param_int_array !> This subroutine reads the value of a real model parameter from a parameter file. -subroutine read_param_real(CS, varname, value, fail_if_missing) - type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, +subroutine read_param_real(CS, varname, value, fail_if_missing, scale) + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters - character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read - real, intent(inout) :: value !< The value of the parameter that may be + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + real, intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file - logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs + logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file -! This subroutine determines the value of an integer model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. + real, optional, intent(in) :: scale !< A scaling factor that the parameter is multiplied + !! by before it is returned. + + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1) logical :: found, defined call get_variable_line(CS, varname, found, defined, value_string) if (found .and. defined .and. (LEN_TRIM(value_string(1)) > 0)) then read(value_string(1),*,err=1003) value + if (present(scale)) value = scale*value else if (present(fail_if_missing)) then ; if (fail_if_missing) then if (.not.found) then @@ -668,26 +669,27 @@ subroutine read_param_real(CS, varname, value, fail_if_missing) end subroutine read_param_real !> This subroutine reads the values of an array of real model parameters from a parameter file. -subroutine read_param_real_array(CS, varname, value, fail_if_missing) - type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, +subroutine read_param_real_array(CS, varname, value, fail_if_missing, scale) + type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters - character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read - real, dimension(:), intent(inout) :: value !< The value of the parameter that may be + character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read + real, dimension(:), intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file - logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs + logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file -! This subroutine determines the value of an integer model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. + real, optional, intent(in) :: scale !< A scaling factor that the parameter is multiplied + !! by before it is returned. + + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1) logical :: found, defined call get_variable_line(CS, varname, found, defined, value_string) if (found .and. defined .and. (LEN_TRIM(value_string(1)) > 0)) then read(value_string(1),*,end=991,err=1004) value - 991 return +991 continue + if (present(scale)) value(:) = scale*value(:) + return else if (present(fail_if_missing)) then ; if (fail_if_missing) then if (.not.found) then @@ -713,11 +715,7 @@ subroutine read_param_char(CS, varname, value, fail_if_missing) !! read from the parameter file logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file -! This subroutine determines the value of an integer model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1) logical :: found, defined @@ -740,11 +738,8 @@ subroutine read_param_char_array(CS, varname, value, fail_if_missing) !! read from the parameter file logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file -! This subroutine determines the value of an integer model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. + + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1), loc_string logical :: found, defined integer :: i, i_out @@ -781,11 +776,8 @@ subroutine read_param_logical(CS, varname, value, fail_if_missing) !! read from the parameter file logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file -! This subroutine determines the value of an integer model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. + + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1) logical :: found, defined @@ -811,12 +803,8 @@ subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing, date_f logical, optional, intent(out) :: date_format !< If present, this indicates whether this !! parameter was read in a date format, so that it can !! later be logged in the same format. -! This subroutine determines the value of an time-type model parameter -! from a parameter file. The arguments are the unit of the open file -! which is to be read, the (case-sensitive) variable name, the variable -! where the value is to be stored, and (optionally) a flag indicating -! whether to fail if this parameter can not be found. The unique argument -! to read time is the number of seconds to use as the unit of time being read. + + ! Local variables character(len=INPUT_STR_LENGTH) :: value_string(1) character(len=240) :: err_msg logical :: found, defined @@ -906,6 +894,7 @@ subroutine get_variable_line(CS, varname, found, defined, value_string, paramIsL logical, optional, intent(in) :: paramIsLogical !< If true, this is a logical parameter !! that can be simply defined without parsing a value_string. + ! Local variables character(len=INPUT_STR_LENGTH) :: val_str, lname, origLine character(len=INPUT_STR_LENGTH) :: line, continuationBuffer, blockName character(len=FILENAME_LENGTH) :: filename @@ -1228,8 +1217,9 @@ function overrideWarningHasBeenIssued(chain, varName) !! override warnings issued character(len=*), intent(in) :: varName !< The name of the variable being queried for warnings logical :: overrideWarningHasBeenIssued -! Returns true if an override warning has been issued for the variable varName + ! Local variables type(link_parameter), pointer :: newLink => NULL(), this => NULL() + overrideWarningHasBeenIssued = .false. this => chain do while( associated(this) ) @@ -1291,15 +1281,14 @@ subroutine log_param_int(CS, modulename, varname, value, desc, units, & character(len=*), intent(in) :: varname !< The name of the parameter to log integer, intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter integer, optional, intent(in) :: default !< The default value of the parameter - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of an integer parameter to a log file, -! along with its name and the module it came from. + character(len=240) :: mesg, myunits write(mesg, '(" ",a," ",a,": ",a)') trim(modulename), trim(varname), trim(left_int(value)) @@ -1324,15 +1313,14 @@ subroutine log_param_int_array(CS, modulename, varname, value, desc, & character(len=*), intent(in) :: varname !< The name of the parameter to log integer, dimension(:), intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter integer, optional, intent(in) :: default !< The default value of the parameter - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of an integer parameter to a log file, -! along with its name and the module it came from. + character(len=1320) :: mesg character(len=240) :: myunits @@ -1358,13 +1346,12 @@ subroutine log_param_real(CS, modulename, varname, value, desc, units, & character(len=*), intent(in) :: varname !< The name of the parameter to log real, intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter real, optional, intent(in) :: default !< The default value of the parameter - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + character(len=240) :: mesg, myunits write(mesg, '(" ",a," ",a,": ",a)') & @@ -1390,11 +1377,10 @@ subroutine log_param_real_array(CS, modulename, varname, value, desc, & character(len=*), intent(in) :: varname !< The name of the parameter to log real, dimension(:), intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter real, optional, intent(in) :: default !< The default value of the parameter -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + character(len=1320) :: mesg character(len=240) :: myunits @@ -1423,15 +1409,14 @@ subroutine log_param_logical(CS, modulename, varname, value, desc, & character(len=*), intent(in) :: varname !< The name of the parameter to log logical, intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter logical, optional, intent(in) :: default !< The default value of the parameter - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a logical parameter to a log file, -! along with its name and the module it came from. + character(len=240) :: mesg, myunits if (value) then @@ -1460,15 +1445,14 @@ subroutine log_param_char(CS, modulename, varname, value, desc, units, & character(len=*), intent(in) :: varname !< The name of the parameter to log character(len=*), intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter character(len=*), optional, intent(in) :: default !< The default value of the parameter - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a character string parameter to a log -! file, along with its name and the module it came from. + character(len=240) :: mesg, myunits write(mesg, '(" ",a," ",a,": ",a)') & @@ -1495,18 +1479,19 @@ subroutine log_param_time(CS, modulename, varname, value, desc, units, & character(len=*), intent(in) :: varname !< The name of the parameter to log type(time_type), intent(in) :: value !< The value of the parameter to log character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter type(time_type), optional, intent(in) :: default !< The default value of the parameter real, optional, intent(in) :: timeunit !< The number of seconds in a time unit for !! real-number output. logical, optional, intent(in) :: log_date !< If true, log the time_type in date format. !! If missing the default is false. - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file + ! Local variables real :: real_time, real_default logical :: use_timeunit, date_format character(len=240) :: mesg, myunits @@ -1580,6 +1565,7 @@ function convert_date_to_string(date) result(date_string) type(time_type), intent(in) :: date !< The date to be translated into a string. character(len=40) :: date_string !< A date string in a format like YYYY-MM-DD HH:MM:SS.sss + ! Local variables character(len=40) :: sub_string real :: real_secs integer :: yrs, mons, days, hours, mins, secs, ticks, ticks_per_sec @@ -1616,7 +1602,7 @@ subroutine get_param_int(CS, modulename, varname, value, desc, units, & integer, intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter integer, optional, intent(in) :: default !< The default value of the parameter integer, optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1628,12 +1614,11 @@ subroutine get_param_int(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + logical :: do_read, do_log do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read @@ -1664,7 +1649,7 @@ subroutine get_param_int_array(CS, modulename, varname, value, desc, units, & integer, dimension(:), intent(inout) :: value !< The value of the parameter that may be reset !! from the parameter file character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter integer, optional, intent(in) :: default !< The default value of the parameter integer, optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1676,12 +1661,11 @@ subroutine get_param_int_array(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + logical :: do_read, do_log do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read @@ -1704,7 +1688,7 @@ end subroutine get_param_int_array !! and logs it in documentation files. subroutine get_param_real(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, & - static_value, debuggingParam) + static_value, debuggingParam, scale) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1712,7 +1696,7 @@ subroutine get_param_real(CS, modulename, varname, value, desc, units, & real, intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter real, optional, intent(in) :: default !< The default value of the parameter real, optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1724,10 +1708,11 @@ subroutine get_param_real(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + real, optional, intent(in) :: scale !< A scaling factor that the parameter is + !! multiplied by before it is returned. + logical :: do_read, do_log do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read @@ -1744,12 +1729,14 @@ subroutine get_param_real(CS, modulename, varname, value, desc, units, & default, debuggingParam) endif + if (present(scale)) value = scale*value + end subroutine get_param_real !> This subroutine reads the values of an array of real model parameters from a parameter file !! and logs them in documentation files. subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & - default, fail_if_missing, do_not_read, do_not_log, static_value) + default, fail_if_missing, do_not_read, do_not_log, static_value, scale) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1757,7 +1744,7 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & real, dimension(:), intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter real, optional, intent(in) :: default !< The default value of the parameter real, optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1769,6 +1756,8 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files + real, optional, intent(in) :: scale !< A scaling factor that the parameter is + !! multiplied by before it is returned. logical :: do_read, do_log @@ -1786,6 +1775,8 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & units, default) endif + if (present(scale)) value(:) = scale*value(:) + end subroutine get_param_real_array !> This subroutine reads the value of a character string model parameter from a parameter file @@ -1800,7 +1791,7 @@ subroutine get_param_char(CS, modulename, varname, value, desc, units, & character(len=*), intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter character(len=*), optional, intent(in) :: default !< The default value of the parameter character(len=*), optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1812,12 +1803,11 @@ subroutine get_param_char(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + logical :: do_read, do_log do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read @@ -1847,7 +1837,7 @@ subroutine get_param_char_array(CS, modulename, varname, value, desc, units, & character(len=*), dimension(:), intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter character(len=*), optional, intent(in) :: default !< The default value of the parameter character(len=*), optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1859,8 +1849,8 @@ subroutine get_param_char_array(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + + ! Local variables logical :: do_read, do_log integer :: i, len_tot, len_val character(len=240) :: cat_val @@ -1901,7 +1891,7 @@ subroutine get_param_logical(CS, modulename, varname, value, desc, units, & logical, intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter logical, optional, intent(in) :: default !< The default value of the parameter logical, optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1913,12 +1903,11 @@ subroutine get_param_logical(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + logical :: do_read, do_log do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read @@ -1950,7 +1939,7 @@ subroutine get_param_time(CS, modulename, varname, value, desc, units, & type(time_type), intent(inout) :: value !< The value of the parameter that may be !! read from the parameter file and logged character(len=*), optional, intent(in) :: desc !< A description of this variable; if not - !! present, this paramter is not written to a doc file + !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter type(time_type), optional, intent(in) :: default !< The default value of the parameter type(time_type), optional, intent(in) :: static_value !< If this parameter is static, it takes @@ -1964,14 +1953,13 @@ subroutine get_param_time(CS, modulename, varname, value, desc, units, & !! parameter to the documentation files real, optional, intent(in) :: timeunit !< The number of seconds in a time unit for !! real-number input to be translated to a time. - logical, optional, intent(in) :: layoutParam !< If present and true, this paramter is + logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is !! logged in the layout parameter file - logical, optional, intent(in) :: debuggingParam !< If present and true, this paramter is + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is !! logged in the debugging parameter file logical, optional, intent(in) :: log_as_date !< If true, log the time_type in date !! format. The default is false. -! This subroutine writes the value of a real parameter to a log file, -! along with its name and the module it came from. + logical :: do_read, do_log, date_format, log_date do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read @@ -1999,7 +1987,7 @@ end subroutine get_param_time subroutine clearParameterBlock(CS) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters -! Resets the parameter block name to blank + type(parameter_block), pointer :: block => NULL() if (associated(CS%blockName)) then block => CS%blockName @@ -2016,7 +2004,7 @@ subroutine openParameterBlock(CS,blockName,desc) !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: blockName !< The name of a parameter block being added character(len=*), optional, intent(in) :: desc !< A description of the parameter block being added -! Tags blockName onto the end of the active parameter block name + type(parameter_block), pointer :: block => NULL() if (associated(CS%blockName)) then block => CS%blockName @@ -2032,7 +2020,7 @@ end subroutine openParameterBlock subroutine closeParameterBlock(CS) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters -! Remove the lowest level of recursion from the active block name + type(parameter_block), pointer :: block => NULL() if (associated(CS%blockName)) then @@ -2053,7 +2041,7 @@ function pushBlockLevel(oldblockName,newBlockName) character(len=*), intent(in) :: oldBlockName !< A sequence of hierarchical parameter block names character(len=*), intent(in) :: newBlockName !< A new block name to add to the end of the sequence character(len=len(oldBlockName)+40) :: pushBlockLevel -! Extends block name (deeper level of parameter block) + if (len_trim(oldBlockName)>0) then pushBlockLevel=trim(oldBlockName)//'%'//trim(newBlockName) else @@ -2065,7 +2053,7 @@ end function pushBlockLevel function popBlockLevel(oldblockName) character(len=*), intent(in) :: oldBlockName !< A sequence of hierarchical parameter block names character(len=len(oldBlockName)+40) :: popBlockLevel -! Truncates block name (shallower level of parameter block) + integer :: i i = index(trim(oldBlockName), '%', .true.) if (i>1) then From 43bff9445564ba7bdf4e75ae30f8d0c65ca08d90 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 5 Sep 2018 10:55:35 -0400 Subject: [PATCH 0694/1072] Corrected MOM_ALE_sponge comments Modified comments to reflect that MOM_ALE_sponges appears to be working with thicknesses in H units, not m. Only comments were changed, and all answers are bitwise identical. --- src/parameterizations/vertical/MOM_ALE_sponge.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 97d7d12f7e..c842b813c9 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -140,7 +140,8 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_ !! to parse for model parameter values (in). type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module (in/out). - real, dimension(SZI_(G),SZJ_(G),nz_data), intent(in) :: data_h !< The thicknesses of the sponge input layers. + real, dimension(SZI_(G),SZJ_(G),nz_data), intent(in) :: data_h !< The thicknesses of the sponge + !! input layers, in thickness units (H). ! This include declares and sets the variable "version". @@ -331,7 +332,7 @@ end function get_ALE_sponge_nz_data subroutine get_ALE_sponge_thicknesses(G, data_h, sponge_mask, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). real, allocatable, dimension(:,:,:), & - intent(inout) :: data_h !< The thicknesses of the sponge input layers. + intent(inout) :: data_h !< The thicknesses of the sponge input layers, in H. logical, dimension(SZI_(G),SZJ_(G)), & intent(out) :: sponge_mask !< A logical mask that is true where !! sponges are being applied. @@ -837,7 +838,7 @@ end subroutine set_up_ALE_sponge_vel_field_varying subroutine apply_ALE_sponge(h, dt, G, CS, Time) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure (in). real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thickness, in m (in) + intent(inout) :: h !< Layer thickness, in H (in) real, intent(in) :: dt !< The amount of time covered by this call, in s (in). type(ALE_sponge_CS), pointer :: CS !< A pointer to the control structure for this module !! that is set by a previous call to initialize_sponge (in). From efc0709a71bc6fb8510b120fa907f1377c56aa47 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 5 Sep 2018 10:56:58 -0400 Subject: [PATCH 0695/1072] Use scale in user get_param calls Use the new argument to rescale the parameters returned by several get_param calls in the user code to take dimensional rescaling into account. All answers are bitwise identical. --- src/user/BFB_initialization.F90 | 3 +-- src/user/DOME2d_initialization.F90 | 11 ++++---- src/user/DOME_initialization.F90 | 3 +-- src/user/ISOMIP_initialization.F90 | 31 ++++++++++------------ src/user/Neverland_initialization.F90 | 9 ++++--- src/user/Phillips_initialization.F90 | 6 ++--- src/user/adjustment_initialization.F90 | 3 +-- src/user/dumbbell_initialization.F90 | 15 +++++------ src/user/external_gwave_initialization.F90 | 3 +-- src/user/lock_exchange_initialization.F90 | 7 ++--- src/user/seamount_initialization.F90 | 3 +-- 11 files changed, 40 insertions(+), 54 deletions(-) diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 2a14f502ef..ed965393a4 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -102,8 +102,7 @@ subroutine BFB_initialize_sponges_southonly(G, GV, use_temperature, tv, param_fi ! Set up sponges for DOME configuration call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0) - min_depth = GV%m_to_Z*min_depth + "The minimum depth of the ocean.", units="m", default=0.0, scale=GV%m_to_Z) call get_param(param_file, mdl, "SOUTHLAT", slat, & "The southern latitude of the domain.", units="degrees") diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 1e0f34f9a0..7d282bffd5 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -115,8 +115,7 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params call MOM_mesg("MOM_initialization.F90, DOME2d_initialize_thickness: setting thickness") call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & - default=1.e-3, units="m", do_not_log=.true.) - min_thickness = GV%m_to_Z*min_thickness + default=1.e-3, units="m", do_not_log=.true., scale=GV%m_to_Z) call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & @@ -450,9 +449,9 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then eta1D(k) = eta1D(k+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%Z_to_m * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo @@ -464,11 +463,11 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) do j=js,je ; do i=is,ie z = -G%bathyT(i,j) do k = nz,1,-1 - z = z + 0.5 * GV%m_to_Z * h(i,j,k) ! Position of the center of layer k + z = z + 0.5 * GV%H_to_Z * h(i,j,k) ! Position of the center of layer k S(i,j,k) = 34.0 - 1.0 * (z/G%max_depth) if ( ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon < dome2d_west_sponge_width ) & S(i,j,k) = S_ref + S_range - z = z + 0.5 * GV%m_to_Z * h(i,j,k) ! Position of the interface k + z = z + 0.5 * GV%H_to_Z * h(i,j,k) ! Position of the interface k enddo enddo ; enddo diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index bcb6a83dd9..a4dc83d9ca 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -167,8 +167,7 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) ! Set up sponges for DOME configuration call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0) - min_depth = GV%m_to_Z * min_depth + "The minimum depth of the ocean.", units="m", default=0.0, scale=GV%m_to_Z) H0(1) = 0.0 do k=2,nz ; H0(k) = -(real(k-1)-0.5)*G%max_depth / real(nz-1) ; enddo diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 0ace62ddc0..267e4c0558 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -149,11 +149,10 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par if (.not.just_read) & call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness") - call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & - 'Minimum layer thickness', units='m', default=1.e-3, do_not_log=just_read) + call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & + 'Minimum layer thickness', units='m', default=1.e-3, do_not_log=just_read, scale=GV%m_to_Z) call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) - min_thickness = GV%m_to_Z*min_thickness select case ( coordinateMode(verticalCoordinate) ) @@ -427,12 +426,10 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) real :: rho_sur, rho_bot, rho_range real :: dT_dz, dS_dz ! Gradients of T and S in degC/Z and PPT/Z. - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface ! - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta. - - ! positive upward, in m. + real :: e0(SZK_(G)+1) ! The resting interface heights, in Z, usually + ! negative because it is positive upward. + real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface, positive upward, in Z. + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in Z. real :: min_depth, dummy1, z real :: damp, rho_dummy, min_thickness, rho_tmp, xi0 character(len=40) :: verticalCoordinate, filename, state_file @@ -470,7 +467,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) ! Set up sponges for ISOMIP configuration call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0) + "The minimum depth of the ocean.", units="m", default=0.0, scale=GV%m_to_Z) if (associated(CSp)) call MOM_error(FATAL, & "ISOMIP_initialize_sponges called with an associated control structure.") @@ -493,7 +490,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) endif ! convert to 1 / seconds - if (G%Zd_to_m * G%bathyT(i,j) > min_depth) then + if (G%bathyT(i,j) > min_depth) then Idamp(i,j) = damp/86400.0 else ; Idamp(i,j) = 0.0 ; endif @@ -547,16 +544,16 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = min_thickness * GV%Z_to_m + h(i,j,k) = min_thickness * GV%Z_to_H else - h(i,j,k) = GV%Z_to_m*(eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H*(eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates do j=js,je ; do i=is,ie - h(i,j,:) = G%Zd_to_m * (G%bathyT(i,j) / dfloat(nz)) + h(i,j,:) = GV%Z_to_H * (G%bathyT(i,j) / dfloat(nz)) enddo ; enddo case default @@ -572,12 +569,12 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) dS_dz = (s_sur - s_bot) / G%max_depth dT_dz = (t_sur - t_bot) / G%max_depth do j=js,je ; do i=is,ie - xi0 = -G%Zd_to_m * G%bathyT(i,j) + xi0 = -G%bathyT(i,j) do k = nz,1,-1 - xi0 = xi0 + 0.5 * h(i,j,k) * GV%m_to_Z ! Depth in middle of layer + xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth in middle of layer S(i,j,k) = S_sur + dS_dz * xi0 T(i,j,k) = T_sur + dT_dz * xi0 - xi0 = xi0 + 0.5 * h(i,j,k) * GV%m_to_Z ! Depth at top of layer + xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth at top of layer enddo enddo ; enddo ! for debugging diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index cb641c9cb9..5e0e7f0af0 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -117,8 +117,8 @@ subroutine Neverland_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ ! Local variables real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), ! usually negative because it is positive upward. - real, dimension(SZK_(G)) :: h_profile ! Vector of initial thickness profile (m) - real :: e_interface ! Current interface positoin (m) + real, dimension(SZK_(G)) :: h_profile ! Vector of initial thickness profile (Z) + real :: e_interface ! Current interface position (m) character(len=40) :: mod = "Neverland_initialize_thickness" ! This subroutine's name. integer :: i, j, k, k1, is, ie, js, je, nz, itt @@ -126,12 +126,13 @@ subroutine Neverland_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ call MOM_mesg(" Neverland_initialization.F90, Neverland_initialize_thickness: setting thickness", 5) call get_param(param_file, mod, "INIT_THICKNESS_PROFILE", h_profile, & - "Profile of initial layer thicknesses.", units="m", fail_if_missing=.true.) + "Profile of initial layer thicknesses.", units="m", scale=GV%m_to_Z, & + fail_if_missing=.true.) ! e0 is the notional position of interfaces e0(1) = 0. ! The surface do k=1,nz - e0(k+1) = e0(k) - GV%m_to_Z*h_profile(k) + e0(k+1) = e0(k) - h_profile(k) enddo do j=js,je ; do i=is,ie diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 719b9cd6ee..f94ff86272 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -65,12 +65,11 @@ subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "JET_HEIGHT", jet_height, & "The interface height scale associated with the \n"//& - "zonal-mean jet.", units="m", & + "zonal-mean jet.", units="m", scale=GV%m_to_Z, & fail_if_missing=.not.just_read, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. - jet_height = jet_height*GV%m_to_Z half_depth = G%max_depth*half_strat eta0(1) = 0.0 ; eta0(nz+1) = -G%max_depth do k=2,1+nz/2 ; eta0(k) = -half_depth*(2.0*(k-1)/real(nz)) ; enddo @@ -240,9 +239,8 @@ subroutine Phillips_initialize_sponges(G, GV, tv, param_file, CSp, h) fail_if_missing=.true.) call get_param(param_file, mdl, "JET_HEIGHT", jet_height, & "The interface height scale associated with the \n"//& - "zonal-mean jet.", units="m", & + "zonal-mean jet.", units="m", scale=GV%m_to_Z, & fail_if_missing=.true.) - jet_height = jet_height * GV%m_to_Z half_depth = G%max_depth*half_strat eta0(1) = 0.0 ; eta0(nz+1) = -G%max_depth diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index e33b1d17ed..b36b58297c 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -61,8 +61,7 @@ subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_par if (.not.just_read) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl,"S_REF",S_ref,fail_if_missing=.true.,do_not_log=.true.) call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness,'Minimum layer thickness', & - units='m', default=1.0e-3, do_not_log=just_read) - min_thickness = min_thickness*GV%m_to_Z + units='m', default=1.0e-3, do_not_log=just_read, scale=GV%m_to_Z) ! Parameters specific to this experiment configuration call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 51a0776900..12ca05fded 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -100,7 +100,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & 'Minimum thickness for layer',& - units='m', default=1.0e-3, do_not_log=just_read) + units='m', default=1.0e-3, do_not_log=just_read, scale=GV%m_to_Z) call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) @@ -154,14 +154,13 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param case ( REGRIDDING_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. - min_thickness = GV%m_to_Z * min_thickness do j=js,je ; do i=is,ie eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = min_thickness + h(i,j,k) = GV%Z_to_H * min_thickness else h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif @@ -171,7 +170,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - h(i,j,:) = GV%Z_to_m * G%bathyT(i,j) / dfloat(nz) + h(i,j,:) = GV%Z_to_H * G%bathyT(i,j) / dfloat(nz) enddo ; enddo end select @@ -282,7 +281,7 @@ subroutine dumbbell_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp call get_param(param_file, mdl, "DUMBBELL_S_RANGE", S_range, do_not_log=.true.) call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & 'Minimum thickness for layer',& - units='m', default=1.0e-3, do_not_log=.true.) + units='m', default=1.0e-3, do_not_log=.true., scale=GV%m_to_Z) ! no active sponges if (sponge_time_scale <= 0.) return @@ -306,12 +305,12 @@ subroutine dumbbell_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp if (use_ALE) then ! construct a uniform grid for the sponge do j=G%jsc,G%jec ; do i=G%isc,G%iec - eta1D(nz+1) = -GV%Z_to_m * G%bathyT(i,j) + eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 - eta1D(k) = -GV%Z_to_m*G%max_depth * real(k-1) / real(nz) + eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = min_thickness + h(i,j,k) = GV%Z_to_H * min_thickness else h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif diff --git a/src/user/external_gwave_initialization.F90 b/src/user/external_gwave_initialization.F90 index 139f4c1945..05a64c6069 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -50,7 +50,7 @@ subroutine external_gwave_initialize_thickness(h, G, GV, param_file, just_read_p if (.not.just_read) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "SSH_ANOMALY_HEIGHT", ssh_anomaly_height, & "The vertical displacement of the SSH anomaly. ", units="m", & - fail_if_missing=.not.just_read, do_not_log=just_read) + fail_if_missing=.not.just_read, do_not_log=just_read, scale=GV%m_to_Z) call get_param(param_file, mdl, "SSH_ANOMALY_WIDTH", ssh_anomaly_width, & "The lateral width of the SSH anomaly. ", units="coordinate", & fail_if_missing=.not.just_read, do_not_log=just_read) @@ -58,7 +58,6 @@ subroutine external_gwave_initialize_thickness(h, G, GV, param_file, just_read_p if (just_read) return ! All run-time parameters have been read, so return. PI = 4.0*atan(1.0) - ssh_anomaly_height = GV%m_to_Z*ssh_anomaly_height do j=G%jsc,G%jec ; do i=G%isc,G%iec Xnondim = (G%geoLonT(i,j)-G%west_lon-0.5*G%len_lon) / ssh_anomaly_width Xnondim = min(1., abs(Xnondim)) diff --git a/src/user/lock_exchange_initialization.F90 b/src/user/lock_exchange_initialization.F90 index b4bb1e296f..e6dd3ee900 100644 --- a/src/user/lock_exchange_initialization.F90 +++ b/src/user/lock_exchange_initialization.F90 @@ -57,18 +57,15 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, param_file, just_read_pa call get_param(param_file, mdl, "FRONT_DISPLACEMENT", front_displacement, & "The vertical displacement of interfaces across the front. \n"//& "A value larger in magnitude that MAX_DEPTH is truncated,", & - units="m", fail_if_missing=.not.just_read, do_not_log=just_read) + units="m", fail_if_missing=.not.just_read, do_not_log=just_read, scale=GV%m_to_Z) call get_param(param_file, mdl, "THERMOCLINE_THICKNESS", thermocline_thickness, & "The thickness of the thermocline in the lock exchange \n"//& "experiment. A value of zero creates a two layer system \n"//& "with vanished layers in between the two inflated layers.", & - default=0., units="m", do_not_log=just_read) + default=0., units="m", do_not_log=just_read, scale=GV%m_to_Z) if (just_read) return ! All run-time parameters have been read, so return. - thermocline_thickness = GV%m_to_Z*thermocline_thickness - front_displacement = GV%m_to_Z*front_displacement - do j=G%jsc,G%jec ; do i=G%isc,G%iec do k=2,nz eta1D(K) = -0.5 * G%max_depth & ! Middle of column diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index f4411f749d..7ec04ba302 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -101,7 +101,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & 'Minimum thickness for layer',& - units='m', default=1.0e-3, do_not_log=just_read) + units='m', default=1.0e-3, do_not_log=just_read, scale=GV%m_to_Z) call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) @@ -155,7 +155,6 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param case ( REGRIDDING_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. - min_thickness = min_thickness * GV%m_to_Z do j=js,je ; do i=is,ie eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 From dcdd9ae1e214d8f0c4c548d12dd1448c83016489 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Wed, 5 Sep 2018 13:30:52 -0400 Subject: [PATCH 0696/1072] Effort to decimate the diag output at runtime - To produce the full diagnostics for 1/8 degree model it is needed to reduce the size of output files. This could be done by "averaging" over a few neighboring grid cells and output the resulting fields on the reduced domain. That's what we call decimation and is the purpose of this project branch. --- src/framework/MOM_diag_mediator.F90 | 51 ++++++++++++++++++++++++++++- src/framework/MOM_diag_remap.F90 | 17 ++++++++++ 2 files changed, 67 insertions(+), 1 deletion(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index fb84d4d48d..6fdd0cc6df 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -25,7 +25,7 @@ module MOM_diag_mediator use MOM_diag_remap, only : diag_remap_configure_axes, diag_remap_axes_configured use MOM_diag_remap, only : diag_remap_get_axes_info, diag_remap_set_active use MOM_diag_remap, only : diag_remap_diag_registration_closed -use MOM_diag_remap, only : horizontally_average_diag_field +use MOM_diag_remap, only : horizontally_average_diag_field, horizontally_decimate_diag_field use diag_axis_mod, only : get_diag_axis_name use diag_data_mod, only : null_axis_id @@ -133,6 +133,7 @@ module MOM_diag_mediator logical :: in_use !< True if this entry is being used. integer :: fms_diag_id !< Underlying FMS diag_manager id. integer :: fms_xyave_diag_id = -1 !< For a horizontally area-averaged diagnostic. + integer :: decimate_diag_id = -1 !< For a horizontally area-decimated diagnostic. character(64) :: debug_str = '' !< For FATAL errors and debugging. type(axes_grp), pointer :: axes => null() !< The axis group for this diagnostic type(diag_type), pointer :: next => null() !< Pointer to the next diagnostic @@ -1170,11 +1171,59 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) if (diag%fms_xyave_diag_id>0) then call post_xy_average(diag_cs, diag, locfield) endif + + !Decimation test + if (diag%decimate_diag_id>0) then + call post_decimated_data(diag_cs, diag, locfield, decimation_factor=2) + endif + if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) & deallocate( locfield ) end subroutine post_data_3d_low +!> Post the horizontally area-averaged diagnostic +subroutine post_decimated_data(diag_cs, diag, field, decimation_factor) + type(diag_ctrl), intent(in) :: diag_cs !< Diagnostics mediator control structure + type(diag_type), intent(in) :: diag !< This diagnostic + real, target, intent(in) :: field(:,:,:) !< Diagnostic field + integer, intent(in) :: decimation_factor !< The factor by which to decimate the diag output field + ! Local variable + real, dimension(size(field,3)) :: decimated_field + logical :: used + integer :: nz, remap_nz, coord + +! if (.not. diag_cs%ave_enabled) then +! return +! endif + + if (diag%axes%is_native) then + call horizontally_decimate_diag_field(diag_cs%G, diag_cs%h, & + diag%axes%is_layer, diag%v_extensive, & + diag_cs%missing_value, decimation_factor, field, decimated_field) + else + nz = size(field, 3) + coord = diag%axes%vertical_coordinate_number + remap_nz = diag_cs%diag_remap_cs(coord)%nz + + call assert(diag_cs%diag_remap_cs(coord)%initialized, & + 'post_xy_average: remap_cs not initialized.') + + call assert(IMPLIES(diag%axes%is_layer, nz == remap_nz), & + 'post_xy_average: layer field dimension mismatch.') + call assert(IMPLIES(.not. diag%axes%is_layer, nz == remap_nz+1), & + 'post_xy_average: interface field dimension mismatch.') + + call horizontally_decimate_diag_field(diag_cs%G, diag_cs%diag_remap_cs(coord)%h, & + diag%axes%is_layer, diag%v_extensive, & + diag_cs%missing_value, decimation_factor, field, decimated_field) + endif + + used = send_data(diag%decimate_diag_id, decimated_field, diag_cs%time_end, & + weight=diag_cs%time_int) + +end subroutine post_decimated_data + !> Post the horizontally area-averaged diagnostic subroutine post_xy_average(diag_cs, diag, field) type(diag_type), intent(in) :: diag !< This diagnostic diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 737e7a3fbf..4022318e69 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -54,6 +54,7 @@ module MOM_diag_remap public vertically_reintegrate_diag_field public vertically_interpolate_diag_field public horizontally_average_diag_field +public horizontally_decimate_diag_field !> Represents remapping of diagnostics to a particular vertical coordinate. !! @@ -704,4 +705,20 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, end subroutine horizontally_average_diag_field +!> Horizontally decimate field +subroutine horizontally_decimate_diag_field(G, h, & + is_layer, is_extensive, & + missing_value, decimation_factor, field, decimated_field) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + real, dimension(:,:,:), intent(in) :: h !< The current thicknesses + logical, intent(in) :: is_layer !< True if the z-axis location is at h points + logical, intent(in) :: is_extensive !< True if the z-direction is spatially integrated (over layers) + real, intent(in) :: missing_value !< A missing_value to assign land/vanished points + integer, intent(in) :: decimation_factor !< The factor by which to decimate the diag output field + real, dimension(:,:,:), intent(in) :: field !< The diagnostic field to be remapped + real, dimension(:), intent(inout) :: decimated_field !< Field argument horizontally averaged + ! Local variables + +end subroutine horizontally_decimate_diag_field + end module MOM_diag_remap From e0cf6a5d56555303e5c79774ea0e023d8b29d5cb Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Wed, 5 Sep 2018 13:55:07 -0400 Subject: [PATCH 0697/1072] Fix diagnostics bug that cause crash - These diagnostics are posted without properly checking their id>0 Their id's are only checked inside .or. combinations so we run into a crash if they are not registered but the .or.ed companions are. --- src/core/MOM_forcing_type.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 9ac616dac0..7d27841311 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -2133,7 +2133,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%frunoff)) res(i,j) = res(i,j)+fluxes%frunoff(i,j) if (associated(fluxes%vprec)) res(i,j) = res(i,j)+fluxes%vprec(i,j) enddo ; enddo - call post_data(handles%id_prcme, res, diag) + if (handles%id_prcme > 0) call post_data(handles%id_prcme, res, diag) if (handles%id_total_prcme > 0) then total_transport = global_area_integral(res,G) call post_data(handles%id_total_prcme, total_transport, diag) @@ -2151,7 +2151,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (fluxes%vprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%vprec(i,j) if (fluxes%evap(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) enddo ; enddo - call post_data(handles%id_net_massout, res, diag) + if (handles%id_net_massout > 0) call post_data(handles%id_net_massout, res, diag) if (handles%id_total_net_massout > 0) then total_transport = global_area_integral(res,G) call post_data(handles%id_total_net_massout, total_transport, diag) @@ -2168,7 +2168,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) ! fluxes%cond is not needed because it is derived from %evap > 0 if (fluxes%evap(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) enddo ; enddo - call post_data(handles%id_net_massin, res, diag) + if (handles%id_net_massin > 0) call post_data(handles%id_net_massin, res, diag) if (handles%id_total_net_massin > 0) then total_transport = global_area_integral(res,G) call post_data(handles%id_total_net_massin, total_transport, diag) @@ -2322,7 +2322,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%sens)) res(i,j) = res(i,j) + fluxes%sens(i,j) if (associated(fluxes%SW)) res(i,j) = res(i,j) + fluxes%SW(i,j) enddo ; enddo - call post_data(handles%id_net_heat_coupler, res, diag) + if (handles%id_net_heat_coupler > 0) call post_data(handles%id_net_heat_coupler, res, diag) if (handles%id_total_net_heat_coupler > 0) then total_transport = global_area_integral(res,G) call post_data(handles%id_total_net_heat_coupler, total_transport, diag) @@ -2382,7 +2382,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%heat_content_massout)) res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j) ! endif enddo ; enddo - call post_data(handles%id_heat_content_surfwater, res, diag) + if (handles%id_heat_content_surfwater > 0) call post_data(handles%id_heat_content_surfwater, res, diag) if (handles%id_total_heat_content_surfwater > 0) then total_transport = global_area_integral(res,G) call post_data(handles%id_total_heat_content_surfwater, total_transport, diag) From c37b9da80767d9ec48fc83a5ccb53ac2094e7e06 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 5 Sep 2018 14:47:51 -0600 Subject: [PATCH 0698/1072] remove shr logging --- config_src/nuopc_driver/mom_cap.F90 | 94 +++++++++-------------------- 1 file changed, 28 insertions(+), 66 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 0088eac6e7..9aa394bce3 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -402,9 +402,9 @@ module mom_cap_mod use shr_nuopc_scalars_mod, only: flds_scalar_name, flds_scalar_num use shr_nuopc_scalars_mod, only: flds_scalar_index_nx, flds_scalar_index_ny use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit - use shr_file_mod, only: shr_file_getLogUnit, shr_file_getLogLevel use shr_file_mod, only: shr_file_setLogUnit, shr_file_setLogLevel use shr_nuopc_time_mod, only: shr_nuopc_time_alarmInit + use, intrinsic :: iso_fortran_env, only: output_unit #endif use ESMF ! TODO: only: ... @@ -656,6 +656,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) !! @param clock an ESMF_Clock object !! @param rc return code subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance, shr_nuopc_utils_ChkErr type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -686,8 +687,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(len=512) :: diro character(len=512) :: logfile character(len=64) :: cvalue - integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level integer :: inst_index ! number of current instance (ie. 1) character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") character(len=16) :: inst_suffix = "" ! char string associated with instance @@ -698,6 +697,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(len=384) :: restartname ! The restart file name (no dir) integer :: nu ! i/o unit to read pointer file #endif + character(len=*),parameter :: subname='(mom_cap:InitializeAdvertise)' !-------------------------------- @@ -755,58 +755,20 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) #ifdef CESMCOUPLED ! determine instance information - call NUOPC_CompAttributeGet(gcomp, name="inst_name", value=inst_name, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call NUOPC_CompAttributeGet(gcomp, name="inst_index", value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - read(cvalue,*) inst_index - - call ESMF_AttributeGet(gcomp, name="inst_suffix", isPresent=isPresent, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (isPresent) then - call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", value=inst_suffix, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else - inst_suffix = '' - end if + call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) + inst_name = "OCN"//trim(inst_suffix) ! reset shr logging to my log file - if (is_root_pe()) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - logunit = shr_file_getUnit() - open(logunit,file=trim(diro)//"/"//trim(logfile)) + if(is_root_pe()) then + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) else - logunit = 6 + logunit = output_unit endif - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) - call shr_file_setLogUnit (logunit) - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1091,7 +1053,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call initialize_grid_rotation_angle(ocean_grid, PF) write(*,*) '----- MOM initialization phase Advertise completed' - +#ifdef CESMCOUPLED + call shr_file_setLogUnit (output_unit) +#endif end subroutine InitializeAdvertise !=============================================================================== @@ -1148,8 +1112,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: mpicom integer :: localPet #ifdef CESMCOUPLED - integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level integer :: inst_index ! number of current instance (ie. 1) character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") character(len=16) :: inst_suffix = "" ! char string associated with instance @@ -1161,7 +1123,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- rc = ESMF_SUCCESS - +#ifdef CESMCOUPLED + call shr_file_setLogUnit (logunit) +#endif !---------------------------------------------------------------------------- ! Get pointers to ocean internal state !---------------------------------------------------------------------------- @@ -1663,7 +1627,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! return ! bail out write(*,*) '----- MOM initialization phase Realize completed' - +#ifdef CESMCOUPLED + call shr_file_setLogUnit (output_unit) +#endif end subroutine InitializeRealize !=============================================================================== @@ -1794,9 +1760,6 @@ subroutine ModelAdvance(gcomp, rc) #ifdef CESMCOUPLED type(ESMF_Time) :: MyTime integer :: seconds, day, year, month, hour, minute - integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - integer :: logunit ! i/o unit for stdout integer :: nu ! i/o unit to write pointer file character(ESMF_MAXSTR) :: cvalue character(ESMF_MAXSTR) :: runid ! Run ID @@ -1821,7 +1784,9 @@ subroutine ModelAdvance(gcomp, rc) rc = ESMF_SUCCESS if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") - +#ifdef CESMCOUPLED + call shr_file_setLogUnit (logunit) +#endif ! query the Component for its clock, importState and exportState call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & exportState=exportState, rc=rc) @@ -1906,9 +1871,6 @@ subroutine ModelAdvance(gcomp, rc) #ifdef CESMCOUPLED ! Reset shr logging to my log file - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, logunit, runtype, clock, rc=rc) @@ -2062,9 +2024,7 @@ subroutine ModelAdvance(gcomp, rc) endif ! reset shr logging to my original values - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - + call shr_file_setLogUnit (output_unit) #else allocate(ofld(isc:iec,jsc:jec)) @@ -2179,7 +2139,9 @@ subroutine ModelAdvance(gcomp, rc) !write(*,*) 'MOM: --- run phase called ---' if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") - +#ifdef CESMCOUPLED + call shr_file_setLogUnit (output_unit) +#endif end subroutine ModelAdvance !=============================================================================== From c09c0a95e25288700d7ab2513a5a4807454ea404 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 5 Sep 2018 18:34:58 -0400 Subject: [PATCH 0699/1072] +Added get_simple_array_i_ind and ..._array_j_ind Added get_simple_array_i_ind and get_simple_array_j_ind to determine the computational array extents for simple arrays based on their size. All answers are bitwise identical, but there are new public types. --- src/framework/MOM_domains.F90 | 122 +++++++++++++++++++++++++++------- 1 file changed, 97 insertions(+), 25 deletions(-) diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index a38facf79a..5d3faaae35 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -43,6 +43,7 @@ module MOM_domains public :: create_group_pass, do_group_pass, group_pass_type public :: start_group_pass, complete_group_pass public :: compute_block_extent, get_global_shape +public :: get_simple_array_i_ind, get_simple_array_j_ind !> Do a halo update on an array interface pass_var @@ -1682,31 +1683,29 @@ subroutine get_domain_extent(Domain, isc, iec, jsc, jec, isd, ied, jsd, jed, & isg, ieg, jsg, jeg, idg_offset, jdg_offset, & symmetric, local_indexing, index_offset) type(MOM_domain_type), & - intent(in) :: Domain !< The MOM domain from which to extract information - integer, intent(out) :: isc !< The start i-index of the computational domain - integer, intent(out) :: iec !< The end i-index of the computational domain - integer, intent(out) :: jsc !< The start j-index of the computational domain - integer, intent(out) :: jec !< The end j-index of the computational domain - integer, intent(out) :: isd !< The start i-index of the data domain - integer, intent(out) :: ied !< The end i-index of the data domain - integer, intent(out) :: jsd !< The start j-index of the data domain - integer, intent(out) :: jed !< The end j-index of the data domain - integer, intent(out) :: isg !< The start i-index of the global domain - integer, intent(out) :: ieg !< The end i-index of the global domain - integer, intent(out) :: jsg !< The start j-index of the global domain - integer, intent(out) :: jeg !< The end j-index of the global domain - integer, intent(out) :: idg_offset !< The offset between the corresponding global and - !! data i-index spaces. - integer, intent(out) :: jdg_offset !< The offset between the corresponding global and - !! data j-index spaces. - logical, intent(out) :: symmetric !< True if symmetric memory is used. - logical, optional, & - intent(in) :: local_indexing !< If true, local tracer array indices start at 1, - !! as in most MOM6 code. - integer, optional, & - intent(in) :: index_offset !< A fixed additional offset to all indices. This - !! can be useful for some types of debugging with - !! dynamic memory allocation. + intent(in) :: Domain !< The MOM domain from which to extract information + integer, intent(out) :: isc !< The start i-index of the computational domain + integer, intent(out) :: iec !< The end i-index of the computational domain + integer, intent(out) :: jsc !< The start j-index of the computational domain + integer, intent(out) :: jec !< The end j-index of the computational domain + integer, intent(out) :: isd !< The start i-index of the data domain + integer, intent(out) :: ied !< The end i-index of the data domain + integer, intent(out) :: jsd !< The start j-index of the data domain + integer, intent(out) :: jed !< The end j-index of the data domain + integer, intent(out) :: isg !< The start i-index of the global domain + integer, intent(out) :: ieg !< The end i-index of the global domain + integer, intent(out) :: jsg !< The start j-index of the global domain + integer, intent(out) :: jeg !< The end j-index of the global domain + integer, intent(out) :: idg_offset !< The offset between the corresponding global and + !! data i-index spaces. + integer, intent(out) :: jdg_offset !< The offset between the corresponding global and + !! data j-index spaces. + logical, intent(out) :: symmetric !< True if symmetric memory is used. + logical, optional, intent(in) :: local_indexing !< If true, local tracer array indices start at 1, + !! as in most MOM6 code. + integer, optional, intent(in) :: index_offset !< A fixed additional offset to all indices. This + !! can be useful for some types of debugging with + !! dynamic memory allocation. ! Local variables integer :: ind_off logical :: local @@ -1738,6 +1737,79 @@ subroutine get_domain_extent(Domain, isc, iec, jsc, jec, isd, ied, jsd, jed, & end subroutine get_domain_extent +!> Return the (potentially symmetric) computational domain i-bounds for an array +!! passed without index specifications (i.e. indices start at 1) based on an array size. +subroutine get_simple_array_i_ind(domain, size, is, ie, symmetric) + type(MOM_domain_type), intent(in) :: domain !< MOM domain from which to extract information + integer, intent(in) :: size !< The i-array size + integer, intent(out) :: is !< The computational domain starting i-index. + integer, intent(out) :: ie !< The computational domain ending i-index. + logical, optional, intent(in) :: symmetric !< If present, indicates whether symmetric sizes + !! can be considered. + ! Local variables + logical :: sym + character(len=120) :: mesg, mesg2 + integer :: isc, iec, jsc, jec, isd, ied, jsd, jed + + call mpp_get_compute_domain(Domain%mpp_domain, isc, iec, jsc, jec) + call mpp_get_data_domain(Domain%mpp_domain, isd, ied, jsd, jed) + + isc = isc-isd+1 ; iec = iec-isd+1 ; ied = ied-isd+1 ; isd = 1 + sym = Domain%symmetric ; if (present(symmetric)) sym = symmetric + + if (size == ied) then ; is = isc ; ie = iec + elseif (size == 1+iec-isc) then ; is = 1 ; ie = size + elseif (sym .and. (size == 1+ied)) then ; is = isc ; ie = iec+1 + elseif (sym .and. (size == 2+iec-isc)) then ; is = 1 ; ie = size+1 + else + write(mesg,'("Unrecognized size ", i6, "in call to get_simple_array_i_ind. \")') size + if (sym) then + write(mesg2,'("Valid sizes are : ", 2i7)') ied, 1+iec-isc + else + write(mesg2,'("Valid sizes are : ", 4i7)') ied, 1+iec-isc, 1+ied, 2+iec-isc + endif + call MOM_error(FATAL, trim(mesg)//trim(mesg2)) + endif + +end subroutine get_simple_array_i_ind + + +!> Return the (potentially symmetric) computational domain j-bounds for an array +!! passed without index specifications (i.e. indices start at 1) based on an array size. +subroutine get_simple_array_j_ind(domain, size, js, je, symmetric) + type(MOM_domain_type), intent(in) :: domain !< MOM domain from which to extract information + integer, intent(in) :: size !< The j-array size + integer, intent(out) :: js !< The computational domain starting j-index. + integer, intent(out) :: je !< The computational domain ending j-index. + logical, optional, intent(in) :: symmetric !< If present, indicates whether symmetric sizes + !! can be considered. + ! Local variables + logical :: sym + character(len=120) :: mesg, mesg2 + integer :: isc, iec, jsc, jec, isd, ied, jsd, jed + + call mpp_get_compute_domain(Domain%mpp_domain, isc, iec, jsc, jec) + call mpp_get_data_domain(Domain%mpp_domain, isd, ied, jsd, jed) + + jsc = jsc-jsd+1 ; jec = jec-jsd+1 ; jed = jed-jsd+1 ; jsd = 1 + sym = Domain%symmetric ; if (present(symmetric)) sym = symmetric + + if (size == jed) then ; js = jsc ; je = jec + elseif (size == 1+jec-jsc) then ; js = 1 ; je = size + elseif (sym .and. (size == 1+jed)) then ; js = jsc ; je = jec+1 + elseif (sym .and. (size == 2+jec-jsc)) then ; js = 1 ; je = size+1 + else + write(mesg,'("Unrecognized size ", i6, "in call to get_simple_array_j_ind. \")') size + if (sym) then + write(mesg2,'("Valid sizes are : ", 2i7)') jed, 1+jec-jsc + else + write(mesg2,'("Valid sizes are : ", 4i7)') jed, 1+jec-jsc, 1+jed, 2+jec-jsc + endif + call MOM_error(FATAL, trim(mesg)//trim(mesg2)) + endif + +end subroutine get_simple_array_j_ind + !> Returns the global shape of h-point arrays subroutine get_global_shape(domain, niglobal, njglobal) type(MOM_domain_type), intent(in) :: domain !< MOM domain From 243bc339ae9c1addaa4b0607cbfe3f493a96ba38 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 5 Sep 2018 18:35:29 -0400 Subject: [PATCH 0700/1072] +Added scale argument to MOM_read_data Added a scale argument to the various versions of MOM_read_data, so that input arrays can be rescaled before being returned. All answers are bitwise identical but there is a new optional argument in a public interface. --- src/framework/MOM_io.F90 | 78 +++++++++++++++++++++++++++++++++++----- 1 file changed, 69 insertions(+), 9 deletions(-) diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index e523270802..db0afa3d8a 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -6,6 +6,7 @@ module MOM_io use MOM_error_handler, only : MOM_error, NOTE, FATAL, WARNING use MOM_domains, only : MOM_domain_type, AGRID, BGRID_NE, CGRID_NE +use MOM_domains, only : get_simple_array_i_ind, get_simple_array_j_ind use MOM_file_parser, only : log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_dyn_horgrid, only : dyn_horgrid_type @@ -845,21 +846,27 @@ end function FMS_file_exists !> This function uses the fms_io function read_data to read 1-D !! data field named "fieldname" from file "filename". -subroutine MOM_read_data_1d(filename, fieldname, data, timelevel) +subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:), intent(inout) :: data !< The 1-dimensional array into which the data integer, optional, intent(in) :: timelevel !< The time level in the file to read + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied + !! by before they are returned. call read_data(filename, fieldname, data, timelevel=timelevel, no_domain=.true.) + if (present(scale)) then ; if (scale /= 1.0) then + data(:) = scale*data(:) + endif ; endif + end subroutine MOM_read_data_1d !> This function uses the fms_io function read_data to read a distributed !! 2-D data field named "fieldname" from file "filename". Valid values for !! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE. subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & - timelevel, position) + timelevel, position, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:,:), intent(inout) :: data !< The 2-dimensional array into which the data @@ -867,17 +874,27 @@ subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition integer, optional, intent(in) :: timelevel !< The time level in the file to read integer, optional, intent(in) :: position !< A flag indicating where this data is located + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied + !! by before they are returned. + + integer :: is, ie, js, je call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, & timelevel=timelevel, position=position) + if (present(scale)) then ; if (scale /= 1.0) then + call get_simple_array_i_ind(MOM_Domain, size(data,1), is, ie) + call get_simple_array_j_ind(MOM_Domain, size(data,2), js, je) + data(is:ie,js:je) = scale*data(is:ie,js:je) + endif ; endif + end subroutine MOM_read_data_2d !> This function uses the fms_io function read_data to read a distributed !! 3-D data field named "fieldname" from file "filename". Valid values for !! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE. subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & - timelevel, position) + timelevel, position, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:,:,:), intent(inout) :: data !< The 3-dimensional array into which the data @@ -885,17 +902,27 @@ subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition integer, optional, intent(in) :: timelevel !< The time level in the file to read integer, optional, intent(in) :: position !< A flag indicating where this data is located + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied + !! by before they are returned. + + integer :: is, ie, js, je call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, & timelevel=timelevel, position=position) + if (present(scale)) then ; if (scale /= 1.0) then + call get_simple_array_i_ind(MOM_Domain, size(data,1), is, ie) + call get_simple_array_j_ind(MOM_Domain, size(data,2), js, je) + data(is:ie,js:je,:) = scale*data(is:ie,js:je,:) + endif ; endif + end subroutine MOM_read_data_3d !> This function uses the fms_io function read_data to read a distributed !! 4-D data field named "fieldname" from file "filename". Valid values for !! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE. subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & - timelevel, position) + timelevel, position, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:,:,:,:), intent(inout) :: data !< The 4-dimensional array into which the data @@ -903,10 +930,20 @@ subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition integer, optional, intent(in) :: timelevel !< The time level in the file to read integer, optional, intent(in) :: position !< A flag indicating where this data is located + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied + !! by before they are returned. + + integer :: is, ie, js, je call read_data(filename, fieldname, data, MOM_Domain%mpp_domain, & timelevel=timelevel, position=position) + if (present(scale)) then ; if (scale /= 1.0) then + call get_simple_array_i_ind(MOM_Domain, size(data,1), is, ie) + call get_simple_array_j_ind(MOM_Domain, size(data,2), js, je) + data(is:ie,js:je,:,:) = scale*data(is:ie,js:je,:,:) + endif ; endif + end subroutine MOM_read_data_4d @@ -914,7 +951,7 @@ end subroutine MOM_read_data_4d !! 2-D data fields with names given by "[uv]_fieldname" from file "filename". Valid values for !! "stagger" include CGRID_NE, BGRID_NE, and AGRID. subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, & - timelevel, stagger, scalar_pair) + timelevel, stagger, scalar_pair, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: u_fieldname !< The variable name of the u data in the file character(len=*), intent(in) :: v_fieldname !< The variable name of the v data in the file @@ -925,8 +962,10 @@ subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition integer, optional, intent(in) :: timelevel !< The time level in the file to read integer, optional, intent(in) :: stagger !< A flag indicating where this vector is discretized - logical, optional, intent(in) :: scalar_pair !< If true, a pair of scalars are to be read.cretized - + logical, optional, intent(in) :: scalar_pair !< If true, a pair of scalars are to be read.cretized + real, optional, intent(in) :: scale !< A scaling factor that the fields are multiplied + !! by before they are returned. + integer :: is, ie, js, je integer :: u_pos, v_pos u_pos = EAST_FACE ; v_pos = NORTH_FACE @@ -941,6 +980,15 @@ subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data call read_data(filename, v_fieldname, v_data, MOM_Domain%mpp_domain, & timelevel=timelevel, position=v_pos) + if (present(scale)) then ; if (scale /= 1.0) then + call get_simple_array_i_ind(MOM_Domain, size(u_data,1), is, ie) + call get_simple_array_j_ind(MOM_Domain, size(u_data,2), js, je) + u_data(is:ie,js:je) = scale*u_data(is:ie,js:je) + call get_simple_array_i_ind(MOM_Domain, size(v_data,1), is, ie) + call get_simple_array_j_ind(MOM_Domain, size(v_data,2), js, je) + v_data(is:ie,js:je) = scale*v_data(is:ie,js:je) + endif ; endif + end subroutine MOM_read_vector_2d @@ -948,7 +996,7 @@ end subroutine MOM_read_vector_2d !! 3-D data fields with names given by "[uv]_fieldname" from file "filename". Valid values for !! "stagger" include CGRID_NE, BGRID_NE, and AGRID. subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, & - timelevel, stagger, scalar_pair) + timelevel, stagger, scalar_pair, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: u_fieldname !< The variable name of the u data in the file character(len=*), intent(in) :: v_fieldname !< The variable name of the v data in the file @@ -959,8 +1007,11 @@ subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data type(MOM_domain_type), intent(in) :: MOM_Domain !< The MOM_Domain that describes the decomposition integer, optional, intent(in) :: timelevel !< The time level in the file to read integer, optional, intent(in) :: stagger !< A flag indicating where this vector is discretized - logical, optional, intent(in) :: scalar_pair !< If true, a pair of scalars are to be read.cretized + logical, optional, intent(in) :: scalar_pair !< If true, a pair of scalars are to be read.cretized + real, optional, intent(in) :: scale !< A scaling factor that the fields are multiplied + !! by before they are returned. + integer :: is, ie, js, je integer :: u_pos, v_pos u_pos = EAST_FACE ; v_pos = NORTH_FACE @@ -975,6 +1026,15 @@ subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data call read_data(filename, v_fieldname, v_data, MOM_Domain%mpp_domain, & timelevel=timelevel, position=v_pos) + if (present(scale)) then ; if (scale /= 1.0) then + call get_simple_array_i_ind(MOM_Domain, size(u_data,1), is, ie) + call get_simple_array_j_ind(MOM_Domain, size(u_data,2), js, je) + u_data(is:ie,js:je,:) = scale*u_data(is:ie,js:je,:) + call get_simple_array_i_ind(MOM_Domain, size(v_data,1), is, ie) + call get_simple_array_j_ind(MOM_Domain, size(v_data,2), js, je) + v_data(is:ie,js:je,:) = scale*v_data(is:ie,js:je,:) + endif ; endif + end subroutine MOM_read_vector_3d From 8c0acdeefb3ce4a7aa91f2c67703f1c24980a682 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 5 Sep 2018 18:37:28 -0400 Subject: [PATCH 0701/1072] Rescale input fields in MOM_read_data calls Rescaled a number of initialization fields that are read from files to the right internal representation inside of the MOM_read_data calls. All answers are bitwise identical. --- .../MOM_state_initialization.F90 | 32 ++++++------------- src/user/ISOMIP_initialization.F90 | 5 +-- 2 files changed, 11 insertions(+), 26 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 756e192196..4aa8e55e93 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -641,10 +641,7 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne if (file_has_thickness) then !### Consider adding a parameter to use to rescale h. if (just_read) return ! All run-time parameters have been read, so return. - call MOM_read_data(filename, "h", h(:,:,:), G%Domain) - do k=1,nz ; do j=js,je ; do i=is,ie - h(i,j,k) = GV%m_to_H * h(i,j,k) - enddo ; enddo ; enddo + call MOM_read_data(filename, "h", h(:,:,:), G%Domain, scale=GV%m_to_H) else call get_param(param_file, mdl, "ADJUST_THICKNESS", correct_thickness, & "If true, all mass below the bottom removed if the \n"//& @@ -860,8 +857,7 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) call log_param(param_file, mdl, "INPUTDIR/INTERFACE_IC_FILE", filename) e0(:) = 0.0 - call MOM_read_data(filename, eta_var, e0(:)) - do k=1,nz+1 ; e0(k) = GV%m_to_Z*e0(k) ; enddo + call MOM_read_data(filename, eta_var, e0(:), scale=GV%m_to_Z) if ((abs(e0(1)) - 0.0) > 0.001) then ! This list probably starts with the interior interface, so shift it up. @@ -1024,11 +1020,7 @@ subroutine depress_surface(h, G, GV, param_file, tv, just_read_params) if (just_read) return ! All run-time parameters have been read, so return. - call MOM_read_data(filename, eta_srf_var, eta_sfc, G%Domain) - - if (scale_factor /= 1.0) then ; do j=js,je ; do i=is,ie - eta_sfc(i,j) = eta_sfc(i,j) * scale_factor - enddo ; enddo ; endif + call MOM_read_data(filename, eta_srf_var, eta_sfc, G%Domain, scale=scale_factor) ! Convert thicknesses to interface heights. call find_eta(h, tv, GV%g_Earth, G, GV, eta) @@ -1111,8 +1103,7 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) if (just_read) return ! All run-time parameters have been read, so return. - call MOM_read_data(filename, p_surf_var, p_surf, G%Domain) - if (scale_factor /= 1.) p_surf(:,:) = scale_factor * p_surf(:,:) + call MOM_read_data(filename, p_surf_var, p_surf, G%Domain, scale=scale_factor) if (use_remapping) then allocate(remap_CS) @@ -1748,10 +1739,7 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, if (.not. use_ALE) then allocate(eta(isd:ied,jsd:jed,nz+1)) - call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) - if (GV%m_to_Z /= 1.0) then ; do k=1,nz+1 ; do j=js,je ; do i=is,ie - eta(i,j,k) = GV%m_to_Z*eta(i,j,k) - enddo ; enddo ; enddo ; endif + call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=GV%m_to_Z) do j=js,je ; do i=is,ie eta(i,j,nz+1) = -G%bathyT(i,j) @@ -1776,18 +1764,18 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, allocate(eta(isd:ied,jsd:jed,nz_data+1)) allocate(h(isd:ied,jsd:jed,nz_data)) - call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) + call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=GV%m_to_Z) do j=js,je ; do i=is,ie - eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) + eta(i,j,nz+1) = -G%bathyT(i,j) enddo ; enddo do k=nz,1,-1 ; do j=js,je ; do i=is,ie - if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_m)) & - eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_m + if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) & + eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_Z enddo ; enddo ; enddo do k=1,nz; do j=js,je ; do i=is,ie - h(i,j,k) = eta(i,j,k)-eta(i,j,k+1) + h(i,j,k) = GV%m_to_H*(eta(i,j,k)-eta(i,j,k+1)) enddo ; enddo ; enddo call initialize_ALE_sponge(Idamp, G, param_file, ALE_CSp, h, nz_data) deallocate(eta) diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 267e4c0558..969bb0664e 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -623,10 +623,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) filename = trim(inputdir)//trim(state_file) if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & "ISOMIP_initialize_sponges: Unable to open "//trim(filename)) - call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain) - if (GV%m_to_Z /= 1.0) then ; do k=1,nz+1 ; do j=js,je ; do i=is,ie - eta(i,j,k) = GV%m_to_Z*eta(i,j,k) - enddo ; enddo ; enddo ; endif + call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=GV%m_to_Z) call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain) call MOM_read_data(filename, salt_var, S(:,:,:), G%Domain) From 48a28d20824a75121bfeb873445cb6852c6b8c62 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 6 Sep 2018 09:20:43 -0400 Subject: [PATCH 0702/1072] Rescale diagnostics in post_data_1d_k If the conversion argument in a register_diag_field call has been set to something other than 1, other post_data calls will rescale diagnostics, but post_data_1d_k previously did not. Now it does. All answers are bitwise identical. --- src/framework/MOM_diag_mediator.F90 | 29 ++++++++++++++++++++++++----- 1 file changed, 24 insertions(+), 5 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index fb84d4d48d..e1103f2a20 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -752,14 +752,15 @@ end subroutine post_data_0d subroutine post_data_1d_k(diag_field_id, field, diag_cs, is_static) integer, intent(in) :: diag_field_id !< The id for an output variable returned by a !! previous call to register_diag_field. - real, intent(in) :: field(:) !< 1-d array being offered for output or averaging + real, target, intent(in) :: field(:) !< 1-d array being offered for output or averaging type(diag_ctrl), target, intent(in) :: diag_CS !< Structure used to regulate diagnostic output logical, optional, intent(in) :: is_static !< If true, this is a static field that is always offered. ! Local variables logical :: used ! The return value of send_data is not used for anything. + real, dimension(:), pointer :: locfield => NULL() logical :: is_stat - integer :: isv, iev, jsv, jev + integer :: k, ks, ke type(diag_type), pointer :: diag => null() if (id_clock_diag_mediator>0) call cpu_clock_begin(id_clock_diag_mediator) @@ -770,11 +771,29 @@ subroutine post_data_1d_k(diag_field_id, field, diag_cs, is_static) 'post_data_1d_k: Unregistered diagnostic id') diag => diag_cs%diags(diag_field_id) do while (associated(diag)) + + if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) then + ks = lbound(field,1) ; ke = ubound(field,1) + allocate( locfield( ks:ke ) ) + + do k=ks,ke + if (field(k) == diag_cs%missing_value) then + locfield(k) = diag_cs%missing_value + else + locfield(k) = field(k) * diag%conversion_factor + endif + enddo + else + locfield => field + endif + if (is_stat) then - used = send_data(diag%fms_diag_id, field) + used = send_data(diag%fms_diag_id, locfield) elseif (diag_cs%ave_enabled) then - used = send_data(diag%fms_diag_id, field, diag_cs%time_end, weight=diag_cs%time_int) + used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, weight=diag_cs%time_int) endif + if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) deallocate( locfield ) + diag => diag%next enddo @@ -800,7 +819,7 @@ subroutine post_data_2d(diag_field_id, field, diag_cs, is_static, mask) 'post_data_2d: Unregistered diagnostic id') diag => diag_cs%diags(diag_field_id) do while (associated(diag)) - call post_data_2d_low(diag, field, diag_cs, is_static, mask) + call post_data_2d_low(diag, field, diag_cs, is_static, mask) diag => diag%next enddo From 2f66582d1f1e4dd278926f45af1f51d072be84a2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 6 Sep 2018 09:25:44 -0400 Subject: [PATCH 0703/1072] Explicitly calculate thkcello Added code to avoid an array syntax multiply of a diagnostic. All answers are bitwise identical in test cases, but this could avoid encountering NaNs in halo regions, and it avoids unnecessary calculations when H_to_m=1. --- src/diagnostics/MOM_diagnostics.F90 | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index e5ffdbff02..99d19c657a 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -324,7 +324,14 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! diagnose thickness/volumes of grid cells (meter) if (CS%id_thkcello>0 .or. CS%id_volcello>0) then if (GV%Boussinesq) then ! thkcello = h for Boussinesq - if (CS%id_thkcello > 0) call post_data(CS%id_thkcello, GV%H_to_m*h, CS%diag) + if (CS%id_thkcello > 0) then ; if (GV%H_to_m == 1.0) then + call post_data(CS%id_thkcello, h, CS%diag) + else + do k=1,nz; do j=js,je ; do i=is,ie + work_3d(i,j,k) = GV%H_to_m*h(i,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_thkcello, work_3d, CS%diag) + endif ; endif if (CS%id_volcello > 0) then ! volcello = h*area for Boussinesq do k=1,nz; do j=js,je ; do i=is,ie work_3d(i,j,k) = ( GV%H_to_m*h(i,j,k) ) * G%areaT(i,j) From ea65055688d81d3698c331fd6f619e510633e487 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 6 Sep 2018 10:51:45 -0400 Subject: [PATCH 0704/1072] Calculate non-Boussinesq e_tidal in depth units Change e_tidal from m to depth units in the non-Boussinesq pressure gradient force calculations. Also simplified MOM_PressureForce_Montgomery openMP directives. All answers are bitwise identical for no Z-rescaling or for rescaling by 2^93 or 2^-93. --- src/core/MOM_PressureForce_Montgomery.F90 | 69 ++++++++++------------ src/core/MOM_PressureForce_analytic_FV.F90 | 21 +++---- src/core/MOM_PressureForce_blocked_AFV.F90 | 21 +++---- 3 files changed, 52 insertions(+), 59 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 079bab6b19..09ce4721d9 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -96,11 +96,11 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, ! enable the use of a reduced gravity form of the equations, ! in m2 s-2. dp_star, & ! Layer thickness after compensation for compressibility, in Pa. + SSH, & ! The sea surface height anomaly, in depth units (Z). e_tidal, & ! Bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in m. - geopot_bot, & ! Bottom geopotential relative to time-mean sea level, + ! astronomical sources and self-attraction and loading, in Z. + geopot_bot ! Bottom geopotential relative to time-mean sea level, ! including any tidal contributions, in units of m2 s-2. - SSH ! Sea surface height anomalies, in m. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, in Pa (usually 2e7 Pa = 2000 dbar). real :: rho_in_situ(SZI_(G)) !In-situ density of a layer, in kg m-3. @@ -116,7 +116,8 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, ! barotropic and baroclinic pieces. type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. - real :: I_gEarth + real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2. + real :: I_gEarth ! The inverse of g_Earth_z, in s2 Z m-2 real :: dalpha real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). real :: alpha_Lay(SZK_(G)) ! The specific volume of each layer, in kg m-3. @@ -141,7 +142,8 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, "can no longer be used with a compressible EOS. Use #define ANALYTIC_FV_PGF.") endif - I_gEarth = 1.0 / GV%g_Earth + g_Earth_z = GV%g_Earth*GV%Z_to_m + I_gEarth = 1.0 / g_Earth_z dp_neglect = GV%H_to_Pa * GV%H_subroundoff do k=1,nz ; alpha_Lay(k) = 1.0 / GV%Rlay(k) ; enddo do k=2,nz ; dalpha_int(K) = alpha_Lay(k-1) - alpha_Lay(k) ; enddo @@ -178,7 +180,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, ! of self-attraction and loading. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - SSH(i,j) = -GV%Z_to_m*G%bathyT(i,j) + SSH(i,j) = -G%bathyT(i,j) enddo ; enddo if (use_EOS) then !$OMP parallel do default(shared) @@ -193,19 +195,19 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=1,nz ; do i=Isq,Ieq+1 - SSH(i,j) = SSH(i,j) + GV%H_to_kg_m2*h(i,j,k)*alpha_Lay(k) + SSH(i,j) = SSH(i,j) + (GV%m_to_Z*GV%H_to_kg_m2)*h(i,j,k)*alpha_Lay(k) enddo ; enddo ; enddo endif - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=1.0) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - geopot_bot(i,j) = -GV%g_Earth*(e_tidal(i,j) + GV%Z_to_m*G%bathyT(i,j)) + geopot_bot(i,j) = -g_Earth_z*(e_tidal(i,j) + G%bathyT(i,j)) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - geopot_bot(i,j) = -GV%g_Earth*GV%Z_to_m*G%bathyT(i,j) + geopot_bot(i,j) = -g_Earth_z*G%bathyT(i,j) enddo ; enddo endif @@ -394,8 +396,8 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta ! attraction and loading, in depth units (Z). real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, in Pa (usually 2e7 Pa = 2000 dbar). - real :: I_Rho0 ! 1/Rho0. - real :: G_Rho0 ! G_Earth / Rho0 in m4 s-2 kg-1. + real :: I_Rho0 ! 1/Rho0, in m3 kg-1. + real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. real :: PFu_bc, PFv_bc ! The pressure gradient force due to along-layer ! compensated density gradients, in m s-2. real :: dr ! Temporary variables. @@ -430,7 +432,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta h_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/CS%Rho0 - G_Rho0 = GV%g_Earth/GV%Rho0 + G_Rho0 = GV%Z_to_m*GV%g_Earth/GV%Rho0 if (CS%tides) then ! Determine the surface height anomaly for calculating self attraction @@ -592,7 +594,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta if (CS%id_PFu_bc>0) call post_data(CS%id_PFu_bc, CS%PFu_bc, CS%diag) if (CS%id_PFv_bc>0) call post_data(CS%id_PFv_bc, CS%PFv_bc, CS%diag) - if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, GV%Z_to_m*e_tidal(:,:), CS%diag) + if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, e_tidal, CS%diag) end subroutine PressureForce_Mont_Bouss @@ -616,15 +618,14 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star !! compensated), times g/rho_0, in m2 Z-1 s-2. ! Local variables - real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer - ! thicknesses, in m-1. + real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer thicknesses, in H-1. real :: press(SZI_(G)) ! Interface pressure, in Pa. real :: T_int(SZI_(G)) ! Interface temperature in C. real :: S_int(SZI_(G)) ! Interface salinity in PSU. real :: dR_dT(SZI_(G)) ! Partial derivatives of density with temperature real :: dR_dS(SZI_(G)) ! and salinity in kg m-3 K-1 and kg m-3 PSU-1. real :: rho_in_situ(SZI_(G)) !In-situ density at the top of a layer. - real :: G_Rho0 ! g_Earth / Rho0 in m4 s-2 kg-1. + real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. real :: Rho0xG ! g_Earth * Rho0 in kg s-2 m-1 Z-1. logical :: use_EOS ! If true, density is calculated from T & S using ! an equation of state. @@ -635,15 +636,13 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke Rho0xG = Rho0*g_Earth*GV%Z_to_m - G_Rho0 = g_Earth/Rho0 + G_Rho0 = GV%Z_to_m*GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) z_neglect = GV%H_subroundoff*GV%H_to_Z if (use_EOS) then if (present(rho_star)) then -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,z_neglect,pbce,rho_star,& -!$OMP GFS_scale,GV) & -!$OMP private(Ihtot) + !$OMP parallel do default(shared) private(Ihtot) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 Ihtot(i) = GV%H_to_Z / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) @@ -655,18 +654,16 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star enddo ; enddo enddo ! end of j loop else -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,tv,z_neglect,G_Rho0,Rho0xG,& -!$OMP pbce,GFS_scale,GV) & -!$OMP private(Ihtot,press,rho_in_situ,T_int,S_int,dR_dT,dR_dS) + !$OMP parallel do default(shared) private(Ihtot,press,rho_in_situ,T_int,S_int,dR_dT,dR_dS) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - Ihtot(i) = GV%H_to_m / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) + Ihtot(i) = GV%H_to_Z / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) press(i) = -Rho0xG*e(i,j,1) enddo call calculate_density(tv%T(:,j,1), tv%S(:,j,1), press, rho_in_situ, & Isq, Ieq-Isq+2, tv%eqn_of_state) do i=Isq,Ieq+1 - pbce(i,j,1) = G_Rho0*(GFS_scale * rho_in_situ(i)) * GV%H_to_m + pbce(i,j,1) = G_Rho0*(GFS_scale * rho_in_situ(i)) * GV%H_to_Z enddo do k=2,nz do i=Isq,Ieq+1 @@ -686,7 +683,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star enddo ! end of j loop endif else ! not use_EOS -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,e,GV,z_neglect,pbce) private(Ihtot) + !$OMP parallel do default(share) private(Ihtot) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 Ihtot(i) = GV%H_to_m / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) @@ -749,8 +746,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star) if (use_EOS) then if (present(alpha_star)) then -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,C_htot,dP_dH,p,dp_neglect, & -!$OMP pbce,alpha_star) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 C_htot(i,j) = dP_dH / ((p(i,j,nz+1)-p(i,j,1)) + dp_neglect) @@ -762,9 +758,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star) enddo ; enddo enddo else -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,tv,p,C_htot, & -!$OMP dP_dH,dp_neglect,pbce) & -!$OMP private(T_int,S_int,dR_dT,dR_dS,rho_in_situ) + !$OMP parallel do default(shared) private(T_int,S_int,dR_dT,dR_dS,rho_in_situ) do j=Jsq,Jeq+1 call calculate_density(tv%T(:,j,nz), tv%S(:,j,nz), p(:,j,nz+1), & rho_in_situ, Isq, Ieq-Isq+2, tv%eqn_of_state) @@ -790,8 +784,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star) enddo endif else ! not use_EOS -!$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,C_htot,dP_dH,p,dp_neglect, & -!$OMP pbce,alpha_Lay,dalpha_int) + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 C_htot(i,j) = dP_dH / ((p(i,j,nz+1)-p(i,j,1)) + dp_neglect) @@ -806,16 +799,14 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star) if (GFS_scale < 1.0) then ! Adjust the Montgomery potential to make this a reduced gravity model. -!$OMP parallel default(none) shared(Isq,Ieq,Jsq,Jeq,dpbce,GFS_scale,pbce,nz) -!$OMP do + !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 dpbce(i,j) = (GFS_scale - 1.0) * pbce(i,j,1) enddo ; enddo -!$OMP do + !$OMP parallel do default(shared) do k=1,nz ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 pbce(i,j,k) = pbce(i,j,k) + dpbce(i,j) enddo ; enddo ; enddo -!$OMP end parallel endif end subroutine Set_pbce_nonBouss @@ -876,7 +867,7 @@ subroutine PressureForce_Mont_init(Time, G, GV, param_file, diag, CS, tides_CSp) if (CS%tides) then CS%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, & - Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter') + Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=GV%Z_to_m) endif CS%GFS_scale = 1.0 diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 99ffda6a88..470636126c 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -127,9 +127,9 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm ! the pressure anomaly at the top of the layer, in Pa m2 s-2. real, dimension(SZI_(G),SZJ_(G)) :: & dp, & ! The (positive) change in pressure across a layer, in Pa. - SSH, & ! The sea surface height anomaly, in m. + SSH, & ! The sea surface height anomaly, in depth units (Z). e_tidal, & ! The bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in m. + ! astronomical sources and self-attraction and loading, in Z. dM, & ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. za ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the @@ -152,6 +152,8 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm real :: dp_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in Pa. + real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2. + real :: I_gEarth ! The inverse of g_Earth_z, in s2 Z m-2 real :: alpha_anom ! The in-situ specific volume, averaged over a ! layer, less alpha_ref, in m3 kg-1. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -165,7 +167,6 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm real :: rho_in_situ(SZI_(G)) ! The in situ density, in kg m-3. real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). ! real :: oneatm = 101325.0 ! 1 atm in Pa (kg/ms2) - real :: I_gEarth real, parameter :: C1_6 = 1.0/6.0 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer :: i, j, k @@ -185,6 +186,8 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm dp_neglect = GV%H_to_Pa * GV%H_subroundoff alpha_ref = 1.0/CS%Rho0 + g_Earth_z = GV%g_Earth*GV%Z_to_m + I_gEarth = 1.0 / g_Earth_z if (use_p_atm) then !$OMP parallel do default(shared) @@ -202,8 +205,6 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm p(i,j,K) = p(i,j,K-1) + GV%H_to_Pa * h(i,j,k-1) enddo ; enddo ; enddo - I_gEarth = 1.0 / GV%g_Earth - if (use_EOS) then ! With a bulk mixed layer, replace the T & S of any layers that are ! lighter than the the buffer layer with the properties of the buffer @@ -302,7 +303,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*GV%Z_to_m*G%bathyT(i,j) + za(i,j) = alpha_ref*p(i,j,nz+1) - g_Earth_z*G%bathyT(i,j) enddo do k=nz,1,-1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) + dza(i,j,k) @@ -315,10 +316,10 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth enddo ; enddo - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=1.0) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - za(i,j) = za(i,j) - GV%g_Earth*e_tidal(i,j) + za(i,j) = za(i,j) - g_Earth_z * e_tidal(i,j) enddo ; enddo endif @@ -767,7 +768,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p endif endif - if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, GV%Z_to_m*e_tidal(:,:), CS%diag) + if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, e_tidal, CS%diag) end subroutine PressureForce_AFV_Bouss @@ -833,7 +834,7 @@ subroutine PressureForce_AFV_init(Time, G, GV, param_file, diag, CS, tides_CSp) if (CS%tides) then CS%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, & - Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter') + Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=GV%Z_to_m) endif CS%GFS_scale = 1.0 diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 7119426871..f8f2abd35b 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -123,9 +123,9 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc ! the pressure anomaly at the top of the layer, in Pa m2 s-2. real, dimension(SZI_(G),SZJ_(G)) :: & dp, & ! The (positive) change in pressure across a layer, in Pa. - SSH, & ! The sea surface height anomaly, in m. + SSH, & ! The sea surface height anomaly, in depth units (Z). e_tidal, & ! The bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in m. + ! astronomical sources and self-attraction and loading, in Z. dM, & ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. za ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the @@ -152,6 +152,8 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc real :: dp_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in Pa. + real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2. + real :: I_gEarth ! The inverse of g_Earth_z, in s2 Z m-2 real :: alpha_anom ! The in-situ specific volume, averaged over a ! layer, less alpha_ref, in m3 kg-1. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -164,7 +166,6 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc real :: rho_in_situ(SZI_(G)) ! The in situ density, in kg m-3. real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). ! real :: oneatm = 101325.0 ! 1 atm in Pa (kg/ms2) - real :: I_gEarth real, parameter :: C1_6 = 1.0/6.0 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer :: is_bk, ie_bk, js_bk, je_bk, Isq_bk, Ieq_bk, Jsq_bk, Jeq_bk @@ -183,6 +184,8 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc dp_neglect = GV%H_to_Pa * GV%H_subroundoff alpha_ref = 1.0/CS%Rho0 + g_Earth_z = GV%g_Earth*GV%Z_to_m + I_gEarth = 1.0 / g_Earth_z if (use_p_atm) then !$OMP parallel do default(shared) @@ -200,8 +203,6 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc p(i,j,K) = p(i,j,K-1) + GV%H_to_Pa * h(i,j,k-1) enddo ; enddo ; enddo - I_gEarth = 1.0 / GV%g_Earth - if (use_EOS) then ! With a bulk mixed layer, replace the T & S of any layers that are ! lighter than the the buffer layer with the properties of the buffer @@ -269,7 +270,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - za(i,j) = alpha_ref*p(i,j,nz+1) - GV%g_Earth*GV%Z_to_m*G%bathyT(i,j) + za(i,j) = alpha_ref*p(i,j,nz+1) - g_Earth_z*G%bathyT(i,j) enddo do k=nz,1,-1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) + dza(i,j,k) @@ -282,10 +283,10 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth enddo ; enddo - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=1.0) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - za(i,j) = za(i,j) - GV%g_Earth*e_tidal(i,j) + za(i,j) = za(i,j) - g_Earth_z * e_tidal(i,j) enddo ; enddo endif @@ -761,7 +762,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at endif endif - if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, GV%Z_to_m*e_tidal(:,:), CS%diag) + if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, e_tidal, CS%diag) end subroutine PressureForce_blk_AFV_Bouss @@ -827,7 +828,7 @@ subroutine PressureForce_blk_AFV_init(Time, G, GV, param_file, diag, CS, tides_C if (CS%tides) then CS%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, & - Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter') + Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=GV%Z_to_m) endif CS%GFS_scale = 1.0 From 32b5fe06160dbbc66e9d9828350872ea4a410d8b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 6 Sep 2018 12:00:02 -0400 Subject: [PATCH 0705/1072] +Put post_data_1d_k into the post_data overload Made post_data_1d_k into the routines that the interface post_data might call. All answers are bitwise identical, but there is effectively a new public interface. --- src/framework/MOM_diag_mediator.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index e1103f2a20..6fb42e9df0 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -64,7 +64,7 @@ module MOM_diag_mediator !> Make a diagnostic available for averaging or output. interface post_data - module procedure post_data_3d, post_data_2d, post_data_0d + module procedure post_data_3d, post_data_2d, post_data_1d_k, post_data_0d end interface post_data !> A group of 1D axes that comprise a 1D/2D/3D mesh From 49053c79bacaa811832052ff16f46aa92bba9f20 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 6 Sep 2018 12:00:51 -0400 Subject: [PATCH 0706/1072] Replace calls to post_data_1d_k with post_data Calls to post_data can now resolve to post_data_1d_k, so there is no reason to use the specific interface. All answers are bitwise identical. --- src/diagnostics/MOM_diag_to_Z.F90 | 4 +- src/diagnostics/MOM_diagnostics.F90 | 6 +-- .../vertical/MOM_diapyc_energy_req.F90 | 38 +++++++++---------- 3 files changed, 24 insertions(+), 24 deletions(-) diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index 2a4b1b1ec3..a4471e1318 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -8,7 +8,7 @@ module MOM_diag_to_Z use MOM_domains, only : pass_var use MOM_coms, only : reproducing_sum -use MOM_diag_mediator, only : post_data, post_data_1d_k, register_diag_field, safe_alloc_ptr +use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl, time_type, diag_axis_init use MOM_diag_mediator, only : axes_grp, define_axes_group use MOM_diag_mediator, only : ocean_register_diag @@ -479,7 +479,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) if (CS%id_tr(m) > 0) call post_data(CS%id_tr(m), CS%tr_z(m)%p, CS%diag) if (CS%id_tr_xyave(m) > 0) then layer_ave = global_z_mean(CS%tr_z(m)%p,G,CS,m) - call post_data_1d_k(CS%id_tr_xyave(m), layer_ave, CS%diag) + call post_data(CS%id_tr_xyave(m), layer_ave, CS%diag) endif enddo endif diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 99d19c657a..eb6f02daae 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -6,7 +6,7 @@ module MOM_diagnostics ! This file is part of MOM6. See LICENSE.md for the license. use MOM_coms, only : reproducing_sum -use MOM_diag_mediator, only : post_data, post_data_1d_k, get_diag_time_end +use MOM_diag_mediator, only : post_data, get_diag_time_end use MOM_diag_mediator, only : register_diag_field, register_scalar_field use MOM_diag_mediator, only : register_static_field, diag_register_area_ids use MOM_diag_mediator, only : diag_ctrl, time_type, safe_alloc_ptr @@ -441,13 +441,13 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! layer mean potential temperature if (CS%id_temp_layer_ave>0) then temp_layer_ave = global_layer_mean(tv%T, h, G, GV) - call post_data_1d_k(CS%id_temp_layer_ave, temp_layer_ave, CS%diag) + call post_data(CS%id_temp_layer_ave, temp_layer_ave, CS%diag) endif ! layer mean salinity if (CS%id_salt_layer_ave>0) then salt_layer_ave = global_layer_mean(tv%S, h, G, GV) - call post_data_1d_k(CS%id_salt_layer_ave, salt_layer_ave, CS%diag) + call post_data(CS%id_salt_layer_ave, salt_layer_ave, CS%diag) endif call calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index b3ddad75fd..acd0c9336c 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -5,7 +5,7 @@ module MOM_diapyc_energy_req !! \author By Robert Hallberg, May 2015 -use MOM_diag_mediator, only : diag_ctrl, Time_type, post_data_1d_k, register_diag_field +use MOM_diag_mediator, only : diag_ctrl, Time_type, post_data, register_diag_field use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type @@ -910,22 +910,22 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & K=nz if (do_print) then - if (CS%id_ERt>0) call post_data_1d_k(CS%id_ERt, PE_chg_k(:,1), CS%diag) - if (CS%id_ERb>0) call post_data_1d_k(CS%id_ERb, PE_chg_k(:,2), CS%diag) - if (CS%id_ERc>0) call post_data_1d_k(CS%id_ERc, PE_chg_k(:,3), CS%diag) - if (CS%id_ERh>0) call post_data_1d_k(CS%id_ERh, PE_chg_k(:,4), CS%diag) - if (CS%id_Kddt>0) call post_data_1d_k(CS%id_Kddt, GV%H_to_m*Kddt_h, CS%diag) - if (CS%id_Kd>0) call post_data_1d_k(CS%id_Kd, Kd, CS%diag) - if (CS%id_h>0) call post_data_1d_k(CS%id_h, GV%H_to_m*h_tr, CS%diag) - if (CS%id_zInt>0) call post_data_1d_k(CS%id_zInt, Z_int, CS%diag) - if (CS%id_CHCt>0) call post_data_1d_k(CS%id_CHCt, ColHt_cor_k(:,1), CS%diag) - if (CS%id_CHCb>0) call post_data_1d_k(CS%id_CHCb, ColHt_cor_k(:,2), CS%diag) - if (CS%id_CHCc>0) call post_data_1d_k(CS%id_CHCc, ColHt_cor_k(:,3), CS%diag) - if (CS%id_CHCh>0) call post_data_1d_k(CS%id_CHCh, ColHt_cor_k(:,4), CS%diag) - if (CS%id_T0>0) call post_data_1d_k(CS%id_T0, T0, CS%diag) - if (CS%id_Tf>0) call post_data_1d_k(CS%id_Tf, Tf, CS%diag) - if (CS%id_S0>0) call post_data_1d_k(CS%id_S0, S0, CS%diag) - if (CS%id_Sf>0) call post_data_1d_k(CS%id_Sf, Sf, CS%diag) + if (CS%id_ERt>0) call post_data(CS%id_ERt, PE_chg_k(:,1), CS%diag) + if (CS%id_ERb>0) call post_data(CS%id_ERb, PE_chg_k(:,2), CS%diag) + if (CS%id_ERc>0) call post_data(CS%id_ERc, PE_chg_k(:,3), CS%diag) + if (CS%id_ERh>0) call post_data(CS%id_ERh, PE_chg_k(:,4), CS%diag) + if (CS%id_Kddt>0) call post_data(CS%id_Kddt, GV%H_to_m*Kddt_h, CS%diag) + if (CS%id_Kd>0) call post_data(CS%id_Kd, Kd, CS%diag) + if (CS%id_h>0) call post_data(CS%id_h, GV%H_to_m*h_tr, CS%diag) + if (CS%id_zInt>0) call post_data(CS%id_zInt, Z_int, CS%diag) + if (CS%id_CHCt>0) call post_data(CS%id_CHCt, ColHt_cor_k(:,1), CS%diag) + if (CS%id_CHCb>0) call post_data(CS%id_CHCb, ColHt_cor_k(:,2), CS%diag) + if (CS%id_CHCc>0) call post_data(CS%id_CHCc, ColHt_cor_k(:,3), CS%diag) + if (CS%id_CHCh>0) call post_data(CS%id_CHCh, ColHt_cor_k(:,4), CS%diag) + if (CS%id_T0>0) call post_data(CS%id_T0, T0, CS%diag) + if (CS%id_Tf>0) call post_data(CS%id_Tf, Tf, CS%diag) + if (CS%id_S0>0) call post_data(CS%id_S0, S0, CS%diag) + if (CS%id_Sf>0) call post_data(CS%id_Sf, Sf, CS%diag) if (CS%id_N2_0>0) then N2(1) = 0.0 ; N2(nz+1) = 0.0 do K=2,nz @@ -935,7 +935,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (T0(k-1) - T0(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (S0(k-1) - S0(k)) ) enddo - call post_data_1d_k(CS%id_N2_0, N2, CS%diag) + call post_data(CS%id_N2_0, N2, CS%diag) endif if (CS%id_N2_f>0) then N2(1) = 0.0 ; N2(nz+1) = 0.0 @@ -946,7 +946,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (Tf(k-1) - Tf(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (Sf(k-1) - Sf(k)) ) enddo - call post_data_1d_k(CS%id_N2_f, N2, CS%diag) + call post_data(CS%id_N2_f, N2, CS%diag) endif endif From 4050617795ac1051b1a00d0662589f5d3e74b40e Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 7 Sep 2018 16:15:34 -0600 Subject: [PATCH 0707/1072] Add OBLD into MCT cap --- config_src/mct_driver/MOM_ocean_model.F90 | 8 +++++++- config_src/mct_driver/ocn_cap_methods.F90 | 1 + 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 1658002d38..3eac851778 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -140,7 +140,8 @@ module MOM_ocean_model 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) - area => NULL() !< cell area of the ocean surface, in m2. + 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. @@ -732,6 +733,7 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, Ocean_sfc%v_surf (isc:iec,jsc:jec), & Ocean_sfc%sea_lev(isc:iec,jsc:jec), & Ocean_sfc%area (isc:iec,jsc:jec), & + Ocean_sfc%OBLD (isc:iec,jsc:jec), & Ocean_sfc%melt_potential(isc:iec,jsc:jec), & Ocean_sfc%frazil (isc:iec,jsc:jec)) @@ -742,6 +744,7 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, Ocean_sfc%sea_lev = 0.0 ! time averaged thickness of top model grid cell (m) plus patm/rho0/grav Ocean_sfc%frazil = 0.0 ! time accumulated frazil (J/m^2) passed to ice model Ocean_sfc%melt_potential = 0.0 ! time accumulated melt potential (J/m^2) passed to ice model + Ocean_sfc%OBLD = 0.0 ! ocean boundary layer depth, in m Ocean_sfc%area = 0.0 Ocean_sfc%axes = diag%axesT1%handles !diag axes to be used by coupler tracer flux diagnostics @@ -812,6 +815,8 @@ subroutine convert_state_to_ocean_type(state, Ocean_sfc, G, patm, press_to_z) 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 (Ocean_sfc%stagger == AGRID) then @@ -1036,6 +1041,7 @@ 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%') diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 17894dc966..33dbc5b36a 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -176,6 +176,7 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) o2x(ind%o2x_So_s, n) = ocn_public%s_surf(ig,jg) * grid%mask2dT(i,j) o2x(ind%o2x_So_u, n) = ocn_public%u_surf(ig,jg) * grid%mask2dT(i,j) o2x(ind%o2x_So_v, n) = ocn_public%v_surf(ig,jg) * grid%mask2dT(i,j) + o2x(ind%o2x_So_bldepth, n) = ocn_public%OBLD(ig,jg) * grid%mask2dT(i,j) ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 if (ocn_public%frazil(ig,jg) > 0.0) then ! Frazil: change from J/m^2 to W/m^2 From c689b2a59747c02b810e1da5a0cf416d49f7a51f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 8 Sep 2018 06:37:16 -0400 Subject: [PATCH 0708/1072] +Added optional inner_halo argument to pass_var_2d Added a new optional argument to pass_var_2d of an inner halo region to exclude from halo updates. The use of this argument can correct a bug that sets G%geolonBu incorrectly on the tripolar fold. All answers are bitwise identical, although there is a new optional argument in a public interface. --- src/framework/MOM_domains.F90 | 73 ++++++++++++++++++++++++++++++----- 1 file changed, 64 insertions(+), 9 deletions(-) diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index a38facf79a..e24b411fd0 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -27,18 +27,18 @@ module MOM_domains use mpp_domains_mod, only : compute_block_extent => mpp_compute_block_extent use mpp_parameter_mod, only : AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM, CORNER use mpp_parameter_mod, only : To_East => WUPDATE, To_West => EUPDATE, Omit_Corners => EDGEUPDATE -use mpp_parameter_mod, only : To_North => SUPDATE, To_South => NUPDATE +use mpp_parameter_mod, only : To_North => SUPDATE, To_South => NUPDATE, CENTER use fms_io_mod, only : file_exist, parse_mask_table implicit none ; private public :: MOM_domains_init, MOM_infra_init, MOM_infra_end, get_domain_extent public :: MOM_define_domain, MOM_define_io_domain, clone_MOM_domain -public :: pass_var, pass_vector, broadcast, PE_here, root_PE, num_PEs -public :: pass_var_start, pass_var_complete, fill_symmetric_edges +public :: pass_var, pass_vector, PE_here, root_PE, num_PEs +public :: pass_var_start, pass_var_complete, fill_symmetric_edges, broadcast public :: pass_vector_start, pass_vector_complete public :: global_field_sum, sum_across_PEs, min_across_PEs, max_across_PEs -public :: AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM, CORNER +public :: AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM, CORNER, CENTER public :: To_East, To_West, To_North, To_South, To_All, Omit_Corners public :: create_group_pass, do_group_pass, group_pass_type public :: start_group_pass, complete_group_pass @@ -178,8 +178,7 @@ subroutine pass_var_3d(array, MOM_dom, sideflag, complete, position, halo, & end subroutine pass_var_3d !> pass_var_2d does a halo update for a two-dimensional array. -subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, & - clock) +subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, inner_halo, clock) real, dimension(:,:), intent(inout) :: array !< The array which is having its halos points !! exchanged. type(MOM_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain @@ -197,9 +196,18 @@ subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, & !! by default. integer, optional, intent(in) :: halo !< The size of the halo to update - the full halo !! by default. - integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be + integer, optional, intent(in) :: inner_halo !< The size of an inner halo to avoid updating, + !! or 0 to avoid updating symmetric memory + !! computational domain points. Setting this >=0 + !! also enforces that complete=.true. + integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be !! started then stopped to time this routine. + ! Local variables + real, allocatable, dimension(:,:) :: tmp + integer :: pos, i_halo, j_halo + integer :: isc, iec, jsc, jec, isd, ied, jsd, jed, IscB, IecB, JscB, JecB + integer :: inner, i, j, isfw, iefw, isfe, iefe, jsfs, jefs, jsfn, jefn integer :: dirflag logical :: block_til_complete @@ -207,8 +215,15 @@ subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, & dirflag = To_All ! 60 if (present(sideflag)) then ; if (sideflag > 0) dirflag = sideflag ; endif - block_til_complete = .true. - if (present(complete)) block_til_complete = complete + block_til_complete = .true. ; if (present(complete)) block_til_complete = complete + pos = CENTER ; if (present(position)) pos = position + + if (present(inner_halo)) then ; if (inner_halo >= 0) then + ! Store the original values. + allocate(tmp(size(array,1), size(array,2))) + tmp(:,:) = array(:,:) + block_til_complete = .true. + endif ; endif if (present(halo) .and. MOM_dom%thin_halo_updates) then call mpp_update_domains(array, MOM_dom%mpp_domain, flags=dirflag, & @@ -219,6 +234,46 @@ subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, & complete=block_til_complete, position=position) endif + if (present(inner_halo)) then ; if (inner_halo >= 0) then + call mpp_get_compute_domain(MOM_dom%mpp_domain, isc, iec, jsc, jec) + call mpp_get_data_domain(MOM_dom%mpp_domain, isd, ied, jsd, jed) + ! Convert to local indices for arrays starting at 1. + isc = isc - (isd-1) ; iec = iec - (isd-1) ; ied = ied - (isd-1) ; isd = 1 + jsc = jsc - (jsd-1) ; jec = jec - (jsd-1) ; jed = jed - (jsd-1) ; jsd = 1 + i_halo = min(inner_halo, isc-1) ; j_halo = min(inner_halo, jsc-1) ; + + ! Figure out the array index extents of the eastern, western, northern and southern regions to copy. + if (pos == CENTER) then + if (size(array,1) == ied) then + isfw = isc - i_halo ; iefw = isc ; isfe = iec ; iefe = iec + i_halo + else ; call MOM_error(FATAL, "pass_var_2d: wrong i-size for CENTER array.") ; endif + if (size(array,2) == jed) then + isfw = isc - i_halo ; iefw = isc ; isfe = iec ; iefe = iec + i_halo + else ; call MOM_error(FATAL, "pass_var_2d: wrong j-size for CENTER array.") ; endif + elseif (pos == CORNER) then + if (size(array,1) == ied) then + isfw = max(isc - (i_halo+1), 1) ; iefw = isc ; isfe = iec ; iefe = iec + i_halo + elseif (size(array,1) == ied+1) then + isfw = isc - i_halo ; iefw = isc+1 ; isfe = iec+1 ; iefe = min(iec + 1 + i_halo, ied+1) + else ; call MOM_error(FATAL, "pass_var_2d: wrong i-size for CORNER array.") ; endif + if (size(array,2) == jed) then + jsfs = max(jsc - (j_halo+1), 1) ; jefs = jsc ; jsfn = jec ; jefn = jec + j_halo + elseif (size(array,2) == jed+1) then + jsfs = jsc - j_halo ; jefs = jsc+1 ; jsfn = jec+1 ; jefn = min(jec + 1 + j_halo, jed+1) + else ; call MOM_error(FATAL, "pass_var_2d: wrong j-size for CORNER array.") ; endif + else + call MOM_error(FATAL, "pass_var_2d: Unrecognized position") + endif + + ! Copy back the stored inner halo points + do j=jsfs,jefn ; do i=isfw,iefw ; array(i,j) = tmp(i,j) ; enddo ; enddo + do j=jsfs,jefn ; do i=isfe,iefe ; array(i,j) = tmp(i,j) ; enddo ; enddo + do j=jsfs,jefs ; do i=isfw,iefe ; array(i,j) = tmp(i,j) ; enddo ; enddo + do j=jsfn,jefn ; do i=isfw,iefe ; array(i,j) = tmp(i,j) ; enddo ; enddo + + deallocate(tmp) + endif ; endif + if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif end subroutine pass_var_2d From 107dd90bcfaf7c3be6012b510ef9800a9e560b14 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 8 Sep 2018 06:42:25 -0400 Subject: [PATCH 0709/1072] (*)Use inner_halo to correct grid transcription Use the new inner_halo argument to pass_var for geolonBu in the grid transcription code, to avoid incorrectly setting the longitudes in points that were set properly without a halo update. This avoids creating new problems but does not by itself correct the problems with G%geolonBu along the tripolar fold when setting the grid from a mosaic file. All answers in the current MOM6 test cases are bitwise identical. --- src/core/MOM_transcribe_grid.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index eea4874f4e..62ac6e1ea4 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -143,7 +143,7 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG) call pass_vector(oG%geoLatCu, oG%geoLatCv, oG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_var(oG%areaBu, oG%Domain, position=CORNER) - call pass_var(oG%geoLonBu, oG%Domain, position=CORNER) + call pass_var(oG%geoLonBu, oG%Domain, position=CORNER, inner_halo=oG%isc-isd) call pass_var(oG%geoLatBu, oG%Domain, position=CORNER) call pass_vector(oG%dxBu, oG%dyBu, oG%Domain, To_All+Scalar_Pair, BGRID_NE) call pass_var(oG%CoriolisBu, oG%Domain, position=CORNER) @@ -287,7 +287,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG) call pass_vector(dG%geoLatCu, dG%geoLatCv, dG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_var(dG%areaBu, dG%Domain, position=CORNER) - call pass_var(dG%geoLonBu, dG%Domain, position=CORNER) + call pass_var(dG%geoLonBu, dG%Domain, position=CORNER, inner_halo=dG%isc-isd) call pass_var(dG%geoLatBu, dG%Domain, position=CORNER) call pass_vector(dG%dxBu, dG%dyBu, dG%Domain, To_All+Scalar_Pair, BGRID_NE) call pass_var(dG%CoriolisBu, dG%Domain, position=CORNER) From 0e96fbaede18bd97f4252dd40c6eeacf54d177c5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 8 Sep 2018 06:44:05 -0400 Subject: [PATCH 0710/1072] +(*)Added runtime parameter USE_TRIPOLAR_GEOLONB_BUG Added the new runtime parameter USE_TRIPOLAR_GEOLONB_BUG that will recreate a longstanding bug in setting the G%geoLonBu for points along the tripolar fold, or if false corrects this bug by use of the new inner_halo argument to pass_var. The default is truebut this should be the depricated branch; setting this to false can change answers in any cases using SIS2 with a tripolar grid. By default all answers are bitwise identical, but the MOM_parameter_doc.all and SIS_parameter_doc.all files change. --- src/initialization/MOM_grid_initialize.F90 | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 9f7c5dcc28..70039bcb98 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -183,6 +183,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) character(len=64) :: mdl = "MOM_grid_init set_grid_metrics_from_mosaic" integer :: err=0, ni, nj, global_indices(4) type(MOM_domain_type) :: SGdom ! Supergrid domain + logical :: lon_bug ! If true use an older buggy answer in the tripolar longitude. integer :: i, j, i2, j2 integer :: npei,npej integer, dimension(:), allocatable :: exni,exnj @@ -193,6 +194,10 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) call get_param(param_file, mdl, "GRID_FILE", grid_file, & "Name of the file from which to read horizontal grid data.", & fail_if_missing=.true.) + call get_param(param_file, mdl, "USE_TRIPOLAR_GEOLONB_BUG", lon_bug, & + "If true, use older code that incorrectly sets the longitude \n"//& + "in some points along the tripolar fold to be off by 360 degrees.", & + default=.true.) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) filename = trim(adjustl(inputdir)) // trim(adjustl(grid_file)) @@ -248,7 +253,11 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) tmpZ(:,:) = 999. call MOM_read_data(filename, 'x', tmpZ, SGdom, position=CORNER) - call pass_var(tmpZ, SGdom, position=CORNER) + if (lon_bug) then + call pass_var(tmpZ, SGdom, position=CORNER) + else + call pass_var(tmpZ, SGdom, position=CORNER, inner_halo=0) + endif call extrapolate_metric(tmpZ, 2*(G%jsc-G%jsd)+2, missing=999.) do j=G%jsd,G%jed ; do i=G%isd,G%ied ; i2 = 2*i ; j2 = 2*j G%geoLonT(i,j) = tmpZ(i2-1,j2-1) From b5ee33f4bc719bb3d5c4ca4d007f649fa6140c12 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 8 Sep 2018 06:44:36 -0400 Subject: [PATCH 0711/1072] +(*)Added runtime parameter GRID_ROTATION_ANGLE_BUGS Added a new runtime argument, GRID_ROTATION_ANGLE_BUGS, that triggers the use of older code to set the grid rotation angle if it is true, or if it is false triggers the use of code that does not give wrong answers when some of the longitudes of points differ by a large factor. The default is true, but this should be the depricated branch; setting this to false changes answers in any cases using SIS2 with a tripolar grid, and may change answers at the level of roundoff even without a tripolar fold. By default all answers are bitwise identical, but the {MOM,SIS}_parameter_doc.all files change. --- .../MOM_shared_initialization.F90 | 72 +++++++++++++++---- 1 file changed, 58 insertions(+), 14 deletions(-) diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index e818c33acd..46a3344a96 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -525,25 +525,69 @@ subroutine initialize_grid_rotation_angle(G, PF) !! to parse for model parameter values. real :: angle, lon_scale - integer :: i, j + real :: pi_720deg ! One quarter the conversion factor from degrees to radians. + real :: lonB(2,2) ! The longitude of a point, shifted to have about the same value. + character(len=40) :: mdl = "initialize_grid_rotation_angle" ! This subroutine's name. + logical :: use_bugs + integer :: i, j, m, n + + call get_param(PF, mdl, "GRID_ROTATION_ANGLE_BUGS", use_bugs, & + "If true, use an older algorithm to calculate the sine and \n"//& + "cosines needed rotate between grid-oriented directions and \n"//& + "true north and east. Differences arise at the tripolar fold.", & + default=.True.) + + if (use_bugs) then + do j=G%jsc,G%jec ; do i=G%isc,G%iec + lon_scale = cos((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J-1 ) + & + G%geoLatBu(I-1,J) + G%geoLatBu(I,J)) * atan(1.0)/180) + angle = atan2((G%geoLonBu(I-1,J) + G%geoLonBu(I,J) - & + G%geoLonBu(I-1,J-1) - G%geoLonBu(I,J-1))*lon_scale, & + G%geoLatBu(I-1,J) + G%geoLatBu(I,J) - & + G%geoLatBu(I-1,J-1) - G%geoLatBu(I,J-1) ) + G%sin_rot(i,j) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean + G%cos_rot(i,j) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) + enddo ; enddo - do j=G%jsc,G%jec ; do i=G%isc,G%iec - lon_scale = cos((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J-1 ) + & - G%geoLatBu(I-1,J) + G%geoLatBu(I,J)) * atan(1.0)/180) - angle = atan2((G%geoLonBu(I-1,J) + G%geoLonBu(I,J) - & - G%geoLonBu(I-1,J-1) - G%geoLonBu(I,J-1))*lon_scale, & - G%geoLatBu(I-1,J) + G%geoLatBu(I,J) - & - G%geoLatBu(I-1,J-1) - G%geoLatBu(I,J-1) ) - G%sin_rot(i,j) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean - G%cos_rot(i,j) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) - enddo ; enddo + ! This is not right at a tripolar or cubed-sphere fold. + call pass_var(G%cos_rot, G%Domain) + call pass_var(G%sin_rot, G%Domain) + else + pi_720deg = atan(1.0) / 180.0 + do j=G%jsc,G%jec ; do i=G%isc,G%iec + do n=1,2 ; do m=1,2 + lonB(m,n) = modulo_around_point(G%geoLonBu(I+m-2,J+n-2), G%geoLonT(i,j), 360.0) + enddo ; enddo + lon_scale = cos(pi_720deg*((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J)) + & + (G%geoLatBu(I,J-1) + G%geoLatBu(I-1,J)) ) ) + angle = atan2(lon_scale*((lonB(1,2) - lonB(2,1)) + (lonB(2,2) - lonB(1,1))), & + (G%geoLatBu(I-1,J) - G%geoLatBu(I,J-1)) + & + (G%geoLatBu(I,J) - G%geoLatBu(I-1,J-1)) ) + G%sin_rot(i,j) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean + G%cos_rot(i,j) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) + enddo ; enddo - ! ### THIS DOESN'T SEEM RIGHT AT A CUBED-SPHERE FOLD -RWH - call pass_var(G%cos_rot, G%Domain) - call pass_var(G%sin_rot, G%Domain) + call pass_vector(G%cos_rot, G%sin_rot, G%Domain, stagger=AGRID) + endif end subroutine initialize_grid_rotation_angle +! ----------------------------------------------------------------------------- +!> Return the modulo value of x in an interval [xc-(Lx/2) xc+(Lx/2)] +!! If Lx<=0, then it returns x without applying modulo arithmetic. +function modulo_around_point(x, xc, Lx) result(x_mod) + real, intent(in) :: x !< Value to which to apply modulo arithmetic + real, intent(in) :: xc !< Center of modulo range + real, intent(in) :: Lx !< Modulo range width + real :: x_mod !< x shifted by an integer multiple of Lx to be close to xc. + + if (Lx > 0.0) then + x_mod = modulo(x - (xc - 0.5*Lx), Lx) + (xc - 0.5*Lx) + else + x_mod = x + endif +end function modulo_around_point + ! ----------------------------------------------------------------------------- !> This subroutine sets the open face lengths at selected points to restrict !! passages to their observed widths based on a named set of sizes. From 813a92386bb64a1ece1192da6c558fcb04aa56a2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 8 Sep 2018 07:33:01 -0400 Subject: [PATCH 0712/1072] Removed trailing white space --- src/framework/MOM_domains.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index e24b411fd0..a43a392963 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -240,7 +240,7 @@ subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, inner ! Convert to local indices for arrays starting at 1. isc = isc - (isd-1) ; iec = iec - (isd-1) ; ied = ied - (isd-1) ; isd = 1 jsc = jsc - (jsd-1) ; jec = jec - (jsd-1) ; jed = jed - (jsd-1) ; jsd = 1 - i_halo = min(inner_halo, isc-1) ; j_halo = min(inner_halo, jsc-1) ; + i_halo = min(inner_halo, isc-1) ; j_halo = min(inner_halo, jsc-1) ! Figure out the array index extents of the eastern, western, northern and southern regions to copy. if (pos == CENTER) then From 68d859f0ccac29c787ae9cb430f968c64fe89f2b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 8 Sep 2018 07:33:39 -0400 Subject: [PATCH 0713/1072] Use G%len_lon to set longitude periodicity If the domain lengths in latitude and longitude stored in the grid type have been set to positive values, use these instead of 180.0 and 360.0 for the periodicity values when initializing the grid rotation angles and setting the open face lengths. All answers are bitwise identical in all existing test cases, but answers could conceivably change for tilted grids with axis location units other than degrees. --- .../MOM_shared_initialization.F90 | 20 ++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 46a3344a96..1a40cdadc8 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -525,6 +525,7 @@ subroutine initialize_grid_rotation_angle(G, PF) !! to parse for model parameter values. real :: angle, lon_scale + real :: len_lon ! The periodic range of longitudes, usually 360 degrees. real :: pi_720deg ! One quarter the conversion factor from degrees to radians. real :: lonB(2,2) ! The longitude of a point, shifted to have about the same value. character(len=40) :: mdl = "initialize_grid_rotation_angle" ! This subroutine's name. @@ -554,9 +555,10 @@ subroutine initialize_grid_rotation_angle(G, PF) call pass_var(G%sin_rot, G%Domain) else pi_720deg = atan(1.0) / 180.0 + len_lon = 360.0 ; if (G%len_lon > 0.0) len_lon = G%len_lon do j=G%jsc,G%jec ; do i=G%isc,G%iec do n=1,2 ; do m=1,2 - lonB(m,n) = modulo_around_point(G%geoLonBu(I+m-2,J+n-2), G%geoLonT(i,j), 360.0) + lonB(m,n) = modulo_around_point(G%geoLonBu(I+m-2,J+n-2), G%geoLonT(i,j), len_lon) enddo ; enddo lon_scale = cos(pi_720deg*((G%geoLatBu(I-1,J-1) + G%geoLatBu(I,J)) + & (G%geoLatBu(I,J-1) + G%geoLatBu(I-1,J)) ) ) @@ -806,6 +808,8 @@ subroutine reset_face_lengths_list(G, param_file) real, pointer, dimension(:) :: & u_width => NULL(), v_width => NULL() real :: lat, lon ! The latitude and longitude of a point. + real :: len_lon ! The periodic range of longitudes, usually 360 degrees. + real :: len_lat ! The range of latitudes, usually 180 degrees. real :: lon_p, lon_m ! The longitude of a point shifted by 360 degrees. logical :: check_360 ! If true, check for longitudes that are shifted by ! +/- 360 degrees from the specified range of values. @@ -852,6 +856,8 @@ subroutine reset_face_lengths_list(G, param_file) call read_face_length_list(iounit, filename, num_lines, lines) endif + len_lon = 360.0 ; if (G%len_lon > 0.0) len_lon = G%len_lon + len_lat = 180.0 ; if (G%len_lat > 0.0) len_lat = G%len_lat ! Broadcast the number of lines and allocate the required space. call broadcast(num_lines, root_PE()) u_pt = 0 ; v_pt = 0 @@ -893,11 +899,11 @@ subroutine reset_face_lengths_list(G, param_file) read(line(isu+8:),*) u_lon(1:2,u_pt), u_lat(1:2,u_pt), u_width(u_pt) if (is_root_PE()) then if (check_360) then - if ((abs(u_lon(1,u_pt)) > 360.0) .or. (abs(u_lon(2,u_pt)) > 360.0)) & + if ((abs(u_lon(1,u_pt)) > len_lon) .or. (abs(u_lon(2,u_pt)) > len_lon)) & call MOM_error(WARNING, "reset_face_lengths_list : Out-of-bounds "//& "u-longitude found when reading line "//trim(line)//" from file "//& trim(filename)) - if ((abs(u_lat(1,u_pt)) > 180.0) .or. (abs(u_lat(2,u_pt)) > 180.0)) & + if ((abs(u_lat(1,u_pt)) > len_lat) .or. (abs(u_lat(2,u_pt)) > len_lat)) & call MOM_error(WARNING, "reset_face_lengths_list : Out-of-bounds "//& "u-latitude found when reading line "//trim(line)//" from file "//& trim(filename)) @@ -920,11 +926,11 @@ subroutine reset_face_lengths_list(G, param_file) read(line(isv+8:),*) v_lon(1:2,v_pt), v_lat(1:2,v_pt), v_width(v_pt) if (is_root_PE()) then if (check_360) then - if ((abs(v_lon(1,v_pt)) > 360.0) .or. (abs(v_lon(2,v_pt)) > 360.0)) & + if ((abs(v_lon(1,v_pt)) > len_lon) .or. (abs(v_lon(2,v_pt)) > len_lon)) & call MOM_error(WARNING, "reset_face_lengths_list : Out-of-bounds "//& "v-longitude found when reading line "//trim(line)//" from file "//& trim(filename)) - if ((abs(v_lat(1,v_pt)) > 180.0) .or. (abs(v_lat(2,v_pt)) > 180.0)) & + if ((abs(v_lat(1,v_pt)) > len_lat) .or. (abs(v_lat(2,v_pt)) > len_lat)) & call MOM_error(WARNING, "reset_face_lengths_list : Out-of-bounds "//& "v-latitude found when reading line "//trim(line)//" from file "//& trim(filename)) @@ -950,7 +956,7 @@ subroutine reset_face_lengths_list(G, param_file) do j=jsd,jed ; do I=IsdB,IedB lat = G%geoLatCu(I,j) ; lon = G%geoLonCu(I,j) - if (check_360) then ; lon_p = lon+360.0 ; lon_m = lon-360.0 + if (check_360) then ; lon_p = lon+len_lon ; lon_m = lon-len_lon else ; lon_p = lon ; lon_m = lon ; endif do npt=1,u_pt @@ -980,7 +986,7 @@ subroutine reset_face_lengths_list(G, param_file) do J=JsdB,JedB ; do i=isd,ied lat = G%geoLatCv(i,J) ; lon = G%geoLonCv(i,J) - if (check_360) then ; lon_p = lon+360.0 ; lon_m = lon-360.0 + if (check_360) then ; lon_p = lon+len_lon ; lon_m = lon-len_lon else ; lon_p = lon ; lon_m = lon ; endif do npt=1,v_pt From cc306eb606c216c7a5561726e8dcdbb14b26c276 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 8 Sep 2018 10:50:38 -0400 Subject: [PATCH 0714/1072] Cast initial_thickness_from_file into depth units Changed the calculations using interface heights from m to depth units in initial_thickness_from_file and adjustEtaToFitBathymetry. Also temporarily introduced two separate interface height variables in m and Z inside of MOM_temp_salt_initialize_from_Z. All answers are bitwise identical for no Z-rescaling or for rescaling by 2^93 or 2^-93. --- .../MOM_state_initialization.F90 | 56 ++++++++++--------- 1 file changed, 30 insertions(+), 26 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 4aa8e55e93..0fca4301d3 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -649,23 +649,22 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne "would indicate.", default=.false., do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. - call MOM_read_data(filename, "eta", eta(:,:,:), G%Domain) - ! if (GV%m_to_Z /= 1.0) eta(:,:,:) = GV%m_to_Z*eta(:,:,:) + call MOM_read_data(filename, "eta", eta(:,:,:), G%Domain, scale=GV%m_to_Z) if (correct_thickness) then call adjustEtaToFitBathymetry(G, GV, eta, h) else do k=nz,1,-1 ; do j=js,je ; do i=is,ie - if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_m)) then - eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_m + if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) then + eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (eta(i,j,K) - eta(i,j,K+1)) + h(i,j,k) = GV%Z_to_H * (eta(i,j,K) - eta(i,j,K+1)) endif enddo ; enddo ; enddo do j=js,je ; do i=is,ie - if (abs(eta(i,j,nz+1) + G%Zd_to_m*G%bathyT(i,j)) > 1.0) & + if (abs(eta(i,j,nz+1) + G%bathyT(i,j)) > 1.0*GV%m_to_Z) & inconsistent = inconsistent + 1 enddo ; enddo call sum_across_PEs(inconsistent) @@ -692,20 +691,21 @@ end subroutine initialize_thickness_from_file subroutine adjustEtaToFitBathymetry(G, GV, eta, h) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: eta !< Interface heights, in m + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: eta !< Interface heights, in Z real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H ! Local variables integer :: i, j, k, is, ie, js, je, nz, contractions, dilations - real, parameter :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria (m) + real :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria (m) real :: hTmp, eTmp, dilate character(len=100) :: mesg is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + hTolerance = 0.1*GV%m_to_Z contractions = 0 do j=js,je ; do i=is,ie - if (-eta(i,j,nz+1) > G%Zd_to_m*G%bathyT(i,j) + hTolerance) then - eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) + if (-eta(i,j,nz+1) > G%bathyT(i,j) + hTolerance) then + eta(i,j,nz+1) = -G%bathyT(i,j) contractions = contractions + 1 endif enddo ; enddo @@ -716,14 +716,14 @@ subroutine adjustEtaToFitBathymetry(G, GV, eta, h) call MOM_error(WARNING, 'adjustEtaToFitBathymetry: '//mesg) endif - ! To preserve previous answers, delay converting thicknesses to units of H - ! until the end of this routine. + ! To preserve previous answers in non-Boussinesq cases, delay converting + ! thicknesses to units of H until the end of this routine. do k=nz,1,-1 ; do j=js,je ; do i=is,ie ! Collapse layers to thinnest possible if the thickness less than ! the thinnest possible (or negative). - if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_m)) then - eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_m - h(i,j,k) = GV%Angstrom_m + if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) then + eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_Z + h(i,j,k) = GV%Angstrom_Z else h(i,j,k) = (eta(i,j,K) - eta(i,j,K+1)) endif @@ -734,12 +734,12 @@ subroutine adjustEtaToFitBathymetry(G, GV, eta, h) ! The whole column is dilated to accommodate deeper topography than ! the bathymetry would indicate. ! This should be... if ((G%mask2dt(i,j)*(eta(i,j,1)-eta(i,j,nz+1)) > 0.0) .and. & - if (-eta(i,j,nz+1) < G%Zd_to_m*G%bathyT(i,j) - hTolerance) then + if (-eta(i,j,nz+1) < G%bathyT(i,j) - hTolerance) then dilations = dilations + 1 if (eta(i,j,1) <= eta(i,j,nz+1)) then - do k=1,nz ; h(i,j,k) = (eta(i,j,1) + G%Zd_to_m*G%bathyT(i,j)) / real(nz) ; enddo + do k=1,nz ; h(i,j,k) = (eta(i,j,1) + G%bathyT(i,j)) / real(nz) ; enddo else - dilate = (eta(i,j,1) + G%Zd_to_m*G%bathyT(i,j)) / (eta(i,j,1) - eta(i,j,nz+1)) + dilate = (eta(i,j,1) + G%bathyT(i,j)) / (eta(i,j,1) - eta(i,j,nz+1)) do k=1,nz ; h(i,j,k) = h(i,j,k) * dilate ; enddo endif do k=nz,2,-1 ; eta(i,j,K) = eta(i,j,K+1) + h(i,j,k) ; enddo @@ -748,7 +748,7 @@ subroutine adjustEtaToFitBathymetry(G, GV, eta, h) ! Now convert thicknesses to units of H. do k=1,nz ; do j=js,je ; do i=is,ie - h(i,j,k) = h(i,j,k)*GV%m_to_H + h(i,j,k) = h(i,j,k)*GV%Z_to_H enddo ; enddo ; enddo call sum_across_PEs(dilations) @@ -1936,7 +1936,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) real, dimension(:), allocatable :: z_edges_in, z_in, Rb real, dimension(:,:,:), allocatable, target :: temp_z, salt_z, mask_z real, dimension(:,:,:), allocatable :: rho_z - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi ! Interface heights in m. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi ! Interface heights in Z. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi_m ! Interface heights in m. real, dimension(SZI_(G),SZJ_(G)) :: nlevs real, dimension(SZI_(G)) :: press @@ -2228,21 +2229,24 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) zi(is:ie,js:je,:) = find_interfaces(rho_z(is:ie,js:je,:), z_in, Rb, G%Zd_to_m*G%bathyT(is:ie,js:je), & nlevs(is:ie,js:je), nkml, nkbl, min_depth) + do K=1,nz+1 ; do j=js,je ; do i=is,ie + zi_m(i,j,K) = zi(i,j,K) ; zi(i,j,K) = GV%m_to_Z*zi(i,j,K) + enddo ; enddo ; enddo if (correct_thickness) then call adjustEtaToFitBathymetry(G, GV, zi, h) else do k=nz,1,-1 ; do j=js,je ; do i=is,ie - if (zi(i,j,K) < (zi(i,j,K+1) + GV%Angstrom_m)) then - zi(i,j,K) = zi(i,j,K+1) + GV%Angstrom_m + if (zi(i,j,K) < (zi(i,j,K+1) + GV%Angstrom_Z)) then + zi(i,j,K) = zi(i,j,K+1) + GV%Angstrom_Z h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%m_to_H * (zi(i,j,K) - zi(i,j,K+1)) + h(i,j,k) = GV%Z_to_H * (zi(i,j,K) - zi(i,j,K+1)) endif enddo ; enddo ; enddo inconsistent=0 do j=js,je ; do i=is,ie - if (abs(zi(i,j,nz+1) + G%Zd_to_m*G%bathyT(i,j)) > 1.0) & + if (abs(zi(i,j,nz+1) + G%bathyT(i,j)) > 1.0*GV%m_to_Z) & inconsistent = inconsistent + 1 enddo ; enddo call sum_across_PEs(inconsistent) @@ -2254,10 +2258,10 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) endif endif - tv%T(is:ie,js:je,:) = tracer_z_init(temp_z(is:ie,js:je,:),-1.0*z_edges_in,zi(is:ie,js:je,:), & + tv%T(is:ie,js:je,:) = tracer_z_init(temp_z(is:ie,js:je,:),-1.0*z_edges_in,zi_m(is:ie,js:je,:), & nkml,nkbl,missing_value,G%mask2dT(is:ie,js:je),nz, & nlevs(is:ie,js:je),dbg,idbg,jdbg) - tv%S(is:ie,js:je,:) = tracer_z_init(salt_z(is:ie,js:je,:),-1.0*z_edges_in,zi(is:ie,js:je,:), & + tv%S(is:ie,js:je,:) = tracer_z_init(salt_z(is:ie,js:je,:),-1.0*z_edges_in,zi_m(is:ie,js:je,:), & nkml,nkbl,missing_value,G%mask2dT(is:ie,js:je),nz, & nlevs(is:ie,js:je)) From ff9e1b865e62abaca8ffc7746dbbe643130e5b3c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 8 Sep 2018 12:34:17 -0400 Subject: [PATCH 0715/1072] +Added optional argument eps_z to tracer_z_init Added a new optional argument, eps_z, to tracer_z_init and find_interfaces, to permit the interface heights used to initialize the tracers to be in depth units instead of requiring that they always be in m. Also cleaned up the formatting in midas_vertmap to clarify comments and standardize the indents. All answers are bitwise identical. --- src/initialization/midas_vertmap.F90 | 427 +++++++++++++-------------- 1 file changed, 203 insertions(+), 224 deletions(-) diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index 0124c767b5..23bda0fce0 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -19,8 +19,8 @@ module MIDAS_vertmap module procedure fill_boundaries_int end interface -real, parameter :: epsln=1.e-10 !< A hard-wired constant! - !! \todo Get rid of this constant +! real, parameter :: epsln=1.e-10 !< A hard-wired constant! + !! \todo Get rid of this constant contains @@ -143,59 +143,58 @@ end function beta_wright_eos_2d #endif !> Layer model routine for remapping tracers -function tracer_z_init(tr_in,z_edges,e,nkml,nkbl,land_fill,wet,nlay,nlevs,debug,i_debug,j_debug) result(tr) - real, dimension(:,:,:), intent(in) :: tr_in !< The z-space array of tracer concentrations that is read in. - real, dimension(size(tr_in,3)+1), intent(in) :: z_edges !< The depths of the cell edges in the input z* data (m) - integer, intent(in) :: nlay !< The number of vertical layers in the target grid - real, dimension(size(tr_in,1),size(tr_in,2),nlay+1), intent(in) :: e !< The depths of the target layer interfaces (m) - integer, intent(in) :: nkml !< The number of mixed layers - integer, intent(in) :: nkbl !< The number of buffer layers - real, intent(in) :: land_fill !< fill in data over land (1) - real, dimension(size(tr_in,1),size(tr_in,2)), intent(in) :: wet !< The wet mask for the source data (valid points) +function tracer_z_init(tr_in, z_edges, e, nkml, nkbl, land_fill, wet, nlay, nlevs, & + debug, i_debug, j_debug, eps_z) result(tr) + real, dimension(:,:,:), intent(in) :: tr_in !< The z-space array of tracer concentrations that is read in. + real, dimension(size(tr_in,3)+1), intent(in) :: z_edges !< The depths of the cell edges in the input z* data (Z or m) + integer, intent(in) :: nlay !< The number of vertical layers in the target grid + real, dimension(size(tr_in,1),size(tr_in,2),nlay+1), & + intent(in) :: e !< The depths of the target layer interfaces (Z or m) + integer, intent(in) :: nkml !< The number of mixed layers + integer, intent(in) :: nkbl !< The number of buffer layers + real, intent(in) :: land_fill !< fill in data over land (1) + real, dimension(size(tr_in,1),size(tr_in,2)), & + intent(in) :: wet !< The wet mask for the source data (valid points) real, dimension(size(tr_in,1),size(tr_in,2)), & optional, intent(in) :: nlevs !< The number of input levels with valid data - logical, optional, intent(in) :: debug !< optional debug flag - integer, optional, intent(in) :: i_debug !< i-index of point for debugging - integer, optional, intent(in) :: j_debug !< j-index of point for debugging + logical, optional, intent(in) :: debug !< optional debug flag + integer, optional, intent(in) :: i_debug !< i-index of point for debugging + integer, optional, intent(in) :: j_debug !< j-index of point for debugging + real, optional, intent(in) :: eps_z !< A negligibly small layer thickness in the units of Z. real, dimension(size(tr_in,1),size(tr_in,2),nlay) :: tr !< tracers in layer space + ! Local variables real, dimension(size(tr_in,3)) :: tr_1d !< a copy of the input tracer concentrations in a column. - real, dimension(nlay+1) :: e_1d - real, dimension(nlay) :: tr_ + real, dimension(nlay+1) :: e_1d ! A 1-d column of intreface heights, in the same units as e. + real, dimension(nlay) :: tr_ ! A 1-d column of tracer concentrations integer, dimension(size(tr_in,1),size(tr_in,2)) :: nlevs_data !< number of valid levels in the input dataset integer :: n,i,j,k,l,nx,ny,nz,nt,kz integer :: k_top,k_bot,k_bot_prev,kk,kstart - real :: sl_tr + real :: sl_tr ! The tracer concentration slope times the layer thickess, in tracer units. + real :: epsln_Z ! A negligibly thin layer thickness, in Z. real, dimension(size(tr_in,3)) :: wt !< The fractional weight for each layer in the range between z1 and z2 - real, dimension(size(tr_in,3)) :: z1,z2 !< z1 and z2 are the depths of the top and bottom limits of the part - ! of a z-cell that contributes to a layer, relative to the cell - ! center and normalized by the cell thickness, nondim. - ! Note that -1/2 <= z1 <= z2 <= 1/2. + real, dimension(size(tr_in,3)) :: z1, z2 ! z1 and z2 are the fractional depths of the top and bottom + ! limits of the part of a z-cell that contributes to a layer, relative + ! to the cell center and normalized by the cell thickness, nondim. + ! Note that -1/2 <= z1 <= z2 <= 1/2. - logical :: debug_msg, debug_ + logical :: debug_msg, debug_, debug_pt nx = size(tr_in,1); ny=size(tr_in,2); nz = size(tr_in,3) nlevs_data = size(tr_in,3) - if (PRESENT(nlevs)) then - nlevs_data = anint(nlevs) - endif + if (PRESENT(nlevs)) nlevs_data = anint(nlevs) + epsln_Z = 1.0e-10 ; if (PRESENT(eps_z)) epsln_Z = eps_z - debug_=.false. - if (PRESENT(debug)) then - debug_=debug - endif - - debug_msg = .false. - if (debug_) then - debug_msg=.true. - endif + debug_=.false. ; if (PRESENT(debug)) debug_ = debug + debug_msg = debug_ + debug_pt = debug_ ; if (PRESENT(i_debug) .and. PRESENT(j_debug)) debug_pt = debug_ do j=1,ny i_loop: do i=1,nx if (nlevs_data(i,j) == 0 .or. wet(i,j) == 0.) then - tr(i,j,:) = land_fill - cycle i_loop + tr(i,j,:) = land_fill + cycle i_loop endif do k=1,nz @@ -208,106 +207,83 @@ function tracer_z_init(tr_in,z_edges,e,nkml,nkbl,land_fill,wet,nlay,nlevs,debug, k_bot = 1 ; k_bot_prev = -1 do k=1,nlay if (e_1d(k+1) > z_edges(1)) then - tr(i,j,k) = tr_1d(1) + tr(i,j,k) = tr_1d(1) elseif (e_1d(k) < z_edges(nlevs_data(i,j)+1)) then - if (debug_msg) then - print *,'*** WARNING : Found interface below valid range of z data ' - print *,'(i,j,z_bottom,interface)= ',& - i,j,z_edges(nlevs_data(i,j)+1),e_1d(k) - print *,'z_edges= ',z_edges - print *,'e=',e_1d - print *,'*** I will extrapolate below using the bottom-most valid values' - debug_msg = .false. - endif - tr(i,j,k) = tr_1d(nlevs_data(i,j)) + if (debug_msg) then + print *,'*** WARNING : Found interface below valid range of z data ' + print *,'(i,j,z_bottom,interface)= ',& + i,j,z_edges(nlevs_data(i,j)+1),e_1d(k) + print *,'z_edges= ',z_edges + print *,'e=',e_1d + print *,'*** I will extrapolate below using the bottom-most valid values' + debug_msg = .false. + endif + tr(i,j,k) = tr_1d(nlevs_data(i,j)) else - kstart=k_bot - call find_overlap(z_edges, e_1d(k), e_1d(k+1), nlevs_data(i,j), & - kstart, k_top, k_bot, wt, z1, z2) - - if (debug_) then - if (PRESENT(i_debug)) then - if (i == i_debug.and.j == j_debug) then - print *,'0001 k,k_top,k_bot,sum(wt),sum(z2-z1) = ',k,k_top,k_bot,sum(wt),sum(z2-z1) - endif - endif - endif - kz = k_top - sl_tr=0.0; ! cur_tr=0.0 - if (kz /= k_bot_prev) then - ! Calculate the intra-cell profile. - if ((kz < nlevs_data(i,j)) .and. (kz > 1)) then - sl_tr = find_limited_slope(tr_1d, z_edges, kz) - endif - endif - if (kz > nlevs_data(i,j)) kz = nlevs_data(i,j) - ! This is the piecewise linear form. - tr(i,j,k) = wt(kz) * & - (tr_1d(kz) + 0.5*sl_tr*(z2(kz) + z1(kz))) - ! For the piecewise parabolic form add the following... - ! + C1_3*cur_tr*(z2(kz)**2 + z2(kz)*z1(kz) + z1(kz)**2)) - ! if (debug_) then - ! print *,'k,k_top,k_bot= ',k,k_top,k_bot - ! endif - if (debug_) then - if (PRESENT(i_debug)) then - if (i == i_debug.and.j == j_debug) then - print *,'0002 k,k_top,k_bot,k_bot_prev,sl_tr = ',k,k_top,k_bot,k_bot_prev,sl_tr - endif - endif - endif - - do kz=k_top+1,k_bot-1 - tr(i,j,k) = tr(i,j,k) + wt(kz)*tr_1d(kz) - enddo + kstart=k_bot + call find_overlap(z_edges, e_1d(k), e_1d(k+1), nlevs_data(i,j), & + kstart, k_top, k_bot, wt, z1, z2) + + if (debug_pt) then ; if ((i == i_debug) .and. (j == j_debug)) then + print *,'0001 k,k_top,k_bot,sum(wt),sum(z2-z1) = ',k,k_top,k_bot,sum(wt),sum(z2-z1) + endif ; endif + kz = k_top + sl_tr=0.0; ! cur_tr=0.0 + if (kz /= k_bot_prev) then + ! Calculate the intra-cell profile. + if ((kz < nlevs_data(i,j)) .and. (kz > 1)) then + sl_tr = find_limited_slope(tr_1d, z_edges, kz) + endif + endif + if (kz > nlevs_data(i,j)) kz = nlevs_data(i,j) + ! This is the piecewise linear form. + tr(i,j,k) = wt(kz) * (tr_1d(kz) + 0.5*sl_tr*(z2(kz) + z1(kz))) + ! For the piecewise parabolic form add the following... + ! + C1_3*wt(kz) * cur_tr*(z2(kz)**2 + z2(kz)*z1(kz) + z1(kz)**2)) + if (debug_pt) then ; if ((i == i_debug) .and. (j == j_debug)) then + print *,'0002 k,k_top,k_bot,k_bot_prev,sl_tr = ',k,k_top,k_bot,k_bot_prev,sl_tr + endif ; endif + + do kz=k_top+1,k_bot-1 + tr(i,j,k) = tr(i,j,k) + wt(kz)*tr_1d(kz) + enddo + + if (debug_pt) then ; if ((i == i_debug) .and. (j == j_debug)) then + print *,'0003 k,tr = ',k,tr(i,j,k) + endif ; endif + + if (k_bot > k_top) then + kz = k_bot + ! Calculate the intra-cell profile. + sl_tr = 0.0 ! ; cur_tr = 0.0 + if ((kz < nlevs_data(i,j)) .and. (kz > 1)) then + sl_tr = find_limited_slope(tr_1d, z_edges, kz) + endif + ! This is the piecewise linear form. + tr(i,j,k) = tr(i,j,k) + wt(kz) * & + (tr_1d(kz) + 0.5*sl_tr*(z2(kz) + z1(kz))) + ! For the piecewise parabolic form add the following... + ! + C1_3*cur_tr*(z2(kz)**2 + z2(kz)*z1(kz) + z1(kz)**2)) + + if (debug_pt) then ; if ((i == i_debug) .and. (j == j_debug)) then + print *,'0004 k,kz,nlevs,sl_tr,tr = ',k,kz,nlevs_data(i,j),sl_tr,tr(i,j,k) + print *,'0005 k,kz,tr(kz),tr(kz-1),tr(kz+1) = ',k,kz,tr_1d(kz),tr_1d(kz-1),tr_1d(kz+1),z_edges(kz+2) + endif ; endif - if (debug_) then - if (PRESENT(i_debug)) then - if (i == i_debug.and.j == j_debug) then - print *,'0003 k,tr = ',k,tr(i,j,k) - endif - endif - endif - - if (k_bot > k_top) then - kz = k_bot - ! Calculate the intra-cell profile. - sl_tr = 0.0 ! ; cur_tr = 0.0 - if ((kz < nlevs_data(i,j)) .and. (kz > 1)) then - sl_tr = find_limited_slope(tr_1d, z_edges, kz) - ! if (debug_) then - ! print *,'002 sl_tr,k,kz,nlevs= ',sl_tr,k,kz,nlevs_data(i,j),nlevs(i,j) - ! endif - endif - ! This is the piecewise linear form. - tr(i,j,k) = tr(i,j,k) + wt(kz) * & - (tr_1d(kz) + 0.5*sl_tr*(z2(kz) + z1(kz))) - ! For the piecewise parabolic form add the following... - ! + C1_3*cur_tr*(z2(kz)**2 + z2(kz)*z1(kz) + z1(kz)**2)) - - if (debug_) then ; if (PRESENT(i_debug)) then - if (i == i_debug.and.j == j_debug) then - print *,'0004 k,kz,nlevs,sl_tr,tr = ',k,kz,nlevs_data(i,j),sl_tr,tr(i,j,k) - print *,'0005 k,kz,tr(kz),tr(kz-1),tr(kz+1) = ',k,kz,tr_1d(kz),tr_1d(kz-1),tr_1d(kz+1),z_edges(kz+2) - endif - endif ; endif - - endif - k_bot_prev = k_bot + endif + k_bot_prev = k_bot endif enddo ! k-loop do k=2,nlay ! simply fill vanished layers with adjacent value - if (e_1d(k)-e_1d(k+1) <= epsln) tr(i,j,k)=tr(i,j,k-1) + if (e_1d(k)-e_1d(k+1) <= epsln_Z) tr(i,j,k)=tr(i,j,k-1) enddo enddo i_loop enddo - return - end function tracer_z_init !> Return the index where to insert item x in list a, assuming a is sorted. @@ -483,16 +459,17 @@ end subroutine determine_temperature !! of each layer that overlaps that depth range. !! Note that by convention, e decreases with increasing k and Z_top > Z_bot. subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z2) - real, dimension(:), intent(in) :: e !< the interface positions, in m. - real, intent(in) :: Z_top !< The top of the range being mapped to, in m. - real, intent(in) :: Z_bot !< The bottom of the range being mapped to, in m. - integer, intent(in) :: k_max !< The number of valid layers. - integer, intent(in) :: k_start !< The layer at which to start searching. - integer, intent(out) :: k_top !< The index of the top layer that overlap with the depth range. - integer, intent(out) :: k_bot !< The index of the bottom layer that overlap with the depth range. - real, dimension(:), intent(out) :: wt !< The relative weights of each layer from k_top to k_bot. - real, dimension(:), intent(out) :: z1 !< Depth of the top limit of layer that contributes to a level - real, dimension(:), intent(out) :: z2 !< Depth of the bottom limit of layer that contributes to a level + real, dimension(:), intent(in) :: e !< The interface positions, in m or Z. + real, intent(in) :: Z_top !< The top of the range being mapped to, in m or Z. + real, intent(in) :: Z_bot !< The bottom of the range being mapped to, in m or Z. + integer, intent(in) :: k_max !< The number of valid layers. + integer, intent(in) :: k_start !< The layer at which to start searching. + integer, intent(out) :: k_top !< The index of the top layer that overlap with the depth range. + integer, intent(out) :: k_bot !< The index of the bottom layer that overlap with the depth range. + real, dimension(:), intent(out) :: wt !< The relative weights of each layer from k_top to k_bot, nondim. + real, dimension(:), intent(out) :: z1 !< Depth of the top limit of layer that contributes to a level, nondim. + real, dimension(:), intent(out) :: z2 !< Depth of the bottom limit of layer that contributes to a level, nondim. + ! Local variables real :: Ih, e_c, tot_wt, I_totwt integer :: k @@ -500,31 +477,36 @@ subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z wt(:)=0.0 ; z1(:)=0.0 ; z2(:)=0.0 k_top = k_start ; k_bot = k_start ; wt(1) = 1.0 ; z1(1) = -0.5 ; z2(1) = 0.5 - do k=k_start,k_max ; if (e(k+1) < Z_top) exit ; enddo + do k=k_start,k_max ; if (e(K+1) < Z_top) exit ; enddo k_top = k if (k>k_max) return ! Determine the fractional weights of each layer. ! Note that by convention, e and Z_int decrease with increasing k. - if (e(k+1) <= Z_bot) then + if (e(K+1) <= Z_bot) then wt(k) = 1.0 ; k_bot = k - Ih = 1.0 / (e(k)-e(k+1)) - e_c = 0.5*(e(k)+e(k+1)) - z1(k) = (e_c - MIN(e(k),Z_top)) * Ih + Ih = 0.0 ; if (e(K) /= e(K+1)) Ih = 1.0 / (e(K)-e(K+1)) + e_c = 0.5*(e(K)+e(K+1)) + z1(k) = (e_c - MIN(e(K), Z_top)) * Ih z2(k) = (e_c - Z_bot) * Ih else - wt(k) = MIN(e(k),Z_top) - e(k+1) ; tot_wt = wt(k) ! These are always > 0. - z1(k) = (0.5*(e(k)+e(k+1)) - MIN(e(k),Z_top)) / (e(k)-e(k+1)) + wt(k) = MIN(e(K),Z_top) - e(K+1) ; tot_wt = wt(k) ! These are always > 0. + ! Ih = 0.0 ; if (e(K) /= e(K+1)) Ih = 1.0 / (e(K)-e(K+1)) + if (e(K) /= e(K+1)) then + z1(k) = (0.5*(e(K)+e(K+1)) - MIN(e(K), Z_top)) / (e(K)-e(K+1)) + else ; z1(k) = -0.5 ; endif z2(k) = 0.5 k_bot = k_max do k=k_top+1,k_max - if (e(k+1) <= Z_bot) then + if (e(K+1) <= Z_bot) then k_bot = k - wt(k) = e(k) - Z_bot ; z1(k) = -0.5 - z2(k) = (0.5*(e(k)+e(k+1)) - Z_bot) / (e(k)-e(k+1)) + wt(k) = e(K) - Z_bot ; z1(k) = -0.5 + if (e(K) /= e(K+1)) then + z2(k) = (0.5*(e(K)+e(K+1)) - Z_bot) / (e(K)-e(K+1)) + else ; z2(k) = 0.5 ; endif else - wt(k) = e(k) - e(k+1) ; z1(k) = -0.5 ; z2(k) = 0.5 + wt(k) = e(K) - e(K+1) ; z1(k) = -0.5 ; z2(k) = 0.5 endif tot_wt = tot_wt + wt(k) ! wt(k) is always > 0. if (k>=k_bot) exit @@ -540,7 +522,7 @@ end subroutine find_overlap !! a piecewise limited scheme. function find_limited_slope(val, e, k) result(slope) real, dimension(:), intent(in) :: val !< An column the values that are being interpolated. - real, dimension(:), intent(in) :: e !< A column's interface heights, in m. + real, dimension(:), intent(in) :: e !< A column's interface heights, in Z or m. integer, intent(in) :: k !< The layer whose slope is being determined. real :: slope !< The normalized slope in the intracell distribution of val. ! Local variables @@ -550,41 +532,45 @@ function find_limited_slope(val, e, k) result(slope) if ((val(k)-val(k-1)) * (val(k)-val(k+1)) >= 0.0) then slope = 0.0 ! ; curvature = 0.0 else - d1 = 0.5*(e(k-1)-e(k+1)) ; d2 = 0.5*(e(k)-e(k+2)) - slope = ((d1**2)*(val(k+1) - val(k)) + (d2**2)*(val(k) - val(k-1))) * & - (e(k) - e(k+1)) / (d1*d2*(d1+d2)) - ! slope = 0.5*(val(k+1) - val(k-1)) - ! This is S.J. Lin's form of the PLM limiter. - amn = min(abs(slope), 2.0*(max(val(k-1), val(k), val(k+1)) - val(k))) - cmn = 2.0*(val(k) - min(val(k-1), val(k), val(k+1))) - slope = sign(1.0, slope) * min(amn, cmn) - - ! min(abs(slope), 2.0*(max(val(k-1),val(k),val(k+1)) - val(k)), & - ! 2.0*(val(k) - min(val(k-1),val(k),val(k+1)))) - ! curvature = 0.0 + d1 = 0.5*(e(K-1)-e(K+1)) ; d2 = 0.5*(e(K)-e(K+2)) + if (d1*d2 > 0.0) then + slope = ((d1**2)*(val(k+1) - val(k)) + (d2**2)*(val(k) - val(k-1))) * & + (e(K) - e(K+1)) / (d1*d2*(d1+d2)) + ! slope = 0.5*(val(k+1) - val(k-1)) + ! This is S.J. Lin's form of the PLM limiter. + amn = min(abs(slope), 2.0*(max(val(k-1), val(k), val(k+1)) - val(k))) + cmn = 2.0*(val(k) - min(val(k-1), val(k), val(k+1))) + slope = sign(1.0, slope) * min(amn, cmn) + + ! min(abs(slope), 2.0*(max(val(k-1),val(k),val(k+1)) - val(k)), & + ! 2.0*(val(k) - min(val(k-1),val(k),val(k+1)))) + ! curvature = 0.0 + else + slope = 0.0 ! ; curvature = 0.0 + endif endif - return - end function find_limited_slope !> Find interface positions corresponding to density profile -function find_interfaces(rho,zin,Rb,depth,nlevs,nkml,nkbl,hml,debug) result(zi) +function find_interfaces(rho, zin, Rb, depth, nlevs, nkml, nkbl, hml, debug, eps_z) result(zi) real, dimension(:,:,:), & - intent(in) :: rho !< potential density in z-space (kg m-3) + intent(in) :: rho !< potential density in z-space (kg m-3) real, dimension(size(rho,3)), & - intent(in) :: zin !< levels (m) - real, dimension(:), intent(in) :: Rb !< target interface densities (kg m-3) + intent(in) :: zin !< Input data levels, in Z (often m). + real, dimension(:), intent(in) :: Rb !< target interface densities (kg m-3) real, dimension(size(rho,1),size(rho,2)), & - intent(in) :: depth !< ocean depth (m) + intent(in) :: depth !< ocean depth in Z real, dimension(size(rho,1),size(rho,2)), & - optional, intent(in) ::nlevs !< number of valid points in each column + optional, intent(in) :: nlevs !< number of valid points in each column logical, optional, intent(in) :: debug !< optional debug flag - integer, optional, intent(in) :: nkml !< number of mixed layer pieces - integer, optional, intent(in) :: nkbl !< number of buffer layer pieces - real, optional, intent(in) :: hml !< mixed layer depth + integer, optional, intent(in) :: nkml !< number of mixed layer pieces + integer, optional, intent(in) :: nkbl !< number of buffer layer pieces + real, optional, intent(in) :: hml !< mixed layer depth, in Z + real, optional, intent(in) :: eps_z !< A negligibly small layer thickness in the units of Z. + real, dimension(size(rho,1),size(rho,2),size(Rb,1)) :: zi !< The returned interface, in the same units az zin. + ! Local variables - real, dimension(size(rho,1),size(rho,2),size(Rb,1)) :: zi real, dimension(size(rho,1),size(rho,3)) :: rho_ real, dimension(size(rho,1)) :: depth_ logical :: unstable @@ -592,11 +578,13 @@ function find_interfaces(rho,zin,Rb,depth,nlevs,nkml,nkbl,hml,debug) result(zi) integer, dimension(size(rho,1),size(Rb,1)) :: ki_ real, dimension(size(rho,1),size(Rb,1)) :: zi_ integer, dimension(size(rho,1),size(rho,2)) :: nlevs_data - integer, dimension(size(rho,1)) :: lo,hi + integer, dimension(size(rho,1)) :: lo, hi real :: slope,rsm,drhodz,hml_ integer :: n,i,j,k,l,nx,ny,nz,nt integer :: nlay,kk,nkml_,nkbl_ logical :: debug_ = .false. + real :: epsln_Z ! A negligibly thin layer thickness, in Z. + real :: epsln_rho ! A negligibly small density change, in kg m-3. real, parameter :: zoff=0.999 nlay=size(Rb)-1 @@ -608,95 +596,86 @@ function find_interfaces(rho,zin,Rb,depth,nlevs,nkml,nkbl,hml,debug) result(zi) nx = size(rho,1); ny=size(rho,2); nz = size(rho,3) nlevs_data(:,:) = size(rho,3) - nkml_=0;nkbl_=0;hml_=0.0 - if (PRESENT(nkml)) nkml_=max(0,nkml) - if (PRESENT(nkbl)) nkbl_=max(0,nkbl) - if (PRESENT(hml)) hml_=hml + nkml_ = 0 ; if (PRESENT(nkml)) nkml_ = max(0, nkml) + nkbl_ = 0 ; if (PRESENT(nkbl)) nkbl_ = max(0, nkbl) + hml_ = 0.0 ; if (PRESENT(hml)) hml_ = hml + epsln_Z = 1.0e-10 ; if (PRESENT(eps_z)) epsln_Z = eps_z + epsln_rho = 1.0e-10 if (PRESENT(nlevs)) then - nlevs_data(:,:) = nlevs(:,:) + nlevs_data(:,:) = nlevs(:,:) endif do j=1,ny rho_(:,:) = rho(:,j,:) i_loop: do i=1,nx if (debug_) then - print *,'looking for interfaces, i,j,nlevs= ',i,j,nlevs_data(i,j) - print *,'initial density profile= ', rho_(i,:) + print *,'looking for interfaces, i,j,nlevs= ',i,j,nlevs_data(i,j) + print *,'initial density profile= ', rho_(i,:) endif unstable=.true. dir=1 do while (unstable) unstable=.false. if (dir == 1) then - do k=2,nlevs_data(i,j)-1 - if (rho_(i,k) - rho_(i,k-1) < 0.0 ) then - if (k == 2) then - rho_(i,k-1)=rho_(i,k)-epsln - else - drhodz = (rho_(i,k+1)-rho_(i,k-1))/(zin(k+1)-zin(k-1)) - if (drhodz < 0.0) then - unstable=.true. - endif - rho_(i,k) = rho_(i,k-1)+drhodz*zoff*(zin(k)-zin(k-1)) - endif - endif - enddo - dir=-1*dir + do k=2,nlevs_data(i,j)-1 + if (rho_(i,k) - rho_(i,k-1) < 0.0 ) then + if (k == 2) then + rho_(i,k-1) = rho_(i,k)-epsln_rho + else + drhodz = (rho_(i,k+1)-rho_(i,k-1)) / (zin(k+1)-zin(k-1)) + if (drhodz < 0.0) unstable=.true. + rho_(i,k) = rho_(i,k-1) + drhodz*zoff*(zin(k)-zin(k-1)) + endif + endif + enddo + dir = -1*dir else - do k=nlevs_data(i,j)-1,2,-1 - if (rho_(i,k+1) - rho_(i,k) < 0.0) then - if (k == nlevs_data(i,j)-1) then - rho_(i,k+1)=rho_(i,k-1)+epsln - else - drhodz = (rho_(i,k+1)-rho_(i,k-1))/(zin(k+1)-zin(k-1)) - if (drhodz < 0.0) then - unstable=.true. - endif - rho_(i,k) = rho_(i,k+1)-drhodz*(zin(k+1)-zin(k)) - endif - endif - enddo - dir=-1*dir + do k=nlevs_data(i,j)-1,2,-1 + if (rho_(i,k+1) - rho_(i,k) < 0.0) then + if (k == nlevs_data(i,j)-1) then + rho_(i,k+1) = rho_(i,k-1)+epsln_rho + else + drhodz = (rho_(i,k+1)-rho_(i,k-1))/(zin(k+1)-zin(k-1)) + if (drhodz < 0.0) unstable=.true. + rho_(i,k) = rho_(i,k+1)-drhodz*(zin(k+1)-zin(k)) + endif + endif + enddo + dir = -1*dir endif enddo if (debug_) then - print *,'final density profile= ', rho_(i,:) + print *,'final density profile= ', rho_(i,:) endif enddo i_loop ki_(:,:) = 0 zi_(:,:) = 0.0 - depth_(:)=-1.0*depth(:,j) - lo(:)=1 - hi(:)=nlevs_data(:,j) - ki_ = bisect_fast(rho_,Rb,lo,hi) - ki_(:,:) = max(1,ki_(:,:)-1) + depth_(:) = -1.0*depth(:,j) + lo(:) = 1 + hi(:) = nlevs_data(:,j) + ki_ = bisect_fast(rho_, Rb, lo, hi) + ki_(:,:) = max(1, ki_(:,:)-1) do i=1,nx do l=2,nlay - slope = (zin(ki_(i,l)+1) - zin(ki_(i,l)))/max(rho_(i,ki_(i,l)+1) - rho_(i,ki_(i,l)),epsln) + slope = (zin(ki_(i,l)+1) - zin(ki_(i,l))) / max(rho_(i,ki_(i,l)+1) - rho_(i,ki_(i,l)),epsln_rho) zi_(i,l) = -1.0*(zin(ki_(i,l)) + slope*(Rb(l)-rho_(i,ki_(i,l)))) - zi_(i,l) = max(zi_(i,l),depth_(i)) - zi_(i,l) = min(zi_(i,l),-1.0*hml_) + zi_(i,l) = max(zi_(i,l), depth_(i)) + zi_(i,l) = min(zi_(i,l), -1.0*hml_) enddo - zi_(i,nlay+1)=depth_(i) + zi_(i,nlay+1) = depth_(i) do l=2,nkml_+1 - zi_(i,l)=max(((1.0-real(l))/real(nkml_))*hml_,depth_(i)) + zi_(i,l) = max(hml_*((1.0-real(l))/real(nkml_)), depth_(i)) enddo do l=nlay,nkml_+2,-1 - if (zi_(i,l) < zi_(i,l+1)+epsln) then - zi_(i,l)=zi_(i,l+1)+epsln - endif - if (zi_(i,l)>-1.0*hml_) then - zi_(i,l)=max(-1.0*hml_,depth_(i)) - endif + if (zi_(i,l) < zi_(i,l+1) + epsln_Z) zi_(i,l) = zi_(i,l+1) + epsln_Z + if (zi_(i,l) > -1.0*hml_) zi_(i,l) = max(-1.0*hml_, depth_(i)) enddo enddo - zi(:,j,:)=zi_(:,:) + zi(:,j,:) = zi_(:,:) enddo - return - end function find_interfaces !> Create a 2d-mesh of grid coordinates from 1-d arrays From 1625ffc04179c1d6d4eeeb18611c46e35328f39e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 9 Sep 2018 12:03:40 -0400 Subject: [PATCH 0716/1072] +MOM_temp_salt_initialize_from_Z now uses Z units Modified MOM_temp_salt_initialize_from_Z to work in depth (Z) units instead of m for heights. Also modified trim_for_ice and cut_off_column_top to work in Z units, including adding a verticalGrid_type argument to cut_off_column_top. All answers in the MOM6 test cases are bitwise identical. --- .../MOM_state_initialization.F90 | 105 +++++++++--------- 1 file changed, 55 insertions(+), 50 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 0fca4301d3..fa719aca4c 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1096,7 +1096,7 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) "file SURFACE_PRESSURE_FILE into a surface pressure.", & units="file dependent", default=1., do_not_log=just_read) call get_param(PF, mdl, "MIN_THICKNESS", min_thickness, 'Minimum layer thickness', & - units='m', default=1.e-3, do_not_log=just_read) + units='m', default=1.e-3, do_not_log=just_read, scale=GV%m_to_Z) call get_param(PF, mdl, "TRIMMING_USES_REMAPPING", use_remapping, & 'When trimming the column, also remap T and S.', & default=.false., do_not_log=just_read) @@ -1122,7 +1122,7 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) endif do j=G%jsc,G%jec ; do i=G%isc,G%iec - call cut_off_column_top(GV%ke, tv, GV%Rho0, GV%g_Earth, G%Zd_to_m*G%bathyT(i,j), & + call cut_off_column_top(GV%ke, tv, GV, GV%g_Earth*GV%Z_to_m, G%bathyT(i,j), & min_thickness, tv%T(i,j,:), T_t(i,j,:), T_b(i,j,:), & tv%S(i,j,:), S_t(i,j,:), S_b(i,j,:), p_surf(i,j), h(i,j,:), remap_CS) enddo ; enddo @@ -1131,14 +1131,14 @@ end subroutine trim_for_ice !> Adjust the layer thicknesses by cutting away the top at the depth where the hydrostatic !! pressure matches p_surf -subroutine cut_off_column_top(nk, tv, Rho0, G_earth, depth, min_thickness, & +subroutine cut_off_column_top(nk, tv, GV, G_earth, depth, min_thickness, & T, T_t, T_b, S, S_t, S_b, p_surf, h, remap_CS) integer, intent(in) :: nk !< Number of layers type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, intent(in) :: Rho0 !< Reference density (kg/m3) - real, intent(in) :: G_earth !< Gravitational acceleration (m/s2) - real, intent(in) :: depth !< Depth of ocean column (m) - real, intent(in) :: min_thickness !< Smallest thickness allowed (m) + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, intent(in) :: G_earth !< Gravitational acceleration (m2 Z-1 s-2) + real, intent(in) :: depth !< Depth of ocean column (Z) + real, intent(in) :: min_thickness !< Smallest thickness allowed (Z) real, dimension(nk), intent(inout) :: T !< Layer mean temperature real, dimension(nk), intent(in) :: T_t !< Temperature at top of layer real, dimension(nk), intent(in) :: T_b !< Temperature at bottom of layer @@ -1149,6 +1149,7 @@ subroutine cut_off_column_top(nk, tv, Rho0, G_earth, depth, min_thickness, & real, dimension(nk), intent(inout) :: h !< Layer thickness (H units, m or Pa) type(remapping_CS), pointer :: remap_CS !< Remapping structure for remapping T and S, !! if associated + ! Local variables real, dimension(nk+1) :: e ! Top and bottom edge values for reconstructions real, dimension(nk) :: h0, S0, T0, h1, S1, T1 @@ -1158,7 +1159,7 @@ subroutine cut_off_column_top(nk, tv, Rho0, G_earth, depth, min_thickness, & ! Calculate original interface positions e(nk+1) = -depth do k=nk,1,-1 - e(K) = e(K+1) + h(k) + e(K) = e(K+1) + GV%H_to_Z*h(k) h0(k) = h(nk+1-k) ! Keep a copy to use in remapping enddo @@ -1166,7 +1167,7 @@ subroutine cut_off_column_top(nk, tv, Rho0, G_earth, depth, min_thickness, & e_top = e(1) do k=1,nk call find_depth_of_pressure_in_cell(T_t(k), T_b(k), S_t(k), S_b(k), e(K), e(K+1), & - P_t, p_surf, Rho0, G_earth, tv%eqn_of_state, P_b, z_out) + P_t, p_surf, GV%Rho0, G_earth, tv%eqn_of_state, P_b, z_out) if (z_out>=e(K)) then ! Imposed pressure was less that pressure at top of cell exit @@ -1183,14 +1184,14 @@ subroutine cut_off_column_top(nk, tv, Rho0, G_earth, depth, min_thickness, & if (e_tope_top) then + if (e(K) > e_top) then ! Original e(K) is too high e(K) = e_top e_top = e_top - min_thickness ! Next interface must be at least this deep endif ! This layer needs trimming - h(k) = max( min_thickness, e(K) - e(K+1) ) - if (e(K) NULL() - real :: min_depth + real :: min_depth ! The minimum depth in Z. real :: dilate real :: missing_value_temp, missing_value_salt logical :: correct_thickness @@ -1937,19 +1939,18 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) real, dimension(:,:,:), allocatable, target :: temp_z, salt_z, mask_z real, dimension(:,:,:), allocatable :: rho_z real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi ! Interface heights in Z. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi_m ! Interface heights in m. real, dimension(SZI_(G),SZJ_(G)) :: nlevs - real, dimension(SZI_(G)) :: press + real, dimension(SZI_(G)) :: press ! Pressures in Pa. ! Local variables for ALE remapping - real, dimension(:), allocatable :: hTarget + real, dimension(:), allocatable :: hTarget ! Target thicknesses in Z. real, dimension(:,:), allocatable :: area_shelf_h real, dimension(:,:), allocatable, target :: frac_shelf_h real, dimension(:,:,:), allocatable, target :: tmpT1dIn, tmpS1dIn real, dimension(:,:,:), allocatable :: tmp_mask_in real, dimension(:,:,:), allocatable :: h1 ! Thicknesses in H. real, dimension(:,:,:), allocatable :: dz_interface ! Change in position of interface due to regridding - real :: zTopOfCell, zBottomOfCell + real :: zTopOfCell, zBottomOfCell ! Heights in Z units type(regridding_CS) :: regridCS ! Regridding parameters and work arrays type(remapping_CS) :: remapCS ! Remapping parameters and work arrays @@ -1985,7 +1986,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) reentrant_x = .false. ; call get_param(PF, mdl, "REENTRANT_X", reentrant_x,default=.true.) tripolar_n = .false. ; call get_param(PF, mdl, "TRIPOLAR_N", tripolar_n, default=.false.) - call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, default=0.0) + call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, default=0.0, scale=GV%m_to_Z) call get_param(PF, mdl, "NKML",nkml,default=0) call get_param(PF, mdl, "NKBL",nkbl,default=0) @@ -2059,6 +2060,9 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) return ! All run-time parameters have been read, so return. endif + !### Change this to GV%Angstrom_Z + eps_z = 1.0e-10*GV%m_to_Z + ! Read input grid coordinates for temperature and salinity field ! in z-coordinate dataset. The file is REQUIRED to contain the ! following: @@ -2082,6 +2086,10 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) kd = size(z_in,1) + ! Convert the units and sign convention of z_in and Z_edges_in. + do k=1,kd ; z_in(k) = GV%m_to_Z*z_in(k) ; enddo + do k=1,size(Z_edges_in,1) ; Z_edges_in(k) = -GV%m_to_Z*Z_edges_in(k) ; enddo + allocate(rho_z(isd:ied,jsd:jed,kd)) allocate(area_shelf_h(isd:ied,jsd:jed)) allocate(frac_shelf_h(isd:ied,jsd:jed)) @@ -2140,21 +2148,21 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) tmp_mask_in(i,j,1:kd) = mask_z(i,j,:) do k = 1, nkd if (tmp_mask_in(i,j,k)>0. .and. k<=kd) then - zBottomOfCell = max( -z_edges_in(k+1), -G%Zd_to_m*G%bathyT(i,j) ) + zBottomOfCell = max( z_edges_in(k+1), -G%bathyT(i,j) ) tmpT1dIn(i,j,k) = temp_z(i,j,k) tmpS1dIn(i,j,k) = salt_z(i,j,k) elseif (k>1) then - zBottomOfCell = -G%Zd_to_m*G%bathyT(i,j) + zBottomOfCell = -G%bathyT(i,j) tmpT1dIn(i,j,k) = tmpT1dIn(i,j,k-1) tmpS1dIn(i,j,k) = tmpS1dIn(i,j,k-1) else ! This next block should only ever be reached over land tmpT1dIn(i,j,k) = -99.9 tmpS1dIn(i,j,k) = -99.9 endif - h1(i,j,k) = GV%m_to_H * (zTopOfCell - zBottomOfCell) + h1(i,j,k) = GV%Z_to_H * (zTopOfCell - zBottomOfCell) zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo - h1(i,j,kd) = h1(i,j,kd) + GV%m_to_H * max(0., zTopOfCell + G%Zd_to_m*G%bathyT(i,j) ) + h1(i,j,kd) = h1(i,j,kd) + GV%Z_to_H * max(0., zTopOfCell + G%bathyT(i,j) ) ! The max here is in case the data data is shallower than model endif ! mask2dT enddo ; enddo @@ -2170,15 +2178,15 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) if (.not. remap_general) then ! This is the old way of initializing to z* coordinates only allocate( hTarget(nz) ) - hTarget = getCoordinateResolution( regridCS ) + hTarget = GV%m_to_Z * getCoordinateResolution( regridCS ) do j = js, je ; do i = is, ie h(i,j,:) = 0. if (G%mask2dT(i,j)>0.) then ! Build the target grid combining hTarget and topography zTopOfCell = 0. ; zBottomOfCell = 0. do k = 1, nz - zBottomOfCell = max( zTopOfCell - hTarget(k), -G%Zd_to_m*G%bathyT(i,j) ) - h(i,j,k) = GV%m_to_H * (zTopOfCell - zBottomOfCell) + zBottomOfCell = max( zTopOfCell - hTarget(k), -G%bathyT(i,j) ) + h(i,j,k) = GV%Z_to_H * (zTopOfCell - zBottomOfCell) zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo else @@ -2227,11 +2235,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) do k=2,nz ; Rb(k)=0.5*(GV%Rlay(k-1)+GV%Rlay(k)) ; enddo Rb(1) = 0.0 ; Rb(nz+1) = 2.0*GV%Rlay(nz) - GV%Rlay(nz-1) - zi(is:ie,js:je,:) = find_interfaces(rho_z(is:ie,js:je,:), z_in, Rb, G%Zd_to_m*G%bathyT(is:ie,js:je), & - nlevs(is:ie,js:je), nkml, nkbl, min_depth) - do K=1,nz+1 ; do j=js,je ; do i=is,ie - zi_m(i,j,K) = zi(i,j,K) ; zi(i,j,K) = GV%m_to_Z*zi(i,j,K) - enddo ; enddo ; enddo + zi(is:ie,js:je,:) = find_interfaces(rho_z(is:ie,js:je,:), z_in, Rb, G%bathyT(is:ie,js:je), & + nlevs(is:ie,js:je), nkml, nkbl, min_depth, eps_z=eps_z) if (correct_thickness) then call adjustEtaToFitBathymetry(G, GV, zi, h) @@ -2252,25 +2257,25 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) call sum_across_PEs(inconsistent) if ((inconsistent > 0) .and. (is_root_pe())) then - write(mesg,'("Thickness initial conditions are inconsistent ",'// & - '"with topography in ",I5," places.")') inconsistent + write(mesg, '("Thickness initial conditions are inconsistent ",'// & + '"with topography in ",I5," places.")') inconsistent call MOM_error(WARNING, mesg) endif endif - tv%T(is:ie,js:je,:) = tracer_z_init(temp_z(is:ie,js:je,:),-1.0*z_edges_in,zi_m(is:ie,js:je,:), & - nkml,nkbl,missing_value,G%mask2dT(is:ie,js:je),nz, & - nlevs(is:ie,js:je),dbg,idbg,jdbg) - tv%S(is:ie,js:je,:) = tracer_z_init(salt_z(is:ie,js:je,:),-1.0*z_edges_in,zi_m(is:ie,js:je,:), & - nkml,nkbl,missing_value,G%mask2dT(is:ie,js:je),nz, & - nlevs(is:ie,js:je)) + tv%T(is:ie,js:je,:) = tracer_z_init(temp_z(is:ie,js:je,:), z_edges_in, zi(is:ie,js:je,:), & + nkml, nkbl, missing_value, G%mask2dT(is:ie,js:je), nz, & + nlevs(is:ie,js:je),dbg,idbg,jdbg, eps_z=eps_z) + tv%S(is:ie,js:je,:) = tracer_z_init(salt_z(is:ie,js:je,:), z_edges_in, zi(is:ie,js:je,:), & + nkml, nkbl, missing_value, G%mask2dT(is:ie,js:je), nz, & + nlevs(is:ie,js:je), eps_z=eps_z) do k=1,nz nPoints = 0 ; tempAvg = 0. ; saltAvg = 0. do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) >= 1.0) then nPoints = nPoints + 1 tempAvg = tempAvg + tv%T(i,j,k) - saltAvg =saltAvg + tv%S(i,j,k) + saltAvg = saltAvg + tv%S(i,j,k) endif ; enddo ; enddo ! Horizontally homogenize data to produce perfectly "flat" initial conditions @@ -2279,8 +2284,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) call sum_across_PEs(tempAvg) call sum_across_PEs(saltAvg) if (nPoints>0) then - tempAvg = tempAvg/real(nPoints) - saltAvg = saltAvg/real(nPoints) + tempAvg = tempAvg / real(nPoints) + saltAvg = saltAvg / real(nPoints) endif tv%T(:,:,k) = tempAvg tv%S(:,:,k) = saltAvg @@ -2292,13 +2297,13 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) ! Fill land values do k=1,nz ; do j=js,je ; do i=is,ie if (tv%T(i,j,k) == missing_value) then - tv%T(i,j,k)=temp_land_fill - tv%S(i,j,k)=salt_land_fill + tv%T(i,j,k) = temp_land_fill + tv%S(i,j,k) = salt_land_fill endif enddo ; enddo ; enddo ! Finally adjust to target density - ks=max(0,nkml)+max(0,nkbl)+1 + ks = max(0,nkml)+max(0,nkbl)+1 if (adjust_temperature .and. .not. useALEremapping) then call determine_temperature(tv%T(is:ie,js:je,:), tv%S(is:ie,js:je,:), & @@ -2307,7 +2312,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) endif deallocate(z_in, z_edges_in, temp_z, salt_z, mask_z) - deallocate(rho_z) ; deallocate(area_shelf_h, frac_shelf_h) + deallocate(rho_z, area_shelf_h, frac_shelf_h) call pass_var(h, G%Domain) call pass_var(tv%T, G%Domain) @@ -2365,7 +2370,7 @@ subroutine MOM_state_init_tests(G, GV, tv) write(0,*) ' ==================================================================== ' write(0,*) '' write(0,*) h - call cut_off_column_top(nk, tv, GV%Rho0, GV%g_Earth, -e(nk+1), GV%Angstrom_H, & + call cut_off_column_top(nk, tv, GV, GV%g_Earth, -e(nk+1), GV%Angstrom_H, & T, T_t, T_b, S, S_t, S_b, 0.5*P_tot, h, remap_CS) write(0,*) h From d556d75d6ac03d9babb01837a5df3f9f8c32e0b8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 9 Sep 2018 21:48:59 -0400 Subject: [PATCH 0717/1072] dense_water_initialize_sponges now uses Z units Modified dense_water_initialize_sponges to work in depth (Z) units instead of m for heights. All answers in the MOM6 test cases are bitwise identical. --- src/user/dense_water_initialization.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index 260caf2f53..f1a7bd6492 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -232,9 +232,9 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then ! is this layer vanished? eta1D(k) = eta1D(k+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%Z_to_m * (eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo enddo @@ -253,7 +253,7 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A x = (G%geoLonT(i,j) - G%west_lon) / G%len_lon do k = 1,nz ! nondimensional middle of layer - zmid = zi + 0.5 * h(i,j,k) / (GV%Z_to_m * G%max_depth) + zmid = zi + 0.5 * h(i,j,k) / (GV%Z_to_H * G%max_depth) if (x > (1. - east_sponge_width)) then !if (zmid >= 0.9 * sill_height) & @@ -264,7 +264,7 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A S(i,j,k) = S_ref + S_range * (zmid - mld) / (1.0 - mld) endif - zi = zi + h(i,j,k) / (GV%Z_to_m * G%max_depth) + zi = zi + h(i,j,k) / (GV%Z_to_H * G%max_depth) enddo enddo enddo From d00ba7dbb55caafe96acd03b86f2317f8f2edbc6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 9 Sep 2018 21:49:37 -0400 Subject: [PATCH 0718/1072] +Modified bcz_param to read using depth units Modified bcz_param to read two parameters using depth units, including an additional verticalGrid_type parameter. All answers are bitwise identical. --- src/user/baroclinic_zone_initialization.F90 | 41 +++++++++++---------- 1 file changed, 21 insertions(+), 20 deletions(-) diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index 1a9f99b840..bdcd84aeee 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -21,21 +21,23 @@ module baroclinic_zone_initialization contains !> Reads the parameters unique to this module -subroutine bcz_params(G, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, & +subroutine bcz_params(G, GV, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, & delta_T, dTdx, L_zone, just_read_params) - type(ocean_grid_type), intent(in) :: G !< Grid structure - type(param_file_type), intent(in) :: param_file !< Parameter file handle - real, intent(out) :: S_ref !< Reference salinity (ppt) - real, intent(out) :: dSdz !< Salinity stratification (ppt/m) - real, intent(out) :: delta_S !< Salinity difference across baroclinic zone (ppt) - real, intent(out) :: dSdx !< Linear salinity gradient (ppt/m) - real, intent(out) :: T_ref !< Reference temperature (ppt) - real, intent(out) :: dTdz !< Temperature stratification (ppt/m) - real, intent(out) :: delta_T !< Temperature difference across baroclinic zone (ppt) - real, intent(out) :: dTdx !< Linear temperature gradient (ppt/m) - real, intent(out) :: L_zone !< Width of baroclinic zone (m) - logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + type(ocean_grid_type), intent(in) :: G !< Grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(param_file_type), intent(in) :: param_file !< Parameter file handle + real, intent(out) :: S_ref !< Reference salinity (ppt) + real, intent(out) :: dSdz !< Salinity stratification (ppt/Z) + real, intent(out) :: delta_S !< Salinity difference across baroclinic zone (ppt) + real, intent(out) :: dSdx !< Linear salinity gradient (ppt/m) + real, intent(out) :: T_ref !< Reference temperature (ppt) + real, intent(out) :: dTdz !< Temperature stratification (ppt/Z) + real, intent(out) :: delta_T !< Temperature difference across baroclinic zone (ppt) + real, intent(out) :: dTdx !< Linear temperature gradient (ppt/m) + real, intent(out) :: L_zone !< Width of baroclinic zone (m) + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. + logical :: just_read ! If true, just read parameters but set nothing. just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -45,16 +47,16 @@ subroutine bcz_params(G, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, & call openParameterBlock(param_file,'BCZIC') call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', units='ppt', & default=35., do_not_log=just_read) - call get_param(param_file, mdl,"DSDZ",dSdz,'Salinity stratification',units='ppt/m', & - default=0.0, do_not_log=just_read) + call get_param(param_file, mdl, "DSDZ", dSdz, 'Salinity stratification', & + units='ppt/m', default=0.0, scale=GV%Z_to_m, do_not_log=just_read) call get_param(param_file, mdl,"DELTA_S",delta_S,'Salinity difference across baroclinic zone', & units='ppt', default=0.0, do_not_log=just_read) call get_param(param_file, mdl,"DSDX",dSdx,'Meridional salinity difference', & units='ppt/'//trim(G%x_axis_units), default=0.0, do_not_log=just_read) call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature',units='C', & default=10., do_not_log=just_read) - call get_param(param_file, mdl,"DTDZ",dTdz,'Temperature stratification',units='C/m', & - default=0.0, do_not_log=just_read) + call get_param(param_file, mdl, "DTDZ", dTdz, 'Temperature stratification', & + units='C/m', default=0.0, scale=GV%Z_to_m, do_not_log=just_read) call get_param(param_file, mdl,"DELTA_T",delta_T,'Temperature difference across baroclinic zone', & units='C', default=0.0, do_not_log=just_read) call get_param(param_file, mdl,"DTDX",dTdx,'Meridional temperature difference', & @@ -89,8 +91,7 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, param_file, is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call bcz_params(G, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, delta_T, dTdx, L_zone, just_read_params) - dTdz = GV%Z_to_m*dTdz ; dSdz = GV%Z_to_m*dSdz + call bcz_params(G, GV, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, delta_T, dTdx, L_zone, just_read_params) if (just_read) return ! All run-time parameters have been read, so return. From 091ef9522d99323463c3f37e2906c462f4ea6c09 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 9 Sep 2018 21:50:14 -0400 Subject: [PATCH 0719/1072] Rossby_front_initialize_velocity now uses Z units Modified Rossby_front_initialize_velocity to work in depth (Z) units instead of m for heights. All answers in the MOM6 test cases are bitwise identical. --- src/user/Rossby_front_2d_initialization.F90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index 6c1410da3f..c619f3db64 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -177,9 +177,9 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, param_file, just_rea real :: T_range ! Range of salinities and temperatures over the vertical real :: dUdT ! Factor to convert dT/dy into dU/dz, g*alpha/f real :: dRho_dT - real :: Dml, zi, zc, zm ! Depths in units of m. + real :: Dml, zi, zc, zm ! Depths in units of Z. real :: f, Ty - real :: hAtU ! Interpolated layer thickness in units of m. + real :: hAtU ! Interpolated layer thickness in units of Z. integer :: i, j, k, is, ie, js, je, nz logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: verticalCoordinate @@ -202,12 +202,12 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, param_file, just_rea do j = G%jsc,G%jec ; do I = G%isc-1,G%iec+1 f = 0.5*( G%CoriolisBu(I,j) + G%CoriolisBu(I,j-1) ) dUdT = 0.0 ; if (abs(f) > 0.0) & - dUdT = ( GV%g_Earth * dRho_dT ) / ( f * GV%Rho0 ) - Dml = GV%Z_to_m*Hml( G, G%geoLatT(i,j) ) + dUdT = ( GV%Z_to_m*GV%g_Earth * dRho_dT ) / ( f * GV%Rho0 ) + Dml = Hml( G, G%geoLatT(i,j) ) Ty = dTdy( G, T_range, G%geoLatT(i,j) ) zi = 0. do k = 1, nz - hAtU = 0.5*(h(i,j,k)+h(i+1,j,k)) * GV%H_to_m + hAtU = 0.5*(h(i,j,k)+h(i+1,j,k)) * GV%H_to_Z zi = zi - hAtU ! Bottom interface position zc = zi - 0.5*hAtU ! Position of middle of cell zm = max( zc + Dml, 0. ) ! Height above bottom of mixed layer @@ -232,7 +232,8 @@ real function yPseudo( G, lat ) end function yPseudo -!> Analytic prescription of mixed layer depth in 2d Rossby front test +!> Analytic prescription of mixed layer depth in 2d Rossby front test, +!! in the same units as G%max_depth real function Hml( G, lat ) type(ocean_grid_type), intent(in) :: G !< Grid structure real, intent(in) :: lat !< Latitude From 17446618ce490ec3ca62b72d48062d21da8978d6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 9 Sep 2018 21:50:42 -0400 Subject: [PATCH 0720/1072] ISOMIP_intialize_sponges now uses Z units Modified ISOMIP_intialize_sponges to work in depth (Z) units instead of m for heights, correcting oversights in previous commits. All answers in the MOM6 test cases are bitwise identical. --- src/user/ISOMIP_initialization.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 969bb0664e..8940a9fcc3 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -294,7 +294,7 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, dS_dz = (s_sur - s_bot) / G%max_depth dT_dz = (t_sur - t_bot) / G%max_depth do j=js,je ; do i=is,ie - xi0 = -G%Zd_to_m * G%bathyT(i,j) + xi0 = -G%bathyT(i,j) do k = nz,1,-1 xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth in middle of layer S(i,j,k) = S_sur + dS_dz * xi0 @@ -497,14 +497,14 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) enddo ; enddo ! Compute min/max density using T_SUR/S_SUR and T_BOT/S_BOT - call calculate_density(t_sur,s_sur,0.0,rho_sur,tv%eqn_of_state) - !write (*,*)'Surface density in sponge:', rho_sur + call calculate_density(t_sur, s_sur, 0.0, rho_sur, tv%eqn_of_state) + !write (mesg,*) 'Surface density in sponge:', rho_sur ! call MOM_mesg(mesg,5) - call calculate_density(t_bot,s_bot,0.0,rho_bot,tv%eqn_of_state) - !write (*,*)'Bottom density in sponge:', rho_bot + call calculate_density(t_bot, s_bot, 0.0, rho_bot, tv%eqn_of_state) + !write (mesg,*) 'Bottom density in sponge:', rho_bot ! call MOM_mesg(mesg,5) rho_range = rho_bot - rho_sur - !write (*,*)'Density range in sponge:', rho_range + !write (mesg,*) 'Density range in sponge:', rho_range ! call MOM_mesg(mesg,5) if (use_ALE) then @@ -530,9 +530,9 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then eta1D(k) = eta1D(k+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_m + h(i,j,k) = GV%Angstrom_H else - h(i,j,k) = GV%Z_to_m*(eta1D(k) - eta1D(k+1)) + h(i,j,k) = GV%Z_to_H*(eta1D(k) - eta1D(k+1)) endif enddo enddo ; enddo From 245f66590df85c4452cf2d619872557dab738bc6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 9 Sep 2018 21:53:14 -0400 Subject: [PATCH 0721/1072] Corrected a recent bug in PressureForce_Mont_Bouss Corrected a double correction for Z in PressureForce_Mont_Bouss that was recently added with commit NOAA-GFDL/MOM6@5907c9e. All answers are bitwise identical when Z units are m. --- src/core/MOM_PressureForce_Montgomery.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 09ce4721d9..6d094349ae 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -507,7 +507,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta do k=1,nz+1 ; do j=Jsq,Jeq+1 call calculate_density(tv_tmp%T(:,j,k), tv_tmp%S(:,j,k), p_ref, rho_star(:,j,k), & Isq,Ieq-Isq+2,tv%eqn_of_state) - do i=Isq,Ieq+1 ; rho_star(i,j,k) = GV%Z_to_m*G_Rho0*rho_star(i,j,k) ; enddo + do i=Isq,Ieq+1 ; rho_star(i,j,k) = G_Rho0*rho_star(i,j,k) ; enddo enddo ; enddo endif ! use_EOS From 1554e0fea2ea86dada86b9dee85f94ec4e485761 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 9 Sep 2018 22:00:29 -0400 Subject: [PATCH 0722/1072] Improved robustness of find_overlap Modified find_overlap and find_limited_slope to avoid NaNs with vanishing layers. All answers are biwise identical in all existing test cases. --- src/diagnostics/MOM_diag_to_Z.F90 | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index a4471e1318..0e966e7ff6 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -678,20 +678,24 @@ subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z ! Note that by convention, e and Z_int decrease with increasing k. if (e(K+1)<=Z_bot) then wt(k) = 1.0 ; k_bot = k - Ih = 1.0 / (e(K)-e(K+1)) + Ih = 0.0 ; if (e(K) /= e(K+1)) Ih = 1.0 / (e(K)-e(K+1)) e_c = 0.5*(e(K)+e(K+1)) z1(k) = (e_c - MIN(e(K),Z_top)) * Ih z2(k) = (e_c - Z_bot) * Ih else wt(k) = MIN(e(K),Z_top) - e(K+1) ; tot_wt = wt(k) ! These are always > 0. - z1(k) = (0.5*(e(K)+e(K+1)) - MIN(e(K),Z_top)) / (e(K)-e(K+1)) + if (e(K) /= e(K+1)) then + z1(k) = (0.5*(e(K)+e(K+1)) - MIN(e(K), Z_top)) / (e(K)-e(K+1)) + else ; z1(k) = -0.5 ; endif z2(k) = 0.5 k_bot = k_max do k=k_top+1,k_max if (e(K+1)<=Z_bot) then k_bot = k wt(k) = e(K) - Z_bot ; z1(k) = -0.5 - z2(k) = (0.5*(e(K)+e(K+1)) - Z_bot) / (e(K)-e(K+1)) + if (e(K) /= e(K+1)) then + z2(k) = (0.5*(e(K)+e(K+1)) - Z_bot) / (e(K)-e(K+1)) + else ; z2(k) = 0.5 ; endif else wt(k) = e(K) - e(K+1) ; z1(k) = -0.5 ; z2(k) = 0.5 endif @@ -705,7 +709,7 @@ subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z end subroutine find_overlap -!> This subroutine determines a limited slope for val to be advected with +!> This subroutine determines a limited slope for val to be advected with !! a piecewise limited scheme. subroutine find_limited_slope(val, e, slope, k) real, dimension(:), intent(in) :: val !< A column of values that are being interpolated. @@ -715,10 +719,10 @@ subroutine find_limited_slope(val, e, slope, k) ! Local variables real :: d1, d2 - if ((val(k)-val(k-1)) * (val(k)-val(k+1)) >= 0.0) then + d1 = 0.5*(e(K-1)-e(K+1)) ; d2 = 0.5*(e(K)-e(K+2)) + if (((val(k)-val(k-1)) * (val(k)-val(k+1)) >= 0.0) .or. (d1*d2 <= 0.0)) then slope = 0.0 ! ; curvature = 0.0 else - d1 = 0.5*(e(K-1)-e(K+1)) ; d2 = 0.5*(e(K)-e(K+2)) slope = (d1**2*(val(k+1) - val(k)) + d2**2*(val(k) - val(k-1))) * & ((e(K) - e(K+1)) / (d1*d2*(d1+d2))) ! slope = 0.5*(val(k+1) - val(k-1)) From e54668abcf731832bce855765f8826d5f1652e42 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 9 Sep 2018 22:08:50 -0400 Subject: [PATCH 0723/1072] Changed tracer_Z_init to use depths in Z units Modified tracer_Z_init to be able to work with depths in units of Z, and added a scale argument to read_Z_edges to change input depths to units of Z. All answers are bitwise identical. --- src/tracer/MOM_tracer_Z_init.F90 | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index 88b1ba37ce..7450571500 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -47,7 +47,7 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val) tr_in ! The z-space array of tracer concentrations that is read in. real, allocatable, dimension(:) :: & z_edges, & ! The depths of the cell edges or cell centers (depending on - ! the value of has_edges) in the input z* data. + ! the value of has_edges) in the input z* data, in depth units (Z). tr_1d, & ! A copy of the input tracer concentrations in a column. wt, & ! The fractional weight for each layer in the range between ! k_top and k_bot, nondim. @@ -55,14 +55,14 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val) z2 ! of a z-cell that contributes to a layer, relative to the cell ! center and normalized by the cell thickness, nondim. ! Note that -1/2 <= z1 <= z2 <= 1/2. - real :: e(SZK_(G)+1) ! The z-star interface heights in m. + real :: e(SZK_(G)+1) ! The z-star interface heights in Z. real :: landval ! The tracer value to use in land points. real :: sl_tr ! The normalized slope of the tracer ! within the cell, in tracer units. real :: htot(SZI_(G)) ! The vertical sum of h, in m or kg m-2. real :: dilate ! The amount by which the thicknesses are dilated to ! create a z-star coordinate, nondim or in m3 kg-1. - real :: missing ! The missing value for the tracer. + real :: missing ! The missing value for the tracer. logical :: has_edges, use_missing, zero_surface character(len=80) :: loc_msg @@ -81,7 +81,8 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val) ! Find out the number of input levels and read the depth of the edges, ! also modifying their sign convention to be monotonically decreasing. - call read_Z_edges(filename, tr_name, z_edges, nz_in, has_edges, use_missing, missing) + call read_Z_edges(filename, tr_name, z_edges, nz_in, has_edges, use_missing, & + missing, scale=1.0/G%Zd_to_m) if (nz_in < 1) then tracer_Z_init = .false. return @@ -128,8 +129,8 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val) do i=is,ie ; if (G%mask2dT(i,j)*htot(i) > 0.0) then ! Determine the z* heights of the model interfaces. - dilate = (G%Zd_to_m*G%bathyT(i,j) - 0.0) / htot(i) - e(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + dilate = (G%bathyT(i,j) - 0.0) / htot(i) + e(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 ; e(K) = e(K+1) + dilate * h(i,j,k) ; enddo ! Create a single-column copy of tr_in. ### CHANGE THIS LATER? @@ -203,8 +204,8 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val) do i=is,ie ; if (G%mask2dT(i,j)*htot(i) > 0.0) then ! Determine the z* heights of the model interfaces. - dilate = (G%Zd_to_m*G%bathyT(i,j) - 0.0) / htot(i) - e(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + dilate = (G%bathyT(i,j) - 0.0) / htot(i) + e(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 ; e(K) = e(K+1) + dilate * h(i,j,k) ; enddo ! Create a single-column copy of tr_in. ### CHANGE THIS LATER? @@ -269,7 +270,7 @@ end function tracer_Z_init !> This subroutine reads the vertical coordinate data for a field from a NetCDF file. !! It also might read the missing value attribute for that same field. subroutine read_Z_edges(filename, tr_name, z_edges, nz_out, has_edges, & - use_missing, missing) + use_missing, missing, scale) character(len=*), intent(in) :: filename !< The name of the file to read from. character(len=*), intent(in) :: tr_name !< The name of the tracer in the file. real, dimension(:), allocatable, & @@ -280,6 +281,7 @@ subroutine read_Z_edges(filename, tr_name, z_edges, nz_out, has_edges, & logical, intent(inout) :: use_missing !< If false on input, see whether the tracer has a !! missing value, and if so return true real, intent(inout) :: missing !< The missing value, if one has been found + real, intent(in) :: scale !< A scaling factor for z_edges into new units. ! This subroutine reads the vertical coordinate data for a field from a ! NetCDF file. It also might read the missing value attribute for that same field. @@ -388,6 +390,8 @@ subroutine read_Z_edges(filename, tr_name, z_edges, nz_out, has_edges, & if (.not.monotonic) & call MOM_error(WARNING,mdl//" "//trim(dim_msg)//" is not monotonic.") + if (scale /= 1.0) then ; do k=1,nz_edge ; z_edges(k) = scale*z_edges(k) ; enddo ; endif + end subroutine read_Z_edges From 8e85151780a503496cd82e87627f9e2fae6e3940 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 9 Sep 2018 22:10:58 -0400 Subject: [PATCH 0724/1072] Modified dye_example to use Z units for depths Modified dye_example to work in depth (Z) units instead of m for depths and related parameters. All answers in the MOM6 test cases are bitwise identical. --- src/tracer/dye_example.F90 | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 489fba76fa..c9a8706e3c 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -41,8 +41,8 @@ module regional_dyes real, allocatable, dimension(:) :: dye_source_maxlon !< Maximum longitude of region dye will be injected. real, allocatable, dimension(:) :: dye_source_minlat !< Minimum latitude of region dye will be injected. real, allocatable, dimension(:) :: dye_source_maxlat !< Maximum latitude of region dye will be injected. - real, allocatable, dimension(:) :: dye_source_mindepth !< Minimum depth of region dye will be injected (m). - real, allocatable, dimension(:) :: dye_source_maxdepth !< Maximum depth of region dye will be injected (m). + real, allocatable, dimension(:) :: dye_source_mindepth !< Minimum depth of region dye will be injected, in Z. + real, allocatable, dimension(:) :: dye_source_maxdepth !< Maximum depth of region dye will be injected, in Z. type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3? @@ -135,18 +135,17 @@ function register_dye_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) CS%dye_source_mindepth(:) = -1.e30 call get_param(param_file, mdl, "DYE_SOURCE_MINDEPTH", CS%dye_source_mindepth, & "This is the minumum depth at which we inject dyes.", & - fail_if_missing=.true.) - if (minval(CS%dye_source_mindepth(:)) < -1.e29) & + units="m", scale=GV%m_to_Z, fail_if_missing=.true.) + if (minval(CS%dye_source_mindepth(:)) < -1.e29*GV%m_to_Z) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MINDEPTH") CS%dye_source_maxdepth(:) = -1.e30 call get_param(param_file, mdl, "DYE_SOURCE_MAXDEPTH", CS%dye_source_maxdepth, & "This is the maximum depth at which we inject dyes.", & - fail_if_missing=.true.) - if (minval(CS%dye_source_maxdepth(:)) < -1.e29) & + units="m", scale=GV%m_to_Z, fail_if_missing=.true.) + if (minval(CS%dye_source_maxdepth(:)) < -1.e29*GV%m_to_Z) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MAXDEPTH ") - allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr)) ; CS%tr(:,:,:,:) = 0.0 do m = 1, CS%ntr @@ -222,14 +221,14 @@ subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_C CS%dye_source_minlat(m)=G%geoLatT(i,j) .and. & G%mask2dT(i,j) > 0.0 ) then - z_bot = -G%Zd_to_m*G%bathyT(i,j) + z_bot = -G%bathyT(i,j) do k = GV%ke, 1, -1 - z_center = z_bot + 0.5*h(i,j,k)*GV%H_to_m + z_center = z_bot + 0.5*h(i,j,k)*GV%H_to_Z if ( z_center > -CS%dye_source_maxdepth(m) .and. & z_center < -CS%dye_source_mindepth(m) ) then CS%tr(i,j,k,m) = 1.0 endif - z_bot = z_bot + h(i,j,k)*GV%H_to_m + z_bot = z_bot + h(i,j,k)*GV%H_to_Z enddo endif enddo ; enddo @@ -305,14 +304,14 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS CS%dye_source_minlat(m)=G%geoLatT(i,j) .and. & G%mask2dT(i,j) > 0.0 ) then - z_bot = -G%Zd_to_m*G%bathyT(i,j) + z_bot = -G%bathyT(i,j) do k=nz,1,-1 - z_center = z_bot + 0.5*h_new(i,j,k)*GV%H_to_m + z_center = z_bot + 0.5*h_new(i,j,k)*GV%H_to_Z if ( z_center > -CS%dye_source_maxdepth(m) .and. & z_center < -CS%dye_source_mindepth(m) ) then CS%tr(i,j,k,m) = 1.0 endif - z_bot = z_bot + h_new(i,j,k)*GV%H_to_m + z_bot = z_bot + h_new(i,j,k)*GV%H_to_Z enddo endif enddo ; enddo From b43827ce6c23beaec070d430134241fca89df1b9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 9 Sep 2018 22:12:28 -0400 Subject: [PATCH 0725/1072] Modified DOME_tracer to use Z units for depths Modified DOME_tracer to work in depth (Z) units instead of m for depths and related parameters. All answers in the MOM6 test cases are bitwise identical. --- src/tracer/DOME_tracer.F90 | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 0a59eb1c92..89393c2c8c 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -169,8 +169,9 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, h, diag, OBC, CS, & real :: tr_y ! Initial zonally uniform tracer concentrations. real :: dist2 ! The distance squared from a line, in m2. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m. - real :: e(SZK_(G)+1), e_top, e_bot, d_tr + ! in roundoff and can be neglected, in H. + real :: e(SZK_(G)+1), e_top, e_bot ! Heights in Z. + real :: d_tr ! A change in tracer concentraions, in tracer units. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB @@ -213,21 +214,21 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, h, diag, OBC, CS, & if (NTR > 7) then do j=js,je ; do i=is,ie - e(nz+1) = -G%Zd_to_m*G%bathyT(i,j) + e(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 - e(K) = e(K+1) + h(i,j,k)*GV%H_to_m + e(K) = e(K+1) + h(i,j,k)*GV%H_to_Z do m=7,NTR - e_top = -600.0*real(m-1) + 3000.0 - e_bot = -600.0*real(m-1) + 2700.0 + e_top = (-600.0*real(m-1) + 3000.0) * GV%m_to_Z + e_bot = (-600.0*real(m-1) + 2700.0) * GV%m_to_Z if (e_top < e(K)) then if (e_top < e(K+1)) then ; d_tr = 0.0 elseif (e_bot < e(K+1)) then - d_tr = (e_top-e(K+1)) / ((h(i,j,k)+h_neglect)*GV%H_to_m) - else ; d_tr = (e_top-e_bot) / ((h(i,j,k)+h_neglect)*GV%H_to_m) + d_tr = 1.0 * (e_top-e(K+1)) / ((h(i,j,k)+h_neglect)*GV%H_to_Z) + else ; d_tr = 1.0 * (e_top-e_bot) / ((h(i,j,k)+h_neglect)*GV%H_to_Z) endif elseif (e_bot < e(K)) then if (e_bot < e(K+1)) then ; d_tr = 1.0 - else ; d_tr = (e(K)-e_bot) / ((h(i,j,k)+h_neglect)*GV%H_to_m) + else ; d_tr = 1.0 * (e(K)-e_bot) / ((h(i,j,k)+h_neglect)*GV%H_to_Z) endif else d_tr = 0.0 From 76a87b41d3626b27aef80e6c8082abd016862463 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 10 Sep 2018 19:32:27 -0400 Subject: [PATCH 0726/1072] +Added an optional halo argument to make_frazil Added an optional argument to make_frazil and adjust_salt that will cause them to work on an extended region beyond the computational domain. All answers are bitwise identical, but there are new optional arguments to publicly visible subroutines. --- src/parameterizations/vertical/MOM_diabatic_aux.F90 | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index f662eda365..5fa4125fcb 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -77,7 +77,7 @@ module MOM_diabatic_aux !! This subroutine warms any water that is colder than the (currently !! surface) freezing point up to the freezing point and accumulates !! the required heat (in J m-2) in tv%frazil. -subroutine make_frazil(h, tv, G, GV, CS, p_surf) +subroutine make_frazil(h, tv, G, GV, CS, p_surf, halo) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -88,6 +88,7 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf) !! call to diabatic_aux_init. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: p_surf !< The pressure at the ocean surface, in Pa. + integer, optional, intent(in) :: halo !< Halo width over which to calculate frazil ! Frazil formation keeps the temperature above the freezing point. ! This subroutine warms any water that is colder than the (currently @@ -113,7 +114,11 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf) logical :: T_fr_set ! True if the freezing point has been calculated for a ! row of points. integer :: i, j, k, is, ie, js, je, nz + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + if (present(halo)) then + is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo + endif call cpu_clock_begin(id_clock_frazil) @@ -309,7 +314,7 @@ end subroutine differential_diffuse_T_S !> This subroutine keeps salinity from falling below a small but positive threshold. !! This usually occurs when the ice model attempts to extract more salt then !! is actually available to it from the ocean. -subroutine adjust_salt(h, tv, G, GV, CS) +subroutine adjust_salt(h, tv, G, GV, CS, halo) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -318,6 +323,7 @@ subroutine adjust_salt(h, tv, G, GV, CS) !! available thermodynamic fields. type(diabatic_aux_CS), intent(in) :: CS !< The control structure returned by a previous !! call to diabatic_aux_init. + integer, optional, intent(in) :: halo !< Halo width over which to work ! local variables real :: salt_add_col(SZI_(G),SZJ_(G)) !< The accumulated salt requirement @@ -325,6 +331,9 @@ subroutine adjust_salt(h, tv, G, GV, CS) real :: mc !< A layer's mass kg m-2 . integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + if (present(halo)) then + is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo + endif ! call cpu_clock_begin(id_clock_adjust_salt) From fd6fb2e8bd8bf9409aef126f515372075c167524 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 10 Sep 2018 19:34:06 -0400 Subject: [PATCH 0727/1072] +Added an optional halo argument to geothermal Added an optional argument to geothermal that will cause it to work on an extended region beyond the computational domain, along with a pass_var call on the static geothermal heat flux to enable this to work properly. All answers are bitwise identical, but there is a new optional argument to a publicly visible subroutines. --- src/parameterizations/vertical/MOM_geothermal.F90 | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 360c3a791d..b1fc1fd177 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -5,6 +5,7 @@ module MOM_geothermal use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : register_static_field, time_type, diag_ctrl +use MOM_domains, only : pass_var use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_io, only : MOM_read_data, slasher @@ -44,7 +45,7 @@ module MOM_geothermal !! the partial derivative of the coordinate density with temperature is positive !! or very small, the layers are simply heated in place. Any heat that can not !! be applied to the ocean is returned (WHERE)? -subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS) +subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid !! structure. @@ -69,6 +70,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS) type(geothermal_CS), pointer :: CS !< The control structure returned by !! a previous call to !! geothermal_init. + integer, optional, intent(in) :: halo !< Halo width over which to work ! Local variables real, dimension(SZI_(G)) :: & heat_rem, & ! remaining heat (H * degC) @@ -105,6 +107,9 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + if (present(halo)) then + is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo + endif if (.not. associated(CS)) call MOM_error(FATAL, "MOM_geothermal: "//& "Module must be initialized before it is used.") @@ -377,6 +382,7 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) CS%geo_heat(i,j) = G%mask2dT(i,j) * scale enddo ; enddo endif + call pass_var(CS%geo_heat, G%domain) ! post the static geothermal heating field id = register_static_field('ocean_model', 'geo_heat', diag%axesT1, & From 1cc8d7202223876e80ceb264a907d80faad299ad Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 10 Sep 2018 19:34:28 -0400 Subject: [PATCH 0728/1072] +Added optional halo_TS arg to set_diffusivity_init Added an optional argument to set_diffusivity_init to return the size of the temperature and salinity halos that are expected to be valid to work with the options in set_diffusivity. Also corrected the checksum call for Kv_shear_Bu. All answers are bitwise identical, but there is a new optional argument to a publicly visible subroutine. --- .../vertical/MOM_set_diffusivity.F90 | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 8d3206303c..7ef7f972ec 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -354,7 +354,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(visc%Kv_shear)) visc%Kv_shear(:,:,:) = 0.0 ! needed for other parameterizations if (CS%debug) then call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear",G%HI) - call Bchksum(visc%Kv_shear, "after calc_KS_vert visc%Kv_shear_Bu",G%HI) + call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu",G%HI) call Bchksum(visc%TKE_turb, "after calc_KS_vert visc%TKE_turb",G%HI) endif else @@ -1892,7 +1892,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) end subroutine set_density_ratios subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp, int_tide_CSp, & - tm_CSp) + tm_CSp, halo_TS) type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -1907,6 +1907,8 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp !! structure (BDM) type(tidal_mixing_cs), pointer :: tm_csp !< pointer to tidal mixing control !! structure + integer, optional, intent(out) :: halo_TS !< The halo size of tracer points that must be + !! valid for the calculations in set_diffusivity. ! local variables real :: decay_length @@ -2228,6 +2230,11 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp if (CS%use_CVMix_ddiff) & id_clock_CVMix_ddiff = cpu_clock_id('(Double diffusion via CVMix)', grain=CLOCK_MODULE) + if (present(halo_TS)) then + halo_TS = 0 + if (CS%Vertex_Shear) halo_TS = 1 + endif + end subroutine set_diffusivity_init !> Clear pointers and dealocate memory From 9ede9b61a32119251bc2920388af117a881b222c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 10 Sep 2018 19:35:05 -0400 Subject: [PATCH 0729/1072] +(*)Corrected halo data when VERTEX_SHEAR=True Added code to work on extra points or do appropriate halo updates for those calls that modify temperatures, salinities and thicknesses before the call to set_diffusivity in both diabatic and legacy_diabatic. All answers are bitwise identical in the existing MOM6 test cases, but this corrects a problem with answers that do not reproduce across PE layouts when VERTEX_SHEAR=True. --- .../vertical/MOM_diabatic_driver.F90 | 36 +++++++++++-------- 1 file changed, 22 insertions(+), 14 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index e3806fd684..5985c6f054 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -154,7 +154,8 @@ module MOM_diabatic_driver !! fluxes are applied, in m. real :: evap_CFL_limit = 0.8 !< The largest fraction of a layer that can be !! evaporated in one time-step (non-dim). - + integer :: halo_TS_diff = 0 !< The temperature, salinity and thickness halo size that + !! must be valid for the diffusivity calculations. logical :: useKPP = .false. !< use CVMix/KPP diffusivities and non-local transport logical :: salt_reject_below_ML !< If true, add salt below mixed layer (layer mode only) logical :: KPPisPassive !< If true, KPP is in passive mode, not changing answers. @@ -379,7 +380,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & integer :: z_ids(7) ! id numbers of diagnostics to be interpolated to depth integer :: dir_flag ! An integer encoding the directions in which to do halo updates. logical :: showCallTree ! If true, show the call tree - integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m + integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m, halo integer :: ig, jg ! global indices for testing testing itide point source (BDM) logical :: avg_enabled ! for testing internal tides (BDM) @@ -447,9 +448,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif if (associated(fluxes%p_surf_full)) then - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full, halo=CS%halo_TS_diff) else - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff) endif if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)") @@ -465,15 +466,16 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_orig,h,eaml,ebml) - do k=1,nz ; do j=js,je ; do i=is,ie + halo = CS%halo_TS_diff + !$OMP parallel do default(shared) + do k=1,nz ; do j=js-halo,je+halo ; do i=is-halo,ie+halo h_orig(i,j,k) = h(i,j,k) ; eaml(i,j,k) = 0.0 ; ebml(i,j,k) = 0.0 enddo ; enddo ; enddo endif if (CS%use_geothermal) then call cpu_clock_begin(id_clock_geothermal) - call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp) + call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G) @@ -1258,7 +1260,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en integer :: z_ids(7) ! id numbers of diagnostics to be interpolated to depth integer :: dir_flag ! An integer encoding the directions in which to do halo updates. logical :: showCallTree ! If true, show the call tree - integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m + integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m, halo integer :: ig, jg ! global indices for testing testing itide point source (BDM) logical :: avg_enabled ! for testing internal tides (BDM) @@ -1323,9 +1325,9 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en endif if (associated(fluxes%p_surf_full)) then - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full, halo=CS%halo_TS_diff) else - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff) endif if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)") @@ -1340,15 +1342,16 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_orig,h,eaml,ebml) - do k=1,nz ; do j=js,je ; do i=is,ie + halo = CS%halo_TS_diff + !$OMP parallel do default(shared) + do k=1,nz ; do j=js-halo,je+halo ; do i=is-halo,ie+halo h_orig(i,j,k) = h(i,j,k) ; eaml(i,j,k) = 0.0 ; ebml(i,j,k) = 0.0 enddo ; enddo ; enddo endif if (CS%use_geothermal) then call cpu_clock_begin(id_clock_geothermal) - call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp) + call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G) @@ -1478,6 +1481,11 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! Sets: Kd, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S ! Also changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ???? ! And sets visc%Kv_shear + if ((CS%halo_TS_diff > 0) .and. (CS%ML_mix_first > 0.0)) then + if (associated(tv%T)) call pass_var(tv%T, G%Domain, halo=CS%halo_TS_diff, complete=.false.) + if (associated(tv%T)) call pass_var(tv%S, G%Domain, halo=CS%halo_TS_diff, complete=.false.) + call pass_var(h, G%domain, halo=CS%halo_TS_diff, complete=.true.) + endif call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, CS%set_diff_CSp, Kd, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -3277,7 +3285,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, ! initialize module for setting diffusivities call set_diffusivity_init(Time, G, GV, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, & - CS%int_tide_CSp, CS%tidal_mixing_CSp) + CS%int_tide_CSp, CS%tidal_mixing_CSp, CS%halo_TS_diff) ! set up the clocks for this module From 9733d7d50c3a9cae498a1a15f756cc20bd5c57e0 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 12 Sep 2018 14:58:12 -0600 Subject: [PATCH 0730/1072] write hist at end of run --- config_src/nuopc_driver/MOM_ocean_model.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 94dd64efed..9d40dc6638 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -773,7 +773,7 @@ subroutine ocean_model_end(Ocean_sfc, Ocean_state, Time, write_restart) if (write_restart) then call ocean_model_save_restart(Ocean_state, Time) end if - call diag_mediator_end(Time, Ocean_state%diag) + call diag_mediator_end(Time, Ocean_state%diag, end_diag_manager=.true.) call MOM_end(Ocean_state%MOM_CSp) if (Ocean_state%use_ice_shelf) call ice_shelf_end(Ocean_state%Ice_shelf_CSp) From 7c4adcb96685db1bbb205a111677ccab9b832f90 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Tue, 18 Sep 2018 17:19:13 -0400 Subject: [PATCH 0731/1072] Diag decimation prototype, coarsening by a factor of 2 - Prototype zaps all diagnostics by a factor of 2 - Works only for the native grid diagnostics - _z diagnostics complain about the local mask array index --- src/core/MOM_grid.F90 | 36 ++- src/framework/MOM_diag_mediator.F90 | 372 ++++++++++++++++++++++++++-- src/framework/MOM_domains.F90 | 48 +++- 3 files changed, 435 insertions(+), 21 deletions(-) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index e72038a252..35247a178b 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -5,7 +5,7 @@ module MOM_grid use MOM_hor_index, only : hor_index_type, hor_index_init use MOM_domains, only : MOM_domain_type, get_domain_extent, compute_block_extent -use MOM_domains, only : get_global_shape +use MOM_domains, only : get_global_shape, get_domain_extent_zap2 use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL use MOM_file_parser, only : get_param, log_param, log_version, param_file_type @@ -52,6 +52,23 @@ module MOM_grid integer :: JsgB !< The start j-index of cell vertices within the global domain integer :: JegB !< The end j-index of cell vertices within the global domain + integer :: isc_zap2 !< The start i-index of cell centers within the computational domain + integer :: iec_zap2 !< The end i-index of cell centers within the computational domain + integer :: jsc_zap2 !< The start j-index of cell centers within the computational domain + integer :: jec_zap2 !< The end j-index of cell centers within the computational domain + integer :: isd_zap2 !< The start i-index of cell centers within the data domain + integer :: ied_zap2 !< The end i-index of cell centers within the data domain + integer :: jsd_zap2 !< The start j-index of cell centers within the data domain + integer :: jed_zap2 !< The end j-index of cell centers within the data domain + integer :: IsdB_zap2 !< The start i-index of cell vertices within the data domain + integer :: IedB_zap2 !< The end i-index of cell vertices within the data domain + integer :: JsdB_zap2 !< The start j-index of cell vertices within the data domain + integer :: JedB_zap2 !< The end j-index of cell vertices within the data domain + integer :: isg_zap2 !< The start i-index of cell centers within the computational domain + integer :: ieg_zap2 !< The end i-index of cell centers within the computational domain + integer :: jsg_zap2 !< The start j-index of cell centers within the computational domain + integer :: jeg_zap2 !< The end j-index of cell centers within the computational domain + integer :: isd_global !< The value of isd in the global index space (decompoistion invariant). integer :: jsd_global !< The value of isd in the global index space (decompoistion invariant). integer :: idg_offset !< The offset between the corresponding global and local i-indices. @@ -343,6 +360,23 @@ subroutine MOM_grid_init(G, param_file, HI, global_indexing, bathymetry_at_vel) if ( G%block(nblocks)%jed+G%block(nblocks)%jdg_offset > G%HI%jed + G%HI%jdg_offset ) & call MOM_error(FATAL, "MOM_grid_init: G%jed_bk > G%jed") + call get_domain_extent_zap2(G%Domain, G%isc_zap2, G%iec_zap2, G%jsc_zap2, G%jec_zap2,& + G%isd_zap2, G%ied_zap2, G%jsd_zap2, G%jed_zap2,& + G%isg_zap2, G%ieg_zap2, G%jsg_zap2, G%jeg_zap2) + + ! Set array sizes for fields that are discretized at tracer cell boundaries. +! G%IscB_zap2 = G%isc_zap2 ; G%JscB_zap2 = G%jsc_zap2 + G%IsdB_zap2 = G%isd_zap2 ; G%JsdB_zap2 = G%jsd_zap2 +! G%IsgB_zap2 = G%isg_zap2 ; G%JsgB_zap2 = G%jsg_zap2 + if (G%symmetric) then +! G%IscB_zap2 = G%isc_zap2-1 ; G%JscB_zap2 = G%jsc_zap2-1 + G%IsdB_zap2 = G%isd_zap2-1 ; G%JsdB_zap2 = G%jsd_zap2-1 +! G%IsgB_zap2 = G%isg_zap2-1 ; G%JsgB_zap2 = G%jsg_zap2-1 + endif +! G%IecB_zap2 = G%iec_zap2 ; G%JecB_zap2 = G%jec_zap2 + G%IedB_zap2 = G%ied_zap2 ; G%JedB_zap2 = G%jed_zap2 +! G%IegB_zap2 = G%ieg_zap2 ; G%JegB_zap2 = G%jeg_zap2 + end subroutine MOM_grid_init diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 6fdd0cc6df..f4d33cb2cb 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -67,6 +67,10 @@ module MOM_diag_mediator module procedure post_data_3d, post_data_2d, post_data_0d end interface post_data +interface zap2_sample + module procedure zap2_sample_2d,zap2_sample_3d,zap2_sample_2d0,zap2_sample_3d0 +end interface zap2_sample + !> A group of 1D axes that comprise a 1D/2D/3D mesh type, public :: axes_grp character(len=15) :: id !< The id string for this particular combination of handles. @@ -108,6 +112,8 @@ module MOM_diag_mediator ! For masking real, pointer, dimension(:,:) :: mask2d => null() !< Mask for 2d (x-y) axes real, pointer, dimension(:,:,:) :: mask3d => null() !< Mask for 3d axes + real, pointer, dimension(:,:) :: mask2d_zap2 => null() !< Mask for 2d (x-y) axes zapped by a factor 2 + real, pointer, dimension(:,:,:) :: mask3d_zap2 => null() !< Mask for 3d axes zapped by a factor 2 end type axes_grp !> Contains an array to store a diagnostic target grid @@ -191,6 +197,28 @@ module MOM_diag_mediator real, dimension(:,:,:), pointer :: mask3dCui => null() real, dimension(:,:,:), pointer :: mask3dCvi => null() !!@} + real, dimension(:,:), pointer :: mask2dT_zap2 => null() !< 2D mask array for cell-center points + real, dimension(:,:), pointer :: mask2dBu_zap2 => null() !< 2D mask array for cell-corner points + real, dimension(:,:), pointer :: mask2dCu_zap2 => null() !< 2D mask array for east-face points + real, dimension(:,:), pointer :: mask2dCv_zap2 => null() !< 2D mask array for north-face points + !>@{ 3D mask arrays for diagnostics at layers (mask...L) and interfaces (mask...i) + real, dimension(:,:,:), pointer :: mask3dTL_zap2 => null() + real, dimension(:,:,:), pointer :: mask3dBL_zap2 => null() + real, dimension(:,:,:), pointer :: mask3dCuL_zap2 => null() + real, dimension(:,:,:), pointer :: mask3dCvL_zap2 => null() + real, dimension(:,:,:), pointer :: mask3dTi_zap2 => null() + real, dimension(:,:,:), pointer :: mask3dBi_zap2 => null() + real, dimension(:,:,:), pointer :: mask3dCui_zap2 => null() + real, dimension(:,:,:), pointer :: mask3dCvi_zap2 => null() + !!@} + integer :: isc_zap2 !< The start i-index of cell centers within the computational domain + integer :: iec_zap2 !< The end i-index of cell centers within the computational domain + integer :: jsc_zap2 !< The start j-index of cell centers within the computational domain + integer :: jec_zap2 !< The end j-index of cell centers within the computational domain + integer :: isd_zap2 !< The start i-index of cell centers within the data domain + integer :: ied_zap2 !< The end i-index of cell centers within the data domain + integer :: jsd_zap2 !< The start j-index of cell centers within the data domain + integer :: jed_zap2 !< The end j-index of cell centers within the data domain ! Space for diagnostics is dynamically allocated as it is needed. ! The chunk size is how much the array should grow on each new allocation. @@ -238,6 +266,9 @@ module MOM_diag_mediator ! CPU clocks integer :: id_clock_diag_mediator, id_clock_diag_remap, id_clock_diag_grid_updates +logical :: decim_all_diags = .true. +integer :: decim_fac = 2 + contains !> Sets up diagnostics axes @@ -250,12 +281,43 @@ subroutine set_axes_info(G, GV, param_file, diag_cs, set_vertical) !! vertical axes ! Local variables integer :: id_xq, id_yq, id_zl, id_zi, id_xh, id_yh - integer :: i, k, nz + integer :: i, j, k, nz real :: zlev(GV%ke), zinter(GV%ke+1) logical :: set_vert + real, dimension(:), pointer :: gridLonT_zap2 =>NULL() + real, dimension(:), pointer :: gridLatT_zap2 =>NULL() set_vert = .true. ; if (present(set_vertical)) set_vert = set_vertical +if(decim_all_diags) then + + allocate(gridLonT_zap2(G%isg_zap2:G%ieg_zap2)) + allocate(gridLatT_zap2(G%jsg_zap2:G%jeg_zap2)) + + do i=G%isg_zap2,G%ieg_zap2; gridLonT_zap2(i) = G%gridLonT(G%isg+decim_fac*i-2); enddo + do j=G%jsg_zap2,G%jeg_zap2; gridLatT_zap2(j) = G%gridLatT(G%jsg+decim_fac*j-2); enddo + + +! if (G%symmetric) then +! id_xq = diag_axis_init('xq', G%gridLonB_zap2(G%isgB:G%iegB), G%x_axis_units, 'x', & +! 'q point nominal longitude', Domain2=G%Domain%mpp_domain_zap2) +! id_yq = diag_axis_init('yq', G%gridLatB_zap2(G%jsgB:G%jegB), G%y_axis_units, 'y', & +! 'q point nominal latitude', Domain2=G%Domain%mpp_domain_zap2) +! else + id_xq = diag_axis_init('xq', gridLonT_zap2(G%isg_zap2:G%ieg_zap2), G%x_axis_units, 'x', & + 'q point nominal longitude', Domain2=G%Domain%mpp_domain_zap2) + id_yq = diag_axis_init('yq', gridLatT_zap2(G%jsg_zap2:G%jeg_zap2), G%y_axis_units, 'y', & + 'q point nominal latitude', Domain2=G%Domain%mpp_domain_zap2) +! endif + id_xh = diag_axis_init('xh', gridLonT_zap2(G%isg_zap2:G%ieg_zap2), G%x_axis_units, 'x', & + 'h point nominal longitude', Domain2=G%Domain%mpp_domain_zap2) + id_yh = diag_axis_init('yh', gridLatT_zap2(G%jsg_zap2:G%jeg_zap2), G%y_axis_units, 'y', & + 'h point nominal latitude', Domain2=G%Domain%mpp_domain_zap2) + + deallocate(gridLonT_zap2) + deallocate(gridLatT_zap2) + +else if (G%symmetric) then id_xq = diag_axis_init('xq', G%gridLonB(G%isgB:G%iegB), G%x_axis_units, 'x', & 'q point nominal longitude', Domain2=G%Domain%mpp_domain) @@ -271,6 +333,7 @@ subroutine set_axes_info(G, GV, param_file, diag_cs, set_vertical) 'h point nominal longitude', Domain2=G%Domain%mpp_domain) id_yh = diag_axis_init('yh', G%gridLatT(G%jsg:G%jeg), G%y_axis_units, 'y', & 'h point nominal latitude', Domain2=G%Domain%mpp_domain) +endif if (set_vert) then nz = GV%ke @@ -429,7 +492,7 @@ subroutine set_masks_for_axes(G, diag_cs) type(diag_ctrl), pointer :: diag_cs !< A pointer to a type with many variables !! used for diagnostics ! Local variables - integer :: c, nk, i, j, k + integer :: c, nk, i, j, k, ii, jj type(axes_grp), pointer :: axes => NULL(), h_axes => NULL() ! Current axes, for convenience do c=1, diag_cs%num_diag_coords @@ -441,7 +504,9 @@ subroutine set_masks_for_axes(G, diag_cs) nk = axes%nz allocate( axes%mask3d(G%isd:G%ied,G%jsd:G%jed,nk) ) ; axes%mask3d(:,:,:) = 0. call diag_remap_calc_hmask(diag_cs%diag_remap_cs(c), G, axes%mask3d) - + if(decim_all_diags) call zap2_sample(axes%mask3d, axes%mask3d_zap2, 1,nk, G%isd,G%ied,G%jsd,G%jed,& + G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2) + h_axes => diag_cs%remap_axesTL(c) ! Use the h-point masks to generate the u-, v- and q- masks ! Level/layer u-points in diagnostic coordinate @@ -452,6 +517,8 @@ subroutine set_masks_for_axes(G, diag_cs) do k = 1, nk ; do j=G%jsc,G%jec ; do I=G%isc-1,G%iec if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i+1,j,k) > 0.) axes%mask3d(I,j,k) = 1. enddo ; enddo ; enddo + if(decim_all_diags) call zap2_sample(axes%mask3d, axes%mask3d_zap2, 1,nk, G%isdb,G%iedb,G%jsd,G%jed,& + G%isdb_zap2,G%iedb_zap2,G%jsd_zap2,G%jed_zap2) ! Level/layer v-points in diagnostic coordinate axes => diag_cs%remap_axesCvL(c) @@ -461,6 +528,8 @@ subroutine set_masks_for_axes(G, diag_cs) do k = 1, nk ; do J=G%jsc-1,G%jec ; do i=G%isc,G%iec if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i,j+1,k) > 0.) axes%mask3d(i,J,k) = 1. enddo ; enddo ; enddo + if(decim_all_diags) call zap2_sample(axes%mask3d, axes%mask3d_zap2, 1,nk, G%isd,G%ied,G%jsdb,G%jedb,& + G%isd_zap2,G%ied_zap2,G%jsdb_zap2,G%jedb_zap2) ! Level/layer q-points in diagnostic coordinate axes => diag_cs%remap_axesBL(c) @@ -471,6 +540,8 @@ subroutine set_masks_for_axes(G, diag_cs) if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i+1,j+1,k) + & h_axes%mask3d(i+1,j,k) + h_axes%mask3d(i,j+1,k) > 0.) axes%mask3d(I,J,k) = 1. enddo ; enddo ; enddo + if(decim_all_diags) call zap2_sample(axes%mask3d, axes%mask3d_zap2, 1,nk, G%isdb,G%iedb,G%jsdb,G%jedb,& + G%isdb_zap2,G%iedb_zap2,G%jsdb_zap2,G%jedb_zap2) ! Interface h-points in diagnostic coordinate (w-point) axes => diag_cs%remap_axesTi(c) @@ -484,6 +555,8 @@ subroutine set_masks_for_axes(G, diag_cs) enddo if (h_axes%mask3d(i,j,nk) > 0.) axes%mask3d(i,J,nk+1) = 1. enddo ; enddo + if(decim_all_diags) call zap2_sample(axes%mask3d, axes%mask3d_zap2, 1,nk+1, G%isd,G%ied,G%jsd,G%jed,& + G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2) h_axes => diag_cs%remap_axesTi(c) ! Use the w-point masks to generate the u-, v- and q- masks @@ -495,6 +568,8 @@ subroutine set_masks_for_axes(G, diag_cs) do k = 1, nk+1 ; do j=G%jsc,G%jec ; do I=G%isc-1,G%iec if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i+1,j,k) > 0.) axes%mask3d(I,j,k) = 1. enddo ; enddo ; enddo + if(decim_all_diags) call zap2_sample(axes%mask3d, axes%mask3d_zap2, 1,nk+1, G%isdb,G%iedb,G%jsd,G%jed,& + G%isdb_zap2,G%iedb_zap2,G%jsd_zap2,G%jed_zap2) ! Interface v-points in diagnostic coordinate axes => diag_cs%remap_axesCvi(c) @@ -504,6 +579,8 @@ subroutine set_masks_for_axes(G, diag_cs) do k = 1, nk+1 ; do J=G%jsc-1,G%jec ; do i=G%isc,G%iec if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i,j+1,k) > 0.) axes%mask3d(i,J,k) = 1. enddo ; enddo ; enddo + if(decim_all_diags) call zap2_sample(axes%mask3d, axes%mask3d_zap2, 1,nk+1, G%isd,G%ied,G%jsdb,G%jedb,& + G%isd_zap2,G%ied_zap2,G%jsdb_zap2,G%jedb_zap2) ! Interface q-points in diagnostic coordinate axes => diag_cs%remap_axesBi(c) @@ -514,6 +591,8 @@ subroutine set_masks_for_axes(G, diag_cs) if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i+1,j+1,k) + & h_axes%mask3d(i+1,j,k) + h_axes%mask3d(i,j+1,k) > 0.) axes%mask3d(I,J,k) = 1. enddo ; enddo ; enddo + if(decim_all_diags) call zap2_sample(axes%mask3d, axes%mask3d_zap2, 1,nk+1, G%isdb,G%iedb,G%jsdb,G%jedb,& + G%isdb_zap2,G%iedb_zap2,G%jsdb_zap2,G%jedb_zap2) endif enddo @@ -703,6 +782,31 @@ subroutine define_axes_group(diag_cs, handles, axes, nz, vertical_coordinate_num endif endif + axes%mask2d_zap2 => null() + if (axes%rank==2) then + if (axes%is_h_point) axes%mask2d_zap2 => diag_cs%mask2dT_zap2 + if (axes%is_u_point) axes%mask2d_zap2 => diag_cs%mask2dCu_zap2 + if (axes%is_v_point) axes%mask2d_zap2 => diag_cs%mask2dCv_zap2 + if (axes%is_q_point) axes%mask2d_zap2 => diag_cs%mask2dBu_zap2 + endif + ! A static 3d mask for non-native coordinates can only be setup when a grid is available + axes%mask3d_zap2 => null() + if (axes%rank==3 .and. axes%is_native) then + ! Native variables can/should use the native masks copied into diag_cs + if (axes%is_layer) then + if (axes%is_h_point) axes%mask3d_zap2 => diag_cs%mask3dTL_zap2 + if (axes%is_u_point) axes%mask3d_zap2 => diag_cs%mask3dCuL_zap2 + if (axes%is_v_point) axes%mask3d_zap2 => diag_cs%mask3dCvL_zap2 + if (axes%is_q_point) axes%mask3d_zap2 => diag_cs%mask3dBL_zap2 + elseif (axes%is_interface) then + if (axes%is_h_point) axes%mask3d_zap2 => diag_cs%mask3dTi_zap2 + if (axes%is_u_point) axes%mask3d_zap2 => diag_cs%mask3dCui_zap2 + if (axes%is_v_point) axes%mask3d_zap2 => diag_cs%mask3dCvi_zap2 + if (axes%is_q_point) axes%mask3d_zap2 => diag_cs%mask3dBi_zap2 + endif + endif + + end subroutine define_axes_group !> Set up the array extents for doing diagnostics @@ -715,6 +819,11 @@ subroutine set_diag_mediator_grid(G, diag_cs) diag_cs%isd = G%isd ; diag_cs%ied = G%ied diag_cs%jsd = G%jsd ; diag_cs%jed = G%jed + diag_cs%isc_zap2 = G%isc_zap2 - (G%isd_zap2-1) ; diag_cs%iec_zap2 = G%iec_zap2 - (G%isd_zap2-1) + diag_cs%jsc_zap2 = G%jsc_zap2 - (G%jsd_zap2-1) ; diag_cs%jec_zap2 = G%jec_zap2 - (G%jsd_zap2-1) + diag_cs%isd_zap2 = G%isd_zap2 ; diag_cs%ied_zap2 = G%ied_zap2 + diag_cs%jsd_zap2 = G%jsd_zap2 ; diag_cs%jed_zap2 = G%jed_zap2 + end subroutine set_diag_mediator_grid !> Make a real scalar diagnostic available for averaging or output @@ -823,6 +932,9 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) logical :: used, is_stat integer :: cszi, cszj, dszi, dszj integer :: isv, iev, jsv, jev, i, j, chksum + !decimation + integer :: isv_dec,iev_dec,jsv_dec,jev_dec + real, dimension(:,:), pointer :: decim_field => NULL() is_stat = .false. ; if (present(is_static)) is_stat = is_static @@ -876,11 +988,25 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) else locfield => field endif + + if (decim_all_diags) then + isv_dec = 1 ; iev_dec = (iev-isv+1)/decim_fac + jsv_dec = 1 ; jev_dec = (jev-jsv+1)/decim_fac + allocate(decim_field(isv_dec:iev_dec,jsv_dec:jev_dec)) + endif + if (diag_cs%diag_as_chksum) then chksum = chksum_general(locfield) if (is_root_pe()) then call log_chksum_diag(diag_cs%chksum_diag_doc_unit, diag%debug_str, chksum) endif + elseif (decim_all_diags) then + !Sample the field at the corner of each cell + do j=jsv_dec,jev_dec ; do i=isv_dec,iev_dec + decim_field(i,j) = locfield(isv+decim_fac*i-2,jsv+decim_fac*j-2) + enddo ; enddo + used = send_data(diag%fms_diag_id, decim_field, diag_cs%time_end, & + is_in=isv_dec, js_in=jsv_dec, ie_in=iev_dec, je_in=jev_dec) else if (is_stat) then if (present(mask)) then @@ -1045,7 +1171,7 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) real, target, intent(in) :: field(:,:,:) !< 3-d array being offered for output or averaging type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output logical, optional, intent(in) :: is_static !< If true, this is a static field that is always offered. - real, optional, intent(in) :: mask(:,:,:) !< If present, use this real array as the data mask. + real, optional,target, intent(in) :: mask(:,:,:) !< If present, use this real array as the data mask. ! Local variables real, dimension(:,:,:), pointer :: locfield => NULL() @@ -1056,6 +1182,12 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) integer :: cszi, cszj, dszi, dszj integer :: isv, iev, jsv, jev, ks, ke, i, j, k, isv_c, jsv_c integer :: chksum + !decimation + integer :: isv_zap2,iev_zap2,jsv_zap2,jev_zap2 + real, dimension(:,:,:), pointer :: zap2_field => NULL() + real, dimension(:,:,:), pointer :: zap2_mask => NULL() + real, dimension(:,:,:), pointer :: locmask => NULL() + real, dimension(:,:,:), pointer :: diag_axes_mask3d => NULL() is_stat = .false. ; if (present(is_static)) is_stat = is_static @@ -1096,8 +1228,8 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) call MOM_error(FATAL,"post_data_3d_low: "//trim(diag%debug_str)//trim(mesg)) endif + ks = lbound(field,3) ; ke = ubound(field,3) if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) then - ks = lbound(field,3) ; ke = ubound(field,3) allocate( locfield( lbound(field,1):ubound(field,1), lbound(field,2):ubound(field,2), ks:ke ) ) ! locfield(:,:,:) = 0.0 ! Zeroing out this array would be a good idea, but it appears ! not to be necessary. @@ -1116,7 +1248,7 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) "have j-direction space to represent the symmetric computational domain.") endif - do k=ks,ke ; do j=jsv_c,jev ; do i=isv_c,iev + do k=ks,ke ; do j=jsv,jev ; do i=isv,iev if (field(i,j,k) == diag_cs%missing_value) then locfield(i,j,k) = diag_cs%missing_value else @@ -1127,12 +1259,74 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) locfield => field endif + if (present(mask)) then + call assert(size(locfield) == size(mask), & + 'post_data_3d_low: mask size mismatch: '//diag%debug_str) + locmask => mask + endif + + diag_axes_mask3d => diag%axes%mask3d + + if (decim_all_diags) then + diag_axes_mask3d => diag%axes%mask3d_zap2 + + isv_zap2 = diag_cs%isc_zap2 ; iev_zap2 = diag_cs%iec_zap2 + jsv_zap2 = diag_cs%jsc_zap2 ; jev_zap2 = diag_cs%jec_zap2 + + if ( size(field,1) == dszi ) then + isv_zap2 = diag_cs%isc_zap2 ; iev_zap2 = diag_cs%iec_zap2 ! Data domain + elseif ( size(field,1) == dszi + 1 ) then + isv_zap2 = diag_cs%isc_zap2 ; iev_zap2 = diag_cs%iec_zap2+1 ! Symmetric data domain + elseif ( size(field,1) == cszi) then + isv_zap2 = 1 ; iev_zap2 = (diag_cs%iec_zap2-diag_cs%isc_zap2) +1 ! Computational domain + elseif ( size(field,1) == cszi + 1 ) then + isv_zap2 = 1 ; iev_zap2 = (diag_cs%iec_zap2-diag_cs%isc_zap2) +2 ! Symmetric computational domain + else + write (mesg,*) " peculiar size ",size(field,1)," in i-direction\n"//& + "does not match one of ", cszi, cszi+1, dszi, dszi+1 + call MOM_error(FATAL,"post_data_3d_low: "//trim(diag%debug_str)//trim(mesg)) + endif + if ( size(field,2) == dszj ) then + jsv_zap2 = diag_cs%jsc_zap2 ; jev_zap2 = diag_cs%jec_zap2 ! Data domain + elseif ( size(field,2) == dszj + 1 ) then + jsv_zap2 = diag_cs%jsc_zap2 ; jev_zap2 = diag_cs%jec_zap2+1 ! Symmetric data domain + elseif ( size(field,2) == cszj) then + jsv_zap2 = 1 ; jev_zap2 = (diag_cs%jec_zap2-diag_cs%jsc_zap2) +1 ! Computational domain + elseif ( size(field,2) == cszj + 1 ) then + jsv_zap2 = 1 ; jev_zap2 = (diag_cs%jec_zap2-diag_cs%jsc_zap2) +2 ! Symmetric computational domain + else + write (mesg,*) " peculiar size ",size(field,2)," in j-direction\n"//& + "does not match one of ", cszj, cszj+1, dszj, dszj+1 + call MOM_error(FATAL,"post_data_3d_low: "//trim(diag%debug_str)//trim(mesg)) + endif + !Sample the field at the corner of each cell + call zap2_sample(locfield, zap2_field, ks,ke) + !point locfield to the decimated field + locfield => zap2_field + isv=isv_zap2; iev=iev_zap2; jsv=jsv_zap2; jev=jev_zap2 + + !Decimated mask + if (present(mask)) then + call zap2_sample(mask, zap2_mask, ks,ke) + locmask => zap2_mask + endif + + endif + if (diag%fms_diag_id>0) then if (diag_cs%diag_as_chksum) then chksum = chksum_general(locfield) if (is_root_pe()) then call log_chksum_diag(diag_cs%chksum_diag_doc_unit, diag%debug_str, chksum) endif + !Decimation test +! elseif (decim_all_diags) then +! !Sample the field at the corner of each cell +! do k=ks,ke ; do j=jsv_dec,jev_dec ; do i=isv_dec,iev_dec +! decim_field(i,j,k) = locfield(isv+decim_fac*i-2,jsv+decim_fac*j-2,k) +! enddo ; enddo ; enddo +! used = send_data(diag%fms_diag_id, decim_field, diag_cs%time_end, & +! is_in=isv_dec, js_in=jsv_dec, ie_in=iev_dec, je_in=jev_dec) else if (is_stat) then if (present(mask)) then @@ -1148,18 +1342,16 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) is_in=isv, js_in=jsv, ie_in=iev, je_in=jev) endif elseif (diag_cs%ave_enabled) then - if (present(mask)) then - call assert(size(locfield) == size(mask), & - 'post_data_3d_low: mask size mismatch: '//diag%debug_str) + if (associated(locmask)) then used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag_cs%time_int, rmask=mask) - elseif (associated(diag%axes%mask3d)) then - call assert(size(locfield) == size(diag%axes%mask3d), & + weight=diag_cs%time_int, rmask=locmask) + elseif (associated(diag_axes_mask3d)) then + call assert(size(locfield) == size(diag_axes_mask3d), & 'post_data_3d_low: mask3d size mismatch: '//diag%debug_str) used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag_cs%time_int, rmask=diag%axes%mask3d) + weight=diag_cs%time_int, rmask=diag_axes_mask3d) else used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & @@ -1182,6 +1374,7 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) end subroutine post_data_3d_low + !> Post the horizontally area-averaged diagnostic subroutine post_decimated_data(diag_cs, diag, field, decimation_factor) type(diag_ctrl), intent(in) :: diag_cs !< Diagnostics mediator control structure @@ -1320,7 +1513,7 @@ end function get_diag_time_end !> Returns the "diag_mediator" handle for a group (native, CMOR, z-coord, ...) of diagnostics !! derived from one field. -integer function register_diag_field(module_name, field_name, axes, init_time, & +integer function register_diag_field(module_name, field_name, axes_in, init_time, & long_name, units, missing_value, range, mask_variant, standard_name, & verbose, do_not_log, err_msg, interp_method, tile_count, cmor_field_name, & cmor_long_name, cmor_units, cmor_standard_name, cell_methods, & @@ -1328,7 +1521,7 @@ integer function register_diag_field(module_name, field_name, axes, init_time, & character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" !! or "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field - type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that + type(axes_grp), target, intent(in) :: axes_in !< Container w/ up to 3 integer handles that !! indicates axes for this field type(time_type), intent(in) :: init_time !< Time at which a field is first available? character(len=*), optional, intent(in) :: long_name !< Long name of a field. @@ -1366,16 +1559,37 @@ integer function register_diag_field(module_name, field_name, axes, init_time, & real :: MOM_missing_value type(diag_ctrl), pointer :: diag_cs => NULL() type(axes_grp), pointer :: remap_axes => null() + type(axes_grp), pointer :: axes => null() integer :: dm_id, i character(len=256) :: new_module_name logical :: active + axes => axes_in MOM_missing_value = axes%diag_cs%missing_value if (present(missing_value)) MOM_missing_value = missing_value diag_cs => axes%diag_cs dm_id = -1 - + !Reroute the axes for decimated diagnostics + if (decim_all_diags) then + if ((axes_in%id == diag_cs%axesTL%id)) then + axes => diag_cs%axesTL + elseif (axes_in%id == diag_cs%axesBL%id) then + axes => diag_cs%axesBL + elseif (axes_in%id == diag_cs%axesCuL%id ) then + axes => diag_cs%axesCuL + elseif (axes_in%id == diag_cs%axesCvL%id) then + axes => diag_cs%axesCvL + elseif (axes_in%id == diag_cs%axesTi%id) then + axes => diag_cs%axesTi + elseif (axes_in%id == diag_cs%axesBi%id) then + axes => diag_cs%axesBi + elseif (axes_in%id == diag_cs%axesCui%id ) then + axes => diag_cs%axesCui + elseif (axes_in%id == diag_cs%axesCvi%id) then + axes => diag_cs%axesCvi + endif + endif ! Register the native diagnostic active = register_diag_field_expand_cmor(dm_id, module_name, field_name, axes, & init_time, long_name=long_name, units=units, missing_value=MOM_missing_value, & @@ -1439,7 +1653,7 @@ integer function register_diag_field(module_name, field_name, axes, init_time, & end function register_diag_field -!> Returns True if either the native of CMOr version of the diagnostic were registered. Updates 'dm_id' +!> Returns True if either the native or CMOr version of the diagnostic were registered. Updates 'dm_id' !! after calling register_diag_field_expand_axes() for both native and CMOR variants of the field. logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, axes, init_time, & long_name, units, missing_value, range, mask_variant, standard_name, & @@ -2235,7 +2449,6 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mod, version, "") - call get_param(param_file, mod, 'NUM_DIAG_COORDS', diag_cs%num_diag_coords, & 'The number of diagnostic vertical coordinates to use.\n'//& 'For each coordinate, an entry in DIAG_COORDS must be provided.', & @@ -2450,6 +2663,9 @@ subroutine diag_masks_set(G, nz, diag_cs) ! Local variables integer :: k + if(decim_all_diags) then + call zap2_diag_masks_set(G, nz, diag_cs) + endif ! 2d masks point to the model masks since they are identical diag_cs%mask2dT => G%mask2dT diag_cs%mask2dBu => G%mask2dBu @@ -2481,6 +2697,126 @@ subroutine diag_masks_set(G, nz, diag_cs) end subroutine diag_masks_set +subroutine zap2_sample_3d(field_in, field_out,ks,ke, is,ie,js,je, is2,ie2,js2,je2) + integer , intent(in) :: ks,ke, is,ie,js,je, is2,ie2,js2,je2 + real, dimension(is:,js:,1:) ,intent(in) :: field_in + real, dimension(:,:,:) , pointer :: field_out + integer :: k,i,j,ii,jj + + allocate(field_out(is2:ie2,js2:je2,ks:ke)) + do k= ks,ke ; do j=js2,je2 ; do i=is2,ie2 + ii = is+2*(i-is2) + jj = js+2*(j-js2) + field_out(i,j,k) = field_in(ii,jj,k) + enddo; enddo; enddo + +end subroutine zap2_sample_3d + +subroutine zap2_sample_2d(field_in, field_out, is,ie,js,je, is2,ie2,js2,je2) + integer , intent(in) :: is,ie,js,je, is2,ie2,js2,je2 + real, dimension(is:,js:) ,intent(in) :: field_in + real, dimension(:,:) , pointer :: field_out + integer :: i,j,ii,jj + + allocate(field_out(is2:ie2,js2:je2)) + do j=js2,je2 ; do i=is2,ie2 + ii = is+2*(i-is2) + jj = js+2*(j-js2) + field_out(i,j) = field_in(ii,jj) + enddo; enddo + +end subroutine zap2_sample_2d + +subroutine zap2_sample_3d0(field_in, field_out,ks,ke) + integer , intent(in) :: ks,ke + real, dimension(:,:,:) ,intent(in) :: field_in + real, dimension(:,:,:) , pointer :: field_out + integer :: k,i,j,ii,jj, is_in,js_in, is2,ie2,js2,je2 + + is_in=1; js_in=1 + is2=1; ie2=size(field_in,1)/2 + js2=1; je2=size(field_in,2)/2 + + allocate(field_out(is2:ie2,js2:je2,ks:ke)) + + do k= ks,ke ; do j=js2,je2 ; do i=is2,ie2 + ii = is_in+2*(i-is2) + jj = js_in+2*(j-js2) + field_out(i,j,k) = field_in(ii,jj,k) + enddo; enddo; enddo + +end subroutine zap2_sample_3d0 + +subroutine zap2_sample_2d0(field_in, field_out) + real, dimension(:,:) ,intent(in) :: field_in + real, dimension(:,:) , pointer :: field_out + integer :: i,j,ii,jj, is_in,js_in, is2,ie2,js2,je2 + + is_in=1; js_in=1 + is2=1; ie2=size(field_in,1)/2 + js2=1; je2=size(field_in,2)/2 + + allocate(field_out(is2:ie2,js2:je2)) + + do j=js2,je2 ; do i=is2,ie2 + ii = is_in+2*(i-is2) + jj = js_in+2*(j-js2) + field_out(i,j) = field_in(ii,jj) + enddo; enddo + +end subroutine zap2_sample_2d0 + +subroutine zap2_diag_masks_set(G, nz, diag_cs) + type(ocean_grid_type), target, intent(in) :: G !< The ocean grid type. + integer, intent(in) :: nz !< The number of layers in the model's native grid. + type(diag_ctrl), pointer :: diag_cs !< A pointer to a type with many variables + !! used for diagnostics + ! Local variables + integer :: i,j,k,ii,jj + +!print*,'original c extents ',G%isc,G%iec,G%jsc,G%jec +!print*,'coarse c extents ',G%isc_zap2,G%iec_zap2,G%jsc_zap2,G%jec_zap2 +!print*,'original d extents ',G%isd,G%ied,G%jsd,G%jed +!print*,'coarse d extents ',G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2 +! original c extents 5 52 5 64 +! coarse c extents 5 28 5 34 +! original d extents 1 56 1 68 +! coarse d extents 1 32 1 38 + diag_cs%isc_zap2 = G%isc_zap2 - (G%isd_zap2-1) ; diag_cs%iec_zap2 = G%iec_zap2 - (G%isd_zap2-1) + diag_cs%jsc_zap2 = G%jsc_zap2 - (G%jsd_zap2-1) ; diag_cs%jec_zap2 = G%jec_zap2 - (G%jsd_zap2-1) + diag_cs%isd_zap2 = G%isd_zap2 ; diag_cs%ied_zap2 = G%ied_zap2 + diag_cs%jsd_zap2 = G%jsd_zap2 ; diag_cs%jed_zap2 = G%jed_zap2 + + ! 2d masks point to the model masks since they are identical + call zap2_sample(G%mask2dT, diag_cs%mask2dT_zap2 ,G%isd,G%ied,G%jsd,G%jed,G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2) + call zap2_sample(G%mask2dBu,diag_cs%mask2dBu_zap2,G%isd,G%ied,G%jsd,G%jed,G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2) + call zap2_sample(G%mask2dCu,diag_cs%mask2dCu_zap2,G%isd,G%ied,G%jsd,G%jed,G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2) + call zap2_sample(G%mask2dCv,diag_cs%mask2dCv_zap2,G%isd,G%ied,G%jsd,G%jed,G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2) + ! 3d native masks are needed by diag_manager but the native variables + ! can only be masked 2d - for ocean points, all layers exists. + allocate(diag_cs%mask3dTL_zap2(G%isd_zap2:G%ied_zap2,G%jsd_zap2:G%jed_zap2,1:nz)) + allocate(diag_cs%mask3dBL_zap2(G%IsdB_zap2:G%IedB_zap2,G%JsdB_zap2:G%JedB_zap2,1:nz)) + allocate(diag_cs%mask3dCuL_zap2(G%IsdB_zap2:G%IedB_zap2,G%jsd_zap2:G%jed_zap2,1:nz)) + allocate(diag_cs%mask3dCvL_zap2(G%isd_zap2:G%ied_zap2,G%JsdB_zap2:G%JedB_zap2,1:nz)) + do k=1,nz + diag_cs%mask3dTL_zap2(:,:,k) = diag_cs%mask2dT_zap2(:,:) + diag_cs%mask3dBL_zap2(:,:,k) = diag_cs%mask2dBu_zap2(:,:) + diag_cs%mask3dCuL_zap2(:,:,k) = diag_cs%mask2dCu_zap2(:,:) + diag_cs%mask3dCvL_zap2(:,:,k) = diag_cs%mask2dCv_zap2(:,:) + enddo + allocate(diag_cs%mask3dTi_zap2(G%isd_zap2:G%ied_zap2,G%jsd_zap2:G%jed_zap2,1:nz+1)) + allocate(diag_cs%mask3dBi_zap2(G%IsdB_zap2:G%IedB_zap2,G%JsdB_zap2:G%JedB_zap2,1:nz+1)) + allocate(diag_cs%mask3dCui_zap2(G%IsdB_zap2:G%IedB_zap2,G%jsd_zap2:G%jed_zap2,1:nz+1)) + allocate(diag_cs%mask3dCvi_zap2(G%isd_zap2:G%ied_zap2,G%JsdB_zap2:G%JedB_zap2,1:nz+1)) + do k=1,nz+1 + diag_cs%mask3dTi_zap2(:,:,k) = diag_cs%mask2dT_zap2(:,:) + diag_cs%mask3dBi_zap2(:,:,k) = diag_cs%mask2dBu_zap2(:,:) + diag_cs%mask3dCui_zap2(:,:,k) = diag_cs%mask2dCu_zap2(:,:) + diag_cs%mask3dCvi_zap2(:,:,k) = diag_cs%mask2dCv_zap2(:,:) + enddo + +end subroutine zap2_diag_masks_set + subroutine diag_mediator_close_registration(diag_CS) type(diag_ctrl), intent(inout) :: diag_CS !< Structure used to regulate diagnostic output diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index a38facf79a..58c6f30171 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -32,7 +32,7 @@ module MOM_domains implicit none ; private -public :: MOM_domains_init, MOM_infra_init, MOM_infra_end, get_domain_extent +public :: MOM_domains_init, MOM_infra_init, MOM_infra_end, get_domain_extent, get_domain_extent_zap2 public :: MOM_define_domain, MOM_define_io_domain, clone_MOM_domain public :: pass_var, pass_vector, broadcast, PE_here, root_PE, num_PEs public :: pass_var_start, pass_var_complete, fill_symmetric_edges @@ -98,6 +98,8 @@ module MOM_domains type, public :: MOM_domain_type type(domain2D), pointer :: mpp_domain => NULL() !< The FMS domain with halos !! on this processor, centered at h points. + type(domain2D), pointer :: mpp_domain_zap2 => NULL() !< A coarse FMS domain with halos + !! on this processor, centered at h points. integer :: niglobal !< The total horizontal i-domain size. integer :: njglobal !< The total horizontal j-domain size. integer :: nihalo !< The i-halo size in memory. @@ -1148,7 +1150,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & character(len=8) :: char_xsiz, char_ysiz, char_niglobal, char_njglobal character(len=40) :: nihalo_nm, njhalo_nm, layout_nm, io_layout_nm, masktable_nm character(len=40) :: niproc_nm, njproc_nm - + integer :: xhalo_zap2,yhalo_zap2 ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl ! This module's name. @@ -1156,6 +1158,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & if (.not.associated(MOM_dom)) then allocate(MOM_dom) allocate(MOM_dom%mpp_domain) + allocate(MOM_dom%mpp_domain_zap2) endif pe = PE_here() @@ -1510,6 +1513,28 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & endif endif + global_indices(1) = 1 ; global_indices(2) = int(MOM_dom%niglobal/2) + global_indices(3) = 1 ; global_indices(4) = int(MOM_dom%njglobal/2) + xhalo_zap2 = int(MOM_dom%nihalo/2) + yhalo_zap2 = int(MOM_dom%njhalo/2) + if (mask_table_exists) then + call MOM_define_domain( global_indices, layout, MOM_dom%mpp_domain_zap2, & + xflags=X_FLAGS, yflags=Y_FLAGS, & + xhalo=xhalo_zap2, yhalo=yhalo_zap2, & + symmetry = MOM_dom%symmetric, name=trim("MOMc"), & + maskmap=MOM_dom%maskmap ) + else + call MOM_define_domain( global_indices, layout, MOM_dom%mpp_domain_zap2, & + xflags=X_FLAGS, yflags=Y_FLAGS, & + xhalo=xhalo_zap2, yhalo=yhalo_zap2, & + symmetry = MOM_dom%symmetric, name=trim("MOMc")) + endif + + if ((io_layout(1) > 0) .and. (io_layout(2) > 0) .and. & + (layout(1)*layout(2) > 1)) then + call MOM_define_io_domain(MOM_dom%mpp_domain_zap2, io_layout) + endif + end subroutine MOM_domains_init !> clone_MD_to_MD copies one MOM_domain_type into another, while allowing @@ -1541,6 +1566,7 @@ subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, & if (.not.associated(MOM_dom)) then allocate(MOM_dom) allocate(MOM_dom%mpp_domain) + allocate(MOM_dom%mpp_domain_zap2) endif ! Save the extra data for creating other domains of different resolution that overlay this domain @@ -1738,6 +1764,24 @@ subroutine get_domain_extent(Domain, isc, iec, jsc, jec, isd, ied, jsd, jed, & end subroutine get_domain_extent +subroutine get_domain_extent_zap2(Domain, isc_zap2, iec_zap2, jsc_zap2, jec_zap2,& + isd_zap2, ied_zap2, jsd_zap2, jed_zap2,& + isg_zap2, ieg_zap2, jsg_zap2, jeg_zap2) + type(MOM_domain_type), & + intent(in) :: Domain !< The MOM domain from which to extract information + integer, intent(out) :: isc_zap2, iec_zap2, jsc_zap2, jec_zap2 + integer, intent(out) :: isd_zap2, ied_zap2, jsd_zap2, jed_zap2 + integer, intent(out) :: isg_zap2, ieg_zap2, jsg_zap2, jeg_zap2 + call mpp_get_compute_domain(Domain%mpp_domain_zap2, isc_zap2, iec_zap2, jsc_zap2, jec_zap2) + call mpp_get_data_domain(Domain%mpp_domain_zap2, isd_zap2, ied_zap2, jsd_zap2, jed_zap2) + call mpp_get_global_domain (Domain%mpp_domain_zap2, isg_zap2, ieg_zap2, jsg_zap2, jeg_zap2) + ! This code institutes the MOM convention that local array indices start at 1. + isc_zap2 = isc_zap2-isd_zap2+1 ; iec_zap2 = iec_zap2-isd_zap2+1 + jsc_zap2 = jsc_zap2-jsd_zap2+1 ; jec_zap2 = jec_zap2-jsd_zap2+1 + ied_zap2 = ied_zap2-isd_zap2+1 ; jed_zap2 = jed_zap2-jsd_zap2+1 + isd_zap2 = 1 ; jsd_zap2 = 1 +end subroutine get_domain_extent_zap2 + !> Returns the global shape of h-point arrays subroutine get_global_shape(domain, niglobal, njglobal) type(MOM_domain_type), intent(in) :: domain !< MOM domain From b9d714b49be2f9d43f25b2cffd12855b2a352e4b Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Wed, 19 Sep 2018 14:52:09 -0400 Subject: [PATCH 0732/1072] Diag decimation prototype, works for native and _z - Next: make diag decimation optional at diag_table level --- src/framework/MOM_diag_mediator.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index f4d33cb2cb..8571283fd3 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -1330,10 +1330,10 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) else if (is_stat) then if (present(mask)) then - call assert(size(locfield) == size(mask), & + call assert(size(locfield) == size(locmask), & 'post_data_3d_low is_stat: mask size mismatch: '//diag%debug_str) used = send_data(diag%fms_diag_id, locfield, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=mask) + is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=locmask) !elseif (associated(diag%axes%mask3d)) then ! used = send_data(diag_field_id, locfield, & ! is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=diag%axes%mask3d) @@ -1342,7 +1342,9 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) is_in=isv, js_in=jsv, ie_in=iev, je_in=jev) endif elseif (diag_cs%ave_enabled) then - if (associated(locmask)) then + if (present(mask)) then + call assert(size(locfield) == size(locmask), & + 'post_data_3d_low: mask size mismatch: '//diag%debug_str) used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & weight=diag_cs%time_int, rmask=locmask) From 7dd4753ee5c1214c564522bfb0273c92f4968453 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 21 Sep 2018 11:28:19 -0400 Subject: [PATCH 0733/1072] Scale MINIMUM_DEPTH and MASKING_DEPTH when read Changed the code to rescale MINIMUM_DEPTH and MASKING_DEPTH from units of m to Z in their get_param calls in MOM_grid_initialize, rather than doing it later. All answers are bitwise identical. --- src/initialization/MOM_grid_initialize.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index f0626cbd02..2845523654 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -1209,8 +1209,8 @@ subroutine initialize_masks(G, PF) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: PF !< Parameter file structure ! Local variables - real :: Dmin ! The depth for masking in the same units as G%bathyT. - real :: min_depth, mask_depth ! Depths in m. + real :: Dmin ! The depth for masking in the same units as G%bathyT (Z). + real :: min_depth, mask_depth ! Depths in the same units as G%bathyT (Z). character(len=40) :: mdl = "MOM_grid_init initialize_masks" integer :: i, j @@ -1220,14 +1220,14 @@ subroutine initialize_masks(G, PF) "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out.\n"//& "If MASKING_DEPTH is specified, then all depths shallower than\n"//& "MINIMUM_DEPTH but deeper than MASKING_DEPTH are rounded to MINIMUM_DEPTH.", & - units="m", default=0.0) + units="m", default=0.0, scale=1.0/G%Zd_to_m) call get_param(PF, mdl, "MASKING_DEPTH", mask_depth, & "The depth below which to mask points as land points, for which all\n"//& "fluxes are zeroed out. MASKING_DEPTH is ignored if negative.", & - units="m", default=-9999.0) + units="m", default=-9999.0, scale=1.0/G%Zd_to_m) - Dmin = min_depth / G%Zd_to_m - if (mask_depth>=0.) Dmin = mask_depth / G%Zd_to_m + Dmin = min_depth + if (mask_depth>=0.) Dmin = mask_depth G%mask2dCu(:,:) = 0.0 ; G%mask2dCv(:,:) = 0.0 ; G%mask2dBu(:,:) = 0.0 From a034c72dbbf9bae10049063111dcf639e04a8934 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 21 Sep 2018 11:29:22 -0400 Subject: [PATCH 0734/1072] Do MOM_tracer_initialize_from_Z in units of Z Rescaled the veriables in MOM_tracer_initialization_from_Z to work in units of Z and H instead of m. Also eliminated several unused variables and added or updated the comments describing others. All answers are bitwise identical. --- .../MOM_tracer_initialization_from_Z.F90 | 48 +++++-------------- 1 file changed, 13 insertions(+), 35 deletions(-) diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 95041d814d..fb5487780f 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -26,6 +26,7 @@ module MOM_tracer_initialization_from_Z use MOM_remapping, only : remapping_core_h use MOM_verticalGrid, only : verticalGrid_type use MOM_horizontal_regridding, only : myStats, horiz_interp_and_extrap_tracer + implicit none ; private #include @@ -43,7 +44,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thickness, in m. + intent(in) :: h !< Layer thickness, in H (often m or kg m-2). real, dimension(:,:,:), pointer :: tr !< Pointer to array to be initialized type(param_file_type), intent(in) :: PF !< parameter file character(len=*), intent(in) :: src_file !< source filename @@ -64,31 +65,24 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, character(len=10) :: remapScheme logical :: homog,useALE -! This include declares and sets the variable "version". -#include "version_variable.h" - + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_initialize_tracers_from_Z" ! This module's name. integer :: is, ie, js, je, nz ! compute domain indices - integer :: isg, ieg, jsg, jeg ! global extent integer :: isd, ied, jsd, jed ! data domain indices - integer :: i, j, k, kd - - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi real, allocatable, dimension(:,:,:), target :: tr_z, mask_z real, allocatable, dimension(:), target :: z_edges_in, z_in ! Local variables for ALE remapping - real, dimension(:), allocatable :: h1, h2, hTarget, deltaE, tmpT1d - real, dimension(:), allocatable :: tmpT1dIn - real :: zTopOfCell, zBottomOfCell, z_bathy ! Heights in m. + real, dimension(:,:,:), allocatable :: hSrc ! Source thicknesses in H units. + real, dimension(:), allocatable :: h1 ! A 1-d column of source thicknesses in Z. + real :: zTopOfCell, zBottomOfCell, z_bathy ! Heights in Z. type(remapping_CS) :: remapCS ! Remapping parameters and work arrays - real, dimension(:,:,:), allocatable :: hSrc - - real :: tempAvg, missing_value - integer :: nPoints, ans + real :: missing_value + integer :: nPoints integer :: id_clock_routine, id_clock_ALE logical :: reentrant_x, tripolar_n @@ -99,7 +93,6 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - isg = G%isg ; ieg = G%ieg ; jsg = G%jsg ; jeg = G%jeg call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") @@ -118,7 +111,6 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, reentrant_x = .false. ; call get_param(PF, mdl, "REENTRANT_X", reentrant_x,default=.true.) tripolar_n = .false. ; call get_param(PF, mdl, "TRIPOLAR_N", tripolar_n, default=.false.) - if (PRESENT(homogenize)) homog=homogenize if (PRESENT(useALEremapping)) useALE=useALEremapping if (PRESENT(remappingScheme)) remapScheme=remappingScheme @@ -127,11 +119,11 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, convert=1.0 if (PRESENT(src_var_unit_conversion)) convert = src_var_unit_conversion - call horiz_interp_and_extrap_tracer(src_file, src_var_nam, convert, recnum, & G, tr_z, mask_z, z_in, z_edges_in, missing_value, reentrant_x, tripolar_n, homog) kd = size(z_edges_in,1)-1 + do k=1,kd+1 ; z_edges_in(k) = GV%m_to_Z*z_edges_in(k) ; enddo call pass_var(tr_z,G%Domain) call pass_var(mask_z,G%Domain) @@ -142,28 +134,19 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, ! First we reserve a work space for reconstructions of the source data allocate( h1(kd) ) allocate( hSrc(isd:ied,jsd:jed,kd) ) - allocate( tmpT1dIn(kd) ) call initialize_remapping( remapCS, remapScheme, boundary_extrapolation=.false. ) ! Data for reconstructions ! Next we initialize the regridding package so that it knows about the target grid - allocate( hTarget(nz) ) - allocate( h2(nz) ) - allocate( tmpT1d(nz) ) - allocate( deltaE(nz+1) ) do j = js, je ; do i = is, ie if (G%mask2dT(i,j)>0.) then ! Build the source grid zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0 - z_bathy = G%Zd_to_m*G%bathyT(i,j) + z_bathy = G%bathyT(i,j) do k = 1, kd if (mask_z(i,j,k) > 0.) then zBottomOfCell = -min( z_edges_in(k+1), z_bathy ) - tmpT1dIn(k) = tr_z(i,j,k) elseif (k>1) then zBottomOfCell = -z_bathy - tmpT1dIn(k) = tmpT1dIn(k-1) - else ! This next block should only ever be reached over land - tmpT1dIn(k) = -99.9 endif h1(k) = zTopOfCell - zBottomOfCell if (h1(k)>0.) nPoints = nPoints + 1 @@ -173,21 +156,16 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, else tr(i,j,:) = 0. endif ! mask2dT - hSrc(i,j,:) = h1(:) + hSrc(i,j,:) = GV%Z_to_H * h1(:) enddo ; enddo call ALE_remap_scalar(remapCS, G, GV, kd, hSrc, tr_z, h, tr, all_cells=.false. ) deallocate( hSrc ) deallocate( h1 ) - deallocate( h2 ) - deallocate( hTarget ) - deallocate( tmpT1d ) - deallocate( tmpT1dIn ) - deallocate( deltaE ) do k=1,nz - call myStats(tr(:,:,k),missing_value,is,ie,js,je,k,'Tracer from ALE()') + call myStats(tr(:,:,k), missing_value, is, ie, js, je, k, 'Tracer from ALE()') enddo call cpu_clock_end(id_clock_ALE) endif ! useALEremapping From 78dc30b337fcc3401b1a044b1d823e9593df28b4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 21 Sep 2018 18:26:46 -0400 Subject: [PATCH 0735/1072] Use units of Z in extract_surface_state Changed the code to work in depth (Z) units in extract_surface_state, including storing two H_mix control structure variables in Z units. All answers are bitwise identical. --- src/core/MOM.F90 | 64 +++++++++++++++++++++++++++--------------------- 1 file changed, 36 insertions(+), 28 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index f004bfcbd3..04b3cdc600 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -274,11 +274,11 @@ module MOM ! These elements are used to control the calculation and error checking of the surface state real :: Hmix !< Diagnostic mixed layer thickness over which to - !! average surface tracer properties (in meter) when + !! average surface tracer properties (in depth units, Z) when !! bulk mixed layer is not used, or a negative value !! if a bulk mixed layer is being used. real :: Hmix_UV !< Depth scale over which to average surface flow to - !! feedback to the coupler/driver (m) when + !! feedback to the coupler/driver (in depth units, Z) when !! bulk mixed layer is not used, or a negative value !! if a bulk mixed layer is being used. logical :: check_bad_sfc_vals !< If true, scan surface state for ridiculous values. @@ -1572,7 +1572,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & integer :: nkml, nkbl, verbosity, write_geom integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. - real :: conv2watt, conv2salt, H_convert + real :: conv2watt, conv2salt character(len=48) :: flux_units, S_flux_units type(vardesc) :: vd_T, vd_S ! Structures describing temperature and salinity variables. @@ -1751,12 +1751,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "If BULKMIXEDLAYER is false, HMIX_SFC_PROP is the depth \n"//& "over which to average to find surface properties like \n"//& "SST and SSS or density (but not surface velocities).", & - units="m", default=1.0) + units="m", default=1.0) !, scale=GV%m_to_Z) call get_param(param_file, "MOM", "HMIX_UV_SFC_PROP", CS%Hmix_UV, & "If BULKMIXEDLAYER is false, HMIX_UV_SFC_PROP is the depth\n"//& "over which to average to find surface flow properties,\n"//& "SSU, SSV. A non-positive value indicates no averaging.", & - units="m", default=0.) + units="m", default=0.) !, scale=GV%m_to_Z) endif call get_param(param_file, "MOM", "MIN_Z_DIAG_INTERVAL", Z_diag_int, & "The minimum amount of time in seconds between \n"//& @@ -1944,6 +1944,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call verticalGridInit( param_file, CS%GV ) GV => CS%GV ! dG%g_Earth = GV%g_Earth + !### These should be merged with the get_param calls, but must follow verticalGridInit. + if (.not.bulkmixedlayer) then + CS%Hmix = CS%Hmix * GV%m_to_Z + CS%Hmix_UV = CS%Hmix_UV * GV%m_to_Z + endif ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. if (CS%debug .or. dG%symmetric) & @@ -2001,10 +2006,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & conv2watt = GV%H_to_kg_m2 * CS%tv%C_p if (GV%Boussinesq) then conv2salt = GV%H_to_m ! Could change to GV%H_to_kg_m2 * 0.001? - H_convert = GV%H_to_m else conv2salt = GV%H_to_kg_m2 - H_convert = GV%H_to_kg_m2 endif call register_tracer(CS%tv%T, CS%tracer_Reg, param_file, dG%HI, GV, & tr_desc=vd_T, registry_diags=.true., flux_nameroot='T', & @@ -2675,11 +2678,12 @@ subroutine extract_surface_state(CS, sfc_state) u => NULL(), & ! u : zonal velocity component (m/s) v => NULL(), & ! v : meridional velocity component (m/s) h => NULL() ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) - real :: depth(SZI_(CS%G)) ! distance from the surface (meter) - real :: depth_ml ! depth over which to average to - ! determine mixed layer properties (meter) - real :: dh ! thickness of a layer within mixed layer (meter) - real :: mass ! mass per unit area of a layer (kg/m2) + real :: depth(SZI_(CS%G)) ! Distance from the surface in depth units (Z) + real :: depth_ml ! Depth over which to average to determine mixed + ! layer properties (Z) + real :: dh ! Thickness of a layer within the mixed layer (Z) + real :: mass ! Mass per unit area of a layer (kg/m2) + real :: bathy_m ! The depth of bathymetry in m (not Z), used for error checking. logical :: use_temperature ! If true, temp and saln used as state variables. integer :: i, j, k, is, ie, js, je, nz, numberOfErrors @@ -2731,7 +2735,8 @@ subroutine extract_surface_state(CS, sfc_state) sfc_state%Hml(i,j) = CS%Hml(i,j) enddo ; enddo ; endif else ! (CS%Hmix >= 0.0) - + !### This calculation should work in thickness (H) units instead of Z, but that + !### would change answers at roundoff in non-Boussinesq cases. depth_ml = CS%Hmix ! Determine the mean tracer properties of the uppermost depth_ml fluid. !$OMP parallel do default(shared) private(depth,dh) @@ -2746,8 +2751,8 @@ subroutine extract_surface_state(CS, sfc_state) enddo do k=1,nz ; do i=is,ie - if (depth(i) + h(i,j,k)*GV%H_to_m < depth_ml) then - dh = h(i,j,k)*GV%H_to_m + if (depth(i) + h(i,j,k)*GV%H_to_Z < depth_ml) then + dh = h(i,j,k)*GV%H_to_Z elseif (depth(i) < depth_ml) then dh = depth_ml - depth(i) else @@ -2763,20 +2768,22 @@ subroutine extract_surface_state(CS, sfc_state) enddo ; enddo ! Calculate the average properties of the mixed layer depth. do i=is,ie - if (depth(i) < GV%H_subroundoff*GV%H_to_m) & - depth(i) = GV%H_subroundoff*GV%H_to_m + if (depth(i) < GV%H_subroundoff*GV%H_to_Z) & + depth(i) = GV%H_subroundoff*GV%H_to_Z if (use_temperature) then sfc_state%SST(i,j) = sfc_state%SST(i,j) / depth(i) sfc_state%SSS(i,j) = sfc_state%SSS(i,j) / depth(i) else sfc_state%sfc_density(i,j) = sfc_state%sfc_density(i,j) / depth(i) endif - sfc_state%Hml(i,j) = depth(i) + sfc_state%Hml(i,j) = GV%Z_to_m * depth(i) enddo enddo ! end of j loop ! Determine the mean velocities in the uppermost depth_ml fluid. if (CS%Hmix_UV>0.) then + !### This calculation should work in thickness (H) units instead of Z, but that + !### would change answers at roundoff in non-Boussinesq cases. depth_ml = CS%Hmix_UV !$OMP parallel do default(shared) private(depth,dh,hv) do J=jscB,jecB @@ -2785,7 +2792,7 @@ subroutine extract_surface_state(CS, sfc_state) sfc_state%v(i,J) = 0.0 enddo do k=1,nz ; do i=is,ie - hv = 0.5 * (h(i,j,k) + h(i,j+1,k)) * GV%H_to_m + hv = 0.5 * (h(i,j,k) + h(i,j+1,k)) * GV%H_to_Z if (depth(i) + hv < depth_ml) then dh = hv elseif (depth(i) < depth_ml) then @@ -2798,8 +2805,8 @@ subroutine extract_surface_state(CS, sfc_state) enddo ; enddo ! Calculate the average properties of the mixed layer depth. do i=is,ie - if (depth(i) < GV%H_subroundoff*GV%H_to_m) & - depth(i) = GV%H_subroundoff*GV%H_to_m + if (depth(i) < GV%H_subroundoff*GV%H_to_Z) & + depth(i) = GV%H_subroundoff*GV%H_to_Z sfc_state%v(i,J) = sfc_state%v(i,J) / depth(i) enddo enddo ! end of j loop @@ -2811,7 +2818,7 @@ subroutine extract_surface_state(CS, sfc_state) sfc_state%u(I,j) = 0.0 enddo do k=1,nz ; do I=iscB,iecB - hu = 0.5 * (h(i,j,k) + h(i+1,j,k)) * GV%H_to_m + hu = 0.5 * (h(i,j,k) + h(i+1,j,k)) * GV%H_to_Z if (depth(i) + hu < depth_ml) then dh = hu elseif (depth(I) < depth_ml) then @@ -2824,8 +2831,8 @@ subroutine extract_surface_state(CS, sfc_state) enddo ; enddo ! Calculate the average properties of the mixed layer depth. do I=iscB,iecB - if (depth(I) < GV%H_subroundoff*GV%H_to_m) & - depth(I) = GV%H_subroundoff*GV%H_to_m + if (depth(I) < GV%H_subroundoff*GV%H_to_Z) & + depth(I) = GV%H_subroundoff*GV%H_to_Z sfc_state%u(I,j) = sfc_state%u(I,j) / depth(I) enddo enddo ! end of j loop @@ -2900,10 +2907,11 @@ subroutine extract_surface_state(CS, sfc_state) numberOfErrors=0 ! count number of errors do j=js,je; do i=is,ie if (G%mask2dT(i,j)>0.) then - localError = sfc_state%sea_lev(i,j)<=-G%Zd_to_m*G%bathyT(i,j) & + bathy_m = G%Zd_to_m*G%bathyT(i,j) + localError = sfc_state%sea_lev(i,j)<=-bathy_m & .or. sfc_state%sea_lev(i,j)>= CS%bad_val_ssh_max & .or. sfc_state%sea_lev(i,j)<=-CS%bad_val_ssh_max & - .or. sfc_state%sea_lev(i,j) + G%Zd_to_m*G%bathyT(i,j) < CS%bad_vol_col_thick + .or. sfc_state%sea_lev(i,j) + bathy_m < CS%bad_vol_col_thick if (use_temperature) localError = localError & .or. sfc_state%SSS(i,j)<0. & .or. sfc_state%SSS(i,j)>=CS%bad_val_sss_max & @@ -2916,7 +2924,7 @@ subroutine extract_surface_state(CS, sfc_state) write(msg(1:240),'(2(a,i4,x),2(a,f8.3,x),8(a,es11.4,x))') & 'Extreme surface sfc_state detected: i=',i,'j=',j, & 'x=',G%geoLonT(i,j), 'y=',G%geoLatT(i,j), & - 'D=',G%Zd_to_m*G%bathyT(i,j), 'SSH=',sfc_state%sea_lev(i,j), & + 'D=',bathy_m, 'SSH=',sfc_state%sea_lev(i,j), & 'SST=',sfc_state%SST(i,j), 'SSS=',sfc_state%SSS(i,j), & 'U-=',sfc_state%u(I-1,j), 'U+=',sfc_state%u(I,j), & 'V-=',sfc_state%v(i,J-1), 'V+=',sfc_state%v(i,J) @@ -2924,7 +2932,7 @@ subroutine extract_surface_state(CS, sfc_state) write(msg(1:240),'(2(a,i4,x),2(a,f8.3,x),6(a,es11.4))') & 'Extreme surface sfc_state detected: i=',i,'j=',j, & 'x=',G%geoLonT(i,j), 'y=',G%geoLatT(i,j), & - 'D=',G%Zd_to_m*G%bathyT(i,j), 'SSH=',sfc_state%sea_lev(i,j), & + 'D=',bathy_m, 'SSH=',sfc_state%sea_lev(i,j), & 'U-=',sfc_state%u(I-1,j), 'U+=',sfc_state%u(I,j), & 'V-=',sfc_state%v(i,J-1), 'V+=',sfc_state%v(i,J) endif From ea8a7704f76dbe2f05691acf8f38c3b089167f2e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 21 Sep 2018 18:27:46 -0400 Subject: [PATCH 0736/1072] Refactored code inside Set_pbce_Bous for clarity Relocated an internal factor in the expression for pbce for greater clarity of where the unit conversion factors come in. All answers are bitwise identical. --- src/core/MOM_PressureForce_Montgomery.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 6d094349ae..4ed4438d58 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -686,12 +686,12 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star !$OMP parallel do default(share) private(Ihtot) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - Ihtot(i) = GV%H_to_m / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) + Ihtot(i) = 1.0 / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) pbce(i,j,1) = GV%g_prime(1) * GV%H_to_m enddo do k=2,nz ; do i=Isq,Ieq+1 pbce(i,j,k) = pbce(i,j,k-1) + & - GV%g_prime(K) * ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i)) + (GV%g_prime(K)*GV%H_to_m) * ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i)) enddo ; enddo enddo ! end of j loop endif ! use_EOS From 4fcdeacaa995f4722cf5c435d8378fe76ea096f2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 22 Sep 2018 04:11:01 -0400 Subject: [PATCH 0737/1072] Replaced the variable mod with mdl in 7 modules Replaced variables mod with mdl in 7 modules to avoid a potential namespace conflict with the intrinsic mod function, and for greater standardization across the MOM6 code. All answers are bitwise identical. --- .../solo_driver/Neverland_surface_forcing.F90 | 16 +-- src/ALE/MOM_regridding.F90 | 118 +++++++++--------- src/framework/MOM_diag_mediator.F90 | 18 +-- .../vertical/MOM_diabatic_aux.F90 | 18 +-- .../vertical/MOM_diabatic_driver.F90 | 70 +++++------ .../vertical/MOM_entrain_diffusive.F90 | 14 +-- src/user/Neverland_initialization.F90 | 10 +- 7 files changed, 132 insertions(+), 132 deletions(-) diff --git a/config_src/solo_driver/Neverland_surface_forcing.F90 b/config_src/solo_driver/Neverland_surface_forcing.F90 index e6111b2a19..326b807293 100644 --- a/config_src/solo_driver/Neverland_surface_forcing.F90 +++ b/config_src/solo_driver/Neverland_surface_forcing.F90 @@ -218,7 +218,7 @@ subroutine Neverland_surface_forcing_init(Time, G, param_file, diag, CS) ! This include declares and sets the variable "version". #include "version_variable.h" ! Local variables - character(len=40) :: mod = "Neverland_surface_forcing" ! This module's name. + character(len=40) :: mdl = "Neverland_surface_forcing" ! This module's name. if (associated(CS)) then call MOM_error(WARNING, "Neverland_surface_forcing_init called with an associated "// & @@ -229,31 +229,31 @@ subroutine Neverland_surface_forcing_init(Time, G, param_file, diag, CS) CS%diag => diag ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & "If true, Temperature and salinity are used as state \n"//& "variables.", default=.true.) - call get_param(param_file, mod, "G_EARTH", CS%G_Earth, & + call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) - call get_param(param_file, mod, "RHO_0", CS%Rho0, & + call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to \n"//& "calculate accelerations and the mass for conservation \n"//& "properties, or with BOUSSINSEQ false to convert some \n"//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) -! call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & +! call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & ! "The background gustiness in the winds.", units="Pa", & ! default=0.02) - call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, & + call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & "If true, the buoyancy fluxes drive the model back \n"//& "toward some specified surface state with a rate \n"//& "given by FLUXCONST.", default= .false.) if (CS%restorebuoy) then - call get_param(param_file, mod, "FLUXCONST", CS%flux_const, & + call get_param(param_file, mdl, "FLUXCONST", CS%flux_const, & "The constant that relates the restoring surface fluxes \n"//& "to the relative surface anomalies (akin to a piston \n"//& "velocity). Note the non-MKS units.", units="m day-1", & diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 9cf69a2485..1e7da482a3 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -164,12 +164,12 @@ module MOM_regridding contains !> Initialization and configures a regridding control structure based on customizable run-time parameters -subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, param_prefix, param_suffix) +subroutine initialize_regridding(CS, GV, max_depth, param_file, mdl, coord_mode, param_prefix, param_suffix) type(regridding_CS), intent(inout) :: CS !< Regridding control structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, intent(in) :: max_depth !< The maximum depth of the ocean, in m. type(param_file_type), intent(in) :: param_file !< Parameter file - character(len=*), intent(in) :: mod !< Name of calling module. + character(len=*), intent(in) :: mdl !< Name of calling module. character(len=*), intent(in) :: coord_mode !< Coordinate mode character(len=*), intent(in) :: param_prefix !< String to prefix to parameter names. !! If empty, causes main model parameters to be used. @@ -199,12 +199,12 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, 250., 375., 500., 500., 500., 500., 500., 500., & 500., 500., 500., 500., 500., 500., 500., 500. /) - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) main_parameters=.false. if (len_trim(param_prefix)==0) main_parameters=.true. - if (main_parameters .and. len_trim(param_suffix)>0) call MOM_error(FATAL,trim(mod)//', initialize_regridding: '// & + if (main_parameters .and. len_trim(param_suffix)>0) call MOM_error(FATAL,trim(mdl)//', initialize_regridding: '// & 'Suffix provided without prefix for parameter names!') CS%nk = 0 @@ -213,7 +213,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, if (main_parameters) then ! Read coordinate units parameter (main model = REGRIDDING_COORDINATE_UNITS) - call get_param(param_file, mod, "REGRIDDING_COORDINATE_UNITS", coord_units, & + call get_param(param_file, mdl, "REGRIDDING_COORDINATE_UNITS", coord_units, & "Units of the regridding coordinuate.",& default=coordinateUnits(coord_mode)) else @@ -228,7 +228,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, param_name = trim(param_prefix)//"_INTERP_SCHEME_"//trim(param_suffix) string2 = 'PPM_H4' ! Default for diagnostics endif - call get_param(param_file, mod, "INTERPOLATION_SCHEME", string, & + call get_param(param_file, mdl, "INTERPOLATION_SCHEME", string, & "This sets the interpolation scheme to use to\n"//& "determine the new grid. These parameters are\n"//& "only relevant when REGRIDDING_COORDINATE_MODE is\n"//& @@ -239,7 +239,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, endif if (main_parameters .and. coord_is_state_dependent) then - call get_param(param_file, mod, "BOUNDARY_EXTRAPOLATION", tmpLogical, & + call get_param(param_file, mdl, "BOUNDARY_EXTRAPOLATION", tmpLogical, & "When defined, a proper high-order reconstruction\n"//& "scheme is used within boundary cells rather\n"//& "than PCM. E.g., if PPM is used for remapping, a\n"//& @@ -261,7 +261,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, string2 = 'UNIFORM' if (max_depth>3000.) string2='WOA09' ! For convenience endif - call get_param(param_file, mod, param_name, string, & + call get_param(param_file, mdl, param_name, string, & "Determines how to specify the coordinate\n"//& "resolution. Valid options are:\n"//& " PARAM - use the vector-parameter "//trim(coord_res_param)//"\n"//& @@ -291,7 +291,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, ke = extract_integer(string(9:len_trim(string)),'',1) tmpReal = extract_real(string(9:len_trim(string)),',',2,missing_value=max_depth) else - call MOM_error(FATAL,trim(mod)//', initialize_regridding: '// & + call MOM_error(FATAL,trim(mdl)//', initialize_regridding: '// & 'Unable to interpret "'//trim(string)//'".') endif allocate(dz(ke)) @@ -302,13 +302,13 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, GV%Rlay(1)+0.5*(GV%Rlay(1)-GV%Rlay(2)), & GV%Rlay(ke)+0.5*(GV%Rlay(ke)-GV%Rlay(ke-1)) ) endif - if (main_parameters) call log_param(param_file, mod, "!"//coord_res_param, dz, & + if (main_parameters) call log_param(param_file, mdl, "!"//coord_res_param, dz, & trim(message), units=trim(coord_units)) elseif (trim(string)=='PARAM') then ! Read coordinate resolution (main model = ALE_RESOLUTION) ke = GV%ke ! Use model nk by default allocate(dz(ke)) - call get_param(param_file, mod, coord_res_param, dz, & + call get_param(param_file, mdl, coord_res_param, dz, & trim(message), units=trim(coord_units), fail_if_missing=.true.) elseif (index(trim(string),'FILE:')==1) then ! FILE:filename,var_name is assumed to be reading level thickness variables @@ -320,7 +320,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, ! Otherwise assume we should look for the file in INPUTDIR fileName = trim(inputdir) // trim( extractWord(trim(string(6:80)), 1) ) endif - if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Specified file not found: Looking for '"//trim(fileName)//"' ("//trim(string)//")") varName = trim( extractWord(trim(string(6:)), 2) ) @@ -328,12 +328,12 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, if (field_exists(fileName,'dz')) then; varName = 'dz' elseif (field_exists(fileName,'dsigma')) then; varName = 'dsigma' elseif (field_exists(fileName,'ztest')) then; varName = 'ztest' - else ; call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + else ; call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Coordinate variable not specified and none could be guessed.") endif endif ! This check fails when the variable is a dimension variable! -AJA - !if (.not. field_exists(fileName,trim(varName))) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + !if (.not. field_exists(fileName,trim(varName))) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & ! "Specified field not found: Looking for '"//trim(varName)//"' ("//trim(string)//")") if (CS%regridding_scheme == REGRIDDING_SIGMA) then expected_units = 'nondim' @@ -345,7 +345,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, if (index(trim(varName),'interfaces=')==1) then varName=trim(varName(12:)) call check_grid_def(filename, varName, expected_units, message, ierr) - if (ierr) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "//& + if (ierr) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "//& "Unsupported format in grid definition '"//trim(filename)//"'. Error message "//trim(message)) call field_size(trim(fileName), trim(varName), nzf) ke = nzf(1)-1 @@ -367,15 +367,15 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, call MOM_read_data(trim(fileName), trim(varName), dz) endif if (main_parameters .and. ke/=GV%ke) then - call MOM_error(FATAL,trim(mod)//', initialize_regridding: '// & + call MOM_error(FATAL,trim(mdl)//', initialize_regridding: '// & 'Mismatch in number of model levels and "'//trim(string)//'".') endif - if (main_parameters) call log_param(param_file, mod, "!"//coord_res_param, dz, & + if (main_parameters) call log_param(param_file, mdl, "!"//coord_res_param, dz, & trim(message), units=coordinateUnits(coord_mode)) elseif (index(trim(string),'FNC1:')==1) then ke = GV%ke; allocate(dz(ke)) call dz_function1( trim(string(6:)), dz ) - if (main_parameters) call log_param(param_file, mod, "!"//coord_res_param, dz, & + if (main_parameters) call log_param(param_file, mdl, "!"//coord_res_param, dz, & trim(message), units=coordinateUnits(coord_mode)) elseif (index(trim(string),'RFNC1:')==1) then ! Function used for set target interface densities @@ -386,24 +386,24 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, allocate(rho_target(ke+1)) fileName = trim( extractWord(trim(string(8:)), 1) ) if (fileName(1:1)/='.' .and. filename(1:1)/='/') fileName = trim(inputdir) // trim( fileName ) - if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: HYBRID "// & + if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: HYBRID "// & "Specified file not found: Looking for '"//trim(fileName)//"' ("//trim(string)//")") varName = trim( extractWord(trim(string(8:)), 2) ) - if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: HYBRID "// & + if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: HYBRID "// & "Specified field not found: Looking for '"//trim(varName)//"' ("//trim(string)//")") call MOM_read_data(trim(fileName), trim(varName), rho_target) varName = trim( extractWord(trim(string(8:)), 3) ) if (varName(1:5) == 'FNC1:') then ! Use FNC1 to calculate dz call dz_function1( trim(string((index(trim(string),'FNC1:')+5):)), dz ) else ! Read dz from file - if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: HYBRID "// & + if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: HYBRID "// & "Specified field not found: Looking for '"//trim(varName)//"' ("//trim(string)//")") call MOM_read_data(trim(fileName), trim(varName), dz) endif if (main_parameters) then - call log_param(param_file, mod, "!"//coord_res_param, dz, & + call log_param(param_file, mdl, "!"//coord_res_param, dz, & trim(message), units=coordinateUnits(coord_mode)) - call log_param(param_file, mod, "!TARGET_DENSITIES", rho_target, & + call log_param(param_file, mdl, "!TARGET_DENSITIES", rho_target, & 'HYBRID target densities for itnerfaces', units=coordinateUnits(coord_mode)) endif elseif (index(trim(string),'WOA09')==1) then @@ -414,16 +414,16 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, tmpReal = tmpReal + woa09_dz(ke) enddo elseif (index(trim(string),'WOA09:')==1) then - if (len_trim(string)==6) call MOM_error(FATAL,trim(mod)//', initialize_regridding: '// & + if (len_trim(string)==6) call MOM_error(FATAL,trim(mdl)//', initialize_regridding: '// & 'Expected string of form "WOA09:N" but got "'//trim(string)//'".') ke = extract_integer(string(7:len_trim(string)),'',1) endif - if (ke>40 .or. ke<1) call MOM_error(FATAL,trim(mod)//', initialize_regridding: '// & + if (ke>40 .or. ke<1) call MOM_error(FATAL,trim(mdl)//', initialize_regridding: '// & 'For "WOA05:N" N must 0 0. ) then dz(ke) = dz(ke) + ( max_depth - tmpReal ) else - call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "MAXIMUM_DEPTH was too shallow to adjust bottom layer of DZ!"//trim(string)) endif endif @@ -466,7 +466,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, ! \todo This line looks like it would overwrite the target densities set just above? elseif (coordinateMode(coord_mode) == REGRIDDING_RHO) then call set_target_densities_from_GV(GV, CS) - call log_param(param_file, mod, "!TARGET_DENSITIES", CS%target_density, & + call log_param(param_file, mdl, "!TARGET_DENSITIES", CS%target_density, & 'RHO target densities for interfaces', units=coordinateUnits(coord_mode)) endif @@ -474,7 +474,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, call initCoord(CS, coord_mode) if (main_parameters .and. coord_is_state_dependent) then - call get_param(param_file, mod, "REGRID_COMPRESSIBILITY_FRACTION", tmpReal, & + call get_param(param_file, mdl, "REGRID_COMPRESSIBILITY_FRACTION", tmpReal, & "When interpolating potential density profiles we can add\n"//& "some artificial compressibility solely to make homogenous\n"//& "regions appear stratified.", default=0.) @@ -482,7 +482,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, endif if (main_parameters) then - call get_param(param_file, mod, "MIN_THICKNESS", tmpReal, & + call get_param(param_file, mdl, "MIN_THICKNESS", tmpReal, & "When regridding, this is the minimum layer\n"//& "thickness allowed.", units="m",& default=regriddingDefaultMinThickness ) @@ -493,21 +493,21 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, if (coordinateMode(coord_mode) == REGRIDDING_SLIGHT) then ! Set SLight-specific regridding parameters. - call get_param(param_file, mod, "SLIGHT_DZ_SURFACE", dz_fixed_sfc, & + call get_param(param_file, mdl, "SLIGHT_DZ_SURFACE", dz_fixed_sfc, & "The nominal thickness of fixed thickness near-surface\n"//& "layers with the SLight coordinate.", units="m", default=1.0) - call get_param(param_file, mod, "SLIGHT_NZ_SURFACE_FIXED", nz_fixed_sfc, & + call get_param(param_file, mdl, "SLIGHT_NZ_SURFACE_FIXED", nz_fixed_sfc, & "The number of fixed-depth surface layers with the SLight\n"//& "coordinate.", units="nondimensional", default=2) - call get_param(param_file, mod, "SLIGHT_SURFACE_AVG_DEPTH", Rho_avg_depth, & + call get_param(param_file, mdl, "SLIGHT_SURFACE_AVG_DEPTH", Rho_avg_depth, & "The thickness of the surface region over which to average\n"//& "when calculating the density to use to define the interior\n"//& "with the SLight coordinate.", units="m", default=1.0) - call get_param(param_file, mod, "SLIGHT_NLAY_TO_INTERIOR", nlay_sfc_int, & + call get_param(param_file, mdl, "SLIGHT_NLAY_TO_INTERIOR", nlay_sfc_int, & "The number of layers to offset the surface density when\n"//& "defining where the interior ocean starts with SLight.", & units="nondimensional", default=2.0) - call get_param(param_file, mod, "SLIGHT_FIX_HALOCLINES", fix_haloclines, & + call get_param(param_file, mdl, "SLIGHT_FIX_HALOCLINES", fix_haloclines, & "If true, identify regions above the reference pressure\n"//& "where the reference pressure systematically underestimates\n"//& "the stratification and use this in the definition of the\n"//& @@ -518,11 +518,11 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, nlay_ML_to_interior=nlay_sfc_int, fix_haloclines=fix_haloclines) if (fix_haloclines) then ! Set additional parameters related to SLIGHT_FIX_HALOCLINES. - call get_param(param_file, mod, "HALOCLINE_FILTER_LENGTH", filt_len, & + call get_param(param_file, mdl, "HALOCLINE_FILTER_LENGTH", filt_len, & "A length scale over which to smooth the temperature and\n"//& "salinity before identifying erroneously unstable haloclines.", & units="m", default=2.0) - call get_param(param_file, mod, "HALOCLINE_STRAT_TOL", strat_tol, & + call get_param(param_file, mdl, "HALOCLINE_STRAT_TOL", strat_tol, & "A tolerance for the ratio of the stratification of the\n"//& "apparent coordinate stratification to the actual value\n"//& "that is used to identify erroneously unstable haloclines.\n"//& @@ -535,20 +535,20 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, endif if (coordinateMode(coord_mode) == REGRIDDING_ADAPTIVE) then - call get_param(param_file, mod, "ADAPT_TIME_RATIO", adaptTimeRatio, & + call get_param(param_file, mdl, "ADAPT_TIME_RATIO", adaptTimeRatio, & "Ratio of ALE timestep to grid timescale.", units="s", default=1e-1) !### Should the units be "nondim"? - call get_param(param_file, mod, "ADAPT_ZOOM_DEPTH", adaptZoom, & + call get_param(param_file, mdl, "ADAPT_ZOOM_DEPTH", adaptZoom, & "Depth of near-surface zooming region.", units="m", default=200.0) - call get_param(param_file, mod, "ADAPT_ZOOM_COEFF", adaptZoomCoeff, & + call get_param(param_file, mdl, "ADAPT_ZOOM_COEFF", adaptZoomCoeff, & "Coefficient of near-surface zooming diffusivity.", & units="nondim", default=0.2) - call get_param(param_file, mod, "ADAPT_BUOY_COEFF", adaptBuoyCoeff, & + call get_param(param_file, mdl, "ADAPT_BUOY_COEFF", adaptBuoyCoeff, & "Coefficient of buoyancy diffusivity.", & units="nondim", default=0.8) - call get_param(param_file, mod, "ADAPT_ALPHA", adaptAlpha, & + call get_param(param_file, mdl, "ADAPT_ALPHA", adaptAlpha, & "Scaling on optimization tendency.", & units="nondim", default=1.0) - call get_param(param_file, mod, "ADAPT_DO_MIN_DEPTH", tmpLogical, & + call get_param(param_file, mdl, "ADAPT_DO_MIN_DEPTH", tmpLogical, & "If true, make a HyCOM-like mixed layer by preventing interfaces\n"//& "from being shallower than the depths specified by the regridding coordinate.", & default=.false.) @@ -559,7 +559,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, endif if (main_parameters .and. coord_is_state_dependent) then - call get_param(param_file, mod, "MAXIMUM_INT_DEPTH_CONFIG", string, & + call get_param(param_file, mdl, "MAXIMUM_INT_DEPTH_CONFIG", string, & "Determines how to specify the maximum interface depths.\n"//& "Valid options are:\n"//& " NONE - there are no maximum interface depths\n"//& @@ -575,7 +575,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, if ( trim(string) == "NONE") then ! Do nothing. elseif ( trim(string) == "PARAM") then - call get_param(param_file, mod, "MAXIMUM_INTERFACE_DEPTHS", z_max, & + call get_param(param_file, mdl, "MAXIMUM_INTERFACE_DEPTHS", z_max, & trim(message), units="m", fail_if_missing=.true.) call set_regrid_max_depths(CS, z_max, GV%m_to_H) elseif (index(trim(string),'FILE:')==1) then @@ -586,18 +586,18 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, ! Otherwise assume we should look for the file in INPUTDIR fileName = trim(inputdir) // trim( extractWord(trim(string(6:80)), 1) ) endif - if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Specified file not found: Looking for '"//trim(fileName)//"' ("//trim(string)//")") do_sum = .false. varName = trim( extractWord(trim(string(6:)), 2) ) - if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Specified field not found: Looking for '"//trim(varName)//"' ("//trim(string)//")") if (len_trim(varName)==0) then if (field_exists(fileName,'z_max')) then; varName = 'z_max' elseif (field_exists(fileName,'dz')) then; varName = 'dz' ; do_sum = .true. elseif (field_exists(fileName,'dz_max')) then; varName = 'dz_max' ; do_sum = .true. - else ; call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + else ; call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "MAXIMUM_INT_DEPTHS variable not specified and none could be guessed.") endif endif @@ -607,7 +607,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, else call MOM_read_data(trim(fileName), trim(varName), z_max) endif - call log_param(param_file, mod, "!MAXIMUM_INT_DEPTHS", z_max, & + call log_param(param_file, mdl, "!MAXIMUM_INT_DEPTHS", z_max, & trim(message), units=coordinateUnits(coord_mode)) call set_regrid_max_depths(CS, z_max, GV%m_to_H) elseif (index(trim(string),'FNC1:')==1) then @@ -617,11 +617,11 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, do k=1,nz_fixed_sfc ; dz_max(k) = dz_fixed_sfc ; enddo endif z_max(1) = 0.0 ; do K=1,ke ; z_max(K+1) = z_max(K) + dz_max(K) ; enddo - call log_param(param_file, mod, "!MAXIMUM_INT_DEPTHS", z_max, & + call log_param(param_file, mdl, "!MAXIMUM_INT_DEPTHS", z_max, & trim(message), units=coordinateUnits(coord_mode)) call set_regrid_max_depths(CS, z_max, GV%m_to_H) else - call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Unrecognized MAXIMUM_INT_DEPTH_CONFIG "//trim(string)) endif deallocate(z_max) @@ -629,7 +629,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, ! Optionally specify maximum thicknesses for each layer, enforced by moving ! the interface below a layer downward. - call get_param(param_file, mod, "MAX_LAYER_THICKNESS_CONFIG", string, & + call get_param(param_file, mdl, "MAX_LAYER_THICKNESS_CONFIG", string, & "Determines how to specify the maximum layer thicknesses.\n"//& "Valid options are:\n"//& " NONE - there are no maximum layer thicknesses\n"//& @@ -644,7 +644,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, if ( trim(string) == "NONE") then ! Do nothing. elseif ( trim(string) == "PARAM") then - call get_param(param_file, mod, "MAX_LAYER_THICKNESS", h_max, & + call get_param(param_file, mdl, "MAX_LAYER_THICKNESS", h_max, & trim(message), units="m", fail_if_missing=.true.) call set_regrid_max_thickness(CS, h_max, GV%m_to_H) elseif (index(trim(string),'FILE:')==1) then @@ -655,30 +655,30 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mod, coord_mode, ! Otherwise assume we should look for the file in INPUTDIR fileName = trim(inputdir) // trim( extractWord(trim(string(6:80)), 1) ) endif - if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Specified file not found: Looking for '"//trim(fileName)//"' ("//trim(string)//")") varName = trim( extractWord(trim(string(6:)), 2) ) - if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Specified field not found: Looking for '"//trim(varName)//"' ("//trim(string)//")") if (len_trim(varName)==0) then if (field_exists(fileName,'h_max')) then; varName = 'h_max' elseif (field_exists(fileName,'dz_max')) then; varName = 'dz_max' - else ; call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + else ; call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "MAXIMUM_INT_DEPTHS variable not specified and none could be guessed.") endif endif call MOM_read_data(trim(fileName), trim(varName), h_max) - call log_param(param_file, mod, "!MAX_LAYER_THICKNESS", h_max, & + call log_param(param_file, mdl, "!MAX_LAYER_THICKNESS", h_max, & trim(message), units=coordinateUnits(coord_mode)) call set_regrid_max_thickness(CS, h_max, GV%m_to_H) elseif (index(trim(string),'FNC1:')==1) then call dz_function1( trim(string(6:)), h_max ) - call log_param(param_file, mod, "!MAX_LAYER_THICKNESS", h_max, & + call log_param(param_file, mdl, "!MAX_LAYER_THICKNESS", h_max, & trim(message), units=coordinateUnits(coord_mode)) call set_regrid_max_thickness(CS, h_max, GV%m_to_H) else - call MOM_error(FATAL,trim(mod)//", initialize_regridding: "// & + call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "Unrecognized MAX_LAYER_THICKNESS_CONFIG "//trim(string)) endif deallocate(h_max) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 6fb42e9df0..a4c1787855 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -2190,7 +2190,7 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir) character(len=240), allocatable :: diag_coords(:) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_diag_mediator" ! This module's name. + character(len=40) :: mdl = "MOM_diag_mediator" ! This module's name. id_clock_diag_mediator = cpu_clock_id('(Ocean diagnostics framework)', grain=CLOCK_MODULE) id_clock_diag_remap = cpu_clock_id('(Ocean diagnostics remapping)', grain=CLOCK_ROUTINE) @@ -2204,22 +2204,22 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir) enddo ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") + call log_version(param_file, mdl, version, "") - call get_param(param_file, mod, 'NUM_DIAG_COORDS', diag_cs%num_diag_coords, & + call get_param(param_file, mdl, 'NUM_DIAG_COORDS', diag_cs%num_diag_coords, & 'The number of diagnostic vertical coordinates to use.\n'//& 'For each coordinate, an entry in DIAG_COORDS must be provided.', & default=1) if (diag_cs%num_diag_coords>0) then allocate(diag_coords(diag_cs%num_diag_coords)) if (diag_cs%num_diag_coords==1) then ! The default is to provide just one instance of Z* - call get_param(param_file, mod, 'DIAG_COORDS', diag_coords, & + call get_param(param_file, mdl, 'DIAG_COORDS', diag_coords, & 'A list of string tuples associating diag_table modules to\n'//& 'a coordinate definition used for diagnostics. Each string\n'//& 'is of the form "MODULE_SUFFIX PARAMETER_SUFFIX COORDINATE_NAME".', & default='z Z ZSTAR') else ! If using more than 1 diagnostic coordinate, all must be explicitly defined - call get_param(param_file, mod, 'DIAG_COORDS', diag_coords, & + call get_param(param_file, mdl, 'DIAG_COORDS', diag_coords, & 'A list of string tuples associating diag_table modules to\n'//& 'a coordinate definition used for diagnostics. Each string\n'//& 'is of the form "MODULE_SUFFIX,PARAMETER_SUFFIX,COORDINATE_NAME".', & @@ -2233,10 +2233,10 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir) deallocate(diag_coords) endif - call get_param(param_file, mod, 'DIAG_MISVAL', diag_cs%missing_value, & + call get_param(param_file, mdl, 'DIAG_MISVAL', diag_cs%missing_value, & 'Set the default missing value to use for diagnostics.', & default=1.e20) - call get_param(param_file, mod, 'DIAG_AS_CHKSUM', diag_cs%diag_as_chksum, & + call get_param(param_file, mdl, 'DIAG_AS_CHKSUM', diag_cs%diag_as_chksum, & 'Instead of writing diagnostics to the diag manager, write\n' //& 'a textfile containing the checksum (bitcount) of the array.', & default=.false.) @@ -2263,7 +2263,7 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir) if (is_root_pe() .and. (diag_CS%available_diag_doc_unit < 0)) then write(this_pe,'(i6.6)') PE_here() doc_file_dflt = "available_diags."//this_pe - call get_param(param_file, mod, "AVAILABLE_DIAGS_FILE", doc_file, & + call get_param(param_file, mdl, "AVAILABLE_DIAGS_FILE", doc_file, & "A file into which to write a list of all available \n"//& "ocean diagnostics that can be included in a diag_table.", & default=doc_file_dflt, do_not_log=(diag_CS%available_diag_doc_unit/=-1)) @@ -2301,7 +2301,7 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir) if (is_root_pe() .and. (diag_CS%chksum_diag_doc_unit < 0) .and. diag_CS%diag_as_chksum) then write(this_pe,'(i6.6)') PE_here() doc_file_dflt = "chksum_diag."//this_pe - call get_param(param_file, mod, "CHKSUM_DIAG_FILE", doc_file, & + call get_param(param_file, mdl, "CHKSUM_DIAG_FILE", doc_file, & "A file into which to write all checksums of the \n"//& "diagnostics listed in the diag_table.", & default=doc_file_dflt, do_not_log=(diag_CS%chksum_diag_doc_unit/=-1)) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index b6a77e1fe6..657c243b2c 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -1299,7 +1299,7 @@ subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm, ! This "include" declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_diabatic_aux" ! This module's name. + character(len=40) :: mdl = "MOM_diabatic_aux" ! This module's name. character(len=48) :: thickness_units integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, nbands isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke @@ -1316,15 +1316,15 @@ subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm, CS%diag => diag ! Set default, read and log parameters - call log_version(param_file, mod, version, & + call log_version(param_file, mdl, version, & "The following parameters are used for auxiliary diabatic processes.") - call get_param(param_file, mod, "RECLAIM_FRAZIL", CS%reclaim_frazil, & + call get_param(param_file, mdl, "RECLAIM_FRAZIL", CS%reclaim_frazil, & "If true, try to use any frazil heat deficit to cool any\n"//& "overlying layers down to the freezing point, thereby \n"//& "avoiding the creation of thin ice when the SST is above \n"//& "the freezing point.", default=.true.) - call get_param(param_file, mod, "PRESSURE_DEPENDENT_FRAZIL", & + call get_param(param_file, mdl, "PRESSURE_DEPENDENT_FRAZIL", & CS%pressure_dependent_frazil, & "If true, use a pressure dependent freezing temperature \n"//& "when making frazil. The default is false, which will be \n"//& @@ -1332,27 +1332,27 @@ subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm, default=.false.) if (use_ePBL) then - call get_param(param_file, mod, "IGNORE_FLUXES_OVER_LAND", CS%ignore_fluxes_over_land,& + call get_param(param_file, mdl, "IGNORE_FLUXES_OVER_LAND", CS%ignore_fluxes_over_land,& "If true, the model does not check if fluxes are being applied\n"//& "over land points. This is needed when the ocean is coupled \n"//& "with ice shelves and sea ice, since the sea ice mask needs to \n"//& "be different than the ocean mask to avoid sea ice formation \n"//& "under ice shelves. This flag only works when use_ePBL = True.", default=.false.) - call get_param(param_file, mod, "DO_RIVERMIX", CS%do_rivermix, & + call get_param(param_file, mdl, "DO_RIVERMIX", CS%do_rivermix, & "If true, apply additional mixing whereever there is \n"//& "runoff, so that it is mixed down to RIVERMIX_DEPTH \n"//& "if the ocean is that deep.", default=.false.) if (CS%do_rivermix) & - call get_param(param_file, mod, "RIVERMIX_DEPTH", CS%rivermix_depth, & + call get_param(param_file, mdl, "RIVERMIX_DEPTH", CS%rivermix_depth, & "The depth to which rivers are mixed if DO_RIVERMIX is \n"//& "defined.", units="m", default=0.0) else ; CS%do_rivermix = .false. ; CS%rivermix_depth = 0.0 ; endif if (GV%nkml == 0) then - call get_param(param_file, mod, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, & + call get_param(param_file, mdl, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, & "If true, use the fluxes%runoff_Hflx field to set the \n"//& "heat carried by runoff, instead of using SST*CP*liq_runoff.", & default=.false.) - call get_param(param_file, mod, "USE_CALVING_HEAT_CONTENT", CS%use_calving_heat_content, & + call get_param(param_file, mdl, "USE_CALVING_HEAT_CONTENT", CS%use_calving_heat_content, & "If true, use the fluxes%calving_Hflx field to set the \n"//& "heat carried by runoff, instead of using SST*CP*froz_runoff.", & default=.false.) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 90e9c5a504..b294bbc64b 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -2724,7 +2724,7 @@ subroutine adiabatic_driver_init(Time, G, param_file, diag, CS, & ! This "include" declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_diabatic_driver" ! This module's name. + character(len=40) :: mdl = "MOM_diabatic_driver" ! This module's name. if (associated(CS)) then call MOM_error(WARNING, "adiabatic_driver_init called with an "// & @@ -2737,7 +2737,7 @@ subroutine adiabatic_driver_init(Time, G, param_file, diag, CS, & if (associated(diag_to_Z_CSp)) CS%diag_to_Z_CSp => diag_to_Z_CSp ! Set default, read and log parameters - call log_version(param_file, mod, version, & + call log_version(param_file, mdl, version, & "The following parameters are used for diabatic processes.") end subroutine adiabatic_driver_init @@ -2770,7 +2770,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, ! This "include" declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_diabatic_driver" ! This module's name. + character(len=40) :: mdl = "MOM_diabatic_driver" ! This module's name. character(len=48) :: thickness_units character(len=40) :: var_name character(len=160) :: var_descript @@ -2798,25 +2798,25 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, CS%bulkmixedlayer = (GV%nkml > 0) ! Set default, read and log parameters - call log_version(param_file, mod, version, & + call log_version(param_file, mdl, version, & "The following parameters are used for diabatic processes.") - call get_param(param_file, mod, "SPONGE", CS%use_sponge, & + call get_param(param_file, mdl, "SPONGE", CS%use_sponge, & "If true, sponges may be applied anywhere in the domain. \n"//& "The exact location and properties of those sponges are \n"//& "specified via calls to initialize_sponge and possibly \n"//& "set_up_sponge_field.", default=.false.) - call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", use_temperature, & + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", use_temperature, & "If true, temperature and salinity are used as state \n"//& "variables.", default=.true.) - call get_param(param_file, mod, "ENERGETICS_SFC_PBL", CS%use_energetic_PBL, & + call get_param(param_file, mdl, "ENERGETICS_SFC_PBL", CS%use_energetic_PBL, & "If true, use an implied energetics planetary boundary \n"//& "layer scheme to determine the diffusivity and viscosity \n"//& "in the surface boundary layer.", default=.false.) - call get_param(param_file, mod, "EPBL_IS_ADDITIVE", CS%ePBL_is_additive, & + call get_param(param_file, mdl, "EPBL_IS_ADDITIVE", CS%ePBL_is_additive, & "If true, the diffusivity from ePBL is added to all\n"//& "other diffusivities. Otherwise, the larger of kappa-\n"//& "shear and ePBL diffusivities are used.", default=.true.) - call get_param(param_file, mod, "DOUBLE_DIFFUSION", differentialDiffusion, & + call get_param(param_file, mdl, "DOUBLE_DIFFUSION", differentialDiffusion, & "If true, apply parameterization of double-diffusion.", & default=.false. ) @@ -2832,55 +2832,55 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, CS%use_CVMix_shear = CVMix_shear_is_used(param_file) if (CS%bulkmixedlayer) then - call get_param(param_file, mod, "ML_MIX_FIRST", CS%ML_mix_first, & + call get_param(param_file, mdl, "ML_MIX_FIRST", CS%ML_mix_first, & "The fraction of the mixed layer mixing that is applied \n"//& "before interior diapycnal mixing. 0 by default.", & units="nondim", default=0.0) - call get_param(param_file, mod, "NKBL", CS%nkbl, default=2, do_not_log=.true.) + call get_param(param_file, mdl, "NKBL", CS%nkbl, default=2, do_not_log=.true.) else CS%ML_mix_first = 0.0 endif if (use_temperature) then - call get_param(param_file, mod, "DO_GEOTHERMAL", CS%use_geothermal, & + call get_param(param_file, mdl, "DO_GEOTHERMAL", CS%use_geothermal, & "If true, apply geothermal heating.", default=.false.) else CS%use_geothermal = .false. endif - call get_param(param_file, mod, "INTERNAL_TIDES", CS%use_int_tides, & + call get_param(param_file, mdl, "INTERNAL_TIDES", CS%use_int_tides, & "If true, use the code that advances a separate set of \n"//& "equations for the internal tide energy density.", default=.false.) CS%nMode = 1 if (CS%use_int_tides) then ! SET NUMBER OF MODES TO CONSIDER - call get_param(param_file, mod, "INTERNAL_TIDE_MODES", CS%nMode, & + call get_param(param_file, mdl, "INTERNAL_TIDE_MODES", CS%nMode, & "The number of distinct internal tide modes \n"//& "that will be calculated.", default=1, do_not_log=.true.) ! The following parameters are used in testing the internal tide code. ! GET LOCATION AND DURATION OF ENERGY POINT SOURCE FOR TESTING (BDM) - call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_TEST", CS%int_tide_source_test, & + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TEST", CS%int_tide_source_test, & "If true, apply an arbitrary generation site for internal tide testing", & default=.false.) if (CS%int_tide_source_test)then - call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & "X Location of generation site for internal tide", default=1.) - call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & "Y Location of generation site for internal tide", default=1.) - call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_TLEN_DAYS", CS%tlen_days, & + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TLEN_DAYS", CS%tlen_days, & "Time interval from start of experiment for adding wave source", & units="days", default=0) CS%time_max_source = increment_time(Time,0,days=CS%tlen_days) endif ! GET UNIFORM MODE VELOCITY FOR TESTING (BDM) - call get_param(param_file, mod, "UNIFORM_CG", CS%uniform_cg, & + call get_param(param_file, mdl, "UNIFORM_CG", CS%uniform_cg, & "If true, set cg = cg_test everywhere for test case", default=.false.) if (CS%uniform_cg)then - call get_param(param_file, mod, "CG_TEST", CS%cg_test, & + call get_param(param_file, mdl, "CG_TEST", CS%cg_test, & "Uniform group velocity of internal tide for test case", default=1.) endif endif - call get_param(param_file, mod, "MASSLESS_MATCH_TARGETS", & + call get_param(param_file, mdl, "MASSLESS_MATCH_TARGETS", & CS%massless_match_targets, & "If true, the temperature and salinity of massless layers \n"//& "are kept consistent with their target densities. \n"//& @@ -2888,7 +2888,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, "diffusively to match massive neighboring layers.", & default=.true.) - call get_param(param_file, mod, "AGGREGATE_FW_FORCING", CS%aggregate_FW_forcing, & + call get_param(param_file, mdl, "AGGREGATE_FW_FORCING", CS%aggregate_FW_forcing, & "If true, the net incoming and outgoing fresh water fluxes are combined\n"//& "and applied as either incoming or outgoing depending on the sign of the net.\n"//& "If false, the net incoming fresh water flux is added to the model and\n"//& @@ -2896,44 +2896,44 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, "into the first non-vanished layer for which the column remains stable", & default=.true.) - call get_param(param_file, mod, "DEBUG", CS%debug, & + call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & default=.false., debuggingParam=.true.) - call get_param(param_file, mod, "DEBUG_CONSERVATION", CS%debugConservation, & + call get_param(param_file, mdl, "DEBUG_CONSERVATION", CS%debugConservation, & "If true, monitor conservation and extrema.", & default=.false., debuggingParam=.true.) - call get_param(param_file, mod, "DEBUG_ENERGY_REQ", CS%debug_energy_req, & + call get_param(param_file, mdl, "DEBUG_ENERGY_REQ", CS%debug_energy_req, & "If true, debug the energy requirements.", default=.false., do_not_log=.true.) - call get_param(param_file, mod, "MIX_BOUNDARY_TRACERS", CS%mix_boundary_tracers, & + call get_param(param_file, mdl, "MIX_BOUNDARY_TRACERS", CS%mix_boundary_tracers, & "If true, mix the passive tracers in massless layers at \n"//& "the bottom into the interior as though a diffusivity of \n"//& "KD_MIN_TR were operating.", default=.true.) if (CS%mix_boundary_tracers) then - call get_param(param_file, mod, "KD", Kd, fail_if_missing=.true.) - call get_param(param_file, mod, "KD_MIN_TR", CS%Kd_min_tr, & + call get_param(param_file, mdl, "KD", Kd, fail_if_missing=.true.) + call get_param(param_file, mdl, "KD_MIN_TR", CS%Kd_min_tr, & "A minimal diffusivity that should always be applied to \n"//& "tracers, especially in massless layers near the bottom. \n"//& "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd) - call get_param(param_file, mod, "KD_BBL_TR", CS%Kd_BBL_tr, & + call get_param(param_file, mdl, "KD_BBL_TR", CS%Kd_BBL_tr, & "A bottom boundary layer tracer diffusivity that will \n"//& "allow for explicitly specified bottom fluxes. The \n"//& "entrainment at the bottom is at least sqrt(Kd_BBL_tr*dt) \n"//& "over the same distance.", units="m2 s-1", default=0.) endif - call get_param(param_file, mod, "TRACER_TRIDIAG", CS%tracer_tridiag, & + call get_param(param_file, mdl, "TRACER_TRIDIAG", CS%tracer_tridiag, & "If true, use the passive tracer tridiagonal solver for T and S\n", & default=.false.) - call get_param(param_file, mod, "MINIMUM_FORCING_DEPTH", CS%minimum_forcing_depth, & + call get_param(param_file, mdl, "MINIMUM_FORCING_DEPTH", CS%minimum_forcing_depth, & "The smallest depth over which forcing can be applied. This\n"//& "only takes effect when near-surface layers become thin\n"//& "relative to this scale, in which case the forcing tendencies\n"//& "scaled down by distributing the forcing over this depth scale.", & units="m", default=0.001) - call get_param(param_file, mod, "EVAP_CFL_LIMIT", CS%evap_CFL_limit, & + call get_param(param_file, mdl, "EVAP_CFL_LIMIT", CS%evap_CFL_limit, & "The largest fraction of a layer than can be lost to forcing\n"//& "(e.g. evaporation, sea-ice formation) in one time-step. The unused\n"//& "mass loss is passed down through the column.", & @@ -3000,7 +3000,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, 'Squared buoyancy frequency below mixed layer', 's-2') CS%id_MLD_user = register_diag_field('ocean_model','MLD_user',diag%axesT1,Time, & 'Mixed layer depth (used defined)', 'm') - call get_param(param_file, mod, "DIAG_MLD_DENSITY_DIFF", CS%MLDdensityDifference, & + call get_param(param_file, mdl, "DIAG_MLD_DENSITY_DIFF", CS%MLDdensityDifference, & "The density difference used to determine a diagnostic mixed\n"//& "layer depth, MLD_user, following the definition of Levitus 1982. \n"//& "The MLD is the depth at which the density is larger than the\n"//& @@ -3087,7 +3087,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, 'set DOUBLE_DIFFUSION=False and USE_CVMIX_DDIFF=True.') endif - call get_param(param_file, mod, "SALT_REJECT_BELOW_ML", CS%salt_reject_below_ML, & + call get_param(param_file, mdl, "SALT_REJECT_BELOW_ML", CS%salt_reject_below_ML, & "If true, place salt from brine rejection below the mixed layer,\n"// & "into the first non-vanished layer for which the column remains stable", & default=.false.) @@ -3322,7 +3322,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, ! obtain information about the number of bands for penetrative shortwave if (use_temperature) then - call get_param(param_file, mod, "PEN_SW_NBANDS", nbands, default=1) + call get_param(param_file, mdl, "PEN_SW_NBANDS", nbands, default=1) if (nbands > 0) then allocate(CS%optics) call opacity_init(Time, G, param_file, diag, CS%tracer_flow_CSp, CS%opacity_CSp, CS%optics) diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index df3783fa32..95a43c8a3c 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -2157,7 +2157,7 @@ subroutine entrain_diffusive_init(Time, G, GV, param_file, diag, CS) real :: decay_length, dt, Kd ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_entrain_diffusive" ! This module's name. + character(len=40) :: mdl = "MOM_entrain_diffusive" ! This module's name. if (associated(CS)) then call MOM_error(WARNING, "entrain_diffusive_init called with an associated "// & @@ -2171,22 +2171,22 @@ subroutine entrain_diffusive_init(Time, G, GV, param_file, diag, CS) CS%bulkmixedlayer = (GV%nkml > 0) ! Set default, read and log parameters - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "CORRECT_DENSITY", CS%correct_density, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "CORRECT_DENSITY", CS%correct_density, & "If true, and USE_EOS is true, the layer densities are \n"//& "restored toward their target values by the diapycnal \n"//& "mixing, as described in Hallberg (MWR, 2000).", & default=.true.) - call get_param(param_file, mod, "MAX_ENT_IT", CS%max_ent_it, & + call get_param(param_file, mdl, "MAX_ENT_IT", CS%max_ent_it, & "The maximum number of iterations that may be used to \n"//& "calculate the interior diapycnal entrainment.", default=5) ! In this module, KD is only used to set the default for TOLERANCE_ENT. (m2 s-1) - call get_param(param_file, mod, "KD", Kd, fail_if_missing=.true.) - call get_param(param_file, mod, "DT", dt, & + call get_param(param_file, mdl, "KD", Kd, fail_if_missing=.true.) + call get_param(param_file, mdl, "DT", dt, & "The (baroclinic) dynamics time step.", units = "s", & fail_if_missing=.true.) ! CS%Tolerance_Ent = MAX(100.0*GV%Angstrom_H,1.0e-4*sqrt(dt*Kd)) ! - call get_param(param_file, mod, "TOLERANCE_ENT", CS%Tolerance_Ent, & + call get_param(param_file, mdl, "TOLERANCE_ENT", CS%Tolerance_Ent, & "The tolerance with which to solve for entrainment values.", & units="m", default=MAX(100.0*GV%Angstrom_m,1.0e-4*sqrt(dt*Kd))) diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index 5e0e7f0af0..76d028c6f4 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -37,7 +37,7 @@ subroutine Neverland_initialize_topography(D, G, param_file, max_depth) real :: x, y ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "Neverland_initialize_topography" ! This subroutine's name. + character(len=40) :: mdl = "Neverland_initialize_topography" ! This subroutine's name. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed real :: nl_roughness_amp is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -45,8 +45,8 @@ subroutine Neverland_initialize_topography(D, G, param_file, max_depth) call MOM_mesg(" Neverland_initialization.F90, Neverland_initialize_topography: setting topography", 5) - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "NL_ROUGHNESS_AMP", nl_roughness_amp, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "NL_ROUGHNESS_AMP", nl_roughness_amp, & "Amplitude of wavy signal in bathymetry.", default=0.05) PI = 4.0*atan(1.0) @@ -119,13 +119,13 @@ subroutine Neverland_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ ! usually negative because it is positive upward. real, dimension(SZK_(G)) :: h_profile ! Vector of initial thickness profile (Z) real :: e_interface ! Current interface position (m) - character(len=40) :: mod = "Neverland_initialize_thickness" ! This subroutine's name. + character(len=40) :: mdl = "Neverland_initialize_thickness" ! This subroutine's name. integer :: i, j, k, k1, is, ie, js, je, nz, itt is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke call MOM_mesg(" Neverland_initialization.F90, Neverland_initialize_thickness: setting thickness", 5) - call get_param(param_file, mod, "INIT_THICKNESS_PROFILE", h_profile, & + call get_param(param_file, mdl, "INIT_THICKNESS_PROFILE", h_profile, & "Profile of initial layer thicknesses.", units="m", scale=GV%m_to_Z, & fail_if_missing=.true.) From 0c9b40959de364dc7e01ec0774992c8485a8c6d3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 22 Sep 2018 21:07:52 -0400 Subject: [PATCH 0738/1072] Changed the units of a_u to Z Changed the units for the viscous coupling coefficients between layers from m to Z, to expand the automated testing of dimensional consistency.` Also changed variables names to reflect their new use and to avoid the use of a single character name to help in searches. All answers are bitwise identical. --- .../vertical/MOM_vert_friction.F90 | 224 +++++++++--------- 1 file changed, 110 insertions(+), 114 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index a19ec5c215..92d1d79b4e 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -60,11 +60,11 @@ module MOM_vert_friction type(time_type) :: rampStartTime !< The time at which the ramping of CFL_trunc starts real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) :: & - a_u !< The u-drag coefficient across an interface, in m s-1. + a_u !< The u-drag coefficient across an interface, in Z s-1. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & h_u !< The effective layer thickness at u-points, m or kg m-2. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) :: & - a_v !< The v-drag coefficient across an interface, in m s-1. + a_v !< The v-drag coefficient across an interface, in Z s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & h_v !< The effective layer thickness at v-points, m or kg m-2. real, pointer, dimension(:,:) :: a1_shelf_u => NULL() !< The u-momentum coupling coefficient under @@ -172,7 +172,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. c1 is nondimensional, ! while b1 has units of inverse thickness. real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver, ND. - real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity in m s-1 + real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity in Z s-1 real :: b_denom_1 ! The first term in the denominator of b1, in H. real :: Hmix ! The mixed layer thickness over which stress @@ -184,7 +184,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & ! density, in s m3 kg-1. real :: Rho0 ! A density used to convert drag laws into stress in ! Pa, in kg m-3. - real :: dt_m_to_H ! The time step times the conversion from m to the + real :: dt_Z_to_H ! The time step times the conversion from Z to the ! units of thickness - either s or s m3 kg-1. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in m or kg m-2. @@ -211,7 +211,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & I_Hmix = 1.0 / Hmix endif dt_Rho0 = dt/GV%H_to_kg_m2 - dt_m_to_H = dt*GV%m_to_H + dt_Z_to_H = dt*GV%Z_to_H Rho0 = GV%Rho0 h_neglect = GV%H_subroundoff Idt = 1.0 / dt @@ -265,7 +265,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & enddo ; endif ! direct_stress if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq - Ray(I,k) = visc%Ray_u(I,j,k) + Ray(I,k) = GV%m_to_Z*visc%Ray_u(I,j,k) enddo ; enddo ; endif ! perform forward elimination on the tridiagonal system @@ -274,9 +274,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & ! and the superdiagonal as c_k. The right-hand side terms are d_k. ! ! ignoring the rayleigh drag contribution, - ! we have a_k = -dt_m_to_H * a_u(k) - ! b_k = h_u(k) + dt_m_to_H * (a_u(k) + a_u(k+1)) - ! c_k = -dt_m_to_H * a_u(k+1) + ! we have a_k = -dt_Z_to_H * a_u(k) + ! b_k = h_u(k) + dt_Z_to_H * (a_u(k) + a_u(k+1)) + ! c_k = -dt_Z_to_H * a_u(k+1) ! ! for forward elimination, we want to: ! calculate c'_k = - c_k / (b_k + a_k c'_(k-1)) @@ -292,18 +292,18 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & ! and the right-hand-side is destructively updated to be d'_k ! do I=Isq,Ieq ; if (do_i(I)) then - b_denom_1 = CS%h_u(I,j,1) + dt_m_to_H * (Ray(I,1) + CS%a_u(I,j,1)) - b1(I) = 1.0 / (b_denom_1 + dt_m_to_H*CS%a_u(I,j,2)) + b_denom_1 = CS%h_u(I,j,1) + dt_Z_to_H * (Ray(I,1) + CS%a_u(I,j,1)) + b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_u(I,j,2)) d1(I) = b_denom_1 * b1(I) u(I,j,1) = b1(I) * (CS%h_u(I,j,1) * u(I,j,1) + surface_stress(I)) endif ; enddo do k=2,nz ; do I=Isq,Ieq ; if (do_i(I)) then - c1(I,k) = dt_m_to_H * CS%a_u(I,j,K) * b1(I) - b_denom_1 = CS%h_u(I,j,k) + dt_m_to_H * (Ray(I,k) + CS%a_u(I,j,K)*d1(I)) - b1(I) = 1.0 / (b_denom_1 + dt_m_to_H * CS%a_u(I,j,K+1)) + c1(I,k) = dt_Z_to_H * CS%a_u(I,j,K) * b1(I) + b_denom_1 = CS%h_u(I,j,k) + dt_Z_to_H * (Ray(I,k) + CS%a_u(I,j,K)*d1(I)) + b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_u(I,j,K+1)) d1(I) = b_denom_1 * b1(I) u(I,j,k) = (CS%h_u(I,j,k) * u(I,j,k) + & - dt_m_to_H * CS%a_u(I,j,K) * u(I,j,k-1)) * b1(I) + dt_Z_to_H * CS%a_u(I,j,K) * u(I,j,k-1)) * b1(I) endif ; enddo ; enddo ! back substitute to solve for the new velocities @@ -373,22 +373,21 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & enddo ; endif ! direct_stress if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie - Ray(i,k) = visc%Ray_v(i,J,k) + Ray(i,k) = GV%m_to_Z*visc%Ray_v(i,J,k) enddo ; enddo ; endif do i=is,ie ; if (do_i(i)) then - b_denom_1 = CS%h_v(i,J,1) + dt_m_to_H * (Ray(i,1) + CS%a_v(i,J,1)) - b1(i) = 1.0 / (b_denom_1 + dt_m_to_H*CS%a_v(i,J,2)) + b_denom_1 = CS%h_v(i,J,1) + dt_Z_to_H * (Ray(i,1) + CS%a_v(i,J,1)) + b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_v(i,J,2)) d1(i) = b_denom_1 * b1(i) v(i,J,1) = b1(i) * (CS%h_v(i,J,1) * v(i,J,1) + surface_stress(i)) endif ; enddo do k=2,nz ; do i=is,ie ; if (do_i(i)) then - c1(i,k) = dt_m_to_H * CS%a_v(i,J,K) * b1(i) - b_denom_1 = CS%h_v(i,J,k) + dt_m_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) - b1(i) = 1.0 / (b_denom_1 + dt_m_to_H * CS%a_v(i,J,K+1)) + c1(i,k) = dt_Z_to_H * CS%a_v(i,J,K) * b1(i) + b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) + b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v(i,J,K+1)) d1(i) = b_denom_1 * b1(i) - v(i,J,k) = (CS%h_v(i,J,k) * v(i,J,k) + dt_m_to_H * & - CS%a_v(i,J,K) * v(i,J,k-1)) * b1(i) + v(i,J,k) = (CS%h_v(i,J,k) * v(i,J,k) + dt_Z_to_H * CS%a_v(i,J,K) * v(i,J,k-1)) * b1(i) endif ; enddo ; enddo do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then v(i,J,k) = v(i,J,k) + c1(i,k+1) * v(i,J,k+1) @@ -479,7 +478,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity times the ! time step, in m. real :: b_denom_1 ! The first term in the denominator of b1, in m or kg m-2. - real :: dt_m_to_H ! The time step times the conversion from m to the + real :: dt_Z_to_H ! The time step times the conversion from Z to the ! units of thickness - either s or s m3 kg-1. logical :: do_i(SZIB_(G)) @@ -490,33 +489,33 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(visc): "// & "Module must be initialized before it is used.") - dt_m_to_H = dt*GV%m_to_H + dt_Z_to_H = dt*GV%Z_to_H do k=1,nz ; do i=Isq,Ieq ; Ray(i,k) = 0.0 ; enddo ; enddo ! Find the zonal viscous using a modification of a standard tridagonal solver. -!$OMP parallel do default(none) shared(G,Isq,Ieq,CS,nz,visc,dt_m_to_H,visc_rem_u) & +!$OMP parallel do default(none) shared(G,Isq,Ieq,CS,nz,visc,dt_Z_to_H,visc_rem_u) & !$OMP firstprivate(Ray) & !$OMP private(do_i,b_denom_1,b1,d1,c1) do j=G%jsc,G%jec do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq - Ray(I,k) = visc%Ray_u(I,j,k) + Ray(I,k) = GV%m_to_Z*visc%Ray_u(I,j,k) enddo ; enddo ; endif do I=Isq,Ieq ; if (do_i(I)) then - b_denom_1 = CS%h_u(I,j,1) + dt_m_to_H * (Ray(I,1) + CS%a_u(I,j,1)) - b1(I) = 1.0 / (b_denom_1 + dt_m_to_H*CS%a_u(I,j,2)) + b_denom_1 = CS%h_u(I,j,1) + dt_Z_to_H * (Ray(I,1) + CS%a_u(I,j,1)) + b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_u(I,j,2)) d1(I) = b_denom_1 * b1(I) visc_rem_u(I,j,1) = b1(I) * CS%h_u(I,j,1) endif ; enddo do k=2,nz ; do I=Isq,Ieq ; if (do_i(I)) then - c1(I,k) = dt_m_to_H * CS%a_u(I,j,K)*b1(I) - b_denom_1 = CS%h_u(I,j,k) + dt_m_to_H * (Ray(I,k) + CS%a_u(I,j,K)*d1(I)) - b1(I) = 1.0 / (b_denom_1 + dt_m_to_H * CS%a_u(I,j,K+1)) + c1(I,k) = dt_Z_to_H * CS%a_u(I,j,K)*b1(I) + b_denom_1 = CS%h_u(I,j,k) + dt_Z_to_H * (Ray(I,k) + CS%a_u(I,j,K)*d1(I)) + b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_u(I,j,K+1)) d1(I) = b_denom_1 * b1(I) - visc_rem_u(I,j,k) = (CS%h_u(I,j,k) + dt_m_to_H * CS%a_u(I,j,K) * visc_rem_u(I,j,k-1)) * b1(I) + visc_rem_u(I,j,k) = (CS%h_u(I,j,k) + dt_Z_to_H * CS%a_u(I,j,K) * visc_rem_u(I,j,k-1)) * b1(I) endif ; enddo ; enddo do k=nz-1,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then visc_rem_u(I,j,k) = visc_rem_u(I,j,k) + c1(I,k+1)*visc_rem_u(I,j,k+1) @@ -526,28 +525,28 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) enddo ! end u-component j loop ! Now find the meridional viscous using a modification. -!$OMP parallel do default(none) shared(Jsq,Jeq,is,ie,G,CS,visc,dt_m_to_H,visc_rem_v,nz) & +!$OMP parallel do default(none) shared(Jsq,Jeq,is,ie,G,CS,visc,dt_Z_to_H,visc_rem_v,nz) & !$OMP firstprivate(Ray) & !$OMP private(do_i,b_denom_1,b1,d1,c1) do J=Jsq,Jeq do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0) ; enddo if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie - Ray(i,k) = visc%Ray_v(i,J,k) + Ray(i,k) = GV%m_to_Z*visc%Ray_v(i,J,k) enddo ; enddo ; endif do i=is,ie ; if (do_i(i)) then - b_denom_1 = CS%h_v(i,J,1) + dt_m_to_H * (Ray(i,1) + CS%a_v(i,J,1)) - b1(i) = 1.0 / (b_denom_1 + dt_m_to_H*CS%a_v(i,J,2)) + b_denom_1 = CS%h_v(i,J,1) + dt_Z_to_H * (Ray(i,1) + CS%a_v(i,J,1)) + b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_v(i,J,2)) d1(i) = b_denom_1 * b1(i) visc_rem_v(i,J,1) = b1(i) * CS%h_v(i,J,1) endif ; enddo do k=2,nz ; do i=is,ie ; if (do_i(i)) then - c1(i,k) = dt_m_to_H * CS%a_v(i,J,K)*b1(i) - b_denom_1 = CS%h_v(i,J,k) + dt_m_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) - b1(i) = 1.0 / (b_denom_1 + dt_m_to_H * CS%a_v(i,J,K+1)) + c1(i,k) = dt_Z_to_H * CS%a_v(i,J,K)*b1(i) + b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) + b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v(i,J,K+1)) d1(i) = b_denom_1 * b1(i) - visc_rem_v(i,J,k) = (CS%h_v(i,J,k) + dt_m_to_H * CS%a_v(i,J,K) * visc_rem_v(i,J,k-1)) * b1(i) + visc_rem_v(i,J,k) = (CS%h_v(i,J,k) + dt_Z_to_H * CS%a_v(i,J,K) * visc_rem_v(i,J,k-1)) * b1(i) endif ; enddo ; enddo do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then visc_rem_v(i,J,k) = visc_rem_v(i,J,k) + c1(i,k+1)*visc_rem_v(i,J,k+1) @@ -593,10 +592,10 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) hvel, & ! hvel is the thickness used at a velocity grid point, in H. hvel_shelf ! The equivalent of hvel under shelves, in H. real, dimension(SZIB_(G),SZK_(G)+1) :: & - a, & ! The drag coefficients across interfaces, in m s-1. a times + a_cpl, & ! The drag coefficients across interfaces, in Z s-1. a_cpl times ! the velocity difference gives the stress across an interface. a_shelf, & ! The drag coefficients across interfaces in water columns under - ! ice shelves, in m s-1. + ! ice shelves, in Z s-1. z_i ! An estimate of each interface's height above the bottom, ! normalized by the bottom boundary layer thickness, nondim. real, dimension(SZIB_(G)) :: & @@ -628,7 +627,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) real :: z_clear ! The clearance of an interface above the surrounding topography, in H. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. - real :: H_to_m, m_to_H ! Unit conversion factors. + real :: m_to_H ! Unit conversion factors. real :: I_valBL ! The inverse of a scaling factor determining when water is ! still within the boundary layer, as determined by the sum @@ -646,7 +645,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) "Module must be initialized before it is used.") h_neglect = GV%H_subroundoff - H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H + m_to_H = GV%m_to_H I_Hbbl(:) = 1.0 / (CS%Hbbl * GV%m_to_H + h_neglect) I_valBL = 0.0 ; if (CS%harm_BL_val > 0.0) I_valBL = 1.0 / CS%harm_BL_val @@ -674,9 +673,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) allocate(CS%a1_shelf_v(G%isd:G%ied,G%JsdB:G%JedB)) ; CS%a1_shelf_v(:,:)=0.0 endif - !$OMP parallel do default(private) shared(G,GV,CS,visc,Isq,ieq,nz,u,h,forces,hML_u, & - !$OMP OBC,h_neglect,dt,m_to_H,I_valBL,Kv_u) & - !$OMP firstprivate(i_hbbl) + !$OMP parallel do default(shared) firstprivate(i_hbbl) do j=G%Jsc,G%Jec do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo @@ -757,7 +754,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) enddo ! k loop endif - call find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & + call find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & dt, j, G, GV, CS, visc, forces, work_on_u=.true., OBC=OBC) if (allocated(hML_u)) then do i=isq,ieq ; if (do_i(i)) then ; hML_u(I,j) = h_ml(I) ; endif ; enddo @@ -811,12 +808,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) if (do_any_shelf) then do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i_shelf(I)) then CS%a_u(I,j,K) = forces%frac_shelf_u(I,j) * a_shelf(I,K) + & - (1.0-forces%frac_shelf_u(I,j)) * a(I,K) + (1.0-forces%frac_shelf_u(I,j)) * a_cpl(I,K) ! This is Alistair's suggestion, but it destabilizes the model. I do not know why. RWH -! CS%a_u(I,j,K) = forces%frac_shelf_u(I,j) * max(a_shelf(I,K), a(I,K)) + & -! (1.0-forces%frac_shelf_u(I,j)) * a(I,K) +! CS%a_u(I,j,K) = forces%frac_shelf_u(I,j) * max(a_shelf(I,K), a_cpl(I,K)) + & +! (1.0-forces%frac_shelf_u(I,j)) * a_cpl(I,K) elseif (do_i(I)) then - CS%a_u(I,j,K) = a(I,K) + CS%a_u(I,j,K) = a_cpl(I,K) endif ; enddo ; enddo do k=1,nz ; do I=Isq,Ieq ; if (do_i_shelf(I)) then ! Should we instead take the inverse of the average of the inverses? @@ -826,14 +823,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) CS%h_u(I,j,k) = hvel(I,k) endif ; enddo ; enddo else - do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) CS%a_u(I,j,K) = a(I,K) ; enddo ; enddo + do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) CS%a_u(I,j,K) = a_cpl(I,K) ; enddo ; enddo do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) CS%h_u(I,j,k) = hvel(I,k) ; enddo ; enddo endif ! Diagnose total Kv at u-points if (CS%id_Kv_u > 0) then do k=1,nz ; do I=Isq,Ieq - if (do_i(I)) Kv_u(I,j,k) = 0.5 * (CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k) + if (do_i(I)) Kv_u(I,j,k) = 0.5 * GV%Z_to_m*(CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k) enddo ; enddo endif @@ -926,7 +923,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) endif ; enddo ; enddo ! i & k loops endif - call find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & + call find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & dt, j, G, GV, CS, visc, forces, work_on_u=.false., OBC=OBC) if ( allocated(hML_v)) then do i=is,ie ; if (do_i(i)) then ; hML_v(i,J) = h_ml(i) ; endif ; enddo @@ -979,12 +976,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) if (do_any_shelf) then do K=1,nz+1 ; do i=is,ie ; if (do_i_shelf(i)) then CS%a_v(i,J,K) = forces%frac_shelf_v(i,J) * a_shelf(i,k) + & - (1.0-forces%frac_shelf_v(i,J)) * a(i,K) + (1.0-forces%frac_shelf_v(i,J)) * a_cpl(i,K) ! This is Alistair's suggestion, but it destabilizes the model. I do not know why. RWH -! CS%a_v(i,J,K) = forces%frac_shelf_v(i,J) * max(a_shelf(i,K), a(i,K)) + & -! (1.0-forces%frac_shelf_v(i,J)) * a(i,K) +! CS%a_v(i,J,K) = forces%frac_shelf_v(i,J) * max(a_shelf(i,K), a_cpl(i,K)) + & +! (1.0-forces%frac_shelf_v(i,J)) * a_cpl(i,K) elseif (do_i(i)) then - CS%a_v(i,J,K) = a(i,K) + CS%a_v(i,J,K) = a_cpl(i,K) endif ; enddo ; enddo do k=1,nz ; do i=is,ie ; if (do_i_shelf(i)) then ! Should we instead take the inverse of the average of the inverses? @@ -994,14 +991,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) CS%h_v(i,J,k) = hvel(i,k) endif ; enddo ; enddo else - do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) CS%a_v(i,J,K) = a(i,K) ; enddo ; enddo + do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) CS%a_v(i,J,K) = a_cpl(i,K) ; enddo ; enddo do k=1,nz ; do i=is,ie ; if (do_i(i)) CS%h_v(i,J,k) = hvel(i,k) ; enddo ; enddo endif ! Diagnose total Kv at v-points if (CS%id_Kv_v > 0) then do k=1,nz ; do i=is,ie - if (do_i(I)) Kv_v(i,J,k) = 0.5 * (CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k) + if (do_i(I)) Kv_v(i,J,k) = 0.5 * GV%Z_to_m*(CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k) enddo ; enddo endif @@ -1011,7 +1008,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) call uvchksum("vertvisc_coef h_[uv]", CS%h_u, & CS%h_v, G%HI,haloshift=0, scale=GV%H_to_m) call uvchksum("vertvisc_coef a_[uv]", CS%a_u, & - CS%a_v, G%HI, haloshift=0) + CS%a_v, G%HI, haloshift=0, scale=GV%Z_to_m) if (allocated(hML_u) .and. allocated(hML_v)) & call uvchksum("vertvisc_coef hML_[uv]", hML_u, hML_v, & G%HI, haloshift=0, scale=GV%H_to_m) @@ -1036,12 +1033,12 @@ end subroutine vertvisc_coef !> Calculate the 'coupling coefficient' (a[k]) at the !! interfaces. If BOTTOMDRAGLAW is defined, the minimum of Hbbl and half the !! adjacent layer thicknesses are used to calculate a[k] near the bottom. -subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & +subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & dt, j, G, GV, CS, visc, forces, work_on_u, OBC, shelf) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZIB_(G),SZK_(GV)+1), & - intent(out) :: a !< Coupling coefficient across interfaces, in m s-1 + intent(out) :: a_cpl !< Coupling coefficient across interfaces, in Z s-1 real, dimension(SZIB_(G),SZK_(GV)), & intent(in) :: hvel !< Thickness at velocity points, in H logical, dimension(SZIB_(G)), & @@ -1069,7 +1066,7 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m ! Local variables real, dimension(SZIB_(G)) :: & - u_star, & ! ustar at a velocity point, in m s-1. + u_star, & ! ustar at a velocity point, in Z s-1. absf, & ! The average of the neighboring absolute values of f, in s-1. ! h_ml, & ! The mixed layer depth, in m or kg m-2. nk_visc, & ! The (real) interface index of the base of mixed layer. @@ -1085,13 +1082,12 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m real :: I_Hmix ! The inverse of the mixed layer thickness, in m-1 or m2 kg-1. real :: a_ml ! The layer coupling coefficient across an interface in ! the mixed layer, in m s-1. - real :: temp1 ! A temporary variable in m2 s-1. + real :: I_amax ! The inverse of the maximum coupling coefficient, in Z-1.??? + real :: temp1 ! A temporary variable in H Z real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. - real :: dz_neglect ! A thickness in m that is so small it is usually lost - ! in roundoff and can be neglected, in m. real :: z2 ! A copy of z_i, nondim. - real :: H_to_m, m_to_H ! Unit conversion factors. + real :: H_to_m, m_to_H, m2_to_Z2 ! Unit conversion factors. real :: topfn real :: a_top logical :: do_shelf, do_OBCs @@ -1099,14 +1095,19 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m integer :: nz real :: botfn - a(:,:) = 0.0 + a_cpl(:,:) = 0.0 if (work_on_u) then ; is = G%IscB ; ie = G%IecB else ; is = G%isc ; ie = G%iec ; endif nz = G%ke h_neglect = GV%H_subroundoff H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H - dz_neglect = GV%H_subroundoff*GV%H_to_m + m2_to_Z2 = GV%m_to_Z*GV%m_to_Z + + ! The maximum coupling coefficent was originally introduced to avoid + ! truncation error problems in the tridiagonal solver. Effectively, the 1e-10 + ! sets the maximum coupling coefficient increment to 1e10 m per timestep. + I_amax = (1.0e-10*GV%Z_to_m) * dt do_shelf = .false. ; if (present(shelf)) do_shelf = shelf do_OBCs = .false. @@ -1115,15 +1116,15 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m ! The following loop calculates the vertical average velocity and ! surface mixed layer contributions to the vertical viscosity. - do i=is,ie ; a(i,1) = 0.0 ; enddo + do i=is,ie ; a_cpl(i,1) = 0.0 ; enddo if ((GV%nkml>0) .or. do_shelf) then ; do k=2,nz ; do i=is,ie - if (do_i(i)) a(i,K) = 2.0*CS%Kv + if (do_i(i)) a_cpl(i,K) = 2.0*CS%Kv enddo ; enddo ; else I_Hmix = 1.0 / (CS%Hmix * m_to_H + h_neglect) do i=is,ie ; z_t(i) = h_neglect*I_Hmix ; enddo do K=2,nz ; do i=is,ie ; if (do_i(i)) then z_t(i) = z_t(i) + h_harm(i,k-1)*I_Hmix - a(i,K) = 2.0*CS%Kv + 2.0*CS%Kvml / ((z_t(i)*z_t(i)) * & + a_cpl(i,K) = 2.0*CS%Kv + 2.0*CS%Kvml / ((z_t(i)*z_t(i)) * & (1.0 + 0.09*z_t(i)*z_t(i)*z_t(i)*z_t(i)*z_t(i)*z_t(i))) endif ; enddo ; enddo endif @@ -1132,12 +1133,12 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m if (CS%bottomdraglaw) then r = hvel(i,nz)*0.5 if (r < bbl_thick(i)) then - a(i,nz+1) = 1.0*kv_bbl(i) / (1e-10*dt*kv_bbl(i) + r*H_to_m) + a_cpl(i,nz+1) = 1.0*m2_to_Z2*kv_bbl(i) / (I_amax* m2_to_Z2*kv_bbl(i) + r*GV%H_to_Z) else - a(i,nz+1) = 1.0*kv_bbl(i) / (1e-10*dt*kv_bbl(i) + bbl_thick(i)*H_to_m) + a_cpl(i,nz+1) = 1.0*m2_to_Z2*kv_bbl(i) / (I_amax* m2_to_Z2*kv_bbl(i) + bbl_thick(i)*GV%H_to_Z) endif else - a(i,nz+1) = 2.0*CS%Kvbbl / (hvel(i,nz)*H_to_m + 2.0e-10*dt*CS%Kvbbl) + a_cpl(i,nz+1) = 2.0*m2_to_Z2*CS%Kvbbl / (hvel(i,nz)*GV%H_to_Z + 2.0*I_amax* m2_to_Z2*CS%Kvbbl) endif endif ; enddo @@ -1160,7 +1161,7 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a(i,K) = a(i,K) + Kv_add(i,K) + a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then @@ -1176,7 +1177,7 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a(i,K) = a(i,K) + Kv_add(i,K) + a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) endif ; enddo ; enddo endif endif @@ -1184,11 +1185,11 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m if (associated(visc%Kv_shear_Bu)) then if (work_on_u) then do K=2,nz ; do I=Is,Ie ; If (do_i(I)) then - a(I,K) = a(I,K) + (2.*0.5)*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) + a_cpl(I,K) = a_cpl(I,K) + (2.*0.5)*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a(i,K) = a(i,K) + (2.*0.5)*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k)) + a_cpl(i,K) = a_cpl(i,K) + (2.*0.5)*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo endif endif @@ -1210,7 +1211,7 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a(i,K) = a(i,K) + Kv_add(i,K) + a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then @@ -1226,7 +1227,7 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a(i,K) = a(i,K) + Kv_add(i,K) + a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) endif ; enddo ; enddo endif endif @@ -1238,7 +1239,7 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) if (CS%bottomdraglaw) then - a(i,K) = a(i,K) + 2.0*(kv_bbl(i)-CS%Kv)*botfn + a_cpl(i,K) = a_cpl(i,K) + 2.0*(kv_bbl(i)-CS%Kv)*botfn r = (hvel(i,k)+hvel(i,k-1)) if (r > 2.0*bbl_thick(i)) then h_shear = ((1.0 - botfn) * r + botfn*2.0*bbl_thick(i)) @@ -1246,15 +1247,13 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m h_shear = r endif else - a(i,K) = a(i,K) + 2.0*(CS%Kvbbl-CS%Kv)*botfn + a_cpl(i,K) = a_cpl(i,K) + 2.0*(CS%Kvbbl-CS%Kv)*botfn h_shear = hvel(i,k) + hvel(i,k-1) + h_neglect endif - ! Up to this point a has units of m2 s-1, but now is converted to m s-1. - ! The term including 1e-10 in the denominators is here to avoid - ! truncation error problems in the tridiagonal solver. Effectively, this - ! sets the maximum coupling coefficient at 1e10 m. - a(i,K) = a(i,K) / (h_shear*H_to_m + 1.0e-10*dt*a(i,K)) + ! Up to this point a has units of m2 s-1, but now is converted to Z s-1. + a_cpl(i,K) = a_cpl(i,K) * m2_to_Z2 + a_cpl(i,K) = a_cpl(i,K) / (h_shear*GV%H_to_Z + I_amax*a_cpl(i,K)) endif ; enddo ; enddo ! i & k loops if (do_shelf) then @@ -1269,11 +1268,11 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif z_t(i) = 0.0 - ! If a(i,1) were not already 0, it would be added here. + ! If a_cpl(i,1) were not already 0, it would be added here. if (0.5*hvel(i,1) > tbl_thick(i)) then - a(i,1) = kv_tbl(i) / (tbl_thick(i) *H_to_m + (1.0e-10*dt)*kv_tbl(i)) + a_cpl(i,1) = m2_to_Z2 * kv_tbl(i) / (tbl_thick(i) *GV%H_to_Z + I_amax*(m2_to_Z2*kv_tbl(i))) else - a(i,1) = kv_tbl(i) / (0.5*hvel(i,1)*H_to_m + (1.0e-10*dt)*kv_tbl(i)) + a_cpl(i,1) = m2_to_Z2 * kv_tbl(i) / (0.5*hvel(i,1)*GV%H_to_Z + I_amax*(m2_to_Z2*kv_tbl(i))) endif endif ; enddo @@ -1287,22 +1286,20 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m else h_shear = r endif - ! The term including 1e-10 in the denominators is here to avoid - ! truncation error problems in the tridiagonal solver. Effectively, this - ! sets the maximum coupling coefficient increment to 1e10 m. - a_top = 2.0 * topfn * kv_tbl(i) - a(i,K) = a(i,K) + a_top / (h_shear*H_to_m + 1.0e-10*dt*a_top) + + a_top = 2.0 * topfn * (m2_to_Z2 * kv_tbl(i)) + a_cpl(i,K) = a_cpl(i,K) + a_top / (h_shear*GV%H_to_Z + I_amax*a_top) endif ; enddo ; enddo elseif (CS%dynamic_viscous_ML .or. (GV%nkml>0)) then max_nk = 0 do i=is,ie ; if (do_i(i)) then if (GV%nkml>0) nk_visc(i) = real(GV%nkml+1) if (work_on_u) then - u_star(I) = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star(I) = 0.5*GV%m_to_Z*(forces%ustar(i,j) + forces%ustar(i+1,j)) absf(I) = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) if (CS%dynamic_viscous_ML) nk_visc(I) = visc%nkml_visc_u(I,j) + 1 else - u_star(i) = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star(i) = 0.5*GV%m_to_Z*(forces%ustar(i,j) + forces%ustar(i,j+1)) absf(i) = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) if (CS%dynamic_viscous_ML) nk_visc(i) = visc%nkml_visc_v(i,J) + 1 endif @@ -1313,16 +1310,16 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m if (do_OBCS) then ; if (work_on_u) then do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) & - u_star(I) = forces%ustar(i,j) + u_star(I) = GV%m_to_Z*forces%ustar(i,j) if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) & - u_star(I) = forces%ustar(i+1,j) + u_star(I) = GV%m_to_Z*forces%ustar(i+1,j) endif ; enddo else do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) & - u_star(i) = forces%ustar(i,j) + u_star(i) = GV%m_to_Z*forces%ustar(i,j) if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) & - u_star(i) = forces%ustar(i,j+1) + u_star(i) = GV%m_to_Z*forces%ustar(i,j+1) endif ; enddo endif ; endif @@ -1337,16 +1334,15 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m do K=2,max_nk ; do i=is,ie ; if (do_i(i)) then ; if (k < nk_visc(i)) then ! Set the viscosity at the interfaces. z_t(i) = z_t(i) + hvel(i,k-1) - temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i)) * H_to_m - ! This viscosity is set to go to 0 at the mixed layer top and bottom - ! (in a log-layer) and be further limited by rotation to give the - ! natural Ekman length. + temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i))*GV%H_to_Z + ! This viscosity is set to go to 0 at the mixed layer top and bottom (in a log-layer) + ! and be further limited by rotation to give the natural Ekman length. visc_ml = u_star(i) * 0.41 * (temp1*u_star(i)) / & (absf(i)*temp1 + h_ml(i)*u_star(i)) - a_ml = 4.0*visc_ml / ((hvel(i,k)+hvel(i,k-1) + h_neglect) * H_to_m + & - 2.0e-10*dt*visc_ml) + a_ml = 4.0*visc_ml / ((hvel(i,k)+hvel(i,k-1) + h_neglect) * GV%H_to_Z + & + 2.0*I_amax* visc_ml) ! Choose the largest estimate of a. - if (a_ml > a(i,K)) a(i,K) = a_ml + if (a_ml > a_cpl(i,K)) a_cpl(i,K) = a_ml endif ; endif ; enddo ; enddo endif @@ -1748,10 +1744,10 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & 'Total vertical viscosity at v-points', 'm2 s-1') CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, & - 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1') + 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=GV%Z_to_m) CS%id_av_vv = register_diag_field('ocean_model', 'av_visc', diag%axesCvi, Time, & - 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1') + 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1', conversion=GV%Z_to_m) CS%id_h_u = register_diag_field('ocean_model', 'Hu_visc', diag%axesCuL, Time, & 'Thickness at Zonal Velocity Points for Viscosity', thickness_units) From 5ae16fe46d42126e669ce9e758d894f20911f05a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 22 Sep 2018 21:09:57 -0400 Subject: [PATCH 0739/1072] Rescale the output of a in write_u_accel Rescale the output of a in write_u_accel and write_v_accel. All answers are bitwise identical, but diagnsotic output changes when the model is truncating velocities. --- src/diagnostics/MOM_PointAccel.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 29fb308dd3..fa31586659 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -85,7 +85,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a real, optional, intent(in) :: str !< The surface wind stress integrated over a time !! step, in m2 s-1. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, m. + optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, Z s-1. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, !! from vertvisc, in m. @@ -215,7 +215,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a endif if (present(a)) then write(file,'(/,"a: ",$)') - do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(I,j,k); enddo + do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(I,j,k)*GV%Z_to_m*dt; enddo endif if (present(hv)) then write(file,'(/,"hvel: ",$)') @@ -413,7 +413,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a real, optional, intent(in) :: str !< The surface wind stress integrated over a time !! step, in m2 s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, m. + optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, Z s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, !! from vertvisc, in m. @@ -547,7 +547,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a endif if (present(a)) then write(file,'(/,"a: ",$)') - do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(i,j,k); enddo + do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(i,j,k)*GV%Z_to_m*dt; enddo endif if (present(hv)) then write(file,'(/,"hvel: ",$)') From 086a5d72696f88cd9f21cc6628bf17bdf8b7cb87 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 23 Sep 2018 20:56:44 -0400 Subject: [PATCH 0740/1072] Removed unnueded variables in MOM_vert_friction Removed unnecssary variables in MOM_vert_friction by working directly with scaling factors from the vertical grid type. ALl answers are bitwise identical. --- .../vertical/MOM_vert_friction.F90 | 25 ++++++++----------- 1 file changed, 11 insertions(+), 14 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 92d1d79b4e..67be1e7ca8 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -625,9 +625,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) real :: z2 ! The distance from the bottom, normalized by Hbbl, nondim. real :: z2_wt ! A nondimensional (0-1) weight used when calculating z2. real :: z_clear ! The clearance of an interface above the surrounding topography, in H. - real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. - real :: m_to_H ! Unit conversion factors. + real :: h_neglect ! A thickness that is so small it is usually lost + ! in roundoff and can be neglected, in H. real :: I_valBL ! The inverse of a scaling factor determining when water is ! still within the boundary layer, as determined by the sum @@ -645,7 +644,6 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) "Module must be initialized before it is used.") h_neglect = GV%H_subroundoff - m_to_H = GV%m_to_H I_Hbbl(:) = 1.0 / (CS%Hbbl * GV%m_to_H + h_neglect) I_valBL = 0.0 ; if (CS%harm_BL_val > 0.0) I_valBL = 1.0 / CS%harm_BL_val @@ -679,7 +677,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) if (CS%bottomdraglaw) then ; do I=Isq,Ieq kv_bbl(I) = visc%kv_bbl_u(I,j) - bbl_thick(I) = visc%bbl_thick_u(I,j) * m_to_H + bbl_thick(I) = visc%bbl_thick_u(I,j) * GV%m_to_H if (do_i(I)) I_Hbbl(I) = 1.0 / (bbl_thick(I) + h_neglect) enddo ; endif @@ -776,7 +774,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! Perhaps this needs to be done more carefully, via find_eta. do I=Isq,Ieq ; if (do_i_shelf(I)) then zh(I) = 0.0 ; Ztop_min(I) = min(zcol(i), zcol(i+1)) - I_HTbl(I) = 1.0 / (visc%tbl_thick_shelf_u(I,j)*m_to_H + h_neglect) + I_HTbl(I) = 1.0 / (visc%tbl_thick_shelf_u(I,j)*GV%m_to_H + h_neglect) endif ; enddo do k=1,nz do i=Isq,Ieq+1 ; zcol(i) = zcol(i) - h(i,j,k) ; enddo @@ -839,14 +837,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! Now work on v-points. !$OMP parallel do default(private) shared(G,GV,CS,visc,is,ie,Jsq,Jeq,nz,v,h,forces,hML_v, & - !$OMP OBC,h_neglect,dt,m_to_H,I_valBL,Kv_v) & + !$OMP OBC,h_neglect,dt,I_valBL,Kv_v) & !$OMP firstprivate(i_hbbl) do J=Jsq,Jeq do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0) ; enddo if (CS%bottomdraglaw) then ; do i=is,ie kv_bbl(i) = visc%kv_bbl_v(i,J) - bbl_thick(i) = visc%bbl_thick_v(i,J) * m_to_H + bbl_thick(i) = visc%bbl_thick_v(i,J) * GV%m_to_H if (do_i(i)) I_Hbbl(i) = 1.0 / bbl_thick(i) enddo ; endif @@ -944,7 +942,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! Perhaps this needs to be done more carefully, via find_eta. do i=is,ie ; if (do_i_shelf(i)) then zh(i) = 0.0 ; Ztop_min(I) = min(zcol1(i), zcol2(i)) - I_HTbl(i) = 1.0 / (visc%tbl_thick_shelf_v(i,J)*m_to_H + h_neglect) + I_HTbl(i) = 1.0 / (visc%tbl_thick_shelf_v(i,J)*GV%m_to_H + h_neglect) endif ; enddo do k=1,nz do i=is,ie ; if (do_i_shelf(i)) then @@ -1087,7 +1085,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. real :: z2 ! A copy of z_i, nondim. - real :: H_to_m, m_to_H, m2_to_Z2 ! Unit conversion factors. + real :: m2_to_Z2 ! Unit conversion factors. real :: topfn real :: a_top logical :: do_shelf, do_OBCs @@ -1101,7 +1099,6 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, else ; is = G%isc ; ie = G%iec ; endif nz = G%ke h_neglect = GV%H_subroundoff - H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H m2_to_Z2 = GV%m_to_Z*GV%m_to_Z ! The maximum coupling coefficent was originally introduced to avoid @@ -1120,7 +1117,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if ((GV%nkml>0) .or. do_shelf) then ; do k=2,nz ; do i=is,ie if (do_i(i)) a_cpl(i,K) = 2.0*CS%Kv enddo ; enddo ; else - I_Hmix = 1.0 / (CS%Hmix * m_to_H + h_neglect) + I_Hmix = 1.0 / (CS%Hmix * GV%m_to_H + h_neglect) do i=is,ie ; z_t(i) = h_neglect*I_Hmix ; enddo do K=2,nz ; do i=is,ie ; if (do_i(i)) then z_t(i) = z_t(i) + h_harm(i,k-1)*I_Hmix @@ -1261,10 +1258,10 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, do i=is,ie ; if (do_i(i)) then if (work_on_u) then kv_tbl(i) = visc%kv_tbl_shelf_u(I,j) - tbl_thick(i) = visc%tbl_thick_shelf_u(I,j) * m_to_H + tbl_thick(i) = visc%tbl_thick_shelf_u(I,j) * GV%m_to_H else kv_tbl(i) = visc%kv_tbl_shelf_v(i,J) - tbl_thick(i) = visc%tbl_thick_shelf_v(i,J) * m_to_H + tbl_thick(i) = visc%tbl_thick_shelf_v(i,J) * GV%m_to_H endif z_t(i) = 0.0 From 0c5a3ef8b9ed26cd8f5a10bd46f4402004c5a85d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 23 Sep 2018 20:57:17 -0400 Subject: [PATCH 0741/1072] Do MOM_set_viscosity in units of Z Rescaled several of the variables in MOM_set_viscosity to work in units of Z and H instead of m. Also eliminated several unused variables and updated the comments describing others. All answers are bitwise identical. --- .../vertical/MOM_set_viscosity.F90 | 168 +++++++++--------- 1 file changed, 86 insertions(+), 82 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 8f9e325ddc..ef92c5a8c5 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -44,15 +44,14 @@ module MOM_set_visc real :: drag_bg_vel !< An assumed unresolved background velocity for !! calculating the bottom drag, in m s-1. real :: BBL_thick_min !< The minimum bottom boundary layer thickness in - !! the same units as thickness (m or kg m-2). + !! the same units as thickness (H, often m or kg m-2). !! This might be Kv / (cdrag * drag_bg_vel) to give !! Kv as the minimum near-bottom viscosity. - real :: Htbl_shelf !< A nominal thickness of the surface boundary layer - !! for use in calculating the near-surface velocity, - !! in units of m. - real :: Htbl_shelf_min !< The minimum surface boundary layer thickness in m. - real :: KV_BBL_min !< The minimum viscosities in the bottom and top - real :: KV_TBL_min !< boundary layers, both in m2 s-1. + real :: Htbl_shelf !< A nominal thickness of the surface boundary layer for use + !! in calculating the near-surface velocity, in units of H. + real :: Htbl_shelf_min !< The minimum surface boundary layer thickness in H. + real :: KV_BBL_min !< The minimum viscosity in the bottom boundary layer, in Z2 s-1. + real :: KV_TBL_min !< The minimum viscosity in the top boundary layer, in Z2 s-1. logical :: bottomdraglaw !< If true, the bottom stress is calculated with a !! drag law c_drag*|u|*u. The velocity magnitude !! may be an assumed value or it may be based on the @@ -71,7 +70,7 @@ module MOM_set_visc !! thickness of the viscous mixed layer. Nondim. real :: omega !< The Earth's rotation rate, in s-1. real :: ustar_min !< A minimum value of ustar to avoid numerical - !! problems, in m s-1. If the value is small enough, + !! problems, in Z s-1. If the value is small enough, !! this should not affect the solution. real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE !! decay scale, nondimensional. @@ -185,6 +184,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) real :: ustarsq ! 400 times the square of ustar, times ! Rho0 divided by G_Earth and the conversion ! from m to thickness units, in kg m-2 or kg2 m-5. + real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion + ! factor from lateral lengths to vertical depths, in Z m-1. real :: cdrag_sqrt ! Square root of the drag coefficient, nd. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, @@ -193,13 +194,14 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) ! the layer, in H kg m-3. real :: Dh ! The increment in layer thickness from ! the present layer, in H. - real :: bbl_thick ! The thickness of the bottom boundary layer in m. + real :: bbl_thick ! The thickness of the bottom boundary layer in H. + real :: bbl_thick_Z ! The thickness of the bottom boundary layer in Z. real :: C2f ! C2f = 2*f at velocity points. real :: U_bg_sq ! The square of an assumed background ! velocity, for calculating the mean ! magnitude near the bottom for use in the - ! quadratic bottom drag, in m2. + ! quadratic bottom drag, in m2 s-2. real :: hwtot ! Sum of the thicknesses used to calculate ! the near-bottom velocity magnitude, in H. real :: hutot ! Running sum of thicknesses times the @@ -209,8 +211,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) real :: hweight ! The thickness of a layer that is within Hbbl ! of the bottom, in H. real :: v_at_u, u_at_v ! v at a u point or vice versa, m s-1. - real :: Rho0x400_G ! 400*Rho0/G_Earth, in kg s2 m-4. The 400 is a - ! constant proposed by Killworth and Edwards, 1999. + real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors, in kg s2 H m-3 Z-2. + ! The 400 is a constant proposed by Killworth and Edwards, 1999. real, dimension(SZI_(G),SZJ_(G),max(GV%nk_rho_varies,1)) :: & Rml ! The mixed layer coordinate density, in kg m-3. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate @@ -256,7 +258,6 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) ! in roundoff and can be neglected, in H. real :: ustH ! ustar converted to units of H s-1. real :: root ! A temporary variable with units of H s-1. - real :: H_to_m, m_to_H ! Local copies of unit conversion factors. real :: Cell_width ! The transverse width of the velocity cell, in m. real :: Rayleigh ! A nondimensional value that is multiplied by the @@ -281,9 +282,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nkmb = GV%nk_rho_varies ; nkml = GV%nkml h_neglect = GV%H_subroundoff - Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth)*GV%m_to_H + Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * GV%Z_to_m*GV%Z_to_H Vol_quit = 0.9*GV%Angstrom_H + h_neglect - H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H C2pi_3 = 8.0*atan(1.0)/3.0 if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(BBL): "//& @@ -305,11 +305,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) OBC => CS%OBC U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel - cdrag_sqrt=sqrt(CS%cdrag) + cdrag_sqrt = sqrt(CS%cdrag) + cdrag_sqrt_Z = GV%m_to_Z * sqrt(CS%cdrag) K2 = max(nkmb+1, 2) ! With a linear drag law, the friction velocity is already known. -! if (CS%linear_drag) ustar(:) = cdrag_sqrt*CS%drag_bg_vel +! if (CS%linear_drag) ustar(:) = cdrag_sqrt_Z*CS%drag_bg_vel if ((nkml>0) .and. .not.use_BBL_EOS) then do i=Isq,Ieq+1 ; p_ref(i) = tv%P_ref ; enddo @@ -377,7 +378,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) !$OMP parallel do default(none) shared(u, v, h, tv, visc, G, GV, CS, Rml, is, ie, js, je, & !$OMP nz, Isq, Ieq, Jsq, Jeq, nkmb, h_neglect, Rho0x400_G,& !$OMP C2pi_3, U_bg_sq, cdrag_sqrt,K2,use_BBL_EOS,OBC, & -!$OMP maxitt,nkml,m_to_H,H_to_m,Vol_quit,D_u,D_v,mask_u,mask_v) & +!$OMP maxitt,nkml,Vol_quit,D_u,D_v,mask_u,mask_v) & !$OMP private(do_i,h_at_vel,htot_vel,hwtot,hutot,Thtot,Shtot, & !$OMP hweight,v_at_u,u_at_v,ustar,T_EOS,S_EOS,press, & !$OMP dR_dT, dR_dS,ustarsq,htot,T_vel,S_vel,Rml_vel, & @@ -543,9 +544,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) enddo ! end of k loop if (.not.CS%linear_drag .and. (hwtot > 0.0)) then - ustar(i) = cdrag_sqrt*hutot/hwtot + ustar(i) = cdrag_sqrt_Z*hutot/hwtot else - ustar(i) = cdrag_sqrt*CS%drag_bg_vel + ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel endif if (use_BBL_EOS) then ; if (hwtot > 0.0) then @@ -555,7 +556,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) endif ; endif endif ; enddo else - do i=is,ie ; ustar(i) = cdrag_sqrt*CS%drag_bg_vel ; enddo + do i=is,ie ; ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel ; enddo endif ! Not linear_drag if (use_BBL_EOS) then @@ -657,7 +658,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (CS%cdrag * U_bg_sq <= 0.0) then ! This avoids NaNs and overflows, and could be used in all cases, ! but is not bitwise identical to the current code. - ustH = ustar(i)*m_to_H ; root = sqrt(0.25*ustH**2 + (htot*C2f)**2) + ustH = ustar(i)*GV%Z_to_H ; root = sqrt(0.25*ustH**2 + (htot*C2f)**2) if (htot*ustH <= (CS%BBL_thick_min+h_neglect) * (0.5*ustH + root)) then bbl_thick = CS%BBL_thick_min else @@ -665,7 +666,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) endif else bbl_thick = htot / (0.5 + sqrt(0.25 + htot*htot*C2f*C2f/ & - ((ustar(i)*ustar(i)) * (m_to_H**2) ))) + ((ustar(i)*ustar(i)) * (GV%Z_to_H**2) ))) if (bbl_thick < CS%BBL_thick_min) bbl_thick = CS%BBL_thick_min endif @@ -856,8 +857,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) else ; Cell_width = G%dx_Cv(i,J) ; endif gam = 1.0 - L(K+1)/L(K) Rayleigh = CS%cdrag * (L(K)-L(K+1)) * (1.0-BBL_frac) * & - (12.0*CS%c_Smag*h_vel_pos) / (12.0*CS%c_Smag*h_vel_pos + m_to_H * & - CS%cdrag * gam*(1.0-gam)*(1.0-1.5*gam) * L(K)**2 * Cell_width) + (12.0*CS%c_Smag*h_vel_pos) / (12.0*CS%c_Smag*h_vel_pos + & + GV%m_to_H * CS%cdrag * gam*(1.0-gam)*(1.0-1.5*gam) * L(K)**2 * Cell_width) else ! This layer feels no drag. Rayleigh = 0.0 endif @@ -878,27 +879,27 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) enddo ! k loop to determine L(K). - bbl_thick = bbl_thick * H_to_m + bbl_thick_Z = bbl_thick * GV%H_to_Z if (m==1) then - visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, & - cdrag_sqrt*ustar(i)*bbl_thick*BBL_visc_frac) - visc%bbl_thick_u(I,j) = bbl_thick + visc%kv_bbl_u(I,j) = (GV%Z_to_m**2) * max(CS%KV_BBL_min, & + cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac) + visc%bbl_thick_u(I,j) = GV%Z_to_m * bbl_thick_Z else - visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, & - cdrag_sqrt*ustar(i)*bbl_thick*BBL_visc_frac) - visc%bbl_thick_v(i,J) = bbl_thick + visc%kv_bbl_v(i,J) = (GV%Z_to_m**2) * max(CS%KV_BBL_min, & + cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac) + visc%bbl_thick_v(i,J) = GV%Z_to_m * bbl_thick_Z endif else ! Not Channel_drag. ! Here the near-bottom viscosity is set to a value which will give ! the correct stress when the shear occurs over bbl_thick. - bbl_thick = bbl_thick * H_to_m + bbl_thick_Z = bbl_thick * GV%H_to_Z if (m==1) then - visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick) - visc%bbl_thick_u(I,j) = bbl_thick + visc%kv_bbl_u(I,j) = (GV%Z_to_m**2) * max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) + visc%bbl_thick_u(I,j) = GV%Z_to_m * bbl_thick_Z else - visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick) - visc%bbl_thick_v(i,J) = bbl_thick + visc%kv_bbl_v(i,J) = (GV%Z_to_m**2) * max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) + visc%bbl_thick_v(i,J) = GV%Z_to_m * bbl_thick_Z endif endif endif ; enddo ! end of i loop @@ -920,12 +921,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (CS%debug) then if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) & - call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI,haloshift=0) + call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI, haloshift=0) if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) & - call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI,haloshift=0) + call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, haloshift=0) if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) & call uvchksum("bbl_thick_[uv]", visc%bbl_thick_u, & - visc%bbl_thick_v, G%HI,haloshift=0) + visc%bbl_thick_v, G%HI, haloshift=0) endif end subroutine set_viscous_BBL @@ -1062,7 +1063,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) dR_dS, & ! Partial derivative of the density at the base of layer nkml ! (roughly the base of the mixed layer) with salinity, in units ! of kg m-3 psu-1. - ustar, & ! The surface friction velocity under ice shelves, in m s-1. + ustar, & ! The surface friction velocity under ice shelves, in Z s-1. press, & ! The pressure at which dR_dT and dR_dS are evaluated, in Pa. T_EOS, & ! T_EOS and S_EOS are the potential temperature and salnity at which dR_dT and dR_dS S_EOS ! which dR_dT and dR_dS are evaluated, in degC and PSU. @@ -1090,6 +1091,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) ! velocity magnitudes, in H m s-1. real :: hweight ! The thickness of a layer that is within Hbbl ! of the bottom, in H. + real :: tbl_thick_Z ! The thickness of the top boundary layer in Z. real :: hlay ! The layer thickness at velocity points, in H. real :: I_2hlay ! 1 / 2*hlay, in H-1. @@ -1112,7 +1114,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) real :: ustarsq ! 400 times the square of ustar, times ! Rho0 divided by G_Earth and the conversion ! from m to thickness units, in kg m-2 or kg2 m-5. - real :: cdrag_sqrt ! Square root of the drag coefficient, nd. + real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion + ! factor from lateral lengths to vertical depths, in Z m-1. + real :: cdrag_sqrt ! Square root of the drag coefficient, ND. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, ! divided by G_Earth, in H kg m-3. @@ -1126,12 +1130,11 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) real :: h_tiny ! A very small thickness, in H. Layers that are less than ! h_tiny can not be the deepest in the viscous mixed layer. real :: absf ! The absolute value of f averaged to velocity points, s-1. - real :: U_star ! The friction velocity at velocity points, in m s-1. + real :: U_star ! The friction velocity at velocity points, in Z s-1. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. - real :: Rho0x400_G ! 400*Rho0/G_Earth, in kg s2 m-4. The 400 is a - ! constant proposed by Killworth and Edwards, 1999. - real :: H_to_m, m_to_H ! Local copies of unit conversion factors. + real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors, in kg s2 H m-3 Z-2. + ! The 400 is a constant proposed by Killworth and Edwards, 1999. real :: ustar1 ! ustar in units of H/s real :: h2f2 ! (h*2*f)^2 logical :: use_EOS, do_any, do_any_shelf, do_i(SZIB_(G)) @@ -1151,9 +1154,10 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) Jsq = js-1 ; Isq = is-1 endif ; endif - Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth)*GV%m_to_H + Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * GV%Z_to_m*GV%Z_to_H U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel - cdrag_sqrt=sqrt(CS%cdrag) + cdrag_sqrt = sqrt(CS%cdrag) + cdrag_sqrt_Z = GV%m_to_Z * sqrt(CS%cdrag) OBC => CS%OBC use_EOS = associated(tv%eqn_of_state) @@ -1161,7 +1165,6 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) h_neglect = GV%H_subroundoff h_tiny = 2.0*GV%Angstrom_H + h_neglect g_H_Rho0 = (GV%g_Earth * GV%H_to_m) / GV%Rho0 - H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H if (associated(forces%frac_shelf_u) .neqv. associated(forces%frac_shelf_v)) & call MOM_error(FATAL, "set_viscous_ML: one of forces%frac_shelf_u and "//& @@ -1177,7 +1180,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) call safe_alloc_ptr(visc%kv_tbl_shelf_v, G%isd, G%ied, G%JsdB, G%JedB) ! With a linear drag law, the friction velocity is already known. -! if (CS%linear_drag) ustar(:) = cdrag_sqrt*CS%drag_bg_vel +! if (CS%linear_drag) ustar(:) = cdrag_sqrt_Z*CS%drag_bg_vel endif !$OMP parallel do default(shared) @@ -1210,9 +1213,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) !$OMP parallel do default(none) shared(u, v, h, tv, forces, visc, dt, G, GV, CS, use_EOS, & !$OMP dt_Rho0, h_neglect, h_tiny, g_H_Rho0,js,je,OBC, & -!$OMP H_to_m, m_to_H, Isq, Ieq, nz, U_bg_sq,mask_v, & +!$OMP Isq, Ieq, nz, U_bg_sq,mask_v, & !$OMP cdrag_sqrt,Rho0x400_G,nkml) & -!$OMP private(do_any,htot,do_i,k_massive,Thtot,uhtot,vhtot,U_Star, & +!$OMP private(do_any,htot,do_i,k_massive,Thtot,uhtot,vhtot,U_star, & !$OMP Idecay_len_TKE,press,k2,I_2hlay,T_EOS,S_EOS,dR_dT, & !$OMP dR_dS,hlay,v_at_u,Uh2,T_lay,S_lay,gHprime, & !$OMP RiBulk,Shtot,Rhtot,absf,do_any_shelf, & @@ -1238,8 +1241,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) if (CS%omega_frac > 0.0) & absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif - U_Star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i+1,j))) - Idecay_len_TKE(I) = ((absf / U_Star) * CS%TKE_decay) * H_to_m + U_star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i+1,j))*GV%m_to_Z) + Idecay_len_TKE(I) = ((absf / U_star) * CS%TKE_decay) * GV%H_to_Z endif enddo @@ -1363,9 +1366,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) enddo ; endif if ((.not.CS%linear_drag) .and. (hwtot > 0.0)) then - ustar(I) = cdrag_sqrt*hutot/hwtot + ustar(I) = cdrag_sqrt_Z*hutot/hwtot else - ustar(I) = cdrag_sqrt*CS%drag_bg_vel + ustar(I) = cdrag_sqrt_Z*CS%drag_bg_vel endif if (use_EOS) then ; if (hwtot > 0.0) then @@ -1438,13 +1441,13 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) !visc%tbl_thick_shelf_u(I,j) = max(CS%Htbl_shelf_min, & ! htot(I) / (0.5 + sqrt(0.25 + & ! (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)))**2 / & - ! (ustar(i)*m_to_H)**2 )) ) - ustar1 = ustar(i)*m_to_H + ! (ustar(i)*GV%Z_to_H)**2 )) ) + ustar1 = ustar(i)*GV%Z_to_H h2f2 = (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 - visc%tbl_thick_shelf_u(I,j) = max(CS%Htbl_shelf_min, & + tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(I)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) - visc%kv_tbl_shelf_u(I,j) = max(CS%KV_TBL_min, & - cdrag_sqrt*ustar(I)*visc%tbl_thick_shelf_u(I,j)) + visc%tbl_thick_shelf_u(I,j) = GV%Z_to_m * tbl_thick_Z + visc%kv_tbl_shelf_u(I,j) = (GV%Z_to_m**2) * max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) endif ; enddo ! I-loop endif ! do_any_shelf @@ -1453,9 +1456,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) !$OMP parallel do default(none) shared(u, v, h, tv, forces, visc, dt, G, GV, CS, use_EOS,& !$OMP dt_Rho0, h_neglect, h_tiny, g_H_Rho0,is,ie,OBC, & !$OMP Jsq,Jeq,nz,U_bg_sq,cdrag_sqrt,Rho0x400_G,nkml, & -!$OMP m_to_H,H_to_m,mask_u) & +!$OMP mask_u) & !$OMP private(do_any,htot,do_i,k_massive,Thtot,vhtot,uhtot,absf,& -!$OMP U_Star,Idecay_len_TKE,press,k2,I_2hlay,T_EOS, & +!$OMP U_star,Idecay_len_TKE,press,k2,I_2hlay,T_EOS, & !$OMP S_EOS,dR_dT, dR_dS,hlay,u_at_v,Uh2, & !$OMP T_lay,S_lay,gHprime,RiBulk,do_any_shelf, & !$OMP Shtot,Rhtot,ustar,h_at_vel,htot_vel,hwtot, & @@ -1482,8 +1485,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif - U_Star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i,j+1))) - Idecay_len_TKE(i) = ((absf / U_Star) * CS%TKE_decay) * H_to_m + U_star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i,j+1))*GV%m_to_Z) + Idecay_len_TKE(i) = ((absf / U_star) * CS%TKE_decay) * GV%H_to_Z endif enddo @@ -1608,9 +1611,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) enddo ; endif if (.not.CS%linear_drag) then ; if (hwtot > 0.0) then - ustar(i) = cdrag_sqrt*hutot/hwtot + ustar(i) = cdrag_sqrt_Z*hutot/hwtot else - ustar(i) = cdrag_sqrt*CS%drag_bg_vel + ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel endif ; endif if (use_EOS) then ; if (hwtot > 0.0) then @@ -1683,13 +1686,14 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) !visc%tbl_thick_shelf_v(i,J) = max(CS%Htbl_shelf_min, & ! htot(i) / (0.5 + sqrt(0.25 + & ! (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))**2 / & - ! (ustar(i)*m_to_H)**2 )) ) - ustar1 = ustar(i)*m_to_H + ! (ustar(i)*GV%Z_to_H)**2 )) ) + ustar1 = ustar(i)*GV%Z_to_H h2f2 = (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 - visc%tbl_thick_shelf_v(i,J) = max(CS%Htbl_shelf_min, & + tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(i)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) - visc%kv_tbl_shelf_v(i,J) = max(CS%KV_TBL_min, & - cdrag_sqrt*ustar(i)*visc%tbl_thick_shelf_v(i,J)) + visc%tbl_thick_shelf_v(i,J) = GV%Z_to_m * tbl_thick_Z + visc%kv_tbl_shelf_v(i,J) = (GV%Z_to_m**2) * max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) + endif ; enddo ! i-loop endif ! do_any_shelf @@ -1910,7 +1914,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) "The rotation rate of the earth.", units="s-1", & default=7.2921e-5) ! This give a minimum decay scale that is typically much less than Angstrom. - CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_m + GV%H_to_m*GV%H_subroundoff) + CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) else call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", units="s-1", & @@ -1922,7 +1926,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) "viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or \n"//& "the thickness over which near-bottom velocities are \n"//& "averaged for the drag law if BOTTOMDRAGLAW is defined \n"//& - "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true.) + "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true.) ! Rescaled later if (CS%bottomdraglaw) then call get_param(param_file, mdl, "CDRAG", CS%cdrag, & "CDRAG is the drag coefficient relating the magnitude of \n"//& @@ -1944,16 +1948,19 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) "The minimum bottom boundary layer thickness that can be \n"//& "used with BOTTOMDRAGLAW. This might be \n"//& "Kv / (cdrag * drag_bg_vel) to give Kv as the minimum \n"//& - "near-bottom viscosity.", units="m", default=0.0) + "near-bottom viscosity.", units="m", default=0.0) ! Rescaled later call get_param(param_file, mdl, "HTBL_SHELF_MIN", CS%Htbl_shelf_min, & "The minimum top boundary layer thickness that can be \n"//& "used with BOTTOMDRAGLAW. This might be \n"//& "Kv / (cdrag * drag_bg_vel) to give Kv as the minimum \n"//& - "near-top viscosity.", units="m", default=CS%BBL_thick_min) + "near-top viscosity.", units="m", default=CS%BBL_thick_min, scale=GV%m_to_H) call get_param(param_file, mdl, "HTBL_SHELF", CS%Htbl_shelf, & "The thickness over which near-surface velocities are \n"//& "averaged for the drag law under an ice shelf. By \n"//& - "default this is the same as HBBL", units="m", default=CS%Hbbl) + "default this is the same as HBBL", units="m", default=CS%Hbbl, scale=GV%m_to_H) + ! These unit conversions are out outside the get_param calls because the are also defaults. + CS%Hbbl = CS%Hbbl * GV%m_to_H ! Rescale + CS%BBL_thick_min = CS%BBL_thick_min * GV%m_to_H ! Rescale call get_param(param_file, mdl, "KV", Kv_background, & "The background kinematic viscosity in the interior. \n"//& @@ -1980,10 +1987,10 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) call get_param(param_file, mdl, "KV_BBL_MIN", CS%KV_BBL_min, & "The minimum viscosities in the bottom boundary layer.", & - units="m2 s-1", default=Kv_background) + units="m2 s-1", default=Kv_background, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "KV_TBL_MIN", CS%KV_TBL_min, & "The minimum viscosities in the top boundary layer.", & - units="m2 s-1", default=Kv_background) + units="m2 s-1", default=Kv_background, scale=GV%m_to_Z**2) if (CS%Channel_drag) then call get_param(param_file, mdl, "SMAG_LAP_CONST", smag_const1, default=-1.0) @@ -2047,9 +2054,6 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) diag%axesCv1, Time, 'Number of layers in viscous mixed layer at v points', 'm') endif - CS%Hbbl = CS%Hbbl * GV%m_to_H - CS%BBL_thick_min = CS%BBL_thick_min * GV%m_to_H - end subroutine set_visc_init !> This subroutine dellocates any memory in the set_visc control structure. From 6ccd94c735e71c6fad9ce9672efb55d4fbb9addd Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 24 Sep 2018 13:45:57 -0600 Subject: [PATCH 0742/1072] Pass Hml, from ePBL or KPP, via a call to diabatic --- .../vertical/MOM_diabatic_driver.F90 | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 4958b957ae..6c5f361833 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -92,6 +92,8 @@ module MOM_diabatic_driver logical :: use_energetic_PBL !< If true, use the implicit energetics planetary !! boundary layer scheme to determine the diffusivity !! in the surface boundary layer. + logical :: use_KPP !< If true, use CVMix/KPP boundary layer scheme to determine the + !! OBLD and the diffusivities within this layer. logical :: use_kappa_shear !< If true, use the kappa_shear module to find the !! shear-driven diapycnal diffusivity. logical :: use_CVMix_shear !< If true, use the CVMix module to find the @@ -266,7 +268,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness (m for Bouss / kg/m2 for non-Bouss) type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs - real, dimension(:,:), pointer :: Hml !< active mixed layer depth + real, dimension(:,:), pointer :: Hml !< mixed layer depth, m type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and @@ -736,11 +738,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) - ! If visc%MLD exists, copy the ePBL's MLD into it - if (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G) - call pass_var(visc%MLD, G%domain, halo=1) - Hml(:,:) = visc%MLD(:,:) + if (associated(Hml)) then + call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G) + call pass_var(Hml, G%domain, halo=1) + ! If visc%MLD exists, copy KPP's BLD into it + if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) endif ! Augment the diffusivities and viscosity due to those diagnosed in energetic_PBL. @@ -2815,7 +2817,10 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, call get_param(param_file, mod, "DOUBLE_DIFFUSION", differentialDiffusion, & "If true, apply parameterization of double-diffusion.", & default=.false. ) - + call get_param(param_file, mod, "USE_KPP", CS%use_KPP, & + "If true, turns on the [CVMix] KPP scheme of Large et al., 1994,\n"// & + "to calculate diffusivities and non-local transport in the OBL.", & + default=.false., do_not_log=.true.) CS%use_CVMix_ddiff = CVMix_ddiff_is_used(param_file) if (CS%use_CVMix_ddiff .and. differentialDiffusion) then From 9f0676e83c92fce480c015a2f8d5d18679d2bd0c Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 24 Sep 2018 13:52:14 -0600 Subject: [PATCH 0743/1072] Copy Hml into sfc_state, so that caps can access it --- src/core/MOM.F90 | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 185413fc88..a476adb491 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2717,6 +2717,13 @@ subroutine extract_surface_state(CS, sfc_state) sfc_state%sea_lev(i,j) = CS%ave_ssh_ibc(i,j) enddo ; enddo + ! copy Hml into sfc_state, so that caps can access it + if (associated(CS%Hml)) then + do j=js,je ; do i=is,ie + sfc_state%Hml(i,j) = CS%Hml(i,j) + enddo ; enddo + endif + if (CS%Hmix < 0.0) then ! A bulk mixed layer is in use, so layer 1 has the properties if (use_temperature) then ; do j=js,je ; do i=is,ie sfc_state%SST(i,j) = CS%tv%T(i,j,1) @@ -2729,9 +2736,6 @@ subroutine extract_surface_state(CS, sfc_state) sfc_state%v(i,J) = v(i,J,1) enddo ; enddo - if (associated(CS%Hml)) then ; do j=js,je ; do i=is,ie - sfc_state%Hml(i,j) = CS%Hml(i,j) - enddo ; enddo ; endif else ! (CS%Hmix >= 0.0) depth_ml = CS%Hmix @@ -2773,7 +2777,6 @@ subroutine extract_surface_state(CS, sfc_state) else sfc_state%sfc_density(i,j) = sfc_state%sfc_density(i,j) / depth(i) endif - sfc_state%Hml(i,j) = depth(i) enddo enddo ! end of j loop From 6f6f92a511f3403d5e793dae3e14e08c7b3eab8a Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 26 Sep 2018 08:53:08 -0600 Subject: [PATCH 0744/1072] Change melt potential from time accumulated to instantaneous --- src/core/MOM.F90 | 12 ++++++------ src/core/MOM_variables.F90 | 4 ++-- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index a476adb491..f6bf668b73 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -548,7 +548,6 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (therm_reset) then CS%time_in_thermo_cycle = 0.0 - if (allocated(sfc_state%melt_potential)) sfc_state%melt_potential(:,:) = 0.0 if (associated(CS%tv%frazil)) CS%tv%frazil(:,:) = 0.0 if (associated(CS%tv%salt_deficit)) CS%tv%salt_deficit(:,:) = 0.0 if (associated(CS%tv%TempxPmE)) CS%tv%TempxPmE(:,:) = 0.0 @@ -2870,12 +2869,13 @@ subroutine extract_surface_state(CS, sfc_state) enddo ; enddo do i=is,ie + ! set melt_potential to zero to avoid passing previous values + sfc_state%melt_potential(i,j) = 0.0 + if (G%mask2dT(i,j)>0.) then - ! time accumulated melt_potential, in J/m^2 - sfc_state%melt_potential(i,j) = sfc_state%melt_potential(i,j) + (CS%tv%C_p * CS%GV%Rho0 * delT(i)) - else - sfc_state%melt_potential(i,j) = 0.0 - endif! G%mask2dT + ! instantaneous melt_potential, in J/m^2 + sfc_state%melt_potential(i,j) = CS%tv%C_p * CS%GV%Rho0 * delT(i) + endif enddo enddo ! end of j loop endif ! melt_potential diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 1b9dae9a6d..fa5b92f31d 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -40,8 +40,8 @@ module MOM_variables v, & !< The mixed layer meridional velocity in m s-1. sea_lev, & !< The sea level in m. If a reduced surface gravity is !! used, that is compensated for in sea_lev. - melt_potential, & !< Amount of heat that can be used to melt sea ice, in J m-2. - !! This is computed w.r.t. surface freezing temperature. + melt_potential, & !< instantaneous amount of heat that can be used to melt sea ice, + !! in J m-2. This is computed w.r.t. surface freezing temperature. ocean_mass, & !< The total mass of the ocean in kg m-2. ocean_heat, & !< The total heat content of the ocean in C kg m-2. ocean_salt, & !< The total salt content of the ocean in kgSalt m-2. From 0090b2fd97f6144e155884883dfd3df180807bf4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Sep 2018 14:10:02 -0400 Subject: [PATCH 0745/1072] (*)Fixed a sign-error in ISOMIP_initialize_temp... Fixed a sign-error in ISOMIP_initialize_temperature_salinity, in which the temperature and salinity gradients were reversed in the layer mode branch. This bug was introduced with commit NOAA-GFDL/MOM6@59c7e221c, but was not detected by the MOM6-examples testing process. The ISOMIP test case now reproduces the answers that can be found with the MOM6 dev/master branch. --- src/user/ISOMIP_initialization.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 8940a9fcc3..621c5046dd 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -333,8 +333,8 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, do k = 1,nz !T0(k) = T_Ref; S0(k) = S_Ref xi1 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z - S0(k) = S_sur + dS_dz * xi1 - T0(k) = T_sur + dT_dz * xi1 + S0(k) = S_sur - dS_dz * xi1 + T0(k) = T_sur - dT_dz * xi1 xi0 = xi0 + h(i,j,k) * GV%H_to_Z ! write(mesg,*) 'S,T,xi0,xi1,k',S0(k),T0(k),xi0,xi1,k ! call MOM_mesg(mesg,5) From a9ab1eb034bec59a7ea2625d51505fa2b8a72aef Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Sep 2018 14:52:58 -0400 Subject: [PATCH 0746/1072] +Added z_tol arg to find_depth_of_pressure_in_cell Added optional z_tol argument to find_depth_of_pressure_in_cell, to permit the calling routine to specify the tolerance for the result of this routine, rather than using the current hard-coded value, and to enable dimensional consistency testing for depths. All answers are bitwise identical, but there is a new optional argument to a public routine. --- src/equation_of_state/MOM_EOS.F90 | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 7748a8b505..9a823d23eb 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -1355,20 +1355,21 @@ end subroutine int_density_dz_generic_plm !> Find the depth at which the reconstructed pressure matches P_tgt subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_tgt, & - rho_ref, G_e, EOS, P_b, z_out) + rho_ref, G_e, EOS, P_b, z_out, z_tol) real, intent(in) :: T_t !< Potential temperatue at the cell top (degC) real, intent(in) :: T_b !< Potential temperatue at the cell bottom (degC) real, intent(in) :: S_t !< Salinity at the cell top (ppt) real, intent(in) :: S_b !< Salinity at the cell bottom (ppt) - real, intent(in) :: z_t !< Absolute height of top of cell (m) (Boussinesq ????) - real, intent(in) :: z_b !< Absolute height of bottom of cell (m) + real, intent(in) :: z_t !< Absolute height of top of cell (Z) (Boussinesq ????) + real, intent(in) :: z_b !< Absolute height of bottom of cell (Z) real, intent(in) :: P_t !< Anomalous pressure of top of cell, relative to g*rho_ref*z_t (Pa) real, intent(in) :: P_tgt !< Target pressure at height z_out, relative to g*rho_ref*z_out (Pa) real, intent(in) :: rho_ref !< Reference density with which calculation are anomalous to - real, intent(in) :: G_e !< Gravitational acceleration (m/s2) + real, intent(in) :: G_e !< Gravitational acceleration (m2 Z-1 s-2) type(EOS_type), pointer :: EOS !< Equation of state structure real, intent(out) :: P_b !< Pressure at the bottom of the cell (Pa) - real, intent(out) :: z_out !< Absolute depth at which anomalous pressure = p_tgt (m) + real, intent(out) :: z_out !< Absolute depth at which anomalous pressure = p_tgt (Z) + real, optional, intent(in) :: z_tol !< The tolerance in finding z_out, in Z. ! Local variables real :: top_weight, bottom_weight, rho_anom, w_left, w_right, GxRho, dz, dp, F_guess, F_l, F_r real :: Pa, Pa_left, Pa_right, Pa_tol ! Pressure anomalies, P = integral of g*(rho-rho_ref) dz @@ -1394,7 +1395,8 @@ subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_t Pa_left = P_t - P_tgt ! Pa_left < 0 F_r = 1. Pa_right = P_b - P_tgt ! Pa_right > 0 - Pa_tol = GxRho * 1.e-5 + Pa_tol = GxRho * 1.e-5 ! 1e-5 has diimensions of m, but should be converted to the units of z. + if (present(z_tol)) Pa_tol = GxRho * z_tol F_guess = F_l - Pa_left / ( Pa_right -Pa_left ) * ( F_r - F_l ) Pa = Pa_right - Pa_left ! To get into iterative loop do while ( abs(Pa) > Pa_tol ) @@ -1435,7 +1437,7 @@ real function frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, pos, EO real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to !! reduce the magnitude of each of the integrals. real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m s-2. - real, intent(in) :: pos !< The fractional vertical position, nondim. + real, intent(in) :: pos !< The fractional vertical position, nondim, 0 to 1. type(EOS_type), pointer :: EOS !< Equation of state structure ! Local variables real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. From d60e85ffe9318949e4b6df41d6a68933badf90a7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Sep 2018 14:54:22 -0400 Subject: [PATCH 0747/1072] Correct Z-unit conversion in trim_for_ice Corrected conversions for dimensional consistency testing in a call to find_depth_of_pressure_in_cell in trim_for_ice, including adding a new optional argument, z_tol, to cut_off_column_top. Also added additional checksums in debug mode and corrected some comments. All answers are bitwise identical, and the layer-mode ISOMIP test case is now passing Z dimensional consistency checks. --- .../MOM_state_initialization.F90 | 37 ++++++++++++------- 1 file changed, 23 insertions(+), 14 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index fa719aca4c..6849acf27e 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -450,6 +450,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & do_not_log=just_read) if (depress_sfc .and. trim_ic_for_p_surf) call MOM_error(FATAL, "MOM_initialize_state: "//& "DEPRESS_INITIAL_SURFACE and TRIM_IC_FOR_P_SURF are exclusive and cannot both be True") + if (new_sim .and. debug .and. (depress_sfc .or. trim_ic_for_p_surf)) & + call hchksum(h, "Pre-depress: h ", G%HI, haloshift=1, scale=GV%H_to_m) if (depress_sfc) call depress_surface(h, G, GV, PF, tv, just_read_params=just_read) if (trim_ic_for_p_surf) call trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params=just_read) @@ -469,6 +471,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & call get_param(PF, mdl, "DT", dt, "Timestep", fail_if_missing=.true.) + if (new_sim .and. debug) & + call hchksum(h, "Pre-ALE_regrid: h ", G%HI, haloshift=1, scale=GV%H_to_m) call ALE_regrid_accelerated(ALE_CSp, G, GV, h, tv, regrid_iterations, u, v, tracer_Reg, & dt=dt, initial=.true.) endif @@ -500,7 +504,6 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & write(mesg,'("MOM_IS: S[",I2,"]")') k call hchksum(tv%S(:,:,k), mesg, G%HI, haloshift=1) enddo ; endif - endif call get_param(PF, mdl, "SPONGE", use_sponge, & @@ -1073,10 +1076,11 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: S_t, S_b ! Top and bottom edge values for reconstructions real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_t, T_b ! of salinity and temperature within each layer. character(len=200) :: inputdir, filename, p_surf_file, p_surf_var ! Strings for file/path - real :: scale_factor, min_thickness + real :: scale_factor ! A file-dependent scaling vactor for the input pressurs. + real :: min_thickness ! The minimum layer thickness, recast into Z units. integer :: i, j, k logical :: just_read ! If true, just read parameters but set nothing. - logical :: use_remapping + logical :: use_remapping ! If true, remap the initial conditions. type(remapping_CS), pointer :: remap_CS => NULL() just_read = .false. ; if (present(just_read_params)) just_read = just_read_params @@ -1124,31 +1128,35 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) do j=G%jsc,G%jec ; do i=G%isc,G%iec call cut_off_column_top(GV%ke, tv, GV, GV%g_Earth*GV%Z_to_m, G%bathyT(i,j), & min_thickness, tv%T(i,j,:), T_t(i,j,:), T_b(i,j,:), & - tv%S(i,j,:), S_t(i,j,:), S_b(i,j,:), p_surf(i,j), h(i,j,:), remap_CS) + tv%S(i,j,:), S_t(i,j,:), S_b(i,j,:), p_surf(i,j), h(i,j,:), remap_CS, & + z_tol=1.0e-5*GV%m_to_Z) enddo ; enddo end subroutine trim_for_ice -!> Adjust the layer thicknesses by cutting away the top at the depth where the hydrostatic -!! pressure matches p_surf + +!> Adjust the layer thicknesses by removing the top of the water column above the +!! depth where the hydrostatic pressure matches p_surf subroutine cut_off_column_top(nk, tv, GV, G_earth, depth, min_thickness, & - T, T_t, T_b, S, S_t, S_b, p_surf, h, remap_CS) - integer, intent(in) :: nk !< Number of layers - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + T, T_t, T_b, S, S_t, S_b, p_surf, h, remap_CS, z_tol) + integer, intent(in) :: nk !< Number of layers + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, intent(in) :: G_earth !< Gravitational acceleration (m2 Z-1 s-2) real, intent(in) :: depth !< Depth of ocean column (Z) real, intent(in) :: min_thickness !< Smallest thickness allowed (Z) - real, dimension(nk), intent(inout) :: T !< Layer mean temperature + real, dimension(nk), intent(inout) :: T !< Layer mean temperature real, dimension(nk), intent(in) :: T_t !< Temperature at top of layer real, dimension(nk), intent(in) :: T_b !< Temperature at bottom of layer - real, dimension(nk), intent(inout) :: S !< Layer mean salinity + real, dimension(nk), intent(inout) :: S !< Layer mean salinity real, dimension(nk), intent(in) :: S_t !< Salinity at top of layer real, dimension(nk), intent(in) :: S_b !< Salinity at bottom of layer real, intent(in) :: p_surf !< Imposed pressure on ocean at surface (Pa) - real, dimension(nk), intent(inout) :: h !< Layer thickness (H units, m or Pa) + real, dimension(nk), intent(inout) :: h !< Layer thickness (H units, m or Pa) type(remapping_CS), pointer :: remap_CS !< Remapping structure for remapping T and S, !! if associated + real, optional, intent(in) :: z_tol !< The tolerance with which to find the depth + !! matching the specified pressure, in Z. ! Local variables real, dimension(nk+1) :: e ! Top and bottom edge values for reconstructions @@ -1167,7 +1175,8 @@ subroutine cut_off_column_top(nk, tv, GV, G_earth, depth, min_thickness, & e_top = e(1) do k=1,nk call find_depth_of_pressure_in_cell(T_t(k), T_b(k), S_t(k), S_b(k), e(K), e(K+1), & - P_t, p_surf, GV%Rho0, G_earth, tv%eqn_of_state, P_b, z_out) + P_t, p_surf, GV%Rho0, G_earth, tv%eqn_of_state, & + P_b, z_out, z_tol=z_tol) if (z_out>=e(K)) then ! Imposed pressure was less that pressure at top of cell exit From 180e0ea12db99a6512aae70efd2a07b36178b4a1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Sep 2018 14:56:37 -0400 Subject: [PATCH 0748/1072] (*)Correct the grid used for allocate_forcing_type Use the correct grid type in allocate_forcing_type and allocate_mech_forcing calls inside initialize_ice_shelf, and added error checks to verify that compatible grids are being used by the ice shelf and ocean. All answers in the existing MOM6 test cases are bitwise identical, but this corrects a problem in which symmetric memory ocean models fail for the ISOMIP test case unless the ice shelf grid also uses symmetric memory. --- src/ice_shelf/MOM_ice_shelf.F90 | 25 +++++++++++++++++++------ 1 file changed, 19 insertions(+), 6 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index e6989caa54..24389af17f 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -754,6 +754,10 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed + if ((CS%grid%isc /= G%isc) .or. (CS%grid%iec /= G%iec) .or. & + (CS%grid%jsc /= G%jsc) .or. (CS%grid%jec /= G%jec)) & + call MOM_error(FATAL,"add_shelf_forces: Incompatible ocean and ice shelf grids.") + ISS => CS%ISS find_area = .true. ; if (present(do_shelf_area)) find_area = do_shelf_area @@ -823,6 +827,10 @@ subroutine add_shelf_pressure(G, CS, fluxes) integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + if ((CS%grid%isc /= G%isc) .or. (CS%grid%iec /= G%iec) .or. & + (CS%grid%jsc /= G%jsc) .or. (CS%grid%jec /= G%jec)) & + call MOM_error(FATAL,"add_shelf_pressure: Incompatible ocean and ice shelf grids.") + do j=js,je ; do i=is,ie press_ice = (CS%ISS%area_shelf_h(i,j) * G%IareaT(i,j)) * (CS%g_Earth * CS%ISS%mass_shelf(i,j)) if (associated(fluxes%p_surf)) then @@ -877,6 +885,10 @@ subroutine add_shelf_flux(G, CS, state, fluxes) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed + if ((CS%grid%isc /= G%isc) .or. (CS%grid%iec /= G%iec) .or. & + (CS%grid%jsc /= G%jsc) .or. (CS%grid%jec /= G%jec)) & + call MOM_error(FATAL,"add_shelf_flux: Incompatible ocean and ice shelf grids.") + ISS => CS%ISS call add_shelf_pressure(G, CS, fluxes) @@ -1098,16 +1110,17 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call set_grid_metrics(dG, param_file) ! call set_diag_mediator_grid(CS%grid, CS%diag) - ! The ocean grid is possibly different - if (associated(ocn_grid)) CS%ocn_grid => ocn_grid + ! The ocean grid possibly uses different symmetry. + if (associated(ocn_grid)) then ; CS%ocn_grid => ocn_grid + else ; CS%ocn_grid => CS%grid ; endif ! Convenience pointers G => CS%grid OG => CS%ocn_grid if (is_root_pe()) then - write(0,*) 'OG: ', OG%isd, OG%isc, OG%iec, OG%ied, OG%jsd, OG%jsc, OG%jsd, OG%jed - write(0,*) 'IG: ', G%isd, G%isc, G%iec, G%ied, G%jsd, G%jsc, G%jsd, G%jed + write(0,*) 'OG: ', OG%isd, OG%isc, OG%iec, OG%ied, OG%jsd, OG%jsc, OG%jsd, OG%jed + write(0,*) 'IG: ', G%isd, G%isc, G%iec, G%ied, G%jsd, G%jsc, G%jsd, G%jed endif CS%Time = Time ! ### This might not be in the right place? @@ -1344,10 +1357,10 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! when SHELF_THERMO = True. These fluxes are necessary if one wants to ! use either ENERGETICS_SFC_PBL (ALE mode) or BULKMIXEDLAYER (layer mode). if (present(fluxes)) & - call allocate_forcing_type(G, fluxes, ustar=.true., shelf=.true., & + call allocate_forcing_type(CS%ocn_grid, fluxes, ustar=.true., shelf=.true., & press=.true., water=CS%isthermo, heat=CS%isthermo) if (present(forces)) & - call allocate_mech_forcing(G, forces, ustar=.true., shelf=.true., press=.true.) + call allocate_mech_forcing(CS%ocn_grid, forces, ustar=.true., shelf=.true., press=.true.) else call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: allocating fluxes in solo mode.") if (present(fluxes)) & From f99e4bbb2a14240014fa7142fd7c5bd79501d0be Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Sep 2018 15:34:51 -0400 Subject: [PATCH 0749/1072] Changed visc%Ray_u into units of Z s-1 Changed the dimensions of visc%Ray_u and visc%Ray_v to Z s-1, from m s-1, for expanded dimensional consistency testing. All answers are bitwise identical. --- src/core/MOM_variables.F90 | 6 +++--- .../vertical/MOM_set_diffusivity.F90 | 7 ++++--- .../vertical/MOM_set_viscosity.F90 | 14 +++++++------- .../vertical/MOM_vert_friction.F90 | 8 ++++---- 4 files changed, 18 insertions(+), 17 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 4a2dbbea54..3cfefd906c 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -219,10 +219,10 @@ module MOM_variables real, pointer, dimension(:,:) :: nkml_visc_v => NULL() !< The number of layers in the viscous surface mixed layer at v-points (nondimensional). real, pointer, dimension(:,:) :: & - MLD => NULL() !< Instantaneous active mixing layer depth (H units). + MLD => NULL() !< Instantaneous active mixing layer depth (H units). real, pointer, dimension(:,:,:) :: & - Ray_u => NULL(), & !< The Rayleigh drag velocity to be applied to each layer at u-points, in m s-1. - Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points, in m s-1. + Ray_u => NULL(), & !< The Rayleigh drag velocity to be applied to each layer at u-points, in Z s-1. + Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points, in Z s-1. real, pointer, dimension(:,:,:) :: Kd_extra_T => NULL() !< The extra diffusivity of temperature due to double diffusion relative to the !! diffusivity of density, in m2 s-1. diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 185bb6a14b..e3c591153f 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -549,7 +549,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) then - call uvchksum("Ray_[uv]", visc%Ray_u, visc%Ray_v, G%HI, 0, symmetric=.true.) + call uvchksum("Ray_[uv]", visc%Ray_u, visc%Ray_v, G%HI, 0, symmetric=.true., scale=GV%Z_to_m) endif endif @@ -1279,7 +1279,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & else ; TKE_to_layer = 0.0 ; endif ! TKE_Ray has been initialized to 0 above. - if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * G%IareaT(i,j) * & + if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * GV%Z_to_m * G%IareaT(i,j) * & ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & @@ -1459,7 +1459,8 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & dhm1 = GV%H_to_m * h(i,j,km1) ! Thickness of level above in m. ! Add in additional energy input from bottom-drag against slopes (sides) - if (Rayleigh_drag) TKE_remaining = TKE_remaining + 0.5*CS%BBL_effic * G%IareaT(i,j) * & + if (Rayleigh_drag) TKE_remaining = TKE_remaining + & + 0.5*CS%BBL_effic * GV%Z_to_m * G%IareaT(i,j) * & ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index ef92c5a8c5..9eb4b80be0 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -260,9 +260,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) real :: root ! A temporary variable with units of H s-1. real :: Cell_width ! The transverse width of the velocity cell, in m. - real :: Rayleigh ! A nondimensional value that is multiplied by the - ! layer's velocity magnitude to give the Rayleigh - ! drag velocity. + real :: Rayleigh ! A nondimensional value that is multiplied by the layer's + ! velocity magnitude to give the Rayleigh drag velocity, + ! times a lateral to vertical distance conversion factor, in Z L-1. real :: gam ! The ratio of the change in the open interface width ! to the open interface width atop a cell, nondim. real :: BBL_frac ! The fraction of a layer's drag that goes into the @@ -856,7 +856,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (m==1) then ; Cell_width = G%dy_Cu(I,j) else ; Cell_width = G%dx_Cv(i,J) ; endif gam = 1.0 - L(K+1)/L(K) - Rayleigh = CS%cdrag * (L(K)-L(K+1)) * (1.0-BBL_frac) * & + Rayleigh = GV%m_to_Z * CS%cdrag * (L(K)-L(K+1)) * (1.0-BBL_frac) * & (12.0*CS%c_Smag*h_vel_pos) / (12.0*CS%c_Smag*h_vel_pos + & GV%m_to_H * CS%cdrag * gam*(1.0-gam)*(1.0-1.5*gam) * L(K)**2 * Cell_width) else ! This layer feels no drag. @@ -921,7 +921,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (CS%debug) then if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) & - call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI, haloshift=0) + call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI, haloshift=0, scale=GV%Z_to_m) if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) & call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, haloshift=0) if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) & @@ -2035,9 +2035,9 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) allocate(visc%Ray_u(IsdB:IedB,jsd:jed,nz)) ; visc%Ray_u = 0.0 allocate(visc%Ray_v(isd:ied,JsdB:JedB,nz)) ; visc%Ray_v = 0.0 CS%id_Ray_u = register_diag_field('ocean_model', 'Rayleigh_u', diag%axesCuL, & - Time, 'Rayleigh drag velocity at u points', 'm s-1') + Time, 'Rayleigh drag velocity at u points', 'm s-1', conversion=GV%Z_to_m) CS%id_Ray_v = register_diag_field('ocean_model', 'Rayleigh_v', diag%axesCvL, & - Time, 'Rayleigh drag velocity at v points', 'm s-1') + Time, 'Rayleigh drag velocity at v points', 'm s-1', conversion=GV%Z_to_m) endif if (use_CVMix_ddiff .or. differential_diffusion) then diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 67be1e7ca8..0666601701 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -265,7 +265,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & enddo ; endif ! direct_stress if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq - Ray(I,k) = GV%m_to_Z*visc%Ray_u(I,j,k) + Ray(I,k) = visc%Ray_u(I,j,k) enddo ; enddo ; endif ! perform forward elimination on the tridiagonal system @@ -373,7 +373,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & enddo ; endif ! direct_stress if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie - Ray(i,k) = GV%m_to_Z*visc%Ray_v(i,J,k) + Ray(i,k) = visc%Ray_v(i,J,k) enddo ; enddo ; endif do i=is,ie ; if (do_i(i)) then @@ -501,7 +501,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq - Ray(I,k) = GV%m_to_Z*visc%Ray_u(I,j,k) + Ray(I,k) = visc%Ray_u(I,j,k) enddo ; enddo ; endif do I=Isq,Ieq ; if (do_i(I)) then @@ -532,7 +532,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0) ; enddo if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie - Ray(i,k) = GV%m_to_Z*visc%Ray_v(i,J,k) + Ray(i,k) = visc%Ray_v(i,J,k) enddo ; enddo ; endif do i=is,ie ; if (do_i(i)) then From 0eccfba3984bff24dd3ad90247a113f6991c8e36 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Sep 2018 16:15:19 -0400 Subject: [PATCH 0750/1072] Changed visc%kv_bbl_u into units of Z2 s-1 Changed the dimensions of visc%kv_bbl_[uv] and visc%kv_tbl_[uv] to Z2 s-1, from m2 s-1, for expanded dimensional consistency testing. All answers are bitwise identical. --- src/core/MOM_variables.F90 | 10 +++++----- src/parameterizations/lateral/MOM_MEKE.F90 | 4 ++-- .../vertical/MOM_set_diffusivity.F90 | 6 +++--- .../vertical/MOM_set_viscosity.F90 | 18 +++++++++--------- .../vertical/MOM_vert_friction.F90 | 18 +++++++++--------- 5 files changed, 28 insertions(+), 28 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 3cfefd906c..b7f202aa5c 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -194,8 +194,8 @@ module MOM_variables real, pointer, dimension(:,:) :: & bbl_thick_u => NULL(), & !< The bottom boundary layer thickness at the u-points, in m. bbl_thick_v => NULL(), & !< The bottom boundary layer thickness at the v-points, in m. - kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points, in m2 s-1. - kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points, in m2 s-1. + kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points, in Z2 s-1. + kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points, in Z2 s-1. ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points, in m s-1. real, pointer, dimension(:,:) :: TKE_BBL => NULL() !< A term related to the bottom boundary layer source of turbulent kinetic @@ -208,9 +208,9 @@ module MOM_variables real, pointer, dimension(:,:) :: tbl_thick_shelf_v => NULL() !< Thickness of the viscous top boundary layer under ice shelves at v-points, in m. real, pointer, dimension(:,:) :: kv_tbl_shelf_u => NULL() - !< Viscosity in the viscous top boundary layer under ice shelves at u-points, in m2 s-1. + !< Viscosity in the viscous top boundary layer under ice shelves at u-points, in Z2 s-1. real, pointer, dimension(:,:) :: kv_tbl_shelf_v => NULL() - !< Viscosity in the viscous top boundary layer under ice shelves at v-points, in m2 s-1. + !< Viscosity in the viscous top boundary layer under ice shelves at v-points, in Z2 s-1. real, pointer, dimension(:,:) :: nkml_visc_u => NULL() !< The number of layers in the viscous surface mixed layer at u-points (nondimensional). !! This is not an integer because there may be fractional layers, and it is stored in @@ -243,7 +243,7 @@ module MOM_variables !! corner columns, in m2 s-1. real, pointer, dimension(:,:,:) :: Kv_slow => NULL() !< The turbulent vertical viscosity component due to "slow" processes (e.g., tidal, - !! background, convection etc). + !! background, convection etc), in m2 s-1. real, pointer, dimension(:,:,:) :: TKE_turb => NULL() !< The turbulent kinetic energy per unit mass at the interfaces, in m2 s-2. !! This may be at the tracer or corner points diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 21d6c21328..450eeb2b62 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -215,13 +215,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) do j=js,je ; do I=is-1,ie drag_vel_u(I,j) = 0.0 if ((G%mask2dCu(I,j) > 0.0) .and. (visc%bbl_thick_u(I,j) > 0.0)) & - drag_vel_u(I,j) = visc%kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) + drag_vel_u(I,j) = (GV%Z_to_m**2)*visc%kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) enddo ; enddo !$OMP do do J=js-1,je ; do i=is,ie drag_vel_v(i,J) = 0.0 if ((G%mask2dCv(i,J) > 0.0) .and. (visc%bbl_thick_v(i,J) > 0.0)) & - drag_vel_v(i,J) = visc%kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) + drag_vel_v(i,J) = (GV%Z_to_m**2)*visc%kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) enddo ; enddo !$OMP do diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index e3c591153f..f24ad1944c 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -540,7 +540,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then call uvchksum("BBL Kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, & - G%HI, 0, symmetric=.true.) + G%HI, 0, symmetric=.true., scale=GV%Z_to_m**2) endif if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) then @@ -1703,7 +1703,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) ! vertical decay scale. do i=is,ie ; if ((G%mask2dCv(i,J) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_v(i,J) > 0.0)) then do_i(i) = .true. ; vhtot(i) = 0.0 ; htot(i) = 0.0 - vstar(i,J) = visc%kv_bbl_v(i,J)/(cdrag_sqrt*visc%bbl_thick_v(i,J)) + vstar(i,J) = (GV%Z_to_m**2)*visc%kv_bbl_v(i,J)/(cdrag_sqrt*visc%bbl_thick_v(i,J)) else do_i(i) = .false. ; vstar(i,J) = 0.0 ; htot(i) = 0.0 endif ; enddo @@ -1733,7 +1733,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) do j=js,je do I=is-1,ie ; if ((G%mask2dCu(I,j) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_u(I,j) > 0.0)) then do_i(I) = .true. ; uhtot(I) = 0.0 ; htot(I) = 0.0 - ustar(I) = visc%kv_bbl_u(I,j)/(cdrag_sqrt*visc%bbl_thick_u(I,j)) + ustar(I) = (GV%Z_to_m**2)*visc%kv_bbl_u(I,j)/(cdrag_sqrt*visc%bbl_thick_u(I,j)) else do_i(I) = .false. ; ustar(I) = 0.0 ; htot(I) = 0.0 endif ; enddo diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 9eb4b80be0..f533d73d78 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -881,11 +881,11 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) bbl_thick_Z = bbl_thick * GV%H_to_Z if (m==1) then - visc%kv_bbl_u(I,j) = (GV%Z_to_m**2) * max(CS%KV_BBL_min, & + visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, & cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac) visc%bbl_thick_u(I,j) = GV%Z_to_m * bbl_thick_Z else - visc%kv_bbl_v(i,J) = (GV%Z_to_m**2) * max(CS%KV_BBL_min, & + visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, & cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac) visc%bbl_thick_v(i,J) = GV%Z_to_m * bbl_thick_Z endif @@ -895,10 +895,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) ! the correct stress when the shear occurs over bbl_thick. bbl_thick_Z = bbl_thick * GV%H_to_Z if (m==1) then - visc%kv_bbl_u(I,j) = (GV%Z_to_m**2) * max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) + visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) visc%bbl_thick_u(I,j) = GV%Z_to_m * bbl_thick_Z else - visc%kv_bbl_v(i,J) = (GV%Z_to_m**2) * max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) + visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) visc%bbl_thick_v(i,J) = GV%Z_to_m * bbl_thick_Z endif endif @@ -923,7 +923,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) & call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI, haloshift=0, scale=GV%Z_to_m) if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) & - call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, haloshift=0) + call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, haloshift=0, scale=GV%Z_to_m**2) if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) & call uvchksum("bbl_thick_[uv]", visc%bbl_thick_u, & visc%bbl_thick_v, G%HI, haloshift=0) @@ -1447,7 +1447,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(I)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) visc%tbl_thick_shelf_u(I,j) = GV%Z_to_m * tbl_thick_Z - visc%kv_tbl_shelf_u(I,j) = (GV%Z_to_m**2) * max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) + visc%kv_tbl_shelf_u(I,j) = max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) endif ; enddo ! I-loop endif ! do_any_shelf @@ -1692,7 +1692,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(i)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) visc%tbl_thick_shelf_v(i,J) = GV%Z_to_m * tbl_thick_Z - visc%kv_tbl_shelf_v(i,J) = (GV%Z_to_m**2) * max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) + visc%kv_tbl_shelf_v(i,J) = max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) endif ; enddo ! i-loop endif ! do_any_shelf @@ -2025,11 +2025,11 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) CS%id_bbl_thick_u = register_diag_field('ocean_model', 'bbl_thick_u', & diag%axesCu1, Time, 'BBL thickness at u points', 'm') CS%id_kv_bbl_u = register_diag_field('ocean_model', 'kv_bbl_u', diag%axesCu1, & - Time, 'BBL viscosity at u points', 'm2 s-1') + Time, 'BBL viscosity at u points', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_bbl_thick_v = register_diag_field('ocean_model', 'bbl_thick_v', & diag%axesCv1, Time, 'BBL thickness at v points', 'm') CS%id_kv_bbl_v = register_diag_field('ocean_model', 'kv_bbl_v', diag%axesCv1, & - Time, 'BBL viscosity at v points', 'm2 s-1') + Time, 'BBL viscosity at v points', 'm2 s-1', conversion=GV%Z_to_m**2) endif if (CS%Channel_drag) then allocate(visc%Ray_u(IsdB:IedB,jsd:jed,nz)) ; visc%Ray_u = 0.0 diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 0666601701..67c3ee5b29 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -599,7 +599,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) z_i ! An estimate of each interface's height above the bottom, ! normalized by the bottom boundary layer thickness, nondim. real, dimension(SZIB_(G)) :: & - kv_bbl, & ! The bottom boundary layer viscosity in m2 s-1. + kv_bbl, & ! The bottom boundary layer viscosity in Z2 s-1. bbl_thick, & ! The bottom boundary layer thickness in m or kg m-2. I_Hbbl, & ! The inverse of the bottom boundary layer thickness, in units ! of H-1 (i.e., m-1 or m2 kg-1). @@ -1045,7 +1045,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, intent(in) :: h_harm !< Harmonic mean of thicknesses around a velocity !! grid point, in H real, dimension(SZIB_(G)), intent(in) :: bbl_thick !< Bottom boundary layer thickness, in H - real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity, in m2 s-1 + real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity, in Z2 s-1 real, dimension(SZIB_(G),SZK_(GV)+1), & intent(in) :: z_i !< Estimate of interface heights above the bottom, !! normalized by the bottom boundary layer thickness @@ -1070,7 +1070,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, nk_visc, & ! The (real) interface index of the base of mixed layer. z_t, & ! The distance from the top, sometimes normalized ! by Hmix, in m or nondimensional. - kv_tbl, & + kv_tbl, & ! The viscosity in a top boundary layer under ice, in Z2 s-1. tbl_thick real, dimension(SZIB_(G),SZK_(GV)) :: & Kv_add ! A viscosity to add, in m2 s-1. @@ -1130,9 +1130,9 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (CS%bottomdraglaw) then r = hvel(i,nz)*0.5 if (r < bbl_thick(i)) then - a_cpl(i,nz+1) = 1.0*m2_to_Z2*kv_bbl(i) / (I_amax* m2_to_Z2*kv_bbl(i) + r*GV%H_to_Z) + a_cpl(i,nz+1) = 1.0*kv_bbl(i) / (I_amax*kv_bbl(i) + r*GV%H_to_Z) else - a_cpl(i,nz+1) = 1.0*m2_to_Z2*kv_bbl(i) / (I_amax* m2_to_Z2*kv_bbl(i) + bbl_thick(i)*GV%H_to_Z) + a_cpl(i,nz+1) = 1.0*kv_bbl(i) / (I_amax*kv_bbl(i) + bbl_thick(i)*GV%H_to_Z) endif else a_cpl(i,nz+1) = 2.0*m2_to_Z2*CS%Kvbbl / (hvel(i,nz)*GV%H_to_Z + 2.0*I_amax* m2_to_Z2*CS%Kvbbl) @@ -1236,7 +1236,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) if (CS%bottomdraglaw) then - a_cpl(i,K) = a_cpl(i,K) + 2.0*(kv_bbl(i)-CS%Kv)*botfn + a_cpl(i,K) = a_cpl(i,K) + 2.0*((GV%Z_to_m**2)*kv_bbl(i) - CS%Kv)*botfn r = (hvel(i,k)+hvel(i,k-1)) if (r > 2.0*bbl_thick(i)) then h_shear = ((1.0 - botfn) * r + botfn*2.0*bbl_thick(i)) @@ -1267,9 +1267,9 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! If a_cpl(i,1) were not already 0, it would be added here. if (0.5*hvel(i,1) > tbl_thick(i)) then - a_cpl(i,1) = m2_to_Z2 * kv_tbl(i) / (tbl_thick(i) *GV%H_to_Z + I_amax*(m2_to_Z2*kv_tbl(i))) + a_cpl(i,1) = kv_tbl(i) / (tbl_thick(i) *GV%H_to_Z + I_amax*kv_tbl(i)) else - a_cpl(i,1) = m2_to_Z2 * kv_tbl(i) / (0.5*hvel(i,1)*GV%H_to_Z + I_amax*(m2_to_Z2*kv_tbl(i))) + a_cpl(i,1) = kv_tbl(i) / (0.5*hvel(i,1)*GV%H_to_Z + I_amax*kv_tbl(i)) endif endif ; enddo @@ -1284,7 +1284,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_shear = r endif - a_top = 2.0 * topfn * (m2_to_Z2 * kv_tbl(i)) + a_top = 2.0 * topfn * kv_tbl(i) a_cpl(i,K) = a_cpl(i,K) + a_top / (h_shear*GV%H_to_Z + I_amax*a_top) endif ; enddo ; enddo elseif (CS%dynamic_viscous_ML .or. (GV%nkml>0)) then From 20060fe27292449fde3af8fde1b0757980c21d46 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Sep 2018 16:46:39 -0400 Subject: [PATCH 0751/1072] +Added the optional argument unscaled to get_param Added a new optional argument, unscaled, to the get_param_real and get_param_real_array routines, to return the value that is read without any rescaling, usually for later use as a default for another parameter. All answers are bitwise identical. --- src/framework/MOM_file_parser.F90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index a4daaa7c40..5c80fb9d51 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -1688,7 +1688,7 @@ end subroutine get_param_int_array !! and logs it in documentation files. subroutine get_param_real(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, & - static_value, debuggingParam, scale) + static_value, debuggingParam, scale, unscaled) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1712,6 +1712,8 @@ subroutine get_param_real(CS, modulename, varname, value, desc, units, & !! logged in the debugging parameter file real, optional, intent(in) :: scale !< A scaling factor that the parameter is !! multiplied by before it is returned. + real, optional, intent(out) :: unscaled !< The value of the parameter that would be + !! returned without any multiplication by a scaling factor. logical :: do_read, do_log @@ -1729,6 +1731,7 @@ subroutine get_param_real(CS, modulename, varname, value, desc, units, & default, debuggingParam) endif + if (present(unscaled)) unscaled = value if (present(scale)) value = scale*value end subroutine get_param_real @@ -1736,7 +1739,7 @@ end subroutine get_param_real !> This subroutine reads the values of an array of real model parameters from a parameter file !! and logs them in documentation files. subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & - default, fail_if_missing, do_not_read, do_not_log, static_value, scale) + default, fail_if_missing, do_not_read, do_not_log, static_value, scale, unscaled) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1758,6 +1761,8 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & !! parameter to the documentation files real, optional, intent(in) :: scale !< A scaling factor that the parameter is !! multiplied by before it is returned. + real, dimension(:), optional, intent(out) :: unscaled !< The value of the parameter that would be + !! returned without any multiplication by a scaling factor. logical :: do_read, do_log @@ -1775,6 +1780,7 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & units, default) endif + if (present(unscaled)) unscaled(:) = value(:) if (present(scale)) value(:) = scale*value(:) end subroutine get_param_real_array From 8164d0622d727a72482833de535298b226329b74 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Sep 2018 16:50:24 -0400 Subject: [PATCH 0752/1072] Use viscosities in Z2 s-1 in MOM_vert_friction Do the calculations in MOM_vert_friction with viscosities in Z2 s-1, instead of m2 s-1, for dimensional consistency testing, including rescaling several parameters when they are read. All answers are bitwise identical. --- .../vertical/MOM_vert_friction.F90 | 62 ++++++++++--------- 1 file changed, 32 insertions(+), 30 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 67c3ee5b29..54d6daca1b 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -31,9 +31,9 @@ module MOM_vert_friction !> The control structure with parameters and memory for the MOM_vert_friction module type, public :: vertvisc_CS ; private - real :: Hmix !< The mixed layer thickness in m. + real :: Hmix !< The mixed layer thickness in thickness units (H). real :: Hmix_stress !< The mixed layer thickness over which the wind - !! stress is applied with direct_stress, in m. + !! stress is applied with direct_stress, in H. real :: Kvml !< The mixed layer vertical viscosity in m2 s-1. real :: Kv !< The interior vertical viscosity in m2 s-1. real :: Hbbl !< The static bottom boundary layer thickness, in m. @@ -207,7 +207,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & "Module must be initialized before it is used.") if (CS%direct_stress) then - Hmix = CS%Hmix_stress*GV%m_to_H + Hmix = CS%Hmix_stress I_Hmix = 1.0 / Hmix endif dt_Rho0 = dt/GV%H_to_kg_m2 @@ -1073,7 +1073,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, kv_tbl, & ! The viscosity in a top boundary layer under ice, in Z2 s-1. tbl_thick real, dimension(SZIB_(G),SZK_(GV)) :: & - Kv_add ! A viscosity to add, in m2 s-1. + Kv_add ! A viscosity to add, in Z2 s-1. real :: h_shear ! The distance over which shears occur, m or kg m-2. real :: r ! A thickness to compare with Hbbl, in m or kg m-2. real :: visc_ml ! The mixed layer viscosity, in m2 s-1. @@ -1117,7 +1117,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if ((GV%nkml>0) .or. do_shelf) then ; do k=2,nz ; do i=is,ie if (do_i(i)) a_cpl(i,K) = 2.0*CS%Kv enddo ; enddo ; else - I_Hmix = 1.0 / (CS%Hmix * GV%m_to_H + h_neglect) + I_Hmix = 1.0 / (CS%Hmix + h_neglect) do i=is,ie ; z_t(i) = h_neglect*I_Hmix ; enddo do K=2,nz ; do i=is,ie ; if (do_i(i)) then z_t(i) = z_t(i) + h_harm(i,k-1)*I_Hmix @@ -1135,7 +1135,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, a_cpl(i,nz+1) = 1.0*kv_bbl(i) / (I_amax*kv_bbl(i) + bbl_thick(i)*GV%H_to_Z) endif else - a_cpl(i,nz+1) = 2.0*m2_to_Z2*CS%Kvbbl / (hvel(i,nz)*GV%H_to_Z + 2.0*I_amax* m2_to_Z2*CS%Kvbbl) + a_cpl(i,nz+1) = 2.0*CS%Kvbbl / (hvel(i,nz)*GV%H_to_Z + 2.0*I_amax*CS%Kvbbl) endif endif ; enddo @@ -1146,14 +1146,14 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! equal to 2 x \delta z if (work_on_u) then do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = (2.*0.5)*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i+1,j,k)) + Kv_add(i,K) = (2.*0.5)*m2_to_Z2*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i+1,j,k)) endif ; enddo ; enddo if (do_OBCs) then do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = 2.*m2_to_Z2*visc%Kv_shear(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i+1,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = 2.*m2_to_Z2*visc%Kv_shear(i+1,j,k) ; enddo endif endif ; enddo endif @@ -1162,14 +1162,14 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = (2.*0.5)*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i,j+1,k)) + Kv_add(i,K) = (2.*0.5)*m2_to_Z2*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i,j+1,k)) endif ; enddo ; enddo if (do_OBCs) then do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = 2.*m2_to_Z2*visc%Kv_shear(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j+1,k) ; enddo + do K=2,nz ; Kv_add(i,K) = 2.*m2_to_Z2*visc%Kv_shear(i,j+1,k) ; enddo endif endif ; enddo endif @@ -1182,11 +1182,11 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (associated(visc%Kv_shear_Bu)) then if (work_on_u) then do K=2,nz ; do I=Is,Ie ; If (do_i(I)) then - a_cpl(I,K) = a_cpl(I,K) + (2.*0.5)*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) + a_cpl(I,K) = a_cpl(I,K) + (2.*0.5)*m2_to_Z2*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + (2.*0.5)*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k)) + a_cpl(i,K) = a_cpl(i,K) + (2.*0.5)*m2_to_Z2*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo endif endif @@ -1196,14 +1196,14 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! GMM/ A factor of 2 is also needed here, see comment above from BGR. if (work_on_u) then do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = Kv_add(i,K) + 1.0 * (visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k)) + Kv_add(i,K) = Kv_add(i,K) + 1.0 * m2_to_Z2*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k)) endif ; enddo ; enddo if (do_OBCs) then do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * m2_to_Z2*visc%Kv_slow(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i+1,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * m2_to_Z2*visc%Kv_slow(i+1,j,k) ; enddo endif endif ; enddo endif @@ -1212,14 +1212,15 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = Kv_add(i,K) + 1.0*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j+1,k)) + Kv_add(i,K) = Kv_add(i,K) + 1.0*m2_to_Z2*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j+1,k)) endif ; enddo ; enddo + !### I am pretty sure that this is double counting here! - RWH if (do_OBCs) then do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * m2_to_Z2*visc%Kv_slow(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j+1,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * m2_to_Z2*visc%Kv_slow(i,j+1,k) ; enddo endif endif ; enddo endif @@ -1236,7 +1237,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) if (CS%bottomdraglaw) then - a_cpl(i,K) = a_cpl(i,K) + 2.0*((GV%Z_to_m**2)*kv_bbl(i) - CS%Kv)*botfn + a_cpl(i,K) = a_cpl(i,K) + 2.0*(kv_bbl(i) - CS%Kv)*botfn r = (hvel(i,k)+hvel(i,k-1)) if (r > 2.0*bbl_thick(i)) then h_shear = ((1.0 - botfn) * r + botfn*2.0*bbl_thick(i)) @@ -1248,8 +1249,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_shear = hvel(i,k) + hvel(i,k-1) + h_neglect endif - ! Up to this point a has units of m2 s-1, but now is converted to Z s-1. - a_cpl(i,K) = a_cpl(i,K) * m2_to_Z2 + ! Up to this point a_cpl has had units of Z2 s-1, but now is converted to Z s-1. a_cpl(i,K) = a_cpl(i,K) / (h_shear*GV%H_to_Z + I_amax*a_cpl(i,K)) endif ; enddo ; enddo ! i & k loops @@ -1576,6 +1576,8 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & ! Local variables real :: hmix_str_dflt + real :: Kv_dflt ! A default viscosity in m2 s-1. + real :: Hmix_m ! A boundary layer thickness, in m. integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz ! This include declares and sets the variable "version". #include "version_variable.h" @@ -1642,16 +1644,17 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface \n"//& "viscosity and diffusivity are elevated when the bulk \n"//& - "mixed layer is not used.", units="m", fail_if_missing=.true.) + "mixed layer is not used.", units="m", scale=GV%m_to_H, & + unscaled=Hmix_m, fail_if_missing=.true.) if (CS%direct_stress) then if (GV%nkml < 1) then call get_param(param_file, mdl, "HMIX_STRESS", CS%Hmix_stress, & "The depth over which the wind stress is applied if \n"//& - "DIRECT_STRESS is true.", units="m", default=CS%Hmix) + "DIRECT_STRESS is true.", units="m", default=Hmix_m, scale=GV%m_to_H) else call get_param(param_file, mdl, "HMIX_STRESS", CS%Hmix_stress, & "The depth over which the wind stress is applied if \n"//& - "DIRECT_STRESS is true.", units="m", fail_if_missing=.true.) + "DIRECT_STRESS is true.", units="m", fail_if_missing=.true., scale=GV%m_to_H) endif if (CS%Hmix_stress <= 0.0) call MOM_error(FATAL, "vertvisc_init: " // & "HMIX_STRESS must be set to a positive value if DIRECT_STRESS is true.") @@ -1659,19 +1662,18 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & call get_param(param_file, mdl, "KV", CS%Kv, & "The background kinematic viscosity in the interior. \n"//& "The molecular value, ~1e-6 m2 s-1, may be used.", & - units="m2 s-1", fail_if_missing=.true.) + units="m2 s-1", fail_if_missing=.true., scale=GV%m_to_Z**2, unscaled=Kv_dflt) -! CS%Kvml = CS%Kv ; CS%Kvbbl = CS%Kv ! Needed? -AJA if (GV%nkml < 1) call get_param(param_file, mdl, "KVML", CS%Kvml, & "The kinematic viscosity in the mixed layer. A typical \n"//& "value is ~1e-2 m2 s-1. KVML is not used if \n"//& "BULKMIXEDLAYER is true. The default is set by KV.", & - units="m2 s-1", default=CS%Kv) + units="m2 s-1", default=Kv_dflt, scale=GV%m_to_Z**2) if (.not.CS%bottomdraglaw) call get_param(param_file, mdl, "KVBBL", CS%Kvbbl, & "The kinematic viscosity in the benthic boundary layer. \n"//& "A typical value is ~1e-2 m2 s-1. KVBBL is not used if \n"//& "BOTTOMDRAGLAW is true. The default is set by KV.", & - units="m2 s-1", default=CS%Kv) + units="m2 s-1", default=Kv_dflt, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "HBBL", CS%Hbbl, & "The thickness of a bottom boundary layer with a \n"//& "viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or \n"//& From 3923bc51a54ebf60060bcb2f2858754c2a3720cf Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Sep 2018 18:23:56 -0400 Subject: [PATCH 0753/1072] Changed visc%bbl_thick_u into units of Z Changed the dimensions of visc%bbl_thick_[uv] and visc%tbl_thick_shelf_[uv] to Z, from m, for expanded dimensional consistency testing. All answers are bitwise identical. --- src/core/MOM_variables.F90 | 8 +++---- src/parameterizations/lateral/MOM_MEKE.F90 | 4 ++-- .../vertical/MOM_set_diffusivity.F90 | 18 +++++++-------- .../vertical/MOM_set_viscosity.F90 | 22 +++++++++---------- .../vertical/MOM_vert_friction.F90 | 12 +++++----- 5 files changed, 32 insertions(+), 32 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index b7f202aa5c..a2b0db9fb6 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -192,8 +192,8 @@ module MOM_variables real :: Prandtl_turb !< The Prandtl number for the turbulent diffusion !! that is captured in Kd_shear. real, pointer, dimension(:,:) :: & - bbl_thick_u => NULL(), & !< The bottom boundary layer thickness at the u-points, in m. - bbl_thick_v => NULL(), & !< The bottom boundary layer thickness at the v-points, in m. + bbl_thick_u => NULL(), & !< The bottom boundary layer thickness at the u-points, in Z. + bbl_thick_v => NULL(), & !< The bottom boundary layer thickness at the v-points, in Z. kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points, in Z2 s-1. kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points, in Z2 s-1. ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points, in m s-1. @@ -204,9 +204,9 @@ module MOM_variables taux_shelf => NULL(), & !< The zonal stresses on the ocean under shelves, in Pa. tauy_shelf => NULL() !< The meridional stresses on the ocean under shelves, in Pa. real, pointer, dimension(:,:) :: tbl_thick_shelf_u => NULL() - !< Thickness of the viscous top boundary layer under ice shelves at u-points, in m. + !< Thickness of the viscous top boundary layer under ice shelves at u-points, in Z. real, pointer, dimension(:,:) :: tbl_thick_shelf_v => NULL() - !< Thickness of the viscous top boundary layer under ice shelves at v-points, in m. + !< Thickness of the viscous top boundary layer under ice shelves at v-points, in Z. real, pointer, dimension(:,:) :: kv_tbl_shelf_u => NULL() !< Viscosity in the viscous top boundary layer under ice shelves at u-points, in Z2 s-1. real, pointer, dimension(:,:) :: kv_tbl_shelf_v => NULL() diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 450eeb2b62..949268c7e9 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -215,13 +215,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) do j=js,je ; do I=is-1,ie drag_vel_u(I,j) = 0.0 if ((G%mask2dCu(I,j) > 0.0) .and. (visc%bbl_thick_u(I,j) > 0.0)) & - drag_vel_u(I,j) = (GV%Z_to_m**2)*visc%kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) + drag_vel_u(I,j) = GV%Z_to_m*visc%kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) enddo ; enddo !$OMP do do J=js-1,je ; do i=is,ie drag_vel_v(i,J) = 0.0 if ((G%mask2dCv(i,J) > 0.0) .and. (visc%bbl_thick_v(i,J) > 0.0)) & - drag_vel_v(i,J) = (GV%Z_to_m**2)*visc%kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) + drag_vel_v(i,J) = GV%Z_to_m*visc%kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) enddo ; enddo !$OMP do diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index f24ad1944c..5db6034db3 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -545,7 +545,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) then call uvchksum("BBL bbl_thick_[uv]", visc%bbl_thick_u, & - visc%bbl_thick_v, G%HI, 0, symmetric=.true.) + visc%bbl_thick_v, G%HI, 0, symmetric=.true., scale=GV%Z_to_m) endif if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) then @@ -1658,21 +1658,21 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) real, dimension(SZI_(G)) :: & htot ! total thickness above or below a layer, or the - ! integrated thickness in the BBL (meter) + ! integrated thickness in the BBL (Z) real, dimension(SZIB_(G)) :: & - uhtot, & ! running integral of u in the BBL (m2/s) + uhtot, & ! running integral of u in the BBL (Z m/s) ustar, & ! bottom boundary layer turbulence speed (m/s) u2_bbl ! square of the mean zonal velocity in the BBL (m2/s2) - real :: vhtot(SZI_(G)) ! running integral of v in the BBL (m2/sec) + real :: vhtot(SZI_(G)) ! running integral of v in the BBL (Z m/sec) real, dimension(SZI_(G),SZJB_(G)) :: & vstar, & ! ustar at at v-points in 2 j-rows (m/s) v2_bbl ! square of average meridional velocity in BBL (m2/s2) real :: cdrag_sqrt ! square root of the drag coefficient (nondim) - real :: hvel ! thickness at velocity points (meter) + real :: hvel ! thickness at velocity points (Z) logical :: domore, do_i(SZI_(G)) integer :: i, j, k, is, ie, js, je, nz @@ -1703,14 +1703,14 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) ! vertical decay scale. do i=is,ie ; if ((G%mask2dCv(i,J) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_v(i,J) > 0.0)) then do_i(i) = .true. ; vhtot(i) = 0.0 ; htot(i) = 0.0 - vstar(i,J) = (GV%Z_to_m**2)*visc%kv_bbl_v(i,J)/(cdrag_sqrt*visc%bbl_thick_v(i,J)) + vstar(i,J) = GV%Z_to_m*visc%kv_bbl_v(i,J)/(cdrag_sqrt*visc%bbl_thick_v(i,J)) else do_i(i) = .false. ; vstar(i,J) = 0.0 ; htot(i) = 0.0 endif ; enddo do k=nz,1,-1 domore = .false. do i=is,ie ; if (do_i(i)) then - hvel = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j+1,k)) + hvel = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j+1,k)) if ((htot(i) + hvel) >= visc%bbl_thick_v(i,J)) then vhtot(i) = vhtot(i) + (visc%bbl_thick_v(i,J) - htot(i))*v(i,J,k) htot(i) = visc%bbl_thick_v(i,J) @@ -1733,13 +1733,13 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) do j=js,je do I=is-1,ie ; if ((G%mask2dCu(I,j) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_u(I,j) > 0.0)) then do_i(I) = .true. ; uhtot(I) = 0.0 ; htot(I) = 0.0 - ustar(I) = (GV%Z_to_m**2)*visc%kv_bbl_u(I,j)/(cdrag_sqrt*visc%bbl_thick_u(I,j)) + ustar(I) = GV%Z_to_m*visc%kv_bbl_u(I,j)/(cdrag_sqrt*visc%bbl_thick_u(I,j)) else do_i(I) = .false. ; ustar(I) = 0.0 ; htot(I) = 0.0 endif ; enddo do k=nz,1,-1 ; domore = .false. do I=is-1,ie ; if (do_i(I)) then - hvel = 0.5*GV%H_to_m*(h(i,j,k) + h(i+1,j,k)) + hvel = 0.5*GV%H_to_Z*(h(i,j,k) + h(i+1,j,k)) if ((htot(I) + hvel) >= visc%bbl_thick_u(I,j)) then uhtot(I) = uhtot(I) + (visc%bbl_thick_u(I,j) - htot(I))*u(I,j,k) htot(I) = visc%bbl_thick_u(I,j) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index f533d73d78..acebe8e6cf 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -883,11 +883,11 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (m==1) then visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, & cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac) - visc%bbl_thick_u(I,j) = GV%Z_to_m * bbl_thick_Z + visc%bbl_thick_u(I,j) = bbl_thick_Z else visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, & cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac) - visc%bbl_thick_v(i,J) = GV%Z_to_m * bbl_thick_Z + visc%bbl_thick_v(i,J) = bbl_thick_Z endif else ! Not Channel_drag. @@ -896,10 +896,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) bbl_thick_Z = bbl_thick * GV%H_to_Z if (m==1) then visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) - visc%bbl_thick_u(I,j) = GV%Z_to_m * bbl_thick_Z + visc%bbl_thick_u(I,j) = bbl_thick_Z else visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) - visc%bbl_thick_v(i,J) = GV%Z_to_m * bbl_thick_Z + visc%bbl_thick_v(i,J) = bbl_thick_Z endif endif endif ; enddo ! end of i loop @@ -926,7 +926,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, haloshift=0, scale=GV%Z_to_m**2) if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) & call uvchksum("bbl_thick_[uv]", visc%bbl_thick_u, & - visc%bbl_thick_v, G%HI, haloshift=0) + visc%bbl_thick_v, G%HI, haloshift=0, scale=GV%Z_to_m) endif end subroutine set_viscous_BBL @@ -1438,7 +1438,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) htot(i) = htot(i) + h_at_vel(i,nz) endif ! use_EOS - !visc%tbl_thick_shelf_u(I,j) = max(CS%Htbl_shelf_min, & + !visc%tbl_thick_shelf_u(I,j) = GV%H_to_Z * max(CS%Htbl_shelf_min, & ! htot(I) / (0.5 + sqrt(0.25 + & ! (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)))**2 / & ! (ustar(i)*GV%Z_to_H)**2 )) ) @@ -1446,7 +1446,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) h2f2 = (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(I)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) - visc%tbl_thick_shelf_u(I,j) = GV%Z_to_m * tbl_thick_Z + visc%tbl_thick_shelf_u(I,j) = tbl_thick_Z visc%kv_tbl_shelf_u(I,j) = max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) endif ; enddo ! I-loop endif ! do_any_shelf @@ -1683,7 +1683,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) htot(i) = htot(i) + h_at_vel(i,nz) endif ! use_EOS - !visc%tbl_thick_shelf_v(i,J) = max(CS%Htbl_shelf_min, & + !visc%tbl_thick_shelf_v(i,J) = GV%H_to_Z * max(CS%Htbl_shelf_min, & ! htot(i) / (0.5 + sqrt(0.25 + & ! (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))**2 / & ! (ustar(i)*GV%Z_to_H)**2 )) ) @@ -1691,7 +1691,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) h2f2 = (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(i)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) - visc%tbl_thick_shelf_v(i,J) = GV%Z_to_m * tbl_thick_Z + visc%tbl_thick_shelf_v(i,J) = tbl_thick_Z visc%kv_tbl_shelf_v(i,J) = max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) endif ; enddo ! i-loop @@ -2023,11 +2023,11 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) allocate(visc%TKE_bbl(isd:ied,jsd:jed)) ; visc%TKE_bbl = 0.0 CS%id_bbl_thick_u = register_diag_field('ocean_model', 'bbl_thick_u', & - diag%axesCu1, Time, 'BBL thickness at u points', 'm') + diag%axesCu1, Time, 'BBL thickness at u points', 'm', conversion=GV%Z_to_m) CS%id_kv_bbl_u = register_diag_field('ocean_model', 'kv_bbl_u', diag%axesCu1, & Time, 'BBL viscosity at u points', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_bbl_thick_v = register_diag_field('ocean_model', 'bbl_thick_v', & - diag%axesCv1, Time, 'BBL thickness at v points', 'm') + diag%axesCv1, Time, 'BBL thickness at v points', 'm', conversion=GV%Z_to_m) CS%id_kv_bbl_v = register_diag_field('ocean_model', 'kv_bbl_v', diag%axesCv1, & Time, 'BBL viscosity at v points', 'm2 s-1', conversion=GV%Z_to_m**2) endif diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 54d6daca1b..64aec71fbb 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -677,7 +677,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) if (CS%bottomdraglaw) then ; do I=Isq,Ieq kv_bbl(I) = visc%kv_bbl_u(I,j) - bbl_thick(I) = visc%bbl_thick_u(I,j) * GV%m_to_H + bbl_thick(I) = visc%bbl_thick_u(I,j) * GV%Z_to_H if (do_i(I)) I_Hbbl(I) = 1.0 / (bbl_thick(I) + h_neglect) enddo ; endif @@ -774,7 +774,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! Perhaps this needs to be done more carefully, via find_eta. do I=Isq,Ieq ; if (do_i_shelf(I)) then zh(I) = 0.0 ; Ztop_min(I) = min(zcol(i), zcol(i+1)) - I_HTbl(I) = 1.0 / (visc%tbl_thick_shelf_u(I,j)*GV%m_to_H + h_neglect) + I_HTbl(I) = 1.0 / (visc%tbl_thick_shelf_u(I,j)*GV%Z_to_H + h_neglect) endif ; enddo do k=1,nz do i=Isq,Ieq+1 ; zcol(i) = zcol(i) - h(i,j,k) ; enddo @@ -844,7 +844,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) if (CS%bottomdraglaw) then ; do i=is,ie kv_bbl(i) = visc%kv_bbl_v(i,J) - bbl_thick(i) = visc%bbl_thick_v(i,J) * GV%m_to_H + bbl_thick(i) = visc%bbl_thick_v(i,J) * GV%Z_to_H if (do_i(i)) I_Hbbl(i) = 1.0 / bbl_thick(i) enddo ; endif @@ -942,7 +942,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! Perhaps this needs to be done more carefully, via find_eta. do i=is,ie ; if (do_i_shelf(i)) then zh(i) = 0.0 ; Ztop_min(I) = min(zcol1(i), zcol2(i)) - I_HTbl(i) = 1.0 / (visc%tbl_thick_shelf_v(i,J)*GV%m_to_H + h_neglect) + I_HTbl(i) = 1.0 / (visc%tbl_thick_shelf_v(i,J)*GV%Z_to_H + h_neglect) endif ; enddo do k=1,nz do i=is,ie ; if (do_i_shelf(i)) then @@ -1258,10 +1258,10 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, do i=is,ie ; if (do_i(i)) then if (work_on_u) then kv_tbl(i) = visc%kv_tbl_shelf_u(I,j) - tbl_thick(i) = visc%tbl_thick_shelf_u(I,j) * GV%m_to_H + tbl_thick(i) = visc%tbl_thick_shelf_u(I,j) * GV%Z_to_H else kv_tbl(i) = visc%kv_tbl_shelf_v(i,J) - tbl_thick(i) = visc%tbl_thick_shelf_v(i,J) * GV%m_to_H + tbl_thick(i) = visc%tbl_thick_shelf_v(i,J) * GV%Z_to_H endif z_t(i) = 0.0 From d1b15c4a20f60895633c45fa700c763baac5a334 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Thu, 27 Sep 2018 15:29:39 -0400 Subject: [PATCH 0754/1072] Diag decimation prototype, requesting in diag_table - This update allows the use to request a level 2 decimated diagnostics in the diag_table as following example shows OMp5 1900 1 1 0 0 0 "ocean_hour", 0, "days", 1, "days", "time" "ocean_model", "tos", "tos", "ocean_hour", "all", "mean", "none",2 "ocean_model", "thetao", "thetao", "ocean_hour", "all", "mean", "none",2 "ocean_model", "umo", "umo", "ocean_hour", "all", "mean", "none",2 "ocean_model", "vmo", "vmo", "ocean_hour", "all", "mean", "none",2 "ocean_model", "volcello", "volcello", "ocean_hour", "all", "mean", "none",2 # Cell measure for 3d data "ocean_hour_d2", 0, "days", 1, "days", "time" "ocean_model_d2", "tos", "tos", "ocean_hour_d2", "all", "mean", "none",2 "ocean_model_d2", "thetao", "thetao", "ocean_hour_d2", "all", "mean", "none",2 "ocean_model_d2", "umo", "umo", "ocean_hour_d2", "all", "mean", "none",2 "ocean_model_d2", "vmo", "vmo", "ocean_hour_d2", "all", "mean", "none",2 "ocean_model_d2", "volcello", "volcello", "ocean_hour_d2", "all", "mean", "none",2 # Cell measure for 3d data - At the moment it works only for "Native" grid diagnostics and level 2 decimation (bination?) - It has to be extended to non-native diagnostics, e.g., "ocean_model_z_d2", "tos", "tos", "ocean_hour_z_d2", "all", "mean", "none",2 - It has to be extended to arbitrary level of decimation, e.g., "ocean_model_z_d4", "tos", "tos", "ocean_hour_z_d4", "all", "mean", "none",2 "ocean_model_z_d2", "tos", "tos", "ocean_hour_z_d2", "all", "mean", "none",2 - Also, note that this prototype only works for smart choices of layouts where "combined" cells are on the same pe We need a major design revision to extend this to arbitrary layouts that would need halo updates and halo handling. --- src/framework/MOM_diag_mediator.F90 | 1199 +++++++++++++++++---------- src/framework/MOM_diag_remap.F90 | 17 - 2 files changed, 745 insertions(+), 471 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 8571283fd3..9bb049dbb7 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -8,7 +8,7 @@ module MOM_diag_mediator use MOM_coms, only : PE_here use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE, CLOCK_ROUTINE -use MOM_error_handler, only : MOM_error, FATAL, is_root_pe, assert +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe, assert use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_io, only : slasher, vardesc, query_vardesc, mom_read_data @@ -25,7 +25,7 @@ module MOM_diag_mediator use MOM_diag_remap, only : diag_remap_configure_axes, diag_remap_axes_configured use MOM_diag_remap, only : diag_remap_get_axes_info, diag_remap_set_active use MOM_diag_remap, only : diag_remap_diag_registration_closed -use MOM_diag_remap, only : horizontally_average_diag_field, horizontally_decimate_diag_field +use MOM_diag_remap, only : horizontally_average_diag_field use diag_axis_mod, only : get_diag_axis_name use diag_data_mod, only : null_axis_id @@ -42,6 +42,7 @@ module MOM_diag_mediator #undef __DO_SAFETY_CHECKS__ #define IMPLIES(A, B) ((.not. (A)) .or. (B)) +#define MAX_DECIM_LEV 2 public set_axes_info, post_data, register_diag_field, time_type public set_masks_for_axes @@ -71,6 +72,19 @@ module MOM_diag_mediator module procedure zap2_sample_2d,zap2_sample_3d,zap2_sample_2d0,zap2_sample_3d0 end interface zap2_sample +interface decimate_sample + module procedure decimate_sample_2d, decimate_sample_3d +end interface decimate_sample + +interface decimate_diag_field + module procedure decimate_diag_field_2d,decimate_diag_field_3d +end interface decimate_diag_field + +type, private :: diag_decim + real, pointer, dimension(:,:) :: mask2d => null() !< Mask for 2d (x-y) axes + real, pointer, dimension(:,:,:) :: mask3d => null() !< Mask for 3d axes +end type diag_decim + !> A group of 1D axes that comprise a 1D/2D/3D mesh type, public :: axes_grp character(len=15) :: id !< The id string for this particular combination of handles. @@ -103,6 +117,7 @@ module MOM_diag_mediator logical :: needs_interpolating = .false. !< If true, indicates that this axes group is for a sampled !! interface-located field that must be interpolated to !! these axes. Used for rank>2. + integer :: decimation_level = 1 !< If greater than 1, the factor by which this diagnostic/axes/masks be decimated ! For horizontally averaged diagnositcs (applies to 2d and 3d fields only) type(axes_grp), pointer :: xyave_axes => null() !< The associated 1d axes for horizontall area-averaged diagnostics ! ID's for cell_measures @@ -112,8 +127,7 @@ module MOM_diag_mediator ! For masking real, pointer, dimension(:,:) :: mask2d => null() !< Mask for 2d (x-y) axes real, pointer, dimension(:,:,:) :: mask3d => null() !< Mask for 3d axes - real, pointer, dimension(:,:) :: mask2d_zap2 => null() !< Mask for 2d (x-y) axes zapped by a factor 2 - real, pointer, dimension(:,:,:) :: mask3d_zap2 => null() !< Mask for 3d axes zapped by a factor 2 + type(diag_decim), dimension(2:MAX_DECIM_LEV) :: decim !< Decimation container end type axes_grp !> Contains an array to store a diagnostic target grid @@ -148,6 +162,36 @@ module MOM_diag_mediator !! False for intensive (concentrations). end type diag_type +type diagcs_decim + integer :: isc !< The start i-index of cell centers within the computational domain + integer :: iec !< The end i-index of cell centers within the computational domain + integer :: jsc !< The start j-index of cell centers within the computational domain + integer :: jec !< The end j-index of cell centers within the computational domain + integer :: isd !< The start i-index of cell centers within the data domain + integer :: ied !< The end i-index of cell centers within the data domain + integer :: jsd !< The start j-index of cell centers within the data domain + integer :: jed !< The end j-index of cell centers within the data domain + integer :: isg,ieg,jsg,jeg + + type(axes_grp) :: axesBL, axesTL, axesCuL, axesCvL + type(axes_grp) :: axesBi, axesTi, axesCui, axesCvi + type(axes_grp) :: axesB1, axesT1, axesCu1, axesCv1 + + real, dimension(:,:), pointer :: mask2dT => null() !< 2D mask array for cell-center points + real, dimension(:,:), pointer :: mask2dBu => null() !< 2D mask array for cell-corner points + real, dimension(:,:), pointer :: mask2dCu => null() !< 2D mask array for east-face points + real, dimension(:,:), pointer :: mask2dCv => null() !< 2D mask array for north-face points + !>@{ 3D mask arrays for diagnostics at layers (mask...L) and interfaces (mask...i) + real, dimension(:,:,:), pointer :: mask3dTL => null() + real, dimension(:,:,:), pointer :: mask3dBL => null() + real, dimension(:,:,:), pointer :: mask3dCuL => null() + real, dimension(:,:,:), pointer :: mask3dCvL => null() + real, dimension(:,:,:), pointer :: mask3dTi => null() + real, dimension(:,:,:), pointer :: mask3dBi => null() + real, dimension(:,:,:), pointer :: mask3dCui => null() + real, dimension(:,:,:), pointer :: mask3dCvi => null() +end type diagcs_decim + !> The following data type a list of diagnostic fields an their variants, !! as well as variables that control the handling of model output. type, public :: diag_ctrl @@ -182,7 +226,7 @@ module MOM_diag_mediator type(axes_grp) :: axesZi !< A 1-D z-space axis at interfaces type(axes_grp) :: axesZL !< A 1-D z-space axis at layer centers type(axes_grp) :: axesNull !< An axis group for scalars - + real, dimension(:,:), pointer :: mask2dT => null() !< 2D mask array for cell-center points real, dimension(:,:), pointer :: mask2dBu => null() !< 2D mask array for cell-corner points real, dimension(:,:), pointer :: mask2dCu => null() !< 2D mask array for east-face points @@ -196,29 +240,10 @@ module MOM_diag_mediator real, dimension(:,:,:), pointer :: mask3dBi => null() real, dimension(:,:,:), pointer :: mask3dCui => null() real, dimension(:,:,:), pointer :: mask3dCvi => null() + + type(diagcs_decim), dimension(2:MAX_DECIM_LEV) :: decim !< Decimation control container + !!@} - real, dimension(:,:), pointer :: mask2dT_zap2 => null() !< 2D mask array for cell-center points - real, dimension(:,:), pointer :: mask2dBu_zap2 => null() !< 2D mask array for cell-corner points - real, dimension(:,:), pointer :: mask2dCu_zap2 => null() !< 2D mask array for east-face points - real, dimension(:,:), pointer :: mask2dCv_zap2 => null() !< 2D mask array for north-face points - !>@{ 3D mask arrays for diagnostics at layers (mask...L) and interfaces (mask...i) - real, dimension(:,:,:), pointer :: mask3dTL_zap2 => null() - real, dimension(:,:,:), pointer :: mask3dBL_zap2 => null() - real, dimension(:,:,:), pointer :: mask3dCuL_zap2 => null() - real, dimension(:,:,:), pointer :: mask3dCvL_zap2 => null() - real, dimension(:,:,:), pointer :: mask3dTi_zap2 => null() - real, dimension(:,:,:), pointer :: mask3dBi_zap2 => null() - real, dimension(:,:,:), pointer :: mask3dCui_zap2 => null() - real, dimension(:,:,:), pointer :: mask3dCvi_zap2 => null() - !!@} - integer :: isc_zap2 !< The start i-index of cell centers within the computational domain - integer :: iec_zap2 !< The end i-index of cell centers within the computational domain - integer :: jsc_zap2 !< The start j-index of cell centers within the computational domain - integer :: jec_zap2 !< The end j-index of cell centers within the computational domain - integer :: isd_zap2 !< The start i-index of cell centers within the data domain - integer :: ied_zap2 !< The end i-index of cell centers within the data domain - integer :: jsd_zap2 !< The start j-index of cell centers within the data domain - integer :: jed_zap2 !< The end j-index of cell centers within the data domain ! Space for diagnostics is dynamically allocated as it is needed. ! The chunk size is how much the array should grow on each new allocation. @@ -263,12 +288,11 @@ module MOM_diag_mediator end type diag_ctrl + + ! CPU clocks integer :: id_clock_diag_mediator, id_clock_diag_remap, id_clock_diag_grid_updates -logical :: decim_all_diags = .true. -integer :: decim_fac = 2 - contains !> Sets up diagnostics axes @@ -281,60 +305,14 @@ subroutine set_axes_info(G, GV, param_file, diag_cs, set_vertical) !! vertical axes ! Local variables integer :: id_xq, id_yq, id_zl, id_zi, id_xh, id_yh - integer :: i, j, k, nz + integer :: i, j, k, nz, dl real :: zlev(GV%ke), zinter(GV%ke+1) logical :: set_vert - real, dimension(:), pointer :: gridLonT_zap2 =>NULL() - real, dimension(:), pointer :: gridLatT_zap2 =>NULL() + real, dimension(:), pointer :: gridLonT_zap =>NULL() + real, dimension(:), pointer :: gridLatT_zap =>NULL() set_vert = .true. ; if (present(set_vertical)) set_vert = set_vertical -if(decim_all_diags) then - - allocate(gridLonT_zap2(G%isg_zap2:G%ieg_zap2)) - allocate(gridLatT_zap2(G%jsg_zap2:G%jeg_zap2)) - - do i=G%isg_zap2,G%ieg_zap2; gridLonT_zap2(i) = G%gridLonT(G%isg+decim_fac*i-2); enddo - do j=G%jsg_zap2,G%jeg_zap2; gridLatT_zap2(j) = G%gridLatT(G%jsg+decim_fac*j-2); enddo - - -! if (G%symmetric) then -! id_xq = diag_axis_init('xq', G%gridLonB_zap2(G%isgB:G%iegB), G%x_axis_units, 'x', & -! 'q point nominal longitude', Domain2=G%Domain%mpp_domain_zap2) -! id_yq = diag_axis_init('yq', G%gridLatB_zap2(G%jsgB:G%jegB), G%y_axis_units, 'y', & -! 'q point nominal latitude', Domain2=G%Domain%mpp_domain_zap2) -! else - id_xq = diag_axis_init('xq', gridLonT_zap2(G%isg_zap2:G%ieg_zap2), G%x_axis_units, 'x', & - 'q point nominal longitude', Domain2=G%Domain%mpp_domain_zap2) - id_yq = diag_axis_init('yq', gridLatT_zap2(G%jsg_zap2:G%jeg_zap2), G%y_axis_units, 'y', & - 'q point nominal latitude', Domain2=G%Domain%mpp_domain_zap2) -! endif - id_xh = diag_axis_init('xh', gridLonT_zap2(G%isg_zap2:G%ieg_zap2), G%x_axis_units, 'x', & - 'h point nominal longitude', Domain2=G%Domain%mpp_domain_zap2) - id_yh = diag_axis_init('yh', gridLatT_zap2(G%jsg_zap2:G%jeg_zap2), G%y_axis_units, 'y', & - 'h point nominal latitude', Domain2=G%Domain%mpp_domain_zap2) - - deallocate(gridLonT_zap2) - deallocate(gridLatT_zap2) - -else - if (G%symmetric) then - id_xq = diag_axis_init('xq', G%gridLonB(G%isgB:G%iegB), G%x_axis_units, 'x', & - 'q point nominal longitude', Domain2=G%Domain%mpp_domain) - id_yq = diag_axis_init('yq', G%gridLatB(G%jsgB:G%jegB), G%y_axis_units, 'y', & - 'q point nominal latitude', Domain2=G%Domain%mpp_domain) - else - id_xq = diag_axis_init('xq', G%gridLonB(G%isg:G%ieg), G%x_axis_units, 'x', & - 'q point nominal longitude', Domain2=G%Domain%mpp_domain) - id_yq = diag_axis_init('yq', G%gridLatB(G%jsg:G%jeg), G%y_axis_units, 'y', & - 'q point nominal latitude', Domain2=G%Domain%mpp_domain) - endif - id_xh = diag_axis_init('xh', G%gridLonT(G%isg:G%ieg), G%x_axis_units, 'x', & - 'h point nominal longitude', Domain2=G%Domain%mpp_domain) - id_yh = diag_axis_init('yh', G%gridLatT(G%jsg:G%jeg), G%y_axis_units, 'y', & - 'h point nominal latitude', Domain2=G%Domain%mpp_domain) -endif - if (set_vert) then nz = GV%ke zinter(1:nz+1) = GV%sInterface(1:nz+1) @@ -350,11 +328,29 @@ subroutine set_axes_info(G, GV, param_file, diag_cs, set_vertical) endif ! Vertical axes for the interfaces and layers - call define_axes_group(diag_cs, (/ id_zi /), diag_cs%axesZi, & + call define_axes_group(diag_cs, (/ id_zi /), diag_cs%axesZi, 1, & v_cell_method='point', is_interface=.true.) - call define_axes_group(diag_cs, (/ id_zL /), diag_cs%axesZL, & + call define_axes_group(diag_cs, (/ id_zL /), diag_cs%axesZL, 1, & v_cell_method='mean', is_layer=.true.) + ! Horizontal axes for the native grid + + if (G%symmetric) then + id_xq = diag_axis_init('xq', G%gridLonB(G%isgB:G%iegB), G%x_axis_units, 'x', & + 'q point nominal longitude', Domain2=G%Domain%mpp_domain) + id_yq = diag_axis_init('yq', G%gridLatB(G%jsgB:G%jegB), G%y_axis_units, 'y', & + 'q point nominal latitude', Domain2=G%Domain%mpp_domain) + else + id_xq = diag_axis_init('xq', G%gridLonB(G%isg:G%ieg), G%x_axis_units, 'x', & + 'q point nominal longitude', Domain2=G%Domain%mpp_domain) + id_yq = diag_axis_init('yq', G%gridLatB(G%jsg:G%jeg), G%y_axis_units, 'y', & + 'q point nominal latitude', Domain2=G%Domain%mpp_domain) + endif + id_xh = diag_axis_init('xh', G%gridLonT(G%isg:G%ieg), G%x_axis_units, 'x', & + 'h point nominal longitude', Domain2=G%Domain%mpp_domain) + id_yh = diag_axis_init('yh', G%gridLatT(G%jsg:G%jeg), G%y_axis_units, 'y', & + 'h point nominal latitude', Domain2=G%Domain%mpp_domain) + ! Axis groupings for the model layers call define_axes_group(diag_cs, (/ id_xh, id_yh, id_zL /), diag_cs%axesTL, & x_cell_method='mean', y_cell_method='mean', v_cell_method='mean', & @@ -392,10 +388,82 @@ subroutine set_axes_info(G, GV, param_file, diag_cs, set_vertical) x_cell_method='point', y_cell_method='mean', is_u_point=.true.) call define_axes_group(diag_cs, (/ id_xh, id_yq /), diag_cs%axesCv1, & x_cell_method='mean', y_cell_method='point', is_v_point=.true.) - ! Axis group for special null axis from diag manager call define_axes_group(diag_cs, (/ null_axis_id /), diag_cs%axesNull) + !Axes group for native decimated diagnostics + do dl=2,MAX_DECIM_LEV + + if(dl .eq. 2) then + allocate(gridLonT_zap(diag_cs%decim(dl)%isg:diag_cs%decim(dl)%ieg)) + allocate(gridLatT_zap(diag_cs%decim(dl)%jsg:diag_cs%decim(dl)%jeg)) + + do i=diag_cs%decim(dl)%isg,diag_cs%decim(dl)%ieg; gridLonT_zap(i) = G%gridLonT(G%isg+dl*i-2); enddo + do j=diag_cs%decim(dl)%jsg,diag_cs%decim(dl)%jeg; gridLatT_zap(j) = G%gridLatT(G%jsg+dl*j-2); enddo + + + ! if (G%symmetric) then + ! id_xq = diag_axis_init('xq', G%gridLonB_zap2(G%isgB:G%iegB), G%x_axis_units, 'x', & + ! 'q point nominal longitude', Domain2=G%Domain%mpp_domain_zap2) + ! id_yq = diag_axis_init('yq', G%gridLatB_zap2(G%jsgB:G%jegB), G%y_axis_units, 'y', & + ! 'q point nominal latitude', Domain2=G%Domain%mpp_domain_zap2) + ! else + id_xq = diag_axis_init('xq', gridLonT_zap, G%x_axis_units, 'x', & + 'q point nominal longitude', Domain2=G%Domain%mpp_domain_zap2) + id_yq = diag_axis_init('yq', gridLatT_zap, G%y_axis_units, 'y', & + 'q point nominal latitude', Domain2=G%Domain%mpp_domain_zap2) + ! endif + id_xh = diag_axis_init('xh', gridLonT_zap, G%x_axis_units, 'x', & + 'h point nominal longitude', Domain2=G%Domain%mpp_domain_zap2) + id_yh = diag_axis_init('yh', gridLatT_zap, G%y_axis_units, 'y', & + 'h point nominal latitude', Domain2=G%Domain%mpp_domain_zap2) + + deallocate(gridLonT_zap) + deallocate(gridLatT_zap) + else + call MOM_error(FATAL, "This decimation level is not supported yet!") + endif + + ! Axis groupings for the model layers + call define_axes_group_decim(diag_cs, (/ id_xh, id_yh, id_zL /), diag_cs%decim(dl)%axesTL, dl, & + x_cell_method='mean', y_cell_method='mean', v_cell_method='mean', & + is_h_point=.true., is_layer=.true., xyave_axes=diag_cs%axesZL) + call define_axes_group_decim(diag_cs, (/ id_xq, id_yq, id_zL /), diag_cs%decim(dl)%axesBL, dl, & + x_cell_method='point', y_cell_method='point', v_cell_method='mean', & + is_q_point=.true., is_layer=.true.) + call define_axes_group_decim(diag_cs, (/ id_xq, id_yh, id_zL /), diag_cs%decim(dl)%axesCuL, dl, & + x_cell_method='point', y_cell_method='mean', v_cell_method='mean', & + is_u_point=.true., is_layer=.true., xyave_axes=diag_cs%axesZL) + call define_axes_group_decim(diag_cs, (/ id_xh, id_yq, id_zL /), diag_cs%decim(dl)%axesCvL, dl, & + x_cell_method='mean', y_cell_method='point', v_cell_method='mean', & + is_v_point=.true., is_layer=.true., xyave_axes=diag_cs%axesZL) + + ! Axis groupings for the model interfaces + call define_axes_group_decim(diag_cs, (/ id_xh, id_yh, id_zi /), diag_cs%decim(dl)%axesTi, dl, & + x_cell_method='mean', y_cell_method='mean', v_cell_method='point', & + is_h_point=.true., is_interface=.true., xyave_axes=diag_cs%axesZi) + call define_axes_group_decim(diag_cs, (/ id_xq, id_yq, id_zi /), diag_cs%decim(dl)%axesBi, dl, & + x_cell_method='point', y_cell_method='point', v_cell_method='point', & + is_q_point=.true., is_interface=.true.) + call define_axes_group_decim(diag_cs, (/ id_xq, id_yh, id_zi /), diag_cs%decim(dl)%axesCui, dl, & + x_cell_method='point', y_cell_method='mean', v_cell_method='point', & + is_u_point=.true., is_interface=.true., xyave_axes=diag_cs%axesZi) + call define_axes_group_decim(diag_cs, (/ id_xh, id_yq, id_zi /), diag_cs%decim(dl)%axesCvi, dl, & + x_cell_method='mean', y_cell_method='point', v_cell_method='point', & + is_v_point=.true., is_interface=.true., xyave_axes=diag_cs%axesZi) + + ! Axis groupings for 2-D arrays + call define_axes_group_decim(diag_cs, (/ id_xh, id_yh /), diag_cs%decim(dl)%axesT1, dl, & + x_cell_method='mean', y_cell_method='mean', is_h_point=.true.) + call define_axes_group_decim(diag_cs, (/ id_xq, id_yq /), diag_cs%decim(dl)%axesB1, dl, & + x_cell_method='point', y_cell_method='point', is_q_point=.true.) + call define_axes_group_decim(diag_cs, (/ id_xq, id_yh /), diag_cs%decim(dl)%axesCu1, dl, & + x_cell_method='point', y_cell_method='mean', is_u_point=.true.) + call define_axes_group_decim(diag_cs, (/ id_xh, id_yq /), diag_cs%decim(dl)%axesCv1, dl, & + x_cell_method='mean', y_cell_method='point', is_v_point=.true.) + + enddo + if (diag_cs%num_diag_coords>0) then allocate(diag_cs%remap_axesZL(diag_cs%num_diag_coords)) allocate(diag_cs%remap_axesTL(diag_cs%num_diag_coords)) @@ -425,6 +493,7 @@ subroutine set_axes_info(G, GV, param_file, diag_cs, set_vertical) nz=nz, vertical_coordinate_number=i, & v_cell_method='mean', & is_h_point=.true., is_layer=.true., is_native=.false., needs_remapping=.true.) + call define_axes_group(diag_cs, (/ id_xh, id_yh, id_zL /), diag_cs%remap_axesTL(i), & nz=nz, vertical_coordinate_number=i, & x_cell_method='mean', y_cell_method='mean', v_cell_method='mean', & @@ -451,7 +520,7 @@ subroutine set_axes_info(G, GV, param_file, diag_cs, set_vertical) xyave_axes=diag_cs%remap_axesZL(i)) ! Axes for z interfaces - call define_axes_group(diag_cs, (/ id_zi /), diag_cs%remap_axesZi(i), & + call define_axes_group(diag_cs, (/ id_zi /), diag_cs%remap_axesZi(i),& nz=nz, vertical_coordinate_number=i, & v_cell_method='point', & is_h_point=.true., is_interface=.true., is_native=.false., needs_interpolating=.true.) @@ -480,7 +549,7 @@ subroutine set_axes_info(G, GV, param_file, diag_cs, set_vertical) needs_interpolating=.true., xyave_axes=diag_cs%remap_axesZi(i)) endif enddo - + call diag_grid_storage_init(diag_CS%diag_grid_temp, G, diag_CS) end subroutine set_axes_info @@ -504,9 +573,7 @@ subroutine set_masks_for_axes(G, diag_cs) nk = axes%nz allocate( axes%mask3d(G%isd:G%ied,G%jsd:G%jed,nk) ) ; axes%mask3d(:,:,:) = 0. call diag_remap_calc_hmask(diag_cs%diag_remap_cs(c), G, axes%mask3d) - if(decim_all_diags) call zap2_sample(axes%mask3d, axes%mask3d_zap2, 1,nk, G%isd,G%ied,G%jsd,G%jed,& - G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2) - + h_axes => diag_cs%remap_axesTL(c) ! Use the h-point masks to generate the u-, v- and q- masks ! Level/layer u-points in diagnostic coordinate @@ -517,8 +584,6 @@ subroutine set_masks_for_axes(G, diag_cs) do k = 1, nk ; do j=G%jsc,G%jec ; do I=G%isc-1,G%iec if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i+1,j,k) > 0.) axes%mask3d(I,j,k) = 1. enddo ; enddo ; enddo - if(decim_all_diags) call zap2_sample(axes%mask3d, axes%mask3d_zap2, 1,nk, G%isdb,G%iedb,G%jsd,G%jed,& - G%isdb_zap2,G%iedb_zap2,G%jsd_zap2,G%jed_zap2) ! Level/layer v-points in diagnostic coordinate axes => diag_cs%remap_axesCvL(c) @@ -528,8 +593,6 @@ subroutine set_masks_for_axes(G, diag_cs) do k = 1, nk ; do J=G%jsc-1,G%jec ; do i=G%isc,G%iec if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i,j+1,k) > 0.) axes%mask3d(i,J,k) = 1. enddo ; enddo ; enddo - if(decim_all_diags) call zap2_sample(axes%mask3d, axes%mask3d_zap2, 1,nk, G%isd,G%ied,G%jsdb,G%jedb,& - G%isd_zap2,G%ied_zap2,G%jsdb_zap2,G%jedb_zap2) ! Level/layer q-points in diagnostic coordinate axes => diag_cs%remap_axesBL(c) @@ -540,8 +603,6 @@ subroutine set_masks_for_axes(G, diag_cs) if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i+1,j+1,k) + & h_axes%mask3d(i+1,j,k) + h_axes%mask3d(i,j+1,k) > 0.) axes%mask3d(I,J,k) = 1. enddo ; enddo ; enddo - if(decim_all_diags) call zap2_sample(axes%mask3d, axes%mask3d_zap2, 1,nk, G%isdb,G%iedb,G%jsdb,G%jedb,& - G%isdb_zap2,G%iedb_zap2,G%jsdb_zap2,G%jedb_zap2) ! Interface h-points in diagnostic coordinate (w-point) axes => diag_cs%remap_axesTi(c) @@ -555,8 +616,6 @@ subroutine set_masks_for_axes(G, diag_cs) enddo if (h_axes%mask3d(i,j,nk) > 0.) axes%mask3d(i,J,nk+1) = 1. enddo ; enddo - if(decim_all_diags) call zap2_sample(axes%mask3d, axes%mask3d_zap2, 1,nk+1, G%isd,G%ied,G%jsd,G%jed,& - G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2) h_axes => diag_cs%remap_axesTi(c) ! Use the w-point masks to generate the u-, v- and q- masks @@ -568,8 +627,6 @@ subroutine set_masks_for_axes(G, diag_cs) do k = 1, nk+1 ; do j=G%jsc,G%jec ; do I=G%isc-1,G%iec if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i+1,j,k) > 0.) axes%mask3d(I,j,k) = 1. enddo ; enddo ; enddo - if(decim_all_diags) call zap2_sample(axes%mask3d, axes%mask3d_zap2, 1,nk+1, G%isdb,G%iedb,G%jsd,G%jed,& - G%isdb_zap2,G%iedb_zap2,G%jsd_zap2,G%jed_zap2) ! Interface v-points in diagnostic coordinate axes => diag_cs%remap_axesCvi(c) @@ -579,8 +636,6 @@ subroutine set_masks_for_axes(G, diag_cs) do k = 1, nk+1 ; do J=G%jsc-1,G%jec ; do i=G%isc,G%iec if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i,j+1,k) > 0.) axes%mask3d(i,J,k) = 1. enddo ; enddo ; enddo - if(decim_all_diags) call zap2_sample(axes%mask3d, axes%mask3d_zap2, 1,nk+1, G%isd,G%ied,G%jsdb,G%jedb,& - G%isd_zap2,G%ied_zap2,G%jsdb_zap2,G%jedb_zap2) ! Interface q-points in diagnostic coordinate axes => diag_cs%remap_axesBi(c) @@ -591,8 +646,6 @@ subroutine set_masks_for_axes(G, diag_cs) if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i+1,j+1,k) + & h_axes%mask3d(i+1,j,k) + h_axes%mask3d(i,j+1,k) > 0.) axes%mask3d(I,J,k) = 1. enddo ; enddo ; enddo - if(decim_all_diags) call zap2_sample(axes%mask3d, axes%mask3d_zap2, 1,nk+1, G%isdb,G%iedb,G%jsdb,G%jedb,& - G%isdb_zap2,G%iedb_zap2,G%jsdb_zap2,G%jedb_zap2) endif enddo @@ -782,32 +835,145 @@ subroutine define_axes_group(diag_cs, handles, axes, nz, vertical_coordinate_num endif endif - axes%mask2d_zap2 => null() +end subroutine define_axes_group + +!> Defines a group of "axes" from list of handles +subroutine define_axes_group_decim(diag_cs, handles, axes, dl, nz, vertical_coordinate_number, & + x_cell_method, y_cell_method, v_cell_method, & + is_h_point, is_q_point, is_u_point, is_v_point, & + is_layer, is_interface, & + is_native, needs_remapping, needs_interpolating, & + xyave_axes) + type(diag_ctrl), target, intent(in) :: diag_cs !< Diagnostics control structure + integer, dimension(:), intent(in) :: handles !< A list of 1D axis handles + type(axes_grp), intent(out) :: axes !< The group of 1D axes + integer, intent(in) :: dl !< Decimation level + integer, optional, intent(in) :: nz !< Number of layers in this diagnostic grid + integer, optional, intent(in) :: vertical_coordinate_number !< Index number for vertical coordinate + character(len=*), optional, intent(in) :: x_cell_method !< A x-direction cell method used to construct the + !! "cell_methods" attribute in CF convention + character(len=*), optional, intent(in) :: y_cell_method !< A y-direction cell method used to construct the + !! "cell_methods" attribute in CF convention + character(len=*), optional, intent(in) :: v_cell_method !< A vertical direction cell method used to construct + !! the "cell_methods" attribute in CF convention + logical, optional, intent(in) :: is_h_point !< If true, indicates this axes group for h-point + !! located fields + logical, optional, intent(in) :: is_q_point !< If true, indicates this axes group for q-point + !! located fields + logical, optional, intent(in) :: is_u_point !< If true, indicates this axes group for + !! u-point located fields + logical, optional, intent(in) :: is_v_point !< If true, indicates this axes group for + !! v-point located fields + logical, optional, intent(in) :: is_layer !< If true, indicates that this axes group is + !! for a layer vertically-located field. + logical, optional, intent(in) :: is_interface !< If true, indicates that this axes group + !! is for an interface vertically-located field. + logical, optional, intent(in) :: is_native !< If true, indicates that this axes group is + !! for a native model grid. False for any other grid. + logical, optional, intent(in) :: needs_remapping !< If true, indicates that this axes group is + !! for a intensive layer-located field that must + !! be remapped to these axes. Used for rank>2. + logical, optional, intent(in) :: needs_interpolating !< If true, indicates that this axes group + !! is for a sampled interface-located field that must + !! be interpolated to these axes. Used for rank>2. + type(axes_grp), optional, target :: xyave_axes !< The corresponding axes group for horizontally + !! area-average diagnostics + ! Local variables + integer :: n + + n = size(handles) + if (n<1 .or. n>3) call MOM_error(FATAL, "define_axes_group: wrong size for list of handles!") + allocate( axes%handles(n) ) + axes%id = i2s(handles, n) ! Identifying string + axes%rank = n + axes%handles(:) = handles(:) + axes%diag_cs => diag_cs ! A [circular] link back to the diag_cs structure + if (present(x_cell_method)) then + if (axes%rank<2) call MOM_error(FATAL, 'define_axes_group: ' // & + 'Can not set x_cell_method for rank<2.') + axes%x_cell_method = trim(x_cell_method) + else + axes%x_cell_method = '' + endif + if (present(y_cell_method)) then + if (axes%rank<2) call MOM_error(FATAL, 'define_axes_group: ' // & + 'Can not set y_cell_method for rank<2.') + axes%y_cell_method = trim(y_cell_method) + else + axes%y_cell_method = '' + endif + if (present(v_cell_method)) then + if (axes%rank/=1 .and. axes%rank/=3) call MOM_error(FATAL, 'define_axes_group: ' // & + 'Can not set v_cell_method for rank<>1 or 3.') + axes%v_cell_method = trim(v_cell_method) + else + axes%v_cell_method = '' + endif + axes%decimation_level = dl + if (present(nz)) axes%nz = nz + if (present(vertical_coordinate_number)) axes%vertical_coordinate_number = vertical_coordinate_number + if (present(is_h_point)) axes%is_h_point = is_h_point + if (present(is_q_point)) axes%is_q_point = is_q_point + if (present(is_u_point)) axes%is_u_point = is_u_point + if (present(is_v_point)) axes%is_v_point = is_v_point + if (present(is_layer)) axes%is_layer = is_layer + if (present(is_interface)) axes%is_interface = is_interface + if (present(is_native)) axes%is_native = is_native + if (present(needs_remapping)) axes%needs_remapping = needs_remapping + if (present(needs_interpolating)) axes%needs_interpolating = needs_interpolating + if (present(xyave_axes)) axes%xyave_axes => xyave_axes + + ! Setup masks for this axes group + + axes%mask2d => null() if (axes%rank==2) then - if (axes%is_h_point) axes%mask2d_zap2 => diag_cs%mask2dT_zap2 - if (axes%is_u_point) axes%mask2d_zap2 => diag_cs%mask2dCu_zap2 - if (axes%is_v_point) axes%mask2d_zap2 => diag_cs%mask2dCv_zap2 - if (axes%is_q_point) axes%mask2d_zap2 => diag_cs%mask2dBu_zap2 + if (axes%is_h_point) axes%mask2d => diag_cs%mask2dT + if (axes%is_u_point) axes%mask2d => diag_cs%mask2dCu + if (axes%is_v_point) axes%mask2d => diag_cs%mask2dCv + if (axes%is_q_point) axes%mask2d => diag_cs%mask2dBu endif ! A static 3d mask for non-native coordinates can only be setup when a grid is available - axes%mask3d_zap2 => null() + axes%mask3d => null() if (axes%rank==3 .and. axes%is_native) then ! Native variables can/should use the native masks copied into diag_cs if (axes%is_layer) then - if (axes%is_h_point) axes%mask3d_zap2 => diag_cs%mask3dTL_zap2 - if (axes%is_u_point) axes%mask3d_zap2 => diag_cs%mask3dCuL_zap2 - if (axes%is_v_point) axes%mask3d_zap2 => diag_cs%mask3dCvL_zap2 - if (axes%is_q_point) axes%mask3d_zap2 => diag_cs%mask3dBL_zap2 + if (axes%is_h_point) axes%mask3d => diag_cs%mask3dTL + if (axes%is_u_point) axes%mask3d => diag_cs%mask3dCuL + if (axes%is_v_point) axes%mask3d => diag_cs%mask3dCvL + if (axes%is_q_point) axes%mask3d => diag_cs%mask3dBL elseif (axes%is_interface) then - if (axes%is_h_point) axes%mask3d_zap2 => diag_cs%mask3dTi_zap2 - if (axes%is_u_point) axes%mask3d_zap2 => diag_cs%mask3dCui_zap2 - if (axes%is_v_point) axes%mask3d_zap2 => diag_cs%mask3dCvi_zap2 - if (axes%is_q_point) axes%mask3d_zap2 => diag_cs%mask3dBi_zap2 + if (axes%is_h_point) axes%mask3d => diag_cs%mask3dTi + if (axes%is_u_point) axes%mask3d => diag_cs%mask3dCui + if (axes%is_v_point) axes%mask3d => diag_cs%mask3dCvi + if (axes%is_q_point) axes%mask3d => diag_cs%mask3dBi endif endif + axes%decim(dl)%mask2d => null() + if (axes%rank==2) then + if (axes%is_h_point) axes%decim(dl)%mask2d => diag_cs%decim(dl)%mask2dT + if (axes%is_u_point) axes%decim(dl)%mask2d => diag_cs%decim(dl)%mask2dCu + if (axes%is_v_point) axes%decim(dl)%mask2d => diag_cs%decim(dl)%mask2dCv + if (axes%is_q_point) axes%decim(dl)%mask2d => diag_cs%decim(dl)%mask2dBu + endif + ! A static 3d mask for non-native coordinates can only be setup when a grid is available + axes%decim(dl)%mask3d => null() + if (axes%rank==3 .and. axes%is_native) then + ! Native variables can/should use the native masks copied into diag_cs + if (axes%is_layer) then + if (axes%is_h_point) axes%decim(dl)%mask3d => diag_cs%decim(dl)%mask3dTL + if (axes%is_u_point) axes%decim(dl)%mask3d => diag_cs%decim(dl)%mask3dCuL + if (axes%is_v_point) axes%decim(dl)%mask3d => diag_cs%decim(dl)%mask3dCvL + if (axes%is_q_point) axes%decim(dl)%mask3d => diag_cs%decim(dl)%mask3dBL + elseif (axes%is_interface) then + if (axes%is_h_point) axes%decim(dl)%mask3d => diag_cs%decim(dl)%mask3dTi + if (axes%is_u_point) axes%decim(dl)%mask3d => diag_cs%decim(dl)%mask3dCui + if (axes%is_v_point) axes%decim(dl)%mask3d => diag_cs%decim(dl)%mask3dCvi + if (axes%is_q_point) axes%decim(dl)%mask3d => diag_cs%decim(dl)%mask3dBi + endif + endif -end subroutine define_axes_group +end subroutine define_axes_group_decim !> Set up the array extents for doing diagnostics subroutine set_diag_mediator_grid(G, diag_cs) @@ -818,11 +984,6 @@ subroutine set_diag_mediator_grid(G, diag_cs) diag_cs%js = G%jsc - (G%jsd-1) ; diag_cs%je = G%jec - (G%jsd-1) diag_cs%isd = G%isd ; diag_cs%ied = G%ied diag_cs%jsd = G%jsd ; diag_cs%jed = G%jed - - diag_cs%isc_zap2 = G%isc_zap2 - (G%isd_zap2-1) ; diag_cs%iec_zap2 = G%iec_zap2 - (G%isd_zap2-1) - diag_cs%jsc_zap2 = G%jsc_zap2 - (G%jsd_zap2-1) ; diag_cs%jec_zap2 = G%jec_zap2 - (G%jsd_zap2-1) - diag_cs%isd_zap2 = G%isd_zap2 ; diag_cs%ied_zap2 = G%ied_zap2 - diag_cs%jsd_zap2 = G%jsd_zap2 ; diag_cs%jed_zap2 = G%jed_zap2 end subroutine set_diag_mediator_grid @@ -924,17 +1085,16 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) real, target, intent(in) :: field(:,:) !< 2-d array being offered for output or averaging type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output logical, optional, intent(in) :: is_static !< If true, this is a static field that is always offered. - real, optional, intent(in) :: mask(:,:) !< If present, use this real array as the data mask. + real, optional,target, intent(in) :: mask(:,:) !< If present, use this real array as the data mask. ! Local variables real, dimension(:,:), pointer :: locfield => NULL() + real, dimension(:,:), pointer :: locmask => NULL() + real, dimension(:,:), pointer :: diag_axes_mask2d => NULL() character(len=300) :: mesg logical :: used, is_stat integer :: cszi, cszj, dszi, dszj - integer :: isv, iev, jsv, jev, i, j, chksum - !decimation - integer :: isv_dec,iev_dec,jsv_dec,jev_dec - real, dimension(:,:), pointer :: decim_field => NULL() + integer :: isv, iev, jsv, jev, i, j, chksum, dl is_stat = .false. ; if (present(is_static)) is_stat = is_static @@ -989,10 +1149,40 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) locfield => field endif - if (decim_all_diags) then - isv_dec = 1 ; iev_dec = (iev-isv+1)/decim_fac - jsv_dec = 1 ; jev_dec = (jev-jsv+1)/decim_fac - allocate(decim_field(isv_dec:iev_dec,jsv_dec:jev_dec)) + if (present(mask)) then + call assert(size(locfield) == size(mask), & + 'post_data_2d_low: mask size mismatch: '//diag%debug_str) + locmask => mask + endif + if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) then + allocate( locfield( lbound(field,1):ubound(field,1), lbound(field,2):ubound(field,2) ) ) + do j=jsv,jev ; do i=isv,iev + if (field(i,j) == diag_cs%missing_value) then + locfield(i,j) = diag_cs%missing_value + else + locfield(i,j) = field(i,j) * diag%conversion_factor + endif + enddo ; enddo + locfield(isv:iev,jsv:jev) = field(isv:iev,jsv:jev) * diag%conversion_factor + else + locfield => field + endif + + if (present(mask)) then + call assert(size(locfield) == size(mask), & + 'post_data_2d_low: mask size mismatch: '//diag%debug_str) + locmask => mask + endif + + diag_axes_mask2d => diag%axes%mask2d + dl = diag%axes%decimation_level + if (dl > 1) then + call decimate_diag_field(locfield, dl, diag_cs,isv,iev,jsv,jev) + if (present(mask)) then + call decimate_diag_field(locmask, dl) + elseif (associated(diag%axes%decim(dl)%mask2d)) then + diag_axes_mask2d => diag%axes%decim(dl)%mask2d + endif endif if (diag_cs%diag_as_chksum) then @@ -1000,20 +1190,13 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) if (is_root_pe()) then call log_chksum_diag(diag_cs%chksum_diag_doc_unit, diag%debug_str, chksum) endif - elseif (decim_all_diags) then - !Sample the field at the corner of each cell - do j=jsv_dec,jev_dec ; do i=isv_dec,iev_dec - decim_field(i,j) = locfield(isv+decim_fac*i-2,jsv+decim_fac*j-2) - enddo ; enddo - used = send_data(diag%fms_diag_id, decim_field, diag_cs%time_end, & - is_in=isv_dec, js_in=jsv_dec, ie_in=iev_dec, je_in=jev_dec) else if (is_stat) then if (present(mask)) then - call assert(size(locfield) == size(mask), & + call assert(size(locfield) == size(locmask), & 'post_data_2d_low is_stat: mask size mismatch: '//diag%debug_str) used = send_data(diag%fms_diag_id, locfield, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=mask) + is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=locmask) !elseif (associated(diag%axes%mask2d)) then ! used = send_data(diag%fms_diag_id, locfield, & ! is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=diag%axes%mask2d) @@ -1023,15 +1206,17 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) endif elseif (diag_cs%ave_enabled) then if (present(mask)) then - call assert(size(locfield) == size(mask), & + call assert(size(locfield) == size(locmask), & 'post_data_2d_low: mask size mismatch: '//diag%debug_str) used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag_cs%time_int, rmask=mask) - elseif (associated(diag%axes%mask2d)) then + weight=diag_cs%time_int, rmask=locmask) + elseif (associated(diag_axes_mask2d)) then + call assert(size(locfield) == size(diag_axes_mask2d), & + 'post_data_2d_low: mask2d size mismatch: '//diag%debug_str) used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag_cs%time_int, rmask=diag%axes%mask2d) + weight=diag_cs%time_int, rmask=diag_axes_mask2d) else used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & @@ -1175,19 +1360,15 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) ! Local variables real, dimension(:,:,:), pointer :: locfield => NULL() + real, dimension(:,:,:), pointer :: locmask => NULL() + real, dimension(:,:,:), pointer :: diag_axes_mask3d => NULL() character(len=300) :: mesg logical :: used ! The return value of send_data is not used for anything. logical :: staggered_in_x, staggered_in_y logical :: is_stat integer :: cszi, cszj, dszi, dszj integer :: isv, iev, jsv, jev, ks, ke, i, j, k, isv_c, jsv_c - integer :: chksum - !decimation - integer :: isv_zap2,iev_zap2,jsv_zap2,jev_zap2 - real, dimension(:,:,:), pointer :: zap2_field => NULL() - real, dimension(:,:,:), pointer :: zap2_mask => NULL() - real, dimension(:,:,:), pointer :: locmask => NULL() - real, dimension(:,:,:), pointer :: diag_axes_mask3d => NULL() + integer :: chksum, dl is_stat = .false. ; if (present(is_static)) is_stat = is_static @@ -1263,162 +1444,63 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) call assert(size(locfield) == size(mask), & 'post_data_3d_low: mask size mismatch: '//diag%debug_str) locmask => mask - endif - - diag_axes_mask3d => diag%axes%mask3d + endif - if (decim_all_diags) then - diag_axes_mask3d => diag%axes%mask3d_zap2 - - isv_zap2 = diag_cs%isc_zap2 ; iev_zap2 = diag_cs%iec_zap2 - jsv_zap2 = diag_cs%jsc_zap2 ; jev_zap2 = diag_cs%jec_zap2 + diag_axes_mask3d => diag%axes%mask3d + dl = diag%axes%decimation_level + if (dl > 1) then + call decimate_diag_field(locfield, dl, diag_cs,isv,iev,jsv,jev) + if (present(mask)) then + call decimate_diag_field(locmask, dl) + elseif (associated(diag%axes%decim(dl)%mask3d)) then + diag_axes_mask3d => diag%axes%decim(dl)%mask3d + endif + endif - if ( size(field,1) == dszi ) then - isv_zap2 = diag_cs%isc_zap2 ; iev_zap2 = diag_cs%iec_zap2 ! Data domain - elseif ( size(field,1) == dszi + 1 ) then - isv_zap2 = diag_cs%isc_zap2 ; iev_zap2 = diag_cs%iec_zap2+1 ! Symmetric data domain - elseif ( size(field,1) == cszi) then - isv_zap2 = 1 ; iev_zap2 = (diag_cs%iec_zap2-diag_cs%isc_zap2) +1 ! Computational domain - elseif ( size(field,1) == cszi + 1 ) then - isv_zap2 = 1 ; iev_zap2 = (diag_cs%iec_zap2-diag_cs%isc_zap2) +2 ! Symmetric computational domain - else - write (mesg,*) " peculiar size ",size(field,1)," in i-direction\n"//& - "does not match one of ", cszi, cszi+1, dszi, dszi+1 - call MOM_error(FATAL,"post_data_3d_low: "//trim(diag%debug_str)//trim(mesg)) - endif - if ( size(field,2) == dszj ) then - jsv_zap2 = diag_cs%jsc_zap2 ; jev_zap2 = diag_cs%jec_zap2 ! Data domain - elseif ( size(field,2) == dszj + 1 ) then - jsv_zap2 = diag_cs%jsc_zap2 ; jev_zap2 = diag_cs%jec_zap2+1 ! Symmetric data domain - elseif ( size(field,2) == cszj) then - jsv_zap2 = 1 ; jev_zap2 = (diag_cs%jec_zap2-diag_cs%jsc_zap2) +1 ! Computational domain - elseif ( size(field,2) == cszj + 1 ) then - jsv_zap2 = 1 ; jev_zap2 = (diag_cs%jec_zap2-diag_cs%jsc_zap2) +2 ! Symmetric computational domain + if (diag_cs%diag_as_chksum) then + chksum = chksum_general(locfield) + if (is_root_pe()) then + call log_chksum_diag(diag_cs%chksum_diag_doc_unit, diag%debug_str, chksum) + endif + else + if (is_stat) then + if (present(mask)) then + call assert(size(locfield) == size(locmask), & + 'post_data_3d_low is_stat: mask size mismatch: '//diag%debug_str) + used = send_data(diag%fms_diag_id, locfield, & + is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=locmask) + !elseif (associated(diag%axes%mask2d)) then + ! used = send_data(diag%fms_diag_id, locfield, & + ! is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=diag%axes%mask2d) else - write (mesg,*) " peculiar size ",size(field,2)," in j-direction\n"//& - "does not match one of ", cszj, cszj+1, dszj, dszj+1 - call MOM_error(FATAL,"post_data_3d_low: "//trim(diag%debug_str)//trim(mesg)) + used = send_data(diag%fms_diag_id, locfield, & + is_in=isv, js_in=jsv, ie_in=iev, je_in=jev) endif - !Sample the field at the corner of each cell - call zap2_sample(locfield, zap2_field, ks,ke) - !point locfield to the decimated field - locfield => zap2_field - isv=isv_zap2; iev=iev_zap2; jsv=jsv_zap2; jev=jev_zap2 - - !Decimated mask + elseif (diag_cs%ave_enabled) then if (present(mask)) then - call zap2_sample(mask, zap2_mask, ks,ke) - locmask => zap2_mask - endif - - endif - - if (diag%fms_diag_id>0) then - if (diag_cs%diag_as_chksum) then - chksum = chksum_general(locfield) - if (is_root_pe()) then - call log_chksum_diag(diag_cs%chksum_diag_doc_unit, diag%debug_str, chksum) - endif - !Decimation test -! elseif (decim_all_diags) then -! !Sample the field at the corner of each cell -! do k=ks,ke ; do j=jsv_dec,jev_dec ; do i=isv_dec,iev_dec -! decim_field(i,j,k) = locfield(isv+decim_fac*i-2,jsv+decim_fac*j-2,k) -! enddo ; enddo ; enddo -! used = send_data(diag%fms_diag_id, decim_field, diag_cs%time_end, & -! is_in=isv_dec, js_in=jsv_dec, ie_in=iev_dec, je_in=jev_dec) - else - if (is_stat) then - if (present(mask)) then - call assert(size(locfield) == size(locmask), & - 'post_data_3d_low is_stat: mask size mismatch: '//diag%debug_str) - used = send_data(diag%fms_diag_id, locfield, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=locmask) - !elseif (associated(diag%axes%mask3d)) then - ! used = send_data(diag_field_id, locfield, & - ! is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=diag%axes%mask3d) - else - used = send_data(diag%fms_diag_id, locfield, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev) - endif - elseif (diag_cs%ave_enabled) then - if (present(mask)) then - call assert(size(locfield) == size(locmask), & - 'post_data_3d_low: mask size mismatch: '//diag%debug_str) - used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag_cs%time_int, rmask=locmask) - elseif (associated(diag_axes_mask3d)) then - call assert(size(locfield) == size(diag_axes_mask3d), & + call assert(size(locfield) == size(locmask), & + 'post_data_3d_low: mask size mismatch: '//diag%debug_str) + used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & + is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & + weight=diag_cs%time_int, rmask=locmask) + elseif (associated(diag_axes_mask3d)) then + call assert(size(locfield) == size(diag_axes_mask3d), & 'post_data_3d_low: mask3d size mismatch: '//diag%debug_str) - used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag_cs%time_int, rmask=diag_axes_mask3d) - else - used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag_cs%time_int) - endif + used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & + is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & + weight=diag_cs%time_int, rmask=diag_axes_mask3d) + else + used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & + is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & + weight=diag_cs%time_int) endif endif endif - if (diag%fms_xyave_diag_id>0) then - call post_xy_average(diag_cs, diag, locfield) - endif - - !Decimation test - if (diag%decimate_diag_id>0) then - call post_decimated_data(diag_cs, diag, locfield, decimation_factor=2) - endif - if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) & deallocate( locfield ) end subroutine post_data_3d_low - -!> Post the horizontally area-averaged diagnostic -subroutine post_decimated_data(diag_cs, diag, field, decimation_factor) - type(diag_ctrl), intent(in) :: diag_cs !< Diagnostics mediator control structure - type(diag_type), intent(in) :: diag !< This diagnostic - real, target, intent(in) :: field(:,:,:) !< Diagnostic field - integer, intent(in) :: decimation_factor !< The factor by which to decimate the diag output field - ! Local variable - real, dimension(size(field,3)) :: decimated_field - logical :: used - integer :: nz, remap_nz, coord - -! if (.not. diag_cs%ave_enabled) then -! return -! endif - - if (diag%axes%is_native) then - call horizontally_decimate_diag_field(diag_cs%G, diag_cs%h, & - diag%axes%is_layer, diag%v_extensive, & - diag_cs%missing_value, decimation_factor, field, decimated_field) - else - nz = size(field, 3) - coord = diag%axes%vertical_coordinate_number - remap_nz = diag_cs%diag_remap_cs(coord)%nz - - call assert(diag_cs%diag_remap_cs(coord)%initialized, & - 'post_xy_average: remap_cs not initialized.') - - call assert(IMPLIES(diag%axes%is_layer, nz == remap_nz), & - 'post_xy_average: layer field dimension mismatch.') - call assert(IMPLIES(.not. diag%axes%is_layer, nz == remap_nz+1), & - 'post_xy_average: interface field dimension mismatch.') - - call horizontally_decimate_diag_field(diag_cs%G, diag_cs%diag_remap_cs(coord)%h, & - diag%axes%is_layer, diag%v_extensive, & - diag_cs%missing_value, decimation_factor, field, decimated_field) - endif - - used = send_data(diag%decimate_diag_id, decimated_field, diag_cs%time_end, & - weight=diag_cs%time_int) - -end subroutine post_decimated_data - !> Post the horizontally area-averaged diagnostic subroutine post_xy_average(diag_cs, diag, field) type(diag_type), intent(in) :: diag !< This diagnostic @@ -1562,36 +1644,35 @@ integer function register_diag_field(module_name, field_name, axes_in, init_time type(diag_ctrl), pointer :: diag_cs => NULL() type(axes_grp), pointer :: remap_axes => null() type(axes_grp), pointer :: axes => null() - integer :: dm_id, i + integer :: dm_id, i, dl character(len=256) :: new_module_name logical :: active axes => axes_in MOM_missing_value = axes%diag_cs%missing_value if (present(missing_value)) MOM_missing_value = missing_value - - diag_cs => axes%diag_cs - dm_id = -1 - !Reroute the axes for decimated diagnostics - if (decim_all_diags) then - if ((axes_in%id == diag_cs%axesTL%id)) then - axes => diag_cs%axesTL - elseif (axes_in%id == diag_cs%axesBL%id) then - axes => diag_cs%axesBL - elseif (axes_in%id == diag_cs%axesCuL%id ) then - axes => diag_cs%axesCuL - elseif (axes_in%id == diag_cs%axesCvL%id) then - axes => diag_cs%axesCvL - elseif (axes_in%id == diag_cs%axesTi%id) then - axes => diag_cs%axesTi - elseif (axes_in%id == diag_cs%axesBi%id) then - axes => diag_cs%axesBi - elseif (axes_in%id == diag_cs%axesCui%id ) then - axes => diag_cs%axesCui - elseif (axes_in%id == diag_cs%axesCvi%id) then - axes => diag_cs%axesCvi - endif + + diag_cs => axes%diag_cs + dm_id = -1 + + if (axes_in%id == diag_cs%axesTL%id) then + axes => diag_cs%axesTL + elseif (axes_in%id == diag_cs%axesBL%id) then + axes => diag_cs%axesBL + elseif (axes_in%id == diag_cs%axesCuL%id ) then + axes => diag_cs%axesCuL + elseif (axes_in%id == diag_cs%axesCvL%id) then + axes => diag_cs%axesCvL + elseif (axes_in%id == diag_cs%axesTi%id) then + axes => diag_cs%axesTi + elseif (axes_in%id == diag_cs%axesBi%id) then + axes => diag_cs%axesBi + elseif (axes_in%id == diag_cs%axesCui%id ) then + axes => diag_cs%axesCui + elseif (axes_in%id == diag_cs%axesCvi%id) then + axes => diag_cs%axesCvi endif + ! Register the native diagnostic active = register_diag_field_expand_cmor(dm_id, module_name, field_name, axes, & init_time, long_name=long_name, units=units, missing_value=MOM_missing_value, & @@ -1604,30 +1685,80 @@ integer function register_diag_field(module_name, field_name, axes_in, init_time y_cell_method=y_cell_method, v_cell_method=v_cell_method, & conversion=conversion, v_extensive=v_extensive) + do dl=2,MAX_DECIM_LEV + new_module_name = trim(module_name)//'_d2' + + if (axes_in%rank == 3 .or. axes_in%rank == 2 ) then + axes => null() + if (axes_in%id == diag_cs%axesTL%id) then + axes => diag_cs%decim(dl)%axesTL + elseif (axes_in%id == diag_cs%axesBL%id) then + axes => diag_cs%decim(dl)%axesBL + elseif (axes_in%id == diag_cs%axesCuL%id ) then + axes => diag_cs%decim(dl)%axesCuL + elseif (axes_in%id == diag_cs%axesCvL%id) then + axes => diag_cs%decim(dl)%axesCvL + elseif (axes_in%id == diag_cs%axesTi%id) then + axes => diag_cs%decim(dl)%axesTi + elseif (axes_in%id == diag_cs%axesBi%id) then + axes => diag_cs%decim(dl)%axesBi + elseif (axes_in%id == diag_cs%axesCui%id ) then + axes => diag_cs%decim(dl)%axesCui + elseif (axes_in%id == diag_cs%axesCvi%id) then + axes => diag_cs%decim(dl)%axesCvi + elseif (axes_in%id == diag_cs%axesT1%id) then + axes => diag_cs%decim(dl)%axesT1 + elseif (axes_in%id == diag_cs%axesB1%id) then + axes => diag_cs%decim(dl)%axesB1 + elseif (axes_in%id == diag_cs%axesCu1%id ) then + axes => diag_cs%decim(dl)%axesCu1 + elseif (axes_in%id == diag_cs%axesCv1%id) then + axes => diag_cs%decim(dl)%axesCv1 + else + !Niki: Should we worry about these, e.g., diag_to_Z_CS? + call MOM_error(WARNING,"register_diag_field: Could not find a proper axes for " & + //trim( new_module_name)//"-"//trim(field_name)) + endif + endif + ! Register the native diagnostic + if (associated(axes)) then + active = register_diag_field_expand_cmor(dm_id, new_module_name, field_name, axes, & + init_time, long_name=long_name, units=units, missing_value=MOM_missing_value, & + range=range, mask_variant=mask_variant, standard_name=standard_name, & + verbose=verbose, do_not_log=do_not_log, err_msg=err_msg, & + interp_method=interp_method, tile_count=tile_count, & + cmor_field_name=cmor_field_name, cmor_long_name=cmor_long_name, & + cmor_units=cmor_units, cmor_standard_name=cmor_standard_name, & + cell_methods=cell_methods, x_cell_method=x_cell_method, & + y_cell_method=y_cell_method, v_cell_method=v_cell_method, & + conversion=conversion, v_extensive=v_extensive) + endif + enddo ! For each diagnostic coordinate register the diagnostic again under a different module name do i=1,diag_cs%num_diag_coords new_module_name = trim(module_name)//'_'//trim(diag_cs%diag_remap_cs(i)%diag_module_suffix) ! Register diagnostics remapped to z vertical coordinate - if (axes%rank == 3) then + if (axes_in%rank == 3) then remap_axes => null() - if ((axes%id == diag_cs%axesTL%id)) then + if ((axes_in%id == diag_cs%axesTL%id)) then remap_axes => diag_cs%remap_axesTL(i) - elseif (axes%id == diag_cs%axesBL%id) then + elseif (axes_in%id == diag_cs%axesBL%id) then remap_axes => diag_cs%remap_axesBL(i) - elseif (axes%id == diag_cs%axesCuL%id ) then + elseif (axes_in%id == diag_cs%axesCuL%id ) then remap_axes => diag_cs%remap_axesCuL(i) - elseif (axes%id == diag_cs%axesCvL%id) then + elseif (axes_in%id == diag_cs%axesCvL%id) then remap_axes => diag_cs%remap_axesCvL(i) - elseif (axes%id == diag_cs%axesTi%id) then + elseif (axes_in%id == diag_cs%axesTi%id) then remap_axes => diag_cs%remap_axesTi(i) - elseif (axes%id == diag_cs%axesBi%id) then + elseif (axes_in%id == diag_cs%axesBi%id) then remap_axes => diag_cs%remap_axesBi(i) - elseif (axes%id == diag_cs%axesCui%id ) then + elseif (axes_in%id == diag_cs%axesCui%id ) then remap_axes => diag_cs%remap_axesCui(i) - elseif (axes%id == diag_cs%axesCvi%id) then + elseif (axes_in%id == diag_cs%axesCvi%id) then remap_axes => diag_cs%remap_axesCvi(i) endif + ! When the MOM_diag_to_Z module has been obsoleted we can assume remap_axes will ! always exist but in the mean-time we have to do this check: ! call assert(associated(remap_axes), 'register_diag_field: remap_axes not set') @@ -2504,6 +2635,15 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir) diag_cs%isd = G%isd ; diag_cs%ied = G%ied diag_cs%jsd = G%jsd ; diag_cs%jed = G%jed + !Decimation indices (should be generalized to arbitrary dl) + diag_cs%decim(2)%isc = G%isc_zap2 - (G%isd_zap2-1) ; diag_cs%decim(2)%iec = G%iec_zap2 - (G%isd_zap2-1) + diag_cs%decim(2)%jsc = G%jsc_zap2 - (G%jsd_zap2-1) ; diag_cs%decim(2)%jec = G%jec_zap2 - (G%jsd_zap2-1) + diag_cs%decim(2)%isd = G%isd_zap2 ; diag_cs%decim(2)%ied = G%ied_zap2 + diag_cs%decim(2)%jsd = G%jsd_zap2 ; diag_cs%decim(2)%jed = G%jed_zap2 + diag_cs%decim(2)%isg = G%isg_zap2 ; diag_cs%decim(2)%ieg = G%ieg_zap2 + diag_cs%decim(2)%jsg = G%jsg_zap2 ; diag_cs%decim(2)%jeg = G%jeg_zap2 + + ! Initialze available diagnostic log file if (is_root_pe() .and. (diag_CS%available_diag_doc_unit < 0)) then write(this_pe,'(i6.6)') PE_here() @@ -2665,9 +2805,6 @@ subroutine diag_masks_set(G, nz, diag_cs) ! Local variables integer :: k - if(decim_all_diags) then - call zap2_diag_masks_set(G, nz, diag_cs) - endif ! 2d masks point to the model masks since they are identical diag_cs%mask2dT => G%mask2dT diag_cs%mask2dBu => G%mask2dBu @@ -2697,127 +2834,10 @@ subroutine diag_masks_set(G, nz, diag_cs) diag_cs%mask3dCvi(:,:,k) = diag_cs%mask2dCv(:,:) enddo -end subroutine diag_masks_set - -subroutine zap2_sample_3d(field_in, field_out,ks,ke, is,ie,js,je, is2,ie2,js2,je2) - integer , intent(in) :: ks,ke, is,ie,js,je, is2,ie2,js2,je2 - real, dimension(is:,js:,1:) ,intent(in) :: field_in - real, dimension(:,:,:) , pointer :: field_out - integer :: k,i,j,ii,jj - - allocate(field_out(is2:ie2,js2:je2,ks:ke)) - do k= ks,ke ; do j=js2,je2 ; do i=is2,ie2 - ii = is+2*(i-is2) - jj = js+2*(j-js2) - field_out(i,j,k) = field_in(ii,jj,k) - enddo; enddo; enddo - -end subroutine zap2_sample_3d - -subroutine zap2_sample_2d(field_in, field_out, is,ie,js,je, is2,ie2,js2,je2) - integer , intent(in) :: is,ie,js,je, is2,ie2,js2,je2 - real, dimension(is:,js:) ,intent(in) :: field_in - real, dimension(:,:) , pointer :: field_out - integer :: i,j,ii,jj - - allocate(field_out(is2:ie2,js2:je2)) - do j=js2,je2 ; do i=is2,ie2 - ii = is+2*(i-is2) - jj = js+2*(j-js2) - field_out(i,j) = field_in(ii,jj) - enddo; enddo - -end subroutine zap2_sample_2d - -subroutine zap2_sample_3d0(field_in, field_out,ks,ke) - integer , intent(in) :: ks,ke - real, dimension(:,:,:) ,intent(in) :: field_in - real, dimension(:,:,:) , pointer :: field_out - integer :: k,i,j,ii,jj, is_in,js_in, is2,ie2,js2,je2 - - is_in=1; js_in=1 - is2=1; ie2=size(field_in,1)/2 - js2=1; je2=size(field_in,2)/2 - - allocate(field_out(is2:ie2,js2:je2,ks:ke)) - - do k= ks,ke ; do j=js2,je2 ; do i=is2,ie2 - ii = is_in+2*(i-is2) - jj = js_in+2*(j-js2) - field_out(i,j,k) = field_in(ii,jj,k) - enddo; enddo; enddo - -end subroutine zap2_sample_3d0 - -subroutine zap2_sample_2d0(field_in, field_out) - real, dimension(:,:) ,intent(in) :: field_in - real, dimension(:,:) , pointer :: field_out - integer :: i,j,ii,jj, is_in,js_in, is2,ie2,js2,je2 - - is_in=1; js_in=1 - is2=1; ie2=size(field_in,1)/2 - js2=1; je2=size(field_in,2)/2 - - allocate(field_out(is2:ie2,js2:je2)) - - do j=js2,je2 ; do i=is2,ie2 - ii = is_in+2*(i-is2) - jj = js_in+2*(j-js2) - field_out(i,j) = field_in(ii,jj) - enddo; enddo + call decimate_diag_masks_set(G, nz, diag_cs) -end subroutine zap2_sample_2d0 - -subroutine zap2_diag_masks_set(G, nz, diag_cs) - type(ocean_grid_type), target, intent(in) :: G !< The ocean grid type. - integer, intent(in) :: nz !< The number of layers in the model's native grid. - type(diag_ctrl), pointer :: diag_cs !< A pointer to a type with many variables - !! used for diagnostics - ! Local variables - integer :: i,j,k,ii,jj - -!print*,'original c extents ',G%isc,G%iec,G%jsc,G%jec -!print*,'coarse c extents ',G%isc_zap2,G%iec_zap2,G%jsc_zap2,G%jec_zap2 -!print*,'original d extents ',G%isd,G%ied,G%jsd,G%jed -!print*,'coarse d extents ',G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2 -! original c extents 5 52 5 64 -! coarse c extents 5 28 5 34 -! original d extents 1 56 1 68 -! coarse d extents 1 32 1 38 - diag_cs%isc_zap2 = G%isc_zap2 - (G%isd_zap2-1) ; diag_cs%iec_zap2 = G%iec_zap2 - (G%isd_zap2-1) - diag_cs%jsc_zap2 = G%jsc_zap2 - (G%jsd_zap2-1) ; diag_cs%jec_zap2 = G%jec_zap2 - (G%jsd_zap2-1) - diag_cs%isd_zap2 = G%isd_zap2 ; diag_cs%ied_zap2 = G%ied_zap2 - diag_cs%jsd_zap2 = G%jsd_zap2 ; diag_cs%jed_zap2 = G%jed_zap2 - - ! 2d masks point to the model masks since they are identical - call zap2_sample(G%mask2dT, diag_cs%mask2dT_zap2 ,G%isd,G%ied,G%jsd,G%jed,G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2) - call zap2_sample(G%mask2dBu,diag_cs%mask2dBu_zap2,G%isd,G%ied,G%jsd,G%jed,G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2) - call zap2_sample(G%mask2dCu,diag_cs%mask2dCu_zap2,G%isd,G%ied,G%jsd,G%jed,G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2) - call zap2_sample(G%mask2dCv,diag_cs%mask2dCv_zap2,G%isd,G%ied,G%jsd,G%jed,G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2) - ! 3d native masks are needed by diag_manager but the native variables - ! can only be masked 2d - for ocean points, all layers exists. - allocate(diag_cs%mask3dTL_zap2(G%isd_zap2:G%ied_zap2,G%jsd_zap2:G%jed_zap2,1:nz)) - allocate(diag_cs%mask3dBL_zap2(G%IsdB_zap2:G%IedB_zap2,G%JsdB_zap2:G%JedB_zap2,1:nz)) - allocate(diag_cs%mask3dCuL_zap2(G%IsdB_zap2:G%IedB_zap2,G%jsd_zap2:G%jed_zap2,1:nz)) - allocate(diag_cs%mask3dCvL_zap2(G%isd_zap2:G%ied_zap2,G%JsdB_zap2:G%JedB_zap2,1:nz)) - do k=1,nz - diag_cs%mask3dTL_zap2(:,:,k) = diag_cs%mask2dT_zap2(:,:) - diag_cs%mask3dBL_zap2(:,:,k) = diag_cs%mask2dBu_zap2(:,:) - diag_cs%mask3dCuL_zap2(:,:,k) = diag_cs%mask2dCu_zap2(:,:) - diag_cs%mask3dCvL_zap2(:,:,k) = diag_cs%mask2dCv_zap2(:,:) - enddo - allocate(diag_cs%mask3dTi_zap2(G%isd_zap2:G%ied_zap2,G%jsd_zap2:G%jed_zap2,1:nz+1)) - allocate(diag_cs%mask3dBi_zap2(G%IsdB_zap2:G%IedB_zap2,G%JsdB_zap2:G%JedB_zap2,1:nz+1)) - allocate(diag_cs%mask3dCui_zap2(G%IsdB_zap2:G%IedB_zap2,G%jsd_zap2:G%jed_zap2,1:nz+1)) - allocate(diag_cs%mask3dCvi_zap2(G%isd_zap2:G%ied_zap2,G%JsdB_zap2:G%JedB_zap2,1:nz+1)) - do k=1,nz+1 - diag_cs%mask3dTi_zap2(:,:,k) = diag_cs%mask2dT_zap2(:,:) - diag_cs%mask3dBi_zap2(:,:,k) = diag_cs%mask2dBu_zap2(:,:) - diag_cs%mask3dCui_zap2(:,:,k) = diag_cs%mask2dCu_zap2(:,:) - diag_cs%mask3dCvi_zap2(:,:,k) = diag_cs%mask2dCv_zap2(:,:) - enddo +end subroutine diag_masks_set -end subroutine zap2_diag_masks_set subroutine diag_mediator_close_registration(diag_CS) type(diag_ctrl), intent(inout) :: diag_CS !< Structure used to regulate diagnostic output @@ -2856,14 +2876,20 @@ subroutine diag_mediator_end(time, diag_CS, end_diag_manager) enddo call diag_grid_storage_end(diag_cs%diag_grid_temp) - deallocate(diag_cs%mask3dTL) - deallocate(diag_cs%mask3dBL) - deallocate(diag_cs%mask3dCuL) - deallocate(diag_cs%mask3dCvL) - deallocate(diag_cs%mask3dTi) - deallocate(diag_cs%mask3dBi) - deallocate(diag_cs%mask3dCui) - deallocate(diag_cs%mask3dCvi) + do i=2,MAX_DECIM_LEV + deallocate(diag_cs%decim(i)%mask2dT) + deallocate(diag_cs%decim(i)%mask2dBu) + deallocate(diag_cs%decim(i)%mask2dCu) + deallocate(diag_cs%decim(i)%mask2dCv) + deallocate(diag_cs%decim(i)%mask3dTL) + deallocate(diag_cs%decim(i)%mask3dBL) + deallocate(diag_cs%decim(i)%mask3dCuL) + deallocate(diag_cs%decim(i)%mask3dCvL) + deallocate(diag_cs%decim(i)%mask3dTi) + deallocate(diag_cs%decim(i)%mask3dBi) + deallocate(diag_cs%decim(i)%mask3dCui) + deallocate(diag_cs%decim(i)%mask3dCvi) + enddo #if defined(DEBUG) || defined(__DO_SAFETY_CHECKS__) deallocate(diag_cs%h_old) @@ -3120,4 +3146,269 @@ subroutine diag_grid_storage_end(grid_storage) deallocate(grid_storage%diag_grids) end subroutine diag_grid_storage_end +subroutine zap2_sample_3d(field_in, field_out,ks,ke, is,ie,js,je, is2,ie2,js2,je2) + integer , intent(in) :: ks,ke, is,ie,js,je, is2,ie2,js2,je2 + real, dimension(is:,js:,1:) ,intent(in) :: field_in + real, dimension(:,:,:) , pointer :: field_out + integer :: k,i,j,ii,jj + + allocate(field_out(is2:ie2,js2:je2,ks:ke)) + do k= ks,ke ; do j=js2,je2 ; do i=is2,ie2 + ii = is+2*(i-is2) + jj = js+2*(j-js2) + field_out(i,j,k) = field_in(ii,jj,k) + enddo; enddo; enddo + +end subroutine zap2_sample_3d + +subroutine zap2_sample_2d(field_in, field_out, is,ie,js,je, is2,ie2,js2,je2) + integer , intent(in) :: is,ie,js,je, is2,ie2,js2,je2 + real, dimension(is:,js:) ,intent(in) :: field_in + real, dimension(:,:) , pointer :: field_out + integer :: i,j,ii,jj + + allocate(field_out(is2:ie2,js2:je2)) + do j=js2,je2 ; do i=is2,ie2 + ii = is+2*(i-is2) + jj = js+2*(j-js2) + field_out(i,j) = field_in(ii,jj) + enddo; enddo + +end subroutine zap2_sample_2d + +subroutine zap2_sample_3d0(field_in, field_out,ks,ke) + integer , intent(in) :: ks,ke + real, dimension(:,:,:) ,intent(in) :: field_in + real, dimension(:,:,:) , pointer :: field_out + integer :: k,i,j,ii,jj, is_in,js_in, is2,ie2,js2,je2 + + is_in=1; js_in=1 + is2=1; ie2=size(field_in,1)/2 + js2=1; je2=size(field_in,2)/2 + + allocate(field_out(is2:ie2,js2:je2,ks:ke)) + + do k= ks,ke ; do j=js2,je2 ; do i=is2,ie2 + ii = is_in+2*(i-is2) + jj = js_in+2*(j-js2) + field_out(i,j,k) = field_in(ii,jj,k) + enddo; enddo; enddo + +end subroutine zap2_sample_3d0 + +subroutine zap2_sample_2d0(field_in, field_out) + real, dimension(:,:) ,intent(in) :: field_in + real, dimension(:,:) , pointer :: field_out + integer :: i,j,ii,jj, is_in,js_in, is2,ie2,js2,je2 + + is_in=1; js_in=1 + is2=1; ie2=size(field_in,1)/2 + js2=1; je2=size(field_in,2)/2 + + allocate(field_out(is2:ie2,js2:je2)) + + do j=js2,je2 ; do i=is2,ie2 + ii = is_in+2*(i-is2) + jj = js_in+2*(j-js2) + field_out(i,j) = field_in(ii,jj) + enddo; enddo + +end subroutine zap2_sample_2d0 + + +subroutine decimate_diag_masks_set(G, nz, diag_cs) + type(ocean_grid_type), target, intent(in) :: G !< The ocean grid type. + integer, intent(in) :: nz !< The number of layers in the model's native grid. + type(diag_ctrl), pointer :: diag_cs !< A pointer to a type with many variables + !! used for diagnostics + ! Local variables + integer :: i,j,k,ii,jj,dl + +!print*,'original c extents ',G%isc,G%iec,G%jsc,G%jec +!print*,'coarse c extents ',G%isc_zap2,G%iec_zap2,G%jsc_zap2,G%jec_zap2 +!print*,'original d extents ',G%isd,G%ied,G%jsd,G%jed +!print*,'coarse d extents ',G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2 +! original c extents 5 52 5 64 +! coarse c extents 5 28 5 34 +! original d extents 1 56 1 68 +! coarse d extents 1 32 1 38 + + do dl=2,MAX_DECIM_LEV + ! 2d masks + allocate(diag_cs%decim(dl)%mask2dT(G%isd_zap2:G%ied_zap2,G%jsd_zap2:G%jed_zap2)) + allocate(diag_cs%decim(dl)%mask2dBu(G%IsdB_zap2:G%IedB_zap2,G%JsdB_zap2:G%JedB_zap2)) + allocate(diag_cs%decim(dl)%mask2dCu(G%IsdB_zap2:G%IedB_zap2,G%jsd_zap2:G%jed_zap2)) + allocate(diag_cs%decim(dl)%mask2dCv(G%isd_zap2:G%ied_zap2,G%JsdB_zap2:G%JedB_zap2)) + call zap2_sample(G%mask2dT, diag_cs%decim(dl)%mask2dT ,G%isd,G%ied,G%jsd,G%jed,G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2) + call zap2_sample(G%mask2dBu,diag_cs%decim(dl)%mask2dBu,G%isd,G%ied,G%jsd,G%jed,G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2) + call zap2_sample(G%mask2dCu,diag_cs%decim(dl)%mask2dCu,G%isd,G%ied,G%jsd,G%jed,G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2) + call zap2_sample(G%mask2dCv,diag_cs%decim(dl)%mask2dCv,G%isd,G%ied,G%jsd,G%jed,G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2) + ! 3d native masks are needed by diag_manager but the native variables + ! can only be masked 2d - for ocean points, all layers exists. + allocate(diag_cs%decim(dl)%mask3dTL(G%isd_zap2:G%ied_zap2,G%jsd_zap2:G%jed_zap2,1:nz)) + allocate(diag_cs%decim(dl)%mask3dBL(G%IsdB_zap2:G%IedB_zap2,G%JsdB_zap2:G%JedB_zap2,1:nz)) + allocate(diag_cs%decim(dl)%mask3dCuL(G%IsdB_zap2:G%IedB_zap2,G%jsd_zap2:G%jed_zap2,1:nz)) + allocate(diag_cs%decim(dl)%mask3dCvL(G%isd_zap2:G%ied_zap2,G%JsdB_zap2:G%JedB_zap2,1:nz)) + do k=1,nz + diag_cs%decim(dl)%mask3dTL(:,:,k) = diag_cs%decim(dl)%mask2dT(:,:) + diag_cs%decim(dl)%mask3dBL(:,:,k) = diag_cs%decim(dl)%mask2dBu(:,:) + diag_cs%decim(dl)%mask3dCuL(:,:,k) = diag_cs%decim(dl)%mask2dCu(:,:) + diag_cs%decim(dl)%mask3dCvL(:,:,k) = diag_cs%decim(dl)%mask2dCv(:,:) + enddo + allocate(diag_cs%decim(dl)%mask3dTi(G%isd_zap2:G%ied_zap2,G%jsd_zap2:G%jed_zap2,1:nz+1)) + allocate(diag_cs%decim(dl)%mask3dBi(G%IsdB_zap2:G%IedB_zap2,G%JsdB_zap2:G%JedB_zap2,1:nz+1)) + allocate(diag_cs%decim(dl)%mask3dCui(G%IsdB_zap2:G%IedB_zap2,G%jsd_zap2:G%jed_zap2,1:nz+1)) + allocate(diag_cs%decim(dl)%mask3dCvi(G%isd_zap2:G%ied_zap2,G%JsdB_zap2:G%JedB_zap2,1:nz+1)) + do k=1,nz+1 + diag_cs%decim(dl)%mask3dTi(:,:,k) = diag_cs%decim(dl)%mask2dT(:,:) + diag_cs%decim(dl)%mask3dBi(:,:,k) = diag_cs%decim(dl)%mask2dBu(:,:) + diag_cs%decim(dl)%mask3dCui(:,:,k) = diag_cs%decim(dl)%mask2dCu(:,:) + diag_cs%decim(dl)%mask3dCvi(:,:,k) = diag_cs%decim(dl)%mask2dCv(:,:) + enddo + enddo +end subroutine decimate_diag_masks_set + + + +subroutine decimate_diag_field_2d(field, dl, diag_cs, isv,iev,jsv,jev) + real, pointer :: field(:,:) !< 2-d array being offered for output or averaging + integer, intent(in) :: dl !< integer decimation level + type(diag_ctrl),optional, intent(in) :: diag_CS !< Structure used to regulate diagnostic output + integer, optional, intent(inout) ::isv,iev,jsv,jev + ! Local variables + integer :: dszi,cszi,dszj,cszj + character(len=300) :: mesg + + call decimate_sample(field, dl) + + if(present(diag_cs))then + cszi = diag_cs%decim(dl)%iec-diag_cs%decim(dl)%isc +1 ; dszi = diag_cs%decim(dl)%ied-diag_cs%decim(dl)%isd +1 + cszj = diag_cs%decim(dl)%jec-diag_cs%decim(dl)%jsc +1 ; dszj = diag_cs%decim(dl)%jed-diag_cs%decim(dl)%jsd +1 + + isv = diag_cs%decim(dl)%isc ; iev = diag_cs%decim(dl)%iec + jsv = diag_cs%decim(dl)%jsc ; jev = diag_cs%decim(dl)%jec + + if ( size(field,1) == dszi ) then + isv = diag_cs%decim(dl)%isc ; iev = diag_cs%decim(dl)%iec ! Data domain + elseif ( size(field,1) == dszi + 1 ) then + isv = diag_cs%decim(dl)%isc ; iev = diag_cs%decim(dl)%iec+1 ! Symmetric data domain + elseif ( size(field,1) == cszi) then + isv = 1 ; iev = (diag_cs%decim(dl)%iec-diag_cs%decim(dl)%isc) +1 ! Computational domain + elseif ( size(field,1) == cszi + 1 ) then + isv = 1 ; iev = (diag_cs%decim(dl)%iec-diag_cs%decim(dl)%isc) +2 ! Symmetric computational domain + else + write (mesg,*) " peculiar size ",size(field,1)," in i-direction\n"//& + "does not match one of ", cszi, cszi+1, dszi, dszi+1 + call MOM_error(FATAL,"decimate_diag_field: "//trim(mesg)) + endif + if ( size(field,2) == dszj ) then + jsv = diag_cs%decim(dl)%jsc ; jev = diag_cs%decim(dl)%jec ! Data domain + elseif ( size(field,2) == dszj + 1 ) then + jsv = diag_cs%decim(dl)%jsc ; jev = diag_cs%decim(dl)%jec+1 ! Symmetric data domain + elseif ( size(field,2) == cszj) then + jsv = 1 ; jev = (diag_cs%decim(dl)%jec-diag_cs%decim(dl)%jsc) +1 ! Computational domain + elseif ( size(field,2) == cszj + 1 ) then + jsv = 1 ; jev = (diag_cs%decim(dl)%jec-diag_cs%decim(dl)%jsc) +2 ! Symmetric computational domain + else + write (mesg,*) " peculiar size ",size(field,2)," in j-direction\n"//& + "does not match one of ", cszj, cszj+1, dszj, dszj+1 + call MOM_error(FATAL,"decimate_diag_field: "//trim(mesg)) + endif + endif + +end subroutine decimate_diag_field_2d + +subroutine decimate_diag_field_3d(field, dl, diag_cs, isv,iev,jsv,jev) + real, pointer :: field(:,:,:) !< 3-d array being offered for output or averaging + integer, intent(in) :: dl !< integer decimation level + type(diag_ctrl),optional, intent(in) :: diag_CS !< Structure used to regulate diagnostic output + integer, optional, intent(inout) ::isv,iev,jsv,jev + ! Local variables + integer :: dszi,cszi,dszj,cszj + character(len=300) :: mesg + + call decimate_sample(field, dl) + + if(present(diag_cs))then + cszi = diag_cs%decim(dl)%iec-diag_cs%decim(dl)%isc +1 ; dszi = diag_cs%decim(dl)%ied-diag_cs%decim(dl)%isd +1 + cszj = diag_cs%decim(dl)%jec-diag_cs%decim(dl)%jsc +1 ; dszj = diag_cs%decim(dl)%jed-diag_cs%decim(dl)%jsd +1 + + isv = diag_cs%decim(dl)%isc ; iev = diag_cs%decim(dl)%iec + jsv = diag_cs%decim(dl)%jsc ; jev = diag_cs%decim(dl)%jec + + if ( size(field,1) == dszi ) then + isv = diag_cs%decim(dl)%isc ; iev = diag_cs%decim(dl)%iec ! Data domain + elseif ( size(field,1) == dszi + 1 ) then + isv = diag_cs%decim(dl)%isc ; iev = diag_cs%decim(dl)%iec+1 ! Symmetric data domain + elseif ( size(field,1) == cszi) then + isv = 1 ; iev = (diag_cs%decim(dl)%iec-diag_cs%decim(dl)%isc) +1 ! Computational domain + elseif ( size(field,1) == cszi + 1 ) then + isv = 1 ; iev = (diag_cs%decim(dl)%iec-diag_cs%decim(dl)%isc) +2 ! Symmetric computational domain + else + write (mesg,*) " peculiar size ",size(field,1)," in i-direction\n"//& + "does not match one of ", cszi, cszi+1, dszi, dszi+1 + call MOM_error(FATAL,"decimate_diag_field: "//trim(mesg)) + endif + if ( size(field,2) == dszj ) then + jsv = diag_cs%decim(dl)%jsc ; jev = diag_cs%decim(dl)%jec ! Data domain + elseif ( size(field,2) == dszj + 1 ) then + jsv = diag_cs%decim(dl)%jsc ; jev = diag_cs%decim(dl)%jec+1 ! Symmetric data domain + elseif ( size(field,2) == cszj) then + jsv = 1 ; jev = (diag_cs%decim(dl)%jec-diag_cs%decim(dl)%jsc) +1 ! Computational domain + elseif ( size(field,2) == cszj + 1 ) then + jsv = 1 ; jev = (diag_cs%decim(dl)%jec-diag_cs%decim(dl)%jsc) +2 ! Symmetric computational domain + else + write (mesg,*) " peculiar size ",size(field,2)," in j-direction\n"//& + "does not match one of ", cszj, cszj+1, dszj, dszj+1 + call MOM_error(FATAL,"decimate_diag_field: "//trim(mesg)) + endif + endif + +end subroutine decimate_diag_field_3d + + +subroutine decimate_sample_3d(field_in, level) + integer , intent(in) :: level + real, dimension(:,:,:) , pointer :: field_in, field_out + integer :: i,j,ii,jj,is,js + integer :: isl,iel,jsl,jel + integer :: k,ks,ke + ! is = lbound(field_in,1) ; ie = ubound(field_in,1) + ! js = lbound(field_in,2) ; je = ubound(field_in,2) + !Always start from the first element + is=1 + js=1 + ks = lbound(field_in,3) ; ke = ubound(field_in,3) + isl=1; iel=size(field_in,1)/level + jsl=1; jel=size(field_in,2)/level + allocate(field_out(isl:iel,jsl:jel,ks:ke)) + do k= ks,ke ; do j=jsl,jel ; do i=isl,iel + ii = is+level*(i-isl) + jj = js+level*(j-jsl) + field_out(i,j,k) = field_in(ii,jj,k) + enddo; enddo; enddo + field_in => field_out +end subroutine decimate_sample_3d + +subroutine decimate_sample_2d(field_in, level) + integer , intent(in) :: level + real, dimension(:,:) , pointer :: field_in, field_out + integer :: i,j,ii,jj,is,js + integer :: isl,iel,jsl,jel + ! is = lbound(field_in,1) ; ie = ubound(field_in,1) + ! js = lbound(field_in,2) ; je = ubound(field_in,2) + !Always start from the first element + is=1 + js=1 + isl=1; iel=size(field_in,1)/level + jsl=1; jel=size(field_in,2)/level + allocate(field_out(isl:iel,jsl:jel)) + do j=jsl,jel ; do i=isl,iel + ii = is+level*(i-isl) + jj = js+level*(j-jsl) + field_out(i,j) = field_in(ii,jj) + enddo; enddo + field_in => field_out +end subroutine decimate_sample_2d + end module MOM_diag_mediator diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 4022318e69..737e7a3fbf 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -54,7 +54,6 @@ module MOM_diag_remap public vertically_reintegrate_diag_field public vertically_interpolate_diag_field public horizontally_average_diag_field -public horizontally_decimate_diag_field !> Represents remapping of diagnostics to a particular vertical coordinate. !! @@ -705,20 +704,4 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, end subroutine horizontally_average_diag_field -!> Horizontally decimate field -subroutine horizontally_decimate_diag_field(G, h, & - is_layer, is_extensive, & - missing_value, decimation_factor, field, decimated_field) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - real, dimension(:,:,:), intent(in) :: h !< The current thicknesses - logical, intent(in) :: is_layer !< True if the z-axis location is at h points - logical, intent(in) :: is_extensive !< True if the z-direction is spatially integrated (over layers) - real, intent(in) :: missing_value !< A missing_value to assign land/vanished points - integer, intent(in) :: decimation_factor !< The factor by which to decimate the diag output field - real, dimension(:,:,:), intent(in) :: field !< The diagnostic field to be remapped - real, dimension(:), intent(inout) :: decimated_field !< Field argument horizontally averaged - ! Local variables - -end subroutine horizontally_decimate_diag_field - end module MOM_diag_remap From 8802dd25891bcbb24a4ec3bb36eca569a2be79e1 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Thu, 27 Sep 2018 19:02:01 -0400 Subject: [PATCH 0755/1072] Diag decimation prototype, requesting in diag_table - This update allows using non-native and decimated diagnostics as well as their combinations. E.g., it works for a diag_table as shown below. - I have to validate with a full diagnostics validate individual diagnostics make sense study the memory foot print to make sure the decimate rotuines have no leak (due to extensive use of fortran pointers) - Also we have to work on an averaging rather than sub-sampling of the fields as is done in this prototype OM5p5 1900 1 1 0 0 0 "ocean_hour", 0, "days", 1, "days", "time" "ocean_model", "tos", "tos", "ocean_hour", "all", "mean", "none",2 "ocean_model", "thetao", "thetao", "ocean_hour", "all", "mean", "none",2 "ocean_model", "umo", "umo", "ocean_hour", "all", "mean", "none",2 "ocean_model", "vmo", "vmo", "ocean_hour", "all", "mean", "none",2 "ocean_model", "volcello", "volcello", "ocean_hour", "all", "mean", "none",2 # Cell measure for 3d data "ocean_hour_d2", 0, "days", 1, "days", "time" "ocean_model_d2", "tos", "tos", "ocean_hour_d2", "all", "mean", "none",2 "ocean_model_d2", "thetao", "thetao", "ocean_hour_d2", "all", "mean", "none",2 "ocean_model_d2", "umo", "umo", "ocean_hour_d2", "all", "mean", "none",2 "ocean_model_d2", "vmo", "vmo", "ocean_hour_d2", "all", "mean", "none",2 "ocean_model_d2", "volcello", "volcello", "ocean_hour_d2", "all", "mean", "none",2 # Cell measure for 3d data "ocean_hour_z", 0, "days", 1, "days", "time" "ocean_model_z", "thetao", "thetao", "ocean_hour_z", "all", "mean", "none",2 "ocean_model_z", "umo", "umo", "ocean_hour_z", "all", "mean", "none",2 "ocean_model_z", "vmo", "vmo", "ocean_hour_z", "all", "mean", "none",2 "ocean_model_z", "volcello", "volcello", "ocean_hour_z", "all", "mean", "none",2 # Cell measure for 3d data "ocean_hour_z_d2", 0, "days", 1, "days", "time" "ocean_model_z_d2", "thetao", "thetao", "ocean_hour_z_d2", "all", "mean", "none",2 "ocean_model_z_d2", "umo", "umo", "ocean_hour_z_d2", "all", "mean", "none",2 "ocean_model_z_d2", "vmo", "vmo", "ocean_hour_z_d2", "all", "mean", "none",2 "ocean_model_z_d2", "volcello", "volcello", "ocean_hour_z_d2", "all", "mean", "none",2 # Cell measure for 3d data --- src/framework/MOM_diag_mediator.F90 | 466 ++++++++++++++++++++-------- 1 file changed, 342 insertions(+), 124 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 9bb049dbb7..6696933d9e 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -73,7 +73,7 @@ module MOM_diag_mediator end interface zap2_sample interface decimate_sample - module procedure decimate_sample_2d, decimate_sample_3d + module procedure decimate_sample_2d, decimate_sample_3d, decimate_sample_3d_out end interface decimate_sample interface decimate_diag_field @@ -176,6 +176,8 @@ module MOM_diag_mediator type(axes_grp) :: axesBL, axesTL, axesCuL, axesCvL type(axes_grp) :: axesBi, axesTi, axesCui, axesCvi type(axes_grp) :: axesB1, axesT1, axesCu1, axesCv1 + type(axes_grp), dimension(:), allocatable :: remap_axesTL, remap_axesBL, remap_axesCuL, remap_axesCvL + type(axes_grp), dimension(:), allocatable :: remap_axesTi, remap_axesBi, remap_axesCui, remap_axesCvi real, dimension(:,:), pointer :: mask2dT => null() !< 2D mask array for cell-center points real, dimension(:,:), pointer :: mask2dBu => null() !< 2D mask array for cell-corner points @@ -305,11 +307,10 @@ subroutine set_axes_info(G, GV, param_file, diag_cs, set_vertical) !! vertical axes ! Local variables integer :: id_xq, id_yq, id_zl, id_zi, id_xh, id_yh - integer :: i, j, k, nz, dl + integer :: id_zl_native, id_zi_native + integer :: i, j, k, nz real :: zlev(GV%ke), zinter(GV%ke+1) logical :: set_vert - real, dimension(:), pointer :: gridLonT_zap =>NULL() - real, dimension(:), pointer :: gridLatT_zap =>NULL() set_vert = .true. ; if (present(set_vertical)) set_vert = set_vertical @@ -326,7 +327,7 @@ subroutine set_axes_info(G, GV, param_file, diag_cs, set_vertical) else id_zl = -1 ; id_zi = -1 endif - + id_zl_native = id_zl ; id_zi_native = id_zi ! Vertical axes for the interfaces and layers call define_axes_group(diag_cs, (/ id_zi /), diag_cs%axesZi, 1, & v_cell_method='point', is_interface=.true.) @@ -391,79 +392,8 @@ subroutine set_axes_info(G, GV, param_file, diag_cs, set_vertical) ! Axis group for special null axis from diag manager call define_axes_group(diag_cs, (/ null_axis_id /), diag_cs%axesNull) - !Axes group for native decimated diagnostics - do dl=2,MAX_DECIM_LEV - - if(dl .eq. 2) then - allocate(gridLonT_zap(diag_cs%decim(dl)%isg:diag_cs%decim(dl)%ieg)) - allocate(gridLatT_zap(diag_cs%decim(dl)%jsg:diag_cs%decim(dl)%jeg)) - - do i=diag_cs%decim(dl)%isg,diag_cs%decim(dl)%ieg; gridLonT_zap(i) = G%gridLonT(G%isg+dl*i-2); enddo - do j=diag_cs%decim(dl)%jsg,diag_cs%decim(dl)%jeg; gridLatT_zap(j) = G%gridLatT(G%jsg+dl*j-2); enddo - - - ! if (G%symmetric) then - ! id_xq = diag_axis_init('xq', G%gridLonB_zap2(G%isgB:G%iegB), G%x_axis_units, 'x', & - ! 'q point nominal longitude', Domain2=G%Domain%mpp_domain_zap2) - ! id_yq = diag_axis_init('yq', G%gridLatB_zap2(G%jsgB:G%jegB), G%y_axis_units, 'y', & - ! 'q point nominal latitude', Domain2=G%Domain%mpp_domain_zap2) - ! else - id_xq = diag_axis_init('xq', gridLonT_zap, G%x_axis_units, 'x', & - 'q point nominal longitude', Domain2=G%Domain%mpp_domain_zap2) - id_yq = diag_axis_init('yq', gridLatT_zap, G%y_axis_units, 'y', & - 'q point nominal latitude', Domain2=G%Domain%mpp_domain_zap2) - ! endif - id_xh = diag_axis_init('xh', gridLonT_zap, G%x_axis_units, 'x', & - 'h point nominal longitude', Domain2=G%Domain%mpp_domain_zap2) - id_yh = diag_axis_init('yh', gridLatT_zap, G%y_axis_units, 'y', & - 'h point nominal latitude', Domain2=G%Domain%mpp_domain_zap2) - - deallocate(gridLonT_zap) - deallocate(gridLatT_zap) - else - call MOM_error(FATAL, "This decimation level is not supported yet!") - endif - - ! Axis groupings for the model layers - call define_axes_group_decim(diag_cs, (/ id_xh, id_yh, id_zL /), diag_cs%decim(dl)%axesTL, dl, & - x_cell_method='mean', y_cell_method='mean', v_cell_method='mean', & - is_h_point=.true., is_layer=.true., xyave_axes=diag_cs%axesZL) - call define_axes_group_decim(diag_cs, (/ id_xq, id_yq, id_zL /), diag_cs%decim(dl)%axesBL, dl, & - x_cell_method='point', y_cell_method='point', v_cell_method='mean', & - is_q_point=.true., is_layer=.true.) - call define_axes_group_decim(diag_cs, (/ id_xq, id_yh, id_zL /), diag_cs%decim(dl)%axesCuL, dl, & - x_cell_method='point', y_cell_method='mean', v_cell_method='mean', & - is_u_point=.true., is_layer=.true., xyave_axes=diag_cs%axesZL) - call define_axes_group_decim(diag_cs, (/ id_xh, id_yq, id_zL /), diag_cs%decim(dl)%axesCvL, dl, & - x_cell_method='mean', y_cell_method='point', v_cell_method='mean', & - is_v_point=.true., is_layer=.true., xyave_axes=diag_cs%axesZL) - - ! Axis groupings for the model interfaces - call define_axes_group_decim(diag_cs, (/ id_xh, id_yh, id_zi /), diag_cs%decim(dl)%axesTi, dl, & - x_cell_method='mean', y_cell_method='mean', v_cell_method='point', & - is_h_point=.true., is_interface=.true., xyave_axes=diag_cs%axesZi) - call define_axes_group_decim(diag_cs, (/ id_xq, id_yq, id_zi /), diag_cs%decim(dl)%axesBi, dl, & - x_cell_method='point', y_cell_method='point', v_cell_method='point', & - is_q_point=.true., is_interface=.true.) - call define_axes_group_decim(diag_cs, (/ id_xq, id_yh, id_zi /), diag_cs%decim(dl)%axesCui, dl, & - x_cell_method='point', y_cell_method='mean', v_cell_method='point', & - is_u_point=.true., is_interface=.true., xyave_axes=diag_cs%axesZi) - call define_axes_group_decim(diag_cs, (/ id_xh, id_yq, id_zi /), diag_cs%decim(dl)%axesCvi, dl, & - x_cell_method='mean', y_cell_method='point', v_cell_method='point', & - is_v_point=.true., is_interface=.true., xyave_axes=diag_cs%axesZi) - - ! Axis groupings for 2-D arrays - call define_axes_group_decim(diag_cs, (/ id_xh, id_yh /), diag_cs%decim(dl)%axesT1, dl, & - x_cell_method='mean', y_cell_method='mean', is_h_point=.true.) - call define_axes_group_decim(diag_cs, (/ id_xq, id_yq /), diag_cs%decim(dl)%axesB1, dl, & - x_cell_method='point', y_cell_method='point', is_q_point=.true.) - call define_axes_group_decim(diag_cs, (/ id_xq, id_yh /), diag_cs%decim(dl)%axesCu1, dl, & - x_cell_method='point', y_cell_method='mean', is_u_point=.true.) - call define_axes_group_decim(diag_cs, (/ id_xh, id_yq /), diag_cs%decim(dl)%axesCv1, dl, & - x_cell_method='mean', y_cell_method='point', is_v_point=.true.) - - enddo + !Non-native Non-decimated if (diag_cs%num_diag_coords>0) then allocate(diag_cs%remap_axesZL(diag_cs%num_diag_coords)) allocate(diag_cs%remap_axesTL(diag_cs%num_diag_coords)) @@ -549,11 +479,186 @@ subroutine set_axes_info(G, GV, param_file, diag_cs, set_vertical) needs_interpolating=.true., xyave_axes=diag_cs%remap_axesZi(i)) endif enddo + + !Defien the decimated axes + call set_axes_info_decim(G, GV, param_file, diag_cs, id_zl_native, id_zi_native) call diag_grid_storage_init(diag_CS%diag_grid_temp, G, diag_CS) end subroutine set_axes_info +subroutine set_axes_info_decim(G, GV, param_file, diag_cs, id_zl_native, id_zi_native) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(diag_ctrl), intent(inout) :: diag_cs !< Diagnostics control structure + integer, intent(in) :: id_zl_native, id_zi_native + + ! Local variables + integer :: id_xq, id_yq, id_zl, id_zi, id_xh, id_yh + integer :: i, j, k, nz, dl + real, dimension(:), pointer :: gridLonT_zap =>NULL() + real, dimension(:), pointer :: gridLatT_zap =>NULL() + + id_zl = id_zl_native ; id_zi = id_zi_native + !Axes group for native decimated diagnostics + do dl=2,MAX_DECIM_LEV + if(dl .ne. 2) call MOM_error(FATAL, "Decimation level other than 2 is not supported yet!") + allocate(gridLonT_zap(diag_cs%decim(dl)%isg:diag_cs%decim(dl)%ieg)) + allocate(gridLatT_zap(diag_cs%decim(dl)%jsg:diag_cs%decim(dl)%jeg)) + + do i=diag_cs%decim(dl)%isg,diag_cs%decim(dl)%ieg; gridLonT_zap(i) = G%gridLonT(G%isg+dl*i-2); enddo + do j=diag_cs%decim(dl)%jsg,diag_cs%decim(dl)%jeg; gridLatT_zap(j) = G%gridLatT(G%jsg+dl*j-2); enddo + + ! if (G%symmetric) then + ! id_xq = diag_axis_init('xq', G%gridLonB_zap2(G%isgB:G%iegB), G%x_axis_units, 'x', & + ! 'q point nominal longitude', Domain2=G%Domain%mpp_domain_zap2) + ! id_yq = diag_axis_init('yq', G%gridLatB_zap2(G%jsgB:G%jegB), G%y_axis_units, 'y', & + ! 'q point nominal latitude', Domain2=G%Domain%mpp_domain_zap2) + ! else + id_xq = diag_axis_init('xq', gridLonT_zap, G%x_axis_units, 'x', & + 'q point nominal longitude', Domain2=G%Domain%mpp_domain_zap2) + id_yq = diag_axis_init('yq', gridLatT_zap, G%y_axis_units, 'y', & + 'q point nominal latitude', Domain2=G%Domain%mpp_domain_zap2) + ! endif + id_xh = diag_axis_init('xh', gridLonT_zap, G%x_axis_units, 'x', & + 'h point nominal longitude', Domain2=G%Domain%mpp_domain_zap2) + id_yh = diag_axis_init('yh', gridLatT_zap, G%y_axis_units, 'y', & + 'h point nominal latitude', Domain2=G%Domain%mpp_domain_zap2) + + deallocate(gridLonT_zap) + deallocate(gridLatT_zap) + + ! Axis groupings for the model layers + call define_axes_group_decim(diag_cs, (/ id_xh, id_yh, id_zL /), diag_cs%decim(dl)%axesTL, dl, & + x_cell_method='mean', y_cell_method='mean', v_cell_method='mean', & + is_h_point=.true., is_layer=.true., xyave_axes=diag_cs%axesZL) + call define_axes_group_decim(diag_cs, (/ id_xq, id_yq, id_zL /), diag_cs%decim(dl)%axesBL, dl, & + x_cell_method='point', y_cell_method='point', v_cell_method='mean', & + is_q_point=.true., is_layer=.true.) + call define_axes_group_decim(diag_cs, (/ id_xq, id_yh, id_zL /), diag_cs%decim(dl)%axesCuL, dl, & + x_cell_method='point', y_cell_method='mean', v_cell_method='mean', & + is_u_point=.true., is_layer=.true., xyave_axes=diag_cs%axesZL) + call define_axes_group_decim(diag_cs, (/ id_xh, id_yq, id_zL /), diag_cs%decim(dl)%axesCvL, dl, & + x_cell_method='mean', y_cell_method='point', v_cell_method='mean', & + is_v_point=.true., is_layer=.true., xyave_axes=diag_cs%axesZL) + + ! Axis groupings for the model interfaces + call define_axes_group_decim(diag_cs, (/ id_xh, id_yh, id_zi /), diag_cs%decim(dl)%axesTi, dl, & + x_cell_method='mean', y_cell_method='mean', v_cell_method='point', & + is_h_point=.true., is_interface=.true., xyave_axes=diag_cs%axesZi) + call define_axes_group_decim(diag_cs, (/ id_xq, id_yq, id_zi /), diag_cs%decim(dl)%axesBi, dl, & + x_cell_method='point', y_cell_method='point', v_cell_method='point', & + is_q_point=.true., is_interface=.true.) + call define_axes_group_decim(diag_cs, (/ id_xq, id_yh, id_zi /), diag_cs%decim(dl)%axesCui, dl, & + x_cell_method='point', y_cell_method='mean', v_cell_method='point', & + is_u_point=.true., is_interface=.true., xyave_axes=diag_cs%axesZi) + call define_axes_group_decim(diag_cs, (/ id_xh, id_yq, id_zi /), diag_cs%decim(dl)%axesCvi, dl, & + x_cell_method='mean', y_cell_method='point', v_cell_method='point', & + is_v_point=.true., is_interface=.true., xyave_axes=diag_cs%axesZi) + + ! Axis groupings for 2-D arrays + call define_axes_group_decim(diag_cs, (/ id_xh, id_yh /), diag_cs%decim(dl)%axesT1, dl, & + x_cell_method='mean', y_cell_method='mean', is_h_point=.true.) + call define_axes_group_decim(diag_cs, (/ id_xq, id_yq /), diag_cs%decim(dl)%axesB1, dl, & + x_cell_method='point', y_cell_method='point', is_q_point=.true.) + call define_axes_group_decim(diag_cs, (/ id_xq, id_yh /), diag_cs%decim(dl)%axesCu1, dl, & + x_cell_method='point', y_cell_method='mean', is_u_point=.true.) + call define_axes_group_decim(diag_cs, (/ id_xh, id_yq /), diag_cs%decim(dl)%axesCv1, dl, & + x_cell_method='mean', y_cell_method='point', is_v_point=.true.) + + !Non-native axes + if (diag_cs%num_diag_coords>0) then +! allocate(diag_cs%decim(dl)%remap_axesZL(diag_cs%num_diag_coords)) +! allocate(diag_cs%decim(dl)%remap_axesZi(diag_cs%num_diag_coords)) + allocate(diag_cs%decim(dl)%remap_axesTL(diag_cs%num_diag_coords)) + allocate(diag_cs%decim(dl)%remap_axesBL(diag_cs%num_diag_coords)) + allocate(diag_cs%decim(dl)%remap_axesCuL(diag_cs%num_diag_coords)) + allocate(diag_cs%decim(dl)%remap_axesCvL(diag_cs%num_diag_coords)) + allocate(diag_cs%decim(dl)%remap_axesTi(diag_cs%num_diag_coords)) + allocate(diag_cs%decim(dl)%remap_axesBi(diag_cs%num_diag_coords)) + allocate(diag_cs%decim(dl)%remap_axesCui(diag_cs%num_diag_coords)) + allocate(diag_cs%decim(dl)%remap_axesCvi(diag_cs%num_diag_coords)) + endif + + do i=1, diag_cs%num_diag_coords + ! For each possible diagnostic coordinate + !call diag_remap_configure_axes(diag_cs%diag_remap_cs(i), GV, param_file) + + ! This vertical coordinate has been configured so can be used. + if (diag_remap_axes_configured(diag_cs%diag_remap_cs(i))) then + + ! This fetches the 1D-axis id for layers and interfaces and overwrite + ! id_zl and id_zi from above. It also returns the number of layers. + call diag_remap_get_axes_info(diag_cs%diag_remap_cs(i), nz, id_zL, id_zi) + + ! Axes for z layers + !This should be the same as non-decimated one which should already be set +! call define_axes_group(diag_cs, (/ id_zL /), diag_cs%decim(dl)%remap_axesZL(i), & +! nz=nz, vertical_coordinate_number=i, & +! v_cell_method='mean', & +! is_h_point=.true., is_layer=.true., is_native=.false., needs_remapping=.true.) + + call define_axes_group_decim(diag_cs, (/ id_xh, id_yh, id_zL /), diag_cs%decim(dl)%remap_axesTL(i), dl, & + nz=nz, vertical_coordinate_number=i, & + x_cell_method='mean', y_cell_method='mean', v_cell_method='mean', & + is_h_point=.true., is_layer=.true., is_native=.false., needs_remapping=.true., & + xyave_axes=diag_cs%remap_axesZL(i)) + + !! \note Remapping for B points is not yet implemented so needs_remapping is not + !! provided for remap_axesBL + call define_axes_group_decim(diag_cs, (/ id_xq, id_yq, id_zL /), diag_cs%decim(dl)%remap_axesBL(i), dl, & + nz=nz, vertical_coordinate_number=i, & + x_cell_method='point', y_cell_method='point', v_cell_method='mean', & + is_q_point=.true., is_layer=.true., is_native=.false.) + + call define_axes_group_decim(diag_cs, (/ id_xq, id_yh, id_zL /), diag_cs%decim(dl)%remap_axesCuL(i), dl, & + nz=nz, vertical_coordinate_number=i, & + x_cell_method='point', y_cell_method='mean', v_cell_method='mean', & + is_u_point=.true., is_layer=.true., is_native=.false., needs_remapping=.true., & + xyave_axes=diag_cs%remap_axesZL(i)) + + call define_axes_group_decim(diag_cs, (/ id_xh, id_yq, id_zL /), diag_cs%decim(dl)%remap_axesCvL(i), dl, & + nz=nz, vertical_coordinate_number=i, & + x_cell_method='mean', y_cell_method='point', v_cell_method='mean', & + is_v_point=.true., is_layer=.true., is_native=.false., needs_remapping=.true., & + xyave_axes=diag_cs%remap_axesZL(i)) + + ! Axes for z interfaces +! call define_axes_group_decim(diag_cs, (/ id_zi /), diag_cs%decim(dl)%remap_axesZi(i),& +! nz=nz, vertical_coordinate_number=i, & +! v_cell_method='point', & +! is_h_point=.true., is_interface=.true., is_native=.false., needs_interpolating=.true.) + call define_axes_group_decim(diag_cs, (/ id_xh, id_yh, id_zi /), diag_cs%decim(dl)%remap_axesTi(i), dl, & + nz=nz, vertical_coordinate_number=i, & + x_cell_method='mean', y_cell_method='mean', v_cell_method='point', & + is_h_point=.true., is_interface=.true., is_native=.false., needs_interpolating=.true., & + xyave_axes=diag_cs%remap_axesZi(i)) + + !! \note Remapping for B points is not yet implemented so needs_remapping is not provided for remap_axesBi + call define_axes_group_decim(diag_cs, (/ id_xq, id_yq, id_zi /), diag_cs%decim(dl)%remap_axesBi(i), dl, & + nz=nz, vertical_coordinate_number=i, & + x_cell_method='point', y_cell_method='point', v_cell_method='point', & + is_q_point=.true., is_interface=.true., is_native=.false.) + + call define_axes_group_decim(diag_cs, (/ id_xq, id_yh, id_zi /), diag_cs%decim(dl)%remap_axesCui(i), dl, & + nz=nz, vertical_coordinate_number=i, & + x_cell_method='point', y_cell_method='mean', v_cell_method='point', & + is_u_point=.true., is_interface=.true., is_native=.false., & + needs_interpolating=.true., xyave_axes=diag_cs%remap_axesZi(i)) + + call define_axes_group_decim(diag_cs, (/ id_xh, id_yq, id_zi /), diag_cs%decim(dl)%remap_axesCvi(i), dl, & + nz=nz, vertical_coordinate_number=i, & + x_cell_method='mean', y_cell_method='point', v_cell_method='point', & + is_v_point=.true., is_interface=.true., is_native=.false., & + needs_interpolating=.true., xyave_axes=diag_cs%remap_axesZi(i)) + endif + enddo + enddo + +end subroutine set_axes_info_decim + + !> set_masks_for_axes sets up the 2d and 3d masks for diagnostics using the current grid !! recorded after calling diag_update_remap_grids() subroutine set_masks_for_axes(G, diag_cs) @@ -650,8 +755,50 @@ subroutine set_masks_for_axes(G, diag_cs) endif enddo + call set_masks_for_axes_decim(G, diag_cs) + end subroutine set_masks_for_axes +subroutine set_masks_for_axes_decim(G, diag_cs) + type(ocean_grid_type), target, intent(in) :: G !< The ocean grid type. + type(diag_ctrl), pointer :: diag_cs !< A pointer to a type with many variables + !! used for diagnostics + ! Local variables + integer :: c, nk, i, j, k, ii, jj + integer :: dl + type(axes_grp), pointer :: axes => NULL(), h_axes => NULL() ! Current axes, for convenience + + do dl=2,MAX_DECIM_LEV + if(dl .ne. 2) call MOM_error(FATAL, "Decimation level other than 2 is not supported yet!") + do c=1, diag_cs%num_diag_coords + ! Level/layer h-points in diagnostic coordinate + axes => diag_cs%remap_axesTL(c) + call decimate_sample(axes%mask3d, axes%decim(dl)%mask3d, dl) + ! Level/layer u-points in diagnostic coordinate + axes => diag_cs%remap_axesCuL(c) + call decimate_sample(axes%mask3d, axes%decim(dl)%mask3d, dl) + ! Level/layer v-points in diagnostic coordinate + axes => diag_cs%remap_axesCvL(c) + call decimate_sample(axes%mask3d, axes%decim(dl)%mask3d, dl) + ! Level/layer q-points in diagnostic coordinate + axes => diag_cs%remap_axesBL(c) + call decimate_sample(axes%mask3d, axes%decim(dl)%mask3d, dl) + ! Interface h-points in diagnostic coordinate (w-point) + axes => diag_cs%remap_axesTi(c) + call decimate_sample(axes%mask3d, axes%decim(dl)%mask3d, dl) + ! Interface u-points in diagnostic coordinate + axes => diag_cs%remap_axesCui(c) + call decimate_sample(axes%mask3d, axes%decim(dl)%mask3d, dl) + ! Interface v-points in diagnostic coordinate + axes => diag_cs%remap_axesCvi(c) + call decimate_sample(axes%mask3d, axes%decim(dl)%mask3d, dl) + ! Interface q-points in diagnostic coordinate + axes => diag_cs%remap_axesBi(c) + call decimate_sample(axes%mask3d, axes%decim(dl)%mask3d, dl) + enddo + enddo +end subroutine set_masks_for_axes_decim + !> Attaches the id of cell areas to axes groups for use with cell_measures subroutine diag_register_area_ids(diag_cs, id_area_t, id_area_q) type(diag_ctrl), intent(inout) :: diag_cs !< Diagnostics control structure @@ -1685,6 +1832,54 @@ integer function register_diag_field(module_name, field_name, axes_in, init_time y_cell_method=y_cell_method, v_cell_method=v_cell_method, & conversion=conversion, v_extensive=v_extensive) + ! For each diagnostic coordinate register the diagnostic again under a different module name + do i=1,diag_cs%num_diag_coords + new_module_name = trim(module_name)//'_'//trim(diag_cs%diag_remap_cs(i)%diag_module_suffix) + + ! Register diagnostics remapped to z vertical coordinate + if (axes_in%rank == 3) then + remap_axes => null() + if ((axes_in%id == diag_cs%axesTL%id)) then + remap_axes => diag_cs%remap_axesTL(i) + elseif (axes_in%id == diag_cs%axesBL%id) then + remap_axes => diag_cs%remap_axesBL(i) + elseif (axes_in%id == diag_cs%axesCuL%id ) then + remap_axes => diag_cs%remap_axesCuL(i) + elseif (axes_in%id == diag_cs%axesCvL%id) then + remap_axes => diag_cs%remap_axesCvL(i) + elseif (axes_in%id == diag_cs%axesTi%id) then + remap_axes => diag_cs%remap_axesTi(i) + elseif (axes_in%id == diag_cs%axesBi%id) then + remap_axes => diag_cs%remap_axesBi(i) + elseif (axes_in%id == diag_cs%axesCui%id ) then + remap_axes => diag_cs%remap_axesCui(i) + elseif (axes_in%id == diag_cs%axesCvi%id) then + remap_axes => diag_cs%remap_axesCvi(i) + endif + + ! When the MOM_diag_to_Z module has been obsoleted we can assume remap_axes will + ! always exist but in the mean-time we have to do this check: + ! call assert(associated(remap_axes), 'register_diag_field: remap_axes not set') + if (associated(remap_axes)) then + if (remap_axes%needs_remapping .or. remap_axes%needs_interpolating) then + active = register_diag_field_expand_cmor(dm_id, new_module_name, field_name, remap_axes, & + init_time, long_name=long_name, units=units, missing_value=MOM_missing_value, & + range=range, mask_variant=mask_variant, standard_name=standard_name, & + verbose=verbose, do_not_log=do_not_log, err_msg=err_msg, & + interp_method=interp_method, tile_count=tile_count, & + cmor_field_name=cmor_field_name, cmor_long_name=cmor_long_name, & + cmor_units=cmor_units, cmor_standard_name=cmor_standard_name, & + cell_methods=cell_methods, x_cell_method=x_cell_method, & + y_cell_method=y_cell_method, v_cell_method=v_cell_method, & + conversion=conversion, v_extensive=v_extensive) + if (active) then + call diag_remap_set_active(diag_cs%diag_remap_cs(i)) + endif + endif ! remap_axes%needs_remapping + endif ! associated(remap_axes) + endif ! axes%rank == 3 + enddo ! i + do dl=2,MAX_DECIM_LEV new_module_name = trim(module_name)//'_d2' @@ -1733,54 +1928,55 @@ integer function register_diag_field(module_name, field_name, axes_in, init_time y_cell_method=y_cell_method, v_cell_method=v_cell_method, & conversion=conversion, v_extensive=v_extensive) endif - enddo - ! For each diagnostic coordinate register the diagnostic again under a different module name - do i=1,diag_cs%num_diag_coords - new_module_name = trim(module_name)//'_'//trim(diag_cs%diag_remap_cs(i)%diag_module_suffix) - - ! Register diagnostics remapped to z vertical coordinate - if (axes_in%rank == 3) then - remap_axes => null() - if ((axes_in%id == diag_cs%axesTL%id)) then - remap_axes => diag_cs%remap_axesTL(i) - elseif (axes_in%id == diag_cs%axesBL%id) then - remap_axes => diag_cs%remap_axesBL(i) - elseif (axes_in%id == diag_cs%axesCuL%id ) then - remap_axes => diag_cs%remap_axesCuL(i) - elseif (axes_in%id == diag_cs%axesCvL%id) then - remap_axes => diag_cs%remap_axesCvL(i) - elseif (axes_in%id == diag_cs%axesTi%id) then - remap_axes => diag_cs%remap_axesTi(i) - elseif (axes_in%id == diag_cs%axesBi%id) then - remap_axes => diag_cs%remap_axesBi(i) - elseif (axes_in%id == diag_cs%axesCui%id ) then - remap_axes => diag_cs%remap_axesCui(i) - elseif (axes_in%id == diag_cs%axesCvi%id) then - remap_axes => diag_cs%remap_axesCvi(i) - endif - ! When the MOM_diag_to_Z module has been obsoleted we can assume remap_axes will - ! always exist but in the mean-time we have to do this check: - ! call assert(associated(remap_axes), 'register_diag_field: remap_axes not set') - if (associated(remap_axes)) then - if (remap_axes%needs_remapping .or. remap_axes%needs_interpolating) then - active = register_diag_field_expand_cmor(dm_id, new_module_name, field_name, remap_axes, & - init_time, long_name=long_name, units=units, missing_value=MOM_missing_value, & - range=range, mask_variant=mask_variant, standard_name=standard_name, & - verbose=verbose, do_not_log=do_not_log, err_msg=err_msg, & - interp_method=interp_method, tile_count=tile_count, & - cmor_field_name=cmor_field_name, cmor_long_name=cmor_long_name, & - cmor_units=cmor_units, cmor_standard_name=cmor_standard_name, & - cell_methods=cell_methods, x_cell_method=x_cell_method, & - y_cell_method=y_cell_method, v_cell_method=v_cell_method, & - conversion=conversion, v_extensive=v_extensive) - if (active) then - call diag_remap_set_active(diag_cs%diag_remap_cs(i)) - endif - endif ! remap_axes%needs_remapping - endif ! associated(remap_axes) - endif ! axes%rank == 3 - enddo ! i + ! For each diagnostic coordinate register the diagnostic again under a different module name + do i=1,diag_cs%num_diag_coords + new_module_name = trim(module_name)//'_'//trim(diag_cs%diag_remap_cs(i)%diag_module_suffix)//'_d2' + + ! Register diagnostics remapped to z vertical coordinate + if (axes_in%rank == 3) then + remap_axes => null() + if ((axes_in%id == diag_cs%axesTL%id)) then + remap_axes => diag_cs%decim(dl)%remap_axesTL(i) + elseif (axes_in%id == diag_cs%axesBL%id) then + remap_axes => diag_cs%decim(dl)%remap_axesBL(i) + elseif (axes_in%id == diag_cs%axesCuL%id ) then + remap_axes => diag_cs%decim(dl)%remap_axesCuL(i) + elseif (axes_in%id == diag_cs%axesCvL%id) then + remap_axes => diag_cs%decim(dl)%remap_axesCvL(i) + elseif (axes_in%id == diag_cs%axesTi%id) then + remap_axes => diag_cs%decim(dl)%remap_axesTi(i) + elseif (axes_in%id == diag_cs%axesBi%id) then + remap_axes => diag_cs%decim(dl)%remap_axesBi(i) + elseif (axes_in%id == diag_cs%axesCui%id ) then + remap_axes => diag_cs%decim(dl)%remap_axesCui(i) + elseif (axes_in%id == diag_cs%axesCvi%id) then + remap_axes => diag_cs%decim(dl)%remap_axesCvi(i) + endif + + ! When the MOM_diag_to_Z module has been obsoleted we can assume remap_axes will + ! always exist but in the mean-time we have to do this check: + ! call assert(associated(remap_axes), 'register_diag_field: remap_axes not set') + if (associated(remap_axes)) then + if (remap_axes%needs_remapping .or. remap_axes%needs_interpolating) then + active = register_diag_field_expand_cmor(dm_id, new_module_name, field_name, remap_axes, & + init_time, long_name=long_name, units=units, missing_value=MOM_missing_value, & + range=range, mask_variant=mask_variant, standard_name=standard_name, & + verbose=verbose, do_not_log=do_not_log, err_msg=err_msg, & + interp_method=interp_method, tile_count=tile_count, & + cmor_field_name=cmor_field_name, cmor_long_name=cmor_long_name, & + cmor_units=cmor_units, cmor_standard_name=cmor_standard_name, & + cell_methods=cell_methods, x_cell_method=x_cell_method, & + y_cell_method=y_cell_method, v_cell_method=v_cell_method, & + conversion=conversion, v_extensive=v_extensive) + if (active) then + call diag_remap_set_active(diag_cs%diag_remap_cs(i)) + endif + endif ! remap_axes%needs_remapping + endif ! associated(remap_axes) + endif ! axes%rank == 3 + enddo ! i + enddo register_diag_field = dm_id @@ -3411,4 +3607,26 @@ subroutine decimate_sample_2d(field_in, level) field_in => field_out end subroutine decimate_sample_2d +subroutine decimate_sample_3d_out(field_in, field_out, level) + integer , intent(in) :: level + real, dimension(:,:,:) , pointer :: field_in, field_out + integer :: i,j,ii,jj,is,js + integer :: isl,iel,jsl,jel + integer :: k,ks,ke + ! is = lbound(field_in,1) ; ie = ubound(field_in,1) + ! js = lbound(field_in,2) ; je = ubound(field_in,2) + !Always start from the first element + is=1 + js=1 + ks = lbound(field_in,3) ; ke = ubound(field_in,3) + isl=1; iel=size(field_in,1)/level + jsl=1; jel=size(field_in,2)/level + allocate(field_out(isl:iel,jsl:jel,ks:ke)) + do k= ks,ke ; do j=jsl,jel ; do i=isl,iel + ii = is+level*(i-isl) + jj = js+level*(j-jsl) + field_out(i,j,k) = field_in(ii,jj,k) + enddo; enddo; enddo +end subroutine decimate_sample_3d_out + end module MOM_diag_mediator From 9cdfbf69d03e848baa62d46dfb192356f1a1940a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 28 Sep 2018 17:24:32 -0400 Subject: [PATCH 0756/1072] Do bulkmixedlayer in units of Z Rescaled several of the variables in bulkmixedlayer to work in units of Z and H instead of m. Also eliminated several unused variables and updated the comments describing others. Several duplicate comment blocks were also removed. All answers are bitwise identical. --- .../vertical/MOM_bulk_mixed_layer.F90 | 452 +++++++----------- 1 file changed, 174 insertions(+), 278 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index ab05237607..48d3729c74 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -42,13 +42,13 @@ module MOM_bulk_mixed_layer !! the mixed layer is converted to TKE, nondim. real :: bulk_Ri_convective !< The efficiency with which convectively !! released mean kinetic energy becomes TKE, nondim. - real :: Hmix_min !< The minimum mixed layer thickness in m. + real :: Hmix_min !< The minimum mixed layer thickness in H. real :: H_limit_fluxes !< When the total ocean depth is less than this - !! value, in m, scale away all surface forcing to + !! value, in H, scale away all surface forcing to !! avoid boiling the ocean. - real :: ustar_min !< A minimum value of ustar to avoid numerical - !! problems, in m s-1. If the value is small enough, - !! this should not affect the solution. + real :: ustar_min !< A minimum value of ustar to avoid numerical problems, + !! in Z s-1. If the value is small enough, this should + !! not affect the solution. real :: omega !< The Earth's rotation rate, in s-1. real :: dT_dS_wt !< When forced to extrapolate T & S to match the !! layer densities, this factor (in deg C / PSU) is @@ -81,8 +81,8 @@ module MOM_bulk_mixed_layer type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. logical :: TKE_diagnostics = .false. !< If true, calculate extensive diagnostics of the TKE budget logical :: do_rivermix = .false. !< Provide additional TKE to mix river runoff - !! at the river mouths to "rivermix_depth" meters - real :: rivermix_depth = 0.0 !< Used if "do_rivermix" = T + !! at the river mouths to rivermix_depth + real :: rivermix_depth = 0.0 !< The depth of mixing if do_rivermix is true, in Z. logical :: limit_det !< If true, limit the extent of buffer layer !! detrainment to be consistent with neighbors. real :: lim_det_dH_sfc !< The fractional limit in the change between grid @@ -105,9 +105,9 @@ module MOM_bulk_mixed_layer real :: Allowed_S_chg !< The amount by which salinity is allowed !! to exceed previous values during detrainment, PSU. -! These are terms in the mixed layer TKE budget, all in m3 s-2. + ! These are terms in the mixed layer TKE budget, all in Z m2 s-3. real, allocatable, dimension(:,:) :: & - ML_depth, & !< The mixed layer depth in m. + ML_depth, & !< The mixed layer depth in H. diag_TKE_wind, & !< The wind source of TKE. diag_TKE_RiBulk, & !< The resolved KE source of TKE. diag_TKE_conv, & !< The convective source of TKE. @@ -116,8 +116,8 @@ module MOM_bulk_mixed_layer diag_TKE_conv_decay, & !< The decay of convective TKE. diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer. diag_TKE_conv_s2, & !< The convective source of TKE due to to mixing in sigma2. - diag_PE_detrain, & !< The spurious source of potential energy due to mixed layer detrainment, W m-2. - diag_PE_detrain2 !< The spurious source of potential energy due to mixed layer only detrainment, W m-2. + diag_PE_detrain, & !< The spurious source of potential energy due to mixed layer detrainment, W Z m-3. + diag_PE_detrain2 !< The spurious source of potential energy due to mixed layer only detrainment, W Z m-3. logical :: allow_clocks_in_omp_loops !< If true, clocks can be called from inside loops that can !! be threaded. To run with multiple threads, set to False. type(group_pass_type) :: pass_h_sum_hmbl_prev !< For group halo pass @@ -204,7 +204,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & type(optics_type), pointer :: optics !< The structure containing the inverse of the !! vertical absorption decay scale for !! penetrating shortwave radiation, in m-1. - real, dimension(:,:), pointer :: Hml !< active mixed layer depth + real, dimension(:,:), pointer :: Hml !< Active mixed layer depth, in m. logical, intent(in) :: aggregate_FW_forcing !< If true, the net incoming and !! outgoing surface freshwater fluxes are !! combined before being applied, instead of @@ -286,7 +286,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & ! new, sorted index space. Here layer 0 is an initially massless layer that ! will be used to hold the new mixed layer properties. real, dimension(SZI_(G),SZK0_(GV)) :: & - h, & ! The layer thickness, in m or kg m-2. + h, & ! The layer thickness, in H (often m or kg m-2). T, & ! The layer temperatures, in deg C. S, & ! The layer salinities, in psu. R0, & ! The potential density referenced to the surface, in kg m-3. @@ -294,7 +294,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & real, dimension(SZI_(G),SZK_(GV)) :: & u, & ! The zonal velocity, in m s-1. v, & ! The meridional velocity, in m s-1. - h_orig, & ! The original thickness in m or kg m-2. + h_orig, & ! The original thickness in H (often m or kg m-2). d_eb, & ! The downward increase across a layer in the entrainment from ! below, in H. The sign convention is that positive values of ! d_eb correspond to a gain in mass by a layer by upward motion. @@ -305,12 +305,12 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & integer, dimension(SZI_(G),SZK_(GV)) :: & ksort ! The sorted k-index that each original layer goes to. real, dimension(SZI_(G),SZJ_(G)) :: & - h_miss ! The summed absolute mismatch, in m. + h_miss ! The summed absolute mismatch, in H. real, dimension(SZI_(G)) :: & TKE, & ! The turbulent kinetic energy available for mixing over a - ! time step, in m3 s-2. + ! time step, in Z m2 s-2. Conv_En, & ! The turbulent kinetic energy source due to mixing down to - ! the depth of free convection, in m3 s-2. + ! the depth of free convection, in Z m2 s-2. htot, & ! The total depth of the layers being considered for ! entrainment, in H. R0_tot, & ! The integrated potential density referenced to the surface @@ -346,7 +346,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & dRcv_dS, & ! Partial derivative of the coordinate variable potential ! density in the mixed layer with salinity, in kg m-3 psu-1. TKE_river ! The turbulent kinetic energy available for mixing at rivermouths over a - ! time step, in m3 s-2. + ! time step, in Z m2 s-2. real, dimension(max(CS%nsw,1),SZI_(G)) :: & Pen_SW_bnd ! The penetrating fraction of the shortwave heating integrated @@ -365,21 +365,21 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & real, dimension(SZI_(G)) :: & dKE_FC, & ! The change in mean kinetic energy due to free convection, - ! in m3 s-2. + ! in Z m2 s-2. h_CA ! The depth to which convective adjustment has gone in H. real, dimension(SZI_(G),SZK_(GV)) :: & dKE_CA, & ! The change in mean kinetic energy due to convective - ! adjustment, in m3 s-2. + ! adjustment, in Z m2 s-2. cTKE ! The turbulent kinetic energy source due to convective - ! adjustment, m3 s-2. + ! adjustment, Z m2 s-2. real, dimension(SZI_(G),SZJ_(G)) :: & Hsfc_max, & ! The thickness of the surface region (mixed and buffer layers) - ! after entrainment but before any buffer layer detrainment, m. + ! after entrainment but before any buffer layer detrainment, H. Hsfc_used, & ! The thickness of the surface region after buffer layer - ! detrainment, in units of m. + ! detrainment, in units of H. Hsfc_min, & ! The minimum thickness of the surface region based on the ! new mixed layer depth and the previous thickness of the - ! neighboring water columns, in m. + ! neighboring water columns, in H. h_sum, & ! The total thickness of the water column, in H. hmbl_prev ! The previous thickness of the mixed and buffer layers, in H. real, dimension(SZI_(G)) :: & @@ -391,16 +391,14 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & real :: H_nbr ! A minimum thickness based on neighboring thicknesses, in H. real :: absf_x_H ! The absolute value of f times the mixed layer thickness, - ! in units of m s-1. - real :: kU_star ! Ustar times the Von Karmen constant, in m s-1. + ! in units of Z s-1. + real :: kU_star ! Ustar times the Von Karmen constant, in Z s-1. real :: dt__diag ! A copy of dt_diag (if present) or dt, in s. logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. integer :: i, j, k, is, ie, js, je, nz, nkmb, n integer :: nsw ! The number of bands of penetrating shortwave radiation. - real :: H_limit_fluxes ! CS%H_limit fluxes converted to units of H. - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not. associated(CS)) call MOM_error(FATAL, "MOM_mixed_layer: "//& @@ -422,19 +420,17 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & Idt = 1.0 / dt Idt_diag = 1.0 / dt__diag write_diags = .true. ; if (present(last_call)) write_diags = last_call - H_limit_fluxes = CS%H_limit_fluxes * GV%m_to_H p_ref(:) = 0.0 ; p_ref_cv(:) = tv%P_Ref nsw = CS%nsw if (CS%limit_det .or. (CS%id_Hsfc_min > 0)) then -!$OMP parallel default(none) shared(is,ie,js,je,nkmb,h_sum,hmbl_prev,h_3d,nz) -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 h_sum(i,j) = 0.0 ; hmbl_prev(i,j) = 0.0 enddo ; enddo -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 do k=1,nkmb ; do i=is-1,ie+1 h_sum(i,j) = h_sum(i,j) + h_3d(i,j,k) @@ -444,7 +440,6 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & h_sum(i,j) = h_sum(i,j) + h_3d(i,j,k) enddo ; enddo enddo -!$OMP end parallel call cpu_clock_begin(id_clock_pass) call create_group_pass(CS%pass_h_sum_hmbl_prev, h_sum,G%Domain) @@ -459,9 +454,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & reset_diags = .false. ! This is the second call to mixedlayer. if (reset_diags) then -!$OMP parallel default(none) shared(is,ie,js,je,CS) if (CS%TKE_diagnostics) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie CS%diag_TKE_wind(i,j) = 0.0 ; CS%diag_TKE_RiBulk(i,j) = 0.0 CS%diag_TKE_conv(i,j) = 0.0 ; CS%diag_TKE_pen_SW(i,j) = 0.0 @@ -470,18 +464,17 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & enddo ; enddo endif if (allocated(CS%diag_PE_detrain)) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie CS%diag_PE_detrain(i,j) = 0.0 enddo ; enddo endif if (allocated(CS%diag_PE_detrain2)) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie CS%diag_PE_detrain2(i,j) = 0.0 enddo ; enddo endif -!$OMP end parallel endif if (CS%ML_resort) then @@ -567,7 +560,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & ! rivermix_depth = The prescribed depth over which to mix river inflow ! drho_ds = The gradient of density wrt salt at the ambient surface salinity. ! Sriver = 0 (i.e. rivers are assumed to be pure freshwater) - RmixConst = 0.5*CS%rivermix_depth*GV%g_Earth*Irho0**2 + RmixConst = 0.5*CS%rivermix_depth * GV%g_Earth * Irho0**2 do i=is,ie TKE_river(i) = max(0.0, RmixConst*dR0_dS(i)* & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * S(i,1)) @@ -587,7 +580,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & ! net_salt = salt ( g(salt)/m2 for non-Bouss and ppt*m/s for Bouss ) via surface fluxes ! Pen_SW_bnd = components to penetrative shortwave radiation call extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & - H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & + CS%H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & h(:,1:), T(:,1:), netMassInOut, netMassOut, Net_heat, Net_salt, Pen_SW_bnd,& tv, aggregate_FW_forcing) @@ -621,7 +614,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & cMKE, Idt_diag, nsw, Pen_SW_bnd, opacity_band, TKE, & Idecay_len_TKE, j, ksort, G, GV, CS) - call absorbRemainingSW(G, GV, h(:,1:), opacity_band, nsw, j, dt, H_limit_fluxes, & + call absorbRemainingSW(G, GV, h(:,1:), opacity_band, nsw, j, dt, CS%H_limit_fluxes, & CS%correct_absorption, CS%absorb_all_SW, & T(:,1:), Pen_SW_bnd, eps, ksort, htot, Ttot) @@ -641,10 +634,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & h(i,0) = htot(i) endif ; enddo if (write_diags .and. allocated(CS%ML_depth)) then ; do i=is,ie - CS%ML_depth(i,j) = h(i,0) * GV%H_to_m + CS%ML_depth(i,j) = h(i,0) * GV%H_to_m ! Rescale the diagnostic. enddo ; endif if (associated(Hml)) then ; do i=is,ie - Hml(i,j) = G%mask2dT(i,j) * (h(i,0) * GV%H_to_m) + Hml(i,j) = G%mask2dT(i,j) * (h(i,0) * GV%H_to_m) ! Rescale the diagnostic for output. enddo ; endif ! At this point, return water to the original layers, but constrained to @@ -678,14 +671,14 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & hmbl_prev(i,j-1) - dHD*min(h_sum(i,j),h_sum(i,j-1)), & hmbl_prev(i,j+1) - dHD*min(h_sum(i,j),h_sum(i,j+1))) ) - Hsfc_min(i,j) = GV%H_to_m*max(h(i,0), min(Hsfc(i), H_nbr)) + Hsfc_min(i,j) = max(h(i,0), min(Hsfc(i), H_nbr)) if (CS%limit_det) max_BL_det(i) = max(0.0, Hsfc(i)-H_nbr) enddo endif if (CS%id_Hsfc_max > 0) then ; do i=is,ie - Hsfc_max(i,j) = Hsfc(i)*GV%H_to_m + Hsfc_max(i,j) = Hsfc(i) enddo ; endif endif @@ -709,9 +702,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & if (CS%id_Hsfc_used > 0) then - do i=is,ie ; Hsfc_used(i,j) = h(i,0)*GV%H_to_m ; enddo + do i=is,ie ; Hsfc_used(i,j) = h(i,0) ; enddo do k=CS%nkml+1,nkmb ; do i=is,ie - Hsfc_used(i,j) = Hsfc_used(i,j) + h(i,k)*GV%H_to_m + Hsfc_used(i,j) = Hsfc_used(i,j) + h(i,k) enddo ; enddo endif @@ -726,20 +719,20 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & ! as the third piece will then optimally describe mixed layer ! restratification. For nkml>=4 the whole strategy should be revisited. do i=is,ie - kU_Star = 0.41*fluxes%ustar(i,j) ! Maybe could be replaced with u*+w*? + kU_Star = 0.41*GV%m_to_Z*fluxes%ustar(i,j) ! Maybe could be replaced with u*+w*? if (associated(fluxes%ustar_shelf) .and. & associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & kU_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * kU_star + & - fluxes%frac_shelf_h(i,j) * (0.41*fluxes%ustar_shelf(i,j)) + fluxes%frac_shelf_h(i,j) * (0.41*GV%m_to_Z*fluxes%ustar_shelf(i,j)) endif - absf_x_H = 0.25 * h(i,0) * & + absf_x_H = 0.25 * GV%m_to_Z * h(i,0) * & !### I think this should be H_to_Z -RWH ((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) ! If the mixed layer vertical viscosity specification is changed in ! MOM_vert_friction.F90, this line will have to be modified accordingly. h_3d(i,j,1) = h(i,0) / (3.0 + sqrt(absf_x_H*(absf_x_H + 2.0*kU_star) / & - (kU_star**2)) ) + (kU_star**2)) ) do k=2,CS%nkml ! The other layers are evenly distributed through the mixed layer. h_3d(i,j,k) = (h(i,0)-h_3d(i,j,1)) * Inkmlm1 @@ -805,18 +798,17 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & do i=is,ie h_miss(i,j) = h_miss(i,j) + abs(h_3d(i,j,nz) - (h_orig(i,nz) + & ((eaml(i,nz) - ebml(i,nz-1)) + ebml(i,nz)))) - h_miss(i,j) = GV%H_to_m * h_miss(i,j) enddo endif enddo ! j loop + !$OMP end parallel ! Whenever thickness changes let the diag manager know, target grids ! for vertical remapping may need to be regenerated. ! This needs to happen after the H update and before the next post_data. call diag_update_remap_grids(CS%diag) -!$OMP end parallel if (write_diags) then if (CS%id_ML_depth > 0) & @@ -860,9 +852,8 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & dKE_CA, cTKE, j, G, GV, CS, nz_conv) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness, in m or kg m-2. - !! (Intent in/out) The units of h are - !! referred to as H below. + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness, in H (often m or kg m-2). + !! The units of h are referred to as H below. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocities interpolated to h !! points, m s-1. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: v !< Zonal velocities interpolated to h @@ -881,10 +872,10 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & !! that will be left in each layer, in H. real, dimension(SZI_(G),SZK_(GV)), intent(out) :: dKE_CA !< The vertically integrated change in !! kinetic energy due to convective - !! adjustment, in m3 s-2. + !! adjustment, in Z m2 s-2. real, dimension(SZI_(G),SZK_(GV)), intent(out) :: cTKE !< The buoyant turbulent kinetic energy !! source due to convective adjustment, - !! in m3 s-2. + !! in Z m2 s-2. integer, intent(in) :: j !< The j-index to work on. type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. integer, optional, intent(in) :: nz_conv !< If present, the number of layers @@ -895,27 +886,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & ! layers and mixed layers to remove hydrostatic instabilities. Any water that ! is lighter than currently in the mixed- or buffer- layer is entrained. -! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out) The units -! of h are referred to as H below. -! (in/out) u - Zonal velocities interpolated to h points, m s-1. -! (in/out) v - Zonal velocities interpolated to h points, m s-1. -! (in/out) R0 - Potential density referenced to surface pressure, in kg m-3. -! (in/out) Rcv - The coordinate defining potential density, in kg m-3. -! (in/out) T - Layer temperatures, in deg C. -! (in/out) S - Layer salinities, in psu. -! (in/out) d_eb - The downward increase across a layer in the entrainment from -! below, in H. Positive values go with mass gain by a layer. -! (out) dKE_CA - The vertically integrated change in kinetic energy due -! to convective adjustment, in m3 s-2. -! (out) cTKE - The buoyant turbulent kinetic energy source due to -! convective adjustment, in m3 s-2. -! (in) j - The j-index to work on. -! (in) ksort - The density-sorted k-indicies. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure for this module. -! (in,opt) nz_conv - If present, the number of layers over which to do -! convective adjustment (perhaps CS%nkml). + ! Local variables real, dimension(SZI_(G)) :: & htot, & ! The total depth of the layers being considered for ! entrainment, in H. @@ -934,13 +905,13 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & h_orig_k1 ! The depth of layer k1 before convective adjustment, in H. real :: h_ent ! The thickness from a layer that is entrained, in H. real :: Ih ! The inverse of a thickness, in H-1. - real :: g_H2_2Rho0 ! Half the gravitational acceleration times the - ! square of the conversion from H to m divided - ! by the mean density, in m6 s-2 H-2 kg-1. + real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of + ! the conversion from H to Z divided by the mean density, + ! in m7 s-2 Z-1 H-2 kg-1. !### CHECK UNITS integer :: is, ie, nz, i, k, k1, nzc, nkmb is = G%isc ; ie = G%iec ; nz = GV%ke - g_H2_2Rho0 = (GV%g_Earth * GV%H_to_m**2) / (2.0 * GV%Rho0) + g_H2_2Rho0 = (GV%g_Earth * GV%Z_to_m * GV%H_to_Z**2) / (2.0 * GV%Rho0) nzc = nz ; if (present(nz_conv)) nzc = nz_conv nkmb = CS%nkml+CS%nkbl @@ -962,8 +933,8 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & do i=is,ie if ((h(i,k) > eps(i,k)) .and. (R0_tot(i) > h(i,k1)*R0(i,k))) then h_ent = h(i,k)-eps(i,k) - cTKE(i,k1) = cTKE(i,k1) + (h_ent * g_H2_2Rho0 * & - (R0_tot(i) - h(i,k1)*R0(i,k)) * CS%nstar2) + cTKE(i,k1) = cTKE(i,k1) + h_ent * g_H2_2Rho0 * & + (R0_tot(i) - h(i,k1)*R0(i,k)) * CS%nstar2 if (k < nkmb) then cTKE(i,k1) = cTKE(i,k1) + cTKE(i,k) dKE_CA(i,k1) = dKE_CA(i,k1) + dKE_CA(i,k) @@ -990,7 +961,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & Ih = 1.0 / h(i,k1) R0(i,k1) = R0_tot(i) * Ih u(i,k1) = uhtot(i) * Ih ; v(i,k1) = vhtot(i) * Ih - dKE_CA(i,k1) = dKE_CA(i,k1) + GV%H_to_m * (CS%bulk_Ri_convective * & + dKE_CA(i,k1) = dKE_CA(i,k1) + GV%H_to_Z * (CS%bulk_Ri_convective * & (KE_orig(i) - 0.5*h(i,k1)*(u(i,k1)**2 + v(i,k1)**2))) Rcv(i,k1) = Rcv_tot(i) * Ih T(i,k1) = Ttot(i) * Ih ; S(i,k1) = Stot(i) * Ih @@ -1018,7 +989,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK_(GV)), & - intent(inout) :: h !< Layer thickness, in m or kg m-2. + intent(inout) :: h !< Layer thickness, in H (often m or kg m-2). !! The units of h are referred to as H below. real, dimension(SZI_(G),SZK_(GV)), & intent(inout) :: d_eb !< The downward increase across a layer in the @@ -1081,12 +1052,10 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(:,:,:), intent(in) :: opacity_band !< The opacity in each band of penetrating !! shortwave radiation, in H-1. !! The indicies of opacity_band are band, i, k. - real, dimension(SZI_(G)), intent(out) :: Conv_en !< The buoyant turbulent kinetic - !! energy source due to free - !! convection, in m3 s-2. - real, dimension(SZI_(G)), intent(out) :: dKE_FC !< The vertically integrated change - !! in kinetic energy due to free - !! convection, in m3 s-2. + real, dimension(SZI_(G)), intent(out) :: Conv_en !< The buoyant turbulent kinetic energy source + !! due to free convection, in Z m2 s-2. + real, dimension(SZI_(G)), intent(out) :: dKE_FC !< The vertically integrated change in kinetic + !! energy due to free convection, in Z m2 s-2. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & intent(in) :: ksort !< The density-sorted k-indices. @@ -1107,32 +1076,8 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! This subroutine causes the mixed layer to entrain to the depth of free ! convection. The depth of free convection is the shallowest depth at which the ! fluid is denser than the average of the fluid above. -! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out) The units -! of h are referred to as H below. -! (in/out) d_eb - The downward increase across a layer in the entrainment from -! below, in H. Positive values go with mass gain by a layer. -! (out) htot - The accumulated mixed layer thickness, in H. -! (out) Ttot - The depth integrated mixed layer temperature, in deg C H. -! (out) Stot - The depth integrated mixed layer salinity, in psu H. -! (out) uhtot - The depth integrated mixed layer zonal velocity, H m s-1. -! (out) vhtot - The integrated mixed layer meridional velocity, H m s-1. -! (out) R0_tot - The integrated mixed layer potential density referenced -! to 0 pressure, in kg m-2. -! (out) Rcv_tot - The integrated mixed layer coordinate variable -! potential density, in kg m-2. -! (in) nsw - The number of bands of penetrating shortwave radiation. -! (out) Pen_SW_bnd - The penetrating shortwave heating at the sea surface -! in each penetrating band, in K H, size nsw x SZI_(G). -! (out) Conv_en - The buoyant turbulent kinetic energy source due to -! free convection, in m3 s-2. -! (out) dKE_FC - The vertically integrated change in kinetic energy due -! to free convection, in m3 s-2. -! (in) j - The j-index to work on. -! (in) ksort - The density-sorted k-indices. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure for this module. + ! Local variables real, dimension(SZI_(G)) :: & massOutRem, & ! Evaporation that remains to be supplied, in H. netMassIn ! mass entering through ocean surface (H) @@ -1154,9 +1099,9 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: h_evap ! The thickness that is evaporated, in H. real :: dh_Newt ! The Newton's method estimate of the change in ! h_ent between iterations, in H. - real :: g_H2_2Rho0 ! Half the gravitational acceleration times the - ! square of the conversion from H to m divided - ! by the mean density, in m6 s-2 H-2 kg-1. + real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of + ! the conversion from H to Z divided by the mean density, + ! in m7 s-2 Z-1 H-2 kg-1. !### CHECK UNITS real :: Angstrom ! The minimum layer thickness, in H. real :: opacity ! The opacity converted to units of H-1. real :: sum_Pen_En ! The potential energy change due to penetrating @@ -1171,7 +1116,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & Angstrom = GV%Angstrom_H C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 - g_H2_2Rho0 = (GV%g_Earth * GV%H_to_m**2) / (2.0 * GV%Rho0) + g_H2_2Rho0 = (GV%g_Earth * GV%Z_to_m * GV%H_to_Z**2) / (2.0 * GV%Rho0) Idt = 1.0/dt is = G%isc ; ie = G%iec ; nz = GV%ke @@ -1388,7 +1333,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & if (h_ent > 0.0) then if (htot(i) > 0.0) & dKE_FC(i) = dKE_FC(i) + CS%bulk_Ri_convective * 0.5 * & - ((GV%H_to_m*h_ent) / (htot(i)*(h_ent+htot(i)))) * & + ((GV%H_to_Z*h_ent) / (htot(i)*(h_ent+htot(i)))) * & ((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2) htot(i) = htot(i) + h_ent @@ -1411,34 +1356,33 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, j, ksort, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G)), intent(in) :: htot !< The accumlated mixed layer thickness, in m - !! or kg m-2. (Intent in). + real, dimension(SZI_(G)), intent(in) :: htot !< The accumlated mixed layer thickness, in H + !! (often m or kg m-2). real, dimension(SZI_(G)), intent(in) :: h_CA !< The mixed layer depth after convective !! adjustment, in H. type(forcing), intent(in) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields !! have NULL ptrs. - real, dimension(SZI_(G)), intent(inout) :: Conv_En !< The buoyant turbulent kinetic energy - !! source due to free convection, - !! in m3 s-2. + real, dimension(SZI_(G)), intent(inout) :: Conv_En !< The buoyant turbulent kinetic energy source + !! due to free convection, in Z m2 s-2. real, dimension(SZI_(G)), intent(in) :: dKE_FC !< The vertically integrated change in !! kinetic energy due to free convection, - !! in m3 s-2. + !! in Z m2 s-2. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: cTKE !< The buoyant turbulent kinetic energy !! source due to convective adjustment, - !! in m3 s-2. + !! in Z m2 s-2. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: dKE_CA !< The vertically integrated change in !! kinetic energy due to convective - !! adjustment, in m3 s-2. + !! adjustment, in Z m2 s-2. real, dimension(SZI_(G)), intent(out) :: TKE !< The turbulent kinetic energy available for - !! mixing over a time step, in m3 s-2. + !! mixing over a time step, in Z m2 s-2. real, dimension(SZI_(G)), intent(out) :: Idecay_len_TKE !< The inverse of the vertical decay !! scale for TKE, in H-1. real, dimension(SZI_(G)), intent(in) :: TKE_river !< The turbulent kinetic energy available !! for driving mixing at river mouths - !! integrated over a time step, in m3 s-2. + !! integrated over a time step, in Z m2 s-2. real, dimension(2,SZI_(G)), intent(out) :: cMKE !< Coefficients of HpE and HpE^2 in !! calculating the denominator of MKE_rate, !! in H-1 and H-2. @@ -1453,48 +1397,23 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, ! This subroutine determines the TKE available at the depth of free ! convection to drive mechanical entrainment. -! Arguments: htot - The accumlated mixed layer thickness, in m or kg m-2. (Intent in) -! The units of htot are referred to as H below. -! (in) h_CA - The mixed layer depth after convective adjustment, in H. -! (in) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) Conv_en - The buoyant turbulent kinetic energy source due to -! free convection, in m3 s-2. -! (in) cTKE - The buoyant turbulent kinetic energy source due to -! convective adjustment, in m3 s-2. -! (in) dKE_FC - The vertically integrated change in kinetic energy due -! to free convection, in m3 s-2. -! (in) dKE_CA - The vertically integrated change in kinetic energy due -! to convective adjustment, in m3 s-2. -! (out) TKE - The turbulent kinetic energy available for mixing over a -! time step, in m3 s-2. -! (out) Idecay_len_TKE - The inverse of the vertical decay scale for -! TKE, in H-1. -! (out) cMKE - Coefficients of HpE and HpE^2 in calculating the -! denominator of MKE_rate, in H-1 and H-2. -! (in) dt - The time step in s. -! (in) j - The j-index to work on. -! (in) ksort - The density-sorted k-indicies. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure for this module. - real :: dKE_conv ! The change in mean kinetic energy due - ! to all convection, in m3 s-2. + ! Local variables + real :: dKE_conv ! The change in mean kinetic energy due to all convection, in Z m2 s-2. real :: nstar_FC ! The effective efficiency with which the energy released by ! free convection is converted to TKE, often ~0.2, ND. real :: nstar_CA ! The effective efficiency with which the energy released by ! convective adjustment is converted to TKE, often ~0.2, ND. real :: TKE_CA ! The potential energy released by convective adjustment if - ! that release is positive, in m3 s2. + ! that release is positive, in Z m2 s2. real :: MKE_rate_CA ! MKE_rate for convective adjustment, ND, 0 to 1. real :: MKE_rate_FC ! MKE_rate for free convection, ND, 0 to 1. - real :: totEn ! The total potential energy released by convection, m3 s-2. + real :: totEn_Z ! The total potential energy released by convection, Z3 s-2. real :: Ih ! The inverse of a thickness, in H-1. real :: exp_kh ! The nondimensional decay of TKE across a layer, ND. real :: absf ! The absolute value of f averaged to thickness points, s-1. - real :: U_star ! The friction velocity in m s-1. - real :: absf_Ustar ! The absolute value of f divided by U_star, in m-1. - real :: wind_TKE_src ! The surface wind source of TKE, in m3 s-3. + real :: U_star ! The friction velocity in Z s-1. + real :: absf_Ustar ! The absolute value of f divided by U_star, in Z-1. + real :: wind_TKE_src ! The surface wind source of TKE, in Z m2 s-3. real :: diag_wt ! The ratio of the current timestep to the diagnostic ! timestep (which may include 2 calls), ND. integer :: is, ie, nz, i @@ -1504,11 +1423,11 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (CS%omega_frac >= 1.0) absf = 2.0*CS%omega do i=is,ie - U_Star = fluxes%ustar(i,j) + U_Star = GV%m_to_Z * fluxes%ustar(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & U_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & - fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) + fluxes%frac_shelf_h(i,j) * GV%m_to_Z * fluxes%ustar_shelf(i,j) endif if (U_Star < CS%ustar_min) U_Star = CS%ustar_min @@ -1519,7 +1438,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif absf_Ustar = absf / U_Star - Idecay_len_TKE(i) = (absf_Ustar * CS%TKE_decay) * GV%H_to_m + Idecay_len_TKE(i) = (absf_Ustar * CS%TKE_decay) * GV%H_to_Z ! The first number in the denominator could be anywhere up to 16. The ! value of 3 was chosen to minimize the time-step dependence of the amount @@ -1531,8 +1450,8 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, ! scales contribute to mixed layer deepening at similar rates, even though ! small scales are dissipated more rapidly (implying they are less efficient). ! Ih = 1.0/(16.0*0.41*U_star*dt) - Ih = GV%H_to_m/(3.0*0.41*U_star*dt) - cMKE(1,i) = 4.0 * Ih ; cMKE(2,i) = (absf_Ustar*GV%H_to_m) * Ih + Ih = GV%H_to_Z/(3.0*0.41*U_star*dt) + cMKE(1,i) = 4.0 * Ih ; cMKE(2,i) = (absf_Ustar*GV%H_to_Z) * Ih if (Idecay_len_TKE(i) > 0.0) then exp_kh = exp(-htot(i)*Idecay_len_TKE(i)) @@ -1546,11 +1465,11 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (Conv_En(i) < 0.0) Conv_En(i) = 0.0 if (cTKE(i,1) > 0.0) then ; TKE_CA = cTKE(i,1) ; else ; TKE_CA = 0.0 ; endif if ((htot(i) >= h_CA(i)) .or. (TKE_CA == 0.0)) then - totEn = Conv_En(i) + TKE_CA + totEn_Z = GV%m_to_Z**2 * (Conv_En(i) + TKE_CA) - if (totEn > 0.0) then - nstar_FC = CS%nstar * totEn / (totEn + 0.2 * & - sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_m))**3 * totEn)) + if (totEn_Z > 0.0) then + nstar_FC = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & + sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_FC = CS%nstar endif @@ -1558,17 +1477,17 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, else ! This reconstructs the Buoyancy flux within the topmost htot of water. if (Conv_En(i) > 0.0) then - totEn = Conv_En(i) + TKE_CA * (htot(i) / h_CA(i)) - nstar_FC = CS%nstar * totEn / (totEn + 0.2 * & - sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_m))**3 * totEn)) + totEn_Z = GV%m_to_Z**2 * (Conv_En(i) + TKE_CA * (htot(i) / h_CA(i)) ) + nstar_FC = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & + sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_FC = CS%nstar endif - totEn = Conv_En(i) + TKE_CA + totEn_Z = GV%m_to_Z**2 * (Conv_En(i) + TKE_CA) if (TKE_CA > 0.0) then - nstar_CA = CS%nstar * totEn / (totEn + 0.2 * & - sqrt(0.5 * dt * (absf*(h_CA(i)*GV%H_to_m))**3 * totEn)) + nstar_CA = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & + sqrt(0.5 * dt * (absf*(h_CA(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_CA = CS%nstar endif @@ -1590,27 +1509,26 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, dKE_conv = dKE_CA(i,1) * MKE_rate_CA + dKE_FC(i) * MKE_rate_FC ! At this point, it is assumed that cTKE is positive and stored in TKE_CA! ! Note: Removed factor of 2 in u*^3 terms. - TKE(i) = (dt*CS%mstar)*((U_Star*U_Star*U_Star)*exp_kh) + & - (exp_kh * dKE_conv + nstar_FC*Conv_En(i) + nstar_CA*TKE_CA) -! Add additional TKE at river mouths + TKE(i) = (dt*CS%mstar)*((GV%Z_to_m**2*(U_Star*U_Star*U_Star))*exp_kh) + & + (exp_kh * dKE_conv + nstar_FC*Conv_En(i) + nstar_CA * TKE_CA) - if (CS%do_rivermix) then + if (CS%do_rivermix) then ! Add additional TKE at river mouths TKE(i) = TKE(i) + TKE_river(i)*dt*exp_kh endif if (CS%TKE_diagnostics) then - wind_TKE_src = CS%mstar*(U_Star*U_Star*U_Star) * diag_wt + wind_TKE_src = CS%mstar*(GV%Z_to_m**2*U_Star*U_Star*U_Star) * diag_wt CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + & - wind_TKE_src + TKE_river(i) * diag_wt + ( wind_TKE_src + TKE_river(i) * diag_wt ) CS%diag_TKE_RiBulk(i,j) = CS%diag_TKE_RiBulk(i,j) + dKE_conv*Idt_diag CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + & (exp_kh-1.0)*(wind_TKE_src + dKE_conv*Idt_diag) CS%diag_TKE_conv(i,j) = CS%diag_TKE_conv(i,j) + & - Idt_diag*(nstar_FC*Conv_En(i) + nstar_CA*TKE_CA) + Idt_diag * (nstar_FC*Conv_En(i) + nstar_CA*TKE_CA) CS%diag_TKE_conv_decay(i,j) = CS%diag_TKE_conv_decay(i,j) + & - Idt_diag*((CS%nstar-nstar_FC)*Conv_En(i) + (CS%nstar-nstar_CA)*TKE_CA) + Idt_diag * ((CS%nstar-nstar_FC)*Conv_En(i) + (CS%nstar-nstar_CA)*TKE_CA) CS%diag_TKE_conv_s2(i,j) = CS%diag_TKE_conv_s2(i,j) + & - Idt_diag*(cTKE(i,1)-TKE_CA) + Idt_diag * (cTKE(i,1)-TKE_CA) endif enddo @@ -1680,7 +1598,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! The indicies of opacity_band are band, i, k. real, dimension(SZI_(G)), intent(inout) :: TKE !< The turbulent kinetic energy !! available for mixing over a time - !! step, in m3 s-2. + !! step, in Z m2 s-2. real, dimension(SZI_(G)), intent(inout) :: Idecay_len_TKE !< The vertical TKE decay rate, in H-1. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & @@ -1688,30 +1606,8 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. ! This subroutine calculates mechanically driven entrainment. -! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out) The units -! of h are referred to as H below. -! (in/out) d_eb - The downward increase across a layer in the entrainment from -! below, in H. Positive values go with mass gain by a layer. -! (in/out) htot - The accumlated mixed layer thickness, in H. -! (in/out) Ttot - The depth integrated mixed layer temperature, in deg C H. -! (in/out) Stot - The depth integrated mixed layer salinity, in psu H. -! (in/out) uhtot - The depth integrated mixed layer zonal velocity, H m s-1. -! (in/out) vhtot - The integrated mixed layer meridional velocity, H m s-1. -! (in/out) R0_tot - The integrated mixed layer potential density referenced -! to 0 pressure, in H kg m-3. -! (in/out) Rcv_tot - The integrated mixed layer coordinate variable -! potential density, in H kg m-3. -! (in) nsw - The number of bands of penetrating shortwave radiation. -! (in/out) Pen_SW_bnd - The penetrating shortwave heating at the sea surface -! in each penetrating band, in K H, size nsw x SZI_(G). -! (in/out) TKE - The turbulent kinetic energy available for mixing over a -! time step, in m3 s-2. -! (in) j - The j-index to work on. -! (in) ksort - The density-sorted k-indicies. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure for this module. + ! Local variables real :: SW_trans ! The fraction of shortwave radiation that is not ! absorbed in a layer, nondimensional. real :: Pen_absorbed ! The amount of penetrative shortwave radiation @@ -1729,18 +1625,18 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! conversion from H to m divided by the mean density, ! in m5 s-2 H-1 kg-1. real :: TKE_full_ent ! The TKE remaining if a layer is fully entrained, - ! in units of m3 s-2. + ! in units of Z m2 s-2. real :: dRL ! Work required to mix water from the next layer ! across the mixed layer, in m2 s-2. real :: Pen_En_Contrib ! Penetrating SW contributions to the changes in ! TKE, divided by layer thickness in m, in m2 s-2. real :: C1 ! A temporary variable in units of m2 s-2. real :: dMKE ! A temporary variable related to the release of mean - ! kinetic energy, with units of H m3 s-2. - real :: TKE_ent ! The TKE that remains if h_ent were entrained, in m3 s-2. + ! kinetic energy, with units of H Z m2 s-2. + real :: TKE_ent ! The TKE that remains if h_ent were entrained, in Z m2 s-2. real :: TKE_ent1 ! The TKE that would remain, without considering the - ! release of mean kinetic energy, in m3 s2. - real :: dTKE_dh ! The partial derivative of TKE with h_ent, in m3 s-2 H-1. + ! release of mean kinetic energy, in Z m2 s2. + real :: dTKE_dh ! The partial derivative of TKE with h_ent, in Z m2 s-2 H-1. real :: Pen_dTKE_dh_Contrib ! The penetrating shortwave contribution to ! dTKE_dh, in m2 s-2. real :: EF4_val ! The result of EF4() (see later), in H-1. @@ -1748,7 +1644,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! in roundoff and can be neglected, in H. real :: dEF4_dh ! The partial derivative of EF4 with h, in H-2. real :: Pen_En1 ! A nondimensional temporary variable. - real :: kh, exp_kh ! Nondimensional temporary variables related to the. + real :: kh, exp_kh ! Nondimensional temporary variables related to the real :: f1_kh ! fractional decay of TKE across a layer. real :: x1, e_x1 ! Nondimensional temporary variables related to real :: f1_x1, f2_x1 ! the relative decay of TKE and SW radiation across @@ -1756,15 +1652,13 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: E_HxHpE ! Entrainment divided by the product of the new and old ! thicknesses, in H-1. real :: Hmix_min ! The minimum mixed layer depth in H. - real :: H_to_m ! Local copies of unit conversion factors. real :: opacity real :: C1_3, C1_6, C1_24 ! 1/3, 1/6, and 1/24. integer :: is, ie, nz, i, k, ks, itt, n C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 ; C1_24 = 1.0/24.0 - H_to_m = GV%H_to_m - g_H_2Rho0 = (GV%g_Earth * H_to_m) / (2.0 * GV%Rho0) - Hmix_min = CS%Hmix_min * GV%m_to_H + g_H_2Rho0 = (GV%g_Earth * GV%Z_to_m * GV%H_to_Z) / (2.0 * GV%Rho0) + Hmix_min = CS%Hmix_min h_neglect = GV%H_subroundoff is = G%isc ; ie = G%iec ; nz = GV%ke @@ -1776,7 +1670,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & h_avail = h(i,k) - eps(i,k) if ((h_avail > 0.) .and. ((TKE(i) > 0.) .or. (htot(i) < Hmix_min))) then dRL = g_H_2Rho0 * (R0(i,k)*htot(i) - R0_tot(i) ) - dMKE = (H_to_m * CS%bulk_Ri_ML) * 0.5 * & + dMKE = (GV%H_to_Z * CS%bulk_Ri_ML) * 0.5 * & ((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2) ! Find the TKE that would remain if the entire layer were entrained. @@ -1822,7 +1716,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & HpE = htot(i)+h_avail MKE_rate = 1.0/(1.0 + (cMKE(1,i)*HpE + cMKE(2,i)*HpE**2)) EF4_val = EF4(htot(i)+h_neglect,h_avail,Idecay_len_TKE(i)) - TKE_full_ent = (exp_kh*TKE(i) - (h_avail*H_to_m)*(dRL*f1_kh + Pen_En_Contrib)) + & + TKE_full_ent = (exp_kh*TKE(i) - (h_avail*GV%H_to_Z)*(dRL*f1_kh + Pen_En_Contrib)) + & MKE_rate*dMKE*EF4_val if ((TKE_full_ent >= 0.0) .or. (h_avail+htot(i) <= Hmix_min)) then ! The layer will be fully entrained. @@ -1832,18 +1726,18 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & E_HxHpE = h_ent / ((htot(i)+h_neglect)*(htot(i)+h_ent+h_neglect)) CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + & Idt_diag * ((exp_kh-1.0)*TKE(i) + & - (h_ent*H_to_m)*dRL*(1.0-f1_kh) + & + (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + & MKE_rate*dMKE*(EF4_val-E_HxHpE)) CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) - & - Idt_diag*(H_to_m*h_ent)*dRL + Idt_diag*(GV%H_to_Z*h_ent)*dRL CS%diag_TKE_pen_SW(i,j) = CS%diag_TKE_pen_SW(i,j) - & - Idt_diag*(H_to_m*h_ent)*Pen_En_Contrib + Idt_diag*(GV%H_to_Z*h_ent)*Pen_En_Contrib CS%diag_TKE_RiBulk(i,j) = CS%diag_TKE_RiBulk(i,j) + & Idt_diag*MKE_rate*dMKE*E_HxHpE endif TKE(i) = TKE_full_ent - if (TKE(i) <= 0.0) TKE(i) = 1.0e-150 + if (TKE(i) <= 0.0) TKE(i) = 1.0e-150*GV%m_to_Z else ! The layer is only partially entrained. The amount that will be ! entrained is determined iteratively. No further layers will be @@ -1902,16 +1796,16 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & C1*((1.0-SW_trans) - opacity*(htot(i) + h_ent)*SW_trans) endif ; enddo ! (Pen_SW_bnd(n,i) > 0.0) - TKE_ent1 = exp_kh*TKE(i) - (h_ent*H_to_m)*(dRL*f1_kh + Pen_En_Contrib) + TKE_ent1 = exp_kh*TKE(i) - (h_ent*GV%H_to_Z)*(dRL*f1_kh + Pen_En_Contrib) EF4_val = EF4(htot(i)+h_neglect,h_ent,Idecay_len_TKE(i),dEF4_dh) HpE = htot(i)+h_ent MKE_rate = 1.0/(1.0 + (cMKE(1,i)*HpE + cMKE(2,i)*HpE**2)) TKE_ent = TKE_ent1 + dMKE*EF4_val*MKE_rate ! TKE_ent is the TKE that would remain if h_ent were entrained. - dTKE_dh = ((-Idecay_len_TKE(i)*TKE_ent1 - dRL*H_to_m) + & - Pen_dTKE_dh_Contrib*H_to_m) + dMKE * MKE_rate* & - (dEF4_dh - EF4_val*MKE_rate*(cMKE(1,i)+2.0*cMKE(2,i)*HpE)) + dTKE_dh = ((-Idecay_len_TKE(i)*TKE_ent1 - dRL*GV%H_to_Z) + & + Pen_dTKE_dh_Contrib*GV%H_to_Z) + dMKE * MKE_rate* & + (dEF4_dh - EF4_val*MKE_rate*(cMKE(1,i)+2.0*cMKE(2,i)*HpE)) ! dh_Newt = -TKE_ent / dTKE_dh ! Bisect if the Newton's method prediction is outside of the bounded range. if (TKE_ent > 0.0) then @@ -1945,12 +1839,12 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & E_HxHpE = h_ent / ((htot(i)+h_neglect)*(HpE+h_neglect)) CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + & Idt_diag * ((exp_kh-1.0)*TKE(i) + & - (h_ent*H_to_m)*dRL*(1.0-f1_kh) + & + (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + & dMKE*MKE_rate*(EF4_val-E_HxHpE)) CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) - & - Idt_diag*(h_ent*H_to_m)*dRL + Idt_diag*(h_ent*GV%H_to_Z)*dRL CS%diag_TKE_pen_SW(i,j) = CS%diag_TKE_pen_SW(i,j) - & - Idt_diag*(h_ent*H_to_m)*Pen_En_Contrib + Idt_diag*(h_ent*GV%H_to_Z)*Pen_En_Contrib CS%diag_TKE_RiBulk(i,j) = CS%diag_TKE_RiBulk(i,j) + & Idt_diag*dMKE*MKE_rate*E_HxHpE endif @@ -2522,7 +2416,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! rho_0*g, in units of H2. real :: dPE_det, dPE_merge ! The energy required to mix the detrained water ! into the buffer layer or the merge the two - ! buffer layers, both in units of J H2 m-4. + ! buffer layers, both in units of J H2 Z m-5. real :: h_from_ml ! The amount of additional water that must be ! drawn from the mixed layer, in H. @@ -2564,11 +2458,11 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! K psu-1 and psu K-1. real :: I_denom ! A work variable with units of psu2 m6 kg-2. - real :: G_2 ! 1/2 G_Earth, in m s-2. - real :: Rho0xG ! Rho0 times G_Earth, in kg m-2 s-2. + real :: G_2 ! 1/2 G_Earth, in m2 Z-1 s-2. + real :: Rho0xG ! Rho0 times G_Earth, in kg m-1 Z-1 s-2. real :: I2Rho0 ! 1 / (2 Rho0), in m3 kg-1. real :: Idt_H2 ! The square of the conversion from thickness - ! to m divided by the time step in m2 H-2 s-1. + ! to Z divided by the time step in Z2 H-2 s-1. logical :: stable_Rcv ! If true, the buffer layers are stable with ! respect to the coordinate potential density. real :: h_neglect ! A thickness that is so small it is usually lost @@ -2593,17 +2487,17 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, kb1 = CS%nkml+1; kb2 = CS%nkml+2 nkmb = CS%nkml+CS%nkbl h_neglect = GV%H_subroundoff - G_2 = 0.5*GV%g_Earth - Rho0xG = GV%Rho0 * GV%g_Earth - Idt_H2 = GV%H_to_m**2 / dt_diag + G_2 = 0.5*GV%g_Earth*GV%Z_to_m + Rho0xG = GV%Rho0 * GV%g_Earth*GV%Z_to_m + Idt_H2 = GV%H_to_Z**2 / dt_diag I2Rho0 = 0.5 / GV%Rho0 Angstrom = GV%Angstrom_H ! This is hard coding of arbitrary and dimensional numbers. - h_min_bl_thick = 5.0 * GV%m_to_H + h_min_bl_thick = 5.0 * GV%m_to_H !### DIMENSIONAL CONSTANT dT_dS_gauge = CS%dT_dS_wt ; dS_dT_gauge = 1.0 /dT_dS_gauge num_events = 10.0 - detrainment_timescale = 4.0*3600.0 + detrainment_timescale = 4.0*3600.0 !### DIMENSIONAL CONSTANT if (CS%nkbl /= 2) call MOM_error(FATAL, "MOM_mixed_layer"// & "CS%nkbl must be 2 in mixedlayer_detrain_2.") @@ -3242,7 +3136,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, if (allocated(CS%diag_PE_detrain)) & CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + Idt_H2*dPE_merge if (allocated(CS%diag_PE_detrain2)) CS%diag_PE_detrain2(i,j) = & - CS%diag_PE_detrain2(i,j) + Idt_H2*(dPE_det+Rho0xG*dPE_extrap) + CS%diag_PE_detrain2(i,j) + Idt_H2*(dPE_det + Rho0xG*dPE_extrap) else ! Not mergeable_bl. ! There is no further detrainment from the buffer layers, and the ! upper buffer layer water is distributed optimally between the @@ -3318,7 +3212,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, if (allocated(CS%diag_PE_detrain)) & CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + Idt_H2*dPE_det if (allocated(CS%diag_PE_detrain2)) CS%diag_PE_detrain2(i,j) = & - CS%diag_PE_detrain2(i,j) + Idt_H2*(dPE_det+Rho0xG*dPE_extrap) + CS%diag_PE_detrain2(i,j) + Idt_H2*(dPE_det + Rho0xG*dPE_extrap) endif endif ! End of detrainment... @@ -3409,12 +3303,12 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e real :: I_denom ! A work variable with units of psu2 m6 kg-2. real :: Sdown, Tdown real :: dt_Time, Timescale = 86400.0*30.0! *365.0/12.0 - real :: g_H2_2Rho0dt ! Half the gravitational acceleration times the - ! square of the conversion from H to m divided - ! by the mean density times the time step, in m6 s-3 H-2 kg-1. + real :: g_H2_2Rho0dt ! Half the gravitational acceleration times the square of + ! the conversion from H to m divided by the mean + ! density times the time step, in m7 s-3 Z-1 H-2 kg-1. !### CHECK UNITS real :: g_H2_2dt ! Half the gravitational acceleration times the ! square of the conversion from H to m divided - ! by the diagnostic time step, in m3 H-2 s-3. + ! by the diagnostic time step, in m4 Z-1 H-2 s-3. logical :: splittable_BL(SZI_(G)), orthogonal_extrap real :: x1 @@ -3426,17 +3320,16 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e "CS%nkbl must be 1 in mixedlayer_detrain_1.") Idt = 1.0/dt dt_Time = dt/Timescale - g_H2_2Rho0dt = (GV%g_Earth * GV%H_to_m**2) / (2.0 * GV%Rho0 * dt_diag) - g_H2_2dt = (GV%g_Earth * GV%H_to_m**2) / (2.0 * dt_diag) + g_H2_2Rho0dt = (GV%g_Earth*GV%Z_to_m * GV%H_to_Z**2) / (2.0 * GV%Rho0 * dt_diag) + g_H2_2dt = (GV%g_Earth*GV%Z_to_m * GV%H_to_Z**2) / (2.0 * dt_diag) ! Move detrained water into the buffer layer. do k=1,CS%nkml do i=is,ie ; if (h(i,k) > 0.0) then Ih = 1.0 / (h(i,nkmb) + h(i,k)) if (CS%TKE_diagnostics) & - CS%diag_TKE_conv_s2(i,j) = CS%diag_TKE_conv_s2(i,j) + & - g_H2_2Rho0dt * h(i,k) * h(i,nkmb) * & - (R0(i,nkmb) - R0(i,k)) + CS%diag_TKE_conv_s2(i,j) = CS%diag_TKE_conv_s2(i,j) + & + g_H2_2Rho0dt * h(i,k) * h(i,nkmb) * (R0(i,nkmb) - R0(i,k)) if (allocated(CS%diag_PE_detrain)) & CS%diag_PE_detrain(i,j) = CS%diag_PE_detrain(i,j) + & g_H2_2dt * h(i,k) * h(i,nkmb) * (R0(i,nkmb) - R0(i,k)) @@ -3667,7 +3560,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_mixed_layer" ! This module's name. - real :: omega_frac_dflt, ustar_min_dflt + real :: omega_frac_dflt, ustar_min_dflt, Hmix_min_m integer :: isd, ied, jsd, jed logical :: use_temperature, use_omega isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -3727,7 +3620,8 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) units="nondim", default=CS%bulk_Ri_ML) call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, & "The minimum mixed layer depth if the mixed layer depth \n"//& - "is determined dynamically.", units="m", default=0.0) + "is determined dynamically.", units="m", default=0.0, scale=GV%m_to_H, & + unscaled=Hmix_min_m) call get_param(param_file, mdl, "LIMIT_BUFFER_DETRAIN", CS%limit_det, & "If true, limit the detrainment from the buffer layers \n"//& @@ -3755,7 +3649,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "DEPTH_LIMIT_FLUXES", CS%H_limit_fluxes, & "The surface fluxes are scaled away when the total ocean \n"//& "depth is less than DEPTH_LIMIT_FLUXES.", & - units="m", default=0.1*CS%Hmix_min) + units="m", default=0.1*Hmix_min_m, scale=GV%m_to_H) call get_param(param_file, mdl, "OMEGA",CS%omega, & "The rotation rate of the earth.", units="s-1", & default=7.2921e-5) @@ -3787,7 +3681,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) "The minimum value of ustar that should be used by the \n"//& "bulk mixed layer model in setting vertical TKE decay \n"//& "scales. This must be greater than 0.", units="m s-1", & - default=ustar_min_dflt) + default=ustar_min_dflt, scale=GV%m_to_Z) if (CS%ustar_min<=0.0) call MOM_error(FATAL, "BML_USTAR_MIN must be positive.") call get_param(param_file, mdl, "RESOLVE_EKMAN", CS%Resolve_Ekman, & @@ -3808,7 +3702,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) if (CS%do_rivermix) & call get_param(param_file, mdl, "RIVERMIX_DEPTH", CS%rivermix_depth, & "The depth to which rivers are mixed if DO_RIVERMIX is \n"//& - "defined.", units="m", default=0.0) + "defined.", units="m", default=0.0, scale=GV%m_to_Z) call get_param(param_file, mdl, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, & "If true, use the fluxes%runoff_Hflx field to set the \n"//& "heat carried by runoff, instead of using SST*CP*liq_runoff.", & @@ -3827,33 +3721,36 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) CS%id_ML_depth = register_diag_field('ocean_model', 'h_ML', diag%axesT1, & Time, 'Surface mixed layer depth', 'm') CS%id_TKE_wind = register_diag_field('ocean_model', 'TKE_wind', diag%axesT1, & - Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3') + Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m) CS%id_TKE_RiBulk = register_diag_field('ocean_model', 'TKE_RiBulk', diag%axesT1, & - Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3') + Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m) CS%id_TKE_conv = register_diag_field('ocean_model', 'TKE_conv', diag%axesT1, & - Time, 'Convective source of mixed layer TKE', 'm3 s-3') + Time, 'Convective source of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m) CS%id_TKE_pen_SW = register_diag_field('ocean_model', 'TKE_pen_SW', diag%axesT1, & - Time, 'TKE consumed by mixing penetrative shortwave radation through the mixed layer', 'm3 s-3') + Time, 'TKE consumed by mixing penetrative shortwave radation through the mixed layer', & + 'm3 s-3', conversion=GV%Z_to_m) CS%id_TKE_mixing = register_diag_field('ocean_model', 'TKE_mixing', diag%axesT1, & - Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3') + Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3', conversion=GV%Z_to_m) CS%id_TKE_mech_decay = register_diag_field('ocean_model', 'TKE_mech_decay', diag%axesT1, & - Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3') + Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m) CS%id_TKE_conv_decay = register_diag_field('ocean_model', 'TKE_conv_decay', diag%axesT1, & - Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3') + Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m) CS%id_TKE_conv_s2 = register_diag_field('ocean_model', 'TKE_conv_s2', diag%axesT1, & - Time, 'Spurious source of mixed layer TKE from sigma2', 'm3 s-3') + Time, 'Spurious source of mixed layer TKE from sigma2', 'm3 s-3', conversion=GV%Z_to_m) CS%id_PE_detrain = register_diag_field('ocean_model', 'PE_detrain', diag%axesT1, & - Time, 'Spurious source of potential energy from mixed layer detrainment', 'W m-2') + Time, 'Spurious source of potential energy from mixed layer detrainment', & + 'W m-2', conversion=GV%Z_to_m) CS%id_PE_detrain2 = register_diag_field('ocean_model', 'PE_detrain2', diag%axesT1, & - Time, 'Spurious source of potential energy from mixed layer only detrainment', 'W m-2') + Time, 'Spurious source of potential energy from mixed layer only detrainment', & + 'W m-2', conversion=GV%Z_to_m) CS%id_h_mismatch = register_diag_field('ocean_model', 'h_miss_ML', diag%axesT1, & - Time, 'Summed absolute mismatch in entrainment terms', 'm') + Time, 'Summed absolute mismatch in entrainment terms', 'm', conversion=GV%H_to_m) CS%id_Hsfc_used = register_diag_field('ocean_model', 'Hs_used', diag%axesT1, & - Time, 'Surface region thickness that is used', 'm') + Time, 'Surface region thickness that is used', 'm', conversion=GV%H_to_m) CS%id_Hsfc_max = register_diag_field('ocean_model', 'Hs_max', diag%axesT1, & - Time, 'Maximum surface region thickness', 'm') + Time, 'Maximum surface region thickness', 'm', conversion=GV%H_to_m) CS%id_Hsfc_min = register_diag_field('ocean_model', 'Hs_min', diag%axesT1, & - Time, 'Minimum surface region thickness', 'm') + Time, 'Minimum surface region thickness', 'm', conversion=GV%H_to_m) !CS%lim_det_dH_sfc = 0.5 ; CS%lim_det_dH_bathy = 0.2 ! Technically these should not get used if limit_det is false? if (CS%limit_det .or. (CS%id_Hsfc_min > 0)) then call get_param(param_file, mdl, "LIMIT_BUFFER_DET_DH_SFC", CS%lim_det_dH_sfc, & @@ -3875,9 +3772,8 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) endif - if (max(CS%id_TKE_wind, CS%id_TKE_RiBulk, CS%id_TKE_conv, & - CS%id_TKE_mixing, CS%id_TKE_pen_SW, CS%id_TKE_mech_decay, & - CS%id_TKE_conv_decay) > 0) then + if (max(CS%id_TKE_wind, CS%id_TKE_RiBulk, CS%id_TKE_conv, CS%id_TKE_mixing, & + CS%id_TKE_pen_SW, CS%id_TKE_mech_decay, CS%id_TKE_conv_decay) > 0) then call safe_alloc_alloc(CS%diag_TKE_wind, isd, ied, jsd, jed) call safe_alloc_alloc(CS%diag_TKE_RiBulk, isd, ied, jsd, jed) call safe_alloc_alloc(CS%diag_TKE_conv, isd, ied, jsd, jed) From 84927f1206f04af11e3e8b1fe638a6b944b30e37 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 28 Sep 2018 17:24:52 -0400 Subject: [PATCH 0757/1072] Calculate viscosity diagnostics in Z2 s-1 Do the internal calculation inside of MOM_vert_friction.F90 of the viscosity at velocity points in units of Z2 s-1, instead of m2 s-2. All answers are bitwise identical. --- src/parameterizations/vertical/MOM_vert_friction.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 64aec71fbb..7eb6ae5436 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -644,7 +644,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) "Module must be initialized before it is used.") h_neglect = GV%H_subroundoff - I_Hbbl(:) = 1.0 / (CS%Hbbl * GV%m_to_H + h_neglect) + I_Hbbl(:) = 1.0 / (CS%Hbbl + h_neglect) I_valBL = 0.0 ; if (CS%harm_BL_val > 0.0) I_valBL = 1.0 / CS%harm_BL_val if (CS%id_Kv_u > 0) then @@ -828,7 +828,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! Diagnose total Kv at u-points if (CS%id_Kv_u > 0) then do k=1,nz ; do I=Isq,Ieq - if (do_i(I)) Kv_u(I,j,k) = 0.5 * GV%Z_to_m*(CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k) + if (do_i(I)) Kv_u(I,j,k) = 0.5 * GV%H_to_Z*(CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k) enddo ; enddo endif @@ -996,7 +996,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! Diagnose total Kv at v-points if (CS%id_Kv_v > 0) then do k=1,nz ; do i=is,ie - if (do_i(I)) Kv_v(i,J,k) = 0.5 * GV%Z_to_m*(CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k) + if (do_i(I)) Kv_v(i,J,k) = 0.5 * GV%H_to_Z*(CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k) enddo ; enddo endif @@ -1679,7 +1679,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & "viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or \n"//& "the thickness over which near-bottom velocities are \n"//& "averaged for the drag law if BOTTOMDRAGLAW is defined \n"//& - "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true.) + "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true., scale=GV%m_to_H) call get_param(param_file, mdl, "MAXVEL", CS%maxvel, & "The maximum velocity allowed before the velocity \n"//& "components are truncated.", units="m s-1", default=3.0e8) @@ -1737,10 +1737,10 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & 'Slow varying vertical viscosity', 'm2 s-1') CS%id_Kv_u = register_diag_field('ocean_model', 'Kv_u', diag%axesCuL, Time, & - 'Total vertical viscosity at u-points', 'm2 s-1') + 'Total vertical viscosity at u-points', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_Kv_v = register_diag_field('ocean_model', 'Kv_v', diag%axesCvL, Time, & - 'Total vertical viscosity at v-points', 'm2 s-1') + 'Total vertical viscosity at v-points', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, & 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=GV%Z_to_m) From 70e95522af0675e4b15ba23659e8f0061849b9fb Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 28 Sep 2018 17:25:12 -0400 Subject: [PATCH 0758/1072] Do MOM_diabatic_aux calculations in units of Z Rescaled several of the variables in MOM_diabatic_aux to work in units of Z and H instead of m. Also added several temporary variables and updated the comments describing others. All answers are bitwise identical. --- .../vertical/MOM_diabatic_aux.F90 | 62 +++++++++++-------- 1 file changed, 35 insertions(+), 27 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 657c243b2c..50f49426fe 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -29,9 +29,9 @@ module MOM_diabatic_aux !> Control structure for diabatic_aux type, public :: diabatic_aux_CS ; private - logical :: do_rivermix = .false. !< Provide additional TKE to mix river runoff - !! at the river mouths to "rivermix_depth" meters - real :: rivermix_depth = 0.0 !< The depth to which rivers are mixed if do_rivermix = T, in m. + logical :: do_rivermix = .false. !< Provide additional TKE to mix river runoff at the + !! river mouths to a depth of "rivermix_depth" + real :: rivermix_depth = 0.0 !< The depth to which rivers are mixed if do_rivermix = T, in Z. logical :: reclaim_frazil !< If true, try to use any frazil heat deficit to !! to cool the topmost layer down to the freezing !! point. The default is false. @@ -660,25 +660,32 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia integer, optional, intent(in) :: id_MLDsq !< Optional handle (ID) of squared MLD ! Local variables - real, dimension(SZI_(G)) :: rhoSurf, deltaRhoAtKm1, deltaRhoAtK, dK, dKm1, pRef_MLD - real, dimension(SZI_(G)) :: rhoAtK, rho1, d1, pRef_N2 ! Used for N2 - real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth - real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML - real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2 - real, parameter :: dz_subML = 50. ! Depth below ML over which to diagnose stratification (m) + real, dimension(SZI_(G)) :: deltaRhoAtKm1, deltaRhoAtK ! Density differences, in kg m-3. + real, dimension(SZI_(G)) :: pRef_MLD, pRef_N2 ! Reference pressures in Pa. + real, dimension(SZI_(G)) :: dK, dKm1, d1 ! Depths in Z. + real, dimension(SZI_(G)) :: rhoSurf, rhoAtK, rho1 ! Densities used for N2, in kg m-3. + real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth, in m. + real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML, in s-2. + real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2, in m2. + real :: Rho_x_gE ! The product of density, gravitational acceleartion and a unit + ! conversion factor, in kg m-1 Z-1 s-2. + real :: gE_Rho0 ! The gravitational acceleration divided by a mean density, in m4 s-2 kg-1. + real :: dz_subML ! Depth below ML over which to diagnose stratification, in Z. integer :: i, j, is, ie, js, je, k, nz, id_N2, id_SQ real :: aFac, ddRho - id_N2 = -1 - if (PRESENT(id_N2subML)) id_N2 = id_N2subML + id_N2 = -1 ; if (PRESENT(id_N2subML)) id_N2 = id_N2subML - id_SQ = -1 - if (PRESENT(id_N2subML)) id_SQ = id_MLDsq + id_SQ = -1 ; if (PRESENT(id_N2subML)) id_SQ = id_MLDsq + + Rho_x_gE = (GV%g_Earth * GV%Z_to_m) * GV%Rho0 + gE_rho0 = GV%m_to_Z * GV%g_Earth / GV%Rho0 + dz_subML = 50.*GV%m_to_Z is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke pRef_MLD(:) = 0. ; pRef_N2(:) = 0. do j=js,je - do i=is,ie ; dK(i) = 0.5 * h(i,j,1) * GV%H_to_m ; enddo ! Depth of center of surface layer + do i=is,ie ; dK(i) = 0.5 * h(i,j,1) * GV%H_to_Z ; enddo ! Depth of center of surface layer call calculate_density(tv%T(:,j,1), tv%S(:,j,1), pRef_MLD, rhoSurf, is, ie-is+1, tv%eqn_of_state) do i=is,ie deltaRhoAtK(i) = 0. @@ -687,20 +694,20 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia subMLN2(i,j) = 0. rho1(i) = 0. d1(i) = 0. - pRef_N2(i) = GV%g_Earth * GV%Rho0 * h(i,j,1) * GV%H_to_m ! Boussinesq approximation!!!! ????? + pRef_N2(i) = Rho_x_gE * h(i,j,1) * GV%H_to_Z ! Boussinesq approximation!!!! ????? !### This should be: pRef_N2(i) = GV%g_Earth * GV%H_to_kg_m2 * h(i,j,1) ! This might change answers at roundoff. endif enddo do k=2,nz do i=is,ie dKm1(i) = dK(i) ! Depth of center of layer K-1 - dK(i) = dK(i) + 0.5 * ( h(i,j,k) + h(i,j,k-1) ) * GV%H_to_m ! Depth of center of layer K + dK(i) = dK(i) + 0.5 * ( h(i,j,k) + h(i,j,k-1) ) * GV%H_to_Z ! Depth of center of layer K enddo ! Stratification, N2, immediately below the mixed layer, averaged over at least 50 m. if (id_N2>0) then do i=is,ie - pRef_N2(i) = pRef_N2(i) + GV%g_Earth * GV%Rho0 * h(i,j,k) * GV%H_to_m ! Boussinesq approximation!!!! ????? + pRef_N2(i) = pRef_N2(i) + Rho_x_gE * h(i,j,k) * GV%H_to_Z ! Boussinesq approximation!!!! ????? !### This should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k) !### This might change answers at roundoff. enddo @@ -712,12 +719,12 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia d1(i) = dK(i) !### It looks to me like there is bad logic here. - RWH ! Use pressure at the bottom of the upper layer used in calculating d/dz rho - pRef_N2(i) = pRef_N2(i) + GV%g_Earth * GV%Rho0 * h(i,j,k) * GV%H_to_m ! Boussinesq approximation!!!! ????? + pRef_N2(i) = pRef_N2(i) + Rho_x_gE * h(i,j,k) * GV%H_to_Z ! Boussinesq approximation!!!! ????? !### This line should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k) !### This might change answers at roundoff. endif if (d1(i)>0. .and. dK(i)-d1(i)>=dz_subML) then - subMLN2(i,j) = GV%g_Earth/ GV%Rho0 * (rho1(i)-rhoAtK(i)) / (d1(i) - dK(i)) + subMLN2(i,j) = gE_rho0 * (rho1(i)-rhoAtK(i)) / (d1(i) - dK(i)) endif endif enddo ! i-loop @@ -741,7 +748,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia if ((MLD(i,j)==0.) .and. (deltaRhoAtK(i)0 .and. subMLN2(i,j)==0. .and. d1(i)>0. .and. dK(i)-d1(i)>0.) then ! ! Use what ever stratification we can, measured over what ever distance is available - ! subMLN2(i,j) = GV%g_Earth/ GV%Rho0 * (rho1(i)-rhoAtK(i)) / (d1(i) - dK(i)) + ! subMLN2(i,j) = gE_rho0 * (rho1(i)-rhoAtK(i)) / (d1(i) - dK(i)) ! endif enddo enddo ! j-loop @@ -818,8 +825,9 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & real, dimension(max(optics%nbands,1),SZI_(G),SZK_(G)) :: opacityBand real :: hGrounding(maxGroundings) real :: Temp_in, Salin_in - real :: I_G_Earth, g_Hconv2 - real :: GoRho + real :: I_G_Earth + real :: g_Hconv2 + real :: GoRho ! g_Earth times a unit conversion factor divided by density, in Z m3 s-2 kg-1 logical :: calculate_energetics logical :: calculate_buoyancy integer :: i, j, is, ie, js, je, k, nz, n, nsw @@ -844,7 +852,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & if (present(cTKE)) cTKE(:,:,:) = 0.0 if (calculate_buoyancy) then SurfPressure(:) = 0.0 - GoRho = GV%g_Earth / GV%Rho0 + GoRho = GV%Z_to_m*GV%g_Earth / GV%Rho0 start = 1 + G%isc - G%isd npts = 1 + G%iec - G%isc endif @@ -1032,7 +1040,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & ! rivermix_depth = The prescribed depth over which to mix river inflow ! drho_ds = The gradient of density wrt salt at the ambient surface salinity. ! Sriver = 0 (i.e. rivers are assumed to be pure freshwater) - RivermixConst = -0.5*(CS%rivermix_depth*dt)*GV%m_to_H*GV%H_to_Pa + RivermixConst = -0.5*(CS%rivermix_depth*dt)*GV%Z_to_H*GV%H_to_Pa cTKE(i,j,k) = cTKE(i,j,k) + max(0.0, RivermixConst*dSV_dS(i,j,1) * & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * tv%S(i,j,1)) @@ -1099,7 +1107,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & tv%T(i,j,k) * min(0.,dThickness) * GV%H_to_kg_m2 * fluxes%C_p * Idt if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & tv%T(i,j,k) * dThickness * GV%H_to_kg_m2 -!NOTE tv%T should be T2d +!### NOTE: tv%T should be T2d in the expressions above. ! Update state by the appropriate increment. hOld = h2d(i,k) ! Keep original thickness in hand @@ -1249,7 +1257,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & ! 3. Convert to a buoyancy flux, excluding penetrating SW heating ! BGR-Jul 5, 2017: The contribution of SW heating here needs investigated for ePBL. do i=is,ie - SkinBuoyFlux(i,j) = - GoRho * GV%H_to_m * ( & + SkinBuoyFlux(i,j) = - GoRho * GV%H_to_Z * ( & dRhodS(i) * (netSalt_rate(i) - tv%S(i,j,1)*netMassInOut_rate(i)) + & dRhodT(i) * ( netHeat_rate(i) + netPen(i,1)) ) ! m^2/s^3 enddo @@ -1345,7 +1353,7 @@ subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm, if (CS%do_rivermix) & call get_param(param_file, mdl, "RIVERMIX_DEPTH", CS%rivermix_depth, & "The depth to which rivers are mixed if DO_RIVERMIX is \n"//& - "defined.", units="m", default=0.0) + "defined.", units="m", default=0.0, scale=GV%m_to_Z) else ; CS%do_rivermix = .false. ; CS%rivermix_depth = 0.0 ; endif if (GV%nkml == 0) then call get_param(param_file, mdl, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, & From 36f04342dd4c4ca79a5d3dbba691c5c9ff901062 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 29 Sep 2018 07:19:23 -0400 Subject: [PATCH 0759/1072] Changed the units of GV%g_Earth to m2 Z-1 s-2 Rescaled the units of GV%g_Earth for dimensional consistency testing. All answers are bitwise identical, including rescaling Z over a large range. --- src/ALE/MOM_ALE.F90 | 2 +- src/core/MOM.F90 | 17 +++++----- src/core/MOM_PressureForce_Montgomery.F90 | 12 +++---- src/core/MOM_PressureForce_analytic_FV.F90 | 10 +++--- src/core/MOM_PressureForce_blocked_AFV.F90 | 10 +++--- src/core/MOM_forcing_type.F90 | 2 +- src/core/MOM_isopycnal_slopes.F90 | 2 +- src/core/MOM_verticalGrid.F90 | 7 ++-- src/diagnostics/MOM_diagnostics.F90 | 16 +++++----- src/diagnostics/MOM_sum_output.F90 | 2 +- src/diagnostics/MOM_wave_speed.F90 | 8 ++--- src/diagnostics/MOM_wave_structure.F90 | 4 +-- .../MOM_coord_initialization.F90 | 32 +++++++++---------- .../MOM_state_initialization.F90 | 16 +++++----- .../lateral/MOM_lateral_mixing_coeffs.F90 | 2 +- .../lateral/MOM_mixed_layer_restrat.F90 | 4 +-- .../lateral/MOM_thickness_diffuse.F90 | 6 ++-- .../vertical/MOM_CVMix_KPP.F90 | 2 +- .../vertical/MOM_CVMix_conv.F90 | 2 +- .../vertical/MOM_CVMix_shear.F90 | 2 +- .../vertical/MOM_bulk_mixed_layer.F90 | 16 +++++----- .../vertical/MOM_diabatic_aux.F90 | 18 +++++------ .../vertical/MOM_diabatic_driver.F90 | 4 +-- .../vertical/MOM_diapyc_energy_req.F90 | 10 +++--- .../vertical/MOM_energetic_PBL.F90 | 6 ++-- .../vertical/MOM_entrain_diffusive.F90 | 2 +- .../vertical/MOM_internal_tide_input.F90 | 2 +- .../vertical/MOM_kappa_shear.F90 | 6 ++-- .../vertical/MOM_set_diffusivity.F90 | 12 +++---- .../vertical/MOM_set_viscosity.F90 | 6 ++-- .../vertical/MOM_shortwave_abs.F90 | 2 +- src/user/BFB_initialization.F90 | 4 +-- src/user/DOME_initialization.F90 | 2 +- src/user/MOM_wave_interface.F90 | 24 +++++++------- src/user/Rossby_front_2d_initialization.F90 | 2 +- 35 files changed, 137 insertions(+), 137 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index a7ac3cc4c7..72acafef51 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -329,7 +329,7 @@ subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt, frac_shelf_h) if (CS%id_T_preale > 0) call post_data(CS%id_T_preale, tv%T, CS%diag) if (CS%id_S_preale > 0) call post_data(CS%id_S_preale, tv%S, CS%diag) if (CS%id_e_preale > 0) then - call find_eta(h, tv, GV%g_Earth, G, GV, eta_preale) + call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, eta_preale) call post_data(CS%id_e_preale, eta_preale, CS%diag) endif diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 04b3cdc600..deef3fa629 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -749,7 +749,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ! Determining the time-average sea surface height is part of the algorithm. ! This may be eta_av if Boussinesq, or need to be diagnosed if not. CS%time_in_cycle = CS%time_in_cycle + dt - call find_eta(h, CS%tv, GV%g_Earth, G, GV, ssh, CS%eta_av_bc) + call find_eta(h, CS%tv, (GV%g_Earth*GV%m_to_Z), G, GV, ssh, CS%eta_av_bc) do j=js,je ; do i=is,ie CS%ssh_rint(i,j) = CS%ssh_rint(i,j) + dt*ssh(i,j) enddo ; enddo @@ -1943,7 +1943,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call verticalGridInit( param_file, CS%GV ) GV => CS%GV -! dG%g_Earth = GV%g_Earth +! dG%g_Earth = (GV%g_Earth*GV%m_to_Z) !### These should be merged with the get_param calls, but must follow verticalGridInit. if (.not.bulkmixedlayer) then CS%Hmix = CS%Hmix * GV%m_to_Z @@ -2150,7 +2150,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & else ; G%Domain_aux => G%Domain ; endif ! Copy common variables from the vertical grid to the horizontal grid. ! Consider removing this later? - G%ke = GV%ke ; G%g_Earth = GV%g_Earth + G%ke = GV%ke ; G%g_Earth = (GV%g_Earth*GV%m_to_Z) call MOM_initialize_state(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, param_file, & dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & @@ -2179,7 +2179,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (CS%debug .or. CS%G%symmetric) then call clone_MOM_domain(CS%G%Domain, CS%G%Domain_aux, symmetric=.false.) else ; CS%G%Domain_aux => CS%G%Domain ;endif - G%ke = GV%ke ; G%g_Earth = GV%g_Earth + G%ke = GV%ke ; G%g_Earth = (GV%g_Earth*GV%m_to_Z) endif @@ -2431,9 +2431,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (.not.query_initialized(CS%ave_ssh_ibc,"ave_ssh",restart_CSp)) then if (CS%split) then - call find_eta(CS%h, CS%tv, GV%g_Earth, G, GV, CS%ave_ssh_ibc, eta) + call find_eta(CS%h, CS%tv, (GV%g_Earth*GV%m_to_Z), G, GV, CS%ave_ssh_ibc, eta) else - call find_eta(CS%h, CS%tv, GV%g_Earth, G, GV, CS%ave_ssh_ibc) + call find_eta(CS%h, CS%tv, (GV%g_Earth*GV%m_to_Z), G, GV, CS%ave_ssh_ibc) endif endif if (CS%split) deallocate(eta) @@ -2470,7 +2470,6 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) type(verticalGrid_type), pointer :: GV => NULL() type(MOM_restart_CS), pointer :: restart_CSp_tmp => NULL() real, allocatable :: z_interface(:,:,:) ! Interface heights (meter) - real, allocatable :: eta(:,:) ! Interface heights (meter) type(vardesc) :: vd call cpu_clock_begin(id_clock_init) @@ -2484,7 +2483,7 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) allocate(restart_CSp_tmp) restart_CSp_tmp = restart_CSp allocate(z_interface(SZI_(G),SZJ_(G),SZK_(G)+1)) - call find_eta(CS%h, CS%tv, GV%g_Earth, G, GV, z_interface) + call find_eta(CS%h, CS%tv, (GV%g_Earth*GV%m_to_Z), G, GV, z_interface) call register_restart_field(z_interface, "eta", .true., restart_CSp_tmp, & "Interface heights", "meter", z_grid='i') @@ -2653,7 +2652,7 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, ssh, p_atm, use_EOS) else Rho_conv=GV%Rho0 endif - IgR0 = 1.0 / (Rho_conv * GV%g_Earth) + IgR0 = 1.0 / (Rho_conv * (GV%g_Earth*GV%m_to_Z)) ssh(i,j) = ssh(i,j) + p_atm(i,j) * IgR0 enddo ; enddo endif ; endif diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 4ed4438d58..4887d1a3e1 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -142,7 +142,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, "can no longer be used with a compressible EOS. Use #define ANALYTIC_FV_PGF.") endif - g_Earth_z = GV%g_Earth*GV%Z_to_m + g_Earth_z = GV%g_Earth I_gEarth = 1.0 / g_Earth_z dp_neglect = GV%H_to_Pa * GV%H_subroundoff do k=1,nz ; alpha_Lay(k) = 1.0 / GV%Rlay(k) ; enddo @@ -302,7 +302,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, ! Note that ddM/dPb = alpha_star(i,j,1) if (present(pbce)) then - call Set_pbce_nonBouss(p, tv_tmp, G, GV, GV%g_Earth, CS%GFS_scale, pbce, & + call Set_pbce_nonBouss(p, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%GFS_scale, pbce, & alpha_star) endif @@ -432,7 +432,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta h_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/CS%Rho0 - G_Rho0 = GV%Z_to_m*GV%g_Earth/GV%Rho0 + G_Rho0 = GV%g_Earth/GV%Rho0 if (CS%tides) then ! Determine the surface height anomaly for calculating self attraction @@ -537,7 +537,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta endif ! use_EOS if (present(pbce)) then - call Set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce, rho_star) + call Set_pbce_Bouss(e, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%Rho0, CS%GFS_scale, pbce, rho_star) endif ! Calculate the pressure force. On a Cartesian grid, @@ -636,7 +636,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke Rho0xG = Rho0*g_Earth*GV%Z_to_m - G_Rho0 = GV%Z_to_m*GV%g_Earth / GV%Rho0 + G_Rho0 = GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) z_neglect = GV%H_subroundoff*GV%H_to_Z @@ -871,7 +871,7 @@ subroutine PressureForce_Mont_init(Time, G, GV, param_file, diag, CS, tides_CSp) endif CS%GFS_scale = 1.0 - if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth + if (GV%g_prime(1) /= (GV%g_Earth*GV%m_to_Z)) CS%GFS_scale = GV%g_prime(1) / (GV%g_Earth*GV%m_to_Z) call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 470636126c..aa9d43610e 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -186,7 +186,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm dp_neglect = GV%H_to_Pa * GV%H_subroundoff alpha_ref = 1.0/CS%Rho0 - g_Earth_z = GV%g_Earth*GV%Z_to_m + g_Earth_z = GV%g_Earth I_gEarth = 1.0 / g_Earth_z if (use_p_atm) then @@ -403,7 +403,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm enddo if (present(pbce)) then - call set_pbce_nonBouss(p, tv_tmp, G, GV, GV%g_Earth, CS%GFS_scale, pbce) + call set_pbce_nonBouss(p, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%GFS_scale, pbce) endif if (present(eta)) then @@ -523,7 +523,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/GV%Rho0 - g_Earth_z = GV%g_Earth*GV%Z_to_m + g_Earth_z = GV%g_Earth G_Rho0 = g_Earth_z/GV%Rho0 rho_ref = CS%Rho0 @@ -748,7 +748,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p endif if (present(pbce)) then - call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce) + call set_pbce_Bouss(e, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%Rho0, CS%GFS_scale, pbce) endif if (present(eta)) then @@ -838,7 +838,7 @@ subroutine PressureForce_AFV_init(Time, G, GV, param_file, diag, CS, tides_CSp) endif CS%GFS_scale = 1.0 - if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth + if (GV%g_prime(1) /= (GV%g_Earth*GV%m_to_Z)) CS%GFS_scale = GV%g_prime(1) / (GV%g_Earth*GV%m_to_Z) call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index f8f2abd35b..4da52327a2 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -184,7 +184,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc dp_neglect = GV%H_to_Pa * GV%H_subroundoff alpha_ref = 1.0/CS%Rho0 - g_Earth_z = GV%g_Earth*GV%Z_to_m + g_Earth_z = GV%g_Earth I_gEarth = 1.0 / g_Earth_z if (use_p_atm) then @@ -385,7 +385,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc enddo if (present(pbce)) then - call set_pbce_nonBouss(p, tv_tmp, G, GV, GV%g_Earth, CS%GFS_scale, pbce) + call set_pbce_nonBouss(p, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%GFS_scale, pbce) endif if (present(eta)) then @@ -509,7 +509,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/GV%Rho0 - g_Earth_z = GV%g_Earth*GV%Z_to_m + g_Earth_z = GV%g_Earth G_Rho0 = g_Earth_z / GV%Rho0 rho_ref = CS%Rho0 @@ -742,7 +742,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at enddo if (present(pbce)) then - call set_pbce_Bouss(e, tv_tmp, G, GV, GV%g_Earth, CS%Rho0, CS%GFS_scale, pbce) + call set_pbce_Bouss(e, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%Rho0, CS%GFS_scale, pbce) endif if (present(eta)) then @@ -832,7 +832,7 @@ subroutine PressureForce_blk_AFV_init(Time, G, GV, param_file, diag, CS, tides_C endif CS%GFS_scale = 1.0 - if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth + if (GV%g_prime(1) /= (GV%g_Earth*GV%m_to_Z)) CS%GFS_scale = GV%g_prime(1) / (GV%g_Earth*GV%m_to_Z) call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index c2042bee51..11b94a2c0c 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -858,7 +858,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, fluxes, optics, h, Temp, Salt, tv, j, depthBeforeScalingFluxes = max( GV%Angstrom_H, 1.e-30*GV%m_to_H ) pressure(:) = 0. ! Ignore atmospheric pressure - GoRho = GV%g_Earth / GV%Rho0 + GoRho = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 start = 1 + G%isc - G%isd npts = 1 + G%iec - G%isc diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index c677f3863c..119eca7b56 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -100,7 +100,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & present_N2_u = PRESENT(N2_u) present_N2_v = PRESENT(N2_v) - G_Rho0 = GV%g_Earth / GV%Rho0 + G_Rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 if (present_N2_u) then do j=js,je ; do I=is-1,ie N2_u(I,j,1) = 0. diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 0fbef525af..eeb9e66647 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -19,8 +19,8 @@ module MOM_verticalGrid ! Commonly used parameters integer :: ke !< The number of layers/levels in the vertical - real :: max_depth !< The maximum depth of the ocean in meters. - real :: g_Earth !< The gravitational acceleration in m s-2. + real :: max_depth !< The maximum depth of the ocean in Z (often m). + real :: g_Earth !< The gravitational acceleration in m2 Z-1 s-2. real :: Rho0 !< The density used in the Boussinesq approximation or nominal !! density used to convert depths into mass units, in kg m-3. @@ -125,6 +125,7 @@ subroutine verticalGridInit( param_file, GV ) if (Z_power /= 0) Z_rescale_factor = 2.0**Z_power GV%Z_to_m = 1.0 * Z_rescale_factor GV%m_to_Z = 1.0 / Z_rescale_factor + GV%g_Earth = GV%g_Earth * GV%Z_to_m #ifdef STATIC_MEMORY_ ! Here NK_ is a macro, while nk is a variable. call get_param(param_file, mdl, "NK", nk, & @@ -151,7 +152,7 @@ subroutine verticalGridInit( param_file, GV ) GV%Angstrom_H = GV%Angstrom_m*1000.0*GV%kg_m2_to_H endif GV%H_subroundoff = 1e-20 * max(GV%Angstrom_H,GV%m_to_H*1e-17) - GV%H_to_Pa = GV%g_Earth * GV%H_to_kg_m2 + GV%H_to_Pa = (GV%g_Earth*GV%m_to_Z) * GV%H_to_kg_m2 GV%H_to_Z = GV%H_to_m * GV%m_to_Z GV%Z_to_H = GV%Z_to_m * GV%m_to_H diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index eb6f02daae..60340287a3 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -284,7 +284,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_h > 0) call post_data(CS%id_h, h, CS%diag) if (associated(CS%e)) then - call find_eta(h, tv, GV%g_Earth, G, GV, CS%e, eta_bt) + call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, CS%e, eta_bt) if (CS%id_e > 0) call post_data(CS%id_e, CS%e, CS%diag) endif @@ -294,7 +294,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & CS%e_D(i,j,k) = CS%e(i,j,k) + G%Zd_to_m*G%bathyT(i,j) enddo ; enddo ; enddo else - call find_eta(h, tv, GV%g_Earth, G, GV, CS%e_D, eta_bt) + call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, CS%e_D, eta_bt) do k=1,nz+1 ; do j=js,je ; do i=is,ie CS%e_D(i,j,k) = CS%e_D(i,j,k) + G%Zd_to_m*G%bathyT(i,j) enddo ; enddo ; enddo @@ -351,7 +351,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif do k=1,nz ! Integrate vertically downward for pressure do i=is,ie ! Pressure for EOS at the layer center (Pa) - pressure_1d(i) = pressure_1d(i) + 0.5*(GV%g_Earth*GV%H_to_kg_m2)*h(i,j,k) + pressure_1d(i) = pressure_1d(i) + 0.5*GV%H_to_Pa*h(i,j,k) enddo ! Store in-situ density (kg/m3) in work_3d call calculate_density(tv%T(:,j,k),tv%S(:,j,k), pressure_1d, & @@ -360,7 +360,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & work_3d(i,j,k) = (GV%H_to_kg_m2*h(i,j,k)) / work_3d(i,j,k) enddo do i=is,ie ! Pressure for EOS at the bottom interface (Pa) - pressure_1d(i) = pressure_1d(i) + 0.5*(GV%g_Earth*GV%H_to_kg_m2)*h(i,j,k) + pressure_1d(i) = pressure_1d(i) + 0.5*GV%H_to_Pa*h(i,j,k) enddo enddo ! k enddo ! j @@ -815,7 +815,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) endif if (CS%id_col_ht > 0) then - call find_eta(h, tv, GV%g_Earth, G, GV, z_top) + call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, z_top) do j=js,je ; do i=is,ie z_bot(i,j) = z_top(i,j) + G%Zd_to_m*G%bathyT(i,j) enddo ; enddo @@ -826,7 +826,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) do j=js,je ; do i=is,ie ; mass(i,j) = 0.0 ; enddo ; enddo if (GV%Boussinesq) then if (associated(tv%eqn_of_state)) then - IG_Earth = 1.0 / GV%g_Earth + IG_Earth = 1.0 / (GV%g_Earth*GV%m_to_Z) ! do j=js,je ; do i=is,ie ; z_bot(i,j) = -P_SURF(i,j)/GV%H_to_Pa ; enddo ; enddo do j=js,je ; do i=is,ie ; z_bot(i,j) = 0.0 ; enddo ; enddo do k=1,nz @@ -835,7 +835,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) z_bot(i,j) = z_top(i,j) - GV%H_to_m*h(i,j,k) enddo ; enddo call int_density_dz(tv%T(:,:,k), tv%S(:,:,k), & - z_top, z_bot, 0.0, GV%H_to_kg_m2, GV%g_Earth, & + z_top, z_bot, 0.0, GV%H_to_kg_m2, (GV%g_Earth*GV%m_to_Z), & G%HI, G%HI, tv%eqn_of_state, dpress) do j=js,je ; do i=is,ie mass(i,j) = mass(i,j) + dpress(i,j) * IG_Earth @@ -860,7 +860,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) ! pbo = (mass * g) + p_surf ! where p_surf is the sea water pressure at sea water surface. do j=js,je ; do i=is,ie - btm_pres(i,j) = mass(i,j) * GV%g_Earth + btm_pres(i,j) = mass(i,j) * (GV%g_Earth*GV%m_to_Z) if (associated(p_surf)) then btm_pres(i,j) = btm_pres(i,j) + p_surf(i,j) endif diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index e21fb3da3d..0e37fbd3d2 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -498,7 +498,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc enddo ; enddo ; enddo mass_tot = reproducing_sum(tmp1, sums=mass_lay, EFP_sum=mass_EFP) - call find_eta(h, tv, GV%g_Earth, G, GV, eta) + call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, eta) do k=1,nz ; do j=js,je ; do i=is,ie tmp1(i,j,k) = (eta(i,j,K)-eta(i,j,K+1)) * areaTm(i,j) enddo ; enddo ; enddo diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 29ea15021c..ea2212a4ab 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -124,10 +124,10 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & endif S => tv%S ; T => tv%T - g_Rho0 = GV%g_Earth/GV%Rho0 + g_Rho0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 use_EOS = associated(tv%eqn_of_state) - H_to_pres = GV%g_Earth * GV%Rho0 + H_to_pres = (GV%g_Earth*GV%m_to_Z) * GV%Rho0 H_to_m = GV%H_to_m rescale = 1024.0**4 ; I_rescale = 1.0/rescale @@ -596,10 +596,10 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) endif ; endif S => tv%S ; T => tv%T - g_Rho0 = GV%g_Earth/GV%Rho0 + g_Rho0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 use_EOS = associated(tv%eqn_of_state) - H_to_pres = GV%g_Earth * GV%Rho0 + H_to_pres = (GV%g_Earth*GV%m_to_Z) * GV%Rho0 H_to_m = GV%H_to_m min_h_frac = tol1 / real(nz) diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 0890006c98..45e71e70ba 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -178,10 +178,10 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) Pi = (4.0*atan(1.0)) S => tv%S ; T => tv%T - g_Rho0 = GV%g_Earth/GV%Rho0 + g_Rho0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 use_EOS = associated(tv%eqn_of_state) - H_to_pres = GV%g_Earth * GV%Rho0 + H_to_pres = (GV%g_Earth*GV%m_to_Z) * GV%Rho0 H_to_m = GV%H_to_m rescale = 1024.0**4 ; I_rescale = 1.0/rescale diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 140983d0fb..b1d68f9dd3 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -133,7 +133,7 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z)) call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & units="m s-2", fail_if_missing=.true.) @@ -141,7 +141,7 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, param_file) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = g_int ; enddo Rlay(1) = GV%Rho0 - do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo + do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/(GV%g_Earth*GV%m_to_Z)) ; enddo call callTree_leave(trim(mdl)//'()') @@ -167,7 +167,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z)) call get_param(param_file, mdl, "LIGHTEST_DENSITY", Rlay_Ref, & "The reference potential density used for layer 1.", & units="kg m-3", default=GV%Rho0) @@ -182,7 +182,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file) enddo ! These statements set the interface reduced gravities. ! do k=2,nz - g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) + g_prime(k) = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0) * (Rlay(k) - Rlay(k-1)) enddo call callTree_leave(trim(mdl)//'()') @@ -219,7 +219,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, param_file, eqn_of_state, & "The initial salinities.", units="PSU", default=35.0) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z)) call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & units="m s-2", fail_if_missing=.true.) @@ -234,7 +234,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, param_file, eqn_of_state, & call calculate_density(T_ref, S_ref, P_ref, Rlay(1), eqn_of_state) ! These statements set the layer densities. ! - do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo + do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/(GV%g_Earth*GV%m_to_Z)) ; enddo call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_ref @@ -264,7 +264,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, & call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z)) call get_param(param_file, mdl, "COORD_FILE", coord_file, & "The file from which the coordinate temperatures and \n"//& "salinities are read.", fail_if_missing=.true.) @@ -282,7 +282,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, & g_prime(1) = g_fs do k=1,nz ; Pref(k) = P_ref ; enddo call calculate_density(T0, S0, Pref, Rlay, 1,nz,eqn_of_state) - do k=2,nz; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo + do k=2,nz; g_prime(k) = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_profile @@ -343,7 +343,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, param_file, & call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z)) k_light = GV%nk_rho_varies + 1 @@ -364,7 +364,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, param_file, & do k=k_light-1,1,-1 Rlay(k) = 2.0*Rlay(k+1) - Rlay(k+2) enddo - do k=2,nz; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo + do k=2,nz; g_prime(k) = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_range @@ -389,7 +389,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z)) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call get_param(param_file, mdl, "COORD_FILE", coord_file, & @@ -405,7 +405,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, param_file) call read_axis_data(filename, coord_var, Rlay) g_prime(1) = g_fs - do k=2,nz ; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo + do k=2,nz ; g_prime(k) = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo do k=1,nz ; if (g_prime(k) <= 0.0) then call MOM_error(FATAL, "MOM_initialization set_coord_from_file: "//& "Zero or negative g_primes read from variable "//"Layer"//" in file "//& @@ -443,7 +443,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, param_file) "all interfaces.", units="kg m-3", default=2.0) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z)) ! This following sets the target layer densities such that a the ! surface interface has density Rlay_ref and the bottom @@ -454,7 +454,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, param_file) ! These statements set the interface reduced gravities. g_prime(1) = g_fs do k=2,nz - g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) + g_prime(k) = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0) * (Rlay(k) - Rlay(k-1)) enddo call callTree_leave(trim(mdl)//'()') @@ -480,12 +480,12 @@ subroutine set_coord_to_none(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=GV%g_Earth) + default=(GV%g_Earth*GV%m_to_Z)) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = 0. ; enddo Rlay(1) = GV%Rho0 - do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo + do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/(GV%g_Earth*GV%m_to_Z)) ; enddo call callTree_leave(trim(mdl)//'()') diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 6849acf27e..0046a4f168 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -925,8 +925,8 @@ subroutine convert_thickness(h, G, GV, tv) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB max_itt = 10 Boussinesq = GV%Boussinesq - I_gEarth = 1.0 / GV%g_Earth - Hm_rho_to_Pa = (GV%g_Earth * GV%H_to_m) ! = GV%H_to_Pa / GV%Rho0 + I_gEarth = 1.0 / (GV%g_Earth*GV%m_to_Z) + Hm_rho_to_Pa = GV%g_Earth * GV%H_to_Z ! = GV%H_to_Pa / GV%Rho0 if (Boussinesq) then call MOM_error(FATAL,"Not yet converting thickness with Boussinesq approx.") @@ -1026,7 +1026,7 @@ subroutine depress_surface(h, G, GV, param_file, tv, just_read_params) call MOM_read_data(filename, eta_srf_var, eta_sfc, G%Domain, scale=scale_factor) ! Convert thicknesses to interface heights. - call find_eta(h, tv, GV%g_Earth, G, GV, eta) + call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, eta) do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then ! if (eta_sfc(i,j) < eta(i,j,nz+1)) then @@ -1126,7 +1126,7 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) endif do j=G%jsc,G%jec ; do i=G%isc,G%iec - call cut_off_column_top(GV%ke, tv, GV, GV%g_Earth*GV%Z_to_m, G%bathyT(i,j), & + call cut_off_column_top(GV%ke, tv, GV, GV%g_Earth, G%bathyT(i,j), & min_thickness, tv%T(i,j,:), T_t(i,j,:), T_b(i,j,:), & tv%S(i,j,:), S_t(i,j,:), S_b(i,j,:), p_surf(i,j), h(i,j,:), remap_CS, & z_tol=1.0e-5*GV%m_to_Z) @@ -2361,15 +2361,15 @@ subroutine MOM_state_init_tests(G, GV, tv) S_t(k) = 35.-(0./500.)*e(k) S(k) = 35.+(0./500.)*z(k) S_b(k) = 35.-(0./500.)*e(k+1) - call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -GV%Rho0*GV%g_Earth*z(k), & + call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -GV%Rho0*(GV%g_Earth*GV%m_to_Z)*z(k), & rho(k), tv%eqn_of_state) - P_tot = P_tot + GV%g_Earth * rho(k) * h(k) + P_tot = P_tot + (GV%g_Earth*GV%m_to_Z) * rho(k) * h(k) enddo P_t = 0. do k = 1, nk call find_depth_of_pressure_in_cell(T_t(k), T_b(k), S_t(k), S_b(k), e(K), e(K+1), & - P_t, 0.5*P_tot, GV%Rho0, GV%g_Earth, tv%eqn_of_state, P_b, z_out) + P_t, 0.5*P_tot, GV%Rho0, (GV%g_Earth*GV%m_to_Z), tv%eqn_of_state, P_b, z_out) write(0,*) k,P_t,P_b,0.5*P_tot,e(K),e(K+1),z_out P_t = P_b enddo @@ -2379,7 +2379,7 @@ subroutine MOM_state_init_tests(G, GV, tv) write(0,*) ' ==================================================================== ' write(0,*) '' write(0,*) h - call cut_off_column_top(nk, tv, GV, GV%g_Earth, -e(nk+1), GV%Angstrom_H, & + call cut_off_column_top(nk, tv, GV, (GV%g_Earth*GV%m_to_Z), -e(nk+1), GV%Angstrom_H, & T, T_t, T_b, S, S_t, S_b, 0.5*P_tot, h, remap_CS) write(0,*) h diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 34a5436f34..86f60b3e2c 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -393,7 +393,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS) "Module must be initialized before it is used.") if (CS%calculate_Eady_growth_rate) then - call find_eta(h, tv, GV%g_Earth, G, GV, e, halo_size=2) + call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, e, halo_size=2) if (CS%use_stored_slopes) then call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, & CS%slope_x, CS%slope_y, N2_u, N2_v, 1) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 1d156620a0..c9939b6693 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -273,7 +273,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var uDml(:) = 0.0 ; vDml(:) = 0.0 uDml_slow(:) = 0.0 ; vDml_slow(:) = 0.0 I4dt = 0.25 / dt - g_Rho0 = GV%g_Earth/GV%Rho0 + g_Rho0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_m proper_averaging = .not. CS%MLE_use_MLD_ave_bug @@ -597,7 +597,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) uDml(:) = 0.0 ; vDml(:) = 0.0 I4dt = 0.25 / dt - g_Rho0 = GV%g_Earth/GV%Rho0 + g_Rho0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 use_EOS = associated(tv%eqn_of_state) h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_m diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 0cf6880e7c..2a0ae1b769 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -162,7 +162,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS enddo ; enddo ! Calculates interface heights, e, in m. - call find_eta(h, tv, GV%g_Earth, G, GV, e, halo_size=1) + call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, e, halo_size=1) ! Set the diffusivities. !$OMP parallel default(none) shared(is,ie,js,je,Khth_Loc_u,CS,use_VarMix,VarMix, & @@ -518,10 +518,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H I4dt = 0.25 / dt I_slope_max2 = 1.0 / (CS%slope_max**2) - G_scale = GV%g_Earth + G_scale = (GV%g_Earth*GV%m_to_Z) h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 dz_neglect = GV%H_subroundoff*H_to_m - G_rho0 = GV%g_Earth / GV%Rho0 + G_rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 N2_floor = CS%N2_floor use_EOS = associated(tv%eqn_of_state) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 3253003119..7802651c9c 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -931,7 +931,7 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux, #endif ! some constants - GoRho = GV%g_Earth / GV%Rho0 + GoRho = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 ! loop over horizontal points on processor !$OMP parallel do default(shared) diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 74fc2d6f2d..9407e4d1e3 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -166,7 +166,7 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, CS, hbl) real :: pref, g_o_rho0, rhok, rhokm1, dz, dh, hcorr integer :: i, j, k - g_o_rho0 = GV%g_Earth / GV%Rho0 + g_o_rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 ! initialize dummy variables rho_lwr(:) = 0.0; rho_1d(:) = 0.0 diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 6f73d7984c..f3b1570930 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -73,7 +73,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & real, parameter :: epsln = 1.e-10 !< Threshold to identify vanished layers ! some constants - GoRho = GV%g_Earth / GV%Rho0 + GoRho = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 do j = G%jsc, G%jec do i = G%isc, G%iec diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 48d3729c74..a851eee838 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -560,7 +560,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & ! rivermix_depth = The prescribed depth over which to mix river inflow ! drho_ds = The gradient of density wrt salt at the ambient surface salinity. ! Sriver = 0 (i.e. rivers are assumed to be pure freshwater) - RmixConst = 0.5*CS%rivermix_depth * GV%g_Earth * Irho0**2 + RmixConst = 0.5*CS%rivermix_depth * (GV%g_Earth*GV%m_to_Z) * Irho0**2 do i=is,ie TKE_river(i) = max(0.0, RmixConst*dR0_dS(i)* & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * S(i,1)) @@ -911,7 +911,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & integer :: is, ie, nz, i, k, k1, nzc, nkmb is = G%isc ; ie = G%iec ; nz = GV%ke - g_H2_2Rho0 = (GV%g_Earth * GV%Z_to_m * GV%H_to_Z**2) / (2.0 * GV%Rho0) + g_H2_2Rho0 = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) nzc = nz ; if (present(nz_conv)) nzc = nz_conv nkmb = CS%nkml+CS%nkbl @@ -1116,7 +1116,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & Angstrom = GV%Angstrom_H C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 - g_H2_2Rho0 = (GV%g_Earth * GV%Z_to_m * GV%H_to_Z**2) / (2.0 * GV%Rho0) + g_H2_2Rho0 = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) Idt = 1.0/dt is = G%isc ; ie = G%iec ; nz = GV%ke @@ -1657,7 +1657,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & integer :: is, ie, nz, i, k, ks, itt, n C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 ; C1_24 = 1.0/24.0 - g_H_2Rho0 = (GV%g_Earth * GV%Z_to_m * GV%H_to_Z) / (2.0 * GV%Rho0) + g_H_2Rho0 = (GV%g_Earth * GV%H_to_Z) / (2.0 * GV%Rho0) Hmix_min = CS%Hmix_min h_neglect = GV%H_subroundoff is = G%isc ; ie = G%iec ; nz = GV%ke @@ -2487,8 +2487,8 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, kb1 = CS%nkml+1; kb2 = CS%nkml+2 nkmb = CS%nkml+CS%nkbl h_neglect = GV%H_subroundoff - G_2 = 0.5*GV%g_Earth*GV%Z_to_m - Rho0xG = GV%Rho0 * GV%g_Earth*GV%Z_to_m + G_2 = 0.5*GV%g_Earth + Rho0xG = GV%Rho0 * GV%g_Earth Idt_H2 = GV%H_to_Z**2 / dt_diag I2Rho0 = 0.5 / GV%Rho0 Angstrom = GV%Angstrom_H @@ -3320,8 +3320,8 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e "CS%nkbl must be 1 in mixedlayer_detrain_1.") Idt = 1.0/dt dt_Time = dt/Timescale - g_H2_2Rho0dt = (GV%g_Earth*GV%Z_to_m * GV%H_to_Z**2) / (2.0 * GV%Rho0 * dt_diag) - g_H2_2dt = (GV%g_Earth*GV%Z_to_m * GV%H_to_Z**2) / (2.0 * dt_diag) + g_H2_2Rho0dt = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0 * dt_diag) + g_H2_2dt = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * dt_diag) ! Move detrained water into the buffer layer. do k=1,CS%nkml diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 50f49426fe..1032bba617 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -678,8 +678,8 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia id_SQ = -1 ; if (PRESENT(id_N2subML)) id_SQ = id_MLDsq - Rho_x_gE = (GV%g_Earth * GV%Z_to_m) * GV%Rho0 - gE_rho0 = GV%m_to_Z * GV%g_Earth / GV%Rho0 + Rho_x_gE = (GV%g_Earth) * GV%Rho0 + gE_rho0 = GV%m_to_Z * (GV%g_Earth*GV%m_to_Z) / GV%Rho0 dz_subML = 50.*GV%m_to_Z is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -695,7 +695,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia rho1(i) = 0. d1(i) = 0. pRef_N2(i) = Rho_x_gE * h(i,j,1) * GV%H_to_Z ! Boussinesq approximation!!!! ????? - !### This should be: pRef_N2(i) = GV%g_Earth * GV%H_to_kg_m2 * h(i,j,1) ! This might change answers at roundoff. + !### This should be: pRef_N2(i) = GV%H_to_Pa * h(i,j,1) ! This might change answers at roundoff. endif enddo do k=2,nz @@ -708,7 +708,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia if (id_N2>0) then do i=is,ie pRef_N2(i) = pRef_N2(i) + Rho_x_gE * h(i,j,k) * GV%H_to_Z ! Boussinesq approximation!!!! ????? - !### This should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k) + !### This should be: pRef_N2(i) = pRev_N2(i) + GV%H_to_Pa * h(i,j,k) !### This might change answers at roundoff. enddo call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_N2, rhoAtK, is, ie-is+1, tv%eqn_of_state) @@ -720,7 +720,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia !### It looks to me like there is bad logic here. - RWH ! Use pressure at the bottom of the upper layer used in calculating d/dz rho pRef_N2(i) = pRef_N2(i) + Rho_x_gE * h(i,j,k) * GV%H_to_Z ! Boussinesq approximation!!!! ????? - !### This line should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k) + !### This line should be: pRef_N2(i) = pRev_N2(i) + GV%H_to_Pa * h(i,j,k) !### This might change answers at roundoff. endif if (d1(i)>0. .and. dK(i)-d1(i)>=dz_subML) then @@ -846,13 +846,13 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & calculate_energetics = (present(cTKE) .and. present(dSV_dT) .and. present(dSV_dS)) calculate_buoyancy = present(SkinBuoyFlux) if (calculate_buoyancy) SkinBuoyFlux(:,:) = 0.0 - I_G_Earth = 1.0 / GV%g_Earth - g_Hconv2 = GV%g_Earth * GV%H_to_kg_m2**2 + I_G_Earth = 1.0 / (GV%g_Earth*GV%m_to_Z) + g_Hconv2 = GV%H_to_Pa * GV%H_to_kg_m2 if (present(cTKE)) cTKE(:,:,:) = 0.0 if (calculate_buoyancy) then SurfPressure(:) = 0.0 - GoRho = GV%Z_to_m*GV%g_Earth / GV%Rho0 + GoRho = GV%g_Earth / GV%Rho0 start = 1 + G%isc - G%isd npts = 1 + G%iec - G%isc endif @@ -905,7 +905,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & do i=is,ie ; pres(i) = 0.0 ; enddo ! Add surface pressure? do k=1,nz do i=is,ie - d_pres(i) = GV%g_Earth * GV%H_to_kg_m2 * h2d(i,k) + d_pres(i) = GV%H_to_Pa * h2d(i,k) p_lay(i) = pres(i) + 0.5*d_pres(i) pres(i) = pres(i) + d_pres(i) enddo diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index b294bbc64b..262e6bcaed 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -407,7 +407,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) if (CS%id_e_predia > 0) then - call find_eta(h, tv, GV%g_Earth, G, GV, eta) + call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, eta) call post_data(CS%id_e_predia, eta, CS%diag) endif @@ -1285,7 +1285,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) if (CS%id_e_predia > 0) then - call find_eta(h, tv, GV%g_Earth, G, GV, eta) + call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, eta) call post_data(CS%id_e_predia, eta, CS%diag) endif diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index acd0c9336c..5248a0fb66 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -251,7 +251,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & nz = G%ke h_neglect = GV%H_subroundoff - I_G_Earth = 1.0 / GV%g_Earth + I_G_Earth = 1.0 / (GV%g_Earth*GV%m_to_Z) debug = .true. surface_BL = .true. ; bottom_BL = .true. ; halves = .true. @@ -269,7 +269,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & T0(k) = T_in(k) ; S0(k) = S_in(k) h_tr(k) = h_in(k) htot = htot + h_tr(k) - pres(K+1) = pres(K) + GV%g_Earth * GV%H_to_kg_m2 * h_tr(k) + pres(K+1) = pres(K) + GV%H_to_Pa * h_tr(k) p_lay(k) = 0.5*(pres(K) + pres(K+1)) Z_int(K+1) = Z_int(K) - GV%H_to_m * h_tr(k) enddo @@ -290,7 +290,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & do k=1,nz dMass = GV%H_to_kg_m2 * h_tr(k) - dPres = GV%g_Earth * dMass + dPres = (GV%g_Earth*GV%m_to_Z) * dMass dT_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dT(k) dS_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dS(k) dT_to_dColHt(k) = dMass * dSV_dT(k) * CS%ColHt_scaling @@ -931,7 +931,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & do K=2,nz call calculate_density(0.5*(T0(k-1) + T0(k)), 0.5*(S0(k-1) + S0(k)), & pres(K), rho_here, tv%eqn_of_state) - N2(K) = (GV%g_Earth * rho_here / (0.5*GV%H_to_m*(h_tr(k-1) + h_tr(k)))) * & + N2(K) = ((GV%g_Earth*GV%m_to_Z) * rho_here / (0.5*GV%H_to_m*(h_tr(k-1) + h_tr(k)))) * & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (T0(k-1) - T0(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (S0(k-1) - S0(k)) ) enddo @@ -942,7 +942,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & do K=2,nz call calculate_density(0.5*(Tf(k-1) + Tf(k)), 0.5*(Sf(k-1) + Sf(k)), & pres(K), rho_here, tv%eqn_of_state) - N2(K) = (GV%g_Earth * rho_here / (0.5*GV%H_to_m*(h_tr(k-1) + h_tr(k)))) * & + N2(K) = ((GV%g_Earth*GV%m_to_Z) * rho_here / (0.5*GV%H_to_m*(h_tr(k-1) + h_tr(k)))) * & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (Tf(k-1) - Tf(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (Sf(k-1) - Sf(k)) ) enddo diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 22204ae3f6..590b866761 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -692,7 +692,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & pres(i,1) = 0.0 do k=1,nz dMass = GV%H_to_kg_m2 * h(i,k) - dPres = GV%g_Earth * dMass + dPres = (GV%g_Earth*GV%m_to_Z) * dMass dT_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dT(i,j,k) dS_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dS(i,j,k) dT_to_dColHt(i,k) = dMass * dSV_dT(i,j,k) @@ -1892,7 +1892,7 @@ subroutine ust_2_u10_coare3p5(USTair,U10,GV) CT=CT+1 u10a = u10 alpha = min(0.028,0.0017 * u10 - 0.005) - z0rough = alpha * USTair**2/GV%g_Earth ! Compute z0rough from ustar guess + z0rough = alpha * USTair**2/(GV%g_Earth*GV%m_to_Z) ! Compute z0rough from ustar guess z0=z0sm+z0rough CD = ( vonkar / log(10/z0) )**2 ! Compute CD from derived roughness u10 = USTair/sqrt(CD);!Compute new u10 from derived CD, while loop @@ -1959,7 +1959,7 @@ subroutine get_LA_windsea(ustar, hbl, GV, LA) ! ! peak frequency (PM, Bouws, 1998) tmp = 2.0 * PI * u19p5_to_u10 * u10 - fp = 0.877 * GV%g_Earth / tmp + fp = 0.877 * (GV%g_Earth*GV%m_to_Z) / tmp ! ! mean frequency fm = fm_to_fp * fp diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 95a43c8a3c..961176e94b 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -226,7 +226,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H tolerance = m_to_H * CS%Tolerance_Ent - g_2dt = 0.5 * GV%g_Earth / dt + g_2dt = 0.5 * (GV%g_Earth*GV%m_to_Z) / dt kmb = GV%nk_rho_varies K2 = max(kmb+1,2) ; kb_min = K2 if (.not. CS%bulkmixedlayer) then diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index b05dfed2aa..4251f0dd1f 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -153,7 +153,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot) logical :: do_i(SZI_(G)), do_any integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - G_Rho0 = GV%g_Earth / GV%Rho0 + G_Rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 ! Find the (limited) density jump across each interface. do i=is,ie diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 0b0ee0a3d7..bccb55ea5f 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -194,7 +194,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & new_kappa = .true. ; if (present(initialize_all)) new_kappa = initialize_all ! Ri_crit = CS%Rino_crit -! gR0 = GV%Rho0*GV%g_Earth ; g_R0 = GV%g_Earth/GV%Rho0 +! gR0 = GV%Rho0*(GV%g_Earth*GV%m_to_Z) ; g_R0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 k0dt = dt*CS%kappa_0 dz_massless = 0.1*sqrt(k0dt) @@ -492,7 +492,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ new_kappa = .true. ; if (present(initialize_all)) new_kappa = initialize_all ! Ri_crit = CS%Rino_crit -! gR0 = GV%Rho0*GV%g_Earth ; g_R0 = GV%g_Earth/GV%Rho0 +! gR0 = GV%Rho0*(GV%g_Earth*GV%m_to_Z) ; g_R0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 k0dt = dt*CS%kappa_0 dz_massless = 0.1*sqrt(k0dt) @@ -821,7 +821,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & integer :: k, itt, itt_dt Ri_crit = CS%Rino_crit - gR0 = GV%Rho0*GV%g_Earth ; g_R0 = GV%g_Earth/GV%Rho0 + gR0 = GV%Rho0*(GV%g_Earth*GV%m_to_Z) ; g_R0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 k0dt = dt*CS%kappa_0 ! These are hard-coded for now. Perhaps these could be made dynamic later? ! tol_dksrc = 0.5*tol_ksrc_chg ; tol_dksrc_low = 1.0 - 1.0/tol_ksrc_chg ? diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 5db6034db3..11e7040718 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -721,7 +721,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & I_dt = 1.0/dt Omega2 = CS%Omega**2 - G_Rho0 = GV%g_Earth / GV%Rho0 + G_Rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 H_neglect = GV%H_subroundoff I_Rho0 = 1.0/GV%Rho0 @@ -846,11 +846,11 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & ! ### This should be 1 / G_Earth * (delta rho_InSitu) ! kappa_max = I_dt * dRho_int(i,K+1) * maxEnt(i,k) * & ! (GV%H_to_m*h(i,j,k) + dh_max) / dRho_lay - ! maxTKE(i,k) = GV%g_Earth * dRho_lay * kappa_max + ! maxTKE(i,k) = (GV%g_Earth*GV%m_to_Z) * dRho_lay * kappa_max ! dRho_int should already be non-negative, so the max is redundant? dh_max = maxEnt(i,k) * (1.0 + dsp1_ds(i,k)) dRho_lay = 0.5 * max(dRho_int(i,K) + dRho_int(i,K+1), 0.0) - maxTKE(i,k) = I_dt * ((GV%g_Earth * I_Rho0) * & + maxTKE(i,k) = I_dt * (((GV%g_Earth*GV%m_to_Z) * I_Rho0) * & (0.5*max(dRho_int(i,K+1) + dsp1_ds(i,k)*dRho_int(i,K),0.0))) * & ((GV%H_to_m*h(i,j,k) + dh_max) * maxEnt(i,k)) TKE_to_Kd(i,k) = 1.0 / (G_Rho0 * dRho_lay + & @@ -910,7 +910,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke - G_Rho0 = GV%g_Earth / GV%Rho0 + G_Rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 H_neglect = GV%H_subroundoff ! Find the (limited) density jump across each interface. @@ -1195,7 +1195,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) Rayleigh_drag = .true. I_Rho0 = 1.0/GV%Rho0 - R0_g = GV%Rho0/GV%g_Earth + R0_g = GV%Rho0/(GV%g_Earth*GV%m_to_Z) do K=2,nz ; Rint(K) = 0.5*(GV%Rlay(k-1)+GV%Rlay(k)) ; enddo @@ -1833,7 +1833,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) enddo if (CS%bulkmixedlayer) then - g_R0 = GV%g_Earth/GV%Rho0 + g_R0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 kmb = GV%nk_rho_varies eps = 0.1 do i=is,ie ; p_ref(i) = tv%P_Ref ; enddo diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index acebe8e6cf..1b37cb23e9 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -282,7 +282,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nkmb = GV%nk_rho_varies ; nkml = GV%nkml h_neglect = GV%H_subroundoff - Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * GV%Z_to_m*GV%Z_to_H + Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * GV%Z_to_m**2 * GV%Z_to_H Vol_quit = 0.9*GV%Angstrom_H + h_neglect C2pi_3 = 8.0*atan(1.0)/3.0 @@ -1154,7 +1154,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) Jsq = js-1 ; Isq = is-1 endif ; endif - Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * GV%Z_to_m*GV%Z_to_H + Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * GV%Z_to_m**2 * GV%Z_to_H U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt = sqrt(CS%cdrag) cdrag_sqrt_Z = GV%m_to_Z * sqrt(CS%cdrag) @@ -1164,7 +1164,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) dt_Rho0 = dt/GV%H_to_kg_m2 h_neglect = GV%H_subroundoff h_tiny = 2.0*GV%Angstrom_H + h_neglect - g_H_Rho0 = (GV%g_Earth * GV%H_to_m) / GV%Rho0 + g_H_Rho0 = (GV%g_Earth*GV%H_to_Z) / GV%Rho0 if (associated(forces%frac_shelf_u) .neqv. associated(forces%frac_shelf_v)) & call MOM_error(FATAL, "set_viscous_ML: one of forces%frac_shelf_u and "//& diff --git a/src/parameterizations/vertical/MOM_shortwave_abs.F90 b/src/parameterizations/vertical/MOM_shortwave_abs.F90 index a81a7803da..410a41583a 100644 --- a/src/parameterizations/vertical/MOM_shortwave_abs.F90 +++ b/src/parameterizations/vertical/MOM_shortwave_abs.F90 @@ -148,7 +148,7 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, C1_6 = 1.0 / 6.0 ; C1_60 = 1.0 / 60.0 TKE_calc = (present(TKE) .and. present(dSV_dT)) - g_Hconv2 = GV%g_Earth * GV%H_to_kg_m2**2 + g_Hconv2 = GV%H_to_Pa * GV%H_to_kg_m2 h_heat(:) = 0.0 if (present(htot)) then ; do i=is,ie ; h_heat(i) = htot(i) ; enddo ; endif diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index ed965393a4..8b33fc8c2b 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -56,9 +56,9 @@ subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) do k = 1,nz Rlay(k) = (rho_bot - rho_top)/(nz-1)*real(k-1) + rho_top if (k >1) then - g_prime(k) = (Rlay(k) - Rlay(k-1))*GV%g_earth/GV%rho0 + g_prime(k) = (Rlay(k) - Rlay(k-1))*(GV%g_Earth*GV%m_to_Z)/GV%rho0 else - g_prime(k) = GV%g_earth + g_prime(k) = (GV%g_Earth*GV%m_to_Z) endif !Rlay(:) = 0.0 !g_prime(:) = 0.0 diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index a4dc83d9ca..3f740beda2 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -277,7 +277,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg) if (.not.associated(OBC)) return - g_prime_tot = (GV%g_Earth/GV%Rho0)*2.0 + g_prime_tot = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0)*2.0 Def_Rad = sqrt(D_edge*g_prime_tot) / (1.0e-4*1000.0) tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*Def_Rad) * GV%m_to_H diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index c8ce37ad55..1a35ebccd2 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -525,11 +525,11 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) elseif (PartitionMode==1) then if (CS%StkLevelMode==0) then ! Take the value at the midpoint - CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b))**2/GV%g_Earth) + CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b))**2/(GV%g_Earth*GV%m_to_Z)) elseif (CS%StkLevelMode==1) then ! Use a numerical integration and then ! divide by layer thickness - WN = (2.*PI*CS%Freq_Cen(b))**2 / GV%g_Earth !bgr bug-fix missing g + WN = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*GV%m_to_Z) !bgr bug-fix missing g CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) endif endif @@ -568,11 +568,11 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) elseif (PartitionMode==1) then if (CS%StkLevelMode==0) then ! Take the value at the midpoint - CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b))**2/GV%g_Earth) + CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b))**2/(GV%g_Earth*GV%m_to_Z)) elseif (CS%StkLevelMode==1) then ! Use a numerical integration and then ! divide by layer thickness - WN = (2.*PI*CS%Freq_Cen(b))**2 / GV%g_Earth + WN = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*GV%m_to_Z) CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) endif endif @@ -770,7 +770,7 @@ subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) endif NUMBANDS = ID do B = 1,NumBands - CS%WaveNum_Cen(b) = (2.*PI*CS%Freq_Cen(b))**2 / GV%g_Earth + CS%WaveNum_Cen(b) = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*GV%m_to_Z) enddo endif @@ -968,7 +968,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US_SL, LA) ! ! peak frequency (PM, Bouws, 1998) tmp = 2.0 * PI * u19p5_to_u10 * u10 - fp = 0.877 * GV%g_Earth / tmp + fp = 0.877 * (GV%g_Earth*GV%m_to_Z) / tmp ! ! mean frequency fm = fm_to_fp * fp @@ -1102,14 +1102,14 @@ subroutine DHH85_mid(GV, ust, zpt, US) !/ omega_min = 0.1 ! Hz ! Cut off at 30cm for now... - omega_max = 6.5 ! ~sqrt(0.2*GV%g_earth*2*pi/0.3) + omega_max = 6.5 ! ~sqrt(0.2*(GV%g_Earth*GV%m_to_Z)*2*pi/0.3) domega=0.05 NOmega = (omega_max-omega_min)/domega ! if (WaveAgePeakFreq) then - omega_peak = GV%G_EARTH/WA/u10 + omega_peak = (GV%g_Earth*GV%m_to_Z)/WA/u10 else - omega_peak = 2. * pi * 0.13 * GV%g_earth / U10 + omega_peak = 2. * pi * 0.13 * (GV%g_Earth*GV%m_to_Z) / U10 endif !/ Ann = 0.006 * WaveAge**(-0.55) @@ -1125,11 +1125,11 @@ subroutine DHH85_mid(GV, ust, zpt, US) do oi = 1,nomega-1 Dnn = exp ( -0.5 * (omega-omega_peak)**2 / Snn**2 / omega_peak**2 ) ! wavespec units = m2s - wavespec = (Ann * GV%g_earth**2 / (omega_peak*omega**4 ) ) & + wavespec = (Ann * (GV%g_Earth*GV%m_to_Z)**2 / (omega_peak*omega**4 ) ) & *exp(-bnn*(omega_peak/omega)**4)*Cnn**Dnn ! Stokes units m (multiply by frequency range for units of m/s) Stokes = 2.0 * wavespec * omega**3 * & - exp( 2.0 * omega**2 * zpt/GV%g_earth)/GV%g_earth + exp( 2.0 * omega**2 * zpt/(GV%g_Earth*GV%m_to_Z))/(GV%g_Earth*GV%m_to_Z) US=US+Stokes*domega omega = omega + domega enddo @@ -1290,7 +1290,7 @@ subroutine ust_2_u10_coare3p5(USTair,U10,GV) CT=CT+1 u10a = u10 alpha = min(0.028,0.0017 * u10 - 0.005) - z0rough = alpha * USTair**2/GV%g_Earth ! Compute z0rough from ustar guess + z0rough = alpha * USTair**2/(GV%g_Earth*GV%m_to_Z) ! Compute z0rough from ustar guess z0=z0sm+z0rough CD = ( vonkar / log(10/z0) )**2 ! Compute CD from derived roughness u10 = USTair/sqrt(CD);!Compute new u10 from derived CD, while loop diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index c619f3db64..975b96e866 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -202,7 +202,7 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, param_file, just_rea do j = G%jsc,G%jec ; do I = G%isc-1,G%iec+1 f = 0.5*( G%CoriolisBu(I,j) + G%CoriolisBu(I,j-1) ) dUdT = 0.0 ; if (abs(f) > 0.0) & - dUdT = ( GV%Z_to_m*GV%g_Earth * dRho_dT ) / ( f * GV%Rho0 ) + dUdT = ( GV%g_Earth * dRho_dT ) / ( f * GV%Rho0 ) Dml = Hml( G, G%geoLatT(i,j) ) Ty = dTdy( G, T_range, G%geoLatT(i,j) ) zi = 0. From 47c8ce61a34b26fa6d3d11b0ce5820bcf22d3e8c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 30 Sep 2018 11:42:34 -0400 Subject: [PATCH 0760/1072] Changed the units of GV%g_prime to m2 Z-1 s-2 Rescaled the units of GV%g_prime for dimensional consistency testing. All answers are bitwise identical, including rescaling Z over a large range. --- src/core/MOM_PressureForce_Montgomery.F90 | 10 +-- src/core/MOM_PressureForce_analytic_FV.F90 | 2 +- src/core/MOM_PressureForce_blocked_AFV.F90 | 2 +- src/core/MOM_barotropic.F90 | 14 ++-- src/core/MOM_open_boundary.F90 | 4 +- src/core/MOM_verticalGrid.F90 | 2 +- src/diagnostics/MOM_sum_output.F90 | 4 +- .../MOM_coord_initialization.F90 | 70 +++++++++---------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 4 +- .../lateral/MOM_thickness_diffuse.F90 | 4 +- .../vertical/MOM_entrain_diffusive.F90 | 2 +- .../vertical/MOM_set_diffusivity.F90 | 4 +- src/user/BFB_initialization.F90 | 6 +- src/user/DOME_initialization.F90 | 10 +-- src/user/Phillips_initialization.F90 | 2 +- src/user/user_initialization.F90 | 4 +- 16 files changed, 72 insertions(+), 72 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 4887d1a3e1..395dccc018 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -527,11 +527,11 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - M(i,j,1) = GV%g_prime(1) * GV%Z_to_m*e(i,j,1) + M(i,j,1) = GV%g_prime(1) * e(i,j,1) if (use_p_atm) M(i,j,1) = M(i,j,1) + p_atm(i,j) * I_Rho0 enddo do k=2,nz ; do i=Isq,Ieq+1 - M(i,j,k) = M(i,j,k-1) + GV%g_prime(K) * GV%Z_to_m*e(i,j,K) + M(i,j,k) = M(i,j,k-1) + GV%g_prime(K) * e(i,j,K) enddo ; enddo enddo endif ! use_EOS @@ -687,11 +687,11 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star do j=Jsq,Jeq+1 do i=Isq,Ieq+1 Ihtot(i) = 1.0 / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) - pbce(i,j,1) = GV%g_prime(1) * GV%H_to_m + pbce(i,j,1) = GV%g_prime(1) * GV%H_to_Z enddo do k=2,nz ; do i=Isq,Ieq+1 pbce(i,j,k) = pbce(i,j,k-1) + & - (GV%g_prime(K)*GV%H_to_m) * ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i)) + (GV%g_prime(K)*GV%H_to_Z) * ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i)) enddo ; enddo enddo ! end of j loop endif ! use_EOS @@ -871,7 +871,7 @@ subroutine PressureForce_Mont_init(Time, G, GV, param_file, diag, CS, tides_CSp) endif CS%GFS_scale = 1.0 - if (GV%g_prime(1) /= (GV%g_Earth*GV%m_to_Z)) CS%GFS_scale = GV%g_prime(1) / (GV%g_Earth*GV%m_to_Z) + if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index aa9d43610e..a245b1f4d4 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -838,7 +838,7 @@ subroutine PressureForce_AFV_init(Time, G, GV, param_file, diag, CS, tides_CSp) endif CS%GFS_scale = 1.0 - if (GV%g_prime(1) /= (GV%g_Earth*GV%m_to_Z)) CS%GFS_scale = GV%g_prime(1) / (GV%g_Earth*GV%m_to_Z) + if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 4da52327a2..e53d44a88a 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -832,7 +832,7 @@ subroutine PressureForce_blk_AFV_init(Time, G, GV, param_file, diag, CS, tides_C endif CS%GFS_scale = 1.0 - if (GV%g_prime(1) /= (GV%g_Earth*GV%m_to_Z)) CS%GFS_scale = GV%g_prime(1) / (GV%g_Earth*GV%m_to_Z) + if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index f240f4318c..733cf7a9d2 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -2640,14 +2640,14 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co else if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then BT_OBC%H_u(i,j) = eta(i,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (GV%Z_to_m*G%bathyT(i,j) + eta(i,j))) !### * GV%H_to_m? + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j) + GV%m_to_Z*eta(i,j))) !### * GV%H_to_m? elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then BT_OBC%H_u(i,j) = eta(i+1,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (GV%Z_to_m*G%bathyT(i+1,j) + eta(i+1,j))) !### * GV%H_to_m? + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i+1,j) + GV%m_to_Z*eta(i+1,j))) !### * GV%H_to_m? endif endif if (GV%Boussinesq) then - BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1) * BT_OBC%H_u(i,j)) !### * GV%H_to_m? + BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1)*GV%m_to_Z * BT_OBC%H_u(i,j)) !### * GV%H_to_m? endif endif endif ; enddo ; enddo @@ -2696,14 +2696,14 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co else if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then BT_OBC%H_v(i,J) = eta(i,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (GV%Z_to_m*G%bathyT(i,j) + eta(i,j))) !### * GV%H_to_m? + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j) + eta(i,j)*GV%m_to_Z)) !### * GV%H_to_m? elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then BT_OBC%H_v(i,J) = eta(i,j+1) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (GV%Z_to_m*G%bathyT(i,j+1) + eta(i,j+1))) !### * GV%H_to_m? + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j+1) + eta(i,j+1)*GV%m_to_Z)) !### * GV%H_to_m? endif endif if (GV%Boussinesq) then - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * BT_OBC%H_v(i,J)) !### * GV%H_to_m? + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1)*GV%m_to_Z * BT_OBC%H_v(i,J)) !### * GV%H_to_m? endif endif endif ; enddo ; enddo @@ -4143,7 +4143,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ! Estimate the maximum stable barotropic time step. gtot_estimate = 0.0 - do k=1,G%ke ; gtot_estimate = gtot_estimate + GV%g_prime(K) ; enddo + do k=1,G%ke ; gtot_estimate = gtot_estimate + GV%g_prime(K)*GV%m_to_Z ; enddo call set_dtbt(G, GV, CS, gtot_est = gtot_estimate, SSH_add = SSH_extra) if (dtbt_input > 0.0) then diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index bd23331e14..6296dbc35b 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -2977,7 +2977,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (segment%direction == OBC_DIRECTION_W) ishift=1 I=segment%HI%IsdB do j=segment%HI%jsd,segment%HI%jed - segment%Cg(I,j) = sqrt(GV%g_prime(1)*G%Zd_to_m*G%bathyT(i+ishift,j)) + segment%Cg(I,j) = sqrt(GV%g_prime(1)*G%bathyT(i+ishift,j)) segment%Htot(I,j)=0.0 do k=1,G%ke segment%h(I,j,k) = h(i+ishift,j,k) @@ -2990,7 +2990,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (segment%direction == OBC_DIRECTION_S) jshift=1 J=segment%HI%JsdB do i=segment%HI%isd,segment%HI%ied - segment%Cg(i,J) = sqrt(GV%g_prime(1)*G%Zd_to_m*G%bathyT(i,j+jshift)) + segment%Cg(i,J) = sqrt(GV%g_prime(1)*G%bathyT(i,j+jshift)) segment%Htot(i,J)=0.0 do k=1,G%ke segment%h(i,J,k) = h(i,j+jshift,k) diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index eeb9e66647..b2ef2dda6a 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -41,7 +41,7 @@ module MOM_verticalGrid !! Angstrom or larger without changing it at the bit level, in thickness units. !! If Angstrom is 0 or exceedingly small, this is negligible compared to 1e-17 m. real, allocatable, dimension(:) :: & - g_prime, & !< The reduced gravity at each interface, in m s-2. + g_prime, & !< The reduced gravity at each interface, in m2 Z-1 s-2. Rlay !< The target coordinate value (potential density) in each layer in kg m-3. integer :: nkml = 0 !< The number of layers at the top that should be treated !! as parts of a homogenous region. diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 0e37fbd3d2..e464d565fa 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -643,7 +643,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc hint = H_0APE(K) + (hbelow - G%Zd_to_m*G%bathyT(i,j)) hbot = H_0APE(K) - G%Zd_to_m*G%bathyT(i,j) hbot = (hbot + ABS(hbot)) * 0.5 - PE_pt(i,j,K) = 0.5 * areaTm(i,j) * (GV%Rho0*GV%g_prime(K)) * & + PE_pt(i,j,K) = 0.5 * areaTm(i,j) * (GV%Rho0*GV%m_to_Z*GV%g_prime(K)) * & (hint * hint - hbot * hbot) enddo enddo ; enddo @@ -653,7 +653,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc do k=nz,1,-1 hint = H_0APE(K) + eta(i,j,K) ! eta and H_0 have opposite signs. hbot = max(H_0APE(K) - G%Zd_to_m*G%bathyT(i,j), 0.0) - PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * (GV%Rho0*GV%g_prime(K))) * & + PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * (GV%Rho0*GV%m_to_Z*GV%g_prime(K))) * & (hint * hint - hbot * hbot) enddo enddo ; enddo diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index b1d68f9dd3..54728f61d9 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -99,7 +99,7 @@ subroutine MOM_initialize_coord(GV, PF, write_geom, output_dir, tv, max_depth) "Unrecognized coordinate setup"//trim(config)) end select if (debug) call chksum(GV%Rlay, "MOM_initialize_coord: Rlay ", 1, nz) - if (debug) call chksum(GV%g_prime, "MOM_initialize_coord: g_prime ", 1, nz) + if (debug) call chksum(GV%Z_to_m*GV%g_prime(:), "MOM_initialize_coord: g_prime ", 1, nz) call setVerticalGridAxes( GV%Rlay, GV ) ! Copy the maximum depth across from the input argument @@ -118,8 +118,8 @@ end subroutine MOM_initialize_coord subroutine set_coord_from_gprime(Rlay, g_prime, GV, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< A structure indicating the open file to - !! parse for model parameter values. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces + !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables @@ -133,15 +133,15 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z)) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & - units="m s-2", fail_if_missing=.true.) + units="m s-2", fail_if_missing=.true., scale=GV%Z_to_m) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = g_int ; enddo Rlay(1) = GV%Rho0 - do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/(GV%g_Earth*GV%m_to_Z)) ; enddo + do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo call callTree_leave(trim(mdl)//'()') @@ -151,8 +151,8 @@ end subroutine set_coord_from_gprime subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, - !! in m s-2. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces + !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables @@ -167,7 +167,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z)) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) call get_param(param_file, mdl, "LIGHTEST_DENSITY", Rlay_Ref, & "The reference potential density used for layer 1.", & units="kg m-3", default=GV%Rho0) @@ -182,7 +182,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file) enddo ! These statements set the interface reduced gravities. ! do k=2,nz - g_prime(k) = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0) * (Rlay(k) - Rlay(k-1)) + g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) enddo call callTree_leave(trim(mdl)//'()') @@ -193,8 +193,8 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, param_file, eqn_of_state, & P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< the reduced gravity across the interfaces, - !! in m s-2. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces + !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters @@ -219,10 +219,10 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, param_file, eqn_of_state, & "The initial salinities.", units="PSU", default=35.0) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z)) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & - units="m s-2", fail_if_missing=.true.) + units="m s-2", fail_if_missing=.true., scale=GV%Z_to_m) ! ! These statements set the interface reduced gravities. ! g_prime(1) = g_fs @@ -234,7 +234,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, param_file, eqn_of_state, & call calculate_density(T_ref, S_ref, P_ref, Rlay(1), eqn_of_state) ! These statements set the layer densities. ! - do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/(GV%g_Earth*GV%m_to_Z)) ; enddo + do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_ref @@ -244,8 +244,8 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, & eqn_of_state, P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, - !! in m s-2. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces + !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters @@ -264,7 +264,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, & call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z)) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) call get_param(param_file, mdl, "COORD_FILE", coord_file, & "The file from which the coordinate temperatures and \n"//& "salinities are read.", fail_if_missing=.true.) @@ -282,7 +282,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, & g_prime(1) = g_fs do k=1,nz ; Pref(k) = P_ref ; enddo call calculate_density(T0, S0, Pref, Rlay, 1,nz,eqn_of_state) - do k=2,nz; g_prime(k) = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo + do k=2,nz; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_profile @@ -292,8 +292,8 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, param_file, & eqn_of_state, P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, - !! in m s-2. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces + !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters @@ -343,7 +343,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, param_file, & call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z)) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) k_light = GV%nk_rho_varies + 1 @@ -364,7 +364,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, param_file, & do k=k_light-1,1,-1 Rlay(k) = 2.0*Rlay(k+1) - Rlay(k+2) enddo - do k=2,nz; g_prime(k) = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo + do k=2,nz; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_range @@ -373,8 +373,8 @@ end subroutine set_coord_from_TS_range subroutine set_coord_from_file(Rlay, g_prime, GV, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, - !! in m s-2. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces + !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables @@ -389,7 +389,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z)) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call get_param(param_file, mdl, "COORD_FILE", coord_file, & @@ -405,7 +405,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, param_file) call read_axis_data(filename, coord_var, Rlay) g_prime(1) = g_fs - do k=2,nz ; g_prime(k) = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo + do k=2,nz ; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo do k=1,nz ; if (g_prime(k) <= 0.0) then call MOM_error(FATAL, "MOM_initialization set_coord_from_file: "//& "Zero or negative g_primes read from variable "//"Layer"//" in file "//& @@ -423,8 +423,8 @@ end subroutine set_coord_from_file subroutine set_coord_linear(Rlay, g_prime, GV, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, - !! in m s-2. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces + !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables @@ -443,7 +443,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, param_file) "all interfaces.", units="kg m-3", default=2.0) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z)) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) ! This following sets the target layer densities such that a the ! surface interface has density Rlay_ref and the bottom @@ -454,7 +454,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, param_file) ! These statements set the interface reduced gravities. g_prime(1) = g_fs do k=2,nz - g_prime(k) = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0) * (Rlay(k) - Rlay(k-1)) + g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) enddo call callTree_leave(trim(mdl)//'()') @@ -466,8 +466,8 @@ end subroutine set_coord_linear subroutine set_coord_to_none(Rlay, g_prime, GV, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). - real, dimension(:), intent(out) :: g_prime !< A structure indicating the open file to - !! parse for model parameter values. + real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, + !! in m s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables @@ -480,12 +480,12 @@ subroutine set_coord_to_none(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z)) + default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = 0. ; enddo Rlay(1) = GV%Rho0 - do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/(GV%g_Earth*GV%m_to_Z)) ; enddo + do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo call callTree_leave(trim(mdl)//'()') diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 86f60b3e2c..6065062b83 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -666,7 +666,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect) Hup = 2.*h(i+1,j,k)*h(i+1,j,k-1) / (h(i+1,j,k) + h(i+1,j,k-1) + h_neglect) H_geom = sqrt(Hdn*Hup) - N2 = GV%g_prime(k) / (GV%H_to_m * max(Hdn,Hup,one_meter)) + N2 = GV%g_prime(k)*GV%m_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) if (min(h(i,j,k-1), h(i+1,j,k-1), h(i,j,k), h(i+1,j,k)) < H_cutoff) & S2 = 0.0 SN_u_local(I,j,k) = (H_geom * GV%H_to_m) * S2 * N2 @@ -677,7 +677,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect) Hup = 2.*h(i,j+1,k)*h(i,j+1,k-1) / (h(i,j+1,k) + h(i,j+1,k-1) + h_neglect) H_geom = sqrt(Hdn*Hup) - N2 = GV%g_prime(k) / (GV%H_to_m * max(Hdn,Hup,one_meter)) + N2 = GV%g_prime(k)*GV%m_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) if (min(h(i,j,k-1), h(i,j+1,k-1), h(i,j,k), h(i,j+1,k)) < H_cutoff) & S2 = 0.0 SN_v_local(i,J,k) = (H_geom * GV%H_to_m) * S2 * N2 diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 2a0ae1b769..5a72723b07 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -729,7 +729,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV endif if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*Slope) - hN2_u(I,K) = GV%g_prime(K) + hN2_u(I,K) = GV%g_prime(K)*GV%m_to_Z endif ! if (use_EOS) else ! if (k > nk_linear) hN2_u(I,K) = N2_floor * dz_neglect @@ -975,7 +975,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV endif if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*Slope) - hN2_v(i,K) = GV%g_prime(K) + hN2_v(i,K) = GV%g_prime(K)*GV%m_to_Z endif ! if (use_EOS) else ! if (k > nk_linear) hN2_v(i,K) = N2_floor * dz_neglect diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 961176e94b..d3a510fea7 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -384,7 +384,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & htot(i) = h(i,j,1) - Angstrom enddo if (associated(fluxes%buoy)) then ; do i=is,ie - maxF(i,1) = (dt*fluxes%buoy(i,j)) / GV%g_prime(2) + maxF(i,1) = (dt*fluxes%buoy(i,j)) / (GV%g_prime(2)*GV%m_to_Z) enddo ; endif endif diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 11e7040718..f185f5aab4 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1810,7 +1810,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) ! below it (nondimensional) ! (in) rho_0 - layer potential densities relative to surface press (kg/m3) - real :: g_R0 ! g_R0 is g/Rho (m4 kg-1 s-2) + real :: g_R0 ! g_R0 is g/Rho (m5 Z-1 kg-1 s-2) real :: eps, tmp ! nondimensional temproray variables real :: a(SZK_(G)), a_0(SZK_(G)) ! nondimensional temporary variables real :: p_ref(SZI_(G)) ! an array of tv%P_Ref pressures @@ -1833,7 +1833,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) enddo if (CS%bulkmixedlayer) then - g_R0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 + g_R0 = GV%g_Earth/GV%Rho0 kmb = GV%nk_rho_varies eps = 0.1 do i=is,ie ; p_ref(i) = tv%P_Ref ; enddo diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 8b33fc8c2b..2eda7d2f1d 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -32,7 +32,7 @@ module BFB_initialization subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) real, dimension(NKMEM_), intent(out) :: Rlay !< Layer potential density. real, dimension(NKMEM_), intent(out) :: g_prime !< The reduced gravity at - !! each interface, in m s-2. + !! each interface, in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(EOS_type), pointer :: eqn_of_state !< Integer that selects the @@ -56,9 +56,9 @@ subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) do k = 1,nz Rlay(k) = (rho_bot - rho_top)/(nz-1)*real(k-1) + rho_top if (k >1) then - g_prime(k) = (Rlay(k) - Rlay(k-1))*(GV%g_Earth*GV%m_to_Z)/GV%rho0 + g_prime(k) = (Rlay(k) - Rlay(k-1)) * GV%g_Earth/GV%rho0 else - g_prime(k) = (GV%g_Earth*GV%m_to_Z) + g_prime(k) = GV%g_Earth endif !Rlay(:) = 0.0 !g_prime(:) = 0.0 diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 3f740beda2..4315420e9a 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -252,9 +252,9 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg) real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 in kg m-3. ! The following variables are used to set up the transport in the DOME example. real :: tr_0, y1, y2, tr_k, rst, rsb, rc, v_k, lon_im1 - real :: D_edge ! The thickness in m of the dense fluid at the + real :: D_edge ! The thickness in Z of the dense fluid at the ! inner edge of the inflow. - real :: g_prime_tot ! The reduced gravity across all layers, m s-2. + real :: g_prime_tot ! The reduced gravity across all layers, m2 Z-1 s-2. real :: Def_Rad ! The deformation radius, based on fluid of ! thickness D_edge, in the same units as lat. real :: Ri_trans ! The shear Richardson number in the transition @@ -271,15 +271,15 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg) IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! The following variables should be transformed into runtime parameters. - D_edge = 300.0 ! The thickness of dense fluid in the inflow. + D_edge = 300.0*GV%m_to_Z ! The thickness of dense fluid in the inflow. Ri_trans = 1.0/3.0 ! The shear Richardson number in the transition region ! region of the specified shear profile. if (.not.associated(OBC)) return - g_prime_tot = ((GV%g_Earth*GV%m_to_Z)/GV%Rho0)*2.0 + g_prime_tot = (GV%g_Earth/GV%Rho0)*2.0 Def_Rad = sqrt(D_edge*g_prime_tot) / (1.0e-4*1000.0) - tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*Def_Rad) * GV%m_to_H + tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*Def_Rad) * GV%Z_to_H if (OBC%number_of_segments /= 1) then call MOM_error(WARNING, 'Error in DOME OBC segment setup', .true.) diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index f94ff86272..580638e415 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -139,7 +139,7 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, param_file, just_read_param fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "JET_HEIGHT", jet_height, & "The interface height scale associated with the \n"//& - "zonal-mean jet.", units="m", & + "zonal-mean jet.", units="m", scale=GV%m_to_Z, & fail_if_missing=.not.just_read, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 3564ff9f3f..174cd0ac8f 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -36,7 +36,7 @@ subroutine USER_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) !! structure. real, dimension(:), intent(out) :: Rlay !< Layer potential density. real, dimension(:), intent(out) :: g_prime !< The reduced gravity at - !! each interface, in m s-2. + !! each interface, in m2 Z-1 s-2. type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. @@ -240,7 +240,7 @@ end subroutine write_user_log !! - h - Layer thickness in H. (Must be positive.) !! - G%bathyT - Basin depth in Z. (Must be positive.) !! - G%CoriolisBu - The Coriolis parameter, in s-1. -!! - GV%g_prime - The reduced gravity at each interface, in m s-2. +!! - GV%g_prime - The reduced gravity at each interface, in m2 Z-1 s-2. !! - GV%Rlay - Layer potential density (coordinate variable), kg m-3. !! If ENABLE_THERMODYNAMICS is defined: !! - T - Temperature in C. From 030b6c2d76825e90d040bec5150d20a08157fdb4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 30 Sep 2018 12:07:46 -0400 Subject: [PATCH 0761/1072] +Remove g_Earth argument from set_pbce_Bous Remove g_Earth argument from set_pbce_Bous and set_pbce_nonBous, instead using the value from inside GV. Also simplified an expression converting layer thicknesses to pressure. All answers are bitwise identical. --- src/core/MOM_PressureForce_Montgomery.F90 | 25 +++++++++------------- src/core/MOM_PressureForce_analytic_FV.F90 | 4 ++-- src/core/MOM_PressureForce_blocked_AFV.F90 | 4 ++-- 3 files changed, 14 insertions(+), 19 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 395dccc018..f8657fca2d 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -116,8 +116,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, ! barotropic and baroclinic pieces. type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. - real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2. - real :: I_gEarth ! The inverse of g_Earth_z, in s2 Z m-2 + real :: I_gEarth ! The inverse of g_Earth, in s2 Z m-2 real :: dalpha real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). real :: alpha_Lay(SZK_(G)) ! The specific volume of each layer, in kg m-3. @@ -142,8 +141,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, "can no longer be used with a compressible EOS. Use #define ANALYTIC_FV_PGF.") endif - g_Earth_z = GV%g_Earth - I_gEarth = 1.0 / g_Earth_z + I_gEarth = 1.0 / GV%g_Earth dp_neglect = GV%H_to_Pa * GV%H_subroundoff do k=1,nz ; alpha_Lay(k) = 1.0 / GV%Rlay(k) ; enddo do k=2,nz ; dalpha_int(K) = alpha_Lay(k-1) - alpha_Lay(k) ; enddo @@ -202,12 +200,12 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - geopot_bot(i,j) = -g_Earth_z*(e_tidal(i,j) + G%bathyT(i,j)) + geopot_bot(i,j) = -GV%g_Earth*(e_tidal(i,j) + G%bathyT(i,j)) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - geopot_bot(i,j) = -g_Earth_z*G%bathyT(i,j) + geopot_bot(i,j) = -GV%g_Earth*G%bathyT(i,j) enddo ; enddo endif @@ -302,8 +300,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, ! Note that ddM/dPb = alpha_star(i,j,1) if (present(pbce)) then - call Set_pbce_nonBouss(p, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%GFS_scale, pbce, & - alpha_star) + call Set_pbce_nonBouss(p, tv_tmp, G, GV, CS%GFS_scale, pbce, alpha_star) endif ! Calculate the pressure force. On a Cartesian grid, @@ -537,7 +534,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta endif ! use_EOS if (present(pbce)) then - call Set_pbce_Bouss(e, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%Rho0, CS%GFS_scale, pbce, rho_star) + call Set_pbce_Bouss(e, tv_tmp, G, GV, CS%Rho0, CS%GFS_scale, pbce, rho_star) endif ! Calculate the pressure force. On a Cartesian grid, @@ -600,12 +597,11 @@ end subroutine PressureForce_Mont_Bouss !> Determines the partial derivative of the acceleration due !! to pressure forces with the free surface height. -subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star) +subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height, in Z. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, intent(in) :: g_Earth !< The gravitational acceleration, in m s-2. real, intent(in) :: Rho0 !< The "Boussinesq" ocean density, in kg m-3. real, intent(in) :: GFS_scale !< Ratio between gravity applied to top interface !! and the gravitational acceleration of the planet. @@ -635,7 +631,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke - Rho0xG = Rho0*g_Earth*GV%Z_to_m + Rho0xG = Rho0*GV%g_Earth G_Rho0 = GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) z_neglect = GV%H_subroundoff*GV%H_to_Z @@ -700,12 +696,11 @@ end subroutine Set_pbce_Bouss !> Determines the partial derivative of the acceleration due !! to pressure forces with the column mass. -subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star) +subroutine Set_pbce_nonBouss(p, tv, G, GV, GFS_scale, pbce, alpha_star) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: p !< Interface pressures, in Pa. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, intent(in) :: g_Earth !< The gravitational acceleration, in m s-2. real, intent(in) :: GFS_scale !< Ratio between gravity applied to top interface !! and the gravitational acceleration of the planet. !! Usually this ratio is 1. @@ -738,7 +733,7 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, g_Earth, GFS_scale, pbce, alpha_star) use_EOS = associated(tv%eqn_of_state) - dP_dH = g_Earth * GV%H_to_kg_m2 + dP_dH = GV%H_to_Pa dp_neglect = dP_dH * GV%H_subroundoff do k=1,nz ; alpha_Lay(k) = 1.0 / GV%Rlay(k) ; enddo diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index a245b1f4d4..a27f72cae2 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -403,7 +403,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm enddo if (present(pbce)) then - call set_pbce_nonBouss(p, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%GFS_scale, pbce) + call set_pbce_nonBouss(p, tv_tmp, G, GV, CS%GFS_scale, pbce) endif if (present(eta)) then @@ -748,7 +748,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p endif if (present(pbce)) then - call set_pbce_Bouss(e, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%Rho0, CS%GFS_scale, pbce) + call set_pbce_Bouss(e, tv_tmp, G, GV, CS%Rho0, CS%GFS_scale, pbce) endif if (present(eta)) then diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index e53d44a88a..7cd449f86f 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -385,7 +385,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc enddo if (present(pbce)) then - call set_pbce_nonBouss(p, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%GFS_scale, pbce) + call set_pbce_nonBouss(p, tv_tmp, G, GV, CS%GFS_scale, pbce) endif if (present(eta)) then @@ -742,7 +742,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at enddo if (present(pbce)) then - call set_pbce_Bouss(e, tv_tmp, G, GV, (GV%g_Earth*GV%m_to_Z), CS%Rho0, CS%GFS_scale, pbce) + call set_pbce_Bouss(e, tv_tmp, G, GV, CS%Rho0, CS%GFS_scale, pbce) endif if (present(eta)) then From 7e3d3685d508564e442c08b15d052c1e403c9bde Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Mon, 1 Oct 2018 15:05:47 -0400 Subject: [PATCH 0762/1072] Diag decimation prototype, fixing memory leaks - The design of decimating subroutines with pointer manipulations was bad and causing memory leak. Using "allocatable" arrays instead is not as elegant but avoids memory leaks at the cost of bringing a few lines of code fo allocating temporary arrays outside the decimating subroutines. The FORTRAN garbage collection takes care of deallocating the "allocatable"s when their scope ends (unlike pointers). --- src/framework/MOM_diag_mediator.F90 | 221 +++++++++++----------------- 1 file changed, 89 insertions(+), 132 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 6696933d9e..46dfae8507 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -73,13 +73,13 @@ module MOM_diag_mediator end interface zap2_sample interface decimate_sample - module procedure decimate_sample_2d, decimate_sample_3d, decimate_sample_3d_out + module procedure decimate_sample_3d_out end interface decimate_sample -interface decimate_diag_field - module procedure decimate_diag_field_2d,decimate_diag_field_3d -end interface decimate_diag_field - +interface decimate_diag_field_set + module procedure decimate_diag_field_set_2d,decimate_diag_field_set_3d +end interface decimate_diag_field_set + type, private :: diag_decim real, pointer, dimension(:,:) :: mask2d => null() !< Mask for 2d (x-y) axes real, pointer, dimension(:,:,:) :: mask3d => null() !< Mask for 3d axes @@ -1237,11 +1237,14 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) ! Local variables real, dimension(:,:), pointer :: locfield => NULL() real, dimension(:,:), pointer :: locmask => NULL() - real, dimension(:,:), pointer :: diag_axes_mask2d => NULL() character(len=300) :: mesg logical :: used, is_stat integer :: cszi, cszj, dszi, dszj - integer :: isv, iev, jsv, jev, i, j, chksum, dl + integer :: isv, iev, jsv, jev, i, j, chksum + real, dimension(:,:), pointer :: diag_axes_mask2d => NULL() + real, dimension(:,:), allocatable, target :: locfield_decim + real, dimension(:,:), allocatable, target :: locmask_decim + integer :: isl,iel,jsl,jel,dl is_stat = .false. ; if (present(is_static)) is_stat = is_static @@ -1324,9 +1327,16 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) diag_axes_mask2d => diag%axes%mask2d dl = diag%axes%decimation_level if (dl > 1) then - call decimate_diag_field(locfield, dl, diag_cs,isv,iev,jsv,jev) + isl=1; iel=size(field,1)/dl + jsl=1; jel=size(field,2)/dl + call decimate_diag_indices_get(iel,jel, dl, diag_cs,isv,iev,jsv,jev) + allocate(locfield_decim(isl:iel,jsl:jel)) + call decimate_diag_field_set(locfield, locfield_decim, dl,isl,iel,jsl,jel) + locfield => locfield_decim if (present(mask)) then - call decimate_diag_field(locmask, dl) + allocate(locmask_decim(isl:iel,jsl:jel)) + call decimate_diag_field_set(locmask, locmask_decim, dl,isl,iel,jsl,jel) + locmask => locmask_decim elseif (associated(diag%axes%decim(dl)%mask2d)) then diag_axes_mask2d => diag%axes%decim(dl)%mask2d endif @@ -1373,7 +1383,6 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) endif if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) & deallocate( locfield ) - end subroutine post_data_2d_low !> Make a real 3-d array diagnostic available for averaging or output. @@ -1508,14 +1517,17 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) ! Local variables real, dimension(:,:,:), pointer :: locfield => NULL() real, dimension(:,:,:), pointer :: locmask => NULL() - real, dimension(:,:,:), pointer :: diag_axes_mask3d => NULL() character(len=300) :: mesg logical :: used ! The return value of send_data is not used for anything. logical :: staggered_in_x, staggered_in_y logical :: is_stat integer :: cszi, cszj, dszi, dszj integer :: isv, iev, jsv, jev, ks, ke, i, j, k, isv_c, jsv_c - integer :: chksum, dl + integer :: chksum + real, dimension(:,:,:), pointer :: diag_axes_mask3d => NULL() + real, dimension(:,:,:), allocatable, target :: locfield_decim + real, dimension(:,:,:), allocatable, target :: locmask_decim + integer :: isl,iel,jsl,jel,dl is_stat = .false. ; if (present(is_static)) is_stat = is_static @@ -1596,9 +1608,16 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) diag_axes_mask3d => diag%axes%mask3d dl = diag%axes%decimation_level if (dl > 1) then - call decimate_diag_field(locfield, dl, diag_cs,isv,iev,jsv,jev) + isl=1; iel=size(field,1)/dl + jsl=1; jel=size(field,2)/dl + call decimate_diag_indices_get(iel,jel, dl, diag_cs,isv,iev,jsv,jev) + allocate(locfield_decim(isl:iel,jsl:jel,ks:ke)) + call decimate_diag_field_set(locfield, locfield_decim, dl,isl,iel,jsl,jel,ks,ke) + locfield => locfield_decim if (present(mask)) then - call decimate_diag_field(locmask, dl) + allocate(locmask_decim(isl:iel,jsl:jel,ks:ke)) + call decimate_diag_field_set(locmask, locmask_decim, dl,isl,iel,jsl,jel,ks,ke) + locmask => locmask_decim elseif (associated(diag%axes%decim(dl)%mask3d)) then diag_axes_mask3d => diag%axes%decim(dl)%mask3d endif @@ -3464,148 +3483,86 @@ subroutine decimate_diag_masks_set(G, nz, diag_cs) enddo end subroutine decimate_diag_masks_set - - -subroutine decimate_diag_field_2d(field, dl, diag_cs, isv,iev,jsv,jev) - real, pointer :: field(:,:) !< 2-d array being offered for output or averaging +subroutine decimate_diag_indices_get(f1,f2, dl, diag_cs,isv,iev,jsv,jev) + integer, intent(in) :: f1,f2 integer, intent(in) :: dl !< integer decimation level - type(diag_ctrl),optional, intent(in) :: diag_CS !< Structure used to regulate diagnostic output - integer, optional, intent(inout) ::isv,iev,jsv,jev - ! Local variables - integer :: dszi,cszi,dszj,cszj - character(len=300) :: mesg - - call decimate_sample(field, dl) - - if(present(diag_cs))then - cszi = diag_cs%decim(dl)%iec-diag_cs%decim(dl)%isc +1 ; dszi = diag_cs%decim(dl)%ied-diag_cs%decim(dl)%isd +1 - cszj = diag_cs%decim(dl)%jec-diag_cs%decim(dl)%jsc +1 ; dszj = diag_cs%decim(dl)%jed-diag_cs%decim(dl)%jsd +1 - - isv = diag_cs%decim(dl)%isc ; iev = diag_cs%decim(dl)%iec - jsv = diag_cs%decim(dl)%jsc ; jev = diag_cs%decim(dl)%jec - - if ( size(field,1) == dszi ) then - isv = diag_cs%decim(dl)%isc ; iev = diag_cs%decim(dl)%iec ! Data domain - elseif ( size(field,1) == dszi + 1 ) then - isv = diag_cs%decim(dl)%isc ; iev = diag_cs%decim(dl)%iec+1 ! Symmetric data domain - elseif ( size(field,1) == cszi) then - isv = 1 ; iev = (diag_cs%decim(dl)%iec-diag_cs%decim(dl)%isc) +1 ! Computational domain - elseif ( size(field,1) == cszi + 1 ) then - isv = 1 ; iev = (diag_cs%decim(dl)%iec-diag_cs%decim(dl)%isc) +2 ! Symmetric computational domain - else - write (mesg,*) " peculiar size ",size(field,1)," in i-direction\n"//& - "does not match one of ", cszi, cszi+1, dszi, dszi+1 - call MOM_error(FATAL,"decimate_diag_field: "//trim(mesg)) - endif - if ( size(field,2) == dszj ) then - jsv = diag_cs%decim(dl)%jsc ; jev = diag_cs%decim(dl)%jec ! Data domain - elseif ( size(field,2) == dszj + 1 ) then - jsv = diag_cs%decim(dl)%jsc ; jev = diag_cs%decim(dl)%jec+1 ! Symmetric data domain - elseif ( size(field,2) == cszj) then - jsv = 1 ; jev = (diag_cs%decim(dl)%jec-diag_cs%decim(dl)%jsc) +1 ! Computational domain - elseif ( size(field,2) == cszj + 1 ) then - jsv = 1 ; jev = (diag_cs%decim(dl)%jec-diag_cs%decim(dl)%jsc) +2 ! Symmetric computational domain - else - write (mesg,*) " peculiar size ",size(field,2)," in j-direction\n"//& - "does not match one of ", cszj, cszj+1, dszj, dszj+1 - call MOM_error(FATAL,"decimate_diag_field: "//trim(mesg)) - endif - endif - -end subroutine decimate_diag_field_2d - -subroutine decimate_diag_field_3d(field, dl, diag_cs, isv,iev,jsv,jev) - real, pointer :: field(:,:,:) !< 3-d array being offered for output or averaging - integer, intent(in) :: dl !< integer decimation level - type(diag_ctrl),optional, intent(in) :: diag_CS !< Structure used to regulate diagnostic output - integer, optional, intent(inout) ::isv,iev,jsv,jev + type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output + integer, intent(inout) ::isv,iev,jsv,jev ! Local variables integer :: dszi,cszi,dszj,cszj character(len=300) :: mesg - call decimate_sample(field, dl) - - if(present(diag_cs))then - cszi = diag_cs%decim(dl)%iec-diag_cs%decim(dl)%isc +1 ; dszi = diag_cs%decim(dl)%ied-diag_cs%decim(dl)%isd +1 - cszj = diag_cs%decim(dl)%jec-diag_cs%decim(dl)%jsc +1 ; dszj = diag_cs%decim(dl)%jed-diag_cs%decim(dl)%jsd +1 + cszi = diag_cs%decim(dl)%iec-diag_cs%decim(dl)%isc +1 ; dszi = diag_cs%decim(dl)%ied-diag_cs%decim(dl)%isd +1 + cszj = diag_cs%decim(dl)%jec-diag_cs%decim(dl)%jsc +1 ; dszj = diag_cs%decim(dl)%jed-diag_cs%decim(dl)%jsd +1 - isv = diag_cs%decim(dl)%isc ; iev = diag_cs%decim(dl)%iec - jsv = diag_cs%decim(dl)%jsc ; jev = diag_cs%decim(dl)%jec + isv = diag_cs%decim(dl)%isc ; iev = diag_cs%decim(dl)%iec + jsv = diag_cs%decim(dl)%jsc ; jev = diag_cs%decim(dl)%jec - if ( size(field,1) == dszi ) then - isv = diag_cs%decim(dl)%isc ; iev = diag_cs%decim(dl)%iec ! Data domain - elseif ( size(field,1) == dszi + 1 ) then - isv = diag_cs%decim(dl)%isc ; iev = diag_cs%decim(dl)%iec+1 ! Symmetric data domain - elseif ( size(field,1) == cszi) then - isv = 1 ; iev = (diag_cs%decim(dl)%iec-diag_cs%decim(dl)%isc) +1 ! Computational domain - elseif ( size(field,1) == cszi + 1 ) then - isv = 1 ; iev = (diag_cs%decim(dl)%iec-diag_cs%decim(dl)%isc) +2 ! Symmetric computational domain - else - write (mesg,*) " peculiar size ",size(field,1)," in i-direction\n"//& - "does not match one of ", cszi, cszi+1, dszi, dszi+1 - call MOM_error(FATAL,"decimate_diag_field: "//trim(mesg)) - endif - if ( size(field,2) == dszj ) then - jsv = diag_cs%decim(dl)%jsc ; jev = diag_cs%decim(dl)%jec ! Data domain - elseif ( size(field,2) == dszj + 1 ) then - jsv = diag_cs%decim(dl)%jsc ; jev = diag_cs%decim(dl)%jec+1 ! Symmetric data domain - elseif ( size(field,2) == cszj) then - jsv = 1 ; jev = (diag_cs%decim(dl)%jec-diag_cs%decim(dl)%jsc) +1 ! Computational domain - elseif ( size(field,2) == cszj + 1 ) then - jsv = 1 ; jev = (diag_cs%decim(dl)%jec-diag_cs%decim(dl)%jsc) +2 ! Symmetric computational domain - else - write (mesg,*) " peculiar size ",size(field,2)," in j-direction\n"//& - "does not match one of ", cszj, cszj+1, dszj, dszj+1 - call MOM_error(FATAL,"decimate_diag_field: "//trim(mesg)) - endif - endif - -end subroutine decimate_diag_field_3d + if ( f1 == dszi ) then + isv = diag_cs%decim(dl)%isc ; iev = diag_cs%decim(dl)%iec ! Data domain + elseif ( f1 == dszi + 1 ) then + isv = diag_cs%decim(dl)%isc ; iev = diag_cs%decim(dl)%iec+1 ! Symmetric data domain + elseif ( f1 == cszi) then + isv = 1 ; iev = (diag_cs%decim(dl)%iec-diag_cs%decim(dl)%isc) +1 ! Computational domain + elseif ( f1 == cszi + 1 ) then + isv = 1 ; iev = (diag_cs%decim(dl)%iec-diag_cs%decim(dl)%isc) +2 ! Symmetric computational domain + else + write (mesg,*) " peculiar size ",f1," in i-direction\n"//& + "does not match one of ", cszi, cszi+1, dszi, dszi+1 + call MOM_error(FATAL,"decimate_diag_field: "//trim(mesg)) + endif + if ( f2 == dszj ) then + jsv = diag_cs%decim(dl)%jsc ; jev = diag_cs%decim(dl)%jec ! Data domain + elseif ( f2 == dszj + 1 ) then + jsv = diag_cs%decim(dl)%jsc ; jev = diag_cs%decim(dl)%jec+1 ! Symmetric data domain + elseif ( f2 == cszj) then + jsv = 1 ; jev = (diag_cs%decim(dl)%jec-diag_cs%decim(dl)%jsc) +1 ! Computational domain + elseif ( f2 == cszj + 1 ) then + jsv = 1 ; jev = (diag_cs%decim(dl)%jec-diag_cs%decim(dl)%jsc) +2 ! Symmetric computational domain + else + write (mesg,*) " peculiar size ",f2," in j-direction\n"//& + "does not match one of ", cszj, cszj+1, dszj, dszj+1 + call MOM_error(FATAL,"decimate_diag_field: "//trim(mesg)) + endif +end subroutine decimate_diag_indices_get + -subroutine decimate_sample_3d(field_in, level) - integer , intent(in) :: level - real, dimension(:,:,:) , pointer :: field_in, field_out +subroutine decimate_diag_field_set_3d(field_in, field_out, level ,isl,iel,jsl,jel,ks,ke) + real, dimension(:,:,:) , pointer :: field_in + real, dimension(:,:,:) , intent(inout) :: field_out + integer , intent(in) :: level, iel,jel,ks,ke + integer , intent(inout) :: isl,jsl integer :: i,j,ii,jj,is,js - integer :: isl,iel,jsl,jel - integer :: k,ks,ke - ! is = lbound(field_in,1) ; ie = ubound(field_in,1) - ! js = lbound(field_in,2) ; je = ubound(field_in,2) + integer :: k + !Always start from the first element - is=1 - js=1 - ks = lbound(field_in,3) ; ke = ubound(field_in,3) - isl=1; iel=size(field_in,1)/level - jsl=1; jel=size(field_in,2)/level - allocate(field_out(isl:iel,jsl:jel,ks:ke)) + is=1; isl=1 + js=1; jsl=1 do k= ks,ke ; do j=jsl,jel ; do i=isl,iel ii = is+level*(i-isl) jj = js+level*(j-jsl) field_out(i,j,k) = field_in(ii,jj,k) enddo; enddo; enddo - field_in => field_out -end subroutine decimate_sample_3d +end subroutine decimate_diag_field_set_3d -subroutine decimate_sample_2d(field_in, level) - integer , intent(in) :: level - real, dimension(:,:) , pointer :: field_in, field_out +subroutine decimate_diag_field_set_2d(field_in, field_out, level ,isl,iel,jsl,jel) + real, dimension(:,:) , pointer :: field_in + real, dimension(:,:), intent(inout) :: field_out + integer , intent(in) :: level, iel,jel + integer , intent(inout) :: isl,jsl integer :: i,j,ii,jj,is,js - integer :: isl,iel,jsl,jel - ! is = lbound(field_in,1) ; ie = ubound(field_in,1) - ! js = lbound(field_in,2) ; je = ubound(field_in,2) + !Always start from the first element - is=1 - js=1 - isl=1; iel=size(field_in,1)/level - jsl=1; jel=size(field_in,2)/level - allocate(field_out(isl:iel,jsl:jel)) + is=1; isl=1 + js=1; jsl=1 do j=jsl,jel ; do i=isl,iel ii = is+level*(i-isl) jj = js+level*(j-jsl) field_out(i,j) = field_in(ii,jj) enddo; enddo - field_in => field_out -end subroutine decimate_sample_2d +end subroutine decimate_diag_field_set_2d + subroutine decimate_sample_3d_out(field_in, field_out, level) integer , intent(in) :: level From f919444882e0f7a7849962b73defec01166508b9 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Mon, 1 Oct 2018 14:57:39 -0600 Subject: [PATCH 0763/1072] fix divide by error if Kd=0.0 --- src/parameterizations/vertical/MOM_bkgnd_mixing.F90 | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 19fffa99af..303e912bd0 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -179,7 +179,12 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) - prandtl_bkgnd_default = Kv/CS%Kd + if (CS%Kd == 0.0) then + prandtl_bkgnd_default = 0.0 + else + prandtl_bkgnd_default = Kv/CS%Kd + endif + call get_param(param_file, mdl, "PRANDTL_BKGND", CS%prandtl_bkgnd, & "Turbulent Prandtl number used to convert vertical \n"//& "background diffusivities into viscosities.", & @@ -269,7 +274,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) "Harrison & Hallberg, JPO 2008.", default=.false.) if (CS%Henyey_IGW_background_new) call check_bkgnd_scheme(CS, "HENYEY_IGW_BACKGROUND_NEW") - if (CS%Kd>1.e-14 .and. (trim(CS%bkgnd_scheme_str)=="BRYAN_LEWIS_DIFFUSIVITY" .or.& + if (CS%Kd>0.0 .and. (trim(CS%bkgnd_scheme_str)=="BRYAN_LEWIS_DIFFUSIVITY" .or.& trim(CS%bkgnd_scheme_str)=="HORIZ_VARYING_BACKGROUND" )) then call MOM_error(WARNING, "set_diffusivity_init: a nonzero constant background "//& "diffusivity (KD) is specified along with "//trim(CS%bkgnd_scheme_str)) From caec6dd276d17b50c206d71720f83ab1dbd8bdf9 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Mon, 1 Oct 2018 17:50:31 -0600 Subject: [PATCH 0764/1072] read prandtl_bkgnd only for cvmix or horiz_varying_background --- .../vertical/MOM_bkgnd_mixing.F90 | 37 ++++++++++--------- 1 file changed, 20 insertions(+), 17 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 303e912bd0..731af2953d 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -179,23 +179,6 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) - if (CS%Kd == 0.0) then - prandtl_bkgnd_default = 0.0 - else - prandtl_bkgnd_default = Kv/CS%Kd - endif - - call get_param(param_file, mdl, "PRANDTL_BKGND", CS%prandtl_bkgnd, & - "Turbulent Prandtl number used to convert vertical \n"//& - "background diffusivities into viscosities.", & - units="nondim", default=prandtl_bkgnd_default) - - if ( abs(Kv-CS%Kd*CS%prandtl_bkgnd)>1.e-14) then - call MOM_error(FATAL,"set_diffusivity_init: The provided KD, KV,"//& - "and PRANDTL_BKGND values are incompatible. The following "//& - "must hold: KD*PRANDTL_BKGND==KV") - endif - ! call openParameterBlock(param_file,'MOM_BACKGROUND_MIXING') call get_param(param_file, mdl, "BRYAN_LEWIS_DIFFUSIVITY", & @@ -259,6 +242,26 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) units="m2 s-1",default = 1.0e-4) endif + prandtl_bkgnd_default = 1.0 + CS%prandtl_bkgnd = prandtl_bkgnd_default + + if (CS%Bryan_Lewis_diffusivity .or. CS%horiz_varying_background) then + + if (CS%Kd /= 0.0) prandtl_bkgnd_default = Kv/CS%Kd + + call get_param(param_file, mdl, "PRANDTL_BKGND", CS%prandtl_bkgnd, & + "Turbulent Prandtl number used to convert vertical \n"//& + "background diffusivities into viscosities.", & + units="nondim", default=prandtl_bkgnd_default) + + if ( abs(Kv-CS%Kd*CS%prandtl_bkgnd)>1.e-14) then + call MOM_error(FATAL,"set_diffusivity_init: The provided KD, KV,"//& + "and PRANDTL_BKGND values are incompatible. The following "//& + "must hold: KD*PRANDTL_BKGND==KV") + endif + + endif + call get_param(param_file, mdl, "HENYEY_IGW_BACKGROUND", & CS%Henyey_IGW_background, & "If true, use a latitude-dependent scaling for the near \n"//& From 3714a39552402dafeb2dd3df6583b63d36020e0e Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Mon, 1 Oct 2018 17:54:59 -0600 Subject: [PATCH 0765/1072] un-indent subroutines --- config_src/mct_driver/ocn_cap_methods.F90 | 448 +++++++++++----------- 1 file changed, 224 insertions(+), 224 deletions(-) diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 33dbc5b36a..1c49accdd3 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -21,238 +21,238 @@ module ocn_cap_methods contains !======================================================================= - !> Maps incomping ocean data to MOM6 data structures - subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, Eclock, c1, c2, c3, c4) - real(kind=8) , intent(in) :: x2o(:,:) !< incoming data - type(cpl_indices_type) , intent(in) :: ind !< Structure with MCT attribute vects and indices - type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid - type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing - type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state - integer , intent(in) :: logunit !< Unit for stdout output - type(ESMF_Clock) , intent(in) :: EClock !< Time and time step ? \todo Why must this - real(kind=8), optional , intent(in) :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition - - ! Local variables - integer :: i, j, ig, jg, isc, iec, jsc, jec ! Grid indices - integer :: k - integer :: day, secs, rc - type(ESMF_time) :: currTime - character(*), parameter :: F01 = "('(ocn_import) ',a,4(i6,2x),d21.14)" - !----------------------------------------------------------------------- - - isc = GRID%isc; iec = GRID%iec ; jsc = GRID%jsc; jec = GRID%jec - - k = 0 - do j = jsc, jec - jg = j + grid%jsc - jsc - do i = isc, iec - ig = i + grid%jsc - isc - k = k + 1 ! Increment position within gindex - - ! taux - ice_ocean_boundary%u_flux(i,j) = x2o(ind%x2o_Foxx_taux,k) - - ! tauy - ice_ocean_boundary%v_flux(i,j) = x2o(ind%x2o_Foxx_tauy,k) - - ! liquid precipitation (rain) - ice_ocean_boundary%lprec(i,j) = x2o(ind%x2o_Faxa_rain,k) - - ! frozen precipitation (snow) - ice_ocean_boundary%fprec(i,j) = x2o(ind%x2o_Faxa_snow,k) - - ! longwave radiation, sum up and down (W/m2) - ice_ocean_boundary%lw_flux(i,j) = (x2o(ind%x2o_Faxa_lwdn,k) + x2o(ind%x2o_Foxx_lwup,k)) - - ! specific humitidy flux - ice_ocean_boundary%q_flux(i,j) = x2o(ind%x2o_Foxx_evap,k) !???TODO: should this be a minus sign - - ! sensible heat flux (W/m2) - ice_ocean_boundary%t_flux(i,j) = x2o(ind%x2o_Foxx_sen,k) !???TODO: should this be a minus sign - - ! latent heat flux (W/m^2) - ice_ocean_boundary%latent_flux(i,j) = x2o(ind%x2o_Foxx_lat,k) !???TODO: should this be a minus sign - - ! liquid runoff - ice_ocean_boundary%rofl_flux(i,j) = x2o(ind%x2o_Foxx_rofl,k) * GRID%mask2dT(ig,jg) - - ! ice runoff - ice_ocean_boundary%rofi_flux(i,j) = x2o(ind%x2o_Foxx_rofi,k) * GRID%mask2dT(ig,jg) - - ! surface pressure - ice_ocean_boundary%p(i,j) = x2o(ind%x2o_Sa_pslv,k) * GRID%mask2dT(ig,jg) - - ! salt flux - ice_ocean_boundary%salt_flux(i,j) = x2o(ind%x2o_Fioi_salt,k) * GRID%mask2dT(ig,jg) - - ! 1) visible, direct shortwave (W/m2) - ! 2) visible, diffuse shortwave (W/m2) - ! 3) near-IR, direct shortwave (W/m2) - ! 4) near-IR, diffuse shortwave (W/m2) - if (present(c1) .and. present(c2) .and. present(c3) .and. present(c4)) then - ! Use runtime coefficients to decompose net short-wave heat flux into 4 components - ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c1 * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c2 * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c3 * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c4 * GRID%mask2dT(ig,jg) - else - ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Faxa_swvdr,k) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Faxa_swvdf,k) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Faxa_swndr,k) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Faxa_swndf,k) * GRID%mask2dT(ig,jg) - end if - end do +!> Maps incomping ocean data to MOM6 data structures +subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, Eclock, c1, c2, c3, c4) + real(kind=8) , intent(in) :: x2o(:,:) !< incoming data + type(cpl_indices_type) , intent(in) :: ind !< Structure with MCT attribute vects and indices + type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid + type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing + type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state + integer , intent(in) :: logunit !< Unit for stdout output + type(ESMF_Clock) , intent(in) :: EClock !< Time and time step ? \todo Why must this + real(kind=8), optional , intent(in) :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition + + ! Local variables + integer :: i, j, ig, jg, isc, iec, jsc, jec ! Grid indices + integer :: k + integer :: day, secs, rc + type(ESMF_time) :: currTime + character(*), parameter :: F01 = "('(ocn_import) ',a,4(i6,2x),d21.14)" + !----------------------------------------------------------------------- + + isc = GRID%isc; iec = GRID%iec ; jsc = GRID%jsc; jec = GRID%jec + + k = 0 + do j = jsc, jec + jg = j + grid%jsc - jsc + do i = isc, iec + ig = i + grid%jsc - isc + k = k + 1 ! Increment position within gindex + + ! taux + ice_ocean_boundary%u_flux(i,j) = x2o(ind%x2o_Foxx_taux,k) + + ! tauy + ice_ocean_boundary%v_flux(i,j) = x2o(ind%x2o_Foxx_tauy,k) + + ! liquid precipitation (rain) + ice_ocean_boundary%lprec(i,j) = x2o(ind%x2o_Faxa_rain,k) + + ! frozen precipitation (snow) + ice_ocean_boundary%fprec(i,j) = x2o(ind%x2o_Faxa_snow,k) + + ! longwave radiation, sum up and down (W/m2) + ice_ocean_boundary%lw_flux(i,j) = (x2o(ind%x2o_Faxa_lwdn,k) + x2o(ind%x2o_Foxx_lwup,k)) + + ! specific humitidy flux + ice_ocean_boundary%q_flux(i,j) = x2o(ind%x2o_Foxx_evap,k) !???TODO: should this be a minus sign + + ! sensible heat flux (W/m2) + ice_ocean_boundary%t_flux(i,j) = x2o(ind%x2o_Foxx_sen,k) !???TODO: should this be a minus sign + + ! latent heat flux (W/m^2) + ice_ocean_boundary%latent_flux(i,j) = x2o(ind%x2o_Foxx_lat,k) !???TODO: should this be a minus sign + + ! liquid runoff + ice_ocean_boundary%rofl_flux(i,j) = x2o(ind%x2o_Foxx_rofl,k) * GRID%mask2dT(ig,jg) + + ! ice runoff + ice_ocean_boundary%rofi_flux(i,j) = x2o(ind%x2o_Foxx_rofi,k) * GRID%mask2dT(ig,jg) + + ! surface pressure + ice_ocean_boundary%p(i,j) = x2o(ind%x2o_Sa_pslv,k) * GRID%mask2dT(ig,jg) + + ! salt flux + ice_ocean_boundary%salt_flux(i,j) = x2o(ind%x2o_Fioi_salt,k) * GRID%mask2dT(ig,jg) + + ! 1) visible, direct shortwave (W/m2) + ! 2) visible, diffuse shortwave (W/m2) + ! 3) near-IR, direct shortwave (W/m2) + ! 4) near-IR, diffuse shortwave (W/m2) + if (present(c1) .and. present(c2) .and. present(c3) .and. present(c4)) then + ! Use runtime coefficients to decompose net short-wave heat flux into 4 components + ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c1 * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c2 * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c3 * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c4 * GRID%mask2dT(ig,jg) + else + ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Faxa_swvdr,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Faxa_swvdf,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Faxa_swndr,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Faxa_swndf,k) * GRID%mask2dT(ig,jg) + end if end do - - if (debug .and. is_root_pe()) then - call ESMF_ClockGet(EClock, CurrTime=CurrTime, rc=rc) - call ESMF_TimeGet(CurrTime, d=day, s=secs, rc=rc) - - do j = GRID%jsc, GRID%jec - do i = GRID%isc, GRID%iec - write(logunit,F01)'import: day, secs, j, i, u_flux = ',day,secs,j,i,ice_ocean_boundary%u_flux(i,j) - write(logunit,F01)'import: day, secs, j, i, v_flux = ',day,secs,j,i,ice_ocean_boundary%v_flux(i,j) - write(logunit,F01)'import: day, secs, j, i, lprec = ',day,secs,j,i,ice_ocean_boundary%lprec(i,j) - write(logunit,F01)'import: day, secs, j, i, lwrad = ',day,secs,j,i,ice_ocean_boundary%lw_flux(i,j) - write(logunit,F01)'import: day, secs, j, i, q_flux = ',day,secs,j,i,ice_ocean_boundary%q_flux(i,j) - write(logunit,F01)'import: day, secs, j, i, t_flux = ',day,secs,j,i,ice_ocean_boundary%t_flux(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 = ',& - day,secs,j,i,ice_ocean_boundary%p(i,j) - write(logunit,F01)'import: day, secs, j, i, salt_flux = ',& - day,secs,j,i,ice_ocean_boundary%salt_flux(i,j) - write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dir = ',& - day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dir(i,j) - write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dif = ',& - day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dif(i,j) - write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dir = ',& - day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i,j) - write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dif = ',& - day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i,j) - end do - end do - end if - - end subroutine ocn_import - -!======================================================================= - - !> Maps outgoing ocean data to MCT attribute vector real array - subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) - type(cpl_indices_type), intent(inout) :: ind !< Structure with coupler indices and vectors - type(ocean_public_type), intent(in) :: ocn_public !< Ocean surface state - type(ocean_grid_type), intent(in) :: grid !< Ocean model grid - real(kind=8), intent(inout) :: o2x(:,:) !< MCT outgoing bugger - real(kind=8), intent(in) :: dt_int !< Amount of time over which to advance the - !! ocean (ocean_coupling_time_step), in sec - integer, intent(in) :: ncouple_per_day !< Number of ocean coupling calls per day - - ! Local variables - real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo - integer :: i, j, n, ig, jg !< Grid indices - real :: slp_L, slp_R, slp_C, slope, u_min, u_max - real :: I_time_int !< The inverse of coupling time interval in s-1. - - !----------------------------------------------------------------------- - - ! Use Adcroft's rule of reciprocals; it does the right thing here. - I_time_int = 0.0 ; if (dt_int > 0.0) I_time_int = 1.0 / dt_int - - ! Copy from ocn_public to o2x. ocn_public uses global indexing with no halos. - ! The mask comes from "grid" that uses the usual MOM domain that has halos - ! and does not use global indexing. - - n = 0 - do j=grid%jsc, grid%jec - jg = j + grid%jdg_offset - do i=grid%isc,grid%iec - n = n+1 - ig = i + grid%idg_offset - ! surface temperature in Kelvin - o2x(ind%o2x_So_t, n) = ocn_public%t_surf(ig,jg) * grid%mask2dT(i,j) - o2x(ind%o2x_So_s, n) = ocn_public%s_surf(ig,jg) * grid%mask2dT(i,j) - o2x(ind%o2x_So_u, n) = ocn_public%u_surf(ig,jg) * grid%mask2dT(i,j) - o2x(ind%o2x_So_v, n) = ocn_public%v_surf(ig,jg) * grid%mask2dT(i,j) - o2x(ind%o2x_So_bldepth, n) = ocn_public%OBLD(ig,jg) * grid%mask2dT(i,j) - ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 - if (ocn_public%frazil(ig,jg) > 0.0) then - ! Frazil: change from J/m^2 to W/m^2 - o2x(ind%o2x_Fioo_q, n) = ocn_public%frazil(ig,jg) * grid%mask2dT(i,j) * I_time_int - else - ! Melt_potential: change from J/m^2 to W/m^2 - o2x(ind%o2x_Fioo_q, n) = -ocn_public%melt_potential(ig,jg) * grid%mask2dT(i,j) * I_time_int !* ncouple_per_day - ! make sure Melt_potential is always <= 0 - if (o2x(ind%o2x_Fioo_q, n) > 0.0) o2x(ind%o2x_Fioo_q, n) = 0.0 - endif - ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain - ! in order to update halos. i.e. does not use global indexing. - ssh(i,j) = ocn_public%sea_lev(ig,jg) + end do + + if (debug .and. is_root_pe()) then + call ESMF_ClockGet(EClock, CurrTime=CurrTime, rc=rc) + call ESMF_TimeGet(CurrTime, d=day, s=secs, rc=rc) + + do j = GRID%jsc, GRID%jec + do i = GRID%isc, GRID%iec + write(logunit,F01)'import: day, secs, j, i, u_flux = ',day,secs,j,i,ice_ocean_boundary%u_flux(i,j) + write(logunit,F01)'import: day, secs, j, i, v_flux = ',day,secs,j,i,ice_ocean_boundary%v_flux(i,j) + write(logunit,F01)'import: day, secs, j, i, lprec = ',day,secs,j,i,ice_ocean_boundary%lprec(i,j) + write(logunit,F01)'import: day, secs, j, i, lwrad = ',day,secs,j,i,ice_ocean_boundary%lw_flux(i,j) + write(logunit,F01)'import: day, secs, j, i, q_flux = ',day,secs,j,i,ice_ocean_boundary%q_flux(i,j) + write(logunit,F01)'import: day, secs, j, i, t_flux = ',day,secs,j,i,ice_ocean_boundary%t_flux(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 = ',& + day,secs,j,i,ice_ocean_boundary%p(i,j) + write(logunit,F01)'import: day, secs, j, i, salt_flux = ',& + day,secs,j,i,ice_ocean_boundary%salt_flux(i,j) + write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dir = ',& + day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dir(i,j) + write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dif = ',& + day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dif(i,j) + write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dir = ',& + day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i,j) + write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dif = ',& + day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i,j) end do end do + end if - ! Update halo of ssh so we can calculate gradients - call pass_var(ssh, grid%domain) +end subroutine ocn_import - ! d/dx ssh - n = 0 - do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec - n = n+1 - ! This is a simple second-order difference - ! o2x(ind%o2x_So_dhdx, n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) - if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. - slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(I,j) - if (grid%mask2dCu(I+1,j)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - if ( (slp_L * slp_R) > 0.0 ) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - o2x(ind%o2x_So_dhdx, n) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdx, n) = 0.0 - end do; end do +!======================================================================= - ! d/dy ssh - n = 0 - do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec +!> Maps outgoing ocean data to MCT attribute vector real array +subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) + type(cpl_indices_type), intent(inout) :: ind !< Structure with coupler indices and vectors + type(ocean_public_type), intent(in) :: ocn_public !< Ocean surface state + type(ocean_grid_type), intent(in) :: grid !< Ocean model grid + real(kind=8), intent(inout) :: o2x(:,:) !< MCT outgoing bugger + real(kind=8), intent(in) :: dt_int !< Amount of time over which to advance the + !! ocean (ocean_coupling_time_step), in sec + integer, intent(in) :: ncouple_per_day !< Number of ocean coupling calls per day + + ! Local variables + real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo + integer :: i, j, n, ig, jg !< Grid indices + real :: slp_L, slp_R, slp_C, slope, u_min, u_max + real :: I_time_int !< The inverse of coupling time interval in s-1. + + !----------------------------------------------------------------------- + + ! Use Adcroft's rule of reciprocals; it does the right thing here. + I_time_int = 0.0 ; if (dt_int > 0.0) I_time_int = 1.0 / dt_int + + ! Copy from ocn_public to o2x. ocn_public uses global indexing with no halos. + ! The mask comes from "grid" that uses the usual MOM domain that has halos + ! and does not use global indexing. + + n = 0 + do j=grid%jsc, grid%jec + jg = j + grid%jdg_offset + do i=grid%isc,grid%iec n = n+1 - ! This is a simple second-order difference - ! o2x(ind%o2x_So_dhdy, n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) - if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. - - slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,J) - if (grid%mask2dCv(i,J+1)==0.) slp_R = 0. - - slp_C = 0.5 * (slp_L + slp_R) - !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R - if ((slp_L * slp_R) > 0.0) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + ig = i + grid%idg_offset + ! surface temperature in Kelvin + o2x(ind%o2x_So_t, n) = ocn_public%t_surf(ig,jg) * grid%mask2dT(i,j) + o2x(ind%o2x_So_s, n) = ocn_public%s_surf(ig,jg) * grid%mask2dT(i,j) + o2x(ind%o2x_So_u, n) = ocn_public%u_surf(ig,jg) * grid%mask2dT(i,j) + o2x(ind%o2x_So_v, n) = ocn_public%v_surf(ig,jg) * grid%mask2dT(i,j) + o2x(ind%o2x_So_bldepth, n) = ocn_public%OBLD(ig,jg) * grid%mask2dT(i,j) + ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 + if (ocn_public%frazil(ig,jg) > 0.0) then + ! Frazil: change from J/m^2 to W/m^2 + o2x(ind%o2x_Fioo_q, n) = ocn_public%frazil(ig,jg) * grid%mask2dT(i,j) * I_time_int else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - o2x(ind%o2x_So_dhdy, n) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdy, n) = 0.0 - end do; end do + ! Melt_potential: change from J/m^2 to W/m^2 + o2x(ind%o2x_Fioo_q, n) = -ocn_public%melt_potential(ig,jg) * grid%mask2dT(i,j) * I_time_int !* ncouple_per_day + ! make sure Melt_potential is always <= 0 + if (o2x(ind%o2x_Fioo_q, n) > 0.0) o2x(ind%o2x_Fioo_q, n) = 0.0 + endif + ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain + ! in order to update halos. i.e. does not use global indexing. + ssh(i,j) = ocn_public%sea_lev(ig,jg) + end do + end do + + ! Update halo of ssh so we can calculate gradients + call pass_var(ssh, grid%domain) + + ! d/dx ssh + n = 0 + do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec + n = n+1 + ! This is a simple second-order difference + ! o2x(ind%o2x_So_dhdx, n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) + if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(I,j) + if (grid%mask2dCu(I+1,j)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + if ( (slp_L * slp_R) > 0.0 ) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + o2x(ind%o2x_So_dhdx, n) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdx, n) = 0.0 + end do; end do + + ! d/dy ssh + n = 0 + do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec + n = n+1 + ! This is a simple second-order difference + ! o2x(ind%o2x_So_dhdy, n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) + if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. + + slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,J) + if (grid%mask2dCv(i,J+1)==0.) slp_R = 0. + + slp_C = 0.5 * (slp_L + slp_R) + !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R + if ((slp_L * slp_R) > 0.0) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + o2x(ind%o2x_So_dhdy, n) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdy, n) = 0.0 + end do; end do - end subroutine ocn_export +end subroutine ocn_export end module ocn_cap_methods From 4306feb4b6f6c0b8a5ce62a145fcf2b037f3ff92 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Mon, 1 Oct 2018 18:01:07 -0600 Subject: [PATCH 0766/1072] end if to endif and end do to enddo --- config_src/mct_driver/ocn_cap_methods.F90 | 24 +++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 1c49accdd3..95fd084bdc 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -100,9 +100,9 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Faxa_swvdf,k) * GRID%mask2dT(ig,jg) ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Faxa_swndr,k) * GRID%mask2dT(ig,jg) ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Faxa_swndf,k) * GRID%mask2dT(ig,jg) - end if - end do - end do + endif + enddo + enddo if (debug .and. is_root_pe()) then call ESMF_ClockGet(EClock, CurrTime=CurrTime, rc=rc) @@ -132,9 +132,9 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i,j) write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dif = ',& day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i,j) - end do - end do - end if + enddo + enddo + endif end subroutine ocn_import @@ -190,8 +190,8 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain ! in order to update halos. i.e. does not use global indexing. ssh(i,j) = ocn_public%sea_lev(ig,jg) - end do - end do + enddo + enddo ! Update halo of ssh so we can calculate gradients call pass_var(ssh, grid%domain) @@ -218,10 +218,10 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) ! Extrema in the mean values require a PCM reconstruction avoid generating ! larger extreme values. slope = 0.0 - end if + endif o2x(ind%o2x_So_dhdx, n) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdx, n) = 0.0 - end do; end do + enddo; enddo ! d/dy ssh n = 0 @@ -248,10 +248,10 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) ! Extrema in the mean values require a PCM reconstruction avoid generating ! larger extreme values. slope = 0.0 - end if + endif o2x(ind%o2x_So_dhdy, n) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdy, n) = 0.0 - end do; end do + enddo; enddo end subroutine ocn_export From 6aecaf77b882194dc6dbba6309337b6d55306b3c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 2 Oct 2018 14:03:43 -0400 Subject: [PATCH 0767/1072] Rescale MOM_continuity_PPM variables via get_param Rescale MOM_continuity_PPM variables from m to Z directly in the get_param calls that read them. All answers are bitwise identical. --- src/core/MOM_continuity_PPM.F90 | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index faa5ec79e2..bdf6e3f9b1 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -2221,6 +2221,7 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) type(continuity_PPM_CS), pointer :: CS !< Module's control structure. !> This include declares and sets the variable "version". #include "version_variable.h" + real :: tol_eta_m ! An unscaled version of tol_eta, in m. character(len=40) :: mdl = "MOM_continuity_PPM" ! This module's name. if (associated(CS)) then @@ -2254,8 +2255,8 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) "height due to the fluxes through each face. The total \n"//& "tolerance for SSH is 4 times this value. The default \n"//& "is 0.5*NK*ANGSTROM, and this should not be set less x\n"//& - "than about 10^-15*MAXIMUM_DEPTH.", units="m", & - default=0.5*G%ke*GV%Angstrom_m) + "than about 10^-15*MAXIMUM_DEPTH.", units="m", scale=GV%m_to_H, & + default=0.5*G%ke*GV%Angstrom_m, unscaled=tol_eta_m) call get_param(param_file, mdl, "ETA_TOLERANCE_AUX", CS%tol_eta_aux, & "The tolerance for free-surface height discrepancies \n"//& @@ -2263,7 +2264,7 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) "layer thicknesses when calculating the auxiliary \n"//& "corrected velocities. By default, this is the same as \n"//& "ETA_TOLERANCE, but can be made larger for efficiency.", & - units="m", default=CS%tol_eta) + units="m", default=tol_eta_m, scale=GV%m_to_H) call get_param(param_file, mdl, "VELOCITY_TOLERANCE", CS%tol_vel, & "The tolerance for barotropic velocity discrepancies \n"//& "between the barotropic solution and the sum of the \n"//& @@ -2299,9 +2300,6 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) id_clock_update = cpu_clock_id('(Ocean continuity update)', grain=CLOCK_ROUTINE) id_clock_correct = cpu_clock_id('(Ocean continuity correction)', grain=CLOCK_ROUTINE) - CS%tol_eta = CS%tol_eta * GV%m_to_H - CS%tol_eta_aux = CS%tol_eta_aux * GV%m_to_H - end subroutine continuity_PPM_init !> continuity_PPM_stencil returns the continuity solver stencil size From d6ada47d02b887bcaa929b3124603a0904efe445 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 2 Oct 2018 14:04:39 -0400 Subject: [PATCH 0768/1072] Do MOM_tidal_mixing calculations in units of Z Rescaled several of the variables in MOM_tidal_mixing to work in units of Z instead of m, for expanded dimensional consistency testing. Also updated the comments describing several variables. All answers are bitwise identical. --- .../vertical/MOM_tidal_mixing.F90 | 91 +++++++++---------- 1 file changed, 45 insertions(+), 46 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index cc6d73e3eb..a9937219ea 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -84,7 +84,7 @@ module MOM_tidal_mixing !! for dissipation of the lee waves. Schemes that are !! currently encoded are St Laurent et al (2002) and !! Polzin (2009). - real :: Int_tide_decay_scale !< decay scale for internal wave TKE (meter) + real :: Int_tide_decay_scale !< decay scale for internal wave TKE (Z) real :: Mu_itides !< efficiency for conversion of dissipation !! to potential energy (nondimensional) @@ -115,7 +115,7 @@ module MOM_tidal_mixing !! profile in Polzin formulation should not exceed !! Polzin_decay_scale_max_factor * depth of the ocean (nondimensional). real :: Polzin_min_decay_scale !< minimum decay scale of the tidal dissipation - !! profile in Polzin formulation (meter) + !! profile in Polzin formulation (Z) real :: TKE_itide_max !< maximum internal tide conversion (W m-2) !! available to mix above the BBL @@ -378,7 +378,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, "When the Polzin decay profile is used, this is the \n"//& "minimum vertical decay scale for the vertical profile\n"//& "of internal tide dissipation with the Polzin (2009) formulation", & - units="m", default=0.0) + units="m", default=0.0, scale=GV%m_to_Z) endif if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation) then @@ -386,7 +386,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, "The decay scale away from the bottom for tidal TKE with \n"//& "the new coding when INT_TIDE_DISSIPATION is used.", & !units="m", default=0.0) - units="m", default=500.0) ! TODO: confirm this new default + units="m", default=500.0, scale=GV%m_to_Z) ! TODO: confirm this new default call get_param(param_file, mdl, "MU_ITIDES", CS%Mu_itides, & "A dimensionless turbulent mixing efficiency used with \n"//& "INT_TIDE_DISSIPATION, often 0.2.", units="nondim", default=0.2) @@ -543,7 +543,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, call CVMix_init_tidal(CVmix_tidal_params_user = CS%CVMix_tidal_params, & mix_scheme = CVMix_tidal_scheme_str, & efficiency = CS%Mu_itides, & - vertical_decay_scale = CS%int_tide_decay_scale, & + vertical_decay_scale = CS%int_tide_decay_scale*GV%Z_to_m, & max_coefficient = CS%tidal_max_coef, & local_mixing_frac = CS%Gamma_itides, & depth_cutoff = CS%min_zbot_itides) @@ -772,13 +772,13 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) CVMix_tidal_params_user = CS%CVMix_tidal_params) ! Update diffusivity - do k=1,G%ke + do k=1,G%ke ! GV%m_to_Z**2 * Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_tidal(k) + Kd_tidal(k+1) ) enddo ! Update viscosity if (associated(Kv)) then - do k=1,G%ke+1 + do k=1,G%ke+1 ! GV%m_to_Z**2 * Kv(i,j,k) = Kv(i,j,k) + Kv_tidal(k) enddo endif @@ -871,13 +871,13 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) CVmix_tidal_params_user = CS%CVMix_tidal_params) ! Update diffusivity - do k=1,G%ke + do k=1,G%ke ! GV%m_to_Z**2 * Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_tidal(k) + Kd_tidal(k+1) ) enddo ! Update viscosity if (associated(Kv)) then - do k=1,G%ke+1 + do k=1,G%ke+1 ! GV%m_to_Z**2 * Kv(i,j,k) = Kv(i,j,k) + Kv_tidal(k) enddo endif @@ -947,16 +947,16 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, real, dimension(SZI_(G)) :: & htot, & ! total thickness above or below a layer, or the - ! integrated thickness in the BBL (meter) - htot_WKB, & ! distance from top to bottom (meter) WKB scaled + ! integrated thickness in the BBL (Z) + htot_WKB, & ! distance from top to bottom (Z) WKB scaled TKE_itidal_bot, & ! internal tide TKE at ocean bottom (m3/s3) TKE_Niku_bot, & ! lee-wave TKE at ocean bottom (m3/s3) TKE_lowmode_bot, & ! internal tide TKE at ocean bottom lost from all remote low modes (m3/s3) (BDM) Inv_int, & ! inverse of TKE decay for int tide over the depth of the ocean (nondim) Inv_int_lee, & ! inverse of TKE decay for lee waves over the depth of the ocean (nondim) Inv_int_low, & ! inverse of TKE decay for low modes over the depth of the ocean (nondim) (BDM) - z0_Polzin, & ! TKE decay scale in Polzin formulation (meter) - z0_Polzin_scaled, & ! TKE decay scale in Polzin formulation (meter) + z0_Polzin, & ! TKE decay scale in Polzin formulation (Z) + z0_Polzin_scaled, & ! TKE decay scale in Polzin formulation (Z) ! multiplied by N2_bot/N2_meanz to be coherent with the WKB scaled z ! z*=int(N2/N2_bot) * N2_bot/N2_meanz = int(N2/N2_meanz) ! z0_Polzin_scaled = z0_Polzin * N2_bot/N2_meanz @@ -968,8 +968,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, TKE_frac_top_lee, & ! fraction of bottom TKE that should appear at top of a layer (nondim) TKE_frac_top_lowmode, & ! fraction of bottom TKE that should appear at top of a layer (nondim) (BDM) - z_from_bot, & ! distance from bottom (meter) - z_from_bot_WKB ! distance from bottom (meter), WKB scaled + z_from_bot, & ! distance from bottom (Z) + z_from_bot_WKB ! distance from bottom (Z), WKB scaled real :: I_rho0 ! 1 / RHO0, (m3/kg) real :: Kd_add ! diffusivity to add in a layer (m2/sec) @@ -977,9 +977,9 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, real :: TKE_Niku_lay ! lee-wave TKE imparted to a layer (m3/s3) real :: TKE_lowmode_lay ! internal tide TKE imparted to a layer (from low mode) (m3/s3) (BDM) real :: frac_used ! fraction of TKE that can be used in a layer (nondim) - real :: Izeta ! inverse of TKE decay scale (1/meter) - real :: Izeta_lee ! inverse of TKE decay scale for lee waves (1/meter) - real :: z0_psl ! temporary variable with units of meter + real :: Izeta ! inverse of TKE decay scale (1/Z) + real :: Izeta_lee ! inverse of TKE decay scale for lee waves (1/Z) + real :: z0_psl ! temporary variable with units of Z real :: TKE_lowmode_tot ! TKE from all low modes (W/m2) (BDM) logical :: use_Polzin, use_Simmons @@ -995,7 +995,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, do i=is,ie ; htot(i) = 0.0 ; Inv_int(i) = 0.0 ; Inv_int_lee(i) = 0.0 ; Inv_int_low(i) = 0.0 ;enddo do k=1,nz ; do i=is,ie - htot(i) = htot(i) + GV%H_to_m*h(i,j,k) + htot(i) = htot(i) + GV%H_to_Z*h(i,j,k) enddo ; enddo I_Rho0 = 1.0/GV%Rho0 @@ -1010,9 +1010,9 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, ! Calculate parameters for vertical structure of dissipation ! Simmons: if ( use_Simmons ) then - Izeta = 1.0 / max(CS%Int_tide_decay_scale, GV%H_subroundoff*GV%H_to_m) + Izeta = 1.0 / max(CS%Int_tide_decay_scale, GV%H_subroundoff*GV%H_to_Z) Izeta_lee = 1.0 / max(CS%Int_tide_decay_scale*CS%Decay_scale_factor_lee, & - GV%H_subroundoff*GV%H_to_m) + GV%H_subroundoff*GV%H_to_Z) do i=is,ie CS%Nb(i,j) = sqrt(N2_bot(i)) if (associated(dd%N2_bot)) dd%N2_bot(i,j) = N2_bot(i) @@ -1031,7 +1031,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, Inv_int_low(i) = 1.0 / (1.0 - exp(-Izeta*htot(i))) endif endif - z_from_bot(i) = GV%H_to_m*h(i,j,nz) + z_from_bot(i) = GV%H_to_Z*h(i,j,nz) enddo endif ! Simmons @@ -1040,10 +1040,10 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, ! WKB scaling of the vertical coordinate do i=is,ie ; N2_meanz(i)=0.0 ; enddo do k=1,nz ; do i=is,ie - N2_meanz(i) = N2_meanz(i) + N2_lay(i,k)*GV%H_to_m*h(i,j,k) + N2_meanz(i) = N2_meanz(i) + N2_lay(i,k)*GV%H_to_Z*h(i,j,k) enddo ; enddo do i=is,ie - N2_meanz(i) = N2_meanz(i) / (htot(i) + GV%H_subroundoff*GV%H_to_m) + N2_meanz(i) = N2_meanz(i) / (htot(i) + GV%H_subroundoff*GV%H_to_Z) if (associated(dd%N2_meanz)) dd%N2_meanz(i,j) = N2_meanz(i) enddo @@ -1051,7 +1051,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, do i=is,ie ; htot_WKB(i) = htot(i) ; enddo ! do i=is,ie ; htot_WKB(i) = 0.0 ; enddo ! do k=1,nz ; do i=is,ie -! htot_WKB(i) = htot_WKB(i) + GV%H_to_m*h(i,j,k)*N2_lay(i,k) / N2_meanz(i) +! htot_WKB(i) = htot_WKB(i) + GV%H_to_Z*h(i,j,k)*N2_lay(i,k) / N2_meanz(i) ! enddo ; enddo ! htot_WKB(i) = htot(i) ! Nearly equivalent and simpler @@ -1059,7 +1059,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, CS%Nb(i,j) = sqrt(N2_bot(i)) if ((CS%tideamp(i,j) > 0.0) .and. & (CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14) ) then - z0_polzin(i) = CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & + z0_polzin(i) = GV%m_to_Z * CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & CS%Nbotref_Polzin**2 * CS%tideamp(i,j) / & ( CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 ) if (z0_polzin(i) < CS%Polzin_min_decay_scale) & @@ -1077,38 +1077,37 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, endif if (associated(dd%Polzin_decay_scale)) & - dd%Polzin_decay_scale(i,j) = z0_polzin(i) + dd%Polzin_decay_scale(i,j) = GV%Z_to_m * z0_polzin(i) if (associated(dd%Polzin_decay_scale_scaled)) & - dd%Polzin_decay_scale_scaled(i,j) = z0_polzin_scaled(i) + dd%Polzin_decay_scale_scaled(i,j) = GV%Z_to_m * z0_polzin_scaled(i) if (associated(dd%N2_bot)) dd%N2_bot(i,j) = CS%Nb(i,j)*CS%Nb(i,j) if ( CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then ! For the Polzin formulation, this if loop prevents the vertical ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14) then - Inv_int(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1 + if (htot_WKB(i) > 1.0e-14*GV%m_to_Z) then !### Avoid using this dimensional constant. + Inv_int(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 endif endif if ( CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09) ) then ! For the Polzin formulation, this if loop prevents the vertical ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14) then - Inv_int_lee(i) = ( z0_polzin_scaled(i)*CS%Decay_scale_factor_lee / htot_WKB(i) ) + 1 + if (htot_WKB(i) > 1.0e-14*GV%m_to_Z) then !### Avoid using this dimensional constant. + Inv_int_lee(i) = ( z0_polzin_scaled(i)*CS%Decay_scale_factor_lee / htot_WKB(i) ) + 1.0 endif endif if ( CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then ! For the Polzin formulation, this if loop prevents the vertical ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14) then - Inv_int_low(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1 + if (htot_WKB(i) > 1.0e-14*GV%m_to_Z) then !### Avoid using this dimensional constant. + Inv_int_low(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 endif endif - z_from_bot(i) = GV%H_to_m*h(i,j,nz) - ! Use the new formulation for WKB scaling. N2 is referenced to its - ! vertical mean. - if (N2_meanz(i) > 1.0e-14 ) then - z_from_bot_WKB(i) = GV%H_to_m*h(i,j,nz)*N2_lay(i,nz) / N2_meanz(i) + z_from_bot(i) = GV%H_to_Z*h(i,j,nz) + ! Use the new formulation for WKB scaling. N2 is referenced to its vertical mean. + if (N2_meanz(i) > 1.0e-14 ) then !### Avoid using this dimensional constant. + z_from_bot_WKB(i) = GV%H_to_Z*h(i,j,nz)*N2_lay(i,nz) / N2_meanz(i) else ; z_from_bot_WKB(i) = 0 ; endif enddo endif ! Polzin @@ -1152,7 +1151,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, if ( use_Simmons ) then do k=nz-1,2,-1 ; do i=is,ie if (max_TKE(i,k) <= 0.0) cycle - z_from_bot(i) = z_from_bot(i) + GV%H_to_m*h(i,j,k) + z_from_bot(i) = z_from_bot(i) + GV%H_to_Z*h(i,j,k) ! Fraction of bottom flux predicted to reach top of this layer TKE_frac_top(i) = Inv_int(i) * exp(-Izeta * z_from_bot(i)) @@ -1167,10 +1166,10 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, ! Actual power expended may be less than predicted if stratification is weak; adjust if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > max_TKE(i,k)) then - frac_used = max_TKE(i,k) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) - TKE_itide_lay = frac_used * TKE_itide_lay - TKE_Niku_lay = frac_used * TKE_Niku_lay - TKE_lowmode_lay = frac_used * TKE_lowmode_lay + frac_used = max_TKE(i,k) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) + TKE_itide_lay = frac_used * TKE_itide_lay + TKE_Niku_lay = frac_used * TKE_Niku_lay + TKE_lowmode_lay = frac_used * TKE_lowmode_lay endif ! Calculate vertical flux available to bottom of layer above @@ -1233,9 +1232,9 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, if ( use_Polzin ) then do k=nz-1,2,-1 ; do i=is,ie if (max_TKE(i,k) <= 0.0) cycle - z_from_bot(i) = z_from_bot(i) + GV%H_to_m*h(i,j,k) + z_from_bot(i) = z_from_bot(i) + GV%H_to_Z*h(i,j,k) if (N2_meanz(i) > 1.0e-14 ) then - z_from_bot_WKB(i) = z_from_bot_WKB(i) + GV%H_to_m*h(i,j,k)*N2_lay(i,k)/N2_meanz(i) + z_from_bot_WKB(i) = z_from_bot_WKB(i) + GV%H_to_Z*h(i,j,k)*N2_lay(i,k)/N2_meanz(i) else ; z_from_bot_WKB(i) = 0 ; endif ! Fraction of bottom flux predicted to reach top of this layer From da4dd4246e6e5d6042984088a8fa757477f24e78 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 2 Oct 2018 14:43:31 -0400 Subject: [PATCH 0769/1072] Refactored diapyc_energy_req_calc N2 calculations Rescaled several of the variables in diapyc_energy_req_test to work in units of Z instead of m, and rearranged the unit convsersions in the N2 calculations to reflect anticipated future use. All answers are bitwise identical. --- .../vertical/MOM_diapyc_energy_req.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 5248a0fb66..767e49ed89 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -89,13 +89,13 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, CS, Kd_int) h_bot(K) = h_bot(K+1) + h_col(k) enddo - ustar = 0.01 ! Change this to being an input parameter? + ustar = 0.01*GV%m_to_Z ! Change this to being an input parameter? absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J)))) Kd(1) = 0.0 ; Kd(nz+1) = 0.0 do K=2,nz - tmp1 = h_top(K) * h_bot(K) * GV%H_to_m - Kd(K) = CS%test_Kh_scaling * & + tmp1 = h_top(K) * h_bot(K) * GV%H_to_Z + Kd(K) = CS%test_Kh_scaling * GV%Z_to_m**2 * & ustar * 0.41 * (tmp1*ustar) / (absf*tmp1 + htot*ustar) enddo endif @@ -117,7 +117,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(GV%ke), intent(in) :: h_in !< Layer thickness before entrainment, - !! in m or kg m-2. + !! in H (m or kg m-2). real, dimension(GV%ke), intent(in) :: T_in !< The layer temperatures, in degC. real, dimension(GV%ke), intent(in) :: S_in !< The layer salinities, in g kg-1. real, dimension(GV%ke+1), intent(in) :: Kd !< The interfaces diapycnal diffusivities, @@ -132,7 +132,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & logical, optional, intent(in) :: may_print !< If present and true, write out diagnostics !! of energy use. type(diapyc_energy_req_CS), & - optional, pointer :: CS !< This module's control structure. + optional, pointer :: CS !< This module's control structure. ! This subroutine uses a substantially refactored tridiagonal equation for ! diapycnal mixing of temperature and salinity to estimate the potential energy @@ -931,7 +931,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & do K=2,nz call calculate_density(0.5*(T0(k-1) + T0(k)), 0.5*(S0(k-1) + S0(k)), & pres(K), rho_here, tv%eqn_of_state) - N2(K) = ((GV%g_Earth*GV%m_to_Z) * rho_here / (0.5*GV%H_to_m*(h_tr(k-1) + h_tr(k)))) * & + N2(K) = ((GV%g_Earth*GV%m_to_Z**2) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (T0(k-1) - T0(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (S0(k-1) - S0(k)) ) enddo @@ -942,7 +942,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & do K=2,nz call calculate_density(0.5*(Tf(k-1) + Tf(k)), 0.5*(Sf(k-1) + Sf(k)), & pres(K), rho_here, tv%eqn_of_state) - N2(K) = ((GV%g_Earth*GV%m_to_Z) * rho_here / (0.5*GV%H_to_m*(h_tr(k-1) + h_tr(k)))) * & + N2(K) = ((GV%g_Earth*GV%m_to_Z**2) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (Tf(k-1) - Tf(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (Sf(k-1) - Sf(k)) ) enddo From cf567b2b4d7586b5a057f82a2c1e4f5543ba91b0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 3 Oct 2018 07:05:52 -0400 Subject: [PATCH 0770/1072] +(*)Added m_to_Z and m_to_H to restart files Added m_to_Z and m_to_H as optional fields in the MOM6 restart files, along with the ability to rescale units or change from Boussinesq to non-Boussinesq or vice versa over a restart. Also added code to rescale restart variables when the internal representation of thicknesses have changed, which required adding a new restart_CSp argument to mixedlayer_restrat_init. All answers are bitwise identical in test cases, and it has been verified that answers are unchanged when H_to_m changes across a restart in the Baltic_OM4_05 test case. --- src/core/MOM.F90 | 24 +++++++++--- src/core/MOM_barotropic.F90 | 16 +++++--- src/core/MOM_dynamics_split_RK2.F90 | 18 ++++++++- src/core/MOM_verticalGrid.F90 | 13 ++++++- .../MOM_state_initialization.F90 | 11 ++++-- .../lateral/MOM_mixed_layer_restrat.F90 | 37 ++++++++++++++++--- 6 files changed, 97 insertions(+), 22 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index deef3fa629..aa34a5a181 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -114,6 +114,7 @@ module MOM use MOM_variables, only : thermo_var_ptrs, vertvisc_type use MOM_variables, only : accel_diag_ptrs, cont_diag_ptrs, ocean_internal_state use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd +use MOM_verticalGrid, only : fix_restart_scaling use MOM_verticalGrid, only : get_thickness_units, get_flux_units, get_tr_flux_units use MOM_wave_interface, only : wave_parameters_CS, waves_end use MOM_wave_interface, only : Update_Stokes_Drift @@ -2324,7 +2325,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call thickness_diffuse_init(Time, G, GV, param_file, diag, CS%CDp, CS%thickness_diffuse_CSp) CS%mixedlayer_restrat = mixedlayer_restrat_init(Time, G, GV, param_file, diag, & - CS%mixedlayer_restrat_CSp) + CS%mixedlayer_restrat_CSp, restart_CSp) if (CS%mixedlayer_restrat) then if (.not.(bulkmixedlayer .or. CS%use_ALE_algorithm)) & call MOM_error(FATAL, "MOM: MIXEDLAYER_RESTRAT true requires a boundary layer scheme.") @@ -2448,17 +2449,19 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & .not.((dirs%input_filename(1:1) == 'r') .and. & (LEN_TRIM(dirs%input_filename) == 1)) - if (CS%ensemble_ocean) then - call init_oda(Time, G, GV, CS%odaCS) + call init_oda(Time, G, GV, CS%odaCS) endif + !### This could perhaps go here instead of in finish_MOM_initialization? + ! call fix_restart_scaling(GV) + call callTree_leave("initialize_MOM()") call cpu_clock_end(id_clock_init) end subroutine initialize_MOM -!> Finishe initializing MOM and writes out the initial conditions. +!> Finishes initializing MOM and writes out the initial conditions. subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) type(time_type), intent(in) :: Time !< model time, used in this routine type(directories), intent(in) :: dirs !< structure with directory paths @@ -2478,6 +2481,9 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) ! Pointers for convenience G => CS%G ; GV => CS%GV + !### Move to initialize_MOM? + call fix_restart_scaling(GV) + ! Write initial conditions if (CS%write_IC) then allocate(restart_CSp_tmp) @@ -2616,10 +2622,16 @@ subroutine set_restart_fields(GV, param_file, CS, restart_CSp) call get_param(param_file, '', "ICE_SHELF", use_ice_shelf, default=.false., & do_not_log=.true.) if (use_ice_shelf .and. associated(CS%Hml)) then - call register_restart_field(CS%Hml, "hML", .false., restart_CSp, & - "Mixed layer thickness", "meter") + call register_restart_field(CS%Hml, "hML", .false., restart_CSp, & + "Mixed layer thickness", "meter") endif + ! Register scalar unit conversion factors. + call register_restart_field(GV%m_to_Z_restart, "m_to_Z", .false., restart_CSp, & + "Height unit conversion factor", "Z meter-1") + call register_restart_field(GV%m_to_H_restart, "m_to_H", .false., restart_CSp, & + "Thickness unit conversion factor", "Z meter-1") + end subroutine set_restart_fields !> Apply a correction to the sea surface height to compensate diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 733cf7a9d2..17d0779ef1 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -2639,11 +2639,11 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co endif else if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - BT_OBC%H_u(i,j) = eta(i,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j) + GV%m_to_Z*eta(i,j))) !### * GV%H_to_m? + BT_OBC%H_u(I,j) = eta(i,j) + BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1) * (G%bathyT(i,j) + GV%m_to_Z*eta(i,j))) !### * GV%H_to_m? elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - BT_OBC%H_u(i,j) = eta(i+1,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i+1,j) + GV%m_to_Z*eta(i+1,j))) !### * GV%H_to_m? + BT_OBC%H_u(I,j) = eta(i+1,j) + BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1) * (G%bathyT(i+1,j) + GV%m_to_Z*eta(i+1,j))) !### * GV%H_to_m? endif endif if (GV%Boussinesq) then @@ -3732,6 +3732,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ! drag piston velocity. character(len=80) :: wave_drag_var ! The wave drag piston velocity variable ! name in wave_drag_file. + real :: uH_rescale ! A rescaling factor for thickness transports from the representation in + ! a restart file to the internal representation in this run. real, allocatable, dimension(:,:) :: lin_drag_h type(memory_size_type) :: MS type(group_pass_type) :: pass_static_data, pass_q_D_Cor @@ -4330,6 +4332,10 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & .NOT.query_initialized(CS%vhbt_IC,"vhbt_IC",restart_CS)) then do j=js,je ; do I=is-1,ie ; CS%uhbt_IC(I,j) = CS%ubtav(I,j) * Datu(I,j) ; enddo ; enddo do J=js-1,je ; do i=is,ie ; CS%vhbt_IC(i,J) = CS%vbtav(i,J) * Datv(i,J) ; enddo ; enddo + elseif ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then + uH_rescale = GV%m_to_H / GV%m_to_H_restart + do j=js,je ; do I=is-1,ie ; CS%uhbt_IC(I,j) = uH_rescale * CS%uhbt_IC(I,j) ; enddo ; enddo + do J=js-1,je ; do i=is,ie ; CS%vhbt_IC(i,J) = uH_rescale * CS%vhbt_IC(I,j) ; enddo ; enddo endif call create_group_pass(pass_bt_hbt_btav, CS%ubt_IC, CS%vbt_IC, G%Domain) @@ -4414,7 +4420,7 @@ subroutine register_barotropic_restarts(HI, GV, param_file, CS, restart_CS) call register_restart_field(CS%vbt_IC, vd(3), .false., restart_CS) if (GV%Boussinesq) then - vd(2) = var_desc("uhbt_IC", "m3 s-1", & + vd(2) = var_desc("uhbt_IC", "m3 s-1", & longname="Next initial condition for the barotropic zonal transport", & hor_grid='u', z_grid='1') vd(3) = var_desc("vhbt_IC", "m3 s-1", & diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 30db43cc0c..8ab7e0d337 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -992,6 +992,10 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_tmp character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. character(len=48) :: thickness_units, flux_units, eta_rest_name + real :: H_rescale ! A rescaling factor for thicknesses from the representation in + ! a restart file to the internal representation in this run. + real :: uH_rescale ! A rescaling factor for thickness transports from the representation in + ! a restart file to the internal representation in this run. real :: H_convert type(group_pass_type) :: pass_av_h_uvh logical :: use_tides, debug_truncations @@ -1115,6 +1119,9 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil do k=1,nz ; do j=js,je ; do i=is,ie CS%eta(i,j) = CS%eta(i,j) + h(i,j,k) enddo ; enddo ; enddo + elseif ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then + H_rescale = GV%m_to_H / GV%m_to_H_restart + do j=js,je ; do i=is,ie ; CS%eta(i,j) = H_rescale * CS%eta(i,j) ; enddo ; enddo endif ! Copy eta into an output array. do j=js,je ; do i=is,ie ; eta(i,j) = CS%eta(i,j) ; enddo ; enddo @@ -1141,8 +1148,17 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil call pass_var(h_tmp, G%Domain, clock=id_clock_pass_init) CS%h_av(:,:,:) = 0.5*(h(:,:,:) + h_tmp(:,:,:)) else - if (.not. query_initialized(CS%h_av,"h2",restart_CS)) & + if (.not. query_initialized(CS%h_av,"h2",restart_CS)) then CS%h_av(:,:,:) = h(:,:,:) + elseif ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then + H_rescale = GV%m_to_H / GV%m_to_H_restart + do k=1,nz ; do j=js,je ; do i=is,ie ; CS%h_av(i,j,k) = H_rescale * CS%h_av(i,j,k) ; enddo ; enddo ; enddo + endif + if ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then + uH_rescale = GV%m_to_H / GV%m_to_H_restart + do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB ; uh(I,j,k) = uH_rescale * uh(I,j,k) ; enddo ; enddo ; enddo + do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie ; vh(i,J,k) = uH_rescale * vh(i,J,k) ; enddo ; enddo ; enddo + endif endif call cpu_clock_begin(id_clock_pass_init) diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index b2ef2dda6a..7b7feadb3c 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -11,7 +11,7 @@ module MOM_verticalGrid #include public verticalGridInit, verticalGridEnd -public setVerticalGridAxes +public setVerticalGridAxes, fix_restart_scaling public get_flux_units, get_thickness_units, get_tr_flux_units !> Describes the vertical ocean grid, including unit conversion factors @@ -56,6 +56,9 @@ module MOM_verticalGrid real :: Z_to_m !< A constant that translates distances in the units of depth to m. real :: H_to_Z !< A constant that translates thickness units to the units of depth. real :: Z_to_H !< A constant that translates depth units to thickness units. + + real :: m_to_Z_restart = 0.0 !< A copy of the m_to_Z that is used in restart files. + real :: m_to_H_restart = 0.0 !< A copy of the m_to_H that is used in restart files. end type verticalGrid_type contains @@ -171,6 +174,14 @@ subroutine verticalGridInit( param_file, GV ) end subroutine verticalGridInit +!> Set the scaling factors for restart files to the scaling factors for this run. +subroutine fix_restart_scaling(GV) + type(verticalGrid_type), intent(inout) :: GV !< The ocean's vertical grid structure + + GV%m_to_Z_restart = GV%m_to_Z + GV%m_to_H_restart = GV%m_to_H +end subroutine fix_restart_scaling + !> Returns the model's thickness units, usually m or kg/m^2. function get_thickness_units(GV) character(len=48) :: get_thickness_units !< The vertical thickness units diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 0046a4f168..02ca818dfb 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -147,6 +147,9 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & character(len=200) :: filename2 ! The name of an input files. character(len=200) :: inputdir ! The directory where NetCDF input files are. character(len=200) :: config + real :: H_rescale ! A rescaling factor for thicknesses from the representation in + ! a restart file to the internal representation in this run. + real :: dt ! The baroclinic dynamics timestep for this run, in s. logical :: from_Z_file, useALE logical :: new_sim integer :: write_geom @@ -159,7 +162,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & ! by a large surface pressure, such as with an ice sheet. logical :: regrid_accelerate integer :: regrid_iterations - logical :: Analytic_FV_PGF, obsol_test +! logical :: Analytic_FV_PGF, obsol_test logical :: convert logical :: just_read ! If true, only read the parameters because this ! is a run from a restart file; this option @@ -174,8 +177,6 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - real :: dt - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -486,6 +487,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & call restore_state(dirs%input_filename, dirs%restart_input_dir, Time, & G, restart_CS) if (present(Time_in)) Time = Time_in + if ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then + H_rescale = GV%m_to_H / GV%m_to_H_restart + do k=1,nz ; do j=js,je ; do i=is,ie ; h(i,j,k) = H_rescale * h(i,j,k) ; enddo ; enddo ; enddo + endif endif if ( use_temperature ) then diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index c9939b6693..78993633b3 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -15,7 +15,7 @@ module MOM_mixed_layer_restrat use MOM_hor_index, only : hor_index_type use MOM_io, only : vardesc, var_desc use MOM_lateral_mixing_coeffs, only : VarMix_CS -use MOM_restart, only : register_restart_field, MOM_restart_CS +use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density @@ -771,17 +771,22 @@ end subroutine mixedlayer_restrat_BML !> Initialize the mixed layer restratification module -logical function mixedlayer_restrat_init(Time, G, GV, param_file, diag, CS) +logical function mixedlayer_restrat_init(Time, G, GV, param_file, diag, CS, restart_CS) type(time_type), intent(in) :: Time !< Current model time type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(param_file_type), intent(in) :: param_file !< Parameter file to parse type(diag_ctrl), target, intent(inout) :: diag !< Regulate diagnostics type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure + ! Local variables -! This include declares and sets the variable "version". -#include "version_variable.h" - real :: flux_to_kg_per_s + real :: H_rescale ! A rescaling factor for thicknesses from the representation in + ! a restart file to the internal representation in this run. + real :: flux_to_kg_per_s ! A unit conversion factor for fluxes. + ! This include declares and sets the variable "version". +# include "version_variable.h" + integer :: i, j ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -888,6 +893,26 @@ logical function mixedlayer_restrat_init(Time, G, GV, param_file, diag, CS) CS%id_vml = register_diag_field('ocean_model', 'vml_restrat', diag%axesCv1, Time, & 'Surface meridional velocity component of mixed layer restratification', 'm s-1') + ! Rescale variables from restart files if the internal dimensional scalings have changed. + if (CS%MLE_MLD_decay_time>0. .or. CS%MLE_MLD_decay_time2>0.) then + if (query_initialized(CS%MLD_filtered, "MLD_MLE_filtered", restart_CS) .and. & + (GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then + H_rescale = GV%m_to_H / GV%m_to_H_restart + do j=G%jsc,G%jec ; do i=G%isc,G%iec + CS%MLD_filtered(i,j) = H_rescale * CS%MLD_filtered(i,j) + enddo ; enddo + endif + endif + if (CS%MLE_MLD_decay_time2>0.) then + if (query_initialized(CS%MLD_filtered_slow, "MLD_MLE_filtered_slow", restart_CS) .and. & + (GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then + H_rescale = GV%m_to_H / GV%m_to_H_restart + do j=G%jsc,G%jec ; do i=G%isc,G%iec + CS%MLD_filtered_slow(i,j) = H_rescale * CS%MLD_filtered_slow(i,j) + enddo ; enddo + endif + endif + ! If MLD_filtered is being used, we need to update halo regions after a restart if (associated(CS%MLD_filtered)) call pass_var(CS%MLD_filtered, G%domain) @@ -899,7 +924,7 @@ subroutine mixedlayer_restrat_register_restarts(HI, param_file, CS, restart_CS) type(hor_index_type), intent(in) :: HI !< Horizontal index structure type(param_file_type), intent(in) :: param_file !< Parameter file to parse type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure - type(MOM_restart_CS), pointer :: restart_CS !< Restart structure + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure ! Local variables type(vardesc) :: vd logical :: mixedlayer_restrat_init From ecefa4c7d9d32403319732e0f833b8c0e49c53ec Mon Sep 17 00:00:00 2001 From: "Jessica.Liptak" Date: Wed, 3 Oct 2018 09:45:19 -0400 Subject: [PATCH 0771/1072] added mol_wt dummy argument to atmos_ocean_fluxes in solo_driver --- config_src/solo_driver/atmos_ocean_fluxes.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/config_src/solo_driver/atmos_ocean_fluxes.F90 b/config_src/solo_driver/atmos_ocean_fluxes.F90 index 5494954398..76c0941c18 100644 --- a/config_src/solo_driver/atmos_ocean_fluxes.F90 +++ b/config_src/solo_driver/atmos_ocean_fluxes.F90 @@ -13,7 +13,7 @@ module atmos_ocean_fluxes_mod !> This subroutine duplicates an interface used by the FMS coupler, but only !! returns a value of -1. None of the arguments are used for anything. function aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index, & - param, flag, ice_restart_file, ocean_restart_file, & + param, flag, mol_wt, ice_restart_file, ocean_restart_file, & units, caller, verbosity) result (coupler_index) character(len=*), intent(in) :: name !< An unused argument @@ -22,6 +22,7 @@ function aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index, integer, optional, intent(in) :: atm_tr_index !< An unused argument real, dimension(:), optional, intent(in) :: param !< An unused argument logical, dimension(:), optional, intent(in) :: flag !< An unused argument + real, intent(in), optional :: mol_wt !< An unused argument character(len=*), optional, intent(in) :: ice_restart_file !< An unused argument character(len=*), optional, intent(in) :: ocean_restart_file !< An unused argument character(len=*), optional, intent(in) :: units !< An unused argument From ced9c35fc8dc6a8102728463bef4c88441bdf106 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 3 Oct 2018 13:08:19 -0400 Subject: [PATCH 0772/1072] +Changed the units of visc%kv_slow to Z-2 s-1 Rescaled the units of visc%kv_slow from m2 s-1 to Z2 s-1 for dimensional consistency testing. This required the addition of a new restart_CSp argument to set_visc_init. Also, some new 1-d variables were added to avoid using array sections as subroutine arguments. All answers are bitwise identical, including rescaling Z over a large range. --- src/core/MOM.F90 | 2 +- src/core/MOM_variables.F90 | 2 +- .../vertical/MOM_bkgnd_mixing.F90 | 56 ++++++++++--------- .../vertical/MOM_diabatic_driver.F90 | 17 +++--- .../vertical/MOM_set_diffusivity.F90 | 2 +- .../vertical/MOM_set_viscosity.F90 | 42 ++++++++++++-- .../vertical/MOM_tidal_mixing.F90 | 14 ++--- .../vertical/MOM_vert_friction.F90 | 12 ++-- 8 files changed, 90 insertions(+), 57 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index aa34a5a181..c117aad3b1 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2290,7 +2290,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%useMEKE = MEKE_init(Time, G, param_file, diag, CS%MEKE_CSp, CS%MEKE, restart_CSp) call VarMix_init(Time, G, param_file, diag, CS%VarMix) - call set_visc_init(Time, G, GV, param_file, diag, CS%visc, CS%set_visc_CSp, CS%OBC) + call set_visc_init(Time, G, GV, param_file, diag, CS%visc, CS%set_visc_CSp, restart_CSp, CS%OBC) if (CS%split) then allocate(eta(SZI_(G),SZJ_(G))) ; eta(:,:) = 0.0 call initialize_dyn_split_RK2(CS%u, CS%v, CS%h, CS%uh, CS%vh, eta, Time, & diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index a2b0db9fb6..b7c89140d7 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -243,7 +243,7 @@ module MOM_variables !! corner columns, in m2 s-1. real, pointer, dimension(:,:,:) :: Kv_slow => NULL() !< The turbulent vertical viscosity component due to "slow" processes (e.g., tidal, - !! background, convection etc), in m2 s-1. + !! background, convection etc), in Z2 s-1. real, pointer, dimension(:,:,:) :: TKE_turb => NULL() !< The turbulent kinetic energy per unit mass at the interfaces, in m2 s-2. !! This may be at the tracer or corner points diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index d25cb8592d..1151044ff3 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -30,7 +30,7 @@ module MOM_bkgnd_mixing public sfc_bkgnd_mixing !> Control structure including parameters for this module. -type, public :: bkgnd_mixing_cs +type, public :: bkgnd_mixing_cs ! TODO: private ! Parameters real :: Bryan_Lewis_c1 !< The vertical diffusivity values for Bryan-Lewis profile @@ -254,9 +254,9 @@ end subroutine bkgnd_mixing_init !> Get surface vertical background diffusivities/viscosities. subroutine sfc_bkgnd_mixing(G, CS) - type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(bkgnd_mixing_cs), pointer, intent(inout) :: CS !< The control structure returned by - !! a previous call to bkgnd_mixing_init. + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(bkgnd_mixing_cs), pointer, intent(inout) :: CS !< The control structure returned by + !! a previous call to bkgnd_mixing_init. ! local variables real :: I_x30 !< 2/acos(2) = 1/(sin(30 deg) * acosh(1/sin(30 deg))) real :: deg_to_rad !< factor converting degrees to radians, pi/180. @@ -305,23 +305,25 @@ end subroutine sfc_bkgnd_mixing !> Calculates the vertical background diffusivities/viscosities -subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, CS) +subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. - real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay!< squared buoyancy frequency associated + real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< squared buoyancy frequency associated !! with layers (1/s2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: kd_lay!< Diapycnal diffusivity of each layer m2 s-1. - real, dimension(:,:,:), pointer :: kv !< The "slow" vertical viscosity at each interface - !! (not layer!) in m2 s-1. - integer, intent(in) :: j !< Meridional grid indice. - type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: kd_lay !< Diapycnal diffusivity of each layer m2 s-1. + real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface + !! (not layer!) in Z2 s-1 + integer, intent(in) :: j !< Meridional grid index + type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by !! a previous call to bkgnd_mixing_init. ! local variables - real, dimension(SZI_(G), SZK_(G)+1) :: depth_2d !< distance from surface of an interface (m) + real, dimension(SZK_(G)+1) :: depth_int !< distance from surface of the interfaces (m) + real, dimension(SZK_(G)+1) :: Kd_col !< Diffusivities at the interfaces (m2 s-1) + real, dimension(SZK_(G)+1) :: Kv_col !< Viscosities at the interfaces (m2 s-1) real, dimension(SZI_(G)) :: & depth !< distance from surface of an interface (meter) real :: depth_c !< depth of the center of a layer (meter) @@ -341,31 +343,33 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, CS) deg_to_rad = atan(1.0)/45.0 ! = PI/180 epsilon = 1.e-10 - depth_2d(:,:) = 0.0 ! Set up the background diffusivity. if (CS%Bryan_Lewis_diffusivity) then do i=is,ie + depth_int(1) = 0.0 do k=2,nz+1 - depth_2d(i,k) = depth_2d(i,k-1) + GV%H_to_m*h(i,j,k-1) + depth_int(k) = depth_int(k-1) + GV%H_to_m*h(i,j,k-1) enddo call CVMix_init_bkgnd(max_nlev=nz, & - zw = depth_2d(i,:), & !< interface depth, must be positive. + zw = depth_int(:), & !< interface depths relative to the surface in m, must be positive. bl1 = CS%Bryan_Lewis_c1, & bl2 = CS%Bryan_Lewis_c2, & bl3 = CS%Bryan_Lewis_c3, & bl4 = CS%Bryan_Lewis_c4, & prandtl = CS%prandtl_bkgnd) - call CVMix_coeffs_bkgnd(Mdiff_out=CS%kv_bkgnd(i,j,:), & - Tdiff_out=CS%kd_bkgnd(i,j,:), & - nlev=nz, & - max_nlev=nz) + Kd_col(:) = 0.0 ; Kv_col(:) = 0.0 ! Is this line necessary? + call CVMix_coeffs_bkgnd(Mdiff_out=Kv_col, Tdiff_out=Kd_col, nlev=nz, max_nlev=nz) - ! Update Kd + ! Update Kd and Kv. + do K=1,nz+1 + CS%Kv_bkgnd(i,j,K) = Kv_col(K) + CS%Kd_bkgnd(i,j,K) = Kd_col(K) + enddo do k=1,nz - kd_lay(i,j,k) = kd_lay(i,j,k) + 0.5*(CS%kd_bkgnd(i,j,K) + CS%kd_bkgnd(i,j,K+1)) + kd_lay(i,j,k) = kd_lay(i,j,k) + 0.5*(Kd_col(K) + Kd_col(K+1)) enddo enddo ! i loop @@ -413,13 +417,11 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, CS) enddo endif - ! Update kv + ! Update Kv if (associated(kv)) then - do i=is,ie - do k=1,nz+1 - kv(i,j,k) = kv(i,j,k) + CS%kv_bkgnd(i,j,k) - enddo - enddo + do k=1,nz+1 ; do i=is,ie + Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * CS%kv_bkgnd(i,j,k) + enddo ; enddo endif end subroutine calculate_bkgnd_mixing diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 262e6bcaed..b909d5ba66 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -594,7 +594,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call cpu_clock_begin(id_clock_kpp) ! total vertical viscosity in the interior is represented via visc%Kv_shear do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + visc%Kv_slow(i,j,k) + visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + GV%Z_to_m**2*visc%Kv_slow(i,j,k) enddo ; enddo ; enddo ! KPP needs the surface buoyancy flux but does not update state variables. @@ -693,7 +693,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%useKPP) then visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) else - visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) + visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kv_conv(i,j,k) endif enddo ; enddo ; enddo !$OMP end parallel @@ -1577,12 +1577,13 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%use_CVMix_conv) then call calculate_CVMix_conv(h, tv, G, GV, CS%CVMix_conv_csp, Hml) - !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,k) = Kd_int(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) - visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) - enddo ; enddo ; enddo - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !### The vertical extent here is more limited that Kv_slow or Kd_int; it might be k=1,nz+1. + do k=1,nz ; do j=js,je ; do i=is,ie + Kd_int(i,j,k) = Kd_int(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) + visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kv_conv(i,j,k) + enddo ; enddo ; enddo + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! endif diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index f185f5aab4..57cb50d431 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -292,7 +292,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! If nothing else is specified, this will be the value used. Kd(:,:,:) = CS%Kd Kd_int(:,:,:) = CS%Kd - if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = CS%Kv + if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = GV%m_to_Z**2 * CS%Kv ! Set up arrays for diagnostics. diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 1b37cb23e9..ce7d089b7b 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -18,7 +18,7 @@ module MOM_set_visc use MOM_cvmix_shear, only : cvmix_shear_is_used use MOM_cvmix_conv, only : cvmix_conv_is_used use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used -use MOM_restart, only : register_restart_field, MOM_restart_CS +use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_safe_alloc, only : safe_alloc_ptr, safe_alloc_alloc use MOM_variables, only : thermo_var_ptrs use MOM_variables, only : vertvisc_type @@ -1720,8 +1720,7 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical !! viscosities and related fields. !! Allocated here. - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control - !! structure. + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. ! Local variables logical :: use_kappa_shear, KS_at_vertex logical :: adiabatic, useKPP, useEPBL @@ -1795,7 +1794,7 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) end subroutine set_visc_register_restarts !> Initializes the MOM_set_visc control structure -subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) +subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, restart_CS, OBC) type(time_type), target, intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -1807,12 +1806,16 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) !! related fields. Allocated here. type(set_visc_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure ! Local variables real :: Csmag_chan_dflt, smag_const1, TKE_decay_dflt, bulk_Ri_ML_dflt real :: Kv_background real :: omega_frac_dflt - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, i, j, n + real :: Z_rescale ! A rescaling factor for heights from the representation in + ! a reastart fole to the internal representation in this run. + integer :: i, j, k, is, ie, js, je, n + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz logical :: use_kappa_shear, adiabatic, use_omega logical :: use_CVMix_ddiff, differential_diffusion, use_KPP type(OBC_segment_type), pointer :: segment => NULL() ! pointer to OBC segment type @@ -1829,10 +1832,10 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) CS%OBC => OBC + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - CS%diag => diag ! Set default, read and log parameters @@ -2054,6 +2057,33 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) diag%axesCv1, Time, 'Number of layers in viscous mixed layer at v points', 'm') endif + if ((GV%m_to_Z_restart /= 0.0) .and. (GV%m_to_Z_restart /= GV%m_to_Z)) then + Z_rescale = GV%m_to_Z / GV%m_to_Z_restart +! if (allocated(visc%Kd_shear)) then ; if (query_initialized(visc%Kd_shear, "Kd_shear", restart_CS)) then +! do k=1,nz+1 ; do j=js,je ; do i=is,ie +! visc%Kd_shear(i,j,k) = Z_rescale**2 * visc%Kd_shear(i,j,k) +! enddo ; enddo ; enddo +! endif ; endif + +! if (allocated(visc%Kv_shear)) then ; if (query_initialized(visc%Kv_shear, "Kv_shear", restart_CS)) then +! do k=1,nz+1 ; do j=js,je ; do i=is,ie +! visc%Kv_shear(i,j,k) = Z_rescale**2 * visc%Kv_shear(i,j,k) +! enddo ; enddo ; enddo +! endif ; endif + +! if (allocated(visc%Kv_shear_Bu)) then ; if (query_initialized(visc%Kv_shear_Bu, "Kv_shear_Bu", restart_CS)) then +! do k=1,nz+1 ; do j=js,je ; do i=is,ie +! visc%Kv_shear_Bu(i,j,k) = Z_rescale**2 * visc%Kv_shear_Bu(i,j,k) +! enddo ; enddo ; enddo +! endif ; endif + + if (associated(visc%Kv_slow)) then ; if (query_initialized(visc%Kv_slow, "Kv_slow", restart_CS)) then + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kv_slow(i,j,k) = Z_rescale**2 * visc%Kv_slow(i,j,k) + enddo ; enddo ; enddo + endif ; endif + endif + end subroutine set_visc_init !> This subroutine dellocates any memory in the set_visc control structure. diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index a9937219ea..8e5f016351 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -675,7 +675,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & !! diffusivity due to TKE-based processes, in m2 s-1. !! Set this to a negative value to have no limit. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) in m2 s-1. + !! (not layer!) in Z2 s-1. if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then if (CS%use_CVMix_tidal) then @@ -703,7 +703,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: Kd !< The diapycnal diffusivities in the layers, in m2 s-1 real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) in m2 s-1. + !! (not layer!) in Z2 s-1. ! Local variables real, dimension(SZK_(G)+1) :: Kd_tidal ! tidal diffusivity [m2/s] real, dimension(SZK_(G)+1) :: Kv_tidal ! tidal viscosity [m2/s] @@ -776,10 +776,10 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_tidal(k) + Kd_tidal(k+1) ) enddo - ! Update viscosity + ! Update viscosity with the proper unit conversion. if (associated(Kv)) then - do k=1,G%ke+1 ! GV%m_to_Z**2 * - Kv(i,j,k) = Kv(i,j,k) + Kv_tidal(k) + do k=1,G%ke+1 + Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kv_tidal(k) enddo endif @@ -877,8 +877,8 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) ! Update viscosity if (associated(Kv)) then - do k=1,G%ke+1 ! GV%m_to_Z**2 * - Kv(i,j,k) = Kv(i,j,k) + Kv_tidal(k) + do k=1,G%ke+1 + Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kv_tidal(k) enddo endif diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 7eb6ae5436..2c558592d0 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1196,14 +1196,14 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! GMM/ A factor of 2 is also needed here, see comment above from BGR. if (work_on_u) then do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = Kv_add(i,K) + 1.0 * m2_to_Z2*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k)) + Kv_add(i,K) = Kv_add(i,K) + 1.0 * (visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k)) endif ; enddo ; enddo if (do_OBCs) then do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * m2_to_Z2*visc%Kv_slow(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * m2_to_Z2*visc%Kv_slow(i+1,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i+1,j,k) ; enddo endif endif ; enddo endif @@ -1218,9 +1218,9 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (do_OBCs) then do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * m2_to_Z2*visc%Kv_slow(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * m2_to_Z2*visc%Kv_slow(i,j+1,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j+1,k) ; enddo endif endif ; enddo endif @@ -1734,7 +1734,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & ALLOC_(CS%h_v(isd:ied,JsdB:JedB,nz)) ; CS%h_v(:,:,:) = 0.0 CS%id_Kv_slow = register_diag_field('ocean_model', 'Kv_slow', diag%axesTi, Time, & - 'Slow varying vertical viscosity', 'm2 s-1') + 'Slow varying vertical viscosity', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_Kv_u = register_diag_field('ocean_model', 'Kv_u', diag%axesCuL, Time, & 'Total vertical viscosity at u-points', 'm2 s-1', conversion=GV%Z_to_m**2) From 256d88735014222c8c23475b682c7ce48b742a53 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 3 Oct 2018 15:13:07 -0400 Subject: [PATCH 0773/1072] +Changed the units of visc%kv_shear to Z-2 s-1 Rescaled the units of visc%kv_shear and visc%Kv_shear_Bu from m2 s-1 to Z2 s-1 for dimensional consistency testing. All answers are bitwise identical, including rescaling Z over a large range. --- src/core/MOM_variables.F90 | 4 +-- .../vertical/MOM_CVMix_KPP.F90 | 16 +++++----- .../vertical/MOM_CVMix_shear.F90 | 29 ++++++++++++------- .../vertical/MOM_diabatic_driver.F90 | 13 +++++---- .../vertical/MOM_kappa_shear.F90 | 12 ++++---- .../vertical/MOM_set_diffusivity.F90 | 12 ++++---- .../vertical/MOM_set_viscosity.F90 | 22 +++++++------- .../vertical/MOM_vert_friction.F90 | 16 +++++----- 8 files changed, 66 insertions(+), 58 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index b7c89140d7..7c976d2fa1 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -237,10 +237,10 @@ module MOM_variables !! in tracer columns, in m2 s-1. real, pointer, dimension(:,:,:) :: Kv_shear => NULL() !< The shear-driven turbulent vertical viscosity at the interfaces between layers - !! in tracer columns, in m2 s-1. + !! in tracer columns, in Z2 s-1. real, pointer, dimension(:,:,:) :: Kv_shear_Bu => NULL() !< The shear-driven turbulent vertical viscosity at the interfaces between layers in - !! corner columns, in m2 s-1. + !! corner columns, in Z2 s-1. real, pointer, dimension(:,:,:) :: Kv_slow => NULL() !< The turbulent vertical viscosity component due to "slow" processes (e.g., tidal, !! background, convection etc), in Z2 s-1. diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 7802651c9c..08828972b7 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -533,7 +533,7 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive, Waves) CS%Vt2(:,:,:) = 0. if (CS%id_OBLdepth_original > 0) allocate( CS%OBLdepth_original( SZI_(G), SZJ_(G) ) ) - allocate( CS%OBLdepthprev( SZI_(G), SZJ_(G) ) );CS%OBLdepthprev(:,:)=0.0 + allocate( CS%OBLdepthprev( SZI_(G), SZJ_(G) ) ) ; CS%OBLdepthprev(:,:) = 0.0 if (CS%id_BulkDrho > 0) allocate( CS%dRho( SZI_(G), SZJ_(G), SZK_(G) ) ) if (CS%id_BulkDrho > 0) CS%dRho(:,:,:) = 0. if (CS%id_BulkUz2 > 0) allocate( CS%Uz2( SZI_(G), SZJ_(G), SZK_(G) ) ) @@ -585,8 +585,8 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & !< (out) Vertical diffusivity including KPP (m2/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP (m2/s) !< (out) Vertical diffusivity including KPP (m2/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP (m2/s) - !< (out) Vertical viscosity including KPP (m2/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP (Z2/s) + !< (out) Vertical viscosity including KPP (Z2/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport (m/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport (m/s) @@ -673,7 +673,7 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & else Kdiffusivity(:,1) = Kt(i,j,:) Kdiffusivity(:,2) = Ks(i,j,:) - Kviscosity(:)=Kv(i,j,:) + Kviscosity(:) = GV%Z_to_m**2 * Kv(i,j,:) endif call CVMix_coeffs_kpp(Kviscosity(:), & ! (inout) Total viscosity (m2/s) @@ -816,15 +816,15 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & do k=1, G%ke+1 Kt(i,j,k) = Kt(i,j,k) + Kdiffusivity(k,1) Ks(i,j,k) = Ks(i,j,k) + Kdiffusivity(k,2) - Kv(i,j,k) = Kv(i,j,k) + Kviscosity(k) - if (CS%Stokes_Mixing) Waves%KvS(i,j,k)=Kv(i,j,k) + Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kviscosity(k) + if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = GV%Z_to_m**2 * Kv(i,j,k) enddo else ! KPP replaces prior diffusivity when former is non-zero do k=1, G%ke+1 if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = Kdiffusivity(k,1) if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = Kdiffusivity(k,2) - if (Kviscosity(k) /= 0.) Kv(i,j,k) = Kviscosity(k) - if (CS%Stokes_Mixing) Waves%KvS(i,j,k)=Kv(i,j,k) + if (Kviscosity(k) /= 0.) Kv(i,j,k) = GV%m_to_Z**2 * Kviscosity(k) + if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = GV%Z_to_m**2 * Kv(i,j,k) enddo endif endif diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index f3b1570930..cdaccafca5 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -22,7 +22,7 @@ module MOM_CVMix_shear public calculate_CVMix_shear, CVMix_shear_init, CVMix_shear_is_used, CVMix_shear_end !> Control structure including parameters for CVMix interior shear schemes. -type, public :: CVMix_shear_cs +type, public :: CVMix_shear_cs ! TODO: private logical :: use_LMD94 !< Flags to use the LMD94 scheme logical :: use_PP81 !< Flags to use Pacanowski and Philander (JPO 1981) logical :: smooth_ri !< If true, smooth Ri using a 1-2-1 filter @@ -61,7 +61,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface !! (not layer!) in m2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface - !! (not layer!) in m2 s-1. + !! (not layer!) in Z2 s-1. type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous call to !! CVMix_shear_init. ! Local variables @@ -69,7 +69,8 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & real :: GoRho real :: pref, DU, DV, DRHO, DZ, N2, S2, dummy real, dimension(2*(G%ke)) :: pres_1d, temp_1d, salt_1d, rho_1d - real, dimension(G%ke+1) :: Ri_Grad !< Gradient Richardson number + real, dimension(G%ke+1) :: Ri_Grad !< Gradient Richardson number + real, dimension(G%ke+1) :: Kvisc ! Vertical viscosity at interfaces (m2/s) real, parameter :: epsln = 1.e-10 !< Threshold to identify vanished layers ! some constants @@ -147,23 +148,29 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & if (CS%id_ri_grad_smooth > 0) CS%ri_grad_smooth(i,j,:) = Ri_Grad(:) endif + do k=1,G%ke+1 + Kvisc(k) = GV%Z_to_m**2 * kv(i,j,k) + enddo ! Call to CVMix wrapper for computing interior mixing coefficients. - call CVMix_coeffs_shear(Mdiff_out=kv(i,j,:), & + call CVMix_coeffs_shear(Mdiff_out=Kvisc(:), & Tdiff_out=kd(i,j,:), & RICH=Ri_Grad(:), & nlev=G%ke, & max_nlev=G%ke) + do k=1,G%ke+1 + kv(i,j,k) = GV%m_to_Z**2 * Kvisc(k) + enddo enddo enddo ! write diagnostics - if (CS%id_kd > 0) call post_data(CS%id_kd,kd, CS%diag) - if (CS%id_kv > 0) call post_data(CS%id_kv,kv, CS%diag) - if (CS%id_N2 > 0) call post_data(CS%id_N2,CS%N2, CS%diag) - if (CS%id_S2 > 0) call post_data(CS%id_S2,CS%S2, CS%diag) - if (CS%id_ri_grad > 0) call post_data(CS%id_ri_grad,CS%ri_grad, CS%diag) - if (CS%id_ri_grad_smooth > 0) call post_data(CS%id_ri_grad_smooth,CS%ri_grad_smooth, CS%diag) + if (CS%id_kd > 0) call post_data(CS%id_kd, kd, CS%diag) + if (CS%id_kv > 0) call post_data(CS%id_kv, kv, CS%diag) + if (CS%id_N2 > 0) call post_data(CS%id_N2, CS%N2, CS%diag) + if (CS%id_S2 > 0) call post_data(CS%id_S2, CS%S2, CS%diag) + if (CS%id_ri_grad > 0) call post_data(CS%id_ri_grad, CS%ri_grad, CS%diag) + if (CS%id_ri_grad_smooth > 0) call post_data(CS%id_ri_grad_smooth ,CS%ri_grad_smooth, CS%diag) end subroutine calculate_CVMix_shear @@ -270,7 +277,7 @@ logical function CVMix_shear_init(Time, G, GV, param_file, diag, CS) CS%id_kd = register_diag_field('ocean_model', 'kd_shear_CVMix', diag%axesTi, Time, & 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s') CS%id_kv = register_diag_field('ocean_model', 'kv_shear_CVMix', diag%axesTi, Time, & - 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s') + 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s', conversion=GV%Z_to_m**2) end function CVMix_shear_init diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index b909d5ba66..46ee54ee94 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -594,7 +594,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call cpu_clock_begin(id_clock_kpp) ! total vertical viscosity in the interior is represented via visc%Kv_shear do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + GV%Z_to_m**2*visc%Kv_slow(i,j,k) + visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + visc%Kv_slow(i,j,k) enddo ; enddo ; enddo ! KPP needs the surface buoyancy flux but does not update state variables. @@ -691,7 +691,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & Kd_heat(i,j,k) = Kd_heat(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) Kd_salt(i,j,k) = Kd_salt(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) if (CS%useKPP) then - visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) + visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kv_conv(i,j,k) else visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kv_conv(i,j,k) endif @@ -745,12 +745,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! Augment the diffusivities and viscosity due to those diagnosed in energetic_PBL. do K=2,nz ; do j=js,je ; do i=is,ie + !### These expressesions assume a Prandtl number of 1. if (CS%ePBL_is_additive) then Kd_add_here = Kd_ePBL(i,j,K) - visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + GV%m_to_Z**2 * Kd_ePBL(i,j,K) else Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) - visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) + visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), GV%m_to_Z**2 * Kd_ePBL(i,j,K)) endif Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_add_here @@ -1725,10 +1726,10 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%ePBL_is_additive) then Kd_add_here = Kd_ePBL(i,j,K) - visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + GV%m_to_Z**2 * Kd_ePBL(i,j,K) else Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) - visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) + visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), GV%m_to_Z**2 * Kd_ePBL(i,j,K)) endif Ent_int = Kd_add_here * (GV%m_to_H**2 * dt) / & (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index bccb55ea5f..79cc4f633c 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -112,7 +112,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & !! toward convergence. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: kv_io !< The vertical viscosity at each interface - !! (not layer!) in m2 s-1. This discards any + !! (not layer!) in Z2 s-1. This discards any !! previous value (i.e. it is intent out) and !! simply sets Kv = Prandtl * Kd_shear real, intent(in) :: dt !< Time increment, in s. @@ -350,7 +350,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & do K=1,nz+1 ; do i=is,ie kappa_io(i,j,K) = G%mask2dT(i,j) * kappa_2d(i,K) tke_io(i,j,K) = G%mask2dT(i,j) * tke_2d(i,K) - kv_io(i,j,K) = ( G%mask2dT(i,j) * kappa_2d(i,K) ) * CS%Prandtl_turb + kv_io(i,j,K) = GV%m_to_Z**2 * ( G%mask2dT(i,j) * kappa_2d(i,K) ) * CS%Prandtl_turb #ifdef ADD_DIAGNOSTICS I_Ld2_3d(i,j,K) = I_Ld2_2d(i,K) dz_Int_3d(i,j,K) = dz_Int_2d(i,K) @@ -376,7 +376,7 @@ end subroutine Calculate_kappa_shear !> Subroutine for calculating shear-driven diffusivity and TKE in corner columns subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_io, tke_io, & - kv_io, dt, G, GV, CS, initialize_all) + kv_io, dt, G, GV, CS, initialize_all) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & @@ -404,7 +404,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ !! timestep, which may accelerate the iteration !! toward convergence. real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & - intent(inout) :: kv_io !< The vertical viscosity at each interface in m2 s-1. + intent(inout) :: kv_io !< The vertical viscosity at each interface in Z2 s-1. !! The previous value is used to initialize kappa !! in the vertex columes as Kappa = Kv/Prandtl !! to accelerate the iteration toward covergence. @@ -541,7 +541,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ rho_2d(I,k) = GV%Rlay(k) enddo ; enddo ; endif if (.not.new_kappa) then ; do K=1,nz+1 ; do I=IsB,IeB - kappa_2d(I,K,J2) = kv_io(I,J,K)*I_Prandtl + kappa_2d(I,K,J2) = GV%Z_to_m**2 * kv_io(I,J,K) * I_Prandtl enddo ; enddo ; endif !--------------------------------------- @@ -678,7 +678,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ do K=1,nz+1 ; do I=IsB,IeB tke_io(I,J,K) = G%mask2dBu(I,J) * tke_2d(I,K) - kv_io(I,J,K) = ( G%mask2dBu(I,J) * kappa_2d(I,K,J2) ) * CS%Prandtl_turb + kv_io(I,J,K) = GV%m_to_Z**2 * ( G%mask2dBu(I,J) * kappa_2d(I,K,J2) ) * CS%Prandtl_turb #ifdef ADD_DIAGNOSTICS I_Ld2_3d(I,J,K) = I_Ld2_2d(I,K) dz_Int_3d(I,J,K) = dz_Int_2d(I,K) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 57cb50d431..c82037d2d7 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -354,7 +354,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(visc%Kv_shear)) visc%Kv_shear(:,:,:) = 0.0 ! needed for other parameterizations if (CS%debug) then call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear",G%HI) - call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu",G%HI) + call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu", G%HI, scale=GV%Z_to_m**2) call Bchksum(visc%TKE_turb, "after calc_KS_vert visc%TKE_turb",G%HI) endif else @@ -363,9 +363,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call calculate_kappa_shear(u_h, v_h, h, tv, fluxes%p_surf, visc%Kd_shear, visc%TKE_turb, & visc%Kv_shear, dt, G, GV, CS%kappaShear_CSp) if (CS%debug) then - call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear",G%HI) - call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear",G%HI) - call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb",G%HI) + call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI) + call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear", G%HI, scale=GV%Z_to_m**2) + call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb", G%HI) endif endif call cpu_clock_end(id_clock_kappaShear) @@ -374,8 +374,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & !NOTE{BGR}: this needs to be cleaned up. It works in 1D case, but has not been tested outside. call calculate_CVMix_shear(u_h, v_h, h, tv, visc%Kd_shear, visc%Kv_shear, G, GV, CS%CVMix_shear_CSp) if (CS%debug) then - call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear",G%HI) - call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear",G%HI) + call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear", G%HI) + call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear", G%HI, scale=GV%Z_to_m**2) endif elseif (associated(visc%Kv_shear)) then visc%Kv_shear(:,:,:) = 0.0 ! needed if calculate_kappa_shear is not enabled diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index ce7d089b7b..2f8e5460a8 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -2059,23 +2059,23 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, restart_CS, OB if ((GV%m_to_Z_restart /= 0.0) .and. (GV%m_to_Z_restart /= GV%m_to_Z)) then Z_rescale = GV%m_to_Z / GV%m_to_Z_restart -! if (allocated(visc%Kd_shear)) then ; if (query_initialized(visc%Kd_shear, "Kd_shear", restart_CS)) then +! if (associated(visc%Kd_shear)) then ; if (query_initialized(visc%Kd_shear, "Kd_shear", restart_CS)) then ! do k=1,nz+1 ; do j=js,je ; do i=is,ie ! visc%Kd_shear(i,j,k) = Z_rescale**2 * visc%Kd_shear(i,j,k) ! enddo ; enddo ; enddo ! endif ; endif -! if (allocated(visc%Kv_shear)) then ; if (query_initialized(visc%Kv_shear, "Kv_shear", restart_CS)) then -! do k=1,nz+1 ; do j=js,je ; do i=is,ie -! visc%Kv_shear(i,j,k) = Z_rescale**2 * visc%Kv_shear(i,j,k) -! enddo ; enddo ; enddo -! endif ; endif + if (associated(visc%Kv_shear)) then ; if (query_initialized(visc%Kv_shear, "Kv_shear", restart_CS)) then + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kv_shear(i,j,k) = Z_rescale**2 * visc%Kv_shear(i,j,k) + enddo ; enddo ; enddo + endif ; endif -! if (allocated(visc%Kv_shear_Bu)) then ; if (query_initialized(visc%Kv_shear_Bu, "Kv_shear_Bu", restart_CS)) then -! do k=1,nz+1 ; do j=js,je ; do i=is,ie -! visc%Kv_shear_Bu(i,j,k) = Z_rescale**2 * visc%Kv_shear_Bu(i,j,k) -! enddo ; enddo ; enddo -! endif ; endif + if (associated(visc%Kv_shear_Bu)) then ; if (query_initialized(visc%Kv_shear_Bu, "Kv_shear_Bu", restart_CS)) then + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kv_shear_Bu(i,j,k) = Z_rescale**2 * visc%Kv_shear_Bu(i,j,k) + enddo ; enddo ; enddo + endif ; endif if (associated(visc%Kv_slow)) then ; if (query_initialized(visc%Kv_slow, "Kv_slow", restart_CS)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 2c558592d0..46adf78423 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1146,14 +1146,14 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! equal to 2 x \delta z if (work_on_u) then do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = (2.*0.5)*m2_to_Z2*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i+1,j,k)) + Kv_add(i,K) = (2.*0.5)*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i+1,j,k)) endif ; enddo ; enddo if (do_OBCs) then do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - do K=2,nz ; Kv_add(i,K) = 2.*m2_to_Z2*visc%Kv_shear(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - do K=2,nz ; Kv_add(i,K) = 2.*m2_to_Z2*visc%Kv_shear(i+1,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i+1,j,k) ; enddo endif endif ; enddo endif @@ -1162,14 +1162,14 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = (2.*0.5)*m2_to_Z2*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i,j+1,k)) + Kv_add(i,K) = (2.*0.5)*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i,j+1,k)) endif ; enddo ; enddo if (do_OBCs) then do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - do K=2,nz ; Kv_add(i,K) = 2.*m2_to_Z2*visc%Kv_shear(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then - do K=2,nz ; Kv_add(i,K) = 2.*m2_to_Z2*visc%Kv_shear(i,j+1,k) ; enddo + do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j+1,k) ; enddo endif endif ; enddo endif @@ -1182,11 +1182,11 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (associated(visc%Kv_shear_Bu)) then if (work_on_u) then do K=2,nz ; do I=Is,Ie ; If (do_i(I)) then - a_cpl(I,K) = a_cpl(I,K) + (2.*0.5)*m2_to_Z2*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) + a_cpl(I,K) = a_cpl(I,K) + (2.*0.5)*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + (2.*0.5)*m2_to_Z2*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k)) + a_cpl(i,K) = a_cpl(i,K) + (2.*0.5)*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo endif endif From 6fb94389a4f4e589edf508b0d477f0be01d6e355 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 3 Oct 2018 16:46:18 -0400 Subject: [PATCH 0774/1072] +Changed the units of visc%Kd_extra_T to Z-2 s-1 Rescaled the units of visc%Kd_extra_T, visc%Kd_extra_S, Kd_heat and Kd_salt from m2 s-1 to Z2 s-1 for dimensional consistency testing. Rescaling the diffusivities for diagnostics required added in a new GV argument to KPP_init. All answers are bitwise identical, including rescaling Z over a large range. --- src/core/MOM_variables.F90 | 4 +- .../vertical/MOM_CVMix_KPP.F90 | 37 +++--- .../vertical/MOM_CVMix_ddiff.F90 | 22 ++-- .../vertical/MOM_diabatic_aux.F90 | 27 ++--- .../vertical/MOM_diabatic_driver.F90 | 112 ++++++++---------- .../vertical/MOM_set_diffusivity.F90 | 8 +- 6 files changed, 102 insertions(+), 108 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 7c976d2fa1..14ab156793 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -225,10 +225,10 @@ module MOM_variables Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points, in Z s-1. real, pointer, dimension(:,:,:) :: Kd_extra_T => NULL() !< The extra diffusivity of temperature due to double diffusion relative to the - !! diffusivity of density, in m2 s-1. + !! diffusivity of density, in Z2 s-1. real, pointer, dimension(:,:,:) :: Kd_extra_S => NULL() !< The extra diffusivity of salinity due to double diffusion relative to the - !! diffusivity of density, in m2 s-1. + !! diffusivity of density, in Z2 s-1. ! One of Kd_extra_T and Kd_extra_S is always 0. Kd_extra_S is positive for salt fingering; ! Kd_extra_T is positive for double diffusive convection. They are only allocated if ! DOUBLE_DIFFUSION is true. diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 08828972b7..e03d217414 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -170,11 +170,12 @@ module MOM_CVMix_KPP !> Initialize the CVMix KPP module and set up diagnostics !! Returns True if KPP is to be used, False otherwise. -logical function KPP_init(paramFile, G, diag, Time, CS, passive, Waves) +logical function KPP_init(paramFile, G, GV, diag, Time, CS, passive, Waves) ! Arguments type(param_file_type), intent(in) :: paramFile !< File parser type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(diag_ctrl), target, intent(in) :: diag !< Diagnostics type(time_type), intent(in) :: Time !< Model time type(KPP_CS), pointer :: CS !< Control structure @@ -493,7 +494,7 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive, Waves) CS%id_Kt_KPP = register_diag_field('ocean_model', 'KPP_Kheat', diag%axesTi, Time, & 'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') CS%id_Kd_in = register_diag_field('ocean_model', 'KPP_Kd_in', diag%axesTi, Time, & - 'Diffusivity passed to KPP', 'm2/s') + 'Diffusivity passed to KPP', 'm2/s', conversion=GV%Z_to_m**2) CS%id_Ks_KPP = register_diag_field('ocean_model', 'KPP_Ksalt', diag%axesTi, Time, & 'Salt diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') CS%id_Kv_KPP = register_diag_field('ocean_model', 'KPP_Kv', diag%axesTi, Time, & @@ -581,10 +582,10 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (m/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux (m2/s3) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP (m2/s) - !< (out) Vertical diffusivity including KPP (m2/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP (m2/s) - !< (out) Vertical diffusivity including KPP (m2/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP (Z2/s) + !< (out) Vertical diffusivity including KPP (Z2/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP (Z2/s) + !< (out) Vertical diffusivity including KPP (Z2/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP (Z2/s) !< (out) Vertical viscosity including KPP (Z2/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport (m/s) @@ -612,8 +613,8 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & call hchksum(h, "KPP in: h",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0) call hchksum(buoyFlux, "KPP in: buoyFlux",G%HI,haloshift=0) - call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0) - call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0) + call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0, scale=GV%Z_to_m**2) endif #endif @@ -621,9 +622,7 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & if (CS%id_Kd_in > 0) call post_data(CS%id_Kd_in, Kt, CS%diag) - !$OMP parallel do default(private) firstprivate(nonLocalTrans) & - !$OMP shared(G,GV,CS,uStar,h,Waves,& - !$OMP buoyFlux,nonLocalTransHeat,nonLocalTransScalar,Kt,Ks,Kv) + !$OMP parallel do default(shared) firstprivate(nonLocalTrans) ! loop over horizontal points on processor do j = G%jsc, G%jec do i = G%isc, G%iec @@ -671,8 +670,8 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & Kdiffusivity(:,:) = 0. ! Diffusivities for heat and salt (m2/s) Kviscosity(:) = 0. ! Viscosity (m2/s) else - Kdiffusivity(:,1) = Kt(i,j,:) - Kdiffusivity(:,2) = Ks(i,j,:) + Kdiffusivity(:,1) = GV%Z_to_m**2 * Kt(i,j,:) + Kdiffusivity(:,2) = GV%Z_to_m**2 * Ks(i,j,:) Kviscosity(:) = GV%Z_to_m**2 * Kv(i,j,:) endif @@ -814,15 +813,15 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & if (.not. CS%passiveMode) then if (CS%KPPisAdditive) then do k=1, G%ke+1 - Kt(i,j,k) = Kt(i,j,k) + Kdiffusivity(k,1) - Ks(i,j,k) = Ks(i,j,k) + Kdiffusivity(k,2) + Kt(i,j,k) = Kt(i,j,k) + GV%m_to_Z**2 * Kdiffusivity(k,1) + Ks(i,j,k) = Ks(i,j,k) + GV%m_to_Z**2 * Kdiffusivity(k,2) Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kviscosity(k) if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = GV%Z_to_m**2 * Kv(i,j,k) enddo else ! KPP replaces prior diffusivity when former is non-zero do k=1, G%ke+1 - if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = Kdiffusivity(k,1) - if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = Kdiffusivity(k,2) + if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = GV%m_to_Z**2 * Kdiffusivity(k,1) + if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = GV%m_to_Z**2 * Kdiffusivity(k,2) if (Kviscosity(k) /= 0.) Kv(i,j,k) = GV%m_to_Z**2 * Kviscosity(k) if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = GV%Z_to_m**2 * Kv(i,j,k) enddo @@ -837,8 +836,8 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & #ifdef __DO_SAFETY_CHECKS__ if (CS%debug) then - call hchksum(Kt, "KPP out: Kt",G%HI,haloshift=0) - call hchksum(Ks, "KPP out: Ks",G%HI,haloshift=0) + call hchksum(Kt, "KPP out: Kt", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Ks, "KPP out: Ks", G%HI, haloshift=0, scale=GV%Z_to_m**2) endif #endif diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index 117c958acb..fc84367a87 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -136,10 +136,10 @@ logical function CVMix_ddiff_init(Time, G, GV, param_file, diag, CS) CS%diag => diag CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for temperature', 'm2 s-1') + 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for salinity', 'm2 s-1') + 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_R_rho = register_diag_field('ocean_model','R_rho',diag%axesTi,Time, & 'Double-diffusion density ratio', 'nondim') @@ -167,9 +167,9 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_T !< Interface double diffusion diapycnal - !! diffusivity for temp (m2/sec). + !! diffusivity for temp (Z2/sec). real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_S !< Interface double diffusion diapycnal - !! diffusivity for salt (m2/sec). + !! diffusivity for salt (Z2/sec). type(CVMix_ddiff_cs), pointer :: CS !< The control structure returned !! by a previous call to CVMix_ddiff_init. integer, intent(in) :: j !< Meridional grid indice. @@ -185,6 +185,9 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) beta_dS, & !< beta*dS across interfaces dT, & !< temp. difference between adjacent layers (degC) dS !< salt difference between adjacent layers + real, dimension(SZK_(G)+1) :: & + Kd1_T, & !< Diapycanal diffusivity of temperature, in m2 s-1. + Kd1_S !< Diapycanal diffusivity of salinity, in m2 s-1. real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) integer :: kOBL !< level of OBL extent @@ -196,8 +199,6 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) alpha_dT(:) = 0.0; beta_dS(:) = 0.0; dRho_dT(:) = 0.0 dRho_dS(:) = 0.0; dT(:) = 0.0; dS(:) = 0.0 - ! set Kd_T and Kd_S to zero to avoid passing values from previous call - Kd_T(:,j,:) = 0.0; Kd_S(:,j,:) = 0.0 ! GMM, I am leaving some code commented below. We need to pass BLD to ! this soubroutine to avoid adding diffusivity above that. This needs @@ -263,12 +264,17 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) ! gets index of the level and interface above hbl !kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl(i,j)) - call CVMix_coeffs_ddiff(Tdiff_out=Kd_T(i,j,:), & - Sdiff_out=Kd_S(i,j,:), & + Kd1_T(:) = 0.0 ; Kd1_S(:) = 0.0 + call CVMix_coeffs_ddiff(Tdiff_out=Kd1_T(:), & + Sdiff_out=Kd1_S(:), & strat_param_num=alpha_dT(:), & strat_param_denom=beta_dS(:), & nlev=G%ke, & max_nlev=G%ke) + do K=1,G%ke+1 + Kd_T(i,j,K) = GV%m_to_Z**2 * Kd1_T(K) + Kd_S(i,j,K) = GV%m_to_Z**2 * Kd1_S(K) + enddo ! Do not apply mixing due to convection within the boundary layer !do k=1,kOBL diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 1032bba617..df87d3fa1f 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -226,22 +226,21 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) b1_T, b1_S, & ! Variables used by the tridiagonal solvers of T & S, in H. d1_T, d1_S ! Variables used by the tridiagonal solvers, nondim. real, dimension(SZI_(G),SZK_(G)) :: & - c1_T, c1_S ! Variables used by the tridiagonal solvers, in m or kg m-2. + c1_T, c1_S ! Variables used by the tridiagonal solvers, in H. real, dimension(SZI_(G),SZK_(G)+1) :: & - mix_T, mix_S ! Mixing distances in both directions across each - ! interface, in m or kg m-2. + mix_T, mix_S ! Mixing distances in both directions across each interface, in H. real :: h_tr ! h_tr is h at tracer points with a tiny thickness - ! added to ensure positive definiteness, in m or kg m-2. + ! added to ensure positive definiteness, in H. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m or kg m-2. + ! in roundoff and can be neglected, in H. real :: I_h_int ! The inverse of the thickness associated with an - ! interface, in m-1 or m2 kg-1. + ! interface, in H-1. real :: b_denom_T ! The first term in the denominators for the expressions - real :: b_denom_S ! for b1_T and b1_S, both in m or kg m-2. - - integer :: i, j, k, is, ie, js, je, nz + real :: b_denom_S ! for b1_T and b1_S, both in H. real, dimension(:,:,:), pointer :: T=>NULL(), S=>NULL() - real, dimension(:,:,:), pointer :: Kd_T=>NULL(), Kd_S=>NULL() + real, dimension(:,:,:), pointer :: Kd_T=>NULL(), Kd_S=>NULL() ! Diffusivities in Z2 s-1. + integer :: i, j, k, is, ie, js, je, nz + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke h_neglect = GV%H_subroundoff @@ -262,8 +261,8 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) do j=js,je do i=is,ie I_h_int = 1.0 / (0.5 * (h(i,j,1) + h(i,j,2)) + h_neglect) - mix_T(i,2) = ((dt * Kd_T(i,j,2)) * GV%m_to_H**2) * I_h_int - mix_S(i,2) = ((dt * Kd_S(i,j,2)) * GV%m_to_H**2) * I_h_int + mix_T(i,2) = ((dt * Kd_T(i,j,2)) * GV%Z_to_H**2) * I_h_int + mix_S(i,2) = ((dt * Kd_S(i,j,2)) * GV%Z_to_H**2) * I_h_int h_tr = h(i,j,1) + h_neglect b1_T(i) = 1.0 / (h_tr + mix_T(i,2)) @@ -276,8 +275,8 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) do k=2,nz-1 ; do i=is,ie ! Calculate the mixing across the interface below this layer. I_h_int = 1.0 / (0.5 * (h(i,j,k) + h(i,j,k+1)) + h_neglect) - mix_T(i,K+1) = ((dt * Kd_T(i,j,K+1)) * GV%m_to_H**2) * I_h_int - mix_S(i,K+1) = ((dt * Kd_S(i,j,K+1)) * GV%m_to_H**2) * I_h_int + mix_T(i,K+1) = ((dt * Kd_T(i,j,K+1)) * GV%Z_to_H**2) * I_h_int + mix_S(i,K+1) = ((dt * Kd_S(i,j,K+1)) * GV%Z_to_H**2) * I_h_int c1_T(i,k) = mix_T(i,K) * b1_T(i) c1_S(i,k) = mix_S(i,K) * b1_S(i) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 46ee54ee94..95b3c3d368 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -323,8 +323,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & Kd_int, & ! diapycnal diffusivity of interfaces (m^2/s) - Kd_heat, & ! diapycnal diffusivity of heat (m^2/s) - Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (m^2/s) + Kd_heat, & ! diapycnal diffusivity of heat (Z^2/s) + Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (Z^2/s) Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (m^2/s) eta, & ! Interface heights before diapycnal mixing, in m. Tdif_flx, & ! diffusive diapycnal heat flux across interfaces (K m/s) @@ -384,7 +384,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & integer :: ig, jg ! global indices for testing testing itide point source (BDM) logical :: avg_enabled ! for testing internal tides (BDM) - real :: Kd_add_here ! An added diffusivity in m2/s + real :: Kd_add_here ! An added diffusivity in Z2/s is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -561,33 +561,31 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! Set diffusivities for heat and salt separately -!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,Kd_heat) -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = Kd_int(i,j,k) - Kd_heat(i,j,k) = Kd_int(i,j,k) + Kd_salt(i,j,k) = GV%m_to_Z**2 * Kd_int(i,j,k) + Kd_heat(i,j,k) = GV%m_to_Z**2 * Kd_int(i,j,k) enddo ; enddo ; enddo ! Add contribution from double diffusion if (associated(visc%Kd_extra_S)) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie Kd_salt(i,j,k) = Kd_salt(i,j,k) + visc%Kd_extra_S(i,j,k) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k) enddo ; enddo ; enddo endif -!$OMP end parallel if (CS%debug) then call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G) - call hchksum(Kd_heat, "after set_diffusivity Kd_heat",G%HI,haloshift=0) - call hchksum(Kd_salt, "after set_diffusivity Kd_salt",G%HI,haloshift=0) + call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=GV%Z_to_m**2) endif if (CS%useKPP) then @@ -625,8 +623,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) - call hchksum(Kd_heat, "after KPP Kd_heat",G%HI,haloshift=0) - call hchksum(Kd_salt, "after KPP Kd_salt",G%HI,haloshift=0) + call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=GV%Z_to_m**2) endif endif ! endif for KPP @@ -670,13 +668,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! increment heat and salt diffusivity. ! CS%useKPP==.true. already has extra_T and extra_S included if (.not. CS%useKPP) then -!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,visc,Kd_heat) -!$OMP do + !$OMP parallel do default(shared) do K=2,nz ; do j=js,je ; do i=is,ie Kd_heat(i,j,K) = Kd_heat(i,j,K) + visc%Kd_extra_T(i,j,K) Kd_salt(i,j,K) = Kd_salt(i,j,K) + visc%Kd_extra_S(i,j,K) enddo ; enddo ; enddo -!$OMP end parallel endif endif @@ -685,18 +681,16 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%use_CVMix_conv) then call calculate_CVMix_conv(h, tv, G, GV, CS%CVMix_conv_csp, Hml) ! Increment vertical diffusion and viscosity due to convection -!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,visc,CS,Kd_heat) -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_heat(i,j,k) = Kd_heat(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) - Kd_salt(i,j,k) = Kd_salt(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) + Kd_heat(i,j,k) = Kd_heat(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kd_conv(i,j,k) + Kd_salt(i,j,k) = Kd_salt(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kd_conv(i,j,k) if (CS%useKPP) then visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kv_conv(i,j,k) else visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kv_conv(i,j,k) endif enddo ; enddo ; enddo -!$OMP end parallel endif ! Save fields before boundary forcing is applied for tendency diagnostics @@ -747,10 +741,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & do K=2,nz ; do j=js,je ; do i=is,ie !### These expressesions assume a Prandtl number of 1. if (CS%ePBL_is_additive) then - Kd_add_here = Kd_ePBL(i,j,K) + Kd_add_here = GV%m_to_Z**2 * Kd_ePBL(i,j,K) visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + GV%m_to_Z**2 * Kd_ePBL(i,j,K) else - Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) + Kd_add_here = GV%m_to_Z**2 * max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), GV%m_to_Z**2 * Kd_ePBL(i,j,K)) endif @@ -829,17 +823,16 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ea_t(i,j,1) = 0.; ea_s(i,j,1) = 0. enddo ; enddo -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_neglect,h,ea_t,ea_s,GV,dt,Kd_salt,Kd_heat,eb_t,eb_s) & -!$OMP private(hval) + !$OMP parallel do default(shared) private(hval) do k=2,nz ; do j=js,je ; do i=is,ie - hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea_t(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_heat(i,j,k) + hval = 1.0 / (h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) + ea_t(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_heat(i,j,k) eb_t(i,j,k-1) = ea_t(i,j,k) - ea_s(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_salt(i,j,k) + ea_s(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_salt(i,j,k) eb_s(i,j,k-1) = ea_s(i,j,k) enddo ; enddo ; enddo do j=js,je ; do i=is,ie - eb_t(i,j,nz) = 0.; eb_s(i,j,nz) = 0. + eb_t(i,j,nz) = 0. ; eb_s(i,j,nz) = 0. enddo ; enddo if (showCallTree) call callTree_waypoint("done setting ea_t,ea_s,eb_t,eb_s from Kd_heat" //& "and Kd_salt (diabatic)") @@ -958,7 +951,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / & + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.5 * (h(i,j,k-1) + h(i,j,k)) + & h_neglect) ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent @@ -984,7 +977,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & !$OMP parallel do default(shared) private(add_ent) do k=nz,2,-1 ; do j=js,je ; do i=is,ie if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / & + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.5 * (h(i,j,k-1) + h(i,j,k)) + & h_neglect) else @@ -1204,8 +1197,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & Kd_int, & ! diapycnal diffusivity of interfaces (m^2/s) - Kd_heat, & ! diapycnal diffusivity of heat (m^2/s) - Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (m^2/s) + Kd_heat, & ! diapycnal diffusivity of heat (Z^2/s) + Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (Z^2/s) Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (m^2/s) eta, & ! Interface heights before diapycnal mixing, in m. Tdif_flx, & ! diffusive diapycnal heat flux across interfaces (K m/s) @@ -1265,7 +1258,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en integer :: ig, jg ! global indices for testing testing itide point source (BDM) logical :: avg_enabled ! for testing internal tides (BDM) - real :: Kd_add_here ! An added diffusivity in m2/s + real :: Kd_add_here ! An added diffusivity in Z2/s is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -1511,32 +1504,29 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) ! The KPP scheme calculates boundary layer diffusivities and non-local transport. -!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,Kd_heat) -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = Kd_int(i,j,k) - Kd_heat(i,j,k) = Kd_int(i,j,k) + Kd_salt(i,j,k) = GV%m_to_Z**2 * Kd_int(i,j,k) + Kd_heat(i,j,k) = GV%m_to_Z**2 * Kd_int(i,j,k) enddo ; enddo ; enddo if (associated(visc%Kd_extra_S)) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie Kd_salt(i,j,k) = Kd_salt(i,j,k) + visc%Kd_extra_S(i,j,k) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k) enddo ; enddo ; enddo endif -!$OMP end parallel call KPP_compute_BLD(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, & fluxes%ustar, CS%KPP_buoy_flux) call KPP_calculate(CS%KPP_CSp, G, GV, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) -!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,G,Kd_heat,Hml) if (associated(Hml)) then call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G) @@ -1544,24 +1534,24 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en endif if (.not. CS%KPPisPassive) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_int(i,j,k) = min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) + Kd_int(i,j,k) = GV%Z_to_m**2 * min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) enddo ; enddo ; enddo if (associated(visc%Kd_extra_S)) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_S(i,j,k) = Kd_salt(i,j,k) - Kd_int(i,j,k) + visc%Kd_extra_S(i,j,k) = (Kd_salt(i,j,k) - GV%m_to_Z**2 * Kd_int(i,j,k)) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then -!$OMP do + !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_T(i,j,k) = Kd_heat(i,j,k) - Kd_int(i,j,k) + visc%Kd_extra_T(i,j,k) = (Kd_heat(i,j,k) - GV%m_to_Z**2 * Kd_int(i,j,k)) enddo ; enddo ; enddo endif endif ! not passive -!$OMP end parallel + call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") if (CS%debug) then @@ -1725,21 +1715,21 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en do K=2,nz ; do j=js,je ; do i=is,ie if (CS%ePBL_is_additive) then - Kd_add_here = Kd_ePBL(i,j,K) + Kd_add_here = GV%m_to_Z**2 * Kd_ePBL(i,j,K) visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + GV%m_to_Z**2 * Kd_ePBL(i,j,K) else - Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) + Kd_add_here = GV%m_to_Z**2 * max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), GV%m_to_Z**2 * Kd_ePBL(i,j,K)) endif - Ent_int = Kd_add_here * (GV%m_to_H**2 * dt) / & + Ent_int = Kd_add_here * (GV%Z_to_H**2 * dt) / & (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) eb(i,j,k-1) = eb(i,j,k-1) + Ent_int ea(i,j,k) = ea(i,j,k) + Ent_int - Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here + Kd_int(i,j,K) = Kd_int(i,j,K) + GV%Z_to_m**2 * Kd_add_here ! for diagnostics - Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_int(i,j,K) - Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_int(i,j,K) + Kd_heat(i,j,K) = Kd_heat(i,j,K) + GV%m_to_Z**2 * Kd_int(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + GV%m_to_Z**2 * Kd_int(i,j,K) enddo ; enddo ; enddo @@ -2103,7 +2093,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ebtr(i,j,k-1) = eb(i,j,k-1) ; eatr(i,j,k) = ea(i,j,k) endif if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / & + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & h_neglect) ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent @@ -2134,7 +2124,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !$OMP parallel do default(shared) private(add_ent) do k=nz,2,-1 ; do j=js,je ; do i=is,ie if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_to_H**2) / & + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & h_neglect) else @@ -3060,19 +3050,19 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, endif CS%id_Kd_heat = register_diag_field('ocean_model', 'Kd_heat', diag%axesTi, Time, & - 'Total diapycnal diffusivity for heat at interfaces', 'm2 s-1', & + 'Total diapycnal diffusivity for heat at interfaces', 'm2 s-1', conversion=GV%Z_to_m**2, & cmor_field_name='difvho', & cmor_standard_name='ocean_vertical_heat_diffusivity', & cmor_long_name='Ocean vertical heat diffusivity') CS%id_Kd_salt = register_diag_field('ocean_model', 'Kd_salt', diag%axesTi, Time, & - 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', & + 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', conversion=GV%Z_to_m**2, & cmor_field_name='difvso', & cmor_standard_name='ocean_vertical_salt_diffusivity', & cmor_long_name='Ocean vertical salt diffusivity') ! CS%useKPP is set to True if KPP-scheme is to be used, False otherwise. ! KPP_init() allocated CS%KPP_Csp and also sets CS%KPPisPassive - CS%useKPP = KPP_init(param_file, G, diag, Time, CS%KPP_CSp, passive=CS%KPPisPassive) + CS%useKPP = KPP_init(param_file, G, GV, diag, Time, CS%KPP_CSp, passive=CS%KPPisPassive) if (CS%useKPP) then allocate( CS%KPP_NLTheat(isd:ied,jsd:jed,nz+1) ) ; CS%KPP_NLTheat(:,:,:) = 0. allocate( CS%KPP_NLTscalar(isd:ied,jsd:jed,nz+1) ) ; CS%KPP_NLTscalar(:,:,:) = 0. diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index c82037d2d7..9062bb9659 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -409,12 +409,12 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (KS_extra(i,K) > KT_extra(i,K)) then ! salt fingering Kd(i,j,k-1) = Kd(i,j,k-1) + 0.5*KT_extra(i,K) Kd(i,j,k) = Kd(i,j,k) + 0.5*KT_extra(i,K) - visc%Kd_extra_S(i,j,k) = KS_extra(i,K)-KT_extra(i,K) + visc%Kd_extra_S(i,j,k) = GV%m_to_Z**2 * (KS_extra(i,K) - KT_extra(i,K)) visc%Kd_extra_T(i,j,k) = 0.0 elseif (KT_extra(i,K) > 0.0) then ! double-diffusive convection Kd(i,j,k-1) = Kd(i,j,k-1) + 0.5*KS_extra(i,K) Kd(i,j,k) = Kd(i,j,k) + 0.5*KS_extra(i,K) - visc%Kd_extra_T(i,j,k) = KT_extra(i,K)-KS_extra(i,K) + visc%Kd_extra_T(i,j,k) = GV%m_to_Z**2 * (KT_extra(i,K) - KS_extra(i,K)) visc%Kd_extra_S(i,j,k) = 0.0 else ! There is no double diffusion at this interface. visc%Kd_extra_T(i,j,k) = 0.0 @@ -534,8 +534,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%useKappaShear) call hchksum(visc%Kd_shear,"Turbulent Kd",G%HI,haloshift=0) if (CS%use_CVMix_ddiff) then - call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T",G%HI,haloshift=0) - call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S",G%HI,haloshift=0) + call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S", G%HI, haloshift=0, scale=GV%Z_to_m**2) endif if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then From 573216994e1d41560895ae02aedca5fc2fc301d7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 3 Oct 2018 18:11:19 -0400 Subject: [PATCH 0775/1072] +Changed the units of visc%Kd_shear to Z-2 s-1 Rescaled the units of visc%Kd_shear, and Kd_ePBL from m2 s-1 to Z2 s-1 for dimensional consistency testing. Also corrected some array initialization lines in CVMix_shear_init that could have led to segmentation faults if certain entries are missing from the diag table. All answers are bitwise identical, including rescaling Z over a large range. --- src/core/MOM_variables.F90 | 2 +- .../vertical/MOM_CVMix_shear.F90 | 39 +++++++++++-------- .../vertical/MOM_diabatic_driver.F90 | 26 ++++++------- .../vertical/MOM_energetic_PBL.F90 | 35 ++--------------- .../vertical/MOM_kappa_shear.F90 | 16 ++++---- .../vertical/MOM_set_diffusivity.F90 | 16 ++++---- .../vertical/MOM_set_viscosity.F90 | 10 ++--- 7 files changed, 61 insertions(+), 83 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 14ab156793..91e3e48af3 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -234,7 +234,7 @@ module MOM_variables ! DOUBLE_DIFFUSION is true. real, pointer, dimension(:,:,:) :: Kd_shear => NULL() !< The shear-driven turbulent diapycnal diffusivity at the interfaces between layers - !! in tracer columns, in m2 s-1. + !! in tracer columns, in Z2 s-1. real, pointer, dimension(:,:,:) :: Kv_shear => NULL() !< The shear-driven turbulent vertical viscosity at the interfaces between layers !! in tracer columns, in Z2 s-1. diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index cdaccafca5..a22bda0d9d 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -59,7 +59,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface - !! (not layer!) in m2 s-1. + !! (not layer!) in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface !! (not layer!) in Z2 s-1. type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous call to @@ -70,7 +70,8 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & real :: pref, DU, DV, DRHO, DZ, N2, S2, dummy real, dimension(2*(G%ke)) :: pres_1d, temp_1d, salt_1d, rho_1d real, dimension(G%ke+1) :: Ri_Grad !< Gradient Richardson number - real, dimension(G%ke+1) :: Kvisc ! Vertical viscosity at interfaces (m2/s) + real, dimension(G%ke+1) :: Kvisc !< Vertical viscosity at interfaces (m2/s) + real, dimension(G%ke+1) :: Kdiff !< Diapycnal diffusivity at interfaces (m2/s) real, parameter :: epsln = 1.e-10 !< Threshold to identify vanished layers ! some constants @@ -148,18 +149,20 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & if (CS%id_ri_grad_smooth > 0) CS%ri_grad_smooth(i,j,:) = Ri_Grad(:) endif - do k=1,G%ke+1 - Kvisc(k) = GV%Z_to_m**2 * kv(i,j,k) + do K=1,G%ke+1 + Kvisc(K) = GV%Z_to_m**2 * kv(i,j,K) + Kdiff(K) = GV%Z_to_m**2 * kd(i,j,K) enddo ! Call to CVMix wrapper for computing interior mixing coefficients. call CVMix_coeffs_shear(Mdiff_out=Kvisc(:), & - Tdiff_out=kd(i,j,:), & + Tdiff_out=Kdiff(:), & RICH=Ri_Grad(:), & nlev=G%ke, & max_nlev=G%ke) - do k=1,G%ke+1 - kv(i,j,k) = GV%m_to_Z**2 * Kvisc(k) + do K=1,G%ke+1 + kv(i,j,K) = GV%m_to_Z**2 * Kvisc(K) + kd(i,j,K) = GV%m_to_Z**2 * Kdiff(K) enddo enddo enddo @@ -255,27 +258,31 @@ logical function CVMix_shear_init(Time, G, GV, param_file, diag, CS) CS%id_N2 = register_diag_field('ocean_model', 'N2_shear', diag%axesTi, Time, & 'Square of Brunt-Vaisala frequency used by MOM_CVMix_shear module', '1/s2') - if (CS%id_N2 > 0) & - allocate( CS%N2( SZI_(G), SZJ_(G), SZK_(G)+1 ) );CS%N2(:,:,:) = 0. + if (CS%id_N2 > 0) then + allocate( CS%N2( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) ; CS%N2(:,:,:) = 0. + endif CS%id_S2 = register_diag_field('ocean_model', 'S2_shear', diag%axesTi, Time, & 'Square of vertical shear used by MOM_CVMix_shear module','1/s2') - if (CS%id_S2 > 0) & - allocate( CS%S2( SZI_(G), SZJ_(G), SZK_(G)+1 ) );CS%S2(:,:,:) = 0. + if (CS%id_S2 > 0) then + allocate( CS%S2( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) ; CS%S2(:,:,:) = 0. + endif CS%id_ri_grad = register_diag_field('ocean_model', 'ri_grad_shear', diag%axesTi, Time, & 'Gradient Richarson number used by MOM_CVMix_shear module','nondim') - if (CS%id_ri_grad > 0) & !Initialize w/ large Richardson value - allocate( CS%ri_grad( SZI_(G), SZJ_(G), SZK_(G)+1 ));CS%ri_grad(:,:,:) = 1.e8 + if (CS%id_ri_grad > 0) then !Initialize w/ large Richardson value + allocate( CS%ri_grad( SZI_(G), SZJ_(G), SZK_(G)+1 )) ; CS%ri_grad(:,:,:) = 1.e8 + endif CS%id_ri_grad_smooth = register_diag_field('ocean_model', 'ri_grad_shear_smooth', & diag%axesTi, Time, & 'Smoothed gradient Richarson number used by MOM_CVMix_shear module','nondim') - if (CS%id_ri_grad_smooth > 0) & !Initialize w/ large Richardson value - allocate( CS%ri_grad_smooth( SZI_(G), SZJ_(G), SZK_(G)+1 ));CS%ri_grad_smooth(:,:,:) = 1.e8 + if (CS%id_ri_grad_smooth > 0) then !Initialize w/ large Richardson value + allocate( CS%ri_grad_smooth( SZI_(G), SZJ_(G), SZK_(G)+1 )) ; CS%ri_grad_smooth(:,:,:) = 1.e8 + endif CS%id_kd = register_diag_field('ocean_model', 'kd_shear_CVMix', diag%axesTi, Time, & - 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s') + 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s', conversion=GV%Z_to_m**2) CS%id_kv = register_diag_field('ocean_model', 'kv_shear_CVMix', diag%axesTi, Time, & 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s', conversion=GV%Z_to_m**2) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 95b3c3d368..65af1f4f2b 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -325,7 +325,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & Kd_int, & ! diapycnal diffusivity of interfaces (m^2/s) Kd_heat, & ! diapycnal diffusivity of heat (Z^2/s) Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (Z^2/s) - Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (m^2/s) + Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (Z^2/s) eta, & ! Interface heights before diapycnal mixing, in m. Tdif_flx, & ! diffusive diapycnal heat flux across interfaces (K m/s) Tadv_flx, & ! advective diapycnal heat flux across interfaces (K m/s) @@ -741,11 +741,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & do K=2,nz ; do j=js,je ; do i=is,ie !### These expressesions assume a Prandtl number of 1. if (CS%ePBL_is_additive) then - Kd_add_here = GV%m_to_Z**2 * Kd_ePBL(i,j,K) - visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + GV%m_to_Z**2 * Kd_ePBL(i,j,K) + Kd_add_here = Kd_ePBL(i,j,K) + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) else - Kd_add_here = GV%m_to_Z**2 * max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) - visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), GV%m_to_Z**2 * Kd_ePBL(i,j,K)) + Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) + visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) endif Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_add_here @@ -758,7 +758,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call hchksum(eb_t, "after ePBL eb_t",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(ea_s, "after ePBL ea_s",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(eb_s, "after ePBL eb_s",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL",G%HI,haloshift=0) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=GV%Z_to_m**2) endif else @@ -1199,7 +1199,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en Kd_int, & ! diapycnal diffusivity of interfaces (m^2/s) Kd_heat, & ! diapycnal diffusivity of heat (Z^2/s) Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (Z^2/s) - Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (m^2/s) + Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (Z^2/s) eta, & ! Interface heights before diapycnal mixing, in m. Tdif_flx, & ! diffusive diapycnal heat flux across interfaces (K m/s) Tadv_flx, & ! advective diapycnal heat flux across interfaces (K m/s) @@ -1715,11 +1715,11 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en do K=2,nz ; do j=js,je ; do i=is,ie if (CS%ePBL_is_additive) then - Kd_add_here = GV%m_to_Z**2 * Kd_ePBL(i,j,K) - visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + GV%m_to_Z**2 * Kd_ePBL(i,j,K) + Kd_add_here = Kd_ePBL(i,j,K) + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) else - Kd_add_here = GV%m_to_Z**2 * max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) - visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), GV%m_to_Z**2 * Kd_ePBL(i,j,K)) + Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) + visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) endif Ent_int = Kd_add_here * (GV%Z_to_H**2 * dt) / & (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) @@ -1736,7 +1736,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%debug) then call hchksum(ea, "after ePBL ea",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(eb, "after ePBL eb",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL",G%HI,haloshift=0) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=GV%Z_to_m**2) endif else @@ -3046,7 +3046,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, 'Total diapycnal diffusivity at interfaces', 'm2 s-1') if (CS%use_energetic_PBL) then CS%id_Kd_ePBL = register_diag_field('ocean_model', 'Kd_ePBL', diag%axesTi, Time, & - 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1') + 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1', conversion=GV%Z_to_m**2) endif CS%id_Kd_heat = register_diag_field('ocean_model', 'Kd_heat', diag%axesTi, Time, & diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 590b866761..a105bfa6e3 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -183,9 +183,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h_3d !< Layer thickness, in m or kg m-2. - !! (Intent in/out) The units of h are referred - !! to as H below. + intent(inout) :: h_3d !< Layer thicknesses, in H (usually m or kg m-2). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u_3d !< Zonal velocities interpolated to h points, !! m s-1. @@ -212,7 +210,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & real, intent(in) :: dt !< Time increment, in s. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces, - !! in m2 s-1. + !! in Z2 s-1. type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous !! call to mixedlayer_init. real, dimension(SZI_(G),SZJ_(G)), & @@ -257,33 +255,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & ! For a traditional Kraus-Turner mixed layer, the values are: ! mstar = 1.25, nstar = 0.4, TKE_decay = 0.0, conv_decay = 0.0 -! Arguments: h_3d - Layer thickness, in m or kg m-2. (Intent in/out) -! The units of h are referred to as H below. -! (in) u_3d - Zonal velocities interpolated to h points, m s-1. -! (in) v_3d - Zonal velocities interpolated to h points, m s-1. -! (in/out) tv - A structure containing pointers to any available -! thermodynamic fields. Absent fields have NULL ptrs. -! (in) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) dt - Time increment, in s. -! (out) Kd_int - The diagnosed diffusivities at interfaces, in m2 s-1. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! mixedlayer_init. -! (in) dSV_dT - The partial derivative of in-situ specific volume with -! potential temperature, in m3 kg-1 K-1. -! (in) dSV_dS - The partial derivative of in-situ specific volume with -! salinity, in m3 kg-1 ppt-1. -! (in) TKE_forced - The forcing requirements to homogenize the forcing -! that has been applied to each layer through each layer, in J m-2. -! (in) Buoy_Flux - The surface buoyancy flux. in m2/s3. -! (in,opt) dt_diag - The diagnostic time step, which may be less than dt -! if there are two callse to mixedlayer, in s. -! (in,opt) last_call - if true, this is the last call to mixedlayer in the -! current time step, so diagnostics will be written. -! The default is .true. - real, dimension(SZI_(G),SZK_(GV)) :: & h, & ! The layer thickness, in H (usually m or kg m-2). T, & ! The layer temperatures, in deg C. @@ -1503,7 +1474,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif do K=1,nz+1 ; do i=is,ie - Kd_int(i,j,K) = Kd(i,K) + Kd_int(i,j,K) = GV%m_to_Z**2 * Kd(i,K) enddo ; enddo enddo ! j-loop diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 79cc4f633c..a6613ed39b 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -101,7 +101,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & !! (or NULL). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: kappa_io !< The diapycnal diffusivity at each interface - !! (not layer!) in m2 s-1. Initially this is the + !! (not layer!) in Z2 s-1. Initially this is the !! value from the previous timestep, which may !! accelerate the iteration toward convergence. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & @@ -215,7 +215,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & rho_2d(i,k) = GV%Rlay(k) ! Could be tv%Rho(i,j,k) ? enddo ; enddo ; endif if (.not.new_kappa) then ; do K=1,nz+1 ; do i=is,ie - kappa_2d(i,K) = kappa_io(i,j,K) + kappa_2d(i,K) = GV%Z_to_m**2*kappa_io(i,j,K) enddo ; enddo ; endif !--------------------------------------- @@ -348,7 +348,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & endif ; enddo ! i-loop do K=1,nz+1 ; do i=is,ie - kappa_io(i,j,K) = G%mask2dT(i,j) * kappa_2d(i,K) + kappa_io(i,j,K) = GV%m_to_Z**2 * G%mask2dT(i,j) * kappa_2d(i,K) tke_io(i,j,K) = G%mask2dT(i,j) * tke_2d(i,K) kv_io(i,j,K) = GV%m_to_Z**2 * ( G%mask2dT(i,j) * kappa_2d(i,K) ) * CS%Prandtl_turb #ifdef ADD_DIAGNOSTICS @@ -360,7 +360,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & enddo ! end of j-loop if (CS%debug) then - call hchksum(kappa_io, "kappa", G%HI) + call hchksum(kappa_io, "kappa", G%HI, scale=GV%Z_to_m**2) call hchksum(tke_io, "tke", G%HI) endif @@ -396,7 +396,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ !! (or NULL). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: kappa_io !< The diapycnal diffusivity at each interface - !! (not layer!) in m2 s-1. + !! (not layer!) in Z2 s-1. real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & intent(inout) :: tke_io !< The turbulent kinetic energy per unit mass at !! each interface (not layer!) in m2 s-2. @@ -686,7 +686,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ enddo ; enddo if (J>=G%jsc) then ; do K=1,nz+1 ; do i=G%isc,G%iec ! Set the diffusivities in tracer columns from the values at vertices. - kappa_io(i,j,K) = G%mask2dT(i,j) * 0.25 * & + kappa_io(i,j,K) = GV%m_to_Z**2 * G%mask2dT(i,j) * 0.25 * & ((kappa_2d(I-1,K,J2m1) + kappa_2d(I,K,J2)) + & (kappa_2d(I-1,K,J2) + kappa_2d(I,K,J2m1))) enddo ; enddo ; endif @@ -694,7 +694,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ enddo ! end of J-loop if (CS%debug) then - call hchksum(kappa_io, "kappa", G%HI) + call hchksum(kappa_io, "kappa", G%HI, scale=GV%Z_to_m**2) call Bchksum(tke_io, "tke", G%HI) endif @@ -2098,7 +2098,7 @@ function kappa_shear_init(Time, G, GV, param_file, diag, CS) CS%diag => diag CS%id_Kd_shear = register_diag_field('ocean_model','Kd_shear',diag%axesTi,Time, & - 'Shear-driven Diapycnal Diffusivity', 'm2 s-1') + 'Shear-driven Diapycnal Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_TKE = register_diag_field('ocean_model','TKE_shear',diag%axesTi,Time, & 'Shear-driven Turbulent Kinetic Energy', 'm2 s-2') #ifdef ADD_DIAGNOSTICS diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 9062bb9659..a28751fb66 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -353,9 +353,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & visc%TKE_turb, visc%Kv_shear_Bu, dt, G, GV, CS%kappaShear_CSp) if (associated(visc%Kv_shear)) visc%Kv_shear(:,:,:) = 0.0 ! needed for other parameterizations if (CS%debug) then - call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear",G%HI) + call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear", G%HI, scale=GV%Z_to_m**2) call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu", G%HI, scale=GV%Z_to_m**2) - call Bchksum(visc%TKE_turb, "after calc_KS_vert visc%TKE_turb",G%HI) + call Bchksum(visc%TKE_turb, "after calc_KS_vert visc%TKE_turb", G%HI) endif else ! Changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ????) @@ -363,7 +363,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call calculate_kappa_shear(u_h, v_h, h, tv, fluxes%p_surf, visc%Kd_shear, visc%TKE_turb, & visc%Kv_shear, dt, G, GV, CS%kappaShear_CSp) if (CS%debug) then - call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI) + call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI, scale=GV%Z_to_m**2) call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear", G%HI, scale=GV%Z_to_m**2) call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb", G%HI) endif @@ -374,7 +374,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & !NOTE{BGR}: this needs to be cleaned up. It works in 1D case, but has not been tested outside. call calculate_CVMix_shear(u_h, v_h, h, tv, visc%Kd_shear, visc%Kv_shear, G, GV, CS%CVMix_shear_CSp) if (CS%debug) then - call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear", G%HI) + call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear", G%HI, scale=GV%Z_to_m**2) call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear", G%HI, scale=GV%Z_to_m**2) endif elseif (associated(visc%Kv_shear)) then @@ -442,15 +442,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%useKappaShear .or. CS%use_CVMix_shear) then if (present(Kd_int)) then do K=2,nz ; do i=is,ie - Kd_int(i,j,K) = visc%Kd_shear(i,j,K) + 0.5*(Kd(i,j,k-1) + Kd(i,j,k)) + Kd_int(i,j,K) = GV%Z_to_m**2 * visc%Kd_shear(i,j,K) + 0.5*(Kd(i,j,k-1) + Kd(i,j,k)) enddo ; enddo do i=is,ie - Kd_int(i,j,1) = visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. + Kd_int(i,j,1) = GV%Z_to_m**2 * visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. Kd_int(i,j,nz+1) = 0.0 enddo endif do k=1,nz ; do i=is,ie - Kd(i,j,k) = Kd(i,j,k) + 0.5*(visc%Kd_shear(i,j,K) + visc%Kd_shear(i,j,K+1)) + Kd(i,j,k) = Kd(i,j,k) + GV%Z_to_m**2 * 0.5*(visc%Kd_shear(i,j,K) + visc%Kd_shear(i,j,K+1)) enddo ; enddo else if (present(Kd_int)) then @@ -531,7 +531,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%debug) then call hchksum(Kd ,"Kd",G%HI,haloshift=0) - if (CS%useKappaShear) call hchksum(visc%Kd_shear,"Turbulent Kd",G%HI,haloshift=0) + if (CS%useKappaShear) call hchksum(visc%Kd_shear, "Turbulent Kd", G%HI, haloshift=0, scale=GV%Z_to_m**2) if (CS%use_CVMix_ddiff) then call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T", G%HI, haloshift=0, scale=GV%Z_to_m**2) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 2f8e5460a8..f1906aad7f 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -2059,11 +2059,11 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, restart_CS, OB if ((GV%m_to_Z_restart /= 0.0) .and. (GV%m_to_Z_restart /= GV%m_to_Z)) then Z_rescale = GV%m_to_Z / GV%m_to_Z_restart -! if (associated(visc%Kd_shear)) then ; if (query_initialized(visc%Kd_shear, "Kd_shear", restart_CS)) then -! do k=1,nz+1 ; do j=js,je ; do i=is,ie -! visc%Kd_shear(i,j,k) = Z_rescale**2 * visc%Kd_shear(i,j,k) -! enddo ; enddo ; enddo -! endif ; endif + if (associated(visc%Kd_shear)) then ; if (query_initialized(visc%Kd_shear, "Kd_shear", restart_CS)) then + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kd_shear(i,j,k) = Z_rescale**2 * visc%Kd_shear(i,j,k) + enddo ; enddo ; enddo + endif ; endif if (associated(visc%Kv_shear)) then ; if (query_initialized(visc%Kv_shear, "Kv_shear", restart_CS)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie From 314210c05475b4b3d883d80e049b2d2f64061505 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 06:35:33 -0400 Subject: [PATCH 0776/1072] +Changed the units of CVMix%kd_conv to Z-2 s-1 Rescaled the units of Kd_conv and Kv_conv in the CVMix_conv control structure from m2 s-1 to Z2 s-1 for dimensional consistency testing. Also simplified the code around some unit scaling factors, and added the correct conversion factors to 3 mixed layer depth diagnostics. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_CVMix_conv.F90 | 27 ++++++++------ .../vertical/MOM_diabatic_aux.F90 | 16 ++++----- .../vertical/MOM_diabatic_driver.F90 | 35 ++++++++++--------- 3 files changed, 43 insertions(+), 35 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 9407e4d1e3..e552cae9c4 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -132,9 +132,9 @@ logical function CVMix_conv_init(Time, G, GV, param_file, diag, CS) CS%id_N2 = register_diag_field('ocean_model', 'N2_conv', diag%axesTi, Time, & 'Square of Brunt-Vaisala frequency used by MOM_CVMix_conv module', '1/s2') CS%id_kd_conv = register_diag_field('ocean_model', 'kd_conv', diag%axesTi, Time, & - 'Additional diffusivity added by MOM_CVMix_conv module', 'm2/s') + 'Additional diffusivity added by MOM_CVMix_conv module', 'm2/s', conversion=GV%Z_to_m**2) CS%id_kv_conv = register_diag_field('ocean_model', 'kv_conv', diag%axesTi, Time, & - 'Additional viscosity added by MOM_CVMix_conv module', 'm2/s') + 'Additional viscosity added by MOM_CVMix_conv module', 'm2/s', conversion=GV%Z_to_m**2) call CVMix_init_conv(convect_diff=CS%kd_conv_const, & convect_visc=CS%kv_conv_const, & @@ -160,6 +160,8 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, CS, hbl) !! computed based on Brunt Vaisala. real, dimension(SZK_(G)) :: rho_1d !< water density in a column, this is also !! a dummy variable, same reason as above. + real, dimension(SZK_(G)+1) :: kv_col !< Viscosities at interfaces in the column (m2 s-1) + real, dimension(SZK_(G)+1) :: kd_col !< Diffusivities at interfaces in the column (m2 s-1) real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m) integer :: kOBL !< level of OBL extent @@ -215,20 +217,25 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, CS, hbl) ! gets index of the level and interface above hbl kOBL = CVMix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl(i,j)) - call CVMix_coeffs_conv(Mdiff_out=CS%kv_conv(i,j,:), & - Tdiff_out=CS%kd_conv(i,j,:), & + kv_col(:) = 0.0 ; kd_col(:) = 0.0 + call CVMix_coeffs_conv(Mdiff_out=kv_col(:), & + Tdiff_out=kd_col(:), & Nsqr=CS%N2(i,j,:), & dens=rho_1d(:), & dens_lwr=rho_lwr(:), & nlev=G%ke, & max_nlev=G%ke, & OBL_ind=kOBL) - - ! Do not apply mixing due to convection within the boundary layer - do k=1,kOBL - CS%kv_conv(i,j,k) = 0.0 - CS%kd_conv(i,j,k) = 0.0 - enddo + + do K=1,G%ke+1 + CS%kv_conv(i,j,K) = GV%m_to_Z**2 * kv_col(K) + CS%kd_conv(i,j,K) = GV%m_to_Z**2 * kd_col(K) + enddo + ! Do not apply mixing due to convection within the boundary layer + do k=1,kOBL + CS%kv_conv(i,j,k) = 0.0 + CS%kd_conv(i,j,k) = 0.0 + enddo enddo enddo diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index df87d3fa1f..90332c1b85 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -663,9 +663,9 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia real, dimension(SZI_(G)) :: pRef_MLD, pRef_N2 ! Reference pressures in Pa. real, dimension(SZI_(G)) :: dK, dKm1, d1 ! Depths in Z. real, dimension(SZI_(G)) :: rhoSurf, rhoAtK, rho1 ! Densities used for N2, in kg m-3. - real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth, in m. + real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth, in Z. real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML, in s-2. - real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2, in m2. + real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2, in Z2. real :: Rho_x_gE ! The product of density, gravitational acceleartion and a unit ! conversion factor, in kg m-1 Z-1 s-2. real :: gE_Rho0 ! The gravitational acceleration divided by a mean density, in m4 s-2 kg-1. @@ -677,8 +677,8 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia id_SQ = -1 ; if (PRESENT(id_N2subML)) id_SQ = id_MLDsq - Rho_x_gE = (GV%g_Earth) * GV%Rho0 - gE_rho0 = GV%m_to_Z * (GV%g_Earth*GV%m_to_Z) / GV%Rho0 + Rho_x_gE = GV%g_Earth * GV%Rho0 + gE_rho0 = GV%m_to_Z**2 * GV%g_Earth / GV%Rho0 dz_subML = 50.*GV%m_to_Z is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -824,7 +824,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & real, dimension(max(optics%nbands,1),SZI_(G),SZK_(G)) :: opacityBand real :: hGrounding(maxGroundings) real :: Temp_in, Salin_in - real :: I_G_Earth +! real :: I_G_Earth real :: g_Hconv2 real :: GoRho ! g_Earth times a unit conversion factor divided by density, in Z m3 s-2 kg-1 logical :: calculate_energetics @@ -845,7 +845,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & calculate_energetics = (present(cTKE) .and. present(dSV_dT) .and. present(dSV_dS)) calculate_buoyancy = present(SkinBuoyFlux) if (calculate_buoyancy) SkinBuoyFlux(:,:) = 0.0 - I_G_Earth = 1.0 / (GV%g_Earth*GV%m_to_Z) +! I_G_Earth = 1.0 / GV%g_Earth g_Hconv2 = GV%H_to_Pa * GV%H_to_kg_m2 if (present(cTKE)) cTKE(:,:,:) = 0.0 @@ -912,8 +912,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & dSV_dT(:,j,k), dSV_dS(:,j,k), is, ie-is+1, tv%eqn_of_state) do i=is,ie ; dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; enddo ! do i=is,ie -! dT_to_dPE(i,k) = I_G_Earth * d_pres(i) * p_lay(i) * dSV_dT(i,j,k) -! dS_to_dPE(i,k) = I_G_Earth * d_pres(i) * p_lay(i) * dSV_dS(i,j,k) +! dT_to_dPE(i,k) = I_G_Earth * GV%Z_to_m * d_pres(i) * p_lay(i) * dSV_dT(i,j,k) +! dS_to_dPE(i,k) = I_G_Earth * GV%Z_to_m * d_pres(i) * p_lay(i) * dSV_dS(i,j,k) ! enddo enddo pen_TKE_2d(:,:) = 0.0 diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 65af1f4f2b..42547d051e 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -683,12 +683,12 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! Increment vertical diffusion and viscosity due to convection !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_heat(i,j,k) = Kd_heat(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kd_conv(i,j,k) - Kd_salt(i,j,k) = Kd_salt(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kd_conv(i,j,k) + Kd_heat(i,j,k) = Kd_heat(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) + Kd_salt(i,j,k) = Kd_salt(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) if (CS%useKPP) then - visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kv_conv(i,j,k) + visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) else - visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kv_conv(i,j,k) + visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) endif enddo ; enddo ; enddo endif @@ -1571,8 +1571,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !### The vertical extent here is more limited that Kv_slow or Kd_int; it might be k=1,nz+1. do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,k) = Kd_int(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) - visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + GV%m_to_Z**2 * CS%CVMix_conv_csp%kv_conv(i,j,k) + Kd_int(i,j,k) = Kd_int(i,j,k) + GV%Z_to_m**2 * CS%CVMix_conv_csp%kd_conv(i,j,k) + visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) enddo ; enddo ; enddo !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -2979,19 +2979,20 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, CS%id_Sadv = register_diag_field('ocean_model',"Sflx_dia_adv",diag%axesTi, & Time, "Advective diapycnal salnity flux across interfaces", & "psu m s-1") - CS%id_MLD_003 = register_diag_field('ocean_model','MLD_003',diag%axesT1,Time, & - 'Mixed layer depth (delta rho = 0.03)', 'm', cmor_field_name='mlotst', & - cmor_long_name='Ocean Mixed Layer Thickness Defined by Sigma T', & + CS%id_MLD_003 = register_diag_field('ocean_model', 'MLD_003', diag%axesT1, Time, & + 'Mixed layer depth (delta rho = 0.03)', 'm', conversion=GV%Z_to_m, & + cmor_field_name='mlotst', cmor_long_name='Ocean Mixed Layer Thickness Defined by Sigma T', & cmor_standard_name='ocean_mixed_layer_thickness_defined_by_sigma_t') - CS%id_mlotstsq = register_diag_field('ocean_model','mlotstsq',diag%axesT1,Time, & - long_name='Square of Ocean Mixed Layer Thickness Defined by Sigma T', & - standard_name='square_of_ocean_mixed_layer_thickness_defined_by_sigma_t',units='m2') + CS%id_mlotstsq = register_diag_field('ocean_model','mlotstsq',diag%axesT1, Time, & + long_name='Square of Ocean Mixed Layer Thickness Defined by Sigma T', & + standard_name='square_of_ocean_mixed_layer_thickness_defined_by_sigma_t', & + units='m2', conversion=GV%Z_to_m**2) CS%id_MLD_0125 = register_diag_field('ocean_model','MLD_0125',diag%axesT1,Time, & - 'Mixed layer depth (delta rho = 0.125)', 'm') + 'Mixed layer depth (delta rho = 0.125)', 'm', conversion=GV%Z_to_m) CS%id_subMLN2 = register_diag_field('ocean_model','subML_N2',diag%axesT1,Time, & 'Squared buoyancy frequency below mixed layer', 's-2') CS%id_MLD_user = register_diag_field('ocean_model','MLD_user',diag%axesT1,Time, & - 'Mixed layer depth (used defined)', 'm') + 'Mixed layer depth (used defined)', 'm', conversion=GV%Z_to_m) call get_param(param_file, mdl, "DIAG_MLD_DENSITY_DIFF", CS%MLDdensityDifference, & "The density difference used to determine a diagnostic mixed\n"//& "layer depth, MLD_user, following the definition of Levitus 1982. \n"//& @@ -3008,15 +3009,15 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, z_grid='z') CS%id_Tdif_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) vd = var_desc("Tflx_dia_adv", "degC m s-1", & - "Advective diapycnal temperature flux across interfaces, interpolated to z",& + "Advective diapycnal temperature flux across interfaces, interpolated to z", & z_grid='z') CS%id_Tadv_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) vd = var_desc("Sflx_dia_diff", "psu m s-1", & - "Diffusive diapycnal salinity flux across interfaces, interpolated to z",& + "Diffusive diapycnal salinity flux across interfaces, interpolated to z", & z_grid='z') CS%id_Sdif_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) vd = var_desc("Sflx_dia_adv", "psu m s-1", & - "Advective diapycnal salinity flux across interfaces, interpolated to z",& + "Advective diapycnal salinity flux across interfaces, interpolated to z", & z_grid='z') CS%id_Sadv_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) endif From 9990e6e4d1161dade722aec08b7fb845ac25a2bd Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 06:37:02 -0400 Subject: [PATCH 0777/1072] Corrected a rescaling factor in find_coupling_coef One of the unit conversion factors in find_coupling coefficient was not changed when the units of KV_slow were changed with Hallberg-NOAA/MOM6@ced9c35. This has now been corrected. The fact that this change did not impact the rescaling tests is an indication that the MOM6 code testing coverage is not as complete as it should be, especially for recently added code. --- src/parameterizations/vertical/MOM_vert_friction.F90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 46adf78423..aec3a68f24 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1085,7 +1085,6 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. real :: z2 ! A copy of z_i, nondim. - real :: m2_to_Z2 ! Unit conversion factors. real :: topfn real :: a_top logical :: do_shelf, do_OBCs @@ -1099,7 +1098,6 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, else ; is = G%isc ; ie = G%iec ; endif nz = G%ke h_neglect = GV%H_subroundoff - m2_to_Z2 = GV%m_to_Z*GV%m_to_Z ! The maximum coupling coefficent was originally introduced to avoid ! truncation error problems in the tridiagonal solver. Effectively, the 1e-10 @@ -1212,7 +1210,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = Kv_add(i,K) + 1.0*m2_to_Z2*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j+1,k)) + Kv_add(i,K) = Kv_add(i,K) + 1.0*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j+1,k)) endif ; enddo ; enddo !### I am pretty sure that this is double counting here! - RWH if (do_OBCs) then From b9fc7ad7cf0c83121045ca4b2c69adaa6857b4bc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 08:54:42 -0400 Subject: [PATCH 0778/1072] +Changed the units of Kd_lay to Z-2 s-1 Renamed the layer-centered diffusivities uniformly to Kd_lay and rescaled the units of Kd_lay from m2 s-1 to Z2 s-1 for dimensional consistency testing. As a part of these chages, a new GV argument was added to user_change_diff. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_CVMix_conv.F90 | 2 +- .../vertical/MOM_bkgnd_mixing.F90 | 30 +++---- .../vertical/MOM_diabatic_driver.F90 | 32 +++---- .../vertical/MOM_entrain_diffusive.F90 | 6 +- .../vertical/MOM_set_diffusivity.F90 | 90 +++++++++---------- .../vertical/MOM_tidal_mixing.F90 | 28 +++--- src/user/user_change_diffusivity.F90 | 23 ++--- 7 files changed, 107 insertions(+), 104 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index e552cae9c4..851951af3e 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -226,7 +226,7 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, CS, hbl) nlev=G%ke, & max_nlev=G%ke, & OBL_ind=kOBL) - + do K=1,G%ke+1 CS%kv_conv(i,j,K) = GV%m_to_Z**2 * kv_col(K) CS%kd_conv(i,j,K) = GV%m_to_Z**2 * kd_col(K) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 1151044ff3..83b1f70026 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -307,17 +307,17 @@ end subroutine sfc_bkgnd_mixing !> Calculates the vertical background diffusivities/viscosities subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) - type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. - real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< squared buoyancy frequency associated + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. + real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< squared buoyancy frequency associated !! with layers (1/s2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: kd_lay !< Diapycnal diffusivity of each layer m2 s-1. - real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: kd_lay !< Diapycnal diffusivity of each layer Z2 s-1. + real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface !! (not layer!) in Z2 s-1 - integer, intent(in) :: j !< Meridional grid index - type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by + integer, intent(in) :: j !< Meridional grid index + type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by !! a previous call to bkgnd_mixing_init. ! local variables @@ -369,7 +369,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) CS%Kd_bkgnd(i,j,K) = Kd_col(K) enddo do k=1,nz - kd_lay(i,j,k) = kd_lay(i,j,k) + 0.5*(Kd_col(K) + Kd_col(K+1)) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_col(K) + Kd_col(K+1)) enddo enddo ! i loop @@ -382,8 +382,8 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) if (depth_c <= CS%Hmix) then ; CS%kd_bkgnd(i,j,k) = CS%Kdml elseif (depth_c >= 2.0*CS%Hmix) then ; CS%kd_bkgnd(i,j,k) = CS%Kd_sfc(i,j) else - kd_lay(i,j,k) = ((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & - (2.0*CS%Kdml - CS%Kd_sfc(i,j)) + Kd_lay(i,j,k) = GV%m_to_Z**2*((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & + GV%m_to_Z**2*(2.0*CS%Kdml - CS%Kd_sfc(i,j)) endif depth(i) = depth(i) + GV%H_to_m*h(i,j,k) @@ -395,13 +395,13 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) abs_sin = max(epsilon,abs(sin(G%geoLatT(i,j)*deg_to_rad))) N_2Omega = max(abs_sin,sqrt(N2_lay(i,k))*I_2Omega) N02_N2 = (CS%N0_2Omega/N_2Omega)**2 - kd_lay(i,j,k) = max(CS%Kd_min, CS%Kd_sfc(i,j) * & + Kd_lay(i,j,k) = max(GV%m_to_Z**2*CS%Kd_min, GV%m_to_Z**2*CS%Kd_sfc(i,j) * & ((abs_sin * invcosh(N_2Omega/abs_sin)) * I_x30)*N02_N2) enddo ; enddo else do k=1,nz ; do i=is,ie - kd_lay(i,j,k) = CS%Kd_sfc(i,j) + Kd_lay(i,j,k) = GV%m_to_Z**2*CS%Kd_sfc(i,j) enddo ; enddo endif @@ -411,7 +411,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) CS%kd_bkgnd(i,j,1) = 0.0; CS%kv_bkgnd(i,j,1) = 0.0 CS%kd_bkgnd(i,j,nz+1) = 0.0; CS%kv_bkgnd(i,j,nz+1) = 0.0 do k=2,nz - CS%kd_bkgnd(i,j,k) = 0.5*(kd_lay(i,j,K-1) + kd_lay(i,j,K)) + CS%kd_bkgnd(i,j,k) = 0.5*GV%Z_to_m**2*(Kd_lay(i,j,K-1) + Kd_lay(i,j,K)) CS%kv_bkgnd(i,j,k) = CS%kd_bkgnd(i,j,k) * CS%prandtl_bkgnd enddo enddo diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 42547d051e..f24a7f3cd4 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -289,9 +289,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! one time step (m for Bouss, kg/m^2 for non-Bouss) eb_t, & ! amount of fluid entrained from the layer below within ! one time step (m for Bouss, kg/m^2 for non-Bouss) - Kd, & ! diapycnal diffusivity of layers (m^2/sec) + Kd_lay, & ! diapycnal diffusivity of layers (Z^2/sec) h_orig, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) - h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) + h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) ! hold, & ! layer thickness before diapycnal entrainment, and later ! the initial layer thicknesses (if a mixed layer is used), ! (m for Bouss, kg/m^2 for non-Bouss) @@ -553,9 +553,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif ! end CS%use_int_tides call cpu_clock_begin(id_clock_set_diffusivity) - ! Sets: Kd, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S + ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S ! Also changes: visc%Kd_shear, visc%Kv_slow and visc%TKE_turb (not clear that TKE_turb is used as input ???? - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, CS%set_diff_CSp, Kd, Kd_int) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, CS%set_diff_CSp, & + Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -931,7 +932,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! thicknesses, as this corresponds pretty closely (to within ! differences in the density jumps between layers) with what is done ! in the calculation of the fluxes in the first place. Kd_min_tr - ! should be much less than the values that have been set in Kd, + ! should be much less than the values that have been set in Kd_lay, ! perhaps a molecular diffusivity. add_ent = ((dt * CS%Kd_min_tr) * GV%m_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & @@ -1163,9 +1164,9 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! one time step (m for Bouss, kg/m^2 for non-Bouss) eb, & ! amount of fluid entrained from the layer below within ! one time step (m for Bouss, kg/m^2 for non-Bouss) - Kd, & ! diapycnal diffusivity of layers (m^2/sec) + Kd_lay, & ! diapycnal diffusivity of layers (Z^2/sec) h_orig, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) - h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) + h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) hold, & ! layer thickness before diapycnal entrainment, and later ! the initial layer thicknesses (if a mixed layer is used), ! (m for Bouss, kg/m^2 for non-Bouss) @@ -1472,7 +1473,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en endif call cpu_clock_begin(id_clock_set_diffusivity) - ! Sets: Kd, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S + ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S ! Also changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ???? ! And sets visc%Kv_shear if ((CS%halo_TS_diff > 0) .and. (CS%ML_mix_first > 0.0)) then @@ -1480,7 +1481,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (associated(tv%T)) call pass_var(tv%S, G%Domain, halo=CS%halo_TS_diff, complete=.false.) call pass_var(h, G%domain, halo=CS%halo_TS_diff, complete=.true.) endif - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, CS%set_diff_CSp, Kd, Kd_int) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, CS%set_diff_CSp, & + Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -1488,8 +1490,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G) - call hchksum(Kd, "after set_diffusivity Kd",G%HI,haloshift=0) - call hchksum(Kd_Int, "after set_diffusivity Kd_Int",G%HI,haloshift=0) + call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0) endif @@ -1558,8 +1560,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) - call hchksum(Kd, "after KPP Kd",G%HI,haloshift=0) - call hchksum(Kd_Int, "after KPP Kd_Int",G%HI,haloshift=0) + call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0) endif endif ! endif for KPP @@ -1653,7 +1655,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! Calculate appropriately limited diapycnal mass fluxes to account ! for diapycnal diffusion and advection. Sets: ea, eb. Changes: kb call Entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS%entrain_diffusive_CSp, & - ea, eb, kb, Kd_Lay=Kd, Kd_int=Kd_int) + ea, eb, kb, Kd_Lay=Kd_lay, Kd_int=Kd_int) call cpu_clock_end(id_clock_entrain) if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)") @@ -2074,7 +2076,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! thicknesses, as this corresponds pretty closely (to within ! differences in the density jumps between layers) with what is done ! in the calculation of the fluxes in the first place. Kd_min_tr - ! should be much less than the values that have been set in Kd, + ! should be much less than the values that have been set in Kd_lay, ! perhaps a molecular diffusivity. add_ent = ((dt * CS%Kd_min_tr) * GV%m_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index d3a510fea7..e48fb0469a 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -73,7 +73,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & ! At least one of the two following arguments must be present. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: Kd_Lay !< The diapycnal diffusivity of layers, - !! in m2 s-1. + !! in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(in) :: Kd_int !< The diapycnal diffusivity of interfaces, !! in m2 s-1. @@ -270,7 +270,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & if (present(Kd_Lay)) then do k=1,nz ; do i=is,ie - dtKd(i,k) = m_to_H**2 * (dt*Kd_Lay(i,j,k)) + dtKd(i,k) = GV%Z_to_H**2 * (dt*Kd_lay(i,j,k)) enddo ; enddo if (present(Kd_int)) then do K=1,nz+1 ; do i=is,ie @@ -278,7 +278,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & enddo ; enddo else do K=2,nz ; do i=is,ie - dtKd_int(i,K) = m_to_H**2 * (0.5*dt*(Kd_Lay(i,j,k-1) + Kd_Lay(i,j,k))) + dtKd_int(i,K) = GV%Z_to_H**2 * (0.5*dt*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k))) enddo ; enddo endif else ! Kd_int must be present, or there already would have been an error. diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index a28751fb66..2d6f513e67 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -197,7 +197,7 @@ module MOM_set_diffusivity !! visc%Kv_slow. Vertical viscosity due to shear-driven mixing is passed via !! visc%Kv_shear subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & - G, GV, CS, Kd, Kd_int) + G, GV, CS, Kd_lay, Kd_int) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -220,7 +220,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & real, intent(in) :: dt !< Time increment (sec). type(set_diffusivity_CS), pointer :: CS !< Module control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(out) :: Kd !< Diapycnal diffusivity of each layer (m2/sec). + intent(out) :: Kd_lay !< Diapycnal diffusivity of each layer (m2/sec). real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(out) :: Kd_int !< Diapycnal diffusivity at each interface (m2/sec). @@ -288,9 +288,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call MOM_error(FATAL, "set_diffusivity: both visc%Kd_extra_T and "//& "visc%Kd_extra_S must be associated when USE_CVMIX_DDIFF or DOUBLE_DIFFUSION are true.") - ! Set Kd, Kd_int and Kv_slow to constant values. + ! Set Kd_lay, Kd_int and Kv_slow to constant values. ! If nothing else is specified, this will be the value used. - Kd(:,:,:) = CS%Kd + Kd_lay(:,:,:) = GV%m_to_Z**2*CS%Kd Kd_int(:,:,:) = CS%Kd if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = GV%m_to_Z**2 * CS%Kv @@ -381,7 +381,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & visc%Kv_shear(:,:,:) = 0.0 ! needed if calculate_kappa_shear is not enabled endif - ! Calculate the diffusivity, Kd, for each layer. This would be + ! Calculate the diffusivity, Kd_lay, for each layer. This would be ! the appropriate place to add a depth-dependent parameterization or ! another explicit parameterization of Kd. @@ -400,20 +400,20 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif ! Add background mixing - call calculate_bkgnd_mixing(h, tv, N2_lay, Kd, visc%Kv_slow, j, G, GV, CS%bkgnd_mixing_csp) + call calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, visc%Kv_slow, j, G, GV, CS%bkgnd_mixing_csp) ! Double-diffusion (old method) if (CS%double_diffusion) then call double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, KT_extra, KS_extra) do K=2,nz ; do i=is,ie if (KS_extra(i,K) > KT_extra(i,K)) then ! salt fingering - Kd(i,j,k-1) = Kd(i,j,k-1) + 0.5*KT_extra(i,K) - Kd(i,j,k) = Kd(i,j,k) + 0.5*KT_extra(i,K) + Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5*GV%m_to_Z**2*KT_extra(i,K) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*KT_extra(i,K) visc%Kd_extra_S(i,j,k) = GV%m_to_Z**2 * (KS_extra(i,K) - KT_extra(i,K)) visc%Kd_extra_T(i,j,k) = 0.0 elseif (KT_extra(i,K) > 0.0) then ! double-diffusive convection - Kd(i,j,k-1) = Kd(i,j,k-1) + 0.5*KS_extra(i,K) - Kd(i,j,k) = Kd(i,j,k) + 0.5*KS_extra(i,K) + Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5*GV%m_to_Z**2*KS_extra(i,K) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*KS_extra(i,K) visc%Kd_extra_T(i,j,k) = GV%m_to_Z**2 * (KT_extra(i,K) - KS_extra(i,K)) visc%Kd_extra_S(i,j,k) = 0.0 else ! There is no double diffusion at this interface. @@ -442,7 +442,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%useKappaShear .or. CS%use_CVMix_shear) then if (present(Kd_int)) then do K=2,nz ; do i=is,ie - Kd_int(i,j,K) = GV%Z_to_m**2 * visc%Kd_shear(i,j,K) + 0.5*(Kd(i,j,k-1) + Kd(i,j,k)) + Kd_int(i,j,K) = GV%Z_to_m**2 * visc%Kd_shear(i,j,K) + 0.5*GV%Z_to_m**2*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) enddo ; enddo do i=is,ie Kd_int(i,j,1) = GV%Z_to_m**2 * visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. @@ -450,15 +450,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & enddo endif do k=1,nz ; do i=is,ie - Kd(i,j,k) = Kd(i,j,k) + GV%Z_to_m**2 * 0.5*(visc%Kd_shear(i,j,K) + visc%Kd_shear(i,j,K+1)) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*(visc%Kd_shear(i,j,K) + visc%Kd_shear(i,j,K+1)) enddo ; enddo else if (present(Kd_int)) then do i=is,ie - Kd_int(i,j,1) = Kd(i,j,1) ; Kd_int(i,j,nz+1) = 0.0 + Kd_int(i,j,1) = GV%Z_to_m**2*Kd_lay(i,j,1) ; Kd_int(i,j,nz+1) = 0.0 enddo do K=2,nz ; do i=is,ie - Kd_int(i,j,K) = 0.5*(Kd(i,j,k-1) + Kd(i,j,k)) + Kd_int(i,j,K) = 0.5*GV%Z_to_m**2*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) enddo ; enddo endif endif @@ -474,21 +474,21 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! Add the ML_Rad diffusivity. if (CS%ML_radiation) & - call add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int) + call add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_int) ! Add the Nikurashin and / or tidal bottom-driven mixing call calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, maxTKE, G, GV, CS%tm_csp, & - N2_lay, N2_int, Kd, Kd_int, CS%Kd_max, visc%Kv_slow) + N2_lay, N2_int, Kd_lay, Kd_int, CS%Kd_max, visc%Kv_slow) ! This adds the diffusion sustained by the energy extracted from the flow ! by the bottom drag. if (CS%bottomdraglaw .and. (CS%BBL_effic>0.0)) then if (CS%use_LOTW_BBL_diffusivity) then call add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, G, GV, CS, & - Kd, Kd_int, dd%Kd_BBL) + Kd_lay, Kd_int, dd%Kd_BBL) else call add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & - maxTKE, kb, G, GV, CS, Kd, Kd_int, dd%Kd_BBL) + maxTKE, kb, G, GV, CS, Kd_lay, Kd_int, dd%Kd_BBL) endif endif @@ -502,8 +502,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & dissip = max( CS%dissip_min, & ! Const. floor on dissip. CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_lay(i,k)), & ! Floor aka Gargett CS%dissip_N2 * N2_lay(i,k) ) ! Floor of Kd_min*rho0/F_Ri - Kd(i,j,k) = max( Kd(i,j,k) , & ! Apply floor to Kd - dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_lay(i,k) + Omega2))) ) + Kd_lay(i,j,k) = max( Kd_lay(i,j,k) , & ! Apply floor to Kd + GV%m_to_Z**2*dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_lay(i,k) + Omega2))) ) enddo ; enddo if (present(Kd_int)) then ; do K=2,nz ; do i=is,ie @@ -522,14 +522,14 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(dd%Kd_work)) then do k=1,nz ; do i=is,ie - dd%Kd_Work(i,j,k) = GV%Rho0 * Kd(i,j,k) * N2_lay(i,k) * & - GV%H_to_m*h(i,j,k) ! Watt m-2 s or kg s-3 + dd%Kd_Work(i,j,k) = GV%Rho0 * GV%Z_to_m**2*Kd_lay(i,j,k) * N2_lay(i,k) * & + GV%H_to_m*h(i,j,k) ! Watt m-2 s or kg s-3 enddo ; enddo endif enddo ! j-loop if (CS%debug) then - call hchksum(Kd ,"Kd",G%HI,haloshift=0) + call hchksum(Kd_lay ,"Kd_lay", G%HI, haloshift=0, scale=GV%Z_to_m**2) if (CS%useKappaShear) call hchksum(visc%Kd_shear, "Turbulent Kd", G%HI, haloshift=0, scale=GV%Z_to_m**2) @@ -559,18 +559,18 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & !$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_int,CS,Kd) do k=1,nz ; do j=js,je ; do i=is,ie Kd_int(i,j,K) = Kd_int(i,j,K) + CS%Kd_add - Kd(i,j,k) = Kd(i,j,k) + CS%Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*CS%Kd_add enddo ; enddo ; enddo else !$OMP parallel do default(none) shared(is,ie,js,je,nz,CS,Kd) do k=1,nz ; do j=js,je ; do i=is,ie - Kd(i,j,k) = Kd(i,j,k) + CS%Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*CS%Kd_add enddo ; enddo ; enddo endif endif if (CS%user_change_diff) then - call user_change_diff(h, tv, G, CS%user_change_diff_CSp, Kd, Kd_int, & + call user_change_diff(h, tv, G, GV, CS%user_change_diff_CSp, Kd_lay, Kd_int, & T_f, S_f, dd%Kd_user) endif @@ -590,7 +590,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%CVMix_ddiff_csp%id_R_rho > 0) & call post_data(CS%CVMix_ddiff_csp%id_R_rho, CS%CVMix_ddiff_csp%R_rho, CS%CVMix_ddiff_csp%diag) - if (CS%id_Kd_layer > 0) call post_data(CS%id_Kd_layer, Kd, CS%diag) + if (CS%id_Kd_layer > 0) call post_data(CS%id_Kd_layer, Kd_lay, CS%diag) ! tidal mixing call post_tidal_diagnostics(G,GV,h,CS%tm_csp) @@ -1120,7 +1120,7 @@ end subroutine double_diffusion !> This routine adds diffusion sustained by flow energy extracted by bottom drag. subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & - maxTKE, kb, G, GV, CS, Kd, Kd_int, Kd_BBL) + maxTKE, kb, G, GV, CS, Kd_lay, Kd_int, Kd_BBL) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -1146,7 +1146,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & !! layer, or -1 without a bulk mixed layer type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd !< The diapycnal diffusvity in layers, in m2 s-1 + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in m2 s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in m2 s-1 real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity, in m2 s-1 @@ -1292,13 +1292,13 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & TKE(i) = TKE(i) - TKE_to_layer - if (Kd(i,j,k) < (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k)) then - delta_Kd = (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) - Kd(i,j,k) + if (Kd_lay(i,j,k) < (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k)) then + delta_Kd = (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) - GV%Z_to_m**2*Kd_lay(i,j,k) if ((CS%Kd_max >= 0.0) .and. (delta_Kd > CS%Kd_max)) then delta_Kd = CS%Kd_Max - Kd(i,j,k) = Kd(i,j,k) + delta_Kd + Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*delta_Kd else - Kd(i,j,k) = (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) + Kd_lay(i,j,k) = (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k) endif Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd @@ -1308,12 +1308,12 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & endif endif else - if (Kd(i,j,k) >= maxTKE(i,k)*TKE_to_Kd(i,k)) then + if (Kd_lay(i,j,k) >= maxTKE(i,k)*GV%m_to_Z**2*TKE_to_Kd(i,k)) then TKE_here = 0.0 TKE(i) = TKE(i) + TKE_Ray - elseif (Kd(i,j,k) + (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) > & - maxTKE(i,k)*TKE_to_Kd(i,k)) then - TKE_here = ((TKE_to_layer+TKE_Ray) + Kd(i,j,k)/TKE_to_Kd(i,k)) - & + elseif (Kd_lay(i,j,k) + (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k) > & + maxTKE(i,k)*GV%m_to_Z**2*TKE_to_Kd(i,k)) then + TKE_here = ( (TKE_to_layer+TKE_Ray) + Kd_lay(i,j,k)/(GV%m_to_Z**2*TKE_to_Kd(i,k)) ) - & maxTKE(i,k) TKE(i) = TKE(i) - TKE_here + TKE_Ray else @@ -1325,7 +1325,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & if (TKE_here > 0.0) then delta_Kd = TKE_here*TKE_to_Kd(i,k) if (CS%Kd_max >= 0.0) delta_Kd = min(delta_Kd, CS%Kd_max) - Kd(i,j,k) = Kd(i,j,k) + delta_Kd + Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*delta_Kd Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd if (do_diag_Kd_BBL) then @@ -1354,7 +1354,7 @@ end subroutine add_drag_diffusivity !! wall turbulent viscosity, up to a BBL height where the energy used for mixing has !! consumed the mechanical TKE input. subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & - G, GV, CS, Kd, Kd_int, Kd_BBL) + G, GV, CS, Kd_lay, Kd_int, Kd_BBL) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -1373,7 +1373,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & intent(in) :: N2_int !< Square of Brunt-Vaisala at interfaces (s-2) type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd !< Layer net diffusivity (m2 s-1) + intent(inout) :: Kd_lay !< Layer net diffusivity (m2 s-1) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & intent(inout) :: Kd_int !< Interface net diffusivity (m2 s-1) real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity (m2 s-1) @@ -1504,7 +1504,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! Add this BBL diffusivity to the model net diffusivity. Kd_int(i,j,k) = Kd_int(i,j,k) + Kd_wall - Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_wall + Kd_lower) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_wall + Kd_lower) Kd_lower = Kd_wall ! Store for next level up. if (do_diag_Kd_BBL) Kd_BBL(i,j,k) = Kd_wall enddo ! k @@ -1513,7 +1513,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & end subroutine add_LOTW_BBL_diffusivity !> This routine adds effects of mixed layer radiation to the layer diffusivities. -subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int) +subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_int) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -1521,7 +1521,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int) type(forcing), intent(in) :: fluxes !< Surface fluxes structure type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd !< The diapycnal diffusvity in layers, in m2 s-1. + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in m2 s-1. integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the @@ -1598,7 +1598,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int) endif ; enddo do k=1,kml+1 ; do i=is,ie ; if (do_i(i)) then - Kd(i,j,k) = Kd(i,j,k) + Kd_mlr_ml(i) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_mlr_ml(i) endif ; enddo ; enddo if (present(Kd_int)) then do K=2,kml+1 ; do i=is,ie ; if (do_i(i)) then @@ -1621,7 +1621,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd, TKE_to_Kd, Kd_int) (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) endif Kd_mlr = min(Kd_mlr,CS%ML_rad_kd_max) - Kd(i,j,k) = Kd(i,j,k) + Kd_mlr + Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_mlr if (present(Kd_int)) then Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_mlr Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_mlr diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 8e5f016351..6976966a50 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -647,7 +647,7 @@ end function tidal_mixing_init !! tidal dissipation and to add the effect of internal-tide-driven mixing to the layer or interface !! diffusivities. subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & - N2_lay, N2_int, Kd, Kd_int, Kd_max, Kv) + N2_lay, N2_int, Kd_lay, Kd_int, Kd_max, Kv) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -668,7 +668,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & !! to its maximum realizable thickness, in m3 s-3 type(tidal_mixing_cs), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd !< The diapycnal diffusvity in layers, in m2 s-1. + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in m2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in m2 s-1. real, intent(in) :: Kd_max !< The maximum increment for diapycnal @@ -679,10 +679,10 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then if (CS%use_CVMix_tidal) then - call calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) + call calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd_lay, Kv) else call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & - N2_lay, Kd, Kd_int, Kd_max) + N2_lay, Kd_lay, Kd_int, Kd_max) endif endif end subroutine @@ -690,7 +690,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & !> Calls the CVMix routines to compute tidal dissipation and to add the effect of internal-tide-driven !! mixing to the interface diffusivities. -subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) +subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd_lay, Kv) integer, intent(in) :: j !< The j-index to work on type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -701,7 +701,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd !< The diapycnal diffusivities in the layers, in m2 s-1 + intent(inout) :: Kd_lay!< The diapycnal diffusivities in the layers, in Z2 s-1 real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface !! (not layer!) in Z2 s-1. ! Local variables @@ -772,8 +772,8 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) CVMix_tidal_params_user = CS%CVMix_tidal_params) ! Update diffusivity - do k=1,G%ke ! GV%m_to_Z**2 * - Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_tidal(k) + Kd_tidal(k+1) ) + do k=1,G%ke + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_tidal(k) + Kd_tidal(k+1) ) enddo ! Update viscosity with the proper unit conversion. @@ -871,8 +871,8 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd, Kv) CVmix_tidal_params_user = CS%CVMix_tidal_params) ! Update diffusivity - do k=1,G%ke ! GV%m_to_Z**2 * - Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_tidal(k) + Kd_tidal(k+1) ) + do k=1,G%ke + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_tidal(k) + Kd_tidal(k+1) ) enddo ! Update viscosity @@ -917,7 +917,7 @@ end subroutine calculate_CVMix_tidal !! Will eventually need to add diffusivity due to other wave-breaking processes (e.g. Bottom friction, !! Froude-number-depending breaking, PSI, etc.). subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & - N2_lay, Kd, Kd_int, Kd_max) + N2_lay, Kd_lay, Kd_int, Kd_max) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -936,7 +936,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, !! to its maximum realizable thickness, in m3 s-3 type(tidal_mixing_cs), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd !< The diapycnal diffusvity in layers, in m2 s-1. + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in m2 s-1. real, intent(in) :: Kd_max !< The maximum increment for diapycnal @@ -1181,7 +1181,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) - Kd(i,j,k) = Kd(i,j,k) + Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_add if (present(Kd_int)) then Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add @@ -1268,7 +1268,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) - Kd(i,j,k) = Kd(i,j,k) + Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_add if (present(Kd_int)) then Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index ea15387f64..f3684f3cdc 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -5,17 +5,17 @@ module user_change_diffusivity use MOM_diag_mediator, only : diag_ctrl, time_type use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE -use MOM_file_parser, only : get_param, log_version, param_file_type -use MOM_grid, only : ocean_grid_type -use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d -use MOM_EOS, only : calculate_density +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_grid, only : ocean_grid_type +use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density implicit none ; private #include -public user_change_diff, user_change_diff_init -public user_change_diff_end +public user_change_diff, user_change_diff_init, user_change_diff_end !> Control structure for user_change_diffusivity type, public :: user_change_diff_CS ; private @@ -38,15 +38,16 @@ module user_change_diffusivity !! main code to alter the diffusivities as needed. The specific example !! implemented here augments the diffusivity for a specified range of latitude !! and coordinate potential density. -subroutine user_change_diff(h, tv, G, CS, Kd, Kd_int, T_f, S_f, Kd_int_add) +subroutine user_change_diff(h, tv, G, GV, CS, Kd_lay, Kd_int, T_f, S_f, Kd_int_add) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers !! to any available thermodynamic !! fields. Absent fields have NULL ptrs. type(user_change_diff_CS), pointer :: CS !< This module's control structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(inout) :: Kd !< The diapycnal diffusivity of - !! each layer in m2 s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity of + !! each layer in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int !< The diapycnal diffusivity !! at each interface in m2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: T_f !< Temperature with massless @@ -109,7 +110,7 @@ subroutine user_change_diff(h, tv, G, CS, Kd, Kd_int, T_f, S_f, Kd_int_add) enddo endif - if (present(Kd)) then + if (present(Kd_lay)) then do k=1,nz ; do i=is,ie if (CS%use_abs_lat) then lat_fn = val_weights(abs(G%geoLatT(i,j)), CS%lat_range) @@ -118,7 +119,7 @@ subroutine user_change_diff(h, tv, G, CS, Kd, Kd_int, T_f, S_f, Kd_int_add) endif rho_fn = val_weights(Rcv(i,k), CS%rho_range) if (rho_fn * lat_fn > 0.0) & - Kd(i,j,k) = Kd(i,j,k) + CS%Kd_add * rho_fn * lat_fn + Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2 * CS%Kd_add * rho_fn * lat_fn enddo ; enddo endif if (present(Kd_int)) then From 7f6647f228b860bc26a3982e03960c546f647a63 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 11:05:49 -0400 Subject: [PATCH 0779/1072] Changed the units of Kd_int to Z-2 s-1 Rescaled the units of Kd_int from m2 s-1 to Z2 s-1 for dimensional consistency testing. Also eliminated some unneeded variables and corrected some unrelated comments. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_CVMix_shear.F90 | 3 +- .../vertical/MOM_diabatic_driver.F90 | 28 ++++++------- .../vertical/MOM_diapyc_energy_req.F90 | 4 +- .../vertical/MOM_entrain_diffusive.F90 | 20 +++++----- .../vertical/MOM_set_diffusivity.F90 | 40 +++++++++---------- .../vertical/MOM_tidal_mixing.F90 | 14 +++---- .../vertical/MOM_vert_friction.F90 | 10 ++--- src/user/user_change_diffusivity.F90 | 4 +- 8 files changed, 60 insertions(+), 63 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index a22bda0d9d..d80ccf1114 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -50,8 +50,7 @@ module MOM_CVMix_shear contains !> Subroutine for calculating (internal) vertical diffusivities/viscosities -subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, & - kv, G, GV, CS ) +subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, CS ) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: u_H !< Initial zonal velocity on T points, in m s-1. diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index f24a7f3cd4..15474051b0 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -564,8 +564,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = GV%m_to_Z**2 * Kd_int(i,j,k) - Kd_heat(i,j,k) = GV%m_to_Z**2 * Kd_int(i,j,k) + Kd_salt(i,j,k) = Kd_int(i,j,K) + Kd_heat(i,j,k) = Kd_int(i,j,K) enddo ; enddo ; enddo ! Add contribution from double diffusion if (associated(visc%Kd_extra_S)) then @@ -1508,8 +1508,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = GV%m_to_Z**2 * Kd_int(i,j,k) - Kd_heat(i,j,k) = GV%m_to_Z**2 * Kd_int(i,j,k) + Kd_salt(i,j,k) = Kd_int(i,j,K) + Kd_heat(i,j,k) = Kd_int(i,j,K) enddo ; enddo ; enddo if (associated(visc%Kd_extra_S)) then !$OMP parallel do default(shared) @@ -1538,18 +1538,18 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (.not. CS%KPPisPassive) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_int(i,j,k) = GV%Z_to_m**2 * min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) + Kd_int(i,j,K) = min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) enddo ; enddo ; enddo if (associated(visc%Kd_extra_S)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_S(i,j,k) = (Kd_salt(i,j,k) - GV%m_to_Z**2 * Kd_int(i,j,k)) + visc%Kd_extra_S(i,j,k) = (Kd_salt(i,j,k) - Kd_int(i,j,K)) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_T(i,j,k) = (Kd_heat(i,j,k) - GV%m_to_Z**2 * Kd_int(i,j,k)) + visc%Kd_extra_T(i,j,k) = (Kd_heat(i,j,k) - Kd_int(i,j,K)) enddo ; enddo ; enddo endif endif ! not passive @@ -1573,7 +1573,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !### The vertical extent here is more limited that Kv_slow or Kd_int; it might be k=1,nz+1. do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,k) = Kd_int(i,j,k) + GV%Z_to_m**2 * CS%CVMix_conv_csp%kd_conv(i,j,k) + Kd_int(i,j,K) = Kd_int(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,k) visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) enddo ; enddo ; enddo !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -1640,7 +1640,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !$OMP private(hval) do k=2,nz ; do j=js,je ; do i=is,ie hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea(i,j,k) = (GV%m_to_H**2) * dt * hval * Kd_int(i,j,k) + ea(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_int(i,j,K) eb(i,j,k-1) = ea(i,j,k) enddo ; enddo ; enddo do j=js,je ; do i=is,ie @@ -1727,11 +1727,11 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) eb(i,j,k-1) = eb(i,j,k-1) + Ent_int ea(i,j,k) = ea(i,j,k) + Ent_int - Kd_int(i,j,K) = Kd_int(i,j,K) + GV%Z_to_m**2 * Kd_add_here + Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here ! for diagnostics - Kd_heat(i,j,K) = Kd_heat(i,j,K) + GV%m_to_Z**2 * Kd_int(i,j,K) - Kd_salt(i,j,K) = Kd_salt(i,j,K) + GV%m_to_Z**2 * Kd_int(i,j,K) + Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_int(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_int(i,j,K) enddo ; enddo ; enddo @@ -2909,12 +2909,12 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, call get_param(param_file, mdl, "KD_MIN_TR", CS%Kd_min_tr, & "A minimal diffusivity that should always be applied to \n"//& "tracers, especially in massless layers near the bottom. \n"//& - "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd) + "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd) !### This would benefit from rescaling. call get_param(param_file, mdl, "KD_BBL_TR", CS%Kd_BBL_tr, & "A bottom boundary layer tracer diffusivity that will \n"//& "allow for explicitly specified bottom fluxes. The \n"//& "entrainment at the bottom is at least sqrt(Kd_BBL_tr*dt) \n"//& - "over the same distance.", units="m2 s-1", default=0.) + "over the same distance.", units="m2 s-1", default=0.) !### This needs rescaling? endif call get_param(param_file, mdl, "TRACER_TRIDIAG", CS%tracer_tridiag, & diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 767e49ed89..93676a384c 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -53,7 +53,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, CS, Kd_int) !! in s. type(diapyc_energy_req_CS), pointer :: CS !< This module's control structure. real, dimension(G%isd:G%ied,G%jsd:G%jed,GV%ke+1), & - optional, intent(in) :: Kd_int !< Interface diffusivities. + optional, intent(in) :: Kd_int !< Interface diffusivities in Z2 s-1. ! Local variables real, dimension(GV%ke) :: & @@ -75,7 +75,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, CS, Kd_int) !$OMP do do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then if (present(Kd_int) .and. .not.CS%use_test_Kh_profile) then - do k=1,nz+1 ; Kd(K) = CS%test_Kh_scaling*Kd_int(i,j,K) ; enddo + do k=1,nz+1 ; Kd(K) = CS%test_Kh_scaling*GV%Z_to_m**2*Kd_int(i,j,K) ; enddo else htot = 0.0 ; h_top(1) = 0.0 do k=1,nz diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index e48fb0469a..b2911d5033 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -76,7 +76,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & !! in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(in) :: Kd_int !< The diapycnal diffusivity of interfaces, - !! in m2 s-1. + !! in Z2 s-1. ! This subroutine calculates ea and eb, the rates at which a layer entrains ! from the layers above and below. The entrainment rates are proportional to @@ -194,7 +194,6 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & real :: h1 ! The layer thickness after entrainment through the ! interface below is taken into account, in H. real :: Idt ! The inverse of the time step, in s-1. - real :: H_to_m, m_to_H ! Local copies of unit conversion factors. logical :: do_any logical :: do_i(SZI_(G)), did_i(SZI_(G)), reiterate, correct_density @@ -224,8 +223,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & &and a linear equation of state to drive the model.") endif - H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H - tolerance = m_to_H * CS%Tolerance_Ent + tolerance = GV%m_to_H * CS%Tolerance_Ent g_2dt = 0.5 * (GV%g_Earth*GV%m_to_Z) / dt kmb = GV%nk_rho_varies K2 = max(kmb+1,2) ; kb_min = K2 @@ -252,7 +250,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & !$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_Lay,G,GV,dt,Kd_int,CS,h,tv, & !$OMP kmb,Angstrom,fluxes,K2,h_neglect,tolerance, & !$OMP ea,eb,correct_density,Kd_eff,diff_work, & -!$OMP g_2dt, kb_out, m_to_H, H_to_m) & +!$OMP g_2dt, kb_out) & !$OMP firstprivate(kb,ds_dsp1,dsp1_ds,pres,kb_min) & !$OMP private(dtKd,dtKd_int,do_i,Ent_bl,dtKd_kb,h_bl, & !$OMP I2p2dsp1_ds,grats,htot,max_eakb,I_dSkbp1, & @@ -274,7 +272,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & enddo ; enddo if (present(Kd_int)) then do K=1,nz+1 ; do i=is,ie - dtKd_int(i,K) = m_to_H**2 * (dt*Kd_int(i,j,K)) + dtKd_int(i,K) = GV%Z_to_H**2 * (dt*Kd_int(i,j,K)) enddo ; enddo else do K=2,nz ; do i=is,ie @@ -283,10 +281,10 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & endif else ! Kd_int must be present, or there already would have been an error. do k=1,nz ; do i=is,ie - dtKd(i,k) = m_to_H**2 * (0.5*dt*(Kd_int(i,j,K)+Kd_int(i,j,K+1))) + dtKd(i,k) = GV%Z_to_H**2 * (0.5*dt*(Kd_int(i,j,K)+Kd_int(i,j,K+1))) enddo ; enddo dO K=1,nz+1 ; do i=is,ie - dtKd_int(i,K) = m_to_H**2 * (dt*Kd_int(i,j,K)) + dtKd_int(i,K) = GV%Z_to_H**2 * (dt*Kd_int(i,j,K)) enddo ; enddo endif @@ -816,11 +814,11 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & (eb(i,j,k) - ea(i,j,k+1))) ) / (I2p2dsp1_ds(i,k) * grats(i,k)) endif - Kd_eff(i,j,k) = H_to_m**2 * (MAX(dtKd(i,k),Kd_here)*Idt) + Kd_eff(i,j,k) = GV%H_to_m**2 * (MAX(dtKd(i,k),Kd_here)*Idt) enddo ; enddo do i=is,ie - Kd_eff(i,j,1) = H_to_m**2 * (dtKd(i,1)*Idt) - Kd_eff(i,j,nz) = H_to_m**2 * (dtKd(i,nz)*Idt) + Kd_eff(i,j,1) = GV%H_to_m**2 * (dtKd(i,1)*Idt) + Kd_eff(i,j,nz) = GV%H_to_m**2 * (dtKd(i,nz)*Idt) enddo endif diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 2d6f513e67..df6c7df3c1 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -291,7 +291,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! Set Kd_lay, Kd_int and Kv_slow to constant values. ! If nothing else is specified, this will be the value used. Kd_lay(:,:,:) = GV%m_to_Z**2*CS%Kd - Kd_int(:,:,:) = CS%Kd + Kd_int(:,:,:) = GV%m_to_Z**2*CS%Kd if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = GV%m_to_Z**2 * CS%Kv ! Set up arrays for diagnostics. @@ -442,10 +442,10 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%useKappaShear .or. CS%use_CVMix_shear) then if (present(Kd_int)) then do K=2,nz ; do i=is,ie - Kd_int(i,j,K) = GV%Z_to_m**2 * visc%Kd_shear(i,j,K) + 0.5*GV%Z_to_m**2*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) + Kd_int(i,j,K) = visc%Kd_shear(i,j,K) + 0.5*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) enddo ; enddo do i=is,ie - Kd_int(i,j,1) = GV%Z_to_m**2 * visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. + Kd_int(i,j,1) = visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. Kd_int(i,j,nz+1) = 0.0 enddo endif @@ -455,10 +455,10 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & else if (present(Kd_int)) then do i=is,ie - Kd_int(i,j,1) = GV%Z_to_m**2*Kd_lay(i,j,1) ; Kd_int(i,j,nz+1) = 0.0 + Kd_int(i,j,1) = Kd_lay(i,j,1) ; Kd_int(i,j,nz+1) = 0.0 enddo do K=2,nz ; do i=is,ie - Kd_int(i,j,K) = 0.5*GV%Z_to_m**2*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) + Kd_int(i,j,K) = 0.5*(Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) enddo ; enddo endif endif @@ -516,7 +516,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_int(i,K)), & ! Floor aka Gargett CS%dissip_N2 * N2_int(i,K) ) ! Floor of Kd_min*rho0/F_Ri Kd_int(i,j,K) = max( Kd_int(i,j,K) , & ! Apply floor to Kd - dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + Omega2))) ) + GV%m_to_Z**2*dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + Omega2))) ) enddo ; enddo ; endif endif @@ -558,7 +558,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (present(Kd_int)) then !$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_int,CS,Kd) do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,K) = Kd_int(i,j,K) + CS%Kd_add + Kd_int(i,j,K) = Kd_int(i,j,K) + GV%m_to_Z**2*CS%Kd_add Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*CS%Kd_add enddo ; enddo ; enddo else @@ -1146,9 +1146,9 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & !! layer, or -1 without a bulk mixed layer type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in m2 s-1 + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in m2 s-1 + intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1 real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity, in m2 s-1 ! This routine adds diffusion sustained by flow energy extracted by bottom drag. @@ -1300,8 +1300,8 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & else Kd_lay(i,j,k) = (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k) endif - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*GV%m_to_Z**2*delta_Kd + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*GV%m_to_Z**2*delta_Kd if (do_diag_Kd_BBL) then Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*delta_Kd Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5*delta_Kd @@ -1326,8 +1326,8 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & delta_Kd = TKE_here*TKE_to_Kd(i,k) if (CS%Kd_max >= 0.0) delta_Kd = min(delta_Kd, CS%Kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*delta_Kd - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*GV%m_to_Z**2*delta_Kd + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*GV%m_to_Z**2*delta_Kd if (do_diag_Kd_BBL) then Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*delta_Kd Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5*delta_Kd @@ -1503,7 +1503,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & TKE_remaining = TKE_remaining - TKE_consumed ! Note this will be non-negative ! Add this BBL diffusivity to the model net diffusivity. - Kd_int(i,j,k) = Kd_int(i,j,k) + Kd_wall + Kd_int(i,j,K) = Kd_int(i,j,K) + GV%m_to_Z**2*Kd_wall Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_wall + Kd_lower) Kd_lower = Kd_wall ! Store for next level up. if (do_diag_Kd_BBL) Kd_BBL(i,j,k) = Kd_wall @@ -1521,7 +1521,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ type(forcing), intent(in) :: fluxes !< Surface fluxes structure type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in m2 s-1. + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1. integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the @@ -1529,7 +1529,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ !! usually (~Rho_0 / (G_Earth * dRho_lay)), !! in m2 s-1 / m3 s-3 = s2 m-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in m2 s-1. + optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1. ! This routine adds effects of mixed layer radiation to the layer diffusivities. @@ -1602,10 +1602,10 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ endif ; enddo ; enddo if (present(Kd_int)) then do K=2,kml+1 ; do i=is,ie ; if (do_i(i)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_mlr_ml(i) + Kd_int(i,j,K) = Kd_int(i,j,K) + GV%m_to_Z**2*Kd_mlr_ml(i) endif ; enddo ; enddo if (kml<=nz-1) then ; do i=is,ie ; if (do_i(i)) then - Kd_int(i,j,Kml+2) = Kd_int(i,j,Kml+2) + 0.5*Kd_mlr_ml(i) + Kd_int(i,j,Kml+2) = Kd_int(i,j,Kml+2) + 0.5*GV%m_to_Z**2*Kd_mlr_ml(i) endif ; enddo ; endif endif @@ -1623,8 +1623,8 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ Kd_mlr = min(Kd_mlr,CS%ML_rad_kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_mlr if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_mlr - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_mlr + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*GV%m_to_Z**2*Kd_mlr + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*GV%m_to_Z**2*Kd_mlr endif TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-z1) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 6976966a50..7e4f67c7cb 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -668,9 +668,9 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & !! to its maximum realizable thickness, in m3 s-3 type(tidal_mixing_cs), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in m2 s-1. + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in m2 s-1. + optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1. real, intent(in) :: Kd_max !< The maximum increment for diapycnal !! diffusivity due to TKE-based processes, in m2 s-1. !! Set this to a negative value to have no limit. @@ -938,7 +938,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in m2 s-1. + optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1. real, intent(in) :: Kd_max !< The maximum increment for diapycnal !! diffusivity due to TKE-based processes, in m2 s-1. !! Set this to a negative value to have no limit. @@ -1184,8 +1184,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_add if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_add + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*GV%m_to_Z**2*Kd_add + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*GV%m_to_Z**2*Kd_add endif ! diagnostics @@ -1271,8 +1271,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_add if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_add + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*GV%m_to_Z**2*Kd_add + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*GV%m_to_Z**2*Kd_add endif ! diagnostics diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index aec3a68f24..9014243e56 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1069,15 +1069,15 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! h_ml, & ! The mixed layer depth, in m or kg m-2. nk_visc, & ! The (real) interface index of the base of mixed layer. z_t, & ! The distance from the top, sometimes normalized - ! by Hmix, in m or nondimensional. + ! by Hmix, in H or nondimensional. kv_tbl, & ! The viscosity in a top boundary layer under ice, in Z2 s-1. tbl_thick real, dimension(SZIB_(G),SZK_(GV)) :: & Kv_add ! A viscosity to add, in Z2 s-1. - real :: h_shear ! The distance over which shears occur, m or kg m-2. - real :: r ! A thickness to compare with Hbbl, in m or kg m-2. - real :: visc_ml ! The mixed layer viscosity, in m2 s-1. - real :: I_Hmix ! The inverse of the mixed layer thickness, in m-1 or m2 kg-1. + real :: h_shear ! The distance over which shears occur, H. + real :: r ! A thickness to compare with Hbbl, in H. + real :: visc_ml ! The mixed layer viscosity, in Z2 s-1. + real :: I_Hmix ! The inverse of the mixed layer thickness, in H-1. real :: a_ml ! The layer coupling coefficient across an interface in ! the mixed layer, in m s-1. real :: I_amax ! The inverse of the maximum coupling coefficient, in Z-1.??? diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index f3684f3cdc..deec1cd858 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -49,7 +49,7 @@ subroutine user_change_diff(h, tv, G, GV, CS, Kd_lay, Kd_int, T_f, S_f, Kd_int_a real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity of !! each layer in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int !< The diapycnal diffusivity - !! at each interface in m2 s-1. + !! at each interface in Z2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: T_f !< Temperature with massless !! layers filled in vertically. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: S_f !< Salinity with massless @@ -132,7 +132,7 @@ subroutine user_change_diff(h, tv, G, GV, CS, Kd_lay, Kd_int, T_f, S_f, Kd_int_a ! rho_int = 0.5*(Rcv(i,k-1) + Rcv(i,k)) rho_fn = val_weights( 0.5*(Rcv(i,k-1) + Rcv(i,k)), CS%rho_range) if (rho_fn * lat_fn > 0.0) then - Kd_int(i,j,K) = Kd_int(i,j,K) + CS%Kd_add * rho_fn * lat_fn + Kd_int(i,j,K) = Kd_int(i,j,K) + GV%m_to_Z**2 * CS%Kd_add * rho_fn * lat_fn if (store_Kd_add) Kd_int_add(i,j,K) = CS%Kd_add * rho_fn * lat_fn endif enddo ; enddo From dfe674c5d0336e53c82cd2a8951e30699844c7c3 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Thu, 4 Oct 2018 12:58:00 -0400 Subject: [PATCH 0780/1072] Diag decimation prototype, aggregating methods - This update introduces aggregation methods, so that we can point average the fields rather than subsampling. This cab be extended to fancier methods such as area or volume averaging --- src/framework/MOM_diag_mediator.F90 | 267 ++++++++++++++++++---------- 1 file changed, 174 insertions(+), 93 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 46dfae8507..c5e4de65a2 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -68,12 +68,8 @@ module MOM_diag_mediator module procedure post_data_3d, post_data_2d, post_data_0d end interface post_data -interface zap2_sample - module procedure zap2_sample_2d,zap2_sample_3d,zap2_sample_2d0,zap2_sample_3d0 -end interface zap2_sample - interface decimate_sample - module procedure decimate_sample_3d_out + module procedure decimate_sample_2d_ptr, decimate_sample_3d_ptr, decimate_sample_2d, decimate_sample_3d end interface decimate_sample interface decimate_diag_field_set @@ -1330,12 +1326,20 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) isl=1; iel=size(field,1)/dl jsl=1; jel=size(field,2)/dl call decimate_diag_indices_get(iel,jel, dl, diag_cs,isv,iev,jsv,jev) - allocate(locfield_decim(isl:iel,jsl:jel)) - call decimate_diag_field_set(locfield, locfield_decim, dl,isl,iel,jsl,jel) +! allocate(locfield_decim(isl:iel,jsl:jel)) +! call decimate_diag_field_set(locfield, locfield_decim, dl,isl,iel,jsl,jel) + if (present(mask)) then + call decimate_sample(locfield, locfield_decim, dl, method='pave', mask=locmask) + elseif (associated(diag%axes%mask2d)) then + call decimate_sample(locfield, locfield_decim, dl, method='pave', mask=diag%axes%mask2d) + else + call decimate_sample(locfield, locfield_decim, dl, method='pave') !decimate without a mask, how ?? + endif locfield => locfield_decim if (present(mask)) then - allocate(locmask_decim(isl:iel,jsl:jel)) - call decimate_diag_field_set(locmask, locmask_decim, dl,isl,iel,jsl,jel) +! allocate(locmask_decim(isl:iel,jsl:jel)) +! call decimate_diag_field_set(locmask, locmask_decim, dl,isl,iel,jsl,jel) + call decimate_sample(locmask, locmask_decim, dl) locmask => locmask_decim elseif (associated(diag%axes%decim(dl)%mask2d)) then diag_axes_mask2d => diag%axes%decim(dl)%mask2d @@ -1611,12 +1615,21 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) isl=1; iel=size(field,1)/dl jsl=1; jel=size(field,2)/dl call decimate_diag_indices_get(iel,jel, dl, diag_cs,isv,iev,jsv,jev) - allocate(locfield_decim(isl:iel,jsl:jel,ks:ke)) - call decimate_diag_field_set(locfield, locfield_decim, dl,isl,iel,jsl,jel,ks,ke) +! allocate(locfield_decim(isl:iel,jsl:jel,ks:ke)) +! call decimate_diag_field_set(locfield, locfield_decim, dl,isl,iel,jsl,jel,ks,ke) + if (present(mask)) then + call decimate_sample(locfield, locfield_decim, dl, method='pave', mask=locmask) + elseif (associated(diag%axes%mask3d)) then + call decimate_sample(locfield, locfield_decim, dl, method='pave', mask=diag%axes%mask3d) + else + !Niki: How are we supposed to aggregate/average without a mask if one or more aggregating cells are on land? + call decimate_sample(locfield, locfield_decim, dl, method='pave') !decimate without a mask, how ?? + endif locfield => locfield_decim if (present(mask)) then - allocate(locmask_decim(isl:iel,jsl:jel,ks:ke)) - call decimate_diag_field_set(locmask, locmask_decim, dl,isl,iel,jsl,jel,ks,ke) +! allocate(locmask_decim(isl:iel,jsl:jel,ks:ke)) +! call decimate_diag_field_set(locmask, locmask_decim, dl,isl,iel,jsl,jel,ks,ke) + call decimate_sample(locmask, locmask_decim, dl) ! Niki: What is the correct method for mask? Defaults to subsample locmask => locmask_decim elseif (associated(diag%axes%decim(dl)%mask3d)) then diag_axes_mask3d => diag%axes%decim(dl)%mask3d @@ -3361,76 +3374,6 @@ subroutine diag_grid_storage_end(grid_storage) deallocate(grid_storage%diag_grids) end subroutine diag_grid_storage_end -subroutine zap2_sample_3d(field_in, field_out,ks,ke, is,ie,js,je, is2,ie2,js2,je2) - integer , intent(in) :: ks,ke, is,ie,js,je, is2,ie2,js2,je2 - real, dimension(is:,js:,1:) ,intent(in) :: field_in - real, dimension(:,:,:) , pointer :: field_out - integer :: k,i,j,ii,jj - - allocate(field_out(is2:ie2,js2:je2,ks:ke)) - do k= ks,ke ; do j=js2,je2 ; do i=is2,ie2 - ii = is+2*(i-is2) - jj = js+2*(j-js2) - field_out(i,j,k) = field_in(ii,jj,k) - enddo; enddo; enddo - -end subroutine zap2_sample_3d - -subroutine zap2_sample_2d(field_in, field_out, is,ie,js,je, is2,ie2,js2,je2) - integer , intent(in) :: is,ie,js,je, is2,ie2,js2,je2 - real, dimension(is:,js:) ,intent(in) :: field_in - real, dimension(:,:) , pointer :: field_out - integer :: i,j,ii,jj - - allocate(field_out(is2:ie2,js2:je2)) - do j=js2,je2 ; do i=is2,ie2 - ii = is+2*(i-is2) - jj = js+2*(j-js2) - field_out(i,j) = field_in(ii,jj) - enddo; enddo - -end subroutine zap2_sample_2d - -subroutine zap2_sample_3d0(field_in, field_out,ks,ke) - integer , intent(in) :: ks,ke - real, dimension(:,:,:) ,intent(in) :: field_in - real, dimension(:,:,:) , pointer :: field_out - integer :: k,i,j,ii,jj, is_in,js_in, is2,ie2,js2,je2 - - is_in=1; js_in=1 - is2=1; ie2=size(field_in,1)/2 - js2=1; je2=size(field_in,2)/2 - - allocate(field_out(is2:ie2,js2:je2,ks:ke)) - - do k= ks,ke ; do j=js2,je2 ; do i=is2,ie2 - ii = is_in+2*(i-is2) - jj = js_in+2*(j-js2) - field_out(i,j,k) = field_in(ii,jj,k) - enddo; enddo; enddo - -end subroutine zap2_sample_3d0 - -subroutine zap2_sample_2d0(field_in, field_out) - real, dimension(:,:) ,intent(in) :: field_in - real, dimension(:,:) , pointer :: field_out - integer :: i,j,ii,jj, is_in,js_in, is2,ie2,js2,je2 - - is_in=1; js_in=1 - is2=1; ie2=size(field_in,1)/2 - js2=1; je2=size(field_in,2)/2 - - allocate(field_out(is2:ie2,js2:je2)) - - do j=js2,je2 ; do i=is2,ie2 - ii = is_in+2*(i-is2) - jj = js_in+2*(j-js2) - field_out(i,j) = field_in(ii,jj) - enddo; enddo - -end subroutine zap2_sample_2d0 - - subroutine decimate_diag_masks_set(G, nz, diag_cs) type(ocean_grid_type), target, intent(in) :: G !< The ocean grid type. integer, intent(in) :: nz !< The number of layers in the model's native grid. @@ -3450,14 +3393,10 @@ subroutine decimate_diag_masks_set(G, nz, diag_cs) do dl=2,MAX_DECIM_LEV ! 2d masks - allocate(diag_cs%decim(dl)%mask2dT(G%isd_zap2:G%ied_zap2,G%jsd_zap2:G%jed_zap2)) - allocate(diag_cs%decim(dl)%mask2dBu(G%IsdB_zap2:G%IedB_zap2,G%JsdB_zap2:G%JedB_zap2)) - allocate(diag_cs%decim(dl)%mask2dCu(G%IsdB_zap2:G%IedB_zap2,G%jsd_zap2:G%jed_zap2)) - allocate(diag_cs%decim(dl)%mask2dCv(G%isd_zap2:G%ied_zap2,G%JsdB_zap2:G%JedB_zap2)) - call zap2_sample(G%mask2dT, diag_cs%decim(dl)%mask2dT ,G%isd,G%ied,G%jsd,G%jed,G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2) - call zap2_sample(G%mask2dBu,diag_cs%decim(dl)%mask2dBu,G%isd,G%ied,G%jsd,G%jed,G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2) - call zap2_sample(G%mask2dCu,diag_cs%decim(dl)%mask2dCu,G%isd,G%ied,G%jsd,G%jed,G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2) - call zap2_sample(G%mask2dCv,diag_cs%decim(dl)%mask2dCv,G%isd,G%ied,G%jsd,G%jed,G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2) + call decimate_sample(G%mask2dT, diag_cs%decim(dl)%mask2dT, dl) + call decimate_sample(G%mask2dBu,diag_cs%decim(dl)%mask2dBu, dl) + call decimate_sample(G%mask2dCu,diag_cs%decim(dl)%mask2dCu, dl) + call decimate_sample(G%mask2dCv,diag_cs%decim(dl)%mask2dCv, dl) ! 3d native masks are needed by diag_manager but the native variables ! can only be masked 2d - for ocean points, all layers exists. allocate(diag_cs%decim(dl)%mask3dTL(G%isd_zap2:G%ied_zap2,G%jsd_zap2:G%jed_zap2,1:nz)) @@ -3564,7 +3503,7 @@ subroutine decimate_diag_field_set_2d(field_in, field_out, level ,isl,iel,jsl,je end subroutine decimate_diag_field_set_2d -subroutine decimate_sample_3d_out(field_in, field_out, level) +subroutine decimate_sample_3d(field_in, field_out, level) integer , intent(in) :: level real, dimension(:,:,:) , pointer :: field_in, field_out integer :: i,j,ii,jj,is,js @@ -3584,6 +3523,148 @@ subroutine decimate_sample_3d_out(field_in, field_out, level) jj = js+level*(j-jsl) field_out(i,j,k) = field_in(ii,jj,k) enddo; enddo; enddo -end subroutine decimate_sample_3d_out +end subroutine decimate_sample_3d + +subroutine decimate_sample_3d_ptr(field_in, field_out, level, method, mask) + real, dimension(:,:,:) , pointer :: field_in + real, dimension(:,:,:) , allocatable :: field_out + integer , intent(in) :: level + character(len=4), optional, intent(in) :: method !< sampling method, one of samp,pave,aave,vave + real, dimension(:,:,:), optional , pointer :: mask + !locals + integer :: i,j,ii,jj,is,js,i0,j0 + integer :: isl,iel,jsl,jel + integer :: k,ks,ke + real :: ave,tot_non_zero + character(len=4) :: samplemethod + samplemethod = 'samp' + if(present(method)) samplemethod = method + + !Always start from the first element + is=1 + js=1 + ks = lbound(field_in,3) ; ke = ubound(field_in,3) + isl=1; iel=size(field_in,1)/level + jsl=1; jel=size(field_in,2)/level + allocate(field_out(isl:iel,jsl:jel,ks:ke)) + + + select case (samplemethod) + case ('samp') !subsample the SW corner cell + do k= ks,ke ; do j=jsl,jel ; do i=isl,iel + i0 = is+level*(i-isl) + j0 = js+level*(j-jsl) + field_out(i,j,k) = field_in(i0,j0,k) + enddo; enddo; enddo + case ('pave') !point average of the cells + if(present(mask)) then + do k= ks,ke ; do j=jsl,jel ; do i=isl,iel + i0 = is+level*(i-isl) + j0 = js+level*(j-jsl) + ave = 0.0 + tot_non_zero = 0.0 + do ii=i0,i0+level-1 ; do jj=j0,j0+level-1 + tot_non_zero = tot_non_zero + mask(ii,jj,k) + ave=ave+field_in(ii,jj,k)*mask(ii,jj,k) + enddo; enddo + field_out(i,j,k) = ave/max(1.0,tot_non_zero) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo; enddo; enddo + else + do k= ks,ke ; do j=jsl,jel ; do i=isl,iel + i0 = is+level*(i-isl) + j0 = js+level*(j-jsl) + ave = 0.0 + tot_non_zero = 0.0 + do ii=i0,i0+level-1 ; do jj=j0,j0+level-1 + tot_non_zero = tot_non_zero + 1 + ave=ave+field_in(ii,jj,k) + enddo; enddo + field_out(i,j,k) = ave/tot_non_zero + enddo; enddo; enddo + endif + case default + call MOM_error(FATAL, "decimate_sample_3d_ptr: unknown sampling method "//trim(samplemethod)) + end select + +end subroutine decimate_sample_3d_ptr + +subroutine decimate_sample_2d_ptr(field_in, field_out, level, method, mask) + real, dimension(:,:) , pointer :: field_in + real, dimension(:,:) , allocatable :: field_out + integer , intent(in) :: level + character(len=4), optional, intent(in) :: method !< sampling method, one of samp,pave,aave,vave + real, dimension(:,:), optional , pointer :: mask + !locals + integer :: i,j,ii,jj,is,js,i0,j0 + integer :: isl,iel,jsl,jel + real :: ave,tot_non_zero + character(len=4) :: samplemethod + samplemethod = 'samp' + if(present(method)) samplemethod = method + + !Always start from the first element + is=1 + js=1 + isl=1; iel=size(field_in,1)/level + jsl=1; jel=size(field_in,2)/level + allocate(field_out(isl:iel,jsl:jel)) + + select case (samplemethod) + case ('samp') !subsample the SW corner cell + do j=jsl,jel ; do i=isl,iel + i0 = is+level*(i-isl) + j0 = js+level*(j-jsl) + field_out(i,j) = field_in(i0,j0) + enddo; enddo + case ('pave') !point average of the cells + if(present(mask)) then + do j=jsl,jel ; do i=isl,iel + i0 = is+level*(i-isl) + j0 = js+level*(j-jsl) + ave = 0.0 + tot_non_zero = 0.0 + do ii=i0,i0+level-1 ; do jj=j0,j0+level-1 + tot_non_zero = tot_non_zero + mask(ii,jj) + ave=ave+field_in(ii,jj)*mask(ii,jj) + enddo; enddo + field_out(i,j) = ave/max(1.0,tot_non_zero) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo; enddo + else !Niki: How are we supposed to aggregate/average without a mask? What if field_in is on land at one or more aggregating cells? + do j=jsl,jel ; do i=isl,iel + i0 = is+level*(i-isl) + j0 = js+level*(j-jsl) + ave = 0.0 + tot_non_zero = 0.0 + do ii=i0,i0+level-1 ; do jj=j0,j0+level-1 + tot_non_zero = tot_non_zero + 1 + ave=ave+field_in(ii,jj) + enddo; enddo + field_out(i,j) = ave/tot_non_zero + enddo; enddo + endif + case default + call MOM_error(FATAL, "decimate_sample_2d_ptr: unknown sampling method "//trim(samplemethod)) + end select + +end subroutine decimate_sample_2d_ptr + +subroutine decimate_sample_2d(field_in, field_out, level) + integer , intent(in) :: level + real, dimension(:,:) , intent(in) :: field_in + real, dimension(:,:) , pointer :: field_out + integer :: i,j,ii,jj,is,js + integer :: isl,iel,jsl,jel + !Always start from the first element + is=1 + js=1 + isl=1; iel=size(field_in,1)/level + jsl=1; jel=size(field_in,2)/level + allocate(field_out(isl:iel,jsl:jel)) + do j=jsl,jel ; do i=isl,iel + ii = is+level*(i-isl) + jj = js+level*(j-jsl) + field_out(i,j) = field_in(ii,jj) + enddo; enddo +end subroutine decimate_sample_2d end module MOM_diag_mediator From 138e63a54d9a3aca0843f6ccff24bb704c7a66aa Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 13:11:24 -0400 Subject: [PATCH 0781/1072] +Do MOM_bkgnd_mixing calculations in units of Z Changed the units of the internal diffusivites used in MOM_bkgnd_mixing from m2 s-1 to Z2 s-1 and depths from m to Z for dimensional consistency testing. Several variables are rescaled via get_param. As a part of these chages, a new GV argument was added to sfc_bkgnd_mixing. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_bkgnd_mixing.F90 | 67 +++++++++---------- .../vertical/MOM_set_diffusivity.F90 | 2 +- 2 files changed, 34 insertions(+), 35 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 83b1f70026..bdae195c06 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -41,8 +41,8 @@ module MOM_bkgnd_mixing !! Bryan-Lewis diffusivity profile (1/m) real :: Bryan_Lewis_c4 !< The depth where diffusivity is Bryan_Lewis_bl1 in the !! Bryan-Lewis profile (m) - real :: Kd_min !< minimum diapycnal diffusivity (m2/s) - real :: Kd !< interior diapycnal diffusivity (m2/s) + real :: Kd_min !< minimum diapycnal diffusivity (Z2/s) + real :: Kd !< interior diapycnal diffusivity (Z2/s) real :: N0_2Omega !< ratio of the typical Buoyancy frequency to !! twice the Earth's rotation period, used with the !! Henyey scaling from the mixing @@ -51,10 +51,9 @@ module MOM_bkgnd_mixing real :: Kd_tanh_lat_scale !< A nondimensional scaling for the range of !! diffusivities with Kd_tanh_lat_fn. Valid values !! are in the range of -2 to 2; 0.4 reproduces CM2M. - real :: Kdml !< mixed layer diapycnal diffusivity (m2/s) + real :: Kdml !< mixed layer diapycnal diffusivity (Z2/s) !! when bulkmixedlayer==.false. - real :: Hmix !< mixed layer thickness (meter) when - !! bulkmixedlayer==.false. + real :: Hmix !< mixed layer thickness (Z) when bulkmixedlayer==.false. logical :: Kd_tanh_lat_fn !< If true, use the tanh dependence of Kd_sfc on !! latitude, like GFDL CM2.1/CM2M. There is no !! physical justification for this form, and it can @@ -86,10 +85,10 @@ module MOM_bkgnd_mixing integer :: id_kd_bkgnd = -1 !< Diagnotic IDs integer :: id_kv_bkgnd = -1 !< Diagnostic IDs - real, allocatable, dimension(:,:) :: Kd_sfc !< surface value of the diffusivity (m2/s) + real, allocatable, dimension(:,:) :: Kd_sfc !< surface value of the diffusivity (Z2/s) ! Diagnostics arrays - real, allocatable, dimension(:,:,:) :: kd_bkgnd !< Background diffusivity (m2/s) - real, allocatable, dimension(:,:,:) :: kv_bkgnd !< Background viscosity (m2/s) + real, allocatable, dimension(:,:,:) :: kd_bkgnd !< Background diffusivity (Z2/s) + real, allocatable, dimension(:,:,:) :: kv_bkgnd !< Background viscosity (Z2/s) end type bkgnd_mixing_cs @@ -126,11 +125,11 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "KD", CS%Kd, & "The background diapycnal diffusivity of density in the \n"//& "interior. Zero or the molecular value, ~1e-7 m2 s-1, \n"//& - "may be used.", units="m2 s-1", fail_if_missing=.true.) + "may be used.", units="m2 s-1", scale=GV%m_to_Z**2, fail_if_missing=.true.) call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, & "The minimum diapycnal diffusivity.", & - units="m2 s-1", default=0.01*CS%Kd) + units="m2 s-1", default=0.01*CS%Kd*GV%Z_to_m**2, scale=GV%m_to_Z**2) ! The following is needed to set one of the choices of vertical background mixing @@ -150,11 +149,11 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) "If BULKMIXEDLAYER is false, KDML is the elevated \n"//& "diapycnal diffusivity in the topmost HMIX of fluid. \n"//& "KDML is only used if BULKMIXEDLAYER is false.", & - units="m2 s-1", default=CS%Kd) + units="m2 s-1", default=CS%Kd*GV%Z_to_m**2, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface \n"//& "viscosity and diffusivity are elevated when the bulk \n"//& - "mixed layer is not used.", units="m", fail_if_missing=.true.) + "mixed layer is not used.", units="m", scale=GV%m_to_Z, fail_if_missing=.true.) endif call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) @@ -245,16 +244,17 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) ! Register diagnostics CS%diag => diag CS%id_kd_bkgnd = register_diag_field('ocean_model', 'Kd_bkgnd', diag%axesTi, Time, & - 'Background diffusivity added by MOM_bkgnd_mixing module', 'm2/s') + 'Background diffusivity added by MOM_bkgnd_mixing module', 'm2/s', conversion=GV%Z_to_m**2) CS%id_kv_bkgnd = register_diag_field('ocean_model', 'Kv_bkgnd', diag%axesTi, Time, & - 'Background viscosity added by MOM_bkgnd_mixing module', 'm2/s') + 'Background viscosity added by MOM_bkgnd_mixing module', 'm2/s', conversion=GV%Z_to_m**2) end subroutine bkgnd_mixing_init !> Get surface vertical background diffusivities/viscosities. -subroutine sfc_bkgnd_mixing(G, CS) +subroutine sfc_bkgnd_mixing(G, GV, CS) type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(bkgnd_mixing_cs), pointer, intent(inout) :: CS !< The control structure returned by !! a previous call to bkgnd_mixing_init. ! local variables @@ -299,7 +299,7 @@ subroutine sfc_bkgnd_mixing(G, CS) enddo ; enddo endif - if (CS%debug) call hchksum(CS%Kd_sfc,"After sfc_bkgnd_mixing: Kd_sfc",G%HI,haloshift=0) + if (CS%debug) call hchksum(CS%Kd_sfc,"After sfc_bkgnd_mixing: Kd_sfc",G%HI,haloshift=0, scale=GV%Z_to_m**2) end subroutine sfc_bkgnd_mixing @@ -324,10 +324,9 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) real, dimension(SZK_(G)+1) :: depth_int !< distance from surface of the interfaces (m) real, dimension(SZK_(G)+1) :: Kd_col !< Diffusivities at the interfaces (m2 s-1) real, dimension(SZK_(G)+1) :: Kv_col !< Viscosities at the interfaces (m2 s-1) - real, dimension(SZI_(G)) :: & - depth !< distance from surface of an interface (meter) - real :: depth_c !< depth of the center of a layer (meter) - real :: I_Hmix !< inverse of fixed mixed layer thickness (1/m) + real, dimension(SZI_(G)) :: depth !< distance from surface of an interface (Z) + real :: depth_c !< depth of the center of a layer (Z) + real :: I_Hmix !< inverse of fixed mixed layer thickness (1/Z) real :: I_2Omega !< 1/(2 Omega) (sec) real :: N_2Omega real :: N02_N2 @@ -365,8 +364,8 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) ! Update Kd and Kv. do K=1,nz+1 - CS%Kv_bkgnd(i,j,K) = Kv_col(K) - CS%Kd_bkgnd(i,j,K) = Kd_col(K) + CS%Kv_bkgnd(i,j,K) = GV%m_to_Z**2*Kv_col(K) + CS%Kd_bkgnd(i,j,K) = GV%m_to_Z**2*Kd_col(K) enddo do k=1,nz Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_col(K) + Kd_col(K+1)) @@ -374,19 +373,19 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) enddo ! i loop elseif ((.not. CS%Bryan_Lewis_diffusivity) .and. (.not.CS%bulkmixedlayer) .and. & - (CS%Kd/= CS%Kdml)) then + (CS%Kd /= CS%Kdml)) then I_Hmix = 1.0 / CS%Hmix do i=is,ie ; depth(i) = 0.0 ; enddo do k=1,nz ; do i=is,ie - depth_c = depth(i) + 0.5*GV%H_to_m*h(i,j,k) - if (depth_c <= CS%Hmix) then ; CS%kd_bkgnd(i,j,k) = CS%Kdml - elseif (depth_c >= 2.0*CS%Hmix) then ; CS%kd_bkgnd(i,j,k) = CS%Kd_sfc(i,j) + depth_c = depth(i) + 0.5*GV%H_to_Z*h(i,j,k) + if (depth_c <= CS%Hmix) then ; CS%Kd_bkgnd(i,j,k) = CS%Kdml + elseif (depth_c >= 2.0*CS%Hmix) then ; CS%Kd_bkgnd(i,j,k) = CS%Kd_sfc(i,j) else - Kd_lay(i,j,k) = GV%m_to_Z**2*((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & - GV%m_to_Z**2*(2.0*CS%Kdml - CS%Kd_sfc(i,j)) + Kd_lay(i,j,k) = ((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & + (2.0*CS%Kdml - CS%Kd_sfc(i,j)) endif - depth(i) = depth(i) + GV%H_to_m*h(i,j,k) + depth(i) = depth(i) + GV%H_to_Z*h(i,j,k) enddo ; enddo elseif (CS%Henyey_IGW_background_new) then @@ -395,13 +394,13 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) abs_sin = max(epsilon,abs(sin(G%geoLatT(i,j)*deg_to_rad))) N_2Omega = max(abs_sin,sqrt(N2_lay(i,k))*I_2Omega) N02_N2 = (CS%N0_2Omega/N_2Omega)**2 - Kd_lay(i,j,k) = max(GV%m_to_Z**2*CS%Kd_min, GV%m_to_Z**2*CS%Kd_sfc(i,j) * & + Kd_lay(i,j,k) = max(CS%Kd_min, CS%Kd_sfc(i,j) * & ((abs_sin * invcosh(N_2Omega/abs_sin)) * I_x30)*N02_N2) enddo ; enddo else do k=1,nz ; do i=is,ie - Kd_lay(i,j,k) = GV%m_to_Z**2*CS%Kd_sfc(i,j) + Kd_lay(i,j,k) = CS%Kd_sfc(i,j) enddo ; enddo endif @@ -411,8 +410,8 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) CS%kd_bkgnd(i,j,1) = 0.0; CS%kv_bkgnd(i,j,1) = 0.0 CS%kd_bkgnd(i,j,nz+1) = 0.0; CS%kv_bkgnd(i,j,nz+1) = 0.0 do k=2,nz - CS%kd_bkgnd(i,j,k) = 0.5*GV%Z_to_m**2*(Kd_lay(i,j,K-1) + Kd_lay(i,j,K)) - CS%kv_bkgnd(i,j,k) = CS%kd_bkgnd(i,j,k) * CS%prandtl_bkgnd + CS%Kd_bkgnd(i,j,k) = 0.5*(Kd_lay(i,j,K-1) + Kd_lay(i,j,K)) + CS%Kv_bkgnd(i,j,k) = CS%Kd_bkgnd(i,j,k) * CS%prandtl_bkgnd enddo enddo endif @@ -420,7 +419,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) ! Update Kv if (associated(kv)) then do k=1,nz+1 ; do i=is,ie - Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * CS%kv_bkgnd(i,j,k) + Kv(i,j,k) = Kv(i,j,k) + CS%Kv_bkgnd(i,j,k) enddo ; enddo endif diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index df6c7df3c1..2223fa1bc9 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -386,7 +386,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! another explicit parameterization of Kd. ! set surface diffusivities (CS%bkgnd_mixing_csp%Kd_sfc) - call sfc_bkgnd_mixing(G, CS%bkgnd_mixing_csp) + call sfc_bkgnd_mixing(G, GV, CS%bkgnd_mixing_csp) !$OMP parallel do default(shared) private(dRho_int, N2_lay, N2_int, N2_bot, KT_extra, & !$OMP KS_extra, TKE_to_Kd,maxTKE, dissip, kb) From a42e3dc98d4ef4c35a810a97168c242eab74bab5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 13:23:51 -0400 Subject: [PATCH 0782/1072] +Changed the units of Kd_min_tr to Z-2 s-1 Rescaled the units of Kd_min_tr and Kd_BBL_tr in the diabatic control structure from m2 s-1 to Z2 s-1 for dimensional consistency testing. Also converted HMIX_MIN from m to Z when it is read in via get_param in regularize_layers_init, which in turn requred a new GV argument to regularize_layers_init. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_diabatic_driver.F90 | 22 +++++++++---------- .../vertical/MOM_regularize_layers.F90 | 9 ++++---- 2 files changed, 16 insertions(+), 15 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 15474051b0..61ba757a7e 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -145,11 +145,11 @@ module MOM_diabatic_driver !! operating. real :: Kd_BBL_tr !< A bottom boundary layer tracer diffusivity that !! will allow for explicitly specified bottom fluxes - !! in m2 s-1. The entrainment at the bottom is at + !! in Z2 s-1. The entrainment at the bottom is at !! least sqrt(Kd_BBL_tr*dt) over the same distance. real :: Kd_min_tr !< A minimal diffusivity that should always be !! applied to tracers, especially in massless layers - !! near the bottom, in m2 s-1. + !! near the bottom, in Z2 s-1. real :: minimum_forcing_depth = 0.001 !< The smallest depth over which heat and freshwater !! fluxes are applied, in m. real :: evap_CFL_limit = 0.8 !< The largest fraction of a layer that can be @@ -319,7 +319,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! These are targets so that the space can be shared with eaml & ebml. eatr, & ! The equivalent of ea and eb for tracers, which differ from ea and ebtr ! eb in that they tend to homogenize tracers in massless layers - ! near the boundaries (m for Bouss and kg/m^2 for non-Bouss) + ! near the boundaries in H (m for Bouss and kg/m^2 for non-Bouss) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & Kd_int, & ! diapycnal diffusivity of interfaces (m^2/s) @@ -334,7 +334,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! The following 5 variables are only used with a bulk mixed layer. real, pointer, dimension(:,:,:) :: & - eaml, & ! The equivalent of ea and eb due to mixed layer processes, + eaml, & ! The equivalent of ea and eb due to mixed layer processes, in H ebml ! (m for Bouss and kg/m^2 for non-Bouss). These will be ! pointers to eatr and ebtr so as to reuse the memory as ! the arrays are not needed at the same time. @@ -366,7 +366,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real :: Tr_ea_BBL ! The diffusive tracer thickness in the BBL that is ! coupled to the bottom within a timestep (m) - real :: htot(SZIB_(G)) ! The summed thickness from the bottom, in m. + real :: htot(SZIB_(G)) ! The summed thickness from the bottom, in H. real :: b1(SZIB_(G)), d1(SZIB_(G)) ! b1, c1, and d1 are variables used by the real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. @@ -915,7 +915,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call cpu_clock_begin(id_clock_tracers) if (CS%mix_boundary_tracers) then - Tr_ea_BBL = sqrt(dt*CS%Kd_BBL_tr) + Tr_ea_BBL = GV%Z_to_H * sqrt(dt*CS%Kd_BBL_tr) !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je do i=is,ie @@ -934,7 +934,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! in the calculation of the fluxes in the first place. Kd_min_tr ! should be much less than the values that have been set in Kd_lay, ! perhaps a molecular diffusivity. - add_ent = ((dt * CS%Kd_min_tr) * GV%m_to_H**2) * & + add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & 0.5*(ea_s(i,j,k) + eb_s(i,j,k-1)) @@ -2078,7 +2078,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! in the calculation of the fluxes in the first place. Kd_min_tr ! should be much less than the values that have been set in Kd_lay, ! perhaps a molecular diffusivity. - add_ent = ((dt * CS%Kd_min_tr) * GV%m_to_H**2) * & + add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & 0.5*(ea(i,j,k) + eb(i,j,k-1)) @@ -2909,12 +2909,12 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, call get_param(param_file, mdl, "KD_MIN_TR", CS%Kd_min_tr, & "A minimal diffusivity that should always be applied to \n"//& "tracers, especially in massless layers near the bottom. \n"//& - "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd) !### This would benefit from rescaling. + "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "KD_BBL_TR", CS%Kd_BBL_tr, & "A bottom boundary layer tracer diffusivity that will \n"//& "allow for explicitly specified bottom fluxes. The \n"//& "entrainment at the bottom is at least sqrt(Kd_BBL_tr*dt) \n"//& - "over the same distance.", units="m2 s-1", default=0.) !### This needs rescaling? + "over the same distance.", units="m2 s-1", default=0., scale=GV%m_to_Z**2) endif call get_param(param_file, mdl, "TRACER_TRIDIAG", CS%tracer_tridiag, & @@ -3310,7 +3310,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, if (CS%use_energetic_PBL) & call energetic_PBL_init(Time, G, GV, param_file, diag, CS%energetic_PBL_CSp) - call regularize_layers_init(Time, G, param_file, diag, CS%regularize_layers_CSp) + call regularize_layers_init(Time, G, GV, param_file, diag, CS%regularize_layers_CSp) if (CS%debug_energy_req) & call diapyc_energy_req_init(Time, G, param_file, diag, CS%diapyc_en_rec_CSp) diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 2b5aa4802b..5bf74bf66c 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -42,7 +42,7 @@ module MOM_regularize_layers real :: h_def_tol4 !< The value of the relative thickness deficit at which to do !! detrainment from the buffer layers to the interior at full !! force, now 50% of the way from h_def_tol1 to 1. - real :: Hmix_min !< The minimum mixed layer thickness in m. + real :: Hmix_min !< The minimum mixed layer thickness in H. type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. @@ -773,7 +773,7 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & endif nkmb = GV%nk_rho_varies h_neglect = GV%H_subroundoff - Hmix_min = CS%Hmix_min * GV%m_to_H + Hmix_min = CS%Hmix_min ! Determine which zonal faces are problematic. do j=js,je ; do I=is-1,ie @@ -876,9 +876,10 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & end subroutine find_deficit_ratios !> Initializes the regularize_layers control structure -subroutine regularize_layers_init(Time, G, param_file, diag, CS) +subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS) type(time_type), target, intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for !! run-time parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate @@ -916,7 +917,7 @@ subroutine regularize_layers_init(Time, G, param_file, diag, CS) call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, & "The minimum mixed layer depth if the mixed layer depth \n"//& - "is determined dynamically.", units="m", default=0.0) + "is determined dynamically.", units="m", default=0.0, scale=GV%m_to_H) call get_param(param_file, mdl, "REG_SFC_DEFICIT_TOLERANCE", CS%h_def_tol1, & "The value of the relative thickness deficit at which \n"//& "to start modifying the layer structure when \n"//& From 85afb793343e0c5e9734b17fce766c2a678befef Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 13:24:16 -0400 Subject: [PATCH 0783/1072] Rescaled TOLERANCE_ENT from m to Z when it is read Rescaled TOLERANCE_ENT from m to Z when it is read in entrain_diffusive_init. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_entrain_diffusive.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index b2911d5033..3c7f21236a 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -223,7 +223,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & &and a linear equation of state to drive the model.") endif - tolerance = GV%m_to_H * CS%Tolerance_Ent + tolerance = CS%Tolerance_Ent g_2dt = 0.5 * (GV%g_Earth*GV%m_to_Z) / dt kmb = GV%nk_rho_varies K2 = max(kmb+1,2) ; kb_min = K2 @@ -1509,7 +1509,7 @@ subroutine F_kb_to_ea_kb(h_bl, Sref, Ent_bl, I_dSkbp1, F_kb, kmb, i, & val = dS_kbp1 * F_kb(i) err_min = -val - tolerance = GV%m_to_H * CS%Tolerance_Ent + tolerance = CS%Tolerance_Ent if (present(tol_in)) tolerance = tol_in bisect_next = .true. @@ -1714,7 +1714,7 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & call MOM_error(FATAL, "determine_Ea_kb should not be called "//& "unless BULKMIXEDLAYER is defined.") endif - tolerance = GV%m_to_H * CS%Tolerance_Ent + tolerance = CS%Tolerance_Ent large_err = GV%m_to_H**2 * 1.0e30 do i=is,ie ; redo_i(i) = do_i(i) ; enddo @@ -1902,7 +1902,7 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & integer :: i, it, is1, ie1 integer, parameter :: MAXIT = 20 - tolerance = GV%m_to_H * CS%Tolerance_Ent + tolerance = CS%Tolerance_Ent if (present(do_i_in)) then do i=is,ie ; do_i(i) = do_i_in(i) ; enddo @@ -2186,7 +2186,7 @@ subroutine entrain_diffusive_init(Time, G, GV, param_file, diag, CS) ! CS%Tolerance_Ent = MAX(100.0*GV%Angstrom_H,1.0e-4*sqrt(dt*Kd)) ! call get_param(param_file, mdl, "TOLERANCE_ENT", CS%Tolerance_Ent, & "The tolerance with which to solve for entrainment values.", & - units="m", default=MAX(100.0*GV%Angstrom_m,1.0e-4*sqrt(dt*Kd))) + units="m", default=MAX(100.0*GV%Angstrom_m,1.0e-4*sqrt(dt*Kd)), scale=GV%m_to_H) CS%id_Kd = register_diag_field('ocean_model', 'Kd_effective', diag%axesTL, Time, & 'Diapycnal diffusivity as applied', 'm2 s-1') From 98b98522838576767f14d3979f186bb4e6860e94 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 14:44:00 -0400 Subject: [PATCH 0784/1072] Fixed unit conversions in the diff_work diagnostic Corrected the unit conversion factors in the diff_work diagnostic in entrainment_diffusive. This diagnostic is not often used, and the answers are bitwise identical. --- src/parameterizations/vertical/MOM_entrain_diffusive.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 3c7f21236a..6bd8aa484f 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -171,7 +171,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & real :: dRHo ! The change in locally referenced potential density between ! the layers above and below an interface, in kg m-3. - real :: g_2dt ! 0.5 * G_Earth / dt, in m s-3. + real :: g_2dt ! 0.5 * G_Earth / dt, times unit conversion factors, in m3 H-2 s-3. real, dimension(SZI_(G)) :: & pressure, & ! The pressure at an interface, in Pa. T_eos, S_eos, & ! The potential temperature and salinity at which to @@ -224,7 +224,6 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & endif tolerance = CS%Tolerance_Ent - g_2dt = 0.5 * (GV%g_Earth*GV%m_to_Z) / dt kmb = GV%nk_rho_varies K2 = max(kmb+1,2) ; kb_min = K2 if (.not. CS%bulkmixedlayer) then @@ -823,6 +822,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & endif if (CS%id_diff_work > 0) then + g_2dt = 0.5 * (GV%H_to_Z*GV%H_to_m) * (GV%g_Earth / dt) do i=is,ie ; diff_work(i,j,1) = 0.0 ; diff_work(i,j,nz+1) = 0.0 ; enddo if (associated(tv%eqn_of_state)) then if (associated(fluxes%p_surf)) then From d8ff40968909f826fa1590bea3476a5504578469 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 14:47:51 -0400 Subject: [PATCH 0785/1072] Use bottom roughness in units of Z Recast the internal tide diffusivity calculations to use units of Z for the bottom roughness scales and other vertical lengths for dimensional consistency testing. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_internal_tide_input.F90 | 13 +++++----- .../vertical/MOM_tidal_mixing.F90 | 24 +++++++++---------- 2 files changed, 19 insertions(+), 18 deletions(-) diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 4251f0dd1f..4a59b9f610 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -255,7 +255,7 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide) ! tidal amplitude file is not present. real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height. real :: kappa_itides ! topographic wavenumber and non-dimensional scaling - real :: min_zbot_itides ! Minimum ocean depth for internal tide conversion, in m. + real :: min_zbot_itides ! Minimum ocean depth for internal tide conversion, in Z. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed if (associated(CS)) then @@ -286,7 +286,7 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide) call get_param(param_file, mdl, "MIN_ZBOT_ITIDES", min_zbot_itides, & "Turn off internal tidal dissipation when the total \n"//& - "ocean depth is less than this value.", units="m", default=0.0) + "ocean depth is less than this value.", units="m", default=0.0, scale=GV%m_to_Z) call get_param(param_file, mdl, "UTIDE", utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & @@ -329,20 +329,21 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide) fail_if_missing=.true.) filename = trim(CS%inputdir) // trim(h2_file) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) - call MOM_read_data(filename, 'h2', itide%h2, G%domain, timelevel=1) + call MOM_read_data(filename, 'h2', itide%h2, G%domain, timelevel=1, scale=GV%m_to_Z**2) do j=js,je ; do i=is,ie mask_itidal = 1.0 - if (G%bathyT(i,j) < min_zbot_itides*GV%m_to_Z) mask_itidal = 0.0 + if (G%bathyT(i,j) < min_zbot_itides) mask_itidal = 0.0 itide%tideamp(i,j) = itide%tideamp(i,j) * mask_itidal * G%mask2dT(i,j) ! Restrict rms topo to 10 percent of column depth. - itide%h2(i,j) = min(0.01*(G%bathyT(i,j)*G%Zd_to_m)**2, itide%h2(i,j)) + !### Note the use here of a hard-coded nondimensional constant. + itide%h2(i,j) = min(0.01*G%bathyT(i,j)**2, itide%h2(i,j)) ! Compute the fixed part of internal tidal forcing; units are [J m-2] here. CS%TKE_itidal_coef(i,j) = 0.5*kappa_h2_factor*GV%Rho0*& - kappa_itides * itide%h2(i,j) * itide%tideamp(i,j)**2 + kappa_itides * GV%Z_to_m**2*itide%h2(i,j) * itide%tideamp(i,j)**2 enddo ; enddo diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 7e4f67c7cb..04ca9dc922 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -96,7 +96,7 @@ module MOM_tidal_mixing real :: Decay_scale_factor_lee !< Scaling factor for the decay scale of lee !! wave energy dissipation (nondimensional) - real :: min_zbot_itides !< minimum depth for internal tide conversion (meter) + real :: min_zbot_itides !< minimum depth for internal tide conversion (Z) logical :: Lowmode_itidal_dissipation = .false. !< If true, consider mixing due to breaking low !! modes that have been remotely generated using an internal tidal !! dissipation scheme to specify the vertical profile of the energy @@ -220,7 +220,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, character(len=200) :: filename, h2_file, Niku_TKE_input_file character(len=200) :: tidal_energy_file, tideamp_file type(vardesc) :: vd - real :: utide, zbot, hamp, prandtl_tidal + real :: utide, hamp, prandtl_tidal real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -397,7 +397,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, units="nondim", default=0.3333) call get_param(param_file, mdl, "MIN_ZBOT_ITIDES", CS%min_zbot_itides, & "Turn off internal tidal dissipation when the total \n"//& - "ocean depth is less than this value.", units="m", default=0.0) + "ocean depth is less than this value.", units="m", default=0.0, scale=GV%m_to_Z) endif if ( (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation) .and. & @@ -448,22 +448,21 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, fail_if_missing=(.not.CS%use_CVMix_tidal)) filename = trim(CS%inputdir) // trim(h2_file) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) - call MOM_read_data(filename, 'h2', CS%h2, G%domain, timelevel=1) + call MOM_read_data(filename, 'h2', CS%h2, G%domain, timelevel=1, scale=GV%m_to_Z**2) do j=js,je ; do i=is,ie - if (G%bathyT(i,j)*G%Zd_to_m < CS%min_zbot_itides) CS%mask_itidal(i,j) = 0.0 + if (G%bathyT(i,j) < CS%min_zbot_itides) CS%mask_itidal(i,j) = 0.0 CS%tideamp(i,j) = CS%tideamp(i,j) * CS%mask_itidal(i,j) * G%mask2dT(i,j) ! Restrict rms topo to 10 percent of column depth. - zbot = G%bathyT(i,j)*G%Zd_to_m - hamp = sqrt(CS%h2(i,j)) - hamp = min(0.1*zbot,hamp) + !### Note the hard-coded nondimensional constant, and that this could be simplified. + hamp = min(0.1*G%bathyT(i,j),sqrt(CS%h2(i,j))) CS%h2(i,j) = hamp*hamp utide = CS%tideamp(i,j) ! Compute the fixed part of internal tidal forcing; units are [kg s-2] here. CS%TKE_itidal(i,j) = 0.5*CS%kappa_h2_factor*GV%Rho0*& - CS%kappa_itides*CS%h2(i,j)*utide*utide + CS%kappa_itides*(GV%Z_to_m**2)*CS%h2(i,j)*utide*utide enddo ; enddo endif @@ -546,7 +545,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, vertical_decay_scale = CS%int_tide_decay_scale*GV%Z_to_m, & max_coefficient = CS%tidal_max_coef, & local_mixing_frac = CS%Gamma_itides, & - depth_cutoff = CS%min_zbot_itides) + depth_cutoff = CS%min_zbot_itides*GV%Z_to_m) call read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS) @@ -1057,11 +1056,12 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, do i=is,ie CS%Nb(i,j) = sqrt(N2_bot(i)) + !### In the code below 1.0e-14 is a dimensional constant. if ((CS%tideamp(i,j) > 0.0) .and. & - (CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14) ) then + (CS%kappa_itides**2 * (GV%Z_to_m**2)*CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14) ) then z0_polzin(i) = GV%m_to_Z * CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & CS%Nbotref_Polzin**2 * CS%tideamp(i,j) / & - ( CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 ) + ( CS%kappa_itides**2 * GV%Z_to_m**2*CS%h2(i,j) * CS%Nb(i,j)**3 ) if (z0_polzin(i) < CS%Polzin_min_decay_scale) & z0_polzin(i) = CS%Polzin_min_decay_scale if (N2_meanz(i) > 1.0e-14 ) then From 7cb717f46c9d8aeeda282edf458f183822c2057c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 14:48:11 -0400 Subject: [PATCH 0786/1072] Recast find_N2 to work in units of Z Recast the internal calculations in find_N2 to use units of Z. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_set_diffusivity.F90 | 27 ++++++++++--------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 2223fa1bc9..07348a895b 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -897,20 +897,21 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & Temp_int, & ! temperature at each interface (degC) Salin_int, & ! salinity at each interface (PPT) drho_bot, & - h_amp, & - hb, & - z_from_bot + h_amp, & ! The topographic roughness amplitude, in Z. + hb, & ! The thickness of the bottom layer in Z + z_from_bot ! The hieght above the bottom in Z real :: Rml_base ! density of the deepest variable density layer - real :: dz_int ! thickness associated with an interface (meter) - real :: G_Rho0 ! gravitation acceleration divided by Bouss reference density (m4 s-2 kg-1) + real :: dz_int ! thickness associated with an interface (Z) + real :: G_Rho0 ! gravitation acceleration divided by Bouss reference density + ! times some unit conversion factors, in (Z m3 s-2 kg-1) real :: H_neglect ! negligibly small thickness, in the same units as h. logical :: do_i(SZI_(G)), do_any integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke - G_Rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 + G_Rho0 = (GV%g_Earth*GV%m_to_Z**2) / GV%Rho0 H_neglect = GV%H_subroundoff ! Find the (limited) density jump across each interface. @@ -948,18 +949,18 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & ! Set the buoyancy frequencies. do k=1,nz ; do i=is,ie N2_lay(i,k) = G_Rho0 * 0.5*(dRho_int(i,K) + dRho_int(i,K+1)) / & - (GV%H_to_m*(h(i,j,k) + H_neglect)) + (GV%H_to_Z*(h(i,j,k) + H_neglect)) enddo ; enddo do i=is,ie ; N2_int(i,1) = 0.0 ; N2_int(i,nz+1) = 0.0 ; enddo do K=2,nz ; do i=is,ie N2_int(i,K) = G_Rho0 * dRho_int(i,K) / & - (0.5*GV%H_to_m*(h(i,j,k-1) + h(i,j,k) + H_neglect)) + (0.5*GV%H_to_Z*(h(i,j,k-1) + h(i,j,k) + H_neglect)) enddo ; enddo ! Find the bottom boundary layer stratification, and use this in the deepest layers. do i=is,ie hb(i) = 0.0 ; dRho_bot(i) = 0.0 - z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz) + z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz) do_i(i) = (G%mask2dT(i,j) > 0.5) if ( (CS%tm_csp%Int_tide_dissipation .or. CS%tm_csp%Lee_wave_dissipation) .and. & @@ -973,7 +974,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & do k=nz,2,-1 do_any = .false. do i=is,ie ; if (do_i(i)) then - dz_int = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j,k-1)) + dz_int = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j,k-1)) z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above hb(i) = hb(i) + dz_int @@ -982,7 +983,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & if (z_from_bot(i) > h_amp(i)) then if (k>2) then ! Always include at least one full layer. - hb(i) = hb(i) + 0.5*GV%H_to_m*(h(i,j,k-1) + h(i,j,k-2)) + hb(i) = hb(i) + 0.5*GV%H_to_Z*(h(i,j,k-1) + h(i,j,k-2)) dRho_bot(i) = dRho_bot(i) + dRho_int(i,K-1) endif do_i(i) = .false. @@ -997,14 +998,14 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & if (hb(i) > 0.0) then N2_bot(i) = (G_Rho0 * dRho_bot(i)) / hb(i) else ; N2_bot(i) = 0.0 ; endif - z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz) + z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz) do_i(i) = (G%mask2dT(i,j) > 0.5) enddo do k=nz,2,-1 do_any = .false. do i=is,ie ; if (do_i(i)) then - dz_int = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j,k-1)) + dz_int = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j,k-1)) z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above N2_int(i,K) = N2_bot(i) From 3666d609d4831987a675a08b277241a4f69f75d5 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 4 Oct 2018 13:49:04 -0600 Subject: [PATCH 0787/1072] read prandtl_bknd for all cases --- .../vertical/MOM_bkgnd_mixing.F90 | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 731af2953d..8e7256cfe2 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -122,7 +122,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) ! Local variables real :: Kv ! The interior vertical viscosity (m2/s) - read to set prandtl ! number unless it is provided as a parameter - real :: prandtl_bkgnd_default ! Default prandtl number computed according to CS%Kd and Kv + real :: prandtl_bkgnd_comp ! Kv/CS%Kd. Gets compared with user-specified prandtl_bkgnd. ! This include declares and sets the variable "version". #include "version_variable.h" @@ -242,19 +242,17 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) units="m2 s-1",default = 1.0e-4) endif - prandtl_bkgnd_default = 1.0 - CS%prandtl_bkgnd = prandtl_bkgnd_default + call get_param(param_file, mdl, "PRANDTL_BKGND", CS%prandtl_bkgnd, & + "Turbulent Prandtl number used to convert vertical \n"//& + "background diffusivities into viscosities.", & + units="nondim", default=1.0) if (CS%Bryan_Lewis_diffusivity .or. CS%horiz_varying_background) then - if (CS%Kd /= 0.0) prandtl_bkgnd_default = Kv/CS%Kd + prandtl_bkgnd_comp = CS%prandtl_bkgnd + if (CS%Kd /= 0.0) prandtl_bkgnd_comp = Kv/CS%Kd - call get_param(param_file, mdl, "PRANDTL_BKGND", CS%prandtl_bkgnd, & - "Turbulent Prandtl number used to convert vertical \n"//& - "background diffusivities into viscosities.", & - units="nondim", default=prandtl_bkgnd_default) - - if ( abs(Kv-CS%Kd*CS%prandtl_bkgnd)>1.e-14) then + if ( abs(CS%prandtl_bkgnd - prandtl_bkgnd_comp)>1.e-14) then call MOM_error(FATAL,"set_diffusivity_init: The provided KD, KV,"//& "and PRANDTL_BKGND values are incompatible. The following "//& "must hold: KD*PRANDTL_BKGND==KV") From 6f12f84f0d6d4efe407f4de017913455a604cb65 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 4 Oct 2018 17:47:11 -0600 Subject: [PATCH 0788/1072] Adds a missing parameter and fixes a bug Add option to use the wrong sign for adjusting net fresh-water. Fixes a bug in MOM_surface_forcing.F90 that occured when IOB was re-introduced. --- config_src/mct_driver/MOM_surface_forcing.F90 | 18 +++++++++++++----- config_src/mct_driver/ocn_cap_methods.F90 | 4 ++-- 2 files changed, 15 insertions(+), 7 deletions(-) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 5c4a43bfc0..6955c20aa1 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -250,6 +250,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & 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. call cpu_clock_begin(id_clock_forcing) @@ -461,15 +462,17 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & ! salt flux ! more salt restoring logic if (associated(fluxes%salt_flux)) & - fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(IOB%salt_flux(i-i0,j-j0) + fluxes%salt_flux(i,j)) + fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(i,j) - IOB%salt_flux(i-i0,j-j0)) if (associated(fluxes%salt_flux_in)) & - fluxes%salt_flux_in(i,j) = G%mask2dT(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 ! adjust the NET fresh-water flux to zero, if flagged if (CS%adjust_net_fresh_water_to_zero) then + sign_for_net_FW_bug = 1. + if (CS%use_net_FW_adjustment_sign_bug) sign_for_net_FW_bug = -1. do j=js,je ; do i=is,ie net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & @@ -480,9 +483,9 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & ! 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 - 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) + 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 @@ -1044,6 +1047,11 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res CS%adjust_net_fresh_water_to_zero, & "If true, adjusts the net fresh-water forcing seen \n"//& "by the ocean (including restoring) to zero.", default=.false.) + 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"//& + "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"//& diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 33dbc5b36a..f00942bd04 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -82,8 +82,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(ig,jg) - ! salt flux - ice_ocean_boundary%salt_flux(i,j) = x2o(ind%x2o_Fioi_salt,k) * GRID%mask2dT(ig,jg) + ! salt flux (minus sign needed here -GMM) + ice_ocean_boundary%salt_flux(i,j) = -x2o(ind%x2o_Fioi_salt,k) * GRID%mask2dT(ig,jg) ! 1) visible, direct shortwave (W/m2) ! 2) visible, diffuse shortwave (W/m2) From 94031154684d593306513e9ec492e945c717589f Mon Sep 17 00:00:00 2001 From: Malte Jansen Date: Thu, 4 Oct 2018 19:57:50 -0500 Subject: [PATCH 0789/1072] Bug fix to compute Rd_dx whenever MEKE is used The default config of MEKE uses Rd_dx to compute barotropic and bottom energy fractions. If Rd_dx not computed here, it will be set to zero in MEKE and as a result gamma_b=gamma_t=1. --- src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index ecc586d025..b9325733e5 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -804,6 +804,7 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) CS%calculate_cg1 = CS%calculate_cg1 .or. use_FGNV_streamfn call get_param(param_file, mdl, "USE_MEKE", use_MEKE, & default=.false., do_not_log=.true.) + CS%calculate_Rd_dx = CS%calculate_Rd_dx .or. use_MEKE CS%calculate_Eady_growth_rate = CS%calculate_Eady_growth_rate .or. use_MEKE call get_param(param_file, mdl, "KHTR_PASSIVITY_COEFF", KhTr_passivity_coeff, & default=0., do_not_log=.true.) From a4d84a2659677fd554578b723d0bfff2542ba9e2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 21:56:27 -0400 Subject: [PATCH 0790/1072] Added a conversion factor for Kd_interface Added a conversion factor for the diagnostic of Kd_interface, so that it does not change when Z is rescaled. All answers are bitwise identical. --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 61ba757a7e..76a64f932a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -3046,7 +3046,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, !call set_diffusivity_init(Time, G, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, CS%int_tide_CSp) CS%id_Kd_interface = register_diag_field('ocean_model', 'Kd_interface', diag%axesTi, Time, & - 'Total diapycnal diffusivity at interfaces', 'm2 s-1') + 'Total diapycnal diffusivity at interfaces', 'm2 s-1', conversion=GV%Z_to_m**2) if (CS%use_energetic_PBL) then CS%id_Kd_ePBL = register_diag_field('ocean_model', 'Kd_ePBL', diag%axesTi, Time, & 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1', conversion=GV%Z_to_m**2) From 469645bd744197b21f4381ca451dc1ad633cd221 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 21:57:17 -0400 Subject: [PATCH 0791/1072] +Added conversion argument to register_Zint_diag Added optional conversion argument to register_Zint_diag, which is then passed on to register_diag. All answers are bitwise identical. --- src/diagnostics/MOM_diag_to_Z.F90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index 0e966e7ff6..f8ea773f74 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -115,7 +115,7 @@ function global_z_mean(var,G,CS,tracer) weight(i,j,k) = depth_weight * ( (valid_point * (G%areaT(i,j) * G%mask2dT(i,j))) ) - ! If the point is flagged, set the variable itsef to zero to avoid NaNs + ! If the point is flagged, set the variable itself to zero to avoid NaNs if (valid_point == 0.) then tmpForSumming(i,j,k) = 0.0 else @@ -1291,12 +1291,13 @@ function register_Z_diag(var_desc, CS, day, missing) end function register_Z_diag !> Register a diagnostic to be output at depth space interfaces -function register_Zint_diag(var_desc, CS, day) +function register_Zint_diag(var_desc, CS, day, conversion) integer :: register_Zint_diag !< The returned z-interface diagnostic index type(vardesc), intent(in) :: var_desc !< A type with metadata for this diagnostic type(diag_to_Z_CS), pointer :: CS !< Control structure returned by !! previous call to diag_to_Z_init. type(time_type), intent(in) :: day !< The current model time + real, optional, intent(in) :: conversion !< A value to multiply data by before writing to file ! Local variables character(len=64) :: var_name ! A variable's name. character(len=48) :: units ! A variable's units. @@ -1327,8 +1328,9 @@ function register_Zint_diag(var_desc, CS, day) "register_Z_diag: unknown hor_grid component "//trim(hor_grid)) end select - register_Zint_diag = register_diag_field("ocean_model_zold", trim(var_name),& - axes, day, trim(longname), trim(units), missing_value=CS%missing_value) + register_Zint_diag = register_diag_field("ocean_model_zold", trim(var_name), & + axes, day, trim(longname), trim(units), missing_value=CS%missing_value, & + conversion=conversion) end function register_Zint_diag From df75031df84b473c5e404d6497c1c946d3070303 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 4 Oct 2018 21:58:14 -0400 Subject: [PATCH 0792/1072] Changed diffusvity units in MOM_set_diffusvities Changed the units of several diffusivities in MOM_set_diffusivities, including KT_extra, KS_extra, Kd_add, delta_Kd and Kd_wall from m2 s-1 to Z2 s-1, for dimensional consistency testing. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_CVMix_ddiff.F90 | 4 +- .../vertical/MOM_set_diffusivity.F90 | 140 +++++++++--------- 2 files changed, 74 insertions(+), 70 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index fc84367a87..eabce5056b 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -46,8 +46,8 @@ module MOM_CVMix_ddiff !!@} ! Diagnostics arrays - real, allocatable, dimension(:,:,:) :: KT_extra !< Double diffusion diffusivity for temp (m2/s) - real, allocatable, dimension(:,:,:) :: KS_extra !< Double diffusion diffusivity for salt (m2/s) +! real, allocatable, dimension(:,:,:) :: KT_extra !< Double diffusion diffusivity for temp (Z2/s) +! real, allocatable, dimension(:,:,:) :: KS_extra !< Double diffusion diffusivity for salt (Z2/s) real, allocatable, dimension(:,:,:) :: R_rho !< Double-diffusion density ratio (nondim) end type CVMix_ddiff_cs diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 07348a895b..80a4b9fe18 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -171,8 +171,8 @@ module MOM_set_diffusivity Kd_BBL => NULL(),& !< BBL diffusivity at interfaces (m2/s) Kd_work => NULL(),& !< layer integrated work by diapycnal mixing (W/m2) maxTKE => NULL(),& !< energy required to entrain to h_max (m3/s3) - KT_extra => NULL(),& !< double diffusion diffusivity for temp (m2/s) - KS_extra => NULL() !< double diffusion diffusivity for saln (m2/s) + KT_extra => NULL(),& !< double diffusion diffusivity for temp (Z2/s) + KS_extra => NULL() !< double diffusion diffusivity for saln (Z2/s) real, pointer, dimension(:,:,:) :: TKE_to_Kd => NULL() !< conversion rate (~1.0 / (G_Earth + dRho_lay)) !! between TKE dissipated within a layer and Kd @@ -247,8 +247,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & real, dimension(SZI_(G),SZK_(G)+1) :: & N2_int, & !< squared buoyancy frequency associated at interfaces (1/s2) dRho_int, & !< locally ref potential density difference across interfaces (kg/m3) - KT_extra, & !< double difusion diffusivity of temperature (m2/sec) - KS_extra !< double difusion diffusivity of salinity (m2/sec) + KT_extra, & !< double difusion diffusivity of temperature (Z2/sec) + KS_extra !< double difusion diffusivity of salinity (Z2/sec) real :: I_Rho0 ! inverse of Boussinesq density (m3/kg) real :: dissip ! local variable for dissipation calculations (W/m3) @@ -407,14 +407,14 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, KT_extra, KS_extra) do K=2,nz ; do i=is,ie if (KS_extra(i,K) > KT_extra(i,K)) then ! salt fingering - Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5*GV%m_to_Z**2*KT_extra(i,K) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*KT_extra(i,K) - visc%Kd_extra_S(i,j,k) = GV%m_to_Z**2 * (KS_extra(i,K) - KT_extra(i,K)) + Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5*KT_extra(i,K) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*KT_extra(i,K) + visc%Kd_extra_S(i,j,k) = (KS_extra(i,K) - KT_extra(i,K)) visc%Kd_extra_T(i,j,k) = 0.0 elseif (KT_extra(i,K) > 0.0) then ! double-diffusive convection - Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5*GV%m_to_Z**2*KS_extra(i,K) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*KS_extra(i,K) - visc%Kd_extra_T(i,j,k) = GV%m_to_Z**2 * (KT_extra(i,K) - KS_extra(i,K)) + Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5**KS_extra(i,K) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5**KS_extra(i,K) + visc%Kd_extra_T(i,j,k) = (KT_extra(i,K) - KS_extra(i,K)) visc%Kd_extra_S(i,j,k) = 0.0 else ! There is no double diffusion at this interface. visc%Kd_extra_T(i,j,k) = 0.0 @@ -558,13 +558,13 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (present(Kd_int)) then !$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_int,CS,Kd) do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,K) = Kd_int(i,j,K) + GV%m_to_Z**2*CS%Kd_add - Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*CS%Kd_add + Kd_int(i,j,K) = Kd_int(i,j,K) + CS%Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + CS%Kd_add enddo ; enddo ; enddo else !$OMP parallel do default(none) shared(is,ie,js,je,nz,CS,Kd) do k=1,nz ; do j=js,je ; do i=is,ie - Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*CS%Kd_add + Kd_lay(i,j,k) = Kd_lay(i,j,k) + CS%Kd_add enddo ; enddo ; enddo endif endif @@ -624,21 +624,21 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%id_Kd_BBL > 0) call post_data(CS%id_Kd_BBL, dd%Kd_BBL, CS%diag) if (CS%id_KT_extra_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_KT_extra_z - z_ptrs(num_z_diags)%p => dd%KT_extra + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_KT_extra_z + z_ptrs(num_z_diags)%p => dd%KT_extra endif if (CS%id_KS_extra_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_KS_extra_z - z_ptrs(num_z_diags)%p => dd%KS_extra + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_KS_extra_z + z_ptrs(num_z_diags)%p => dd%KS_extra endif if (CS%id_Kd_BBL_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_Kd_BBL_z - z_ptrs(num_z_diags)%p => dd%KS_extra + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_Kd_BBL_z + z_ptrs(num_z_diags)%p => dd%Kd_BBL endif if (num_z_diags > 0) & @@ -1053,10 +1053,10 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, Kd_T_dd, Kd_S_dd) type(set_diffusivity_CS), pointer :: CS !< Module control structure. real, dimension(SZI_(G),SZK_(G)+1), & intent(out) :: Kd_T_dd !< Interface double diffusion diapycnal - !! diffusivity for temp (m2/sec). + !! diffusivity for temp (Z2/sec). real, dimension(SZI_(G),SZK_(G)+1), & intent(out) :: Kd_S_dd !< Interface double diffusion diapycnal - !! diffusivity for saln (m2/sec). + !! diffusivity for saln (Z2/sec). real, dimension(SZI_(G)) :: & dRho_dT, & ! partial derivatives of density wrt temp (kg m-3 degC-1) @@ -1068,18 +1068,22 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, Kd_T_dd, Kd_S_dd) real :: alpha_dT ! density difference between layers due to temp diffs (kg/m3) real :: beta_dS ! density difference between layers due to saln diffs (kg/m3) - real :: Rrho ! vertical density ratio - real :: diff_dd ! factor for double-diffusion - real :: prandtl ! flux ratio for diffusive convection regime + real :: Rrho ! vertical density ratio + real :: diff_dd ! factor for double-diffusion (nondim) + real :: Kd_dd ! The dominant double diffusive diffusivity in Z2/sec + real :: prandtl ! flux ratio for diffusive convection regime - real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio - real, parameter :: dsfmax = 1.e-4 ! max diffusivity in case of salt fingering - real, parameter :: Kv_molecular = 1.5e-6 ! molecular viscosity (m2/sec) + real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio + real :: dsfmax ! max diffusivity in case of salt fingering (Z2/sec) + real :: Kv_molecular ! molecular viscosity (Z2/sec) integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke if (associated(tv%eqn_of_state)) then + dsfmax = GV%m_to_Z**2 * 1.e-4 ! max salt fingering diffusivity rescaled to (Z2/sec) + Kv_molecular = GV%m_to_Z**2 * 1.5e-6 ! molecular viscosity rescaled to (Z2/sec) + do i=is,ie pres(i) = 0.0 ; Kd_T_dd(i,1) = 0.0 ; Kd_S_dd(i,1) = 0.0 Kd_T_dd(i,nz+1) = 0.0 ; Kd_S_dd(i,nz+1) = 0.0 @@ -1098,18 +1102,18 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, Kd_T_dd, Kd_S_dd) beta_dS = dRho_dS(i) * (S_f(i,j,k-1) - S_f(i,j,k)) if ((alpha_dT > beta_dS) .and. (beta_dS > 0.0)) then ! salt finger case - Rrho = min(alpha_dT/beta_dS,Rrho0) + Rrho = min(alpha_dT / beta_dS, Rrho0) diff_dd = 1.0 - ((RRho-1.0)/(RRho0-1.0)) - diff_dd = dsfmax*diff_dd*diff_dd*diff_dd - Kd_T_dd(i,K) = 0.7*diff_dd - Kd_S_dd(i,K) = diff_dd + Kd_dd = dsfmax * diff_dd*diff_dd*diff_dd + Kd_T_dd(i,K) = 0.7*Kd_dd + Kd_S_dd(i,K) = Kd_dd elseif ((alpha_dT < 0.) .and. (beta_dS < 0.) .and. (alpha_dT > beta_dS)) then ! diffusive convection - Rrho = alpha_dT/beta_dS - diff_dd = Kv_molecular*0.909*exp(4.6*exp(-0.54*(1/Rrho-1))) + Rrho = alpha_dT / beta_dS + Kd_dd = Kv_molecular * 0.909*exp(4.6*exp(-0.54*(1/Rrho-1))) prandtl = 0.15*Rrho if (Rrho > 0.5) prandtl = (1.85-0.85/Rrho)*Rrho - Kd_T_dd(i,K) = diff_dd - Kd_S_dd(i,K) = prandtl*diff_dd + Kd_T_dd(i,K) = Kd_dd + Kd_S_dd(i,K) = prandtl*Kd_dd else Kd_T_dd(i,K) = 0.0 ; Kd_S_dd(i,K) = 0.0 endif @@ -1176,7 +1180,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & real :: absf ! average absolute Coriolis parameter around a thickness point (1/s) real :: R0_g ! Rho0 / G_Earth (kg s2 m-2) real :: I_rho0 ! 1 / RHO0 - real :: delta_Kd ! increment to Kd from the bottom boundary layer mixing (m2/s) + real :: delta_Kd ! increment to Kd from the bottom boundary layer mixing (Z2/s) logical :: Rayleigh_drag ! Set to true if Rayleigh drag velocities ! defined in visc, on the assumption that this ! extracted energy also drives diapycnal mixing. @@ -1294,18 +1298,18 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & TKE(i) = TKE(i) - TKE_to_layer if (Kd_lay(i,j,k) < (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k)) then - delta_Kd = (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) - GV%Z_to_m**2*Kd_lay(i,j,k) - if ((CS%Kd_max >= 0.0) .and. (delta_Kd > CS%Kd_max)) then - delta_Kd = CS%Kd_Max - Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*delta_Kd + delta_Kd = (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k) - Kd_lay(i,j,k) + if ((CS%Kd_max >= 0.0) .and. (delta_Kd > GV%m_to_Z**2*CS%Kd_max)) then + delta_Kd = GV%m_to_Z**2*CS%Kd_Max + Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd else Kd_lay(i,j,k) = (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k) endif - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*GV%m_to_Z**2*delta_Kd - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*GV%m_to_Z**2*delta_Kd + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd if (do_diag_Kd_BBL) then - Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*delta_Kd - Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5*delta_Kd + Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*GV%Z_to_m**2*delta_Kd + Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5*GV%Z_to_m**2*delta_Kd endif endif else @@ -1324,14 +1328,14 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & if (TKE(i) < 0.0) TKE(i) = 0.0 ! This should be unnecessary? if (TKE_here > 0.0) then - delta_Kd = TKE_here*TKE_to_Kd(i,k) - if (CS%Kd_max >= 0.0) delta_Kd = min(delta_Kd, CS%Kd_max) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*delta_Kd - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*GV%m_to_Z**2*delta_Kd - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*GV%m_to_Z**2*delta_Kd + delta_Kd = TKE_here * GV%m_to_Z**2*TKE_to_Kd(i,k) + if (CS%Kd_max >= 0.0) delta_Kd = min(delta_Kd, GV%m_to_Z**2*CS%Kd_max) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd if (do_diag_Kd_BBL) then - Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*delta_Kd - Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5*delta_Kd + Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*GV%Z_to_m**2*delta_Kd + Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5*GV%Z_to_m**2*delta_Kd endif endif endif @@ -1388,15 +1392,15 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & real :: TKE_Kd_wall ! TKE associated with unlimited law of the wall mixing (m3 s-3) real :: cdrag_sqrt ! square root of the drag coefficient (nondimensional) real :: ustar ! value of ustar at a thickness point (m/s) - real :: ustar2 ! square of ustar, for convenience (m2/s2) + real :: ustar2 ! square of ustar, for convenience (Z2/s2) real :: absf ! average absolute value of Coriolis parameter around a thickness point (1/sec) real :: dh, dhm1 ! thickness of layers k and k-1, respecitvely (meter) real :: z ! distance to interface k from bottom (meter) real :: D_minus_z ! distance to interface k from surface (meter) real :: total_thickness ! total thickness of water column (meter) real :: Idecay ! inverse of decay scale used for "Joule heating" loss of TKE with height (1/m) - real :: Kd_wall ! Law of the wall diffusivity (m2/s) - real :: Kd_lower ! diffusivity for lower interface (m2/sec) + real :: Kd_wall ! Law of the wall diffusivity (Z2/s) + real :: Kd_lower ! diffusivity for lower interface (Z2/sec) real :: ustar_D ! u* x D (m2/s) real :: I_Rho0 ! 1 / rho0 real :: N2_min ! Minimum value of N2 to use in calculation of TKE_Kd_wall (1/s2) @@ -1427,7 +1431,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! u* at the bottom, in m s-1. ustar = visc%ustar_BBL(i,j) - ustar2 = ustar**2 + ustar2 = GV%m_to_Z**2*ustar**2 ! In add_drag_diffusivity(), fluxes%ustar_tidal is added in. This might be double counting ! since ustar_BBL should already include all contributions to u*? -AJA if (associated(fluxes%ustar_tidal)) ustar = ustar + fluxes%ustar_tidal(i,j) @@ -1484,7 +1488,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! TKE associated with Kd_wall, in m3 s-2. ! This calculation if for the volume spanning the interface. - TKE_Kd_wall = Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) + TKE_Kd_wall = GV%Z_to_m**2*Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) ! Now bound Kd such that the associated TKE is no greater than available TKE for mixing. if (TKE_Kd_wall>0.) then @@ -1493,7 +1497,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & else ! Either N2=0 or dh = 0. if (TKE_remaining>0.) then - Kd_wall = CS%Kd_max + Kd_wall = GV%m_to_Z**2*CS%Kd_max else Kd_wall = 0. endif @@ -1504,10 +1508,10 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & TKE_remaining = TKE_remaining - TKE_consumed ! Note this will be non-negative ! Add this BBL diffusivity to the model net diffusivity. - Kd_int(i,j,K) = Kd_int(i,j,K) + GV%m_to_Z**2*Kd_wall - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_wall + Kd_lower) + Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_wall + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*(Kd_wall + Kd_lower) Kd_lower = Kd_wall ! Store for next level up. - if (do_diag_Kd_BBL) Kd_BBL(i,j,k) = Kd_wall + if (do_diag_Kd_BBL) Kd_BBL(i,j,k) = GV%Z_to_m**2*Kd_wall enddo ! k enddo ! i @@ -2086,7 +2090,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp call get_param(param_file, mdl, "KD_ADD", CS%Kd_add, & "A uniform diapycnal diffusivity that is added \n"//& "everywhere without any filtering or scaling.", & - units="m2 s-1", default=0.0) + units="m2 s-1", default=0.0, scale=GV%m_to_Z**2) if (CS%use_LOTW_BBL_diffusivity .and. CS%Kd_max<=0.) call MOM_error(FATAL, & "set_diffusivity_init: KD_MAX must be set (positive) when "// & "USE_LOTW_BBL_DIFFUSIVITY=True.") @@ -2190,20 +2194,20 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp ! The default molecular viscosity follows the CCSM4.0 and MOM4p1 defaults. CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for temperature', 'm2 s-1') + 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for salinity', 'm2 s-1') + 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=GV%Z_to_m**2) if (associated(diag_to_Z_CSp)) then vd = var_desc("KT_extra", "m2 s-1", & "Double-Diffusive Temperature Diffusivity, interpolated to z", & z_grid='z') - CS%id_KT_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + CS%id_KT_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) vd = var_desc("KS_extra", "m2 s-1", & "Double-Diffusive Salinity Diffusivity, interpolated to z",& z_grid='z') - CS%id_KS_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + CS%id_KS_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) vd = var_desc("Kd_BBL", "m2 s-1", & "Bottom Boundary Layer Diffusivity", z_grid='z') CS%id_Kd_BBL_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) From 8bfefc9a175fb6d2681df97748e1a960fa2beff7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 5 Oct 2018 05:50:41 -0400 Subject: [PATCH 0793/1072] Changed the units of Kd_BBL to Z-2 s-1 Rescaled the units of Kd_BBL from m2 s-1 to Z2 s-1 for dimensional consistency testing. Also changed the units of several diffusivity parameters in MOM_set_diffusivity, including CV%Kd, CS%Kv, and CS%Kd_max, via calls to get_param. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_set_diffusivity.F90 | 104 +++++++++--------- .../vertical/MOM_tidal_mixing.F90 | 22 ++-- 2 files changed, 63 insertions(+), 63 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 80a4b9fe18..1894e2ae25 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -51,8 +51,7 @@ module MOM_set_diffusivity logical :: debug !< If true, write verbose checksums for debugging. logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with - !! GV%nk_rho_varies variable density mixed & buffer - !! layers. + !! GV%nk_rho_varies variable density mixed & buffer layers. real :: FluxRi_max !< The flux Richardson number where the stratification is !! large enough that N2 > omega2. The full expression for !! the Flux Richardson number is usually @@ -70,14 +69,14 @@ module MOM_set_diffusivity real :: cdrag !< quadratic drag coefficient (nondim) real :: IMax_decay !< inverse of a maximum decay scale for !! bottom-drag driven turbulence, (1/m) - real :: Kv !< The interior vertical viscosity (m2/s) - real :: Kd !< interior diapycnal diffusivity (m2/s) - real :: Kd_min !< minimum diapycnal diffusivity (m2/s) - real :: Kd_max !< maximum increment for diapycnal diffusivity (m2/s) + real :: Kv !< The interior vertical viscosity (Z2/s) + real :: Kd !< interior diapycnal diffusivity (Z2/s) + real :: Kd_min !< minimum diapycnal diffusivity (Z2/s) + real :: Kd_max !< maximum increment for diapycnal diffusivity (Z2/s) !! Set to a negative value to have no limit. real :: Kd_add !< uniform diffusivity added everywhere without - !! filtering or scaling (m2/s) - real :: Kdml !< mixed layer diapycnal diffusivity (m2/s) + !! filtering or scaling (Z2/s) + real :: Kdml !< mixed layer diapycnal diffusivity (Z2/s) !! when bulkmixedlayer==.false. real :: Hmix !< mixed layer thickness (meter) when !! bulkmixedlayer==.false. @@ -108,7 +107,7 @@ module MOM_set_diffusivity !! where N2 is the squared buoyancy frequency (s-2) and OMEGA2 !! is the rotation rate of the earth squared. real :: ML_rad_kd_max !< Maximum diapycnal diffusivity due to turbulence - !! radiated from the base of the mixed layer (m2/s) + !! radiated from the base of the mixed layer (Z2/s) real :: ML_rad_efold_coeff !< non-dim coefficient to scale penetration depth real :: ML_rad_coeff !< coefficient, which scales MSTAR*USTAR^3 to !! obtain energy available for mixing below @@ -290,9 +289,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! Set Kd_lay, Kd_int and Kv_slow to constant values. ! If nothing else is specified, this will be the value used. - Kd_lay(:,:,:) = GV%m_to_Z**2*CS%Kd - Kd_int(:,:,:) = GV%m_to_Z**2*CS%Kd - if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = GV%m_to_Z**2 * CS%Kv + Kd_lay(:,:,:) = CS%Kd + Kd_int(:,:,:) = CS%Kd + if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = CS%Kv ! Set up arrays for diagnostics. @@ -734,7 +733,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & else; TKE_to_Kd(i,k) = 0.; endif ! The maximum TKE conversion we allow is really a statement ! about the upper diffusivity we allow. Kd_max must be set. - maxTKE(i,k) = hN2pO2 * CS%Kd_max ! Units of m3 s-3. + maxTKE(i,k) = hN2pO2 * GV%Z_to_m**2*CS%Kd_max ! Units of m3 s-3. enddo ; enddo kb(is:ie) = -1 ! kb should not be used by any code in non-layered mode -AJA return @@ -1299,8 +1298,8 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & if (Kd_lay(i,j,k) < (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k)) then delta_Kd = (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k) - Kd_lay(i,j,k) - if ((CS%Kd_max >= 0.0) .and. (delta_Kd > GV%m_to_Z**2*CS%Kd_max)) then - delta_Kd = GV%m_to_Z**2*CS%Kd_Max + if ((CS%Kd_max >= 0.0) .and. (delta_Kd > CS%Kd_max)) then + delta_Kd = CS%Kd_max Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd else Kd_lay(i,j,k) = (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k) @@ -1308,8 +1307,8 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd if (do_diag_Kd_BBL) then - Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*GV%Z_to_m**2*delta_Kd - Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5*GV%Z_to_m**2*delta_Kd + Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*delta_Kd + Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5*delta_Kd endif endif else @@ -1329,13 +1328,13 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & if (TKE_here > 0.0) then delta_Kd = TKE_here * GV%m_to_Z**2*TKE_to_Kd(i,k) - if (CS%Kd_max >= 0.0) delta_Kd = min(delta_Kd, GV%m_to_Z**2*CS%Kd_max) + if (CS%Kd_max >= 0.0) delta_Kd = min(delta_Kd, CS%Kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd if (do_diag_Kd_BBL) then - Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*GV%Z_to_m**2*delta_Kd - Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5*GV%Z_to_m**2*delta_Kd + Kd_BBL(i,j,K) = Kd_BBL(i,j,K) + 0.5*delta_Kd + Kd_BBL(i,j,K+1) = Kd_BBL(i,j,K+1) + 0.5*delta_Kd endif endif endif @@ -1491,13 +1490,13 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & TKE_Kd_wall = GV%Z_to_m**2*Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) ! Now bound Kd such that the associated TKE is no greater than available TKE for mixing. - if (TKE_Kd_wall>0.) then + if (TKE_Kd_wall > 0.) then TKE_consumed = min(TKE_Kd_wall, TKE_remaining) Kd_wall = (TKE_consumed/TKE_Kd_wall) * Kd_wall ! Scale Kd so that only TKE_consumed is used. else ! Either N2=0 or dh = 0. - if (TKE_remaining>0.) then - Kd_wall = GV%m_to_Z**2*CS%Kd_max + if (TKE_remaining > 0.) then + Kd_wall = CS%Kd_max else Kd_wall = 0. endif @@ -1511,7 +1510,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_wall Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*(Kd_wall + Kd_lower) Kd_lower = Kd_wall ! Store for next level up. - if (do_diag_Kd_BBL) Kd_BBL(i,j,k) = GV%Z_to_m**2*Kd_wall + if (do_diag_Kd_BBL) Kd_BBL(i,j,K) = Kd_wall enddo ! k enddo ! i @@ -1538,13 +1537,14 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ ! This routine adds effects of mixed layer radiation to the layer diffusivities. - real, dimension(SZI_(G)) :: & - h_ml, & - TKE_ml_flux, & - I_decay, & - Kd_mlr_ml + real, dimension(SZI_(G)) :: h_ml + real, dimension(SZI_(G)) :: TKE_ml_flux + real, dimension(SZI_(G)) :: I_decay + real, dimension(SZI_(G)) :: Kd_mlr_ml ! Diffusivities associated with mixed layer radiation, in Z2 s-1. - real :: f_sq, h_ml_sq, ustar_sq, Kd_mlr, C1_6 + real :: f_sq, h_ml_sq, ustar_sq + real :: Kd_mlr ! A diffusivity associated with mixed layer turbulence radiation, in Z2 s-1. + real :: C1_6 ! 1/6 real :: Omega2 ! rotation rate squared (1/s2) real :: z1 ! layer thickness times I_decay (nondim) real :: dzL ! thickness converted to meter @@ -1592,25 +1592,25 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ ! a more accurate Taylor series approximations for very thin layers. z1 = (GV%H_to_m*h(i,j,kml+1)) * I_decay(i) if (z1 > 1e-5) then - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,kml+1)) * & + Kd_mlr = (TKE_ml_flux(i) * GV%m_to_Z**2*TKE_to_Kd(i,kml+1)) * & (1.0 - exp(-z1)) else - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,kml+1)) * & + Kd_mlr = (TKE_ml_flux(i) * GV%m_to_Z**2*TKE_to_Kd(i,kml+1)) * & (z1 * (1.0 - z1 * (0.5 - C1_6*z1))) endif - Kd_mlr_ml(i) = min(Kd_mlr,CS%ML_rad_kd_max) + Kd_mlr_ml(i) = min(Kd_mlr, CS%ML_rad_kd_max) TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-z1) endif ; enddo do k=1,kml+1 ; do i=is,ie ; if (do_i(i)) then - Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_mlr_ml(i) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_mlr_ml(i) endif ; enddo ; enddo if (present(Kd_int)) then do K=2,kml+1 ; do i=is,ie ; if (do_i(i)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + GV%m_to_Z**2*Kd_mlr_ml(i) + Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_mlr_ml(i) endif ; enddo ; enddo if (kml<=nz-1) then ; do i=is,ie ; if (do_i(i)) then - Kd_int(i,j,Kml+2) = Kd_int(i,j,Kml+2) + 0.5*GV%m_to_Z**2*Kd_mlr_ml(i) + Kd_int(i,j,Kml+2) = Kd_int(i,j,Kml+2) + 0.5*Kd_mlr_ml(i) endif ; enddo ; endif endif @@ -1619,21 +1619,21 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ do i=is,ie ; if (do_i(i)) then dzL = GV%H_to_m*h(i,j,k) ; z1 = dzL*I_decay(i) if (z1 > 1e-5) then - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & + Kd_mlr = (TKE_ml_flux(i) * GV%m_to_Z**2*TKE_to_Kd(i,k)) * & ((1.0 - exp(-z1)) / dzL) else - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & + Kd_mlr = (TKE_ml_flux(i) * GV%m_to_Z**2*TKE_to_Kd(i,k)) * & (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) endif - Kd_mlr = min(Kd_mlr,CS%ML_rad_kd_max) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_mlr + Kd_mlr = min(Kd_mlr, CS%ML_rad_kd_max) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_mlr if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*GV%m_to_Z**2*Kd_mlr - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*GV%m_to_Z**2*Kd_mlr + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_mlr + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_mlr endif TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-z1) - if (TKE_ml_flux(i) * I_decay(i) < 0.1*CS%Kd_min*Omega2) then + if (TKE_ml_flux(i) * I_decay(i) < 0.1*CS%Kd_min*GV%Z_to_m**2*Omega2) then do_i(i) = .false. else ; do_any = .true. ; endif endif ; enddo @@ -1982,8 +1982,8 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp call get_param(param_file, mdl, "ML_RAD_KD_MAX", CS%ML_rad_kd_max, & "The maximum diapycnal diffusivity due to turbulence \n"//& "radiated from the base of the mixed layer. \n"//& - "This is only used if ML_RADIATION is true.", units="m2 s-1", & - default=1.0e-3) + "This is only used if ML_RADIATION is true.", & + units="m2 s-1", default=1.0e-3, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "ML_RAD_COEFF", CS%ML_rad_coeff, & "The coefficient which scales MSTAR*USTAR^3 to obtain \n"//& "the energy available for mixing below the base of the \n"//& @@ -2058,7 +2058,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp CS%use_LOTW_BBL_diffusivity = .false. ! This parameterization depends on a u* from viscous BBL endif CS%id_Kd_BBL = register_diag_field('ocean_model','Kd_BBL',diag%axesTi,Time, & - 'Bottom Boundary Layer Diffusivity', 'm2 s-1') + 'Bottom Boundary Layer Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2) call get_param(param_file, mdl, "SIMPLE_TKE_TO_KD", CS%simple_TKE_to_Kd, & "If true, uses a simple estimate of Kd/TKE that will\n"//& "work for arbitrary vertical coordinates. If false,\n"//& @@ -2072,19 +2072,19 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp call get_param(param_file, mdl, "KV", CS%Kv, & "The background kinematic viscosity in the interior. \n"//& "The molecular value, ~1e-6 m2 s-1, may be used.", & - units="m2 s-1", fail_if_missing=.true.) + units="m2 s-1", scale=GV%m_to_Z**2, fail_if_missing=.true.) call get_param(param_file, mdl, "KD", CS%Kd, & "The background diapycnal diffusivity of density in the \n"//& "interior. Zero or the molecular value, ~1e-7 m2 s-1, \n"//& - "may be used.", units="m2 s-1", fail_if_missing=.true.) + "may be used.", units="m2 s-1", scale=GV%m_to_Z**2, fail_if_missing=.true.) call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, & "The minimum diapycnal diffusivity.", & - units="m2 s-1", default=0.01*CS%Kd) + units="m2 s-1", default=0.01*CS%Kd*GV%Z_to_m**2, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "KD_MAX", CS%Kd_max, & "The maximum permitted increment for the diapycnal \n"//& "diffusivity from TKE-based parameterizations, or a \n"//& - "negative value for no limit.", units="m2 s-1", default=-1.0) + "negative value for no limit.", units="m2 s-1", default=-1.0, scale=GV%m_to_Z**2) if (CS%simple_TKE_to_Kd .and. CS%Kd_max<=0.) call MOM_error(FATAL, & "set_diffusivity_init: To use SIMPLE_TKE_TO_KD, KD_MAX must be set to >0.") call get_param(param_file, mdl, "KD_ADD", CS%Kd_add, & @@ -2108,7 +2108,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp "If BULKMIXEDLAYER is false, KDML is the elevated \n"//& "diapycnal diffusivity in the topmost HMIX of fluid. \n"//& "KDML is only used if BULKMIXEDLAYER is false.", & - units="m2 s-1", default=CS%Kd) + units="m2 s-1", default=CS%Kd*GV%Z_to_m**2, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface \n"//& "viscosity and diffusivity are elevated when the bulk \n"//& @@ -2210,7 +2210,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp CS%id_KS_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) vd = var_desc("Kd_BBL", "m2 s-1", & "Bottom Boundary Layer Diffusivity", z_grid='z') - CS%id_Kd_BBL_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + CS%id_Kd_BBL_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) endif endif ! old double-diffusion diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 04ca9dc922..b75557af9e 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -671,7 +671,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1. real, intent(in) :: Kd_max !< The maximum increment for diapycnal - !! diffusivity due to TKE-based processes, in m2 s-1. + !! diffusivity due to TKE-based processes, in Z2 s-1. !! Set this to a negative value to have no limit. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface !! (not layer!) in Z2 s-1. @@ -684,7 +684,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & N2_lay, Kd_lay, Kd_int, Kd_max) endif endif -end subroutine +end subroutine calculate_tidal_mixing !> Calls the CVMix routines to compute tidal dissipation and to add the effect of internal-tide-driven @@ -939,7 +939,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1. real, intent(in) :: Kd_max !< The maximum increment for diapycnal - !! diffusivity due to TKE-based processes, in m2 s-1. + !! diffusivity due to TKE-based processes, in Z2 s-1. !! Set this to a negative value to have no limit. ! local @@ -1180,7 +1180,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, ! Convert power to diffusivity Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) - if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_add if (present(Kd_int)) then @@ -1193,7 +1193,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, ! If at layers, dd%Kd_itidal is just TKE_to_Kd(i,k) * TKE_itide_lay ! The following sets the interface diagnostics. Kd_add = TKE_to_Kd(i,k) * TKE_itide_lay - if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_add if (present(Kd_int)) then @@ -1280,7 +1280,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, ! If at layers, this is just dd%Kd_itidal(i,j,K) = TKE_to_Kd(i,k) * TKE_itide_lay ! The following sets the interface diagnostics. Kd_add = TKE_to_Kd(i,k) * TKE_itide_lay - if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add if (k Date: Fri, 5 Oct 2018 08:27:49 -0400 Subject: [PATCH 0794/1072] +Changed the units of TKE_to_Kd to Z2 s2 m-3 Rescaled the units of TKE_to_Kd from s2 m-1 to Z2 s2 m-3 for dimensional consistency testing. Also changed the internal units of Kd_add and three diagnostic diffusivities from m2 s-1 to Z2 s-1 in MOM_tidal_mixing. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_set_diffusivity.F90 | 50 +++++----- .../vertical/MOM_tidal_mixing.F90 | 93 +++++++++---------- 2 files changed, 71 insertions(+), 72 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 1894e2ae25..237b0aeb12 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -175,7 +175,7 @@ module MOM_set_diffusivity real, pointer, dimension(:,:,:) :: TKE_to_Kd => NULL() !< conversion rate (~1.0 / (G_Earth + dRho_lay)) !! between TKE dissipated within a layer and Kd - !! in that layer, in m2 s-1 / m3 s-3 = s2 m-1 + !! in that layer, in Z2 s-1 / m3 s-3 = Z2 s2 m-3 end type diffusivity_diags @@ -676,7 +676,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in m2 s-1 / m3 s-3 = s2 m-1 + !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 real, dimension(SZI_(G),SZK_(G)), intent(out) :: maxTKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness, in m3 s-3 integer, dimension(SZI_(G)), intent(out) :: kb !< Index of lightest layer denser than the buffer @@ -712,7 +712,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & real :: I_Rho0 ! inverse of Boussinesq reference density (m3/kg) real :: I_dt ! 1/dt (1/sec) real :: H_neglect ! negligibly small thickness (units as h) - real :: hN2pO2 ! h * (N^2 + Omega^2), in m s-2. + real :: hN2pO2 ! h * (N^2 + Omega^2), in m3 s-2 Z-2. logical :: do_i(SZI_(G)) integer :: i, k, is, ie, nz, i_rem, kmb, kb_min @@ -720,20 +720,20 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & I_dt = 1.0/dt Omega2 = CS%Omega**2 - G_Rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 + G_Rho0 = (GV%g_Earth*GV%m_to_Z**2) / GV%Rho0 H_neglect = GV%H_subroundoff I_Rho0 = 1.0/GV%Rho0 ! Simple but coordinate-independent estimate of Kd/TKE if (CS%simple_TKE_to_Kd) then do k=1,nz ; do i=is,ie - hN2pO2 = ( GV%H_to_m * h(i,j,k) ) * ( N2_lay(i,k) + Omega2 ) ! Units of m s-2. + hN2pO2 = GV%Z_to_m**2*( GV%H_to_m * h(i,j,k) ) * ( N2_lay(i,k) + Omega2 ) ! Units of m3 Z-2 s-2. if (hN2pO2>0.) then - TKE_to_Kd(i,k) = 1./ hN2pO2 ! Units of s2 m-1. + TKE_to_Kd(i,k) = 1.0 / hN2pO2 ! Units of Z2 s2 m-3. else; TKE_to_Kd(i,k) = 0.; endif ! The maximum TKE conversion we allow is really a statement ! about the upper diffusivity we allow. Kd_max must be set. - maxTKE(i,k) = hN2pO2 * GV%Z_to_m**2*CS%Kd_max ! Units of m3 s-3. + maxTKE(i,k) = hN2pO2 * CS%Kd_max ! Units of m3 s-3. enddo ; enddo kb(is:ie) = -1 ! kb should not be used by any code in non-layered mode -AJA return @@ -828,7 +828,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & enddo do k=2,kmb ; do i=is,ie maxTKE(i,k) = 0.0 - TKE_to_Kd(i,k) = 1.0 / ((N2_lay(i,k) + Omega2) * & + TKE_to_Kd(i,k) = GV%m_to_Z**2 / ((N2_lay(i,k) + Omega2) * & (GV%H_to_m*(h(i,j,k) + H_neglect))) enddo ; enddo do k=kmb+1,kb_min-1 ; do i=is,ie @@ -852,8 +852,8 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & maxTKE(i,k) = I_dt * (((GV%g_Earth*GV%m_to_Z) * I_Rho0) * & (0.5*max(dRho_int(i,K+1) + dsp1_ds(i,k)*dRho_int(i,K),0.0))) * & ((GV%H_to_m*h(i,j,k) + dh_max) * maxEnt(i,k)) - TKE_to_Kd(i,k) = 1.0 / (G_Rho0 * dRho_lay + & - CS%Omega**2 * GV%H_to_m*(h(i,j,k) + H_neglect)) + TKE_to_Kd(i,k) = GV%m_to_Z**3 / (G_Rho0 * dRho_lay + & + CS%Omega**2 * GV%H_to_Z*(h(i,j,k) + H_neglect)) endif enddo ; enddo @@ -1143,7 +1143,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in m2 s-1 / m3 s-3 = s2 m-1 + !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 real, dimension(SZI_(G),SZK_(G)), intent(in) :: maxTKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness, in m3 s-3 integer, dimension(SZI_(G)), intent(in) :: kb !< Index of lightest layer denser than the buffer @@ -1296,13 +1296,13 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & TKE(i) = TKE(i) - TKE_to_layer - if (Kd_lay(i,j,k) < (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k)) then - delta_Kd = (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k) - Kd_lay(i,j,k) + if (Kd_lay(i,j,k) < (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k)) then + delta_Kd = (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) - Kd_lay(i,j,k) if ((CS%Kd_max >= 0.0) .and. (delta_Kd > CS%Kd_max)) then delta_Kd = CS%Kd_max Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd else - Kd_lay(i,j,k) = (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k) + Kd_lay(i,j,k) = (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) endif Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*delta_Kd @@ -1312,12 +1312,12 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & endif endif else - if (Kd_lay(i,j,k) >= maxTKE(i,k)*GV%m_to_Z**2*TKE_to_Kd(i,k)) then + if (Kd_lay(i,j,k) >= maxTKE(i,k)*TKE_to_Kd(i,k)) then TKE_here = 0.0 TKE(i) = TKE(i) + TKE_Ray - elseif (Kd_lay(i,j,k) + (TKE_to_layer+TKE_Ray)*GV%m_to_Z**2*TKE_to_Kd(i,k) > & - maxTKE(i,k)*GV%m_to_Z**2*TKE_to_Kd(i,k)) then - TKE_here = ( (TKE_to_layer+TKE_Ray) + Kd_lay(i,j,k)/(GV%m_to_Z**2*TKE_to_Kd(i,k)) ) - & + elseif (Kd_lay(i,j,k) + (TKE_to_layer+TKE_Ray)*TKE_to_Kd(i,k) > & + maxTKE(i,k)*TKE_to_Kd(i,k)) then + TKE_here = ( (TKE_to_layer+TKE_Ray) + Kd_lay(i,j,k)/TKE_to_Kd(i,k) ) - & maxTKE(i,k) TKE(i) = TKE(i) - TKE_here + TKE_Ray else @@ -1327,7 +1327,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & if (TKE(i) < 0.0) TKE(i) = 0.0 ! This should be unnecessary? if (TKE_here > 0.0) then - delta_Kd = TKE_here * GV%m_to_Z**2*TKE_to_Kd(i,k) + delta_Kd = TKE_here * TKE_to_Kd(i,k) if (CS%Kd_max >= 0.0) delta_Kd = min(delta_Kd, CS%Kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + delta_Kd Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*delta_Kd @@ -1531,7 +1531,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in m2 s-1 / m3 s-3 = s2 m-1 + !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1. @@ -1592,10 +1592,10 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ ! a more accurate Taylor series approximations for very thin layers. z1 = (GV%H_to_m*h(i,j,kml+1)) * I_decay(i) if (z1 > 1e-5) then - Kd_mlr = (TKE_ml_flux(i) * GV%m_to_Z**2*TKE_to_Kd(i,kml+1)) * & + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,kml+1)) * & (1.0 - exp(-z1)) else - Kd_mlr = (TKE_ml_flux(i) * GV%m_to_Z**2*TKE_to_Kd(i,kml+1)) * & + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,kml+1)) * & (z1 * (1.0 - z1 * (0.5 - C1_6*z1))) endif Kd_mlr_ml(i) = min(Kd_mlr, CS%ML_rad_kd_max) @@ -1619,10 +1619,10 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ do i=is,ie ; if (do_i(i)) then dzL = GV%H_to_m*h(i,j,k) ; z1 = dzL*I_decay(i) if (z1 > 1e-5) then - Kd_mlr = (TKE_ml_flux(i) * GV%m_to_Z**2*TKE_to_Kd(i,k)) * & + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ((1.0 - exp(-z1)) / dzL) else - Kd_mlr = (TKE_ml_flux(i) * GV%m_to_Z**2*TKE_to_Kd(i,k)) * & + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) endif Kd_mlr = min(Kd_mlr, CS%ML_rad_kd_max) @@ -2157,7 +2157,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp CS%id_maxTKE = register_diag_field('ocean_model','maxTKE',diag%axesTL,Time, & 'Maximum layer TKE', 'm3 s-3') CS%id_TKE_to_Kd = register_diag_field('ocean_model','TKE_to_Kd',diag%axesTL,Time, & - 'Convert TKE to Kd', 's2 m') + 'Convert TKE to Kd', 's2 m', conversion=GV%Z_to_m**2) CS%id_N2 = register_diag_field('ocean_model','N2',diag%axesTi,Time, & 'Buoyancy frequency squared', 's-2', cmor_field_name='obvfsq', & cmor_long_name='Square of seawater buoyancy frequency',& diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index b75557af9e..fba82d7f5d 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -38,9 +38,9 @@ module MOM_tidal_mixing !> Containers for tidal mixing diagnostics type, public :: tidal_mixing_diags ; private real, pointer, dimension(:,:,:) :: & - Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces (m2 s-1) + Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces (Z2 s-1) Fl_itidal => NULL(),& !< vertical flux of tidal turbulent dissipation (m3 s-3) - Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces (m2 s-1) + Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces (Z2 s-1) Kd_Niku_work => NULL(),& !< layer integrated work by lee-wave driven mixing (W m-2) Kd_Itidal_Work => NULL(),& !< layer integrated work by int tide driven mixing (W m-2) Kd_Lowmode_Work => NULL(),& !< layer integrated work by low mode driven mixing (W m-2) @@ -50,7 +50,7 @@ module MOM_tidal_mixing real, pointer, dimension(:,:,:) :: tidal_qe_md => NULL() !< Input tidal energy dissipated locally, !! interpolated to model vertical coordinate (W m-3?) real, pointer, dimension(:,:,:) :: Kd_lowmode => NULL() !< internal tide diffusivity at interfaces - !! due to propagating low modes (m2/s) + !! due to propagating low modes (Z2/s) real, pointer, dimension(:,:,:) :: Fl_lowmode => NULL() !< vertical flux of tidal turbulent !! dissipation due to propagating low modes (m3/s3) real, pointer, dimension(:,:) :: & @@ -121,7 +121,7 @@ module MOM_tidal_mixing !! available to mix above the BBL real :: utide !< constant tidal amplitude (m s-1) used if - real :: kappa_itides !< topographic wavenumber and non-dimensional scaling + real :: kappa_itides !< topographic wavenumber and non-dimensional scaling, in Z-1 real :: kappa_h2_factor !< factor for the product of wavenumber * rms sgs height character(len=200) :: inputdir !< The directory in which to find input files @@ -411,7 +411,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, call get_param(param_file, mdl, "KAPPA_ITIDES", CS%kappa_itides, & "A topographic wavenumber used with INT_TIDE_DISSIPATION. \n"//& "The default is 2pi/10 km, as in St.Laurent et al. 2002.", & - units="m-1", default=8.e-4*atan(1.0)) + units="m-1", default=8.e-4*atan(1.0), scale=GV%Z_to_m) call get_param(param_file, mdl, "UTIDE", CS%utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & @@ -461,8 +461,8 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, utide = CS%tideamp(i,j) ! Compute the fixed part of internal tidal forcing; units are [kg s-2] here. - CS%TKE_itidal(i,j) = 0.5*CS%kappa_h2_factor*GV%Rho0*& - CS%kappa_itides*(GV%Z_to_m**2)*CS%h2(i,j)*utide*utide + CS%TKE_itidal(i,j) = 0.5*GV%Z_to_m * CS%kappa_h2_factor*GV%Rho0*& + CS%kappa_itides * CS%h2(i,j) * utide*utide enddo ; enddo endif @@ -559,7 +559,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, CS%Lowmode_itidal_dissipation) then CS%id_Kd_itidal = register_diag_field('ocean_model','Kd_itides',diag%axesTi,Time, & - 'Internal Tide Driven Diffusivity', 'm2 s-1') + 'Internal Tide Driven Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2) if (CS%use_CVMix_tidal) then CS%id_N2_int = register_diag_field('ocean_model','N2_int',diag%axesTi,Time, & @@ -581,7 +581,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, 'Bottom Buoyancy Frequency', 's-1') CS%id_Kd_lowmode = register_diag_field('ocean_model','Kd_lowmode',diag%axesTi,Time, & - 'Internal Tide Driven Diffusivity (from propagating low modes)', 'm2 s-1') + 'Internal Tide Driven Diffusivity (from propagating low modes)', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_Fl_itidal = register_diag_field('ocean_model','Fl_itides',diag%axesTi,Time, & 'Vertical flux of tidal turbulent dissipation', 'm3 s-3') @@ -590,12 +590,12 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, 'Vertical flux of tidal turbulent dissipation (from propagating low modes)', 'm3 s-3') CS%id_Polzin_decay_scale = register_diag_field('ocean_model','Polzin_decay_scale',diag%axesT1,Time, & - 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', 'm') + 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', 'm', conversion=GV%Z_to_m) CS%id_Polzin_decay_scale_scaled = register_diag_field('ocean_model', & - 'Polzin_decay_scale_scaled',diag%axesT1,Time, & + 'Polzin_decay_scale_scaled', diag%axesT1, Time, & 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme, '// & - 'scaled by N2_bot/N2_meanz', 'm') + 'scaled by N2_bot/N2_meanz', 'm', conversion=GV%Z_to_m) CS%id_N2_bot = register_diag_field('ocean_model','N2_b',diag%axesT1,Time, & 'Bottom Buoyancy frequency squared', 's-2') @@ -616,24 +616,24 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, CS%id_TKE_leewave = register_diag_field('ocean_model','TKE_leewave',diag%axesT1,Time, & 'Lee wave Driven Turbulent Kinetic Energy', 'W m-2') CS%id_Kd_Niku = register_diag_field('ocean_model','Kd_Nikurashin',diag%axesTi,Time, & - 'Lee Wave Driven Diffusivity', 'm2 s-1') + 'Lee Wave Driven Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2) endif endif ! S%use_CVMix_tidal if (associated(CS%diag_to_Z_CSp)) then vd = var_desc("Kd_itides","m2 s-1", & "Internal Tide Driven Diffusivity, interpolated to z", z_grid='z') - CS%id_Kd_itidal_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + CS%id_Kd_itidal_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) if (CS%Lee_wave_dissipation) then vd = var_desc("Kd_Nikurashin", "m2 s-1", & "Lee Wave Driven Diffusivity, interpolated to z", z_grid='z') - CS%id_Kd_Niku_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + CS%id_Kd_Niku_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) endif if (CS%Lowmode_itidal_dissipation) then vd = var_desc("Kd_lowmode","m2 s-1", & "Internal Tide Driven Diffusivity (from low modes), interpolated to z",& z_grid='z') - CS%id_Kd_lowmode_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + CS%id_Kd_lowmode_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) endif endif @@ -662,7 +662,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in m2 s-1 / m3 s-3 = s2 m-1 + !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 real, dimension(SZI_(G),SZK_(G)), intent(in) :: max_TKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness, in m3 s-3 type(tidal_mixing_cs), pointer :: CS !< The control structure for this module @@ -736,7 +736,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd_lay, Kv) hcorr = 0.0 do k=1,G%ke ! cell center and cell bottom in meters (negative values in the ocean) - dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment, rescaled to m for use by CVMix. dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness @@ -772,13 +772,13 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd_lay, Kv) ! Update diffusivity do k=1,G%ke - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_tidal(k) + Kd_tidal(k+1) ) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_tidal(k) + Kd_tidal(k+1)) ! Rescale from m2 s-1 to Z2 s-1. enddo ! Update viscosity with the proper unit conversion. if (associated(Kv)) then do k=1,G%ke+1 - Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kv_tidal(k) + Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 s-1. enddo endif @@ -817,11 +817,10 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd_lay, Kv) iFaceHeight = 0.0 ! BBL is all relative to the surface hcorr = 0.0 - h_m = h(i,j,:)*GV%H_to_m do k=1,G%ke + h_m(k) = h(i,j,k)*GV%H_to_m ! Rescale thicknesses to m for use by CVmix. ! cell center and cell bottom in meters (negative values in the ocean) - dh = h_m(k) ! Nominal thickness to use for increment - dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) + dh = h_m(k) + hcorr ! Nominal thickness less the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness cellHeight(k) = iFaceHeight(k) - 0.5 * dh @@ -871,13 +870,13 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd_lay, Kv) ! Update diffusivity do k=1,G%ke - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_tidal(k) + Kd_tidal(k+1) ) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_tidal(k) + Kd_tidal(k+1)) ! Rescale from m2 s-1 to Z2 s-1. enddo ! Update viscosity if (associated(Kv)) then do k=1,G%ke+1 - Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kv_tidal(k) + Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 s-1. enddo endif @@ -930,7 +929,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in m2 s-1 / m3 s-3 = s2 m-1 + !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 real, dimension(SZI_(G),SZK_(G)), intent(in) :: max_TKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness, in m3 s-3 type(tidal_mixing_cs), pointer :: CS !< The control structure for this module @@ -971,7 +970,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, z_from_bot_WKB ! distance from bottom (Z), WKB scaled real :: I_rho0 ! 1 / RHO0, (m3/kg) - real :: Kd_add ! diffusivity to add in a layer (m2/sec) + real :: Kd_add ! diffusivity to add in a layer (Z2/sec) real :: TKE_itide_lay ! internal tide TKE imparted to a layer (from barotropic) (m3/s3) real :: TKE_Niku_lay ! lee-wave TKE imparted to a layer (m3/s3) real :: TKE_lowmode_lay ! internal tide TKE imparted to a layer (from low mode) (m3/s3) (BDM) @@ -1056,15 +1055,15 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, do i=is,ie CS%Nb(i,j) = sqrt(N2_bot(i)) - !### In the code below 1.0e-14 is a dimensional constant. + !### In the code below 1.0e-14 is a dimensional constant in s-3 if ((CS%tideamp(i,j) > 0.0) .and. & - (CS%kappa_itides**2 * (GV%Z_to_m**2)*CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14) ) then + (CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14) ) then z0_polzin(i) = GV%m_to_Z * CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & CS%Nbotref_Polzin**2 * CS%tideamp(i,j) / & - ( CS%kappa_itides**2 * GV%Z_to_m**2*CS%h2(i,j) * CS%Nb(i,j)**3 ) + ( CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 ) if (z0_polzin(i) < CS%Polzin_min_decay_scale) & z0_polzin(i) = CS%Polzin_min_decay_scale - if (N2_meanz(i) > 1.0e-14 ) then + if (N2_meanz(i) > 1.0e-14 ) then !### Here 1.0e-14 has dimensions of s-2. z0_polzin_scaled(i) = z0_polzin(i)*CS%Nb(i,j)**2 / N2_meanz(i) else z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) @@ -1077,9 +1076,9 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, endif if (associated(dd%Polzin_decay_scale)) & - dd%Polzin_decay_scale(i,j) = GV%Z_to_m * z0_polzin(i) + dd%Polzin_decay_scale(i,j) = z0_polzin(i) if (associated(dd%Polzin_decay_scale_scaled)) & - dd%Polzin_decay_scale_scaled(i,j) = GV%Z_to_m * z0_polzin_scaled(i) + dd%Polzin_decay_scale_scaled(i,j) = z0_polzin_scaled(i) if (associated(dd%N2_bot)) dd%N2_bot(i,j) = CS%Nb(i,j)*CS%Nb(i,j) if ( CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then @@ -1180,12 +1179,12 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, ! Convert power to diffusivity Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) - if (Kd_max >= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_add + if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_add if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*GV%m_to_Z**2*Kd_add - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*GV%m_to_Z**2*Kd_add + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_add endif ! diagnostics @@ -1193,7 +1192,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, ! If at layers, dd%Kd_itidal is just TKE_to_Kd(i,k) * TKE_itide_lay ! The following sets the interface diagnostics. Kd_add = TKE_to_Kd(i,k) * TKE_itide_lay - if (Kd_max >= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2*Kd_add + if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_add if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*GV%m_to_Z**2*Kd_add - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*GV%m_to_Z**2*Kd_add + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5*Kd_add + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5*Kd_add endif ! diagnostics @@ -1280,7 +1279,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, ! If at layers, this is just dd%Kd_itidal(i,j,K) = TKE_to_Kd(i,k) * TKE_itide_lay ! The following sets the interface diagnostics. Kd_add = TKE_to_Kd(i,k) * TKE_itide_lay - if (Kd_max >= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, GV%Z_to_m**2*Kd_max) + if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add if (k Date: Fri, 5 Oct 2018 09:13:13 -0400 Subject: [PATCH 0795/1072] Removed trailing white space --- src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index b9325733e5..4f7126b4bd 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -804,7 +804,7 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) CS%calculate_cg1 = CS%calculate_cg1 .or. use_FGNV_streamfn call get_param(param_file, mdl, "USE_MEKE", use_MEKE, & default=.false., do_not_log=.true.) - CS%calculate_Rd_dx = CS%calculate_Rd_dx .or. use_MEKE + CS%calculate_Rd_dx = CS%calculate_Rd_dx .or. use_MEKE CS%calculate_Eady_growth_rate = CS%calculate_Eady_growth_rate .or. use_MEKE call get_param(param_file, mdl, "KHTR_PASSIVITY_COEFF", KhTr_passivity_coeff, & default=0., do_not_log=.true.) From 21473df7835871d5e5422892356d9ee394e86601 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 5 Oct 2018 10:37:39 -0400 Subject: [PATCH 0796/1072] Rescaled MOM_set_diffusivity calculations into Z Rescaled numerous internal calculations and internal variables in MOM_set_diffusivity to work in units of Z in place of m to permit dimensional consistency testing. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_set_diffusivity.F90 | 145 +++++++++--------- 1 file changed, 73 insertions(+), 72 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 237b0aeb12..9917f49f90 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -68,7 +68,7 @@ module MOM_set_diffusivity !! by bottom drag drives BBL diffusion (nondim) real :: cdrag !< quadratic drag coefficient (nondim) real :: IMax_decay !< inverse of a maximum decay scale for - !! bottom-drag driven turbulence, (1/m) + !! bottom-drag driven turbulence, (1/Z) real :: Kv !< The interior vertical viscosity (Z2/s) real :: Kd !< interior diapycnal diffusivity (Z2/s) real :: Kd_min !< minimum diapycnal diffusivity (Z2/s) @@ -521,8 +521,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(dd%Kd_work)) then do k=1,nz ; do i=is,ie - dd%Kd_Work(i,j,k) = GV%Rho0 * GV%Z_to_m**2*Kd_lay(i,j,k) * N2_lay(i,k) * & - GV%H_to_m*h(i,j,k) ! Watt m-2 s or kg s-3 + dd%Kd_Work(i,j,k) = GV%Rho0 * GV%Z_to_m**3*Kd_lay(i,j,k) * N2_lay(i,k) * & + GV%H_to_Z*h(i,j,k) ! Watt m-2 s or kg s-3 enddo ; enddo endif enddo ! j-loop @@ -693,19 +693,19 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & maxEnt ! maxEnt is the maximum value of entrainment from below (with ! compensating entrainment from above to keep the layer ! density from changing) that will not deplete all of the - ! layers above or below a layer within a timestep (meter) + ! layers above or below a layer within a timestep (Z) real, dimension(SZI_(G)) :: & htot, & ! total thickness above or below a layer, or the - ! integrated thickness in the BBL (meter) + ! integrated thickness in the BBL (Z) mFkb, & ! total thickness in the mixed and buffer layers - ! times ds_dsp1 (meter) + ! times ds_dsp1 (Z) p_ref, & ! array of tv%P_Ref pressures Rcv_kmb, & ! coordinate density in the lowest buffer layer p_0 ! An array of 0 pressures real :: dh_max ! maximum amount of entrainment a layer could ! undergo before entraining all fluid in the layers - ! above or below (meter) + ! above or below (Z) real :: dRho_lay ! density change across a layer (kg/m3) real :: Omega2 ! rotation rate squared (1/s2) real :: G_Rho0 ! gravitation accel divided by Bouss ref density (m4 s-2 kg-1) @@ -727,7 +727,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & ! Simple but coordinate-independent estimate of Kd/TKE if (CS%simple_TKE_to_Kd) then do k=1,nz ; do i=is,ie - hN2pO2 = GV%Z_to_m**2*( GV%H_to_m * h(i,j,k) ) * ( N2_lay(i,k) + Omega2 ) ! Units of m3 Z-2 s-2. + hN2pO2 = GV%Z_to_m**3 * ( GV%H_to_Z * h(i,j,k) ) * ( N2_lay(i,k) + Omega2 ) ! Units of m3 Z-2 s-2. if (hN2pO2>0.) then TKE_to_Kd(i,k) = 1.0 / hN2pO2 ! Units of Z2 s2 m-3. else; TKE_to_Kd(i,k) = 0.; endif @@ -782,32 +782,32 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & if (CS%bulkmixedlayer) then kmb = GV%nk_rho_varies do i=is,ie - htot(i) = GV%H_to_m*h(i,j,kmb) + htot(i) = GV%H_to_Z*h(i,j,kmb) mFkb(i) = 0.0 if (kb(i) < nz) & - mFkb(i) = ds_dsp1(i,kb(i)) * (GV%H_to_m*(h(i,j,kmb) - GV%Angstrom_H)) + mFkb(i) = ds_dsp1(i,kb(i)) * (GV%H_to_Z*(h(i,j,kmb) - GV%Angstrom_H)) enddo do k=1,kmb-1 ; do i=is,ie - htot(i) = htot(i) + GV%H_to_m*h(i,j,k) - mFkb(i) = mFkb(i) + ds_dsp1(i,k+1)*(GV%H_to_m*(h(i,j,k) - GV%Angstrom_H)) + htot(i) = htot(i) + GV%H_to_Z*h(i,j,k) + mFkb(i) = mFkb(i) + ds_dsp1(i,k+1)*(GV%H_to_Z*(h(i,j,k) - GV%Angstrom_H)) enddo ; enddo else do i=is,i - maxEnt(i,1) = 0.0 ; htot(i) = GV%H_to_m*(h(i,j,1) - GV%Angstrom_H) + maxEnt(i,1) = 0.0 ; htot(i) = GV%H_to_Z*(h(i,j,1) - GV%Angstrom_H) enddo endif do k=kb_min,nz-1 ; do i=is,ie if (k == kb(i)) then - maxEnt(i,kb(i))= mFkb(i) + maxEnt(i,kb(i)) = mFkb(i) elseif (k > kb(i)) then maxEnt(i,k) = (1.0/dsp1_ds(i,k))*(maxEnt(i,k-1) + htot(i)) ! maxEnt(i,k) = ds_dsp1(i,k)*(maxEnt(i,k-1) + htot(i)) ! BITWISE CHG - htot(i) = htot(i) + GV%H_to_m*(h(i,j,k) - GV%Angstrom_H) + htot(i) = htot(i) + GV%H_to_Z*(h(i,j,k) - GV%Angstrom_H) endif enddo ; enddo do i=is,ie - htot(i) = GV%H_to_m*(h(i,j,nz) - GV%Angstrom_H) ; maxEnt(i,nz) = 0.0 + htot(i) = GV%H_to_Z*(h(i,j,nz) - GV%Angstrom_H) ; maxEnt(i,nz) = 0.0 do_i(i) = (G%mask2dT(i,j) > 0.5) enddo do k=nz-1,kb_min,-1 @@ -816,7 +816,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & if (k 0.0) .and. (absf > 0.5*CS%IMax_decay*ustar_h)) then @@ -1222,12 +1222,12 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & I2decay(i) = 0.5*CS%IMax_decay endif TKE(i) = ((CS%BBL_effic * cdrag_sqrt) * & - exp(-I2decay(i)*(GV%H_to_m*h(i,j,nz))) ) * & + exp(-I2decay(i)*(GV%H_to_Z*h(i,j,nz))) ) * & visc%TKE_BBL(i,j) if (associated(fluxes%TKE_tidal)) & TKE(i) = TKE(i) + fluxes%TKE_tidal(i,j) * I_Rho0 * & - (CS%BBL_effic * exp(-I2decay(i)*(GV%H_to_m*h(i,j,nz)))) + (CS%BBL_effic * exp(-I2decay(i)*(GV%H_to_Z*h(i,j,nz)))) ! Distribute the work over a BBL of depth 20^2 ustar^2 / g' following ! Killworth & Edwards (1999) and Zilitikevich & Mironov (1996). @@ -1237,16 +1237,16 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & gh_sum_top(i) = R0_g * 400.0 * ustar_h**2 do_i(i) = (G%mask2dT(i,j) > 0.5) - htot(i) = GV%H_to_m*h(i,j,nz) - rho_htot(i) = GV%Rlay(nz)*(GV%H_to_m*h(i,j,nz)) + htot(i) = GV%H_to_Z*h(i,j,nz) + rho_htot(i) = GV%Rlay(nz)*(GV%H_to_Z*h(i,j,nz)) Rho_top(i) = GV%Rlay(1) if (CS%bulkmixedlayer .and. do_i(i)) Rho_top(i) = GV%Rlay(kb(i)-1) enddo do k=nz-1,2,-1 ; domore = .false. do i=is,ie ; if (do_i(i)) then - htot(i) = htot(i) + GV%H_to_m*h(i,j,k) - rho_htot(i) = rho_htot(i) + GV%Rlay(k)*(GV%H_to_m*h(i,j,k)) + htot(i) = htot(i) + GV%H_to_Z*h(i,j,k) + rho_htot(i) = rho_htot(i) + GV%Rlay(k)*(GV%H_to_Z*h(i,j,k)) if (htot(i)*GV%Rlay(k-1) <= (rho_htot(i) - gh_sum_top(i))) then ! The top of the mixing is in the interface atop the current layer. Rho_top(i) = (rho_htot(i) - gh_sum_top(i)) / htot(i) @@ -1265,7 +1265,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & i_rem = i_rem + 1 ! Count the i-rows that are still being worked on. ! Apply vertical decay of the turbulent energy. This energy is ! simply lost. - TKE(i) = TKE(i) * exp(-I2decay(i) * (GV%H_to_m*(h(i,j,k) + h(i,j,k+1)))) + TKE(i) = TKE(i) * exp(-I2decay(i) * (GV%H_to_Z*(h(i,j,k) + h(i,j,k+1)))) ! if (maxEnt(i,k) <= 0.0) cycle if (maxTKE(i,k) <= 0.0) cycle @@ -1390,17 +1390,17 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & real :: TKE_consumed ! TKE used for mixing in this layer (m3 s-3) real :: TKE_Kd_wall ! TKE associated with unlimited law of the wall mixing (m3 s-3) real :: cdrag_sqrt ! square root of the drag coefficient (nondimensional) - real :: ustar ! value of ustar at a thickness point (m/s) + real :: ustar ! value of ustar at a thickness point (Z/s) real :: ustar2 ! square of ustar, for convenience (Z2/s2) real :: absf ! average absolute value of Coriolis parameter around a thickness point (1/sec) - real :: dh, dhm1 ! thickness of layers k and k-1, respecitvely (meter) - real :: z ! distance to interface k from bottom (meter) - real :: D_minus_z ! distance to interface k from surface (meter) - real :: total_thickness ! total thickness of water column (meter) - real :: Idecay ! inverse of decay scale used for "Joule heating" loss of TKE with height (1/m) + real :: dh, dhm1 ! thickness of layers k and k-1, respecitvely (Z) + real :: z_bot ! distance to interface k from bottom (Z) + real :: D_minus_z ! distance to interface k from surface (Z) + real :: total_thickness ! total thickness of water column (Z) + real :: Idecay ! inverse of decay scale used for "Joule heating" loss of TKE with height (1/Z) real :: Kd_wall ! Law of the wall diffusivity (Z2/s) real :: Kd_lower ! diffusivity for lower interface (Z2/sec) - real :: ustar_D ! u* x D (m2/s) + real :: ustar_D ! u* x D (Z2/s) real :: I_Rho0 ! 1 / rho0 real :: N2_min ! Minimum value of N2 to use in calculation of TKE_Kd_wall (1/s2) logical :: Rayleigh_drag ! Set to true if there are Rayleigh drag velocities defined in visc, on @@ -1429,11 +1429,11 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) ! Non-zero on equator! ! u* at the bottom, in m s-1. - ustar = visc%ustar_BBL(i,j) - ustar2 = GV%m_to_Z**2*ustar**2 + ustar = GV%m_to_Z*visc%ustar_BBL(i,j) + ustar2 = ustar**2 ! In add_drag_diffusivity(), fluxes%ustar_tidal is added in. This might be double counting ! since ustar_BBL should already include all contributions to u*? -AJA - if (associated(fluxes%ustar_tidal)) ustar = ustar + fluxes%ustar_tidal(i,j) + if (associated(fluxes%ustar_tidal)) ustar = ustar + GV%m_to_Z*fluxes%ustar_tidal(i,j) ! The maximum decay scale should be something of order 200 m. We use the smaller of u*/f and ! (IMax_decay)^-1 as the decay scale. If ustar = 0, this is land so this value doesn't matter. @@ -1450,17 +1450,17 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & TKE_column = CS%BBL_effic * TKE_column ! Only use a fraction of the mechanical dissipation for mixing. TKE_remaining = TKE_column - total_thickness = ( sum(h(i,j,:)) + GV%H_subroundoff )* GV%H_to_m ! Total column thickness, in m. + total_thickness = ( sum(h(i,j,:)) + GV%H_subroundoff )* GV%H_to_Z ! Total column thickness, in m. ustar_D = ustar * total_thickness - z = 0. + z_bot = 0. Kd_lower = 0. ! Diffusivity on bottom boundary. ! Work upwards from the bottom, accumulating work used until it exceeds the available TKE input ! at the bottom. do k=G%ke,2,-1 - dh = GV%H_to_m * h(i,j,k) ! Thickness of this level in m. + dh = GV%H_to_Z * h(i,j,k) ! Thickness of this level in Z. km1 = max(k-1, 1) - dhm1 = GV%H_to_m * h(i,j,km1) ! Thickness of level above in m. + dhm1 = GV%H_to_Z * h(i,j,km1) ! Thickness of level above in Z. ! Add in additional energy input from bottom-drag against slopes (sides) if (Rayleigh_drag) TKE_remaining = TKE_remaining + & @@ -1474,20 +1474,21 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! This is energy loss in addition to work done as mixing, apparently to Joule heating. TKE_remaining = exp(-Idecay*dh) * TKE_remaining - z = z + h(i,j,k)*GV%H_to_m ! Distance between upper interface of layer and the bottom, in m. - D_minus_z = max(total_thickness - z, 0.) ! Thickness above layer, m. + z_bot = z_bot + h(i,j,k)*GV%H_to_Z ! Distance between upper interface of layer and the bottom, in Z. + D_minus_z = max(total_thickness - z_bot, 0.) ! Thickness above layer, Z. ! Diffusivity using law of the wall, limited by rotation, at height z, in m2/s. ! This calculation is at the upper interface of the layer - if ( ustar_D + absf * ( z * D_minus_z ) == 0.) then + if ( ustar_D + absf * ( z_bot * D_minus_z ) == 0.) then Kd_wall = 0. else - Kd_wall = ( ( von_karm * ustar2 ) * ( z * D_minus_z ) )/( ustar_D + absf * ( z * D_minus_z ) ) + Kd_wall = ( ( von_karm * ustar2 ) * ( z_bot * D_minus_z ) ) / & + ( ustar_D + absf * ( z_bot * D_minus_z ) ) endif ! TKE associated with Kd_wall, in m3 s-2. ! This calculation if for the volume spanning the interface. - TKE_Kd_wall = GV%Z_to_m**2*Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) + TKE_Kd_wall = GV%Z_to_m**3*Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) ! Now bound Kd such that the associated TKE is no greater than available TKE for mixing. if (TKE_Kd_wall > 0.) then @@ -1537,9 +1538,9 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ ! This routine adds effects of mixed layer radiation to the layer diffusivities. - real, dimension(SZI_(G)) :: h_ml + real, dimension(SZI_(G)) :: h_ml ! Mixed layer thickness, in Z. real, dimension(SZI_(G)) :: TKE_ml_flux - real, dimension(SZI_(G)) :: I_decay + real, dimension(SZI_(G)) :: I_decay ! A decay rate in Z-1. real, dimension(SZI_(G)) :: Kd_mlr_ml ! Diffusivities associated with mixed layer radiation, in Z2 s-1. real :: f_sq, h_ml_sq, ustar_sq @@ -1547,10 +1548,10 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ real :: C1_6 ! 1/6 real :: Omega2 ! rotation rate squared (1/s2) real :: z1 ! layer thickness times I_decay (nondim) - real :: dzL ! thickness converted to meter + real :: dzL ! thickness converted to Z real :: I_decay_len2_TKE ! squared inverse decay lengthscale for - ! TKE, as used in the mixed layer code (1/m2) - real :: h_neglect ! negligibly small thickness (meter) + ! TKE, as used in the mixed layer code (1/Z2) + real :: h_neglect ! negligibly small thickness (Z) logical :: do_any, do_i(SZI_(G)) integer :: i, k, is, ie, nz, kml @@ -1559,12 +1560,12 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ Omega2 = CS%Omega**2 C1_6 = 1.0 / 6.0 kml = GV%nkml - h_neglect = GV%H_subroundoff*GV%H_to_m + h_neglect = GV%H_subroundoff*GV%H_to_Z if (.not.CS%ML_radiation) return do i=is,ie ; h_ml(i) = 0.0 ; do_i(i) = (G%mask2dT(i,j) > 0.5) ; enddo - do k=1,kml ; do i=is,ie ; h_ml(i) = h_ml(i) + GV%H_to_m*h(i,j,k) ; enddo ; enddo + do k=1,kml ; do i=is,ie ; h_ml(i) = h_ml(i) + GV%H_to_Z*h(i,j,k) ; enddo ; enddo do i=is,ie ; if (do_i(i)) then if (CS%ML_omega_frac >= 1.0) then @@ -1579,7 +1580,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ ustar_sq = max(fluxes%ustar(i,j), CS%ustar_min)**2 TKE_ml_flux(i) = (CS%mstar*CS%ML_rad_coeff)*(ustar_sq*fluxes%ustar(i,j)) - I_decay_len2_TKE = CS%TKE_decay**2 * (f_sq / ustar_sq) + I_decay_len2_TKE = CS%TKE_decay**2 * (f_sq / (GV%m_to_Z**2*ustar_sq)) if (CS%ML_rad_TKE_decay) & TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-h_ml(i) * sqrt(I_decay_len2_TKE)) @@ -1590,7 +1591,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ ! Average the dissipation layer kml+1, using ! a more accurate Taylor series approximations for very thin layers. - z1 = (GV%H_to_m*h(i,j,kml+1)) * I_decay(i) + z1 = (GV%H_to_Z*h(i,j,kml+1)) * I_decay(i) if (z1 > 1e-5) then Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,kml+1)) * & (1.0 - exp(-z1)) @@ -1617,13 +1618,13 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ do k=kml+2,nz-1 do_any = .false. do i=is,ie ; if (do_i(i)) then - dzL = GV%H_to_m*h(i,j,k) ; z1 = dzL*I_decay(i) + dzL = GV%H_to_Z*h(i,j,k) ; z1 = dzL*I_decay(i) if (z1 > 1e-5) then Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & - ((1.0 - exp(-z1)) / dzL) + GV%m_to_Z * ((1.0 - exp(-z1)) / dzL) else Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & - (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) + GV%m_to_Z * (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) endif Kd_mlr = min(Kd_mlr, CS%ML_rad_kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_mlr @@ -1633,7 +1634,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ endif TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-z1) - if (TKE_ml_flux(i) * I_decay(i) < 0.1*CS%Kd_min*GV%Z_to_m**2*Omega2) then + if (TKE_ml_flux(i) * I_decay(i) < 0.1*CS%Kd_min*GV%Z_to_m**3*Omega2) then do_i(i) = .false. else ; do_any = .true. ; endif endif ; enddo @@ -2035,10 +2036,10 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp "The maximum decay scale for the BBL diffusion, or 0 \n"//& "to allow the mixing to penetrate as far as \n"//& "stratification and rotation permit. The default is 0. \n"//& - "This is only used if BOTTOMDRAGLAW is true.", units="m", & - default=0.0) + "This is only used if BOTTOMDRAGLAW is true.", & + units="m", default=0.0, scale=GV%m_to_Z) - CS%IMax_decay = 1.0/200.0 + CS%IMax_decay = 1.0 / (200.0*GV%m_to_Z) !### This is inconsistent with the description above. if (decay_length > 0.0) CS%IMax_decay = 1.0/decay_length call get_param(param_file, mdl, "BBL_MIXING_AS_MAX", CS%BBL_mixing_as_max, & "If true, take the maximum of the diffusivity from the \n"//& From 5f3949fd71a313992106d903c792d3607e04fa33 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Fri, 5 Oct 2018 12:05:37 -0400 Subject: [PATCH 0797/1072] Diag decimation prototype, fixed masks and cleanup - The masks for non-native decimated diags were not set right - Some cleanup of the code to consolidate new calls - Note that locmask => NULL() shoulbe in the body of subroutines not in the definition section. If it is in the definition section it is set to null only on the first entry (it is automatically "save"ed) and on subsequent entry it is whatever it was the last time. --- src/framework/MOM_diag_mediator.F90 | 314 +++++++++++++++------------- 1 file changed, 165 insertions(+), 149 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index c5e4de65a2..9bce490007 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -68,13 +68,17 @@ module MOM_diag_mediator module procedure post_data_3d, post_data_2d, post_data_0d end interface post_data -interface decimate_sample - module procedure decimate_sample_2d_ptr, decimate_sample_3d_ptr, decimate_sample_2d, decimate_sample_3d -end interface decimate_sample +interface decimate_field + module procedure decimate_field_2d, decimate_field_3d +end interface decimate_field -interface decimate_diag_field_set - module procedure decimate_diag_field_set_2d,decimate_diag_field_set_3d -end interface decimate_diag_field_set +interface decimate_mask + module procedure decimate_mask_2d_p, decimate_mask_3d_p, decimate_mask_2d_a, decimate_mask_3d_a +end interface decimate_mask + +interface decimate_diag_field + module procedure decimate_diag_field_2d, decimate_diag_field_3d +end interface decimate_diag_field type, private :: diag_decim real, pointer, dimension(:,:) :: mask2d => null() !< Mask for 2d (x-y) axes @@ -769,28 +773,28 @@ subroutine set_masks_for_axes_decim(G, diag_cs) do c=1, diag_cs%num_diag_coords ! Level/layer h-points in diagnostic coordinate axes => diag_cs%remap_axesTL(c) - call decimate_sample(axes%mask3d, axes%decim(dl)%mask3d, dl) + call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesTL(c)%decim(dl)%mask3d, dl) ! Level/layer u-points in diagnostic coordinate axes => diag_cs%remap_axesCuL(c) - call decimate_sample(axes%mask3d, axes%decim(dl)%mask3d, dl) + call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesCuL(c)%decim(dl)%mask3d, dl) ! Level/layer v-points in diagnostic coordinate axes => diag_cs%remap_axesCvL(c) - call decimate_sample(axes%mask3d, axes%decim(dl)%mask3d, dl) + call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesCvL(c)%decim(dl)%mask3d, dl) ! Level/layer q-points in diagnostic coordinate axes => diag_cs%remap_axesBL(c) - call decimate_sample(axes%mask3d, axes%decim(dl)%mask3d, dl) + call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesBL(c)%decim(dl)%mask3d, dl) ! Interface h-points in diagnostic coordinate (w-point) axes => diag_cs%remap_axesTi(c) - call decimate_sample(axes%mask3d, axes%decim(dl)%mask3d, dl) + call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesTi(c)%decim(dl)%mask3d, dl) ! Interface u-points in diagnostic coordinate axes => diag_cs%remap_axesCui(c) - call decimate_sample(axes%mask3d, axes%decim(dl)%mask3d, dl) + call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesCui(c)%decim(dl)%mask3d, dl) ! Interface v-points in diagnostic coordinate axes => diag_cs%remap_axesCvi(c) - call decimate_sample(axes%mask3d, axes%decim(dl)%mask3d, dl) + call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesCvi(c)%decim(dl)%mask3d, dl) ! Interface q-points in diagnostic coordinate axes => diag_cs%remap_axesBi(c) - call decimate_sample(axes%mask3d, axes%decim(dl)%mask3d, dl) + call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesBi(c)%decim(dl)%mask3d, dl) enddo enddo end subroutine set_masks_for_axes_decim @@ -1232,16 +1236,16 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) ! Local variables real, dimension(:,:), pointer :: locfield => NULL() - real, dimension(:,:), pointer :: locmask => NULL() + real, dimension(:,:), pointer :: locmask character(len=300) :: mesg logical :: used, is_stat integer :: cszi, cszj, dszi, dszj integer :: isv, iev, jsv, jev, i, j, chksum - real, dimension(:,:), pointer :: diag_axes_mask2d => NULL() real, dimension(:,:), allocatable, target :: locfield_decim real, dimension(:,:), allocatable, target :: locmask_decim - integer :: isl,iel,jsl,jel,dl + integer :: dl + locmask => NULL() is_stat = .false. ; if (present(is_static)) is_stat = is_static ! Determine the propery array indices, noting that because of the (:,:) @@ -1295,11 +1299,6 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) locfield => field endif - if (present(mask)) then - call assert(size(locfield) == size(mask), & - 'post_data_2d_low: mask size mismatch: '//diag%debug_str) - locmask => mask - endif if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) then allocate( locfield( lbound(field,1):ubound(field,1), lbound(field,2):ubound(field,2) ) ) do j=jsv,jev ; do i=isv,iev @@ -1315,35 +1314,21 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) endif if (present(mask)) then - call assert(size(locfield) == size(mask), & - 'post_data_2d_low: mask size mismatch: '//diag%debug_str) locmask => mask + elseif(associated(diag%axes%mask2d)) then + locmask => diag%axes%mask2d endif - diag_axes_mask2d => diag%axes%mask2d dl = diag%axes%decimation_level if (dl > 1) then - isl=1; iel=size(field,1)/dl - jsl=1; jel=size(field,2)/dl - call decimate_diag_indices_get(iel,jel, dl, diag_cs,isv,iev,jsv,jev) -! allocate(locfield_decim(isl:iel,jsl:jel)) -! call decimate_diag_field_set(locfield, locfield_decim, dl,isl,iel,jsl,jel) - if (present(mask)) then - call decimate_sample(locfield, locfield_decim, dl, method='pave', mask=locmask) - elseif (associated(diag%axes%mask2d)) then - call decimate_sample(locfield, locfield_decim, dl, method='pave', mask=diag%axes%mask2d) - else - call decimate_sample(locfield, locfield_decim, dl, method='pave') !decimate without a mask, how ?? - endif + call decimate_diag_field(locfield, locfield_decim, dl, diag_cs, diag,isv,iev,jsv,jev, mask) locfield => locfield_decim if (present(mask)) then -! allocate(locmask_decim(isl:iel,jsl:jel)) -! call decimate_diag_field_set(locmask, locmask_decim, dl,isl,iel,jsl,jel) - call decimate_sample(locmask, locmask_decim, dl) + call decimate_mask(locmask, locmask_decim, dl) locmask => locmask_decim - elseif (associated(diag%axes%decim(dl)%mask2d)) then - diag_axes_mask2d => diag%axes%decim(dl)%mask2d - endif + elseif(associated(diag%axes%decim(dl)%mask2d)) then + locmask => diag%axes%decim(dl)%mask2d + endif endif if (diag_cs%diag_as_chksum) then @@ -1366,18 +1351,12 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) is_in=isv, js_in=jsv, ie_in=iev, je_in=jev) endif elseif (diag_cs%ave_enabled) then - if (present(mask)) then + if (associated(locmask)) then call assert(size(locfield) == size(locmask), & 'post_data_2d_low: mask size mismatch: '//diag%debug_str) used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & weight=diag_cs%time_int, rmask=locmask) - elseif (associated(diag_axes_mask2d)) then - call assert(size(locfield) == size(diag_axes_mask2d), & - 'post_data_2d_low: mask2d size mismatch: '//diag%debug_str) - used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag_cs%time_int, rmask=diag_axes_mask2d) else used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & @@ -1520,7 +1499,7 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) ! Local variables real, dimension(:,:,:), pointer :: locfield => NULL() - real, dimension(:,:,:), pointer :: locmask => NULL() + real, dimension(:,:,:), pointer :: locmask character(len=300) :: mesg logical :: used ! The return value of send_data is not used for anything. logical :: staggered_in_x, staggered_in_y @@ -1528,11 +1507,11 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) integer :: cszi, cszj, dszi, dszj integer :: isv, iev, jsv, jev, ks, ke, i, j, k, isv_c, jsv_c integer :: chksum - real, dimension(:,:,:), pointer :: diag_axes_mask3d => NULL() real, dimension(:,:,:), allocatable, target :: locfield_decim real, dimension(:,:,:), allocatable, target :: locmask_decim integer :: isl,iel,jsl,jel,dl + locmask => NULL() is_stat = .false. ; if (present(is_static)) is_stat = is_static ! Determine the proper array indices, noting that because of the (:,:) @@ -1604,36 +1583,21 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) endif if (present(mask)) then - call assert(size(locfield) == size(mask), & - 'post_data_3d_low: mask size mismatch: '//diag%debug_str) locmask => mask + elseif(associated(diag%axes%mask3d)) then + locmask => diag%axes%mask3d endif - - diag_axes_mask3d => diag%axes%mask3d + dl = diag%axes%decimation_level if (dl > 1) then - isl=1; iel=size(field,1)/dl - jsl=1; jel=size(field,2)/dl - call decimate_diag_indices_get(iel,jel, dl, diag_cs,isv,iev,jsv,jev) -! allocate(locfield_decim(isl:iel,jsl:jel,ks:ke)) -! call decimate_diag_field_set(locfield, locfield_decim, dl,isl,iel,jsl,jel,ks,ke) - if (present(mask)) then - call decimate_sample(locfield, locfield_decim, dl, method='pave', mask=locmask) - elseif (associated(diag%axes%mask3d)) then - call decimate_sample(locfield, locfield_decim, dl, method='pave', mask=diag%axes%mask3d) - else - !Niki: How are we supposed to aggregate/average without a mask if one or more aggregating cells are on land? - call decimate_sample(locfield, locfield_decim, dl, method='pave') !decimate without a mask, how ?? - endif + call decimate_diag_field(locfield, locfield_decim, dl, diag_cs, diag,isv,iev,jsv,jev, mask) locfield => locfield_decim if (present(mask)) then -! allocate(locmask_decim(isl:iel,jsl:jel,ks:ke)) -! call decimate_diag_field_set(locmask, locmask_decim, dl,isl,iel,jsl,jel,ks,ke) - call decimate_sample(locmask, locmask_decim, dl) ! Niki: What is the correct method for mask? Defaults to subsample + call decimate_mask(locmask, locmask_decim, dl) locmask => locmask_decim - elseif (associated(diag%axes%decim(dl)%mask3d)) then - diag_axes_mask3d => diag%axes%decim(dl)%mask3d - endif + elseif(associated(diag%axes%decim(dl)%mask3d)) then + locmask => diag%axes%decim(dl)%mask3d + endif endif if (diag_cs%diag_as_chksum) then @@ -1656,18 +1620,12 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) is_in=isv, js_in=jsv, ie_in=iev, je_in=jev) endif elseif (diag_cs%ave_enabled) then - if (present(mask)) then + if (associated(locmask)) then call assert(size(locfield) == size(locmask), & 'post_data_3d_low: mask size mismatch: '//diag%debug_str) used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & weight=diag_cs%time_int, rmask=locmask) - elseif (associated(diag_axes_mask3d)) then - call assert(size(locfield) == size(diag_axes_mask3d), & - 'post_data_3d_low: mask3d size mismatch: '//diag%debug_str) - used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag_cs%time_int, rmask=diag_axes_mask3d) else used = send_data(diag%fms_diag_id, locfield, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & @@ -3393,10 +3351,10 @@ subroutine decimate_diag_masks_set(G, nz, diag_cs) do dl=2,MAX_DECIM_LEV ! 2d masks - call decimate_sample(G%mask2dT, diag_cs%decim(dl)%mask2dT, dl) - call decimate_sample(G%mask2dBu,diag_cs%decim(dl)%mask2dBu, dl) - call decimate_sample(G%mask2dCu,diag_cs%decim(dl)%mask2dCu, dl) - call decimate_sample(G%mask2dCv,diag_cs%decim(dl)%mask2dCv, dl) + call decimate_mask(G%mask2dT, diag_cs%decim(dl)%mask2dT, dl) + call decimate_mask(G%mask2dBu,diag_cs%decim(dl)%mask2dBu, dl) + call decimate_mask(G%mask2dCu,diag_cs%decim(dl)%mask2dCu, dl) + call decimate_mask(G%mask2dCv,diag_cs%decim(dl)%mask2dCv, dl) ! 3d native masks are needed by diag_manager but the native variables ! can only be masked 2d - for ocean points, all layers exists. allocate(diag_cs%decim(dl)%mask3dTL(G%isd_zap2:G%ied_zap2,G%jsd_zap2:G%jed_zap2,1:nz)) @@ -3426,7 +3384,7 @@ subroutine decimate_diag_indices_get(f1,f2, dl, diag_cs,isv,iev,jsv,jev) integer, intent(in) :: f1,f2 integer, intent(in) :: dl !< integer decimation level type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output - integer, intent(inout) ::isv,iev,jsv,jev + integer, intent(out) ::isv,iev,jsv,jev ! Local variables integer :: dszi,cszi,dszj,cszj character(len=300) :: mesg @@ -3467,65 +3425,58 @@ subroutine decimate_diag_indices_get(f1,f2, dl, diag_cs,isv,iev,jsv,jev) end subroutine decimate_diag_indices_get -subroutine decimate_diag_field_set_3d(field_in, field_out, level ,isl,iel,jsl,jel,ks,ke) - real, dimension(:,:,:) , pointer :: field_in - real, dimension(:,:,:) , intent(inout) :: field_out - integer , intent(in) :: level, iel,jel,ks,ke - integer , intent(inout) :: isl,jsl - integer :: i,j,ii,jj,is,js - integer :: k - !Always start from the first element - is=1; isl=1 - js=1; jsl=1 - do k= ks,ke ; do j=jsl,jel ; do i=isl,iel - ii = is+level*(i-isl) - jj = js+level*(j-jsl) - field_out(i,j,k) = field_in(ii,jj,k) - enddo; enddo; enddo -end subroutine decimate_diag_field_set_3d - -subroutine decimate_diag_field_set_2d(field_in, field_out, level ,isl,iel,jsl,jel) - real, dimension(:,:) , pointer :: field_in - real, dimension(:,:), intent(inout) :: field_out - integer , intent(in) :: level, iel,jel - integer , intent(inout) :: isl,jsl - integer :: i,j,ii,jj,is,js - - !Always start from the first element - is=1; isl=1 - js=1; jsl=1 - do j=jsl,jel ; do i=isl,iel - ii = is+level*(i-isl) - jj = js+level*(j-jsl) - field_out(i,j) = field_in(ii,jj) - enddo; enddo -end subroutine decimate_diag_field_set_2d +subroutine decimate_diag_field_3d(locfield, locfield_decim, dl, diag_cs, diag,isv,iev,jsv,jev, mask) + real, dimension(:,:,:), pointer :: locfield + real, dimension(:,:,:), allocatable, intent(inout) :: locfield_decim + type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output + type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post + integer, intent(in) :: dl + integer, intent(out):: isv,iev,jsv,jev + real, optional,target, intent(in) :: mask(:,:,:) !< If present, use this real array as the data mask. + !locals + real, dimension(:,:,:), pointer :: locmask => NULL() + integer :: isl,iel,jsl,jel + isl=1; iel=size(locfield,1)/dl + jsl=1; jel=size(locfield,2)/dl + call decimate_diag_indices_get(iel,jel, dl, diag_cs,isv,iev,jsv,jev) + if (present(mask)) then + locmask => mask + call decimate_field(locfield, locfield_decim, dl, method='pave', mask=locmask) + elseif (associated(diag%axes%mask3d)) then + call decimate_field(locfield, locfield_decim, dl, method='pave', mask=diag%axes%mask3d) + else + call decimate_field(locfield, locfield_decim, dl, method='pave') !decimate without a mask, how ?? + endif +end subroutine decimate_diag_field_3d -subroutine decimate_sample_3d(field_in, field_out, level) - integer , intent(in) :: level - real, dimension(:,:,:) , pointer :: field_in, field_out - integer :: i,j,ii,jj,is,js +subroutine decimate_diag_field_2d(locfield, locfield_decim, dl, diag_cs, diag,isv,iev,jsv,jev, mask) + real, dimension(:,:), pointer :: locfield + real, dimension(:,:), allocatable, intent(inout) :: locfield_decim + type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output + type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post + integer, intent(in) :: dl + integer, intent(out):: isv,iev,jsv,jev + real, optional,target, intent(in) :: mask(:,:) !< If present, use this real array as the data mask. + !locals + real, dimension(:,:), pointer :: locmask => NULL() integer :: isl,iel,jsl,jel - integer :: k,ks,ke - ! is = lbound(field_in,1) ; ie = ubound(field_in,1) - ! js = lbound(field_in,2) ; je = ubound(field_in,2) - !Always start from the first element - is=1 - js=1 - ks = lbound(field_in,3) ; ke = ubound(field_in,3) - isl=1; iel=size(field_in,1)/level - jsl=1; jel=size(field_in,2)/level - allocate(field_out(isl:iel,jsl:jel,ks:ke)) - do k= ks,ke ; do j=jsl,jel ; do i=isl,iel - ii = is+level*(i-isl) - jj = js+level*(j-jsl) - field_out(i,j,k) = field_in(ii,jj,k) - enddo; enddo; enddo -end subroutine decimate_sample_3d + isl=1; iel=size(locfield,1)/dl + jsl=1; jel=size(locfield,2)/dl + call decimate_diag_indices_get(iel,jel, dl, diag_cs,isv,iev,jsv,jev) + if (present(mask)) then + locmask => mask + call decimate_field(locfield, locfield_decim, dl, method='pave', mask=locmask) + elseif (associated(diag%axes%mask2d)) then + call decimate_field(locfield, locfield_decim, dl, method='pave', mask=diag%axes%mask2d) + else + call decimate_field(locfield, locfield_decim, dl, method='pave') !decimate without a mask, how ?? + endif -subroutine decimate_sample_3d_ptr(field_in, field_out, level, method, mask) +end subroutine decimate_diag_field_2d + +subroutine decimate_field_3d(field_in, field_out, level, method, mask) real, dimension(:,:,:) , pointer :: field_in real, dimension(:,:,:) , allocatable :: field_out integer , intent(in) :: level @@ -3583,12 +3534,12 @@ subroutine decimate_sample_3d_ptr(field_in, field_out, level, method, mask) enddo; enddo; enddo endif case default - call MOM_error(FATAL, "decimate_sample_3d_ptr: unknown sampling method "//trim(samplemethod)) + call MOM_error(FATAL, "decimate_field_3d: unknown sampling method "//trim(samplemethod)) end select -end subroutine decimate_sample_3d_ptr +end subroutine decimate_field_3d -subroutine decimate_sample_2d_ptr(field_in, field_out, level, method, mask) +subroutine decimate_field_2d(field_in, field_out, level, method, mask) real, dimension(:,:) , pointer :: field_in real, dimension(:,:) , allocatable :: field_out integer , intent(in) :: level @@ -3629,7 +3580,7 @@ subroutine decimate_sample_2d_ptr(field_in, field_out, level, method, mask) enddo; enddo field_out(i,j) = ave/max(1.0,tot_non_zero) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo - else !Niki: How are we supposed to aggregate/average without a mask? What if field_in is on land at one or more aggregating cells? + else !Niki: How are we supposed to decimate/average without a mask? What if field_in is on land at one or more aggregating cells? do j=jsl,jel ; do i=isl,iel i0 = is+level*(i-isl) j0 = js+level*(j-jsl) @@ -3643,12 +3594,34 @@ subroutine decimate_sample_2d_ptr(field_in, field_out, level, method, mask) enddo; enddo endif case default - call MOM_error(FATAL, "decimate_sample_2d_ptr: unknown sampling method "//trim(samplemethod)) + call MOM_error(FATAL, "decimate_field_2d: unknown sampling method "//trim(samplemethod)) end select -end subroutine decimate_sample_2d_ptr +end subroutine decimate_field_2d + +subroutine decimate_mask_3d_p(field_in, field_out, level) + integer , intent(in) :: level + real, dimension(:,:,:) , pointer :: field_in, field_out + integer :: i,j,ii,jj,is,js + integer :: isl,iel,jsl,jel + integer :: k,ks,ke + ! is = lbound(field_in,1) ; ie = ubound(field_in,1) + ! js = lbound(field_in,2) ; je = ubound(field_in,2) + !Always start from the first element + is=1 + js=1 + ks = lbound(field_in,3) ; ke = ubound(field_in,3) + isl=1; iel=size(field_in,1)/level + jsl=1; jel=size(field_in,2)/level + allocate(field_out(isl:iel,jsl:jel,ks:ke)) + do k= ks,ke ; do j=jsl,jel ; do i=isl,iel + ii = is+level*(i-isl) + jj = js+level*(j-jsl) + field_out(i,j,k) = field_in(ii,jj,k) + enddo; enddo; enddo +end subroutine decimate_mask_3d_p -subroutine decimate_sample_2d(field_in, field_out, level) +subroutine decimate_mask_2d_p(field_in, field_out, level) integer , intent(in) :: level real, dimension(:,:) , intent(in) :: field_in real, dimension(:,:) , pointer :: field_out @@ -3665,6 +3638,49 @@ subroutine decimate_sample_2d(field_in, field_out, level) jj = js+level*(j-jsl) field_out(i,j) = field_in(ii,jj) enddo; enddo -end subroutine decimate_sample_2d +end subroutine decimate_mask_2d_p + +subroutine decimate_mask_3d_a(field_in, field_out, level) + integer , intent(in) :: level + real, dimension(:,:,:), pointer :: field_in + real, dimension(:,:,:), allocatable :: field_out + integer :: i,j,ii,jj,is,js + integer :: isl,iel,jsl,jel + integer :: k,ks,ke + ! is = lbound(field_in,1) ; ie = ubound(field_in,1) + ! js = lbound(field_in,2) ; je = ubound(field_in,2) + !Always start from the first element + is=1 + js=1 + ks = lbound(field_in,3) ; ke = ubound(field_in,3) + isl=1; iel=size(field_in,1)/level + jsl=1; jel=size(field_in,2)/level + allocate(field_out(isl:iel,jsl:jel,ks:ke)) + do k= ks,ke ; do j=jsl,jel ; do i=isl,iel + ii = is+level*(i-isl) + jj = js+level*(j-jsl) + field_out(i,j,k) = field_in(ii,jj,k) + enddo; enddo; enddo +end subroutine decimate_mask_3d_a + +subroutine decimate_mask_2d_a(field_in, field_out, level) + integer , intent(in) :: level + real, dimension(:,:) , intent(in) :: field_in + real, dimension(:,:) , allocatable :: field_out + integer :: i,j,ii,jj,is,js + integer :: isl,iel,jsl,jel + !Always start from the first element + is=1 + js=1 + isl=1; iel=size(field_in,1)/level + jsl=1; jel=size(field_in,2)/level + allocate(field_out(isl:iel,jsl:jel)) + do j=jsl,jel ; do i=isl,iel + ii = is+level*(i-isl) + jj = js+level*(j-jsl) + field_out(i,j) = field_in(ii,jj) + enddo; enddo +end subroutine decimate_mask_2d_a + end module MOM_diag_mediator From e6e63dbd649559f8949fda00613d4945101ad4b9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 5 Oct 2018 14:35:52 -0400 Subject: [PATCH 0798/1072] Changed the units of visc%ustar_BBL to Z s-1 Rescaled the units of visc%ustar_BBL from m s-1 to Z s-1 for dimensional consistency testing. Also changed the units of 5 CS%dissip_... parameters in MOM_set_diffusivity via calls to get_param. All answers are bitwise identical, including rescaling Z over a large range. --- src/core/MOM_variables.F90 | 2 +- .../vertical/MOM_set_diffusivity.F90 | 41 ++++++++++--------- 2 files changed, 22 insertions(+), 21 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 91e3e48af3..8f7dc9dea1 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -196,7 +196,7 @@ module MOM_variables bbl_thick_v => NULL(), & !< The bottom boundary layer thickness at the v-points, in Z. kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points, in Z2 s-1. kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points, in Z2 s-1. - ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points, in m s-1. + ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points, in Z s-1. real, pointer, dimension(:,:) :: TKE_BBL => NULL() !< A term related to the bottom boundary layer source of turbulent kinetic !! energy, currently in units of m3 s-3, but will later be changed to W m-2. diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 9917f49f90..52df0e0f72 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -84,11 +84,11 @@ module MOM_set_diffusivity logical :: limit_dissipation !< If enabled, dissipation is limited to be larger !! than the following: - real :: dissip_min !< Minimum dissipation (W/m3) - real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N (W/m3) - real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N (J/m3) - real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 (W m-3 s2) - real :: dissip_Kd_min !< Minimum Kd (m2/s) with dissipatio Rho0*Kd_min*N^2 + real :: dissip_min !< Minimum dissipation (Z2 m-2 W m-3) + real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N (Z2 m-2 W m-3) + real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N (Z2 m-2 W m-3 s) + real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 (Z2 m-2 W m-3 s2) + real :: dissip_Kd_min !< Minimum Kd (Z2/s) with dissipation Rho0*Kd_min*N^2 real :: TKE_itide_max !< maximum internal tide conversion (W m-2) !! available to mix above the BBL @@ -250,7 +250,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & KS_extra !< double difusion diffusivity of salinity (Z2/sec) real :: I_Rho0 ! inverse of Boussinesq density (m3/kg) - real :: dissip ! local variable for dissipation calculations (W/m3) + real :: dissip ! local variable for dissipation calculations (Z2 W/m5) real :: Omega2 ! squared absolute rotation rate (1/s2) logical :: use_EOS ! If true, compute density from T/S using equation of state. @@ -502,7 +502,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_lay(i,k)), & ! Floor aka Gargett CS%dissip_N2 * N2_lay(i,k) ) ! Floor of Kd_min*rho0/F_Ri Kd_lay(i,j,k) = max( Kd_lay(i,j,k) , & ! Apply floor to Kd - GV%m_to_Z**2*dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_lay(i,k) + Omega2))) ) + dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_lay(i,k) + Omega2))) ) enddo ; enddo if (present(Kd_int)) then ; do K=2,nz ; do i=is,ie @@ -515,7 +515,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_int(i,K)), & ! Floor aka Gargett CS%dissip_N2 * N2_int(i,K) ) ! Floor of Kd_min*rho0/F_Ri Kd_int(i,j,K) = max( Kd_int(i,j,K) , & ! Apply floor to Kd - GV%m_to_Z**2*dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + Omega2))) ) + dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + Omega2))) ) enddo ; enddo ; endif endif @@ -1209,7 +1209,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ! Any turbulence that makes it into the mixed layers is assumed ! to be relatively small and is discarded. do i=is,ie - ustar_h = GV%m_to_Z*visc%ustar_BBL(i,j) + ustar_h = visc%ustar_BBL(i,j) if (associated(fluxes%ustar_tidal)) & ustar_h = ustar_h + GV%m_to_Z*fluxes%ustar_tidal(i,j) absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & @@ -1429,7 +1429,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) ! Non-zero on equator! ! u* at the bottom, in m s-1. - ustar = GV%m_to_Z*visc%ustar_BBL(i,j) + ustar = visc%ustar_BBL(i,j) ustar2 = ustar**2 ! In add_drag_diffusivity(), fluxes%ustar_tidal is added in. This might be double counting ! since ustar_BBL should already include all contributions to u*? -AJA @@ -1668,13 +1668,13 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) real, dimension(SZIB_(G)) :: & uhtot, & ! running integral of u in the BBL (Z m/s) - ustar, & ! bottom boundary layer turbulence speed (m/s) + ustar, & ! bottom boundary layer turbulence speed (Z/s) u2_bbl ! square of the mean zonal velocity in the BBL (m2/s2) real :: vhtot(SZI_(G)) ! running integral of v in the BBL (Z m/sec) real, dimension(SZI_(G),SZJB_(G)) :: & - vstar, & ! ustar at at v-points in 2 j-rows (m/s) + vstar, & ! ustar at at v-points (Z/s) v2_bbl ! square of average meridional velocity in BBL (m2/s2) real :: cdrag_sqrt ! square root of the drag coefficient (nondim) @@ -1709,7 +1709,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) ! vertical decay scale. do i=is,ie ; if ((G%mask2dCv(i,J) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_v(i,J) > 0.0)) then do_i(i) = .true. ; vhtot(i) = 0.0 ; htot(i) = 0.0 - vstar(i,J) = GV%Z_to_m*visc%kv_bbl_v(i,J)/(cdrag_sqrt*visc%bbl_thick_v(i,J)) + vstar(i,J) = visc%kv_bbl_v(i,J) / (cdrag_sqrt*visc%bbl_thick_v(i,J)) else do_i(i) = .false. ; vstar(i,J) = 0.0 ; htot(i) = 0.0 endif ; enddo @@ -1739,7 +1739,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) do j=js,je do I=is-1,ie ; if ((G%mask2dCu(I,j) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_u(I,j) > 0.0)) then do_i(I) = .true. ; uhtot(I) = 0.0 ; htot(I) = 0.0 - ustar(I) = GV%Z_to_m*visc%kv_bbl_u(I,j)/(cdrag_sqrt*visc%bbl_thick_u(I,j)) + ustar(I) = visc%kv_bbl_u(I,j) / (cdrag_sqrt*visc%bbl_thick_u(I,j)) else do_i(I) = .false. ; ustar(I) = 0.0 ; htot(I) = 0.0 endif ; enddo @@ -1770,10 +1770,11 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) G%areaCu(I,j)*(ustar(I)*ustar(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*vstar(i,J-1)) + & G%areaCv(i,J)*(vstar(i,J)*vstar(i,J))) ) ) - visc%TKE_BBL(i,j) = (((G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + & + visc%TKE_BBL(i,j) = GV%Z_to_m * & + (((G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + & G%areaCu(I,j) * (ustar(I)*u2_bbl(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*v2_bbl(i,J-1)) + & - G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J))))*G%IareaT(i,j)) + G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J))) )*G%IareaT(i,j)) enddo enddo !$OMP end parallel @@ -2125,20 +2126,20 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp call get_param(param_file, mdl, "DISSIPATION_MIN", CS%dissip_min, & "The minimum dissipation by which to determine a lower \n"//& - "bound of Kd (a floor).", units="W m-3", default=0.0) + "bound of Kd (a floor).", units="W m-3", default=0.0, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "DISSIPATION_N0", CS%dissip_N0, & "The intercept when N=0 of the N-dependent expression \n"//& "used to set a minimum dissipation by which to determine \n"//& "a lower bound of Kd (a floor): A in eps_min = A + B*N.", & - units="W m-3", default=0.0) + units="W m-3", default=0.0, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "DISSIPATION_N1", CS%dissip_N1, & "The coefficient multiplying N, following Gargett, used to \n"//& "set a minimum dissipation by which to determine a lower \n"//& "bound of Kd (a floor): B in eps_min = A + B*N", & - units="J m-3", default=0.0) + units="J m-3", default=0.0, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "DISSIPATION_KD_MIN", CS%dissip_Kd_min, & "The minimum vertical diffusivity applied as a floor.", & - units="m2 s-1", default=0.0) + units="m2 s-1", default=0.0, scale=GV%m_to_Z**2) CS%limit_dissipation = (CS%dissip_min>0.) .or. (CS%dissip_N1>0.) .or. & (CS%dissip_N0>0.) .or. (CS%dissip_Kd_min>0.) From 7575e39e3dacb4d950b6ef9c61e2c950c3b35308 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 5 Oct 2018 14:48:41 -0400 Subject: [PATCH 0799/1072] Swapped argument attribute order Altered the order of the attributes of the new argument to match the other arguments. The code is syntactically equivalent. --- config_src/solo_driver/atmos_ocean_fluxes.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/solo_driver/atmos_ocean_fluxes.F90 b/config_src/solo_driver/atmos_ocean_fluxes.F90 index 76c0941c18..4a4ddf6da3 100644 --- a/config_src/solo_driver/atmos_ocean_fluxes.F90 +++ b/config_src/solo_driver/atmos_ocean_fluxes.F90 @@ -22,7 +22,7 @@ function aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index, integer, optional, intent(in) :: atm_tr_index !< An unused argument real, dimension(:), optional, intent(in) :: param !< An unused argument logical, dimension(:), optional, intent(in) :: flag !< An unused argument - real, intent(in), optional :: mol_wt !< An unused argument + real, optional, intent(in) :: mol_wt !< An unused argument character(len=*), optional, intent(in) :: ice_restart_file !< An unused argument character(len=*), optional, intent(in) :: ocean_restart_file !< An unused argument character(len=*), optional, intent(in) :: units !< An unused argument From 6a47a23f9db3587162cb84623483367e3ad88f4f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 6 Oct 2018 06:34:04 -0400 Subject: [PATCH 0800/1072] Recast diffusivity in energetic_PBL into Z2 s-1 Rescaled the internal representation of diffusivities in energetic_PBL from m2 s-1 to Z2 s-1, and related lengths from m to Z and vstar from m s-1 to Z s-1 all for greater dimensional consistency testing. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_energetic_PBL.F90 | 51 ++++++++++--------- 1 file changed, 27 insertions(+), 24 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index a105bfa6e3..04cf148d16 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -52,8 +52,8 @@ module MOM_energetic_PBL !! energy is converted to a turbulent velocity, relative to !! mechanically forced turbulent kinetic energy, nondim. !! Making this larger increases the diffusivity. - real :: vstar_scale_fac !< An overall nondimensional scaling factor for vstar. - !! Making this larger increases the diffusivity. + real :: vstar_scale_fac !< An overall nondimensional scaling factor for vstar times a unit + !! conversion factor. Making this larger increases the diffusivity. real :: Ekman_scale_coef !< A nondimensional scaling factor controlling the inhibition of the !! diffusive length scale by rotation. Making this larger decreases !! the diffusivity in the planetary boundary layer. @@ -63,7 +63,7 @@ module MOM_energetic_PBL !! value of 0.1 might be better justified by observations. real :: MLD_tol !< A tolerance for determining the boundary layer thickness when !! Use_MLD_iteration is true, in m. - real :: min_mix_len !< The minimum mixing length scale that will be used by ePBL, in m. + real :: min_mix_len !< The minimum mixing length scale that will be used by ePBL, in Z. !! The default (0) does not set a minimum. real :: N2_Dissipation_Scale_Neg !< A nondimensional scaling factor controlling the loss of TKE !! due to enhanced dissipation in the presence of negative (unstable) @@ -354,7 +354,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & real :: LA ! The Langmuir number (non-dim) real :: LAmod ! A modified Langmuir number accounting for other parameters. real :: hbs_here ! The local minimum of hb_hs and MixLen_shape, times a - ! conversion factor from H to M, in m H-1. + ! conversion factor from H to Z, in Z H-1. real :: nstar_FC ! The fraction of conv_PErel that can be converted to mixing, nondim. real :: TKE_reduc ! The fraction by which TKE and other energy fields are ! reduced to support mixing, nondim. between 0 and 1. @@ -373,7 +373,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & real :: dPE_conv ! The convective change in column potential energy, in J m-2. real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K), in J m-2. real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K), in J m-2 H-1. - real :: Kd_guess0, PE_chg_g0, dPEa_dKd_g0, Kddt_h_g0 + real :: Kd_guess0 ! A first guess of the diapycnal diffusivity, in Z2 s-1. + real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 + real :: dPEa_dKd_g0 + real :: Kddt_h_g0 ! The first guess diapycnal diffusivity times a timestep divided + ! by the average thicknesses around a layer, in H (m or kg m-2). real :: PE_chg_max ! The maximum PE change for very large values of Kddt_h(K). real :: dPEc_dKd_Kd0 ! The partial derivative of PE change with Kddt_h(K) ! for very small values of Kddt_h(K), in J m-2 H-1. @@ -663,7 +667,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & pres(i,1) = 0.0 do k=1,nz dMass = GV%H_to_kg_m2 * h(i,k) - dPres = (GV%g_Earth*GV%m_to_Z) * dMass + dPres = (GV%g_Earth*GV%m_to_Z) * dMass ! This is equivalent to GV%H_to_Pa * h(i,k) dT_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dT(i,j,k) dS_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dS(i,j,k) dT_to_dColHt(i,k) = dMass * dSV_dT(i,j,k) @@ -955,7 +959,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & dSe_t2 = Kddt_h(K-1) * ((S0(k-2) - S0(k-1)) + dSe(k-2)) endif endif - dt_h = (GV%m_to_H**2*dt) / max(0.5*(h(i,k-1)+h(i,k)), 1e-15*h_sum(i)) + dt_h = (GV%Z_to_H**2*dt) / max(0.5*(h(i,k-1)+h(i,k)), 1e-15*h_sum(i)) ! This tests whether the layers above and below this interface are in ! a convetively stable configuration, without considering any effects of @@ -1045,13 +1049,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & TKE_here = mech_TKE(i) + CS%wstar_ustar_coef*conv_PErel(i) if (TKE_here > 0.0) then vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 - hbs_here = GV%H_to_m * min(hb_hs(i,K), MixLen_shape(K)) + hbs_here = GV%H_to_Z * min(hb_hs(i,K), MixLen_shape(K)) Mixing_Length_Used(k) = MAX(CS%min_mix_len,((h_tt*hbs_here)*vstar) / & ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar)) !Note setting Kd_guess0 to Mixing_Length_Used(K) here will ! change the answers. Therefore, skipping that. if (.not.CS%Use_MLD_Iteration) then - Kd_guess0 = vstar * vonKar * ((h_tt*hbs_here)*vstar) / & + Kd_guess0 = vstar * vonKar * ((h_tt*hbs_here)*vstar) / & ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar) else Kd_guess0 = vstar * vonKar * Mixing_Length_Used(k) @@ -1097,16 +1101,16 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & TKE_here = mech_TKE(i) + CS%wstar_ustar_coef*(conv_PErel(i)-PE_chg_max) if (TKE_here > 0.0) then vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 - hbs_here = GV%H_to_m * min(hb_hs(i,K), MixLen_shape(K)) + hbs_here = GV%H_to_Z * min(hb_hs(i,K), MixLen_shape(K)) Mixing_Length_Used(k) = max(CS%min_mix_len,((h_tt*hbs_here)*vstar) / & ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar)) if (.not.CS%Use_MLD_Iteration) then ! Note again (as prev) that using Mixing_Length_Used here ! instead of redoing the computation will change answers... - Kd(i,k) = vstar * vonKar * ((h_tt*hbs_here)*vstar) / & + Kd(i,k) = vstar * vonKar * ((h_tt*hbs_here)*vstar) / & ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar) else - Kd(i,k) = vstar * vonKar * Mixing_Length_Used(k) + Kd(i,k) = vstar * vonKar * Mixing_Length_Used(k) endif else vstar = 0.0 ; Kd(i,k) = 0.0 @@ -1362,7 +1366,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & !This is how the iteration was original conducted do k=2,nz if (FIRST_OBL) then !Breaks when OBL found - if (Vstar_Used(k) > 1.e-10 .and. k < nz) then + if (Vstar_Used(k) > 1.e-10*GV%m_to_Z .and. k < nz) then MLD_FOUND = MLD_FOUND + h(i,k-1)*GV%H_to_m else FIRST_OBL = .false. @@ -1474,7 +1478,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif do K=1,nz+1 ; do i=is,ie - Kd_int(i,j,K) = GV%m_to_Z**2 * Kd(i,K) + Kd_int(i,j,K) = Kd(i,K) enddo ; enddo enddo ! j-loop @@ -1923,18 +1927,17 @@ subroutine get_LA_windsea(ustar, hbl, GV, LA) call ust_2_u10_coare3p5(ustar*sqrt(GV%Rho0/1.225),U10,GV) ! surface Stokes drift us = us_to_u10*u10 - ! - ! significant wave height from Pierson-Moskowitz - ! spectrum (Bouws, 1998) + + ! significant wave height from Pierson-Moskowitz spectrum (Bouws, 1998) hm0 = 0.0246 *u10**2 - ! + ! peak frequency (PM, Bouws, 1998) tmp = 2.0 * PI * u19p5_to_u10 * u10 fp = 0.877 * (GV%g_Earth*GV%m_to_Z) / tmp - ! + ! mean frequency fm = fm_to_fp * fp - ! + ! total Stokes transport (a factor r_loss is applied to account ! for the effect of directional spreading, multidirectional waves ! and the use of PM peak frequency and PM significant wave height @@ -2100,7 +2103,7 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "VSTAR_SCALE_FACTOR", CS%vstar_scale_fac, & "An overall nondimensional scaling factor for v*. \n"// & "Making this larger decreases the PBL diffusivity.", & - units="nondim", default=1.0) + units="nondim", default=1.0, scale=GV%m_to_Z) call get_param(param_file, mdl, "EKMAN_SCALE_COEF", CS%Ekman_scale_coef, & "A nondimensional scaling factor controlling the inhibition \n"// & "of the diffusive length scale by rotation. Making this larger \n"//& @@ -2124,7 +2127,7 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "EPBL_MIN_MIX_LEN", CS%min_mix_len, & "The minimum mixing length scale that will be used \n"//& "by ePBL. The default (0) does not set a minimum.", & - units="meter", default=0.0) + units="meter", default=0.0, scale=GV%m_to_Z) call get_param(param_file, mdl, "EPBL_ORIGINAL_PE_CALC", CS%orig_PE_calc, & "If true, the ePBL code uses the original form of the \n"// & "potential energy change code. Otherwise, the newer \n"// & @@ -2224,9 +2227,9 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) CS%id_Hsfc_used = register_diag_field('ocean_model', 'ePBL_Hs_used', diag%axesT1, & Time, 'Surface region thickness that is used', 'm') CS%id_Mixing_Length = register_diag_field('ocean_model', 'Mixing_Length', diag%axesTi, & - Time, 'Mixing Length that is used', 'm') + Time, 'Mixing Length that is used', 'm', conversion=GV%Z_to_m) CS%id_Velocity_Scale = register_diag_field('ocean_model', 'Velocity_Scale', diag%axesTi, & - Time, 'Velocity Scale that is used.', 'm s-1') + Time, 'Velocity Scale that is used.', 'm s-1', conversion=GV%Z_to_m) CS%id_LT_enhancement = register_diag_field('ocean_model', 'LT_Enhancement', diag%axesT1, & Time, 'LT enhancement that is used.', 'nondim') CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, & From e69a9d861543f95235ed355cc1e33b00bd119045 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 6 Oct 2018 06:36:10 -0400 Subject: [PATCH 0801/1072] Added missing unit conversion factor for Kd_layer Added a missing diagnostic conversion argument in the register_diag_field call for Kd_layer. This does not alter answers, but will change a diagnostic when Z_RESCALE_POWER is not 0. --- src/parameterizations/vertical/MOM_set_diffusivity.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 52df0e0f72..3ca3d22fba 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -2148,7 +2148,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp CS%dissip_N2 = CS%dissip_Kd_min * GV%Rho0 / CS%FluxRi_max CS%id_Kd_layer = register_diag_field('ocean_model', 'Kd_layer', diag%axesTL, Time, & - 'Diapycnal diffusivity of layers (as set)', 'm2 s-1') + 'Diapycnal diffusivity of layers (as set)', 'm2 s-1', conversion=GV%Z_to_m**2) if (CS%tm_csp%Int_tide_dissipation .or. CS%tm_csp%Lee_wave_dissipation .or. & From a546ea079097f5f9ca68298ec0f76939a22f4b88 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 6 Oct 2018 06:39:34 -0400 Subject: [PATCH 0802/1072] Calculate diagnostics in Z instead of H Changed several diatnostics to be stored internally in units of Z or Z2 s-1, and then converted from Z to m via the diag manager, to avoid any conversions in the special case when Z_RESCALE_POWER=0 for efficiency in that special limit. All answers are bitwise identical. --- .../vertical/MOM_bulk_mixed_layer.F90 | 30 +++++++++---------- .../vertical/MOM_entrain_diffusive.F90 | 14 ++++----- 2 files changed, 22 insertions(+), 22 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index a851eee838..eb7dae1590 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -305,7 +305,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & integer, dimension(SZI_(G),SZK_(GV)) :: & ksort ! The sorted k-index that each original layer goes to. real, dimension(SZI_(G),SZJ_(G)) :: & - h_miss ! The summed absolute mismatch, in H. + h_miss ! The summed absolute mismatch, in Z. real, dimension(SZI_(G)) :: & TKE, & ! The turbulent kinetic energy available for mixing over a ! time step, in Z m2 s-2. @@ -374,12 +374,12 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & ! adjustment, Z m2 s-2. real, dimension(SZI_(G),SZJ_(G)) :: & Hsfc_max, & ! The thickness of the surface region (mixed and buffer layers) - ! after entrainment but before any buffer layer detrainment, H. + ! after entrainment but before any buffer layer detrainment, in Z. Hsfc_used, & ! The thickness of the surface region after buffer layer - ! detrainment, in units of H. + ! detrainment, in units of Z. Hsfc_min, & ! The minimum thickness of the surface region based on the ! new mixed layer depth and the previous thickness of the - ! neighboring water columns, in H. + ! neighboring water columns, in Z. h_sum, & ! The total thickness of the water column, in H. hmbl_prev ! The previous thickness of the mixed and buffer layers, in H. real, dimension(SZI_(G)) :: & @@ -671,14 +671,14 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & hmbl_prev(i,j-1) - dHD*min(h_sum(i,j),h_sum(i,j-1)), & hmbl_prev(i,j+1) - dHD*min(h_sum(i,j),h_sum(i,j+1))) ) - Hsfc_min(i,j) = max(h(i,0), min(Hsfc(i), H_nbr)) + Hsfc_min(i,j) = GV%H_to_Z * max(h(i,0), min(Hsfc(i), H_nbr)) if (CS%limit_det) max_BL_det(i) = max(0.0, Hsfc(i)-H_nbr) enddo endif if (CS%id_Hsfc_max > 0) then ; do i=is,ie - Hsfc_max(i,j) = Hsfc(i) + Hsfc_max(i,j) = GV%H_to_Z * Hsfc(i) enddo ; endif endif @@ -702,9 +702,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & if (CS%id_Hsfc_used > 0) then - do i=is,ie ; Hsfc_used(i,j) = h(i,0) ; enddo + do i=is,ie ; Hsfc_used(i,j) = GV%H_to_Z * h(i,0) ; enddo do k=CS%nkml+1,nkmb ; do i=is,ie - Hsfc_used(i,j) = Hsfc_used(i,j) + h(i,k) + Hsfc_used(i,j) = Hsfc_used(i,j) + GV%H_to_Z * h(i,k) enddo ; enddo endif @@ -788,15 +788,15 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & if (CS%id_h_mismatch > 0) then do i=is,ie - h_miss(i,j) = abs(h_3d(i,j,1) - (h_orig(i,1) + & + h_miss(i,j) = GV%H_to_Z * abs(h_3d(i,j,1) - (h_orig(i,1) + & (eaml(i,1) + (ebml(i,1) - eaml(i,1+1))))) enddo do k=2,nz-1 ; do i=is,ie - h_miss(i,j) = h_miss(i,j) + abs(h_3d(i,j,k) - (h_orig(i,k) + & + h_miss(i,j) = h_miss(i,j) + GV%H_to_Z * abs(h_3d(i,j,k) - (h_orig(i,k) + & ((eaml(i,k) - ebml(i,k-1)) + (ebml(i,k) - eaml(i,k+1))))) enddo ; enddo do i=is,ie - h_miss(i,j) = h_miss(i,j) + abs(h_3d(i,j,nz) - (h_orig(i,nz) + & + h_miss(i,j) = h_miss(i,j) + GV%H_to_Z * abs(h_3d(i,j,nz) - (h_orig(i,nz) + & ((eaml(i,nz) - ebml(i,nz-1)) + ebml(i,nz)))) enddo endif @@ -3744,13 +3744,13 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) Time, 'Spurious source of potential energy from mixed layer only detrainment', & 'W m-2', conversion=GV%Z_to_m) CS%id_h_mismatch = register_diag_field('ocean_model', 'h_miss_ML', diag%axesT1, & - Time, 'Summed absolute mismatch in entrainment terms', 'm', conversion=GV%H_to_m) + Time, 'Summed absolute mismatch in entrainment terms', 'm', conversion=GV%Z_to_m) CS%id_Hsfc_used = register_diag_field('ocean_model', 'Hs_used', diag%axesT1, & - Time, 'Surface region thickness that is used', 'm', conversion=GV%H_to_m) + Time, 'Surface region thickness that is used', 'm', conversion=GV%Z_to_m) CS%id_Hsfc_max = register_diag_field('ocean_model', 'Hs_max', diag%axesT1, & - Time, 'Maximum surface region thickness', 'm', conversion=GV%H_to_m) + Time, 'Maximum surface region thickness', 'm', conversion=GV%Z_to_m) CS%id_Hsfc_min = register_diag_field('ocean_model', 'Hs_min', diag%axesT1, & - Time, 'Minimum surface region thickness', 'm', conversion=GV%H_to_m) + Time, 'Minimum surface region thickness', 'm', conversion=GV%Z_to_m) !CS%lim_det_dH_sfc = 0.5 ; CS%lim_det_dH_bathy = 0.2 ! Technically these should not get used if limit_det is false? if (CS%limit_det .or. (CS%id_Hsfc_min > 0)) then call get_param(param_file, mdl, "LIMIT_BUFFER_DET_DH_SFC", CS%lim_det_dH_sfc, & diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 6bd8aa484f..4ddde1060c 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -806,23 +806,23 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & endif ! correct_density if (CS%id_Kd > 0) then - Idt = 1.0 / dt + Idt = GV%H_to_Z**2 / dt do k=2,nz-1 ; do i=is,ie if (k 0) then - g_2dt = 0.5 * (GV%H_to_Z*GV%H_to_m) * (GV%g_Earth / dt) + g_2dt = 0.5 * GV%H_to_Z**2 * (GV%g_Earth / dt) do i=is,ie ; diff_work(i,j,1) = 0.0 ; diff_work(i,j,nz+1) = 0.0 ; enddo if (associated(tv%eqn_of_state)) then if (associated(fluxes%p_surf)) then @@ -2189,9 +2189,9 @@ subroutine entrain_diffusive_init(Time, G, GV, param_file, diag, CS) units="m", default=MAX(100.0*GV%Angstrom_m,1.0e-4*sqrt(dt*Kd)), scale=GV%m_to_H) CS%id_Kd = register_diag_field('ocean_model', 'Kd_effective', diag%axesTL, Time, & - 'Diapycnal diffusivity as applied', 'm2 s-1') + 'Diapycnal diffusivity as applied', 'm2 s-1', conversion=GV%Z_to_m**2) CS%id_diff_work = register_diag_field('ocean_model', 'diff_work', diag%axesTi, Time, & - 'Work actually done by diapycnal diffusion across each interface', 'W m-2') + 'Work actually done by diapycnal diffusion across each interface', 'W m-2', conversion=GV%Z_to_m) end subroutine entrain_diffusive_init From 21a9e4ba0459d25c2fe1fca2fb594fbe66166068 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 6 Oct 2018 09:39:05 -0400 Subject: [PATCH 0803/1072] +Recast energetic_PBL to work in units of Z Recast the internal calculations in energetic_PBL to use units of Z for dimensional consistency testing. As a part of these chages, a new GV argument was added to energetic_PBL_get_MLD, along with an optional argument to specify the output units for MLD. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_diabatic_driver.F90 | 4 +- .../vertical/MOM_energetic_PBL.F90 | 175 +++++++++--------- 2 files changed, 93 insertions(+), 86 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 76a64f932a..b111322df3 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -733,7 +733,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! If visc%MLD exists, copy the ePBL's MLD into it if (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G) + call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, GV) call pass_var(visc%MLD, G%domain, halo=1) Hml(:,:) = visc%MLD(:,:) endif @@ -1708,7 +1708,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! If visc%MLD exists, copy the ePBL's MLD into it if (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G) + call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, GV) call pass_var(visc%MLD, G%domain, halo=1) Hml(:,:) = visc%MLD(:,:) endif diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 04cf148d16..cd27295045 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -62,7 +62,7 @@ module MOM_energetic_PBL !! boundary layer thickness. The default is 0, but a !! value of 0.1 might be better justified by observations. real :: MLD_tol !< A tolerance for determining the boundary layer thickness when - !! Use_MLD_iteration is true, in m. + !! Use_MLD_iteration is true, in Z. real :: min_mix_len !< The minimum mixing length scale that will be used by ePBL, in Z. !! The default (0) does not set a minimum. real :: N2_Dissipation_Scale_Neg !< A nondimensional scaling factor controlling the loss of TKE @@ -145,8 +145,8 @@ module MOM_energetic_PBL diag_TKE_conv_decay, & !< The decay of convective TKE, in J m-2. diag_TKE_mixing,& !< The work done by TKE to deepen the mixed layer, in J m-2. ! Additional output parameters also 2d - ML_depth, & !< The mixed layer depth in m. (result after iteration step) - ML_depth2, & !< The mixed layer depth in m. (guess for iteration step) + ML_depth, & !< The mixed layer depth in Z. (result after iteration step) + ML_depth2, & !< The mixed layer depth in Z. (guess for iteration step) Enhance_M, & !< The enhancement to the turbulent velocity scale (non-dim) MSTAR_MIX, & !< Mstar used in EPBL MSTAR_LT, & !< Mstar for Langmuir turbulence @@ -335,9 +335,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & real :: dt_h ! The timestep divided by the averages of the thicknesses around ! a layer, times a thickness conversion factor, in H s m-2. real :: h_bot ! The distance from the bottom, in H. - real :: h_rsum ! The running sum of h from the top, in H. + real :: h_rsum ! The running sum of h from the top, in Z. real :: I_hs ! The inverse of h_sum, in H-1. - real :: I_mld ! The inverse of the current value of MLD, in H-1. + real :: I_MLD ! The inverse of the current value of MLD, in Z-1. real :: h_tt ! The distance from the surface or up to the next interface ! that did not exhibit turbulent mixing from this scheme plus ! a surface mixing roughness length given by h_tt_min, in H. @@ -347,7 +347,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & real :: vonKar ! The vonKarman constant. real :: I_dtrho ! 1.0 / (dt * Rho0) in m3 kg-1 s-1. This is ! used convert TKE back into ustar^3. - real :: U_star ! The surface friction velocity, in m s-1. + real :: U_star ! The surface friction velocity, in Z s-1. real :: U_Star_Mean ! The surface friction without gustiness in m s-1. real :: vstar ! An in-situ turbulent velocity, in m s-1. real :: Enhance_M ! An enhancement factor for vstar, based here on Langmuir impact. @@ -406,18 +406,17 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & real :: dt__diag ! A copy of dt_diag (if present) or dt, in s. real :: IdtdR0 ! = 1.0 / (dt__diag * Rho0), in m3 kg-1 s-1. real, dimension(SZI_(G),SZJ_(G)) :: & - Hsfc_used ! The thickness of the surface region after buffer layer + Hsfc_used ! The thickness of the surface region in Z logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. - ! detrainment, in units of m. ! Local column copies of energy change diagnostics, all in J m-2. real :: dTKE_conv, dTKE_forcing, dTKE_mixing real :: dTKE_MKE, dTKE_mech_decay, dTKE_conv_decay !---------------------------------------------------------------------- !/BGR added Aug24,2016 for adding iteration to get boundary layer depth ! - needed to compute new mixing length. - real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration, in m. - real :: max_MLD, min_MLD ! Iteration bounds, in m, which are adjusted at each step + real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration, in Z. + real :: max_MLD, min_MLD ! Iteration bounds, in Z, which are adjusted at each step ! - These are initialized based on surface/bottom ! 1. The iteration guesses a value (possibly from ! prev step or neighbor). @@ -465,29 +464,29 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & integer, save :: NOTCONVERGED! !-End BGR iteration parameters----------------------------------------- real :: N2_dissipation - real :: Bf_STABLE ! Buoyancy flux, capped at 0 (negative only) + real :: Bf_STABLE ! Buoyancy flux, capped at 0 (negative only) real :: Bf_UNSTABLE ! Buoyancy flux, floored at 0 (positive only) - real :: STAB_SCALE ! Composite of Stabilizing length scales: - ! Ekman scale and Monin-Obukhov scale. - real :: iL_Ekman ! Inverse of Ekman length scale - real :: iL_Obukhov ! Inverse of Obukhov length scale + real :: Stab_Scale ! Composite of stabilizing Ekman scale and Monin-Obukhov length scales, in Z + real :: iL_Ekman ! Inverse of Ekman length scale, in Z-1 + real :: iL_Obukhov ! Inverse of Obukhov length scale, in Z-1 real :: MLD_o_Ekman ! > real :: MLD_o_Obukhov_stab ! Ratios of length scales where MLD is boundary layer depth real :: Ekman_o_Obukhov_stab ! > real :: MLD_o_Obukhov_un ! Ratios of length scales where MLD is boundary layer depth real :: Ekman_o_Obukhov_un ! > - real :: C_MO = 1. ! Constant in STAB_SCALE for Monin-Obukhov - real :: C_EK = 2. ! Constant in STAB_SCALE for Ekman length - real :: MLD_over_STAB ! Mixing layer depth divided by STAB_SCALE - real :: MSTAR_MIX! The value of mstar (Proportionality of TKE to drive mixing to ustar + real :: C_MO = 1. ! Constant in Stab_Scale for Monin-Obukhov + real :: C_EK = 2. ! Constant in Stab_Scale for Ekman length + real :: MLD_over_STAB ! Mixing layer depth divided by Stab_Scale + real :: MSTAR_MIX ! The value of mstar (Proportionality of TKE to drive mixing to ustar ! cubed) which is computed as a function of latitude, boundary layer depth, ! and the Monin-Obukhov depth. - real :: MSTAR_LT ! The added mstar contribution due to Langmuir turbulence + real :: MSTAR_LT ! The added mstar contribution due to Langmuir turbulence real :: MSTAR_Conv_Adj ! Adjustment made to mstar due to convection reducing mechanical mixing. real :: MSTAR_STAB, MSTAR_ROT ! Mstar in each limit, max is used. logical :: debug=.false. ! Change this hard-coded value for debugging. -! The following arrays are used only for debugging purposes. + + ! The following arrays are used only for debugging purposes. real :: dPE_debug, mixing_debug, taux2, tauy2 real, dimension(20) :: TKE_left_itt, PE_chg_itt, Kddt_h_itt, dPEa_dKd_itt, MKE_src_itt real, dimension(SZI_(G),SZK_(GV)) :: & @@ -552,7 +551,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & !!OMP TKE_forced,debug,H_neglect,dSV_dT, & !!OMP dSV_dS,I_dtrho,C1_3,h_tt_min,vonKar, & !!OMP max_itt,Kd_int) & -!!OMP private(i,j,k,h,u,v,T,S,Kd,mech_TKE_k,conv_PErel_k, & +!!OMP private(i,j,k,h,u,v,T,S,Kd,mech_TKE_k,conv_PErel_k, & !!OMP U_Star,absf,mech_TKE,conv_PErel,nstar_k, & !!OMP h_sum,I_hs,h_bot,hb_hs,T0,S0,num_itts, & !!OMP pres,dMass,dPres,dT_to_dPE,dS_to_dPE, & @@ -584,8 +583,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & Kd(i,K) = 0.0 enddo ; enddo do i=is,ie - CS%ML_depth(i,j) = h(i,1)*GV%H_to_m - !CS%ML_depth2(i,j) = h(i,1)*GV%H_to_m + CS%ML_depth(i,j) = h(i,1)*GV%H_to_Z + !CS%ML_depth2(i,j) = h(i,1)*GV%H_to_Z sfc_connected(i) = .true. enddo @@ -601,17 +600,17 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & ! interface. do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then - U_Star = fluxes%ustar(i,j) + U_star = GV%m_to_Z*fluxes%ustar(i,j) U_Star_Mean = fluxes%ustar_gustless(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & - U_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & - fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) + U_star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & + fluxes%frac_shelf_h(i,j) * GV%m_to_Z*fluxes%ustar_shelf(i,j) endif if (U_Star < CS%ustar_min) U_Star = CS%ustar_min ! Computing Bf w/ limiters. - Bf_Stable = max(0.0,buoy_Flux(i,j)) ! Positive for stable - Bf_Unstable = min(0.0,buoy_flux(i,j)) ! Negative for unstable + Bf_Stable = max(0.0, GV%m_to_Z**2 * buoy_Flux(i,j)) ! Positive for stable + Bf_Unstable = min(0.0, GV%m_to_Z**2 * buoy_flux(i,j)) ! Negative for unstable if (CS%omega_frac >= 1.0) then ; absf(i) = 2.0*CS%omega else absf(i) = 0.25*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & @@ -621,13 +620,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif ! Computing stability scale which correlates with TKE for mixing, where ! TKE for mixing = TKE production minus TKE dissipation - Stab_Scale = u_star**2 / ( VonKar * ( C_MO * BF_Stable/u_star - C_EK * u_star * absf(i))) + Stab_Scale = U_star**2 / ( VonKar * ( C_MO * BF_Stable / U_star - C_EK * U_star * absf(i))) ! Inverse of Ekman and Obukhov - iL_Ekman = absf(i)/U_star - iL_Obukhov = buoy_flux(i,j)*vonkar/U_Star**3 + iL_Ekman = absf(i) / U_star + iL_Obukhov = GV%m_to_Z**2 * buoy_flux(i,j)*vonkar / (U_star**3) if (CS%Mstar_Mode == CS%CONST_MSTAR) then - mech_TKE(i) = (dt*CS%mstar*GV%Rho0)*((U_Star**3)) + mech_TKE(i) = (dt*CS%mstar*GV%Rho0) * GV%Z_to_m**3 * U_star**3 conv_PErel(i) = 0.0 if (CS%TKE_diagnostics) then @@ -689,18 +688,18 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & !/The following lines are for the iteration over MLD !{ ! max_MLD will initialized as ocean bottom depth - max_MLD = 0.0 ; do k=1,nz ; max_MLD = max_MLD + h(i,k)*GV%H_to_m ; enddo + max_MLD = 0.0 ; do k=1,nz ; max_MLD = max_MLD + h(i,k)*GV%H_to_Z ; enddo min_MLD = 0.0 !min_MLD will initialize as 0. !/BGR: May add user-input bounds for max/min MLD !/BGR: Add MLD_guess based on stored previous value. ! note that this is different from ML_Depth already ! computed by EPBL, need to figure out why. - if (CS%MLD_iteration_guess .and. CS%ML_Depth2(i,j) > 1.) then + if (CS%MLD_iteration_guess .and. (CS%ML_Depth2(i,j) > 1.0*GV%m_to_Z)) then !If prev value is present use for guess. - MLD_guess=CS%ML_Depth2(i,j) + MLD_guess = CS%ML_Depth2(i,j) else - !Otherwise guess middle of water column (or stab_scale if smaller). + !Otherwise guess middle of water column (or Stab_Scale if smaller). MLD_guess = 0.5 * (min_MLD+max_MLD) endif @@ -713,8 +712,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & do OBL_IT=1,MAX_OBL_IT ; if (.not. OBL_CONVERGED) then ! Reset ML_depth - CS%ML_depth(i,j) = h(i,1)*GV%H_to_m - !CS%ML_depth2(i,j) = h(i,1)*GV%H_to_m + CS%ML_depth(i,j) = h(i,1)*GV%H_to_Z + !CS%ML_depth2(i,j) = h(i,1)*GV%H_to_Z sfc_connected(i) = .true. @@ -746,8 +745,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif elseif (CS%MSTAR_MODE == CS%EKMAN_o_OBUKHOV) then !### Please refrain from using the construct A / B / C in place of A/(B*C). - mstar_STAB = CS%MSTAR_COEF*sqrt(Bf_Stable/u_star**2/(absf(i)+1.e-10)) - mstar_ROT = CS%C_EK*log(max(1.,u_star/(absf(i)+1.e-10)/mld_guess)) + mstar_STAB = CS%MSTAR_COEF*sqrt(Bf_Stable / U_star**2 / (absf(i)+1.e-10)) + mstar_ROT = CS%C_EK * log(max(1., U_star / (absf(i)+1.e-10) / MLD_guess)) if ( CS%MSTAR_CAP <= 0.0) then !No cap. MSTAR_MIX = max(mstar_STAB,& ! 1st term if balance of rotation and stabilizing ! the balance is f(L_Ekman,L_Obukhov) @@ -770,18 +769,18 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & ! Adjustment for unstable buoyancy flux. ! Convection reduces mechanical mixing because there ! is less density gradient to mix. (Statically unstable near surface) - MSTAR_Conv_Adj = 1. - CS%CNV_MST_FAC * (-BF_Unstable+1.e-10) / & - ( (-Bf_Unstable+1.e-10)+ & - 2. *MSTAR_MIX *U_STAR**3 / MLD_GUESS ) + MSTAR_Conv_Adj = 1. - CS%CNV_MST_FAC * (-BF_Unstable + 1.e-10*GV%m_to_Z**2) / & + ( (-Bf_Unstable + 1.e-10*GV%m_to_Z**2) + & + 2.0 *MSTAR_MIX * U_star**3 / MLD_guess ) if (CS%USE_LT) then - call get_Langmuir_Number( LA, G, GV, abs(MLD_guess), u_star_mean, I, J, & + call get_Langmuir_Number( LA, G, GV, abs(GV%Z_to_m*MLD_guess), u_star_mean, i, j, & H=H(i,:), U_H=U(i,:), V_H=V(i,:), WAVES=WAVES) ! 2. Get parameters for modified LA - MLD_o_Ekman = abs(MLD_guess*iL_Ekman) - MLD_o_Obukhov_stab = abs(max(0.,MLD_guess*iL_Obukhov)) - MLD_o_Obukhov_un = abs(min(0.,MLD_guess*iL_Obukhov)) - Ekman_o_Obukhov_stab = abs(max(0.,iL_Obukhov/(iL_Ekman+1.e-10))) - Ekman_o_Obukhov_un = abs(min(0.,iL_Obukhov/(iL_Ekman+1.e-10))) + MLD_o_Ekman = abs(MLD_guess * iL_Ekman) + MLD_o_Obukhov_stab = abs(max(0., MLD_guess*iL_Obukhov)) + MLD_o_Obukhov_un = abs(min(0., MLD_guess*iL_Obukhov)) + Ekman_o_Obukhov_stab = abs(max(0., iL_Obukhov / (iL_Ekman + 1.e-10*GV%Z_to_m))) + Ekman_o_Obukhov_un = abs(min(0., iL_Obukhov / (iL_Ekman + 1.e-10*GV%Z_to_m))) ! 3. Adjust LA based on various parameters. ! Assumes linear factors based on length scale ratios to adjust LA ! Note when these coefficients are set to 0 recovers simple LA. @@ -805,7 +804,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif endif !Reset mech_tke and conv_perel values (based on new mstar) - mech_TKE(i) = ( MSTAR_mix * MSTAR_conv_adj * ENHANCE_M + MSTAR_LT) * (dt*GV%Rho0*U_Star**3) + mech_TKE(i) = ( MSTAR_mix * MSTAR_conv_adj * ENHANCE_M + MSTAR_LT) * & + GV%Z_to_m**3 * (dt*GV%Rho0*U_star**3) conv_PErel(i) = 0.0 if (CS%TKE_diagnostics) then CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + mech_TKE(i) * IdtdR0 @@ -856,7 +856,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & I_MLD = 1.0 / MLD_guess ; h_rsum = 0.0 MixLen_shape(1) = 1.0 do K=2,nz+1 - h_rsum = h_rsum + h(i,k-1)*GV%H_to_m + h_rsum = h_rsum + h(i,k-1)*GV%H_to_Z if (CS%MixLenExponent==2.0)then MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**2!CS%MixLenExponent @@ -888,7 +888,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & ! different rates. The following form is often used for mechanical ! stirring from the surface, perhaps due to breaking surface gravity ! waves and wind-driven turbulence. - Idecay_len_TKE(i) = (CS%TKE_decay * absf(i) / U_Star) * GV%H_to_m + Idecay_len_TKE(i) = (CS%TKE_decay * absf(i) / U_star) * GV%H_to_Z exp_kh = 1.0 if (Idecay_len_TKE(i) > 0.0) exp_kh = exp(-h(i,k-1)*Idecay_len_TKE(i)) if (CS%TKE_diagnostics) & @@ -1149,8 +1149,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0 endif if (sfc_connected(i)) then - CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_m * h(i,k) - !CS%ML_depth2(i,j) = CS%ML_depth2(i,J) + GV%H_to_m * h(i,k) + CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_Z * h(i,k) + ! CS%ML_depth2(i,j) = CS%ML_depth2(i,J) + GV%H_to_Z * h(i,k) endif Kddt_h(K) = Kd(i,k)*dt_h @@ -1174,8 +1174,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & mech_TKE(i) = TKE_reduc*(mech_TKE(i) + MKE_src) conv_PErel(i) = TKE_reduc*conv_PErel(i) if (sfc_connected(i)) then - CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_m * h(i,k) - !CS%ML_depth2(i,J) = CS%ML_depth2(i,J) + GV%H_to_m * h(i,k) + CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_Z * h(i,k) + ! CS%ML_depth2(i,J) = CS%ML_depth2(i,J) + GV%H_to_Z * h(i,k) endif elseif (tot_TKE == 0.0) then ! This can arise if nstar_FC = 0. @@ -1277,7 +1277,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif if (sfc_connected(i)) CS%ML_depth(i,J) = CS%ML_depth(i,J) + & - (PE_chg / PE_chg_g0) * GV%H_to_m * h(i,k) + (PE_chg / PE_chg_g0) * GV%H_to_Z * h(i,k) tot_TKE = 0.0 ; mech_TKE(i) = 0.0 ; conv_PErel(i) = 0.0 sfc_disconnect = .true. endif @@ -1361,18 +1361,18 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & ITmin(obl_it) = min_MLD ! Track min } For debug purpose ITguess(obl_it) = MLD_guess ! Track guess } !/ - MLD_FOUND=0.0 ; FIRST_OBL=.true. + MLD_found = 0.0 ; FIRST_OBL = .true. if (CS%Orig_MLD_iteration) then !This is how the iteration was original conducted do k=2,nz if (FIRST_OBL) then !Breaks when OBL found - if (Vstar_Used(k) > 1.e-10*GV%m_to_Z .and. k < nz) then - MLD_FOUND = MLD_FOUND + h(i,k-1)*GV%H_to_m + if ((Vstar_Used(k) > 1.e-10*GV%m_to_Z) .and. k < nz) then + MLD_found = MLD_found + h(i,k-1)*GV%H_to_Z else FIRST_OBL = .false. - if (MLD_FOUND-CS%MLD_tol > MLD_guess) then + if (MLD_found - CS%MLD_tol > MLD_guess) then min_MLD = MLD_guess - elseif ((MLD_guess-MLD_FOUND) < max(CS%MLD_tol,h(i,k-1)*GV%H_to_m)) then + elseif ((MLD_guess - MLD_found) < max(CS%MLD_tol,h(i,k-1)*GV%H_to_Z)) then OBL_CONVERGED = .true.!Break convergence loop if (OBL_IT_STATS) then !Compute iteration statistics MAXIT = max(MAXIT,obl_it) @@ -1390,10 +1390,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & enddo else !New method uses ML_DEPTH as computed in ePBL routine - MLD_FOUND=CS%ML_DEPTH(i,j) - if (MLD_FOUND-CS%MLD_tol > MLD_guess) then + MLD_found = CS%ML_Depth(i,j) + if (MLD_found - CS%MLD_tol > MLD_guess) then min_MLD = MLD_guess - elseif (abs(MLD_guess-MLD_FOUND) < (CS%MLD_tol)) then + elseif (abs(MLD_guess - MLD_found) < CS%MLD_tol) then OBL_CONVERGED = .true.!Break convergence loop if (OBL_IT_STATS) then !Compute iteration statistics MAXIT = max(MAXIT,obl_it) @@ -1408,8 +1408,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif endif ! For next pass, guess average of minimum and maximum values. - MLD_guess = min_MLD*0.5 + max_MLD*0.5 - ITresult(obl_it) = MLD_FOUND + MLD_guess = 0.5*(min_MLD + max_MLD) + ITresult(obl_it) = MLD_found endif ; enddo ! Iteration loop for converged boundary layer thickness. if (.not.OBL_CONVERGED) then !/Temp output, warn that EPBL didn't converge @@ -1452,9 +1452,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & if (allocated(CS%Enhance_M)) CS%Enhance_M(i,j) = Enhance_M if (allocated(CS%mstar_mix)) CS%mstar_mix(i,j) = MSTAR_MIX if (allocated(CS%mstar_lt)) CS%mstar_lt(i,j) = MSTAR_LT - if (allocated(CS%MLD_Obukhov)) CS%MLD_Obukhov(i,j) = (MLD_guess*iL_Obukhov) - if (allocated(CS%MLD_Ekman)) CS%MLD_Ekman(i,j) = (MLD_guess*iL_Ekman) - if (allocated(CS%Ekman_Obukhov)) CS%Ekman_Obukhov(i,j) = (iL_Obukhov/(iL_Ekman+1.e-10)) + if (allocated(CS%MLD_Obukhov)) CS%MLD_Obukhov(i,j) = MLD_guess * iL_Obukhov + if (allocated(CS%MLD_Ekman)) CS%MLD_Ekman(i,j) = MLD_guess * iL_Ekman + if (allocated(CS%Ekman_Obukhov)) CS%Ekman_Obukhov(i,j) = iL_Obukhov / (iL_Ekman + 1.e-10*GV%Z_to_m) if (allocated(CS%La)) CS%La(i,j) = LA if (allocated(CS%La_mod)) CS%La_mod(i,j) = LAmod else @@ -1471,9 +1471,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif ; enddo ; ! Close of i-loop - Note unusual loop order! if (CS%id_Hsfc_used > 0) then - do i=is,ie ; Hsfc_used(i,j) = h(i,1)*GV%H_to_m ; enddo + do i=is,ie ; Hsfc_used(i,j) = h(i,1)*GV%H_to_Z ; enddo do k=2,nz ; do i=is,ie - if (Kd(i,K) > 0.0) Hsfc_used(i,j) = Hsfc_used(i,j) + h(i,k)*GV%H_to_m + if (Kd(i,K) > 0.0) Hsfc_used(i,j) = Hsfc_used(i,j) + h(i,k)*GV%H_to_Z enddo ; enddo endif @@ -1830,15 +1830,22 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & end subroutine find_PE_chg_orig !> Copies the ePBL active mixed layer depth into MLD -subroutine energetic_PBL_get_MLD(CS, MLD, G) +subroutine energetic_PBL_get_MLD(CS, MLD, G, GV, m_to_MLD_units) type(energetic_PBL_CS), pointer :: CS !< Control structure for ePBL type(ocean_grid_type), intent(in) :: G !< Grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: MLD !< Depth of ePBL active mixing layer + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: MLD !< Depth of ePBL active mixing layer, in m + real, optional, intent(in) :: m_to_MLD_units !< A conversion factor to the desired units for MLD ! Local variables + real :: scale ! A dimensional rescaling factor integer :: i,j + + scale = GV%Z_to_m ; if (present(m_to_MLD_units)) scale = scale * m_to_MLD_units + do j = G%jsc, G%jec ; do i = G%isc, G%iec - MLD(i,j) = CS%ML_depth(i,j) + MLD(i,j) = scale*CS%ML_Depth(i,j) enddo ; enddo + end subroutine energetic_PBL_get_MLD !> Computes wind speed from ustar_air based on COARE 3.5 Cd relationship @@ -1923,8 +1930,8 @@ subroutine get_LA_windsea(ustar, hbl, GV, LA) real :: pi, u10 pi = 4.0*atan(1.0) if (ustar > 0.0) then - ! Computing u10 based on u_star and COARE 3.5 relationships - call ust_2_u10_coare3p5(ustar*sqrt(GV%Rho0/1.225),U10,GV) + ! Computing u10 based on ustar and COARE 3.5 relationships + call ust_2_u10_coare3p5(ustar * sqrt(GV%Rho0/1.225), U10, GV) ! surface Stokes drift us = us_to_u10*u10 @@ -2123,7 +2130,7 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "EPBL_MLD_TOLERANCE", CS%MLD_tol, & "The tolerance for the iteratively determined mixed \n"// & "layer depth. This is only used with USE_MLD_ITERATION.", & - units="meter", default=1.0) + units="meter", default=1.0, scale=GV%m_to_Z) call get_param(param_file, mdl, "EPBL_MIN_MIX_LEN", CS%min_mix_len, & "The minimum mixing length scale that will be used \n"//& "by ePBL. The default (0) does not set a minimum.", & @@ -2201,13 +2208,13 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) units="nondim", default=0.95) endif ! This gives a minimum decay scale that is typically much less than Angstrom. - CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_m + GV%H_to_m*GV%H_subroundoff) - call log_param(param_file, mdl, "EPBL_USTAR_MIN", CS%ustar_min, & + CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) + call log_param(param_file, mdl, "EPBL_USTAR_MIN", CS%ustar_min*GV%Z_to_m, & "The (tiny) minimum friction velocity used within the \n"//& "ePBL code, derived from OMEGA and ANGSTROM.", units="m s-1") CS%id_ML_depth = register_diag_field('ocean_model', 'ePBL_h_ML', diag%axesT1, & - Time, 'Surface boundary layer depth', 'm', & + Time, 'Surface boundary layer depth', 'm', conversion=GV%Z_to_m, & cmor_long_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme') CS%id_TKE_wind = register_diag_field('ocean_model', 'ePBL_TKE_wind', diag%axesT1, & Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3') @@ -2225,7 +2232,7 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) CS%id_TKE_conv_decay = register_diag_field('ocean_model', 'ePBL_TKE_conv_decay', diag%axesT1, & Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3') CS%id_Hsfc_used = register_diag_field('ocean_model', 'ePBL_Hs_used', diag%axesT1, & - Time, 'Surface region thickness that is used', 'm') + Time, 'Surface region thickness that is used', 'm', conversion=GV%m_to_Z) CS%id_Mixing_Length = register_diag_field('ocean_model', 'Mixing_Length', diag%axesTi, & Time, 'Mixing Length that is used', 'm', conversion=GV%Z_to_m) CS%id_Velocity_Scale = register_diag_field('ocean_model', 'Velocity_Scale', diag%axesTi, & @@ -2235,7 +2242,7 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, & Time, 'MSTAR that is used.', 'nondim') CS%id_OSBL = register_diag_field('ocean_model', 'ePBL_OSBL', diag%axesT1, & - Time, 'ePBL Surface Boundary layer depth.', 'm') + Time, 'ePBL Surface Boundary layer depth.', 'm', conversion=GV%m_to_Z) ! BGR (9/21/2017) Note that ePBL_OSBL is the guess for iteration step while ePBL_h_ML is ! result from iteration step. CS%id_mld_ekman = register_diag_field('ocean_model', 'MLD_EKMAN', diag%axesT1, & From 2743a41343bfb283ef8e126f986d7cef8c6d29d1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 6 Oct 2018 11:24:10 -0400 Subject: [PATCH 0804/1072] +Changed the units of SkinBuoyFlux to Z2 s-3 Changed the units of SkinBuoyFlux in diabatic and Buoy_flux in energetic_PBL from m2 s-3 to Z2 s-3 for dimensional consistency testing. All answers are bitwise identical, including rescaling Z over a large range. --- src/parameterizations/vertical/MOM_diabatic_aux.F90 | 4 ++-- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 6 ++---- src/parameterizations/vertical/MOM_energetic_PBL.F90 | 8 ++++---- 3 files changed, 8 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 90332c1b85..119e3dbb30 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -790,7 +790,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & optional, intent(out) :: dSV_dS !< Partial derivative of specific volume with !! salinity, in m3 kg-1 / (g kg-1). real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface in m2 s-3 + optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface in Z2 s-3 ! Local variables integer, parameter :: maxGroundings = 5 @@ -1256,7 +1256,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & ! 3. Convert to a buoyancy flux, excluding penetrating SW heating ! BGR-Jul 5, 2017: The contribution of SW heating here needs investigated for ePBL. do i=is,ie - SkinBuoyFlux(i,j) = - GoRho * GV%H_to_Z * ( & + SkinBuoyFlux(i,j) = - GoRho * GV%H_to_Z * GV%m_to_Z**2 * ( & dRhodS(i) * (netSalt_rate(i) - tv%S(i,j,1)*netMassInOut_rate(i)) + & dRhodT(i) * ( netHeat_rate(i) + netPen(i,1)) ) ! m^2/s^3 enddo diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index b111322df3..a82cb12e44 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -300,13 +300,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & cTKE, & ! convective TKE requirements for each layer in J/m^2. u_h, & ! zonal and meridional velocities at thickness points after v_h ! entrainment (m/s) - real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & - cn ! baroclinic gravity wave speeds (formerly cg1 - BDM) - + cn ! baroclinic gravity wave speeds real, dimension(SZI_(G),SZJ_(G)) :: & Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges - SkinBuoyFlux! 2d surface buoyancy flux (m2/s3), used by ePBL + SkinBuoyFlux! 2d surface buoyancy flux (Z2/s3), used by ePBL real, dimension(SZI_(G),SZJ_(G),G%ke) :: h_diag ! diagnostic array for thickness real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp real, dimension(SZI_(G),SZJ_(G),G%ke) :: saln_diag ! diagnostic array for salinity diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index cd27295045..b82c697b8d 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -214,7 +214,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous !! call to mixedlayer_init. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: Buoy_Flux !< The surface buoyancy flux. in m2/s3. + intent(in) :: Buoy_Flux !< The surface buoyancy flux in Z2/s3. real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less !! than dt if there are two callse to !! mixedlayer, in s. @@ -609,8 +609,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif if (U_Star < CS%ustar_min) U_Star = CS%ustar_min ! Computing Bf w/ limiters. - Bf_Stable = max(0.0, GV%m_to_Z**2 * buoy_Flux(i,j)) ! Positive for stable - Bf_Unstable = min(0.0, GV%m_to_Z**2 * buoy_flux(i,j)) ! Negative for unstable + Bf_Stable = max(0.0, buoy_Flux(i,j)) ! Positive for stable + Bf_Unstable = min(0.0, buoy_flux(i,j)) ! Negative for unstable if (CS%omega_frac >= 1.0) then ; absf(i) = 2.0*CS%omega else absf(i) = 0.25*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & @@ -623,7 +623,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & Stab_Scale = U_star**2 / ( VonKar * ( C_MO * BF_Stable / U_star - C_EK * U_star * absf(i))) ! Inverse of Ekman and Obukhov iL_Ekman = absf(i) / U_star - iL_Obukhov = GV%m_to_Z**2 * buoy_flux(i,j)*vonkar / (U_star**3) + iL_Obukhov = buoy_flux(i,j)*vonkar / (U_star**3) if (CS%Mstar_Mode == CS%CONST_MSTAR) then mech_TKE(i) = (dt*CS%mstar*GV%Rho0) * GV%Z_to_m**3 * U_star**3 From bb6ddb5a8a4f5fc8c4ce6b666af46a200394411e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 6 Oct 2018 11:31:44 -0400 Subject: [PATCH 0805/1072] +Recast find_N2_bottom to work in units of Z Recast the internal calculations in find_N2_bottom to use units of Z for dimensional consistency testing. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- .../vertical/MOM_internal_tide_input.F90 | 22 +++++++++---------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 4a59b9f610..b8e6abb4c4 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -46,7 +46,7 @@ module MOM_int_tide_input type, public :: int_tide_input_type real, allocatable, dimension(:,:) :: & TKE_itidal_input, & !< The internal tide TKE input at the bottom of the ocean, in W m-2. - h2, & !< The squared topographic roughness height, in m2. + h2, & !< The squared topographic roughness height, in Z2. tideamp, & !< The amplitude of the tidal velocities, in m s-1. Nb !< The bottom stratification, in s-1. end type int_tide_input_type @@ -128,7 +128,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot) !! smooth out the values in thin layers, in degC. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_f !< Salinity after vertical filtering to !! smooth out the values in thin layers, in PSU. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h2 !< Bottom topographic roughness, in m2 + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h2 !< Bottom topographic roughness, in Z2 type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes type(int_tide_input_CS), pointer :: CS !< This module's control structure. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: N2_bot !< The squared buoyancy freqency at the @@ -141,19 +141,19 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot) Temp_int, & ! The temperature at each interface, in degC. Salin_int, & ! The salinity at each interface, in PSU. drho_bot, & - h_amp, & - hb, & - z_from_bot, & + h_amp, & ! The amplitude of topographic roughness, in Z. + hb, & ! The depth below a layer, in Z. + z_from_bot, & ! The height of a layer center above the bottom, in Z. dRho_dT, & ! The partial derivatives of density with temperature and dRho_dS ! salinity, in kg m-3 degC-1 and kg m-3 PSU-1. - real :: dz_int ! The thickness associated with an interface, in m. + real :: dz_int ! The thickness associated with an interface, in Z. real :: G_Rho0 ! The gravitation acceleration divided by the Boussinesq - ! density, in m4 s-2 kg-1. + ! density, in Z m3 s-2 kg-1. logical :: do_i(SZI_(G)), do_any integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - G_Rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 + G_Rho0 = (GV%g_Earth*GV%m_to_Z**2) / GV%Rho0 ! Find the (limited) density jump across each interface. do i=is,ie @@ -194,7 +194,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot) ! Find the bottom boundary layer stratification. do i=is,ie hb(i) = 0.0 ; dRho_bot(i) = 0.0 - z_from_bot(i) = 0.5*GV%H_to_m*h(i,j,nz) + z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz) do_i(i) = (G%mask2dT(i,j) > 0.5) h_amp(i) = sqrt(h2(i,j)) enddo @@ -202,7 +202,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot) do k=nz,2,-1 do_any = .false. do i=is,ie ; if (do_i(i)) then - dz_int = 0.5*GV%H_to_m*(h(i,j,k) + h(i,j,k-1)) + dz_int = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j,k-1)) z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above hb(i) = hb(i) + dz_int @@ -211,7 +211,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot) if (z_from_bot(i) > h_amp(i)) then if (k>2) then ! Always include at least one full layer. - hb(i) = hb(i) + 0.5*GV%H_to_m*(h(i,j,k-1) + h(i,j,k-2)) + hb(i) = hb(i) + 0.5*GV%H_to_Z*(h(i,j,k-1) + h(i,j,k-2)) dRho_bot(i) = dRho_bot(i) + dRho_int(i,K-1) endif do_i(i) = .false. From 6197f8beee58c5e0e82edc24f52f551a4de92a69 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 6 Oct 2018 13:54:31 -0400 Subject: [PATCH 0806/1072] +Made GV a required argument to initialize_sponge Made GV a required argument to initialize_sponge to facilitate dimensional consistency checking and removed the internal copy of eta_Z_to_m. All answers are bitwise identical. --- src/parameterizations/vertical/MOM_sponge.F90 | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index 70f7a9216d..8bb8fa3ef3 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -54,7 +54,6 @@ module MOM_sponge !! coordinate-density is being damped, in kg m-3. real, pointer :: Ref_eta(:,:) => NULL() !< The value toward which the interface !! heights are being damped, in depth units (Z). - real :: eta_Z_to_m !< The conversion factor between the units for depths (Z) and m. type(p3d) :: var(MAX_FIELDS_) !< Pointers to the fields that are being damped. type(p2d) :: Ref_val(MAX_FIELDS_) !< The values to which the fields are damped. @@ -90,8 +89,7 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(sponge_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module - type(verticalGrid_type), & - optional, intent(in) :: GV !< The ocean's vertical grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZJ_(G)), & optional, intent(in) :: Iresttime_i_mean !< The inverse of the restoring time for !! the zonal mean properties, in s-1. @@ -135,8 +133,6 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & ! CS%bulkmixedlayer may be set later via a call to set_up_sponge_ML_density. CS%bulkmixedlayer = .false. - CS%eta_Z_to_m = 1.0 ; if (present(GV)) CS%eta_Z_to_m = GV%Z_to_m - CS%num_col = 0 ; CS%fldno = 0 do j=G%jsc,G%jec ; do i=G%isc,G%iec if ((Iresttime(i,j)>0.0) .and. (G%mask2dT(i,j)>0)) & @@ -385,9 +381,6 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) call MOM_error(FATAL, "Rml must be provided to apply_sponge when using "//& "a bulk mixed layer.") - if (CS%eta_Z_to_m /= GV%Z_to_m) call MOM_error(FATAL, & - "There are inconsistent depth units between calls to set_up_sponge and apply_sponge.") - if ((CS%id_w_sponge > 0) .or. CS%do_i_mean_sponge) then do k=1,nz+1 ; do j=js,je ; do i=is,ie w_int(i,j,K) = 0.0 From 7b8cb07d6f48c9f2ea8159f6a8e8c3390a2f5c07 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 8 Oct 2018 11:45:44 -0400 Subject: [PATCH 0807/1072] +Recast MOM_kappa_shear to work in units of Z Recast the internal calculations in MOM_kappa_shear to use units of Z and Z2 s-1 in place of m and m2 s-1 for dimensional consistency testing. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a range from Z_RESCALE_POWER=-93 to 8. For larger values of Z_RESCALE_POWER, there are subtle round-off level changes in some of the single column test cases, for which I suspect underflow in TKE may be the culprit, but this nees further investigation. --- .../vertical/MOM_kappa_shear.F90 | 321 +++++++++--------- 1 file changed, 163 insertions(+), 158 deletions(-) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index a6613ed39b..2ee8a0bdc6 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -50,7 +50,7 @@ module MOM_kappa_shear !! the buoyancy and shear scales in the diffusivity !! equation, 0 to eliminate the shear scale. Nondim. real :: TKE_bg !< The background level of TKE, in m2 s-2. - real :: kappa_0 !< The background diapycnal diffusivity, in m2 s-1. + real :: kappa_0 !< The background diapycnal diffusivity, in Z2 s-1. real :: kappa_tol_err !< The fractional error in kappa that is tolerated. real :: Prandtl_turb !< Prandtl number used to convert Kd_shear into viscosity. integer :: nkml !< The number of layers in the mixed layer, as @@ -126,31 +126,31 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & h_2d, & ! A 2-D version of h, but converted to m. u_2d, v_2d, T_2d, S_2d, rho_2d ! 2-D versions of u_in, v_in, T, S, and rho. real, dimension(SZI_(G),SZK_(GV)+1) :: & - kappa_2d, tke_2d ! 2-D versions of various kappa_io and tke_io. + kappa_2d, tke_2d ! 2-D versions of various kappa_io and tke_io. real, dimension(SZK_(GV)) :: & u, & ! The zonal velocity after a timestep of mixing, in m s-1. v, & ! The meridional velocity after a timestep of mixing, in m s-1. - Idz, & ! The inverse of the distance between TKE points, in m. + Idz, & ! The inverse of the distance between TKE points, in Z-1. T, & ! The potential temperature after a timestep of mixing, in C. Sal, & ! The salinity after a timestep of mixing, in psu. - dz, & ! The layer thickness, in m. - u0xdz, & ! The initial zonal velocity times dz, in m2 s-1. - v0xdz, & ! The initial meridional velocity times dz, in m2 s-1. - T0xdz, & ! The initial temperature times dz, in C m. - S0xdz ! The initial salinity times dz, in PSU m. + dz, & ! The layer thickness, in Z. + u0xdz, & ! The initial zonal velocity times dz, in Z m s-1. + v0xdz, & ! The initial meridional velocity times dz, in Z m s-1. + T0xdz, & ! The initial temperature times dz, in C Z. + S0xdz ! The initial salinity times dz, in PSU Z. real, dimension(SZK_(GV)+1) :: & kappa, & ! The shear-driven diapycnal diffusivity at an interface, in - ! units of m2 s-1. + ! units of Z2 s-1. tke, & ! The Turbulent Kinetic Energy per unit mass at an interface, ! in units of m2 s-2. - kappa_avg, & ! The time-weighted average of kappa, in m2 s-1. + kappa_avg, & ! The time-weighted average of kappa, in Z2 s-1. tke_avg ! The time-weighted average of TKE, in m2 s-2. real :: f2 ! The squared Coriolis parameter of each column, in s-2. real :: surface_pres ! The top surface pressure, in Pa. - real :: dz_in_lay ! The running sum of the thickness in a layer, in m. - real :: k0dt ! The background diffusivity times the timestep, in m2. - real :: dz_massless ! A layer thickness that is considered massless, in m. + real :: dz_in_lay ! The running sum of the thickness in a layer, in Z. + real :: k0dt ! The background diffusivity times the timestep, in Z2. + real :: dz_massless ! A layer thickness that is considered massless, in Z. logical :: use_temperature ! If true, temperature and salinity have been ! allocated and are being used as state variables. logical :: new_kappa = .true. ! If true, ignore the value of kappa from the @@ -176,7 +176,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & integer :: max_debug_itt ; parameter(max_debug_itt=20) real :: wt(SZK_(GV)+1), wt_tot, I_wt_tot, wt_itt real, dimension(SZK_(GV)+1) :: & - Ri_k, tke_prev, dtke, dkappa, dtke_norm, & + Ri_k, tke_prev, dtke, dkap, dtke_norm, & ksrc_av ! The average through the iterations of k_src, in s-1. real, dimension(SZK_(GV)+1,0:max_debug_itt) :: & tke_it1, N2_it1, Sh2_it1, ksrc_it1, kappa_it1, kprev_it1 @@ -193,9 +193,6 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & use_temperature = .false. ; if (associated(tv%T)) use_temperature = .true. new_kappa = .true. ; if (present(initialize_all)) new_kappa = initialize_all -! Ri_crit = CS%Rino_crit -! gR0 = GV%Rho0*(GV%g_Earth*GV%m_to_Z) ; g_R0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 - k0dt = dt*CS%kappa_0 dz_massless = 0.1*sqrt(k0dt) @@ -206,7 +203,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & !$OMP tv,G,GV,CS,kappa_io,dz_massless,k0dt,p_surf,dt,tke_io,kv_io) do j=js,je do k=1,nz ; do i=is,ie - h_2d(i,k) = h(i,j,k)*GV%H_to_m + h_2d(i,k) = h(i,j,k)*GV%H_to_Z u_2d(i,k) = u_in(i,j,k) ; v_2d(i,k) = v_in(i,j,k) enddo ; enddo if (use_temperature) then ; do k=1,nz ; do i=is,ie @@ -215,7 +212,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & rho_2d(i,k) = GV%Rlay(k) ! Could be tv%Rho(i,j,k) ? enddo ; enddo ; endif if (.not.new_kappa) then ; do K=1,nz+1 ; do i=is,ie - kappa_2d(i,K) = GV%Z_to_m**2*kappa_io(i,j,K) + kappa_2d(i,K) = kappa_io(i,j,K) enddo ; enddo ; endif !--------------------------------------- @@ -294,7 +291,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- if (new_kappa) then - do K=1,nzc+1 ; kappa(K) = 1.0 ; enddo + do K=1,nzc+1 ; kappa(K) = GV%m_to_Z**2*1.0 ; enddo else do K=1,nzc+1 ; kappa(K) = kappa_2d(i,K) ; enddo endif @@ -327,8 +324,8 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & #ifdef ADD_DIAGNOSTICS I_Ld2_2d(i,1) = 0.0 ; dz_Int_2d(i,1) = dz_Int(1) do K=2,nzc - I_Ld2_2d(i,K) = (N2(K) / CS%lambda**2 + f2) / & - max(TKE(K),1e-30) + I_L2_bdry(K) + I_Ld2_2d(i,K) = I_L2_bdry(K) + & + (N2(K) / CS%lambda**2 + f2) * Z2_to_L2 / (max(TKE(K),1e-30)) dz_Int_2d(i,K) = dz_Int(K) enddo I_Ld2_2d(i,nzc+1) = 0.0 ; dz_Int_2d(i,nzc+1) = dz_Int(nzc+1) @@ -348,9 +345,9 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & endif ; enddo ! i-loop do K=1,nz+1 ; do i=is,ie - kappa_io(i,j,K) = GV%m_to_Z**2 * G%mask2dT(i,j) * kappa_2d(i,K) + kappa_io(i,j,K) = G%mask2dT(i,j) * kappa_2d(i,K) tke_io(i,j,K) = G%mask2dT(i,j) * tke_2d(i,K) - kv_io(i,j,K) = GV%m_to_Z**2 * ( G%mask2dT(i,j) * kappa_2d(i,K) ) * CS%Prandtl_turb + kv_io(i,j,K) = ( G%mask2dT(i,j) * kappa_2d(i,K) ) * CS%Prandtl_turb #ifdef ADD_DIAGNOSTICS I_Ld2_3d(i,j,K) = I_Ld2_2d(i,K) dz_Int_3d(i,j,K) = dz_Int_2d(i,K) @@ -419,33 +416,33 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ h_2d, & ! A 2-D version of h, but converted to m. u_2d, v_2d, T_2d, S_2d, rho_2d ! 2-D versions of u_in, v_in, T, S, and rho. real, dimension(SZIB_(G),SZK_(GV)+1,2) :: & - kappa_2d ! Quasi 2-D versions of kappa_io, in m2 s-1. + kappa_2d ! Quasi 2-D versions of kappa_io, in Z2 s-1. real, dimension(SZIB_(G),SZK_(GV)+1) :: & tke_2d ! 2-D version tke_io in m2 s-2. real, dimension(SZK_(GV)) :: & u, & ! The zonal velocity after a timestep of mixing, in m s-1. v, & ! The meridional velocity after a timestep of mixing, in m s-1. - Idz, & ! The inverse of the distance between TKE points, in m. + Idz, & ! The inverse of the distance between TKE points, in Z-1. T, & ! The potential temperature after a timestep of mixing, in C. Sal, & ! The salinity after a timestep of mixing, in psu. - dz, & ! The layer thickness, in m. - u0xdz, & ! The initial zonal velocity times dz, in m2 s-1. - v0xdz, & ! The initial meridional velocity times dz, in m2 s-1. - T0xdz, & ! The initial temperature times dz, in C m. - S0xdz ! The initial salinity times dz, in PSU m. + dz, & ! The layer thickness, in Z. + u0xdz, & ! The initial zonal velocity times dz, in m Z s-1. + v0xdz, & ! The initial meridional velocity times dz, in m Z s-1. + T0xdz, & ! The initial temperature times dz, in C Z. + S0xdz ! The initial salinity times dz, in PSU Z. real, dimension(SZK_(GV)+1) :: & kappa, & ! The shear-driven diapycnal diffusivity at an interface, in ! units of m2 s-1. tke, & ! The Turbulent Kinetic Energy per unit mass at an interface, ! in units of m2 s-2. - kappa_avg, & ! The time-weighted average of kappa, in m2 s-1. + kappa_avg, & ! The time-weighted average of kappa, in Z2 s-1. tke_avg ! The time-weighted average of TKE, in m2 s-2. real :: f2 ! The squared Coriolis parameter of each column, in s-2. real :: surface_pres ! The top surface pressure, in Pa. - real :: dz_in_lay ! The running sum of the thickness in a layer, in m. - real :: k0dt ! The background diffusivity times the timestep, in m2. - real :: dz_massless ! A layer thickness that is considered massless, in m. + real :: dz_in_lay ! The running sum of the thickness in a layer, in Z. + real :: k0dt ! The background diffusivity times the timestep, in Z2. + real :: dz_massless ! A layer thickness that is considered massless, in Z. real :: I_hwt ! The inverse of the masked thickness weights, in H-1. real :: I_Prandtl logical :: use_temperature ! If true, temperature and salinity have been @@ -491,9 +488,6 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ use_temperature = .false. ; if (associated(tv%T)) use_temperature = .true. new_kappa = .true. ; if (present(initialize_all)) new_kappa = initialize_all -! Ri_crit = CS%Rino_crit -! gR0 = GV%Rho0*(GV%g_Earth*GV%m_to_Z) ; g_R0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 - k0dt = dt*CS%kappa_0 dz_massless = 0.1*sqrt(k0dt) I_Prandtl = 0.0 ; if (CS%Prandtl_turb > 0.0) I_Prandtl = 1.0 / CS%Prandtl_turb @@ -529,19 +523,19 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ((G%mask2dT(i+1,j) * h(i+1,j,k)) * S_in(i+1,j,k) + & (G%mask2dT(i,j+1) * h(i,j+1,k)) * S_in(i,j+1,k)) ) * I_hwt endif - h_2d(I,k) = GV%H_to_m * ((G%mask2dT(i,j) * h(i,j,k) + G%mask2dT(i+1,j+1) * h(i+1,j+1,k)) + & + h_2d(I,k) = GV%H_to_Z * ((G%mask2dT(i,j) * h(i,j,k) + G%mask2dT(i+1,j+1) * h(i+1,j+1,k)) + & (G%mask2dT(i+1,j) * h(i+1,j,k) + G%mask2dT(i,j+1) * h(i,j+1,k)) ) / & ((G%mask2dT(i,j) + G%mask2dT(i+1,j+1)) + & (G%mask2dT(i+1,j) + G%mask2dT(i,j+1)) + 1.0e-36 ) -! h_2d(I,k) = 0.25*((h(i,j,k) + h(i+1,j+1,k)) + (h(i+1,j,k) + h(i,j+1,k)))*GV%H_to_m +! h_2d(I,k) = 0.25*((h(i,j,k) + h(i+1,j+1,k)) + (h(i+1,j,k) + h(i,j+1,k)))*GV%H_to_Z ! h_2d(I,k) = ((h(i,j,k)**2 + h(i+1,j+1,k)**2) + & -! (h(i+1,j,k)**2 + h(i,j+1,k)**2))*GV%H_to_m * I_hwt +! (h(i+1,j,k)**2 + h(i,j+1,k)**2))*GV%H_to_Z * I_hwt enddo ; enddo if (.not.use_temperature) then ; do k=1,nz ; do I=IsB,IeB rho_2d(I,k) = GV%Rlay(k) enddo ; enddo ; endif if (.not.new_kappa) then ; do K=1,nz+1 ; do I=IsB,IeB - kappa_2d(I,K,J2) = GV%Z_to_m**2 * kv_io(I,J,K) * I_Prandtl + kappa_2d(I,K,J2) = kv_io(I,J,K) * I_Prandtl enddo ; enddo ; endif !--------------------------------------- @@ -623,7 +617,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- if (new_kappa) then - do K=1,nzc+1 ; kappa(K) = 1.0 ; enddo + do K=1,nzc+1 ; kappa(K) = GV%m_to_Z**2*1.0 ; enddo else do K=1,nzc+1 ; kappa(K) = kappa_2d(I,K,J2) ; enddo endif @@ -656,8 +650,8 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ #ifdef ADD_DIAGNOSTICS I_Ld2_2d(I,1) = 0.0 ; dz_Int_2d(I,1) = dz_Int(1) do K=2,nzc - I_Ld2_2d(I,K) = (N2(K) / CS%lambda**2 + f2) / & - max(TKE(K),1e-30) + I_L2_bdry(K) + I_Ld2_2d(I,K) = I_L2_bdry(K) + & + (N2(K) / CS%lambda**2 + f2) * Z2_to_L2 / (max(TKE(K),1e-30)) dz_Int_2d(I,K) = dz_Int(K) enddo I_Ld2_2d(I,nzc+1) = 0.0 ; dz_Int_2d(I,nzc+1) = dz_Int(nzc+1) @@ -678,7 +672,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ do K=1,nz+1 ; do I=IsB,IeB tke_io(I,J,K) = G%mask2dBu(I,J) * tke_2d(I,K) - kv_io(I,J,K) = GV%m_to_Z**2 * ( G%mask2dBu(I,J) * kappa_2d(I,K,J2) ) * CS%Prandtl_turb + kv_io(I,J,K) = ( G%mask2dBu(I,J) * kappa_2d(I,K,J2) ) * CS%Prandtl_turb #ifdef ADD_DIAGNOSTICS I_Ld2_3d(I,J,K) = I_Ld2_2d(I,K) dz_Int_3d(I,J,K) = dz_Int_2d(I,K) @@ -686,7 +680,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ enddo ; enddo if (J>=G%jsc) then ; do K=1,nz+1 ; do i=G%isc,G%iec ! Set the diffusivities in tracer columns from the values at vertices. - kappa_io(i,j,K) = GV%m_to_Z**2 * G%mask2dT(i,j) * 0.25 * & + kappa_io(i,j,K) = G%mask2dT(i,j) * 0.25 * & ((kappa_2d(I-1,K,J2m1) + kappa_2d(I,K,J2)) + & (kappa_2d(I-1,K,J2) + kappa_2d(I,K,J2m1))) enddo ; enddo ; endif @@ -714,7 +708,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & tke_avg, tv, CS, GV) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZK_(GV)+1), & - intent(inout) :: kappa !< The time-weighted average of kappa, in m2 s-1. + intent(inout) :: kappa !< The time-weighted average of kappa, in Z2 s-1. real, dimension(SZK_(GV)+1), & intent(inout) :: tke !< The Turbulent Kinetic Energy per unit mass at !! an interface, in units of m2 s-2. @@ -722,17 +716,17 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real, intent(in) :: f2 !< The square of the Coriolis parameter, in s-2. real, intent(in) :: surface_pres !< The surface pressure, in Pa. real, dimension(SZK_(GV)), & - intent(in) :: dz !< The layer thickness, in m. + intent(in) :: dz !< The layer thickness, in Z. real, dimension(SZK_(GV)), & - intent(in) :: u0xdz !< The initial zonal velocity times dz, in m2 s-1. + intent(in) :: u0xdz !< The initial zonal velocity times dz, in Z m s-1. real, dimension(SZK_(GV)), & - intent(in) :: v0xdz !< The initial meridional velocity times dz, in m2 s-1. + intent(in) :: v0xdz !< The initial meridional velocity times dz, in Z m s-1. real, dimension(SZK_(GV)), & - intent(in) :: T0xdz !< The initial temperature times dz, in C m. + intent(in) :: T0xdz !< The initial temperature times dz, in C Z. real, dimension(SZK_(GV)), & - intent(in) :: S0xdz !< The initial salinity times dz, in PSU m. + intent(in) :: S0xdz !< The initial salinity times dz, in PSU Z. real, dimension(SZK_(GV)+1), & - intent(out) :: kappa_avg !< The time-weighted average of kappa, in m2 s-1. + intent(out) :: kappa_avg !< The time-weighted average of kappa, in Z2 s-1. real, dimension(SZK_(GV)+1), & intent(out) :: tke_avg !< The time-weighted average of TKE, in m2 s-2. real, intent(in) :: dt !< Time increment, in s. @@ -745,7 +739,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real, dimension(nzc) :: & u, & ! The zonal velocity after a timestep of mixing, in m s-1. v, & ! The meridional velocity after a timestep of mixing, in m s-1. - Idz, & ! The inverse of the distance between TKE points, in m. + Idz, & ! The inverse of the distance between TKE points, in Z-1. T, & ! The potential temperature after a timestep of mixing, in C. Sal, & ! The salinity after a timestep of mixing, in psu. u_test, v_test, T_test, S_test @@ -753,46 +747,46 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real, dimension(nzc+1) :: & N2, & ! The squared buoyancy frequency at an interface, in s-2. dz_Int, & ! The extent of a finite-volume space surrounding an interface, - ! as used in calculating kappa and TKE, in m. + ! as used in calculating kappa and TKE, in Z. I_dz_int, & ! The inverse of the distance between velocity & density points - ! above and below an interface, in m-1. This is used to + ! above and below an interface, in Z-1. This is used to ! calculate N2, shear, and fluxes, and it might differ from ! 1/dz_Int, as they have different uses. S2, & ! The squared shear at an interface, in s-2. a1, & ! a1 is the coupling between adjacent interfaces in the TKE, - ! velocity, and density equations, in m s-1 or m. + ! velocity, and density equations, in Z s-1 or Z. c1, & ! c1 is used in the tridiagonal (and similar) solvers. k_src, & ! The shear-dependent source term in the kappa equation, in s-1. kappa_src, & ! The shear-dependent source term in the kappa equation in s-1. - kappa_out, & ! The kappa that results from the kappa equation, in m2 s-1. + kappa_out, & ! The kappa that results from the kappa equation, in Z2 s-1. kappa_mid, & ! The average of the initial and predictor estimates of kappa, - ! in units of m2 s-1. + ! in units of Z2 s-1. tke_pred, & ! The value of TKE from a predictor step, in m2 s-2. - kappa_pred, & ! The value of kappa from a predictor step, in m2 s-1. + kappa_pred, & ! The value of kappa from a predictor step, in Z2 s-1. pressure, & ! The pressure at an interface, in Pa. T_int, & ! The temperature interpolated to an interface, in C. Sal_int, & ! The salinity interpolated to an interface, in psu. dbuoy_dT, & ! The partial derivatives of buoyancy with changes in - dbuoy_dS, & ! temperature and salinity, in m s-2 K-1 and m s-2 psu-1. + dbuoy_dS, & ! temperature and salinity, in Z s-2 K-1 and Z s-2 psu-1. I_L2_bdry, & ! The inverse of the square of twice the harmonic mean - ! distance to the top and bottom boundaries, in m-2. - K_Q, & ! Diffusivity divided by TKE, in s. - K_Q_tmp, & ! Diffusivity divided by TKE, in s. + ! distance to the top and bottom boundaries, in Z-2. + K_Q, & ! Diffusivity divided by TKE, in Z2 m-2 s. + K_Q_tmp, & ! A temporary copy of diffusivity divided by TKE, in Z2 m-2 s. local_src_avg, & ! The time-integral of the local source, nondim. tol_min, & ! Minimum tolerated ksrc for the corrector step, in s-1. tol_max, & ! Maximum tolerated ksrc for the corrector step, in s-1. tol_chg, & ! The tolerated change integrated in time, nondim. - dist_from_top, & ! The distance from the top surface, in m. + dist_from_top, & ! The distance from the top surface, in Z. local_src ! The sum of all sources of kappa, including kappa_src and ! sources from the elliptic term, in s-1. - real :: dist_from_bot ! The distance from the bottom surface, in m. + real :: dist_from_bot ! The distance from the bottom surface, in Z. real :: b1 ! The inverse of the pivot in the tridiagonal equations. real :: bd1 ! A term in the denominator of b1. real :: d1 ! 1 - c1 in the tridiagonal equations. real :: gR0 ! Rho_0 times g in kg m-2 s-2. - real :: g_R0 ! g_R0 is g/Rho in m4 kg-1 s-2. - real :: Norm ! A factor that normalizes two weights to 1, in m-2. + real :: g_R0 ! g_R0 is g/Rho in Z m3 kg-1 s-2. + real :: Norm ! A factor that normalizes two weights to 1, in Z-2. real :: tol_dksrc, tol2 ! ### Tolerances that need to be set better later. real :: tol_dksrc_low ! The tolerance for the fractional decrease in ksrc ! within an iteration. 0 < tol_dksrc_low < 1. @@ -806,7 +800,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real :: Idtt ! Idtt = 1 / dt_test, in s-1. real :: dt_inc ! An increment to dt_test that is being tested, in s. - real :: k0dt ! The background diffusivity times the timestep, in m2. + real :: k0dt ! The background diffusivity times the timestep, in Z2. logical :: valid_dt ! If true, all levels so far exhibit acceptably small ! changes in k_src. logical :: use_temperature ! If true, temperature and salinity have been @@ -821,7 +815,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & integer :: k, itt, itt_dt Ri_crit = CS%Rino_crit - gR0 = GV%Rho0*(GV%g_Earth*GV%m_to_Z) ; g_R0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 + gR0 = GV%Rho0*(GV%g_Earth*GV%m_to_Z) ; g_R0 = (GV%g_Earth*GV%m_to_Z**2)/GV%Rho0 k0dt = dt*CS%kappa_0 ! These are hard-coded for now. Perhaps these could be made dynamic later? ! tol_dksrc = 0.5*tol_ksrc_chg ; tol_dksrc_low = 1.0 - 1.0/tol_ksrc_chg ? @@ -846,7 +840,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! layers and applying a time-step of background diffusion. if (nzc > 1) then a1(2) = k0dt*I_dz_int(2) - b1 = 1.0 / (dz(1)+a1(2)) + b1 = 1.0 / (dz(1) + a1(2)) u(1) = b1 * u0xdz(1) ; v(1) = b1 * v0xdz(1) T(1) = b1 * T0xdz(1) ; Sal(1) = b1 * S0xdz(1) c1(2) = a1(2) * b1 ; d1 = dz(1) * b1 ! = 1 - c1 @@ -904,14 +898,14 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & do K=nzc,2,-1 dist_from_bot = dist_from_bot + dz(k) I_L2_bdry(K) = (dist_from_top(K) + dist_from_bot)**2 / & - (dist_from_top(K) * dist_from_bot)**2 + (dist_from_top(K) * dist_from_bot)**2 enddo ! Calculate thermodynamic coefficients and an initial estimate of N2. if (use_temperature) then pressure(1) = surface_pres do K=2,nzc - pressure(K) = pressure(K-1) + gR0*dz(k-1) + pressure(K) = pressure(K-1) + gR0*GV%Z_to_m*dz(k-1) T_int(K) = 0.5*(T(k-1) + T(k)) Sal_int(K) = 0.5*(Sal(k-1) + Sal(k)) enddo @@ -968,7 +962,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! This call just calculates N2 and S2. call calculate_projected_state(kappa, u, v, T, Sal, 0.0, nzc, & dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u, v, T, Sal, N2=N2, S2=S2) + u, v, T, Sal, GV, N2=N2, S2=S2) ! ---------------------------------------------------- ! Iterate ! ---------------------------------------------------- @@ -999,7 +993,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! call cpu_clock_begin(id_clock_KQ) call find_kappa_tke(N2, S2, kappa, Idz, dz_Int, I_L2_bdry, f2, & - nzc, CS, K_Q, tke, kappa_out, kappa_src, local_src) + nzc, CS, GV, K_Q, tke, kappa_out, kappa_src, local_src) ! call cpu_clock_end(id_clock_KQ) ! call cpu_clock_begin(id_clock_avg) @@ -1038,7 +1032,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! enough. call calculate_projected_state(kappa_out, u, v, T, Sal, 0.5*dt_test, nzc, & dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u_test, v_test, T_test, S_test, N2, S2, & + u_test, v_test, T_test, S_test, GV, N2, S2, & ks_int = ks_kappa, ke_int = ke_kappa) valid_dt = .true. Idtt = 1.0 / dt_test @@ -1065,7 +1059,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & do itt_dt=1,dt_refinements call calculate_projected_state(kappa_out, u, v, T, Sal, & 0.5*(dt_test+dt_inc), nzc, dz, I_dz_int, dbuoy_dT, & - dbuoy_dS, u_test, v_test, T_test, S_test, N2, S2, & + dbuoy_dS, u_test, v_test, T_test, S_test, GV, N2, S2, & ks_int = ks_kappa, ke_int = ke_kappa) valid_dt = .true. Idtt = 1.0 / (dt_test+dt_inc) @@ -1119,14 +1113,14 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! call cpu_clock_begin(id_clock_project) call calculate_projected_state(kappa_out, u, v, T, Sal, dt_now, nzc, & dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u_test, v_test, T_test, S_test, N2=N2, S2=S2, & + u_test, v_test, T_test, S_test, GV, N2=N2, S2=S2, & ks_int = ks_kappa, ke_int = ke_kappa) ! call cpu_clock_end(id_clock_project) ! call cpu_clock_begin(id_clock_KQ) do K=1,nzc+1 ; K_Q_tmp(K) = K_Q(K) ; enddo call find_kappa_tke(N2, S2, kappa_out, Idz, dz_Int, I_L2_bdry, f2, & - nzc, CS, K_Q_tmp, tke_pred, kappa_pred) + nzc, CS, GV, K_Q_tmp, tke_pred, kappa_pred) ! call cpu_clock_end(id_clock_KQ) ks_kappa = GV%ke+1 ; ke_kappa = 0 @@ -1139,13 +1133,13 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! call cpu_clock_begin(id_clock_project) call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, & dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u_test, v_test, T_test, S_test, N2=N2, S2=S2, & + u_test, v_test, T_test, S_test, GV, N2=N2, S2=S2, & ks_int = ks_kappa, ke_int = ke_kappa) ! call cpu_clock_end(id_clock_project) ! call cpu_clock_begin(id_clock_KQ) call find_kappa_tke(N2, S2, kappa_out, Idz, dz_Int, I_L2_bdry, f2, & - nzc, CS, K_Q, tke_pred, kappa_pred) + nzc, CS, GV, K_Q, tke_pred, kappa_pred) ! call cpu_clock_end(id_clock_KQ) ! call cpu_clock_begin(id_clock_avg) @@ -1164,7 +1158,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! call cpu_clock_begin(id_clock_project) call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, & dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u, v, T, Sal, N2, S2) + u, v, T, Sal, GV, N2, S2) ! call cpu_clock_end(id_clock_project) endif @@ -1198,7 +1192,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & Ri_k(K) = 1e3 ; if (N2(K) < 1e3 * S2(K)) Ri_k(K) = N2(K) / S2(K) dtke(K) = tke_pred(K) - tke(K) dtke_norm(K) = dtke(K) / (0.5*(tke(K) + tke_pred(K))) - dkappa(K) = kappa_pred(K) - kappa_out(K) + dkap(K) = kappa_pred(K) - kappa_out(K) enddo if (itt <= max_debug_itt) then do k=1,nzc @@ -1215,7 +1209,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & if (abs(dkappa_it1(K,itt-1)) > 1e-20) & d_dkappa_it1(K,itt) = dkappa_it1(K,itt) / dkappa_it1(K,itt-1) endif - dkappa_norm(K,itt) = dkappa(K) / max(0.5*(Kappa_pred(K) + kappa_out(K)), 1e-100) + dkappa_norm(K,itt) = dkap(K) / max(0.5*(kappa_pred(K) + kappa_out(K)), GV%m_to_Z**2*1e-100) enddo endif #endif @@ -1231,27 +1225,28 @@ end subroutine kappa_shear_column !! may also calculate the projected buoyancy frequency and shear. subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u, v, T, Sal, N2, S2, ks_int, ke_int) + u, v, T, Sal, GV, N2, S2, ks_int, ke_int) integer, intent(in) :: nz !< The number of layers (after eliminating massless !! layers?). real, dimension(nz+1), intent(in) :: kappa !< The diapycnal diffusivity at interfaces, - !! in m2 s-1. + !! in Z2 s-1. real, dimension(nz), intent(in) :: u0 !< The initial zonal velocity, in m s-1. real, dimension(nz), intent(in) :: v0 !< The initial meridional velocity, in m s-1. real, dimension(nz), intent(in) :: T0 !< The initial temperature, in C. real, dimension(nz), intent(in) :: S0 !< The initial salinity, in PSU. - real, dimension(nz), intent(in) :: dz !< The grid spacing of layers, in m. + real, dimension(nz), intent(in) :: dz !< The grid spacing of layers, in Z. real, dimension(nz+1), intent(in) :: I_dz_int !< The inverse of the layer's thicknesses, - !! in m-1. + !! in Z-1. real, dimension(nz+1), intent(in) :: dbuoy_dT !< The partial derivative of buoyancy with - !! temperature, in m s-2 C-1. + !! temperature, in Z s-2 C-1. real, dimension(nz+1), intent(in) :: dbuoy_dS !< The partial derivative of buoyancy with - !! salinity, in m s-2 PSU-1. + !! salinity, in Z s-2 PSU-1. real, intent(in) :: dt !< The time step in s. real, dimension(nz), intent(inout) :: u !< The zonal velocity after dt, in m s-1. real, dimension(nz), intent(inout) :: v !< The meridional velocity after dt, in m s-1. real, dimension(nz), intent(inout) :: T !< The temperature after dt, in C. real, dimension(nz), intent(inout) :: Sal !< The salinity after dt, in PSU. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(nz+1), optional, & intent(inout) :: N2 !< The buoyancy frequency squared at interfaces, !! in s-2. @@ -1263,6 +1258,8 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & ! Local variables real, dimension(nz+1) :: c1 + real :: L2_to_Z2 ! A conversion factor from horizontal length units to vertical depth + ! units squared, in Z2 m-2. real :: a_a, a_b, b1, d1, bd1, b1nz_0 integer :: k, ks, ke @@ -1325,14 +1322,15 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & endif if (present(S2)) then + L2_to_Z2 = GV%m_to_Z**2 S2(1) = 0.0 ; S2(nz+1) = 0.0 if (ks > 1) & - S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * I_dz_int(ks)**2 + S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * L2_to_Z2*I_dz_int(ks)**2 do K=ks+1,ke - S2(K) = ((u(k)-u(k-1))**2 + (v(k)-v(k-1))**2) * I_dz_int(K)**2 + S2(K) = ((u(k)-u(k-1))**2 + (v(k)-v(k-1))**2) * L2_to_Z2*I_dz_int(K)**2 enddo if (ke This subroutine calculates new, consistent estimates of TKE and kappa. subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & - nz, CS, K_Q, tke, kappa, kappa_src, local_src) + nz, CS, GV, K_Q, tke, kappa, kappa_src, local_src) integer, intent(in) :: nz !< The number of layers to work on. real, dimension(nz+1), intent(in) :: N2 !< The buoyancy frequency squared at interfaces, !! in s-2. real, dimension(nz+1), intent(in) :: S2 !< The squared shear at interfaces, in s-2. real, dimension(nz+1), intent(in) :: kappa_in !< The initial guess at the diffusivity, - !! in m2 s-1. - real, dimension(nz+1), intent(in) :: dz_Int !< The thicknesses associated with interfaces, - !! in m. + !! in Z2 s-1. + real, dimension(nz+1), intent(in) :: dz_Int !< The thicknesses associated with interfaces, + !! in Z-1. real, dimension(nz+1), intent(in) :: I_L2_bdry !< The inverse of the squared distance to !! boundaries, m2. - real, dimension(nz), intent(in) :: Idz !< The inverse grid spacing of layers, in m-1. + real, dimension(nz), intent(in) :: Idz !< The inverse grid spacing of layers, in Z-1. real, intent(in) :: f2 !< The squared Coriolis parameter, in s-2. type(Kappa_shear_CS), pointer :: CS !< A pointer to this module's control structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(nz+1), intent(inout) :: K_Q !< The shear-driven diapycnal diffusivity divided by !! the turbulent kinetic energy per unit mass at !! interfaces, in s. real, dimension(nz+1), intent(out) :: tke !< The turbulent kinetic energy per unit mass at !! interfaces, in units of m2 s-2. - real, dimension(nz+1), intent(out) :: kappa !< The diapycnal diffusivity at interfaces, - !! in m2 s-1. + real, dimension(nz+1), intent(out) :: kappa !< The diapycnal diffusivity at interfaces, + !! in Z2 s-1. real, dimension(nz+1), optional, & intent(out) :: kappa_src !< The source term for kappa, in s-1. real, dimension(nz+1), optional, & @@ -1387,16 +1386,16 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! equations, in m s-1. dQdz ! Half the partial derivative of TKE with depth, m s-2. real, dimension(nz+1) :: & - dK, & ! The change in kappa, in m2 s-1. - dQ, & ! The change in TKE, in m2 s-1. + dK, & ! The change in kappa, in Z2 s-1. + dQ, & ! The change in TKE, in m2 s-2. cQ, cK, & ! cQ and cK are the upward influences in the tridiagonal and ! hexadiagonal solvers for the TKE and kappa equations, ND. I_Ld2, & ! 1/Ld^2, where Ld is the effective decay length scale - ! for kappa, in units of m-2. + ! for kappa, in units of Z-2. TKE_decay, & ! The local TKE decay rate in s-1. k_src, & ! The source term in the kappa equation, in s-1. - dQmdK, & ! With Newton's method the change in dQ(k-1) due to dK(k), s. - dKdQ, & ! With Newton's method the change in dK(k) due to dQ(k), s-1. + dQmdK, & ! With Newton's method the change in dQ(k-1) due to dK(k), m2 s Z-2. + dKdQ, & ! With Newton's method the change in dK(k) due to dQ(k), Z2 m-2 s-1. e1 ! The fractional change in a layer TKE due to a change in the ! TKE of the layer above when all the kappas below are 0. ! e1 is nondimensional, and 0 < e1 < 1. @@ -1404,7 +1403,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! and stratification, in m2 s-3. (For convenience, ! a term involving the non-dissipation of q0 is also ! included here.) - real :: bQ, bK ! The inverse of the pivot in the tridiagonal equations. + real :: bQ, bK ! The inverse of the pivot in the tridiagonal equations, in Z-1. real :: bd1 ! A term in the denominator of bQ or bK. real :: cQcomp, cKcomp ! 1 - cQ or 1 - cK in the tridiagonal equations. real :: c_s2 ! The coefficient for the decay of TKE due to @@ -1417,21 +1416,26 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real :: Ilambda2 ! 1.0 / CS%lambda**2. real :: TKE_min ! The minimum value of shear-driven TKE that can be ! solved for, in m2 s-2. - real :: kappa0 ! The background diapycnal diffusivity, in m2 s-1. + real :: kappa0 ! The background diapycnal diffusivity, in Z2 s-1. real :: max_err ! The maximum value of norm_err in a column, nondim. - real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0, m2 s-1. + real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0, Z2 s-1. real :: eden1, eden2, I_eden, ome ! Variables used in calculating e1. real :: diffusive_src ! The diffusive source in the kappa equation, in m s-1. real :: chg_by_k0 ! The value of k_src that leads to an increase of ! kappa_0 if only the diffusive term is a sink, in s-1. - real :: kappa_mean ! A mean value of kappa, in m2 s-1. + real :: kappa_mean ! A mean value of kappa, in Z2 s-1. real :: Newton_test ! The value of relative error that will cause the next ! iteration to use Newton's method. ! Temporary variables used in the Newton's method iterations. - real :: decay_term, I_Q, kap_src, v1, v2 - + real :: decay_term_k ! The decay term in the diffusivity equation + real :: decay_term_Q ! The decay term in the TKE equation + real :: I_Q ! The inverse of TKE, in s2 m-2 + real :: kap_src + real :: v1, v2 + real :: Z2_to_L2 ! A conversion factor from vertical depth units to horizontal length + ! units squared, in m2 Z-2. real :: tol_err ! The tolerance for max_err that determines when to ! stop iterating. real :: Newton_err ! The tolerance for max_err that determines when to @@ -1456,7 +1460,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & integer :: max_debug_itt ; parameter(max_debug_itt=20) real :: K_err_lin, Q_err_lin real, dimension(nz+1) :: & - kappa_prev, & ! The value of kappa at the start of the current iteration, in m2 s-1. + kappa_prev, & ! The value of kappa at the start of the current iteration, in Z2 s-1. TKE_prev ! The value of TKE at the start of the current iteration, in m2 s-2. real, dimension(nz+1,1:max_debug_itt) :: & tke_it1, kappa_it1, kprev_it1, & ! Various values from each iteration. @@ -1471,6 +1475,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & q0 = CS%TKE_bg ; kappa0 = CS%kappa_0 ; TKE_min = max(CS%TKE_bg,1.0E-20) Ri_crit = CS%Rino_crit Ilambda2 = 1.0 / CS%lambda**2 + Z2_to_L2 = GV%Z_to_m**2 kappa_trunc = 0.01*kappa0 ! ### CHANGE THIS HARD-WIRING LATER? do_Newton = .false. ; abort_Newton = .false. tol_err = CS%kappa_tol_err @@ -1554,13 +1559,13 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! terms. ke_tke = max(ke_kappa,ke_kappa_prev)+1 - ! aQ is the coupling between adjacent interfaces in m s-1. + ! aQ is the coupling between adjacent interfaces in Z s-1. do k=1,min(ke_tke,nz) - aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) + aQ(k) = (0.5*(kappa(K)+kappa(K+1)) + kappa0) * Idz(k) enddo dQ(1) = -TKE(1) if (tke_noflux_top_BC) then - tke_src = kappa0*S2(1) + q0 * TKE_decay(1) ! Uses that kappa(1) = 0 + tke_src = Z2_to_L2*kappa0*S2(1) + q0 * TKE_decay(1) ! Uses that kappa(1) = 0 bd1 = dz_Int(1) * TKE_decay(1) bQ = 1.0 / (bd1 + aQ(1)) tke(1) = bQ * (dz_Int(1)*tke_src) @@ -1570,8 +1575,8 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & endif do K=2,ke_tke-1 dQ(K) = -TKE(K) - tke_src = (kappa(K) + kappa0)*S2(K) + q0*TKE_decay(K) - bd1 = dz_Int(K)*(TKE_decay(K) + N2(K)*K_Q(K)) + cQcomp*aQ(k-1) + tke_src = Z2_to_L2*(kappa(K) + kappa0)*S2(K) + q0*TKE_decay(K) + bd1 = dz_Int(K)*(TKE_decay(K) + N2(K)*Z2_to_L2*K_Q(K)) + cQcomp*aQ(k-1) bQ = 1.0 / (bd1 + aQ(k)) tke(K) = bQ * (dz_Int(K)*tke_src + aQ(k-1)*tke(K-1)) cQ(K+1) = aQ(k) * bQ ; cQcomp = bd1 * bQ ! = 1 - cQ @@ -1581,7 +1586,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dQ(nz+1) = 0.0 else k = ke_tke - tke_src = kappa0*S2(K) + q0*TKE_decay(K) ! Uses that kappa(ke_tke) = 0 + tke_src = Z2_to_L2*kappa0*S2(K) + q0*TKE_decay(K) ! Uses that kappa(ke_tke) = 0 if (K == nz+1) then dQ(K) = -TKE(K) bQ = 1.0 / (dz_Int(K)*TKE_decay(K) + cQcomp*aQ(k-1)) @@ -1624,12 +1629,12 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dK(1) = 0.0 ! kappa takes boundary values of 0. cK(2) = 0.0 ; cKcomp = 1.0 if (itt == 1) then ; dO K=2,nz - I_Ld2(K) = (N2(K)*Ilambda2 + f2) / tke(K) + I_L2_bdry(K) + I_Ld2(K) = (N2(K)*Ilambda2 + f2) * Z2_to_L2 / tke(K) + I_L2_bdry(K) enddo ; endif do K=2,nz dK(K) = -kappa(K) if (itt>1) & - I_Ld2(K) = (N2(K)*Ilambda2 + f2) / tke(K) + I_L2_bdry(K) + I_Ld2(K) = (N2(K)*Ilambda2 + f2) * Z2_to_L2 / tke(K) + I_L2_bdry(K) bd1 = dz_Int(K)*I_Ld2(K) + cKcomp*Idz(k-1) bK = 1.0 / (bd1 + Idz(k)) @@ -1673,7 +1678,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & aQ(1) = (0.5*(kappa(1)+kappa(2))+kappa0) * Idz(1) dQdz(1) = 0.5*(TKE(1) - TKE(2))*Idz(1) if (tke_noflux_top_BC) then - tke_src = dz_Int(1) * (kappa0*S2(1) - (TKE(1) - q0)*TKE_decay(1)) - & + tke_src = dz_Int(1) * (Z2_to_L2*kappa0*S2(1) - (TKE(1) - q0)*TKE_decay(1)) - & aQ(1) * (TKE(1) - TKE(2)) bQ = 1.0 / (aQ(1) + dz_Int(1)*TKE_decay(1)) @@ -1686,21 +1691,21 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & endif do K=2,nz I_Q = 1.0 / TKE(K) - I_Ld2(K) = (N2(K)*Ilambda2 + f2) * I_Q + I_L2_bdry(K) + I_Ld2(K) = (N2(K)*Ilambda2 + f2) * (Z2_to_L2*I_Q) + I_L2_bdry(K) kap_src = dz_Int(K) * (k_src(K) - I_Ld2(K)*kappa(K)) + & - Idz(k-1)*(kappa(K-1)-kappa(K)) - Idz(k)*(kappa(K)-kappa(K+1)) + Idz(k-1)*(kappa(K-1)-kappa(K)) - Idz(k)*(kappa(K)-kappa(K+1)) ! Ensure that the pivot is always positive, and that 0 <= cK <= 1. ! Otherwise do not use Newton's method. - decay_term = -Idz(k-1)*dQmdK(K)*dKdQ(K-1) + dz_Int(K)*I_Ld2(K) - if (decay_term < 0.0) then ; abort_Newton = .true. ; exit ; endif - bK = 1.0 / (Idz(k) + Idz(k-1)*cKcomp + decay_term) + decay_term_k = -Idz(k-1)*dQmdK(K)*dKdQ(K-1) + dz_Int(K)*I_Ld2(K) + if (decay_term_k < 0.0) then ; abort_Newton = .true. ; exit ; endif + bK = 1.0 / (Idz(k) + Idz(k-1)*cKcomp + decay_term_k) cK(K+1) = bK * Idz(k) - cKcomp = bK * (Idz(k-1)*cKcomp + decay_term) ! = 1-cK(K+1) + cKcomp = bK * (Idz(k-1)*cKcomp + decay_term_k) ! = 1-cK(K+1) dKdQ(K) = bK * (Idz(k-1)*dKdQ(K-1)*cQ(K) + & - (N2(K)*Ilambda2 + f2)*I_Q**2*kappa(K)) + GV%Z_to_m*(N2(K)*Ilambda2 + f2) * I_Q**2 * kappa(K) ) dK(K) = bK * (kap_src + Idz(k-1)*dK(K-1) + Idz(k-1)*dKdQ(K-1)*dQ(K-1)) ! Truncate away negligibly small values of kappa. @@ -1714,21 +1719,21 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! Solve for dQ(K)... aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) dQdz(k) = 0.5*(TKE(K) - TKE(K+1))*Idz(k) - tke_src = dz_Int(K) * ((kappa(k) + kappa0)*S2(k) - kappa(k)*N2(k) - & - (TKE(k) - q0)*TKE_decay(k)) - & + tke_src = dz_Int(K) * (Z2_to_L2*((kappa(k) + kappa0)*S2(k) - kappa(k)*N2(k)) - & + (TKE(k) - q0)*TKE_decay(k)) - & (aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K))) v1 = aQ(k-1) + dQdz(k-1)*dKdQ(K-1) v2 = (v1*dQmdK(K) + dQdz(k-1)*cK(K)) + & - ((dQdz(k-1) - dQdz(k)) + dz_Int(K)*(S2(K) - N2(K))) + ((dQdz(k-1) - dQdz(k)) + Z2_to_L2*dz_Int(K)*(S2(K) - N2(K))) ! Ensure that the pivot is always positive, and that 0 <= cQ <= 1. ! Otherwise do not use Newton's method. - decay_term = dz_Int(K)*TKE_decay(K) - dQdz(k-1)*dKdQ(K-1)*cQ(K) - v2*dKdQ(K) - if (decay_term < 0.0) then ; abort_Newton = .true. ; exit ; endif - bQ = 1.0 / (aQ(k) + (cQcomp*aQ(k-1) + decay_term)) + decay_term_Q = dz_Int(K)*TKE_decay(K) - dQdz(k-1)*dKdQ(K-1)*cQ(K) - v2*dKdQ(K) + if (decay_term_Q < 0.0) then ; abort_Newton = .true. ; exit ; endif + bQ = 1.0 / (aQ(k) + (cQcomp*aQ(k-1) + decay_term_Q)) cQ(K+1) = aQ(k) * bQ - cQcomp = (cQcomp*aQ(k-1) + decay_term) * bQ + cQcomp = (cQcomp*aQ(k-1) + decay_term_Q) * bQ dQmdK(K+1) = (v2 * cK(K+1) - dQdz(k)) * bQ ! Ensure that TKE+dQ will not drop below 0.5*TKE. @@ -1746,15 +1751,15 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dK(nz+1) = 0.0 ; dKdQ(nz+1) = 0.0 if (tke_noflux_bottom_BC) then K = nz+1 - tke_src = dz_Int(K) * (kappa0*S2(K) - (TKE(K) - q0)*TKE_decay(K)) + & + tke_src = dz_Int(K) * (Z2_to_L2*kappa0*S2(K) - (TKE(K) - q0)*TKE_decay(K)) + & aQ(k-1) * (TKE(K-1) - TKE(K)) v1 = aQ(k-1) + dQdz(k-1)*dKdQ(K-1) - decay_term = max(0.0, dz_Int(K)*TKE_decay(K) - dQdz(k-1)*dKdQ(K-1)*cQ(K)) - if (decay_term < 0.0) then + decay_term_Q = max(0.0, dz_Int(K)*TKE_decay(K) - dQdz(k-1)*dKdQ(K-1)*cQ(K)) + if (decay_term_Q < 0.0) then abort_Newton = .true. else - bQ = 1.0 / (aQ(k) + (cQcomp*aQ(k-1) + decay_term)) + bQ = 1.0 / (aQ(k) + (cQcomp*aQ(k-1) + decay_term_Q)) ! Ensure that TKE+dQ will not drop below 0.5*TKE. dQ(K) = max(bQ * ((v1 * dQ(K-1) + dQdz(k-1)*dK(K-1)) + tke_src), & -0.5*TKE(K)) @@ -1772,10 +1777,9 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & if (K < nz+1) then ! Ignore this source? aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) - tke_src = (dz_Int(K) * (kappa0*S2(K) - (TKE(K)-q0)*TKE_decay(K)) - & - (aQ(k) * (TKE(K) - TKE(K+1)) - & - aQ(k-1) * (TKE(K-1) - TKE(K))) ) / & - (aQ(k) + (aQ(k-1) + dz_Int(K)*TKE_decay(K))) + tke_src = (dz_Int(K) * (Z2_to_L2*kappa0*S2(K) - (TKE(K)-q0)*TKE_decay(K)) - & + (aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K))) ) / & + (aQ(k) + (aQ(k-1) + dz_Int(K)*TKE_decay(K))) endif #endif dK(K) = 0.0 @@ -1816,7 +1820,8 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & endif #ifdef DEBUG - ! Check these solutions for consistency. + ! Check these solutions for consistency. + ! The unit conversions here have not been carefully tested. do K=2,nz ! In these equations, K_err_lin and Q_err_lin should be at round-off levels ! compared with the dominant terms, perhaps, dz_Int*I_Ld2*kappa and @@ -1824,23 +1829,23 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! been increased to ensure a positive pivot, or 2) negative TKEs have been ! truncated, or 3) small or negative kappas have been rounded toward 0. I_Q = 1.0 / TKE(K) - I_Ld2(K) = (N2(K)*Ilambda2 + f2) * I_Q + I_L2_bdry(K) + I_Ld2(K) = (N2(K)*Ilambda2 + f2) * (Z2_to_L2*I_Q) + I_L2_bdry(K) kap_src = dz_Int(K) * (k_src(K) - I_Ld2(K)*kappa_prev(K)) + & - (Idz(k-1)*(kappa_prev(k-1)-kappa_prev(k)) - & - Idz(k)*(kappa_prev(k)-kappa_prev(k+1))) - K_err_lin = -Idz(k-1)*(dK(K-1)-dK(K)) + Idz(k)*(dK(K)-dK(K+1)) + & + (Idz(k-1)*(kappa_prev(k-1)-kappa_prev(k)) - & + Idz(k)*(kappa_prev(k)-kappa_prev(k+1))) + K_err_lin = -Idz(k-1)*(dK(K-1)-dK(K)) + Idz(k)*(dK(K)-dK(K+1)) + & dz_Int(K)*I_Ld2(K)*dK(K) - kap_src - & - (N2(K)*Ilambda2 + f2)*I_Q**2*kappa_prev(K) * dQ(K) + GV%Z_to_m*(N2(K)*Ilambda2 + f2)*I_Q**2*kappa_prev(K) * dQ(K) - tke_src = dz_Int(K) * ((kappa_prev(K) + kappa0)*S2(K) - & - kappa_prev(K)*N2(K) - (TKE_prev(K) - q0)*TKE_decay(K)) - & + tke_src = dz_Int(K) * (Z2_to_L2*(kappa_prev(K) + kappa0)*S2(K) - & + Z2_to_L2*kappa_prev(K)*N2(K) - (TKE_prev(K) - q0)*TKE_decay(K)) - & (aQ(k) * (TKE_prev(K) - TKE_prev(K+1)) - & aQ(k-1) * (TKE_prev(K-1) - TKE_prev(K))) Q_err_lin = (aQ(k-1) * (dQ(K-1)-dQ(K)) - aQ(k) * (dQ(k)-dQ(k+1))) - & 0.5*(TKE_prev(K)-TKE_prev(K+1))*Idz(k) * (dK(K) + dK(K+1)) - & 0.5*(TKE_prev(K)-TKE_prev(K-1))*Idz(k-1)* (dK(K-1) + dK(K)) + & - dz_Int(K) * (dK(K) * (S2(K) - N2(K)) - dQ(K)*TKE_decay(K)) + tke_src + dz_Int(K) * (Z2_to_L2*dK(K) * (S2(K) - N2(K)) - dQ(K)*TKE_decay(K)) + tke_src enddo #endif endif ! End of the Newton's method solver. @@ -1942,8 +1947,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & if (present(local_src)) then local_src(1) = 0.0 ; local_src(nz+1) = 0.0 do K=2,nz - diffusive_src = Idz(k-1)*(kappa(K-1)-kappa(K)) + & - Idz(k)*(kappa(K+1)-kappa(K)) + diffusive_src = Idz(k-1)*(kappa(K-1)-kappa(K)) + Idz(k)*(kappa(K+1)-kappa(K)) chg_by_k0 = kappa0 * ((Idz(k-1)+Idz(k)) / dz_Int(K) + I_Ld2(K)) if (diffusive_src <= 0.0) then local_src(K) = k_src(K) + chg_by_k0 @@ -2023,7 +2027,8 @@ function kappa_shear_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "KD_KAPPA_SHEAR_0", CS%kappa_0, & "The background diffusivity that is used to smooth the \n"//& "density and shear profiles before solving for the \n"//& - "diffusivities. Defaults to value of KD.", units="m2 s-1", default=KD_normal) + "diffusivities. Defaults to value of KD.", & + units="m2 s-1", default=KD_normal, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "FRI_CURVATURE", CS%FRi_curvature, & "The nondimensional curvature of the function of the \n"//& "Richardson number in the kappa source term in the \n"//& @@ -2103,9 +2108,9 @@ function kappa_shear_init(Time, G, GV, param_file, diag, CS) 'Shear-driven Turbulent Kinetic Energy', 'm2 s-2') #ifdef ADD_DIAGNOSTICS CS%id_ILd2 = register_diag_field('ocean_model','ILd2_shear',diag%axesTi,Time, & - 'Inverse kappa decay scale at interfaces', 'm-2') + 'Inverse kappa decay scale at interfaces', 'm-2', conversion=GV%m_to_Z**2) CS%id_dz_Int = register_diag_field('ocean_model','dz_Int_shear',diag%axesTi,Time, & - 'Finite volume thickness of interfaces', 'm') + 'Finite volume thickness of interfaces', 'm', conversion=GV%Z_to_m) #endif end function kappa_shear_init From 8dbc04601c4a934b20680e8203d4c8f393bae68b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 9 Oct 2018 14:13:22 -0400 Subject: [PATCH 0808/1072] Recast mixedlayer_restrat to work in units of Z Recast the internal calculations in mixedlayer_restrat to use vertical height units of Z in place of m for dimensional consistency testing. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- .../lateral/MOM_mixed_layer_restrat.F90 | 61 ++++++++++--------- 1 file changed, 31 insertions(+), 30 deletions(-) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 78993633b3..27a60e7a38 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -138,17 +138,17 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var MLD_slow, & ! Mixed layer depth actually used in MLE restratification parameterization (H units) htot_slow, & ! The sum of the thicknesses of layers in the mixed layer (H units) Rml_av_slow ! g_Rho0 times the average mixed layer density (m s-2) - real :: g_Rho0 ! G_Earth/Rho0 (m4 s-2 kg-1) + real :: g_Rho0 ! G_Earth/Rho0 (m5 Z-1 s-2 kg-1) real :: rho_ml(SZI_(G)) ! Potential density relative to the surface (kg m-3) real :: p0(SZI_(G)) ! A pressure of 0 (Pa) - real :: h_vel ! htot interpolated onto velocity points in metre (not H). + real :: h_vel ! htot interpolated onto velocity points in Z (not H). real :: absf ! absolute value of f, interpolated to velocity points (s-1) - real :: u_star ! surface friction velocity, interpolated to velocity points (m s-1) + real :: u_star ! surface friction velocity, interpolated to velocity points (Z s-1) real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer (s-1) real :: timescale ! mixing growth timescale (sec) real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected (H units) - real :: dz_neglect ! A tiny thickness (in m) that is usually lost in roundoff so can be neglected + real :: dz_neglect ! A tiny thickness (in Z) that is usually lost in roundoff so can be neglected real :: I4dt ! 1/(4 dt) (sec-1) real :: Ihtot,Ihtot_slow! total mixed layer thickness real :: a(SZK_(G)) ! A non-dimensional value relating the overall flux @@ -273,9 +273,9 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var uDml(:) = 0.0 ; vDml(:) = 0.0 uDml_slow(:) = 0.0 ; vDml_slow(:) = 0.0 I4dt = 0.25 / dt - g_Rho0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 + g_Rho0 = GV%g_Earth / GV%Rho0 h_neglect = GV%H_subroundoff - dz_neglect = GV%H_subroundoff*GV%H_to_m + dz_neglect = GV%H_subroundoff*GV%H_to_Z proper_averaging = .not. CS%MLE_use_MLD_ave_bug if (CS%front_length>0.) then res_upscale = .true. @@ -338,7 +338,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var call hchksum(h,'mixed_layer_restrat: h',G%HI,haloshift=1,scale=GV%H_to_m) call hchksum(forces%ustar,'mixed_layer_restrat: u*',G%HI,haloshift=1) call hchksum(MLD_fast,'mixed_layer_restrat: MLD',G%HI,haloshift=1,scale=GV%H_to_m) - call hchksum(Rml_av_fast,'mixed_layer_restrat: rml',G%HI,haloshift=1) + call hchksum(Rml_av_fast,'mixed_layer_restrat: rml',G%HI,haloshift=1, scale=GV%m_to_Z) endif ! TO DO: @@ -348,7 +348,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! U - Component !$OMP do do j=js,je ; do I=is-1,ie - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star = GV%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & @@ -358,23 +358,23 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 ! 0.41 is the von Karmen constant, 9.8696 = pi^2. - h_vel = 0.5*((htot_fast(i,j) + htot_fast(i+1,j)) + h_neglect) * GV%H_to_m + h_vel = 0.5*((htot_fast(i,j) + htot_fast(i+1,j)) + h_neglect) * GV%H_to_Z mom_mixrate = (0.41*9.8696)*u_star**2 / & (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef if (res_upscale) timescale = timescale * res_scaling_fac uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & - G%IdxCu(I,j)*(Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%m_to_H) + G%IdxCu(I,j)*(Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) ! As above but using the slow filtered MLD - h_vel = 0.5*((htot_slow(i,j) + htot_slow(i+1,j)) + h_neglect) * GV%H_to_m + h_vel = 0.5*((htot_slow(i,j) + htot_slow(i+1,j)) + h_neglect) * GV%H_to_Z mom_mixrate = (0.41*9.8696)*u_star**2 / & (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef2 if (res_upscale) timescale = timescale * res_scaling_fac uDml_slow(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & - G%IdxCu(I,j)*(Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%m_to_H) + G%IdxCu(I,j)*(Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) if (uDml(I) + uDml_slow(I) == 0.) then do k=1,nz ; uhml(I,j,k) = 0.0 ; enddo @@ -424,7 +424,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! V- component !$OMP do do J=js-1,je ; do i=is,ie - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star = GV%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & @@ -434,23 +434,23 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 ! 0.41 is the von Karmen constant, 9.8696 = pi^2. - h_vel = 0.5*((htot_fast(i,j) + htot_fast(i,j+1)) + h_neglect) * GV%H_to_m + h_vel = 0.5*((htot_fast(i,j) + htot_fast(i,j+1)) + h_neglect) * GV%H_to_Z mom_mixrate = (0.41*9.8696)*u_star**2 / & (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef if (res_upscale) timescale = timescale * res_scaling_fac vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* & - G%IdyCv(i,J)*(Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%m_to_H) + G%IdyCv(i,J)*(Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) ! As above but using the slow filtered MLD - h_vel = 0.5*((htot_slow(i,j) + htot_slow(i,j+1)) + h_neglect) * GV%H_to_m + h_vel = 0.5*((htot_slow(i,j) + htot_slow(i,j+1)) + h_neglect) * GV%H_to_Z mom_mixrate = (0.41*9.8696)*u_star**2 / & (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef2 if (res_upscale) timescale = timescale * res_scaling_fac vDml_slow(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* & - G%IdyCv(i,J)*(Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%m_to_H) + G%IdyCv(i,J)*(Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) if (vDml(i) + vDml_slow(i) == 0.) then do k=1,nz ; vhml(i,J,k) = 0.0 ; enddo @@ -559,17 +559,17 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) real, dimension(SZI_(G),SZJ_(G)) :: & htot, & ! The sum of the thicknesses of layers in the mixed layer (H units) Rml_av ! g_Rho0 times the average mixed layer density (m s-2) - real :: g_Rho0 ! G_Earth/Rho0 (m4 s-2 kg-1) + real :: g_Rho0 ! G_Earth/Rho0 (m5 Z-1 s-2 kg-1) real :: Rho0(SZI_(G)) ! Potential density relative to the surface (kg m-3) real :: p0(SZI_(G)) ! A pressure of 0 (Pa) - real :: h_vel ! htot interpolated onto velocity points (meter; not H) + real :: h_vel ! htot interpolated onto velocity points (Z; not H) real :: absf ! absolute value of f, interpolated to velocity points (s-1) - real :: u_star ! surface friction velocity, interpolated to velocity points (m s-1) + real :: u_star ! surface friction velocity, interpolated to velocity points (Z s-1) real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer (s-1) real :: timescale ! mixing growth timescale (sec) real :: h_neglect ! tiny thickness usually lost in roundoff and can be neglected (H units) - real :: dz_neglect ! tiny thickness (in m) that usually lost in roundoff and can be neglected (meter) + real :: dz_neglect ! tiny thickness (in Z) that usually lost in roundoff and can be neglected (meter) real :: I4dt ! 1/(4 dt) real :: I2htot ! Twice the total mixed layer thickness at velocity points (H units) real :: z_topx2 ! depth of the top of a layer at velocity points (H units) @@ -597,10 +597,10 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) uDml(:) = 0.0 ; vDml(:) = 0.0 I4dt = 0.25 / dt - g_Rho0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 + g_Rho0 = GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) h_neglect = GV%H_subroundoff - dz_neglect = GV%H_subroundoff*GV%H_to_m + dz_neglect = GV%H_subroundoff*GV%H_to_Z if (.not.use_EOS) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "An equation of state must be used with this module.") @@ -644,9 +644,9 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) do i=is,ie ; utimescale_diag(i,j) = 0.0 ; enddo do i=is,ie ; vtimescale_diag(i,j) = 0.0 ; enddo do I=is-1,ie - h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_m + h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star = GV%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 @@ -661,7 +661,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) utimescale_diag(I,j) = timescale uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & - G%IdxCu(I,j)*(Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%m_to_H) + G%IdxCu(I,j)*(Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) if (uDml(i) == 0) then do k=1,nkml ; uhml(I,j,k) = 0.0 ; enddo @@ -692,9 +692,9 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) ! V- component !$OMP do do J=js-1,je ; do i=is,ie - h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_m + h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_Z - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star = GV%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 @@ -709,7 +709,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) vtimescale_diag(i,J) = timescale vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* & - G%IdyCv(i,J)*(Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%m_to_H) + G%IdyCv(i,J)*(Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) if (vDml(i) == 0) then do k=1,nkml ; vhml(i,J,k) = 0.0 ; enddo else @@ -883,7 +883,8 @@ logical function mixedlayer_restrat_init(Time, G, GV, param_file, diag, CS, rest CS%id_MLD = register_diag_field('ocean_model', 'MLD_restrat', diag%axesT1, Time, & 'Mixed Layer Depth as used in the mixed-layer restratification parameterization', 'm') CS%id_Rml = register_diag_field('ocean_model', 'ML_buoy_restrat', diag%axesT1, Time, & - 'Mixed Layer Buoyancy as used in the mixed-layer restratification parameterization', 'm s2') + 'Mixed Layer Buoyancy as used in the mixed-layer restratification parameterization', & + 'm s2', conversion=GV%m_to_Z) CS%id_uDml = register_diag_field('ocean_model', 'udml_restrat', diag%axesCu1, Time, & 'Transport stream function amplitude for zonal restratification of mixed layer', 'm3 s-1') CS%id_vDml = register_diag_field('ocean_model', 'vdml_restrat', diag%axesCv1, Time, & From 8315caaff77db24e112f743eac4e7880dee3a62b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 9 Oct 2018 14:20:34 -0400 Subject: [PATCH 0809/1072] +Allow find_eta to specify units for eta Added a new optional argument to find_eta to specify the units to use in reporting the interface heights and eliminated the required G_Earth argument, instead obtaining this information from GV. These changes support dimensional consistency testing. All answers are bitwise identical, but some calls may need to use the new eta_to_m argument when Z_RESCALE_POWER is not 0, and the interface to find_eta has changed. --- src/ALE/MOM_ALE.F90 | 2 +- src/core/MOM.F90 | 8 +-- src/core/MOM_interface_heights.F90 | 72 ++++++++++--------- src/diagnostics/MOM_diagnostics.F90 | 6 +- src/diagnostics/MOM_sum_output.F90 | 2 +- .../MOM_state_initialization.F90 | 2 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 2 +- .../lateral/MOM_thickness_diffuse.F90 | 2 +- .../vertical/MOM_diabatic_driver.F90 | 4 +- 9 files changed, 52 insertions(+), 48 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 72acafef51..192b278a09 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -329,7 +329,7 @@ subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt, frac_shelf_h) if (CS%id_T_preale > 0) call post_data(CS%id_T_preale, tv%T, CS%diag) if (CS%id_S_preale > 0) call post_data(CS%id_S_preale, tv%S, CS%diag) if (CS%id_e_preale > 0) then - call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, eta_preale) + call find_eta(h, tv, G, GV, eta_preale, eta_to_m=1.0) call post_data(CS%id_e_preale, eta_preale, CS%diag) endif diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c117aad3b1..eaacbc8493 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -750,7 +750,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ! Determining the time-average sea surface height is part of the algorithm. ! This may be eta_av if Boussinesq, or need to be diagnosed if not. CS%time_in_cycle = CS%time_in_cycle + dt - call find_eta(h, CS%tv, (GV%g_Earth*GV%m_to_Z), G, GV, ssh, CS%eta_av_bc) + call find_eta(h, CS%tv, G, GV, ssh, CS%eta_av_bc, eta_to_m=1.0) do j=js,je ; do i=is,ie CS%ssh_rint(i,j) = CS%ssh_rint(i,j) + dt*ssh(i,j) enddo ; enddo @@ -2432,9 +2432,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (.not.query_initialized(CS%ave_ssh_ibc,"ave_ssh",restart_CSp)) then if (CS%split) then - call find_eta(CS%h, CS%tv, (GV%g_Earth*GV%m_to_Z), G, GV, CS%ave_ssh_ibc, eta) + call find_eta(CS%h, CS%tv, G, GV, CS%ave_ssh_ibc, eta, eta_to_m=1.0) else - call find_eta(CS%h, CS%tv, (GV%g_Earth*GV%m_to_Z), G, GV, CS%ave_ssh_ibc) + call find_eta(CS%h, CS%tv, G, GV, CS%ave_ssh_ibc, eta_to_m=1.0) endif endif if (CS%split) deallocate(eta) @@ -2489,7 +2489,7 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) allocate(restart_CSp_tmp) restart_CSp_tmp = restart_CSp allocate(z_interface(SZI_(G),SZJ_(G),SZK_(G)+1)) - call find_eta(CS%h, CS%tv, (GV%g_Earth*GV%m_to_Z), G, GV, z_interface) + call find_eta(CS%h, CS%tv, G, GV, z_interface, eta_to_m=1.0) call register_restart_field(z_interface, "eta", .true., restart_CSp_tmp, & "Interface heights", "meter", z_grid='i') diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index 1ae571a733..c6c283dfc2 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -27,9 +27,8 @@ module MOM_interface_heights !! form for consistency with the calculation of the pressure gradient forces. !! Additionally, these height may be dilated for consistency with the !! corresponding time-average quantity from the barotropic calculation. -subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid - !! structure. +subroutine find_eta_3d(h, tv, G, GV, eta, eta_bt, halo_size, eta_to_m) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical !! grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H @@ -37,16 +36,17 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to !! various thermodynamic !! variables. - real, intent(in) :: G_Earth !< Earth gravitational - !! acceleration (m/s2). real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: eta !< layer interface heights - !! (meter). + !! (Z or 1/eta_to_m m). real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic !! variable that gives the "correct" free surface height (Boussinesq) or total water !! column mass per unit area (non-Boussinesq). This is used to dilate the layer. !! thicknesses when calculating interfaceheights, in H (m or kg m-2). integer, optional, intent(in) :: halo_size !< width of halo points on !! which to calculate eta. + real, optional, intent(in) :: eta_to_m !< The conversion factor from + !! the units of eta to m; by default this is GV%Z_to_m. + ! Local variables real :: p(SZI_(G),SZJ_(G),SZK_(G)+1) real :: dz_geo(SZI_(G),SZJ_(G),SZK_(G)) ! The change in geopotential height @@ -54,6 +54,7 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) real :: dilate(SZI_(G)) ! non-dimensional dilation factor real :: htot(SZI_(G)) ! total thickness H real :: I_gEarth + real :: Z_to_eta, H_to_eta, H_to_rho_eta ! Unit conversion factors with obvious names. integer i, j, k, isv, iev, jsv, jev, nz, halo halo = 0 ; if (present(halo_size)) halo = max(0,halo_size) @@ -64,18 +65,19 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) if ((isvG%ied) .or. (jsvG%jed)) & call MOM_error(FATAL,"find_eta called with an overly large halo_size.") - I_gEarth = 1.0 / G_Earth + Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = GV%Z_to_m / eta_to_m + H_to_eta = GV%H_to_Z * Z_to_eta + H_to_rho_eta = GV%H_to_kg_m2 * (GV%m_to_Z * Z_to_eta) + I_gEarth = Z_to_eta / GV%g_Earth -!$OMP parallel default(none) shared(isv,iev,jsv,jev,nz,eta,G,GV,h,eta_bt,tv,p, & -!$OMP G_Earth,dz_geo,halo,I_gEarth) & -!$OMP private(dilate,htot) +!$OMP parallel default(shared) private(dilate,htot) !$OMP do - do j=jsv,jev ; do i=isv,iev ; eta(i,j,nz+1) = -G%Zd_to_m*G%bathyT(i,j) ; enddo ; enddo + do j=jsv,jev ; do i=isv,iev ; eta(i,j,nz+1) = -Z_to_eta*G%bathyT(i,j) ; enddo ; enddo if (GV%Boussinesq) then !$OMP do do j=jsv,jev ; do k=nz,1,-1; do i=isv,iev - eta(i,j,K) = eta(i,j,K+1) + h(i,j,k)*GV%H_to_m + eta(i,j,K) = eta(i,j,K+1) + h(i,j,k)*H_to_eta enddo ; enddo ; enddo if (present(eta_bt)) then ! Dilate the water column to agree with the free surface height @@ -83,22 +85,22 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) !$OMP do do j=jsv,jev do i=isv,iev - dilate(i) = (eta_bt(i,j)*GV%H_to_m + G%Zd_to_m*G%bathyT(i,j)) / & - (eta(i,j,1) + G%Zd_to_m*G%bathyT(i,j)) + dilate(i) = (eta_bt(i,j)*H_to_eta + Z_to_eta*G%bathyT(i,j)) / & + (eta(i,j,1) + Z_to_eta*G%bathyT(i,j)) enddo do k=1,nz ; do i=isv,iev - eta(i,j,K) = dilate(i) * (eta(i,j,K) + G%Zd_to_m*G%bathyT(i,j)) - G%Zd_to_m*G%bathyT(i,j) + eta(i,j,K) = dilate(i) * (eta(i,j,K) + Z_to_eta*G%bathyT(i,j)) - Z_to_eta*G%bathyT(i,j) enddo ; enddo enddo endif else if (associated(tv%eqn_of_state)) then - ! ### THIS SHOULD BE P_SURF, IF AVAILABLE. !$OMP do do j=jsv,jev + ! ### THIS SHOULD BE P_SURF, IF AVAILABLE. do i=isv,iev ; p(i,j,1) = 0.0 ; enddo do k=1,nz ; do i=isv,iev - p(i,j,K+1) = p(i,j,K) + G_Earth*GV%H_to_kg_m2*h(i,j,k) + p(i,j,K+1) = p(i,j,K) + GV%H_to_Pa*h(i,j,k) enddo ; enddo enddo !$OMP do @@ -115,7 +117,7 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) else !$OMP do do j=jsv,jev ; do k=nz,1,-1; do i=isv,iev - eta(i,j,K) = eta(i,j,K+1) + GV%H_to_kg_m2*h(i,j,k)/GV%Rlay(k) + eta(i,j,K) = eta(i,j,K+1) + H_to_rho_eta*h(i,j,k)/GV%Rlay(k) enddo ; enddo ; enddo endif if (present(eta_bt)) then @@ -127,7 +129,7 @@ subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) do k=1,nz ; do i=isv,iev ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo do i=isv,iev ; dilate(i) = eta_bt(i,j) / htot(i) ; enddo do k=1,nz ; do i=isv,iev - eta(i,j,K) = dilate(i) * (eta(i,j,K) + G%Zd_to_m*G%bathyT(i,j)) - G%Zd_to_m*G%bathyT(i,j) + eta(i,j,K) = dilate(i) * (eta(i,j,K) + Z_to_eta*G%bathyT(i,j)) - Z_to_eta*G%bathyT(i,j) enddo ; enddo enddo endif @@ -140,7 +142,7 @@ end subroutine find_eta_3d !! with the calculation of the pressure gradient forces. Additionally, the sea !! surface height may be adjusted for consistency with the corresponding !! time-average quantity from the barotropic calculation. -subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) +subroutine find_eta_2d(h, tv, G, GV, eta, eta_bt, halo_size, eta_to_m) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid !! structure. @@ -149,8 +151,6 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to !! various thermodynamic !! variables. - real, intent(in) :: G_Earth !< Earth gravitational - !! acceleration (m/s2). real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta !< free surface height !! relative to mean sea !! level (z=0) (m). @@ -159,37 +159,41 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) !! water column mass per unit area (non-Boussinesq), in H (m or kg m-2). integer, optional, intent(in) :: halo_size !< width of halo points on !! which to calculate eta. + real, optional, intent(in) :: eta_to_m !< The conversion factor from + !! the units of eta to m; by default this is GV%Z_to_m. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & p ! The pressure in Pa. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & dz_geo ! The change in geopotential height across a layer, in m2 s-2. - real :: htot(SZI_(G)) ! The sum of all layers' thicknesses, in kg m-2 or m. + real :: htot(SZI_(G)) ! The sum of all layers' thicknesses, in H. real :: I_gEarth + real :: Z_to_eta, H_to_eta, H_to_rho_eta ! Unit conversion factors with obvious names. integer i, j, k, is, ie, js, je, nz, halo halo = 0 ; if (present(halo_size)) halo = max(0,halo_size) is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo nz = G%ke - I_gEarth = 1.0 / G_Earth + Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = GV%Z_to_m / eta_to_m + H_to_eta = GV%H_to_Z * Z_to_eta + H_to_rho_eta = GV%H_to_kg_m2 * (GV%m_to_Z * Z_to_eta) + I_gEarth = Z_to_eta / GV%g_Earth -!$OMP parallel default(none) shared(is,ie,js,je,nz,eta,G,GV,eta_bt,h,tv,p, & -!$OMP G_Earth,dz_geo,halo,I_gEarth) & -!$OMP private(htot) +!$OMP parallel default(shared) private(htot) !$OMP do - do j=js,je ; do i=is,ie ; eta(i,j) = -G%Zd_to_m*G%bathyT(i,j) ; enddo ; enddo + do j=js,je ; do i=is,ie ; eta(i,j) = -Z_to_eta*G%bathyT(i,j) ; enddo ; enddo if (GV%Boussinesq) then if (present(eta_bt)) then !$OMP do do j=js,je ; do i=is,ie - eta(i,j) = GV%H_to_m*eta_bt(i,j) + eta(i,j) = H_to_eta*eta_bt(i,j) enddo ; enddo else !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie - eta(i,j) = eta(i,j) + h(i,j,k)*GV%H_to_m + eta(i,j) = eta(i,j) + h(i,j,k)*H_to_eta enddo ; enddo ; enddo endif else @@ -199,7 +203,7 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) do i=is,ie ; p(i,j,1) = 0.0 ; enddo do k=1,nz ; do i=is,ie - p(i,j,k+1) = p(i,j,k) + G_Earth*GV%H_to_kg_m2*h(i,j,k) + p(i,j,k+1) = p(i,j,k) + GV%H_to_Pa*h(i,j,k) enddo ; enddo enddo !$OMP do @@ -214,7 +218,7 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) else !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie - eta(i,j) = eta(i,j) + GV%H_to_kg_m2*h(i,j,k)/GV%Rlay(k) + eta(i,j) = eta(i,j) + H_to_rho_eta*h(i,j,k)/GV%Rlay(k) enddo ; enddo ; enddo endif if (present(eta_bt)) then @@ -225,8 +229,8 @@ subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) do i=is,ie ; htot(i) = GV%H_subroundoff ; enddo do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo do i=is,ie - eta(i,j) = (eta_bt(i,j) / htot(i)) * (eta(i,j) + G%Zd_to_m*G%bathyT(i,j)) - & - G%Zd_to_m*G%bathyT(i,j) + eta(i,j) = (eta_bt(i,j) / htot(i)) * (eta(i,j) + Z_to_eta*G%bathyT(i,j)) - & + Z_to_eta*G%bathyT(i,j) enddo enddo endif diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 60340287a3..30101c91a0 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -284,7 +284,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_h > 0) call post_data(CS%id_h, h, CS%diag) if (associated(CS%e)) then - call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, CS%e, eta_bt) + call find_eta(h, tv, G, GV, CS%e, eta_bt, eta_to_m=1.0) if (CS%id_e > 0) call post_data(CS%id_e, CS%e, CS%diag) endif @@ -294,7 +294,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & CS%e_D(i,j,k) = CS%e(i,j,k) + G%Zd_to_m*G%bathyT(i,j) enddo ; enddo ; enddo else - call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, CS%e_D, eta_bt) + call find_eta(h, tv, G, GV, CS%e_D, eta_bt, eta_to_m=1.0) do k=1,nz+1 ; do j=js,je ; do i=is,ie CS%e_D(i,j,k) = CS%e_D(i,j,k) + G%Zd_to_m*G%bathyT(i,j) enddo ; enddo ; enddo @@ -815,7 +815,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) endif if (CS%id_col_ht > 0) then - call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, z_top) + call find_eta(h, tv, G, GV, z_top, eta_to_m=1.0) do j=js,je ; do i=is,ie z_bot(i,j) = z_top(i,j) + G%Zd_to_m*G%bathyT(i,j) enddo ; enddo diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index e464d565fa..91a4dd96ab 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -498,7 +498,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc enddo ; enddo ; enddo mass_tot = reproducing_sum(tmp1, sums=mass_lay, EFP_sum=mass_EFP) - call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, eta) + call find_eta(h, tv, G, GV, eta, eta_to_m=1.0) do k=1,nz ; do j=js,je ; do i=is,ie tmp1(i,j,k) = (eta(i,j,K)-eta(i,j,K+1)) * areaTm(i,j) enddo ; enddo ; enddo diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 02ca818dfb..b19e6fc518 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1031,7 +1031,7 @@ subroutine depress_surface(h, G, GV, param_file, tv, just_read_params) call MOM_read_data(filename, eta_srf_var, eta_sfc, G%Domain, scale=scale_factor) ! Convert thicknesses to interface heights. - call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, eta) + call find_eta(h, tv, G, GV, eta, eta_to_m=1.0) do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then ! if (eta_sfc(i,j) < eta(i,j,nz+1)) then diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 6065062b83..eace701a6c 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -393,7 +393,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS) "Module must be initialized before it is used.") if (CS%calculate_Eady_growth_rate) then - call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, e, halo_size=2) + call find_eta(h, tv, G, GV, e, halo_size=2, eta_to_m=1.0) if (CS%use_stored_slopes) then call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, & CS%slope_x, CS%slope_y, N2_u, N2_v, 1) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 5a72723b07..b7b0fc105c 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -162,7 +162,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS enddo ; enddo ! Calculates interface heights, e, in m. - call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, e, halo_size=1) + call find_eta(h, tv, G, GV, e, halo_size=1, eta_to_m=1.0) ! Set the diffusivities. !$OMP parallel default(none) shared(is,ie,js,je,Khth_Loc_u,CS,use_VarMix,VarMix, & diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index a82cb12e44..88f28f8937 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -405,7 +405,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) if (CS%id_e_predia > 0) then - call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, eta) + call find_eta(h, tv, G, GV, eta, eta_to_m=1.0) call post_data(CS%id_e_predia, eta, CS%diag) endif @@ -1278,7 +1278,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) if (CS%id_e_predia > 0) then - call find_eta(h, tv, (GV%g_Earth*GV%m_to_Z), G, GV, eta) + call find_eta(h, tv, G, GV, eta, eta_to_m=1.0) call post_data(CS%id_e_predia, eta, CS%diag) endif From 1d881a163bd2d97067ce74c60fea21154197cfac Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 10 Oct 2018 06:13:43 -0400 Subject: [PATCH 0810/1072] Recast thickness_diffuse to work in units of Z Recast the internal calculations in thickness_diffuse to use vertical height units of Z in place of m for dimensional consistency testing. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- .../lateral/MOM_thickness_diffuse.F90 | 177 +++++++++--------- 1 file changed, 88 insertions(+), 89 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index b7b0fc105c..caad72b3a4 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -86,7 +86,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion ! Local variables real :: e(SZI_(G), SZJ_(G), SZK_(G)+1) ! heights of interfaces, relative to mean - ! sea level,in H units, positive up. + ! sea level, in Z, positive up. real :: uhD(SZIB_(G), SZJ_(G), SZK_(G)) ! uhD & vhD are the diffusive u*h & real :: vhD(SZI_(G), SZJB_(G), SZK_(G)) ! v*h fluxes (m2 H s-1) @@ -111,7 +111,6 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS KH_v_CFL ! The maximum stable interface height diffusivity at v grid points (m2 s-1) real :: Khth_Loc_u(SZIB_(G), SZJ_(G)) real :: Khth_Loc(SZIB_(G), SZJB_(G)) ! locally calculated thickness diffusivity (m2/s) - real :: H_to_m, m_to_H ! Local copies of unit conversion factors. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. real, dimension(:,:), pointer :: cg1 => null() !< Wave speed (m/s) @@ -130,7 +129,6 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke h_neglect = GV%H_subroundoff - H_to_m = GV%H_to_m ; m_to_H = GV%m_to_H if (associated(MEKE)) then if (associated(MEKE%GM_src)) then @@ -162,7 +160,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS enddo ; enddo ! Calculates interface heights, e, in m. - call find_eta(h, tv, G, GV, e, halo_size=1, eta_to_m=1.0) + call find_eta(h, tv, G, GV, e, halo_size=1) ! Set the diffusivities. !$OMP parallel default(none) shared(is,ie,js,je,Khth_Loc_u,CS,use_VarMix,VarMix, & @@ -402,15 +400,15 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV CS, int_slope_u, int_slope_v, slope_x, slope_y) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg/m2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions (m) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions (Z) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: Kh_u !< Thickness diffusivity on interfaces !! at u points (m2/s) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: Kh_v !< Thickness diffusivity on interfaces !! at v points (m2/s) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uhD !< Zonal mass fluxes (m3/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vhD !< Meridional mass fluxes (m3/s) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uhD !< Zonal mass fluxes (m2 H s-1) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vhD !< Meridional mass fluxes (m2 H s-1) real, dimension(:,:), pointer :: cg1 !< Wave speed (m/s) real, intent(in) :: dt !< Time increment (s) type(MEKE_type), pointer :: MEKE !< MEKE control structue @@ -425,6 +423,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !! density gradients. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), optional, intent(in) :: slope_x !< Isopycnal slope at u-points real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), optional, intent(in) :: slope_y !< Isopycnal slope at v-points + ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & T, & ! The temperature (or density) in C, with the values in @@ -434,12 +433,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV Rho, & ! Density itself, when a nonlinear equation of state is ! not in use. h_avail, & ! The mass available for diffusion out of each face, divided - ! by dt, in m3 s-1. + ! by dt, in H m2 s-1. h_frac ! The fraction of the mass in the column above the bottom ! interface of a layer that is within a layer, ND. 0 0.0) then Slope = drdx / sqrt(mag_grad2) slope2_Ratio_u(I,K) = Slope**2 * I_slope_max2 @@ -693,13 +689,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! that ignore density gradients along layers. if (present_int_slope_u) then Slope = (1.0 - int_slope_u(I,j,K)) * Slope + & - int_slope_u(I,j,K) * ((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)) + int_slope_u(I,j,K) * GV%Z_to_m*((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)) slope2_Ratio_u(I,K) = (1.0 - int_slope_u(I,j,K)) * slope2_Ratio_u(I,K) endif if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope ! Estimate the streamfunction at each interface (m3 s-1). - Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*Slope) + Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*GV%m_to_Z*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -725,11 +721,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_x) then Slope = slope_x(I,j,k) else - Slope = ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) + Slope = GV%Z_to_m*((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) endif if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope - Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*Slope) - hN2_u(I,K) = GV%g_prime(K)*GV%m_to_Z + Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*GV%m_to_Z*Slope) + hN2_u(I,K) = GV%g_prime(K) endif ! if (use_EOS) else ! if (k > nk_linear) hN2_u(I,K) = N2_floor * dz_neglect @@ -741,9 +737,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (CS%use_FGNV_streamfn) then do k=1,nz ; do I=is-1,ie ; if (G%mask2dCu(I,j)>0.) then - h_harm = H_to_m * max( h_neglect, & + h_harm = max( h_neglect, & 2. * h(i,j,k) * h(i+1,j,k) / ( ( h(i,j,k) + h(i+1,j,k) ) + h_neglect ) ) - c2_h_u(I,k) = CS%FGNV_scale * ( 0.5*( cg1(i,j) + cg1(i+1,j) ) )**2 / h_harm + c2_h_u(I,k) = CS%FGNV_scale * ( 0.5*( cg1(i,j) + cg1(i+1,j) ) )**2 / (GV%H_to_Z*h_harm) endif ; enddo ; enddo ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. @@ -764,9 +760,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (uhtot(I,j) <= 0.0) then ! The transport that must balance the transport below is positive. - Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i,j,k)) * H_to_m + Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i,j,k)) * GV%H_to_Z else ! (uhtot(I,j) > 0.0) - Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i+1,j,k)) * H_to_m + Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i+1,j,k)) * GV%H_to_Z endif ! The actual streamfunction at each interface. @@ -777,7 +773,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Make sure that there is enough mass above to allow the streamfunction ! to satisfy the boundary condition of 0 at the surface. - Sfn_in_h = min(max(Sfn_est * m_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i+1,j,K)) + Sfn_in_h = min(max(Sfn_est * GV%Z_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i+1,j,K)) ! The actual transport is limited by the mass available in the two ! neighboring grid cells. @@ -819,7 +815,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! A second order centered estimate is used for the density transfered ! between water columns. - Work_u(I,j) = Work_u(I,j) + ( G_scale * H_to_m ) * & + Work_u(I,j) = Work_u(I,j) + G_scale * & ( uhtot(I,j) * drdkDe_u(I,K) - & (uhD(I,j,K) * drdi_u(I,K)) * 0.25 * & ((e(i,j,K) + e(i,j,K+1)) + (e(i+1,j,K) + e(i+1,j,K+1))) ) @@ -836,7 +832,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !$OMP int_slope_v,KH_v,vhtot,h_frac,h_avail_rsum, & !$OMP vhD,h_avail,G_scale,Work_v,CS,slope_y,cg1, & !$OMP diag_sfn_y, diag_sfn_unlim_y,N2_floor, & -!$OMP present_slope_y,m_to_H,H_to_m,G_rho0) & +!$OMP present_slope_y,G_rho0) & !$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, & !$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, & !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & @@ -890,7 +886,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV haL = 0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect haR = 0.5*(h(i,j+1,k-1) + h(i,j+1,k)) + h_neglect if (GV%Boussinesq) then - dzaL = haL * H_to_m ; dzaR = haR * H_to_m + dzaL = haL * GV%H_to_Z ; dzaR = haR * GV%H_to_Z else dzaL = 0.5*(e(i,j,K-1) - e(i,j,K+1)) + dz_neglect dzaR = 0.5*(e(i,j+1,K-1) - e(i,j+1,K+1)) + dz_neglect @@ -909,8 +905,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV haB = 0.5*(h(i,j,k) + h(i,j+1,k)) + h_neglect ! hN2_v is used with the FGNV streamfunction formulation - hN2_v(i,K) = (0.5 * H_to_m * ( hg2A / haA + hg2B / haB )) * & - max(drdz*G_rho0 , N2_floor) + hN2_v(i,K) = (0.5 * GV%H_to_Z * ( hg2A / haA + hg2B / haB )) * & + max(drdz*G_rho0, N2_floor) endif if (present_slope_y) then Slope = slope_y(i,J,k) @@ -925,7 +921,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdy**2 + drdz**2 + mag_grad2 = drdy**2 + (GV%m_to_Z*drdz)**2 if (mag_grad2 > 0.0) then Slope = drdy / sqrt(mag_grad2) slope2_Ratio_v(i,K) = Slope**2 * I_slope_max2 @@ -939,13 +935,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! that ignore density gradients along layers. if (present_int_slope_v) then Slope = (1.0 - int_slope_v(i,J,K)) * Slope + & - int_slope_v(i,J,K) * ((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)) + int_slope_v(i,J,K) * GV%Z_to_m*((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)) slope2_Ratio_v(i,K) = (1.0 - int_slope_v(i,J,K)) * slope2_Ratio_v(i,K) endif if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope ! Estimate the streamfunction at each interface (m3 s-1). - Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*Slope) + Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*GV%m_to_Z*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -971,11 +967,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_y) then Slope = slope_y(i,J,k) else - Slope = ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) + Slope = GV%Z_to_m*((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) endif if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope - Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*Slope) - hN2_v(i,K) = GV%g_prime(K)*GV%m_to_Z + Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*GV%m_to_Z*Slope) + hN2_v(i,K) = GV%g_prime(K) endif ! if (use_EOS) else ! if (k > nk_linear) hN2_v(i,K) = N2_floor * dz_neglect @@ -987,9 +983,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (CS%use_FGNV_streamfn) then do k=1,nz ; do i=is,ie ; if (G%mask2dCv(i,J)>0.) then - h_harm = H_to_m * max( h_neglect, & + h_harm = max( h_neglect, & 2. * h(i,j,k) * h(i,j+1,k) / ( ( h(i,j,k) + h(i,j+1,k) ) + h_neglect ) ) - c2_h_v(i,k) = CS%FGNV_scale * ( 0.5*( cg1(i,j) + cg1(i,j+1) ) )**2 / h_harm + c2_h_v(i,k) = CS%FGNV_scale * ( 0.5*( cg1(i,j) + cg1(i,j+1) ) )**2 / (GV%H_to_Z*h_harm) endif ; enddo ; enddo ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. @@ -1010,9 +1006,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (vhtot(i,J) <= 0.0) then ! The transport that must balance the transport below is positive. - Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j,k)) * H_to_m + Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j,k)) * GV%H_to_Z else ! (vhtot(I,j) > 0.0) - Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j+1,k)) * H_to_m + Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j+1,k)) * GV%H_to_Z endif ! The actual streamfunction at each interface. @@ -1023,7 +1019,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Make sure that there is enough mass above to allow the streamfunction ! to satisfy the boundary condition of 0 at the surface. - Sfn_in_h = min(max(Sfn_est * m_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i,j+1,K)) + Sfn_in_h = min(max(Sfn_est * GV%Z_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i,j+1,K)) ! The actual transport is limited by the mass available in the two ! neighboring grid cells. @@ -1065,7 +1061,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! A second order centered estimate is used for the density transfered ! between water columns. - Work_v(i,J) = Work_v(i,J) + ( G_scale * H_to_m ) * & + Work_v(i,J) = Work_v(i,J) + G_scale * & ( vhtot(i,J) * drdkDe_v(i,K) - & (vhD(i,J,K) * drdj_v(i,K)) * 0.25 * & ((e(i,j,K) + e(i,j,K+1)) + (e(i,j+1,K) + e(i,j+1,K+1))) ) @@ -1098,7 +1094,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV drdiB = drho_dT_u(I) * (T(i+1,j,1)-T(i,j,1)) + & drho_dS_u(I) * (S(i+1,j,1)-S(i,j,1)) endif - Work_u(I,j) = Work_u(I,j) + ( G_scale * H_to_m ) * & + Work_u(I,j) = Work_u(I,j) + G_scale * & ( (uhD(I,j,1) * drdiB) * 0.25 * & ((e(i,j,1) + e(i,j,2)) + (e(i+1,j,1) + e(i+1,j,2))) ) @@ -1123,7 +1119,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV drdjB = drho_dT_v(i) * (T(i,j+1,1)-T(i,j,1)) + & drho_dS_v(i) * (S(i,j+1,1)-S(i,j,1)) endif - Work_v(i,J) = Work_v(i,J) - ( G_scale * H_to_m ) * & + Work_v(i,J) = Work_v(i,J) - G_scale * & ( (vhD(i,J,1) * drdjB) * 0.25 * & ((e(i,j,1) + e(i,j,2)) + (e(i,j+1,1) + e(i,j+1,2))) ) enddo @@ -1154,7 +1150,7 @@ subroutine streamfn_solver(nk, c2_h, hN2, sfn) integer, intent(in) :: nk !< Number of layers real, dimension(nk), intent(in) :: c2_h !< Wave speed squared over thickness in layers (m s-2) real, dimension(nk+1), intent(in) :: hN2 !< Thickness times N2 at interfaces (m s-2) - real, dimension(nk+1), intent(inout) :: sfn !< Streamfunction (m3 s-1) + real, dimension(nk+1), intent(inout) :: sfn !< Streamfunction (Z m2 s-1 or arbitrary units) !! On entry, equals diffusivity times slope. !! On exit, equals the streamfunction. ! Local variables @@ -1188,7 +1184,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (H) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions (m) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions (Z) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kh_u !< Thickness diffusivity on interfaces !! at u points (m2/s) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: Kh_v !< Thickness diffusivity on interfaces @@ -1248,7 +1244,8 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV real :: sl_Kp1 ! The sign-corrected slope of the interface below, ND. real :: I_sl_K ! The (limited) inverse of sl_K, ND. real :: I_sl_Kp1 ! The (limited) inverse of sl_Kp1, ND. - real :: I_4t ! A quarter of inverse of the damping timescale, in s-1. + real :: I_4t ! A quarter of a unit conversion factor divided by + ! the damping timescale, in s-1. real :: Fn_R ! A function of Rsl, such that Rsl < Fn_R < 1. real :: denom, I_denom ! A denominator and its inverse, various units. real :: Kh_min ! A local floor on the diffusivity, in m2 s-1. @@ -1344,7 +1341,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Limit the diffusivities - I_4t = Kh_scale / (4.0*dt) + I_4t = GV%Z_to_m*Kh_scale / (4.0*dt) do n=1,2 if (n==1) then ; jsh = js ; ish = is-1 @@ -1387,7 +1384,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! dH = I_4t * (h(i+1,j,k) - h(i,j,k)) / denom adH = abs(dH) - sign = 1.0 ; if (dH < 0) sign = -1.0 + sign = 1.0*GV%Z_to_m ; if (dH < 0) sign = -1.0*GV%Z_to_m sl_K = sign * (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) sl_Kp1 = sign * (e(i+1,j,K+1)-e(i,j,K+1)) * G%IdxCu(I,j) @@ -1410,7 +1407,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! dH = I_4t * (h(i,j+1,k) - h(i,j,k)) / denom adH = abs(dH) - sign = 1.0 ; if (dH < 0) sign = -1.0 + sign = 1.0*GV%Z_to_m ; if (dH < 0) sign = -1.0*GV%Z_to_m sl_K = sign * (e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J) sl_Kp1 = sign * (e(i,j+1,K+1)-e(i,j,K+1)) * G%IdyCv(i,J) @@ -1821,9 +1818,11 @@ subroutine thickness_diffuse_init(Time, G, GV, param_file, diag, CDp, CS) CS%id_sfn_y = register_diag_field('ocean_model', 'GM_sfn_y', diag%axesCvi, Time, & 'Parameterized Meridional Overturning Streamfunction', 'm3 s-1') CS%id_sfn_unlim_x = register_diag_field('ocean_model', 'GM_sfn_unlim_x', diag%axesCui, Time, & - 'Parameterized Zonal Overturning Streamfunction before limiting/smoothing', 'm3 s-1') + 'Parameterized Zonal Overturning Streamfunction before limiting/smoothing', & + 'm3 s-1', conversion=GV%Z_to_m) CS%id_sfn_unlim_y = register_diag_field('ocean_model', 'GM_sfn_unlim_y', diag%axesCvi, Time, & - 'Parameterized Meridional Overturning Streamfunction before limiting/smoothing', 'm3 s-1') + 'Parameterized Meridional Overturning Streamfunction before limiting/smoothing', & + 'm3 s-1', conversion=GV%Z_to_m) end subroutine thickness_diffuse_init From d6dc15710af8e30445787aedbf1b98ceaa840ee7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 10 Oct 2018 07:03:24 -0400 Subject: [PATCH 0811/1072] Recast calc_slope_functions to work in units of Z Recast the internal calculations in calc_slope_functions to use vertical height units of Z in place of m for dimensional consistency testing. Also eliminated an unused argument, e, from calc_Visbeck_coeffs. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 39 +++++++------------ 1 file changed, 15 insertions(+), 24 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index eace701a6c..583fad8c75 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -397,7 +397,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS) if (CS%use_stored_slopes) then call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, & CS%slope_x, CS%slope_y, N2_u, N2_v, 1) - call calc_Visbeck_coeffs(h, e, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, CS) + call calc_Visbeck_coeffs(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, CS) ! call calc_slope_functions_using_just_e(h, G, CS, e, .false.) else !call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, CS%slope_x, CS%slope_y) @@ -417,11 +417,10 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS) end subroutine calc_slope_functions !> Calculates factors used when setting diffusivity coefficients similar to Visbeck et al. -subroutine calc_Visbeck_coeffs(h, e, slope_x, slope_y, N2_u, N2_v, G, GV, CS) +subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg/m2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface position (m) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: slope_x !< Zonal isoneutral slope real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: N2_u !< Brunt-Vaisala frequency at u-points (1/s2) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: slope_y !< Meridional isoneutral slope @@ -620,20 +619,11 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) h_neglect = GV%H_subroundoff H_cutoff = real(2*nz) * (GV%Angstrom_H + h_neglect) -!$OMP parallel default(none) shared(is,ie,js,je,CS,nz,e,G,GV,h,H_cutoff,h_neglect, & -!$OMP one_meter,SN_u_local,SN_v_local,calculate_slopes) & -!$OMP private(E_x,E_y,S2,Hdn,Hup,H_geom,N2) -!$OMP do - do j=js-1,je+1 ; do i=is-1,ie+1 - CS%SN_u(i,j) = 0.0 - CS%SN_v(i,j) = 0.0 - enddo ; enddo - ! To set the length scale based on the deformation radius, use wave_speed to ! calculate the first-mode gravity wave speed and then blend the equatorial ! and midlatitude deformation radii, using calc_resoln_function as a template. -!$OMP do + !$OMP parallel do default(shared) private(E_x,E_y,S2,Hdn,Hup,H_geom,N2) do k=nz,CS%VarMix_Ktop,-1 if (calculate_slopes) then @@ -669,7 +659,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) N2 = GV%g_prime(k)*GV%m_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) if (min(h(i,j,k-1), h(i+1,j,k-1), h(i,j,k), h(i+1,j,k)) < H_cutoff) & S2 = 0.0 - SN_u_local(I,j,k) = (H_geom * GV%H_to_m) * S2 * N2 + SN_u_local(I,j,k) = (H_geom * GV%H_to_Z) * S2 * N2 enddo ; enddo do J=js-1,je ; do i=is,ie S2 = ( E_y(i,J)**2 + 0.25*( & @@ -680,44 +670,45 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) N2 = GV%g_prime(k)*GV%m_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) if (min(h(i,j,k-1), h(i,j+1,k-1), h(i,j,k), h(i,j+1,k)) < H_cutoff) & S2 = 0.0 - SN_v_local(i,J,k) = (H_geom * GV%H_to_m) * S2 * N2 + SN_v_local(i,J,k) = (H_geom * GV%H_to_Z) * S2 * N2 enddo ; enddo enddo ! k -!$OMP do - do j = js,je + !$OMP parallel do default(shared) + do j=js,je + do I=is-1,ie ; CS%SN_u(I,j) = 0.0 ; enddo do k=nz,CS%VarMix_Ktop,-1 ; do I=is-1,ie CS%SN_u(I,j) = CS%SN_u(I,j) + SN_u_local(I,j,k) enddo ; enddo ! SN above contains S^2*N^2*H, convert to vertical average of S*N do I=is-1,ie - !SN_u(I,j) = sqrt( SN_u(I,j) / (G%Zd_to_m*( max(G%bathyT(I,j), G%bathyT(I+1,j)) + GV%Angstrom_Z ) )) + !SN_u(I,j) = sqrt( SN_u(I,j) / ( max(G%bathyT(I,j), G%bathyT(I+1,j)) + GV%Angstrom_Z ) )) !The code below behaves better than the line above. Not sure why? AJA if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_Z ) then CS%SN_u(I,j) = G%mask2dCu(I,j) * sqrt( CS%SN_u(I,j) / & - (G%Zd_to_m*max(G%bathyT(I,j), G%bathyT(I+1,j))) ) + (max(G%bathyT(I,j), G%bathyT(I+1,j))) ) else CS%SN_u(I,j) = 0.0 endif enddo enddo -!$OMP do + !$OMP parallel do default(shared) do J=js-1,je - do k=nz,CS%VarMix_Ktop,-1 ; do I=is,ie + do i=is,ie ; CS%SN_v(i,J) = 0.0 ; enddo + do k=nz,CS%VarMix_Ktop,-1 ; do i=is,ie CS%SN_v(i,J) = CS%SN_v(i,J) + SN_v_local(i,J,k) enddo ; enddo do i=is,ie - !SN_v(i,J) = sqrt( SN_v(i,J) / (G%Zd_to_m*( max(G%bathyT(i,J), G%bathyT(i,J+1)) + GV%Angstrom_Z ) )) + !SN_v(i,J) = sqrt( SN_v(i,J) / ( max(G%bathyT(i,J), G%bathyT(i,J+1)) + GV%Angstrom_Z ) )) !The code below behaves better than the line above. Not sure why? AJA if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_Z ) then CS%SN_v(i,J) = G%mask2dCv(i,J) * sqrt( CS%SN_v(i,J) / & - (G%Zd_to_m*max(G%bathyT(i,J), G%bathyT(i,J+1))) ) + (max(G%bathyT(i,J), G%bathyT(i,J+1))) ) else CS%SN_v(I,j) = 0.0 endif enddo enddo -!$OMP end parallel end subroutine calc_slope_functions_using_just_e From 373c23264bb9b56124d78f4b040c22169bc7a699 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Wed, 10 Oct 2018 11:39:22 -0400 Subject: [PATCH 0812/1072] Diag decimation prototype, fix masks for non-native grids - All decimated axes need to have the non-decimated mask3d fields initialized correctly. The non-decimated masks are being used in the decimation algorithm for the diagnostics fields --- src/framework/MOM_diag_mediator.F90 | 128 ++++++++++++++++++---------- 1 file changed, 85 insertions(+), 43 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 9bce490007..02033958f0 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -768,33 +768,44 @@ subroutine set_masks_for_axes_decim(G, diag_cs) integer :: dl type(axes_grp), pointer :: axes => NULL(), h_axes => NULL() ! Current axes, for convenience + !Each decimated axis needs both decimated and non-decimated mask + !The decimated mask is needed for sending out the diagnostics output via diag_manager + !The non-decimated mask is needed for decimating the diagnostics field do dl=2,MAX_DECIM_LEV if(dl .ne. 2) call MOM_error(FATAL, "Decimation level other than 2 is not supported yet!") do c=1, diag_cs%num_diag_coords ! Level/layer h-points in diagnostic coordinate axes => diag_cs%remap_axesTL(c) - call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesTL(c)%decim(dl)%mask3d, dl) + call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesTL(c)%decim(dl)%mask3d, dl)!set decimated mask + diag_cs%decim(dl)%remap_axesTL(c)%mask3d => axes%mask3d !set non-decimated mask ! Level/layer u-points in diagnostic coordinate axes => diag_cs%remap_axesCuL(c) - call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesCuL(c)%decim(dl)%mask3d, dl) + call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesCuL(c)%decim(dl)%mask3d, dl)!set decimated mask + diag_cs%decim(dl)%remap_axesCul(c)%mask3d => axes%mask3d !set non-decimated mask ! Level/layer v-points in diagnostic coordinate axes => diag_cs%remap_axesCvL(c) - call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesCvL(c)%decim(dl)%mask3d, dl) + call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesCvL(c)%decim(dl)%mask3d, dl)!set decimated mask + diag_cs%decim(dl)%remap_axesCvL(c)%mask3d => axes%mask3d !set non-decimated mask ! Level/layer q-points in diagnostic coordinate axes => diag_cs%remap_axesBL(c) - call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesBL(c)%decim(dl)%mask3d, dl) + call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesBL(c)%decim(dl)%mask3d, dl)!set decimated mask + diag_cs%decim(dl)%remap_axesBL(c)%mask3d => axes%mask3d !set non-decimated mask ! Interface h-points in diagnostic coordinate (w-point) axes => diag_cs%remap_axesTi(c) - call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesTi(c)%decim(dl)%mask3d, dl) + call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesTi(c)%decim(dl)%mask3d, dl)!set decimated mask + diag_cs%decim(dl)%remap_axesTi(c)%mask3d => axes%mask3d !set non-decimated mask ! Interface u-points in diagnostic coordinate axes => diag_cs%remap_axesCui(c) - call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesCui(c)%decim(dl)%mask3d, dl) + call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesCui(c)%decim(dl)%mask3d, dl)!set decimated mask + diag_cs%decim(dl)%remap_axesCui(c)%mask3d => axes%mask3d !set non-decimated mask ! Interface v-points in diagnostic coordinate axes => diag_cs%remap_axesCvi(c) - call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesCvi(c)%decim(dl)%mask3d, dl) + call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesCvi(c)%decim(dl)%mask3d, dl)!set decimated mask + diag_cs%decim(dl)%remap_axesCvi(c)%mask3d => axes%mask3d !set non-decimated mask ! Interface q-points in diagnostic coordinate axes => diag_cs%remap_axesBi(c) - call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesBi(c)%decim(dl)%mask3d, dl) + call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesBi(c)%decim(dl)%mask3d, dl)!set decimated mask + diag_cs%decim(dl)%remap_axesBi(c)%mask3d => axes%mask3d !set non-decimated mask enddo enddo end subroutine set_masks_for_axes_decim @@ -3442,11 +3453,11 @@ subroutine decimate_diag_field_3d(locfield, locfield_decim, dl, diag_cs, diag,is call decimate_diag_indices_get(iel,jel, dl, diag_cs,isv,iev,jsv,jev) if (present(mask)) then locmask => mask - call decimate_field(locfield, locfield_decim, dl, method='pave', mask=locmask) + call decimate_field(locfield, locfield_decim, dl, method='pave', mask=locmask, area=diag_cs%G%areaT) elseif (associated(diag%axes%mask3d)) then - call decimate_field(locfield, locfield_decim, dl, method='pave', mask=diag%axes%mask3d) + call decimate_field(locfield, locfield_decim, dl, method='pave', mask=diag%axes%mask3d, area=diag_cs%G%areaT) else - call decimate_field(locfield, locfield_decim, dl, method='pave') !decimate without a mask, how ?? + call MOM_error(FATAL, "decimate_diag_field_3d: Cannot decimate without a mask!!! ") endif end subroutine decimate_diag_field_3d @@ -3471,22 +3482,23 @@ subroutine decimate_diag_field_2d(locfield, locfield_decim, dl, diag_cs, diag,is elseif (associated(diag%axes%mask2d)) then call decimate_field(locfield, locfield_decim, dl, method='pave', mask=diag%axes%mask2d) else - call decimate_field(locfield, locfield_decim, dl, method='pave') !decimate without a mask, how ?? + call MOM_error(FATAL, "decimate_diag_field_2d: Cannot decimate without a mask!!! ") endif end subroutine decimate_diag_field_2d -subroutine decimate_field_3d(field_in, field_out, level, method, mask) +subroutine decimate_field_3d(field_in, field_out, level, method, mask, area) real, dimension(:,:,:) , pointer :: field_in real, dimension(:,:,:) , allocatable :: field_out integer , intent(in) :: level character(len=4), optional, intent(in) :: method !< sampling method, one of samp,pave,aave,vave real, dimension(:,:,:), optional , pointer :: mask - !locals + real, dimension(:,:), optional , intent(in) :: area + !locals integer :: i,j,ii,jj,is,js,i0,j0 integer :: isl,iel,jsl,jel integer :: k,ks,ke - real :: ave,tot_non_zero + real :: ave,tot_non_zero,a1 character(len=4) :: samplemethod samplemethod = 'samp' if(present(method)) samplemethod = method @@ -3533,6 +3545,20 @@ subroutine decimate_field_3d(field_in, field_out, level, method, mask) field_out(i,j,k) = ave/tot_non_zero enddo; enddo; enddo endif + case ('aave') !area average of the cells + do k= ks,ke ; do j=jsl,jel ; do i=isl,iel + field_out(i,j,k) = 0.0 + i0 = is+level*(i-isl) + j0 = js+level*(j-jsl) + ave = 0.0 + tot_non_zero = 0.0 + do ii=i0,i0+level-1 ; do jj=j0,j0+level-1 + a1 = area(ii,jj)*mask(ii,jj,k) + tot_non_zero = tot_non_zero + a1 + ave=ave + field_in(ii,jj,k) * a1 + enddo; enddo + if(tot_non_zero .gt. 0.0) field_out(i,j,k) = ave/tot_non_zero + enddo; enddo; enddo case default call MOM_error(FATAL, "decimate_field_3d: unknown sampling method "//trim(samplemethod)) end select @@ -3602,22 +3628,25 @@ end subroutine decimate_field_2d subroutine decimate_mask_3d_p(field_in, field_out, level) integer , intent(in) :: level real, dimension(:,:,:) , pointer :: field_in, field_out - integer :: i,j,ii,jj,is,js + integer :: i,j,ii,jj,is,js,i0,j0 integer :: isl,iel,jsl,jel integer :: k,ks,ke - ! is = lbound(field_in,1) ; ie = ubound(field_in,1) - ! js = lbound(field_in,2) ; je = ubound(field_in,2) - !Always start from the first element + real :: tot_non_zero + !decimated mask = 0 unless the mask value of one of the decimating cells is 1 is=1 js=1 ks = lbound(field_in,3) ; ke = ubound(field_in,3) isl=1; iel=size(field_in,1)/level jsl=1; jel=size(field_in,2)/level - allocate(field_out(isl:iel,jsl:jel,ks:ke)) + allocate(field_out(isl:iel,jsl:jel,ks:ke)); field_out(:,:,:) = 0.0 do k= ks,ke ; do j=jsl,jel ; do i=isl,iel - ii = is+level*(i-isl) - jj = js+level*(j-jsl) - field_out(i,j,k) = field_in(ii,jj,k) + i0 = is+level*(i-isl) + j0 = js+level*(j-jsl) + tot_non_zero = 0.0 + do ii=i0,i0+level-1 ; do jj=j0,j0+level-1 + tot_non_zero = tot_non_zero + field_in(ii,jj,k) + enddo;enddo + if(tot_non_zero > 0.0) field_out(i,j,k)=1.0 enddo; enddo; enddo end subroutine decimate_mask_3d_p @@ -3625,18 +3654,23 @@ subroutine decimate_mask_2d_p(field_in, field_out, level) integer , intent(in) :: level real, dimension(:,:) , intent(in) :: field_in real, dimension(:,:) , pointer :: field_out - integer :: i,j,ii,jj,is,js + integer :: i,j,ii,jj,is,js,i0,j0 integer :: isl,iel,jsl,jel - !Always start from the first element + real :: tot_non_zero + !decimated mask = 0 unless the mask value of one of the decimating cells is 1 is=1 js=1 isl=1; iel=size(field_in,1)/level jsl=1; jel=size(field_in,2)/level - allocate(field_out(isl:iel,jsl:jel)) + allocate(field_out(isl:iel,jsl:jel)); field_out(:,:) = 0.0 do j=jsl,jel ; do i=isl,iel - ii = is+level*(i-isl) - jj = js+level*(j-jsl) - field_out(i,j) = field_in(ii,jj) + i0 = is+level*(i-isl) + j0 = js+level*(j-jsl) + tot_non_zero = 0.0 + do ii=i0,i0+level-1 ; do jj=j0,j0+level-1 + tot_non_zero = tot_non_zero + field_in(ii,jj) + enddo;enddo + if(tot_non_zero > 0.0) field_out(i,j)=1.0 enddo; enddo end subroutine decimate_mask_2d_p @@ -3644,22 +3678,25 @@ subroutine decimate_mask_3d_a(field_in, field_out, level) integer , intent(in) :: level real, dimension(:,:,:), pointer :: field_in real, dimension(:,:,:), allocatable :: field_out - integer :: i,j,ii,jj,is,js + integer :: i,j,ii,jj,is,js,i0,j0 integer :: isl,iel,jsl,jel integer :: k,ks,ke - ! is = lbound(field_in,1) ; ie = ubound(field_in,1) - ! js = lbound(field_in,2) ; je = ubound(field_in,2) - !Always start from the first element + real :: tot_non_zero + !decimated mask = 0 unless the mask value of one of the decimating cells is 1 is=1 js=1 ks = lbound(field_in,3) ; ke = ubound(field_in,3) isl=1; iel=size(field_in,1)/level jsl=1; jel=size(field_in,2)/level - allocate(field_out(isl:iel,jsl:jel,ks:ke)) + allocate(field_out(isl:iel,jsl:jel,ks:ke)); field_out(:,:,:) = 0.0 do k= ks,ke ; do j=jsl,jel ; do i=isl,iel - ii = is+level*(i-isl) - jj = js+level*(j-jsl) - field_out(i,j,k) = field_in(ii,jj,k) + i0 = is+level*(i-isl) + j0 = js+level*(j-jsl) + tot_non_zero = 0.0 + do ii=i0,i0+level-1 ; do jj=j0,j0+level-1 + tot_non_zero = tot_non_zero + field_in(ii,jj,k) + enddo;enddo + if(tot_non_zero > 0.0) field_out(i,j,k)=1.0 enddo; enddo; enddo end subroutine decimate_mask_3d_a @@ -3667,18 +3704,23 @@ subroutine decimate_mask_2d_a(field_in, field_out, level) integer , intent(in) :: level real, dimension(:,:) , intent(in) :: field_in real, dimension(:,:) , allocatable :: field_out - integer :: i,j,ii,jj,is,js + integer :: i,j,ii,jj,is,js,i0,j0 integer :: isl,iel,jsl,jel - !Always start from the first element + real :: tot_non_zero + !decimated mask = 0 unless the mask value of one of the decimating cells is 1 is=1 js=1 isl=1; iel=size(field_in,1)/level jsl=1; jel=size(field_in,2)/level - allocate(field_out(isl:iel,jsl:jel)) + allocate(field_out(isl:iel,jsl:jel)); field_out(:,:) = 0.0 do j=jsl,jel ; do i=isl,iel - ii = is+level*(i-isl) - jj = js+level*(j-jsl) - field_out(i,j) = field_in(ii,jj) + i0 = is+level*(i-isl) + j0 = js+level*(j-jsl) + tot_non_zero = 0.0 + do ii=i0,i0+level-1 ; do jj=j0,j0+level-1 + tot_non_zero = tot_non_zero + field_in(ii,jj) + enddo;enddo + if(tot_non_zero > 0.0) field_out(i,j)=1.0 enddo; enddo end subroutine decimate_mask_2d_a From 6ef7d1dc474c3a6c5db45ea6aad85571f3f68d53 Mon Sep 17 00:00:00 2001 From: "brandon.reichl" Date: Wed, 10 Oct 2018 16:30:00 -0400 Subject: [PATCH 0813/1072] Numerous modifications to improve Ideal hurricane config and wave functionality in such cases. - wave parameters passed to split dynamics for down-Stokes gradient momentum mixing. - KPP updates to compute SL and turbulent Langmuir number for paramaterization options. - KPP bug-fixes to pass waves to correct routines for their use. - wave_interface bug-fix so Stokes drift bands are properly initialized. --- src/core/MOM.F90 | 3 +- src/core/MOM_dynamics_split_RK2.F90 | 10 ++- .../vertical/MOM_CVMix_KPP.F90 | 31 ++++--- .../vertical/MOM_diabatic_driver.F90 | 4 +- src/user/MOM_wave_interface.F90 | 87 ++++++++++++++----- src/user/SCM_idealized_hurricane.F90 | 20 +++-- 6 files changed, 107 insertions(+), 48 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 54b5197ad9..95df27f185 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -956,7 +956,8 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call step_MOM_dyn_split_RK2(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, & - CS%eta_av_bc, G, GV, CS%dyn_split_RK2_CSp, calc_dtbt, CS%VarMix, CS%MEKE) + CS%eta_av_bc, G, GV, CS%dyn_split_RK2_CSp, calc_dtbt, CS%VarMix, CS%MEKE,& + waves=waves) if (showCallTree) call callTree_waypoint("finished step_MOM_dyn_split (step_MOM)") elseif (CS%do_dynamics) then ! ------------------------------------ not SPLIT diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 0f4bd88111..c62f628774 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -58,6 +58,7 @@ module MOM_dynamics_split_RK2 use MOM_vert_friction, only : updateCFLtruncationValue use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units use MOM_verticalGrid, only : get_flux_units, get_tr_flux_units +use MOM_wave_interface, only: wave_parameters_CS implicit none ; private @@ -228,7 +229,7 @@ module MOM_dynamics_split_RK2 subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & Time_local, dt, forces, p_surf_begin, p_surf_end, & uh, vh, uhtr, vhtr, eta_av, & - G, GV, CS, calc_dtbt, VarMix, MEKE) + G, GV, CS, calc_dtbt, VarMix, MEKE, Waves) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -262,7 +263,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & logical, intent(in) :: calc_dtbt !< if true, recalculate barotropic time step type(VarMix_CS), pointer :: VarMix !< specify the spatially varying viscosities type(MEKE_type), pointer :: MEKE !< related to mesoscale eddy kinetic energy param - + type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing + !! fields related to the surface wave conditions real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocity in m s-1. @@ -576,7 +578,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, CS%vertvisc_CSp, & CS%OBC) call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & - GV, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) + GV, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") if (G%nonblocking_updates) then call cpu_clock_end(id_clock_vertvisc) @@ -774,7 +776,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call cpu_clock_begin(id_clock_vertvisc) call vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS%vertvisc_CSp, CS%OBC) call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, & - CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) + CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot,waves=waves) if (G%nonblocking_updates) then call cpu_clock_end(id_clock_vertvisc) call start_group_pass(CS%pass_uv, G%Domain, clock=id_clock_pass) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 3253003119..137c81bfca 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -135,7 +135,9 @@ module MOM_CVMix_KPP integer :: id_NLT_dTdt = -1 integer :: id_NLT_temp_budget = -1 integer :: id_NLT_saln_budget = -1 - integer :: id_EnhK = -1, id_EnhW = -1, id_EnhVt2 = -1 + integer :: id_EnhK = -1, id_EnhVt2 = -1 + integer :: id_EnhW = -1 + integer :: id_La_SL = -1 integer :: id_OBLdepth_original = -1 !!@} @@ -522,6 +524,8 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive, Waves) 'Langmuir number enhancement to K as used by [CVMix] KPP','nondim') CS%id_EnhVt2 = register_diag_field('ocean_model', 'EnhVt2', diag%axesTL, Time, & 'Langmuir number enhancement to Vt2 as used by [CVMix] KPP','nondim') + CS%id_La_SL = register_diag_field('ocean_model', 'KPP_La_SL', diag%axesT1, Time, & + 'Surface-layer Langmuir number computed in [CVMix] KPP','nondim') allocate( CS%N( SZI_(G), SZJ_(G), SZK_(G)+1 ) ) CS%N(:,:,:) = 0. @@ -708,10 +712,12 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & if (CS%LT_K_METHOD==LT_K_MODE_CONSTANT) then LangEnhK = CS%KPP_K_ENH_FAC elseif (CS%LT_K_METHOD==LT_K_MODE_VR12) then - LangEnhK = min(10.,sqrt(1.+(1.5*WAVES%LangNum(i,j))**(-2) + & - (5.4*WAVES%LangNum(i,j))**(-4))) + ! Added minimum value for La_SL, so removed maximum value for LangEnhK. + LangEnhK = sqrt(1.+(1.5*WAVES%La_SL(i,j))**(-2) + & + (5.4*WAVES%La_SL(i,j))**(-4)) elseif (CS%LT_K_METHOD==LT_K_MODE_RW16) then - LangEnhK = min(2.25, 1. + 1./WAVES%LangNum(i,j)) + !This maximum value is proposed in Reichl et al., 2016 JPO formula + LangEnhK = min(2.25, 1. + 1./WAVES%La_SL(i,j)) else !This shouldn't be reached. !call MOM_error(WARNING,"Unexpected behavior in MOM_CVMix_KPP, see error in LT_K_ENHANCEMENT") @@ -916,7 +922,7 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux, real :: MLD_GUESS, LA real :: surfHuS, surfHvS, surfUs, surfVs, wavedir, currentdir real :: VarUp, VarDn, M, VarLo, VarAvg - real :: H10pct, H20pct,CMNFACT, USx20pct, USy20pct + real :: H10pct, H20pct,CMNFACT, USx20pct, USy20pct, enhvt2 integer :: B real :: WST @@ -1065,7 +1071,7 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux, MLD_GUESS = max( 1., abs(CS%OBLdepthprev(i,j) ) ) call get_Langmuir_Number( LA, G, GV, MLD_guess, surfFricVel, I, J, & H=H(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES) - WAVES%LangNum(i,j)=LA + WAVES%La_SL(i,j)=LA endif @@ -1112,20 +1118,24 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux, LangEnhVT2(k) = CS%KPP_VT2_ENH_FAC enddo elseif (CS%LT_VT2_METHOD==LT_VT2_MODE_VR12) then + !Introduced minimum value for La_SL, so maximum value for enhvt2 is removed. + enhvt2 = sqrt(1.+(1.5*WAVES%La_SL(i,j))**(-2) + & + (5.4*WAVES%La_SL(i,j))**(-4)) do k=1,G%ke - LangEnhVT2(k) = min(10.,sqrt(1.+(1.5*WAVES%LangNum(i,j))**(-2) + & - (5.4*WAVES%LangNum(i,j))**(-4))) + LangEnhVT2(k) = enhvt2 enddo elseif (CS%LT_VT2_METHOD==LT_VT2_MODE_RW16) then + !Introduced minimum value for La_SL, so maximum value for enhvt2 is removed. + enhvt2 = 1. + 2.3*WAVES%La_SL(i,j)**(-0.5) do k=1,G%ke - LangEnhVT2(k) = min(2.25, 1. + 1./WAVES%LangNum(i,j)) + LangEnhVT2(k) = enhvt2 enddo elseif (CS%LT_VT2_METHOD==LT_VT2_MODE_LF17) then CS%CS=cvmix_get_kpp_real('c_s',CS%KPP_params) do k=1,G%ke WST = (max(0.,-buoyflux(i,j,1))*(-cellHeight(k)))**(1./3.) LangEnhVT2(k) = sqrt((0.15*WST**3. + 0.17*surfFricVel**3.* & - (1.+0.49*WAVES%LangNum(i,j)**(-2.))) / & + (1.+0.49*WAVES%La_SL(i,j)**(-2.))) / & (0.2*ws_1d(k)**3/(CS%cs*CS%surf_layer_ext*CS%vonKarman**4.))) enddo else @@ -1298,6 +1308,7 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux, if (CS%id_BulkUz2 > 0) call post_data(CS%id_BulkUz2, CS%Uz2, CS%diag) if (CS%id_EnhK > 0) call post_data(CS%id_EnhK, CS%EnhK, CS%diag) if (CS%id_EnhVt2 > 0) call post_data(CS%id_EnhVt2, CS%EnhVt2, CS%diag) + if (CS%id_La_SL>0.and.present(WAVES)) call post_data(CS%id_La_SL,WAVES%La_SL,CS%diag) ! BLD smoothing: if (CS%n_smooth > 0) call KPP_smooth_BLD(CS,G,GV,h) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index e3806fd684..215f74c695 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -605,7 +605,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! The KPP scheme calculates boundary layer diffusivities and non-local transport. call KPP_compute_BLD(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, & - fluxes%ustar, CS%KPP_buoy_flux) + fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) call KPP_calculate(CS%KPP_CSp, G, GV, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) @@ -1523,7 +1523,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !$OMP end parallel call KPP_compute_BLD(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, & - fluxes%ustar, CS%KPP_buoy_flux) + fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) call KPP_calculate(CS%KPP_CSp, G, GV, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index c8ce37ad55..d169da701d 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -82,7 +82,9 @@ module MOM_wave_interface !! Horizontal -> V points !! Vertical -> Mid-points real, allocatable, dimension(:,:), public :: & - LangNum !< Langmuir number (directionality factored later) + La_SL,& !< SL Langmuir number (directionality factored later) + !! Horizontal -> H points + La_Turb !< Aligned Turbulent Langmuir number !! Horizontal -> H points real, allocatable, dimension(:,:), public :: & US0_x !< Surface Stokes Drift (zonal, m/s) @@ -106,9 +108,17 @@ module MOM_wave_interface type(diag_ctrl), pointer, public :: diag !< A structure that is used to regulate the !! timing of diagnostic output. + ! An arbitrary lower-bound on the Langmuir number. Run-time parameter. + ! Langmuir number is sqrt(u_star/u_stokes). When both are small + ! but u_star is orders of magnitude smaller the Langmuir number could + ! have unintended consequences. Since both are small it can be safely capped + ! to avoid such consequences. + real :: La_min = 0.05 + !>@{ Diagnostic handles - integer, public :: id_surfacestokes_x, id_surfacestokes_y - integer, public :: id_3dstokes_x, id_3dstokes_y + integer, public :: id_surfacestokes_x = -1 , id_surfacestokes_y = -1 + integer, public :: id_3dstokes_x = -1 , id_3dstokes_y = -1 + integer, public :: id_La_turb = -1 !!@} end type wave_parameters_CS @@ -343,6 +353,11 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) call get_param(param_file, mdl, "LA_MISALIGNMENT", LA_Misalignment, & "Flag (logical) if using misalignment bt shear and waves in LA",& default=.false.) + call get_param(param_file, mdl, "MIN_LANGMUIR", CS%La_min, & + "A minimum value for all Langmuir numbers that is not physical, \n"//& + " but is likely only encountered when the wind is very small and \n"//& + " therefore its effects should be mostly benign.",units="nondim",& + default=0.05) ! Allocate and initialize ! a. Stokes driftProfiles @@ -356,8 +371,10 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) allocate(CS%US0_y(G%isd:G%ied,G%jsdB:G%jedB)) CS%US0_y(:,:) = 0.0 ! c. Langmuir number - allocate(CS%LangNum(G%isc:G%iec,G%jsc:G%jec)) - CS%LangNum(:,:) = 0.0 + allocate(CS%La_SL(G%isc:G%iec,G%jsc:G%jec)) + allocate(CS%La_turb(G%isc:G%iec,G%jsc:G%jec)) + CS%La_SL(:,:) = 0.0 + CS%La_turb (:,:) = 0.0 ! d. Viscosity for Stokes drift if (CS%StokesMixing) then allocate(CS%KvS(G%isd:G%Ied,G%jsd:G%jed,G%ke)) @@ -373,6 +390,8 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) CS%diag%axesCvL,Time,'3d Stokes drift (y)','m s-1') CS%id_3dstokes_x = register_diag_field('ocean_model','3d_stokes_x', & CS%diag%axesCuL,Time,'3d Stokes drift (y)','m s-1') + CS%id_La_turb = register_diag_field('ocean_model','La_turbulent',& + CS%diag%axesT1,Time,'Surface (turbulent) Langmuir number','nondim') return end subroutine MOM_wave_interface_init @@ -454,6 +473,7 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) real :: Top, MidPoint, Bottom real :: DecayScale real :: CMN_FAC, WN, US + real :: La integer :: ii, jj, kk, b, iim1, jjm1 ! 1. If Test Profile Option is chosen @@ -636,6 +656,18 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) enddo endif + ! Turbulent Langmuir number is computed here and available to use anywhere. + ! SL Langmuir number requires mixing layer depth, and therefore is computed + ! in the routine it is needed by (e.g. KPP or ePBL). + do ii = G%isc,G%iec + do jj = G%jsc, G%jec + Top = h(ii,jj,1)*GV%H_to_m + call get_Langmuir_Number( La, G, GV, Top, ustar(ii,jj), ii, jj, & + Override_MA=.false.,WAVES=CS) + CS%La_turb(ii,jj) = La + enddo + enddo + ! Output any desired quantities if (CS%id_surfacestokes_y>0) & call post_data(CS%id_surfacestokes_y, CS%us0_y, CS%diag) @@ -645,7 +677,8 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) call post_data(CS%id_3dstokes_y, CS%us_y, CS%diag) if (CS%id_3dstokes_x>0) & call post_data(CS%id_3dstokes_x, CS%us_x, CS%diag) - + if (CS%id_La_turb>0) & + call post_data(CS%id_La_turb, CS%La_turb, CS%diag) return end subroutine Update_Stokes_Drift @@ -673,11 +706,6 @@ subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) dataOverrideIsInitialized = .true. - allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,1:id)) - CS%STKx0(:,:,:) = 0.0 - allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,1:id)) - CS%STKy0(:,:,:) = 0.0 - ! Read in number of wavenumber bands in file to set number to be read in ! Hardcoded filename/variables varread1 = 'wavenumber' !Old method gives wavenumber @@ -742,9 +770,13 @@ subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) ! Allocating size of frequency bins allocate( CS%Freq_Cen(1:id) ) CS%Freq_Cen(:) = 0.0 - ! Allocating size of wavenumber bins + ! Allocating size of wavenumber bins allocate( CS%WaveNum_Cen(1:id) ) CS%WaveNum_Cen(:) = 0.0 + allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,1:id)) + CS%STKx0(:,:,:) = 0.0 + allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,1:id)) + CS%STKy0(:,:,:) = 0.0 endif ! Reading wavenumber bins/Frequencies @@ -822,7 +854,7 @@ end subroutine Surface_Bands_by_data_override !! want the wind-speed only dependent Langmuir number. Therefore, we need to be !! careful about what we try to access here. subroutine get_Langmuir_Number( LA, G, GV, HBL, USTAR, i, j, & - H, U_H, V_H, Waves ) + H, U_H, V_H, Override_MA, Waves ) type(ocean_grid_type), & intent(in) :: G !< Ocean grid structure type(verticalGrid_type), & @@ -832,6 +864,11 @@ subroutine get_Langmuir_Number( LA, G, GV, HBL, USTAR, i, j, & real, intent(in) :: USTAR !< Friction velocity (m/s) real, intent(in) :: HBL !< (Positive) thickness of boundary !! layer (m) + logical, optional,& + intent(in) :: Override_MA !< Override to use misalignment in LA + !! calculation. This can be used if diagnostic + !! LA outputs are desired that are different than + !! those used by the dynamical model. real, optional, dimension(SZK_(GV)), & intent(in) :: H !< Grid layer thickness (m or kg/m2) real, optional, dimension(SZK_(GV)), & @@ -847,7 +884,7 @@ subroutine get_Langmuir_Number( LA, G, GV, HBL, USTAR, i, j, & real :: Top, bottom, midpoint real :: Dpt_LASL, ShearDirection, WaveDirection real :: LA_STKx, LA_STKy, LA_STK - logical :: ContinueLoop + logical :: ContinueLoop, USE_MA real, dimension(SZK_(G)) :: US_H, VS_H real, dimension(NumBands) :: StkBand_X, StkBand_Y integer :: KK, BB @@ -855,10 +892,14 @@ subroutine get_Langmuir_Number( LA, G, GV, HBL, USTAR, i, j, & ! Compute averaging depth for Stokes drift (negative) Dpt_LASL = min(-0.1, -LA_FracHBL*HBL) + USE_MA = LA_Misalignment + if (present(Override_MA)) USE_MA = Override_MA + ! If requesting to use misalignment in the Langmuir number compute the Shear Direction - if (LA_Misalignment .and. (.not.(present(H).and.present(U_H).and.present(V_H)))) then - call MOM_error(Fatal,'Get_LA_waves requested to consider misalignment.') - elseif (LA_Misalignment) then + if (USE_MA) then + if (.not.(present(H).and.present(U_H).and.present(V_H))) then + call MOM_error(Fatal,'Get_LA_waves requested to consider misalignment.') + endif ContinueLoop = .true. bottom = 0.0 do kk = 1,G%ke @@ -905,11 +946,12 @@ subroutine get_Langmuir_Number( LA, G, GV, HBL, USTAR, i, j, & ! This is an arbitrary lower bound on Langmuir number. ! We shouldn't expect values lower than this, but ! there is also no good reason to cap it here other then - ! to prevent artificially big enhancements. - LA = max(0.1,sqrt(USTAR/(LA_STK+1.e-8))) + ! to prevent large enhancements in unconstrained parts of + ! the curve fit parameterizations. + LA = max(WAVES%La_min,sqrt(USTAR/(LA_STK+1.e-10))) endif - if (LA_Misalignment) then + if (Use_MA) then WaveDirection = atan2(LA_STKy,LA_STKx) LA = LA / sqrt(max(1.e-8,cos( WaveDirection - ShearDirection))) endif @@ -1312,11 +1354,12 @@ end subroutine ust_2_u10_coare3p5 subroutine Waves_end(CS) type(wave_parameters_CS), pointer :: CS !< Control structure - if (allocated(CS%WaveNum_Cen)) then; deallocate( CS%WaveNum_Cen ); endif + if (allocated(CS%WaveNum_Cen)) deallocate( CS%WaveNum_Cen ) if (allocated(CS%Freq_Cen)) deallocate( CS%Freq_Cen ) if (allocated(CS%Us_x)) deallocate( CS%Us_x ) if (allocated(CS%Us_y)) deallocate( CS%Us_y ) - if (allocated(CS%LangNum)) deallocate( CS%LangNum ) + if (allocated(CS%La_SL)) deallocate( CS%La_SL ) + if (allocated(CS%La_turb)) deallocate( CS%La_turb ) if (allocated(CS%STKx0)) deallocate( CS%STKx0 ) if (allocated(CS%STKy0)) deallocate( CS%STKy0 ) if (allocated(CS%KvS)) deallocate( CS%KvS ) diff --git a/src/user/SCM_idealized_hurricane.F90 b/src/user/SCM_idealized_hurricane.F90 index 93f6421b4d..62ff880d3c 100644 --- a/src/user/SCM_idealized_hurricane.F90 +++ b/src/user/SCM_idealized_hurricane.F90 @@ -395,6 +395,7 @@ subroutine idealized_hurricane_wind_profile(CS,absf,YY,XX,UOCN,VOCN,Tx,Ty) ! Wind profile terms real :: U10 real :: radius + real :: radius10 real :: radius_km real :: radiusB real :: fcor @@ -439,18 +440,19 @@ subroutine idealized_hurricane_wind_profile(CS,absf,YY,XX,UOCN,VOCN,Tx,Ty) U10 = sqrt(CS%Holland_AxBxDP*exp(-CS%Holland_A/radiusB)/(CS%rho_A*radiusB)& +0.25*(radius_km*absf)**2) - 0.5*radius_km*absf elseif ( (radius/CS%rad_max_wind .gt. 10.) .and. & - (radius/CS%rad_max_wind .lt. 12.) ) then - radius = CS%rad_max_wind*10. + (radius/CS%rad_max_wind .lt. 15.) ) then + + radius10 = CS%rad_max_wind*10. if (CS%BR_Bench) then - radius_km = radius/1000. + radius_km = radius10/1000. else - radius_km = radius + radius_km = radius10 endif - radiusB=radius**CS%Holland_B + radiusB=radius10**CS%Holland_B U10 = (sqrt(CS%Holland_AxBxDp*exp(-CS%Holland_A/radiusB)/(CS%rho_A*radiusB)& +0.25*(radius_km*absf)**2)-0.5*radius_km*absf) & - * (12.-radius/CS%rad_max_wind)/2. + * (15.-radius/CS%rad_max_wind)/5. else U10 = 0. endif @@ -465,9 +467,9 @@ subroutine idealized_hurricane_wind_profile(CS,absf,YY,XX,UOCN,VOCN,Tx,Ty) P1 = (6.88*RSTR - 9.60*CS%Hurr_translation_spd + 85.31) * CS%Deg2Rad ALPH = A0 - A1*cos(CS%hurr_translation_dir-Adir-P1) if ( (radius/CS%rad_max_wind.gt.10.) .and.& - (radius/CS%rad_max_wind.lt.12.) ) then - ALPH = ALPH*(12.0-radius/CS%rad_max_wind)/2. - elseif (radius/CS%rad_max_wind.gt.12.) then + (radius/CS%rad_max_wind.lt.15.) ) then + ALPH = ALPH*(15.0-radius/CS%rad_max_wind)/5. + elseif (radius/CS%rad_max_wind.gt.15.) then ALPH = 0.0 endif ALPH = ALPH * CS%Deg2Rad From e495d0c00675446e822c45e15a8e6c63d051fb19 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 10 Oct 2018 15:22:55 -0600 Subject: [PATCH 0814/1072] Add heat flux term deu to melt/freeze of sea ice This term is passed via IOB%melth. The corresponding term in fluxes is fluxes%seaice_melt. This commit also fixes units description for rofl_* in the MCT IOB. --- config_src/mct_driver/MOM_surface_forcing.F90 | 18 ++- config_src/mct_driver/ocn_cap_methods.F90 | 4 + src/core/MOM_forcing_type.F90 | 110 ++++++++++++------ 3 files changed, 88 insertions(+), 44 deletions(-) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 5c4a43bfc0..97f118a6f9 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -152,11 +152,12 @@ module MOM_surface_forcing ! 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(:,:) :: rofl_flux =>NULL() !< liquid runoff (kg/m2/s) + real, pointer, dimension(:,:) :: rofi_flux =>NULL() !< ice runoff (kg/m2/s) 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(:,:) :: melth =>NULL() !< sea ice and snow melt 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(:,:) :: lw_flux =>NULL() !< long wave radiation (W/m2) @@ -166,7 +167,6 @@ module MOM_surface_forcing 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) @@ -442,6 +442,10 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & if (associated(fluxes%sens)) & fluxes%sens(i,j) = G%mask2dT(i,j) * IOB%t_flux(i-i0,j-j0) + ! sea ice and snow melt heat flux (W/m2) + if (associated(fluxes%melth)) & + fluxes%melth(i,j) = G%mask2dT(i,j) * IOB%melth(i-i0,j-j0) + ! latent heat flux (W/m^2) if (associated(fluxes%latent)) & fluxes%latent(i,j) = G%mask2dT(i,j) * IOB%latent_flux(i-i0,j-j0) @@ -771,6 +775,7 @@ subroutine IOB_allocate(IOB, 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% melth (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), & @@ -780,7 +785,6 @@ subroutine IOB_allocate(IOB, 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% runoff (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), & @@ -796,6 +800,7 @@ subroutine IOB_allocate(IOB, isc, iec, jsc, jec) IOB%u_flux = 0.0 IOB%v_flux = 0.0 IOB%t_flux = 0.0 + IOB%melth = 0.0 IOB%q_flux = 0.0 IOB%salt_flux = 0.0 IOB%lw_flux = 0.0 @@ -805,7 +810,6 @@ subroutine IOB_allocate(IOB, isc, iec, jsc, jec) IOB%sw_flux_nir_dif = 0.0 IOB%lprec = 0.0 IOB%fprec = 0.0 - IOB%runoff = 0.0 IOB%ustar_berg = 0.0 IOB%area_berg = 0.0 IOB%mass_berg = 0.0 @@ -1311,7 +1315,10 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) 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%melth ', mpp_chksum( iobt%melth ) 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) @@ -1320,7 +1327,6 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) 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)) & diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 95fd084bdc..a9527f1660 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -73,6 +73,9 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, ! latent heat flux (W/m^2) ice_ocean_boundary%latent_flux(i,j) = x2o(ind%x2o_Foxx_lat,k) !???TODO: should this be a minus sign + ! snow&ice melt heat flux (W/m^2) + ice_ocean_boundary%melth(i,j) = x2o(ind%x2o_Fioi_melth,k) + ! liquid runoff ice_ocean_boundary%rofl_flux(i,j) = x2o(ind%x2o_Foxx_rofl,k) * GRID%mask2dT(ig,jg) @@ -116,6 +119,7 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, write(logunit,F01)'import: day, secs, j, i, lwrad = ',day,secs,j,i,ice_ocean_boundary%lw_flux(i,j) write(logunit,F01)'import: day, secs, j, i, q_flux = ',day,secs,j,i,ice_ocean_boundary%q_flux(i,j) write(logunit,F01)'import: day, secs, j, i, t_flux = ',day,secs,j,i,ice_ocean_boundary%t_flux(i,j) + write(logunit,F01)'import: day, secs, j, i, melth = ',day,secs,j,i,ice_ocean_boundary%melth(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 = ',& diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 9486967b40..b6a1f069c6 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -65,6 +65,7 @@ module MOM_forcing_type real, pointer, dimension(:,:) :: & latent => NULL(), & !< latent (W/m^2) (typically < 0) sens => NULL(), & !< sensible (W/m^2) (typically negative) + melth => NULL(), & !< sea ice and snow melt (W/m^2) (typically negative) heat_added => NULL() !< additional heat flux from SST restoring or flux adjustments (W/m^2) ! components of latent heat fluxes used for diagnostic purposes @@ -261,6 +262,7 @@ module MOM_forcing_type integer :: id_heat_content_vprec = -1, id_heat_content_massout = -1 integer :: id_heat_added = -1, id_heat_content_massin = -1 integer :: id_hfrainds = -1, id_hfrunoffds = -1 + integer :: id_melth = -1 ! global area integrated heat flux diagnostic handles integer :: id_total_net_heat_coupler = -1, id_total_net_heat_surface = -1 @@ -486,20 +488,22 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, endif ! net volume/mass of liquid and solid passing through surface boundary fluxes - netMassInOut(i) = dt * (scale * ((((( fluxes%lprec(i,j) & - + fluxes%fprec(i,j) ) & - + fluxes%evap(i,j) ) & - + fluxes%lrunoff(i,j) ) & - + fluxes%vprec(i,j) ) & - + fluxes%frunoff(i,j) ) ) + netMassInOut(i) = dt * (scale * (((((( fluxes%lprec(i,j) & + + fluxes%fprec(i,j) ) & + + fluxes%evap(i,j) ) & + + fluxes%lrunoff(i,j) ) & + + fluxes%vprec(i,j) ) & + + fluxes%seaice_melt(i,j)) & + + fluxes%frunoff(i,j) )) if (do_NMIOr) then ! Repeat the above code w/ dt=1s for legacy reasons - netMassInOut_rate(i) = (scale * ((((( fluxes%lprec(i,j) & - + fluxes%fprec(i,j) ) & - + fluxes%evap(i,j) ) & - + fluxes%lrunoff(i,j) ) & - + fluxes%vprec(i,j) ) & - + fluxes%frunoff(i,j) ) ) + netMassInOut_rate(i) = (scale * (((((( fluxes%lprec(i,j) & + + fluxes%fprec(i,j) ) & + + fluxes%evap(i,j) ) & + + fluxes%lrunoff(i,j) ) & + + fluxes%vprec(i,j) ) & + + fluxes%seaice_melt(i,j)) & + + fluxes%frunoff(i,j) )) endif ! smg: @@ -544,11 +548,24 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! surface heat fluxes from radiation and turbulent fluxes (K * H) ! (H=m for Bouss, H=kg/m2 for non-Bouss) - net_heat(i) = scale * dt * J_m2_to_H * & - ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)) ) - !Repeats above code w/ dt=1. for legacy reason - if (do_NHR) net_heat_rate(i) = scale * J_m2_to_H * & - ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)) ) + + ! CIME provides heat flux from snow&ice melt (melth), so this should be added here + if (associated(fluxes%melth)) then + net_heat(i) = scale * dt * J_m2_to_H * & + ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j) + & + fluxes%melth(i,j)) ) + !Repeats above code w/ dt=1. for legacy reason + if (do_NHR) net_heat_rate(i) = scale * J_m2_to_H * & + ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j) + & + fluxes%melth(i,j))) + else + net_heat(i) = scale * dt * J_m2_to_H * & + ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)) ) + !Repeats above code w/ dt=1. for legacy reason + if (do_NHR) net_heat_rate(i) = scale * J_m2_to_H * & + ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)) ) + endif + ! Add heat flux from surface damping (restoring) (K * H) or flux adjustments. if (associated(fluxes%heat_added)) then net_heat(i) = net_heat(i) + (scale * (dt * J_m2_to_H)) * fluxes%heat_added(i,j) @@ -1201,13 +1218,14 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use cmor_long_name='Water Evaporation Flux Where Ice Free Ocean over Sea') ! smg: seaice_melt field requires updates to the sea ice model - !handles%id_seaice_melt = register_diag_field('ocean_model', 'seaice_melt', & - ! diag%axesT1, Time, 'water flux to ocean from sea ice melt(> 0) or form(< 0)', & - ! 'kg m-2 s-1', & - ! standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics', & - ! cmor_field_name='fsitherm', & - ! cmor_standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics',& - ! cmor_long_name='water flux to ocean from sea ice melt(> 0) or form(< 0)') + ! gmm: MCT provides this field + handles%id_seaice_melt = register_diag_field('ocean_model', 'seaice_melt', & + diag%axesT1, Time, 'water flux to ocean from sea ice melt(> 0) or form(< 0)', & + 'kg m-2 s-1', & + standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics', & + cmor_field_name='fsitherm', & + cmor_standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics',& + cmor_long_name='water flux to ocean from sea ice melt(> 0) or form(< 0)') handles%id_precip = register_diag_field('ocean_model', 'precip', diag%axesT1, Time, & 'Liquid + frozen precipitation into ocean', 'kg m-2 s-1') @@ -1269,12 +1287,13 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use cmor_long_name='Evaporation Where Ice Free Ocean over Sea Area Integrated') ! seaice_melt field requires updates to the sea ice model - !handles%id_total_seaice_melt = register_scalar_field('ocean_model', 'total_seaice_melt', Time, diag, & - ! long_name='Area integrated sea ice melt (>0) or form (<0)', units='kg s-1', & - ! standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics_area_integrated', & - ! cmor_field_name='total_fsitherm', & - ! cmor_standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics_area_integrated', & - ! cmor_long_name='Water Melt/Form from Sea Ice Area Integrated') + ! gmm: MCT provides this field + handles%id_total_seaice_melt = register_scalar_field('ocean_model', 'total_seaice_melt', Time, diag, & + long_name='Area integrated sea ice melt (>0) or form (<0)', units='kg s-1', & + standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics_area_integrated', & + cmor_field_name='total_fsitherm', & + cmor_standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics_area_integrated', & + cmor_long_name='Water Melt/Form from Sea Ice Area Integrated') handles%id_total_precip = register_scalar_field('ocean_model', 'total_precip', Time, diag, & long_name='Area integrated liquid+frozen precip into ocean', units='kg s-1') @@ -1404,11 +1423,11 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use 'W m-2') handles%id_net_heat_coupler = register_diag_field('ocean_model', 'net_heat_coupler', & - diag%axesT1,Time,'Surface ocean heat flux from SW+LW+latent+sensible (via the coupler)',& + diag%axesT1,Time,'Surface ocean heat flux from SW+LW+latent+sensible+melth (via the coupler)',& 'W m-2') handles%id_net_heat_surface = register_diag_field('ocean_model', 'net_heat_surface',diag%axesT1, & - Time,'Surface ocean heat flux from SW+LW+lat+sens+mass transfer+frazil+restore or flux adjustments', 'W m-2',& + Time,'Surface ocean heat flux from SW+LW+lat+sens+mass transfer+frazil+restore+melth or flux adjustments', 'W m-2',& standard_name='surface_downward_heat_flux_in_sea_water', cmor_field_name='hfds', & cmor_standard_name='surface_downward_heat_flux_in_sea_water', & cmor_long_name='Surface ocean heat flux from SW+LW+latent+sensible+masstransfer+frazil') @@ -1464,6 +1483,13 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use cmor_standard_name='surface_downward_sensible_heat_flux', & cmor_long_name='Surface Downward Sensible Heat Flux') + handles%id_melth = register_diag_field('ocean_model', 'melth', diag%axesT1, Time,& + 'Heat flux into ocean from snow and sea ice melt', 'W m-2', & + standard_name='snow_ice_melt_heat_flux', & + !GMM? cmor_field_name='hfsso', & + cmor_standard_name='snow_ice_melt_heat_flux', & + cmor_long_name='Heat flux into ocean from snow and sea ice melt') + handles%id_heat_added = register_diag_field('ocean_model', 'heat_added', diag%axesT1, Time, & 'Flux Adjustment or restoring surface heat flux into ocean', 'W m-2') @@ -1534,7 +1560,7 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use handles%id_total_net_heat_coupler = register_scalar_field('ocean_model', & 'total_net_heat_coupler', Time, diag, & - long_name='Area integrated surface heat flux from SW+LW+latent+sensible (via the coupler)',& + long_name='Area integrated surface heat flux from SW+LW+latent+sensible+melth (via the coupler)',& units='W') handles%id_total_net_heat_surface = register_scalar_field('ocean_model', & @@ -1621,12 +1647,12 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use handles%id_net_heat_coupler_ga = register_scalar_field('ocean_model', & 'net_heat_coupler_ga', Time, diag, & - long_name='Area averaged surface heat flux from SW+LW+latent+sensible (via the coupler)',& + long_name='Area averaged surface heat flux from SW+LW+latent+sensible+melth (via the coupler)',& units='W m-2') handles%id_net_heat_surface_ga = register_scalar_field('ocean_model', & 'net_heat_surface_ga', Time, diag, & - long_name='Area averaged surface heat flux from SW+LW+lat+sens+mass+frazil+restore or flux adjustments', & + long_name='Area averaged surface heat flux from SW+LW+lat+sens+mass+frazil+restore+melth or flux adjustments', & units='W m-2', & cmor_field_name='ave_hfds', & cmor_standard_name='surface_downward_heat_flux_in_sea_water_area_averaged', & @@ -1790,8 +1816,7 @@ subroutine forcing_accumulate(flux_tmp, forces, fluxes, dt, G, wt2) fluxes%vprec(i,j) = wt1*fluxes%vprec(i,j) + wt2*flux_tmp%vprec(i,j) fluxes%lrunoff(i,j) = wt1*fluxes%lrunoff(i,j) + wt2*flux_tmp%lrunoff(i,j) fluxes%frunoff(i,j) = wt1*fluxes%frunoff(i,j) + wt2*flux_tmp%frunoff(i,j) - ! ### ADD LATER fluxes%seaice_melt(i,j) = wt1*fluxes%seaice_melt(i,j) + wt2*flux_tmp%seaice_melt(i,j) - + fluxes%seaice_melt(i,j) = wt1*fluxes%seaice_melt(i,j) + wt2*flux_tmp%seaice_melt(i,j) fluxes%sw(i,j) = wt1*fluxes%sw(i,j) + wt2*flux_tmp%sw(i,j) fluxes%sw_vis_dir(i,j) = wt1*fluxes%sw_vis_dir(i,j) + wt2*flux_tmp%sw_vis_dir(i,j) fluxes%sw_vis_dif(i,j) = wt1*fluxes%sw_vis_dif(i,j) + wt2*flux_tmp%sw_vis_dif(i,j) @@ -2269,6 +2294,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%latent)) res(i,j) = res(i,j) + fluxes%latent(i,j) if (associated(fluxes%sens)) res(i,j) = res(i,j) + fluxes%sens(i,j) if (associated(fluxes%SW)) res(i,j) = res(i,j) + fluxes%SW(i,j) + if (associated(fluxes%melth)) res(i,j) = res(i,j) + fluxes%melth(i,j) enddo ; enddo call post_data(handles%id_net_heat_coupler, res, diag) if (handles%id_total_net_heat_coupler > 0) then @@ -2289,6 +2315,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%latent)) res(i,j) = res(i,j) + fluxes%latent(i,j) if (associated(fluxes%sens)) res(i,j) = res(i,j) + fluxes%sens(i,j) if (associated(fluxes%SW)) res(i,j) = res(i,j) + fluxes%SW(i,j) + if (associated(fluxes%melth)) res(i,j) = res(i,j) + fluxes%melth(i,j) if (associated(sfc_state%frazil)) res(i,j) = res(i,j) + sfc_state%frazil(i,j) * I_dt ! if (associated(sfc_state%TempXpme)) then ! res(i,j) = res(i,j) + sfc_state%TempXpme(i,j) * fluxes%C_p * I_dt @@ -2455,6 +2482,11 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if ((handles%id_sens > 0) .and. associated(fluxes%sens)) then call post_data(handles%id_sens, fluxes%sens, diag) endif + + if ((handles%id_melth > 0) .and. associated(fluxes%melth)) then + call post_data(handles%id_melth, fluxes%melth, diag) + endif + if ((handles%id_total_sens > 0) .and. associated(fluxes%sens)) then total_transport = global_area_integral(fluxes%sens,G) call post_data(handles%id_total_sens, total_transport, diag) @@ -2562,6 +2594,7 @@ subroutine allocate_forcing_type(G, fluxes, water, heat, ustar, press, shelf, ic call myAlloc(fluxes%netMassIn,isd,ied,jsd,jed, water) call myAlloc(fluxes%netSalt,isd,ied,jsd,jed, water) + call myAlloc(fluxes%melth,isd,ied,jsd,jed, heat) call myAlloc(fluxes%sw,isd,ied,jsd,jed, heat) call myAlloc(fluxes%lw,isd,ied,jsd,jed, heat) call myAlloc(fluxes%latent,isd,ied,jsd,jed, heat) @@ -2656,6 +2689,7 @@ subroutine deallocate_forcing_type(fluxes) if (associated(fluxes%ustar_gustless)) deallocate(fluxes%ustar_gustless) if (associated(fluxes%buoy)) deallocate(fluxes%buoy) if (associated(fluxes%sw)) deallocate(fluxes%sw) + if (associated(fluxes%melth)) deallocate(fluxes%melth) if (associated(fluxes%sw_vis_dir)) deallocate(fluxes%sw_vis_dir) if (associated(fluxes%sw_vis_dif)) deallocate(fluxes%sw_vis_dif) if (associated(fluxes%sw_nir_dir)) deallocate(fluxes%sw_nir_dir) @@ -2818,7 +2852,7 @@ end subroutine deallocate_mech_forcing !! * non-penetrative = non-downwelling shortwave; portion of SW !! totally absorbed in the k=1 cell. !! The non-penetrative SW is combined with -!! LW+LAT+SENS in net_heat inside routine +!! LW+LAT+SENS+MELTH in net_heat inside routine !! extractFluxes1d. Notably, for many cases, !! non-penetrative SW = 0. !! * penetrative = that portion of shortwave penetrating below From 8738e296689c3704b2503087a2ad0be5ad6cf7a7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 11 Oct 2018 08:44:28 -0400 Subject: [PATCH 0815/1072] +Recast calc_isoneutral_slope to work in units of Z Recast the calc_isoneutral_slope take interface heights (the argument e) in units of Z, and internally to use vertical height units of Z in place of m for dimensional consistency testing. Also recast calc_slope_functions_using_just_e to take interface heights in units of e. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- src/core/MOM_isopycnal_slopes.F90 | 48 ++++++++++++------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 9 ++-- 2 files changed, 37 insertions(+), 20 deletions(-) diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 119eca7b56..3e305f37b7 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -18,11 +18,12 @@ module MOM_isopycnal_slopes !> Calculate isopycnal slopes, and optionally return N2 used in calculation. subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & - slope_x, slope_y, N2_u, N2_v, halo) + slope_x, slope_y, N2_u, N2_v, halo) !, eta_to_m) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface heights (m) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface heights (in Z or units + !! given by 1/eta_to_m) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables real, intent(in) :: dt_kappa_smooth !< A vertical diffusive smoothing @@ -36,6 +37,9 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & optional, intent(inout) :: N2_v !< Brunt-Vaisala frequency squared at !! interfaces between u-points (s-2) integer, optional, intent(in) :: halo !< Halo width over which to compute + + ! real, optional, intent(in) :: eta_to_m !< The conversion factor from the units + ! (This argument has been tested but for now serves no purpose.) !! of eta to m; GV%Z_to_m by default. ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & T, & ! The temperature (or density) in C, with the values in @@ -63,12 +67,12 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & ! interface times the grid spacing, in kg m-3. real :: drdkL, drdkR ! Vertical density differences across an interface, ! in kg m-3. - real :: hg2A, hg2B, hg2L, hg2R - real :: haA, haB, haL, haR - real :: dzaL, dzaR - real :: wtA, wtB, wtL, wtR - real :: drdx, drdy, drdz ! Zonal, meridional, and vertical density gradients, - ! in units of kg m-4. + real :: hg2A, hg2B, hg2L, hg2R ! Squares of geometric mean thicknesses, in H2. + real :: haA, haB, haL, haR ! Arithmetic mean thicknesses in H. + real :: dzaL, dzaR ! Temporary thicknesses in eta units (Z?). + real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. + real :: drdx, drdy ! Zonal and meridional density gradients, in kg m-4. + real :: drdz ! Vertical density gradient, in units of kg m-3 Z-1. real :: Slope ! The slope of density surfaces, calculated in a way ! that is always between -1 and 1. real :: mag_grad2 ! The squared magnitude of the 3-d density gradient, in kg2 m-8. @@ -77,10 +81,15 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & ! in roundoff and can be neglected, in H. real :: h_neglect2 ! h_neglect^2, in H2. real :: dz_neglect ! A thickness in m that is so small it is usually lost - ! in roundoff and can be neglected, in m. + ! in roundoff and can be neglected, in eta units (Z?). logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. real :: G_Rho0, N2, dzN2, H_x(SZIB_(G)), H_y(SZI_(G)) + real :: Z_to_L ! A conversion factor between from units for e to the + ! units for lateral distances. + real :: L_to_Z ! A conversion factor between from units for lateral distances + ! to the units for e. + real :: H_to_Z ! A conversion factor from thickness units to the units of e. logical :: present_N2_u, present_N2_v integer :: is, ie, js, je, nz, IsdB @@ -94,13 +103,18 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & nz = G%ke ; IsdB = G%IsdB h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 - dz_neglect = GV%H_subroundoff*GV%H_to_m + Z_to_L = GV%Z_to_m ; H_to_Z = GV%H_to_Z + ! if (present(eta_to_m)) then + ! Z_to_L = eta_to_m ; H_to_Z = GV%H_to_m / eta_to_m + ! endif + L_to_Z = 1.0 / Z_to_L + dz_neglect = GV%H_subroundoff * H_to_Z use_EOS = associated(tv%eqn_of_state) present_N2_u = PRESENT(N2_u) present_N2_v = PRESENT(N2_v) - G_Rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 + G_Rho0 = (GV%g_Earth*L_to_Z*GV%m_to_Z) / GV%Rho0 if (present_N2_u) then do j=js,je ; do I=is-1,ie N2_u(I,j,1) = 0. @@ -187,7 +201,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & haL = 0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect haR = 0.5*(h(i+1,j,k-1) + h(i+1,j,k)) + h_neglect if (GV%Boussinesq) then - dzaL = haL * GV%H_to_m ; dzaR = haR * GV%H_to_m + dzaL = haL * H_to_Z ; dzaR = haR * H_to_Z else dzaL = 0.5*(e(i,j,K-1) - e(i,j,K+1)) + dz_neglect dzaR = 0.5*(e(i+1,j,K-1) - e(i+1,j,K+1)) + dz_neglect @@ -207,7 +221,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdx**2 + drdz**2 + mag_grad2 = drdx**2 + (L_to_Z*drdz)**2 if (mag_grad2 > 0.0) then slope_x(I,j,K) = drdx / sqrt(mag_grad2) else ! Just in case mag_grad2 = 0 ever. @@ -217,7 +231,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & if (present_N2_u) N2_u(I,j,k) = G_Rho0 * drdz * G%mask2dCu(I,j) ! Square of Brunt-Vaisala frequency (s-2) else ! With .not.use_EOS, the layers are constant density. - slope_x(I,j,K) = ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) + slope_x(I,j,K) = (Z_to_L*(e(i,j,K)-e(i+1,j,K))) * G%IdxCu(I,j) endif enddo ! I @@ -271,7 +285,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & haL = 0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect haR = 0.5*(h(i,j+1,k-1) + h(i,j+1,k)) + h_neglect if (GV%Boussinesq) then - dzaL = haL * GV%H_to_m ; dzaR = haR * GV%H_to_m + dzaL = haL * H_to_Z ; dzaR = haR * H_to_Z else dzaL = 0.5*(e(i,j,K-1) - e(i,j,K+1)) + dz_neglect dzaR = 0.5*(e(i,j+1,K-1) - e(i,j+1,K+1)) + dz_neglect @@ -291,7 +305,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdy**2 + drdz**2 + mag_grad2 = drdy**2 + (L_to_Z*drdz)**2 if (mag_grad2 > 0.0) then slope_y(i,J,K) = drdy / sqrt(mag_grad2) else ! Just in case mag_grad2 = 0 ever. @@ -301,7 +315,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & if (present_N2_v) N2_v(i,J,k) = G_Rho0 * drdz * G%mask2dCv(i,J) ! Square of Brunt-Vaisala frequency (s-2) else ! With .not.use_EOS, the layers are constant density. - slope_y(i,J,K) = ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) + slope_y(i,J,K) = (Z_to_L*(e(i,j,K)-e(i,j+1,K))) * G%IdyCv(i,J) endif enddo ! i diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 583fad8c75..a851ccf1b6 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -393,7 +393,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS) "Module must be initialized before it is used.") if (CS%calculate_Eady_growth_rate) then - call find_eta(h, tv, G, GV, e, halo_size=2, eta_to_m=1.0) + call find_eta(h, tv, G, GV, e, halo_size=2) if (CS%use_stored_slopes) then call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, & CS%slope_x, CS%slope_y, N2_u, N2_v, 1) @@ -599,6 +599,8 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) real :: N2 ! Brunt-Vaisala frequency (1/s) real :: Hup, Hdn ! Thickness from above, below (m or kg m-2) real :: H_geom ! The geometric mean of Hup*Hdn, in m or kg m-2. + real :: Z_to_L ! A conversion factor between from units for e to the + ! units for lateral distances. real :: one_meter ! One meter in thickness units of m or kg m-2. integer :: is, ie, js, je, nz integer :: i, j, k, kb_max @@ -618,6 +620,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) one_meter = 1.0 * GV%m_to_H h_neglect = GV%H_subroundoff H_cutoff = real(2*nz) * (GV%Angstrom_H + h_neglect) + Z_to_L = GV%Z_to_m ! To set the length scale based on the deformation radius, use wave_speed to ! calculate the first-mode gravity wave speed and then blend the equatorial @@ -629,12 +632,12 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) if (calculate_slopes) then ! Calculate the interface slopes E_x and E_y and u- and v- points respectively do j=js-1,je+1 ; do I=is-1,ie - E_x(I,j) = (e(i+1,j,K)-e(i,j,K))*G%IdxCu(I,j) + E_x(I,j) = Z_to_L*(e(i+1,j,K)-e(i,j,K))*G%IdxCu(I,j) ! Mask slopes where interface intersects topography if (min(h(I,j,k),h(I+1,j,k)) < H_cutoff) E_x(I,j) = 0. enddo ; enddo do J=js-1,je ; do i=is-1,ie+1 - E_y(i,J) = (e(i,j+1,K)-e(i,j,K))*G%IdyCv(i,J) + E_y(i,J) = Z_to_L*(e(i,j+1,K)-e(i,j,K))*G%IdyCv(i,J) ! Mask slopes where interface intersects topography if (min(h(i,J,k),h(i,J+1,k)) < H_cutoff) E_y(I,j) = 0. enddo ; enddo From 1402a86876edb0299290dabb3a27780fd942daaa Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 11 Oct 2018 11:31:41 -0400 Subject: [PATCH 0816/1072] +Recast vert_fill_TS to work with units of Z Recast the vert_fill_TS take the diffusivity argument in units of Z2 s-1, and for the private version in calc_isoneutral_slopes eliminated the timescale argument (which had previously been hard-coded to 1.0). Rescaling the diffusivities vert_fill_TS required added in a new GV argument to VarMix_init. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- src/core/MOM.F90 | 2 +- src/core/MOM_isopycnal_slopes.F90 | 16 ++++++++-------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 5 +++-- .../lateral/MOM_thickness_diffuse.F90 | 10 +++++----- .../vertical/MOM_internal_tide_input.F90 | 4 ++-- .../vertical/MOM_set_diffusivity.F90 | 6 +++--- 6 files changed, 22 insertions(+), 21 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index eaacbc8493..aa89ddf117 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2289,7 +2289,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%useMEKE = MEKE_init(Time, G, param_file, diag, CS%MEKE_CSp, CS%MEKE, restart_CSp) - call VarMix_init(Time, G, param_file, diag, CS%VarMix) + call VarMix_init(Time, G, GV, param_file, diag, CS%VarMix) call set_visc_init(Time, G, GV, param_file, diag, CS%visc, CS%set_visc_CSp, restart_CSp, CS%OBC) if (CS%split) then allocate(eta(SZI_(G),SZJ_(G))) ; eta(:,:) = 0.0 diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 3e305f37b7..3698c32afe 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -26,8 +26,8 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & !! given by 1/eta_to_m) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables - real, intent(in) :: dt_kappa_smooth !< A vertical diffusive smoothing - !! timescale, in s. + real, intent(in) :: dt_kappa_smooth !< A smoothing vertical diffusivity + !! times a smoothing timescale, in Z2. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: slope_x !< Isopycnal slope in i-direction (nondim) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: slope_y !< Isopycnal slope in j-direction (nondim) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), & @@ -130,9 +130,9 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & if (use_EOS) then if (present(halo)) then - call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, 1.0, T, S, G, GV, halo+1) + call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, T, S, G, GV, halo+1) else - call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, 1.0, T, S, G, GV, 1) + call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, T, S, G, GV, 1) endif endif @@ -325,14 +325,14 @@ end subroutine calc_isoneutral_slopes !> Returns tracer arrays (nominally T and S) with massless layers filled with !! sensible values, by diffusing vertically with a small but constant diffusivity. -subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) +subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Temperature (deg C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Salinity (psu) - real, intent(in) :: kappa !< A vertical diffusivity to use for smoothing (m2 s-1) - real, intent(in) :: dt !< The time increment, in s. + real, intent(in) :: kappa_dt !< A vertical diffusivity to use for smoothing + !! times a smoothing timescale, in Z2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature (deg C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filed salinity (psu) integer, optional, intent(in) :: halo_here !< Halo width over which to compute @@ -352,7 +352,7 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo nz = G%ke - kap_dt_x2 = (2.0*kappa*dt)*GV%m_to_H**2 + kap_dt_x2 = (2.0*kappa_dt)*GV%Z_to_H**2 h_neglect = GV%H_subroundoff if (kap_dt_x2 <= 0.0) then diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index a851ccf1b6..fb14e8f23b 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -716,9 +716,10 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) end subroutine calc_slope_functions_using_just_e !> Initializes the variables mixing coefficients container -subroutine VarMix_init(Time, G, param_file, diag, CS) +subroutine VarMix_init(Time, G, GV, param_file, diag, CS) type(time_type), intent(in) :: Time !< Current model time type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(VarMix_CS), pointer :: CS !< Variable mixing coefficients @@ -835,7 +836,7 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate \n"//& "more sensible values of T & S into thin layers.", & - default=1.0e-6) + default=1.0e-6, scale=GV%m_to_Z**2) !### Add units argument. endif if (CS%calculate_Eady_growth_rate) then diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index caad72b3a4..982b73698f 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -1601,10 +1601,10 @@ end subroutine add_detangling_Kh subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg/m2) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Input temperature (C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Input salinity (ppt) - real, intent(in) :: kappa !< Constant diffusivity to use (m2/s) + real, intent(in) :: kappa !< Constant diffusivity to use (Z2/s) real, intent(in) :: dt !< Time increment (s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature (C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filled salinity (ppt) @@ -1633,8 +1633,8 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo nz = G%ke h_neglect = GV%H_subroundoff - kap_dt_x2 = (2.0*kappa*dt)*GV%m_to_H**2 - h0 = 1.0e-16*sqrt(kappa*dt)*GV%m_to_H + kap_dt_x2 = (2.0*kappa*dt)*GV%Z_to_H**2 + h0 = 1.0e-16*sqrt(kappa*dt)*GV%Z_to_H if (kap_dt_x2 <= 0.0) then !$OMP parallel do default(none) shared(is,ie,js,je,nz,T_f,T_in,S_f,S_in) @@ -1742,7 +1742,7 @@ subroutine thickness_diffuse_init(Time, G, GV, param_file, diag, CDp, CS) call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate \n"//& "more sensible values of T & S into thin layers.", & - default=1.0e-6) + default=1.0e-6, scale=GV%m_to_Z**2) call get_param(param_file, mdl, "KHTH_USE_FGNV_STREAMFUNCTION", CS%use_FGNV_streamfn, & "If true, use the streamfunction formulation of\n"// & "Ferrari et al., 2010, which effectively emphasizes\n"//& diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index b8e6abb4c4..e41cc8cb2b 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -88,8 +88,8 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, CS) if (.not.associated(CS)) call MOM_error(FATAL,"set_diffusivity: "//& "Module must be initialized before it is used.") - kappa_fill = 1.e-3 ! m2 s-1 - dt_fill = 7200. + kappa_fill = 1.e-3*GV%m_to_Z**2 !### Dimensional constant in m2 s-1. + dt_fill = 7200. !### Dimensionalconstant in s. use_EOS = associated(tv%eqn_of_state) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 3ca3d22fba..873a61d7b8 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -276,8 +276,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & "Module must be initialized before it is used.") I_Rho0 = 1.0/GV%Rho0 - kappa_fill = 1.e-3 ! m2 s-1 - dt_fill = 7200. + kappa_fill = 1.e-3*GV%m_to_Z**2 !### Dimensional constant in m2 s-1. + dt_fill = 7200. !### Dimensionalconstant in s. Omega2 = CS%Omega*CS%Omega use_EOS = associated(tv%eqn_of_state) @@ -346,7 +346,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call cpu_clock_begin(id_clock_kappaShear) if (CS%Vertex_shear) then call full_convection(G, GV, h, tv, T_adj, S_adj, fluxes%p_surf, & - kappa_fill*dt_fill, halo=1) + GV%Z_to_H**2*kappa_fill*dt_fill, halo=1) call calc_kappa_shear_vertex(u, v, h, T_adj, S_adj, tv, fluxes%p_surf, visc%Kd_shear, & visc%TKE_turb, visc%Kv_shear_Bu, dt, G, GV, CS%kappaShear_CSp) From 4bf6386e651175460804b9231bcebb3a3f479c0c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 11 Oct 2018 12:13:49 -0400 Subject: [PATCH 0817/1072] Fixed rescaling of eta_av unsplit stepping code Corrected the dimensional rescaling of eta_av in step_MOM_dyn_unsplit and step_MOM_dyn_unsplit_RK2 to go to H. This only occurs with Boussinesq code, and the answers do not change if H_to_m is 1, as is often the case, and only diagnostics are impacted in ocean only cases. This code appears not to be adequately tested with the MOM6_examples test suite, which was bitwise identical with this change. --- src/core/MOM_dynamics_unsplit.F90 | 4 ++-- src/core/MOM_dynamics_unsplit_RK2.F90 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 96d78fccde..430443de06 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -209,7 +209,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume or mass !! transport since the last tracer advection, in m3 or kg. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height or - !! column mass, in m or kg m-2. + !! column mass, in H (m or kg m-2). type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit. type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with fields @@ -491,7 +491,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & endif if (GV%Boussinesq) then - do j=js,je ; do i=is,ie ; eta_av(i,j) = -G%Zd_to_m*G%bathyT(i,j) ; enddo ; enddo + do j=js,je ; do i=is,ie ; eta_av(i,j) = -GV%Z_to_H*G%bathyT(i,j) ; enddo ; enddo else do j=js,je ; do i=is,ie ; eta_av(i,j) = 0.0 ; enddo ; enddo endif diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index aef20292f8..3a5db102f2 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -221,7 +221,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! or mass transport since the last !! tracer advection, in m3 or kg. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height - !! or column mass, in m or kg m-2. + !! or column mass, in H (m or kg m-2). type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit_RK2. type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with @@ -431,7 +431,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, endif if (GV%Boussinesq) then - do j=js,je ; do i=is,ie ; eta_av(i,j) = -G%Zd_to_m*G%bathyT(i,j) ; enddo ; enddo + do j=js,je ; do i=is,ie ; eta_av(i,j) = -GV%Z_to_H*G%bathyT(i,j) ; enddo ; enddo else do j=js,je ; do i=is,ie ; eta_av(i,j) = 0.0 ; enddo ; enddo endif From 70779e6b306ee6b30ea851235e51d8ef708d8d7c Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 12 Oct 2018 15:30:24 -0600 Subject: [PATCH 0818/1072] Deletes TODO comments. Signs are correct. --- config_src/mct_driver/ocn_cap_methods.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index a9527f1660..38ee3f6b2e 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -65,13 +65,13 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, ice_ocean_boundary%lw_flux(i,j) = (x2o(ind%x2o_Faxa_lwdn,k) + x2o(ind%x2o_Foxx_lwup,k)) ! specific humitidy flux - ice_ocean_boundary%q_flux(i,j) = x2o(ind%x2o_Foxx_evap,k) !???TODO: should this be a minus sign + ice_ocean_boundary%q_flux(i,j) = x2o(ind%x2o_Foxx_evap,k) ! sensible heat flux (W/m2) - ice_ocean_boundary%t_flux(i,j) = x2o(ind%x2o_Foxx_sen,k) !???TODO: should this be a minus sign + 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) !???TODO: should this be a minus sign + ice_ocean_boundary%latent_flux(i,j) = x2o(ind%x2o_Foxx_lat,k) ! snow&ice melt heat flux (W/m^2) ice_ocean_boundary%melth(i,j) = x2o(ind%x2o_Fioi_melth,k) From 67e70c5f16c6bfb2cc85e7fdf9e21851bf5efb4b Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 12 Oct 2018 15:44:27 -0600 Subject: [PATCH 0819/1072] Add more complete description of Fioi_meltw --- config_src/mct_driver/ocn_cpl_indices.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/mct_driver/ocn_cpl_indices.F90 b/config_src/mct_driver/ocn_cpl_indices.F90 index 52f94f6106..32c0f4155f 100644 --- a/config_src/mct_driver/ocn_cpl_indices.F90 +++ b/config_src/mct_driver/ocn_cpl_indices.F90 @@ -41,7 +41,7 @@ module ocn_cpl_indices integer :: x2o_Faxa_swndr !< near-IR, direct shortwave (W/m2) integer :: x2o_Faxa_swndf !< near-IR, direct shortwave (W/m2) integer :: x2o_Fioi_melth !< Heat flux from snow & ice melt (W/m2) - integer :: x2o_Fioi_meltw !< Snow melt flux (kg/m2/s) + integer :: x2o_Fioi_meltw !< Water flux from sea ice and snow melt (kg/m2/s) integer :: x2o_Fioi_bcpho !< Black Carbon hydrophobic release from sea ice component integer :: x2o_Fioi_bcphi !< Black Carbon hydrophilic release from sea ice component integer :: x2o_Fioi_flxdst !< Dust release from sea ice component From 918f218efab526ea973f991ff3ad2031e18b8d5a Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 12 Oct 2018 15:49:40 -0600 Subject: [PATCH 0820/1072] Adds meltw (water flux from seaice and snow) The corresponding variable from CIME is *Fioi_meltw --- config_src/mct_driver/MOM_surface_forcing.F90 | 8 ++++++++ config_src/mct_driver/ocn_cap_methods.F90 | 4 ++++ 2 files changed, 12 insertions(+) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 97f118a6f9..0d45409925 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -158,6 +158,7 @@ module MOM_surface_forcing 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(:,:) :: melth =>NULL() !< sea ice and snow melt heat flux (W/m2) + real, pointer, dimension(:,:) :: meltw =>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) @@ -446,6 +447,10 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & if (associated(fluxes%melth)) & fluxes%melth(i,j) = G%mask2dT(i,j) * IOB%melth(i-i0,j-j0) + ! water flux due to sea ice and snow melt (kg/m2/s) + if (associated(fluxes%meltw)) & + fluxes%meltw(i,j) = G%mask2dT(i,j) * IOB%meltw(i-i0,j-j0) + ! latent heat flux (W/m^2) if (associated(fluxes%latent)) & fluxes%latent(i,j) = G%mask2dT(i,j) * IOB%latent_flux(i-i0,j-j0) @@ -776,6 +781,7 @@ subroutine IOB_allocate(IOB, isc, iec, jsc, jec) IOB% v_flux (isc:iec,jsc:jec), & IOB% t_flux (isc:iec,jsc:jec), & IOB% melth (isc:iec,jsc:jec), & + IOB% meltw (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), & @@ -801,6 +807,7 @@ subroutine IOB_allocate(IOB, isc, iec, jsc, jec) IOB%v_flux = 0.0 IOB%t_flux = 0.0 IOB%melth = 0.0 + IOB%meltw = 0.0 IOB%q_flux = 0.0 IOB%salt_flux = 0.0 IOB%lw_flux = 0.0 @@ -1316,6 +1323,7 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) 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%melth ', mpp_chksum( iobt%melth ) + write(outunit,100) 'iobt%meltw ', mpp_chksum( iobt%meltw ) 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 ) diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 38ee3f6b2e..d58400b270 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -76,6 +76,9 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, ! snow&ice melt heat flux (W/m^2) ice_ocean_boundary%melth(i,j) = x2o(ind%x2o_Fioi_melth,k) + ! water flux from snow&ice melt (kg/m2/s) + ice_ocean_boundary%meltw(i,j) = x2o(ind%x2o_Fioi_meltw,k) + ! liquid runoff ice_ocean_boundary%rofl_flux(i,j) = x2o(ind%x2o_Foxx_rofl,k) * GRID%mask2dT(ig,jg) @@ -120,6 +123,7 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, write(logunit,F01)'import: day, secs, j, i, q_flux = ',day,secs,j,i,ice_ocean_boundary%q_flux(i,j) write(logunit,F01)'import: day, secs, j, i, t_flux = ',day,secs,j,i,ice_ocean_boundary%t_flux(i,j) write(logunit,F01)'import: day, secs, j, i, melth = ',day,secs,j,i,ice_ocean_boundary%melth(i,j) + write(logunit,F01)'import: day, secs, j, i, meltw = ',day,secs,j,i,ice_ocean_boundary%meltw(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 = ',& From d581094ca6d1ad68b6aeb9533717211103259d56 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 12 Oct 2018 15:51:28 -0600 Subject: [PATCH 0821/1072] Updates MCT doxygen after adding meltw and melth --- config_src/mct_driver/ocn_comp_mct.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 97692ccc65..442b44f67d 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -773,8 +773,6 @@ end subroutine ocean_model_init_sfc !! mi, mass of ice (kg/m2) !! !! Variables in the coupler that are **NOT** used in MOM6 (i.e., no corresponding field in fluxes): -!! x2o_Fioi_melth, heat flux from snow & ice melt (W/m2) -!! x2o_Fioi_meltw, snow melt flux (kg/m2/s) !! x2o_Si_ifrac, fractional ice wrt ocean !! x2o_So_duu10n, 10m wind speed squared (m^2/s^2) !! x2o_Sa_co2prog, bottom atm level prognostic CO2 From a2ab18d7e51984b6fd4fe572a77f2b4bba7387ec Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 13 Oct 2018 14:49:49 -0400 Subject: [PATCH 0822/1072] Recast MOM_wave_speed to work in units of Z Recast the internal calculations in MOM_wave_speed to use vertical height units of Z in place of m for dimensional consistency testing. Several probable bugs were highlighted in comments but not corrected. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- src/diagnostics/MOM_wave_speed.F90 | 151 ++++++++++++----------------- 1 file changed, 62 insertions(+), 89 deletions(-) diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index ea2212a4ab..e8d58e502b 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -29,7 +29,7 @@ module MOM_wave_speed !! wave speed. This parameter controls the default behavior of !! wave_speed() which can be overridden by optional arguments. real :: mono_N2_depth = -1. !< The depth below which N2 is limited as monotonic for the purposes of - !! calculating the equivalent barotropic wave speed. (m) + !! calculating the equivalent barotropic wave speed. (Z) !! This parameter controls the default behavior of wave_speed() which !! can be overridden by optional arguments. type(remapping_CS) :: remapping_CS !< Used for vertical remapping when calculating equivalent barotropic @@ -58,7 +58,7 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & !! for the purposes of calculating vertical modal structure. real, optional, intent(in) :: mono_N2_depth !< A depth below which N2 is limited as !! monotonic for the purposes of calculating vertical - !! modal structure. + !! modal structure, in m. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: modal_structure !< Normalized model structure (non-dim) @@ -66,7 +66,7 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & real, dimension(SZK_(G)+1) :: & dRho_dT, dRho_dS, & pres, T_int, S_int, & - gprime ! The reduced gravity across each interface, in m s-2. + gprime ! The reduced gravity across each interface, in m2 Z-1 s-2. real, dimension(SZK_(G)) :: & Igl, Igu ! The inverse of the reduced gravity across an interface times ! the thickness of the layer below (Igl) or above (Igu) it, @@ -78,13 +78,13 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & real det, ddet, detKm1, detKm2, ddetKm1, ddetKm2 real :: lam, dlam, lam0 real :: min_h_frac - real :: H_to_pres - real :: H_to_m ! Local copy of a unit conversion factor. + real :: H_to_pres ! A conversion factor from thickesses (in Z) to pressure (in Pa) real, dimension(SZI_(G)) :: & htot, hmin, & ! Thicknesses in m. H_here, HxT_here, HxS_here, HxR_here real :: speed2_tot real :: I_Hnew, drxh_sum + real :: L2_to_Z2 ! A scaling factor squared from units of lateral distances to depths, in Z2 m-2. real, parameter :: tol1 = 0.0001, tol2 = 0.001 real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() real :: g_Rho0 ! G_Earth/Rho0 in m4 s-2 kg-1. @@ -109,12 +109,14 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed endif ; endif + L2_to_Z2 = GV%m_to_Z**2 + l_use_ebt_mode = CS%use_ebt_mode if (present(use_ebt_mode)) l_use_ebt_mode = use_ebt_mode l_mono_N2_column_fraction = CS%mono_N2_column_fraction if (present(mono_N2_column_fraction)) l_mono_N2_column_fraction = mono_N2_column_fraction - l_mono_N2_depth = CS%mono_N2_depth - if (present(mono_N2_depth)) l_mono_N2_depth = mono_N2_depth + l_mono_N2_depth = GV%m_to_Z*CS%mono_N2_depth + if (present(mono_N2_depth)) l_mono_N2_depth = GV%m_to_Z*mono_N2_depth calc_modal_structure = l_use_ebt_mode if (present(modal_structure)) calc_modal_structure = .true. if (calc_modal_structure) then @@ -124,18 +126,17 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & endif S => tv%S ; T => tv%T - g_Rho0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 + g_Rho0 = GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) - H_to_pres = (GV%g_Earth*GV%m_to_Z) * GV%Rho0 - H_to_m = GV%H_to_m + H_to_pres = GV%g_Earth * GV%Rho0 rescale = 1024.0**4 ; I_rescale = 1.0/rescale min_h_frac = tol1 / real(nz) !$OMP parallel do default(none) shared(is,ie,js,je,nz,h,G,GV,min_h_frac,use_EOS,T,S,tv,& !$OMP calc_modal_structure,l_use_ebt_mode,modal_structure, & !$OMP l_mono_N2_column_fraction,l_mono_N2_depth,CS, & -!$OMP H_to_pres,H_to_m,cg1,g_Rho0,rescale,I_rescale) & +!$OMP H_to_pres,cg1,g_Rho0,rescale,I_rescale,L2_to_Z2) & !$OMP private(htot,hmin,kf,H_here,HxT_here,HxS_here,HxR_here, & !$OMP Hf,Tf,Sf,Rf,pres,T_int,S_int,drho_dT, & !$OMP drho_dS,drxh_sum,kc,Hc,Tc,Sc,I_Hnew,gprime, & @@ -148,7 +149,7 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & ! at the top). This also transposes the row order so that columns can ! be worked upon one at a time. do i=is,ie ; htot(i) = 0.0 ; enddo - do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k)*H_to_m ; enddo ; enddo + do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k)*GV%H_to_Z ; enddo ; enddo do i=is,ie hmin(i) = htot(i)*min_h_frac ; kf(i) = 1 ; H_here(i) = 0.0 @@ -156,20 +157,20 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & enddo if (use_EOS) then do k=1,nz ; do i=is,ie - if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then + if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then Hf(kf(i),i) = H_here(i) Tf(kf(i),i) = HxT_here(i) / H_here(i) Sf(kf(i),i) = HxS_here(i) / H_here(i) kf(i) = kf(i) + 1 ! Start a new layer - H_here(i) = h(i,j,k)*H_to_m - HxT_here(i) = (h(i,j,k)*H_to_m)*T(i,j,k) - HxS_here(i) = (h(i,j,k)*H_to_m)*S(i,j,k) + H_here(i) = h(i,j,k)*GV%H_to_Z + HxT_here(i) = (h(i,j,k)*GV%H_to_Z)*T(i,j,k) + HxS_here(i) = (h(i,j,k)*GV%H_to_Z)*S(i,j,k) else - H_here(i) = H_here(i) + h(i,j,k)*H_to_m - HxT_here(i) = HxT_here(i) + (h(i,j,k)*H_to_m)*T(i,j,k) - HxS_here(i) = HxS_here(i) + (h(i,j,k)*H_to_m)*S(i,j,k) + H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z + HxT_here(i) = HxT_here(i) + (h(i,j,k)*GV%H_to_Z)*T(i,j,k) + HxS_here(i) = HxS_here(i) + (h(i,j,k)*GV%H_to_Z)*S(i,j,k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then @@ -179,16 +180,16 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & endif ; enddo else do k=1,nz ; do i=is,ie - if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then + if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then Hf(kf(i),i) = H_here(i) ; Rf(kf(i),i) = HxR_here(i) / H_here(i) kf(i) = kf(i) + 1 ! Start a new layer - H_here(i) = h(i,j,k)*H_to_m - HxR_here(i) = (h(i,j,k)*H_to_m)*GV%Rlay(k) + H_here(i) = h(i,j,k)*GV%H_to_Z + HxR_here(i) = (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k) else - H_here(i) = H_here(i) + h(i,j,k)*H_to_m - HxR_here(i) = HxR_here(i) + (h(i,j,k)*H_to_m)*GV%Rlay(k) + H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z + HxR_here(i) = HxR_here(i) + (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then @@ -312,27 +313,29 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & speed2_tot = 0.0 if (l_use_ebt_mode) then Igu(1) = 0. ! Neumann condition for pressure modes - sum_hc = Hc(1)*GV%H_to_m - N2min = gprime(2)/Hc(1) + sum_hc = Hc(1)*GV%H_to_m !### I believe this conversion factor to be wrong. -RWH + N2min = L2_to_Z2*gprime(2)/Hc(1) do k=2,kc hw = 0.5*(Hc(k-1)+Hc(k)) gp = gprime(K) if (l_mono_N2_column_fraction>0. .or. l_mono_N2_depth>=0.) then - if (G%Zd_to_m*G%bathyT(i,j)-sum_hc < l_mono_N2_column_fraction*G%Zd_to_m*G%bathyT(i,j) .and. & - gp>N2min*hw) then + if (G%bathyT(i,j)-sum_hc < l_mono_N2_column_fraction*G%bathyT(i,j) .and. & + L2_to_Z2*gp > N2min*hw) then ! Filters out regions where N2 increases with depth but only in a lower fraction of water column - gp = N2min/hw - elseif (l_mono_N2_depth>=0. .and. sum_hc>l_mono_N2_depth .and. gp>N2min*hw) then + gp = N2min/hw !### THIS IS DIMENSIONALLY INCONSISTENT! -RWH + !### This should be gp = GV%Z_to_m**2* (N2min*hw) + elseif (l_mono_N2_depth>=0. .and. sum_hc>l_mono_N2_depth .and. L2_to_Z2*gp>N2min*hw) then ! Filters out regions where N2 increases with depth but only below a certain depth - gp = N2min/hw + gp = N2min/hw !### THIS IS DIMENSIONALLY INCONSISTENT! -RWH + !### This should be gp = GV%Z_to_m**2* (N2min*hw) else - N2min = gp/hw + N2min = L2_to_Z2 * gp/hw endif endif Igu(k) = 1.0/(gp*Hc(k)) Igl(k-1) = 1.0/(gp*Hc(k-1)) speed2_tot = speed2_tot + gprime(k)*(Hc(k-1)+Hc(k))*0.707 - sum_hc = sum_hc + Hc(k)*GV%H_to_m + sum_hc = sum_hc + Hc(k)*GV%H_to_m !### I believe this conversion factor to be wrong. -RWH enddo !Igl(kc) = 0. ! Neumann condition for pressure modes Igl(kc) = 2.*Igu(kc) ! Dirichlet condition for pressure modes @@ -449,9 +452,9 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & mode_struct(1:kc)=0. endif ! Note that remapping_core_h requires that the same units be used - ! for both the source and target grid thicknesses. - call remapping_core_h(CS%remapping_CS, kc, Hc, mode_struct, & - nz, GV%H_to_m*h(i,j,:), modal_structure(i,j,:)) + ! for both the source and target grid thicknesses, here in H. + call remapping_core_h(CS%remapping_CS, kc, GV%Z_to_H*Hc(:), mode_struct, & + nz, h(i,j,:), modal_structure(i,j,:), 1.0e-30*GV%m_to_H, 1.0e-10*GV%m_to_H) endif else cg1(i,j) = 0.0 @@ -506,7 +509,7 @@ subroutine tdma6(n, a, b, c, lam, y) do k = n-1, 1, -1 y(k) = ( yy(k) - c(k) * y(k+1) ) * beta(k) enddo -end subroutine +end subroutine tdma6 !> Calculates the wave speeds for the first few barolinic modes. subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) @@ -556,7 +559,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) integer :: numint ! number of widows (intervals) in root searching range integer :: nrootsfound ! number of extra roots found (not including 1st root) real :: min_h_frac - real :: H_to_pres + real :: H_to_pres ! A conversion factor from thickesses (in Z) to pressure (in Pa) real :: H_to_m ! Local copy of a unit conversion factor. real, dimension(SZI_(G)) :: & htot, hmin, & ! Thicknesses in m. @@ -596,10 +599,10 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) endif ; endif S => tv%S ; T => tv%T - g_Rho0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 + g_Rho0 = GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) - H_to_pres = (GV%g_Earth*GV%m_to_Z) * GV%Rho0 + H_to_pres = GV%g_Earth * GV%Rho0 H_to_m = GV%H_to_m min_h_frac = tol1 / real(nz) @@ -620,7 +623,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) ! at the top). This also transposes the row order so that columns can ! be worked upon one at a time. do i=is,ie ; htot(i) = 0.0 ; enddo - do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k)*H_to_m ; enddo ; enddo + do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k)*GV%H_to_Z ; enddo ; enddo do i=is,ie hmin(i) = htot(i)*min_h_frac ; kf(i) = 1 ; H_here(i) = 0.0 @@ -628,20 +631,20 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) enddo if (use_EOS) then do k=1,nz ; do i=is,ie - if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then + if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then Hf(kf(i),i) = H_here(i) Tf(kf(i),i) = HxT_here(i) / H_here(i) Sf(kf(i),i) = HxS_here(i) / H_here(i) kf(i) = kf(i) + 1 ! Start a new layer - H_here(i) = h(i,j,k)*H_to_m - HxT_here(i) = (h(i,j,k)*H_to_m)*T(i,j,k) - HxS_here(i) = (h(i,j,k)*H_to_m)*S(i,j,k) + H_here(i) = h(i,j,k)*GV%H_to_Z + HxT_here(i) = (h(i,j,k)*GV%H_to_Z)*T(i,j,k) + HxS_here(i) = (h(i,j,k)*GV%H_to_Z)*S(i,j,k) else - H_here(i) = H_here(i) + h(i,j,k)*H_to_m - HxT_here(i) = HxT_here(i) + (h(i,j,k)*H_to_m)*T(i,j,k) - HxS_here(i) = HxS_here(i) + (h(i,j,k)*H_to_m)*S(i,j,k) + H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z + HxT_here(i) = HxT_here(i) + (h(i,j,k)*GV%H_to_Z)*T(i,j,k) + HxS_here(i) = HxS_here(i) + (h(i,j,k)*GV%H_to_Z)*S(i,j,k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then @@ -651,16 +654,16 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) endif ; enddo else do k=1,nz ; do i=is,ie - if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then + if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then Hf(kf(i),i) = H_here(i) ; Rf(kf(i),i) = HxR_here(i) / H_here(i) kf(i) = kf(i) + 1 ! Start a new layer - H_here(i) = h(i,j,k)*H_to_m - HxR_here(i) = (h(i,j,k)*H_to_m)*GV%Rlay(k) + H_here(i) = h(i,j,k)*GV%H_to_Z + HxR_here(i) = (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k) else - H_here(i) = H_here(i) + h(i,j,k)*H_to_m - HxR_here(i) = HxR_here(i) + (h(i,j,k)*H_to_m)*GV%Rlay(k) + H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z + HxR_here(i) = HxR_here(i) + (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then @@ -787,7 +790,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) do K=2,kc Igl(K) = 1.0/(gprime(K)*Hc(k)) ; Igu(K) = 1.0/(gprime(K)*Hc(k-1)) z_int(K) = z_int(K-1) + Hc(k-1) - N2(K) = gprime(K)/(0.5*(Hc(k)+Hc(k-1))) + N2(K) = GV%m_to_Z**2*gprime(K)/(0.5*(Hc(k)+Hc(k-1))) speed2_tot = speed2_tot + gprime(K)*(Hc(k-1)+Hc(k)) enddo ! Set stratification for surface and bottom (setting equal to nearest interface for now) @@ -795,11 +798,8 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) ! Calcualte depth at bottom z_int(kc+1) = z_int(kc)+Hc(kc) ! check that thicknesses sum to total depth - if (abs(z_int(kc+1)-htot(i)) > 1.e-10) then - call MOM_error(WARNING, "wave_structure: mismatch in total depths") - print *, "kc=", kc - print *, "z_int(kc+1)=", z_int(kc+1) - print *, "htot(i)=", htot(i) + if (abs(z_int(kc+1)-htot(i)) > 1.e-12*htot(i)) then + call MOM_error(FATAL, "wave_structure: mismatch in total depths") endif ! Define the diagonals of the tridiagonal matrix @@ -955,19 +955,6 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) call MOM_error(WARNING, "wave_speed: root not found "// & " after sub_it_max subdivisions of original"// & " interval.") - !if (ig == 144 .and. jg == 5) then - !print *, "xbl=",xbl - !print *, "xbr=",xbr - !print *, "Wave_speed: kc=",kc - !print *, 'Wave_speed: z_int(ig,jg)=', z_int(1:kc+1) - !print *, 'Wave_speed: N2(ig,jg)=', N2(1:kc+1) - !print *, 'Wave_speed: gprime=', gprime(1:kc+1) - !print *, 'Wave_speed: htot=', htot(i) - !print *, 'Wave_speed: cn1=', cn(i,j,1) - !print *, 'Wave_speed: numint=', numint - !print *, 'Wave_speed: nrootsfound=', nrootsfound - !stop - !endif endif ! sub_it == sub_it_max enddo ! sub_it-loop------------------------------------------------- endif ! det_l*ddet_l < 0.0 @@ -980,20 +967,6 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) ! oops, lamMax not large enough - could add code to increase (BDM) ! set unfound modes to zero for now (BDM) cn(i,j,nrootsfound+2:nmodes) = 0.0 - !if (ig == 83 .and. jg == 2) then - ! call MOM_error(WARNING, "wave_speed: not all modes found "// & - ! " within search range: increase numint.") - ! print *, "Increase lamMax at ig=",ig," jg=",jg - ! print *, "where lamMax=", lamMax - ! print *, 'numint=', numint - ! print *, "nrootsfound=", nrootsfound - ! print *, "xbl=",xbl - ! print *, "xbr=",xbr - !print *, "kc=",kc - !print *, 'z_int(ig,jg)=', z_int(1:kc+1) - !print *, 'N2(ig,jg)=', N2(1:kc+1) - !stop - !endif else ! else shift interval and keep looking until nmodes or numint is reached det_l = det_r @@ -1133,9 +1106,9 @@ subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_ if (.not.associated(CS)) call MOM_error(FATAL, & "wave_speed_set_param called with an associated control structure.") - if (present(use_ebt_mode)) CS%use_ebt_mode=use_ebt_mode - if (present(mono_N2_column_fraction)) CS%mono_N2_column_fraction=mono_N2_column_fraction - if (present(mono_N2_depth)) CS%mono_N2_depth=mono_N2_depth + if (present(use_ebt_mode)) CS%use_ebt_mode = use_ebt_mode + if (present(mono_N2_column_fraction)) CS%mono_N2_column_fraction = mono_N2_column_fraction + if (present(mono_N2_depth)) CS%mono_N2_depth = mono_N2_depth end subroutine wave_speed_set_param From b806a3416ae6e9662f902a075cba5c6c8271a05d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 13 Oct 2018 15:44:55 -0400 Subject: [PATCH 0823/1072] Recast MOM_structure to work in units of Z Recast the internal calculations in MOM_structure to use vertical height units of Z in place of m for dimensional consistency testing. At one point the code goes into a complicated iterative tridiagonal solver, and this part of the algorithm reverts to working in m (for now). All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- src/diagnostics/MOM_wave_structure.F90 | 148 ++++++++++--------------- 1 file changed, 60 insertions(+), 88 deletions(-) diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 45e71e70ba..735690eb81 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -44,7 +44,7 @@ module MOM_wave_structure real, allocatable, dimension(:,:,:) :: z_depths !< Depths of layer interfaces, in m. real, allocatable, dimension(:,:,:) :: N2 - !< Squared buoyancy frequency at each interface + !< Squared buoyancy frequency at each interface, in S-2. integer, allocatable, dimension(:,:):: num_intfaces !< Number of layer interfaces (including surface and bottom) real :: int_tide_source_x !< X Location of generation site @@ -108,7 +108,7 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) real, dimension(SZK_(G)+1) :: & dRho_dT, dRho_dS, & pres, T_int, S_int, & - gprime ! The reduced gravity across each interface, in m s-2. + gprime ! The reduced gravity across each interface, in m2 Z-1 s-2. real, dimension(SZK_(G)) :: & Igl, Igu ! The inverse of the reduced gravity across an interface times ! the thickness of the layer below (Igl) or above (Igu) it, @@ -123,15 +123,14 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) real :: lam real :: min_h_frac real :: H_to_pres - real :: H_to_m ! Local copy of a unit conversion factor. real, dimension(SZI_(G)) :: & - hmin, & ! Thicknesses in m. + hmin, & ! Thicknesses in Z. H_here, HxT_here, HxS_here, HxR_here real :: speed2_tot real :: I_Hnew, drxh_sum real, parameter :: tol1 = 0.0001, tol2 = 0.001 real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() - real :: g_Rho0 ! G_Earth/Rho0 in m4 s-2 kg-1. + real :: g_Rho0 ! G_Earth/Rho0 in m5 Z-1 s-2 kg-1. real :: rescale, I_rescale integer :: kf(SZI_(G)) integer, parameter :: max_itt = 1 ! number of times to iterate in solving for eigenvector @@ -152,6 +151,7 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) real :: w2avg ! average of squared vertical velocity structure funtion real :: int_dwdz2, int_w2, int_N2w2, KE_term, PE_term, W0 ! terms in vertically averaged energy equation + real :: gp_unscaled ! A version of gprime rescaled to units of m s-2. real, dimension(SZK_(G)-1) :: lam_z ! product of eigen value and gprime(k); one value for each ! interface (excluding surface and bottom) real, dimension(SZK_(G)-1) :: a_diag, b_diag, c_diag @@ -178,11 +178,10 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) Pi = (4.0*atan(1.0)) S => tv%S ; T => tv%T - g_Rho0 = (GV%g_Earth*GV%m_to_Z)/GV%Rho0 + g_Rho0 = GV%g_Earth /GV%Rho0 use_EOS = associated(tv%eqn_of_state) - H_to_pres = (GV%g_Earth*GV%m_to_Z) * GV%Rho0 - H_to_m = GV%H_to_m + H_to_pres = GV%g_Earth * GV%Rho0 rescale = 1024.0**4 ; I_rescale = 1.0/rescale min_h_frac = tol1 / real(nz) @@ -192,7 +191,7 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) ! at the top). This also transposes the row order so that columns can ! be worked upon one at a time. do i=is,ie ; htot(i,j) = 0.0 ; enddo - do k=1,nz ; do i=is,ie ; htot(i,j) = htot(i,j) + h(i,j,k)*H_to_m ; enddo ; enddo + do k=1,nz ; do i=is,ie ; htot(i,j) = htot(i,j) + h(i,j,k)*GV%H_to_Z ; enddo ; enddo do i=is,ie hmin(i) = htot(i,j)*min_h_frac ; kf(i) = 1 ; H_here(i) = 0.0 @@ -200,20 +199,20 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) enddo if (use_EOS) then do k=1,nz ; do i=is,ie - if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then + if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then Hf(kf(i),i) = H_here(i) Tf(kf(i),i) = HxT_here(i) / H_here(i) Sf(kf(i),i) = HxS_here(i) / H_here(i) kf(i) = kf(i) + 1 ! Start a new layer - H_here(i) = h(i,j,k)*H_to_m - HxT_here(i) = (h(i,j,k)*H_to_m)*T(i,j,k) - HxS_here(i) = (h(i,j,k)*H_to_m)*S(i,j,k) + H_here(i) = h(i,j,k)*GV%H_to_Z + HxT_here(i) = (h(i,j,k)*GV%H_to_Z)*T(i,j,k) + HxS_here(i) = (h(i,j,k)*GV%H_to_Z)*S(i,j,k) else - H_here(i) = H_here(i) + h(i,j,k)*H_to_m - HxT_here(i) = HxT_here(i) + (h(i,j,k)*H_to_m)*T(i,j,k) - HxS_here(i) = HxS_here(i) + (h(i,j,k)*H_to_m)*S(i,j,k) + H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z + HxT_here(i) = HxT_here(i) + (h(i,j,k)*GV%H_to_Z)*T(i,j,k) + HxS_here(i) = HxS_here(i) + (h(i,j,k)*GV%H_to_Z)*S(i,j,k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then @@ -223,16 +222,16 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) endif ; enddo else do k=1,nz ; do i=is,ie - if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*H_to_m > hmin(i))) then + if ((H_here(i) > hmin(i)) .and. (h(i,j,k)*GV%H_to_Z > hmin(i))) then Hf(kf(i),i) = H_here(i) ; Rf(kf(i),i) = HxR_here(i) / H_here(i) kf(i) = kf(i) + 1 ! Start a new layer - H_here(i) = h(i,j,k)*H_to_m - HxR_here(i) = (h(i,j,k)*H_to_m)*GV%Rlay(k) + H_here(i) = h(i,j,k)*GV%H_to_Z + HxR_here(i) = (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k) else - H_here(i) = H_here(i) + h(i,j,k)*H_to_m - HxR_here(i) = HxR_here(i) + (h(i,j,k)*H_to_m)*GV%Rlay(k) + H_here(i) = H_here(i) + h(i,j,k)*GV%H_to_Z + HxR_here(i) = HxR_here(i) + (h(i,j,k)*GV%H_to_Z)*GV%Rlay(k) endif enddo ; enddo do i=is,ie ; if (H_here(i) > 0.0) then @@ -368,20 +367,20 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) do K=2,kc Igl(K) = 1.0/(gprime(K)*Hc(k)) ; Igu(K) = 1.0/(gprime(K)*Hc(k-1)) z_int(K) = z_int(K-1) + Hc(k-1) - N2(K) = gprime(K)/(0.5*(Hc(k)+Hc(k-1))) + N2(K) = GV%m_to_Z**2*gprime(K)/(0.5*(Hc(k)+Hc(k-1))) enddo ! Set stratification for surface and bottom (setting equal to nearest interface for now) N2(1) = N2(2) ; N2(kc+1) = N2(kc) ! Calcualte depth at bottom z_int(kc+1) = z_int(kc)+Hc(kc) ! check that thicknesses sum to total depth - if (abs(z_int(kc+1)-htot(i,j)) > 1.e-10) then - call MOM_error(WARNING, "wave_structure: mismatch in total depths") - print *, "kc=", kc - print *, "z_int(kc+1)=", z_int(kc+1) - print *, "htot(i,j)=", htot(i,j) + if (abs(z_int(kc+1)-htot(i,j)) > 1.e-14*htot(i,j)) then + call MOM_error(FATAL, "wave_structure: mismatch in total depths") endif + ! Note that many of the calcluation from here on revert to using vertical + ! distances in m, not Z. + ! Populate interior rows of tridiagonal matrix; must multiply through by ! gprime to get tridiagonal matrix to the symmetrical form: ! [-1/H(k-1)]e(k-1) + [1/H(k-1)+1/H(k)-lam_z]e(k) + [-1/H(k)]e(k+1) = 0, @@ -389,30 +388,33 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) ! Frist, populate interior rows do K=3,kc-1 row = K-1 ! indexing for TD matrix rows - lam_z(row) = lam*gprime(K) - a_diag(row) = gprime(K)*(-Igu(K)) - b_diag(row) = gprime(K)*(Igu(K)+Igl(K)) - lam_z(row) - c_diag(row) = gprime(K)*(-Igl(K)) + gp_unscaled = GV%m_to_Z*gprime(K) + lam_z(row) = lam*gp_unscaled + a_diag(row) = gp_unscaled*(-Igu(K)) + b_diag(row) = gp_unscaled*(Igu(K)+Igl(K)) - lam_z(row) + c_diag(row) = gp_unscaled*(-Igl(K)) if (isnan(lam_z(row)))then ; print *, "Wave_structure: lam_z(row) is NAN" ; endif if (isnan(a_diag(row)))then ; print *, "Wave_structure: a(k) is NAN" ; endif if (isnan(b_diag(row)))then ; print *, "Wave_structure: b(k) is NAN" ; endif if (isnan(c_diag(row)))then ; print *, "Wave_structure: c(k) is NAN" ; endif enddo ! Populate top row of tridiagonal matrix - K=2 ; row = K-1 - lam_z(row) = lam*gprime(K) + K=2 ; row = K-1 ; + gp_unscaled = GV%m_to_Z*gprime(K) + lam_z(row) = lam*gp_unscaled a_diag(row) = 0.0 - b_diag(row) = gprime(K)*(Igu(K)+Igl(K)) - lam_z(row) - c_diag(row) = gprime(K)*(-Igl(K)) + b_diag(row) = gp_unscaled*(Igu(K)+Igl(K)) - lam_z(row) + c_diag(row) = gp_unscaled*(-Igl(K)) ! Populate bottom row of tridiagonal matrix K=kc ; row = K-1 - lam_z(row) = lam*gprime(K) - a_diag(row) = gprime(K)*(-Igu(K)) - b_diag(row) = gprime(K)*(Igu(K)+Igl(K)) - lam_z(row) + gp_unscaled = GV%m_to_Z*gprime(K) + lam_z(row) = lam*gp_unscaled + a_diag(row) = gp_unscaled*(-Igu(K)) + b_diag(row) = gp_unscaled*(Igu(K)+Igl(K)) - lam_z(row) c_diag(row) = 0.0 ! Guess a vector shape to start with (excludes surface and bottom) - e_guess(1:kc-1) = sin(z_int(2:kc)/htot(i,j)*Pi) + e_guess(1:kc-1) = sin((z_int(2:kc)/htot(i,j)) *Pi) e_guess(1:kc-1) = e_guess(1:kc-1)/sqrt(sum(e_guess(1:kc-1)**2)) ! Perform inverse iteration with tri-diag solver @@ -441,11 +443,12 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) !(including surface and bottom) w2avg = 0.0 do k=1,nzm-1 - dz(k) = Hc(k) + dz(k) = GV%Z_to_m*Hc(k) w2avg = w2avg + 0.5*(w_strct(K)**2+w_strct(K+1)**2)*dz(k) enddo - w2avg = w2avg/htot(i,j) - w_strct = w_strct/sqrt(htot(i,j)*w2avg*I_a_int) + !### Some mathematical cancellations could occur in the next two lines. + w2avg = w2avg / htot(i,j) + w_strct = w_strct / sqrt(htot(i,j)*w2avg*I_a_int) ! Calculate vertical structure function of u (i.e. dw/dz) do K=2,nzm-1 @@ -495,45 +498,13 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) endif ! Store values in control structure - CS%w_strct(i,j,1:nzm) = w_strct - CS%u_strct(i,j,1:nzm) = u_strct - CS%W_profile(i,j,1:nzm) = W_profile - CS%Uavg_profile(i,j,1:nzm)= Uavg_profile - CS%z_depths(i,j,1:nzm) = z_int - CS%N2(i,j,1:nzm) = N2 + CS%w_strct(i,j,1:nzm) = w_strct(:) + CS%u_strct(i,j,1:nzm) = u_strct(:) + CS%W_profile(i,j,1:nzm) = W_profile(:) + CS%Uavg_profile(i,j,1:nzm)= Uavg_profile(:) + CS%z_depths(i,j,1:nzm) = GV%Z_to_m*z_int(:) + CS%N2(i,j,1:nzm) = N2(:) CS%num_intfaces(i,j) = nzm - - !----for debugging; delete later---- - !if (ig == ig_stop .and. jg == jg_stop) then - !print *, 'cn(ig,jg)=', cn(i,j) - !print *, "e_guess=", e_guess(1:kc-1) - !print *, "|e_guess|=", sqrt(sum(e_guess(1:kc-1)**2)) - !print *, 'f0=', sqrt(f2) - !print *, 'freq=', freq - !print *, 'Kh=', sqrt(Kmag2) - !print *, 'Wave_structure: z_int(ig,jg)=', z_int(1:nzm) - !print *, 'Wave_structure: N2(ig,jg)=', N2(1:nzm) - !print *, 'gprime=', gprime(1:nzm) - !print *, '1/Hc=', 1/Hc - !print *, 'Wave_structure: a_diag(ig,jg)=', a_diag(1:kc-1) - !print *, 'Wave_structure: b_diag(ig,jg)=', b_diag(1:kc-1) - !print *, 'Wave_structure: c_diag(ig,jg)=', c_diag(1:kc-1) - !print *, 'Wave_structure: lam_z(ig,jg)=', lam_z(1:kc-1) - !print *, 'Wave_structure: w_strct(ig,jg)=', w_strct(1:nzm) - !print *, 'En(i,j)=', En(i,j) - !print *, 'Wave_structure: W_profile(ig,jg)=', W_profile(1:nzm) - !print *,'int_dwdz2 =',int_dwdz2 - !print *,'int_w2 =',int_w2 - !print *,'int_N2w2 =',int_N2w2 - !print *,'KEterm=',KE_term - !print *,'PEterm=',PE_term - !print *, 'W0=',W0 - !print *,'Uavg_profile=',Uavg_profile(1:nzm) - !open(unit=1,file='out_N2',form='formatted') ; write(1,*) N2 ; close(1) - !open(unit=2,file='out_z',form='formatted') ; write(2,*) z_int ; close(2) - !endif - !----------------------------------- - else ! If not enough layers, default to zero nzm = kc+1 @@ -584,8 +555,8 @@ subroutine tridiag_solver(a, b, c, h, y, method, x) real, dimension(:), intent(out) :: x !< vector of unknown values to solve for. ! Local variables integer :: nrow ! number of rows in A matrix - real, allocatable, dimension(:,:) :: A_check ! for solution checking - real, allocatable, dimension(:) :: y_check ! for solution checking +! real, allocatable, dimension(:,:) :: A_check ! for solution checking +! real, allocatable, dimension(:) :: y_check ! for solution checking real, allocatable, dimension(:) :: c_prime, y_prime, q, alpha ! intermediate values for solvers real :: Q_prime, beta ! intermediate values for solver @@ -597,8 +568,8 @@ subroutine tridiag_solver(a, b, c, h, y, method, x) allocate(y_prime(nrow)) allocate(q(nrow)) allocate(alpha(nrow)) - allocate(A_check(nrow,nrow)) - allocate(y_check(nrow)) +! allocate(A_check(nrow,nrow)) +! allocate(y_check(nrow)) if (method == 'TDMA_T') then ! Standard Thomas algoritim (4th variant). @@ -648,7 +619,7 @@ subroutine tridiag_solver(a, b, c, h, y, method, x) ! symmetric, diagonally dominant matrix, with h>0. ! Need to add a check for these conditions. do k=1,nrow-1 - if (abs(a(k+1)-c(k)) > 1.e-10) then + if (abs(a(k+1)-c(k)) > 1.e-10*(abs(a(k+1))+abs(c(k)))) then call MOM_error(WARNING, "tridiag_solver: matrix not symmetric; need symmetry when invoking TDMA_H") endif enddo @@ -671,8 +642,8 @@ subroutine tridiag_solver(a, b, c, h, y, method, x) Q_prime = beta*(h(k)+alpha(k-1)*Q_prime) enddo if ((h(nrow)+alpha(nrow-1)*Q_prime+alpha(nrow)) == 0.0)then - call MOM_error(WARNING, "Tridiag_solver: this system is not stable; overriding beta(nrow).") - beta = 1/(1e-15) ! place holder for unstable systems - delete later + call MOM_error(FATAL, "Tridiag_solver: this system is not stable.") ! ; overriding beta(nrow) + ! This has hard-coded dimensions: beta = 1/(1e-15) ! place holder for unstable systems - delete later else beta = 1/(h(nrow)+alpha(nrow-1)*Q_prime+alpha(nrow)) endif @@ -686,7 +657,8 @@ subroutine tridiag_solver(a, b, c, h, y, method, x) !print *, 'x=',x(1:nrow) endif - deallocate(c_prime,y_prime,q,alpha,A_check,y_check) + deallocate(c_prime,y_prime,q,alpha) +! deallocate(A_check,y_check) end subroutine tridiag_solver From 8e29a1b27b0c0e6c21c487bb54fe5cd5eea82902 Mon Sep 17 00:00:00 2001 From: "brandon.reichl" Date: Sat, 13 Oct 2018 21:03:41 -0400 Subject: [PATCH 0824/1072] Updates to use the new idealized_hurricane test case. - The new and old (SCM) idealized_hurricane test case capabilies are included. - This includes a redundant subroutine SCM_idealized_hurricane_wind_forcing, which has capabilities replaced by the new idealized_hurricane_wind_forcing, but will change model answers. When an answer change is deemed acceptable this code should be removed and a new test case should be made from the new (improved) code. --- .../solo_driver/MOM_surface_forcing.F90 | 7 +- .../MOM_state_initialization.F90 | 4 - ...CM_CVmix_tests.F90 => SCM_CVMix_tests.F90} | 26 +- src/user/SCM_idealized_hurricane.F90 | 259 ++++++++++++------ 4 files changed, 197 insertions(+), 99 deletions(-) rename src/user/{SCM_CVmix_tests.F90 => SCM_CVMix_tests.F90} (95%) diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 236032df16..9a7ed215c0 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -45,7 +45,7 @@ module MOM_surface_forcing use user_revise_forcing, only : user_alter_forcing, user_revise_forcing_init use user_revise_forcing, only : user_revise_forcing_CS use idealized_hurricane, only : idealized_hurricane_wind_init -use idealized_hurricane, only : idealized_hurricane_wind_forcing +use idealized_hurricane, only : idealized_hurricane_wind_forcing, SCM_idealized_hurricane_wind_forcing use idealized_hurricane, only : idealized_hurricane_CS use SCM_CVmix_tests, only : SCM_CVmix_tests_surface_forcing_init use SCM_CVmix_tests, only : SCM_CVmix_tests_wind_forcing @@ -277,6 +277,8 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call Neverland_wind_forcing(sfc_state, forces, day_center, G, CS%Neverland_forcing_CSp) elseif (trim(CS%wind_config) == "ideal_hurr") then call idealized_hurricane_wind_forcing(sfc_state, forces, day_center, G, CS%idealized_hurricane_CSp) + elseif (trim(CS%wind_config) == "SCM_ideal_hurr") then + call SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day_center, G, CS%idealized_hurricane_CSp) elseif (trim(CS%wind_config) == "SCM_CVmix_tests") then call SCM_CVmix_tests_wind_forcing(sfc_state, forces, day_center, G, CS%SCM_CVmix_tests_CSp) elseif (trim(CS%wind_config) == "USER") then @@ -1685,7 +1687,8 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) call MESO_surface_forcing_init(Time, G, param_file, diag, CS%MESO_forcing_CSp) elseif (trim(CS%wind_config) == "Neverland") then call Neverland_surface_forcing_init(Time, G, param_file, diag, CS%Neverland_forcing_CSp) - elseif (trim(CS%wind_config) == "ideal_hurr") then + elseif (trim(CS%wind_config) == "ideal_hurr" .or.& + trim(CS%wind_config) == "SCM_ideal_hurr") then call idealized_hurricane_wind_init(Time, G, param_file, CS%idealized_hurricane_CSp) elseif (trim(CS%wind_config) == "const") then call get_param(param_file, mdl, "CONST_WIND_TAUX", CS%tau_x0, & diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 3a603d75ad..4a52a4fb37 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -75,7 +75,6 @@ module MOM_state_initialization use Rossby_front_2d_initialization, only : Rossby_front_initialize_thickness use Rossby_front_2d_initialization, only : Rossby_front_initialize_temperature_salinity use Rossby_front_2d_initialization, only : Rossby_front_initialize_velocity -use idealized_hurricane, only : idealized_hurricane_TS_init use SCM_CVMix_tests, only: SCM_CVMix_tests_TS_init use dyed_channel_initialization, only : dyed_channel_set_OBC_tracer_data use dyed_obcs_initialization, only : dyed_obcs_set_OBC_data @@ -337,7 +336,6 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & " \t seamount - no motion test with seamount ICs. \n"//& " \t dumbbell - sloshing channel ICs. \n"//& " \t rossby_front - a mixed layer front in thermal wind balance.\n"//& - " \t SCM_ideal_hurr - used in the SCM idealized hurricane test.\n"//& " \t SCM_CVMix_tests - used in the SCM CVMix tests.\n"//& " \t USER - call a user modified routine.", & fail_if_missing=new_sim, do_not_log=just_read) @@ -369,8 +367,6 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & tv%S, h, G, GV, PF, eos, just_read_params=just_read) case ("rossby_front"); call Rossby_front_initialize_temperature_salinity ( tv%T, & tv%S, h, G, GV, PF, eos, just_read_params=just_read) - case ("SCM_ideal_hurr"); call idealized_hurricane_TS_init ( tv%T, & - tv%S, h, G, GV, PF, just_read_params=just_read) case ("SCM_CVMix_tests"); call SCM_CVMix_tests_TS_init (tv%T, & tv%S, h, G, GV, PF, just_read_params=just_read) case ("dense"); call dense_water_initialize_TS(G, GV, PF, eos, tv%T, tv%S, & diff --git a/src/user/SCM_CVmix_tests.F90 b/src/user/SCM_CVMix_tests.F90 similarity index 95% rename from src/user/SCM_CVmix_tests.F90 rename to src/user/SCM_CVMix_tests.F90 index fca5ffa1d2..681edfce74 100644 --- a/src/user/SCM_CVmix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -55,7 +55,6 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, param_file, just_read_params) logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: eta(SZK_(G)+1) ! The 1-d nominal positions of the interfaces. real :: UpperLayerTempMLD !< Upper layer Temp MLD thickness (m) real :: UpperLayerSaltMLD !< Upper layer Salt MLD thickness (m) real :: UpperLayerTemp !< Upper layer temperature (SST if thickness 0) (deg C) @@ -64,7 +63,8 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, param_file, just_read_params) real :: LowerLayerSalt !< Salt at top of lower layer (PPT) real :: LowerLayerdTdz !< Temp gradient in lower layer (deg C m^{-1}) real :: LowerLayerdSdz !< Salt gradient in lower layer (PPT m^{-1}) - real :: zC, DZ + real :: LowerLayerMinTemp !< Minimum temperature in lower layer + real :: zC, DZ, top, bottom logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz @@ -93,26 +93,22 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, param_file, just_read_params) call get_param(param_file, mdl,"SCM_L2_DSDZ",LowerLayerdSdZ, & 'Initial salinity stratification in layer 2', & units='PPT/m', default=0.00, do_not_log=just_read) + call get_param(param_file, mdl,"SCM_L2_MINTEMP",LowerLayerMinTemp, & + 'Layer 2 minimum temperature', units='C', default=4.0, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - eta(1) = 0. ! Reference to surface + top = 0. ! Reference to surface + bottom = 0. do k=1,nz - eta(K+1) = eta(K) - h(i,j,k)*GV%H_to_m ! Interface below layer (in m) - zC = 0.5*( eta(K) + eta(K+1) ) ! Z of middle of layer (in m) + bottom = bottom - h(i,j,k)*GV%H_to_m ! Interface below layer (in m) + zC = 0.5*( top + bottom ) ! Z of middle of layer (in m) DZ = min(0., zC + UpperLayerTempMLD) - if (DZ >= 0.0) then ! in Layer 1 - T(i,j,k) = UpperLayerTemp - else ! in Layer 2 - T(i,j,k) = LowerLayerTemp + LowerLayerdTdZ * DZ - endif + T(i,j,k) = max(LowerLayerMinTemp,LowerLayerTemp + LowerLayerdTdZ * DZ) DZ = min(0., zC + UpperLayerSaltMLD) - if (DZ >= 0.0) then ! in Layer 1 - S(i,j,k) = UpperLayerSalt - else ! in Layer 2 - S(i,j,k) = LowerLayerSalt + LowerLayerdSdZ * DZ - endif + S(i,j,k) = LowerLayerSalt + LowerLayerdSdZ * DZ + top = bottom enddo ! k enddo ; enddo diff --git a/src/user/SCM_idealized_hurricane.F90 b/src/user/SCM_idealized_hurricane.F90 index 62ff880d3c..6646449171 100644 --- a/src/user/SCM_idealized_hurricane.F90 +++ b/src/user/SCM_idealized_hurricane.F90 @@ -1,7 +1,9 @@ !> Initial conditions and forcing for the idealized hurricane example. module Idealized_hurricane -! Renamed from SCM_idealized_hurricane to idealizeD_hurricane +! Renamed from SCM_idealized_hurricane to idealized_hurricane ! This module is no longer exclusively for use in SCM mode. +! Legacy code that can be deleted is at the bottom. +! The T/S initializations have been removed. ! This file is part of MOM6. See LICENSE.md for the license. @@ -19,14 +21,12 @@ module Idealized_hurricane #include -public idealized_hurricane_TS_init !Public interface to initialize TS as vertically - ! uniform with prescribed vertical for hurricane - ! experiments. Used for other idealized - ! configurations. public idealized_hurricane_wind_init !Public interface to intialize the idealized ! hurricane wind profile. public idealized_hurricane_wind_forcing !Public interface to update the idealized ! hurricane wind profile. +public SCM_idealized_hurricane_wind_forcing !Public interface to the legacy idealized + ! hurricane wind profile for SCM. !> Container for parameters describing idealized wind structure type, public :: idealized_hurricane_CS ; private @@ -76,77 +76,6 @@ module Idealized_hurricane contains -!> Initializes temperature and salinity for the idealized hurricane example -subroutine idealized_hurricane_TS_init(T, S, h, G, GV, param_file, just_read_params) - type(ocean_grid_type), & - intent(in) :: G !< Grid structure - type(verticalGrid_type), & - intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & - intent(out) :: T !< Potential temperature (degC) - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & - intent(out) :: S !< Salinity (psu) - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & - intent(in) :: h !< Layer thickness in H (m or Pa) - type(param_file_type), & - intent(in) :: param_file !< Input parameter structure - logical, optional, & - intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. - ! Local variables - real :: top ! The 1-d nominal positions of the upper interface. - real :: bot ! The 1-d nominal positions of the lower interface. - real :: S_ref, SST_ref, dTdZ, MLD - real :: zC - logical :: just_read ! If true, just read parameters but set nothing. - integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz - real :: Tbot - - Tbot = 4.0 - - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - - just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - - if (.not.just_read) call log_version(param_file, mdl, version) - call get_param(param_file, mdl,"SALT_REF",S_ref, & - 'Reference salinity', units='1e-3',default=35.0, & - do_not_log=just_read) - call get_param(param_file, mdl,"TEMP_REF",SST_ref, & - 'Reference surface temperature', units='C', & - fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl,"INTERIOR_DTDZ",dTdZ, & - 'Initial temperature stratification below mixed layer', & - units='C/m', fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl,"REF_LAYER_DEPTH",MLD, & - 'Initial mixed layer depth', units='m', & - fail_if_missing=.not.just_read, do_not_log=just_read) - - if (just_read) return ! All run-time parameters have been read, so return. - - T(:,:,:) = 0.0 - S(:,:,:) = 0.0 - - do j=jsd,jed - do i=isd,ied - top = 0. - bot = 0. - do k=1,nz - ! Compute next interface - bot = bot - h(i,j,k)*GV%H_to_m - ! Depth of middle of layer - zC = 0.5*( top + bot ) - ! Compute Temperature and Salinity based on decay rates - T(i,j,k) = max(Tbot,SST_ref + dTdz * min(0., zC + MLD)) - S(i,j,k) = S_ref - top = bot - enddo ! k - enddo - enddo - -end subroutine idealized_hurricane_TS_init - !> Initializes wind profile for the SCM idealized hurricane example subroutine idealized_hurricane_wind_init(Time, G, param_file, CS) type(time_type), & @@ -304,6 +233,7 @@ subroutine idealized_hurricane_wind_forcing(state, forces, day, G, CS) YC = CS%Hurr_cen_Y0 + (time_type_to_real(day)*CS%hurr_translation_spd*& sin(CS%hurr_translation_dir)) + if (CS%BR_Bench) then ! f reset to value used in generated wind for benchmark test fbench = 5.5659e-05 @@ -323,7 +253,7 @@ subroutine idealized_hurricane_wind_forcing(state, forces, day, G, CS) + fbench ! Calculate position as a function of time. if (CS%SCM_mode) then - YY = YC + YY = YC + CS%dy_from_center XX = XC else LAT = G%geoLatCu(I,j)*1000. !KM_to_m @@ -346,7 +276,7 @@ subroutine idealized_hurricane_wind_forcing(state, forces, day, G, CS) + fbench ! Calculate position as a function of time. if (CS%SCM_mode) then - YY = YC + YY = YC + CS%dy_from_center XX = XC else LAT = G%geoLatCv(i,J)*1000. !KM_to_m @@ -443,6 +373,7 @@ subroutine idealized_hurricane_wind_profile(CS,absf,YY,XX,UOCN,VOCN,Tx,Ty) (radius/CS%rad_max_wind .lt. 15.) ) then radius10 = CS%rad_max_wind*10. + if (CS%BR_Bench) then radius_km = radius10/1000. else @@ -499,4 +430,176 @@ subroutine idealized_hurricane_wind_profile(CS,absf,YY,XX,UOCN,VOCN,Tx,Ty) return end subroutine idealized_hurricane_wind_profile +!> This subroutine is primarily needed as a legacy for reproducing answers. +!! It is included as an additional subroutine rather than padded into the previous +!! routine with flags to ease its eventual removal. Its functionality is replaced +!! with the new routines and it can be deleted when answer changes are acceptable. +subroutine SCM_idealized_hurricane_wind_forcing(state, forces, day, G, CS) + type(surface), intent(in) :: state !< Surface state structure + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + type(time_type), intent(in) :: day !< Time in days + type(ocean_grid_type), intent(inout) :: G !< Grid structure + type(idealized_hurricane_CS), pointer :: CS !< Container for SCM parameters + ! Local variables + integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + real :: pie, Deg2Rad + real :: U10, A, B, C, r, f, du10, rkm ! For wind profile expression + real :: xx, t0 !for location + real :: dp, rB + real :: Cd ! Air-sea drag coefficient + real :: Uocn, Vocn ! Surface ocean velocity components + real :: dU, dV ! Air-sea differential motion + !Wind angle variables + real :: Alph,Rstr, A0, A1, P1, Adir, transdir, V_TS, U_TS + logical :: BR_Bench + ! Bounds for loops and memory allocation + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + ! Allocate the forcing arrays, if necessary. + + call allocate_mech_forcing(G, forces, stress=.true., ustar=.true.) + pie = 4.0*atan(1.0) ; Deg2Rad = pie/180. + !/ BR + ! Implementing Holland (1980) parameteric wind profile + !------------------------------------------------------| + BR_Bench = .true. !true if comparing to LES runs | + t0 = 129600. !TC 'eye' crosses (0,0) at 36 hours| + transdir = pie !translation direction (-x) | + !------------------------------------------------------| + dp = CS%pressure_ambient - CS%pressure_central + C = CS%max_windspeed / sqrt( DP ) + B = C**2 * CS%rho_a * exp(1.0) + if (BR_Bench) then + ! rho_a reset to value used in generated wind for benchmark test + B = C**2 * 1.2 * exp(1.0) + endif + A = (CS%rad_max_wind/1000.)**B + f =G%CoriolisBu(is,js) ! f=f(x,y) but in the SCM is constant + if (BR_Bench) then + ! f reset to value used in generated wind for benchmark test + f = 5.5659e-05 + endif + !/ BR + ! Calculate x position as a function of time. + xx = ( t0 - time_type_to_real(day)) * CS%hurr_translation_spd * cos(transdir) + r = sqrt(xx**2.+CS%DY_from_center**2.) + !/ BR + ! rkm - r converted to km for Holland prof. + ! used in km due to error, correct implementation should + ! not need rkm, but to match winds w/ experiment this must + ! be maintained. Causes winds far from storm center to be a + ! couple of m/s higher than the correct Holland prof. + if (BR_Bench) then + rkm = r/1000. + rB = (rkm)**B + else + ! if not comparing to benchmark, then use correct Holland prof. + rkm = r + rB = r**B + endif + !/ BR + ! Calculate U10 in the interior (inside of 10x radius of maximum wind), + ! while adjusting U10 to 0 outside of 12x radius of maximum wind. + ! Note that rho_a is set to 1.2 following generated wind for experiment + if (r/CS%rad_max_wind > 0.001 .AND. r/CS%rad_max_wind < 10.) then + U10 = sqrt( A*B*dp*exp(-A/rB)/(1.2*rB) + 0.25*(rkm*f)**2 ) - 0.5*rkm*f + elseif (r/CS%rad_max_wind > 10. .AND. r/CS%rad_max_wind < 12.) then + r=CS%rad_max_wind*10. + if (BR_Bench) then + rkm = r/1000. + rB=rkm**B + else + rkm = r + rB = r**B + endif + U10 = ( sqrt( A*B*dp*exp(-A/rB)/(1.2*rB) + 0.25*(rkm*f)**2 ) - 0.5*rkm*f) & + * (12. - r/CS%rad_max_wind)/2. + else + U10 = 0. + endif + Adir = atan2(CS%DY_from_center,xx) + + !/ BR + ! Wind angle model following Zhang and Ulhorn (2012) + ! ALPH is inflow angle positive outward. + RSTR = min(10.,r / CS%rad_max_wind) + A0 = -0.9*RSTR -0.09*CS%max_windspeed - 14.33 + A1 = -A0 *(0.04*RSTR +0.05*CS%hurr_translation_spd+0.14) + P1 = (6.88*RSTR -9.60*CS%hurr_translation_spd+85.31)*pie/180. + ALPH = A0 - A1*cos( (TRANSDIR - ADIR ) - P1) + if (r/CS%rad_max_wind > 10. .AND. r/CS%rad_max_wind < 12.) then + ALPH = ALPH* (12. - r/CS%rad_max_wind)/2. + elseif (r/CS%rad_max_wind > 12.) then + ALPH = 0.0 + endif + ALPH = ALPH * Deg2Rad + !/BR + ! Prepare for wind calculation + ! X_TS is component of translation speed added to wind vector + ! due to background steering wind. + U_TS = CS%hurr_translation_spd/2.*cos(transdir) + V_TS = CS%hurr_translation_spd/2.*sin(transdir) + + ! Set the surface wind stresses, in units of Pa. A positive taux + ! accelerates the ocean to the (pseudo-)east. + ! The i-loop extends to is-1 so that taux can be used later in the + ! calculation of ustar - otherwise the lower bound would be Isq. + do j=js,je ; do I=is-1,Ieq + !/BR + ! Turn off surface current for stress calculation to be + ! consistent with test case. + Uocn = 0.!state%u(I,j) + Vocn = 0.!0.25*( (state%v(i,J) + state%v(i+1,J-1)) & + ! +(state%v(i+1,J) + state%v(i,J-1)) ) + !/BR + ! Wind vector calculated from location/direction (sin/cos flipped b/c + ! cyclonic wind is 90 deg. phase shifted from position angle). + dU = U10*sin(Adir-pie-Alph) - Uocn + U_TS + dV = U10*cos(Adir-Alph) - Vocn + V_TS + !/----------------------------------------------------| + !BR + ! Add a simple drag coefficient as a function of U10 | + !/----------------------------------------------------| + du10=sqrt(du**2+dv**2) + if (du10 < 11.) then + Cd = 1.2e-3 + elseif (du10 < 20.) then + Cd = (0.49 + 0.065 * U10 )*0.001 + else + Cd = 0.0018 + endif + forces%taux(I,j) = CS%rho_a * G%mask2dCu(I,j) * Cd*sqrt(du**2+dV**2)*dU + enddo ; enddo + !/BR + ! See notes above + do J=js-1,Jeq ; do i=is,ie + Uocn = 0.!0.25*( (state%u(I,j) + state%u(I-1,j+1)) & + ! +(state%u(I-1,j) + state%u(I,j+1)) ) + Vocn = 0.!state%v(i,J) + dU = U10*sin(Adir-pie-Alph) - Uocn + U_TS + dV = U10*cos(Adir-Alph) - Vocn + V_TS + du10=sqrt(du**2+dv**2) + if (du10 < 11.) then + Cd = 1.2e-3 + elseif (du10 < 20.) then + Cd = (0.49 + 0.065 * U10 )*0.001 + else + Cd = 0.0018 + endif + forces%tauy(I,j) = CS%rho_a * G%mask2dCv(I,j) * Cd*du10*dV + enddo ; enddo + ! Set the surface friction velocity, in units of m s-1. ustar is always positive. + do j=js,je ; do i=is,ie + ! This expression can be changed if desired, but need not be. + forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(CS%gustiness/CS%Rho0 + & + sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & + 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) + enddo ; enddo + return +end subroutine SCM_idealized_hurricane_wind_forcing + end module idealized_hurricane From 05359f0502af60083c6131b5ab9bfe40d06fbe89 Mon Sep 17 00:00:00 2001 From: "brandon.reichl" Date: Sat, 13 Oct 2018 21:07:22 -0400 Subject: [PATCH 0825/1072] Renaming SCM_idealized_hurricane.F90 to Idealized_Hurricane.F90 --- src/user/{SCM_idealized_hurricane.F90 => Idealized_Hurricane.F90} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/user/{SCM_idealized_hurricane.F90 => Idealized_Hurricane.F90} (100%) diff --git a/src/user/SCM_idealized_hurricane.F90 b/src/user/Idealized_Hurricane.F90 similarity index 100% rename from src/user/SCM_idealized_hurricane.F90 rename to src/user/Idealized_Hurricane.F90 From 654485eac749254690a686137ac4cc959ceeac5d Mon Sep 17 00:00:00 2001 From: "brandon.reichl" Date: Sat, 13 Oct 2018 21:15:19 -0400 Subject: [PATCH 0826/1072] Updates to idealized hurricane code style. --- src/user/Idealized_Hurricane.F90 | 30 +++++++++++++++++++++--------- 1 file changed, 21 insertions(+), 9 deletions(-) diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90 index 6646449171..ca495882b6 100644 --- a/src/user/Idealized_Hurricane.F90 +++ b/src/user/Idealized_Hurricane.F90 @@ -1,12 +1,24 @@ -!> Initial conditions and forcing for the idealized hurricane example. +!> Forcing for the idealized hurricane and SCM_idealized_hurricane examples. module Idealized_hurricane -! Renamed from SCM_idealized_hurricane to idealized_hurricane -! This module is no longer exclusively for use in SCM mode. -! Legacy code that can be deleted is at the bottom. -! The T/S initializations have been removed. ! This file is part of MOM6. See LICENSE.md for the license. +! History +!-------- +! November 2014: Origination. +! October 2018: Renamed module from SCM_idealized_hurricane to idealized_hurricane +! This module is no longer exclusively for use in SCM mode. +! Legacy code that can be deleted is at the bottom (currently maintained +! only to preserve exact answers in SCM mode). +! The T/S initializations have been removed since they are redundant +! w/ T/S initializations in CVMix_tests (which should be moved +! into the main state_initialization to their utility +! for multiple example cases).. +! To do +! 1. Remove the legacy SCM_idealized_hurricane_wind_forcing code +! 2. Make the hurricane-to-background wind transition a runtime parameter +! + use MOM_error_handler, only : MOM_error, FATAL use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_forcing_type, only : forcing, mech_forcing @@ -64,8 +76,8 @@ module Idealized_hurricane real :: DY_from_center !< (Fixed) distance in y from storm center path [m] ! Par - real :: PI - real :: Deg2Rad + real :: PI !< Mathematical constant + real :: Deg2Rad !< Mathematical constant end type @@ -430,9 +442,9 @@ subroutine idealized_hurricane_wind_profile(CS,absf,YY,XX,UOCN,VOCN,Tx,Ty) return end subroutine idealized_hurricane_wind_profile -!> This subroutine is primarily needed as a legacy for reproducing answers. +!> This subroutine is primarily needed as a legacy for reproducing answers. !! It is included as an additional subroutine rather than padded into the previous -!! routine with flags to ease its eventual removal. Its functionality is replaced +!! routine with flags to ease its eventual removal. Its functionality is replaced !! with the new routines and it can be deleted when answer changes are acceptable. subroutine SCM_idealized_hurricane_wind_forcing(state, forces, day, G, CS) type(surface), intent(in) :: state !< Surface state structure From 9b0af26e82bcef1c9959368740cfdd7096ece64e Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 15 Oct 2018 08:44:51 -0600 Subject: [PATCH 0827/1072] Adds meltw and melth into fluxes --- src/core/MOM_forcing_type.F90 | 72 ++++++++++++++++++++++++++--------- 1 file changed, 53 insertions(+), 19 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index b6a1f069c6..0d708a0e36 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -82,7 +82,7 @@ module MOM_forcing_type vprec => NULL(), & !< virtual liquid precip associated w/ SSS restoring ( kg/(m^2 s) ) lrunoff => NULL(), & !< liquid river runoff entering ocean ( kg/(m^2 s) ) frunoff => NULL(), & !< frozen river runoff (calving) entering ocean ( kg/(m^2 s) ) - seaice_melt => NULL(), & !< seaice melt (positive) or formation (negative) ( kg/(m^2 s) ) + meltw => NULL(), & !< snow/seaice melt (positive) or formation (negative) ( kg/(m^2 s) ) netMassIn => NULL(), & !< Sum of water mass flux out of the ocean ( kg/(m^2 s) ) netMassOut => NULL(), & !< Net water mass flux into of the ocean ( kg/(m^2 s) ) netSalt => NULL() !< Net salt entering the ocean @@ -234,7 +234,7 @@ module MOM_forcing_type integer :: id_lrunoff = -1, id_frunoff = -1 integer :: id_net_massout = -1, id_net_massin = -1 integer :: id_massout_flux = -1, id_massin_flux = -1 - integer :: id_seaice_melt = -1 + integer :: id_meltw = -1 ! global area integrated mass flux diagnostic handles integer :: id_total_prcme = -1, id_total_evap = -1 @@ -242,7 +242,7 @@ module MOM_forcing_type integer :: id_total_lprec = -1, id_total_fprec = -1 integer :: id_total_lrunoff = -1, id_total_frunoff = -1 integer :: id_total_net_massout = -1, id_total_net_massin = -1 - integer :: id_total_seaice_melt = -1 + integer :: id_total_meltw = -1 ! global area averaged mass flux diagnostic handles integer :: id_prcme_ga = -1, id_evap_ga = -1 @@ -275,6 +275,7 @@ module MOM_forcing_type integer :: id_total_heat_content_cond = -1, id_total_heat_content_surfwater= -1 integer :: id_total_heat_content_vprec = -1, id_total_heat_content_massout = -1 integer :: id_total_heat_added = -1, id_total_heat_content_massin = -1 + integer :: id_total_melth = -1 ! global area averaged heat flux diagnostic handles integer :: id_net_heat_coupler_ga = -1, id_net_heat_surface_ga = -1 @@ -493,7 +494,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, + fluxes%evap(i,j) ) & + fluxes%lrunoff(i,j) ) & + fluxes%vprec(i,j) ) & - + fluxes%seaice_melt(i,j)) & + + fluxes%meltw(i,j) ) & + fluxes%frunoff(i,j) )) if (do_NMIOr) then ! Repeat the above code w/ dt=1s for legacy reasons @@ -502,7 +503,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, + fluxes%evap(i,j) ) & + fluxes%lrunoff(i,j) ) & + fluxes%vprec(i,j) ) & - + fluxes%seaice_melt(i,j)) & + + fluxes%meltw(i,j) ) & + fluxes%frunoff(i,j) )) endif @@ -534,6 +535,11 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, netMassOut(i) = netMassOut(i) + fluxes%lprec(i,j) endif + ! meltw < 0 means sea ice formation taking water from the ocean. + if (fluxes%meltw(i,j) < 0.0) then + netMassOut(i) = netMassOut(i) + fluxes%meltw(i,j) + endif + ! vprec < 0 means virtual evaporation arising from surface salinity restoring, ! in which case heat_content_vprec is computed in MOM_diabatic_driver.F90. if (fluxes%vprec(i,j) < 0.0) then @@ -549,7 +555,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! surface heat fluxes from radiation and turbulent fluxes (K * H) ! (H=m for Bouss, H=kg/m2 for non-Bouss) - ! CIME provides heat flux from snow&ice melt (melth), so this should be added here + ! CIME provides heat flux from snow&ice melt (melth), so this is added below if (associated(fluxes%melth)) then net_heat(i) = scale * dt * J_m2_to_H * & ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j) + & @@ -1005,8 +1011,10 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, haloshift) call hchksum(fluxes%fprec, mesg//" fluxes%fprec",G%HI,haloshift=hshift) if (associated(fluxes%vprec)) & call hchksum(fluxes%vprec, mesg//" fluxes%vprec",G%HI,haloshift=hshift) - if (associated(fluxes%seaice_melt)) & - call hchksum(fluxes%seaice_melt, mesg//" fluxes%seaice_melt",G%HI,haloshift=hshift) + if (associated(fluxes%meltw)) & + call hchksum(fluxes%meltw, mesg//" fluxes%meltw",G%HI,haloshift=hshift) + if (associated(fluxes%melth)) & + call hchksum(fluxes%melth, mesg//" fluxes%melth",G%HI,haloshift=hshift) if (associated(fluxes%p_surf)) & call hchksum(fluxes%p_surf, mesg//" fluxes%p_surf",G%HI,haloshift=hshift) if (associated(fluxes%salt_flux)) & @@ -1111,7 +1119,8 @@ subroutine forcing_SinglePointPrint(fluxes, G, i, j, mesg) call locMsg(fluxes%lprec,'lprec') call locMsg(fluxes%fprec,'fprec') call locMsg(fluxes%vprec,'vprec') - call locMsg(fluxes%seaice_melt,'seaice_melt') + call locMsg(fluxes%meltw,'meltw') + call locMsg(fluxes%melth,'melth') call locMsg(fluxes%p_surf,'p_surf') call locMsg(fluxes%salt_flux,'salt_flux') call locMsg(fluxes%TKE_tidal,'TKE_tidal') @@ -1219,8 +1228,9 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use ! smg: seaice_melt field requires updates to the sea ice model ! gmm: MCT provides this field - handles%id_seaice_melt = register_diag_field('ocean_model', 'seaice_melt', & - diag%axesT1, Time, 'water flux to ocean from sea ice melt(> 0) or form(< 0)', & + ! TODO: confirm cmor field name + handles%id_meltw = register_diag_field('ocean_model', 'meltw', & + diag%axesT1, Time, 'water flux to ocean from snow/sea ice melt(> 0) or form(< 0)', & 'kg m-2 s-1', & standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics', & cmor_field_name='fsitherm', & @@ -1288,7 +1298,8 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use ! seaice_melt field requires updates to the sea ice model ! gmm: MCT provides this field - handles%id_total_seaice_melt = register_scalar_field('ocean_model', 'total_seaice_melt', Time, diag, & + ! TODO: confirm cmor field name + handles%id_total_meltw = register_scalar_field('ocean_model', 'total_meltw', Time, diag, & long_name='Area integrated sea ice melt (>0) or form (<0)', units='kg s-1', & standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics_area_integrated', & cmor_field_name='total_fsitherm', & @@ -1430,7 +1441,7 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use Time,'Surface ocean heat flux from SW+LW+lat+sens+mass transfer+frazil+restore+melth or flux adjustments', 'W m-2',& standard_name='surface_downward_heat_flux_in_sea_water', cmor_field_name='hfds', & cmor_standard_name='surface_downward_heat_flux_in_sea_water', & - cmor_long_name='Surface ocean heat flux from SW+LW+latent+sensible+masstransfer+frazil') + cmor_long_name='Surface ocean heat flux from SW+LW+latent+sensible+masstransfer+frazil+melth') handles%id_sw = register_diag_field('ocean_model', 'SW', diag%axesT1, Time, & 'Shortwave radiation flux into ocean', 'W m-2', & @@ -1486,7 +1497,7 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use handles%id_melth = register_diag_field('ocean_model', 'melth', diag%axesT1, Time,& 'Heat flux into ocean from snow and sea ice melt', 'W m-2', & standard_name='snow_ice_melt_heat_flux', & - !GMM? cmor_field_name='hfsso', & + !GMM TODO cmor_field_name='hfsso', & cmor_standard_name='snow_ice_melt_heat_flux', & cmor_long_name='Heat flux into ocean from snow and sea ice melt') @@ -1641,6 +1652,10 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use long_name='Area integrated surface heat flux from restoring and/or flux adjustment', & units='W') + handles%id_total_melth = register_scalar_field('ocean_model',& + 'total_melth', Time, diag, & + long_name='Area integrated surface heat flux from snow and sea ice melt', & + units='W') !=============================================================== ! area averaged surface heat fluxes @@ -1816,7 +1831,7 @@ subroutine forcing_accumulate(flux_tmp, forces, fluxes, dt, G, wt2) fluxes%vprec(i,j) = wt1*fluxes%vprec(i,j) + wt2*flux_tmp%vprec(i,j) fluxes%lrunoff(i,j) = wt1*fluxes%lrunoff(i,j) + wt2*flux_tmp%lrunoff(i,j) fluxes%frunoff(i,j) = wt1*fluxes%frunoff(i,j) + wt2*flux_tmp%frunoff(i,j) - fluxes%seaice_melt(i,j) = wt1*fluxes%seaice_melt(i,j) + wt2*flux_tmp%seaice_melt(i,j) + fluxes%meltw(i,j) = wt1*fluxes%meltw(i,j) + wt2*flux_tmp%meltw(i,j) fluxes%sw(i,j) = wt1*fluxes%sw(i,j) + wt2*flux_tmp%sw(i,j) fluxes%sw_vis_dir(i,j) = wt1*fluxes%sw_vis_dir(i,j) + wt2*flux_tmp%sw_vis_dir(i,j) fluxes%sw_vis_dif(i,j) = wt1*fluxes%sw_vis_dif(i,j) + wt2*flux_tmp%sw_vis_dif(i,j) @@ -1971,7 +1986,7 @@ subroutine set_derived_forcing_fields(forces, fluxes, G, Rho0) end subroutine set_derived_forcing_fields -!> This subroutine calculates determines the net mass source to th eocean from +!> This subroutine calculates determines the net mass source to th ocean from !! a (thermodynamic) forcing type and stores it in a mech_forcing type. subroutine set_net_mass_forcing(fluxes, forces, G) type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields @@ -2001,6 +2016,9 @@ subroutine set_net_mass_forcing(fluxes, forces, G) if (associated(fluxes%evap)) then ; do j=js,je ; do i=is,ie forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%evap(i,j) enddo ; enddo ; endif + if (associated(fluxes%meltw)) then ; do j=js,je ; do i=is,ie + forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%meltw(i,j) + enddo ; enddo ; endif endif end subroutine set_net_mass_forcing @@ -2105,6 +2123,8 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%lrunoff)) res(i,j) = res(i,j)+fluxes%lrunoff(i,j) if (associated(fluxes%frunoff)) res(i,j) = res(i,j)+fluxes%frunoff(i,j) if (associated(fluxes%vprec)) res(i,j) = res(i,j)+fluxes%vprec(i,j) + ! GMM, not sure if meltw is needed here. If so, the name prcme is misleading. + if (associated(fluxes%meltw)) res(i,j) = res(i,j)+fluxes%meltw(i,j) enddo ; enddo call post_data(handles%id_prcme, res, diag) if (handles%id_total_prcme > 0) then @@ -2123,6 +2143,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (fluxes%lprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%lprec(i,j) if (fluxes%vprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%vprec(i,j) if (fluxes%evap(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) + if (fluxes%meltw(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%meltw(i,j) enddo ; enddo call post_data(handles%id_net_massout, res, diag) if (handles%id_total_net_massout > 0) then @@ -2140,6 +2161,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (fluxes%vprec(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%vprec(i,j) ! fluxes%cond is not needed because it is derived from %evap > 0 if (fluxes%evap(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) + if (fluxes%meltw(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%meltw(i,j) enddo ; enddo call post_data(handles%id_net_massin, res, diag) if (handles%id_total_net_massin > 0) then @@ -2228,6 +2250,14 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) endif endif + if (associated(fluxes%meltw)) then + if (handles%id_meltw > 0) call post_data(handles%id_meltw, fluxes%meltw, diag) + if (handles%id_total_meltw > 0) then + total_transport = global_area_integral(fluxes%meltw,G) + call post_data(handles%id_total_meltw, total_transport, diag) + endif + endif + ! post diagnostics for boundary heat fluxes ==================================== if ((handles%id_heat_content_lrunoff > 0) .and. associated(fluxes%heat_content_lrunoff)) & @@ -2487,6 +2517,11 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) call post_data(handles%id_melth, fluxes%melth, diag) endif + if ((handles%id_total_melth > 0) .and. associated(fluxes%melth)) then + total_transport = global_area_integral(fluxes%melth,G) + call post_data(handles%id_total_melth, total_transport, diag) + endif + if ((handles%id_total_sens > 0) .and. associated(fluxes%sens)) then total_transport = global_area_integral(fluxes%sens,G) call post_data(handles%id_total_sens, total_transport, diag) @@ -2589,11 +2624,10 @@ subroutine allocate_forcing_type(G, fluxes, water, heat, ustar, press, shelf, ic call myAlloc(fluxes%vprec,isd,ied,jsd,jed, water) call myAlloc(fluxes%lrunoff,isd,ied,jsd,jed, water) call myAlloc(fluxes%frunoff,isd,ied,jsd,jed, water) - call myAlloc(fluxes%seaice_melt,isd,ied,jsd,jed, water) + call myAlloc(fluxes%meltw,isd,ied,jsd,jed, water) call myAlloc(fluxes%netMassOut,isd,ied,jsd,jed, water) call myAlloc(fluxes%netMassIn,isd,ied,jsd,jed, water) call myAlloc(fluxes%netSalt,isd,ied,jsd,jed, water) - call myAlloc(fluxes%melth,isd,ied,jsd,jed, heat) call myAlloc(fluxes%sw,isd,ied,jsd,jed, heat) call myAlloc(fluxes%lw,isd,ied,jsd,jed, heat) @@ -2714,7 +2748,7 @@ subroutine deallocate_forcing_type(fluxes) if (associated(fluxes%vprec)) deallocate(fluxes%vprec) if (associated(fluxes%lrunoff)) deallocate(fluxes%lrunoff) if (associated(fluxes%frunoff)) deallocate(fluxes%frunoff) - if (associated(fluxes%seaice_melt)) deallocate(fluxes%seaice_melt) + if (associated(fluxes%meltw)) deallocate(fluxes%meltw) if (associated(fluxes%salt_flux)) deallocate(fluxes%salt_flux) if (associated(fluxes%p_surf_full)) deallocate(fluxes%p_surf_full) if (associated(fluxes%p_surf)) deallocate(fluxes%p_surf) From 6acc499e689efcf9efdc078e1b0ec53bb3990721 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 15 Oct 2018 10:44:27 -0600 Subject: [PATCH 0828/1072] Ignores volume flux of sea ice via reverse engineering --- config_src/mct_driver/MOM_surface_forcing.F90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 0d45409925..509907dd41 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -489,9 +489,12 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & ! 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 - 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) + ! GMM: as stated above, the following is wrong. CIME deals with volume/mass and + ! heat from sea ice/snow via meltw and melth, 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 From 2dd042a5c6c19ce41fc0884782e9ada733495a03 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Mon, 15 Oct 2018 17:30:54 -0400 Subject: [PATCH 0829/1072] Diag decimation prototype, first attemp at general algorithm - According to Alistair, the decimation method could be solely deduced from the axes%x_cell_method, axes%y_cell_method and probably the area_cell_method at the time of send_data - This is the summary of the algoritm f(Id,Jd) = \sum_{i,j} f(Id+i,Jd+j) * weight(Id+i,Jd+j) / [ \sum_{i,j} weight(Id+i,Jd+j)] Id,Jd are the decimated (coarse grid) indices run over the coarsened compute grid, i and j run from 0 to dl-1 (dl being the decimation level) if and jf weight(if,jf) run over the original fine computre grid x_cell_method y_cell_method area_cell_method weight(if,jf) example --------------------------------------------------------------------- ------------- mean mean mean A(if,jf)*h(if,jf) theta point mean mean dy(if,jf)*h(if,jf) u mean point mean dx(if,jf)*h(if,jf) v mean mean sum A(if,jf) h*theta sum sum sum 1 volcello point sum sum 1 umo --- src/framework/MOM_diag_mediator.F90 | 318 ++++++++++++++++++---------- 1 file changed, 201 insertions(+), 117 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 02033958f0..bed00b2355 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -3434,8 +3434,6 @@ subroutine decimate_diag_indices_get(f1,f2, dl, diag_cs,isv,iev,jsv,jev) endif end subroutine decimate_diag_indices_get - - subroutine decimate_diag_field_3d(locfield, locfield_decim, dl, diag_cs, diag,isv,iev,jsv,jev, mask) real, dimension(:,:,:), pointer :: locfield @@ -3446,20 +3444,46 @@ subroutine decimate_diag_field_3d(locfield, locfield_decim, dl, diag_cs, diag,is integer, intent(out):: isv,iev,jsv,jev real, optional,target, intent(in) :: mask(:,:,:) !< If present, use this real array as the data mask. !locals - real, dimension(:,:,:), pointer :: locmask => NULL() - integer :: isl,iel,jsl,jel + real, dimension(:,:,:), pointer :: locmask + integer :: isl,iel,jsl,jel, xy_method + + locmask => NULL() + !Get the correct indices corresponding to input field + !Shape of the input diag field isl=1; iel=size(locfield,1)/dl - jsl=1; jel=size(locfield,2)/dl + jsl=1; jel=size(locfield,2)/dl + !Get the shape of the decimated field isv,iev,jsv,jev call decimate_diag_indices_get(iel,jel, dl, diag_cs,isv,iev,jsv,jev) + !Set the non-decimated mask, it must be associated and initialized if (present(mask)) then locmask => mask - call decimate_field(locfield, locfield_decim, dl, method='pave', mask=locmask, area=diag_cs%G%areaT) elseif (associated(diag%axes%mask3d)) then - call decimate_field(locfield, locfield_decim, dl, method='pave', mask=diag%axes%mask3d, area=diag_cs%G%areaT) + locmask => diag%axes%mask3d else call MOM_error(FATAL, "decimate_diag_field_3d: Cannot decimate without a mask!!! ") endif + !Determine the decimation method + !Make a two digit integer case id = x_case*10+y_case where x_case and/or y_case is 1 for sum and 2 for mean + xy_method = 0 !subsample and pick the SW corner value + if (trim(diag%axes%y_cell_method)=='sum') then + xy_method = xy_method + 1 + elseif (trim(diag%axes%y_cell_method)=='mean') then + xy_method = xy_method + 2 + endif + if (trim(diag%axes%x_cell_method)=='sum') then + xy_method = xy_method + 10 + elseif (trim(diag%axes%x_cell_method)=='mean') then + xy_method = xy_method + 20 + endif +! if (trim(diag%axes%area_cell_method)=='sum') then +! xy_method = xy_method + 100 +! elseif (trim(diag%axes%area_cell_method)=='mean') then +! xy_method = xy_method + 200 +! endif + + call decimate_field(locfield, locfield_decim, dl, xy_method, locmask, diag_cs) + end subroutine decimate_diag_field_3d subroutine decimate_diag_field_2d(locfield, locfield_decim, dl, diag_cs, diag,isv,iev,jsv,jev, mask) @@ -3471,157 +3495,217 @@ subroutine decimate_diag_field_2d(locfield, locfield_decim, dl, diag_cs, diag,is integer, intent(out):: isv,iev,jsv,jev real, optional,target, intent(in) :: mask(:,:) !< If present, use this real array as the data mask. !locals - real, dimension(:,:), pointer :: locmask => NULL() - integer :: isl,iel,jsl,jel + real, dimension(:,:), pointer :: locmask + integer :: isl,iel,jsl,jel, xy_method + + locmask => NULL() + !Get the correct indices corresponding to input field + !Shape of the input diag field isl=1; iel=size(locfield,1)/dl - jsl=1; jel=size(locfield,2)/dl + jsl=1; jel=size(locfield,2)/dl + !Get the shape of the decimated field isv,iev,jsv,jev call decimate_diag_indices_get(iel,jel, dl, diag_cs,isv,iev,jsv,jev) + !Set the non-decimated mask, it must be associated and initialized if (present(mask)) then locmask => mask - call decimate_field(locfield, locfield_decim, dl, method='pave', mask=locmask) elseif (associated(diag%axes%mask2d)) then - call decimate_field(locfield, locfield_decim, dl, method='pave', mask=diag%axes%mask2d) + locmask => diag%axes%mask2d else call MOM_error(FATAL, "decimate_diag_field_2d: Cannot decimate without a mask!!! ") endif - + !Determine the decimation method + !Make a two digit integer case id = x_case*10+y_case where x_case and/or y_case is 1 for sum and 2 for mean + xy_method = 0 !subsample and pick the SW corner value + if (trim(diag%axes%y_cell_method)=='sum') then + xy_method = xy_method + 1 + elseif (trim(diag%axes%y_cell_method)=='mean') then + xy_method = xy_method + 2 + endif + if (trim(diag%axes%x_cell_method)=='sum') then + xy_method = xy_method + 10 + elseif (trim(diag%axes%x_cell_method)=='mean') then + xy_method = xy_method + 20 + endif +! if (trim(diag%axes%area_cell_method)=='sum') then +! xy_method = xy_method + 100 +! elseif (trim(diag%axes%area_cell_method)=='mean') then +! xy_method = xy_method + 200 +! endif + + call decimate_field(locfield, locfield_decim, dl, xy_method, locmask, diag_cs) + end subroutine decimate_diag_field_2d -subroutine decimate_field_3d(field_in, field_out, level, method, mask, area) +subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs) real, dimension(:,:,:) , pointer :: field_in real, dimension(:,:,:) , allocatable :: field_out - integer , intent(in) :: level - character(len=4), optional, intent(in) :: method !< sampling method, one of samp,pave,aave,vave - real, dimension(:,:,:), optional , pointer :: mask - real, dimension(:,:), optional , intent(in) :: area - !locals + integer , intent(in) :: dl + integer, optional, intent(in) :: method !< sampling method, one of 00,01,02,10,20,11,22 + real, dimension(:,:,:), pointer :: mask + type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output + !locals + character(len=240) :: mesg integer :: i,j,ii,jj,is,js,i0,j0 integer :: isl,iel,jsl,jel integer :: k,ks,ke - real :: ave,tot_non_zero,a1 - character(len=4) :: samplemethod - samplemethod = 'samp' - if(present(method)) samplemethod = method - + real :: ave,total_weight,weight + real :: epsilon = 1.0e-20 !Always start from the first element is=1 js=1 ks = lbound(field_in,3) ; ke = ubound(field_in,3) - isl=1; iel=size(field_in,1)/level - jsl=1; jel=size(field_in,2)/level - allocate(field_out(isl:iel,jsl:jel,ks:ke)) + isl=1; iel=size(field_in,1)/dl + jsl=1; jel=size(field_in,2)/dl + allocate(field_out(isl:iel,jsl:jel,ks:ke)) - - select case (samplemethod) - case ('samp') !subsample the SW corner cell + if(method .eq. 0) then !point average the fields in dl^2 cells do k= ks,ke ; do j=jsl,jel ; do i=isl,iel - i0 = is+level*(i-isl) - j0 = js+level*(j-jsl) - field_out(i,j,k) = field_in(i0,j0,k) + i0 = is+dl*(i-isl) + j0 = js+dl*(j-jsl) + ave = 0.0 + total_weight = 0.0 + do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 + total_weight = total_weight + mask(ii,jj,k) + ave=ave+field_in(ii,jj,k)*mask(ii,jj,k) + enddo; enddo + field_out(i,j,k) = ave/max(1.0,total_weight) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo - case ('pave') !point average of the cells - if(present(mask)) then - do k= ks,ke ; do j=jsl,jel ; do i=isl,iel - i0 = is+level*(i-isl) - j0 = js+level*(j-jsl) - ave = 0.0 - tot_non_zero = 0.0 - do ii=i0,i0+level-1 ; do jj=j0,j0+level-1 - tot_non_zero = tot_non_zero + mask(ii,jj,k) - ave=ave+field_in(ii,jj,k)*mask(ii,jj,k) - enddo; enddo - field_out(i,j,k) = ave/max(1.0,tot_non_zero) !Avoid zero mask at all aggregating cells where ave=0.0 - enddo; enddo; enddo - else - do k= ks,ke ; do j=jsl,jel ; do i=isl,iel - i0 = is+level*(i-isl) - j0 = js+level*(j-jsl) - ave = 0.0 - tot_non_zero = 0.0 - do ii=i0,i0+level-1 ; do jj=j0,j0+level-1 - tot_non_zero = tot_non_zero + 1 - ave=ave+field_in(ii,jj,k) - enddo; enddo - field_out(i,j,k) = ave/tot_non_zero - enddo; enddo; enddo - endif - case ('aave') !area average of the cells + elseif(method .eq. 1) then !point in x, sum in y + do k= ks,ke ; do j=jsl,jel ; do i=isl,iel + i0 = is+dl*(i-isl) + j0 = js+dl*(j-jsl) + ave = 0.0 + total_weight = 0.0 + ii=i0 + do jj=j0,j0+dl-1 + total_weight = total_weight + mask(ii,jj,k) + ave=ave+field_in(ii,jj,k)*mask(ii,jj,k) + enddo + field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo; enddo; enddo + elseif(method .eq. 10) then !sum in x, point in y + do k= ks,ke ; do j=jsl,jel ; do i=isl,iel + i0 = is+dl*(i-isl) + j0 = js+dl*(j-jsl) + ave = 0.0 + total_weight = 0.0 + jj=j0 + do ii=i0,i0+dl-1 + total_weight = total_weight + mask(ii,jj,k) + ave=ave+field_in(ii,jj,k)*mask(ii,jj,k) + enddo + field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo; enddo; enddo + elseif(method .eq. 2) then !point in x, normal area average in y do k= ks,ke ; do j=jsl,jel ; do i=isl,iel - field_out(i,j,k) = 0.0 - i0 = is+level*(i-isl) - j0 = js+level*(j-jsl) + i0 = is+dl*(i-isl) + j0 = js+dl*(j-jsl) ave = 0.0 - tot_non_zero = 0.0 - do ii=i0,i0+level-1 ; do jj=j0,j0+level-1 - a1 = area(ii,jj)*mask(ii,jj,k) - tot_non_zero = tot_non_zero + a1 - ave=ave + field_in(ii,jj,k) * a1 + total_weight = 0.0 + ii=i0 + do jj=j0,j0+dl-1 + weight =mask(ii,jj,k)*diag_cs%G%dyCu(ii,jj)*diag_cs%h(ii,jj,k) + total_weight = total_weight +weight + ave=ave+field_in(ii,jj,k)*weight + enddo + field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo; enddo; enddo + elseif(method .eq. 20) then !normal area average in x, point in y + do k= ks,ke ; do j=jsl,jel ; do i=isl,iel + i0 = is+dl*(i-isl) + j0 = js+dl*(j-jsl) + ave = 0.0 + total_weight = 0.0 + jj=j0 + do ii=i0,i0+dl-1 + weight = mask(ii,jj,k)*diag_cs%G%dxCv(ii,jj)*diag_cs%h(ii,jj,k) + total_weight = total_weight + weight + ave=ave+field_in(ii,jj,k)*weight + enddo + field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo; enddo; enddo + elseif(method .eq. 22) then !Volume average the fields in x and y + do k= ks,ke ; do j=jsl,jel ; do i=isl,iel + i0 = is+dl*(i-isl) + j0 = js+dl*(j-jsl) + ave = 0.0 + total_weight = 0.0 + do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 + weight = mask(ii,jj,k)*diag_cs%G%areaT(ii,jj)*diag_cs%h(ii,jj,k) + total_weight = total_weight + weight + ave=ave+field_in(ii,jj,k)*weight enddo; enddo - if(tot_non_zero .gt. 0.0) field_out(i,j,k) = ave/tot_non_zero + field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo - case default - call MOM_error(FATAL, "decimate_field_3d: unknown sampling method "//trim(samplemethod)) - end select - + elseif(method .eq. 11) then !sum the fields in x and y + do k= ks,ke ; do j=jsl,jel ; do i=isl,iel + i0 = is+dl*(i-isl) + j0 = js+dl*(j-jsl) + ave = 0.0 + total_weight = 0.0 + do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 + total_weight = total_weight + mask(ii,jj,k) + ave=ave+field_in(ii,jj,k)*mask(ii,jj,k) + enddo; enddo + field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo; enddo; enddo + else + write (mesg,*) " unknown sampling method: ",method + call MOM_error(FATAL, "decimate_field_3d: "//trim(mesg)) + endif + end subroutine decimate_field_3d -subroutine decimate_field_2d(field_in, field_out, level, method, mask) +subroutine decimate_field_2d(field_in, field_out, dl, method, mask, diag_cs) real, dimension(:,:) , pointer :: field_in real, dimension(:,:) , allocatable :: field_out - integer , intent(in) :: level - character(len=4), optional, intent(in) :: method !< sampling method, one of samp,pave,aave,vave - real, dimension(:,:), optional , pointer :: mask + integer , intent(in) :: dl + integer, optional, intent(in) :: method !< sampling method, one of 00,01,02,10,20,11,22 + real, dimension(:,:), pointer :: mask + type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output !locals + character(len=240) :: mesg integer :: i,j,ii,jj,is,js,i0,j0 integer :: isl,iel,jsl,jel - real :: ave,tot_non_zero - character(len=4) :: samplemethod - samplemethod = 'samp' - if(present(method)) samplemethod = method - + real :: ave,total_weight,weight + real :: epsilon = 1.0e-20 !Always start from the first element is=1 js=1 - isl=1; iel=size(field_in,1)/level - jsl=1; jel=size(field_in,2)/level + isl=1; iel=size(field_in,1)/dl + jsl=1; jel=size(field_in,2)/dl allocate(field_out(isl:iel,jsl:jel)) - select case (samplemethod) - case ('samp') !subsample the SW corner cell + if(method .eq. 0) then !point average the fields in dl^2 cells do j=jsl,jel ; do i=isl,iel - i0 = is+level*(i-isl) - j0 = js+level*(j-jsl) - field_out(i,j) = field_in(i0,j0) - enddo; enddo - case ('pave') !point average of the cells - if(present(mask)) then - do j=jsl,jel ; do i=isl,iel - i0 = is+level*(i-isl) - j0 = js+level*(j-jsl) - ave = 0.0 - tot_non_zero = 0.0 - do ii=i0,i0+level-1 ; do jj=j0,j0+level-1 - tot_non_zero = tot_non_zero + mask(ii,jj) - ave=ave+field_in(ii,jj)*mask(ii,jj) - enddo; enddo - field_out(i,j) = ave/max(1.0,tot_non_zero) !Avoid zero mask at all aggregating cells where ave=0.0 + i0 = is+dl*(i-isl) + j0 = js+dl*(j-jsl) + ave = 0.0 + total_weight = 0.0 + do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 + total_weight = total_weight + mask(ii,jj) + ave=ave+field_in(ii,jj)*mask(ii,jj) enddo; enddo - else !Niki: How are we supposed to decimate/average without a mask? What if field_in is on land at one or more aggregating cells? - do j=jsl,jel ; do i=isl,iel - i0 = is+level*(i-isl) - j0 = js+level*(j-jsl) - ave = 0.0 - tot_non_zero = 0.0 - do ii=i0,i0+level-1 ; do jj=j0,j0+level-1 - tot_non_zero = tot_non_zero + 1 - ave=ave+field_in(ii,jj) - enddo; enddo - field_out(i,j) = ave/tot_non_zero + field_out(i,j) = ave/max(1.0,total_weight) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo; enddo + elseif(method .eq. 22) then !Volume average the fields in x and y + do j=jsl,jel ; do i=isl,iel + i0 = is+dl*(i-isl) + j0 = js+dl*(j-jsl) + ave = 0.0 + total_weight = 0.0 + do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 + weight = mask(ii,jj)*diag_cs%G%areaT(ii,jj)*diag_cs%h(ii,jj,1) + total_weight = total_weight + weight + ave=ave+field_in(ii,jj)*weight enddo; enddo - endif - case default - call MOM_error(FATAL, "decimate_field_2d: unknown sampling method "//trim(samplemethod)) - end select + field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo; enddo + + else + write (mesg,*) " unknown sampling method: ",method + call MOM_error(FATAL, "decimate_field_2d: "//trim(mesg)) + endif end subroutine decimate_field_2d From 719459354ce74af0a4c9e26dd2dd54e8e09064dc Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 16 Oct 2018 08:04:57 -0600 Subject: [PATCH 0830/1072] Re-introduces salt_flux contribution into net_FW --- config_src/mct_driver/MOM_surface_forcing.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 509907dd41..5bc8fdd97a 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -491,9 +491,9 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & ! 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 meltw and melth, 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) + 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 From 4e9c9bd472a398e1b84883d7c79f88e7d86e4f56 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Wed, 17 Oct 2018 17:06:55 -0400 Subject: [PATCH 0831/1072] Add missing logical condition for v_extensive Branch should be taken only if v_extensive is present AND .true., per conversation with @adcroft . --- src/framework/MOM_diag_mediator.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index a4c1787855..d529315459 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -1786,6 +1786,7 @@ subroutine attach_cell_methods(id, axes, ostring, cell_methods, & ostring = trim(adjustl(ostring))//' '//trim(axis_name)//':'//trim(v_cell_method) endif elseif (present(v_extensive)) then + if(v_extensive) then if (axes%rank==1) then call get_diag_axis_name(axes%handles(1), axis_name) elseif (axes%rank==3) then @@ -1793,6 +1794,7 @@ subroutine attach_cell_methods(id, axes, ostring, cell_methods, & endif call diag_field_add_attribute(id, 'cell_methods', trim(axis_name)//':sum') ostring = trim(adjustl(ostring))//' '//trim(axis_name)//':sum' + endif else if (len(trim(axes%v_cell_method))>0) then if (axes%rank==1) then From 009d00b32cfca9596b1c2b28aea8dd0f7dbb6064 Mon Sep 17 00:00:00 2001 From: "brandon.reichl" Date: Wed, 17 Oct 2018 18:59:39 -0400 Subject: [PATCH 0832/1072] Trailing whitespace --- src/user/MOM_wave_interface.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 67d149c252..d715b742ee 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -84,7 +84,7 @@ module MOM_wave_interface real, allocatable, dimension(:,:), public :: & La_SL,& !< SL Langmuir number (directionality factored later) !! Horizontal -> H points - La_Turb !< Aligned Turbulent Langmuir number + La_Turb !< Aligned Turbulent Langmuir number !! Horizontal -> H points real, allocatable, dimension(:,:), public :: & US0_x !< Surface Stokes Drift (zonal, m/s) @@ -864,8 +864,8 @@ subroutine get_Langmuir_Number( LA, G, GV, HBL, USTAR, i, j, & real, intent(in) :: USTAR !< Friction velocity (m/s) real, intent(in) :: HBL !< (Positive) thickness of boundary !! layer (m) - logical, optional,& - intent(in) :: Override_MA !< Override to use misalignment in LA + logical, optional,& + intent(in) :: Override_MA !< Override to use misalignment in LA !! calculation. This can be used if diagnostic !! LA outputs are desired that are different than !! those used by the dynamical model. From 0b8f544aebc566fad1a0e9c53cda2510e79da633 Mon Sep 17 00:00:00 2001 From: Rocky Dunlap Date: Thu, 18 Oct 2018 12:46:55 -0600 Subject: [PATCH 0833/1072] Move in updates to MOM6 cap to unify with EMC --- config_src/nuopc_driver/MOM_ocean_model.F90 | 552 +++---- .../nuopc_driver/MOM_surface_forcing.F90 | 209 +-- config_src/nuopc_driver/mom_cap.F90 | 1340 ++++++++--------- config_src/nuopc_driver/mom_cap_methods.F90 | 6 +- config_src/nuopc_driver/mom_cap_time.F90 | 425 ++++++ 5 files changed, 1394 insertions(+), 1138 deletions(-) create mode 100644 config_src/nuopc_driver/mom_cap_time.F90 diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 9d40dc6638..17d66789b5 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -1,72 +1,66 @@ +!> 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 -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_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 : 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 @@ -77,7 +71,6 @@ module MOM_ocean_model implicit none ; private 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 @@ -85,12 +78,15 @@ module MOM_ocean_model public ice_ocn_bnd_type_chksum public ocean_public_type_chksum public ocean_model_data_get +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". @@ -98,15 +94,14 @@ module MOM_ocean_model type(domain2d) :: Domain !< The domain for the surface fields. 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. + !! 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 @@ -221,20 +216,17 @@ module MOM_ocean_model contains -!======================================================================= -! -! -! -! Initialize the ocean model. -! - !> 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. @@ -247,14 +239,9 @@ 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. - + ! Local variables real :: Rho0 ! The Boussinesq ocean density, in kg m-3. real :: G_Earth ! The gravitational acceleration in m s-2. - ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "ocean_model_init" ! This module's name. @@ -411,17 +398,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i 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. -! -! !> 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 @@ -452,33 +428,32 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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-ocn 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. + ! 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. + 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. + 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 callTree_enter("update_ocean_model(), ocean_model_MOM.F90") call get_time(Ocean_coupling_time_step, secs, days) dt_coupling = 86400.0*real(days) + real(secs) @@ -512,19 +487,24 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%grid, OS%forcing_CSp) if (OS%fluxes%fluxes_used) then - - call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & + if (do_thermo) & + call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & OS%grid, 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) & 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 - call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) - call iceberg_fluxes(OS%grid, OS%fluxes, OS%use_ice_shelf, & + 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 @@ -538,34 +518,36 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! Indicate that there are new unused fluxes. OS%fluxes%fluxes_used = .false. OS%fluxes%dt_buoy_accum = dt_coupling - else - OS%flux_tmp%C_p = OS%fluxes%C_p - call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & + if (do_thermo) & + call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & OS%grid, 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, dt_coupling, OS%Ice_shelf_CSp) + 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 - call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & - OS%sfc_state, dt_coupling, OS%marine_ice_CSp) - call iceberg_fluxes(OS%grid, OS%flux_tmp, OS%use_ice_shelf, & + 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 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 - endif - call set_derived_forcing_fields(OS%forces, OS%fluxes, OS%grid, OS%GV%Rho0) call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid) @@ -673,130 +655,85 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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. -! +!> 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.) + 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 + !! 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 "//& "dynamics and advective times. Additional restart fields "//& "that have not been coded yet would be required for reproducibility.") - if (.not.OS%fluxes%fluxes_used) call MOM_error(FATAL, "ocean_model_restart "//& "was called with unused buoyancy fluxes. For conservation, the ocean "//& "restart files can only be created after the buoyancy forcing is applied.") 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 - + 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 + 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 + endif end subroutine ocean_model_restart ! NAME="ocean_model_restart" -!======================================================================= -! -! -! -! Close down the ocean model. Terminate the model run, optionally -! saving the ocean state in a restart file and deallocating any data -! associated with the ocean. - -! Arguments: Ocean_sfc - An ocean_public_type structure that is to be -! deallocated upon termination. -! (inout) Ocean_state - A pointer to the structure containing the internal -! ocean state to be deallocated upon termination. -! (in) Time - The model time, used for writing restarts. -! (in) write_restart - Write restart file if true -! +!> 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, write_restart) - 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. + 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. logical, intent(in) :: write_restart !< true => write restart file - if (write_restart) then - call ocean_model_save_restart(Ocean_state, Time) - end if + call ocean_model_save_restart(Ocean_state, Time) call diag_mediator_end(Time, Ocean_state%diag, end_diag_manager=.true.) 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. subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) - type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the - !! internal ocean state (in). - type(time_type), intent(in) :: Time !< The model time at this call, needed for mpp_write calls. - character(len=*), optional, intent(in) :: directory !< An optional directory into which to - !! write these restart files. + type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the + !! internal ocean state (in). + type(time_type), intent(in) :: Time !< The model time at this call, needed for mpp_write calls. + character(len=*), optional, intent(in) :: directory !< An optional directory into which to + !! 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. - + !! 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. @@ -806,16 +743,12 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) call MOM_error(WARNING, "ocean_model_save_restart called with inconsistent "//& "dynamics and advective times. Additional restart fields "//& "that have not been coded yet would be required for reproducibility.") - if (.not.OS%fluxes%fluxes_used) call MOM_error(FATAL, "ocean_model_save_restart "//& "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) @@ -827,15 +760,17 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) end subroutine ocean_model_save_restart -!======================================================================= - +!> 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 - type(ocean_public_type), intent(inout) :: Ocean_sfc - type(diag_ctrl), intent(in) :: diag + 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 + 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 @@ -850,9 +785,9 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, call mpp_get_layout(input_domain,layout) call mpp_get_global_domain(input_domain, xsize=xsz, ysize=ysz) if (PRESENT(maskmap)) then - call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain, maskmap=maskmap) + call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain, maskmap=maskmap) else - call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain) + call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain) endif call mpp_get_compute_domain(Ocean_sfc%Domain, isc, iec, jsc, jec) @@ -880,22 +815,23 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, end subroutine initialize_ocean_public_type -!======================================================================= -! 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. +!> 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 - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, optional, intent(in) :: patm(:,:) - real, optional, intent(in) :: press_to_z - + 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 @@ -955,13 +891,17 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, & 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*(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)) + 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*(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)) + 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 @@ -984,20 +924,15 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, & end subroutine convert_state_to_ocean_type -!======================================================================= -! -! -! -! This subroutine extracts the surface properties from the ocean's internal -! state and stores them in the ocean type returned to the calling ice model. -! It has to be separate from the ocean_initialization call because the coupler -! module allocates the space for some of these variables. -! - +!> 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 - type(ocean_public_type), intent(inout) :: Ocean_sfc - + 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 @@ -1009,9 +944,7 @@ 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 !! non-ocean PEs, or PEs that have not yet been initialzed, and it can safely @@ -1035,17 +968,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 @@ -1081,13 +1010,18 @@ subroutine Ocean_stock_pe(OS, index, value, time_index) end subroutine Ocean_stock_pe -subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc) +!> 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 @@ -1105,23 +1039,23 @@ subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc) select case(name) case('area') - array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) case('mask') - array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) !OR same result ! do j=g_jsc,g_jec ; do i=g_isc,g_iec ! array2D(isc+i-g_isc,jsc+j-g_jsc) = OS%grid%mask2dT(i,j) ! enddo ; enddo case('t_surf') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('t_pme') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('t_runoff') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('t_calving') - array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET + array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET case('btfHeat') - array2D(isc:,jsc:) = 0 + array2D(isc:,jsc:) = 0 case('tlat') array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) case('tlon') @@ -1143,37 +1077,40 @@ 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() @@ -1190,21 +1127,14 @@ subroutine ocean_public_type_chksum(id, timestep, ocn) 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/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index e601e83347..19a0ddbf86 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -45,9 +45,7 @@ module MOM_surface_forcing #include -public IOB_allocate -public convert_IOB_to_fluxes -public convert_IOB_to_forces +public convert_IOB_to_fluxes, convert_IOB_to_forces public surface_forcing_init public ice_ocn_bnd_type_chksum public forcing_save_restart @@ -63,9 +61,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) @@ -116,7 +111,7 @@ module MOM_surface_forcing 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 :: adjust_net_fresh_water_by_scaling ! adjust net surface fresh-water w/o moving zero contour + 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) @@ -205,8 +200,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & type(ice_ocean_boundary_type), & 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 @@ -215,12 +210,11 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. type(surface), intent(in) :: sfc_state !< A structure containing fields that describe the - !! surface state of the ocean. + !! surface state of the ocean. 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 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) @@ -477,7 +471,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & 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) @@ -496,6 +489,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & 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 ! more salt restoring logic @@ -649,6 +643,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) 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 @@ -665,7 +660,13 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) forces%p_surf(i,j) = forces%p_surf_full(i,j) enddo ; enddo endif + else + 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. wind_stagger = CS%wind_stagger if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. & @@ -843,58 +844,6 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) call cpu_clock_end(id_clock_forcing) end subroutine convert_IOB_to_forces -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% u_flux (isc:iec,jsc:jec), & - IOB% v_flux (isc:iec,jsc:jec), & - IOB% t_flux (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% runoff (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%u_flux = 0.0 - IOB%v_flux = 0.0 - IOB%t_flux = 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%runoff = 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 thermodynamic flux adjustments obtained via data_override !! Component name is 'OCN' !! Available adjustments are: @@ -998,23 +947,19 @@ subroutine apply_force_adjustments(G, CS, Time, forces) end subroutine apply_force_adjustments +!> 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 + 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 - character(len=*), intent(in) :: directory - logical, optional, intent(in) :: time_stamped - character(len=*), optional, intent(in) :: filename_suffix -! Arguments: CS - A pointer to the control structure returned by a previous -! call to surface_forcing_init. -! (in) G - The ocean's grid structure. -! (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) time_stamped - If true, the restart file names include -! a unique time stamp. The default is false. -! (in, opt) filename_suffix - An 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 @@ -1022,22 +967,21 @@ subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & end subroutine forcing_save_restart +!> Initialize the surface forcing, including setting parameters and allocating permanent memory. subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, restore_temp) - type(time_type), intent(in) :: Time + type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(inout) :: diag - type(surface_forcing_CS), pointer :: CS - logical, optional, intent(in) :: restore_salt, restore_temp -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module -! (in) restore_salt - If present and true, salinity restoring will be -! applied in this model. + 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, in m s-1. type(directories) :: dirs logical :: new_sim, iceberg_flux_diags @@ -1129,11 +1073,6 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res "limited by max_p_surf instead of the full atmospheric \n"//& "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 \n"//& "staggering of the input wind stress field. Valid \n"//& @@ -1209,7 +1148,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res "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, & @@ -1360,13 +1299,14 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res call cpu_clock_end(id_clock_forcing) end subroutine surface_forcing_init +!> 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) @@ -1377,40 +1317,43 @@ 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 - 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%q_flux ', mpp_chksum( iobt%q_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%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 ) - if (associated(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 ) + 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 + 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%q_flux ', mpp_chksum( iobt%q_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%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 ) + if (associated(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 ) 100 FORMAT(" CHECKSUM::",A20," = ",Z20) - call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%') + call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%') end subroutine ice_ocn_bnd_type_chksum diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 9aa394bce3..d638b82b94 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -363,7 +363,6 @@ !! module mom_cap_mod use constants_mod, only: constants_init - use data_override_mod, only: data_override_init, data_override use diag_manager_mod, only: diag_manager_init, diag_manager_end use field_manager_mod, only: field_manager_init, field_manager_end use fms_mod, only: fms_init, fms_end, open_namelist_file, check_nml_error @@ -387,7 +386,6 @@ module mom_cap_mod use time_manager_mod, only: date_to_string use time_manager_mod, only: fms_get_calendar_type => get_calendar_type use MOM_domains, only: MOM_infra_init, num_pes, root_pe, pe_here - use MOM_surface_forcing, only: IOB_allocate use MOM_file_parser, only: get_param, log_version, param_file_type, close_param_file use MOM_get_input, only: Get_MOM_Input, directories use MOM_domains, only: pass_var @@ -397,25 +395,22 @@ module mom_cap_mod use MOM_ocean_model, only: ocean_model_restart, ocean_public_type, ocean_state_type use MOM_ocean_model, only: ocean_model_data_get, ocean_model_init_sfc use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid + use mom_cap_time, only: AlarmInit #ifdef CESMCOUPLED use mom_cap_methods, only: mom_import, mom_export - use shr_nuopc_scalars_mod, only: flds_scalar_name, flds_scalar_num - use shr_nuopc_scalars_mod, only: flds_scalar_index_nx, flds_scalar_index_ny use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit use shr_file_mod, only: shr_file_setLogUnit, shr_file_setLogLevel - use shr_nuopc_time_mod, only: shr_nuopc_time_alarmInit - use, intrinsic :: iso_fortran_env, only: output_unit #endif - use ESMF ! TODO: only: ... - use NUOPC ! TODO: only: ... - use NUOPC_Model, & ! TODO: only: ... + use, intrinsic :: iso_fortran_env, only: output_unit + + use ESMF + use NUOPC + use NUOPC_Model, & model_routine_SS => SetServices, & - model_label_DataInitialize => label_DataInitialize, & model_label_Advance => label_Advance, & -#ifdef CESMCOUPLED + model_label_DataInitialize => label_DataInitialize, & model_label_SetRunClock => label_SetRunClock, & -#endif model_label_Finalize => label_Finalize use time_utils_mod, only: esmf2fms_time @@ -453,20 +448,16 @@ module mom_cap_mod integer :: import_slice = 1 integer :: export_slice = 1 character(len=256) :: tmpstr - integer :: dbrc type(ESMF_Grid) :: mom_grid_i - -#ifdef CESMCOUPLED - logical :: write_diagnostics = .false. - integer :: logunit ! stdout logging unit number - character(len=32) :: runtype ! run type -#else - logical :: write_diagnostics = .true. -#endif - logical :: profile_memory = .true. - logical :: grid_attach_area = .false. - integer(ESMF_KIND_I8) :: restart_interval - logical :: sw_decomp + logical :: write_diagnostics = .false. + character(len=32) :: runtype ! run type + integer :: logunit ! stdout logging unit number + logical :: profile_memory = .true. + logical :: grid_attach_area = .false. + character(len=128) :: scalar_field_name + integer :: scalar_field_count + integer :: scalar_field_idx_grid_nx + integer :: scalar_field_idx_grid_ny character(len=*),parameter :: u_file_u = & __FILE__ @@ -504,13 +495,13 @@ subroutine SetServices(gcomp, rc) ! set entry point for methods that require specific implementation call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv01p1"/), userRoutine=InitializeAdvertise, rc=rc) + phaseLabelList=(/"IPDv03p1"/), userRoutine=InitializeAdvertise, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv01p3"/), userRoutine=InitializeRealize, rc=rc) + phaseLabelList=(/"IPDv03p3"/), userRoutine=InitializeRealize, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -534,7 +525,6 @@ subroutine SetServices(gcomp, rc) file=__FILE__)) & return ! bail out -#ifdef CESMCOUPLED call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -546,7 +536,6 @@ subroutine SetServices(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out -#endif call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & specRoutine=ocean_model_finalize, rc=rc) @@ -576,71 +565,159 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) type(ESMF_Clock) :: clock integer, intent(out) :: rc - character(len=10) :: value + logical :: isPresent, isSet + integer :: iostat + character(len=64) :: value, logmsg character(len=*),parameter :: subname='(mom_cap:InitializeP0)' rc = ESMF_SUCCESS - ! Switch to IPDv01 by filtering all other phaseMap entries + ! Switch to IPDv03 by filtering all other phaseMap entries call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, & - acceptStringList=(/"IPDv01p"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_AttributeGet(gcomp, name="DumpFields", value=value, defaultValue="false", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! write_diagnostics=(trim(value)=="true") - call ESMF_LogWrite('MOM_CAP:DumpFields = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + acceptStringList=(/"IPDv03p"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + write_diagnostics = .false. + call NUOPC_CompAttributeGet(gcomp, name="DumpFields", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) write_diagnostics=(trim(value)=="true") + + write(logmsg,*) write_diagnostics + call ESMF_LogWrite('mom_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + profile_memory = .false. + call NUOPC_CompAttributeGet(gcomp, name="ProfileMemory", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) profile_memory=(trim(value)=="true") + write(logmsg,*) profile_memory + call ESMF_LogWrite('mom_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + grid_attach_area = .false. + call NUOPC_CompAttributeGet(gcomp, name="GridAttachArea", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) grid_attach_area=(trim(value)=="true") + write(logmsg,*) grid_attach_area + call ESMF_LogWrite('mom_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + scalar_field_name = "" + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + scalar_field_name = trim(value) + call ESMF_LogWrite('mom_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif - call ESMF_AttributeGet(gcomp, name="ProfileMemory", value=value, defaultValue="true", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - profile_memory=(trim(value)/="false") - call ESMF_LogWrite('MOM_CAP:ProfileMemory = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + scalar_field_count = 0 + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + read(value, '(i)', iostat=iostat) scalar_field_count + if (iostat /= 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ScalarFieldCount not an integer: "//trim(value), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + write(logmsg,*) scalar_field_count + call ESMF_LogWrite('mom_cap:ScalarFieldCount = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif -#ifndef CESMCOUPLED - ! Retrieve restart_interval in (seconds) - ! A restart_interval value of 0 means no restart will be written. - call ESMF_AttributeGet(gcomp, name="restart_interval", value=value, defaultValue="0", & - convention="NUOPC", purpose="Instance", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - restart_interval = ESMF_UtilString2Int(value, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + scalar_field_idx_grid_nx = 0 + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + read(value, '(i)', iostat=iostat) scalar_field_idx_grid_nx + if (iostat /= 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ScalarFieldIdxGridNX not an integer: "//trim(value), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + write(logmsg,*) scalar_field_idx_grid_nx + call ESMF_LogWrite('mom_cap:ScalarFieldIdxGridNX = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif - if(restart_interval < 0) then - call ESMF_LogSetError(ESMF_RC_NOT_VALID, & - msg="MOM_CAP: OCN attribute: restart_interval cannot be negative.", & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return + scalar_field_idx_grid_ny = 0 + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny + if (iostat /= 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ScalarFieldIdxGridNY not an integer: "//trim(value), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + write(logmsg,*) scalar_field_idx_grid_ny + call ESMF_LogWrite('mom_cap:ScalarFieldIdxGridNY = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return endif - call ESMF_LogWrite('MOM_CAP:restart_interval = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) -#endif - call ESMF_AttributeGet(gcomp, name="GridAttachArea", value=value, defaultValue="false", & - convention="NUOPC", purpose="Instance", rc=rc) + call NUOPC_CompAttributeAdd(gcomp, & + attrList=(/'RestartFileToRead', 'RestartFileToWrite'/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - grid_attach_area=(trim(value)=="true") - call ESMF_LogWrite('MOM_CAP:GridAttachArea = '//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) - + line=__LINE__, & + file=__FILE__)) & + return + end subroutine !=============================================================================== @@ -656,7 +733,6 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) !! @param clock an ESMF_Clock object !! @param rc return code subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance, shr_nuopc_utils_ChkErr type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -680,29 +756,26 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: year=0, month=0, day=0, hour=0, minute=0, second=0 integer :: mpi_comm_mom integer :: i,n - character(80) :: stdname, shortname -#ifdef CESMCOUPLED - integer :: nflds + character(len=256) :: stdname, shortname character(len=32) :: starttype ! model start type character(len=512) :: diro character(len=512) :: logfile - character(len=64) :: cvalue - integer :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix = "" ! char string associated with instance - ! (ie. "_0001" or "") - logical :: isPresent - character(len=384) :: restart_pointer_file ! File name for restart pointer file - character(len=384) :: restartfile ! Path/Name of restart file - character(len=384) :: restartname ! The restart file name (no dir) - integer :: nu ! i/o unit to read pointer file -#endif - - character(len=*),parameter :: subname='(mom_cap:InitializeAdvertise)' + character(ESMF_MAXSTR) :: cvalue + logical :: isPresent, isPresentDiro, isPresentLogfile, isSet + logical :: existflag + integer :: userRc + character(len=512) :: restartfile ! Path/Name of restart file + character(len=*), parameter :: subname='(mom_cap:InitializeAdvertise)' !-------------------------------- rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' enter', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + allocate(Ice_ocean_boundary) !allocate(ocean_state) ! ocean_model_init allocate this pointer allocate(ocean_public) @@ -752,92 +825,170 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) DT = set_time (DT_OCEAN, 0) Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) -#ifdef CESMCOUPLED - - ! determine instance information - call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - inst_name = "OCN"//trim(inst_suffix) + ! rsd need to figure out how to get this without share code + !call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) + !inst_name = "OCN"//trim(inst_suffix) ! reset shr logging to my log file - if(is_root_pe()) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) + if (is_root_pe()) then + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & + isPresent=isPresentDiro, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, & + isPresent=isPresentLogfile, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresentDiro .and. isPresentLogfile) then + open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) + else + logunit = output_unit + endif else logunit = output_unit endif - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) + starttype = "" + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - read(cvalue,*) starttype + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + read(cvalue,*) starttype + else + call ESMF_LogWrite('mom_cap:start_type unset - using input.nml for restart option', & + ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + runtype = "" if (trim(starttype) == trim('startup')) then - runtype = "initial" + runtype = "initial" else if (trim(starttype) == trim('continue') ) then - runtype = "continue" + runtype = "continue" else if (trim(starttype) == trim('branch')) then - runtype = "continue" - else - call ESMF_LogWrite(subname//' ERROR: unknown starttype '//trim(starttype), ESMF_LOGMSG_ERROR, rc=dbrc) - rc = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if + runtype = "continue" + else if (len_trim(starttype) > 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": unknown starttype - "//trim(starttype), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + if (len_trim(runtype) > 0) then + call ESMF_LogWrite('mom_cap:startup = '//trim(runtype), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + + restartfile = "" if (runtype == "initial") then - - ! startup (new run) - 'n' is needed below since we don't specify input_filename in input.nml - ocean_public%is_ocean_pe = .true. - call ocean_model_init(ocean_public, ocean_state, Time, Time, input_restart_file = 'n') - - - else ! hybrid or branch or continuos runs - - ! read name of restart file in the pointer file - nu = shr_file_getUnit() - restart_pointer_file = 'rpointer.ocn' - if (is_root_pe()) then - write(logunit,*) 'Reading ocn pointer file: ',restart_pointer_file - end if - open(nu, file=restart_pointer_file, form='formatted', status='unknown') - read(nu,'(a)') restartfile - close(nu) - - ! initialize from restart file - if (is_root_pe()) then - write(logunit,*) 'Reading restart file: ',trim(restartfile) - end if - call shr_file_freeUnit(nu) - - ocean_public%is_ocean_pe = .true. - call ocean_model_init(ocean_public, ocean_state, Time, Time, input_restart_file=trim(restartfile)) + ! startup (new run) - 'n' is needed below if we don't specify input_filename in input.nml + restartfile = "n" + else if (runtype == "continue") then ! hybrid or branch or continuos runs + + ! optionally call into system-specific implementation to get restart file name + call ESMF_MethodExecute(gcomp, label="GetRestartFileToRead", & + existflag=existflag, userRc=userRc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg="Error executing user method to get restart filename", & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (ESMF_LogFoundError(rcToCheck=userRc, msg="Error in method to get restart filename", & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (existflag) then + call ESMF_LogWrite('mom_cap: called user GetRestartFileToRead', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + + call NUOPC_CompAttributeGet(gcomp, name='RestartFileToRead', & + value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + restartfile = trim(cvalue) + call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + else + call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & + ESMF_LOGMSG_WARNING, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif end if - call ocean_model_init_sfc(ocean_state, ocean_public) - -#else - + ocean_public%is_ocean_pe = .true. - call ocean_model_init(ocean_public, ocean_state, Time, Time) - -#endif + if (len_trim(restartfile) > 0) then + call ocean_model_init(ocean_public, ocean_state, Time, Time, & + input_restart_file=trim(restartfile)) + else + call ocean_model_init(ocean_public, ocean_state, Time, Time) + endif - !tcx tcraig This results in errors in CESM with help from Alper - ! FATAL error "MPP_OPEN: error in OPEN for data_table" - ! The subroutine data_override_init shouldn't be called because ALLOW_FLUX_ADJUSTMENTS is set to FALSE - !tcx call data_override_init(ocean_domain_in = ocean_public%domain) + call ocean_model_init_sfc(ocean_state, ocean_public) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - call IOB_allocate(ice_ocean_boundary, isc, iec, jsc, jec) - - call external_coupler_sbc_init(ocean_public%domain, dt_cpld, Run_len) + allocate ( Ice_ocean_boundary% u_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% v_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% t_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% q_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% salt_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% lw_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_vis_dir (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_vis_dif (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_nir_dir (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_nir_dif (isc:iec,jsc:jec), & + Ice_ocean_boundary% lprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% fprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% runoff (isc:iec,jsc:jec), & + Ice_ocean_boundary% calving (isc:iec,jsc:jec), & + Ice_ocean_boundary% runoff_hflx (isc:iec,jsc:jec), & + Ice_ocean_boundary% calving_hflx (isc:iec,jsc:jec), & + Ice_ocean_boundary% mi (isc:iec,jsc:jec), & + Ice_ocean_boundary% p (isc:iec,jsc:jec)) + + Ice_ocean_boundary%u_flux = 0.0 + Ice_ocean_boundary%v_flux = 0.0 + Ice_ocean_boundary%t_flux = 0.0 + Ice_ocean_boundary%q_flux = 0.0 + Ice_ocean_boundary%salt_flux = 0.0 + Ice_ocean_boundary%lw_flux = 0.0 + Ice_ocean_boundary%sw_flux_vis_dir = 0.0 + Ice_ocean_boundary%sw_flux_vis_dif = 0.0 + Ice_ocean_boundary%sw_flux_nir_dir = 0.0 + Ice_ocean_boundary%sw_flux_nir_dif = 0.0 + Ice_ocean_boundary%lprec = 0.0 + Ice_ocean_boundary%fprec = 0.0 + Ice_ocean_boundary%runoff = 0.0 + Ice_ocean_boundary%calving = 0.0 + Ice_ocean_boundary%runoff_hflx = 0.0 + Ice_ocean_boundary%calving_hflx = 0.0 + Ice_ocean_boundary%mi = 0.0 + Ice_ocean_boundary%p = 0.0 ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) @@ -849,13 +1000,15 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) #ifdef CESMCOUPLED !--------- import fields ------------- - call fld_list_add(fldsToOcn_num, fldsToOcn, trim(flds_scalar_name), "will_provide") ! not in EMC + if (len_trim(scalar_field_name) > 0) then + call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") ! not in EMC + endif call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx @@ -867,7 +1020,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - + ! EMC fields not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn @@ -884,7 +1037,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") @@ -908,11 +1061,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! read(cvalue,*) flds_co2a - ! call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) ! call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! read(cvalue,*) flds_co2c - ! call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) ! if (flds_co2a .or. flds_co2c) then ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_co2prog" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_co2diag" , "will provide") @@ -920,11 +1073,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call NUOPC_CompAttributeGet(gcomp, name='ice_ncat', value=cvalue, rc=rc) ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! read(cvalue,*) ice_ncat - ! call ESMF_LogWrite('ice_ncat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite('ice_ncat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) ! call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc) ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! read(cvalue,*) flds_i2o_per_cat - ! call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) ! if (flds_i2o_per_cat) then ! do num = 1, ice_ncat ! name = 'Si_ifrac_' // cnum @@ -942,7 +1095,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! end do !--------- export fields ------------- - call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(flds_scalar_name), "will_provide") ! not in EMC + if (len_trim(scalar_field_name) > 0) then + call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide") ! not in EMC + endif call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask" , "will provide") ! -> ocean_mask call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t" , "will provide") ! -> sea_surface_temperature call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide") ! -> s_surf @@ -950,7 +1105,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! not in EMC call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! not in EMC ! EMC fields not used @@ -960,7 +1115,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Optional CESM fields currently not used ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen" , "will provide") ! not in EMC ! if (flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") ! end if @@ -1043,19 +1198,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) return ! bail out enddo - ! When running mom6 solo, the rotation angles are not computed internally - ! in MOM6. We need to calculate cos and sin of rotational angle for MOM6; - ! the values are stored in ocean_internalstate%ptr%ocean_grid_ptr%cos_rot and sin_rot - ! The rotation angles are retrieved during run time to rotate incoming - ! and outgoing vectors - ! call calculate_rot_angle(ocean_state, ocean_public) - ! tcraig, this is handled fine internally and if not, then later call this - ! call initialize_grid_rotation_angle(ocean_grid, PF) - - write(*,*) '----- MOM initialization phase Advertise completed' -#ifdef CESMCOUPLED - call shr_file_setLogUnit (output_unit) -#endif end subroutine InitializeAdvertise !=============================================================================== @@ -1111,21 +1253,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) type(ESMF_Field) :: field_t_surf integer :: mpicom integer :: localPet -#ifdef CESMCOUPLED - integer :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix = "" ! char string associated with instance - ! (ie. "_0001" or "") - character(len=64) :: cvalue - logical :: isPresent -#endif - character(len=*),parameter :: subname='(mom_cap:InitializeRealize)' + character(len=*), parameter :: subname='(mom_cap:InitializeRealize)' !-------------------------------- rc = ESMF_SUCCESS + #ifdef CESMCOUPLED call shr_file_setLogUnit (logunit) #endif + !---------------------------------------------------------------------------- ! Get pointers to ocean internal state !---------------------------------------------------------------------------- @@ -1162,8 +1298,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call mpp_get_global_domain(ocean_public%domain, xsize=nxg, ysize=nyg) write(tmpstr,'(a,2i6)') subname//' nxg,nyg = ',nxg,nyg - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + !--------------------------------- ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total !--------------------------------- @@ -1171,16 +1311,20 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ntiles=mpp_get_ntile_count(ocean_public%domain) ! this is tiles on this pe if (ntiles /= 1) then rc = ESMF_FAILURE - call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR, rc=dbrc) + call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return endif ntiles=mpp_get_domain_npes(ocean_public%domain) write(tmpstr,'(a,1i6)') subname//' ntiles = ',ntiles - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + !--------------------------------- ! get start and end indices of each tile and their PET !--------------------------------- @@ -1189,11 +1333,16 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call mpp_get_compute_domains(ocean_public%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye) call mpp_get_pelist(ocean_public%domain, pe) if (debug > 0) then - do n = 1,ntiles - write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - enddo + do n = 1,ntiles + write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + enddo end if + !--------------------------------- ! create delayout and distgrid @@ -1211,11 +1360,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) deBlockList(2,2,n) = ye(n) petMap(n) = pe(n) ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side enddo @@ -1225,6 +1374,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out + ! rsd this assumes tripole grid, but sometimes in CESM a bipole + ! grid is used -- need to introduce conditional logic here + allocate(connectionList(2)) ! bipolar boundary condition at top row: nyg @@ -1269,17 +1421,25 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) return ! bail out allocate(indexList(cnt)) write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out write(tmpstr,'(a,4i8)') subname//' distgrid list= ',& indexList(1),indexList(cnt),minval(indexList), maxval(indexList) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return deallocate(IndexList) - + !--------------------------------- ! create grid !--------------------------------- @@ -1389,20 +1549,19 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ubnd4 = ubound(dataPtr_xcor,2) write(tmpstr,*) subname//' iscjsc = ',isc,iec,jsc,jec - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(tmpstr,*) subname//' lbub12 = ',lbnd1,ubnd1,lbnd2,ubnd2 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(tmpstr,*) subname//' lbub34 = ',lbnd3,ubnd3,lbnd4,ubnd4 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) if (iec-isc /= ubnd1-lbnd1 .or. jec-jsc /= ubnd2-lbnd2) then - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": fld and grid do not have the same size.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": fld and grid do not have the same size.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return endif allocate(ofld(isc:iec,jsc:jec)) @@ -1410,10 +1569,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) write(tmpstr,*) subname//' ofld mask = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld mask = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 j1 = j - lbnd2 + jsc @@ -1425,10 +1584,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if(grid_attach_area) then call ocean_model_data_get(ocean_state, ocean_public, 'area', ofld, isc, jsc) write(tmpstr,*) subname//' ofld area = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld area = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 j1 = j - lbnd2 + jsc @@ -1440,10 +1599,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ocean_model_data_get(ocean_state, ocean_public, 'tlon', ofld, isc, jsc) write(tmpstr,*) subname//' ofld xt = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld xt = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 j1 = j - lbnd2 + jsc @@ -1455,10 +1614,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ocean_model_data_get(ocean_state, ocean_public, 'tlat', ofld, isc, jsc) write(tmpstr,*) subname//' ofld yt = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld yt = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 j1 = j - lbnd2 + jsc @@ -1469,10 +1628,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ocean_model_data_get(ocean_state, ocean_public, 'geoLonBu', ofld, isc, jsc) write(tmpstr,*) subname//' ofld xu = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld xu = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) do j = lbnd4, ubnd4 do i = lbnd3, ubnd3 j1 = j - lbnd4 + jsc - 1 @@ -1492,17 +1651,17 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) endif dataPtr_xcor(i,j) = mod(dataPtr_xcor(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) ! write(tmpstr,*) subname//' ijfld xu = ',i,i1,j,j1,dataPtr_xcor(i,j) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) enddo enddo ! MOM6 runs on C-Grid. call ocean_model_data_get(ocean_state, ocean_public, 'geoLatBu', ofld, isc, jsc) write(tmpstr,*) subname//' ofld yu = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) call mpp_global_field(ocean_public%domain, ofld, gfld) write(tmpstr,*) subname//' gfld yu = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) do j = lbnd4, ubnd4 do i = lbnd3, ubnd3 j1 = j - lbnd4 + jsc - 1 @@ -1519,29 +1678,29 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) return ! bail out endif ! write(tmpstr,*) subname//' ijfld yu = ',i,i1,j,j1,dataPtr_ycor(i,j) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) enddo enddo write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) if(grid_attach_area) then write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) endif write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(tmpstr,*) subname//' ycen = ',minval(dataPtr_ycen),maxval(dataPtr_ycen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(tmpstr,*) subname//' xcor = ',minval(dataPtr_xcor),maxval(dataPtr_xcor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) deallocate(gfld) @@ -1564,21 +1723,21 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out -#ifdef CESMCOUPLED - call State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, localPet, & - flds_scalar_name, flds_scalar_num, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, localPet, & - flds_scalar_name, flds_scalar_num, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -#endif + if (len_trim(scalar_field_name) > 0) then + call State_SetScalar(dble(nxg),scalar_field_idx_grid_nx, exportState, localPet, & + scalar_field_name, scalar_field_count, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & + scalar_field_name, scalar_field_count, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif call ESMF_StateGet(exportState, itemSearch="sea_surface_temperature", itemCount=icount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1618,18 +1777,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) deallocate(ofld) endif -! tcraig, turn this off for now, have issues with overwriting failures -! call NUOPC_Write(exportState, fileNamePrefix='init_field_ocn_export_', & -! timeslice=1, relaxedFlag=.true., rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out - - write(*,*) '----- MOM initialization phase Realize completed' -#ifdef CESMCOUPLED - call shr_file_setLogUnit (output_unit) -#endif + !call NUOPC_Write(exportState, fileNamePrefix='post_realize_field_ocn_export_', & + ! timeslice=1, relaxedFlag=.true., rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + end subroutine InitializeRealize !=============================================================================== @@ -1670,11 +1824,13 @@ subroutine DataInitialize(gcomp, rc) ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr call get_ocean_grid(ocean_state, ocean_grid) +#ifdef CESMCOUPLED call mom_export(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out +#endif call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1737,6 +1893,8 @@ subroutine ModelAdvance(gcomp, rc) integer, intent(out) :: rc ! local variables + integer :: userRc + logical :: existflag, isPresent, isSet type(ESMF_Clock) :: clock type(ESMF_Alarm) :: alarm type(ESMF_State) :: importState, exportState @@ -1757,15 +1915,10 @@ subroutine ModelAdvance(gcomp, rc) integer :: isc,iec,jsc,jec,lbnd1,ubnd1,lbnd2,ubnd2 integer :: i,j,i1,j1 integer :: nc -#ifdef CESMCOUPLED type(ESMF_Time) :: MyTime integer :: seconds, day, year, month, hour, minute - integer :: nu ! i/o unit to write pointer file - character(ESMF_MAXSTR) :: cvalue - character(ESMF_MAXSTR) :: runid ! Run ID - character(len=384) :: restartname ! restart file name (no dir) - character(len=384) :: restart_pointer_file ! file name for restart pointer file -#else + character(ESMF_MAXSTR) :: restartname, cvalue +#ifndef CESMCOUPLED real(ESMF_KIND_R8), allocatable :: ofld(:,:), ocz(:,:), ocm(:,:) real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) @@ -1784,9 +1937,11 @@ subroutine ModelAdvance(gcomp, rc) rc = ESMF_SUCCESS if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") + #ifdef CESMCOUPLED call shr_file_setLogUnit (logunit) #endif + ! query the Component for its clock, importState and exportState call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & exportState=exportState, rc=rc) @@ -1849,10 +2004,6 @@ subroutine ModelAdvance(gcomp, rc) Time_step_coupled = esmf2fms_time(timeStep) dt_cpld = dth*3600+dtm*60+dts - call ice_ocn_bnd_from_data(Ice_ocean_boundary, Time, Time_step_coupled) - - call external_coupler_sbc_before(Ice_ocean_boundary, ocean_public, nc, dt_cpld ) - if(write_diagnostics) then call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', & timeslice=import_slice, relaxedFlag=.true., rc=rc) @@ -1870,7 +2021,6 @@ subroutine ModelAdvance(gcomp, rc) call get_ocean_grid(ocean_state, ocean_grid) #ifdef CESMCOUPLED - ! Reset shr logging to my log file call shr_file_setLogUnit (logunit) call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, logunit, runtype, clock, rc=rc) @@ -1914,16 +2064,24 @@ subroutine ModelAdvance(gcomp, rc) dataPtr_evap = - dataPtr_evap dataPtr_sensi = - dataPtr_sensi + print *, 'lbnd1,ubnd1,lbnd2,ubnd2', lbnd1, ubnd1, lbnd2, ubnd2 + allocate(mzmf(lbnd1:ubnd1,lbnd2:ubnd2)) allocate(mmmf(lbnd1:ubnd1,lbnd2:ubnd2)) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc ! work around local vs global indexing - i1 = i - lbnd1 + isc +! j1 = j - lbnd2 + jsc ! work around local vs global indexing +! i1 = i - lbnd1 + isc + j1 = j + ocean_grid%jsc - lbnd2 + i1 = i + ocean_grid%isc - lbnd1 +! mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & +! + ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) +! mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & +! - ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - + ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) + - ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - - ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) + + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) enddo enddo dataPtr_mzmf = mzmf @@ -1931,22 +2089,22 @@ subroutine ModelAdvance(gcomp, rc) deallocate(mzmf, mmmf) !Optionally write restart files when currTime-startTime is integer multiples of restart_interval - if (restart_interval > 0 ) then - time_elapsed = currTime - startTime - call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - n_interval = time_elapsed_sec / restart_interval - if ((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then - time_restart_current = esmf2fms_time(currTime) - timestamp = date_to_string(time_restart_current) - call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=dbrc) - write(*,*) 'calling ocean_model_restart' - call ocean_model_restart(ocean_state, timestamp) - endif - endif +! if (restart_interval > 0 ) then +! time_elapsed = currTime - startTime +! call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +! line=__LINE__, & +! file=__FILE__)) & +! return ! bail out +! n_interval = time_elapsed_sec / restart_interval +! if ((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then +! time_restart_current = esmf2fms_time(currTime) +! timestamp = date_to_string(time_restart_current) +! call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=rc) +! write(*,*) 'calling ocean_model_restart' +! call ocean_model_restart(ocean_state, timestamp) +! endif +! endif #endif ! Update MOM6 @@ -1956,75 +2114,15 @@ subroutine ModelAdvance(gcomp, rc) if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") #ifdef CESMCOUPLED - call mom_export(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - ! If restart alarm is ringing - write restart file - call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_AlarmRingerOff( alarm, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! determine restart filename - ! Need to use next time step since clock is not advanced until the end of the time interval - call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - read(cvalue,*) runid - - call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, s=seconds, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I5.5)') trim(runid), year, month, day, seconds - - ! write name of restart file in the rpointer file - nu = shr_file_getUnit() - if (is_root_pe()) then - restart_pointer_file = 'rpointer.ocn' - open(nu, file=restart_pointer_file, form='formatted', status='unknown') - write(nu,'(a)') trim(restartname) //'.nc' - close(nu) - write(logunit,*) 'ocn restart pointer file written: ',trim(restartname) - endif - call shr_file_freeUnit(nu) - - ! write restart file(s) - call ocean_model_restart(ocean_state, restartname=restartname) - - if (is_root_pe()) then - write(logunit,*) subname//' writing restart file ',trim(restartname) - end if - endif - ! reset shr logging to my original values call shr_file_setLogUnit (output_unit) + #else allocate(ofld(isc:iec,jsc:jec)) @@ -2065,83 +2163,116 @@ subroutine ModelAdvance(gcomp, rc) ocm = dataPtr_ocm do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc ! work around local vs global indexing - i1 = i - lbnd1 + isc + j1 = j + ocean_grid%jsc - lbnd2 + i1 = i + ocean_grid%isc - lbnd1 dataPtr_ocz(i,j) = ocean_grid%cos_rot(i1,j1)*ocz(i,j) & - - ocean_grid%sin_rot(i1,j1)*ocm(i,j) + + ocean_grid%sin_rot(i1,j1)*ocm(i,j) dataPtr_ocm(i,j) = ocean_grid%cos_rot(i1,j1)*ocm(i,j) & - + ocean_grid%sin_rot(i1,j1)*ocz(i,j) - enddo - enddo - deallocate(ocz, ocm) - - !call ESMF_LogWrite("B4 writing diags", dataPtr_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc)) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_mask(i,j) = nint(ofld(i1,j1)) - enddo - enddo - deallocate(ofld) - - ! Now rotate ocn current from tripolar grid back to lat/lon grid (CCW) - allocate(ocz(lbnd1:ubnd1,lbnd2:ubnd2)) - allocate(ocm(lbnd1:ubnd1,lbnd2:ubnd2)) - - call State_getFldPtr(exportState,'ocn_current_zonal',dataPtr_ocz,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'ocn_current_merid',dataPtr_ocm,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling - - ocz = dataPtr_ocz - ocm = dataPtr_ocm - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc ! work around local vs global indexing - i1 = i - lbnd1 + isc - dataPtr_ocz(i,j) = ocean_grid%cos_rot(i1,j1)*ocz(i,j) & - - ocean_grid%sin_rot(i1,j1)*ocm(i,j) - dataPtr_ocm(i,j) = ocean_grid%cos_rot(i1,j1)*ocm(i,j) & - + ocean_grid%sin_rot(i1,j1)*ocz(i,j) + - ocean_grid%sin_rot(i1,j1)*ocz(i,j) + ! multiply by mask to zero out non-ocean points + dataPtr_ocz(i,j) = dataPtr_ocz(i,j) * dataPtr_mask(i,j) + dataPtr_ocm(i,j) = dataPtr_ocm(i,j) * dataPtr_mask(i,j) enddo enddo deallocate(ocz, ocm) #endif - + + ! If restart alarm is ringing - write restart file + call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_AlarmRingerOff(alarm, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! call into system specific method to get desired restart filename + restartname = "" + call ESMF_MethodExecute(gcomp, label="GetRestartFileToWrite", & + existflag=existflag, userRc=userRc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg="Error executing user method to get restart filename", & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (ESMF_LogFoundError(rcToCheck=userRc, msg="Error in method to get restart filename", & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (existflag) then + call ESMF_LogWrite("mom_cap: called user GetRestartFileToWrite method", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompAttributeGet(gcomp, name='RestartFileToWrite', & + isPresent=isPresent, isSet=isSet, value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + restartname = trim(cvalue) + call ESMF_LogWrite("mom_cap: User RestartFileToWrite: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + endif + + if (len_trim(restartname) == 0) then + ! none provided, so use a default restart filename + call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, & + h=hour, m=minute, s=seconds, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & + "ocn", year, month, day, hour, minute, seconds + call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + ! write restart file(s) + call ocean_model_restart(ocean_state, restartname=restartname) + + if (is_root_pe()) then + write(logunit,*) subname//' writing restart file ',trim(restartname) + end if + endif + if (write_diagnostics) then - call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & - timeslice=export_slice, relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - export_slice = export_slice + 1 + call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & + timeslice=export_slice, relaxedFlag=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + export_slice = export_slice + 1 endif - - !call ESMF_LogWrite("Before calling sbc forcing", ESMF_LOGMSG_INFO, rc=rc) - call external_coupler_sbc_after(Ice_ocean_boundary, ocean_public, nc, dt_cpld ) - !call ESMF_LogWrite("Before dumpMomInternal", ESMF_LOGMSG_INFO, rc=rc) - !write(*,*) 'MOM: --- run phase called ---' - + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") -#ifdef CESMCOUPLED - call shr_file_setLogUnit (output_unit) -#endif + end subroutine ModelAdvance !=============================================================================== @@ -2161,6 +2292,7 @@ subroutine ModelSetRunClock(gcomp, rc) integer :: restart_n ! Number until restart interval integer :: restart_ymd ! Restart date (YYYYMMDD) type(ESMF_ALARM) :: restart_alarm + logical :: isPresent, isSet logical :: first_time = .true. character(len=*),parameter :: subname='mom_cap:(ModelSetRunClock) ' !-------------------------------- @@ -2203,9 +2335,9 @@ subroutine ModelSetRunClock(gcomp, rc) file=__FILE__)) & return ! bail out - call ESMF_LogWrite(subname//" ERROR in time consistency; "//trim(dtimestring)//" ne "//trim(mtimestring), & - ESMF_LOGMSG_ERROR, rc=dbrc) - rc = ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_VAL_WRONG, & + msg=subname//": ERROR in time consistency: "//trim(dtimestring)//" != "//trim(mtimestring), & + line=__LINE__, file=__FILE__, rcToReturn=rc) return endif @@ -2222,30 +2354,44 @@ subroutine ModelSetRunClock(gcomp, rc) return ! bail out if (first_time) then - !-------------------------------- + !-------------------------------- ! set restart alarm - !-------------------------------- - call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + !-------------------------------- - call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - read(cvalue,*) restart_n + ! defaults + restart_n = 0 + restart_ymd = 0 - call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="restart_option", isPresent=isPresent, & + isSet=isSet, value=restart_option, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - read(cvalue,*) restart_ymd - - call shr_nuopc_time_alarmInit(mclock, & + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + read(cvalue,*) restart_n + endif + call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + read(cvalue,*) restart_ymd + endif + else + restart_option = "none" + endif + + call AlarmInit(mclock, & alarm = restart_alarm, & option = trim(restart_option), & opt_n = restart_n, & @@ -2256,13 +2402,21 @@ subroutine ModelSetRunClock(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out first_time = .false. + + call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & + ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if !-------------------------------- @@ -2283,6 +2437,7 @@ subroutine ModelSetRunClock(gcomp, rc) end subroutine ModelSetRunClock + !=============================================================================== !> Called by NUOPC at the end of the run to clean up. @@ -2331,14 +2486,14 @@ subroutine ocean_model_finalize(gcomp, rc) Time = esmf2fms_time(currTime) #ifdef CESMCOUPLED - call ocean_model_end (ocean_public, ocean_State, Time, write_restart=.false.) + call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.false.) #else - call ocean_model_end (ocean_public, ocean_State, Time, write_restart=.true.) + call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.true.) #endif - call field_manager_end + call field_manager_end() - call fms_io_exit - call fms_end + call fms_io_exit() + call fms_end() write(*,*) 'MOM: --- completed ---' @@ -2346,165 +2501,6 @@ end subroutine ocean_model_finalize !==================================================================== - ! get forcing data from data_overide - subroutine ice_ocn_bnd_from_data(x, Time, Time_step_coupled) - - type (ice_ocean_boundary_type) :: x - type(Time_type), intent(in) :: Time, Time_step_coupled - - type(Time_type) :: Time_next - character(len=*),parameter :: subname='(mom_cap:ice_ocn_bnd_from_data)' - - Time_next = Time + Time_step_coupled - - !call data_override('OCN', 't_flux', x%t_flux , Time_next) - !call data_override('OCN', 'u_flux', x%u_flux , Time_next) - !call data_override('OCN', 'v_flux', x%v_flux , Time_next) - !call data_override('OCN', 'q_flux', x%q_flux , Time_next) - !call data_override('OCN', 'salt_flux', x%salt_flux , Time_next) - !call data_override('OCN', 'lw_flux', x%lw_flux , Time_next) - !call data_override('OCN', 'sw_flux_vis_dir', x%sw_flux_vis_dir, Time_next) - !call data_override('OCN', 'sw_flux_vis_dif', x%sw_flux_vis_dif, Time_next) - !call data_override('OCN', 'sw_flux_nir_dir', x%sw_flux_nir_dir, Time_next) - !call data_override('OCN', 'sw_flux_nir_dif', x%sw_flux_nir_dif, Time_next) - !call data_override('OCN', 'lprec', x%lprec , Time_next) - !call data_override('OCN', 'fprec', x%fprec , Time_next) - !call data_override('OCN', 'runoff', x%runoff , Time_next) - !call data_override('OCN', 'calving', x%calving , Time_next) - !call data_override('OCN', 'p', x%p , Time_next) - - end subroutine ice_ocn_bnd_from_data - -!----------------------------------------------------------------------------------------- -! -! Subroutines for enabling coupling to external programs through a third party coupler -! such as OASIS/PRISM. -! If no external coupler then these will mostly be dummy routines. -! These routines can also serve as spots to call other user defined routines -!----------------------------------------------------------------------------------------- - -!----------------------------------------------------------------------------------------- - -! Dummy subroutines. - - subroutine external_coupler_mpi_init(mom_local_communicator, external_initialization) - implicit none - integer, intent(out) :: mom_local_communicator - logical, intent(out) :: external_initialization - external_initialization = .false. - mom_local_communicator = -100 ! Is there mpp_undefined parameter corresponding to MPI_UNDEFINED? - ! probably wouldn't need logical flag. - return - end subroutine external_coupler_mpi_init - -!----------------------------------------------------------------------------------------- - subroutine external_coupler_sbc_init(Dom, dt_cpld, Run_len) - implicit none - type(domain2d) :: Dom - integer :: dt_cpld - type(time_type) :: Run_len - return - end subroutine external_coupler_sbc_init - - subroutine external_coupler_sbc_before(Ice_ocean_boundary, ocean_public, nsteps, dt_cpld ) - implicit none - type (ice_ocean_boundary_type), intent(INOUT) :: Ice_ocean_boundary - type (ocean_public_type) , intent(INOUT) :: ocean_public - integer , intent(IN) :: nsteps, dt_cpld - return - end subroutine external_coupler_sbc_before - - - subroutine external_coupler_sbc_after(Ice_ocean_boundary, ocean_public, nsteps, dt_cpld ) - type (ice_ocean_boundary_type) :: Ice_ocean_boundary - type (ocean_public_type) :: ocean_public - integer :: nsteps, dt_cpld - return - end subroutine external_coupler_sbc_after - - subroutine external_coupler_restart( dt_cpld, num_cpld_calls ) - implicit none - integer, intent(in) :: dt_cpld, num_cpld_calls - return - end subroutine external_coupler_restart - - subroutine external_coupler_exit - return - end subroutine external_coupler_exit - -!----------------------------------------------------------------------------------------- - subroutine external_coupler_mpi_exit(mom_local_communicator, external_initialization) - implicit none - integer, intent(in) :: mom_local_communicator - logical, intent(in) :: external_initialization - return - end subroutine external_coupler_mpi_exit -!----------------------------------------------------------------------------------------- - subroutine writeSliceFields(state, filename_prefix, slice, rc) - type(ESMF_State) :: state - character(len=*) :: filename_prefix - integer :: slice - integer, intent(out), optional :: rc - - integer :: n, nfields - type(ESMF_Field) :: field - type(ESMF_StateItem_Flag) :: itemType - character(len=40) :: fileName - character(len=64),allocatable :: fieldNameList(:) - character(len=*),parameter :: subname='(mom_cap:writeSliceFields)' - - if (present(rc)) rc = ESMF_SUCCESS - - if (ESMF_IO_PIO_PRESENT .and. & - (ESMF_IO_NETCDF_PRESENT .or. ESMF_IO_PNETCDF_PRESENT)) then - - call ESMF_StateGet(state, itemCount=nfields, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - allocate(fieldNameList(nfields)) - call ESMF_StateGet(state, itemNameList=fieldNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - do n=1, size(fieldNameList) - call ESMF_StateGet(state, itemName=fieldNameList(n), & - itemType=itemType, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (itemType /= ESMF_STATEITEM_NOTFOUND) then - ! field is available in the state - call ESMF_StateGet(state, itemName=fieldNameList(n), field=field, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! -> output to file - write (fileName,"(A)") & - filename_prefix//trim(fieldNameList(n))//".nc" - call ESMF_FieldWrite(field, fileName=trim(fileName), & - timeslice=slice, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - enddo - - deallocate(fieldNameList) - - endif - - end subroutine writeSliceFields - - !----------------------------------------------------------------------------- - subroutine State_GetFldPtr(ST, fldname, fldptr, rc) type(ESMF_State) , intent(in) :: ST character(len=*) , intent(in) :: fldname @@ -2533,7 +2529,7 @@ end subroutine State_GetFldPtr !----------------------------------------------------------------------------- - subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_num, rc) + subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_count, rc) ! ---------------------------------------------- ! Set scalar data from State for a particular name ! ---------------------------------------------- @@ -2541,8 +2537,8 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ integer, intent(in) :: scalar_id type(ESMF_State), intent(inout) :: State integer, intent(in) :: mytask - character(len=*), intent(in) :: scalar_name - integer, intent(in) :: scalar_num + character(len=*), intent(in) :: scalar_name + integer, intent(in) :: scalar_count integer, intent(inout) :: rc ! local variables @@ -2560,11 +2556,11 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ call ESMF_FieldGet(field, farrayPtr=farrayptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - if (scalar_id < 0 .or. scalar_id > scalar_num) then - call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", & - ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u, rc=dbrc) - rc = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (scalar_id < 0 .or. scalar_id > scalar_count) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ERROR in scalar_id", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return endif farrayptr(1,scalar_id) = value @@ -2588,6 +2584,7 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) integer :: npet, nx, ny, pet integer :: elb(2), eub(2), clb(2), cub(2), tlb(2), tub(2) type(ESMF_VM) :: vm + real(ESMF_KIND_R8), pointer :: fldptr(:,:) character(len=*),parameter :: subname='(mom_cap:MOM_RealizeFields)' rc = ESMF_SUCCESS @@ -2596,12 +2593,12 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) if (NUOPC_IsConnected(state, fieldName=field_defs(i)%shortname)) then - if (field_defs(i)%shortname == flds_scalar_name) then + if (field_defs(i)%shortname == scalar_field_name) then call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected on root pe.", & ESMF_LOGMSG_INFO, & line=__LINE__, & file=__FILE__, & - rc=dbrc) + rc=rc) call SetScalarField(field, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2613,11 +2610,11 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) ESMF_LOGMSG_INFO, & line=__LINE__, & file=__FILE__, & - rc=dbrc) + rc=rc) write(tmpstr,'(a,4i12)') subname//trim(tag)//' Field '//trim(field_defs(i)%shortname)//':', & lbound(field_defs(i)%farrayPtr,1), ubound(field_defs(i)%farrayPtr,1), & lbound(field_defs(i)%farrayPtr,2), ubound(field_defs(i)%farrayPtr,2) - call ESMF_LogWrite(tmpstr, ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(tmpstr, ESMF_LOGMSG_INFO, rc=rc) field = ESMF_FieldCreate(grid=grid, & farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & !farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & @@ -2631,13 +2628,22 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) ESMF_LOGMSG_INFO, & line=__LINE__, & file=__FILE__, & - rc=dbrc) + rc=rc) field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & name=field_defs(i)%shortname, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + + ! initialize to zero + call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + fldptr = 0.0 + endif call NUOPC_Realize(state, field=field, rc=rc) @@ -2645,19 +2651,12 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - ! call ESMF_FieldPrint(field=field, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out else call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is not connected.", & ESMF_LOGMSG_INFO, & line=__LINE__, & file=__FILE__, & - rc=dbrc) - ! TODO: Initialize the value in the pointer to 0 after proper restart is setup - ! if(associated(field_defs(i)%farrayPtr) ) field_defs(i)%farrayPtr = 0.0 + rc=rc) ! remove a not connected Field from State call ESMF_StateRemove(state, (/field_defs(i)%shortname/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -2693,10 +2692,10 @@ subroutine SetScalarField(field, rc) grid = ESMF_GridCreate(distgrid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - field = ESMF_FieldCreate(name=trim(flds_scalar_name), grid=grid, & + field = ESMF_FieldCreate(name=trim(scalar_field_name), grid=grid, & typekind=ESMF_TYPEKIND_R8, & ungriddedLBound=(/1/), & - ungriddedUBound=(/flds_scalar_num/), & ! num of scalar values + ungriddedUBound=(/scalar_field_count/), & ! num of scalar values rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -2723,9 +2722,10 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) num = num + 1 if (num > fldsMax) then - call ESMF_LogWrite(trim(subname)//": ERROR num gt fldsMax "//trim(stdname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - return + call ESMF_LogSetError(ESMF_RC_VAL_OUTOFRANGE, & + msg=trim(subname)//": ERROR number of field exceeded fldsMax: "//trim(stdname), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return endif fldlist(num)%stdname = trim(stdname) @@ -2747,50 +2747,4 @@ end subroutine fld_list_add !----------------------------------------------------------------------------- -#if (1 == 0) - subroutine calculate_rot_angle(OS, OSFC) - type(ocean_state_type), intent(in) :: OS - type(ocean_public_type), intent(in) :: OSFC - - integer :: i,j,ishift,jshift,ilb,iub,jlb,jub - real :: angle, lon_scale - type(ocean_grid_type), pointer :: grid - - call get_ocean_grid(OS, grid) - - !print *, 'lbound: ', lbound(grid%geoLatT), lbound(grid%geoLonT), lbound(grid%sin_rot) - !print *, 'ubound: ', ubound(grid%geoLatT), ubound(grid%geoLonT), ubound(grid%sin_rot) - - !print *, minval(grid%geoLatT), maxval(grid%geoLatT) - !print *, minval(grid%geoLonT), maxval(grid%geoLonT) - !print *, grid%isc, grid%jsc, grid%iec, grid%jec - - ! - ! The bounds isc:iec goes from 5-104, isc-ishift:iec-ishift goes from 1:100 - ! - call mpp_get_compute_domain(OSFC%Domain, ilb, iub, jlb, jub) - ishift = ilb-grid%isc - jshift = jlb-grid%jsc - !print *, 'ilb, iub, jlb, jub', ilb, iub, jlb, jub, ishift, jshift - !print *, 'sizes', iub-ilb, jub-jlb, grid%iec-grid%isc, grid%jec-grid%jsc -! allocate(grid%sin_rot(ilb:iub, jlb:jub)) -! allocate(grid%cos_rot(ilb:iub, jlb:jub)) - - ! loop 5-104 - do j=grid%jsc,grid%jec ; do i=grid%isc,grid%iec - lon_scale = cos((grid%geoLatBu(I-1,J-1) + grid%geoLatBu(I,J-1 ) + & - grid%geoLatBu(I-1,J) + grid%geoLatBu(I,J)) * atan(1.0)/180) - angle = atan2((grid%geoLonBu(I-1,J) + grid%geoLonBu(I,J) - & - grid%geoLonBu(I-1,J-1) - grid%geoLonBu(I,J-1))*lon_scale, & - grid%geoLatBu(I-1,J) + grid%geoLatBu(I,J) - & - grid%geoLatBu(I-1,J-1) - grid%geoLatBu(I,J-1) ) - grid%sin_rot(i+ishift,j+jshift) = sin(angle) ! angle is the clockwise angle from lat/lon to ocean - grid%cos_rot(i+ishift,j+jshift) = cos(angle) ! grid (e.g. angle of ocean "north" from true north) - enddo ; enddo - !print *, minval(grid%sin_rot), maxval(grid%sin_rot) - !print *, minval(grid%cos_rot), maxval(grid%cos_rot) - - end subroutine -#endif - end module mom_cap_mod diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index be9cd4e966..6e3558efc5 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -3,6 +3,7 @@ module mom_cap_methods use ESMF, only: ESMF_time, ESMF_ClockGet, ESMF_TimeGet, ESMF_State, ESMF_Clock use ESMF, only: ESMF_KIND_R8, ESMF_Field, ESMF_SUCCESS, ESMF_LogFoundError use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_StateGet, ESMF_FieldGet + use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE use MOM_ocean_model, only: ocean_public_type, ocean_state_type use MOM_surface_forcing, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type @@ -15,8 +16,10 @@ module mom_cap_methods private ! Public member functions +#ifdef CESMCOUPLED public :: mom_export public :: mom_import +#endif public :: mom_import_nems integer :: rc,dbrc @@ -27,6 +30,7 @@ module mom_cap_methods contains !----------------------------------------------------------------------- +#ifdef CESMCOUPLED !> Maps outgoing ocean data to ESMF State !! See \ref section_mom_export for a summary of the data !! that is transferred from MOM6 to MCT. @@ -468,7 +472,7 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & end if end subroutine mom_import - +#endif !----------------------------------------------------------------------------- subroutine mom_import_nems(ocean_public, grid, importState, ice_ocean_boundary, rc) diff --git a/config_src/nuopc_driver/mom_cap_time.F90 b/config_src/nuopc_driver/mom_cap_time.F90 new file mode 100644 index 0000000000..c85d68b1ae --- /dev/null +++ b/config_src/nuopc_driver/mom_cap_time.F90 @@ -0,0 +1,425 @@ +! +! This was originally share code in CIME, but required CIME as a +! dependency to build the MOM cap. The options here for setting +! a restart alarm are useful for all caps, so a second step is to +! determine if/how these could be offered more generally in a +! shared library. For now we really want the MOM cap to only +! depend on MOM and ESMF/NUOPC. +! +module mom_cap_time + + ! !USES: + use ESMF , only : ESMF_Time, ESMF_Clock, ESMF_Calendar, ESMF_Alarm + use ESMF , only : ESMF_TimeGet, ESMF_TimeSet + use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet + use ESMF , only : ESMF_ClockGet, ESMF_AlarmCreate + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_LogSetError, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU + use ESMF , only : ESMF_RC_ARG_BAD + use ESMF , only : operator(<), operator(/=), operator(+), operator(-), operator(*) , operator(>=) + use ESMF , only : operator(<=), operator(>), operator(==) + + implicit none + private ! default private + + public :: AlarmInit ! initialize an alarm + + private :: TimeInit + private :: date2ymd + + ! Clock and alarm options + character(len=*), private, parameter :: & + optNONE = "none" , & + optNever = "never" , & + optNSteps = "nsteps" , & + optNStep = "nstep" , & + optNSeconds = "nseconds" , & + optNSecond = "nsecond" , & + optNMinutes = "nminutes" , & + optNMinute = "nminute" , & + optNHours = "nhours" , & + optNHour = "nhour" , & + optNDays = "ndays" , & + optNDay = "nday" , & + optNMonths = "nmonths" , & + optNMonth = "nmonth" , & + optNYears = "nyears" , & + optNYear = "nyear" , & + optMonthly = "monthly" , & + optYearly = "yearly" , & + optDate = "date" , & + optIfdays0 = "ifdays0" , & + optGLCCouplingPeriod = "glc_coupling_period" + + ! Module data + integer, parameter :: SecPerDay = 86400 ! Seconds per day + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine AlarmInit( clock, alarm, option, & + opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) + + ! !DESCRIPTION: Setup an alarm in a clock + ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm + ! time. If you send an arbitrary but proper ringtime from the + ! past and the ring interval, the alarm will always go off on the + ! next clock advance and this will cause serious problems. Even + ! if it makes sense to initialize an alarm with some reference + ! time and the alarm interval, that reference time has to be + ! advance forward to be >= the current time. In the logic below + ! we set an appropriate "NextAlarm" and then we make sure to + ! advance it properly based on the ring interval. + + ! input/output variables + type(ESMF_Clock) , intent(inout) :: clock ! clock + type(ESMF_Alarm) , intent(inout) :: alarm ! alarm + character(len=*) , intent(in) :: option ! alarm option + integer , optional , intent(in) :: opt_n ! alarm freq + integer , optional , intent(in) :: opt_ymd ! alarm ymd + integer , optional , intent(in) :: opt_tod ! alarm tod (sec) + type(ESMF_Time) , optional , intent(in) :: RefTime ! ref time + character(len=*) , optional , intent(in) :: alarmname ! alarm name + integer , intent(inout) :: rc ! Return code + + ! local variables + type(ESMF_Calendar) :: cal ! calendar + integer :: lymd ! local ymd + integer :: ltod ! local tod + integer :: cyy,cmm,cdd,csec ! time info + integer :: nyy,nmm,ndd,nsec ! time info + character(len=64) :: lalarmname ! local alarm name + logical :: update_nextalarm ! update next alarm + type(ESMF_Time) :: CurrTime ! Current Time + type(ESMF_Time) :: NextAlarm ! Next restart alarm time + type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval + character(len=*), parameter :: subname = '(AlarmInit): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lalarmname = 'alarm_unknown' + if (present(alarmname)) lalarmname = trim(alarmname) + ltod = 0 + if (present(opt_tod)) ltod = opt_tod + lymd = -1 + if (present(opt_ymd)) lymd = opt_ymd + + ! verify parameters + if (trim(option) == optNSteps .or. trim(option) == optNStep .or. & + trim(option) == optNSeconds .or. trim(option) == optNSecond .or. & + trim(option) == optNMinutes .or. trim(option) == optNMinute .or. & + trim(option) == optNHours .or. trim(option) == optNHour .or. & + trim(option) == optNDays .or. trim(option) == optNDay .or. & + trim(option) == optNMonths .or. trim(option) == optNMonth .or. & + trim(option) == optNYears .or. trim(option) == optNYear .or. & + trim(option) == optIfdays0) then + if (.not. present(opt_n)) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' requires opt_n', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + if (opt_n <= 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' invalid opt_n', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + endif + + call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + call ESMF_TimeGet(CurrTime, yy=nyy, mm=nmm, dd=ndd, s=nsec, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + ! initial guess of next alarm, this will be updated below + if (present(RefTime)) then + NextAlarm = RefTime + else + NextAlarm = CurrTime + endif + + ! Determine calendar + call ESMF_ClockGet(clock, calendar=cal, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + ! Determine inputs for call to create alarm + selectcase (trim(option)) + + case (optNONE, optNever) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .false. + + case (optDate) + if (.not. present(opt_ymd)) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' requires opt_ymd', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + if (lymd < 0 .or. ltod < 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//'opt_ymd, opt_tod invalid', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call TimeInit(NextAlarm, lymd, cal, tod=ltod, desc="optDate", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .false. + + case (optIfdays0) + if (.not. present(opt_ymd)) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' requires opt_ymd', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=opt_n, s=0, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .true. + + case (optNSteps, optNStep) + call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNSeconds, optNSecond) + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMinutes, optNMinute) + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNHours, optNHour) + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNDays, optNDay) + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMonths, optNMonth) + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optMonthly) + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .true. + + case (optNYears, optNYear) + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optYearly) + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .true. + + case default + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//' unknown option: '//trim(option), & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + + end select + + ! -------------------------------------------------------------------------------- + ! --- AlarmInterval and NextAlarm should be set --- + ! -------------------------------------------------------------------------------- + + ! --- advance Next Alarm so it won't ring on first timestep for + ! --- most options above. go back one alarminterval just to be careful + + if (update_nextalarm) then + NextAlarm = NextAlarm - AlarmInterval + do while (NextAlarm <= CurrTime) + NextAlarm = NextAlarm + AlarmInterval + enddo + endif + + alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, ringInterval=AlarmInterval, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + end subroutine AlarmInit + + !=============================================================================== + + subroutine TimeInit( Time, ymd, cal, tod, desc, logunit, rc) + + ! Create the ESMF_Time object corresponding to the given input time, given in + ! YMD (Year Month Day) and TOD (Time-of-day) format. + ! Set the time by an integer as YYYYMMDD and integer seconds in the day + + ! input/output parameters: + type(ESMF_Time) , intent(inout) :: Time ! ESMF time + integer , intent(in) :: ymd ! year, month, day YYYYMMDD + type(ESMF_Calendar) , intent(in) :: cal ! ESMF calendar + integer , intent(in), optional :: tod ! time of day in seconds + character(len=*) , intent(in), optional :: desc ! description of time to set + integer , intent(in), optional :: logunit + integer , intent(out), optional :: rc + + ! local varaibles + integer :: yr, mon, day ! Year, month, day as integers + integer :: ltod ! local tod + character(len=256) :: ldesc ! local desc + character(len=*), parameter :: subname = '(TimeInit) ' + !------------------------------------------------------------------------------- + + ltod = 0 + if (present(tod)) ltod = tod + ldesc = '' + if (present(desc)) ldesc = desc + + if ( (ymd < 0) .or. (ltod < 0) .or. (ltod > SecPerDay) )then + if (present(logunit)) then + write(logunit,*) subname//': ERROR yymmdd is a negative number or '// & + 'time-of-day out of bounds', ymd, ltod + end if + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//' yymmdd is negative or time-of-day out of bounds ', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + + call date2ymd (ymd,yr,mon,day) + + call ESMF_TimeSet( Time, yy=yr, mm=mon, dd=day, s=ltod, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + end subroutine TimeInit + + !=============================================================================== + + subroutine date2ymd (date, year, month, day) + + ! input/output variables + integer, intent(in) :: date ! coded-date (yyyymmdd) + integer, intent(out) :: year,month,day ! calendar year,month,day + + ! local variables + integer :: tdate ! temporary date + character(*),parameter :: subName = "(date2ymd)" + !------------------------------------------------------------------------------- + + tdate = abs(date) + year = int(tdate/10000) + if (date < 0) then + year = -year + end if + month = int( mod(tdate,10000)/ 100) + day = mod(tdate, 100) + + end subroutine date2ymd + +end module From 0a3335fb0ea95b595da9656ab8ec52a3aa799034 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Thu, 18 Oct 2018 15:16:48 -0400 Subject: [PATCH 0834/1072] Diag decimation prototype, decimation algorithm extension - This commit extends the proposed decimatipn algorithm to cover all the present diagnostics in the OM4_025 diag_table There may be more cases that need to be coded up later --- src/framework/MOM_diag_mediator.F90 | 364 ++++++++++++++++++++-------- 1 file changed, 265 insertions(+), 99 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index bed00b2355..0fe947423a 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -142,6 +142,25 @@ module MOM_diag_mediator type(diag_grids_type), dimension(:), allocatable :: diag_grids !< Primarily empty, except h field end type diag_grid_storage +!> integers to encode the total cell methods +integer :: PPP=0 !< x:point,y:point,z:point +integer :: PPS=1 !< x:point,y:point,z:sum +integer :: PPM=2 !< x:point,y:point,z:mean +integer :: PSP=10 !< x:point,y:sum,z:point +integer :: PSS=11 !< x:point,y:sum,z:point +integer :: PSM=12 !< x:point,y:sum,z:mean +integer :: PMP=20 !< x:point,y:mean,z:point +integer :: PMM=22 !< x:point,y:mean,z:mean +integer :: SPP=100 !< x:sum,y:point,z:point +integer :: SPS=101 !< x:sum,y:point,z:sum +integer :: SSP=110 !< x:sum;y:sum,z:point +integer :: MPP=200 !< x:mean,y:point,z:point +integer :: MPM=202 !< x:mean,y:point,z:mean +integer :: MMP=220 !< x:mean,y:mean,z:point +integer :: MMS=221 !< x:mean,y:mean,z:sum +integer :: SSS=111 !< x:sum,y:sum,z:sum +integer :: MMM=222 !< x:mean,y:mean,z:mean + !> This type is used to represent a diagnostic at the diag_mediator level. !! !! There can be both 'primary' and 'seconday' diagnostics. The primaries @@ -160,6 +179,8 @@ module MOM_diag_mediator real :: conversion_factor = 0. !< A factor to multiply data by before posting to FMS, if non-zero. logical :: v_extensive = .false. !< True for vertically extensive fields (vertically integrated). !! False for intensive (concentrations). + integer :: xyz_method = 0 !< A 3 digit integer encoding the diagnostics cell method + !! It can be used to determine the decimation algorithm end type diag_type type diagcs_decim @@ -290,8 +311,6 @@ module MOM_diag_mediator end type diag_ctrl - - ! CPU clocks integer :: id_clock_diag_mediator, id_clock_diag_remap, id_clock_diag_grid_updates @@ -1246,7 +1265,7 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) real, optional,target, intent(in) :: mask(:,:) !< If present, use this real array as the data mask. ! Local variables - real, dimension(:,:), pointer :: locfield => NULL() + real, dimension(:,:), pointer :: locfield real, dimension(:,:), pointer :: locmask character(len=300) :: mesg logical :: used, is_stat @@ -1256,6 +1275,7 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) real, dimension(:,:), allocatable, target :: locmask_decim integer :: dl + locfield => NULL() locmask => NULL() is_stat = .false. ; if (present(is_static)) is_stat = is_static @@ -1326,13 +1346,15 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) if (present(mask)) then locmask => mask - elseif(associated(diag%axes%mask2d)) then - locmask => diag%axes%mask2d + elseif(.NOT. is_stat) then + if(associated(diag%axes%mask2d)) locmask => diag%axes%mask2d endif - dl = diag%axes%decimation_level + dl=1 + if(.NOT. is_stat) dl = diag%axes%decimation_level if (dl > 1) then call decimate_diag_field(locfield, locfield_decim, dl, diag_cs, diag,isv,iev,jsv,jev, mask) + if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) deallocate( locfield ) locfield => locfield_decim if (present(mask)) then call decimate_mask(locmask, locmask_decim, dl) @@ -1375,7 +1397,7 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) endif endif endif - if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) & + if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.) .and. dl<2) & deallocate( locfield ) end subroutine post_data_2d_low @@ -1509,7 +1531,7 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) real, optional,target, intent(in) :: mask(:,:,:) !< If present, use this real array as the data mask. ! Local variables - real, dimension(:,:,:), pointer :: locfield => NULL() + real, dimension(:,:,:), pointer :: locfield real, dimension(:,:,:), pointer :: locmask character(len=300) :: mesg logical :: used ! The return value of send_data is not used for anything. @@ -1522,6 +1544,7 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) real, dimension(:,:,:), allocatable, target :: locmask_decim integer :: isl,iel,jsl,jel,dl + locfield => NULL() locmask => NULL() is_stat = .false. ; if (present(is_static)) is_stat = is_static @@ -1599,9 +1622,11 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) locmask => diag%axes%mask3d endif - dl = diag%axes%decimation_level + dl=1 + if(.NOT. is_stat) dl = diag%axes%decimation_level if (dl > 1) then call decimate_diag_field(locfield, locfield_decim, dl, diag_cs, diag,isv,iev,jsv,jev, mask) + if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) deallocate( locfield ) locfield => locfield_decim if (present(mask)) then call decimate_mask(locmask, locmask_decim, dl) @@ -1644,7 +1669,7 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) endif endif endif - if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) & + if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.) .and. dl<2) & deallocate( locfield ) end subroutine post_data_3d_low @@ -2077,7 +2102,7 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, if (fms_id /= DIAG_FIELD_NOT_FOUND .or. fms_xyave_id /= DIAG_FIELD_NOT_FOUND) then call add_diag_to_list(diag_cs, dm_id, fms_id, this_diag, axes, module_name, field_name, msg) this_diag%fms_xyave_diag_id = fms_xyave_id - + call add_xyz_method(this_diag, axes, x_cell_method, y_cell_method, v_cell_method, v_extensive) if (present(v_extensive)) this_diag%v_extensive = v_extensive if (present(conversion)) this_diag%conversion_factor = conversion register_diag_field_expand_cmor = .true. @@ -2137,7 +2162,7 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, if (fms_id /= DIAG_FIELD_NOT_FOUND .or. fms_xyave_id /= DIAG_FIELD_NOT_FOUND) then call add_diag_to_list(diag_cs, dm_id, fms_id, this_diag, axes, module_name, field_name, msg) this_diag%fms_xyave_diag_id = fms_xyave_id - + call add_xyz_method(this_diag, axes, x_cell_method, y_cell_method, v_cell_method, v_extensive) if (present(v_extensive)) this_diag%v_extensive = v_extensive if (present(conversion)) this_diag%conversion_factor = conversion register_diag_field_expand_cmor = .true. @@ -2273,6 +2298,67 @@ subroutine add_diag_to_list(diag_cs, dm_id, fms_id, this_diag, axes, module_name end subroutine add_diag_to_list +subroutine add_xyz_method(diag, axes, x_cell_method, y_cell_method, v_cell_method, v_extensive) + type(diag_type), pointer :: diag !< This diagnostic + type(axes_grp), intent(in) :: axes !< Container w/ up to 3 integer handles that indicates + !! axes for this field + character(len=*), optional, intent(in) :: x_cell_method !< Specifies the cell method for the x-direction. + !! Use '' have no method. + character(len=*), optional, intent(in) :: y_cell_method !< Specifies the cell method for the y-direction. + !! Use '' have no method. + character(len=*), optional, intent(in) :: v_cell_method !< Specifies the cell method for the vertical direction. + !! Use '' have no method. + logical, optional, intent(in) :: v_extensive !< True for vertically extensive fields + !! (vertically integrated). Default/absent for intensive. + integer :: xyz_method + character(len=9) :: mstr + + !This is a simple way to encode the cell method information made from 3 strings + !(x_cell_method,y_cell_method,v_cell_method) in a 3 digit integer xyz + !x_cell_method,y_cell_method,v_cell_method can each be 'point' or 'sum' or 'mean' + !We can encode these with setting 0 for 'point', 1 for 'sum, 2 for 'mean' in + !the 100s position for x, 10s position for y, 1s position for z + !E.g., x:sum,y:point,z:mean is 102 + + xyz_method = 0 + + mstr = diag%axes%v_cell_method + if (present(v_extensive)) then + if (present(v_cell_method)) call MOM_error(FATAL, "attach_cell_methods: " // & + 'Vertical cell method was specified along with the vertically extensive flag.') + if(v_extensive) then + mstr='sum' + else + mstr='mean' + endif + elseif (present(v_cell_method)) then + mstr = v_cell_method + endif + if (trim(mstr)=='sum') then + xyz_method = xyz_method + 1 + elseif (trim(mstr)=='mean') then + xyz_method = xyz_method + 2 + endif + + mstr = diag%axes%y_cell_method + if (present(y_cell_method)) mstr = y_cell_method + if (trim(mstr)=='sum') then + xyz_method = xyz_method + 10 + elseif (trim(mstr)=='mean') then + xyz_method = xyz_method + 20 + endif + + mstr = diag%axes%x_cell_method + if (present(x_cell_method)) mstr = x_cell_method + if (trim(mstr)=='sum') then + xyz_method = xyz_method + 100 + elseif (trim(mstr)=='mean') then + xyz_method = xyz_method + 200 + endif + + diag%xyz_method = xyz_method +end subroutine add_xyz_method + !> Attaches "cell_methods" attribute to a variable based on defaults for axes_grp or optional arguments. subroutine attach_cell_methods(id, axes, ostring, cell_methods, & x_cell_method, y_cell_method, v_cell_method, v_extensive) @@ -2360,6 +2446,7 @@ subroutine attach_cell_methods(id, axes, ostring, cell_methods, & ostring = trim(adjustl(ostring))//' '//trim(axis_name)//':'//trim(v_cell_method) endif elseif (present(v_extensive)) then + if(v_extensive) then if (axes%rank==1) then call get_diag_axis_name(axes%handles(1), axis_name) elseif (axes%rank==3) then @@ -2367,6 +2454,7 @@ subroutine attach_cell_methods(id, axes, ostring, cell_methods, & endif call diag_field_add_attribute(id, 'cell_methods', trim(axis_name)//':sum') ostring = trim(adjustl(ostring))//' '//trim(axis_name)//':sum' + endif else if (len(trim(axes%v_cell_method))>0) then if (axes%rank==1) then @@ -3445,7 +3533,7 @@ subroutine decimate_diag_field_3d(locfield, locfield_decim, dl, diag_cs, diag,is real, optional,target, intent(in) :: mask(:,:,:) !< If present, use this real array as the data mask. !locals real, dimension(:,:,:), pointer :: locmask - integer :: isl,iel,jsl,jel, xy_method + integer :: isl,iel,jsl,jel locmask => NULL() !Get the correct indices corresponding to input field @@ -3462,27 +3550,8 @@ subroutine decimate_diag_field_3d(locfield, locfield_decim, dl, diag_cs, diag,is else call MOM_error(FATAL, "decimate_diag_field_3d: Cannot decimate without a mask!!! ") endif - !Determine the decimation method - !Make a two digit integer case id = x_case*10+y_case where x_case and/or y_case is 1 for sum and 2 for mean - xy_method = 0 !subsample and pick the SW corner value - if (trim(diag%axes%y_cell_method)=='sum') then - xy_method = xy_method + 1 - elseif (trim(diag%axes%y_cell_method)=='mean') then - xy_method = xy_method + 2 - endif - if (trim(diag%axes%x_cell_method)=='sum') then - xy_method = xy_method + 10 - elseif (trim(diag%axes%x_cell_method)=='mean') then - xy_method = xy_method + 20 - endif -! if (trim(diag%axes%area_cell_method)=='sum') then -! xy_method = xy_method + 100 -! elseif (trim(diag%axes%area_cell_method)=='mean') then -! xy_method = xy_method + 200 -! endif - - call decimate_field(locfield, locfield_decim, dl, xy_method, locmask, diag_cs) + call decimate_field(locfield, locfield_decim, dl, diag%xyz_method, locmask, diag_cs, diag) end subroutine decimate_diag_field_3d @@ -3496,7 +3565,7 @@ subroutine decimate_diag_field_2d(locfield, locfield_decim, dl, diag_cs, diag,is real, optional,target, intent(in) :: mask(:,:) !< If present, use this real array as the data mask. !locals real, dimension(:,:), pointer :: locmask - integer :: isl,iel,jsl,jel, xy_method + integer :: isl,iel,jsl,jel locmask => NULL() !Get the correct indices corresponding to input field @@ -3513,36 +3582,45 @@ subroutine decimate_diag_field_2d(locfield, locfield_decim, dl, diag_cs, diag,is else call MOM_error(FATAL, "decimate_diag_field_2d: Cannot decimate without a mask!!! ") endif - !Determine the decimation method - !Make a two digit integer case id = x_case*10+y_case where x_case and/or y_case is 1 for sum and 2 for mean - xy_method = 0 !subsample and pick the SW corner value - if (trim(diag%axes%y_cell_method)=='sum') then - xy_method = xy_method + 1 - elseif (trim(diag%axes%y_cell_method)=='mean') then - xy_method = xy_method + 2 - endif - if (trim(diag%axes%x_cell_method)=='sum') then - xy_method = xy_method + 10 - elseif (trim(diag%axes%x_cell_method)=='mean') then - xy_method = xy_method + 20 - endif -! if (trim(diag%axes%area_cell_method)=='sum') then -! xy_method = xy_method + 100 -! elseif (trim(diag%axes%area_cell_method)=='mean') then -! xy_method = xy_method + 200 -! endif - call decimate_field(locfield, locfield_decim, dl, xy_method, locmask, diag_cs) + call decimate_field(locfield, locfield_decim, dl, diag%xyz_method, locmask, diag_cs,diag) end subroutine decimate_diag_field_2d -subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs) + +!- According to Alistair, the decimation method could be solely deduced +! from the axes%x_cell_method, axes%y_cell_method and probably the area_cell_method +! at the time of send_data +!- This is the summary of the algoritm +! f(Id,Jd) = \sum_{i,j} f(Id+i,Jd+j) * weight(Id+i,Jd+j) / [ \sum_{i,j} weight(Id+i,Jd+j)] +! Id,Jd are the decimated (coarse grid) indices run over the coarsened compute grid, +! i and j run from 0 to dl-1 (dl being the decimation level) +! if and jf +! weight(if,jf) run over the original fine computre grid +! +!example x_cell y_cell ?_cell weight impemented weight(if,jf) algorithm_id +!--------------------------------------------------------------------------------------- +!theta mean mean mean A*h A(if,jf)*h(if,jf) 22 +!u point mean mean dy*h dyCu(if,jf)*h(if,jf)*delta(if,Id) 02 +!v mean point mean dx*h dxCv(if,jf)*h(if,jf)*delta(jf,Jd) 20 +!volcello sum sum sum 1 1 11 +!umo point sum sum 1 1*delta(if,Id) 01 +!? sum point sum 1 1*delta(jf,Jd) 10 +!w mean mean point A N/A +!h*theta mean mean sum A N/A +! +!delta is the Kroneker delta +!Niki: I am not sure if he meant area_cell_method or z_cell_method for the 4th column +!Niki: I have not used the 4th column at all!!! + +subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs, diag) real, dimension(:,:,:) , pointer :: field_in real, dimension(:,:,:) , allocatable :: field_out integer , intent(in) :: dl integer, optional, intent(in) :: method !< sampling method, one of 00,01,02,10,20,11,22 real, dimension(:,:,:), pointer :: mask type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output + type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post !locals character(len=240) :: mesg integer :: i,j,ii,jj,is,js,i0,j0 @@ -3553,50 +3631,65 @@ subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs) !Always start from the first element is=1 js=1 - ks = lbound(field_in,3) ; ke = ubound(field_in,3) + ks=1 ; ke =size(field_in,3) isl=1; iel=size(field_in,1)/dl jsl=1; jel=size(field_in,2)/dl allocate(field_out(isl:iel,jsl:jel,ks:ke)) - if(method .eq. 0) then !point average the fields in dl^2 cells + if(method .eq. MMM) then !xyz_method = MMM = 222 do k= ks,ke ; do j=jsl,jel ; do i=isl,iel i0 = is+dl*(i-isl) j0 = js+dl*(j-jsl) ave = 0.0 total_weight = 0.0 do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 - total_weight = total_weight + mask(ii,jj,k) - ave=ave+field_in(ii,jj,k)*mask(ii,jj,k) + weight = mask(ii,jj,k)*diag_cs%G%areaT(ii,jj)*diag_cs%h(ii,jj,k) + total_weight = total_weight + weight + ave=ave+field_in(ii,jj,k)*weight enddo; enddo - field_out(i,j,k) = ave/max(1.0,total_weight) !Avoid zero mask at all aggregating cells where ave=0.0 + field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo - elseif(method .eq. 1) then !point in x, sum in y + elseif(method .eq. SSS) then !xyz_method = SSS = 111 e.g., volcello do k= ks,ke ; do j=jsl,jel ; do i=isl,iel i0 = is+dl*(i-isl) j0 = js+dl*(j-jsl) ave = 0.0 total_weight = 0.0 - ii=i0 - do jj=j0,j0+dl-1 - total_weight = total_weight + mask(ii,jj,k) - ave=ave+field_in(ii,jj,k)*mask(ii,jj,k) - enddo + do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 + weight = mask(ii,jj,k) + total_weight = total_weight + weight + ave=ave+field_in(ii,jj,k)*weight + enddo; enddo field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo - elseif(method .eq. 10) then !sum in x, point in y + elseif(method .eq. MMP .or. method .eq. MMS) then !xyz_method = MMP = 220, e.g., or T_advection_xy do k= ks,ke ; do j=jsl,jel ; do i=isl,iel i0 = is+dl*(i-isl) j0 = js+dl*(j-jsl) ave = 0.0 total_weight = 0.0 - jj=j0 - do ii=i0,i0+dl-1 - total_weight = total_weight + mask(ii,jj,k) - ave=ave+field_in(ii,jj,k)*mask(ii,jj,k) + do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 + weight = mask(ii,jj,k)*diag_cs%G%areaT(ii,jj) + total_weight = total_weight + weight + ave=ave+field_in(ii,jj,k)*weight + enddo; enddo + field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo; enddo; enddo + elseif(method .eq. PMM) then !xyz_method = PMM = 022 + do k= ks,ke ; do j=jsl,jel ; do i=isl,iel + i0 = is+dl*(i-isl) + j0 = js+dl*(j-jsl) + ave = 0.0 + total_weight = 0.0 + ii=i0 + do jj=j0,j0+dl-1 + weight =mask(ii,jj,k)*diag_cs%G%dyCu(ii,jj)*diag_cs%h(ii,jj,k) + total_weight = total_weight +weight + ave=ave+field_in(ii,jj,k)*weight enddo field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo - elseif(method .eq. 2) then !point in x, normal area average in y + elseif(method .eq. PSM) then !xyz_method = PSM = 012 do k= ks,ke ; do j=jsl,jel ; do i=isl,iel i0 = is+dl*(i-isl) j0 = js+dl*(j-jsl) @@ -3610,59 +3703,63 @@ subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs) enddo field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo - elseif(method .eq. 20) then !normal area average in x, point in y + elseif(method .eq. PSS) then !xyz_method = PSS = 011 e.g. umo do k= ks,ke ; do j=jsl,jel ; do i=isl,iel i0 = is+dl*(i-isl) j0 = js+dl*(j-jsl) ave = 0.0 total_weight = 0.0 - jj=j0 - do ii=i0,i0+dl-1 - weight = mask(ii,jj,k)*diag_cs%G%dxCv(ii,jj)*diag_cs%h(ii,jj,k) - total_weight = total_weight + weight + ii=i0 + do jj=j0,j0+dl-1 + weight =mask(ii,jj,k) + total_weight = total_weight +weight ave=ave+field_in(ii,jj,k)*weight enddo field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo - elseif(method .eq. 22) then !Volume average the fields in x and y + elseif(method .eq. SPS) then !xyz_method = SPS = 101 e.g. vmo do k= ks,ke ; do j=jsl,jel ; do i=isl,iel i0 = is+dl*(i-isl) j0 = js+dl*(j-jsl) ave = 0.0 total_weight = 0.0 - do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 - weight = mask(ii,jj,k)*diag_cs%G%areaT(ii,jj)*diag_cs%h(ii,jj,k) - total_weight = total_weight + weight + jj=j0 + do ii=i0,i0+dl-1 + weight =mask(ii,jj,k) + total_weight = total_weight +weight ave=ave+field_in(ii,jj,k)*weight - enddo; enddo + enddo field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo - elseif(method .eq. 11) then !sum the fields in x and y + elseif(method .eq. MPM) then !xyz_method = MPM = 202 do k= ks,ke ; do j=jsl,jel ; do i=isl,iel i0 = is+dl*(i-isl) j0 = js+dl*(j-jsl) ave = 0.0 total_weight = 0.0 - do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 - total_weight = total_weight + mask(ii,jj,k) - ave=ave+field_in(ii,jj,k)*mask(ii,jj,k) - enddo; enddo + jj=j0 + do ii=i0,i0+dl-1 + weight = mask(ii,jj,k)*diag_cs%G%dxCv(ii,jj)*diag_cs%h(ii,jj,k) + total_weight = total_weight + weight + ave=ave+field_in(ii,jj,k)*weight + enddo field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 - enddo; enddo; enddo + enddo; enddo; enddo else write (mesg,*) " unknown sampling method: ",method - call MOM_error(FATAL, "decimate_field_3d: "//trim(mesg)) + call MOM_error(FATAL, "decimate_field_3d: "//trim(mesg)//" "//trim(diag%debug_str)) endif end subroutine decimate_field_3d -subroutine decimate_field_2d(field_in, field_out, dl, method, mask, diag_cs) +subroutine decimate_field_2d(field_in, field_out, dl, method, mask, diag_cs,diag) real, dimension(:,:) , pointer :: field_in real, dimension(:,:) , allocatable :: field_out integer , intent(in) :: dl integer, optional, intent(in) :: method !< sampling method, one of 00,01,02,10,20,11,22 real, dimension(:,:), pointer :: mask type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output + type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post !locals character(len=240) :: mesg integer :: i,j,ii,jj,is,js,i0,j0 @@ -3675,36 +3772,105 @@ subroutine decimate_field_2d(field_in, field_out, dl, method, mask, diag_cs) isl=1; iel=size(field_in,1)/dl jsl=1; jel=size(field_in,2)/dl allocate(field_out(isl:iel,jsl:jel)) - - if(method .eq. 0) then !point average the fields in dl^2 cells + + if(method .eq. MMM) then !xyz_method = MMM do j=jsl,jel ; do i=isl,iel i0 = is+dl*(i-isl) j0 = js+dl*(j-jsl) ave = 0.0 total_weight = 0.0 do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 - total_weight = total_weight + mask(ii,jj) - ave=ave+field_in(ii,jj)*mask(ii,jj) + weight = mask(ii,jj)*diag_cs%G%areaT(ii,jj)*diag_cs%h(ii,jj,1) + total_weight = total_weight + weight + ave=ave+field_in(ii,jj)*weight enddo; enddo - field_out(i,j) = ave/max(1.0,total_weight) !Avoid zero mask at all aggregating cells where ave=0.0 + field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo - elseif(method .eq. 22) then !Volume average the fields in x and y + elseif(method .eq. MMP) then !xyz_method = MMP do j=jsl,jel ; do i=isl,iel i0 = is+dl*(i-isl) j0 = js+dl*(j-jsl) ave = 0.0 total_weight = 0.0 do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 - weight = mask(ii,jj)*diag_cs%G%areaT(ii,jj)*diag_cs%h(ii,jj,1) - total_weight = total_weight + weight + weight = mask(ii,jj)*diag_cs%G%areaT(ii,jj) + total_weight = total_weight + weight ave=ave+field_in(ii,jj)*weight enddo; enddo field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo - + elseif(method .eq. SSP) then !xyz_method = SSP , e.g., T_dfxy_cont_tendency_2d + do j=jsl,jel ; do i=isl,iel + i0 = is+dl*(i-isl) + j0 = js+dl*(j-jsl) + ave = 0.0 + total_weight = 0.0 + do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 + weight = mask(ii,jj) + total_weight = total_weight + weight + ave=ave+field_in(ii,jj)*weight + enddo; enddo + field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo; enddo + elseif(method .eq. PSP) then !xyz_method = PSP = 010, e.g., umo_2d + do j=jsl,jel ; do i=isl,iel + i0 = is+dl*(i-isl) + j0 = js+dl*(j-jsl) + ave = 0.0 + total_weight = 0.0 + ii=i0 + do jj=j0,j0+dl-1 + weight =mask(ii,jj) + total_weight = total_weight +weight + ave=ave+field_in(ii,jj)*weight + enddo + field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo; enddo + elseif(method .eq. SPP) then !xyz_method = SPP = 100, e.g., vmo_2d + do j=jsl,jel ; do i=isl,iel + i0 = is+dl*(i-isl) + j0 = js+dl*(j-jsl) + ave = 0.0 + total_weight = 0.0 + jj=j0 + do ii=i0,i0+dl-1 + weight =mask(ii,jj) + total_weight = total_weight +weight + ave=ave+field_in(ii,jj)*weight + enddo + field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo; enddo + elseif(method .eq. PMP) then !xyz_method = PMP = 020 + do j=jsl,jel ; do i=isl,iel + i0 = is+dl*(i-isl) + j0 = js+dl*(j-jsl) + ave = 0.0 + total_weight = 0.0 + ii=i0 + do jj=j0,j0+dl-1 + weight =mask(ii,jj)*diag_cs%G%dyCu(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? + total_weight = total_weight +weight + ave=ave+field_in(ii,jj)*weight + enddo + field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo; enddo + elseif(method .eq. MPP) then !xyz_method = MPP = 200 + do j=jsl,jel ; do i=isl,iel + i0 = is+dl*(i-isl) + j0 = js+dl*(j-jsl) + ave = 0.0 + total_weight = 0.0 + jj=j0 + do ii=i0,i0+dl-1 + weight =mask(ii,jj)*diag_cs%G%dxCv(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? + total_weight = total_weight +weight + ave=ave+field_in(ii,jj)*weight + enddo + field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 + enddo; enddo else write (mesg,*) " unknown sampling method: ",method - call MOM_error(FATAL, "decimate_field_2d: "//trim(mesg)) + call MOM_error(FATAL, "decimate_field_2d: "//trim(mesg)//" "//trim(diag%debug_str)) endif end subroutine decimate_field_2d From e55e0c27c72f728f0ee8ec54acfad0963b8ddbb1 Mon Sep 17 00:00:00 2001 From: Rocky Dunlap Date: Thu, 18 Oct 2018 14:47:17 -0600 Subject: [PATCH 0835/1072] Remove trailing whitespace in two files --- config_src/nuopc_driver/mom_cap.F90 | 156 +++++++++++------------ config_src/nuopc_driver/mom_cap_time.F90 | 84 ++++++------ 2 files changed, 120 insertions(+), 120 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index d638b82b94..eb8c003945 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -404,9 +404,9 @@ module mom_cap_mod use, intrinsic :: iso_fortran_env, only: output_unit - use ESMF - use NUOPC - use NUOPC_Model, & + use ESMF + use NUOPC + use NUOPC_Model, & model_routine_SS => SetServices, & model_label_Advance => label_Advance, & model_label_DataInitialize => label_DataInitialize, & @@ -456,7 +456,7 @@ module mom_cap_mod logical :: grid_attach_area = .false. character(len=128) :: scalar_field_name integer :: scalar_field_count - integer :: scalar_field_idx_grid_nx + integer :: scalar_field_idx_grid_nx integer :: scalar_field_idx_grid_ny character(len=*),parameter :: u_file_u = & __FILE__ @@ -578,23 +578,23 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + write_diagnostics = .false. call NUOPC_CompAttributeGet(gcomp, name="DumpFields", value=value, & isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) write_diagnostics=(trim(value)=="true") - + write(logmsg,*) write_diagnostics call ESMF_LogWrite('mom_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return profile_memory = .false. call NUOPC_CompAttributeGet(gcomp, name="ProfileMemory", value=value, & @@ -602,14 +602,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) profile_memory=(trim(value)=="true") write(logmsg,*) profile_memory call ESMF_LogWrite('mom_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return grid_attach_area = .false. call NUOPC_CompAttributeGet(gcomp, name="GridAttachArea", value=value, & @@ -617,14 +617,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) grid_attach_area=(trim(value)=="true") write(logmsg,*) grid_attach_area call ESMF_LogWrite('mom_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return scalar_field_name = "" call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=value, & @@ -632,14 +632,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - if (isPresent .and. isSet) then + return + if (isPresent .and. isSet) then scalar_field_name = trim(value) call ESMF_LogWrite('mom_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_count = 0 @@ -648,7 +648,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_count if (iostat /= 0) then @@ -662,7 +662,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_idx_grid_nx = 0 @@ -671,7 +671,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_nx if (iostat /= 0) then @@ -685,7 +685,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_idx_grid_ny = 0 @@ -694,7 +694,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny if (iostat /= 0) then @@ -708,16 +708,16 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - call NUOPC_CompAttributeAdd(gcomp, & + call NUOPC_CompAttributeAdd(gcomp, & attrList=(/'RestartFileToRead', 'RestartFileToWrite'/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + end subroutine !=============================================================================== @@ -774,7 +774,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return allocate(Ice_ocean_boundary) !allocate(ocean_state) ! ocean_model_init allocate this pointer @@ -827,11 +827,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! rsd need to figure out how to get this without share code !call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - !inst_name = "OCN"//trim(inst_suffix) + !inst_name = "OCN"//trim(inst_suffix) ! reset shr logging to my log file if (is_root_pe()) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & isPresent=isPresentDiro, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -842,7 +842,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresentDiro .and. isPresentLogfile) then open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) else @@ -853,7 +853,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) endif starttype = "" - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -867,7 +867,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif runtype = "" @@ -881,7 +881,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//": unknown starttype - "//trim(starttype), & line=__LINE__, file=__FILE__, rcToReturn=rc) - return + return endif if (len_trim(runtype) > 0) then @@ -889,9 +889,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - + restartfile = "" if (runtype == "initial") then ! startup (new run) - 'n' is needed below if we don't specify input_filename in input.nml @@ -914,36 +914,36 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - + call NUOPC_CompAttributeGet(gcomp, name='RestartFileToRead', & value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then restartfile = trim(cvalue) call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return else - call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & + call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & ESMF_LOGMSG_WARNING, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif end if - + ocean_public%is_ocean_pe = .true. if (len_trim(restartfile) > 0) then - call ocean_model_init(ocean_public, ocean_state, Time, Time, & + call ocean_model_init(ocean_public, ocean_state, Time, Time, & input_restart_file=trim(restartfile)) else call ocean_model_init(ocean_public, ocean_state, Time, Time) @@ -1008,7 +1008,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx @@ -1020,7 +1020,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - + ! EMC fields not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn @@ -1037,7 +1037,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") @@ -1105,7 +1105,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! not in EMC call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! not in EMC ! EMC fields not used @@ -1115,7 +1115,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Optional CESM fields currently not used ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen" , "will provide") ! not in EMC ! if (flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") ! end if @@ -1303,7 +1303,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + !--------------------------------- ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total !--------------------------------- @@ -1324,7 +1324,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return - + !--------------------------------- ! get start and end indices of each tile and their PET !--------------------------------- @@ -1339,10 +1339,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return enddo end if - + !--------------------------------- ! create delayout and distgrid @@ -1425,7 +1425,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1437,9 +1437,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return deallocate(IndexList) - + !--------------------------------- ! create grid !--------------------------------- @@ -1730,7 +1730,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & scalar_field_name, scalar_field_count, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1783,7 +1783,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! line=__LINE__, & ! file=__FILE__)) & ! return ! bail out - + end subroutine InitializeRealize !=============================================================================== @@ -2081,7 +2081,7 @@ subroutine ModelAdvance(gcomp, rc) mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) + + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) enddo enddo dataPtr_mzmf = mzmf @@ -2177,26 +2177,26 @@ subroutine ModelAdvance(gcomp, rc) deallocate(ocz, ocm) #endif - + ! If restart alarm is ringing - write restart file call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmRingerOff(alarm, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + ! call into system specific method to get desired restart filename restartname = "" call ESMF_MethodExecute(gcomp, label="GetRestartFileToWrite", & @@ -2230,7 +2230,7 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out endif endif - + if (len_trim(restartname) == 0) then ! none provided, so use a default restart filename call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) @@ -2244,7 +2244,7 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & + write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & "ocn", year, month, day, hour, minute, seconds call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -2252,15 +2252,15 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out endif - + ! write restart file(s) call ocean_model_restart(ocean_state, restartname=restartname) - + if (is_root_pe()) then write(logunit,*) subname//' writing restart file ',trim(restartname) end if endif - + if (write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & timeslice=export_slice, relaxedFlag=.true., rc=rc) @@ -2270,9 +2270,9 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out export_slice = export_slice + 1 endif - + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") - + end subroutine ModelAdvance !=============================================================================== @@ -2354,9 +2354,9 @@ subroutine ModelSetRunClock(gcomp, rc) return ! bail out if (first_time) then - !-------------------------------- + !-------------------------------- ! set restart alarm - !-------------------------------- + !-------------------------------- ! defaults restart_n = 0 @@ -2390,7 +2390,7 @@ subroutine ModelSetRunClock(gcomp, rc) else restart_option = "none" endif - + call AlarmInit(mclock, & alarm = restart_alarm, & option = trim(restart_option), & @@ -2402,21 +2402,21 @@ subroutine ModelSetRunClock(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out first_time = .false. - - call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & + + call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + end if !-------------------------------- @@ -2537,7 +2537,7 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ integer, intent(in) :: scalar_id type(ESMF_State), intent(inout) :: State integer, intent(in) :: mytask - character(len=*), intent(in) :: scalar_name + character(len=*), intent(in) :: scalar_name integer, intent(in) :: scalar_count integer, intent(inout) :: rc @@ -2635,14 +2635,14 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + ! initialize to zero call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - fldptr = 0.0 + fldptr = 0.0 endif diff --git a/config_src/nuopc_driver/mom_cap_time.F90 b/config_src/nuopc_driver/mom_cap_time.F90 index c85d68b1ae..7da3cf842d 100644 --- a/config_src/nuopc_driver/mom_cap_time.F90 +++ b/config_src/nuopc_driver/mom_cap_time.F90 @@ -2,17 +2,17 @@ ! This was originally share code in CIME, but required CIME as a ! dependency to build the MOM cap. The options here for setting ! a restart alarm are useful for all caps, so a second step is to -! determine if/how these could be offered more generally in a -! shared library. For now we really want the MOM cap to only +! determine if/how these could be offered more generally in a +! shared library. For now we really want the MOM cap to only ! depend on MOM and ESMF/NUOPC. ! -module mom_cap_time +module mom_cap_time ! !USES: - use ESMF , only : ESMF_Time, ESMF_Clock, ESMF_Calendar, ESMF_Alarm + use ESMF , only : ESMF_Time, ESMF_Clock, ESMF_Calendar, ESMF_Alarm use ESMF , only : ESMF_TimeGet, ESMF_TimeSet use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet - use ESMF , only : ESMF_ClockGet, ESMF_AlarmCreate + use ESMF , only : ESMF_ClockGet, ESMF_AlarmCreate use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO use ESMF , only : ESMF_LogSetError, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU use ESMF , only : ESMF_RC_ARG_BAD @@ -122,14 +122,14 @@ subroutine AlarmInit( clock, alarm, option, & msg=subname//trim(option)//' requires opt_n', & line=__LINE__, & file=__FILE__, rcToReturn=rc) - return + return end if if (opt_n <= 0) then call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//trim(option)//' invalid opt_n', & line=__LINE__, & file=__FILE__, rcToReturn=rc) - return + return end if endif @@ -137,21 +137,21 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return call ESMF_TimeGet(CurrTime, yy=nyy, mm=nmm, dd=ndd, s=nsec, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return - ! initial guess of next alarm, this will be updated below + ! initial guess of next alarm, this will be updated below if (present(RefTime)) then NextAlarm = RefTime else @@ -163,8 +163,8 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + ! Determine inputs for call to create alarm selectcase (trim(option)) @@ -173,12 +173,12 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return update_nextalarm = .false. case (optDate) @@ -187,25 +187,25 @@ subroutine AlarmInit( clock, alarm, option, & msg=subname//trim(option)//' requires opt_ymd', & line=__LINE__, & file=__FILE__, rcToReturn=rc) - return + return end if if (lymd < 0 .or. ltod < 0) then call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//trim(option)//'opt_ymd, opt_tod invalid', & line=__LINE__, & file=__FILE__, rcToReturn=rc) - return + return end if call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return call TimeInit(NextAlarm, lymd, cal, tod=ltod, desc="optDate", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return update_nextalarm = .false. case (optIfdays0) @@ -214,18 +214,18 @@ subroutine AlarmInit( clock, alarm, option, & msg=subname//trim(option)//' requires opt_ymd', & line=__LINE__, & file=__FILE__, rcToReturn=rc) - return + return end if call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=opt_n, s=0, calendar=cal, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return update_nextalarm = .true. case (optNSteps, optNStep) @@ -233,7 +233,7 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. @@ -242,7 +242,7 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. @@ -251,7 +251,7 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. @@ -260,7 +260,7 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. @@ -269,7 +269,7 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. @@ -278,7 +278,7 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. @@ -287,12 +287,12 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return update_nextalarm = .true. case (optNYears, optNYear) @@ -300,7 +300,7 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. @@ -309,20 +309,20 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return update_nextalarm = .true. - + case default call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//' unknown option: '//trim(option), & line=__LINE__, & file=__FILE__, rcToReturn=rc) - return + return end select @@ -344,8 +344,8 @@ subroutine AlarmInit( clock, alarm, option, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + end subroutine AlarmInit !=============================================================================== @@ -390,15 +390,15 @@ subroutine TimeInit( Time, ymd, cal, tod, desc, logunit, rc) end if call date2ymd (ymd,yr,mon,day) - + call ESMF_TimeSet( Time, yy=yr, mm=mon, dd=day, s=ltod, calendar=cal, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return end subroutine TimeInit - + !=============================================================================== subroutine date2ymd (date, year, month, day) @@ -421,5 +421,5 @@ subroutine date2ymd (date, year, month, day) day = mod(tdate, 100) end subroutine date2ymd - + end module From 9763f8b16e9796f0649d1b8869a77b78f024ddb5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 19 Oct 2018 17:45:52 -0400 Subject: [PATCH 0836/1072] Rescale ISOMIP MIN_THICKNESS via get_param Rescaled MIN_THICKNESS in ISOMIP initialization via the call to get_param. Also added (commented out) unit arguments to other get_param calls. All answers are bitwise identical. --- src/user/ISOMIP_initialization.F90 | 26 +++++++++++++++----------- 1 file changed, 15 insertions(+), 11 deletions(-) diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 621c5046dd..2256d31490 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -268,7 +268,7 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & + call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl, "ISOMIP_T_SUR",t_sur, & 'Temperature at the surface (interface)', default=-1.9, do_not_log=just_read) @@ -441,27 +441,31 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - call get_param(PF, mdl,"MIN_THICKNESS",min_thickness,'Minimum layer thickness',units='m',default=1.e-3) - min_thickness = GV%m_to_Z * min_thickness + call get_param(PF, mdl, "MIN_THICKNESS", min_thickness, "Minimum layer thickness", & + units="m", default=1.e-3, scale=GV%m_to_Z) - call get_param(PF, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & + call get_param(PF, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE) - call get_param(PF, mdl, "ISOMIP_TNUDG", TNUDG, 'Nudging time scale for sponge layers (days)', default=0.0) + call get_param(PF, mdl, "ISOMIP_TNUDG", TNUDG, "Nudging time scale for sponge layers (days)", default=0.0) - call get_param(PF, mdl, "T_REF", t_ref, 'Reference temperature', default=10.0,& + call get_param(PF, mdl, "T_REF", t_ref, "Reference temperature", default=10.0,& do_not_log=.true.) - call get_param(PF, mdl, "S_REF", s_ref, 'Reference salinity', default=35.0,& + call get_param(PF, mdl, "S_REF", s_ref, "Reference salinity", default=35.0,& do_not_log=.true.) - call get_param(PF, mdl, "ISOMIP_S_SUR_SPONGE", s_sur, 'Surface salinity in sponge layer.', default=s_ref) + call get_param(PF, mdl, "ISOMIP_S_SUR_SPONGE", s_sur, & + 'Surface salinity in sponge layer.', default=s_ref) ! units="PSU") - call get_param(PF, mdl, "ISOMIP_S_BOT_SPONGE", s_bot, 'Bottom salinity in sponge layer.', default=s_ref) + call get_param(PF, mdl, "ISOMIP_S_BOT_SPONGE", s_bot, & + 'Bottom salinity in sponge layer.', default=s_ref) ! units="PSU") - call get_param(PF, mdl, "ISOMIP_T_SUR_SPONGE", t_sur, 'Surface temperature in sponge layer.', default=t_ref) + call get_param(PF, mdl, "ISOMIP_T_SUR_SPONGE", t_sur, & + 'Surface temperature in sponge layer.', default=t_ref) ! units="degC") - call get_param(PF, mdl, "ISOMIP_T_BOT_SPONGE", t_bot, 'Bottom temperature in sponge layer.', default=t_ref) + call get_param(PF, mdl, "ISOMIP_T_BOT_SPONGE", t_bot, & + 'Bottom temperature in sponge layer.', default=t_ref) ! units="degC") T(:,:,:) = 0.0 ; S(:,:,:) = 0.0 ; Idamp(:,:) = 0.0; RHO(:,:,:) = 0.0 From 3f5ee779a04748d2f9889f49353001a3f17cdb57 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 19 Oct 2018 17:46:39 -0400 Subject: [PATCH 0837/1072] +Changed the units of Kd_add from m2 s-1 to Z2 s-1 Rescaled the units of Kd_add from m2 s-1 to Z2 s-1 via the get_param call for this KD_ADD for dimensional consistency testing. Also changed the units of the optional Kd_int_add argument to user_change_diff and added conversion arguments to the register_diag_field calls for Kd_user. All answers are bitwise identical, including rescaling Z over a large range. --- .../vertical/MOM_set_diffusivity.F90 | 58 +++++++++---------- src/user/user_change_diffusivity.F90 | 13 +++-- 2 files changed, 36 insertions(+), 35 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 873a61d7b8..1a09c32d50 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -165,13 +165,13 @@ module MOM_set_diffusivity !> This structure has memory for used in calculating diagnostics of diffusivity type diffusivity_diags real, pointer, dimension(:,:,:) :: & - N2_3d => NULL(),& !< squared buoyancy frequency at interfaces (1/s2) - Kd_user => NULL(),& !< user-added diffusivity at interfaces (m2/s) - Kd_BBL => NULL(),& !< BBL diffusivity at interfaces (m2/s) - Kd_work => NULL(),& !< layer integrated work by diapycnal mixing (W/m2) - maxTKE => NULL(),& !< energy required to entrain to h_max (m3/s3) - KT_extra => NULL(),& !< double diffusion diffusivity for temp (Z2/s) - KS_extra => NULL() !< double diffusion diffusivity for saln (Z2/s) + N2_3d => NULL(), & !< squared buoyancy frequency at interfaces (1/s2) + Kd_user => NULL(), & !< user-added diffusivity at interfaces (m2/s) + Kd_BBL => NULL(), & !< BBL diffusivity at interfaces (m2/s) + Kd_work => NULL(), & !< layer integrated work by diapycnal mixing (W/m2) + maxTKE => NULL(), & !< energy required to entrain to h_max (m3/s3) + KT_extra => NULL(), & !< double diffusion diffusivity for temp (Z2/s) + KS_extra => NULL() !< double diffusion diffusivity for saln (Z2/s) real, pointer, dimension(:,:,:) :: TKE_to_Kd => NULL() !< conversion rate (~1.0 / (G_Earth + dRho_lay)) !! between TKE dissipated within a layer and Kd @@ -744,11 +744,11 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & kmb = GV%nk_rho_varies do i=is,ie ; p_0(i) = 0.0 ; p_ref(i) = tv%P_Ref ; enddo do k=1,nz - call calculate_density(tv%T(:,j,k),tv%S(:,j,k),p_0,rho_0(:,k),& - is,ie-is+1,tv%eqn_of_state) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_0, rho_0(:,k), & + is, ie-is+1, tv%eqn_of_state) enddo - call calculate_density(tv%T(:,j,kmb),tv%S(:,j,kmb),p_ref,Rcv_kmb,& - is,ie-is+1,tv%eqn_of_state) + call calculate_density(tv%T(:,j,kmb), tv%S(:,j,kmb), p_ref, Rcv_kmb, & + is, ie-is+1, tv%eqn_of_state) kb_min = kmb+1 do i=is,ie @@ -1845,8 +1845,8 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) eps = 0.1 do i=is,ie ; p_ref(i) = tv%P_Ref ; enddo do k=1,kmb - call calculate_density(tv%T(:,j,k),tv%S(:,j,k),p_ref,Rcv(:,k),& - is,ie-is+1,tv%eqn_of_state) + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_ref, Rcv(:,k), & + is, ie-is+1, tv%eqn_of_state) enddo do i=is,ie if (kb(i) <= nz-1) then @@ -1994,7 +1994,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp call get_param(param_file, mdl, "ML_RAD_APPLY_TKE_DECAY", CS%ML_rad_TKE_decay, & "If true, apply the same exponential decay to ML_rad as \n"//& "is applied to the other surface sources of TKE in the \n"//& - "mixed layer code. This is only used if ML_RADIATION is true.",& + "mixed layer code. This is only used if ML_RADIATION is true.", & default=.true.) call get_param(param_file, mdl, "MSTAR", CS%mstar, & "The ratio of the friction velocity cubed to the TKE \n"//& @@ -2059,7 +2059,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp else CS%use_LOTW_BBL_diffusivity = .false. ! This parameterization depends on a u* from viscous BBL endif - CS%id_Kd_BBL = register_diag_field('ocean_model','Kd_BBL',diag%axesTi,Time, & + CS%id_Kd_BBL = register_diag_field('ocean_model', 'Kd_BBL', diag%axesTi, Time, & 'Bottom Boundary Layer Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2) call get_param(param_file, mdl, "SIMPLE_TKE_TO_KD", CS%simple_TKE_to_Kd, & "If true, uses a simple estimate of Kd/TKE that will\n"//& @@ -2154,27 +2154,27 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp if (CS%tm_csp%Int_tide_dissipation .or. CS%tm_csp%Lee_wave_dissipation .or. & CS%tm_csp%Lowmode_itidal_dissipation) then - CS%id_Kd_Work = register_diag_field('ocean_model','Kd_Work',diag%axesTL,Time, & + CS%id_Kd_Work = register_diag_field('ocean_model', 'Kd_Work', diag%axesTL, Time, & 'Work done by Diapycnal Mixing', 'W m-2') - CS%id_maxTKE = register_diag_field('ocean_model','maxTKE',diag%axesTL,Time, & + CS%id_maxTKE = register_diag_field('ocean_model', 'maxTKE', diag%axesTL, Time, & 'Maximum layer TKE', 'm3 s-3') - CS%id_TKE_to_Kd = register_diag_field('ocean_model','TKE_to_Kd',diag%axesTL,Time, & + CS%id_TKE_to_Kd = register_diag_field('ocean_model', 'TKE_to_Kd', diag%axesTL, Time, & 'Convert TKE to Kd', 's2 m', conversion=GV%Z_to_m**2) - CS%id_N2 = register_diag_field('ocean_model','N2',diag%axesTi,Time, & - 'Buoyancy frequency squared', 's-2', cmor_field_name='obvfsq', & - cmor_long_name='Square of seawater buoyancy frequency',& + CS%id_N2 = register_diag_field('ocean_model', 'N2', diag%axesTi, Time, & + 'Buoyancy frequency squared', 's-2', cmor_field_name='obvfsq', & + cmor_long_name='Square of seawater buoyancy frequency', & cmor_standard_name='square_of_brunt_vaisala_frequency_in_sea_water') if (CS%user_change_diff) & - CS%id_Kd_user = register_diag_field('ocean_model','Kd_user',diag%axesTi,Time, & - 'User-specified Extra Diffusivity', 'm2 s-1') + CS%id_Kd_user = register_diag_field('ocean_model', 'Kd_user', diag%axesTi, Time, & + 'User-specified Extra Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2) if (associated(diag_to_Z_CSp)) then - vd = var_desc("N2", "s-2",& + vd = var_desc("N2", "s-2", & "Buoyancy frequency, interpolated to z", z_grid='z') CS%id_N2_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) if (CS%user_change_diff) & - CS%id_Kd_user_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) + CS%id_Kd_user_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) endif endif @@ -2195,10 +2195,10 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp "double-diffusive convection.", default=1.5e-6, units="m2 s-1") ! The default molecular viscosity follows the CCSM4.0 and MOM4p1 defaults. - CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & + CS%id_KT_extra = register_diag_field('ocean_model', 'KT_extra', diag%axesTi, Time, & 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=GV%Z_to_m**2) - CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & + CS%id_KS_extra = register_diag_field('ocean_model', 'KS_extra', diag%axesTi, Time, & 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=GV%Z_to_m**2) if (associated(diag_to_Z_CSp)) then @@ -2207,7 +2207,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp z_grid='z') CS%id_KT_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) vd = var_desc("KS_extra", "m2 s-1", & - "Double-Diffusive Salinity Diffusivity, interpolated to z",& + "Double-Diffusive Salinity Diffusivity, interpolated to z", & z_grid='z') CS%id_KS_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) vd = var_desc("Kd_BBL", "m2 s-1", & @@ -2217,7 +2217,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp endif ! old double-diffusion if (CS%user_change_diff) then - call user_change_diff_init(Time, G, param_file, diag, CS%user_change_diff_CSp) + call user_change_diff_init(Time, G, GV, param_file, diag, CS%user_change_diff_CSp) endif if (CS%tm_csp%Int_tide_dissipation .and. CS%bkgnd_mixing_csp%Bryan_Lewis_diffusivity) & diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index deec1cd858..8a97a3f636 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -41,7 +41,7 @@ module user_change_diffusivity subroutine user_change_diff(h, tv, G, GV, CS, Kd_lay, Kd_int, T_f, S_f, Kd_int_add) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in Z (often m or kg m-2). type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers !! to any available thermodynamic !! fields. Absent fields have NULL ptrs. @@ -56,7 +56,7 @@ subroutine user_change_diff(h, tv, G, GV, CS, Kd_lay, Kd_int, T_f, S_f, Kd_int_a !! layers filled in vertically. real, dimension(:,:,:), optional, pointer :: Kd_int_add !< The diapycnal !! diffusivity that is being added at - !! each interface in m2 s-1. + !! each interface in Z2 s-1. ! Local variables real :: Rcv(SZI_(G),SZK_(G)) ! The coordinate density in layers in kg m-3. real :: p_ref(SZI_(G)) ! An array of tv%P_Ref pressures. @@ -119,7 +119,7 @@ subroutine user_change_diff(h, tv, G, GV, CS, Kd_lay, Kd_int, T_f, S_f, Kd_int_a endif rho_fn = val_weights(Rcv(i,k), CS%rho_range) if (rho_fn * lat_fn > 0.0) & - Kd_lay(i,j,k) = Kd_lay(i,j,k) + GV%m_to_Z**2 * CS%Kd_add * rho_fn * lat_fn + Kd_lay(i,j,k) = Kd_lay(i,j,k) + CS%Kd_add * rho_fn * lat_fn enddo ; enddo endif if (present(Kd_int)) then @@ -132,7 +132,7 @@ subroutine user_change_diff(h, tv, G, GV, CS, Kd_lay, Kd_int, T_f, S_f, Kd_int_a ! rho_int = 0.5*(Rcv(i,k-1) + Rcv(i,k)) rho_fn = val_weights( 0.5*(Rcv(i,k-1) + Rcv(i,k)), CS%rho_range) if (rho_fn * lat_fn > 0.0) then - Kd_int(i,j,K) = Kd_int(i,j,K) + GV%m_to_Z**2 * CS%Kd_add * rho_fn * lat_fn + Kd_int(i,j,K) = Kd_int(i,j,K) + CS%Kd_add * rho_fn * lat_fn if (store_Kd_add) Kd_int_add(i,j,K) = CS%Kd_add * rho_fn * lat_fn endif enddo ; enddo @@ -181,9 +181,10 @@ function val_weights(val, range) result(ans) end function val_weights !> Set up the module control structure. -subroutine user_change_diff_init(Time, G, param_file, diag, CS) +subroutine user_change_diff_init(Time, G, GV, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for !! model parameter values. @@ -214,7 +215,7 @@ subroutine user_change_diff_init(Time, G, param_file, diag, CS) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "USER_KD_ADD", CS%Kd_add, & "A user-specified additional diffusivity over a range of \n"//& - "latitude and density.", units="m2 s-1", default=0.0) + "latitude and density.", default=0.0, units="m2 s-1", scale=GV%m_to_Z**2) if (CS%Kd_add /= 0.0) then call get_param(param_file, mdl, "USER_KD_ADD_LAT_RANGE", CS%lat_range(:), & "Four successive values that define a range of latitudes \n"//& From 58a683c4da87745f8fe1b07d4cad0241e2e4d9d3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 19 Oct 2018 17:50:48 -0400 Subject: [PATCH 0838/1072] +Refactored Kelvin_set_OBC_data Refactored Kelvin_set_OBC_data to reduce the number of variables in the module control structure and to use g_Earth from the vertical grid type, which required the addition of a new verticalGrid_type argument to Kelvin_set_OBC_data. All answers are bitwise identical. --- src/core/MOM_boundary_update.F90 | 4 +- src/user/Kelvin_initialization.F90 | 92 ++++++++++++++++-------------- 2 files changed, 50 insertions(+), 46 deletions(-) diff --git a/src/core/MOM_boundary_update.F90 b/src/core/MOM_boundary_update.F90 index fc198ead02..a37fbaa22c 100644 --- a/src/core/MOM_boundary_update.F90 +++ b/src/core/MOM_boundary_update.F90 @@ -113,7 +113,7 @@ subroutine update_OBC_data(OBC, G, GV, tv, h, CS, Time) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< layer thickness + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< layer thicknesses, in H type(ocean_OBC_type), pointer :: OBC !< Open boundary structure type(update_OBC_CS), pointer :: CS !< Control structure for OBCs type(time_type), intent(in) :: Time !< Model time @@ -138,7 +138,7 @@ subroutine update_OBC_data(OBC, G, GV, tv, h, CS, Time) if (CS%use_tidal_bay) & call tidal_bay_set_OBC_data(OBC, CS%tidal_bay_OBC_CSp, G, h, Time) if (CS%use_Kelvin) & - call Kelvin_set_OBC_data(OBC, CS%Kelvin_OBC_CSp, G, h, Time) + call Kelvin_set_OBC_data(OBC, CS%Kelvin_OBC_CSp, G, GV, h, Time) if (CS%use_shelfwave) & call shelfwave_set_OBC_data(OBC, CS%shelfwave_OBC_CSp, G, h, Time) if (CS%use_dyed_channel) & diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 8315833391..63586ec541 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -32,13 +32,8 @@ module Kelvin_initialization real :: coast_angle = 0 !< Angle of coastline real :: coast_offset1 = 0 !< Longshore distance to coastal angle real :: coast_offset2 = 0 !< Longshore distance to coastal angle - real :: N0 = 0 !< Brunt-Vaisala frequency real :: H0 = 0 !< Bottom depth real :: F_0 !< Coriolis parameter - real :: plx = 0 !< Longshore wave parameter - real :: pmz = 0 !< Vertical wave parameter - real :: lambda = 0 !< Vertical wave parameter - real :: omega !< Frequency real :: rho_range !< Density range real :: rho_0 !< Mean density end type Kelvin_OBC_CS @@ -160,17 +155,23 @@ subroutine Kelvin_initialize_topography(D, G, param_file, max_depth) end subroutine Kelvin_initialize_topography !> This subroutine sets the properties of flow at open boundary conditions. -subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) - type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies - !! whether, where, and what open boundary - !! conditions are used. - type(Kelvin_OBC_CS), pointer :: CS !< Kelvin wave control structure. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness. - type(time_type), intent(in) :: Time !< model time. +subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, h, Time) + type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies + !! whether, where, and what open boundary + !! conditions are used. + type(Kelvin_OBC_CS), pointer :: CS !< Kelvin wave control structure. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness, in H. + type(time_type), intent(in) :: Time !< model time. ! The following variables are used to set up the transport in the Kelvin example. real :: time_sec, cff + real :: N0 ! Brunt-Vaisala frequency in s-1 + real :: plx !< Longshore wave parameter + real :: pmz !< Vertical wave parameter + real :: lambda !< Offshore decay scale + real :: omega !< Wave frequency in s-1 real :: PI integer :: i, j, k, n, is, ie, js, je, isd, ied, jsd, jed, nz integer :: IsdB, IedB, JsdB, JedB @@ -190,15 +191,18 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) fac = 1.0 if (CS%mode == 0) then - CS%omega = 2.0 * PI / (12.42 * 3600.0) ! M2 Tide period - val1 = sin(CS%omega * time_sec) + omega = 2.0 * PI / (12.42 * 3600.0) ! M2 Tide period + val1 = GV%m_to_Z * sin(omega * time_sec) else - CS%N0 = sqrt(CS%rho_range / CS%rho_0 * G%g_Earth * CS%H0) + N0 = sqrt((CS%rho_range / CS%rho_0) * GV%g_Earth * (GV%m_to_Z * CS%H0)) ! Two wavelengths in domain - CS%plx = 4.0 * PI / G%len_lon - CS%pmz = PI * CS%mode / CS%H0 - CS%lambda = CS%pmz * CS%F_0 / CS%N0 - CS%omega = CS%F_0 * CS%plx / CS%lambda + plx = 4.0 * PI / G%len_lon + pmz = PI * CS%mode / CS%H0 + lambda = pmz * CS%F_0 / N0 + omega = CS%F_0 * plx / lambda + + ! lambda = PI * CS%mode * CS%F_0 / (CS%H0 * N0) + ! omega = (4.0 * CS%H0 * N0) / (CS%mode * G%len_lon) endif sina = sin(CS%coast_angle) @@ -223,26 +227,26 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then - cff = sqrt(G%g_Earth * 0.5 * G%Zd_to_m * (G%bathyT(i+1,j) + G%bathyT(i,j))) + cff = sqrt(GV%g_Earth * 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) val2 = fac * exp(- CS%F_0 * y / cff) - segment%eta(I,j) = val2 * cos(CS%omega * time_sec) + segment%eta(I,j) = val2 * cos(omega * time_sec) segment%normal_vel_bt(I,j) = val1 * cff * cosa / & - (0.5 * G%Zd_to_m * (G%bathyT(i+1,j) + G%bathyT(i,j))) * val2 + (0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) * val2 else ! Not rotated yet segment%eta(I,j) = 0.0 segment%normal_vel_bt(I,j) = 0.0 if (segment%nudged) then do k=1,nz - segment%nudged_normal_vel(I,j,k) = fac * CS%lambda / CS%F_0 * & - exp(- CS%lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * & - cos(CS%omega * time_sec) + segment%nudged_normal_vel(I,j,k) = fac * lambda / CS%F_0 * & + exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * & + cos(omega * time_sec) enddo elseif (segment%specified) then do k=1,nz - segment%normal_vel(I,j,k) = fac * CS%lambda / CS%F_0 * & - exp(- CS%lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * & - cos(CS%omega * time_sec) + segment%normal_vel(I,j,k) = fac * lambda / CS%F_0 * & + exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * & + cos(omega * time_sec) segment%normal_trans(I,j,k) = segment%normal_vel(I,j,k) * & h(i+1,j,k) * G%dyCu(I,j) enddo @@ -260,12 +264,12 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) if (CS%mode == 0) then do k=1,nz segment%tangential_vel(I,J,k) = val1 * cff * sina / & - (0.25 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j) + & - G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) * val2 + (0.25 * (G%bathyT(i+1,j) + G%bathyT(i,j) + & + G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) * val2 !### For rotational symmetry, this should be: ! segment%tangential_vel(I,J,k) = val1 * cff * sina / & -! ( 0.25*G%Zd_to_m*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) +& -! (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) * val2 +! ( 0.25*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) +& +! (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) * val2 enddo endif enddo ; enddo @@ -279,24 +283,24 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then - cff = sqrt(G%g_Earth * 0.5 * G%Zd_to_m*(G%bathyT(i,j+1) + G%bathyT(i,j))) + cff = sqrt(GV%g_Earth * 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j))) val2 = fac * exp(- 0.5 * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * y / cff) - segment%eta(I,j) = val2 * cos(CS%omega * time_sec) + segment%eta(I,j) = val2 * cos(omega * time_sec) segment%normal_vel_bt(I,j) = val1 * cff * sina / & - (0.5 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j))) * val2 + (0.5*(G%bathyT(i+1,j) + G%bathyT(i,j))) * val2 else ! Not rotated yet segment%eta(i,J) = 0.0 segment%normal_vel_bt(i,J) = 0.0 if (segment%nudged) then do k=1,nz - segment%nudged_normal_vel(i,J,k) = fac * CS%lambda / CS%F_0 * & - exp(- CS%lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * cosa + segment%nudged_normal_vel(i,J,k) = fac * lambda / CS%F_0 * & + exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * cosa enddo elseif (segment%specified) then do k=1,nz - segment%normal_vel(i,J,k) = fac * CS%lambda / CS%F_0 * & - exp(- CS%lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * cosa + segment%normal_vel(i,J,k) = fac * lambda / CS%F_0 * & + exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * cosa segment%normal_trans(i,J,k) = segment%normal_vel(i,J,k) * & h(i,j+1,k) * G%dxCv(i,J) enddo @@ -314,12 +318,12 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, h, Time) if (CS%mode == 0) then do k=1,nz segment%tangential_vel(I,J,k) = val1 * cff * sina / & - (0.25 * G%Zd_to_m*(G%bathyT(i+1,j) + G%bathyT(i,j) + & - G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) * val2 + (0.25*(G%bathyT(i+1,j) + G%bathyT(i,j) + & + G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) * val2 !### This should be: ! segment%tangential_vel(I,J,k) = val1 * cff * sina / & -! ( 0.25*G%Zd_to_m*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) +& -! (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) * val2 +! ( 0.25*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) +& +! (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) * val2 enddo endif enddo ; enddo From 45d3a47b316c983877c4091cf23b7e2c5cc4d5cb Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 21 Oct 2018 11:15:36 -0400 Subject: [PATCH 0839/1072] Corrected scaling in hchksum calls for Kd_int Corrected a dimensional rescaling factor in the hchksum calls for Kd_int, so the checksum output is identical when Z is rescaled. All answers are bitwise identical. --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 2e4ee0835b..0ec0575914 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1496,7 +1496,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G) call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, scale=GV%Z_to_m**2) - call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0) + call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=GV%Z_to_m**2) endif @@ -1568,7 +1568,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call MOM_forcing_chksum("after KPP", fluxes, G, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=GV%Z_to_m**2) - call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0) + call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, scale=GV%Z_to_m**2) endif endif ! endif for KPP From 8491305e7459fdbb5387b183a2889bee8ca1e545 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 21 Oct 2018 11:16:15 -0400 Subject: [PATCH 0840/1072] Corrected scaling in hchksum call for g_prime Corrected a dimensional rescaling factor in the hchksum call for g_prime, so the checksum output is identical when Z is rescaled. All answers are bitwise identical. --- src/initialization/MOM_coord_initialization.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 54728f61d9..e1674a1500 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -99,7 +99,7 @@ subroutine MOM_initialize_coord(GV, PF, write_geom, output_dir, tv, max_depth) "Unrecognized coordinate setup"//trim(config)) end select if (debug) call chksum(GV%Rlay, "MOM_initialize_coord: Rlay ", 1, nz) - if (debug) call chksum(GV%Z_to_m*GV%g_prime(:), "MOM_initialize_coord: g_prime ", 1, nz) + if (debug) call chksum(GV%m_to_Z*GV%g_prime(:), "MOM_initialize_coord: g_prime ", 1, nz) call setVerticalGridAxes( GV%Rlay, GV ) ! Copy the maximum depth across from the input argument From b8a9a8b3cced55fa986c5b8f5c6e62e8ae4f439a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 21 Oct 2018 11:17:38 -0400 Subject: [PATCH 0841/1072] +Added handling of underflows in kappa_shear Added code to improve the handling of underflows of shear in the kappa_shear code, including adding parentheses to the expressions setting S2 and reading the run-time parameter VEL_UNDERFLOW that is stored in the control structure. Also added vel_underflow as an optional argument to calculate_projected_state. All answers are bitwise identical, and the issues with underflows when rescaling Z over a large range (once again at least -93 to 93) have been addressed. --- .../vertical/MOM_kappa_shear.F90 | 67 ++++++++++++------- 1 file changed, 42 insertions(+), 25 deletions(-) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 2ee8a0bdc6..be1a00fbd6 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -66,6 +66,8 @@ module MOM_kappa_shear logical :: eliminate_massless !< If true, massless layers are merged with neighboring !! massive layers in this calculation. ! I can think of no good reason why this should be false. - RWH + real :: vel_underflow !< Velocity components smaller than vel_underflow + !! are set to 0, in m s-1. ! logical :: layer_stagger = .false. ! If true, do the calculations centered at ! layers, rather than the interfaces. logical :: debug = .false. !< If true, write verbose debugging messages. @@ -960,9 +962,9 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & #endif ! This call just calculates N2 and S2. - call calculate_projected_state(kappa, u, v, T, Sal, 0.0, nzc, & - dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u, v, T, Sal, GV, N2=N2, S2=S2) + call calculate_projected_state(kappa, u, v, T, Sal, 0.0, nzc, dz, I_dz_int, & + dbuoy_dT, dbuoy_dS, u, v, T, Sal, GV, & + N2=N2, S2=S2, vel_underflow=CS%vel_underflow) ! ---------------------------------------------------- ! Iterate ! ---------------------------------------------------- @@ -1030,10 +1032,10 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! timestep is found long before the minimum is reached, so the ! value of max_KS_it may be unimportant, especially if it is large ! enough. - call calculate_projected_state(kappa_out, u, v, T, Sal, 0.5*dt_test, nzc, & - dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u_test, v_test, T_test, S_test, GV, N2, S2, & - ks_int = ks_kappa, ke_int = ke_kappa) + call calculate_projected_state(kappa_out, u, v, T, Sal, 0.5*dt_test, nzc, dz, I_dz_int, & + dbuoy_dT, dbuoy_dS, u_test, v_test, T_test, S_test, & + GV, N2, S2, ks_int=ks_kappa, ke_int=ke_kappa, & + vel_underflow=CS%vel_underflow) valid_dt = .true. Idtt = 1.0 / dt_test do K=max(ks_kappa-1,2),min(ke_kappa+1,nzc) @@ -1057,10 +1059,9 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & if ((dt_test < dt_rem) .and. valid_dt) then dt_inc = 0.5*dt_test do itt_dt=1,dt_refinements - call calculate_projected_state(kappa_out, u, v, T, Sal, & - 0.5*(dt_test+dt_inc), nzc, dz, I_dz_int, dbuoy_dT, & - dbuoy_dS, u_test, v_test, T_test, S_test, GV, N2, S2, & - ks_int = ks_kappa, ke_int = ke_kappa) + call calculate_projected_state(kappa_out, u, v, T, Sal, 0.5*(dt_test+dt_inc), & + nzc, dz, I_dz_int, dbuoy_dT, dbuoy_dS, u_test, v_test, T_test, S_test, & + GV, N2, S2, ks_int=ks_kappa, ke_int=ke_kappa, vel_underflow=CS%vel_underflow) valid_dt = .true. Idtt = 1.0 / (dt_test+dt_inc) do K=max(ks_kappa-1,2),min(ke_kappa+1,nzc) @@ -1111,10 +1112,10 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! call cpu_clock_end(id_clock_avg) else ! call cpu_clock_begin(id_clock_project) - call calculate_projected_state(kappa_out, u, v, T, Sal, dt_now, nzc, & - dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u_test, v_test, T_test, S_test, GV, N2=N2, S2=S2, & - ks_int = ks_kappa, ke_int = ke_kappa) + call calculate_projected_state(kappa_out, u, v, T, Sal, dt_now, nzc, dz, I_dz_int, & + dbuoy_dT, dbuoy_dS, u_test, v_test, T_test, S_test, & + GV, N2=N2, S2=S2, ks_int=ks_kappa, ke_int=ke_kappa, & + vel_underflow=CS%vel_underflow) ! call cpu_clock_end(id_clock_project) ! call cpu_clock_begin(id_clock_KQ) @@ -1131,10 +1132,10 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & enddo ! call cpu_clock_begin(id_clock_project) - call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, & - dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u_test, v_test, T_test, S_test, GV, N2=N2, S2=S2, & - ks_int = ks_kappa, ke_int = ke_kappa) + call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, dz, I_dz_int, & + dbuoy_dT, dbuoy_dS, u_test, v_test, T_test, S_test, & + GV, N2=N2, S2=S2, ks_int=ks_kappa, ke_int=ke_kappa, & + vel_underflow=CS%vel_underflow) ! call cpu_clock_end(id_clock_project) ! call cpu_clock_begin(id_clock_KQ) @@ -1157,8 +1158,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! Update the values of u, v, T, Sal, N2, and S2 for the next iteration. ! call cpu_clock_begin(id_clock_project) call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, & - dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u, v, T, Sal, GV, N2, S2) + dz, I_dz_int, dbuoy_dT, dbuoy_dS, u, v, T, Sal, & + GV, N2, S2, vel_underflow=CS%vel_underflow) ! call cpu_clock_end(id_clock_project) endif @@ -1225,7 +1226,7 @@ end subroutine kappa_shear_column !! may also calculate the projected buoyancy frequency and shear. subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u, v, T, Sal, GV, N2, S2, ks_int, ke_int) + u, v, T, Sal, GV, N2, S2, ks_int, ke_int, vel_underflow) integer, intent(in) :: nz !< The number of layers (after eliminating massless !! layers?). real, dimension(nz+1), intent(in) :: kappa !< The diapycnal diffusivity at interfaces, @@ -1255,17 +1256,22 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & integer, optional, intent(in) :: ks_int !< The topmost k-index with a non-zero diffusivity. integer, optional, intent(in) :: ke_int !< The bottommost k-index with a non-zero !! diffusivity. + real, optional, intent(in) :: vel_underflow !< If present and true, any velocities that + !! are smaller in magnitude than this value are + !! set to 0, in m s-1. ! Local variables real, dimension(nz+1) :: c1 real :: L2_to_Z2 ! A conversion factor from horizontal length units to vertical depth ! units squared, in Z2 m-2. + real :: underflow_vel ! Velocities smaller in magnitude than underflow_vel are set to 0, in m s-1. real :: a_a, a_b, b1, d1, bd1, b1nz_0 integer :: k, ks, ke ks = 1 ; ke = nz if (present(ks_int)) ks = max(ks_int-1,1) if (present(ke_int)) ke = min(ke_int,nz) + underflow_vel = 0.0 ; if (present(vel_underflow)) underflow_vel = vel_underflow if (ks > ke) return @@ -1308,16 +1314,22 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & endif u(ke) = b1nz_0 * (dz(ke)*u0(ke) + a_a*u(ke-1)) v(ke) = b1nz_0 * (dz(ke)*v0(ke) + a_a*v(ke-1)) + if (abs(u(ke)) < underflow_vel) u(ke) = 0.0 + if (abs(v(ke)) < underflow_vel) v(ke) = 0.0 do k=ke-1,ks,-1 u(k) = u(k) + c1(k+1)*u(k+1) v(k) = v(k) + c1(k+1)*v(k+1) + if (abs(u(k)) < underflow_vel) u(k) = 0.0 + if (abs(v(k)) < underflow_vel) v(k) = 0.0 T(k) = T(k) + c1(k+1)*T(k+1) Sal(k) = Sal(k) + c1(k+1)*Sal(k+1) enddo else ! dt <= 0.0 do k=1,nz u(k) = u0(k) ; v(k) = v0(k) ; T(k) = T0(k) ; Sal(k) = S0(k) + if (abs(u(k)) < underflow_vel) u(k) = 0.0 + if (abs(v(k)) < underflow_vel) v(k) = 0.0 enddo endif @@ -1325,12 +1337,12 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & L2_to_Z2 = GV%m_to_Z**2 S2(1) = 0.0 ; S2(nz+1) = 0.0 if (ks > 1) & - S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * L2_to_Z2*I_dz_int(ks)**2 + S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * (L2_to_Z2*I_dz_int(ks)**2) do K=ks+1,ke - S2(K) = ((u(k)-u(k-1))**2 + (v(k)-v(k-1))**2) * L2_to_Z2*I_dz_int(K)**2 + S2(K) = ((u(k)-u(k-1))**2 + (v(k)-v(k-1))**2) * (L2_to_Z2*I_dz_int(K)**2) enddo if (ke Date: Mon, 22 Oct 2018 16:56:45 -0400 Subject: [PATCH 0842/1072] Fixes bug (crash) if Langmuir number output is enabled but waves CS is not associated --- src/parameterizations/vertical/MOM_CVMix_KPP.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 7d5615f6a8..71a76ff44d 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -1307,7 +1307,11 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux, if (CS%id_BulkUz2 > 0) call post_data(CS%id_BulkUz2, CS%Uz2, CS%diag) if (CS%id_EnhK > 0) call post_data(CS%id_EnhK, CS%EnhK, CS%diag) if (CS%id_EnhVt2 > 0) call post_data(CS%id_EnhVt2, CS%EnhVt2, CS%diag) - if (CS%id_La_SL>0.and.present(WAVES)) call post_data(CS%id_La_SL,WAVES%La_SL,CS%diag) + if (present(WAVES)) then + if ((CS%id_La_SL>0) .and. associated(WAVES)) then + call post_data(CS%id_La_SL,WAVES%La_SL,CS%diag) + endif + endif ! BLD smoothing: if (CS%n_smooth > 0) call KPP_smooth_BLD(CS,G,GV,h) From 813f3871ca08a142d96433d7cd602fc6658b4912 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 22 Oct 2018 19:10:09 -0400 Subject: [PATCH 0843/1072] Corrected chksum rescaling for e in thickness_diffuse Corrected the rescaling in a checksum call for e in thickness_diffuse. All answers are bitwise identical, including rescaling Z over a large range. --- src/parameterizations/lateral/MOM_thickness_diffuse.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 982b73698f..ac50c4c11a 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -290,7 +290,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS call uvchksum("Kh_[uv]", Kh_u, Kh_v, G%HI,haloshift=0) call uvchksum("int_slope_[uv]", int_slope_u, int_slope_v, G%HI, haloshift=0) call hchksum(h, "thickness_diffuse_1 h", G%HI, haloshift=1, scale=GV%H_to_m) - call hchksum(e, "thickness_diffuse_1 e", G%HI, haloshift=1) + call hchksum(e, "thickness_diffuse_1 e", G%HI, haloshift=1, scale=GV%Z_to_m) if (use_stored_slopes) then call uvchksum("VarMix%slope_[xy]", VarMix%slope_x, VarMix%slope_y, & G%HI, haloshift=0) From c9813e6cd7890429dc1816ff468aac0da3bc1311 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 22 Oct 2018 19:10:50 -0400 Subject: [PATCH 0844/1072] Recast SCM_CVMix_tests_TS_init to work in units of Z Recast the internal calculations in SCM_CVMix_tests_TS_init to use vertical height units of Z in place of m for dimensional consistency testing. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- src/user/SCM_CVMix_tests.F90 | 46 +++++++++++++++++++----------------- 1 file changed, 24 insertions(+), 22 deletions(-) diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index 681edfce74..f9516ef91e 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -48,23 +48,23 @@ module SCM_CVMix_tests subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, param_file, just_read_params) real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(out) :: T !< Potential temperature (degC) real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(out) :: S !< Salinity (psu) - real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(in) :: h !< Layer thickness (m or Pa) + real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(in) :: h !< Layer thickness in H (often m or Pa) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV!< Vertical grid structure type(param_file_type), intent(in) :: param_file !< Input parameter structure logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: UpperLayerTempMLD !< Upper layer Temp MLD thickness (m) - real :: UpperLayerSaltMLD !< Upper layer Salt MLD thickness (m) + real :: UpperLayerTempMLD !< Upper layer Temp MLD thickness (Z) + real :: UpperLayerSaltMLD !< Upper layer Salt MLD thickness (Z) real :: UpperLayerTemp !< Upper layer temperature (SST if thickness 0) (deg C) real :: UpperLayerSalt !< Upper layer salinity (SSS if thickness 0) (PPT) real :: LowerLayerTemp !< Temp at top of lower layer (deg C) real :: LowerLayerSalt !< Salt at top of lower layer (PPT) - real :: LowerLayerdTdz !< Temp gradient in lower layer (deg C m^{-1}) - real :: LowerLayerdSdz !< Salt gradient in lower layer (PPT m^{-1}) + real :: LowerLayerdTdz !< Temp gradient in lower layer (deg C / Z) + real :: LowerLayerdSdz !< Salt gradient in lower layer (PPT / Z) real :: LowerLayerMinTemp !< Minimum temperature in lower layer - real :: zC, DZ, top, bottom + real :: zC, DZ, top, bottom ! Depths and thicknesses in Z. logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz @@ -75,25 +75,27 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, param_file, just_read_params) just_read = .false. ; if (present(just_read_params)) just_read = just_read_params if (.not.just_read) call log_version(param_file, mdl, version) - call get_param(param_file, mdl,"SCM_TEMP_MLD",UpperLayerTempMLD, & - 'Initial temp mixed layer depth', units='m',default=0.0, do_not_log=just_read) - call get_param(param_file, mdl,"SCM_SALT_MLD",UpperLayerSaltMLD, & - 'Initial salt mixed layer depth', units='m',default=0.0, do_not_log=just_read) - call get_param(param_file, mdl,"SCM_L1_SALT",UpperLayerSalt, & - 'Layer 2 surface salinity', units='1e-3',default=35.0, do_not_log=just_read) - call get_param(param_file, mdl,"SCM_L1_TEMP",UpperLayerTemp, & + call get_param(param_file, mdl, "SCM_TEMP_MLD", UpperLayerTempMLD, & + 'Initial temp mixed layer depth', & + units='m', default=0.0, scale=GV%m_to_Z, do_not_log=just_read) + call get_param(param_file, mdl, "SCM_SALT_MLD", UpperLayerSaltMLD, & + 'Initial salt mixed layer depth', & + units='m', default=0.0, scale=GV%m_to_Z, do_not_log=just_read) + call get_param(param_file, mdl, "SCM_L1_SALT", UpperLayerSalt, & + 'Layer 2 surface salinity', units='1e-3', default=35.0, do_not_log=just_read) + call get_param(param_file, mdl, "SCM_L1_TEMP", UpperLayerTemp, & 'Layer 1 surface temperature', units='C', default=20.0, do_not_log=just_read) - call get_param(param_file, mdl,"SCM_L2_SALT",LowerLayerSalt, & - 'Layer 2 surface salinity', units='1e-3',default=35.0, do_not_log=just_read) - call get_param(param_file, mdl,"SCM_L2_TEMP",LowerLayerTemp, & + call get_param(param_file, mdl, "SCM_L2_SALT", LowerLayerSalt, & + 'Layer 2 surface salinity', units='1e-3', default=35.0, do_not_log=just_read) + call get_param(param_file, mdl, "SCM_L2_TEMP", LowerLayerTemp, & 'Layer 2 surface temperature', units='C', default=20.0, do_not_log=just_read) - call get_param(param_file, mdl,"SCM_L2_DTDZ",LowerLayerdTdZ, & + call get_param(param_file, mdl, "SCM_L2_DTDZ", LowerLayerdTdZ, & 'Initial temperature stratification in layer 2', & - units='C/m', default=0.00, do_not_log=just_read) - call get_param(param_file, mdl,"SCM_L2_DSDZ",LowerLayerdSdZ, & + units='C/m', default=0.0, scale=GV%Z_to_m, do_not_log=just_read) + call get_param(param_file, mdl, "SCM_L2_DSDZ", LowerLayerdSdZ, & 'Initial salinity stratification in layer 2', & - units='PPT/m', default=0.00, do_not_log=just_read) - call get_param(param_file, mdl,"SCM_L2_MINTEMP",LowerLayerMinTemp, & + units='PPT/m', default=0.0, scale=GV%Z_to_m, do_not_log=just_read) + call get_param(param_file, mdl, "SCM_L2_MINTEMP",LowerLayerMinTemp, & 'Layer 2 minimum temperature', units='C', default=4.0, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -102,7 +104,7 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, param_file, just_read_params) top = 0. ! Reference to surface bottom = 0. do k=1,nz - bottom = bottom - h(i,j,k)*GV%H_to_m ! Interface below layer (in m) + bottom = bottom - h(i,j,k)*GV%H_to_Z ! Interface below layer (in m) zC = 0.5*( top + bottom ) ! Z of middle of layer (in m) DZ = min(0., zC + UpperLayerTempMLD) T(i,j,k) = max(LowerLayerMinTemp,LowerLayerTemp + LowerLayerdTdZ * DZ) From 1dee6fd19a87207f5d05f31fe5f42d030bc080d2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 22 Oct 2018 19:18:10 -0400 Subject: [PATCH 0845/1072] +Recast MOM_wave_interface to work in units of Z Recast the internal calculations in MOM_wave_interface to use vertical height units of Z in place of m for dimensional consistency testing. This included changing the units of one argument in the get_Langmuir_Number interface, which is used outside of this module. There was also some general code clean-up in the MOM_wave_interfaces code. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- .../vertical/MOM_CVMix_KPP.F90 | 2 +- .../vertical/MOM_energetic_PBL.F90 | 2 +- src/user/MOM_wave_interface.F90 | 282 +++++++++--------- 3 files changed, 136 insertions(+), 150 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 7d5615f6a8..4f2a1bfad4 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -1067,7 +1067,7 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux, "without activating USEWAVES") endif !For now get Langmuir number based on prev. MLD (otherwise must compute 3d LA) - MLD_GUESS = max( 1., abs(CS%OBLdepthprev(i,j) ) ) + MLD_GUESS = max( 1.*GV%m_to_Z, abs(GV%m_to_Z*CS%OBLdepthprev(i,j) ) ) call get_Langmuir_Number( LA, G, GV, MLD_guess, surfFricVel, I, J, & H=H(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES) WAVES%La_SL(i,j)=LA diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index b82c697b8d..21ef6522f7 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -773,7 +773,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & ( (-Bf_Unstable + 1.e-10*GV%m_to_Z**2) + & 2.0 *MSTAR_MIX * U_star**3 / MLD_guess ) if (CS%USE_LT) then - call get_Langmuir_Number( LA, G, GV, abs(GV%Z_to_m*MLD_guess), u_star_mean, i, j, & + call get_Langmuir_Number( LA, G, GV, abs(MLD_guess), u_star_mean, i, j, & H=H(i,:), U_H=U(i,:), V_H=V(i,:), WAVES=WAVES) ! 2. Get parameters for modified LA MLD_o_Ekman = abs(MLD_guess * iL_Ekman) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index d715b742ee..01c0bcf653 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -41,7 +41,7 @@ module MOM_wave_interface !> Container for all surface wave related parameters -type, public:: wave_parameters_CS ; private +type, public :: wave_parameters_CS ; private !Main surface wave options logical, public :: UseWaves !< Flag to enable surface gravity wave feature @@ -101,7 +101,7 @@ module MOM_wave_interface !! Horizontal -> V points !! 3rd dimension -> Freq/Wavenumber real, allocatable, dimension(:,:,:), public :: & - KvS !< Viscosity for Stokes Drift shear (m2/s) + KvS !< Viscosity for Stokes Drift shear (Z2/s) ! Pointers to auxiliary fields type(time_type), pointer, public :: Time !< A pointer to the ocean model's clock. @@ -276,7 +276,7 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) 'Surface Stokes (y) for test profile',& units='m/s',default=0.0) call get_param(param_file,mdl,"TP_WVL",TP_WVL,& - units='m',default=50.0) + units='m', default=50.0, scale=GV%m_to_Z) case (SURFBANDS_STRING)! Surface Stokes Drift Bands WaveMethod = SURFBANDS call get_param(param_file, mdl, "SURFBAND_SOURCE",TMPSTRING2, & @@ -470,16 +470,18 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: ustar !< Wind friction velocity (m/s) ! Local Variables - real :: Top, MidPoint, Bottom + real :: Top, MidPoint, Bottom, one_cm real :: DecayScale real :: CMN_FAC, WN, US real :: La integer :: ii, jj, kk, b, iim1, jjm1 + one_cm = 0.01*GV%m_to_Z + ! 1. If Test Profile Option is chosen ! Computing mid-point value from surface value and decay wavelength if (WaveMethod==TESTPROF) then - DecayScale = 4.*PI/TP_WVL !4pi + DecayScale = 4.*PI / TP_WVL !4pi do II = G%isdB,G%iedB do jj = G%jsd,G%jed IIm1 = max(1,II-1) @@ -487,8 +489,8 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) MidPoint = 0.0 do kk = 1,G%ke Top = Bottom - MidPoint = Bottom - GV%H_to_m*(h(II,jj,kk)+h(IIm1,jj,kk))/4. - Bottom = Bottom - GV%H_to_m*(h(II,jj,kk)+h(IIm1,jj,kk))/2. + MidPoint = Bottom - GV%H_to_Z*0.25*(h(II,jj,kk)+h(IIm1,jj,kk)) + Bottom = Bottom - GV%H_to_Z*0.5*(h(II,jj,kk)+h(IIm1,jj,kk)) CS%Us_x(II,jj,kk) = TP_STKX0*exp(MidPoint*DecayScale) enddo enddo @@ -500,8 +502,8 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) MidPoint = 0.0 do kk = 1,G%ke Top = Bottom - MidPoint = Bottom - GV%H_to_m*(h(ii,JJ,kk)+h(ii,JJm1,kk))/4. - Bottom = Bottom - GV%H_to_m*(h(ii,JJ,kk)+h(ii,JJm1,kk))/2. + MidPoint = Bottom - GV%H_to_Z*0.25*(h(ii,JJ,kk)+h(ii,JJm1,kk)) + Bottom = Bottom - GV%H_to_Z*0.5*(h(ii,JJ,kk)+h(ii,JJm1,kk)) CS%Us_y(ii,JJ,kk) = TP_STKY0*exp(MidPoint*DecayScale) enddo enddo @@ -522,8 +524,8 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) do b = 1,NumBands if (PartitionMode==0) then ! In wavenumber we are averaging over (small) level - CMN_FAC = (1.0-exp(-0.01*2*CS%WaveNum_Cen(b))) & - / (0.01*2.*CS%WaveNum_Cen(b)) + CMN_FAC = (1.0-exp(-one_cm*2.*CS%WaveNum_Cen(b))) / & + (one_cm*2.*CS%WaveNum_Cen(b)) elseif (PartitionMode==1) then ! In frequency we are not averaging over level and taking top CMN_FAC = 1.0 @@ -535,8 +537,8 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) do kk = 1,G%ke Top = Bottom IIm1 = max(II-1,1) - MidPoint = Bottom - GV%H_to_m*(h(II,jj,kk)+h(IIm1,jj,kk))/4. - Bottom = Bottom - GV%H_to_m*(h(II,jj,kk)+h(IIm1,jj,kk))/2. + MidPoint = Bottom - GV%H_to_Z*0.25*(h(II,jj,kk)+h(IIm1,jj,kk)) + Bottom = Bottom - GV%H_to_Z*0.5*(h(II,jj,kk)+h(IIm1,jj,kk)) do b = 1,NumBands if (PartitionMode==0) then ! In wavenumber we are averaging over level @@ -545,11 +547,11 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) elseif (PartitionMode==1) then if (CS%StkLevelMode==0) then ! Take the value at the midpoint - CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b))**2/(GV%g_Earth*GV%m_to_Z)) + CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b))**2/(GV%g_Earth*GV%m_to_Z**2)) elseif (CS%StkLevelMode==1) then ! Use a numerical integration and then ! divide by layer thickness - WN = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*GV%m_to_Z) !bgr bug-fix missing g + WN = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*GV%m_to_Z**2) !bgr bug-fix missing g CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) endif endif @@ -565,8 +567,8 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) do b = 1,NumBands if (PartitionMode==0) then ! In wavenumber we are averaging over (small) level - CMN_FAC = (1.0-exp(-0.01*2*CS%WaveNum_Cen(b))) & - / (0.01*2.*CS%WaveNum_Cen(b)) + CMN_FAC = (1.0-exp(-one_cm*2.*CS%WaveNum_Cen(b))) / & + (one_cm*2.*CS%WaveNum_Cen(b)) elseif (PartitionMode==1) then ! In frequency we are not averaging over level and taking top CMN_FAC = 1.0 @@ -578,21 +580,22 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) do kk = 1,G%ke Top = Bottom JJm1 = max(JJ-1,1) - MidPoint = Bottom - GV%H_to_m*(h(ii,JJ,kk)+h(ii,JJm1,kk))/4. - Bottom = Bottom - GV%H_to_m*(h(ii,JJ,kk)+h(ii,JJm1,kk))/2. + MidPoint = Bottom - GV%H_to_Z*0.25*(h(ii,JJ,kk)+h(ii,JJm1,kk)) + Bottom = Bottom - GV%H_to_Z*0.5*(h(ii,JJ,kk)+h(ii,JJm1,kk)) do b = 1,NumBands if (PartitionMode==0) then ! In wavenumber we are averaging over level - CMN_FAC = (exp(Top*2.*CS%WaveNum_Cen(b))-exp(Bottom*2.*CS%WaveNum_Cen(b)))& - / ((Top-Bottom)*(2.*CS%WaveNum_Cen(b))) + CMN_FAC = (exp(Top*2.*CS%WaveNum_Cen(b)) - & + exp(Bottom*2.*CS%WaveNum_Cen(b))) / & + ((Top-Bottom)*(2.*CS%WaveNum_Cen(b))) elseif (PartitionMode==1) then if (CS%StkLevelMode==0) then ! Take the value at the midpoint - CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b))**2/(GV%g_Earth*GV%m_to_Z)) + CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b))**2/(GV%g_Earth*GV%m_to_Z**2)) elseif (CS%StkLevelMode==1) then ! Use a numerical integration and then ! divide by layer thickness - WN = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*GV%m_to_Z) + WN = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*GV%m_to_Z**2) CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) endif endif @@ -608,13 +611,13 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) do kk = 1,G%ke Top = Bottom IIm1 = max(II-1,1) - MidPoint = Bottom - GV%H_to_m*(h(II,jj,kk)+h(IIm1,jj,kk))/4. - Bottom = Bottom - GV%H_to_m*(h(II,jj,kk)+h(IIm1,jj,kk))/2. + MidPoint = Bottom - GV%H_to_Z*0.25*(h(II,jj,kk)+h(IIm1,jj,kk)) + Bottom = Bottom - GV%H_to_Z*0.5*(h(II,jj,kk)+h(IIm1,jj,kk)) !bgr note that this is using a u-point ii on h-point ustar ! this code has only been previous used for uniform ! grid cases. This needs fixed if DHH85 is used for non ! uniform cases. - call DHH85_mid(GV,ustar(ii,jj),Midpoint,US) + call DHH85_mid(GV, ustar(ii,jj), MidPoint, US) ! Putting into x-direction (no option for direction CS%US_x(II,jj,kk) = US enddo @@ -626,8 +629,8 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) do kk=1, G%ke Top = Bottom JJm1 = max(JJ-1,1) - MidPoint = Bottom - GV%H_to_m*(h(ii,JJ,kk)+h(ii,JJm1,kk))/4. - Bottom = Bottom - GV%H_to_m*(h(ii,JJ,kk)+h(ii,JJm1,kk))/2. + MidPoint = Bottom - GV%H_to_Z*0.25*(h(ii,JJ,kk)+h(ii,JJm1,kk)) + Bottom = Bottom - GV%H_to_Z*0.5*(h(ii,JJ,kk)+h(ii,JJm1,kk)) !bgr note that this is using a v-point jj on h-point ustar ! this code has only been previous used for uniform ! grid cases. This needs fixed if DHH85 is used for non @@ -661,7 +664,7 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) ! in the routine it is needed by (e.g. KPP or ePBL). do ii = G%isc,G%iec do jj = G%jsc, G%jec - Top = h(ii,jj,1)*GV%H_to_m + Top = h(ii,jj,1)*GV%H_to_Z call get_Langmuir_Number( La, G, GV, Top, ustar(ii,jj), ii, jj, & Override_MA=.false.,WAVES=CS) CS%La_turb(ii,jj) = La @@ -670,15 +673,15 @@ subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) ! Output any desired quantities if (CS%id_surfacestokes_y>0) & - call post_data(CS%id_surfacestokes_y, CS%us0_y, CS%diag) + call post_data(CS%id_surfacestokes_y, CS%us0_y, CS%diag) if (CS%id_surfacestokes_x>0) & - call post_data(CS%id_surfacestokes_x, CS%us0_x, CS%diag) + call post_data(CS%id_surfacestokes_x, CS%us0_x, CS%diag) if (CS%id_3dstokes_y>0) & - call post_data(CS%id_3dstokes_y, CS%us_y, CS%diag) + call post_data(CS%id_3dstokes_y, CS%us_y, CS%diag) if (CS%id_3dstokes_x>0) & - call post_data(CS%id_3dstokes_x, CS%us_x, CS%diag) + call post_data(CS%id_3dstokes_x, CS%us_x, CS%diag) if (CS%id_La_turb>0) & - call post_data(CS%id_La_turb, CS%La_turb, CS%diag) + call post_data(CS%id_La_turb, CS%La_turb, CS%diag) return end subroutine Update_Stokes_Drift @@ -693,8 +696,7 @@ subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) ! Local variables real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal and psuedo-meridional real :: temp_y(SZI_(G),SZJ_(G)) ! Stokes drift of band at h-points, in m/s - real :: Top, MidPoint, Bottom - real :: DecayScale + real :: Top, MidPoint integer :: b integer :: i, j integer, dimension(4) :: start, counter, dims, dim_id @@ -792,6 +794,7 @@ subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) " in file "// trim(SurfBandFileName)//" in MOM_wave_interface") endif NUMBANDS = ID + do B = 1,NumBands ; CS%WaveNum_Cen(b) = GV%Z_to_m*CS%WaveNum_Cen(b) ; enddo elseif (PartitionMode==1) then rcode_fr = NF90_GET_VAR(ncid, dim_id(1), CS%Freq_Cen, start, counter) if (rcode_fr /= 0) then @@ -802,7 +805,7 @@ subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) endif NUMBANDS = ID do B = 1,NumBands - CS%WaveNum_Cen(b) = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*GV%m_to_Z) + CS%WaveNum_Cen(b) = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*GV%m_to_Z**2) enddo endif @@ -845,7 +848,6 @@ subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) call pass_vector(CS%STKx0(:,:,b),CS%STKy0(:,:,b), G%Domain, To_ALL) enddo !Closes b-loop -return end subroutine Surface_Bands_by_data_override !> Interface to get Langmuir number based on options stored in wave structure @@ -862,15 +864,14 @@ subroutine get_Langmuir_Number( LA, G, GV, HBL, USTAR, i, j, & integer, intent(in) :: i !< Meridional index of h-point integer, intent(in) :: j !< Zonal index of h-point real, intent(in) :: USTAR !< Friction velocity (m/s) - real, intent(in) :: HBL !< (Positive) thickness of boundary - !! layer (m) + real, intent(in) :: HBL !< (Positive) thickness of boundary layer (Z) logical, optional,& intent(in) :: Override_MA !< Override to use misalignment in LA !! calculation. This can be used if diagnostic !! LA outputs are desired that are different than !! those used by the dynamical model. real, optional, dimension(SZK_(GV)), & - intent(in) :: H !< Grid layer thickness (m or kg/m2) + intent(in) :: H !< Grid layer thickness in H (m or kg/m2) real, optional, dimension(SZK_(GV)), & intent(in) :: U_H !< Zonal velocity at H point (m/s) real, optional, dimension(SZK_(GV)), & @@ -890,7 +891,7 @@ subroutine get_Langmuir_Number( LA, G, GV, HBL, USTAR, i, j, & integer :: KK, BB ! Compute averaging depth for Stokes drift (negative) - Dpt_LASL = min(-0.1, -LA_FracHBL*HBL) + Dpt_LASL = min(-0.1*GV%m_to_Z, -LA_FracHBL*HBL) USE_MA = LA_Misalignment if (present(Override_MA)) USE_MA = Override_MA @@ -904,9 +905,9 @@ subroutine get_Langmuir_Number( LA, G, GV, HBL, USTAR, i, j, & bottom = 0.0 do kk = 1,G%ke Top = Bottom - MidPoint = Bottom + GV%H_to_m*h(kk)/2. - Bottom = Bottom + GV%H_to_m*h(kk) - if (MidPoint > DPT_LASL .and. kk > 1 .and. ContinueLoop) then + MidPoint = Bottom + GV%H_to_Z*0.5*h(kk) + Bottom = Bottom + GV%H_to_Z*h(kk) + if (MidPoint > Dpt_LASL .and. kk > 1 .and. ContinueLoop) then ShearDirection = atan2(V_H(1)-V_H(kk),U_H(1)-U_H(kk)) ContinueLoop = .false. endif @@ -928,7 +929,7 @@ subroutine get_Langmuir_Number( LA, G, GV, HBL, USTAR, i, j, & enddo call Get_SL_Average_Band(GV, Dpt_LASL, NumBands, WAVES%WaveNum_Cen, StkBand_X, LA_STKx ) call Get_SL_Average_Band(GV, Dpt_LASL, NumBands, WAVES%WaveNum_Cen, StkBand_Y, LA_STKy ) - LA_STK = sqrt(LA_STKX*LA_STKX+LA_STKY*LA_STKY) + LA_STK = sqrt(LA_STKX**2 + LA_STKY**2) elseif (WaveMethod==DHH85) then ! Temporarily integrating profile rather than spectrum for simplicity do kk = 1,GV%ke @@ -937,7 +938,7 @@ subroutine get_Langmuir_Number( LA, G, GV, HBL, USTAR, i, j, & enddo call Get_SL_Average_Prof( GV, Dpt_LASL, H, US_H, LA_STKx) call Get_SL_Average_Prof( GV, Dpt_LASL, H, VS_H, LA_STKy) - LA_STK = sqrt(LA_STKX*LA_STKX+LA_STKY*LA_STKY) + LA_STK = sqrt(LA_STKX**2 + LA_STKY**2) elseif (WaveMethod==LF17) then call get_StokesSL_LiFoxKemper(ustar,hbl*LA_FracHBL, GV, LA_STK, LA) endif @@ -977,7 +978,7 @@ end subroutine get_Langmuir_Number !! - BGR note: fixed parameter values should be changed to "get_params" subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US_SL, LA) real, intent(in) :: ustar !< water-side surface friction velocity (m/s) - real, intent(in) :: hbl !< boundary layer depth (m) + real, intent(in) :: hbl !< boundary layer depth (Z) type(verticalGrid_type), & intent(in) :: GV !< Ocean vertical grid structure real, intent(out) :: US_SL !< Surface layer averaged Stokes drift (m/s) @@ -989,7 +990,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US_SL, LA) u19p5_to_u10 = 1.075, & ! ratio of mean frequency to peak frequency for ! Pierson-Moskowitz spectrum (Webb, 2011) - fm_to_fp = 1.296, & + fm_into_fp = 1.296, & ! ratio of surface Stokes drift to U10 us_to_u10 = 0.0162, & ! loss ratio of Stokes transport @@ -1013,7 +1014,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US_SL, LA) fp = 0.877 * (GV%g_Earth*GV%m_to_Z) / tmp ! ! mean frequency - fm = fm_to_fp * fp + fm = fm_into_fp * fp ! ! total Stokes transport (a factor r_loss is applied to account ! for the effect of directional spreading, multidirectional waves @@ -1031,19 +1032,19 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US_SL, LA) ! is also included kstar = kphil * 2.56 ! surface layer - z0 = abs(hbl) + z0 = abs(GV%Z_to_m*hbl) z0i = 1.0 / z0 ! term 1 to 4 - r1 = ( 0.151 / kphil * z0i -0.84 ) & - * ( 1.0 - exp(-2.0 * kphil * z0) ) - r2 = -( 0.84 + 0.0591 / kphil * z0i ) & - *sqrt( 2.0 * PI * kphil * z0 ) & - *erfc( sqrt( 2.0 * kphil * z0 ) ) - r3 = ( 0.0632 / kstar * z0i + 0.125 ) & - * (1.0 - exp(-2.0 * kstar * z0) ) - r4 = ( 0.125 + 0.0946 / kstar * z0i ) & - *sqrt( 2.0 * PI *kstar * z0) & - *erfc( sqrt( 2.0 * kstar * z0 ) ) + r1 = ( 0.151 / kphil * z0i -0.84 ) * & + ( 1.0 - exp(-2.0 * kphil * z0) ) + r2 = -( 0.84 + 0.0591 / kphil * z0i ) * & + sqrt( 2.0 * PI * kphil * z0 ) * & + erfc( sqrt( 2.0 * kphil * z0 ) ) + r3 = ( 0.0632 / kstar * z0i + 0.125 ) * & + (1.0 - exp(-2.0 * kstar * z0) ) + r4 = ( 0.125 + 0.0946 / kstar * z0i ) * & + sqrt( 2.0 * PI *kstar * z0) * & + erfc( sqrt( 2.0 * kstar * z0 ) ) us_sl = us * (0.715 + r1 + r2 + r3 + r4) LA = sqrt(ustar/us_sl) else @@ -1057,16 +1058,16 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US_SL, LA) subroutine Get_SL_Average_Prof( GV, AvgDepth, H, Profile, Average ) type(verticalGrid_type), & intent(in) :: GV !< Ocean vertical grid structure - real, intent(in) :: AvgDepth !< Depth to average over (m) + real, intent(in) :: AvgDepth !< Depth to average over (Z) real, dimension(SZK_(GV)), & - intent(in) :: H !< Grid thickness (m) + intent(in) :: H !< Grid thickness (H) real, dimension(SZK_(GV)), & intent(in) :: Profile !< Profile of quantity to be averaged !! (used here for Stokes drift, m/s) real, intent(out) :: Average !< Output quantity averaged over depth AvgDepth !! (used here for Stokes drift, m/s) !Local variables - real :: top, midpoint, bottom + real :: top, midpoint, bottom ! Depths in Z real :: Sum integer :: kk @@ -1077,16 +1078,16 @@ subroutine Get_SL_Average_Prof( GV, AvgDepth, H, Profile, Average ) bottom = 0.0 do kk = 1, GV%ke Top = Bottom - MidPoint = Bottom - GV%H_to_m * h(kk)/2. - Bottom = Bottom - GV%H_to_m * h(kk) + MidPoint = Bottom - GV%H_to_Z * 0.5*h(kk) + Bottom = Bottom - GV%H_to_Z * h(kk) if (AvgDepth < Bottom) then !Whole cell within H_LA - Sum = Sum + Profile(kk) * (GV%H_to_m * H(kk)) - elseif (AvgDepth < top) then !partial cell within H_LA - Sum = Sum + Profile(kk) * (top-AvgDepth) + Sum = Sum + Profile(kk) * (GV%H_to_Z * H(kk)) + elseif (AvgDepth < Top) then !partial cell within H_LA + Sum = Sum + Profile(kk) * (Top-AvgDepth) endif enddo -! Divide by AvgDepth + ! Divide by AvgDepth !### Consider dividing by the depth in the column if that is smaller. -RWH Average = Sum / abs(AvgDepth) return @@ -1096,15 +1097,15 @@ end subroutine Get_SL_Average_Prof subroutine Get_SL_Average_Band( GV, AvgDepth, NB, WaveNumbers, SurfStokes, Average ) type(verticalGrid_type), & intent(in) :: GV !< Ocean vertical grid - real, intent(in) :: AvgDepth !< Depth to average over (m) + real, intent(in) :: AvgDepth !< Depth to average over (Z) integer, intent(in) :: NB !< Number of bands used real, dimension(NB), & - intent(in) :: WaveNumbers !< Wavenumber corresponding to each band (1/m) + intent(in) :: WaveNumbers !< Wavenumber corresponding to each band (1/Z) real, dimension(NB), & intent(in) :: SurfStokes !< Surface Stokes drift for each band (m/s) real, intent(out) :: Average !< Output average Stokes drift over depth AvgDepth (m/s) + ! Local variables - real :: top, midpoint, bottom integer :: bb ! Loop over bands @@ -1112,9 +1113,9 @@ subroutine Get_SL_Average_Band( GV, AvgDepth, NB, WaveNumbers, SurfStokes, Avera do bb = 1, NB ! Factor includes analytical integration of e(2kz) ! - divided by (-H_LA) to get average from integral. - Average = Average + SurfStokes(BB) / (2.*WaveNumbers(BB)) & - * (1.-EXP( AvgDepth * 2.0 * WaveNumbers(BB) )) & - / abs(AvgDepth) + Average = Average + SurfStokes(BB) * & + (1.-EXP(-abs(AvgDepth * 2.0 * WaveNumbers(BB)))) / & + abs(AvgDepth * 2.0 * WaveNumbers(BB)) enddo return @@ -1130,7 +1131,7 @@ subroutine DHH85_mid(GV, ust, zpt, US) type(verticalGrid_type), & intent(in) :: GV !< Ocean vertical grid real, intent(in) :: UST !< Surface friction velocity (m/s) - real, intent(in) :: ZPT !< Depth to get Stokes drift (m) + real, intent(in) :: ZPT !< Depth to get Stokes drift (Z) !### THIS IS NOT USED YET. real, intent(out) :: US !< Stokes drift (m/s) ! real :: ann, Bnn, Snn, Cnn, Dnn @@ -1145,11 +1146,11 @@ subroutine DHH85_mid(GV, ust, zpt, US) omega_min = 0.1 ! Hz ! Cut off at 30cm for now... omega_max = 6.5 ! ~sqrt(0.2*(GV%g_Earth*GV%m_to_Z)*2*pi/0.3) - domega=0.05 + domega = 0.05 NOmega = (omega_max-omega_min)/domega ! if (WaveAgePeakFreq) then - omega_peak = (GV%g_Earth*GV%m_to_Z)/WA/u10 + omega_peak = (GV%g_Earth*GV%m_to_Z) / (WA * u10) else omega_peak = 2. * pi * 0.13 * (GV%g_Earth*GV%m_to_Z) / U10 endif @@ -1163,15 +1164,15 @@ subroutine DHH85_mid(GV, ust, zpt, US) endif !/ US = 0.0 - omega = omega_min+domega/2. + omega = omega_min + 0.5*domega do oi = 1,nomega-1 - Dnn = exp ( -0.5 * (omega-omega_peak)**2 / Snn**2 / omega_peak**2 ) + Dnn = exp ( -0.5 * (omega-omega_peak)**2 / (Snn**2 * omega_peak**2) ) ! wavespec units = m2s - wavespec = (Ann * (GV%g_Earth*GV%m_to_Z)**2 / (omega_peak*omega**4 ) ) & - *exp(-bnn*(omega_peak/omega)**4)*Cnn**Dnn + wavespec = (Ann * (GV%g_Earth*GV%m_to_Z)**2 / (omega_peak*omega**4 ) ) * & + exp(-bnn*(omega_peak/omega)**4)*Cnn**Dnn ! Stokes units m (multiply by frequency range for units of m/s) Stokes = 2.0 * wavespec * omega**3 * & - exp( 2.0 * omega**2 * zpt/(GV%g_Earth*GV%m_to_Z))/(GV%g_Earth*GV%m_to_Z) + exp( 2.0 * omega**2 * zpt/(GV%g_Earth*GV%m_to_Z)) / (GV%g_Earth*GV%m_to_Z) US=US+Stokes*domega omega = omega + domega enddo @@ -1196,62 +1197,47 @@ subroutine StokesMixing(G, GV, DT, h, u, v, Waves ) type(Wave_parameters_CS), & pointer :: Waves !< Surface wave related control structure. ! Local variables - real :: dTauUp, dTauDn, DVel + real :: dTauUp, dTauDn + real :: h_Lay ! The layer thickness at a velocity point, in Z. integer :: i,j,k ! This is a template to think about down-Stokes mixing. ! This is not ready for use... do k = 1, G%ke - do j = G%jscB, G%jecB ! **Are these index bounds right? - do i = G%iscB, G%iecB ! **Are these index bounds right? - if (k == 1) then - dTauUp = 0. - dTauDn = 0.5*(WAVES%Kvs(i,j,k+1)+WAVES%Kvs(i+1,j,k+1))*& - (waves%us_x(i,j,k)-waves%us_x(i,j,k+1))& - /(GV%H_to_m *0.5*(h(i,j,k)+h(i,j,k+1)) ) - elseif (k < G%ke-1) then - dTauUp = 0.5*(waves%Kvs(i,j,k)+waves%Kvs(i+1,j,k))*& - (waves%us_x(i,j,k-1)-waves%us_x(i,j,k))& - /(GV%H_to_m *0.5*(h(i,j,k-1)+h(i,j,k)) ) - dTauDn = 0.5*(waves%Kvs(i,j,k+1)+waves%Kvs(i+1,j,k+1))*& - (waves%us_x(i,j,k)-waves%us_x(i,j,k+1))& - /(GV%H_to_m *0.5*(h(i,j,k)+h(i,j,k+1)) ) - elseif (k == G%ke) then - dTauUp = 0.5*(waves%Kvs(i,j,k)+waves%Kvs(i+1,j,k))*& - (waves%us_x(i,j,k-1)-waves%us_x(i,j,k))& - /(GV%H_to_m *0.5*(h(i,j,k-1)+h(i,j,k)) ) - dTauDn = 0.0 - endif - DVel = (dTauUp-dTauDn) / (GV%H_to_m *h(i,j,k)) * DT - u(i,j,k) = u(i,j,k)+DVel + do j = G%jsc, G%jec + do I = G%iscB, G%iecB + h_lay = GV%H_to_Z*0.5*(h(i,j,k)+h(i+1,j,k)) + dTauUp = 0.0 + if (k > 1) & + dTauUp = 0.5*(waves%Kvs(i,j,k)+waves%Kvs(i+1,j,k)) * & + (waves%us_x(i,j,k-1)-waves%us_x(i,j,k)) / & + (0.5*(h_lay + GV%H_to_Z*0.5*(h(i,j,k-1)+h(i+1,j,k-1)) )) + dTauDn = 0.0 + if (k < G%ke-1) & + dTauDn = 0.5*(waves%Kvs(i,j,k+1)+waves%Kvs(i+1,j,k+1)) * & + (waves%us_x(i,j,k)-waves%us_x(i,j,k+1)) / & + (0.5*(h_lay + GV%H_to_Z*0.5*(h(i,j,k+1)+h(i+1,j,k+1)) )) + u(i,j,k) = u(i,j,k) + dt * (dTauUp-dTauDn) / h_Lay enddo enddo enddo do k = 1, G%ke - do j = G%jscB, G%jecB ! **Are these index bounds right? - do i = G%iscB, G%iecB ! **Are these index bounds right? - if (k == 1) then - dTauUp = 0. - dTauDn = 0.5*(waves%Kvs(i,j,k+1)+waves%Kvs(i,j+1,k+1))& - *(waves%us_y(i,j,k)-waves%us_y(i,j,k+1))& - /(GV%H_to_m *0.5*(h(i,j,k)+h(i,j,k+1)) ) - elseif (k < G%ke-1) then - dTauUp = 0.5*(waves%Kvs(i,j,k)+waves%Kvs(i,j+1,k))*& - (waves%us_y(i,j,k-1)-waves%us_y(i,j,k))& - /(GV%H_to_m *0.5*(h(i,j,k-1)+h(i,j,k)) ) - dTauDn = 0.5*(waves%Kvs(i,j,k+1)+waves%Kvs(i,j+1,k+1))*& - (waves%us_y(i,j,k)-waves%us_y(i,j,k+1))& - /(GV%H_to_m *0.5*(h(i,j,k)+h(i,j,k+1)) ) - elseif (k == G%ke) then - dTauUp = 0.5*(waves%Kvs(i,j,k)+waves%Kvs(i,j+1,k))*& - (waves%us_y(i,j,k-1)-waves%us_y(i,j,k))& - /(GV%H_to_m *0.5*(h(i,j,k-1)+h(i,j,k)) ) - dTauDn = 0.0 - endif - DVel = (dTauUp-dTauDn) / (GV%H_to_m *h(i,j,k)) * DT - v(i,j,k) = v(i,j,k)+DVel + do J = G%jscB, G%jecB + do i = G%isc, G%iec + h_Lay = GV%H_to_Z*0.5*(h(i,j,k)+h(i,j+1,k)) + dTauUp = 0. + if (k > 1) & + dTauUp = 0.5*(waves%Kvs(i,j,k)+waves%Kvs(i,j+1,k)) * & + (waves%us_y(i,j,k-1)-waves%us_y(i,j,k)) / & + (0.5*(h_lay + GV%H_to_Z*0.5*(h(i,j,k-1)+h(i,j+1,k-1)) )) + dTauDn = 0.0 + if (k < G%ke-1) & + dTauDn =0.5*(waves%Kvs(i,j,k+1)+waves%Kvs(i,j+1,k+1)) * & + (waves%us_y(i,j,k)-waves%us_y(i,j,k+1)) / & + (0.5*(h_lay + GV%H_to_Z*0.5*(h(i,j,k+1)+h(i,j+1,k+1)) )) + v(i,J,k) = v(i,J,k) + dt * (dTauUp-dTauDn) / h_Lay enddo enddo enddo @@ -1283,21 +1269,21 @@ subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES) integer :: i,j,k do k = 1, G%ke - do j = G%jscB, G%jecB !**Are these index bounds right? - do i = G%iscB, G%iecB !**Are these index bounds right? + do j = G%jsc, G%jec + do I = G%iscB, G%iecB DVel = 0.25*(WAVES%us_y(i,j+1,k)+WAVES%us_y(i-1,j+1,k))*G%CoriolisBu(i,j+1) + & 0.25*(WAVES%us_y(i,j,k)+WAVES%us_y(i-1,j,k))*G%CoriolisBu(i,j) - u(i,j,k) = u(i,j,k)+DVEL*DT + u(I,j,k) = u(I,j,k) + DVEL*DT enddo enddo enddo do k = 1, G%ke - do j = G%jscB, G%jecB !**Are these index bounds right? - do i = G%iscB, G%iecB !**Are these index bounds right? + do J = G%jscB, G%jecB + do i = G%isc, G%iec DVel = 0.25*(WAVES%us_x(i+1,j,k)+WAVES%us_x(i+1,j-1,k))*G%CoriolisBu(i+1,j) + & 0.25*(WAVES%us_x(i,j,k)+WAVES%us_x(i,j-1,k))*G%CoriolisBu(i,j) - v(i,j,k) = v(i,j,k)-DVEL*DT + v(i,J,k) = v(i,j,k) - DVEL*DT enddo enddo enddo @@ -1323,24 +1309,24 @@ subroutine ust_2_u10_coare3p5(USTair,U10,GV) ! Note in Edson et al. 2013, eq. 13 m is given as 0.017. However, ! m=0.0017 reproduces the curve in their figure 6. - z0sm = 0.11 * nu / USTair; !Compute z0smooth from ustar guess - u10 = USTair/sqrt(0.001); !Guess for u10 + z0sm = 0.11 * nu * GV%m_to_Z / USTair !Compute z0smooth from ustar guess + u10 = USTair/sqrt(0.001) !Guess for u10 u10a = 1000 CT=0 - do while (abs(u10a/u10-1.)>0.001) + do while (abs(u10a/u10-1.) > 0.001) CT=CT+1 u10a = u10 - alpha = min(0.028,0.0017 * u10 - 0.005) - z0rough = alpha * USTair**2/(GV%g_Earth*GV%m_to_Z) ! Compute z0rough from ustar guess - z0=z0sm+z0rough - CD = ( vonkar / log(10/z0) )**2 ! Compute CD from derived roughness - u10 = USTair/sqrt(CD);!Compute new u10 from derived CD, while loop - ! ends and checks for convergence...CT counter - ! makes sure loop doesn't run away if function - ! doesn't converge. This code was produced offline - ! and converged rapidly (e.g. 2 cycles) - ! for ustar=0.0001:0.0001:10. + alpha = min(0.028, 0.0017 * u10 - 0.005) + z0rough = alpha * USTair**2 / GV%g_Earth ! Compute z0rough from ustar guess + z0 = z0sm + z0rough + CD = ( vonkar / log(10.*GV%m_to_Z / z0) )**2 ! Compute CD from derived roughness + u10 = USTair/sqrt(CD) ! Compute new u10 from derived CD, while loop + ! ends and checks for convergence...CT counter + ! makes sure loop doesn't run away if function + ! doesn't converge. This code was produced offline + ! and converged rapidly (e.g. 2 cycles) + ! for ustar=0.0001:0.0001:10. if (CT>20) then u10 = USTair/sqrt(0.0015) ! I don't expect to get here, but just ! in case it will output a reasonable value. From d748764c7176b25f6ad44c80847c1715b85cec2d Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Tue, 23 Oct 2018 10:31:57 -0400 Subject: [PATCH 0846/1072] Diag decimation, fixed the decimated fields indices --- src/framework/MOM_diag_mediator.F90 | 365 ++++++++++++++-------------- 1 file changed, 187 insertions(+), 178 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 0fe947423a..881c77a76f 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -1330,20 +1330,6 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) locfield => field endif - if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) then - allocate( locfield( lbound(field,1):ubound(field,1), lbound(field,2):ubound(field,2) ) ) - do j=jsv,jev ; do i=isv,iev - if (field(i,j) == diag_cs%missing_value) then - locfield(i,j) = diag_cs%missing_value - else - locfield(i,j) = field(i,j) * diag%conversion_factor - endif - enddo ; enddo - locfield(isv:iev,jsv:jev) = field(isv:iev,jsv:jev) * diag%conversion_factor - else - locfield => field - endif - if (present(mask)) then locmask => mask elseif(.NOT. is_stat) then @@ -1633,7 +1619,7 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) locmask => locmask_decim elseif(associated(diag%axes%decim(dl)%mask3d)) then locmask => diag%axes%decim(dl)%mask3d - endif + endif endif if (diag_cs%diag_as_chksum) then @@ -3443,10 +3429,10 @@ subroutine decimate_diag_masks_set(G, nz, diag_cs) !print*,'coarse c extents ',G%isc_zap2,G%iec_zap2,G%jsc_zap2,G%jec_zap2 !print*,'original d extents ',G%isd,G%ied,G%jsd,G%jed !print*,'coarse d extents ',G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2 -! original c extents 5 52 5 64 -! coarse c extents 5 28 5 34 -! original d extents 1 56 1 68 -! coarse d extents 1 32 1 38 +! original c extents 5 52 5 52 +! coarse c extents 3 26 3 26 +! original d extents 1 56 1 56 +! coarse d extents 1 28 1 28 do dl=2,MAX_DECIM_LEV ! 2d masks @@ -3495,7 +3481,8 @@ subroutine decimate_diag_indices_get(f1,f2, dl, diag_cs,isv,iev,jsv,jev) jsv = diag_cs%decim(dl)%jsc ; jev = diag_cs%decim(dl)%jec if ( f1 == dszi ) then - isv = diag_cs%decim(dl)%isc ; iev = diag_cs%decim(dl)%iec ! Data domain + isv = diag_cs%decim(dl)%isc ; iev = diag_cs%decim(dl)%iec ! field on Data domain, take compute domain indcies + !The rest is not taken with the full MOM6 diag_table elseif ( f1 == dszi + 1 ) then isv = diag_cs%decim(dl)%isc ; iev = diag_cs%decim(dl)%iec+1 ! Symmetric data domain elseif ( f1 == cszi) then @@ -3505,7 +3492,7 @@ subroutine decimate_diag_indices_get(f1,f2, dl, diag_cs,isv,iev,jsv,jev) else write (mesg,*) " peculiar size ",f1," in i-direction\n"//& "does not match one of ", cszi, cszi+1, dszi, dszi+1 - call MOM_error(FATAL,"decimate_diag_field: "//trim(mesg)) + call MOM_error(FATAL,"decimate_diag_indices_get: "//trim(mesg)) endif if ( f2 == dszj ) then jsv = diag_cs%decim(dl)%jsc ; jev = diag_cs%decim(dl)%jec ! Data domain @@ -3518,7 +3505,7 @@ subroutine decimate_diag_indices_get(f1,f2, dl, diag_cs,isv,iev,jsv,jev) else write (mesg,*) " peculiar size ",f2," in j-direction\n"//& "does not match one of ", cszj, cszj+1, dszj, dszj+1 - call MOM_error(FATAL,"decimate_diag_field: "//trim(mesg)) + call MOM_error(FATAL,"decimate_diag_indices_get: "//trim(mesg)) endif end subroutine decimate_diag_indices_get @@ -3529,19 +3516,21 @@ subroutine decimate_diag_field_3d(locfield, locfield_decim, dl, diag_cs, diag,is type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post integer, intent(in) :: dl - integer, intent(out):: isv,iev,jsv,jev + integer, intent(inout):: isv,iev,jsv,jev real, optional,target, intent(in) :: mask(:,:,:) !< If present, use this real array as the data mask. !locals real, dimension(:,:,:), pointer :: locmask - integer :: isl,iel,jsl,jel + integer :: f1,f2,isv_o,jsv_o locmask => NULL() !Get the correct indices corresponding to input field !Shape of the input diag field - isl=1; iel=size(locfield,1)/dl - jsl=1; jel=size(locfield,2)/dl - !Get the shape of the decimated field isv,iev,jsv,jev - call decimate_diag_indices_get(iel,jel, dl, diag_cs,isv,iev,jsv,jev) + f1=size(locfield,1)/dl + f2=size(locfield,2)/dl + !Save the extents of the original (fine) domain + isv_o=isv;jsv_o=jsv + !Get the shape of the decimated field and overwrite isv,iev,jsv,jev with them + call decimate_diag_indices_get(f1,f2, dl, diag_cs,isv,iev,jsv,jev) !Set the non-decimated mask, it must be associated and initialized if (present(mask)) then locmask => mask @@ -3551,7 +3540,8 @@ subroutine decimate_diag_field_3d(locfield, locfield_decim, dl, diag_cs, diag,is call MOM_error(FATAL, "decimate_diag_field_3d: Cannot decimate without a mask!!! ") endif - call decimate_field(locfield, locfield_decim, dl, diag%xyz_method, locmask, diag_cs, diag) + call decimate_field(locfield, locfield_decim, dl, diag%xyz_method, locmask, diag_cs, diag, & + isv_o,jsv_o,isv,iev,jsv,jev) end subroutine decimate_diag_field_3d @@ -3565,15 +3555,17 @@ subroutine decimate_diag_field_2d(locfield, locfield_decim, dl, diag_cs, diag,is real, optional,target, intent(in) :: mask(:,:) !< If present, use this real array as the data mask. !locals real, dimension(:,:), pointer :: locmask - integer :: isl,iel,jsl,jel + integer :: f1,f2,isv_o,jsv_o locmask => NULL() !Get the correct indices corresponding to input field !Shape of the input diag field - isl=1; iel=size(locfield,1)/dl - jsl=1; jel=size(locfield,2)/dl - !Get the shape of the decimated field isv,iev,jsv,jev - call decimate_diag_indices_get(iel,jel, dl, diag_cs,isv,iev,jsv,jev) + f1=size(locfield,1)/dl + f2=size(locfield,2)/dl + !Save the extents of the original (fine) domain + isv_o=isv;jsv_o=jsv + !Get the shape of the decimated field and overwrite isv,iev,jsv,jev with them + call decimate_diag_indices_get(f1,f2, dl, diag_cs,isv,iev,jsv,jev) !Set the non-decimated mask, it must be associated and initialized if (present(mask)) then locmask => mask @@ -3583,66 +3575,70 @@ subroutine decimate_diag_field_2d(locfield, locfield_decim, dl, diag_cs, diag,is call MOM_error(FATAL, "decimate_diag_field_2d: Cannot decimate without a mask!!! ") endif - call decimate_field(locfield, locfield_decim, dl, diag%xyz_method, locmask, diag_cs,diag) + call decimate_field(locfield, locfield_decim, dl, diag%xyz_method, locmask, diag_cs,diag, & + isv_o,jsv_o,isv,iev,jsv,jev) end subroutine decimate_diag_field_2d -!- According to Alistair, the decimation method could be solely deduced -! from the axes%x_cell_method, axes%y_cell_method and probably the area_cell_method -! at the time of send_data -!- This is the summary of the algoritm +!- The decimation method could be deduced (before send_data call) +! from the diag%x_cell_method, diag%y_cell_method and diag%v_cell_method +! +!- This is the summary of the decimation algoritm for a diagnostic field f: ! f(Id,Jd) = \sum_{i,j} f(Id+i,Jd+j) * weight(Id+i,Jd+j) / [ \sum_{i,j} weight(Id+i,Jd+j)] -! Id,Jd are the decimated (coarse grid) indices run over the coarsened compute grid, ! i and j run from 0 to dl-1 (dl being the decimation level) -! if and jf -! weight(if,jf) run over the original fine computre grid +! Id,Jd are the decimated (coarse grid) indices run over the coarsened compute grid, +! if and jf are the original (fine grid) indices ! -!example x_cell y_cell ?_cell weight impemented weight(if,jf) algorithm_id +!example x_cell y_cell v_cell algorithm_id impemented weight(if,jf) !--------------------------------------------------------------------------------------- -!theta mean mean mean A*h A(if,jf)*h(if,jf) 22 -!u point mean mean dy*h dyCu(if,jf)*h(if,jf)*delta(if,Id) 02 -!v mean point mean dx*h dxCv(if,jf)*h(if,jf)*delta(jf,Jd) 20 -!volcello sum sum sum 1 1 11 -!umo point sum sum 1 1*delta(if,Id) 01 -!? sum point sum 1 1*delta(jf,Jd) 10 -!w mean mean point A N/A -!h*theta mean mean sum A N/A +!theta mean mean mean MMM =222 G%areaT(if,jf)*h(if,jf) +!u point mean mean PMM =022 dyCu(if,jf)*h(if,jf)*delta(if,Id) +!? point sum mean PSM =012 dyCu(if,jf)*h(if,jf)*delta(if,Id) right? +!v mean point mean MPM =202 dxCv(if,jf)*h(if,jf)*delta(jf,Jd) +!volcello sum sum sum SSS =111 1 +!T_dfxy_co sum sum point SSP =110 1 right? T_dfxy_cont_tendency_2d +!umo point sum sum PSS =011 1*delta(if,Id) +!vmo sum point sum SPS =101 1*delta(jf,Jd) +!umo_2d point sum point PSP =010 1*delta(if,Id) right? +!vmo_2d sum point point SPP =100 1*delta(jf,Jd) right? +!? point mean point PMP =020 dyCu(if,jf)*delta(if,Id) right? +!? mean point point MPP =200 dxCv(if,jf)*delta(jf,Jd) right? +!w mean mean point MMP =220 G%areaT(if,jf) +!h*theta mean mean sum MMS =221 G%areaT(if,jf) right? ! !delta is the Kroneker delta -!Niki: I am not sure if he meant area_cell_method or z_cell_method for the 4th column -!Niki: I have not used the 4th column at all!!! -subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs, diag) +subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs, diag,isv_o,jsv_o,isv_d,iev_d,jsv_d,jev_d) real, dimension(:,:,:) , pointer :: field_in real, dimension(:,:,:) , allocatable :: field_out integer , intent(in) :: dl - integer, optional, intent(in) :: method !< sampling method, one of 00,01,02,10,20,11,22 + integer, intent(in) :: method !< sampling method, one of 00,01,02,10,20,11,22 real, dimension(:,:,:), pointer :: mask type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post + integer , intent(in) :: isv_o,jsv_o !< original indices, In practice isv_o=jsv_o=1 + integer , intent(in) :: isv_d,iev_d,jsv_d,jev_d !< decimaed indices !locals character(len=240) :: mesg - integer :: i,j,ii,jj,is,js,i0,j0 - integer :: isl,iel,jsl,jel + integer :: i,j,ii,jj,i0,j0 integer :: k,ks,ke real :: ave,total_weight,weight real :: epsilon = 1.0e-20 - !Always start from the first element - is=1 - js=1 - ks=1 ; ke =size(field_in,3) - isl=1; iel=size(field_in,1)/dl - jsl=1; jel=size(field_in,2)/dl - allocate(field_out(isl:iel,jsl:jel,ks:ke)) + ks=1 ; ke =size(field_in,3) + !Allocate the decimated field on the decimated data domain + allocate(field_out(diag_cs%decim(dl)%isd:diag_cs%decim(dl)%ied,diag_cs%decim(dl)%jsd:diag_cs%decim(dl)%jed,ks:ke)) +! allocate(field_out(1:size(field_in,1)/dl,1:size(field_in,2)/dl,ks:ke)) + !Fill the decimated field on the decimated diagnostics (almost always compuate) domain if(method .eq. MMM) then !xyz_method = MMM = 222 - do k= ks,ke ; do j=jsl,jel ; do i=isl,iel - i0 = is+dl*(i-isl) - j0 = js+dl*(j-jsl) + do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) ave = 0.0 total_weight = 0.0 - do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 + do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 +! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 !This seems to be faster!!!! weight = mask(ii,jj,k)*diag_cs%G%areaT(ii,jj)*diag_cs%h(ii,jj,k) total_weight = total_weight + weight ave=ave+field_in(ii,jj,k)*weight @@ -3650,12 +3646,13 @@ subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs, dia field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo elseif(method .eq. SSS) then !xyz_method = SSS = 111 e.g., volcello - do k= ks,ke ; do j=jsl,jel ; do i=isl,iel - i0 = is+dl*(i-isl) - j0 = js+dl*(j-jsl) + do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) ave = 0.0 total_weight = 0.0 - do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 + do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 +! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 weight = mask(ii,jj,k) total_weight = total_weight + weight ave=ave+field_in(ii,jj,k)*weight @@ -3663,12 +3660,13 @@ subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs, dia field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo elseif(method .eq. MMP .or. method .eq. MMS) then !xyz_method = MMP = 220, e.g., or T_advection_xy - do k= ks,ke ; do j=jsl,jel ; do i=isl,iel - i0 = is+dl*(i-isl) - j0 = js+dl*(j-jsl) + do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) ave = 0.0 total_weight = 0.0 - do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 + do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 +! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 weight = mask(ii,jj,k)*diag_cs%G%areaT(ii,jj) total_weight = total_weight + weight ave=ave+field_in(ii,jj,k)*weight @@ -3676,9 +3674,9 @@ subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs, dia field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo elseif(method .eq. PMM) then !xyz_method = PMM = 022 - do k= ks,ke ; do j=jsl,jel ; do i=isl,iel - i0 = is+dl*(i-isl) - j0 = js+dl*(j-jsl) + do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) ave = 0.0 total_weight = 0.0 ii=i0 @@ -3690,9 +3688,9 @@ subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs, dia field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo elseif(method .eq. PSM) then !xyz_method = PSM = 012 - do k= ks,ke ; do j=jsl,jel ; do i=isl,iel - i0 = is+dl*(i-isl) - j0 = js+dl*(j-jsl) + do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) ave = 0.0 total_weight = 0.0 ii=i0 @@ -3704,9 +3702,9 @@ subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs, dia field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo elseif(method .eq. PSS) then !xyz_method = PSS = 011 e.g. umo - do k= ks,ke ; do j=jsl,jel ; do i=isl,iel - i0 = is+dl*(i-isl) - j0 = js+dl*(j-jsl) + do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) ave = 0.0 total_weight = 0.0 ii=i0 @@ -3718,9 +3716,9 @@ subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs, dia field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo elseif(method .eq. SPS) then !xyz_method = SPS = 101 e.g. vmo - do k= ks,ke ; do j=jsl,jel ; do i=isl,iel - i0 = is+dl*(i-isl) - j0 = js+dl*(j-jsl) + do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) ave = 0.0 total_weight = 0.0 jj=j0 @@ -3732,9 +3730,9 @@ subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs, dia field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo elseif(method .eq. MPM) then !xyz_method = MPM = 202 - do k= ks,ke ; do j=jsl,jel ; do i=isl,iel - i0 = is+dl*(i-isl) - j0 = js+dl*(j-jsl) + do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) ave = 0.0 total_weight = 0.0 jj=j0 @@ -3752,7 +3750,7 @@ subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs, dia end subroutine decimate_field_3d -subroutine decimate_field_2d(field_in, field_out, dl, method, mask, diag_cs,diag) +subroutine decimate_field_2d(field_in, field_out, dl, method, mask, diag_cs,diag,isv_o,jsv_o,isv_d,iev_d,jsv_d,jev_d) real, dimension(:,:) , pointer :: field_in real, dimension(:,:) , allocatable :: field_out integer , intent(in) :: dl @@ -3760,26 +3758,27 @@ subroutine decimate_field_2d(field_in, field_out, dl, method, mask, diag_cs,diag real, dimension(:,:), pointer :: mask type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post + integer , intent(in) :: isv_o,jsv_o !< original indices, In practice isv_o=jsv_o=1 + integer , intent(in) :: isv_d,iev_d,jsv_d,jev_d !< decimaed indices !locals character(len=240) :: mesg - integer :: i,j,ii,jj,is,js,i0,j0 - integer :: isl,iel,jsl,jel + integer :: i,j,ii,jj,i0,j0 real :: ave,total_weight,weight real :: epsilon = 1.0e-20 - !Always start from the first element - is=1 - js=1 - isl=1; iel=size(field_in,1)/dl - jsl=1; jel=size(field_in,2)/dl - allocate(field_out(isl:iel,jsl:jel)) - + + !Allocate the decimated field on the decimated data domain + allocate(field_out(diag_cs%decim(dl)%isd:diag_cs%decim(dl)%ied,diag_cs%decim(dl)%jsd:diag_cs%decim(dl)%jed)) +! allocate(field_out(1:size(field_in,1)/dl,1:size(field_in,2)/dl)) + !Fill the decimated field on the decimated diagnostics (almost always compuate) domain + if(method .eq. MMM) then !xyz_method = MMM - do j=jsl,jel ; do i=isl,iel - i0 = is+dl*(i-isl) - j0 = js+dl*(j-jsl) + do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) ave = 0.0 total_weight = 0.0 - do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 + do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 +! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 weight = mask(ii,jj)*diag_cs%G%areaT(ii,jj)*diag_cs%h(ii,jj,1) total_weight = total_weight + weight ave=ave+field_in(ii,jj)*weight @@ -3787,25 +3786,27 @@ subroutine decimate_field_2d(field_in, field_out, dl, method, mask, diag_cs,diag field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo elseif(method .eq. MMP) then !xyz_method = MMP - do j=jsl,jel ; do i=isl,iel - i0 = is+dl*(i-isl) - j0 = js+dl*(j-jsl) + do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) ave = 0.0 total_weight = 0.0 - do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 + do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 +! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 weight = mask(ii,jj)*diag_cs%G%areaT(ii,jj) total_weight = total_weight + weight ave=ave+field_in(ii,jj)*weight enddo; enddo field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo - elseif(method .eq. SSP) then !xyz_method = SSP , e.g., T_dfxy_cont_tendency_2d - do j=jsl,jel ; do i=isl,iel - i0 = is+dl*(i-isl) - j0 = js+dl*(j-jsl) + elseif(method .eq. SSP) then !xyz_method = SSP , e.g., T_dfxy_cont_tendency_2d + do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) ave = 0.0 total_weight = 0.0 - do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 + do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 +! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 weight = mask(ii,jj) total_weight = total_weight + weight ave=ave+field_in(ii,jj)*weight @@ -3813,9 +3814,9 @@ subroutine decimate_field_2d(field_in, field_out, dl, method, mask, diag_cs,diag field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo elseif(method .eq. PSP) then !xyz_method = PSP = 010, e.g., umo_2d - do j=jsl,jel ; do i=isl,iel - i0 = is+dl*(i-isl) - j0 = js+dl*(j-jsl) + do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) ave = 0.0 total_weight = 0.0 ii=i0 @@ -3827,9 +3828,9 @@ subroutine decimate_field_2d(field_in, field_out, dl, method, mask, diag_cs,diag field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo elseif(method .eq. SPP) then !xyz_method = SPP = 100, e.g., vmo_2d - do j=jsl,jel ; do i=isl,iel - i0 = is+dl*(i-isl) - j0 = js+dl*(j-jsl) + do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) ave = 0.0 total_weight = 0.0 jj=j0 @@ -3841,9 +3842,9 @@ subroutine decimate_field_2d(field_in, field_out, dl, method, mask, diag_cs,diag field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo elseif(method .eq. PMP) then !xyz_method = PMP = 020 - do j=jsl,jel ; do i=isl,iel - i0 = is+dl*(i-isl) - j0 = js+dl*(j-jsl) + do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) ave = 0.0 total_weight = 0.0 ii=i0 @@ -3855,9 +3856,9 @@ subroutine decimate_field_2d(field_in, field_out, dl, method, mask, diag_cs,diag field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo elseif(method .eq. MPP) then !xyz_method = MPP = 200 - do j=jsl,jel ; do i=isl,iel - i0 = is+dl*(i-isl) - j0 = js+dl*(j-jsl) + do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) ave = 0.0 total_weight = 0.0 jj=j0 @@ -3875,99 +3876,107 @@ subroutine decimate_field_2d(field_in, field_out, dl, method, mask, diag_cs,diag end subroutine decimate_field_2d -subroutine decimate_mask_3d_p(field_in, field_out, level) - integer , intent(in) :: level +subroutine decimate_mask_3d_p(field_in, field_out, dl) + integer , intent(in) :: dl real, dimension(:,:,:) , pointer :: field_in, field_out - integer :: i,j,ii,jj,is,js,i0,j0 - integer :: isl,iel,jsl,jel + integer :: i,j,ii,jj,i0,j0 + integer :: isv_o,jsv_o,isv_d,iev_d,jsv_d,jev_d integer :: k,ks,ke real :: tot_non_zero !decimated mask = 0 unless the mask value of one of the decimating cells is 1 - is=1 - js=1 + isv_o=1 + jsv_o=1 ks = lbound(field_in,3) ; ke = ubound(field_in,3) - isl=1; iel=size(field_in,1)/level - jsl=1; jel=size(field_in,2)/level - allocate(field_out(isl:iel,jsl:jel,ks:ke)); field_out(:,:,:) = 0.0 - do k= ks,ke ; do j=jsl,jel ; do i=isl,iel - i0 = is+level*(i-isl) - j0 = js+level*(j-jsl) + isv_d=1; iev_d=size(field_in,1)/dl + jsv_d=1; jev_d=size(field_in,2)/dl + allocate(field_out(isv_d:iev_d,jsv_d:jev_d,ks:ke)) + field_out(:,:,:) = 0.0 + do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) tot_non_zero = 0.0 - do ii=i0,i0+level-1 ; do jj=j0,j0+level-1 +! do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 + do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 tot_non_zero = tot_non_zero + field_in(ii,jj,k) enddo;enddo if(tot_non_zero > 0.0) field_out(i,j,k)=1.0 enddo; enddo; enddo end subroutine decimate_mask_3d_p -subroutine decimate_mask_2d_p(field_in, field_out, level) - integer , intent(in) :: level +subroutine decimate_mask_2d_p(field_in, field_out, dl) + integer , intent(in) :: dl real, dimension(:,:) , intent(in) :: field_in real, dimension(:,:) , pointer :: field_out - integer :: i,j,ii,jj,is,js,i0,j0 - integer :: isl,iel,jsl,jel + integer :: i,j,ii,jj,i0,j0 + integer :: isv_o,jsv_o,isv_d,iev_d,jsv_d,jev_d real :: tot_non_zero !decimated mask = 0 unless the mask value of one of the decimating cells is 1 - is=1 - js=1 - isl=1; iel=size(field_in,1)/level - jsl=1; jel=size(field_in,2)/level - allocate(field_out(isl:iel,jsl:jel)); field_out(:,:) = 0.0 - do j=jsl,jel ; do i=isl,iel - i0 = is+level*(i-isl) - j0 = js+level*(j-jsl) + isv_o=1 + jsv_o=1 + isv_d=1; iev_d=size(field_in,1)/dl + jsv_d=1; jev_d=size(field_in,2)/dl + allocate(field_out(isv_d:iev_d,jsv_d:jev_d)) + field_out(:,:) = 0.0 + do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) tot_non_zero = 0.0 - do ii=i0,i0+level-1 ; do jj=j0,j0+level-1 +! do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 + do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 tot_non_zero = tot_non_zero + field_in(ii,jj) enddo;enddo if(tot_non_zero > 0.0) field_out(i,j)=1.0 enddo; enddo end subroutine decimate_mask_2d_p -subroutine decimate_mask_3d_a(field_in, field_out, level) - integer , intent(in) :: level +subroutine decimate_mask_3d_a(field_in, field_out, dl) + integer , intent(in) :: dl real, dimension(:,:,:), pointer :: field_in real, dimension(:,:,:), allocatable :: field_out - integer :: i,j,ii,jj,is,js,i0,j0 - integer :: isl,iel,jsl,jel + integer :: i,j,ii,jj,i0,j0 + integer :: isv_o,jsv_o,isv_d,iev_d,jsv_d,jev_d integer :: k,ks,ke real :: tot_non_zero !decimated mask = 0 unless the mask value of one of the decimating cells is 1 - is=1 - js=1 + isv_o=1 + jsv_o=1 ks = lbound(field_in,3) ; ke = ubound(field_in,3) - isl=1; iel=size(field_in,1)/level - jsl=1; jel=size(field_in,2)/level - allocate(field_out(isl:iel,jsl:jel,ks:ke)); field_out(:,:,:) = 0.0 - do k= ks,ke ; do j=jsl,jel ; do i=isl,iel - i0 = is+level*(i-isl) - j0 = js+level*(j-jsl) + isv_d=1; iev_d=size(field_in,1)/dl + jsv_d=1; jev_d=size(field_in,2)/dl + allocate(field_out(isv_d:iev_d,jsv_d:jev_d,ks:ke)) + field_out(:,:,:) = 0.0 + do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) tot_non_zero = 0.0 - do ii=i0,i0+level-1 ; do jj=j0,j0+level-1 +! do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 + do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 tot_non_zero = tot_non_zero + field_in(ii,jj,k) enddo;enddo if(tot_non_zero > 0.0) field_out(i,j,k)=1.0 enddo; enddo; enddo end subroutine decimate_mask_3d_a -subroutine decimate_mask_2d_a(field_in, field_out, level) - integer , intent(in) :: level +subroutine decimate_mask_2d_a(field_in, field_out, dl) + integer , intent(in) :: dl real, dimension(:,:) , intent(in) :: field_in real, dimension(:,:) , allocatable :: field_out - integer :: i,j,ii,jj,is,js,i0,j0 - integer :: isl,iel,jsl,jel + integer :: i,j,ii,jj,i0,j0 + integer :: isv_o,jsv_o,isv_d,iev_d,jsv_d,jev_d real :: tot_non_zero !decimated mask = 0 unless the mask value of one of the decimating cells is 1 - is=1 - js=1 - isl=1; iel=size(field_in,1)/level - jsl=1; jel=size(field_in,2)/level - allocate(field_out(isl:iel,jsl:jel)); field_out(:,:) = 0.0 - do j=jsl,jel ; do i=isl,iel - i0 = is+level*(i-isl) - j0 = js+level*(j-jsl) + isv_o=1 + jsv_o=1 + isv_d=1; iev_d=size(field_in,1)/dl + jsv_d=1; jev_d=size(field_in,2)/dl + allocate(field_out(isv_d:iev_d,jsv_d:jev_d)) + field_out(:,:) = 0.0 + do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) tot_non_zero = 0.0 - do ii=i0,i0+level-1 ; do jj=j0,j0+level-1 +! do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 + do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 tot_non_zero = tot_non_zero + field_in(ii,jj) enddo;enddo if(tot_non_zero > 0.0) field_out(i,j)=1.0 From 9f45cce5a616dd0ebacbaf557a1623842cb9fe45 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 23 Oct 2018 10:11:50 -0600 Subject: [PATCH 0847/1072] Fix a typo in the description of USE_LEGACY_DIABATIC_DRIVER --- src/core/MOM.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 5000ef110d..8968c888ae 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1665,8 +1665,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "there is no buoyancy forcing, but makes the model \n"//& "faster by eliminating subroutine calls.", default=.false.) call get_param(param_file, "MOM", "USE_LEGACY_DIABATIC_DRIVER", CS%use_legacy_diabatic_driver, & - "If true, use the a legacy version of the diabatic subroutine. \n"//& - "This is temporary and is needed avoid change in answers.", & + "If true, use a legacy version of the diabatic subroutine. \n"//& + "This is temporary and is needed to avoid change in answers.", & default=.true.) call get_param(param_file, "MOM", "DO_DYNAMICS", CS%do_dynamics, & "If False, skips the dynamics calls that update u & v, as well as \n"//& From c6f1ac01fb511bd263667fa50b8253d9e7095aeb Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 23 Oct 2018 10:54:04 -0600 Subject: [PATCH 0848/1072] Add missing register* and safe_alloc* for wd --- .../vertical/MOM_diabatic_driver.F90 | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 8e83f4f97a..5af388e50a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -2948,12 +2948,6 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, if (GV%Boussinesq) then ; thickness_units = "m" else ; thickness_units = "kg m-2" ; endif - ! used by layer diabatic - CS%id_ea = register_diag_field('ocean_model','ea',diag%axesTL,Time, & - 'Layer entrainment from above per timestep','m') - CS%id_eb = register_diag_field('ocean_model','eb',diag%axesTL,Time, & - 'Layer entrainment from below per timestep', 'm') - CS%id_ea_t = register_diag_field('ocean_model','ea_t',diag%axesTL,Time, & 'Layer (heat) entrainment from above per timestep','m') CS%id_eb_t = register_diag_field('ocean_model','eb_t',diag%axesTL,Time, & @@ -2962,10 +2956,20 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, 'Layer (salt) entrainment from above per timestep','m') CS%id_eb_s = register_diag_field('ocean_model','eb_s',diag%axesTL,Time, & 'Layer (salt) entrainment from below per timestep', 'm') + ! used by layer diabatic + CS%id_ea = register_diag_field('ocean_model','ea',diag%axesTL,Time, & + 'Layer entrainment from above per timestep','m') + CS%id_eb = register_diag_field('ocean_model','eb',diag%axesTL,Time, & + 'Layer entrainment from below per timestep', 'm') + CS%id_wd = register_diag_field('ocean_model','wd',diag%axesTi,Time, & + 'Diapycnal velocity', 'm s-1') + if (CS%id_wd > 0) call safe_alloc_ptr(CDp%diapyc_vel,isd,ied,jsd,jed,nz+1) + CS%id_dudt_dia = register_diag_field('ocean_model','dudt_dia',diag%axesCuL,Time, & 'Zonal Acceleration from Diapycnal Mixing', 'm s-2') CS%id_dvdt_dia = register_diag_field('ocean_model','dvdt_dia',diag%axesCvL,Time, & 'Meridional Acceleration from Diapycnal Mixing', 'm s-2') + if (CS%use_int_tides) then CS%id_cg1 = register_diag_field('ocean_model','cn1', diag%axesT1, & Time, 'First baroclinic mode (eigen) speed', 'm s-1') From 204a767f9ad96e28268011390203d5e6b0627401 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 23 Oct 2018 17:44:16 +0000 Subject: [PATCH 0849/1072] Corrected intent of some variables - ice_shelf_advect_temp_*() has G intent(inout) but should be intent(in) - KPP_compute_BLD() and KPP_smooth_BLD() had G intent(in), now intent(inout) - set_visc_init() had G intent(in), now intent(inout) - Thanks to @jiandewang for reporting issue when evaluating PR #862 --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 4 ++-- src/parameterizations/vertical/MOM_CVMix_KPP.F90 | 4 ++-- src/parameterizations/vertical/MOM_set_viscosity.F90 | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 23ec85d8c5..eea9ee322a 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -3609,7 +3609,7 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step !< The time step for this update, in s. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: hmask !< A mask indicating which tracer points are + intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: h0 !< The initial ice shelf thicknesses in m. @@ -3850,7 +3850,7 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step !< The time step for this update, in s. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: hmask !< A mask indicating which tracer points are + intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: h_after_uflux !< The ice shelf thicknesses after diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index e03d217414..dec3187a99 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -864,7 +864,7 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux, ! Arguments type(KPP_CS), pointer :: CS !< Control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(ocean_grid_type), intent(inout) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) @@ -1308,7 +1308,7 @@ end subroutine KPP_compute_BLD subroutine KPP_smooth_BLD(CS,G,GV,h) ! Arguments type(KPP_CS), pointer :: CS !< Control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(ocean_grid_type), intent(inout) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 4e75bcacc2..af2dce00d6 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1806,7 +1806,7 @@ end subroutine set_visc_register_restarts !> Initializes the MOM_set_visc control structure subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, restart_CS, OBC) type(time_type), target, intent(in) :: Time !< The current model time. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. From 9f0076a493bfd57e31c5490a47a91c276d9de02e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 23 Oct 2018 19:22:54 -0400 Subject: [PATCH 0850/1072] Corrected openMP directive errors in recent commit Corrected a number of openMP directives that had been broken by a recent set of commits. The code would not compile with openMP enabled without these changes. All answers are bitwise identical, and answers have been verified to reproduce with 1 and 2 threads for the SIS2_cgrid_bergs test case. --- src/core/MOM_PressureForce_Montgomery.F90 | 2 +- src/core/MOM_PressureForce_blocked_AFV.F90 | 2 +- src/core/MOM_isopycnal_slopes.F90 | 38 ++++++++-------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 18 ++------ .../vertical/MOM_set_diffusivity.F90 | 4 +- .../vertical/MOM_set_viscosity.F90 | 45 +++++-------------- .../vertical/MOM_vert_friction.F90 | 4 +- 7 files changed, 39 insertions(+), 74 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index f8657fca2d..4f295600cd 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -679,7 +679,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) enddo ! end of j loop endif else ! not use_EOS - !$OMP parallel do default(share) private(Ihtot) + !$OMP parallel do default(shared) private(Ihtot) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 Ihtot(i) = 1.0 / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 7cd449f86f..cd5961c23d 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -618,7 +618,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at endif !$OMP parallel do default(none) shared(use_p_atm,rho_ref,G,GV,e,p_atm,nz,use_EOS,& -!$OMP use_ALE,T_t,T_b,S_t,S_b,CS,tv,tv_tmp, & +!$OMP use_ALE,T_t,T_b,S_t,S_b,CS,tv,tv_tmp,g_Earth_z, & !$OMP h,PFu,I_Rho0,h_neglect,dz_neglect,PFv,dM)& !$OMP private(is_bk,ie_bk,js_bk,je_bk,Isq_bk,Ieq_bk,Jsq_bk, & !$OMP Jeq_bk,ioff_bk,joff_bk,pa_bk, & diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 3698c32afe..41b9bef817 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -137,27 +137,25 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & endif ! Find the maximum and minimum permitted streamfunction. -!$OMP parallel default(none) shared(is,ie,js,je,pres,GV,h,nz) -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 pres(i,j,1) = 0.0 ! ### This should be atmospheric pressure. pres(i,j,2) = pres(i,j,1) + GV%H_to_Pa*h(i,j,1) enddo ; enddo -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 do k=2,nz ; do i=is-1,ie+1 pres(i,j,K+1) = pres(i,j,K) + GV%H_to_Pa*h(i,j,k) enddo ; enddo enddo -!$OMP end parallel - -!$OMP parallel do default(none) shared(nz,is,ie,js,je,use_EOS,G,GV,pres,T,S, & -!$OMP IsdB,tv,h,h_neglect,e,dz_neglect, & -!$OMP h_neglect2,present_N2_u,G_Rho0,N2_u,slope_x) & -!$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & -!$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, & -!$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & -!$OMP drdx,mag_grad2,Slope,slope2_Ratio) + + !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,pres,T,S,tv, & + !$OMP h,h_neglect,e,dz_neglect,Z_to_L,L_to_Z,H_to_Z, & + !$OMP h_neglect2,present_N2_u,G_Rho0,N2_u,slope_x) & + !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & + !$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, & + !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & + !$OMP drdx,mag_grad2,Slope,slope2_Ratio) do j=js,je ; do K=nz,2,-1 if (.not.(use_EOS)) then drdiA = 0.0 ; drdiB = 0.0 @@ -237,14 +235,14 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & enddo ! I enddo ; enddo ! end of j-loop - ! Calculate the meridional isopycnal slope. -!$OMP parallel do default(none) shared(nz,is,ie,js,je,use_EOS,G,GV,pres,T,S, & -!$OMP IsdB,tv,h,h_neglect,e,dz_neglect, & -!$OMP h_neglect2,present_N2_v,G_Rho0,N2_v,slope_y) & -!$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, & -!$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, & -!$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & -!$OMP drdy,mag_grad2,Slope,slope2_Ratio) + ! Calculate the meridional isopycnal slope. + !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,pres,T,S,tv, & + !$OMP h,h_neglect,e,dz_neglect,Z_to_L,L_to_Z,H_to_Z, & + !$OMP h_neglect2,present_N2_v,G_Rho0,N2_v,slope_y) & + !$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, & + !$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, & + !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & + !$OMP drdy,mag_grad2,Slope,slope2_Ratio) do j=js-1,je ; do K=nz,2,-1 if (.not.(use_EOS)) then drdjA = 0.0 ; drdjB = 0.0 diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index b4da411aac..7f33140fb7 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -426,9 +426,8 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: slope_y !< Meridional isoneutral slope real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: N2_v !< Brunt-Vaisala frequency at v-points (1/s2) type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + ! Local variables - real :: E_x(SZIB_(G), SZJ_(G)) ! X-slope of interface at u points (for diagnostics) - real :: E_y(SZI_(G), SZJB_(G)) ! Y-slope of interface at u points (for diagnostics) real :: Khth_Loc ! Locally calculated thickness mixing coefficient (m2/s) real :: S2 ! Interface slope squared (non-dim) real :: N2 ! Brunt-Vaisala frequency (1/s) @@ -437,8 +436,6 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) integer :: is, ie, js, je, nz integer :: i, j, k, kb_max real :: S2max, wNE, wSE, wSW, wNW - real :: SN_u_local(SZIB_(G), SZJ_(G),SZK_(G)) - real :: SN_v_local(SZI_(G), SZJB_(G),SZK_(G)) real :: H_u(SZIB_(G)), H_v(SZI_(G)) real :: S2_u(SZIB_(G), SZJ_(G)) real :: S2_v(SZI_(G), SZJB_(G)) @@ -455,12 +452,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) S2max = CS%Visbeck_S_max**2 -!$OMP parallel default(none) shared(is,ie,js,je,CS,nz,e,G,GV,h, & -!$OMP S2_u,S2_v,slope_x,slope_y, & -!$OMP SN_u_local,SN_v_local,N2_u,N2_v, S2max) & -!$OMP private(E_x,E_y,S2,H_u,H_v,Hdn,Hup,H_geom,N2, & -!$OMP wNE, wSE, wSW, wNW) -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 CS%SN_u(i,j) = 0.0 CS%SN_v(i,j) = 0.0 @@ -470,7 +462,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) ! calculate the first-mode gravity wave speed and then blend the equatorial ! and midlatitude deformation radii, using calc_resoln_function as a template. -!$OMP do + !$OMP parallel do default(shared) private(S2,H_u,Hdn,Hup,H_geom,N2,wNE,wSE,wSW,wNW) do j = js,je do I=is-1,ie CS%SN_u(I,j) = 0. ; H_u(I) = 0. ; S2_u(I,j) = 0. @@ -516,7 +508,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) enddo enddo -!$OMP do + !$OMP parallel do default(shared) private(S2,H_v,Hdn,Hup,H_geom,N2,wNE,wSE,wSW,wNW) do J = js-1,je do i=is,ie CS%SN_v(i,J) = 0. ; H_v(i) = 0. ; S2_v(i,J) = 0. @@ -562,8 +554,6 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) enddo enddo -!$OMP end parallel - ! Offer diagnostic fields for averaging. if (query_averaging_enabled(CS%diag)) then if (CS%id_S2_u > 0) call post_data(CS%id_S2_u, S2_u, CS%diag) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 873a61d7b8..e5e55ec590 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -555,13 +555,13 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%Kd_add > 0.0) then if (present(Kd_int)) then -!$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_int,CS,Kd) + !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie Kd_int(i,j,K) = Kd_int(i,j,K) + CS%Kd_add Kd_lay(i,j,k) = Kd_lay(i,j,k) + CS%Kd_add enddo ; enddo ; enddo else -!$OMP parallel do default(none) shared(is,ie,js,je,nz,CS,Kd) + !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie Kd_lay(i,j,k) = Kd_lay(i,j,k) + CS%Kd_add enddo ; enddo ; enddo diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 4e75bcacc2..e8844d88c5 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -375,20 +375,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (.not.use_BBL_EOS) Rml_vel(:,:) = 0.0 -!$OMP parallel do default(none) shared(u, v, h, tv, visc, G, GV, CS, Rml, is, ie, js, je, & -!$OMP nz, Isq, Ieq, Jsq, Jeq, nkmb, h_neglect, Rho0x400_G,& -!$OMP C2pi_3, U_bg_sq, cdrag_sqrt,K2,use_BBL_EOS,OBC, & -!$OMP maxitt,nkml,Vol_quit,D_u,D_v,mask_u,mask_v) & -!$OMP private(do_i,h_at_vel,htot_vel,hwtot,hutot,Thtot,Shtot, & -!$OMP hweight,v_at_u,u_at_v,ustar,T_EOS,S_EOS,press, & -!$OMP dR_dT, dR_dS,ustarsq,htot,T_vel,S_vel,Rml_vel, & -!$OMP oldfn,Dfn,Dh,Rhtot,C2f,ustH,root,bbl_thick, & -!$OMP D_vel,tmp,Dp,Dm,a_3,a,a_12,slope,Vol_open,Vol_2_reg,& -!$OMP C24_a,apb_4a,Iapb,a2x48_apb3,ax2_3apb,Vol_direct, & -!$OMP L_direct,Ibma_2,L,vol,vol_below,Vol_err,h_vel_pos, & -!$OMP BBL_visc_frac,h_vel,L0,Vol_0,dV_dL2,dVol,L_max, & -!$OMP L_min,Vol_err_min,Vol_err_max,BBL_frac,Cell_width, & -!$OMP gam,Rayleigh, Vol_tol, tmp_val_m1_to_p1) + !$OMP parallel do default(private) shared(u,v,h,tv,visc,G,GV,CS,Rml,is,ie,js,je,nz,nkmb, & + !$OMP nkml,Isq,Ieq,Jsq,Jeq,h_neglect,Rho0x400_G,C2pi_3, & + !$OMP U_bg_sq,cdrag_sqrt_Z,cdrag_sqrt,K2,use_BBL_EOS, & + !$OMP OBC,maxitt,Vol_quit,D_u,D_v,mask_u,mask_v) do j=Jsq,Jeq ; do m=1,2 if (m==1) then @@ -1211,16 +1201,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) endif enddo ; endif -!$OMP parallel do default(none) shared(u, v, h, tv, forces, visc, dt, G, GV, CS, use_EOS, & -!$OMP dt_Rho0, h_neglect, h_tiny, g_H_Rho0,js,je,OBC, & -!$OMP Isq, Ieq, nz, U_bg_sq,mask_v, & -!$OMP cdrag_sqrt,Rho0x400_G,nkml) & -!$OMP private(do_any,htot,do_i,k_massive,Thtot,uhtot,vhtot,U_star, & -!$OMP Idecay_len_TKE,press,k2,I_2hlay,T_EOS,S_EOS,dR_dT, & -!$OMP dR_dS,hlay,v_at_u,Uh2,T_lay,S_lay,gHprime, & -!$OMP RiBulk,Shtot,Rhtot,absf,do_any_shelf, & -!$OMP h_at_vel,ustar,htot_vel,hwtot,hutot,hweight,ustarsq, & -!$OMP oldfn,Dfn,Dh,Rlay,Rlb,h2f2,ustar1) + !$OMP parallel do default(private) shared(u,v,h,tv,forces,visc,dt,G,GV,CS,use_EOS,dt_Rho0, & + !$OMP h_neglect,h_tiny,g_H_Rho0,js,je,OBC,Isq,Ieq,nz, & + !$OMP U_bg_sq,mask_v,cdrag_sqrt,cdrag_sqrt_Z,Rho0x400_G,nkml) do j=js,je ! u-point loop if (CS%dynamic_viscous_ML) then do_any = .false. @@ -1453,17 +1436,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) enddo ! j-loop at u-points -!$OMP parallel do default(none) shared(u, v, h, tv, forces, visc, dt, G, GV, CS, use_EOS,& -!$OMP dt_Rho0, h_neglect, h_tiny, g_H_Rho0,is,ie,OBC, & -!$OMP Jsq,Jeq,nz,U_bg_sq,cdrag_sqrt,Rho0x400_G,nkml, & -!$OMP mask_u) & -!$OMP private(do_any,htot,do_i,k_massive,Thtot,vhtot,uhtot,absf,& -!$OMP U_star,Idecay_len_TKE,press,k2,I_2hlay,T_EOS, & -!$OMP S_EOS,dR_dT, dR_dS,hlay,u_at_v,Uh2, & -!$OMP T_lay,S_lay,gHprime,RiBulk,do_any_shelf, & -!$OMP Shtot,Rhtot,ustar,h_at_vel,htot_vel,hwtot, & -!$OMP hutot,hweight,ustarsq,oldfn,Dh,Rlay,Rlb,Dfn, & -!$OMP h2f2,ustar1) + !$OMP parallel do default(private) shared(u,v,h,tv,forces,visc,dt,G,GV,CS,use_EOS,dt_Rho0, & + !$OMP h_neglect,h_tiny,g_H_Rho0,is,ie,OBC,Jsq,Jeq,nz, & + !$OMP U_bg_sq,cdrag_sqrt,cdrag_sqrt_Z,Rho0x400_G,nkml,mask_u) do J=Jsq,Jeq ! v-point loop if (CS%dynamic_viscous_ML) then do_any = .false. diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 9014243e56..57bf5a3ab6 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -671,7 +671,9 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) allocate(CS%a1_shelf_v(G%isd:G%ied,G%JsdB:G%JedB)) ; CS%a1_shelf_v(:,:)=0.0 endif - !$OMP parallel do default(shared) firstprivate(i_hbbl) + !$OMP parallel do default(private) shared(G,GV,CS,visc,Isq,Ieq,nz,u,h,forces,hML_u, & + !$OMP OBC,h_neglect,dt,I_valBL,Kv_u) & + !$OMP firstprivate(i_hbbl) do j=G%Jsc,G%Jec do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo From d3eecefdb8bec63639cd1d68bbe72840e23d52af Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 24 Oct 2018 09:09:25 -0400 Subject: [PATCH 0851/1072] (*)Fixed dimensional scaling for Boussinesq Flather Corrected dimensional rescaling for Boussinesq Flather OBCs, so the code now gives identical answers in the circle_OBCS test case for various values of H_RESCALE_POWER and partly corrected problems that will arise with the non-Boussinesq version of the Flather OBCs, although this mode still is not working. All answers in the test cases are bitwise identical. --- src/core/MOM_barotropic.F90 | 32 ++++++++++++-------------------- 1 file changed, 12 insertions(+), 20 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 17d0779ef1..70e40ebbd6 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -61,20 +61,20 @@ module MOM_barotropic type, private :: BT_OBC_type real, dimension(:,:), pointer :: Cg_u => NULL() !< The external wave speed at u-points, in m s-1. real, dimension(:,:), pointer :: Cg_v => NULL() !< The external wave speed at u-points, in m s-1. - real, dimension(:,:), pointer :: H_u => NULL() !< The total thickness at the u-points, in m or kg m-2. - real, dimension(:,:), pointer :: H_v => NULL() !< The total thickness at the v-points, in m or kg m-2. + real, dimension(:,:), pointer :: H_u => NULL() !< The total thickness at the u-points, in H (m or kg m-2). + real, dimension(:,:), pointer :: H_v => NULL() !< The total thickness at the v-points, in H (m or kg m-2). real, dimension(:,:), pointer :: uhbt => NULL() !< The zonal barotropic thickness fluxes specified - !! for open boundary conditions (if any), in units of m3 s-1. + !! for open boundary conditions (if any), in units of H m2 s-1. real, dimension(:,:), pointer :: vhbt => NULL() !< The meridional barotropic thickness fluxes specified - !! for open boundary conditions (if any), in units of m3 s-1. + !! for open boundary conditions (if any), in units of H m2 s-1. real, dimension(:,:), pointer :: ubt_outer => NULL() !< The zonal velocities just outside the domain, !! as set by the open boundary conditions, in units of m s-1. real, dimension(:,:), pointer :: vbt_outer => NULL() !< The meridional velocities just outside the domain, !! as set by the open boundary conditions, in units of m s-1. real, dimension(:,:), pointer :: eta_outer_u => NULL() !< The surface height outside of the domain - !! at a u-point with an open boundary condition, in units of m or kg m-2. + !! at a u-point with an open boundary condition, in units of H. real, dimension(:,:), pointer :: eta_outer_v => NULL() !< The surface height outside of the domain - !! at a v-point with an open boundary condition, in units of m or kg m-2. + !! at a v-point with an open boundary condition, in units of H. logical :: apply_u_OBCs !< True if this PE has an open boundary at a u-point. logical :: apply_v_OBCs !< True if this PE has an open boundary at a v-point. !>@{ Index ranges for the open boundary conditions @@ -2422,8 +2422,8 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, real :: vel_prev ! The previous velocity in m s-1. real :: vel_trans ! The combination of the previous and current velocity ! that does the mass transport, in m s-1. - real :: H_u ! The total thickness at the u-point, in m or kg m-2. - real :: H_v ! The total thickness at the v-point, in m or kg m-2. + real :: H_u ! The total thickness at the u-point, in H (often m or kg m-2). + real :: H_v ! The total thickness at the v-point, in H (often m or kg m-2). real :: cfl ! The CFL number at the point in question, ND. real :: u_inlet real :: v_inlet @@ -2630,7 +2630,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co else if (Datu(I,j) > 0.0) BT_OBC%ubt_outer(I,j) = BT_OBC%uhbt(I,j) / Datu(I,j) endif - else ! This is assuming Flather as only other option + else ! This is assuming Flather as only other option if (GV%Boussinesq) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then BT_OBC%H_u(I,j) = G%bathyT(i,j)*GV%Z_to_H + eta(i,j) @@ -2640,15 +2640,11 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co else if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then BT_OBC%H_u(I,j) = eta(i,j) - BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1) * (G%bathyT(i,j) + GV%m_to_Z*eta(i,j))) !### * GV%H_to_m? elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then BT_OBC%H_u(I,j) = eta(i+1,j) - BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1) * (G%bathyT(i+1,j) + GV%m_to_Z*eta(i+1,j))) !### * GV%H_to_m? endif endif - if (GV%Boussinesq) then - BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1)*GV%m_to_Z * BT_OBC%H_u(i,j)) !### * GV%H_to_m? - endif + BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1) * GV%H_to_Z*BT_OBC%H_u(i,j)) endif endif ; enddo ; enddo if (OBC%Flather_u_BCs_exist_globally) then @@ -2686,7 +2682,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co else if (Datv(i,J) > 0.0) BT_OBC%vbt_outer(i,J) = BT_OBC%vhbt(i,J) / Datv(i,J) endif - else ! This is assuming Flather as only other option + else ! This is assuming Flather as only other option if (GV%Boussinesq) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then BT_OBC%H_v(i,J) = G%bathyT(i,j)*GV%Z_to_H + eta(i,j) @@ -2696,15 +2692,11 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co else if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then BT_OBC%H_v(i,J) = eta(i,j) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j) + eta(i,j)*GV%m_to_Z)) !### * GV%H_to_m? elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then BT_OBC%H_v(i,J) = eta(i,j+1) - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * (G%bathyT(i,j+1) + eta(i,j+1)*GV%m_to_Z)) !### * GV%H_to_m? endif endif - if (GV%Boussinesq) then - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1)*GV%m_to_Z * BT_OBC%H_v(i,J)) !### * GV%H_to_m? - endif + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * GV%H_to_Z*BT_OBC%H_v(i,J)) endif endif ; enddo ; enddo if (OBC%Flather_v_BCs_exist_globally) then From c0ffbf0a621b4cbf074d4bd46de5dd21a1b20ed1 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Wed, 24 Oct 2018 11:05:59 -0400 Subject: [PATCH 0852/1072] Add missing diag_id check before post_data The diag_id check was missing causing crash in some models. --- src/core/MOM_forcing_type.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 11b94a2c0c..d41bac42c5 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -2355,7 +2355,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) ! endif if (associated(fluxes%heat_added)) res(i,j) = res(i,j) + fluxes%heat_added(i,j) enddo ; enddo - call post_data(handles%id_net_heat_surface, res, diag) + if (handles%id_net_heat_surface > 0) call post_data(handles%id_net_heat_surface, res, diag) if (handles%id_total_net_heat_surface > 0) then total_transport = global_area_integral(res,G) From de8f1b66df6696e8a2b0c7c1f696bc8f6a0b2281 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Thu, 25 Oct 2018 10:27:30 -0400 Subject: [PATCH 0853/1072] Diag decimation, check the commensurate condition - Beware! Currently only commensurate layouts are supported. I.e., the decimated subgrid cells should all be contained in the same core (pe). For this to happend the layout of the model runs should be chosen so that NIGLOBAL/layout_x and NJGLOBAL/layout_y are both divisible by dl (decimation level) if a _dl diagnostics is present in the diag_table - This is a major limitition of the current implementation. But the extension to arbitrary layouts would required cross processor communications (halo updates) which may slow down the model considerably and beat the purpose of decimation. --- src/framework/MOM_diag_mediator.F90 | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index e6de2309e3..a31f8e8f69 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -3512,8 +3512,24 @@ subroutine decimate_diag_indices_get(f1,f2, dl, diag_cs,isv,iev,jsv,jev) integer, intent(out) ::isv,iev,jsv,jev !< diagnostics-compute indices (to be passed to send_data) ! Local variables integer :: dszi,cszi,dszj,cszj - character(len=300) :: mesg - + character(len=500) :: mesg + logical, save :: first_check = .true. + + !Check ONCE that the decimated diag-compute domain is commensurate with the original non-decimated diag-compute domain + !This is a major limitation of the current implementation of the decimated diagnostics. + !We assume that the compute domain can be subdivided to dl*dl cells, hence avoiding the need of halo updates. + !We want this check to error out only if there was a decimated diagnostics requested and about to post that is + !why the check is here and not in the init routines. This check need to be done only once, hence the outer if statement + if(first_check) then + if(mod(diag_cs%ie-diag_cs%is+1, dl) .ne. 0 .OR. mod(diag_cs%je-diag_cs%js+1, dl) .ne. 0) then + write (mesg,*) "Non-commensurate decimated domain is not supported. "//& + "Please choose a layout such that NIGLOBAL/Layout_X and NJGLOBAL/Layout_Y are both divisible by dl=",dl, " Current domain extents: ",& + diag_cs%is,diag_cs%ie, diag_cs%js,diag_cs%je + call MOM_error(FATAL,"decimate_diag_indices_get: "//trim(mesg)) + endif + first_check = .false. + endif + cszi = diag_cs%decim(dl)%iec-diag_cs%decim(dl)%isc +1 ; dszi = diag_cs%decim(dl)%ied-diag_cs%decim(dl)%isd +1 cszj = diag_cs%decim(dl)%jec-diag_cs%decim(dl)%jsc +1 ; dszj = diag_cs%decim(dl)%jed-diag_cs%decim(dl)%jsd +1 From 6c98b8e16908b2f838bfdfb9de5a789e12e974c0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 23 Oct 2018 19:22:54 -0400 Subject: [PATCH 0854/1072] Corrected openMP directive errors in recent commit Corrected a number of openMP directives that had been broken by a recent set of commits. The code would not compile with openMP enabled without these changes. All answers are bitwise identical, and answers have been verified to reproduce with 1 and 2 threads for the SIS2_cgrid_bergs test case. --- src/core/MOM_PressureForce_Montgomery.F90 | 2 +- src/core/MOM_PressureForce_blocked_AFV.F90 | 2 +- src/core/MOM_isopycnal_slopes.F90 | 38 ++++++++-------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 18 ++------ .../vertical/MOM_set_diffusivity.F90 | 4 +- .../vertical/MOM_set_viscosity.F90 | 45 +++++-------------- .../vertical/MOM_vert_friction.F90 | 4 +- 7 files changed, 39 insertions(+), 74 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index f8657fca2d..4f295600cd 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -679,7 +679,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) enddo ! end of j loop endif else ! not use_EOS - !$OMP parallel do default(share) private(Ihtot) + !$OMP parallel do default(shared) private(Ihtot) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 Ihtot(i) = 1.0 / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 7cd449f86f..cd5961c23d 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -618,7 +618,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at endif !$OMP parallel do default(none) shared(use_p_atm,rho_ref,G,GV,e,p_atm,nz,use_EOS,& -!$OMP use_ALE,T_t,T_b,S_t,S_b,CS,tv,tv_tmp, & +!$OMP use_ALE,T_t,T_b,S_t,S_b,CS,tv,tv_tmp,g_Earth_z, & !$OMP h,PFu,I_Rho0,h_neglect,dz_neglect,PFv,dM)& !$OMP private(is_bk,ie_bk,js_bk,je_bk,Isq_bk,Ieq_bk,Jsq_bk, & !$OMP Jeq_bk,ioff_bk,joff_bk,pa_bk, & diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 3698c32afe..41b9bef817 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -137,27 +137,25 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & endif ! Find the maximum and minimum permitted streamfunction. -!$OMP parallel default(none) shared(is,ie,js,je,pres,GV,h,nz) -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 pres(i,j,1) = 0.0 ! ### This should be atmospheric pressure. pres(i,j,2) = pres(i,j,1) + GV%H_to_Pa*h(i,j,1) enddo ; enddo -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 do k=2,nz ; do i=is-1,ie+1 pres(i,j,K+1) = pres(i,j,K) + GV%H_to_Pa*h(i,j,k) enddo ; enddo enddo -!$OMP end parallel - -!$OMP parallel do default(none) shared(nz,is,ie,js,je,use_EOS,G,GV,pres,T,S, & -!$OMP IsdB,tv,h,h_neglect,e,dz_neglect, & -!$OMP h_neglect2,present_N2_u,G_Rho0,N2_u,slope_x) & -!$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & -!$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, & -!$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & -!$OMP drdx,mag_grad2,Slope,slope2_Ratio) + + !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,pres,T,S,tv, & + !$OMP h,h_neglect,e,dz_neglect,Z_to_L,L_to_Z,H_to_Z, & + !$OMP h_neglect2,present_N2_u,G_Rho0,N2_u,slope_x) & + !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & + !$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, & + !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & + !$OMP drdx,mag_grad2,Slope,slope2_Ratio) do j=js,je ; do K=nz,2,-1 if (.not.(use_EOS)) then drdiA = 0.0 ; drdiB = 0.0 @@ -237,14 +235,14 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & enddo ! I enddo ; enddo ! end of j-loop - ! Calculate the meridional isopycnal slope. -!$OMP parallel do default(none) shared(nz,is,ie,js,je,use_EOS,G,GV,pres,T,S, & -!$OMP IsdB,tv,h,h_neglect,e,dz_neglect, & -!$OMP h_neglect2,present_N2_v,G_Rho0,N2_v,slope_y) & -!$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, & -!$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, & -!$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & -!$OMP drdy,mag_grad2,Slope,slope2_Ratio) + ! Calculate the meridional isopycnal slope. + !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,pres,T,S,tv, & + !$OMP h,h_neglect,e,dz_neglect,Z_to_L,L_to_Z,H_to_Z, & + !$OMP h_neglect2,present_N2_v,G_Rho0,N2_v,slope_y) & + !$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, & + !$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, & + !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & + !$OMP drdy,mag_grad2,Slope,slope2_Ratio) do j=js-1,je ; do K=nz,2,-1 if (.not.(use_EOS)) then drdjA = 0.0 ; drdjB = 0.0 diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index b4da411aac..7f33140fb7 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -426,9 +426,8 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: slope_y !< Meridional isoneutral slope real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: N2_v !< Brunt-Vaisala frequency at v-points (1/s2) type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + ! Local variables - real :: E_x(SZIB_(G), SZJ_(G)) ! X-slope of interface at u points (for diagnostics) - real :: E_y(SZI_(G), SZJB_(G)) ! Y-slope of interface at u points (for diagnostics) real :: Khth_Loc ! Locally calculated thickness mixing coefficient (m2/s) real :: S2 ! Interface slope squared (non-dim) real :: N2 ! Brunt-Vaisala frequency (1/s) @@ -437,8 +436,6 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) integer :: is, ie, js, je, nz integer :: i, j, k, kb_max real :: S2max, wNE, wSE, wSW, wNW - real :: SN_u_local(SZIB_(G), SZJ_(G),SZK_(G)) - real :: SN_v_local(SZI_(G), SZJB_(G),SZK_(G)) real :: H_u(SZIB_(G)), H_v(SZI_(G)) real :: S2_u(SZIB_(G), SZJ_(G)) real :: S2_v(SZI_(G), SZJB_(G)) @@ -455,12 +452,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) S2max = CS%Visbeck_S_max**2 -!$OMP parallel default(none) shared(is,ie,js,je,CS,nz,e,G,GV,h, & -!$OMP S2_u,S2_v,slope_x,slope_y, & -!$OMP SN_u_local,SN_v_local,N2_u,N2_v, S2max) & -!$OMP private(E_x,E_y,S2,H_u,H_v,Hdn,Hup,H_geom,N2, & -!$OMP wNE, wSE, wSW, wNW) -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 CS%SN_u(i,j) = 0.0 CS%SN_v(i,j) = 0.0 @@ -470,7 +462,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) ! calculate the first-mode gravity wave speed and then blend the equatorial ! and midlatitude deformation radii, using calc_resoln_function as a template. -!$OMP do + !$OMP parallel do default(shared) private(S2,H_u,Hdn,Hup,H_geom,N2,wNE,wSE,wSW,wNW) do j = js,je do I=is-1,ie CS%SN_u(I,j) = 0. ; H_u(I) = 0. ; S2_u(I,j) = 0. @@ -516,7 +508,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) enddo enddo -!$OMP do + !$OMP parallel do default(shared) private(S2,H_v,Hdn,Hup,H_geom,N2,wNE,wSE,wSW,wNW) do J = js-1,je do i=is,ie CS%SN_v(i,J) = 0. ; H_v(i) = 0. ; S2_v(i,J) = 0. @@ -562,8 +554,6 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) enddo enddo -!$OMP end parallel - ! Offer diagnostic fields for averaging. if (query_averaging_enabled(CS%diag)) then if (CS%id_S2_u > 0) call post_data(CS%id_S2_u, S2_u, CS%diag) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 873a61d7b8..e5e55ec590 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -555,13 +555,13 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%Kd_add > 0.0) then if (present(Kd_int)) then -!$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_int,CS,Kd) + !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie Kd_int(i,j,K) = Kd_int(i,j,K) + CS%Kd_add Kd_lay(i,j,k) = Kd_lay(i,j,k) + CS%Kd_add enddo ; enddo ; enddo else -!$OMP parallel do default(none) shared(is,ie,js,je,nz,CS,Kd) + !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie Kd_lay(i,j,k) = Kd_lay(i,j,k) + CS%Kd_add enddo ; enddo ; enddo diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index af2dce00d6..d4261b6523 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -375,20 +375,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (.not.use_BBL_EOS) Rml_vel(:,:) = 0.0 -!$OMP parallel do default(none) shared(u, v, h, tv, visc, G, GV, CS, Rml, is, ie, js, je, & -!$OMP nz, Isq, Ieq, Jsq, Jeq, nkmb, h_neglect, Rho0x400_G,& -!$OMP C2pi_3, U_bg_sq, cdrag_sqrt,K2,use_BBL_EOS,OBC, & -!$OMP maxitt,nkml,Vol_quit,D_u,D_v,mask_u,mask_v) & -!$OMP private(do_i,h_at_vel,htot_vel,hwtot,hutot,Thtot,Shtot, & -!$OMP hweight,v_at_u,u_at_v,ustar,T_EOS,S_EOS,press, & -!$OMP dR_dT, dR_dS,ustarsq,htot,T_vel,S_vel,Rml_vel, & -!$OMP oldfn,Dfn,Dh,Rhtot,C2f,ustH,root,bbl_thick, & -!$OMP D_vel,tmp,Dp,Dm,a_3,a,a_12,slope,Vol_open,Vol_2_reg,& -!$OMP C24_a,apb_4a,Iapb,a2x48_apb3,ax2_3apb,Vol_direct, & -!$OMP L_direct,Ibma_2,L,vol,vol_below,Vol_err,h_vel_pos, & -!$OMP BBL_visc_frac,h_vel,L0,Vol_0,dV_dL2,dVol,L_max, & -!$OMP L_min,Vol_err_min,Vol_err_max,BBL_frac,Cell_width, & -!$OMP gam,Rayleigh, Vol_tol, tmp_val_m1_to_p1) + !$OMP parallel do default(private) shared(u,v,h,tv,visc,G,GV,CS,Rml,is,ie,js,je,nz,nkmb, & + !$OMP nkml,Isq,Ieq,Jsq,Jeq,h_neglect,Rho0x400_G,C2pi_3, & + !$OMP U_bg_sq,cdrag_sqrt_Z,cdrag_sqrt,K2,use_BBL_EOS, & + !$OMP OBC,maxitt,Vol_quit,D_u,D_v,mask_u,mask_v) do j=Jsq,Jeq ; do m=1,2 if (m==1) then @@ -1211,16 +1201,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) endif enddo ; endif -!$OMP parallel do default(none) shared(u, v, h, tv, forces, visc, dt, G, GV, CS, use_EOS, & -!$OMP dt_Rho0, h_neglect, h_tiny, g_H_Rho0,js,je,OBC, & -!$OMP Isq, Ieq, nz, U_bg_sq,mask_v, & -!$OMP cdrag_sqrt,Rho0x400_G,nkml) & -!$OMP private(do_any,htot,do_i,k_massive,Thtot,uhtot,vhtot,U_star, & -!$OMP Idecay_len_TKE,press,k2,I_2hlay,T_EOS,S_EOS,dR_dT, & -!$OMP dR_dS,hlay,v_at_u,Uh2,T_lay,S_lay,gHprime, & -!$OMP RiBulk,Shtot,Rhtot,absf,do_any_shelf, & -!$OMP h_at_vel,ustar,htot_vel,hwtot,hutot,hweight,ustarsq, & -!$OMP oldfn,Dfn,Dh,Rlay,Rlb,h2f2,ustar1) + !$OMP parallel do default(private) shared(u,v,h,tv,forces,visc,dt,G,GV,CS,use_EOS,dt_Rho0, & + !$OMP h_neglect,h_tiny,g_H_Rho0,js,je,OBC,Isq,Ieq,nz, & + !$OMP U_bg_sq,mask_v,cdrag_sqrt,cdrag_sqrt_Z,Rho0x400_G,nkml) do j=js,je ! u-point loop if (CS%dynamic_viscous_ML) then do_any = .false. @@ -1453,17 +1436,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) enddo ! j-loop at u-points -!$OMP parallel do default(none) shared(u, v, h, tv, forces, visc, dt, G, GV, CS, use_EOS,& -!$OMP dt_Rho0, h_neglect, h_tiny, g_H_Rho0,is,ie,OBC, & -!$OMP Jsq,Jeq,nz,U_bg_sq,cdrag_sqrt,Rho0x400_G,nkml, & -!$OMP mask_u) & -!$OMP private(do_any,htot,do_i,k_massive,Thtot,vhtot,uhtot,absf,& -!$OMP U_star,Idecay_len_TKE,press,k2,I_2hlay,T_EOS, & -!$OMP S_EOS,dR_dT, dR_dS,hlay,u_at_v,Uh2, & -!$OMP T_lay,S_lay,gHprime,RiBulk,do_any_shelf, & -!$OMP Shtot,Rhtot,ustar,h_at_vel,htot_vel,hwtot, & -!$OMP hutot,hweight,ustarsq,oldfn,Dh,Rlay,Rlb,Dfn, & -!$OMP h2f2,ustar1) + !$OMP parallel do default(private) shared(u,v,h,tv,forces,visc,dt,G,GV,CS,use_EOS,dt_Rho0, & + !$OMP h_neglect,h_tiny,g_H_Rho0,is,ie,OBC,Jsq,Jeq,nz, & + !$OMP U_bg_sq,cdrag_sqrt,cdrag_sqrt_Z,Rho0x400_G,nkml,mask_u) do J=Jsq,Jeq ! v-point loop if (CS%dynamic_viscous_ML) then do_any = .false. diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 9014243e56..57bf5a3ab6 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -671,7 +671,9 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) allocate(CS%a1_shelf_v(G%isd:G%ied,G%JsdB:G%JedB)) ; CS%a1_shelf_v(:,:)=0.0 endif - !$OMP parallel do default(shared) firstprivate(i_hbbl) + !$OMP parallel do default(private) shared(G,GV,CS,visc,Isq,Ieq,nz,u,h,forces,hML_u, & + !$OMP OBC,h_neglect,dt,I_valBL,Kv_u) & + !$OMP firstprivate(i_hbbl) do j=G%Jsc,G%Jec do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo From 0b48ab43e08a74b36529fb45d08ed031a74cc358 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 25 Oct 2018 17:15:14 -0600 Subject: [PATCH 0855/1072] fix mech_forcing_diags args --- config_src/mct_driver/MOM_ocean_model.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 3eac851778..4714194f40 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -559,8 +559,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%nstep = OS%nstep + 1 call enable_averaging(time_step, OS%Time, OS%diag) - call mech_forcing_diags(OS%forces, OS%fluxes, time_step, OS%grid, & - OS%diag, OS%forcing_CSp%handles) + call mech_forcing_diags(OS%forces, time_step, OS%grid, OS%diag, OS%forcing_CSp%handles) call disable_averaging(OS%diag) if (OS%fluxes%fluxes_used) then From 09489b4844b9cfb69ca29a1c0e6b599a07be350f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 26 Oct 2018 09:11:16 -0400 Subject: [PATCH 0856/1072] (*)Fixed bugs in EBT mode wave speed calculation Corrected several bugs in the equivalent barotropic wave speed calculation, all related to the filtering of reduced gravities to prevent stratification from increasing with depth. (As an aside, I do not recall why we were doing this.) These changes correct dimensional rescaling factors and correct an obviously incorrect limited g_prime calculation. This could change answers, but it just happens not to in the existing MOM6_examples test cases, including OM4_05, which has the right parameter settings to trigger this bug, but in our short test runs it curiously does not encounter the downward increasing stratification below 2000 m. No updates are needed for MOM6-examples files. --- src/diagnostics/MOM_wave_speed.F90 | 119 +++++------------------------ 1 file changed, 21 insertions(+), 98 deletions(-) diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index e8d58e502b..c3c7e78cac 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -78,9 +78,9 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & real det, ddet, detKm1, detKm2, ddetKm1, ddetKm2 real :: lam, dlam, lam0 real :: min_h_frac - real :: H_to_pres ! A conversion factor from thickesses (in Z) to pressure (in Pa) + real :: Z_to_Pa ! A conversion factor from thickesses (in Z) to pressure (in Pa) real, dimension(SZI_(G)) :: & - htot, hmin, & ! Thicknesses in m. + htot, hmin, & ! Thicknesses in Z. H_here, HxT_here, HxS_here, HxR_here real :: speed2_tot real :: I_Hnew, drxh_sum @@ -127,16 +127,16 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & S => tv%S ; T => tv%T g_Rho0 = GV%g_Earth / GV%Rho0 + Z_to_Pa = GV%g_Earth * GV%Rho0 use_EOS = associated(tv%eqn_of_state) - H_to_pres = GV%g_Earth * GV%Rho0 rescale = 1024.0**4 ; I_rescale = 1.0/rescale min_h_frac = tol1 / real(nz) !$OMP parallel do default(none) shared(is,ie,js,je,nz,h,G,GV,min_h_frac,use_EOS,T,S,tv,& !$OMP calc_modal_structure,l_use_ebt_mode,modal_structure, & -!$OMP l_mono_N2_column_fraction,l_mono_N2_depth,CS, & -!$OMP H_to_pres,cg1,g_Rho0,rescale,I_rescale,L2_to_Z2) & +!$OMP l_mono_N2_column_fraction,l_mono_N2_depth,CS, & +!$OMP Z_to_Pa,cg1,g_Rho0,rescale,I_rescale,L2_to_Z2) & !$OMP private(htot,hmin,kf,H_here,HxT_here,HxS_here,HxR_here, & !$OMP Hf,Tf,Sf,Rf,pres,T_int,S_int,drho_dT, & !$OMP drho_dS,drxh_sum,kc,Hc,Tc,Sc,I_Hnew,gprime, & @@ -203,7 +203,7 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & if (use_EOS) then pres(1) = 0.0 do k=2,kf(i) - pres(k) = pres(k-1) + H_to_pres*Hf(k-1,i) + pres(k) = pres(k-1) + Z_to_Pa*Hf(k-1,i) T_int(k) = 0.5*(Tf(k,i)+Tf(k-1,i)) S_int(k) = 0.5*(Sf(k,i)+Sf(k-1,i)) enddo @@ -313,21 +313,18 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & speed2_tot = 0.0 if (l_use_ebt_mode) then Igu(1) = 0. ! Neumann condition for pressure modes - sum_hc = Hc(1)*GV%H_to_m !### I believe this conversion factor to be wrong. -RWH + sum_hc = Hc(1) N2min = L2_to_Z2*gprime(2)/Hc(1) do k=2,kc hw = 0.5*(Hc(k-1)+Hc(k)) gp = gprime(K) if (l_mono_N2_column_fraction>0. .or. l_mono_N2_depth>=0.) then - if (G%bathyT(i,j)-sum_hc < l_mono_N2_column_fraction*G%bathyT(i,j) .and. & - L2_to_Z2*gp > N2min*hw) then - ! Filters out regions where N2 increases with depth but only in a lower fraction of water column - gp = N2min/hw !### THIS IS DIMENSIONALLY INCONSISTENT! -RWH - !### This should be gp = GV%Z_to_m**2* (N2min*hw) - elseif (l_mono_N2_depth>=0. .and. sum_hc>l_mono_N2_depth .and. L2_to_Z2*gp>N2min*hw) then - ! Filters out regions where N2 increases with depth but only below a certain depth - gp = N2min/hw !### THIS IS DIMENSIONALLY INCONSISTENT! -RWH - !### This should be gp = GV%Z_to_m**2* (N2min*hw) + if ( ((G%bathyT(i,j)-sum_hc < l_mono_N2_column_fraction*G%bathyT(i,j)) .or. & + ((l_mono_N2_depth >= 0.) .and. (sum_hc > l_mono_N2_depth))) .and. & + (L2_to_Z2*gp > N2min*hw) ) then + ! Filters out regions where N2 increases with depth but only in a lower fraction + ! of the water column or below a certain depth. + gp = GV%Z_to_m**2 * (N2min*hw) else N2min = L2_to_Z2 * gp/hw endif @@ -335,7 +332,7 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & Igu(k) = 1.0/(gp*Hc(k)) Igl(k-1) = 1.0/(gp*Hc(k-1)) speed2_tot = speed2_tot + gprime(k)*(Hc(k-1)+Hc(k))*0.707 - sum_hc = sum_hc + Hc(k)*GV%H_to_m !### I believe this conversion factor to be wrong. -RWH + sum_hc = sum_hc + Hc(k) enddo !Igl(kc) = 0. ! Neumann condition for pressure modes Igl(kc) = 2.*Igu(kc) ! Dirichlet condition for pressure modes @@ -559,10 +556,9 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) integer :: numint ! number of widows (intervals) in root searching range integer :: nrootsfound ! number of extra roots found (not including 1st root) real :: min_h_frac - real :: H_to_pres ! A conversion factor from thickesses (in Z) to pressure (in Pa) - real :: H_to_m ! Local copy of a unit conversion factor. + real :: Z_to_Pa ! A conversion factor from thickesses (in Z) to pressure (in Pa) real, dimension(SZI_(G)) :: & - htot, hmin, & ! Thicknesses in m. + htot, hmin, & ! Thicknesses in Z. H_here, HxT_here, HxS_here, HxR_here real :: speed2_tot ! overestimate of the mode-1 speed squared, m2 s-2 real :: speed2_min ! minimum mode speed (squared) to consider in root searching @@ -574,8 +570,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) real :: g_Rho0 ! G_Earth/Rho0 in m4 s-2 kg-1. integer :: kf(SZI_(G)) integer, parameter :: max_itt = 10 - logical :: use_EOS ! If true, density is calculated from T & S using an - ! equation of state. + logical :: use_EOS ! If true, density is calculated from T & S using the equation of state. real, dimension(SZK_(G)+1) :: z_int, N2 integer :: nsub ! number of subintervals used for root finding integer, parameter :: sub_it_max = 4 @@ -585,7 +580,6 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) integer :: kc, nrows integer :: sub, sub_it integer :: i, j, k, k2, itt, is, ie, js, je, nz, row, iint, m, ig, jg - integer :: ig_need_sub, jg_need_sub ! for debugging (BDM) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -601,23 +595,11 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) S => tv%S ; T => tv%T g_Rho0 = GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) - - H_to_pres = GV%g_Earth * GV%Rho0 - H_to_m = GV%H_to_m + Z_to_Pa = GV%g_Earth * GV%Rho0 min_h_frac = tol1 / real(nz) -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h,G,GV,min_h_frac,use_EOS,T,S, & -!$OMP H_to_pres,H_to_m,tv,cn,g_Rho0,nmodes) & -!$OMP private(htot,hmin,kf,H_here,HxT_here,HxS_here,HxR_here, & -!$OMP Hf,Tf,Sf,Rf,pres,T_int,S_int,drho_dT, & -!$OMP drho_dS,drxh_sum,kc,Hc,Tc,Sc,I_Hnew,gprime, & -!$OMP Rc,speed2_tot,Igl,Igu,dlam, & -!$OMP det,ddet,ig,jg,z_int,N2,row,nrows,lam_1, & -!$OMP lamMin,speed2_min,lamMax,lamInc,numint,det_l, & -!$OMP ddet_l,xr,xl,det_r,xbl,xbr,ddet_r,xl_sub, & -!$OMP ig_need_sub,jg_need_sub,sub_rootfound,nsub, & -!$OMP det_sub,ddet_sub,lam_n, & -!$OMP a_diag,b_diag,c_diag,nrootsfound) + !$OMP parallel do default(private) shared(is,ie,js,je,nz,h,G,GV,min_h_frac,use_EOS,T,S, & + !$OMP Z_to_Pa,tv,cn,g_Rho0,nmodes) do j=js,je ! First merge very thin layers with the one above (or below if they are ! at the top). This also transposes the row order so that columns can @@ -678,7 +660,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) if (use_EOS) then pres(1) = 0.0 do k=2,kf(i) - pres(k) = pres(k-1) + H_to_pres*Hf(k-1,i) + pres(k) = pres(k-1) + Z_to_Pa*Hf(k-1,i) T_int(k) = 0.5*(Tf(k,i)+Tf(k-1,i)) S_int(k) = 0.5*(Sf(k,i)+Sf(k-1,i)) enddo @@ -849,22 +831,6 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) endif enddo - ! print resutls (for debugging only) - !if (ig == 83 .and. jg == 2) then - ! if (nmodes>1)then - ! print *, "Results after finding first mode:" - ! print *, "first guess at lam_1=", 1./speed2_tot - ! print *, "final guess at lam_1=", lam_1 - ! print *, "det value after iterations, det=", det - ! print *, "ddet value after iterations, det=", ddet - ! print *, "final guess at c1=", cn(i,j,1) - ! print *, "a_diag=",a_diag(1:nrows) - ! print *, "b_diag=",b_diag(1:nrows) - ! print *, "c_diag=",c_diag(1:nrows) - ! !stop - ! endif - !endif - ! Find other eigen values if c1 is of significant magnitude, > cn_thresh nrootsfound = 0 ! number of extra roots found (not including 1st root) if (nmodes>1 .and. kc>=nmodes+1 .and. cn(i,j,1)>c1_thresh) then @@ -879,15 +845,6 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) ! set number of intervals within search range numint = nint((lamMax - lamMin)/lamInc) - !if (ig == 144 .and. jg == 5) then - ! print *, 'Looking for other eigenvalues at', ig, jg - ! print *, 'Wave_speed: lamMin=', lamMin - ! print *, 'Wave_speed: cnMax=', 1/sqrt(lamMin) - ! print *, 'Wave_speed: lamMax=', lamMax - ! print *, 'Wave_speed: cnMin=', 1/sqrt(lamMax) - ! print *, 'Wave_speed: lamInc=', lamInc - !endif - ! Find intervals containing zero-crossings (roots) of the determinant ! that are beyond the first root @@ -900,22 +857,11 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) xl = xr - lamInc call tridiag_det(a_diag(1:nrows),b_diag(1:nrows),c_diag(1:nrows), & nrows,xr,det_r,ddet_r) - !if (ig == 83 .and. jg == 2) then - ! print *, "Move interval" - ! print *, "iint=",iint - ! print *, "@ xr=",xr - ! print *, "det_r=",det_r - ! print *, "ddet_r=",ddet_r - !endif if (det_l*det_r < 0.0) then ! if function changes sign if (det_l*ddet_l < 0.0) then ! if function at left is headed to zero nrootsfound = nrootsfound + 1 xbl(nrootsfound) = xl xbr(nrootsfound) = xr - !if (ig == 144 .and. jg == 5) then - ! print *, "Root located without subdivision!" - ! print *, "between xbl=",xl,"and xbr=",xr - !endif else ! function changes sign but has a local max/min in interval, ! try subdividing interval as many times as necessary (or sub_it_max). @@ -923,9 +869,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) !call MOM_error(WARNING, "determinant changes sign"// & ! "but has a local max/min in interval;"//& ! " reduce increment in lam.") - ig_need_sub = i + G%idg_offset ; jg_need_sub = j + G%jdg_offset ! begin subdivision loop ------------------------------------------- - !print *, "subdividing interval at ig=",ig_need_sub,"jg=",jg_need_sub sub_rootfound = .false. ! initialize do sub_it=1,sub_it_max nsub = 2**sub_it ! number of subintervals; nsub=2,4,8,... @@ -940,10 +884,6 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) nrootsfound = nrootsfound + 1 xbl(nrootsfound) = xl_sub xbr(nrootsfound) = xr - !if (ig == 144 .and. jg == 5) then - ! print *, "Root located after subdiving",sub_it," times!" - ! print *, "between xbl=",xl_sub,"and xbr=",xr - !endif exit ! exit sub loop endif ! headed toward zero endif ! sign change @@ -1001,23 +941,6 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) else cn(i,j,:) = 0.0 ! This is a land point. endif ! if not land - ! ----- Spot check - comment out later (BDM) ---------- - !ig = G%idg_offset + i - !jg = G%jdg_offset + j - !if (ig == 83 .and. jg == 2) then - !! print *, "nmodes=",nmodes - ! print *, "lam_1=",lam_1 - ! print *, "lamMin=",lamMin - ! print *, "lamMax=",lamMax - ! print *, "lamInc=",lamInc - ! print *, "nrootsfound=",nrootsfound - ! do m=1,nmodes - ! print *, "c",m,"= ", cn(i,j,m) - ! print *, "xbl",m,"= ", xbl(m) - ! print *, "xbr",m,"= ", xbr(m) - ! enddo - !endif - !------------------------------------------------------- enddo ! i-loop enddo ! j-loop From a3b8f510e41e0794a89a7e34facef0f4db6901a4 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 26 Oct 2018 13:23:41 +0000 Subject: [PATCH 0857/1072] Fix intent for geothermal_init() - @jiandewang reported that the argument G should be intent(inout). --- src/parameterizations/vertical/MOM_geothermal.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 3880f9fd54..c09d85f5b5 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -315,7 +315,7 @@ end subroutine geothermal !> Initialize parameters and allocate memory associated with the geothermal heating module. subroutine geothermal_init(Time, G, param_file, diag, CS) type(time_type), target, intent(in) :: Time !< Current model time. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< Structure used to regulate diagnostic output. From 368848fd24985e83841ac88b1aef2a7c91036aa1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 26 Oct 2018 10:42:55 -0400 Subject: [PATCH 0858/1072] Rescale values reported by PointAccel Rescaled the values of multiple variables written out by write_u_accel and write_v_accal, converting them back to m or m3 s-1 before being written. All answers are bitwise identical. --- src/diagnostics/MOM_PointAccel.F90 | 98 +++++++++++++++--------------- 1 file changed, 49 insertions(+), 49 deletions(-) diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index fa31586659..a5b5bbc6b0 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -73,7 +73,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: um !< The new zonal velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: hin !< The layer thickness, in m. + intent(in) :: hin !< The layer thickness, in H. type(accel_diag_ptrs), intent(in) :: ADp !< A structure pointing to the various !! accelerations in the momentum equations. type(cont_diag_ptrs), intent(in) :: CDp !< A structure with pointers to various terms @@ -88,7 +88,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, Z s-1. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, - !! from vertvisc, in m. + !! from vertvisc, in H. ! Local variables real :: f_eff, CFL real :: Angstrom @@ -231,27 +231,27 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a endif write(file,'(/,"h--: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (hin(i,j-1,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (GV%H_to_m*hin(i,j-1,k)); enddo write(file,'(/,"h+-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (hin(i+1,j-1,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (GV%H_to_m*hin(i+1,j-1,k)); enddo write(file,'(/,"h-0: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (hin(i,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (GV%H_to_m*hin(i,j,k)); enddo write(file,'(/,"h+0: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (hin(i+1,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (GV%H_to_m*hin(i+1,j,k)); enddo write(file,'(/,"h-+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (hin(i,j+1,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (GV%H_to_m*hin(i,j+1,k)); enddo write(file,'(/,"h++: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (hin(i+1,j+1,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (GV%H_to_m*hin(i+1,j+1,k)); enddo - e(nz+1) = -G%Zd_to_m*G%bathyT(i,j) - do k=nz,1,-1 ; e(K) = e(K+1) + hin(i,j,k) ; enddo + e(nz+1) = -GV%Z_to_m*G%bathyT(i,j) + do k=nz,1,-1 ; e(K) = e(K+1) + GV%H_to_m*hin(i,j,k) ; enddo write(file,'(/,"e-: ",$)') write(file,'(ES10.3," ",$)') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo - e(nz+1) = -G%Zd_to_m*G%bathyT(i+1,j) - do k=nz,1,-1 ; e(K) = e(K+1) + hin(i+1,j,k) ; enddo + e(nz+1) = -GV%Z_to_m*G%bathyT(i+1,j) + do k=nz,1,-1 ; e(K) = e(K+1) + GV%H_to_m*hin(i+1,j,k) ; enddo write(file,'(/,"e+: ",$)') write(file,'(ES10.3," ",$)') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K) ; enddo @@ -281,53 +281,53 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a write(file,'(/,"vh--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CDp%vh(i,J-1,k)*G%IdxCv(i,J-1)); enddo + (GV%H_to_m*CDp%vh(i,J-1,k)*G%IdxCv(i,J-1)); enddo write(file,'(/," vhC--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i,j-1,k)*(hin(i,j-1,k) + hin(i,j,k))); enddo + (0.5*CS%v_av(i,j-1,k)*GV%H_to_m*(hin(i,j-1,k) + hin(i,j,k))); enddo if (prev_avail) then write(file,'(/," vhCp--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_prev(i,j-1,k)*(hin(i,j-1,k) + hin(i,j,k))); enddo + (0.5*CS%v_prev(i,j-1,k)*GV%H_to_m*(hin(i,j-1,k) + hin(i,j,k))); enddo endif write(file,'(/,"vh-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CDp%vh(i,J,k)*G%IdxCv(i,J)); enddo + (GV%H_to_m*CDp%vh(i,J,k)*G%IdxCv(i,J)); enddo write(file,'(/," vhC-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i,J,k)*(hin(i,j,k) + hin(i,j+1,k))); enddo + (0.5*CS%v_av(i,J,k)*GV%H_to_m*(hin(i,j,k) + hin(i,j+1,k))); enddo if (prev_avail) then write(file,'(/," vhCp-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_prev(i,J,k)*(hin(i,j,k) + hin(i,j+1,k))); enddo + (0.5*CS%v_prev(i,J,k)*GV%H_to_m*(hin(i,j,k) + hin(i,j+1,k))); enddo endif write(file,'(/,"vh+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CDp%vh(i+1,J-1,k)*G%IdxCv(i+1,J-1)); enddo + (GV%H_to_m*CDp%vh(i+1,J-1,k)*G%IdxCv(i+1,J-1)); enddo write(file,'(/," vhC+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i+1,J-1,k)*(hin(i+1,j-1,k) + hin(i+1,j,k))); enddo + (0.5*CS%v_av(i+1,J-1,k)*GV%H_to_m*(hin(i+1,j-1,k) + hin(i+1,j,k))); enddo if (prev_avail) then write(file,'(/," vhCp+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_prev(i+1,J-1,k)*(hin(i+1,j-1,k) + hin(i+1,j,k))); enddo + (0.5*CS%v_prev(i+1,J-1,k)*GV%H_to_m*(hin(i+1,j-1,k) + hin(i+1,j,k))); enddo endif write(file,'(/,"vh++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CDp%vh(i+1,J,k)*G%IdxCv(i+1,J)); enddo + (GV%H_to_m*CDp%vh(i+1,J,k)*G%IdxCv(i+1,J)); enddo write(file,'(/," vhC++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i+1,J,k)*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo + (0.5*CS%v_av(i+1,J,k)*GV%H_to_m*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo if (prev_avail) then write(file,'(/," vhCp++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i+1,J,k)*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo + (0.5*CS%v_av(i+1,J,k)*GV%H_to_m*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo endif - write(file,'(/,"D: ",2(ES10.3))') G%Zd_to_m*G%bathyT(i,j),G%Zd_to_m*G%bathyT(i+1,j) + write(file,'(/,"D: ",2(ES10.3))') GV%Z_to_m*G%bathyT(i,j),GV%Z_to_m*G%bathyT(i+1,j) ! From here on, the normalized accelerations are written. if (prev_avail) then @@ -401,7 +401,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: vm !< The new meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: hin !< The layer thickness, in m. + intent(in) :: hin !< The layer thickness, in H. type(accel_diag_ptrs), intent(in) :: ADp !< A structure pointing to the various !! accelerations in the momentum equations. type(cont_diag_ptrs), intent(in) :: CDp !< A structure with pointers to various terms in @@ -416,7 +416,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, Z s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, - !! from vertvisc, in m. + !! from vertvisc, in H. ! Local variables real :: f_eff, CFL real :: Angstrom @@ -563,26 +563,26 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a endif write(file,'("h--: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') hin(i-1,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') GV%H_to_m*hin(i-1,j,k); enddo write(file,'(/,"h0-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') hin(i,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') GV%H_to_m*hin(i,j,k); enddo write(file,'(/,"h+-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') hin(i+1,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') GV%H_to_m*hin(i+1,j,k); enddo write(file,'(/,"h-+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') hin(i-1,j+1,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') GV%H_to_m*hin(i-1,j+1,k); enddo write(file,'(/,"h0+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') hin(i,j+1,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') GV%H_to_m*hin(i,j+1,k); enddo write(file,'(/,"h++: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') hin(i+1,j+1,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') GV%H_to_m*hin(i+1,j+1,k); enddo - e(nz+1) = -G%Zd_to_m*G%bathyT(i,j) - do k=nz,1,-1 ; e(K) = e(K+1) + hin(i,j,k); enddo + e(nz+1) = -GV%Z_to_m*G%bathyT(i,j) + do k=nz,1,-1 ; e(K) = e(K+1) + GV%H_to_m*hin(i,j,k); enddo write(file,'(/,"e-: ",$)') write(file,'(ES10.3," ",$)') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo - e(nz+1) = -G%Zd_to_m*G%bathyT(i,j+1) - do k=nz,1,-1 ; e(K) = e(K+1) + hin(i,j+1,k) ; enddo + e(nz+1) = -GV%Z_to_m*G%bathyT(i,j+1) + do k=nz,1,-1 ; e(K) = e(K+1) + GV%H_to_m*hin(i,j+1,k) ; enddo write(file,'(/,"e+: ",$)') write(file,'(ES10.3," ",$)') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo @@ -612,14 +612,14 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a write(file,'(/,"uh--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CDp%uh(I-1,j,k)*G%IdyCu(I-1,j)); enddo + (GV%H_to_m*CDp%uh(I-1,j,k)*G%IdyCu(I-1,j)); enddo write(file,'(/," uhC--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_av(I-1,j,k) * 0.5*(hin(i-1,j,k) + hin(i,j,k))); enddo + (CS%u_av(I-1,j,k) * GV%H_to_m*0.5*(hin(i-1,j,k) + hin(i,j,k))); enddo if (prev_avail) then write(file,'(/," uhCp--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%u_prev(I-1,j,k)*(hin(i-1,j,k) + hin(i,j,k))); enddo + (CS%u_prev(I-1,j,k) * GV%H_to_m*0.5*(hin(i-1,j,k) + hin(i,j,k))); enddo endif write(file,'(/,"uh-+: ",$)') @@ -627,38 +627,38 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a (CDp%uh(I-1,j+1,k)*G%IdyCu(I-1,j+1)); enddo write(file,'(/," uhC-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_av(I-1,j+1,k) * 0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))); enddo + (CS%u_av(I-1,j+1,k) * GV%H_to_m*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))); enddo if (prev_avail) then write(file,'(/," uhCp-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%u_prev(I-1,j+1,k)*(hin(i-1,j+1,k) + hin(i,j+1,k))); enddo + (CS%u_prev(I-1,j+1,k) * GV%H_to_m*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))); enddo endif write(file,'(/,"uh+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CDp%uh(I,j,k)*G%IdyCu(I,j)); enddo + (GV%H_to_m*CDp%uh(I,j,k)*G%IdyCu(I,j)); enddo write(file,'(/," uhC+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_av(I,j,k) * 0.5*(hin(i,j,k) + hin(i+1,j,k))); enddo + (CS%u_av(I,j,k) * GV%H_to_m*0.5*(hin(i,j,k) + hin(i+1,j,k))); enddo if (prev_avail) then write(file,'(/," uhCp+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%u_prev(I,j,k)*(hin(i,j,k) + hin(i+1,j,k))); enddo + (CS%u_prev(I,j,k) * GV%H_to_m*0.5*(hin(i,j,k) + hin(i+1,j,k))); enddo endif write(file,'(/,"uh++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CDp%uh(I,j+1,k)*G%IdyCu(I,j+1)); enddo + (GV%H_to_m*CDp%uh(I,j+1,k)*G%IdyCu(I,j+1)); enddo write(file,'(/," uhC++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_av(I,j+1,k) * 0.5*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo + (CS%u_av(I,j+1,k) * 0.5*GV%H_to_m*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo if (prev_avail) then write(file,'(/," uhCp++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%u_prev(I,j+1,k)*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo + (CS%u_prev(I,j+1,k) * GV%H_to_m*0.5*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo endif - write(file,'(/,"D: ",2(ES10.3))') G%Zd_to_m*G%bathyT(i,j),G%Zd_to_m*G%bathyT(i,j+1) + write(file,'(/,"D: ",2(ES10.3))') GV%Z_to_m*G%bathyT(i,j),GV%Z_to_m*G%bathyT(i,j+1) ! From here on, the normalized accelerations are written. if (prev_avail) then From d3244d685b216122a1f3123419a4c7230d865c60 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 26 Oct 2018 10:43:36 -0400 Subject: [PATCH 0859/1072] +Add conversion argument to register_static_field Added a new optional conversion argument to register_static_field, to trigger the conversion of the input with a registered diagnostic by a multiplicative scaling factor. All answers are bitwise identical. --- src/framework/MOM_diag_mediator.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index d529315459..8fd9874a3a 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -1917,7 +1917,7 @@ function register_static_field(module_name, field_name, axes, & long_name, units, missing_value, range, mask_variant, standard_name, & do_not_log, interp_method, tile_count, & cmor_field_name, cmor_long_name, cmor_units, cmor_standard_name, area, & - x_cell_method, y_cell_method, area_cell_method) + x_cell_method, y_cell_method, area_cell_method, conversion) integer :: register_static_field !< An integer handle for a diagnostic array. character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" !! or "ice_shelf_model" @@ -1943,6 +1943,7 @@ function register_static_field(module_name, field_name, axes, & character(len=*), optional, intent(in) :: x_cell_method !< Specifies the cell method for the x-direction. character(len=*), optional, intent(in) :: y_cell_method !< Specifies the cell method for the y-direction. character(len=*), optional, intent(in) :: area_cell_method !< Specifies the cell method for area + real, optional, intent(in) :: conversion !< A value to multiply data by before writing to file ! Local variables real :: MOM_missing_value @@ -1971,6 +1972,7 @@ function register_static_field(module_name, field_name, axes, & call assert(associated(diag), 'register_static_field: diag allocation failed') diag%fms_diag_id = fms_id diag%debug_str = trim(module_name)//"-"//trim(field_name) + if (present(conversion)) diag%conversion_factor = conversion if (present(x_cell_method)) then call get_diag_axis_name(axes%handles(1), axis_name) call diag_field_add_attribute(fms_id, 'cell_methods', trim(axis_name)//':'//trim(x_cell_method)) @@ -2013,6 +2015,7 @@ function register_static_field(module_name, field_name, axes, & call alloc_diag_with_id(dm_id, diag_cs, cmor_diag) cmor_diag%fms_diag_id = fms_id cmor_diag%debug_str = trim(module_name)//"-"//trim(cmor_field_name) + if (present(conversion)) cmor_diag%conversion_factor = conversion if (present(x_cell_method)) then call get_diag_axis_name(axes%handles(1), axis_name) call diag_field_add_attribute(fms_id, 'cell_methods', trim(axis_name)//':'//trim(x_cell_method)) From fce22cb6a6a7b8df5f5613bcb91a702b9bbae15d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 26 Oct 2018 10:44:07 -0400 Subject: [PATCH 0860/1072] +Rescale depth inside of MEKE_lengthScales_0d Moved dimensional rescaling of depth inside of MEKE_lengthScales_0d to facilitate enhanced dimensional consistency testing. This required the addition of new arguments to the internal routintes MEKE_lengthScales and MEKE_lengthScales_0d. All answers are bitwise identical. --- src/parameterizations/lateral/MOM_MEKE.F90 | 23 ++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 949268c7e9..9607dafeb3 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -258,7 +258,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) endif ! Calculates bottomFac2, barotrFac2 and LmixScale - call MEKE_lengthScales(CS, MEKE, G, SN_u, SN_v, MEKE%MEKE, bottomFac2, barotrFac2, LmixScale) + call MEKE_lengthScales(CS, MEKE, G, GV, SN_u, SN_v, MEKE%MEKE, bottomFac2, barotrFac2, LmixScale) if (CS%debug) then call uvchksum("MEKE drag_vel_[uv]", drag_vel_u, drag_vel_v, G%HI) call hchksum(mass, 'MEKE mass',G%HI,haloshift=1) @@ -612,8 +612,8 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, SN_u, SN_v, drag_rate_visc, I_mass) do while (resid>0.) n1 = n1 + 1 EKE = EKEmax - call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%Zd_to_m*G%bathyT(i,j), & - MEKE%Rd_dx_h(i,j), SN, EKE, & + call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & + MEKE%Rd_dx_h(i,j), SN, EKE, GV%Z_to_m, & bottomFac2, barotrFac2, LmixScale, & Lrhines, Leady) ! TODO: Should include resolution function in Kh @@ -688,11 +688,12 @@ end subroutine MEKE_equilibrium !> Calculates the eddy mixing length scale and \f$\gamma_b\f$ and \f$\gamma_t\f$ !! functions that are ratios of either bottom or barotropic eddy energy to the !! column eddy energy, respectively. See \ref section_MEKE_equations. -subroutine MEKE_lengthScales(CS, MEKE, G, SN_u, SN_v, & +subroutine MEKE_lengthScales(CS, MEKE, G, GV, SN_u, SN_v, & EKE, bottomFac2, barotrFac2, LmixScale) type(MEKE_CS), pointer :: CS !< MEKE control structure. type(MEKE_type), pointer :: MEKE !< MEKE data. type(ocean_grid_type), intent(inout) :: G !< Ocean grid. + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points (s-1). real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at u-points (s-1). real, dimension(SZI_(G),SZJ_(G)), intent(in) :: EKE !< Eddy kinetic energy (m2/s2). @@ -717,8 +718,8 @@ subroutine MEKE_lengthScales(CS, MEKE, G, SN_u, SN_v, & beta = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) endif ! Returns bottomFac2, barotrFac2 and LmixScale - call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%Zd_to_m*G%bathyT(i,j), & - MEKE%Rd_dx_h(i,j), SN, MEKE%MEKE(i,j), & + call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & + MEKE%Rd_dx_h(i,j), SN, MEKE%MEKE(i,j), GV%Z_to_m, & bottomFac2(i,j), barotrFac2(i,j), LmixScale(i,j), & Lrhines(i,j), Leady(i,j)) enddo ; enddo @@ -730,15 +731,17 @@ end subroutine MEKE_lengthScales !> Calculates the eddy mixing length scale and \f$\gamma_b\f$ and \f$\gamma_t\f$ !! functions that are ratios of either bottom or barotropic eddy energy to the !! column eddy energy, respectively. See \ref section_MEKE_equations. -subroutine MEKE_lengthScales_0d(CS, area, beta, depth, Rd_dx, SN, & - EKE, bottomFac2, barotrFac2, LmixScale, Lrhines, Leady) +subroutine MEKE_lengthScales_0d(CS, area, beta, depth, Rd_dx, SN, EKE, Z_to_L, & + bottomFac2, barotrFac2, LmixScale, Lrhines, Leady) type(MEKE_CS), pointer :: CS !< MEKE control structure. real, intent(in) :: area !< Grid cell area (m2) real, intent(in) :: beta !< Planetary beta = |grad F| (s-1 m-1) - real, intent(in) :: depth !< Ocean depth (m) + real, intent(in) :: depth !< Ocean depth (Z) real, intent(in) :: Rd_dx !< Resolution Ld/dx (nondim). real, intent(in) :: SN !< Eady growth rate (s-1). real, intent(in) :: EKE !< Eddy kinetic energy (m s-1). + real, intent(in) :: Z_to_L !< A conversion factor from depth units (Z) to + !! the units for lateral distances (L). real, intent(out) :: bottomFac2 !< gamma_b^2 real, intent(out) :: barotrFac2 !< gamma_t^2 real, intent(out) :: LmixScale !< Eddy mixing length (m). @@ -750,7 +753,7 @@ subroutine MEKE_lengthScales_0d(CS, area, beta, depth, Rd_dx, SN, & ! Length scale for MEKE derived diffusivity Lgrid = sqrt(area) ! Grid scale Ldeform = Lgrid * Rd_dx ! Deformation scale - Lfrict = depth / CS%cdrag ! Frictional arrest scale + Lfrict = (Z_to_L * depth) / CS%cdrag ! Frictional arrest scale ! gamma_b^2 is the ratio of bottom eddy energy to mean column eddy energy ! used in calculating bottom drag bottomFac2 = CS%MEKE_CD_SCALE**2 From 970f440c23538cff7ceec95991844e7eb22161af Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 26 Oct 2018 10:44:29 -0400 Subject: [PATCH 0861/1072] Simplify MOM_diagnostics code Use conversion argument to register_static_field to simplify the MOM_diagnostics code. Also use rescaling values from GV instead of G to prepare for future simplifications. All answers are bitwise identical. --- src/diagnostics/MOM_diagnostics.F90 | 53 +++++++++-------------------- 1 file changed, 16 insertions(+), 37 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 30101c91a0..9152636c94 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -291,12 +291,12 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (associated(CS%e_D)) then if (associated(CS%e)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie - CS%e_D(i,j,k) = CS%e(i,j,k) + G%Zd_to_m*G%bathyT(i,j) + CS%e_D(i,j,k) = CS%e(i,j,k) + GV%Z_to_m*G%bathyT(i,j) enddo ; enddo ; enddo else call find_eta(h, tv, G, GV, CS%e_D, eta_bt, eta_to_m=1.0) do k=1,nz+1 ; do j=js,je ; do i=is,ie - CS%e_D(i,j,k) = CS%e_D(i,j,k) + G%Zd_to_m*G%bathyT(i,j) + CS%e_D(i,j,k) = CS%e_D(i,j,k) + GV%Z_to_m*G%bathyT(i,j) enddo ; enddo ; enddo endif @@ -817,7 +817,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) if (CS%id_col_ht > 0) then call find_eta(h, tv, G, GV, z_top, eta_to_m=1.0) do j=js,je ; do i=is,ie - z_bot(i,j) = z_top(i,j) + G%Zd_to_m*G%bathyT(i,j) + z_bot(i,j) = z_top(i,j) + GV%Z_to_m*G%bathyT(i,j) enddo ; enddo call post_data(CS%id_col_ht, z_bot, CS%diag) endif @@ -1216,7 +1216,7 @@ subroutine post_surface_thermo_diags(IDs, G, GV, diag, dt_int, sfc_state, tv, & ! post total volume of the liquid ocean if (IDs%id_volo > 0) then do j=js,je ; do i=is,ie - work_2d(i,j) = G%mask2dT(i,j)*(ssh(i,j) + G%Zd_to_m*G%bathyT(i,j)) + work_2d(i,j) = G%mask2dT(i,j)*(ssh(i,j) + GV%Z_to_m*G%bathyT(i,j)) enddo ; enddo volo = global_area_integral(work_2d, G) call post_data(IDs%id_volo, volo, diag) @@ -1826,10 +1826,7 @@ subroutine write_static_fields(G, GV, tv, diag) type(diag_ctrl), target, intent(inout) :: diag !< regulates diagnostic output ! Local variables - real :: tmp_h(SZI_(G),SZJ_(G)) - integer :: id, i, j - - tmp_h(:,:) = 0.0 + integer :: id id = register_static_field('ocean_model', 'geolat', diag%axesT1, & 'Latitude of tracer (T) points', 'degrees_north') @@ -1878,45 +1875,30 @@ subroutine write_static_fields(G, GV, tv, diag) cmor_field_name='areacello_cu', cmor_standard_name='cell_area', & cmor_long_name='Ocean Grid-Cell Area', & x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') - if (id > 0) then - call post_data(id, G%areaCu, diag, .true.) - endif + if (id > 0) call post_data(id, G%areaCu, diag, .true.) id = register_static_field('ocean_model', 'area_v', diag%axesCv1, & 'Surface area of y-direction flow (V) cells', 'm2', & cmor_field_name='areacello_cv', cmor_standard_name='cell_area', & cmor_long_name='Ocean Grid-Cell Area', & x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') - if (id > 0) then - call post_data(id, G%areaCv, diag, .true.) - endif + if (id > 0) call post_data(id, G%areaCv, diag, .true.) id = register_static_field('ocean_model', 'area_q', diag%axesB1, & 'Surface area of B-grid flow (Q) cells', 'm2', & cmor_field_name='areacello_bu', cmor_standard_name='cell_area', & cmor_long_name='Ocean Grid-Cell Area', & x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') - if (id > 0) then - call post_data(id, G%areaBu, diag, .true.) - endif + if (id > 0) call post_data(id, G%areaBu, diag, .true.) id = register_static_field('ocean_model', 'depth_ocean', diag%axesT1, & 'Depth of the ocean at tracer points', 'm', & standard_name='sea_floor_depth_below_geoid', & cmor_field_name='deptho', cmor_long_name='Sea Floor Depth', & - cmor_standard_name='sea_floor_depth_below_geoid',& - area=diag%axesT1%id_area, & - x_cell_method='mean', y_cell_method='mean', area_cell_method='mean') - if (id > 0) then - if (G%Zd_to_m == 1.0) then - call post_data(id, G%bathyT, diag, .true., mask=G%mask2dT) - else - do j=G%jsc,G%jec ; do i=G%isc,G%iec - tmp_h(i,j) = G%bathyT(i,j) * G%Zd_to_m - enddo ; enddo - call post_data(id, tmp_h, diag, .true., mask=G%mask2dT) - endif - endif + cmor_standard_name='sea_floor_depth_below_geoid', area=diag%axesT1%id_area, & + x_cell_method='mean', y_cell_method='mean', area_cell_method='mean', & + conversion=GV%Z_to_m) + if (id > 0) call post_data(id, G%bathyT, diag, .true., mask=G%mask2dT) id = register_static_field('ocean_model', 'wet', diag%axesT1, & '0 if land, 1 if ocean at tracer points', 'none', area=diag%axesT1%id_area) @@ -1985,13 +1967,10 @@ subroutine write_static_fields(G, GV, tv, diag) 'Percentage of cell area covered by ocean', '%', & cmor_field_name='sftof', cmor_standard_name='SeaAreaFraction', & cmor_long_name='Sea Area Fraction', & - x_cell_method='mean', y_cell_method='mean', area_cell_method='mean') - if (id > 0) then - do j=G%jsc,G%jec ; do i=G%isc,G%iec - tmp_h(i,j) = 100. * G%mask2dT(i,j) - enddo ; enddo - call post_data(id, tmp_h, diag, .true.) - endif + x_cell_method='mean', y_cell_method='mean', area_cell_method='mean', & + conversion=100.0) + if (id > 0) call post_data(id, G%mask2dT, diag, .true.) + id = register_static_field('ocean_model','Rho_0', diag%axesNull, & 'mean ocean density used with the Boussinesq approximation', & From b008d923a5f660f1e63be75089dfd9226298182e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 26 Oct 2018 15:17:57 -0400 Subject: [PATCH 0862/1072] Recast MOM_sum_output to work in units of Z Recast the internal calculations in MOM_sum_output to use vertical height units of Z in place of m for dimensional consistency testing. The depth list that is written to or read from a file still uses heights in m and volumes in m3, so it is compatible across rescaling and across versions of the code. There was also some rearrangement of the code for simplifications. Various comments were also updated. All answers and output are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- src/diagnostics/MOM_sum_output.F90 | 133 ++++++++++++++--------------- 1 file changed, 65 insertions(+), 68 deletions(-) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 91a4dd96ab..a902ad67ec 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -56,7 +56,7 @@ module MOM_sum_output logical :: read_depth_list !< Read the depth list from a file if it exists !! and write it if it doesn't. character(len=200) :: depth_list_file !< The name of the depth list file. - real :: D_list_min_inc !< The minimum increment, in m, between the depths of the + real :: D_list_min_inc !< The minimum increment, in Z, between the depths of the !! entries in the depth-list file, 0 by default. logical :: use_temperature !< If true, temperature and salinity are state variables. real :: fresh_water_input !< The total mass of fresh water added by surface fluxes @@ -211,8 +211,8 @@ subroutine MOM_sum_output_init(G, param_file, directory, ntrnc, & "create that file otherwise.", default=.false.) call get_param(param_file, mdl, "DEPTH_LIST_MIN_INC", CS%D_list_min_inc, & "The minimum increment between the depths of the \n"//& - "entries in the depth-list file.", units="m", & - default=1.0E-10) + "entries in the depth-list file.", & + units="m", default=1.0E-10, scale=1.0/G%Zd_to_m) if (CS%read_depth_list) then call get_param(param_file, mdl, "DEPTH_LIST_FILE", CS%depth_list_file, & "The name of the depth list file.", default="Depth_list.nc") @@ -288,21 +288,21 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc optional, pointer :: OBC !< Open boundaries control structure. type(time_type), optional, intent(in) :: dt_forcing !< The forcing time step ! Local variables - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! The height of interfaces, in m. + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! The height of interfaces, in Z. real :: areaTm(SZI_(G),SZJ_(G)) ! A masked version of areaT, in m2. real :: KE(SZK_(G)) ! The total kinetic energy of a layer, in J. real :: PE(SZK_(G)+1)! The available potential energy of an interface, in J. real :: KE_tot ! The total kinetic energy, in J. real :: PE_tot ! The total available potential energy, in J. - real :: H_0APE(SZK_(G)+1) ! The uniform depth which overlies the same - ! volume as is below an interface, in m. - ! H is usually positive. + real :: Z_0APE(SZK_(G)+1) ! The uniform depth which overlies the same + ! volume as is below an interface, in Z. + real :: H_0APE(SZK_(G)+1) ! A version of Z_0APE, converted to m, usually positive. real :: toten ! The total kinetic & potential energies of ! all layers, in Joules (i.e. kg m2 s-2). real :: En_mass ! The total kinetic and potential energies divided by ! the total mass of the ocean, in m2 s-2. - real :: vol_lay(SZK_(G)) ! The volume of fluid in a layer, in m3. - real :: volbelow ! The volume of all layers beneath an interface in m3. + real :: vol_lay(SZK_(G)) ! The volume of fluid in a layer, in Z m2. + real :: volbelow ! The volume of all layers beneath an interface in Z m2. real :: mass_lay(SZK_(G)) ! The mass of fluid in a layer, in kg. real :: mass_tot ! The total mass of the ocean in kg. real :: vol_tot ! The total ocean volume in m3. @@ -332,12 +332,11 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc real :: temp_anom ! The change in total heat that cannot be accounted for ! by the surface fluxes, divided by the total heat ! capacity of the ocean, in C. - real :: hint ! The deviation of an interface from H, in m. + real :: hint ! The deviation of an interface from H, in Z. real :: hbot ! 0 if the basin is deeper than H, or the ! height of the basin depth over H otherwise, - ! in m. This makes PE only include real fluid. - real :: hbelow ! The depth of fluid in all layers beneath - ! an interface, in m. + ! in Z. This makes PE only include real fluid. + real :: hbelow ! The depth of fluid in all layers beneath an interface, in Z. type(EFP_type) :: & mass_EFP, & ! Extended fixed point sums of total mass, etc. salt_EFP, heat_EFP, salt_chg_EFP, heat_chg_EFP, mass_chg_EFP, & @@ -345,37 +344,35 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc real :: CFL_trans ! A transport-based definition of the CFL number, nondim. real :: CFL_lin ! A simpler definition of the CFL number, nondim. real :: max_CFL(2) ! The maxima of the CFL numbers, nondim. - real :: Irho0 + real :: Irho0 ! The inverse of the reference density, in m3 kg-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - tmp1 + tmp1 ! A temporary array real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & - PE_pt + PE_pt ! The potential energy at each point, in J. real, dimension(SZI_(G),SZJ_(G)) :: & - Temp_int, Salt_int - real :: H_to_m, H_to_kg_m2 ! Local copies of unit conversion factors. + Temp_int, Salt_int ! Layer and cell integrated heat and salt, in J and g Salt. + real :: H_to_kg_m2 ! Local copy of a unit conversion factor. integer :: num_nc_fields ! The number of fields that will actually go into ! the NetCDF file. integer :: i, j, k, is, ie, js, je, ns, nz, m, Isq, Ieq, Jsq, Jeq - integer :: l, lbelow, labove ! indices of deep_area_vol, used to find - ! H. lbelow & labove are lower & upper - ! limits for l in the search for lH. + integer :: l, lbelow, labove ! indices of deep_area_vol, used to find Z_0APE. + ! lbelow & labove are lower & upper limits for l + ! in the search for the entry in lH to use. integer :: start_of_day, num_days real :: reday, var character(len=240) :: energypath_nc character(len=200) :: mesg character(len=32) :: mesg_intro, time_units, day_str, n_str, date_str logical :: date_stamped - type(time_type) :: dt_force + type(time_type) :: dt_force ! A time_type version of the forcing timestep. real :: Tr_stocks(MAX_FIELDS_) - real :: Tr_min(MAX_FIELDS_),Tr_max(MAX_FIELDS_) + real :: Tr_min(MAX_FIELDS_), Tr_max(MAX_FIELDS_) real :: Tr_min_x(MAX_FIELDS_), Tr_min_y(MAX_FIELDS_), Tr_min_z(MAX_FIELDS_) real :: Tr_max_x(MAX_FIELDS_), Tr_max_y(MAX_FIELDS_), Tr_max_z(MAX_FIELDS_) logical :: Tr_minmax_got(MAX_FIELDS_) = .false. character(len=40), dimension(MAX_FIELDS_) :: & Tr_names, Tr_units integer :: nTr_stocks - real, allocatable :: toten_PE(:) - integer :: pe_num integer :: iyear, imonth, iday, ihour, iminute, isecond, itick ! For call to get_date() logical :: local_open_BC type(OBC_segment_type), pointer :: segment => NULL() @@ -445,7 +442,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - H_to_m = GV%H_to_m ; H_to_kg_m2 = GV%H_to_kg_m2 + H_to_kg_m2 = GV%H_to_kg_m2 if (.not.associated(CS)) call MOM_error(FATAL, & "write_energy: Module must be initialized before it is used.") @@ -489,7 +486,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc endif mass_tot = reproducing_sum(tmp1, sums=mass_lay, EFP_sum=mass_EFP) - do k=1,nz ; vol_lay(k) = (H_to_m/H_to_kg_m2)*mass_lay(k) ; enddo + do k=1,nz ; vol_lay(k) = (GV%H_to_Z/H_to_kg_m2)*mass_lay(k) ; enddo else tmp1(:,:,:) = 0.0 if (CS%do_APE_calc) then @@ -498,17 +495,17 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc enddo ; enddo ; enddo mass_tot = reproducing_sum(tmp1, sums=mass_lay, EFP_sum=mass_EFP) - call find_eta(h, tv, G, GV, eta, eta_to_m=1.0) + call find_eta(h, tv, G, GV, eta) do k=1,nz ; do j=js,je ; do i=is,ie tmp1(i,j,k) = (eta(i,j,K)-eta(i,j,K+1)) * areaTm(i,j) enddo ; enddo ; enddo - vol_tot = H_to_m*reproducing_sum(tmp1, sums=vol_lay) + vol_tot = GV%Z_to_m*reproducing_sum(tmp1, sums=vol_lay) else do k=1,nz ; do j=js,je ; do i=is,ie tmp1(i,j,k) = H_to_kg_m2 * h(i,j,k) * areaTm(i,j) enddo ; enddo ; enddo mass_tot = reproducing_sum(tmp1, sums=mass_lay, EFP_sum=mass_EFP) - do k=1,nz ; vol_lay(k) = mass_lay(k) / GV%Rho0 ; enddo + do k=1,nz ; vol_lay(k) = GV%m_to_Z * (mass_lay(k) / GV%Rho0) ; enddo endif endif ! Boussinesq @@ -615,55 +612,53 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc CS%lH(k) = l endif lbelow = l - H_0APE(K) = CS%DL(l)%depth - (volbelow - CS%DL(l)%vol_below) / CS%DL(l)%area + Z_0APE(K) = CS%DL(l)%depth - (volbelow - CS%DL(l)%vol_below) / CS%DL(l)%area enddo - H_0APE(nz+1) = CS%DL(2)%depth - else - do k=1,nz+1 ; H_0APE(K) = 0.0 ; enddo - endif + Z_0APE(nz+1) = CS%DL(2)%depth -! Calculate the Kinetic Energy integrated over each layer. - tmp1(:,:,:) = 0.0 - do k=1,nz ; do j=js,je ; do i=is,ie - tmp1(i,j,k) = (0.25 * H_to_kg_m2 * (areaTm(i,j) * h(i,j,k))) * & - (u(I-1,j,k)**2 + u(I,j,k)**2 + v(i,J-1,k)**2 + v(i,J,k)**2) - enddo ; enddo ; enddo - -! Calculate the Available Potential Energy integrated over each -! interface. With a nonlinear equation of state or with a bulk -! mixed layer this calculation is only approximate. - do k=1,nz+1 ; PE(K) = 0.0 ; enddo - if (CS%do_APE_calc) then + ! Calculate the Available Potential Energy integrated over each + ! interface. With a nonlinear equation of state or with a bulk + ! mixed layer this calculation is only approximate. With an ALE model + ! this does not make sense. PE_pt(:,:,:) = 0.0 if (GV%Boussinesq) then do j=js,je ; do i=is,ie hbelow = 0.0 do k=nz,1,-1 - hbelow = hbelow + h(i,j,k) * H_to_m - hint = H_0APE(K) + (hbelow - G%Zd_to_m*G%bathyT(i,j)) - hbot = H_0APE(K) - G%Zd_to_m*G%bathyT(i,j) + hbelow = hbelow + h(i,j,k) * GV%H_to_Z + hint = Z_0APE(K) + (hbelow - G%bathyT(i,j)) + hbot = Z_0APE(K) - G%bathyT(i,j) hbot = (hbot + ABS(hbot)) * 0.5 - PE_pt(i,j,K) = 0.5 * areaTm(i,j) * (GV%Rho0*GV%m_to_Z*GV%g_prime(K)) * & + PE_pt(i,j,K) = 0.5 * areaTm(i,j) * GV%Z_to_m*(GV%Rho0*GV%g_prime(K)) * & (hint * hint - hbot * hbot) enddo enddo ; enddo else do j=js,je ; do i=is,ie - hbelow = 0.0 do k=nz,1,-1 - hint = H_0APE(K) + eta(i,j,K) ! eta and H_0 have opposite signs. - hbot = max(H_0APE(K) - G%Zd_to_m*G%bathyT(i,j), 0.0) - PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * (GV%Rho0*GV%m_to_Z*GV%g_prime(K))) * & + hint = Z_0APE(K) + eta(i,j,K) ! eta and H_0 have opposite signs. + hbot = max(Z_0APE(K) - G%bathyT(i,j), 0.0) + PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * GV%Z_to_m*(GV%Rho0*GV%g_prime(K))) * & (hint * hint - hbot * hbot) enddo enddo ; enddo endif + + PE_tot = reproducing_sum(PE_pt, sums=PE) + do k=1,nz+1 ; H_0APE(K) = GV%Z_to_m*Z_0APE(K) ; enddo + else + PE_tot = 0.0 + do k=1,nz+1 ; PE(K) = 0.0 ; H_0APE(K) = 0.0 ; enddo endif +! Calculate the Kinetic Energy integrated over each layer. + tmp1(:,:,:) = 0.0 + do k=1,nz ; do j=js,je ; do i=is,ie + tmp1(i,j,k) = (0.25 * H_to_kg_m2 * (areaTm(i,j) * h(i,j,k))) * & + (u(I-1,j,k)**2 + u(I,j,k)**2 + v(i,J-1,k)**2 + v(i,J,k)**2) + enddo ; enddo ; enddo KE_tot = reproducing_sum(tmp1, sums=KE) - PE_tot = 0.0 - if (CS%do_APE_calc) & - PE_tot = reproducing_sum(PE_pt, sums=PE) + toten = KE_tot + PE_tot Salt = 0.0 ; Heat = 0.0 @@ -1061,15 +1056,15 @@ subroutine create_depth_list(G, CS) !! in which the ordered depth list is stored. ! Local variables real, dimension(G%Domain%niglobal*G%Domain%njglobal + 1) :: & - Dlist, & !< The global list of bottom depths, in m. + Dlist, & !< The global list of bottom depths, in Z. AreaList !< The global list of cell areas, in m2. integer, dimension(G%Domain%niglobal*G%Domain%njglobal+1) :: & indx2 !< The position of an element in the original unsorted list. - real :: Dnow !< The depth now being considered for sorting, in m. - real :: Dprev !< The most recent depth that was considered, in m. - real :: vol !< The running sum of open volume below a deptn, in m3. + real :: Dnow !< The depth now being considered for sorting, in Z. + real :: Dprev !< The most recent depth that was considered, in Z. + real :: vol !< The running sum of open volume below a deptn, in Z m2. real :: area !< The open area at the current depth, in m2. - real :: D_list_prev !< The most recent depth added to the list, in m. + real :: D_list_prev !< The most recent depth added to the list, in Z. logical :: add_to_list !< This depth should be included as an entry on the list. integer :: ir, indxt @@ -1088,7 +1083,7 @@ subroutine create_depth_list(G, CS) i_global = i + G%idg_offset - (G%isg-1) list_pos = (j_global-1)*G%Domain%niglobal + i_global - Dlist(list_pos) = G%Zd_to_m*G%bathyT(i,j) + Dlist(list_pos) = G%bathyT(i,j) Arealist(list_pos) = G%mask2dT(i,j)*G%areaT(i,j) enddo ; enddo @@ -1238,7 +1233,7 @@ subroutine write_depth_list(G, CS, filename, list_size) if (status /= NF90_NOERR) call MOM_error(WARNING, & filename//trim(NF90_STRERROR(status))) - do k=1,list_size ; tmp(k) = CS%DL(k)%depth ; enddo + do k=1,list_size ; tmp(k) = G%Zd_to_m*CS%DL(k)%depth ; enddo status = NF90_PUT_VAR(ncid, Did, tmp) if (status /= NF90_NOERR) call MOM_error(WARNING, & filename//" depth "//trim(NF90_STRERROR(status))) @@ -1248,7 +1243,7 @@ subroutine write_depth_list(G, CS, filename, list_size) if (status /= NF90_NOERR) call MOM_error(WARNING, & filename//" area "//trim(NF90_STRERROR(status))) - do k=1,list_size ; tmp(k) = CS%DL(k)%vol_below ; enddo + do k=1,list_size ; tmp(k) = G%Zd_to_m*CS%DL(k)%vol_below ; enddo status = NF90_PUT_VAR(ncid, Vid, tmp) if (status /= NF90_NOERR) call MOM_error(WARNING, & filename//" vol_below "//trim(NF90_STRERROR(status))) @@ -1270,10 +1265,12 @@ subroutine read_depth_list(G, CS, filename) character(len=32) :: mdl character(len=240) :: var_name, var_msg real, allocatable :: tmp(:) + real :: m_to_Z integer :: ncid, status, varid, list_size, k integer :: ndim, len, var_dim_ids(NF90_MAX_VAR_DIMS) mdl = "MOM_sum_output read_depth_list:" + m_to_Z = 1.0/G%Zd_to_m status = NF90_OPEN(filename, NF90_NOWRITE, ncid) if (status /= NF90_NOERR) then @@ -1312,7 +1309,7 @@ subroutine read_depth_list(G, CS, filename) " Difficulties reading variable "//trim(var_msg)//& trim(NF90_STRERROR(status))) - do k=1,list_size ; CS%DL(k)%depth = tmp(k) ; enddo + do k=1,list_size ; CS%DL(k)%depth = m_to_Z*tmp(k) ; enddo var_name = "area" var_msg = trim(var_name)//" in "//trim(filename)//" - " @@ -1338,7 +1335,7 @@ subroutine read_depth_list(G, CS, filename) " Difficulties reading variable "//trim(var_msg)//& trim(NF90_STRERROR(status))) - do k=1,list_size ; CS%DL(k)%vol_below = tmp(k) ; enddo + do k=1,list_size ; CS%DL(k)%vol_below = m_to_Z*tmp(k) ; enddo status = NF90_CLOSE(ncid) if (status /= NF90_NOERR) call MOM_error(WARNING, mdl// & From ea8ed3e3e8f7a9cab2ed5d2ffc79e1b3eddb6745 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 26 Oct 2018 15:18:18 -0400 Subject: [PATCH 0863/1072] Use local variables to rescale in MOM_Point_Accel Set up local variables to use for the unit conversion in MOM_point_accel both to simplify the code, facilate the detection of unconverted variables with greps and to simplify the changes that will required with additional future unit conversions. All answers are bitwise identical. --- src/diagnostics/MOM_PointAccel.F90 | 84 ++++++++++++++++-------------- 1 file changed, 44 insertions(+), 40 deletions(-) diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index a5b5bbc6b0..89dbe0b6a9 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -95,6 +95,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a real :: truncvel, du real :: Inorm(SZK_(G)) real :: e(SZK_(G)+1) + real :: h_scale, uh_scale integer :: yr, mo, day, hr, minute, sec, yearday integer :: k, ks, ke integer :: nz @@ -103,6 +104,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a integer :: file Angstrom = GV%Angstrom_H + GV%H_subroundoff + h_scale = GV%H_to_m ; uh_scale = GV%H_to_m ! if (.not.associated(CS)) return nz = G%ke @@ -231,27 +233,27 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a endif write(file,'(/,"h--: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (GV%H_to_m*hin(i,j-1,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i,j-1,k)); enddo write(file,'(/,"h+-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (GV%H_to_m*hin(i+1,j-1,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i+1,j-1,k)); enddo write(file,'(/,"h-0: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (GV%H_to_m*hin(i,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i,j,k)); enddo write(file,'(/,"h+0: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (GV%H_to_m*hin(i+1,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i+1,j,k)); enddo write(file,'(/,"h-+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (GV%H_to_m*hin(i,j+1,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i,j+1,k)); enddo write(file,'(/,"h++: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (GV%H_to_m*hin(i+1,j+1,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i+1,j+1,k)); enddo e(nz+1) = -GV%Z_to_m*G%bathyT(i,j) - do k=nz,1,-1 ; e(K) = e(K+1) + GV%H_to_m*hin(i,j,k) ; enddo + do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j,k) ; enddo write(file,'(/,"e-: ",$)') write(file,'(ES10.3," ",$)') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo e(nz+1) = -GV%Z_to_m*G%bathyT(i+1,j) - do k=nz,1,-1 ; e(K) = e(K+1) + GV%H_to_m*hin(i+1,j,k) ; enddo + do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i+1,j,k) ; enddo write(file,'(/,"e+: ",$)') write(file,'(ES10.3," ",$)') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K) ; enddo @@ -281,50 +283,50 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a write(file,'(/,"vh--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (GV%H_to_m*CDp%vh(i,J-1,k)*G%IdxCv(i,J-1)); enddo + (uh_scale*CDp%vh(i,J-1,k)*G%IdxCv(i,J-1)); enddo write(file,'(/," vhC--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i,j-1,k)*GV%H_to_m*(hin(i,j-1,k) + hin(i,j,k))); enddo + (0.5*CS%v_av(i,j-1,k)*h_scale*(hin(i,j-1,k) + hin(i,j,k))); enddo if (prev_avail) then write(file,'(/," vhCp--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_prev(i,j-1,k)*GV%H_to_m*(hin(i,j-1,k) + hin(i,j,k))); enddo + (0.5*CS%v_prev(i,j-1,k)*h_scale*(hin(i,j-1,k) + hin(i,j,k))); enddo endif write(file,'(/,"vh-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (GV%H_to_m*CDp%vh(i,J,k)*G%IdxCv(i,J)); enddo + (uh_scale*CDp%vh(i,J,k)*G%IdxCv(i,J)); enddo write(file,'(/," vhC-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i,J,k)*GV%H_to_m*(hin(i,j,k) + hin(i,j+1,k))); enddo + (0.5*CS%v_av(i,J,k)*h_scale*(hin(i,j,k) + hin(i,j+1,k))); enddo if (prev_avail) then write(file,'(/," vhCp-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_prev(i,J,k)*GV%H_to_m*(hin(i,j,k) + hin(i,j+1,k))); enddo + (0.5*CS%v_prev(i,J,k)*h_scale*(hin(i,j,k) + hin(i,j+1,k))); enddo endif write(file,'(/,"vh+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (GV%H_to_m*CDp%vh(i+1,J-1,k)*G%IdxCv(i+1,J-1)); enddo + (uh_scale*CDp%vh(i+1,J-1,k)*G%IdxCv(i+1,J-1)); enddo write(file,'(/," vhC+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i+1,J-1,k)*GV%H_to_m*(hin(i+1,j-1,k) + hin(i+1,j,k))); enddo + (0.5*CS%v_av(i+1,J-1,k)*h_scale*(hin(i+1,j-1,k) + hin(i+1,j,k))); enddo if (prev_avail) then write(file,'(/," vhCp+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_prev(i+1,J-1,k)*GV%H_to_m*(hin(i+1,j-1,k) + hin(i+1,j,k))); enddo + (0.5*CS%v_prev(i+1,J-1,k)*h_scale*(hin(i+1,j-1,k) + hin(i+1,j,k))); enddo endif write(file,'(/,"vh++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (GV%H_to_m*CDp%vh(i+1,J,k)*G%IdxCv(i+1,J)); enddo + (uh_scale*CDp%vh(i+1,J,k)*G%IdxCv(i+1,J)); enddo write(file,'(/," vhC++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i+1,J,k)*GV%H_to_m*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo + (0.5*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo if (prev_avail) then write(file,'(/," vhCp++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i+1,J,k)*GV%H_to_m*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo + (0.5*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo endif write(file,'(/,"D: ",2(ES10.3))') GV%Z_to_m*G%bathyT(i,j),GV%Z_to_m*G%bathyT(i+1,j) @@ -423,6 +425,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a real :: truncvel, dv real :: Inorm(SZK_(G)) real :: e(SZK_(G)+1) + real :: h_scale, uh_scale integer :: yr, mo, day, hr, minute, sec, yearday integer :: k, ks, ke integer :: nz @@ -431,6 +434,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a integer :: file Angstrom = GV%Angstrom_H + GV%H_subroundoff + h_scale = GV%H_to_m ; uh_scale = GV%H_to_m ! if (.not.associated(CS)) return nz = G%ke @@ -563,26 +567,26 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a endif write(file,'("h--: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') GV%H_to_m*hin(i-1,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i-1,j,k); enddo write(file,'(/,"h0-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') GV%H_to_m*hin(i,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i,j,k); enddo write(file,'(/,"h+-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') GV%H_to_m*hin(i+1,j,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i+1,j,k); enddo write(file,'(/,"h-+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') GV%H_to_m*hin(i-1,j+1,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i-1,j+1,k); enddo write(file,'(/,"h0+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') GV%H_to_m*hin(i,j+1,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i,j+1,k); enddo write(file,'(/,"h++: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') GV%H_to_m*hin(i+1,j+1,k); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i+1,j+1,k); enddo e(nz+1) = -GV%Z_to_m*G%bathyT(i,j) - do k=nz,1,-1 ; e(K) = e(K+1) + GV%H_to_m*hin(i,j,k); enddo + do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j,k); enddo write(file,'(/,"e-: ",$)') write(file,'(ES10.3," ",$)') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo e(nz+1) = -GV%Z_to_m*G%bathyT(i,j+1) - do k=nz,1,-1 ; e(K) = e(K+1) + GV%H_to_m*hin(i,j+1,k) ; enddo + do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j+1,k) ; enddo write(file,'(/,"e+: ",$)') write(file,'(ES10.3," ",$)') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo @@ -612,50 +616,50 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a write(file,'(/,"uh--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (GV%H_to_m*CDp%uh(I-1,j,k)*G%IdyCu(I-1,j)); enddo + (uh_scale*CDp%uh(I-1,j,k)*G%IdyCu(I-1,j)); enddo write(file,'(/," uhC--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_av(I-1,j,k) * GV%H_to_m*0.5*(hin(i-1,j,k) + hin(i,j,k))); enddo + (CS%u_av(I-1,j,k) * h_scale*0.5*(hin(i-1,j,k) + hin(i,j,k))); enddo if (prev_avail) then write(file,'(/," uhCp--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_prev(I-1,j,k) * GV%H_to_m*0.5*(hin(i-1,j,k) + hin(i,j,k))); enddo + (CS%u_prev(I-1,j,k) * h_scale*0.5*(hin(i-1,j,k) + hin(i,j,k))); enddo endif write(file,'(/,"uh-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CDp%uh(I-1,j+1,k)*G%IdyCu(I-1,j+1)); enddo + (uh_scale*CDp%uh(I-1,j+1,k)*G%IdyCu(I-1,j+1)); enddo write(file,'(/," uhC-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_av(I-1,j+1,k) * GV%H_to_m*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))); enddo + (CS%u_av(I-1,j+1,k) * h_scale*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))); enddo if (prev_avail) then write(file,'(/," uhCp-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_prev(I-1,j+1,k) * GV%H_to_m*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))); enddo + (CS%u_prev(I-1,j+1,k) * h_scale*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))); enddo endif write(file,'(/,"uh+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (GV%H_to_m*CDp%uh(I,j,k)*G%IdyCu(I,j)); enddo + (uh_scale*CDp%uh(I,j,k)*G%IdyCu(I,j)); enddo write(file,'(/," uhC+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_av(I,j,k) * GV%H_to_m*0.5*(hin(i,j,k) + hin(i+1,j,k))); enddo + (CS%u_av(I,j,k) * h_scale*0.5*(hin(i,j,k) + hin(i+1,j,k))); enddo if (prev_avail) then write(file,'(/," uhCp+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_prev(I,j,k) * GV%H_to_m*0.5*(hin(i,j,k) + hin(i+1,j,k))); enddo + (CS%u_prev(I,j,k) * h_scale*0.5*(hin(i,j,k) + hin(i+1,j,k))); enddo endif write(file,'(/,"uh++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (GV%H_to_m*CDp%uh(I,j+1,k)*G%IdyCu(I,j+1)); enddo + (uh_scale*CDp%uh(I,j+1,k)*G%IdyCu(I,j+1)); enddo write(file,'(/," uhC++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_av(I,j+1,k) * 0.5*GV%H_to_m*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo + (CS%u_av(I,j+1,k) * 0.5*h_scale*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo if (prev_avail) then write(file,'(/," uhCp++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_prev(I,j+1,k) * GV%H_to_m*0.5*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo + (CS%u_prev(I,j+1,k) * h_scale*0.5*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo endif write(file,'(/,"D: ",2(ES10.3))') GV%Z_to_m*G%bathyT(i,j),GV%Z_to_m*G%bathyT(i,j+1) From fe0c041f997b855864a88e7aa909063d337cefcc Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Fri, 26 Oct 2018 16:19:53 -0400 Subject: [PATCH 0864/1072] Diagnostics downsampling, implement suggestions in reviews - This update addresses and implements suggestions in the reviews by Alisair and Balaji, particularly - Rename the whole project and scheme to downsampling - Make a container type for the horizontal indices G%Hd2 for downsampling level 2 - Removed the trailing blanks caught by travis --- src/core/MOM_grid.F90 | 38 +- src/framework/MOM_diag_mediator.F90 | 802 ++++++++++++++-------------- src/framework/MOM_domains.F90 | 57 +- 3 files changed, 426 insertions(+), 471 deletions(-) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index c80f2a2070..453e351060 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -5,7 +5,7 @@ module MOM_grid use MOM_hor_index, only : hor_index_type, hor_index_init use MOM_domains, only : MOM_domain_type, get_domain_extent, compute_block_extent -use MOM_domains, only : get_global_shape, get_domain_extent_zap2 +use MOM_domains, only : get_global_shape, get_domain_extent_dsamp2 use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL use MOM_file_parser, only : get_param, log_param, log_version, param_file_type @@ -21,6 +21,7 @@ module MOM_grid type(MOM_domain_type), pointer :: Domain => NULL() !< Ocean model domain type(MOM_domain_type), pointer :: Domain_aux => NULL() !< A non-symmetric auxiliary domain type. type(hor_index_type) :: HI !< Horizontal index ranges + type(hor_index_type) :: HId2 !< Horizontal index ranges for level-2-downsampling integer :: isc !< The start i-index of cell centers within the computational domain integer :: iec !< The end i-index of cell centers within the computational domain @@ -52,23 +53,6 @@ module MOM_grid integer :: JsgB !< The start j-index of cell vertices within the global domain integer :: JegB !< The end j-index of cell vertices within the global domain - integer :: isc_zap2 !< The start i-index of cell centers within the computational domain - integer :: iec_zap2 !< The end i-index of cell centers within the computational domain - integer :: jsc_zap2 !< The start j-index of cell centers within the computational domain - integer :: jec_zap2 !< The end j-index of cell centers within the computational domain - integer :: isd_zap2 !< The start i-index of cell centers within the data domain - integer :: ied_zap2 !< The end i-index of cell centers within the data domain - integer :: jsd_zap2 !< The start j-index of cell centers within the data domain - integer :: jed_zap2 !< The end j-index of cell centers within the data domain - integer :: IsdB_zap2 !< The start i-index of cell vertices within the data domain - integer :: IedB_zap2 !< The end i-index of cell vertices within the data domain - integer :: JsdB_zap2 !< The start j-index of cell vertices within the data domain - integer :: JedB_zap2 !< The end j-index of cell vertices within the data domain - integer :: isg_zap2 !< The start i-index of cell centers within the computational domain - integer :: ieg_zap2 !< The end i-index of cell centers within the computational domain - integer :: jsg_zap2 !< The start j-index of cell centers within the computational domain - integer :: jeg_zap2 !< The end j-index of cell centers within the computational domain - integer :: isd_global !< The value of isd in the global index space (decompoistion invariant). integer :: jsd_global !< The value of isd in the global index space (decompoistion invariant). integer :: idg_offset !< The offset between the corresponding global and local i-indices. @@ -361,22 +345,16 @@ subroutine MOM_grid_init(G, param_file, HI, global_indexing, bathymetry_at_vel) if ( G%block(nblocks)%jed+G%block(nblocks)%jdg_offset > G%HI%jed + G%HI%jdg_offset ) & call MOM_error(FATAL, "MOM_grid_init: G%jed_bk > G%jed") - call get_domain_extent_zap2(G%Domain, G%isc_zap2, G%iec_zap2, G%jsc_zap2, G%jec_zap2,& - G%isd_zap2, G%ied_zap2, G%jsd_zap2, G%jed_zap2,& - G%isg_zap2, G%ieg_zap2, G%jsg_zap2, G%jeg_zap2) + call get_domain_extent_dsamp2(G%Domain, G%HId2%isc, G%HId2%iec, G%HId2%jsc, G%HId2%jec,& + G%HId2%isd, G%HId2%ied, G%HId2%jsd, G%HId2%jed,& + G%HId2%isg, G%HId2%ieg, G%HId2%jsg, G%HId2%jeg) ! Set array sizes for fields that are discretized at tracer cell boundaries. -! G%IscB_zap2 = G%isc_zap2 ; G%JscB_zap2 = G%jsc_zap2 - G%IsdB_zap2 = G%isd_zap2 ; G%JsdB_zap2 = G%jsd_zap2 -! G%IsgB_zap2 = G%isg_zap2 ; G%JsgB_zap2 = G%jsg_zap2 + G%HId2%IsdB = G%HId2%isd ; G%HId2%JsdB = G%HId2%jsd if (G%symmetric) then -! G%IscB_zap2 = G%isc_zap2-1 ; G%JscB_zap2 = G%jsc_zap2-1 - G%IsdB_zap2 = G%isd_zap2-1 ; G%JsdB_zap2 = G%jsd_zap2-1 -! G%IsgB_zap2 = G%isg_zap2-1 ; G%JsgB_zap2 = G%jsg_zap2-1 + G%HId2%IsdB = G%HId2%isd-1 ; G%HId2%JsdB = G%HId2%jsd-1 endif -! G%IecB_zap2 = G%iec_zap2 ; G%JecB_zap2 = G%jec_zap2 - G%IedB_zap2 = G%ied_zap2 ; G%JedB_zap2 = G%jed_zap2 -! G%IegB_zap2 = G%ieg_zap2 ; G%JegB_zap2 = G%jeg_zap2 + G%HId2%IedB = G%HId2%ied ; G%HId2%JedB = G%HId2%jed end subroutine MOM_grid_init diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index a31f8e8f69..2abc9b611d 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -42,7 +42,7 @@ module MOM_diag_mediator #undef __DO_SAFETY_CHECKS__ #define IMPLIES(A, B) ((.not. (A)) .or. (B)) -#define MAX_DECIM_LEV 2 +#define MAX_DSAMP_LEV 2 public set_axes_info, post_data, register_diag_field, time_type public set_masks_for_axes @@ -68,22 +68,22 @@ module MOM_diag_mediator module procedure post_data_3d, post_data_2d, post_data_1d_k, post_data_0d end interface post_data -interface decimate_field - module procedure decimate_field_2d, decimate_field_3d -end interface decimate_field +interface downsample_field + module procedure downsample_field_2d, downsample_field_3d +end interface downsample_field -interface decimate_mask - module procedure decimate_mask_2d_p, decimate_mask_3d_p, decimate_mask_2d_a, decimate_mask_3d_a -end interface decimate_mask +interface downsample_mask + module procedure downsample_mask_2d_p, downsample_mask_3d_p, downsample_mask_2d_a, downsample_mask_3d_a +end interface downsample_mask -interface decimate_diag_field - module procedure decimate_diag_field_2d, decimate_diag_field_3d -end interface decimate_diag_field +interface downsample_diag_field + module procedure downsample_diag_field_2d, downsample_diag_field_3d +end interface downsample_diag_field -type, private :: diag_decim - real, pointer, dimension(:,:) :: mask2d => null() !< Mask for 2d (x-y) axes - real, pointer, dimension(:,:,:) :: mask3d => null() !< Mask for 3d axes -end type diag_decim +type, private :: diag_dsamp + real, pointer, dimension(:,:) :: mask2d => null() !< Mask for 2d (x-y) axes + real, pointer, dimension(:,:,:) :: mask3d => null() !< Mask for 3d axes +end type diag_dsamp !> A group of 1D axes that comprise a 1D/2D/3D mesh type, public :: axes_grp @@ -117,7 +117,7 @@ module MOM_diag_mediator logical :: needs_interpolating = .false. !< If true, indicates that this axes group is for a sampled !! interface-located field that must be interpolated to !! these axes. Used for rank>2. - integer :: decimation_level = 1 !< If greater than 1, the factor by which this diagnostic/axes/masks be decimated + integer :: downsample_level = 1 !< If greater than 1, the factor by which this diagnostic/axes/masks be downsampled ! For horizontally averaged diagnositcs (applies to 2d and 3d fields only) type(axes_grp), pointer :: xyave_axes => null() !< The associated 1d axes for horizontall area-averaged diagnostics ! ID's for cell_measures @@ -127,7 +127,7 @@ module MOM_diag_mediator ! For masking real, pointer, dimension(:,:) :: mask2d => null() !< Mask for 2d (x-y) axes real, pointer, dimension(:,:,:) :: mask3d => null() !< Mask for 3d axes - type(diag_decim), dimension(2:MAX_DECIM_LEV) :: decim !< Decimation container + type(diag_dsamp), dimension(2:MAX_DSAMP_LEV) :: dsamp !< Downsample container end type axes_grp !> Contains an array to store a diagnostic target grid @@ -172,7 +172,7 @@ module MOM_diag_mediator logical :: in_use !< True if this entry is being used. integer :: fms_diag_id !< Underlying FMS diag_manager id. integer :: fms_xyave_diag_id = -1 !< For a horizontally area-averaged diagnostic. - integer :: decimate_diag_id = -1 !< For a horizontally area-decimated diagnostic. + integer :: downsample_diag_id = -1 !< For a horizontally area-downsampled diagnostic. character(64) :: debug_str = '' !< For FATAL errors and debugging. type(axes_grp), pointer :: axes => null() !< The axis group for this diagnostic type(diag_type), pointer :: next => null() !< Pointer to the next diagnostic @@ -180,10 +180,10 @@ module MOM_diag_mediator logical :: v_extensive = .false. !< True for vertically extensive fields (vertically integrated). !! False for intensive (concentrations). integer :: xyz_method = 0 !< A 3 digit integer encoding the diagnostics cell method - !! It can be used to determine the decimation algorithm + !! It can be used to determine the downsample algorithm end type diag_type -type diagcs_decim +type diagcs_dsamp integer :: isc !< The start i-index of cell centers within the computational domain integer :: iec !< The end i-index of cell centers within the computational domain integer :: jsc !< The start j-index of cell centers within the computational domain @@ -193,7 +193,7 @@ module MOM_diag_mediator integer :: jsd !< The start j-index of cell centers within the data domain integer :: jed !< The end j-index of cell centers within the data domain integer :: isg,ieg,jsg,jeg - + type(axes_grp) :: axesBL, axesTL, axesCuL, axesCvL type(axes_grp) :: axesBi, axesTi, axesCui, axesCvi type(axes_grp) :: axesB1, axesT1, axesCu1, axesCv1 @@ -213,7 +213,7 @@ module MOM_diag_mediator real, dimension(:,:,:), pointer :: mask3dBi => null() real, dimension(:,:,:), pointer :: mask3dCui => null() real, dimension(:,:,:), pointer :: mask3dCvi => null() -end type diagcs_decim +end type diagcs_dsamp !> The following data type a list of diagnostic fields an their variants, !! as well as variables that control the handling of model output. @@ -264,8 +264,8 @@ module MOM_diag_mediator real, dimension(:,:,:), pointer :: mask3dCui => null() real, dimension(:,:,:), pointer :: mask3dCvi => null() - type(diagcs_decim), dimension(2:MAX_DECIM_LEV) :: decim !< Decimation control container - + type(diagcs_dsamp), dimension(2:MAX_DSAMP_LEV) :: dsamp !< Downsample control container + !!@} ! Space for diagnostics is dynamically allocated as it is needed. @@ -365,9 +365,9 @@ subroutine set_axes_info(G, GV, param_file, diag_cs, set_vertical) endif id_zl_native = id_zl ; id_zi_native = id_zi ! Vertical axes for the interfaces and layers - call define_axes_group(diag_cs, (/ id_zi /), diag_cs%axesZi, nz=1, & + call define_axes_group(diag_cs, (/ id_zi /), diag_cs%axesZi, & v_cell_method='point', is_interface=.true.) - call define_axes_group(diag_cs, (/ id_zL /), diag_cs%axesZL, nz=1, & + call define_axes_group(diag_cs, (/ id_zL /), diag_cs%axesZL, & v_cell_method='mean', is_layer=.true.) ! Axis groupings for the model layers @@ -412,7 +412,7 @@ subroutine set_axes_info(G, GV, param_file, diag_cs, set_vertical) call define_axes_group(diag_cs, (/ null_axis_id /), diag_cs%axesNull) - !Non-native Non-decimated + !Non-native Non-downsampled if (diag_cs%num_diag_coords>0) then allocate(diag_cs%remap_axesZL(diag_cs%num_diag_coords)) allocate(diag_cs%remap_axesTL(diag_cs%num_diag_coords)) @@ -498,14 +498,14 @@ subroutine set_axes_info(G, GV, param_file, diag_cs, set_vertical) endif enddo - !Define the decimated axes - call set_axes_info_decim(G, GV, param_file, diag_cs, id_zl_native, id_zi_native) - + !Define the downsampled axes + call set_axes_info_dsamp(G, GV, param_file, diag_cs, id_zl_native, id_zi_native) + call diag_grid_storage_init(diag_CS%diag_grid_temp, G, diag_CS) end subroutine set_axes_info -subroutine set_axes_info_decim(G, GV, param_file, diag_cs, id_zl_native, id_zi_native) +subroutine set_axes_info_dsamp(G, GV, param_file, diag_cs, id_zl_native, id_zi_native) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(param_file_type), intent(in) :: param_file !< Parameter file structure @@ -515,89 +515,87 @@ subroutine set_axes_info_decim(G, GV, param_file, diag_cs, id_zl_native, id_zi_n ! Local variables integer :: id_xq, id_yq, id_zl, id_zi, id_xh, id_yh integer :: i, j, k, nz, dl - real, dimension(:), pointer :: gridLonT_zap =>NULL() - real, dimension(:), pointer :: gridLatT_zap =>NULL() + real, dimension(:), pointer :: gridLonT_dsamp =>NULL() + real, dimension(:), pointer :: gridLatT_dsamp =>NULL() id_zl = id_zl_native ; id_zi = id_zi_native - !Axes group for native decimated diagnostics - do dl=2,MAX_DECIM_LEV - if(dl .ne. 2) call MOM_error(FATAL, "set_axes_info_decim: Decimation level other than 2 is not supported yet!") - allocate(gridLonT_zap(diag_cs%decim(dl)%isg:diag_cs%decim(dl)%ieg)) - allocate(gridLatT_zap(diag_cs%decim(dl)%jsg:diag_cs%decim(dl)%jeg)) + !Axes group for native downsampled diagnostics + do dl=2,MAX_DSAMP_LEV + if(dl .ne. 2) call MOM_error(FATAL, "set_axes_info_dsamp: Downsample level other than 2 is not supported yet!") + allocate(gridLonT_dsamp(diag_cs%dsamp(dl)%isg:diag_cs%dsamp(dl)%ieg)) + allocate(gridLatT_dsamp(diag_cs%dsamp(dl)%jsg:diag_cs%dsamp(dl)%jeg)) - do i=diag_cs%decim(dl)%isg,diag_cs%decim(dl)%ieg; gridLonT_zap(i) = G%gridLonT(G%isg+dl*i-2); enddo - do j=diag_cs%decim(dl)%jsg,diag_cs%decim(dl)%jeg; gridLatT_zap(j) = G%gridLatT(G%jsg+dl*j-2); enddo + do i=diag_cs%dsamp(dl)%isg,diag_cs%dsamp(dl)%ieg; gridLonT_dsamp(i) = G%gridLonT(G%isg+dl*i-2); enddo + do j=diag_cs%dsamp(dl)%jsg,diag_cs%dsamp(dl)%jeg; gridLatT_dsamp(j) = G%gridLatT(G%jsg+dl*j-2); enddo if (G%symmetric) then - call MOM_error(FATAL, "set_axes_info_decim: Decimation of symmetric case is not supported yet!") - ! id_xq = diag_axis_init('xq', gridLonB_zap(G%isgB:G%iegB), G%x_axis_units, 'x', & - ! 'q point nominal longitude', Domain2=G%Domain%mpp_domain_zap2) - ! id_yq = diag_axis_init('yq', gridLatB_zap(G%jsgB:G%jegB), G%y_axis_units, 'y', & - ! 'q point nominal latitude', Domain2=G%Domain%mpp_domain_zap2) + call MOM_error(FATAL, "set_axes_info_dsamp: Downsample of symmetric case is not supported yet!") + ! id_xq = diag_axis_init('xq', gridLonB_dsamp(G%isgB:G%iegB), G%x_axis_units, 'x', & + ! 'q point nominal longitude', Domain2=G%Domain%mpp_domain_d2) + ! id_yq = diag_axis_init('yq', gridLatB_dsamp(G%jsgB:G%jegB), G%y_axis_units, 'y', & + ! 'q point nominal latitude', Domain2=G%Domain%mpp_domain_d2) else - id_xq = diag_axis_init('xq', gridLonT_zap, G%x_axis_units, 'x', & - 'q point nominal longitude', Domain2=G%Domain%mpp_domain_zap2) - id_yq = diag_axis_init('yq', gridLatT_zap, G%y_axis_units, 'y', & - 'q point nominal latitude', Domain2=G%Domain%mpp_domain_zap2) + id_xq = diag_axis_init('xq', gridLonT_dsamp, G%x_axis_units, 'x', & + 'q point nominal longitude', Domain2=G%Domain%mpp_domain_d2) + id_yq = diag_axis_init('yq', gridLatT_dsamp, G%y_axis_units, 'y', & + 'q point nominal latitude', Domain2=G%Domain%mpp_domain_d2) endif - id_xh = diag_axis_init('xh', gridLonT_zap, G%x_axis_units, 'x', & - 'h point nominal longitude', Domain2=G%Domain%mpp_domain_zap2) - id_yh = diag_axis_init('yh', gridLatT_zap, G%y_axis_units, 'y', & - 'h point nominal latitude', Domain2=G%Domain%mpp_domain_zap2) + id_xh = diag_axis_init('xh', gridLonT_dsamp, G%x_axis_units, 'x', & + 'h point nominal longitude', Domain2=G%Domain%mpp_domain_d2) + id_yh = diag_axis_init('yh', gridLatT_dsamp, G%y_axis_units, 'y', & + 'h point nominal latitude', Domain2=G%Domain%mpp_domain_d2) - deallocate(gridLonT_zap) - deallocate(gridLatT_zap) + deallocate(gridLonT_dsamp) + deallocate(gridLatT_dsamp) ! Axis groupings for the model layers - call define_axes_group_decim(diag_cs, (/ id_xh, id_yh, id_zL /), diag_cs%decim(dl)%axesTL, dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yh, id_zL /), diag_cs%dsamp(dl)%axesTL, dl, & x_cell_method='mean', y_cell_method='mean', v_cell_method='mean', & is_h_point=.true., is_layer=.true., xyave_axes=diag_cs%axesZL) - call define_axes_group_decim(diag_cs, (/ id_xq, id_yq, id_zL /), diag_cs%decim(dl)%axesBL, dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yq, id_zL /), diag_cs%dsamp(dl)%axesBL, dl, & x_cell_method='point', y_cell_method='point', v_cell_method='mean', & is_q_point=.true., is_layer=.true.) - call define_axes_group_decim(diag_cs, (/ id_xq, id_yh, id_zL /), diag_cs%decim(dl)%axesCuL, dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yh, id_zL /), diag_cs%dsamp(dl)%axesCuL, dl, & x_cell_method='point', y_cell_method='mean', v_cell_method='mean', & is_u_point=.true., is_layer=.true., xyave_axes=diag_cs%axesZL) - call define_axes_group_decim(diag_cs, (/ id_xh, id_yq, id_zL /), diag_cs%decim(dl)%axesCvL, dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yq, id_zL /), diag_cs%dsamp(dl)%axesCvL, dl, & x_cell_method='mean', y_cell_method='point', v_cell_method='mean', & is_v_point=.true., is_layer=.true., xyave_axes=diag_cs%axesZL) ! Axis groupings for the model interfaces - call define_axes_group_decim(diag_cs, (/ id_xh, id_yh, id_zi /), diag_cs%decim(dl)%axesTi, dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yh, id_zi /), diag_cs%dsamp(dl)%axesTi, dl, & x_cell_method='mean', y_cell_method='mean', v_cell_method='point', & is_h_point=.true., is_interface=.true., xyave_axes=diag_cs%axesZi) - call define_axes_group_decim(diag_cs, (/ id_xq, id_yq, id_zi /), diag_cs%decim(dl)%axesBi, dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yq, id_zi /), diag_cs%dsamp(dl)%axesBi, dl, & x_cell_method='point', y_cell_method='point', v_cell_method='point', & is_q_point=.true., is_interface=.true.) - call define_axes_group_decim(diag_cs, (/ id_xq, id_yh, id_zi /), diag_cs%decim(dl)%axesCui, dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yh, id_zi /), diag_cs%dsamp(dl)%axesCui, dl, & x_cell_method='point', y_cell_method='mean', v_cell_method='point', & is_u_point=.true., is_interface=.true., xyave_axes=diag_cs%axesZi) - call define_axes_group_decim(diag_cs, (/ id_xh, id_yq, id_zi /), diag_cs%decim(dl)%axesCvi, dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yq, id_zi /), diag_cs%dsamp(dl)%axesCvi, dl, & x_cell_method='mean', y_cell_method='point', v_cell_method='point', & is_v_point=.true., is_interface=.true., xyave_axes=diag_cs%axesZi) ! Axis groupings for 2-D arrays - call define_axes_group_decim(diag_cs, (/ id_xh, id_yh /), diag_cs%decim(dl)%axesT1, dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yh /), diag_cs%dsamp(dl)%axesT1, dl, & x_cell_method='mean', y_cell_method='mean', is_h_point=.true.) - call define_axes_group_decim(diag_cs, (/ id_xq, id_yq /), diag_cs%decim(dl)%axesB1, dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yq /), diag_cs%dsamp(dl)%axesB1, dl, & x_cell_method='point', y_cell_method='point', is_q_point=.true.) - call define_axes_group_decim(diag_cs, (/ id_xq, id_yh /), diag_cs%decim(dl)%axesCu1, dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yh /), diag_cs%dsamp(dl)%axesCu1, dl, & x_cell_method='point', y_cell_method='mean', is_u_point=.true.) - call define_axes_group_decim(diag_cs, (/ id_xh, id_yq /), diag_cs%decim(dl)%axesCv1, dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yq /), diag_cs%dsamp(dl)%axesCv1, dl, & x_cell_method='mean', y_cell_method='point', is_v_point=.true.) !Non-native axes if (diag_cs%num_diag_coords>0) then -! allocate(diag_cs%decim(dl)%remap_axesZL(diag_cs%num_diag_coords)) -! allocate(diag_cs%decim(dl)%remap_axesZi(diag_cs%num_diag_coords)) - allocate(diag_cs%decim(dl)%remap_axesTL(diag_cs%num_diag_coords)) - allocate(diag_cs%decim(dl)%remap_axesBL(diag_cs%num_diag_coords)) - allocate(diag_cs%decim(dl)%remap_axesCuL(diag_cs%num_diag_coords)) - allocate(diag_cs%decim(dl)%remap_axesCvL(diag_cs%num_diag_coords)) - allocate(diag_cs%decim(dl)%remap_axesTi(diag_cs%num_diag_coords)) - allocate(diag_cs%decim(dl)%remap_axesBi(diag_cs%num_diag_coords)) - allocate(diag_cs%decim(dl)%remap_axesCui(diag_cs%num_diag_coords)) - allocate(diag_cs%decim(dl)%remap_axesCvi(diag_cs%num_diag_coords)) + allocate(diag_cs%dsamp(dl)%remap_axesTL(diag_cs%num_diag_coords)) + allocate(diag_cs%dsamp(dl)%remap_axesBL(diag_cs%num_diag_coords)) + allocate(diag_cs%dsamp(dl)%remap_axesCuL(diag_cs%num_diag_coords)) + allocate(diag_cs%dsamp(dl)%remap_axesCvL(diag_cs%num_diag_coords)) + allocate(diag_cs%dsamp(dl)%remap_axesTi(diag_cs%num_diag_coords)) + allocate(diag_cs%dsamp(dl)%remap_axesBi(diag_cs%num_diag_coords)) + allocate(diag_cs%dsamp(dl)%remap_axesCui(diag_cs%num_diag_coords)) + allocate(diag_cs%dsamp(dl)%remap_axesCvi(diag_cs%num_diag_coords)) endif do i=1, diag_cs%num_diag_coords @@ -612,13 +610,7 @@ subroutine set_axes_info_decim(G, GV, param_file, diag_cs, id_zl_native, id_zi_n call diag_remap_get_axes_info(diag_cs%diag_remap_cs(i), nz, id_zL, id_zi) ! Axes for z layers - !This should be the same as non-decimated one which should already be set -! call define_axes_group(diag_cs, (/ id_zL /), diag_cs%decim(dl)%remap_axesZL(i), & -! nz=nz, vertical_coordinate_number=i, & -! v_cell_method='mean', & -! is_h_point=.true., is_layer=.true., is_native=.false., needs_remapping=.true.) - - call define_axes_group_decim(diag_cs, (/ id_xh, id_yh, id_zL /), diag_cs%decim(dl)%remap_axesTL(i), dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yh, id_zL /), diag_cs%dsamp(dl)%remap_axesTL(i), dl, & nz=nz, vertical_coordinate_number=i, & x_cell_method='mean', y_cell_method='mean', v_cell_method='mean', & is_h_point=.true., is_layer=.true., is_native=.false., needs_remapping=.true., & @@ -626,47 +618,43 @@ subroutine set_axes_info_decim(G, GV, param_file, diag_cs, id_zl_native, id_zi_n !! \note Remapping for B points is not yet implemented so needs_remapping is not !! provided for remap_axesBL - call define_axes_group_decim(diag_cs, (/ id_xq, id_yq, id_zL /), diag_cs%decim(dl)%remap_axesBL(i), dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yq, id_zL /), diag_cs%dsamp(dl)%remap_axesBL(i), dl, & nz=nz, vertical_coordinate_number=i, & x_cell_method='point', y_cell_method='point', v_cell_method='mean', & is_q_point=.true., is_layer=.true., is_native=.false.) - call define_axes_group_decim(diag_cs, (/ id_xq, id_yh, id_zL /), diag_cs%decim(dl)%remap_axesCuL(i), dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yh, id_zL /), diag_cs%dsamp(dl)%remap_axesCuL(i), dl, & nz=nz, vertical_coordinate_number=i, & x_cell_method='point', y_cell_method='mean', v_cell_method='mean', & is_u_point=.true., is_layer=.true., is_native=.false., needs_remapping=.true., & xyave_axes=diag_cs%remap_axesZL(i)) - call define_axes_group_decim(diag_cs, (/ id_xh, id_yq, id_zL /), diag_cs%decim(dl)%remap_axesCvL(i), dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yq, id_zL /), diag_cs%dsamp(dl)%remap_axesCvL(i), dl, & nz=nz, vertical_coordinate_number=i, & x_cell_method='mean', y_cell_method='point', v_cell_method='mean', & is_v_point=.true., is_layer=.true., is_native=.false., needs_remapping=.true., & xyave_axes=diag_cs%remap_axesZL(i)) ! Axes for z interfaces -! call define_axes_group_decim(diag_cs, (/ id_zi /), diag_cs%decim(dl)%remap_axesZi(i),& -! nz=nz, vertical_coordinate_number=i, & -! v_cell_method='point', & -! is_h_point=.true., is_interface=.true., is_native=.false., needs_interpolating=.true.) - call define_axes_group_decim(diag_cs, (/ id_xh, id_yh, id_zi /), diag_cs%decim(dl)%remap_axesTi(i), dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yh, id_zi /), diag_cs%dsamp(dl)%remap_axesTi(i), dl, & nz=nz, vertical_coordinate_number=i, & x_cell_method='mean', y_cell_method='mean', v_cell_method='point', & is_h_point=.true., is_interface=.true., is_native=.false., needs_interpolating=.true., & xyave_axes=diag_cs%remap_axesZi(i)) !! \note Remapping for B points is not yet implemented so needs_remapping is not provided for remap_axesBi - call define_axes_group_decim(diag_cs, (/ id_xq, id_yq, id_zi /), diag_cs%decim(dl)%remap_axesBi(i), dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yq, id_zi /), diag_cs%dsamp(dl)%remap_axesBi(i), dl, & nz=nz, vertical_coordinate_number=i, & x_cell_method='point', y_cell_method='point', v_cell_method='point', & is_q_point=.true., is_interface=.true., is_native=.false.) - call define_axes_group_decim(diag_cs, (/ id_xq, id_yh, id_zi /), diag_cs%decim(dl)%remap_axesCui(i), dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xq, id_yh, id_zi /), diag_cs%dsamp(dl)%remap_axesCui(i), dl, & nz=nz, vertical_coordinate_number=i, & x_cell_method='point', y_cell_method='mean', v_cell_method='point', & is_u_point=.true., is_interface=.true., is_native=.false., & needs_interpolating=.true., xyave_axes=diag_cs%remap_axesZi(i)) - call define_axes_group_decim(diag_cs, (/ id_xh, id_yq, id_zi /), diag_cs%decim(dl)%remap_axesCvi(i), dl, & + call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yq, id_zi /), diag_cs%dsamp(dl)%remap_axesCvi(i), dl, & nz=nz, vertical_coordinate_number=i, & x_cell_method='mean', y_cell_method='point', v_cell_method='point', & is_v_point=.true., is_interface=.true., is_native=.false., & @@ -674,9 +662,9 @@ subroutine set_axes_info_decim(G, GV, param_file, diag_cs, id_zl_native, id_zi_n endif enddo enddo - -end subroutine set_axes_info_decim - + +end subroutine set_axes_info_dsamp + !> set_masks_for_axes sets up the 2d and 3d masks for diagnostics using the current grid !! recorded after calling diag_update_remap_grids() @@ -774,12 +762,12 @@ subroutine set_masks_for_axes(G, diag_cs) endif enddo - !Allocate and initialize the decimated masks for the axes - call set_masks_for_axes_decim(G, diag_cs) - + !Allocate and initialize the downsampled masks for the axes + call set_masks_for_axes_dsamp(G, diag_cs) + end subroutine set_masks_for_axes -subroutine set_masks_for_axes_decim(G, diag_cs) +subroutine set_masks_for_axes_dsamp(G, diag_cs) type(ocean_grid_type), target, intent(in) :: G !< The ocean grid type. type(diag_ctrl), pointer :: diag_cs !< A pointer to a type with many variables !! used for diagnostics @@ -788,47 +776,47 @@ subroutine set_masks_for_axes_decim(G, diag_cs) integer :: dl type(axes_grp), pointer :: axes => NULL(), h_axes => NULL() ! Current axes, for convenience - !Each decimated axis needs both decimated and non-decimated mask - !The decimated mask is needed for sending out the diagnostics output via diag_manager - !The non-decimated mask is needed for decimating the diagnostics field - do dl=2,MAX_DECIM_LEV - if(dl .ne. 2) call MOM_error(FATAL, "set_masks_for_axes_decim: Decimation level other than 2 is not supported yet!") + !Each downsampled axis needs both downsampled and non-downsampled mask + !The downsampled mask is needed for sending out the diagnostics output via diag_manager + !The non-downsampled mask is needed for downsampling the diagnostics field + do dl=2,MAX_DSAMP_LEV + if(dl .ne. 2) call MOM_error(FATAL, "set_masks_for_axes_dsamp: Downsample level other than 2 is not supported yet!") do c=1, diag_cs%num_diag_coords ! Level/layer h-points in diagnostic coordinate axes => diag_cs%remap_axesTL(c) - call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesTL(c)%decim(dl)%mask3d, dl)!set decimated mask - diag_cs%decim(dl)%remap_axesTL(c)%mask3d => axes%mask3d !set non-decimated mask + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesTL(c)%dsamp(dl)%mask3d, dl)!set downsampled mask + diag_cs%dsamp(dl)%remap_axesTL(c)%mask3d => axes%mask3d !set non-downsampled mask ! Level/layer u-points in diagnostic coordinate axes => diag_cs%remap_axesCuL(c) - call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesCuL(c)%decim(dl)%mask3d, dl)!set decimated mask - diag_cs%decim(dl)%remap_axesCul(c)%mask3d => axes%mask3d !set non-decimated mask + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesCuL(c)%dsamp(dl)%mask3d, dl)!set downsampled mask + diag_cs%dsamp(dl)%remap_axesCul(c)%mask3d => axes%mask3d !set non-downsampled mask ! Level/layer v-points in diagnostic coordinate axes => diag_cs%remap_axesCvL(c) - call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesCvL(c)%decim(dl)%mask3d, dl)!set decimated mask - diag_cs%decim(dl)%remap_axesCvL(c)%mask3d => axes%mask3d !set non-decimated mask + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesCvL(c)%dsamp(dl)%mask3d, dl)!set downsampled mask + diag_cs%dsamp(dl)%remap_axesCvL(c)%mask3d => axes%mask3d !set non-downsampled mask ! Level/layer q-points in diagnostic coordinate axes => diag_cs%remap_axesBL(c) - call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesBL(c)%decim(dl)%mask3d, dl)!set decimated mask - diag_cs%decim(dl)%remap_axesBL(c)%mask3d => axes%mask3d !set non-decimated mask + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesBL(c)%dsamp(dl)%mask3d, dl)!set downsampled mask + diag_cs%dsamp(dl)%remap_axesBL(c)%mask3d => axes%mask3d !set non-downsampled mask ! Interface h-points in diagnostic coordinate (w-point) axes => diag_cs%remap_axesTi(c) - call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesTi(c)%decim(dl)%mask3d, dl)!set decimated mask - diag_cs%decim(dl)%remap_axesTi(c)%mask3d => axes%mask3d !set non-decimated mask + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesTi(c)%dsamp(dl)%mask3d, dl)!set downsampled mask + diag_cs%dsamp(dl)%remap_axesTi(c)%mask3d => axes%mask3d !set non-downsampled mask ! Interface u-points in diagnostic coordinate axes => diag_cs%remap_axesCui(c) - call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesCui(c)%decim(dl)%mask3d, dl)!set decimated mask - diag_cs%decim(dl)%remap_axesCui(c)%mask3d => axes%mask3d !set non-decimated mask + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesCui(c)%dsamp(dl)%mask3d, dl)!set downsampled mask + diag_cs%dsamp(dl)%remap_axesCui(c)%mask3d => axes%mask3d !set non-downsampled mask ! Interface v-points in diagnostic coordinate axes => diag_cs%remap_axesCvi(c) - call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesCvi(c)%decim(dl)%mask3d, dl)!set decimated mask - diag_cs%decim(dl)%remap_axesCvi(c)%mask3d => axes%mask3d !set non-decimated mask + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesCvi(c)%dsamp(dl)%mask3d, dl)!set downsampled mask + diag_cs%dsamp(dl)%remap_axesCvi(c)%mask3d => axes%mask3d !set non-downsampled mask ! Interface q-points in diagnostic coordinate axes => diag_cs%remap_axesBi(c) - call decimate_mask(axes%mask3d, diag_cs%decim(dl)%remap_axesBi(c)%decim(dl)%mask3d, dl)!set decimated mask - diag_cs%decim(dl)%remap_axesBi(c)%mask3d => axes%mask3d !set non-decimated mask + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesBi(c)%dsamp(dl)%mask3d, dl)!set downsampled mask + diag_cs%dsamp(dl)%remap_axesBi(c)%mask3d => axes%mask3d !set non-downsampled mask enddo enddo -end subroutine set_masks_for_axes_decim +end subroutine set_masks_for_axes_dsamp !> Attaches the id of cell areas to axes groups for use with cell_measures subroutine diag_register_area_ids(diag_cs, id_area_t, id_area_q) @@ -1015,8 +1003,8 @@ subroutine define_axes_group(diag_cs, handles, axes, nz, vertical_coordinate_num end subroutine define_axes_group -!> Defines a group of decimated "axes" from list of handles -subroutine define_axes_group_decim(diag_cs, handles, axes, dl, nz, vertical_coordinate_number, & +!> Defines a group of downsampled "axes" from list of handles +subroutine define_axes_group_dsamp(diag_cs, handles, axes, dl, nz, vertical_coordinate_number, & x_cell_method, y_cell_method, v_cell_method, & is_h_point, is_q_point, is_u_point, is_v_point, & is_layer, is_interface, & @@ -1025,7 +1013,7 @@ subroutine define_axes_group_decim(diag_cs, handles, axes, dl, nz, vertical_coor type(diag_ctrl), target, intent(in) :: diag_cs !< Diagnostics control structure integer, dimension(:), intent(in) :: handles !< A list of 1D axis handles type(axes_grp), intent(out) :: axes !< The group of 1D axes - integer, intent(in) :: dl !< Decimation level + integer, intent(in) :: dl !< Downsample level integer, optional, intent(in) :: nz !< Number of layers in this diagnostic grid integer, optional, intent(in) :: vertical_coordinate_number !< Index number for vertical coordinate character(len=*), optional, intent(in) :: x_cell_method !< A x-direction cell method used to construct the @@ -1087,7 +1075,7 @@ subroutine define_axes_group_decim(diag_cs, handles, axes, dl, nz, vertical_coor else axes%v_cell_method = '' endif - axes%decimation_level = dl + axes%downsample_level = dl if (present(nz)) axes%nz = nz if (present(vertical_coordinate_number)) axes%vertical_coordinate_number = vertical_coordinate_number if (present(is_h_point)) axes%is_h_point = is_h_point @@ -1102,7 +1090,7 @@ subroutine define_axes_group_decim(diag_cs, handles, axes, dl, nz, vertical_coor if (present(xyave_axes)) axes%xyave_axes => xyave_axes ! Setup masks for this axes group - + axes%mask2d => null() if (axes%rank==2) then if (axes%is_h_point) axes%mask2d => diag_cs%mask2dT @@ -1127,31 +1115,31 @@ subroutine define_axes_group_decim(diag_cs, handles, axes, dl, nz, vertical_coor endif endif - axes%decim(dl)%mask2d => null() + axes%dsamp(dl)%mask2d => null() if (axes%rank==2) then - if (axes%is_h_point) axes%decim(dl)%mask2d => diag_cs%decim(dl)%mask2dT - if (axes%is_u_point) axes%decim(dl)%mask2d => diag_cs%decim(dl)%mask2dCu - if (axes%is_v_point) axes%decim(dl)%mask2d => diag_cs%decim(dl)%mask2dCv - if (axes%is_q_point) axes%decim(dl)%mask2d => diag_cs%decim(dl)%mask2dBu + if (axes%is_h_point) axes%dsamp(dl)%mask2d => diag_cs%dsamp(dl)%mask2dT + if (axes%is_u_point) axes%dsamp(dl)%mask2d => diag_cs%dsamp(dl)%mask2dCu + if (axes%is_v_point) axes%dsamp(dl)%mask2d => diag_cs%dsamp(dl)%mask2dCv + if (axes%is_q_point) axes%dsamp(dl)%mask2d => diag_cs%dsamp(dl)%mask2dBu endif ! A static 3d mask for non-native coordinates can only be setup when a grid is available - axes%decim(dl)%mask3d => null() + axes%dsamp(dl)%mask3d => null() if (axes%rank==3 .and. axes%is_native) then ! Native variables can/should use the native masks copied into diag_cs if (axes%is_layer) then - if (axes%is_h_point) axes%decim(dl)%mask3d => diag_cs%decim(dl)%mask3dTL - if (axes%is_u_point) axes%decim(dl)%mask3d => diag_cs%decim(dl)%mask3dCuL - if (axes%is_v_point) axes%decim(dl)%mask3d => diag_cs%decim(dl)%mask3dCvL - if (axes%is_q_point) axes%decim(dl)%mask3d => diag_cs%decim(dl)%mask3dBL + if (axes%is_h_point) axes%dsamp(dl)%mask3d => diag_cs%dsamp(dl)%mask3dTL + if (axes%is_u_point) axes%dsamp(dl)%mask3d => diag_cs%dsamp(dl)%mask3dCuL + if (axes%is_v_point) axes%dsamp(dl)%mask3d => diag_cs%dsamp(dl)%mask3dCvL + if (axes%is_q_point) axes%dsamp(dl)%mask3d => diag_cs%dsamp(dl)%mask3dBL elseif (axes%is_interface) then - if (axes%is_h_point) axes%decim(dl)%mask3d => diag_cs%decim(dl)%mask3dTi - if (axes%is_u_point) axes%decim(dl)%mask3d => diag_cs%decim(dl)%mask3dCui - if (axes%is_v_point) axes%decim(dl)%mask3d => diag_cs%decim(dl)%mask3dCvi - if (axes%is_q_point) axes%decim(dl)%mask3d => diag_cs%decim(dl)%mask3dBi + if (axes%is_h_point) axes%dsamp(dl)%mask3d => diag_cs%dsamp(dl)%mask3dTi + if (axes%is_u_point) axes%dsamp(dl)%mask3d => diag_cs%dsamp(dl)%mask3dCui + if (axes%is_v_point) axes%dsamp(dl)%mask3d => diag_cs%dsamp(dl)%mask3dCvi + if (axes%is_q_point) axes%dsamp(dl)%mask3d => diag_cs%dsamp(dl)%mask3dBi endif endif - -end subroutine define_axes_group_decim + +end subroutine define_axes_group_dsamp !> Set up the array extents for doing diagnostics subroutine set_diag_mediator_grid(G, diag_cs) @@ -1285,14 +1273,14 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) real, optional,target, intent(in) :: mask(:,:) !< If present, use this real array as the data mask. ! Local variables - real, dimension(:,:), pointer :: locfield + real, dimension(:,:), pointer :: locfield real, dimension(:,:), pointer :: locmask character(len=300) :: mesg logical :: used, is_stat integer :: cszi, cszj, dszi, dszj integer :: isv, iev, jsv, jev, i, j, chksum - real, dimension(:,:), allocatable, target :: locfield_decim - real, dimension(:,:), allocatable, target :: locmask_decim + real, dimension(:,:), allocatable, target :: locfield_dsamp + real, dimension(:,:), allocatable, target :: locmask_dsamp integer :: dl locfield => NULL() @@ -1353,21 +1341,21 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) if (present(mask)) then locmask => mask elseif(.NOT. is_stat) then - if(associated(diag%axes%mask2d)) locmask => diag%axes%mask2d - endif + if(associated(diag%axes%mask2d)) locmask => diag%axes%mask2d + endif dl=1 - if(.NOT. is_stat) dl = diag%axes%decimation_level !static field decimation i not supported yet - !Decimate the diag field and mask (if present) + if(.NOT. is_stat) dl = diag%axes%downsample_level !static field downsample i not supported yet + !Downsample the diag field and mask (if present) if (dl > 1) then - call decimate_diag_field(locfield, locfield_decim, dl, diag_cs, diag,isv,iev,jsv,jev, mask) + call downsample_diag_field(locfield, locfield_dsamp, dl, diag_cs, diag,isv,iev,jsv,jev, mask) if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) deallocate( locfield ) - locfield => locfield_decim + locfield => locfield_dsamp if (present(mask)) then - call decimate_mask(locmask, locmask_decim, dl) - locmask => locmask_decim - elseif(associated(diag%axes%decim(dl)%mask2d)) then - locmask => diag%axes%decim(dl)%mask2d + call downsample_mask(locmask, locmask_dsamp, dl) + locmask => locmask_dsamp + elseif(associated(diag%axes%dsamp(dl)%mask2d)) then + locmask => diag%axes%dsamp(dl)%mask2d endif endif @@ -1547,8 +1535,8 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) integer :: cszi, cszj, dszi, dszj integer :: isv, iev, jsv, jev, ks, ke, i, j, k, isv_c, jsv_c integer :: chksum - real, dimension(:,:,:), allocatable, target :: locfield_decim - real, dimension(:,:,:), allocatable, target :: locmask_decim + real, dimension(:,:,:), allocatable, target :: locfield_dsamp + real, dimension(:,:,:), allocatable, target :: locmask_dsamp integer :: isl,iel,jsl,jel,dl locfield => NULL() @@ -1626,22 +1614,22 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) if (present(mask)) then locmask => mask elseif(associated(diag%axes%mask3d)) then - locmask => diag%axes%mask3d + locmask => diag%axes%mask3d endif dl=1 - if(.NOT. is_stat) dl = diag%axes%decimation_level !static field decimation i not supported yet - !Decimate the diag field and mask (if present) + if(.NOT. is_stat) dl = diag%axes%downsample_level !static field downsample i not supported yet + !Downsample the diag field and mask (if present) if (dl > 1) then - call decimate_diag_field(locfield, locfield_decim, dl, diag_cs, diag,isv,iev,jsv,jev, mask) + call downsample_diag_field(locfield, locfield_dsamp, dl, diag_cs, diag,isv,iev,jsv,jev, mask) if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) deallocate( locfield ) - locfield => locfield_decim + locfield => locfield_dsamp if (present(mask)) then - call decimate_mask(locmask, locmask_decim, dl) - locmask => locmask_decim - elseif(associated(diag%axes%decim(dl)%mask3d)) then - locmask => diag%axes%decim(dl)%mask3d - endif + call downsample_mask(locmask, locmask_dsamp, dl) + locmask => locmask_dsamp + elseif(associated(diag%axes%dsamp(dl)%mask3d)) then + locmask => diag%axes%dsamp(dl)%mask3d + endif endif if (diag%fms_diag_id>0) then @@ -1837,7 +1825,7 @@ integer function register_diag_field(module_name, field_name, axes_in, init_time diag_cs => axes%diag_cs dm_id = -1 - + if (axes_in%id == diag_cs%axesTL%id) then axes => diag_cs%axesTL elseif (axes_in%id == diag_cs%axesBL%id) then @@ -1915,42 +1903,42 @@ integer function register_diag_field(module_name, field_name, axes_in, init_time endif ! axes%rank == 3 enddo ! i - !Register decimated diagnostics - do dl=2,MAX_DECIM_LEV + !Register downsampled diagnostics + do dl=2,MAX_DSAMP_LEV new_module_name = trim(module_name)//'_d2' if (axes_in%rank == 3 .or. axes_in%rank == 2 ) then axes => null() if (axes_in%id == diag_cs%axesTL%id) then - axes => diag_cs%decim(dl)%axesTL + axes => diag_cs%dsamp(dl)%axesTL elseif (axes_in%id == diag_cs%axesBL%id) then - axes => diag_cs%decim(dl)%axesBL + axes => diag_cs%dsamp(dl)%axesBL elseif (axes_in%id == diag_cs%axesCuL%id ) then - axes => diag_cs%decim(dl)%axesCuL + axes => diag_cs%dsamp(dl)%axesCuL elseif (axes_in%id == diag_cs%axesCvL%id) then - axes => diag_cs%decim(dl)%axesCvL + axes => diag_cs%dsamp(dl)%axesCvL elseif (axes_in%id == diag_cs%axesTi%id) then - axes => diag_cs%decim(dl)%axesTi + axes => diag_cs%dsamp(dl)%axesTi elseif (axes_in%id == diag_cs%axesBi%id) then - axes => diag_cs%decim(dl)%axesBi + axes => diag_cs%dsamp(dl)%axesBi elseif (axes_in%id == diag_cs%axesCui%id ) then - axes => diag_cs%decim(dl)%axesCui + axes => diag_cs%dsamp(dl)%axesCui elseif (axes_in%id == diag_cs%axesCvi%id) then - axes => diag_cs%decim(dl)%axesCvi + axes => diag_cs%dsamp(dl)%axesCvi elseif (axes_in%id == diag_cs%axesT1%id) then - axes => diag_cs%decim(dl)%axesT1 + axes => diag_cs%dsamp(dl)%axesT1 elseif (axes_in%id == diag_cs%axesB1%id) then - axes => diag_cs%decim(dl)%axesB1 + axes => diag_cs%dsamp(dl)%axesB1 elseif (axes_in%id == diag_cs%axesCu1%id ) then - axes => diag_cs%decim(dl)%axesCu1 + axes => diag_cs%dsamp(dl)%axesCu1 elseif (axes_in%id == diag_cs%axesCv1%id) then - axes => diag_cs%decim(dl)%axesCv1 + axes => diag_cs%dsamp(dl)%axesCv1 else !Niki: Should we worry about these, e.g., diag_to_Z_CS? call MOM_error(WARNING,"register_diag_field: Could not find a proper axes for " & //trim( new_module_name)//"-"//trim(field_name)) endif - endif + endif ! Register the native diagnostic if (associated(axes)) then active = register_diag_field_expand_cmor(dm_id, new_module_name, field_name, axes, & @@ -1973,21 +1961,21 @@ integer function register_diag_field(module_name, field_name, axes_in, init_time if (axes_in%rank == 3) then remap_axes => null() if ((axes_in%id == diag_cs%axesTL%id)) then - remap_axes => diag_cs%decim(dl)%remap_axesTL(i) + remap_axes => diag_cs%dsamp(dl)%remap_axesTL(i) elseif (axes_in%id == diag_cs%axesBL%id) then - remap_axes => diag_cs%decim(dl)%remap_axesBL(i) + remap_axes => diag_cs%dsamp(dl)%remap_axesBL(i) elseif (axes_in%id == diag_cs%axesCuL%id ) then - remap_axes => diag_cs%decim(dl)%remap_axesCuL(i) + remap_axes => diag_cs%dsamp(dl)%remap_axesCuL(i) elseif (axes_in%id == diag_cs%axesCvL%id) then - remap_axes => diag_cs%decim(dl)%remap_axesCvL(i) + remap_axes => diag_cs%dsamp(dl)%remap_axesCvL(i) elseif (axes_in%id == diag_cs%axesTi%id) then - remap_axes => diag_cs%decim(dl)%remap_axesTi(i) + remap_axes => diag_cs%dsamp(dl)%remap_axesTi(i) elseif (axes_in%id == diag_cs%axesBi%id) then - remap_axes => diag_cs%decim(dl)%remap_axesBi(i) + remap_axes => diag_cs%dsamp(dl)%remap_axesBi(i) elseif (axes_in%id == diag_cs%axesCui%id ) then - remap_axes => diag_cs%decim(dl)%remap_axesCui(i) + remap_axes => diag_cs%dsamp(dl)%remap_axesCui(i) elseif (axes_in%id == diag_cs%axesCvi%id) then - remap_axes => diag_cs%decim(dl)%remap_axesCvi(i) + remap_axes => diag_cs%dsamp(dl)%remap_axesCvi(i) endif ! When the MOM_diag_to_Z module has been obsoleted we can assume remap_axes will @@ -2326,14 +2314,14 @@ subroutine add_xyz_method(diag, axes, x_cell_method, y_cell_method, v_cell_metho !! (vertically integrated). Default/absent for intensive. integer :: xyz_method character(len=9) :: mstr - + !This is a simple way to encode the cell method information made from 3 strings !(x_cell_method,y_cell_method,v_cell_method) in a 3 digit integer xyz !x_cell_method,y_cell_method,v_cell_method can each be 'point' or 'sum' or 'mean' !We can encode these with setting 0 for 'point', 1 for 'sum, 2 for 'mean' in !the 100s position for x, 10s position for y, 1s position for z !E.g., x:sum,y:point,z:mean is 102 - + xyz_method = 0 mstr = diag%axes%v_cell_method @@ -2344,7 +2332,7 @@ subroutine add_xyz_method(diag, axes, x_cell_method, y_cell_method, v_cell_metho mstr='sum' else mstr='mean' - endif + endif elseif (present(v_cell_method)) then mstr = v_cell_method endif @@ -2353,7 +2341,7 @@ subroutine add_xyz_method(diag, axes, x_cell_method, y_cell_method, v_cell_metho elseif (trim(mstr)=='mean') then xyz_method = xyz_method + 2 endif - + mstr = diag%axes%y_cell_method if (present(y_cell_method)) mstr = y_cell_method if (trim(mstr)=='sum') then @@ -2361,7 +2349,7 @@ subroutine add_xyz_method(diag, axes, x_cell_method, y_cell_method, v_cell_metho elseif (trim(mstr)=='mean') then xyz_method = xyz_method + 20 endif - + mstr = diag%axes%x_cell_method if (present(x_cell_method)) mstr = x_cell_method if (trim(mstr)=='sum') then @@ -2935,14 +2923,14 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir) diag_cs%isd = G%isd ; diag_cs%ied = G%ied diag_cs%jsd = G%jsd ; diag_cs%jed = G%jed - !Decimation indices for dl=2 (should be generalized to arbitrary dl, perhaps via a G array) - diag_cs%decim(2)%isc = G%isc_zap2 - (G%isd_zap2-1) ; diag_cs%decim(2)%iec = G%iec_zap2 - (G%isd_zap2-1) - diag_cs%decim(2)%jsc = G%jsc_zap2 - (G%jsd_zap2-1) ; diag_cs%decim(2)%jec = G%jec_zap2 - (G%jsd_zap2-1) - diag_cs%decim(2)%isd = G%isd_zap2 ; diag_cs%decim(2)%ied = G%ied_zap2 - diag_cs%decim(2)%jsd = G%jsd_zap2 ; diag_cs%decim(2)%jed = G%jed_zap2 - diag_cs%decim(2)%isg = G%isg_zap2 ; diag_cs%decim(2)%ieg = G%ieg_zap2 - diag_cs%decim(2)%jsg = G%jsg_zap2 ; diag_cs%decim(2)%jeg = G%jeg_zap2 - + !Downsample indices for dl=2 (should be generalized to arbitrary dl, perhaps via a G array) + diag_cs%dsamp(2)%isc = G%HId2%isc - (G%HId2%isd-1) ; diag_cs%dsamp(2)%iec = G%HId2%iec - (G%HId2%isd-1) + diag_cs%dsamp(2)%jsc = G%HId2%jsc - (G%HId2%jsd-1) ; diag_cs%dsamp(2)%jec = G%HId2%jec - (G%HId2%jsd-1) + diag_cs%dsamp(2)%isd = G%HId2%isd ; diag_cs%dsamp(2)%ied = G%HId2%ied + diag_cs%dsamp(2)%jsd = G%HId2%jsd ; diag_cs%dsamp(2)%jed = G%HId2%jed + diag_cs%dsamp(2)%isg = G%HId2%isg ; diag_cs%dsamp(2)%ieg = G%HId2%ieg + diag_cs%dsamp(2)%jsg = G%HId2%jsg ; diag_cs%dsamp(2)%jeg = G%HId2%jeg + ! Initialze available diagnostic log file if (is_root_pe() .and. (diag_CS%available_diag_doc_unit < 0)) then write(this_pe,'(i6.6)') PE_here() @@ -3133,8 +3121,8 @@ subroutine diag_masks_set(G, nz, diag_cs) diag_cs%mask3dCvi(:,:,k) = diag_cs%mask2dCv(:,:) enddo - !Allocate and initialize the decimated masks - call decimate_diag_masks_set(G, nz, diag_cs) + !Allocate and initialize the downsampled masks + call downsample_diag_masks_set(G, nz, diag_cs) end subroutine diag_masks_set @@ -3183,19 +3171,19 @@ subroutine diag_mediator_end(time, diag_CS, end_diag_manager) deallocate(diag_cs%mask3dBi) deallocate(diag_cs%mask3dCui) deallocate(diag_cs%mask3dCvi) - do i=2,MAX_DECIM_LEV - deallocate(diag_cs%decim(i)%mask2dT) - deallocate(diag_cs%decim(i)%mask2dBu) - deallocate(diag_cs%decim(i)%mask2dCu) - deallocate(diag_cs%decim(i)%mask2dCv) - deallocate(diag_cs%decim(i)%mask3dTL) - deallocate(diag_cs%decim(i)%mask3dBL) - deallocate(diag_cs%decim(i)%mask3dCuL) - deallocate(diag_cs%decim(i)%mask3dCvL) - deallocate(diag_cs%decim(i)%mask3dTi) - deallocate(diag_cs%decim(i)%mask3dBi) - deallocate(diag_cs%decim(i)%mask3dCui) - deallocate(diag_cs%decim(i)%mask3dCvi) + do i=2,MAX_DSAMP_LEV + deallocate(diag_cs%dsamp(i)%mask2dT) + deallocate(diag_cs%dsamp(i)%mask2dBu) + deallocate(diag_cs%dsamp(i)%mask2dCu) + deallocate(diag_cs%dsamp(i)%mask2dCv) + deallocate(diag_cs%dsamp(i)%mask3dTL) + deallocate(diag_cs%dsamp(i)%mask3dBL) + deallocate(diag_cs%dsamp(i)%mask3dCuL) + deallocate(diag_cs%dsamp(i)%mask3dCvL) + deallocate(diag_cs%dsamp(i)%mask3dTi) + deallocate(diag_cs%dsamp(i)%mask3dBi) + deallocate(diag_cs%dsamp(i)%mask3dCui) + deallocate(diag_cs%dsamp(i)%mask3dCvi) enddo #if defined(DEBUG) || defined(__DO_SAFETY_CHECKS__) @@ -3453,9 +3441,9 @@ subroutine diag_grid_storage_end(grid_storage) deallocate(grid_storage%diag_grids) end subroutine diag_grid_storage_end -!< Allocate and initialize the masks for decimated diagostics in diag_cs -!! The decimated masks in the axes would later "point" to these. -subroutine decimate_diag_masks_set(G, nz, diag_cs) +!< Allocate and initialize the masks for downsampled diagostics in diag_cs +!! The downsampled masks in the axes would later "point" to these. +subroutine downsample_diag_masks_set(G, nz, diag_cs) type(ocean_grid_type), target, intent(in) :: G !< The ocean grid type. integer, intent(in) :: nz !< The number of layers in the model's native grid. type(diag_ctrl), pointer :: diag_cs !< A pointer to a type with many variables @@ -3464,50 +3452,50 @@ subroutine decimate_diag_masks_set(G, nz, diag_cs) integer :: i,j,k,ii,jj,dl !print*,'original c extents ',G%isc,G%iec,G%jsc,G%jec -!print*,'coarse c extents ',G%isc_zap2,G%iec_zap2,G%jsc_zap2,G%jec_zap2 +!print*,'coarse c extents ',G%HId2%isc,G%HId2%iec,G%HId2%jsc,G%HId2%jec !print*,'original d extents ',G%isd,G%ied,G%jsd,G%jed -!print*,'coarse d extents ',G%isd_zap2,G%ied_zap2,G%jsd_zap2,G%jed_zap2 +!print*,'coarse d extents ',G%HId2%isd,G%HId2%ied,G%HId2%jsd,G%HId2%jed ! original c extents 5 52 5 52 ! coarse c extents 3 26 3 26 ! original d extents 1 56 1 56 ! coarse d extents 1 28 1 28 - - do dl=2,MAX_DECIM_LEV + + do dl=2,MAX_DSAMP_LEV ! 2d masks - call decimate_mask(G%mask2dT, diag_cs%decim(dl)%mask2dT, dl) - call decimate_mask(G%mask2dBu,diag_cs%decim(dl)%mask2dBu, dl) - call decimate_mask(G%mask2dCu,diag_cs%decim(dl)%mask2dCu, dl) - call decimate_mask(G%mask2dCv,diag_cs%decim(dl)%mask2dCv, dl) + call downsample_mask(G%mask2dT, diag_cs%dsamp(dl)%mask2dT, dl) + call downsample_mask(G%mask2dBu,diag_cs%dsamp(dl)%mask2dBu, dl) + call downsample_mask(G%mask2dCu,diag_cs%dsamp(dl)%mask2dCu, dl) + call downsample_mask(G%mask2dCv,diag_cs%dsamp(dl)%mask2dCv, dl) ! 3d native masks are needed by diag_manager but the native variables ! can only be masked 2d - for ocean points, all layers exists. - allocate(diag_cs%decim(dl)%mask3dTL(G%isd_zap2:G%ied_zap2,G%jsd_zap2:G%jed_zap2,1:nz)) - allocate(diag_cs%decim(dl)%mask3dBL(G%IsdB_zap2:G%IedB_zap2,G%JsdB_zap2:G%JedB_zap2,1:nz)) - allocate(diag_cs%decim(dl)%mask3dCuL(G%IsdB_zap2:G%IedB_zap2,G%jsd_zap2:G%jed_zap2,1:nz)) - allocate(diag_cs%decim(dl)%mask3dCvL(G%isd_zap2:G%ied_zap2,G%JsdB_zap2:G%JedB_zap2,1:nz)) + allocate(diag_cs%dsamp(dl)%mask3dTL(G%HId2%isd:G%HId2%ied,G%HId2%jsd:G%HId2%jed,1:nz)) + allocate(diag_cs%dsamp(dl)%mask3dBL(G%HId2%IsdB:G%HId2%IedB,G%HId2%JsdB:G%HId2%JedB,1:nz)) + allocate(diag_cs%dsamp(dl)%mask3dCuL(G%HId2%IsdB:G%HId2%IedB,G%HId2%jsd:G%HId2%jed,1:nz)) + allocate(diag_cs%dsamp(dl)%mask3dCvL(G%HId2%isd:G%HId2%ied,G%HId2%JsdB:G%HId2%JedB,1:nz)) do k=1,nz - diag_cs%decim(dl)%mask3dTL(:,:,k) = diag_cs%decim(dl)%mask2dT(:,:) - diag_cs%decim(dl)%mask3dBL(:,:,k) = diag_cs%decim(dl)%mask2dBu(:,:) - diag_cs%decim(dl)%mask3dCuL(:,:,k) = diag_cs%decim(dl)%mask2dCu(:,:) - diag_cs%decim(dl)%mask3dCvL(:,:,k) = diag_cs%decim(dl)%mask2dCv(:,:) + diag_cs%dsamp(dl)%mask3dTL(:,:,k) = diag_cs%dsamp(dl)%mask2dT(:,:) + diag_cs%dsamp(dl)%mask3dBL(:,:,k) = diag_cs%dsamp(dl)%mask2dBu(:,:) + diag_cs%dsamp(dl)%mask3dCuL(:,:,k) = diag_cs%dsamp(dl)%mask2dCu(:,:) + diag_cs%dsamp(dl)%mask3dCvL(:,:,k) = diag_cs%dsamp(dl)%mask2dCv(:,:) enddo - allocate(diag_cs%decim(dl)%mask3dTi(G%isd_zap2:G%ied_zap2,G%jsd_zap2:G%jed_zap2,1:nz+1)) - allocate(diag_cs%decim(dl)%mask3dBi(G%IsdB_zap2:G%IedB_zap2,G%JsdB_zap2:G%JedB_zap2,1:nz+1)) - allocate(diag_cs%decim(dl)%mask3dCui(G%IsdB_zap2:G%IedB_zap2,G%jsd_zap2:G%jed_zap2,1:nz+1)) - allocate(diag_cs%decim(dl)%mask3dCvi(G%isd_zap2:G%ied_zap2,G%JsdB_zap2:G%JedB_zap2,1:nz+1)) + allocate(diag_cs%dsamp(dl)%mask3dTi(G%HId2%isd:G%HId2%ied,G%HId2%jsd:G%HId2%jed,1:nz+1)) + allocate(diag_cs%dsamp(dl)%mask3dBi(G%HId2%IsdB:G%HId2%IedB,G%HId2%JsdB:G%HId2%JedB,1:nz+1)) + allocate(diag_cs%dsamp(dl)%mask3dCui(G%HId2%IsdB:G%HId2%IedB,G%HId2%jsd:G%HId2%jed,1:nz+1)) + allocate(diag_cs%dsamp(dl)%mask3dCvi(G%HId2%isd:G%HId2%ied,G%HId2%JsdB:G%HId2%JedB,1:nz+1)) do k=1,nz+1 - diag_cs%decim(dl)%mask3dTi(:,:,k) = diag_cs%decim(dl)%mask2dT(:,:) - diag_cs%decim(dl)%mask3dBi(:,:,k) = diag_cs%decim(dl)%mask2dBu(:,:) - diag_cs%decim(dl)%mask3dCui(:,:,k) = diag_cs%decim(dl)%mask2dCu(:,:) - diag_cs%decim(dl)%mask3dCvi(:,:,k) = diag_cs%decim(dl)%mask2dCv(:,:) + diag_cs%dsamp(dl)%mask3dTi(:,:,k) = diag_cs%dsamp(dl)%mask2dT(:,:) + diag_cs%dsamp(dl)%mask3dBi(:,:,k) = diag_cs%dsamp(dl)%mask2dBu(:,:) + diag_cs%dsamp(dl)%mask3dCui(:,:,k) = diag_cs%dsamp(dl)%mask2dCu(:,:) + diag_cs%dsamp(dl)%mask3dCvi(:,:,k) = diag_cs%dsamp(dl)%mask2dCv(:,:) enddo enddo -end subroutine decimate_diag_masks_set +end subroutine downsample_diag_masks_set -!> Get the diagnostics-compute indices (to be passed to send_data) based on the shape of -!! the diag field (the same way they are deduced for non-decimated fields) -subroutine decimate_diag_indices_get(f1,f2, dl, diag_cs,isv,iev,jsv,jev) +!> Get the diagnostics-compute indices (to be passed to send_data) based on the shape of +!! the diag field (the same way they are deduced for non-downsampled fields) +subroutine downsample_diag_indices_get(f1,f2, dl, diag_cs,isv,iev,jsv,jev) integer, intent(in) :: f1,f2 !< the sizes of the diag field in x and y - integer, intent(in) :: dl !< integer decimation level + integer, intent(in) :: dl !< integer downsample level type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output integer, intent(out) ::isv,iev,jsv,jev !< diagnostics-compute indices (to be passed to send_data) ! Local variables @@ -3515,71 +3503,71 @@ subroutine decimate_diag_indices_get(f1,f2, dl, diag_cs,isv,iev,jsv,jev) character(len=500) :: mesg logical, save :: first_check = .true. - !Check ONCE that the decimated diag-compute domain is commensurate with the original non-decimated diag-compute domain - !This is a major limitation of the current implementation of the decimated diagnostics. - !We assume that the compute domain can be subdivided to dl*dl cells, hence avoiding the need of halo updates. - !We want this check to error out only if there was a decimated diagnostics requested and about to post that is + !Check ONCE that the downsampled diag-compute domain is commensurate with the original non-downsampled diag-compute domain + !This is a major limitation of the current implementation of the downsampled diagnostics. + !We assume that the compute domain can be subdivided to dl*dl cells, hence avoiding the need of halo updates. + !We want this check to error out only if there was a downsampled diagnostics requested and about to post that is !why the check is here and not in the init routines. This check need to be done only once, hence the outer if statement if(first_check) then if(mod(diag_cs%ie-diag_cs%is+1, dl) .ne. 0 .OR. mod(diag_cs%je-diag_cs%js+1, dl) .ne. 0) then - write (mesg,*) "Non-commensurate decimated domain is not supported. "//& + write (mesg,*) "Non-commensurate downsampled domain is not supported. "//& "Please choose a layout such that NIGLOBAL/Layout_X and NJGLOBAL/Layout_Y are both divisible by dl=",dl, " Current domain extents: ",& diag_cs%is,diag_cs%ie, diag_cs%js,diag_cs%je - call MOM_error(FATAL,"decimate_diag_indices_get: "//trim(mesg)) + call MOM_error(FATAL,"downsample_diag_indices_get: "//trim(mesg)) endif first_check = .false. endif - - cszi = diag_cs%decim(dl)%iec-diag_cs%decim(dl)%isc +1 ; dszi = diag_cs%decim(dl)%ied-diag_cs%decim(dl)%isd +1 - cszj = diag_cs%decim(dl)%jec-diag_cs%decim(dl)%jsc +1 ; dszj = diag_cs%decim(dl)%jed-diag_cs%decim(dl)%jsd +1 - isv = diag_cs%decim(dl)%isc ; iev = diag_cs%decim(dl)%iec - jsv = diag_cs%decim(dl)%jsc ; jev = diag_cs%decim(dl)%jec + cszi = diag_cs%dsamp(dl)%iec-diag_cs%dsamp(dl)%isc +1 ; dszi = diag_cs%dsamp(dl)%ied-diag_cs%dsamp(dl)%isd +1 + cszj = diag_cs%dsamp(dl)%jec-diag_cs%dsamp(dl)%jsc +1 ; dszj = diag_cs%dsamp(dl)%jed-diag_cs%dsamp(dl)%jsd +1 + + isv = diag_cs%dsamp(dl)%isc ; iev = diag_cs%dsamp(dl)%iec + jsv = diag_cs%dsamp(dl)%jsc ; jev = diag_cs%dsamp(dl)%jec if ( f1 == dszi ) then - isv = diag_cs%decim(dl)%isc ; iev = diag_cs%decim(dl)%iec ! field on Data domain, take compute domain indcies - !The rest is not taken with the full MOM6 diag_table + isv = diag_cs%dsamp(dl)%isc ; iev = diag_cs%dsamp(dl)%iec ! field on Data domain, take compute domain indcies + !The rest is not taken with the full MOM6 diag_table elseif ( f1 == dszi + 1 ) then - isv = diag_cs%decim(dl)%isc ; iev = diag_cs%decim(dl)%iec+1 ! Symmetric data domain + isv = diag_cs%dsamp(dl)%isc ; iev = diag_cs%dsamp(dl)%iec+1 ! Symmetric data domain elseif ( f1 == cszi) then - isv = 1 ; iev = (diag_cs%decim(dl)%iec-diag_cs%decim(dl)%isc) +1 ! Computational domain + isv = 1 ; iev = (diag_cs%dsamp(dl)%iec-diag_cs%dsamp(dl)%isc) +1 ! Computational domain elseif ( f1 == cszi + 1 ) then - isv = 1 ; iev = (diag_cs%decim(dl)%iec-diag_cs%decim(dl)%isc) +2 ! Symmetric computational domain + isv = 1 ; iev = (diag_cs%dsamp(dl)%iec-diag_cs%dsamp(dl)%isc) +2 ! Symmetric computational domain else write (mesg,*) " peculiar size ",f1," in i-direction\n"//& "does not match one of ", cszi, cszi+1, dszi, dszi+1 - call MOM_error(FATAL,"decimate_diag_indices_get: "//trim(mesg)) + call MOM_error(FATAL,"downsample_diag_indices_get: "//trim(mesg)) endif if ( f2 == dszj ) then - jsv = diag_cs%decim(dl)%jsc ; jev = diag_cs%decim(dl)%jec ! Data domain + jsv = diag_cs%dsamp(dl)%jsc ; jev = diag_cs%dsamp(dl)%jec ! Data domain elseif ( f2 == dszj + 1 ) then - jsv = diag_cs%decim(dl)%jsc ; jev = diag_cs%decim(dl)%jec+1 ! Symmetric data domain + jsv = diag_cs%dsamp(dl)%jsc ; jev = diag_cs%dsamp(dl)%jec+1 ! Symmetric data domain elseif ( f2 == cszj) then - jsv = 1 ; jev = (diag_cs%decim(dl)%jec-diag_cs%decim(dl)%jsc) +1 ! Computational domain + jsv = 1 ; jev = (diag_cs%dsamp(dl)%jec-diag_cs%dsamp(dl)%jsc) +1 ! Computational domain elseif ( f2 == cszj + 1 ) then - jsv = 1 ; jev = (diag_cs%decim(dl)%jec-diag_cs%decim(dl)%jsc) +2 ! Symmetric computational domain + jsv = 1 ; jev = (diag_cs%dsamp(dl)%jec-diag_cs%dsamp(dl)%jsc) +2 ! Symmetric computational domain else write (mesg,*) " peculiar size ",f2," in j-direction\n"//& "does not match one of ", cszj, cszj+1, dszj, dszj+1 - call MOM_error(FATAL,"decimate_diag_indices_get: "//trim(mesg)) + call MOM_error(FATAL,"downsample_diag_indices_get: "//trim(mesg)) endif -end subroutine decimate_diag_indices_get +end subroutine downsample_diag_indices_get -!> This subroutine allocates and computes a decimated array from an input array -!! It also determines the diagnostics-compurte indices for the decimated array -!! 3d interface -subroutine decimate_diag_field_3d(locfield, locfield_decim, dl, diag_cs, diag,isv,iev,jsv,jev, mask) +!> This subroutine allocates and computes a downsampled array from an input array +!! It also determines the diagnostics-compurte indices for the downsampled array +!! 3d interface +subroutine downsample_diag_field_3d(locfield, locfield_dsamp, dl, diag_cs, diag,isv,iev,jsv,jev, mask) real, dimension(:,:,:), pointer :: locfield !< input array pointer - real, dimension(:,:,:), allocatable, intent(inout) :: locfield_decim !< output (decimated) array + real, dimension(:,:,:), allocatable, intent(inout) :: locfield_dsamp !< output (downsampled) array type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post - integer, intent(in) :: dl !< integer decimation level + integer, intent(in) :: dl !< integer downsample level integer, intent(inout):: isv,iev,jsv,jev !< diagnostics-compute indices (to be passed to send_data) real, optional,target, intent(in) :: mask(:,:,:) !< If present, use this real array as the data mask. !locals - real, dimension(:,:,:), pointer :: locmask + real, dimension(:,:,:), pointer :: locmask integer :: f1,f2,isv_o,jsv_o - + locmask => NULL() !Get the correct indices corresponding to input field !Shape of the input diag field @@ -3587,37 +3575,37 @@ subroutine decimate_diag_field_3d(locfield, locfield_decim, dl, diag_cs, diag,is f2=size(locfield,2)/dl !Save the extents of the original (fine) domain isv_o=isv;jsv_o=jsv - !Get the shape of the decimated field and overwrite isv,iev,jsv,jev with them - call decimate_diag_indices_get(f1,f2, dl, diag_cs,isv,iev,jsv,jev) - !Set the non-decimated mask, it must be associated and initialized + !Get the shape of the downsampled field and overwrite isv,iev,jsv,jev with them + call downsample_diag_indices_get(f1,f2, dl, diag_cs,isv,iev,jsv,jev) + !Set the non-downsampled mask, it must be associated and initialized if (present(mask)) then locmask => mask elseif (associated(diag%axes%mask3d)) then locmask => diag%axes%mask3d else - call MOM_error(FATAL, "decimate_diag_field_3d: Cannot decimate without a mask!!! ") + call MOM_error(FATAL, "downsample_diag_field_3d: Cannot downsample without a mask!!! ") endif - - call decimate_field(locfield, locfield_decim, dl, diag%xyz_method, locmask, diag_cs, diag, & + + call downsample_field(locfield, locfield_dsamp, dl, diag%xyz_method, locmask, diag_cs, diag, & isv_o,jsv_o,isv,iev,jsv,jev) - -end subroutine decimate_diag_field_3d -!> This subroutine allocates and computes a decimated array from an input array -!! It also determines the diagnostics-compurte indices for the decimated array -!! 2d interface -subroutine decimate_diag_field_2d(locfield, locfield_decim, dl, diag_cs, diag,isv,iev,jsv,jev, mask) +end subroutine downsample_diag_field_3d + +!> This subroutine allocates and computes a downsampled array from an input array +!! It also determines the diagnostics-compurte indices for the downsampled array +!! 2d interface +subroutine downsample_diag_field_2d(locfield, locfield_dsamp, dl, diag_cs, diag,isv,iev,jsv,jev, mask) real, dimension(:,:), pointer :: locfield !< input array pointer - real, dimension(:,:), allocatable, intent(inout) :: locfield_decim !< output (decimated) array + real, dimension(:,:), allocatable, intent(inout) :: locfield_dsamp !< output (downsampled) array type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post - integer, intent(in) :: dl !< integer decimation level + integer, intent(in) :: dl !< integer downsample level integer, intent(out):: isv,iev,jsv,jev !< diagnostics-compute indices (to be passed to send_data) real, optional,target, intent(in) :: mask(:,:) !< If present, use this real array as the data mask. !locals - real, dimension(:,:), pointer :: locmask + real, dimension(:,:), pointer :: locmask integer :: f1,f2,isv_o,jsv_o - + locmask => NULL() !Get the correct indices corresponding to input field !Shape of the input diag field @@ -3625,56 +3613,56 @@ subroutine decimate_diag_field_2d(locfield, locfield_decim, dl, diag_cs, diag,is f2=size(locfield,2)/dl !Save the extents of the original (fine) domain isv_o=isv;jsv_o=jsv - !Get the shape of the decimated field and overwrite isv,iev,jsv,jev with them - call decimate_diag_indices_get(f1,f2, dl, diag_cs,isv,iev,jsv,jev) - !Set the non-decimated mask, it must be associated and initialized + !Get the shape of the downsampled field and overwrite isv,iev,jsv,jev with them + call downsample_diag_indices_get(f1,f2, dl, diag_cs,isv,iev,jsv,jev) + !Set the non-downsampled mask, it must be associated and initialized if (present(mask)) then locmask => mask elseif (associated(diag%axes%mask2d)) then locmask => diag%axes%mask2d else - call MOM_error(FATAL, "decimate_diag_field_2d: Cannot decimate without a mask!!! ") + call MOM_error(FATAL, "downsample_diag_field_2d: Cannot downsample without a mask!!! ") endif - - call decimate_field(locfield, locfield_decim, dl, diag%xyz_method, locmask, diag_cs,diag, & + + call downsample_field(locfield, locfield_dsamp, dl, diag%xyz_method, locmask, diag_cs,diag, & isv_o,jsv_o,isv,iev,jsv,jev) - -end subroutine decimate_diag_field_2d -!> The decimation algorithm -!! The decimation method could be deduced (before send_data call) +end subroutine downsample_diag_field_2d + +!> The downsample algorithm +!! The downsample method could be deduced (before send_data call) !! from the diag%x_cell_method, diag%y_cell_method and diag%v_cell_method -!! -!! This is the summary of the decimation algoritm for a diagnostic field f: +!! +!! This is the summary of the downsample algoritm for a diagnostic field f: !! f(Id,Jd) = \sum_{i,j} f(Id+i,Jd+j) * weight(Id+i,Jd+j) / [ \sum_{i,j} weight(Id+i,Jd+j)] -!! i and j run from 0 to dl-1 (dl being the decimation level) -!! Id,Jd are the decimated (coarse grid) indices run over the coarsened compute grid, +!! i and j run from 0 to dl-1 (dl being the downsample level) +!! Id,Jd are the downsampled (coarse grid) indices run over the coarsened compute grid, !! if and jf are the original (fine grid) indices !! -!!example x_cell y_cell v_cell algorithm_id impemented weight(if,jf) +!!example x_cell y_cell v_cell algorithm_id impemented weight(if,jf) !!--------------------------------------------------------------------------------------- -!!theta mean mean mean MMM =222 G%areaT(if,jf)*h(if,jf) -!!u point mean mean PMM =022 dyCu(if,jf)*h(if,jf)*delta(if,Id) -!!? point sum mean PSM =012 dyCu(if,jf)*h(if,jf)*delta(if,Id) right? -!!v mean point mean MPM =202 dxCv(if,jf)*h(if,jf)*delta(jf,Jd) -!!volcello sum sum sum SSS =111 1 -!!T_dfxy_co sum sum point SSP =110 1 right? T_dfxy_cont_tendency_2d -!!umo point sum sum PSS =011 1*delta(if,Id) -!!vmo sum point sum SPS =101 1*delta(jf,Jd) -!!umo_2d point sum point PSP =010 1*delta(if,Id) right? -!!vmo_2d sum point point SPP =100 1*delta(jf,Jd) right? -!!? point mean point PMP =020 dyCu(if,jf)*delta(if,Id) right? -!!? mean point point MPP =200 dxCv(if,jf)*delta(jf,Jd) right? -!!w mean mean point MMP =220 G%areaT(if,jf) -!!h*theta mean mean sum MMS =221 G%areaT(if,jf) right? +!!theta mean mean mean MMM =222 G%areaT(if,jf)*h(if,jf) +!!u point mean mean PMM =022 dyCu(if,jf)*h(if,jf)*delta(if,Id) +!!v mean point mean MPM =202 dxCv(if,jf)*h(if,jf)*delta(jf,Jd) +!!? point sum mean PSM =012 h(if,jf)*delta(if,Id) +!!volcello sum sum sum SSS =111 1 +!!T_dfxy_co sum sum point SSP =110 1 +!!umo point sum sum PSS =011 1*delta(if,Id) +!!vmo sum point sum SPS =101 1*delta(jf,Jd) +!!umo_2d point sum point PSP =010 1*delta(if,Id) +!!vmo_2d sum point point SPP =100 1*delta(jf,Jd) +!!? point mean point PMP =020 dyCu(if,jf)*delta(if,Id) +!!? mean point point MPP =200 dxCv(if,jf)*delta(jf,Jd) +!!w mean mean point MMP =220 G%areaT(if,jf) +!!h*theta mean mean sum MMS =221 G%areaT(if,jf) !! !!delta is the Kroneker delta -!> This subroutine allocates and computes a decimated array given an input array -!! The decimation method is based on the "cell_methods" for the diagnostics as explained +!> This subroutine allocates and computes a downsampled array given an input array +!! The downsample method is based on the "cell_methods" for the diagnostics as explained !! in the above table -!! 3d interface -subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs, diag,isv_o,jsv_o,isv_d,iev_d,jsv_d,jev_d) +!! 3d interface +subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, diag,isv_o,jsv_o,isv_d,iev_d,jsv_d,jev_d) real, dimension(:,:,:) , pointer :: field_in real, dimension(:,:,:) , allocatable :: field_out integer , intent(in) :: dl @@ -3683,7 +3671,7 @@ subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs, dia type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post integer , intent(in) :: isv_o,jsv_o !< original indices, In practice isv_o=jsv_o=1 - integer , intent(in) :: isv_d,iev_d,jsv_d,jev_d !< decimaed indices + integer , intent(in) :: isv_d,iev_d,jsv_d,jev_d !< dsampaed indices !locals character(len=240) :: mesg integer :: i,j,ii,jj,i0,j0 @@ -3692,10 +3680,10 @@ subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs, dia real :: epsilon = 1.0e-20 ks=1 ; ke =size(field_in,3) - !Allocate the decimated field on the decimated data domain - allocate(field_out(diag_cs%decim(dl)%isd:diag_cs%decim(dl)%ied,diag_cs%decim(dl)%jsd:diag_cs%decim(dl)%jed,ks:ke)) + !Allocate the downsampled field on the downsampled data domain + allocate(field_out(diag_cs%dsamp(dl)%isd:diag_cs%dsamp(dl)%ied,diag_cs%dsamp(dl)%jsd:diag_cs%dsamp(dl)%jed,ks:ke)) ! allocate(field_out(1:size(field_in,1)/dl,1:size(field_in,2)/dl,ks:ke)) - !Fill the decimated field on the decimated diagnostics (almost always compuate) domain + !Fill the downsampled field on the downsampled diagnostics (almost always compuate) domain if(method .eq. MMM) then !xyz_method = MMM = 222 do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d i0 = isv_o+dl*(i-isv_d) @@ -3717,7 +3705,7 @@ subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs, dia ave = 0.0 total_weight = 0.0 do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 -! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 +! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 weight = mask(ii,jj,k) total_weight = total_weight + weight ave=ave+field_in(ii,jj,k)*weight @@ -3731,7 +3719,7 @@ subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs, dia ave = 0.0 total_weight = 0.0 do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 -! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 +! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 weight = mask(ii,jj,k)*diag_cs%G%areaT(ii,jj) total_weight = total_weight + weight ave=ave+field_in(ii,jj,k)*weight @@ -3746,8 +3734,8 @@ subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs, dia total_weight = 0.0 ii=i0 do jj=j0,j0+dl-1 - weight =mask(ii,jj,k)*diag_cs%G%dyCu(ii,jj)*diag_cs%h(ii,jj,k) - total_weight = total_weight +weight + weight =mask(ii,jj,k)*diag_cs%G%dyCu(ii,jj)*diag_cs%h(ii,jj,k) + total_weight = total_weight +weight ave=ave+field_in(ii,jj,k)*weight enddo field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 @@ -3760,8 +3748,8 @@ subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs, dia total_weight = 0.0 ii=i0 do jj=j0,j0+dl-1 - weight =mask(ii,jj,k)*diag_cs%G%dyCu(ii,jj)*diag_cs%h(ii,jj,k) - total_weight = total_weight +weight + weight =mask(ii,jj,k)*diag_cs%h(ii,jj,k) + total_weight = total_weight +weight ave=ave+field_in(ii,jj,k)*weight enddo field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 @@ -3774,8 +3762,8 @@ subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs, dia total_weight = 0.0 ii=i0 do jj=j0,j0+dl-1 - weight =mask(ii,jj,k) - total_weight = total_weight +weight + weight =mask(ii,jj,k) + total_weight = total_weight +weight ave=ave+field_in(ii,jj,k)*weight enddo field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 @@ -3788,8 +3776,8 @@ subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs, dia total_weight = 0.0 jj=j0 do ii=i0,i0+dl-1 - weight =mask(ii,jj,k) - total_weight = total_weight +weight + weight =mask(ii,jj,k) + total_weight = total_weight +weight ave=ave+field_in(ii,jj,k)*weight enddo field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 @@ -3802,20 +3790,20 @@ subroutine decimate_field_3d(field_in, field_out, dl, method, mask, diag_cs, dia total_weight = 0.0 jj=j0 do ii=i0,i0+dl-1 - weight = mask(ii,jj,k)*diag_cs%G%dxCv(ii,jj)*diag_cs%h(ii,jj,k) + weight = mask(ii,jj,k)*diag_cs%G%dxCv(ii,jj)*diag_cs%h(ii,jj,k) total_weight = total_weight + weight ave=ave+field_in(ii,jj,k)*weight enddo field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo else - write (mesg,*) " unknown sampling method: ",method - call MOM_error(FATAL, "decimate_field_3d: "//trim(mesg)//" "//trim(diag%debug_str)) + write (mesg,*) " unknown sampling method: ",method + call MOM_error(FATAL, "downsample_field_3d: "//trim(mesg)//" "//trim(diag%debug_str)) endif - -end subroutine decimate_field_3d -subroutine decimate_field_2d(field_in, field_out, dl, method, mask, diag_cs,diag,isv_o,jsv_o,isv_d,iev_d,jsv_d,jev_d) +end subroutine downsample_field_3d + +subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs,diag,isv_o,jsv_o,isv_d,iev_d,jsv_d,jev_d) real, dimension(:,:) , pointer :: field_in real, dimension(:,:) , allocatable :: field_out integer , intent(in) :: dl @@ -3824,54 +3812,40 @@ subroutine decimate_field_2d(field_in, field_out, dl, method, mask, diag_cs,diag type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post integer , intent(in) :: isv_o,jsv_o !< original indices, In practice isv_o=jsv_o=1 - integer , intent(in) :: isv_d,iev_d,jsv_d,jev_d !< decimaed indices + integer , intent(in) :: isv_d,iev_d,jsv_d,jev_d !< dsampaed indices !locals character(len=240) :: mesg integer :: i,j,ii,jj,i0,j0 real :: ave,total_weight,weight real :: epsilon = 1.0e-20 - !Allocate the decimated field on the decimated data domain - allocate(field_out(diag_cs%decim(dl)%isd:diag_cs%decim(dl)%ied,diag_cs%decim(dl)%jsd:diag_cs%decim(dl)%jed)) + !Allocate the downsampled field on the downsampled data domain + allocate(field_out(diag_cs%dsamp(dl)%isd:diag_cs%dsamp(dl)%ied,diag_cs%dsamp(dl)%jsd:diag_cs%dsamp(dl)%jed)) ! allocate(field_out(1:size(field_in,1)/dl,1:size(field_in,2)/dl)) - !Fill the decimated field on the decimated diagnostics (almost always compuate) domain + !Fill the downsampled field on the downsampled diagnostics (almost always compuate) domain - if(method .eq. MMM) then !xyz_method = MMM + if(method .eq. MMP) then !xyz_method = MMP do j=jsv_d,jev_d ; do i=isv_d,iev_d i0 = isv_o+dl*(i-isv_d) j0 = jsv_o+dl*(j-jsv_d) ave = 0.0 total_weight = 0.0 do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 -! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 - weight = mask(ii,jj)*diag_cs%G%areaT(ii,jj)*diag_cs%h(ii,jj,1) - total_weight = total_weight + weight - ave=ave+field_in(ii,jj)*weight - enddo; enddo - field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 - enddo; enddo - elseif(method .eq. MMP) then !xyz_method = MMP - do j=jsv_d,jev_d ; do i=isv_d,iev_d - i0 = isv_o+dl*(i-isv_d) - j0 = jsv_o+dl*(j-jsv_d) - ave = 0.0 - total_weight = 0.0 - do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 -! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 +! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 weight = mask(ii,jj)*diag_cs%G%areaT(ii,jj) total_weight = total_weight + weight ave=ave+field_in(ii,jj)*weight enddo; enddo field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo - elseif(method .eq. SSP) then !xyz_method = SSP , e.g., T_dfxy_cont_tendency_2d + elseif(method .eq. SSP) then !xyz_method = SSP , e.g., T_dfxy_cont_tendency_2d do j=jsv_d,jev_d ; do i=isv_d,iev_d i0 = isv_o+dl*(i-isv_d) j0 = jsv_o+dl*(j-jsv_d) ave = 0.0 total_weight = 0.0 do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 -! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 +! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 weight = mask(ii,jj) total_weight = total_weight + weight ave=ave+field_in(ii,jj)*weight @@ -3886,8 +3860,8 @@ subroutine decimate_field_2d(field_in, field_out, dl, method, mask, diag_cs,diag total_weight = 0.0 ii=i0 do jj=j0,j0+dl-1 - weight =mask(ii,jj) - total_weight = total_weight +weight + weight =mask(ii,jj) + total_weight = total_weight +weight ave=ave+field_in(ii,jj)*weight enddo field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 @@ -3900,8 +3874,8 @@ subroutine decimate_field_2d(field_in, field_out, dl, method, mask, diag_cs,diag total_weight = 0.0 jj=j0 do ii=i0,i0+dl-1 - weight =mask(ii,jj) - total_weight = total_weight +weight + weight =mask(ii,jj) + total_weight = total_weight +weight ave=ave+field_in(ii,jj)*weight enddo field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 @@ -3914,8 +3888,8 @@ subroutine decimate_field_2d(field_in, field_out, dl, method, mask, diag_cs,diag total_weight = 0.0 ii=i0 do jj=j0,j0+dl-1 - weight =mask(ii,jj)*diag_cs%G%dyCu(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? - total_weight = total_weight +weight + weight =mask(ii,jj)*diag_cs%G%dyCu(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? + total_weight = total_weight +weight ave=ave+field_in(ii,jj)*weight enddo field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 @@ -3928,35 +3902,35 @@ subroutine decimate_field_2d(field_in, field_out, dl, method, mask, diag_cs,diag total_weight = 0.0 jj=j0 do ii=i0,i0+dl-1 - weight =mask(ii,jj)*diag_cs%G%dxCv(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? - total_weight = total_weight +weight + weight =mask(ii,jj)*diag_cs%G%dxCv(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? + total_weight = total_weight +weight ave=ave+field_in(ii,jj)*weight enddo field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo else - write (mesg,*) " unknown sampling method: ",method - call MOM_error(FATAL, "decimate_field_2d: "//trim(mesg)//" "//trim(diag%debug_str)) + write (mesg,*) " unknown sampling method: ",method + call MOM_error(FATAL, "downsample_field_2d: "//trim(mesg)//" "//trim(diag%debug_str)) endif - -end subroutine decimate_field_2d -!> Allocate and compute the decimated masks -!! The masks are decimated based on a minority rule, i.e., a coarse cell is open (1) +end subroutine downsample_field_2d + +!> Allocate and compute the downsampled masks +!! The masks are downsampled based on a minority rule, i.e., a coarse cell is open (1) !! if at least one of the sub-cells are open, otherwise it's closed (0) -subroutine decimate_mask_3d_p(field_in, field_out, dl) +subroutine downsample_mask_3d_p(field_in, field_out, dl) integer , intent(in) :: dl real, dimension(:,:,:) , pointer :: field_in, field_out integer :: i,j,ii,jj,i0,j0 integer :: isv_o,jsv_o,isv_d,iev_d,jsv_d,jev_d integer :: k,ks,ke real :: tot_non_zero - !decimated mask = 0 unless the mask value of one of the decimating cells is 1 + !downsampled mask = 0 unless the mask value of one of the downsampling cells is 1 isv_o=1 jsv_o=1 - ks = lbound(field_in,3) ; ke = ubound(field_in,3) + ks = lbound(field_in,3) ; ke = ubound(field_in,3) isv_d=1; iev_d=size(field_in,1)/dl - jsv_d=1; jev_d=size(field_in,2)/dl + jsv_d=1; jev_d=size(field_in,2)/dl allocate(field_out(isv_d:iev_d,jsv_d:jev_d,ks:ke)) field_out(:,:,:) = 0.0 do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d @@ -3964,40 +3938,40 @@ subroutine decimate_mask_3d_p(field_in, field_out, dl) j0 = jsv_o+dl*(j-jsv_d) tot_non_zero = 0.0 ! do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 - do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 + do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 tot_non_zero = tot_non_zero + field_in(ii,jj,k) enddo;enddo if(tot_non_zero > 0.0) field_out(i,j,k)=1.0 enddo; enddo; enddo -end subroutine decimate_mask_3d_p +end subroutine downsample_mask_3d_p -subroutine decimate_mask_2d_p(field_in, field_out, dl) +subroutine downsample_mask_2d_p(field_in, field_out, dl) integer , intent(in) :: dl real, dimension(:,:) , intent(in) :: field_in real, dimension(:,:) , pointer :: field_out integer :: i,j,ii,jj,i0,j0 integer :: isv_o,jsv_o,isv_d,iev_d,jsv_d,jev_d real :: tot_non_zero - !decimated mask = 0 unless the mask value of one of the decimating cells is 1 + !downsampled mask = 0 unless the mask value of one of the downsampling cells is 1 isv_o=1 jsv_o=1 isv_d=1; iev_d=size(field_in,1)/dl - jsv_d=1; jev_d=size(field_in,2)/dl - allocate(field_out(isv_d:iev_d,jsv_d:jev_d)) + jsv_d=1; jev_d=size(field_in,2)/dl + allocate(field_out(isv_d:iev_d,jsv_d:jev_d)) field_out(:,:) = 0.0 do j=jsv_d,jev_d ; do i=isv_d,iev_d i0 = isv_o+dl*(i-isv_d) j0 = jsv_o+dl*(j-jsv_d) tot_non_zero = 0.0 ! do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 - do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 + do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 tot_non_zero = tot_non_zero + field_in(ii,jj) enddo;enddo if(tot_non_zero > 0.0) field_out(i,j)=1.0 enddo; enddo -end subroutine decimate_mask_2d_p +end subroutine downsample_mask_2d_p -subroutine decimate_mask_3d_a(field_in, field_out, dl) +subroutine downsample_mask_3d_a(field_in, field_out, dl) integer , intent(in) :: dl real, dimension(:,:,:), pointer :: field_in real, dimension(:,:,:), allocatable :: field_out @@ -4005,51 +3979,51 @@ subroutine decimate_mask_3d_a(field_in, field_out, dl) integer :: isv_o,jsv_o,isv_d,iev_d,jsv_d,jev_d integer :: k,ks,ke real :: tot_non_zero - !decimated mask = 0 unless the mask value of one of the decimating cells is 1 + !downsampled mask = 0 unless the mask value of one of the downsampling cells is 1 isv_o=1 jsv_o=1 - ks = lbound(field_in,3) ; ke = ubound(field_in,3) + ks = lbound(field_in,3) ; ke = ubound(field_in,3) isv_d=1; iev_d=size(field_in,1)/dl - jsv_d=1; jev_d=size(field_in,2)/dl + jsv_d=1; jev_d=size(field_in,2)/dl allocate(field_out(isv_d:iev_d,jsv_d:jev_d,ks:ke)) field_out(:,:,:) = 0.0 do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d i0 = isv_o+dl*(i-isv_d) j0 = jsv_o+dl*(j-jsv_d) tot_non_zero = 0.0 -! do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 - do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 +! do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 + do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 tot_non_zero = tot_non_zero + field_in(ii,jj,k) enddo;enddo if(tot_non_zero > 0.0) field_out(i,j,k)=1.0 enddo; enddo; enddo -end subroutine decimate_mask_3d_a +end subroutine downsample_mask_3d_a -subroutine decimate_mask_2d_a(field_in, field_out, dl) +subroutine downsample_mask_2d_a(field_in, field_out, dl) integer , intent(in) :: dl real, dimension(:,:) , intent(in) :: field_in real, dimension(:,:) , allocatable :: field_out integer :: i,j,ii,jj,i0,j0 integer :: isv_o,jsv_o,isv_d,iev_d,jsv_d,jev_d real :: tot_non_zero - !decimated mask = 0 unless the mask value of one of the decimating cells is 1 + !downsampled mask = 0 unless the mask value of one of the downsampling cells is 1 isv_o=1 jsv_o=1 isv_d=1; iev_d=size(field_in,1)/dl - jsv_d=1; jev_d=size(field_in,2)/dl + jsv_d=1; jev_d=size(field_in,2)/dl allocate(field_out(isv_d:iev_d,jsv_d:jev_d)) field_out(:,:) = 0.0 do j=jsv_d,jev_d ; do i=isv_d,iev_d i0 = isv_o+dl*(i-isv_d) j0 = jsv_o+dl*(j-jsv_d) tot_non_zero = 0.0 -! do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 - do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 +! do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 + do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 tot_non_zero = tot_non_zero + field_in(ii,jj) enddo;enddo if(tot_non_zero > 0.0) field_out(i,j)=1.0 enddo; enddo -end subroutine decimate_mask_2d_a +end subroutine downsample_mask_2d_a end module MOM_diag_mediator diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index c4ef88d30c..55e6e47b63 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -32,7 +32,7 @@ module MOM_domains implicit none ; private -public :: MOM_domains_init, MOM_infra_init, MOM_infra_end, get_domain_extent, get_domain_extent_zap2 +public :: MOM_domains_init, MOM_infra_init, MOM_infra_end, get_domain_extent, get_domain_extent_dsamp2 public :: MOM_define_domain, MOM_define_io_domain, clone_MOM_domain public :: pass_var, pass_vector, PE_here, root_PE, num_PEs public :: pass_var_start, pass_var_complete, fill_symmetric_edges, broadcast @@ -99,7 +99,7 @@ module MOM_domains type, public :: MOM_domain_type type(domain2D), pointer :: mpp_domain => NULL() !< The FMS domain with halos !! on this processor, centered at h points. - type(domain2D), pointer :: mpp_domain_zap2 => NULL() !< A coarse FMS domain with halos + type(domain2D), pointer :: mpp_domain_d2 => NULL() !< A coarse FMS domain with halos !! on this processor, centered at h points. integer :: niglobal !< The total horizontal i-domain size. integer :: njglobal !< The total horizontal j-domain size. @@ -1206,7 +1206,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & character(len=8) :: char_xsiz, char_ysiz, char_niglobal, char_njglobal character(len=40) :: nihalo_nm, njhalo_nm, layout_nm, io_layout_nm, masktable_nm character(len=40) :: niproc_nm, njproc_nm - integer :: xhalo_zap2,yhalo_zap2 + integer :: xhalo_d2,yhalo_d2 ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl ! This module's name. @@ -1214,7 +1214,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & if (.not.associated(MOM_dom)) then allocate(MOM_dom) allocate(MOM_dom%mpp_domain) - allocate(MOM_dom%mpp_domain_zap2) + allocate(MOM_dom%mpp_domain_d2) endif pe = PE_here() @@ -1571,26 +1571,29 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & global_indices(1) = 1 ; global_indices(2) = int(MOM_dom%niglobal/2) global_indices(3) = 1 ; global_indices(4) = int(MOM_dom%njglobal/2) - xhalo_zap2 = int(MOM_dom%nihalo/2) - yhalo_zap2 = int(MOM_dom%njhalo/2) + !For downsampled domain, recommend a halo of 1 (or 0?) since we're not doing wide-stencil computations. + !But that does not work because the downsampled field would not have the correct size to pass the checks, e.g., we get + !error: downsample_diag_indices_get: peculiar size 28 in i-direction\ndoes not match one of 24 25 26 27 + xhalo_d2 = int(MOM_dom%nihalo/2) + yhalo_d2 = int(MOM_dom%njhalo/2) if (mask_table_exists) then - call MOM_define_domain( global_indices, layout, MOM_dom%mpp_domain_zap2, & + call MOM_define_domain( global_indices, layout, MOM_dom%mpp_domain_d2, & xflags=X_FLAGS, yflags=Y_FLAGS, & - xhalo=xhalo_zap2, yhalo=yhalo_zap2, & + xhalo=xhalo_d2, yhalo=yhalo_d2, & symmetry = MOM_dom%symmetric, name=trim("MOMc"), & maskmap=MOM_dom%maskmap ) else - call MOM_define_domain( global_indices, layout, MOM_dom%mpp_domain_zap2, & + call MOM_define_domain( global_indices, layout, MOM_dom%mpp_domain_d2, & xflags=X_FLAGS, yflags=Y_FLAGS, & - xhalo=xhalo_zap2, yhalo=yhalo_zap2, & + xhalo=xhalo_d2, yhalo=yhalo_d2, & symmetry = MOM_dom%symmetric, name=trim("MOMc")) endif if ((io_layout(1) > 0) .and. (io_layout(2) > 0) .and. & (layout(1)*layout(2) > 1)) then - call MOM_define_io_domain(MOM_dom%mpp_domain_zap2, io_layout) + call MOM_define_io_domain(MOM_dom%mpp_domain_d2, io_layout) endif - + end subroutine MOM_domains_init !> clone_MD_to_MD copies one MOM_domain_type into another, while allowing @@ -1622,7 +1625,7 @@ subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, & if (.not.associated(MOM_dom)) then allocate(MOM_dom) allocate(MOM_dom%mpp_domain) - allocate(MOM_dom%mpp_domain_zap2) + allocate(MOM_dom%mpp_domain_d2) endif ! Save the extra data for creating other domains of different resolution that overlay this domain @@ -1818,23 +1821,23 @@ subroutine get_domain_extent(Domain, isc, iec, jsc, jec, isd, ied, jsd, jed, & end subroutine get_domain_extent -subroutine get_domain_extent_zap2(Domain, isc_zap2, iec_zap2, jsc_zap2, jec_zap2,& - isd_zap2, ied_zap2, jsd_zap2, jed_zap2,& - isg_zap2, ieg_zap2, jsg_zap2, jeg_zap2) +subroutine get_domain_extent_dsamp2(Domain, isc_d2, iec_d2, jsc_d2, jec_d2,& + isd_d2, ied_d2, jsd_d2, jed_d2,& + isg_d2, ieg_d2, jsg_d2, jeg_d2) type(MOM_domain_type), & intent(in) :: Domain !< The MOM domain from which to extract information - integer, intent(out) :: isc_zap2, iec_zap2, jsc_zap2, jec_zap2 - integer, intent(out) :: isd_zap2, ied_zap2, jsd_zap2, jed_zap2 - integer, intent(out) :: isg_zap2, ieg_zap2, jsg_zap2, jeg_zap2 - call mpp_get_compute_domain(Domain%mpp_domain_zap2, isc_zap2, iec_zap2, jsc_zap2, jec_zap2) - call mpp_get_data_domain(Domain%mpp_domain_zap2, isd_zap2, ied_zap2, jsd_zap2, jed_zap2) - call mpp_get_global_domain (Domain%mpp_domain_zap2, isg_zap2, ieg_zap2, jsg_zap2, jeg_zap2) + integer, intent(out) :: isc_d2, iec_d2, jsc_d2, jec_d2 + integer, intent(out) :: isd_d2, ied_d2, jsd_d2, jed_d2 + integer, intent(out) :: isg_d2, ieg_d2, jsg_d2, jeg_d2 + call mpp_get_compute_domain(Domain%mpp_domain_d2, isc_d2, iec_d2, jsc_d2, jec_d2) + call mpp_get_data_domain(Domain%mpp_domain_d2, isd_d2, ied_d2, jsd_d2, jed_d2) + call mpp_get_global_domain (Domain%mpp_domain_d2, isg_d2, ieg_d2, jsg_d2, jeg_d2) ! This code institutes the MOM convention that local array indices start at 1. - isc_zap2 = isc_zap2-isd_zap2+1 ; iec_zap2 = iec_zap2-isd_zap2+1 - jsc_zap2 = jsc_zap2-jsd_zap2+1 ; jec_zap2 = jec_zap2-jsd_zap2+1 - ied_zap2 = ied_zap2-isd_zap2+1 ; jed_zap2 = jed_zap2-jsd_zap2+1 - isd_zap2 = 1 ; jsd_zap2 = 1 -end subroutine get_domain_extent_zap2 + isc_d2 = isc_d2-isd_d2+1 ; iec_d2 = iec_d2-isd_d2+1 + jsc_d2 = jsc_d2-jsd_d2+1 ; jec_d2 = jec_d2-jsd_d2+1 + ied_d2 = ied_d2-isd_d2+1 ; jed_d2 = jed_d2-jsd_d2+1 + isd_d2 = 1 ; jsd_d2 = 1 +end subroutine get_domain_extent_dsamp2 !> Return the (potentially symmetric) computational domain i-bounds for an array !! passed without index specifications (i.e. indices start at 1) based on an array size. From 16fef4f69f3641f0c1af91f6b290f17528960e38 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Fri, 26 Oct 2018 17:44:17 -0400 Subject: [PATCH 0865/1072] Diagnostics downsampling, fix the issue for symmetric case - There was a unnecessary check for symmetric case --- src/core/MOM_grid.F90 | 5 ++-- src/framework/MOM_diag_mediator.F90 | 37 ++++++++++++++++------------- 2 files changed, 24 insertions(+), 18 deletions(-) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 453e351060..39aa9290f0 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -21,7 +21,7 @@ module MOM_grid type(MOM_domain_type), pointer :: Domain => NULL() !< Ocean model domain type(MOM_domain_type), pointer :: Domain_aux => NULL() !< A non-symmetric auxiliary domain type. type(hor_index_type) :: HI !< Horizontal index ranges - type(hor_index_type) :: HId2 !< Horizontal index ranges for level-2-downsampling + type(hor_index_type) :: HId2 !< Horizontal index ranges for level-2-downsampling integer :: isc !< The start i-index of cell centers within the computational domain integer :: iec !< The end i-index of cell centers within the computational domain @@ -348,8 +348,9 @@ subroutine MOM_grid_init(G, param_file, HI, global_indexing, bathymetry_at_vel) call get_domain_extent_dsamp2(G%Domain, G%HId2%isc, G%HId2%iec, G%HId2%jsc, G%HId2%jec,& G%HId2%isd, G%HId2%ied, G%HId2%jsd, G%HId2%jed,& G%HId2%isg, G%HId2%ieg, G%HId2%jsg, G%HId2%jeg) - + ! Set array sizes for fields that are discretized at tracer cell boundaries. + G%HId2%IegB = G%HId2%ieg ; G%HId2%JegB = G%HId2%jeg G%HId2%IsdB = G%HId2%isd ; G%HId2%JsdB = G%HId2%jsd if (G%symmetric) then G%HId2%IsdB = G%HId2%isd-1 ; G%HId2%JsdB = G%HId2%jsd-1 diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 2abc9b611d..8ba54ba997 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -517,6 +517,8 @@ subroutine set_axes_info_dsamp(G, GV, param_file, diag_cs, id_zl_native, id_zi_n integer :: i, j, k, nz, dl real, dimension(:), pointer :: gridLonT_dsamp =>NULL() real, dimension(:), pointer :: gridLatT_dsamp =>NULL() + real, dimension(:), pointer :: gridLonB_dsamp =>NULL() + real, dimension(:), pointer :: gridLatB_dsamp =>NULL() id_zl = id_zl_native ; id_zi = id_zi_native !Axes group for native downsampled diagnostics @@ -524,29 +526,32 @@ subroutine set_axes_info_dsamp(G, GV, param_file, diag_cs, id_zl_native, id_zi_n if(dl .ne. 2) call MOM_error(FATAL, "set_axes_info_dsamp: Downsample level other than 2 is not supported yet!") allocate(gridLonT_dsamp(diag_cs%dsamp(dl)%isg:diag_cs%dsamp(dl)%ieg)) allocate(gridLatT_dsamp(diag_cs%dsamp(dl)%jsg:diag_cs%dsamp(dl)%jeg)) - do i=diag_cs%dsamp(dl)%isg,diag_cs%dsamp(dl)%ieg; gridLonT_dsamp(i) = G%gridLonT(G%isg+dl*i-2); enddo do j=diag_cs%dsamp(dl)%jsg,diag_cs%dsamp(dl)%jeg; gridLatT_dsamp(j) = G%gridLatT(G%jsg+dl*j-2); enddo - - if (G%symmetric) then - call MOM_error(FATAL, "set_axes_info_dsamp: Downsample of symmetric case is not supported yet!") - ! id_xq = diag_axis_init('xq', gridLonB_dsamp(G%isgB:G%iegB), G%x_axis_units, 'x', & - ! 'q point nominal longitude', Domain2=G%Domain%mpp_domain_d2) - ! id_yq = diag_axis_init('yq', gridLatB_dsamp(G%jsgB:G%jegB), G%y_axis_units, 'y', & - ! 'q point nominal latitude', Domain2=G%Domain%mpp_domain_d2) - else - id_xq = diag_axis_init('xq', gridLonT_dsamp, G%x_axis_units, 'x', & - 'q point nominal longitude', Domain2=G%Domain%mpp_domain_d2) - id_yq = diag_axis_init('yq', gridLatT_dsamp, G%y_axis_units, 'y', & - 'q point nominal latitude', Domain2=G%Domain%mpp_domain_d2) - endif + allocate(gridLonB_dsamp(diag_cs%dsamp(dl)%isg:diag_cs%dsamp(dl)%ieg)) + allocate(gridLatB_dsamp(diag_cs%dsamp(dl)%jsg:diag_cs%dsamp(dl)%jeg)) + do i=diag_cs%dsamp(dl)%isg,diag_cs%dsamp(dl)%ieg; gridLonB_dsamp(i) = G%gridLonB(G%isg+dl*i-2); enddo + do j=diag_cs%dsamp(dl)%jsg,diag_cs%dsamp(dl)%jeg; gridLatB_dsamp(j) = G%gridLatB(G%jsg+dl*j-2); enddo + +!I don't see a need for this since isgB=isg and iegB=ieg +! if (G%symmetric) then +! id_xq = diag_axis_init('xq', gridLonB_dsamp(G%isgB:G%iegB), G%x_axis_units, 'x', & +! 'q point nominal longitude', Domain2=G%Domain%mpp_domain_d2) +! id_yq = diag_axis_init('yq', gridLatB_dsamp(G%jsgB:G%jegB), G%y_axis_units, 'y', & +! 'q point nominal latitude', Domain2=G%Domain%mpp_domain_d2) +! else + id_xq = diag_axis_init('xq', gridLonB_dsamp, G%x_axis_units, 'x', & + 'q point nominal longitude', Domain2=G%Domain%mpp_domain_d2) + id_yq = diag_axis_init('yq', gridLatB_dsamp, G%y_axis_units, 'y', & + 'q point nominal latitude', Domain2=G%Domain%mpp_domain_d2) +! endif id_xh = diag_axis_init('xh', gridLonT_dsamp, G%x_axis_units, 'x', & 'h point nominal longitude', Domain2=G%Domain%mpp_domain_d2) id_yh = diag_axis_init('yh', gridLatT_dsamp, G%y_axis_units, 'y', & 'h point nominal latitude', Domain2=G%Domain%mpp_domain_d2) - deallocate(gridLonT_dsamp) - deallocate(gridLatT_dsamp) + deallocate(gridLonT_dsamp,gridLatT_dsamp) + deallocate(gridLonB_dsamp,gridLatB_dsamp) ! Axis groupings for the model layers call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yh, id_zL /), diag_cs%dsamp(dl)%axesTL, dl, & From abcf214edf8e034afcdbe88564cc56191606b1f6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 29 Oct 2018 16:22:40 -0400 Subject: [PATCH 0866/1072] +Find diapyc_energy_req column height changes in Z Recast the internal calculation of column height changes inside of diapyc_energy_req_calc into Z, with compensating changes to other terms to keep the energy changes in J m-2. This required the addition of a new GV argument to diapyc_energy_req_init. Also, numerous comments were corrected or updated and three diagnostics are now rescaled via conversion factors. All answers are bitwise identical. --- .../vertical/MOM_diabatic_driver.F90 | 3 +- .../vertical/MOM_diapyc_energy_req.F90 | 182 +++++++++--------- 2 files changed, 94 insertions(+), 91 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index a82b5730ff..285141c5c7 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1307,7 +1307,6 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%debug_energy_req) & call diapyc_energy_req_test(h, dt, tv, G, GV, CS%diapyc_en_rec_CSp) - call cpu_clock_begin(id_clock_set_diffusivity) call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS%set_diff_CSp) call cpu_clock_end(id_clock_set_diffusivity) @@ -3327,7 +3326,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, call regularize_layers_init(Time, G, GV, param_file, diag, CS%regularize_layers_CSp) if (CS%debug_energy_req) & - call diapyc_energy_req_init(Time, G, param_file, diag, CS%diapyc_en_rec_CSp) + call diapyc_energy_req_init(Time, G, GV, param_file, diag, CS%diapyc_en_rec_CSp) ! obtain information about the number of bands for penetrative shortwave if (use_temperature) then diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 93676a384c..293e6db90a 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -44,8 +44,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, CS, Kd_int) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(G%isd:G%ied,G%jsd:G%jed,GV%ke), & - intent(in) :: h_3d !< Layer thickness before entrainment, - !! in m or kg m-2. + intent(in) :: h_3d !< Layer thickness before entrainment, in H. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. !! Absent fields have NULL ptrs. @@ -60,7 +59,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, CS, Kd_int) T0, S0, & ! T0 & S0 are columns of initial temperatures and salinities, in degC and g/kg. h_col ! h_col is a column of thicknesses h at tracer points, in H (m or kg m-2). real, dimension(GV%ke+1) :: & - Kd, & ! A column of diapycnal diffusivities at interfaces, in m2 s-1. + Kd, & ! A column of diapycnal diffusivities at interfaces, in Z2 s-1. h_top, h_bot ! Distances from the top or bottom, in H. real :: ustar, absf, htot real :: energy_Kd ! The energy used by diapycnal mixing in W m-2. @@ -75,7 +74,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, CS, Kd_int) !$OMP do do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then if (present(Kd_int) .and. .not.CS%use_test_Kh_profile) then - do k=1,nz+1 ; Kd(K) = CS%test_Kh_scaling*GV%Z_to_m**2*Kd_int(i,j,K) ; enddo + do k=1,nz+1 ; Kd(K) = CS%test_Kh_scaling*Kd_int(i,j,K) ; enddo else htot = 0.0 ; h_top(1) = 0.0 do k=1,nz @@ -95,7 +94,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, CS, Kd_int) Kd(1) = 0.0 ; Kd(nz+1) = 0.0 do K=2,nz tmp1 = h_top(K) * h_bot(K) * GV%H_to_Z - Kd(K) = CS%test_Kh_scaling * GV%Z_to_m**2 * & + Kd(K) = CS%test_Kh_scaling * & ustar * 0.41 * (tmp1*ustar) / (absf*tmp1 + htot*ustar) enddo endif @@ -121,9 +120,8 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & real, dimension(GV%ke), intent(in) :: T_in !< The layer temperatures, in degC. real, dimension(GV%ke), intent(in) :: S_in !< The layer salinities, in g kg-1. real, dimension(GV%ke+1), intent(in) :: Kd !< The interfaces diapycnal diffusivities, - !! in m2 s-1. - real, intent(in) :: dt !< The amount of time covered by this call, - !! in s. + !! in Z2 s-1. + real, intent(in) :: dt !< The amount of time covered by this call, in s. real, intent(out) :: energy_Kd !< The column-integrated rate of energy !! consumption by diapycnal diffusion, in W m-2. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any @@ -147,8 +145,8 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & dSV_dS, & ! Partial derivative of specific volume with salinity, in m3 kg-1 / (g kg-1). T0, S0, & ! Initial temperatures and salinities. Te, Se, & ! Running incomplete estimates of the new temperatures and salinities. - Te_a, Se_a, & ! Running incomplete estimates of the new temperatures and salinities. - Te_b, Se_b, & ! Running incomplete estimates of the new temperatures and salinities. + Te_a, Se_a, & ! Running incomplete estimates of the new temperatures and salinities. + Te_b, Se_b, & ! Running incomplete estimates of the new temperatures and salinities. Tf, Sf, & ! New final values of the temperatures and salinities. dTe, dSe, & ! Running (1-way) estimates of temperature and salinity change. dTe_a, dSe_a, & ! Running (1-way) estimates of temperature and salinity change. @@ -156,21 +154,21 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & Th_a, & ! An effective temperature times a thickness in the layer above, ! including implicit mixing effects with other yet higher layers, in K H. Sh_a, & ! An effective salinity times a thickness in the layer above, - ! including implicit mixing effects with other yet higher layers, in K H. + ! including implicit mixing effects with other yet higher layers, in ppt H. Th_b, & ! An effective temperature times a thickness in the layer below, ! including implicit mixing effects with other yet lower layers, in K H. Sh_b, & ! An effective salinity times a thickness in the layer below, - ! including implicit mixing effects with other yet lower layers, in K H. + ! including implicit mixing effects with other yet lower layers, in ppt H. dT_to_dPE, & ! Partial derivative of column potential energy with the temperature dS_to_dPE, & ! and salinity changes within a layer, in J m-2 K-1 and J m-2 / (g kg-1). dT_to_dColHt, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt, & ! and salinity changes within a layer, in m K-1 and m ppt-1. + dS_to_dColHt, & ! and salinity changes within a layer, in Z K-1 and Z ppt-1. dT_to_dColHt_a, & ! Partial derivatives of the total column height with the temperature dS_to_dColHt_a, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers higher in the water colun, in m K-1 and m ppt-1. + ! of mixing with layers higher in the water colun, in Z K-1 and Z ppt-1. dT_to_dColHt_b, & ! Partial derivatives of the total column height with the temperature dS_to_dColHt_b, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers lower in the water colun, in m K-1 and m ppt-1. + ! of mixing with layers lower in the water colun, in Z K-1 and Z ppt-1. dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature dS_to_dPE_a, & ! and salinity changes within a layer, including the implicit effects ! of mixing with layers higher in the water column, in @@ -191,14 +189,18 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ! ensure positive definiteness, in m or kg m-2. real, dimension(GV%ke+1) :: & pres, & ! Interface pressures in Pa. - z_Int, & ! Interface heights relative to the surface, in m. + pres_Z, & ! Interface pressures with a rescaling factor to convert interface height + ! movements into changes in column potential energy, in J m-2 Z-1. + z_Int, & ! Interface heights relative to the surface, in H. N2, & ! An estimate of the buoyancy frequency in s-2. - Kddt_h_a, & ! - Kddt_h_b, & ! Kddt_h, & ! The diapycnal diffusivity times a timestep divided by the - ! average thicknesses around a layer, in m or kg m-2. + ! average thicknesses around a layer, in H (m or kg m-2). + Kddt_h_a, & ! The value of Kddt_h for layers above the central point in the + ! tridiagonal solver, in H. + Kddt_h_b, & ! The value of Kddt_h for layers below the central point in the + ! tridiagonal solver, in H. Kd_so_far ! The value of Kddt_h that has been applied already in - ! calculating the energy changes, in m or kg m-2. + ! calculating the energy changes, in H (m or kg m-2). real, dimension(GV%ke+1,4) :: & PE_chg_k, & ! The integrated potential energy change within a timestep due ! to the diffusivity at interface K for 4 different orders of @@ -206,14 +208,18 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ColHt_cor_k ! The correction to the potential energy change due to ! changes in the net column height, in J m-2. real :: & - b1 ! b1 is used by the tridiagonal solver, in m-1 or m2 kg-1. + b1 ! b1 is used by the tridiagonal solver, in H-1. real :: & - I_b1 ! The inverse of b1, in m or kg m-2. - real :: Kd0, dKd + I_b1 ! The inverse of b1, in H. + real :: Kd0 ! The value of Kddt_h that has already been applied, in H. + real :: dKd ! The change in the value of Kddt_h, in H. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m. - real :: dTe_term, dSe_term - real :: Kddt_h_guess + ! in roundoff and can be neglected, in H. + real :: dTe_term ! A diffusivity-independent term related to the temperature + ! change in the layer below the interface, in K H. + real :: dSe_term ! A diffusivity-independent term related to the salinity + ! change in the layer below the interface, in ppt H. + real :: Kddt_h_guess ! A guess of the final value of Kddt_h, in H. real :: dMass ! The mass per unit area within a layer, in kg m-2. real :: dPres ! The hydrostatic pressure change across a layer, in Pa. real :: dMKE_max ! The maximum amount of mean kinetic energy that could be @@ -221,12 +227,13 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ! the layer below an interface were homogenized with all of ! the water above the interface, in J m-2 = kg s-2. real :: rho_here ! The in-situ density, in kg m-3. - real :: PE_change, ColHt_cor - real :: htot - real :: dT_k, dT_km1, dS_k, dS_km1 ! Temporary arrays - real :: b1Kd ! Temporary arrays - real :: Kd_rat, Kdr_denom, I_Kdr_denom ! Temporary arrays - real :: dTe_t2, dSe_t2, dT_km1_t2, dS_km1_t2, dT_k_t2, dS_k_t2 + real :: PE_change ! The change in column potential energy from applying Kddt_h at the + ! present interface, in J m-2. + real :: ColHt_cor ! The correction to PE_chg that is made due to a net + ! change in the column height, in J m-2. + real :: htot ! A running sum of thicknesses, in H. + real :: dTe_t2, dT_km1_t2, dT_k_t2 ! Temporary arrays describing temperature changes. + real :: dSe_t2, dS_km1_t2, dS_k_t2 ! Temporary arrays describing salinity changes. logical :: do_print ! The following are a bunch of diagnostic arrays for debugging purposes. @@ -243,15 +250,12 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & real :: PE_chg(6) real, dimension(6) :: dT_k_itt, dS_k_itt, dT_km1_itt, dS_km1_itt - real :: I_G_Earth - real :: dKd_rat_dKd, ddT_k_dKd, ddS_k_dKd, ddT_km1_dKd, ddS_km1_dKd integer :: k, nz, itt, max_itt, k_cent logical :: surface_BL, bottom_BL, central, halves, debug logical :: old_PE_calc nz = G%ke h_neglect = GV%H_subroundoff - I_G_Earth = 1.0 / (GV%g_Earth*GV%m_to_Z) debug = .true. surface_BL = .true. ; bottom_BL = .true. ; halves = .true. @@ -264,14 +268,15 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & dPEb_dKd(:) = 0.0 ; dPEb_dKd_est(:) = 0.0 ; dPEb_dKd_err(:) = 0.0 dPEb_dKd_err_norm(:) = 0.0 ; dPEb_dKd_trunc(:) = 0.0 - htot = 0.0 ; pres(1) = 0.0 ; Z_int(1) = 0.0 + htot = 0.0 ; pres(1) = 0.0 ; pres_Z(1) = 0.0 ; Z_int(1) = 0.0 do k=1,nz T0(k) = T_in(k) ; S0(k) = S_in(k) h_tr(k) = h_in(k) htot = htot + h_tr(k) pres(K+1) = pres(K) + GV%H_to_Pa * h_tr(k) + pres_Z(K+1) = GV%Z_to_m * pres(K+1) p_lay(k) = 0.5*(pres(K) + pres(K+1)) - Z_int(K+1) = Z_int(K) - GV%H_to_m * h_tr(k) + Z_int(K+1) = Z_int(K) - h_tr(k) enddo do k=1,nz h_tr(k) = max(h_tr(k), 1e-15*htot) @@ -281,7 +286,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & Kddt_h(1) = 0.0 ; Kddt_h(nz+1) = 0.0 do K=2,nz - Kddt_h(K) = min((GV%m_to_H**2*dt)*Kd(k) / (0.5*(h_tr(k-1) + h_tr(k))),1e3*htot) + Kddt_h(K) = min((GV%Z_to_H**2*dt)*Kd(k) / (0.5*(h_tr(k-1) + h_tr(k))), 1e3*htot) enddo ! Solve the tridiagonal equations for new temperatures. @@ -290,11 +295,11 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & do k=1,nz dMass = GV%H_to_kg_m2 * h_tr(k) - dPres = (GV%g_Earth*GV%m_to_Z) * dMass + dPres = GV%H_to_Pa * h_tr(k) dT_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dT(k) dS_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dS(k) - dT_to_dColHt(k) = dMass * dSV_dT(k) * CS%ColHt_scaling - dS_to_dColHt(k) = dMass * dSV_dS(k) * CS%ColHt_scaling + dT_to_dColHt(k) = dMass * GV%m_to_Z * dSV_dT(k) * CS%ColHt_scaling + dS_to_dColHt(k) = dMass * GV%m_to_Z * dSV_dS(k) * CS%ColHt_scaling enddo ! PE_chg_k(1) = 0.0 ; PE_chg_k(nz+1) = 0.0 @@ -352,14 +357,14 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & call find_PE_chg_orig(Kddt_h_guess, h_tr(k), hp_a(k-1), & dTe_term, dSe_term, dT_km1_t2, dS_km1_t2, & dT_to_dPE(k), dS_to_dPE(k), dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), & - pres(K), dT_to_dColHt(k), dS_to_dColHt(k), & + pres_Z(K), dT_to_dColHt(k), dS_to_dColHt(k), & dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & PE_chg_k(k,1), dPEa_dKd(k)) else call find_PE_chg(0.0, Kddt_h_guess, hp_a(k-1), hp_b(k), & Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), & - pres(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & dT_to_dColHt_b(k), dS_to_dColHt_b(k), & PE_chg=PE_chg_k(K,1), dPEc_dKd=dPEa_dKd(K), & ColHt_cor=ColHt_cor_k(K,1)) @@ -373,14 +378,14 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & call find_PE_chg_orig(Kddt_h_guess, h_tr(k), hp_a(k-1), & dTe_term, dSe_term, dT_km1_t2, dS_km1_t2, & dT_to_dPE(k), dS_to_dPE(k), dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), & - pres(K), dT_to_dColHt(k), dS_to_dColHt(k), & + pres_Z(K), dT_to_dColHt(k), dS_to_dColHt(k), & dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & PE_chg=PE_chg(itt)) else call find_PE_chg(0.0, Kddt_h_guess, hp_a(k-1), hp_b(k), & Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), & - pres(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & dT_to_dColHt_b(k), dS_to_dColHt_b(k), & PE_chg=PE_chg(itt)) endif @@ -497,14 +502,14 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & call find_PE_chg_orig(Kddt_h_guess, h_tr(k-1), hp_b(k), & dTe_term, dSe_term, dT_k_t2, dS_k_t2, & dT_to_dPE(k-1), dS_to_dPE(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), & - pres(K), dT_to_dColHt(k-1), dS_to_dColHt(k-1), & + pres_Z(K), dT_to_dColHt(k-1), dS_to_dColHt(k-1), & dT_to_dColHt_b(k), dS_to_dColHt_b(k), & PE_chg=PE_chg_k(K,2), dPEc_dKd=dPEb_dKd(K)) else call find_PE_chg(0.0, Kddt_h_guess, hp_a(k-1), hp_b(k), & Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), & - pres(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & dT_to_dColHt_b(k), dS_to_dColHt_b(k), & PE_chg=PE_chg_k(K,2), dPEc_dKd=dPEb_dKd(K), & ColHt_cor=ColHt_cor_k(K,2)) @@ -519,14 +524,14 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & call find_PE_chg_orig(Kddt_h_guess, h_tr(k-1), hp_b(k), & dTe_term, dSe_term, dT_k_t2, dS_k_t2, & dT_to_dPE(k-1), dS_to_dPE(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), & - pres(K), dT_to_dColHt(k-1), dS_to_dColHt(k-1), & + pres_Z(K), dT_to_dColHt(k-1), dS_to_dColHt(k-1), & dT_to_dColHt_b(k), dS_to_dColHt_b(k), & PE_chg=PE_chg(itt)) else call find_PE_chg(0.0, Kddt_h_guess, hp_a(k-1), hp_b(k), & Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), & - pres(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & dT_to_dColHt_b(k), dS_to_dColHt_b(k), & PE_chg=PE_chg(itt)) endif @@ -618,15 +623,13 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & endif Th_b(k) = h_tr(k) * T0(k) ; Sh_b(k) = h_tr(k) * S0(k) - Kddt_h_a(K) = 0.0 - if (K < K_cent) Kddt_h_a(K) = Kddt_h(K) - + Kddt_h_a(K) = 0.0 ; if (K < K_cent) Kddt_h_a(K) = Kddt_h(K) dKd = Kddt_h_a(K) call find_PE_chg(Kd0, dKd, hp_a(k-1), hp_b(k), & Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), & - pres(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & dT_to_dColHt_b(k), dS_to_dColHt_b(k), & PE_chg=PE_change, ColHt_cor=ColHt_cor) PE_chg_k(K,3) = PE_change @@ -673,7 +676,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & call find_PE_chg(Kd0, dKd, hp_a(k-1), hp_b(k), & Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), & - pres(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & dT_to_dColHt_b(k), dS_to_dColHt_b(k), & PE_chg=PE_change, ColHt_cor=ColHt_cor) PE_chg_k(K,3) = PE_chg_k(K,3) + PE_change @@ -720,7 +723,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & call find_PE_chg(Kd0, dKd, hp_a(k-1), hp_b(k), & Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), & - pres(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & dT_to_dColHt_b(k), dS_to_dColHt_b(k), & PE_chg=PE_change, ColHt_cor=ColHt_cor) PE_chg_k(K,3) = PE_chg_k(K,3) + PE_change @@ -805,7 +808,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & call find_PE_chg(Kd0, dKd, hp_a(k-1), hp_b(k), & Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), & - pres(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & dT_to_dColHt_b(k), dS_to_dColHt_b(k), & PE_chg=PE_change, ColHt_cor=ColHt_cor) @@ -853,7 +856,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & call find_PE_chg(Kd0, dKd, hp_a(k-1), hp_b(k), & Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), & - pres(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & dT_to_dColHt_b(k), dS_to_dColHt_b(k), & PE_chg=PE_change, ColHt_cor=ColHt_cor) @@ -914,9 +917,9 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & if (CS%id_ERb>0) call post_data(CS%id_ERb, PE_chg_k(:,2), CS%diag) if (CS%id_ERc>0) call post_data(CS%id_ERc, PE_chg_k(:,3), CS%diag) if (CS%id_ERh>0) call post_data(CS%id_ERh, PE_chg_k(:,4), CS%diag) - if (CS%id_Kddt>0) call post_data(CS%id_Kddt, GV%H_to_m*Kddt_h, CS%diag) - if (CS%id_Kd>0) call post_data(CS%id_Kd, Kd, CS%diag) - if (CS%id_h>0) call post_data(CS%id_h, GV%H_to_m*h_tr, CS%diag) + if (CS%id_Kddt>0) call post_data(CS%id_Kddt, Kddt_h, CS%diag) + if (CS%id_Kd>0) call post_data(CS%id_Kd, Kd, CS%diag) + if (CS%id_h>0) call post_data(CS%id_h, h_tr, CS%diag) if (CS%id_zInt>0) call post_data(CS%id_zInt, Z_int, CS%diag) if (CS%id_CHCt>0) call post_data(CS%id_CHCt, ColHt_cor_k(:,1), CS%diag) if (CS%id_CHCb>0) call post_data(CS%id_CHCb, ColHt_cor_k(:,2), CS%diag) @@ -956,7 +959,7 @@ end subroutine diapyc_energy_req_calc !! for several changes in an interfaces's diapycnal diffusivity times a timestep. subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & dT_to_dPE_a, dS_to_dPE_a, dT_to_dPE_b, dS_to_dPE_b, & - pres, dT_to_dColHt_a, dS_to_dColHt_a, dT_to_dColHt_b, dS_to_dColHt_b, & + pres_Z, dT_to_dColHt_a, dS_to_dColHt_a, dT_to_dColHt_b, dS_to_dColHt_b, & PE_chg, dPEc_dKd, dPE_max, dPEc_dKd_0, ColHt_cor) real, intent(in) :: Kddt_h0 !< The previously used diffusivity at an interface times !! the time step and divided by the average of the @@ -1000,25 +1003,25 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & !! a layer's salinity change to the change in column !! potential energy, including all implicit diffusive changes !! in the salinities of all the layers below, in J m-2 ppt-1. - real, intent(in) :: pres !< The hydrostatic interface pressure, which is used to relate + real, intent(in) :: pres_Z !< The hydrostatic interface pressure, which is used to relate !! the changes in column thickness to the energy that is radiated - !! as gravity waves and unavailable to drive mixing, in Pa. + !! as gravity waves and unavailable to drive mixing, in J m-2 Z-1. real, intent(in) :: dT_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers above, in m K-1. + !! in the temperatures of all the layers above, in Z K-1. real, intent(in) :: dS_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers above, in m ppt-1. + !! in the salinities of all the layers above, in Z ppt-1. real, intent(in) :: dT_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers below, in m K-1. + !! in the temperatures of all the layers below, in Z K-1. real, intent(in) :: dS_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers below, in m ppt-1. + !! in the salinities of all the layers below, in Z ppt-1. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying !! Kddt_h at the present interface, in J m-2. @@ -1066,11 +1069,11 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & y1 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) PE_chg = PEc_core * y1 ColHt_chg = ColHt_core * y1 - if (ColHt_chg < 0.0) PE_chg = PE_chg - pres * ColHt_chg - if (present(ColHt_cor)) ColHt_cor = -pres * min(ColHt_chg, 0.0) + if (ColHt_chg < 0.0) PE_chg = PE_chg - pres_Z * ColHt_chg + if (present(ColHt_cor)) ColHt_cor = -pres_Z * min(ColHt_chg, 0.0) elseif (present(ColHt_cor)) then y1 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) - ColHt_cor = -pres * min(ColHt_core * y1, 0.0) + ColHt_cor = -pres_Z * min(ColHt_core * y1, 0.0) endif if (present(dPEc_dKd)) then @@ -1078,7 +1081,7 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & y1 = 1.0 / (bdt1 + dKddt_h * hps)**2 dPEc_dKd = PEc_core * y1 ColHt_chg = ColHt_core * y1 - if (ColHt_chg < 0.0) dPEc_dKd = dPEc_dKd - pres * ColHt_chg + if (ColHt_chg < 0.0) dPEc_dKd = dPEc_dKd - pres_Z * ColHt_chg endif if (present(dPE_max)) then @@ -1086,7 +1089,7 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & y1 = 1.0 / (bdt1 * hps) dPE_max = PEc_core * y1 ColHt_chg = ColHt_core * y1 - if (ColHt_chg < 0.0) dPE_max = dPE_max - pres * ColHt_chg + if (ColHt_chg < 0.0) dPE_max = dPE_max - pres_Z * ColHt_chg endif if (present(dPEc_dKd_0)) then @@ -1094,7 +1097,7 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & y1 = 1.0 / bdt1**2 dPEc_dKd_0 = PEc_core * y1 ColHt_chg = ColHt_core * y1 - if (ColHt_chg < 0.0) dPEc_dKd_0 = dPEc_dKd_0 - pres * ColHt_chg + if (ColHt_chg < 0.0) dPEc_dKd_0 = dPEc_dKd_0 - pres_Z * ColHt_chg endif end subroutine find_PE_chg @@ -1105,7 +1108,7 @@ end subroutine find_PE_chg !! using the original form used in the first version of ePBL. subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & dT_km1_t2, dS_km1_t2, dT_to_dPE_k, dS_to_dPE_k, & - dT_to_dPEa, dS_to_dPEa, pres, dT_to_dColHt_k, & + dT_to_dPEa, dS_to_dPEa, pres_Z, dT_to_dColHt_k, & dS_to_dColHt_k, dT_to_dColHta, dS_to_dColHta, & PE_chg, dPEc_dKd, dPE_max, dPEc_dKd_0) real, intent(in) :: Kddt_h !< The diffusivity at an interface times the time step and @@ -1124,9 +1127,9 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & !! temperature change in the layer above the interface, in K. real, intent(in) :: dS_km1_t2 !< A diffusivity-independent term related to the !! salinity change in the layer above the interface, in ppt. - real, intent(in) :: pres !< The hydrostatic interface pressure, which is used to relate + real, intent(in) :: pres_Z !< The hydrostatic interface pressure, which is used to relate !! the changes in column thickness to the energy that is radiated - !! as gravity waves and unavailable to drive mixing, in Pa. + !! as gravity waves and unavailable to drive mixing, in J m-2 Z-1. real, intent(in) :: dT_to_dPE_k !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column !! potential energy, including all implicit diffusive changes @@ -1146,19 +1149,19 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & real, intent(in) :: dT_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers below, in m K-1. + !! in the temperatures of all the layers below, in Z K-1. real, intent(in) :: dS_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers below, in m ppt-1. + !! in the salinities of all the layers below, in Z ppt-1. real, intent(in) :: dT_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers above, in m K-1. + !! in the temperatures of all the layers above, in Z K-1. real, intent(in) :: dS_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers above, in m ppt-1. + !! in the salinities of all the layers above, in Z ppt-1. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying !! Kddt_h at the present interface, in J m-2. @@ -1213,7 +1216,7 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & (dS_to_dPE_k * dS_k + dS_to_dPEa * dS_km1) ColHt_chg = (dT_to_dColHt_k * dT_k + dT_to_dColHta * dT_km1) + & (dS_to_dColHt_k * dS_k + dS_to_dColHta * dS_km1) - if (ColHt_chg < 0.0) PE_chg = PE_chg - pres * ColHt_chg + if (ColHt_chg < 0.0) PE_chg = PE_chg - pres_Z * ColHt_chg endif if (present(dPEc_dKd)) then @@ -1230,7 +1233,7 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & (dS_to_dPE_k * ddS_k_dKd + dS_to_dPEa * ddS_km1_dKd) dColHt_dKd = (dT_to_dColHt_k * ddT_k_dKd + dT_to_dColHta * ddT_km1_dKd) + & (dS_to_dColHt_k * ddS_k_dKd + dS_to_dColHta * ddS_km1_dKd) - if (dColHt_dKd < 0.0) dPEc_dKd = dPEc_dKd - pres * dColHt_dKd + if (dColHt_dKd < 0.0) dPEc_dKd = dPEc_dKd - pres_Z * dColHt_dKd endif if (present(dPE_max)) then @@ -1241,7 +1244,7 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & dColHt_max = (dT_to_dColHta * dT_km1_t2 + dS_to_dColHta * dS_km1_t2) + & ((dT_to_dColHt_k + dT_to_dColHta) * dTe_term + & (dS_to_dColHt_k + dS_to_dColHta) * dSe_term) / (b_den_1 + h_k) - if (dColHt_max < 0.0) dPE_max = dPE_max - pres*dColHt_max + if (dColHt_max < 0.0) dPE_max = dPE_max - pres_Z*dColHt_max endif if (present(dPEc_dKd_0)) then @@ -1250,15 +1253,16 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & (dT_to_dPE_k * dTe_term + dS_to_dPE_k * dSe_term) / (h_k*b_den_1) dColHt_dKd = (dT_to_dColHta * dT_km1_t2 + dS_to_dColHta * dS_km1_t2) / (b_den_1) + & (dT_to_dColHt_k * dTe_term + dS_to_dColHt_k * dSe_term) / (h_k*b_den_1) - if (dColHt_dKd < 0.0) dPEc_dKd_0 = dPEc_dKd_0 - pres*dColHt_dKd + if (dColHt_dKd < 0.0) dPEc_dKd_0 = dPEc_dKd_0 - pres_Z*dColHt_dKd endif end subroutine find_PE_chg_orig !> Initialize parameters and allocate memory associated with the diapycnal energy requirement module. -subroutine diapyc_energy_req_init(Time, G, param_file, diag, CS) +subroutine diapyc_energy_req_init(Time, G, GV, param_file, diag, CS) type(time_type), intent(in) :: Time !< model time type(ocean_grid_type), intent(in) :: G !< model grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(param_file_type), intent(in) :: param_file !< file to parse for parameter values type(diag_ctrl), target, intent(inout) :: diag !< structure to regulate diagnostic output type(diapyc_energy_req_CS), pointer :: CS !< module control structure @@ -1297,13 +1301,13 @@ subroutine diapyc_energy_req_init(Time, G, param_file, diag, CS) CS%id_ERh = register_diag_field('ocean_model', 'EnReqTest_ERh', diag%axesZi, Time, & "Diffusivity Energy Requirements, halves", "J m-2") CS%id_Kddt = register_diag_field('ocean_model', 'EnReqTest_Kddt', diag%axesZi, Time, & - "Implicit diffusive coupling coefficient", "m") + "Implicit diffusive coupling coefficient", "m", conversion=GV%H_to_m) CS%id_Kd = register_diag_field('ocean_model', 'EnReqTest_Kd', diag%axesZi, Time, & - "Diffusivity in test", "m2 s-1") + "Diffusivity in test", "m2 s-1", conversion=GV%Z_to_m**2) CS%id_h = register_diag_field('ocean_model', 'EnReqTest_h_lay', diag%axesZL, Time, & - "Test column layer thicknesses", "m") + "Test column layer thicknesses", "m", conversion=GV%H_to_m) CS%id_zInt = register_diag_field('ocean_model', 'EnReqTest_z_int', diag%axesZi, Time, & - "Test column layer interface heights", "m") + "Test column layer interface heights", "m", conversion=GV%H_to_m) CS%id_CHCt = register_diag_field('ocean_model', 'EnReqTest_CHCt', diag%axesZi, Time, & "Column Height Correction to Energy Requirements, top-down", "J m-2") CS%id_CHCb = register_diag_field('ocean_model', 'EnReqTest_CHCb', diag%axesZi, Time, & From 3034a4c8271f4c1c0a84b5fbd67a16d9154cc4d7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 29 Oct 2018 16:24:04 -0400 Subject: [PATCH 0867/1072] Find energetic_PBL column height changes in Z Recast the internal calculation of column height changes in energetic_PBL into units of Z, with compensating changes to other terms to keep the energy changes in J m-2. Also updated comments and added commented out code suggesting improved forms of expressions related to Langmuir turbulence and certain bounding limits. All answers are bitwise identical. --- .../vertical/MOM_energetic_PBL.F90 | 145 ++++++++++-------- 1 file changed, 79 insertions(+), 66 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 21ef6522f7..7928ebad50 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -264,6 +264,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & real, dimension(SZI_(G),SZK_(GV)+1) :: & Kd, & ! The diapycnal diffusivity, in m2 s-1. pres, & ! Interface pressures in Pa. + pres_Z, & ! Interface pressures with a rescaling factor to convert interface height + ! movements into changes in column potential energy, in J m-2 Z-1. hb_hs ! The distance from the bottom over the thickness of the ! water column, nondim. real, dimension(SZI_(G)) :: & @@ -285,12 +287,12 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & real, dimension(SZI_(G),SZK_(GV)) :: & dT_to_dColHt, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt, & ! and salinity changes within a layer, in m K-1 and m ppt-1. + dS_to_dColHt, & ! and salinity changes within a layer, in Z K-1 and Z ppt-1. dT_to_dPE, & ! Partial derivatives of column potential energy with the temperature dS_to_dPE, & ! and salinity changes within a layer, in J m-2 K-1 and J m-2 ppt-1. dT_to_dColHt_a, & ! Partial derivatives of the total column height with the temperature dS_to_dColHt_a, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers higher in the water colun, in m K-1 and m ppt-1. + ! of mixing with layers higher in the water colun, in Z K-1 and Z ppt-1. dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature dS_to_dPE_a ! and salinity changes within a layer, including the implicit effects ! of mixing with layers higher in the water column, in @@ -528,9 +530,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & reset_diags = .false. ! This is the second call to mixedlayer. if (reset_diags) then -!!OMP parallel default(none) shared(is,ie,js,je,CS) if (CS%TKE_diagnostics) then -!!OMP do +!!OMP parallel do default(none) shared(is,ie,js,je,CS) do j=js,je ; do i=is,ie CS%diag_TKE_wind(i,j) = 0.0 ; CS%diag_TKE_MKE(i,j) = 0.0 CS%diag_TKE_conv(i,j) = 0.0 ; CS%diag_TKE_forcing(i,j) = 0.0 @@ -538,23 +539,23 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & CS%diag_TKE_conv_decay(i,j) = 0.0 !; CS%diag_TKE_unbalanced_forcing(i,j) = 0.0 enddo ; enddo endif +!!OMP parallel do default(none) shared(CS) if (CS%Mixing_Diagnostics) then CS%Mixing_Length(:,:,:) = 0.0 CS%Velocity_Scale(:,:,:) = 0.0 endif -!!OMP end parallel endif !!OMP parallel do default(none) shared(js,je,nz,is,ie,h_3d,u_3d,v_3d,tv,dt, & !!OMP CS,G,GV,fluxes,IdtdR0, & !!OMP TKE_forced,debug,H_neglect,dSV_dT, & -!!OMP dSV_dS,I_dtrho,C1_3,h_tt_min,vonKar, & +!!OMP dSV_dS,I_dtrho,C1_3,h_tt_min,vonKar, & !!OMP max_itt,Kd_int) & !!OMP private(i,j,k,h,u,v,T,S,Kd,mech_TKE_k,conv_PErel_k, & !!OMP U_Star,absf,mech_TKE,conv_PErel,nstar_k, & !!OMP h_sum,I_hs,h_bot,hb_hs,T0,S0,num_itts, & -!!OMP pres,dMass,dPres,dT_to_dPE,dS_to_dPE, & +!!OMP pres,pres_Z,dMass,dPres,dT_to_dPE,dS_to_dPE, & !!OMP dT_to_dColHt,dS_to_dColHt,Kddt_h,hp_a, & !!OMP Th_a,Sh_a,Th_b,Sh_b,dT_to_dPE_a,htot, & !!OMP dT_to_dColHt_a,dS_to_dColHt_a,uhtot,vhtot, & @@ -608,13 +609,14 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & fluxes%frac_shelf_h(i,j) * GV%m_to_Z*fluxes%ustar_shelf(i,j) endif if (U_Star < CS%ustar_min) U_Star = CS%ustar_min + ! Computing Bf w/ limiters. Bf_Stable = max(0.0, buoy_Flux(i,j)) ! Positive for stable Bf_Unstable = min(0.0, buoy_flux(i,j)) ! Negative for unstable if (CS%omega_frac >= 1.0) then ; absf(i) = 2.0*CS%omega else absf(i) = 0.25*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & - (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) + (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) if (CS%omega_frac > 0.0) & absf(i) = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf(i)**2) endif @@ -624,6 +626,20 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & ! Inverse of Ekman and Obukhov iL_Ekman = absf(i) / U_star iL_Obukhov = buoy_flux(i,j)*vonkar / (U_star**3) + if (CS%USE_LT) then + Ekman_o_Obukhov_stab = abs(max(0., iL_Obukhov / (iL_Ekman + 1.e-10*GV%Z_to_m))) + Ekman_o_Obukhov_un = abs(min(0., iL_Obukhov / (iL_Ekman + 1.e-10*GV%Z_to_m))) + !### Consider recoding this as... + ! Max_ratio = 1.0e16 + ! Ekman_Obukhov = Max_ratio + ! if (abs(buoy_flux(i,j)*vonkar) < Max_ratio*(absf(i) * U_star**2)) & + ! Ekman_Obukhov = buoy_flux(i,j)*vonkar / (absf(i) * U_star**2) + ! if (buoy_flux(i,j) > 0.0) then + ! Ekman_o_Obukhov_stab = Ekman_Obukhov ; Ekman_o_Obukhov_un = 0.0 + ! else + ! Ekman_o_Obukhov_un = Ekman_Obukhov ; Ekman_o_Obukhov_stab = 0.0 + ! endif + endif if (CS%Mstar_Mode == CS%CONST_MSTAR) then mech_TKE(i) = (dt*CS%mstar*GV%Rho0) * GV%Z_to_m**3 * U_star**3 @@ -663,16 +679,17 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & hb_hs(i,K) = h_bot * I_hs enddo - pres(i,1) = 0.0 + pres(i,1) = 0.0 ; pres_Z(i,1) = 0.0 do k=1,nz dMass = GV%H_to_kg_m2 * h(i,k) dPres = (GV%g_Earth*GV%m_to_Z) * dMass ! This is equivalent to GV%H_to_Pa * h(i,k) dT_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dT(i,j,k) dS_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dS(i,j,k) - dT_to_dColHt(i,k) = dMass * dSV_dT(i,j,k) - dS_to_dColHt(i,k) = dMass * dSV_dS(i,j,k) + dT_to_dColHt(i,k) = dMass * GV%m_to_Z * dSV_dT(i,j,k) + dS_to_dColHt(i,k) = dMass * GV%m_to_Z * dSV_dS(i,j,k) pres(i,K+1) = pres(i,K) + dPres + pres_Z(i,K+1) = GV%Z_to_m * pres(i,K+1) enddo ! endif ; enddo @@ -722,6 +739,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & ! First solve for the TKE to PE length scale if (CS%MSTAR_MODE == CS%MLD_o_OBUKHOV) then MLD_over_Stab = MLD_guess / Stab_Scale - CS%MSTAR_XINT + !### MLD_over_Stab = (MLD_guess * (VonKar * (C_MO*BF_Stable - C_EK*U_star**2*absf(i)))) / & + !### U_star**3 - CS%MSTAR_XINT if ((MLD_over_Stab) <= 0.0) then !Asymptote to 0 as MLD_over_Stab -> -infinity (always) MSTAR_mix = (CS%MSTAR_B*(MLD_over_Stab)+CS%MSTAR_A)**(CS%MSTAR_N) @@ -745,26 +764,19 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & endif elseif (CS%MSTAR_MODE == CS%EKMAN_o_OBUKHOV) then !### Please refrain from using the construct A / B / C in place of A/(B*C). + ! The limit for the balance of rotation and stabilizing is f(L_Ekman,L_Obukhov) mstar_STAB = CS%MSTAR_COEF*sqrt(Bf_Stable / U_star**2 / (absf(i)+1.e-10)) + !### Should be mstar_STAB = CS%MSTAR_COEF*sqrt(Bf_Stable / (U_star**2 * (absf(i)+1.e-10))) + ! The limit for rotation (Ekman length) limited mixin mstar_ROT = CS%C_EK * log(max(1., U_star / (absf(i)+1.e-10) / MLD_guess)) - if ( CS%MSTAR_CAP <= 0.0) then !No cap. - MSTAR_MIX = max(mstar_STAB,& ! 1st term if balance of rotation and stabilizing - ! the balance is f(L_Ekman,L_Obukhov) - min(& ! 2nd term for forced stratification limited - 1.25,& !.5/von Karman (Obukhov limit) - ! 3rd term for rotation (Ekman length) limited - mstar_ROT)) - else - MSTAR_MIX = min( & ! Sets a cap. The cap should be large and just - ! meant to be a safety net. - CS%MSTAR_CAP, & - max(mstar_STAB,& ! 1st term if balance of rotation and stabilizing - ! the balance is f(L_Ekman,L_Obukhov) - min(& ! 2nd term for forced stratification limited - 1.25,& !.5/von Karman (Obukhov limit) - ! 3rd term for rotation (Ekman length) limited - mstar_ROT))) - endif!cap for mstar_mode==2 + !### Consider rewriting the expression for mstar_ROT as: + ! mstar_Rot = 0.0 + ! if (Ustar > absf(i) * MLD_guess) & + ! mstar_ROT = CS%C_EK * log(U_star / (absf(i) * MLD_guess)) + ! Here 1.25 is .5/von Karman, which gives the Obukhov limit. + MSTAR_MIX = max(mstar_STAB, min(1.25, mstar_ROT)) + + if (CS%MSTAR_CAP > 0.0) MSTAR_MIX = min(CS%MSTAR_CAP, MSTAR_MIX) endif!mstar_mode==1 or ==2 ! Adjustment for unstable buoyancy flux. ! Convection reduces mechanical mixing because there @@ -772,6 +784,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & MSTAR_Conv_Adj = 1. - CS%CNV_MST_FAC * (-BF_Unstable + 1.e-10*GV%m_to_Z**2) / & ( (-Bf_Unstable + 1.e-10*GV%m_to_Z**2) + & 2.0 *MSTAR_MIX * U_star**3 / MLD_guess ) + ! MSTAR_Conv_Adj = 1. - CS%CNV_MST_FAC * ((-BF_Unstable + 1.e-10*GV%m_to_Z**2)*MLD_guess) / & + ! ( (-Bf_Unstable + 1.e-10*GV%m_to_Z**2)*MLD_guess + & + ! 2.0*MSTAR_MIX * U_star**3 ) if (CS%USE_LT) then call get_Langmuir_Number( LA, G, GV, abs(MLD_guess), u_star_mean, i, j, & H=H(i,:), U_H=U(i,:), V_H=V(i,:), WAVES=WAVES) @@ -779,8 +794,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & MLD_o_Ekman = abs(MLD_guess * iL_Ekman) MLD_o_Obukhov_stab = abs(max(0., MLD_guess*iL_Obukhov)) MLD_o_Obukhov_un = abs(min(0., MLD_guess*iL_Obukhov)) - Ekman_o_Obukhov_stab = abs(max(0., iL_Obukhov / (iL_Ekman + 1.e-10*GV%Z_to_m))) - Ekman_o_Obukhov_un = abs(min(0., iL_Obukhov / (iL_Ekman + 1.e-10*GV%Z_to_m))) ! 3. Adjust LA based on various parameters. ! Assumes linear factors based on length scale ratios to adjust LA ! Note when these coefficients are set to 0 recovers simple LA. @@ -792,10 +805,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & if (CS%LT_Enhance_Form==1) then !Original w'/ust scaling w/ Van Roekel et al. 2012 scaling ! NOTE we know now that this is not the right way to scale M. - ENHANCE_M = (1+(1.4*LA)**(-2)+(5.4*LA)**(-4))**(1.5) + ENHANCE_M = (1. + (1.4*LA)**(-2) + (5.4*LA)**(-4))**(1.5) elseif (CS%LT_Enhance_Form==2) then ! Enhancement is multiplied (added mst_lt set to 0) - ENHANCE_M = min(CS%Max_Enhance_M,(1.+CS%LT_ENHANCE_COEF*LAmod**CS%LT_ENHANCE_EXP)) + ENHANCE_M = min(CS%Max_Enhance_M, (1. + CS%LT_ENHANCE_COEF*LAmod**CS%LT_ENHANCE_EXP)) MSTAR_LT = 0.0 elseif (CS%LT_ENHANCE_Form == 3) then ! or Enhancement is additive (multiplied enhance_m set to 1) @@ -1050,7 +1063,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & if (TKE_here > 0.0) then vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 hbs_here = GV%H_to_Z * min(hb_hs(i,K), MixLen_shape(K)) - Mixing_Length_Used(k) = MAX(CS%min_mix_len,((h_tt*hbs_here)*vstar) / & + Mixing_Length_Used(k) = MAX(CS%min_mix_len, ((h_tt*hbs_here)*vstar) / & ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar)) !Note setting Kd_guess0 to Mixing_Length_Used(K) here will ! change the answers. Therefore, skipping that. @@ -1070,7 +1083,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & call find_PE_chg_orig(Kddt_h_g0, h(i,k), hp_a(i), dTe_term, dSe_term, & dT_km1_t2, dS_km1_t2, dT_to_dPE(i,k), dS_to_dPE(i,k), & dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), & - pres(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & + pres_Z(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & dPEc_dKd_0=dPEc_dKd_Kd0 ) @@ -1078,7 +1091,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & call find_PE_chg(0.0, Kddt_h_g0, hp_a(i), h(i,k), & Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), dT_to_dPE(i,k), dS_to_dPE(i,k), & - pres(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & + pres_Z(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & dT_to_dColHt(i,k), dS_to_dColHt(i,k), & PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & dPEc_dKd_0=dPEc_dKd_Kd0 ) @@ -1121,14 +1134,14 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & call find_PE_chg_orig(Kd(i,k)*dt_h, h(i,k), hp_a(i), dTe_term, dSe_term, & dT_km1_t2, dS_km1_t2, dT_to_dPE(i,k), dS_to_dPE(i,k), & dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), & - pres(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & + pres_Z(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & PE_chg=dPE_conv) else call find_PE_chg(0.0, Kd(i,k)*dt_h, hp_a(i), h(i,k), & Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), dT_to_dPE(i,k), dS_to_dPE(i,k), & - pres(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & + pres_Z(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & dT_to_dColHt(i,k), dS_to_dColHt(i,k), & PE_chg=dPE_conv) endif @@ -1208,14 +1221,14 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & call find_PE_chg_orig(Kddt_h_guess, h(i,k), hp_a(i), dTe_term, dSe_term, & dT_km1_t2, dS_km1_t2, dT_to_dPE(i,k), dS_to_dPE(i,k), & dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), & - pres(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & + pres_Z(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & PE_chg=PE_chg, dPEc_dKd=dPEc_dKd ) else call find_PE_chg(0.0, Kddt_h_guess, hp_a(i), h(i,k), & Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), dT_to_dPE(i,k), dS_to_dPE(i,k), & - pres(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & + pres_Z(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & dT_to_dColHt(i,k), dS_to_dColHt(i,k), & PE_chg=dPE_conv) endif @@ -1457,7 +1470,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & if (allocated(CS%Ekman_Obukhov)) CS%Ekman_Obukhov(i,j) = iL_Obukhov / (iL_Ekman + 1.e-10*GV%Z_to_m) if (allocated(CS%La)) CS%La(i,j) = LA if (allocated(CS%La_mod)) CS%La_mod(i,j) = LAmod - else + else ! End of the ocean-point part of the i-loop ! For masked points, Kd_int must still be set (to 0) because it has intent out. do K=1,nz+1 Kd(i,K) = 0. @@ -1468,7 +1481,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & if (present(dS_expected)) then do k=1,nz ; dS_expected(i,j,k) = 0.0 ; enddo endif - endif ; enddo ; ! Close of i-loop - Note unusual loop order! + endif ; enddo ! Close of i-loop - Note unusual loop order! if (CS%id_Hsfc_used > 0) then do i=is,ie ; Hsfc_used(i,j) = h(i,1)*GV%H_to_Z ; enddo @@ -1532,7 +1545,7 @@ end subroutine energetic_PBL !! for several changes in an interfaces's diapycnal diffusivity times a timestep. subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & dT_to_dPE_a, dS_to_dPE_a, dT_to_dPE_b, dS_to_dPE_b, & - pres, dT_to_dColHt_a, dS_to_dColHt_a, dT_to_dColHt_b, dS_to_dColHt_b, & + pres_Z, dT_to_dColHt_a, dS_to_dColHt_a, dT_to_dColHt_b, dS_to_dColHt_b, & PE_chg, dPEc_dKd, dPE_max, dPEc_dKd_0, ColHt_cor) real, intent(in) :: Kddt_h0 !< The previously used diffusivity at an interface times !! the time step and divided by the average of the @@ -1576,25 +1589,25 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & !! a layer's salinity change to the change in column !! potential energy, including all implicit diffusive changes !! in the salinities of all the layers below, in J m-2 ppt-1. - real, intent(in) :: pres !< The hydrostatic interface pressure, which is used to relate + real, intent(in) :: pres_Z !< The rescaled hydrostatic interface pressure, which relates !! the changes in column thickness to the energy that is radiated - !! as gravity waves and unavailable to drive mixing, in Pa. + !! as gravity waves and unavailable to drive mixing, in J m-2 Z-1. real, intent(in) :: dT_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers above, in m K-1. + !! in the temperatures of all the layers above, in Z K-1. real, intent(in) :: dS_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers above, in m ppt-1. + !! in the salinities of all the layers above, in Z ppt-1. real, intent(in) :: dT_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers below, in m K-1. + !! in the temperatures of all the layers below, in Z K-1. real, intent(in) :: dS_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers below, in m ppt-1. + !! in the salinities of all the layers below, in Z ppt-1. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying !! Kddt_h at the present interface, in J m-2. @@ -1642,11 +1655,11 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & y1 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) PE_chg = PEc_core * y1 ColHt_chg = ColHt_core * y1 - if (ColHt_chg < 0.0) PE_chg = PE_chg - pres * ColHt_chg - if (present(ColHt_cor)) ColHt_cor = -pres * min(ColHt_chg, 0.0) + if (ColHt_chg < 0.0) PE_chg = PE_chg - pres_Z * ColHt_chg + if (present(ColHt_cor)) ColHt_cor = -pres_Z * min(ColHt_chg, 0.0) elseif (present(ColHt_cor)) then y1 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) - ColHt_cor = -pres * min(ColHt_core * y1, 0.0) + ColHt_cor = -pres_Z * min(ColHt_core * y1, 0.0) endif if (present(dPEc_dKd)) then @@ -1654,7 +1667,7 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & y1 = 1.0 / (bdt1 + dKddt_h * hps)**2 dPEc_dKd = PEc_core * y1 ColHt_chg = ColHt_core * y1 - if (ColHt_chg < 0.0) dPEc_dKd = dPEc_dKd - pres * ColHt_chg + if (ColHt_chg < 0.0) dPEc_dKd = dPEc_dKd - pres_Z * ColHt_chg endif if (present(dPE_max)) then @@ -1662,7 +1675,7 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & y1 = 1.0 / (bdt1 * hps) dPE_max = PEc_core * y1 ColHt_chg = ColHt_core * y1 - if (ColHt_chg < 0.0) dPE_max = dPE_max - pres * ColHt_chg + if (ColHt_chg < 0.0) dPE_max = dPE_max - pres_Z * ColHt_chg endif if (present(dPEc_dKd_0)) then @@ -1670,7 +1683,7 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & y1 = 1.0 / bdt1**2 dPEc_dKd_0 = PEc_core * y1 ColHt_chg = ColHt_core * y1 - if (ColHt_chg < 0.0) dPEc_dKd_0 = dPEc_dKd_0 - pres * ColHt_chg + if (ColHt_chg < 0.0) dPEc_dKd_0 = dPEc_dKd_0 - pres_Z * ColHt_chg endif end subroutine find_PE_chg @@ -1680,7 +1693,7 @@ end subroutine find_PE_chg !! using the original form used in the first version of ePBL. subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & dT_km1_t2, dS_km1_t2, dT_to_dPE_k, dS_to_dPE_k, & - dT_to_dPEa, dS_to_dPEa, pres, dT_to_dColHt_k, & + dT_to_dPEa, dS_to_dPEa, pres_Z, dT_to_dColHt_k, & dS_to_dColHt_k, dT_to_dColHta, dS_to_dColHta, & PE_chg, dPEc_dKd, dPE_max, dPEc_dKd_0) real, intent(in) :: Kddt_h !< The diffusivity at an interface times the time step and @@ -1699,9 +1712,9 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & !! temperature change in the layer above the interface, in K. real, intent(in) :: dS_km1_t2 !< A diffusivity-independent term related to the !! salinity change in the layer above the interface, in ppt. - real, intent(in) :: pres !< The hydrostatic interface pressure, which is used to relate + real, intent(in) :: pres_Z !< The rescaled hydrostatic interface pressure, which relates !! the changes in column thickness to the energy that is radiated - !! as gravity waves and unavailable to drive mixing, in Pa. + !! as gravity waves and unavailable to drive mixing, in J m-2 Z-1. real, intent(in) :: dT_to_dPE_k !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column !! potential energy, including all implicit diffusive changes @@ -1721,19 +1734,19 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & real, intent(in) :: dT_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers below, in m K-1. + !! in the temperatures of all the layers below, in Z K-1. real, intent(in) :: dS_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers below, in m ppt-1. + !! in the salinities of all the layers below, in Z ppt-1. real, intent(in) :: dT_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers above, in m K-1. + !! in the temperatures of all the layers above, in Z K-1. real, intent(in) :: dS_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers above, in m ppt-1. + !! in the salinities of all the layers above, in Z ppt-1. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying !! Kddt_h at the present interface, in J m-2. @@ -1787,7 +1800,7 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & (dS_to_dPE_k * dS_k + dS_to_dPEa * dS_km1) ColHt_chg = (dT_to_dColHt_k * dT_k + dT_to_dColHta * dT_km1) + & (dS_to_dColHt_k * dS_k + dS_to_dColHta * dS_km1) - if (ColHt_chg < 0.0) PE_chg = PE_chg - pres * ColHt_chg + if (ColHt_chg < 0.0) PE_chg = PE_chg - pres_Z * ColHt_chg endif if (present(dPEc_dKd)) then @@ -1804,7 +1817,7 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & (dS_to_dPE_k * ddS_k_dKd + dS_to_dPEa * ddS_km1_dKd) dColHt_dKd = (dT_to_dColHt_k * ddT_k_dKd + dT_to_dColHta * ddT_km1_dKd) + & (dS_to_dColHt_k * ddS_k_dKd + dS_to_dColHta * ddS_km1_dKd) - if (dColHt_dKd < 0.0) dPEc_dKd = dPEc_dKd - pres * dColHt_dKd + if (dColHt_dKd < 0.0) dPEc_dKd = dPEc_dKd - pres_Z * dColHt_dKd endif if (present(dPE_max)) then @@ -1815,7 +1828,7 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & dColHt_max = (dT_to_dColHta * dT_km1_t2 + dS_to_dColHta * dS_km1_t2) + & ((dT_to_dColHt_k + dT_to_dColHta) * dTe_term + & (dS_to_dColHt_k + dS_to_dColHta) * dSe_term) / (b_den_1 + h_k) - if (dColHt_max < 0.0) dPE_max = dPE_max - pres*dColHt_max + if (dColHt_max < 0.0) dPE_max = dPE_max - pres_Z*dColHt_max endif if (present(dPEc_dKd_0)) then @@ -1824,7 +1837,7 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & (dT_to_dPE_k * dTe_term + dS_to_dPE_k * dSe_term) / (h_k*b_den_1) dColHt_dKd = (dT_to_dColHta * dT_km1_t2 + dS_to_dColHta * dS_km1_t2) / (b_den_1) + & (dT_to_dColHt_k * dTe_term + dS_to_dColHt_k * dSe_term) / (h_k*b_den_1) - if (dColHt_dKd < 0.0) dPEc_dKd_0 = dPEc_dKd_0 - pres*dColHt_dKd + if (dColHt_dKd < 0.0) dPEc_dKd_0 = dPEc_dKd_0 - pres_Z*dColHt_dKd endif end subroutine find_PE_chg_orig From 1cfc3841b8c988603e43224c9d2211c933002b39 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Tue, 30 Oct 2018 11:17:34 -0400 Subject: [PATCH 0868/1072] Downsample Diagnostics, fix symmetric memory case - This updates fixes the symetric memory case. By hook or by crook, the downsampled diagnostics now run for both symmetric and non-symmetric memory cases. --- src/core/MOM_grid.F90 | 7 +- src/framework/MOM_diag_mediator.F90 | 292 +++++++++++++++------------- 2 files changed, 159 insertions(+), 140 deletions(-) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 39aa9290f0..a08c6c4c6c 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -350,12 +350,17 @@ subroutine MOM_grid_init(G, param_file, HI, global_indexing, bathymetry_at_vel) G%HId2%isg, G%HId2%ieg, G%HId2%jsg, G%HId2%jeg) ! Set array sizes for fields that are discretized at tracer cell boundaries. - G%HId2%IegB = G%HId2%ieg ; G%HId2%JegB = G%HId2%jeg + G%HId2%IscB = G%HId2%isc ; G%HId2%JscB = G%HId2%jsc G%HId2%IsdB = G%HId2%isd ; G%HId2%JsdB = G%HId2%jsd + G%HId2%IsgB = G%HId2%isg ; G%HId2%JsgB = G%HId2%jsg if (G%symmetric) then + G%HId2%IscB = G%HId2%isc-1 ; G%HId2%JscB = G%HId2%jsc-1 G%HId2%IsdB = G%HId2%isd-1 ; G%HId2%JsdB = G%HId2%jsd-1 + G%HId2%IsgB = G%HId2%isg-1 ; G%HId2%JsgB = G%HId2%jsg-1 endif + G%HId2%IecB = G%HId2%iec ; G%HId2%JecB = G%HId2%jec G%HId2%IedB = G%HId2%ied ; G%HId2%JedB = G%HId2%jed + G%HId2%IegB = G%HId2%ieg ; G%HId2%JegB = G%HId2%jeg end subroutine MOM_grid_init diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 8ba54ba997..1f58e1489e 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -73,7 +73,7 @@ module MOM_diag_mediator end interface downsample_field interface downsample_mask - module procedure downsample_mask_2d_p, downsample_mask_3d_p, downsample_mask_2d_a, downsample_mask_3d_a + module procedure downsample_mask_2d, downsample_mask_3d end interface downsample_mask interface downsample_diag_field @@ -160,6 +160,7 @@ module MOM_diag_mediator integer :: MMS=221 !< x:mean,y:mean,z:sum integer :: SSS=111 !< x:sum,y:sum,z:sum integer :: MMM=222 !< x:mean,y:mean,z:mean +integer :: MSK=-1 !< Use the downsample method of a mask !> This type is used to represent a diagnostic at the diag_mediator level. !! @@ -193,6 +194,7 @@ module MOM_diag_mediator integer :: jsd !< The start j-index of cell centers within the data domain integer :: jed !< The end j-index of cell centers within the data domain integer :: isg,ieg,jsg,jeg + integer :: isgB,iegB,jsgB,jegB type(axes_grp) :: axesBL, axesTL, axesCuL, axesCvL type(axes_grp) :: axesBi, axesTi, axesCui, axesCvi @@ -524,34 +526,38 @@ subroutine set_axes_info_dsamp(G, GV, param_file, diag_cs, id_zl_native, id_zi_n !Axes group for native downsampled diagnostics do dl=2,MAX_DSAMP_LEV if(dl .ne. 2) call MOM_error(FATAL, "set_axes_info_dsamp: Downsample level other than 2 is not supported yet!") + if (G%symmetric) then + allocate(gridLonB_dsamp(diag_cs%dsamp(dl)%isgB:diag_cs%dsamp(dl)%iegB)) + allocate(gridLatB_dsamp(diag_cs%dsamp(dl)%jsgB:diag_cs%dsamp(dl)%jegB)) + do i=diag_cs%dsamp(dl)%isgB,diag_cs%dsamp(dl)%iegB; gridLonB_dsamp(i) = G%gridLonB(G%isgB+dl*i); enddo + do j=diag_cs%dsamp(dl)%jsgB,diag_cs%dsamp(dl)%jegB; gridLatB_dsamp(j) = G%gridLatB(G%jsgB+dl*j); enddo + id_xq = diag_axis_init('xq', gridLonB_dsamp, G%x_axis_units, 'x', & + 'q point nominal longitude', Domain2=G%Domain%mpp_domain_d2) + id_yq = diag_axis_init('yq', gridLatB_dsamp, G%y_axis_units, 'y', & + 'q point nominal latitude', Domain2=G%Domain%mpp_domain_d2) + deallocate(gridLonB_dsamp,gridLatB_dsamp) + else + allocate(gridLonB_dsamp(diag_cs%dsamp(dl)%isg:diag_cs%dsamp(dl)%ieg)) + allocate(gridLatB_dsamp(diag_cs%dsamp(dl)%jsg:diag_cs%dsamp(dl)%jeg)) + do i=diag_cs%dsamp(dl)%isg,diag_cs%dsamp(dl)%ieg; gridLonB_dsamp(i) = G%gridLonB(G%isg+dl*i-2); enddo + do j=diag_cs%dsamp(dl)%jsg,diag_cs%dsamp(dl)%jeg; gridLatB_dsamp(j) = G%gridLatB(G%jsg+dl*j-2); enddo + id_xq = diag_axis_init('xq', gridLonB_dsamp, G%x_axis_units, 'x', & + 'q point nominal longitude', Domain2=G%Domain%mpp_domain_d2) + id_yq = diag_axis_init('yq', gridLatB_dsamp, G%y_axis_units, 'y', & + 'q point nominal latitude', Domain2=G%Domain%mpp_domain_d2) + deallocate(gridLonB_dsamp,gridLatB_dsamp) + endif + allocate(gridLonT_dsamp(diag_cs%dsamp(dl)%isg:diag_cs%dsamp(dl)%ieg)) allocate(gridLatT_dsamp(diag_cs%dsamp(dl)%jsg:diag_cs%dsamp(dl)%jeg)) do i=diag_cs%dsamp(dl)%isg,diag_cs%dsamp(dl)%ieg; gridLonT_dsamp(i) = G%gridLonT(G%isg+dl*i-2); enddo do j=diag_cs%dsamp(dl)%jsg,diag_cs%dsamp(dl)%jeg; gridLatT_dsamp(j) = G%gridLatT(G%jsg+dl*j-2); enddo - allocate(gridLonB_dsamp(diag_cs%dsamp(dl)%isg:diag_cs%dsamp(dl)%ieg)) - allocate(gridLatB_dsamp(diag_cs%dsamp(dl)%jsg:diag_cs%dsamp(dl)%jeg)) - do i=diag_cs%dsamp(dl)%isg,diag_cs%dsamp(dl)%ieg; gridLonB_dsamp(i) = G%gridLonB(G%isg+dl*i-2); enddo - do j=diag_cs%dsamp(dl)%jsg,diag_cs%dsamp(dl)%jeg; gridLatB_dsamp(j) = G%gridLatB(G%jsg+dl*j-2); enddo - -!I don't see a need for this since isgB=isg and iegB=ieg -! if (G%symmetric) then -! id_xq = diag_axis_init('xq', gridLonB_dsamp(G%isgB:G%iegB), G%x_axis_units, 'x', & -! 'q point nominal longitude', Domain2=G%Domain%mpp_domain_d2) -! id_yq = diag_axis_init('yq', gridLatB_dsamp(G%jsgB:G%jegB), G%y_axis_units, 'y', & -! 'q point nominal latitude', Domain2=G%Domain%mpp_domain_d2) -! else - id_xq = diag_axis_init('xq', gridLonB_dsamp, G%x_axis_units, 'x', & - 'q point nominal longitude', Domain2=G%Domain%mpp_domain_d2) - id_yq = diag_axis_init('yq', gridLatB_dsamp, G%y_axis_units, 'y', & - 'q point nominal latitude', Domain2=G%Domain%mpp_domain_d2) -! endif id_xh = diag_axis_init('xh', gridLonT_dsamp, G%x_axis_units, 'x', & 'h point nominal longitude', Domain2=G%Domain%mpp_domain_d2) id_yh = diag_axis_init('yh', gridLatT_dsamp, G%y_axis_units, 'y', & 'h point nominal latitude', Domain2=G%Domain%mpp_domain_d2) deallocate(gridLonT_dsamp,gridLatT_dsamp) - deallocate(gridLonB_dsamp,gridLatB_dsamp) ! Axis groupings for the model layers call define_axes_group_dsamp(diag_cs, (/ id_xh, id_yh, id_zL /), diag_cs%dsamp(dl)%axesTL, dl, & @@ -789,35 +795,43 @@ subroutine set_masks_for_axes_dsamp(G, diag_cs) do c=1, diag_cs%num_diag_coords ! Level/layer h-points in diagnostic coordinate axes => diag_cs%remap_axesTL(c) - call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesTL(c)%dsamp(dl)%mask3d, dl)!set downsampled mask + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesTL(c)%dsamp(dl)%mask3d, dl,G%isc, G%jsc, & + G%HId2%isc, G%HId2%iec, G%HId2%jsc, G%HId2%jec, G%HId2%isd, G%HId2%ied, G%HId2%jsd, G%HId2%jed) diag_cs%dsamp(dl)%remap_axesTL(c)%mask3d => axes%mask3d !set non-downsampled mask ! Level/layer u-points in diagnostic coordinate axes => diag_cs%remap_axesCuL(c) - call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesCuL(c)%dsamp(dl)%mask3d, dl)!set downsampled mask + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesCuL(c)%dsamp(dl)%mask3d, dl,G%IscB,G%JscB, & + G%HId2%IscB,G%HId2%IecB,G%HId2%jsc, G%HId2%jec,G%HId2%IsdB,G%HId2%IedB,G%HId2%jsd, G%HId2%jed) diag_cs%dsamp(dl)%remap_axesCul(c)%mask3d => axes%mask3d !set non-downsampled mask ! Level/layer v-points in diagnostic coordinate axes => diag_cs%remap_axesCvL(c) - call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesCvL(c)%dsamp(dl)%mask3d, dl)!set downsampled mask + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesCvL(c)%dsamp(dl)%mask3d, dl,G%isc ,G%JscB, & + G%HId2%isc ,G%HId2%iec, G%HId2%JscB,G%HId2%JecB,G%HId2%isd ,G%HId2%ied, G%HId2%JsdB,G%HId2%JedB) diag_cs%dsamp(dl)%remap_axesCvL(c)%mask3d => axes%mask3d !set non-downsampled mask ! Level/layer q-points in diagnostic coordinate axes => diag_cs%remap_axesBL(c) - call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesBL(c)%dsamp(dl)%mask3d, dl)!set downsampled mask + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesBL(c)%dsamp(dl)%mask3d, dl,G%IscB,G%JscB, & + G%HId2%IscB,G%HId2%IecB,G%HId2%JscB,G%HId2%JecB,G%HId2%IsdB,G%HId2%IedB,G%HId2%JsdB,G%HId2%JedB) diag_cs%dsamp(dl)%remap_axesBL(c)%mask3d => axes%mask3d !set non-downsampled mask ! Interface h-points in diagnostic coordinate (w-point) axes => diag_cs%remap_axesTi(c) - call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesTi(c)%dsamp(dl)%mask3d, dl)!set downsampled mask + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesTi(c)%dsamp(dl)%mask3d, dl,G%isc, G%jsc, & + G%HId2%isc, G%HId2%iec, G%HId2%jsc, G%HId2%jec, G%HId2%isd, G%HId2%ied, G%HId2%jsd, G%HId2%jed) diag_cs%dsamp(dl)%remap_axesTi(c)%mask3d => axes%mask3d !set non-downsampled mask ! Interface u-points in diagnostic coordinate axes => diag_cs%remap_axesCui(c) - call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesCui(c)%dsamp(dl)%mask3d, dl)!set downsampled mask + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesCui(c)%dsamp(dl)%mask3d, dl,G%IscB,G%JscB, & + G%HId2%IscB,G%HId2%IecB,G%HId2%jsc, G%HId2%jec,G%HId2%IsdB,G%HId2%IedB,G%HId2%jsd, G%HId2%jed) diag_cs%dsamp(dl)%remap_axesCui(c)%mask3d => axes%mask3d !set non-downsampled mask ! Interface v-points in diagnostic coordinate axes => diag_cs%remap_axesCvi(c) - call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesCvi(c)%dsamp(dl)%mask3d, dl)!set downsampled mask + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesCvi(c)%dsamp(dl)%mask3d, dl,G%isc ,G%JscB, & + G%HId2%isc ,G%HId2%iec, G%HId2%JscB,G%HId2%JecB,G%HId2%isd ,G%HId2%ied, G%HId2%JsdB,G%HId2%JedB) diag_cs%dsamp(dl)%remap_axesCvi(c)%mask3d => axes%mask3d !set non-downsampled mask ! Interface q-points in diagnostic coordinate axes => diag_cs%remap_axesBi(c) - call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesBi(c)%dsamp(dl)%mask3d, dl)!set downsampled mask + call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesBi(c)%dsamp(dl)%mask3d, dl,G%IscB,G%JscB, & + G%HId2%IscB,G%HId2%IecB,G%HId2%JscB,G%HId2%JecB,G%HId2%IsdB,G%HId2%IedB,G%HId2%JsdB,G%HId2%JedB)!set downsampled mask diag_cs%dsamp(dl)%remap_axesBi(c)%mask3d => axes%mask3d !set non-downsampled mask enddo enddo @@ -1283,7 +1297,7 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) character(len=300) :: mesg logical :: used, is_stat integer :: cszi, cszj, dszi, dszj - integer :: isv, iev, jsv, jev, i, j, chksum + integer :: isv, iev, jsv, jev, i, j, chksum, isv_o,jsv_o real, dimension(:,:), allocatable, target :: locfield_dsamp real, dimension(:,:), allocatable, target :: locmask_dsamp integer :: dl @@ -1353,11 +1367,12 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) if(.NOT. is_stat) dl = diag%axes%downsample_level !static field downsample i not supported yet !Downsample the diag field and mask (if present) if (dl > 1) then + isv_o=isv ; jsv_o=jsv call downsample_diag_field(locfield, locfield_dsamp, dl, diag_cs, diag,isv,iev,jsv,jev, mask) if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) deallocate( locfield ) locfield => locfield_dsamp if (present(mask)) then - call downsample_mask(locmask, locmask_dsamp, dl) + call downsample_field_2d(locmask, locmask_dsamp, dl, MSK, locmask, diag_cs,diag,isv_o,jsv_o,isv,iev,jsv,jev) locmask => locmask_dsamp elseif(associated(diag%axes%dsamp(dl)%mask2d)) then locmask => diag%axes%dsamp(dl)%mask2d @@ -1538,11 +1553,11 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) logical :: staggered_in_x, staggered_in_y logical :: is_stat integer :: cszi, cszj, dszi, dszj - integer :: isv, iev, jsv, jev, ks, ke, i, j, k, isv_c, jsv_c + integer :: isv, iev, jsv, jev, ks, ke, i, j, k, isv_c, jsv_c, isv_o,jsv_o integer :: chksum real, dimension(:,:,:), allocatable, target :: locfield_dsamp real, dimension(:,:,:), allocatable, target :: locmask_dsamp - integer :: isl,iel,jsl,jel,dl + integer :: dl locfield => NULL() locmask => NULL() @@ -1626,11 +1641,12 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) if(.NOT. is_stat) dl = diag%axes%downsample_level !static field downsample i not supported yet !Downsample the diag field and mask (if present) if (dl > 1) then + isv_o=isv ; jsv_o=jsv call downsample_diag_field(locfield, locfield_dsamp, dl, diag_cs, diag,isv,iev,jsv,jev, mask) if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) deallocate( locfield ) locfield => locfield_dsamp if (present(mask)) then - call downsample_mask(locmask, locmask_dsamp, dl) + call downsample_field_3d(locmask, locmask_dsamp, dl, MSK, locmask, diag_cs,diag,isv_o,jsv_o,isv,iev,jsv,jev) locmask => locmask_dsamp elseif(associated(diag%axes%dsamp(dl)%mask3d)) then locmask => diag%axes%dsamp(dl)%mask3d @@ -2935,6 +2951,8 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir) diag_cs%dsamp(2)%jsd = G%HId2%jsd ; diag_cs%dsamp(2)%jed = G%HId2%jed diag_cs%dsamp(2)%isg = G%HId2%isg ; diag_cs%dsamp(2)%ieg = G%HId2%ieg diag_cs%dsamp(2)%jsg = G%HId2%jsg ; diag_cs%dsamp(2)%jeg = G%HId2%jeg + diag_cs%dsamp(2)%isgB = G%HId2%isgB ; diag_cs%dsamp(2)%iegB = G%HId2%iegB + diag_cs%dsamp(2)%jsgB = G%HId2%jsgB ; diag_cs%dsamp(2)%jegB = G%HId2%jegB ! Initialze available diagnostic log file if (is_root_pe() .and. (diag_CS%available_diag_doc_unit < 0)) then @@ -3457,20 +3475,29 @@ subroutine downsample_diag_masks_set(G, nz, diag_cs) integer :: i,j,k,ii,jj,dl !print*,'original c extents ',G%isc,G%iec,G%jsc,G%jec +!print*,'original c extents ',G%iscb,G%iecb,G%jscb,G%jecb !print*,'coarse c extents ',G%HId2%isc,G%HId2%iec,G%HId2%jsc,G%HId2%jec !print*,'original d extents ',G%isd,G%ied,G%jsd,G%jed !print*,'coarse d extents ',G%HId2%isd,G%HId2%ied,G%HId2%jsd,G%HId2%jed -! original c extents 5 52 5 52 +! original c extents 5 52 5 52 +! original cB-nonsym extents 5 52 5 52 +! original cB-sym extents 4 52 4 52 ! coarse c extents 3 26 3 26 ! original d extents 1 56 1 56 +! original dB-nonsym extents 1 56 1 56 +! original dB-sym extents 0 56 0 56 ! coarse d extents 1 28 1 28 do dl=2,MAX_DSAMP_LEV - ! 2d masks - call downsample_mask(G%mask2dT, diag_cs%dsamp(dl)%mask2dT, dl) - call downsample_mask(G%mask2dBu,diag_cs%dsamp(dl)%mask2dBu, dl) - call downsample_mask(G%mask2dCu,diag_cs%dsamp(dl)%mask2dCu, dl) - call downsample_mask(G%mask2dCv,diag_cs%dsamp(dl)%mask2dCv, dl) + ! 2d mask + call downsample_mask(G%mask2dT, diag_cs%dsamp(dl)%mask2dT, dl,G%isc, G%jsc, & + G%HId2%isc, G%HId2%iec, G%HId2%jsc, G%HId2%jec, G%HId2%isd, G%HId2%ied, G%HId2%jsd, G%HId2%jed) + call downsample_mask(G%mask2dBu,diag_cs%dsamp(dl)%mask2dBu, dl,G%IscB,G%JscB, & + G%HId2%IscB,G%HId2%IecB,G%HId2%JscB,G%HId2%JecB,G%HId2%IsdB,G%HId2%IedB,G%HId2%JsdB,G%HId2%JedB) + call downsample_mask(G%mask2dCu,diag_cs%dsamp(dl)%mask2dCu, dl,G%IscB,G%JscB, & + G%HId2%IscB,G%HId2%IecB,G%HId2%jsc, G%HId2%jec,G%HId2%IsdB,G%HId2%IedB,G%HId2%jsd, G%HId2%jed) + call downsample_mask(G%mask2dCv,diag_cs%dsamp(dl)%mask2dCv, dl,G%isc ,G%JscB, & + G%HId2%isc ,G%HId2%iec, G%HId2%JscB,G%HId2%JecB,G%HId2%isd ,G%HId2%ied, G%HId2%JsdB,G%HId2%JedB) ! 3d native masks are needed by diag_manager but the native variables ! can only be masked 2d - for ocean points, all layers exists. allocate(diag_cs%dsamp(dl)%mask3dTL(G%HId2%isd:G%HId2%ied,G%HId2%jsd:G%HId2%jed,1:nz)) @@ -3498,13 +3525,13 @@ end subroutine downsample_diag_masks_set !> Get the diagnostics-compute indices (to be passed to send_data) based on the shape of !! the diag field (the same way they are deduced for non-downsampled fields) -subroutine downsample_diag_indices_get(f1,f2, dl, diag_cs,isv,iev,jsv,jev) - integer, intent(in) :: f1,f2 !< the sizes of the diag field in x and y +subroutine downsample_diag_indices_get(fo1,fo2, dl, diag_cs,isv,iev,jsv,jev) + integer, intent(in) :: fo1,fo2 !< the sizes of the diag field in x and y integer, intent(in) :: dl !< integer downsample level type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output integer, intent(out) ::isv,iev,jsv,jev !< diagnostics-compute indices (to be passed to send_data) ! Local variables - integer :: dszi,cszi,dszj,cszj + integer :: dszi,cszi,dszj,cszj,f1,f2 character(len=500) :: mesg logical, save :: first_check = .true. @@ -3525,10 +3552,15 @@ subroutine downsample_diag_indices_get(f1,f2, dl, diag_cs,isv,iev,jsv,jev) cszi = diag_cs%dsamp(dl)%iec-diag_cs%dsamp(dl)%isc +1 ; dszi = diag_cs%dsamp(dl)%ied-diag_cs%dsamp(dl)%isd +1 cszj = diag_cs%dsamp(dl)%jec-diag_cs%dsamp(dl)%jsc +1 ; dszj = diag_cs%dsamp(dl)%jed-diag_cs%dsamp(dl)%jsd +1 - isv = diag_cs%dsamp(dl)%isc ; iev = diag_cs%dsamp(dl)%iec jsv = diag_cs%dsamp(dl)%jsc ; jev = diag_cs%dsamp(dl)%jec - + f1 = fo1/dl + f2 = fo2/dl + !Correction for the symmetric case + if (diag_cs%G%symmetric) then + f1 = f1 + mod(fo1,dl) + f2 = f2 + mod(fo2,dl) + endif if ( f1 == dszi ) then isv = diag_cs%dsamp(dl)%isc ; iev = diag_cs%dsamp(dl)%iec ! field on Data domain, take compute domain indcies !The rest is not taken with the full MOM6 diag_table @@ -3576,8 +3608,8 @@ subroutine downsample_diag_field_3d(locfield, locfield_dsamp, dl, diag_cs, diag, locmask => NULL() !Get the correct indices corresponding to input field !Shape of the input diag field - f1=size(locfield,1)/dl - f2=size(locfield,2)/dl + f1=size(locfield,1) + f2=size(locfield,2) !Save the extents of the original (fine) domain isv_o=isv;jsv_o=jsv !Get the shape of the downsampled field and overwrite isv,iev,jsv,jev with them @@ -3614,8 +3646,8 @@ subroutine downsample_diag_field_2d(locfield, locfield_dsamp, dl, diag_cs, diag, locmask => NULL() !Get the correct indices corresponding to input field !Shape of the input diag field - f1=size(locfield,1)/dl - f2=size(locfield,2)/dl + f1=size(locfield,1) + f2=size(locfield,2) !Save the extents of the original (fine) domain isv_o=isv;jsv_o=jsv !Get the shape of the downsampled field and overwrite isv,iev,jsv,jev with them @@ -3671,23 +3703,34 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d real, dimension(:,:,:) , pointer :: field_in real, dimension(:,:,:) , allocatable :: field_out integer , intent(in) :: dl - integer, intent(in) :: method !< sampling method, one of 00,01,02,10,20,11,22 - real, dimension(:,:,:), pointer :: mask + integer, intent(in) :: method !< sampling method + real, dimension(:,:,:), pointer :: mask type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post integer , intent(in) :: isv_o,jsv_o !< original indices, In practice isv_o=jsv_o=1 integer , intent(in) :: isv_d,iev_d,jsv_d,jev_d !< dsampaed indices !locals character(len=240) :: mesg - integer :: i,j,ii,jj,i0,j0 + integer :: i,j,ii,jj,i0,j0,f1,f2,f_in1,f_in2 integer :: k,ks,ke real :: ave,total_weight,weight real :: epsilon = 1.0e-20 ks=1 ; ke =size(field_in,3) !Allocate the downsampled field on the downsampled data domain - allocate(field_out(diag_cs%dsamp(dl)%isd:diag_cs%dsamp(dl)%ied,diag_cs%dsamp(dl)%jsd:diag_cs%dsamp(dl)%jed,ks:ke)) +! allocate(field_out(diag_cs%dsamp(dl)%isd:diag_cs%dsamp(dl)%ied,diag_cs%dsamp(dl)%jsd:diag_cs%dsamp(dl)%jed,ks:ke)) ! allocate(field_out(1:size(field_in,1)/dl,1:size(field_in,2)/dl,ks:ke)) + f_in1 = size(field_in,1) + f_in2 = size(field_in,2) + f1 = f_in1/dl + f2 = f_in2/dl + !Correction for the symmetric case + if (diag_cs%G%symmetric) then + f1 = f1 + mod(f_in1,dl) + f2 = f2 + mod(f_in2,dl) + endif + allocate(field_out(1:f1,1:f2,ks:ke)) + !Fill the downsampled field on the downsampled diagnostics (almost always compuate) domain if(method .eq. MMM) then !xyz_method = MMM = 222 do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d @@ -3801,6 +3844,17 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d enddo field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo + elseif(method .eq. MSK) then !The input field is a mask, subsample + field_out(:,:,:) = 0.0 + do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) + ave = 0.0 + do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 + ave=ave+field_in(ii,jj,k) + enddo; enddo + if(ave > 0.0) field_out(i,j,k)=1.0 + enddo; enddo; enddo else write (mesg,*) " unknown sampling method: ",method call MOM_error(FATAL, "downsample_field_3d: "//trim(mesg)//" "//trim(diag%debug_str)) @@ -3812,7 +3866,7 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs,di real, dimension(:,:) , pointer :: field_in real, dimension(:,:) , allocatable :: field_out integer , intent(in) :: dl - integer, optional, intent(in) :: method !< sampling method, one of 00,01,02,10,20,11,22 + integer, intent(in) :: method !< sampling method real, dimension(:,:), pointer :: mask type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post @@ -3820,14 +3874,24 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs,di integer , intent(in) :: isv_d,iev_d,jsv_d,jev_d !< dsampaed indices !locals character(len=240) :: mesg - integer :: i,j,ii,jj,i0,j0 + integer :: i,j,ii,jj,i0,j0,f1,f2,f_in1,f_in2 real :: ave,total_weight,weight real :: epsilon = 1.0e-20 !Allocate the downsampled field on the downsampled data domain - allocate(field_out(diag_cs%dsamp(dl)%isd:diag_cs%dsamp(dl)%ied,diag_cs%dsamp(dl)%jsd:diag_cs%dsamp(dl)%jed)) +! allocate(field_out(diag_cs%dsamp(dl)%isd:diag_cs%dsamp(dl)%ied,diag_cs%dsamp(dl)%jsd:diag_cs%dsamp(dl)%jed)) ! allocate(field_out(1:size(field_in,1)/dl,1:size(field_in,2)/dl)) !Fill the downsampled field on the downsampled diagnostics (almost always compuate) domain + f_in1 = size(field_in,1) + f_in2 = size(field_in,2) + f1 = f_in1/dl + f2 = f_in2/dl + !Correction for the symmetric case + if (diag_cs%G%symmetric) then + f1 = f1 + mod(f_in1,dl) + f2 = f2 + mod(f_in2,dl) + endif + allocate(field_out(1:f1,1:f2)) if(method .eq. MMP) then !xyz_method = MMP do j=jsv_d,jev_d ; do i=isv_d,iev_d @@ -3913,6 +3977,17 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs,di enddo field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo + elseif(method .eq. MSK) then !The input field is a mask, subsample + field_out(:,:) = 0.0 + do j=jsv_d,jev_d ; do i=isv_d,iev_d + i0 = isv_o+dl*(i-isv_d) + j0 = jsv_o+dl*(j-jsv_d) + ave = 0.0 + do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 + ave=ave+field_in(ii,jj) + enddo; enddo + if(ave > 0.0) field_out(i,j)=1.0 + enddo; enddo else write (mesg,*) " unknown sampling method: ",method call MOM_error(FATAL, "downsample_field_2d: "//trim(mesg)//" "//trim(diag%debug_str)) @@ -3923,113 +3998,52 @@ end subroutine downsample_field_2d !> Allocate and compute the downsampled masks !! The masks are downsampled based on a minority rule, i.e., a coarse cell is open (1) !! if at least one of the sub-cells are open, otherwise it's closed (0) -subroutine downsample_mask_3d_p(field_in, field_out, dl) - integer , intent(in) :: dl - real, dimension(:,:,:) , pointer :: field_in, field_out - integer :: i,j,ii,jj,i0,j0 - integer :: isv_o,jsv_o,isv_d,iev_d,jsv_d,jev_d - integer :: k,ks,ke - real :: tot_non_zero - !downsampled mask = 0 unless the mask value of one of the downsampling cells is 1 - isv_o=1 - jsv_o=1 - ks = lbound(field_in,3) ; ke = ubound(field_in,3) - isv_d=1; iev_d=size(field_in,1)/dl - jsv_d=1; jev_d=size(field_in,2)/dl - allocate(field_out(isv_d:iev_d,jsv_d:jev_d,ks:ke)) - field_out(:,:,:) = 0.0 - do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d - i0 = isv_o+dl*(i-isv_d) - j0 = jsv_o+dl*(j-jsv_d) - tot_non_zero = 0.0 -! do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 - do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 - tot_non_zero = tot_non_zero + field_in(ii,jj,k) - enddo;enddo - if(tot_non_zero > 0.0) field_out(i,j,k)=1.0 - enddo; enddo; enddo -end subroutine downsample_mask_3d_p - -subroutine downsample_mask_2d_p(field_in, field_out, dl) - integer , intent(in) :: dl +subroutine downsample_mask_2d(field_in, field_out, dl, isc_o,jsc_o, isc_d,iec_d,jsc_d,jec_d , isd_d,ied_d,jsd_d,jed_d) real, dimension(:,:) , intent(in) :: field_in real, dimension(:,:) , pointer :: field_out + integer , intent(in) :: dl + integer , intent(in) :: isc_o,jsc_o + integer , intent(in) :: isc_d,iec_d,jsc_d,jec_d !< downsampled mask compute indices + integer , intent(in) :: isd_d,ied_d,jsd_d,jed_d !< downsampled mask data indices integer :: i,j,ii,jj,i0,j0 - integer :: isv_o,jsv_o,isv_d,iev_d,jsv_d,jev_d real :: tot_non_zero !downsampled mask = 0 unless the mask value of one of the downsampling cells is 1 - isv_o=1 - jsv_o=1 - isv_d=1; iev_d=size(field_in,1)/dl - jsv_d=1; jev_d=size(field_in,2)/dl - allocate(field_out(isv_d:iev_d,jsv_d:jev_d)) + allocate(field_out(isd_d:ied_d,jsd_d:jed_d)) field_out(:,:) = 0.0 - do j=jsv_d,jev_d ; do i=isv_d,iev_d - i0 = isv_o+dl*(i-isv_d) - j0 = jsv_o+dl*(j-jsv_d) + do j=jsc_d,jec_d ; do i=isc_d,iec_d + i0 = isc_o+dl*(i-isc_d) + j0 = jsc_o+dl*(j-jsc_d) tot_non_zero = 0.0 -! do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 - do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 + do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 tot_non_zero = tot_non_zero + field_in(ii,jj) enddo;enddo if(tot_non_zero > 0.0) field_out(i,j)=1.0 enddo; enddo -end subroutine downsample_mask_2d_p +end subroutine downsample_mask_2d -subroutine downsample_mask_3d_a(field_in, field_out, dl) +subroutine downsample_mask_3d(field_in, field_out, dl, isc_o,jsc_o, isc_d,iec_d,jsc_d,jec_d , isd_d,ied_d,jsd_d,jed_d) + real, dimension(:,:,:) , intent(in) :: field_in + real, dimension(:,:,:) , pointer :: field_out integer , intent(in) :: dl - real, dimension(:,:,:), pointer :: field_in - real, dimension(:,:,:), allocatable :: field_out - integer :: i,j,ii,jj,i0,j0 - integer :: isv_o,jsv_o,isv_d,iev_d,jsv_d,jev_d - integer :: k,ks,ke + integer , intent(in) :: isc_o,jsc_o + integer , intent(in) :: isc_d,iec_d,jsc_d,jec_d !< downsampled mask compute indices + integer , intent(in) :: isd_d,ied_d,jsd_d,jed_d !< downsampled mask data indices + integer :: i,j,ii,jj,i0,j0,k,ks,ke real :: tot_non_zero !downsampled mask = 0 unless the mask value of one of the downsampling cells is 1 - isv_o=1 - jsv_o=1 ks = lbound(field_in,3) ; ke = ubound(field_in,3) - isv_d=1; iev_d=size(field_in,1)/dl - jsv_d=1; jev_d=size(field_in,2)/dl - allocate(field_out(isv_d:iev_d,jsv_d:jev_d,ks:ke)) + allocate(field_out(isd_d:ied_d,jsd_d:jed_d,ks:ke)) field_out(:,:,:) = 0.0 - do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d - i0 = isv_o+dl*(i-isv_d) - j0 = jsv_o+dl*(j-jsv_d) + do k= ks,ke ; do j=jsc_d,jec_d ; do i=isc_d,iec_d + i0 = isc_o+dl*(i-isc_d) + j0 = jsc_o+dl*(j-jsc_d) tot_non_zero = 0.0 -! do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 - do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 + do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 tot_non_zero = tot_non_zero + field_in(ii,jj,k) enddo;enddo if(tot_non_zero > 0.0) field_out(i,j,k)=1.0 enddo; enddo; enddo -end subroutine downsample_mask_3d_a - -subroutine downsample_mask_2d_a(field_in, field_out, dl) - integer , intent(in) :: dl - real, dimension(:,:) , intent(in) :: field_in - real, dimension(:,:) , allocatable :: field_out - integer :: i,j,ii,jj,i0,j0 - integer :: isv_o,jsv_o,isv_d,iev_d,jsv_d,jev_d - real :: tot_non_zero - !downsampled mask = 0 unless the mask value of one of the downsampling cells is 1 - isv_o=1 - jsv_o=1 - isv_d=1; iev_d=size(field_in,1)/dl - jsv_d=1; jev_d=size(field_in,2)/dl - allocate(field_out(isv_d:iev_d,jsv_d:jev_d)) - field_out(:,:) = 0.0 - do j=jsv_d,jev_d ; do i=isv_d,iev_d - i0 = isv_o+dl*(i-isv_d) - j0 = jsv_o+dl*(j-jsv_d) - tot_non_zero = 0.0 -! do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 - do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 - tot_non_zero = tot_non_zero + field_in(ii,jj) - enddo;enddo - if(tot_non_zero > 0.0) field_out(i,j)=1.0 - enddo; enddo -end subroutine downsample_mask_2d_a - +end subroutine downsample_mask_3d end module MOM_diag_mediator From 4863472a809fa4779cacd51d11bd069df678f325 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 30 Oct 2018 14:46:25 -0400 Subject: [PATCH 0869/1072] +Added m_to_Z arg to horiz_interp_and_extrap_tracer Added a new argument to the two horiz_interp_and_extrap_tracer routines to handle unit conversions, and extensively cleaned up the code in MOM_horizontal_regridding to match the style of other MOM6 code. All answers are bitwise identical in the test cases, but the new argument needs to be used for rescaling of Z to a value other than 1 to work correctly. --- src/framework/MOM_horizontal_regridding.F90 | 603 ++++++++++---------- 1 file changed, 294 insertions(+), 309 deletions(-) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index afadf6bdfa..21d581978a 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -50,8 +50,8 @@ module MOM_horizontal_regridding !> Extrapolate and interpolate data interface horiz_interp_and_extrap_tracer - module procedure horiz_interp_and_extrap_tracer_record - module procedure horiz_interp_and_extrap_tracer_fms_id + module procedure horiz_interp_and_extrap_tracer_record + module procedure horiz_interp_and_extrap_tracer_fms_id end interface contains @@ -73,21 +73,19 @@ subroutine myStats(array, missing, is, ie, js, je, k, mesg) character(len=120) :: lMesg minA = 9.E24 ; maxA = -9.E24 ; found = .false. - do j = js, je - do i = is, ie - if (array(i,j) /= array(i,j)) stop 'Nan!' - if (abs(array(i,j)-missing)>1.e-6*abs(missing)) then - if (found) then - minA = min(minA, array(i,j)) - maxA = max(maxA, array(i,j)) - else - found = .true. - minA = array(i,j) - maxA = array(i,j) - endif - endif - enddo - enddo + do j=js,je ; do i=is,ie + if (array(i,j) /= array(i,j)) stop 'Nan!' + if (abs(array(i,j)-missing) > 1.e-6*abs(missing)) then + if (found) then + minA = min(minA, array(i,j)) + maxA = max(maxA, array(i,j)) + else + found = .true. + minA = array(i,j) + maxA = array(i,j) + endif + endif + enddo ; enddo call min_across_PEs(minA) call max_across_PEs(maxA) if (is_root_pe()) then @@ -95,6 +93,7 @@ subroutine myStats(array, missing, is, ie, js, je, k, mesg) 'init_from_Z: min=',minA,' max=',maxA,' Level=',k,trim(mesg) call MOM_mesg(lMesg,2) endif + end subroutine myStats @@ -102,7 +101,7 @@ end subroutine myStats !! valid data (good=1). If no information is available, !! Then use a previous guess (prev). Optionally (smooth) !! blend the filled points to achieve a more desirable result. -subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug,debug) +subroutine fill_miss_2d(aout, good, fill, prev, G, smooth, num_pass, relc, crit, keep_bug, debug) use MOM_coms, only : sum_across_PEs type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -127,7 +126,7 @@ subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug real, dimension(SZI_(G),SZJ_(G)) :: b,r - real, dimension(SZI_(G),SZJ_(G)) :: fill_pts,good_,good_new + real, dimension(SZI_(G),SZJ_(G)) :: fill_pts, good_, good_new character(len=256) :: mesg ! The text of an error message integer :: i,j,k @@ -163,116 +162,111 @@ subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug do_smooth=.false. if (PRESENT(smooth)) do_smooth=smooth - fill_pts(:,:)=fill(:,:) + fill_pts(:,:) = fill(:,:) nfill = sum(fill(is:ie,js:je)) call sum_across_PEs(nfill) nfill_prev = nfill - good_(:,:)=good(:,:) - r(:,:)=0.0 + good_(:,:) = good(:,:) + r(:,:) = 0.0 do while (nfill > 0.0) - call pass_var(good_,G%Domain) - call pass_var(aout,G%Domain) - - b(:,:)=aout(:,:) - good_new(:,:)=good_(:,:) - - do j=js,je - i_loop: do i=is,ie - - if (good_(i,j) == 1.0 .or. fill(i,j) == 0.) cycle i_loop - - ge=good_(i+1,j);gw=good_(i-1,j) - gn=good_(i,j+1);gs=good_(i,j-1) - east=0.0;west=0.0;north=0.0;south=0.0 - if (ge == 1.0) east=aout(i+1,j)*ge - if (gw == 1.0) west=aout(i-1,j)*gw - if (gn == 1.0) north=aout(i,j+1)*gn - if (gs == 1.0) south=aout(i,j-1)*gs - - ngood = ge+gw+gn+gs - if (ngood > 0.) then - b(i,j)=(east+west+north+south)/ngood - fill_pts(i,j)=0.0 - good_new(i,j)=1.0 - endif - enddo i_loop - enddo - - aout(is:ie,js:je)=b(is:ie,js:je) - good_(is:ie,js:je)=good_new(is:ie,js:je) - nfill_prev = nfill - nfill = sum(fill_pts(is:ie,js:je)) - call sum_across_PEs(nfill) - - if (nfill == nfill_prev .and. PRESENT(prev)) then - do j=js,je - do i=is,ie - if (fill_pts(i,j) == 1.0) then - aout(i,j)=prev(i,j) - fill_pts(i,j)=0.0 - endif - enddo - enddo - elseif (nfill == nfill_prev) then - call MOM_error(WARNING, & - 'Unable to fill missing points using either data at the same vertical level from a connected basin'//& - 'or using a point from a previous vertical level. Make sure that the original data has some valid'//& - 'data in all basins.', .true.) - write(mesg,*) 'nfill=',nfill - call MOM_error(WARNING, mesg, .true.) - endif - - nfill = sum(fill_pts(is:ie,js:je)) - call sum_across_PEs(nfill) + call pass_var(good_,G%Domain) + call pass_var(aout,G%Domain) - enddo + b(:,:)=aout(:,:) + good_new(:,:)=good_(:,:) - if (do_smooth) then - do k=1,npass - call pass_var(aout,G%Domain) - do j=js,je - do i=is,ie - if (fill(i,j) == 1) then - east=max(good(i+1,j),fill(i+1,j)) ; west=max(good(i-1,j),fill(i-1,j)) - north=max(good(i,j+1),fill(i,j+1)) ; south=max(good(i,j-1),fill(i,j-1)) - !### Appropriate parentheses should be added here, but they will change answers. - r(i,j) = relax_coeff*(south*aout(i,j-1)+north*aout(i,j+1) + & - west*aout(i-1,j)+east*aout(i+1,j) - & - (south+north+west+east)*aout(i,j)) - else - r(i,j) = 0. - endif - enddo - enddo - aout(is:ie,js:je)=r(is:ie,js:je)+aout(is:ie,js:je) - ares = maxval(abs(r)) - call max_across_PEs(ares) - if (ares <= acrit) exit - enddo - endif + do j=js,je ; do i=is,ie + + if (good_(i,j) == 1.0 .or. fill(i,j) == 0.) cycle + + ge=good_(i+1,j) ; gw=good_(i-1,j) + gn=good_(i,j+1) ; gs=good_(i,j-1) + east=0.0 ; west=0.0 ; north=0.0 ; south=0.0 + if (ge == 1.0) east = aout(i+1,j)*ge + if (gw == 1.0) west = aout(i-1,j)*gw + if (gn == 1.0) north = aout(i,j+1)*gn + if (gs == 1.0) south = aout(i,j-1)*gs + + ngood = ge+gw+gn+gs + if (ngood > 0.) then + b(i,j)=(east+west+north+south)/ngood + !### Replace this with + ! b(i,j) = ((east+west) + (north+south))/ngood + fill_pts(i,j) = 0.0 + good_new(i,j) = 1.0 + endif + enddo ; enddo + + aout(is:ie,js:je) = b(is:ie,js:je) + good_(is:ie,js:je) = good_new(is:ie,js:je) + nfill_prev = nfill + nfill = sum(fill_pts(is:ie,js:je)) + call sum_across_PEs(nfill) + + if (nfill == nfill_prev .and. PRESENT(prev)) then + do j=js,je ; do i=is,ie ; if (fill_pts(i,j) == 1.0) then + aout(i,j) = prev(i,j) + fill_pts(i,j) = 0.0 + endif ; enddo ; enddo + elseif (nfill == nfill_prev) then + call MOM_error(WARNING, & + 'Unable to fill missing points using either data at the same vertical level from a connected basin'//& + 'or using a point from a previous vertical level. Make sure that the original data has some valid'//& + 'data in all basins.', .true.) + write(mesg,*) 'nfill=',nfill + call MOM_error(WARNING, mesg, .true.) + endif + + nfill = sum(fill_pts(is:ie,js:je)) + call sum_across_PEs(nfill) - do j=js,je - do i=is,ie - if (good_(i,j) == 0.0 .and. fill_pts(i,j) == 1.0) then - write(mesg,*) 'In fill_miss, fill, good,i,j= ',fill_pts(i,j),good_(i,j),i,j - call MOM_error(WARNING, mesg, .true.) - call MOM_error(FATAL,"MOM_initialize: "// & - "fill is true and good is false after fill_miss, how did this happen? ") - endif - enddo enddo - return + if (do_smooth) then ; do k=1,npass + call pass_var(aout,G%Domain) + do j=js,je ; do i=is,ie + if (fill(i,j) == 1) then + east = max(good(i+1,j),fill(i+1,j)) ; west = max(good(i-1,j),fill(i-1,j)) + north = max(good(i,j+1),fill(i,j+1)) ; south = max(good(i,j-1),fill(i,j-1)) + r(i,j) = relax_coeff*(south*aout(i,j-1)+north*aout(i,j+1) + & + west*aout(i-1,j)+east*aout(i+1,j) - & + (south+north+west+east)*aout(i,j)) + !### Appropriate parentheses should be added here, but they will change answers. + ! r(i,j) = relax_coeff*( ((south*aout(i,j-1) + north*aout(i,j+1)) + & + ! (west*aout(i-1,j)+east*aout(i+1,j))) - & + ! ((south+north)+(west+east))*aout(i,j) ) + else + r(i,j) = 0. + endif + enddo ; enddo + ares = 0.0 + do j=js,je ; do i=is,ie + aout(i,j) = r(i,j) + aout(i,j) + ares = max(ares, abs(r(i,j))) + enddo ; enddo + call max_across_PEs(ares) + if (ares <= acrit) exit + enddo ; endif + + do j=js,je ; do i=is,ie + if (good_(i,j) == 0.0 .and. fill_pts(i,j) == 1.0) then + write(mesg,*) 'In fill_miss, fill, good,i,j= ',fill_pts(i,j),good_(i,j),i,j + call MOM_error(WARNING, mesg, .true.) + call MOM_error(FATAL,"MOM_initialize: "// & + "fill is true and good is false after fill_miss, how did this happen? ") + endif + enddo ; enddo end subroutine fill_miss_2d !> Extrapolate and interpolate from a file record -subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, recnum, G, tr_z, mask_z, z_in, & - z_edges_in, missing_value, reentrant_x, tripolar_n, homogenize ) +subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, recnum, G, tr_z, & + mask_z, z_in, z_edges_in, missing_value, reentrant_x, & + tripolar_n, homogenize, m_to_Z) character(len=*), intent(in) :: filename !< Path to file containing tracer to be !! interpolated. @@ -281,9 +275,9 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, integer, intent(in) :: recnum !< Record number of tracer to be read. type(ocean_grid_type), intent(inout) :: G !< Grid object real, allocatable, dimension(:,:,:) :: tr_z !< pointer to allocatable tracer array on local - !! model grid and native vertical levels. + !! model grid and input-file vertical levels. real, allocatable, dimension(:,:,:) :: mask_z !< pointer to allocatable tracer mask array on - !! local model grid and native vertical levels. + !! local model grid and input-file vertical levels. real, allocatable, dimension(:) :: z_in !< Cell grid values for input data. real, allocatable, dimension(:) :: z_edges_in !< Cell grid edge values for input data. real, intent(out) :: missing_value !< The missing value in the returned array. @@ -291,8 +285,11 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, logical, intent(in) :: tripolar_n !< If true, this is a northern tripolar grid logical, optional, intent(in) :: homogenize !< If present and true, horizontally homogenize data !! to produce perfectly "flat" initial conditions + real, optional, intent(in) :: m_to_Z !< A conversion factor from meters to the units + !! of depth. If missing, G%bathyT must be in m. - real, dimension(:,:), allocatable :: tr_in,tr_inp ! A 2-d array for holding input data on + ! Local variables + real, dimension(:,:), allocatable :: tr_in, tr_inp ! A 2-d array for holding input data on ! native horizontal grid and extended grid ! with poles. real, dimension(:,:), allocatable :: mask_in ! A 2-d mask for extended input grid. @@ -405,6 +402,8 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, call cpu_clock_end(id_clock_read) + if (present(m_to_Z)) then ; do k=1,kd ; z_in(k) = m_to_Z * z_in(k) ; enddo ; endif + ! extrapolate the input data to the north pole using the northerm-most latitude max_lat = maxval(lat_in) @@ -425,8 +424,8 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, ! construct level cell boundaries as the mid-point between adjacent centers z_edges_in(1) = 0.0 - do k=2,kd - z_edges_in(k)=0.5*(z_in(k-1)+z_in(k)) + do K=2,kd + z_edges_in(K)=0.5*(z_in(k-1)+z_in(k)) enddo z_edges_in(kd+1)=2.0*z_in(kd) - z_in(kd-1) @@ -446,7 +445,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, allocate(mask_in(id,jdp)) ; mask_in(:,:)=0.0 allocate(last_row(id)) ; last_row(:)=0.0 - max_depth = G%Zd_to_m*maxval(G%bathyT) + max_depth = maxval(G%bathyT) call mpp_max(max_depth) if (z_edges_in(kd+1) abs(roundoff*missing_value)) then - mask_in(i,j)=1.0 - tr_inp(i,j) = tr_inp(i,j) * conversion + mask_in(i,j) = 1.0 + tr_inp(i,j) = tr_inp(i,j) * conversion else - tr_inp(i,j)=missing_value + tr_inp(i,j) = missing_value endif enddo enddo @@ -543,7 +542,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, nPoints = nPoints + 1 varAvg = varAvg + tr_out(i,j) endif - if (G%mask2dT(i,j) == 1.0 .and. z_edges_in(k) <= G%Zd_to_m*G%bathyT(i,j) .and. mask_out(i,j) < 1.0) & + if (G%mask2dT(i,j) == 1.0 .and. z_edges_in(k) <= G%bathyT(i,j) .and. mask_out(i,j) < 1.0) & fill(i,j)=1.0 enddo enddo @@ -569,18 +568,18 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, ! tr_out contains input z-space data on the model grid with missing values ! now fill in missing values using "ICE-nine" algorithm. - tr_outf(:,:)=tr_out(:,:) - if (k==1) tr_prev(:,:)=tr_outf(:,:) - good2(:,:)=good(:,:) - fill2(:,:)=fill(:,:) + tr_outf(:,:) = tr_out(:,:) + if (k==1) tr_prev(:,:) = tr_outf(:,:) + good2(:,:) = good(:,:) + fill2(:,:) = fill(:,:) - call fill_miss_2d(tr_outf,good2,fill2,tr_prev,G,smooth=.true.) - call myStats(tr_outf,missing_value,is,ie,js,je,k,'field from fill_miss_2d()') + call fill_miss_2d(tr_outf, good2, fill2, tr_prev, G, smooth=.true.) + call myStats(tr_outf, missing_value, is, ie, js, je, k, 'field from fill_miss_2d()') - tr_z(:,:,k) = tr_outf(:,:)*G%mask2dT(:,:) - mask_z(:,:,k) = good2(:,:)+fill2(:,:) + tr_z(:,:,k) = tr_outf(:,:) * G%mask2dT(:,:) + mask_z(:,:,k) = good2(:,:) + fill2(:,:) - tr_prev(:,:)=tr_z(:,:,k) + tr_prev(:,:) = tr_z(:,:,k) if (debug) then call hchksum(tr_prev,'field after fill ',G%HI) @@ -591,8 +590,9 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, end subroutine horiz_interp_and_extrap_tracer_record !> Extrapolate and interpolate using a FMS time interpolation handle -subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, tr_z, mask_z, z_in, & - z_edges_in, missing_value, reentrant_x, tripolar_n, homogenize ) +subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, tr_z, mask_z, & + z_in, z_edges_in, missing_value, reentrant_x, & + tripolar_n, homogenize, m_to_Z) integer, intent(in) :: fms_id !< A unique id used by the FMS time interpolator type(time_type), intent(in) :: Time !< A FMS time type @@ -603,13 +603,16 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t real, allocatable, dimension(:,:,:) :: mask_z !< pointer to allocatable tracer mask array on !! local model grid and native vertical levels. real, allocatable, dimension(:) :: z_in !< Cell grid values for input data. - real, allocatable, dimension(:) :: z_edges_in !< Cell grid edge values for input data. + real, allocatable, dimension(:) :: z_edges_in !< Cell grid edge values for input data. (Intent out) real, intent(out) :: missing_value !< The missing value in the returned array. logical, intent(in) :: reentrant_x !< If true, this grid is reentrant in the x-direction logical, intent(in) :: tripolar_n !< If true, this is a northern tripolar grid logical, optional, intent(in) :: homogenize !< If present and true, horizontally homogenize data !! to produce perfectly "flat" initial conditions + real, optional, intent(in) :: m_to_Z !< A conversion factor from meters to the units + !! of depth. If missing, G%bathyT must be in m. + ! Local variables real, dimension(:,:), allocatable :: tr_in,tr_inp !< A 2-d array for holding input data on !! native horizontal grid and extended grid !! with poles. @@ -678,9 +681,11 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t call mpp_get_axis_data(axes_data(2), lat_in) call mpp_get_axis_data(axes_data(3), z_in) + if (present(m_to_Z)) then ; do k=1,kd ; z_in(k) = m_to_Z * z_in(k) ; enddo ; endif + call cpu_clock_end(id_clock_read) - missing_value=get_external_field_missing(fms_id) + missing_value = get_external_field_missing(fms_id) ! extrapolate the input data to the north pole using the northerm-most latitude @@ -688,14 +693,14 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t max_lat = maxval(lat_in) add_np=.false. if (max_lat < 90.0) then - add_np=.true. - jdp=jd+1 + add_np = .true. + jdp = jd+1 allocate(lat_inp(jdp)) - lat_inp(1:jd)=lat_in(:) - lat_inp(jd+1)=90.0 + lat_inp(1:jd) = lat_in(:) + lat_inp(jd+1) = 90.0 deallocate(lat_in) allocate(lat_in(1:jdp)) - lat_in(:)=lat_inp(:) + lat_in(:) = lat_inp(:) else jdp=jd endif @@ -704,16 +709,16 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t z_edges_in(1) = 0.0 do k=2,kd - z_edges_in(k)=0.5*(z_in(k-1)+z_in(k)) + z_edges_in(k) = 0.5*(z_in(k-1)+z_in(k)) enddo - z_edges_in(kd+1)=2.0*z_in(kd) - z_in(kd-1) + z_edges_in(kd+1) = 2.0*z_in(kd) - z_in(kd-1) call horiz_interp_init() lon_in = lon_in*PI_180 lat_in = lat_in*PI_180 - allocate(x_in(id,jdp),y_in(id,jdp)) - call meshgrid(lon_in,lat_in, x_in, y_in) + allocate(x_in(id,jdp), y_in(id,jdp)) + call meshgrid(lon_in, lat_in, x_in, y_in) lon_out(:,:) = G%geoLonT(:,:)*PI_180 lat_out(:,:) = G%geoLatT(:,:)*PI_180 @@ -724,13 +729,13 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t allocate(mask_in(id,jdp)) ; mask_in(:,:)=0.0 allocate(last_row(id)) ; last_row(:)=0.0 - max_depth = G%Zd_to_m*maxval(G%bathyT) + max_depth = maxval(G%bathyT) call mpp_max(max_depth) if (z_edges_in(kd+1) abs(roundoff*missing_value)) then - mask_in(i,j)=1.0 - tr_inp(i,j) = tr_inp(i,j) * conversion - else - tr_inp(i,j)=missing_value - endif - enddo - enddo - - -! call fms routine horiz_interp to interpolate input level data to model horizontal grid - + do j=1,jdp ; do i=1,id + if (abs(tr_inp(i,j)-missing_value) > abs(roundoff*missing_value)) then + mask_in(i,j)=1.0 + tr_inp(i,j) = tr_inp(i,j) * conversion + else + tr_inp(i,j) = missing_value + endif + enddo ; enddo + ! call fms routine horiz_interp to interpolate input level data to model horizontal grid if (k == 1) then - call horiz_interp_new(Interp,x_in,y_in,lon_out(is:ie,js:je),lat_out(is:ie,js:je), & - interp_method='bilinear',src_modulo=reentrant_x) + call horiz_interp_new(Interp, x_in, y_in, lon_out(is:ie,js:je), lat_out(is:ie,js:je), & + interp_method='bilinear', src_modulo=reentrant_x) endif -! if (debug) then - call myStats(tr_in,missing_value, 1,id,1,jd,k,'Tracer from file') -! endif + if (debug) then + call myStats(tr_in, missing_value, 1, id, 1, jd, k, 'Tracer from file') + endif tr_out(:,:) = 0.0 - call horiz_interp(Interp,tr_inp,tr_out(is:ie,js:je), missing_value=missing_value, new_missing_handle=.true.) + call horiz_interp(Interp, tr_inp, tr_out(is:ie,js:je), missing_value=missing_value, & + new_missing_handle=.true.) - mask_out=1.0 - do j=js,je - do i=is,ie - if (abs(tr_out(i,j)-missing_value) < abs(roundoff*missing_value)) mask_out(i,j)=0. - enddo - enddo + mask_out(:,:) = 1.0 + do j=js,je ; do i=is,ie + if (abs(tr_out(i,j)-missing_value) < abs(roundoff*missing_value)) mask_out(i,j) = 0. + enddo ; enddo - fill = 0.0; good = 0.0 + fill(:,:) = 0.0 ; good(:,:) = 0.0 nPoints = 0 ; varAvg = 0. - do j=js,je - do i=is,ie - if (mask_out(i,j) < 1.0) then - tr_out(i,j)=missing_value - else - good(i,j)=1.0 - nPoints = nPoints + 1 - varAvg = varAvg + tr_out(i,j) - endif - if (G%mask2dT(i,j) == 1.0 .and. z_edges_in(k) <= G%Zd_to_m*G%bathyT(i,j) .and. mask_out(i,j) < 1.0) & - fill(i,j)=1.0 - enddo - enddo - call pass_var(fill,G%Domain) - call pass_var(good,G%Domain) + do j=js,je ; do i=is,ie + if (mask_out(i,j) < 1.0) then + tr_out(i,j) = missing_value + else + good(i,j) = 1.0 + nPoints = nPoints + 1 + varAvg = varAvg + tr_out(i,j) + endif + if ((G%mask2dT(i,j) == 1.0) .and. (z_edges_in(k) <= G%bathyT(i,j)) .and. & + (mask_out(i,j) < 1.0)) & + fill(i,j)=1.0 + enddo ; enddo + call pass_var(fill, G%Domain) + call pass_var(good, G%Domain) if (debug) then - call myStats(tr_out,missing_value, is,ie,js,je,k,'variable from horiz_interp()') + call myStats(tr_out, missing_value, is, ie, js, je, k, 'variable from horiz_interp()') endif ! Horizontally homogenize data to produce perfectly "flat" initial conditions - if (PRESENT(homogenize)) then - if (homogenize) then - call sum_across_PEs(nPoints) - call sum_across_PEs(varAvg) - if (nPoints>0) then - varAvg = varAvg/real(nPoints) - endif - tr_out(:,:) = varAvg - endif - endif + if (PRESENT(homogenize)) then ; if (homogenize) then + call sum_across_PEs(nPoints) + call sum_across_PEs(varAvg) + if (nPoints>0) then + varAvg = varAvg/real(nPoints) + endif + tr_out(:,:) = varAvg + endif ; endif -! tr_out contains input z-space data on the model grid with missing values -! now fill in missing values using "ICE-nine" algorithm. + ! tr_out contains input z-space data on the model grid with missing values + ! now fill in missing values using "ICE-nine" algorithm. - tr_outf(:,:)=tr_out(:,:) - if (k==1) tr_prev(:,:)=tr_outf(:,:) - good2(:,:)=good(:,:) - fill2(:,:)=fill(:,:) + tr_outf(:,:) = tr_out(:,:) + if (k==1) tr_prev(:,:) = tr_outf(:,:) + good2(:,:) = good(:,:) + fill2(:,:) = fill(:,:) - call fill_miss_2d(tr_outf,good2,fill2,tr_prev,G,smooth=.true.) + call fill_miss_2d(tr_outf, good2, fill2, tr_prev, G, smooth=.true.) ! if (debug) then -! call hchksum(tr_outf,'field from fill_miss_2d ',G%HI) +! call hchksum(tr_outf, 'field from fill_miss_2d ', G%HI) ! endif -! call myStats(tr_outf,missing_value,is,ie,js,je,k,'field from fill_miss_2d()') +! call myStats(tr_outf, missing_value, is, ie, js, je, k, 'field from fill_miss_2d()') tr_z(:,:,k) = tr_outf(:,:)*G%mask2dT(:,:) - mask_z(:,:,k) = good2(:,:)+fill2(:,:) - tr_prev(:,:)=tr_z(:,:,k) + mask_z(:,:,k) = good2(:,:) + fill2(:,:) + tr_prev(:,:) = tr_z(:,:,k) if (debug) then call hchksum(tr_prev,'field after fill ',G%HI) @@ -872,80 +868,75 @@ end subroutine horiz_interp_and_extrap_tracer_fms_id !> Create a 2d-mesh of grid coordinates from 1-d arrays. -subroutine meshgrid(x,y,x_T,y_T) -real, dimension(:), intent(in) :: x !< input 1-dimensional vector -real, dimension(:), intent(in) :: y !< input 1-dimensional vector -real, dimension(size(x,1),size(y,1)), intent(inout) :: x_T !< output 2-dimensional array -real, dimension(size(x,1),size(y,1)), intent(inout) :: y_T !< output 2-dimensional array - -integer :: ni,nj,i,j +subroutine meshgrid(x, y, x_T, y_T) + real, dimension(:), intent(in) :: x !< input 1-dimensional vector + real, dimension(:), intent(in) :: y !< input 1-dimensional vector + real, dimension(size(x,1),size(y,1)), intent(inout) :: x_T !< output 2-dimensional array + real, dimension(size(x,1),size(y,1)), intent(inout) :: y_T !< output 2-dimensional array -ni=size(x,1);nj=size(y,1) + integer :: ni,nj,i,j -do j=1,nj - x_T(:,j)=x(:) -enddo + ni=size(x,1) ; nj=size(y,1) -do i=1,ni - y_T(i,:)=y(:) -enddo + do j=1,nj ; do i=1,ni + x_T(i,j) = x(i) + enddo ; enddo -return + do j=1,nj ; do i=1,ni + y_T(i,j) = y(j) + enddo ; enddo end subroutine meshgrid +! None of the subsequent code appears to be used at all. !> Fill grid edges for integer data function fill_boundaries_int(m,cyclic_x,tripolar_n) result(mp) -integer, dimension(:,:), intent(in) :: m !< input array (ND) -logical, intent(in) :: cyclic_x !< True if domain is zonally re-entrant -logical, intent(in) :: tripolar_n !< True if domain has an Arctic fold -integer, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp + integer, dimension(:,:), intent(in) :: m !< input array (ND) + logical, intent(in) :: cyclic_x !< True if domain is zonally re-entrant + logical, intent(in) :: tripolar_n !< True if domain has an Arctic fold + integer, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp -real, dimension(size(m,1),size(m,2)) :: m_real -real, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp_real + real, dimension(size(m,1),size(m,2)) :: m_real + real, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp_real -m_real = real(m) + m_real = real(m) -mp_real = fill_boundaries_real(m_real,cyclic_x,tripolar_n) + mp_real = fill_boundaries_real(m_real,cyclic_x,tripolar_n) -mp = int(mp_real) - -return + mp = int(mp_real) end function fill_boundaries_int !> Fill grid edges for real data function fill_boundaries_real(m,cyclic_x,tripolar_n) result(mp) -real, dimension(:,:), intent(in) :: m !< input array (ND) -logical, intent(in) :: cyclic_x !< True if domain is zonally re-entrant -logical, intent(in) :: tripolar_n !< True if domain has an Arctic fold -real, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp - -integer :: ni,nj,i,j + real, dimension(:,:), intent(in) :: m !< input array (ND) + logical, intent(in) :: cyclic_x !< True if domain is zonally re-entrant + logical, intent(in) :: tripolar_n !< True if domain has an Arctic fold + real, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp -ni=size(m,1); nj=size(m,2) + integer :: ni,nj,i,j -mp(1:ni,1:nj)=m(:,:) + ni=size(m,1); nj=size(m,2) -if (cyclic_x) then - mp(0,1:nj)=m(ni,1:nj) - mp(ni+1,1:nj)=m(1,1:nj) -else - mp(0,1:nj)=m(1,1:nj) - mp(ni+1,1:nj)=m(ni,1:nj) -endif + mp(1:ni,1:nj)=m(:,:) -mp(1:ni,0)=m(1:ni,1) -if (tripolar_n) then - do i=1,ni - mp(i,nj+1)=m(ni-i+1,nj) - enddo -else - mp(1:ni,nj+1)=m(1:ni,nj) -endif + if (cyclic_x) then + mp(0,1:nj)=m(ni,1:nj) + mp(ni+1,1:nj)=m(1,1:nj) + else + mp(0,1:nj)=m(1,1:nj) + mp(ni+1,1:nj)=m(ni,1:nj) + endif -return + mp(1:ni,0)=m(1:ni,1) + if (tripolar_n) then + do i=1,ni + mp(i,nj+1)=m(ni-i+1,nj) + enddo + else + mp(1:ni,nj+1)=m(1:ni,nj) + endif end function fill_boundaries_real @@ -956,68 +947,62 @@ end function fill_boundaries_real !! in each region is an approximation to del2(zi)=0 subject to !! boundary conditions along the valid points curve bounding this region. subroutine smooth_heights(zi,fill,bad,sor,niter,cyclic_x, tripolar_n) + real, dimension(:,:), intent(inout) :: zi !< input and output array (ND) + integer, dimension(size(zi,1),size(zi,2)), intent(in) :: fill !< same shape as zi, 1=fill + integer, dimension(size(zi,1),size(zi,2)), intent(in) :: bad !< same shape as zi, 1=bad data + real, intent(in) :: sor !< relaxation coefficient (ND) + integer, intent(in) :: niter !< maximum number of iterations + logical, intent(in) :: cyclic_x !< true if domain is zonally reentrant + logical, intent(in) :: tripolar_n !< true if domain has an Arctic fold -real, dimension(:,:), intent(inout) :: zi !< input and output array (ND) -integer, dimension(size(zi,1),size(zi,2)), intent(in) :: fill !< same shape as zi, 1=fill -integer, dimension(size(zi,1),size(zi,2)), intent(in) :: bad !< same shape as zi, 1=bad data -real, intent(in) :: sor !< relaxation coefficient (ND) -integer, intent(in) :: niter !< maximum number of iterations -logical, intent(in) :: cyclic_x !< true if domain is zonally reentrant -logical, intent(in) :: tripolar_n !< true if domain has an Arctic fold - -integer :: i,j,k,n -integer :: ni,nj - -real, dimension(size(zi,1),size(zi,2)) :: res, m -integer, dimension(size(zi,1),size(zi,2),4) :: B -real, dimension(0:size(zi,1)+1,0:size(zi,2)+1) :: mp -integer, dimension(0:size(zi,1)+1,0:size(zi,2)+1) :: nm - -real :: Isum, bsum - -ni=size(zi,1); nj=size(zi,2) + ! Local variables + real, dimension(size(zi,1),size(zi,2)) :: res, m + integer, dimension(size(zi,1),size(zi,2),4) :: B + real, dimension(0:size(zi,1)+1,0:size(zi,2)+1) :: mp + integer, dimension(0:size(zi,1)+1,0:size(zi,2)+1) :: nm + integer :: i,j,k,n + integer :: ni,nj + real :: Isum, bsum + ni=size(zi,1) ; nj=size(zi,2) -mp=fill_boundaries(zi,cyclic_x,tripolar_n) -B(:,:,:)=0.0 -nm=fill_boundaries(bad,cyclic_x,tripolar_n) + mp(:,:) = fill_boundaries(zi,cyclic_x,tripolar_n) -do j=1,nj - do i=1,ni - if (fill(i,j) == 1) then - B(i,j,1)=1-nm(i+1,j);B(i,j,2)=1-nm(i-1,j) - B(i,j,3)=1-nm(i,j+1);B(i,j,4)=1-nm(i,j-1) - endif - enddo -enddo + B(:,:,:) = 0.0 + nm(:,:) = fill_boundaries(bad,cyclic_x,tripolar_n) -do n=1,niter do j=1,nj do i=1,ni if (fill(i,j) == 1) then - bsum = real(B(i,j,1)+B(i,j,2)+B(i,j,3)+B(i,j,4)) - Isum = 1.0/bsum - res(i,j)=Isum*(B(i,j,1)*mp(i+1,j)+B(i,j,2)*mp(i-1,j)+& - B(i,j,3)*mp(i,j+1)+B(i,j,4)*mp(i,j-1)) - mp(i,j) + B(i,j,1)=1-nm(i+1,j);B(i,j,2)=1-nm(i-1,j) + B(i,j,3)=1-nm(i,j+1);B(i,j,4)=1-nm(i,j-1) endif enddo enddo - res(:,:)=res(:,:)*sor - do j=1,nj - do i=1,ni - mp(i,j)=mp(i,j)+res(i,j) + do n=1,niter + do j=1,nj + do i=1,ni + if (fill(i,j) == 1) then + bsum = real(B(i,j,1)+B(i,j,2)+B(i,j,3)+B(i,j,4)) + Isum = 1.0/bsum + res(i,j)=Isum*(B(i,j,1)*mp(i+1,j)+B(i,j,2)*mp(i-1,j)+& + B(i,j,3)*mp(i,j+1)+B(i,j,4)*mp(i,j-1)) - mp(i,j) + endif + enddo enddo - enddo - - zi(:,:)=mp(1:ni,1:nj) - mp = fill_boundaries(zi,cyclic_x,tripolar_n) -enddo - + res(:,:)=res(:,:)*sor + do j=1,nj + do i=1,ni + mp(i,j)=mp(i,j)+res(i,j) + enddo + enddo -return + zi(:,:)=mp(1:ni,1:nj) + mp = fill_boundaries(zi,cyclic_x,tripolar_n) + enddo end subroutine smooth_heights From b3e712b3937d72b97c9002b5855a0d4fc2c6aec0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 30 Oct 2018 14:51:23 -0400 Subject: [PATCH 0870/1072] +Recast MOM_ALE_sponge to work in units of Z Recast the internal calculations in MOM_ALE_sponge to use vertical height units of Z in place of m for dimensional consistency testing. This included adding a new GV argument to set_up_ALE_sponge_field and to apply_ALE_sponge, and using the new m_to_Z argument to horiz_interp_and_extrap_tracer, and also the elimination of some lines that performed a now unneeded rescaling of z_in and Z_edges_in. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- .../MOM_state_initialization.F90 | 15 +-- .../MOM_tracer_initialization_from_Z.F90 | 4 +- .../vertical/MOM_ALE_sponge.F90 | 107 +++++++++--------- .../vertical/MOM_diabatic_driver.F90 | 4 +- 4 files changed, 66 insertions(+), 64 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index eb4129e2e3..7d798f1271 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1824,8 +1824,8 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, call MOM_read_data(filename, salin_var, tmp(:,:,:), G%Domain) call set_up_sponge_field(tmp, tv%S, G, nz, CSp) elseif (use_temperature) then - call set_up_ALE_sponge_field(filename, potemp_var, Time, G, tv%T, ALE_CSp) - call set_up_ALE_sponge_field(filename, salin_var, Time, G, tv%S, ALE_CSp) + call set_up_ALE_sponge_field(filename, potemp_var, Time, G, GV, tv%T, ALE_CSp) + call set_up_ALE_sponge_field(filename, salin_var, Time, G, GV, tv%S, ALE_CSp) endif end subroutine initialize_sponges_file @@ -2089,16 +2089,17 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) ! value at the northernmost/southernmost latitude. call horiz_interp_and_extrap_tracer(tfilename, potemp_var, 1.0, 1, & - G, temp_z, mask_z, z_in, z_edges_in, missing_value_temp, reentrant_x, tripolar_n, homogenize) + G, temp_z, mask_z, z_in, z_edges_in, missing_value_temp, reentrant_x, & + tripolar_n, homogenize, m_to_Z=GV%m_to_Z) call horiz_interp_and_extrap_tracer(sfilename, salin_var, 1.0, 1, & - G, salt_z, mask_z, z_in, z_edges_in, missing_value_salt, reentrant_x, tripolar_n, homogenize) + G, salt_z, mask_z, z_in, z_edges_in, missing_value_salt, reentrant_x, & + tripolar_n, homogenize, m_to_Z=GV%m_to_Z) kd = size(z_in,1) - ! Convert the units and sign convention of z_in and Z_edges_in. - do k=1,kd ; z_in(k) = GV%m_to_Z*z_in(k) ; enddo - do k=1,size(Z_edges_in,1) ; Z_edges_in(k) = -GV%m_to_Z*Z_edges_in(k) ; enddo + ! Convert the sign convention of Z_edges_in. + do k=1,size(Z_edges_in,1) ; Z_edges_in(k) = -Z_edges_in(k) ; enddo allocate(rho_z(isd:ied,jsd:jed,kd)) allocate(area_shelf_h(isd:ied,jsd:jed)) diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index fb5487780f..b6dda5a4ab 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -120,10 +120,10 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, if (PRESENT(src_var_unit_conversion)) convert = src_var_unit_conversion call horiz_interp_and_extrap_tracer(src_file, src_var_nam, convert, recnum, & - G, tr_z, mask_z, z_in, z_edges_in, missing_value, reentrant_x, tripolar_n, homog) + G, tr_z, mask_z, z_in, z_edges_in, missing_value, reentrant_x, tripolar_n, & + homog, m_to_Z=GV%m_to_Z) kd = size(z_edges_in,1)-1 - do k=1,kd+1 ; z_edges_in(k) = GV%m_to_Z*z_edges_in(k) ; enddo call pass_var(tr_z,G%Domain) call pass_var(mask_z,G%Domain) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index c842b813c9..0b10a8d2d4 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -581,20 +581,22 @@ end subroutine set_up_ALE_sponge_field_fixed !> This subroutine stores the reference profile at h points for the variable !! whose address is given by filename and fieldname. -subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr, CS) - character(len=*), intent(in) :: filename !< The name of the file with the - !! time varying field data - character(len=*), intent(in) :: fieldname !< The name of the field in the file - !! with the time varying field data - type(time_type), intent(in) :: Time !< The current model time - type(ocean_grid_type), intent(in) :: G !< Grid structure (in). +subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, f_ptr, CS) + character(len=*), intent(in) :: filename !< The name of the file with the + !! time varying field data + character(len=*), intent(in) :: fieldname !< The name of the field in the file + !! with the time varying field data + type(time_type), intent(in) :: Time !< The current model time + type(ocean_grid_type), intent(in) :: G !< Grid structure (in). + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - target, intent(in) :: f_ptr !< Pointer to the field to be damped (in). - type(ALE_sponge_CS), pointer :: CS !< Sponge control structure (in/out). + target, intent(in) :: f_ptr !< Pointer to the field to be damped (in). + type(ALE_sponge_CS), pointer :: CS !< Sponge control structure (in/out). + ! Local variables real, allocatable, dimension(:,:,:) :: sp_val !< Field to be used in the sponge real, allocatable, dimension(:,:,:) :: mask_z !< Field mask for the sponge data - real, allocatable, dimension(:), target :: z_in, z_edges_in + real, allocatable, dimension(:), target :: z_in, z_edges_in ! Heights in Z. real :: missing_value integer :: j, k, col integer :: isd,ied,jsd,jed @@ -604,9 +606,9 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr, character(len=256) :: mesg ! String for error messages ! Local variables for ALE remapping - real, dimension(:), allocatable :: hsrc + real, dimension(:), allocatable :: hsrc ! Source thicknesses in Z real, dimension(:), allocatable :: tmpT1d - real :: zTopOfCell, zBottomOfCell + real :: zTopOfCell, zBottomOfCell ! Heights in Z type(remapping_CS) :: remapCS ! Remapping parameters and work arrays if (.not.associated(CS)) return @@ -649,9 +651,8 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr, ! In the future, this should be generalized using an interface to return the ! modulo attribute of the zonal axis (mjh). - ! call horiz_interp_and_extrap_tracer(CS%Ref_val(CS%fldno)%id,Time, 1.0,G,sp_val,mask_z,z_in,z_edges_in,& - ! missing_value,.true.,& - ! .false.,.false.) + ! call horiz_interp_and_extrap_tracer(CS%Ref_val(CS%fldno)%id,Time, 1.0,G,sp_val,mask_z,z_in,z_edges_in, & + ! missing_value, .true., .false., .false., m_to_Z=GV%m_to_Z) ! Do not think halo updates are needed (mjh) ! call pass_var(sp_val,G%Domain) @@ -668,10 +669,10 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr, zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0; hsrc(:) = 0.0; tmpT1d(:) = -99.9 do k=1,nz_data if (mask_z(CS%col_i(col),CS%col_j(col),k) == 1.0) then - zBottomOfCell = -min( z_edges_in(k+1), G%Zd_to_m*G%bathyT(CS%col_i(col),CS%col_j(col)) ) + zBottomOfCell = -min( z_edges_in(k+1), G%bathyT(CS%col_i(col),CS%col_j(col)) ) ! tmpT1d(k) = sp_val(CS%col_i(col),CS%col_j(col),k) elseif (k>1) then - zBottomOfCell = -G%Zd_to_m*G%bathyT(CS%col_i(col),CS%col_j(col)) + zBottomOfCell = -G%bathyT(CS%col_i(col),CS%col_j(col)) ! tmpT1d(k) = tmpT1d(k-1) ! else ! This next block should only ever be reached over land ! tmpT1d(k) = -99.9 @@ -681,10 +682,10 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr, zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo ! In case data is deeper than model - hsrc(nz_data) = hsrc(nz_data) + ( zTopOfCell + G%Zd_to_m*G%bathyT(CS%col_i(col),CS%col_j(col)) ) + hsrc(nz_data) = hsrc(nz_data) + ( zTopOfCell + G%bathyT(CS%col_i(col),CS%col_j(col)) ) CS%Ref_val(CS%fldno)%h(1:nz_data,col) = 0. CS%Ref_val(CS%fldno)%p(1:nz_data,col) = -1.e24 - CS%Ref_val(CS%fldno)%h(1:nz_data,col) = hsrc(1:nz_data) + CS%Ref_val(CS%fldno)%h(1:nz_data,col) = GV%Z_to_H*hsrc(1:nz_data) ! CS%Ref_val(CS%fldno)%p(1:nz_data,col) = tmpT1d(1:nz_data) enddo @@ -796,8 +797,7 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename ! modulo attribute of the zonal axis (mjh). call horiz_interp_and_extrap_tracer(CS%Ref_val_u%id,Time, 1.0,G,u_val,mask_u,z_in,z_edges_in,& - missing_value,.true.,& - .false.,.false.) + missing_value,.true.,.false.,.false., m_to_Z=1.0/G%Zd_to_m) !!! TODO: add a velocity interface! (mjh) @@ -806,9 +806,8 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename ! In the future, this should be generalized using an interface to return the ! modulo attribute of the zonal axis (mjh). - call horiz_interp_and_extrap_tracer(CS%Ref_val_v%id,Time, 1.0,G,v_val,mask_v,z_in,z_edges_in,& - missing_value,.true.,& - .false.,.false.) + call horiz_interp_and_extrap_tracer(CS%Ref_val_v%id,Time, 1.0,G,v_val,mask_v,z_in,z_edges_in, & + missing_value,.true.,.false.,.false., m_to_Z=1.0/G%Zd_to_m) ! stores the reference profile allocate(CS%Ref_val_u%p(fld_sz(3),CS%num_col_u)) @@ -835,8 +834,9 @@ end subroutine set_up_ALE_sponge_vel_field_varying !> This subroutine applies damping to the layers thicknesses, temp, salt and a variety of tracers !! for every column where there is damping. -subroutine apply_ALE_sponge(h, dt, G, CS, Time) +subroutine apply_ALE_sponge(h, dt, G, GV, CS, Time) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure (in). + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Layer thickness, in H (in) real, intent(in) :: dt !< The amount of time covered by this call, in s (in). @@ -847,6 +847,7 @@ subroutine apply_ALE_sponge(h, dt, G, CS, Time) real :: damp ! The timestep times the local damping coefficient. ND. real :: I1pdamp ! I1pdamp is 1/(1 + damp). Nondimensional. real :: Idt ! 1.0/dt, in s-1. + real :: m_to_Z ! A unit conversion factor from m to Z. real, allocatable, dimension(:) :: tmp_val2 ! data values on the original grid real, dimension(SZK_(G)) :: tmp_val1 ! data values remapped to model grid real :: hu(SZIB_(G), SZJ_(G), SZK_(G)) ! A temporary array for h at u pts @@ -856,11 +857,18 @@ subroutine apply_ALE_sponge(h, dt, G, CS, Time) integer :: c, m, nkmb, i, j, k, is, ie, js, je, nz, nz_data real, allocatable, dimension(:), target :: z_in, z_edges_in real :: missing_value + real :: h_neglect, h_neglect_edge is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke if (.not.associated(CS)) return + if (GV%Boussinesq) then + h_neglect = GV%m_to_H*1.0e-30 ; h_neglect_edge = GV%m_to_H*1.0e-10 + else + h_neglect = GV%kg_m2_to_H*1.0e-30 ; h_neglect_edge = GV%kg_m2_to_H*1.0e-10 + endif + if (CS%new_sponges) then if (.not. present(Time)) & call MOM_error(FATAL,"apply_ALE_sponge: No time information provided") @@ -874,8 +882,8 @@ subroutine apply_ALE_sponge(h, dt, G, CS, Time) sp_val(:,:,:)=0.0 mask_z(:,:,:)=0.0 - call horiz_interp_and_extrap_tracer(CS%Ref_val(CS%fldno)%id,Time, 1.0,G,sp_val,mask_z,z_in,z_edges_in,& - missing_value,.true., .false.,.false.) + call horiz_interp_and_extrap_tracer(CS%Ref_val(CS%fldno)%id,Time, 1.0,G,sp_val,mask_z,z_in,z_edges_in, & + missing_value,.true., .false.,.false., m_to_Z=GV%m_to_Z) ! call pass_var(sp_val,G%Domain) ! call pass_var(mask_z,G%Domain) @@ -886,7 +894,7 @@ subroutine apply_ALE_sponge(h, dt, G, CS, Time) CS%Ref_val(m)%p(1:nz_data,c) = sp_val(i,j,1:nz_data) do k=2,nz_data ! if (mask_z(i,j,k)==0.) & - if (CS%Ref_val(m)%h(k,c) <= 0.001) & + if (CS%Ref_val(m)%h(k,c) <= 0.001*GV%m_to_H) & ! some confusion here about why the masks are not correct returning from horiz_interp ! reverting to using a minimum thickness criteria CS%Ref_val(m)%p(k,c) = CS%Ref_val(m)%p(k-1,c) @@ -910,13 +918,11 @@ subroutine apply_ALE_sponge(h, dt, G, CS, Time) I1pdamp = 1.0 / (1.0 + damp) tmp_val2(1:nz_data) = CS%Ref_val(m)%p(1:nz_data,c) if (CS%new_sponges) then - call remapping_core_h(CS%remap_cs, & - nz_data, CS%Ref_val(m)%h(1:nz_data,c), tmp_val2, & - CS%nz, h(i,j,:), tmp_val1) + call remapping_core_h(CS%remap_cs, nz_data, CS%Ref_val(m)%h(1:nz_data,c), tmp_val2, & + CS%nz, h(i,j,:), tmp_val1, h_neglect, h_neglect_edge) else - call remapping_core_h(CS%remap_cs, & - nz_data, CS%Ref_h%p(1:nz_data,c), tmp_val2, & - CS%nz, h(i,j,:), tmp_val1) + call remapping_core_h(CS%remap_cs,nz_data, CS%Ref_h%p(1:nz_data,c), tmp_val2, & + CS%nz, h(i,j,:), tmp_val1, h_neglect, h_neglect_edge) endif !Backward Euler method CS%var(m)%p(i,j,1:CS%nz) = I1pdamp * (CS%var(m)%p(i,j,1:CS%nz) + tmp_val1 * damp) @@ -927,7 +933,8 @@ subroutine apply_ALE_sponge(h, dt, G, CS, Time) ! for debugging !c=CS%num_col !do m=1,CS%fldno - ! write(*,*)'APPLY SPONGE,m,CS%Ref_h(:,c),h(i,j,:),tmp_val2,tmp_val1',m,CS%Ref_h(:,c),h(i,j,:),tmp_val2,tmp_val1 + ! write(*,*) 'APPLY SPONGE,m,CS%Ref_h(:,c),h(i,j,:),tmp_val2,tmp_val1',& + ! m,CS%Ref_h(:,c),h(i,j,:),tmp_val2,tmp_val1 !enddo if (CS%sponge_uv) then @@ -945,9 +952,8 @@ subroutine apply_ALE_sponge(h, dt, G, CS, Time) allocate(sp_val(G%isdB:G%iedB,G%jsd:G%jed,1:nz_data)) allocate(mask_z(G%isdB:G%iedB,G%jsd:G%jed,1:nz_data)) ! Interpolate from the external horizontal grid and in time - call horiz_interp_and_extrap_tracer(CS%Ref_val_u%id,Time, 1.0,G,sp_val,mask_z,z_in,z_edges_in,& - missing_value,.true.,& - .false.,.false.) + call horiz_interp_and_extrap_tracer(CS%Ref_val_u%id,Time, 1.0,G,sp_val,mask_z,z_in,z_edges_in, & + missing_value, .true., .false., .false., m_to_Z=GV%m_to_Z) ! call pass_var(sp_val,G%Domain) ! call pass_var(mask_z,G%Domain) @@ -965,9 +971,8 @@ subroutine apply_ALE_sponge(h, dt, G, CS, Time) allocate(sp_val(G%isd:G%ied,G%jsdB:G%jedB,1:nz_data)) allocate(mask_z(G%isd:G%ied,G%jsdB:G%jedB,1:nz_data)) ! Interpolate from the external horizontal grid and in time - call horiz_interp_and_extrap_tracer(CS%Ref_val_v%id,Time, 1.0,G,sp_val,mask_z,z_in,z_edges_in,& - missing_value,.true.,& - .false.,.false.) + call horiz_interp_and_extrap_tracer(CS%Ref_val_v%id,Time, 1.0,G,sp_val,mask_z,z_in,z_edges_in, & + missing_value, .true., .false., .false., m_to_Z=GV%m_to_Z) ! call pass_var(sp_val,G%Domain) ! call pass_var(mask_z,G%Domain) @@ -992,13 +997,11 @@ subroutine apply_ALE_sponge(h, dt, G, CS, Time) if (CS%new_sponges) nz_data = CS%Ref_val(m)%nz_data tmp_val2(1:nz_data) = CS%Ref_val_u%p(1:nz_data,c) if (CS%new_sponges) then - call remapping_core_h(CS%remap_cs, & - nz_data, CS%Ref_val_u%h(:,c), tmp_val2, & - CS%nz, hu(i,j,:), tmp_val1) + call remapping_core_h(CS%remap_cs, nz_data, CS%Ref_val_u%h(:,c), tmp_val2, & + CS%nz, hu(i,j,:), tmp_val1, h_neglect, h_neglect_edge) else - call remapping_core_h(CS%remap_cs, & - nz_data, CS%Ref_hu%p(:,c), tmp_val2, & - CS%nz, hu(i,j,:), tmp_val1) + call remapping_core_h(CS%remap_cs, nz_data, CS%Ref_hu%p(:,c), tmp_val2, & + CS%nz, hu(i,j,:), tmp_val1, h_neglect, h_neglect_edge) endif !Backward Euler method CS%var_u%p(i,j,:) = I1pdamp * (CS%var_u%p(i,j,:) + tmp_val1 * damp) @@ -1015,13 +1018,11 @@ subroutine apply_ALE_sponge(h, dt, G, CS, Time) I1pdamp = 1.0 / (1.0 + damp) tmp_val2(1:nz_data) = CS%Ref_val_v%p(1:nz_data,c) if (CS%new_sponges) then - call remapping_core_h(CS%remap_cs, & - CS%nz_data, CS%Ref_val_v%h(:,c), tmp_val2, & - CS%nz, hv(i,j,:), tmp_val1) + call remapping_core_h(CS%remap_cs, CS%nz_data, CS%Ref_val_v%h(:,c), tmp_val2, & + CS%nz, hv(i,j,:), tmp_val1, h_neglect, h_neglect_edge) else - call remapping_core_h(CS%remap_cs, & - CS%nz_data, CS%Ref_hv%p(:,c), tmp_val2, & - CS%nz, hv(i,j,:), tmp_val1) + call remapping_core_h(CS%remap_cs, CS%nz_data, CS%Ref_hv%p(:,c), tmp_val2, & + CS%nz, hv(i,j,:), tmp_val1, h_neglect, h_neglect_edge) endif !Backward Euler method CS%var_v%p(i,j,:) = I1pdamp * (CS%var_v%p(i,j,:) + tmp_val1 * damp) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 285141c5c7..2fd7550083 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1015,7 +1015,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call cpu_clock_begin(id_clock_sponge) if (associated(CS%ALE_sponge_CSp)) then ! ALE sponge - call apply_ALE_sponge(h, dt, G, CS%ALE_sponge_CSp, CS%Time) + call apply_ALE_sponge(h, dt, G, GV, CS%ALE_sponge_CSp, CS%Time) endif call cpu_clock_end(id_clock_sponge) @@ -2174,7 +2174,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call cpu_clock_begin(id_clock_sponge) if (associated(CS%ALE_sponge_CSp)) then ! ALE sponge - call apply_ALE_sponge(h, dt, G, CS%ALE_sponge_CSp, CS%Time) + call apply_ALE_sponge(h, dt, G, GV, CS%ALE_sponge_CSp, CS%Time) else ! Layer mode sponge if (CS%bulkmixedlayer .and. associated(tv%eqn_of_state)) then From 9015a8932a200059a323e7984fd603b4f1ae72d3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 1 Nov 2018 03:42:54 -0400 Subject: [PATCH 0871/1072] +Recast MOM_diag_to_Z to work in units of Z Recast the internal calculations in MOM_diag_to_Z to use vertical height units of Z in place of m for dimensional consistency testing. This included adding a new GV argument to global_z_mean to undo the scaling and avoid overflow in some reproducing sums. Also, a halo update that was only needed with ice_shelf enabled is only done in that case. Numerous comments were updated. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- src/diagnostics/MOM_diag_to_Z.F90 | 108 ++++++++++++++++-------------- 1 file changed, 57 insertions(+), 51 deletions(-) diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index f8ea773f74..ca81bcdd7e 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -66,7 +66,7 @@ module MOM_diag_to_Z integer :: num_tr_used = 0 !< Th enumber of tracers in use. integer :: nk_zspace = -1 !< The number of levels in the z-space output - real, pointer :: Z_int(:) => NULL() !< interface depths of the z-space file (meter) + real, pointer :: Z_int(:) => NULL() !< interface depths of the z-space file, in Z !>@{ Axis groups for z-space diagnostic output type(axes_grp) :: axesBz, axesTz, axesCuz, axesCvz @@ -85,13 +85,14 @@ module MOM_diag_to_Z contains !> Return the global horizontal mean in z-space -function global_z_mean(var,G,CS,tracer) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(diag_to_Z_CS), pointer :: CS !< Control structure returned by - !! previous call to diag_to_Z_init. +function global_z_mean(var, G, GV, CS, tracer) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(diag_to_Z_CS), pointer :: CS !< Control structure returned by + !! previous call to diag_to_Z_init. real, dimension(SZI_(G), SZJ_(G), CS%nk_zspace), & - intent(in) :: var !< An array with the variable to average - integer, intent(in) :: tracer !< The tracer index being worked on + intent(in) :: var !< An array with the variable to average + integer, intent(in) :: tracer !< The tracer index being worked on ! Local variables real, dimension(SZI_(G), SZJ_(G), CS%nk_zspace) :: tmpForSumming, weight real, dimension(CS%nk_zspace) :: global_z_mean, scalarij, weightij @@ -107,13 +108,13 @@ function global_z_mean(var,G,CS,tracer) do k=1,nz ; do j=js,je ; do i=is,ie valid_point = 1.0 ! Weight factor for partial bottom cells - depth_weight = min( max( (-G%Zd_to_m*G%bathyT(i,j)), CS%Z_int(k+1) ) - CS%Z_int(k), 0.) + depth_weight = min( max(-G%bathyT(i,j), CS%Z_int(k+1)) - CS%Z_int(k), 0.) ! Flag the point as invalid if it contains missing data, or is below the bathymetry if (var(i,j,k) == CS%missing_tr(tracer)) valid_point = 0. if (depth_weight == 0.) valid_point = 0. - weight(i,j,k) = depth_weight * ( (valid_point * (G%areaT(i,j) * G%mask2dT(i,j))) ) + weight(i,j,k) = GV%Z_to_m * depth_weight * ( (valid_point * (G%areaT(i,j) * G%mask2dT(i,j))) ) ! If the point is flagged, set the variable itself to zero to avoid NaNs if (valid_point == 0.) then @@ -123,8 +124,8 @@ function global_z_mean(var,G,CS,tracer) endif enddo ; enddo ; enddo - global_temp_scalar = reproducing_sum(tmpForSumming,sums=scalarij) - global_weight_scalar = reproducing_sum(weight,sums=weightij) + global_temp_scalar = reproducing_sum(tmpForSumming, sums=scalarij) + global_weight_scalar = reproducing_sum(weight, sums=weightij) do k=1, nz if (scalarij(k) == 0) then @@ -154,8 +155,8 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) !! to diag_to_Z_init. ! Local variables ! Note the deliberately reversed axes in h_f, u_f, v_f, and tr_f. - real :: ssh(SZI_(G),SZJ_(G)) ! copy of ssh_in (meter or kg/m2) - real :: e(SZK_(G)+2) ! z-star interface heights (meter or kg/m2) + real :: ssh(SZI_(G),SZJ_(G)) ! copy of ssh_in whose halos can be updated (meter or kg/m2) + real :: e(SZK_(G)+2) ! z-star interface heights in Z real :: h_f(SZK_(G)+1,SZI_(G)) ! thicknesses of massive layers (meter or kg/m2) real :: u_f(SZK_(G)+1,SZIB_(G))! zonal velocity component in any massive layer real :: v_f(SZK_(G)+1,SZI_(G)) ! meridional velocity component in any massive layer @@ -163,8 +164,8 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) real :: tr_f(SZK_(G),max(CS%num_tr_used,1),SZI_(G)) ! tracer concentration in massive layers integer :: nk_valid(SZIB_(G)) ! number of massive layers in a column - real :: D_pt(SZIB_(G)) ! bottom depth (meter or kg/m2) - real :: shelf_depth(SZIB_(G)) ! ice shelf depth (meter or kg/m2) + real :: D_pt(SZIB_(G)) ! bottom depth in Z + real :: shelf_depth(SZIB_(G)) ! ice shelf depth in Z real :: htot ! summed layer thicknesses (meter or kg/m2) real :: dilate ! proportion by which to dilate every layer real :: wt(SZK_(G)+1) ! fractional weight for each layer in the @@ -191,16 +192,20 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) IsgB = G%IsgB ; IegB = G%IegB ; JsgB = G%JsgB ; JegB = G%JegB nkml = max(GV%nkml, 1) Angstrom = GV%Angstrom_H - ssh(:,:) = ssh_in linear_velocity_profiles = .true. - ! Update the halos - call pass_var(ssh, G%Domain) + if (.not.associated(CS)) call MOM_error(FATAL, & "diagnostic_fields_zstar: Module must be initialized before it is used.") ice_shelf = associated(frac_shelf_h) + ! Update the halos + if (ice_shelf) then + do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ; ssh(i,j) = GV%m_to_Z*ssh_in(i,j) ; enddo ; enddo + call pass_var(ssh, G%Domain) + endif + ! If no fields are needed, return if ((CS%id_u_z <= 0) .and. (CS%id_v_z <= 0) .and. (CS%num_tr_used < 1)) return @@ -217,7 +222,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) ! Remove all massless layers. do I=Isq,Ieq nk_valid(I) = 0 - D_pt(I) = 0.5*G%Zd_to_m*(G%bathyT(i+1,j)+G%bathyT(i,j)) + D_pt(I) = 0.5*(G%bathyT(i+1,j)+G%bathyT(i,j)) if (ice_shelf) then if (frac_shelf_h(i,j)+frac_shelf_h(i+1,j) > 0.) then ! under shelf shelf_depth(I) = abs(0.5*(ssh(i+1,j)+ssh(i,j))) @@ -236,9 +241,9 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) nk_valid(I) = nk_valid(I) + 1 ; k2 = nk_valid(I) h_f(k2,I) = Angstrom ; u_f(k2,I) = 0.0 ! GM: D_pt is always slightly larger (by 1E-6 or so) than shelf_depth, so - ! I consider that the ice shelf is grounded when - ! shelf_depth(I) + 1.0E-3 > D_pt(i) - if (ice_shelf .and. shelf_depth(I) + 1.0E-3 > D_pt(i)) nk_valid(I)=0 + ! I consider that the ice shelf is grounded for diagnostic purposes when + ! shelf_depth(I) + 1.0E-3*GV%m_to_Z > D_pt(i) + if (ice_shelf .and. (shelf_depth(I) + 1.0E-3*GV%m_to_Z > D_pt(i))) nk_valid(I)=0 endif ; enddo @@ -246,8 +251,8 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) ! Calculate the z* interface heights for tracers. htot = 0.0 ; do k=1,nk_valid(i) ; htot = htot + h_f(k,i) ; enddo dilate = 0.0 - if (htot*GV%H_to_m > 2.0*Angstrom) then - dilate = MAX((D_pt(i) - shelf_depth(i)),Angstrom)/htot + if (htot > 2.0*Angstrom) then + dilate = MAX((D_pt(i) - shelf_depth(i)), GV%Angstrom_Z)/htot endif e(nk_valid(i)+1) = -D_pt(i) do k=nk_valid(i),1,-1 ; e(K) = e(K+1) + h_f(k,i)*dilate ; enddo @@ -314,7 +319,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) shelf_depth(:) = 0.0 ! initially all is open ocean ! Remove all massless layers. do i=is,ie - nk_valid(i) = 0 ; D_pt(i) = 0.5*G%Zd_to_m*(G%bathyT(i,j)+G%bathyT(i,j+1)) + nk_valid(i) = 0 ; D_pt(i) = 0.5*(G%bathyT(i,j)+G%bathyT(i,j+1)) if (ice_shelf) then if (frac_shelf_h(i,j)+frac_shelf_h(i,j+1) > 0.) then ! under shelf shelf_depth(i) = abs(0.5*(ssh(i,j)+ssh(i,j+1))) @@ -332,7 +337,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) ! no-slip BBC in the output, if anything but piecewise constant is used. nk_valid(i) = nk_valid(i) + 1 ; k2 = nk_valid(i) h_f(k2,i) = Angstrom ; v_f(k2,i) = 0.0 - if (ice_shelf .and. shelf_depth(i) + 1.0E-3 > D_pt(i)) nk_valid(I)=0 + if (ice_shelf .and. shelf_depth(i) + 1.0E-3*GV%m_to_Z > D_pt(i)) nk_valid(I)=0 endif ; enddo do i=is,ie ; if (nk_valid(i) > 0) then @@ -340,7 +345,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) htot = 0.0 ; do k=1,nk_valid(i) ; htot = htot + h_f(k,i) ; enddo dilate = 0.0 if (htot > 2.0*Angstrom) then - dilate = MAX((D_pt(i) - shelf_depth(i)),Angstrom)/htot + dilate = MAX((D_pt(i) - shelf_depth(i)), GV%Angstrom_Z)/htot endif e(nk_valid(i)+1) = -D_pt(i) do k=nk_valid(i),1,-1 ; e(K) = e(K+1) + h_f(k,i)*dilate ; enddo @@ -406,7 +411,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) shelf_depth(:) = 0.0 ! initially all is open ocean ! Remove all massless layers. do i=is,ie - nk_valid(i) = 0 ; D_pt(i) = G%Zd_to_m*G%bathyT(i,j) + nk_valid(i) = 0 ; D_pt(i) = G%bathyT(i,j) if (ice_shelf) then if (frac_shelf_h(i,j) > 0.) then ! under shelf shelf_depth(i) = abs(ssh(i,j)) @@ -417,7 +422,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) if ((G%mask2dT(i,j) > 0.5) .and. (h(i,j,k) > 2.0*Angstrom)) then nk_valid(i) = nk_valid(i) + 1 ; k2 = nk_valid(i) h_f(k2,i) = h(i,j,k) - if (ice_shelf .and. shelf_depth(I) + 1.0E-3 > D_pt(i)) nk_valid(I)=0 + if (ice_shelf .and. shelf_depth(I) + 1.0E-3*GV%m_to_Z > D_pt(i)) nk_valid(I)=0 do m=1,CS%num_tr_used ; tr_f(k2,m,i) = CS%tr_model(m)%p(i,j,k) ; enddo endif enddo ; enddo @@ -427,7 +432,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) htot = 0.0 ; do k=1,nk_valid(i) ; htot = htot + h_f(k,i) ; enddo dilate = 0.0 if (htot > 2.0*Angstrom) then - dilate = MAX((D_pt(i) - shelf_depth(i)),Angstrom)/htot + dilate = MAX((D_pt(i) - shelf_depth(i)), GV%Angstrom_Z)/htot endif e(nk_valid(i)+1) = -D_pt(i) do k=nk_valid(i),1,-1 ; e(K) = e(K+1) + h_f(k,i)*dilate ; enddo @@ -478,7 +483,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) do m=1,CS%num_tr_used if (CS%id_tr(m) > 0) call post_data(CS%id_tr(m), CS%tr_z(m)%p, CS%diag) if (CS%id_tr_xyave(m) > 0) then - layer_ave = global_z_mean(CS%tr_z(m)%p,G,CS,m) + layer_ave = global_z_mean(CS%tr_z(m)%p, G, GV, CS, m) call post_data(CS%id_tr_xyave(m), layer_ave, CS%diag) endif enddo @@ -505,9 +510,9 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) !! diag_to_Z_init. ! Local variables real, dimension(SZI_(G), SZJ_(G)) :: & - htot, & ! total layer thickness (meter or kg/m2) - dilate ! nondimensional factor by which to dilate layers to - ! convert them into z* space. (-G%D < z* < 0) + htot, & ! total layer thickness, in H + dilate ! Factor by which to dilate layers to convert them + ! into z* space, in Z H-1. (-G%D < z* < 0) real, dimension(SZI_(G), max(CS%nk_zspace,1)) :: & uh_Z ! uh_int interpolated into depth space (m3 or kg) @@ -515,22 +520,22 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) vh_Z ! vh_int interpolated into depth space (m3 or kg) real :: h_rem ! dilated thickness of a layer that has yet to be mapped - ! into depth space (meter or kg/m2) + ! into depth space (in Z) real :: uh_rem ! integrated zonal transport of a layer that has yet to be ! mapped into depth space (m3 or kg) real :: vh_rem ! integrated meridional transport of a layer that has yet ! to be mapped into depth space (m3 or kg) real :: h_here ! thickness of a layer that is within the range of the - ! current depth level (meter or kg/m2) + ! current depth level (in Z) real :: h_above ! thickness of a layer that is above the current depth - ! level (meter or kg.m2) + ! level (in Z) real :: uh_here ! zonal transport of a layer that is attributed to the ! current depth level (m3 or kg) real :: vh_here ! meridional transport of a layer that is attributed to ! the current depth level (m3 or kg) real :: Idt ! inverse of the time step (sec) - real :: Z_int_above(SZIB_(G)) ! height of the interface atop a layer (meter or kg/m2) + real :: z_int_above(SZIB_(G)) ! height of the interface atop a layer (meter or kg/m2) integer :: kz(SZIB_(G)) ! index of depth level that is being contributed to @@ -556,13 +561,13 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) htot(i,j) = htot(i,j) + h(i,j,k) enddo ; enddo ; enddo do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - dilate(i,j) = G%Zd_to_m*G%bathyT(i,j) / htot(i,j) + dilate(i,j) = G%bathyT(i,j) / htot(i,j) enddo ; enddo ! zonal transport if (CS%id_uh_Z > 0) then ; do j=js,je do I=Isq,Ieq - kz(I) = nk_z ; z_int_above(I) = -0.5*G%Zd_to_m*(G%bathyT(i,j)+G%bathyT(i+1,j)) + kz(I) = nk_z ; z_int_above(I) = -0.5*(G%bathyT(i,j)+G%bathyT(i+1,j)) enddo do k=nk_z,1,-1 ; do I=Isq,Ieq uh_Z(I,k) = 0.0 @@ -597,7 +602,7 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) ! meridional transport if (CS%id_vh_Z > 0) then ; do J=Jsq,Jeq do i=is,ie - kz(i) = nk_z ; z_int_above(i) = -0.5*G%Zd_to_m*(G%bathyT(i,j)+G%bathyT(i,j+1)) + kz(i) = nk_z ; z_int_above(i) = -0.5*(G%bathyT(i,j)+G%bathyT(i,j+1)) enddo do k=nk_z,1,-1 ; do i=is,ie vh_Z(i,k) = 0.0 @@ -650,9 +655,9 @@ end subroutine calculate_Z_transport !! of each layer. It also calculates the normalized relative depths of the range !! of each layer that overlaps that depth range. subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z2) - real, dimension(:), intent(in) :: e !< Column interface heights (meter or kg/m2). - real, intent(in) :: Z_top !< Top of range being mapped to (meter or kg/m2). - real, intent(in) :: Z_bot !< Bottom of range being mapped to (meter or kg/m2). + real, dimension(:), intent(in) :: e !< Column interface heights, in arbitrary units. + real, intent(in) :: Z_top !< Top of range being mapped to, in the units of e. + real, intent(in) :: Z_bot !< Bottom of range being mapped to, in the units of e. integer, intent(in) :: k_max !< Number of valid layers. integer, intent(in) :: k_start !< Layer at which to start searching. integer, intent(inout) :: k_top !< Indices of top layers that overlap with the depth @@ -713,11 +718,11 @@ end subroutine find_overlap !! a piecewise limited scheme. subroutine find_limited_slope(val, e, slope, k) real, dimension(:), intent(in) :: val !< A column of values that are being interpolated. - real, dimension(:), intent(in) :: e !< Column interface heights (meter or kg/m2). + real, dimension(:), intent(in) :: e !< Column interface heights in arbitrary units real, intent(out) :: slope !< Normalized slope in the intracell distribution of val. integer, intent(in) :: k !< Layer whose slope is being determined. ! Local variables - real :: d1, d2 + real :: d1, d2 ! Thicknesses in the units of e. d1 = 0.5*(e(K-1)-e(K+1)) ; d2 = 0.5*(e(K)-e(K+2)) if (((val(k)-val(k-1)) * (val(k)-val(k+1)) >= 0.0) .or. (d1*d2 <= 0.0)) then @@ -773,8 +778,8 @@ subroutine calc_Zint_diags(h, in_ptrs, ids, num_diags, G, GV, CS) do k=1,nk ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo do i=is,ie dilate(i) = 0.0 - if (htot(i)*GV%H_to_m > 0.5) dilate(i) = (G%Zd_to_m*G%bathyT(i,j) - 0.0) / htot(i) - e(i,nk+1) = -G%Zd_to_m*G%bathyT(i,j) + if (htot(i) > 0.5*GV%m_to_H) dilate(i) = (G%bathyT(i,j) - 0.0) / htot(i) + e(i,nk+1) = -G%bathyT(i,j) enddo do k=nk,1,-1 ; do i=is,ie e(i,k) = e(i,k+1) + h(i,j,k) * dilate(i) @@ -964,8 +969,8 @@ subroutine MOM_diag_to_Z_init(Time, G, GV, param_file, diag, CS) character(len=200) :: in_dir, zgrid_file ! strings for directory/file character(len=48) :: flux_units, string integer :: z_axis, zint_axis - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nk, id_test - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nk = G%ke + integer :: k, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nk, id_test + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nk = G%ke IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB if (associated(CS)) then @@ -994,6 +999,7 @@ subroutine MOM_diag_to_Z_init(Time, G, GV, param_file, diag, CS) in_dir = slasher(in_dir) call get_Z_depths(trim(in_dir)//trim(zgrid_file), "zw", CS%Z_int, "zt", & z_axis, zint_axis, CS%nk_zspace) + do K=1,CS%nk_zspace+1 ; CS%Z_int(K) = GV%m_to_Z*CS%Z_int(K) ; enddo call log_param(param_file, mdl, "!INPUTDIR/Z_OUTPUT_GRID_FILE", & trim(in_dir)//trim(zgrid_file)) call log_param(param_file, mdl, "!NK_ZSPACE (from file)", CS%nk_zspace, & @@ -1051,7 +1057,7 @@ subroutine get_Z_depths(depth_file, int_depth_name, int_depth, cell_depth_name, character(len=*), intent(in) :: depth_file !< The file to read for the depths character(len=*), intent(in) :: int_depth_name !< The interface depth variable name real, dimension(:), pointer :: int_depth !< A pointer that will be allocated and - !! returned with the interface depths + !! returned with the interface depths in m character(len=*), intent(in) :: cell_depth_name !< The cell-center depth variable name integer, intent(out) :: z_axis_index !< The cell-center z-axis diagnostic index handle integer, intent(out) :: edge_index !< The interface z-axis diagnostic index handle From 703725889819b5348df2550bd4f0e36f993867f3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 1 Nov 2018 03:49:32 -0400 Subject: [PATCH 0872/1072] Clarified comments in Idealized_Hurricane Clarified comments in idealized_hurricane_wind_forcing. All answers are bitwise identical. --- src/user/Idealized_Hurricane.F90 | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90 index ca495882b6..80d727ddfc 100644 --- a/src/user/Idealized_Hurricane.F90 +++ b/src/user/Idealized_Hurricane.F90 @@ -268,8 +268,8 @@ subroutine idealized_hurricane_wind_forcing(state, forces, day, G, CS) YY = YC + CS%dy_from_center XX = XC else - LAT = G%geoLatCu(I,j)*1000. !KM_to_m - LON = G%geoLonCu(I,j)*1000. !KM_to_m + LAT = G%geoLatCu(I,j)*1000. ! Convert Lat from km to m. + LON = G%geoLonCu(I,j)*1000. ! Convert Lon from km to m. YY = LAT - YC XX = LON - XC endif @@ -291,13 +291,12 @@ subroutine idealized_hurricane_wind_forcing(state, forces, day, G, CS) YY = YC + CS%dy_from_center XX = XC else - LAT = G%geoLatCv(i,J)*1000. !KM_to_m - LON = G%geoLonCv(i,J)*1000. !KM_to_m + LAT = G%geoLatCv(i,J)*1000. ! Convert Lat from km to m. + LON = G%geoLonCv(i,J)*1000. ! Convert Lon from km to m. YY = LAT - YC XX = LON - XC endif - call idealized_hurricane_wind_profile(& - CS,f,YY,XX,Uocn,Vocn,TX,TY) + call idealized_hurricane_wind_profile(CS, f, YY, XX, Uocn, Vocn, TX, TY) forces%tauy(i,J) = G%mask2dCv(i,J) * TY enddo enddo @@ -316,7 +315,7 @@ subroutine idealized_hurricane_wind_forcing(state, forces, day, G, CS) end subroutine idealized_hurricane_wind_forcing !> Calculate the wind speed at a location as a function of time. -subroutine idealized_hurricane_wind_profile(CS,absf,YY,XX,UOCN,VOCN,Tx,Ty) +subroutine idealized_hurricane_wind_profile(CS, absf, YY, XX, UOCN, VOCN, Tx, Ty) ! Author: Brandon Reichl ! Date: Nov-20-2014 ! Aug-14-2018 Generalized for non-SCM configuration @@ -436,8 +435,8 @@ subroutine idealized_hurricane_wind_profile(CS,absf,YY,XX,UOCN,VOCN,Tx,Ty) endif ! Compute stress vector - TX = CS%rho_A * Cd * sqrt(du**2+dV**2) * dU - TY = CS%rho_A * Cd * sqrt(du**2+dV**2) * dV + TX = CS%rho_A * Cd * sqrt(du**2 + dV**2) * dU + TY = CS%rho_A * Cd * sqrt(du**2 + dV**2) * dV return end subroutine idealized_hurricane_wind_profile From 618c4752d264701b8fe83e0bd8519a5fac1e2020 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 2 Nov 2018 09:35:31 -0400 Subject: [PATCH 0873/1072] Combined scaling factors in build_adapt_column Combined two dimensional scaling factors whose product is also available in build_adapt_column. All answers are bitwise identical. --- src/ALE/coord_adapt.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/ALE/coord_adapt.F90 b/src/ALE/coord_adapt.F90 index 91ba50fab7..dcd6f6d8e8 100644 --- a/src/ALE/coord_adapt.F90 +++ b/src/ALE/coord_adapt.F90 @@ -18,7 +18,7 @@ module coord_adapt !> Number of layers/levels integer :: nk - !> Nominal near-surface resolution + !> Nominal near-surface resolution in H real, allocatable, dimension(:) :: coordinateResolution !> Ratio of optimisation and diffusion timescales @@ -52,7 +52,7 @@ module coord_adapt subroutine init_coord_adapt(CS, nk, coordinateResolution) type(adapt_CS), pointer :: CS !< Unassociated pointer to hold the control structure integer, intent(in) :: nk !< Number of layers in the grid - real, dimension(:), intent(in) :: coordinateResolution !< Nominal near-surface resolution (m) + real, dimension(:), intent(in) :: coordinateResolution !< Nominal near-surface resolution (H) if (associated(CS)) call MOM_error(FATAL, "init_coord_adapt: CS already associated") allocate(CS) @@ -126,7 +126,7 @@ subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) zNext(nz+1) = zInt(i,j,nz+1) ! local depth for scaling diffusivity - depth = G%bathyT(i,j) * G%Zd_to_m*GV%m_to_H + depth = G%bathyT(i,j) * GV%Z_to_H ! initialize del2sigma to zero del2sigma(:) = 0. From 7853e8343ca083b827d986fd82575682d4b26e92 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 2 Nov 2018 09:35:54 -0400 Subject: [PATCH 0874/1072] Corrected comments in build_sigma_column Corrected the dimensions used to describe arguments to build_sigma_column and other routines in coord_sigma. All answers are bitwise identical. --- src/ALE/coord_sigma.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/ALE/coord_sigma.F90 b/src/ALE/coord_sigma.F90 index bbb6312ba4..addb313a37 100644 --- a/src/ALE/coord_sigma.F90 +++ b/src/ALE/coord_sigma.F90 @@ -16,7 +16,7 @@ module coord_sigma !> Minimum thickness allowed for layers real :: min_thickness - !> Target coordinate resolution + !> Target coordinate resolution, nondimensional real, allocatable, dimension(:) :: coordinateResolution end type sigma_CS @@ -51,7 +51,7 @@ end subroutine end_coord_sigma !> This subroutine can be used to set the parameters for the coord_sigma module subroutine set_sigma_params(CS, min_thickness) type(sigma_CS), pointer :: CS !< Coordinate control structure - real, optional, intent(in) :: min_thickness !< Minimum allowed thickness, in m + real, optional, intent(in) :: min_thickness !< Minimum allowed thickness, in H if (.not. associated(CS)) call MOM_error(FATAL, "set_sigma_params: CS not associated") @@ -62,9 +62,9 @@ end subroutine set_sigma_params !> Build a sigma coordinate column subroutine build_sigma_column(CS, depth, totalThickness, zInterface) type(sigma_CS), intent(in) :: CS !< Coordinate control structure - real, intent(in) :: depth !< Depth of ocean bottom (positive in m) - real, intent(in) :: totalThickness !< Column thickness (positive in m) - real, dimension(CS%nk+1), intent(inout) :: zInterface !< Absolute positions of interfaces in m + real, intent(in) :: depth !< Depth of ocean bottom (positive in H, often m) + real, intent(in) :: totalThickness !< Column thickness (positive in H) + real, dimension(CS%nk+1), intent(inout) :: zInterface !< Absolute positions of interfaces in H ! Local variables integer :: k From c98fb73187b8e4d0220d525929762d54bc7f013d Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Fri, 2 Nov 2018 10:10:36 -0400 Subject: [PATCH 0875/1072] Diagnostics Downsample, implement Hallberg's suggestion - Could I suggest that we do the enumeration using 1,2,3 instead of 0,1,2, so that the 2-d variant PS (which would currently resolve to 1) can not be confused with the 3-d PPS (which would also resolve to 1). With 1,2,3, PS becomes 12, whereas PPS becomes 112. 0 could be reserved for no-axis. - There is still no need to have two digit codes, may be because there are no diagnostics with PP* in the full diag_table.MOM6 --- src/framework/MOM_diag_mediator.F90 | 68 ++++++++++++++--------------- 1 file changed, 34 insertions(+), 34 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 1f58e1489e..4973eaa3b3 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -143,23 +143,23 @@ module MOM_diag_mediator end type diag_grid_storage !> integers to encode the total cell methods -integer :: PPP=0 !< x:point,y:point,z:point -integer :: PPS=1 !< x:point,y:point,z:sum -integer :: PPM=2 !< x:point,y:point,z:mean -integer :: PSP=10 !< x:point,y:sum,z:point -integer :: PSS=11 !< x:point,y:sum,z:point -integer :: PSM=12 !< x:point,y:sum,z:mean -integer :: PMP=20 !< x:point,y:mean,z:point -integer :: PMM=22 !< x:point,y:mean,z:mean -integer :: SPP=100 !< x:sum,y:point,z:point -integer :: SPS=101 !< x:sum,y:point,z:sum -integer :: SSP=110 !< x:sum;y:sum,z:point -integer :: MPP=200 !< x:mean,y:point,z:point -integer :: MPM=202 !< x:mean,y:point,z:mean -integer :: MMP=220 !< x:mean,y:mean,z:point -integer :: MMS=221 !< x:mean,y:mean,z:sum -integer :: SSS=111 !< x:sum,y:sum,z:sum -integer :: MMM=222 !< x:mean,y:mean,z:mean +!integer :: PPP=111 !< x:point,y:point,z:point, this kind of diagnostic is not currently present in diag_table.MOM6 +!integer :: PPS=112 !< x:point,y:point,z:sum , this kind of diagnostic is not currently present in diag_table.MOM6 +!integer :: PPM=113 !< x:point,y:point,z:mean , this kind of diagnostic is not currently present in diag_table.MOM6 +integer :: PSP=121 !< x:point,y:sum,z:point +integer :: PSS=122 !< x:point,y:sum,z:point +integer :: PSM=123 !< x:point,y:sum,z:mean +integer :: PMP=131 !< x:point,y:mean,z:point +integer :: PMM=133 !< x:point,y:mean,z:mean +integer :: SPP=211 !< x:sum,y:point,z:point +integer :: SPS=212 !< x:sum,y:point,z:sum +integer :: SSP=221 !< x:sum;y:sum,z:point +integer :: MPP=311 !< x:mean,y:point,z:point +integer :: MPM=313 !< x:mean,y:point,z:mean +integer :: MMP=331 !< x:mean,y:mean,z:point +integer :: MMS=332 !< x:mean,y:mean,z:sum +integer :: SSS=222 !< x:sum,y:sum,z:sum +integer :: MMM=333 !< x:mean,y:mean,z:mean integer :: MSK=-1 !< Use the downsample method of a mask !> This type is used to represent a diagnostic at the diag_mediator level. @@ -2339,11 +2339,11 @@ subroutine add_xyz_method(diag, axes, x_cell_method, y_cell_method, v_cell_metho !This is a simple way to encode the cell method information made from 3 strings !(x_cell_method,y_cell_method,v_cell_method) in a 3 digit integer xyz !x_cell_method,y_cell_method,v_cell_method can each be 'point' or 'sum' or 'mean' - !We can encode these with setting 0 for 'point', 1 for 'sum, 2 for 'mean' in + !We can encode these with setting 1 for 'point', 2 for 'sum, 3 for 'mean' in !the 100s position for x, 10s position for y, 1s position for z - !E.g., x:sum,y:point,z:mean is 102 + !E.g., x:sum,y:point,z:mean is 213 - xyz_method = 0 + xyz_method = 111 mstr = diag%axes%v_cell_method if (present(v_extensive)) then @@ -3732,7 +3732,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d allocate(field_out(1:f1,1:f2,ks:ke)) !Fill the downsampled field on the downsampled diagnostics (almost always compuate) domain - if(method .eq. MMM) then !xyz_method = MMM = 222 + if(method .eq. MMM) then do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d i0 = isv_o+dl*(i-isv_d) j0 = jsv_o+dl*(j-jsv_d) @@ -3746,7 +3746,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d enddo; enddo field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo - elseif(method .eq. SSS) then !xyz_method = SSS = 111 e.g., volcello + elseif(method .eq. SSS) then !e.g., volcello do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d i0 = isv_o+dl*(i-isv_d) j0 = jsv_o+dl*(j-jsv_d) @@ -3760,7 +3760,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d enddo; enddo field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo - elseif(method .eq. MMP .or. method .eq. MMS) then !xyz_method = MMP = 220, e.g., or T_advection_xy + elseif(method .eq. MMP .or. method .eq. MMS) then !e.g., T_advection_xy do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d i0 = isv_o+dl*(i-isv_d) j0 = jsv_o+dl*(j-jsv_d) @@ -3774,7 +3774,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d enddo; enddo field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo - elseif(method .eq. PMM) then !xyz_method = PMM = 022 + elseif(method .eq. PMM) then do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d i0 = isv_o+dl*(i-isv_d) j0 = jsv_o+dl*(j-jsv_d) @@ -3788,7 +3788,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d enddo field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo - elseif(method .eq. PSM) then !xyz_method = PSM = 012 + elseif(method .eq. PSM) then do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d i0 = isv_o+dl*(i-isv_d) j0 = jsv_o+dl*(j-jsv_d) @@ -3802,7 +3802,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d enddo field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo - elseif(method .eq. PSS) then !xyz_method = PSS = 011 e.g. umo + elseif(method .eq. PSS) then !e.g. umo do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d i0 = isv_o+dl*(i-isv_d) j0 = jsv_o+dl*(j-jsv_d) @@ -3816,7 +3816,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d enddo field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo - elseif(method .eq. SPS) then !xyz_method = SPS = 101 e.g. vmo + elseif(method .eq. SPS) then !e.g. vmo do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d i0 = isv_o+dl*(i-isv_d) j0 = jsv_o+dl*(j-jsv_d) @@ -3830,7 +3830,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d enddo field_out(i,j,k) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo; enddo - elseif(method .eq. MPM) then !xyz_method = MPM = 202 + elseif(method .eq. MPM) then do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d i0 = isv_o+dl*(i-isv_d) j0 = jsv_o+dl*(j-jsv_d) @@ -3893,7 +3893,7 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs,di endif allocate(field_out(1:f1,1:f2)) - if(method .eq. MMP) then !xyz_method = MMP + if(method .eq. MMP) then do j=jsv_d,jev_d ; do i=isv_d,iev_d i0 = isv_o+dl*(i-isv_d) j0 = jsv_o+dl*(j-jsv_d) @@ -3907,7 +3907,7 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs,di enddo; enddo field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo - elseif(method .eq. SSP) then !xyz_method = SSP , e.g., T_dfxy_cont_tendency_2d + elseif(method .eq. SSP) then ! e.g., T_dfxy_cont_tendency_2d do j=jsv_d,jev_d ; do i=isv_d,iev_d i0 = isv_o+dl*(i-isv_d) j0 = jsv_o+dl*(j-jsv_d) @@ -3921,7 +3921,7 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs,di enddo; enddo field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo - elseif(method .eq. PSP) then !xyz_method = PSP = 010, e.g., umo_2d + elseif(method .eq. PSP) then ! e.g., umo_2d do j=jsv_d,jev_d ; do i=isv_d,iev_d i0 = isv_o+dl*(i-isv_d) j0 = jsv_o+dl*(j-jsv_d) @@ -3935,7 +3935,7 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs,di enddo field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo - elseif(method .eq. SPP) then !xyz_method = SPP = 100, e.g., vmo_2d + elseif(method .eq. SPP) then ! e.g., vmo_2d do j=jsv_d,jev_d ; do i=isv_d,iev_d i0 = isv_o+dl*(i-isv_d) j0 = jsv_o+dl*(j-jsv_d) @@ -3949,7 +3949,7 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs,di enddo field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo - elseif(method .eq. PMP) then !xyz_method = PMP = 020 + elseif(method .eq. PMP) then do j=jsv_d,jev_d ; do i=isv_d,iev_d i0 = isv_o+dl*(i-isv_d) j0 = jsv_o+dl*(j-jsv_d) @@ -3963,7 +3963,7 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs,di enddo field_out(i,j) = ave/(total_weight+epsilon) !Avoid zero mask at all aggregating cells where ave=0.0 enddo; enddo - elseif(method .eq. MPP) then !xyz_method = MPP = 200 + elseif(method .eq. MPP) then do j=jsv_d,jev_d ; do i=isv_d,iev_d i0 = isv_o+dl*(i-isv_d) j0 = jsv_o+dl*(j-jsv_d) From cd2648d9a3b79219a1cd4676ae879b276ab2ae64 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 2 Nov 2018 13:16:21 -0600 Subject: [PATCH 0876/1072] Take meltw into account when adjust_net_fresh_water_to_zero=true --- config_src/mct_driver/MOM_surface_forcing.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 5bc8fdd97a..1145ab346c 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -480,7 +480,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & ! adjust the NET fresh-water flux to zero, if flagged if (CS%adjust_net_fresh_water_to_zero) then do j=js,je ; do i=is,ie - net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j)) + & + net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j) + fluxes%meltw(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 From 622d19ec8d9a06611da1b2a00a6de69a8f659c94 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 2 Nov 2018 13:17:58 -0600 Subject: [PATCH 0877/1072] Delete comment on whether meltw is needed in PRmE --- src/core/MOM_forcing_type.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 0d708a0e36..4755358d73 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -2123,7 +2123,6 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%lrunoff)) res(i,j) = res(i,j)+fluxes%lrunoff(i,j) if (associated(fluxes%frunoff)) res(i,j) = res(i,j)+fluxes%frunoff(i,j) if (associated(fluxes%vprec)) res(i,j) = res(i,j)+fluxes%vprec(i,j) - ! GMM, not sure if meltw is needed here. If so, the name prcme is misleading. if (associated(fluxes%meltw)) res(i,j) = res(i,j)+fluxes%meltw(i,j) enddo ; enddo call post_data(handles%id_prcme, res, diag) From 3cd18cac64c750826b7e3c2d5b15be0e93cb14ab Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 2 Nov 2018 13:19:01 -0600 Subject: [PATCH 0878/1072] Sets CS%ignore_fluxes_over_land = .false. when ePBL is not used --- src/parameterizations/vertical/MOM_diabatic_aux.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index f662eda365..ee412b358c 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -1337,7 +1337,10 @@ subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm, call get_param(param_file, mod, "RIVERMIX_DEPTH", CS%rivermix_depth, & "The depth to which rivers are mixed if DO_RIVERMIX is \n"//& "defined.", units="m", default=0.0) - else ; CS%do_rivermix = .false. ; CS%rivermix_depth = 0.0 ; endif + else + CS%do_rivermix = .false. ; CS%rivermix_depth = 0.0 ; CS%ignore_fluxes_over_land = .false. + endif + if (GV%nkml == 0) then call get_param(param_file, mod, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, & "If true, use the fluxes%runoff_Hflx field to set the \n"//& From ac5ff385c48c047cc87728476e38ce14940685e5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 2 Nov 2018 09:41:46 -0400 Subject: [PATCH 0879/1072] +Pass max_depth to initialize_regridding in Z Changed the units of the max_depth argument to initialize_regridding and ALE_init from m to Z, and store CoordinateResolution in Z instead of m for most coordinates (sigma an rho are the two counterexamples). Internally this involved adding an new optional scaling argument to setCoordinateResolution and a new optional unde_scaling argument to getCoordinateResolution, and a new element coord_Scale in the regridding_CS. Elsewhere this required changing the zScale arguments to build_zlike_column. Also rescaled GV%max_depth to Z for consistency with what is in the documentation. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- src/ALE/MOM_ALE.F90 | 16 +-- src/ALE/MOM_regridding.F90 | 136 +++++++++++------- src/core/MOM.F90 | 9 +- src/framework/MOM_diag_remap.F90 | 2 +- .../MOM_coord_initialization.F90 | 2 +- .../MOM_state_initialization.F90 | 4 +- 6 files changed, 103 insertions(+), 66 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 192b278a09..45a79a02f0 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -26,7 +26,7 @@ module MOM_ALE use MOM_interface_heights,only : find_eta use MOM_regridding, only : initialize_regridding, regridding_main, end_regridding use MOM_regridding, only : uniformResolution -use MOM_regridding, only : inflate_vanished_layers_old, setCoordinateResolution +use MOM_regridding, only : inflate_vanished_layers_old use MOM_regridding, only : set_target_densities_from_GV, set_target_densities use MOM_regridding, only : regriddingCoordinateModeDoc, DEFAULT_COORDINATE_MODE use MOM_regridding, only : regriddingInterpSchemeDoc, regriddingDefaultInterpScheme @@ -130,7 +130,7 @@ module MOM_ALE subroutine ALE_init( param_file, GV, max_depth, CS) type(param_file_type), intent(in) :: param_file !< Parameter file type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, intent(in) :: max_depth !< The maximum depth of the ocean, in m. + real, intent(in) :: max_depth !< The maximum depth of the ocean, in Z. type(ALE_CS), pointer :: CS !< Module control structure ! Local variables @@ -298,7 +298,7 @@ subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt, frac_shelf_h) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the - !! last time step (m or Pa) + !! last time step in H (often m or Pa) real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity field (m/s) real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< Meridional velocity field (m/s) type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure @@ -1098,7 +1098,7 @@ end subroutine pressure_gradient_ppm !> Initializes regridding for the main ALE algorithm subroutine ALE_initRegridding(GV, max_depth, param_file, mdl, regridCS) type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, intent(in) :: max_depth !< The maximum depth of the ocean, in m. + real, intent(in) :: max_depth !< The maximum depth of the ocean, in Z. type(param_file_type), intent(in) :: param_file !< parameter file character(len=*), intent(in) :: mdl !< Name of calling module type(regridding_CS), intent(out) :: regridCS !< Regridding parameters and work arrays @@ -1120,7 +1120,7 @@ function ALE_getCoordinate( CS ) type(ALE_CS), pointer :: CS !< module control structure real, dimension(CS%nk+1) :: ALE_getCoordinate - ALE_getCoordinate(:) = getCoordinateInterfaces( CS%regridCS ) + ALE_getCoordinate(:) = getCoordinateInterfaces( CS%regridCS, undo_scaling=.true. ) end function ALE_getCoordinate @@ -1171,7 +1171,7 @@ subroutine ALE_updateVerticalGridType(CS, GV) integer :: nk nk = GV%ke - GV%sInterface(1:nk+1) = getCoordinateInterfaces( CS%regridCS ) + GV%sInterface(1:nk+1) = getCoordinateInterfaces( CS%regridCS, undo_scaling=.true. ) GV%sLayer(1:nk) = 0.5*( GV%sInterface(1:nk) + GV%sInterface(2:nk+1) ) GV%zAxisUnits = getCoordinateUnits( CS%regridCS ) GV%zAxisLongName = getCoordinateShortName( CS%regridCS ) @@ -1196,7 +1196,7 @@ subroutine ALE_writeCoordinateFile( CS, GV, directory ) real :: ds(GV%ke), dsi(GV%ke+1) filepath = trim(directory) // trim("Vertical_coordinate") - ds(:) = getCoordinateResolution( CS%regridCS ) + ds(:) = getCoordinateResolution( CS%regridCS, undo_scaling=.true. ) dsi(1) = 0.5*ds(1) dsi(2:GV%ke) = 0.5*( ds(1:GV%ke-1) + ds(2:GV%ke) ) dsi(GV%ke+1) = 0.5*ds(GV%ke) @@ -1225,7 +1225,7 @@ subroutine ALE_initThicknessToCoord( CS, G, GV, h ) integer :: i, j, k do j = G%jsd,G%jed ; do i = G%isd,G%ied - h(i,j,:) = GV%m_to_H * getStaticThickness( CS%regridCS, 0., G%Zd_to_m*G%bathyT(i,j) ) + h(i,j,:) = GV%Z_to_H * getStaticThickness( CS%regridCS, 0., G%bathyT(i,j) ) enddo ; enddo end subroutine ALE_initThicknessToCoord diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 1e7da482a3..8efd78ed07 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -36,15 +36,18 @@ module MOM_regridding #include !> Regridding control structure -type, public :: regridding_CS - private +type, public :: regridding_CS ; private !> This array is set by function setCoordinateResolution() !! It contains the "resolution" or delta coordinate of the target !! coorindate. It has the units of the target coordinate, e.g. - !! meters for z*, non-dimensional for sigma, etc. + !! Z (often meters) for z*, non-dimensional for sigma, etc. real, dimension(:), allocatable :: coordinateResolution + !> This is a scaling factor that restores coordinateResolution to values in + !! the natural units for output. + real :: coord_scale = 1.0 + !> This array is set by function set_target_densities() !! This array is the nominal coordinate of interfaces and is the !! running sum of coordinateResolution. i.e. @@ -167,7 +170,7 @@ module MOM_regridding subroutine initialize_regridding(CS, GV, max_depth, param_file, mdl, coord_mode, param_prefix, param_suffix) type(regridding_CS), intent(inout) :: CS !< Regridding control structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, intent(in) :: max_depth !< The maximum depth of the ocean, in m. + real, intent(in) :: max_depth !< The maximum depth of the ocean, in Z. type(param_file_type), intent(in) :: param_file !< Parameter file character(len=*), intent(in) :: mdl !< Name of calling module. character(len=*), intent(in) :: coord_mode !< Coordinate mode @@ -184,6 +187,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mdl, coord_mode, logical :: tmpLogical, fix_haloclines, set_max, do_sum, main_parameters logical :: coord_is_state_dependent, ierr real :: filt_len, strat_tol, index_scale, tmpReal + real :: maximum_depth !< The maximum depth of the ocean, in m. real :: dz_fixed_sfc, Rho_avg_depth, nlay_sfc_int real :: adaptTimeRatio, adaptZoom, adaptZoomCoeff, adaptBuoyCoeff, adaptAlpha integer :: nz_fixed_sfc, k, nzf(4) @@ -210,6 +214,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mdl, coord_mode, CS%nk = 0 CS%regridding_scheme = coordinateMode(coord_mode) coord_is_state_dependent = state_dependent(coord_mode) + maximum_depth = GV%Z_to_m*max_depth if (main_parameters) then ! Read coordinate units parameter (main model = REGRIDDING_COORDINATE_UNITS) @@ -259,7 +264,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mdl, coord_mode, param_name = trim(param_prefix)//"_DEF_"//trim(param_suffix) coord_res_param = trim(param_prefix)//"_RES_"//trim(param_suffix) string2 = 'UNIFORM' - if (max_depth>3000.) string2='WOA09' ! For convenience + if (maximum_depth>3000.) string2='WOA09' ! For convenience endif call get_param(param_file, mdl, param_name, string, & "Determines how to specify the coordinate\n"//& @@ -285,11 +290,11 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mdl, coord_mode, if (index(trim(string),'UNIFORM')==1) then if (len_trim(string)==7) then ke = GV%ke ! Use model nk by default - tmpReal = max_depth + tmpReal = maximum_depth elseif (index(trim(string),'UNIFORM:')==1 .and. len_trim(string)>8) then ! Format is "UNIFORM:N" or "UNIFORM:N,dz" ke = extract_integer(string(9:len_trim(string)),'',1) - tmpReal = extract_real(string(9:len_trim(string)),',',2,missing_value=max_depth) + tmpReal = extract_real(string(9:len_trim(string)),',',2,missing_value=maximum_depth) else call MOM_error(FATAL,trim(mdl)//', initialize_regridding: '// & 'Unable to interpret "'//trim(string)//'".') @@ -409,7 +414,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mdl, coord_mode, elseif (index(trim(string),'WOA09')==1) then if (len_trim(string)==5) then tmpReal = 0. ; ke = 0 - do while (tmpReal max_depth) then - if ( dz(ke) + ( max_depth - tmpReal ) > 0. ) then - dz(ke) = dz(ke) + ( max_depth - tmpReal ) + if (tmpReal < maximum_depth) then + dz(ke) = dz(ke) + ( maximum_depth - tmpReal ) + elseif (tmpReal > maximum_depth) then + if ( dz(ke) + ( maximum_depth - tmpReal ) > 0. ) then + dz(ke) = dz(ke) + ( maximum_depth - tmpReal ) else call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & "MAXIMUM_DEPTH was too shallow to adjust bottom layer of DZ!"//trim(string)) @@ -457,7 +462,18 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mdl, coord_mode, allocate( CS%target_density(CS%nk+1) ); CS%target_density(:) = -1.E30 endif - if (allocated(dz)) call setCoordinateResolution(dz, CS) + if (allocated(dz)) then + if ((coordinateMode(coord_mode) == REGRIDDING_SIGMA) .or. & + (coordinateMode(coord_mode) == REGRIDDING_RHO)) then + call setCoordinateResolution(dz, CS, scale=1.0) + elseif (coordinateMode(coord_mode) == REGRIDDING_ADAPTIVE) then + call setCoordinateResolution(dz, CS, scale=GV%m_to_H) + CS%coord_scale = GV%H_to_m + else + call setCoordinateResolution(dz, CS, scale=GV%m_to_Z) + CS%coord_scale = GV%Z_to_m + endif + endif if (allocated(rho_target)) then call set_target_densities(CS, rho_target) @@ -484,9 +500,9 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mdl, coord_mode, if (main_parameters) then call get_param(param_file, mdl, "MIN_THICKNESS", tmpReal, & "When regridding, this is the minimum layer\n"//& - "thickness allowed.", units="m",& + "thickness allowed.", units="m", scale=GV%m_to_H, & default=regriddingDefaultMinThickness ) - call set_regrid_params(CS, min_thickness=tmpReal*GV%m_to_H) + call set_regrid_params(CS, min_thickness=tmpReal) else call set_regrid_params(CS, min_thickness=0.) endif @@ -762,7 +778,7 @@ subroutine end_regridding(CS) end subroutine end_regridding !------------------------------------------------------------------------------ -!> Dispatching regridding routine for orchestrating regridding & remapping +!> Dispatching regridding routine for orchestrating regridding & remapping subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, frac_shelf_h, conv_adjust) !------------------------------------------------------------------------------ ! This routine takes care of (1) building a new grid and (2) remapping between @@ -859,11 +875,11 @@ end subroutine regridding_main !> Calculates h_new from h + delta_k dzInterface subroutine calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new) type(regridding_CS), intent(in) :: CS !< Regridding control structure - type(ocean_grid_type), intent(in) :: G !< Grid structure + type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Old layer thicknesses (m) - real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(in) :: dzInterface !< Change in interface positions (m) - real, dimension(SZI_(G),SZJ_(G),CS%nk), intent(inout) :: h_new !< New layer thicknesses (m) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Old layer thicknesses (arbitrary units) + real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(in) :: dzInterface !< Change in interface positions (same as h) + real, dimension(SZI_(G),SZJ_(G),CS%nk), intent(inout) :: h_new !< New layer thicknesses (same as h) ! Local variables integer :: i, j, k, nki @@ -902,20 +918,18 @@ subroutine check_remapping_grid( G, GV, h, dzInterface, msg ) integer :: i, j !$OMP parallel do default(shared) - do j = G%jsc-1,G%jec+1 - do i = G%isc-1,G%iec+1 - if (G%mask2dT(i,j)>0.) call check_grid_column( GV%ke, G%Zd_to_m*G%bathyT(i,j), h(i,j,:), dzInterface(i,j,:), msg ) - enddo - enddo + do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 + if (G%mask2dT(i,j)>0.) call check_grid_column( GV%ke, GV%Z_to_H*G%bathyT(i,j), h(i,j,:), dzInterface(i,j,:), msg ) + enddo ; enddo end subroutine check_remapping_grid !> Check that the total thickness of new and old grids are consistent subroutine check_grid_column( nk, depth, h, dzInterface, msg ) integer, intent(in) :: nk !< Number of cells - real, intent(in) :: depth !< Depth of bottom (m) - real, dimension(nk), intent(in) :: h !< Cell thicknesses (m) - real, dimension(nk+1), intent(in) :: dzInterface !< Change in interface positions (m) + real, intent(in) :: depth !< Depth of bottom (m or arbitrary units) + real, dimension(nk), intent(in) :: h !< Cell thicknesses (m or arbitrary units) + real, dimension(nk+1), intent(in) :: dzInterface !< Change in interface positions (same units as h) character(len=*), intent(in) :: msg !< Message to append to errors ! Local variables integer :: k @@ -1164,14 +1178,14 @@ subroutine build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h) if (frac_shelf_h(i,j) > 0.) then ! under ice shelf call build_zstar_column(CS%zlike_CS, nominalDepth, totalThickness, zNew, & z_rigid_top = totalThickness-nominalDepth, & - eta_orig=zOld(1), zScale=GV%m_to_H) + eta_orig=zOld(1), zScale=GV%Z_to_H) else call build_zstar_column(CS%zlike_CS, nominalDepth, totalThickness, & - zNew, zScale=GV%m_to_H) + zNew, zScale=GV%Z_to_H) endif else call build_zstar_column(CS%zlike_CS, nominalDepth, totalThickness, & - zNew, zScale=GV%m_to_H) + zNew, zScale=GV%Z_to_H) endif ! Calculate the final change in grid position after blending new and old grids @@ -1456,7 +1470,7 @@ subroutine build_grid_HyCOM1( G, GV, h, tv, h_new, dzInterface, CS ) call build_hycom1_column(CS%hycom_CS, tv%eqn_of_state, GV%ke, depth, & h(i, j, :), tv%T(i, j, :), tv%S(i, j, :), p_col, & - z_col, z_col_new, zScale=GV%m_to_H, & + z_col, z_col_new, zScale=GV%Z_to_H, & h_neglect=h_neglect, h_neglect_edge=h_neglect_edge) ! Calculate the final change in grid position after blending new and old grids @@ -1945,14 +1959,19 @@ end subroutine initCoord !------------------------------------------------------------------------------ !> Set the fixed resolution data -subroutine setCoordinateResolution( dz, CS ) +subroutine setCoordinateResolution( dz, CS, scale ) real, dimension(:), intent(in) :: dz !< A vector of vertical grid spacings type(regridding_CS), intent(inout) :: CS !< Regridding control structure + real, optional, intent(in) :: scale !< A scaling factor converting dz to coordRes if (size(dz)/=CS%nk) call MOM_error( FATAL, & 'setCoordinateResolution: inconsistent number of levels' ) - CS%coordinateResolution(:) = dz(:) + if (present(scale)) then + CS%coordinateResolution(:) = scale*dz(:) + else + CS%coordinateResolution(:) = dz(:) + endif end subroutine setCoordinateResolution @@ -2054,20 +2073,33 @@ end subroutine set_regrid_max_thickness !------------------------------------------------------------------------------ !> Query the fixed resolution data -function getCoordinateResolution( CS ) +function getCoordinateResolution( CS, undo_scaling ) type(regridding_CS), intent(in) :: CS !< Regridding control structure + logical, optional, intent(in) :: undo_scaling !< If present and true, undo any internal + !! rescaling of the resolution data. real, dimension(CS%nk) :: getCoordinateResolution - getCoordinateResolution(:) = CS%coordinateResolution(:) + logical :: unscale + unscale = .false. ; if (present(undo_scaling)) unscale = undo_scaling + + if (unscale) then + getCoordinateResolution(:) = CS%coord_scale * CS%coordinateResolution(:) + else + getCoordinateResolution(:) = CS%coordinateResolution(:) + endif end function getCoordinateResolution !> Query the target coordinate interface positions -function getCoordinateInterfaces( CS ) +function getCoordinateInterfaces( CS, undo_scaling ) type(regridding_CS), intent(in) :: CS !< Regridding control structure + logical, optional, intent(in) :: undo_scaling !< If present and true, undo any internal + !! rescaling of the resolution data. real, dimension(CS%nk+1) :: getCoordinateInterfaces !< Interface positions in target coordinate integer :: k + logical :: unscale + unscale = .false. ; if (present(undo_scaling)) unscale = undo_scaling ! When using a coordinate with target densities, we need to get the actual ! densities, rather than computing the interfaces based on resolution @@ -2078,11 +2110,19 @@ function getCoordinateInterfaces( CS ) getCoordinateInterfaces(:) = CS%target_density(:) else - getCoordinateInterfaces(1) = 0. - do k = 1, CS%nk - getCoordinateInterfaces(k+1) = getCoordinateInterfaces(k) & - -CS%coordinateResolution(k) - enddo + if (unscale) then + getCoordinateInterfaces(1) = 0. + do k = 1, CS%nk + getCoordinateInterfaces(K+1) = getCoordinateInterfaces(K) - & + CS%coord_scale * CS%coordinateResolution(k) + enddo + else + getCoordinateInterfaces(1) = 0. + do k = 1, CS%nk + getCoordinateInterfaces(K+1) = getCoordinateInterfaces(K) - & + CS%coordinateResolution(k) + enddo + endif ! The following line has an "abs()" to allow ferret users to reference ! data by index. It is a temporary work around... :( -AJA getCoordinateInterfaces(:) = abs( getCoordinateInterfaces(:) ) @@ -2290,9 +2330,9 @@ function getStaticThickness( CS, SSH, depth ) z = ssh do k = 1, CS%nk dz = CS%coordinateResolution(k) * ( 1. + ssh/depth ) ! Nominal dz* - dz = max(dz, 0.) ! Avoid negative incase ssh=-depth - dz = min(dz, depth - z) ! Clip if below topography - z = z + dz ! Bottom of layer + dz = max(dz, 0.) ! Avoid negative incase ssh=-depth + dz = min(dz, depth - z) ! Clip if below topography + z = z + dz ! Bottom of layer getStaticThickness(k) = dz enddo else diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 8968c888ae..bcb1dee9fa 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1972,7 +1972,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Allocate initialize time-invariant MOM variables. call MOM_initialize_fixed(dG, CS%OBC, param_file, write_geom_files, dirs%output_directory) call callTree_waypoint("returned from MOM_initialize_fixed() (initialize_MOM)") - ! This could replace a later call to rescale_grid_bathymetry. + if (dG%Zd_to_m /= GV%Z_to_m) call rescale_dyn_horgrid_bathymetry(dG, GV%Z_to_m) if (associated(CS%OBC)) call call_OBC_register(param_file, CS%update_OBC_CSp, CS%OBC) @@ -2133,11 +2133,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Initialize dynamically evolving fields, perhaps from restart files. call cpu_clock_begin(id_clock_MOM_init) call MOM_initialize_coord(GV, param_file, write_geom_files, & - dirs%output_directory, CS%tv, dG%max_depth*dG%Zd_to_m) + dirs%output_directory, CS%tv, dG%max_depth) call callTree_waypoint("returned from MOM_initialize_coord() (initialize_MOM)") if (CS%use_ALE_algorithm) then - call ALE_init(param_file, GV, dG%max_depth*dG%Zd_to_m, CS%ALE_CSp) + call ALE_init(param_file, GV, dG%max_depth, CS%ALE_CSp) call callTree_waypoint("returned from ALE_init() (initialize_MOM)") endif @@ -2149,9 +2149,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call copy_dyngrid_to_MOM_grid(dG, G) call destroy_dyn_horgrid(dG) - ! This could replace an earlier call to rescale_dyn_horgrid_bathymetry just after MOM_initialize_fixed. - ! if (G%Zd_to_m /= GV%Z_to_m) call rescale_grid_bathymetry(G, GV%Z_to_m) - ! Set a few remaining fields that are specific to the ocean grid type. call set_first_direction(G, first_direction) ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index be3a02f777..4cb122b38e 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -270,7 +270,7 @@ subroutine diag_remap_update(remap_cs, G, GV, h, T, S, eqn_of_state) if (remap_cs%vertical_coord == coordinateMode('ZSTAR')) then call build_zstar_column(get_zlike_CS(remap_cs%regrid_cs), & GV%Z_to_H*G%bathyT(i,j), sum(h(i,j,:)), & - zInterfaces, zScale=GV%m_to_H) + zInterfaces, zScale=GV%Z_to_H) elseif (remap_cs%vertical_coord == coordinateMode('SIGMA')) then call build_sigma_column(get_sigma_CS(remap_cs%regrid_cs), & GV%Z_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index e1674a1500..7126548402 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -37,7 +37,7 @@ subroutine MOM_initialize_coord(GV, PF, write_geom, output_dir, tv, max_depth) logical, intent(in) :: write_geom !< If true, write grid geometry files. character(len=*), intent(in) :: output_dir !< The directory into which to write files. type(thermo_var_ptrs), intent(inout) :: tv !< The thermodynamic variable structure. - real, intent(in) :: max_depth !< The ocean's maximum depth, in m. + real, intent(in) :: max_depth !< The ocean's maximum depth, in Z. ! Local character(len=200) :: config logical :: debug diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 7d798f1271..f6f2ae97b8 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -2184,12 +2184,12 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) ! Build the target grid (and set the model thickness to it) ! This call can be more general but is hard-coded for z* coordinates... ???? - call ALE_initRegridding( GV, GV%Z_to_m*G%max_depth, PF, mdl, regridCS ) ! sets regridCS + call ALE_initRegridding( GV, G%max_depth, PF, mdl, regridCS ) ! sets regridCS if (.not. remap_general) then ! This is the old way of initializing to z* coordinates only allocate( hTarget(nz) ) - hTarget = GV%m_to_Z * getCoordinateResolution( regridCS ) + hTarget = getCoordinateResolution( regridCS ) do j = js, je ; do i = is, ie h(i,j,:) = 0. if (G%mask2dT(i,j)>0.) then From 989b12c17c0b7e97842ec95636b824a1b427ea43 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 2 Nov 2018 17:21:12 -0400 Subject: [PATCH 0880/1072] Corrected comments in build_zlike_column Corrected the dimensions used to describe arguments to build_zlike_column and other routines in coord_zlike. All answers are bitwise identical. --- src/ALE/coord_zlike.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/ALE/coord_zlike.F90 b/src/ALE/coord_zlike.F90 index 7eafb5d5a6..78e38ecd1b 100644 --- a/src/ALE/coord_zlike.F90 +++ b/src/ALE/coord_zlike.F90 @@ -17,7 +17,7 @@ module coord_zlike !! be used in all subsequent calls to build_zstar_column with this structure. real :: min_thickness - !> Target coordinate resolution, usually in m + !> Target coordinate resolution, usually in Z (often m) real, allocatable, dimension(:) :: coordinateResolution end type zlike_CS @@ -29,7 +29,7 @@ module coord_zlike subroutine init_coord_zlike(CS, nk, coordinateResolution) type(zlike_CS), pointer :: CS !< Unassociated pointer to hold the control structure integer, intent(in) :: nk !< Number of levels in the grid - real, dimension(:), intent(in) :: coordinateResolution !< Target coordinate resolution, in m + real, dimension(:), intent(in) :: coordinateResolution !< Target coordinate resolution, in Z (often m) if (associated(CS)) call MOM_error(FATAL, "init_coord_zlike: CS already associated!") allocate(CS) @@ -52,7 +52,7 @@ end subroutine end_coord_zlike !> Set parameters in the zlike structure subroutine set_zlike_params(CS, min_thickness) type(zlike_CS), pointer :: CS !< Coordinate control structure - real, optional, intent(in) :: min_thickness !< Minimum allowed thickness, in m + real, optional, intent(in) :: min_thickness !< Minimum allowed thickness, in H if (.not. associated(CS)) call MOM_error(FATAL, "set_zlike_params: CS not associated") @@ -63,7 +63,7 @@ end subroutine set_zlike_params subroutine build_zstar_column(CS, depth, total_thickness, zInterface, & z_rigid_top, eta_orig, zScale) type(zlike_CS), intent(in) :: CS !< Coordinate control structure - real, intent(in) :: depth !< Depth of ocean bottom (positive in m or H) + real, intent(in) :: depth !< Depth of ocean bottom (positive in the output units) real, intent(in) :: total_thickness !< Column thickness (positive in the same units as depth) real, dimension(CS%nk+1), intent(inout) :: zInterface !< Absolute positions of interfaces real, optional, intent(in) :: z_rigid_top !< The height of a rigid top (negative in the @@ -71,7 +71,7 @@ subroutine build_zstar_column(CS, depth, total_thickness, zInterface, & real, optional, intent(in) :: eta_orig !< The actual original height of the top in the !! same units as depth real, optional, intent(in) :: zScale !< Scaling factor from the target coordinate resolution - !! in m to desired units for zInterface, perhaps m_to_H + !! in Z to desired units for zInterface, perhaps Z_to_H ! Local variables real :: eta, stretching, dh, min_thickness, z0_top, z_star, z_scale integer :: k From 0948407f5782175ca93f8fc3610fde5107ea1e57 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 2 Nov 2018 17:28:46 -0400 Subject: [PATCH 0881/1072] Set coord_adapt and coord_slight parameters in H Rescale coord_adapt and coord_slight parameters to H in the get_param calls, and pass them to these modules in rescaled units. Also convert the units of the e_preale diagnostic via the post_data call. All answers in the MOM6-examples test cases are bitwise identical in the MOM6 test cases. --- src/ALE/MOM_ALE.F90 | 15 ++++--- src/ALE/MOM_regridding.F90 | 50 +++++++++++------------ src/ALE/coord_adapt.F90 | 36 +++++++++++------ src/ALE/coord_slight.F90 | 81 ++++++++++++++++++++++---------------- 4 files changed, 102 insertions(+), 80 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 45a79a02f0..98eeda2dce 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -32,8 +32,6 @@ module MOM_ALE use MOM_regridding, only : regriddingInterpSchemeDoc, regriddingDefaultInterpScheme use MOM_regridding, only : regriddingDefaultBoundaryExtrapolation use MOM_regridding, only : regriddingDefaultMinThickness -use MOM_regridding, only : set_regrid_max_depths -use MOM_regridding, only : set_regrid_max_thickness use MOM_regridding, only : regridding_CS, set_regrid_params use MOM_regridding, only : getCoordinateInterfaces, getCoordinateResolution use MOM_regridding, only : getCoordinateUnits, getCoordinateShortName @@ -205,14 +203,15 @@ subroutine ALE_init( param_file, GV, max_depth, CS) units="s", default=0.) call get_param(param_file, mdl, "REGRID_FILTER_SHALLOW_DEPTH", filter_shallow_depth, & "The depth above which no time-filtering is applied. Above this depth\n"//& - "final grid exactly matches the target (new) grid.", units="m", default=0.) + "final grid exactly matches the target (new) grid.", & + units="m", default=0., scale=GV%m_to_H) call get_param(param_file, mdl, "REGRID_FILTER_DEEP_DEPTH", filter_deep_depth, & "The depth below which full time-filtering is applied with time-scale\n"//& "REGRID_TIME_SCALE. Between depths REGRID_FILTER_SHALLOW_DEPTH and\n"//& "REGRID_FILTER_SHALLOW_DEPTH the filter wieghts adopt a cubic profile.", & - units="m", default=0.) - call set_regrid_params(CS%regridCS, depth_of_time_filter_shallow=filter_shallow_depth*GV%m_to_H, & - depth_of_time_filter_deep=filter_deep_depth*GV%m_to_H) + units="m", default=0., scale=GV%m_to_H) + call set_regrid_params(CS%regridCS, depth_of_time_filter_shallow=filter_shallow_depth, & + depth_of_time_filter_deep=filter_deep_depth) call get_param(param_file, mdl, "REGRID_USE_OLD_DIRECTION", local_logical, & "If true, the regridding ntegrates upwards from the bottom for\n"//& "interface positions, much as the main model does. If false\n"//& @@ -249,7 +248,7 @@ subroutine ALE_register_diags(Time, G, GV, diag, CS) CS%id_S_preale = register_diag_field('ocean_model', 'S_preale', diag%axesTL, Time, & 'Salinity before remapping', 'PSU') CS%id_e_preale = register_diag_field('ocean_model', 'e_preale', diag%axesTi, Time, & - 'Interface Heights before remapping', 'm') + 'Interface Heights before remapping', 'm', conversion=GV%Z_to_m) CS%id_dzRegrid = register_diag_field('ocean_model','dzRegrid',diag%axesTi,Time, & 'Change in interface height due to ALE regridding', 'm') @@ -329,7 +328,7 @@ subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt, frac_shelf_h) if (CS%id_T_preale > 0) call post_data(CS%id_T_preale, tv%T, CS%diag) if (CS%id_S_preale > 0) call post_data(CS%id_S_preale, tv%S, CS%diag) if (CS%id_e_preale > 0) then - call find_eta(h, tv, G, GV, eta_preale, eta_to_m=1.0) + call find_eta(h, tv, G, GV, eta_preale) call post_data(CS%id_e_preale, eta_preale, CS%diag) endif diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 8efd78ed07..ca2b18123f 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -75,7 +75,7 @@ module MOM_regridding !> Interpolation control structure type(interp_CS_type) :: interp_CS - !> Minimum thickness allowed when building the new grid through regridding + !> Minimum thickness allowed when building the new grid through regridding, in H. real :: min_thickness !> Reference pressure for potential density calculations (Pa) @@ -487,7 +487,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mdl, coord_mode, endif ! initialise coordinate-specific control structure - call initCoord(CS, coord_mode) + call initCoord(CS, GV, coord_mode) if (main_parameters .and. coord_is_state_dependent) then call get_param(param_file, mdl, "REGRID_COMPRESSIBILITY_FRACTION", tmpReal, & @@ -511,14 +511,14 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mdl, coord_mode, ! Set SLight-specific regridding parameters. call get_param(param_file, mdl, "SLIGHT_DZ_SURFACE", dz_fixed_sfc, & "The nominal thickness of fixed thickness near-surface\n"//& - "layers with the SLight coordinate.", units="m", default=1.0) + "layers with the SLight coordinate.", units="m", default=1.0, scale=GV%m_to_H) call get_param(param_file, mdl, "SLIGHT_NZ_SURFACE_FIXED", nz_fixed_sfc, & "The number of fixed-depth surface layers with the SLight\n"//& "coordinate.", units="nondimensional", default=2) call get_param(param_file, mdl, "SLIGHT_SURFACE_AVG_DEPTH", Rho_avg_depth, & "The thickness of the surface region over which to average\n"//& "when calculating the density to use to define the interior\n"//& - "with the SLight coordinate.", units="m", default=1.0) + "with the SLight coordinate.", units="m", default=1.0, scale=GV%m_to_H) call get_param(param_file, mdl, "SLIGHT_NLAY_TO_INTERIOR", nlay_sfc_int, & "The number of layers to offset the surface density when\n"//& "defining where the interior ocean starts with SLight.", & @@ -554,7 +554,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mdl, coord_mode, call get_param(param_file, mdl, "ADAPT_TIME_RATIO", adaptTimeRatio, & "Ratio of ALE timestep to grid timescale.", units="s", default=1e-1) !### Should the units be "nondim"? call get_param(param_file, mdl, "ADAPT_ZOOM_DEPTH", adaptZoom, & - "Depth of near-surface zooming region.", units="m", default=200.0) + "Depth of near-surface zooming region.", units="m", default=200.0, scale=GV%m_to_H) call get_param(param_file, mdl, "ADAPT_ZOOM_COEFF", adaptZoomCoeff, & "Coefficient of near-surface zooming diffusivity.", & units="nondim", default=0.2) @@ -592,8 +592,8 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mdl, coord_mode, ! Do nothing. elseif ( trim(string) == "PARAM") then call get_param(param_file, mdl, "MAXIMUM_INTERFACE_DEPTHS", z_max, & - trim(message), units="m", fail_if_missing=.true.) - call set_regrid_max_depths(CS, z_max, GV%m_to_H) + trim(message), units="m", scale=GV%m_to_H, fail_if_missing=.true.) + call set_regrid_max_depths(CS, z_max) elseif (index(trim(string),'FILE:')==1) then if (string(6:6)=='.' .or. string(6:6)=='/') then ! If we specified "FILE:./xyz" or "FILE:/xyz" then we have a relative or absolute path @@ -661,8 +661,8 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mdl, coord_mode, ! Do nothing. elseif ( trim(string) == "PARAM") then call get_param(param_file, mdl, "MAX_LAYER_THICKNESS", h_max, & - trim(message), units="m", fail_if_missing=.true.) - call set_regrid_max_thickness(CS, h_max, GV%m_to_H) + trim(message), units="m", fail_if_missing=.true., scale=GV%m_to_H) + call set_regrid_max_thickness(CS, h_max) elseif (index(trim(string),'FILE:')==1) then if (string(6:6)=='.' .or. string(6:6)=='/') then ! If we specified "FILE:./xyz" or "FILE:/xyz" then we have a relative or absolute path @@ -1598,7 +1598,7 @@ subroutine build_grid_SLight(G, GV, h, tv, dzInterface, CS) ( 0.5 * ( z_col(K) + z_col(K+1) ) * GV%H_to_Pa - CS%ref_pressure ) enddo - call build_slight_column(CS%slight_CS, tv%eqn_of_state, GV%H_to_Pa, GV%m_to_H, & + call build_slight_column(CS%slight_CS, tv%eqn_of_state, GV%H_to_Pa, & GV%H_subroundoff, nz, depth, h(i, j, :), & tv%T(i, j, :), tv%S(i, j, :), p_col, z_col, z_col_new, & h_neglect=h_neglect, h_neglect_edge=h_neglect_edge) @@ -1703,16 +1703,13 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) real :: total_height real :: delta_h real :: max_depth - real :: min_thickness real :: eta ! local elevation real :: local_depth real :: x1, y1, x2, y2 real :: x, t nz = GV%ke - max_depth = G%max_depth*GV%Z_to_H - min_thickness = CS%min_thickness !### May need *GV%m_to_H ? do j = G%jsc-1,G%jec+1 do i = G%isc-1,G%iec+1 @@ -1760,8 +1757,8 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) ! Modify interface heights to avoid layers of zero thicknesses do k = nz,1,-1 - if ( z_inter(k) < (z_inter(k+1) + min_thickness) ) then - z_inter(k) = z_inter(k+1) + min_thickness + if ( z_inter(k) < (z_inter(k+1) + CS%min_thickness) ) then + z_inter(k) = z_inter(k+1) + CS%min_thickness endif enddo @@ -1933,11 +1930,12 @@ end function uniformResolution !> Initialize the coordinate resolutions by calling the appropriate initialization !! routine for the specified coordinate mode. -subroutine initCoord(CS, coord_mode) - type(regridding_CS), intent(inout) :: CS !< Regridding control structure - character(len=*), intent(in) :: coord_mode !< A string indicating the coordinate mode. - !! See the documenttion for regrid_consts - !! for the recognized values. +subroutine initCoord(CS, GV, coord_mode) + type(regridding_CS), intent(inout) :: CS !< Regridding control structure + character(len=*), intent(in) :: coord_mode !< A string indicating the coordinate mode. + !! See the documenttion for regrid_consts + !! for the recognized values. + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure select case (coordinateMode(coord_mode)) case (REGRIDDING_ZSTAR) @@ -1951,9 +1949,9 @@ subroutine initCoord(CS, coord_mode) case (REGRIDDING_HYCOM1) call init_coord_hycom(CS%hycom_CS, CS%nk, CS%coordinateResolution, CS%target_density, CS%interp_CS) case (REGRIDDING_SLIGHT) - call init_coord_slight(CS%slight_CS, CS%nk, CS%ref_pressure, CS%target_density, CS%interp_CS) + call init_coord_slight(CS%slight_CS, CS%nk, CS%ref_pressure, CS%target_density, CS%interp_CS, GV%m_to_H) case (REGRIDDING_ADAPTIVE) - call init_coord_adapt(CS%adapt_CS, CS%nk, CS%coordinateResolution) + call init_coord_adapt(CS%adapt_CS, CS%nk, CS%coordinateResolution, GV%m_to_H) end select end subroutine initCoord @@ -2195,16 +2193,16 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri adaptTimeRatio, adaptZoom, adaptZoomCoeff, adaptBuoyCoeff, adaptAlpha, adaptDoMin) type(regridding_CS), intent(inout) :: CS !< Regridding control structure logical, optional, intent(in) :: boundary_extrapolation !< Extrapolate in boundary cells - real, optional, intent(in) :: min_thickness !< Minimum thickness allowed when building the new grid (m) + real, optional, intent(in) :: min_thickness !< Minimum thickness allowed when building the new grid (H) real, optional, intent(in) :: old_grid_weight !< Weight given to old coordinate when time-filtering grid character(len=*), optional, intent(in) :: interp_scheme !< Interpolation method for state-dependent coordinates real, optional, intent(in) :: depth_of_time_filter_shallow !< Depth to start cubic (H units) real, optional, intent(in) :: depth_of_time_filter_deep !< Depth to end cubic (H units) real, optional, intent(in) :: compress_fraction !< Fraction of compressibility to add to potential density - real, optional, intent(in) :: dz_min_surface !< The fixed resolution in the topmost SLight_nkml_min layers (m) + real, optional, intent(in) :: dz_min_surface !< The fixed resolution in the topmost SLight_nkml_min layers (H) integer, optional, intent(in) :: nz_fixed_surface !< The number of fixed-thickness layers at the top of the model real, optional, intent(in) :: Rho_ml_avg_depth !< Averaging depth over which to determine mixed layer potential - !! density (m) + !! density (H) real, optional, intent(in) :: nlay_ML_to_interior !< Number of layers to offset the mixed layer density to find !! resolved stratification (nondim) logical, optional, intent(in) :: fix_haloclines !< Detect regions with much weaker stratification in the coordinate @@ -2215,7 +2213,7 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri logical, optional, intent(in) :: integrate_downward_for_e !< If true, integrate for interface positions downward !! from the top. real, optional, intent(in) :: adaptTimeRatio !< Ratio of the ALE timestep to the grid timescale, ND. - real, optional, intent(in) :: adaptZoom !< Depth of near-surface zooming region, in m. + real, optional, intent(in) :: adaptZoom !< Depth of near-surface zooming region, in H. real, optional, intent(in) :: adaptZoomCoeff !< Coefficient of near-surface zooming diffusivity, ND. real, optional, intent(in) :: adaptBuoyCoeff !< Coefficient of buoyancy diffusivity, ND. real, optional, intent(in) :: adaptAlpha !< Scaling factor on optimization tendency, ND. diff --git a/src/ALE/coord_adapt.F90 b/src/ALE/coord_adapt.F90 index dcd6f6d8e8..22e3c91610 100644 --- a/src/ALE/coord_adapt.F90 +++ b/src/ALE/coord_adapt.F90 @@ -22,22 +22,22 @@ module coord_adapt real, allocatable, dimension(:) :: coordinateResolution !> Ratio of optimisation and diffusion timescales - real :: adaptTimeRatio = 1e-1 + real :: adaptTimeRatio !> Nondimensional coefficient determining how much optimisation to apply - real :: adaptAlpha = 1.0 + real :: adaptAlpha - !> Near-surface zooming depth - real :: adaptZoom = 200.0 + !> Near-surface zooming depth in H + real :: adaptZoom !> Near-surface zooming coefficient - real :: adaptZoomCoeff = 0.0 + real :: adaptZoomCoeff !> Stratification-dependent diffusion coefficient - real :: adaptBuoyCoeff = 0.0 + real :: adaptBuoyCoeff - !> Reference density difference for stratification-dependent diffusion - real :: adaptDrho0 = 0.5 + !> Reference density difference for stratification-dependent diffusion in kg m-3 + real :: adaptDrho0 !> If true, form a HYCOM1-like mixed layet by preventing interfaces !! from becoming shallower than the depths set by coordinateResolution @@ -49,17 +49,31 @@ module coord_adapt contains !> Initialise an adapt_CS with parameters -subroutine init_coord_adapt(CS, nk, coordinateResolution) +subroutine init_coord_adapt(CS, nk, coordinateResolution, m_to_H) type(adapt_CS), pointer :: CS !< Unassociated pointer to hold the control structure integer, intent(in) :: nk !< Number of layers in the grid real, dimension(:), intent(in) :: coordinateResolution !< Nominal near-surface resolution (H) + real, optional, intent(in) :: m_to_H !< A conversion factor from m to the units of thicknesses + + real :: m_to_H_rescale ! A unit conversion factor. if (associated(CS)) call MOM_error(FATAL, "init_coord_adapt: CS already associated") allocate(CS) allocate(CS%coordinateResolution(nk)) + m_to_H_rescale = 1.0 ; if (present(m_to_H)) m_to_H_rescale = m_to_H + CS%nk = nk CS%coordinateResolution(:) = coordinateResolution(:) + + ! Set real parameter default values + CS%adaptTimeRatio = 1e-1 ! Nondim. + CS%adaptAlpha = 1.0 ! Nondim. + CS%adaptZoom = 200.0 * m_to_H_rescale + CS%adaptZoomCoeff = 0.0 ! Nondim. + CS%adaptBuoyCoeff = 0.0 ! Nondim. + CS%adaptDrho0 = 0.5 ! kg m-3 + end subroutine init_coord_adapt !> Clean up the coordinate control structure @@ -79,7 +93,7 @@ subroutine set_adapt_params(CS, adaptTimeRatio, adaptAlpha, adaptZoom, adaptZoom real, optional, intent(in) :: adaptTimeRatio !< Ratio of optimisation and diffusion timescales real, optional, intent(in) :: adaptAlpha !< Nondimensional coefficient determining !! how much optimisation to apply - real, optional, intent(in) :: adaptZoom !< Near-surface zooming depth, in m + real, optional, intent(in) :: adaptZoom !< Near-surface zooming depth, in H real, optional, intent(in) :: adaptZoomCoeff !< Near-surface zooming coefficient real, optional, intent(in) :: adaptBuoyCoeff !< Stratification-dependent diffusion coefficient real, optional, intent(in) :: adaptDrho0 !< Reference density difference for @@ -226,7 +240,7 @@ subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) ! set vertical grid diffusivity kGrid(k) = (CS%adaptTimeRatio * nz**2 * depth) * & - (CS%adaptZoomCoeff / (CS%adaptZoom * GV%m_to_H + 0.5*(zNext(K) + zNext(K+1))) + & + (CS%adaptZoomCoeff / (CS%adaptZoom + 0.5*(zNext(K) + zNext(K+1))) + & (CS%adaptBuoyCoeff * drdz / CS%adaptDrho0) + & max(1.0 - CS%adaptZoomCoeff - CS%adaptBuoyCoeff, 0.0) / depth) enddo diff --git a/src/ALE/coord_slight.F90 b/src/ALE/coord_slight.F90 index 639ba8c0b5..7090bb4429 100644 --- a/src/ALE/coord_slight.F90 +++ b/src/ALE/coord_slight.F90 @@ -17,7 +17,7 @@ module coord_slight !> Number of layers/levels integer :: nk - !> Minimum thickness allowed when building the new grid through regridding (m) + !> Minimum thickness allowed when building the new grid through regridding (H) real :: min_thickness !> Reference pressure for potential density calculations (Pa) @@ -25,39 +25,39 @@ module coord_slight !> Fraction (between 0 and 1) of compressibility to add to potential density !! profiles when interpolating for target grid positions. (nondim) - real :: compressibility_fraction = 0. + real :: compressibility_fraction ! The following 4 parameters were introduced for use with the SLight coordinate: - !> Depth over which to average to determine the mixed layer potential density (m) - real :: Rho_ML_avg_depth = 1.0 + !> Depth over which to average to determine the mixed layer potential density (H) + real :: Rho_ML_avg_depth !> Number of layers to offset the mixed layer density to find resolved stratification (nondim) - real :: nlay_ml_offset = 2.0 + real :: nlay_ml_offset !> The number of fixed-thickness layers at the top of the model integer :: nz_fixed_surface = 2 - !> The fixed resolution in the topmost SLight_nkml_min layers (m) - real :: dz_ml_min = 1.0 + !> The fixed resolution in the topmost SLight_nkml_min layers (H) + real :: dz_ml_min !> If true, detect regions with much weaker stratification in the coordinate !! than based on in-situ density, and use a stretched coordinate there. logical :: fix_haloclines = .false. !> A length scale over which to filter T & S when looking for spuriously - !! unstable water mass profiles, in m. - real :: halocline_filter_length = 2.0 + !! unstable water mass profiles, in H. + real :: halocline_filter_length !> A value of the stratification ratio that defines a problematic halocline region (nondim). - real :: halocline_strat_tol = 0.25 + real :: halocline_strat_tol !> Nominal density of interfaces, in kg m-3. real, allocatable, dimension(:) :: target_density - !> Maximum depths of interfaces, in m. + !> Maximum depths of interfaces, in H. real, allocatable, dimension(:) :: max_interface_depths - !> Maximum thicknesses of layers, in m. + !> Maximum thicknesses of layers, in H. real, allocatable, dimension(:) :: max_layer_thickness !> Interpolation control structure @@ -69,21 +69,35 @@ module coord_slight contains !> Initialise a slight_CS with pointers to parameters -subroutine init_coord_slight(CS, nk, ref_pressure, target_density, interp_CS) +subroutine init_coord_slight(CS, nk, ref_pressure, target_density, interp_CS, m_to_H) type(slight_CS), pointer :: CS !< Unassociated pointer to hold the control structure integer, intent(in) :: nk !< Number of layers in the grid real, intent(in) :: ref_pressure !< Nominal density of interfaces in Pa real, dimension(:), intent(in) :: target_density !< Nominal density of interfaces in kg m-3 type(interp_CS_type), intent(in) :: interp_CS !< Controls for interpolation + real, optional, intent(in) :: m_to_H !< A conversion factor from m to the units of thicknesses + + real :: m_to_H_rescale ! A unit conversion factor. if (associated(CS)) call MOM_error(FATAL, "init_coord_slight: CS already associated!") allocate(CS) allocate(CS%target_density(nk+1)) + m_to_H_rescale = 1.0 ; if (present(m_to_H)) m_to_H_rescale = m_to_H + CS%nk = nk CS%ref_pressure = ref_pressure CS%target_density(:) = target_density(:) CS%interp_CS = interp_CS + + ! Set real parameter default values + CS%compressibility_fraction = 0. ! Nondim. + CS%Rho_ML_avg_depth = 1.0 * m_to_H_rescale + CS%nlay_ml_offset = 2.0 ! Nondim. + CS%dz_ml_min = 1.0 * m_to_H_rescale + CS%halocline_filter_length = 2.0 * m_to_H_rescale + CS%halocline_strat_tol = 0.25 ! Nondim. + end subroutine init_coord_slight !> This subroutine deallocates memory in the control structure for the coord_slight module @@ -103,26 +117,26 @@ subroutine set_slight_params(CS, max_interface_depths, max_layer_thickness, & halocline_filter_length, halocline_strat_tol, interp_CS) type(slight_CS), pointer :: CS !< Coordinate control structure real, dimension(:), & - optional, intent(in) :: max_interface_depths !< Maximum depths of interfaces in m + optional, intent(in) :: max_interface_depths !< Maximum depths of interfaces in H real, dimension(:), & - optional, intent(in) :: max_layer_thickness !< Maximum thicknesses of layers in m + optional, intent(in) :: max_layer_thickness !< Maximum thicknesses of layers in H real, optional, intent(in) :: min_thickness !< Minimum thickness allowed when building the - !! new grid through regridding, in m + !! new grid through regridding, in H real, optional, intent(in) :: compressibility_fraction !< Fraction (between 0 and 1) of !! compressibility to add to potential density profiles when !! interpolating for target grid positions. (nondim) real, optional, intent(in) :: dz_ml_min !< The fixed resolution in the topmost - !! SLight_nkml_min layers (m) + !! SLight_nkml_min layers (H) integer, optional, intent(in) :: nz_fixed_surface !< The number of fixed-thickness layers at the !! top of the model real, optional, intent(in) :: Rho_ML_avg_depth !< Depth over which to average to determine - !! the mixed layer potential density (m) + !! the mixed layer potential density (H) real, optional, intent(in) :: nlay_ML_offset !< Number of layers to offset the mixed layer !! density to find resolved stratification (nondim) logical, optional, intent(in) :: fix_haloclines !< If true, detect regions with much weaker than !! based on in-situ density, and use a stretched coordinate there. real, optional, intent(in) :: halocline_filter_length !< A length scale over which to filter T & S - !! when looking for spuriously unstable water mass profiles, in m. + !! when looking for spuriously unstable water mass profiles, in H. real, optional, intent(in) :: halocline_strat_tol !< A value of the stratification ratio that !! defines a problematic halocline region (nondim). type(interp_CS_type), & @@ -163,28 +177,25 @@ subroutine set_slight_params(CS, max_interface_depths, max_layer_thickness, & end subroutine set_slight_params !> Build a SLight coordinate column -subroutine build_slight_column(CS, eqn_of_state, H_to_Pa, m_to_H, H_subroundoff, & +subroutine build_slight_column(CS, eqn_of_state, H_to_Pa, H_subroundoff, & nz, depth, h_col, T_col, S_col, p_col, z_col, z_col_new, & h_neglect, h_neglect_edge) - type(slight_CS), intent(in) :: CS !< Coordinate control structure + type(slight_CS), intent(in) :: CS !< Coordinate control structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure real, intent(in) :: H_to_Pa !< GV%H_to_Pa - real, intent(in) :: m_to_H !< GV%m_to_H real, intent(in) :: H_subroundoff !< GV%H_subroundoff - integer, intent(in) :: nz !< Number of levels - real, intent(in) :: depth !< Depth of ocean bottom (positive in m) + integer, intent(in) :: nz !< Number of levels + real, intent(in) :: depth !< Depth of ocean bottom (positive in H) real, dimension(nz), intent(in) :: T_col !< T for column real, dimension(nz), intent(in) :: S_col !< S for column - real, dimension(nz), intent(in) :: h_col !< Layer thicknesses, in m + real, dimension(nz), intent(in) :: h_col !< Layer thicknesses, in H units (m or kg m-2) real, dimension(nz), intent(in) :: p_col !< Layer quantities - real, dimension(nz+1), intent(in) :: z_col !< Interface positions relative to the surface in H units (m or kg m-2) - real, dimension(nz+1), intent(inout) :: z_col_new !< Absolute positions of interfaces - real, optional, intent(in) :: h_neglect !< A negligibly small width for the - !! purpose of cell reconstructions - !! in the same units as h_col. - real, optional, intent(in) :: h_neglect_edge !< A negligibly small width - !! for the purpose of edge value calculations - !! in the same units as h_col. + real, dimension(nz+1), intent(in) :: z_col !< Interface positions relative to the surface in H + real, dimension(nz+1), intent(inout) :: z_col_new !< Absolute positions of interfaces in H + real, optional, intent(in) :: h_neglect !< A negligibly small width for the purpose of + !! cell reconstructions in H. + real, optional, intent(in) :: h_neglect_edge !< A negligibly small width for the purpose + !! of edge value calculations in H. ! Local variables real, dimension(nz) :: rho_col ! Layer quantities real, dimension(nz) :: T_f, S_f ! Filtered ayer quantities @@ -282,7 +293,7 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_Pa, m_to_H, H_subroundoff, ! Determine which interfaces are in the s-space region and the depth extent ! of this region. z_wt = 0.0 ; rho_x_z = 0.0 - H_ml_av = m_to_H*CS%Rho_ml_avg_depth + H_ml_av = CS%Rho_ml_avg_depth do k=1,nz if (z_wt + h_col(k) >= H_ml_av) then rho_x_z = rho_x_z + rho_col(k) * (H_ml_av - z_wt) @@ -323,7 +334,7 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_Pa, m_to_H, H_subroundoff, ! ! z_int_unst and k_interior. if (CS%halocline_filter_length > 0.0) then - Lfilt = CS%halocline_filter_length*m_to_H + Lfilt = CS%halocline_filter_length ! Filter the temperature and salnity with a fixed lengthscale. h_tr = h_col(1) + H_subroundoff From 284591f0e24da118c94dadfbe628fa8c41bf7549 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 2 Nov 2018 18:18:55 -0400 Subject: [PATCH 0882/1072] Calculate height-related diagnostics in Z Calculate height-related diagnostics in Z and then convert them to m via the post_data call. All answers are bitwise identical. --- src/diagnostics/MOM_diagnostics.F90 | 32 ++++++++++++++--------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 9152636c94..98daea3be5 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -284,19 +284,19 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_h > 0) call post_data(CS%id_h, h, CS%diag) if (associated(CS%e)) then - call find_eta(h, tv, G, GV, CS%e, eta_bt, eta_to_m=1.0) + call find_eta(h, tv, G, GV, CS%e, eta_bt) if (CS%id_e > 0) call post_data(CS%id_e, CS%e, CS%diag) endif if (associated(CS%e_D)) then if (associated(CS%e)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie - CS%e_D(i,j,k) = CS%e(i,j,k) + GV%Z_to_m*G%bathyT(i,j) + CS%e_D(i,j,k) = CS%e(i,j,k) + G%bathyT(i,j) enddo ; enddo ; enddo else - call find_eta(h, tv, G, GV, CS%e_D, eta_bt, eta_to_m=1.0) + call find_eta(h, tv, G, GV, CS%e_D, eta_bt) do k=1,nz+1 ; do j=js,je ; do i=is,ie - CS%e_D(i,j,k) = CS%e_D(i,j,k) + GV%Z_to_m*G%bathyT(i,j) + CS%e_D(i,j,k) = CS%e_D(i,j,k) + G%bathyT(i,j) enddo ; enddo ; enddo endif @@ -772,17 +772,17 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) !! previous call to diagnostics_init. real, dimension(SZI_(G), SZJ_(G)) :: & - z_top, & ! Height of the top of a layer or the ocean, in m. + z_top, & ! Height of the top of a layer or the ocean, in Z. z_bot, & ! Height of the bottom of a layer (for id_mass) or the - ! (positive) depth of the ocean (for id_col_ht), in m. + ! (positive) depth of the ocean (for id_col_ht), in Z. mass, & ! integrated mass of the water column, in kg m-2. For - ! non-Boussinesq models this is rho*dz. For Boussiensq + ! non-Boussinesq models this is rho*dz. For Boussinesq ! models, this is either the integral of in-situ density - ! (rho*dz for col_mass) or reference dens (Rho_0*dz for mass_wt). + ! (rho*dz for col_mass) or reference density (Rho_0*dz for mass_wt). btm_pres,&! The pressure at the ocean bottom, or CMIP variable 'pbo'. ! This is the column mass multiplied by gravity plus the pressure ! at the ocean surface. - dpress, & ! Change in hydrostatic pressure across a layer, in Pa. + dpress, & ! Change in hydrostatic pressure across a layer, in Pa. tr_int ! vertical integral of a tracer times density, ! (Rho_0 in a Boussinesq model) in TR kg m-2. real :: IG_Earth ! Inverse of gravitational acceleration, in s2 m-1. @@ -815,9 +815,9 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) endif if (CS%id_col_ht > 0) then - call find_eta(h, tv, G, GV, z_top, eta_to_m=1.0) + call find_eta(h, tv, G, GV, z_top) do j=js,je ; do i=is,ie - z_bot(i,j) = z_top(i,j) + GV%Z_to_m*G%bathyT(i,j) + z_bot(i,j) = z_top(i,j) + G%bathyT(i,j) enddo ; enddo call post_data(CS%id_col_ht, z_bot, CS%diag) endif @@ -832,10 +832,10 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) do k=1,nz do j=js,je ; do i=is,ie z_top(i,j) = z_bot(i,j) - z_bot(i,j) = z_top(i,j) - GV%H_to_m*h(i,j,k) + z_bot(i,j) = z_top(i,j) - GV%H_to_Z*h(i,j,k) enddo ; enddo call int_density_dz(tv%T(:,:,k), tv%S(:,:,k), & - z_top, z_bot, 0.0, GV%H_to_kg_m2, (GV%g_Earth*GV%m_to_Z), & + z_top, z_bot, 0.0, GV%Rho0, GV%g_Earth, & G%HI, G%HI, tv%eqn_of_state, dpress) do j=js,je ; do i=is,ie mass(i,j) = mass(i,j) + dpress(i,j) * IG_Earth @@ -1534,11 +1534,11 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, param_file, diag, CS 'Layer Thickness', thickness_units, v_extensive=.true., conversion=convert_H) CS%id_e = register_diag_field('ocean_model', 'e', diag%axesTi, Time, & - 'Interface Height Relative to Mean Sea Level', 'm') + 'Interface Height Relative to Mean Sea Level', 'm', conversion=GV%Z_to_m) if (CS%id_e>0) call safe_alloc_ptr(CS%e,isd,ied,jsd,jed,nz+1) CS%id_e_D = register_diag_field('ocean_model', 'e_D', diag%axesTi, Time, & - 'Interface Height above the Seafloor', 'm') + 'Interface Height above the Seafloor', 'm', conversion=GV%Z_to_m) if (CS%id_e_D>0) call safe_alloc_ptr(CS%e_D,isd,ied,jsd,jed,nz+1) CS%id_Rml = register_diag_field('ocean_model', 'Rml', diag%axesTL, Time, & @@ -1690,7 +1690,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, param_file, diag, CS 'The column integrated in situ density', 'kg m-2') CS%id_col_ht = register_diag_field('ocean_model', 'col_height', diag%axesT1, Time, & - 'The height of the water column', 'm') + 'The height of the water column', 'm', conversion=GV%Z_to_m) CS%id_pbo = register_diag_field('ocean_model', 'pbo', diag%axesT1, Time, & long_name='Sea Water Pressure at Sea Floor', standard_name='sea_water_pressure_at_sea_floor', & units='Pa') From 9b542c391e308b5e2fc9fbcbf288755938265edf Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 6 Nov 2018 05:12:55 -0500 Subject: [PATCH 0883/1072] +Add MOM_unit_scaling module Added a new module, MOM_unit_scaling, with a transparent type with the various unit scaling factors, along with the new routines unit_scaling_init, fix_restart_unit_scaling and unit_scaling_end for setting and manipulating the contents of this type. All answers are bitwise identical. --- src/framework/MOM_unit_scaling.F90 | 125 +++++++++++++++++++++++++++++ 1 file changed, 125 insertions(+) create mode 100644 src/framework/MOM_unit_scaling.F90 diff --git a/src/framework/MOM_unit_scaling.F90 b/src/framework/MOM_unit_scaling.F90 new file mode 100644 index 0000000000..60b07c1fbd --- /dev/null +++ b/src/framework/MOM_unit_scaling.F90 @@ -0,0 +1,125 @@ +!> Provides a transparent unit rescaling type to facilitate dimensional consistency testing +module MOM_unit_scaling + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type + +implicit none ; private + +public unit_scaling_init, unit_scaling_end, fix_restart_unit_scaling + +!> Describes various unit conversion factors +type, public :: unit_scale_type + real :: m_to_Z !< A constant that translates distances in meters to the units of depth. + real :: Z_to_m !< A constant that translates distances in the units of depth to meters. + real :: m_to_L !< A constant that translates lengths in meters to the units of horizontal lengths. + real :: L_to_m !< A constant that translates lengths in the units of horizontal lengths to meters. + real :: s_to_T !< A constant that time intervals in seconds to the units of time. + real :: T_to_s !< A constant that the units of time to seconds. + + ! These are useful combinations of the fundamental scale conversion factors above. + real :: Z_to_L !< Convert vertical distances to lateral lengths + real :: L_to_Z !< Convert vertical distances to lateral lengths + real :: L_T_to_m_s !< Convert lateral velocities from L T-1 to m s-1. + real :: m_s_to_L_T !< Convert lateral velocities from m s-1 to L T-1. + real :: L_T2_to_m_s2 !< Convert lateral accelerations from L T-2 to m s-2. + real :: Z2_T_to_m2_s !< Convert vertical diffusivities from Z2 T-1 to m2 s-1. + real :: m2_s_to_Z2_T !< Convert vertical diffusivities from m2 s-1 to Z2 T-1. + + ! These are used for changing scaling across restarts. + real :: m_to_Z_restart = 0.0 !< A copy of the m_to_Z that is used in restart files. + real :: m_to_L_restart = 0.0 !< A copy of the m_to_L that is used in restart files. + real :: s_to_T_restart = 0.0 !< A copy of the s_to_T that is used in restart files. +end type unit_scale_type + +contains + +!> Allocates and initializes the ocean model unit scaling type +subroutine unit_scaling_init( param_file, US ) + type(param_file_type), intent(in) :: param_file !< Parameter file handle/type + type(unit_scale_type), pointer :: US !< A dimensional unit scaling type + + ! This routine initializes a unit_scale_type structure (US). + + ! Local variables + integer :: Z_power, L_power, T_power + real :: Z_rescale_factor, L_rescale_factor, T_rescale_factor + ! This include declares and sets the variable "version". +# include "version_variable.h" + character(len=16) :: mdl = "MOM_unit_scaling" + + if (associated(US)) call MOM_error(FATAL, & + 'unit_scaling_init: called with an associated US pointer.') + allocate(US) + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mdl, version, & + "Parameters for doing unit scaling of variables.") + call get_param(param_file, mdl, "Z_RESCALE_POWER", Z_power, & + "An integer power of 2 that is used to rescale the model's \n"//& + "intenal units of depths and heights. Valid values range from -300 to 300.", & + units="nondim", default=0, debuggingParam=.true.) + call get_param(param_file, mdl, "L_RESCALE_POWER", L_power, & + "An integer power of 2 that is used to rescale the model's \n"//& + "intenal units of lateral distances. Valid values range from -300 to 300.", & + units="nondim", default=0, debuggingParam=.true.) + call get_param(param_file, mdl, "T_RESCALE_POWER", T_power, & + "An integer power of 2 that is used to rescale the model's \n"//& + "intenal units of time. Valid values range from -300 to 300.", & + units="nondim", default=0, debuggingParam=.true.) + if (abs(Z_power) > 300) call MOM_error(FATAL, "unit_scaling_init: "//& + "Z_RESCALE_POWER is outside of the valid range of -300 to 300.") + if (abs(L_power) > 300) call MOM_error(FATAL, "unit_scaling_init: "//& + "L_RESCALE_POWER is outside of the valid range of -300 to 300.") + if (abs(T_power) > 300) call MOM_error(FATAL, "unit_scaling_init: "//& + "T_RESCALE_POWER is outside of the valid range of -300 to 300.") + + Z_rescale_factor = 1.0 + if (Z_power /= 0) Z_rescale_factor = 2.0**Z_power + US%Z_to_m = 1.0 * Z_rescale_factor + US%m_to_Z = 1.0 / Z_rescale_factor + + L_rescale_factor = 1.0 + if (L_power /= 0) L_rescale_factor = 2.0**L_power + US%L_to_m = 1.0 * L_rescale_factor + US%m_to_L = 1.0 / L_rescale_factor + + T_rescale_factor = 1.0 + if (T_power /= 0) T_rescale_factor = 2.0**T_power + US%T_to_s = 1.0 * T_rescale_factor + US%s_to_T = 1.0 / T_rescale_factor + + ! These are useful combinations of the fundamental scale conversion factors set above. + US%Z_to_L = US%Z_to_m * US%m_to_L + US%L_to_Z = US%L_to_m * US%m_to_Z + US%L_T_to_m_s = US%L_to_m * US%s_to_T + US%m_s_to_L_T = US%m_to_L * US%T_to_s + US%L_T2_to_m_s2 = US%L_to_m * US%s_to_T**2 + ! It does not look like US%m_s2_to_L_T2 would be used, so it does not exist. + US%Z2_T_to_m2_s = US%Z_to_m**2 * US%s_to_T + US%m2_s_to_Z2_T = US%m_to_Z**2 * US%T_to_s + +end subroutine unit_scaling_init + +!> Set the unit scaling factors for output to restart files to the unit scaling +!! factors for this run. +subroutine fix_restart_unit_scaling(US) + type(unit_scale_type), intent(inout) :: US !< A dimensional unit scaling type + + US%m_to_Z_restart = US%m_to_Z + US%m_to_L_restart = US%m_to_L + US%s_to_T_restart = US%s_to_T + +end subroutine fix_restart_unit_scaling + +!> Deallocates a unit scaling structure. +subroutine unit_scaling_end( US ) + type(unit_scale_type), pointer :: US !< A dimensional unit scaling type + + deallocate( US ) + +end subroutine unit_scaling_end + +end module MOM_unit_scaling From 533d495ebec14b4a2d8d33533a52c411664cf2f2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 6 Nov 2018 05:15:18 -0500 Subject: [PATCH 0884/1072] +Replace GV%m_to_Z with US%m_to_Z Removed the scaling factor from m to the units of vertical distances from the vertical grid type, and replaced all instances where it is used with the version from the unit_scaling type. This also includes the addition of a new unit_scale_type element to the MOM_control_struct. A number of unit_scale_type arguments were added in various subroutines. All answers are bitwise identical, but there are new entries in the MOM_parameter_doc files. --- config_src/coupled_driver/ocean_model_MOM.F90 | 10 +- config_src/solo_driver/MOM_driver.F90 | 9 +- src/ALE/MOM_ALE.F90 | 16 +- src/ALE/MOM_regridding.F90 | 12 +- src/core/MOM.F90 | 155 ++++++++++-------- src/core/MOM_PressureForce.F90 | 16 +- src/core/MOM_PressureForce_Montgomery.F90 | 13 +- src/core/MOM_PressureForce_analytic_FV.F90 | 18 +- src/core/MOM_PressureForce_blocked_AFV.F90 | 20 ++- src/core/MOM_barotropic.F90 | 24 +-- src/core/MOM_boundary_update.F90 | 6 +- src/core/MOM_dynamics_split_RK2.F90 | 48 +++--- src/core/MOM_dynamics_unsplit.F90 | 32 ++-- src/core/MOM_dynamics_unsplit_RK2.F90 | 27 +-- src/core/MOM_forcing_type.F90 | 27 +-- src/core/MOM_interface_heights.F90 | 59 +++---- src/core/MOM_isopycnal_slopes.F90 | 6 +- src/core/MOM_verticalGrid.F90 | 12 +- src/diagnostics/MOM_diag_to_Z.F90 | 21 ++- src/diagnostics/MOM_diagnostics.F90 | 25 +-- src/diagnostics/MOM_sum_output.F90 | 8 +- src/diagnostics/MOM_wave_speed.F90 | 17 +- src/diagnostics/MOM_wave_structure.F90 | 45 ++--- src/framework/MOM_diag_mediator.F90 | 16 +- src/framework/MOM_diag_remap.F90 | 10 +- .../MOM_coord_initialization.F90 | 64 +++++--- .../MOM_state_initialization.F90 | 144 ++++++++-------- .../MOM_tracer_initialization_from_Z.F90 | 17 +- src/ocean_data_assim/MOM_oda_driver.F90 | 23 ++- .../lateral/MOM_internal_tides.F90 | 8 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 33 ++-- .../lateral/MOM_mixed_layer_restrat.F90 | 29 ++-- .../lateral/MOM_thickness_diffuse.F90 | 30 ++-- .../vertical/MOM_ALE_sponge.F90 | 12 +- .../vertical/MOM_CVMix_KPP.F90 | 27 +-- .../vertical/MOM_CVMix_conv.F90 | 16 +- .../vertical/MOM_CVMix_ddiff.F90 | 12 +- .../vertical/MOM_CVMix_shear.F90 | 10 +- .../vertical/MOM_bkgnd_mixing.F90 | 42 ++--- .../vertical/MOM_bulk_mixed_layer.F90 | 101 +++--------- .../vertical/MOM_diabatic_aux.F90 | 18 +- .../vertical/MOM_diabatic_driver.F90 | 125 +++++++------- .../vertical/MOM_diapyc_energy_req.F90 | 19 ++- .../vertical/MOM_energetic_PBL.F90 | 61 +++---- .../vertical/MOM_entrain_diffusive.F90 | 6 +- .../vertical/MOM_internal_tide_input.F90 | 20 ++- .../vertical/MOM_kappa_shear.F90 | 46 +++--- .../vertical/MOM_set_diffusivity.F90 | 109 ++++++------ .../vertical/MOM_set_viscosity.F90 | 59 +++---- .../vertical/MOM_tidal_mixing.F90 | 58 ++++--- .../vertical/MOM_vert_friction.F90 | 40 +++-- src/tracer/DOME_tracer.F90 | 8 +- src/tracer/MOM_tracer_flow_control.F90 | 11 +- src/tracer/dye_example.F90 | 12 +- src/user/BFB_initialization.F90 | 6 +- src/user/DOME2d_initialization.F90 | 6 +- src/user/DOME_initialization.F90 | 11 +- src/user/ISOMIP_initialization.F90 | 15 +- src/user/Kelvin_initialization.F90 | 8 +- src/user/MOM_wave_interface.F90 | 134 +++++++-------- src/user/Neverland_initialization.F90 | 6 +- src/user/Phillips_initialization.F90 | 32 ++-- src/user/SCM_CVMix_tests.F90 | 18 +- src/user/adjustment_initialization.F90 | 6 +- src/user/benchmark_initialization.F90 | 8 +- src/user/dumbbell_initialization.F90 | 11 +- src/user/external_gwave_initialization.F90 | 6 +- src/user/lock_exchange_initialization.F90 | 8 +- src/user/seamount_initialization.F90 | 6 +- src/user/sloshing_initialization.F90 | 8 +- src/user/soliton_initialization.F90 | 6 +- src/user/user_change_diffusivity.F90 | 6 +- 72 files changed, 1136 insertions(+), 977 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 4e89945678..bcc9ea3dd7 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -43,6 +43,7 @@ module ocean_model_mod use MOM_time_manager, only : real_to_time, 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 @@ -190,6 +191,9 @@ module ocean_model_mod 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() !< A pointer to the MOM control structure type(ice_shelf_CS), pointer :: & @@ -266,7 +270,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, & OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, & diag_ptr=OS%diag, count_calls=.true.) - call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, C_p=OS%C_p, & + 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%fluxes%C_p = OS%C_p @@ -367,7 +371,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) 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, param_file, OS%Waves, OS%diag) + 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 @@ -552,7 +556,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda ! For now, the waves are only updated on the thermodynamics steps, because that is where ! the wave intensities are actually used to drive mixing. At some point, the wave updates ! might also need to become a part of the ocean dynamics, according to B. Reichl. - call Update_Surface_Waves(OS%grid, OS%GV, OS%time, ocean_coupling_time_step, OS%waves) + call Update_Surface_Waves(OS%grid, OS%GV, OS%US, OS%time, ocean_coupling_time_step, OS%waves) endif if ((OS%nstep==0) .and. (OS%nstep_thermo==0)) then ! This is the first call to update_ocean_model. diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 4933f29182..0fef7c2589 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -56,6 +56,7 @@ program MOM_main use MOM_time_manager, only : JULIAN, GREGORIAN, NOLEAP, THIRTY_DAY_MONTHS use MOM_time_manager, only : NO_CALENDAR use MOM_tracer_flow_control, only : tracer_flow_control_CS + use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type use MOM_write_cputime, only : write_cputime, MOM_write_cputime_init @@ -89,6 +90,8 @@ program MOM_main ! A pointer to a structure containing metrics and related information. type(ocean_grid_type), pointer :: grid type(verticalGrid_type), pointer :: GV + ! A pointer to a structure containing dimensional unit scaling factors. + type(unit_scale_type), pointer :: US ! If .true., use the ice shelf model for part of the domain. logical :: use_ice_shelf @@ -312,7 +315,7 @@ program MOM_main tracer_flow_CSp=tracer_flow_CSp) endif - call get_MOM_state_elements(MOM_CSp, G=grid, GV=GV, C_p=fluxes%C_p) + call get_MOM_state_elements(MOM_CSp, G=grid, GV=GV, US=US, C_p=fluxes%C_p) Master_Time = Time call callTree_waypoint("done initialize_MOM") @@ -335,7 +338,7 @@ program MOM_main call get_param(param_file,mod_name,"USE_WAVES",Use_Waves,& "If true, enables surface wave modules.",default=.false.) if (use_waves) then - call MOM_wave_interface_init(Time,grid,GV,param_file,Waves_CSp,diag) + call MOM_wave_interface_init(Time, grid, GV, US, param_file, Waves_CSp, diag) else call MOM_wave_interface_init_lite(param_file) endif @@ -491,7 +494,7 @@ program MOM_main fluxes%dt_buoy_accum = dt_forcing if (use_waves) then - call Update_Surface_Waves(grid,GV,time,time_step_ocean,waves_csp) + call Update_Surface_Waves(grid, GV, US, time, time_step_ocean, waves_csp) endif if (ns==1) then diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 98eeda2dce..97ccb78aed 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -42,6 +42,7 @@ module MOM_ALE use MOM_remapping, only : remapping_CS, dzFromH1H2 use MOM_string_functions, only : uppercase, extractWord, extract_integer use MOM_tracer_registry, only : tracer_registry_type, tracer_type, MOM_tracer_chkinv +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : ocean_grid_type, thermo_var_ptrs use MOM_verticalGrid, only : get_thickness_units, verticalGrid_type @@ -125,9 +126,10 @@ module MOM_ALE !! before the main time integration loop to initialize the regridding stuff. !! We read the MOM_input file to register the values of different !! regridding/remapping parameters. -subroutine ALE_init( param_file, GV, max_depth, CS) +subroutine ALE_init( param_file, GV, US, max_depth, CS) type(param_file_type), intent(in) :: param_file !< Parameter file type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: max_depth !< The maximum depth of the ocean, in Z. type(ALE_CS), pointer :: CS !< Module control structure @@ -160,7 +162,7 @@ subroutine ALE_init( param_file, GV, max_depth, CS) default=.true.) ! Initialize and configure regridding - call ALE_initRegridding( GV, max_depth, param_file, mdl, CS%regridCS) + call ALE_initRegridding(GV, US, max_depth, param_file, mdl, CS%regridCS) ! Initialize and configure remapping call get_param(param_file, mdl, "REMAPPING_SCHEME", string, & @@ -293,9 +295,10 @@ end subroutine ALE_end !! the old grid and the new grid. The creation of the new grid can be based !! on z coordinates, target interface densities, sigma coordinates or any !! arbitrary coordinate system. -subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt, frac_shelf_h) +subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, dt, frac_shelf_h) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the !! last time step in H (often m or Pa) real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity field (m/s) @@ -328,7 +331,7 @@ subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt, frac_shelf_h) if (CS%id_T_preale > 0) call post_data(CS%id_T_preale, tv%T, CS%diag) if (CS%id_S_preale > 0) call post_data(CS%id_S_preale, tv%S, CS%diag) if (CS%id_e_preale > 0) then - call find_eta(h, tv, G, GV, eta_preale) + call find_eta(h, tv, G, GV, US, eta_preale) call post_data(CS%id_e_preale, eta_preale, CS%diag) endif @@ -1095,8 +1098,9 @@ end subroutine pressure_gradient_ppm !> Initializes regridding for the main ALE algorithm -subroutine ALE_initRegridding(GV, max_depth, param_file, mdl, regridCS) +subroutine ALE_initRegridding(GV, US, max_depth, param_file, mdl, regridCS) type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: max_depth !< The maximum depth of the ocean, in Z. type(param_file_type), intent(in) :: param_file !< parameter file character(len=*), intent(in) :: mdl !< Name of calling module @@ -1110,7 +1114,7 @@ subroutine ALE_initRegridding(GV, max_depth, param_file, mdl, regridCS) trim(regriddingCoordinateModeDoc), & default=DEFAULT_COORDINATE_MODE, fail_if_missing=.true.) - call initialize_regridding(regridCS, GV, max_depth, param_file, mdl, coord_mode, '', '') + call initialize_regridding(regridCS, GV, US, max_depth, param_file, mdl, coord_mode, '', '') end subroutine ALE_initRegridding diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index ca2b18123f..aac9ae4294 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -7,10 +7,11 @@ module MOM_regridding use MOM_file_parser, only : param_file_type, get_param, log_param use MOM_io, only : file_exists, field_exists, field_size, MOM_read_data use MOM_io, only : slasher +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : ocean_grid_type, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : EOS_type, calculate_density -use MOM_string_functions,only : uppercase, extractWord, extract_integer, extract_real +use MOM_string_functions, only : uppercase, extractWord, extract_integer, extract_real use MOM_remapping, only : remapping_CS use regrid_consts, only : state_dependent, coordinateUnits @@ -167,9 +168,10 @@ module MOM_regridding contains !> Initialization and configures a regridding control structure based on customizable run-time parameters -subroutine initialize_regridding(CS, GV, max_depth, param_file, mdl, coord_mode, param_prefix, param_suffix) - type(regridding_CS), intent(inout) :: CS !< Regridding control structure - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure +subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_mode, param_prefix, param_suffix) + type(regridding_CS), intent(inout) :: CS !< Regridding control structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: max_depth !< The maximum depth of the ocean, in Z. type(param_file_type), intent(in) :: param_file !< Parameter file character(len=*), intent(in) :: mdl !< Name of calling module. @@ -470,7 +472,7 @@ subroutine initialize_regridding(CS, GV, max_depth, param_file, mdl, coord_mode, call setCoordinateResolution(dz, CS, scale=GV%m_to_H) CS%coord_scale = GV%H_to_m else - call setCoordinateResolution(dz, CS, scale=GV%m_to_Z) + call setCoordinateResolution(dz, CS, scale=US%m_to_Z) CS%coord_scale = GV%Z_to_m endif endif diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index bcb1dee9fa..30cc481a52 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -110,6 +110,8 @@ module MOM use MOM_tracer_flow_control, only : tracer_flow_control_init, call_tracer_surface_state use MOM_tracer_flow_control, only : tracer_flow_control_end use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid +use MOM_unit_scaling, only : unit_scale_type, unit_scaling_init +use MOM_unit_scaling, only : unit_scaling_end, fix_restart_unit_scaling use MOM_variables, only : surface, allocate_surface_state, deallocate_surface_state use MOM_variables, only : thermo_var_ptrs, vertvisc_type use MOM_variables, only : accel_diag_ptrs, cont_diag_ptrs, ocean_internal_state @@ -177,6 +179,8 @@ module MOM type(ocean_grid_type) :: G !< structure containing metrics and grid info type(verticalGrid_type), pointer :: & GV => NULL() !< structure containing vertical grid info + type(unit_scale_type), pointer :: & + US => NULL() !< structure containing various unit conversion factors type(thermo_var_ptrs) :: tv !< structure containing pointers to available thermodynamic fields real :: t_dyn_rel_adv !< The time of the dynamics relative to tracer advection and lateral mixing !! (in seconds), or equivalently the elapsed time since advectively updating the @@ -563,7 +567,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (associated(CS%VarMix)) then call enable_averaging(cycle_time, Time_start + real_to_time(cycle_time), & CS%diag) - call calc_resoln_function(h, CS%tv, G, GV, CS%VarMix) + call calc_resoln_function(h, CS%tv, G, GV, CS%US, CS%VarMix) call disable_averaging(CS%diag) endif endif @@ -588,12 +592,12 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (CS%UseWaves) then ! Update wave information, which is presently kept static over each call to step_mom call enable_averaging(time_interval, Time_start + real_to_time(time_interval), CS%diag) - call Update_Stokes_Drift(G, GV, Waves, h, forces%ustar) + call Update_Stokes_Drift(G, GV, CS%US, Waves, h, forces%ustar) call disable_averaging(CS%diag) endif else ! not do_dyn. if (CS%UseWaves) & ! Diagnostics are not enabled in this call. - call Update_Stokes_Drift(G, GV, Waves, h, fluxes%ustar) + call Update_Stokes_Drift(G, GV, CS%US, Waves, h, fluxes%ustar) endif if (CS%debug) then @@ -753,7 +757,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ! Determining the time-average sea surface height is part of the algorithm. ! This may be eta_av if Boussinesq, or need to be diagnosed if not. CS%time_in_cycle = CS%time_in_cycle + dt - call find_eta(h, CS%tv, G, GV, ssh, CS%eta_av_bc, eta_to_m=1.0) + call find_eta(h, CS%tv, G, GV, CS%US, ssh, CS%eta_av_bc, eta_to_m=1.0) do j=js,je ; do i=is,ie CS%ssh_rint(i,j) = CS%ssh_rint(i,j) + dt*ssh(i,j) enddo ; enddo @@ -771,7 +775,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & call enable_averaging(CS%t_dyn_rel_diag, Time_local, CS%diag) call calculate_diagnostic_fields(u, v, h, CS%uh, CS%vh, CS%tv, CS%ADp, & CS%CDp, p_surf, CS%t_dyn_rel_diag, CS%diag_pre_sync,& - G, GV, CS%diagnostics_CSp) + G, GV, CS%US, CS%diagnostics_CSp) call post_tracer_diagnostics(CS%Tracer_reg, h, CS%diag_pre_sync, CS%diag, G, GV, CS%t_dyn_rel_diag) call diag_copy_diag_to_storage(CS%diag_pre_sync, h, CS%diag) if (showCallTree) call callTree_waypoint("finished calculate_diagnostic_fields (step_MOM)") @@ -784,7 +788,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & CS%Z_diag_time, CS%diag) !### This is the one place where fluxes might used if do_thermo=.false. Is this correct? call calculate_Z_diag_fields(u, v, h, ssh, fluxes%frac_shelf_h, & - G, GV, CS%diag_to_Z_CSp) + G, GV, CS%US, CS%diag_to_Z_CSp) CS%Z_diag_time = CS%Z_diag_time + CS%Z_diag_interval call disable_averaging(CS%diag) if (showCallTree) call callTree_waypoint("finished calculate_Z_diag_fields (step_MOM)") @@ -809,10 +813,10 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & CS%ave_ssh_ibc(i,j) = ssh(i,j) enddo ; enddo if (do_dyn) then - call adjust_ssh_for_p_atm(CS%tv, G, GV, CS%ave_ssh_ibc, forces%p_surf_SSH, & + call adjust_ssh_for_p_atm(CS%tv, G, GV, CS%US, CS%ave_ssh_ibc, forces%p_surf_SSH, & CS%calc_rho_for_sea_lev) elseif (do_thermo) then - call adjust_ssh_for_p_atm(CS%tv, G, GV, CS%ave_ssh_ibc, fluxes%p_surf_SSH, & + call adjust_ssh_for_p_atm(CS%tv, G, GV, CS%US, CS%ave_ssh_ibc, fluxes%p_surf_SSH, & CS%calc_rho_for_sea_lev) endif endif @@ -856,7 +860,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (MOM_state_is_synchronized(CS)) & call write_energy(CS%u, CS%v, CS%h, CS%tv, Time_local, CS%nstep_tot, & - G, GV, CS%sum_output_CSp, CS%tracer_flow_CSp, & + G, GV, CS%US, CS%sum_output_CSp, CS%tracer_flow_CSp, & dt_forcing=real_to_time(time_interval) ) call cpu_clock_end(id_clock_other) @@ -920,8 +924,8 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call enable_averaging(dt_thermo, Time_local+real_to_time(dt_thermo-dt), CS%diag) call cpu_clock_begin(id_clock_thick_diff) if (associated(CS%VarMix)) & - call calc_slope_functions(h, CS%tv, dt, G, GV, CS%VarMix) - call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt_thermo, G, GV, & + call calc_slope_functions(h, CS%tv, dt, G, GV, CS%US, CS%VarMix) + call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt_thermo, G, GV, CS%US, & CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) call cpu_clock_end(id_clock_thick_diff) call pass_var(h, G%Domain, clock=id_clock_pass) !###, halo=max(2,cont_stensil)) @@ -939,7 +943,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & Time_local + real_to_time(bbl_time_int-dt), CS%diag) ! Calculate the BBL properties and store them inside visc (u,h). call cpu_clock_begin(id_clock_BBL_visc) - call set_viscous_BBL(CS%u, CS%v, CS%h, CS%tv, CS%visc, G, GV, & + call set_viscous_BBL(CS%u, CS%v, CS%h, CS%tv, CS%visc, G, GV, CS%US, & CS%set_visc_CSp, symmetrize=.true.) call cpu_clock_end(id_clock_BBL_visc) if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM)") @@ -961,7 +965,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call step_MOM_dyn_split_RK2(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, & - CS%eta_av_bc, G, GV, CS%dyn_split_RK2_CSp, calc_dtbt, CS%VarMix, CS%MEKE,& + CS%eta_av_bc, G, GV, CS%US, CS%dyn_split_RK2_CSp, calc_dtbt, CS%VarMix, CS%MEKE,& waves=waves) if (showCallTree) call callTree_waypoint("finished step_MOM_dyn_split (step_MOM)") @@ -976,11 +980,11 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if (CS%use_RK2) then call step_MOM_dyn_unsplit_RK2(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, & - CS%eta_av_bc, G, GV, CS%dyn_unsplit_RK2_CSp, CS%VarMix, CS%MEKE) + CS%eta_av_bc, G, GV, CS%US, CS%dyn_unsplit_RK2_CSp, CS%VarMix, CS%MEKE) else call step_MOM_dyn_unsplit(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, & - CS%eta_av_bc, G, GV, CS%dyn_unsplit_CSp, CS%VarMix, CS%MEKE, Waves=Waves) + CS%eta_av_bc, G, GV, CS%US, CS%dyn_unsplit_CSp, CS%VarMix, CS%MEKE, Waves=Waves) endif if (showCallTree) call callTree_waypoint("finished step_MOM_dyn_unsplit (step_MOM)") @@ -992,8 +996,8 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if (CS%debug) call hchksum(h,"Pre-thickness_diffuse h", G%HI, haloshift=0, scale=GV%H_to_m) if (associated(CS%VarMix)) & - call calc_slope_functions(h, CS%tv, dt, G, GV, CS%VarMix) - call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt, G, GV, & + call calc_slope_functions(h, CS%tv, dt, G, GV, CS%US, CS%VarMix) + call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt, G, GV, CS%US, & CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) if (CS%debug) call hchksum(h,"Post-thickness_diffuse h", G%HI, haloshift=1, scale=GV%H_to_m) @@ -1011,7 +1015,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & endif call cpu_clock_begin(id_clock_ml_restrat) call mixedlayer_restrat(h, CS%uhtr, CS%vhtr, CS%tv, forces, dt, CS%visc%MLD, & - CS%VarMix, G, GV, CS%mixedlayer_restrat_CSp) + CS%VarMix, G, GV, CS%US, CS%mixedlayer_restrat_CSp) call cpu_clock_end(id_clock_ml_restrat) call pass_var(h, G%Domain, clock=id_clock_pass) !###, halo=max(2,cont_stensil)) if (CS%debug) then @@ -1162,7 +1166,7 @@ subroutine step_MOM_thermo(CS, G, GV, u, v, h, tv, fluxes, dtdia, & ! DIABATIC_FIRST=True. Otherwise diabatic() is called after the dynamics ! and set_viscous_BBL is called as a part of the dynamic stepping. call cpu_clock_begin(id_clock_BBL_visc) - call set_viscous_BBL(u, v, h, tv, CS%visc, G, GV, CS%set_visc_CSp, symmetrize=.true.) + call set_viscous_BBL(u, v, h, tv, CS%visc, G, GV, CS%US, CS%set_visc_CSp, symmetrize=.true.) call cpu_clock_end(id_clock_BBL_visc) if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM_thermo)") endif @@ -1184,10 +1188,10 @@ subroutine step_MOM_thermo(CS, G, GV, u, v, h, tv, fluxes, dtdia, & if (CS%use_legacy_diabatic_driver) then ! the following subroutine is legacy and will be deleted in the near future. call legacy_diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, & - dtdia, Time_end_thermo, G, GV, CS%diabatic_CSp, Waves=Waves) + dtdia, Time_end_thermo, G, GV, CS%US, CS%diabatic_CSp, Waves=Waves) else call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, & - dtdia, Time_end_thermo, G, GV, CS%diabatic_CSp, Waves=Waves) + dtdia, Time_end_thermo, G, GV, CS%US, CS%diabatic_CSp, Waves=Waves) endif fluxes%fluxes_used = .true. call cpu_clock_end(id_clock_diabatic) @@ -1217,10 +1221,10 @@ subroutine step_MOM_thermo(CS, G, GV, u, v, h, tv, fluxes, dtdia, & endif call cpu_clock_begin(id_clock_ALE) if (use_ice_shelf) then - call ALE_main(G, GV, h, u, v, tv, CS%tracer_Reg, CS%ALE_CSp, dtdia, & + call ALE_main(G, GV, CS%US, h, u, v, tv, CS%tracer_Reg, CS%ALE_CSp, dtdia, & fluxes%frac_shelf_h) else - call ALE_main(G, GV, h, u, v, tv, CS%tracer_Reg, CS%ALE_CSp, dtdia) + call ALE_main(G, GV, CS%US, h, u, v, tv, CS%tracer_Reg, CS%ALE_CSp, dtdia) endif if (showCallTree) call callTree_waypoint("finished ALE_main (step_MOM_thermo)") @@ -1396,8 +1400,8 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS if (.not. skip_diffusion) then if (associated(CS%VarMix)) then call pass_var(CS%h, G%Domain) - call calc_resoln_function(CS%h, CS%tv, G, GV, CS%VarMix) - call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, CS%VarMix) + call calc_resoln_function(CS%h, CS%tv, G, GV, CS%US, CS%VarMix) + call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, CS%US, CS%VarMix) endif call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) @@ -1421,8 +1425,8 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS if (.not. skip_diffusion) then if (associated(CS%VarMix)) then call pass_var(CS%h, G%Domain) - call calc_resoln_function(CS%h, CS%tv, G, GV, CS%VarMix) - call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, CS%VarMix) + call calc_resoln_function(CS%h, CS%tv, G, GV, CS%US, CS%VarMix) + call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, CS%US, CS%VarMix) endif call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) @@ -1471,7 +1475,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS endif - call adjust_ssh_for_p_atm(CS%tv, G, GV, CS%ave_ssh_ibc, forces%p_surf_SSH, & + call adjust_ssh_for_p_atm(CS%tv, G, GV, CS%US, CS%ave_ssh_ibc, forces%p_surf_SSH, & CS%calc_rho_for_sea_lev) call extract_surface_state(CS, sfc_state) @@ -1511,13 +1515,13 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & logical, optional, intent(in) :: count_calls !< If true, nstep_tot counts the number of !! calls to step_MOM instead of the number of !! dynamics timesteps. - ! local + ! local variables type(ocean_grid_type), pointer :: G => NULL() ! A pointer to a structure with metrics and related type(hor_index_type) :: HI ! A hor_index_type for array extents type(verticalGrid_type), pointer :: GV => NULL() type(dyn_horgrid_type), pointer :: dG => NULL() type(diag_ctrl), pointer :: diag => NULL() - + type(unit_scale_type), pointer :: US => NULL() character(len=4), parameter :: vers_num = 'v2.0' ! This include declares and sets the variable "version". @@ -1626,6 +1630,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call unit_tests(verbosity) endif + ! Determining the internal unit scaling factors for this run. + call unit_scaling_init(param_file, CS%US) + + US => CS%US + call get_param(param_file, "MOM", "SPLIT", CS%split, & "Use the split time stepping if true.", default=.true.) if (CS%split) then @@ -1756,12 +1765,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "If BULKMIXEDLAYER is false, HMIX_SFC_PROP is the depth \n"//& "over which to average to find surface properties like \n"//& "SST and SSS or density (but not surface velocities).", & - units="m", default=1.0) !, scale=GV%m_to_Z) + units="m", default=1.0) !, scale=US%m_to_Z) call get_param(param_file, "MOM", "HMIX_UV_SFC_PROP", CS%Hmix_UV, & "If BULKMIXEDLAYER is false, HMIX_UV_SFC_PROP is the depth\n"//& "over which to average to find surface flow properties,\n"//& "SSU, SSV. A non-positive value indicates no averaging.", & - units="m", default=0.) !, scale=GV%m_to_Z) + units="m", default=0.) !, scale=US%m_to_Z) endif call get_param(param_file, "MOM", "HFREEZE", CS%HFrz, & "If HFREEZE > 0, melt potential will be computed. The actual depth \n"//& @@ -1951,13 +1960,13 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call create_dyn_horgrid(dG, HI, bathymetry_at_vel=bathy_at_vel) call clone_MOM_domain(G%Domain, dG%Domain) - call verticalGridInit( param_file, CS%GV ) + call verticalGridInit( param_file, CS%GV, US ) GV => CS%GV -! dG%g_Earth = (GV%g_Earth*GV%m_to_Z) +! dG%g_Earth = (GV%g_Earth*US%m_to_Z) !### These should be merged with the get_param calls, but must follow verticalGridInit. if (.not.bulkmixedlayer) then - CS%Hmix = CS%Hmix * GV%m_to_Z - CS%Hmix_UV = CS%Hmix_UV * GV%m_to_Z + CS%Hmix = CS%Hmix * US%m_to_Z + CS%Hmix_UV = CS%Hmix_UV * US%m_to_Z endif ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. @@ -2103,7 +2112,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Set the fields that are needed for bitwise identical restarting ! the time stepping scheme. call restart_init(param_file, restart_CSp) - call set_restart_fields(GV, param_file, CS, restart_CSp) + call set_restart_fields(GV, US, param_file, CS, restart_CSp) if (CS%split) then call register_restarts_dyn_split_RK2(dG%HI, GV, param_file, & CS%dyn_split_RK2_CSp, restart_CSp, CS%uh, CS%vh) @@ -2117,7 +2126,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! This subroutine calls user-specified tracer registration routines. ! Additional calls can be added to MOM_tracer_flow_control.F90. - call call_tracer_register(dG%HI, GV, param_file, CS%tracer_flow_CSp, & + call call_tracer_register(dG%HI, GV, US, param_file, CS%tracer_flow_CSp, & CS%tracer_Reg, restart_CSp) call MEKE_alloc_register_restart(dG%HI, param_file, CS%MEKE, restart_CSp) @@ -2132,12 +2141,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Initialize dynamically evolving fields, perhaps from restart files. call cpu_clock_begin(id_clock_MOM_init) - call MOM_initialize_coord(GV, param_file, write_geom_files, & + call MOM_initialize_coord(GV, US, param_file, write_geom_files, & dirs%output_directory, CS%tv, dG%max_depth) call callTree_waypoint("returned from MOM_initialize_coord() (initialize_MOM)") if (CS%use_ALE_algorithm) then - call ALE_init(param_file, GV, dG%max_depth, CS%ALE_CSp) + call ALE_init(param_file, GV, US, dG%max_depth, CS%ALE_CSp) call callTree_waypoint("returned from ALE_init() (initialize_MOM)") endif @@ -2157,9 +2166,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & else ; G%Domain_aux => G%Domain ; endif ! Copy common variables from the vertical grid to the horizontal grid. ! Consider removing this later? - G%ke = GV%ke ; G%g_Earth = (GV%g_Earth*GV%m_to_Z) + G%ke = GV%ke ; G%g_Earth = (GV%g_Earth*US%m_to_Z) - call MOM_initialize_state(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, param_file, & + call MOM_initialize_state(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, US, param_file, & dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & CS%sponge_CSp, CS%ALE_sponge_CSp, CS%OBC, Time_in) call cpu_clock_end(id_clock_MOM_init) @@ -2186,7 +2195,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (CS%debug .or. CS%G%symmetric) then call clone_MOM_domain(CS%G%Domain, CS%G%Domain_aux, symmetric=.false.) else ; CS%G%Domain_aux => CS%G%Domain ;endif - G%ke = GV%ke ; G%g_Earth = (GV%g_Earth*GV%m_to_Z) + G%ke = GV%ke ; G%g_Earth = (GV%g_Earth*US%m_to_Z) endif @@ -2223,10 +2232,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & enddo ; enddo ! pass to the pointer shelf_area => frac_shelf_h - call ALE_main(G, GV, CS%h, CS%u, CS%v, CS%tv, CS%tracer_Reg, CS%ALE_CSp, & + call ALE_main(G, GV, US, CS%h, CS%u, CS%v, CS%tv, CS%tracer_Reg, CS%ALE_CSp, & frac_shelf_h = shelf_area) else - call ALE_main( G, GV, CS%h, CS%u, CS%v, CS%tv, CS%tracer_Reg, CS%ALE_CSp ) + call ALE_main( G, GV, US, CS%h, CS%u, CS%v, CS%tv, CS%tracer_Reg, CS%ALE_CSp ) endif call cpu_clock_begin(id_clock_pass_init) @@ -2262,7 +2271,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! This call sets up the diagnostic axes. These are needed, ! e.g. to generate the target grids below. - call set_axes_info(G, GV, param_file, diag) + call set_axes_info(G, GV, US, param_file, diag) ! Whenever thickness/T/S changes let the diag manager know, target grids ! for vertical remapping may need to be regenerated. @@ -2295,12 +2304,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%useMEKE = MEKE_init(Time, G, param_file, diag, CS%MEKE_CSp, CS%MEKE, restart_CSp) - call VarMix_init(Time, G, GV, param_file, diag, CS%VarMix) - call set_visc_init(Time, G, GV, param_file, diag, CS%visc, CS%set_visc_CSp, restart_CSp, CS%OBC) + call VarMix_init(Time, G, GV, US, param_file, diag, CS%VarMix) + call set_visc_init(Time, G, GV, US, param_file, diag, CS%visc, CS%set_visc_CSp, restart_CSp, CS%OBC) if (CS%split) then allocate(eta(SZI_(G),SZJ_(G))) ; eta(:,:) = 0.0 call initialize_dyn_split_RK2(CS%u, CS%v, CS%h, CS%uh, CS%vh, eta, Time, & - G, GV, param_file, diag, CS%dyn_split_RK2_CSp, restart_CSp, & + G, GV, US, param_file, diag, CS%dyn_split_RK2_CSp, restart_CSp, & CS%dt, CS%ADp, CS%CDp, MOM_internal_state, CS%VarMix, CS%MEKE, & CS%OBC, CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, & CS%visc, dirs, CS%ntrunc, calc_dtbt=calc_dtbt) @@ -2317,20 +2326,20 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif endif elseif (CS%use_RK2) then - call initialize_dyn_unsplit_RK2(CS%u, CS%v, CS%h, Time, G, GV, & + call initialize_dyn_unsplit_RK2(CS%u, CS%v, CS%h, Time, G, GV, US, & param_file, diag, CS%dyn_unsplit_RK2_CSp, restart_CSp, & CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, CS%update_OBC_CSp, & CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, CS%ntrunc) else - call initialize_dyn_unsplit(CS%u, CS%v, CS%h, Time, G, GV, & + call initialize_dyn_unsplit(CS%u, CS%v, CS%h, Time, G, GV, US, & param_file, diag, CS%dyn_unsplit_CSp, restart_CSp, & CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, CS%update_OBC_CSp, & CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, CS%ntrunc) endif call callTree_waypoint("dynamics initialized (initialize_MOM)") - call thickness_diffuse_init(Time, G, GV, param_file, diag, CS%CDp, CS%thickness_diffuse_CSp) - CS%mixedlayer_restrat = mixedlayer_restrat_init(Time, G, GV, param_file, diag, & + call thickness_diffuse_init(Time, G, GV, US, param_file, diag, CS%CDp, CS%thickness_diffuse_CSp) + CS%mixedlayer_restrat = mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, & CS%mixedlayer_restrat_CSp, restart_CSp) if (CS%mixedlayer_restrat) then if (.not.(bulkmixedlayer .or. CS%use_ALE_algorithm)) & @@ -2345,7 +2354,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call diag_copy_diag_to_storage(CS%diag_pre_sync, CS%h, CS%diag) CS%Z_diag_interval = real_to_time(CS%dt_therm * max(1,floor(0.01 + Z_diag_int/CS%dt_therm))) - call MOM_diag_to_Z_init(Time, G, GV, param_file, diag, CS%diag_to_Z_CSp) + call MOM_diag_to_Z_init(Time, G, GV, US, param_file, diag, CS%diag_to_Z_CSp) CS%Z_diag_time = Start_time + CS%Z_diag_interval * (1 + & ((Time + real_to_time(CS%dt_therm)) - Start_time) / CS%Z_diag_interval) @@ -2359,7 +2368,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call adiabatic_driver_init(Time, G, param_file, diag, CS%diabatic_CSp, & CS%tracer_flow_CSp, CS%diag_to_Z_CSp) else - call diabatic_driver_init(Time, G, GV, param_file, CS%use_ALE_algorithm, diag, & + call diabatic_driver_init(Time, G, GV, US, param_file, CS%use_ALE_algorithm, diag, & CS%ADp, CS%CDp, CS%diabatic_CSp, CS%tracer_flow_CSp, & CS%sponge_CSp, CS%ALE_sponge_CSp, CS%diag_to_Z_CSp) endif @@ -2383,7 +2392,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! This subroutine initializes any tracer packages. new_sim = is_new_run(restart_CSp) - call tracer_flow_control_init(.not.new_sim, Time, G, GV, CS%h, param_file, & + call tracer_flow_control_init(.not.new_sim, Time, G, GV, US, CS%h, param_file, & CS%diag, CS%OBC, CS%tracer_flow_CSp, CS%sponge_CSp, & CS%ALE_sponge_CSp, CS%diag_to_Z_CSp, CS%tv) if (present(tracer_flow_CSp)) tracer_flow_CSp => CS%tracer_flow_CSp @@ -2438,9 +2447,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (.not.query_initialized(CS%ave_ssh_ibc,"ave_ssh",restart_CSp)) then if (CS%split) then - call find_eta(CS%h, CS%tv, G, GV, CS%ave_ssh_ibc, eta, eta_to_m=1.0) + call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, eta, eta_to_m=1.0) else - call find_eta(CS%h, CS%tv, G, GV, CS%ave_ssh_ibc, eta_to_m=1.0) + call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, eta_to_m=1.0) endif endif if (CS%split) deallocate(eta) @@ -2461,6 +2470,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & !### This could perhaps go here instead of in finish_MOM_initialization? ! call fix_restart_scaling(GV) + ! call fix_restart_unit_scaling(CS%US) call callTree_leave("initialize_MOM()") call cpu_clock_end(id_clock_init) @@ -2489,13 +2499,14 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) !### Move to initialize_MOM? call fix_restart_scaling(GV) + call fix_restart_unit_scaling(CS%US) ! Write initial conditions if (CS%write_IC) then allocate(restart_CSp_tmp) restart_CSp_tmp = restart_CSp allocate(z_interface(SZI_(G),SZJ_(G),SZK_(G)+1)) - call find_eta(CS%h, CS%tv, G, GV, z_interface, eta_to_m=1.0) + call find_eta(CS%h, CS%tv, G, GV, CS%US, z_interface, eta_to_m=1.0) call register_restart_field(z_interface, "eta", .true., restart_CSp_tmp, & "Interface heights", "meter", z_grid='i') @@ -2505,7 +2516,7 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) deallocate(restart_CSp_tmp) endif - call write_energy(CS%u, CS%v, CS%h, CS%tv, Time, 0, G, GV, & + call write_energy(CS%u, CS%v, CS%h, CS%tv, Time, 0, G, GV, CS%US, & CS%sum_output_CSp, CS%tracer_flow_CSp) call callTree_leave("finish_MOM_initialization()") @@ -2582,8 +2593,9 @@ end subroutine MOM_timing_init !! This routine should be altered if there are any changes to the !! time stepping scheme. The CHECK_RESTART facility may be used to !! confirm that all needed restart fields have been included. -subroutine set_restart_fields(GV, param_file, CS, restart_CSp) +subroutine set_restart_fields(GV, US, param_file, CS, restart_CSp) type(verticalGrid_type), intent(inout) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(inout) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< opened file for parsing to get parameters type(MOM_control_struct), intent(in) :: CS !< control structure set up by inialize_MOM type(MOM_restart_CS), pointer :: restart_CSp !< pointer to the restart control @@ -2633,7 +2645,7 @@ subroutine set_restart_fields(GV, param_file, CS, restart_CSp) endif ! Register scalar unit conversion factors. - call register_restart_field(GV%m_to_Z_restart, "m_to_Z", .false., restart_CSp, & + call register_restart_field(US%m_to_Z_restart, "m_to_Z", .false., restart_CSp, & "Height unit conversion factor", "Z meter-1") call register_restart_field(GV%m_to_H_restart, "m_to_H", .false., restart_CSp, & "Thickness unit conversion factor", "Z meter-1") @@ -2642,12 +2654,13 @@ end subroutine set_restart_fields !> Apply a correction to the sea surface height to compensate !! for the atmospheric pressure (the inverse barometer). -subroutine adjust_ssh_for_p_atm(tv, G, GV, ssh, p_atm, use_EOS) +subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: ssh !< time mean surface height (m) - real, dimension(:,:), optional, pointer :: p_atm !< atmospheric pressure (Pascal) + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: ssh !< time mean surface height (m) + real, dimension(:,:), optional, pointer :: p_atm !< atmospheric pressure (Pascal) logical, optional, intent(in) :: use_EOS !< If true, calculate the density for !! the SSH correction using the equation of state. @@ -2670,7 +2683,7 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, ssh, p_atm, use_EOS) else Rho_conv=GV%Rho0 endif - IgR0 = 1.0 / (Rho_conv * (GV%g_Earth*GV%m_to_Z)) + IgR0 = 1.0 / (Rho_conv * (GV%g_Earth*US%m_to_Z)) ssh(i,j) = ssh(i,j) + p_atm(i,j) * IgR0 enddo ; enddo endif ; endif @@ -3038,17 +3051,20 @@ end function MOM_state_is_synchronized !> This subroutine offers access to values or pointers to other types from within !! the MOM_control_struct, allowing the MOM_control_struct to be opaque. -subroutine get_MOM_state_elements(CS, G, GV, C_p, use_temp) +subroutine get_MOM_state_elements(CS, G, GV, US, C_p, use_temp) type(MOM_control_struct), pointer :: CS !< MOM control structure type(ocean_grid_type), & optional, pointer :: G !< structure containing metrics and grid info type(verticalGrid_type), & optional, pointer :: GV !< structure containing vertical grid info + type(unit_scale_type), & + optional, pointer :: US !< A dimensional unit scaling type real, optional, intent(out) :: C_p !< The heat capacity logical, optional, intent(out) :: use_temp !< Indicates whether temperature is a state variable if (present(G)) G => CS%G if (present(GV)) GV => CS%GV + if (present(US)) US => CS%US if (present(C_p)) C_p = CS%tv%C_p if (present(use_temp)) use_temp = associated(CS%tv%T) end subroutine get_MOM_state_elements @@ -3107,6 +3123,7 @@ subroutine MOM_end(CS) if (associated(CS%update_OBC_CSp)) call OBC_register_end(CS%update_OBC_CSp) call verticalGridEnd(CS%GV) + call unit_scaling_end(CS%US) call MOM_grid_end(CS%G) deallocate(CS) diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index ebefd38bcf..c343c38516 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -17,6 +17,7 @@ module MOM_PressureForce use MOM_PressureForce_Mont, only : PressureForce_Mont_init, PressureForce_Mont_end use MOM_PressureForce_Mont, only : PressureForce_Mont_CS use MOM_tidal_forcing, only : tidal_forcing_CS +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_ALE, only: ALE_CS @@ -43,9 +44,10 @@ module MOM_PressureForce contains !> A thin layer between the model and the Boussinesq and non-Boussinesq pressure force routines. -subroutine PressureForce(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, pbce, eta) +subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, eta) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables @@ -67,26 +69,26 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, pbce, eta) if (CS%Analytic_FV_PGF .and. CS%blocked_AFV) then if (GV%Boussinesq) then - call PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, & + call PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, & CS%PressureForce_blk_AFV_CSp, ALE_CSp, p_atm, pbce, eta) else - call PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, & + call PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, & CS%PressureForce_blk_AFV_CSp, p_atm, pbce, eta) endif elseif (CS%Analytic_FV_PGF) then if (GV%Boussinesq) then - call PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS%PressureForce_AFV_CSp, & + call PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_AFV_CSp, & ALE_CSp, p_atm, pbce, eta) else - call PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS%PressureForce_AFV_CSp, & + call PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_AFV_CSp, & ALE_CSp, p_atm, pbce, eta) endif else if (GV%Boussinesq) then - call PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS%PressureForce_Mont_CSp, & + call PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_Mont_CSp, & p_atm, pbce, eta) else - call PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS%PressureForce_Mont_CSp, & + call PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS%PressureForce_Mont_CSp, & p_atm, pbce, eta) endif endif diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 4f295600cd..e21b4200e1 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -9,6 +9,7 @@ module MOM_PressureForce_Mont use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_tidal_forcing, only : calc_tidal_forcing, tidal_forcing_CS +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs @@ -55,9 +56,10 @@ module MOM_PressureForce_Mont !! ie to ie, je to je range before this subroutine is called: !! h[ie+1] and h[je+1] and and (if tv%form_of_EOS is set) T[ie+1], S[ie+1], !! T[je+1], and S[je+1]. -subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta) +subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, eta) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in kg/m2. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration due to pressure gradients @@ -193,11 +195,11 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do k=1,nz ; do i=Isq,Ieq+1 - SSH(i,j) = SSH(i,j) + (GV%m_to_Z*GV%H_to_kg_m2)*h(i,j,k)*alpha_Lay(k) + SSH(i,j) = SSH(i,j) + (US%m_to_Z*GV%H_to_kg_m2)*h(i,j,k)*alpha_Lay(k) enddo ; enddo ; enddo endif - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 geopot_bot(i,j) = -GV%g_Earth*(e_tidal(i,j) + G%bathyT(i,j)) @@ -353,9 +355,10 @@ end subroutine PressureForce_Mont_nonBouss !! ie to ie, je to je range before this subroutine is called: !! h[ie+1] and h[je+1] and (if tv%form_of_EOS is set) T[ie+1], S[ie+1], !! T[je+1], and S[je+1]. -subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta) +subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, eta) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration due to pressure gradients @@ -443,7 +446,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_Z enddo ; enddo enddo - call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) + call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) endif ! Here layer interface heights, e, are calculated. diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index a27f72cae2..050b280c4e 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -10,6 +10,7 @@ module MOM_PressureForce_AFV use MOM_grid, only : ocean_grid_type use MOM_PressureForce_Mont, only : set_pbce_Bouss, set_pbce_nonBouss use MOM_tidal_forcing, only : calc_tidal_forcing, tidal_forcing_CS +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs @@ -57,9 +58,10 @@ module MOM_PressureForce_AFV !> Thin interface between the model and the Boussinesq and non-Boussinesq !! pressure force routines. -subroutine PressureForce_AFV(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, pbce, eta) +subroutine PressureForce_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, eta) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg/m2) type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration (m/s2) @@ -76,9 +78,9 @@ subroutine PressureForce_AFV(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, pbce, e !! contributions or compressibility compensation. if (GV%Boussinesq) then - call PressureForce_AFV_bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, pbce, eta) + call PressureForce_AFV_bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, eta) else - call PressureForce_AFV_nonbouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, pbce, eta) + call PressureForce_AFV_nonbouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, eta) endif end subroutine PressureForce_AFV @@ -93,9 +95,10 @@ end subroutine PressureForce_AFV !! ie to ie, je to je range before this subroutine is called: !! h[ie+1] and h[je+1] and (if tv%eqn_of_state is set) T[ie+1], S[ie+1], !! T[je+1], and S[je+1]. -subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, pbce, eta) +subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, eta) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (kg/m2) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration (m/s2) @@ -316,7 +319,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth enddo ; enddo - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) - g_Earth_z * e_tidal(i,j) @@ -434,9 +437,10 @@ end subroutine PressureForce_AFV_nonBouss !! ie to ie, je to je range before this subroutine is called: !! h[ie+1] and h[je+1] and (if tv%eqn_of_state is set) T[ie+1], S[ie+1], !! T[je+1], and S[je+1]. -subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, pbce, eta) +subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, eta) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (kg/m2) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration (m/s2) @@ -541,7 +545,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, p e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_Z enddo ; enddo enddo - call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) + call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) endif ! Here layer interface heights, e, are calculated. diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index cd5961c23d..04b77548be 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -10,6 +10,7 @@ module MOM_PressureForce_blk_AFV use MOM_grid, only : ocean_grid_type use MOM_PressureForce_Mont, only : set_pbce_Bouss, set_pbce_nonBouss use MOM_tidal_forcing, only : calc_tidal_forcing, tidal_forcing_CS +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs @@ -57,9 +58,10 @@ module MOM_PressureForce_blk_AFV !> Thin interface between the model and the Boussinesq and non-Boussinesq !! pressure force routines. -subroutine PressureForce_blk_AFV(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, pbce, eta) +subroutine PressureForce_blk_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, eta) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg/m2) type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration (m/s2) @@ -76,9 +78,9 @@ subroutine PressureForce_blk_AFV(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, pbc !! contributions or compressibility compensation. if (GV%Boussinesq) then - call PressureForce_blk_AFV_bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, pbce, eta) + call PressureForce_blk_AFV_bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, eta) else - call PressureForce_blk_AFV_nonbouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta) + call PressureForce_blk_AFV_nonbouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, eta) endif end subroutine PressureForce_blk_AFV @@ -93,9 +95,10 @@ end subroutine PressureForce_blk_AFV !! ie to ie, je to je range before this subroutine is called: !! h[ie+1] and h[je+1] and (if tv%eqn_of_state is set) T[ie+1], S[ie+1], !! T[je+1], and S[je+1]. -subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbce, eta) +subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, eta) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (kg/m2) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration (m/s2) @@ -283,7 +286,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, CS, p_atm, pbc do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth enddo ; enddo - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) - g_Earth_z * e_tidal(i,j) @@ -417,14 +420,15 @@ end subroutine PressureForce_blk_AFV_nonBouss !! ie to ie, je to je range before this subroutine is called: !! h[ie+1] and h[je+1] and (if tv%eqn_of_state is set) T[ie+1], S[ie+1], !! T[je+1], and S[je+1]. -subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_atm, pbce, eta) +subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, eta) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg/m2) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration (m/s2) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration (m/s2) - type(PressureForce_blk_AFV_CS), pointer :: CS !< Finite volume PGF control structure + type(PressureForce_blk_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean !! or atmosphere-ocean interface in Pa. @@ -527,7 +531,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, CS, ALE_CSp, p_at e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_Z enddo ; enddo enddo - call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=GV%m_to_Z) + call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) endif ! Here layer interface heights, e, are calculated. diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 70e40ebbd6..bca06c2a0c 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -23,6 +23,7 @@ module MOM_barotropic use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_tidal_forcing, only : tidal_forcing_sensitivity, tidal_forcing_CS use MOM_time_manager, only : time_type, real_to_time, operator(+), operator(-) +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : BT_cont_type, alloc_bt_cont_type use MOM_verticalGrid, only : verticalGrid_type @@ -375,14 +376,15 @@ module MOM_barotropic !! 0.0 and 1.0 determining the scheme. In practice, bebt must be of !! order 0.2 or greater. A forwards-backwards treatment of the !! Coriolis terms is always used. -subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & - forces, pbce, eta_PF_in, U_Cor, V_Cor, & - accel_layer_u, accel_layer_v, eta_out, uhbtav, vhbtav, G, GV, CS, & +subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, & + eta_PF_in, U_Cor, V_Cor, accel_layer_u, accel_layer_v, & + eta_out, uhbtav, vhbtav, G, GV, US, CS, & visc_rem_u, visc_rem_v, etaav, OBC, & BT_cont, eta_PF_start, & taux_bot, tauy_bot, uh0, vh0, u_uh0, v_vh0) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_in !< The initial (3-D) zonal velocity, in m s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_in !< The initial (3-D) meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta_in !< The initial barotropic free surface height @@ -708,7 +710,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & dtbt = dt * Instep bebt = CS%bebt be_proj = CS%bebt - mass_to_Z = GV%m_to_Z / GV%Rho0 + mass_to_Z = US%m_to_Z / GV%Rho0 !--- setup the weight when computing vbt_trans and ubt_trans if (project_velocity) then @@ -1459,7 +1461,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & call uvchksum("BT frhat[uv]", CS%frhatu, CS%frhatv, G%HI, 0, .true., .true.) call uvchksum("BT bc_accel_[uv]", bc_accel_u, bc_accel_v, & G%HI, haloshift=0) - call uvchksum("BT IDat[uv]", CS%IDatu, CS%IDatv, G%HI, haloshift=0, scale=GV%m_to_Z) + call uvchksum("BT IDat[uv]", CS%IDatu, CS%IDatv, G%HI, haloshift=0, scale=US%m_to_Z) call uvchksum("BT visc_rem_[uv]", visc_rem_u, visc_rem_v, & G%HI, haloshift=1) endif @@ -2256,9 +2258,10 @@ end subroutine btstep !> This subroutine automatically determines an optimal value for dtbt based !! on some state of the ocean. -subroutine set_dtbt(G, GV, CS, eta, pbce, BT_cont, gtot_est, SSH_add) +subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(barotropic_CS), pointer :: CS !< Barotropic control structure. real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta !< The barotropic free surface !! height anomaly or column mass anomaly, in H. @@ -2323,7 +2326,7 @@ subroutine set_dtbt(G, GV, CS, eta, pbce, BT_cont, gtot_est, SSH_add) elseif (CS%Nonlinear_continuity .and. present(eta)) then call find_face_areas(Datu, Datv, G, GV, CS, MS, eta=eta, halo=0) else - call find_face_areas(Datu, Datv, G, GV, CS, MS, halo=0, add_max=add_SSH*GV%m_to_Z) + call find_face_areas(Datu, Datv, G, GV, CS, MS, halo=0, add_max=add_SSH*US%m_to_Z) endif det_de = 0.0 @@ -3677,10 +3680,11 @@ end subroutine bt_mass_source !> barotropic_init initializes a number of time-invariant fields used in the !! barotropic calculation and initializes any barotropic fields that have not !! already been initialized. -subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & +subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, & restart_CS, calc_dtbt, BT_cont, tides_CSp) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< The zonal velocity, in m s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -4137,8 +4141,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ! Estimate the maximum stable barotropic time step. gtot_estimate = 0.0 - do k=1,G%ke ; gtot_estimate = gtot_estimate + GV%g_prime(K)*GV%m_to_Z ; enddo - call set_dtbt(G, GV, CS, gtot_est = gtot_estimate, SSH_add = SSH_extra) + do k=1,G%ke ; gtot_estimate = gtot_estimate + GV%g_prime(K)*US%m_to_Z ; enddo + call set_dtbt(G, GV, US, CS, gtot_est = gtot_estimate, SSH_add = SSH_extra) if (dtbt_input > 0.0) then CS%dtbt = dtbt_input diff --git a/src/core/MOM_boundary_update.F90 b/src/core/MOM_boundary_update.F90 index a37fbaa22c..6ca49256f2 100644 --- a/src/core/MOM_boundary_update.F90 +++ b/src/core/MOM_boundary_update.F90 @@ -13,6 +13,7 @@ module MOM_boundary_update use MOM_open_boundary, only : ocean_obc_type, update_OBC_segment_data use MOM_open_boundary, only : OBC_registry_type, file_OBC_CS use MOM_open_boundary, only : register_file_OBC, file_OBC_end +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type use MOM_tracer_registry, only : tracer_registry_type use MOM_variables, only : thermo_var_ptrs @@ -109,9 +110,10 @@ subroutine call_OBC_register(param_file, CS, OBC) end subroutine call_OBC_register !> Calls appropriate routine to update the open boundary conditions. -subroutine update_OBC_data(OBC, G, GV, tv, h, CS, Time) +subroutine update_OBC_data(OBC, G, GV, US, tv, h, CS, Time) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< layer thicknesses, in H type(ocean_OBC_type), pointer :: OBC !< Open boundary structure @@ -138,7 +140,7 @@ subroutine update_OBC_data(OBC, G, GV, tv, h, CS, Time) if (CS%use_tidal_bay) & call tidal_bay_set_OBC_data(OBC, CS%tidal_bay_OBC_CSp, G, h, Time) if (CS%use_Kelvin) & - call Kelvin_set_OBC_data(OBC, CS%Kelvin_OBC_CSp, G, GV, h, Time) + call Kelvin_set_OBC_data(OBC, CS%Kelvin_OBC_CSp, G, GV, US, h, Time) if (CS%use_shelfwave) & call shelfwave_set_OBC_data(OBC, CS%shelfwave_OBC_CSp, G, h, Time) if (CS%use_dyed_channel) & diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 4c861eeec9..00da82a00f 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -53,6 +53,7 @@ module MOM_dynamics_split_RK2 use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_ML, set_visc_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS +use MOM_unit_scaling, only : unit_scale_type use MOM_vert_friction, only : vertvisc, vertvisc_coef, vertvisc_remnant use MOM_vert_friction, only : vertvisc_limit_vel, vertvisc_init, vertvisc_CS use MOM_vert_friction, only : updateCFLtruncationValue @@ -229,9 +230,10 @@ module MOM_dynamics_split_RK2 subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & Time_local, dt, forces, p_surf_begin, p_surf_end, & uh, vh, uhtr, vhtr, eta_av, & - G, GV, CS, calc_dtbt, VarMix, MEKE, Waves) + G, GV, US, CS, calc_dtbt, VarMix, MEKE, Waves) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & target, intent(inout) :: u !< zonal velocity (m/s) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -404,7 +406,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! pbce = dM/deta if (CS%begw == 0.0) call enable_averaging(dt, Time_local, CS%diag) call cpu_clock_begin(id_clock_pres) - call PressureForce(h, tv, CS%PFu, CS%PFv, G, GV, CS%PressureForce_CSp, & + call PressureForce(h, tv, CS%PFu, CS%PFv, G, GV, US, CS%PressureForce_CSp, & CS%ALE_CSp, p_surf, CS%pbce, CS%eta_PF) if (dyn_p_surf) then Pa_to_eta = 1.0 / GV%H_to_Pa @@ -419,7 +421,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (showCallTree) call callTree_wayPoint("done with PressureForce (step_MOM_dyn_split_RK2)") if (associated(CS%OBC)) then; if (CS%OBC%update_OBC) then - call update_OBC_data(CS%OBC, G, GV, tv, h, CS%update_OBC_CSp, Time_local) + call update_OBC_data(CS%OBC, G, GV, US, tv, h, CS%update_OBC_CSp, Time_local) endif; endif if (associated(CS%OBC) .and. CS%debug_OBC) & call open_boundary_zero_normal_flow(CS%OBC, G, CS%PFu, CS%PFv) @@ -472,14 +474,14 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & enddo call enable_averaging(dt, Time_local, CS%diag) - call set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, & + call set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) if (CS%debug) then call uvchksum("before vertvisc: up", up, vp, G%HI, haloshift=0, symmetric=sym) endif - call vertvisc_coef(up, vp, h, forces, visc, dt, G, GV, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(up, vp, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt, G, GV, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) if (showCallTree) call callTree_wayPoint("done with vertvisc_coef (step_MOM_dyn_split_RK2)") @@ -525,14 +527,13 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & u_init => u ; v_init => v call cpu_clock_begin(id_clock_btstep) - if (calc_dtbt) call set_dtbt(G, GV, CS%barotropic_CSp, eta, CS%pbce) + if (calc_dtbt) call set_dtbt(G, GV, US, CS%barotropic_CSp, eta, CS%pbce) if (showCallTree) call callTree_enter("btstep(), MOM_barotropic.F90") ! This is the predictor step call to btstep. - call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, & - forces, CS%pbce, CS%eta_PF, u_av, v_av, CS%u_accel_bt, & - CS%v_accel_bt, eta_pred, CS%uhbt, CS%vhbt, G, GV, CS%barotropic_CSp,& - CS%visc_rem_u, CS%visc_rem_v, OBC=CS%OBC, & - BT_cont = CS%BT_cont, eta_PF_start=eta_PF_start, & + call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, CS%eta_PF, & + u_av, v_av, CS%u_accel_bt, CS%v_accel_bt, eta_pred, CS%uhbt, CS%vhbt, & + G, GV, US, CS%barotropic_CSp, CS%visc_rem_u, CS%visc_rem_v, & + OBC=CS%OBC, BT_cont=CS%BT_cont, eta_PF_start=eta_PF_start, & taux_bot=taux_bot, tauy_bot=tauy_bot, & uh0=uh_ptr, vh0=vh_ptr, u_uh0=u_ptr, v_vh0=v_ptr) if (showCallTree) call callTree_leave("btstep()") @@ -575,7 +576,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug) then call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym) endif - call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, CS%vertvisc_CSp, & + call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & CS%OBC) call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & GV, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) @@ -653,9 +654,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! PFu = d/dx M(hp,T,S) ! pbce = dM/deta call cpu_clock_begin(id_clock_pres) - call PressureForce(hp, tv, CS%PFu, CS%PFv, G, GV, & - CS%PressureForce_CSp, CS%ALE_CSp, & - p_surf, CS%pbce, CS%eta_PF) + call PressureForce(hp, tv, CS%PFu, CS%PFv, G, GV, US, CS%PressureForce_CSp, & + CS%ALE_CSp, p_surf, CS%pbce, CS%eta_PF) call cpu_clock_end(id_clock_pres) if (showCallTree) call callTree_wayPoint("done with PressureForce[hp=(1-b).h+b.h] (step_MOM_dyn_split_RK2)") endif @@ -729,11 +729,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (showCallTree) call callTree_enter("btstep(), MOM_barotropic.F90") ! This is the corrector step call to btstep. - call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, & - forces, CS%pbce, CS%eta_PF, u_av, v_av, CS%u_accel_bt, & - CS%v_accel_bt, eta_pred, CS%uhbt, CS%vhbt, G, GV, & - CS%barotropic_CSp, CS%visc_rem_u, CS%visc_rem_v, & - etaav=eta_av, OBC=CS%OBC, & + call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, & + CS%eta_PF, u_av, v_av, CS%u_accel_bt, CS%v_accel_bt, & + eta_pred, CS%uhbt, CS%vhbt, G, GV, US, CS%barotropic_CSp, & + CS%visc_rem_u, CS%visc_rem_v, etaav=eta_av, OBC=CS%OBC, & BT_cont = CS%BT_cont, eta_PF_start=eta_PF_start, & taux_bot=taux_bot, tauy_bot=tauy_bot, & uh0=uh_ptr, vh0=vh_ptr, u_uh0=u_ptr, v_vh0=v_ptr) @@ -774,7 +773,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! u <- u + dt d/dz visc d/dz u ! u_av <- u_av + dt d/dz visc d/dz u_av call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, & CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot,waves=waves) if (G%nonblocking_updates) then @@ -951,12 +950,13 @@ end subroutine register_restarts_dyn_split_RK2 !> This subroutine initializes all of the variables that are used by this !! dynamic core, including diagnostics and the cpu clocks. -subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_file, & +subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param_file, & diag, CS, restart_CS, dt, Accel_diag, Cont_diag, MIS, & VarMix, MEKE, OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & visc, dirs, ntrunc, calc_dtbt) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(inout) :: u !< zonal velocity (m/s) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -1096,7 +1096,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil call PressureForce_init(Time, G, GV, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) call hor_visc_init(Time, G, param_file, diag, CS%hor_visc_CSp) - call vertvisc_init(MIS, Time, G, GV, param_file, diag, CS%ADp, dirs, & + call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & "initialize_dyn_split_RK2 called with setVisc_CSp unassociated.") @@ -1128,7 +1128,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil ! Copy eta into an output array. do j=js,je ; do i=is,ie ; eta(i,j) = CS%eta(i,j) ; enddo ; enddo - call barotropic_init(u, v, h, CS%eta, Time, G, GV, param_file, diag, & + call barotropic_init(u, v, h, CS%eta, Time, G, GV, US, param_file, diag, & CS%barotropic_CSp, restart_CS, calc_dtbt, CS%BT_cont, & CS%tides_CSp) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 430443de06..543a97e31f 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -92,6 +92,7 @@ module MOM_dynamics_unsplit use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_ML, set_visc_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS +use MOM_unit_scaling, only : unit_scale_type use MOM_vert_friction, only : vertvisc, vertvisc_coef use MOM_vert_friction, only : vertvisc_limit_vel, vertvisc_init, vertvisc_CS use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units @@ -180,10 +181,11 @@ module MOM_dynamics_unsplit !> Step the MOM6 dynamics using an unsplit mixed 2nd order (for continuity) and !! 3rd order (for the inviscid momentum equations) order scheme subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & - p_surf_begin, p_surf_end, uh, vh, uhtr, vhtr, eta_av, G, GV, CS, & + p_surf_begin, p_surf_end, uh, vh, uhtr, vhtr, eta_av, G, GV, US, CS, & VarMix, MEKE, Waves) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity, in m s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H. @@ -307,12 +309,12 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & if (dyn_p_surf) then ; do j=js-2,je+2 ; do i=is-2,ie+2 p_surf(i,j) = 0.75*p_surf_begin(i,j) + 0.25*p_surf_end(i,j) enddo ; enddo ; endif - call PressureForce(h_av, tv, CS%PFu, CS%PFv, G, GV, & + call PressureForce(h_av, tv, CS%PFu, CS%PFv, G, GV, US, & CS%PressureForce_CSp, CS%ALE_CSp, p_surf) call cpu_clock_end(id_clock_pres) if (associated(CS%OBC)) then; if (CS%OBC%update_OBC) then - call update_OBC_data(CS%OBC, G, GV, tv, h, CS%update_OBC_CSp, Time_local) + call update_OBC_data(CS%OBC, G, GV, US, tv, h, CS%update_OBC_CSp, Time_local) endif; endif if (associated(CS%OBC)) then call open_boundary_zero_normal_flow(CS%OBC, G, CS%PFu, CS%PFv) @@ -340,10 +342,10 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! up <- up + dt/2 d/dz visc d/dz up call cpu_clock_begin(id_clock_vertvisc) call enable_averaging(dt, Time_local, CS%diag) - call set_viscous_ML(u, v, h_av, tv, forces, visc, dt*0.5, G, GV, & + call set_viscous_ML(u, v, h_av, tv, forces, visc, dt*0.5, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) - call vertvisc_coef(up, vp, h_av, forces, visc, dt*0.5, G, GV, & + call vertvisc_coef(up, vp, h_av, forces, visc, dt*0.5, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(up, vp, h_av, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & G, GV, CS%vertvisc_CSp, Waves=Waves) @@ -375,12 +377,12 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & if (dyn_p_surf) then ; do j=js-2,je+2 ; do i=is-2,ie+2 p_surf(i,j) = 0.25*p_surf_begin(i,j) + 0.75*p_surf_end(i,j) enddo ; enddo ; endif - call PressureForce(h_av, tv, CS%PFu, CS%PFv, G, GV, & + call PressureForce(h_av, tv, CS%PFu, CS%PFv, G, GV, US, & CS%PressureForce_CSp, CS%ALE_CSp, p_surf) call cpu_clock_end(id_clock_pres) if (associated(CS%OBC)) then; if (CS%OBC%update_OBC) then - call update_OBC_data(CS%OBC, G, GV, tv, h, CS%update_OBC_CSp, Time_local) + call update_OBC_data(CS%OBC, G, GV, US, tv, h, CS%update_OBC_CSp, Time_local) endif; endif if (associated(CS%OBC)) then call open_boundary_zero_normal_flow(CS%OBC, G, CS%PFu, CS%PFv) @@ -407,7 +409,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! upp <- upp + dt/2 d/dz visc d/dz upp call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(upp, vpp, hp, forces, visc, dt*0.5, G, GV, & + call vertvisc_coef(upp, vpp, hp, forces, visc, dt*0.5, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(upp, vpp, hp, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & G, GV, CS%vertvisc_CSp, Waves=Waves) @@ -454,12 +456,12 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! PFu = d/dx M(h_av,T,S) call cpu_clock_begin(id_clock_pres) - call PressureForce(h_av, tv, CS%PFu, CS%PFv, G, GV, & + call PressureForce(h_av, tv, CS%PFu, CS%PFv, G, GV, US, & CS%PressureForce_CSp, CS%ALE_CSp, p_surf) call cpu_clock_end(id_clock_pres) if (associated(CS%OBC)) then; if (CS%OBC%update_OBC) then - call update_OBC_data(CS%OBC, G, GV, tv, h, CS%update_OBC_CSp, Time_local) + call update_OBC_data(CS%OBC, G, GV, US, tv, h, CS%update_OBC_CSp, Time_local) endif; endif ! u = u + dt * ( PFu + CAu ) @@ -478,7 +480,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! u <- u + dt d/dz visc d/dz u call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(u, v, h_av, forces, visc, dt, G, GV, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(u, v, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(u, v, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, Waves=Waves) call cpu_clock_end(id_clock_vertvisc) @@ -556,13 +558,13 @@ subroutine register_restarts_dyn_unsplit(HI, GV, param_file, CS, restart_CS) end subroutine register_restarts_dyn_unsplit !> Initialize parameters and allocate memory associated with the unsplit dynamics module. -subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, param_file, diag, CS, & +subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS, & restart_CS, Accel_diag, Cont_diag, MIS, & OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & visc, dirs, ntrunc) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid - !! structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(inout) :: u !< The zonal velocity, in m s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -654,7 +656,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, param_file, diag, CS, & call PressureForce_init(Time, G, GV, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) call hor_visc_init(Time, G, param_file, diag, CS%hor_visc_CSp) - call vertvisc_init(MIS, Time, G, GV, param_file, diag, CS%ADp, dirs, & + call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & "initialize_dyn_unsplit called with setVisc_CSp unassociated.") diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 3a5db102f2..b917592a1d 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -89,6 +89,7 @@ module MOM_dynamics_unsplit_RK2 use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_ML, set_visc_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS +use MOM_unit_scaling, only : unit_scale_type use MOM_vert_friction, only : vertvisc, vertvisc_coef use MOM_vert_friction, only : vertvisc_limit_vel, vertvisc_init, vertvisc_CS use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units @@ -182,11 +183,11 @@ module MOM_dynamics_unsplit_RK2 !> Step the MOM6 dynamics using an unsplit quasi-2nd order Runge-Kutta scheme subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, forces, & - p_surf_begin, p_surf_end, uh, vh, uhtr, vhtr, eta_av, G, GV, CS, & + p_surf_begin, p_surf_end, uh, vh, uhtr, vhtr, eta_av, G, GV, US, CS, & VarMix, MEKE) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid - !! structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u_in !< The input and output zonal !! velocity, in m s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v_in !< The input and output meridional @@ -303,14 +304,14 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, if (dyn_p_surf) then ; do j=js-2,je+2 ; do i=is-2,ie+2 p_surf(i,j) = 0.5*p_surf_begin(i,j) + 0.5*p_surf_end(i,j) enddo ; enddo ; endif - call PressureForce(h_in, tv, CS%PFu, CS%PFv, G, GV, & + call PressureForce(h_in, tv, CS%PFu, CS%PFv, G, GV, US, & CS%PressureForce_CSp, CS%ALE_CSp, p_surf) call cpu_clock_end(id_clock_pres) call pass_vector(CS%PFu, CS%PFv, G%Domain, clock=id_clock_pass) call pass_vector(CS%CAu, CS%CAv, G%Domain, clock=id_clock_pass) if (associated(CS%OBC)) then; if (CS%OBC%update_OBC) then - call update_OBC_data(CS%OBC, G, GV, tv, h_in, CS%update_OBC_CSp, Time_local) + call update_OBC_data(CS%OBC, G, GV, US, tv, h_in, CS%update_OBC_CSp, Time_local) endif; endif if (associated(CS%OBC)) then call open_boundary_zero_normal_flow(CS%OBC, G, CS%PFu, CS%PFv) @@ -337,10 +338,10 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up[n-1/2] <- up*[n-1/2] + dt/2 d/dz visc d/dz up[n-1/2] call cpu_clock_begin(id_clock_vertvisc) call enable_averaging(dt, Time_local, CS%diag) - call set_viscous_ML(up, vp, h_av, tv, forces, visc, dt_pred, G, GV, & + call set_viscous_ML(up, vp, h_av, tv, forces, visc, dt_pred, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) - call vertvisc_coef(up, vp, h_av, forces, visc, dt_pred, G, GV, & + call vertvisc_coef(up, vp, h_av, forces, visc, dt_pred, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(up, vp, h_av, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, & G, GV, CS%vertvisc_CSp) @@ -393,11 +394,11 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up[n] <- up* + dt d/dz visc d/dz up ! u[n] <- u*[n] + dt d/dz visc d/dz u[n] call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(up, vp, h_av, forces, visc, dt, G, GV, & + call vertvisc_coef(up, vp, h_av, forces, visc, dt, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(up, vp, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) - call vertvisc_coef(u_in, v_in, h_av, forces, visc, dt, G, GV, & + call vertvisc_coef(u_in, v_in, h_av, forces, visc, dt, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(u_in, v_in, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp,& G, GV, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) @@ -503,13 +504,13 @@ subroutine register_restarts_dyn_unsplit_RK2(HI, GV, param_file, CS, restart_CS) end subroutine register_restarts_dyn_unsplit_RK2 !> Initialize parameters and allocate memory associated with the unsplit RK2 dynamics module. -subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, param_file, diag, CS, & +subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag, CS, & restart_CS, Accel_diag, Cont_diag, MIS, & OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & visc, dirs, ntrunc) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid - !! structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity, in m s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity, !! in m s-1. @@ -616,7 +617,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, param_file, diag, CS call PressureForce_init(Time, G, GV, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) call hor_visc_init(Time, G, param_file, diag, CS%hor_visc_CSp) - call vertvisc_init(MIS, Time, G, GV, param_file, diag, CS%ADp, dirs, & + call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & "initialize_dyn_unsplit_RK2 called with setVisc_CSp unassociated.") diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index d41bac42c5..843e6cb844 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -13,6 +13,7 @@ module MOM_forcing_type use MOM_grid, only : ocean_grid_type use MOM_shortwave_abs, only : sumSWoverBands, optics_type use MOM_spatial_means, only : global_area_integral, global_area_mean +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -817,10 +818,11 @@ end subroutine extractFluxes2d !! These are actual fluxes, with units of stuff per time. Setting dt=1 in the call to !! extractFluxes routine allows us to get "stuf per time" rather than the time integrated !! fluxes needed in other routines that call extractFluxes. -subroutine calculateBuoyancyFlux1d(G, GV, fluxes, optics, h, Temp, Salt, tv, j, & +subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, j, & buoyancyFlux, netHeatMinusSW, netSalt, skip_diags) type(ocean_grid_type), intent(in) :: G !< ocean grid type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(forcing), intent(inout) :: fluxes !< surface fluxes type(optics_type), pointer :: optics !< penetrating SW optics real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness (H) @@ -858,7 +860,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, fluxes, optics, h, Temp, Salt, tv, j, depthBeforeScalingFluxes = max( GV%Angstrom_H, 1.e-30*GV%m_to_H ) pressure(:) = 0. ! Ignore atmospheric pressure - GoRho = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 + GoRho = (GV%g_Earth*US%m_to_Z) / GV%Rho0 start = 1 + G%isc - G%isd npts = 1 + G%iec - G%isc @@ -906,16 +908,17 @@ end subroutine calculateBuoyancyFlux1d !> Calculates surface buoyancy flux by adding up the heat, FW and salt fluxes, !! for 2d arrays. This is a wrapper for calculateBuoyancyFlux1d. -subroutine calculateBuoyancyFlux2d(G, GV, fluxes, optics, h, Temp, Salt, tv, & +subroutine calculateBuoyancyFlux2d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, & buoyancyFlux, netHeatMinusSW, netSalt, skip_diags) - type(ocean_grid_type), intent(in) :: G !< ocean grid - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(forcing), intent(inout) :: fluxes !< surface fluxes - type(optics_type), pointer :: optics !< SW ocean optics - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness (H) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< temperature (deg C) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< salinity (ppt) - type(thermo_var_ptrs), intent(inout) :: tv !< thermodynamics type + type(ocean_grid_type), intent(in) :: G !< ocean grid + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(forcing), intent(inout) :: fluxes !< surface fluxes + type(optics_type), pointer :: optics !< SW ocean optics + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness (H) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< temperature (deg C) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< salinity (ppt) + type(thermo_var_ptrs), intent(inout) :: tv !< thermodynamics type real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoy flux (m^2/s^3) real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netHeatMinusSW !< surf temp flux (K H) real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netSalt !< surf salt flux (ppt H) @@ -932,7 +935,7 @@ subroutine calculateBuoyancyFlux2d(G, GV, fluxes, optics, h, Temp, Salt, tv, & !$OMP netHeatMinusSW,netSalt,skip_diags) & !$OMP firstprivate(netT,netS) do j = G%jsc, G%jec - call calculateBuoyancyFlux1d(G, GV, fluxes, optics, h, Temp, Salt, tv, j, buoyancyFlux(:,j,:), & + call calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, j, buoyancyFlux(:,j,:), & netT, netS, skip_diags=skip_diags) if (present(netHeatMinusSW)) netHeatMinusSW(G%isc:G%iec,j) = netT(G%isc:G%iec) if (present(netSalt)) netSalt(G%isc:G%iec,j) = netS(G%isc:G%iec) diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index c6c283dfc2..1ed4e8a7e6 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -6,6 +6,7 @@ module MOM_interface_heights use MOM_error_handler, only : MOM_error, FATAL use MOM_file_parser, only : log_version use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : int_specific_vol_dp @@ -27,23 +28,23 @@ module MOM_interface_heights !! form for consistency with the calculation of the pressure gradient forces. !! Additionally, these height may be dilated for consistency with the !! corresponding time-average quantity from the barotropic calculation. -subroutine find_eta_3d(h, tv, G, GV, eta, eta_bt, halo_size, eta_to_m) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical - !! grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H - !! (usually m or kg m-2). - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to - !! various thermodynamic - !! variables. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: eta !< layer interface heights - !! (Z or 1/eta_to_m m). - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic +subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2). + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to + !! various thermodynamic + !! variables. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: eta !< layer interface heights + !! (Z or 1/eta_to_m m). + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic !! variable that gives the "correct" free surface height (Boussinesq) or total water !! column mass per unit area (non-Boussinesq). This is used to dilate the layer. !! thicknesses when calculating interfaceheights, in H (m or kg m-2). integer, optional, intent(in) :: halo_size !< width of halo points on - !! which to calculate eta. + !! which to calculate eta. real, optional, intent(in) :: eta_to_m !< The conversion factor from !! the units of eta to m; by default this is GV%Z_to_m. @@ -67,7 +68,7 @@ subroutine find_eta_3d(h, tv, G, GV, eta, eta_bt, halo_size, eta_to_m) Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = GV%Z_to_m / eta_to_m H_to_eta = GV%H_to_Z * Z_to_eta - H_to_rho_eta = GV%H_to_kg_m2 * (GV%m_to_Z * Z_to_eta) + H_to_rho_eta = GV%H_to_kg_m2 * (US%m_to_Z * Z_to_eta) I_gEarth = Z_to_eta / GV%g_Earth !$OMP parallel default(shared) private(dilate,htot) @@ -142,23 +143,23 @@ end subroutine find_eta_3d !! with the calculation of the pressure gradient forces. Additionally, the sea !! surface height may be adjusted for consistency with the corresponding !! time-average quantity from the barotropic calculation. -subroutine find_eta_2d(h, tv, G, GV, eta, eta_bt, halo_size, eta_to_m) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid - !! structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H - !! (usually m or kg m-2). - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to - !! various thermodynamic - !! variables. - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta !< free surface height - !! relative to mean sea - !! level (z=0) (m). - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic +subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2). + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to + !! various thermodynamic + !! variables. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta !< free surface height + !! relative to mean sea + !! level (z=0) (m). + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic !! variable that gives the "correct" free surface height (Boussinesq) or total !! water column mass per unit area (non-Boussinesq), in H (m or kg m-2). integer, optional, intent(in) :: halo_size !< width of halo points on - !! which to calculate eta. + !! which to calculate eta. real, optional, intent(in) :: eta_to_m !< The conversion factor from !! the units of eta to m; by default this is GV%Z_to_m. ! Local variables @@ -177,7 +178,7 @@ subroutine find_eta_2d(h, tv, G, GV, eta, eta_bt, halo_size, eta_to_m) Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = GV%Z_to_m / eta_to_m H_to_eta = GV%H_to_Z * Z_to_eta - H_to_rho_eta = GV%H_to_kg_m2 * (GV%m_to_Z * Z_to_eta) + H_to_rho_eta = GV%H_to_kg_m2 * (US%m_to_Z * Z_to_eta) I_gEarth = Z_to_eta / GV%g_Earth !$OMP parallel default(shared) private(htot) diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 41b9bef817..70601b25f7 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -4,6 +4,7 @@ module MOM_isopycnal_slopes ! This file is part of MOM6. See LICENSE.md for the license. use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : int_specific_vol_dp, calculate_density_derivs @@ -17,10 +18,11 @@ module MOM_isopycnal_slopes contains !> Calculate isopycnal slopes, and optionally return N2 used in calculation. -subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & +subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & slope_x, slope_y, N2_u, N2_v, halo) !, eta_to_m) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface heights (in Z or units !! given by 1/eta_to_m) @@ -114,7 +116,7 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & present_N2_u = PRESENT(N2_u) present_N2_v = PRESENT(N2_v) - G_Rho0 = (GV%g_Earth*L_to_Z*GV%m_to_Z) / GV%Rho0 + G_Rho0 = (GV%g_Earth*L_to_Z*US%m_to_Z) / GV%Rho0 if (present_N2_u) then do j=js,je ; do I=is-1,ie N2_u(I,j,1) = 0. diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 7b7feadb3c..091a486b48 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -5,6 +5,7 @@ module MOM_verticalGrid use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_unit_scaling, only : unit_scale_type implicit none ; private @@ -64,9 +65,10 @@ module MOM_verticalGrid contains !> Allocates and initializes the ocean model vertical grid structure. -subroutine verticalGridInit( param_file, GV ) +subroutine verticalGridInit( param_file, GV, US ) type(param_file_type), intent(in) :: param_file !< Parameter file handle/type type(verticalGrid_type), pointer :: GV !< The container for vertical grid data + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! This routine initializes the verticalGrid_type structure (GV). ! All memory is allocated but not necessarily set to meaningful values until later. @@ -127,7 +129,6 @@ subroutine verticalGridInit( param_file, GV ) Z_rescale_factor = 1.0 if (Z_power /= 0) Z_rescale_factor = 2.0**Z_power GV%Z_to_m = 1.0 * Z_rescale_factor - GV%m_to_Z = 1.0 / Z_rescale_factor GV%g_Earth = GV%g_Earth * GV%Z_to_m #ifdef STATIC_MEMORY_ ! Here NK_ is a macro, while nk is a variable. @@ -155,11 +156,11 @@ subroutine verticalGridInit( param_file, GV ) GV%Angstrom_H = GV%Angstrom_m*1000.0*GV%kg_m2_to_H endif GV%H_subroundoff = 1e-20 * max(GV%Angstrom_H,GV%m_to_H*1e-17) - GV%H_to_Pa = (GV%g_Earth*GV%m_to_Z) * GV%H_to_kg_m2 + GV%H_to_Pa = (GV%g_Earth*US%m_to_Z) * GV%H_to_kg_m2 - GV%H_to_Z = GV%H_to_m * GV%m_to_Z + GV%H_to_Z = GV%H_to_m * US%m_to_Z GV%Z_to_H = GV%Z_to_m * GV%m_to_H - GV%Angstrom_Z = GV%m_to_Z * GV%Angstrom_m + GV%Angstrom_Z = US%m_to_Z * GV%Angstrom_m ! Log derivative values. call log_param(param_file, mdl, "M to THICKNESS", GV%m_to_H*H_rescale_factor) @@ -178,7 +179,6 @@ end subroutine verticalGridInit subroutine fix_restart_scaling(GV) type(verticalGrid_type), intent(inout) :: GV !< The ocean's vertical grid structure - GV%m_to_Z_restart = GV%m_to_Z GV%m_to_H_restart = GV%m_to_H end subroutine fix_restart_scaling diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index ca81bcdd7e..5cceda7e3b 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -6,17 +6,18 @@ module MOM_diag_to_Z ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_domains, only : pass_var use MOM_coms, only : reproducing_sum use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl, time_type, diag_axis_init use MOM_diag_mediator, only : axes_grp, define_axes_group use MOM_diag_mediator, only : ocean_register_diag +use MOM_domains, only : pass_var use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_io, only : slasher, vardesc, query_vardesc, modify_vardesc use MOM_spatial_means, only : global_layer_mean +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : p3d, p2d use MOM_verticalGrid, only : verticalGrid_type @@ -138,9 +139,10 @@ function global_z_mean(var, G, GV, CS, tracer) end function global_z_mean !> This subroutine maps tracers and velocities into depth space for diagnostics. -subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) +subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< The zonal velocity, in m s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -202,7 +204,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) ! Update the halos if (ice_shelf) then - do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ; ssh(i,j) = GV%m_to_Z*ssh_in(i,j) ; enddo ; enddo + do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ; ssh(i,j) = US%m_to_Z*ssh_in(i,j) ; enddo ; enddo call pass_var(ssh, G%Domain) endif @@ -242,8 +244,8 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) h_f(k2,I) = Angstrom ; u_f(k2,I) = 0.0 ! GM: D_pt is always slightly larger (by 1E-6 or so) than shelf_depth, so ! I consider that the ice shelf is grounded for diagnostic purposes when - ! shelf_depth(I) + 1.0E-3*GV%m_to_Z > D_pt(i) - if (ice_shelf .and. (shelf_depth(I) + 1.0E-3*GV%m_to_Z > D_pt(i))) nk_valid(I)=0 + ! shelf_depth(I) + 1.0E-3*US%m_to_Z > D_pt(i) + if (ice_shelf .and. (shelf_depth(I) + 1.0E-3*US%m_to_Z > D_pt(i))) nk_valid(I)=0 endif ; enddo @@ -337,7 +339,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) ! no-slip BBC in the output, if anything but piecewise constant is used. nk_valid(i) = nk_valid(i) + 1 ; k2 = nk_valid(i) h_f(k2,i) = Angstrom ; v_f(k2,i) = 0.0 - if (ice_shelf .and. shelf_depth(i) + 1.0E-3*GV%m_to_Z > D_pt(i)) nk_valid(I)=0 + if (ice_shelf .and. shelf_depth(i) + 1.0E-3*US%m_to_Z > D_pt(i)) nk_valid(I)=0 endif ; enddo do i=is,ie ; if (nk_valid(i) > 0) then @@ -422,7 +424,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) if ((G%mask2dT(i,j) > 0.5) .and. (h(i,j,k) > 2.0*Angstrom)) then nk_valid(i) = nk_valid(i) + 1 ; k2 = nk_valid(i) h_f(k2,i) = h(i,j,k) - if (ice_shelf .and. shelf_depth(I) + 1.0E-3*GV%m_to_Z > D_pt(i)) nk_valid(I)=0 + if (ice_shelf .and. shelf_depth(I) + 1.0E-3*US%m_to_Z > D_pt(i)) nk_valid(I)=0 do m=1,CS%num_tr_used ; tr_f(k2,m,i) = CS%tr_model(m)%p(i,j,k) ; enddo endif enddo ; enddo @@ -953,10 +955,11 @@ subroutine register_Z_tracer_low(tr_ptr, name, long_name, units, standard_name, end subroutine register_Z_tracer_low !> This subroutine sets parameters that control Z-space diagnostic output. -subroutine MOM_diag_to_Z_init(Time, G, GV, param_file, diag, CS) +subroutine MOM_diag_to_Z_init(Time, G, GV, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< Current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(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 !< Struct to regulate diagnostic output. type(diag_to_Z_CS), pointer :: CS !< Pointer to point to control structure for @@ -999,7 +1002,7 @@ subroutine MOM_diag_to_Z_init(Time, G, GV, param_file, diag, CS) in_dir = slasher(in_dir) call get_Z_depths(trim(in_dir)//trim(zgrid_file), "zw", CS%Z_int, "zt", & z_axis, zint_axis, CS%nk_zspace) - do K=1,CS%nk_zspace+1 ; CS%Z_int(K) = GV%m_to_Z*CS%Z_int(K) ; enddo + do K=1,CS%nk_zspace+1 ; CS%Z_int(K) = US%m_to_Z*CS%Z_int(K) ; enddo call log_param(param_file, mdl, "!INPUTDIR/Z_OUTPUT_GRID_FILE", & trim(in_dir)//trim(zgrid_file)) call log_param(param_file, mdl, "!NK_ZSPACE (from file)", CS%nk_zspace, & diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 98daea3be5..36ccf1425e 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -25,6 +25,7 @@ module MOM_diagnostics use MOM_spatial_means, only : global_area_mean, global_layer_mean use MOM_spatial_means, only : global_volume_mean, global_area_integral use MOM_tracer_registry, only : tracer_registry_type, post_tracer_transport_diagnostics +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, ocean_internal_state, p3d use MOM_variables, only : accel_diag_ptrs, cont_diag_ptrs, surface use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units @@ -179,9 +180,10 @@ module MOM_diagnostics contains !> Diagnostics not more naturally calculated elsewhere are computed here. subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & - dt, diag_pre_sync, G, GV, CS, eta_bt) + dt, diag_pre_sync, G, GV, US, CS, eta_bt) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< The zonal velocity, in m s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -284,7 +286,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_h > 0) call post_data(CS%id_h, h, CS%diag) if (associated(CS%e)) then - call find_eta(h, tv, G, GV, CS%e, eta_bt) + call find_eta(h, tv, G, GV, US, CS%e, eta_bt) if (CS%id_e > 0) call post_data(CS%id_e, CS%e, CS%diag) endif @@ -294,7 +296,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & CS%e_D(i,j,k) = CS%e(i,j,k) + G%bathyT(i,j) enddo ; enddo ; enddo else - call find_eta(h, tv, G, GV, CS%e_D, eta_bt) + call find_eta(h, tv, G, GV, US, CS%e_D, eta_bt) do k=1,nz+1 ; do j=js,je ; do i=is,ie CS%e_D(i,j,k) = CS%e_D(i,j,k) + G%bathyT(i,j) enddo ; enddo ; enddo @@ -450,7 +452,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & call post_data(CS%id_salt_layer_ave, salt_layer_ave, CS%diag) endif - call calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) + call calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) if ((CS%id_Rml > 0) .or. (CS%id_Rcv > 0) .or. associated(CS%h_Rlay) .or. & associated(CS%uh_Rlay) .or. associated(CS%vh_Rlay) .or. & @@ -614,7 +616,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if ((CS%id_cg1>0) .or. (CS%id_Rd1>0) .or. (CS%id_cfl_cg1>0) .or. & (CS%id_cfl_cg1_x>0) .or. (CS%id_cfl_cg1_y>0)) then - call wave_speed(h, tv, G, GV, CS%cg1, CS%wave_speed_CSp) + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp) if (CS%id_cg1>0) call post_data(CS%id_cg1, CS%cg1, CS%diag) if (CS%id_Rd1>0) then !$OMP parallel do default(none) shared(is,ie,js,je,G,CS) & @@ -655,12 +657,12 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif if ((CS%id_cg_ebt>0) .or. (CS%id_Rd_ebt>0) .or. (CS%id_p_ebt>0)) then if (CS%id_p_ebt>0) then - call wave_speed(h, tv, G, GV, CS%cg1, CS%wave_speed_CSp, use_ebt_mode=.true., & + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, use_ebt_mode=.true., & mono_N2_column_fraction=CS%mono_N2_column_fraction, & mono_N2_depth=CS%mono_N2_depth, modal_structure=CS%p_ebt) call post_data(CS%id_p_ebt, CS%p_ebt, CS%diag) else - call wave_speed(h, tv, G, GV, CS%cg1, CS%wave_speed_CSp, use_ebt_mode=.true., & + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, use_ebt_mode=.true., & mono_N2_column_fraction=CS%mono_N2_column_fraction, & mono_N2_depth=CS%mono_N2_depth) endif @@ -758,9 +760,10 @@ end subroutine find_weights !> This subroutine calculates vertical integrals of several tracers, along !! with the mass-weight of these tracers, the total column mass, and the !! carefully calculated column height. -subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) +subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various @@ -815,7 +818,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) endif if (CS%id_col_ht > 0) then - call find_eta(h, tv, G, GV, z_top) + call find_eta(h, tv, G, GV, US, z_top) do j=js,je ; do i=is,ie z_bot(i,j) = z_top(i,j) + G%bathyT(i,j) enddo ; enddo @@ -826,7 +829,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) do j=js,je ; do i=is,ie ; mass(i,j) = 0.0 ; enddo ; enddo if (GV%Boussinesq) then if (associated(tv%eqn_of_state)) then - IG_Earth = 1.0 / (GV%g_Earth*GV%m_to_Z) + IG_Earth = 1.0 / (GV%g_Earth*US%m_to_Z) ! do j=js,je ; do i=is,ie ; z_bot(i,j) = -P_SURF(i,j)/GV%H_to_Pa ; enddo ; enddo do j=js,je ; do i=is,ie ; z_bot(i,j) = 0.0 ; enddo ; enddo do k=1,nz @@ -860,7 +863,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, CS) ! pbo = (mass * g) + p_surf ! where p_surf is the sea water pressure at sea water surface. do j=js,je ; do i=is,ie - btm_pres(i,j) = mass(i,j) * (GV%g_Earth*GV%m_to_Z) + btm_pres(i,j) = mass(i,j) * (GV%g_Earth*US%m_to_Z) if (associated(p_surf)) then btm_pres(i,j) = btm_pres(i,j) + p_surf(i,j) endif diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index a902ad67ec..955c33b129 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -21,6 +21,7 @@ module MOM_sum_output use MOM_time_manager, only : operator(/=), operator(<=), operator(>=), operator(<) use MOM_time_manager, only : get_calendar_type, time_type_to_real, NO_CALENDAR use MOM_tracer_flow_control, only : tracer_flow_control_CS, call_tracer_stocks +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -266,9 +267,10 @@ end subroutine MOM_sum_output_end !> This subroutine calculates and writes the total model energy, the energy and !! mass of each layer, and other globally integrated physical quantities. -subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forcing) +subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_forcing) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< The zonal velocity, in m s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -495,7 +497,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc enddo ; enddo ; enddo mass_tot = reproducing_sum(tmp1, sums=mass_lay, EFP_sum=mass_EFP) - call find_eta(h, tv, G, GV, eta) + call find_eta(h, tv, G, GV, US, eta) do k=1,nz ; do j=js,je ; do i=is,ie tmp1(i,j,k) = (eta(i,j,K)-eta(i,j,K+1)) * areaTm(i,j) enddo ; enddo ; enddo @@ -505,7 +507,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc tmp1(i,j,k) = H_to_kg_m2 * h(i,j,k) * areaTm(i,j) enddo ; enddo ; enddo mass_tot = reproducing_sum(tmp1, sums=mass_lay, EFP_sum=mass_EFP) - do k=1,nz ; vol_lay(k) = GV%m_to_Z * (mass_lay(k) / GV%Rho0) ; enddo + do k=1,nz ; vol_lay(k) = US%m_to_Z * (mass_lay(k) / GV%Rho0) ; enddo endif endif ! Boussinesq diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index e8d58e502b..c84ad8a798 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -7,9 +7,10 @@ module MOM_wave_speed use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : log_version use MOM_grid, only : ocean_grid_type +use MOM_remapping, only : remapping_CS, initialize_remapping, remapping_core_h +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use MOM_remapping, only : remapping_CS, initialize_remapping, remapping_core_h use MOM_EOS, only : calculate_density, calculate_density_derivs implicit none ; private @@ -40,10 +41,11 @@ module MOM_wave_speed contains !> Calculates the wave speed of the first baroclinic mode. -subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & +subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & mono_N2_column_fraction, mono_N2_depth, modal_structure) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thickness in units of H (m or kg/m2) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables @@ -109,14 +111,14 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed endif ; endif - L2_to_Z2 = GV%m_to_Z**2 + L2_to_Z2 = US%m_to_Z**2 l_use_ebt_mode = CS%use_ebt_mode if (present(use_ebt_mode)) l_use_ebt_mode = use_ebt_mode l_mono_N2_column_fraction = CS%mono_N2_column_fraction if (present(mono_N2_column_fraction)) l_mono_N2_column_fraction = mono_N2_column_fraction - l_mono_N2_depth = GV%m_to_Z*CS%mono_N2_depth - if (present(mono_N2_depth)) l_mono_N2_depth = GV%m_to_Z*mono_N2_depth + l_mono_N2_depth = US%m_to_Z*CS%mono_N2_depth + if (present(mono_N2_depth)) l_mono_N2_depth = US%m_to_Z*mono_N2_depth calc_modal_structure = l_use_ebt_mode if (present(modal_structure)) calc_modal_structure = .true. if (calc_modal_structure) then @@ -512,9 +514,10 @@ subroutine tdma6(n, a, b, c, lam, y) end subroutine tdma6 !> Calculates the wave speeds for the first few barolinic modes. -subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) +subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg/m2) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables integer, intent(in) :: nmodes !< Number of modes @@ -790,7 +793,7 @@ subroutine wave_speeds(h, tv, G, GV, nmodes, cn, CS, full_halos) do K=2,kc Igl(K) = 1.0/(gprime(K)*Hc(k)) ; Igu(K) = 1.0/(gprime(K)*Hc(k-1)) z_int(K) = z_int(K-1) + Hc(k-1) - N2(K) = GV%m_to_Z**2*gprime(K)/(0.5*(Hc(k)+Hc(k-1))) + N2(K) = US%m_to_Z**2*gprime(K)/(0.5*(Hc(k)+Hc(k-1))) speed2_tot = speed2_tot + gprime(K)*(Hc(k-1)+Hc(k)) enddo ! Set stratification for surface and bottom (setting equal to nearest interface for now) diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 735690eb81..0f1a7eecc7 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -17,6 +17,7 @@ module MOM_wave_structure use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : log_version, param_file_type, get_param use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -82,28 +83,28 @@ module MOM_wave_structure !! For n=1,2,3,... !! Solve (A-lam*I)e = e_guess for e !! Set e_guess=e/|e| and repeat, with each iteration refining the estimate of e -subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid - !! structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H - !! (usually m or kg m-2). - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various - !! thermodynamic variables. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: cn !< The (non-rotational) mode - !! internal gravity wave speed, - !! in m s-1. +subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halos) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2). + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: cn !< The (non-rotational) mode + !! internal gravity wave speed, + !! in m s-1. integer, intent(in) :: ModeNum !< Mode number real, intent(in) :: freq !< Intrinsic wave frequency, in s-1. - type(wave_structure_CS), pointer :: CS !< The control structure returned - !! by a previous call to - !! wave_structure_init. + type(wave_structure_CS), pointer :: CS !< The control structure returned + !! by a previous call to + !! wave_structure_init. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(in) :: En !< Internal wave energy density, - !! in Jm-2. + optional, intent(in) :: En !< Internal wave energy density, + !! in Jm-2. logical,optional, intent(in) :: full_halos !< If true, do the calculation - !! over the entire computational - !! domain. + !! over the entire computational + !! domain. ! Local variables real, dimension(SZK_(G)+1) :: & dRho_dT, dRho_dS, & @@ -367,7 +368,7 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) do K=2,kc Igl(K) = 1.0/(gprime(K)*Hc(k)) ; Igu(K) = 1.0/(gprime(K)*Hc(k-1)) z_int(K) = z_int(K-1) + Hc(k-1) - N2(K) = GV%m_to_Z**2*gprime(K)/(0.5*(Hc(k)+Hc(k-1))) + N2(K) = US%m_to_Z**2*gprime(K)/(0.5*(Hc(k)+Hc(k-1))) enddo ! Set stratification for surface and bottom (setting equal to nearest interface for now) N2(1) = N2(2) ; N2(kc+1) = N2(kc) @@ -388,7 +389,7 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) ! Frist, populate interior rows do K=3,kc-1 row = K-1 ! indexing for TD matrix rows - gp_unscaled = GV%m_to_Z*gprime(K) + gp_unscaled = US%m_to_Z*gprime(K) lam_z(row) = lam*gp_unscaled a_diag(row) = gp_unscaled*(-Igu(K)) b_diag(row) = gp_unscaled*(Igu(K)+Igl(K)) - lam_z(row) @@ -400,14 +401,14 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) enddo ! Populate top row of tridiagonal matrix K=2 ; row = K-1 ; - gp_unscaled = GV%m_to_Z*gprime(K) + gp_unscaled = US%m_to_Z*gprime(K) lam_z(row) = lam*gp_unscaled a_diag(row) = 0.0 b_diag(row) = gp_unscaled*(Igu(K)+Igl(K)) - lam_z(row) c_diag(row) = gp_unscaled*(-Igl(K)) ! Populate bottom row of tridiagonal matrix K=kc ; row = K-1 - gp_unscaled = GV%m_to_Z*gprime(K) + gp_unscaled = US%m_to_Z*gprime(K) lam_z(row) = lam*gp_unscaled a_diag(row) = gp_unscaled*(-Igu(K)) b_diag(row) = gp_unscaled*(Igu(K)+Igl(K)) - lam_z(row) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 8fd9874a3a..117adb512e 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -15,6 +15,7 @@ module MOM_diag_mediator use MOM_safe_alloc, only : safe_alloc_ptr, safe_alloc_alloc use MOM_string_functions, only : lowercase use MOM_time_manager, only : time_type +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : EOS_type use MOM_diag_remap, only : diag_remap_ctrl @@ -240,12 +241,13 @@ module MOM_diag_mediator contains !> Sets up diagnostics axes -subroutine set_axes_info(G, GV, param_file, diag_cs, set_vertical) - type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(diag_ctrl), intent(inout) :: diag_cs !< Diagnostics control structure - logical, optional, intent(in) :: set_vertical !< If true or missing, set up +subroutine set_axes_info(G, GV, US, param_file, diag_cs, set_vertical) + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(diag_ctrl), intent(inout) :: diag_cs !< Diagnostics control structure + logical, optional, intent(in) :: set_vertical !< If true or missing, set up !! vertical axes ! Local variables integer :: id_xq, id_yq, id_zl, id_zi, id_xh, id_yh @@ -347,7 +349,7 @@ subroutine set_axes_info(G, GV, param_file, diag_cs, set_vertical) do i=1, diag_cs%num_diag_coords ! For each possible diagnostic coordinate - call diag_remap_configure_axes(diag_cs%diag_remap_cs(i), GV, param_file) + call diag_remap_configure_axes(diag_cs%diag_remap_cs(i), GV, US, param_file) ! This vertical coordinate has been configured so can be used. if (diag_remap_axes_configured(diag_cs%diag_remap_cs(i))) then diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 4cb122b38e..748c09ba0c 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -26,6 +26,7 @@ module MOM_diag_remap use MOM_io, only : file_exists, field_size use MOM_string_functions, only : lowercase, extractWord use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : EOS_type use MOM_remapping, only : remapping_CS, initialize_remapping @@ -136,10 +137,11 @@ end subroutine diag_remap_set_active !> Configure the vertical axes for a diagnostic remapping control structure. !! Reads a configuration parameters to determine coordinate generation. -subroutine diag_remap_configure_axes(remap_cs, GV, param_file) +subroutine diag_remap_configure_axes(remap_cs, GV, US, param_file) type(diag_remap_ctrl), intent(inout) :: remap_cs !< Diag remap control structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< Parameter file structure ! Local variables integer :: nzi(4), nzl(4), k character(len=200) :: inputdir, string, filename, int_varname, layer_varname @@ -152,7 +154,7 @@ subroutine diag_remap_configure_axes(remap_cs, GV, param_file) real, allocatable, dimension(:) :: interfaces, layers - call initialize_regridding(remap_cs%regrid_cs, GV, GV%max_depth, param_file, mod, & + call initialize_regridding(remap_cs%regrid_cs, GV, US, GV%max_depth, param_file, mod, & trim(remap_cs%vertical_coord_name), "DIAG_COORD", trim(remap_cs%diag_coord_name)) call set_regrid_params(remap_cs%regrid_cs, min_thickness=0., integrate_downward_for_e=.false.) diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 7126548402..656557ae9c 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -13,6 +13,7 @@ module MOM_coord_initialization use MOM_io, only : open_file, MOM_read_data, read_axis_data, SINGLE_FILE, MULTIPLE use MOM_io, only : slasher, vardesc, write_field, var_desc use MOM_string_functions, only : uppercase +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type, setVerticalGridAxes use user_initialization, only : user_set_coord @@ -30,8 +31,9 @@ module MOM_coord_initialization !> MOM_initialize_coord sets up time-invariant quantities related to MOM6's !! vertical coordinate. -subroutine MOM_initialize_coord(GV, PF, write_geom, output_dir, tv, max_depth) +subroutine MOM_initialize_coord(GV, US, PF, write_geom, output_dir, tv, max_depth) type(verticalGrid_type), intent(inout) :: GV !< Ocean vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: PF !< A structure indicating the open file !! to parse for model parameter values. logical, intent(in) :: write_geom !< If true, write grid geometry files. @@ -76,30 +78,30 @@ subroutine MOM_initialize_coord(GV, PF, write_geom, output_dir, tv, max_depth) fail_if_missing=.true.) select case ( trim(config) ) case ("gprime") - call set_coord_from_gprime(GV%Rlay, GV%g_prime, GV, PF) + call set_coord_from_gprime(GV%Rlay, GV%g_prime, GV, US, PF) case ("layer_ref") - call set_coord_from_layer_density(GV%Rlay, GV%g_prime, GV, PF) + call set_coord_from_layer_density(GV%Rlay, GV%g_prime, GV, US, PF) case ("linear") - call set_coord_linear(GV%Rlay, GV%g_prime, GV, PF) + call set_coord_linear(GV%Rlay, GV%g_prime, GV, US, PF) case ("ts_ref") - call set_coord_from_ts_ref(GV%Rlay, GV%g_prime, GV, PF, eos, tv%P_Ref) + call set_coord_from_ts_ref(GV%Rlay, GV%g_prime, GV, US, PF, eos, tv%P_Ref) case ("ts_profile") - call set_coord_from_TS_profile(GV%Rlay, GV%g_prime, GV, PF, eos, tv%P_Ref) + call set_coord_from_TS_profile(GV%Rlay, GV%g_prime, GV, US, PF, eos, tv%P_Ref) case ("ts_range") - call set_coord_from_TS_range(GV%Rlay, GV%g_prime, GV, PF, eos, tv%P_Ref) + call set_coord_from_TS_range(GV%Rlay, GV%g_prime, GV, US, PF, eos, tv%P_Ref) case ("file") - call set_coord_from_file(GV%Rlay, GV%g_prime, GV, PF) + call set_coord_from_file(GV%Rlay, GV%g_prime, GV, US, PF) case ("USER") call user_set_coord(GV%Rlay, GV%g_prime, GV, PF, eos) case ("BFB") call BFB_set_coord(GV%Rlay, GV%g_prime, GV, PF, eos) case ("none", "ALE") - call set_coord_to_none(GV%Rlay, GV%g_prime, GV, PF) + call set_coord_to_none(GV%Rlay, GV%g_prime, GV, US, PF) case default ; call MOM_error(FATAL,"MOM_initialize_coord: "// & "Unrecognized coordinate setup"//trim(config)) end select if (debug) call chksum(GV%Rlay, "MOM_initialize_coord: Rlay ", 1, nz) - if (debug) call chksum(GV%m_to_Z*GV%g_prime(:), "MOM_initialize_coord: g_prime ", 1, nz) + if (debug) call chksum(US%m_to_Z*GV%g_prime(:), "MOM_initialize_coord: g_prime ", 1, nz) call setVerticalGridAxes( GV%Rlay, GV ) ! Copy the maximum depth across from the input argument @@ -115,12 +117,13 @@ end subroutine MOM_initialize_coord ! The set_coord routines deal with initializing aspects of the vertical grid. !> Sets the layer densities (Rlay) and the interface reduced gravities (g). -subroutine set_coord_from_gprime(Rlay, g_prime, GV, param_file) +subroutine set_coord_from_gprime(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables real :: g_int ! Reduced gravities across the internal interfaces, in m s-2. @@ -133,7 +136,7 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) + default=(GV%g_Earth*US%m_to_Z), scale=GV%Z_to_m) call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & units="m s-2", fail_if_missing=.true., scale=GV%Z_to_m) @@ -148,12 +151,13 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, param_file) end subroutine set_coord_from_gprime !> Sets the layer densities (Rlay) and the interface reduced gravities (g). -subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file) +subroutine set_coord_from_layer_density(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables real :: g_fs ! Reduced gravity across the free surface, in m s-2. @@ -167,7 +171,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) + default=(GV%g_Earth*US%m_to_Z), scale=GV%Z_to_m) call get_param(param_file, mdl, "LIGHTEST_DENSITY", Rlay_Ref, & "The reference potential density used for layer 1.", & units="kg m-3", default=GV%Rho0) @@ -189,13 +193,14 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file) end subroutine set_coord_from_layer_density !> Sets the layer densities (Rlay) and the interface reduced gravities (g) from a profile of g'. -subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, param_file, eqn_of_state, & +subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state, & P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters type(EOS_type), pointer :: eqn_of_state !< integer selecting the equation of state. @@ -219,7 +224,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, param_file, eqn_of_state, & "The initial salinities.", units="PSU", default=35.0) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) + default=(GV%g_Earth*US%m_to_Z), scale=GV%Z_to_m) call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & units="m s-2", fail_if_missing=.true., scale=GV%Z_to_m) @@ -240,13 +245,14 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, param_file, eqn_of_state, & end subroutine set_coord_from_TS_ref !> Sets the layer densities (Rlay) and the interface reduced gravities (g) from a T-S profile. -subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, & +subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, & eqn_of_state, P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters type(EOS_type), pointer :: eqn_of_state !< integer that selects equation of state. @@ -264,7 +270,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, & call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) + default=(GV%g_Earth*US%m_to_Z), scale=GV%Z_to_m) call get_param(param_file, mdl, "COORD_FILE", coord_file, & "The file from which the coordinate temperatures and \n"//& "salinities are read.", fail_if_missing=.true.) @@ -288,13 +294,14 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, & end subroutine set_coord_from_TS_profile !> Sets the layer densities (Rlay) and the interface reduced gravities (g) from a linear T-S profile. -subroutine set_coord_from_TS_range(Rlay, g_prime, GV, param_file, & +subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, & eqn_of_state, P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters type(EOS_type), pointer :: eqn_of_state !< integer that selects equation of state @@ -343,7 +350,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, param_file, & call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) + default=(GV%g_Earth*US%m_to_Z), scale=GV%Z_to_m) k_light = GV%nk_rho_varies + 1 @@ -370,12 +377,13 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, param_file, & end subroutine set_coord_from_TS_range ! Sets the layer densities (Rlay) and the interface reduced gravities (g) from data in file. -subroutine set_coord_from_file(Rlay, g_prime, GV, param_file) +subroutine set_coord_from_file(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables real :: g_fs ! Reduced gravity across the free surface, in m s-2. @@ -389,7 +397,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) + default=(GV%g_Earth*US%m_to_Z), scale=GV%Z_to_m) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call get_param(param_file, mdl, "COORD_FILE", coord_file, & @@ -420,12 +428,13 @@ end subroutine set_coord_from_file !! reference surface layer density and spanning a range of densities !! to the bottom defined by the parameter RLAY_RANGE !! (defaulting to 2.0 if not defined) -subroutine set_coord_linear(Rlay, g_prime, GV, param_file) +subroutine set_coord_linear(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces !! in m2 Z-1 s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables character(len=40) :: mdl = "set_coord_linear" ! This subroutine @@ -443,7 +452,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, param_file) "all interfaces.", units="kg m-3", default=2.0) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) + default=(GV%g_Earth*US%m_to_Z), scale=GV%Z_to_m) ! This following sets the target layer densities such that a the ! surface interface has density Rlay_ref and the bottom @@ -463,12 +472,13 @@ end subroutine set_coord_linear !> Sets Rlay to Rho0 and g_prime to zero except for the free surface. !! This is for use only in ALE mode where Rlay should not be used and g_prime(1) alone !! might be used. -subroutine set_coord_to_none(Rlay, g_prime, GV, param_file) +subroutine set_coord_to_none(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, !! in m s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables real :: g_fs ! Reduced gravity across the free surface, in m s-2. @@ -480,7 +490,7 @@ subroutine set_coord_to_none(Rlay, g_prime, GV, param_file) call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*GV%m_to_Z), scale=GV%Z_to_m) + default=(GV%g_Earth*US%m_to_Z), scale=GV%Z_to_m) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = 0. ; enddo @@ -511,7 +521,7 @@ subroutine write_vertgrid_file(GV, param_file, directory) call create_file(unit, trim(filepath), vars, 2, fields, SINGLE_FILE, GV=GV) call write_field(unit, fields(1), GV%Rlay) - call write_field(unit, fields(2), GV%g_prime) + call write_field(unit, fields(2), GV%g_prime) !### RESCALE THIS? call close_file(unit) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index f6f2ae97b8..e610e2c998 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -36,6 +36,7 @@ module MOM_state_initialization use MOM_string_functions, only : uppercase, lowercase use MOM_time_manager, only : time_type use MOM_tracer_registry, only : tracer_registry_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : setVerticalGridAxes, verticalGrid_type use MOM_ALE, only : pressure_gradient_plm @@ -111,11 +112,12 @@ module MOM_state_initialization !> Initialize temporally evolving fields, either as initial !! conditions or by reading them from a restart (or saves) file. -subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & +subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & restart_CS, ALE_CSp, tracer_Reg, sponge_CSp, & ALE_sponge_CSp, OBC, Time_in) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: u !< The zonal velocity that is being initialized, !! in m s-1 @@ -233,7 +235,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & if (.NOT.use_temperature) call MOM_error(FATAL,"MOM_initialize_state : "//& "use_temperature must be true if INIT_LAYERS_FROM_Z_FILE is true") - call MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params=just_read) + call MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_params=just_read) else ! Initialize thickness, h. @@ -267,9 +269,9 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & fail_if_missing=new_sim, do_not_log=just_read) select case (trim(config)) case ("file") - call initialize_thickness_from_file(h, G, GV, PF, .false., just_read_params=just_read) + call initialize_thickness_from_file(h, G, GV, US, PF, .false., just_read_params=just_read) case ("thickness_file") - call initialize_thickness_from_file(h, G, GV, PF, .true., just_read_params=just_read) + call initialize_thickness_from_file(h, G, GV, US, PF, .true., just_read_params=just_read) case ("coord") if (new_sim .and. useALE) then call ALE_initThicknessToCoord( ALE_CSp, G, GV, h ) @@ -279,35 +281,35 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & endif case ("uniform"); call initialize_thickness_uniform(h, G, GV, PF, & just_read_params=just_read) - case ("list"); call initialize_thickness_list(h, G, GV, PF, & + case ("list"); call initialize_thickness_list(h, G, GV, US, PF, & just_read_params=just_read) case ("DOME"); call DOME_initialize_thickness(h, G, GV, PF, & just_read_params=just_read) - case ("ISOMIP"); call ISOMIP_initialize_thickness(h, G, GV, PF, tv, & + case ("ISOMIP"); call ISOMIP_initialize_thickness(h, G, GV, US, PF, tv, & just_read_params=just_read) - case ("benchmark"); call benchmark_initialize_thickness(h, G, GV, PF, & + case ("benchmark"); call benchmark_initialize_thickness(h, G, GV, US, PF, & tv%eqn_of_state, tv%P_Ref, just_read_params=just_read) - case ("Neverland"); call Neverland_initialize_thickness(h, G, GV, PF, & + case ("Neverland"); call Neverland_initialize_thickness(h, G, GV, US, PF, & tv%eqn_of_state, tv%P_Ref) case ("search"); call initialize_thickness_search case ("circle_obcs"); call circle_obcs_initialize_thickness(h, G, GV, PF, & just_read_params=just_read) - case ("lock_exchange"); call lock_exchange_initialize_thickness(h, G, GV, & + case ("lock_exchange"); call lock_exchange_initialize_thickness(h, G, GV, US, & PF, just_read_params=just_read) - case ("external_gwave"); call external_gwave_initialize_thickness(h, G, GV, & + case ("external_gwave"); call external_gwave_initialize_thickness(h, G, GV, US, & PF, just_read_params=just_read) - case ("DOME2D"); call DOME2d_initialize_thickness(h, G, GV, PF, & + case ("DOME2D"); call DOME2d_initialize_thickness(h, G, GV, US, PF, & just_read_params=just_read) - case ("adjustment2d"); call adjustment_initialize_thickness(h, G, GV, & + case ("adjustment2d"); call adjustment_initialize_thickness(h, G, GV, US, & PF, just_read_params=just_read) - case ("sloshing"); call sloshing_initialize_thickness(h, G, GV, PF, & + case ("sloshing"); call sloshing_initialize_thickness(h, G, GV, US, PF, & just_read_params=just_read) - case ("seamount"); call seamount_initialize_thickness(h, G, GV, PF, & + case ("seamount"); call seamount_initialize_thickness(h, G, GV, US, PF, & just_read_params=just_read) - case ("dumbbell"); call dumbbell_initialize_thickness(h, G, GV, PF, & + case ("dumbbell"); call dumbbell_initialize_thickness(h, G, GV, US, PF, & just_read_params=just_read) - case ("soliton"); call soliton_initialize_thickness(h, G, GV) - case ("phillips"); call Phillips_initialize_thickness(h, G, GV, PF, & + case ("soliton"); call soliton_initialize_thickness(h, G, GV, US) + case ("phillips"); call Phillips_initialize_thickness(h, G, GV, US, PF, & just_read_params=just_read) case ("rossby_front"); call Rossby_front_initialize_thickness(h, G, GV, & PF, just_read_params=just_read) @@ -368,8 +370,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & tv%S, h, G, GV, PF, eos, just_read_params=just_read) case ("rossby_front"); call Rossby_front_initialize_temperature_salinity ( tv%T, & tv%S, h, G, GV, PF, eos, just_read_params=just_read) - case ("SCM_CVMix_tests"); call SCM_CVMix_tests_TS_init (tv%T, & - tv%S, h, G, GV, PF, just_read_params=just_read) + case ("SCM_CVMix_tests"); call SCM_CVMix_tests_TS_init(tv%T, tv%S, h, & + G, GV, US, PF, just_read_params=just_read) case ("dense"); call dense_water_initialize_TS(G, GV, PF, eos, tv%T, tv%S, & h, just_read_params=just_read) case ("USER"); call user_init_temperature_salinity(tv%T, tv%S, G, PF, eos, & @@ -407,7 +409,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & just_read_params=just_read) case ("circular"); call initialize_velocity_circular(u, v, G, PF, & just_read_params=just_read) - case ("phillips"); call Phillips_initialize_velocity(u, v, G, GV, PF, & + case ("phillips"); call Phillips_initialize_velocity(u, v, G, GV, US, PF, & just_read_params=just_read) case ("rossby_front"); call Rossby_front_initialize_velocity(u, v, h, & G, GV, PF, just_read_params=just_read) @@ -433,7 +435,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & if (new_sim .and. convert .and. .not.GV%Boussinesq) & ! Convert thicknesses from geomtric distances to mass-per-unit-area. - call convert_thickness(h, G, GV, tv) + call convert_thickness(h, G, GV, US, tv) ! Remove the mass that would be displaced by an ice shelf or inverse barometer. call get_param(PF, mdl, "DEPRESS_INITIAL_SURFACE", depress_sfc, & @@ -449,8 +451,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & "DEPRESS_INITIAL_SURFACE and TRIM_IC_FOR_P_SURF are exclusive and cannot both be True") if (new_sim .and. debug .and. (depress_sfc .or. trim_ic_for_p_surf)) & call hchksum(h, "Pre-depress: h ", G%HI, haloshift=1, scale=GV%H_to_m) - if (depress_sfc) call depress_surface(h, G, GV, PF, tv, just_read_params=just_read) - if (trim_ic_for_p_surf) call trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params=just_read) + if (depress_sfc) call depress_surface(h, G, GV, US, PF, tv, just_read_params=just_read) + if (trim_ic_for_p_surf) call trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params=just_read) ! Perhaps we want to run the regridding coordinate generator for multiple ! iterations here so the initial grid is consistent with the coordinate @@ -523,20 +525,20 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & " \t\t for buoyancy-forced basin case.\n"//& " \t USER - call a user modified routine.", default="file") select case (trim(config)) - case ("DOME"); call DOME_initialize_sponges(G, GV, tv, PF, sponge_CSp) + case ("DOME"); call DOME_initialize_sponges(G, GV, US, tv, PF, sponge_CSp) case ("DOME2D"); call DOME2d_initialize_sponges(G, GV, tv, PF, useALE, & sponge_CSp, ALE_sponge_CSp) - case ("ISOMIP"); call ISOMIP_initialize_sponges(G, GV, tv, PF, useALE, & + case ("ISOMIP"); call ISOMIP_initialize_sponges(G, GV, US, tv, PF, useALE, & sponge_CSp, ALE_sponge_CSp) case ("USER"); call user_initialize_sponges(G, GV, use_temperature, tv, PF, sponge_CSp, h) - case ("BFB"); call BFB_initialize_sponges_southonly(G, GV, use_temperature, tv, PF, & + case ("BFB"); call BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, PF, & sponge_CSp, h) - case ("DUMBBELL"); call dumbbell_initialize_sponges(G, GV, tv, PF, useALE, & + case ("DUMBBELL"); call dumbbell_initialize_sponges(G, GV, US, tv, PF, useALE, & sponge_CSp, ALE_sponge_CSp) - case ("phillips"); call Phillips_initialize_sponges(G, GV, tv, PF, sponge_CSp, h) + case ("phillips"); call Phillips_initialize_sponges(G, GV, US, tv, PF, sponge_CSp, h) case ("dense"); call dense_water_initialize_sponges(G, GV, tv, PF, useALE, & sponge_CSp, ALE_sponge_CSp) - case ("file"); call initialize_sponges_file(G, GV, use_temperature, tv, PF, & + case ("file"); call initialize_sponges_file(G, GV, US, use_temperature, tv, PF, & sponge_CSp, ALE_sponge_CSp, Time) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized sponge configuration "//trim(config)) @@ -560,7 +562,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & " tidal_bay - Flather with tidal forcing on eastern boundary\n"//& " USER - user specified", default="none") if (trim(config) == "DOME") then - call DOME_set_OBC_data(OBC, tv, G, GV, PF, tracer_Reg) + call DOME_set_OBC_data(OBC, tv, G, GV, US, PF, tracer_Reg) elseif (trim(config) == "dyed_channel") then call dyed_channel_set_OBC_tracer_data(OBC, G, GV, PF, tracer_Reg) OBC%update_OBC = .true. @@ -601,18 +603,20 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & end subroutine MOM_initialize_state !> Reads the layer thicknesses or interface heights from a file. -subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickness, just_read_params) +subroutine initialize_thickness_from_file(h, G, GV, US, param_file, file_has_thickness, & + just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in m. + intent(out) :: h !< The thickness that is being initialized, in m. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file - !! to parse for model parameter values. + !! to parse for model parameter values. logical, intent(in) :: file_has_thickness !< If true, this file contains layer - !! thicknesses; otherwise it contains - !! interface heights. + !! thicknesses; otherwise it contains + !! interface heights. logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + !! only read parameters without changing h. ! Local variables real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! Interface heights, in depth units. @@ -653,10 +657,10 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne "would indicate.", default=.false., do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. - call MOM_read_data(filename, "eta", eta(:,:,:), G%Domain, scale=GV%m_to_Z) + call MOM_read_data(filename, "eta", eta(:,:,:), G%Domain, scale=US%m_to_Z) if (correct_thickness) then - call adjustEtaToFitBathymetry(G, GV, eta, h) + call adjustEtaToFitBathymetry(G, GV, US, eta, h) else do k=nz,1,-1 ; do j=js,je ; do i=is,ie if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) then @@ -668,7 +672,7 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne enddo ; enddo ; enddo do j=js,je ; do i=is,ie - if (abs(eta(i,j,nz+1) + G%bathyT(i,j)) > 1.0*GV%m_to_Z) & + if (abs(eta(i,j,nz+1) + G%bathyT(i,j)) > 1.0*US%m_to_Z) & inconsistent = inconsistent + 1 enddo ; enddo call sum_across_PEs(inconsistent) @@ -692,9 +696,10 @@ end subroutine initialize_thickness_from_file !! is dilated (expanded) to fill the void. !! @remark{There is a (hard-wired) "tolerance" parameter such that the !! criteria for adjustment must equal or exceed 10cm.} -subroutine adjustEtaToFitBathymetry(G, GV, eta, h) +subroutine adjustEtaToFitBathymetry(G, GV, US, eta, h) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: eta !< Interface heights, in Z real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H ! Local variables @@ -704,7 +709,7 @@ subroutine adjustEtaToFitBathymetry(G, GV, eta, h) character(len=100) :: mesg is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - hTolerance = 0.1*GV%m_to_Z + hTolerance = 0.1*US%m_to_Z contractions = 0 do j=js,je ; do i=is,ie @@ -820,9 +825,10 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) end subroutine initialize_thickness_uniform !> Initialize thickness from a 1D list -subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) +subroutine initialize_thickness_list(h, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized, in H. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -861,7 +867,7 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) call log_param(param_file, mdl, "INPUTDIR/INTERFACE_IC_FILE", filename) e0(:) = 0.0 - call MOM_read_data(filename, eta_var, e0(:), scale=GV%m_to_Z) + call MOM_read_data(filename, eta_var, e0(:), scale=US%m_to_Z) if ((abs(e0(1)) - 0.0) > 0.001) then ! This list probably starts with the interior interface, so shift it up. @@ -900,9 +906,10 @@ subroutine initialize_thickness_search end subroutine initialize_thickness_search !> Converts thickness from geometric to pressure units -subroutine convert_thickness(h, G, GV, tv) +subroutine convert_thickness(h, G, GV, US, tv) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Input geometric layer thicknesses (in H units), !! being converted to layer pressure @@ -926,7 +933,7 @@ subroutine convert_thickness(h, G, GV, tv) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB max_itt = 10 Boussinesq = GV%Boussinesq - I_gEarth = 1.0 / (GV%g_Earth*GV%m_to_Z) + I_gEarth = 1.0 / (GV%g_Earth*US%m_to_Z) Hm_rho_to_Pa = GV%g_Earth * GV%H_to_Z ! = GV%H_to_Pa / GV%Rho0 if (Boussinesq) then @@ -978,9 +985,10 @@ subroutine convert_thickness(h, G, GV, tv) end subroutine convert_thickness !> Depress the sea-surface based on an initial condition file -subroutine depress_surface(h, G, GV, param_file, tv, just_read_params) +subroutine depress_surface(h, G, GV, US, param_file, tv, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters @@ -1027,7 +1035,7 @@ subroutine depress_surface(h, G, GV, param_file, tv, just_read_params) call MOM_read_data(filename, eta_srf_var, eta_sfc, G%Domain, scale=scale_factor) ! Convert thicknesses to interface heights. - call find_eta(h, tv, G, GV, eta, eta_to_m=1.0) + call find_eta(h, tv, G, GV, US, eta, eta_to_m=1.0) do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then ! if (eta_sfc(i,j) < eta(i,j,nz+1)) then @@ -1061,10 +1069,11 @@ end subroutine depress_surface !> Adjust the layer thicknesses by cutting away the top of each model column at the depth !! where the hydrostatic pressure matches an imposed surface pressure read from file. -subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) +subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params) type(param_file_type), intent(in) :: PF !< Parameter file structure type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ALE_CS), pointer :: ALE_CSp !< ALE control structure type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -1101,7 +1110,7 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) "file SURFACE_PRESSURE_FILE into a surface pressure.", & units="file dependent", default=1., do_not_log=just_read) call get_param(PF, mdl, "MIN_THICKNESS", min_thickness, 'Minimum layer thickness', & - units='m', default=1.e-3, do_not_log=just_read, scale=GV%m_to_Z) + units='m', default=1.e-3, do_not_log=just_read, scale=US%m_to_Z) call get_param(PF, mdl, "TRIMMING_USES_REMAPPING", use_remapping, & 'When trimming the column, also remap T and S.', & default=.false., do_not_log=just_read) @@ -1130,7 +1139,7 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) call cut_off_column_top(GV%ke, tv, GV, GV%g_Earth, G%bathyT(i,j), & min_thickness, tv%T(i,j,:), T_t(i,j,:), T_b(i,j,:), & tv%S(i,j,:), S_t(i,j,:), S_b(i,j,:), p_surf(i,j), h(i,j,:), remap_CS, & - z_tol=1.0e-5*GV%m_to_Z) + z_tol=1.0e-5*US%m_to_Z) enddo ; enddo end subroutine trim_for_ice @@ -1651,9 +1660,10 @@ end subroutine initialize_temp_salt_linear !! number of tracers should be restored within each sponge. The !! interface height is always subject to damping, and must always be !! the first registered field. -subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, ALE_CSp, Time) +subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, param_file, CSp, ALE_CSp, Time) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: use_temperature !< If true, T & S are state variables. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic !! variables. @@ -1750,7 +1760,7 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, if (.not. use_ALE) then allocate(eta(isd:ied,jsd:jed,nz+1)) - call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=GV%m_to_Z) + call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=US%m_to_Z) do j=js,je ; do i=is,ie eta(i,j,nz+1) = -G%bathyT(i,j) @@ -1775,7 +1785,7 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp, allocate(eta(isd:ied,jsd:jed,nz_data+1)) allocate(h(isd:ied,jsd:jed,nz_data)) - call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=GV%m_to_Z) + call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=US%m_to_Z) do j=js,je ; do i=is,ie eta(i,j,nz+1) = -G%bathyT(i,j) @@ -1884,13 +1894,14 @@ end subroutine set_velocity_depth_min !> This subroutine determines the isopycnal or other coordinate interfaces and !! layer potential temperatures and salinities directly from a z-space file on !! a latitude-longitude grid. -subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) +subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_params) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: h !< Layer thicknesses being initialized, in H type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic !! variables including temperature and salinity type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: PF !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1996,7 +2007,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) reentrant_x = .false. ; call get_param(PF, mdl, "REENTRANT_X", reentrant_x,default=.true.) tripolar_n = .false. ; call get_param(PF, mdl, "TRIPOLAR_N", tripolar_n, default=.false.) - call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, default=0.0, scale=GV%m_to_Z) + call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, default=0.0, scale=US%m_to_Z) call get_param(PF, mdl, "NKML",nkml,default=0) call get_param(PF, mdl, "NKBL",nkbl,default=0) @@ -2071,7 +2082,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) endif !### Change this to GV%Angstrom_Z - eps_z = 1.0e-10*GV%m_to_Z + eps_z = 1.0e-10*US%m_to_Z ! Read input grid coordinates for temperature and salinity field ! in z-coordinate dataset. The file is REQUIRED to contain the @@ -2090,11 +2101,11 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) call horiz_interp_and_extrap_tracer(tfilename, potemp_var, 1.0, 1, & G, temp_z, mask_z, z_in, z_edges_in, missing_value_temp, reentrant_x, & - tripolar_n, homogenize, m_to_Z=GV%m_to_Z) + tripolar_n, homogenize, m_to_Z=US%m_to_Z) call horiz_interp_and_extrap_tracer(sfilename, salin_var, 1.0, 1, & G, salt_z, mask_z, z_in, z_edges_in, missing_value_salt, reentrant_x, & - tripolar_n, homogenize, m_to_Z=GV%m_to_Z) + tripolar_n, homogenize, m_to_Z=US%m_to_Z) kd = size(z_in,1) @@ -2184,7 +2195,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) ! Build the target grid (and set the model thickness to it) ! This call can be more general but is hard-coded for z* coordinates... ???? - call ALE_initRegridding( GV, G%max_depth, PF, mdl, regridCS ) ! sets regridCS + call ALE_initRegridding( GV, US, G%max_depth, PF, mdl, regridCS ) ! sets regridCS if (.not. remap_general) then ! This is the old way of initializing to z* coordinates only @@ -2250,7 +2261,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) nlevs(is:ie,js:je), nkml, nkbl, min_depth, eps_z=eps_z) if (correct_thickness) then - call adjustEtaToFitBathymetry(G, GV, zi, h) + call adjustEtaToFitBathymetry(G, GV, US, zi, h) else do k=nz,1,-1 ; do j=js,je ; do i=is,ie if (zi(i,j,K) < (zi(i,j,K+1) + GV%Angstrom_Z)) then @@ -2262,7 +2273,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) enddo ; enddo ; enddo inconsistent=0 do j=js,je ; do i=is,ie - if (abs(zi(i,j,nz+1) + G%bathyT(i,j)) > 1.0*GV%m_to_Z) & + if (abs(zi(i,j,nz+1) + G%bathyT(i,j)) > 1.0*US%m_to_Z) & inconsistent = inconsistent + 1 enddo ; enddo call sum_across_PEs(inconsistent) @@ -2335,9 +2346,10 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) end subroutine MOM_temp_salt_initialize_from_Z !> Run simple unit tests -subroutine MOM_state_init_tests(G, GV, tv) +subroutine MOM_state_init_tests(G, GV, US, tv) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. ! Local variables integer, parameter :: nk=5 @@ -2363,15 +2375,15 @@ subroutine MOM_state_init_tests(G, GV, tv) S_t(k) = 35.-(0./500.)*e(k) S(k) = 35.+(0./500.)*z(k) S_b(k) = 35.-(0./500.)*e(k+1) - call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -GV%Rho0*(GV%g_Earth*GV%m_to_Z)*z(k), & + call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -GV%Rho0*(GV%g_Earth*US%m_to_Z)*z(k), & rho(k), tv%eqn_of_state) - P_tot = P_tot + (GV%g_Earth*GV%m_to_Z) * rho(k) * h(k) + P_tot = P_tot + (GV%g_Earth*US%m_to_Z) * rho(k) * h(k) enddo P_t = 0. do k = 1, nk call find_depth_of_pressure_in_cell(T_t(k), T_b(k), S_t(k), S_b(k), e(K), e(K+1), & - P_t, 0.5*P_tot, GV%Rho0, (GV%g_Earth*GV%m_to_Z), tv%eqn_of_state, P_b, z_out) + P_t, 0.5*P_tot, GV%Rho0, (GV%g_Earth*US%m_to_Z), tv%eqn_of_state, P_b, z_out) write(0,*) k,P_t,P_b,0.5*P_tot,e(K),e(K+1),z_out P_t = P_b enddo @@ -2381,7 +2393,7 @@ subroutine MOM_state_init_tests(G, GV, tv) write(0,*) ' ==================================================================== ' write(0,*) '' write(0,*) h - call cut_off_column_top(nk, tv, GV, (GV%g_Earth*GV%m_to_Z), -e(nk+1), GV%Angstrom_H, & + call cut_off_column_top(nk, tv, GV, (GV%g_Earth*US%m_to_Z), -e(nk+1), GV%Angstrom_H, & T, T_t, T_b, S, S_t, S_b, 0.5*P_tot, h, remap_CS) write(0,*) h diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index b6dda5a4ab..1baf30fcc3 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -15,17 +15,17 @@ module MOM_tracer_initialization_from_Z use MOM_file_parser, only : log_version use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type, isPointInCell +use MOM_horizontal_regridding, only : myStats, horiz_interp_and_extrap_tracer +use MOM_regridding, only : regridding_CS +use MOM_remapping, only : remapping_CS, initialize_remapping +use MOM_remapping, only : remapping_core_h use MOM_string_functions, only : uppercase +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs -use MOM_verticalGrid, only : setVerticalGridAxes +use MOM_verticalGrid, only : verticalGrid_type, setVerticalGridAxes use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type use MOM_EOS, only : int_specific_vol_dp use MOM_ALE, only : ALE_remap_scalar -use MOM_regridding, only : regridding_CS -use MOM_remapping, only : remapping_CS, initialize_remapping -use MOM_remapping, only : remapping_core_h -use MOM_verticalGrid, only : verticalGrid_type -use MOM_horizontal_regridding, only : myStats, horiz_interp_and_extrap_tracer implicit none ; private @@ -38,11 +38,12 @@ module MOM_tracer_initialization_from_Z contains !> Initializes a tracer from a z-space data file. -subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, & +subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_nam, & src_var_unit_conversion, src_var_record, homogenize, & useALEremapping, remappingScheme, src_var_gridspec ) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thickness, in H (often m or kg m-2). real, dimension(:,:,:), pointer :: tr !< Pointer to array to be initialized @@ -121,7 +122,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, call horiz_interp_and_extrap_tracer(src_file, src_var_nam, convert, recnum, & G, tr_z, mask_z, z_in, z_edges_in, missing_value, reentrant_x, tripolar_n, & - homog, m_to_Z=GV%m_to_Z) + homog, m_to_Z=US%m_to_Z) kd = size(z_edges_in,1)-1 call pass_var(tr_z,G%Domain) diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index f9dae9b246..1ac6c2a035 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -33,7 +33,6 @@ module MOM_oda_driver_mod use MOM_diag_mediator, only : diag_ctrl, set_axes_info use MOM_error_handler, only : FATAL, WARNING, MOM_error, MOM_mesg, is_root_pe use MOM_get_input, only : get_MOM_input, directories -use MOM_variables, only : thermo_var_ptrs use MOM_grid, only : ocean_grid_type, MOM_grid_init use MOM_grid_initialize, only : set_grid_metrics use MOM_hor_index, only : hor_index_type, hor_index_init @@ -41,7 +40,6 @@ module MOM_oda_driver_mod use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid use MOM_fixed_initialization, only : MOM_initialize_fixed, MOM_initialize_topography use MOM_coord_initialization, only : MOM_initialize_coord -use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit use MOM_file_parser, only : read_param, get_param, param_file_type use MOM_string_functions, only : lowercase use MOM_ALE, only : ALE_CS, ALE_initThicknessToCoord, ALE_init, ALE_updateVerticalGridType @@ -49,6 +47,9 @@ module MOM_oda_driver_mod use MOM_remapping, only : remapping_CS, initialize_remapping, remapping_core_h use MOM_regridding, only : regridding_CS, initialize_regridding use MOM_regridding, only : regridding_main, set_regrid_params +use MOM_unit_scaling, only : unit_scale_type, unit_scaling_init +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit implicit none ; private @@ -67,6 +68,9 @@ module MOM_oda_driver_mod type(ptr_mpp_domain), pointer, dimension(:) :: domains => NULL() !< Pointer to mpp_domain objects !! for ensemble members type(verticalGrid_type), pointer :: GV => NULL() !< vertical grid for DA + type(unit_scale_type), pointer :: & + US => NULL() !< structure containing various unit conversion factors for DA + type(domain2d), pointer :: mpp_domain => NULL() !< Pointer to a mpp domain object for DA type(grid_type), pointer :: oda_grid !< local tracer grid real, pointer, dimension(:,:,:) :: h => NULL() ! Calls subroutines in this file that are needed to refract, propagate, !! and dissipate energy density of the internal tide. subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & - G, GV, CS) + G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H !! (usually m or kg m-2). @@ -349,7 +351,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & if (CS%apply_bottom_drag) then do j=jsd,jed ; do i=isd,ied ! Note the 1 m dimensional scale here. Should this be a parameter? - I_D_here = 1.0 / (GV%Z_to_m*max(G%bathyT(i,j), 1.0*GV%m_to_Z)) + I_D_here = 1.0 / (GV%Z_to_m*max(G%bathyT(i,j), 1.0*US%m_to_Z)) drag_scale(i,j) = CS%cdrag * sqrt(max(0.0, vel_btTide(i,j)**2 + & tot_En(i,j) * I_rho0 * I_D_here)) * I_D_here enddo ; enddo @@ -381,7 +383,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & if (CS%apply_wave_drag .or. CS%apply_Froude_drag) then do m=1,CS%NMode ; do fr=1,CS%Nfreq ! Calculate modal structure for given mode and frequency - call wave_structure(h, tv, G, GV, cn(:,:,m), m, CS%frequency(fr), & + call wave_structure(h, tv, G, GV, US, cn(:,:,m), m, CS%frequency(fr), & CS%wave_structure_CSp, tot_En_mode(:,:,fr,m), full_halos=.true.) ! Pick out near-bottom and max horizontal baroclinic velocity values at each point do j=jsd,jed ; do i=isd,ied diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 7f33140fb7..9119eb3169 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -13,6 +13,7 @@ module MOM_lateral_mixing_coeffs use MOM_interface_heights, only : find_eta use MOM_isopycnal_slopes, only : calc_isoneutral_slopes use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_speed, only : wave_speed, wave_speed_CS, wave_speed_init @@ -129,11 +130,12 @@ module MOM_lateral_mixing_coeffs contains !> Calculates and stores the non-dimensional resolution functions -subroutine calc_resoln_function(h, tv, G, GV, CS) +subroutine calc_resoln_function(h, tv, G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg/m2) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(VarMix_CS), pointer :: CS !< Variable mixing coefficients ! Local variables real :: cg1_q ! The gravity wave speed interpolated to q points, in m s-1. @@ -156,15 +158,15 @@ subroutine calc_resoln_function(h, tv, G, GV, CS) "calc_resoln_function: %ebt_struct is not associated with RESOLN_USE_EBT.") if (CS%Resoln_use_ebt) then ! Both resolution fn and vertical structure are using EBT - call wave_speed(h, tv, G, GV, CS%cg1, CS%wave_speed_CSp, modal_structure=CS%ebt_struct) + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, modal_structure=CS%ebt_struct) else ! Use EBT to get vertical structure first and then re-calculate cg1 using first baroclinic mode - call wave_speed(h, tv, G, GV, CS%cg1, CS%wave_speed_CSp, modal_structure=CS%ebt_struct, use_ebt_mode=.true.) - call wave_speed(h, tv, G, GV, CS%cg1, CS%wave_speed_CSp) + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, modal_structure=CS%ebt_struct, use_ebt_mode=.true.) + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp) endif call pass_var(CS%ebt_struct, G%Domain) else - call wave_speed(h, tv, G, GV, CS%cg1, CS%wave_speed_CSp) + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp) endif call create_group_pass(CS%pass_cg1, CS%cg1, G%Domain) @@ -376,9 +378,10 @@ end subroutine calc_resoln_function !> Calculates and stores functions of isopycnal slopes, e.g. Sx, Sy, S*N, mostly used in the Visbeck et al. !! style scaling of diffusivity -subroutine calc_slope_functions(h, tv, dt, G, GV, CS) +subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness (m or kg/m2) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, intent(in) :: dt !< Time increment (s) @@ -393,15 +396,15 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS) "Module must be initialized before it is used.") if (CS%calculate_Eady_growth_rate) then - call find_eta(h, tv, G, GV, e, halo_size=2) + call find_eta(h, tv, G, GV, US, e, halo_size=2) if (CS%use_stored_slopes) then - call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, & + call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, & CS%slope_x, CS%slope_y, N2_u, N2_v, 1) call calc_Visbeck_coeffs(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, CS) ! call calc_slope_functions_using_just_e(h, G, CS, e, .false.) else !call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, CS%slope_x, CS%slope_y) - call calc_slope_functions_using_just_e(h, G, GV, CS, e, .true.) + call calc_slope_functions_using_just_e(h, G, GV, US, CS, e, .true.) endif endif @@ -570,10 +573,11 @@ end subroutine calc_Visbeck_coeffs !> The original calc_slope_function() that calculated slopes using !! interface positions only, not accounting for density variations. -subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) +subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slopes) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness (m or kg/m2) type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(VarMix_CS), pointer :: CS !< Variable mixing coefficients real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface position (m) logical, intent(in) :: calculate_slopes !< If true, calculate slopes internally @@ -649,7 +653,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect) Hup = 2.*h(i+1,j,k)*h(i+1,j,k-1) / (h(i+1,j,k) + h(i+1,j,k-1) + h_neglect) H_geom = sqrt(Hdn*Hup) - N2 = GV%g_prime(k)*GV%m_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) + N2 = GV%g_prime(k)*US%m_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) if (min(h(i,j,k-1), h(i+1,j,k-1), h(i,j,k), h(i+1,j,k)) < H_cutoff) & S2 = 0.0 SN_u_local(I,j,k) = (H_geom * GV%H_to_Z) * S2 * N2 @@ -660,7 +664,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect) Hup = 2.*h(i,j+1,k)*h(i,j+1,k-1) / (h(i,j+1,k) + h(i,j+1,k-1) + h_neglect) H_geom = sqrt(Hdn*Hup) - N2 = GV%g_prime(k)*GV%m_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) + N2 = GV%g_prime(k)*US%m_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) if (min(h(i,j,k-1), h(i,j+1,k-1), h(i,j,k), h(i,j+1,k)) < H_cutoff) & S2 = 0.0 SN_v_local(i,J,k) = (H_geom * GV%H_to_Z) * S2 * N2 @@ -706,10 +710,11 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) end subroutine calc_slope_functions_using_just_e !> Initializes the variables mixing coefficients container -subroutine VarMix_init(Time, G, GV, param_file, diag, CS) +subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< Current model time type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(VarMix_CS), pointer :: CS !< Variable mixing coefficients @@ -827,7 +832,7 @@ subroutine VarMix_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate \n"//& "more sensible values of T & S into thin layers.", & - default=1.0e-6, scale=GV%m_to_Z**2) !### Add units argument. + default=1.0e-6, scale=US%m_to_Z**2) !### Add units argument. endif if (CS%calculate_Eady_growth_rate) then diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 27a60e7a38..be30be6633 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -16,6 +16,7 @@ module MOM_mixed_layer_restrat use MOM_io, only : vardesc, var_desc use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density @@ -84,9 +85,10 @@ module MOM_mixed_layer_restrat !> Driver for the mixed-layer restratification parameterization. !! The code branches between two different implementations depending !! on whether the bulk-mixed layer or a general coordinate are in use. -subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, CS) +subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness (H units = m or kg/m2) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux (m3 or kg) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux (m3 or kg) @@ -102,18 +104,19 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, "Module must be initialized before it is used.") if (GV%nkml>0) then - call mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) + call mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) else - call mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, CS) + call mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, US, CS) endif end subroutine mixedlayer_restrat !> Calculates a restratifying flow in the mixed layer. -subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix, G, GV, CS) +subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix, G, GV, US, CS) ! Arguments type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness (H units = m or kg/m2) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux (m3 or kg) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux (m3 or kg) @@ -338,7 +341,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var call hchksum(h,'mixed_layer_restrat: h',G%HI,haloshift=1,scale=GV%H_to_m) call hchksum(forces%ustar,'mixed_layer_restrat: u*',G%HI,haloshift=1) call hchksum(MLD_fast,'mixed_layer_restrat: MLD',G%HI,haloshift=1,scale=GV%H_to_m) - call hchksum(Rml_av_fast,'mixed_layer_restrat: rml',G%HI,haloshift=1, scale=GV%m_to_Z) + call hchksum(Rml_av_fast,'mixed_layer_restrat: rml',G%HI,haloshift=1, scale=US%m_to_Z) endif ! TO DO: @@ -348,7 +351,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! U - Component !$OMP do do j=js,je ; do I=is-1,ie - u_star = GV%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star = US%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & @@ -424,7 +427,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! V- component !$OMP do do J=js-1,je ; do i=is,ie - u_star = GV%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star = US%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & @@ -539,9 +542,10 @@ end subroutine mixedlayer_restrat_general !> Calculates a restratifying flow assuming a 2-layer bulk mixed layer. -subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) +subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness (H units = m or kg/m2) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux (m3 or kg) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux (m3 or kg) @@ -646,7 +650,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) do I=is-1,ie h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z - u_star = GV%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star = US%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 @@ -694,7 +698,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, CS) do J=js-1,je ; do i=is,ie h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_Z - u_star = GV%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star = US%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 @@ -771,10 +775,11 @@ end subroutine mixedlayer_restrat_BML !> Initialize the mixed layer restratification module -logical function mixedlayer_restrat_init(Time, G, GV, param_file, diag, CS, restart_CS) +logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, restart_CS) type(time_type), intent(in) :: Time !< Current model time type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file to parse type(diag_ctrl), target, intent(inout) :: diag !< Regulate diagnostics type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure @@ -884,7 +889,7 @@ logical function mixedlayer_restrat_init(Time, G, GV, param_file, diag, CS, rest 'Mixed Layer Depth as used in the mixed-layer restratification parameterization', 'm') CS%id_Rml = register_diag_field('ocean_model', 'ML_buoy_restrat', diag%axesT1, Time, & 'Mixed Layer Buoyancy as used in the mixed-layer restratification parameterization', & - 'm s2', conversion=GV%m_to_Z) + 'm s2', conversion=US%m_to_Z) CS%id_uDml = register_diag_field('ocean_model', 'udml_restrat', diag%axesCu1, Time, & 'Transport stream function amplitude for zonal restratification of mixed layer', 'm3 s-1') CS%id_vDml = register_diag_field('ocean_model', 'vdml_restrat', diag%axesCv1, Time, & diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index ac50c4c11a..e487d5f5a5 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -14,6 +14,7 @@ module MOM_thickness_diffuse use MOM_interface_heights, only : find_eta use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_MEKE_types, only : MEKE_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, cont_diag_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -72,9 +73,10 @@ module MOM_thickness_diffuse !> Calculates thickness diffusion coefficients and applies thickness diffusion to layer !! thicknesses, h. Diffusivities are limited to ensure stability. !! Also returns along-layer mass fluxes used in the continuity equation. -subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS) +subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness (m or kg/m2) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux (m2 H) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux (m2 H) @@ -160,7 +162,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS enddo ; enddo ! Calculates interface heights, e, in m. - call find_eta(h, tv, G, GV, e, halo_size=1) + call find_eta(h, tv, G, GV, US, e, halo_size=1) ! Set the diffusivities. !$OMP parallel default(none) shared(is,ie,js,je,Khth_Loc_u,CS,use_VarMix,VarMix, & @@ -303,10 +305,10 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS ! Calculate uhD, vhD from h, e, KH_u, KH_v, tv%T/S if (use_stored_slopes) then - call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, MEKE, CS, & + call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, US, MEKE, CS, & int_slope_u, int_slope_v, VarMix%slope_x, VarMix%slope_y) else - call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, MEKE, CS, & + call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, US, MEKE, CS, & int_slope_u, int_slope_v) endif @@ -396,10 +398,11 @@ end subroutine thickness_diffuse !> Calculates parameterized layer transports for use in the continuity equation. !! Fluxes are limited to give positive definite thicknesses. !! Called by thickness_diffuse(). -subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, MEKE, & +subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, US, MEKE, & CS, int_slope_u, int_slope_v, slope_x, slope_y) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg/m2) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions (Z) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: Kh_u !< Thickness diffusivity on interfaces @@ -675,7 +678,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdx**2 + (GV%m_to_Z*drdz)**2 + mag_grad2 = drdx**2 + (US%m_to_Z*drdz)**2 if (mag_grad2 > 0.0) then Slope = drdx / sqrt(mag_grad2) slope2_Ratio_u(I,K) = Slope**2 * I_slope_max2 @@ -695,7 +698,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope ! Estimate the streamfunction at each interface (m3 s-1). - Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*GV%m_to_Z*Slope) + Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*US%m_to_Z*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -724,7 +727,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV Slope = GV%Z_to_m*((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) endif if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope - Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*GV%m_to_Z*Slope) + Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*US%m_to_Z*Slope) hN2_u(I,K) = GV%g_prime(K) endif ! if (use_EOS) else ! if (k > nk_linear) @@ -921,7 +924,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdy**2 + (GV%m_to_Z*drdz)**2 + mag_grad2 = drdy**2 + (US%m_to_Z*drdz)**2 if (mag_grad2 > 0.0) then Slope = drdy / sqrt(mag_grad2) slope2_Ratio_v(i,K) = Slope**2 * I_slope_max2 @@ -941,7 +944,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope ! Estimate the streamfunction at each interface (m3 s-1). - Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*GV%m_to_Z*Slope) + Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*US%m_to_Z*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -970,7 +973,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV Slope = GV%Z_to_m*((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) endif if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope - Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*GV%m_to_Z*Slope) + Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*US%m_to_Z*Slope) hN2_v(i,K) = GV%g_prime(K) endif ! if (use_EOS) else ! if (k > nk_linear) @@ -1679,10 +1682,11 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) end subroutine vert_fill_TS !> Initialize the thickness diffusion module/structure -subroutine thickness_diffuse_init(Time, G, GV, param_file, diag, CDp, CS) +subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) type(time_type), intent(in) :: Time !< Current model time type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(cont_diag_ptrs), intent(inout) :: CDp !< Continuity equation diagnostics @@ -1742,7 +1746,7 @@ subroutine thickness_diffuse_init(Time, G, GV, param_file, diag, CDp, CS) call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate \n"//& "more sensible values of T & S into thin layers.", & - default=1.0e-6, scale=GV%m_to_Z**2) + default=1.0e-6, scale=US%m_to_Z**2) call get_param(param_file, mdl, "KHTH_USE_FGNV_STREAMFUNCTION", CS%use_FGNV_streamfn, & "If true, use the streamfunction formulation of\n"// & "Ferrari et al., 2010, which effectively emphasizes\n"//& diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 0b10a8d2d4..1ad8e44960 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -22,6 +22,7 @@ module MOM_ALE_sponge use MOM_spatial_means, only : global_i_mean use MOM_time_manager, only : time_type, init_external_field, get_external_field_size, time_interp_external_init use MOM_remapping, only : remapping_cs, remapping_core_h, initialize_remapping +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type ! GMM - Planned extension: Support for time varying sponge targets. @@ -652,7 +653,7 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, f_p ! modulo attribute of the zonal axis (mjh). ! call horiz_interp_and_extrap_tracer(CS%Ref_val(CS%fldno)%id,Time, 1.0,G,sp_val,mask_z,z_in,z_edges_in, & - ! missing_value, .true., .false., .false., m_to_Z=GV%m_to_Z) + ! missing_value, .true., .false., .false., m_to_Z=US%m_to_Z) ! Do not think halo updates are needed (mjh) ! call pass_var(sp_val,G%Domain) @@ -834,9 +835,10 @@ end subroutine set_up_ALE_sponge_vel_field_varying !> This subroutine applies damping to the layers thicknesses, temp, salt and a variety of tracers !! for every column where there is damping. -subroutine apply_ALE_sponge(h, dt, G, GV, CS, Time) +subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure (in). type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Layer thickness, in H (in) real, intent(in) :: dt !< The amount of time covered by this call, in s (in). @@ -883,7 +885,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, CS, Time) mask_z(:,:,:)=0.0 call horiz_interp_and_extrap_tracer(CS%Ref_val(CS%fldno)%id,Time, 1.0,G,sp_val,mask_z,z_in,z_edges_in, & - missing_value,.true., .false.,.false., m_to_Z=GV%m_to_Z) + missing_value,.true., .false.,.false., m_to_Z=US%m_to_Z) ! call pass_var(sp_val,G%Domain) ! call pass_var(mask_z,G%Domain) @@ -953,7 +955,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, CS, Time) allocate(mask_z(G%isdB:G%iedB,G%jsd:G%jed,1:nz_data)) ! Interpolate from the external horizontal grid and in time call horiz_interp_and_extrap_tracer(CS%Ref_val_u%id,Time, 1.0,G,sp_val,mask_z,z_in,z_edges_in, & - missing_value, .true., .false., .false., m_to_Z=GV%m_to_Z) + missing_value, .true., .false., .false., m_to_Z=US%m_to_Z) ! call pass_var(sp_val,G%Domain) ! call pass_var(mask_z,G%Domain) @@ -972,7 +974,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, CS, Time) allocate(mask_z(G%isd:G%ied,G%jsdB:G%jedB,1:nz_data)) ! Interpolate from the external horizontal grid and in time call horiz_interp_and_extrap_tracer(CS%Ref_val_v%id,Time, 1.0,G,sp_val,mask_z,z_in,z_edges_in, & - missing_value, .true., .false., .false., m_to_Z=GV%m_to_Z) + missing_value, .true., .false., .false., m_to_Z=US%m_to_Z) ! call pass_var(sp_val,G%Domain) ! call pass_var(mask_z,G%Domain) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index e0bb50ea6d..03b7b9f561 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -12,6 +12,7 @@ module MOM_CVMix_KPP use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_file_parser, only : openParameterBlock, closeParameterBlock use MOM_grid, only : ocean_grid_type, isPointInCell +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only : wave_parameters_CS, Get_Langmuir_Number use MOM_domains, only : pass_var @@ -574,7 +575,7 @@ logical function KPP_init(paramFile, G, GV, diag, Time, CS, passive, Waves) end function KPP_init !> KPP vertical diffusivity/viscosity and non-local tracer transport -subroutine KPP_calculate(CS, G, GV, h, uStar, & +subroutine KPP_calculate(CS, G, GV, US, h, uStar, & buoyFlux, Kt, Ks, Kv, nonLocalTransHeat,& nonLocalTransScalar, Waves) @@ -582,6 +583,7 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & type(KPP_CS), pointer :: CS !< Control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (m/s) @@ -819,16 +821,16 @@ subroutine KPP_calculate(CS, G, GV, h, uStar, & if (.not. CS%passiveMode) then if (CS%KPPisAdditive) then do k=1, G%ke+1 - Kt(i,j,k) = Kt(i,j,k) + GV%m_to_Z**2 * Kdiffusivity(k,1) - Ks(i,j,k) = Ks(i,j,k) + GV%m_to_Z**2 * Kdiffusivity(k,2) - Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kviscosity(k) + Kt(i,j,k) = Kt(i,j,k) + US%m_to_Z**2 * Kdiffusivity(k,1) + Ks(i,j,k) = Ks(i,j,k) + US%m_to_Z**2 * Kdiffusivity(k,2) + Kv(i,j,k) = Kv(i,j,k) + US%m_to_Z**2 * Kviscosity(k) if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = GV%Z_to_m**2 * Kv(i,j,k) enddo else ! KPP replaces prior diffusivity when former is non-zero do k=1, G%ke+1 - if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = GV%m_to_Z**2 * Kdiffusivity(k,1) - if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = GV%m_to_Z**2 * Kdiffusivity(k,2) - if (Kviscosity(k) /= 0.) Kv(i,j,k) = GV%m_to_Z**2 * Kviscosity(k) + if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = US%m_to_Z**2 * Kdiffusivity(k,1) + if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = US%m_to_Z**2 * Kdiffusivity(k,2) + if (Kviscosity(k) /= 0.) Kv(i,j,k) = US%m_to_Z**2 * Kviscosity(k) if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = GV%Z_to_m**2 * Kv(i,j,k) enddo endif @@ -866,13 +868,13 @@ end subroutine KPP_calculate !> Compute OBL depth -subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux, Waves) +subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyFlux, Waves) ! Arguments type(KPP_CS), pointer :: CS !< Control structure type(ocean_grid_type), intent(inout) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< potential/cons temp (deg C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< Salinity (ppt) @@ -881,6 +883,7 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux, type(EOS_type), pointer :: EOS !< Equation of state real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (m/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux (m2/s3) + type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS ! Local variables integer :: i, j, k, km1 ! Loop indices @@ -936,7 +939,7 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux, #endif ! some constants - GoRho = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 + GoRho = (GV%g_Earth*US%m_to_Z) / GV%Rho0 ! loop over horizontal points on processor !$OMP parallel do default(shared) @@ -1067,8 +1070,8 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux, "without activating USEWAVES") endif !For now get Langmuir number based on prev. MLD (otherwise must compute 3d LA) - MLD_GUESS = max( 1.*GV%m_to_Z, abs(GV%m_to_Z*CS%OBLdepthprev(i,j) ) ) - call get_Langmuir_Number( LA, G, GV, MLD_guess, surfFricVel, I, J, & + MLD_GUESS = max( 1.*US%m_to_Z, abs(US%m_to_Z*CS%OBLdepthprev(i,j) ) ) + call get_Langmuir_Number( LA, G, GV, US, MLD_guess, surfFricVel, I, J, & H=H(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES) WAVES%La_SL(i,j)=LA endif diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 851951af3e..baf347930b 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -3,16 +3,17 @@ module MOM_CVMix_conv ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_debugging, only : hchksum use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field use MOM_diag_mediator, only : post_data use MOM_EOS, only : calculate_density -use MOM_variables, only : thermo_var_ptrs use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE use MOM_file_parser, only : openParameterBlock, closeParameterBlock -use MOM_debugging, only : hchksum +use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use MOM_file_parser, only : get_param, log_version, param_file_type use CVMix_convection, only : CVMix_init_conv, CVMix_coeffs_conv use CVMix_kpp, only : CVMix_kpp_compute_kOBL_depth @@ -145,10 +146,11 @@ end function CVMix_conv_init !> Subroutine for calculating enhanced diffusivity/viscosity !! due to convection via CVMix -subroutine calculate_CVMix_conv(h, tv, G, GV, CS, hbl) +subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. type(CVMix_conv_cs), pointer :: CS !< The control structure returned @@ -168,7 +170,7 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, CS, hbl) real :: pref, g_o_rho0, rhok, rhokm1, dz, dh, hcorr integer :: i, j, k - g_o_rho0 = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 + g_o_rho0 = (GV%g_Earth*US%m_to_Z) / GV%Rho0 ! initialize dummy variables rho_lwr(:) = 0.0; rho_1d(:) = 0.0 @@ -228,8 +230,8 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, CS, hbl) OBL_ind=kOBL) do K=1,G%ke+1 - CS%kv_conv(i,j,K) = GV%m_to_Z**2 * kv_col(K) - CS%kd_conv(i,j,K) = GV%m_to_Z**2 * kd_col(K) + CS%kv_conv(i,j,K) = US%m_to_Z**2 * kv_col(K) + CS%kd_conv(i,j,K) = US%m_to_Z**2 * kd_col(K) enddo ! Do not apply mixing due to convection within the boundary layer do k=1,kOBL diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index eabce5056b..5d76287279 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -6,13 +6,14 @@ module MOM_CVMix_ddiff use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field use MOM_diag_mediator, only : post_data use MOM_EOS, only : calculate_density_derivs -use MOM_variables, only : thermo_var_ptrs use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE use MOM_file_parser, only : openParameterBlock, closeParameterBlock +use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_debugging, only : hchksum use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use MOM_file_parser, only : get_param, log_version, param_file_type use cvmix_ddiff, only : cvmix_init_ddiff, CVMix_coeffs_ddiff use cvmix_kpp, only : CVmix_kpp_compute_kOBL_depth implicit none ; private @@ -160,10 +161,11 @@ end function CVMix_ddiff_init !> Subroutine for computing vertical diffusion coefficients for the !! double diffusion mixing parameterization. -subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) +subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_T !< Interface double diffusion diapycnal @@ -272,8 +274,8 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) nlev=G%ke, & max_nlev=G%ke) do K=1,G%ke+1 - Kd_T(i,j,K) = GV%m_to_Z**2 * Kd1_T(K) - Kd_S(i,j,K) = GV%m_to_Z**2 * Kd1_S(K) + Kd_T(i,j,K) = US%m_to_Z**2 * Kd1_T(K) + Kd_S(i,j,K) = US%m_to_Z**2 * Kd1_S(K) enddo ! Do not apply mixing due to convection within the boundary layer diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index d80ccf1114..b6ee62ea1c 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -10,6 +10,7 @@ module MOM_CVMix_shear use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, EOS_type @@ -50,9 +51,10 @@ module MOM_CVMix_shear contains !> Subroutine for calculating (internal) vertical diffusivities/viscosities -subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, CS ) +subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: u_H !< Initial zonal velocity on T points, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: v_H !< Initial meridional velocity on T points, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. @@ -74,7 +76,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, CS ) real, parameter :: epsln = 1.e-10 !< Threshold to identify vanished layers ! some constants - GoRho = (GV%g_Earth*GV%m_to_Z) / GV%Rho0 + GoRho = (GV%g_Earth*US%m_to_Z) / GV%Rho0 do j = G%jsc, G%jec do i = G%isc, G%iec @@ -160,8 +162,8 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, CS ) nlev=G%ke, & max_nlev=G%ke) do K=1,G%ke+1 - kv(i,j,K) = GV%m_to_Z**2 * Kvisc(K) - kd(i,j,K) = GV%m_to_Z**2 * Kdiff(K) + kv(i,j,K) = US%m_to_Z**2 * Kvisc(K) + kd(i,j,K) = US%m_to_Z**2 * Kdiff(K) enddo enddo enddo diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 19181b1bf9..bf140ba069 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -5,20 +5,20 @@ module MOM_bkgnd_mixing ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_debugging, only : hchksum use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field use MOM_diag_mediator, only : post_data use MOM_EOS, only : calculate_density, calculate_density_derivs -use MOM_variables, only : thermo_var_ptrs -use MOM_forcing_type, only : forcing use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE +use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_file_parser, only : openParameterBlock, closeParameterBlock -use MOM_debugging, only : hchksum +use MOM_forcing_type, only : forcing use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type -use MOM_file_parser, only : get_param, log_version, param_file_type -use CVMix_background, only : CVMix_init_bkgnd, CVMix_coeffs_bkgnd -use MOM_variables, only : vertvisc_type +use MOM_variables, only : thermo_var_ptrs, vertvisc_type use MOM_intrinsic_functions, only : invcosh +use CVMix_background, only : CVMix_init_bkgnd, CVMix_coeffs_bkgnd implicit none ; private @@ -109,14 +109,15 @@ module MOM_bkgnd_mixing contains !> Initialize the background mixing routine. -subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) +subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current time. type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. - type(bkgnd_mixing_cs), pointer :: CS !< This module's control structure. + type(bkgnd_mixing_cs), pointer :: CS !< This module's control structure. ! Local variables real :: Kv ! The interior vertical viscosity (m2/s) - read to set prandtl @@ -140,7 +141,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "KD", CS%Kd, & "The background diapycnal diffusivity of density in the \n"//& "interior. Zero or the molecular value, ~1e-7 m2 s-1, \n"//& - "may be used.", units="m2 s-1", scale=GV%m_to_Z**2, fail_if_missing=.true.) + "may be used.", units="m2 s-1", scale=US%m_to_Z**2, fail_if_missing=.true.) call get_param(param_file, mdl, "KV", Kv, & "The background kinematic viscosity in the interior. \n"//& @@ -149,7 +150,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, & "The minimum diapycnal diffusivity.", & - units="m2 s-1", default=0.01*CS%Kd*GV%Z_to_m**2, scale=GV%m_to_Z**2) + units="m2 s-1", default=0.01*CS%Kd*GV%Z_to_m**2, scale=US%m_to_Z**2) ! The following is needed to set one of the choices of vertical background mixing @@ -169,11 +170,11 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) "If BULKMIXEDLAYER is false, KDML is the elevated \n"//& "diapycnal diffusivity in the topmost HMIX of fluid. \n"//& "KDML is only used if BULKMIXEDLAYER is false.", & - units="m2 s-1", default=CS%Kd*GV%Z_to_m**2, scale=GV%m_to_Z**2) + units="m2 s-1", default=CS%Kd*GV%Z_to_m**2, scale=US%m_to_Z**2) call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface \n"//& "viscosity and diffusivity are elevated when the bulk \n"//& - "mixed layer is not used.", units="m", scale=GV%m_to_Z, fail_if_missing=.true.) + "mixed layer is not used.", units="m", scale=US%m_to_Z, fail_if_missing=.true.) endif call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) @@ -223,22 +224,22 @@ subroutine bkgnd_mixing_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "BCKGRND_VDC1", & CS%bckgrnd_vdc1, & "Background diffusivity (Ledwell) when HORIZ_VARYING_BACKGROUND=True", & - units="m2 s-1",default = 0.16e-04, scale=GV%m_to_Z**2) + units="m2 s-1",default = 0.16e-04, scale=US%m_to_Z**2) call get_param(param_file, mdl, "BCKGRND_VDC_EQ", & CS%bckgrnd_vdc_eq, & "Equatorial diffusivity (Gregg) when HORIZ_VARYING_BACKGROUND=True", & - units="m2 s-1",default = 0.01e-04, scale=GV%m_to_Z**2) + units="m2 s-1",default = 0.01e-04, scale=US%m_to_Z**2) call get_param(param_file, mdl, "BCKGRND_VDC_PSIM", & CS%bckgrnd_vdc_psim, & "Max. PSI induced diffusivity (MacKinnon) when HORIZ_VARYING_BACKGROUND=True", & - units="m2 s-1",default = 0.13e-4, scale=GV%m_to_Z**2) + units="m2 s-1",default = 0.13e-4, scale=US%m_to_Z**2) call get_param(param_file, mdl, "BCKGRND_VDC_BAN", & CS%bckgrnd_vdc_ban, & "Banda Sea diffusivity (Gordon) when HORIZ_VARYING_BACKGROUND=True", & - units="m2 s-1",default = 1.0e-4, scale=GV%m_to_Z**2) + units="m2 s-1",default = 1.0e-4, scale=US%m_to_Z**2) endif call get_param(param_file, mdl, "PRANDTL_BKGND", CS%prandtl_bkgnd, & @@ -374,10 +375,11 @@ end subroutine sfc_bkgnd_mixing !> Calculates the vertical background diffusivities/viscosities -subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) +subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< squared buoyancy frequency associated @@ -435,11 +437,11 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, CS) ! Update Kd and Kv. do K=1,nz+1 - CS%Kv_bkgnd(i,j,K) = GV%m_to_Z**2*Kv_col(K) - CS%Kd_bkgnd(i,j,K) = GV%m_to_Z**2*Kd_col(K) + CS%Kv_bkgnd(i,j,K) = US%m_to_Z**2*Kv_col(K) + CS%Kd_bkgnd(i,j,K) = US%m_to_Z**2*Kd_col(K) enddo do k=1,nz - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_col(K) + Kd_col(K+1)) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*US%m_to_Z**2*(Kd_col(K) + Kd_col(K+1)) enddo enddo ! i loop diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index eb7dae1590..d7e2dfd0bb 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -12,6 +12,7 @@ module MOM_bulk_mixed_layer use MOM_forcing_type, only : extractFluxes1d, forcing use MOM_grid, only : ocean_grid_type use MOM_shortwave_abs, only : absorbRemainingSW, optics_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs @@ -168,10 +169,11 @@ module MOM_bulk_mixed_layer !! For a traditional Kraus-Turner mixed layer, the values are: !! pen_SW_frac = 0.0, pen_SW_scale = 0.0 m, mstar = 1.25, !! nstar = 0.4, TKE_decay = 0.0, conv_decay = 0.0 -subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & +subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, CS, & optics, Hml, aggregate_FW_forcing, dt_diag, last_call) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h_3d !< Layer thickness, in m or kg m-2. !! (Intent in/out) The units of h are @@ -217,65 +219,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & !! diagnostics will be written. The default is !! .true. -! This subroutine partially steps the bulk mixed layer model. -! The following processes are executed, in the order listed. -! 1. Undergo convective adjustment into mixed layer. -! 2. Apply surface heating and cooling. -! 3. Starting from the top, entrain whatever fluid the TKE budget -! permits. Penetrating shortwave radiation is also applied at -! this point. -! 4. If there is any unentrained fluid that was formerly in the -! mixed layer, detrain this fluid into the buffer layer. This -! is equivalent to the mixed layer detraining to the Monin- -! Obukhov depth. -! 5. Divide the fluid in the mixed layer evenly into CS%nkml pieces. -! 6. Split the buffer layer if appropriate. -! Layers 1 to nkml are the mixed layer, nkml+1 to nkml+nkbl are the -! buffer layers. The results of this subroutine are mathematically -! identical if there are multiple pieces of the mixed layer with -! the same density or if there is just a single layer. There is no -! stability limit on the time step. -! -! The key parameters for the mixed layer are found in the control structure. -! These include mstar, nstar, nstar2, pen_SW_frac, pen_SW_scale, and TKE_decay. -! For the Oberhuber (1993) mixed layer, the values of these are: -! pen_SW_frac = 0.42, pen_SW_scale = 15.0 m, mstar = 1.25, -! nstar = 1, TKE_decay = 2.5, conv_decay = 0.5 -! TKE_decay is 1/kappa in eq. 28 of Oberhuber (1993), while conv_decay is 1/mu. -! Conv_decay has been eliminated in favor of the well-calibrated form for the -! efficiency of penetrating convection from Wang (2003). -! For a traditional Kraus-Turner mixed layer, the values are: -! pen_SW_frac = 0.0, pen_SW_scale = 0.0 m, mstar = 1.25, -! nstar = 0.4, TKE_decay = 0.0, conv_decay = 0.0 - -! Arguments: h_3d - Layer thickness, in m or kg m-2. (Intent in/out) -! The units of h are referred to as H below. -! (in) u_3d - Zonal velocities interpolated to h points, m s-1. -! (in) v_3d - Zonal velocities interpolated to h points, m s-1. -! (in/out) tv - A structure containing pointers to any available -! thermodynamic fields. Absent fields have NULL ptrs. -! (in) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) dt - Time increment, in s. -! (in/out) ea - The amount of fluid moved downward into a layer; this should -! be increased due to mixed layer detrainment, in the same units -! as h - usually m or kg m-2 (i.e., H). -! (in/out) eb - The amount of fluid moved upward into a layer; this should -! be increased due to mixed layer entrainment, in the same units -! as h - usually m or kg m-2 (i.e., H). -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! mixedlayer_init. -! (in) optics - The structure containing the inverse of the vertical -! absorption decay scale for penetrating shortwave -! radiation, in m-1. -! (in,opt) dt_diag - The diagnostic time step, which may be less than dt -! if there are two callse to mixedlayer, in s. -! (in,opt) last_call - if true, this is the last call to mixedlayer in the -! current time step, so diagnostics will be written. -! The default is .true. - + ! Local variiables real, dimension(SZI_(G),SZK_(GV)) :: & eaml, & ! The amount of fluid moved downward into a layer due to mixed ! mixed layer detrainment, in m. (I.e. entrainment from above.) @@ -560,7 +504,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & ! rivermix_depth = The prescribed depth over which to mix river inflow ! drho_ds = The gradient of density wrt salt at the ambient surface salinity. ! Sriver = 0 (i.e. rivers are assumed to be pure freshwater) - RmixConst = 0.5*CS%rivermix_depth * (GV%g_Earth*GV%m_to_Z) * Irho0**2 + RmixConst = 0.5*CS%rivermix_depth * (GV%g_Earth*US%m_to_Z) * Irho0**2 do i=is,ie TKE_river(i) = max(0.0, RmixConst*dR0_dS(i)* & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * S(i,1)) @@ -606,13 +550,13 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & call find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, & TKE, TKE_river, Idecay_len_TKE, cMKE, dt, Idt_diag, & - j, ksort, G, GV, CS) + j, ksort, G, GV, US, CS) ! Here the mechanically driven entrainment occurs. call mechanical_entrainment(h(:,1:), d_eb, htot, Ttot, Stot, uhtot, vhtot, & R0_tot, Rcv_tot, u, v, T(:,1:), S(:,1:), R0(:,1:), Rcv(:,1:), eps, dR0_dT, dRcv_dT, & cMKE, Idt_diag, nsw, Pen_SW_bnd, opacity_band, TKE, & - Idecay_len_TKE, j, ksort, G, GV, CS) + Idecay_len_TKE, j, ksort, G, GV, US, CS) call absorbRemainingSW(G, GV, h(:,1:), opacity_band, nsw, j, dt, CS%H_limit_fluxes, & CS%correct_absorption, CS%absorb_all_SW, & @@ -719,14 +663,14 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & ! as the third piece will then optimally describe mixed layer ! restratification. For nkml>=4 the whole strategy should be revisited. do i=is,ie - kU_Star = 0.41*GV%m_to_Z*fluxes%ustar(i,j) ! Maybe could be replaced with u*+w*? + kU_Star = 0.41*US%m_to_Z*fluxes%ustar(i,j) ! Maybe could be replaced with u*+w*? if (associated(fluxes%ustar_shelf) .and. & associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & kU_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * kU_star + & - fluxes%frac_shelf_h(i,j) * (0.41*GV%m_to_Z*fluxes%ustar_shelf(i,j)) + fluxes%frac_shelf_h(i,j) * (0.41*US%m_to_Z*fluxes%ustar_shelf(i,j)) endif - absf_x_H = 0.25 * GV%m_to_Z * h(i,0) * & !### I think this should be H_to_Z -RWH + absf_x_H = 0.25 * US%m_to_Z * h(i,0) * & !### I think this should be H_to_Z -RWH ((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) ! If the mixed layer vertical viscosity specification is changed in @@ -1353,9 +1297,10 @@ end subroutine mixedlayer_convection !! convection to drive mechanical entrainment. subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, & TKE, TKE_river, Idecay_len_TKE, cMKE, dt, Idt_diag, & - j, ksort, G, GV, CS) + j, ksort, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G)), intent(in) :: htot !< The accumlated mixed layer thickness, in H !! (often m or kg m-2). real, dimension(SZI_(G)), intent(in) :: h_CA !< The mixed layer depth after convective @@ -1423,11 +1368,11 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (CS%omega_frac >= 1.0) absf = 2.0*CS%omega do i=is,ie - U_Star = GV%m_to_Z * fluxes%ustar(i,j) + U_Star = US%m_to_Z * fluxes%ustar(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & U_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & - fluxes%frac_shelf_h(i,j) * GV%m_to_Z * fluxes%ustar_shelf(i,j) + fluxes%frac_shelf_h(i,j) * US%m_to_Z * fluxes%ustar_shelf(i,j) endif if (U_Star < CS%ustar_min) U_Star = CS%ustar_min @@ -1465,7 +1410,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (Conv_En(i) < 0.0) Conv_En(i) = 0.0 if (cTKE(i,1) > 0.0) then ; TKE_CA = cTKE(i,1) ; else ; TKE_CA = 0.0 ; endif if ((htot(i) >= h_CA(i)) .or. (TKE_CA == 0.0)) then - totEn_Z = GV%m_to_Z**2 * (Conv_En(i) + TKE_CA) + totEn_Z = US%m_to_Z**2 * (Conv_En(i) + TKE_CA) if (totEn_Z > 0.0) then nstar_FC = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & @@ -1477,14 +1422,14 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, else ! This reconstructs the Buoyancy flux within the topmost htot of water. if (Conv_En(i) > 0.0) then - totEn_Z = GV%m_to_Z**2 * (Conv_En(i) + TKE_CA * (htot(i) / h_CA(i)) ) + totEn_Z = US%m_to_Z**2 * (Conv_En(i) + TKE_CA * (htot(i) / h_CA(i)) ) nstar_FC = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_FC = CS%nstar endif - totEn_Z = GV%m_to_Z**2 * (Conv_En(i) + TKE_CA) + totEn_Z = US%m_to_Z**2 * (Conv_En(i) + TKE_CA) if (TKE_CA > 0.0) then nstar_CA = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & sqrt(0.5 * dt * (absf*(h_CA(i)*GV%H_to_Z))**3 * totEn_Z)) @@ -1539,9 +1484,10 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & R0_tot, Rcv_tot, u, v, T, S, R0, Rcv, eps, & dR0_dT, dRcv_dT, cMKE, Idt_diag, nsw, & Pen_SW_bnd, opacity_band, TKE, & - Idecay_len_TKE, j, ksort, G, GV, CS) + Idecay_len_TKE, j, ksort, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZK_(GV)), & intent(inout) :: h !< Layer thickness, in m or kg m-2. !! The units of h are referred to as H below. @@ -1737,7 +1683,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & endif TKE(i) = TKE_full_ent - if (TKE(i) <= 0.0) TKE(i) = 1.0e-150*GV%m_to_Z + if (TKE(i) <= 0.0) TKE(i) = 1.0e-150*US%m_to_Z else ! The layer is only partially entrained. The amount that will be ! entrained is determined iteratively. No further layers will be @@ -3539,10 +3485,11 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e end subroutine mixedlayer_detrain_1 !> This subroutine initializes the MOM bulk mixed layer module. -subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) +subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) type(time_type), target, intent(in) :: Time !< The model's clock with the current time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(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 @@ -3681,7 +3628,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) "The minimum value of ustar that should be used by the \n"//& "bulk mixed layer model in setting vertical TKE decay \n"//& "scales. This must be greater than 0.", units="m s-1", & - default=ustar_min_dflt, scale=GV%m_to_Z) + default=ustar_min_dflt, scale=US%m_to_Z) if (CS%ustar_min<=0.0) call MOM_error(FATAL, "BML_USTAR_MIN must be positive.") call get_param(param_file, mdl, "RESOLVE_EKMAN", CS%Resolve_Ekman, & @@ -3702,7 +3649,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) if (CS%do_rivermix) & call get_param(param_file, mdl, "RIVERMIX_DEPTH", CS%rivermix_depth, & "The depth to which rivers are mixed if DO_RIVERMIX is \n"//& - "defined.", units="m", default=0.0, scale=GV%m_to_Z) + "defined.", units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, & "If true, use the fluxes%runoff_Hflx field to set the \n"//& "heat carried by runoff, instead of using SST*CP*liq_runoff.", & diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 119e3dbb30..d6406a7c4a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -16,6 +16,7 @@ module MOM_diabatic_aux use MOM_forcing_type, only : forcing, extractFluxes1d, forcing_SinglePointPrint use MOM_grid, only : ocean_grid_type use MOM_shortwave_abs, only : absorbRemainingSW, optics_type, sumSWoverBands +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type! , accel_diag_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -645,9 +646,10 @@ end subroutine find_uv_at_h !> Diagnose a mixed layer depth (MLD) determined by a given density difference with the surface. !> This routine is appropriate in MOM_diabatic_driver due to its position within the time stepping. -subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, diagPtr, id_N2subML, id_MLDsq) +subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, diagPtr, id_N2subML, id_MLDsq) type(ocean_grid_type), intent(in) :: G !< Grid type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: id_MLD !< Handle (ID) of MLD diagnostic real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thickness, in H (usually m or kg m-3) @@ -678,8 +680,8 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia id_SQ = -1 ; if (PRESENT(id_N2subML)) id_SQ = id_MLDsq Rho_x_gE = GV%g_Earth * GV%Rho0 - gE_rho0 = GV%m_to_Z**2 * GV%g_Earth / GV%Rho0 - dz_subML = 50.*GV%m_to_Z + gE_rho0 = US%m_to_Z**2 * GV%g_Earth / GV%Rho0 + dz_subML = 50.*US%m_to_Z is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke pRef_MLD(:) = 0. ; pRef_N2(:) = 0. @@ -761,13 +763,14 @@ end subroutine diagnoseMLDbyDensityDifference !> Update the thickness, temperature, and salinity due to thermodynamic !! boundary forcing (contained in fluxes type) applied to h, tv%T and tv%S, !! and calculate the TKE implications of this heating. -subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & +subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & aggregate_FW_forcing, evap_CFL_limit, & minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, & SkinBuoyFlux ) type(diabatic_aux_CS), pointer :: CS !< Control structure for diabatic_aux type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: dt !< Time-step over which forcing is applied (s) type(forcing), intent(inout) :: fluxes !< Surface fluxes container type(optics_type), pointer :: optics !< Optical properties container @@ -1256,7 +1259,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & ! 3. Convert to a buoyancy flux, excluding penetrating SW heating ! BGR-Jul 5, 2017: The contribution of SW heating here needs investigated for ePBL. do i=is,ie - SkinBuoyFlux(i,j) = - GoRho * GV%H_to_Z * GV%m_to_Z**2 * ( & + SkinBuoyFlux(i,j) = - GoRho * GV%H_to_Z * US%m_to_Z**2 * ( & dRhodS(i) * (netSalt_rate(i) - tv%S(i,j,1)*netMassInOut_rate(i)) + & dRhodT(i) * ( netHeat_rate(i) + netPen(i,1)) ) ! m^2/s^3 enddo @@ -1290,10 +1293,11 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & end subroutine applyBoundaryFluxesInOut !> This subroutine initializes the parameters and control structure of the diabatic_aux module. -subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm, use_ePBL) +subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgorithm, use_ePBL) type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(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 used to regulate diagnostic output type(diabatic_aux_CS), pointer :: CS !< A pointer to the control structure for the @@ -1352,7 +1356,7 @@ subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm, if (CS%do_rivermix) & call get_param(param_file, mdl, "RIVERMIX_DEPTH", CS%rivermix_depth, & "The depth to which rivers are mixed if DO_RIVERMIX is \n"//& - "defined.", units="m", default=0.0, scale=GV%m_to_Z) + "defined.", units="m", default=0.0, scale=US%m_to_Z) else ; CS%do_rivermix = .false. ; CS%rivermix_depth = 0.0 ; endif if (GV%nkml == 0) then call get_param(param_file, mdl, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, & diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 2fd7550083..6e6c705d45 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -64,6 +64,7 @@ module MOM_diabatic_driver use MOM_time_manager, only : time_type, real_to_time, operator(-), operator(<=) use MOM_tracer_flow_control, only : call_tracer_column_fns, tracer_flow_control_CS use MOM_tracer_diabatic, only : tracer_vertdiff +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type, accel_diag_ptrs use MOM_variables, only : cont_diag_ptrs, MOM_thermovar_chksum, p3d use MOM_verticalGrid, only : verticalGrid_type @@ -260,9 +261,10 @@ module MOM_diabatic_driver !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, CS, WAVES) + G, GV, US, CS, WAVES) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity (m/s) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity (m/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness (m for Bouss / kg/m2 for non-Bouss) @@ -407,7 +409,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) if (CS%id_e_predia > 0) then - call find_eta(h, tv, G, GV, eta, eta_to_m=1.0) + call find_eta(h, tv, G, GV, US, eta, eta_to_m=1.0) call post_data(CS%id_e_predia, eta, CS%diag) endif @@ -428,7 +430,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G) if (CS%debug_energy_req) & - call diapyc_energy_req_test(h, dt, tv, G, GV, CS%diapyc_en_rec_CSp) + call diapyc_energy_req_test(h, dt, tv, G, GV, US, CS%diapyc_en_rec_CSp) call cpu_clock_begin(id_clock_set_diffusivity) @@ -512,7 +514,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! tide module (BDM). ! PROVIDE ENERGY DISTRIBUTION (calculate time-varying energy source) - call set_int_tide_input(u, v, h, tv, fluxes, CS%int_tide_input, dt, G, GV, & + call set_int_tide_input(u, v, h, tv, fluxes, CS%int_tide_input, dt, G, GV, US, & CS%int_tide_input_CSp) ! CALCULATE MODAL VELOCITIES cn(:,:,:) = 0.0 @@ -520,7 +522,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! SET TO CONSTANT VALUE TO TEST PROPAGATE CODE do m=1,CS%nMode ; cn(:,:,m) = CS%cg_test ; enddo else - call wave_speeds(h, tv, G, GV, CS%nMode, cn, full_halos=.true.) + call wave_speeds(h, tv, G, GV, US, CS%nMode, cn, full_halos=.true.) ! uncomment the lines below for a hard-coded cn that changes linearly with latitude !do j=G%jsd,G%jed ; do i=G%isd,G%ied ! cn(i,j,:) = ((7.-1.)/14000000.)*G%geoLatBu(i,j) + (1.-((7.-1.)/14000000.)*-7000000.) @@ -543,11 +545,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif ! CALL ROUTINE USING PRESCRIBED KE FOR TESTING call propagate_int_tide(h, tv, cn, TKE_itidal_input_test, & - CS%int_tide_input%tideamp, CS%int_tide_input%Nb, dt, G, GV, CS%int_tide_CSp) + CS%int_tide_input%tideamp, CS%int_tide_input%Nb, dt, G, GV, US, & + CS%int_tide_CSp) else ! CALL ROUTINE USING CALCULATED KE INPUT call propagate_int_tide(h, tv, cn, CS%int_tide_input%TKE_itidal_input, & - CS%int_tide_input%tideamp, CS%int_tide_input%Nb, dt, G, GV, CS%int_tide_CSp) + CS%int_tide_input%tideamp, CS%int_tide_input%Nb, dt, G, GV, US, & + CS%int_tide_CSp) endif if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") endif ! end CS%use_int_tides @@ -555,8 +559,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call cpu_clock_begin(id_clock_set_diffusivity) ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S ! Also changes: visc%Kd_shear, visc%Kv_slow and visc%TKE_turb (not clear that TKE_turb is used as input ???? - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, CS%set_diff_CSp, & - Kd_lay, Kd_int) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, & + CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -601,14 +605,14 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! Sets: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux ! NOTE: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux are returned as rates (i.e. stuff per second) ! unlike other instances where the fluxes are integrated in time over a time-step. - call calculateBuoyancyFlux2d(G, GV, fluxes, CS%optics, h, tv%T, tv%S, tv, & + call calculateBuoyancyFlux2d(G, GV, US, fluxes, CS%optics, h, tv%T, tv%S, tv, & CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) ! The KPP scheme calculates boundary layer diffusivities and non-local transport. - call KPP_compute_BLD(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, & + call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv%eqn_of_state, & fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) - call KPP_calculate(CS%KPP_CSp, G, GV, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & + call KPP_calculate(CS%KPP_CSp, G, GV, US, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) if (associated(Hml)) then @@ -682,7 +686,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! Calculate vertical mixing due to convection (computed via CVMix) if (CS%use_CVMix_conv) then - call calculate_CVMix_conv(h, tv, G, GV, CS%CVMix_conv_csp, Hml) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_csp, Hml) ! Increment vertical diffusion and viscosity due to convection !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie @@ -715,7 +719,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%use_energetic_PBL) then skinbuoyflux(:,:) = 0.0 - call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, dt, fluxes, CS%optics, & + call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux) @@ -730,7 +734,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV) - call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, & + call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then @@ -768,7 +772,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif else - call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, dt, fluxes, CS%optics, & + call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & h, tv, CS%aggregate_FW_forcing, & CS%evap_CFL_limit, CS%minimum_forcing_depth) @@ -1015,7 +1019,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call cpu_clock_begin(id_clock_sponge) if (associated(CS%ALE_sponge_CSp)) then ! ALE sponge - call apply_ALE_sponge(h, dt, G, GV, CS%ALE_sponge_CSp, CS%Time) + call apply_ALE_sponge(h, dt, G, GV, US, CS%ALE_sponge_CSp, CS%Time) endif call cpu_clock_end(id_clock_sponge) @@ -1087,14 +1091,14 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%id_dvdt_dia > 0) call post_data(CS%id_dvdt_dia, ADp%dv_dt_dia, CS%diag) if (CS%id_MLD_003 > 0 .or. CS%id_subMLN2 > 0 .or. CS%id_mlotstsq > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03, G, GV, CS%diag, & + call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03, G, GV, US, CS%diag, & id_N2subML=CS%id_subMLN2, id_MLDsq=CS%id_mlotstsq) endif if (CS%id_MLD_0125 > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125, G, GV, CS%diag) + call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125, G, GV, US, CS%diag) endif if (CS%id_MLD_user > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_user, h, tv, CS%MLDdensityDifference, G, GV, CS%diag) + call diagnoseMLDbyDensityDifference(CS%id_MLD_user, h, tv, CS%MLDdensityDifference, G, GV, US, CS%diag) endif if (CS%id_Tdif > 0) call post_data(CS%id_Tdif, Tdif_flx, CS%diag) @@ -1143,9 +1147,10 @@ end subroutine diabatic !> Imposes the diapycnal mass fluxes and the accompanying diapycnal advection of momentum and tracers !! using the original MOM6 algorithms. subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, CS, WAVES) + G, GV, US, CS, WAVES) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity (m/s) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity (m/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness (m for Bouss / kg/m2 for non-Bouss) @@ -1285,7 +1290,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) if (CS%id_e_predia > 0) then - call find_eta(h, tv, G, GV, eta, eta_to_m=1.0) + call find_eta(h, tv, G, GV, US, eta, eta_to_m=1.0) call post_data(CS%id_e_predia, eta, CS%diag) endif @@ -1305,7 +1310,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G) if (CS%debug_energy_req) & - call diapyc_energy_req_test(h, dt, tv, G, GV, CS%diapyc_en_rec_CSp) + call diapyc_energy_req_test(h, dt, tv, G, GV, US, CS%diapyc_en_rec_CSp) call cpu_clock_begin(id_clock_set_diffusivity) call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS%set_diff_CSp) @@ -1385,7 +1390,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%ML_mix_first < 1.0) then ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt*CS%ML_mix_first, & - eaml,ebml, G, GV, CS%bulkmixedlayer_CSp, CS%optics, & + eaml,ebml, G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & Hml, CS%aggregate_FW_forcing, dt, last_call=.false.) if (CS%salt_reject_below_ML) & call insert_brine(h, tv, G, GV, fluxes, nkmb, CS%diabatic_aux_CSp, & @@ -1393,8 +1398,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en else ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt, eaml, ebml, & - G, GV, CS%bulkmixedlayer_CSp, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) + G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & + Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) endif ! Keep salinity from falling below a small but positive threshold. @@ -1436,7 +1441,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! tide module (BDM). ! PROVIDE ENERGY DISTRIBUTION (calculate time-varying energy source) - call set_int_tide_input(u, v, h, tv, fluxes, CS%int_tide_input, dt, G, GV, & + call set_int_tide_input(u, v, h, tv, fluxes, CS%int_tide_input, dt, G, GV, US, & CS%int_tide_input_CSp) ! CALCULATE MODAL VELOCITIES cn(:,:,:) = 0.0 @@ -1444,7 +1449,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! SET TO CONSTANT VALUE TO TEST PROPAGATE CODE do m=1,CS%nMode ; cn(:,:,m) = CS%cg_test ; enddo else - call wave_speeds(h, tv, G, GV, CS%nMode, cn, full_halos=.true.) + call wave_speeds(h, tv, G, GV, US, CS%nMode, cn, full_halos=.true.) ! uncomment the lines below for a hard-coded cn that changes linearly with latitude !do j=G%jsd,G%jed ; do i=G%isd,G%ied ! cn(i,j,:) = ((7.-1.)/14000000.)*G%geoLatBu(i,j) + (1.-((7.-1.)/14000000.)*-7000000.) @@ -1466,12 +1471,12 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en enddo ; enddo endif ! CALL ROUTINE USING PRESCRIBED KE FOR TESTING - call propagate_int_tide(h, tv, cn, TKE_itidal_input_test, & - CS%int_tide_input%tideamp, CS%int_tide_input%Nb, dt, G, GV, CS%int_tide_CSp) + call propagate_int_tide(h, tv, cn, TKE_itidal_input_test, CS%int_tide_input%tideamp, & + CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) else ! CALL ROUTINE USING CALCULATED KE INPUT - call propagate_int_tide(h, tv, cn, CS%int_tide_input%TKE_itidal_input, & - CS%int_tide_input%tideamp, CS%int_tide_input%Nb, dt, G, GV, CS%int_tide_CSp) + call propagate_int_tide(h, tv, cn, CS%int_tide_input%TKE_itidal_input, CS%int_tide_input%tideamp, & + CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) endif if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") endif @@ -1485,8 +1490,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (associated(tv%T)) call pass_var(tv%S, G%Domain, halo=CS%halo_TS_diff, complete=.false.) call pass_var(h, G%domain, halo=CS%halo_TS_diff, complete=.true.) endif - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, CS%set_diff_CSp, & - Kd_lay, Kd_int) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, & + CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -1506,7 +1511,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! Sets: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux ! NOTE: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux are returned as rates (i.e. stuff per second) ! unlike other instances where the fluxes are integrated in time over a time-step. - call calculateBuoyancyFlux2d(G, GV, fluxes, CS%optics, h, tv%T, tv%S, tv, & + call calculateBuoyancyFlux2d(G, GV, US, fluxes, CS%optics, h, tv%T, tv%S, tv, & CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) ! The KPP scheme calculates boundary layer diffusivities and non-local transport. @@ -1528,11 +1533,11 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en enddo ; enddo ; enddo endif - call KPP_compute_BLD(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, & - fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) + call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv%eqn_of_state, & + fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) - call KPP_calculate(CS%KPP_CSp, G, GV, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & - Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) + call KPP_calculate(CS%KPP_CSp, G, GV, US, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & + Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) if (associated(Hml)) then call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G) @@ -1574,7 +1579,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! Add vertical diff./visc. due to convection (computed via CVMix) if (CS%use_CVMix_conv) then - call calculate_CVMix_conv(h, tv, G, GV, CS%CVMix_conv_csp, Hml) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_csp, Hml) !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !### The vertical extent here is more limited that Kv_slow or Kd_int; it might be k=1,nz+1. @@ -1660,7 +1665,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call cpu_clock_begin(id_clock_entrain) ! Calculate appropriately limited diapycnal mass fluxes to account ! for diapycnal diffusion and advection. Sets: ea, eb. Changes: kb - call Entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS%entrain_diffusive_CSp, & + call Entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS%entrain_diffusive_CSp, & ea, eb, kb, Kd_Lay=Kd_lay, Kd_int=Kd_int) call cpu_clock_end(id_clock_entrain) if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)") @@ -1696,7 +1701,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%use_energetic_PBL) then skinbuoyflux(:,:) = 0.0 - call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, dt, fluxes, CS%optics, & + call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux) @@ -1709,7 +1714,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV) - call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, & + call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) ! If visc%MLD exists, copy the ePBL's MLD into it @@ -1748,7 +1753,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en endif else - call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, dt, fluxes, CS%optics, & + call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & h, tv, CS%aggregate_FW_forcing, & CS%evap_CFL_limit, CS%minimum_forcing_depth) @@ -1940,8 +1945,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call cpu_clock_begin(id_clock_mixedlayer) ! Changes: h, tv%T, tv%S, ea and eb (G is also inout???) call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_mix, ea, eb, & - G, GV, CS%bulkmixedlayer_CSp, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) + G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & + Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) if (CS%salt_reject_below_ML) & call insert_brine(h, tv, G, GV, fluxes, nkmb, CS%diabatic_aux_CSp, dt_mix, & @@ -2174,7 +2179,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call cpu_clock_begin(id_clock_sponge) if (associated(CS%ALE_sponge_CSp)) then ! ALE sponge - call apply_ALE_sponge(h, dt, G, GV, CS%ALE_sponge_CSp, CS%Time) + call apply_ALE_sponge(h, dt, G, GV, US, CS%ALE_sponge_CSp, CS%Time) else ! Layer mode sponge if (CS%bulkmixedlayer .and. associated(tv%eqn_of_state)) then @@ -2380,14 +2385,14 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%id_wd > 0) call post_data(CS%id_wd, CDp%diapyc_vel, CS%diag) if (CS%id_MLD_003 > 0 .or. CS%id_subMLN2 > 0 .or. CS%id_mlotstsq > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03, G, GV, CS%diag, & + call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03, G, GV, US, CS%diag, & id_N2subML=CS%id_subMLN2, id_MLDsq=CS%id_mlotstsq) endif if (CS%id_MLD_0125 > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125, G, GV, CS%diag) + call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125, G, GV, US, CS%diag) endif if (CS%id_MLD_user > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_user, h, tv, CS%MLDdensityDifference, G, GV, CS%diag) + call diagnoseMLDbyDensityDifference(CS%id_MLD_user, h, tv, CS%MLDdensityDifference, G, GV, US, CS%diag) endif if (CS%id_Tdif > 0) call post_data(CS%id_Tdif, Tdif_flx, CS%diag) @@ -2744,12 +2749,13 @@ end subroutine adiabatic_driver_init !> This routine initializes the diabatic driver module. -subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, & +subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, diag, & ADp, CDp, CS, tracer_flow_CSp, sponge_CSp, & ALE_sponge_CSp, diag_to_Z_CSp) type(time_type), target :: Time !< model time type(ocean_grid_type), intent(inout) :: G !< model grid structure type(verticalGrid_type), intent(in) :: GV !< model vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< file to parse for parameter values logical, intent(in) :: useALEalgorithm !< logical for whether to use ALE remapping type(diag_ctrl), target, intent(inout) :: diag !< structure to regulate diagnostic output @@ -2918,12 +2924,12 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, call get_param(param_file, mdl, "KD_MIN_TR", CS%Kd_min_tr, & "A minimal diffusivity that should always be applied to \n"//& "tracers, especially in massless layers near the bottom. \n"//& - "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd, scale=GV%m_to_Z**2) + "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd, scale=US%m_to_Z**2) call get_param(param_file, mdl, "KD_BBL_TR", CS%Kd_BBL_tr, & "A bottom boundary layer tracer diffusivity that will \n"//& "allow for explicitly specified bottom fluxes. The \n"//& "entrainment at the bottom is at least sqrt(Kd_BBL_tr*dt) \n"//& - "over the same distance.", units="m2 s-1", default=0., scale=GV%m_to_Z**2) + "over the same distance.", units="m2 s-1", default=0., scale=US%m_to_Z**2) endif call get_param(param_file, mdl, "TRACER_TRIDIAG", CS%tracer_tridiag, & @@ -3272,7 +3278,8 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, endif ! CS%use_tidal_mixing is set to True if an internal tidal dissipation scheme is to be used. - CS%use_tidal_mixing = tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, CS%tidal_mixing_CSp) + CS%use_tidal_mixing = tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_CSp, & + CS%tidal_mixing_CSp) ! CS%use_CVMix_conv is set to True if CVMix convection will be used, otherwise ! False. @@ -3286,13 +3293,13 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, ! initialize module for internal tide induced mixing if (CS%use_int_tides) then - call int_tide_input_init(Time, G, GV, param_file, diag, CS%int_tide_input_CSp, & + call int_tide_input_init(Time, G, GV, US, param_file, diag, CS%int_tide_input_CSp, & CS%int_tide_input) call internal_tides_init(Time, G, GV, param_file, diag, CS%int_tide_CSp) endif ! initialize module for setting diffusivities - call set_diffusivity_init(Time, G, GV, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, & + call set_diffusivity_init(Time, G, GV, US, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, & CS%int_tide_CSp, CS%tidal_mixing_CSp, CS%halo_TS_diff) @@ -3314,14 +3321,14 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, id_clock_differential_diff = cpu_clock_id('(Ocean differential diffusion)', grain=CLOCK_ROUTINE) ! initialize the auxiliary diabatic driver module - call diabatic_aux_init(Time, G, GV, param_file, diag, CS%diabatic_aux_CSp, & + call diabatic_aux_init(Time, G, GV, US, param_file, diag, CS%diabatic_aux_CSp, & CS%useALEalgorithm, CS%use_energetic_PBL) ! initialize the boundary layer modules if (CS%bulkmixedlayer) & - call bulkmixedlayer_init(Time, G, GV, param_file, diag, CS%bulkmixedlayer_CSp) + call bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS%bulkmixedlayer_CSp) if (CS%use_energetic_PBL) & - call energetic_PBL_init(Time, G, GV, param_file, diag, CS%energetic_PBL_CSp) + call energetic_PBL_init(Time, G, GV, US, param_file, diag, CS%energetic_PBL_CSp) call regularize_layers_init(Time, G, GV, param_file, diag, CS%regularize_layers_CSp) diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 293e6db90a..80651ca593 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -9,6 +9,7 @@ module MOM_diapyc_energy_req use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_specific_vol_derivs, calculate_density @@ -40,9 +41,10 @@ module MOM_diapyc_energy_req !> This subroutine helps test the accuracy of the diapycnal mixing energy requirement code !! by writing diagnostics, possibly using an intensely mixing test profile of diffusivity -subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, CS, Kd_int) +subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(G%isd:G%ied,G%jsd:G%jed,GV%ke), & intent(in) :: h_3d !< Layer thickness before entrainment, in H. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any @@ -88,7 +90,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, CS, Kd_int) h_bot(K) = h_bot(K+1) + h_col(k) enddo - ustar = 0.01*GV%m_to_Z ! Change this to being an input parameter? + ustar = 0.01*US%m_to_Z ! Change this to being an input parameter? absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J)))) Kd(1) = 0.0 ; Kd(nz+1) = 0.0 @@ -99,7 +101,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, CS, Kd_int) enddo endif may_print = is_root_PE() .and. (i==ie) .and. (j==je) - call diapyc_energy_req_calc(h_col, T0, S0, Kd, energy_Kd, dt, tv, G, GV, & + call diapyc_energy_req_calc(h_col, T0, S0, Kd, energy_Kd, dt, tv, G, GV, US, & may_print=may_print, CS=CS) endif ; enddo ; enddo @@ -112,9 +114,10 @@ end subroutine diapyc_energy_req_test !! The various estimates are taken because they will later be used as templates !! for other bits of code subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & - G, GV, may_print, CS) + G, GV, US, may_print, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(GV%ke), intent(in) :: h_in !< Layer thickness before entrainment, !! in H (m or kg m-2). real, dimension(GV%ke), intent(in) :: T_in !< The layer temperatures, in degC. @@ -298,8 +301,8 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & dPres = GV%H_to_Pa * h_tr(k) dT_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dT(k) dS_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dS(k) - dT_to_dColHt(k) = dMass * GV%m_to_Z * dSV_dT(k) * CS%ColHt_scaling - dS_to_dColHt(k) = dMass * GV%m_to_Z * dSV_dS(k) * CS%ColHt_scaling + dT_to_dColHt(k) = dMass * US%m_to_Z * dSV_dT(k) * CS%ColHt_scaling + dS_to_dColHt(k) = dMass * US%m_to_Z * dSV_dS(k) * CS%ColHt_scaling enddo ! PE_chg_k(1) = 0.0 ; PE_chg_k(nz+1) = 0.0 @@ -934,7 +937,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & do K=2,nz call calculate_density(0.5*(T0(k-1) + T0(k)), 0.5*(S0(k-1) + S0(k)), & pres(K), rho_here, tv%eqn_of_state) - N2(K) = ((GV%g_Earth*GV%m_to_Z**2) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & + N2(K) = ((GV%g_Earth*US%m_to_Z**2) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (T0(k-1) - T0(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (S0(k-1) - S0(k)) ) enddo @@ -945,7 +948,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & do K=2,nz call calculate_density(0.5*(Tf(k-1) + Tf(k)), 0.5*(Sf(k-1) + Sf(k)), & pres(K), rho_here, tv%eqn_of_state) - N2(K) = ((GV%g_Earth*GV%m_to_Z**2) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & + N2(K) = ((GV%g_Earth*US%m_to_Z**2) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (Tf(k-1) - Tf(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (Sf(k-1) - Sf(k)) ) enddo diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 7928ebad50..1f664deb5a 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -11,6 +11,7 @@ module MOM_energetic_PBL use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_forcing_type, only : forcing use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only: wave_parameters_CS, Get_Langmuir_Number @@ -177,11 +178,12 @@ module MOM_energetic_PBL !! mixed layer model. It assumes that heating, cooling and freshwater fluxes !! have already been applied. All calculations are done implicitly, and there !! is no stability limit on the time step. -subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & +subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & dSV_dT, dSV_dS, TKE_forced, Buoy_Flux, dt_diag, last_call, & dT_expected, dS_expected, waves ) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h_3d !< Layer thicknesses, in H (usually m or kg m-2). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -601,12 +603,12 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & ! interface. do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then - U_star = GV%m_to_Z*fluxes%ustar(i,j) + U_star = US%m_to_Z*fluxes%ustar(i,j) U_Star_Mean = fluxes%ustar_gustless(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & U_star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & - fluxes%frac_shelf_h(i,j) * GV%m_to_Z*fluxes%ustar_shelf(i,j) + fluxes%frac_shelf_h(i,j) * US%m_to_Z*fluxes%ustar_shelf(i,j) endif if (U_Star < CS%ustar_min) U_Star = CS%ustar_min @@ -682,11 +684,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & pres(i,1) = 0.0 ; pres_Z(i,1) = 0.0 do k=1,nz dMass = GV%H_to_kg_m2 * h(i,k) - dPres = (GV%g_Earth*GV%m_to_Z) * dMass ! This is equivalent to GV%H_to_Pa * h(i,k) + dPres = (GV%g_Earth*US%m_to_Z) * dMass ! This is equivalent to GV%H_to_Pa * h(i,k) dT_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dT(i,j,k) dS_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dS(i,j,k) - dT_to_dColHt(i,k) = dMass * GV%m_to_Z * dSV_dT(i,j,k) - dS_to_dColHt(i,k) = dMass * GV%m_to_Z * dSV_dS(i,j,k) + dT_to_dColHt(i,k) = dMass * US%m_to_Z * dSV_dT(i,j,k) + dS_to_dColHt(i,k) = dMass * US%m_to_Z * dSV_dS(i,j,k) pres(i,K+1) = pres(i,K) + dPres pres_Z(i,K+1) = GV%Z_to_m * pres(i,K+1) @@ -712,7 +714,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & !/BGR: Add MLD_guess based on stored previous value. ! note that this is different from ML_Depth already ! computed by EPBL, need to figure out why. - if (CS%MLD_iteration_guess .and. (CS%ML_Depth2(i,j) > 1.0*GV%m_to_Z)) then + if (CS%MLD_iteration_guess .and. (CS%ML_Depth2(i,j) > 1.0*US%m_to_Z)) then !If prev value is present use for guess. MLD_guess = CS%ML_Depth2(i,j) else @@ -781,14 +783,14 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & ! Adjustment for unstable buoyancy flux. ! Convection reduces mechanical mixing because there ! is less density gradient to mix. (Statically unstable near surface) - MSTAR_Conv_Adj = 1. - CS%CNV_MST_FAC * (-BF_Unstable + 1.e-10*GV%m_to_Z**2) / & - ( (-Bf_Unstable + 1.e-10*GV%m_to_Z**2) + & + MSTAR_Conv_Adj = 1. - CS%CNV_MST_FAC * (-BF_Unstable + 1.e-10*US%m_to_Z**2) / & + ( (-Bf_Unstable + 1.e-10*US%m_to_Z**2) + & 2.0 *MSTAR_MIX * U_star**3 / MLD_guess ) - ! MSTAR_Conv_Adj = 1. - CS%CNV_MST_FAC * ((-BF_Unstable + 1.e-10*GV%m_to_Z**2)*MLD_guess) / & - ! ( (-Bf_Unstable + 1.e-10*GV%m_to_Z**2)*MLD_guess + & + ! MSTAR_Conv_Adj = 1. - CS%CNV_MST_FAC * ((-BF_Unstable + 1.e-10*US%m_to_Z**2)*MLD_guess) / & + ! ( (-Bf_Unstable + 1.e-10*US%m_to_Z**2)*MLD_guess + & ! 2.0*MSTAR_MIX * U_star**3 ) if (CS%USE_LT) then - call get_Langmuir_Number( LA, G, GV, abs(MLD_guess), u_star_mean, i, j, & + call get_Langmuir_Number( LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, & H=H(i,:), U_H=U(i,:), V_H=V(i,:), WAVES=WAVES) ! 2. Get parameters for modified LA MLD_o_Ekman = abs(MLD_guess * iL_Ekman) @@ -1379,7 +1381,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, CS, & !This is how the iteration was original conducted do k=2,nz if (FIRST_OBL) then !Breaks when OBL found - if ((Vstar_Used(k) > 1.e-10*GV%m_to_Z) .and. k < nz) then + if ((Vstar_Used(k) > 1.e-10*US%m_to_Z) .and. k < nz) then MLD_found = MLD_found + h(i,k-1)*GV%H_to_Z else FIRST_OBL = .false. @@ -1862,9 +1864,10 @@ subroutine energetic_PBL_get_MLD(CS, MLD, G, GV, m_to_MLD_units) end subroutine energetic_PBL_get_MLD !> Computes wind speed from ustar_air based on COARE 3.5 Cd relationship -subroutine ust_2_u10_coare3p5(USTair,U10,GV) +subroutine ust_2_u10_coare3p5(USTair, U10, GV, US) real, intent(in) :: USTair !< Ustar in the air, in m s-1. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(out) :: U10 !< The 10 m wind speed, in m s-1. real, parameter :: vonkar = 0.4 @@ -1887,7 +1890,7 @@ subroutine ust_2_u10_coare3p5(USTair,U10,GV) CT=CT+1 u10a = u10 alpha = min(0.028,0.0017 * u10 - 0.005) - z0rough = alpha * USTair**2/(GV%g_Earth*GV%m_to_Z) ! Compute z0rough from ustar guess + z0rough = alpha * USTair**2/(GV%g_Earth*US%m_to_Z) ! Compute z0rough from ustar guess z0=z0sm+z0rough CD = ( vonkar / log(10/z0) )**2 ! Compute CD from derived roughness u10 = USTair/sqrt(CD);!Compute new u10 from derived CD, while loop @@ -1907,10 +1910,11 @@ end subroutine ust_2_u10_coare3p5 !> This subroutine returns the Langmuir number, given ustar and the boundary !! layer thickness, inclusion conversion to the 10m wind. -subroutine get_LA_windsea(ustar, hbl, GV, LA) +subroutine get_LA_windsea(ustar, hbl, GV, US, LA) real, intent(in) :: ustar !< The water-side surface friction velocity (m/s) real, intent(in) :: hbl !< The ocean boundary layer depth (m) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(out) :: LA !< The Langmuir number returned from this module ! Original description: ! This function returns the enhancement factor, given the 10-meter @@ -1938,22 +1942,22 @@ subroutine get_LA_windsea(ustar, hbl, GV, LA) us_to_u10 = 0.0162, & ! loss ratio of Stokes transport r_loss = 0.667 - real :: us, hm0, fm, fp, vstokes, kphil, kstar + real :: uStokes, hm0, fm, fp, vstokes, kphil, kstar real :: z0, z0i, r1, r2, r3, r4, tmp, us_sl, lasl_sqr_i real :: pi, u10 pi = 4.0*atan(1.0) if (ustar > 0.0) then ! Computing u10 based on ustar and COARE 3.5 relationships - call ust_2_u10_coare3p5(ustar * sqrt(GV%Rho0/1.225), U10, GV) + call ust_2_u10_coare3p5(ustar * sqrt(GV%Rho0/1.225), U10, GV, US) ! surface Stokes drift - us = us_to_u10*u10 + uStokes = us_to_u10*u10 ! significant wave height from Pierson-Moskowitz spectrum (Bouws, 1998) hm0 = 0.0246 *u10**2 ! peak frequency (PM, Bouws, 1998) tmp = 2.0 * PI * u19p5_to_u10 * u10 - fp = 0.877 * (GV%g_Earth*GV%m_to_Z) / tmp + fp = 0.877 * (GV%g_Earth*US%m_to_Z) / tmp ! mean frequency fm = fm_to_fp * fp @@ -1966,7 +1970,7 @@ subroutine get_LA_windsea(ustar, hbl, GV, LA) ! ! the general peak wavenumber for Phillips' spectrum ! (Breivik et al., 2016) with correction of directional spreading - kphil = 0.176 * us / vstokes + kphil = 0.176 * uStokes / vstokes ! ! surface layer averaged Stokes dirft with Stokes drift profile ! estimated from Phillips' spectrum (Breivik et al., 2016) @@ -1989,7 +1993,7 @@ subroutine get_LA_windsea(ustar, hbl, GV, LA) r4 = ( 0.125 + 0.0946 / kstar * z0i ) & *sqrt( 2.0 * PI *kstar * z0) & *erfc( sqrt( 2.0 * kstar * z0 ) ) - us_sl = us * (0.715 + r1 + r2 + r3 + r4) + us_sl = uStokes * (0.715 + r1 + r2 + r3 + r4) ! LA = sqrt(ustar / us_sl) else @@ -1998,10 +2002,11 @@ subroutine get_LA_windsea(ustar, hbl, GV, LA) endsubroutine Get_LA_windsea !> This subroutine initializes the energetic_PBL module -subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) +subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) type(time_type), target, intent(in) :: Time !< The current model time type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(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(energetic_PBL_CS), pointer :: CS !< A pointer that is set to point to the control @@ -2123,7 +2128,7 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "VSTAR_SCALE_FACTOR", CS%vstar_scale_fac, & "An overall nondimensional scaling factor for v*. \n"// & "Making this larger decreases the PBL diffusivity.", & - units="nondim", default=1.0, scale=GV%m_to_Z) + units="nondim", default=1.0, scale=US%m_to_Z) call get_param(param_file, mdl, "EKMAN_SCALE_COEF", CS%Ekman_scale_coef, & "A nondimensional scaling factor controlling the inhibition \n"// & "of the diffusive length scale by rotation. Making this larger \n"//& @@ -2143,11 +2148,11 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "EPBL_MLD_TOLERANCE", CS%MLD_tol, & "The tolerance for the iteratively determined mixed \n"// & "layer depth. This is only used with USE_MLD_ITERATION.", & - units="meter", default=1.0, scale=GV%m_to_Z) + units="meter", default=1.0, scale=US%m_to_Z) call get_param(param_file, mdl, "EPBL_MIN_MIX_LEN", CS%min_mix_len, & "The minimum mixing length scale that will be used \n"//& "by ePBL. The default (0) does not set a minimum.", & - units="meter", default=0.0, scale=GV%m_to_Z) + units="meter", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "EPBL_ORIGINAL_PE_CALC", CS%orig_PE_calc, & "If true, the ePBL code uses the original form of the \n"// & "potential energy change code. Otherwise, the newer \n"// & @@ -2245,7 +2250,7 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) CS%id_TKE_conv_decay = register_diag_field('ocean_model', 'ePBL_TKE_conv_decay', diag%axesT1, & Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3') CS%id_Hsfc_used = register_diag_field('ocean_model', 'ePBL_Hs_used', diag%axesT1, & - Time, 'Surface region thickness that is used', 'm', conversion=GV%m_to_Z) + Time, 'Surface region thickness that is used', 'm', conversion=US%m_to_Z) CS%id_Mixing_Length = register_diag_field('ocean_model', 'Mixing_Length', diag%axesTi, & Time, 'Mixing Length that is used', 'm', conversion=GV%Z_to_m) CS%id_Velocity_Scale = register_diag_field('ocean_model', 'Velocity_Scale', diag%axesTi, & @@ -2255,7 +2260,7 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, & Time, 'MSTAR that is used.', 'nondim') CS%id_OSBL = register_diag_field('ocean_model', 'ePBL_OSBL', diag%axesT1, & - Time, 'ePBL Surface Boundary layer depth.', 'm', conversion=GV%m_to_Z) + Time, 'ePBL Surface Boundary layer depth.', 'm', conversion=US%m_to_Z) ! BGR (9/21/2017) Note that ePBL_OSBL is the guess for iteration step while ePBL_h_ML is ! result from iteration step. CS%id_mld_ekman = register_diag_field('ocean_model', 'MLD_EKMAN', diag%axesT1, & diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 4ddde1060c..b524716f55 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -9,6 +9,7 @@ module MOM_entrain_diffusive use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_forcing_type, only : forcing use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs @@ -41,10 +42,11 @@ module MOM_entrain_diffusive !! the buoyancy flux in a layer and inversely proportional to the density !! differences between layers. The scheme that is used here is described in !! detail in Hallberg, Mon. Wea. Rev. 2000. -subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & +subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & kb_out, Kd_Lay, Kd_int) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< The zonal velocity, in m s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -381,7 +383,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, CS, ea, eb, & htot(i) = h(i,j,1) - Angstrom enddo if (associated(fluxes%buoy)) then ; do i=is,ie - maxF(i,1) = (dt*fluxes%buoy(i,j)) / (GV%g_prime(2)*GV%m_to_Z) + maxF(i,1) = (dt*fluxes%buoy(i,j)) / (GV%g_prime(2)*US%m_to_Z) enddo ; endif endif diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index e41cc8cb2b..c89ec7df78 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -15,6 +15,7 @@ module MOM_int_tide_input use MOM_grid, only : ocean_grid_type use MOM_io, only : slasher, vardesc, MOM_read_data use MOM_thickness_diffuse, only : vert_fill_TS +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs @@ -54,9 +55,10 @@ module MOM_int_tide_input contains !> Sets the model-state dependent internal tide energy sources. -subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, CS) +subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1 real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) @@ -88,7 +90,7 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, CS) if (.not.associated(CS)) call MOM_error(FATAL,"set_diffusivity: "//& "Module must be initialized before it is used.") - kappa_fill = 1.e-3*GV%m_to_Z**2 !### Dimensional constant in m2 s-1. + kappa_fill = 1.e-3*US%m_to_Z**2 !### Dimensional constant in m2 s-1. dt_fill = 7200. !### Dimensionalconstant in s. use_EOS = associated(tv%eqn_of_state) @@ -98,7 +100,7 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, CS) call vert_fill_TS(h, tv%T, tv%S, kappa_fill, dt_fill, T_f, S_f, G, GV) endif - call find_N2_bottom(h, tv, T_f, S_f, itide%h2, fluxes, G, GV, N2_bot) + call find_N2_bottom(h, tv, T_f, S_f, itide%h2, fluxes, G, GV, US, N2_bot) !$OMP parallel do default(none) shared(is,ie,js,je,G,itide,N2_bot,CS) do j=js,je ; do i=is,ie @@ -118,9 +120,10 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, CS) end subroutine set_int_tide_input !> Estimates the near-bottom buoyancy frequency (N^2). -subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot) +subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to the !! thermodynamic fields @@ -153,7 +156,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot) logical :: do_i(SZI_(G)), do_any integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - G_Rho0 = (GV%g_Earth*GV%m_to_Z**2) / GV%Rho0 + G_Rho0 = (GV%g_Earth*US%m_to_Z**2) / GV%Rho0 ! Find the (limited) density jump across each interface. do i=is,ie @@ -232,10 +235,11 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, N2_bot) end subroutine find_N2_bottom !> Initializes the data related to the internal tide input module -subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide) +subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(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 !< structure used to regulate diagnostic output. type(int_tide_input_CS), pointer :: CS !< This module's control structure, which is initialized here. @@ -286,7 +290,7 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide) call get_param(param_file, mdl, "MIN_ZBOT_ITIDES", min_zbot_itides, & "Turn off internal tidal dissipation when the total \n"//& - "ocean depth is less than this value.", units="m", default=0.0, scale=GV%m_to_Z) + "ocean depth is less than this value.", units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "UTIDE", utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & @@ -329,7 +333,7 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide) fail_if_missing=.true.) filename = trim(CS%inputdir) // trim(h2_file) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) - call MOM_read_data(filename, 'h2', itide%h2, G%domain, timelevel=1, scale=GV%m_to_Z**2) + call MOM_read_data(filename, 'h2', itide%h2, G%domain, timelevel=1, scale=US%m_to_Z**2) do j=js,je ; do i=is,ie mask_itidal = 1.0 diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index be1a00fbd6..6ec325eba7 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -11,6 +11,7 @@ module MOM_kappa_shear use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs @@ -87,9 +88,10 @@ module MOM_kappa_shear !> Subroutine for calculating shear-driven diffusivity and TKE in tracer columns subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & - kv_io, dt, G, GV, CS, initialize_all) + kv_io, dt, G, GV, US, CS, initialize_all) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u_in !< Initial zonal velocity, in m s-1. (Intent in) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -293,14 +295,14 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- if (new_kappa) then - do K=1,nzc+1 ; kappa(K) = GV%m_to_Z**2*1.0 ; enddo + do K=1,nzc+1 ; kappa(K) = US%m_to_Z**2*1.0 ; enddo else do K=1,nzc+1 ; kappa(K) = kappa_2d(i,K) ; enddo endif call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & - tke_avg, tv, CS, GV) + tke_avg, tv, CS, GV, US) ! call cpu_clock_begin(id_clock_setup) ! Extrapolate from the vertically reduced grid back to the original layers. @@ -375,9 +377,10 @@ end subroutine Calculate_kappa_shear !> Subroutine for calculating shear-driven diffusivity and TKE in corner columns subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_io, tke_io, & - kv_io, dt, G, GV, CS, initialize_all) + kv_io, dt, G, GV, US, CS, initialize_all) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u_in !< Initial zonal velocity, in m s-1. (Intent in) real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & @@ -619,14 +622,14 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- if (new_kappa) then - do K=1,nzc+1 ; kappa(K) = GV%m_to_Z**2*1.0 ; enddo + do K=1,nzc+1 ; kappa(K) = US%m_to_Z**2*1.0 ; enddo else do K=1,nzc+1 ; kappa(K) = kappa_2d(I,K,J2) ; enddo endif call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & - tke_avg, tv, CS, GV) + tke_avg, tv, CS, GV, US) ! call cpu_clock_begin(Id_clock_setup) ! Extrapolate from the vertically reduced grid back to the original layers. @@ -707,8 +710,9 @@ end subroutine Calc_kappa_shear_vertex !> This subroutine calculates shear-driven diffusivity and TKE in a single column subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & - tke_avg, tv, CS, GV) + tke_avg, tv, CS, GV, US) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)+1), & intent(inout) :: kappa !< The time-weighted average of kappa, in Z2 s-1. real, dimension(SZK_(GV)+1), & @@ -817,7 +821,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & integer :: k, itt, itt_dt Ri_crit = CS%Rino_crit - gR0 = GV%Rho0*(GV%g_Earth*GV%m_to_Z) ; g_R0 = (GV%g_Earth*GV%m_to_Z**2)/GV%Rho0 + gR0 = GV%Rho0*(GV%g_Earth*US%m_to_Z) ; g_R0 = (GV%g_Earth*US%m_to_Z**2)/GV%Rho0 k0dt = dt*CS%kappa_0 ! These are hard-coded for now. Perhaps these could be made dynamic later? ! tol_dksrc = 0.5*tol_ksrc_chg ; tol_dksrc_low = 1.0 - 1.0/tol_ksrc_chg ? @@ -963,7 +967,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! This call just calculates N2 and S2. call calculate_projected_state(kappa, u, v, T, Sal, 0.0, nzc, dz, I_dz_int, & - dbuoy_dT, dbuoy_dS, u, v, T, Sal, GV, & + dbuoy_dT, dbuoy_dS, u, v, T, Sal, GV, US, & N2=N2, S2=S2, vel_underflow=CS%vel_underflow) ! ---------------------------------------------------- ! Iterate @@ -1034,7 +1038,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! enough. call calculate_projected_state(kappa_out, u, v, T, Sal, 0.5*dt_test, nzc, dz, I_dz_int, & dbuoy_dT, dbuoy_dS, u_test, v_test, T_test, S_test, & - GV, N2, S2, ks_int=ks_kappa, ke_int=ke_kappa, & + GV, US, N2, S2, ks_int=ks_kappa, ke_int=ke_kappa, & vel_underflow=CS%vel_underflow) valid_dt = .true. Idtt = 1.0 / dt_test @@ -1061,7 +1065,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & do itt_dt=1,dt_refinements call calculate_projected_state(kappa_out, u, v, T, Sal, 0.5*(dt_test+dt_inc), & nzc, dz, I_dz_int, dbuoy_dT, dbuoy_dS, u_test, v_test, T_test, S_test, & - GV, N2, S2, ks_int=ks_kappa, ke_int=ke_kappa, vel_underflow=CS%vel_underflow) + GV, US, N2, S2, ks_int=ks_kappa, ke_int=ke_kappa, vel_underflow=CS%vel_underflow) valid_dt = .true. Idtt = 1.0 / (dt_test+dt_inc) do K=max(ks_kappa-1,2),min(ke_kappa+1,nzc) @@ -1114,7 +1118,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! call cpu_clock_begin(id_clock_project) call calculate_projected_state(kappa_out, u, v, T, Sal, dt_now, nzc, dz, I_dz_int, & dbuoy_dT, dbuoy_dS, u_test, v_test, T_test, S_test, & - GV, N2=N2, S2=S2, ks_int=ks_kappa, ke_int=ke_kappa, & + GV, US, N2=N2, S2=S2, ks_int=ks_kappa, ke_int=ke_kappa, & vel_underflow=CS%vel_underflow) ! call cpu_clock_end(id_clock_project) @@ -1134,7 +1138,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! call cpu_clock_begin(id_clock_project) call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, dz, I_dz_int, & dbuoy_dT, dbuoy_dS, u_test, v_test, T_test, S_test, & - GV, N2=N2, S2=S2, ks_int=ks_kappa, ke_int=ke_kappa, & + GV, US, N2=N2, S2=S2, ks_int=ks_kappa, ke_int=ke_kappa, & vel_underflow=CS%vel_underflow) ! call cpu_clock_end(id_clock_project) @@ -1159,7 +1163,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! call cpu_clock_begin(id_clock_project) call calculate_projected_state(kappa_mid, u, v, T, Sal, dt_now, nzc, & dz, I_dz_int, dbuoy_dT, dbuoy_dS, u, v, T, Sal, & - GV, N2, S2, vel_underflow=CS%vel_underflow) + GV, US, N2, S2, vel_underflow=CS%vel_underflow) ! call cpu_clock_end(id_clock_project) endif @@ -1210,7 +1214,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & if (abs(dkappa_it1(K,itt-1)) > 1e-20) & d_dkappa_it1(K,itt) = dkappa_it1(K,itt) / dkappa_it1(K,itt-1) endif - dkappa_norm(K,itt) = dkap(K) / max(0.5*(kappa_pred(K) + kappa_out(K)), GV%m_to_Z**2*1e-100) + dkappa_norm(K,itt) = dkap(K) / max(0.5*(kappa_pred(K) + kappa_out(K)), US%m_to_Z**2*1e-100) enddo endif #endif @@ -1226,7 +1230,7 @@ end subroutine kappa_shear_column !! may also calculate the projected buoyancy frequency and shear. subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & dz, I_dz_int, dbuoy_dT, dbuoy_dS, & - u, v, T, Sal, GV, N2, S2, ks_int, ke_int, vel_underflow) + u, v, T, Sal, GV, US, N2, S2, ks_int, ke_int, vel_underflow) integer, intent(in) :: nz !< The number of layers (after eliminating massless !! layers?). real, dimension(nz+1), intent(in) :: kappa !< The diapycnal diffusivity at interfaces, @@ -1248,6 +1252,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & real, dimension(nz), intent(inout) :: T !< The temperature after dt, in C. real, dimension(nz), intent(inout) :: Sal !< The salinity after dt, in PSU. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(nz+1), optional, & intent(inout) :: N2 !< The buoyancy frequency squared at interfaces, !! in s-2. @@ -1334,7 +1339,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & endif if (present(S2)) then - L2_to_Z2 = GV%m_to_Z**2 + L2_to_Z2 = US%m_to_Z**2 S2(1) = 0.0 ; S2(nz+1) = 0.0 if (ks > 1) & S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * (L2_to_Z2*I_dz_int(ks)**2) @@ -1978,10 +1983,11 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & end subroutine find_kappa_tke !> This subroutineinitializesthe parameters that regulate shear-driven mixing -function kappa_shear_init(Time, G, GV, param_file, diag, CS) +function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(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 @@ -2040,7 +2046,7 @@ function kappa_shear_init(Time, G, GV, param_file, diag, CS) "The background diffusivity that is used to smooth the \n"//& "density and shear profiles before solving for the \n"//& "diffusivities. Defaults to value of KD.", & - units="m2 s-1", default=KD_normal, scale=GV%m_to_Z**2) + units="m2 s-1", default=KD_normal, scale=US%m_to_Z**2) call get_param(param_file, mdl, "FRI_CURVATURE", CS%FRi_curvature, & "The nondimensional curvature of the function of the \n"//& "Richardson number in the kappa source term in the \n"//& @@ -2125,7 +2131,7 @@ function kappa_shear_init(Time, G, GV, param_file, diag, CS) 'Shear-driven Turbulent Kinetic Energy', 'm2 s-2') #ifdef ADD_DIAGNOSTICS CS%id_ILd2 = register_diag_field('ocean_model','ILd2_shear',diag%axesTi,Time, & - 'Inverse kappa decay scale at interfaces', 'm-2', conversion=GV%m_to_Z**2) + 'Inverse kappa decay scale at interfaces', 'm-2', conversion=US%m_to_Z**2) CS%id_dz_Int = register_diag_field('ocean_model','dz_Int_shear',diag%axesTi,Time, & 'Finite volume thickness of interfaces', 'm', conversion=GV%Z_to_m) #endif diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index ee6c5de3ee..9d4234b7ea 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -32,6 +32,7 @@ module MOM_set_diffusivity use MOM_bkgnd_mixing, only : bkgnd_mixing_end, sfc_bkgnd_mixing use MOM_string_functions, only : uppercase use MOM_thickness_diffuse, only : vert_fill_TS +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d use MOM_verticalGrid, only : verticalGrid_type use user_change_diffusivity, only : user_change_diff, user_change_diff_init @@ -196,9 +197,10 @@ module MOM_set_diffusivity !! visc%Kv_slow. Vertical viscosity due to shear-driven mixing is passed via !! visc%Kv_shear subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & - G, GV, CS, Kd_lay, Kd_int) + G, GV, US, CS, Kd_lay, Kd_int) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< The zonal velocity, in m s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -276,7 +278,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & "Module must be initialized before it is used.") I_Rho0 = 1.0/GV%Rho0 - kappa_fill = 1.e-3*GV%m_to_Z**2 !### Dimensional constant in m2 s-1. + kappa_fill = 1.e-3*US%m_to_Z**2 !### Dimensional constant in m2 s-1. dt_fill = 7200. !### Dimensionalconstant in s. Omega2 = CS%Omega*CS%Omega @@ -349,7 +351,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & GV%Z_to_H**2*kappa_fill*dt_fill, halo=1) call calc_kappa_shear_vertex(u, v, h, T_adj, S_adj, tv, fluxes%p_surf, visc%Kd_shear, & - visc%TKE_turb, visc%Kv_shear_Bu, dt, G, GV, CS%kappaShear_CSp) + visc%TKE_turb, visc%Kv_shear_Bu, dt, G, GV, US, CS%kappaShear_CSp) if (associated(visc%Kv_shear)) visc%Kv_shear(:,:,:) = 0.0 ! needed for other parameterizations if (CS%debug) then call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear", G%HI, scale=GV%Z_to_m**2) @@ -360,7 +362,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! Changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ????) ! Sets visc%Kv_shear call calculate_kappa_shear(u_h, v_h, h, tv, fluxes%p_surf, visc%Kd_shear, visc%TKE_turb, & - visc%Kv_shear, dt, G, GV, CS%kappaShear_CSp) + visc%Kv_shear, dt, G, GV, US, CS%kappaShear_CSp) if (CS%debug) then call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI, scale=GV%Z_to_m**2) call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear", G%HI, scale=GV%Z_to_m**2) @@ -371,7 +373,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (showCallTree) call callTree_waypoint("done with calculate_kappa_shear (set_diffusivity)") elseif (CS%use_CVMix_shear) then !NOTE{BGR}: this needs to be cleaned up. It works in 1D case, but has not been tested outside. - call calculate_CVMix_shear(u_h, v_h, h, tv, visc%Kd_shear, visc%Kv_shear, G, GV, CS%CVMix_shear_CSp) + call calculate_CVMix_shear(u_h, v_h, h, tv, visc%Kd_shear, visc%Kv_shear, G, GV, US, CS%CVMix_shear_CSp) if (CS%debug) then call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear", G%HI, scale=GV%Z_to_m**2) call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear", G%HI, scale=GV%Z_to_m**2) @@ -392,18 +394,18 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & do j=js,je ! Set up variables related to the stratification. - call find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, N2_lay, N2_int, N2_bot) + call find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, N2_lay, N2_int, N2_bot) if (associated(dd%N2_3d)) then do K=1,nz+1 ; do i=is,ie ; dd%N2_3d(i,j,K) = N2_int(i,K) ; enddo ; enddo endif ! Add background mixing - call calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, visc%Kv_slow, j, G, GV, CS%bkgnd_mixing_csp) + call calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, visc%Kv_slow, j, G, GV, US, CS%bkgnd_mixing_csp) ! Double-diffusion (old method) if (CS%double_diffusion) then - call double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, KT_extra, KS_extra) + call double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, KT_extra, KS_extra) do K=2,nz ; do i=is,ie if (KS_extra(i,K) > KT_extra(i,K)) then ! salt fingering Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5*KT_extra(i,K) @@ -433,7 +435,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! GMM, we need to pass HBL to compute_ddiff_coeffs, but it is not yet available. if (CS%use_CVMix_ddiff) then call cpu_clock_begin(id_clock_CVMix_ddiff) - call compute_ddiff_coeffs(h, tv, G, GV, j, visc%Kd_extra_T, visc%Kd_extra_S, CS%CVMix_ddiff_csp) + call compute_ddiff_coeffs(h, tv, G, GV, US, j, visc%Kd_extra_T, visc%Kd_extra_S, CS%CVMix_ddiff_csp) call cpu_clock_end(id_clock_CVMix_ddiff) endif @@ -462,7 +464,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif endif - call find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, TKE_to_Kd, & + call find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, TKE_to_Kd, & maxTKE, kb) if (associated(dd%maxTKE)) then ; do k=1,nz ; do i=is,ie dd%maxTKE(i,j,k) = maxTKE(i,k) @@ -473,21 +475,21 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! Add the ML_Rad diffusivity. if (CS%ML_radiation) & - call add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_int) + call add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, Kd_int) ! Add the Nikurashin and / or tidal bottom-driven mixing - call calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, maxTKE, G, GV, CS%tm_csp, & + call calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, maxTKE, G, GV, US, CS%tm_csp, & N2_lay, N2_int, Kd_lay, Kd_int, CS%Kd_max, visc%Kv_slow) ! This adds the diffusion sustained by the energy extracted from the flow ! by the bottom drag. if (CS%bottomdraglaw .and. (CS%BBL_effic>0.0)) then if (CS%use_LOTW_BBL_diffusivity) then - call add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, G, GV, CS, & + call add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, G, GV, US, CS, & Kd_lay, Kd_int, dd%Kd_BBL) else call add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & - maxTKE, kb, G, GV, CS, Kd_lay, Kd_int, dd%Kd_BBL) + maxTKE, kb, G, GV, US, CS, Kd_lay, Kd_int, dd%Kd_BBL) endif endif @@ -657,10 +659,11 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & end subroutine set_diffusivity !> Convert turbulent kinetic energy to diffusivity -subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & +subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & TKE_to_Kd, maxTKE, kb) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available @@ -720,7 +723,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & I_dt = 1.0/dt Omega2 = CS%Omega**2 - G_Rho0 = (GV%g_Earth*GV%m_to_Z**2) / GV%Rho0 + G_Rho0 = (GV%g_Earth*US%m_to_Z**2) / GV%Rho0 H_neglect = GV%H_subroundoff I_Rho0 = 1.0/GV%Rho0 @@ -828,7 +831,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & enddo do k=2,kmb ; do i=is,ie maxTKE(i,k) = 0.0 - TKE_to_Kd(i,k) = GV%m_to_Z**3 / ((N2_lay(i,k) + Omega2) * & + TKE_to_Kd(i,k) = US%m_to_Z**3 / ((N2_lay(i,k) + Omega2) * & (GV%H_to_Z*(h(i,j,k) + H_neglect))) enddo ; enddo do k=kmb+1,kb_min-1 ; do i=is,ie @@ -845,14 +848,14 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & ! ### This should be 1 / G_Earth * (delta rho_InSitu) ! kappa_max = I_dt * dRho_int(i,K+1) * maxEnt(i,k) * & ! (GV%H_to_m*h(i,j,k) + dh_max) / dRho_lay - ! maxTKE(i,k) = (GV%g_Earth*GV%m_to_Z) * dRho_lay * kappa_max + ! maxTKE(i,k) = (GV%g_Earth*US%m_to_Z) * dRho_lay * kappa_max ! dRho_int should already be non-negative, so the max is redundant? dh_max = maxEnt(i,k) * (1.0 + dsp1_ds(i,k)) dRho_lay = 0.5 * max(dRho_int(i,K) + dRho_int(i,K+1), 0.0) maxTKE(i,k) = I_dt*GV%Z_to_m * ((GV%g_Earth * I_Rho0) * & (0.5*max(dRho_int(i,K+1) + dsp1_ds(i,k)*dRho_int(i,K), 0.0))) * & ((GV%H_to_Z*h(i,j,k) + dh_max) * maxEnt(i,k)) - TKE_to_Kd(i,k) = GV%m_to_Z**3 / (G_Rho0 * dRho_lay + & + TKE_to_Kd(i,k) = US%m_to_Z**3 / (G_Rho0 * dRho_lay + & CS%Omega**2 * GV%H_to_Z*(h(i,j,k) + H_neglect)) endif enddo ; enddo @@ -860,10 +863,11 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, CS, & end subroutine find_TKE_to_Kd !> Calculate Brunt-Vaisala frequency, N^2. -subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & +subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & N2_lay, N2_int, N2_bot) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available @@ -910,7 +914,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke - G_Rho0 = (GV%g_Earth*GV%m_to_Z**2) / GV%Rho0 + G_Rho0 = (GV%g_Earth*US%m_to_Z**2) / GV%Rho0 H_neglect = GV%H_subroundoff ! Find the (limited) density jump across each interface. @@ -1035,9 +1039,10 @@ end subroutine find_N2 !! be made run-time variables rather than hard-coded constants. !! !! \todo Find reference for NCAR tech note above. -subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, Kd_T_dd, Kd_S_dd) +subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available !! thermodynamic fields; absent fields have NULL ptrs. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -1080,8 +1085,8 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, Kd_T_dd, Kd_S_dd) is = G%isc ; ie = G%iec ; nz = G%ke if (associated(tv%eqn_of_state)) then - dsfmax = GV%m_to_Z**2 * 1.e-4 ! max salt fingering diffusivity rescaled to (Z2/sec) - Kv_molecular = GV%m_to_Z**2 * 1.5e-6 ! molecular viscosity rescaled to (Z2/sec) + dsfmax = US%m_to_Z**2 * 1.e-4 ! max salt fingering diffusivity rescaled to (Z2/sec) + Kv_molecular = US%m_to_Z**2 * 1.5e-6 ! molecular viscosity rescaled to (Z2/sec) do i=is,ie pres(i) = 0.0 ; Kd_T_dd(i,1) = 0.0 ; Kd_S_dd(i,1) = 0.0 @@ -1124,9 +1129,10 @@ end subroutine double_diffusion !> This routine adds diffusion sustained by flow energy extracted by bottom drag. subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & - maxTKE, kb, G, GV, CS, Kd_lay, Kd_int, Kd_BBL) + maxTKE, kb, G, GV, US, CS, Kd_lay, Kd_int, Kd_BBL) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< The zonal velocity, in m s-1 real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -1199,7 +1205,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) Rayleigh_drag = .true. I_Rho0 = 1.0/GV%Rho0 - R0_g = GV%Rho0 / (GV%m_to_Z**2*GV%g_Earth) + R0_g = GV%Rho0 / (US%m_to_Z**2*GV%g_Earth) do K=2,nz ; Rint(K) = 0.5*(GV%Rlay(k-1)+GV%Rlay(k)) ; enddo @@ -1211,7 +1217,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & do i=is,ie ustar_h = visc%ustar_BBL(i,j) if (associated(fluxes%ustar_tidal)) & - ustar_h = ustar_h + GV%m_to_Z*fluxes%ustar_tidal(i,j) + ustar_h = ustar_h + US%m_to_Z*fluxes%ustar_tidal(i,j) absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) if ((ustar_h > 0.0) .and. (absf > 0.5*CS%IMax_decay*ustar_h)) then @@ -1358,9 +1364,10 @@ end subroutine add_drag_diffusivity !! wall turbulent viscosity, up to a BBL height where the energy used for mixing has !! consumed the mechanical TKE input. subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & - G, GV, CS, Kd_lay, Kd_int, Kd_BBL) + G, GV, US, CS, Kd_lay, Kd_int, Kd_BBL) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< u component of flow (m s-1) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -1433,7 +1440,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ustar2 = ustar**2 ! In add_drag_diffusivity(), fluxes%ustar_tidal is added in. This might be double counting ! since ustar_BBL should already include all contributions to u*? -AJA - if (associated(fluxes%ustar_tidal)) ustar = ustar + GV%m_to_Z*fluxes%ustar_tidal(i,j) + if (associated(fluxes%ustar_tidal)) ustar = ustar + US%m_to_Z*fluxes%ustar_tidal(i,j) ! The maximum decay scale should be something of order 200 m. We use the smaller of u*/f and ! (IMax_decay)^-1 as the decay scale. If ustar = 0, this is land so this value doesn't matter. @@ -1518,9 +1525,10 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & end subroutine add_LOTW_BBL_diffusivity !> This routine adds effects of mixed layer radiation to the layer diffusivities. -subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_int) +subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, Kd_int) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) type(forcing), intent(in) :: fluxes !< Surface fluxes structure @@ -1580,7 +1588,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ ustar_sq = max(fluxes%ustar(i,j), CS%ustar_min)**2 TKE_ml_flux(i) = (CS%mstar*CS%ML_rad_coeff)*(ustar_sq*fluxes%ustar(i,j)) - I_decay_len2_TKE = CS%TKE_decay**2 * (f_sq / (GV%m_to_Z**2*ustar_sq)) + I_decay_len2_TKE = CS%TKE_decay**2 * (f_sq / (US%m_to_Z**2*ustar_sq)) if (CS%ML_rad_TKE_decay) & TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-h_ml(i) * sqrt(I_decay_len2_TKE)) @@ -1621,10 +1629,10 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, CS, Kd_lay, TKE_to_Kd, Kd_ dzL = GV%H_to_Z*h(i,j,k) ; z1 = dzL*I_decay(i) if (z1 > 1e-5) then Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & - GV%m_to_Z * ((1.0 - exp(-z1)) / dzL) + US%m_to_Z * ((1.0 - exp(-z1)) / dzL) else Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & - GV%m_to_Z * (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) + US%m_to_Z * (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) endif Kd_mlr = min(Kd_mlr, CS%ML_rad_kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_mlr @@ -1899,11 +1907,12 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) end subroutine set_density_ratios -subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp, int_tide_CSp, & +subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z_CSp, int_tide_CSp, & tm_CSp, halo_TS) type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + 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 used to regulate diagnostic output. @@ -1985,7 +1994,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp "The maximum diapycnal diffusivity due to turbulence \n"//& "radiated from the base of the mixed layer. \n"//& "This is only used if ML_RADIATION is true.", & - units="m2 s-1", default=1.0e-3, scale=GV%m_to_Z**2) + units="m2 s-1", default=1.0e-3, scale=US%m_to_Z**2) call get_param(param_file, mdl, "ML_RAD_COEFF", CS%ML_rad_coeff, & "The coefficient which scales MSTAR*USTAR^3 to obtain \n"//& "the energy available for mixing below the base of the \n"//& @@ -2038,9 +2047,9 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp "to allow the mixing to penetrate as far as \n"//& "stratification and rotation permit. The default is 0. \n"//& "This is only used if BOTTOMDRAGLAW is true.", & - units="m", default=0.0, scale=GV%m_to_Z) + units="m", default=0.0, scale=US%m_to_Z) - CS%IMax_decay = 1.0 / (200.0*GV%m_to_Z) !### This is inconsistent with the description above. + CS%IMax_decay = 1.0 / (200.0*US%m_to_Z) !### This is inconsistent with the description above. if (decay_length > 0.0) CS%IMax_decay = 1.0/decay_length call get_param(param_file, mdl, "BBL_MIXING_AS_MAX", CS%BBL_mixing_as_max, & "If true, take the maximum of the diffusivity from the \n"//& @@ -2069,30 +2078,30 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp default=.false.) ! set params releted to the background mixing - call bkgnd_mixing_init(Time, G, GV, param_file, CS%diag, CS%bkgnd_mixing_csp) + call bkgnd_mixing_init(Time, G, GV, US, param_file, CS%diag, CS%bkgnd_mixing_csp) call get_param(param_file, mdl, "KV", CS%Kv, & "The background kinematic viscosity in the interior. \n"//& "The molecular value, ~1e-6 m2 s-1, may be used.", & - units="m2 s-1", scale=GV%m_to_Z**2, fail_if_missing=.true.) + units="m2 s-1", scale=US%m_to_Z**2, fail_if_missing=.true.) call get_param(param_file, mdl, "KD", CS%Kd, & "The background diapycnal diffusivity of density in the \n"//& "interior. Zero or the molecular value, ~1e-7 m2 s-1, \n"//& - "may be used.", units="m2 s-1", scale=GV%m_to_Z**2, fail_if_missing=.true.) + "may be used.", units="m2 s-1", scale=US%m_to_Z**2, fail_if_missing=.true.) call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, & "The minimum diapycnal diffusivity.", & - units="m2 s-1", default=0.01*CS%Kd*GV%Z_to_m**2, scale=GV%m_to_Z**2) + units="m2 s-1", default=0.01*CS%Kd*GV%Z_to_m**2, scale=US%m_to_Z**2) call get_param(param_file, mdl, "KD_MAX", CS%Kd_max, & "The maximum permitted increment for the diapycnal \n"//& "diffusivity from TKE-based parameterizations, or a \n"//& - "negative value for no limit.", units="m2 s-1", default=-1.0, scale=GV%m_to_Z**2) + "negative value for no limit.", units="m2 s-1", default=-1.0, scale=US%m_to_Z**2) if (CS%simple_TKE_to_Kd .and. CS%Kd_max<=0.) call MOM_error(FATAL, & "set_diffusivity_init: To use SIMPLE_TKE_TO_KD, KD_MAX must be set to >0.") call get_param(param_file, mdl, "KD_ADD", CS%Kd_add, & "A uniform diapycnal diffusivity that is added \n"//& "everywhere without any filtering or scaling.", & - units="m2 s-1", default=0.0, scale=GV%m_to_Z**2) + units="m2 s-1", default=0.0, scale=US%m_to_Z**2) if (CS%use_LOTW_BBL_diffusivity .and. CS%Kd_max<=0.) call MOM_error(FATAL, & "set_diffusivity_init: KD_MAX must be set (positive) when "// & "USE_LOTW_BBL_DIFFUSIVITY=True.") @@ -2110,7 +2119,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp "If BULKMIXEDLAYER is false, KDML is the elevated \n"//& "diapycnal diffusivity in the topmost HMIX of fluid. \n"//& "KDML is only used if BULKMIXEDLAYER is false.", & - units="m2 s-1", default=CS%Kd*GV%Z_to_m**2, scale=GV%m_to_Z**2) + units="m2 s-1", default=CS%Kd*GV%Z_to_m**2, scale=US%m_to_Z**2) call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface \n"//& "viscosity and diffusivity are elevated when the bulk \n"//& @@ -2126,20 +2135,20 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp call get_param(param_file, mdl, "DISSIPATION_MIN", CS%dissip_min, & "The minimum dissipation by which to determine a lower \n"//& - "bound of Kd (a floor).", units="W m-3", default=0.0, scale=GV%m_to_Z**2) + "bound of Kd (a floor).", units="W m-3", default=0.0, scale=US%m_to_Z**2) call get_param(param_file, mdl, "DISSIPATION_N0", CS%dissip_N0, & "The intercept when N=0 of the N-dependent expression \n"//& "used to set a minimum dissipation by which to determine \n"//& "a lower bound of Kd (a floor): A in eps_min = A + B*N.", & - units="W m-3", default=0.0, scale=GV%m_to_Z**2) + units="W m-3", default=0.0, scale=US%m_to_Z**2) call get_param(param_file, mdl, "DISSIPATION_N1", CS%dissip_N1, & "The coefficient multiplying N, following Gargett, used to \n"//& "set a minimum dissipation by which to determine a lower \n"//& "bound of Kd (a floor): B in eps_min = A + B*N", & - units="J m-3", default=0.0, scale=GV%m_to_Z**2) + units="J m-3", default=0.0, scale=US%m_to_Z**2) call get_param(param_file, mdl, "DISSIPATION_KD_MIN", CS%dissip_Kd_min, & "The minimum vertical diffusivity applied as a floor.", & - units="m2 s-1", default=0.0, scale=GV%m_to_Z**2) + units="m2 s-1", default=0.0, scale=US%m_to_Z**2) CS%limit_dissipation = (CS%dissip_min>0.) .or. (CS%dissip_N1>0.) .or. & (CS%dissip_N0>0.) .or. (CS%dissip_Kd_min>0.) @@ -2217,14 +2226,14 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp endif ! old double-diffusion if (CS%user_change_diff) then - call user_change_diff_init(Time, G, GV, param_file, diag, CS%user_change_diff_CSp) + call user_change_diff_init(Time, G, GV, US, param_file, diag, CS%user_change_diff_CSp) endif if (CS%tm_csp%Int_tide_dissipation .and. CS%bkgnd_mixing_csp%Bryan_Lewis_diffusivity) & call MOM_error(FATAL,"MOM_Set_Diffusivity: "// & "Bryan-Lewis and internal tidal dissipation are both enabled. Choose one.") - CS%useKappaShear = kappa_shear_init(Time, G, GV, param_file, CS%diag, CS%kappaShear_CSp) + CS%useKappaShear = kappa_shear_init(Time, G, GV, US, param_file, CS%diag, CS%kappaShear_CSp) if (CS%useKappaShear) CS%Vertex_Shear = kappa_shear_at_vertex(param_file) if (CS%useKappaShear) & diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index d4261b6523..fb40b08a6c 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -20,8 +20,8 @@ module MOM_set_visc use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_safe_alloc, only : safe_alloc_ptr, safe_alloc_alloc -use MOM_variables, only : thermo_var_ptrs -use MOM_variables, only : vertvisc_type +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs, vertvisc_type use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_DIRECTION_E @@ -99,9 +99,10 @@ module MOM_set_visc !! paper of Killworth and Edwards, JPO 1999. It is not necessary to !! calculate the thickness and viscosity every time step; instead !! previous values may be used. -subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) +subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< The zonal velocity, in m s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -118,28 +119,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) logical, optional, intent(in) :: symmetrize !< If present and true, do extra calculations !! of those values in visc that would be !! calculated with symmetric memory. -! The following subroutine calculates the thickness of the bottom -! boundary layer and the viscosity within that layer. A drag law is -! used, either linearized about an assumed bottom velocity or using -! the actual near-bottom velocities combined with an assumed -! unresolved velocity. The bottom boundary layer thickness is -! limited by a combination of stratification and rotation, as in the -! paper of Killworth and Edwards, JPO 1999. It is not necessary to -! calculate the thickness and viscosity every time step; instead -! previous values may be used. -! -! Arguments: u - Zonal velocity, in m s-1. -! (in) v - Meridional velocity, in m s-1. -! (in) h - Layer thickness, in m or kg m-2. In the comments below, -! the units of h are denoted as H. -! (in) tv - A structure containing pointers to any available -! thermodynamic fields. Absent fields have NULL ptrs. -! (out) visc - A structure containing vertical viscosities and related -! fields. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! vertvisc_init. + + ! Local variables real, dimension(SZIB_(G)) :: & ustar, & ! The bottom friction velocity, in m s-1. T_EOS, & ! The temperature used to calculate the partial derivatives @@ -306,7 +287,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt = sqrt(CS%cdrag) - cdrag_sqrt_Z = GV%m_to_Z * sqrt(CS%cdrag) + cdrag_sqrt_Z = US%m_to_Z * sqrt(CS%cdrag) K2 = max(nkmb+1, 2) ! With a linear drag law, the friction velocity is already known. @@ -846,7 +827,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, CS, symmetrize) if (m==1) then ; Cell_width = G%dy_Cu(I,j) else ; Cell_width = G%dx_Cv(i,J) ; endif gam = 1.0 - L(K+1)/L(K) - Rayleigh = GV%m_to_Z * CS%cdrag * (L(K)-L(K+1)) * (1.0-BBL_frac) * & + Rayleigh = US%m_to_Z * CS%cdrag * (L(K)-L(K+1)) * (1.0-BBL_frac) * & (12.0*CS%c_Smag*h_vel_pos) / (12.0*CS%c_Smag*h_vel_pos + & GV%m_to_H * CS%cdrag * gam*(1.0-gam)*(1.0-1.5*gam) * L(K)**2 * Cell_width) else ! This layer feels no drag. @@ -1012,9 +993,10 @@ end function set_u_at_v !! A bulk Richardson criterion or the thickness of the topmost NKML layers (with a bulk mixed layer) !! are currently used. The thicknesses are given in terms of fractional layers, so that this !! thickness will move as the thickness of the topmost layers change. -subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) +subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetrize) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< The zonal velocity, in m s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -1031,8 +1013,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) type(set_visc_CS), pointer :: CS !< The control structure returned by a previous !! call to vertvisc_init. logical, optional, intent(in) :: symmetrize !< If present and true, do extra calculations - !! of those values in visc that would be - !! calculated with symmetric memory. + !! of those values in visc that would be + !! calculated with symmetric memory. ! Local variables real, dimension(SZIB_(G)) :: & htot, & ! The total depth of the layers being that are within the @@ -1147,7 +1129,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * GV%Z_to_m**2 * GV%Z_to_H U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt = sqrt(CS%cdrag) - cdrag_sqrt_Z = GV%m_to_Z * sqrt(CS%cdrag) + cdrag_sqrt_Z = US%m_to_Z * sqrt(CS%cdrag) OBC => CS%OBC use_EOS = associated(tv%eqn_of_state) @@ -1224,7 +1206,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) if (CS%omega_frac > 0.0) & absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif - U_star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i+1,j))*GV%m_to_Z) + U_star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i+1,j))*US%m_to_Z) Idecay_len_TKE(I) = ((absf / U_star) * CS%TKE_decay) * GV%H_to_Z endif enddo @@ -1460,7 +1442,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, CS, symmetrize) absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif - U_star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i,j+1))*GV%m_to_Z) + U_star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i,j+1))*US%m_to_Z) Idecay_len_TKE(i) = ((absf / U_star) * CS%TKE_decay) * GV%H_to_Z endif @@ -1779,10 +1761,11 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) end subroutine set_visc_register_restarts !> Initializes the MOM_set_visc control structure -subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, restart_CS, OBC) +subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS, OBC) type(time_type), target, intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(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 @@ -1975,10 +1958,10 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, restart_CS, OB call get_param(param_file, mdl, "KV_BBL_MIN", CS%KV_BBL_min, & "The minimum viscosities in the bottom boundary layer.", & - units="m2 s-1", default=Kv_background, scale=GV%m_to_Z**2) + units="m2 s-1", default=Kv_background, scale=US%m_to_Z**2) call get_param(param_file, mdl, "KV_TBL_MIN", CS%KV_TBL_min, & "The minimum viscosities in the top boundary layer.", & - units="m2 s-1", default=Kv_background, scale=GV%m_to_Z**2) + units="m2 s-1", default=Kv_background, scale=US%m_to_Z**2) if (CS%Channel_drag) then call get_param(param_file, mdl, "SMAG_LAP_CONST", smag_const1, default=-1.0) @@ -2042,8 +2025,8 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, restart_CS, OB diag%axesCv1, Time, 'Number of layers in viscous mixed layer at v points', 'm') endif - if ((GV%m_to_Z_restart /= 0.0) .and. (GV%m_to_Z_restart /= GV%m_to_Z)) then - Z_rescale = GV%m_to_Z / GV%m_to_Z_restart + if ((US%m_to_Z_restart /= 0.0) .and. (US%m_to_Z_restart /= US%m_to_Z)) then + Z_rescale = US%m_to_Z / US%m_to_Z_restart if (associated(visc%Kd_shear)) then ; if (query_initialized(visc%Kd_shear, "Kd_shear", restart_CS)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie visc%Kd_shear(i,j,k) = Z_rescale**2 * visc%Kd_shear(i,j,k) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index fba82d7f5d..b9a16ebb46 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -7,17 +7,18 @@ module MOM_tidal_mixing use MOM_diag_mediator, only : safe_alloc_ptr, post_data use MOM_diag_to_Z, only : diag_to_Z_CS, register_Zint_diag use MOM_diag_to_Z, only : calc_Zint_diags +use MOM_debugging, only : hchksum use MOM_EOS, only : calculate_density -use MOM_variables, only : thermo_var_ptrs, p3d use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE -use MOM_debugging, only : hchksum -use MOM_grid, only : ocean_grid_type -use MOM_verticalGrid, only : verticalGrid_type -use MOM_remapping, only : remapping_CS, initialize_remapping, remapping_core_h use MOM_file_parser, only : openParameterBlock, closeParameterBlock use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_string_functions, only : uppercase, lowercase +use MOM_grid, only : ocean_grid_type use MOM_io, only : slasher, MOM_read_data, vardesc, var_desc, field_size +use MOM_remapping, only : remapping_CS, initialize_remapping, remapping_core_h +use MOM_string_functions, only : uppercase, lowercase +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs, p3d +use MOM_verticalGrid, only : verticalGrid_type use CVMix_tidal, only : CVMix_init_tidal, CVMix_compute_Simmons_invariant use CVMix_tidal, only : CVMix_coeffs_tidal, CVMix_tidal_params_type use CVMix_tidal, only : CVMix_compute_Schmittner_invariant, CVMix_compute_SchmittnerCoeff @@ -204,10 +205,11 @@ module MOM_tidal_mixing contains !> Initializes internal tidal dissipation scheme for diapycnal mixing -logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, CS) +logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_CSp, CS) type(time_type), intent(in) :: Time !< The current time. type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< pointer to the Z-diagnostics control @@ -378,7 +380,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, "When the Polzin decay profile is used, this is the \n"//& "minimum vertical decay scale for the vertical profile\n"//& "of internal tide dissipation with the Polzin (2009) formulation", & - units="m", default=0.0, scale=GV%m_to_Z) + units="m", default=0.0, scale=US%m_to_Z) endif if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation) then @@ -386,7 +388,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, "The decay scale away from the bottom for tidal TKE with \n"//& "the new coding when INT_TIDE_DISSIPATION is used.", & !units="m", default=0.0) - units="m", default=500.0, scale=GV%m_to_Z) ! TODO: confirm this new default + units="m", default=500.0, scale=US%m_to_Z) ! TODO: confirm this new default call get_param(param_file, mdl, "MU_ITIDES", CS%Mu_itides, & "A dimensionless turbulent mixing efficiency used with \n"//& "INT_TIDE_DISSIPATION, often 0.2.", units="nondim", default=0.2) @@ -397,7 +399,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, units="nondim", default=0.3333) call get_param(param_file, mdl, "MIN_ZBOT_ITIDES", CS%min_zbot_itides, & "Turn off internal tidal dissipation when the total \n"//& - "ocean depth is less than this value.", units="m", default=0.0, scale=GV%m_to_Z) + "ocean depth is less than this value.", units="m", default=0.0, scale=US%m_to_Z) endif if ( (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation) .and. & @@ -448,7 +450,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, fail_if_missing=(.not.CS%use_CVMix_tidal)) filename = trim(CS%inputdir) // trim(h2_file) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) - call MOM_read_data(filename, 'h2', CS%h2, G%domain, timelevel=1, scale=GV%m_to_Z**2) + call MOM_read_data(filename, 'h2', CS%h2, G%domain, timelevel=1, scale=US%m_to_Z**2) do j=js,je ; do i=is,ie if (G%bathyT(i,j) < CS%min_zbot_itides) CS%mask_itidal(i,j) = 0.0 @@ -645,10 +647,11 @@ end function tidal_mixing_init !> Depending on whether or not CVMix is active, calls the associated subroutine to compute internal !! tidal dissipation and to add the effect of internal-tide-driven mixing to the layer or interface !! diffusivities. -subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & +subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, CS, & N2_lay, N2_int, Kd_lay, Kd_int, Kd_max, Kv) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy @@ -678,9 +681,9 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then if (CS%use_CVMix_tidal) then - call calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd_lay, Kv) + call calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) else - call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & + call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, CS, & N2_lay, Kd_lay, Kd_int, Kd_max) endif endif @@ -689,14 +692,14 @@ end subroutine calculate_tidal_mixing !> Calls the CVMix routines to compute tidal dissipation and to add the effect of internal-tide-driven !! mixing to the interface diffusivities. -subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd_lay, Kv) +subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) integer, intent(in) :: j !< The j-index to work on type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tidal_mixing_cs), pointer :: CS !< This module's control structure. - real, dimension(SZI_(G),SZK_(G)+1), & - intent(in) :: N2_int !< The squared buoyancy frequency at the - !! interfaces, in s-2. + real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: N2_int !< The squared buoyancy + !! frequency at the interfaces, in s-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -772,13 +775,13 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd_lay, Kv) ! Update diffusivity do k=1,G%ke - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_tidal(k) + Kd_tidal(k+1)) ! Rescale from m2 s-1 to Z2 s-1. + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*US%m_to_Z**2*(Kd_tidal(k) + Kd_tidal(k+1)) ! Rescale from m2 s-1 to Z2 s-1. enddo ! Update viscosity with the proper unit conversion. if (associated(Kv)) then do k=1,G%ke+1 - Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 s-1. + Kv(i,j,k) = Kv(i,j,k) + US%m_to_Z**2 * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 s-1. enddo endif @@ -870,13 +873,13 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd_lay, Kv) ! Update diffusivity do k=1,G%ke - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*GV%m_to_Z**2*(Kd_tidal(k) + Kd_tidal(k+1)) ! Rescale from m2 s-1 to Z2 s-1. + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5*US%m_to_Z**2*(Kd_tidal(k) + Kd_tidal(k+1)) ! Rescale from m2 s-1 to Z2 s-1. enddo ! Update viscosity if (associated(Kv)) then do k=1,G%ke+1 - Kv(i,j,k) = Kv(i,j,k) + GV%m_to_Z**2 * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 s-1. + Kv(i,j,k) = Kv(i,j,k) + US%m_to_Z**2 * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 s-1. enddo endif @@ -914,10 +917,11 @@ end subroutine calculate_CVMix_tidal !! low modes (rays) of the internal tide ("lowmode"), and (3) local dissipation of internal lee waves. !! Will eventually need to add diffusivity due to other wave-breaking processes (e.g. Bottom friction, !! Froude-number-depending breaking, PSI, etc.). -subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, & +subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, CS, & N2_lay, Kd_lay, Kd_int, Kd_max) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy frequency @@ -1058,7 +1062,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, !### In the code below 1.0e-14 is a dimensional constant in s-3 if ((CS%tideamp(i,j) > 0.0) .and. & (CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14) ) then - z0_polzin(i) = GV%m_to_Z * CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & + z0_polzin(i) = US%m_to_Z * CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & CS%Nbotref_Polzin**2 * CS%tideamp(i,j) / & ( CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 ) if (z0_polzin(i) < CS%Polzin_min_decay_scale) & @@ -1084,21 +1088,21 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, CS, if ( CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then ! For the Polzin formulation, this if loop prevents the vertical ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14*GV%m_to_Z) then !### Avoid using this dimensional constant. + if (htot_WKB(i) > 1.0e-14*US%m_to_Z) then !### Avoid using this dimensional constant. Inv_int(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 endif endif if ( CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09) ) then ! For the Polzin formulation, this if loop prevents the vertical ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14*GV%m_to_Z) then !### Avoid using this dimensional constant. + if (htot_WKB(i) > 1.0e-14*US%m_to_Z) then !### Avoid using this dimensional constant. Inv_int_lee(i) = ( z0_polzin_scaled(i)*CS%Decay_scale_factor_lee / htot_WKB(i) ) + 1.0 endif endif if ( CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then ! For the Polzin formulation, this if loop prevents the vertical ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14*GV%m_to_Z) then !### Avoid using this dimensional constant. + if (htot_WKB(i) > 1.0e-14*US%m_to_Z) then !### Avoid using this dimensional constant. Inv_int_low(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 endif endif diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 57bf5a3ab6..450e054cf6 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -16,6 +16,7 @@ module MOM_vert_friction use MOM_PointAccel, only : write_u_accel, write_v_accel, PointAccel_init use MOM_PointAccel, only : PointAccel_CS use MOM_time_manager, only : time_type, time_type_to_real, operator(-) +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type use MOM_variables, only : cont_diag_ptrs, accel_diag_ptrs use MOM_variables, only : ocean_internal_state @@ -563,9 +564,10 @@ end subroutine vertvisc_remnant !> Calculate the coupling coefficients (CS%a_u and CS%a_v) !! and effective layer thicknesses (CS%h_u and CS%h_v) for later use in the !! applying the implicit vertical viscosity via vertvisc(). -subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) +subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u !< Zonal velocity in m s-1 real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & @@ -755,7 +757,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) endif call find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & - dt, j, G, GV, CS, visc, forces, work_on_u=.true., OBC=OBC) + dt, j, G, GV, US, CS, visc, forces, work_on_u=.true., OBC=OBC) if (allocated(hML_u)) then do i=isq,ieq ; if (do_i(i)) then ; hML_u(I,j) = h_ml(I) ; endif ; enddo endif @@ -770,7 +772,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) if (do_any_shelf) then if (CS%harmonic_visc) then call find_coupling_coef(a_shelf, hvel, do_i_shelf, h_harm, bbl_thick, & - kv_bbl, z_i, h_ml, dt, j, G, GV, CS, & + kv_bbl, z_i, h_ml, dt, j, G, GV, US, CS, & visc, forces, work_on_u=.true., OBC=OBC, shelf=.true.) else ! Find upwind-biased thickness near the surface. ! Perhaps this needs to be done more carefully, via find_eta. @@ -798,7 +800,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) endif ; enddo enddo call find_coupling_coef(a_shelf, hvel_shelf, do_i_shelf, h_harm, & - bbl_thick, kv_bbl, z_i, h_ml, dt, j, G, GV, CS, & + bbl_thick, kv_bbl, z_i, h_ml, dt, j, G, GV, US, CS, & visc, forces, work_on_u=.true., OBC=OBC, shelf=.true.) endif do I=Isq,Ieq ; if (do_i_shelf(I)) CS%a1_shelf_u(I,j) = a_shelf(I,1) ; enddo @@ -924,7 +926,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) endif call find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & - dt, j, G, GV, CS, visc, forces, work_on_u=.false., OBC=OBC) + dt, j, G, GV, US, CS, visc, forces, work_on_u=.false., OBC=OBC) if ( allocated(hML_v)) then do i=is,ie ; if (do_i(i)) then ; hML_v(i,J) = h_ml(i) ; endif ; enddo endif @@ -938,7 +940,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) if (do_any_shelf) then if (CS%harmonic_visc) then call find_coupling_coef(a_shelf, hvel, do_i_shelf, h_harm, bbl_thick, & - kv_bbl, z_i, h_ml, dt, j, G, GV, CS, visc, & + kv_bbl, z_i, h_ml, dt, j, G, GV, US, CS, visc, & forces, work_on_u=.false., OBC=OBC, shelf=.true.) else ! Find upwind-biased thickness near the surface. ! Perhaps this needs to be done more carefully, via find_eta. @@ -966,7 +968,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) endif ; enddo enddo call find_coupling_coef(a_shelf, hvel_shelf, do_i_shelf, h_harm, & - bbl_thick, kv_bbl, z_i, h_ml, dt, j, G, GV, CS, & + bbl_thick, kv_bbl, z_i, h_ml, dt, j, G, GV, US, CS, & visc, forces, work_on_u=.false., OBC=OBC, shelf=.true.) endif do i=is,ie ; if (do_i_shelf(i)) CS%a1_shelf_v(i,J) = a_shelf(i,1) ; enddo @@ -1034,9 +1036,10 @@ end subroutine vertvisc_coef !! interfaces. If BOTTOMDRAGLAW is defined, the minimum of Hbbl and half the !! adjacent layer thicknesses are used to calculate a[k] near the bottom. subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & - dt, j, G, GV, CS, visc, forces, work_on_u, OBC, shelf) + dt, j, G, GV, US, CS, visc, forces, work_on_u, OBC, shelf) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZK_(GV)+1), & intent(out) :: a_cpl !< Coupling coefficient across interfaces, in Z s-1 real, dimension(SZIB_(G),SZK_(GV)), & @@ -1292,11 +1295,11 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, do i=is,ie ; if (do_i(i)) then if (GV%nkml>0) nk_visc(i) = real(GV%nkml+1) if (work_on_u) then - u_star(I) = 0.5*GV%m_to_Z*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star(I) = 0.5*US%m_to_Z*(forces%ustar(i,j) + forces%ustar(i+1,j)) absf(I) = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) if (CS%dynamic_viscous_ML) nk_visc(I) = visc%nkml_visc_u(I,j) + 1 else - u_star(i) = 0.5*GV%m_to_Z*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star(i) = 0.5*US%m_to_Z*(forces%ustar(i,j) + forces%ustar(i,j+1)) absf(i) = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) if (CS%dynamic_viscous_ML) nk_visc(i) = visc%nkml_visc_v(i,J) + 1 endif @@ -1307,16 +1310,16 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (do_OBCS) then ; if (work_on_u) then do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) & - u_star(I) = GV%m_to_Z*forces%ustar(i,j) + u_star(I) = US%m_to_Z*forces%ustar(i,j) if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) & - u_star(I) = GV%m_to_Z*forces%ustar(i+1,j) + u_star(I) = US%m_to_Z*forces%ustar(i+1,j) endif ; enddo else do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) & - u_star(i) = GV%m_to_Z*forces%ustar(i,j) + u_star(i) = US%m_to_Z*forces%ustar(i,j) if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) & - u_star(i) = GV%m_to_Z*forces%ustar(i,j+1) + u_star(i) = US%m_to_Z*forces%ustar(i,j+1) endif ; enddo endif ; endif @@ -1557,7 +1560,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, CS) end subroutine vertvisc_limit_vel !> Initialize the vertical friction module -subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & +subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & ntrunc, CS) type(ocean_internal_state), & target, intent(in) :: MIS !< The "MOM Internal State", a set of pointers @@ -1566,6 +1569,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & type(time_type), target, intent(in) :: Time !< Current model time type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< File to parse for parameters type(diag_ctrl), target, intent(inout) :: diag !< Diagnostic control structure type(accel_diag_ptrs), intent(inout) :: ADp !< Acceleration diagnostic pointers @@ -1662,18 +1666,18 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & call get_param(param_file, mdl, "KV", CS%Kv, & "The background kinematic viscosity in the interior. \n"//& "The molecular value, ~1e-6 m2 s-1, may be used.", & - units="m2 s-1", fail_if_missing=.true., scale=GV%m_to_Z**2, unscaled=Kv_dflt) + units="m2 s-1", fail_if_missing=.true., scale=US%m_to_Z**2, unscaled=Kv_dflt) if (GV%nkml < 1) call get_param(param_file, mdl, "KVML", CS%Kvml, & "The kinematic viscosity in the mixed layer. A typical \n"//& "value is ~1e-2 m2 s-1. KVML is not used if \n"//& "BULKMIXEDLAYER is true. The default is set by KV.", & - units="m2 s-1", default=Kv_dflt, scale=GV%m_to_Z**2) + units="m2 s-1", default=Kv_dflt, scale=US%m_to_Z**2) if (.not.CS%bottomdraglaw) call get_param(param_file, mdl, "KVBBL", CS%Kvbbl, & "The kinematic viscosity in the benthic boundary layer. \n"//& "A typical value is ~1e-2 m2 s-1. KVBBL is not used if \n"//& "BOTTOMDRAGLAW is true. The default is set by KV.", & - units="m2 s-1", default=Kv_dflt, scale=GV%m_to_Z**2) + units="m2 s-1", default=Kv_dflt, scale=US%m_to_Z**2) call get_param(param_file, mdl, "HBBL", CS%Hbbl, & "The thickness of a bottom boundary layer with a \n"//& "viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or \n"//& diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 89393c2c8c..795d49694b 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -18,6 +18,7 @@ module DOME_tracer use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type @@ -134,10 +135,11 @@ function register_DOME_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) end function register_DOME_tracer !> Initializes the NTR tracer fields in tr(:,:,:,:) and sets up the tracer output. -subroutine initialize_DOME_tracer(restart, day, G, GV, h, diag, OBC, CS, & +subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & sponge_CSp, diag_to_Z_CSp, param_file) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: restart !< .true. if the fields have already !! been read from a restart file. type(time_type), target, intent(in) :: day !< Time of the start of the run. @@ -218,8 +220,8 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, h, diag, OBC, CS, & do k=nz,1,-1 e(K) = e(K+1) + h(i,j,k)*GV%H_to_Z do m=7,NTR - e_top = (-600.0*real(m-1) + 3000.0) * GV%m_to_Z - e_bot = (-600.0*real(m-1) + 2700.0) * GV%m_to_Z + e_top = (-600.0*real(m-1) + 3000.0) * US%m_to_Z + e_bot = (-600.0*real(m-1) + 2700.0) * US%m_to_Z if (e_top < e(K)) then if (e_top < e(K+1)) then ; d_tr = 0.0 elseif (e_bot < e(K+1)) then diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index ae9690aca4..3dcd9ac192 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -16,6 +16,7 @@ module MOM_tracer_flow_control use MOM_sponge, only : sponge_CS use MOM_ALE_sponge, only : ALE_sponge_CS use MOM_tracer_registry, only : tracer_registry_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type #include @@ -141,9 +142,10 @@ end subroutine call_tracer_flux_init !> The following 5 subroutines and associated definitions provide the !! machinery to register and call the subroutines that initialize !! tracers and apply vertical column processes to tracers. -subroutine call_tracer_register(HI, GV, param_file, CS, tr_Reg, restart_CS) +subroutine call_tracer_register(HI, GV, US, param_file, CS, tr_Reg, restart_CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(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(tracer_flow_control_CS), pointer :: CS !< A pointer that is set to point to the @@ -237,7 +239,7 @@ subroutine call_tracer_register(HI, GV, param_file, CS, tr_Reg, restart_CS) register_ideal_age_tracer(HI, GV, param_file, CS%ideal_age_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_regional_dyes) CS%use_regional_dyes = & - register_dye_tracer(HI, GV, param_file, CS%dye_tracer_CSp, & + register_dye_tracer(HI, GV, US, param_file, CS%dye_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_oil) CS%use_oil = & register_oil_tracer(HI, GV, param_file, CS%oil_tracer_CSp, & @@ -268,7 +270,7 @@ end subroutine call_tracer_register !> This subroutine calls all registered tracer initialization !! subroutines. -subroutine tracer_flow_control_init(restart, day, G, GV, h, param_file, diag, OBC, & +subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag, OBC, & CS, sponge_CSp, ALE_sponge_CSp, diag_to_Z_CSp, tv) logical, intent(in) :: restart !< 1 if the fields have already !! been read from a restart file. @@ -276,6 +278,7 @@ subroutine tracer_flow_control_init(restart, day, G, GV, h, param_file, diag, OB type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid !! structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h !< Layer thicknesses, in H !! (usually m or kg m-2) type(param_file_type), intent(in) :: param_file !< A structure to parse for @@ -308,7 +311,7 @@ subroutine tracer_flow_control_init(restart, day, G, GV, h, param_file, diag, OB call USER_initialize_tracer(restart, day, G, GV, h, diag, OBC, CS%USER_tracer_example_CSp, & sponge_CSp, diag_to_Z_CSp) if (CS%use_DOME_tracer) & - call initialize_DOME_tracer(restart, day, G, GV, h, diag, OBC, CS%DOME_tracer_CSp, & + call initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS%DOME_tracer_CSp, & sponge_CSp, diag_to_Z_CSp, param_file) if (CS%use_ISOMIP_tracer) & call initialize_ISOMIP_tracer(restart, day, G, GV, h, diag, OBC, CS%ISOMIP_tracer_CSp, & diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index c9a8706e3c..1416fb9655 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -18,6 +18,7 @@ module regional_dyes use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type @@ -61,9 +62,10 @@ module regional_dyes !> This subroutine is used to register tracer fields and subroutines !! to be used with MOM. -function register_dye_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) +function register_dye_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(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(dye_tracer_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module @@ -135,15 +137,15 @@ function register_dye_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) CS%dye_source_mindepth(:) = -1.e30 call get_param(param_file, mdl, "DYE_SOURCE_MINDEPTH", CS%dye_source_mindepth, & "This is the minumum depth at which we inject dyes.", & - units="m", scale=GV%m_to_Z, fail_if_missing=.true.) - if (minval(CS%dye_source_mindepth(:)) < -1.e29*GV%m_to_Z) & + units="m", scale=US%m_to_Z, fail_if_missing=.true.) + if (minval(CS%dye_source_mindepth(:)) < -1.e29*US%m_to_Z) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MINDEPTH") CS%dye_source_maxdepth(:) = -1.e30 call get_param(param_file, mdl, "DYE_SOURCE_MAXDEPTH", CS%dye_source_maxdepth, & "This is the maximum depth at which we inject dyes.", & - units="m", scale=GV%m_to_Z, fail_if_missing=.true.) - if (minval(CS%dye_source_maxdepth(:)) < -1.e29*GV%m_to_Z) & + units="m", scale=US%m_to_Z, fail_if_missing=.true.) + if (minval(CS%dye_source_maxdepth(:)) < -1.e29*US%m_to_Z) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MAXDEPTH ") allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr)) ; CS%tr(:,:,:,:) = 0.0 diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 2eda7d2f1d..7c16ade9b5 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -9,6 +9,7 @@ module BFB_initialization use MOM_grid, only : ocean_grid_type use MOM_sponge, only : set_up_sponge_field, initialize_sponge, sponge_CS use MOM_tracer_registry, only : tracer_registry_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type use MOM_verticalGrid, only : verticalGrid_type @@ -70,9 +71,10 @@ end subroutine BFB_set_coord !> This subroutine sets up the sponges for the southern bouundary of the domain. Maximum damping occurs !! within 2 degrees lat of the boundary. The damping linearly decreases northward over the next 2 degrees. -subroutine BFB_initialize_sponges_southonly(G, GV, use_temperature, tv, param_file, CSp, h) +subroutine BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, param_file, CSp, h) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: use_temperature !< If true, temperature and salinity are used as !! state variables. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables @@ -102,7 +104,7 @@ subroutine BFB_initialize_sponges_southonly(G, GV, use_temperature, tv, param_fi ! Set up sponges for DOME configuration call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0, scale=GV%m_to_Z) + "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "SOUTHLAT", slat, & "The southern latitude of the domain.", units="degrees") diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 7d282bffd5..bd4f652dec 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -10,6 +10,7 @@ module DOME2d_initialization use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type use MOM_sponge, only : sponge_CS, set_up_sponge_field, initialize_sponge +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type @@ -84,9 +85,10 @@ subroutine DOME2d_initialize_topography ( D, G, param_file, max_depth ) end subroutine DOME2d_initialize_topography !> Initialize thicknesses according to coordinate mode -subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params ) +subroutine DOME2d_initialize_thickness ( h, G, GV, US, param_file, just_read_params ) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized, in H. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -115,7 +117,7 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params call MOM_mesg("MOM_initialization.F90, DOME2d_initialize_thickness: setting thickness") call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & - default=1.e-3, units="m", do_not_log=.true., scale=GV%m_to_Z) + default=1.e-3, units="m", do_not_log=.true., scale=US%m_to_Z) call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 4315420e9a..40e6e422df 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -14,6 +14,7 @@ module DOME_initialization use MOM_open_boundary, only : OBC_segment_type, register_segment_tracer use MOM_tracer_registry, only : tracer_registry_type, tracer_type use MOM_tracer_registry, only : tracer_name_lookup +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type @@ -134,9 +135,10 @@ end subroutine DOME_initialize_thickness !! number of tracers should be restored within each sponge. The ! !! interface height is always subject to damping, and must always be ! !! the first registered field. ! -subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) +subroutine DOME_initialize_sponges(G, GV, US, tv, PF, CSp) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available !! thermodynamic fields, including potential temperature and !! salinity or mixed layer density. Absent fields have NULL ptrs. @@ -167,7 +169,7 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) ! Set up sponges for DOME configuration call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0, scale=GV%m_to_Z) + "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) H0(1) = 0.0 do k=2,nz ; H0(k) = -(real(k-1)-0.5)*G%max_depth / real(nz-1) ; enddo @@ -229,7 +231,7 @@ end subroutine DOME_initialize_sponges !> This subroutine sets the properties of flow at open boundary conditions. !! This particular example is for the DOME inflow describe in Legg et al. 2006. -subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg) +subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary !! conditions are used. @@ -239,6 +241,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg) !! fields have NULL ptrs. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry. @@ -271,7 +274,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg) IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! The following variables should be transformed into runtime parameters. - D_edge = 300.0*GV%m_to_Z ! The thickness of dense fluid in the inflow. + D_edge = 300.0*US%m_to_Z ! The thickness of dense fluid in the inflow. Ri_trans = 1.0/3.0 ! The shear Richardson number in the transition region ! region of the specified shear profile. diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 2256d31490..c5d55640a6 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -13,6 +13,7 @@ module ISOMIP_initialization use MOM_io, only : file_exists use MOM_io, only : MOM_read_data use MOM_io, only : slasher +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type @@ -117,9 +118,10 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth) end subroutine ISOMIP_initialize_topography !> Initialization of thicknesses -subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_params) +subroutine ISOMIP_initialize_thickness ( h, G, GV, US, param_file, tv, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized, in H. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -150,7 +152,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness") call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & - 'Minimum layer thickness', units='m', default=1.e-3, do_not_log=just_read, scale=GV%m_to_Z) + 'Minimum layer thickness', units='m', default=1.e-3, do_not_log=just_read, scale=US%m_to_Z) call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) @@ -399,9 +401,10 @@ end subroutine ISOMIP_initialize_temperature_salinity !> Sets up the the inverse restoration time (Idamp), and ! the values towards which the interface heights and an arbitrary ! number of tracers should be restored within each sponge. -subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) +subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers !! to any available thermodynamic !! fields, potential temperature and @@ -442,7 +445,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed call get_param(PF, mdl, "MIN_THICKNESS", min_thickness, "Minimum layer thickness", & - units="m", default=1.e-3, scale=GV%m_to_Z) + units="m", default=1.e-3, scale=US%m_to_Z) call get_param(PF, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE) @@ -471,7 +474,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) ! Set up sponges for ISOMIP configuration call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0, scale=GV%m_to_Z) + "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) if (associated(CSp)) call MOM_error(FATAL, & "ISOMIP_initialize_sponges called with an associated control structure.") @@ -627,7 +630,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) filename = trim(inputdir)//trim(state_file) if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & "ISOMIP_initialize_sponges: Unable to open "//trim(filename)) - call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=GV%m_to_Z) + call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=US%m_to_Z) call MOM_read_data(filename, temp_var, T(:,:,:), G%Domain) call MOM_read_data(filename, salt_var, S(:,:,:), G%Domain) diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 63586ec541..341f6e99f6 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -16,6 +16,7 @@ module Kelvin_initialization use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_E use MOM_open_boundary, only : OBC_DIRECTION_S, OBC_DIRECTION_W use MOM_open_boundary, only : OBC_registry_type +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type use MOM_time_manager, only : time_type, time_type_to_real @@ -155,13 +156,14 @@ subroutine Kelvin_initialize_topography(D, G, param_file, max_depth) end subroutine Kelvin_initialize_topography !> This subroutine sets the properties of flow at open boundary conditions. -subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, h, Time) +subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary !! conditions are used. type(Kelvin_OBC_CS), pointer :: CS !< Kelvin wave control structure. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness, in H. type(time_type), intent(in) :: Time !< model time. @@ -192,9 +194,9 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, h, Time) if (CS%mode == 0) then omega = 2.0 * PI / (12.42 * 3600.0) ! M2 Tide period - val1 = GV%m_to_Z * sin(omega * time_sec) + val1 = US%m_to_Z * sin(omega * time_sec) else - N0 = sqrt((CS%rho_range / CS%rho_0) * GV%g_Earth * (GV%m_to_Z * CS%H0)) + N0 = sqrt((CS%rho_range / CS%rho_0) * GV%g_Earth * (US%m_to_Z * CS%H0)) ! Two wavelengths in domain plx = 4.0 * PI / G%len_lon pmz = PI * CS%mode / CS%H0 diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 01c0bcf653..f4bd8ed8a3 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -10,10 +10,11 @@ module MOM_wave_interface use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type -use MOM_verticalgrid, only : verticalGrid_type use MOM_safe_alloc, only : safe_alloc_ptr use MOM_time_manager, only : time_type, operator(+), operator(/) +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, surface +use MOM_verticalgrid, only : verticalGrid_type use data_override_mod, only : data_override_init, data_override implicit none @@ -185,11 +186,12 @@ module MOM_wave_interface contains !> Initializes parameters related to MOM_wave_interface -subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) +subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) type(time_type), target, intent(in) :: Time !< Time (s) - type(ocean_grid_type), intent(inout) :: G !< Grid structure + type(ocean_grid_type), intent(inout) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - type(param_file_type), intent(in) :: param_file !< Input parameter structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< Input parameter structure type(wave_parameters_CS), pointer :: CS !< Wave parameter control structure type(diag_ctrl), target, intent(inout) :: diag !< Diagnostic Pointer ! Local variables @@ -276,7 +278,7 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) 'Surface Stokes (y) for test profile',& units='m/s',default=0.0) call get_param(param_file,mdl,"TP_WVL",TP_WVL,& - units='m', default=50.0, scale=GV%m_to_Z) + units='m', default=50.0, scale=US%m_to_Z) case (SURFBANDS_STRING)! Surface Stokes Drift Bands WaveMethod = SURFBANDS call get_param(param_file, mdl, "SURFBAND_SOURCE",TMPSTRING2, & @@ -417,12 +419,13 @@ subroutine MOM_wave_interface_init_lite(param_file) end subroutine MOM_wave_interface_init_lite !> Subroutine that handles updating of surface wave/Stokes drift related properties -subroutine Update_Surface_Waves(G,GV,Day,DT,CS) +subroutine Update_Surface_Waves(G, GV, US, Day, dt, CS) type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure type(ocean_grid_type), intent(inout) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - type(time_type), intent(in) :: Day !< Time (s) - type(time_type), intent(in) :: DT !< Timestep (s) + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(time_type), intent(in) :: Day !< Time (s) + type(time_type), intent(in) :: dt !< Timestep (s) ! Local variables integer :: ii, jj, kk, b type(time_type) :: Day_Center @@ -434,7 +437,7 @@ subroutine Update_Surface_Waves(G,GV,Day,DT,CS) ! Do nothing elseif (WaveMethod==SURFBANDS) then if (DataSource==DATAOVR) then - call Surface_Bands_by_data_override(day_center,G,GV,CS) + call Surface_Bands_by_data_override(day_center, G, GV, US, CS) elseif (DataSource==Coupler) then ! Reserve for coupler hooks elseif (DataSource==Input) then @@ -458,13 +461,11 @@ end subroutine Update_Surface_Waves !> Constructs the Stokes Drift profile on the model grid based on !! desired coupling options -subroutine Update_Stokes_Drift(G,GV,CS,h,ustar) - type(wave_parameters_CS), & - pointer :: CS !< Wave parameter Control structure - type(ocean_grid_type), & - intent(inout) :: G !< Grid structure - type(verticalGrid_type), & - intent(in) :: GV !< Vertical grid structure +subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) + type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure + type(ocean_grid_type), intent(inout) :: G !< Grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h ! A subroutine to fill the Stokes drift from a NetCDF file !! using the data_override procedures. -subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) +subroutine Surface_Bands_by_data_override(day_center, G, GV, US, CS) use NETCDF type(time_type), intent(in) :: day_center !< Center of timestep (s) type(wave_parameters_CS), pointer :: CS !< Wave structure type(ocean_grid_type), intent(inout) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal and psuedo-meridional real :: temp_y(SZI_(G),SZJ_(G)) ! Stokes drift of band at h-points, in m/s @@ -805,7 +807,7 @@ subroutine Surface_Bands_by_data_override(day_center,G,GV,CS) endif NUMBANDS = ID do B = 1,NumBands - CS%WaveNum_Cen(b) = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*GV%m_to_Z**2) + CS%WaveNum_Cen(b) = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*US%m_to_Z**2) enddo endif @@ -855,26 +857,24 @@ end subroutine Surface_Bands_by_data_override !! Note this can be called with an unallocated Waves pointer, which is okay if we !! want the wind-speed only dependent Langmuir number. Therefore, we need to be !! careful about what we try to access here. -subroutine get_Langmuir_Number( LA, G, GV, HBL, USTAR, i, j, & +subroutine get_Langmuir_Number( LA, G, GV, US, HBL, USTAR, i, j, & H, U_H, V_H, Override_MA, Waves ) - type(ocean_grid_type), & - intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), & - intent(in) :: GV !< Ocean vertical grid structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: i !< Meridional index of h-point integer, intent(in) :: j !< Zonal index of h-point real, intent(in) :: USTAR !< Friction velocity (m/s) real, intent(in) :: HBL !< (Positive) thickness of boundary layer (Z) - logical, optional,& - intent(in) :: Override_MA !< Override to use misalignment in LA + logical, optional, intent(in) :: Override_MA !< Override to use misalignment in LA !! calculation. This can be used if diagnostic !! LA outputs are desired that are different than !! those used by the dynamical model. - real, optional, dimension(SZK_(GV)), & + real, dimension(SZK_(GV)), optional, & intent(in) :: H !< Grid layer thickness in H (m or kg/m2) - real, optional, dimension(SZK_(GV)), & + real, dimension(SZK_(GV)), optional, & intent(in) :: U_H !< Zonal velocity at H point (m/s) - real, optional, dimension(SZK_(GV)), & + real, dimension(SZK_(GV)), optional, & intent(in) :: V_H !< Meridional velocity at H point (m/s) type(Wave_parameters_CS), & pointer :: Waves !< Surface wave control structure. @@ -891,7 +891,7 @@ subroutine get_Langmuir_Number( LA, G, GV, HBL, USTAR, i, j, & integer :: KK, BB ! Compute averaging depth for Stokes drift (negative) - Dpt_LASL = min(-0.1*GV%m_to_Z, -LA_FracHBL*HBL) + Dpt_LASL = min(-0.1*US%m_to_Z, -LA_FracHBL*HBL) USE_MA = LA_Misalignment if (present(Override_MA)) USE_MA = Override_MA @@ -940,7 +940,7 @@ subroutine get_Langmuir_Number( LA, G, GV, HBL, USTAR, i, j, & call Get_SL_Average_Prof( GV, Dpt_LASL, H, VS_H, LA_STKy) LA_STK = sqrt(LA_STKX**2 + LA_STKY**2) elseif (WaveMethod==LF17) then - call get_StokesSL_LiFoxKemper(ustar,hbl*LA_FracHBL, GV, LA_STK, LA) + call get_StokesSL_LiFoxKemper(ustar,hbl*LA_FracHBL, GV, US, LA_STK, LA) endif if (.not.(WaveMethod==LF17)) then @@ -976,12 +976,12 @@ end subroutine get_Langmuir_Number !! - BGR change output to LA from Efactor !! - BGR remove u10 input !! - BGR note: fixed parameter values should be changed to "get_params" -subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US_SL, LA) +subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) real, intent(in) :: ustar !< water-side surface friction velocity (m/s) real, intent(in) :: hbl !< boundary layer depth (Z) - type(verticalGrid_type), & - intent(in) :: GV !< Ocean vertical grid structure - real, intent(out) :: US_SL !< Surface layer averaged Stokes drift (m/s) + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, intent(out) :: UStokes_SL !< Surface layer averaged Stokes drift (m/s) real, intent(out) :: LA !< Langmuir number ! Local variables ! parameters @@ -995,15 +995,15 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US_SL, LA) us_to_u10 = 0.0162, & ! loss ratio of Stokes transport r_loss = 0.667 - real :: us, hm0, fm, fp, vstokes, kphil, kstar + real :: UStokes, hm0, fm, fp, vstokes, kphil, kstar real :: z0, z0i, r1, r2, r3, r4, tmp, lasl_sqr_i real :: u10 if (ustar > 0.0) then ! Computing u10 based on u_star and COARE 3.5 relationships - call ust_2_u10_coare3p5(ustar*sqrt(GV%Rho0/1.225),U10,GV) + call ust_2_u10_coare3p5(ustar*sqrt(GV%Rho0/1.225), u10, GV, US) ! surface Stokes drift - us = us_to_u10*u10 + UStokes = us_to_u10*u10 ! ! significant wave height from Pierson-Moskowitz ! spectrum (Bouws, 1998) @@ -1011,7 +1011,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US_SL, LA) ! ! peak frequency (PM, Bouws, 1998) tmp = 2.0 * PI * u19p5_to_u10 * u10 - fp = 0.877 * (GV%g_Earth*GV%m_to_Z) / tmp + fp = 0.877 * (GV%g_Earth*US%m_to_Z) / tmp ! ! mean frequency fm = fm_into_fp * fp @@ -1024,7 +1024,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US_SL, LA) ! ! the general peak wavenumber for Phillips' spectrum ! (Breivik et al., 2016) with correction of directional spreading - kphil = 0.176 * us / vstokes + kphil = 0.176 * UStokes / vstokes ! ! surface layer averaged Stokes dirft with Stokes drift profile ! estimated from Phillips' spectrum (Breivik et al., 2016) @@ -1045,10 +1045,10 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US_SL, LA) r4 = ( 0.125 + 0.0946 / kstar * z0i ) * & sqrt( 2.0 * PI *kstar * z0) * & erfc( sqrt( 2.0 * kstar * z0 ) ) - us_sl = us * (0.715 + r1 + r2 + r3 + r4) - LA = sqrt(ustar/us_sl) + UStokes_sl = UStokes * (0.715 + r1 + r2 + r3 + r4) + LA = sqrt(ustar/UStokes_sl) else - us_sl = 0.0 + UStokes_sl = 0.0 LA=1.e8 endif return @@ -1127,32 +1127,32 @@ end subroutine Get_SL_Average_Band !! use for comparing MOM6 simulation to his LES !! computed at z mid point (I think) and not depth averaged. !! Should be fine to integrate in frequency from 0.1 to sqrt(-0.2*grav*2pi/dz -subroutine DHH85_mid(GV, ust, zpt, US) - type(verticalGrid_type), & - intent(in) :: GV !< Ocean vertical grid +subroutine DHH85_mid(GV, US, ust, zpt, UStokes) + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: UST !< Surface friction velocity (m/s) real, intent(in) :: ZPT !< Depth to get Stokes drift (Z) !### THIS IS NOT USED YET. - real, intent(out) :: US !< Stokes drift (m/s) + real, intent(out) :: UStokes !< Stokes drift (m/s) ! real :: ann, Bnn, Snn, Cnn, Dnn real :: omega_peak, omega, u10, WA, domega real :: omega_min, omega_max, wavespec, Stokes integer :: Nomega, OI - ! + WA = WaveAge u10 = WaveWind !/ omega_min = 0.1 ! Hz ! Cut off at 30cm for now... - omega_max = 6.5 ! ~sqrt(0.2*(GV%g_Earth*GV%m_to_Z)*2*pi/0.3) + omega_max = 6.5 ! ~sqrt(0.2*(GV%g_Earth*US%m_to_Z)*2*pi/0.3) domega = 0.05 NOmega = (omega_max-omega_min)/domega ! if (WaveAgePeakFreq) then - omega_peak = (GV%g_Earth*GV%m_to_Z) / (WA * u10) + omega_peak = (GV%g_Earth*US%m_to_Z) / (WA * u10) else - omega_peak = 2. * pi * 0.13 * (GV%g_Earth*GV%m_to_Z) / U10 + omega_peak = 2. * pi * 0.13 * (GV%g_Earth*US%m_to_Z) / U10 endif !/ Ann = 0.006 * WaveAge**(-0.55) @@ -1163,17 +1163,17 @@ subroutine DHH85_mid(GV, ust, zpt, US) Cnn = Cnn - 6.0*log10(WA) endif !/ - US = 0.0 + UStokes = 0.0 omega = omega_min + 0.5*domega do oi = 1,nomega-1 Dnn = exp ( -0.5 * (omega-omega_peak)**2 / (Snn**2 * omega_peak**2) ) ! wavespec units = m2s - wavespec = (Ann * (GV%g_Earth*GV%m_to_Z)**2 / (omega_peak*omega**4 ) ) * & + wavespec = (Ann * (GV%g_Earth*US%m_to_Z)**2 / (omega_peak*omega**4 ) ) * & exp(-bnn*(omega_peak/omega)**4)*Cnn**Dnn ! Stokes units m (multiply by frequency range for units of m/s) Stokes = 2.0 * wavespec * omega**3 * & - exp( 2.0 * omega**2 * zpt/(GV%g_Earth*GV%m_to_Z)) / (GV%g_Earth*GV%m_to_Z) - US=US+Stokes*domega + exp( 2.0 * omega**2 * zpt/(GV%g_Earth*US%m_to_Z)) / (GV%g_Earth*US%m_to_Z) + UStokes = UStokes + Stokes*domega omega = omega + domega enddo @@ -1293,10 +1293,12 @@ end subroutine CoriolisStokes !! Probably doesn't belong in this module, but it is used here to estimate !! wind speed for wind-wave relationships. Should be a fine way to estimate !! the neutral wind-speed as written here. -subroutine ust_2_u10_coare3p5(USTair,U10,GV) +subroutine ust_2_u10_coare3p5(USTair, U10, GV, US) real, intent(in) :: USTair !< Wind friction velocity (m/s) real, intent(out) :: U10 !< 10-m neutral wind speed (m/s) type(verticalGrid_type), intent(in) :: GV !< vertical grid type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + ! Local variables real, parameter :: vonkar = 0.4 ! Should access a get_param von karman real, parameter :: nu=1e-6 ! Should access a get_param air-viscosity @@ -1309,7 +1311,7 @@ subroutine ust_2_u10_coare3p5(USTair,U10,GV) ! Note in Edson et al. 2013, eq. 13 m is given as 0.017. However, ! m=0.0017 reproduces the curve in their figure 6. - z0sm = 0.11 * nu * GV%m_to_Z / USTair !Compute z0smooth from ustar guess + z0sm = 0.11 * nu * US%m_to_Z / USTair !Compute z0smooth from ustar guess u10 = USTair/sqrt(0.001) !Guess for u10 u10a = 1000 @@ -1320,7 +1322,7 @@ subroutine ust_2_u10_coare3p5(USTair,U10,GV) alpha = min(0.028, 0.0017 * u10 - 0.005) z0rough = alpha * USTair**2 / GV%g_Earth ! Compute z0rough from ustar guess z0 = z0sm + z0rough - CD = ( vonkar / log(10.*GV%m_to_Z / z0) )**2 ! Compute CD from derived roughness + CD = ( vonkar / log(10.*US%m_to_Z / z0) )**2 ! Compute CD from derived roughness u10 = USTair/sqrt(CD) ! Compute new u10 from derived CD, while loop ! ends and checks for convergence...CT counter ! makes sure loop doesn't run away if function diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index 76d028c6f4..5ed179190a 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -10,6 +10,7 @@ module Neverland_initialization use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type use MOM_tracer_registry, only : tracer_registry_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type @@ -102,9 +103,10 @@ end function spike !! by finding the depths of interfaces in a specified latitude-dependent !! temperature profile with an exponentially decaying thermocline on top of a !! linear stratification. -subroutine Neverland_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ref) +subroutine Neverland_initialize_thickness(h, G, GV, US, param_file, eqn_of_state, P_ref) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(out), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< The thickness that is being !! initialized, in H. type(param_file_type), intent(in) :: param_file !< A structure indicating the open @@ -126,7 +128,7 @@ subroutine Neverland_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ call MOM_mesg(" Neverland_initialization.F90, Neverland_initialize_thickness: setting thickness", 5) call get_param(param_file, mdl, "INIT_THICKNESS_PROFILE", h_profile, & - "Profile of initial layer thicknesses.", units="m", scale=GV%m_to_Z, & + "Profile of initial layer thicknesses.", units="m", scale=US%m_to_Z, & fail_if_missing=.true.) ! e0 is the notional position of interfaces diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 580638e415..e5eea1d2d2 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -10,6 +10,7 @@ module Phillips_initialization use MOM_grid, only : ocean_grid_type use MOM_sponge, only : set_up_sponge_field, initialize_sponge, sponge_CS use MOM_tracer_registry, only : tracer_registry_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type @@ -29,15 +30,16 @@ module Phillips_initialization contains !> Initialize the thickness field for the Phillips model test case. -subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. +subroutine Phillips_initialize_thickness(h, G, GV, US, param_file, just_read_params) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H. - type(param_file_type), intent(in) :: param_file !< A structure indicating the open file - !! to parse for model parameter values. + intent(out) :: h !< The thickness that is being initialized, in H. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + !! only read parameters without changing h. real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces, in depth units (Z). real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta, in depth units (Z). @@ -65,7 +67,7 @@ subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "JET_HEIGHT", jet_height, & "The interface height scale associated with the \n"//& - "zonal-mean jet.", units="m", scale=GV%m_to_Z, & + "zonal-mean jet.", units="m", scale=US%m_to_Z, & fail_if_missing=.not.just_read, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -109,17 +111,18 @@ subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) end subroutine Phillips_initialize_thickness !> Initialize the velocity fields for the Phillips model test case -subroutine Phillips_initialize_velocity(u, v, G, GV, param_file, just_read_params) +subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: u !< i-component of velocity [m/s] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: v !< j-component of velocity [m/s] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to - !! parse for modelparameter values. + !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + !! only read parameters without changing h. real :: damp_rate, jet_width, jet_height, x_2, y_2 real :: velocity_amplitude, pi @@ -139,7 +142,7 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, param_file, just_read_param fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "JET_HEIGHT", jet_height, & "The interface height scale associated with the \n"//& - "zonal-mean jet.", units="m", scale=GV%m_to_Z, & + "zonal-mean jet.", units="m", scale=US%m_to_Z, & fail_if_missing=.not.just_read, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -185,9 +188,10 @@ end subroutine Phillips_initialize_velocity !> Sets up the the inverse restoration time (Idamp), and the values towards which the interface !! heights and an arbitrary number of tracers should be restored within each sponge for the Phillips !! model test case -subroutine Phillips_initialize_sponges(G, GV, tv, param_file, CSp, h) +subroutine Phillips_initialize_sponges(G, GV, US, tv, param_file, CSp, h) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers !! to any available thermodynamic !! fields, potential temperature and @@ -239,7 +243,7 @@ subroutine Phillips_initialize_sponges(G, GV, tv, param_file, CSp, h) fail_if_missing=.true.) call get_param(param_file, mdl, "JET_HEIGHT", jet_height, & "The interface height scale associated with the \n"//& - "zonal-mean jet.", units="m", scale=GV%m_to_Z, & + "zonal-mean jet.", units="m", scale=US%m_to_Z, & fail_if_missing=.true.) half_depth = G%max_depth*half_strat diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index f9516ef91e..dd6fa2d2e7 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -10,6 +10,7 @@ module SCM_CVMix_tests use MOM_grid, only : ocean_grid_type use MOM_verticalgrid, only : verticalGrid_type use MOM_safe_alloc, only : safe_alloc_ptr +use MOM_unit_scaling, only : unit_scale_type use MOM_time_manager, only : time_type, operator(+), operator(/), time_type_to_real use MOM_variables, only : thermo_var_ptrs, surface implicit none ; private @@ -45,12 +46,13 @@ module SCM_CVMix_tests contains !> Initializes temperature and salinity for the SCM CVMix test example -subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, param_file, just_read_params) - real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(out) :: T !< Potential temperature (degC) - real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(out) :: S !< Salinity (psu) - real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(in) :: h !< Layer thickness in H (often m or Pa) - type(ocean_grid_type), intent(in) :: G !< Grid structure - type(verticalGrid_type), intent(in) :: GV!< Vertical grid structure +subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read_params) + real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(out) :: T !< Potential temperature (degC) + real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(out) :: S !< Salinity (psu) + real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(in) :: h !< Layer thickness in H (often m or Pa) + type(ocean_grid_type), intent(in) :: G !< Grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Input parameter structure logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. @@ -77,10 +79,10 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, param_file, just_read_params) if (.not.just_read) call log_version(param_file, mdl, version) call get_param(param_file, mdl, "SCM_TEMP_MLD", UpperLayerTempMLD, & 'Initial temp mixed layer depth', & - units='m', default=0.0, scale=GV%m_to_Z, do_not_log=just_read) + units='m', default=0.0, scale=US%m_to_Z, do_not_log=just_read) call get_param(param_file, mdl, "SCM_SALT_MLD", UpperLayerSaltMLD, & 'Initial salt mixed layer depth', & - units='m', default=0.0, scale=GV%m_to_Z, do_not_log=just_read) + units='m', default=0.0, scale=US%m_to_Z, do_not_log=just_read) call get_param(param_file, mdl, "SCM_L1_SALT", UpperLayerSalt, & 'Layer 2 surface salinity', units='1e-3', default=35.0, do_not_log=just_read) call get_param(param_file, mdl, "SCM_L1_TEMP", UpperLayerTemp, & diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index b36b58297c..fbf1a0df97 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -7,6 +7,7 @@ module adjustment_initialization use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type @@ -26,9 +27,10 @@ module adjustment_initialization contains !> Initializes the layer thicknesses in the adjustment test case -subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_params) +subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized, in H. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -61,7 +63,7 @@ subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_par if (.not.just_read) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl,"S_REF",S_ref,fail_if_missing=.true.,do_not_log=.true.) call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness,'Minimum layer thickness', & - units='m', default=1.0e-3, do_not_log=just_read, scale=GV%m_to_Z) + units='m', default=1.0e-3, do_not_log=just_read, scale=US%m_to_Z) ! Parameters specific to this experiment configuration call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index 8e0e03ad94..b3b9662164 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -10,6 +10,7 @@ module benchmark_initialization use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type use MOM_tracer_registry, only : tracer_registry_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type @@ -71,10 +72,11 @@ end subroutine benchmark_initialize_topography !! by finding the depths of interfaces in a specified latitude-dependent !! temperature profile with an exponentially decaying thermocline on top of a !! linear stratification. -subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & +subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state, & P_ref, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized, in H. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -118,8 +120,8 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & k1 = GV%nk_rho_varies + 1 - ML_depth = 50.0 * GV%m_to_Z - thermocline_scale = 500.0 * GV%m_to_Z + ML_depth = 50.0 * US%m_to_Z + thermocline_scale = 500.0 * US%m_to_Z a_exp = 0.9 ! This block calculates T0(k) for the purpose of diagnosing where the diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 12ca05fded..95a8f073bf 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -11,6 +11,7 @@ module dumbbell_initialization use MOM_grid, only : ocean_grid_type use MOM_sponge, only : set_up_sponge_field, initialize_sponge, sponge_CS use MOM_tracer_registry, only : tracer_registry_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type @@ -70,9 +71,10 @@ subroutine dumbbell_initialize_topography ( D, G, param_file, max_depth ) end subroutine dumbbell_initialize_topography !> Initializes the layer thicknesses to be uniform in the dumbbell test case -subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_params) +subroutine dumbbell_initialize_thickness ( h, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized, in m. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -100,7 +102,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & 'Minimum thickness for layer',& - units='m', default=1.0e-3, do_not_log=just_read, scale=GV%m_to_Z) + units='m', default=1.0e-3, do_not_log=just_read, scale=US%m_to_Z) call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) @@ -246,9 +248,10 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, param_file end subroutine dumbbell_initialize_temperature_salinity !> Initialize the restoring sponges for the dumbbell test case -subroutine dumbbell_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) +subroutine dumbbell_initialize_sponges(G, GV, US, tv, param_file, use_ALE, CSp, ACSp) type(ocean_grid_type), intent(in) :: G !< Horizontal grid control structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid control structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables type(param_file_type), intent(in) :: param_file !< Parameter file structure logical, intent(in) :: use_ALE !< ALE flag @@ -281,7 +284,7 @@ subroutine dumbbell_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp call get_param(param_file, mdl, "DUMBBELL_S_RANGE", S_range, do_not_log=.true.) call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & 'Minimum thickness for layer',& - units='m', default=1.0e-3, do_not_log=.true., scale=GV%m_to_Z) + units='m', default=1.0e-3, do_not_log=.true., scale=US%m_to_Z) ! no active sponges if (sponge_time_scale <= 0.) return diff --git a/src/user/external_gwave_initialization.F90 b/src/user/external_gwave_initialization.F90 index 05a64c6069..153ec00b42 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -8,6 +8,7 @@ module external_gwave_initialization use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type use MOM_tracer_registry, only : tracer_registry_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -19,9 +20,10 @@ module external_gwave_initialization contains !> This subroutine initializes layer thicknesses for the external_gwave experiment. -subroutine external_gwave_initialize_thickness(h, G, GV, param_file, just_read_params) +subroutine external_gwave_initialize_thickness(h, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized, in H. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -50,7 +52,7 @@ subroutine external_gwave_initialize_thickness(h, G, GV, param_file, just_read_p if (.not.just_read) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "SSH_ANOMALY_HEIGHT", ssh_anomaly_height, & "The vertical displacement of the SSH anomaly. ", units="m", & - fail_if_missing=.not.just_read, do_not_log=just_read, scale=GV%m_to_Z) + fail_if_missing=.not.just_read, do_not_log=just_read, scale=US%m_to_Z) call get_param(param_file, mdl, "SSH_ANOMALY_WIDTH", ssh_anomaly_width, & "The lateral width of the SSH anomaly. ", units="coordinate", & fail_if_missing=.not.just_read, do_not_log=just_read) diff --git a/src/user/lock_exchange_initialization.F90 b/src/user/lock_exchange_initialization.F90 index e6dd3ee900..4114b709c8 100644 --- a/src/user/lock_exchange_initialization.F90 +++ b/src/user/lock_exchange_initialization.F90 @@ -9,6 +9,7 @@ module lock_exchange_initialization use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type use MOM_tracer_registry, only : tracer_registry_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -22,9 +23,10 @@ module lock_exchange_initialization !> This subroutine initializes layer thicknesses for the lock_exchange experiment. ! ----------------------------------------------------------------------------- -subroutine lock_exchange_initialize_thickness(h, G, GV, param_file, just_read_params) +subroutine lock_exchange_initialize_thickness(h, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized, in H. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -57,12 +59,12 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, param_file, just_read_pa call get_param(param_file, mdl, "FRONT_DISPLACEMENT", front_displacement, & "The vertical displacement of interfaces across the front. \n"//& "A value larger in magnitude that MAX_DEPTH is truncated,", & - units="m", fail_if_missing=.not.just_read, do_not_log=just_read, scale=GV%m_to_Z) + units="m", fail_if_missing=.not.just_read, do_not_log=just_read, scale=US%m_to_Z) call get_param(param_file, mdl, "THERMOCLINE_THICKNESS", thermocline_thickness, & "The thickness of the thermocline in the lock exchange \n"//& "experiment. A value of zero creates a two layer system \n"//& "with vanished layers in between the two inflated layers.", & - default=0., units="m", do_not_log=just_read, scale=GV%m_to_Z) + default=0., units="m", do_not_log=just_read, scale=US%m_to_Z) if (just_read) return ! All run-time parameters have been read, so return. diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 7ec04ba302..21f7b30788 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -11,6 +11,7 @@ module seamount_initialization use MOM_grid, only : ocean_grid_type use MOM_sponge, only : set_up_sponge_field, initialize_sponge, sponge_CS use MOM_tracer_registry, only : tracer_registry_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type @@ -73,9 +74,10 @@ end subroutine seamount_initialize_topography !> Initialization of thicknesses. !! This subroutine initializes the layer thicknesses to be uniform. -subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_params) +subroutine seamount_initialize_thickness ( h, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized, in H. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -101,7 +103,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & 'Minimum thickness for layer',& - units='m', default=1.0e-3, do_not_log=just_read, scale=GV%m_to_Z) + units='m', default=1.0e-3, do_not_log=just_read, scale=US%m_to_Z) call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index 4340d9dcda..bda2a8d895 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -11,6 +11,7 @@ module sloshing_initialization use MOM_grid, only : ocean_grid_type use MOM_sponge, only : set_up_sponge_field, initialize_sponge, sponge_CS use MOM_tracer_registry, only : tracer_registry_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type @@ -54,9 +55,10 @@ end subroutine sloshing_initialize_topography !! same thickness but all interfaces (except bottom and sea surface) are !! displaced according to a half-period cosine, with maximum value on the !! left and minimum value on the right. This sets off a regular sloshing motion. -subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_params) +subroutine sloshing_initialize_thickness ( h, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized, in H. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file @@ -114,14 +116,14 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_param enddo ! 2. Define displacement - a0 = 75.0 * GV%m_to_Z ! 75m Displacement amplitude in depth units. + a0 = 75.0 * US%m_to_Z ! 75m Displacement amplitude in depth units. do k = 1,nz+1 weight_z = - 4.0 * ( z_unif(k) + 0.5 )**2 + 1.0 x = G%geoLonT(i,j) / G%len_lon !### Perhaps the '+ weight_z' here should be '* weight_z' - RWH - displ(k) = a0 * cos(acos(-1.0)*x) + weight_z * GV%m_to_Z + displ(k) = a0 * cos(acos(-1.0)*x) + weight_z * US%m_to_Z if ( k == 1 ) then displ(k) = 0.0 diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index 96e7170bb6..668497fe11 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -7,6 +7,7 @@ module soliton_initialization use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type @@ -27,9 +28,10 @@ module soliton_initialization contains !> Initialization of thicknesses in Equatorial Rossby soliton test -subroutine soliton_initialize_thickness(h, G, GV) +subroutine soliton_initialize_thickness(h, G, GV, US) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized, in H. @@ -45,7 +47,7 @@ subroutine soliton_initialize_thickness(h, G, GV) x0 = 2.0*G%len_lon/3.0 y0 = 0.0 val1 = 0.395 - val2 = GV%m_to_Z * 0.771*(val1*val1) + val2 = US%m_to_Z * 0.771*(val1*val1) do j = G%jsc,G%jec ; do i = G%isc,G%iec do k = 1, nz diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index 8a97a3f636..4cef242cb1 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -7,6 +7,7 @@ module user_change_diffusivity use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density @@ -181,10 +182,11 @@ function val_weights(val, range) result(ans) end function val_weights !> Set up the module control structure. -subroutine user_change_diff_init(Time, G, GV, param_file, diag, CS) +subroutine user_change_diff_init(Time, G, GV, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for !! model parameter values. @@ -215,7 +217,7 @@ subroutine user_change_diff_init(Time, G, GV, param_file, diag, CS) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "USER_KD_ADD", CS%Kd_add, & "A user-specified additional diffusivity over a range of \n"//& - "latitude and density.", default=0.0, units="m2 s-1", scale=GV%m_to_Z**2) + "latitude and density.", default=0.0, units="m2 s-1", scale=US%m_to_Z**2) if (CS%Kd_add /= 0.0) then call get_param(param_file, mdl, "USER_KD_ADD_LAT_RANGE", CS%lat_range(:), & "Four successive values that define a range of latitudes \n"//& From f8384ef709e8f3b11adbc57917790da158cf36bc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 6 Nov 2018 08:24:36 -0500 Subject: [PATCH 0885/1072] +Replace GV%Z_to_m with US%Z_to_m Removed the scaling factor from m to the units of vertical distances from the vertical grid type, and replaced all instances where it is used with the version from the unit_scaling type. A number of unit_scale_type arguments were added in various subroutines. Several duplicate blocks of comments were also removed. All answers are bitwise identical. --- src/ALE/MOM_ALE.F90 | 5 +- src/ALE/MOM_regridding.F90 | 4 +- src/core/MOM.F90 | 14 ++-- src/core/MOM_PressureForce.F90 | 9 ++- src/core/MOM_PressureForce_Montgomery.F90 | 5 +- src/core/MOM_PressureForce_analytic_FV.F90 | 5 +- src/core/MOM_PressureForce_blocked_AFV.F90 | 5 +- src/core/MOM_barotropic.F90 | 2 +- src/core/MOM_dynamics_split_RK2.F90 | 6 +- src/core/MOM_dynamics_unsplit.F90 | 8 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 8 +- src/core/MOM_interface_heights.F90 | 8 +- src/core/MOM_isopycnal_slopes.F90 | 4 +- src/core/MOM_verticalGrid.F90 | 20 +---- src/diagnostics/MOM_PointAccel.F90 | 23 +++--- src/diagnostics/MOM_diag_to_Z.F90 | 7 +- src/diagnostics/MOM_diagnostics.F90 | 41 ++++------ src/diagnostics/MOM_sum_output.F90 | 8 +- src/diagnostics/MOM_wave_speed.F90 | 4 +- src/diagnostics/MOM_wave_structure.F90 | 4 +- .../MOM_coord_initialization.F90 | 20 ++--- .../MOM_state_initialization.F90 | 2 +- src/parameterizations/lateral/MOM_MEKE.F90 | 24 +++--- .../lateral/MOM_internal_tides.F90 | 2 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 2 +- .../lateral/MOM_thickness_diffuse.F90 | 27 +++---- .../vertical/MOM_CVMix_KPP.F90 | 25 ++++--- .../vertical/MOM_CVMix_conv.F90 | 9 ++- .../vertical/MOM_CVMix_ddiff.F90 | 9 ++- .../vertical/MOM_CVMix_shear.F90 | 13 ++-- .../vertical/MOM_bkgnd_mixing.F90 | 14 ++-- .../vertical/MOM_bulk_mixed_layer.F90 | 32 ++++---- .../vertical/MOM_diabatic_aux.F90 | 4 +- .../vertical/MOM_diabatic_driver.F90 | 54 ++++++------- .../vertical/MOM_diapyc_energy_req.F90 | 9 ++- .../vertical/MOM_energetic_PBL.F90 | 28 +++---- .../vertical/MOM_entrain_diffusive.F90 | 7 +- .../vertical/MOM_internal_tide_input.F90 | 2 +- .../vertical/MOM_kappa_shear.F90 | 25 ++++--- .../vertical/MOM_set_diffusivity.F90 | 75 ++++++++++--------- .../vertical/MOM_set_viscosity.F90 | 22 +++--- .../vertical/MOM_tidal_mixing.F90 | 24 +++--- .../vertical/MOM_vert_friction.F90 | 26 ++++--- src/user/MOM_wave_interface.F90 | 4 +- src/user/SCM_CVMix_tests.F90 | 4 +- src/user/baroclinic_zone_initialization.F90 | 13 ++-- src/user/dumbbell_initialization.F90 | 2 +- src/user/seamount_initialization.F90 | 2 +- 48 files changed, 337 insertions(+), 333 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 97ccb78aed..6f81466685 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -228,9 +228,10 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS) end subroutine ALE_init !> Initialize diagnostics for the ALE module. -subroutine ALE_register_diags(Time, G, GV, diag, CS) +subroutine ALE_register_diags(Time, G, GV, US, diag, CS) type(time_type),target, intent(in) :: Time !< Time structure type(ocean_grid_type), intent(in) :: G !< Grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(diag_ctrl), target, intent(in) :: diag !< Diagnostics control structure type(ALE_CS), pointer :: CS !< Module control structure @@ -250,7 +251,7 @@ subroutine ALE_register_diags(Time, G, GV, diag, CS) CS%id_S_preale = register_diag_field('ocean_model', 'S_preale', diag%axesTL, Time, & 'Salinity before remapping', 'PSU') CS%id_e_preale = register_diag_field('ocean_model', 'e_preale', diag%axesTi, Time, & - 'Interface Heights before remapping', 'm', conversion=GV%Z_to_m) + 'Interface Heights before remapping', 'm', conversion=US%Z_to_m) CS%id_dzRegrid = register_diag_field('ocean_model','dzRegrid',diag%axesTi,Time, & 'Change in interface height due to ALE regridding', 'm') diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index aac9ae4294..f7dcaa2648 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -216,7 +216,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m CS%nk = 0 CS%regridding_scheme = coordinateMode(coord_mode) coord_is_state_dependent = state_dependent(coord_mode) - maximum_depth = GV%Z_to_m*max_depth + maximum_depth = US%Z_to_m*max_depth if (main_parameters) then ! Read coordinate units parameter (main model = REGRIDDING_COORDINATE_UNITS) @@ -473,7 +473,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m CS%coord_scale = GV%H_to_m else call setCoordinateResolution(dz, CS, scale=US%m_to_Z) - CS%coord_scale = GV%Z_to_m + CS%coord_scale = US%Z_to_m endif endif diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 30cc481a52..5e636194df 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -846,7 +846,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & endif if (CS%time_in_thermo_cycle > 0.0) then call enable_averaging(CS%time_in_thermo_cycle, Time_local, CS%diag) - call post_surface_thermo_diags(CS%sfc_IDs, G, GV, CS%diag, CS%time_in_thermo_cycle, & + call post_surface_thermo_diags(CS%sfc_IDs, G, GV, CS%US, CS%diag, CS%time_in_thermo_cycle, & sfc_state, CS%tv, ssh, CS%ave_ssh_ibc) endif call disable_averaging(CS%diag) @@ -1030,7 +1030,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call diag_update_remap_grids(CS%diag) if (CS%useMEKE) call step_forward_MEKE(CS%MEKE, h, CS%VarMix%SN_u, CS%VarMix%SN_v, & - CS%visc, dt, G, GV, CS%MEKE_CSp, CS%uhtr, CS%vhtr) + CS%visc, dt, G, GV, CS%US, CS%MEKE_CSp, CS%uhtr, CS%vhtr) call disable_averaging(CS%diag) ! Advance the dynamics time by dt. @@ -1982,7 +1982,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call MOM_initialize_fixed(dG, CS%OBC, param_file, write_geom_files, dirs%output_directory) call callTree_waypoint("returned from MOM_initialize_fixed() (initialize_MOM)") - if (dG%Zd_to_m /= GV%Z_to_m) call rescale_dyn_horgrid_bathymetry(dG, GV%Z_to_m) + if (dG%Zd_to_m /= US%Z_to_m) call rescale_dyn_horgrid_bathymetry(dG, US%Z_to_m) if (associated(CS%OBC)) call call_OBC_register(param_file, CS%update_OBC_CSp, CS%OBC) @@ -2289,7 +2289,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call set_masks_for_axes(G, diag) ! Diagnose static fields AND associate areas/volumes with axes - call write_static_fields(G, GV, CS%tv, CS%diag) + call write_static_fields(G, GV, US, CS%tv, CS%diag) call callTree_waypoint("static fields written (initialize_MOM)") ! Register the volume cell measure (must be one of first diagnostics) @@ -2349,7 +2349,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call pass_var(CS%visc%MLD, G%domain, halo=1) endif - call MOM_diagnostics_init(MOM_internal_state, CS%ADp, CS%CDp, Time, G, GV, & + call MOM_diagnostics_init(MOM_internal_state, CS%ADp, CS%CDp, Time, G, GV, US, & param_file, diag, CS%diagnostics_CSp, CS%tv) call diag_copy_diag_to_storage(CS%diag_pre_sync, CS%h, CS%diag) @@ -2387,7 +2387,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call register_tracer_diagnostics(CS%tracer_Reg, CS%h, Time, diag, G, GV, & CS%use_ALE_algorithm, CS%diag_to_Z_CSp) if (CS%use_ALE_algorithm) then - call ALE_register_diags(Time, G, GV, diag, CS%ALE_CSp) + call ALE_register_diags(Time, G, GV, US, diag, CS%ALE_CSp) endif ! This subroutine initializes any tracer packages. @@ -2812,7 +2812,7 @@ subroutine extract_surface_state(CS, sfc_state) sfc_state%sfc_density(i,j) = sfc_state%sfc_density(i,j) / depth(i) endif !### Verify that this is no longer needed. - ! sfc_state%Hml(i,j) = GV%Z_to_m * depth(i) + ! sfc_state%Hml(i,j) = US%Z_to_m * depth(i) enddo enddo ! end of j loop diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index c343c38516..a872a5b88f 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -96,10 +96,11 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e end subroutine Pressureforce !> Initialize the pressure force control structure -subroutine PressureForce_init(Time, G, GV, param_file, diag, CS, tides_CSp) +subroutine PressureForce_init(Time, G, GV, US, param_file, diag, CS, tides_CSp) type(time_type), target, intent(in) :: Time !< Current model time type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(PressureForce_CS), pointer :: CS !< Pressure force control structure @@ -127,13 +128,13 @@ subroutine PressureForce_init(Time, G, GV, param_file, diag, CS, tides_CSp) default=.false., do_not_log=.true., debuggingParam=.true.) if (CS%Analytic_FV_PGF .and. CS%blocked_AFV) then - call PressureForce_blk_AFV_init(Time, G, GV, param_file, diag, & + call PressureForce_blk_AFV_init(Time, G, GV, US, param_file, diag, & CS%PressureForce_blk_AFV_CSp, tides_CSp) elseif (CS%Analytic_FV_PGF) then - call PressureForce_AFV_init(Time, G, GV, param_file, diag, & + call PressureForce_AFV_init(Time, G, GV, US, param_file, diag, & CS%PressureForce_AFV_CSp, tides_CSp) else - call PressureForce_Mont_init(Time, G, GV, param_file, diag, & + call PressureForce_Mont_init(Time, G, GV, US, param_file, diag, & CS%PressureForce_Mont_CSp, tides_CSp) endif diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index e21b4200e1..164229f894 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -810,10 +810,11 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, GFS_scale, pbce, alpha_star) end subroutine Set_pbce_nonBouss !> Initialize the Montgomery-potential form of PGF control structure -subroutine PressureForce_Mont_init(Time, G, GV, param_file, diag, CS, tides_CSp) +subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_CSp) type(time_type), target, intent(in) :: Time !< Current model time type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(PressureForce_Mont_CS), pointer :: CS !< Montgomery PGF control structure @@ -865,7 +866,7 @@ subroutine PressureForce_Mont_init(Time, G, GV, param_file, diag, CS, tides_CSp) if (CS%tides) then CS%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, & - Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=GV%Z_to_m) + Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=US%Z_to_m) endif CS%GFS_scale = 1.0 diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 050b280c4e..a674a43731 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -777,10 +777,11 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at end subroutine PressureForce_AFV_Bouss !> Initializes the finite volume pressure gradient control structure -subroutine PressureForce_AFV_init(Time, G, GV, param_file, diag, CS, tides_CSp) +subroutine PressureForce_AFV_init(Time, G, GV, US, param_file, diag, CS, tides_CSp) type(time_type), target, intent(in) :: Time !< Current model time type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure @@ -838,7 +839,7 @@ subroutine PressureForce_AFV_init(Time, G, GV, param_file, diag, CS, tides_CSp) if (CS%tides) then CS%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, & - Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=GV%Z_to_m) + Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=US%Z_to_m) endif CS%GFS_scale = 1.0 diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 04b77548be..74e29e0f69 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -771,10 +771,11 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, end subroutine PressureForce_blk_AFV_Bouss !> Initializes the finite volume pressure gradient control structure -subroutine PressureForce_blk_AFV_init(Time, G, GV, param_file, diag, CS, tides_CSp) +subroutine PressureForce_blk_AFV_init(Time, G, GV, US, param_file, diag, CS, tides_CSp) type(time_type), target, intent(in) :: Time !< Current model time type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(PressureForce_blk_AFV_CS), pointer :: CS !< Finite volume PGF control structure @@ -832,7 +833,7 @@ subroutine PressureForce_blk_AFV_init(Time, G, GV, param_file, diag, CS, tides_C if (CS%tides) then CS%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, & - Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=GV%Z_to_m) + Time, 'Tidal Forcing Astronomical and SAL Height Anomaly', 'meter', conversion=US%Z_to_m) endif CS%GFS_scale = 1.0 diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index bca06c2a0c..68284b3282 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -3956,7 +3956,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, "An estimate of how much higher SSH might get, for use \n"//& "in calculating the safe external wave speed. The \n"//& "default is the minimum of 10 m or 5% of MAXIMUM_DEPTH.", & - units="m", default=min(10.0,0.05*G%max_depth*GV%Z_to_m)) + units="m", default=min(10.0,0.05*G%max_depth*US%Z_to_m)) call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 00da82a00f..c6cf3ab0e7 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -579,7 +579,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & CS%OBC) call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & - GV, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) + GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") if (G%nonblocking_updates) then call cpu_clock_end(id_clock_vertvisc) @@ -774,7 +774,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! u_av <- u_av + dt d/dz visc d/dz u_av call cpu_clock_begin(id_clock_vertvisc) call vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) - call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, & + call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, US, & CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot,waves=waves) if (G%nonblocking_updates) then call cpu_clock_end(id_clock_vertvisc) @@ -1093,7 +1093,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param call continuity_init(Time, G, GV, param_file, diag, CS%continuity_CSp) call CoriolisAdv_init(Time, G, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) - call PressureForce_init(Time, G, GV, param_file, diag, CS%PressureForce_CSp, & + call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) call hor_visc_init(Time, G, param_file, diag, CS%hor_visc_CSp) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 543a97e31f..fa62036846 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -348,7 +348,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call vertvisc_coef(up, vp, h_av, forces, visc, dt*0.5, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(up, vp, h_av, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & - G, GV, CS%vertvisc_CSp, Waves=Waves) + G, GV, US, CS%vertvisc_CSp, Waves=Waves) call cpu_clock_end(id_clock_vertvisc) call pass_vector(up, vp, G%Domain, clock=id_clock_pass) @@ -412,7 +412,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call vertvisc_coef(upp, vpp, hp, forces, visc, dt*0.5, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(upp, vpp, hp, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & - G, GV, CS%vertvisc_CSp, Waves=Waves) + G, GV, US, CS%vertvisc_CSp, Waves=Waves) call cpu_clock_end(id_clock_vertvisc) call pass_vector(upp, vpp, G%Domain, clock=id_clock_pass) @@ -482,7 +482,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_begin(id_clock_vertvisc) call vertvisc_coef(u, v, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(u, v, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & - G, GV, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, Waves=Waves) + G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, Waves=Waves) call cpu_clock_end(id_clock_vertvisc) call pass_vector(u, v, G%Domain, clock=id_clock_pass) @@ -653,7 +653,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS call continuity_init(Time, G, GV, param_file, diag, CS%continuity_CSp) call CoriolisAdv_init(Time, G, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) - call PressureForce_init(Time, G, GV, param_file, diag, CS%PressureForce_CSp, & + call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) call hor_visc_init(Time, G, param_file, diag, CS%hor_visc_CSp) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index b917592a1d..472a9adabe 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -344,7 +344,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call vertvisc_coef(up, vp, h_av, forces, visc, dt_pred, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(up, vp, h_av, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, & - G, GV, CS%vertvisc_CSp) + G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) call pass_vector(up, vp, G%Domain, clock=id_clock_pass) @@ -397,11 +397,11 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call vertvisc_coef(up, vp, h_av, forces, visc, dt, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(up, vp, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & - G, GV, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) + G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) call vertvisc_coef(u_in, v_in, h_av, forces, visc, dt, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(u_in, v_in, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp,& - G, GV, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) + G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) call cpu_clock_end(id_clock_vertvisc) call pass_vector(up, vp, G%Domain, clock=id_clock_pass) call pass_vector(u_in, v_in, G%Domain, clock=id_clock_pass) @@ -614,7 +614,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag call continuity_init(Time, G, GV, param_file, diag, CS%continuity_CSp) call CoriolisAdv_init(Time, G, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) - call PressureForce_init(Time, G, GV, param_file, diag, CS%PressureForce_CSp, & + call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) call hor_visc_init(Time, G, param_file, diag, CS%hor_visc_CSp) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index 1ed4e8a7e6..745e8c5b39 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -46,7 +46,7 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) integer, optional, intent(in) :: halo_size !< width of halo points on !! which to calculate eta. real, optional, intent(in) :: eta_to_m !< The conversion factor from - !! the units of eta to m; by default this is GV%Z_to_m. + !! the units of eta to m; by default this is US%Z_to_m. ! Local variables real :: p(SZI_(G),SZJ_(G),SZK_(G)+1) @@ -66,7 +66,7 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) if ((isvG%ied) .or. (jsvG%jed)) & call MOM_error(FATAL,"find_eta called with an overly large halo_size.") - Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = GV%Z_to_m / eta_to_m + Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = US%Z_to_m / eta_to_m H_to_eta = GV%H_to_Z * Z_to_eta H_to_rho_eta = GV%H_to_kg_m2 * (US%m_to_Z * Z_to_eta) I_gEarth = Z_to_eta / GV%g_Earth @@ -161,7 +161,7 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) integer, optional, intent(in) :: halo_size !< width of halo points on !! which to calculate eta. real, optional, intent(in) :: eta_to_m !< The conversion factor from - !! the units of eta to m; by default this is GV%Z_to_m. + !! the units of eta to m; by default this is US%Z_to_m. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & p ! The pressure in Pa. @@ -176,7 +176,7 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo nz = G%ke - Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = GV%Z_to_m / eta_to_m + Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = US%Z_to_m / eta_to_m H_to_eta = GV%H_to_Z * Z_to_eta H_to_rho_eta = GV%H_to_kg_m2 * (US%m_to_Z * Z_to_eta) I_gEarth = Z_to_eta / GV%g_Earth diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 70601b25f7..c6bbff50fd 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -41,7 +41,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & integer, optional, intent(in) :: halo !< Halo width over which to compute ! real, optional, intent(in) :: eta_to_m !< The conversion factor from the units - ! (This argument has been tested but for now serves no purpose.) !! of eta to m; GV%Z_to_m by default. + ! (This argument has been tested but for now serves no purpose.) !! of eta to m; US%Z_to_m by default. ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & T, & ! The temperature (or density) in C, with the values in @@ -105,7 +105,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & nz = G%ke ; IsdB = G%IsdB h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 - Z_to_L = GV%Z_to_m ; H_to_Z = GV%H_to_Z + Z_to_L = US%Z_to_m ; H_to_Z = GV%H_to_Z ! if (present(eta_to_m)) then ! Z_to_L = eta_to_m ; H_to_Z = GV%H_to_m / eta_to_m ! endif diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 091a486b48..92f303e12b 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -53,12 +53,9 @@ module MOM_verticalGrid real :: m_to_H !< A constant that translates distances in m to the units of thickness. real :: H_to_m !< A constant that translates distances in the units of thickness to m. real :: H_to_Pa !< A constant that translates the units of thickness to pressure in Pa. - real :: m_to_Z !< A constant that translates distances in m to the units of depth. - real :: Z_to_m !< A constant that translates distances in the units of depth to m. real :: H_to_Z !< A constant that translates thickness units to the units of depth. real :: Z_to_H !< A constant that translates depth units to thickness units. - real :: m_to_Z_restart = 0.0 !< A copy of the m_to_Z that is used in restart files. real :: m_to_H_restart = 0.0 !< A copy of the m_to_H that is used in restart files. end type verticalGrid_type @@ -73,8 +70,8 @@ subroutine verticalGridInit( param_file, GV, US ) ! All memory is allocated but not necessarily set to meaningful values until later. ! Local variables - integer :: nk, H_power, Z_power - real :: H_rescale_factor, Z_rescale_factor + integer :: nk, H_power + real :: H_rescale_factor ! This include declares and sets the variable "version". # include "version_variable.h" character(len=16) :: mdl = 'MOM_verticalGrid' @@ -120,16 +117,7 @@ subroutine verticalGridInit( param_file, GV, US ) "units of thickness into m.", units="m H-1", default=1.0) GV%H_to_m = GV%H_to_m * H_rescale_factor endif - call get_param(param_file, mdl, "Z_RESCALE_POWER", Z_power, & - "An integer power of 2 that is used to rescale the model's \n"//& - "intenal units of depths and heights. Valid values range from -300 to 300.", & - units="nondim", default=0, debuggingParam=.true.) - if (abs(Z_power) > 300) call MOM_error(FATAL, "verticalGridInit: "//& - "Z_RESCALE_POWER is outside of the valid range of -300 to 300.") - Z_rescale_factor = 1.0 - if (Z_power /= 0) Z_rescale_factor = 2.0**Z_power - GV%Z_to_m = 1.0 * Z_rescale_factor - GV%g_Earth = GV%g_Earth * GV%Z_to_m + GV%g_Earth = GV%g_Earth * US%Z_to_m #ifdef STATIC_MEMORY_ ! Here NK_ is a macro, while nk is a variable. call get_param(param_file, mdl, "NK", nk, & @@ -159,7 +147,7 @@ subroutine verticalGridInit( param_file, GV, US ) GV%H_to_Pa = (GV%g_Earth*US%m_to_Z) * GV%H_to_kg_m2 GV%H_to_Z = GV%H_to_m * US%m_to_Z - GV%Z_to_H = GV%Z_to_m * GV%m_to_H + GV%Z_to_H = US%Z_to_m * GV%m_to_H GV%Angstrom_Z = US%m_to_Z * GV%Angstrom_m ! Log derivative values. diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 89dbe0b6a9..7a03c1e06f 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -18,6 +18,7 @@ module MOM_PointAccel use MOM_io, only : open_file use MOM_io, only : APPEND_FILE, ASCII_FILE, MULTIPLE, SINGLE_FILE use MOM_time_manager, only : time_type, get_time, get_date, set_date, operator(-) +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : ocean_internal_state, accel_diag_ptrs, cont_diag_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -65,11 +66,12 @@ module MOM_PointAccel !> This subroutine writes to an output file all of the accelerations !! that have been applied to a column of zonal velocities over the !! previous timestep. This subroutine is called from vertvisc. -subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a, hv) +subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, str, a, hv) integer, intent(in) :: I !< The zonal index of the column to be documented. integer, intent(in) :: j !< The meridional index of the column to be documented. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: um !< The new zonal velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -217,7 +219,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a endif if (present(a)) then write(file,'(/,"a: ",$)') - do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(I,j,k)*GV%Z_to_m*dt; enddo + do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(I,j,k)*US%Z_to_m*dt; enddo endif if (present(hv)) then write(file,'(/,"hvel: ",$)') @@ -246,13 +248,13 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i+1,j+1,k)); enddo - e(nz+1) = -GV%Z_to_m*G%bathyT(i,j) + e(nz+1) = -US%Z_to_m*G%bathyT(i,j) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j,k) ; enddo write(file,'(/,"e-: ",$)') write(file,'(ES10.3," ",$)') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo - e(nz+1) = -GV%Z_to_m*G%bathyT(i+1,j) + e(nz+1) = -US%Z_to_m*G%bathyT(i+1,j) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i+1,j,k) ; enddo write(file,'(/,"e+: ",$)') write(file,'(ES10.3," ",$)') e(ks) @@ -329,7 +331,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a (0.5*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo endif - write(file,'(/,"D: ",2(ES10.3))') GV%Z_to_m*G%bathyT(i,j),GV%Z_to_m*G%bathyT(i+1,j) + write(file,'(/,"D: ",2(ES10.3))') US%Z_to_m*G%bathyT(i,j),US%Z_to_m*G%bathyT(i+1,j) ! From here on, the normalized accelerations are written. if (prev_avail) then @@ -395,11 +397,12 @@ end subroutine write_u_accel !> This subroutine writes to an output file all of the accelerations !! that have been applied to a column of meridional velocities over !! the previous timestep. This subroutine is called from vertvisc. -subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a, hv) +subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, str, a, hv) integer, intent(in) :: i !< The zonal index of the column to be documented. integer, intent(in) :: J !< The meridional index of the column to be documented. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: vm !< The new meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -551,7 +554,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a endif if (present(a)) then write(file,'(/,"a: ",$)') - do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(i,j,k)*GV%Z_to_m*dt; enddo + do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') a(i,j,k)*US%Z_to_m*dt; enddo endif if (present(hv)) then write(file,'(/,"hvel: ",$)') @@ -579,13 +582,13 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a write(file,'(/,"h++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i+1,j+1,k); enddo - e(nz+1) = -GV%Z_to_m*G%bathyT(i,j) + e(nz+1) = -US%Z_to_m*G%bathyT(i,j) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j,k); enddo write(file,'(/,"e-: ",$)') write(file,'(ES10.3," ",$)') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo - e(nz+1) = -GV%Z_to_m*G%bathyT(i,j+1) + e(nz+1) = -US%Z_to_m*G%bathyT(i,j+1) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j+1,k) ; enddo write(file,'(/,"e+: ",$)') write(file,'(ES10.3," ",$)') e(ks) @@ -662,7 +665,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, vel_rpt, str, a (CS%u_prev(I,j+1,k) * h_scale*0.5*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo endif - write(file,'(/,"D: ",2(ES10.3))') GV%Z_to_m*G%bathyT(i,j),GV%Z_to_m*G%bathyT(i,j+1) + write(file,'(/,"D: ",2(ES10.3))') US%Z_to_m*G%bathyT(i,j),US%Z_to_m*G%bathyT(i,j+1) ! From here on, the normalized accelerations are written. if (prev_avail) then diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index 5cceda7e3b..424b241c46 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -86,9 +86,10 @@ module MOM_diag_to_Z contains !> Return the global horizontal mean in z-space -function global_z_mean(var, G, GV, CS, tracer) +function global_z_mean(var, G, GV, US, CS, tracer) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diag_to_Z_CS), pointer :: CS !< Control structure returned by !! previous call to diag_to_Z_init. real, dimension(SZI_(G), SZJ_(G), CS%nk_zspace), & @@ -115,7 +116,7 @@ function global_z_mean(var, G, GV, CS, tracer) if (var(i,j,k) == CS%missing_tr(tracer)) valid_point = 0. if (depth_weight == 0.) valid_point = 0. - weight(i,j,k) = GV%Z_to_m * depth_weight * ( (valid_point * (G%areaT(i,j) * G%mask2dT(i,j))) ) + weight(i,j,k) = US%Z_to_m * depth_weight * ( (valid_point * (G%areaT(i,j) * G%mask2dT(i,j))) ) ! If the point is flagged, set the variable itself to zero to avoid NaNs if (valid_point == 0.) then @@ -485,7 +486,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, US, CS) do m=1,CS%num_tr_used if (CS%id_tr(m) > 0) call post_data(CS%id_tr(m), CS%tr_z(m)%p, CS%diag) if (CS%id_tr_xyave(m) > 0) then - layer_ave = global_z_mean(CS%tr_z(m)%p, G, GV, CS, m) + layer_ave = global_z_mean(CS%tr_z(m)%p, G, GV, US, CS, m) call post_data(CS%id_tr_xyave(m), layer_ave, CS%diag) endif enddo diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 36ccf1425e..3ea4e65506 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1166,11 +1166,12 @@ end subroutine post_surface_dyn_diags !> This routine posts diagnostics of various ocean surface and integrated !! quantities at the time the ocean state is reported back to the caller -subroutine post_surface_thermo_diags(IDs, G, GV, diag, dt_int, sfc_state, tv, & +subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv, & ssh, ssh_ibc) type(surface_diag_IDs), intent(in) :: IDs !< A structure with the diagnostic IDs. type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output real, intent(in) :: dt_int !< total time step associated with these diagnostics, in s. type(surface), intent(in) :: sfc_state !< structure describing the ocean surface state @@ -1219,7 +1220,7 @@ subroutine post_surface_thermo_diags(IDs, G, GV, diag, dt_int, sfc_state, tv, & ! post total volume of the liquid ocean if (IDs%id_volo > 0) then do j=js,je ; do i=is,ie - work_2d(i,j) = G%mask2dT(i,j)*(ssh(i,j) + GV%Z_to_m*G%bathyT(i,j)) + work_2d(i,j) = G%mask2dT(i,j)*(ssh(i,j) + US%Z_to_m*G%bathyT(i,j)) enddo ; enddo volo = global_area_integral(work_2d, G) call post_data(IDs%id_volo, volo, diag) @@ -1394,7 +1395,7 @@ end subroutine post_transport_diagnostics !> This subroutine registers various diagnostics and allocates space for fields !! that other diagnostis depend upon. -subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, param_file, diag, CS, tv) +subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag, CS, tv) type(ocean_internal_state), intent(in) :: MIS !< For "MOM Internal State" a set of pointers to !! the fields and accelerations that make up the !! ocean's internal physical state. @@ -1405,6 +1406,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, param_file, diag, CS type(time_type), intent(in) :: Time !< Current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(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 !< Structure to regulate diagnostic output. @@ -1413,25 +1415,11 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, param_file, diag, CS type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. -! Arguments -! (in) MIS - For "MOM Internal State" a set of pointers to the fields and -! accelerations that make up the ocean's internal physical -! state. -! (inout) ADp - structure with pointers to momentum equation terms -! (inout) CDp - structure with pointers to continuity equation terms -! (in) Time - current model time -! (in) G - ocean grid structure -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - structure indicating the open file to parse for -! model parameter values -! (in) diag - structure to regulate diagnostic output -! (in/out) CS - pointer set to point to control structure for this module - -! This include declares and sets the variable "version". -#include "version_variable.h" - - character(len=40) :: mdl = "MOM_diagnostics" ! This module's name. + ! Local variables real :: omega, f2_min, convert_H + ! This include declares and sets the variable "version". +# include "version_variable.h" + character(len=40) :: mdl = "MOM_diagnostics" ! This module's name. character(len=48) :: thickness_units, flux_units logical :: use_temperature integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, nkml, nkbl @@ -1537,11 +1525,11 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, param_file, diag, CS 'Layer Thickness', thickness_units, v_extensive=.true., conversion=convert_H) CS%id_e = register_diag_field('ocean_model', 'e', diag%axesTi, Time, & - 'Interface Height Relative to Mean Sea Level', 'm', conversion=GV%Z_to_m) + 'Interface Height Relative to Mean Sea Level', 'm', conversion=US%Z_to_m) if (CS%id_e>0) call safe_alloc_ptr(CS%e,isd,ied,jsd,jed,nz+1) CS%id_e_D = register_diag_field('ocean_model', 'e_D', diag%axesTi, Time, & - 'Interface Height above the Seafloor', 'm', conversion=GV%Z_to_m) + 'Interface Height above the Seafloor', 'm', conversion=US%Z_to_m) if (CS%id_e_D>0) call safe_alloc_ptr(CS%e_D,isd,ied,jsd,jed,nz+1) CS%id_Rml = register_diag_field('ocean_model', 'Rml', diag%axesTL, Time, & @@ -1693,7 +1681,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, param_file, diag, CS 'The column integrated in situ density', 'kg m-2') CS%id_col_ht = register_diag_field('ocean_model', 'col_height', diag%axesT1, Time, & - 'The height of the water column', 'm', conversion=GV%Z_to_m) + 'The height of the water column', 'm', conversion=US%Z_to_m) CS%id_pbo = register_diag_field('ocean_model', 'pbo', diag%axesT1, Time, & long_name='Sea Water Pressure at Sea Floor', standard_name='sea_water_pressure_at_sea_floor', & units='Pa') @@ -1822,9 +1810,10 @@ subroutine register_transport_diags(Time, G, GV, IDs, diag) end subroutine register_transport_diags !> Offers the static fields in the ocean grid type for output via the diag_manager. -subroutine write_static_fields(G, GV, tv, diag) +subroutine write_static_fields(G, GV, US, tv, diag) type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables type(diag_ctrl), target, intent(inout) :: diag !< regulates diagnostic output @@ -1900,7 +1889,7 @@ subroutine write_static_fields(G, GV, tv, diag) cmor_field_name='deptho', cmor_long_name='Sea Floor Depth', & cmor_standard_name='sea_floor_depth_below_geoid', area=diag%axesT1%id_area, & x_cell_method='mean', y_cell_method='mean', area_cell_method='mean', & - conversion=GV%Z_to_m) + conversion=US%Z_to_m) if (id > 0) call post_data(id, G%bathyT, diag, .true., mask=G%mask2dT) id = register_static_field('ocean_model', 'wet', diag%axesT1, & diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 955c33b129..112c3b9104 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -501,7 +501,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ do k=1,nz ; do j=js,je ; do i=is,ie tmp1(i,j,k) = (eta(i,j,K)-eta(i,j,K+1)) * areaTm(i,j) enddo ; enddo ; enddo - vol_tot = GV%Z_to_m*reproducing_sum(tmp1, sums=vol_lay) + vol_tot = US%Z_to_m*reproducing_sum(tmp1, sums=vol_lay) else do k=1,nz ; do j=js,je ; do i=is,ie tmp1(i,j,k) = H_to_kg_m2 * h(i,j,k) * areaTm(i,j) @@ -631,7 +631,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ hint = Z_0APE(K) + (hbelow - G%bathyT(i,j)) hbot = Z_0APE(K) - G%bathyT(i,j) hbot = (hbot + ABS(hbot)) * 0.5 - PE_pt(i,j,K) = 0.5 * areaTm(i,j) * GV%Z_to_m*(GV%Rho0*GV%g_prime(K)) * & + PE_pt(i,j,K) = 0.5 * areaTm(i,j) * US%Z_to_m*(GV%Rho0*GV%g_prime(K)) * & (hint * hint - hbot * hbot) enddo enddo ; enddo @@ -640,14 +640,14 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ do k=nz,1,-1 hint = Z_0APE(K) + eta(i,j,K) ! eta and H_0 have opposite signs. hbot = max(Z_0APE(K) - G%bathyT(i,j), 0.0) - PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * GV%Z_to_m*(GV%Rho0*GV%g_prime(K))) * & + PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * US%Z_to_m*(GV%Rho0*GV%g_prime(K))) * & (hint * hint - hbot * hbot) enddo enddo ; enddo endif PE_tot = reproducing_sum(PE_pt, sums=PE) - do k=1,nz+1 ; H_0APE(K) = GV%Z_to_m*Z_0APE(K) ; enddo + do k=1,nz+1 ; H_0APE(K) = US%Z_to_m*Z_0APE(K) ; enddo else PE_tot = 0.0 do k=1,nz+1 ; PE(K) = 0.0 ; H_0APE(K) = 0.0 ; enddo diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index c84ad8a798..9910ea576b 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -325,11 +325,11 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & L2_to_Z2*gp > N2min*hw) then ! Filters out regions where N2 increases with depth but only in a lower fraction of water column gp = N2min/hw !### THIS IS DIMENSIONALLY INCONSISTENT! -RWH - !### This should be gp = GV%Z_to_m**2* (N2min*hw) + !### This should be gp = US%Z_to_m**2* (N2min*hw) elseif (l_mono_N2_depth>=0. .and. sum_hc>l_mono_N2_depth .and. L2_to_Z2*gp>N2min*hw) then ! Filters out regions where N2 increases with depth but only below a certain depth gp = N2min/hw !### THIS IS DIMENSIONALLY INCONSISTENT! -RWH - !### This should be gp = GV%Z_to_m**2* (N2min*hw) + !### This should be gp = US%Z_to_m**2* (N2min*hw) else N2min = L2_to_Z2 * gp/hw endif diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 0f1a7eecc7..7e82c02ec8 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -444,7 +444,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo !(including surface and bottom) w2avg = 0.0 do k=1,nzm-1 - dz(k) = GV%Z_to_m*Hc(k) + dz(k) = US%Z_to_m*Hc(k) w2avg = w2avg + 0.5*(w_strct(K)**2+w_strct(K+1)**2)*dz(k) enddo !### Some mathematical cancellations could occur in the next two lines. @@ -503,7 +503,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo CS%u_strct(i,j,1:nzm) = u_strct(:) CS%W_profile(i,j,1:nzm) = W_profile(:) CS%Uavg_profile(i,j,1:nzm)= Uavg_profile(:) - CS%z_depths(i,j,1:nzm) = GV%Z_to_m*z_int(:) + CS%z_depths(i,j,1:nzm) = US%Z_to_m*z_int(:) CS%N2(i,j,1:nzm) = N2(:) CS%num_intfaces(i,j) = nzm else diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 656557ae9c..ad66762fef 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -136,10 +136,10 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, US, param_file) call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=GV%Z_to_m) + default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & - units="m s-2", fail_if_missing=.true., scale=GV%Z_to_m) + units="m s-2", fail_if_missing=.true., scale=US%Z_to_m) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = g_int ; enddo @@ -171,7 +171,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, US, param_file) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=GV%Z_to_m) + default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) call get_param(param_file, mdl, "LIGHTEST_DENSITY", Rlay_Ref, & "The reference potential density used for layer 1.", & units="kg m-3", default=GV%Rho0) @@ -224,10 +224,10 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state "The initial salinities.", units="PSU", default=35.0) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=GV%Z_to_m) + default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & - units="m s-2", fail_if_missing=.true., scale=GV%Z_to_m) + units="m s-2", fail_if_missing=.true., scale=US%Z_to_m) ! ! These statements set the interface reduced gravities. ! g_prime(1) = g_fs @@ -270,7 +270,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, & call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=GV%Z_to_m) + default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) call get_param(param_file, mdl, "COORD_FILE", coord_file, & "The file from which the coordinate temperatures and \n"//& "salinities are read.", fail_if_missing=.true.) @@ -350,7 +350,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, & call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=GV%Z_to_m) + default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) k_light = GV%nk_rho_varies + 1 @@ -397,7 +397,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, US, param_file) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=GV%Z_to_m) + default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call get_param(param_file, mdl, "COORD_FILE", coord_file, & @@ -452,7 +452,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, US, param_file) "all interfaces.", units="kg m-3", default=2.0) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=GV%Z_to_m) + default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) ! This following sets the target layer densities such that a the ! surface interface has density Rlay_ref and the bottom @@ -490,7 +490,7 @@ subroutine set_coord_to_none(Rlay, g_prime, GV, US, param_file) call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=GV%Z_to_m) + default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = 0. ; enddo diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index e610e2c998..83347d2089 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -361,7 +361,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & case ("adjustment2d"); call adjustment_initialize_temperature_salinity ( tv%T, & tv%S, h, G, GV, PF, eos, just_read_params=just_read) case ("baroclinic_zone"); call baroclinic_zone_init_temperature_salinity( tv%T, & - tv%S, h, G, GV, PF, just_read_params=just_read) + tv%S, h, G, GV, US, PF, just_read_params=just_read) case ("sloshing"); call sloshing_initialize_temperature_salinity(tv%T, & tv%S, h, G, GV, PF, eos, just_read_params=just_read) case ("seamount"); call seamount_initialize_temperature_salinity(tv%T, & diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 9607dafeb3..69e63ae323 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -15,6 +15,7 @@ module MOM_MEKE use MOM_hor_index, only : hor_index_type use MOM_io, only : vardesc, var_desc use MOM_restart, only : MOM_restart_CS, register_restart_field, query_initialized +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : vertvisc_type use MOM_verticalGrid, only : verticalGrid_type use MOM_MEKE_types, only : MEKE_type @@ -88,10 +89,11 @@ module MOM_MEKE !> Integrates forward-in-time the MEKE eddy energy equation. !! See \ref section_MEKE_equations. -subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) +subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, hv) type(MEKE_type), pointer :: MEKE !< MEKE data. type(ocean_grid_type), intent(inout) :: G !< Ocean grid. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg m-2). real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points (s-1). real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at u-points (s-1). @@ -215,13 +217,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) do j=js,je ; do I=is-1,ie drag_vel_u(I,j) = 0.0 if ((G%mask2dCu(I,j) > 0.0) .and. (visc%bbl_thick_u(I,j) > 0.0)) & - drag_vel_u(I,j) = GV%Z_to_m*visc%kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) + drag_vel_u(I,j) = US%Z_to_m*visc%kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) enddo ; enddo !$OMP do do J=js-1,je ; do i=is,ie drag_vel_v(i,J) = 0.0 if ((G%mask2dCv(i,J) > 0.0) .and. (visc%bbl_thick_v(i,J) > 0.0)) & - drag_vel_v(i,J) = GV%Z_to_m*visc%kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) + drag_vel_v(i,J) = US%Z_to_m*visc%kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) enddo ; enddo !$OMP do @@ -253,12 +255,12 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) !$OMP end parallel if (CS%initialize) then - call MEKE_equilibrium(CS, MEKE, G, GV, SN_u, SN_v, drag_rate_visc, I_mass) + call MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_mass) CS%initialize = .false. endif ! Calculates bottomFac2, barotrFac2 and LmixScale - call MEKE_lengthScales(CS, MEKE, G, GV, SN_u, SN_v, MEKE%MEKE, bottomFac2, barotrFac2, LmixScale) + call MEKE_lengthScales(CS, MEKE, G, US, SN_u, SN_v, MEKE%MEKE, bottomFac2, barotrFac2, LmixScale) if (CS%debug) then call uvchksum("MEKE drag_vel_[uv]", drag_vel_u, drag_vel_v, G%HI) call hchksum(mass, 'MEKE mass',G%HI,haloshift=1) @@ -568,9 +570,10 @@ end subroutine step_forward_MEKE !> Calculates the equilibrium solutino where the source depends only on MEKE diffusivity !! and there is no lateral diffusion of MEKE. !! Results is in MEKE%MEKE. -subroutine MEKE_equilibrium(CS, MEKE, G, GV, SN_u, SN_v, drag_rate_visc, I_mass) +subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_mass) type(ocean_grid_type), intent(inout) :: G !< Ocean grid. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(MEKE_CS), pointer :: CS !< MEKE control structure. type(MEKE_type), pointer :: MEKE !< MEKE data. real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points (s-1). @@ -613,7 +616,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, SN_u, SN_v, drag_rate_visc, I_mass) n1 = n1 + 1 EKE = EKEmax call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & - MEKE%Rd_dx_h(i,j), SN, EKE, GV%Z_to_m, & + MEKE%Rd_dx_h(i,j), SN, EKE, US%Z_to_m, & bottomFac2, barotrFac2, LmixScale, & Lrhines, Leady) ! TODO: Should include resolution function in Kh @@ -688,12 +691,13 @@ end subroutine MEKE_equilibrium !> Calculates the eddy mixing length scale and \f$\gamma_b\f$ and \f$\gamma_t\f$ !! functions that are ratios of either bottom or barotropic eddy energy to the !! column eddy energy, respectively. See \ref section_MEKE_equations. -subroutine MEKE_lengthScales(CS, MEKE, G, GV, SN_u, SN_v, & +subroutine MEKE_lengthScales(CS, MEKE, G, US, SN_u, SN_v, & EKE, bottomFac2, barotrFac2, LmixScale) type(MEKE_CS), pointer :: CS !< MEKE control structure. type(MEKE_type), pointer :: MEKE !< MEKE data. type(ocean_grid_type), intent(inout) :: G !< Ocean grid. - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. +! type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points (s-1). real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at u-points (s-1). real, dimension(SZI_(G),SZJ_(G)), intent(in) :: EKE !< Eddy kinetic energy (m2/s2). @@ -719,7 +723,7 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, SN_u, SN_v, & endif ! Returns bottomFac2, barotrFac2 and LmixScale call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & - MEKE%Rd_dx_h(i,j), SN, MEKE%MEKE(i,j), GV%Z_to_m, & + MEKE%Rd_dx_h(i,j), SN, MEKE%MEKE(i,j), US%Z_to_m, & bottomFac2(i,j), barotrFac2(i,j), LmixScale(i,j), & Lrhines(i,j), Leady(i,j)) enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index f1406bf0bb..8978a9b1f9 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -351,7 +351,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & if (CS%apply_bottom_drag) then do j=jsd,jed ; do i=isd,ied ! Note the 1 m dimensional scale here. Should this be a parameter? - I_D_here = 1.0 / (GV%Z_to_m*max(G%bathyT(i,j), 1.0*US%m_to_Z)) + I_D_here = 1.0 / (US%Z_to_m*max(G%bathyT(i,j), 1.0*US%m_to_Z)) drag_scale(i,j) = CS%cdrag * sqrt(max(0.0, vel_btTide(i,j)**2 + & tot_En(i,j) * I_rho0 * I_D_here)) * I_D_here enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 9119eb3169..9be4f3d984 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -614,7 +614,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop one_meter = 1.0 * GV%m_to_H h_neglect = GV%H_subroundoff H_cutoff = real(2*nz) * (GV%Angstrom_H + h_neglect) - Z_to_L = GV%Z_to_m + Z_to_L = US%Z_to_m ! To set the length scale based on the deformation radius, use wave_speed to ! calculate the first-mode gravity wave speed and then blend the equatorial diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index e487d5f5a5..e106eb544b 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -284,7 +284,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP end parallel if (CS%detangle_interfaces) then - call add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV, & + call add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV, US, & CS, int_slope_u, int_slope_v) endif @@ -292,7 +292,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp call uvchksum("Kh_[uv]", Kh_u, Kh_v, G%HI,haloshift=0) call uvchksum("int_slope_[uv]", int_slope_u, int_slope_v, G%HI, haloshift=0) call hchksum(h, "thickness_diffuse_1 h", G%HI, haloshift=1, scale=GV%H_to_m) - call hchksum(e, "thickness_diffuse_1 e", G%HI, haloshift=1, scale=GV%Z_to_m) + call hchksum(e, "thickness_diffuse_1 e", G%HI, haloshift=1, scale=US%Z_to_m) if (use_stored_slopes) then call uvchksum("VarMix%slope_[xy]", VarMix%slope_x, VarMix%slope_y, & G%HI, haloshift=0) @@ -521,7 +521,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 dz_neglect = GV%H_subroundoff*GV%H_to_Z G_rho0 = GV%g_Earth / GV%Rho0 - N2_floor = CS%N2_floor*GV%Z_to_m**2 + N2_floor = CS%N2_floor*US%Z_to_m**2 use_EOS = associated(tv%eqn_of_state) present_int_slope_u = PRESENT(int_slope_u) @@ -692,7 +692,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! that ignore density gradients along layers. if (present_int_slope_u) then Slope = (1.0 - int_slope_u(I,j,K)) * Slope + & - int_slope_u(I,j,K) * GV%Z_to_m*((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)) + int_slope_u(I,j,K) * US%Z_to_m*((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)) slope2_Ratio_u(I,K) = (1.0 - int_slope_u(I,j,K)) * slope2_Ratio_u(I,K) endif if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope @@ -724,7 +724,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_x) then Slope = slope_x(I,j,k) else - Slope = GV%Z_to_m*((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) + Slope = US%Z_to_m*((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) endif if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*US%m_to_Z*Slope) @@ -938,7 +938,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! that ignore density gradients along layers. if (present_int_slope_v) then Slope = (1.0 - int_slope_v(i,J,K)) * Slope + & - int_slope_v(i,J,K) * GV%Z_to_m*((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)) + int_slope_v(i,J,K) * US%Z_to_m*((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)) slope2_Ratio_v(i,K) = (1.0 - int_slope_v(i,J,K)) * slope2_Ratio_v(i,K) endif if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope @@ -970,7 +970,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_y) then Slope = slope_y(i,J,k) else - Slope = GV%Z_to_m*((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) + Slope = US%Z_to_m*((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) endif if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*US%m_to_Z*Slope) @@ -1182,10 +1182,11 @@ subroutine streamfn_solver(nk, c2_h, hN2, sfn) end subroutine streamfn_solver !> Modifies thickness diffusivities to untangle layer structures -subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV, CS, & +subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV, US, CS, & int_slope_u, int_slope_v) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (H) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions (Z) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kh_u !< Thickness diffusivity on interfaces @@ -1344,7 +1345,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Limit the diffusivities - I_4t = GV%Z_to_m*Kh_scale / (4.0*dt) + I_4t = US%Z_to_m*Kh_scale / (4.0*dt) do n=1,2 if (n==1) then ; jsh = js ; ish = is-1 @@ -1387,7 +1388,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! dH = I_4t * (h(i+1,j,k) - h(i,j,k)) / denom adH = abs(dH) - sign = 1.0*GV%Z_to_m ; if (dH < 0) sign = -1.0*GV%Z_to_m + sign = 1.0*US%Z_to_m ; if (dH < 0) sign = -1.0*US%Z_to_m sl_K = sign * (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) sl_Kp1 = sign * (e(i+1,j,K+1)-e(i,j,K+1)) * G%IdxCu(I,j) @@ -1410,7 +1411,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! dH = I_4t * (h(i,j+1,k) - h(i,j,k)) / denom adH = abs(dH) - sign = 1.0*GV%Z_to_m ; if (dH < 0) sign = -1.0*GV%Z_to_m + sign = 1.0*US%Z_to_m ; if (dH < 0) sign = -1.0*US%Z_to_m sl_K = sign * (e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J) sl_Kp1 = sign * (e(i,j+1,K+1)-e(i,j,K+1)) * G%IdyCv(i,J) @@ -1823,10 +1824,10 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) 'Parameterized Meridional Overturning Streamfunction', 'm3 s-1') CS%id_sfn_unlim_x = register_diag_field('ocean_model', 'GM_sfn_unlim_x', diag%axesCui, Time, & 'Parameterized Zonal Overturning Streamfunction before limiting/smoothing', & - 'm3 s-1', conversion=GV%Z_to_m) + 'm3 s-1', conversion=US%Z_to_m) CS%id_sfn_unlim_y = register_diag_field('ocean_model', 'GM_sfn_unlim_y', diag%axesCvi, Time, & 'Parameterized Meridional Overturning Streamfunction before limiting/smoothing', & - 'm3 s-1', conversion=GV%Z_to_m) + 'm3 s-1', conversion=US%Z_to_m) end subroutine thickness_diffuse_init diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 03b7b9f561..abddc57197 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -173,12 +173,13 @@ module MOM_CVMix_KPP !> Initialize the CVMix KPP module and set up diagnostics !! Returns True if KPP is to be used, False otherwise. -logical function KPP_init(paramFile, G, GV, diag, Time, CS, passive, Waves) +logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) ! Arguments type(param_file_type), intent(in) :: paramFile !< File parser type(ocean_grid_type), intent(in) :: G !< Ocean grid - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diag_ctrl), target, intent(in) :: diag !< Diagnostics type(time_type), intent(in) :: Time !< Model time type(KPP_CS), pointer :: CS !< Control structure @@ -497,7 +498,7 @@ logical function KPP_init(paramFile, G, GV, diag, Time, CS, passive, Waves) CS%id_Kt_KPP = register_diag_field('ocean_model', 'KPP_Kheat', diag%axesTi, Time, & 'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') CS%id_Kd_in = register_diag_field('ocean_model', 'KPP_Kd_in', diag%axesTi, Time, & - 'Diffusivity passed to KPP', 'm2/s', conversion=GV%Z_to_m**2) + 'Diffusivity passed to KPP', 'm2/s', conversion=US%Z_to_m**2) CS%id_Ks_KPP = register_diag_field('ocean_model', 'KPP_Ksalt', diag%axesTi, Time, & 'Salt diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') CS%id_Kv_KPP = register_diag_field('ocean_model', 'KPP_Kv', diag%axesTi, Time, & @@ -619,8 +620,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & call hchksum(h, "KPP in: h",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0) call hchksum(buoyFlux, "KPP in: buoyFlux",G%HI,haloshift=0) - call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0, scale=GV%Z_to_m**2) - call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0, scale=US%Z_to_m**2) + call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0, scale=US%Z_to_m**2) endif #endif @@ -676,9 +677,9 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & Kdiffusivity(:,:) = 0. ! Diffusivities for heat and salt (m2/s) Kviscosity(:) = 0. ! Viscosity (m2/s) else - Kdiffusivity(:,1) = GV%Z_to_m**2 * Kt(i,j,:) - Kdiffusivity(:,2) = GV%Z_to_m**2 * Ks(i,j,:) - Kviscosity(:) = GV%Z_to_m**2 * Kv(i,j,:) + Kdiffusivity(:,1) = US%Z_to_m**2 * Kt(i,j,:) + Kdiffusivity(:,2) = US%Z_to_m**2 * Ks(i,j,:) + Kviscosity(:) = US%Z_to_m**2 * Kv(i,j,:) endif call CVMix_coeffs_kpp(Kviscosity(:), & ! (inout) Total viscosity (m2/s) @@ -824,14 +825,14 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & Kt(i,j,k) = Kt(i,j,k) + US%m_to_Z**2 * Kdiffusivity(k,1) Ks(i,j,k) = Ks(i,j,k) + US%m_to_Z**2 * Kdiffusivity(k,2) Kv(i,j,k) = Kv(i,j,k) + US%m_to_Z**2 * Kviscosity(k) - if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = GV%Z_to_m**2 * Kv(i,j,k) + if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = US%Z_to_m**2 * Kv(i,j,k) enddo else ! KPP replaces prior diffusivity when former is non-zero do k=1, G%ke+1 if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = US%m_to_Z**2 * Kdiffusivity(k,1) if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = US%m_to_Z**2 * Kdiffusivity(k,2) if (Kviscosity(k) /= 0.) Kv(i,j,k) = US%m_to_Z**2 * Kviscosity(k) - if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = GV%Z_to_m**2 * Kv(i,j,k) + if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = US%Z_to_m**2 * Kv(i,j,k) enddo endif endif @@ -844,8 +845,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & #ifdef __DO_SAFETY_CHECKS__ if (CS%debug) then - call hchksum(Kt, "KPP out: Kt", G%HI, haloshift=0, scale=GV%Z_to_m**2) - call hchksum(Ks, "KPP out: Ks", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Kt, "KPP out: Kt", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(Ks, "KPP out: Ks", G%HI, haloshift=0, scale=US%Z_to_m**2) endif #endif diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index baf347930b..215c1c4dbf 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -52,14 +52,15 @@ module MOM_CVMix_conv contains !> Initialized the CVMix convection mixing routine. -logical function CVMix_conv_init(Time, G, GV, param_file, diag, CS) +logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current time. type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. - type(CVMix_conv_cs), pointer :: CS !< This module's control structure. + type(CVMix_conv_cs), pointer :: CS !< This module's control structure. ! Local variables real :: prandtl_conv !< Turbulent Prandtl number used in convective instabilities. logical :: useEPBL !< If True, use the ePBL boundary layer scheme. @@ -133,9 +134,9 @@ logical function CVMix_conv_init(Time, G, GV, param_file, diag, CS) CS%id_N2 = register_diag_field('ocean_model', 'N2_conv', diag%axesTi, Time, & 'Square of Brunt-Vaisala frequency used by MOM_CVMix_conv module', '1/s2') CS%id_kd_conv = register_diag_field('ocean_model', 'kd_conv', diag%axesTi, Time, & - 'Additional diffusivity added by MOM_CVMix_conv module', 'm2/s', conversion=GV%Z_to_m**2) + 'Additional diffusivity added by MOM_CVMix_conv module', 'm2/s', conversion=US%Z_to_m**2) CS%id_kv_conv = register_diag_field('ocean_model', 'kv_conv', diag%axesTi, Time, & - 'Additional viscosity added by MOM_CVMix_conv module', 'm2/s', conversion=GV%Z_to_m**2) + 'Additional viscosity added by MOM_CVMix_conv module', 'm2/s', conversion=US%Z_to_m**2) call CVMix_init_conv(convect_diff=CS%kd_conv_const, & convect_visc=CS%kv_conv_const, & diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index 5d76287279..7f01b39378 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -58,14 +58,15 @@ module MOM_CVMix_ddiff contains !> Initialized the CVMix double diffusion module. -logical function CVMix_ddiff_init(Time, G, GV, param_file, diag, CS) +logical function CVMix_ddiff_init(Time, G, GV, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current time. type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. - type(CVMix_ddiff_cs), pointer :: CS !< This module's control structure. + type(CVMix_ddiff_cs), pointer :: CS !< This module's control structure. ! This include declares and sets the variable "version". #include "version_variable.h" @@ -137,10 +138,10 @@ logical function CVMix_ddiff_init(Time, G, GV, param_file, diag, CS) CS%diag => diag CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=GV%Z_to_m**2) + 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=US%Z_to_m**2) CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=GV%Z_to_m**2) + 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=US%Z_to_m**2) CS%id_R_rho = register_diag_field('ocean_model','R_rho',diag%axesTi,Time, & 'Double-diffusion density ratio', 'nondim') diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index b6ee62ea1c..9b33e7dd8e 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -151,8 +151,8 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) endif do K=1,G%ke+1 - Kvisc(K) = GV%Z_to_m**2 * kv(i,j,K) - Kdiff(K) = GV%Z_to_m**2 * kd(i,j,K) + Kvisc(K) = US%Z_to_m**2 * kv(i,j,K) + Kdiff(K) = US%Z_to_m**2 * kd(i,j,K) enddo ! Call to CVMix wrapper for computing interior mixing coefficients. @@ -183,10 +183,11 @@ end subroutine calculate_CVMix_shear !! \note *This is where we test to make sure multiple internal shear !! mixing routines (including JHL) are not enabled at the same time. !! (returns) CVMix_shear_init - True if module is to be used, False otherwise -logical function CVMix_shear_init(Time, G, GV, param_file, diag, CS) +logical function CVMix_shear_init(Time, G, GV, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current time. - type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. type(CVMix_shear_cs), pointer :: CS !< This module's control structure. @@ -283,9 +284,9 @@ logical function CVMix_shear_init(Time, G, GV, param_file, diag, CS) endif CS%id_kd = register_diag_field('ocean_model', 'kd_shear_CVMix', diag%axesTi, Time, & - 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s', conversion=GV%Z_to_m**2) + 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s', conversion=US%Z_to_m**2) CS%id_kv = register_diag_field('ocean_model', 'kv_shear_CVMix', diag%axesTi, Time, & - 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s', conversion=GV%Z_to_m**2) + 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s', conversion=US%Z_to_m**2) end function CVMix_shear_init diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index bf140ba069..4aea0b8d5d 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -150,7 +150,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, & "The minimum diapycnal diffusivity.", & - units="m2 s-1", default=0.01*CS%Kd*GV%Z_to_m**2, scale=US%m_to_Z**2) + units="m2 s-1", default=0.01*CS%Kd*US%Z_to_m**2, scale=US%m_to_Z**2) ! The following is needed to set one of the choices of vertical background mixing @@ -170,7 +170,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) "If BULKMIXEDLAYER is false, KDML is the elevated \n"//& "diapycnal diffusivity in the topmost HMIX of fluid. \n"//& "KDML is only used if BULKMIXEDLAYER is false.", & - units="m2 s-1", default=CS%Kd*GV%Z_to_m**2, scale=US%m_to_Z**2) + units="m2 s-1", default=CS%Kd*US%Z_to_m**2, scale=US%m_to_Z**2) call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface \n"//& "viscosity and diffusivity are elevated when the bulk \n"//& @@ -314,17 +314,17 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) ! Register diagnostics CS%diag => diag CS%id_kd_bkgnd = register_diag_field('ocean_model', 'Kd_bkgnd', diag%axesTi, Time, & - 'Background diffusivity added by MOM_bkgnd_mixing module', 'm2/s', conversion=GV%Z_to_m**2) + 'Background diffusivity added by MOM_bkgnd_mixing module', 'm2/s', conversion=US%Z_to_m**2) CS%id_kv_bkgnd = register_diag_field('ocean_model', 'Kv_bkgnd', diag%axesTi, Time, & - 'Background viscosity added by MOM_bkgnd_mixing module', 'm2/s', conversion=GV%Z_to_m**2) + 'Background viscosity added by MOM_bkgnd_mixing module', 'm2/s', conversion=US%Z_to_m**2) end subroutine bkgnd_mixing_init !> Get surface vertical background diffusivities/viscosities. -subroutine sfc_bkgnd_mixing(G, GV, CS) +subroutine sfc_bkgnd_mixing(G, US, CS) type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(bkgnd_mixing_cs), pointer, intent(inout) :: CS !< The control structure returned by !! a previous call to bkgnd_mixing_init. ! local variables @@ -369,7 +369,7 @@ subroutine sfc_bkgnd_mixing(G, GV, CS) enddo ; enddo endif - if (CS%debug) call hchksum(CS%Kd_sfc,"After sfc_bkgnd_mixing: Kd_sfc",G%HI,haloshift=0, scale=GV%Z_to_m**2) + if (CS%debug) call hchksum(CS%Kd_sfc,"After sfc_bkgnd_mixing: Kd_sfc",G%HI,haloshift=0, scale=US%Z_to_m**2) end subroutine sfc_bkgnd_mixing diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index d7e2dfd0bb..85e12fe567 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -1454,7 +1454,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, dKE_conv = dKE_CA(i,1) * MKE_rate_CA + dKE_FC(i) * MKE_rate_FC ! At this point, it is assumed that cTKE is positive and stored in TKE_CA! ! Note: Removed factor of 2 in u*^3 terms. - TKE(i) = (dt*CS%mstar)*((GV%Z_to_m**2*(U_Star*U_Star*U_Star))*exp_kh) + & + TKE(i) = (dt*CS%mstar)*((US%Z_to_m**2*(U_Star*U_Star*U_Star))*exp_kh) + & (exp_kh * dKE_conv + nstar_FC*Conv_En(i) + nstar_CA * TKE_CA) if (CS%do_rivermix) then ! Add additional TKE at river mouths @@ -1462,7 +1462,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, endif if (CS%TKE_diagnostics) then - wind_TKE_src = CS%mstar*(GV%Z_to_m**2*U_Star*U_Star*U_Star) * diag_wt + wind_TKE_src = CS%mstar*(US%Z_to_m**2*U_Star*U_Star*U_Star) * diag_wt CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + & ( wind_TKE_src + TKE_river(i) * diag_wt ) CS%diag_TKE_RiBulk(i,j) = CS%diag_TKE_RiBulk(i,j) + dKE_conv*Idt_diag @@ -3668,36 +3668,36 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) CS%id_ML_depth = register_diag_field('ocean_model', 'h_ML', diag%axesT1, & Time, 'Surface mixed layer depth', 'm') CS%id_TKE_wind = register_diag_field('ocean_model', 'TKE_wind', diag%axesT1, & - Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m) + Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m) CS%id_TKE_RiBulk = register_diag_field('ocean_model', 'TKE_RiBulk', diag%axesT1, & - Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m) + Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m) CS%id_TKE_conv = register_diag_field('ocean_model', 'TKE_conv', diag%axesT1, & - Time, 'Convective source of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m) + Time, 'Convective source of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m) CS%id_TKE_pen_SW = register_diag_field('ocean_model', 'TKE_pen_SW', diag%axesT1, & Time, 'TKE consumed by mixing penetrative shortwave radation through the mixed layer', & - 'm3 s-3', conversion=GV%Z_to_m) + 'm3 s-3', conversion=US%Z_to_m) CS%id_TKE_mixing = register_diag_field('ocean_model', 'TKE_mixing', diag%axesT1, & - Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3', conversion=GV%Z_to_m) + Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3', conversion=US%Z_to_m) CS%id_TKE_mech_decay = register_diag_field('ocean_model', 'TKE_mech_decay', diag%axesT1, & - Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m) + Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m) CS%id_TKE_conv_decay = register_diag_field('ocean_model', 'TKE_conv_decay', diag%axesT1, & - Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3', conversion=GV%Z_to_m) + Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m) CS%id_TKE_conv_s2 = register_diag_field('ocean_model', 'TKE_conv_s2', diag%axesT1, & - Time, 'Spurious source of mixed layer TKE from sigma2', 'm3 s-3', conversion=GV%Z_to_m) + Time, 'Spurious source of mixed layer TKE from sigma2', 'm3 s-3', conversion=US%Z_to_m) CS%id_PE_detrain = register_diag_field('ocean_model', 'PE_detrain', diag%axesT1, & Time, 'Spurious source of potential energy from mixed layer detrainment', & - 'W m-2', conversion=GV%Z_to_m) + 'W m-2', conversion=US%Z_to_m) CS%id_PE_detrain2 = register_diag_field('ocean_model', 'PE_detrain2', diag%axesT1, & Time, 'Spurious source of potential energy from mixed layer only detrainment', & - 'W m-2', conversion=GV%Z_to_m) + 'W m-2', conversion=US%Z_to_m) CS%id_h_mismatch = register_diag_field('ocean_model', 'h_miss_ML', diag%axesT1, & - Time, 'Summed absolute mismatch in entrainment terms', 'm', conversion=GV%Z_to_m) + Time, 'Summed absolute mismatch in entrainment terms', 'm', conversion=US%Z_to_m) CS%id_Hsfc_used = register_diag_field('ocean_model', 'Hs_used', diag%axesT1, & - Time, 'Surface region thickness that is used', 'm', conversion=GV%Z_to_m) + Time, 'Surface region thickness that is used', 'm', conversion=US%Z_to_m) CS%id_Hsfc_max = register_diag_field('ocean_model', 'Hs_max', diag%axesT1, & - Time, 'Maximum surface region thickness', 'm', conversion=GV%Z_to_m) + Time, 'Maximum surface region thickness', 'm', conversion=US%Z_to_m) CS%id_Hsfc_min = register_diag_field('ocean_model', 'Hs_min', diag%axesT1, & - Time, 'Minimum surface region thickness', 'm', conversion=GV%Z_to_m) + Time, 'Minimum surface region thickness', 'm', conversion=US%Z_to_m) !CS%lim_det_dH_sfc = 0.5 ; CS%lim_det_dH_bathy = 0.2 ! Technically these should not get used if limit_det is false? if (CS%limit_det .or. (CS%id_Hsfc_min > 0)) then call get_param(param_file, mdl, "LIMIT_BUFFER_DET_DH_SFC", CS%lim_det_dH_sfc, & diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index d6406a7c4a..604e0ab2dc 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -915,8 +915,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & dSV_dT(:,j,k), dSV_dS(:,j,k), is, ie-is+1, tv%eqn_of_state) do i=is,ie ; dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; enddo ! do i=is,ie -! dT_to_dPE(i,k) = I_G_Earth * GV%Z_to_m * d_pres(i) * p_lay(i) * dSV_dT(i,j,k) -! dS_to_dPE(i,k) = I_G_Earth * GV%Z_to_m * d_pres(i) * p_lay(i) * dSV_dS(i,j,k) +! dT_to_dPE(i,k) = I_G_Earth * US%Z_to_m * d_pres(i) * p_lay(i) * dSV_dT(i,j,k) +! dS_to_dPE(i,k) = I_G_Earth * US%Z_to_m * d_pres(i) * p_lay(i) * dSV_dS(i,j,k) ! enddo enddo pen_TKE_2d(:,:) = 0.0 diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 6e6c705d45..e9107a6cc3 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -434,7 +434,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call cpu_clock_begin(id_clock_set_diffusivity) - call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS%set_diff_CSp) + call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS%set_diff_CSp) call cpu_clock_end(id_clock_set_diffusivity) ! Frazil formation keeps the temperature above the freezing point. @@ -589,8 +589,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G) - call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=GV%Z_to_m**2) - call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=US%Z_to_m**2) endif if (CS%useKPP) then @@ -630,8 +630,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) - call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=GV%Z_to_m**2) - call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z_to_m**2) endif endif ! endif for KPP @@ -738,12 +738,12 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G, GV) + call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G, US) call pass_var(Hml, G%domain, halo=1) ! If visc%MLD exists, copy ePBL's MLD into it if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) elseif (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, GV) + call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, US) call pass_var(visc%MLD, G%domain, halo=1) endif @@ -768,7 +768,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call hchksum(eb_t, "after ePBL eb_t",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(ea_s, "after ePBL ea_s",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(eb_s, "after ePBL eb_s",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z_to_m**2) endif else @@ -1313,7 +1313,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call diapyc_energy_req_test(h, dt, tv, G, GV, US, CS%diapyc_en_rec_CSp) call cpu_clock_begin(id_clock_set_diffusivity) - call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS%set_diff_CSp) + call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS%set_diff_CSp) call cpu_clock_end(id_clock_set_diffusivity) ! Frazil formation keeps the temperature above the freezing point. @@ -1499,8 +1499,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G) - call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, scale=GV%Z_to_m**2) - call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z_to_m**2) endif @@ -1571,8 +1571,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) - call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=GV%Z_to_m**2) - call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, scale=US%Z_to_m**2) endif endif ! endif for KPP @@ -1719,7 +1719,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! If visc%MLD exists, copy the ePBL's MLD into it if (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, GV) + call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, US) call pass_var(visc%MLD, G%domain, halo=1) Hml(:,:) = visc%MLD(:,:) endif @@ -1749,7 +1749,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%debug) then call hchksum(ea, "after ePBL ea",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(eb, "after ePBL eb",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z_to_m**2) endif else @@ -3001,19 +3001,19 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di Time, "Advective diapycnal salnity flux across interfaces", & "psu m s-1") CS%id_MLD_003 = register_diag_field('ocean_model', 'MLD_003', diag%axesT1, Time, & - 'Mixed layer depth (delta rho = 0.03)', 'm', conversion=GV%Z_to_m, & + 'Mixed layer depth (delta rho = 0.03)', 'm', conversion=US%Z_to_m, & cmor_field_name='mlotst', cmor_long_name='Ocean Mixed Layer Thickness Defined by Sigma T', & cmor_standard_name='ocean_mixed_layer_thickness_defined_by_sigma_t') CS%id_mlotstsq = register_diag_field('ocean_model','mlotstsq',diag%axesT1, Time, & long_name='Square of Ocean Mixed Layer Thickness Defined by Sigma T', & standard_name='square_of_ocean_mixed_layer_thickness_defined_by_sigma_t', & - units='m2', conversion=GV%Z_to_m**2) + units='m2', conversion=US%Z_to_m**2) CS%id_MLD_0125 = register_diag_field('ocean_model','MLD_0125',diag%axesT1,Time, & - 'Mixed layer depth (delta rho = 0.125)', 'm', conversion=GV%Z_to_m) + 'Mixed layer depth (delta rho = 0.125)', 'm', conversion=US%Z_to_m) CS%id_subMLN2 = register_diag_field('ocean_model','subML_N2',diag%axesT1,Time, & 'Squared buoyancy frequency below mixed layer', 's-2') CS%id_MLD_user = register_diag_field('ocean_model','MLD_user',diag%axesT1,Time, & - 'Mixed layer depth (used defined)', 'm', conversion=GV%Z_to_m) + 'Mixed layer depth (used defined)', 'm', conversion=US%Z_to_m) call get_param(param_file, mdl, "DIAG_MLD_DENSITY_DIFF", CS%MLDdensityDifference, & "The density difference used to determine a diagnostic mixed\n"//& "layer depth, MLD_user, following the definition of Levitus 1982. \n"//& @@ -3065,26 +3065,26 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di !call set_diffusivity_init(Time, G, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, CS%int_tide_CSp) CS%id_Kd_interface = register_diag_field('ocean_model', 'Kd_interface', diag%axesTi, Time, & - 'Total diapycnal diffusivity at interfaces', 'm2 s-1', conversion=GV%Z_to_m**2) + 'Total diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z_to_m**2) if (CS%use_energetic_PBL) then CS%id_Kd_ePBL = register_diag_field('ocean_model', 'Kd_ePBL', diag%axesTi, Time, & - 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1', conversion=GV%Z_to_m**2) + 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z_to_m**2) endif CS%id_Kd_heat = register_diag_field('ocean_model', 'Kd_heat', diag%axesTi, Time, & - 'Total diapycnal diffusivity for heat at interfaces', 'm2 s-1', conversion=GV%Z_to_m**2, & + 'Total diapycnal diffusivity for heat at interfaces', 'm2 s-1', conversion=US%Z_to_m**2, & cmor_field_name='difvho', & cmor_standard_name='ocean_vertical_heat_diffusivity', & cmor_long_name='Ocean vertical heat diffusivity') CS%id_Kd_salt = register_diag_field('ocean_model', 'Kd_salt', diag%axesTi, Time, & - 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', conversion=GV%Z_to_m**2, & + 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', conversion=US%Z_to_m**2, & cmor_field_name='difvso', & cmor_standard_name='ocean_vertical_salt_diffusivity', & cmor_long_name='Ocean vertical salt diffusivity') ! CS%useKPP is set to True if KPP-scheme is to be used, False otherwise. ! KPP_init() allocated CS%KPP_Csp and also sets CS%KPPisPassive - CS%useKPP = KPP_init(param_file, G, GV, diag, Time, CS%KPP_CSp, passive=CS%KPPisPassive) + CS%useKPP = KPP_init(param_file, G, GV, US, diag, Time, CS%KPP_CSp, passive=CS%KPPisPassive) if (CS%useKPP) then allocate( CS%KPP_NLTheat(isd:ied,jsd:jed,nz+1) ) ; CS%KPP_NLTheat(:,:,:) = 0. allocate( CS%KPP_NLTscalar(isd:ied,jsd:jed,nz+1) ) ; CS%KPP_NLTscalar(:,:,:) = 0. @@ -3283,9 +3283,9 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! CS%use_CVMix_conv is set to True if CVMix convection will be used, otherwise ! False. - CS%use_CVMix_conv = CVMix_conv_init(Time, G, GV, param_file, diag, CS%CVMix_conv_csp) + CS%use_CVMix_conv = CVMix_conv_init(Time, G, GV, US, param_file, diag, CS%CVMix_conv_csp) - call entrain_diffusive_init(Time, G, GV, param_file, diag, CS%entrain_diffusive_CSp) + call entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS%entrain_diffusive_CSp) ! initialize the geothermal heating module if (CS%use_geothermal) & @@ -3333,7 +3333,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call regularize_layers_init(Time, G, GV, param_file, diag, CS%regularize_layers_CSp) if (CS%debug_energy_req) & - call diapyc_energy_req_init(Time, G, GV, param_file, diag, CS%diapyc_en_rec_CSp) + call diapyc_energy_req_init(Time, G, GV, US, param_file, diag, CS%diapyc_en_rec_CSp) ! obtain information about the number of bands for penetrative shortwave if (use_temperature) then diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 80651ca593..4fbdc9d8c3 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -277,7 +277,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & h_tr(k) = h_in(k) htot = htot + h_tr(k) pres(K+1) = pres(K) + GV%H_to_Pa * h_tr(k) - pres_Z(K+1) = GV%Z_to_m * pres(K+1) + pres_Z(K+1) = US%Z_to_m * pres(K+1) p_lay(k) = 0.5*(pres(K) + pres(K+1)) Z_int(K+1) = Z_int(K) - h_tr(k) enddo @@ -1262,10 +1262,11 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & end subroutine find_PE_chg_orig !> Initialize parameters and allocate memory associated with the diapycnal energy requirement module. -subroutine diapyc_energy_req_init(Time, G, GV, param_file, diag, CS) +subroutine diapyc_energy_req_init(Time, G, GV, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< model time type(ocean_grid_type), intent(in) :: G !< model grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< file to parse for parameter values type(diag_ctrl), target, intent(inout) :: diag !< structure to regulate diagnostic output type(diapyc_energy_req_CS), pointer :: CS !< module control structure @@ -1306,10 +1307,10 @@ subroutine diapyc_energy_req_init(Time, G, GV, param_file, diag, CS) CS%id_Kddt = register_diag_field('ocean_model', 'EnReqTest_Kddt', diag%axesZi, Time, & "Implicit diffusive coupling coefficient", "m", conversion=GV%H_to_m) CS%id_Kd = register_diag_field('ocean_model', 'EnReqTest_Kd', diag%axesZi, Time, & - "Diffusivity in test", "m2 s-1", conversion=GV%Z_to_m**2) + "Diffusivity in test", "m2 s-1", conversion=US%Z_to_m**2) CS%id_h = register_diag_field('ocean_model', 'EnReqTest_h_lay', diag%axesZL, Time, & "Test column layer thicknesses", "m", conversion=GV%H_to_m) - CS%id_zInt = register_diag_field('ocean_model', 'EnReqTest_z_int', diag%axesZi, Time, & + CS%id_zInt = register_diag_field('ocean_model', 'EnReqTest_z_int', diag%axesZi, Time, & "Test column layer interface heights", "m", conversion=GV%H_to_m) CS%id_CHCt = register_diag_field('ocean_model', 'EnReqTest_CHCt', diag%axesZi, Time, & "Column Height Correction to Energy Requirements, top-down", "J m-2") diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 1f664deb5a..fbc8b90996 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -629,8 +629,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS iL_Ekman = absf(i) / U_star iL_Obukhov = buoy_flux(i,j)*vonkar / (U_star**3) if (CS%USE_LT) then - Ekman_o_Obukhov_stab = abs(max(0., iL_Obukhov / (iL_Ekman + 1.e-10*GV%Z_to_m))) - Ekman_o_Obukhov_un = abs(min(0., iL_Obukhov / (iL_Ekman + 1.e-10*GV%Z_to_m))) + Ekman_o_Obukhov_stab = abs(max(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) + Ekman_o_Obukhov_un = abs(min(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) !### Consider recoding this as... ! Max_ratio = 1.0e16 ! Ekman_Obukhov = Max_ratio @@ -644,7 +644,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS endif if (CS%Mstar_Mode == CS%CONST_MSTAR) then - mech_TKE(i) = (dt*CS%mstar*GV%Rho0) * GV%Z_to_m**3 * U_star**3 + mech_TKE(i) = (dt*CS%mstar*GV%Rho0) * US%Z_to_m**3 * U_star**3 conv_PErel(i) = 0.0 if (CS%TKE_diagnostics) then @@ -691,7 +691,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS dS_to_dColHt(i,k) = dMass * US%m_to_Z * dSV_dS(i,j,k) pres(i,K+1) = pres(i,K) + dPres - pres_Z(i,K+1) = GV%Z_to_m * pres(i,K+1) + pres_Z(i,K+1) = US%Z_to_m * pres(i,K+1) enddo ! endif ; enddo @@ -820,7 +820,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS endif !Reset mech_tke and conv_perel values (based on new mstar) mech_TKE(i) = ( MSTAR_mix * MSTAR_conv_adj * ENHANCE_M + MSTAR_LT) * & - GV%Z_to_m**3 * (dt*GV%Rho0*U_star**3) + US%Z_to_m**3 * (dt*GV%Rho0*U_star**3) conv_PErel(i) = 0.0 if (CS%TKE_diagnostics) then CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + mech_TKE(i) * IdtdR0 @@ -1469,7 +1469,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (allocated(CS%mstar_lt)) CS%mstar_lt(i,j) = MSTAR_LT if (allocated(CS%MLD_Obukhov)) CS%MLD_Obukhov(i,j) = MLD_guess * iL_Obukhov if (allocated(CS%MLD_Ekman)) CS%MLD_Ekman(i,j) = MLD_guess * iL_Ekman - if (allocated(CS%Ekman_Obukhov)) CS%Ekman_Obukhov(i,j) = iL_Obukhov / (iL_Ekman + 1.e-10*GV%Z_to_m) + if (allocated(CS%Ekman_Obukhov)) CS%Ekman_Obukhov(i,j) = iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m) if (allocated(CS%La)) CS%La(i,j) = LA if (allocated(CS%La_mod)) CS%La_mod(i,j) = LAmod else ! End of the ocean-point part of the i-loop @@ -1845,19 +1845,19 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & end subroutine find_PE_chg_orig !> Copies the ePBL active mixed layer depth into MLD -subroutine energetic_PBL_get_MLD(CS, MLD, G, GV, m_to_MLD_units) +subroutine energetic_PBL_get_MLD(CS, MLD, G, US, m_to_MLD_units) type(energetic_PBL_CS), pointer :: CS !< Control structure for ePBL type(ocean_grid_type), intent(in) :: G !< Grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G)), intent(out) :: MLD !< Depth of ePBL active mixing layer, in m real, optional, intent(in) :: m_to_MLD_units !< A conversion factor to the desired units for MLD ! Local variables real :: scale ! A dimensional rescaling factor integer :: i,j - scale = GV%Z_to_m ; if (present(m_to_MLD_units)) scale = scale * m_to_MLD_units + scale = US%Z_to_m ; if (present(m_to_MLD_units)) scale = scale * m_to_MLD_units - do j = G%jsc, G%jec ; do i = G%isc, G%iec + do j=G%jsc,G%jec ; do i=G%isc,G%iec MLD(i,j) = scale*CS%ML_Depth(i,j) enddo ; enddo @@ -2227,12 +2227,12 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) endif ! This gives a minimum decay scale that is typically much less than Angstrom. CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) - call log_param(param_file, mdl, "EPBL_USTAR_MIN", CS%ustar_min*GV%Z_to_m, & + call log_param(param_file, mdl, "EPBL_USTAR_MIN", CS%ustar_min*US%Z_to_m, & "The (tiny) minimum friction velocity used within the \n"//& "ePBL code, derived from OMEGA and ANGSTROM.", units="m s-1") CS%id_ML_depth = register_diag_field('ocean_model', 'ePBL_h_ML', diag%axesT1, & - Time, 'Surface boundary layer depth', 'm', conversion=GV%Z_to_m, & + Time, 'Surface boundary layer depth', 'm', conversion=US%Z_to_m, & cmor_long_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme') CS%id_TKE_wind = register_diag_field('ocean_model', 'ePBL_TKE_wind', diag%axesT1, & Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3') @@ -2252,9 +2252,9 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) CS%id_Hsfc_used = register_diag_field('ocean_model', 'ePBL_Hs_used', diag%axesT1, & Time, 'Surface region thickness that is used', 'm', conversion=US%m_to_Z) CS%id_Mixing_Length = register_diag_field('ocean_model', 'Mixing_Length', diag%axesTi, & - Time, 'Mixing Length that is used', 'm', conversion=GV%Z_to_m) + Time, 'Mixing Length that is used', 'm', conversion=US%Z_to_m) CS%id_Velocity_Scale = register_diag_field('ocean_model', 'Velocity_Scale', diag%axesTi, & - Time, 'Velocity Scale that is used.', 'm s-1', conversion=GV%Z_to_m) + Time, 'Velocity Scale that is used.', 'm s-1', conversion=US%Z_to_m) CS%id_LT_enhancement = register_diag_field('ocean_model', 'LT_Enhancement', diag%axesT1, & Time, 'LT enhancement that is used.', 'nondim') CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, & diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index b524716f55..d438cae864 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -2135,10 +2135,11 @@ end subroutine find_maxF_kb !> This subroutine initializes the parameters and memory associated with the !! entrain_diffusive module. -subroutine entrain_diffusive_init(Time, G, GV, param_file, diag, CS) +subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(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 @@ -2191,9 +2192,9 @@ subroutine entrain_diffusive_init(Time, G, GV, param_file, diag, CS) units="m", default=MAX(100.0*GV%Angstrom_m,1.0e-4*sqrt(dt*Kd)), scale=GV%m_to_H) CS%id_Kd = register_diag_field('ocean_model', 'Kd_effective', diag%axesTL, Time, & - 'Diapycnal diffusivity as applied', 'm2 s-1', conversion=GV%Z_to_m**2) + 'Diapycnal diffusivity as applied', 'm2 s-1', conversion=US%Z_to_m**2) CS%id_diff_work = register_diag_field('ocean_model', 'diff_work', diag%axesTi, Time, & - 'Work actually done by diapycnal diffusion across each interface', 'W m-2', conversion=GV%Z_to_m) + 'Work actually done by diapycnal diffusion across each interface', 'W m-2', conversion=US%Z_to_m) end subroutine entrain_diffusive_init diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index c89ec7df78..c2b303426b 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -347,7 +347,7 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) ! Compute the fixed part of internal tidal forcing; units are [J m-2] here. CS%TKE_itidal_coef(i,j) = 0.5*kappa_h2_factor*GV%Rho0*& - kappa_itides * GV%Z_to_m**2*itide%h2(i,j) * itide%tideamp(i,j)**2 + kappa_itides * US%Z_to_m**2*itide%h2(i,j) * itide%tideamp(i,j)**2 enddo ; enddo diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 6ec325eba7..7b0a7ad032 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -361,7 +361,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & enddo ! end of j-loop if (CS%debug) then - call hchksum(kappa_io, "kappa", G%HI, scale=GV%Z_to_m**2) + call hchksum(kappa_io, "kappa", G%HI, scale=US%Z_to_m**2) call hchksum(tke_io, "tke", G%HI) endif @@ -693,7 +693,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ enddo ! end of J-loop if (CS%debug) then - call hchksum(kappa_io, "kappa", G%HI, scale=GV%Z_to_m**2) + call hchksum(kappa_io, "kappa", G%HI, scale=US%Z_to_m**2) call Bchksum(tke_io, "tke", G%HI) endif @@ -911,7 +911,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & if (use_temperature) then pressure(1) = surface_pres do K=2,nzc - pressure(K) = pressure(K-1) + gR0*GV%Z_to_m*dz(k-1) + pressure(K) = pressure(K-1) + gR0*US%Z_to_m*dz(k-1) T_int(K) = 0.5*(T(k-1) + T(k)) Sal_int(K) = 0.5*(Sal(k-1) + Sal(k)) enddo @@ -999,7 +999,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! call cpu_clock_begin(id_clock_KQ) call find_kappa_tke(N2, S2, kappa, Idz, dz_Int, I_L2_bdry, f2, & - nzc, CS, GV, K_Q, tke, kappa_out, kappa_src, local_src) + nzc, CS, GV, US, K_Q, tke, kappa_out, kappa_src, local_src) ! call cpu_clock_end(id_clock_KQ) ! call cpu_clock_begin(id_clock_avg) @@ -1125,7 +1125,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! call cpu_clock_begin(id_clock_KQ) do K=1,nzc+1 ; K_Q_tmp(K) = K_Q(K) ; enddo call find_kappa_tke(N2, S2, kappa_out, Idz, dz_Int, I_L2_bdry, f2, & - nzc, CS, GV, K_Q_tmp, tke_pred, kappa_pred) + nzc, CS, GV, US, K_Q_tmp, tke_pred, kappa_pred) ! call cpu_clock_end(id_clock_KQ) ks_kappa = GV%ke+1 ; ke_kappa = 0 @@ -1144,7 +1144,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! call cpu_clock_begin(id_clock_KQ) call find_kappa_tke(N2, S2, kappa_out, Idz, dz_Int, I_L2_bdry, f2, & - nzc, CS, GV, K_Q, tke_pred, kappa_pred) + nzc, CS, GV, US, K_Q, tke_pred, kappa_pred) ! call cpu_clock_end(id_clock_KQ) ! call cpu_clock_begin(id_clock_avg) @@ -1368,7 +1368,7 @@ end subroutine calculate_projected_state !> This subroutine calculates new, consistent estimates of TKE and kappa. subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & - nz, CS, GV, K_Q, tke, kappa, kappa_src, local_src) + nz, CS, GV, US, K_Q, tke, kappa, kappa_src, local_src) integer, intent(in) :: nz !< The number of layers to work on. real, dimension(nz+1), intent(in) :: N2 !< The buoyancy frequency squared at interfaces, !! in s-2. @@ -1383,6 +1383,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real, intent(in) :: f2 !< The squared Coriolis parameter, in s-2. type(Kappa_shear_CS), pointer :: CS !< A pointer to this module's control structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(nz+1), intent(inout) :: K_Q !< The shear-driven diapycnal diffusivity divided by !! the turbulent kinetic energy per unit mass at !! interfaces, in s. @@ -1492,7 +1493,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & q0 = CS%TKE_bg ; kappa0 = CS%kappa_0 ; TKE_min = max(CS%TKE_bg,1.0E-20) Ri_crit = CS%Rino_crit Ilambda2 = 1.0 / CS%lambda**2 - Z2_to_L2 = GV%Z_to_m**2 + Z2_to_L2 = US%Z_to_m**2 kappa_trunc = 0.01*kappa0 ! ### CHANGE THIS HARD-WIRING LATER? do_Newton = .false. ; abort_Newton = .false. tol_err = CS%kappa_tol_err @@ -1722,7 +1723,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & cK(K+1) = bK * Idz(k) cKcomp = bK * (Idz(k-1)*cKcomp + decay_term_k) ! = 1-cK(K+1) dKdQ(K) = bK * (Idz(k-1)*dKdQ(K-1)*cQ(K) + & - GV%Z_to_m*(N2(K)*Ilambda2 + f2) * I_Q**2 * kappa(K) ) + US%Z_to_m*(N2(K)*Ilambda2 + f2) * I_Q**2 * kappa(K) ) dK(K) = bK * (kap_src + Idz(k-1)*dK(K-1) + Idz(k-1)*dKdQ(K-1)*dQ(K-1)) ! Truncate away negligibly small values of kappa. @@ -1853,7 +1854,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & Idz(k)*(kappa_prev(k)-kappa_prev(k+1))) K_err_lin = -Idz(k-1)*(dK(K-1)-dK(K)) + Idz(k)*(dK(K)-dK(K+1)) + & dz_Int(K)*I_Ld2(K)*dK(K) - kap_src - & - GV%Z_to_m*(N2(K)*Ilambda2 + f2)*I_Q**2*kappa_prev(K) * dQ(K) + US%Z_to_m*(N2(K)*Ilambda2 + f2)*I_Q**2*kappa_prev(K) * dQ(K) tke_src = dz_Int(K) * (Z2_to_L2*(kappa_prev(K) + kappa0)*S2(K) - & Z2_to_L2*kappa_prev(K)*N2(K) - (TKE_prev(K) - q0)*TKE_decay(K)) - & @@ -2126,14 +2127,14 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) CS%diag => diag CS%id_Kd_shear = register_diag_field('ocean_model','Kd_shear',diag%axesTi,Time, & - 'Shear-driven Diapycnal Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2) + 'Shear-driven Diapycnal Diffusivity', 'm2 s-1', conversion=US%Z_to_m**2) CS%id_TKE = register_diag_field('ocean_model','TKE_shear',diag%axesTi,Time, & 'Shear-driven Turbulent Kinetic Energy', 'm2 s-2') #ifdef ADD_DIAGNOSTICS CS%id_ILd2 = register_diag_field('ocean_model','ILd2_shear',diag%axesTi,Time, & 'Inverse kappa decay scale at interfaces', 'm-2', conversion=US%m_to_Z**2) CS%id_dz_Int = register_diag_field('ocean_model','dz_Int_shear',diag%axesTi,Time, & - 'Finite volume thickness of interfaces', 'm', conversion=GV%Z_to_m) + 'Finite volume thickness of interfaces', 'm', conversion=US%Z_to_m) #endif end function kappa_shear_init diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 9d4234b7ea..cbff7bbabf 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -354,8 +354,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & visc%TKE_turb, visc%Kv_shear_Bu, dt, G, GV, US, CS%kappaShear_CSp) if (associated(visc%Kv_shear)) visc%Kv_shear(:,:,:) = 0.0 ! needed for other parameterizations if (CS%debug) then - call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear", G%HI, scale=GV%Z_to_m**2) - call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu", G%HI, scale=GV%Z_to_m**2) + call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear", G%HI, scale=US%Z_to_m**2) + call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu", G%HI, scale=US%Z_to_m**2) call Bchksum(visc%TKE_turb, "after calc_KS_vert visc%TKE_turb", G%HI) endif else @@ -364,8 +364,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call calculate_kappa_shear(u_h, v_h, h, tv, fluxes%p_surf, visc%Kd_shear, visc%TKE_turb, & visc%Kv_shear, dt, G, GV, US, CS%kappaShear_CSp) if (CS%debug) then - call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI, scale=GV%Z_to_m**2) - call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear", G%HI, scale=GV%Z_to_m**2) + call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI, scale=US%Z_to_m**2) + call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear", G%HI, scale=US%Z_to_m**2) call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb", G%HI) endif endif @@ -375,8 +375,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & !NOTE{BGR}: this needs to be cleaned up. It works in 1D case, but has not been tested outside. call calculate_CVMix_shear(u_h, v_h, h, tv, visc%Kd_shear, visc%Kv_shear, G, GV, US, CS%CVMix_shear_CSp) if (CS%debug) then - call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear", G%HI, scale=GV%Z_to_m**2) - call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear", G%HI, scale=GV%Z_to_m**2) + call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear", G%HI, scale=US%Z_to_m**2) + call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear", G%HI, scale=US%Z_to_m**2) endif elseif (associated(visc%Kv_shear)) then visc%Kv_shear(:,:,:) = 0.0 ! needed if calculate_kappa_shear is not enabled @@ -387,7 +387,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! another explicit parameterization of Kd. ! set surface diffusivities (CS%bkgnd_mixing_csp%Kd_sfc) - call sfc_bkgnd_mixing(G, GV, CS%bkgnd_mixing_csp) + call sfc_bkgnd_mixing(G, US, CS%bkgnd_mixing_csp) !$OMP parallel do default(shared) private(dRho_int, N2_lay, N2_int, N2_bot, KT_extra, & !$OMP KS_extra, TKE_to_Kd,maxTKE, dissip, kb) @@ -523,34 +523,34 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(dd%Kd_work)) then do k=1,nz ; do i=is,ie - dd%Kd_Work(i,j,k) = GV%Rho0 * GV%Z_to_m**3*Kd_lay(i,j,k) * N2_lay(i,k) * & + dd%Kd_Work(i,j,k) = GV%Rho0 * US%Z_to_m**3*Kd_lay(i,j,k) * N2_lay(i,k) * & GV%H_to_Z*h(i,j,k) ! Watt m-2 s or kg s-3 enddo ; enddo endif enddo ! j-loop if (CS%debug) then - call hchksum(Kd_lay ,"Kd_lay", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(Kd_lay ,"Kd_lay", G%HI, haloshift=0, scale=US%Z_to_m**2) - if (CS%useKappaShear) call hchksum(visc%Kd_shear, "Turbulent Kd", G%HI, haloshift=0, scale=GV%Z_to_m**2) + if (CS%useKappaShear) call hchksum(visc%Kd_shear, "Turbulent Kd", G%HI, haloshift=0, scale=US%Z_to_m**2) if (CS%use_CVMix_ddiff) then - call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T", G%HI, haloshift=0, scale=GV%Z_to_m**2) - call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S", G%HI, haloshift=0, scale=GV%Z_to_m**2) + call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S", G%HI, haloshift=0, scale=US%Z_to_m**2) endif if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then call uvchksum("BBL Kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, & - G%HI, 0, symmetric=.true., scale=GV%Z_to_m**2) + G%HI, 0, symmetric=.true., scale=US%Z_to_m**2) endif if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) then call uvchksum("BBL bbl_thick_[uv]", visc%bbl_thick_u, & - visc%bbl_thick_v, G%HI, 0, symmetric=.true., scale=GV%Z_to_m) + visc%bbl_thick_v, G%HI, 0, symmetric=.true., scale=US%Z_to_m) endif if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) then - call uvchksum("Ray_[uv]", visc%Ray_u, visc%Ray_v, G%HI, 0, symmetric=.true., scale=GV%Z_to_m) + call uvchksum("Ray_[uv]", visc%Ray_u, visc%Ray_v, G%HI, 0, symmetric=.true., scale=US%Z_to_m) endif endif @@ -730,7 +730,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & ! Simple but coordinate-independent estimate of Kd/TKE if (CS%simple_TKE_to_Kd) then do k=1,nz ; do i=is,ie - hN2pO2 = GV%Z_to_m**3 * ( GV%H_to_Z * h(i,j,k) ) * ( N2_lay(i,k) + Omega2 ) ! Units of m3 Z-2 s-2. + hN2pO2 = US%Z_to_m**3 * ( GV%H_to_Z * h(i,j,k) ) * ( N2_lay(i,k) + Omega2 ) ! Units of m3 Z-2 s-2. if (hN2pO2>0.) then TKE_to_Kd(i,k) = 1.0 / hN2pO2 ! Units of Z2 s2 m-3. else; TKE_to_Kd(i,k) = 0.; endif @@ -852,7 +852,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & ! dRho_int should already be non-negative, so the max is redundant? dh_max = maxEnt(i,k) * (1.0 + dsp1_ds(i,k)) dRho_lay = 0.5 * max(dRho_int(i,K) + dRho_int(i,K+1), 0.0) - maxTKE(i,k) = I_dt*GV%Z_to_m * ((GV%g_Earth * I_Rho0) * & + maxTKE(i,k) = I_dt*US%Z_to_m * ((GV%g_Earth * I_Rho0) * & (0.5*max(dRho_int(i,K+1) + dsp1_ds(i,k)*dRho_int(i,K), 0.0))) * & ((GV%H_to_Z*h(i,j,k) + dh_max) * maxEnt(i,k)) TKE_to_Kd(i,k) = US%m_to_Z**3 / (G_Rho0 * dRho_lay + & @@ -1289,7 +1289,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & else ; TKE_to_layer = 0.0 ; endif ! TKE_Ray has been initialized to 0 above. - if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * GV%Z_to_m * G%IareaT(i,j) * & + if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * US%Z_to_m * G%IareaT(i,j) * & ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & @@ -1471,7 +1471,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! Add in additional energy input from bottom-drag against slopes (sides) if (Rayleigh_drag) TKE_remaining = TKE_remaining + & - 0.5*CS%BBL_effic * GV%Z_to_m * G%IareaT(i,j) * & + 0.5*CS%BBL_effic * US%Z_to_m * G%IareaT(i,j) * & ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & @@ -1495,7 +1495,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! TKE associated with Kd_wall, in m3 s-2. ! This calculation if for the volume spanning the interface. - TKE_Kd_wall = GV%Z_to_m**3*Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) + TKE_Kd_wall = US%Z_to_m**3*Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) ! Now bound Kd such that the associated TKE is no greater than available TKE for mixing. if (TKE_Kd_wall > 0.) then @@ -1642,7 +1642,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, endif TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-z1) - if (TKE_ml_flux(i) * I_decay(i) < 0.1*CS%Kd_min*GV%Z_to_m**3*Omega2) then + if (TKE_ml_flux(i) * I_decay(i) < 0.1*CS%Kd_min*US%Z_to_m**3*Omega2) then do_i(i) = .false. else ; do_any = .true. ; endif endif ; enddo @@ -1653,9 +1653,10 @@ end subroutine add_MLrad_diffusivity !> This subroutine calculates several properties related to bottom !! boundary layer turbulence. -subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) +subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< The zonal velocity, in m s-1 real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -1778,7 +1779,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, CS) G%areaCu(I,j)*(ustar(I)*ustar(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*vstar(i,J-1)) + & G%areaCv(i,J)*(vstar(i,J)*vstar(i,J))) ) ) - visc%TKE_BBL(i,j) = GV%Z_to_m * & + visc%TKE_BBL(i,j) = US%Z_to_m * & (((G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + & G%areaCu(I,j) * (ustar(I)*u2_bbl(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*v2_bbl(i,J-1)) + & @@ -2069,7 +2070,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z CS%use_LOTW_BBL_diffusivity = .false. ! This parameterization depends on a u* from viscous BBL endif CS%id_Kd_BBL = register_diag_field('ocean_model', 'Kd_BBL', diag%axesTi, Time, & - 'Bottom Boundary Layer Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2) + 'Bottom Boundary Layer Diffusivity', 'm2 s-1', conversion=US%Z_to_m**2) call get_param(param_file, mdl, "SIMPLE_TKE_TO_KD", CS%simple_TKE_to_Kd, & "If true, uses a simple estimate of Kd/TKE that will\n"//& "work for arbitrary vertical coordinates. If false,\n"//& @@ -2091,7 +2092,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z "may be used.", units="m2 s-1", scale=US%m_to_Z**2, fail_if_missing=.true.) call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, & "The minimum diapycnal diffusivity.", & - units="m2 s-1", default=0.01*CS%Kd*GV%Z_to_m**2, scale=US%m_to_Z**2) + units="m2 s-1", default=0.01*CS%Kd*US%Z_to_m**2, scale=US%m_to_Z**2) call get_param(param_file, mdl, "KD_MAX", CS%Kd_max, & "The maximum permitted increment for the diapycnal \n"//& "diffusivity from TKE-based parameterizations, or a \n"//& @@ -2119,7 +2120,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z "If BULKMIXEDLAYER is false, KDML is the elevated \n"//& "diapycnal diffusivity in the topmost HMIX of fluid. \n"//& "KDML is only used if BULKMIXEDLAYER is false.", & - units="m2 s-1", default=CS%Kd*GV%Z_to_m**2, scale=US%m_to_Z**2) + units="m2 s-1", default=CS%Kd*US%Z_to_m**2, scale=US%m_to_Z**2) call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface \n"//& "viscosity and diffusivity are elevated when the bulk \n"//& @@ -2157,7 +2158,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z CS%dissip_N2 = CS%dissip_Kd_min * GV%Rho0 / CS%FluxRi_max CS%id_Kd_layer = register_diag_field('ocean_model', 'Kd_layer', diag%axesTL, Time, & - 'Diapycnal diffusivity of layers (as set)', 'm2 s-1', conversion=GV%Z_to_m**2) + 'Diapycnal diffusivity of layers (as set)', 'm2 s-1', conversion=US%Z_to_m**2) if (CS%tm_csp%Int_tide_dissipation .or. CS%tm_csp%Lee_wave_dissipation .or. & @@ -2168,7 +2169,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z CS%id_maxTKE = register_diag_field('ocean_model', 'maxTKE', diag%axesTL, Time, & 'Maximum layer TKE', 'm3 s-3') CS%id_TKE_to_Kd = register_diag_field('ocean_model', 'TKE_to_Kd', diag%axesTL, Time, & - 'Convert TKE to Kd', 's2 m', conversion=GV%Z_to_m**2) + 'Convert TKE to Kd', 's2 m', conversion=US%Z_to_m**2) CS%id_N2 = register_diag_field('ocean_model', 'N2', diag%axesTi, Time, & 'Buoyancy frequency squared', 's-2', cmor_field_name='obvfsq', & cmor_long_name='Square of seawater buoyancy frequency', & @@ -2176,14 +2177,14 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z if (CS%user_change_diff) & CS%id_Kd_user = register_diag_field('ocean_model', 'Kd_user', diag%axesTi, Time, & - 'User-specified Extra Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2) + 'User-specified Extra Diffusivity', 'm2 s-1', conversion=US%Z_to_m**2) if (associated(diag_to_Z_CSp)) then vd = var_desc("N2", "s-2", & "Buoyancy frequency, interpolated to z", z_grid='z') CS%id_N2_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) if (CS%user_change_diff) & - CS%id_Kd_user_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) + CS%id_Kd_user_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=US%Z_to_m**2) endif endif @@ -2205,23 +2206,23 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z ! The default molecular viscosity follows the CCSM4.0 and MOM4p1 defaults. CS%id_KT_extra = register_diag_field('ocean_model', 'KT_extra', diag%axesTi, Time, & - 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=GV%Z_to_m**2) + 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=US%Z_to_m**2) CS%id_KS_extra = register_diag_field('ocean_model', 'KS_extra', diag%axesTi, Time, & - 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=GV%Z_to_m**2) + 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=US%Z_to_m**2) if (associated(diag_to_Z_CSp)) then vd = var_desc("KT_extra", "m2 s-1", & "Double-Diffusive Temperature Diffusivity, interpolated to z", & z_grid='z') - CS%id_KT_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) + CS%id_KT_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=US%Z_to_m**2) vd = var_desc("KS_extra", "m2 s-1", & "Double-Diffusive Salinity Diffusivity, interpolated to z", & z_grid='z') - CS%id_KS_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) + CS%id_KS_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=US%Z_to_m**2) vd = var_desc("Kd_BBL", "m2 s-1", & "Bottom Boundary Layer Diffusivity", z_grid='z') - CS%id_Kd_BBL_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) + CS%id_Kd_BBL_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=US%Z_to_m**2) endif endif ! old double-diffusion @@ -2240,10 +2241,10 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z id_clock_kappaShear = cpu_clock_id('(Ocean kappa_shear)', grain=CLOCK_MODULE) ! CVMix shear-driven mixing - CS%use_CVMix_shear = CVMix_shear_init(Time, G, GV, param_file, CS%diag, CS%CVMix_shear_csp) + CS%use_CVMix_shear = CVMix_shear_init(Time, G, GV, US, param_file, CS%diag, CS%CVMix_shear_csp) ! CVMix double diffusion mixing - CS%use_CVMix_ddiff = CVMix_ddiff_init(Time, G, GV, param_file, CS%diag, CS%CVMix_ddiff_csp) + CS%use_CVMix_ddiff = CVMix_ddiff_init(Time, G, GV, US, param_file, CS%diag, CS%CVMix_ddiff_csp) if (CS%use_CVMix_ddiff) & id_clock_CVMix_ddiff = cpu_clock_id('(Double diffusion via CVMix)', grain=CLOCK_MODULE) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index fb40b08a6c..bdcadf6ab1 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -263,7 +263,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nkmb = GV%nk_rho_varies ; nkml = GV%nkml h_neglect = GV%H_subroundoff - Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * GV%Z_to_m**2 * GV%Z_to_H + Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * US%Z_to_m**2 * GV%Z_to_H Vol_quit = 0.9*GV%Angstrom_H + h_neglect C2pi_3 = 8.0*atan(1.0)/3.0 @@ -892,12 +892,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) if (CS%debug) then if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) & - call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI, haloshift=0, scale=GV%Z_to_m) + call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI, haloshift=0, scale=US%Z_to_m) if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) & - call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, haloshift=0, scale=GV%Z_to_m**2) + call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, haloshift=0, scale=US%Z_to_m**2) if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) & call uvchksum("bbl_thick_[uv]", visc%bbl_thick_u, & - visc%bbl_thick_v, G%HI, haloshift=0, scale=GV%Z_to_m) + visc%bbl_thick_v, G%HI, haloshift=0, scale=US%Z_to_m) endif end subroutine set_viscous_BBL @@ -1126,7 +1126,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri Jsq = js-1 ; Isq = is-1 endif ; endif - Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * GV%Z_to_m**2 * GV%Z_to_H + Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * US%Z_to_m**2 * GV%Z_to_H U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt = sqrt(CS%cdrag) cdrag_sqrt_Z = US%m_to_Z * sqrt(CS%cdrag) @@ -1994,21 +1994,21 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS allocate(visc%TKE_bbl(isd:ied,jsd:jed)) ; visc%TKE_bbl = 0.0 CS%id_bbl_thick_u = register_diag_field('ocean_model', 'bbl_thick_u', & - diag%axesCu1, Time, 'BBL thickness at u points', 'm', conversion=GV%Z_to_m) + diag%axesCu1, Time, 'BBL thickness at u points', 'm', conversion=US%Z_to_m) CS%id_kv_bbl_u = register_diag_field('ocean_model', 'kv_bbl_u', diag%axesCu1, & - Time, 'BBL viscosity at u points', 'm2 s-1', conversion=GV%Z_to_m**2) + Time, 'BBL viscosity at u points', 'm2 s-1', conversion=US%Z_to_m**2) CS%id_bbl_thick_v = register_diag_field('ocean_model', 'bbl_thick_v', & - diag%axesCv1, Time, 'BBL thickness at v points', 'm', conversion=GV%Z_to_m) + diag%axesCv1, Time, 'BBL thickness at v points', 'm', conversion=US%Z_to_m) CS%id_kv_bbl_v = register_diag_field('ocean_model', 'kv_bbl_v', diag%axesCv1, & - Time, 'BBL viscosity at v points', 'm2 s-1', conversion=GV%Z_to_m**2) + Time, 'BBL viscosity at v points', 'm2 s-1', conversion=US%Z_to_m**2) endif if (CS%Channel_drag) then allocate(visc%Ray_u(IsdB:IedB,jsd:jed,nz)) ; visc%Ray_u = 0.0 allocate(visc%Ray_v(isd:ied,JsdB:JedB,nz)) ; visc%Ray_v = 0.0 CS%id_Ray_u = register_diag_field('ocean_model', 'Rayleigh_u', diag%axesCuL, & - Time, 'Rayleigh drag velocity at u points', 'm s-1', conversion=GV%Z_to_m) + Time, 'Rayleigh drag velocity at u points', 'm s-1', conversion=US%Z_to_m) CS%id_Ray_v = register_diag_field('ocean_model', 'Rayleigh_v', diag%axesCvL, & - Time, 'Rayleigh drag velocity at v points', 'm s-1', conversion=GV%Z_to_m) + Time, 'Rayleigh drag velocity at v points', 'm s-1', conversion=US%Z_to_m) endif if (use_CVMix_ddiff .or. differential_diffusion) then diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index b9a16ebb46..254843ebe2 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -413,7 +413,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ call get_param(param_file, mdl, "KAPPA_ITIDES", CS%kappa_itides, & "A topographic wavenumber used with INT_TIDE_DISSIPATION. \n"//& "The default is 2pi/10 km, as in St.Laurent et al. 2002.", & - units="m-1", default=8.e-4*atan(1.0), scale=GV%Z_to_m) + units="m-1", default=8.e-4*atan(1.0), scale=US%Z_to_m) call get_param(param_file, mdl, "UTIDE", CS%utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & @@ -463,7 +463,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ utide = CS%tideamp(i,j) ! Compute the fixed part of internal tidal forcing; units are [kg s-2] here. - CS%TKE_itidal(i,j) = 0.5*GV%Z_to_m * CS%kappa_h2_factor*GV%Rho0*& + CS%TKE_itidal(i,j) = 0.5*US%Z_to_m * CS%kappa_h2_factor*GV%Rho0*& CS%kappa_itides * CS%h2(i,j) * utide*utide enddo ; enddo @@ -544,10 +544,10 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ call CVMix_init_tidal(CVmix_tidal_params_user = CS%CVMix_tidal_params, & mix_scheme = CVMix_tidal_scheme_str, & efficiency = CS%Mu_itides, & - vertical_decay_scale = CS%int_tide_decay_scale*GV%Z_to_m, & + vertical_decay_scale = CS%int_tide_decay_scale*US%Z_to_m, & max_coefficient = CS%tidal_max_coef, & local_mixing_frac = CS%Gamma_itides, & - depth_cutoff = CS%min_zbot_itides*GV%Z_to_m) + depth_cutoff = CS%min_zbot_itides*US%Z_to_m) call read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS) @@ -561,7 +561,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ CS%Lowmode_itidal_dissipation) then CS%id_Kd_itidal = register_diag_field('ocean_model','Kd_itides',diag%axesTi,Time, & - 'Internal Tide Driven Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2) + 'Internal Tide Driven Diffusivity', 'm2 s-1', conversion=US%Z_to_m**2) if (CS%use_CVMix_tidal) then CS%id_N2_int = register_diag_field('ocean_model','N2_int',diag%axesTi,Time, & @@ -583,7 +583,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ 'Bottom Buoyancy Frequency', 's-1') CS%id_Kd_lowmode = register_diag_field('ocean_model','Kd_lowmode',diag%axesTi,Time, & - 'Internal Tide Driven Diffusivity (from propagating low modes)', 'm2 s-1', conversion=GV%Z_to_m**2) + 'Internal Tide Driven Diffusivity (from propagating low modes)', 'm2 s-1', conversion=US%Z_to_m**2) CS%id_Fl_itidal = register_diag_field('ocean_model','Fl_itides',diag%axesTi,Time, & 'Vertical flux of tidal turbulent dissipation', 'm3 s-3') @@ -592,12 +592,12 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ 'Vertical flux of tidal turbulent dissipation (from propagating low modes)', 'm3 s-3') CS%id_Polzin_decay_scale = register_diag_field('ocean_model','Polzin_decay_scale',diag%axesT1,Time, & - 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', 'm', conversion=GV%Z_to_m) + 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', 'm', conversion=US%Z_to_m) CS%id_Polzin_decay_scale_scaled = register_diag_field('ocean_model', & 'Polzin_decay_scale_scaled', diag%axesT1, Time, & 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme, '// & - 'scaled by N2_bot/N2_meanz', 'm', conversion=GV%Z_to_m) + 'scaled by N2_bot/N2_meanz', 'm', conversion=US%Z_to_m) CS%id_N2_bot = register_diag_field('ocean_model','N2_b',diag%axesT1,Time, & 'Bottom Buoyancy frequency squared', 's-2') @@ -618,24 +618,24 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ CS%id_TKE_leewave = register_diag_field('ocean_model','TKE_leewave',diag%axesT1,Time, & 'Lee wave Driven Turbulent Kinetic Energy', 'W m-2') CS%id_Kd_Niku = register_diag_field('ocean_model','Kd_Nikurashin',diag%axesTi,Time, & - 'Lee Wave Driven Diffusivity', 'm2 s-1', conversion=GV%Z_to_m**2) + 'Lee Wave Driven Diffusivity', 'm2 s-1', conversion=US%Z_to_m**2) endif endif ! S%use_CVMix_tidal if (associated(CS%diag_to_Z_CSp)) then vd = var_desc("Kd_itides","m2 s-1", & "Internal Tide Driven Diffusivity, interpolated to z", z_grid='z') - CS%id_Kd_itidal_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) + CS%id_Kd_itidal_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=US%Z_to_m**2) if (CS%Lee_wave_dissipation) then vd = var_desc("Kd_Nikurashin", "m2 s-1", & "Lee Wave Driven Diffusivity, interpolated to z", z_grid='z') - CS%id_Kd_Niku_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) + CS%id_Kd_Niku_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=US%Z_to_m**2) endif if (CS%Lowmode_itidal_dissipation) then vd = var_desc("Kd_lowmode","m2 s-1", & "Internal Tide Driven Diffusivity (from low modes), interpolated to z",& z_grid='z') - CS%id_Kd_lowmode_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=GV%Z_to_m**2) + CS%id_Kd_lowmode_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time, conversion=US%Z_to_m**2) endif endif diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 450e054cf6..aa0b40ba17 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -138,10 +138,11 @@ module MOM_vert_friction !! There is an additional stress term on the right-hand side !! if DIRECT_STRESS is true, applied to the surface layer. -subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & +subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & taux_bot, tauy_bot, Waves) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: u !< Zonal velocity in m s-1 real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & @@ -418,7 +419,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & enddo ! end of v-component J loop - call vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, CS) + call vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS) ! Here the velocities associated with open boundary conditions are applied. if (associated(OBC)) then @@ -1010,7 +1011,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) call uvchksum("vertvisc_coef h_[uv]", CS%h_u, & CS%h_v, G%HI,haloshift=0, scale=GV%H_to_m) call uvchksum("vertvisc_coef a_[uv]", CS%a_u, & - CS%a_v, G%HI, haloshift=0, scale=GV%Z_to_m) + CS%a_v, G%HI, haloshift=0, scale=US%Z_to_m) if (allocated(hML_u) .and. allocated(hML_v)) & call uvchksum("vertvisc_coef hML_[uv]", hML_u, hML_v, & G%HI, haloshift=0, scale=GV%H_to_m) @@ -1107,7 +1108,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! The maximum coupling coefficent was originally introduced to avoid ! truncation error problems in the tridiagonal solver. Effectively, the 1e-10 ! sets the maximum coupling coefficient increment to 1e10 m per timestep. - I_amax = (1.0e-10*GV%Z_to_m) * dt + I_amax = (1.0e-10*US%Z_to_m) * dt do_shelf = .false. ; if (present(shelf)) do_shelf = shelf do_OBCs = .false. @@ -1351,9 +1352,10 @@ end subroutine find_coupling_coef !> Velocity components which exceed a threshold for physically !! reasonable values are truncated. Optionally, any column with excessive !! velocities may be sent to a diagnostic reporting subroutine. -subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, CS) +subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: u !< Zonal velocity in m s-1 real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & @@ -1467,7 +1469,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, CS) do j=js,je; do I=Isq,Ieq ; if (dowrite(I,j)) then ! Here the diagnostic reporting subroutines are called if ! unphysically large values were found. - call write_u_accel(I, j, u_old, h, ADp, CDp, dt, G, GV, CS%PointAccel_CSp, & + call write_u_accel(I, j, u_old, h, ADp, CDp, dt, G, GV, US, CS%PointAccel_CSp, & vel_report(I,j), forces%taux(I,j)*dt_Rho0, a=CS%a_u, hv=CS%h_u) endif ; enddo ; enddo endif @@ -1552,7 +1554,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, CS) do J=Jsq,Jeq; do i=is,ie ; if (dowrite(i,J)) then ! Here the diagnostic reporting subroutines are called if ! unphysically large values were found. - call write_v_accel(i, J, v_old, h, ADp, CDp, dt, G, GV, CS%PointAccel_CSp, & + call write_v_accel(i, J, v_old, h, ADp, CDp, dt, G, GV, US, CS%PointAccel_CSp, & vel_report(i,J), forces%tauy(i,J)*dt_Rho0, a=CS%a_v, hv=CS%h_v) endif ; enddo ; enddo endif @@ -1738,19 +1740,19 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & ALLOC_(CS%h_v(isd:ied,JsdB:JedB,nz)) ; CS%h_v(:,:,:) = 0.0 CS%id_Kv_slow = register_diag_field('ocean_model', 'Kv_slow', diag%axesTi, Time, & - 'Slow varying vertical viscosity', 'm2 s-1', conversion=GV%Z_to_m**2) + 'Slow varying vertical viscosity', 'm2 s-1', conversion=US%Z_to_m**2) CS%id_Kv_u = register_diag_field('ocean_model', 'Kv_u', diag%axesCuL, Time, & - 'Total vertical viscosity at u-points', 'm2 s-1', conversion=GV%Z_to_m**2) + 'Total vertical viscosity at u-points', 'm2 s-1', conversion=US%Z_to_m**2) CS%id_Kv_v = register_diag_field('ocean_model', 'Kv_v', diag%axesCvL, Time, & - 'Total vertical viscosity at v-points', 'm2 s-1', conversion=GV%Z_to_m**2) + 'Total vertical viscosity at v-points', 'm2 s-1', conversion=US%Z_to_m**2) CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, & - 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=GV%Z_to_m) + 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m) CS%id_av_vv = register_diag_field('ocean_model', 'av_visc', diag%axesCvi, Time, & - 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1', conversion=GV%Z_to_m) + 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m) CS%id_h_u = register_diag_field('ocean_model', 'Hu_visc', diag%axesCuL, Time, & 'Thickness at Zonal Velocity Points for Viscosity', thickness_units) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index f4bd8ed8a3..4b3300ccd3 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -796,7 +796,7 @@ subroutine Surface_Bands_by_data_override(day_center, G, GV, US, CS) " in file "// trim(SurfBandFileName)//" in MOM_wave_interface") endif NUMBANDS = ID - do B = 1,NumBands ; CS%WaveNum_Cen(b) = GV%Z_to_m*CS%WaveNum_Cen(b) ; enddo + do B = 1,NumBands ; CS%WaveNum_Cen(b) = US%Z_to_m*CS%WaveNum_Cen(b) ; enddo elseif (PartitionMode==1) then rcode_fr = NF90_GET_VAR(ncid, dim_id(1), CS%Freq_Cen, start, counter) if (rcode_fr /= 0) then @@ -1032,7 +1032,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) ! is also included kstar = kphil * 2.56 ! surface layer - z0 = abs(GV%Z_to_m*hbl) + z0 = abs(US%Z_to_m*hbl) z0i = 1.0 / z0 ! term 1 to 4 r1 = ( 0.151 / kphil * z0i -0.84 ) * & diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index dd6fa2d2e7..4970ddb91a 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -93,10 +93,10 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read_par 'Layer 2 surface temperature', units='C', default=20.0, do_not_log=just_read) call get_param(param_file, mdl, "SCM_L2_DTDZ", LowerLayerdTdZ, & 'Initial temperature stratification in layer 2', & - units='C/m', default=0.0, scale=GV%Z_to_m, do_not_log=just_read) + units='C/m', default=0.0, scale=US%Z_to_m, do_not_log=just_read) call get_param(param_file, mdl, "SCM_L2_DSDZ", LowerLayerdSdZ, & 'Initial salinity stratification in layer 2', & - units='PPT/m', default=0.0, scale=GV%Z_to_m, do_not_log=just_read) + units='PPT/m', default=0.0, scale=US%Z_to_m, do_not_log=just_read) call get_param(param_file, mdl, "SCM_L2_MINTEMP",LowerLayerMinTemp, & 'Layer 2 minimum temperature', units='C', default=4.0, do_not_log=just_read) diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index bdcd84aeee..27d70283dc 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -6,6 +6,7 @@ module baroclinic_zone_initialization use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_file_parser, only : openParameterBlock, closeParameterBlock use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -21,10 +22,11 @@ module baroclinic_zone_initialization contains !> Reads the parameters unique to this module -subroutine bcz_params(G, GV, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, & +subroutine bcz_params(G, GV, US, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, & delta_T, dTdx, L_zone, just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handle real, intent(out) :: S_ref !< Reference salinity (ppt) real, intent(out) :: dSdz !< Salinity stratification (ppt/Z) @@ -48,7 +50,7 @@ subroutine bcz_params(G, GV, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', units='ppt', & default=35., do_not_log=just_read) call get_param(param_file, mdl, "DSDZ", dSdz, 'Salinity stratification', & - units='ppt/m', default=0.0, scale=GV%Z_to_m, do_not_log=just_read) + units='ppt/m', default=0.0, scale=US%Z_to_m, do_not_log=just_read) call get_param(param_file, mdl,"DELTA_S",delta_S,'Salinity difference across baroclinic zone', & units='ppt', default=0.0, do_not_log=just_read) call get_param(param_file, mdl,"DSDX",dSdx,'Meridional salinity difference', & @@ -56,7 +58,7 @@ subroutine bcz_params(G, GV, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature',units='C', & default=10., do_not_log=just_read) call get_param(param_file, mdl, "DTDZ", dTdz, 'Temperature stratification', & - units='C/m', default=0.0, scale=GV%Z_to_m, do_not_log=just_read) + units='C/m', default=0.0, scale=US%Z_to_m, do_not_log=just_read) call get_param(param_file, mdl,"DELTA_T",delta_T,'Temperature difference across baroclinic zone', & units='C', default=0.0, do_not_log=just_read) call get_param(param_file, mdl,"DTDX",dTdx,'Meridional temperature difference', & @@ -68,10 +70,11 @@ subroutine bcz_params(G, GV, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz end subroutine bcz_params !> Initialization of temperature and salinity with the baroclinic zone initial conditions -subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, param_file, & +subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, US, param_file, & just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature [deg C] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< The model thicknesses in H (m or kg m-2) @@ -91,7 +94,7 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, param_file, is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call bcz_params(G, GV, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, delta_T, dTdx, L_zone, just_read_params) + call bcz_params(G, GV, US, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, delta_T, dTdx, L_zone, just_read_params) if (just_read) return ! All run-time parameters have been read, so return. diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 95a8f073bf..ce8fcdef39 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -137,7 +137,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, US, param_file, just_read_p e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * & ( (real(K)-1.5) / real(nz-1) ) ) / S_range ! Force round numbers ... the above expression has irrational factors ... - e0(K) = nint(2048.*GV%Z_to_m*e0(K)) / (2048.*GV%Z_to_m) + e0(K) = nint(2048.*US%Z_to_m*e0(K)) / (2048.*US%Z_to_m) e0(K) = min(real(1-K)*GV%Angstrom_Z, e0(K)) ! Bound by surface e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom enddo diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 21f7b30788..42ea66d0ad 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -138,7 +138,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, US, param_file, just_read_p e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * & ( (real(K)-1.5) / real(nz-1) ) ) / S_range ! Force round numbers ... the above expression has irrational factors ... - e0(K) = nint(2048.*GV%Z_to_m*e0(K))/(2048.*GV%Z_to_m) + e0(K) = nint(2048.*US%Z_to_m*e0(K))/(2048.*US%Z_to_m) e0(K) = min(real(1-K)*GV%Angstrom_Z, e0(K)) ! Bound by surface e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom enddo From 04069b74baaac0a6ae9dceeee227062c5dd31e1a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 6 Nov 2018 10:14:43 -0500 Subject: [PATCH 0886/1072] +Pass unit_scale_type argument to step_MOM_thermo Pass a new unit_scale_type argument to step_MOM_thermo. Elsewhere in MOM.F90, a local pointer, US, is set to CS%US for convenience. All answers are bitwise identical. --- src/core/MOM.F90 | 116 +++++++++++++++++++++++++---------------------- 1 file changed, 62 insertions(+), 54 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 5e636194df..60ed293ece 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -424,11 +424,12 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & !! thermodynamic quantities should be reset. !! If missing, this is like start_cycle. - ! local - type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing - ! metrics and related information - type(verticalGrid_type), pointer :: GV => NULL() - + ! local variables + type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing + ! metrics and related information + type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to the vertical grid structure + type(unit_scale_type), pointer :: US => NULL() ! Pointer to a structure containing + ! various unit conversion factors integer :: ntstep ! time steps between tracer updates or diabatic forcing integer :: n_max ! number of steps to take in this call @@ -476,7 +477,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & type(group_pass_type) :: pass_tau_ustar_psurf logical :: showCallTree - G => CS%G ; GV => CS%GV + G => CS%G ; GV => CS%GV ; US => CS%US is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -567,7 +568,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (associated(CS%VarMix)) then call enable_averaging(cycle_time, Time_start + real_to_time(cycle_time), & CS%diag) - call calc_resoln_function(h, CS%tv, G, GV, CS%US, CS%VarMix) + call calc_resoln_function(h, CS%tv, G, GV, US, CS%VarMix) call disable_averaging(CS%diag) endif endif @@ -592,12 +593,12 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (CS%UseWaves) then ! Update wave information, which is presently kept static over each call to step_mom call enable_averaging(time_interval, Time_start + real_to_time(time_interval), CS%diag) - call Update_Stokes_Drift(G, GV, CS%US, Waves, h, forces%ustar) + call Update_Stokes_Drift(G, GV, US, Waves, h, forces%ustar) call disable_averaging(CS%diag) endif else ! not do_dyn. if (CS%UseWaves) & ! Diagnostics are not enabled in this call. - call Update_Stokes_Drift(G, GV, CS%US, Waves, h, fluxes%ustar) + call Update_Stokes_Drift(G, GV, US, Waves, h, fluxes%ustar) endif if (CS%debug) then @@ -649,7 +650,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & endif ! Apply diabatic forcing, do mixing, and regrid. - call step_MOM_thermo(CS, G, GV, u, v, h, CS%tv, fluxes, dtdia, & + call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & end_time_thermo, .true., Waves=Waves) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia @@ -743,7 +744,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (dtdia > dt) CS%Time = CS%Time - real_to_time(0.5*(dtdia-dt)) ! Apply diabatic forcing, do mixing, and regrid. - call step_MOM_thermo(CS, G, GV, u, v, h, CS%tv, fluxes, dtdia, & + call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & Time_local, .false., Waves=Waves) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia CS%t_dyn_rel_thermo = 0.0 @@ -757,7 +758,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ! Determining the time-average sea surface height is part of the algorithm. ! This may be eta_av if Boussinesq, or need to be diagnosed if not. CS%time_in_cycle = CS%time_in_cycle + dt - call find_eta(h, CS%tv, G, GV, CS%US, ssh, CS%eta_av_bc, eta_to_m=1.0) + call find_eta(h, CS%tv, G, GV, US, ssh, CS%eta_av_bc, eta_to_m=1.0) do j=js,je ; do i=is,ie CS%ssh_rint(i,j) = CS%ssh_rint(i,j) + dt*ssh(i,j) enddo ; enddo @@ -775,7 +776,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & call enable_averaging(CS%t_dyn_rel_diag, Time_local, CS%diag) call calculate_diagnostic_fields(u, v, h, CS%uh, CS%vh, CS%tv, CS%ADp, & CS%CDp, p_surf, CS%t_dyn_rel_diag, CS%diag_pre_sync,& - G, GV, CS%US, CS%diagnostics_CSp) + G, GV, US, CS%diagnostics_CSp) call post_tracer_diagnostics(CS%Tracer_reg, h, CS%diag_pre_sync, CS%diag, G, GV, CS%t_dyn_rel_diag) call diag_copy_diag_to_storage(CS%diag_pre_sync, h, CS%diag) if (showCallTree) call callTree_waypoint("finished calculate_diagnostic_fields (step_MOM)") @@ -788,7 +789,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & CS%Z_diag_time, CS%diag) !### This is the one place where fluxes might used if do_thermo=.false. Is this correct? call calculate_Z_diag_fields(u, v, h, ssh, fluxes%frac_shelf_h, & - G, GV, CS%US, CS%diag_to_Z_CSp) + G, GV, US, CS%diag_to_Z_CSp) CS%Z_diag_time = CS%Z_diag_time + CS%Z_diag_interval call disable_averaging(CS%diag) if (showCallTree) call callTree_waypoint("finished calculate_Z_diag_fields (step_MOM)") @@ -813,10 +814,10 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & CS%ave_ssh_ibc(i,j) = ssh(i,j) enddo ; enddo if (do_dyn) then - call adjust_ssh_for_p_atm(CS%tv, G, GV, CS%US, CS%ave_ssh_ibc, forces%p_surf_SSH, & + call adjust_ssh_for_p_atm(CS%tv, G, GV, US, CS%ave_ssh_ibc, forces%p_surf_SSH, & CS%calc_rho_for_sea_lev) elseif (do_thermo) then - call adjust_ssh_for_p_atm(CS%tv, G, GV, CS%US, CS%ave_ssh_ibc, fluxes%p_surf_SSH, & + call adjust_ssh_for_p_atm(CS%tv, G, GV, US, CS%ave_ssh_ibc, fluxes%p_surf_SSH, & CS%calc_rho_for_sea_lev) endif endif @@ -846,7 +847,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & endif if (CS%time_in_thermo_cycle > 0.0) then call enable_averaging(CS%time_in_thermo_cycle, Time_local, CS%diag) - call post_surface_thermo_diags(CS%sfc_IDs, G, GV, CS%US, CS%diag, CS%time_in_thermo_cycle, & + call post_surface_thermo_diags(CS%sfc_IDs, G, GV, US, CS%diag, CS%time_in_thermo_cycle, & sfc_state, CS%tv, ssh, CS%ave_ssh_ibc) endif call disable_averaging(CS%diag) @@ -860,7 +861,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (MOM_state_is_synchronized(CS)) & call write_energy(CS%u, CS%v, CS%h, CS%tv, Time_local, CS%nstep_tot, & - G, GV, CS%US, CS%sum_output_CSp, CS%tracer_flow_CSp, & + G, GV, US, CS%sum_output_CSp, CS%tracer_flow_CSp, & dt_forcing=real_to_time(time_interval) ) call cpu_clock_end(id_clock_other) @@ -892,10 +893,12 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & optional, pointer :: Waves !< Container for wave related parameters; the !! fields in Waves are intent in here. - ! local - type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing - ! metrics and related information - type(verticalGrid_type), pointer :: GV => NULL() + ! local variables + type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing + ! metrics and related information + type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to the vertical grid structure + type(unit_scale_type), pointer :: US => NULL() ! Pointer to a structure containing + ! various unit conversion factors type(MOM_diag_IDs), pointer :: IDs => NULL() ! A structure with the diagnostic IDs. real, dimension(:,:,:), pointer :: & u => NULL(), & ! u : zonal velocity component (m/s) @@ -909,7 +912,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - G => CS%G ; GV => CS%GV ; IDs => CS%IDs + G => CS%G ; GV => CS%GV ; US => CS%US ; IDs => CS%IDs is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -924,8 +927,8 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call enable_averaging(dt_thermo, Time_local+real_to_time(dt_thermo-dt), CS%diag) call cpu_clock_begin(id_clock_thick_diff) if (associated(CS%VarMix)) & - call calc_slope_functions(h, CS%tv, dt, G, GV, CS%US, CS%VarMix) - call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt_thermo, G, GV, CS%US, & + call calc_slope_functions(h, CS%tv, dt, G, GV, US, CS%VarMix) + call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt_thermo, G, GV, US, & CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) call cpu_clock_end(id_clock_thick_diff) call pass_var(h, G%Domain, clock=id_clock_pass) !###, halo=max(2,cont_stensil)) @@ -943,7 +946,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & Time_local + real_to_time(bbl_time_int-dt), CS%diag) ! Calculate the BBL properties and store them inside visc (u,h). call cpu_clock_begin(id_clock_BBL_visc) - call set_viscous_BBL(CS%u, CS%v, CS%h, CS%tv, CS%visc, G, GV, CS%US, & + call set_viscous_BBL(CS%u, CS%v, CS%h, CS%tv, CS%visc, G, GV, US, & CS%set_visc_CSp, symmetrize=.true.) call cpu_clock_end(id_clock_BBL_visc) if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM)") @@ -965,7 +968,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call step_MOM_dyn_split_RK2(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, & - CS%eta_av_bc, G, GV, CS%US, CS%dyn_split_RK2_CSp, calc_dtbt, CS%VarMix, CS%MEKE,& + CS%eta_av_bc, G, GV, US, CS%dyn_split_RK2_CSp, calc_dtbt, CS%VarMix, CS%MEKE,& waves=waves) if (showCallTree) call callTree_waypoint("finished step_MOM_dyn_split (step_MOM)") @@ -980,11 +983,11 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if (CS%use_RK2) then call step_MOM_dyn_unsplit_RK2(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, & - CS%eta_av_bc, G, GV, CS%US, CS%dyn_unsplit_RK2_CSp, CS%VarMix, CS%MEKE) + CS%eta_av_bc, G, GV, US, CS%dyn_unsplit_RK2_CSp, CS%VarMix, CS%MEKE) else call step_MOM_dyn_unsplit(u, v, h, CS%tv, CS%visc, Time_local, dt, forces, & p_surf_begin, p_surf_end, CS%uh, CS%vh, CS%uhtr, CS%vhtr, & - CS%eta_av_bc, G, GV, CS%US, CS%dyn_unsplit_CSp, CS%VarMix, CS%MEKE, Waves=Waves) + CS%eta_av_bc, G, GV, US, CS%dyn_unsplit_CSp, CS%VarMix, CS%MEKE, Waves=Waves) endif if (showCallTree) call callTree_waypoint("finished step_MOM_dyn_unsplit (step_MOM)") @@ -996,8 +999,8 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if (CS%debug) call hchksum(h,"Pre-thickness_diffuse h", G%HI, haloshift=0, scale=GV%H_to_m) if (associated(CS%VarMix)) & - call calc_slope_functions(h, CS%tv, dt, G, GV, CS%US, CS%VarMix) - call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt, G, GV, CS%US, & + call calc_slope_functions(h, CS%tv, dt, G, GV, US, CS%VarMix) + call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt, G, GV, US, & CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) if (CS%debug) call hchksum(h,"Post-thickness_diffuse h", G%HI, haloshift=1, scale=GV%H_to_m) @@ -1015,7 +1018,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & endif call cpu_clock_begin(id_clock_ml_restrat) call mixedlayer_restrat(h, CS%uhtr, CS%vhtr, CS%tv, forces, dt, CS%visc%MLD, & - CS%VarMix, G, GV, CS%US, CS%mixedlayer_restrat_CSp) + CS%VarMix, G, GV, US, CS%mixedlayer_restrat_CSp) call cpu_clock_end(id_clock_ml_restrat) call pass_var(h, G%Domain, clock=id_clock_pass) !###, halo=max(2,cont_stensil)) if (CS%debug) then @@ -1030,7 +1033,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call diag_update_remap_grids(CS%diag) if (CS%useMEKE) call step_forward_MEKE(CS%MEKE, h, CS%VarMix%SN_u, CS%VarMix%SN_v, & - CS%visc, dt, G, GV, CS%US, CS%MEKE_CSp, CS%uhtr, CS%vhtr) + CS%visc, dt, G, GV, US, CS%MEKE_CSp, CS%uhtr, CS%vhtr) call disable_averaging(CS%diag) ! Advance the dynamics time by dt. @@ -1122,11 +1125,12 @@ end subroutine step_MOM_tracer_dyn !> MOM_step_thermo orchestrates the thermodynamic time stepping and vertical !! remapping, via calls to diabatic (or adiabatic) and ALE_main. -subroutine step_MOM_thermo(CS, G, GV, u, v, h, tv, fluxes, dtdia, & +subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & Time_end_thermo, update_BBL, Waves) type(MOM_control_struct), intent(inout) :: CS !< Master MOM control structure type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(inout) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(inout) :: u !< zonal velocity (m/s) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -1166,7 +1170,7 @@ subroutine step_MOM_thermo(CS, G, GV, u, v, h, tv, fluxes, dtdia, & ! DIABATIC_FIRST=True. Otherwise diabatic() is called after the dynamics ! and set_viscous_BBL is called as a part of the dynamic stepping. call cpu_clock_begin(id_clock_BBL_visc) - call set_viscous_BBL(u, v, h, tv, CS%visc, G, GV, CS%US, CS%set_visc_CSp, symmetrize=.true.) + call set_viscous_BBL(u, v, h, tv, CS%visc, G, GV, US, CS%set_visc_CSp, symmetrize=.true.) call cpu_clock_end(id_clock_BBL_visc) if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM_thermo)") endif @@ -1188,10 +1192,10 @@ subroutine step_MOM_thermo(CS, G, GV, u, v, h, tv, fluxes, dtdia, & if (CS%use_legacy_diabatic_driver) then ! the following subroutine is legacy and will be deleted in the near future. call legacy_diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, & - dtdia, Time_end_thermo, G, GV, CS%US, CS%diabatic_CSp, Waves=Waves) + dtdia, Time_end_thermo, G, GV, US, CS%diabatic_CSp, Waves=Waves) else call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, & - dtdia, Time_end_thermo, G, GV, CS%US, CS%diabatic_CSp, Waves=Waves) + dtdia, Time_end_thermo, G, GV, US, CS%diabatic_CSp, Waves=Waves) endif fluxes%fluxes_used = .true. call cpu_clock_end(id_clock_diabatic) @@ -1221,10 +1225,10 @@ subroutine step_MOM_thermo(CS, G, GV, u, v, h, tv, fluxes, dtdia, & endif call cpu_clock_begin(id_clock_ALE) if (use_ice_shelf) then - call ALE_main(G, GV, CS%US, h, u, v, tv, CS%tracer_Reg, CS%ALE_CSp, dtdia, & + call ALE_main(G, GV, US, h, u, v, tv, CS%tracer_Reg, CS%ALE_CSp, dtdia, & fluxes%frac_shelf_h) else - call ALE_main(G, GV, CS%US, h, u, v, tv, CS%tracer_Reg, CS%ALE_CSp, dtdia) + call ALE_main(G, GV, US, h, u, v, tv, CS%tracer_Reg, CS%ALE_CSp, dtdia) endif if (showCallTree) call callTree_waypoint("finished ALE_main (step_MOM_thermo)") @@ -1316,6 +1320,8 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS ! metrics and related information type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to structure containing information ! about the vertical grid + type(unit_scale_type), pointer :: US => NULL() ! Pointer to a structure containing + ! various unit conversion factors logical :: first_iter !< True if this is the first time step_offline has been called in a given interval logical :: last_iter !< True if this is the last time step_tracer is to be called in an offline interval @@ -1341,8 +1347,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS type(time_type) :: Time_end ! End time of a segment, as a time type ! Grid-related pointer assignments - G => CS%G - GV => CS%GV + G => CS%G ; GV => CS%GV ; US => CS%US is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -1400,8 +1405,8 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS if (.not. skip_diffusion) then if (associated(CS%VarMix)) then call pass_var(CS%h, G%Domain) - call calc_resoln_function(CS%h, CS%tv, G, GV, CS%US, CS%VarMix) - call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, CS%US, CS%VarMix) + call calc_resoln_function(CS%h, CS%tv, G, GV, US, CS%VarMix) + call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, US, CS%VarMix) endif call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) @@ -1425,8 +1430,8 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS if (.not. skip_diffusion) then if (associated(CS%VarMix)) then call pass_var(CS%h, G%Domain) - call calc_resoln_function(CS%h, CS%tv, G, GV, CS%US, CS%VarMix) - call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, CS%US, CS%VarMix) + call calc_resoln_function(CS%h, CS%tv, G, GV, US, CS%VarMix) + call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, US, CS%VarMix) endif call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) @@ -1475,7 +1480,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS endif - call adjust_ssh_for_p_atm(CS%tv, G, GV, CS%US, CS%ave_ssh_ibc, forces%p_surf_SSH, & + call adjust_ssh_for_p_atm(CS%tv, G, GV, US, CS%ave_ssh_ibc, forces%p_surf_SSH, & CS%calc_rho_for_sea_lev) call extract_surface_state(CS, sfc_state) @@ -2470,7 +2475,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & !### This could perhaps go here instead of in finish_MOM_initialization? ! call fix_restart_scaling(GV) - ! call fix_restart_unit_scaling(CS%US) + ! call fix_restart_unit_scaling(US) call callTree_leave("initialize_MOM()") call cpu_clock_end(id_clock_init) @@ -2485,9 +2490,12 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) type(MOM_restart_CS), pointer :: restart_CSp !< pointer to the restart control !! structure that will be used for MOM. ! Local variables - type(ocean_grid_type), pointer :: G => NULL() - type(verticalGrid_type), pointer :: GV => NULL() - type(MOM_restart_CS), pointer :: restart_CSp_tmp => NULL() + type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing + ! metrics and related information + type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to the vertical grid structure + type(unit_scale_type), pointer :: US => NULL() ! Pointer to a structure containing + ! various unit conversion factors + type(MOM_restart_CS), pointer :: restart_CSp_tmp => NULL() real, allocatable :: z_interface(:,:,:) ! Interface heights (meter) type(vardesc) :: vd @@ -2495,18 +2503,18 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) call callTree_enter("finish_MOM_initialization()") ! Pointers for convenience - G => CS%G ; GV => CS%GV + G => CS%G ; GV => CS%GV ; US => CS%US !### Move to initialize_MOM? call fix_restart_scaling(GV) - call fix_restart_unit_scaling(CS%US) + call fix_restart_unit_scaling(US) ! Write initial conditions if (CS%write_IC) then allocate(restart_CSp_tmp) restart_CSp_tmp = restart_CSp allocate(z_interface(SZI_(G),SZJ_(G),SZK_(G)+1)) - call find_eta(CS%h, CS%tv, G, GV, CS%US, z_interface, eta_to_m=1.0) + call find_eta(CS%h, CS%tv, G, GV, US, z_interface, eta_to_m=1.0) call register_restart_field(z_interface, "eta", .true., restart_CSp_tmp, & "Interface heights", "meter", z_grid='i') @@ -2516,7 +2524,7 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) deallocate(restart_CSp_tmp) endif - call write_energy(CS%u, CS%v, CS%h, CS%tv, Time, 0, G, GV, CS%US, & + call write_energy(CS%u, CS%v, CS%h, CS%tv, Time, 0, G, GV, US, & CS%sum_output_CSp, CS%tracer_flow_CSp) call callTree_leave("finish_MOM_initialization()") From fa04b52edf24e16262da61fd1b28937fde309130 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 6 Nov 2018 10:16:15 -0500 Subject: [PATCH 0887/1072] Corrected openMP directives Corrected a number of openMP directives that were not properly updated when unit_scale_type variables were introduced. All answers are bitwise identical, and the code once again compiles with openMP enabled. --- src/core/MOM_barotropic.F90 | 14 +-- src/core/MOM_forcing_type.F90 | 8 +- src/diagnostics/MOM_wave_speed.F90 | 14 +-- src/parameterizations/lateral/MOM_MEKE.F90 | 87 +++++++------------ .../lateral/MOM_mixed_layer_restrat.F90 | 6 +- .../lateral/MOM_thickness_diffuse.F90 | 4 +- .../vertical/MOM_diabatic_aux.F90 | 35 ++++---- .../vertical/MOM_energetic_PBL.F90 | 2 +- .../vertical/MOM_entrain_diffusive.F90 | 32 +++---- .../vertical/MOM_kappa_shear.F90 | 4 +- .../vertical/MOM_set_diffusivity.F90 | 2 +- .../vertical/MOM_set_viscosity.F90 | 6 +- 12 files changed, 86 insertions(+), 128 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 68284b3282..5c6ec52fc7 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1251,7 +1251,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !$OMP Rayleigh_u, Rayleigh_v, & !$OMP use_BT_Cont,BTCL_u,uhbt0,BTCL_v,vhbt0,eta,Idt) & !$OMP private(u_max_cor,v_max_cor,eta_cor_max,Htot) -!$OMP do + !$OMP do do j=js-1,je+1 ; do I=is-1,ie ; av_rem_u(I,j) = 0.0 ; enddo ; enddo !$OMP do do J=js-1,je ; do i=is-1,ie+1 ; av_rem_v(i,J) = 0.0 ; enddo ; enddo @@ -1311,23 +1311,23 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! Zero out the arrays for various time-averaged quantities. if (find_etaav) then -!$OMP do + !$OMP do do j=jsvf-1,jevf+1 ; do i=isvf-1,ievf+1 eta_sum(i,j) = 0.0 ; eta_wtd(i,j) = 0.0 enddo ; enddo else -!$OMP do + !$OMP do do j=jsvf-1,jevf+1 ; do i=isvf-1,ievf+1 eta_wtd(i,j) = 0.0 enddo ; enddo endif -!$OMP do + !$OMP do do j=jsvf-1,jevf+1 ; do I=isvf-1,ievf ubt_sum(I,j) = 0.0 ; uhbt_sum(I,j) = 0.0 PFu_bt_sum(I,j) = 0.0 ; Coru_bt_sum(I,j) = 0.0 ubt_wtd(I,j) = 0.0 ; ubt_trans(I,j) = 0.0 enddo ; enddo -!$OMP do + !$OMP do do J=jsvf-1,jevf ; do i=isvf-1,ievf+1 vbt_sum(i,J) = 0.0 ; vhbt_sum(i,J) = 0.0 PFv_bt_sum(i,J) = 0.0 ; Corv_bt_sum(i,J) = 0.0 @@ -1335,7 +1335,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo ! Set the mass source, after first initializing the halos to 0. -!$OMP do + !$OMP do do j=jsvf-1,jevf+1; do i=isvf-1,ievf+1 ; eta_src(i,j) = 0.0 ; enddo ; enddo if (CS%bound_BT_corr) then ; if (use_BT_Cont .and. CS%BT_cont_bounds) then do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then @@ -1364,7 +1364,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (abs(CS%eta_cor(i,j)) > dt*CS%eta_cor_bound(i,j)) & CS%eta_cor(i,j) = sign(dt*CS%eta_cor_bound(i,j),CS%eta_cor(i,j)) enddo ; enddo ; endif ; endif -!$OMP do + !$OMP do do j=js,je ; do i=is,ie eta_src(i,j) = G%mask2dT(i,j) * (Instep * CS%eta_cor(i,j)) enddo ; enddo diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 843e6cb844..077e983245 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -931,15 +931,13 @@ subroutine calculateBuoyancyFlux2d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, netT(G%isc:G%iec) = 0. ; netS(G%isc:G%iec) = 0. -!$OMP parallel do default(none) shared(G,GV,fluxes,optics,h,Temp,Salt,tv,buoyancyFlux,& -!$OMP netHeatMinusSW,netSalt,skip_diags) & -!$OMP firstprivate(netT,netS) - do j = G%jsc, G%jec + !$OMP parallel do default(shared) firstprivate(netT,netS) + do j=G%jsc,G%jec call calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, j, buoyancyFlux(:,j,:), & netT, netS, skip_diags=skip_diags) if (present(netHeatMinusSW)) netHeatMinusSW(G%isc:G%iec,j) = netT(G%isc:G%iec) if (present(netSalt)) netSalt(G%isc:G%iec,j) = netS(G%isc:G%iec) - enddo ! j + enddo end subroutine calculateBuoyancyFlux2d diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 9910ea576b..1daed1a999 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -609,18 +609,8 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) H_to_m = GV%H_to_m min_h_frac = tol1 / real(nz) -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h,G,GV,min_h_frac,use_EOS,T,S, & -!$OMP H_to_pres,H_to_m,tv,cn,g_Rho0,nmodes) & -!$OMP private(htot,hmin,kf,H_here,HxT_here,HxS_here,HxR_here, & -!$OMP Hf,Tf,Sf,Rf,pres,T_int,S_int,drho_dT, & -!$OMP drho_dS,drxh_sum,kc,Hc,Tc,Sc,I_Hnew,gprime, & -!$OMP Rc,speed2_tot,Igl,Igu,dlam, & -!$OMP det,ddet,ig,jg,z_int,N2,row,nrows,lam_1, & -!$OMP lamMin,speed2_min,lamMax,lamInc,numint,det_l, & -!$OMP ddet_l,xr,xl,det_r,xbl,xbr,ddet_r,xl_sub, & -!$OMP ig_need_sub,jg_need_sub,sub_rootfound,nsub, & -!$OMP det_sub,ddet_sub,lam_n, & -!$OMP a_diag,b_diag,c_diag,nrootsfound) + !$OMP parallel do default(private) shared(is,ie,js,je,nz,h,G,GV,US,min_h_frac,use_EOS,T,S, & + !$OMP H_to_pres,H_to_m,tv,cn,g_Rho0,nmodes) do j=js,je ! First merge very thin layers with the one above (or below if they are ! at the top). This also transposes the row order so that columns can diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 69e63ae323..25e61b3cf3 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -198,14 +198,8 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo endif -!$OMP parallel default(none) shared(MEKE,CS,is,ie,js,je,nz,src,mass,G,GV,h,I_mass, & -!$OMP sdt,drag_vel_u,visc,drag_vel_v,drag_rate_visc, & -!$OMP drag_rate,Rho0,MEKE_decay,sdt_damp,cdrag2, & -!$OMP bottomFac2) & -!$OMP private(ldamping) - if (CS%MEKE_Cd_scale == 0.0 .and. .not. CS%visc_drag) then -!$OMP do + !$OMP parallel do default(shared) private(ldamping) do j=js,je ; do i=is,ie drag_rate(i,j) = 0. enddo ; enddo @@ -213,20 +207,20 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Calculate drag_rate_visc(i,j) which accounts for the model bottom mean flow if (CS%visc_drag) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie drag_vel_u(I,j) = 0.0 if ((G%mask2dCu(I,j) > 0.0) .and. (visc%bbl_thick_u(I,j) > 0.0)) & drag_vel_u(I,j) = US%Z_to_m*visc%kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) enddo ; enddo -!$OMP do + !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie drag_vel_v(i,J) = 0.0 if ((G%mask2dCv(i,J) > 0.0) .and. (visc%bbl_thick_v(i,J) > 0.0)) & drag_vel_v(i,J) = US%Z_to_m*visc%kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) enddo ; enddo -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie drag_rate_visc(i,j) = (0.25*G%IareaT(i,j) * & ((G%areaCu(I-1,j)*drag_vel_u(I-1,j) + & @@ -235,13 +229,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h G%areaCv(i,J)*drag_vel_v(i,J)) ) ) enddo ; enddo else -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie drag_rate_visc(i,j) = 0. enddo ; enddo endif -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 do i=is-1,ie+1 ; mass(i,j) = 0.0 ; enddo do k=1,nz ; do i=is-1,ie+1 @@ -252,7 +246,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (mass(i,j) > 0.0) I_mass(i,j) = 1.0 / mass(i,j) enddo enddo -!$OMP end parallel if (CS%initialize) then call MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_mass) @@ -270,41 +263,35 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h call hchksum(LmixScale, 'MEKE LmixScale',G%HI) endif -!$OMP parallel default(none) shared(MEKE,CS,is,ie,js,je,nz,src,mass,G,h,I_mass, & -!$OMP sdt,drag_vel_u,visc,drag_vel_v,drag_rate_visc, & -!$OMP drag_rate,Rho0,MEKE_decay,sdt_damp,cdrag2, & -!$OMP bottomFac2,barotrFac2,use_drag_rate) & -!$OMP private(ldamping) - ! Aggregate sources of MEKE (background, frictional and GM) -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie src(i,j) = CS%MEKE_BGsrc enddo ; enddo if (associated(MEKE%mom_src)) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie src(i,j) = src(i,j) - CS%MEKE_FrCoeff*I_mass(i,j)*MEKE%mom_src(i,j) enddo ; enddo endif if (associated(MEKE%GM_src)) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie src(i,j) = src(i,j) - CS%MEKE_GMcoeff*I_mass(i,j)*MEKE%GM_src(i,j) enddo ; enddo endif ! Increase EKE by a full time-steps worth of source -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie MEKE%MEKE(i,j) = (MEKE%MEKE(i,j) + sdt*src(i,j) )*G%mask2dT(i,j) enddo ; enddo if (use_drag_rate) then ! Calculate a viscous drag rate (includes BBL contributions from mean flow and eddies) -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie drag_rate(i,j) = (Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 & + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) @@ -312,7 +299,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif ! First stage of Strang splitting -!$OMP do + !$OMP parallel do default(shared) private(ldamping) do j=js,je ; do i=is,ie ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j) if (MEKE%MEKE(i,j)<0.) ldamping = 0. @@ -321,7 +308,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping) MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) enddo ; enddo -!$OMP end parallel if (CS%MEKE_KH >= 0.0 .or. CS%KhMEKE_FAC > 0.0 .or. CS%MEKE_K4 >= 0.0) then ! Update halos for lateral or bi-harmonic diffusion @@ -332,8 +318,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%MEKE_K4 >= 0.0) then ! Calculate Laplacian of MEKE -!$OMP parallel default(none) shared(is,ie,js,je,MEKE_uflux,G,MEKE,MEKE_vflux,CS) -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * G%mask2dCu(I,j)) * & (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) @@ -341,7 +326,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & ! (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) enddo ; enddo -!$OMP do + !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * G%mask2dCv(i,J)) * & (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) @@ -349,23 +334,19 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & ! (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) enddo ; enddo -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie CS%del2MEKE(i,j) = G%IareaT(i,j) * & ((MEKE_uflux(I,j) - MEKE_uflux(I-1,j)) + (MEKE_vflux(i,J) - MEKE_vflux(i,J-1))) ! CS%del2MEKE(i,j) = (G%IareaT(i,j)*I_mass(i,j)) * & ! ((MEKE_uflux(I,j) - MEKE_uflux(I-1,j)) + (MEKE_vflux(i,J) - MEKE_vflux(i,J-1))) enddo ; enddo -!$OMP end parallel call cpu_clock_begin(CS%id_clock_pass) call do_group_pass(CS%pass_del2MEKE, G%Domain) call cpu_clock_end(CS%id_clock_pass) ! Bi-harmonic diffusion of MEKE -!$OMP parallel default(none) shared(is,ie,js,je,MEKE_uflux,G,CS,sdt,mass, & -!$OMP mass_neglect,MEKE_vflux,I_mass) & -!$OMP private(K4_here,Inv_Kh_max) -!$OMP do + !$OMP parallel do default(shared) private(K4_here,Inv_Kh_max) do j=js,je ; do I=is-1,ie K4_here = CS%MEKE_K4 ! Limit Kh to avoid CFL violations. @@ -377,7 +358,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & (CS%del2MEKE(i+1,j) - CS%del2MEKE(i,j)) enddo ; enddo -!$OMP do + !$OMP parallel do default(shared) private(K4_here,Inv_Kh_max) do J=js-1,je ; do i=is,ie K4_here = CS%MEKE_K4 Inv_Kh_max = 64.0*sdt * (((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & @@ -388,26 +369,19 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & (CS%del2MEKE(i,j+1) - CS%del2MEKE(i,j)) enddo ; enddo -!$OMP do + !$OMP parallel do default(shared) ! Store tendency of bi-harmonic in del2MEKE do j=js,je ; do i=is,ie CS%del2MEKE(i,j) = (sdt*(G%IareaT(i,j)*I_mass(i,j))) * & ((MEKE_uflux(I-1,j) - MEKE_uflux(I,j)) + & (MEKE_vflux(i,J-1) - MEKE_vflux(i,J))) enddo ; enddo -!$OMP end parallel endif ! -!$OMP parallel default(none) shared(is,ie,js,je,MEKE,CS,sdt,G,Kh_u,MEKE_uflux, & -!$OMP mass,mass_neglect,Kh_v,MEKE_vflux,I_mass, & -!$OMP sdt_damp,drag_rate,Rho0,drag_rate_visc, & -!$OMP cdrag2,bottomFac2,MEKE_decay,barotrFac2, & -!$OMP use_drag_rate,dt,baroHu,baroHv,GV) & -!$OMP private(Kh_here,Inv_Kh_max,ldamping,advFac) if (CS%MEKE_KH >= 0.0 .or. CS%KhMEKE_FAC > 0.0 .or. CS%MEKE_advection_factor >0.0) then ! Lateral diffusion of MEKE Kh_here = max(0.,CS%MEKE_Kh) -!$OMP do + !$OMP parallel do default(shared) firstprivate(Kh_here) private(Inv_Kh_max) do j=js,je ; do I=is-1,ie ! Limit Kh to avoid CFL violations. if (associated(MEKE%Kh)) & @@ -421,7 +395,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & (MEKE%MEKE(i,j) - MEKE%MEKE(i+1,j)) enddo ; enddo -!$OMP do + !$OMP parallel do default(shared) firstprivate(Kh_here) private(Inv_Kh_max) do J=js-1,je ; do i=is,ie if (associated(MEKE%Kh)) & Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i,j+1)) @@ -436,7 +410,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo if (CS%MEKE_advection_factor>0.) then advFac = GV%H_to_m * CS%MEKE_advection_factor / dt -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie if (baroHu(I,j)>0.) then MEKE_uflux(I,j) = MEKE_uflux(I,j) + baroHu(I,j)*MEKE%MEKE(i,j)*advFac @@ -444,7 +418,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h MEKE_uflux(I,j) = MEKE_uflux(I,j) + baroHu(I,j)*MEKE%MEKE(i+1,j)*advFac endif enddo ; enddo -!$OMP do + !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie if (baroHv(i,J)>0.) then MEKE_vflux(i,J) = MEKE_vflux(i,J) + baroHv(i,J)*MEKE%MEKE(i,j)*advFac @@ -453,7 +427,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif enddo ; enddo endif -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + (sdt*(G%IareaT(i,j)*I_mass(i,j))) * & ((MEKE_uflux(I-1,j) - MEKE_uflux(I,j)) + & @@ -463,7 +437,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Add on bi-harmonic tendency if (CS%MEKE_K4 >= 0.0) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + CS%del2MEKE(i,j) enddo ; enddo @@ -474,13 +448,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (sdt>sdt_damp) then ! Recalculate the drag rate, since MEKE has changed. if (use_drag_rate) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie drag_rate(i,j) = (Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 & + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) enddo ; enddo endif -!$OMP do + !$OMP parallel do default(shared) private(ldamping) do j=js,je ; do i=is,ie ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j) if (MEKE%MEKE(i,j)<0.) ldamping = 0. @@ -491,7 +465,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo endif endif ! MEKE_KH>=0 -!$OMP end parallel call cpu_clock_begin(CS%id_clock_pass) call do_group_pass(CS%pass_MEKE, G%Domain) @@ -501,20 +474,20 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%MEKE_KhCoeff>0.) then if (CS%use_old_lscale) then if (CS%Rd_as_max_scale) then -!$OMP parallel do default(none) shared(is,ie,js,je,MEKE,CS,G,barotrFac2) + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie MEKE%Kh(i,j) = (CS%MEKE_KhCoeff & * sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j))) & * min(MEKE%Rd_dx_h(i,j), 1.0) enddo ; enddo else -!$OMP parallel do default(none) shared(is,ie,js,je,MEKE,CS,G,barotrFac2) + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie MEKE%Kh(i,j) = CS%MEKE_KhCoeff*sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j)) enddo ; enddo endif else -!$OMP parallel do default(none) shared(is,ie,js,je,MEKE,LmixScale,CS,G,barotrFac2) + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie MEKE%Kh(i,j) = (CS%MEKE_KhCoeff*sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j)))*LmixScale(i,j)) enddo ; enddo @@ -534,7 +507,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h call cpu_clock_end(CS%id_clock_pass) endif -! Offer fields for averaging. + ! Offer fields for averaging. if (CS%id_MEKE>0) call post_data(CS%id_MEKE, MEKE%MEKE, CS%diag) if (CS%id_Ue>0) call post_data(CS%id_Ue, sqrt(max(0.,2.0*MEKE%MEKE)), CS%diag) if (CS%id_Ub>0) call post_data(CS%id_Ub, sqrt(max(0.,2.0*MEKE%MEKE*bottomFac2)), CS%diag) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index be30be6633..164fbac47f 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -288,10 +288,10 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var endif p0(:) = 0.0 -!$OMP parallel default(none) shared(is,ie,js,je,G,GV,htot_fast,Rml_av_fast,tv,p0,h,h_avail,& +!$OMP parallel default(none) shared(is,ie,js,je,G,GV,US,htot_fast,Rml_av_fast,tv,p0,h,h_avail,& !$OMP h_neglect,g_Rho0,I4dt,CS,uhml,uhtr,dt,vhml,vhtr, & !$OMP utimescale_diag,vtimescale_diag,forces,dz_neglect, & -!$OMP htot_slow,MLD_slow,Rml_av_slow,VarMix,I_l_f, & +!$OMP htot_slow,MLD_slow,Rml_av_slow,VarMix,I_l_f, & !$OMP res_upscale, & !$OMP nz,MLD_fast,uDml_diag,vDml_diag,proper_averaging) & !$OMP private(rho_ml,h_vel,u_star,absf,mom_mixrate,timescale, & @@ -612,7 +612,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) ! Fix this later for nkml >= 3. p0(:) = 0.0 -!$OMP parallel default(none) shared(is,ie,js,je,G,GV,htot,Rml_av,tv,p0,h,h_avail, & +!$OMP parallel default(none) shared(is,ie,js,je,G,GV,US,htot,Rml_av,tv,p0,h,h_avail, & !$OMP h_neglect,g_Rho0,I4dt,CS,uhml,uhtr,dt,vhml,vhtr, & !$OMP utimescale_diag,vtimescale_diag,forces,dz_neglect, & !$OMP uDml_diag,vDml_diag,nkml) & diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index e106eb544b..f4e95bbb17 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -580,7 +580,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV enddo ; enddo !$OMP end parallel -!$OMP parallel do default(none) shared(nz,is,ie,js,je,find_work,use_EOS,G,GV,pres,T,S, & +!$OMP parallel do default(none) shared(nz,is,ie,js,je,find_work,use_EOS,G,GV,US,pres,T,S, & !$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect, & !$OMP I_slope_max2,h_neglect2,present_int_slope_u, & !$OMP int_slope_u,KH_u,uhtot,h_frac,h_avail_rsum, & @@ -829,7 +829,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV enddo ! end of j-loop ! Calculate the meridional fluxes and gradients. -!$OMP parallel do default(none) shared(nz,is,ie,js,je,find_work,use_EOS,G,GV,pres,T,S, & +!$OMP parallel do default(none) shared(nz,is,ie,js,je,find_work,use_EOS,G,GV,US,pres,T,S, & !$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect, & !$OMP I_slope_max2,h_neglect2,present_int_slope_v, & !$OMP int_slope_v,KH_v,vhtot,h_frac,h_avail_rsum, & diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 604e0ab2dc..161967c59a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -870,26 +870,23 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & if (CS%id_createdH>0) CS%createdH(:,:) = 0. numberOfGroundings = 0 -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h,tv,nsw,G,GV,optics,fluxes,dt, & -!$OMP H_limit_fluxes, & -!$OMP numberOfGroundings,iGround,jGround,nonPenSW, & -!$OMP hGrounding,CS,Idt,aggregate_FW_forcing, & -!$OMP minimum_forcing_depth,evap_CFL_limit, & -!$OMP calculate_buoyancy,netPen,SkinBuoyFlux,GoRho, & -!$OMP calculate_energetics,dSV_dT,dSV_dS,cTKE,g_Hconv2) & -!$OMP private(opacityBand,h2d,T2d,netMassInOut,netMassOut, & -!$OMP netHeat,netSalt,Pen_SW_bnd,fractionOfForcing, & -!$OMP IforcingDepthScale, & -!$OMP dThickness,dTemp,dSalt,hOld,Ithickness, & -!$OMP netMassIn,pres,d_pres,p_lay,dSV_dT_2d, & -!$OMP netmassinout_rate,netheat_rate,netsalt_rate, & -!$OMP drhodt,drhods,pen_sw_bnd_rate,SurfPressure, & -!$OMP pen_TKE_2d,Temp_in,Salin_in,RivermixConst) & -!$OMP firstprivate(start,npts) - - - ! Work in vertical slices for efficiency + !$OMP parallel do default(none) shared(is,ie,js,je,nz,h,tv,nsw,G,GV,US,optics,fluxes,dt, & + !$OMP H_limit_fluxes,numberOfGroundings,iGround,jGround,& + !$OMP nonPenSW,hGrounding,CS,Idt,aggregate_FW_forcing, & + !$OMP minimum_forcing_depth,evap_CFL_limit, & + !$OMP calculate_buoyancy,netPen,SkinBuoyFlux,GoRho, & + !$OMP calculate_energetics,dSV_dT,dSV_dS,cTKE,g_Hconv2) & + !$OMP private(opacityBand,h2d,T2d,netMassInOut,netMassOut, & + !$OMP netHeat,netSalt,Pen_SW_bnd,fractionOfForcing, & + !$OMP IforcingDepthScale, & + !$OMP dThickness,dTemp,dSalt,hOld,Ithickness, & + !$OMP netMassIn,pres,d_pres,p_lay,dSV_dT_2d, & + !$OMP netmassinout_rate,netheat_rate,netsalt_rate, & + !$OMP drhodt,drhods,pen_sw_bnd_rate,SurfPressure, & + !$OMP pen_TKE_2d,Temp_in,Salin_in,RivermixConst) & + !$OMP firstprivate(start,npts) do j=js,je + ! Work in vertical slices for efficiency ! Copy state into 2D-slice arrays do k=1,nz ; do i=is,ie diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index fbc8b90996..50b27a5ae6 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -550,7 +550,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS !!OMP parallel do default(none) shared(js,je,nz,is,ie,h_3d,u_3d,v_3d,tv,dt, & -!!OMP CS,G,GV,fluxes,IdtdR0, & +!!OMP CS,G,GV,US,fluxes,IdtdR0, & !!OMP TKE_forced,debug,H_neglect,dSV_dT, & !!OMP dSV_dS,I_dtrho,C1_3,h_tt_min,vonKar, & !!OMP max_itt,Kd_int) & diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index d438cae864..af9eb9bfba 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -248,22 +248,22 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, pres(:) = 0.0 endif -!$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_Lay,G,GV,dt,Kd_int,CS,h,tv, & -!$OMP kmb,Angstrom,fluxes,K2,h_neglect,tolerance, & -!$OMP ea,eb,correct_density,Kd_eff,diff_work, & -!$OMP g_2dt, kb_out) & -!$OMP firstprivate(kb,ds_dsp1,dsp1_ds,pres,kb_min) & -!$OMP private(dtKd,dtKd_int,do_i,Ent_bl,dtKd_kb,h_bl, & -!$OMP I2p2dsp1_ds,grats,htot,max_eakb,I_dSkbp1, & -!$OMP zeros,maxF_kb,maxF,ea_kbp1,eakb,Sref, & -!$OMP maxF_correct,do_any, & -!$OMP err_min_eakb0,err_max_eakb0,eakb_maxF, & -!$OMP min_eakb,err_eakb0,F,minF,hm,fk,F_kb_maxent,& -!$OMP F_kb,is1,ie1,kb_min_act,dFdfm_kb,b1,dFdfm, & -!$OMP Fprev,fm,fr,c1,reiterate,eb_kmb,did_i, & -!$OMP h_avail,h_guess,dS_kb,Rcv,F_cor,dS_kb_eff, & -!$OMP Rho_cor,ea_cor,h1,Idt,Kd_here,pressure, & -!$OMP T_eos,S_eos,dRho_dT,dRho_dS,dRho,dS_anom_lim) + !$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_Lay,G,GV,US,dt,CS,h,tv, & + !$OMP kmb,Angstrom,fluxes,K2,h_neglect,tolerance, & + !$OMP ea,eb,correct_density,Kd_int,Kd_eff, & + !$OMP diff_work,g_2dt, kb_out) & + !$OMP firstprivate(kb,ds_dsp1,dsp1_ds,pres,kb_min) & + !$OMP private(dtKd,dtKd_int,do_i,Ent_bl,dtKd_kb,h_bl, & + !$OMP I2p2dsp1_ds,grats,htot,max_eakb,I_dSkbp1, & + !$OMP zeros,maxF_kb,maxF,ea_kbp1,eakb,Sref, & + !$OMP maxF_correct,do_any, & + !$OMP err_min_eakb0,err_max_eakb0,eakb_maxF, & + !$OMP min_eakb,err_eakb0,F,minF,hm,fk,F_kb_maxent,& + !$OMP F_kb,is1,ie1,kb_min_act,dFdfm_kb,b1,dFdfm, & + !$OMP Fprev,fm,fr,c1,reiterate,eb_kmb,did_i, & + !$OMP h_avail,h_guess,dS_kb,Rcv,F_cor,dS_kb_eff, & + !$OMP Rho_cor,ea_cor,h1,Idt,Kd_here,pressure, & + !$OMP T_eos,S_eos,dRho_dT,dRho_dS,dRho,dS_anom_lim) do j=js,je do i=is,ie ; kb(i) = 1 ; enddo diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 7b0a7ad032..525dfb1cb0 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -204,7 +204,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & #ifdef ADD_DIAGNOSTICS !$OMP I_Ld2_3d,dz_Int_3d, & #endif - !$OMP tv,G,GV,CS,kappa_io,dz_massless,k0dt,p_surf,dt,tke_io,kv_io) + !$OMP tv,G,GV,US,CS,kappa_io,dz_massless,k0dt,p_surf,dt,tke_io,kv_io) do j=js,je do k=1,nz ; do i=is,ie h_2d(i,k) = h(i,j,k)*GV%H_to_Z @@ -501,7 +501,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ #ifdef ADD_DIAGNOSTICS !$OMP I_Ld2_3d,dz_Int_3d, & #endif - !$OMP tv,G,GV,CS,kappa_io,dz_massless,k0dt,p_surf,dt,tke_io,kv_io) + !$OMP tv,G,GV,US,CS,kappa_io,dz_massless,k0dt,p_surf,dt,tke_io,kv_io) do J=JsB,JeB J2 = mod(J,2)+1 ; J2m1 = 3-J2 ! = mod(J-1,2)+1 diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index cbff7bbabf..4578c49c9c 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1708,7 +1708,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) cdrag_sqrt = sqrt(CS%cdrag) -!$OMP parallel default(none) shared(cdrag_sqrt,is,ie,js,je,nz,visc,CS,G,GV,vstar,h,v, & +!$OMP parallel default(none) shared(cdrag_sqrt,is,ie,js,je,nz,visc,CS,G,GV,US,vstar,h,v, & !$OMP v2_bbl,u) & !$OMP private(do_i,vhtot,htot,domore,hvel,uhtot,ustar,u2_bbl) !$OMP do diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index bdcadf6ab1..c623b0c0a8 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -356,7 +356,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) if (.not.use_BBL_EOS) Rml_vel(:,:) = 0.0 - !$OMP parallel do default(private) shared(u,v,h,tv,visc,G,GV,CS,Rml,is,ie,js,je,nz,nkmb, & + !$OMP parallel do default(private) shared(u,v,h,tv,visc,G,GV,US,CS,Rml,is,ie,js,je,nz,nkmb, & !$OMP nkml,Isq,Ieq,Jsq,Jeq,h_neglect,Rho0x400_G,C2pi_3, & !$OMP U_bg_sq,cdrag_sqrt_Z,cdrag_sqrt,K2,use_BBL_EOS, & !$OMP OBC,maxitt,Vol_quit,D_u,D_v,mask_u,mask_v) @@ -1183,7 +1183,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri endif enddo ; endif - !$OMP parallel do default(private) shared(u,v,h,tv,forces,visc,dt,G,GV,CS,use_EOS,dt_Rho0, & + !$OMP parallel do default(private) shared(u,v,h,tv,forces,visc,dt,G,GV,US,CS,use_EOS,dt_Rho0, & !$OMP h_neglect,h_tiny,g_H_Rho0,js,je,OBC,Isq,Ieq,nz, & !$OMP U_bg_sq,mask_v,cdrag_sqrt,cdrag_sqrt_Z,Rho0x400_G,nkml) do j=js,je ! u-point loop @@ -1418,7 +1418,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri enddo ! j-loop at u-points - !$OMP parallel do default(private) shared(u,v,h,tv,forces,visc,dt,G,GV,CS,use_EOS,dt_Rho0, & + !$OMP parallel do default(private) shared(u,v,h,tv,forces,visc,dt,G,GV,US,CS,use_EOS,dt_Rho0, & !$OMP h_neglect,h_tiny,g_H_Rho0,is,ie,OBC,Jsq,Jeq,nz, & !$OMP U_bg_sq,cdrag_sqrt,cdrag_sqrt_Z,Rho0x400_G,nkml,mask_u) do J=Jsq,Jeq ! v-point loop From e1136e02912a3746a67f75ef6b553b2bf1049aa1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 6 Nov 2018 11:40:29 -0500 Subject: [PATCH 0888/1072] Rescale HMIX_SFC_PROP via get_param Rescaled the values of HMIX_SFC_PROP and HMIX_UV_SFC_PROP via their calls to get_param. All answers are bitwise identical. --- src/core/MOM.F90 | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 60ed293ece..67fd35a9d2 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1770,12 +1770,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "If BULKMIXEDLAYER is false, HMIX_SFC_PROP is the depth \n"//& "over which to average to find surface properties like \n"//& "SST and SSS or density (but not surface velocities).", & - units="m", default=1.0) !, scale=US%m_to_Z) + units="m", default=1.0, scale=US%m_to_Z) call get_param(param_file, "MOM", "HMIX_UV_SFC_PROP", CS%Hmix_UV, & "If BULKMIXEDLAYER is false, HMIX_UV_SFC_PROP is the depth\n"//& "over which to average to find surface flow properties,\n"//& "SSU, SSV. A non-positive value indicates no averaging.", & - units="m", default=0.) !, scale=US%m_to_Z) + units="m", default=0.0, scale=US%m_to_Z) endif call get_param(param_file, "MOM", "HFREEZE", CS%HFrz, & "If HFREEZE > 0, melt potential will be computed. The actual depth \n"//& @@ -1968,11 +1968,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call verticalGridInit( param_file, CS%GV, US ) GV => CS%GV ! dG%g_Earth = (GV%g_Earth*US%m_to_Z) - !### These should be merged with the get_param calls, but must follow verticalGridInit. - if (.not.bulkmixedlayer) then - CS%Hmix = CS%Hmix * US%m_to_Z - CS%Hmix_UV = CS%Hmix_UV * US%m_to_Z - endif ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. if (CS%debug .or. dG%symmetric) & @@ -1980,7 +1975,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call callTree_waypoint("grids initialized (initialize_MOM)") - call MOM_timing_init(CS) ! Allocate initialize time-invariant MOM variables. From 2dd1d6b03c9b42c86eaa296a16a0d28bf8d18c4a Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 6 Nov 2018 16:47:12 +0000 Subject: [PATCH 0889/1072] Update cache dir for /lustre/f2 --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index ec16fd5d7b..cdacb620b0 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -8,7 +8,7 @@ stages: # Merges MOM6 with dev/gfdl. Changes directory to test directory, if it exists. before_script: - MOM6_SRC=$CI_PROJECT_DIR - - CACHE_DIR=/lustre/f1/oar.gfdl.ogrp-account/runner/cache/ + - echo Cache directory set to ${CACHE_DIR:=/lustre/f2/scratch/oar.gfdl.ogrp-account/runner/cache/} - git pull --no-edit https://github.com/NOAA-GFDL/MOM6.git dev/gfdl && git submodule init && git submodule update - pwd ; ls From 244a36ab4e0bc052cab60b1194d3225f9d071c3a Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 6 Nov 2018 16:47:12 +0000 Subject: [PATCH 0890/1072] Update cache dir for /lustre/f2 --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index ec16fd5d7b..cdacb620b0 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -8,7 +8,7 @@ stages: # Merges MOM6 with dev/gfdl. Changes directory to test directory, if it exists. before_script: - MOM6_SRC=$CI_PROJECT_DIR - - CACHE_DIR=/lustre/f1/oar.gfdl.ogrp-account/runner/cache/ + - echo Cache directory set to ${CACHE_DIR:=/lustre/f2/scratch/oar.gfdl.ogrp-account/runner/cache/} - git pull --no-edit https://github.com/NOAA-GFDL/MOM6.git dev/gfdl && git submodule init && git submodule update - pwd ; ls From a6d0146da7e4c1ed2f7918cd913fa6c05ac03b92 Mon Sep 17 00:00:00 2001 From: MFJansen Date: Tue, 6 Nov 2018 12:02:10 -0600 Subject: [PATCH 0891/1072] Added parameter in Neverland_initialization which allows to remove continents --- src/user/Neverland_initialization.F90 | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index 76d028c6f4..a370a60f49 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -39,7 +39,7 @@ subroutine Neverland_initialize_topography(D, G, param_file, max_depth) #include "version_variable.h" character(len=40) :: mdl = "Neverland_initialize_topography" ! This subroutine's name. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed - real :: nl_roughness_amp + real :: nl_roughness_amp, nl_top_amp is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -48,6 +48,8 @@ subroutine Neverland_initialize_topography(D, G, param_file, max_depth) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "NL_ROUGHNESS_AMP", nl_roughness_amp, & "Amplitude of wavy signal in bathymetry.", default=0.05) + call get_param(param_file, mdl, "NL_CONTINENT_AMP", nl_top_amp, & + "Scale factor for topography - 0.0 for no continents.", default=1.0) PI = 4.0*atan(1.0) @@ -57,18 +59,17 @@ subroutine Neverland_initialize_topography(D, G, param_file, max_depth) x=(G%geoLonT(i,j)-G%west_lon)/G%len_lon y=(G%geoLatT(i,j)-G%south_lat)/G%len_lat ! This sets topography that has a reentrant channel to the south. - - D(i,j) = 1.0 - (1.2 * spike(x,0.2) + 1.2 * spike(x-1.0,0.2)) * spike(MIN(0.0,y-0.3),0.2) & !< South America - - 1.2 * spike(x-0.5,0.2) * spike(MIN(0.0,y-0.55),0.2) & !< Africa - - 1.1 * spike(y-1,0.12) - 1.1 * spike(y,0.12) & !< The great northern wall and Antarctica - - 1.2 * (spike(x,0.12) + spike(x-1,0.12)) * spike(MAX(0.0,y-0.06),0.12) & !< Antarctic Peninsula - - 0.1 * (cosbell(x,0.1) + cosbell(x-1,0.1)) & !< Drake Passage ridge - - 0.5 * cosbell(x-0.16,0.05) * (cosbell(y-0.18,0.13)**0.4) & !< Scotia Arc East - - 0.4 * (cosbell(x-0.09,0.08)**0.4) * cosbell(y-0.26,0.05) & !< Scotia Arc North - - 0.4 * (cosbell(x-0.08,0.08)**0.4) * cosbell(y-0.1,0.05) & !< Scotia Arc South + D(i,j) = 1.0 - 1.1 * spike(y-1,0.12) - 1.1 * spike(y,0.12) - & !< The great northern wall and Antarctica + nl_top_amp*( & + (1.2 * spike(x,0.2) + 1.2 * spike(x-1.0,0.2)) * spike(MIN(0.0,y-0.3),0.2) & !< South America + + 1.2 * spike(x-0.5,0.2) * spike(MIN(0.0,y-0.55),0.2) & !< Africa + + 1.2 * (spike(x,0.12) + spike(x-1,0.12)) * spike(MAX(0.0,y-0.06),0.12) & !< Antarctic Peninsula + + 0.1 * (cosbell(x,0.1) + cosbell(x-1,0.1)) & !< Drake Passage ridge + + 0.5 * cosbell(x-0.16,0.05) * (cosbell(y-0.18,0.13)**0.4) & !< Scotia Arc East + + 0.4 * (cosbell(x-0.09,0.08)**0.4) * cosbell(y-0.26,0.05) & !< Scotia Arc North + + 0.4 * (cosbell(x-0.08,0.08)**0.4) * cosbell(y-0.1,0.05)) & !< Scotia Arc South - nl_roughness_amp * cos(14*PI*x) * sin(14*PI*y) & !< roughness - nl_roughness_amp * cos(20*PI*x) * cos(20*PI*y) !< roughness - if (D(i,j) < 0.0) D(i,j) = 0.0 D(i,j) = D(i,j) * max_depth enddo From fa1a7624b4350b7fd12c5e6af10ad6a8efcfcb09 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 6 Nov 2018 18:56:27 -0500 Subject: [PATCH 0892/1072] +Added run-time parameters for benchmark test case Added two new runtime parameters that are used in setting up the benchmark test case. By default all answers are bitwise identical, but the MOM_parameter_doc.short files change for the benchmark test case. --- src/user/benchmark_initialization.F90 | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index b3b9662164..d50fe3fa05 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -38,8 +38,8 @@ subroutine benchmark_initialize_topography(D, G, param_file, max_depth) real :: D0 ! A constant to make the maximum ! ! basin depth MAXIMUM_DEPTH. ! real :: x, y -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "benchmark_initialize_topography" ! This subroutine's name. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -107,12 +107,21 @@ subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state ! interface temperature for a given z and its derivative. real :: pi, z logical :: just_read + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "benchmark_initialize_thickness" ! This subroutine's name. integer :: i, j, k, k1, is, ie, js, je, nz, itt is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + if (.not.just_read) call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "BENCHMARK_ML_DEPTH_IC", ML_depth, & + "Initial mixed layer depth in the benchmark test case.", & + units='m', default=50.0, scale=US%m_to_Z, do_not_log=just_read) + call get_param(param_file, mdl, "BENCHMARK_THERMOCLINE_SCALE", thermocline_scale, & + "Initial thermocline depth scale in the benchmark test case.", & + default=500.0, units="m", scale=US%m_to_Z, do_not_log=just_read) if (just_read) return ! This subroutine has no run-time parameters. @@ -120,8 +129,6 @@ subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state k1 = GV%nk_rho_varies + 1 - ML_depth = 50.0 * US%m_to_Z - thermocline_scale = 500.0 * US%m_to_Z a_exp = 0.9 ! This block calculates T0(k) for the purpose of diagnosing where the From 6ccb6b6f7a5a94836ba2d3bbad9384c3ced3dcd5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 6 Nov 2018 18:58:32 -0500 Subject: [PATCH 0893/1072] +Added a run-time parameter for circle_obcs Added a new runtime parameter, DISK_IC_AMPLITUDE, that is used in setting up the circle_obcs test case. By default all answers are bitwise identical, but the MOM_parameter_doc.short files change for the benchmark test case. --- src/user/circle_obcs_initialization.F90 | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index f72a6e1830..7ba02a7acc 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -37,10 +37,11 @@ subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_para ! negative because it is positive upward. real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! positive upward, in in depth units (Z). + real :: IC_amp ! The amplitude of the initial height displacement, in H. real :: diskrad, rad, xCenter, xRadius, lonC, latC, xOffset logical :: just_read -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "circle_obcs_initialization" ! This module's name. integer :: i, j, k, is, ie, js, je, nz @@ -61,6 +62,10 @@ subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_para "The x-offset of the initially elevated disk in the \n"//& "circle_obcs test case.", units=G%x_axis_units, & default = 0.0, do_not_log=just_read) + call get_param(param_file, mdl, "DISK_IC_AMPLITUDE", IC_amp, & + "Initial amplitude of interface height displacements \n"//& + "in the circle_obcs test case.", & + units='m', default=5.0, scale=GV%m_to_H, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -93,12 +98,11 @@ subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_para rad = rad*(2.*asin(1.)) ! Map 0-1 to 0-pi if (nz==1) then ! The model is barotropic - h(i,j,k) = h(i,j,k) + GV%m_to_H * 1.0*0.5*(1.+cos(rad)) ! cosine bell + h(i,j,k) = h(i,j,k) + IC_amp * 0.5*(1.+cos(rad)) ! cosine bell else ! The model is baroclinic do k = 1, nz - h(i,j,k) = h(i,j,k) - GV%m_to_H * 0.5*(1.+cos(rad)) & ! cosine bell - * 5.0 * real( 2*k-nz ) + h(i,j,k) = h(i,j,k) - 0.5*(1.+cos(rad)) * IC_amp * real( 2*k-nz ) enddo endif enddo ; enddo From 0874ac4fbf447b5e2ba9ef134c145f97b58056be Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 6 Nov 2018 18:59:05 -0500 Subject: [PATCH 0894/1072] +Added the INTERFACE_IC_QUANTA runtime parameter Added a new parameter, INTERFACE_IC_QUANTA, that is used in the seamount and dumbbell test case to ensure that the initial interface heights can be easily represented in output files and are not sensitive to order of arithmetic changes in the setup. By default all answers are bitwise identical, but the MOM_parameter_doc.short files change for the seamount and dumbbell test cases. --- src/user/dumbbell_initialization.F90 | 20 ++++++++++++++------ src/user/seamount_initialization.F90 | 21 ++++++++++++++------- 2 files changed, 28 insertions(+), 13 deletions(-) diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index ce8fcdef39..5a5a845449 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -6,7 +6,7 @@ module dumbbell_initialization use MOM_domains, only : sum_across_PEs use MOM_dyn_horgrid, only : dyn_horgrid_type use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe -use MOM_file_parser, only : get_param, param_file_type +use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type use MOM_sponge, only : set_up_sponge_field, initialize_sponge, sponge_CS @@ -86,12 +86,14 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, US, param_file, just_read_p ! negative because it is positive upward. real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! positive upward, in depth units (Z). - integer :: i, j, k, is, ie, js, je, nz - real :: x - real :: delta_h - real :: min_thickness, S_surf, S_range, S_ref, S_light, S_dense + real :: min_thickness ! The minimum layer thicknesses, in Z. + real :: S_surf, S_range, S_ref, S_light, S_dense ! Various salinities, in ppt. + real :: eta_IC_quanta ! The granularity of quantization of intial interface heights, in Z-1. + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=20) :: verticalCoordinate logical :: just_read ! If true, just read parameters but set nothing. + integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -100,6 +102,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, US, param_file, just_read_p if (.not.just_read) & call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness") + if (.not.just_read) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & 'Minimum thickness for layer',& units='m', default=1.0e-3, do_not_log=just_read, scale=US%m_to_Z) @@ -125,6 +128,10 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, US, param_file, just_read_p call get_param(param_file, mdl, "S_REF", S_ref, default=35.0, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_light, default = S_Ref, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_dense, default = S_Ref, do_not_log=.true.) + call get_param(param_file, mdl, "INTERFACE_IC_QUANTA", eta_IC_quanta, & + "The granularity of initial interface height values \n"//& + "per meter, to avoid sensivity to order-of-arithmetic changes.", & + default=2048.0, units="m-1", scale=US%Z_to_m, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. do K=1,nz+1 @@ -137,7 +144,8 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, US, param_file, just_read_p e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * & ( (real(K)-1.5) / real(nz-1) ) ) / S_range ! Force round numbers ... the above expression has irrational factors ... - e0(K) = nint(2048.*US%Z_to_m*e0(K)) / (2048.*US%Z_to_m) + if (eta_IC_quanta > 0.0) & + e0(K) = nint(eta_IC_quanta*e0(K)) / eta_IC_quanta e0(K) = min(real(1-K)*GV%Angstrom_Z, e0(K)) ! Bound by surface e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom enddo diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 42ea66d0ad..3a5d7d186f 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -85,11 +85,13 @@ subroutine seamount_initialize_thickness ( h, G, GV, US, param_file, just_read_p logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! - real :: min_thickness, S_surf, S_range, S_ref, S_light, S_dense + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), usually + ! negative because it is positive upward. + real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface + ! positive upward, in depth units (Z). + real :: min_thickness ! The minimum layer thicknesses, in Z. + real :: S_surf, S_range, S_ref, S_light, S_dense ! Various salinities, in ppt. + real :: eta_IC_quanta ! The granularity of quantization of intial interface heights, in Z-1. character(len=20) :: verticalCoordinate logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, nz @@ -102,7 +104,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, US, param_file, just_read_p call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness") call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & - 'Minimum thickness for layer',& + 'Minimum thickness for layer', & units='m', default=1.0e-3, do_not_log=just_read, scale=US%m_to_Z) call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) @@ -126,6 +128,10 @@ subroutine seamount_initialize_thickness ( h, G, GV, US, param_file, just_read_p call get_param(param_file, mdl, "S_REF", S_ref, default=35.0, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_light, default = S_Ref, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_dense, default = S_Ref, do_not_log=.true.) + call get_param(param_file, mdl, "INTERFACE_IC_QUANTA", eta_IC_quanta, & + "The granularity of initial interface height values \n"//& + "per meter, to avoid sensivity to order-of-arithmetic changes.", & + default=2048.0, units="m-1", scale=US%Z_to_m, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. do K=1,nz+1 @@ -138,7 +144,8 @@ subroutine seamount_initialize_thickness ( h, G, GV, US, param_file, just_read_p e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * & ( (real(K)-1.5) / real(nz-1) ) ) / S_range ! Force round numbers ... the above expression has irrational factors ... - e0(K) = nint(2048.*US%Z_to_m*e0(K))/(2048.*US%Z_to_m) + if (eta_IC_quanta > 0.0) & + e0(K) = nint(eta_IC_quanta*e0(K)) / eta_IC_quanta e0(K) = min(real(1-K)*GV%Angstrom_Z, e0(K)) ! Bound by surface e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom enddo From 9259ba1ea8b11fd3a48f04aeedb645a2b047e3c9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 6 Nov 2018 18:59:26 -0500 Subject: [PATCH 0895/1072] +Added run-time parameters for sloshing test case Added two new runtime parameters, SLOSHING_IC_AMPLITUDE and SLOSHING_IC_BUG, that are used in setting up the sloshing test case. By default all answers are bitwise identical, but the MOM_parameter_doc.short files change for the sloshing test case. --- src/user/sloshing_initialization.F90 | 28 +++++++++++++++++++++------- 1 file changed, 21 insertions(+), 7 deletions(-) diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index bda2a8d895..5c4c5ec5b6 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -6,7 +6,7 @@ module sloshing_initialization use MOM_domains, only : sum_across_PEs use MOM_dyn_horgrid, only : dyn_horgrid_type use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe -use MOM_file_parser, only : get_param, param_file_type +use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type use MOM_sponge, only : set_up_sponge_field, initialize_sponge, sponge_CS @@ -25,8 +25,6 @@ module sloshing_initialization public sloshing_initialize_thickness public sloshing_initialize_temperature_salinity -character(len=40) :: mdl = "sloshing_initialization" !< This module's name. - contains !> Initialization of topography. @@ -73,14 +71,27 @@ subroutine sloshing_initialize_thickness ( h, G, GV, US, param_file, just_read_p real :: weight_z ! A (misused?) depth-space weighting, in inconsistent units. real :: x1, y1, x2, y2 ! Dimensonless parameters. real :: x, t ! Dimensionless depth coordinates? + logical :: use_IC_bug ! If true, set the initial conditions retaining an old bug. logical :: just_read ! If true, just read parameters but set nothing. + ! This include declares and sets the variable "version". +# include "version_variable.h" + character(len=40) :: mdl = "sloshing_initialization" !< This module's name. integer :: i, j, k, is, ie, js, je, nx, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - if (just_read) return ! This subroutine has no run-time parameters. + if (.not.just_read) call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "SLOSHING_IC_AMPLITUDE", a0, & + "Initial amplitude of sloshing internal interface height \n"//& + "displacements it the sloshing test case.", & + units='m', default=75.0, scale=US%m_to_Z, do_not_log=just_read) + call get_param(param_file, mdl, "SLOSHING_IC_BUG", use_IC_bug, & + "If true, use code with a bug to set the sloshing initial conditions.", & + default=.true., do_not_log=just_read) + + if (just_read) return ! All run-time parameters have been read, so return. ! Define thicknesses do j=G%jsc,G%jec ; do i=G%isc,G%iec @@ -116,14 +127,17 @@ subroutine sloshing_initialize_thickness ( h, G, GV, US, param_file, just_read_p enddo ! 2. Define displacement - a0 = 75.0 * US%m_to_Z ! 75m Displacement amplitude in depth units. + ! a0 is set via get_param; by default a0 is a 75m Displacement amplitude in depth units. do k = 1,nz+1 weight_z = - 4.0 * ( z_unif(k) + 0.5 )**2 + 1.0 x = G%geoLonT(i,j) / G%len_lon - !### Perhaps the '+ weight_z' here should be '* weight_z' - RWH - displ(k) = a0 * cos(acos(-1.0)*x) + weight_z * US%m_to_Z + if (use_IC_bug) then + displ(k) = a0 * cos(acos(-1.0)*x) + weight_z * US%m_to_Z + else + displ(k) = a0 * cos(acos(-1.0)*x) * weight_z + endif if ( k == 1 ) then displ(k) = 0.0 From 0ace7767073a8991b442c99462472972bd462a15 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 6 Nov 2018 18:59:44 -0500 Subject: [PATCH 0896/1072] Added a comment in USER_initialize_thickness Added a comment in USER_initialize_thickness and removed a constant that is being multiplied by 0. All answers are bitwise identical. --- src/user/user_initialization.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 174cd0ac8f..0a4ce7ccaa 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -92,7 +92,7 @@ subroutine USER_initialize_thickness(h, G, GV, param_file, just_read_params) if (just_read) return ! All run-time parameters have been read, so return. - h(:,:,1) = 0.0 * GV%m_to_H + h(:,:,1) = 0.0 ! h should be set in units of H. if (first_call) call write_user_log(param_file) From dfb9d9fc3c715ad88d61eab276c3f35beaff17a3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 8 Nov 2018 18:44:44 -0500 Subject: [PATCH 0897/1072] Corrected an openMP directive Corrected an openMP directives that omitted a recently added unit_scale_type variable. All answers are bitwise identical, and the code once again compiles with openMP enabled. --- src/diagnostics/MOM_wave_speed.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index cd71800290..3a136bcd9b 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -135,7 +135,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & rescale = 1024.0**4 ; I_rescale = 1.0/rescale min_h_frac = tol1 / real(nz) -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h,G,GV,min_h_frac,use_EOS,T,S,tv,& +!$OMP parallel do default(none) shared(is,ie,js,je,nz,h,G,GV,US,min_h_frac,use_EOS,T,S,tv,& !$OMP calc_modal_structure,l_use_ebt_mode,modal_structure, & !$OMP l_mono_N2_column_fraction,l_mono_N2_depth,CS, & !$OMP Z_to_Pa,cg1,g_Rho0,rescale,I_rescale,L2_to_Z2) & From 718e1d9c92aff0a706a8931ef60f5bd3d85d26bc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 8 Nov 2018 18:53:10 -0500 Subject: [PATCH 0898/1072] +Recast ice_shelf code to work in units of Z Recast the internal calculations in the MOM6 ice shelf code and several persistent ice shelf state variables to use vertical height units of Z in place of m for dimensional consistency testing. This includes adding new unit_scale_type arguments to several routines and new elements to the ice shelf control structure. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- src/ice_shelf/MOM_ice_shelf.F90 | 86 ++++-- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 302 ++++++++++----------- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 38 ++- src/ice_shelf/user_shelf_init.F90 | 25 +- 4 files changed, 244 insertions(+), 207 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 3a27c988c9..58d6c75480 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -13,6 +13,7 @@ module MOM_ice_shelf use MOM_domains, only : MOM_domains_init, clone_MOM_domain use MOM_domains, only : pass_var, pass_vector, TO_ALL, CGRID_NE, BGRID_NE, CORNER use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid +use MOM_dyn_horgrid, only : rescale_dyn_horgrid_bathymetry use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe use MOM_file_parser, only : read_param, get_param, log_param, log_version, param_file_type use MOM_grid, only : MOM_grid_init, ocean_grid_type @@ -27,6 +28,7 @@ module MOM_ice_shelf use MOM_restart, only : restart_init, restore_state, MOM_restart_CS use MOM_time_manager, only : time_type, time_type_to_real, time_type_to_real, real_to_time use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid +use MOM_unit_scaling, only : unit_scale_type, unit_scaling_init, fix_restart_unit_scaling use MOM_variables, only : surface use MOM_forcing_type, only : forcing, allocate_forcing_type, MOM_forcing_chksum use MOM_forcing_type, only : mech_forcing, allocate_mech_forcing, MOM_mech_forcing_chksum @@ -66,6 +68,8 @@ module MOM_ice_shelf type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control !! structure for the ice shelves type(ocean_grid_type) :: grid !< Grid for the ice-shelf model + type(unit_scale_type), pointer :: & + US => NULL() !< A structure containing various unit conversion factors !type(dyn_horgrid_type), pointer :: dG !< Dynamic grid for the ice-shelf model type(ocean_grid_type), pointer :: ocn_grid => NULL() !< A pointer to the ocean model grid !! The rest is private @@ -91,6 +95,7 @@ module MOM_ice_shelf real :: Temp_ice !< The core temperature of shelf ice, in C. real :: kv_ice !< The viscosity of ice, in m2 s-1. real :: density_ice !< A typical density of ice, in kg m-3. + real :: rho_ice !< Nominal ice density in kg m-2 Z-1 real :: kv_molec !< The molecular kinematic viscosity of sea water, m2 s-1. real :: kd_molec_salt!< The molecular diffusivity of salt, in m2 s-1. real :: kd_molec_temp!< The molecular diffusivity of heat, in m2 s-1. @@ -120,7 +125,7 @@ module MOM_ice_shelf !! shelf front(until we think of a better way to do it- !! but any difference will be negligible) logical :: calve_to_mask !< If true, calve any ice that passes outside of a masked area - real :: min_thickness_simple_calve !< min. ice shelf thickness criteria for calving + real :: min_thickness_simple_calve !< min. ice shelf thickness criteria for calving, in Z real :: T0 !< temperature at ocean surface in the restoring region, in degC real :: S0 !< Salinity at ocean surface in the restoring region, in ppt. real :: input_flux !< Ice volume flux at an upstream open boundary, in m3 s-1. @@ -193,6 +198,8 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) type(mech_forcing), optional, intent(inout) :: forces !< A structure with the driving mechanical forces type(ocean_grid_type), pointer :: G => NULL() ! The grid structure used by the ice shelf. + type(unit_scale_type), pointer :: US => NULL() ! Pointer to a structure containing + ! various unit conversion factors type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe !! the ice-shelf state @@ -266,7 +273,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) "initialize_ice_shelf must be called before shelf_calc_flux.") call cpu_clock_begin(id_clock_shelf) - G => CS%grid + G => CS%grid ; US => CS%US ISS => CS%ISS ! useful parameters @@ -630,7 +637,12 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) ! Melting has been computed, now is time to update thickness and mass if ( CS%override_shelf_movement .and. (.not.CS%mass_from_file)) then - call change_thickness_using_melt(ISS, G, time_step, fluxes, CS%density_ice, CS%debug) + call change_thickness_using_melt(ISS, G, time_step, fluxes, CS%rho_ice, CS%debug) + + if (CS%debug) then + call hchksum(ISS%h_shelf, "h_shelf after change thickness using melt", G%HI, haloshift=0, scale=US%Z_to_m) + call hchksum(ISS%mass_shelf, "mass_shelf after change thickness using melt", G%HI, haloshift=0) + endif endif if (CS%DEBUG) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, haloshift=0) @@ -645,7 +657,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) ! advect the ice shelf, and advance the front. Calving will be in here somewhere as well.. ! when we decide on how to do it - call update_ice_shelf(CS%dCS, ISS, G, time_step, Time, state%ocean_mass, coupled_GL) + call update_ice_shelf(CS%dCS, ISS, G, US, time_step, Time, state%ocean_mass, coupled_GL) endif @@ -687,7 +699,7 @@ subroutine change_thickness_using_melt(ISS, G, time_step, fluxes, rho_ice, debug real, intent(in) :: time_step !< The time step for this update, in s. type(forcing), intent(inout) :: fluxes !< structure containing pointers to any possible !! thermodynamic or mass-flux forcing fields. - real, intent(in) :: rho_ice !< The density of ice-shelf ice, in kg m-3. + real, intent(in) :: rho_ice !< The density of ice-shelf ice, in kg m-2 Z-1. logical, optional, intent(in) :: debug !< If present and true, write chksums ! locals @@ -729,11 +741,6 @@ subroutine change_thickness_using_melt(ISS, G, time_step, fluxes, rho_ice, debug call pass_var(ISS%mass_shelf, G%domain) - if (present(debug)) then ; if (debug) then - call hchksum(ISS%h_shelf, "h_shelf after change thickness using melt", G%HI, haloshift=0) - call hchksum(ISS%mass_shelf, "mass_shelf after change thickness using melt", G%HI, haloshift=0) - endif ; endif - end subroutine change_thickness_using_melt !> This subroutine adds the mechanical forcing fields and perhaps shelf areas, based on @@ -869,7 +876,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) type(time_type) :: Time0!< The previous time (Time-dt) real, dimension(SZDI_(G),SZDJ_(G)) :: last_mass_shelf !< Ice shelf mass !! at at previous time (Time-dt), in kg/m^2 - real, dimension(SZDI_(G),SZDJ_(G)) :: last_h_shelf !< Ice shelf thickness + real, dimension(SZDI_(G),SZDJ_(G)) :: last_h_shelf !< Ice shelf thickness in Z !! at at previous time (Time-dt), in m real, dimension(SZDI_(G),SZDJ_(G)) :: last_hmask !< Ice shelf mask !! at at previous time (Time-dt) @@ -994,14 +1001,14 @@ subroutine add_shelf_flux(G, CS, state, fluxes) Time0 = real_to_time(t0) last_hmask(:,:) = ISS%hmask(:,:) ; last_area_shelf_h(:,:) = ISS%area_shelf_h(:,:) call time_interp_external(CS%id_read_mass, Time0, last_mass_shelf) - last_h_shelf = last_mass_shelf/CS%density_ice + last_h_shelf(:,:) = last_mass_shelf(:,:) / CS%rho_ice ! apply calving if (CS%min_thickness_simple_calve > 0.0) then call ice_shelf_min_thickness_calve(G, last_h_shelf, last_area_shelf_h, last_hmask, & CS%min_thickness_simple_calve) ! convert to mass again - last_mass_shelf = last_h_shelf * CS%density_ice + last_mass_shelf(:,:) = last_h_shelf(:,:) * CS%rho_ice endif shelf_mass0 = 0.0; shelf_mass1 = 0.0 @@ -1069,10 +1076,14 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl !! a solo ice-sheet driver. type(ocean_grid_type), pointer :: G => NULL(), OG => NULL() ! Pointers to grids for convenience. + type(unit_scale_type), pointer :: US => NULL() ! Pointer to a structure containing + ! various unit conversion factors type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe !! the ice-shelf state type(directories) :: dirs type(dyn_horgrid_type), pointer :: dG => NULL() + real :: Z_rescale ! A rescaling factor for heights from the representation in + ! a reastart fole to the internal representation in this run. real :: cdrag, drag_bg_vel logical :: new_sim, save_IC, var_force !This include declares and sets the variable "version". @@ -1097,6 +1108,9 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! MOM's grid and infrastructure. call Get_MOM_Input(dirs=dirs) + ! Determining the internal unit scaling factors for this run. + call unit_scaling_init(param_file, CS%US) + ! Set up the ice-shelf domain and grid wd_halos(:)=0 call MOM_domains_init(CS%grid%domain, param_file, min_halo=wd_halos, symmetric=GRID_SYM_) @@ -1117,6 +1131,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! Convenience pointers G => CS%grid OG => CS%ocn_grid + US => CS%US if (is_root_pe()) then write(0,*) 'OG: ', OG%isd, OG%isc, OG%iec, OG%ied, OG%jsd, OG%jsc, OG%jsd, OG%jed @@ -1323,10 +1338,11 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call get_param(param_file, mdl, "DENSITY_ICE", CS%density_ice, & "A typical density of ice.", units="kg m-3", default=900.0) endif + CS%rho_ice = CS%density_ice*US%Z_to_m call get_param(param_file, mdl, "MIN_THICKNESS_SIMPLE_CALVE", & CS%min_thickness_simple_calve, & "Min thickness rule for the very simple calving law",& - units="m", default=0.0) + units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "USTAR_SHELF_BG", CS%ustar_bg, & "The minimum value of ustar under ice sheves.", units="m s-1", & @@ -1370,15 +1386,16 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl endif ! Set up the bottom depth, G%D either analytically or from file - call MOM_initialize_topography(G%bathyT, G%max_depth, dG, param_file) + call MOM_initialize_topography(dG%bathyT, G%max_depth, dG, param_file) + if (dG%Zd_to_m /= US%Z_to_m) call rescale_dyn_horgrid_bathymetry(dG, US%Z_to_m) + ! Set up the Coriolis parameter, G%f, usually analytically. - call MOM_initialize_rotation(G%CoriolisBu, dG, param_file) + call MOM_initialize_rotation(dG%CoriolisBu, dG, param_file) + ! This copies grid elements, inglucy bathyT and CoriolisBu from dG to CS%grid. call copy_dyngrid_to_MOM_grid(dG, CS%grid) call destroy_dyn_horgrid(dG) - !### Rescale the topography in the grid, and record the units. - ! Set up the restarts. call restart_init(param_file, CS%restart_CSp, "Shelf.res") call register_restart_field(ISS%mass_shelf, "shelf_mass", .true., CS%restart_CSp, & @@ -1387,6 +1404,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl "Ice shelf area in cell", "m2") call register_restart_field(ISS%h_shelf, "h_shelf", .true., CS%restart_CSp, & "ice sheet/shelf thickness", "m") + call register_restart_field(US%m_to_Z_restart, "m_to_Z", .false., CS%restart_CSp, & + "Height unit conversion factor", "Z meter-1") if (CS%active_shelf_dynamics) then call register_restart_field(ISS%hmask, "h_mask", .true., CS%restart_CSp, & "ice sheet/shelf thickness mask" ,"none") @@ -1418,12 +1437,12 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if (new_sim) then ! new simulation, initialize ice thickness as in the static case - call initialize_ice_thickness(ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, G, param_file) + call initialize_ice_thickness(ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, G, US, param_file) ! next make sure mass is consistent with thickness do j=G%jsd,G%jed ; do i=G%isd,G%ied if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2)) then - ISS%mass_shelf(i,j) = ISS%h_shelf(i,j)*CS%density_ice + ISS%mass_shelf(i,j) = ISS%h_shelf(i,j)*CS%rho_ice endif enddo ; enddo @@ -1446,12 +1465,12 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if (new_sim .and. (.not. (CS%override_shelf_movement .and. CS%mass_from_file))) then ! This model is initialized internally or from a file. - call initialize_ice_thickness(ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, G, param_file) + call initialize_ice_thickness(ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, G, US, param_file) ! next make sure mass is consistent with thickness do j=G%jsd,G%jed ; do i=G%isd,G%ied if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2)) then - ISS%mass_shelf(i,j) = ISS%h_shelf(i,j)*CS%density_ice + ISS%mass_shelf(i,j) = ISS%h_shelf(i,j)*CS%rho_ice endif enddo ; enddo @@ -1461,6 +1480,14 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: Restoring ice shelf from file.") call restore_state(dirs%input_filename, dirs%restart_input_dir, Time, & G, CS%restart_CSp) + + if ((US%m_to_Z_restart /= 0.0) .and. (US%m_to_Z_restart /= US%m_to_Z)) then + Z_rescale = US%m_to_Z / US%m_to_Z_restart + do j=G%jsc,G%jec ; do i=G%isc,G%iec + ISS%h_shelf(i,j) = Z_rescale * ISS%h_shelf(i,j) + enddo ; enddo + endif + endif ! .not. new_sim CS%Time = Time @@ -1497,7 +1524,9 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl endif if (shelf_mass_is_dynamic) & - call initialize_ice_shelf_dyn(param_file, Time, ISS, CS%dCS, G, diag, new_sim, solo_ice_sheet_in) + call initialize_ice_shelf_dyn(param_file, Time, ISS, CS%dCS, G, US, diag, new_sim, solo_ice_sheet_in) + + call fix_restart_unit_scaling(US) call get_param(param_file, mdl, "SAVE_INITIAL_CONDS", save_IC, & "If true, save the ice shelf initial conditions.", & @@ -1518,7 +1547,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl CS%id_shelf_mass = register_diag_field('ocean_model', 'shelf_mass', CS%diag%axesT1, CS%Time, & 'mass of shelf', 'kg/m^2') CS%id_h_shelf = register_diag_field('ocean_model', 'h_shelf', CS%diag%axesT1, CS%Time, & - 'ice shelf thickness', 'm') + 'ice shelf thickness', 'm', conversion=US%Z_to_m) CS%id_mass_flux = register_diag_field('ocean_model', 'mass_flux', CS%diag%axesT1,& CS%Time,'Total mass flux of freshwater across the ice-ocean interface.', 'kg/s') CS%id_melt = register_diag_field('ocean_model', 'melt', CS%diag%axesT1, CS%Time, & @@ -1626,7 +1655,7 @@ subroutine initialize_shelf_mass(G, param_file, CS, ISS, new_sim) case ("USER") call USER_initialize_shelf_mass(ISS%mass_shelf, ISS%area_shelf_h, & - ISS%h_shelf, ISS%hmask, G, CS%user_CS, param_file, new_sim_2) + ISS%h_shelf, ISS%hmask, G, CS%US, CS%user_CS, param_file, new_sim_2) case default ; call MOM_error(FATAL,"initialize_ice_shelf: "// & "Unrecognized ice shelf setup "//trim(config)) @@ -1652,7 +1681,7 @@ subroutine update_shelf_mass(G, CS, ISS, Time) ISS%hmask(i,j) = 0. if (ISS%mass_shelf(i,j) > 0.0) then ISS%area_shelf_h(i,j) = G%areaT(i,j) - ISS%h_shelf(i,j) = ISS%mass_shelf(i,j)/CS%density_ice + ISS%h_shelf(i,j) = ISS%mass_shelf(i,j) / CS%rho_ice ISS%hmask(i,j) = 1. endif enddo ; enddo @@ -1718,6 +1747,8 @@ subroutine solo_time_step(CS, time_step, nsteps, Time, min_time_step_in) real, optional, intent(in) :: min_time_step_in !< The minimum permitted time step in s. type(ocean_grid_type), pointer :: G => NULL() + type(unit_scale_type), pointer :: US => NULL() ! Pointer to a structure containing + ! various unit conversion factors type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe !! the ice-shelf state integer :: is, iec, js, jec, i, j @@ -1729,6 +1760,7 @@ subroutine solo_time_step(CS, time_step, nsteps, Time, min_time_step_in) ! coupled ice-ocean dynamics. G => CS%grid + US => CS%US ISS => CS%ISS is = G%isc ; iec = G%iec ; js = G%jsc ; jec = G%jec @@ -1767,7 +1799,7 @@ subroutine solo_time_step(CS, time_step, nsteps, Time, min_time_step_in) update_ice_vel = ((time_step_int > min_time_step) .or. (time_step_int >= time_step)) coupled_GL = .false. - call update_ice_shelf(CS%dCS, ISS, G, time_step_int, Time, must_update_vel=update_ice_vel) + call update_ice_shelf(CS%dCS, ISS, G, US, time_step_int, Time, must_update_vel=update_ice_vel) call enable_averaging(time_step,Time,CS%diag) if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, ISS%area_shelf_h, CS%diag) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index eea9ee322a..995301fcc8 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -18,6 +18,7 @@ module MOM_ice_shelf_dynamics use MOM_restart, only : register_restart_field, query_initialized use MOM_restart, only : MOM_restart_CS use MOM_time_manager, only : time_type, set_time +use MOM_unit_scaling, only : unit_scale_type, unit_scaling_init !MJH use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary use MOM_ice_shelf_state, only : ice_shelf_state use MOM_coms, only : reproducing_sum, sum_across_PEs, max_across_PEs, min_across_PEs @@ -51,9 +52,9 @@ module MOM_ice_shelf_dynamics real, pointer, dimension(:,:) :: u_face_mask_bdry => NULL() !< A duplicate copy of u_face_mask? real, pointer, dimension(:,:) :: v_face_mask_bdry => NULL() !< A duplicate copy of v_face_mask? real, pointer, dimension(:,:) :: u_flux_bdry_val => NULL() !< The ice volume flux into the cell through open boundary - !! u-faces (where u_face_mask=4), in m3 s-1??? + !! u-faces (where u_face_mask=4), in Z m2 s-1??? real, pointer, dimension(:,:) :: v_flux_bdry_val => NULL() !< The ice volume flux into the cell through open boundary - !! v-faces (where v_face_mask=4), in m3 s-1??? + !! v-faces (where v_face_mask=4), in Z m2 s-1??? ! needed where u_face_mask is equal to 4, similary for v_face_mask real, pointer, dimension(:,:) :: umask => NULL() !< u-mask on the actual degrees of freedom (B grid) !! 1=normal node, 3=inhomogeneous boundary node, @@ -67,7 +68,7 @@ module MOM_ice_shelf_dynamics !! in degC on corner-points (B grid) real, pointer, dimension(:,:) :: tmask => NULL() !< A mask on tracer points that is 1 where there is ice. real, pointer, dimension(:,:) :: ice_visc => NULL() !< Glen's law ice viscosity, perhaps in m. - real, pointer, dimension(:,:) :: thickness_bdry_val => NULL() !< The ice thickness at an inflowing boundary, in m. + real, pointer, dimension(:,:) :: thickness_bdry_val => NULL() !< The ice thickness at an inflowing boundary, in Z. real, pointer, dimension(:,:) :: u_bdry_val => NULL() !< The zonal ice velocity at inflowing boundaries in m/s??? real, pointer, dimension(:,:) :: v_bdry_val => NULL() !< The meridional ice velocity at inflowing boundaries in m/s??? real, pointer, dimension(:,:) :: h_bdry_val => NULL() !< The ice thickness at inflowing boundaries, in m. @@ -78,7 +79,7 @@ module MOM_ice_shelf_dynamics real, pointer, dimension(:,:) :: OD_rt => NULL() !< A running total for calculating OD_av. real, pointer, dimension(:,:) :: float_frac_rt => NULL() !< A running total for calculating float_frac. - real, pointer, dimension(:,:) :: OD_av => NULL() !< The time average open ocean depth, in m. + real, pointer, dimension(:,:) :: OD_av => NULL() !< The time average open ocean depth, in Z. real, pointer, dimension(:,:) :: float_frac => NULL() !< Fraction of the time a cell is "exposed", i.e. the column !! thickness is below a threshold. !### [if float_frac = 1 ==> grounded; obviously counterintuitive; might fix] @@ -123,7 +124,7 @@ module MOM_ice_shelf_dynamics real :: thresh_float_col_depth !< The water column depth over which the shelf if considered to be floating logical :: moving_shelf_front !< Specify whether to advance shelf front (and calve). logical :: calve_to_mask !< If true, calve off the ice shelf when it passes the edge of a mask. - real :: min_thickness_simple_calve !< min. ice shelf thickness criteria for calving, in m + real :: min_thickness_simple_calve !< min. ice shelf thickness criteria for calving, in Z real :: cg_tolerance !< The tolerance in the CG solver, relative to initial residual, that !! deterimnes when to stop the conguage gradient iterations. @@ -253,7 +254,7 @@ subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) end subroutine register_ice_shelf_dyn_restarts !> Initializes shelf model data, parameters and diagnostics -subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, diag, new_sim, solo_ice_sheet_in) +subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_sim, solo_ice_sheet_in) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(ocean_grid_type), pointer :: ocn_grid !< The calling ocean model's horizontal grid structure type(time_type), intent(inout) :: Time !< The clock that that will indicate the model time @@ -261,14 +262,18 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, diag, new_sim, !! the ice-shelf state type(ice_shelf_dyn_CS), pointer :: CS !< A pointer to the ice shelf dynamics control structure type(ocean_grid_type), intent(inout) :: G !< The grid type describing the ice shelf grid. + type(unit_scale_type), intent(in) :: US !< Pointer to a structure containing unit conversion factors type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate the diagnostic output. logical, intent(in) :: new_sim !< If true this is a new simulation, otherwise !! has been started from a restart file. logical, optional, intent(in) :: solo_ice_sheet_in !< If present, this indicates whether !! a solo ice-sheet driver. + ! Local variables + real :: Z_rescale ! A rescaling factor for heights from the representation in + ! a reastart fole to the internal representation in this run. !This include declares and sets the variable "version". -#include "version_variable.h" +# include "version_variable.h" character(len=200) :: config character(len=200) :: IC_file,filename,inputdir character(len=40) :: var_name @@ -364,7 +369,7 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, diag, new_sim, call get_param(param_file, mdl, "THRESH_FLOAT_COL_DEPTH", CS%thresh_float_col_depth, & "min ocean thickness to consider ice *floating*; \n"// & "will only be important with use of tides", & - units="m", default=1.e-3) + units="m", default=1.e-3, scale=US%m_to_Z) call get_param(param_file, mdl, "NONLIN_SOLVE_ERR_MODE", CS%nonlin_solve_err_mode, & "Choose whether nonlin error in vel solve is based on nonlinear \n"// & "residual (1) or relative change since last iteration (2)", default=1) @@ -382,7 +387,7 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, diag, new_sim, call get_param(param_file, mdl, "MIN_THICKNESS_SIMPLE_CALVE", & CS%min_thickness_simple_calve, & "Min thickness rule for the VERY simple calving law",& - units="m", default=0.0) + units="m", default=0.0, scale=US%m_to_Z) ! Allocate memory in the ice shelf dynamics control structure that was not ! previously allocated for registration for restarts. @@ -420,6 +425,13 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, diag, new_sim, ! Take additional initialization steps, for example of dependent variables. if (active_shelf_dynamics .and. .not.new_sim) then + if ((US%m_to_Z_restart /= 0.0) .and. (US%m_to_Z_restart /= US%m_to_Z)) then + Z_rescale = US%m_to_Z / US%m_to_Z_restart + do j=G%jsc,G%jec ; do i=G%isc,G%iec + CS%OD_av(i,j) = Z_rescale * CS%OD_av(i,j) + enddo ; enddo + endif + ! this is unfortunately necessary; if grid is not symmetric the boundary values ! of u and v are otherwise not set till the end of the first linear solve, and so ! viscosity is not calculated correctly. @@ -475,8 +487,8 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, diag, new_sim, if (new_sim) then call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") - call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf) - call ice_shelf_solve_outer(CS, ISS, G, CS%u_shelf, CS%v_shelf, iters, Time) + call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) + call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf,CS%u_shelf,CS%diag) if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf,CS%v_shelf,CS%diag) @@ -496,9 +508,9 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, diag, new_sim, CS%id_float_frac = register_diag_field('ocean_model','ice_float_frac',CS%diag%axesT1, Time, & 'fraction of cell that is floating (sort of)', 'none') CS%id_col_thick = register_diag_field('ocean_model','col_thick',CS%diag%axesT1, Time, & - 'ocean column thickness passed to ice model', 'm') + 'ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) CS%id_OD_av = register_diag_field('ocean_model','OD_av',CS%diag%axesT1, Time, & - 'intermediate ocean column thickness passed to ice model', 'm') + 'intermediate ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) !CS%id_h_after_uflux = register_diag_field('ocean_model','h_after_uflux',CS%diag%axesh1, Time, & ! 'thickness after u flux ', 'none') !CS%id_h_after_vflux = register_diag_field('ocean_model','h_after_vflux',CS%diag%axesh1, Time, & @@ -516,25 +528,25 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, diag, new_sim, end subroutine initialize_ice_shelf_dyn -subroutine initialize_diagnostic_fields(CS, ISS, G, Time) +subroutine initialize_diagnostic_fields(CS, ISS, G, US, Time) type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + type(unit_scale_type), intent(in) :: US !< Pointer to a structure containing unit conversion factors type(time_type), intent(in) :: Time !< The current model time integer :: i, j, iters, isd, ied, jsd, jed - real :: rhoi, rhow, OD + real :: rhoi_rhow, OD type(time_type) :: dummy_time - rhoi = CS%density_ice - rhow = CS%density_ocean_avg + rhoi_rhow = CS%density_ice / CS%density_ocean_avg dummy_time = set_time(0,0) isd=G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed do j=jsd,jed do i=isd,ied - OD = G%Zd_to_m*G%bathyT(i,j) - rhoi/rhow * ISS%h_shelf(i,j) + OD = G%bathyT(i,j) - rhoi_rhow * ISS%h_shelf(i,j) if (OD >= 0) then ! ice thickness does not take up whole ocean column -> floating CS%OD_av(i,j) = OD @@ -546,7 +558,7 @@ subroutine initialize_diagnostic_fields(CS, ISS, G, Time) enddo enddo - call ice_shelf_solve_outer(CS, ISS, G, CS%u_shelf, CS%v_shelf, iters, dummy_time) + call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, dummy_time) end subroutine initialize_diagnostic_fields @@ -583,11 +595,12 @@ end function ice_time_step_CFL !> This subroutine updates the ice shelf velocities, mass, stresses and properties due to the !! ice shelf dynamics. -subroutine update_ice_shelf(CS, ISS, G, time_step, Time, ocean_mass, coupled_grounding, must_update_vel) +subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled_grounding, must_update_vel) type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + type(unit_scale_type), intent(in) :: US !< Pointer to a structure containing unit conversion factors real, intent(in) :: time_step !< time step in sec type(time_type), intent(in) :: Time !< The current model time real, dimension(SZDI_(G),SZDJ_(G)), & @@ -611,16 +624,16 @@ subroutine update_ice_shelf(CS, ISS, G, time_step, Time, ocean_mass, coupled_gro if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) update_ice_vel = .true. if (coupled_GL) then - call update_OD_ffrac(CS, G, ocean_mass, update_ice_vel) + call update_OD_ffrac(CS, G, US, ocean_mass, update_ice_vel) elseif (update_ice_vel) then - call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf) + call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) endif if (update_ice_vel) then - call ice_shelf_solve_outer(CS, ISS, G, CS%u_shelf, CS%v_shelf, iters, Time) + call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf, iters, Time) endif - call ice_shelf_temp(CS, ISS, G, time_step, ISS%water_flux, Time) + call ice_shelf_temp(CS, ISS, G, US, time_step, ISS%water_flux, Time) if (update_ice_vel) then call enable_averaging(CS%elapsed_velocity_time, Time, CS%diag) @@ -629,7 +642,7 @@ subroutine update_ice_shelf(CS, ISS, G, time_step, Time, ocean_mass, coupled_gro if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf,CS%v_shelf,CS%diag) if (CS%id_t_shelf > 0) call post_data(CS%id_t_shelf,CS%t_shelf,CS%diag) if (CS%id_float_frac > 0) call post_data(CS%id_float_frac,CS%float_frac,CS%diag) - if (CS%id_OD_av >0) call post_data(CS%id_OD_av,CS%OD_av,CS%diag) + if (CS%id_OD_av >0) call post_data(CS%id_OD_av, CS%OD_av,CS%diag) if (CS%id_u_mask > 0) call post_data(CS%id_u_mask,CS%umask,CS%diag) if (CS%id_v_mask > 0) call post_data(CS%id_v_mask,CS%vmask,CS%diag) @@ -691,10 +704,10 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) ! o--- (3) ---o ! - real, dimension(SZDI_(G),SZDJ_(G)) :: h_after_uflux, h_after_vflux + real, dimension(SZDI_(G),SZDJ_(G)) :: h_after_uflux, h_after_vflux ! Ice thicknesses in Z. real, dimension(SZDI_(G),SZDJ_(G),4) :: flux_enter integer :: isd, ied, jsd, jed, i, j, isc, iec, jsc, jec - real :: rho, spy, thick_bd + real :: rho, spy rho = CS%density_ice spy = 365 * 86400 ! seconds per year; is there a global constant for this? No - it is dependent upon a calendar. @@ -707,14 +720,9 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) h_after_vflux(:,:) = 0.0 ! call MOM_mesg("MOM_ice_shelf.F90: ice_shelf_advect called") - do j=jsd,jed - do i=isd,ied - thick_bd = CS%thickness_bdry_val(i,j) - if (thick_bd /= 0.0) then - ISS%h_shelf(i,j) = CS%thickness_bdry_val(i,j) - endif - enddo - enddo + do j=jsd,jed ; do i=isd,ied ; if (CS%thickness_bdry_val(i,j) /= 0.0) then + ISS%h_shelf(i,j) = CS%thickness_bdry_val(i,j) + endif ; enddo ; enddo call ice_shelf_advect_thickness_x(CS, G, time_step/spy, ISS%hmask, ISS%h_shelf, h_after_uflux, flux_enter) @@ -757,11 +765,12 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) end subroutine ice_shelf_advect -subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) +subroutine ice_shelf_solve_outer(CS, ISS, G, US, u, v, iters, time) type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + type(unit_scale_type), intent(in) :: US !< Pointer to a structure containing unit conversion factors real, dimension(SZDIB_(G),SZDJB_(G)), & intent(inout) :: u !< The zonal ice shelf velocity at vertices, in m/year real, dimension(SZDIB_(G),SZDJB_(G)), & @@ -771,13 +780,14 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) real, dimension(SZDIB_(G),SZDJB_(G)) :: TAUDX, TAUDY, u_prev_iterate, v_prev_iterate, & u_bdry_cont, v_bdry_cont, Au, Av, err_u, err_v, & - u_last, v_last, H_node + u_last, v_last + real, dimension(SZDIB_(G),SZDJB_(G)) :: H_node ! Ice shelf thickness at corners, in Z. real, dimension(SZDI_(G),SZDJ_(G)) :: float_cond ! An array indicating where the ice ! shelf is floating: 0 if floating, 1 if not. character(len=160) :: mesg ! The text of an error message integer :: conv_flag, i, j, k,l, iter integer :: isdq, iedq, jsdq, jedq, isd, ied, jsd, jed, isumstart, jsumstart, nodefloat, nsub - real :: err_max, err_tempu, err_tempv, err_init, area, max_vel, tempu, tempv, rhoi, rhow + real :: err_max, err_tempu, err_tempv, err_init, area, max_vel, tempu, tempv, rhoi_rhow real, pointer, dimension(:,:,:,:) :: Phi => NULL() real, pointer, dimension(:,:,:,:,:,:) :: Phisub => NULL() real, dimension(8,4) :: Phi_temp @@ -790,8 +800,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) isdq = G%isdB ; iedq = G%iedB ; jsdq = G%jsdB ; jedq = G%jedB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - rhoi = CS%density_ice - rhow = CS%density_ocean_avg + rhoi_rhow = CS%density_ice / CS%density_ocean_avg TAUDX(:,:) = 0.0 ; TAUDY(:,:) = 0.0 u_bdry_cont(:,:) = 0.0 ; v_bdry_cont(:,:) = 0.0 @@ -809,7 +818,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) ! Include the edge if tile is at the southern bdry; Should add a test to avoid this if reentrant. if (G%jsc+G%jdg_offset==G%jsg) jsumstart = G%jscB - call calc_shelf_driving_stress(CS, ISS, G, TAUDX, TAUDY, CS%OD_av) + call calc_shelf_driving_stress(CS, ISS, G, US, TAUDX, TAUDY, CS%OD_av) ! this is to determine which cells contain the grounding line, ! the criterion being that the cell is ice-covered, with some nodes @@ -829,7 +838,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) do k=0,1 do l=0,1 if ((ISS%hmask(i,j) == 1) .and. & - (rhoi/rhow * H_node(i-1+k,j-1+l) - G%Zd_to_m*G%bathyT(i,j) <= 0)) then + (rhoi_rhow * H_node(i-1+k,j-1+l) - G%bathyT(i,j) <= 0)) then nodefloat = nodefloat + 1 endif enddo @@ -870,7 +879,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) Phi(i,j,:,:) = Phi_temp enddo ; enddo - call calc_shelf_visc(CS, ISS, G, u, v) + call calc_shelf_visc(CS, ISS, G, US, u, v) call pass_var(CS%ice_visc, G%domain) call pass_var(CS%taub_beta_eff, G%domain) @@ -883,13 +892,13 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) call apply_boundary_values(CS, ISS, G, time, Phisub, H_node, CS%ice_visc, & CS%taub_beta_eff, float_cond, & - rhoi/rhow, u_bdry_cont, v_bdry_cont) + rhoi_rhow, u_bdry_cont, v_bdry_cont) Au(:,:) = 0.0 ; Av(:,:) = 0.0 call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & - CS%ice_visc, float_cond, G%Zd_to_m*G%bathyT(:,:), CS%taub_beta_eff, G%areaT, & - G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) + CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, G%areaT, & + G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi_rhow) err_init = 0 ; err_tempu = 0; err_tempv = 0 do j=jsumstart,G%jecB @@ -928,7 +937,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) write(mesg,*) "ice_shelf_solve_outer: linear solve done in ",iters," iterations" call MOM_mesg(mesg, 5) - call calc_shelf_visc(CS, ISS, G, u, v) + call calc_shelf_visc(CS, ISS, G, US, u, v) call pass_var(CS%ice_visc, G%domain) call pass_var(CS%taub_beta_eff, G%domain) @@ -942,13 +951,13 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) call apply_boundary_values(CS, ISS, G, time, Phisub, H_node, CS%ice_visc, & CS%taub_beta_eff, float_cond, & - rhoi/rhow, u_bdry_cont, v_bdry_cont) + rhoi_rhow, u_bdry_cont, v_bdry_cont) Au(:,:) = 0 ; Av(:,:) = 0 call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & - CS%ice_visc, float_cond, G%Zd_to_m*G%bathyT(:,:), CS%taub_beta_eff, G%areaT, & - G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi/rhow) + CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, G%areaT, & + G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi_rhow) err_max = 0 @@ -1034,7 +1043,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c intent(in) :: taudy !< The y-direction driving stress, in ??? real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: H_node !< The ice shelf thickness at nodal (corner) - !! points, in m. + !! points, in Z. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: float_cond !< An array indicating where the ice !! shelf is floating: 0 if floating, 1 if not. @@ -1111,7 +1120,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c call pass_vector(DIAGu, DIAGv, G%domain, TO_ALL, BGRID_NE) call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, hmask, & - H_node, CS%ice_visc, float_cond, G%Zd_to_m*G%bathyT(:,:), CS%taub_beta_eff, & + H_node, CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, & G%areaT, G, isc-1, iec+1, jsc-1, jec+1, CS%density_ice/CS%density_ocean_avg) call pass_vector(Au, Av, G%domain, TO_ALL, BGRID_NE) @@ -1182,7 +1191,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c Au(:,:) = 0 ; Av(:,:) = 0 call CG_action(Au, Av, Du, Dv, Phi, Phisub, CS%umask, CS%vmask, hmask, & - H_node, CS%ice_visc, float_cond, G%Zd_to_m*G%bathyT(:,:), CS%taub_beta_eff, & + H_node, CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, & G%areaT, G, is, ie, js, je, CS%density_ice/CS%density_ocean_avg) ! Au, Av valid region moves in by 1 @@ -1412,13 +1421,13 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: h0 !< The initial ice shelf thicknesses in m. + intent(in) :: h0 !< The initial ice shelf thicknesses in Z. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_after_uflux !< The ice shelf thicknesses after - !! the zonal mass fluxes, in m. + !! the zonal mass fluxes, in Z. real, dimension(SZDI_(G),SZDJ_(G),4), & intent(inout) :: flux_enter !< The ice volume flux into the cell - !! through the 4 cell boundaries, in m3 + !! through the 4 cell boundaries, in Z m2 ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells @@ -1441,7 +1450,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied integer :: i_off, j_off logical :: at_east_bdry, at_west_bdry, one_off_west_bdry, one_off_east_bdry - real, dimension(-2:2) :: stencil + real, dimension(-2:2) :: stencil ! Thicknesses in Z. real :: u_face, & ! positive if out flux_diff_cell, phi, dxh, dyh, dxdyh character (len=1) :: debug_str @@ -1454,7 +1463,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl if (((j+j_off) <= G%domain%njglobal+G%domain%njhalo) .AND. & ((j+j_off) >= G%domain%njhalo+1)) then ! based on mehmet's code - only if btw north & south boundaries - stencil(:) = -1 + stencil(:) = -1. ! if (i+i_off == G%domain%nihalo+G%domain%nihalo) do i=is,ie @@ -1512,7 +1521,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl ! (o.w. flux would most likely be out of cell) ! but h(i-2) is not - flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step / dxdyh * stencil(-1) + flux_diff_cell = flux_diff_cell + ABS(u_face) * (dyh * time_step / dxdyh) * stencil(-1) endif @@ -1523,7 +1532,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl (stencil(0) - phi * (stencil(0)-stencil(-1))/2) else - flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * stencil(0) + flux_diff_cell = flux_diff_cell - ABS(u_face) * (dyh * time_step / dxdyh) * stencil(0) if ((hmask(i-1,j) == 0) .OR. (hmask(i-1,j) == 2)) then flux_enter(i-1,j,2) = ABS(u_face) * dyh * time_step * stencil(0) @@ -1561,7 +1570,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl ! (o.w. flux would most likely be out of cell) ! but h(i+2) is not - flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step / dxdyh * stencil(1) + flux_diff_cell = flux_diff_cell + ABS(u_face) * (dyh * time_step / dxdyh) * stencil(1) endif @@ -1577,7 +1586,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl ! (o.w. flux would most likely be out of cell) ! but h(i+2) is not - flux_diff_cell = flux_diff_cell - ABS(u_face) * dyh * time_step / dxdyh * stencil(0) + flux_diff_cell = flux_diff_cell - ABS(u_face) * (dyh * time_step / dxdyh) * stencil(0) if ((hmask(i+1,j) == 0) .OR. (hmask(i+1,j) == 2)) then flux_enter(i+1,j,1) = ABS(u_face) * dyh * time_step * stencil(0) @@ -1643,13 +1652,13 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: h_after_uflux !< The ice shelf thicknesses after - !! the zonal mass fluxes, in m. + !! the zonal mass fluxes, in Z. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_after_vflux !< The ice shelf thicknesses after - !! the meridional mass fluxes, in m. + !! the meridional mass fluxes, in Z. real, dimension(SZDI_(G),SZDJ_(G),4), & intent(inout) :: flux_enter !< The ice volume flux into the cell - !! through the 4 cell boundaries, in m3 + !! through the 4 cell boundaries, in Z m2 ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells @@ -1672,7 +1681,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied integer :: i_off, j_off logical :: at_north_bdry, at_south_bdry, one_off_west_bdry, one_off_east_bdry - real, dimension(-2:2) :: stencil + real, dimension(-2:2) :: stencil ! Thicknesses in Z real :: v_face, & ! positive if out flux_diff_cell, phi, dxh, dyh, dxdyh character(len=1) :: debug_str @@ -1738,7 +1747,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, else ! h(j-1) is valid ! (o.w. flux would most likely be out of cell) ! but h(j-2) is not - flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step / dxdyh * stencil(-1) + flux_diff_cell = flux_diff_cell + ABS(v_face) * (dxh * time_step / dxdyh) * stencil(-1) endif elseif (v_face < 0) then !flux is out of cell - we need info from h(j-1), h(j+1) if available @@ -1748,7 +1757,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * & (stencil(0) - phi * (stencil(0)-stencil(-1))/2) else - flux_diff_cell = flux_diff_cell - ABS(v_face) * dxh * time_step / dxdyh * stencil(0) + flux_diff_cell = flux_diff_cell - ABS(v_face) * (dxh * time_step / dxdyh) * stencil(0) if ((hmask(i,j-1) == 0) .OR. (hmask(i,j-1) == 2)) then flux_enter(i,j-1,4) = ABS(v_face) * dyh * time_step * stencil(0) @@ -1850,7 +1859,7 @@ subroutine shelf_advance_front(CS, ISS, G, flux_enter) type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G),4), & intent(inout) :: flux_enter !< The ice volume flux into the cell - !! through the 4 cell boundaries, in m3 + !! through the 4 cell boundaries, in Z m2 ! in this subroutine we go through the computational cells only and, if they are empty or partial cells, ! we find the reference thickness and update the shelf mass and partial area fraction and the hmask if necessary @@ -2025,13 +2034,13 @@ end subroutine shelf_advance_front subroutine ice_shelf_min_thickness_calve(G, h_shelf, area_shelf_h, hmask, thickness_calve) type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< The ice shelf thickness, in m. + intent(inout) :: h_shelf !< The ice shelf thickness, in Z. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf - real, intent(in) :: thickness_calve !< The thickness at which to trigger calving, in m. + real, intent(in) :: thickness_calve !< The thickness at which to trigger calving, in Z. integer :: i,j @@ -2039,7 +2048,7 @@ subroutine ice_shelf_min_thickness_calve(G, h_shelf, area_shelf_h, hmask, thickn do i=G%isd,G%ied ! if ((h_shelf(i,j) < CS%thickness_calve) .and. (hmask(i,j) == 1) .and. & ! (CS%float_frac(i,j) == 0.0)) then - if ((h_shelf(i,j) < thickness_calve) .and. (area_shelf_h(i,j) > 0.)) then + if ((h_shelf(i,j) < thickness_calve) .and. (area_shelf_h(i,j) > 0.)) then h_shelf(i,j) = 0.0 area_shelf_h(i,j) = 0.0 hmask(i,j) = 0.0 @@ -2052,7 +2061,7 @@ end subroutine ice_shelf_min_thickness_calve subroutine calve_to_mask(G, h_shelf, area_shelf_h, hmask, calve_mask) type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< The ice shelf thickness, in m. + intent(inout) :: h_shelf !< The ice shelf thickness, in Z. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. real, dimension(SZDI_(G),SZDJ_(G)), & @@ -2074,13 +2083,14 @@ subroutine calve_to_mask(G, h_shelf, area_shelf_h, hmask, calve_mask) end subroutine calve_to_mask -subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) +subroutine calc_shelf_driving_stress(CS, ISS, G, US, TAUD_X, TAUD_Y, OD) type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe - !! the ice-shelf state + !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + type(unit_scale_type), intent(in) :: US !< Pointer to a structure containing unit conversion factors real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: OD !< ocean floor depth at tracer points, in m + intent(in) :: OD !< ocean floor depth at tracer points, in Z real, dimension(SZDIB_(G),SZDJB_(G)), & intent(inout) :: TAUD_X !< X-direction driving stress at q-points real, dimension(SZDIB_(G),SZDJB_(G)), & @@ -2097,8 +2107,8 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) ! "average" ocean depth -- and is needed to find surface elevation ! (it is assumed that base_ice = bed + OD) - real, dimension(SIZE(OD,1),SIZE(OD,2)) :: S, & ! surface elevation - BASE ! basal elevation of shelf/stream + real, dimension(SIZE(OD,1),SIZE(OD,2)) :: S, & ! surface elevation, in Z + BASE ! basal elevation of shelf/stream, in Z real :: rho, rhow, sx, sy, neumann_val, dxh, dyh, dxdyh, grav @@ -2118,12 +2128,12 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) rho = CS%density_ice rhow = CS%density_ocean_avg - grav = CS%g_Earth + grav = US%Z_to_m**2 * CS%g_Earth ! prelim - go through and calculate S ! or is this faster? - BASE(:,:) = -G%Zd_to_m*G%bathyT(:,:) + OD(:,:) + BASE(:,:) = -G%bathyT(:,:) + OD(:,:) S(:,:) = BASE(:,:) + ISS%h_shelf(:,:) do j=jsc-1,jec+1 @@ -2148,23 +2158,23 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) if (ISS%hmask(i-1,j) == 1) then sx = (S(i,j)-S(i-1,j))/dxh else - sx=0 + sx = 0 endif else ! interior if (ISS%hmask(i+1,j) == 1) then cnt = cnt+1 - sx = S(i+1,j) + sx = S(i+1,j) else sx = S(i,j) - endif - if (ISS%hmask(i-1,j) == 1) then + endif + if (ISS%hmask(i-1,j) == 1) then cnt = cnt+1 - sx = sx - S(i-1,j) + sx = sx - S(i-1,j) else sx = sx - S(i,j) - endif + endif if (cnt == 0) then - sx=0 + sx = 0 else sx = sx / (cnt * dxh) endif @@ -2199,7 +2209,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) sy = sy - S(i,j) endif if (cnt == 0) then - sy=0 + sy = 0 else sy = sy / (cnt * dyh) endif @@ -2222,9 +2232,9 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, TAUD_X, TAUD_Y, OD) taud_y(I,J) = taud_y(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * dxdyh if (CS%float_frac(i,j) == 1) then - neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j) ** 2 - rhow * (G%Zd_to_m*G%bathyT(i,j)) ** 2) + neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * G%bathyT(i,j)**2) else - neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j) ** 2 + neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2 endif @@ -2273,8 +2283,8 @@ subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf - real, intent(in) :: input_flux !< The integrated inward ice thickness flux in m3 s-1. - real, intent(in) :: input_thick !< The ice thickness at boundaries, in m. + real, intent(in) :: input_flux !< The integrated inward ice thickness flux in Z m2 s-1. + real, intent(in) :: input_thick !< The ice thickness at boundaries, in Z. logical, optional, intent(in) :: new_sim !< If present and false, this run is being restarted ! this will be a per-setup function. the boundary values of thickness and velocity @@ -2362,7 +2372,7 @@ subroutine CG_action(uret, vret, u, v, Phi, Phisub, umask, vmask, hmask, H_node, !! meridional flow at the corner point real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: H_node !< The ice shelf thickness at nodal (corner) - !! points, in m. + !! points, in Z. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf @@ -2374,7 +2384,7 @@ subroutine CG_action(uret, vret, u, v, Phi, Phisub, umask, vmask, hmask, H_node, intent(in) :: float_cond !< An array indicating where the ice !! shelf is floating: 0 if floating, 1 if not. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points, in m. + intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points, in Z. real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: beta !< A field related to the nonlinear part of the !! "linearized" basal stress. The exact form and @@ -2530,8 +2540,8 @@ subroutine CG_action(uret, vret, u, v, Phi, Phisub, umask, vmask, hmask, H_node, if (float_cond(i,j) == 1) then Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = bathyT(i,j) Ucell(:,:) = u(i-1:i,j-1:j) ; Vcell(:,:) = v(i-1:i,j-1:j) ; Hcell(:,:) = H_node(i-1:i,j-1:j) - call CG_action_subgrid_basal & - (Phisub, Hcell, Ucell, Vcell, area, basel, dens_ratio, Usubcontr, Vsubcontr) + call CG_action_subgrid_basal(Phisub, Hcell, Ucell, Vcell, area, basel, & + dens_ratio, Usubcontr, Vsubcontr) do iphi=1,2 ; do jphi=1,2 if (umask(i-2+iphi,j-2+jphi) == 1) then uret(i-2+iphi,j-2+jphi) = uret(i-2+iphi,j-2+jphi) + Usubcontr (iphi,jphi) * beta(i,j) @@ -2551,11 +2561,11 @@ subroutine CG_action_subgrid_basal(Phisub, H, U, V, DXDYH, bathyT, dens_ratio, U real, dimension(:,:,:,:,:,:), & intent(in) :: Phisub !< Quadrature structure weights at subgridscale !! locations for finite element calculations - real, dimension(2,2), intent(in) :: H !< The ice shelf thickness at nodal (corner) points, in m. + real, dimension(2,2), intent(in) :: H !< The ice shelf thickness at nodal (corner) points, in Z. real, dimension(2,2), intent(in) :: U !< The zonal ice shelf velocity at vertices, in m/year real, dimension(2,2), intent(in) :: V !< The meridional ice shelf velocity at vertices, in m/year real, intent(in) :: DXDYH !< The tracer cell area, in m2 - real, intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points, in m. + real, intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points, in Z. real, intent(in) :: dens_ratio !< The density of ice divided by the density !! of seawater, nondimensional real, dimension(2,2), intent(inout) :: Ucontr !< A field related to the subgridscale contributions to @@ -2615,7 +2625,7 @@ subroutine matrix_diagonal(CS, G, float_cond, H_node, nu, beta, hmask, dens_rati !! shelf is floating: 0 if floating, 1 if not. real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: H_node !< The ice shelf thickness at nodal - !! (corner) points, in m. + !! (corner) points, in Z. real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: nu !< A field related to the ice viscosity from Glen's !! flow law. The exact form and units depend on the @@ -2738,10 +2748,9 @@ subroutine matrix_diagonal(CS, G, float_cond, H_node, nu, beta, hmask, dens_rati enddo ; enddo enddo ; enddo if (float_cond(i,j) == 1) then - Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%Zd_to_m*G%bathyT(i,j) + Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%bathyT(i,j) Hcell(:,:) = H_node(i-1:i,j-1:j) - call CG_diagonal_subgrid_basal & - (Phisub, Hcell, dxdyh, basel, dens_ratio, Usubcontr, Vsubcontr) + call CG_diagonal_subgrid_basal(Phisub, Hcell, dxdyh, basel, dens_ratio, Usubcontr, Vsubcontr) do iphi=1,2 ; do jphi=1,2 if (CS%umask(i-2+iphi,j-2+jphi) == 1) then u_diagonal(i-2+iphi,j-2+jphi) = u_diagonal(i-2+iphi,j-2+jphi) + Usubcontr(iphi,jphi) * beta(i,j) @@ -2758,9 +2767,9 @@ subroutine CG_diagonal_subgrid_basal (Phisub, H_node, DXDYH, bathyT, dens_ratio, intent(in) :: Phisub !< Quadrature structure weights at subgridscale !! locations for finite element calculations real, dimension(2,2), intent(in) :: H_node !< The ice shelf thickness at nodal (corner) - !! points, in m + !! points, in Z real, intent(in) :: DXDYH !< The tracer cell area, in m2 - real, intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points, in m + real, intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points, in Z real, intent(in) :: dens_ratio !< The density of ice divided by the density !! of seawater, nondimensional real, dimension(2,2), intent(inout) :: Ucontr !< A field related to the subgridscale contributions to @@ -2804,7 +2813,7 @@ subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, flo !! locations for finite element calculations real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: H_node !< The ice shelf thickness at nodal - !! (corner) points, in m. + !! (corner) points, in Z. real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: nu !< A field related to the ice viscosity from Glen's !! flow law. The exact form and units depend on the @@ -2953,11 +2962,11 @@ subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, flo enddo ; enddo if (float_cond(i,j) == 1) then - Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%Zd_to_m*G%bathyT(i,j) + Usubcontr = 0.0 ; Vsubcontr = 0.0 ; basel = G%bathyT(i,j) Ucell(:,:) = CS%u_bdry_val(i-1:i,j-1:j) ; Vcell(:,:) = CS%v_bdry_val(i-1:i,j-1:j) Hcell(:,:) = H_node(i-1:i,j-1:j) - call CG_action_subgrid_basal & - (Phisub, Hcell, Ucell, Vcell, dxdyh, basel, dens_ratio, Usubcontr, Vsubcontr) + call CG_action_subgrid_basal(Phisub, Hcell, Ucell, Vcell, dxdyh, basel, & + dens_ratio, Usubcontr, Vsubcontr) do iphi=1,2 ; do jphi = 1,2 if (CS%umask(i-2+iphi,j-2+jphi) == 1) then u_bdry_contr(i-2+iphi,j-2+jphi) = u_bdry_contr(i-2+iphi,j-2+jphi) + & @@ -2976,11 +2985,12 @@ end subroutine apply_boundary_values !> Update depth integrated viscosity, based on horizontal strain rates, and also update the !! nonlinear part of the basal traction. -subroutine calc_shelf_visc(CS, ISS, G, u, v) +subroutine calc_shelf_visc(CS, ISS, G, US, u, v) type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + type(unit_scale_type), intent(in) :: US !< Pointer to a structure containing unit conversion factors real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & intent(inout) :: u !< The zonal ice shelf velocity, in m/year. real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & @@ -3023,7 +3033,7 @@ subroutine calc_shelf_visc(CS, ISS, G, u, v) CS%ice_visc(i,j) = .5 * A**(-1/n) * & (ux**2+vy**2+ux*vy+0.25*(uy+vx)**2+eps_min**2) ** ((1-n)/(2*n)) * & - ISS%h_shelf(i,j) + US%Z_to_m*ISS%h_shelf(i,j) umid = (u(i,j) + u(i,j-1) + u(i-1,j) + u(i-1,j-1))/4 vmid = (v(i,j) + v(i,j-1) + v(i-1,j) + v(i-1,j-1))/4 @@ -3035,9 +3045,10 @@ subroutine calc_shelf_visc(CS, ISS, G, u, v) end subroutine calc_shelf_visc -subroutine update_OD_ffrac(CS, G, ocean_mass, find_avg) +subroutine update_OD_ffrac(CS, G, US, ocean_mass, find_avg) type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + type(unit_scale_type), intent(in) :: US !< Pointer to a structure containing unit conversion factors real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: ocean_mass !< The mass per unit area of the ocean in kg m-2. logical, intent(in) :: find_avg !< If true, find the average of OD and ffrac, and @@ -3047,12 +3058,12 @@ subroutine update_OD_ffrac(CS, G, ocean_mass, find_avg) real :: I_rho_ocean real :: I_counter - I_rho_ocean = 1.0/CS%density_ocean_avg + I_rho_ocean = 1.0 / (US%Z_to_m*CS%density_ocean_avg) isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec do j=jsc,jec ; do i=isc,iec - CS%OD_rt(i,j) = CS%OD_rt(i,j) + ocean_mass(i,j)*I_rho_ocean + CS%OD_rt(i,j) = CS%OD_rt(i,j) + ocean_mass(i,j)*I_rho_ocean if (ocean_mass(i,j)*I_rho_ocean > CS%thresh_float_col_depth) then CS%float_frac_rt(i,j) = CS%float_frac_rt(i,j) + 1.0 endif @@ -3076,20 +3087,19 @@ end subroutine update_OD_ffrac subroutine update_OD_ffrac_uncoupled(CS, G, h_shelf) type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure - type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: h_shelf !< the thickness of the ice shelf in m + intent(in) :: h_shelf !< the thickness of the ice shelf in Z - integer :: i, j, iters, isd, ied, jsd, jed - real :: rhoi, rhow, OD + integer :: i, j, iters, isd, ied, jsd, jed + real :: rhoi_rhow, OD - rhoi = CS%density_ice - rhow = CS%density_ocean_avg + rhoi_rhow = CS%density_ice / CS%density_ocean_avg isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed do j=jsd,jed do i=isd,ied - OD = G%Zd_to_m*G%bathyT(i,j) - rhoi/rhow * h_shelf(i,j) + OD = G%bathyT(i,j) - rhoi_rhow * h_shelf(i,j) if (OD >= 0) then ! ice thickness does not take up whole ocean column -> floating CS%OD_av(i,j) = OD @@ -3398,13 +3408,13 @@ end subroutine update_velocity_masks subroutine interpolate_H_to_B(G, h_shelf, hmask, H_node) type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: h_shelf !< The ice shelf thickness at tracer points, in m. + intent(in) :: h_shelf !< The ice shelf thickness at tracer points, in Z. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDIB_(G),SZDJB_(G)), & intent(inout) :: H_node !< The ice shelf thickness at nodal (corner) - !! points, in m. + !! points, in Z. integer :: i, j, isc, iec, jsc, jec, num_h, k, l real :: summ @@ -3460,11 +3470,12 @@ end subroutine ice_shelf_dyn_end !> This subroutine updates the vertically averaged ice shelf temperature. -subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) +subroutine ice_shelf_temp(CS, ISS, G, US, time_step, melt_rate, Time) type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + type(unit_scale_type), intent(in) :: US !< Pointer to a structure containing unit conversion factors real, intent(in) :: time_step !< The time step for this update, in s. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: melt_rate !< basal melt rate in kg/m^2/s @@ -3481,7 +3492,7 @@ subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) ! t_after_vflux - similar ! ! This subroutine takes the velocity (on the Bgrid) and timesteps -! (HT)_t = - div (uHT) + (adot Tsurd -bdot Tbot) once and then calculates T=HT/H +! (HT)_t = - div (uHT) + (adot Tsurf -bdot Tbot) once and then calculates T=HT/H ! ! The flux overflows are included here. That is because they will be used to advect 3D scalars ! into partial cells @@ -3516,7 +3527,7 @@ subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) rho = CS%density_ice spy = 365 * 86400 ! seconds per year; is there a global constant for this? No - it is dependent upon a calendar. - adot = 0.1/spy ! for now adot and Tsurf are defined here adot=surf acc 0.1m/yr, Tsurf=-20oC, vary them later + adot = 0.1*US%m_to_Z/spy ! for now adot and Tsurf are defined here adot=surf acc 0.1m/yr, Tsurf=-20oC, vary them later Tsurf = -20.0 isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -3531,14 +3542,14 @@ subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) t_bd = CS%t_bdry_val(i,j) ! if (ISS%hmask(i,j) > 1) then if ((ISS%hmask(i,j) == 3) .or. (ISS%hmask(i,j) == -2)) then - CS%t_shelf(i,j) = CS%t_bdry_val(i,j) + CS%t_shelf(i,j) = CS%t_bdry_val(i,j) endif enddo enddo do j=jsd,jed do i=isd,ied - TH(i,j) = CS%t_shelf(i,j)*ISS%h_shelf(i,j) + TH(i,j) = CS%t_shelf(i,j)*ISS%h_shelf(i,j) enddo enddo @@ -3557,7 +3568,7 @@ subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) do i=isd,ied ! if (ISS%hmask(i,j) == 1) then if (ISS%h_shelf(i,j) > 0.0) then - CS%t_shelf(i,j) = th_after_vflux(i,j)/ISS%h_shelf(i,j) + CS%t_shelf(i,j) = th_after_vflux(i,j)/(ISS%h_shelf(i,j)) else CS%t_shelf(i,j) = -10.0 endif @@ -3579,8 +3590,8 @@ subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) do i=isc,iec if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2)) then if (ISS%h_shelf(i,j) > 0.0) then -! CS%t_shelf(i,j) = CS%t_shelf(i,j) + time_step*(adot*Tsurf -melt_rate(i,j)*ISS%tfreeze(i,j))/ISS%h_shelf(i,j) - CS%t_shelf(i,j) = CS%t_shelf(i,j) + time_step*(adot*Tsurf -3/spy*ISS%tfreeze(i,j))/ISS%h_shelf(i,j) +! CS%t_shelf(i,j) = CS%t_shelf(i,j) + time_step*(adot*Tsurf - US%m_to_Z*melt_rate(i,j)*ISS%tfreeze(i,j))/(ISS%h_shelf(i,j)) + CS%t_shelf(i,j) = CS%t_shelf(i,j) + time_step*(adot*Tsurf - (3.0*US%m_to_Z/spy)*ISS%tfreeze(i,j)) / ISS%h_shelf(i,j) else ! the ice is about to melt away ! in this case set thickness, area, and mask to zero @@ -3612,13 +3623,13 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: h0 !< The initial ice shelf thicknesses in m. + intent(in) :: h0 !< The initial ice shelf thicknesses in Z. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_after_uflux !< The ice shelf thicknesses after !! the zonal mass fluxes, in m. real, dimension(SZDI_(G),SZDJ_(G),4), & intent(inout) :: flux_enter !< The integrated temperature flux into - !! the cell through the 4 cell boundaries, in degC m3 + !! the cell through the 4 cell boundaries, in degC Z m2 ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells @@ -3690,9 +3701,6 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_flux_bdry_val(i-1,j) * & CS%t_bdry_val(i-1,j) / dxdyh -! assume no flux bc for temp -! flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_shelf(i,j)*CS%t_bdry_val(i-1,j) / dxdyh - else ! get u-velocity at center of left face @@ -3743,9 +3751,6 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_flux_bdry_val(i+1,j) *& CS%t_bdry_val(i+1,j)/ dxdyh -! assume no flux bc for temp -! flux_diff_cell = flux_diff_cell + dyh * time_step * CS%u_shelf(i,j)*CS%t_bdry_val(i+1,j)/ dxdyh - else u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) @@ -3806,8 +3811,6 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f CS%thickness_bdry_val(i+1,j) elseif (CS%u_face_mask(i-1,j) == 4.) then flux_enter(i,j,1) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j)*CS%t_bdry_val(i-1,j) -! flux_enter(i,j,1) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*CS%t_bdry_val(i-1,j) -! assume no flux bc for temp endif if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then @@ -3816,8 +3819,6 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f CS%thickness_bdry_val(i+1,j) elseif (CS%u_face_mask(i+1,j) == 4.) then flux_enter(i,j,2) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) * CS%t_bdry_val(i+1,j) -! assume no flux bc for temp -! flux_enter(i,j,2) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*CS%t_bdry_val(i+1,j) endif ! if ((i == is) .AND. (hmask(i,j) == 0) .AND. (hmask(i-1,j) == 1)) then @@ -3854,13 +3855,13 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: h_after_uflux !< The ice shelf thicknesses after - !! the zonal mass fluxes, in m. + !! the zonal mass fluxes, in Z. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_after_vflux !< The ice shelf thicknesses after - !! the meridional mass fluxes, in m. + !! the meridional mass fluxes, in Z. real, dimension(SZDI_(G),SZDJ_(G),4), & intent(inout) :: flux_enter !< The integrated temperature flux into - !! the cell through the 4 cell boundaries, in degC m3 + !! the cell through the 4 cell boundaries, in degC Z m2 ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells @@ -3926,9 +3927,6 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_flux_bdry_val(i,j-1) * & CS%t_bdry_val(i,j-1)/ dxdyh -! assume no flux bc for temp -! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*CS%t_bdry_val(i,j-1) / dxdyh - else ! get u-velocity at center of left face @@ -3979,9 +3977,6 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_flux_bdry_val(i,j+1) *& CS%t_bdry_val(i,j+1)/ dxdyh -! assume no flux bc for temp -! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*CS%t_bdry_val(i,j+1) / dxdyh - else ! get u-velocity at center of right face @@ -4031,9 +4026,6 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft CS%thickness_bdry_val(i,j-1) elseif (CS%v_face_mask(i,j-1) == 4.) then flux_enter(i,j,3) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1)*CS%t_bdry_val(i,j-1) -! assume no flux bc for temp -! flux_enter(i,j,3) = G%dxh(i,j) * time_step * CS%v_shelf(i,j)*CS%t_bdry_val(i,j-1) - endif if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then @@ -4042,8 +4034,6 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft CS%thickness_bdry_val(i,j+1) elseif (CS%v_face_mask(i,j+1) == 4.) then flux_enter(i,j,4) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1)*CS%t_bdry_val(i,j+1) -! assume no flux bc for temp -! flux_enter(i,j,4) = G%dxh(i,j) * time_step * CS%v_shelf(i,j)*CS%t_bdry_val(i,j+1) endif ! if ((j == js) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j-1) == 1)) then diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index ec6ce0fffa..efbc22f64d 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -7,6 +7,7 @@ module MOM_ice_shelf_initialize use MOM_file_parser, only : get_param, read_param, log_param, param_file_type use MOM_io, only: MOM_read_data, file_exists, slasher use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe +use MOM_unit_scaling, only : unit_scale_type use user_shelf_init, only: USER_init_ice_thickness implicit none ; private @@ -19,17 +20,19 @@ module MOM_ice_shelf_initialize contains !> Initialize ice shelf thickness -subroutine initialize_ice_thickness(h_shelf, area_shelf_h, hmask, G, PF) +subroutine initialize_ice_thickness(h_shelf, area_shelf_h, hmask, G, US, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< The ice shelf thickness, in m. + intent(inout) :: h_shelf !< The ice shelf thickness, in Z. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf + type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters + integer :: i, j character(len=40) :: mdl = "initialize_ice_thickness" ! This subroutine's name. character(len=200) :: config @@ -39,9 +42,9 @@ subroutine initialize_ice_thickness(h_shelf, area_shelf_h, hmask, G, PF) fail_if_missing=.true.) select case ( trim(config) ) - case ("CHANNEL"); call initialize_ice_thickness_channel (h_shelf, area_shelf_h, hmask, G, PF) - case ("FILE"); call initialize_ice_thickness_from_file (h_shelf, area_shelf_h, hmask, G, PF) - case ("USER"); call USER_init_ice_thickness (h_shelf, area_shelf_h, hmask, G, PF) + case ("CHANNEL"); call initialize_ice_thickness_channel (h_shelf, area_shelf_h, hmask, G, US, PF) + case ("FILE"); call initialize_ice_thickness_from_file (h_shelf, area_shelf_h, hmask, G, US, PF) + case ("USER"); call USER_init_ice_thickness (h_shelf, area_shelf_h, hmask, G, US, PF) case default ; call MOM_error(FATAL,"MOM_initialize: "// & "Unrecognized ice profile setup "//trim(config)) end select @@ -49,7 +52,7 @@ subroutine initialize_ice_thickness(h_shelf, area_shelf_h, hmask, G, PF) end subroutine initialize_ice_thickness !> Initialize ice shelf thickness from file -subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, PF) +subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, US, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_shelf !< The ice shelf thickness, in m. @@ -58,6 +61,7 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, P real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf + type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters ! This subroutine reads ice thickness and area from a file and puts it into @@ -91,7 +95,7 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, P if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_topography_from_file: Unable to open "//trim(filename)) - call MOM_read_data(filename,trim(thickness_varname),h_shelf,G%Domain) + call MOM_read_data(filename, trim(thickness_varname), h_shelf, G%Domain, scale=US%m_to_Z) call MOM_read_data(filename,trim(area_varname),area_shelf_h,G%Domain) ! call get_param(PF, mdl, "ICE_BOUNDARY_CONFIG", config, & @@ -108,7 +112,7 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, P if ((G%geoLonCv(i,j) > len_sidestress).and. & (len_sidestress > 0.)) then - udh = exp (-(G%geoLonCv(i,j)-len_sidestress)/5.0) * h_shelf(i,j) + udh = exp(-(G%geoLonCv(i,j)-len_sidestress)/5.0) * h_shelf(i,j) if (udh <= 25.0) then h_shelf(i,j) = 0.0 area_shelf_h (i,j) = 0.0 @@ -135,15 +139,16 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, P end subroutine initialize_ice_thickness_from_file !> Initialize ice shelf thickness for a channel configuration -subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, PF) +subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, US, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< The ice shelf thickness, in m. + intent(inout) :: h_shelf !< The ice shelf thickness, in Z. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf + type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters character(len=40) :: mdl = "initialize_ice_shelf_thickness_channel" ! This subroutine's name. @@ -160,19 +165,26 @@ subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, PF) call MOM_mesg(mdl//": setting thickness") call get_param(PF, mdl, "SHELF_MAX_DRAFT", max_draft, & - units="m", default=1.0) + units="m", default=1.0, scale=US%m_to_Z) call get_param(PF, mdl, "SHELF_MIN_DRAFT", min_draft, & - units="m", default=1.0) + units="m", default=1.0, scale=US%m_to_Z) call get_param(PF, mdl, "FLAT_SHELF_WIDTH", flat_shelf_width, & units="axis_units", default=0.0) call get_param(PF, mdl, "SHELF_SLOPE_SCALE", shelf_slope_scale, & units="axis_units", default=0.0) call get_param(PF, mdl, "SHELF_EDGE_POS_0", edge_pos, & units="axis_units", default=0.0) +! call get_param(param_file, mdl, "RHO_0", Rho_ocean, & +! "The mean ocean density used with BOUSSINESQ true to \n"//& +! "calculate accelerations and the mass for conservation \n"//& +! "properties, or with BOUSSINSEQ false to convert some \n"//& +! "parameters from vertical units of m to kg m-2.", & +! units="kg m-3", default=1035.0, scale=US%Z_to_m) slope_pos = edge_pos - flat_shelf_width c1 = 0.0 ; if (shelf_slope_scale > 0.0) c1 = 1.0 / shelf_slope_scale + do j=G%jsd,G%jed if (((j+j_off) <= jedg) .AND. ((j+j_off) >= nyh+1)) then @@ -198,7 +210,7 @@ subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, PF) endif if (G%geoLonT(i,j) > slope_pos) then - h_shelf (i,j) = min_draft + h_shelf(i,j) = min_draft ! mass_shelf(i,j) = Rho_ocean * min_draft else ! mass_shelf(i,j) = Rho_ocean * (min_draft + & diff --git a/src/ice_shelf/user_shelf_init.F90 b/src/ice_shelf/user_shelf_init.F90 index 7e5bbe2620..60dd6ec18f 100644 --- a/src/ice_shelf/user_shelf_init.F90 +++ b/src/ice_shelf/user_shelf_init.F90 @@ -9,6 +9,7 @@ module user_shelf_init use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_time_manager, only : time_type, set_time, time_type_to_real +use MOM_unit_scaling, only : unit_scale_type ! use MOM_io, only : close_file, fieldtype, file_exists ! use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE ! use MOM_io, only : write_field, slasher @@ -21,9 +22,9 @@ module user_shelf_init !> The control structure for the user_ice_shelf module type, public :: user_ice_shelf_CS ; private - real :: Rho_ocean !< The ocean's typical density, in kg m-3. - real :: max_draft !< The maximum ocean draft of the ice shelf, in m. - real :: min_draft !< The minimum ocean draft of the ice shelf, in m. + real :: Rho_ocean !< The ocean's typical density, in kg m-2 Z-1. + real :: max_draft !< The maximum ocean draft of the ice shelf, in Z. + real :: min_draft !< The minimum ocean draft of the ice shelf, in Z. real :: flat_shelf_width !< The range over which the shelf is min_draft thick. real :: shelf_slope_scale !< The range over which the shelf slopes. real :: pos_shelf_edge_0 !< The x-position of the shelf edge at time 0, in km. @@ -34,7 +35,7 @@ module user_shelf_init contains !> This subroutine sets up the initial mass and area covered by the ice shelf, based on user-provided code. -subroutine USER_initialize_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, CS, param_file, new_sim) +subroutine USER_initialize_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, US, CS, param_file, new_sim) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & @@ -47,7 +48,8 @@ subroutine USER_initialize_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, real, dimension(SZDI_(G),SZDJ_(G)), & intent(out) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf - type(user_ice_shelf_CS), pointer :: CS !< A pointer to the user ice shelf control structure + type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors + type(user_ice_shelf_CS), pointer :: CS !< A pointer to the user ice shelf control structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters logical, intent(in) :: new_sim !< If true, this is a new run; otherwise it is !! being started from a restart file. @@ -83,11 +85,11 @@ subroutine USER_initialize_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, "calculate accelerations and the mass for conservation \n"//& "properties, or with BOUSSINSEQ false to convert some \n"//& "parameters from vertical units of m to kg m-2.", & - units="kg m-3", default=1035.0) + units="kg m-3", default=1035.0, scale=US%Z_to_m) call get_param(param_file, mdl, "SHELF_MAX_DRAFT", CS%max_draft, & - units="m", default=1.0) + units="m", default=1.0, scale=US%m_to_Z) call get_param(param_file, mdl, "SHELF_MIN_DRAFT", CS%min_draft, & - units="m", default=1.0) + units="m", default=1.0, scale=US%m_to_Z) call get_param(param_file, mdl, "FLAT_SHELF_WIDTH", CS%flat_shelf_width, & units="axis_units", default=0.0) call get_param(param_file, mdl, "SHELF_SLOPE_SCALE", CS%shelf_slope_scale, & @@ -102,7 +104,7 @@ subroutine USER_initialize_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, end subroutine USER_initialize_shelf_mass !> This subroutine updates the ice shelf thickness, as specified by user-provided code. -subroutine USER_init_ice_thickness(h_shelf, area_shelf_h, hmask, G, param_file) +subroutine USER_init_ice_thickness(h_shelf, area_shelf_h, hmask, G, US, param_file) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & intent(out) :: h_shelf !< The ice shelf thickness, in m. @@ -111,6 +113,7 @@ subroutine USER_init_ice_thickness(h_shelf, area_shelf_h, hmask, G, param_file) real, dimension(SZDI_(G),SZDJ_(G)), & intent(out) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf + type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! This subroutine initializes the ice shelf thickness. Currently it does so @@ -118,7 +121,7 @@ subroutine USER_init_ice_thickness(h_shelf, area_shelf_h, hmask, G, param_file) real, dimension(SZI_(G),SZJ_(G)) :: mass_shelf type(user_ice_shelf_CS), pointer :: CS => NULL() - call USER_initialize_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, CS, param_file, .true.) + call USER_initialize_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, US, CS, param_file, .true.) end subroutine USER_init_ice_thickness @@ -131,7 +134,7 @@ subroutine USER_update_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, C real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< The ice shelf thickness, in m. + intent(inout) :: h_shelf !< The ice shelf thickness, in Z. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf From c8eeaaba837f08e60166a851f080e37fc64012d2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 9 Nov 2018 14:38:42 -0500 Subject: [PATCH 0899/1072] +Changed units of ustar from m/s to Z/s Changed the units of fluxes%ustar and forces%ustar from m/s to Z/s for dimensional consistency testing. This includes adding new unit_scale_type arguments to several routines and new elements to the top-level ocean model control structures. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- .../coupled_driver/MOM_surface_forcing.F90 | 35 +++++---- config_src/coupled_driver/ocean_model_MOM.F90 | 10 +-- .../ice_solo_driver/MOM_surface_forcing.F90 | 55 +++++++------ .../ice_solo_driver/user_surface_forcing.F90 | 8 +- config_src/mct_driver/MOM_ocean_model.F90 | 13 ++-- config_src/mct_driver/MOM_surface_forcing.F90 | 20 +++-- config_src/solo_driver/MOM_driver.F90 | 8 +- .../solo_driver/MOM_surface_forcing.F90 | 78 +++++++++++-------- .../solo_driver/Neverland_surface_forcing.F90 | 6 +- .../solo_driver/user_surface_forcing.F90 | 6 +- src/core/MOM.F90 | 4 +- src/core/MOM_forcing_type.F90 | 20 +++-- src/ice_shelf/MOM_ice_shelf.F90 | 6 +- .../lateral/MOM_mixed_layer_restrat.F90 | 10 +-- .../vertical/MOM_CVMix_KPP.F90 | 12 +-- .../vertical/MOM_bulk_mixed_layer.F90 | 4 +- .../vertical/MOM_diabatic_driver.F90 | 30 +++---- .../vertical/MOM_energetic_PBL.F90 | 2 +- .../vertical/MOM_set_diffusivity.F90 | 12 +-- .../vertical/MOM_set_viscosity.F90 | 4 +- .../vertical/MOM_vert_friction.F90 | 12 +-- src/user/Idealized_Hurricane.F90 | 34 ++++---- src/user/MOM_wave_interface.F90 | 19 +++-- src/user/SCM_CVMix_tests.F90 | 14 ++-- 24 files changed, 231 insertions(+), 191 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 51d3e0c7b7..98e5b1adc4 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -28,6 +28,7 @@ module MOM_surface_forcing use MOM_restart, only : restart_init_end, save_restart, restore_state use MOM_string_functions, only : uppercase use MOM_spatial_means, only : adjust_area_mean_to_zero +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface use user_revise_forcing, only : user_alter_forcing, user_revise_forcing_init use user_revise_forcing, only : user_revise_forcing_CS @@ -194,7 +195,7 @@ module MOM_surface_forcing !> 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, CS, sfc_state) +subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc_state) type(ice_ocean_boundary_type), & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive !! the ocean in a coupled model @@ -205,6 +206,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, sfc_sta 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 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. type(surface), intent(in) :: sfc_state !< A structure containing fields that describe the @@ -531,12 +533,12 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, sfc_sta ! Set the wind stresses and ustar. if (associated(fluxes%ustar) .and. associated(fluxes%ustar_gustless)) then - call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, ustar=fluxes%ustar, & + call extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, ustar=fluxes%ustar, & gustless_ustar=fluxes%ustar_gustless) elseif (associated(fluxes%ustar)) then - call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, ustar=fluxes%ustar) + call extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, ustar=fluxes%ustar) elseif (associated(fluxes%ustar_gustless)) then - call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, gustless_ustar=fluxes%ustar_gustless) + call extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, gustless_ustar=fluxes%ustar_gustless) endif if (coupler_type_initialized(fluxes%tr_fluxes) .and. & @@ -558,7 +560,7 @@ 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. -subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS, dt_forcing, reset_avg) +subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_forcing, reset_avg) type(ice_ocean_boundary_type), & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive !! the ocean in a coupled model @@ -567,6 +569,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS, dt_forc 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 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. real, optional, intent(in) :: dt_forcing !< A time interval over which to apply the @@ -678,10 +681,10 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS, dt_forc ! Set the wind stresses and ustar. if (wt1 <= 0.0) then - call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux=forces%taux, tauy=forces%tauy, & + call extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux=forces%taux, tauy=forces%tauy, & ustar=forces%ustar, tau_halo=1) else - call extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux=forces%taux, tauy=forces%tauy, & + call extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux=forces%taux, tauy=forces%tauy, & ustar=ustar_tmp, tau_halo=1) do j=js,je ; do i=is,ie forces%ustar(i,j) = wt1*forces%ustar(i,j) + wt2*ustar_tmp(i,j) @@ -782,7 +785,7 @@ end subroutine convert_IOB_to_forces !> This subroutine extracts the wind stresses and related fields like ustar from an !! Ice_ocean_boundary_type into optional argument arrays, including changes of units, sign !! conventions, and putting the fields into arrays with MOM-standard sized halos. -subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, ustar, & +subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, ustar, & gustless_ustar, tau_halo) type(ice_ocean_boundary_type), & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive @@ -791,6 +794,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta 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 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. real, dimension(SZIB_(G),SZJ_(G)), & @@ -798,7 +802,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta real, dimension(SZI_(G),SZJB_(G)), & optional, intent(inout) :: tauy !< The meridional wind stresses on a C-grid, in Pa. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(inout) :: ustar !< The surface friction velocity, in m s-1. + optional, intent(inout) :: ustar !< The surface friction velocity, in Z s-1. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(out) :: gustless_ustar !< The surface friction velocity without !! any contributions from gustiness, in m s-1. @@ -939,7 +943,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0)) ) & gustiness = CS%gust(i,j) endif - ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*IOB%stress_mag(i-i0,j-j0)) + ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0*IOB%stress_mag(i-i0,j-j0)) enddo ; enddo ; endif if (do_gustless) then ; do j=js,je ; do i=is,ie gustless_ustar(i,j) = sqrt(IOB%stress_mag(i-i0,j-j0) / CS%Rho0) @@ -958,7 +962,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif - if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) + if (do_ustar) ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0 * tau_mag) if (do_gustless) gustless_ustar(i,j) = sqrt(tau_mag / CS%Rho0) !### Change to: ! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) @@ -968,7 +972,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta tau_mag = G%mask2dT(i,j) * sqrt(taux_in_A(i,j)**2 + tauy_in_A(i,j)**2) gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) + if (do_ustar) ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0 * tau_mag) if (do_gustless) gustless_ustar(i,j) = sqrt(tau_mag / CS%Rho0) !### Change to: ! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) @@ -987,7 +991,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, CS, taux, tauy, usta gustiness = CS%gust_const if (CS%read_gust_2d) gustiness = CS%gust(i,j) - if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) + if (do_ustar) ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0 * tau_mag) if (do_gustless) gustless_ustar(i,j) = sqrt(tau_mag / CS%Rho0) !### Change to: ! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) @@ -1122,9 +1126,10 @@ subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & end subroutine forcing_save_restart !> Initialize the surface forcing, including setting parameters and allocating permanent memory. -subroutine surface_forcing_init(Time, G, param_file, diag, CS) +subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) 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 @@ -1407,7 +1412,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS) call get_param(param_file, mdl, "ALLOW_ICEBERG_FLUX_DIAGNOSTICS", iceberg_flux_diags, & "If true, makes available diagnostics of fluxes from icebergs\n"//& "as seen by MOM6.", default=.false.) - call register_forcing_type_diags(Time, diag, CS%use_temperature, CS%handles, & + 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, & diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index bcc9ea3dd7..32cdd843ff 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -43,7 +43,7 @@ module ocean_model_mod use MOM_time_manager, only : real_to_time, 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_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 @@ -355,7 +355,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) 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, param_file, OS%diag, & + call surface_forcing_init(Time_in, OS%grid, OS%US, param_file, OS%diag, & OS%forcing_CSp) if (OS%use_ice_shelf) then @@ -498,7 +498,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda index_bnds(3), index_bnds(4)) if (do_dyn) then - call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time_dyn, OS%grid, & + call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time_dyn, OS%grid, OS%US, & OS%forcing_CSp, dt_forcing=dt_coupling, reset_avg=OS%fluxes%fluxes_used) if (OS%use_ice_shelf) & call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) @@ -510,7 +510,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda if (do_thermo) then if (OS%fluxes%fluxes_used) then call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp, OS%sfc_state) + OS%grid, OS%US, OS%forcing_CSp, OS%sfc_state) ! Add ice shelf fluxes if (OS%use_ice_shelf) & @@ -532,7 +532,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda ! into a temporary type and then accumulate them in about 20 lines. OS%flux_tmp%C_p = OS%fluxes%C_p call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp, OS%sfc_state) + OS%grid, OS%US, OS%forcing_CSp, OS%sfc_state) if (OS%use_ice_shelf) & call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) diff --git a/config_src/ice_solo_driver/MOM_surface_forcing.F90 b/config_src/ice_solo_driver/MOM_surface_forcing.F90 index 5e4a52b69d..c0b6d7dd94 100644 --- a/config_src/ice_solo_driver/MOM_surface_forcing.F90 +++ b/config_src/ice_solo_driver/MOM_surface_forcing.F90 @@ -72,6 +72,7 @@ module MOM_surface_forcing use MOM_time_manager, only : time_type, operator(+), operator(/), get_time, set_time use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface ! use MESO_surface_forcing, only : MESO_wind_forcing, MESO_buoyancy_forcing ! use MESO_surface_forcing, only : MESO_surface_forcing_init, MESO_surface_forcing_CS @@ -333,12 +334,13 @@ subroutine buoyancy_forcing_allocate(fluxes, G, CS) end subroutine buoyancy_forcing_allocate -subroutine wind_forcing_zero(sfc_state, forces, day, G, CS) +subroutine wind_forcing_zero(sfc_state, forces, day, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), intent(in) :: day - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + 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(surface_forcing_CS), pointer :: CS ! subroutine sets the surface wind stresses to zero @@ -373,11 +375,11 @@ subroutine wind_forcing_zero(sfc_state, forces, day, G, CS) if (CS%read_gust_2d) then if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = sqrt(CS%gust(i,j)/CS%Rho0) + forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust(i,j)/CS%Rho0) enddo ; enddo ; endif else if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = sqrt(CS%gust_const/CS%Rho0) + forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust_const/CS%Rho0) enddo ; enddo ; endif endif @@ -389,8 +391,8 @@ subroutine wind_forcing_2gyre(sfc_state, forces, day, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), intent(in) :: day - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(surface_forcing_CS), pointer :: CS ! This subroutine sets the surface wind stresses according to double gyre. @@ -432,8 +434,8 @@ subroutine wind_forcing_1gyre(sfc_state, forces, day, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), intent(in) :: day - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(surface_forcing_CS), pointer :: CS ! This subroutine sets the surface wind stresses according to single gyre. @@ -470,12 +472,13 @@ subroutine wind_forcing_1gyre(sfc_state, forces, day, G, CS) end subroutine wind_forcing_1gyre -subroutine wind_forcing_gyres(sfc_state, forces, day, G, CS) +subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), intent(in) :: day - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + 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(surface_forcing_CS), pointer :: CS ! This subroutine sets the surface wind stresses according to gyres. @@ -513,7 +516,7 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, CS) ! set the friction velocity do j=js,je ; do i=is,ie - forces%ustar(i,j) = sqrt(sqrt(0.5*(forces%tauy(i,j-1)*forces%tauy(i,j-1) + & + forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(0.5*(forces%tauy(i,j-1)*forces%tauy(i,j-1) + & forces%tauy(i,j)*forces%tauy(i,j) + forces%taux(i-1,j)*forces%taux(i-1,j) + & forces%taux(i,j)*forces%taux(i,j)))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo @@ -522,12 +525,13 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, CS) end subroutine wind_forcing_gyres -subroutine wind_forcing_from_file(sfc_state, forces, day, G, CS) +subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), intent(in) :: day - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS), pointer :: CS ! This subroutine sets the surface wind stresses. @@ -580,12 +584,12 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, CS) if (CS%read_gust_2d) then do j=js,je ; do i=is,ie - forces%ustar(i,j) = sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j)) + CS%gust(i,j)) / CS%Rho0) enddo ; enddo else do j=js,je ; do i=is,ie - forces%ustar(i,j) = sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo endif @@ -605,13 +609,13 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, CS) call pass_vector(forces%taux, forces%tauy, G%Domain, To_All) if (CS%read_gust_2d) then do j=js, je ; do i=is, ie - forces%ustar(i,j) = sqrt((sqrt(0.5*((forces%tauy(i,j-1)**2 + & + forces%ustar(i,j) = US%m_to_Z * sqrt((sqrt(0.5*((forces%tauy(i,j-1)**2 + & forces%tauy(i,j)**2) + (forces%taux(i-1,j)**2 + & forces%taux(i,j)**2))) + CS%gust(i,j)) / CS%Rho0 ) enddo ; enddo else do j=js, je ; do i=is, ie - forces%ustar(i,j) = sqrt(sqrt(0.5*((forces%tauy(i,j-1)**2 + & + forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(0.5*((forces%tauy(i,j-1)**2 + & forces%tauy(i,j)**2) + (forces%taux(i-1,j)**2 + & forces%taux(i,j)**2)))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo @@ -631,7 +635,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes - type(time_type), intent(in) :: day + type(time_type), intent(in) :: day !< Time used for determining the fluxes. real, intent(in) :: dt !< The amount of time over which !! the fluxes apply, in s type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure @@ -836,7 +840,7 @@ subroutine buoyancy_forcing_zero(sfc_state, fluxes, day, dt, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes - type(time_type), intent(in) :: day + type(time_type), intent(in) :: day !< Time used for determining the fluxes. real, intent(in) :: dt !< The amount of time over which !! the fluxes apply, in s type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -895,7 +899,7 @@ subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes - type(time_type), intent(in) :: day + type(time_type), intent(in) :: day !< Time used for determining the fluxes. real, intent(in) :: dt !< The amount of time over which !! the fluxes apply, in s type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -1011,9 +1015,10 @@ subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & end subroutine forcing_save_restart -subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) +subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_CSp) type(time_type), intent(in) :: 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(in) :: diag type(surface_forcing_CS), pointer :: CS @@ -1228,7 +1233,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) ! call MESO_surface_forcing_init(Time, G, param_file, diag, CS%MESO_forcing_CSp) endif - call register_forcing_type_diags(Time, diag, CS%use_temperature, CS%handles) + call register_forcing_type_diags(Time, diag, US, CS%use_temperature, CS%handles) ! Set up any restart fields associated with the forcing. call restart_init(G, param_file, CS%restart_CSp, "MOM_forcing.res") diff --git a/config_src/ice_solo_driver/user_surface_forcing.F90 b/config_src/ice_solo_driver/user_surface_forcing.F90 index 6a70999d50..22ea1d08fb 100644 --- a/config_src/ice_solo_driver/user_surface_forcing.F90 +++ b/config_src/ice_solo_driver/user_surface_forcing.F90 @@ -55,6 +55,7 @@ module user_surface_forcing use MOM_time_manager, only : time_type, operator(+), operator(/), get_time use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface implicit none ; private @@ -88,12 +89,13 @@ module user_surface_forcing !> This subroutine sets the surface wind stresses, forces%taux and forces%tauy. !! These are the stresses in the direction of the model grid (i.e. the same !! direction as the u- and v- velocities.) They are both in Pa. -subroutine USER_wind_forcing(sfc_state, forces, day, G, CS) +subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(time_type), intent(in) :: day !< The time of the fluxes type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned !! by a previous call to user_surface_forcing_init @@ -101,7 +103,7 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, CS) ! These are the stresses in the direction of the model grid (i.e. the same ! direction as the u- and v- velocities.) They are both in Pa. ! In addition, this subroutine can be used to set the surface friction -! velocity, forces%ustar, in m s-1. This is needed with a bulk mixed layer. +! velocity, forces%ustar, in Z s-1. This is needed with a bulk mixed layer. ! ! Arguments: state - A structure containing fields that describe the ! surface state of the ocean. @@ -144,7 +146,7 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, CS) ! is always positive. if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & + forces%ustar(i,j) = US%m_to_Z * G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) enddo ; enddo ; endif diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 4714194f40..a7b41dbe67 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -53,6 +53,7 @@ module MOM_ocean_model 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 @@ -198,6 +199,8 @@ module MOM_ocean_model !! containing metrics and related information. type(verticalGrid_type), pointer :: GV => NULL() !< A pointer to a vertical grid !! structure containing metrics and related information. + 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_restart_CS), pointer :: & @@ -276,7 +279,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i 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, C_p=OS%fluxes%C_p, & + call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%fluxes%C_p, & use_temp=use_temperature) OS%C_p = OS%fluxes%C_p @@ -361,7 +364,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i 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, param_file, OS%diag, & + call surface_forcing_init(Time_in, OS%grid, OS%US, param_file, OS%diag, & OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) if (OS%use_ice_shelf) then @@ -473,7 +476,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & weight = 1.0 call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp) + OS%grid, OS%US, OS%forcing_CSp) if (OS%fluxes%fluxes_used) then @@ -481,7 +484,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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%forcing_CSp, & + 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. @@ -513,7 +516,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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%forcing_CSp, & + 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 (OS%use_ice_shelf) then diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 5c4a43bfc0..d62729cf6f 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -28,6 +28,7 @@ module MOM_surface_forcing use MOM_restart, only : restart_init_end, save_restart, restore_state use MOM_string_functions, only : uppercase use MOM_spatial_means, only : adjust_area_mean_to_zero +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface use user_revise_forcing, only : user_alter_forcing, user_revise_forcing_init use user_revise_forcing, only : user_revise_forcing_CS @@ -202,7 +203,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, CS, & +subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & sfc_state, restore_salt, restore_temp) type(ice_ocean_boundary_type), & @@ -216,6 +217,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & 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 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. type(surface), intent(in) :: sfc_state !< A structure containing fields that describe the @@ -516,7 +518,7 @@ 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. -subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) +subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) type(ice_ocean_boundary_type), & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive !! the ocean in a coupled model @@ -525,6 +527,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) 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 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. @@ -668,7 +671,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) + forces%ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0*tau_mag) enddo; enddo elseif (wind_stagger == AGRID) then @@ -693,7 +696,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) do j=js,je ; do i=is,ie gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & + forces%ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) enddo; enddo @@ -714,9 +717,9 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) if (CS%read_gust_2d) then - forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) + forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) else - forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) + forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) endif enddo; enddo @@ -964,9 +967,10 @@ end subroutine forcing_save_restart !======================================================================= !> Initializes surface forcing: get relevant parameters and allocate arrays. -subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, restore_temp) +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 @@ -1231,7 +1235,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res call get_param(param_file, mdl, "ALLOW_ICEBERG_FLUX_DIAGNOSTICS", iceberg_flux_diags, & "If true, makes available diagnostics of fluxes from icebergs\n"//& "as seen by MOM6.", default=.false.) - call register_forcing_type_diags(Time, diag, CS%use_temperature, CS%handles, & + 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, & diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 0fef7c2589..5ccb00c1ae 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -322,7 +322,7 @@ program MOM_main call extract_surface_state(MOM_CSp, sfc_state) - call surface_forcing_init(Time, grid, param_file, diag, & + call surface_forcing_init(Time, grid, US, param_file, diag, & surface_forcing_CSp, tracer_flow_CSp) call callTree_waypoint("done surface_forcing_init") @@ -478,12 +478,12 @@ program MOM_main ! Set the forcing for the next steps. if (.not. offline_tracer_mode) then - call set_forcing(sfc_state, forces, fluxes, Time, Time_step_ocean, grid, & + call set_forcing(sfc_state, forces, fluxes, Time, Time_step_ocean, grid, US, & surface_forcing_CSp) endif if (debug) then - call MOM_mech_forcing_chksum("After set forcing", forces, grid, haloshift=0) - call MOM_forcing_chksum("After set forcing", fluxes, grid, haloshift=0) + call MOM_mech_forcing_chksum("After set forcing", forces, grid, US, haloshift=0) + call MOM_forcing_chksum("After set forcing", fluxes, grid, US, haloshift=0) endif if (use_ice_shelf) then diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 9a7ed215c0..1a2622cfc5 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -35,6 +35,7 @@ module MOM_surface_forcing use MOM_time_manager, only : time_type, operator(+), operator(/), get_time, time_type_to_real use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface use MESO_surface_forcing, only : MESO_buoyancy_forcing use MESO_surface_forcing, only : MESO_surface_forcing_init, MESO_surface_forcing_CS @@ -213,7 +214,7 @@ module MOM_surface_forcing !! !! It also allocates and initializes the fields in the forcing and mech_forcing types !! the first time it is called. -subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS) +subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces @@ -221,6 +222,7 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS type(time_type), intent(in) :: day_start !< The start time of the fluxes type(time_type), intent(in) :: day_interval !< Length of time over which these fluxes applied type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call ! Local variables @@ -260,29 +262,29 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS if (CS%variable_winds .or. CS%first_call_set_forcing) then if (trim(CS%wind_config) == "file") then - call wind_forcing_from_file(sfc_state, forces, day_center, G, CS) + call wind_forcing_from_file(sfc_state, forces, day_center, G, US, CS) elseif (trim(CS%wind_config) == "data_override") then - call wind_forcing_by_data_override(sfc_state, forces, day_center, G, CS) + call wind_forcing_by_data_override(sfc_state, forces, day_center, G, US, CS) elseif (trim(CS%wind_config) == "2gyre") then - call wind_forcing_2gyre(sfc_state, forces, day_center, G, CS) + call wind_forcing_2gyre(sfc_state, forces, day_center, G, US, CS) elseif (trim(CS%wind_config) == "1gyre") then - call wind_forcing_1gyre(sfc_state, forces, day_center, G, CS) + call wind_forcing_1gyre(sfc_state, forces, day_center, G, US, CS) elseif (trim(CS%wind_config) == "gyres") then - call wind_forcing_gyres(sfc_state, forces, day_center, G, CS) + call wind_forcing_gyres(sfc_state, forces, day_center, G, US, CS) elseif (trim(CS%wind_config) == "zero") then - call wind_forcing_const(sfc_state, forces, 0., 0., day_center, G, CS) + call wind_forcing_const(sfc_state, forces, 0., 0., day_center, G, US, CS) elseif (trim(CS%wind_config) == "const") then - call wind_forcing_const(sfc_state, forces, CS%tau_x0, CS%tau_y0, day_center, G, CS) + call wind_forcing_const(sfc_state, forces, CS%tau_x0, CS%tau_y0, day_center, G, US, CS) elseif (trim(CS%wind_config) == "Neverland") then - call Neverland_wind_forcing(sfc_state, forces, day_center, G, CS%Neverland_forcing_CSp) + call Neverland_wind_forcing(sfc_state, forces, day_center, G, US, CS%Neverland_forcing_CSp) elseif (trim(CS%wind_config) == "ideal_hurr") then - call idealized_hurricane_wind_forcing(sfc_state, forces, day_center, G, CS%idealized_hurricane_CSp) + call idealized_hurricane_wind_forcing(sfc_state, forces, day_center, G, US, CS%idealized_hurricane_CSp) elseif (trim(CS%wind_config) == "SCM_ideal_hurr") then - call SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day_center, G, CS%idealized_hurricane_CSp) + call SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day_center, G, US, CS%idealized_hurricane_CSp) elseif (trim(CS%wind_config) == "SCM_CVmix_tests") then - call SCM_CVmix_tests_wind_forcing(sfc_state, forces, day_center, G, CS%SCM_CVmix_tests_CSp) + call SCM_CVmix_tests_wind_forcing(sfc_state, forces, day_center, G, US, CS%SCM_CVmix_tests_CSp) elseif (trim(CS%wind_config) == "USER") then - call USER_wind_forcing(sfc_state, forces, day_center, G, CS%user_forcing_CSp) + call USER_wind_forcing(sfc_state, forces, day_center, G, US, CS%user_forcing_CSp) elseif (CS%variable_winds .and. .not.CS%first_call_set_forcing) then call MOM_error(FATAL, & "MOM_surface_forcing: Variable winds defined with no wind config") @@ -354,7 +356,7 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS end subroutine set_forcing !> Sets the surface wind stresses to constant values -subroutine wind_forcing_const(sfc_state, forces, tau_x0, tau_y0, day, G, CS) +subroutine wind_forcing_const(sfc_state, forces, tau_x0, tau_y0, day, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces @@ -362,6 +364,7 @@ subroutine wind_forcing_const(sfc_state, forces, tau_x0, tau_y0, day, G, CS) real, intent(in) :: tau_y0 !< The meridional wind stress in Pa type(time_type), intent(in) :: day !< The time of the fluxes 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(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call ! Local variables @@ -385,11 +388,11 @@ subroutine wind_forcing_const(sfc_state, forces, tau_x0, tau_y0, day, G, CS) if (CS%read_gust_2d) then if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = sqrt( ( mag_tau + CS%gust(i,j) ) / CS%Rho0 ) + forces%ustar(i,j) = US%m_to_Z * sqrt( ( mag_tau + CS%gust(i,j) ) / CS%Rho0 ) enddo ; enddo ; endif else if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = sqrt( ( mag_tau + CS%gust_const ) / CS%Rho0 ) + forces%ustar(i,j) = US%m_to_Z * sqrt( ( mag_tau + CS%gust_const ) / CS%Rho0 ) enddo ; enddo ; endif endif @@ -398,12 +401,13 @@ end subroutine wind_forcing_const !> Sets the surface wind stresses to set up two idealized gyres. -subroutine wind_forcing_2gyre(sfc_state, forces, day, G, CS) +subroutine wind_forcing_2gyre(sfc_state, forces, day, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(time_type), intent(in) :: day !< The time of the fluxes 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(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call ! Local variables @@ -431,12 +435,13 @@ end subroutine wind_forcing_2gyre !> Sets the surface wind stresses to set up a single idealized gyre. -subroutine wind_forcing_1gyre(sfc_state, forces, day, G, CS) +subroutine wind_forcing_1gyre(sfc_state, forces, day, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(time_type), intent(in) :: day !< The time of the fluxes 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(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call ! Local variables @@ -462,12 +467,13 @@ subroutine wind_forcing_1gyre(sfc_state, forces, day, G, CS) end subroutine wind_forcing_1gyre !> Sets the surface wind stresses to set up idealized gyres. -subroutine wind_forcing_gyres(sfc_state, forces, day, G, CS) +subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(time_type), intent(in) :: day !< The time of the fluxes 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(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call ! Local variables @@ -492,9 +498,9 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, CS) forces%tauy(i,J) = 0.0 enddo ; enddo - ! set the friction velocity + ! set the friction velocity !### Add parenthesis so that this is rotationally invariant. do j=js,je ; do i=is,ie - forces%ustar(i,j) = sqrt(sqrt(0.5*(forces%tauy(i,j-1)*forces%tauy(i,j-1) + & + forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(0.5*(forces%tauy(i,j-1)*forces%tauy(i,j-1) + & forces%tauy(i,j)*forces%tauy(i,j) + forces%taux(i-1,j)*forces%taux(i-1,j) + & forces%taux(i,j)*forces%taux(i,j)))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo @@ -504,12 +510,13 @@ end subroutine wind_forcing_gyres ! Sets the surface wind stresses from input files. -subroutine wind_forcing_from_file(sfc_state, forces, day, G, CS) +subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(time_type), intent(in) :: day !< The time of the fluxes type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call ! Local variables @@ -577,12 +584,12 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, CS) if (.not.read_Ustar) then if (CS%read_gust_2d) then do j=js,je ; do i=is,ie - forces%ustar(i,j) = sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j)) + CS%gust(i,j)) / CS%Rho0) enddo ; enddo else do j=js,je ; do i=is,ie - forces%ustar(i,j) = sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo endif @@ -622,13 +629,13 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, CS) if (.not.read_Ustar) then if (CS%read_gust_2d) then do j=js, je ; do i=is, ie - forces%ustar(i,j) = sqrt((sqrt(0.5*((forces%tauy(i,j-1)**2 + & + forces%ustar(i,j) = US%m_to_Z * sqrt((sqrt(0.5*((forces%tauy(i,j-1)**2 + & forces%tauy(i,j)**2) + (forces%taux(i-1,j)**2 + & forces%taux(i,j)**2))) + CS%gust(i,j)) / CS%Rho0 ) enddo ; enddo else do j=js, je ; do i=is, ie - forces%ustar(i,j) = sqrt(sqrt(0.5*((forces%tauy(i,j-1)**2 + & + forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(0.5*((forces%tauy(i,j-1)**2 + & forces%tauy(i,j)**2) + (forces%taux(i-1,j)**2 + & forces%taux(i,j)**2)))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo @@ -641,7 +648,7 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, CS) if (read_Ustar) then call MOM_read_data(filename, CS%Ustar_var, forces%ustar(:,:), & - G%Domain, timelevel=time_lev) + G%Domain, timelevel=time_lev, scale=US%Z_to_m) endif CS%wind_last_lev = time_lev @@ -653,17 +660,19 @@ end subroutine wind_forcing_from_file ! Sets the surface wind stresses via the data override facility. -subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, CS) +subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(time_type), intent(in) :: day !< The time of the fluxes type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call ! Local variables real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal and psuedo-meridional real :: temp_y(SZI_(G),SZJ_(G)) ! wind stresses at h-points, in Pa. + real :: temp_ustar(SZI_(G),SZJ_(G)) ! ustar in m s-1 (not rescaled). integer :: i, j, is_in, ie_in, js_in, je_in logical :: read_uStar @@ -694,17 +703,19 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, CS) read_Ustar = (len_trim(CS%ustar_var) > 0) ! Need better control higher up ???? if (read_Ustar) then - call data_override('OCN', 'ustar', forces%ustar, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) + do j=G%jsc,G%jec ; do i=G%isc,G%iec ; temp_ustar(i,j) = US%Z_to_m*forces%ustar(i,j) ; enddo ; enddo + call data_override('OCN', 'ustar', temp_ustar, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) + do j=G%jsc,G%jec ; do i=G%isc,G%iec ; forces%ustar(i,j) = US%m_to_Z*temp_ustar(i,j) ; enddo ; enddo else if (CS%read_gust_2d) then call data_override('OCN', 'gust', CS%gust, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) do j=G%jsc,G%jec ; do i=G%isc,G%iec - forces%ustar(i,j) = sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j)) + CS%gust(i,j)) / CS%Rho0) enddo ; enddo else do j=G%jsc,G%jec ; do i=G%isc,G%iec - forces%ustar(i,j) = sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo endif @@ -1347,9 +1358,10 @@ subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & end subroutine forcing_save_restart !> Initialize the surface forcing module -subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) +subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_CSp) 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 !< structure used to regulate diagnostic output type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by @@ -1703,7 +1715,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) CS%SCM_CVmix_tests_CSp%Rho0 = CS%Rho0 !copy reference density for pass endif - call register_forcing_type_diags(Time, diag, CS%use_temperature, CS%handles) + call register_forcing_type_diags(Time, diag, US, CS%use_temperature, CS%handles) ! Set up any restart fields associated with the forcing. call restart_init(param_file, CS%restart_CSp, "MOM_forcing.res") diff --git a/config_src/solo_driver/Neverland_surface_forcing.F90 b/config_src/solo_driver/Neverland_surface_forcing.F90 index 326b807293..192d894661 100644 --- a/config_src/solo_driver/Neverland_surface_forcing.F90 +++ b/config_src/solo_driver/Neverland_surface_forcing.F90 @@ -13,6 +13,7 @@ module Neverland_surface_forcing use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, read_data, slasher use MOM_time_manager, only : time_type, operator(+), operator(/) +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface implicit none ; private @@ -46,12 +47,13 @@ module Neverland_surface_forcing !> Sets the surface wind stresses, forces%taux and forces%tauy for the !! Neverland forcing configuration. -subroutine Neverland_wind_forcing(sfc_state, forces, day, G, CS) +subroutine Neverland_wind_forcing(sfc_state, forces, day, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(time_type), intent(in) :: day !< Time used for determining the fluxes. type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(Neverland_surface_forcing_CS), pointer :: CS !< Control structure for this module. ! Local variables @@ -102,7 +104,7 @@ subroutine Neverland_wind_forcing(sfc_state, forces, day, G, CS) ! is always positive. ! if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie ! ! This expression can be changed if desired, but need not be. -! forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & +! forces%ustar(i,j) = US%m_to_Z * G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & ! sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & ! 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) ! enddo ; enddo ; endif diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90 index 7a27c75e18..1d2cd158ae 100644 --- a/config_src/solo_driver/user_surface_forcing.F90 +++ b/config_src/solo_driver/user_surface_forcing.F90 @@ -15,6 +15,7 @@ module user_surface_forcing use MOM_time_manager, only : time_type, operator(+), operator(/) use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface implicit none ; private @@ -47,12 +48,13 @@ module user_surface_forcing !> This subroutine sets the surface wind stresses, forces%taux and forces%tauy. !! These are the stresses in the direction of the model grid (i.e. the same !! direction as the u- and v- velocities.) They are both in Pa. -subroutine USER_wind_forcing(sfc_state, forces, day, G, CS) +subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(time_type), intent(in) :: day !< The time of the fluxes type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned !! by a previous call to user_surface_forcing_init @@ -86,7 +88,7 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, CS) ! is always positive. if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & + forces%ustar(i,j) = US%m_to_Z * G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) enddo ; enddo ; endif diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 67fd35a9d2..9bb2fa74cf 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -605,7 +605,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (cycle_start) & call MOM_state_chksum("Before steps ", u, v, h, CS%uh, CS%vh, G, GV) if (cycle_start) call check_redundant("Before steps ", u, v, G) - if (do_dyn) call MOM_mech_forcing_chksum("Before steps", forces, G, haloshift=0) + if (do_dyn) call MOM_mech_forcing_chksum("Before steps", forces, G, US, haloshift=0) if (do_dyn) call check_redundant("Before steps ", forces%taux, forces%tauy, G) endif call cpu_clock_end(id_clock_other) @@ -1185,7 +1185,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & ! call MOM_state_chksum("Pre-diabatic ",u, v, h, CS%uhtr, CS%vhtr, G, GV) call MOM_thermo_chksum("Pre-diabatic ", tv, G,haloshift=0) call check_redundant("Pre-diabatic ", u, v, G) - call MOM_forcing_chksum("Pre-diabatic", fluxes, G, haloshift=0) + call MOM_forcing_chksum("Pre-diabatic", fluxes, G, US, haloshift=0) endif call cpu_clock_begin(id_clock_diabatic) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 077e983245..fb8c3e3b86 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -45,7 +45,7 @@ module MOM_forcing_type ! surface stress components and turbulent velocity scale real, pointer, dimension(:,:) :: & - ustar => NULL(), & !< surface friction velocity scale (m/s) + ustar => NULL(), & !< surface friction velocity scale (Z/s) ustar_gustless => NULL() !< surface friction velocity scale without any !! any augmentation for gustiness (m/s) @@ -181,7 +181,7 @@ module MOM_forcing_type real, pointer, dimension(:,:) :: & taux => NULL(), & !< zonal wind stress (Pa) tauy => NULL(), & !< meridional wind stress (Pa) - ustar => NULL(), & !< surface friction velocity scale (m/s) + ustar => NULL(), & !< surface friction velocity scale (Z/s) net_mass_src => NULL() !< The net mass source to the ocean, in kg m-2 s-1. ! applied surface pressure from other component models (e.g., atmos, sea ice, land ice) @@ -943,10 +943,11 @@ end subroutine calculateBuoyancyFlux2d !> Write out chksums for thermodynamic fluxes. -subroutine MOM_forcing_chksum(mesg, fluxes, G, haloshift) +subroutine MOM_forcing_chksum(mesg, fluxes, G, US, haloshift) character(len=*), intent(in) :: mesg !< message type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields type(ocean_grid_type), intent(in) :: G !< grid type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: haloshift !< shift in halo integer :: is, ie, js, je, nz, hshift @@ -958,7 +959,7 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, haloshift) ! counts, there must be no redundant points, so all variables use is..ie ! and js...je as their extent. if (associated(fluxes%ustar)) & - call hchksum(fluxes%ustar, mesg//" fluxes%ustar",G%HI,haloshift=hshift) + call hchksum(fluxes%ustar, mesg//" fluxes%ustar",G%HI, haloshift=hshift, scale=US%Z_to_m) if (associated(fluxes%buoy)) & call hchksum(fluxes%buoy, mesg//" fluxes%buoy ",G%HI,haloshift=hshift) if (associated(fluxes%sw)) & @@ -1020,10 +1021,11 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, haloshift) end subroutine MOM_forcing_chksum !> Write out chksums for the driving mechanical forces. -subroutine MOM_mech_forcing_chksum(mesg, forces, G, haloshift) +subroutine MOM_mech_forcing_chksum(mesg, forces, G, US, haloshift) character(len=*), intent(in) :: mesg !< message type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces type(ocean_grid_type), intent(in) :: G !< grid type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: haloshift !< shift in halo integer :: is, ie, js, je, nz, hshift @@ -1040,7 +1042,7 @@ subroutine MOM_mech_forcing_chksum(mesg, forces, G, haloshift) if (associated(forces%p_surf)) & call hchksum(forces%p_surf, mesg//" forces%p_surf",G%HI,haloshift=hshift) if (associated(forces%ustar)) & - call hchksum(forces%ustar, mesg//" forces%ustar",G%HI,haloshift=hshift) + call hchksum(forces%ustar, mesg//" forces%ustar",G%HI,haloshift=hshift, scale=US%Z_to_m) if (associated(forces%rigidity_ice_u) .and. associated(forces%rigidity_ice_v)) & call uvchksum(mesg//" forces%rigidity_ice_[uv]", forces%rigidity_ice_u, & forces%rigidity_ice_v, G%HI, haloshift=hshift, symmetric=.true.) @@ -1134,9 +1136,10 @@ end subroutine forcing_SinglePointPrint !> Register members of the forcing type for diagnostics -subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use_berg_fluxes) +subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, use_berg_fluxes) type(time_type), intent(in) :: Time !< time type type(diag_ctrl), intent(inout) :: diag !< diagnostic control type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: use_temperature !< True if T/S are in use type(forcing_diags), intent(inout) :: handles !< handles for diagnostics logical, optional, intent(in) :: use_berg_fluxes !< If true, allow iceberg flux diagnostics @@ -1158,7 +1161,8 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use cmor_standard_name='surface_downward_y_stress') handles%id_ustar = register_diag_field('ocean_model', 'ustar', diag%axesT1, Time, & - 'Surface friction velocity = [(gustiness + tau_magnitude)/rho0]^(1/2)', 'm s-1') + 'Surface friction velocity = [(gustiness + tau_magnitude)/rho0]^(1/2)', & + 'm s-1', conversion=US%Z_to_m) if (present(use_berg_fluxes)) then if (use_berg_fluxes) then diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 58d6c75480..3e0b978de5 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -645,7 +645,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) endif endif - if (CS%DEBUG) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, haloshift=0) + if (CS%DEBUG) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, US, haloshift=0) call add_shelf_flux(G, CS, state, fluxes) @@ -687,7 +687,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) call cpu_clock_end(id_clock_shelf) - if (CS%DEBUG) call MOM_forcing_chksum("End of shelf calc flux", fluxes, G, haloshift=0) + if (CS%DEBUG) call MOM_forcing_chksum("End of shelf calc flux", fluxes, G, US, haloshift=0) end subroutine shelf_calc_flux @@ -1053,7 +1053,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) if (CS%DEBUG) then write(mesg,*) 'Mean melt flux (kg/(m^2 s)), dt = ', mean_melt_flux, CS%time_step call MOM_mesg(mesg) - call MOM_forcing_chksum("After constant sea level", fluxes, G, haloshift=0) + call MOM_forcing_chksum("After constant sea level", fluxes, G, CS%US, haloshift=0) endif endif !constant_sea_level diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 164fbac47f..55c906ae26 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -339,7 +339,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var if (CS%debug) then call hchksum(h,'mixed_layer_restrat: h',G%HI,haloshift=1,scale=GV%H_to_m) - call hchksum(forces%ustar,'mixed_layer_restrat: u*',G%HI,haloshift=1) + call hchksum(forces%ustar,'mixed_layer_restrat: u*',G%HI,haloshift=1,scale=US%Z_to_m) call hchksum(MLD_fast,'mixed_layer_restrat: MLD',G%HI,haloshift=1,scale=GV%H_to_m) call hchksum(Rml_av_fast,'mixed_layer_restrat: rml',G%HI,haloshift=1, scale=US%m_to_Z) endif @@ -351,7 +351,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! U - Component !$OMP do do j=js,je ; do I=is-1,ie - u_star = US%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & @@ -427,7 +427,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! V- component !$OMP do do J=js-1,je ; do i=is,ie - u_star = US%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & @@ -650,7 +650,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) do I=is-1,ie h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z - u_star = US%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 @@ -698,7 +698,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) do J=js-1,je ; do i=is,ie h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_Z - u_star = US%m_to_Z*0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index abddc57197..9c5e6bb3cc 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -488,7 +488,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) CS%id_Vt2 = register_diag_field('ocean_model', 'KPP_Vt2', diag%axesTL, Time, & 'Unresolved shear turbulence used by [CVMix] KPP', 'm2/s2') CS%id_uStar = register_diag_field('ocean_model', 'KPP_uStar', diag%axesT1, Time, & - 'Friction velocity, u*, as used by [CVMix] KPP', 'm/s') + 'Friction velocity, u*, as used by [CVMix] KPP', 'm/s', conversion=US%Z_to_m) CS%id_buoyFlux = register_diag_field('ocean_model', 'KPP_buoyFlux', diag%axesTi, Time, & 'Surface (and penetrating) buoyancy flux, as used by [CVMix] KPP', 'm2/s3') CS%id_QminusSW = register_diag_field('ocean_model', 'KPP_QminusSW', diag%axesT1, Time, & @@ -587,7 +587,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (m/s) + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (Z/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux (m2/s3) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP (Z2/s) !< (out) Vertical diffusivity including KPP (Z2/s) @@ -618,7 +618,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & #ifdef __DO_SAFETY_CHECKS__ if (CS%debug) then call hchksum(h, "KPP in: h",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0) + call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0, scale=US%Z_to_m) call hchksum(buoyFlux, "KPP in: buoyFlux",G%HI,haloshift=0) call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0, scale=US%Z_to_m**2) call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0, scale=US%Z_to_m**2) @@ -638,7 +638,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & if (G%mask2dT(i,j)==0.) cycle ! things independent of position within the column - surfFricVel = uStar(i,j) + surfFricVel = US%Z_to_m * uStar(i,j) iFaceHeight(1) = 0.0 ! BBL is all relative to the surface hcorr = 0. @@ -882,7 +882,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Velocity i-component (m/s) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Velocity j-component (m/s) type(EOS_type), pointer :: EOS !< Equation of state - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (m/s) + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (Z/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux (m2/s3) type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS @@ -958,7 +958,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! things independent of position within the column Coriolis = 0.25*( (G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) & +(G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1)) ) - surfFricVel = uStar(i,j) + surfFricVel = US%Z_to_m * uStar(i,j) ! Bullk Richardson number computed for each cell in a column, ! assuming OBLdepth = grid cell depth. After Rib(k) is diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 85e12fe567..6f055ce61a 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -663,7 +663,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! as the third piece will then optimally describe mixed layer ! restratification. For nkml>=4 the whole strategy should be revisited. do i=is,ie - kU_Star = 0.41*US%m_to_Z*fluxes%ustar(i,j) ! Maybe could be replaced with u*+w*? + kU_Star = 0.41*fluxes%ustar(i,j) ! Maybe could be replaced with u*+w*? if (associated(fluxes%ustar_shelf) .and. & associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & @@ -1368,7 +1368,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (CS%omega_frac >= 1.0) absf = 2.0*CS%omega do i=is,ie - U_Star = US%m_to_Z * fluxes%ustar(i,j) + U_Star = fluxes%ustar(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & U_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index e9107a6cc3..981fcd0b6a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -425,7 +425,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debug) then call MOM_state_chksum("Start of diabatic ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("Start of diabatic", fluxes, G, haloshift=0) + call MOM_forcing_chksum("Start of diabatic", fluxes, G, US, haloshift=0) endif if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G) @@ -587,7 +587,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debug) then call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, haloshift=0) + call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G) call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=US%Z_to_m**2) call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=US%Z_to_m**2) @@ -610,7 +610,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! The KPP scheme calculates boundary layer diffusivities and non-local transport. call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv%eqn_of_state, & - fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) + fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) call KPP_calculate(CS%KPP_CSp, G, GV, US, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) @@ -628,7 +628,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") if (CS%debug) then call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("after KPP", fluxes, G, haloshift=0) + call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z_to_m**2) call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z_to_m**2) @@ -655,7 +655,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debug) then call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, haloshift=0) + call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) endif endif ! endif for KPP @@ -789,7 +789,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call diag_update_remap_grids(CS%diag) call cpu_clock_end(id_clock_remap) if (CS%debug) then - call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, haloshift=0) + call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G) call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, haloshift=0) endif @@ -1305,7 +1305,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%debug) then call MOM_state_chksum("Start of diabatic ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("Start of diabatic", fluxes, G, haloshift=0) + call MOM_forcing_chksum("Start of diabatic", fluxes, G, US, haloshift=0) endif if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G) @@ -1373,7 +1373,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%bulkmixedlayer) then if (CS%debug) then - call MOM_forcing_chksum("Before mixedlayer", fluxes, G, haloshift=0) + call MOM_forcing_chksum("Before mixedlayer", fluxes, G, US, haloshift=0) endif if (CS%ML_mix_first > 0.0) then @@ -1413,7 +1413,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call cpu_clock_end(id_clock_mixedlayer) if (CS%debug) then call MOM_state_chksum("After mixedlayer ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("After mixedlayer", fluxes, G, haloshift=0) + call MOM_forcing_chksum("After mixedlayer", fluxes, G, US, haloshift=0) endif if (showCallTree) call callTree_waypoint("done with 1st bulkmixedlayer (diabatic)") if (CS%debugConservation) call MOM_state_stats('1st bulkmixedlayer', u, v, h, tv%T, tv%S, G) @@ -1497,7 +1497,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%debug) then call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, haloshift=0) + call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G) call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, scale=US%Z_to_m**2) call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z_to_m**2) @@ -1569,7 +1569,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") if (CS%debug) then call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("after KPP", fluxes, G, haloshift=0) + call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=US%Z_to_m**2) call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, scale=US%Z_to_m**2) @@ -1610,7 +1610,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%debug) then call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, haloshift=0) + call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) endif @@ -1673,7 +1673,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en endif ! endif for (CS%useALEalgorithm) if (CS%debug) then - call MOM_forcing_chksum("after calc_entrain ", fluxes, G, haloshift=0) + call MOM_forcing_chksum("after calc_entrain ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after calc_entrain ", tv, G) call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, haloshift=0) call hchksum(ea, "after calc_entrain ea", G%HI, haloshift=0, scale=GV%H_to_m) @@ -1771,7 +1771,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call cpu_clock_end(id_clock_remap) if (CS%debug) then - call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, haloshift=0) + call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G) call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, haloshift=0) endif @@ -1816,7 +1816,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%debug) then call MOM_state_chksum("after negative check ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("after negative check ", fluxes, G, haloshift=0) + call MOM_forcing_chksum("after negative check ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after negative check ", tv, G) endif if (showCallTree) call callTree_waypoint("done with h=ea-eb (diabatic)") diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 50b27a5ae6..a3a08fff63 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -603,7 +603,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! interface. do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then - U_star = US%m_to_Z*fluxes%ustar(i,j) + U_star = fluxes%ustar(i,j) U_Star_Mean = fluxes%ustar_gustless(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 4578c49c9c..79ba2914f5 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -117,7 +117,7 @@ module MOM_set_diffusivity !! to ML_rad as applied to the other surface !! sources of TKE in the mixed layer code. real :: ustar_min !< A minimum value of ustar to avoid numerical - !! problems (m/s). If the value is small enough, + !! problems (Z/s). If the value is small enough, !! this parameter should not affect the solution. real :: TKE_decay !< ratio of natural Ekman depth to TKE decay scale (nondim) real :: mstar !< ratio of friction velocity cubed to @@ -1551,7 +1551,9 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, real, dimension(SZI_(G)) :: I_decay ! A decay rate in Z-1. real, dimension(SZI_(G)) :: Kd_mlr_ml ! Diffusivities associated with mixed layer radiation, in Z2 s-1. - real :: f_sq, h_ml_sq, ustar_sq + real :: f_sq ! The square of the local Coriolis parameter or a related variable, in s-2. + real :: h_ml_sq ! The square of the mixed layer thickness, in Z2. + real :: ustar_sq ! ustar squared in Z2 s-2. real :: Kd_mlr ! A diffusivity associated with mixed layer turbulence radiation, in Z2 s-1. real :: C1_6 ! 1/6 real :: Omega2 ! rotation rate squared (1/s2) @@ -1587,8 +1589,8 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, ustar_sq = max(fluxes%ustar(i,j), CS%ustar_min)**2 - TKE_ml_flux(i) = (CS%mstar*CS%ML_rad_coeff)*(ustar_sq*fluxes%ustar(i,j)) - I_decay_len2_TKE = CS%TKE_decay**2 * (f_sq / (US%m_to_Z**2*ustar_sq)) + TKE_ml_flux(i) = (CS%mstar*CS%ML_rad_coeff)*(US%Z_to_m**3*ustar_sq*fluxes%ustar(i,j)) + I_decay_len2_TKE = CS%TKE_decay**2 * (f_sq / ustar_sq) if (CS%ML_rad_TKE_decay) & TKE_ml_flux(i) = TKE_ml_flux(i) * exp(-h_ml(i) * sqrt(I_decay_len2_TKE)) @@ -1984,7 +1986,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, diag_to_Z "length scale.", default=.false.) if (CS%ML_radiation) then ! This give a minimum decay scale that is typically much less than Angstrom. - CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_m + GV%H_subroundoff*GV%H_to_m) + CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_subroundoff*GV%H_to_Z) call get_param(param_file, mdl, "ML_RAD_EFOLD_COEFF", CS%ML_rad_efold_coeff, & "A coefficient that is used to scale the penetration \n"//& diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index c623b0c0a8..cb80ebb0c0 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1206,7 +1206,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri if (CS%omega_frac > 0.0) & absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif - U_star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i+1,j))*US%m_to_Z) + U_star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i+1,j))) Idecay_len_TKE(I) = ((absf / U_star) * CS%TKE_decay) * GV%H_to_Z endif enddo @@ -1442,7 +1442,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif - U_star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i,j+1))*US%m_to_Z) + U_star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i,j+1))) Idecay_len_TKE(i) = ((absf / U_star) * CS%TKE_decay) * GV%H_to_Z endif diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index aa0b40ba17..3bcc287058 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1296,11 +1296,11 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, do i=is,ie ; if (do_i(i)) then if (GV%nkml>0) nk_visc(i) = real(GV%nkml+1) if (work_on_u) then - u_star(I) = 0.5*US%m_to_Z*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star(I) = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) absf(I) = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) if (CS%dynamic_viscous_ML) nk_visc(I) = visc%nkml_visc_u(I,j) + 1 else - u_star(i) = 0.5*US%m_to_Z*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star(i) = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) absf(i) = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) if (CS%dynamic_viscous_ML) nk_visc(i) = visc%nkml_visc_v(i,J) + 1 endif @@ -1311,16 +1311,16 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (do_OBCS) then ; if (work_on_u) then do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) & - u_star(I) = US%m_to_Z*forces%ustar(i,j) + u_star(I) = forces%ustar(i,j) if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) & - u_star(I) = US%m_to_Z*forces%ustar(i+1,j) + u_star(I) = forces%ustar(i+1,j) endif ; enddo else do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) & - u_star(i) = US%m_to_Z*forces%ustar(i,j) + u_star(i) = forces%ustar(i,j) if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) & - u_star(i) = US%m_to_Z*forces%ustar(i,j+1) + u_star(i) = forces%ustar(i,j+1) endif ; enddo endif ; endif diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90 index 80d727ddfc..36aef6df6c 100644 --- a/src/user/Idealized_Hurricane.F90 +++ b/src/user/Idealized_Hurricane.F90 @@ -26,6 +26,7 @@ module Idealized_hurricane use MOM_grid, only : ocean_grid_type use MOM_safe_alloc, only : safe_alloc_ptr use MOM_time_manager, only : time_type, operator(+), operator(/), time_type_to_real +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, surface use MOM_verticalGrid, only : verticalGrid_type @@ -196,17 +197,13 @@ subroutine idealized_hurricane_wind_init(Time, G, param_file, CS) end subroutine idealized_hurricane_wind_init !> Computes the surface wind for the idealized hurricane test cases -subroutine idealized_hurricane_wind_forcing(state, forces, day, G, CS) - type(surface), & - intent(in) :: state !< Surface state structure - type(mech_forcing), & - intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), & - intent(in) :: day !< Time in days - type(ocean_grid_type), & - intent(inout) :: G !< Grid structure - type(idealized_hurricane_CS), & - pointer :: CS !< Container for idealized hurricane parameters +subroutine idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) + type(surface), intent(in) :: state !< Surface state structure + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + type(time_type), intent(in) :: day !< Time in days + type(ocean_grid_type), intent(inout) :: G !< Grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(idealized_hurricane_CS), pointer :: CS !< Container for idealized hurricane parameters ! Local variables integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq @@ -305,7 +302,7 @@ subroutine idealized_hurricane_wind_forcing(state, forces, day, G, CS) do j=js,je do i=is,ie ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(CS%gustiness/CS%Rho0 + & + forces%ustar(i,j) = US%m_to_Z * G%mask2dT(i,j) * sqrt(CS%gustiness/CS%Rho0 + & sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) enddo @@ -445,11 +442,12 @@ end subroutine idealized_hurricane_wind_profile !! It is included as an additional subroutine rather than padded into the previous !! routine with flags to ease its eventual removal. Its functionality is replaced !! with the new routines and it can be deleted when answer changes are acceptable. -subroutine SCM_idealized_hurricane_wind_forcing(state, forces, day, G, CS) - type(surface), intent(in) :: state !< Surface state structure - type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), intent(in) :: day !< Time in days - type(ocean_grid_type), intent(inout) :: G !< Grid structure +subroutine SCM_idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) + type(surface), intent(in) :: state !< Surface state structure + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + type(time_type), intent(in) :: day !< Time in days + type(ocean_grid_type), intent(inout) :: G !< Grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(idealized_hurricane_CS), pointer :: CS !< Container for SCM parameters ! Local variables integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq @@ -606,7 +604,7 @@ subroutine SCM_idealized_hurricane_wind_forcing(state, forces, day, G, CS) ! Set the surface friction velocity, in units of m s-1. ustar is always positive. do j=js,je ; do i=is,ie ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = G%mask2dT(i,j) * sqrt(CS%gustiness/CS%Rho0 + & + forces%ustar(i,j) = US%m_to_Z * G%mask2dT(i,j) * sqrt(CS%gustiness/CS%Rho0 + & sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) enddo ; enddo diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 4b3300ccd3..1ede95cce5 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -465,11 +465,11 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure type(ocean_grid_type), intent(inout) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h ! Date: Fri, 9 Nov 2018 14:41:39 -0500 Subject: [PATCH 0900/1072] Split excessively long lines Split two lines that had become longer than 120 characters with the recent addtion of new subroutine arguments and scaling factors. All answers are bitwise identical. --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 6 ++++-- src/user/baroclinic_zone_initialization.F90 | 3 ++- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 995301fcc8..050fad5089 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -3590,8 +3590,10 @@ subroutine ice_shelf_temp(CS, ISS, G, US, time_step, melt_rate, Time) do i=isc,iec if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2)) then if (ISS%h_shelf(i,j) > 0.0) then -! CS%t_shelf(i,j) = CS%t_shelf(i,j) + time_step*(adot*Tsurf - US%m_to_Z*melt_rate(i,j)*ISS%tfreeze(i,j))/(ISS%h_shelf(i,j)) - CS%t_shelf(i,j) = CS%t_shelf(i,j) + time_step*(adot*Tsurf - (3.0*US%m_to_Z/spy)*ISS%tfreeze(i,j)) / ISS%h_shelf(i,j) +! CS%t_shelf(i,j) = CS%t_shelf(i,j) + & +! time_step*(adot*Tsurf - US%m_to_Z*melt_rate(i,j)*ISS%tfreeze(i,j))/(ISS%h_shelf(i,j)) + CS%t_shelf(i,j) = CS%t_shelf(i,j) + & + time_step*(adot*Tsurf - (3.0*US%m_to_Z/spy)*ISS%tfreeze(i,j)) / ISS%h_shelf(i,j) else ! the ice is about to melt away ! in this case set thickness, area, and mask to zero diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index 27d70283dc..b9bab35f59 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -94,7 +94,8 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, US, param_f is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call bcz_params(G, GV, US, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, delta_T, dTdx, L_zone, just_read_params) + call bcz_params(G, GV, US, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, & + delta_T, dTdx, L_zone, just_read_params) if (just_read) return ! All run-time parameters have been read, so return. From 4605c864ca8f752e269561a447cb3f01982a6067 Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Mon, 12 Nov 2018 10:56:29 -0600 Subject: [PATCH 0901/1072] modified: src/parameterizations/lateral/MOM_MEKE.F90 so as to include topographic beta effect in computing Rhines scale --- src/parameterizations/lateral/MOM_MEKE.F90 | 53 ++++++++++++++++++---- 1 file changed, 45 insertions(+), 8 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 25e61b3cf3..8a42aa30cd 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -1,4 +1,6 @@ !> Implements the Mesoscale Eddy Kinetic Energy framework +! with topographic beta effect included in computing beta in Rhines scale + module MOM_MEKE ! This file is part of MOM6. See LICENSE.md for the license. @@ -61,8 +63,10 @@ module MOM_MEKE real :: aEady !< Weighting towards Eady scale of mixing length (non-dim.) real :: aGrid !< Weighting towards grid scale of mixing length (non-dim.) real :: MEKE_advection_factor !< A scaling in front of the advection of MEKE (non-dim.) + real :: MEKE_topographic_beta !< weighting how much topographic beta is considered + ! when computing beta in Rhines scale logical :: initialize !< If True, invokes a steady state solver to calculate MEKE. - logical :: debug !< If true, write out checksums of data for debugging + logical :: debug !< If true, write out checksums of data for debugging ! Optional storage real, dimension(:,:), allocatable :: del2MEKE !< Laplacian of MEKE, used for bi-harmonic diffusion. @@ -557,12 +561,15 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m real :: beta, SN, bottomFac2, barotrFac2, LmixScale, Lrhines, Leady real :: I_H, KhCoeff, Kh, Ubg2, cd2, drag_rate, ldamping, src real :: EKE, EKEmin, EKEmax, resid, ResMin, ResMax, EKEerr + real, dimension(SZI_(G),SZJ_(G)) :: D, lat, lon !< ocean depth, lat, & lon at h-points + real :: FatH ! Coriolis parameter at h points; to compute topographic beta integer :: i, j, is, ie, js, je, n1, n2 real, parameter :: tolerance = 1.e-12 ! Width of EKE bracket in m^2 s^-2. logical :: useSecant, debugIteration is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - + D = G%bathyT; lat = G%geolatt; lon = G%geolont + debugIteration = .false. KhCoeff = CS%MEKE_KhCoeff Ubg2 = CS%MEKE_Uscale**2 @@ -573,7 +580,13 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m !SN = 0.25*max( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)), 0.) ! This avoids extremes values in equilibrium solution due to bad values in SN_u, SN_v SN = min( min(SN_u(I,j) , SN_u(I-1,j)) , min(SN_v(i,J), SN_v(i,J-1)) ) - beta = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) + + FatH = 0.25*((G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) + & + (G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1))) !< Coriolis parameter at h points + beta = sqrt( ( G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH/D(i,j)*(D(i+1,j) - D(i-1,j)) & + /2./G%dxT(i,j) )**2. + ( G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH/D(i,j) & + *(D(i,j+1) - D(i,j-1))/2./G%dyT(i,j) )**2. ) + I_H = GV%Rho0 * I_mass(i,j) if (KhCoeff*SN*I_H>0.) then @@ -678,11 +691,12 @@ subroutine MEKE_lengthScales(CS, MEKE, G, US, SN_u, SN_v, & real, dimension(SZI_(G),SZJ_(G)), intent(out) :: barotrFac2 !< gamma_t^2 real, dimension(SZI_(G),SZJ_(G)), intent(out) :: LmixScale !< Eddy mixing length (m). ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: Lrhines, Leady - real :: beta, SN + real, dimension(SZI_(G),SZJ_(G)) :: Lrhines, Leady, D, lat, lon + real :: beta, SN, FatH integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + D = G%bathyT; lat = G%geolatt; lon = G%geolont !$OMP do do j=js,je ; do i=is,ie @@ -692,7 +706,11 @@ subroutine MEKE_lengthScales(CS, MEKE, G, US, SN_u, SN_v, & else SN = 0. endif - beta = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) + FatH = 0.25*( ( G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1) ) + & + ( G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1) ) ) !< Coriolis parameter at h points + beta = sqrt( ( G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH/D(i,j)*(D(i+1,j) - D(i-1,j)) & + /2./G%dxT(i,j) )**2. + ( G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH/D(i,j) & + *(D(i,j+1) - D(i,j-1))/2./G%dyT(i,j) )**2. ) endif ! Returns bottomFac2, barotrFac2 and LmixScale call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & @@ -927,6 +945,11 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) "Using unity would be normal but other values could accomodate a mismatch\n"//& "between the advecting barotropic flow and the vertical structure of MEKE.", & units="nondim", default=0.0) + call get_param(param_file, mdl, "MEKE_topographic_beta", CS%MEKE_topographic_beta, & + "A scale factor to determine how much topographic beta is weighed in " //& + "computing beta in the expression of Rhines scale. Use 1 if full "//& + "topographic beta effect is considered; use 0 if it's completely ignored.", & + units="nondim", default=0.0) ! Nonlocal module parameters call get_param(param_file, mdl, "CDRAG", CS%cdrag, & @@ -1235,7 +1258,7 @@ end subroutine MEKE_end !! !! \f{eqnarray*}{ !! L_d & = & \sqrt{\frac{c_g^2}{f^2+2\beta c_g}} \sim \frac{ c_g }{f} \\\\ -!! L_R & = & \sqrt{\frac{U_e}{\beta}} \\\\ +!! L_R & = & \sqrt{\frac{U_e}{\beta^*}} \\\\ !! L_e & = & \frac{U_e}{|S| N} \\\\ !! L_f & = & \frac{H}{c_d} \\\\ !! L_\Delta & = & \sqrt{A_\Delta} . @@ -1243,8 +1266,21 @@ end subroutine MEKE_end !! !! \f$L_c\f$ is a constant and \f$\delta[L_c]\f$ is the impulse function so that the term !! \f$\frac{\delta[L_c]}{L_c}\f$ evaluates to \f$\frac{1}{L_c}\f$ when \f$L_c\f$ is non-zero -!! but is dropped if \f$L_c=0\f$. +!! but is dropped if \f$L_c=0\fi$. +!! +!! \f$\beta^*\f$ is the effective \f$\beta\f$ that combines both the planetary vorticity +!! gradient (i.e. \f$\beta=\nabla f\f$) and the topographic \f$\beta\f$ effect, +!! with the latter weighed by a weighting constant, \f$c_\beta\f$, that varies +!! from 0 to 1, so that \f$c_\beta=0\f$ means the topographic \f$\beta\f$ effect is ignored, +!! while \f$c_\beta=1\f$ means it is fully considered. The new \f$\beta^*\f$ therefore +!! takes the form of !! +!! \f[ +!! \beta^* = \sqrt{( \partial_xf - c_\beta\frac{f}{D}\partial_xD )^2 + +!! ( \partial_yf - c_\beta\frac{f}{D}\partial_yD )^2} +!! \f] +!! where \f$D\f$ is water column depth at T points. +!! !! \subsection section_MEKE_viscosity Viscosity derived from MEKE !! !! As for \f$ \kappa_M \f$, the predicted eddy velocity scale can be @@ -1295,6 +1331,7 @@ end subroutine MEKE_end !! | \f$ \alpha_e \f$ | MEKE_ALPHA_EADY | !! | \f$ \alpha_\Delta \f$ | MEKE_ALPHA_GRID | !! | \f$ L_c \f$ | MEKE_FIXED_MIXING_LENGTH | +!! | \f$ c_\beta \f$ | MEKE_TOPOGRAPHIC_BETA | !! | - | MEKE_KHTH_FAC | !! | - | MEKE_KHTR_FAC | !! From 3e67206dec2e19267e508d8c8a284f9fa5ee9d2b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 13 Nov 2018 12:10:46 -0500 Subject: [PATCH 0902/1072] +Changed units of fluxes%ustar_shelf to Z/s Changed the units of fluxes%ustar_shelf and fluxes%ustar_berg from m/s to Z/s for dimensional consistency testing. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- .../coupled_driver/MOM_surface_forcing.F90 | 2 +- config_src/mct_driver/MOM_surface_forcing.F90 | 2 +- src/core/MOM_forcing_type.F90 | 8 +++---- src/ice_shelf/MOM_ice_shelf.F90 | 22 +++++++++---------- src/ice_shelf/MOM_marine_ice.F90 | 4 ++-- .../vertical/MOM_bulk_mixed_layer.F90 | 4 ++-- .../vertical/MOM_energetic_PBL.F90 | 2 +- 7 files changed, 21 insertions(+), 23 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 98e5b1adc4..045a9dc7de 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -414,7 +414,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%ustar_berg)) & - fluxes%ustar_berg(i,j) = IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) + 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) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index d62729cf6f..1e07e791e8 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -422,7 +422,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & ! .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) = IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) + ! 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)) & diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index fb8c3e3b86..770cfc6e35 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -129,12 +129,12 @@ module MOM_forcing_type ! iceberg related inputs real, pointer, dimension(:,:) :: & - ustar_berg => NULL(), & !< iceberg contribution to top ustar (m/s) + ustar_berg => NULL(), & !< iceberg contribution to top ustar (Z/s) area_berg => NULL(), & !< area of ocean surface covered by icebergs (m2/m2) mass_berg => NULL() !< mass of icebergs (kg/m2) ! land ice-shelf related inputs - real, pointer, dimension(:,:) :: ustar_shelf => NULL() !< Friction velocity under ice-shelves (in m/s) + real, pointer, dimension(:,:) :: ustar_shelf => NULL() !< Friction velocity under ice-shelves (in Z/s) !! as computed by the ocean at the previous time step. real, pointer, dimension(:,:) :: frac_shelf_h => NULL() !< Fractional ice shelf coverage of h-cells, nondimensional !! cells, nondimensional from 0 to 1. This is only @@ -1167,7 +1167,7 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, if (present(use_berg_fluxes)) then if (use_berg_fluxes) then handles%id_ustar_berg = register_diag_field('ocean_model', 'ustar_berg', diag%axesT1, Time, & - 'Friction velocity below iceberg ', 'm s-1') + 'Friction velocity below iceberg ', 'm s-1', conversion=US%Z_to_m) handles%id_area_berg = register_diag_field('ocean_model', 'area_berg', diag%axesT1, Time, & 'Area of grid cell covered by iceberg ', 'm2 m-2') @@ -1176,7 +1176,7 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, 'Mass of icebergs ', 'kg m-2') handles%id_ustar_ice_cover = register_diag_field('ocean_model', 'ustar_ice_cover', diag%axesT1, Time, & - 'Friction velocity below iceberg and ice shelf together', 'm s-1') + 'Friction velocity below iceberg and ice shelf together', 'm s-1', conversion=US%Z_to_m) handles%id_frac_ice_cover = register_diag_field('ocean_model', 'frac_ice_cover', diag%axesT1, Time, & 'Area of grid cell below iceberg and ice shelf together ', 'm2 m-2') diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 3e0b978de5..a7b89c4934 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -83,7 +83,7 @@ module MOM_ice_shelf real, pointer, dimension(:,:) :: & utide => NULL() !< tidal velocity, in m/s - real :: ustar_bg !< A minimum value for ustar under ice shelves, in m s-1. + real :: ustar_bg !< A minimum value for ustar under ice shelves, in Z s-1. real :: cdrag !< drag coefficient under ice shelves , non-dimensional. real :: g_Earth !< The gravitational acceleration in m s-2. real :: Cp !< The heat capacity of sea water, in J kg-1 K-1. @@ -356,12 +356,11 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) u_at_h = state%u(i,j) v_at_h = state%v(i,j) - fluxes%ustar_shelf(i,j)= sqrt(CS%cdrag*((u_at_h**2.0 + v_at_h**2.0) +& - CS%utide(i,j)**1)) + !### I think that CS%utide**1 should be CS%utide**2 + fluxes%ustar_shelf(i,j) = MAX(CS%ustar_bg, US%m_to_Z * & + sqrt(CS%cdrag*((u_at_h**2.0 + v_at_h**2.0) + CS%utide(i,j)**1))) - ustar_h = MAX(CS%ustar_bg, fluxes%ustar_shelf(i,j)) - - fluxes%ustar_shelf(i,j) = ustar_h + ustar_h = US%Z_to_m*fluxes%ustar_shelf(i,j) if (associated(state%taux_shelf) .and. associated(state%tauy_shelf)) then state%taux_shelf(i,j) = ustar_h*ustar_h*CS%Rho0*Isqrt2 @@ -931,7 +930,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) ! tauy2 = (asv1 * state%tauy_shelf(i,J-1)**2 + & ! asv2 * state%tauy_shelf(i,J)**2 ) / (asv1 + asv2) - !fluxes%ustar(i,j) = MAX(CS%ustar_bg, sqrt(Irho0 * sqrt(taux2 + tauy2))) + !fluxes%ustar(i,j) = MAX(CS%ustar_bg, US%m_to_Z*sqrt(Irho0 * sqrt(taux2 + tauy2))) ! endif ; enddo ; enddo if (CS%active_shelf_dynamics .or. CS%override_shelf_movement) then @@ -1345,8 +1344,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "USTAR_SHELF_BG", CS%ustar_bg, & - "The minimum value of ustar under ice sheves.", units="m s-1", & - default=0.0) + "The minimum value of ustar under ice sheves.", & + units="m s-1", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "CDRAG_SHELF", cdrag, & "CDRAG is the drag coefficient relating the magnitude of \n"//& "the velocity field to the surface stress.", units="nondim", & @@ -1357,9 +1356,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl "DRAG_BG_VEL is either the assumed bottom velocity (with \n"//& "LINEAR_DRAG) or an unresolved velocity that is \n"//& "combined with the resolved velocity to estimate the \n"//& - "velocity magnitude.", units="m s-1", default=0.0) + "velocity magnitude.", units="m s-1", default=0.0, scale=US%m_to_Z) if (CS%cdrag*drag_bg_vel > 0.0) CS%ustar_bg = sqrt(CS%cdrag)*drag_bg_vel - endif ! Allocate and initialize state variables to default values @@ -1571,7 +1569,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl CS%id_tfl_shelf = register_diag_field('ocean_model', 'tflux_shelf', CS%diag%axesT1, CS%Time, & 'Heat conduction into ice shelf', 'W m-2') CS%id_ustar_shelf = register_diag_field('ocean_model', 'ustar_shelf', CS%diag%axesT1, CS%Time, & - 'Fric vel under shelf', 'm/s') + 'Fric vel under shelf', 'm/s', conversion=US%Z_to_m) if (CS%active_shelf_dynamics) then CS%id_h_mask = register_diag_field('ocean_model', 'h_mask', CS%diag%axesT1, CS%Time, & 'ice shelf thickness mask', 'none') diff --git a/src/ice_shelf/MOM_marine_ice.F90 b/src/ice_shelf/MOM_marine_ice.F90 index 343aacd452..8592273775 100644 --- a/src/ice_shelf/MOM_marine_ice.F90 +++ b/src/ice_shelf/MOM_marine_ice.F90 @@ -136,8 +136,8 @@ subroutine iceberg_fluxes(G, fluxes, use_ice_shelf, sfc_state, & fluxes%ustar_shelf(:,:) = 0. endif do j=jsd,jed ; do i=isd,ied ; if (G%areaT(i,j) > 0.0) then - fluxes%frac_shelf_h(i,j) = fluxes%frac_shelf_h(i,j) + fluxes%area_berg(i,j) - fluxes%ustar_shelf(i,j) = fluxes%ustar_shelf(i,j) + fluxes%ustar_berg(i,j) + fluxes%frac_shelf_h(i,j) = fluxes%frac_shelf_h(i,j) + fluxes%area_berg(i,j) + fluxes%ustar_shelf(i,j) = fluxes%ustar_shelf(i,j) + fluxes%ustar_berg(i,j) endif ; enddo ; enddo !Zero'ing out other fluxes under the tabular icebergs diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 6f055ce61a..5d74f0d4d2 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -668,7 +668,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & kU_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * kU_star + & - fluxes%frac_shelf_h(i,j) * (0.41*US%m_to_Z*fluxes%ustar_shelf(i,j)) + fluxes%frac_shelf_h(i,j) * (0.41*fluxes%ustar_shelf(i,j)) endif absf_x_H = 0.25 * US%m_to_Z * h(i,0) * & !### I think this should be H_to_Z -RWH ((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & @@ -1372,7 +1372,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & U_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & - fluxes%frac_shelf_h(i,j) * US%m_to_Z * fluxes%ustar_shelf(i,j) + fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) endif if (U_Star < CS%ustar_min) U_Star = CS%ustar_min diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index a3a08fff63..0f685693c3 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -608,7 +608,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & U_star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & - fluxes%frac_shelf_h(i,j) * US%m_to_Z*fluxes%ustar_shelf(i,j) + fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) endif if (U_Star < CS%ustar_min) U_Star = CS%ustar_min From 9e81fb5ea9bcb21296dfc1d527b5e7039d07cadb Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Tue, 13 Nov 2018 16:15:29 -0600 Subject: [PATCH 0903/1072] modified: src/parameterizations/lateral/MOM_MEKE.F90 to remove the redundant copy of G%bathyT, lat, and lon --- src/parameterizations/lateral/MOM_MEKE.F90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 8a42aa30cd..8294bdbedb 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -561,14 +561,12 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m real :: beta, SN, bottomFac2, barotrFac2, LmixScale, Lrhines, Leady real :: I_H, KhCoeff, Kh, Ubg2, cd2, drag_rate, ldamping, src real :: EKE, EKEmin, EKEmax, resid, ResMin, ResMax, EKEerr - real, dimension(SZI_(G),SZJ_(G)) :: D, lat, lon !< ocean depth, lat, & lon at h-points real :: FatH ! Coriolis parameter at h points; to compute topographic beta integer :: i, j, is, ie, js, je, n1, n2 real, parameter :: tolerance = 1.e-12 ! Width of EKE bracket in m^2 s^-2. logical :: useSecant, debugIteration is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - D = G%bathyT; lat = G%geolatt; lon = G%geolont debugIteration = .false. KhCoeff = CS%MEKE_KhCoeff @@ -583,9 +581,10 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m FatH = 0.25*((G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) + & (G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1))) !< Coriolis parameter at h points - beta = sqrt( ( G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH/D(i,j)*(D(i+1,j) - D(i-1,j)) & - /2./G%dxT(i,j) )**2. + ( G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH/D(i,j) & - *(D(i,j+1) - D(i,j-1))/2./G%dyT(i,j) )**2. ) + beta = sqrt( ( G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j)* & + (G%bathyT(i+1,j) - G%bathyT(i-1,j))/2./G%dxT(i,j) )**2. & + + ( G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & + *(G%bathyT(i,j+1) - G%bathyT(i,j-1))/2./G%dyT(i,j) )**2. ) I_H = GV%Rho0 * I_mass(i,j) @@ -691,7 +690,7 @@ subroutine MEKE_lengthScales(CS, MEKE, G, US, SN_u, SN_v, & real, dimension(SZI_(G),SZJ_(G)), intent(out) :: barotrFac2 !< gamma_t^2 real, dimension(SZI_(G),SZJ_(G)), intent(out) :: LmixScale !< Eddy mixing length (m). ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: Lrhines, Leady, D, lat, lon + real, dimension(SZI_(G),SZJ_(G)) :: Lrhines, Leady real :: beta, SN, FatH integer :: i, j, is, ie, js, je @@ -708,9 +707,10 @@ subroutine MEKE_lengthScales(CS, MEKE, G, US, SN_u, SN_v, & endif FatH = 0.25*( ( G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1) ) + & ( G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1) ) ) !< Coriolis parameter at h points - beta = sqrt( ( G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH/D(i,j)*(D(i+1,j) - D(i-1,j)) & - /2./G%dxT(i,j) )**2. + ( G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH/D(i,j) & - *(D(i,j+1) - D(i,j-1))/2./G%dyT(i,j) )**2. ) + beta = sqrt( ( G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & + *(G%bathyT(i+1,j) - G%bathyT(i-1,j)) /2./G%dxT(i,j) )**2. & + + ( G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & + *(G%bathyT(i,j+1) - G%bathyT(i,j-1))/2./G%dyT(i,j) )**2. ) endif ! Returns bottomFac2, barotrFac2 and LmixScale call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & From 639cfbf3719470e51a7289afdb5262c35cc79345 Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Tue, 13 Nov 2018 16:19:40 -0600 Subject: [PATCH 0904/1072] modified: src/parameterizations/lateral/MOM_MEKE.F90 --- src/parameterizations/lateral/MOM_MEKE.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 8294bdbedb..6cf96d395d 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -695,7 +695,6 @@ subroutine MEKE_lengthScales(CS, MEKE, G, US, SN_u, SN_v, & integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - D = G%bathyT; lat = G%geolatt; lon = G%geolont !$OMP do do j=js,je ; do i=is,ie From ae07097fe0f33b5931d4bd1f2656191fcc68c450 Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Tue, 13 Nov 2018 16:28:30 -0600 Subject: [PATCH 0905/1072] modified: src/parameterizations/lateral/MOM_MEKE.F90 --- src/parameterizations/lateral/MOM_MEKE.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 6cf96d395d..79e1755983 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -944,7 +944,7 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) "Using unity would be normal but other values could accomodate a mismatch\n"//& "between the advecting barotropic flow and the vertical structure of MEKE.", & units="nondim", default=0.0) - call get_param(param_file, mdl, "MEKE_topographic_beta", CS%MEKE_topographic_beta, & + call get_param(param_file, mdl, "MEKE_TOPOGRAPHIC_BETA", CS%MEKE_topographic_beta, & "A scale factor to determine how much topographic beta is weighed in " //& "computing beta in the expression of Rhines scale. Use 1 if full "//& "topographic beta effect is considered; use 0 if it's completely ignored.", & From cbb5480693f45274e55b464f234e298a7fe02440 Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Wed, 14 Nov 2018 12:24:01 -0600 Subject: [PATCH 0906/1072] modified: src/parameterizations/lateral/MOM_MEKE.F90 --- src/parameterizations/lateral/MOM_MEKE.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 79e1755983..b0cc3008e0 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -63,10 +63,10 @@ module MOM_MEKE real :: aEady !< Weighting towards Eady scale of mixing length (non-dim.) real :: aGrid !< Weighting towards grid scale of mixing length (non-dim.) real :: MEKE_advection_factor !< A scaling in front of the advection of MEKE (non-dim.) - real :: MEKE_topographic_beta !< weighting how much topographic beta is considered + real :: MEKE_topographic_beta !< weighting how much topographic beta is considered ! when computing beta in Rhines scale logical :: initialize !< If True, invokes a steady state solver to calculate MEKE. - logical :: debug !< If true, write out checksums of data for debugging + logical :: debug !< If true, write out checksums of data for debugging ! Optional storage real, dimension(:,:), allocatable :: del2MEKE !< Laplacian of MEKE, used for bi-harmonic diffusion. @@ -567,7 +567,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m logical :: useSecant, debugIteration is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - + debugIteration = .false. KhCoeff = CS%MEKE_KhCoeff Ubg2 = CS%MEKE_Uscale**2 @@ -585,7 +585,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m (G%bathyT(i+1,j) - G%bathyT(i-1,j))/2./G%dxT(i,j) )**2. & + ( G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & *(G%bathyT(i,j+1) - G%bathyT(i,j-1))/2./G%dyT(i,j) )**2. ) - + I_H = GV%Rho0 * I_mass(i,j) if (KhCoeff*SN*I_H>0.) then @@ -1266,7 +1266,7 @@ end subroutine MEKE_end !! \f$L_c\f$ is a constant and \f$\delta[L_c]\f$ is the impulse function so that the term !! \f$\frac{\delta[L_c]}{L_c}\f$ evaluates to \f$\frac{1}{L_c}\f$ when \f$L_c\f$ is non-zero !! but is dropped if \f$L_c=0\fi$. -!! +!! !! \f$\beta^*\f$ is the effective \f$\beta\f$ that combines both the planetary vorticity !! gradient (i.e. \f$\beta=\nabla f\f$) and the topographic \f$\beta\f$ effect, !! with the latter weighed by a weighting constant, \f$c_\beta\f$, that varies @@ -1274,12 +1274,12 @@ end subroutine MEKE_end !! while \f$c_\beta=1\f$ means it is fully considered. The new \f$\beta^*\f$ therefore !! takes the form of !! -!! \f[ -!! \beta^* = \sqrt{( \partial_xf - c_\beta\frac{f}{D}\partial_xD )^2 + +!! \f[ +!! \beta^* = \sqrt{( \partial_xf - c_\beta\frac{f}{D}\partial_xD )^2 + !! ( \partial_yf - c_\beta\frac{f}{D}\partial_yD )^2} !! \f] !! where \f$D\f$ is water column depth at T points. -!! +!! !! \subsection section_MEKE_viscosity Viscosity derived from MEKE !! !! As for \f$ \kappa_M \f$, the predicted eddy velocity scale can be From 8f62d18c90e77582a18e92c1eacc90510d3e921a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 14 Nov 2018 16:04:34 -0500 Subject: [PATCH 0907/1072] Corrected 8 comments Corrected the grid staggering locations indicated in 6 comments, the text of a seventh and added units in an eighth. All answers are bitwise identical. --- src/parameterizations/lateral/MOM_MEKE.F90 | 11 +++++------ .../lateral/MOM_lateral_mixing_coeffs.F90 | 6 +++--- src/tracer/MOM_neutral_diffusion.F90 | 2 +- 3 files changed, 9 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 25e61b3cf3..50699f6932 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -96,11 +96,11 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg m-2). real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points (s-1). - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at u-points (s-1). + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points (s-1). type(vertvisc_type), intent(in) :: visc !< The vertical viscosity type. real, intent(in) :: dt !< Model(baroclinic) time-step (s). type(MEKE_CS), pointer :: CS !< MEKE control structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: hu !< Zonal flux flux (H m2 s-1). + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: hu !< Zonal mass flux (H m2 s-1). real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: hv !< Meridional mass flux (H m2 s-1). ! Local variables @@ -550,8 +550,8 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m type(MEKE_CS), pointer :: CS !< MEKE control structure. type(MEKE_type), pointer :: MEKE !< MEKE data. real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points (s-1). - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at u-points (s-1). - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: drag_rate_visc !< Mean flow contrib. to drag rate + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points (s-1). + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: drag_rate_visc !< Mean flow contrib. to drag rate real, dimension(SZI_(G),SZJ_(G)), intent(in) :: I_mass !< Inverse of column mass. ! Local variables real :: beta, SN, bottomFac2, barotrFac2, LmixScale, Lrhines, Leady @@ -669,10 +669,9 @@ subroutine MEKE_lengthScales(CS, MEKE, G, US, SN_u, SN_v, & type(MEKE_CS), pointer :: CS !< MEKE control structure. type(MEKE_type), pointer :: MEKE !< MEKE data. type(ocean_grid_type), intent(inout) :: G !< Ocean grid. -! type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points (s-1). - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at u-points (s-1). + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points (s-1). real, dimension(SZI_(G),SZJ_(G)), intent(in) :: EKE !< Eddy kinetic energy (m2/s2). real, dimension(SZI_(G),SZJ_(G)), intent(out) :: bottomFac2 !< gamma_b^2 real, dimension(SZI_(G),SZJ_(G)), intent(out) :: barotrFac2 !< gamma_t^2 diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 9be4f3d984..4963ba4bf0 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -389,8 +389,8 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & e ! The interface heights relative to mean sea level, in m. - real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: N2_u ! Square of Brunt-Vaisala freq at u-points - real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: N2_v ! Square of Brunt-Vaisala freq at u-points + real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: N2_u ! Square of Brunt-Vaisala freq at u-points, in s-2 + real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: N2_v ! Square of Brunt-Vaisala freq at v-points, in s-2 if (.not. associated(CS)) call MOM_error(FATAL, "MOM_lateral_mixing_coeffs.F90, calc_slope_functions:"//& "Module must be initialized before it is used.") @@ -584,7 +584,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop !! otherwise use slopes stored in CS ! Local variables real :: E_x(SZIB_(G), SZJ_(G)) ! X-slope of interface at u points (for diagnostics) - real :: E_y(SZI_(G), SZJB_(G)) ! Y-slope of interface at u points (for diagnostics) + real :: E_y(SZI_(G), SZJB_(G)) ! Y-slope of interface at v points (for diagnostics) real :: Khth_Loc ! Locally calculated thickness mixing coefficient (m2/s) real :: H_cutoff ! Local estimate of a minimum thickness for masking (m) real :: h_neglect ! A thickness that is so small it is usually lost diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 4002fe646b..b7d9dba592 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -412,7 +412,7 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, CS) type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (H units) real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Coef_x !< dt * Kh * dy / dx at u-points (m^2) - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Coef_y !< dt * Kh * dx / dy at u-points (m^2) + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Coef_y !< dt * Kh * dx / dy at v-points (m^2) real, intent(in) :: dt !< Tracer time step * I_numitts !! (I_numitts in tracer_hordiff) type(tracer_registry_type), pointer :: Reg !< Tracer registry From dcdc509c1c91769e68e944830cc84aaa7ef892ac Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 14 Nov 2018 17:46:07 -0500 Subject: [PATCH 0908/1072] +Add US arg to set_up_ALE_sponge_vel_field_varying Use US%m_to_Z in place of G%Zd_to_m to convert units from m to Z in set_up_ALE_sponge_vel_field_varying, whic required adding a unit_scale_type argument. All answers are bitwise identical. --- src/parameterizations/vertical/MOM_ALE_sponge.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 1ad8e44960..b08e77e213 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -741,13 +741,14 @@ end subroutine set_up_ALE_sponge_vel_field_fixed !> This subroutine stores the reference profile at uand v points for the variable !! whose address is given by u_ptr and v_ptr. subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename_v, fieldname_v, & - Time, G, CS, u_ptr, v_ptr) + Time, G, US, CS, u_ptr, v_ptr) character(len=*), intent(in) :: filename_u !< File name for u field character(len=*), intent(in) :: fieldname_u !< Name of u variable in file character(len=*), intent(in) :: filename_v !< File name for v field character(len=*), intent(in) :: fieldname_v !< Name of v variable in file type(time_type), intent(in) :: Time !< Model time type(ocean_grid_type), intent(inout) :: G !< Ocean grid (in) + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(in) :: u_ptr !< u pointer to the field to be damped (in). real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(in) :: v_ptr !< v pointer to the field to be damped (in). @@ -798,7 +799,7 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename ! modulo attribute of the zonal axis (mjh). call horiz_interp_and_extrap_tracer(CS%Ref_val_u%id,Time, 1.0,G,u_val,mask_u,z_in,z_edges_in,& - missing_value,.true.,.false.,.false., m_to_Z=1.0/G%Zd_to_m) + missing_value,.true.,.false.,.false., m_to_Z=US%m_to_Z) !!! TODO: add a velocity interface! (mjh) @@ -808,7 +809,7 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename ! modulo attribute of the zonal axis (mjh). call horiz_interp_and_extrap_tracer(CS%Ref_val_v%id,Time, 1.0,G,v_val,mask_v,z_in,z_edges_in, & - missing_value,.true.,.false.,.false., m_to_Z=1.0/G%Zd_to_m) + missing_value,.true.,.false.,.false., m_to_Z=US%m_to_Z) ! stores the reference profile allocate(CS%Ref_val_u%p(fld_sz(3),CS%num_col_u)) From 375bab5a0ea0ae662e100256ad5c26e95ddd1dbf Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 14 Nov 2018 17:46:57 -0500 Subject: [PATCH 0909/1072] +Rescaled variables in MOM_internal_tides Recast internal depth and height variables in MOM_internal_tides to use units of Z instead of m. This required adding a unit_scale_type arguments to internal_tides_init and itidal_lowmode_loss, and a modified call from diabatic_driver_init. All answers are bitwise identical. --- .../lateral/MOM_internal_tides.F90 | 22 +++++++++++-------- .../vertical/MOM_diabatic_driver.F90 | 2 +- 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 8978a9b1f9..527eca30bc 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -74,7 +74,7 @@ module MOM_internal_tides !< energy lost due to wave breaking [W m-2] real, allocatable, dimension(:,:) :: TKE_itidal_loss_fixed !< fixed part of the energy lost due to small-scale drag - !! [kg m-2] here; will be multiplied by N and En to get into [W m-2] + !! [kg Z-2] here; will be multiplied by N and En to get into [W m-2] real, allocatable, dimension(:,:,:,:,:) :: TKE_itidal_loss !< energy lost due to small-scale wave drag [W m-2] real, allocatable, dimension(:,:) :: tot_leak_loss !< Energy loss rates due to misc bakground processes, @@ -397,7 +397,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Finally, apply loss if (CS%apply_wave_drag) then ! Calculate loss rate and apply loss over the time step - call itidal_lowmode_loss(G, CS, Nb, Ub, CS%En, CS%TKE_itidal_loss_fixed, & + call itidal_lowmode_loss(G, US, CS, Nb, Ub, CS%En, CS%TKE_itidal_loss_fixed, & CS%TKE_itidal_loss, dt, full_halos=.false.) endif ! Check for En<0 - for debugging, delete later @@ -622,8 +622,9 @@ end subroutine sum_En !> Calculates the energy lost from the propagating internal tide due to !! scattering over small-scale roughness along the lines of Jayne & St. Laurent (2001). -subroutine itidal_lowmode_loss(G, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, dt, full_halos) +subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, dt, full_halos) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. real, dimension(G%isd:G%ied,G%jsd:G%jed), & @@ -633,7 +634,7 @@ subroutine itidal_lowmode_loss(G, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, dt, !! mode velocity, in m s-1. real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(in) :: TKE_loss_fixed !< Fixed part of energy loss, - !! in kg m-2 (rho*kappa*h^2). + !! in kg Z-2 (rho*kappa*h^2). real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle,CS%nFreq,CS%nMode), & intent(inout) :: En !< Energy density of the internal waves, in J m-2. real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle,CS%nFreq,CS%nMode), & @@ -670,7 +671,7 @@ subroutine itidal_lowmode_loss(G, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, dt, enddo ! Calculate TKE loss rate; units of [W m-2] here. - TKE_loss_tot = q_itides * TKE_loss_fixed(i,j) * Nb(i,j) * Ub(i,j,fr,m)**2 + TKE_loss_tot = q_itides * US%Z_to_m**2 * TKE_loss_fixed(i,j) * Nb(i,j) * Ub(i,j,fr,m)**2 ! Update energy remaining (this is a pseudo implicit calc) ! (E(t+1)-E(t))/dt = -TKE_loss(E(t+1)/E(t)), which goes to zero as E(t+1) goes to zero @@ -2104,10 +2105,11 @@ end subroutine PPM_limit_pos ! end subroutine register_int_tide_restarts !> This subroutine initializes the internal tides module. -subroutine internal_tides_init(Time, G, GV, param_file, diag, CS) +subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) type(time_type), target, intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate @@ -2280,7 +2282,7 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS) "dissipated locally with INT_TIDE_DISSIPATION. \n"//& "THIS NAME COULD BE BETTER.", & units="nondim", default=0.3333) - call get_param(param_file, mdl, "KAPPA_ITIDES", kappa_itides, & + call get_param(param_file, mdl, "KAPPA_ITIDES", kappa_itides, & "A topographic wavenumber used with INT_TIDE_DISSIPATION. \n"//& "The default is 2pi/10 km, as in St.Laurent et al. 2002.", & units="m-1", default=8.e-4*atan(1.0)) @@ -2312,16 +2314,18 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS) fail_if_missing=.true.) filename = trim(CS%inputdir) // trim(h2_file) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) - call MOM_read_data(filename, 'h2', h2, G%domain, timelevel=1) + call MOM_read_data(filename, 'h2', h2, G%domain, timelevel=1, scale=US%m_to_Z) do j=G%jsc,G%jec ; do i=G%isc,G%iec ! Restrict rms topo to 10 percent of column depth. - h2(i,j) = min(0.01*(G%Zd_to_m*G%bathyT(i,j))**2, h2(i,j)) + h2(i,j) = min(0.01*(G%bathyT(i,j))**2, h2(i,j)) ! Compute the fixed part; units are [kg m-2] here ! will be multiplied by N and En to get into [W m-2] CS%TKE_itidal_loss_fixed(i,j) = 0.5*kappa_h2_factor*GV%Rho0*& kappa_itides * h2(i,j) enddo ; enddo + deallocate(h2) + ! Read in prescribed coast/ridge/shelf angles from file call get_param(param_file, mdl, "REFL_ANGLE_FILE", refl_angle_file, & "The path to the file containing the local angle of \n"//& diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 981fcd0b6a..4506177f41 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -3295,7 +3295,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (CS%use_int_tides) then call int_tide_input_init(Time, G, GV, US, param_file, diag, CS%int_tide_input_CSp, & CS%int_tide_input) - call internal_tides_init(Time, G, GV, param_file, diag, CS%int_tide_CSp) + call internal_tides_init(Time, G, GV, US, param_file, diag, CS%int_tide_CSp) endif ! initialize module for setting diffusivities From 967e470ebe6f9b332f7133ac5a95158d3c0afeb0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 14 Nov 2018 17:48:04 -0500 Subject: [PATCH 0910/1072] +Rescaled variables in MOM_tidal_mixing Recast internal depth and height variables in MOM_tidal_mixing to use units of Z instead of m. This required adding a unit_scale_type arguments to the internal subroutines read_tidal_energy and read_tidal_constituents. Also eliminated the use of where statements and array syntax, which are strongly discouraged because they can operate on uninitialized points in the halo regions. All answers are bitwise identical. --- .../vertical/MOM_tidal_mixing.F90 | 92 ++++++++++--------- 1 file changed, 49 insertions(+), 43 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 254843ebe2..05c377ab9c 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -136,8 +136,8 @@ module MOM_tidal_mixing type(CVMix_tidal_params_type) :: CVMix_tidal_params !< A CVMix-specific type with parameters for tidal mixing type(CVMix_global_params_type) :: CVMix_glb_params !< CVMix-specific for Prandtl number only real :: tidal_max_coef !< CVMix-specific maximum allowable tidal diffusivity. [m^2/s] - real :: tidal_diss_lim_tc !< CVMix-specific dissipation limit for - !! tidal-energy-constituent data + real :: tidal_diss_lim_tc !< CVMix-specific dissipation limit depth for + !! tidal-energy-constituent data, in Z. type(remapping_CS) :: remap_CS !< The control structure for remapping ! Data containers @@ -510,7 +510,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ call get_param(param_file, mdl, "TIDAL_DISS_LIM_TC", CS%tidal_diss_lim_tc, & "Min allowable depth for dissipation for tidal-energy-constituent data. \n"//& "No dissipation contribution is applied above TIDAL_DISS_LIM_TC.", & - units="m", default=0.0) + units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "TIDAL_ENERGY_FILE",tidal_energy_file, & "The path to the file containing tidal energy \n"//& "dissipation. Used with CVMix tidal mixing schemes.", & @@ -549,7 +549,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ local_mixing_frac = CS%Gamma_itides, & depth_cutoff = CS%min_zbot_itides*US%Z_to_m) - call read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS) + call read_tidal_energy(G, US, tidal_energy_type, tidal_energy_file, CS) !call closeParameterBlock(param_file) @@ -1500,13 +1500,14 @@ end subroutine post_tidal_diagnostics ! TODO: move this subroutine to MOM_internal_tide_input module (?) !> This subroutine read tidal energy inputs from a file. -subroutine read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS) +subroutine read_tidal_energy(G, US, tidal_energy_type, tidal_energy_file, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=20), intent(in) :: tidal_energy_type !< The type of tidal energy inputs to read character(len=200), intent(in) :: tidal_energy_file !< The file from which to read tidalinputs type(tidal_mixing_cs), pointer :: CS !< The control structure for this module ! local - integer :: isd, ied, jsd, jed, nz + integer :: i, j, isd, ied, jsd, jed, nz real, allocatable, dimension(:,:) :: tidal_energy_flux_2d ! input tidal energy flux at T-grid points (W/m^2) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke @@ -1516,10 +1517,12 @@ subroutine read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS) if (.not. allocated(CS%tidal_qe_2d)) allocate(CS%tidal_qe_2d(isd:ied,jsd:jed)) allocate(tidal_energy_flux_2d(isd:ied,jsd:jed)) call MOM_read_data(tidal_energy_file,'wave_dissipation',tidal_energy_flux_2d, G%domain) - CS%tidal_qe_2d = (CS%Gamma_itides) * tidal_energy_flux_2d + do j=G%jsc,G%jec ; do i=G%isc,G%iec + CS%tidal_qe_2d(i,j) = CS%Gamma_itides * tidal_energy_flux_2d(i,j) + enddo ; enddo deallocate(tidal_energy_flux_2d) case ('ER03') ! Egbert & Ray 2003 - call read_tidal_constituents(G, tidal_energy_file, CS) + call read_tidal_constituents(G, US, tidal_energy_file, CS) case default call MOM_error(FATAL, "read_tidal_energy: Unknown tidal energy file type.") end select @@ -1527,31 +1530,33 @@ subroutine read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS) end subroutine read_tidal_energy !> This subroutine reads tidal input energy from a file by constituent. -subroutine read_tidal_constituents(G, tidal_energy_file, CS) +subroutine read_tidal_constituents(G, US, tidal_energy_file, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=200), intent(in) :: tidal_energy_file !< The file from which to read tidal energy inputs type(tidal_mixing_cs), pointer :: CS !< The control structure for this module - ! local - integer :: k, isd, ied, jsd, jed, i,j - integer, dimension(4) :: nz_in - real, parameter :: p33 = 1.0/3.0 + ! local variables + real, parameter :: C1_3 = 1.0/3.0 real, dimension(SZI_(G),SZJ_(G)) :: & tidal_qk1, & ! qk1 coefficient used in Schmittner & Egbert tidal_qo1 ! qo1 coefficient used in Schmittner & Egbert real, allocatable, dimension(:) :: & - z_t, & ! depth from surface to midpoint of input layer [cm] - z_w ! depth from surface to top of input layer [cm] + z_t, & ! depth from surface to midpoint of input layer [Z] + z_w ! depth from surface to top of input layer [Z] real, allocatable, dimension(:,:,:) :: & tc_m2, & ! input lunar semidiurnal tidal energy flux [W/m^2] tc_s2, & ! input solar semidiurnal tidal energy flux [W/m^2] tc_k1, & ! input lunar diurnal tidal energy flux [W/m^2] tc_o1 ! input lunar diurnal tidal energy flux [W/m^2] + integer, dimension(4) :: nz_in + integer :: k, is, ie, js, je, isd, ied, jsd, jed, i, j + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ! get number of input levels: - call field_size(tidal_energy_file, 'z_t',nz_in) + call field_size(tidal_energy_file, 'z_t', nz_in) ! allocate local variables allocate(z_t(nz_in(1)), z_w(nz_in(1)) ) @@ -1569,28 +1574,30 @@ subroutine read_tidal_constituents(G, tidal_energy_file, CS) call MOM_read_data(tidal_energy_file, 'S2', tc_s2, G%domain) call MOM_read_data(tidal_energy_file, 'K1', tc_k1, G%domain) call MOM_read_data(tidal_energy_file, 'O1', tc_o1, G%domain) - call MOM_read_data(tidal_energy_file, 'z_t', z_t) - call MOM_read_data(tidal_energy_file, 'z_w', z_w) - - !### THE USE OF WHERE STTAEMENTS IS STRONGLY DISCOURAGED IN MOM6! - where (abs(G%geoLatT(:,:)) < 30.0) - tidal_qk1(:,:) = p33 - tidal_qo1(:,:) = p33 - elsewhere - tidal_qk1(:,:) = 1.0 - tidal_qo1(:,:) = 1.0 - endwhere - - CS%tidal_qe_3d_in = 0.0 + ! Note the hard-coded assumption that z_t and z_w in the file are in centimeters. + call MOM_read_data(tidal_energy_file, 'z_t', z_t, scale=100.0*US%m_to_Z) + call MOM_read_data(tidal_energy_file, 'z_w', z_w, scale=100.0*US%m_to_Z) + + do j=js,je ; do i=is,ie + if (abs(G%geoLatT(i,j)) < 30.0) then + tidal_qk1(i,j) = C1_3 + tidal_qo1(i,j) = C1_3 + else + tidal_qk1(i,j) = 1.0 + tidal_qo1(i,j) = 1.0 + endif + enddo ; enddo + + CS%tidal_qe_3d_in(:,:,:) = 0.0 do k=1,nz_in(1) - ! input cell thickness - CS%h_src(k) = (z_t(k)-z_w(k))*2.0 *1e-2 + ! Store the input cell thickness in m for use with CVmix. + CS%h_src(k) = US%Z_to_m*(z_t(k)-z_w(k))*2.0 ! form tidal_qe_3d_in from weighted tidal constituents - !### THE USE OF WHERE STATEMENTS IS STRONGLY DISCOURAGED IN MOM6! - where (((z_t(k)*1e-2) <= G%bathyT(:,:)*G%Zd_to_m) .and. (z_w(k)*1e-2 > CS%tidal_diss_lim_tc)) - CS%tidal_qe_3d_in(:,:,k) = p33*tc_m2(:,:,k) + p33*tc_s2(:,:,k) + & - tidal_qk1*tc_k1(:,:,k) + tidal_qo1*tc_o1(:,:,k) - endwhere + do j=js,je ; do i=is,ie + if ((z_t(k) <= G%bathyT(i,j)) .and. (z_w(k) > CS%tidal_diss_lim_tc)) & + CS%tidal_qe_3d_in(i,j,k) = C1_3*tc_m2(i,j,k) + C1_3*tc_s2(i,j,k) + & + tidal_qk1(i,j)*tc_k1(i,j,k) + tidal_qo1(i,j)*tc_o1(i,j,k) + enddo ; enddo enddo !open(unit=1905,file="out_1905.txt",access="APPEND") @@ -1601,7 +1608,7 @@ subroutine read_tidal_constituents(G, tidal_energy_file, CS) ! do k=50,nz_in(1) ! write(1905,*) i,j,k ! write(1905,*) CS%tidal_qe_3d_in(i,j,k), tc_m2(i,j,k) - ! write(1905,*) z_t(k), G%bathyT(i,j)*G%Zd_to_m, z_w(k),CS%tidal_diss_lim_tc + ! write(1905,*) z_t(k), G%bathyT(i,j), z_w(k),CS%tidal_diss_lim_tc ! end do ! endif ! enddo @@ -1614,12 +1621,11 @@ subroutine read_tidal_constituents(G, tidal_energy_file, CS) endif !! collapse 3D q*E to 2D q*E - !CS%tidal_qe_2d = 0.0 - !do k=1,nz_in(1) - ! where (z_t(k) <= G%bathyT(:,:)*G%Zd_to_m) - ! CS%tidal_qe_2d(:,:) = CS%tidal_qe_2d(:,:) + CS%tidal_qe_3d_in(:,:,k) - ! endwhere - !enddo + !CS%tidal_qe_2d(:,:) = 0.0 + !do k=1,nz_in(1) ; do j=js,je ; do i=is,ie + ! if (z_t(k) <= G%bathyT(i,j)) & + ! CS%tidal_qe_2d(i,j) = CS%tidal_qe_2d(i,j) + CS%tidal_qe_3d_in(i,j,k) + !enddo ; enddo ; enddo ! initialize input remapping: call initialize_remapping(CS%remap_cs, remapping_scheme="PLM", & From 9ac67ccaa1f64f8bda30c03704bb92adbe4232e5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 14 Nov 2018 17:53:41 -0500 Subject: [PATCH 0911/1072] +Add unit_scale_type argument to tracer_Z_init Use US%m_to_Z in place of 1/G%Zd_to_m to convert units from m to Z in tracer_Z_init. This required adding a unit_scale_type argument to tracer_Z_init and 4 subroutines that used the previous interface to tracer_Z_init. All answers are bitwise identical. --- src/tracer/MOM_OCMIP2_CFC.F90 | 15 +++++++++------ src/tracer/MOM_generic_tracer.F90 | 8 +++++--- src/tracer/MOM_tracer_Z_init.F90 | 6 ++++-- src/tracer/MOM_tracer_flow_control.F90 | 8 ++++---- src/tracer/ideal_age_example.F90 | 8 +++++--- src/tracer/oil_tracer.F90 | 11 ++++++----- 6 files changed, 33 insertions(+), 23 deletions(-) diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index ebff38508c..6712088988 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -18,6 +18,7 @@ module MOM_OCMIP2_CFC use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type @@ -308,13 +309,14 @@ subroutine flux_init_OCMIP2_CFC(CS, verbosity) end subroutine flux_init_OCMIP2_CFC !> Initialize the OCMP2 CFC tracer fields and set up the tracer output. -subroutine initialize_OCMIP2_CFC(restart, day, G, GV, h, diag, OBC, CS, & +subroutine initialize_OCMIP2_CFC(restart, day, G, GV, US, h, diag, OBC, CS, & sponge_CSp, diag_to_Z_CSp) logical, intent(in) :: restart !< .true. if the fields have already been !! read from a restart file. type(time_type), target, intent(in) :: day !< Time of the start of the run. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H !! (usually m or kg m-2). @@ -343,12 +345,12 @@ subroutine initialize_OCMIP2_CFC(restart, day, G, GV, h, diag, OBC, CS, & if (.not.restart .or. (CS%tracers_may_reinit .and. & .not.query_initialized(CS%CFC11, CS%CFC11_name, CS%restart_CSp))) & call init_tracer_CFC(h, CS%CFC11, CS%CFC11_name, CS%CFC11_land_val, & - CS%CFC11_IC_val, G, CS) + CS%CFC11_IC_val, G, US, CS) if (.not.restart .or. (CS%tracers_may_reinit .and. & .not.query_initialized(CS%CFC12, CS%CFC12_name, CS%restart_CSp))) & call init_tracer_CFC(h, CS%CFC12, CS%CFC12_name, CS%CFC12_land_val, & - CS%CFC12_IC_val, G, CS) + CS%CFC12_IC_val, G, US, CS) if (associated(OBC)) then ! Steal from updated DOME in the fullness of time. @@ -357,8 +359,9 @@ subroutine initialize_OCMIP2_CFC(restart, day, G, GV, h, diag, OBC, CS, & end subroutine initialize_OCMIP2_CFC !>This subroutine initializes a tracer array. -subroutine init_tracer_CFC(h, tr, name, land_val, IC_val, G, CS) +subroutine init_tracer_CFC(h, tr, name, land_val, IC_val, G, US, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: tr !< The tracer concentration array character(len=*), intent(in) :: name !< The tracer name @@ -378,9 +381,9 @@ subroutine init_tracer_CFC(h, tr, name, land_val, IC_val, G, CS) if (.not.file_exists(CS%IC_file, G%Domain)) & call MOM_error(FATAL, "initialize_OCMIP2_CFC: Unable to open "//CS%IC_file) if (CS%Z_IC_file) then - OK = tracer_Z_init(tr, h, CS%IC_file, name, G) + OK = tracer_Z_init(tr, h, CS%IC_file, name, G, US) if (.not.OK) then - OK = tracer_Z_init(tr, h, CS%IC_file, trim(name), G) + OK = tracer_Z_init(tr, h, CS%IC_file, trim(name), G, US) if (.not.OK) call MOM_error(FATAL,"initialize_OCMIP2_CFC: "//& "Unable to read "//trim(name)//" from "//& trim(CS%IC_file)//".") diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index ee1f038180..12f7ecf0c4 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -40,6 +40,7 @@ module MOM_generic_tracer use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_Z_init, only : tracer_Z_init use MOM_tracer_initialization_from_Z, only : MOM_initialize_tracer_from_Z + use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface, thermo_var_ptrs use MOM_open_boundary, only : ocean_OBC_type use MOM_verticalGrid, only : verticalGrid_type @@ -222,13 +223,14 @@ end function register_MOM_generic_tracer !! !! This subroutine initializes the NTR tracer fields in tr(:,:,:,:) !! and it sets up the tracer output. - subroutine initialize_MOM_generic_tracer(restart, day, G, GV, h, param_file, diag, OBC, CS, & + subroutine initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, diag, OBC, CS, & sponge_CSp, ALE_sponge_CSp,diag_to_Z_CSp) logical, intent(in) :: restart !< .true. if the fields have already been !! read from a restart file. type(time_type), target, intent(in) :: day !< Time of the start of the run. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(diag_ctrl), target, intent(in) :: diag !< Regulates diagnostic output. @@ -319,9 +321,9 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, h, param_file, dia if (.not.file_exists(CS%IC_file)) call MOM_error(FATAL, & "initialize_MOM_Generic_tracer: Unable to open "//CS%IC_file) if (CS%Z_IC_file) then - OK = tracer_Z_init(tr_ptr, h, CS%IC_file, g_tracer_name, G) + OK = tracer_Z_init(tr_ptr, h, CS%IC_file, g_tracer_name, G, US) if (.not.OK) then - OK = tracer_Z_init(tr_ptr, h, CS%IC_file, trim(g_tracer_name), G) + OK = tracer_Z_init(tr_ptr, h, CS%IC_file, trim(g_tracer_name), G, US) if (.not.OK) call MOM_error(FATAL,"initialize_MOM_Generic_tracer: "//& "Unable to read "//trim(g_tracer_name)//" from "//& trim(CS%IC_file)//".") diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index 7450571500..d78821cd46 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -8,6 +8,7 @@ module MOM_tracer_Z_init ! use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_io, only : MOM_read_data +use MOM_unit_scaling, only : unit_scale_type use netcdf @@ -21,9 +22,10 @@ module MOM_tracer_Z_init !> This function initializes a tracer by reading a Z-space file, returning !! .true. if this appears to have been successful, and false otherwise. -function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val) +function tracer_Z_init(tr, h, filename, tr_name, G, US, missing_val, land_val) logical :: tracer_Z_init !< A return code indicating if the initialization has been successful type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: tr !< The tracer to initialize real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -82,7 +84,7 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val) ! Find out the number of input levels and read the depth of the edges, ! also modifying their sign convention to be monotonically decreasing. call read_Z_edges(filename, tr_name, z_edges, nz_in, has_edges, use_missing, & - missing, scale=1.0/G%Zd_to_m) + missing, scale=US%m_to_Z) if (nz_in < 1) then tracer_Z_init = .false. return diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 3dcd9ac192..6438a55ed2 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -317,23 +317,23 @@ subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag call initialize_ISOMIP_tracer(restart, day, G, GV, h, diag, OBC, CS%ISOMIP_tracer_CSp, & ALE_sponge_CSp, diag_to_Z_CSp) if (CS%use_ideal_age) & - call initialize_ideal_age_tracer(restart, day, G, GV, h, diag, OBC, CS%ideal_age_tracer_CSp, & + call initialize_ideal_age_tracer(restart, day, G, GV, US, h, diag, OBC, CS%ideal_age_tracer_CSp, & sponge_CSp, diag_to_Z_CSp) if (CS%use_regional_dyes) & call initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS%dye_tracer_CSp, & sponge_CSp, diag_to_Z_CSp) if (CS%use_oil) & - call initialize_oil_tracer(restart, day, G, GV, h, diag, OBC, CS%oil_tracer_CSp, & + call initialize_oil_tracer(restart, day, G, GV, US, h, diag, OBC, CS%oil_tracer_CSp, & sponge_CSp, diag_to_Z_CSp) if (CS%use_advection_test_tracer) & call initialize_advection_test_tracer(restart, day, G, GV, h, diag, OBC, CS%advection_test_tracer_CSp, & sponge_CSp, diag_to_Z_CSp) if (CS%use_OCMIP2_CFC) & - call initialize_OCMIP2_CFC(restart, day, G, GV, h, diag, OBC, CS%OCMIP2_CFC_CSp, & + call initialize_OCMIP2_CFC(restart, day, G, GV, US, h, diag, OBC, CS%OCMIP2_CFC_CSp, & sponge_CSp, diag_to_Z_CSp) #ifdef _USE_GENERIC_TRACER if (CS%use_MOM_generic_tracer) & - call initialize_MOM_generic_tracer(restart, day, G, GV, h, param_file, diag, OBC, & + call initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, diag, OBC, & CS%MOM_generic_tracer_CSp, sponge_CSp, ALE_sponge_CSp, diag_to_Z_CSp) #endif if (CS%use_pseudo_salt_tracer) & diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index d7fcb53324..750fa83021 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -18,6 +18,7 @@ module ideal_age_example use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type @@ -193,13 +194,14 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) end function register_ideal_age_tracer !> Sets the ideal age traces to their initial values and sets up the tracer output -subroutine initialize_ideal_age_tracer(restart, day, G, GV, h, diag, OBC, CS, & +subroutine initialize_ideal_age_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & sponge_CSp, diag_to_Z_CSp) logical, intent(in) :: restart !< .true. if the fields have already !! been read from a restart file. type(time_type), target, intent(in) :: day !< Time of the start of the run. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate @@ -250,10 +252,10 @@ subroutine initialize_ideal_age_tracer(restart, day, G, GV, h, diag, OBC, CS, & if (CS%Z_IC_file) then OK = tracer_Z_init(CS%tr(:,:,:,m), h, CS%IC_file, name,& - G, -1e34, 0.0) ! CS%land_val(m)) + G, US, -1e34, 0.0) ! CS%land_val(m)) if (.not.OK) then OK = tracer_Z_init(CS%tr(:,:,:,m), h, CS%IC_file, & - trim(name), G, -1e34, 0.0) ! CS%land_val(m)) + trim(name), G, US, -1e34, 0.0) ! CS%land_val(m)) if (.not.OK) call MOM_error(FATAL,"initialize_ideal_age_tracer: "//& "Unable to read "//trim(name)//" from "//& trim(CS%IC_file)//".") diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 3b98c19a73..3130ba3804 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -18,8 +18,8 @@ module oil_tracer use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init -use MOM_variables, only : surface -use MOM_variables, only : thermo_var_ptrs +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : surface, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use coupler_types_mod, only : coupler_type_set_data, ind_csurf @@ -201,13 +201,14 @@ function register_oil_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) end function register_oil_tracer !> Initialize the oil tracers and set up tracer output -subroutine initialize_oil_tracer(restart, day, G, GV, h, diag, OBC, CS, & +subroutine initialize_oil_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & sponge_CSp, diag_to_Z_CSp) logical, intent(in) :: restart !< .true. if the fields have already !! been read from a restart file. type(time_type), target, intent(in) :: day !< Time of the start of the run. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate @@ -266,10 +267,10 @@ subroutine initialize_oil_tracer(restart, day, G, GV, h, diag, OBC, CS, & if (CS%Z_IC_file) then OK = tracer_Z_init(CS%tr(:,:,:,m), h, CS%IC_file, name, & - G, -1e34, 0.0) ! CS%land_val(m)) + G, US, -1e34, 0.0) ! CS%land_val(m)) if (.not.OK) then OK = tracer_Z_init(CS%tr(:,:,:,m), h, CS%IC_file, & - trim(name), G, -1e34, 0.0) ! CS%land_val(m)) + trim(name), G, US, -1e34, 0.0) ! CS%land_val(m)) if (.not.OK) call MOM_error(FATAL,"initialize_oil_tracer: "//& "Unable to read "//trim(name)//" from "//& trim(CS%IC_file)//".") From 47909a1cafd3bf960df25380dc3da4568a28c6fd Mon Sep 17 00:00:00 2001 From: MFJansen Date: Wed, 14 Nov 2018 17:39:38 -0600 Subject: [PATCH 0912/1072] Added perturbations to initial layer thicknesses in Neverland This is necessary to allow for instabilities and turbulence to develop in a zonally symmetric channel configuration.. --- src/user/Neverland_initialization.F90 | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index 5f5b081f1c..4438d81e46 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -122,6 +122,7 @@ subroutine Neverland_initialize_thickness(h, G, GV, US, param_file, eqn_of_state ! usually negative because it is positive upward. real, dimension(SZK_(G)) :: h_profile ! Vector of initial thickness profile (Z) real :: e_interface ! Current interface position (m) + real :: x,y,r1,r2 ! x,y and radial coordinates for computation of initial pert. character(len=40) :: mdl = "Neverland_initialize_thickness" ! This subroutine's name. integer :: i, j, k, k1, is, ie, js, je, nz, itt @@ -141,7 +142,12 @@ subroutine Neverland_initialize_thickness(h, G, GV, US, param_file, eqn_of_state do j=js,je ; do i=is,ie e_interface = -G%bathyT(i,j) do k=nz,1,-1 - h(i,j,k) = max( GV%Angstrom_H, GV%Z_to_H * (e0(k) - e_interface) ) + x=(G%geoLonT(i,j)-G%west_lon)/G%len_lon + y=(G%geoLatT(i,j)-G%south_lat)/G%len_lat + r1=sqrt((x-0.7)**2+(y-0.2)**2) + r2=sqrt((x-0.3)**2+(y-0.25)**2) + h(i,j,k) = max( GV%Angstrom_H, GV%Z_to_H * (e0(k) - e_interface) & + + 1.0E5*GV%Angstrom_H*(spike(r1,0.15)-spike(r2,0.15)) ) e_interface = max( e0(k), e_interface - GV%H_to_Z * h(i,j,k) ) enddo enddo ; enddo From d2bfd736dfc6f734b653dbae1550da8979b20a61 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 14 Nov 2018 18:58:19 -0500 Subject: [PATCH 0913/1072] +Add unit_scale_type argument to diag_remap_update Added a unit_scale_type argument to diag_remap_update and a pointer to a unit_scale_type structure to diag_mediator_init and store a this pointer in the diag_ctrl type, all to accomodate rescaling of depths via US%Z_to_m instead of G%Zd_to_m. All answers are bitwise identical. --- src/core/MOM.F90 | 2 +- src/framework/MOM_diag_mediator.F90 | 9 ++++++--- src/framework/MOM_diag_remap.F90 | 9 +++++---- 3 files changed, 12 insertions(+), 8 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 9bb2fa74cf..3126b0b8ec 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2256,7 +2256,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & diag => CS%diag ! Initialize the diag mediator. - call diag_mediator_init(G, GV, GV%ke, param_file, diag, doc_file_dir=dirs%output_directory) + call diag_mediator_init(G, GV, US, GV%ke, param_file, diag, doc_file_dir=dirs%output_directory) if (present(diag_ptr)) diag_ptr => CS%diag ! Initialize the diagnostics masks for native arrays. diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 117adb512e..db9e391610 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -15,7 +15,7 @@ module MOM_diag_mediator use MOM_safe_alloc, only : safe_alloc_ptr, safe_alloc_alloc use MOM_string_functions, only : lowercase use MOM_time_manager, only : time_type -use MOM_unit_scaling, only : unit_scale_type +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : EOS_type use MOM_diag_remap, only : diag_remap_ctrl @@ -223,6 +223,7 @@ module MOM_diag_mediator type(EOS_type), pointer :: eqn_of_state => null() !< The equation of state type type(ocean_grid_type), pointer :: G => null() !< The ocean grid type type(verticalGrid_type), pointer :: GV => null() !< The model's vertical ocean grid + type(unit_scale_type), pointer :: US => null() !< A dimensional unit scaling type !> The volume cell measure (special diagnostic) manager id integer :: volume_cell_measure_dm_id = -1 @@ -2177,9 +2178,10 @@ end subroutine diag_mediator_infrastructure_init !> diag_mediator_init initializes the MOM diag_mediator and opens the available !! diagnostics file, if appropriate. -subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir) +subroutine diag_mediator_init(G, GV, US, nz, param_file, diag_cs, doc_file_dir) type(ocean_grid_type), target, intent(inout) :: G !< The ocean grid type. type(verticalGrid_type), target, intent(in) :: GV !< The ocean vertical grid structure + type(unit_scale_type), target, intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: nz !< The number of layers in the model's native grid. type(param_file_type), intent(in) :: param_file !< Parameter file structure type(diag_ctrl), intent(inout) :: diag_cs !< A pointer to a type with many variables @@ -2251,6 +2253,7 @@ subroutine diag_mediator_init(G, GV, nz, param_file, diag_cs, doc_file_dir) ! Keep pointers grid, h, T, S needed diagnostic remapping diag_cs%G => G diag_cs%GV => GV + diag_cs%US => US diag_cs%h => null() diag_cs%T => null() diag_cs%S => null() @@ -2404,7 +2407,7 @@ subroutine diag_update_remap_grids(diag_cs, alt_h, alt_T, alt_S) do i=1, diag_cs%num_diag_coords call diag_remap_update(diag_cs%diag_remap_cs(i), & - diag_cs%G, diag_cs%GV, h_diag, T_diag, S_diag, & + diag_cs%G, diag_cs%GV, diag_cs%US, h_diag, T_diag, S_diag, & diag_cs%eqn_of_state) enddo diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 748c09ba0c..632258d5d2 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -225,10 +225,11 @@ function diag_remap_axes_configured(remap_cs) !! height or layer thicknesses changes. In the case of density-based !! coordinates then technically we should also regenerate the !! target grid whenever T/S change. -subroutine diag_remap_update(remap_cs, G, GV, h, T, S, eqn_of_state) +subroutine diag_remap_update(remap_cs, G, GV, US, h, T, S, eqn_of_state) type(diag_remap_ctrl), intent(inout) :: remap_cs !< Diagnostic coordinate control structure type(ocean_grid_type), pointer :: G !< The ocean's grid type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(:, :, :), intent(in) :: h !< New thickness real, dimension(:, :, :), intent(in) :: T !< New T real, dimension(:, :, :), intent(in) :: S !< New S @@ -278,15 +279,15 @@ subroutine diag_remap_update(remap_cs, G, GV, h, T, S, eqn_of_state) GV%Z_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) elseif (remap_cs%vertical_coord == coordinateMode('RHO')) then call build_rho_column(get_rho_CS(remap_cs%regrid_cs), G%ke, & - G%Zd_to_m*G%bathyT(i,j), h(i,j,:), T(i,j,:), S(i,j,:), & + US%Z_to_m*G%bathyT(i,j), h(i,j,:), T(i,j,:), S(i,j,:), & eqn_of_state, zInterfaces, h_neglect, h_neglect_edge) elseif (remap_cs%vertical_coord == coordinateMode('SLIGHT')) then ! call build_slight_column(remap_cs%regrid_cs,remap_cs%remap_cs, nz, & -! G%Zd_to_m*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) +! US%Z_to_m*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) call MOM_error(FATAL,"diag_remap_update: SLIGHT coordinate not coded for diagnostics yet!") elseif (remap_cs%vertical_coord == coordinateMode('HYCOM1')) then ! call build_hycom1_column(remap_cs%regrid_cs, nz, & -! G%Zd_to_m*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) +! US%Z_to_m*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) call MOM_error(FATAL,"diag_remap_update: HYCOM1 coordinate not coded for diagnostics yet!") endif remap_cs%h(i,j,:) = zInterfaces(1:nz) - zInterfaces(2:nz+1) From 366efc8c6e6ddb7c337d0ab565291d68e81dc9c0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Nov 2018 04:45:20 -0500 Subject: [PATCH 0914/1072] +Add unit_scale_type arg to MOM_initialize_fixed Added a unit_scale_type argument to MOM_initialize_fixed and moved the call to rescale_dyn_horgrid_bathymetry into MOM_initialize_fixed immediately after the call to MOM_initialize_topography. Also added a unit_scale_type argument to mask_outside_OBCs and open_boundary_config to accomodate rescaling of depths via US%Z_to_m instead of G%Zd_to_m. All answers are bitwise identical. --- src/core/MOM.F90 | 7 ++---- src/core/MOM_open_boundary.F90 | 24 ++++++++++-------- .../MOM_fixed_initialization.F90 | 25 +++++++++++-------- 3 files changed, 29 insertions(+), 27 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 3126b0b8ec..4063ac619d 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -72,7 +72,6 @@ module MOM use MOM_dynamics_unsplit_RK2, only : initialize_dyn_unsplit_RK2, end_dyn_unsplit_RK2 use MOM_dynamics_unsplit_RK2, only : MOM_dyn_unsplit_RK2_CS use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid -use MOM_dyn_horgrid, only : rescale_dyn_horgrid_bathymetry use MOM_EOS, only : EOS_init, calculate_density, calculate_TFreeze use MOM_fixed_initialization, only : MOM_initialize_fixed use MOM_grid, only : ocean_grid_type, MOM_grid_init, MOM_grid_end @@ -1978,11 +1977,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call MOM_timing_init(CS) ! Allocate initialize time-invariant MOM variables. - call MOM_initialize_fixed(dG, CS%OBC, param_file, write_geom_files, dirs%output_directory) + call MOM_initialize_fixed(dG, US, CS%OBC, param_file, write_geom_files, dirs%output_directory) call callTree_waypoint("returned from MOM_initialize_fixed() (initialize_MOM)") - if (dG%Zd_to_m /= US%Z_to_m) call rescale_dyn_horgrid_bathymetry(dG, US%Z_to_m) - if (associated(CS%OBC)) call call_OBC_register(param_file, CS%update_OBC_CSp, CS%OBC) call tracer_registry_init(param_file, CS%tracer_Reg) @@ -2982,7 +2979,7 @@ subroutine extract_surface_state(CS, sfc_state) numberOfErrors=0 ! count number of errors do j=js,je; do i=is,ie if (G%mask2dT(i,j)>0.) then - bathy_m = G%Zd_to_m*G%bathyT(i,j) + bathy_m = CS%US%Z_to_m * G%bathyT(i,j) localError = sfc_state%sea_lev(i,j)<=-bathy_m & .or. sfc_state%sea_lev(i,j)>= CS%bad_val_ssh_max & .or. sfc_state%sea_lev(i,j)<=-CS%bad_val_ssh_max & diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 6296dbc35b..8fd4cc06f5 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -19,12 +19,13 @@ module MOM_open_boundary use MOM_obsolete_params, only : obsolete_logical, obsolete_int, obsolete_real, obsolete_char use MOM_string_functions, only : extract_word, remove_spaces use MOM_tracer_registry, only : tracer_type, tracer_registry_type, tracer_name_lookup -use MOM_variables, only : thermo_var_ptrs use time_interp_external_mod, only : init_external_field, time_interp_external use time_interp_external_mod, only : time_interp_external_init use MOM_remapping, only : remappingSchemesDoc, remappingDefaultScheme, remapping_CS use MOM_remapping, only : initialize_remapping, remapping_core_h, end_remapping use MOM_regridding, only : regridding_CS +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -290,8 +291,9 @@ module MOM_open_boundary !> here. The remainder of the segment data are initialized in a !> later call to update_open_boundary_data -subroutine open_boundary_config(G, param_file, OBC) +subroutine open_boundary_config(G, US, param_file, OBC) type(dyn_horgrid_type), intent(inout) :: G !< Ocean grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handle type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure ! Local variables @@ -473,7 +475,7 @@ subroutine open_boundary_config(G, param_file, OBC) "is entering the domain.", units="m", default=0.0) endif - if (mask_outside) call mask_outside_OBCs(G, param_file, OBC) + if (mask_outside) call mask_outside_OBCs(G, US, param_file, OBC) ! All tracers are using the same restoring length scale for now, but we may want to make this ! tracer-specific in the future for example, in cases where certain tracers are poorly constrained @@ -3690,17 +3692,18 @@ end subroutine fill_temp_salt_segments !> Find the region outside of all open boundary segments and !! make sure it is set to land mask. Gonna need to know global land !! mask as well to get it right... -subroutine mask_outside_OBCs(G, param_file, OBC) - type(dyn_horgrid_type), intent(inout) :: G !< Ocean grid structure - type(param_file_type), intent(in) :: param_file !< Parameter file handle - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure +subroutine mask_outside_OBCs(G, US, param_file, OBC) + type(dyn_horgrid_type), intent(inout) :: G !< Ocean grid structure + type(param_file_type), intent(in) :: param_file !< Parameter file handle + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type -! Local variables + ! Local variables integer :: isd, ied, IsdB, IedB, jsd, jed, JsdB, JedB, n integer :: i, j logical :: fatal_error = .False. real :: min_depth - integer, parameter :: cin = 3, cout = 4, cland = -1, cedge = -2 + integer, parameter :: cin = 3, cout = 4, cland = -1, cedge = -2 character(len=256) :: mesg ! Message for error messages. type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list real, allocatable, dimension(:,:) :: color, color2 ! For sorting inside from outside, @@ -3709,8 +3712,7 @@ subroutine mask_outside_OBCs(G, param_file, OBC) if (.not. associated(OBC)) return call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - default=0.0, do_not_log=.true.) - min_depth = min_depth / G%Zd_to_m + units="m", default=0.0, scale=US%m_to_Z, do_not_log=.true.) allocate(color(G%isd:G%ied, G%jsd:G%jed)) ; color = 0 allocate(color2(G%isd:G%ied, G%jsd:G%jed)) ; color2 = 0 diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index b754b19bcb..24d496703c 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -6,7 +6,7 @@ module MOM_fixed_initialization use MOM_debugging, only : hchksum, qchksum, uvchksum use MOM_domains, only : pass_var -use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_dyn_horgrid, only : dyn_horgrid_type, rescale_dyn_horgrid_bathymetry use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, WARNING, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint use MOM_file_parser, only : get_param, read_param, log_param, param_file_type @@ -25,6 +25,7 @@ module MOM_fixed_initialization use MOM_shared_initialization, only : reset_face_lengths_named, reset_face_lengths_file, reset_face_lengths_list use MOM_shared_initialization, only : read_face_length_list, set_velocity_depth_max, set_velocity_depth_min use MOM_shared_initialization, only : compute_global_grid_integrals, write_ocean_geometry_file +use MOM_unit_scaling, only : unit_scale_type use user_initialization, only : user_initialize_topography use DOME_initialization, only : DOME_initialize_topography @@ -51,8 +52,9 @@ module MOM_fixed_initialization ! ----------------------------------------------------------------------------- !> MOM_initialize_fixed sets up time-invariant quantities related to MOM6's !! horizontal grid, bathymetry, and the Coriolis parameter. -subroutine MOM_initialize_fixed(G, OBC, PF, write_geom, output_dir) +subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) type(dyn_horgrid_type), intent(inout) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ocean_OBC_type), pointer :: OBC !< Open boundary structure. type(param_file_type), intent(in) :: PF !< A structure indicating the open file !! to parse for model parameter values. @@ -75,19 +77,20 @@ subroutine MOM_initialize_fixed(G, OBC, PF, write_geom, output_dir) "The directory in which input files are found.", default=".") inputdir = slasher(inputdir) -! Set up the parameters of the physical domain (i.e. the grid), G + ! Set up the parameters of the physical domain (i.e. the grid), G call set_grid_metrics(G, PF) -! Set up the bottom depth, G%bathyT either analytically or from file -! This also sets G%max_depth based on the input parameter MAXIMUM_DEPTH, -! or, if absent, is diagnosed as G%max_depth = max( G%D(:,:) ) + ! Set up the bottom depth, G%bathyT either analytically or from file + ! This also sets G%max_depth based on the input parameter MAXIMUM_DEPTH, + ! or, if absent, is diagnosed as G%max_depth = max( G%D(:,:) ) call MOM_initialize_topography(G%bathyT, G%max_depth, G, PF) + if (G%Zd_to_m /= US%Z_to_m) call rescale_dyn_horgrid_bathymetry(G, US%Z_to_m) ! To initialize masks, the bathymetry in halo regions must be filled in call pass_var(G%bathyT, G%Domain) -! Determine the position of any open boundaries - call open_boundary_config(G, PF, OBC) + ! Determine the position of any open boundaries + call open_boundary_config(G, US, PF, OBC) ! Make bathymetry consistent with open boundaries call open_boundary_impose_normal_slope(OBC, G, G%bathyT) @@ -99,14 +102,14 @@ subroutine MOM_initialize_fixed(G, OBC, PF, write_geom, output_dir) call open_boundary_impose_land_mask(OBC, G, G%areaCu, G%areaCv) if (debug) then - call hchksum(G%bathyT, 'MOM_initialize_fixed: depth ', G%HI, haloshift=1) + call hchksum(G%bathyT, 'MOM_initialize_fixed: depth ', G%HI, haloshift=1, scale=US%Z_to_m) call hchksum(G%mask2dT, 'MOM_initialize_fixed: mask2dT ', G%HI) call uvchksum('MOM_initialize_fixed: mask2dC[uv]', G%mask2dCu, & G%mask2dCv, G%HI) call qchksum(G%mask2dBu, 'MOM_initialize_fixed: mask2dBu ', G%HI) endif -! Modulate geometric scales according to geography. + ! Modulate geometric scales according to geography. call get_param(PF, mdl, "CHANNEL_CONFIG", config, & "A parameter that determines which set of channels are \n"//& "restricted to specific widths. Options are:\n"//& @@ -128,7 +131,7 @@ subroutine MOM_initialize_fixed(G, OBC, PF, write_geom, output_dir) "Unrecognized channel configuration "//trim(config)) end select -! This call sets the topography at velocity points. + ! This call sets the topography at velocity points. if (G%bathymetry_at_vel) then call get_param(PF, mdl, "VELOCITY_DEPTH_CONFIG", config, & "A string that determines how the topography is set at \n"//& From 6c478014368a4e8845a6c71f6c086cd011451efc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Nov 2018 06:02:02 -0500 Subject: [PATCH 0915/1072] +Add unit_scale_type arg to MOM_sum_output_init Added a unit_scale_type argument to MOM_sum_output_init, depth_list_setup, read_depth_list and write_depth_list, and used elements of this type to rescale depth variables in place of G%Zd_to_m. All answers are bitwise identical. --- src/core/MOM.F90 | 2 +- src/diagnostics/MOM_sum_output.F90 | 32 ++++++++++++++++-------------- 2 files changed, 18 insertions(+), 16 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 4063ac619d..b2d211796f 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2452,7 +2452,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%nstep_tot = 0 if (present(count_calls)) CS%count_calls = count_calls - call MOM_sum_output_init(G, param_file, dirs%output_directory, & + call MOM_sum_output_init(G, US, param_file, dirs%output_directory, & CS%ntrunc, Time_init, CS%sum_output_CSp) ! Flag whether to save initial conditions in finish_MOM_initialization() or not. diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 112c3b9104..92028dabf4 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -117,9 +117,10 @@ module MOM_sum_output contains !> MOM_sum_output_init initializes the parameters and settings for the MOM_sum_output module. -subroutine MOM_sum_output_init(G, param_file, directory, ntrnc, & +subroutine MOM_sum_output_init(G, US, param_file, directory, ntrnc, & Input_start_time, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. character(len=*), intent(in) :: directory !< The directory where the energy file goes. @@ -213,7 +214,7 @@ subroutine MOM_sum_output_init(G, param_file, directory, ntrnc, & call get_param(param_file, mdl, "DEPTH_LIST_MIN_INC", CS%D_list_min_inc, & "The minimum increment between the depths of the \n"//& "entries in the depth-list file.", & - units="m", default=1.0E-10, scale=1.0/G%Zd_to_m) + units="m", default=1.0E-10, scale=US%m_to_Z) if (CS%read_depth_list) then call get_param(param_file, mdl, "DEPTH_LIST_FILE", CS%depth_list_file, & "The name of the depth list file.", default="Depth_list.nc") @@ -222,7 +223,7 @@ subroutine MOM_sum_output_init(G, param_file, directory, ntrnc, & endif allocate(CS%lH(G%ke)) - call depth_list_setup(G, CS) + call depth_list_setup(G, US, CS) else CS%list_size = 0 endif @@ -1023,8 +1024,9 @@ end subroutine accumulate_net_input !! cross sectional areas at each depth and the volume of fluid deeper !! than each depth. This might be read from a previously created file !! or it might be created anew. (For now only new creation occurs. -subroutine depth_list_setup(G, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure +subroutine depth_list_setup(G, US, CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(Sum_output_CS), pointer :: CS !< The control structure returned by a !! previous call to MOM_sum_output_init. ! Local variables @@ -1032,13 +1034,13 @@ subroutine depth_list_setup(G, CS) if (CS%read_depth_list) then if (file_exists(CS%depth_list_file)) then - call read_depth_list(G, CS, CS%depth_list_file) + call read_depth_list(G, US, CS, CS%depth_list_file) else if (is_root_pe()) call MOM_error(WARNING, "depth_list_setup: "// & trim(CS%depth_list_file)//" does not exist. Creating a new file.") call create_depth_list(G, CS) - call write_depth_list(G, CS, CS%depth_list_file, CS%list_size+1) + call write_depth_list(G, US, CS, CS%depth_list_file, CS%list_size+1) endif else call create_depth_list(G, CS) @@ -1177,8 +1179,9 @@ subroutine create_depth_list(G, CS) end subroutine create_depth_list !> This subroutine writes out the depth list to the specified file. -subroutine write_depth_list(G, CS, filename, list_size) +subroutine write_depth_list(G, US, CS, filename, list_size) 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(Sum_output_CS), pointer :: CS !< The control structure returned by a !! previous call to MOM_sum_output_init. character(len=*), intent(in) :: filename !< The path to the depth list file to write. @@ -1235,7 +1238,7 @@ subroutine write_depth_list(G, CS, filename, list_size) if (status /= NF90_NOERR) call MOM_error(WARNING, & filename//trim(NF90_STRERROR(status))) - do k=1,list_size ; tmp(k) = G%Zd_to_m*CS%DL(k)%depth ; enddo + do k=1,list_size ; tmp(k) = US%Z_to_m*CS%DL(k)%depth ; enddo status = NF90_PUT_VAR(ncid, Did, tmp) if (status /= NF90_NOERR) call MOM_error(WARNING, & filename//" depth "//trim(NF90_STRERROR(status))) @@ -1245,7 +1248,7 @@ subroutine write_depth_list(G, CS, filename, list_size) if (status /= NF90_NOERR) call MOM_error(WARNING, & filename//" area "//trim(NF90_STRERROR(status))) - do k=1,list_size ; tmp(k) = G%Zd_to_m*CS%DL(k)%vol_below ; enddo + do k=1,list_size ; tmp(k) = US%Z_to_m*CS%DL(k)%vol_below ; enddo status = NF90_PUT_VAR(ncid, Vid, tmp) if (status /= NF90_NOERR) call MOM_error(WARNING, & filename//" vol_below "//trim(NF90_STRERROR(status))) @@ -1258,8 +1261,9 @@ end subroutine write_depth_list !> This subroutine reads in the depth list to the specified file !! and allocates and sets up CS%DL and CS%list_size . -subroutine read_depth_list(G, CS, filename) +subroutine read_depth_list(G, US, CS, filename) 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(Sum_output_CS), pointer :: CS !< The control structure returned by a !! previous call to MOM_sum_output_init. character(len=*), intent(in) :: filename !< The path to the depth list file to read. @@ -1267,12 +1271,10 @@ subroutine read_depth_list(G, CS, filename) character(len=32) :: mdl character(len=240) :: var_name, var_msg real, allocatable :: tmp(:) - real :: m_to_Z integer :: ncid, status, varid, list_size, k integer :: ndim, len, var_dim_ids(NF90_MAX_VAR_DIMS) mdl = "MOM_sum_output read_depth_list:" - m_to_Z = 1.0/G%Zd_to_m status = NF90_OPEN(filename, NF90_NOWRITE, ncid) if (status /= NF90_NOERR) then @@ -1311,7 +1313,7 @@ subroutine read_depth_list(G, CS, filename) " Difficulties reading variable "//trim(var_msg)//& trim(NF90_STRERROR(status))) - do k=1,list_size ; CS%DL(k)%depth = m_to_Z*tmp(k) ; enddo + do k=1,list_size ; CS%DL(k)%depth = US%m_to_Z*tmp(k) ; enddo var_name = "area" var_msg = trim(var_name)//" in "//trim(filename)//" - " @@ -1337,7 +1339,7 @@ subroutine read_depth_list(G, CS, filename) " Difficulties reading variable "//trim(var_msg)//& trim(NF90_STRERROR(status))) - do k=1,list_size ; CS%DL(k)%vol_below = m_to_Z*tmp(k) ; enddo + do k=1,list_size ; CS%DL(k)%vol_below = US%m_to_Z*tmp(k) ; enddo status = NF90_CLOSE(ncid) if (status /= NF90_NOERR) call MOM_error(WARNING, mdl// & From 3d4c8913de017b510052b389ca3ecbbab4c8bb49 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Nov 2018 06:03:33 -0500 Subject: [PATCH 0916/1072] +Add optional unit_scale_type arg to initialize_masks Added an optional unit_scale_type argument to initialize_masks and write_ocean_geometry_file, and used elements of this type to rescale depth variables in place of G%Zd_to_m. All answers are bitwise identical. --- src/ice_shelf/MOM_ice_shelf.F90 | 2 +- .../MOM_fixed_initialization.F90 | 6 +++--- src/initialization/MOM_grid_initialize.F90 | 19 ++++++++++++------- .../MOM_shared_initialization.F90 | 19 ++++++++++++------- 4 files changed, 28 insertions(+), 18 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index a7b89c4934..82ae988f4f 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -1385,7 +1385,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! Set up the bottom depth, G%D either analytically or from file call MOM_initialize_topography(dG%bathyT, G%max_depth, dG, param_file) - if (dG%Zd_to_m /= US%Z_to_m) call rescale_dyn_horgrid_bathymetry(dG, US%Z_to_m) + call rescale_dyn_horgrid_bathymetry(dG, US%Z_to_m) ! Set up the Coriolis parameter, G%f, usually analytically. call MOM_initialize_rotation(dG%CoriolisBu, dG, param_file) diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 24d496703c..c7ebb6a251 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -84,7 +84,7 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) ! This also sets G%max_depth based on the input parameter MAXIMUM_DEPTH, ! or, if absent, is diagnosed as G%max_depth = max( G%D(:,:) ) call MOM_initialize_topography(G%bathyT, G%max_depth, G, PF) - if (G%Zd_to_m /= US%Z_to_m) call rescale_dyn_horgrid_bathymetry(G, US%Z_to_m) + call rescale_dyn_horgrid_bathymetry(G, US%Z_to_m) ! To initialize masks, the bathymetry in halo regions must be filled in call pass_var(G%bathyT, G%Domain) @@ -96,7 +96,7 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) call open_boundary_impose_normal_slope(OBC, G, G%bathyT) ! This call sets masks that prohibit flow over any point interpreted as land - call initialize_masks(G, PF) + call initialize_masks(G, PF, US) ! Make OBC mask consistent with land mask call open_boundary_impose_land_mask(OBC, G, G%areaCu, G%areaCv) @@ -162,7 +162,7 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) call compute_global_grid_integrals(G) ! Write out all of the grid data used by this run. - if (write_geom) call write_ocean_geometry_file(G, PF, output_dir) + if (write_geom) call write_ocean_geometry_file(G, PF, output_dir, US=US) call callTree_leave('MOM_initialize_fixed()') diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 0f5a8505ab..7019564586 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -16,6 +16,7 @@ module MOM_grid_initialize use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_io, only : MOM_read_data, read_data, slasher, file_exists use MOM_io, only : CORNER, NORTH_FACE, EAST_FACE +use MOM_unit_scaling, only : unit_scale_type use mpp_domains_mod, only : mpp_get_domain_extents, mpp_deallocate_domain @@ -1214,26 +1215,30 @@ end function Adcroft_reciprocal !! are 0.0 at any points adjacent to a land point. mask2dBu is 0.0 at !! any land or boundary point. For points in the interior, mask2dCu, !! mask2dCv, and mask2dBu are all 1.0. -subroutine initialize_masks(G, PF) - type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type - type(param_file_type), intent(in) :: PF !< Parameter file structure +subroutine initialize_masks(G, PF, US) + type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type + type(param_file_type), intent(in) :: PF !< Parameter file structure + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: Dmin ! The depth for masking in the same units as G%bathyT (Z). - real :: min_depth, mask_depth ! Depths in the same units as G%bathyT (Z). + real :: m_to_Z_scale ! A unit conversion factor from m to Z. + real :: Dmin ! The depth for masking in the same units as G%bathyT (Z). + real :: min_depth ! The minimum ocean depth in the same units as G%bathyT (Z). + real :: mask_depth ! The depth shallower than which to mask a point as land, in Z. character(len=40) :: mdl = "MOM_grid_init initialize_masks" integer :: i, j call callTree_enter("initialize_masks(), MOM_grid_initialize.F90") + m_to_Z_scale = 1.0 ; if (present(US)) m_to_Z_scale = US%m_to_Z call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & "If MASKING_DEPTH is unspecified, then anything shallower than\n"//& "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out.\n"//& "If MASKING_DEPTH is specified, then all depths shallower than\n"//& "MINIMUM_DEPTH but deeper than MASKING_DEPTH are rounded to MINIMUM_DEPTH.", & - units="m", default=0.0, scale=1.0/G%Zd_to_m) + units="m", default=0.0, scale=m_to_Z_scale) call get_param(PF, mdl, "MASKING_DEPTH", mask_depth, & "The depth below which to mask points as land points, for which all\n"//& "fluxes are zeroed out. MASKING_DEPTH is ignored if negative.", & - units="m", default=-9999.0, scale=1.0/G%Zd_to_m) + units="m", default=-9999.0, scale=m_to_Z_scale) Dmin = min_depth if (mask_depth>=0.) Dmin = mask_depth diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 31dfc551b5..9ca352c3ed 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -15,6 +15,7 @@ module MOM_shared_initialization use MOM_io, only : MOM_read_data, MOM_read_vector, SINGLE_FILE, MULTIPLE use MOM_io, only : slasher, vardesc, write_field, var_desc use MOM_string_functions, only : uppercase +use MOM_unit_scaling, only : unit_scale_type use netcdf @@ -1143,12 +1144,13 @@ end subroutine compute_global_grid_integrals ! ----------------------------------------------------------------------------- !> Write out a file describing the topography, Coriolis parameter, grid locations !! and various other fixed fields from the grid. -subroutine write_ocean_geometry_file(G, param_file, directory, geom_file) - type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid - type(param_file_type), intent(in) :: param_file !< Parameter file structure - character(len=*), intent(in) :: directory !< The directory into which to place the geometry file. - character(len=*), optional, intent(in) :: geom_file !< If present, the name of the geometry file - !! (otherwise the file is "ocean_geometry") +subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) + type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid + type(param_file_type), intent(in) :: param_file !< Parameter file structure + character(len=*), intent(in) :: directory !< The directory into which to place the geometry file. + character(len=*), optional, intent(in) :: geom_file !< If present, the name of the geometry file + !! (otherwise the file is "ocean_geometry") + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables. character(len=240) :: filepath @@ -1156,6 +1158,7 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file) integer, parameter :: nFlds=23 type(vardesc) :: vars(nFlds) type(fieldtype) :: fields(nFlds) + real :: Z_to_m_scale ! A unit conversion factor from Z to m. integer :: unit integer :: file_threading integer :: nFlds_used @@ -1172,6 +1175,8 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + Z_to_m_scale = 1.0 ; if (present(US)) Z_to_m_scale = US%Z_to_m + ! vardesc is a structure defined in MOM_io.F90. The elements of ! this structure, in order, are: ! (1) the variable name for the NetCDF file @@ -1240,7 +1245,7 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file) call write_field(unit, fields(3), G%Domain%mpp_domain, G%geoLatT) call write_field(unit, fields(4), G%Domain%mpp_domain, G%geoLonT) - do j=js,je ; do i=is,ie ; out_h(i,j) = G%Zd_to_m*G%bathyT(i,j) ; enddo ; enddo + do j=js,je ; do i=is,ie ; out_h(i,j) = Z_to_m_scale*G%bathyT(i,j) ; enddo ; enddo call write_field(unit, fields(5), G%Domain%mpp_domain, out_h) call write_field(unit, fields(6), G%Domain%mpp_domain, G%CoriolisBu) From fac1464e831ebe2b6165e27dc2fc014023fee1bd Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Nov 2018 10:23:13 -0500 Subject: [PATCH 0917/1072] +Eliminated Zd_to_m from grid types Eliminated Zd_to_m from dyn_horgrid_type and ocean_grid_type. Instead, any dimensional rescaling uses elements of unit_scale_types. All answers are bitwise identical. --- src/core/MOM_grid.F90 | 8 +++----- src/core/MOM_transcribe_grid.F90 | 2 -- src/framework/MOM_dyn_horgrid.F90 | 16 +++++++--------- 3 files changed, 10 insertions(+), 16 deletions(-) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index c0ca264d68..e226598b7f 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -132,7 +132,6 @@ module MOM_grid real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & bathyT !< Ocean bottom depth at tracer points, in depth units. - real :: Zd_to_m = 1.0 !< The conversion factor between the units of bathyT and m. logical :: bathymetry_at_vel !< If true, there are separate values for the !! basin depths at velocity points. Otherwise the effects of @@ -165,7 +164,7 @@ module MOM_grid real :: len_lat = 0. !< The latitudinal (or y-coord) extent of physical domain real :: len_lon = 0. !< The longitudinal (or x-coord) extent of physical domain real :: Rad_Earth = 6.378e6 !< The radius of the planet in meters. - real :: max_depth !< The maximum depth of the ocean in depth units (scaled by Zd_to_m). + real :: max_depth !< The maximum depth of the ocean in depth units (Z). end type ocean_grid_type contains @@ -359,13 +358,13 @@ subroutine rescale_grid_bathymetry(G, m_in_new_units) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - if (m_in_new_units == G%Zd_to_m) return + if (m_in_new_units == 1.0) return if (m_in_new_units < 0.0) & call MOM_error(FATAL, "rescale_grid_bathymetry: Negative depth units are not permitted.") if (m_in_new_units == 0.0) & call MOM_error(FATAL, "rescale_grid_bathymetry: Zero depth units are not permitted.") - rescale = G%Zd_to_m / m_in_new_units + rescale = 1.0 / m_in_new_units do j=jsd,jed ; do i=isd,ied G%bathyT(i,j) = rescale*G%bathyT(i,j) enddo ; enddo @@ -376,7 +375,6 @@ subroutine rescale_grid_bathymetry(G, m_in_new_units) G%Dblock_v(i,J) = rescale*G%Dblock_v(i,J) ; G%Dopen_v(i,J) = rescale*G%Dopen_v(i,J) enddo ; enddo ; endif G%max_depth = rescale*G%max_depth - G%Zd_to_m = m_in_new_units end subroutine rescale_grid_bathymetry diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index 8c3786d51a..62ac6e1ea4 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -44,7 +44,6 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG) if ((isd > oG%isc) .or. (ied < oG%ied) .or. (jsd > oG%jsc) .or. (jed > oG%jed)) & call MOM_error(FATAL, "copy_dyngrid_to_MOM_grid called with incompatible grids.") - oG%Zd_to_m = dG%Zd_to_m do i=isd,ied ; do j=jsd,jed oG%geoLonT(i,j) = dG%geoLonT(i+ido,j+jdo) oG%geoLatT(i,j) = dG%geoLatT(i+ido,j+jdo) @@ -188,7 +187,6 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG) if ((isd > dG%isc) .or. (ied < dG%ied) .or. (jsd > dG%jsc) .or. (jed > dG%jed)) & call MOM_error(FATAL, "copy_dyngrid_to_MOM_grid called with incompatible grids.") - dG%Zd_to_m = oG%Zd_to_m do i=isd,ied ; do j=jsd,jed dG%geoLonT(i,j) = oG%geoLonT(i+ido,j+jdo) dG%geoLatT(i,j) = oG%geoLatT(i+ido,j+jdo) diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 37500d31c2..51c45bc1b9 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -132,17 +132,16 @@ module MOM_dyn_horgrid real, allocatable, dimension(:,:) :: & bathyT !< Ocean bottom depth at tracer points, in depth units. - real :: Zd_to_m = 1.0 !< The conversion factor between the units of bathyT and m. logical :: bathymetry_at_vel !< If true, there are separate values for the !! basin depths at velocity points. Otherwise the effects of !! of topography are entirely determined from thickness points. real, allocatable, dimension(:,:) :: & - Dblock_u, & !< Topographic depths at u-points at which the flow is blocked, in depth units. - Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu, in depth units. + Dblock_u, & !< Topographic depths at u-points at which the flow is blocked, in Z. + Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu, in Z. real, allocatable, dimension(:,:) :: & - Dblock_v, & !< Topographic depths at v-points at which the flow is blocked, in depth units. - Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv, in depth units. + Dblock_v, & !< Topographic depths at v-points at which the flow is blocked, in Z. + Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv, in Z. real, allocatable, dimension(:,:) :: & CoriolisBu !< The Coriolis parameter at corner points, in s-1. real, allocatable, dimension(:,:) :: & @@ -160,7 +159,7 @@ module MOM_dyn_horgrid real :: len_lat = 0. !< The latitudinal (or y-coord) extent of physical domain real :: len_lon = 0. !< The longitudinal (or x-coord) extent of physical domain real :: Rad_Earth = 6.378e6 !< The radius of the planet in meters. - real :: max_depth !< The maximum depth of the ocean in depth units (scaled by Zd_to_m). + real :: max_depth !< The maximum depth of the ocean in Z. end type dyn_horgrid_type contains @@ -287,13 +286,13 @@ subroutine rescale_dyn_horgrid_bathymetry(G, m_in_new_units) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - if (m_in_new_units == G%Zd_to_m) return + if (m_in_new_units == 1.0) return if (m_in_new_units < 0.0) & call MOM_error(FATAL, "rescale_grid_bathymetry: Negative depth units are not permitted.") if (m_in_new_units == 0.0) & call MOM_error(FATAL, "rescale_grid_bathymetry: Zero depth units are not permitted.") - rescale = G%Zd_to_m / m_in_new_units + rescale = 1.0 / m_in_new_units do j=jsd,jed ; do i=isd,ied G%bathyT(i,j) = rescale*G%bathyT(i,j) enddo ; enddo @@ -304,7 +303,6 @@ subroutine rescale_dyn_horgrid_bathymetry(G, m_in_new_units) G%Dblock_v(i,J) = rescale*G%Dblock_v(i,J) ; G%Dopen_v(i,J) = rescale*G%Dopen_v(i,J) enddo ; enddo ; endif G%max_depth = rescale*G%max_depth - G%Zd_to_m = m_in_new_units end subroutine rescale_dyn_horgrid_bathymetry From 5810cf0c7b329c6e73007c7fab77eafc706b7143 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Nov 2018 11:23:13 -0500 Subject: [PATCH 0918/1072] Recast internal MOM_barotropic variables into Z Recast two internal variables used in the call to set_dtbt from within barotropic_init to have units of Z instead of m and m2 Z-1 s-2 instead of m s-2, simplifying the code, and expanding dimensional consistency testing. All answers are bitwise identical in the MOM6 test cases, including rescaling Z over a large range. --- src/core/MOM_barotropic.F90 | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 5c6ec52fc7..7095d370b6 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -2272,10 +2272,10 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) !! the effective open face areas as a !! function of barotropic flow. real, optional, intent(in) :: gtot_est !< An estimate of the total gravitational - !! acceleration, in m s-2. + !! acceleration, in m2 Z-1 s-2. real, optional, intent(in) :: SSH_add !< An additional contribution to SSH to !! provide a margin of error when - !! calculating the external wave speed, in m. + !! calculating the external wave speed, in Z. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & @@ -2299,7 +2299,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) ! order 1. For stability, this may be made larger ! than physical problem would suggest. real :: add_SSH ! An additional contribution to SSH to provide a margin of error - ! when calculating the external wave speed, in m. + ! when calculating the external wave speed, in Z. real :: min_max_dt2, Idt_max2, dtbt_max logical :: use_BT_cont type(memory_size_type) :: MS @@ -2326,7 +2326,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) elseif (CS%Nonlinear_continuity .and. present(eta)) then call find_face_areas(Datu, Datv, G, GV, CS, MS, eta=eta, halo=0) else - call find_face_areas(Datu, Datv, G, GV, CS, MS, halo=0, add_max=add_SSH*US%m_to_Z) + call find_face_areas(Datu, Datv, G, GV, CS, MS, halo=0, add_max=add_SSH) endif det_de = 0.0 @@ -2345,8 +2345,8 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) enddo ; enddo ; enddo else do j=js,je ; do i=is,ie - gtot_E(i,j) = gtot_est * GV%H_to_m ; gtot_W(i,j) = gtot_est * GV%H_to_m - gtot_N(i,j) = gtot_est * GV%H_to_m ; gtot_S(i,j) = gtot_est * GV%H_to_m + gtot_E(i,j) = gtot_est * GV%H_to_Z ; gtot_W(i,j) = gtot_est * GV%H_to_Z + gtot_N(i,j) = gtot_est * GV%H_to_Z ; gtot_S(i,j) = gtot_est * GV%H_to_Z enddo ; enddo endif @@ -3717,9 +3717,9 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, character(len=40) :: mdl = "MOM_barotropic" ! This module's name. real :: Datu(SZIBS_(G),SZJ_(G)) ! Zonal open face area in H m. real :: Datv(SZI_(G),SZJBS_(G)) ! Meridional open face area in H m. - real :: gtot_estimate ! Summing GV%g_prime gives an upper-bound estimate for pbce. + real :: gtot_estimate ! Summed GV%g_prime in m2 Z-1 s-2, to give an upper-bound estimate for pbce. real :: SSH_extra ! An estimate of how much higher SSH might get, for use - ! in calculating the safe external wave speed. + ! in calculating the safe external wave speed, in Z. real :: dtbt_input, dtbt_tmp real :: wave_drag_scale ! A scaling factor for the barotropic linear wave drag ! piston velocities. @@ -3956,7 +3956,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, "An estimate of how much higher SSH might get, for use \n"//& "in calculating the safe external wave speed. The \n"//& "default is the minimum of 10 m or 5% of MAXIMUM_DEPTH.", & - units="m", default=min(10.0,0.05*G%max_depth*US%Z_to_m)) + units="m", default=min(10.0,0.05*G%max_depth*US%Z_to_m), scale=US%m_to_Z) call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & @@ -4141,8 +4141,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! Estimate the maximum stable barotropic time step. gtot_estimate = 0.0 - do k=1,G%ke ; gtot_estimate = gtot_estimate + GV%g_prime(K)*US%m_to_Z ; enddo - call set_dtbt(G, GV, US, CS, gtot_est = gtot_estimate, SSH_add = SSH_extra) + do k=1,G%ke ; gtot_estimate = gtot_estimate + GV%g_prime(K) ; enddo + call set_dtbt(G, GV, US, CS, gtot_est=gtot_estimate, SSH_add=SSH_extra) if (dtbt_input > 0.0) then CS%dtbt = dtbt_input From 4491b845a272f97a7595c08e43cae341ca239805 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Thu, 15 Nov 2018 18:25:48 +0000 Subject: [PATCH 0919/1072] Corrected soma comment/doxygen syntax --- src/parameterizations/lateral/MOM_MEKE.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 2b388150b3..f412082c8e 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -1,5 +1,5 @@ !> Implements the Mesoscale Eddy Kinetic Energy framework -! with topographic beta effect included in computing beta in Rhines scale +!! with topographic beta effect included in computing beta in Rhines scale module MOM_MEKE @@ -63,8 +63,8 @@ module MOM_MEKE real :: aEady !< Weighting towards Eady scale of mixing length (non-dim.) real :: aGrid !< Weighting towards grid scale of mixing length (non-dim.) real :: MEKE_advection_factor !< A scaling in front of the advection of MEKE (non-dim.) - real :: MEKE_topographic_beta !< weighting how much topographic beta is considered - ! when computing beta in Rhines scale + real :: MEKE_topographic_beta !< Weight for how much topographic beta is considered + !! when computing beta in Rhines scale (non-dim.) logical :: initialize !< If True, invokes a steady state solver to calculate MEKE. logical :: debug !< If true, write out checksums of data for debugging @@ -704,7 +704,7 @@ subroutine MEKE_lengthScales(CS, MEKE, G, US, SN_u, SN_v, & SN = 0. endif FatH = 0.25*( ( G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1) ) + & - ( G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1) ) ) !< Coriolis parameter at h points + ( G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1) ) ) ! Coriolis parameter at h points beta = sqrt( ( G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & *(G%bathyT(i+1,j) - G%bathyT(i-1,j)) /2./G%dxT(i,j) )**2. & + ( G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & From 7f737646b66040b5601cc6ac08480d8a598b1363 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Nov 2018 18:41:13 -0500 Subject: [PATCH 0920/1072] +Recast ustar_gustless into Z/s Rescaled ustar_gustless and the ustar argument to get_Langmuir_number from m/s to Z/s, and added a unit_scale_type argument to set_derived_forcing fields. Also rolled some unit conversion factors into Irho0, simplifying several lines of the code in extract_IOB_stresses. All answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 24 +++++++++---------- .../ice_solo_driver/MOM_surface_forcing.F90 | 14 ++++++----- config_src/mct_driver/MOM_ocean_model.F90 | 2 +- .../solo_driver/MOM_surface_forcing.F90 | 2 +- src/core/MOM_forcing_type.F90 | 11 +++++---- .../vertical/MOM_CVMix_KPP.F90 | 2 +- .../vertical/MOM_energetic_PBL.F90 | 2 +- src/user/MOM_wave_interface.F90 | 18 +++++++------- 8 files changed, 39 insertions(+), 36 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 045a9dc7de..fc646a4f56 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -794,7 +794,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, 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 - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. real, dimension(SZIB_(G),SZJ_(G)), & @@ -805,7 +805,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, optional, intent(inout) :: ustar !< The surface friction velocity, in Z s-1. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(out) :: gustless_ustar !< The surface friction velocity without - !! any contributions from gustiness, in m s-1. + !! any contributions from gustiness, in Z s-1. integer, optional, intent(in) :: tau_halo !< The halo size of wind stresses to set, 0 by default. ! Local variables @@ -817,7 +817,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, real, dimension(SZIB_(G),SZJB_(G)) :: tauy_in_B ! Meridional wind stresses (in Pa) at q points real :: gustiness ! unresolved gustiness that contributes to ustar (Pa) - real :: Irho0 ! inverse of the mean density in (m^3/kg) + real :: Irho0 ! Inverse of the mean density rescaled to (Z2 m / kg) real :: taux2, tauy2 ! squared wind stresses (Pa^2) real :: tau_mag ! magnitude of the wind stress (Pa) @@ -831,7 +831,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, Isqh = G%IscB-halo ; Ieqh = G%IecB+halo ; Jsqh = G%JscB-halo ; Jeqh = G%JecB+halo i0 = is - index_bounds(1) ; j0 = js - index_bounds(3) - Irho0 = 1.0/CS%Rho0 + Irho0 = US%m_to_Z**2 / CS%Rho0 do_ustar = present(ustar) ; do_gustless = present(gustless_ustar) @@ -943,10 +943,10 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) > 0)) ) & gustiness = CS%gust(i,j) endif - ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0*IOB%stress_mag(i-i0,j-j0)) + ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*IOB%stress_mag(i-i0,j-j0)) enddo ; enddo ; endif if (do_gustless) then ; do j=js,je ; do i=is,ie - gustless_ustar(i,j) = sqrt(IOB%stress_mag(i-i0,j-j0) / CS%Rho0) + gustless_ustar(i,j) = US%m_to_Z * sqrt(IOB%stress_mag(i-i0,j-j0) / CS%Rho0) !### Change to: ! gustless_ustar(i,j) = sqrt(Irho0 * IOB%stress_mag(i-i0,j-j0)) enddo ; enddo ; endif @@ -962,8 +962,8 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif - if (do_ustar) ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = sqrt(tau_mag / CS%Rho0) + if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) + if (do_gustless) gustless_ustar(i,j) = US%m_to_Z * sqrt(tau_mag / CS%Rho0) !### Change to: ! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) enddo ; enddo @@ -972,8 +972,8 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, tau_mag = G%mask2dT(i,j) * sqrt(taux_in_A(i,j)**2 + tauy_in_A(i,j)**2) gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - if (do_ustar) ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = sqrt(tau_mag / CS%Rho0) + if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) + if (do_gustless) gustless_ustar(i,j) = US%m_to_Z * sqrt(tau_mag / CS%Rho0) !### Change to: ! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) enddo ; enddo @@ -991,8 +991,8 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, gustiness = CS%gust_const if (CS%read_gust_2d) gustiness = CS%gust(i,j) - if (do_ustar) ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = sqrt(tau_mag / CS%Rho0) + if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) + if (do_gustless) gustless_ustar(i,j) = US%m_to_Z * sqrt(tau_mag / CS%Rho0) !### Change to: ! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) enddo ; enddo diff --git a/config_src/ice_solo_driver/MOM_surface_forcing.F90 b/config_src/ice_solo_driver/MOM_surface_forcing.F90 index c0b6d7dd94..301b8a9eea 100644 --- a/config_src/ice_solo_driver/MOM_surface_forcing.F90 +++ b/config_src/ice_solo_driver/MOM_surface_forcing.F90 @@ -167,15 +167,17 @@ module MOM_surface_forcing contains -subroutine set_forcing(sfc_state, forcing, fluxes, day_start, day_interval, G, CS) +subroutine set_forcing(sfc_state, forcing, fluxes, day_start, day_interval, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(forcing), intent(inout) :: fluxes - type(time_type), intent(in) :: day_start - type(time_type), intent(in) :: day_interval + type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields + type(time_type), intent(in) :: day_start !< The start time of the fluxes + type(time_type), intent(in) :: day_interval !< Length of time over which these fluxes applied type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(surface_forcing_CS), pointer :: CS + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by + !! a previous surface_forcing_init call ! This subroutine calls other subroutines in this file to get surface forcing fields. ! It also allocates and initializes the fields in the flux type. @@ -282,7 +284,7 @@ subroutine set_forcing(sfc_state, forcing, fluxes, day_start, day_interval, G, C ! Fields that exist in both the forcing and mech_forcing types must be copied. if (CS%variable_winds .or. CS%first_call_set_forcing) then call copy_common_forcing_fields(forces, fluxes, G) - call set_derived_forcing_fields(forces, fluxes, G, CS%Rho0) + call set_derived_forcing_fields(forces, fluxes, G, US, CS%Rho0) endif if ((CS%variable_buoyforce .or. CS%first_call_set_forcing) .and. & diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index a7b41dbe67..1a3a06b4d8 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -542,7 +542,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & #endif endif - call set_derived_forcing_fields(OS%forces, OS%fluxes, OS%grid, OS%GV%Rho0) + 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%nstep==0) then diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 1a2622cfc5..d404edf9f3 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -340,7 +340,7 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, US ! Fields that exist in both the forcing and mech_forcing types must be copied. if (CS%variable_winds .or. CS%first_call_set_forcing) then call copy_common_forcing_fields(forces, fluxes, G) - call set_derived_forcing_fields(forces, fluxes, G, CS%Rho0) + call set_derived_forcing_fields(forces, fluxes, G, US, CS%Rho0) endif if ((CS%variable_buoyforce .or. CS%first_call_set_forcing) .and. & diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 770cfc6e35..69f39c7ddb 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -47,7 +47,7 @@ module MOM_forcing_type real, pointer, dimension(:,:) :: & ustar => NULL(), & !< surface friction velocity scale (Z/s) ustar_gustless => NULL() !< surface friction velocity scale without any - !! any augmentation for gustiness (m/s) + !! any augmentation for gustiness (Z/s) ! surface buoyancy force, used when temperature is not a state variable real, pointer, dimension(:,:) :: & @@ -1961,19 +1961,20 @@ end subroutine copy_common_forcing_fields !> This subroutine calculates certain derived forcing fields based on information !! from a mech_forcing type and stores them in a (thermodynamic) forcing type. -subroutine set_derived_forcing_fields(forces, fluxes, G, Rho0) +subroutine set_derived_forcing_fields(forces, fluxes, G, US, Rho0) type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(ocean_grid_type), intent(in) :: G !< grid type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: Rho0 !< A reference density of seawater, in kg m-3, !! as used to calculate ustar. real :: taux2, tauy2 ! Squared wind stress components, in Pa^2. - real :: Irho0 ! Inverse of the mean density in (m^3/kg) + real :: Irho0 ! Inverse of the mean density rescaled to (Z2 m / kg) integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - Irho0 = 1.0/Rho0 + Irho0 = US%m_to_Z**2 / Rho0 if (associated(forces%taux) .and. associated(forces%tauy) .and. & associated(fluxes%ustar_gustless)) then @@ -1989,7 +1990,7 @@ subroutine set_derived_forcing_fields(forces, fluxes, G, Rho0) G%mask2dCv(i,J) * forces%tauy(i,J)**2) / & (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) - fluxes%ustar_gustless(i,j) = sqrt(sqrt(taux2 + tauy2) / Rho0) + fluxes%ustar_gustless(i,j) = US%m_to_Z * sqrt(sqrt(taux2 + tauy2) / Rho0) !### Change to: ! fluxes%ustar_gustless(i,j) = sqrt(sqrt(taux2 + tauy2) * Irho0) enddo ; enddo diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 9c5e6bb3cc..67c4173b96 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -1072,7 +1072,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF endif !For now get Langmuir number based on prev. MLD (otherwise must compute 3d LA) MLD_GUESS = max( 1.*US%m_to_Z, abs(US%m_to_Z*CS%OBLdepthprev(i,j) ) ) - call get_Langmuir_Number( LA, G, GV, US, MLD_guess, surfFricVel, I, J, & + call get_Langmuir_Number( LA, G, GV, US, MLD_guess, uStar(i,j), i, j, & H=H(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES) WAVES%La_SL(i,j)=LA endif diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 0f685693c3..9e32cd2aa9 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -352,7 +352,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: I_dtrho ! 1.0 / (dt * Rho0) in m3 kg-1 s-1. This is ! used convert TKE back into ustar^3. real :: U_star ! The surface friction velocity, in Z s-1. - real :: U_Star_Mean ! The surface friction without gustiness in m s-1. + real :: U_Star_Mean ! The surface friction without gustiness in Z s-1. real :: vstar ! An in-situ turbulent velocity, in m s-1. real :: Enhance_M ! An enhancement factor for vstar, based here on Langmuir impact. real :: LA ! The Langmuir number (non-dim) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 1ede95cce5..f9934615dc 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -864,7 +864,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: i !< Meridional index of h-point integer, intent(in) :: j !< Zonal index of h-point - real, intent(in) :: ustar !< Friction velocity (m/s) + real, intent(in) :: ustar !< Friction velocity (Z/s) real, intent(in) :: HBL !< (Positive) thickness of boundary layer (Z) logical, optional, intent(in) :: Override_MA !< Override to use misalignment in LA !! calculation. This can be used if diagnostic @@ -940,7 +940,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & call Get_SL_Average_Prof( GV, Dpt_LASL, H, VS_H, LA_STKy) LA_STK = sqrt(LA_STKX**2 + LA_STKY**2) elseif (WaveMethod==LF17) then - call get_StokesSL_LiFoxKemper(ustar,hbl*LA_FracHBL, GV, US, LA_STK, LA) + call get_StokesSL_LiFoxKemper(ustar, hbl*LA_FracHBL, GV, US, LA_STK, LA) endif if (.not.(WaveMethod==LF17)) then @@ -949,11 +949,11 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & ! there is also no good reason to cap it here other then ! to prevent large enhancements in unconstrained parts of ! the curve fit parameterizations. - LA = max(WAVES%La_min,sqrt(USTAR/(LA_STK+1.e-10))) + LA = max(WAVES%La_min, sqrt(US%Z_to_m*ustar / (LA_STK+1.e-10))) endif if (Use_MA) then - WaveDirection = atan2(LA_STKy,LA_STKx) + WaveDirection = atan2(LA_STKy, LA_STKx) LA = LA / sqrt(max(1.e-8,cos( WaveDirection - ShearDirection))) endif @@ -977,7 +977,7 @@ end subroutine get_Langmuir_Number !! - BGR remove u10 input !! - BGR note: fixed parameter values should be changed to "get_params" subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) - real, intent(in) :: ustar !< water-side surface friction velocity (m/s) + real, intent(in) :: ustar !< water-side surface friction velocity (Z/s) real, intent(in) :: hbl !< boundary layer depth (Z) type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1001,7 +1001,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) if (ustar > 0.0) then ! Computing u10 based on u_star and COARE 3.5 relationships - call ust_2_u10_coare3p5(ustar*sqrt(GV%Rho0/1.225), u10, GV, US) + call ust_2_u10_coare3p5(US%Z_to_m*ustar*sqrt(GV%Rho0/1.225), u10, GV, US) ! surface Stokes drift UStokes = us_to_u10*u10 ! @@ -1046,13 +1046,13 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) sqrt( 2.0 * PI *kstar * z0) * & erfc( sqrt( 2.0 * kstar * z0 ) ) UStokes_sl = UStokes * (0.715 + r1 + r2 + r3 + r4) - LA = sqrt(ustar/UStokes_sl) + LA = sqrt(US%Z_to_m*ustar / UStokes_sl) else UStokes_sl = 0.0 LA=1.e8 endif - return -endsubroutine Get_StokesSL_LiFoxKemper + +end subroutine Get_StokesSL_LiFoxKemper !> Get SL Averaged Stokes drift from a Stokes drift Profile subroutine Get_SL_Average_Prof( GV, AvgDepth, H, Profile, Average ) From 1297ebfffe428899a40e7764b146c5efdc3a11fe Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 16 Nov 2018 13:45:37 +0000 Subject: [PATCH 0921/1072] Fixed line wrap in new parameter documentation --- src/parameterizations/lateral/MOM_MEKE.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index f412082c8e..a7433c58bb 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -944,8 +944,8 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) "between the advecting barotropic flow and the vertical structure of MEKE.", & units="nondim", default=0.0) call get_param(param_file, mdl, "MEKE_TOPOGRAPHIC_BETA", CS%MEKE_topographic_beta, & - "A scale factor to determine how much topographic beta is weighed in " //& - "computing beta in the expression of Rhines scale. Use 1 if full "//& + "A scale factor to determine how much topographic beta is weighed in\n" //& + "computing beta in the expression of Rhines scale. Use 1 if full\n"//& "topographic beta effect is considered; use 0 if it's completely ignored.", & units="nondim", default=0.0) From a1653f6b5e6178882e9cfec0ceba1d6b599b35c0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Nov 2018 15:36:45 -0500 Subject: [PATCH 0922/1072] +Rescale depth in DOME_initialize_topography Added an optional unit_scale_type argument to DOME_initialize_topography, and if it is present the unit conversion of the topography from m to Z occurs within this initialization routine. All answers are bitwise identical. --- src/user/DOME_initialization.F90 | 35 ++++++++++++++++++-------------- 1 file changed, 20 insertions(+), 15 deletions(-) diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 40e6e422df..101e52eb30 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -32,16 +32,19 @@ module DOME_initialization ! ----------------------------------------------------------------------------- !> This subroutine sets up the DOME topography -subroutine DOME_initialize_topography(D, G, param_file, max_depth) - type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type +subroutine DOME_initialize_topography(D, G, param_file, max_depth, US) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m - type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum depth of model in m - - real :: min_depth ! The minimum and maximum depths in m. -! This include declares and sets the variable "version". -#include "version_variable.h" + intent(out) :: D !< Ocean bottom depth in m or Z if US is present + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum model depth in the units of D + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + + ! Local variables + real :: m_to_Z ! A dimensional rescaling factor. + real :: min_depth ! The minimum and maximum depths in Z. + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "DOME_initialize_topography" ! This subroutine's name. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -49,22 +52,24 @@ subroutine DOME_initialize_topography(D, G, param_file, max_depth) call MOM_mesg(" DOME_initialization.F90, DOME_initialize_topography: setting topography", 5) + m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z + call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0) + "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) do j=js,je ; do i=is,ie if (G%geoLatT(i,j) < 600.0) then if (G%geoLatT(i,j) < 300.0) then - D(i,j)=max_depth + D(i,j) = max_depth else - D(i,j)=max_depth-10.0*(G%geoLatT(i,j)-300.0) + D(i,j) = max_depth - 10.0*m_to_Z * (G%geoLatT(i,j)-300.0) endif else - if ((G%geoLonT(i,j) > 1000.0).AND.(G%geoLonT(i,j) < 1100.0)) then - D(i,j)=600.0 + if ((G%geoLonT(i,j) > 1000.0) .AND. (G%geoLonT(i,j) < 1100.0)) then + D(i,j) = 600.0*m_to_Z else - D(i,j)=0.5*min_depth + D(i,j) = 0.5*min_depth endif endif From 771e44f218d8ad709599f38852362298741865f1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Nov 2018 15:37:10 -0500 Subject: [PATCH 0923/1072] +Rescale depth in ISOMIP_initialize_topography Added an optional unit_scale_type argument to ISOMIP_initialize_topography, and if it is present the unit conversion of the topography from m to Z occurs within this initialization routine. All answers are bitwise identical. --- src/user/ISOMIP_initialization.F90 | 49 +++++++++++++++++------------- 1 file changed, 28 insertions(+), 21 deletions(-) diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index c5d55640a6..6a3bf8007e 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -36,23 +36,27 @@ module ISOMIP_initialization contains !> Initialization of topography for the ISOMIP configuration -subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth) - type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type +subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m - type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum depth of model in m + intent(out) :: D !< Ocean bottom depth in m or Z if US is present + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum model depth in the units of D + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + ! Local variables - real :: min_depth ! The minimum and maximum depths in m. + real :: min_depth ! The minimum and maximum depths in Z. + real :: m_to_Z ! A dimensional rescaling factor. ! The following variables are used to set up the bathymetry in the ISOMIP example. real :: bmax ! max depth of bedrock topography real :: b0,b2,b4,b6 ! first, second, third and fourth bedrock topography coeff - real :: xbar ! characteristic along-flow lenght scale of the bedrock - real :: dc ! depth of the trough compared with side walls + real :: xbar ! characteristic along-flow lenght scale of the bedrock + real :: dc ! depth of the trough compared with side walls in Z real :: fc ! characteristic width of the side walls of the channel real :: wc ! half-width of the trough real :: ly ! domain width (across ice flow) - real :: bx, by, xtil ! dummy vatiables + real :: bx, by ! dummy vatiables in Z + real :: xtil ! dummy vatiable logical :: is_2D ! If true, use 2D setup ! This include declares and sets the variable "version". #include "version_variable.h" @@ -63,15 +67,18 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth) call MOM_mesg(" ISOMIP_initialization.F90, ISOMIP_initialize_topography: setting topography", 5) + m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z + call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0) + "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) call get_param(param_file, mdl, "ISOMIP_2D",is_2D,'If true, use a 2D setup.', default=.false.) ! The following variables should be transformed into runtime parameters? - bmax=720.0; b0=-150.0; b2=-728.8; b4=343.91; b6=-50.57 - xbar=300.0E3; dc=500.0; fc=4.0E3; wc=24.0E3; ly=80.0E3 - bx = 0.0; by = 0.0; xtil = 0.0 + bmax = 720.0*m_to_Z ; dc = 500.0*m_to_Z + b0 = -150.0*m_to_Z ; b2 = -728.8*m_to_Z ; b4 = 343.91*m_to_Z ; b6 = -50.57*m_to_Z + xbar = 300.0e3 ; fc = 4.0e3 ; wc = 24.0e3 ; ly = 80.0e3 + bx = 0.0 ; by = 0.0 ; xtil = 0.0 if (is_2D) then @@ -79,15 +86,15 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth) ! 2D setup xtil = G%geoLonT(i,j)*1.0e3/xbar !xtil = 450*1.0e3/xbar - bx = b0+b2*xtil**2 + b4*xtil**4 + b6*xtil**6 + bx = b0 + b2*xtil**2 + b4*xtil**4 + b6*xtil**6 !by = (dc/(1.+exp(-2.*(G%geoLatT(i,j)*1.0e3- ly/2. - wc)/fc))) + & ! (dc/(1.+exp(2.*(G%geoLatT(i,j)*1.0e3- ly/2. + wc)/fc))) ! slice at y = 40 km - by = (dc/(1.+exp(-2.*(40.0*1.0e3- ly/2. - wc)/fc))) + & - (dc/(1.+exp(2.*(40.0*1.0e3- ly/2. + wc)/fc))) + by = (dc / (1.+exp(-2.*(40.0*1.0e3- ly/2. - wc)/fc))) + & + (dc / (1.+exp(2.*(40.0*1.0e3- ly/2. + wc)/fc))) - D(i,j) = -max(bx+by,-bmax) + D(i,j) = -max(bx+by, -bmax) if (D(i,j) > max_depth) D(i,j) = max_depth if (D(i,j) < min_depth) D(i,j) = 0.5*min_depth enddo ; enddo @@ -105,11 +112,11 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth) xtil = G%geoLonT(i,j)*1.0e3/xbar - bx = b0+b2*xtil**2 + b4*xtil**4 + b6*xtil**6 - by = (dc/(1.+exp(-2.*(G%geoLatT(i,j)*1.0e3- ly/2. - wc)/fc))) + & - (dc/(1.+exp(2.*(G%geoLatT(i,j)*1.0e3- ly/2. + wc)/fc))) + bx = b0 + b2*xtil**2 + b4*xtil**4 + b6*xtil**6 + by = (dc / (1.+exp(-2.*(G%geoLatT(i,j)*1.0e3- ly/2. - wc)/fc))) + & + (dc / (1.+exp(2.*(G%geoLatT(i,j)*1.0e3- ly/2. + wc)/fc))) - D(i,j) = -max(bx+by,-bmax) + D(i,j) = -max(bx+by, -bmax) if (D(i,j) > max_depth) D(i,j) = max_depth if (D(i,j) < min_depth) D(i,j) = 0.5*min_depth enddo ; enddo From f272edc30bda516ddd86b2fff3736bbf2837636a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Nov 2018 15:37:30 -0500 Subject: [PATCH 0924/1072] +Rescale depth in Kelvin_initialize_topography Added an optional unit_scale_type argument to Kelvin_initialize_topography, and if it is present the unit conversion of the topography from m to Z occurs within this initialization routine. All answers are bitwise identical. --- src/user/Kelvin_initialization.F90 | 26 ++++++++++++++++---------- 1 file changed, 16 insertions(+), 10 deletions(-) diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 341f6e99f6..1fd9edb3ea 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -110,22 +110,28 @@ end subroutine Kelvin_OBC_end ! ----------------------------------------------------------------------------- !> This subroutine sets up the Kelvin topography and land mask -subroutine Kelvin_initialize_topography(D, G, param_file, max_depth) - type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: D !< Ocean bottom depth in m - type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum depth of model in m +subroutine Kelvin_initialize_topography(D, G, param_file, max_depth, US) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(out) :: D !< Ocean bottom depth in m or Z if US is present + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum model depth in the units of D + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + ! Local variables character(len=40) :: mdl = "Kelvin_initialize_topography" ! This subroutine's name. - real :: min_depth ! The minimum and maximum depths in m. + real :: m_to_Z ! A dimensional rescaling factor. + real :: min_depth ! The minimum and maximum depths in Z. real :: PI ! 3.1415... real :: coast_offset1, coast_offset2, coast_angle, right_angle integer :: i, j call MOM_mesg(" Kelvin_initialization.F90, Kelvin_initialize_topography: setting topography", 5) + m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0) + "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) call get_param(param_file, mdl, "ROTATED_COAST_OFFSET_1", coast_offset1, & default=100.0, do_not_log=.true.) call get_param(param_file, mdl, "ROTATED_COAST_OFFSET_2", coast_offset2, & @@ -137,17 +143,17 @@ subroutine Kelvin_initialize_topography(D, G, param_file, max_depth) right_angle = 2 * atan(1.0) do j=G%jsc,G%jec ; do i=G%isc,G%iec - D(i,j)=max_depth + D(i,j) = max_depth ! Southern side if ((G%geoLonT(i,j) - G%west_lon > coast_offset1) .AND. & (atan2(G%geoLatT(i,j) - G%south_lat + coast_offset2, & G%geoLonT(i,j) - G%west_lon - coast_offset1) < coast_angle)) & - D(i,j)=0.5*min_depth + D(i,j) = 0.5*min_depth ! Northern side if ((G%geoLonT(i,j) - G%west_lon < G%len_lon - coast_offset1) .AND. & (atan2(G%len_lat + G%south_lat + coast_offset2 - G%geoLatT(i,j), & G%len_lon + G%west_lon - coast_offset1 - G%geoLonT(i,j)) < coast_angle)) & - D(i,j)=0.5*min_depth + D(i,j) = 0.5*min_depth if (D(i,j) > max_depth) D(i,j) = max_depth if (D(i,j) < min_depth) D(i,j) = 0.5*min_depth From e543439096cb7c8bdd88e3c55710bd5363dbfca8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Nov 2018 16:50:57 -0500 Subject: [PATCH 0925/1072] +Rescale depth in Phillips_initialize_topography Added an optional unit_scale_type argument to Phillips_initialize_topography, and if it is present the unit conversion of the topography from m to Z occurs within this initialization routine. All answers are bitwise identical. --- src/user/Phillips_initialization.F90 | 54 +++++++++++++++------------- 1 file changed, 29 insertions(+), 25 deletions(-) diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index e5eea1d2d2..1e513460b5 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -283,48 +283,52 @@ function sech(x) end function sech !> Initialize topography. -subroutine Phillips_initialize_topography(D, G, param_file, max_depth) - type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type +subroutine Phillips_initialize_topography(D, G, param_file, max_depth, US) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m - type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum depth of model in m + intent(out) :: D !< Ocean bottom depth in m or Z if US is present + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum model depth in the units of D + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type - real :: PI, Htop, Wtop, Ltop, offset, dist, & - x1, x2, x3, x4, y1, y2 + ! Local variables + real :: m_to_Z ! A dimensional rescaling factor. + real :: PI, Htop, Wtop, Ltop, offset, dist + real :: x1, x2, x3, x4, y1, y2 integer :: i,j,is,ie,js,je character(len=40) :: mdl = "Phillips_initialize_topography" ! This subroutine's name. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec PI = 4.0*atan(1.0) + m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call get_param(param_file, mdl, "PHILLIPS_HTOP", Htop, & - "The maximum height of the topography.", units="m", & + call get_param(param_file, mdl, "PHILLIPS_HTOP", Htop, & + "The maximum height of the topography.", units="m", scale=m_to_Z, & fail_if_missing=.true.) ! Htop=0.375*max_depth ! max height of topog. above max_depth - Wtop=0.5*G%len_lat ! meridional width of drake and mount - Ltop=0.25*G%len_lon ! zonal width of topographic features - offset=0.1*G%len_lat ! meridional offset from center - dist=0.333*G%len_lon ! distance between drake and mount + Wtop = 0.5*G%len_lat ! meridional width of drake and mount + Ltop = 0.25*G%len_lon ! zonal width of topographic features + offset = 0.1*G%len_lat ! meridional offset from center + dist = 0.333*G%len_lon ! distance between drake and mount ! should be longer than Ltop/2 y1=G%south_lat+0.5*G%len_lat+offset-0.5*Wtop; y2=y1+Wtop x1=G%west_lon+0.1*G%len_lon; x2=x1+Ltop; x3=x1+dist; x4=x3+3.0/2.0*Ltop do i=is,ie ; do j=js,je - D(i,j)=0.0 - if (G%geoLonT(i,j)>x1 .and. G%geoLonT(i,j)y1 .and. G%geoLatT(i,j)x3 .and. G%geoLonT(i,j)y1 .and. G%geoLatT(i,j)x1 .and. G%geoLonT(i,j)y1 .and. G%geoLatT(i,j)x3 .and. G%geoLonT(i,j)y1 .and. G%geoLatT(i,j) Date: Fri, 16 Nov 2018 16:51:46 -0500 Subject: [PATCH 0926/1072] +Rescale depth in benchmark_initialize_topography Added an optional unit_scale_type argument to benchmark_initialize_topography, and if it is present the unit conversion of the topography from m to Z occurs within this initialization routine. All answers are bitwise identical. --- src/user/benchmark_initialization.F90 | 25 +++++++++++++++---------- 1 file changed, 15 insertions(+), 10 deletions(-) diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index d50fe3fa05..0a5589a0b6 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -26,17 +26,20 @@ module benchmark_initialization contains !> This subroutine sets up the benchmark test case topography. -subroutine benchmark_initialize_topography(D, G, param_file, max_depth) - type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type +subroutine benchmark_initialize_topography(D, G, param_file, max_depth, US) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m - type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum depth of model in m + intent(out) :: D !< Ocean bottom depth in m or Z if US is present + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum model depth in the units of D + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + ! Local variables - real :: min_depth ! The minimum and maximum depths in m. + real :: min_depth ! The minimum and maximum depths in Z. real :: PI ! 3.1415926... calculated as 4*atan(1) real :: D0 ! A constant to make the maximum ! ! basin depth MAXIMUM_DEPTH. ! + real :: m_to_Z ! A dimensional rescaling factor. real :: x, y ! This include declares and sets the variable "version". # include "version_variable.h" @@ -47,17 +50,19 @@ subroutine benchmark_initialize_topography(D, G, param_file, max_depth) call MOM_mesg(" benchmark_initialization.F90, benchmark_initialize_topography: setting topography", 5) + m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z + call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0) + "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) PI = 4.0*atan(1.0) D0 = max_depth / 0.5 ! Calculate the depth of the bottom. - do i=is,ie ; do j=js,je - x=(G%geoLonT(i,j)-G%west_lon)/G%len_lon - y=(G%geoLatT(i,j)-G%south_lat)/G%len_lat + do j=js,je ; do i=is,ie + x = (G%geoLonT(i,j)-G%west_lon) / G%len_lon + y = (G%geoLatT(i,j)-G%south_lat) / G%len_lat ! This sets topography that has a reentrant channel to the south. D(i,j) = -D0 * ( y*(1.0 + 0.6*cos(4.0*PI*x)) & + 0.75*exp(-6.0*y) & From 8560c62f39d323dd1007788d9fcf68e38e2bb8b0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Nov 2018 16:52:29 -0500 Subject: [PATCH 0927/1072] +Rescale depth in shelfwave_initialize_topography Added an optional unit_scale_type argument to shelfwave_initialize_topography, and if it is present the unit conversion of the topography from m to Z occurs within this initialization routine. All answers are bitwise identical. --- src/user/shelfwave_initialization.F90 | 33 +++++++++++++++------------ 1 file changed, 18 insertions(+), 15 deletions(-) diff --git a/src/user/shelfwave_initialization.F90 b/src/user/shelfwave_initialization.F90 index 9207830032..1a52519122 100644 --- a/src/user/shelfwave_initialization.F90 +++ b/src/user/shelfwave_initialization.F90 @@ -12,6 +12,7 @@ module shelfwave_initialization use MOM_open_boundary, only : OBC_segment_type, register_OBC use MOM_open_boundary, only : OBC_registry_type use MOM_time_manager, only : time_type, time_type_to_real +use MOM_unit_scaling, only : unit_scale_type implicit none ; private @@ -93,31 +94,33 @@ subroutine shelfwave_OBC_end(CS) end subroutine shelfwave_OBC_end !> Initialization of topography. -subroutine shelfwave_initialize_topography ( D, G, param_file, max_depth ) - ! Arguments - type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type +subroutine shelfwave_initialize_topography( D, G, param_file, max_depth, US ) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m - type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum depth of model in m + intent(out) :: D !< Ocean bottom depth in m or Z if US is present + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum model depth in the units of D + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables + real :: m_to_Z ! A dimensional rescaling factor. integer :: i, j real :: y, rLy, Ly, H0 + m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z + call get_param(param_file, mdl,"SHELFWAVE_Y_LENGTH_SCALE",Ly, & default=50., do_not_log=.true.) - call get_param(param_file, mdl,"MINIMUM_DEPTH",H0, & - default=10., do_not_log=.true.) + call get_param(param_file, mdl,"MINIMUM_DEPTH", H0, & + default=10., units="m", scale=m_to_Z, do_not_log=.true.) rLy = 0. ; if (Ly>0.) rLy = 1. / Ly - do i=G%isc,G%iec - do j=G%jsc,G%jec - ! Compute normalized zonal coordinates (x,y=0 at center of domain) - y = ( G%geoLatT(i,j) - G%south_lat ) - D(i,j) = H0 * exp(2 * rLy * y) - enddo - enddo + + do j=G%jsc,G%jec ; do i=G%isc,G%iec + ! Compute normalized zonal coordinates (x,y=0 at center of domain) + y = ( G%geoLatT(i,j) - G%south_lat ) + D(i,j) = H0 * exp(2 * rLy * y) + enddo ; enddo end subroutine shelfwave_initialize_topography From c9517fedbb27e085c6742c253625247802260a2f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Nov 2018 16:55:48 -0500 Subject: [PATCH 0928/1072] +Rescale depth in USER_initialize_topography Added an optional unit_scale_type argument to USER_initialize_topography, and if it is present the unit conversion of the topography from m to Z occurs within this initialization routine. All answers are bitwise identical. --- src/user/user_initialization.F90 | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 0a4ce7ccaa..c94613117a 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -13,6 +13,7 @@ module user_initialization use MOM_open_boundary, only : OBC_DIRECTION_S use MOM_sponge, only : set_up_sponge_field, initialize_sponge, sponge_CS use MOM_tracer_registry, only : tracer_registry_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type @@ -54,12 +55,13 @@ subroutine USER_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) end subroutine USER_set_coord !> Initialize topography. -subroutine USER_initialize_topography(D, G, param_file, max_depth) - type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type +subroutine USER_initialize_topography(D, G, param_file, max_depth, US) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m - type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum depth of model in m + intent(out) :: D !< Ocean bottom depth in m or Z if US is present + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum model depth in the units of D + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type call MOM_error(FATAL, & "USER_initialization.F90, USER_initialize_topography: " // & From 74014e7b77fe77decf43ca56a05a0202c89ca5f6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Nov 2018 16:56:37 -0500 Subject: [PATCH 0929/1072] Better comments in initialize_topography routines Clarified comments in several initialize_topography routines to explain that they will set the topography using the same units as the input value of mad_depth. All answers are bitwise identical. --- src/user/DOME2d_initialization.F90 | 16 ++++++------- src/user/Neverland_initialization.F90 | 23 +++++++++--------- src/user/dense_water_initialization.F90 | 16 ++++++++----- src/user/dumbbell_initialization.F90 | 32 ++++++++++++------------- src/user/seamount_initialization.F90 | 26 ++++++++++---------- src/user/sloshing_initialization.F90 | 10 ++++---- 6 files changed, 61 insertions(+), 62 deletions(-) diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index bd4f652dec..f20e4466bd 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -33,19 +33,19 @@ module DOME2d_initialization contains !> Initialize topography with a shelf and slope in a 2D domain -subroutine DOME2d_initialize_topography ( D, G, param_file, max_depth ) - ! Arguments - type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type +subroutine DOME2d_initialize_topography( D, G, param_file, max_depth ) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m - type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum depth of model in m + intent(out) :: D !< Ocean bottom depth in the units of depth_max + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum ocean depth in arbitrary units + ! Local variables integer :: i, j real :: x, bay_depth, l1, l2 real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index 5f5b081f1c..67845a522f 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -26,18 +26,19 @@ module Neverland_initialization !> This subroutine sets up the Neverland test case topography. subroutine Neverland_initialize_topography(D, G, param_file, max_depth) - type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m - type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum depth of model in m + intent(out) :: D !< Ocean bottom depth in the units of depth_max + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum ocean depth in arbitrary units + ! Local variables real :: PI ! 3.1415926... calculated as 4*atan(1) real :: D0 ! A constant to make the maximum ! ! basin depth MAXIMUM_DEPTH. ! real :: x, y -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "Neverland_initialize_topography" ! This subroutine's name. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed real :: nl_roughness_amp, nl_top_amp @@ -55,10 +56,9 @@ subroutine Neverland_initialize_topography(D, G, param_file, max_depth) PI = 4.0*atan(1.0) ! Calculate the depth of the bottom. - do i=is,ie - do j=js,je - x=(G%geoLonT(i,j)-G%west_lon)/G%len_lon - y=(G%geoLatT(i,j)-G%south_lat)/G%len_lat + do j=js,je ; do i=is,ie + x = (G%geoLonT(i,j)-G%west_lon) / G%len_lon + y =( G%geoLatT(i,j)-G%south_lat) / G%len_lat ! This sets topography that has a reentrant channel to the south. D(i,j) = 1.0 - 1.1 * spike(y-1,0.12) - 1.1 * spike(y,0.12) - & !< The great northern wall and Antarctica nl_top_amp*( & @@ -73,8 +73,7 @@ subroutine Neverland_initialize_topography(D, G, param_file, max_depth) - nl_roughness_amp * cos(20*PI*x) * cos(20*PI*y) !< roughness if (D(i,j) < 0.0) D(i,j) = 0.0 D(i,j) = D(i,j) * max_depth - enddo - enddo + enddo ; enddo end subroutine Neverland_initialize_topography ! ----------------------------------------------------------------------------- diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index f1a7bd6492..f857978c8e 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -11,6 +11,7 @@ module dense_water_initialization use MOM_file_parser, only : get_param, param_file_type use MOM_grid, only : ocean_grid_type use MOM_sponge, only : sponge_CS +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -32,10 +33,12 @@ module dense_water_initialization !> Initialize the topography field for the dense water experiment subroutine dense_water_initialize_topography(D, G, param_file, max_depth) - type(dyn_horgrid_type), intent(in) :: G !< Grid control structure - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: D !< Output topography field - type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum depth of the model + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(out) :: D !< Ocean bottom depth in the units of depth_max + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum ocean depth in arbitrary units + ! Local variables real, dimension(5) :: domain_params ! nondimensional widths of all domain sections real :: sill_frac, shelf_frac @@ -63,8 +66,8 @@ subroutine dense_water_initialize_topography(D, G, param_file, max_depth) domain_params(i) = domain_params(i-1) + domain_params(i) enddo - do i = G%isc,G%iec - do j = G%jsc,G%jec + do j = G%jsc,G%jec + do i = G%isc,G%iec ! compute normalised zonal coordinate x = (G%geoLonT(i,j) - G%west_lon) / G%len_lon @@ -88,6 +91,7 @@ subroutine dense_water_initialize_topography(D, G, param_file, max_depth) endif enddo enddo + end subroutine dense_water_initialize_topography !> Initialize the temperature and salinity for the dense water experiment diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 5a5a845449..02222c9865 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -34,13 +34,13 @@ module dumbbell_initialization contains !> Initialization of topography. -subroutine dumbbell_initialize_topography ( D, G, param_file, max_depth ) - ! Arguments - type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type +subroutine dumbbell_initialize_topography( D, G, param_file, max_depth ) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m - type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum depth of model in m + intent(out) :: D !< Ocean bottom depth in the units of depth_max + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum ocean depth in arbitrary units + ! Local variables integer :: i, j real :: x, y, delta, dblen, dbfrac @@ -56,17 +56,15 @@ subroutine dumbbell_initialize_topography ( D, G, param_file, max_depth ) dblen=dblen*1.e3 endif - do i=G%isc,G%iec - do j=G%jsc,G%jec - ! Compute normalized zonal coordinates (x,y=0 at center of domain) - x = ( G%geoLonT(i,j) ) / dblen - y = ( G%geoLatT(i,j) ) / G%len_lat - D(i,j) = G%max_depth - if ((x>=-0.25 .and. x<=0.25) .and. (y <= -0.5*dbfrac .or. y >= 0.5*dbfrac)) then - D(i,j) = 0.0 - endif - enddo - enddo + do j=G%jsc,G%jec ; do i=G%isc,G%iec + ! Compute normalized zonal coordinates (x,y=0 at center of domain) + x = ( G%geoLonT(i,j) ) / dblen + y = ( G%geoLatT(i,j) ) / G%len_lat + D(i,j) = G%max_depth + if ((x>=-0.25 .and. x<=0.25) .and. (y <= -0.5*dbfrac .or. y >= 0.5*dbfrac)) then + D(i,j) = 0.0 + endif + enddo ; enddo end subroutine dumbbell_initialize_topography diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 3a5d7d186f..8f1ed97b06 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -33,13 +33,12 @@ module seamount_initialization contains !> Initialization of topography. -subroutine seamount_initialize_topography ( D, G, param_file, max_depth ) - ! Arguments - type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type +subroutine seamount_initialize_topography( D, G, param_file, max_depth ) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m - type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum depth of model in m + intent(out) :: D !< Ocean bottom depth in the units of depth_max + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum ocean depth in arbitrary units ! Local variables integer :: i, j @@ -61,14 +60,13 @@ subroutine seamount_initialize_topography ( D, G, param_file, max_depth ) Ly = Ly / G%len_lat rLx = 0. ; if (Lx>0.) rLx = 1. / Lx rLy = 0. ; if (Ly>0.) rLy = 1. / Ly - do i=G%isc,G%iec - do j=G%jsc,G%jec - ! Compute normalized zonal coordinates (x,y=0 at center of domain) - x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon - 0.5 - y = ( G%geoLatT(i,j) - G%south_lat ) / G%len_lat - 0.5 - D(i,j) = G%max_depth * ( 1.0 - delta * exp(-(rLx*x)**2 -(rLy*y)**2) ) - enddo - enddo + + do j=G%jsc,G%jec ; do i=G%isc,G%iec + ! Compute normalized zonal coordinates (x,y=0 at center of domain) + x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon - 0.5 + y = ( G%geoLatT(i,j) - G%south_lat ) / G%len_lat - 0.5 + D(i,j) = G%max_depth * ( 1.0 - delta * exp(-(rLx*x)**2 -(rLy*y)**2) ) + enddo ; enddo end subroutine seamount_initialize_topography diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index 5c4c5ec5b6..f192af804d 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -28,12 +28,12 @@ module sloshing_initialization contains !> Initialization of topography. -subroutine sloshing_initialize_topography ( D, G, param_file, max_depth ) - type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type +subroutine sloshing_initialize_topography( D, G, param_file, max_depth ) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m - type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum depth of model in m + intent(out) :: D !< Ocean bottom depth in the units of depth_max + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum ocean depth in arbitrary units ! Local variables integer :: i, j From bc808be8e3cd8a50a4fbef4f9aabbb38366b71f9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Nov 2018 16:57:55 -0500 Subject: [PATCH 0930/1072] +Rescale topography in MOM_shared_initialization Added an optional unit_scale_type argument to initialize_topography_from_file, apply_topography_edits_from_file, initialize_topography_named and limit_topography, which if present causes the topography to be scaled to units of Z when it is first set up. In addition, optional unit_scale_type arguments were added to all of the routines in MOM_shared_initialization and MOM_grid_initialize where they will eventually be needed so that the various components using this code (i.e., MOM6 and SIS2) can have a graceful transition to the new interfaces. All answers are bitwise identical. --- src/initialization/MOM_grid_initialize.F90 | 13 +- .../MOM_shared_initialization.F90 | 173 +++++++++--------- 2 files changed, 93 insertions(+), 93 deletions(-) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 7019564586..a0a354858f 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -54,9 +54,10 @@ module MOM_grid_initialize !> set_grid_metrics is used to set the primary values in the model's horizontal !! grid. The bathymetry, land-sea mask and any restricted channel widths are !! not known yet, so these are set later. -subroutine set_grid_metrics(G, param_file) - type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type - type(param_file_type), intent(in) :: param_file !< Parameter file structure +subroutine set_grid_metrics(G, param_file, US) + type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type + type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables ! This include declares and sets the variable "version". #include "version_variable.h" @@ -1216,9 +1217,9 @@ end function Adcroft_reciprocal !! any land or boundary point. For points in the interior, mask2dCu, !! mask2dCv, and mask2dBu are all 1.0. subroutine initialize_masks(G, PF, US) - type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type - type(param_file_type), intent(in) :: PF !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type + type(param_file_type), intent(in) :: PF !< Parameter file structure + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables real :: m_to_Z_scale ! A unit conversion factor from m to Z. real :: Dmin ! The depth for masking in the same units as G%bathyT (Z). diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 9ca352c3ed..113c3b3a85 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -49,10 +49,11 @@ end subroutine MOM_shared_init_init ! ----------------------------------------------------------------------------- !> MOM_initialize_rotation makes the appropriate call to set up the Coriolis parameter. -subroutine MOM_initialize_rotation(f, G, PF) +subroutine MOM_initialize_rotation(f, G, PF, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent(out) :: f !< The Coriolis parameter in s-1 type(param_file_type), intent(in) :: PF !< Parameter file structure + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! This subroutine makes the appropriate call to set up the Coriolis parameter. ! This is a separate subroutine so that it can be made public and shared with @@ -81,12 +82,13 @@ subroutine MOM_initialize_rotation(f, G, PF) end subroutine MOM_initialize_rotation !> Calculates the components of grad f (Coriolis parameter) -subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G) +subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(out) :: dF_dx !< x-component of grad f real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(out) :: dF_dy !< y-component of grad f + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i,j real :: f1, f2 @@ -109,37 +111,39 @@ subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G) call pass_vector(dF_dx, dF_dy, G%Domain, stagger=AGRID) end subroutine MOM_calculate_grad_Coriolis -!> Return the global maximum ocean bottom depth in m. -function diagnoseMaximumDepth(D,G) +!> Return the global maximum ocean bottom depth in the same units as the input depth. +function diagnoseMaximumDepth(D, G) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: D !< Ocean bottom depth in m - real :: diagnoseMaximumDepth !< The global maximum ocean bottom depth in m + intent(in) :: D !< Ocean bottom depth in m or Z + real :: diagnoseMaximumDepth !< The global maximum ocean bottom depth in m or Z ! Local variables integer :: i,j - diagnoseMaximumDepth=D(G%isc,G%jsc) - do j=G%jsc, G%jec - do i=G%isc, G%iec - diagnoseMaximumDepth=max(diagnoseMaximumDepth,D(i,j)) - enddo - enddo + diagnoseMaximumDepth = D(G%isc,G%jsc) + do j=G%jsc, G%jec ; do i=G%isc, G%iec + diagnoseMaximumDepth = max(diagnoseMaximumDepth,D(i,j)) + enddo ; enddo call max_across_PEs(diagnoseMaximumDepth) end function diagnoseMaximumDepth !> Read gridded depths from file -subroutine initialize_topography_from_file(D, G, param_file) +subroutine initialize_topography_from_file(D, G, param_file, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m + intent(out) :: D !< Ocean bottom depth in m or Z if US is present type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables + real :: m_to_Z ! A dimensional rescaling factor. character(len=200) :: filename, topo_file, inputdir ! Strings for file/path character(len=200) :: topo_varname ! Variable name in file character(len=40) :: mdl = "initialize_topography_from_file" ! This subroutine's name. call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") + m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call get_param(param_file, mdl, "TOPO_FILE", topo_file, & @@ -155,28 +159,29 @@ subroutine initialize_topography_from_file(D, G, param_file) if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_topography_from_file: Unable to open "//trim(filename)) - D(:,:) = -9.E30 ! Initializing to a very large negative depth (tall mountains) - ! everywhere before reading from a file should do nothing. - ! However, in the instance of masked-out PEs, halo regions - ! are not updated when a processor does not exist. We need to - ! ensure the depth in masked-out PEs appears to be that of land - ! so this line does that in the halo regions. For non-masked PEs - ! the halo region is filled properly with a later pass_var(). - call MOM_read_data(filename, trim(topo_varname), D, G%Domain) + D(:,:) = -9.e30*m_to_Z ! Initializing to a very large negative depth (tall mountains) everywhere + ! before reading from a file should do nothing. However, in the instance of + ! masked-out PEs, halo regions are not updated when a processor does not + ! exist. We need to ensure the depth in masked-out PEs appears to be that + ! of land so this line does that in the halo regions. For non-masked PEs + ! the halo region is filled properly with a later pass_var(). + call MOM_read_data(filename, trim(topo_varname), D, G%Domain, scale=m_to_Z) - call apply_topography_edits_from_file(D, G, param_file) + call apply_topography_edits_from_file(D, G, param_file, US) call callTree_leave(trim(mdl)//'()') end subroutine initialize_topography_from_file !> Applies a list of topography overrides read from a netcdf file -subroutine apply_topography_edits_from_file(D, G, param_file) +subroutine apply_topography_edits_from_file(D, G, param_file, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(inout) :: D !< Ocean bottom depth in m + intent(inout) :: D !< Ocean bottom depth in m or Z if US is present type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables + real :: m_to_Z ! A dimensional rescaling factor. character(len=200) :: topo_edits_file, inputdir ! Strings for file/path character(len=40) :: mdl = "apply_topography_edits_from_file" ! This subroutine's name. integer :: n_edits, n, ashape(5), i, j, ncid, id, ncstatus, iid, jid, zid @@ -185,6 +190,8 @@ subroutine apply_topography_edits_from_file(D, G, param_file) call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") + m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call get_param(param_file, mdl, "TOPO_EDITS_FILE", topo_edits_file, & @@ -267,8 +274,8 @@ subroutine apply_topography_edits_from_file(D, G, param_file) if (i>=G%isc .and. i<=G%iec .and. j>=G%jsc .and. j<=G%jec) then if (new_depth(n)/=0.) then write(*,'(a,3i5,f8.2,a,f8.2,2i4)') & - 'Ocean topography edit: ',n,ig(n),jg(n),D(i,j),'->',abs(new_depth(n)),i,j - D(i,j) = abs(new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) + 'Ocean topography edit: ',n,ig(n),jg(n),D(i,j)/m_to_Z,'->',abs(new_depth(n)),i,j + D(i,j) = abs(m_to_Z*new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) else call MOM_error(FATAL, ' apply_topography_edits_from_file: '//& "A zero depth edit would change the land mask and is not allowed in"//trim(topo_edits_file)) @@ -282,30 +289,25 @@ subroutine apply_topography_edits_from_file(D, G, param_file) end subroutine apply_topography_edits_from_file !> initialize the bathymetry based on one of several named idealized configurations -subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth) +subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m + intent(out) :: D !< Ocean bottom depth in m or Z if US is present type(param_file_type), intent(in) :: param_file !< Parameter file structure character(len=*), intent(in) :: topog_config !< The name of an idealized !! topographic configuration - real, intent(in) :: max_depth !< Maximum depth of model in m + real, intent(in) :: max_depth !< Maximum depth of model in the units of D + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type -! Arguments: D - the bottom depth in m. Intent out. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) topog_config - The name of an idealized topographic configuration. -! (in) max_depth - The maximum depth in m. + ! This subroutine places the bottom depth in m into D(:,:), shaped according to the named config. -! This subroutine places the bottom depth in m into D(:,:), shaped in a spoon - real :: min_depth ! The minimum depth in m. + ! Local variables + real :: m_to_Z ! A dimensional rescaling factor. + real :: min_depth ! The minimum depth in Z. real :: PI ! 3.1415926... calculated as 4*atan(1) - real :: D0 ! A constant to make the maximum ! - ! basin depth MAXIMUM_DEPTH. ! - real :: expdecay ! A decay scale of associated with ! - ! the sloping boundaries, in m. ! - real :: Dedge ! The depth in m at the basin edge. ! + real :: D0 ! A constant to make the maximum basin depth MAXIMUM_DEPTH. + real :: expdecay ! A decay scale of associated with the sloping boundaries, in m. + real :: Dedge ! The depth in Z at the basin edge ! real :: south_lat, west_lon, len_lon, len_lat, Rad_earth integer :: i, j, is, ie, js, je, isd, ied, jsd, jed character(len=40) :: mdl = "initialize_topography_named" ! This subroutine's name. @@ -316,15 +318,17 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth call MOM_mesg(" MOM_shared_initialization.F90, initialize_topography_named: "//& "TOPO_CONFIG = "//trim(topog_config), 5) + m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0) + "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) if (max_depth<=0.) call MOM_error(FATAL,"initialize_topography_named: "// & "MAXIMUM_DEPTH has a non-sensical value! Was it set?") if (trim(topog_config) /= "flat") then call get_param(param_file, mdl, "EDGE_DEPTH", Dedge, & "The depth at the edge of one of the named topographies.", & - units="m", default=100.0) + units="m", default=100.0, scale=m_to_Z) ! call get_param(param_file, mdl, "SOUTHLAT", south_lat, & ! "The southern latitude of the domain.", units="degrees", & ! fail_if_missing=.true.) @@ -398,37 +402,36 @@ end subroutine initialize_topography_named ! ----------------------------------------------------------------------------- !> limit_topography ensures that min_depth < D(x,y) < max_depth -subroutine limit_topography(D, G, param_file, max_depth) +subroutine limit_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(inout) :: D !< Ocean bottom depth in m + intent(inout) :: D !< Ocean bottom depth in m or Z if US is present type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum depth of model in m -! Arguments: D - the bottom depth in m. Intent in/out. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) max_depth - The maximum depth in m. - -! This subroutine ensures that min_depth < D(x,y) < max_depth + real, intent(in) :: max_depth !< Maximum depth of model in the units of D + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + + ! Local variables + real :: m_to_Z ! A dimensional rescaling factor. integer :: i, j character(len=40) :: mdl = "limit_topography" ! This subroutine's name. real :: min_depth, mask_depth call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") + m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & "If MASKING_DEPTH is unspecified, then anything shallower than\n"//& "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out.\n"//& "If MASKING_DEPTH is specified, then all depths shallower than\n"//& "MINIMUM_DEPTH but deeper than MASKING_DEPTH are rounded to MINIMUM_DEPTH.", & - units="m", default=0.0) + units="m", default=0.0, scale=m_to_Z) call get_param(param_file, mdl, "MASKING_DEPTH", mask_depth, & - "The depth below which to mask the ocean as land.", units="m", & - default=-9999.0, do_not_log=.true.) + "The depth below which to mask the ocean as land.", & + units="m", default=-9999.0, scale=m_to_Z, do_not_log=.true.) ! Make sure that min_depth < D(x,y) < max_depth - if (mask_depth<-9990.) then + if (mask_depth < -9990.*m_to_Z) then do j=G%jsd,G%jed ; do i=G%isd,G%ied D(i,j) = min( max( D(i,j), 0.5*min_depth ), max_depth ) enddo ; enddo @@ -448,11 +451,12 @@ end subroutine limit_topography ! ----------------------------------------------------------------------------- !> This subroutine sets up the Coriolis parameter for a sphere -subroutine set_rotation_planetary(f, G, param_file) +subroutine set_rotation_planetary(f, G, param_file, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & intent(out) :: f !< Coriolis parameter (vertical component) in s^-1 type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! This subroutine sets up the Coriolis parameter for a sphere character(len=30) :: mdl = "set_rotation_planetary" ! This subroutine's name. @@ -476,11 +480,12 @@ end subroutine set_rotation_planetary ! ----------------------------------------------------------------------------- !> This subroutine sets up the Coriolis parameter for a beta-plane or f-plane -subroutine set_rotation_beta_plane(f, G, param_file) +subroutine set_rotation_beta_plane(f, G, param_file, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & intent(out) :: f !< Coriolis parameter (vertical component) in s^-1 type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! This subroutine sets up the Coriolis parameter for a beta-plane integer :: I, J @@ -594,18 +599,14 @@ end function modulo_around_point ! ----------------------------------------------------------------------------- !> This subroutine sets the open face lengths at selected points to restrict !! passages to their observed widths based on a named set of sizes. -subroutine reset_face_lengths_named(G, param_file, name) +subroutine reset_face_lengths_named(G, param_file, name, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters character(len=*), intent(in) :: name !< The name for the set of face lengths. Only "global_1deg" !! is currently implemented. -! This subroutine sets the open face lengths at selected points to restrict -! passages to their observed widths. + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type -! Arguments: G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) name - The name for the set of face lengths. + ! Local variables character(len=256) :: mesg ! Message for error messages. real :: dx_2 = -1.0, dy_2 = -1.0 real :: pi_180 @@ -722,15 +723,12 @@ end subroutine reset_face_lengths_named ! ----------------------------------------------------------------------------- !> This subroutine sets the open face lengths at selected points to restrict !! passages to their observed widths from a arrays read from a file. -subroutine reset_face_lengths_file(G, param_file) +subroutine reset_face_lengths_file(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters -! This subroutine sets the open face lengths at selected points to restrict -! passages to their observed widths. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type -! Arguments: G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. + ! Local variables character(len=40) :: mdl = "reset_face_lengths_file" ! This subroutine's name. character(len=256) :: mesg ! Message for error messages. character(len=200) :: filename, chan_file, inputdir ! Strings for file/path @@ -791,15 +789,12 @@ end subroutine reset_face_lengths_file ! ----------------------------------------------------------------------------- !> This subroutine sets the open face lengths at selected points to restrict !! passages to their observed widths from a list read from a file. -subroutine reset_face_lengths_list(G, param_file) +subroutine reset_face_lengths_list(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters -! This subroutine sets the open face lengths at selected points to restrict -! passages to their observed widths. + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type -! Arguments: G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. + ! Local variables character(len=120), pointer, dimension(:) :: lines => NULL() character(len=120) :: line character(len=200) :: filename, chan_file, inputdir, mesg ! Strings for file/path @@ -1121,8 +1116,8 @@ end subroutine set_velocity_depth_min !! later use in reporting diagnostics subroutine compute_global_grid_integrals(G) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid - ! Subroutine to pre-compute global integrals of grid quantities for - ! later use in reporting diagnostics + + ! Local variables real, dimension(G%isc:G%iec, G%jsc:G%jec) :: tmpForSumming integer :: i,j @@ -1282,10 +1277,14 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) call write_field(unit, fields(19), G%Domain%mpp_domain, G%mask2dT) if (G%bathymetry_at_vel) then - call write_field(unit, fields(20), G%Domain%mpp_domain, G%Dblock_u) - call write_field(unit, fields(21), G%Domain%mpp_domain, G%Dopen_u) - call write_field(unit, fields(22), G%Domain%mpp_domain, G%Dblock_v) - call write_field(unit, fields(23), G%Domain%mpp_domain, G%Dopen_v) + do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = Z_to_m_scale*G%Dblock_u(I,j) ; enddo ; enddo + call write_field(unit, fields(20), G%Domain%mpp_domain, out_u) + do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = Z_to_m_scale*G%Dopen_u(I,j) ; enddo ; enddo + call write_field(unit, fields(21), G%Domain%mpp_domain, out_u) + do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = Z_to_m_scale*G%Dblock_v(i,J) ; enddo ; enddo + call write_field(unit, fields(22), G%Domain%mpp_domain, out_v) + do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = Z_to_m_scale*G%Dopen_v(i,J) ; enddo ; enddo + call write_field(unit, fields(23), G%Domain%mpp_domain, out_v) endif call close_file(unit) From 604a716ca95ee63975fd0f221399ad0159b00856 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Nov 2018 16:58:39 -0500 Subject: [PATCH 0931/1072] Rescale topography during initialization Use new use_scale_type arguments in the call to MOM_initialize_topography and eliminated the call to rescale_dyn_horgrid_bathymetry in MOM_initialize_fixed, so the rescaling of the topography to units of Z happens when it is being set up via the various initialize_topography routines. All answers in the GFDL MOM6-examples test cases are bitwise identical, including rescaling Z over a large range. --- .../MOM_fixed_initialization.F90 | 45 ++++++++++--------- 1 file changed, 25 insertions(+), 20 deletions(-) diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index c7ebb6a251..63774b98f8 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -83,8 +83,8 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) ! Set up the bottom depth, G%bathyT either analytically or from file ! This also sets G%max_depth based on the input parameter MAXIMUM_DEPTH, ! or, if absent, is diagnosed as G%max_depth = max( G%D(:,:) ) - call MOM_initialize_topography(G%bathyT, G%max_depth, G, PF) - call rescale_dyn_horgrid_bathymetry(G, US%Z_to_m) + call MOM_initialize_topography(G%bathyT, G%max_depth, G, PF, US) +! call rescale_dyn_horgrid_bathymetry(G, US%Z_to_m) ! To initialize masks, the bathymetry in halo regions must be filled in call pass_var(G%bathyT, G%Domain) @@ -170,19 +170,24 @@ end subroutine MOM_initialize_fixed !> MOM_initialize_topography makes the appropriate call to set up the bathymetry. At this !! point the topography is in units of m, but this can be changed later. -subroutine MOM_initialize_topography(D, max_depth, G, PF) +subroutine MOM_initialize_topography(D, max_depth, G, PF, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(out) :: D !< Ocean bottom depth in m type(param_file_type), intent(in) :: PF !< Parameter file structure real, intent(out) :: max_depth !< Maximum depth of model in m + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! This subroutine makes the appropriate call to set up the bottom depth. ! This is a separate subroutine so that it can be made public and shared with ! the ice-sheet code or other components. + real :: m_to_Z, Z_to_m ! Dimensional rescaling factors character(len=40) :: mdl = "MOM_initialize_topography" ! This subroutine's name. character(len=200) :: config + m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z + Z_to_m = 1.0 ; if (present(US)) Z_to_m = US%Z_to_m + call get_param(PF, mdl, "TOPO_CONFIG", config, & "This specifies how bathymetry is specified: \n"//& " \t file - read bathymetric information from the file \n"//& @@ -210,39 +215,39 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) " \t dense - Denmark Strait-like dense water formation and overflow.\n"//& " \t USER - call a user modified routine.", & fail_if_missing=.true.) - max_depth = -1.e9; call read_param(PF, "MAXIMUM_DEPTH", max_depth) + max_depth = -1.e9*m_to_Z ; call read_param(PF, "MAXIMUM_DEPTH", max_depth, scale=m_to_Z) select case ( trim(config) ) - case ("file"); call initialize_topography_from_file(D, G, PF) - case ("flat"); call initialize_topography_named(D, G, PF, config, max_depth) - case ("spoon"); call initialize_topography_named(D, G, PF, config, max_depth) - case ("bowl"); call initialize_topography_named(D, G, PF, config, max_depth) - case ("halfpipe"); call initialize_topography_named(D, G, PF, config, max_depth) - case ("DOME"); call DOME_initialize_topography(D, G, PF, max_depth) - case ("ISOMIP"); call ISOMIP_initialize_topography(D, G, PF, max_depth) - case ("benchmark"); call benchmark_initialize_topography(D, G, PF, max_depth) + case ("file"); call initialize_topography_from_file(D, G, PF, US) + case ("flat"); call initialize_topography_named(D, G, PF, config, max_depth, US) + case ("spoon"); call initialize_topography_named(D, G, PF, config, max_depth, US) + case ("bowl"); call initialize_topography_named(D, G, PF, config, max_depth, US) + case ("halfpipe"); call initialize_topography_named(D, G, PF, config, max_depth, US) + case ("DOME"); call DOME_initialize_topography(D, G, PF, max_depth, US) + case ("ISOMIP"); call ISOMIP_initialize_topography(D, G, PF, max_depth, US) + case ("benchmark"); call benchmark_initialize_topography(D, G, PF, max_depth, US) case ("Neverland"); call Neverland_initialize_topography(D, G, PF, max_depth) case ("DOME2D"); call DOME2d_initialize_topography(D, G, PF, max_depth) - case ("Kelvin"); call Kelvin_initialize_topography(D, G, PF, max_depth) + case ("Kelvin"); call Kelvin_initialize_topography(D, G, PF, max_depth, US) case ("sloshing"); call sloshing_initialize_topography(D, G, PF, max_depth) case ("seamount"); call seamount_initialize_topography(D, G, PF, max_depth) - case ("dumbbell"); call dumbbell_initialize_topography(D, G, PF, max_depth) - case ("shelfwave"); call shelfwave_initialize_topography(D, G, PF, max_depth) - case ("Phillips"); call Phillips_initialize_topography(D, G, PF, max_depth) + case ("dumbbell"); call dumbbell_initialize_topography(D, G, PF, max_depth) + case ("shelfwave"); call shelfwave_initialize_topography(D, G, PF, max_depth, US) + case ("Phillips"); call Phillips_initialize_topography(D, G, PF, max_depth, US) case ("dense"); call dense_water_initialize_topography(D, G, PF, max_depth) - case ("USER"); call user_initialize_topography(D, G, PF, max_depth) + case ("USER"); call user_initialize_topography(D, G, PF, max_depth, US) case default ; call MOM_error(FATAL,"MOM_initialize_topography: "// & "Unrecognized topography setup '"//trim(config)//"'") end select if (max_depth>0.) then - call log_param(PF, mdl, "MAXIMUM_DEPTH", max_depth, & + call log_param(PF, mdl, "MAXIMUM_DEPTH", max_depth*Z_to_m, & "The maximum depth of the ocean.", units="m") else max_depth = diagnoseMaximumDepth(D,G) - call log_param(PF, mdl, "!MAXIMUM_DEPTH", max_depth, & + call log_param(PF, mdl, "!MAXIMUM_DEPTH", max_depth*Z_to_m, & "The (diagnosed) maximum depth of the ocean.", units="m") endif if (trim(config) /= "DOME") then - call limit_topography(D, G, PF, max_depth) + call limit_topography(D, G, PF, max_depth, US) endif end subroutine MOM_initialize_topography From 45a6400c6e5774a8c43871b8bed2dbe6881db11a Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 19 Nov 2018 15:33:59 +0000 Subject: [PATCH 0932/1072] Added run-time parameter for Neverland perturbation - Run-time parameter NL_THICKNESS_PERT_AMP expressed non-dimensionally - Adjusted to not alter free-surface (for low-enough amplitudes) --- src/user/Neverland_initialization.F90 | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index 4438d81e46..2668ad0166 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -123,6 +123,7 @@ subroutine Neverland_initialize_thickness(h, G, GV, US, param_file, eqn_of_state real, dimension(SZK_(G)) :: h_profile ! Vector of initial thickness profile (Z) real :: e_interface ! Current interface position (m) real :: x,y,r1,r2 ! x,y and radial coordinates for computation of initial pert. + real :: pert_amp ! Amplitude of perturbations measured in Angstrom_H character(len=40) :: mdl = "Neverland_initialize_thickness" ! This subroutine's name. integer :: i, j, k, k1, is, ie, js, je, nz, itt @@ -132,6 +133,9 @@ subroutine Neverland_initialize_thickness(h, G, GV, US, param_file, eqn_of_state call get_param(param_file, mdl, "INIT_THICKNESS_PROFILE", h_profile, & "Profile of initial layer thicknesses.", units="m", scale=US%m_to_Z, & fail_if_missing=.true.) + call get_param(param_file, mdl, "NL_THICKNESS_PERT_AMP", pert_amp, & + "Amplitude of finite scale perturbations as fraction of depth.", & + units="nondim", default=0.) ! e0 is the notional position of interfaces e0(1) = 0. ! The surface @@ -141,15 +145,18 @@ subroutine Neverland_initialize_thickness(h, G, GV, US, param_file, eqn_of_state do j=js,je ; do i=is,ie e_interface = -G%bathyT(i,j) - do k=nz,1,-1 + do k=nz,2,-1 + h(i,j,k) = GV%Z_to_H * (e0(k) - e_interface) ! Nominal thickness x=(G%geoLonT(i,j)-G%west_lon)/G%len_lon y=(G%geoLatT(i,j)-G%south_lat)/G%len_lat r1=sqrt((x-0.7)**2+(y-0.2)**2) r2=sqrt((x-0.3)**2+(y-0.25)**2) - h(i,j,k) = max( GV%Angstrom_H, GV%Z_to_H * (e0(k) - e_interface) & - + 1.0E5*GV%Angstrom_H*(spike(r1,0.15)-spike(r2,0.15)) ) - e_interface = max( e0(k), e_interface - GV%H_to_Z * h(i,j,k) ) + h(i,j,k) = h(i,j,k) + pert_amp*(e0(k) - e0(nz+1))*GV%Z_to_H*(spike(r1,0.15)-spike(r2,0.15)) ! Prescribed perturbation + h(i,j,k) = max( GV%Angstrom_H, h(i,j,k) ) ! Limit to non-negative + e_interface = e_interface + GV%H_to_Z * h(i,j,k) ! Actual position of upper interface enddo + h(i,j,1) = GV%Z_to_H * (e0(1) - e_interface) ! Nominal thickness + h(i,j,1) = max( GV%Angstrom_H, h(i,j,1) ) ! Limit to non-negative enddo ; enddo end subroutine Neverland_initialize_thickness From 5e5e315d625d8171fe240bd1248829d769dfc808 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 19 Nov 2018 15:50:03 +0000 Subject: [PATCH 0933/1072] Adds random noise option for Neverland IC - Random numbers seeded from position for reproducibility - Noise multiplies the layer thickness - Run-time non-dimensional parameter to control amplitude Todo: - Create a MOM layer around random_numbers_mod for convenience --- src/user/Neverland_initialization.F90 | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index 2668ad0166..4c4cb32572 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -15,6 +15,8 @@ module Neverland_initialization use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type +use random_numbers_mod, only: initializeRandomNumberStream, getRandomNumbers, randomNumberStream + implicit none ; private #include @@ -124,6 +126,9 @@ subroutine Neverland_initialize_thickness(h, G, GV, US, param_file, eqn_of_state real :: e_interface ! Current interface position (m) real :: x,y,r1,r2 ! x,y and radial coordinates for computation of initial pert. real :: pert_amp ! Amplitude of perturbations measured in Angstrom_H + real :: h_noise ! Amplitude of noise to scale h by + real :: noise ! Noise + type(randomNumberStream) :: rns ! Random numbers for stochastic tidal parameterization character(len=40) :: mdl = "Neverland_initialize_thickness" ! This subroutine's name. integer :: i, j, k, k1, is, ie, js, je, nz, itt @@ -136,6 +141,8 @@ subroutine Neverland_initialize_thickness(h, G, GV, US, param_file, eqn_of_state call get_param(param_file, mdl, "NL_THICKNESS_PERT_AMP", pert_amp, & "Amplitude of finite scale perturbations as fraction of depth.", & units="nondim", default=0.) + call get_param(param_file, mdl, "NL_THICKNESS_NOISE_AMP", h_noise, & + "Amplitude of noise to scale layer by.", units="nondim", default=0.) ! e0 is the notional position of interfaces e0(1) = 0. ! The surface @@ -152,6 +159,12 @@ subroutine Neverland_initialize_thickness(h, G, GV, US, param_file, eqn_of_state r1=sqrt((x-0.7)**2+(y-0.2)**2) r2=sqrt((x-0.3)**2+(y-0.25)**2) h(i,j,k) = h(i,j,k) + pert_amp*(e0(k) - e0(nz+1))*GV%Z_to_H*(spike(r1,0.15)-spike(r2,0.15)) ! Prescribed perturbation + if (h_noise /= 0.) then + rns = initializeRandomNumberStream( int( 4096*(x + (y+1.)) ) ) + call getRandomNumbers(rns, noise) ! x will be in (0,1) + noise = h_noise * 2. * ( noise - 0.5 ) ! range -h_noise to h_noise + h(i,j,k) = ( 1. + noise ) * h(i,j,k) + endif h(i,j,k) = max( GV%Angstrom_H, h(i,j,k) ) ! Limit to non-negative e_interface = e_interface + GV%H_to_Z * h(i,j,k) ! Actual position of upper interface enddo From 24cdc5cddb8992145f71da1c1da83588bbd0c278 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 19 Nov 2018 10:13:37 -0700 Subject: [PATCH 0934/1072] Add heat_content_meltw --- src/core/MOM_forcing_type.F90 | 66 +++++++++++++++++++++++++++-------- 1 file changed, 52 insertions(+), 14 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 4755358d73..aebba42eaa 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -90,7 +90,8 @@ module MOM_forcing_type ! heat associated with water crossing ocean surface real, pointer, dimension(:,:) :: & heat_content_cond => NULL(), & !< heat content associated with condensating water (W/m^2) - heat_content_lprec => NULL(), & !< heat content associated with liquid >0 precip (W/m^2) (diagnostic) + heat_content_lprec => NULL(), & !< heat content associated with liquid >0 precip (W/m^2) (diagnostic) + heat_content_meltw => NULL(), & !< heat content associated with snow/seaice melt/freeze (W/m^2) heat_content_fprec => NULL(), & !< heat content associated with frozen precip (W/m^2) heat_content_vprec => NULL(), & !< heat content associated with virtual >0 precip (W/m^2) heat_content_lrunoff => NULL(), & !< heat content associated with liquid runoff (W/m^2) @@ -262,7 +263,7 @@ module MOM_forcing_type integer :: id_heat_content_vprec = -1, id_heat_content_massout = -1 integer :: id_heat_added = -1, id_heat_content_massin = -1 integer :: id_hfrainds = -1, id_hfrunoffds = -1 - integer :: id_melth = -1 + integer :: id_melth = -1, id_heat_content_meltw = -1 ! global area integrated heat flux diagnostic handles integer :: id_total_net_heat_coupler = -1, id_total_net_heat_surface = -1 @@ -275,7 +276,7 @@ module MOM_forcing_type integer :: id_total_heat_content_cond = -1, id_total_heat_content_surfwater= -1 integer :: id_total_heat_content_vprec = -1, id_total_heat_content_massout = -1 integer :: id_total_heat_added = -1, id_total_heat_content_massin = -1 - integer :: id_total_melth = -1 + integer :: id_total_melth = -1, id_total_heat_content_meltw = -1 ! global area averaged heat flux diagnostic handles integer :: id_net_heat_coupler_ga = -1, id_net_heat_surface_ga = -1 @@ -727,6 +728,15 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, endif endif + ! Following lprec and fprec, water flux due to sea ice melt (meltw) enters at SST - GMM + if (associated(fluxes%heat_content_meltw)) then + if (fluxes%meltw(i,j) > 0.0) then + fluxes%heat_content_meltw(i,j) = fluxes%C_p*fluxes%meltw(i,j)*T(i,1) + else + fluxes%heat_content_meltw(i,j) = 0.0 + endif + endif + ! virtual precip associated with salinity restoring ! vprec > 0 means add water to ocean, assumed to be at SST ! vprec < 0 means remove water from ocean; set heat_content_vprec in MOM_diabatic_driver.F90 @@ -1035,6 +1045,8 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, haloshift) call hchksum(fluxes%heat_content_lprec, mesg//" fluxes%heat_content_lprec",G%HI,haloshift=hshift) if (associated(fluxes%heat_content_fprec)) & call hchksum(fluxes%heat_content_fprec, mesg//" fluxes%heat_content_fprec",G%HI,haloshift=hshift) + if (associated(fluxes%heat_content_meltw)) & + call hchksum(fluxes%heat_content_meltw, mesg//" fluxes%heat_content_meltw",G%HI,haloshift=hshift) if (associated(fluxes%heat_content_cond)) & call hchksum(fluxes%heat_content_cond, mesg//" fluxes%heat_content_cond",G%HI,haloshift=hshift) if (associated(fluxes%heat_content_massout)) & @@ -1131,6 +1143,7 @@ subroutine forcing_SinglePointPrint(fluxes, G, i, j, mesg) call locMsg(fluxes%heat_content_frunoff,'heat_content_frunoff') call locMsg(fluxes%heat_content_lprec,'heat_content_lprec') call locMsg(fluxes%heat_content_fprec,'heat_content_fprec') + call locMsg(fluxes%heat_content_meltw,'heat_content_meltw') call locMsg(fluxes%heat_content_vprec,'heat_content_vprec') call locMsg(fluxes%heat_content_cond,'heat_content_cond') call locMsg(fluxes%heat_content_cond,'heat_content_massout') @@ -1404,6 +1417,10 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use diag%axesT1,Time,'Heat content (relative to 0degC) of frozen prec entering ocean',& 'W m-2') + handles%id_heat_content_meltw = register_diag_field('ocean_model', 'heat_content_meltw',& + diag%axesT1,Time,'Heat content (relative to 0degC) of water flux due to sea ice melting entering ocean',& + 'W m-2') + handles%id_heat_content_vprec = register_diag_field('ocean_model', 'heat_content_vprec', & diag%axesT1,Time,'Heat content (relative to 0degC) of virtual precip entering ocean',& 'W m-2') @@ -1540,6 +1557,11 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use long_name='Area integrated heat content (relative to 0C) of frozen precip',& units='W') + handles%id_total_heat_content_meltw = register_scalar_field('ocean_model', & + 'total_heat_content_meltw', Time, diag, & + long_name='Area integrated heat content (relative to 0C) of water flux due to melting',& + units='W') + handles%id_total_heat_content_vprec = register_scalar_field('ocean_model', & 'total_heat_content_vprec', Time, diag, & long_name='Area integrated heat content (relative to 0C) of virtual precip',& @@ -1864,6 +1886,11 @@ subroutine forcing_accumulate(flux_tmp, forces, fluxes, dt, G, wt2) fluxes%heat_content_fprec(i,j) = wt1*fluxes%heat_content_fprec(i,j) + wt2*flux_tmp%heat_content_fprec(i,j) enddo ; enddo endif + if (associated(fluxes%heat_content_meltw) .and. associated(flux_tmp%heat_content_meltw)) then + do j=js,je ; do i=is,ie + fluxes%heat_content_meltw(i,j) = wt1*fluxes%heat_content_meltw(i,j) + wt2*flux_tmp%heat_content_meltw(i,j) + enddo ; enddo + endif if (associated(fluxes%heat_content_vprec) .and. associated(flux_tmp%heat_content_vprec)) then do j=js,je ; do i=is,ie fluxes%heat_content_vprec(i,j) = wt1*fluxes%heat_content_vprec(i,j) + wt2*flux_tmp%heat_content_vprec(i,j) @@ -2287,6 +2314,13 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) call post_data(handles%id_total_heat_content_fprec, total_transport, diag) endif + if ((handles%id_heat_content_meltw > 0) .and. associated(fluxes%heat_content_meltw)) & + call post_data(handles%id_heat_content_meltw, fluxes%heat_content_meltw, diag) + if ((handles%id_total_heat_content_meltw > 0) .and. associated(fluxes%heat_content_meltw)) then + total_transport = global_area_integral(fluxes%heat_content_meltw,G) + call post_data(handles%id_total_heat_content_meltw, total_transport, diag) + endif + if ((handles%id_heat_content_vprec > 0) .and. associated(fluxes%heat_content_vprec)) & call post_data(handles%id_heat_content_vprec, fluxes%heat_content_vprec, diag) if ((handles%id_total_heat_content_vprec > 0) .and. associated(fluxes%heat_content_vprec)) then @@ -2346,17 +2380,18 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%SW)) res(i,j) = res(i,j) + fluxes%SW(i,j) if (associated(fluxes%melth)) res(i,j) = res(i,j) + fluxes%melth(i,j) if (associated(sfc_state%frazil)) res(i,j) = res(i,j) + sfc_state%frazil(i,j) * I_dt - ! if (associated(sfc_state%TempXpme)) then - ! res(i,j) = res(i,j) + sfc_state%TempXpme(i,j) * fluxes%C_p * I_dt - ! else - if (associated(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) - if (associated(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) - if (associated(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) - if (associated(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) - if (associated(fluxes%heat_content_vprec)) res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j) - if (associated(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) - if (associated(fluxes%heat_content_massout)) res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j) - ! endif + !if (associated(sfc_state%TempXpme)) then + ! res(i,j) = res(i,j) + sfc_state%TempXpme(i,j) * fluxes%C_p * I_dt + !else + if (associated(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) + if (associated(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) + if (associated(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) + if (associated(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) + if (associated(fluxes%heat_content_meltw)) res(i,j) = res(i,j) + fluxes%heat_content_meltw(i,j) + if (associated(fluxes%heat_content_vprec)) res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j) + if (associated(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) + if (associated(fluxes%heat_content_massout)) res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j) + !endif if (associated(fluxes%heat_added)) res(i,j) = res(i,j) + fluxes%heat_added(i,j) enddo ; enddo call post_data(handles%id_net_heat_surface, res, diag) @@ -2380,6 +2415,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) if (associated(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) if (associated(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) + if (associated(fluxes%heat_content_meltw)) res(i,j) = res(i,j) + fluxes%heat_content_meltw(i,j) if (associated(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) if (associated(fluxes%heat_content_vprec)) res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j) if (associated(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) @@ -2640,6 +2676,7 @@ subroutine allocate_forcing_type(G, fluxes, water, heat, ustar, press, shelf, ic if (present(heat) .and. present(water)) then ; if (heat .and. water) then call myAlloc(fluxes%heat_content_cond,isd,ied,jsd,jed, .true.) + call myAlloc(fluxes%heat_content_meltw,isd,ied,jsd,jed, .true.) call myAlloc(fluxes%heat_content_lprec,isd,ied,jsd,jed, .true.) call myAlloc(fluxes%heat_content_fprec,isd,ied,jsd,jed, .true.) call myAlloc(fluxes%heat_content_vprec,isd,ied,jsd,jed, .true.) @@ -2736,6 +2773,7 @@ subroutine deallocate_forcing_type(fluxes) if (associated(fluxes%heat_added)) deallocate(fluxes%heat_added) if (associated(fluxes%heat_content_lrunoff)) deallocate(fluxes%heat_content_lrunoff) if (associated(fluxes%heat_content_frunoff)) deallocate(fluxes%heat_content_frunoff) + if (associated(fluxes%heat_content_meltw)) deallocate(fluxes%heat_content_meltw) if (associated(fluxes%heat_content_lprec)) deallocate(fluxes%heat_content_lprec) if (associated(fluxes%heat_content_fprec)) deallocate(fluxes%heat_content_fprec) if (associated(fluxes%heat_content_cond)) deallocate(fluxes%heat_content_cond) From 16d07453060870ec96b11c58728006e79268c330 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Wed, 21 Nov 2018 10:49:46 -0500 Subject: [PATCH 0935/1072] This update fixes compilation issues of ESM - Add missing new argument "US" to MOM_initialize_tracer_from_Z --- src/tracer/MOM_generic_tracer.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 12f7ecf0c4..edcc636996 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -286,7 +286,7 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, "initializing generic tracer "//trim(g_tracer_name)//& " using MOM_initialize_tracer_from_Z ") - call MOM_initialize_tracer_from_Z(h, tr_ptr, G, GV, param_file, & + call MOM_initialize_tracer_from_Z(h, tr_ptr, G, GV, US, param_file, & src_file = g_tracer%src_file, & src_var_nam = g_tracer%src_var_name, & src_var_unit_conversion = g_tracer%src_var_unit_conversion,& From 62709d79870871df05c256bb43009bc7f5f650dd Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 3 Dec 2018 16:27:03 -0500 Subject: [PATCH 0936/1072] Extended comments to clarify Z units Added to comments to clarify the unscaled units of variabiles that scale with Z, using notation like 'in Z ~> m'. Only comments are changed, and all answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 4 +- .../ice_solo_driver/user_surface_forcing.F90 | 2 +- src/ALE/MOM_ALE.F90 | 4 +- src/ALE/MOM_regridding.F90 | 2 +- src/core/MOM.F90 | 6 +- src/core/MOM_PressureForce_Montgomery.F90 | 20 +-- src/core/MOM_PressureForce_analytic_FV.F90 | 14 +- src/core/MOM_PressureForce_blocked_AFV.F90 | 16 +- src/core/MOM_barotropic.F90 | 28 ++-- src/core/MOM_forcing_type.F90 | 12 +- src/core/MOM_grid.F90 | 2 +- src/core/MOM_isopycnal_slopes.F90 | 6 +- src/core/MOM_variables.F90 | 34 ++--- src/core/MOM_verticalGrid.F90 | 4 +- src/diagnostics/MOM_diag_to_Z.F90 | 16 +- src/diagnostics/MOM_diagnostics.F90 | 4 +- src/diagnostics/MOM_sum_output.F90 | 26 ++-- src/diagnostics/MOM_wave_speed.F90 | 10 +- src/diagnostics/MOM_wave_structure.F90 | 4 +- src/equation_of_state/MOM_EOS.F90 | 50 +++--- src/equation_of_state/MOM_EOS_Wright.F90 | 14 +- src/equation_of_state/MOM_EOS_linear.F90 | 16 +- src/framework/MOM_dyn_horgrid.F90 | 10 +- src/ice_shelf/MOM_ice_shelf.F90 | 6 +- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 78 +++++----- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 4 +- src/ice_shelf/user_shelf_init.F90 | 6 +- .../MOM_coord_initialization.F90 | 16 +- src/initialization/MOM_grid_initialize.F90 | 6 +- .../MOM_shared_initialization.F90 | 4 +- .../MOM_state_initialization.F90 | 22 +-- .../MOM_tracer_initialization_from_Z.F90 | 4 +- src/initialization/midas_vertmap.F90 | 8 +- .../lateral/MOM_mixed_layer_restrat.F90 | 16 +- .../lateral/MOM_thickness_diffuse.F90 | 36 ++--- .../vertical/MOM_ALE_sponge.F90 | 6 +- .../vertical/MOM_CVMix_shear.F90 | 4 +- .../vertical/MOM_bkgnd_mixing.F90 | 5 +- .../vertical/MOM_bulk_mixed_layer.F90 | 98 +++++------- .../vertical/MOM_diabatic_aux.F90 | 17 ++- .../vertical/MOM_diabatic_driver.F90 | 8 +- .../vertical/MOM_diapyc_energy_req.F90 | 28 ++-- .../vertical/MOM_energetic_PBL.F90 | 57 +++---- .../vertical/MOM_entrain_diffusive.F90 | 4 +- .../vertical/MOM_internal_tide_input.F90 | 16 +- .../vertical/MOM_kappa_shear.F90 | 124 +++++++-------- .../vertical/MOM_set_diffusivity.F90 | 143 +++++++++--------- .../vertical/MOM_set_viscosity.F90 | 22 +-- src/parameterizations/vertical/MOM_sponge.F90 | 6 +- .../vertical/MOM_tidal_mixing.F90 | 64 ++++---- .../vertical/MOM_vert_friction.F90 | 26 ++-- src/tracer/DOME_tracer.F90 | 2 +- src/tracer/MOM_tracer_Z_init.F90 | 4 +- src/tracer/dye_example.F90 | 4 +- src/user/BFB_initialization.F90 | 8 +- src/user/DOME2d_initialization.F90 | 10 +- src/user/DOME_initialization.F90 | 12 +- src/user/ISOMIP_initialization.F90 | 18 +-- src/user/Kelvin_initialization.F90 | 2 +- src/user/MOM_wave_interface.F90 | 22 +-- src/user/Neverland_initialization.F90 | 9 +- src/user/Phillips_initialization.F90 | 14 +- src/user/SCM_CVMix_tests.F90 | 10 +- src/user/adjustment_initialization.F90 | 4 +- src/user/baroclinic_zone_initialization.F90 | 2 +- src/user/benchmark_initialization.F90 | 14 +- src/user/circle_obcs_initialization.F90 | 4 +- src/user/dumbbell_initialization.F90 | 8 +- src/user/external_gwave_initialization.F90 | 2 +- src/user/seamount_initialization.F90 | 8 +- src/user/user_change_diffusivity.F90 | 8 +- src/user/user_initialization.F90 | 6 +- 72 files changed, 648 insertions(+), 661 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index fc646a4f56..e10d0fb9ca 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -802,10 +802,10 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, real, dimension(SZI_(G),SZJB_(G)), & optional, intent(inout) :: tauy !< The meridional wind stresses on a C-grid, in Pa. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(inout) :: ustar !< The surface friction velocity, in Z s-1. + optional, intent(inout) :: ustar !< The surface friction velocity, in Z s-1 ~> m s-1. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(out) :: gustless_ustar !< The surface friction velocity without - !! any contributions from gustiness, in Z s-1. + !! any contributions from gustiness, in Z s-1 ~> m s-1. integer, optional, intent(in) :: tau_halo !< The halo size of wind stresses to set, 0 by default. ! Local variables diff --git a/config_src/ice_solo_driver/user_surface_forcing.F90 b/config_src/ice_solo_driver/user_surface_forcing.F90 index 22ea1d08fb..06ba823d9c 100644 --- a/config_src/ice_solo_driver/user_surface_forcing.F90 +++ b/config_src/ice_solo_driver/user_surface_forcing.F90 @@ -103,7 +103,7 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) ! These are the stresses in the direction of the model grid (i.e. the same ! direction as the u- and v- velocities.) They are both in Pa. ! In addition, this subroutine can be used to set the surface friction -! velocity, forces%ustar, in Z s-1. This is needed with a bulk mixed layer. +! velocity, forces%ustar, in Z s-1 ~> m s-1. This is needed with a bulk mixed layer. ! ! Arguments: state - A structure containing fields that describe the ! surface state of the ocean. diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 6f81466685..607753cfac 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -130,7 +130,7 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS) type(param_file_type), intent(in) :: param_file !< Parameter file type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: max_depth !< The maximum depth of the ocean, in Z. + real, intent(in) :: max_depth !< The maximum depth of the ocean, in Z ~> m. type(ALE_CS), pointer :: CS !< Module control structure ! Local variables @@ -1102,7 +1102,7 @@ end subroutine pressure_gradient_ppm subroutine ALE_initRegridding(GV, US, max_depth, param_file, mdl, regridCS) type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: max_depth !< The maximum depth of the ocean, in Z. + real, intent(in) :: max_depth !< The maximum depth of the ocean, in Z ~> m. type(param_file_type), intent(in) :: param_file !< parameter file character(len=*), intent(in) :: mdl !< Name of calling module type(regridding_CS), intent(out) :: regridCS !< Regridding parameters and work arrays diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index f7dcaa2648..5da749a8d0 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -172,7 +172,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m type(regridding_CS), intent(inout) :: CS !< Regridding control structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: max_depth !< The maximum depth of the ocean, in Z. + real, intent(in) :: max_depth !< The maximum depth of the ocean, in Z ~> m. type(param_file_type), intent(in) :: param_file !< Parameter file character(len=*), intent(in) :: mdl !< Name of calling module. character(len=*), intent(in) :: coord_mode !< Coordinate mode diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index b2d211796f..79eed5a912 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2707,10 +2707,10 @@ subroutine extract_surface_state(CS, sfc_state) u => NULL(), & !< u : zonal velocity component (m/s) v => NULL(), & !< v : meridional velocity component (m/s) h => NULL() !< h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) - real :: depth(SZI_(CS%G)) !< Distance from the surface in depth units (Z) + real :: depth(SZI_(CS%G)) !< Distance from the surface in depth units (Z ~> m) real :: depth_ml !< Depth over which to average to determine mixed - !! layer properties (Z) - real :: dh !< Thickness of a layer within the mixed layer (Z) + !! layer properties (Z ~> m) + real :: dh !< Thickness of a layer within the mixed layer (Z ~> m) real :: mass !< Mass per unit area of a layer (kg/m2) real :: bathy_m !< The depth of bathymetry in m (not Z), used for error checking. real :: T_freeze !< freezing temperature (oC) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 164229f894..d2c533a34c 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -98,9 +98,9 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! enable the use of a reduced gravity form of the equations, ! in m2 s-2. dp_star, & ! Layer thickness after compensation for compressibility, in Pa. - SSH, & ! The sea surface height anomaly, in depth units (Z). + SSH, & ! The sea surface height anomaly, in depth units (Z ~> m). e_tidal, & ! Bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in Z. + ! astronomical sources and self-attraction and loading, in Z ~> m. geopot_bot ! Bottom geopotential relative to time-mean sea level, ! including any tidal contributions, in units of m2 s-2. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate @@ -390,10 +390,10 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, real :: Rho_cv_BL(SZI_(G)) ! The coordinate potential density in ! the deepest variable density near-surface layer, in kg m-3. real :: h_star(SZI_(G),SZJ_(G)) ! Layer thickness after compensation - ! for compressibility, in m. + ! for compressibility, in Z ~> m. real :: e_tidal(SZI_(G),SZJ_(G)) ! Bottom geopotential anomaly due to tidal ! forces from astronomical sources and self- - ! attraction and loading, in depth units (Z). + ! attraction and loading, in depth units (Z ~> m). real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, in Pa (usually 2e7 Pa = 2000 dbar). real :: I_Rho0 ! 1/Rho0, in m3 kg-1. @@ -402,7 +402,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ! compensated density gradients, in m s-2. real :: dr ! Temporary variables. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m. + ! in roundoff and can be neglected, in Z ~> m. logical :: use_p_atm ! If true, use the atmospheric pressure. logical :: use_EOS ! If true, density is calculated from T & S using ! an equation of state. @@ -603,7 +603,7 @@ end subroutine PressureForce_Mont_Bouss subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height, in Z. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height, in Z ~> m. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, intent(in) :: Rho0 !< The "Boussinesq" ocean density, in kg m-3. real, intent(in) :: GFS_scale !< Ratio between gravity applied to top interface @@ -614,7 +614,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) !! to free surface height anomalies, in m2 H-1 s-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: rho_star !< The layer densities (maybe compressibility - !! compensated), times g/rho_0, in m2 Z-1 s-2. + !! compensated), times g/rho_0, in m2 Z-1 s-2 ~> m s-2. ! Local variables real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer thicknesses, in H-1. @@ -624,12 +624,12 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) real :: dR_dT(SZI_(G)) ! Partial derivatives of density with temperature real :: dR_dS(SZI_(G)) ! and salinity in kg m-3 K-1 and kg m-3 PSU-1. real :: rho_in_situ(SZI_(G)) !In-situ density at the top of a layer. - real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. - real :: Rho0xG ! g_Earth * Rho0 in kg s-2 m-1 Z-1. + real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1. + real :: Rho0xG ! g_Earth * Rho0 in kg s-2 m-1 Z-1 ~> kg m-2 m-2. logical :: use_EOS ! If true, density is calculated from T & S using ! an equation of state. real :: z_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in Z. + ! in roundoff and can be neglected, in Z ~> m. integer :: Isq, Ieq, Jsq, Jeq, nz, i, j, k Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index a674a43731..e49f77d054 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -130,9 +130,9 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p ! the pressure anomaly at the top of the layer, in Pa m2 s-2. real, dimension(SZI_(G),SZJ_(G)) :: & dp, & ! The (positive) change in pressure across a layer, in Pa. - SSH, & ! The sea surface height anomaly, in depth units (Z). + SSH, & ! The sea surface height anomaly, in depth units (Z ~> m). e_tidal, & ! The bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in Z. + ! astronomical sources and self-attraction and loading, in Z ~> m. dM, & ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. za ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the @@ -155,7 +155,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p real :: dp_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in Pa. - real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2. + real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2 ~> m s-2. real :: I_gEarth ! The inverse of g_Earth_z, in s2 Z m-2 real :: alpha_anom ! The in-situ specific volume, averaged over a ! layer, less alpha_ref, in m3 kg-1. @@ -456,10 +456,10 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at !! calculate PFu and PFv, in H, with any tidal !! contributions or compressibility compensation. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in depth units (Z). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in depth units (Z ~> m). real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in Z. + ! astronomical sources and self-attraction and loading, in Z ~> m. dM ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. real, dimension(SZI_(G)) :: & @@ -496,11 +496,11 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at real :: p0(SZI_(G)) ! An array of zeros to use for pressure in Pa. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in m. - real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2. + real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2 ~> m s-2. real :: I_Rho0 ! 1/Rho0. real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. real :: Rho_ref ! The reference density in kg m-3. - real :: dz_neglect ! A minimal thickness in Z, like e. + real :: dz_neglect ! A minimal thickness in Z ~> m, like e. logical :: use_p_atm ! If true, use the atmospheric pressure. logical :: use_ALE ! If true, use an ALE pressure reconstruction. logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 74e29e0f69..affaa40012 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -126,9 +126,9 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, ! the pressure anomaly at the top of the layer, in Pa m2 s-2. real, dimension(SZI_(G),SZJ_(G)) :: & dp, & ! The (positive) change in pressure across a layer, in Pa. - SSH, & ! The sea surface height anomaly, in depth units (Z). + SSH, & ! The sea surface height anomaly, in depth units (Z ~> m). e_tidal, & ! The bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in Z. + ! astronomical sources and self-attraction and loading, in Z ~> m. dM, & ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. za ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the @@ -155,8 +155,8 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, real :: dp_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in Pa. - real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2. - real :: I_gEarth ! The inverse of g_Earth_z, in s2 Z m-2 + real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2 ~> m s-2. + real :: I_gEarth ! The inverse of g_Earth_z, in s2 Z m-2 ~> s2 m-1. real :: alpha_anom ! The in-situ specific volume, averaged over a ! layer, less alpha_ref, in m3 kg-1. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -439,10 +439,10 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, !! calculate PFu and PFv, in H, with any tidal !! contributions or compressibility compensation. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in depth units (Z). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in depth units (Z ~> m). real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in depth units (Z). + ! astronomical sources and self-attraction and loading, in depth units (Z ~> m). dM ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. real, dimension(SZI_(G)) :: & @@ -480,10 +480,10 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. real :: I_Rho0 ! 1/Rho0. - real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2. + real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2 ~> m s-2. real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. real :: Rho_ref ! The reference density in kg m-3. - real :: dz_neglect ! A minimal thickness in Z, like e. + real :: dz_neglect ! A minimal thickness in Z ~> m, like e. logical :: use_p_atm ! If true, use the atmospheric pressure. logical :: use_ALE ! If true, use an ALE pressure reconstruction. logical :: use_EOS ! If true, density is calculated from T & S using an diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 7095d370b6..9a652e23a3 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -98,7 +98,7 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: frhatv !< The fraction of the total column thickness interpolated to v grid points in each layer, nondim. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: IDatu - !< Inverse of the basin depth at u grid points, in Z-1. + !< Inverse of the basin depth at u grid points, in Z-1 ~> m-1. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: lin_drag_u !< A spatially varying linear drag coefficient acting on the zonal barotropic flow, in H s-1. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt_IC @@ -110,7 +110,7 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: ubtav !< The barotropic zonal velocity averaged over the baroclinic time step, m s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: IDatv - !< Inverse of the basin depth at v grid points, in Z-1. + !< Inverse of the basin depth at v grid points, in Z-1 ~> m-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: lin_drag_v !< A spatially varying linear drag coefficient acting on the zonal barotropic flow, in H s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt_IC @@ -136,15 +136,15 @@ module MOM_barotropic !< This is a copy of G%IareaT with wide halos, but will !! still utilize the macro IareaT when referenced, m-2. real ALLOCABLE_, dimension(NIMEMBW_,NJMEMW_) :: & - D_u_Cor, & !< A simply averaged depth at u points, in Z. + D_u_Cor, & !< A simply averaged depth at u points, in Z ~> m. dy_Cu, & !< A copy of G%dy_Cu with wide halos, in m. IdxCu !< A copy of G%IdxCu with wide halos, in m-1. real ALLOCABLE_, dimension(NIMEMW_,NJMEMBW_) :: & - D_v_Cor, & !< A simply averaged depth at v points, in Z. + D_v_Cor, & !< A simply averaged depth at v points, in Z ~> m. dx_Cv, & !< A copy of G%dx_Cv with wide halos, in m. IdyCv !< A copy of G%IdyCv with wide halos, in m-1. real ALLOCABLE_, dimension(NIMEMBW_,NJMEMBW_) :: & - q_D !< f / D at PV points, in Z-1 s-1. + q_D !< f / D at PV points, in Z-1 s-1 ~> m-1 s-1. real, dimension(:,:,:), pointer :: frhatu1 => NULL() !< Predictor step values of frhatu stored for diagnostics. real, dimension(:,:,:), pointer :: frhatv1 => NULL() !< Predictor step values of frhatv stored for diagnostics. @@ -498,7 +498,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, Rayleigh_u, & ! A Rayleigh drag timescale operating at u-points, in s-1. PFu_bt_sum, & ! The summed zonal barotropic pressure gradient force, in m s-2. Coru_bt_sum, & ! The summed zonal barotropic Coriolis acceleration, in m s-2. - DCor_u, & ! A simply averaged depth at u points, in Z. + DCor_u, & ! A simply averaged depth at u points, in Z ~> m. Datu ! Basin depth at u-velocity grid points times the y-grid ! spacing, in H m. real, dimension(SZIW_(CS),SZJBW_(CS)) :: & @@ -529,7 +529,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! in m s-2. Corv_bt_sum, & ! The summed meridional barotropic Coriolis acceleration, ! in m s-2. - DCor_v, & ! A simply averaged depth at v points, in Z. + DCor_v, & ! A simply averaged depth at v points, in Z ~> m. Datv ! Basin depth at v-velocity grid points times the x-grid ! spacing, in H m. real, target, dimension(SZIW_(CS),SZJW_(CS)) :: & @@ -2272,10 +2272,10 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) !! the effective open face areas as a !! function of barotropic flow. real, optional, intent(in) :: gtot_est !< An estimate of the total gravitational - !! acceleration, in m2 Z-1 s-2. + !! acceleration, in m2 Z-1 s-2 ~> m s-2. real, optional, intent(in) :: SSH_add !< An additional contribution to SSH to !! provide a margin of error when - !! calculating the external wave speed, in Z. + !! calculating the external wave speed, in Z ~> m. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & @@ -2299,7 +2299,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) ! order 1. For stability, this may be made larger ! than physical problem would suggest. real :: add_SSH ! An additional contribution to SSH to provide a margin of error - ! when calculating the external wave speed, in Z. + ! when calculating the external wave speed, in Z ~> m. real :: min_max_dt2, Idt_max2, dtbt_max logical :: use_BT_cont type(memory_size_type) :: MS @@ -3537,7 +3537,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) !! or column mass anomaly, in H (m or kg m-2). integer, optional, intent(in) :: halo !< The halo size to use, default = 1. real, optional, intent(in) :: add_max !< A value to add to the maximum depth (used - !! to overestimate the external wave speed) in Z. + !! to overestimate the external wave speed) in Z ~> m. ! Local variables real :: H1, H2 ! Temporary total thicknesses, in m or kg m-2. @@ -3693,7 +3693,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: eta !< Free surface height or column mass anomaly, in - !! m or kg m-2. + !! Z ~> m or H ~> kg m-2. type(time_type), target, intent(in) :: Time !< The current model time. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic @@ -3717,9 +3717,9 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, character(len=40) :: mdl = "MOM_barotropic" ! This module's name. real :: Datu(SZIBS_(G),SZJ_(G)) ! Zonal open face area in H m. real :: Datv(SZI_(G),SZJBS_(G)) ! Meridional open face area in H m. - real :: gtot_estimate ! Summed GV%g_prime in m2 Z-1 s-2, to give an upper-bound estimate for pbce. + real :: gtot_estimate ! Summed GV%g_prime, in m2 Z-1 s-2 ~> m s-2, to give an upper-bound estimate for pbce. real :: SSH_extra ! An estimate of how much higher SSH might get, for use - ! in calculating the safe external wave speed, in Z. + ! in calculating the safe external wave speed, in Z ~> m. real :: dtbt_input, dtbt_tmp real :: wave_drag_scale ! A scaling factor for the barotropic linear wave drag ! piston velocities. diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 69f39c7ddb..ac72bafe32 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -45,9 +45,9 @@ module MOM_forcing_type ! surface stress components and turbulent velocity scale real, pointer, dimension(:,:) :: & - ustar => NULL(), & !< surface friction velocity scale (Z/s) + ustar => NULL(), & !< surface friction velocity scale, in Z s-1 ~> m s-1. ustar_gustless => NULL() !< surface friction velocity scale without any - !! any augmentation for gustiness (Z/s) + !! any augmentation for gustiness, in Z s-1 ~> m s-1. ! surface buoyancy force, used when temperature is not a state variable real, pointer, dimension(:,:) :: & @@ -129,12 +129,12 @@ module MOM_forcing_type ! iceberg related inputs real, pointer, dimension(:,:) :: & - ustar_berg => NULL(), & !< iceberg contribution to top ustar (Z/s) + ustar_berg => NULL(), & !< iceberg contribution to top ustar, in Z s-1 ~> m s-1. area_berg => NULL(), & !< area of ocean surface covered by icebergs (m2/m2) mass_berg => NULL() !< mass of icebergs (kg/m2) ! land ice-shelf related inputs - real, pointer, dimension(:,:) :: ustar_shelf => NULL() !< Friction velocity under ice-shelves (in Z/s) + real, pointer, dimension(:,:) :: ustar_shelf => NULL() !< Friction velocity under ice-shelves, in Z s-1 ~> m s-1. !! as computed by the ocean at the previous time step. real, pointer, dimension(:,:) :: frac_shelf_h => NULL() !< Fractional ice shelf coverage of h-cells, nondimensional !! cells, nondimensional from 0 to 1. This is only @@ -181,7 +181,7 @@ module MOM_forcing_type real, pointer, dimension(:,:) :: & taux => NULL(), & !< zonal wind stress (Pa) tauy => NULL(), & !< meridional wind stress (Pa) - ustar => NULL(), & !< surface friction velocity scale (Z/s) + ustar => NULL(), & !< surface friction velocity scale, in Z s-1 ~> m s-1. net_mass_src => NULL() !< The net mass source to the ocean, in kg m-2 s-1. ! applied surface pressure from other component models (e.g., atmos, sea ice, land ice) @@ -1970,7 +1970,7 @@ subroutine set_derived_forcing_fields(forces, fluxes, G, US, Rho0) !! as used to calculate ustar. real :: taux2, tauy2 ! Squared wind stress components, in Pa^2. - real :: Irho0 ! Inverse of the mean density rescaled to (Z2 m / kg) + real :: Irho0 ! Inverse of the mean density rescaled to (Z2 m / kg ~> m3 kg-1) integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index e226598b7f..11fe7813cd 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -164,7 +164,7 @@ module MOM_grid real :: len_lat = 0. !< The latitudinal (or y-coord) extent of physical domain real :: len_lon = 0. !< The longitudinal (or x-coord) extent of physical domain real :: Rad_Earth = 6.378e6 !< The radius of the planet in meters. - real :: max_depth !< The maximum depth of the ocean in depth units (Z). + real :: max_depth !< The maximum depth of the ocean in depth units (Z ~> m). end type ocean_grid_type contains diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index c6bbff50fd..2c394c8ddc 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -24,12 +24,12 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface heights (in Z or units + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface heights (in Z ~> m or units !! given by 1/eta_to_m) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables real, intent(in) :: dt_kappa_smooth !< A smoothing vertical diffusivity - !! times a smoothing timescale, in Z2. + !! times a smoothing timescale, in Z2 ~> m2. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: slope_x !< Isopycnal slope in i-direction (nondim) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: slope_y !< Isopycnal slope in j-direction (nondim) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), & @@ -332,7 +332,7 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Temperature (deg C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Salinity (psu) real, intent(in) :: kappa_dt !< A vertical diffusivity to use for smoothing - !! times a smoothing timescale, in Z2. + !! times a smoothing timescale, in Z2 ~> m2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature (deg C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filed salinity (psu) integer, optional, intent(in) :: halo_here !< Halo width over which to compute diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 4aa14cb082..246b5f764e 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -195,11 +195,11 @@ module MOM_variables real :: Prandtl_turb !< The Prandtl number for the turbulent diffusion !! that is captured in Kd_shear. real, pointer, dimension(:,:) :: & - bbl_thick_u => NULL(), & !< The bottom boundary layer thickness at the u-points, in Z. - bbl_thick_v => NULL(), & !< The bottom boundary layer thickness at the v-points, in Z. - kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points, in Z2 s-1. - kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points, in Z2 s-1. - ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points, in Z s-1. + bbl_thick_u => NULL(), & !< The bottom boundary layer thickness at the u-points, in Z ~> m. + bbl_thick_v => NULL(), & !< The bottom boundary layer thickness at the v-points, in Z ~> m. + kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points, in Z2 s-1 ~> m2 s-1. + kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points, in Z2 s-1 ~> m2 s-1. + ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points, in Z s-1 ~> m s-1. real, pointer, dimension(:,:) :: TKE_BBL => NULL() !< A term related to the bottom boundary layer source of turbulent kinetic !! energy, currently in units of m3 s-3, but will later be changed to W m-2. @@ -207,13 +207,13 @@ module MOM_variables taux_shelf => NULL(), & !< The zonal stresses on the ocean under shelves, in Pa. tauy_shelf => NULL() !< The meridional stresses on the ocean under shelves, in Pa. real, pointer, dimension(:,:) :: tbl_thick_shelf_u => NULL() - !< Thickness of the viscous top boundary layer under ice shelves at u-points, in Z. + !< Thickness of the viscous top boundary layer under ice shelves at u-points, in Z ~> m. real, pointer, dimension(:,:) :: tbl_thick_shelf_v => NULL() - !< Thickness of the viscous top boundary layer under ice shelves at v-points, in Z. + !< Thickness of the viscous top boundary layer under ice shelves at v-points, in Z ~> m. real, pointer, dimension(:,:) :: kv_tbl_shelf_u => NULL() - !< Viscosity in the viscous top boundary layer under ice shelves at u-points, in Z2 s-1. + !< Viscosity in the viscous top boundary layer under ice shelves at u-points, in Z2 s-1 ~> m2 s-1. real, pointer, dimension(:,:) :: kv_tbl_shelf_v => NULL() - !< Viscosity in the viscous top boundary layer under ice shelves at v-points, in Z2 s-1. + !< Viscosity in the viscous top boundary layer under ice shelves at v-points, in Z2 s-1 ~> m2 s-1. real, pointer, dimension(:,:) :: nkml_visc_u => NULL() !< The number of layers in the viscous surface mixed layer at u-points (nondimensional). !! This is not an integer because there may be fractional layers, and it is stored in @@ -224,29 +224,29 @@ module MOM_variables real, pointer, dimension(:,:) :: & MLD => NULL() !< Instantaneous active mixing layer depth (H units). real, pointer, dimension(:,:,:) :: & - Ray_u => NULL(), & !< The Rayleigh drag velocity to be applied to each layer at u-points, in Z s-1. - Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points, in Z s-1. + Ray_u => NULL(), & !< The Rayleigh drag velocity to be applied to each layer at u-points, in Z s-1 ~> m s-1. + Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points, in Z s-1 ~> m s-1. real, pointer, dimension(:,:,:) :: Kd_extra_T => NULL() !< The extra diffusivity of temperature due to double diffusion relative to the - !! diffusivity of density, in Z2 s-1. + !! diffusivity of density, in Z2 s-1 ~> m2 s-1. real, pointer, dimension(:,:,:) :: Kd_extra_S => NULL() !< The extra diffusivity of salinity due to double diffusion relative to the - !! diffusivity of density, in Z2 s-1. + !! diffusivity of density, in Z2 s-1 ~> m2 s-1. ! One of Kd_extra_T and Kd_extra_S is always 0. Kd_extra_S is positive for salt fingering; ! Kd_extra_T is positive for double diffusive convection. They are only allocated if ! DOUBLE_DIFFUSION is true. real, pointer, dimension(:,:,:) :: Kd_shear => NULL() !< The shear-driven turbulent diapycnal diffusivity at the interfaces between layers - !! in tracer columns, in Z2 s-1. + !! in tracer columns, in Z2 s-1 ~> m2 s-1. real, pointer, dimension(:,:,:) :: Kv_shear => NULL() !< The shear-driven turbulent vertical viscosity at the interfaces between layers - !! in tracer columns, in Z2 s-1. + !! in tracer columns, in Z2 s-1 ~> m2 s-1. real, pointer, dimension(:,:,:) :: Kv_shear_Bu => NULL() !< The shear-driven turbulent vertical viscosity at the interfaces between layers in - !! corner columns, in Z2 s-1. + !! corner columns, in Z2 s-1 ~> m2 s-1. real, pointer, dimension(:,:,:) :: Kv_slow => NULL() !< The turbulent vertical viscosity component due to "slow" processes (e.g., tidal, - !! background, convection etc), in Z2 s-1. + !! background, convection etc), in Z2 s-1 ~> m2 s-1. real, pointer, dimension(:,:,:) :: TKE_turb => NULL() !< The turbulent kinetic energy per unit mass at the interfaces, in m2 s-2. !! This may be at the tracer or corner points diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 92f303e12b..3d5d6db936 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -21,7 +21,7 @@ module MOM_verticalGrid ! Commonly used parameters integer :: ke !< The number of layers/levels in the vertical real :: max_depth !< The maximum depth of the ocean in Z (often m). - real :: g_Earth !< The gravitational acceleration in m2 Z-1 s-2. + real :: g_Earth !< The gravitational acceleration in m2 Z-1 s-2 ~> m s-2. real :: Rho0 !< The density used in the Boussinesq approximation or nominal !! density used to convert depths into mass units, in kg m-3. @@ -42,7 +42,7 @@ module MOM_verticalGrid !! Angstrom or larger without changing it at the bit level, in thickness units. !! If Angstrom is 0 or exceedingly small, this is negligible compared to 1e-17 m. real, allocatable, dimension(:) :: & - g_prime, & !< The reduced gravity at each interface, in m2 Z-1 s-2. + g_prime, & !< The reduced gravity at each interface, in m2 Z-1 s-2 ~> m s-2. Rlay !< The target coordinate value (potential density) in each layer in kg m-3. integer :: nkml = 0 !< The number of layers at the top that should be treated !! as parts of a homogenous region. diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index 424b241c46..d02f4f5fbb 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -67,7 +67,7 @@ module MOM_diag_to_Z integer :: num_tr_used = 0 !< Th enumber of tracers in use. integer :: nk_zspace = -1 !< The number of levels in the z-space output - real, pointer :: Z_int(:) => NULL() !< interface depths of the z-space file, in Z + real, pointer :: Z_int(:) => NULL() !< interface depths of the z-space file, in Z ~> m. !>@{ Axis groups for z-space diagnostic output type(axes_grp) :: axesBz, axesTz, axesCuz, axesCvz @@ -159,7 +159,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, US, CS) ! Local variables ! Note the deliberately reversed axes in h_f, u_f, v_f, and tr_f. real :: ssh(SZI_(G),SZJ_(G)) ! copy of ssh_in whose halos can be updated (meter or kg/m2) - real :: e(SZK_(G)+2) ! z-star interface heights in Z + real :: e(SZK_(G)+2) ! z-star interface heights in Z ~> m. real :: h_f(SZK_(G)+1,SZI_(G)) ! thicknesses of massive layers (meter or kg/m2) real :: u_f(SZK_(G)+1,SZIB_(G))! zonal velocity component in any massive layer real :: v_f(SZK_(G)+1,SZI_(G)) ! meridional velocity component in any massive layer @@ -167,8 +167,8 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, US, CS) real :: tr_f(SZK_(G),max(CS%num_tr_used,1),SZI_(G)) ! tracer concentration in massive layers integer :: nk_valid(SZIB_(G)) ! number of massive layers in a column - real :: D_pt(SZIB_(G)) ! bottom depth in Z - real :: shelf_depth(SZIB_(G)) ! ice shelf depth in Z + real :: D_pt(SZIB_(G)) ! bottom depth in Z ~> m. + real :: shelf_depth(SZIB_(G)) ! ice shelf depth in Z ~> m. real :: htot ! summed layer thicknesses (meter or kg/m2) real :: dilate ! proportion by which to dilate every layer real :: wt(SZK_(G)+1) ! fractional weight for each layer in the @@ -515,7 +515,7 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) real, dimension(SZI_(G), SZJ_(G)) :: & htot, & ! total layer thickness, in H dilate ! Factor by which to dilate layers to convert them - ! into z* space, in Z H-1. (-G%D < z* < 0) + ! into z* space, in Z H-1 ~> 1 or m3 kg-1. (-G%D < z* < 0) real, dimension(SZI_(G), max(CS%nk_zspace,1)) :: & uh_Z ! uh_int interpolated into depth space (m3 or kg) @@ -523,15 +523,15 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) vh_Z ! vh_int interpolated into depth space (m3 or kg) real :: h_rem ! dilated thickness of a layer that has yet to be mapped - ! into depth space (in Z) + ! into depth space (in Z ~> m) real :: uh_rem ! integrated zonal transport of a layer that has yet to be ! mapped into depth space (m3 or kg) real :: vh_rem ! integrated meridional transport of a layer that has yet ! to be mapped into depth space (m3 or kg) real :: h_here ! thickness of a layer that is within the range of the - ! current depth level (in Z) + ! current depth level (in Z ~> m) real :: h_above ! thickness of a layer that is above the current depth - ! level (in Z) + ! level (in Z ~> m) real :: uh_here ! zonal transport of a layer that is attributed to the ! current depth level (m3 or kg) real :: vh_here ! meridional transport of a layer that is attributed to diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 3ea4e65506..d1dd451616 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -775,9 +775,9 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) !! previous call to diagnostics_init. real, dimension(SZI_(G), SZJ_(G)) :: & - z_top, & ! Height of the top of a layer or the ocean, in Z. + z_top, & ! Height of the top of a layer or the ocean, in Z ~> m. z_bot, & ! Height of the bottom of a layer (for id_mass) or the - ! (positive) depth of the ocean (for id_col_ht), in Z. + ! (positive) depth of the ocean (for id_col_ht), in Z ~> m. mass, & ! integrated mass of the water column, in kg m-2. For ! non-Boussinesq models this is rho*dz. For Boussinesq ! models, this is either the integral of in-situ density diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 92028dabf4..2f526fc98e 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -57,7 +57,7 @@ module MOM_sum_output logical :: read_depth_list !< Read the depth list from a file if it exists !! and write it if it doesn't. character(len=200) :: depth_list_file !< The name of the depth list file. - real :: D_list_min_inc !< The minimum increment, in Z, between the depths of the + real :: D_list_min_inc !< The minimum increment, in Z ~> m, between the depths of the !! entries in the depth-list file, 0 by default. logical :: use_temperature !< If true, temperature and salinity are state variables. real :: fresh_water_input !< The total mass of fresh water added by surface fluxes @@ -291,21 +291,21 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ optional, pointer :: OBC !< Open boundaries control structure. type(time_type), optional, intent(in) :: dt_forcing !< The forcing time step ! Local variables - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! The height of interfaces, in Z. + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! The height of interfaces, in Z ~> m. real :: areaTm(SZI_(G),SZJ_(G)) ! A masked version of areaT, in m2. real :: KE(SZK_(G)) ! The total kinetic energy of a layer, in J. real :: PE(SZK_(G)+1)! The available potential energy of an interface, in J. real :: KE_tot ! The total kinetic energy, in J. real :: PE_tot ! The total available potential energy, in J. real :: Z_0APE(SZK_(G)+1) ! The uniform depth which overlies the same - ! volume as is below an interface, in Z. + ! volume as is below an interface, in Z ~> m. real :: H_0APE(SZK_(G)+1) ! A version of Z_0APE, converted to m, usually positive. real :: toten ! The total kinetic & potential energies of ! all layers, in Joules (i.e. kg m2 s-2). real :: En_mass ! The total kinetic and potential energies divided by ! the total mass of the ocean, in m2 s-2. - real :: vol_lay(SZK_(G)) ! The volume of fluid in a layer, in Z m2. - real :: volbelow ! The volume of all layers beneath an interface in Z m2. + real :: vol_lay(SZK_(G)) ! The volume of fluid in a layer, in Z m2 ~> m3. + real :: volbelow ! The volume of all layers beneath an interface in Z m2 ~> m3. real :: mass_lay(SZK_(G)) ! The mass of fluid in a layer, in kg. real :: mass_tot ! The total mass of the ocean in kg. real :: vol_tot ! The total ocean volume in m3. @@ -335,11 +335,11 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ real :: temp_anom ! The change in total heat that cannot be accounted for ! by the surface fluxes, divided by the total heat ! capacity of the ocean, in C. - real :: hint ! The deviation of an interface from H, in Z. + real :: hint ! The deviation of an interface from H, in Z ~> m. real :: hbot ! 0 if the basin is deeper than H, or the ! height of the basin depth over H otherwise, - ! in Z. This makes PE only include real fluid. - real :: hbelow ! The depth of fluid in all layers beneath an interface, in Z. + ! in Z ~> m. This makes PE only include real fluid. + real :: hbelow ! The depth of fluid in all layers beneath an interface, in Z ~> m. type(EFP_type) :: & mass_EFP, & ! Extended fixed point sums of total mass, etc. salt_EFP, heat_EFP, salt_chg_EFP, heat_chg_EFP, mass_chg_EFP, & @@ -1060,15 +1060,15 @@ subroutine create_depth_list(G, CS) !! in which the ordered depth list is stored. ! Local variables real, dimension(G%Domain%niglobal*G%Domain%njglobal + 1) :: & - Dlist, & !< The global list of bottom depths, in Z. + Dlist, & !< The global list of bottom depths, in Z ~> m. AreaList !< The global list of cell areas, in m2. integer, dimension(G%Domain%niglobal*G%Domain%njglobal+1) :: & indx2 !< The position of an element in the original unsorted list. - real :: Dnow !< The depth now being considered for sorting, in Z. - real :: Dprev !< The most recent depth that was considered, in Z. - real :: vol !< The running sum of open volume below a deptn, in Z m2. + real :: Dnow !< The depth now being considered for sorting, in Z ~> m. + real :: Dprev !< The most recent depth that was considered, in Z ~> m. + real :: vol !< The running sum of open volume below a deptn, in Z m2 ~> m3. real :: area !< The open area at the current depth, in m2. - real :: D_list_prev !< The most recent depth added to the list, in Z. + real :: D_list_prev !< The most recent depth added to the list, in Z ~> m. logical :: add_to_list !< This depth should be included as an entry on the list. integer :: ir, indxt diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 3a136bcd9b..2681314b36 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -30,7 +30,7 @@ module MOM_wave_speed !! wave speed. This parameter controls the default behavior of !! wave_speed() which can be overridden by optional arguments. real :: mono_N2_depth = -1. !< The depth below which N2 is limited as monotonic for the purposes of - !! calculating the equivalent barotropic wave speed. (Z) + !! calculating the equivalent barotropic wave speed, in Z ~> m. !! This parameter controls the default behavior of wave_speed() which !! can be overridden by optional arguments. type(remapping_CS) :: remapping_CS !< Used for vertical remapping when calculating equivalent barotropic @@ -68,7 +68,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & real, dimension(SZK_(G)+1) :: & dRho_dT, dRho_dS, & pres, T_int, S_int, & - gprime ! The reduced gravity across each interface, in m2 Z-1 s-2. + gprime ! The reduced gravity across each interface, in m2 Z-1 s-2 ~> m s-2. real, dimension(SZK_(G)) :: & Igl, Igu ! The inverse of the reduced gravity across an interface times ! the thickness of the layer below (Igl) or above (Igu) it, @@ -82,11 +82,11 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & real :: min_h_frac real :: Z_to_Pa ! A conversion factor from thickesses (in Z) to pressure (in Pa) real, dimension(SZI_(G)) :: & - htot, hmin, & ! Thicknesses in Z. + htot, hmin, & ! Thicknesses in Z ~> m. H_here, HxT_here, HxS_here, HxR_here real :: speed2_tot real :: I_Hnew, drxh_sum - real :: L2_to_Z2 ! A scaling factor squared from units of lateral distances to depths, in Z2 m-2. + real :: L2_to_Z2 ! A scaling factor squared from units of lateral distances to depths, in Z2 m-2 ~> 1. real, parameter :: tol1 = 0.0001, tol2 = 0.001 real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() real :: g_Rho0 ! G_Earth/Rho0 in m4 s-2 kg-1. @@ -561,7 +561,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) real :: min_h_frac real :: Z_to_Pa ! A conversion factor from thickesses (in Z) to pressure (in Pa) real, dimension(SZI_(G)) :: & - htot, hmin, & ! Thicknesses in Z. + htot, hmin, & ! Thicknesses in Z ~> m. H_here, HxT_here, HxS_here, HxR_here real :: speed2_tot ! overestimate of the mode-1 speed squared, m2 s-2 real :: speed2_min ! minimum mode speed (squared) to consider in root searching diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 7e82c02ec8..fbec51196c 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -109,7 +109,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real, dimension(SZK_(G)+1) :: & dRho_dT, dRho_dS, & pres, T_int, S_int, & - gprime ! The reduced gravity across each interface, in m2 Z-1 s-2. + gprime ! The reduced gravity across each interface, in m2 Z-1 s-2 ~> m s-2. real, dimension(SZK_(G)) :: & Igl, Igu ! The inverse of the reduced gravity across an interface times ! the thickness of the layer below (Igl) or above (Igu) it, @@ -125,7 +125,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real :: min_h_frac real :: H_to_pres real, dimension(SZI_(G)) :: & - hmin, & ! Thicknesses in Z. + hmin, & ! Thicknesses in Z ~> m. H_here, HxT_here, HxS_here, HxR_here real :: speed2_tot real :: I_Hnew, drxh_sum diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 9a823d23eb..3cd23a9b04 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -625,14 +625,14 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, & real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S !< Salinity (PSU) real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in depth units (Z). + intent(in) :: z_t !< Height at the top of the layer in depth units (Z ~> m). real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the bottom of the layer in Z. + intent(in) :: z_b !< Height at the bottom of the layer, in Z ~> m. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to !! reduce the magnitude of each of the integrals. real, intent(in) :: rho_0 !< A density, in kg m-3, that is used to calculate the !! pressure (as p~=-z*rho_0*G_e) used in the equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2 ~> m s-2. type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly across the layer, in Pa. @@ -650,7 +650,7 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, & !! divided by the y grid spacing, in Pa. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. - real, optional, intent(in) :: dz_neglect !< A miniscule thickness change, in Z. + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change, in Z ~> m. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. @@ -876,16 +876,16 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S !< Salinity of the layer in PSU. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in depth units (Z). + intent(in) :: z_t !< Height at the top of the layer in depth units (Z ~> m). real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the bottom of the layer in Z. + intent(in) :: z_b !< Height at the bottom of the layer in Z ~> m. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is !! subtracted out to reduce the magnitude !! of each of the integrals. real, intent(in) :: rho_0 !< A density, in kg m-3, that is used !! to calculate the pressure (as p~=-z*rho_0*G_e) !! used in the equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2 ~> m s-2. type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly @@ -904,7 +904,7 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, !! layer divided by the y grid spacing, in Pa. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. - real, optional, intent(in) :: dz_neglect !< A miniscule thickness change, in Z. + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change, in Z ~> m. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. real :: T5(5), S5(5), p5(5), r5(5) @@ -912,10 +912,10 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real :: w_left, w_right real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. real :: GxRho, I_Rho - real :: dz ! The layer thickness, in Z. - real :: hWght ! A pressure-thickness below topography, in Z. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Z. - real :: iDenom ! The inverse of the denominator in the weights, in Z-2. + real :: dz ! The layer thickness, in Z ~> m. + real :: hWght ! A pressure-thickness below topography, in Z ~> m. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Z ~> m. + real :: iDenom ! The inverse of the denominator in the weights, in Z-2 ~> m-2. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. @@ -1068,14 +1068,14 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & intent(in) :: S_b !< Salinity at the cell bottom (ppt) real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_t !< The geometric height at the top of the layer, - !! in depth units (Z), usually m. + !! in depth units (Z ~> m). real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< The geometric height at the bottom of the layer in Z. + intent(in) :: z_b !< The geometric height at the bottom of the layer in Z ~> m. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to !! reduce the magnitude of each of the integrals. real, intent(in) :: rho_0 !< A density, in kg m-3, that is used to calculate the !! pressure (as p~=-z*rho_0*G_e) used in the equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2 ~> m s-2. real, intent(in) :: dz_subroundoff !< A miniscule thickness !! change with the same units as z_t real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & @@ -1125,16 +1125,16 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & real, parameter :: C1_90 = 1.0/90.0 ! A rational constant, ND. real :: GxRho ! Gravitational acceleration times density, in kg m-1 Z-1 s-2. real :: I_Rho ! The inverse of the reference density, in m3 kg-1. - real :: dz(HIO%iscB:HIO%iecB+1) ! Layer thicknesses at tracer points in Z. - real :: dz_x(5,HIO%iscB:HIO%iecB) ! Layer thicknesses along an x-line of subrid locations, in Z. - real :: dz_y(5,HIO%isc:HIO%iec) ! Layer thicknesses along a y-line of subrid locations, in Z. + real :: dz(HIO%iscB:HIO%iecB+1) ! Layer thicknesses at tracer points in Z ~> m. + real :: dz_x(5,HIO%iscB:HIO%iecB) ! Layer thicknesses along an x-line of subrid locations, in Z ~> m. + real :: dz_y(5,HIO%isc:HIO%iec) ! Layer thicknesses along a y-line of subrid locations, in Z ~> m. real :: weight_t, weight_b ! Nondimensional wieghts of the top and bottom. real :: massWeightToggle ! A nondimensional toggle factor (0 or 1). real :: Ttl, Tbl, Ttr, Tbr ! Temperatures at the velocity cell corners, in degC. real :: Stl, Sbl, Str, Sbr ! Salinities at the velocity cell corners, in ppt. - real :: hWght ! A topographically limited thicknes weight, in Z. - real :: hL, hR ! Thicknesses to the left and right, in Z. - real :: iDenom ! The denominator of the thickness weight expressions, in Z-2. + real :: hWght ! A topographically limited thicknes weight, in Z ~> m. + real :: hL, hR ! Thicknesses to the left and right, in Z ~> m. + real :: iDenom ! The denominator of the thickness weight expressions, in Z-2 ~> m-2. integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n integer :: iin, jin, ioff, joff integer :: pos @@ -1360,16 +1360,16 @@ subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_t real, intent(in) :: T_b !< Potential temperatue at the cell bottom (degC) real, intent(in) :: S_t !< Salinity at the cell top (ppt) real, intent(in) :: S_b !< Salinity at the cell bottom (ppt) - real, intent(in) :: z_t !< Absolute height of top of cell (Z) (Boussinesq ????) - real, intent(in) :: z_b !< Absolute height of bottom of cell (Z) + real, intent(in) :: z_t !< Absolute height of top of cell, in Z ~> m. (Boussinesq ????) + real, intent(in) :: z_b !< Absolute height of bottom of cell, in Z ~> m. real, intent(in) :: P_t !< Anomalous pressure of top of cell, relative to g*rho_ref*z_t (Pa) real, intent(in) :: P_tgt !< Target pressure at height z_out, relative to g*rho_ref*z_out (Pa) real, intent(in) :: rho_ref !< Reference density with which calculation are anomalous to real, intent(in) :: G_e !< Gravitational acceleration (m2 Z-1 s-2) type(EOS_type), pointer :: EOS !< Equation of state structure real, intent(out) :: P_b !< Pressure at the bottom of the cell (Pa) - real, intent(out) :: z_out !< Absolute depth at which anomalous pressure = p_tgt (Z) - real, optional, intent(in) :: z_tol !< The tolerance in finding z_out, in Z. + real, intent(out) :: z_out !< Absolute depth at which anomalous pressure = p_tgt, in Z ~> m. + real, optional, intent(in) :: z_tol !< The tolerance in finding z_out, in Z ~> m. ! Local variables real :: top_weight, bottom_weight, rho_anom, w_left, w_right, GxRho, dz, dp, F_guess, F_l, F_r real :: Pa, Pa_left, Pa_right, Pa_tol ! Pressure anomalies, P = integral of g*(rho-rho_ref) dz diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index a4535ec961..51ffe4b9f0 100644 --- a/src/equation_of_state/MOM_EOS_Wright.F90 +++ b/src/equation_of_state/MOM_EOS_Wright.F90 @@ -402,16 +402,16 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S !< Salinity in PSU. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in depth units (Z). + intent(in) :: z_t !< Height at the top of the layer in depth units (Z ~> m). real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the top of the layer in Z. + intent(in) :: z_b !< Height at the top of the layer in Z ~> m. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out !! to reduce the magnitude of each of the integrals. !! (The pressure is calucated as p~=-z*rho_0*G_e.) real, intent(in) :: rho_0 !< Density, in kg m-3, that is used to calculate the !! pressure (as p~=-z*rho_0*G_e) used in the !! equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2 ~> m s-2. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly across the !! layer, in Pa. @@ -429,7 +429,7 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, !! layer divided by the y grid spacing, in Pa. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. - real, optional, intent(in) :: dz_neglect !< A miniscule thickness change in Z. + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change in Z ~> m. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. @@ -440,9 +440,9 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real :: eps, eps2, rem real :: GxRho, I_Rho real :: p_ave, I_al0, I_Lzz - real :: dz ! The layer thickness, in Z. - real :: hWght ! A pressure-thickness below topography, in Z. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Z. + real :: dz ! The layer thickness, in Z ~> m. + real :: hWght ! A pressure-thickness below topography, in Z ~> m. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Z ~> m. real :: iDenom ! The inverse of the denominator in the weights, in m-Z. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90 index d63929bd62..af961f4c43 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -323,9 +323,9 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S !< Salinity in PSU. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in depth units (Z). + intent(in) :: z_t !< Height at the top of the layer in depth units (Z ~> m). real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the top of the layer in Z. + intent(in) :: z_b !< Height at the top of the layer in Z ~> m. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted !! out to reduce the magnitude of each of the !! integrals. @@ -333,7 +333,7 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, !! the pressure (as p~=-z*rho_0_pres*G_e) used in !! the equation of state. rho_0_pres is not used !! here. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2 ~> m s-2. real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. real, intent(in) :: dRho_dT !< The derivative of density with temperature, !! in kg m-3 C-1. @@ -356,16 +356,16 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, !! layer divided by the y grid spacing, in Pa. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. - real, optional, intent(in) :: dz_neglect !< A miniscule thickness change in Z. + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change in Z ~> m. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. ! Local variables real :: rho_anom ! The density anomaly from rho_ref, in kg m-3. real :: raL, raR ! rho_anom to the left and right, in kg m-3. - real :: dz, dzL, dzR ! Layer thicknesses in Z. - real :: hWght ! A pressure-thickness below topography, in Z. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Z. - real :: iDenom ! The inverse of the denominator in the weights, in Z-2. + real :: dz, dzL, dzR ! Layer thicknesses in Z ~> m. + real :: hWght ! A pressure-thickness below topography, in Z ~> m. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Z ~> m. + real :: iDenom ! The inverse of the denominator in the weights, in Z-2 ~> m-2. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 51c45bc1b9..754af0cb8f 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -137,11 +137,11 @@ module MOM_dyn_horgrid !! basin depths at velocity points. Otherwise the effects of !! of topography are entirely determined from thickness points. real, allocatable, dimension(:,:) :: & - Dblock_u, & !< Topographic depths at u-points at which the flow is blocked, in Z. - Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu, in Z. + Dblock_u, & !< Topographic depths at u-points at which the flow is blocked, in Z ~> m. + Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu, in Z ~> m. real, allocatable, dimension(:,:) :: & - Dblock_v, & !< Topographic depths at v-points at which the flow is blocked, in Z. - Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv, in Z. + Dblock_v, & !< Topographic depths at v-points at which the flow is blocked, in Z ~> m. + Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv, in Z ~> m. real, allocatable, dimension(:,:) :: & CoriolisBu !< The Coriolis parameter at corner points, in s-1. real, allocatable, dimension(:,:) :: & @@ -159,7 +159,7 @@ module MOM_dyn_horgrid real :: len_lat = 0. !< The latitudinal (or y-coord) extent of physical domain real :: len_lon = 0. !< The longitudinal (or x-coord) extent of physical domain real :: Rad_Earth = 6.378e6 !< The radius of the planet in meters. - real :: max_depth !< The maximum depth of the ocean in Z. + real :: max_depth !< The maximum depth of the ocean in Z ~> m. end type dyn_horgrid_type contains diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 82ae988f4f..995192830e 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -83,7 +83,7 @@ module MOM_ice_shelf real, pointer, dimension(:,:) :: & utide => NULL() !< tidal velocity, in m/s - real :: ustar_bg !< A minimum value for ustar under ice shelves, in Z s-1. + real :: ustar_bg !< A minimum value for ustar under ice shelves, in Z s-1 ~> m s-1. real :: cdrag !< drag coefficient under ice shelves , non-dimensional. real :: g_Earth !< The gravitational acceleration in m s-2. real :: Cp !< The heat capacity of sea water, in J kg-1 K-1. @@ -125,7 +125,7 @@ module MOM_ice_shelf !! shelf front(until we think of a better way to do it- !! but any difference will be negligible) logical :: calve_to_mask !< If true, calve any ice that passes outside of a masked area - real :: min_thickness_simple_calve !< min. ice shelf thickness criteria for calving, in Z + real :: min_thickness_simple_calve !< min. ice shelf thickness criteria for calving, in Z ~> m. real :: T0 !< temperature at ocean surface in the restoring region, in degC real :: S0 !< Salinity at ocean surface in the restoring region, in ppt. real :: input_flux !< Ice volume flux at an upstream open boundary, in m3 s-1. @@ -875,7 +875,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) type(time_type) :: Time0!< The previous time (Time-dt) real, dimension(SZDI_(G),SZDJ_(G)) :: last_mass_shelf !< Ice shelf mass !! at at previous time (Time-dt), in kg/m^2 - real, dimension(SZDI_(G),SZDJ_(G)) :: last_h_shelf !< Ice shelf thickness in Z + real, dimension(SZDI_(G),SZDJ_(G)) :: last_h_shelf !< Ice shelf thickness in Z ~> m. !! at at previous time (Time-dt), in m real, dimension(SZDI_(G),SZDJ_(G)) :: last_hmask !< Ice shelf mask !! at at previous time (Time-dt) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 050fad5089..90ab481722 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -52,9 +52,9 @@ module MOM_ice_shelf_dynamics real, pointer, dimension(:,:) :: u_face_mask_bdry => NULL() !< A duplicate copy of u_face_mask? real, pointer, dimension(:,:) :: v_face_mask_bdry => NULL() !< A duplicate copy of v_face_mask? real, pointer, dimension(:,:) :: u_flux_bdry_val => NULL() !< The ice volume flux into the cell through open boundary - !! u-faces (where u_face_mask=4), in Z m2 s-1??? + !! u-faces (where u_face_mask=4), in Z m2 s-1 ~> m3 s-1??? real, pointer, dimension(:,:) :: v_flux_bdry_val => NULL() !< The ice volume flux into the cell through open boundary - !! v-faces (where v_face_mask=4), in Z m2 s-1??? + !! v-faces (where v_face_mask=4), in Z m2 s-1 ~> m3 s-1??? ! needed where u_face_mask is equal to 4, similary for v_face_mask real, pointer, dimension(:,:) :: umask => NULL() !< u-mask on the actual degrees of freedom (B grid) !! 1=normal node, 3=inhomogeneous boundary node, @@ -68,7 +68,7 @@ module MOM_ice_shelf_dynamics !! in degC on corner-points (B grid) real, pointer, dimension(:,:) :: tmask => NULL() !< A mask on tracer points that is 1 where there is ice. real, pointer, dimension(:,:) :: ice_visc => NULL() !< Glen's law ice viscosity, perhaps in m. - real, pointer, dimension(:,:) :: thickness_bdry_val => NULL() !< The ice thickness at an inflowing boundary, in Z. + real, pointer, dimension(:,:) :: thickness_bdry_val => NULL() !< The ice thickness at an inflowing boundary in Z ~> m. real, pointer, dimension(:,:) :: u_bdry_val => NULL() !< The zonal ice velocity at inflowing boundaries in m/s??? real, pointer, dimension(:,:) :: v_bdry_val => NULL() !< The meridional ice velocity at inflowing boundaries in m/s??? real, pointer, dimension(:,:) :: h_bdry_val => NULL() !< The ice thickness at inflowing boundaries, in m. @@ -79,7 +79,7 @@ module MOM_ice_shelf_dynamics real, pointer, dimension(:,:) :: OD_rt => NULL() !< A running total for calculating OD_av. real, pointer, dimension(:,:) :: float_frac_rt => NULL() !< A running total for calculating float_frac. - real, pointer, dimension(:,:) :: OD_av => NULL() !< The time average open ocean depth, in Z. + real, pointer, dimension(:,:) :: OD_av => NULL() !< The time average open ocean depth, in Z ~> m. real, pointer, dimension(:,:) :: float_frac => NULL() !< Fraction of the time a cell is "exposed", i.e. the column !! thickness is below a threshold. !### [if float_frac = 1 ==> grounded; obviously counterintuitive; might fix] @@ -124,7 +124,7 @@ module MOM_ice_shelf_dynamics real :: thresh_float_col_depth !< The water column depth over which the shelf if considered to be floating logical :: moving_shelf_front !< Specify whether to advance shelf front (and calve). logical :: calve_to_mask !< If true, calve off the ice shelf when it passes the edge of a mask. - real :: min_thickness_simple_calve !< min. ice shelf thickness criteria for calving, in Z + real :: min_thickness_simple_calve !< min. ice shelf thickness criteria for calving, in Z ~> m. real :: cg_tolerance !< The tolerance in the CG solver, relative to initial residual, that !! deterimnes when to stop the conguage gradient iterations. @@ -704,7 +704,7 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) ! o--- (3) ---o ! - real, dimension(SZDI_(G),SZDJ_(G)) :: h_after_uflux, h_after_vflux ! Ice thicknesses in Z. + real, dimension(SZDI_(G),SZDJ_(G)) :: h_after_uflux, h_after_vflux ! Ice thicknesses in Z ~> m. real, dimension(SZDI_(G),SZDJ_(G),4) :: flux_enter integer :: isd, ied, jsd, jed, i, j, isc, iec, jsc, jec real :: rho, spy @@ -781,7 +781,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u, v, iters, time) real, dimension(SZDIB_(G),SZDJB_(G)) :: TAUDX, TAUDY, u_prev_iterate, v_prev_iterate, & u_bdry_cont, v_bdry_cont, Au, Av, err_u, err_v, & u_last, v_last - real, dimension(SZDIB_(G),SZDJB_(G)) :: H_node ! Ice shelf thickness at corners, in Z. + real, dimension(SZDIB_(G),SZDJB_(G)) :: H_node ! Ice shelf thickness at corners, in Z ~> m. real, dimension(SZDI_(G),SZDJ_(G)) :: float_cond ! An array indicating where the ice ! shelf is floating: 0 if floating, 1 if not. character(len=160) :: mesg ! The text of an error message @@ -1043,7 +1043,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c intent(in) :: taudy !< The y-direction driving stress, in ??? real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: H_node !< The ice shelf thickness at nodal (corner) - !! points, in Z. + !! points, in Z ~> m. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: float_cond !< An array indicating where the ice !! shelf is floating: 0 if floating, 1 if not. @@ -1421,13 +1421,13 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: h0 !< The initial ice shelf thicknesses in Z. + intent(in) :: h0 !< The initial ice shelf thicknesses in Z ~> m. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_after_uflux !< The ice shelf thicknesses after - !! the zonal mass fluxes, in Z. + !! the zonal mass fluxes, in Z ~> m. real, dimension(SZDI_(G),SZDJ_(G),4), & intent(inout) :: flux_enter !< The ice volume flux into the cell - !! through the 4 cell boundaries, in Z m2 + !! through the 4 cell boundaries, in Z m2 ~> m3. ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells @@ -1450,7 +1450,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied integer :: i_off, j_off logical :: at_east_bdry, at_west_bdry, one_off_west_bdry, one_off_east_bdry - real, dimension(-2:2) :: stencil ! Thicknesses in Z. + real, dimension(-2:2) :: stencil ! Thicknesses in Z ~> m. real :: u_face, & ! positive if out flux_diff_cell, phi, dxh, dyh, dxdyh character (len=1) :: debug_str @@ -1652,13 +1652,13 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: h_after_uflux !< The ice shelf thicknesses after - !! the zonal mass fluxes, in Z. + !! the zonal mass fluxes, in Z ~> m. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_after_vflux !< The ice shelf thicknesses after - !! the meridional mass fluxes, in Z. + !! the meridional mass fluxes, in Z ~> m. real, dimension(SZDI_(G),SZDJ_(G),4), & intent(inout) :: flux_enter !< The ice volume flux into the cell - !! through the 4 cell boundaries, in Z m2 + !! through the 4 cell boundaries, in Z m2 ~> m3. ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells @@ -1681,7 +1681,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied integer :: i_off, j_off logical :: at_north_bdry, at_south_bdry, one_off_west_bdry, one_off_east_bdry - real, dimension(-2:2) :: stencil ! Thicknesses in Z + real, dimension(-2:2) :: stencil ! Thicknesses in Z ~> m. real :: v_face, & ! positive if out flux_diff_cell, phi, dxh, dyh, dxdyh character(len=1) :: debug_str @@ -1859,7 +1859,7 @@ subroutine shelf_advance_front(CS, ISS, G, flux_enter) type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G),4), & intent(inout) :: flux_enter !< The ice volume flux into the cell - !! through the 4 cell boundaries, in Z m2 + !! through the 4 cell boundaries, in Z m2 ~> m3. ! in this subroutine we go through the computational cells only and, if they are empty or partial cells, ! we find the reference thickness and update the shelf mass and partial area fraction and the hmask if necessary @@ -2034,13 +2034,13 @@ end subroutine shelf_advance_front subroutine ice_shelf_min_thickness_calve(G, h_shelf, area_shelf_h, hmask, thickness_calve) type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< The ice shelf thickness, in Z. + intent(inout) :: h_shelf !< The ice shelf thickness, in Z ~> m. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf - real, intent(in) :: thickness_calve !< The thickness at which to trigger calving, in Z. + real, intent(in) :: thickness_calve !< The thickness at which to trigger calving, in Z ~> m. integer :: i,j @@ -2061,7 +2061,7 @@ end subroutine ice_shelf_min_thickness_calve subroutine calve_to_mask(G, h_shelf, area_shelf_h, hmask, calve_mask) type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< The ice shelf thickness, in Z. + intent(inout) :: h_shelf !< The ice shelf thickness, in Z ~> m. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. real, dimension(SZDI_(G),SZDJ_(G)), & @@ -2090,7 +2090,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, TAUD_X, TAUD_Y, OD) type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. type(unit_scale_type), intent(in) :: US !< Pointer to a structure containing unit conversion factors real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: OD !< ocean floor depth at tracer points, in Z + intent(in) :: OD !< ocean floor depth at tracer points, in Z ~> m. real, dimension(SZDIB_(G),SZDJB_(G)), & intent(inout) :: TAUD_X !< X-direction driving stress at q-points real, dimension(SZDIB_(G),SZDJB_(G)), & @@ -2107,8 +2107,8 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, TAUD_X, TAUD_Y, OD) ! "average" ocean depth -- and is needed to find surface elevation ! (it is assumed that base_ice = bed + OD) - real, dimension(SIZE(OD,1),SIZE(OD,2)) :: S, & ! surface elevation, in Z - BASE ! basal elevation of shelf/stream, in Z + real, dimension(SIZE(OD,1),SIZE(OD,2)) :: S, & ! surface elevation, in Z ~> m. + BASE ! basal elevation of shelf/stream, in Z ~> m. real :: rho, rhow, sx, sy, neumann_val, dxh, dyh, dxdyh, grav @@ -2283,8 +2283,8 @@ subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf - real, intent(in) :: input_flux !< The integrated inward ice thickness flux in Z m2 s-1. - real, intent(in) :: input_thick !< The ice thickness at boundaries, in Z. + real, intent(in) :: input_flux !< The integrated inward ice thickness flux in Z m2 s-1 ~> m3 s-1. + real, intent(in) :: input_thick !< The ice thickness at boundaries, in Z ~> m. logical, optional, intent(in) :: new_sim !< If present and false, this run is being restarted ! this will be a per-setup function. the boundary values of thickness and velocity @@ -2372,7 +2372,7 @@ subroutine CG_action(uret, vret, u, v, Phi, Phisub, umask, vmask, hmask, H_node, !! meridional flow at the corner point real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: H_node !< The ice shelf thickness at nodal (corner) - !! points, in Z. + !! points, in Z ~> m. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf @@ -2384,7 +2384,7 @@ subroutine CG_action(uret, vret, u, v, Phi, Phisub, umask, vmask, hmask, H_node, intent(in) :: float_cond !< An array indicating where the ice !! shelf is floating: 0 if floating, 1 if not. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points, in Z. + intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points, in Z ~> m. real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: beta !< A field related to the nonlinear part of the !! "linearized" basal stress. The exact form and @@ -2561,11 +2561,11 @@ subroutine CG_action_subgrid_basal(Phisub, H, U, V, DXDYH, bathyT, dens_ratio, U real, dimension(:,:,:,:,:,:), & intent(in) :: Phisub !< Quadrature structure weights at subgridscale !! locations for finite element calculations - real, dimension(2,2), intent(in) :: H !< The ice shelf thickness at nodal (corner) points, in Z. + real, dimension(2,2), intent(in) :: H !< The ice shelf thickness at nodal (corner) points, in Z ~> m. real, dimension(2,2), intent(in) :: U !< The zonal ice shelf velocity at vertices, in m/year real, dimension(2,2), intent(in) :: V !< The meridional ice shelf velocity at vertices, in m/year real, intent(in) :: DXDYH !< The tracer cell area, in m2 - real, intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points, in Z. + real, intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points, in Z ~> m. real, intent(in) :: dens_ratio !< The density of ice divided by the density !! of seawater, nondimensional real, dimension(2,2), intent(inout) :: Ucontr !< A field related to the subgridscale contributions to @@ -2625,7 +2625,7 @@ subroutine matrix_diagonal(CS, G, float_cond, H_node, nu, beta, hmask, dens_rati !! shelf is floating: 0 if floating, 1 if not. real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: H_node !< The ice shelf thickness at nodal - !! (corner) points, in Z. + !! (corner) points, in Z ~> m. real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: nu !< A field related to the ice viscosity from Glen's !! flow law. The exact form and units depend on the @@ -2767,9 +2767,9 @@ subroutine CG_diagonal_subgrid_basal (Phisub, H_node, DXDYH, bathyT, dens_ratio, intent(in) :: Phisub !< Quadrature structure weights at subgridscale !! locations for finite element calculations real, dimension(2,2), intent(in) :: H_node !< The ice shelf thickness at nodal (corner) - !! points, in Z + !! points, in Z ~> m. real, intent(in) :: DXDYH !< The tracer cell area, in m2 - real, intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points, in Z + real, intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points, in Z ~> m. real, intent(in) :: dens_ratio !< The density of ice divided by the density !! of seawater, nondimensional real, dimension(2,2), intent(inout) :: Ucontr !< A field related to the subgridscale contributions to @@ -2813,7 +2813,7 @@ subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, flo !! locations for finite element calculations real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: H_node !< The ice shelf thickness at nodal - !! (corner) points, in Z. + !! (corner) points, in Z ~> m. real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: nu !< A field related to the ice viscosity from Glen's !! flow law. The exact form and units depend on the @@ -3089,7 +3089,7 @@ subroutine update_OD_ffrac_uncoupled(CS, G, h_shelf) type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: h_shelf !< the thickness of the ice shelf in Z + intent(in) :: h_shelf !< the thickness of the ice shelf in Z ~> m. integer :: i, j, iters, isd, ied, jsd, jed real :: rhoi_rhow, OD @@ -3408,13 +3408,13 @@ end subroutine update_velocity_masks subroutine interpolate_H_to_B(G, h_shelf, hmask, H_node) type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: h_shelf !< The ice shelf thickness at tracer points, in Z. + intent(in) :: h_shelf !< The ice shelf thickness at tracer points, in Z ~> m. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDIB_(G),SZDJB_(G)), & intent(inout) :: H_node !< The ice shelf thickness at nodal (corner) - !! points, in Z. + !! points, in Z ~> m. integer :: i, j, isc, iec, jsc, jec, num_h, k, l real :: summ @@ -3625,7 +3625,7 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: h0 !< The initial ice shelf thicknesses in Z. + intent(in) :: h0 !< The initial ice shelf thicknesses in Z ~> m. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_after_uflux !< The ice shelf thicknesses after !! the zonal mass fluxes, in m. @@ -3857,10 +3857,10 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: h_after_uflux !< The ice shelf thicknesses after - !! the zonal mass fluxes, in Z. + !! the zonal mass fluxes, in Z ~> m. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_after_vflux !< The ice shelf thicknesses after - !! the meridional mass fluxes, in Z. + !! the meridional mass fluxes, in Z ~> m. real, dimension(SZDI_(G),SZDJ_(G),4), & intent(inout) :: flux_enter !< The integrated temperature flux into !! the cell through the 4 cell boundaries, in degC Z m2 diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index efbc22f64d..f39d58cd17 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -23,7 +23,7 @@ module MOM_ice_shelf_initialize subroutine initialize_ice_thickness(h_shelf, area_shelf_h, hmask, G, US, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< The ice shelf thickness, in Z. + intent(inout) :: h_shelf !< The ice shelf thickness, in Z ~> m. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. real, dimension(SZDI_(G),SZDJ_(G)), & @@ -142,7 +142,7 @@ end subroutine initialize_ice_thickness_from_file subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, US, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< The ice shelf thickness, in Z. + intent(inout) :: h_shelf !< The ice shelf thickness, in Z ~> m. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. real, dimension(SZDI_(G),SZDJ_(G)), & diff --git a/src/ice_shelf/user_shelf_init.F90 b/src/ice_shelf/user_shelf_init.F90 index 60dd6ec18f..77cc175634 100644 --- a/src/ice_shelf/user_shelf_init.F90 +++ b/src/ice_shelf/user_shelf_init.F90 @@ -23,8 +23,8 @@ module user_shelf_init !> The control structure for the user_ice_shelf module type, public :: user_ice_shelf_CS ; private real :: Rho_ocean !< The ocean's typical density, in kg m-2 Z-1. - real :: max_draft !< The maximum ocean draft of the ice shelf, in Z. - real :: min_draft !< The minimum ocean draft of the ice shelf, in Z. + real :: max_draft !< The maximum ocean draft of the ice shelf, in Z ~> m. + real :: min_draft !< The minimum ocean draft of the ice shelf, in Z ~> m. real :: flat_shelf_width !< The range over which the shelf is min_draft thick. real :: shelf_slope_scale !< The range over which the shelf slopes. real :: pos_shelf_edge_0 !< The x-position of the shelf edge at time 0, in km. @@ -134,7 +134,7 @@ subroutine USER_update_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, C real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< The ice shelf thickness, in Z. + intent(inout) :: h_shelf !< The ice shelf thickness, in Z ~> m. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index ad66762fef..a649cf222e 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -39,7 +39,7 @@ subroutine MOM_initialize_coord(GV, US, PF, write_geom, output_dir, tv, max_dept logical, intent(in) :: write_geom !< If true, write grid geometry files. character(len=*), intent(in) :: output_dir !< The directory into which to write files. type(thermo_var_ptrs), intent(inout) :: tv !< The thermodynamic variable structure. - real, intent(in) :: max_depth !< The ocean's maximum depth, in Z. + real, intent(in) :: max_depth !< The ocean's maximum depth, in Z ~> m. ! Local character(len=200) :: config logical :: debug @@ -121,7 +121,7 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! in m2 Z-1 s-2. + !! in m2 Z-1 s-2 ~> m s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters @@ -155,7 +155,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! in m2 Z-1 s-2. + !! in m2 Z-1 s-2 ~> m s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters @@ -198,7 +198,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! in m2 Z-1 s-2. + !! in m2 Z-1 s-2 ~> m s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time @@ -250,7 +250,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, & real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! in m2 Z-1 s-2. + !! in m2 Z-1 s-2 ~> m s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time @@ -299,7 +299,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, & real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! in m2 Z-1 s-2. + !! in m2 Z-1 s-2 ~> m s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time @@ -381,7 +381,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! in m2 Z-1 s-2. + !! in m2 Z-1 s-2 ~> m s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters @@ -432,7 +432,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! in m2 Z-1 s-2. + !! in m2 Z-1 s-2 ~> m s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index a0a354858f..7136965b2d 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -1222,9 +1222,9 @@ subroutine initialize_masks(G, PF, US) type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables real :: m_to_Z_scale ! A unit conversion factor from m to Z. - real :: Dmin ! The depth for masking in the same units as G%bathyT (Z). - real :: min_depth ! The minimum ocean depth in the same units as G%bathyT (Z). - real :: mask_depth ! The depth shallower than which to mask a point as land, in Z. + real :: Dmin ! The depth for masking in the same units as G%bathyT (Z ~> m). + real :: min_depth ! The minimum ocean depth in the same units as G%bathyT (Z ~> m). + real :: mask_depth ! The depth shallower than which to mask a point as land, in Z ~> m. character(len=40) :: mdl = "MOM_grid_init initialize_masks" integer :: i, j diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 113c3b3a85..3681e86dd1 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -303,11 +303,11 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth ! Local variables real :: m_to_Z ! A dimensional rescaling factor. - real :: min_depth ! The minimum depth in Z. + real :: min_depth ! The minimum depth in Z ~> m. real :: PI ! 3.1415926... calculated as 4*atan(1) real :: D0 ! A constant to make the maximum basin depth MAXIMUM_DEPTH. real :: expdecay ! A decay scale of associated with the sloping boundaries, in m. - real :: Dedge ! The depth in Z at the basin edge + real :: Dedge ! The depth, in Z ~> m, at the basin edge ! real :: south_lat, west_lon, len_lon, len_lat, Rad_earth integer :: i, j, is, ie, js, je, isd, ied, jsd, jed character(len=40) :: mdl = "initialize_topography_named" ! This subroutine's name. diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 83347d2089..a4b49395ad 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -700,7 +700,7 @@ subroutine adjustEtaToFitBathymetry(G, GV, US, eta, h) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: eta !< Interface heights, in Z + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: eta !< Interface heights, in Z ~> m. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H ! Local variables integer :: i, j, k, is, ie, js, je, nz, contractions, dilations @@ -837,10 +837,10 @@ subroutine initialize_thickness_list(h, G, GV, US, param_file, just_read_params) !! only read parameters without changing h. ! Local variables character(len=40) :: mdl = "initialize_thickness_list" ! This subroutine's name. - real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z ~> m), ! usually negative because it is positive upward. real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in depth units (Z). + ! positive upward, in depth units (Z ~> m). logical :: just_read ! If true, just read parameters but set nothing. character(len=200) :: filename, eta_file, inputdir ! Strings for file/path character(len=72) :: eta_var @@ -1153,8 +1153,8 @@ subroutine cut_off_column_top(nk, tv, GV, G_earth, depth, min_thickness, & type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, intent(in) :: G_earth !< Gravitational acceleration (m2 Z-1 s-2) - real, intent(in) :: depth !< Depth of ocean column (Z) - real, intent(in) :: min_thickness !< Smallest thickness allowed (Z) + real, intent(in) :: depth !< Depth of ocean column, in Z ~> m. + real, intent(in) :: min_thickness !< Smallest thickness allowed, in Z ~> m. real, dimension(nk), intent(inout) :: T !< Layer mean temperature real, dimension(nk), intent(in) :: T_t !< Temperature at top of layer real, dimension(nk), intent(in) :: T_b !< Temperature at bottom of layer @@ -1166,7 +1166,7 @@ subroutine cut_off_column_top(nk, tv, GV, G_earth, depth, min_thickness, & type(remapping_CS), pointer :: remap_CS !< Remapping structure for remapping T and S, !! if associated real, optional, intent(in) :: z_tol !< The tolerance with which to find the depth - !! matching the specified pressure, in Z. + !! matching the specified pressure, in Z ~> m. ! Local variables real, dimension(nk+1) :: e ! Top and bottom edge values for reconstructions @@ -1936,11 +1936,11 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param integer :: kd, inconsistent integer :: nkd ! number of levels to use for regridding input arrays - real :: eps_Z ! A negligibly thin layer thickness, in Z. + real :: eps_Z ! A negligibly thin layer thickness, in Z ~> m. real :: PI_180 ! for conversion from degrees to radians real, dimension(:,:), pointer :: shelf_area => NULL() - real :: min_depth ! The minimum depth in Z. + real :: min_depth ! The minimum depth in Z ~> m. real :: dilate real :: missing_value_temp, missing_value_salt logical :: correct_thickness @@ -1959,19 +1959,19 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param real, dimension(:), allocatable :: z_edges_in, z_in, Rb real, dimension(:,:,:), allocatable, target :: temp_z, salt_z, mask_z real, dimension(:,:,:), allocatable :: rho_z - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi ! Interface heights in Z. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi ! Interface heights in Z ~> m. real, dimension(SZI_(G),SZJ_(G)) :: nlevs real, dimension(SZI_(G)) :: press ! Pressures in Pa. ! Local variables for ALE remapping - real, dimension(:), allocatable :: hTarget ! Target thicknesses in Z. + real, dimension(:), allocatable :: hTarget ! Target thicknesses in Z ~> m. real, dimension(:,:), allocatable :: area_shelf_h real, dimension(:,:), allocatable, target :: frac_shelf_h real, dimension(:,:,:), allocatable, target :: tmpT1dIn, tmpS1dIn real, dimension(:,:,:), allocatable :: tmp_mask_in real, dimension(:,:,:), allocatable :: h1 ! Thicknesses in H. real, dimension(:,:,:), allocatable :: dz_interface ! Change in position of interface due to regridding - real :: zTopOfCell, zBottomOfCell ! Heights in Z units + real :: zTopOfCell, zBottomOfCell ! Heights in Z units, Z ~> m. type(regridding_CS) :: regridCS ! Regridding parameters and work arrays type(remapping_CS) :: remapCS ! Remapping parameters and work arrays diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 1baf30fcc3..9c04b8ca39 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -78,8 +78,8 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ ! Local variables for ALE remapping real, dimension(:,:,:), allocatable :: hSrc ! Source thicknesses in H units. - real, dimension(:), allocatable :: h1 ! A 1-d column of source thicknesses in Z. - real :: zTopOfCell, zBottomOfCell, z_bathy ! Heights in Z. + real, dimension(:), allocatable :: h1 ! A 1-d column of source thicknesses in Z ~> m. + real :: zTopOfCell, zBottomOfCell, z_bathy ! Heights in Z ~> m. type(remapping_CS) :: remapCS ! Remapping parameters and work arrays real :: missing_value diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index 23bda0fce0..b7d1b43152 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -171,7 +171,7 @@ function tracer_z_init(tr_in, z_edges, e, nkml, nkbl, land_fill, wet, nlay, nlev integer :: n,i,j,k,l,nx,ny,nz,nt,kz integer :: k_top,k_bot,k_bot_prev,kk,kstart real :: sl_tr ! The tracer concentration slope times the layer thickess, in tracer units. - real :: epsln_Z ! A negligibly thin layer thickness, in Z. + real :: epsln_Z ! A negligibly thin layer thickness, in Z ~> m. real, dimension(size(tr_in,3)) :: wt !< The fractional weight for each layer in the range between z1 and z2 real, dimension(size(tr_in,3)) :: z1, z2 ! z1 and z2 are the fractional depths of the top and bottom ! limits of the part of a z-cell that contributes to a layer, relative @@ -560,13 +560,13 @@ function find_interfaces(rho, zin, Rb, depth, nlevs, nkml, nkbl, hml, debug, eps intent(in) :: zin !< Input data levels, in Z (often m). real, dimension(:), intent(in) :: Rb !< target interface densities (kg m-3) real, dimension(size(rho,1),size(rho,2)), & - intent(in) :: depth !< ocean depth in Z + intent(in) :: depth !< ocean depth in Z ~> m. real, dimension(size(rho,1),size(rho,2)), & optional, intent(in) :: nlevs !< number of valid points in each column logical, optional, intent(in) :: debug !< optional debug flag integer, optional, intent(in) :: nkml !< number of mixed layer pieces integer, optional, intent(in) :: nkbl !< number of buffer layer pieces - real, optional, intent(in) :: hml !< mixed layer depth, in Z + real, optional, intent(in) :: hml !< mixed layer depth, in Z ~> m. real, optional, intent(in) :: eps_z !< A negligibly small layer thickness in the units of Z. real, dimension(size(rho,1),size(rho,2),size(Rb,1)) :: zi !< The returned interface, in the same units az zin. @@ -583,7 +583,7 @@ function find_interfaces(rho, zin, Rb, depth, nlevs, nkml, nkbl, hml, debug, eps integer :: n,i,j,k,l,nx,ny,nz,nt integer :: nlay,kk,nkml_,nkbl_ logical :: debug_ = .false. - real :: epsln_Z ! A negligibly thin layer thickness, in Z. + real :: epsln_Z ! A negligibly thin layer thickness, in Z ~> m. real :: epsln_rho ! A negligibly small density change, in kg m-3. real, parameter :: zoff=0.999 diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 55c906ae26..2754ad06c0 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -141,17 +141,17 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var MLD_slow, & ! Mixed layer depth actually used in MLE restratification parameterization (H units) htot_slow, & ! The sum of the thicknesses of layers in the mixed layer (H units) Rml_av_slow ! g_Rho0 times the average mixed layer density (m s-2) - real :: g_Rho0 ! G_Earth/Rho0 (m5 Z-1 s-2 kg-1) + real :: g_Rho0 ! G_Earth/Rho0 (m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1) real :: rho_ml(SZI_(G)) ! Potential density relative to the surface (kg m-3) real :: p0(SZI_(G)) ! A pressure of 0 (Pa) - real :: h_vel ! htot interpolated onto velocity points in Z (not H). + real :: h_vel ! htot interpolated onto velocity points, in Z ~> m (not H). real :: absf ! absolute value of f, interpolated to velocity points (s-1) - real :: u_star ! surface friction velocity, interpolated to velocity points (Z s-1) + real :: u_star ! surface friction velocity, interpolated to velocity points, in Z s-1 ~> m s-1. real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer (s-1) real :: timescale ! mixing growth timescale (sec) real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected (H units) - real :: dz_neglect ! A tiny thickness (in Z) that is usually lost in roundoff so can be neglected + real :: dz_neglect ! A tiny thickness (in Z ~> m) that is usually lost in roundoff so can be neglected real :: I4dt ! 1/(4 dt) (sec-1) real :: Ihtot,Ihtot_slow! total mixed layer thickness real :: a(SZK_(G)) ! A non-dimensional value relating the overall flux @@ -563,17 +563,17 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) real, dimension(SZI_(G),SZJ_(G)) :: & htot, & ! The sum of the thicknesses of layers in the mixed layer (H units) Rml_av ! g_Rho0 times the average mixed layer density (m s-2) - real :: g_Rho0 ! G_Earth/Rho0 (m5 Z-1 s-2 kg-1) + real :: g_Rho0 ! G_Earth/Rho0 (m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1) real :: Rho0(SZI_(G)) ! Potential density relative to the surface (kg m-3) real :: p0(SZI_(G)) ! A pressure of 0 (Pa) - real :: h_vel ! htot interpolated onto velocity points (Z; not H) + real :: h_vel ! htot interpolated onto velocity points (in Z ~> m; not H) real :: absf ! absolute value of f, interpolated to velocity points (s-1) - real :: u_star ! surface friction velocity, interpolated to velocity points (Z s-1) + real :: u_star ! surface friction velocity, interpolated to velocity points, in Z s-1 ~> m s-1. real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer (s-1) real :: timescale ! mixing growth timescale (sec) real :: h_neglect ! tiny thickness usually lost in roundoff and can be neglected (H units) - real :: dz_neglect ! tiny thickness (in Z) that usually lost in roundoff and can be neglected (meter) + real :: dz_neglect ! tiny thickness (in Z ~> m) that usually lost in roundoff and can be neglected (meter) real :: I4dt ! 1/(4 dt) real :: I2htot ! Twice the total mixed layer thickness at velocity points (H units) real :: z_topx2 ! depth of the top of a layer at velocity points (H units) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index f4e95bbb17..9a7d7078df 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -88,7 +88,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion ! Local variables real :: e(SZI_(G), SZJ_(G), SZK_(G)+1) ! heights of interfaces, relative to mean - ! sea level, in Z, positive up. + ! sea level, in Z ~> m, positive up. real :: uhD(SZIB_(G), SZJ_(G), SZK_(G)) ! uhD & vhD are the diffusive u*h & real :: vhD(SZI_(G), SZJB_(G), SZK_(G)) ! v*h fluxes (m2 H s-1) @@ -466,28 +466,30 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: drdkL, drdkR ! Vertical density differences across an interface, in kg m-3. real :: drdi_u(SZIB_(G), SZK_(G)+1) ! Copy of drdi at u-points in kg m-3. real :: drdj_v(SZI_(G), SZK_(G)+1) ! Copy of drdj at v-points in kg m-3. - real :: drdkDe_u(SZIB_(G), SZK_(G)+1) ! Lateral difference of product of drdk and e at u-points, in Z kg m-3. - real :: drdkDe_v(SZI_(G), SZK_(G)+1) ! Lateral difference of product of drdk and e at v-points, in Z kg m-3. + real :: drdkDe_u(SZIB_(G),SZK_(G)+1) ! Lateral difference of product of drdk and e at u-points, + ! in Z kg m-3 ~> kg m-2. + real :: drdkDe_v(SZI_(G),SZK_(G)+1) ! Lateral difference of product of drdk and e at v-points, + ! in Z kg m-3 ~> kg m-2. real :: hg2A, hg2B, hg2L, hg2R ! Squares of geometric mean thicknesses, in H2. real :: haA, haB, haL, haR ! Arithmetic mean thicknesses in H. - real :: dzaL, dzaR ! Temporary thicknesses in Z. + real :: dzaL, dzaR ! Temporary thicknesses in Z ~> m. real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. real :: drdx, drdy ! Zonal and meridional density gradients, in kg m-4. - real :: drdz ! Vertical density gradient, in units of kg m-3 Z-1. + real :: drdz ! Vertical density gradient, in units of kg m-3 Z-1 ~> kg m-4. real :: h_harm ! Harmonic mean layer thickness, in H. - real :: c2_h_u(SZIB_(G), SZK_(G)+1) ! Wave speed squared divided by h at u-points, m2 Z-1 s-2. - real :: c2_h_v(SZI_(G), SZK_(G)+1) ! Wave speed squared divided by h at v-points, m2 Z-1 s-2. - real :: hN2_u(SZIB_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above u-points, m2 Z-1 s-2. - real :: hN2_v(SZI_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above v-points, m2 Z-1 s-2. + real :: c2_h_u(SZIB_(G), SZK_(G)+1) ! Wave speed squared divided by h at u-points, in m2 Z-1 s-2 ~> m s-2. + real :: c2_h_v(SZI_(G), SZK_(G)+1) ! Wave speed squared divided by h at v-points, in m2 Z-1 s-2 ~> m s-2. + real :: hN2_u(SZIB_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above u-points, in m2 Z-1 s-2. + real :: hN2_v(SZI_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above v-points, in m2 Z-1 s-2. real :: Sfn_est ! Two preliminary estimates (before limiting) of the - ! overturning streamfunction, both in Z m2 s-1. - real :: Sfn_unlim_u(SZIB_(G), SZK_(G)+1) ! Streamfunction for u-points (Z m2 s-1) - real :: Sfn_unlim_v(SZI_(G), SZK_(G)+1) ! Streamfunction for v-points (Z m2 s-1) + ! overturning streamfunction, both in Z m2 s-1 ~> m3 s-1. + real :: Sfn_unlim_u(SZIB_(G), SZK_(G)+1) ! Streamfunction for u-points, in Z m2 s-1 ~> m3 s-1. + real :: Sfn_unlim_v(SZI_(G), SZK_(G)+1) ! Streamfunction for v-points, in Z m2 s-1 ~> m3 s-1. real :: slope2_Ratio_u(SZIB_(G), SZK_(G)+1) ! The ratio of the slope squared to slope_max squared. real :: slope2_Ratio_v(SZI_(G), SZK_(G)+1) ! The ratio of the slope squared to slope_max squared. real :: Sfn_in_h ! The overturning streamfunction, in H m2 s-1 (note units different from other Sfn vars). real :: Sfn_safe ! The streamfunction that goes linearly back to 0 at the surface. This is a - ! good thing to use when the slope is so large as to be meaningless (Z m2 s-1). + ! good thing to use when the slope is so large as to be meaningless (Z m2 s-1 ~> m3 s-1). real :: Slope ! The slope of density surfaces, calculated in a way ! that is always between -1 and 1, nondimensional. real :: mag_grad2 ! The squared magnitude of the 3-d density gradient, in kg2 m-8. @@ -495,16 +497,16 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. real :: h_neglect2 ! h_neglect^2, in H2. - real :: dz_neglect ! A thickness in Z that is so small it is usually lost - ! in roundoff and can be neglected, in Z. + real :: dz_neglect ! A thickness, in Z ~> m, that is so small it is usually lost + ! in roundoff and can be neglected, in Z ~> m. real :: G_scale ! The gravitational acceleration times some unit conversion - ! factors, in m3 Z-1 H-1 s-2. + ! factors, in m3 Z-1 H-1 s-2 ~> m s-2 or m4 kg-1 s-2. logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. logical :: find_work ! If true, find the change in energy due to the fluxes. integer :: nk_linear ! The number of layers over which the streamfunction ! goes to 0. - real :: G_rho0 ! g/Rho0 in m5 Z-1 s-2 + real :: G_rho0 ! g/Rho0, in m5 Z-1 s-2 ~> m4 s-2. real :: N2_floor ! A floor for N2 to avoid degeneracy in the elliptic solver ! times unit conversion factors (s-2 m2 Z-2) real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: diag_sfn_x, diag_sfn_unlim_x ! Diagnostics diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index b08e77e213..8fe7267953 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -597,7 +597,7 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, f_p ! Local variables real, allocatable, dimension(:,:,:) :: sp_val !< Field to be used in the sponge real, allocatable, dimension(:,:,:) :: mask_z !< Field mask for the sponge data - real, allocatable, dimension(:), target :: z_in, z_edges_in ! Heights in Z. + real, allocatable, dimension(:), target :: z_in, z_edges_in ! Heights in Z ~> m. real :: missing_value integer :: j, k, col integer :: isd,ied,jsd,jed @@ -607,9 +607,9 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, f_p character(len=256) :: mesg ! String for error messages ! Local variables for ALE remapping - real, dimension(:), allocatable :: hsrc ! Source thicknesses in Z + real, dimension(:), allocatable :: hsrc ! Source thicknesses in Z ~> m. real, dimension(:), allocatable :: tmpT1d - real :: zTopOfCell, zBottomOfCell ! Heights in Z + real :: zTopOfCell, zBottomOfCell ! Heights in Z ~> m. type(remapping_CS) :: remapCS ! Remapping parameters and work arrays if (.not.associated(CS)) return diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 9b33e7dd8e..f53b8a6934 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -60,9 +60,9 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface - !! (not layer!) in Z2 s-1. + !! (not layer!) in Z2 s-1 ~> m2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface - !! (not layer!) in Z2 s-1. + !! (not layer!) in Z2 s-1 ~> m2 s-1. type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous call to !! CVMix_shear_init. ! Local variables diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 4aea0b8d5d..e1e86b9e1a 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -384,9 +384,10 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, US, CS) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< squared buoyancy frequency associated !! with layers (1/s2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: kd_lay !< Diapycnal diffusivity of each layer Z2 s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: kd_lay !< Diapycnal diffusivity of each layer, + !! in Z2 s-1 ~> m2 s-1. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) in Z2 s-1 + !! (not layer!) in Z2 s-1 ~> m2 s-1 integer, intent(in) :: j !< Meridional grid index type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by !! a previous call to bkgnd_mixing_init. diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 5d74f0d4d2..858ad04189 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -48,7 +48,7 @@ module MOM_bulk_mixed_layer !! value, in H, scale away all surface forcing to !! avoid boiling the ocean. real :: ustar_min !< A minimum value of ustar to avoid numerical problems, - !! in Z s-1. If the value is small enough, this should + !! in Z s-1 ~> m s-1. If the value is small enough, this should !! not affect the solution. real :: omega !< The Earth's rotation rate, in s-1. real :: dT_dS_wt !< When forced to extrapolate T & S to match the @@ -83,7 +83,7 @@ module MOM_bulk_mixed_layer logical :: TKE_diagnostics = .false. !< If true, calculate extensive diagnostics of the TKE budget logical :: do_rivermix = .false. !< Provide additional TKE to mix river runoff !! at the river mouths to rivermix_depth - real :: rivermix_depth = 0.0 !< The depth of mixing if do_rivermix is true, in Z. + real :: rivermix_depth = 0.0 !< The depth of mixing if do_rivermix is true, in Z ~> m. logical :: limit_det !< If true, limit the extent of buffer layer !! detrainment to be consistent with neighbors. real :: lim_det_dH_sfc !< The fractional limit in the change between grid @@ -106,7 +106,7 @@ module MOM_bulk_mixed_layer real :: Allowed_S_chg !< The amount by which salinity is allowed !! to exceed previous values during detrainment, PSU. - ! These are terms in the mixed layer TKE budget, all in Z m2 s-3. + ! These are terms in the mixed layer TKE budget, all in Z m2 s-3 ~> m3 s-3. real, allocatable, dimension(:,:) :: & ML_depth, & !< The mixed layer depth in H. diag_TKE_wind, & !< The wind source of TKE. @@ -249,12 +249,12 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C integer, dimension(SZI_(G),SZK_(GV)) :: & ksort ! The sorted k-index that each original layer goes to. real, dimension(SZI_(G),SZJ_(G)) :: & - h_miss ! The summed absolute mismatch, in Z. + h_miss ! The summed absolute mismatch, in Z ~> m. real, dimension(SZI_(G)) :: & TKE, & ! The turbulent kinetic energy available for mixing over a - ! time step, in Z m2 s-2. + ! time step, in Z m2 s-2 ~> m3 s-2. Conv_En, & ! The turbulent kinetic energy source due to mixing down to - ! the depth of free convection, in Z m2 s-2. + ! the depth of free convection, in Z m2 s-2 ~> m3 s-2. htot, & ! The total depth of the layers being considered for ! entrainment, in H. R0_tot, & ! The integrated potential density referenced to the surface @@ -290,7 +290,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C dRcv_dS, & ! Partial derivative of the coordinate variable potential ! density in the mixed layer with salinity, in kg m-3 psu-1. TKE_river ! The turbulent kinetic energy available for mixing at rivermouths over a - ! time step, in Z m2 s-2. + ! time step, in Z m2 s-2 ~> m3 s-2. real, dimension(max(CS%nsw,1),SZI_(G)) :: & Pen_SW_bnd ! The penetrating fraction of the shortwave heating integrated @@ -309,21 +309,21 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C real, dimension(SZI_(G)) :: & dKE_FC, & ! The change in mean kinetic energy due to free convection, - ! in Z m2 s-2. + ! in Z m2 s-2 ~> m3 s-2. h_CA ! The depth to which convective adjustment has gone in H. real, dimension(SZI_(G),SZK_(GV)) :: & dKE_CA, & ! The change in mean kinetic energy due to convective - ! adjustment, in Z m2 s-2. + ! adjustment, in Z m2 s-2 ~> m3 s-2. cTKE ! The turbulent kinetic energy source due to convective ! adjustment, Z m2 s-2. real, dimension(SZI_(G),SZJ_(G)) :: & Hsfc_max, & ! The thickness of the surface region (mixed and buffer layers) - ! after entrainment but before any buffer layer detrainment, in Z. + ! after entrainment but before any buffer layer detrainment, in Z ~> m. Hsfc_used, & ! The thickness of the surface region after buffer layer ! detrainment, in units of Z. Hsfc_min, & ! The minimum thickness of the surface region based on the ! new mixed layer depth and the previous thickness of the - ! neighboring water columns, in Z. + ! neighboring water columns, in Z ~> m. h_sum, & ! The total thickness of the water column, in H. hmbl_prev ! The previous thickness of the mixed and buffer layers, in H. real, dimension(SZI_(G)) :: & @@ -336,7 +336,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C real :: absf_x_H ! The absolute value of f times the mixed layer thickness, ! in units of Z s-1. - real :: kU_star ! Ustar times the Von Karmen constant, in Z s-1. + real :: kU_star ! Ustar times the Von Karmen constant, in Z s-1 ~> m s-1. real :: dt__diag ! A copy of dt_diag (if present) or dt, in s. logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. @@ -816,10 +816,10 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & !! that will be left in each layer, in H. real, dimension(SZI_(G),SZK_(GV)), intent(out) :: dKE_CA !< The vertically integrated change in !! kinetic energy due to convective - !! adjustment, in Z m2 s-2. + !! adjustment, in Z m2 s-2 ~> m3 s-2. real, dimension(SZI_(G),SZK_(GV)), intent(out) :: cTKE !< The buoyant turbulent kinetic energy !! source due to convective adjustment, - !! in Z m2 s-2. + !! in Z m2 s-2 ~> m3 s-2. integer, intent(in) :: j !< The j-index to work on. type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. integer, optional, intent(in) :: nz_conv !< If present, the number of layers @@ -997,9 +997,9 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! shortwave radiation, in H-1. !! The indicies of opacity_band are band, i, k. real, dimension(SZI_(G)), intent(out) :: Conv_en !< The buoyant turbulent kinetic energy source - !! due to free convection, in Z m2 s-2. + !! due to free convection, in Z m2 s-2 ~> m3 s-2. real, dimension(SZI_(G)), intent(out) :: dKE_FC !< The vertically integrated change in kinetic - !! energy due to free convection, in Z m2 s-2. + !! energy due to free convection, in Z m2 s-2 ~> m3 s-2. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & intent(in) :: ksort !< The density-sorted k-indices. @@ -1309,25 +1309,25 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, !! possible forcing fields. Unused fields !! have NULL ptrs. real, dimension(SZI_(G)), intent(inout) :: Conv_En !< The buoyant turbulent kinetic energy source - !! due to free convection, in Z m2 s-2. + !! due to free convection, in Z m2 s-2 ~> m3 s-2. real, dimension(SZI_(G)), intent(in) :: dKE_FC !< The vertically integrated change in !! kinetic energy due to free convection, - !! in Z m2 s-2. + !! in Z m2 s-2 ~> m3 s-2. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: cTKE !< The buoyant turbulent kinetic energy !! source due to convective adjustment, - !! in Z m2 s-2. + !! in Z m2 s-2 ~> m3 s-2. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: dKE_CA !< The vertically integrated change in !! kinetic energy due to convective - !! adjustment, in Z m2 s-2. + !! adjustment, in Z m2 s-2 ~> m3 s-2. real, dimension(SZI_(G)), intent(out) :: TKE !< The turbulent kinetic energy available for - !! mixing over a time step, in Z m2 s-2. + !! mixing over a time step, in Z m2 s-2 ~> m3 s-2. real, dimension(SZI_(G)), intent(out) :: Idecay_len_TKE !< The inverse of the vertical decay !! scale for TKE, in H-1. real, dimension(SZI_(G)), intent(in) :: TKE_river !< The turbulent kinetic energy available !! for driving mixing at river mouths - !! integrated over a time step, in Z m2 s-2. + !! integrated over a time step, in Z m2 s-2 ~> m3 s-2. real, dimension(2,SZI_(G)), intent(out) :: cMKE !< Coefficients of HpE and HpE^2 in !! calculating the denominator of MKE_rate, !! in H-1 and H-2. @@ -1343,22 +1343,22 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, ! convection to drive mechanical entrainment. ! Local variables - real :: dKE_conv ! The change in mean kinetic energy due to all convection, in Z m2 s-2. + real :: dKE_conv ! The change in mean kinetic energy due to all convection, in Z m2 s-2 ~> m3 s-2. real :: nstar_FC ! The effective efficiency with which the energy released by ! free convection is converted to TKE, often ~0.2, ND. real :: nstar_CA ! The effective efficiency with which the energy released by ! convective adjustment is converted to TKE, often ~0.2, ND. real :: TKE_CA ! The potential energy released by convective adjustment if - ! that release is positive, in Z m2 s2. + ! that release is positive, in Z m2 s-2 ~> m3 s-2. real :: MKE_rate_CA ! MKE_rate for convective adjustment, ND, 0 to 1. real :: MKE_rate_FC ! MKE_rate for free convection, ND, 0 to 1. real :: totEn_Z ! The total potential energy released by convection, Z3 s-2. real :: Ih ! The inverse of a thickness, in H-1. real :: exp_kh ! The nondimensional decay of TKE across a layer, ND. real :: absf ! The absolute value of f averaged to thickness points, s-1. - real :: U_star ! The friction velocity in Z s-1. - real :: absf_Ustar ! The absolute value of f divided by U_star, in Z-1. - real :: wind_TKE_src ! The surface wind source of TKE, in Z m2 s-3. + real :: U_star ! The friction velocity in Z s-1 ~> m s-1. + real :: absf_Ustar ! The absolute value of f divided by U_star, in Z-1 ~> m-1. + real :: wind_TKE_src ! The surface wind source of TKE, in Z m2 s-3 ~> m3 s-3. real :: diag_wt ! The ratio of the current timestep to the diagnostic ! timestep (which may include 2 calls), ND. integer :: is, ie, nz, i @@ -1544,7 +1544,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! The indicies of opacity_band are band, i, k. real, dimension(SZI_(G)), intent(inout) :: TKE !< The turbulent kinetic energy !! available for mixing over a time - !! step, in Z m2 s-2. + !! step, in Z m2 s-2 ~> m3 s-2. real, dimension(SZI_(G)), intent(inout) :: Idecay_len_TKE !< The vertical TKE decay rate, in H-1. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & @@ -1579,10 +1579,10 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: C1 ! A temporary variable in units of m2 s-2. real :: dMKE ! A temporary variable related to the release of mean ! kinetic energy, with units of H Z m2 s-2. - real :: TKE_ent ! The TKE that remains if h_ent were entrained, in Z m2 s-2. + real :: TKE_ent ! The TKE that remains if h_ent were entrained, in Z m2 s-2 ~> m3 s-2. real :: TKE_ent1 ! The TKE that would remain, without considering the - ! release of mean kinetic energy, in Z m2 s2. - real :: dTKE_dh ! The partial derivative of TKE with h_ent, in Z m2 s-2 H-1. + ! release of mean kinetic energy, in Z m2 s-2 ~> m3 s-2. + real :: dTKE_dh ! The partial derivative of TKE with h_ent, in Z m2 s-2 H-1 ~> m2 s-2 or m5 s-2 kg-1. real :: Pen_dTKE_dh_Contrib ! The penetrating shortwave contribution to ! dTKE_dh, in m2 s-2. real :: EF4_val ! The result of EF4() (see later), in H-1. @@ -2293,33 +2293,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! two buffer layers and may also move buffer layer water into the interior ! isopycnal layers. -! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out) The units of -! h are referred to as H below. Layer 0 is the new mixed layer. -! (in/out) T - Potential temperature, in C. -! (in/out) S - Salinity, in psu. -! (in/out) R0 - Potential density referenced to surface pressure, in kg m-3. -! (in/out) Rcv - The coordinate defining potential density, in kg m-3. -! (in) RcvTgt - The target value of Rcv for each layer, in kg m-3. -! (in) dt - Time increment, in s. -! (in) dt_diag - The diagnostic time step, in s. -! (in/out) d_ea - The upward increase across a layer in the entrainment from -! above, in m or kg m-2 (H). Positive d_ea goes with layer -! thickness increases. -! (in) j - The meridional row to work on. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! mixedlayer_init. -! (in) max_BL_det - If non-negative, the maximum detrainment permitted -! from the buffer layers, in H. -! (in) dR0_dT - The partial derivative of potential density referenced -! to the surface with potential temperature, in kg m-3 K-1. -! (in) dR0_dS - The partial derivative of cpotential density referenced -! to the surface with salinity, in kg m-3 psu-1. -! (in) dRcv_dT - The partial derivative of coordinate defining potential -! density with potential temperature, in kg m-3 K-1. -! (in) dRcv_dS - The partial derivative of coordinate defining potential -! density with salinity, in kg m-3 psu-1. + ! Local variables real :: h_to_bl ! The total thickness detrained to the buffer ! layers, in H (the units of h). real :: R0_to_bl, Rcv_to_bl ! The depth integrated amount of R0, Rcv, T @@ -2404,11 +2378,11 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! K psu-1 and psu K-1. real :: I_denom ! A work variable with units of psu2 m6 kg-2. - real :: G_2 ! 1/2 G_Earth, in m2 Z-1 s-2. - real :: Rho0xG ! Rho0 times G_Earth, in kg m-1 Z-1 s-2. + real :: G_2 ! 1/2 G_Earth, in m2 Z-1 s-2 ~> m s-2. + real :: Rho0xG ! Rho0 times G_Earth, in kg m-1 Z-1 s-2 ~> kg m-2 s-2. real :: I2Rho0 ! 1 / (2 Rho0), in m3 kg-1. - real :: Idt_H2 ! The square of the conversion from thickness - ! to Z divided by the time step in Z2 H-2 s-1. + real :: Idt_H2 ! The square of the conversion from thickness to Z + ! divided by the time step, in Z2 H-2 s-1 ~> s-1 or m6 kg-2 s-1. logical :: stable_Rcv ! If true, the buffer layers are stable with ! respect to the coordinate potential density. real :: h_neglect ! A thickness that is so small it is usually lost diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 161967c59a..0e7363e2aa 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -32,7 +32,7 @@ module MOM_diabatic_aux type, public :: diabatic_aux_CS ; private logical :: do_rivermix = .false. !< Provide additional TKE to mix river runoff at the !! river mouths to a depth of "rivermix_depth" - real :: rivermix_depth = 0.0 !< The depth to which rivers are mixed if do_rivermix = T, in Z. + real :: rivermix_depth = 0.0 !< The depth to which rivers are mixed if do_rivermix = T, in Z ~> m. logical :: reclaim_frazil !< If true, try to use any frazil heat deficit to !! to cool the topmost layer down to the freezing !! point. The default is false. @@ -239,7 +239,7 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) real :: b_denom_T ! The first term in the denominators for the expressions real :: b_denom_S ! for b1_T and b1_S, both in H. real, dimension(:,:,:), pointer :: T=>NULL(), S=>NULL() - real, dimension(:,:,:), pointer :: Kd_T=>NULL(), Kd_S=>NULL() ! Diffusivities in Z2 s-1. + real, dimension(:,:,:), pointer :: Kd_T=>NULL(), Kd_S=>NULL() ! Diffusivities in Z2 s-1 ~> m2 s-1. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -663,15 +663,15 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, ! Local variables real, dimension(SZI_(G)) :: deltaRhoAtKm1, deltaRhoAtK ! Density differences, in kg m-3. real, dimension(SZI_(G)) :: pRef_MLD, pRef_N2 ! Reference pressures in Pa. - real, dimension(SZI_(G)) :: dK, dKm1, d1 ! Depths in Z. + real, dimension(SZI_(G)) :: dK, dKm1, d1 ! Depths in Z ~> m. real, dimension(SZI_(G)) :: rhoSurf, rhoAtK, rho1 ! Densities used for N2, in kg m-3. - real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth, in Z. + real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth, in Z ~> m. real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML, in s-2. - real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2, in Z2. + real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2, in Z2 ~> m2. real :: Rho_x_gE ! The product of density, gravitational acceleartion and a unit ! conversion factor, in kg m-1 Z-1 s-2. real :: gE_Rho0 ! The gravitational acceleration divided by a mean density, in m4 s-2 kg-1. - real :: dz_subML ! Depth below ML over which to diagnose stratification, in Z. + real :: dz_subML ! Depth below ML over which to diagnose stratification, in Z ~> m. integer :: i, j, is, ie, js, je, k, nz, id_N2, id_SQ real :: aFac, ddRho @@ -793,7 +793,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & optional, intent(out) :: dSV_dS !< Partial derivative of specific volume with !! salinity, in m3 kg-1 / (g kg-1). real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface in Z2 s-3 + optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface, in Z2 s-3 ~> m2 s-3. ! Local variables integer, parameter :: maxGroundings = 5 @@ -829,7 +829,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & real :: Temp_in, Salin_in ! real :: I_G_Earth real :: g_Hconv2 - real :: GoRho ! g_Earth times a unit conversion factor divided by density, in Z m3 s-2 kg-1 + real :: GoRho ! g_Earth times a unit conversion factor divided by density, + ! in Z m3 s-2 kg-1 ~> m4 s-2 kg-1 logical :: calculate_energetics logical :: calculate_buoyancy integer :: i, j, is, ie, js, je, k, nz, n, nsw diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 4506177f41..644cff264a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -148,11 +148,11 @@ module MOM_diabatic_driver !! operating. real :: Kd_BBL_tr !< A bottom boundary layer tracer diffusivity that !! will allow for explicitly specified bottom fluxes - !! in Z2 s-1. The entrainment at the bottom is at + !! in Z2 s-1 ~> m2 s-1. The entrainment at the bottom is at !! least sqrt(Kd_BBL_tr*dt) over the same distance. real :: Kd_min_tr !< A minimal diffusivity that should always be !! applied to tracers, especially in massless layers - !! near the bottom, in Z2 s-1. + !! near the bottom, in Z2 s-1 ~> m2 s-1. real :: minimum_forcing_depth = 0.001 !< The smallest depth over which heat and freshwater !! fluxes are applied, in m. real :: evap_CFL_limit = 0.8 !< The largest fraction of a layer that can be @@ -386,7 +386,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & integer :: ig, jg ! global indices for testing testing itide point source (BDM) logical :: avg_enabled ! for testing internal tides (BDM) - real :: Kd_add_here ! An added diffusivity in Z2/s + real :: Kd_add_here ! An added diffusivity, in Z2 s-1 ~> m2 s-1. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -1269,7 +1269,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en integer :: ig, jg ! global indices for testing testing itide point source (BDM) logical :: avg_enabled ! for testing internal tides (BDM) - real :: Kd_add_here ! An added diffusivity in Z2/s + real :: Kd_add_here ! An added diffusivity, in Z2 s-1 ~> m2 s-1. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 4fbdc9d8c3..85bcd08e88 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -54,14 +54,14 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) !! in s. type(diapyc_energy_req_CS), pointer :: CS !< This module's control structure. real, dimension(G%isd:G%ied,G%jsd:G%jed,GV%ke+1), & - optional, intent(in) :: Kd_int !< Interface diffusivities in Z2 s-1. + optional, intent(in) :: Kd_int !< Interface diffusivities in Z2 s-1 ~> m2 s-1. ! Local variables real, dimension(GV%ke) :: & T0, S0, & ! T0 & S0 are columns of initial temperatures and salinities, in degC and g/kg. h_col ! h_col is a column of thicknesses h at tracer points, in H (m or kg m-2). real, dimension(GV%ke+1) :: & - Kd, & ! A column of diapycnal diffusivities at interfaces, in Z2 s-1. + Kd, & ! A column of diapycnal diffusivities at interfaces, in Z2 s-1 ~> m2 s-1. h_top, h_bot ! Distances from the top or bottom, in H. real :: ustar, absf, htot real :: energy_Kd ! The energy used by diapycnal mixing in W m-2. @@ -123,7 +123,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & real, dimension(GV%ke), intent(in) :: T_in !< The layer temperatures, in degC. real, dimension(GV%ke), intent(in) :: S_in !< The layer salinities, in g kg-1. real, dimension(GV%ke+1), intent(in) :: Kd !< The interfaces diapycnal diffusivities, - !! in Z2 s-1. + !! in Z2 s-1 ~> m2 s-1. real, intent(in) :: dt !< The amount of time covered by this call, in s. real, intent(out) :: energy_Kd !< The column-integrated rate of energy !! consumption by diapycnal diffusion, in W m-2. @@ -165,13 +165,13 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & dT_to_dPE, & ! Partial derivative of column potential energy with the temperature dS_to_dPE, & ! and salinity changes within a layer, in J m-2 K-1 and J m-2 / (g kg-1). dT_to_dColHt, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt, & ! and salinity changes within a layer, in Z K-1 and Z ppt-1. + dS_to_dColHt, & ! and salinity changes within a layer, in Z K-1 ~> m K-1 and Z ppt-1 ~> m ppt-1. dT_to_dColHt_a, & ! Partial derivatives of the total column height with the temperature dS_to_dColHt_a, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers higher in the water colun, in Z K-1 and Z ppt-1. + ! of mixing with layers higher in the water colun, in Z K-1 ~> m K-1 and Z ppt-1 ~> m ppt-1. dT_to_dColHt_b, & ! Partial derivatives of the total column height with the temperature dS_to_dColHt_b, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers lower in the water colun, in Z K-1 and Z ppt-1. + ! of mixing with layers lower in the water colun, in Z K-1 ~> m K-1 and Z ppt-1 ~> m ppt-1. dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature dS_to_dPE_a, & ! and salinity changes within a layer, including the implicit effects ! of mixing with layers higher in the water column, in @@ -1012,19 +1012,19 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real, intent(in) :: dT_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers above, in Z K-1. + !! in the temperatures of all the layers above, in Z K-1 ~> m K-1. real, intent(in) :: dS_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers above, in Z ppt-1. + !! in the salinities of all the layers above, in Z ppt-1 ~> m ppt-1. real, intent(in) :: dT_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers below, in Z K-1. + !! in the temperatures of all the layers below, in Z K-1 ~> m K-1. real, intent(in) :: dS_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers below, in Z ppt-1. + !! in the salinities of all the layers below, in Z ppt-1 ~> m ppt-1. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying !! Kddt_h at the present interface, in J m-2. @@ -1152,19 +1152,19 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & real, intent(in) :: dT_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers below, in Z K-1. + !! in the temperatures of all the layers below, in Z K-1 ~> m K-1. real, intent(in) :: dS_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers below, in Z ppt-1. + !! in the salinities of all the layers below, in Z ppt-1 ~> m ppt-1. real, intent(in) :: dT_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers above, in Z K-1. + !! in the temperatures of all the layers above, in Z K-1 ~> m K-1. real, intent(in) :: dS_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers above, in Z ppt-1. + !! in the salinities of all the layers above, in Z ppt-1 ~> m ppt-1. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying !! Kddt_h at the present interface, in J m-2. diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 9e32cd2aa9..88ef1c9a18 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -63,8 +63,8 @@ module MOM_energetic_PBL !! boundary layer thickness. The default is 0, but a !! value of 0.1 might be better justified by observations. real :: MLD_tol !< A tolerance for determining the boundary layer thickness when - !! Use_MLD_iteration is true, in Z. - real :: min_mix_len !< The minimum mixing length scale that will be used by ePBL, in Z. + !! Use_MLD_iteration is true, in Z ~> m. + real :: min_mix_len !< The minimum mixing length scale that will be used by ePBL, in Z ~> m. !! The default (0) does not set a minimum. real :: N2_Dissipation_Scale_Neg !< A nondimensional scaling factor controlling the loss of TKE !! due to enhanced dissipation in the presence of negative (unstable) @@ -146,8 +146,8 @@ module MOM_energetic_PBL diag_TKE_conv_decay, & !< The decay of convective TKE, in J m-2. diag_TKE_mixing,& !< The work done by TKE to deepen the mixed layer, in J m-2. ! Additional output parameters also 2d - ML_depth, & !< The mixed layer depth in Z. (result after iteration step) - ML_depth2, & !< The mixed layer depth in Z. (guess for iteration step) + ML_depth, & !< The mixed layer depth in Z ~> m. (result after iteration step) + ML_depth2, & !< The mixed layer depth in Z ~> m. (guess for iteration step) Enhance_M, & !< The enhancement to the turbulent velocity scale (non-dim) MSTAR_MIX, & !< Mstar used in EPBL MSTAR_LT, & !< Mstar for Langmuir turbulence @@ -212,11 +212,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, intent(in) :: dt !< Time increment, in s. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces, - !! in Z2 s-1. + !! in Z2 s-1 ~> m2 s-1. type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous !! call to mixedlayer_init. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: Buoy_Flux !< The surface buoyancy flux in Z2/s3. + intent(in) :: Buoy_Flux !< The surface buoyancy flux in Z2 s-3 ~> m2 s-3. real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less !! than dt if there are two callse to !! mixedlayer, in s. @@ -257,6 +257,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! For a traditional Kraus-Turner mixed layer, the values are: ! mstar = 1.25, nstar = 0.4, TKE_decay = 0.0, conv_decay = 0.0 + ! Local variables real, dimension(SZI_(G),SZK_(GV)) :: & h, & ! The layer thickness, in H (usually m or kg m-2). T, & ! The layer temperatures, in deg C. @@ -289,12 +290,12 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, dimension(SZI_(G),SZK_(GV)) :: & dT_to_dColHt, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt, & ! and salinity changes within a layer, in Z K-1 and Z ppt-1. + dS_to_dColHt, & ! and salinity changes within a layer, in Z K-1 ~> m K-1 and Z ppt-1 ~> m ppt-1. dT_to_dPE, & ! Partial derivatives of column potential energy with the temperature dS_to_dPE, & ! and salinity changes within a layer, in J m-2 K-1 and J m-2 ppt-1. dT_to_dColHt_a, & ! Partial derivatives of the total column height with the temperature dS_to_dColHt_a, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers higher in the water colun, in Z K-1 and Z ppt-1. + ! of mixing with layers higher in the water colun, in Z K-1 ~> m K-1 and Z ppt-1 ~> m ppt-1. dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature dS_to_dPE_a ! and salinity changes within a layer, including the implicit effects ! of mixing with layers higher in the water column, in @@ -339,9 +340,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: dt_h ! The timestep divided by the averages of the thicknesses around ! a layer, times a thickness conversion factor, in H s m-2. real :: h_bot ! The distance from the bottom, in H. - real :: h_rsum ! The running sum of h from the top, in Z. + real :: h_rsum ! The running sum of h from the top, in Z ~> m. real :: I_hs ! The inverse of h_sum, in H-1. - real :: I_MLD ! The inverse of the current value of MLD, in Z-1. + real :: I_MLD ! The inverse of the current value of MLD, in Z-1 ~> m-1. real :: h_tt ! The distance from the surface or up to the next interface ! that did not exhibit turbulent mixing from this scheme plus ! a surface mixing roughness length given by h_tt_min, in H. @@ -351,14 +352,14 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: vonKar ! The vonKarman constant. real :: I_dtrho ! 1.0 / (dt * Rho0) in m3 kg-1 s-1. This is ! used convert TKE back into ustar^3. - real :: U_star ! The surface friction velocity, in Z s-1. - real :: U_Star_Mean ! The surface friction without gustiness in Z s-1. + real :: U_star ! The surface friction velocity, in Z s-1 ~> m s-1. + real :: U_Star_Mean ! The surface friction without gustiness in Z s-1 ~> m s-1. real :: vstar ! An in-situ turbulent velocity, in m s-1. real :: Enhance_M ! An enhancement factor for vstar, based here on Langmuir impact. real :: LA ! The Langmuir number (non-dim) real :: LAmod ! A modified Langmuir number accounting for other parameters. real :: hbs_here ! The local minimum of hb_hs and MixLen_shape, times a - ! conversion factor from H to Z, in Z H-1. + ! conversion factor from H to Z, in Z H-1 ~> 1 or m3 kg-1. real :: nstar_FC ! The fraction of conv_PErel that can be converted to mixing, nondim. real :: TKE_reduc ! The fraction by which TKE and other energy fields are ! reduced to support mixing, nondim. between 0 and 1. @@ -377,7 +378,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: dPE_conv ! The convective change in column potential energy, in J m-2. real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K), in J m-2. real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K), in J m-2 H-1. - real :: Kd_guess0 ! A first guess of the diapycnal diffusivity, in Z2 s-1. + real :: Kd_guess0 ! A first guess of the diapycnal diffusivity, in Z2 s-1 ~> m2 s-1. real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 real :: dPEa_dKd_g0 real :: Kddt_h_g0 ! The first guess diapycnal diffusivity times a timestep divided @@ -410,7 +411,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: dt__diag ! A copy of dt_diag (if present) or dt, in s. real :: IdtdR0 ! = 1.0 / (dt__diag * Rho0), in m3 kg-1 s-1. real, dimension(SZI_(G),SZJ_(G)) :: & - Hsfc_used ! The thickness of the surface region in Z + Hsfc_used ! The thickness of the surface region in Z ~> m. logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. ! Local column copies of energy change diagnostics, all in J m-2. @@ -419,8 +420,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS !---------------------------------------------------------------------- !/BGR added Aug24,2016 for adding iteration to get boundary layer depth ! - needed to compute new mixing length. - real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration, in Z. - real :: max_MLD, min_MLD ! Iteration bounds, in Z, which are adjusted at each step + real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration, in Z ~> m. + real :: max_MLD, min_MLD ! Iteration bounds, in Z ~> m, which are adjusted at each step ! - These are initialized based on surface/bottom ! 1. The iteration guesses a value (possibly from ! prev step or neighbor). @@ -470,9 +471,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: N2_dissipation real :: Bf_STABLE ! Buoyancy flux, capped at 0 (negative only) real :: Bf_UNSTABLE ! Buoyancy flux, floored at 0 (positive only) - real :: Stab_Scale ! Composite of stabilizing Ekman scale and Monin-Obukhov length scales, in Z - real :: iL_Ekman ! Inverse of Ekman length scale, in Z-1 - real :: iL_Obukhov ! Inverse of Obukhov length scale, in Z-1 + real :: Stab_Scale ! Composite of stabilizing Ekman scale and Monin-Obukhov length scales, in Z ~> m. + real :: iL_Ekman ! Inverse of Ekman length scale, in Z-1 ~> m-1. + real :: iL_Obukhov ! Inverse of Obukhov length scale, in Z-1 ~> m-1. real :: MLD_o_Ekman ! > real :: MLD_o_Obukhov_stab ! Ratios of length scales where MLD is boundary layer depth real :: Ekman_o_Obukhov_stab ! > @@ -1597,19 +1598,19 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real, intent(in) :: dT_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers above, in Z K-1. + !! in the temperatures of all the layers above, in Z K-1 ~> m K-1. real, intent(in) :: dS_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers above, in Z ppt-1. + !! in the salinities of all the layers above, in Z ppt-1 ~> m ppt-1. real, intent(in) :: dT_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers below, in Z K-1. + !! in the temperatures of all the layers below, in Z K-1 ~> m K-1. real, intent(in) :: dS_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers below, in Z ppt-1. + !! in the salinities of all the layers below, in Z ppt-1 ~> m ppt-1. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying !! Kddt_h at the present interface, in J m-2. @@ -1736,19 +1737,19 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & real, intent(in) :: dT_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers below, in Z K-1. + !! in the temperatures of all the layers below, in Z K-1 ~> m K-1. real, intent(in) :: dS_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers below, in Z ppt-1. + !! in the salinities of all the layers below, in Z ppt-1 ~> m ppt-1. real, intent(in) :: dT_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers above, in Z K-1. + !! in the temperatures of all the layers above, in Z K-1 ~> m K-1. real, intent(in) :: dS_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers above, in Z ppt-1. + !! in the salinities of all the layers above, in Z ppt-1 ~> m ppt-1. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying !! Kddt_h at the present interface, in J m-2. diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index af9eb9bfba..dd00a28f85 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -75,10 +75,10 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, ! At least one of the two following arguments must be present. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: Kd_Lay !< The diapycnal diffusivity of layers, - !! in Z2 s-1. + !! in Z2 s-1 ~> m2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(in) :: Kd_int !< The diapycnal diffusivity of interfaces, - !! in Z2 s-1. + !! in Z2 s-1 ~> m2 s-1. ! This subroutine calculates ea and eb, the rates at which a layer entrains ! from the layers above and below. The entrainment rates are proportional to diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index c2b303426b..d0e31f1a1b 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -47,7 +47,7 @@ module MOM_int_tide_input type, public :: int_tide_input_type real, allocatable, dimension(:,:) :: & TKE_itidal_input, & !< The internal tide TKE input at the bottom of the ocean, in W m-2. - h2, & !< The squared topographic roughness height, in Z2. + h2, & !< The squared topographic roughness height, in Z2 ~> m2. tideamp, & !< The amplitude of the tidal velocities, in m s-1. Nb !< The bottom stratification, in s-1. end type int_tide_input_type @@ -131,7 +131,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) !! smooth out the values in thin layers, in degC. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_f !< Salinity after vertical filtering to !! smooth out the values in thin layers, in PSU. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h2 !< Bottom topographic roughness, in Z2 + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h2 !< Bottom topographic roughness, in Z2 ~> m2. type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes type(int_tide_input_CS), pointer :: CS !< This module's control structure. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: N2_bot !< The squared buoyancy freqency at the @@ -144,15 +144,15 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) Temp_int, & ! The temperature at each interface, in degC. Salin_int, & ! The salinity at each interface, in PSU. drho_bot, & - h_amp, & ! The amplitude of topographic roughness, in Z. - hb, & ! The depth below a layer, in Z. - z_from_bot, & ! The height of a layer center above the bottom, in Z. + h_amp, & ! The amplitude of topographic roughness, in Z ~> m. + hb, & ! The depth below a layer, in Z ~> m. + z_from_bot, & ! The height of a layer center above the bottom, in Z ~> m. dRho_dT, & ! The partial derivatives of density with temperature and dRho_dS ! salinity, in kg m-3 degC-1 and kg m-3 PSU-1. - real :: dz_int ! The thickness associated with an interface, in Z. + real :: dz_int ! The thickness associated with an interface, in Z ~> m. real :: G_Rho0 ! The gravitation acceleration divided by the Boussinesq - ! density, in Z m3 s-2 kg-1. + ! density, in Z m3 s-2 kg-1 ~> m4 s-2 kg-1. logical :: do_i(SZI_(G)), do_any integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -259,7 +259,7 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) ! tidal amplitude file is not present. real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height. real :: kappa_itides ! topographic wavenumber and non-dimensional scaling - real :: min_zbot_itides ! Minimum ocean depth for internal tide conversion, in Z. + real :: min_zbot_itides ! Minimum ocean depth for internal tide conversion, in Z ~> m. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed if (associated(CS)) then diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 525dfb1cb0..9af56ebe67 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -51,7 +51,7 @@ module MOM_kappa_shear !! the buoyancy and shear scales in the diffusivity !! equation, 0 to eliminate the shear scale. Nondim. real :: TKE_bg !< The background level of TKE, in m2 s-2. - real :: kappa_0 !< The background diapycnal diffusivity, in Z2 s-1. + real :: kappa_0 !< The background diapycnal diffusivity, in Z2 s-1 ~> m2 s-1. real :: kappa_tol_err !< The fractional error in kappa that is tolerated. real :: Prandtl_turb !< Prandtl number used to convert Kd_shear into viscosity. integer :: nkml !< The number of layers in the mixed layer, as @@ -105,7 +105,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & !! (or NULL). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: kappa_io !< The diapycnal diffusivity at each interface - !! (not layer!) in Z2 s-1. Initially this is the + !! (not layer!) in Z2 s-1 ~> m2 s-1. Initially this is the !! value from the previous timestep, which may !! accelerate the iteration toward convergence. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & @@ -116,7 +116,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & !! toward convergence. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: kv_io !< The vertical viscosity at each interface - !! (not layer!) in Z2 s-1. This discards any + !! (not layer!) in Z2 s-1 ~> m2 s-1. This discards any !! previous value (i.e. it is intent out) and !! simply sets Kv = Prandtl * Kd_shear real, intent(in) :: dt !< Time increment, in s. @@ -134,27 +134,27 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & real, dimension(SZK_(GV)) :: & u, & ! The zonal velocity after a timestep of mixing, in m s-1. v, & ! The meridional velocity after a timestep of mixing, in m s-1. - Idz, & ! The inverse of the distance between TKE points, in Z-1. + Idz, & ! The inverse of the distance between TKE points, in Z-1 ~> m-1. T, & ! The potential temperature after a timestep of mixing, in C. Sal, & ! The salinity after a timestep of mixing, in psu. - dz, & ! The layer thickness, in Z. - u0xdz, & ! The initial zonal velocity times dz, in Z m s-1. - v0xdz, & ! The initial meridional velocity times dz, in Z m s-1. - T0xdz, & ! The initial temperature times dz, in C Z. - S0xdz ! The initial salinity times dz, in PSU Z. + dz, & ! The layer thickness, in Z ~> m. + u0xdz, & ! The initial zonal velocity times dz, in Z m s-1 ~> m2 s-1. + v0xdz, & ! The initial meridional velocity times dz, in Z m s-1 ~> m2 s-1. + T0xdz, & ! The initial temperature times dz, in C Z ~> C m. + S0xdz ! The initial salinity times dz, in PSU Z ~> PSU m. real, dimension(SZK_(GV)+1) :: & kappa, & ! The shear-driven diapycnal diffusivity at an interface, in - ! units of Z2 s-1. + ! units of Z2 s-1 ~> m2 s-1. tke, & ! The Turbulent Kinetic Energy per unit mass at an interface, ! in units of m2 s-2. - kappa_avg, & ! The time-weighted average of kappa, in Z2 s-1. + kappa_avg, & ! The time-weighted average of kappa, in Z2 s-1 ~> m2 s-1. tke_avg ! The time-weighted average of TKE, in m2 s-2. real :: f2 ! The squared Coriolis parameter of each column, in s-2. real :: surface_pres ! The top surface pressure, in Pa. - real :: dz_in_lay ! The running sum of the thickness in a layer, in Z. - real :: k0dt ! The background diffusivity times the timestep, in Z2. - real :: dz_massless ! A layer thickness that is considered massless, in Z. + real :: dz_in_lay ! The running sum of the thickness in a layer, in Z ~> m. + real :: k0dt ! The background diffusivity times the timestep, in Z2 ~> m2. + real :: dz_massless ! A layer thickness that is considered massless, in Z ~> m. logical :: use_temperature ! If true, temperature and salinity have been ! allocated and are being used as state variables. logical :: new_kappa = .true. ! If true, ignore the value of kappa from the @@ -398,7 +398,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ !! (or NULL). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: kappa_io !< The diapycnal diffusivity at each interface - !! (not layer!) in Z2 s-1. + !! (not layer!) in Z2 s-1 ~> m2 s-1. real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & intent(inout) :: tke_io !< The turbulent kinetic energy per unit mass at !! each interface (not layer!) in m2 s-2. @@ -406,7 +406,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ !! timestep, which may accelerate the iteration !! toward convergence. real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & - intent(inout) :: kv_io !< The vertical viscosity at each interface in Z2 s-1. + intent(inout) :: kv_io !< The vertical viscosity at each interface in Z2 s-1 ~> m2 s-1. !! The previous value is used to initialize kappa !! in the vertex columes as Kappa = Kv/Prandtl !! to accelerate the iteration toward covergence. @@ -421,16 +421,16 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ h_2d, & ! A 2-D version of h, but converted to m. u_2d, v_2d, T_2d, S_2d, rho_2d ! 2-D versions of u_in, v_in, T, S, and rho. real, dimension(SZIB_(G),SZK_(GV)+1,2) :: & - kappa_2d ! Quasi 2-D versions of kappa_io, in Z2 s-1. + kappa_2d ! Quasi 2-D versions of kappa_io, in Z2 s-1 ~> m2 s-1. real, dimension(SZIB_(G),SZK_(GV)+1) :: & tke_2d ! 2-D version tke_io in m2 s-2. real, dimension(SZK_(GV)) :: & u, & ! The zonal velocity after a timestep of mixing, in m s-1. v, & ! The meridional velocity after a timestep of mixing, in m s-1. - Idz, & ! The inverse of the distance between TKE points, in Z-1. + Idz, & ! The inverse of the distance between TKE points, in Z-1 ~> m-1. T, & ! The potential temperature after a timestep of mixing, in C. Sal, & ! The salinity after a timestep of mixing, in psu. - dz, & ! The layer thickness, in Z. + dz, & ! The layer thickness, in Z ~> m. u0xdz, & ! The initial zonal velocity times dz, in m Z s-1. v0xdz, & ! The initial meridional velocity times dz, in m Z s-1. T0xdz, & ! The initial temperature times dz, in C Z. @@ -440,14 +440,14 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! units of m2 s-1. tke, & ! The Turbulent Kinetic Energy per unit mass at an interface, ! in units of m2 s-2. - kappa_avg, & ! The time-weighted average of kappa, in Z2 s-1. + kappa_avg, & ! The time-weighted average of kappa, in Z2 s-1 ~> m2 s-1. tke_avg ! The time-weighted average of TKE, in m2 s-2. real :: f2 ! The squared Coriolis parameter of each column, in s-2. real :: surface_pres ! The top surface pressure, in Pa. - real :: dz_in_lay ! The running sum of the thickness in a layer, in Z. - real :: k0dt ! The background diffusivity times the timestep, in Z2. - real :: dz_massless ! A layer thickness that is considered massless, in Z. + real :: dz_in_lay ! The running sum of the thickness in a layer, in Z ~> m. + real :: k0dt ! The background diffusivity times the timestep, in Z2 ~> m2. + real :: dz_massless ! A layer thickness that is considered massless, in Z ~> m. real :: I_hwt ! The inverse of the masked thickness weights, in H-1. real :: I_Prandtl logical :: use_temperature ! If true, temperature and salinity have been @@ -714,7 +714,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)+1), & - intent(inout) :: kappa !< The time-weighted average of kappa, in Z2 s-1. + intent(inout) :: kappa !< The time-weighted average of kappa, in Z2 s-1 ~> m2 s-1. real, dimension(SZK_(GV)+1), & intent(inout) :: tke !< The Turbulent Kinetic Energy per unit mass at !! an interface, in units of m2 s-2. @@ -722,17 +722,17 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real, intent(in) :: f2 !< The square of the Coriolis parameter, in s-2. real, intent(in) :: surface_pres !< The surface pressure, in Pa. real, dimension(SZK_(GV)), & - intent(in) :: dz !< The layer thickness, in Z. + intent(in) :: dz !< The layer thickness, in Z ~> m. real, dimension(SZK_(GV)), & - intent(in) :: u0xdz !< The initial zonal velocity times dz, in Z m s-1. + intent(in) :: u0xdz !< The initial zonal velocity times dz, in Z m s-1 ~> m2 s-1. real, dimension(SZK_(GV)), & - intent(in) :: v0xdz !< The initial meridional velocity times dz, in Z m s-1. + intent(in) :: v0xdz !< The initial meridional velocity times dz, in Z m s-1 ~> m2 s-1. real, dimension(SZK_(GV)), & - intent(in) :: T0xdz !< The initial temperature times dz, in C Z. + intent(in) :: T0xdz !< The initial temperature times dz, in C Z ~> C m. real, dimension(SZK_(GV)), & - intent(in) :: S0xdz !< The initial salinity times dz, in PSU Z. + intent(in) :: S0xdz !< The initial salinity times dz, in PSU Z ~> PSU m. real, dimension(SZK_(GV)+1), & - intent(out) :: kappa_avg !< The time-weighted average of kappa, in Z2 s-1. + intent(out) :: kappa_avg !< The time-weighted average of kappa, in Z2 s-1 ~> m2 s-1. real, dimension(SZK_(GV)+1), & intent(out) :: tke_avg !< The time-weighted average of TKE, in m2 s-2. real, intent(in) :: dt !< Time increment, in s. @@ -745,7 +745,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real, dimension(nzc) :: & u, & ! The zonal velocity after a timestep of mixing, in m s-1. v, & ! The meridional velocity after a timestep of mixing, in m s-1. - Idz, & ! The inverse of the distance between TKE points, in Z-1. + Idz, & ! The inverse of the distance between TKE points, in Z-1 ~> m-1. T, & ! The potential temperature after a timestep of mixing, in C. Sal, & ! The salinity after a timestep of mixing, in psu. u_test, v_test, T_test, S_test @@ -753,46 +753,46 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real, dimension(nzc+1) :: & N2, & ! The squared buoyancy frequency at an interface, in s-2. dz_Int, & ! The extent of a finite-volume space surrounding an interface, - ! as used in calculating kappa and TKE, in Z. + ! as used in calculating kappa and TKE, in Z ~> m. I_dz_int, & ! The inverse of the distance between velocity & density points - ! above and below an interface, in Z-1. This is used to + ! above and below an interface, in Z-1 ~> m-1. This is used to ! calculate N2, shear, and fluxes, and it might differ from ! 1/dz_Int, as they have different uses. S2, & ! The squared shear at an interface, in s-2. a1, & ! a1 is the coupling between adjacent interfaces in the TKE, - ! velocity, and density equations, in Z s-1 or Z. + ! velocity, and density equations, in Z s-1 or Z ~> m s-1 or m. c1, & ! c1 is used in the tridiagonal (and similar) solvers. k_src, & ! The shear-dependent source term in the kappa equation, in s-1. kappa_src, & ! The shear-dependent source term in the kappa equation in s-1. - kappa_out, & ! The kappa that results from the kappa equation, in Z2 s-1. + kappa_out, & ! The kappa that results from the kappa equation, in Z2 s-1 ~> m2 s-1. kappa_mid, & ! The average of the initial and predictor estimates of kappa, ! in units of Z2 s-1. tke_pred, & ! The value of TKE from a predictor step, in m2 s-2. - kappa_pred, & ! The value of kappa from a predictor step, in Z2 s-1. + kappa_pred, & ! The value of kappa from a predictor step, in Z2 s-1 ~> m2 s-1. pressure, & ! The pressure at an interface, in Pa. T_int, & ! The temperature interpolated to an interface, in C. Sal_int, & ! The salinity interpolated to an interface, in psu. - dbuoy_dT, & ! The partial derivatives of buoyancy with changes in - dbuoy_dS, & ! temperature and salinity, in Z s-2 K-1 and Z s-2 psu-1. + dbuoy_dT, & ! The partial derivatives of buoyancy with changes in temperature + dbuoy_dS, & ! and salinity, in Z s-2 K-1 ~> m s-2 K-1 and Z s-2 psu-1 ~> m s-2 psu-1. I_L2_bdry, & ! The inverse of the square of twice the harmonic mean - ! distance to the top and bottom boundaries, in Z-2. - K_Q, & ! Diffusivity divided by TKE, in Z2 m-2 s. - K_Q_tmp, & ! A temporary copy of diffusivity divided by TKE, in Z2 m-2 s. + ! distance to the top and bottom boundaries, in Z-2 ~> m-2. + K_Q, & ! Diffusivity divided by TKE, in Z2 m-2 s ~> s. + K_Q_tmp, & ! A temporary copy of diffusivity divided by TKE, in Z2 m-2 s ~> s. local_src_avg, & ! The time-integral of the local source, nondim. tol_min, & ! Minimum tolerated ksrc for the corrector step, in s-1. tol_max, & ! Maximum tolerated ksrc for the corrector step, in s-1. tol_chg, & ! The tolerated change integrated in time, nondim. - dist_from_top, & ! The distance from the top surface, in Z. + dist_from_top, & ! The distance from the top surface, in Z ~> m. local_src ! The sum of all sources of kappa, including kappa_src and ! sources from the elliptic term, in s-1. - real :: dist_from_bot ! The distance from the bottom surface, in Z. + real :: dist_from_bot ! The distance from the bottom surface, in Z ~> m. real :: b1 ! The inverse of the pivot in the tridiagonal equations. real :: bd1 ! A term in the denominator of b1. real :: d1 ! 1 - c1 in the tridiagonal equations. real :: gR0 ! Rho_0 times g in kg m-2 s-2. - real :: g_R0 ! g_R0 is g/Rho in Z m3 kg-1 s-2. - real :: Norm ! A factor that normalizes two weights to 1, in Z-2. + real :: g_R0 ! g_R0 is g/Rho in Z m3 kg-1 s-2 ~> m4 kg-1 s-2. + real :: Norm ! A factor that normalizes two weights to 1, in Z-2 ~> m-2. real :: tol_dksrc, tol2 ! ### Tolerances that need to be set better later. real :: tol_dksrc_low ! The tolerance for the fractional decrease in ksrc ! within an iteration. 0 < tol_dksrc_low < 1. @@ -806,7 +806,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real :: Idtt ! Idtt = 1 / dt_test, in s-1. real :: dt_inc ! An increment to dt_test that is being tested, in s. - real :: k0dt ! The background diffusivity times the timestep, in Z2. + real :: k0dt ! The background diffusivity times the timestep, in Z2 ~> m2. logical :: valid_dt ! If true, all levels so far exhibit acceptably small ! changes in k_src. logical :: use_temperature ! If true, temperature and salinity have been @@ -1234,18 +1234,18 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & integer, intent(in) :: nz !< The number of layers (after eliminating massless !! layers?). real, dimension(nz+1), intent(in) :: kappa !< The diapycnal diffusivity at interfaces, - !! in Z2 s-1. + !! in Z2 s-1 ~> m2 s-1. real, dimension(nz), intent(in) :: u0 !< The initial zonal velocity, in m s-1. real, dimension(nz), intent(in) :: v0 !< The initial meridional velocity, in m s-1. real, dimension(nz), intent(in) :: T0 !< The initial temperature, in C. real, dimension(nz), intent(in) :: S0 !< The initial salinity, in PSU. - real, dimension(nz), intent(in) :: dz !< The grid spacing of layers, in Z. + real, dimension(nz), intent(in) :: dz !< The grid spacing of layers, in Z ~> m. real, dimension(nz+1), intent(in) :: I_dz_int !< The inverse of the layer's thicknesses, - !! in Z-1. + !! in Z-1 ~> m-1. real, dimension(nz+1), intent(in) :: dbuoy_dT !< The partial derivative of buoyancy with - !! temperature, in Z s-2 C-1. + !! temperature, in Z s-2 C-1 ~> m s-2 C-1. real, dimension(nz+1), intent(in) :: dbuoy_dS !< The partial derivative of buoyancy with - !! salinity, in Z s-2 PSU-1. + !! salinity, in Z s-2 PSU-1 ~> m s-2 PSU-1. real, intent(in) :: dt !< The time step in s. real, dimension(nz), intent(inout) :: u !< The zonal velocity after dt, in m s-1. real, dimension(nz), intent(inout) :: v !< The meridional velocity after dt, in m s-1. @@ -1268,7 +1268,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & ! Local variables real, dimension(nz+1) :: c1 real :: L2_to_Z2 ! A conversion factor from horizontal length units to vertical depth - ! units squared, in Z2 m-2. + ! units squared, in Z2 m-2 ~> 1. real :: underflow_vel ! Velocities smaller in magnitude than underflow_vel are set to 0, in m s-1. real :: a_a, a_b, b1, d1, bd1, b1nz_0 integer :: k, ks, ke @@ -1374,12 +1374,12 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & !! in s-2. real, dimension(nz+1), intent(in) :: S2 !< The squared shear at interfaces, in s-2. real, dimension(nz+1), intent(in) :: kappa_in !< The initial guess at the diffusivity, - !! in Z2 s-1. + !! in Z2 s-1 ~> m2 s-1. real, dimension(nz+1), intent(in) :: dz_Int !< The thicknesses associated with interfaces, - !! in Z-1. + !! in Z-1 ~> m-1. real, dimension(nz+1), intent(in) :: I_L2_bdry !< The inverse of the squared distance to !! boundaries, m2. - real, dimension(nz), intent(in) :: Idz !< The inverse grid spacing of layers, in Z-1. + real, dimension(nz), intent(in) :: Idz !< The inverse grid spacing of layers, in Z-1 ~> m-1. real, intent(in) :: f2 !< The squared Coriolis parameter, in s-2. type(Kappa_shear_CS), pointer :: CS !< A pointer to this module's control structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -1390,7 +1390,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real, dimension(nz+1), intent(out) :: tke !< The turbulent kinetic energy per unit mass at !! interfaces, in units of m2 s-2. real, dimension(nz+1), intent(out) :: kappa !< The diapycnal diffusivity at interfaces, - !! in Z2 s-1. + !! in Z2 s-1 ~> m2 s-1. real, dimension(nz+1), optional, & intent(out) :: kappa_src !< The source term for kappa, in s-1. real, dimension(nz+1), optional, & @@ -1404,7 +1404,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! equations, in m s-1. dQdz ! Half the partial derivative of TKE with depth, m s-2. real, dimension(nz+1) :: & - dK, & ! The change in kappa, in Z2 s-1. + dK, & ! The change in kappa, in Z2 s-1 ~> m2 s-1. dQ, & ! The change in TKE, in m2 s-2. cQ, cK, & ! cQ and cK are the upward influences in the tridiagonal and ! hexadiagonal solvers for the TKE and kappa equations, ND. @@ -1421,7 +1421,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! and stratification, in m2 s-3. (For convenience, ! a term involving the non-dissipation of q0 is also ! included here.) - real :: bQ, bK ! The inverse of the pivot in the tridiagonal equations, in Z-1. + real :: bQ, bK ! The inverse of the pivot in the tridiagonal equations, in Z-1 ~> m-1. real :: bd1 ! A term in the denominator of bQ or bK. real :: cQcomp, cKcomp ! 1 - cQ or 1 - cK in the tridiagonal equations. real :: c_s2 ! The coefficient for the decay of TKE due to @@ -1434,7 +1434,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real :: Ilambda2 ! 1.0 / CS%lambda**2. real :: TKE_min ! The minimum value of shear-driven TKE that can be ! solved for, in m2 s-2. - real :: kappa0 ! The background diapycnal diffusivity, in Z2 s-1. + real :: kappa0 ! The background diapycnal diffusivity, in Z2 s-1 ~> m2 s-1. real :: max_err ! The maximum value of norm_err in a column, nondim. real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0, Z2 s-1. @@ -1443,7 +1443,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real :: chg_by_k0 ! The value of k_src that leads to an increase of ! kappa_0 if only the diffusive term is a sink, in s-1. - real :: kappa_mean ! A mean value of kappa, in Z2 s-1. + real :: kappa_mean ! A mean value of kappa, in Z2 s-1 ~> m2 s-1. real :: Newton_test ! The value of relative error that will cause the next ! iteration to use Newton's method. ! Temporary variables used in the Newton's method iterations. @@ -1478,7 +1478,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & integer :: max_debug_itt ; parameter(max_debug_itt=20) real :: K_err_lin, Q_err_lin real, dimension(nz+1) :: & - kappa_prev, & ! The value of kappa at the start of the current iteration, in Z2 s-1. + kappa_prev, & ! The value of kappa at the start of the current iteration, in Z2 s-1 ~> m2 s-1. TKE_prev ! The value of TKE at the start of the current iteration, in m2 s-2. real, dimension(nz+1,1:max_debug_itt) :: & tke_it1, kappa_it1, kprev_it1, & ! Various values from each iteration. @@ -1577,7 +1577,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! terms. ke_tke = max(ke_kappa,ke_kappa_prev)+1 - ! aQ is the coupling between adjacent interfaces in Z s-1. + ! aQ is the coupling between adjacent interfaces in Z s-1 ~> m s-1. do k=1,min(ke_tke,nz) aQ(k) = (0.5*(kappa(K)+kappa(K+1)) + kappa0) * Idz(k) enddo diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 79ba2914f5..031b47ed5f 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -69,15 +69,15 @@ module MOM_set_diffusivity !! by bottom drag drives BBL diffusion (nondim) real :: cdrag !< quadratic drag coefficient (nondim) real :: IMax_decay !< inverse of a maximum decay scale for - !! bottom-drag driven turbulence, (1/Z) - real :: Kv !< The interior vertical viscosity (Z2/s) - real :: Kd !< interior diapycnal diffusivity (Z2/s) - real :: Kd_min !< minimum diapycnal diffusivity (Z2/s) - real :: Kd_max !< maximum increment for diapycnal diffusivity (Z2/s) + !! bottom-drag driven turbulence, in Z-1 ~> m-1. + real :: Kv !< The interior vertical viscosity, in Z2 s-1 ~> m2 s-1. + real :: Kd !< interior diapycnal diffusivity, in Z2 s-1 ~> m2 s-1. + real :: Kd_min !< minimum diapycnal diffusivity, in Z2 s-1 ~> m2 s-1. + real :: Kd_max !< maximum increment for diapycnal diffusivity, in Z2 s-1 ~> m2 s-1. !! Set to a negative value to have no limit. real :: Kd_add !< uniform diffusivity added everywhere without - !! filtering or scaling (Z2/s) - real :: Kdml !< mixed layer diapycnal diffusivity (Z2/s) + !! filtering or scaling, in Z2 s-1 ~> m2 s-1. + real :: Kdml !< mixed layer diapycnal diffusivity, in Z2 s-1 ~> m2 s-1. !! when bulkmixedlayer==.false. real :: Hmix !< mixed layer thickness (meter) when !! bulkmixedlayer==.false. @@ -85,11 +85,11 @@ module MOM_set_diffusivity logical :: limit_dissipation !< If enabled, dissipation is limited to be larger !! than the following: - real :: dissip_min !< Minimum dissipation (Z2 m-2 W m-3) - real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N (Z2 m-2 W m-3) - real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N (Z2 m-2 W m-3 s) - real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 (Z2 m-2 W m-3 s2) - real :: dissip_Kd_min !< Minimum Kd (Z2/s) with dissipation Rho0*Kd_min*N^2 + real :: dissip_min !< Minimum dissipation (Z2 m-2 W m-3 ~> W m-3) + real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N (Z2 m-2 W m-3 ~> W m-3) + real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N (Z2 m-2 W m-3 s ~> J m-3) + real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 (Z2 m-2 W m-3 s2 ~> J s m-3) + real :: dissip_Kd_min !< Minimum Kd, in Z2 s-1 ~> m2 s-1, with dissipation Rho0*Kd_min*N^2 real :: TKE_itide_max !< maximum internal tide conversion (W m-2) !! available to mix above the BBL @@ -108,7 +108,7 @@ module MOM_set_diffusivity !! where N2 is the squared buoyancy frequency (s-2) and OMEGA2 !! is the rotation rate of the earth squared. real :: ML_rad_kd_max !< Maximum diapycnal diffusivity due to turbulence - !! radiated from the base of the mixed layer (Z2/s) + !! radiated from the base of the mixed layer, in Z2 s-1 ~> m2 s-1. real :: ML_rad_efold_coeff !< non-dim coefficient to scale penetration depth real :: ML_rad_coeff !< coefficient, which scales MSTAR*USTAR^3 to !! obtain energy available for mixing below @@ -117,7 +117,7 @@ module MOM_set_diffusivity !! to ML_rad as applied to the other surface !! sources of TKE in the mixed layer code. real :: ustar_min !< A minimum value of ustar to avoid numerical - !! problems (Z/s). If the value is small enough, + !! problems, in Z s-1 ~> m s-1. If the value is small enough, !! this parameter should not affect the solution. real :: TKE_decay !< ratio of natural Ekman depth to TKE decay scale (nondim) real :: mstar !< ratio of friction velocity cubed to @@ -171,12 +171,12 @@ module MOM_set_diffusivity Kd_BBL => NULL(), & !< BBL diffusivity at interfaces (m2/s) Kd_work => NULL(), & !< layer integrated work by diapycnal mixing (W/m2) maxTKE => NULL(), & !< energy required to entrain to h_max (m3/s3) - KT_extra => NULL(), & !< double diffusion diffusivity for temp (Z2/s) - KS_extra => NULL() !< double diffusion diffusivity for saln (Z2/s) + KT_extra => NULL(), & !< double diffusion diffusivity for temp, in Z2 s-1 ~> m2 s-1. + KS_extra => NULL() !< double diffusion diffusivity for saln, in Z2 s-1 ~> m2 s-1. real, pointer, dimension(:,:,:) :: TKE_to_Kd => NULL() - !< conversion rate (~1.0 / (G_Earth + dRho_lay)) - !! between TKE dissipated within a layer and Kd - !! in that layer, in Z2 s-1 / m3 s-3 = Z2 s2 m-3 + !< conversion rate (~1.0 / (G_Earth + dRho_lay)) between TKE + !! dissipated within a layer and Kd in that layer, + !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1 end type diffusivity_diags @@ -679,7 +679,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 + !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1 real, dimension(SZI_(G),SZK_(G)), intent(out) :: maxTKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness, in m3 s-3 integer, dimension(SZI_(G)), intent(out) :: kb !< Index of lightest layer denser than the buffer @@ -696,19 +696,19 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & maxEnt ! maxEnt is the maximum value of entrainment from below (with ! compensating entrainment from above to keep the layer ! density from changing) that will not deplete all of the - ! layers above or below a layer within a timestep (Z) + ! layers above or below a layer within a timestep, in Z ~> m. real, dimension(SZI_(G)) :: & htot, & ! total thickness above or below a layer, or the - ! integrated thickness in the BBL (Z) + ! integrated thickness in the BBL, in Z ~> m. mFkb, & ! total thickness in the mixed and buffer layers - ! times ds_dsp1 (Z) + ! times ds_dsp1, in Z ~> m. p_ref, & ! array of tv%P_Ref pressures Rcv_kmb, & ! coordinate density in the lowest buffer layer p_0 ! An array of 0 pressures real :: dh_max ! maximum amount of entrainment a layer could ! undergo before entraining all fluid in the layers - ! above or below (Z) + ! above or below, in Z ~> m. real :: dRho_lay ! density change across a layer (kg/m3) real :: Omega2 ! rotation rate squared (1/s2) real :: G_Rho0 ! gravitation accel divided by Bouss ref density (m4 s-2 kg-1) @@ -900,14 +900,14 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & Temp_int, & ! temperature at each interface (degC) Salin_int, & ! salinity at each interface (PPT) drho_bot, & - h_amp, & ! The topographic roughness amplitude, in Z. - hb, & ! The thickness of the bottom layer in Z - z_from_bot ! The hieght above the bottom in Z + h_amp, & ! The topographic roughness amplitude, in Z ~> m. + hb, & ! The thickness of the bottom layer, in Z ~> m. + z_from_bot ! The hieght above the bottom, in Z ~> m. real :: Rml_base ! density of the deepest variable density layer - real :: dz_int ! thickness associated with an interface (Z) + real :: dz_int ! thickness associated with an interface, in Z ~> m. real :: G_Rho0 ! gravitation acceleration divided by Bouss reference density - ! times some unit conversion factors, in (Z m3 s-2 kg-1) + ! times some unit conversion factors, in Z m3 s-2 kg-1 ~> m4 s-2 kg-1. real :: H_neglect ! negligibly small thickness, in the same units as h. logical :: do_i(SZI_(G)), do_any @@ -1057,10 +1057,10 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) type(set_diffusivity_CS), pointer :: CS !< Module control structure. real, dimension(SZI_(G),SZK_(G)+1), & intent(out) :: Kd_T_dd !< Interface double diffusion diapycnal - !! diffusivity for temp (Z2/sec). + !! diffusivity for temp, in Z2 s-1 ~> m2 s-1. real, dimension(SZI_(G),SZK_(G)+1), & intent(out) :: Kd_S_dd !< Interface double diffusion diapycnal - !! diffusivity for saln (Z2/sec). + !! diffusivity for saln, in Z2 s-1 ~> m2 s-1. real, dimension(SZI_(G)) :: & dRho_dT, & ! partial derivatives of density wrt temp (kg m-3 degC-1) @@ -1074,12 +1074,12 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) real :: Rrho ! vertical density ratio real :: diff_dd ! factor for double-diffusion (nondim) - real :: Kd_dd ! The dominant double diffusive diffusivity in Z2/sec + real :: Kd_dd ! The dominant double diffusive diffusivity, in Z2 s-1 ~> m2 s-1 real :: prandtl ! flux ratio for diffusive convection regime real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio - real :: dsfmax ! max diffusivity in case of salt fingering (Z2/sec) - real :: Kv_molecular ! molecular viscosity (Z2/sec) + real :: dsfmax ! max diffusivity in case of salt fingering, in Z2 s-1 ~> m2 s-1 + real :: Kv_molecular ! molecular viscosity, in Z2 s-1 ~> m2 s-1 integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke @@ -1149,17 +1149,19 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 + !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1. real, dimension(SZI_(G),SZK_(G)), intent(in) :: maxTKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness, in m3 s-3 integer, dimension(SZI_(G)), intent(in) :: kb !< Index of lightest layer denser than the buffer !! layer, or -1 without a bulk mixed layer type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1 + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, + !! in Z2 s-1 ~> m2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1 - real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity, in m2 s-1 + intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, + !! in Z2 s-1 ~> m2 s-1. + real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity, in Z2 s-1 ~> m2 s-1. ! This routine adds diffusion sustained by flow energy extracted by bottom drag. @@ -1167,25 +1169,25 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & Rint ! coordinate density of an interface (kg/m3) real, dimension(SZI_(G)) :: & htot, & ! total thickness above or below a layer, or the - ! integrated thickness in the BBL (Z) + ! integrated thickness in the BBL, in Z ~> m. rho_htot, & ! running integral with depth of density (Z kg/m3) gh_sum_top, & ! BBL value of g'h that can be supported by ! the local ustar, times R0_g (kg/m2) Rho_top, & ! density at top of the BBL (kg/m3) TKE, & ! turbulent kinetic energy available to drive ! bottom-boundary layer mixing in a layer (m3/s3) - I2decay ! inverse of twice the TKE decay scale (1/Z) + I2decay ! inverse of twice the TKE decay scale, in Z-1 ~> m-1. real :: TKE_to_layer ! TKE used to drive mixing in a layer (m3/s3) real :: TKE_Ray ! TKE from layer Rayleigh drag used to drive mixing in layer (m3/s3) real :: TKE_here ! TKE that goes into mixing in this layer (m3/s3) real :: dRl, dRbot ! temporaries holding density differences (kg/m3) real :: cdrag_sqrt ! square root of the drag coefficient (nondimensional) - real :: ustar_h ! value of ustar at a thickness point (Z/s) + real :: ustar_h ! value of ustar at a thickness point, in Z s-1 ~> m s-1. real :: absf ! average absolute Coriolis parameter around a thickness point (1/s) real :: R0_g ! Rho0 / G_Earth (kg s2 Z-1 m-4) real :: I_rho0 ! 1 / RHO0 - real :: delta_Kd ! increment to Kd from the bottom boundary layer mixing (Z2/s) + real :: delta_Kd ! increment to Kd from the bottom boundary layer mixing, in Z2 s-1 ~> m2 s-1. logical :: Rayleigh_drag ! Set to true if Rayleigh drag velocities ! defined in visc, on the assumption that this ! extracted energy also drives diapycnal mixing. @@ -1397,17 +1399,17 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & real :: TKE_consumed ! TKE used for mixing in this layer (m3 s-3) real :: TKE_Kd_wall ! TKE associated with unlimited law of the wall mixing (m3 s-3) real :: cdrag_sqrt ! square root of the drag coefficient (nondimensional) - real :: ustar ! value of ustar at a thickness point (Z/s) + real :: ustar ! value of ustar at a thickness point, in Z s-1 ~> m s-1. real :: ustar2 ! square of ustar, for convenience (Z2/s2) real :: absf ! average absolute value of Coriolis parameter around a thickness point (1/sec) - real :: dh, dhm1 ! thickness of layers k and k-1, respecitvely (Z) - real :: z_bot ! distance to interface k from bottom (Z) - real :: D_minus_z ! distance to interface k from surface (Z) - real :: total_thickness ! total thickness of water column (Z) - real :: Idecay ! inverse of decay scale used for "Joule heating" loss of TKE with height (1/Z) - real :: Kd_wall ! Law of the wall diffusivity (Z2/s) + real :: dh, dhm1 ! thickness of layers k and k-1, respecitvely, in Z ~> m. + real :: z_bot ! distance to interface k from bottom, in Z ~> m. + real :: D_minus_z ! distance to interface k from surface, in Z ~> m. + real :: total_thickness ! total thickness of water column, in Z ~> m. + real :: Idecay ! inverse of decay scale used for "Joule heating" loss of TKE with height, in Z-1 ~> m-1. + real :: Kd_wall ! Law of the wall diffusivity, in Z2 s-1 ~> m2 s-1. real :: Kd_lower ! diffusivity for lower interface (Z2/sec) - real :: ustar_D ! u* x D (Z2/s) + real :: ustar_D ! u* x D , in Z2 s-1 ~> m2 s-1. real :: I_Rho0 ! 1 / rho0 real :: N2_min ! Minimum value of N2 to use in calculation of TKE_Kd_wall (1/s2) logical :: Rayleigh_drag ! Set to true if there are Rayleigh drag velocities defined in visc, on @@ -1465,9 +1467,9 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! Work upwards from the bottom, accumulating work used until it exceeds the available TKE input ! at the bottom. do k=G%ke,2,-1 - dh = GV%H_to_Z * h(i,j,k) ! Thickness of this level in Z. + dh = GV%H_to_Z * h(i,j,k) ! Thickness of this level in Z ~> m. km1 = max(k-1, 1) - dhm1 = GV%H_to_Z * h(i,j,km1) ! Thickness of level above in Z. + dhm1 = GV%H_to_Z * h(i,j,km1) ! Thickness of level above in Z ~> m. ! Add in additional energy input from bottom-drag against slopes (sides) if (Rayleigh_drag) TKE_remaining = TKE_remaining + & @@ -1481,7 +1483,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! This is energy loss in addition to work done as mixing, apparently to Joule heating. TKE_remaining = exp(-Idecay*dh) * TKE_remaining - z_bot = z_bot + h(i,j,k)*GV%H_to_Z ! Distance between upper interface of layer and the bottom, in Z. + z_bot = z_bot + h(i,j,k)*GV%H_to_Z ! Distance between upper interface of layer and the bottom, in Z ~> m. D_minus_z = max(total_thickness - z_bot, 0.) ! Thickness above layer, Z. ! Diffusivity using law of the wall, limited by rotation, at height z, in m2/s. @@ -1534,34 +1536,35 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, type(forcing), intent(in) :: fluxes !< Surface fluxes structure type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1. + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1 ~> m2 s-1. integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 + !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1. + optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, + !! in Z2 s-1 ~> m2 s-1. ! This routine adds effects of mixed layer radiation to the layer diffusivities. - real, dimension(SZI_(G)) :: h_ml ! Mixed layer thickness, in Z. + real, dimension(SZI_(G)) :: h_ml ! Mixed layer thickness, in Z ~> m. real, dimension(SZI_(G)) :: TKE_ml_flux - real, dimension(SZI_(G)) :: I_decay ! A decay rate in Z-1. - real, dimension(SZI_(G)) :: Kd_mlr_ml ! Diffusivities associated with mixed layer radiation, in Z2 s-1. + real, dimension(SZI_(G)) :: I_decay ! A decay rate in Z-1 ~> m-1. + real, dimension(SZI_(G)) :: Kd_mlr_ml ! Diffusivities associated with mixed layer radiation, in Z2 s-1 ~> m2 s-1. real :: f_sq ! The square of the local Coriolis parameter or a related variable, in s-2. - real :: h_ml_sq ! The square of the mixed layer thickness, in Z2. - real :: ustar_sq ! ustar squared in Z2 s-2. - real :: Kd_mlr ! A diffusivity associated with mixed layer turbulence radiation, in Z2 s-1. + real :: h_ml_sq ! The square of the mixed layer thickness, in Z2 ~> m2. + real :: ustar_sq ! ustar squared in Z2 s-2 ~> m2 s-2. + real :: Kd_mlr ! A diffusivity associated with mixed layer turbulence radiation, in Z2 s-1 ~> m2 s-1. real :: C1_6 ! 1/6 - real :: Omega2 ! rotation rate squared (1/s2) + real :: Omega2 ! rotation rate squared, in s-2. real :: z1 ! layer thickness times I_decay (nondim) - real :: dzL ! thickness converted to Z + real :: dzL ! thickness converted to Z ~> m. real :: I_decay_len2_TKE ! squared inverse decay lengthscale for - ! TKE, as used in the mixed layer code (1/Z2) - real :: h_neglect ! negligibly small thickness (Z) + ! TKE, as used in the mixed layer code, in Z-2 ~> m-2. + real :: h_neglect ! negligibly small thickness, in Z ~> m. logical :: do_any, do_i(SZI_(G)) integer :: i, k, is, ie, nz, kml @@ -1675,21 +1678,21 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) real, dimension(SZI_(G)) :: & htot ! total thickness above or below a layer, or the - ! integrated thickness in the BBL (Z) + ! integrated thickness in the BBL, in Z ~> m. real, dimension(SZIB_(G)) :: & uhtot, & ! running integral of u in the BBL (Z m/s) - ustar, & ! bottom boundary layer turbulence speed (Z/s) + ustar, & ! bottom boundary layer turbulence speed, in Z s-1 ~> m s-1. u2_bbl ! square of the mean zonal velocity in the BBL (m2/s2) real :: vhtot(SZI_(G)) ! running integral of v in the BBL (Z m/sec) real, dimension(SZI_(G),SZJB_(G)) :: & - vstar, & ! ustar at at v-points (Z/s) + vstar, & ! ustar at at v-points, in Z s-1 ~> m s-1. v2_bbl ! square of average meridional velocity in BBL (m2/s2) real :: cdrag_sqrt ! square root of the drag coefficient (nondim) - real :: hvel ! thickness at velocity points (Z) + real :: hvel ! thickness at velocity points, in Z ~> m. logical :: domore, do_i(SZI_(G)) integer :: i, j, k, is, ie, js, je, nz diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index cb80ebb0c0..2d53db68de 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -50,8 +50,8 @@ module MOM_set_visc real :: Htbl_shelf !< A nominal thickness of the surface boundary layer for use !! in calculating the near-surface velocity, in units of H. real :: Htbl_shelf_min !< The minimum surface boundary layer thickness in H. - real :: KV_BBL_min !< The minimum viscosity in the bottom boundary layer, in Z2 s-1. - real :: KV_TBL_min !< The minimum viscosity in the top boundary layer, in Z2 s-1. + real :: KV_BBL_min !< The minimum viscosity in the bottom boundary layer, in Z2 s-1 ~> m2 s-1. + real :: KV_TBL_min !< The minimum viscosity in the top boundary layer, in Z2 s-1 ~> m2 s-1. logical :: bottomdraglaw !< If true, the bottom stress is calculated with a !! drag law c_drag*|u|*u. The velocity magnitude !! may be an assumed value or it may be based on the @@ -70,7 +70,7 @@ module MOM_set_visc !! thickness of the viscous mixed layer. Nondim. real :: omega !< The Earth's rotation rate, in s-1. real :: ustar_min !< A minimum value of ustar to avoid numerical - !! problems, in Z s-1. If the value is small enough, + !! problems, in Z s-1 ~> m s-1. If the value is small enough, !! this should not affect the solution. real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE !! decay scale, nondimensional. @@ -166,7 +166,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! Rho0 divided by G_Earth and the conversion ! from m to thickness units, in kg m-2 or kg2 m-5. real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion - ! factor from lateral lengths to vertical depths, in Z m-1. + ! factor from lateral lengths to vertical depths, in Z m-1 ~> 1. real :: cdrag_sqrt ! Square root of the drag coefficient, nd. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, @@ -176,7 +176,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: Dh ! The increment in layer thickness from ! the present layer, in H. real :: bbl_thick ! The thickness of the bottom boundary layer in H. - real :: bbl_thick_Z ! The thickness of the bottom boundary layer in Z. + real :: bbl_thick_Z ! The thickness of the bottom boundary layer in Z ~> m. real :: C2f ! C2f = 2*f at velocity points. real :: U_bg_sq ! The square of an assumed background @@ -242,8 +242,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: Cell_width ! The transverse width of the velocity cell, in m. real :: Rayleigh ! A nondimensional value that is multiplied by the layer's - ! velocity magnitude to give the Rayleigh drag velocity, - ! times a lateral to vertical distance conversion factor, in Z L-1. + ! velocity magnitude to give the Rayleigh drag velocity, times + ! a lateral to vertical distance conversion factor, in Z L-1 ~> 1. real :: gam ! The ratio of the change in the open interface width ! to the open interface width atop a cell, nondim. real :: BBL_frac ! The fraction of a layer's drag that goes into the @@ -1035,7 +1035,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri dR_dS, & ! Partial derivative of the density at the base of layer nkml ! (roughly the base of the mixed layer) with salinity, in units ! of kg m-3 psu-1. - ustar, & ! The surface friction velocity under ice shelves, in Z s-1. + ustar, & ! The surface friction velocity under ice shelves, in Z s-1 ~> m s-1. press, & ! The pressure at which dR_dT and dR_dS are evaluated, in Pa. T_EOS, & ! T_EOS and S_EOS are the potential temperature and salnity at which dR_dT and dR_dS S_EOS ! which dR_dT and dR_dS are evaluated, in degC and PSU. @@ -1063,7 +1063,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! velocity magnitudes, in H m s-1. real :: hweight ! The thickness of a layer that is within Hbbl ! of the bottom, in H. - real :: tbl_thick_Z ! The thickness of the top boundary layer in Z. + real :: tbl_thick_Z ! The thickness of the top boundary layer in Z ~> m. real :: hlay ! The layer thickness at velocity points, in H. real :: I_2hlay ! 1 / 2*hlay, in H-1. @@ -1087,7 +1087,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! Rho0 divided by G_Earth and the conversion ! from m to thickness units, in kg m-2 or kg2 m-5. real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion - ! factor from lateral lengths to vertical depths, in Z m-1. + ! factor from lateral lengths to vertical depths, in Z m-1 ~> 1. real :: cdrag_sqrt ! Square root of the drag coefficient, ND. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, @@ -1102,7 +1102,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real :: h_tiny ! A very small thickness, in H. Layers that are less than ! h_tiny can not be the deepest in the viscous mixed layer. real :: absf ! The absolute value of f averaged to velocity points, s-1. - real :: U_star ! The friction velocity at velocity points, in Z s-1. + real :: U_star ! The friction velocity at velocity points, in Z s-1 ~> m s-1. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors, in kg s2 H m-3 Z-2. diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index 8bb8fa3ef3..c656f6f1a5 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -347,7 +347,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) fld_anom ! Anomalies in a tracer concentration, relative to the ! i-mean target value. real, dimension(SZJ_(G), SZK_(G)+1) :: & - eta_mean_anom ! The i-mean interface height anomalies, in Z. + eta_mean_anom ! The i-mean interface height anomalies, in Z ~> m. real, allocatable, dimension(:,:,:) :: & fld_mean_anom ! THe i-mean tracer concentration anomalies. real, dimension(SZI_(G), SZK_(G)+1) :: & @@ -357,8 +357,8 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) dilate ! A nondimensional factor by which to dilate layers to ! give 0 at the surface. - real :: e(SZK_(G)+1) ! The interface heights, in Z, usually negative. - real :: e0 ! The height of the free surface in Z. + real :: e(SZK_(G)+1) ! The interface heights, in Z ~> m, usually negative. + real :: e0 ! The height of the free surface in Z ~> m. real :: e_str ! A nondimensional amount by which the reference ! profile must be stretched for the free surfaces ! heights in the two profiles to agree. diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 05c377ab9c..f995cf0739 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -39,9 +39,9 @@ module MOM_tidal_mixing !> Containers for tidal mixing diagnostics type, public :: tidal_mixing_diags ; private real, pointer, dimension(:,:,:) :: & - Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces (Z2 s-1) + Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces, in Z2 s-1 ~> m2 s-1. Fl_itidal => NULL(),& !< vertical flux of tidal turbulent dissipation (m3 s-3) - Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces (Z2 s-1) + Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces, in Z2 s-1 ~> m2 s-1. Kd_Niku_work => NULL(),& !< layer integrated work by lee-wave driven mixing (W m-2) Kd_Itidal_Work => NULL(),& !< layer integrated work by int tide driven mixing (W m-2) Kd_Lowmode_Work => NULL(),& !< layer integrated work by low mode driven mixing (W m-2) @@ -51,7 +51,7 @@ module MOM_tidal_mixing real, pointer, dimension(:,:,:) :: tidal_qe_md => NULL() !< Input tidal energy dissipated locally, !! interpolated to model vertical coordinate (W m-3?) real, pointer, dimension(:,:,:) :: Kd_lowmode => NULL() !< internal tide diffusivity at interfaces - !! due to propagating low modes (Z2/s) + !! due to propagating low modes, in Z2 s-1 ~> m2 s-1. real, pointer, dimension(:,:,:) :: Fl_lowmode => NULL() !< vertical flux of tidal turbulent !! dissipation due to propagating low modes (m3/s3) real, pointer, dimension(:,:) :: & @@ -85,7 +85,7 @@ module MOM_tidal_mixing !! for dissipation of the lee waves. Schemes that are !! currently encoded are St Laurent et al (2002) and !! Polzin (2009). - real :: Int_tide_decay_scale !< decay scale for internal wave TKE (Z) + real :: Int_tide_decay_scale !< decay scale for internal wave TKE, in Z ~> m. real :: Mu_itides !< efficiency for conversion of dissipation !! to potential energy (nondimensional) @@ -97,7 +97,7 @@ module MOM_tidal_mixing real :: Decay_scale_factor_lee !< Scaling factor for the decay scale of lee !! wave energy dissipation (nondimensional) - real :: min_zbot_itides !< minimum depth for internal tide conversion (Z) + real :: min_zbot_itides !< minimum depth for internal tide conversion, in Z ~> m. logical :: Lowmode_itidal_dissipation = .false. !< If true, consider mixing due to breaking low !! modes that have been remotely generated using an internal tidal !! dissipation scheme to specify the vertical profile of the energy @@ -116,13 +116,13 @@ module MOM_tidal_mixing !! profile in Polzin formulation should not exceed !! Polzin_decay_scale_max_factor * depth of the ocean (nondimensional). real :: Polzin_min_decay_scale !< minimum decay scale of the tidal dissipation - !! profile in Polzin formulation (Z) + !! profile in Polzin formulation, in Z ~> m. real :: TKE_itide_max !< maximum internal tide conversion (W m-2) !! available to mix above the BBL real :: utide !< constant tidal amplitude (m s-1) used if - real :: kappa_itides !< topographic wavenumber and non-dimensional scaling, in Z-1 + real :: kappa_itides !< topographic wavenumber and non-dimensional scaling, in Z-1 ~> m-1. real :: kappa_h2_factor !< factor for the product of wavenumber * rms sgs height character(len=200) :: inputdir !< The directory in which to find input files @@ -137,7 +137,7 @@ module MOM_tidal_mixing type(CVMix_global_params_type) :: CVMix_glb_params !< CVMix-specific for Prandtl number only real :: tidal_max_coef !< CVMix-specific maximum allowable tidal diffusivity. [m^2/s] real :: tidal_diss_lim_tc !< CVMix-specific dissipation limit depth for - !! tidal-energy-constituent data, in Z. + !! tidal-energy-constituent data, in Z ~> m. type(remapping_CS) :: remap_CS !< The control structure for remapping ! Data containers @@ -665,19 +665,21 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, C !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 + !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1 real, dimension(SZI_(G),SZK_(G)), intent(in) :: max_TKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness, in m3 s-3 type(tidal_mixing_cs), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1. + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1 ~> m2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1. + optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, + !! in Z2 s-1 ~> m2 s-1. real, intent(in) :: Kd_max !< The maximum increment for diapycnal - !! diffusivity due to TKE-based processes, in Z2 s-1. + !! diffusivity due to TKE-based processes, + !! in Z2 s-1 ~> m2 s-1. !! Set this to a negative value to have no limit. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) in Z2 s-1. + !! (not layer!) in Z2 s-1 ~> m2 s-1. if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then if (CS%use_CVMix_tidal) then @@ -703,9 +705,9 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd_lay!< The diapycnal diffusivities in the layers, in Z2 s-1 + intent(inout) :: Kd_lay!< The diapycnal diffusivities in the layers, in Z2 s-1 ~> m2 s-1. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) in Z2 s-1. + !! (not layer!) in Z2 s-1 ~> m2 s-1. ! Local variables real, dimension(SZK_(G)+1) :: Kd_tidal ! tidal diffusivity [m2/s] real, dimension(SZK_(G)+1) :: Kv_tidal ! tidal viscosity [m2/s] @@ -781,7 +783,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) ! Update viscosity with the proper unit conversion. if (associated(Kv)) then do k=1,G%ke+1 - Kv(i,j,k) = Kv(i,j,k) + US%m_to_Z**2 * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 s-1. + Kv(i,j,k) = Kv(i,j,k) + US%m_to_Z**2 * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 s-1. enddo endif @@ -933,32 +935,34 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 + !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1 real, dimension(SZI_(G),SZK_(G)), intent(in) :: max_TKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness, in m3 s-3 type(tidal_mixing_cs), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1. + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1 ~> m2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, in Z2 s-1. + optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, + !! in Z2 s-1 ~> m2 s-1. real, intent(in) :: Kd_max !< The maximum increment for diapycnal - !! diffusivity due to TKE-based processes, in Z2 s-1. + !! diffusivity due to TKE-based processes, + !! in Z2 s-1 ~> m2 s-1. !! Set this to a negative value to have no limit. ! local real, dimension(SZI_(G)) :: & htot, & ! total thickness above or below a layer, or the - ! integrated thickness in the BBL (Z) - htot_WKB, & ! distance from top to bottom (Z) WKB scaled + ! integrated thickness in the BBL, in Z ~> m. + htot_WKB, & ! WKB scaled distance from top to bottom, in Z ~> m. TKE_itidal_bot, & ! internal tide TKE at ocean bottom (m3/s3) TKE_Niku_bot, & ! lee-wave TKE at ocean bottom (m3/s3) TKE_lowmode_bot, & ! internal tide TKE at ocean bottom lost from all remote low modes (m3/s3) (BDM) Inv_int, & ! inverse of TKE decay for int tide over the depth of the ocean (nondim) Inv_int_lee, & ! inverse of TKE decay for lee waves over the depth of the ocean (nondim) Inv_int_low, & ! inverse of TKE decay for low modes over the depth of the ocean (nondim) (BDM) - z0_Polzin, & ! TKE decay scale in Polzin formulation (Z) - z0_Polzin_scaled, & ! TKE decay scale in Polzin formulation (Z) + z0_Polzin, & ! TKE decay scale in Polzin formulation, in Z ~> m. + z0_Polzin_scaled, & ! TKE decay scale in Polzin formulation, in Z ~> m. ! multiplied by N2_bot/N2_meanz to be coherent with the WKB scaled z ! z*=int(N2/N2_bot) * N2_bot/N2_meanz = int(N2/N2_meanz) ! z0_Polzin_scaled = z0_Polzin * N2_bot/N2_meanz @@ -970,18 +974,18 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, TKE_frac_top_lee, & ! fraction of bottom TKE that should appear at top of a layer (nondim) TKE_frac_top_lowmode, & ! fraction of bottom TKE that should appear at top of a layer (nondim) (BDM) - z_from_bot, & ! distance from bottom (Z) - z_from_bot_WKB ! distance from bottom (Z), WKB scaled + z_from_bot, & ! distance from bottom, in Z ~> m. + z_from_bot_WKB ! WKB scaled distance from bottom, in Z ~> m. real :: I_rho0 ! 1 / RHO0, (m3/kg) - real :: Kd_add ! diffusivity to add in a layer (Z2/sec) + real :: Kd_add ! diffusivity to add in a layer, in Z2 s-1 ~> m2 s-1. real :: TKE_itide_lay ! internal tide TKE imparted to a layer (from barotropic) (m3/s3) real :: TKE_Niku_lay ! lee-wave TKE imparted to a layer (m3/s3) real :: TKE_lowmode_lay ! internal tide TKE imparted to a layer (from low mode) (m3/s3) (BDM) real :: frac_used ! fraction of TKE that can be used in a layer (nondim) - real :: Izeta ! inverse of TKE decay scale (1/Z) - real :: Izeta_lee ! inverse of TKE decay scale for lee waves (1/Z) - real :: z0_psl ! temporary variable with units of Z + real :: Izeta ! inverse of TKE decay scale, in Z-1 ~> m-1. + real :: Izeta_lee ! inverse of TKE decay scale for lee waves, in Z-1 ~> m-1. + real :: z0_psl ! temporary variable with units of Z ~> m. real :: TKE_lowmode_tot ! TKE from all low modes (W/m2) (BDM) logical :: use_Polzin, use_Simmons diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 3bcc287058..d956df2f59 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -61,11 +61,11 @@ module MOM_vert_friction type(time_type) :: rampStartTime !< The time at which the ramping of CFL_trunc starts real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) :: & - a_u !< The u-drag coefficient across an interface, in Z s-1. + a_u !< The u-drag coefficient across an interface, in Z s-1 ~> m s-1. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & h_u !< The effective layer thickness at u-points, m or kg m-2. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) :: & - a_v !< The v-drag coefficient across an interface, in Z s-1. + a_v !< The v-drag coefficient across an interface, in Z s-1 ~> m s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & h_v !< The effective layer thickness at v-points, m or kg m-2. real, pointer, dimension(:,:) :: a1_shelf_u => NULL() !< The u-momentum coupling coefficient under @@ -174,7 +174,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. c1 is nondimensional, ! while b1 has units of inverse thickness. real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver, ND. - real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity in Z s-1 + real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity, in Z s-1 ~> m s-1. real :: b_denom_1 ! The first term in the denominator of b1, in H. real :: Hmix ! The mixed layer thickness over which stress @@ -595,14 +595,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) hvel, & ! hvel is the thickness used at a velocity grid point, in H. hvel_shelf ! The equivalent of hvel under shelves, in H. real, dimension(SZIB_(G),SZK_(G)+1) :: & - a_cpl, & ! The drag coefficients across interfaces, in Z s-1. a_cpl times + a_cpl, & ! The drag coefficients across interfaces, in Z s-1 ~> m s-1. a_cpl times ! the velocity difference gives the stress across an interface. a_shelf, & ! The drag coefficients across interfaces in water columns under - ! ice shelves, in Z s-1. + ! ice shelves, in Z s-1 ~> m s-1. z_i ! An estimate of each interface's height above the bottom, ! normalized by the bottom boundary layer thickness, nondim. real, dimension(SZIB_(G)) :: & - kv_bbl, & ! The bottom boundary layer viscosity in Z2 s-1. + kv_bbl, & ! The bottom boundary layer viscosity in Z2 s-1 ~> m2 s-1. bbl_thick, & ! The bottom boundary layer thickness in m or kg m-2. I_Hbbl, & ! The inverse of the bottom boundary layer thickness, in units ! of H-1 (i.e., m-1 or m2 kg-1). @@ -1042,7 +1042,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZK_(GV)+1), & - intent(out) :: a_cpl !< Coupling coefficient across interfaces, in Z s-1 + intent(out) :: a_cpl !< Coupling coefficient across interfaces, in Z s-1 ~> m s-1. real, dimension(SZIB_(G),SZK_(GV)), & intent(in) :: hvel !< Thickness at velocity points, in H logical, dimension(SZIB_(G)), & @@ -1051,7 +1051,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, intent(in) :: h_harm !< Harmonic mean of thicknesses around a velocity !! grid point, in H real, dimension(SZIB_(G)), intent(in) :: bbl_thick !< Bottom boundary layer thickness, in H - real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity, in Z2 s-1 + real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity, in Z2 s-1 ~> m2 s-1. real, dimension(SZIB_(G),SZK_(GV)+1), & intent(in) :: z_i !< Estimate of interface heights above the bottom, !! normalized by the bottom boundary layer thickness @@ -1070,23 +1070,23 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! Local variables real, dimension(SZIB_(G)) :: & - u_star, & ! ustar at a velocity point, in Z s-1. + u_star, & ! ustar at a velocity point, in Z s-1 ~> m s-1. absf, & ! The average of the neighboring absolute values of f, in s-1. ! h_ml, & ! The mixed layer depth, in m or kg m-2. nk_visc, & ! The (real) interface index of the base of mixed layer. z_t, & ! The distance from the top, sometimes normalized ! by Hmix, in H or nondimensional. - kv_tbl, & ! The viscosity in a top boundary layer under ice, in Z2 s-1. + kv_tbl, & ! The viscosity in a top boundary layer under ice, in Z2 s-1 ~> m2 s-1. tbl_thick real, dimension(SZIB_(G),SZK_(GV)) :: & - Kv_add ! A viscosity to add, in Z2 s-1. + Kv_add ! A viscosity to add, in Z2 s-1 ~> m2 s-1. real :: h_shear ! The distance over which shears occur, H. real :: r ! A thickness to compare with Hbbl, in H. - real :: visc_ml ! The mixed layer viscosity, in Z2 s-1. + real :: visc_ml ! The mixed layer viscosity, in Z2 s-1 ~> m2 s-1. real :: I_Hmix ! The inverse of the mixed layer thickness, in H-1. real :: a_ml ! The layer coupling coefficient across an interface in ! the mixed layer, in m s-1. - real :: I_amax ! The inverse of the maximum coupling coefficient, in Z-1.??? + real :: I_amax ! The inverse of the maximum coupling coefficient, in Z-1 ~> m-1.??? real :: temp1 ! A temporary variable in H Z real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 795d49694b..6278561a3d 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -172,7 +172,7 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & real :: dist2 ! The distance squared from a line, in m2. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H. - real :: e(SZK_(G)+1), e_top, e_bot ! Heights in Z. + real :: e(SZK_(G)+1), e_top, e_bot ! Heights in Z ~> m. real :: d_tr ! A change in tracer concentraions, in tracer units. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index d78821cd46..b065915312 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -49,7 +49,7 @@ function tracer_Z_init(tr, h, filename, tr_name, G, US, missing_val, land_val) tr_in ! The z-space array of tracer concentrations that is read in. real, allocatable, dimension(:) :: & z_edges, & ! The depths of the cell edges or cell centers (depending on - ! the value of has_edges) in the input z* data, in depth units (Z). + ! the value of has_edges) in the input z* data, in Z ~> m. tr_1d, & ! A copy of the input tracer concentrations in a column. wt, & ! The fractional weight for each layer in the range between ! k_top and k_bot, nondim. @@ -57,7 +57,7 @@ function tracer_Z_init(tr, h, filename, tr_name, G, US, missing_val, land_val) z2 ! of a z-cell that contributes to a layer, relative to the cell ! center and normalized by the cell thickness, nondim. ! Note that -1/2 <= z1 <= z2 <= 1/2. - real :: e(SZK_(G)+1) ! The z-star interface heights in Z. + real :: e(SZK_(G)+1) ! The z-star interface heights in Z ~> m. real :: landval ! The tracer value to use in land points. real :: sl_tr ! The normalized slope of the tracer ! within the cell, in tracer units. diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 1416fb9655..348e2a822f 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -42,8 +42,8 @@ module regional_dyes real, allocatable, dimension(:) :: dye_source_maxlon !< Maximum longitude of region dye will be injected. real, allocatable, dimension(:) :: dye_source_minlat !< Minimum latitude of region dye will be injected. real, allocatable, dimension(:) :: dye_source_maxlat !< Maximum latitude of region dye will be injected. - real, allocatable, dimension(:) :: dye_source_mindepth !< Minimum depth of region dye will be injected, in Z. - real, allocatable, dimension(:) :: dye_source_maxdepth !< Maximum depth of region dye will be injected, in Z. + real, allocatable, dimension(:) :: dye_source_mindepth !< Minimum depth of region dye will be injected, in Z ~> m. + real, allocatable, dimension(:) :: dye_source_maxdepth !< Maximum depth of region dye will be injected, in Z ~> m. type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3? diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 7c16ade9b5..abf0d9fe53 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -33,7 +33,7 @@ module BFB_initialization subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) real, dimension(NKMEM_), intent(out) :: Rlay !< Layer potential density. real, dimension(NKMEM_), intent(out) :: g_prime !< The reduced gravity at - !! each interface, in m2 Z-1 s-2. + !! each interface, in m2 Z-1 s-2 ~> m s-2. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(EOS_type), pointer :: eqn_of_state !< Integer that selects the @@ -84,10 +84,10 @@ subroutine BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, para intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) ! Local variables - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in depth units (Z). + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in depth units (Z ~> m). real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. - real :: H0(SZK_(G)) ! Resting layer thickesses in depth units (Z). - real :: min_depth ! The minimum ocean depth in depth units (Z). + real :: H0(SZK_(G)) ! Resting layer thickesses in depth units (Z ~> m). + real :: min_depth ! The minimum ocean depth in depth units (Z ~> m). real :: damp, e_dense, damp_new, slat, wlon, lenlat, lenlon, nlat character(len=40) :: mdl = "BFB_initialize_sponges_southonly" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index f20e4466bd..af1666fabd 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -97,10 +97,10 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, US, param_file, just_read_par !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(GV)) ! The resting interface heights, in depth units (Z), usually + real :: e0(SZK_(GV)) ! The resting interface heights, in depth units (Z ~> m), usually ! negative because it is positive upward. real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface - ! positive upward, in depth units (Z). + ! positive upward, in depth units (Z ~> m). integer :: i, j, k, is, ie, js, je, nz real :: x real :: delta_h @@ -365,11 +365,11 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. real :: S_ref, T_ref ! Reference salinity and temerature within surface layer real :: S_range, T_range ! Range of salinities and temperatures over the vertical - real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), + real :: e0(SZK_(G)+1) ! The resting interface heights, in Z ~> m, ! usually negative because it is positive upward. real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface - ! positive upward, in Z. - real :: d_eta(SZK_(G)) ! The layer thickness in a column, in Z. + ! positive upward, in Z ~> m. + real :: d_eta(SZK_(G)) ! The layer thickness in a column, in Z ~> m. real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay real :: dome2d_west_sponge_time_scale, dome2d_east_sponge_time_scale real :: dome2d_west_sponge_width, dome2d_east_sponge_width diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 101e52eb30..80fac3a4f0 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -42,7 +42,7 @@ subroutine DOME_initialize_topography(D, G, param_file, max_depth, US) ! Local variables real :: m_to_Z ! A dimensional rescaling factor. - real :: min_depth ! The minimum and maximum depths in Z. + real :: min_depth ! The minimum and maximum depths in Z ~> m. ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "DOME_initialize_topography" ! This subroutine's name. @@ -93,9 +93,9 @@ subroutine DOME_initialize_thickness(h, G, GV, param_file, just_read_params) !! only read parameters without changing h. real :: e0(SZK_(GV)+1) ! The resting interface heights, in m, usually - ! negative because it is positive upward, in depth units (Z). + ! negative because it is positive upward, in Z ~> m. real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface - ! positive upward, in depth units (Z). + ! positive upward, in Z ~> m. logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "DOME_initialize_thickness" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, nz @@ -156,7 +156,7 @@ subroutine DOME_initialize_sponges(G, GV, US, tv, PF, CSp) real :: temp(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for other variables. ! real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. - real :: H0(SZK_(G)) ! Interface heights in depth units (Z) + real :: H0(SZK_(G)) ! Interface heights in Z ~> m. real :: min_depth real :: damp, e_dense, damp_new character(len=40) :: mdl = "DOME_initialize_sponges" ! This subroutine's name. @@ -260,9 +260,9 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 in kg m-3. ! The following variables are used to set up the transport in the DOME example. real :: tr_0, y1, y2, tr_k, rst, rsb, rc, v_k, lon_im1 - real :: D_edge ! The thickness in Z of the dense fluid at the + real :: D_edge ! The thickness, in Z ~> m, of the dense fluid at the ! inner edge of the inflow. - real :: g_prime_tot ! The reduced gravity across all layers, m2 Z-1 s-2. + real :: g_prime_tot ! The reduced gravity across all layers, in m2 Z-1 s-2 ~> m s-2. real :: Def_Rad ! The deformation radius, based on fluid of ! thickness D_edge, in the same units as lat. real :: Ri_trans ! The shear Richardson number in the transition diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 6a3bf8007e..d8f1ab0935 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -45,17 +45,17 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: min_depth ! The minimum and maximum depths in Z. + real :: min_depth ! The minimum and maximum depths in Z ~> m. real :: m_to_Z ! A dimensional rescaling factor. ! The following variables are used to set up the bathymetry in the ISOMIP example. real :: bmax ! max depth of bedrock topography real :: b0,b2,b4,b6 ! first, second, third and fourth bedrock topography coeff real :: xbar ! characteristic along-flow lenght scale of the bedrock - real :: dc ! depth of the trough compared with side walls in Z + real :: dc ! depth of the trough compared with side walls in Z ~> m. real :: fc ! characteristic width of the side walls of the channel real :: wc ! half-width of the trough real :: ly ! domain width (across ice flow) - real :: bx, by ! dummy vatiables in Z + real :: bx, by ! dummy vatiables in Z ~> m. real :: xtil ! dummy vatiable logical :: is_2D ! If true, use 2D setup ! This include declares and sets the variable "version". @@ -139,10 +139,10 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, US, param_file, tv, just_read logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z ~> m), ! usually negative because it is positive upward. real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in depth units (Z). + ! positive upward, in depth units (Z ~> m). integer :: i, j, k, is, ie, js, je, nz, tmp1 real :: x real :: rho_range @@ -257,7 +257,7 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, ! Local variables integer :: i, j, k, is, ie, js, je, nz, itt real :: x, ds, dt, rho_sur, rho_bot - real :: xi0, xi1 ! Heights in depth units (Z). + real :: xi0, xi1 ! Heights in depth units (Z ~> m). real :: S_sur, T_sur, S_bot, T_bot real :: dT_dz, dS_dz ! Gradients of T and S in degC/Z and PPT/Z. real :: z ! vertical position in z space @@ -436,10 +436,10 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) real :: rho_sur, rho_bot, rho_range real :: dT_dz, dS_dz ! Gradients of T and S in degC/Z and PPT/Z. - real :: e0(SZK_(G)+1) ! The resting interface heights, in Z, usually + real :: e0(SZK_(G)+1) ! The resting interface heights, in Z ~> m, usually ! negative because it is positive upward. - real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface, positive upward, in Z. - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in Z. + real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface, positive upward, in Z ~> m. + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in Z ~> m. real :: min_depth, dummy1, z real :: damp, rho_dummy, min_thickness, rho_tmp, xi0 character(len=40) :: verticalCoordinate, filename, state_file diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 1fd9edb3ea..33ce7d383a 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -121,7 +121,7 @@ subroutine Kelvin_initialize_topography(D, G, param_file, max_depth, US) ! Local variables character(len=40) :: mdl = "Kelvin_initialize_topography" ! This subroutine's name. real :: m_to_Z ! A dimensional rescaling factor. - real :: min_depth ! The minimum and maximum depths in Z. + real :: min_depth ! The minimum and maximum depths in Z ~> m. real :: PI ! 3.1415... real :: coast_offset1, coast_offset2, coast_angle, right_angle integer :: i, j diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index f9934615dc..9a98d55b21 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -102,7 +102,7 @@ module MOM_wave_interface !! Horizontal -> V points !! 3rd dimension -> Freq/Wavenumber real, allocatable, dimension(:,:,:), public :: & - KvS !< Viscosity for Stokes Drift shear (Z2/s) + KvS !< Viscosity for Stokes Drift shear (Z2/s ~> m2 s-1) ! Pointers to auxiliary fields type(time_type), pointer, public :: Time !< A pointer to the ocean model's clock. @@ -469,7 +469,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Thickness (m or kg/m2) real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: ustar !< Wind friction velocity (Z/s) + intent(in) :: ustar !< Wind friction velocity, in Z s-1 ~> m s-1. ! Local Variables real :: Top, MidPoint, Bottom, one_cm real :: DecayScale @@ -864,8 +864,8 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: i !< Meridional index of h-point integer, intent(in) :: j !< Zonal index of h-point - real, intent(in) :: ustar !< Friction velocity (Z/s) - real, intent(in) :: HBL !< (Positive) thickness of boundary layer (Z) + real, intent(in) :: ustar !< Friction velocity, in Z s-1 ~> m s-1. + real, intent(in) :: HBL !< (Positive) thickness of boundary layer, in Z ~> m. logical, optional, intent(in) :: Override_MA !< Override to use misalignment in LA !! calculation. This can be used if diagnostic !! LA outputs are desired that are different than @@ -977,8 +977,8 @@ end subroutine get_Langmuir_Number !! - BGR remove u10 input !! - BGR note: fixed parameter values should be changed to "get_params" subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) - real, intent(in) :: ustar !< water-side surface friction velocity (Z/s) - real, intent(in) :: hbl !< boundary layer depth (Z) + real, intent(in) :: ustar !< water-side surface friction velocity, in Z s-1 ~> m s-1. + real, intent(in) :: hbl !< boundary layer depth, in Z ~> m. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(out) :: UStokes_SL !< Surface layer averaged Stokes drift (m/s) @@ -1058,7 +1058,7 @@ end subroutine Get_StokesSL_LiFoxKemper subroutine Get_SL_Average_Prof( GV, AvgDepth, H, Profile, Average ) type(verticalGrid_type), & intent(in) :: GV !< Ocean vertical grid structure - real, intent(in) :: AvgDepth !< Depth to average over (Z) + real, intent(in) :: AvgDepth !< Depth to average over, in Z ~> m. real, dimension(SZK_(GV)), & intent(in) :: H !< Grid thickness (H) real, dimension(SZK_(GV)), & @@ -1067,7 +1067,7 @@ subroutine Get_SL_Average_Prof( GV, AvgDepth, H, Profile, Average ) real, intent(out) :: Average !< Output quantity averaged over depth AvgDepth !! (used here for Stokes drift, m/s) !Local variables - real :: top, midpoint, bottom ! Depths in Z + real :: top, midpoint, bottom ! Depths in Z ~> m. real :: Sum integer :: kk @@ -1097,7 +1097,7 @@ end subroutine Get_SL_Average_Prof subroutine Get_SL_Average_Band( GV, AvgDepth, NB, WaveNumbers, SurfStokes, Average ) type(verticalGrid_type), & intent(in) :: GV !< Ocean vertical grid - real, intent(in) :: AvgDepth !< Depth to average over (Z) + real, intent(in) :: AvgDepth !< Depth to average over, in Z ~> m. integer, intent(in) :: NB !< Number of bands used real, dimension(NB), & intent(in) :: WaveNumbers !< Wavenumber corresponding to each band (1/Z) @@ -1130,7 +1130,7 @@ end subroutine Get_SL_Average_Band subroutine DHH85_mid(GV, US, zpt, UStokes) type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: ZPT !< Depth to get Stokes drift (Z) !### THIS IS NOT USED YET. + real, intent(in) :: ZPT !< Depth to get Stokes drift, in Z ~> m. !### THIS IS NOT USED YET. real, intent(out) :: UStokes !< Stokes drift (m/s) ! real :: ann, Bnn, Snn, Cnn, Dnn @@ -1197,7 +1197,7 @@ subroutine StokesMixing(G, GV, DT, h, u, v, Waves ) pointer :: Waves !< Surface wave related control structure. ! Local variables real :: dTauUp, dTauDn - real :: h_Lay ! The layer thickness at a velocity point, in Z. + real :: h_Lay ! The layer thickness at a velocity point, in Z ~> m. integer :: i,j,k ! This is a template to think about down-Stokes mixing. diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index 131b77ab31..cd3fc19c32 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -119,10 +119,10 @@ subroutine Neverland_initialize_thickness(h, G, GV, US, param_file, eqn_of_state real, intent(in) :: P_Ref !< The coordinate-density !! reference pressure in Pa. ! Local variables - real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z ~> m), ! usually negative because it is positive upward. - real, dimension(SZK_(G)) :: h_profile ! Vector of initial thickness profile (Z) - real :: e_interface ! Current interface position (m) + real, dimension(SZK_(G)) :: h_profile ! Vector of initial thickness profile, in Z ~> m. + real :: e_interface ! Current interface position, in Z ~> m. real :: x,y,r1,r2 ! x,y and radial coordinates for computation of initial pert. real :: pert_amp ! Amplitude of perturbations measured in Angstrom_H real :: h_noise ! Amplitude of noise to scale h by @@ -157,7 +157,8 @@ subroutine Neverland_initialize_thickness(h, G, GV, US, param_file, eqn_of_state y=(G%geoLatT(i,j)-G%south_lat)/G%len_lat r1=sqrt((x-0.7)**2+(y-0.2)**2) r2=sqrt((x-0.3)**2+(y-0.25)**2) - h(i,j,k) = h(i,j,k) + pert_amp*(e0(k) - e0(nz+1))*GV%Z_to_H*(spike(r1,0.15)-spike(r2,0.15)) ! Prescribed perturbation + h(i,j,k) = h(i,j,k) + pert_amp * (e0(k) - e0(nz+1)) * GV%Z_to_H * & + (spike(r1,0.15)-spike(r2,0.15)) ! Prescribed perturbation if (h_noise /= 0.) then rns = initializeRandomNumberStream( int( 4096*(x + (y+1.)) ) ) call getRandomNumbers(rns, noise) ! x will be in (0,1) diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 1e513460b5..d8bad8bd4d 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -41,10 +41,10 @@ subroutine Phillips_initialize_thickness(h, G, GV, US, param_file, just_read_par logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces, in depth units (Z). - real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta, in depth units (Z). + real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces, in Z ~> m. + real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta, in Z ~> m. real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface - ! positive upward, in in depth units (Z). + ! positive upward, in Z ~> m. real :: damp_rate, jet_width, jet_height, y_2 real :: half_strat, half_depth logical :: just_read ! If true, just read parameters but set nothing. @@ -207,17 +207,17 @@ subroutine Phillips_initialize_sponges(G, GV, US, tv, param_file, CSp, h) ! Local variables real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces. - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in depth units (Z). + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in Z ~> m. real :: temp(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for other variables. real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. - real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta, in Z. + real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta, in Z ~> m. real :: Idamp_im(SZJ_(G)) ! The inverse zonal-mean damping rate, in s-1. real :: damp_rate ! The inverse zonal-mean damping rate, in s-1. real :: jet_width ! The width of the zonal mean jet, in km. - real :: jet_height ! The interface height scale associated with the zonal-mean jet, in Z. + real :: jet_height ! The interface height scale associated with the zonal-mean jet, in Z ~> m. real :: y_2 ! The y-position relative to the channel center, in km. real :: half_strat ! The fractional depth where the straficiation is centered, ND. - real :: half_depth ! The depth where the stratification is centered, in Z. + real :: half_depth ! The depth where the stratification is centered, in Z ~> m. character(len=40) :: mdl = "Phillips_initialize_sponges" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index 303dbb54ea..960bed6a1f 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -58,16 +58,16 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read_par logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: UpperLayerTempMLD !< Upper layer Temp MLD thickness (Z) - real :: UpperLayerSaltMLD !< Upper layer Salt MLD thickness (Z) + real :: UpperLayerTempMLD !< Upper layer Temp MLD thickness, in Z ~> m. + real :: UpperLayerSaltMLD !< Upper layer Salt MLD thickness, in Z ~> m. real :: UpperLayerTemp !< Upper layer temperature (SST if thickness 0) (deg C) real :: UpperLayerSalt !< Upper layer salinity (SSS if thickness 0) (PPT) real :: LowerLayerTemp !< Temp at top of lower layer (deg C) real :: LowerLayerSalt !< Salt at top of lower layer (PPT) - real :: LowerLayerdTdz !< Temp gradient in lower layer (deg C / Z) - real :: LowerLayerdSdz !< Salt gradient in lower layer (PPT / Z) + real :: LowerLayerdTdz !< Temp gradient in lower layer, in degC / Z ~> degC m-1. + real :: LowerLayerdSdz !< Salt gradient in lower layer, in PPT / Z ~> PPT m-1. real :: LowerLayerMinTemp !< Minimum temperature in lower layer - real :: zC, DZ, top, bottom ! Depths and thicknesses in Z. + real :: zC, DZ, top, bottom ! Depths and thicknesses in Z ~> m. logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index fbf1a0df97..8ba8916538 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -38,10 +38,10 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), usually + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z ~> m), usually ! negative because it is positive upward. real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in depth units (Z). + ! positive upward, in depth units (Z ~> m). real :: x, y, yy, delta_S_strat, dSdz, delta_S, S_ref real :: min_thickness, adjustment_width, adjustment_delta, adjustment_deltaS real :: front_wave_amp, front_wave_length, front_wave_asym diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index b9bab35f59..6c1f4d653b 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -86,7 +86,7 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, US, param_f real :: T_ref, dTdz, dTdx, delta_T ! Parameters describing temperature distribution real :: S_ref, dSdz, dSdx, delta_S ! Parameters describing salinity distribution real :: L_zone ! Width of baroclinic zone - real :: zc, zi ! Depths in depth units (Z). + real :: zc, zi ! Depths in depth units (Z ~> m). real :: x, xd, xs, y, yd, fn real :: PI ! 3.1415926... calculated as 4*atan(1) logical :: just_read ! If true, just read parameters but set nothing. diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index 0a5589a0b6..25d0f6171c 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -35,7 +35,7 @@ subroutine benchmark_initialize_topography(D, G, param_file, max_depth, US) type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: min_depth ! The minimum and maximum depths in Z. + real :: min_depth ! The minimum and maximum depths in Z ~> m. real :: PI ! 3.1415926... calculated as 4*atan(1) real :: D0 ! A constant to make the maximum ! ! basin depth MAXIMUM_DEPTH. ! @@ -93,19 +93,19 @@ subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units (Z), + real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units (Z ~> m), ! usually negative because it is positive upward. real :: e_pert(SZK_(GV)+1) ! Interface height perturbations, positive upward, - ! in depth units (Z). + ! in depth units (Z ~> m). real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface - ! positive upward, in depth units (Z). + ! positive upward, in depth units (Z ~> m). real :: SST ! The initial sea surface temperature, in deg C. real :: T_int ! The initial temperature of an interface, in deg C. - real :: ML_depth ! The specified initial mixed layer depth, in depth units (Z). - real :: thermocline_scale ! The e-folding scale of the thermocline, in depth units (Z). + real :: ML_depth ! The specified initial mixed layer depth, in depth units (Z ~> m). + real :: thermocline_scale ! The e-folding scale of the thermocline, in depth units (Z ~> m). real, dimension(SZK_(GV)) :: T0, pres, S0, rho_guess, drho, drho_dT, drho_dS real :: a_exp ! The fraction of the overall stratification that is exponential. - real :: I_ts, I_md ! Inverse lengthscales in Z-1. + real :: I_ts, I_md ! Inverse lengthscales in Z-1 ~> m-1. real :: T_frac ! A ratio of the interface temperature to the range ! between SST and the bottom temperature. real :: err, derr_dz ! The error between the profile's temperature and the diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index 7ba02a7acc..6cc6d922eb 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -33,10 +33,10 @@ subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_para logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units (Z), usually + real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units (Z ~> m), usually ! negative because it is positive upward. real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface - ! positive upward, in in depth units (Z). + ! positive upward, in depth units (Z ~> m). real :: IC_amp ! The amplitude of the initial height displacement, in H. real :: diskrad, rad, xCenter, xRadius, lonC, latC, xOffset logical :: just_read diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 02222c9865..3b6e6e105f 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -80,13 +80,13 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, US, param_file, just_read_p logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), usually + real :: e0(SZK_(G)+1) ! The resting interface heights, in Z ~> m, usually ! negative because it is positive upward. real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in depth units (Z). - real :: min_thickness ! The minimum layer thicknesses, in Z. + ! positive upward, in Z ~> m. + real :: min_thickness ! The minimum layer thicknesses, in Z ~> m. real :: S_surf, S_range, S_ref, S_light, S_dense ! Various salinities, in ppt. - real :: eta_IC_quanta ! The granularity of quantization of intial interface heights, in Z-1. + real :: eta_IC_quanta ! The granularity of quantization of intial interface heights, in Z-1 ~> m-1. ! This include declares and sets the variable "version". # include "version_variable.h" character(len=20) :: verticalCoordinate diff --git a/src/user/external_gwave_initialization.F90 b/src/user/external_gwave_initialization.F90 index 153ec00b42..552733861f 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -32,7 +32,7 @@ subroutine external_gwave_initialize_thickness(h, G, GV, US, param_file, just_re !! only read parameters without changing h. ! Local variables real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in depth units (Z). + ! positive upward, in Z ~> m. real :: ssh_anomaly_height ! Vertical height of ssh anomaly real :: ssh_anomaly_width ! Lateral width of anomaly logical :: just_read ! If true, just read parameters but set nothing. diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 8f1ed97b06..2172fa5efb 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -83,13 +83,13 @@ subroutine seamount_initialize_thickness ( h, G, GV, US, param_file, just_read_p logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z), usually + real :: e0(SZK_(G)+1) ! The resting interface heights, in Z ~> m, usually ! negative because it is positive upward. real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in depth units (Z). - real :: min_thickness ! The minimum layer thicknesses, in Z. + ! positive upward, in Z ~> m. + real :: min_thickness ! The minimum layer thicknesses, in Z ~> m. real :: S_surf, S_range, S_ref, S_light, S_dense ! Various salinities, in ppt. - real :: eta_IC_quanta ! The granularity of quantization of intial interface heights, in Z-1. + real :: eta_IC_quanta ! The granularity of quantization of intial interface heights, in Z-1 ~> m-1. character(len=20) :: verticalCoordinate logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, nz diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index 4cef242cb1..34157e8e49 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -42,22 +42,22 @@ module user_change_diffusivity subroutine user_change_diff(h, tv, G, GV, CS, Kd_lay, Kd_int, T_f, S_f, Kd_int_add) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in Z (often m or kg m-2). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in H (often m or kg m-2). type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers !! to any available thermodynamic !! fields. Absent fields have NULL ptrs. type(user_change_diff_CS), pointer :: CS !< This module's control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity of - !! each layer in Z2 s-1. + !! each layer in Z2 s-1 ~> m2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int !< The diapycnal diffusivity - !! at each interface in Z2 s-1. + !! at each interface in Z2 s-1 ~> m2 s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: T_f !< Temperature with massless !! layers filled in vertically. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: S_f !< Salinity with massless !! layers filled in vertically. real, dimension(:,:,:), optional, pointer :: Kd_int_add !< The diapycnal !! diffusivity that is being added at - !! each interface in Z2 s-1. + !! each interface in Z2 s-1 ~> m2 s-1. ! Local variables real :: Rcv(SZI_(G),SZK_(G)) ! The coordinate density in layers in kg m-3. real :: p_ref(SZI_(G)) ! An array of tv%P_Ref pressures. diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index c94613117a..a6a36d5dd6 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -37,7 +37,7 @@ subroutine USER_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) !! structure. real, dimension(:), intent(out) :: Rlay !< Layer potential density. real, dimension(:), intent(out) :: g_prime !< The reduced gravity at - !! each interface, in m2 Z-1 s-2. + !! each interface, in m2 Z-1 s-2 ~> m s-2. type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. @@ -240,9 +240,9 @@ end subroutine write_user_log !! - u - Zonal velocity in m s-1. !! - v - Meridional velocity in m s-1. !! - h - Layer thickness in H. (Must be positive.) -!! - G%bathyT - Basin depth in Z. (Must be positive.) +!! - G%bathyT - Basin depth in Z ~> m. (Must be positive.) !! - G%CoriolisBu - The Coriolis parameter, in s-1. -!! - GV%g_prime - The reduced gravity at each interface, in m2 Z-1 s-2. +!! - GV%g_prime - The reduced gravity at each interface, in m2 Z-1 s-2 ~> m s-2. !! - GV%Rlay - Layer potential density (coordinate variable), kg m-3. !! If ENABLE_THERMODYNAMICS is defined: !! - T - Temperature in C. From 0d4933178801028930b5d8c5d80232698189fa37 Mon Sep 17 00:00:00 2001 From: mvertens Date: Mon, 3 Dec 2018 16:15:38 -0700 Subject: [PATCH 0937/1072] modifications to nuopc cap that are up to date with moa cap --- config_src/nuopc_driver/MOM_ocean_model.F90 | 50 ++- config_src/nuopc_driver/mom_cap.F90 | 364 +++++++++++++++----- config_src/nuopc_driver/mom_cap_methods.F90 | 44 ++- 3 files changed, 353 insertions(+), 105 deletions(-) diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 17d66789b5..3ffa1e8d5f 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -121,6 +121,7 @@ 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(), & !< Instantaneous heat used to melt sea ice (in J/m^2) area => NULL() !< cell area of the ocean surface, in m2. type(coupler_2d_bc_type) :: fields !< A structure that may contain named !! arrays of tracer-related surface fields. @@ -242,6 +243,12 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! 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. @@ -343,10 +350,22 @@ 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"//& + "melt potential will not be computed.", units="m", default=-1.0, do_not_log=.true.) + + if (HFrz .gt. 0.0) then + use_melt_pot=.true. + else + use_melt_pot=.false. + endif + ! 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) + do_integrals=.true., gas_fields_ocn=gas_fields_ocn, use_meltpot=use_melt_pot) call surface_forcing_init(Time_in, OS%grid, param_file, OS%diag, & OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) @@ -797,6 +816,7 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, Ocean_sfc%v_surf (isc:iec,jsc:jec), & Ocean_sfc%sea_lev(isc:iec,jsc:jec), & Ocean_sfc%area (isc:iec,jsc:jec), & + Ocean_sfc%melt_potential(isc:iec,jsc:jec), & Ocean_sfc%frazil (isc:iec,jsc:jec)) Ocean_sfc%t_surf = 0.0 ! time averaged sst (Kelvin) passed to atmosphere/ice model @@ -805,6 +825,7 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, Ocean_sfc%v_surf = 0.0 ! time averaged v-current (m/sec) passed to atmosphere/ice models Ocean_sfc%sea_lev = 0.0 ! time averaged thickness of top model grid cell (m) plus patm/rho0/grav Ocean_sfc%frazil = 0.0 ! time accumulated frazil (J/m^2) passed to ice model + Ocean_sfc%melt_potential = 0.0 ! time accumulated melt potential (J/m^2) passed to ice model Ocean_sfc%area = 0.0 Ocean_sfc%axes = diag%axesT1%handles !diag axes to be used by coupler tracer flux diagnostics @@ -889,6 +910,12 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z 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 (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) * & @@ -1057,25 +1084,25 @@ subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc) case('btfHeat') array2D(isc:,jsc:) = 0 case('tlat') - array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) case('tlon') - array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) case('ulat') - array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) case('ulon') - array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) case('vlat') - array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) case('vlon') - array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) case('geoLatBu') - array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) case('geoLonBu') - array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) case('cos_rot') - array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 + array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 case('sin_rot') - array2D(isc:,jsc:) = OS%grid%sin_rot(g_isc:g_iec,g_jsc:g_jec) ! =0 + array2D(isc:,jsc:) = OS%grid%sin_rot(g_isc:g_iec,g_jsc:g_jec) ! =0 case default call MOM_error(FATAL,'get_ocean_grid_data2D: unknown argument name='//name) end select @@ -1121,6 +1148,7 @@ 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%melt_potential ',mpp_chksum(ocn%melt_potential) call coupler_type_write_chksums(ocn%fields, outunit, 'ocean%') 100 FORMAT(" CHECKSUM::",A20," = ",Z20) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index eb8c003945..8e083fbe55 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -404,9 +404,9 @@ module mom_cap_mod use, intrinsic :: iso_fortran_env, only: output_unit - use ESMF - use NUOPC - use NUOPC_Model, & + use ESMF + use NUOPC + use NUOPC_Model, & model_routine_SS => SetServices, & model_label_Advance => label_Advance, & model_label_DataInitialize => label_DataInitialize, & @@ -456,7 +456,7 @@ module mom_cap_mod logical :: grid_attach_area = .false. character(len=128) :: scalar_field_name integer :: scalar_field_count - integer :: scalar_field_idx_grid_nx + integer :: scalar_field_idx_grid_nx integer :: scalar_field_idx_grid_ny character(len=*),parameter :: u_file_u = & __FILE__ @@ -578,23 +578,23 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + write_diagnostics = .false. call NUOPC_CompAttributeGet(gcomp, name="DumpFields", value=value, & isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) write_diagnostics=(trim(value)=="true") - + write(logmsg,*) write_diagnostics call ESMF_LogWrite('mom_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return profile_memory = .false. call NUOPC_CompAttributeGet(gcomp, name="ProfileMemory", value=value, & @@ -602,14 +602,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) profile_memory=(trim(value)=="true") write(logmsg,*) profile_memory call ESMF_LogWrite('mom_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return grid_attach_area = .false. call NUOPC_CompAttributeGet(gcomp, name="GridAttachArea", value=value, & @@ -617,14 +617,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) grid_attach_area=(trim(value)=="true") write(logmsg,*) grid_attach_area call ESMF_LogWrite('mom_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return scalar_field_name = "" call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=value, & @@ -632,14 +632,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - if (isPresent .and. isSet) then + return + if (isPresent .and. isSet) then scalar_field_name = trim(value) call ESMF_LogWrite('mom_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_count = 0 @@ -648,7 +648,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_count if (iostat /= 0) then @@ -662,7 +662,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_idx_grid_nx = 0 @@ -671,7 +671,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_nx if (iostat /= 0) then @@ -685,7 +685,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_idx_grid_ny = 0 @@ -694,7 +694,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny if (iostat /= 0) then @@ -708,16 +708,16 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - call NUOPC_CompAttributeAdd(gcomp, & + call NUOPC_CompAttributeAdd(gcomp, & attrList=(/'RestartFileToRead', 'RestartFileToWrite'/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + end subroutine !=============================================================================== @@ -766,7 +766,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: userRc character(len=512) :: restartfile ! Path/Name of restart file character(len=*), parameter :: subname='(mom_cap:InitializeAdvertise)' - !-------------------------------- + real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_frzmlt + real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_dhdx + real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_dhdy +!-------------------------------- rc = ESMF_SUCCESS @@ -774,7 +777,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return allocate(Ice_ocean_boundary) !allocate(ocean_state) ! ocean_model_init allocate this pointer @@ -827,11 +830,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! rsd need to figure out how to get this without share code !call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - !inst_name = "OCN"//trim(inst_suffix) + !inst_name = "OCN"//trim(inst_suffix) ! reset shr logging to my log file if (is_root_pe()) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & isPresent=isPresentDiro, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -842,7 +845,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresentDiro .and. isPresentLogfile) then open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) else @@ -853,7 +856,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) endif starttype = "" - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -867,7 +870,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif runtype = "" @@ -881,7 +884,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//": unknown starttype - "//trim(starttype), & line=__LINE__, file=__FILE__, rcToReturn=rc) - return + return endif if (len_trim(runtype) > 0) then @@ -889,9 +892,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - + restartfile = "" if (runtype == "initial") then ! startup (new run) - 'n' is needed below if we don't specify input_filename in input.nml @@ -914,36 +917,36 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - + call NUOPC_CompAttributeGet(gcomp, name='RestartFileToRead', & value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then restartfile = trim(cvalue) call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return else - call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & + call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & ESMF_LOGMSG_WARNING, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif end if - + ocean_public%is_ocean_pe = .true. if (len_trim(restartfile) > 0) then - call ocean_model_init(ocean_public, ocean_state, Time, Time, & + call ocean_model_init(ocean_public, ocean_state, Time, Time, & input_restart_file=trim(restartfile)) else call ocean_model_init(ocean_public, ocean_state, Time, Time) @@ -1008,7 +1011,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx @@ -1020,7 +1023,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - + ! EMC fields not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn @@ -1037,7 +1040,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") @@ -1103,19 +1106,18 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide") ! -> s_surf call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u" , "will provide") ! -> ocn_current_zonal call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! -> sea_surface_slope_zonal + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! -> sea_surface_slope_merid + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! -> freezing_melting_potential ! EMC fields not used - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") ! not in CESM - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") ! not in CESM + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev", "will provide") ! not in CESM ! Optional CESM fields currently not used - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen" , "will provide") ! not in EMC + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen", "will provide") ! not in EMC ! if (flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") ! end if @@ -1177,8 +1179,18 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide",& data=ocean_public%sea_lev) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide",& - data=ocean_public%frazil) + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide",& + ! data=ocean_public%frazil) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "accum_heat_frazil" , "will provide",& + data=Ocean_public%frazil) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "inst_melt_potential" , "will provide",& + data=Ocean_public%melt_potential) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential", "will provide", & + data=dataPtr_frzmlt) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide",& + data=ocean_public%frazil) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide",& + data=ocean_public%frazil) !JW #endif @@ -1303,7 +1315,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + !--------------------------------- ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total !--------------------------------- @@ -1324,7 +1336,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return - + !--------------------------------- ! get start and end indices of each tile and their PET !--------------------------------- @@ -1339,10 +1351,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return enddo end if - + !--------------------------------- ! create delayout and distgrid @@ -1425,7 +1437,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1437,9 +1449,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return deallocate(IndexList) - + !--------------------------------- ! create grid !--------------------------------- @@ -1730,7 +1742,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & scalar_field_name, scalar_field_count, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1783,7 +1795,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! line=__LINE__, & ! file=__FILE__)) & ! return ! bail out - + end subroutine InitializeRealize !=============================================================================== @@ -1914,6 +1926,7 @@ subroutine ModelAdvance(gcomp, rc) integer :: dth, dtm, dts, dt_cpld = 86400 integer :: isc,iec,jsc,jec,lbnd1,ubnd1,lbnd2,ubnd2 integer :: i,j,i1,j1 + real :: slp_L, slp_R, slp_C, slope, u_min, u_max !JW integer :: nc type(ESMF_Time) :: MyTime integer :: seconds, day, year, month, hour, minute @@ -1927,12 +1940,22 @@ subroutine ModelAdvance(gcomp, rc) real(ESMF_KIND_R8), pointer :: dataPtr_ocz(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_ocm(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_melt_potential(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_frzmlt(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) !JW + real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) !JW real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) + real(ESMF_KIND_R8), allocatable :: ssh(:,:) + real(ESMF_KIND_R8), allocatable :: sshx(:,:) + real(ESMF_KIND_R8), allocatable :: sshy(:,:) #endif type(ocean_grid_type), pointer :: ocean_grid character(240) :: msgString character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' + ! helper flag for debugging bounds + logical :: BoundsDebug = .false. + integer :: ijloc(2) !-------------------------------- rc = ESMF_SUCCESS @@ -2021,6 +2044,7 @@ subroutine ModelAdvance(gcomp, rc) call get_ocean_grid(ocean_state, ocean_grid) #ifdef CESMCOUPLED + call shr_file_setLogUnit (logunit) call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, logunit, runtype, clock, rc=rc) @@ -2028,7 +2052,9 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out + #else + call State_getFldPtr(exportState,'ocean_mask',dataPtr_mask,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2081,7 +2107,7 @@ subroutine ModelAdvance(gcomp, rc) mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) + + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) enddo enddo dataPtr_mzmf = mzmf @@ -2114,6 +2140,7 @@ subroutine ModelAdvance(gcomp, rc) if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") #ifdef CESMCOUPLED + call mom_export(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2151,14 +2178,175 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) + !call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + ! fixfrzmlt !JW + call State_getFldPtr(exportState,'accum_heat_frazil',dataPtr_frazil,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'inst_melt_potential',dataPtr_melt_potential,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frzmlt,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'sea_surface_slope_zonal',dataPtr_dhdx,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'sea_surface_slope_merid',dataPtr_dhdy,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out !JW + + allocate( ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW + allocate(sshx(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW + allocate(sshy(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW + ssh = 0.0_ESMF_KIND_R8 !JW + sshx = 0.0_ESMF_KIND_R8 !JW + sshy = 0.0_ESMF_KIND_R8 !JW + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! note: the following code is modified from NCAR nuopc driver mom_cap_methods + ! where is the rotation in that system? + ! + ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain + ! in order to update halos. i.e. does not use global indexing. + ! + ! here, isc,iec,jsc,jec are global indices on cap domain (no halos) + + do j=jsc,jec + do i=isc,iec + j1 = j - ocean_grid%jdg_offset + i1 = i - ocean_grid%idg_offset + ssh(i1,j1) = Ocean_public%sea_lev(i,j) + end do + end do + + ! Update halo of ssh so we can calculate gradients + call pass_var(ssh, ocean_grid%domain) + + ! calculation of slope on native mom domains (local indexing, halos) + ! stay inside of halos (ie 2:79,2:97) + ! d/dx ssh + do j = ocean_grid%jsd+1,ocean_grid%jed-1 + do i = ocean_grid%isd+1,ocean_grid%ied-1 + ! This is a simple second-order difference + !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = (ssh(I,j) - ssh(I-1,j)) * ocean_grid%mask2dCu(i-1,j) + if (ocean_grid%mask2dCu(i-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * ocean_grid%mask2dCu(i,j) + if (ocean_grid%mask2dCu(i+1,j)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + if ( (slp_L * slp_R) > 0.0 ) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + sshx(i,j) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) sshx(i,j) = 0.0 + end do + end do + + ! d/dy ssh + do j = ocean_grid%jsd+1,ocean_grid%jed-1 + do i = ocean_grid%isd+1,ocean_grid%ied-1 + ! This is a simple second-order difference + !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = ssh(i,J) - ssh(i,J-1) * ocean_grid%mask2dCv(i,j-1) + if (ocean_grid%mask2dCv(i,j-1)==0.) slp_L = 0. + slp_R = ssh(i,J+1) - ssh(i,J) * ocean_grid%mask2dCv(i,j) + if (ocean_grid%mask2dCv(i,j+1)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R + if ((slp_L * slp_R) > 0.0) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + sshy(i,j) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) sshy(i,j) = 0.0 + end do + end do + ! rotate slopes from tripolar grid back to lat/lon grid (CCW) + ! "grid" uses the usual MOM domain that has halos + ! and does not use global indexing. + ! x,y => latlon + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j + ocean_grid%jsc - lbnd2 + i1 = i + ocean_grid%isc - lbnd1 + dataPtr_dhdx(i,j) = ocean_grid%cos_rot(i1,j1)*sshx(i1,j1) & + + ocean_grid%sin_rot(i1,j1)*sshy(i1,j1) + dataPtr_dhdy(i,j) = ocean_grid%cos_rot(i1,j1)*sshy(i1,j1) & + - ocean_grid%sin_rot(i1,j1)*sshx(i1,j1) + enddo + enddo + deallocate(ssh); deallocate(sshx); deallocate(sshy) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling + dataPtr_melt_potential = -dataPtr_melt_potential/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling + !melt_potential, defined positive for T>Tfreeze + !so change sign + !testing + ijloc = maxloc(dataPtr_frazil) + if((sum(ijloc) .gt. 2) .and. & + (dataPtr_frazil(ijloc(1),ijloc(2)) .gt. 0.0))then + i1 = ijloc(1) - lbnd1 + isc + j1 = ijloc(2) - lbnd2 + jsc ! work around local vs global indexing + write (msgString,*)' MOM6 dataPtr_frazil at maxloc ',i1,j1,& + real(dataPtr_frazil(ijloc(1),ijloc(2)),4) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + + write (msgString,*)' MOM6 dataPtr_melt_potential at maxloc ',i1,j1,& + real(dataPtr_melt_potential(ijloc(1),ijloc(2)),4) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + endif + !testing + + dataPtr_melt_potential = min(dataPtr_melt_potential,0.0) + + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + if(dataPtr_frazil(i,j) .eq. 0.0)then + dataPtr_frzmlt(i,j) = dataPtr_melt_potential(i,j) + else + dataPtr_frzmlt(i,j) = dataPtr_frazil(i,j) + endif + enddo + enddo + dataPtr_frzmlt = max(-1000.0,min(1000.0,dataPtr_frzmlt)) + ! rotate ocn current from tripolar grid back to lat/lon grid (CCW) + ! "grid" uses the usual MOM domain that has halos + ! and does not use global indexing. + ! x,y => latlon ocz = dataPtr_ocz ocm = dataPtr_ocm do j = lbnd2, ubnd2 @@ -2177,26 +2365,26 @@ subroutine ModelAdvance(gcomp, rc) deallocate(ocz, ocm) #endif - + ! If restart alarm is ringing - write restart file call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmRingerOff(alarm, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + ! call into system specific method to get desired restart filename restartname = "" call ESMF_MethodExecute(gcomp, label="GetRestartFileToWrite", & @@ -2230,7 +2418,7 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out endif endif - + if (len_trim(restartname) == 0) then ! none provided, so use a default restart filename call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) @@ -2244,7 +2432,7 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & + write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & "ocn", year, month, day, hour, minute, seconds call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -2252,15 +2440,15 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out endif - + ! write restart file(s) call ocean_model_restart(ocean_state, restartname=restartname) - + if (is_root_pe()) then write(logunit,*) subname//' writing restart file ',trim(restartname) end if endif - + if (write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & timeslice=export_slice, relaxedFlag=.true., rc=rc) @@ -2270,9 +2458,9 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out export_slice = export_slice + 1 endif - + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") - + end subroutine ModelAdvance !=============================================================================== @@ -2354,9 +2542,9 @@ subroutine ModelSetRunClock(gcomp, rc) return ! bail out if (first_time) then - !-------------------------------- + !-------------------------------- ! set restart alarm - !-------------------------------- + !-------------------------------- ! defaults restart_n = 0 @@ -2390,7 +2578,7 @@ subroutine ModelSetRunClock(gcomp, rc) else restart_option = "none" endif - + call AlarmInit(mclock, & alarm = restart_alarm, & option = trim(restart_option), & @@ -2402,21 +2590,21 @@ subroutine ModelSetRunClock(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out first_time = .false. - - call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & + + call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + end if !-------------------------------- @@ -2537,7 +2725,7 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ integer, intent(in) :: scalar_id type(ESMF_State), intent(inout) :: State integer, intent(in) :: mytask - character(len=*), intent(in) :: scalar_name + character(len=*), intent(in) :: scalar_name integer, intent(in) :: scalar_count integer, intent(inout) :: rc @@ -2635,14 +2823,14 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + ! initialize to zero call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - fldptr = 0.0 + fldptr = 0.0 endif diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 6e3558efc5..34946cefdb 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -1,8 +1,10 @@ module mom_cap_methods - use ESMF, only: ESMF_time, ESMF_ClockGet, ESMF_TimeGet, ESMF_State, ESMF_Clock + use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet + use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalTeg + use ESMF, only: ESMF_State, ESMF_StateGet use ESMF, only: ESMF_KIND_R8, ESMF_Field, ESMF_SUCCESS, ESMF_LogFoundError - use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_StateGet, ESMF_FieldGet + use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_FieldGet use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE use MOM_ocean_model, only: ocean_public_type, ocean_state_type use MOM_surface_forcing, only: ice_ocean_boundary_type @@ -47,6 +49,7 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices integer :: lbnd1, lbnd2 real :: slp_L, slp_R, slp_C, slope, u_min, u_max + real :: I_time_int !< The inverse of coupling time interval in s-1. integer :: day, secs type(ESMF_time) :: currTime real(ESMF_KIND_R8), pointer :: dataPtr_omask(:,:) @@ -58,6 +61,8 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:,:) + type(ESMF_TimeInterval) :: timeStep + integer :: dt_int !< time over which to advance the ocean (ocean_coupling_time_step), in sec character(len=*), parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" character(len=*), parameter :: subname = '(mom_export)' !----------------------------------------------------------------------- @@ -116,6 +121,23 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + ! Use Adcroft's rule of reciprocals; it does the right thing here. + call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_TimeIntervalGet( timeStep, s=dt_int, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (real(dt_int) > 0.0) then + I_time_int = 1.0 / real(dt_int) + else + I_time_int = 0.0 + end if + ! Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. ! The mask comes from "grid" that uses the usual MOM domain that has halos ! and does not use global indexing. @@ -132,10 +154,20 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) dataPtr_v(i1,j1) = ocean_public%v_surf(i,j) * grid%mask2dT(ig,jg) dataPtr_q(i1,j1) = 0. dataPtr_bldepth(i1,j1) = 0. ! TODO: this needs to be generalized - !dataPtr_u(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%u_surf(i,j) & - ! - grid%sin_rot(ig,jg) * ocean_public%v_surf(i,j)) * grid%mask2dT(ig,jg) - !dataPtr_v(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%v_surf(i,j) & - ! + grid%sin_rot(ig,jg) * ocean_public%u_surf(i,j)) * grid%mask2dT(ig,jg) + + ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 + if (ocn_public%frazil(ig,jg) > 0.0) then + ! Frazil: change from J/m^2 to W/m^2 + dataPtr_Fioo_q(i1,j1) = ocn_public%frazil(i,j) * grid%mask2dT(ig,jg) * I_time_int + else + ! Melt_potential: change from J/m^2 to W/m^2 + dataPtr_Fioo_q(i1,j1) = -ocn_public%melt_potential(i,j) * grid%mask2dT(ig,jg) * I_time_int !* ncouple_per_day + + ! make sure Melt_potential is always <= 0 + if (dataPtr_Fioo_q(i1,j1) > 0.0) then + dataPtr_Fioo_q(i1,j1) = 0.0 + endif + end if end do end do From c284cdd5d7a5127fcb76244a119966dee4b83a60 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 3 Dec 2018 16:46:21 -0700 Subject: [PATCH 0938/1072] Adds meltw and melth into FW_in and heat_in, respectively --- src/diagnostics/MOM_sum_output.F90 | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 91a4dd96ab..6640a864c2 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -952,6 +952,10 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) endif endif + if (associated(fluxes%meltw)) then ; do j=js,je ; do i=is,ie + FW_in(i,j) = FW_in(i,j) + dt * G%areaT(i,j) * fluxes%meltw(i,j) + enddo ; enddo ; endif + salt_in(:,:) = 0.0 ; heat_in(:,:) = 0.0 if (CS%use_temperature) then @@ -960,6 +964,10 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) (fluxes%lw(i,j) + (fluxes%latent(i,j) + fluxes%sens(i,j)))) enddo ; enddo ; endif + if (associated(fluxes%melth)) then ; do j=js,je ; do i=is,ie + heat_in(i,j) = heat_in(i,j) + dt*G%areaT(i,j) * fluxes%melth(i,j) + enddo ; enddo ; endif + ! smg: new code ! include heat content from water transport across ocean surface ! if (associated(fluxes%heat_content_lprec)) then ; do j=js,je ; do i=is,ie From a910cd00df0e15d1d0716d4e72b42959b986ca26 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 3 Dec 2018 16:47:50 -0700 Subject: [PATCH 0939/1072] Adds meltw into net_mass_src --- src/core/MOM_forcing_type.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index fc688f15c0..03a568b4f4 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -2103,7 +2103,7 @@ subroutine get_net_mass_forcing(fluxes, G, net_mass_src) net_mass_src(i,j) = net_mass_src(i,j) + fluxes%evap(i,j) enddo ; enddo ; endif if (associated(fluxes%meltw)) then ; do j=js,je ; do i=is,ie - forces%net_mass_src(i,j) = forces%net_mass_src(i,j) + fluxes%meltw(i,j) + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%meltw(i,j) enddo ; enddo ; endif end subroutine get_net_mass_forcing From f9a3a8122d5cbc59c740b47b65d7510069998e9b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 3 Dec 2018 22:54:12 -0700 Subject: [PATCH 0940/1072] latest updates to get cap up to date with dev/ncar and working --- config_src/nuopc_driver/MOM_ocean_model.F90 | 50 +-- config_src/nuopc_driver/mom_cap.F90 | 364 +++++--------------- config_src/nuopc_driver/mom_cap_methods.F90 | 44 +-- config_src/nuopc_driver/time_utils.F90 | 161 +++++++++ 4 files changed, 266 insertions(+), 353 deletions(-) create mode 100644 config_src/nuopc_driver/time_utils.F90 diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 3ffa1e8d5f..17d66789b5 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -121,7 +121,6 @@ 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(), & !< Instantaneous heat used to melt sea ice (in J/m^2) area => NULL() !< cell area of the ocean surface, in m2. type(coupler_2d_bc_type) :: fields !< A structure that may contain named !! arrays of tracer-related surface fields. @@ -243,12 +242,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! 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. @@ -350,22 +343,10 @@ 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"//& - "melt potential will not be computed.", units="m", default=-1.0, do_not_log=.true.) - - if (HFrz .gt. 0.0) then - use_melt_pot=.true. - else - use_melt_pot=.false. - endif - ! 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) + do_integrals=.true., gas_fields_ocn=gas_fields_ocn) call surface_forcing_init(Time_in, OS%grid, param_file, OS%diag, & OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) @@ -816,7 +797,6 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, Ocean_sfc%v_surf (isc:iec,jsc:jec), & Ocean_sfc%sea_lev(isc:iec,jsc:jec), & Ocean_sfc%area (isc:iec,jsc:jec), & - Ocean_sfc%melt_potential(isc:iec,jsc:jec), & Ocean_sfc%frazil (isc:iec,jsc:jec)) Ocean_sfc%t_surf = 0.0 ! time averaged sst (Kelvin) passed to atmosphere/ice model @@ -825,7 +805,6 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, Ocean_sfc%v_surf = 0.0 ! time averaged v-current (m/sec) passed to atmosphere/ice models Ocean_sfc%sea_lev = 0.0 ! time averaged thickness of top model grid cell (m) plus patm/rho0/grav Ocean_sfc%frazil = 0.0 ! time accumulated frazil (J/m^2) passed to ice model - Ocean_sfc%melt_potential = 0.0 ! time accumulated melt potential (J/m^2) passed to ice model Ocean_sfc%area = 0.0 Ocean_sfc%axes = diag%axesT1%handles !diag axes to be used by coupler tracer flux diagnostics @@ -910,12 +889,6 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z 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 (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) * & @@ -1084,25 +1057,25 @@ subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc) case('btfHeat') array2D(isc:,jsc:) = 0 case('tlat') - array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) case('tlon') - array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) case('ulat') - array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) case('ulon') - array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) case('vlat') - array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) case('vlon') - array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) case('geoLatBu') - array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) case('geoLonBu') - array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) case('cos_rot') - array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 + array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 case('sin_rot') - array2D(isc:,jsc:) = OS%grid%sin_rot(g_isc:g_iec,g_jsc:g_jec) ! =0 + array2D(isc:,jsc:) = OS%grid%sin_rot(g_isc:g_iec,g_jsc:g_jec) ! =0 case default call MOM_error(FATAL,'get_ocean_grid_data2D: unknown argument name='//name) end select @@ -1148,7 +1121,6 @@ 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%melt_potential ',mpp_chksum(ocn%melt_potential) call coupler_type_write_chksums(ocn%fields, outunit, 'ocean%') 100 FORMAT(" CHECKSUM::",A20," = ",Z20) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 8e083fbe55..eb8c003945 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -404,9 +404,9 @@ module mom_cap_mod use, intrinsic :: iso_fortran_env, only: output_unit - use ESMF - use NUOPC - use NUOPC_Model, & + use ESMF + use NUOPC + use NUOPC_Model, & model_routine_SS => SetServices, & model_label_Advance => label_Advance, & model_label_DataInitialize => label_DataInitialize, & @@ -456,7 +456,7 @@ module mom_cap_mod logical :: grid_attach_area = .false. character(len=128) :: scalar_field_name integer :: scalar_field_count - integer :: scalar_field_idx_grid_nx + integer :: scalar_field_idx_grid_nx integer :: scalar_field_idx_grid_ny character(len=*),parameter :: u_file_u = & __FILE__ @@ -578,23 +578,23 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + write_diagnostics = .false. call NUOPC_CompAttributeGet(gcomp, name="DumpFields", value=value, & isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) write_diagnostics=(trim(value)=="true") - + write(logmsg,*) write_diagnostics call ESMF_LogWrite('mom_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return profile_memory = .false. call NUOPC_CompAttributeGet(gcomp, name="ProfileMemory", value=value, & @@ -602,14 +602,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) profile_memory=(trim(value)=="true") write(logmsg,*) profile_memory call ESMF_LogWrite('mom_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return grid_attach_area = .false. call NUOPC_CompAttributeGet(gcomp, name="GridAttachArea", value=value, & @@ -617,14 +617,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) grid_attach_area=(trim(value)=="true") write(logmsg,*) grid_attach_area call ESMF_LogWrite('mom_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return scalar_field_name = "" call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=value, & @@ -632,14 +632,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - if (isPresent .and. isSet) then + return + if (isPresent .and. isSet) then scalar_field_name = trim(value) call ESMF_LogWrite('mom_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_count = 0 @@ -648,7 +648,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_count if (iostat /= 0) then @@ -662,7 +662,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_idx_grid_nx = 0 @@ -671,7 +671,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_nx if (iostat /= 0) then @@ -685,7 +685,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_idx_grid_ny = 0 @@ -694,7 +694,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny if (iostat /= 0) then @@ -708,16 +708,16 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - call NUOPC_CompAttributeAdd(gcomp, & + call NUOPC_CompAttributeAdd(gcomp, & attrList=(/'RestartFileToRead', 'RestartFileToWrite'/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + end subroutine !=============================================================================== @@ -766,10 +766,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: userRc character(len=512) :: restartfile ! Path/Name of restart file character(len=*), parameter :: subname='(mom_cap:InitializeAdvertise)' - real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_frzmlt - real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_dhdx - real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_dhdy -!-------------------------------- + !-------------------------------- rc = ESMF_SUCCESS @@ -777,7 +774,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return allocate(Ice_ocean_boundary) !allocate(ocean_state) ! ocean_model_init allocate this pointer @@ -830,11 +827,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! rsd need to figure out how to get this without share code !call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - !inst_name = "OCN"//trim(inst_suffix) + !inst_name = "OCN"//trim(inst_suffix) ! reset shr logging to my log file if (is_root_pe()) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & isPresent=isPresentDiro, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -845,7 +842,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresentDiro .and. isPresentLogfile) then open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) else @@ -856,7 +853,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) endif starttype = "" - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -870,7 +867,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif runtype = "" @@ -884,7 +881,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//": unknown starttype - "//trim(starttype), & line=__LINE__, file=__FILE__, rcToReturn=rc) - return + return endif if (len_trim(runtype) > 0) then @@ -892,9 +889,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - + restartfile = "" if (runtype == "initial") then ! startup (new run) - 'n' is needed below if we don't specify input_filename in input.nml @@ -917,36 +914,36 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - + call NUOPC_CompAttributeGet(gcomp, name='RestartFileToRead', & value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then restartfile = trim(cvalue) call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return else - call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & + call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & ESMF_LOGMSG_WARNING, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif end if - + ocean_public%is_ocean_pe = .true. if (len_trim(restartfile) > 0) then - call ocean_model_init(ocean_public, ocean_state, Time, Time, & + call ocean_model_init(ocean_public, ocean_state, Time, Time, & input_restart_file=trim(restartfile)) else call ocean_model_init(ocean_public, ocean_state, Time, Time) @@ -1011,7 +1008,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx @@ -1023,7 +1020,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - + ! EMC fields not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn @@ -1040,7 +1037,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") @@ -1106,18 +1103,19 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide") ! -> s_surf call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u" , "will provide") ! -> ocn_current_zonal call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! -> sea_surface_slope_zonal - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! -> sea_surface_slope_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! -> freezing_melting_potential + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! not in EMC ! EMC fields not used - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev", "will provide") ! not in CESM + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") ! not in CESM + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") ! not in CESM ! Optional CESM fields currently not used - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen", "will provide") ! not in EMC + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen" , "will provide") ! not in EMC ! if (flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") ! end if @@ -1179,18 +1177,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide",& data=ocean_public%sea_lev) - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide",& - ! data=ocean_public%frazil) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "accum_heat_frazil" , "will provide",& - data=Ocean_public%frazil) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "inst_melt_potential" , "will provide",& - data=Ocean_public%melt_potential) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential", "will provide", & - data=dataPtr_frzmlt) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide",& - data=ocean_public%frazil) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide",& - data=ocean_public%frazil) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide",& + data=ocean_public%frazil) #endif @@ -1315,7 +1303,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + !--------------------------------- ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total !--------------------------------- @@ -1336,7 +1324,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return - + !--------------------------------- ! get start and end indices of each tile and their PET !--------------------------------- @@ -1351,10 +1339,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return enddo end if - + !--------------------------------- ! create delayout and distgrid @@ -1437,7 +1425,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1449,9 +1437,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return deallocate(IndexList) - + !--------------------------------- ! create grid !--------------------------------- @@ -1742,7 +1730,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & scalar_field_name, scalar_field_count, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1795,7 +1783,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! line=__LINE__, & ! file=__FILE__)) & ! return ! bail out - + end subroutine InitializeRealize !=============================================================================== @@ -1926,7 +1914,6 @@ subroutine ModelAdvance(gcomp, rc) integer :: dth, dtm, dts, dt_cpld = 86400 integer :: isc,iec,jsc,jec,lbnd1,ubnd1,lbnd2,ubnd2 integer :: i,j,i1,j1 - real :: slp_L, slp_R, slp_C, slope, u_min, u_max !JW integer :: nc type(ESMF_Time) :: MyTime integer :: seconds, day, year, month, hour, minute @@ -1940,22 +1927,12 @@ subroutine ModelAdvance(gcomp, rc) real(ESMF_KIND_R8), pointer :: dataPtr_ocz(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_ocm(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_melt_potential(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_frzmlt(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) !JW - real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) !JW real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) - real(ESMF_KIND_R8), allocatable :: ssh(:,:) - real(ESMF_KIND_R8), allocatable :: sshx(:,:) - real(ESMF_KIND_R8), allocatable :: sshy(:,:) #endif type(ocean_grid_type), pointer :: ocean_grid character(240) :: msgString character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' - ! helper flag for debugging bounds - logical :: BoundsDebug = .false. - integer :: ijloc(2) !-------------------------------- rc = ESMF_SUCCESS @@ -2044,7 +2021,6 @@ subroutine ModelAdvance(gcomp, rc) call get_ocean_grid(ocean_state, ocean_grid) #ifdef CESMCOUPLED - call shr_file_setLogUnit (logunit) call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, logunit, runtype, clock, rc=rc) @@ -2052,9 +2028,7 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - #else - call State_getFldPtr(exportState,'ocean_mask',dataPtr_mask,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2107,7 +2081,7 @@ subroutine ModelAdvance(gcomp, rc) mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) + + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) enddo enddo dataPtr_mzmf = mzmf @@ -2140,7 +2114,6 @@ subroutine ModelAdvance(gcomp, rc) if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") #ifdef CESMCOUPLED - call mom_export(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2178,175 +2151,14 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - !call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! fixfrzmlt !JW - call State_getFldPtr(exportState,'accum_heat_frazil',dataPtr_frazil,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'inst_melt_potential',dataPtr_melt_potential,rc=rc) + call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frzmlt,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'sea_surface_slope_zonal',dataPtr_dhdx,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'sea_surface_slope_merid',dataPtr_dhdy,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out !JW - - allocate( ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW - allocate(sshx(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW - allocate(sshy(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW - ssh = 0.0_ESMF_KIND_R8 !JW - sshx = 0.0_ESMF_KIND_R8 !JW - sshy = 0.0_ESMF_KIND_R8 !JW - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! note: the following code is modified from NCAR nuopc driver mom_cap_methods - ! where is the rotation in that system? - ! - ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain - ! in order to update halos. i.e. does not use global indexing. - ! - ! here, isc,iec,jsc,jec are global indices on cap domain (no halos) - - do j=jsc,jec - do i=isc,iec - j1 = j - ocean_grid%jdg_offset - i1 = i - ocean_grid%idg_offset - ssh(i1,j1) = Ocean_public%sea_lev(i,j) - end do - end do - - ! Update halo of ssh so we can calculate gradients - call pass_var(ssh, ocean_grid%domain) - - ! calculation of slope on native mom domains (local indexing, halos) - ! stay inside of halos (ie 2:79,2:97) - ! d/dx ssh - do j = ocean_grid%jsd+1,ocean_grid%jed-1 - do i = ocean_grid%isd+1,ocean_grid%ied-1 - ! This is a simple second-order difference - !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = (ssh(I,j) - ssh(I-1,j)) * ocean_grid%mask2dCu(i-1,j) - if (ocean_grid%mask2dCu(i-1,j)==0.) slp_L = 0. - slp_R = (ssh(I+1,j) - ssh(I,j)) * ocean_grid%mask2dCu(i,j) - if (ocean_grid%mask2dCu(i+1,j)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - if ( (slp_L * slp_R) > 0.0 ) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - sshx(i,j) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) sshx(i,j) = 0.0 - end do - end do - - ! d/dy ssh - do j = ocean_grid%jsd+1,ocean_grid%jed-1 - do i = ocean_grid%isd+1,ocean_grid%ied-1 - ! This is a simple second-order difference - !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = ssh(i,J) - ssh(i,J-1) * ocean_grid%mask2dCv(i,j-1) - if (ocean_grid%mask2dCv(i,j-1)==0.) slp_L = 0. - slp_R = ssh(i,J+1) - ssh(i,J) * ocean_grid%mask2dCv(i,j) - if (ocean_grid%mask2dCv(i,j+1)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R - if ((slp_L * slp_R) > 0.0) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - sshy(i,j) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) sshy(i,j) = 0.0 - end do - end do - ! rotate slopes from tripolar grid back to lat/lon grid (CCW) - ! "grid" uses the usual MOM domain that has halos - ! and does not use global indexing. - ! x,y => latlon - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j + ocean_grid%jsc - lbnd2 - i1 = i + ocean_grid%isc - lbnd1 - dataPtr_dhdx(i,j) = ocean_grid%cos_rot(i1,j1)*sshx(i1,j1) & - + ocean_grid%sin_rot(i1,j1)*sshy(i1,j1) - dataPtr_dhdy(i,j) = ocean_grid%cos_rot(i1,j1)*sshy(i1,j1) & - - ocean_grid%sin_rot(i1,j1)*sshx(i1,j1) - enddo - enddo - deallocate(ssh); deallocate(sshx); deallocate(sshy) - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling - dataPtr_melt_potential = -dataPtr_melt_potential/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling - !melt_potential, defined positive for T>Tfreeze - !so change sign - !testing - ijloc = maxloc(dataPtr_frazil) - if((sum(ijloc) .gt. 2) .and. & - (dataPtr_frazil(ijloc(1),ijloc(2)) .gt. 0.0))then - i1 = ijloc(1) - lbnd1 + isc - j1 = ijloc(2) - lbnd2 + jsc ! work around local vs global indexing - write (msgString,*)' MOM6 dataPtr_frazil at maxloc ',i1,j1,& - real(dataPtr_frazil(ijloc(1),ijloc(2)),4) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - - write (msgString,*)' MOM6 dataPtr_melt_potential at maxloc ',i1,j1,& - real(dataPtr_melt_potential(ijloc(1),ijloc(2)),4) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - endif - !testing - - dataPtr_melt_potential = min(dataPtr_melt_potential,0.0) - - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - if(dataPtr_frazil(i,j) .eq. 0.0)then - dataPtr_frzmlt(i,j) = dataPtr_melt_potential(i,j) - else - dataPtr_frzmlt(i,j) = dataPtr_frazil(i,j) - endif - enddo - enddo - dataPtr_frzmlt = max(-1000.0,min(1000.0,dataPtr_frzmlt)) - ! rotate ocn current from tripolar grid back to lat/lon grid (CCW) - ! "grid" uses the usual MOM domain that has halos - ! and does not use global indexing. - ! x,y => latlon ocz = dataPtr_ocz ocm = dataPtr_ocm do j = lbnd2, ubnd2 @@ -2365,26 +2177,26 @@ subroutine ModelAdvance(gcomp, rc) deallocate(ocz, ocm) #endif - + ! If restart alarm is ringing - write restart file call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmRingerOff(alarm, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + ! call into system specific method to get desired restart filename restartname = "" call ESMF_MethodExecute(gcomp, label="GetRestartFileToWrite", & @@ -2418,7 +2230,7 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out endif endif - + if (len_trim(restartname) == 0) then ! none provided, so use a default restart filename call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) @@ -2432,7 +2244,7 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & + write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & "ocn", year, month, day, hour, minute, seconds call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -2440,15 +2252,15 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out endif - + ! write restart file(s) call ocean_model_restart(ocean_state, restartname=restartname) - + if (is_root_pe()) then write(logunit,*) subname//' writing restart file ',trim(restartname) end if endif - + if (write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & timeslice=export_slice, relaxedFlag=.true., rc=rc) @@ -2458,9 +2270,9 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out export_slice = export_slice + 1 endif - + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") - + end subroutine ModelAdvance !=============================================================================== @@ -2542,9 +2354,9 @@ subroutine ModelSetRunClock(gcomp, rc) return ! bail out if (first_time) then - !-------------------------------- + !-------------------------------- ! set restart alarm - !-------------------------------- + !-------------------------------- ! defaults restart_n = 0 @@ -2578,7 +2390,7 @@ subroutine ModelSetRunClock(gcomp, rc) else restart_option = "none" endif - + call AlarmInit(mclock, & alarm = restart_alarm, & option = trim(restart_option), & @@ -2590,21 +2402,21 @@ subroutine ModelSetRunClock(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out first_time = .false. - - call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & + + call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + end if !-------------------------------- @@ -2725,7 +2537,7 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ integer, intent(in) :: scalar_id type(ESMF_State), intent(inout) :: State integer, intent(in) :: mytask - character(len=*), intent(in) :: scalar_name + character(len=*), intent(in) :: scalar_name integer, intent(in) :: scalar_count integer, intent(inout) :: rc @@ -2823,14 +2635,14 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + ! initialize to zero call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - fldptr = 0.0 + fldptr = 0.0 endif diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 34946cefdb..6e3558efc5 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -1,10 +1,8 @@ module mom_cap_methods - use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet - use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalTeg - use ESMF, only: ESMF_State, ESMF_StateGet + use ESMF, only: ESMF_time, ESMF_ClockGet, ESMF_TimeGet, ESMF_State, ESMF_Clock use ESMF, only: ESMF_KIND_R8, ESMF_Field, ESMF_SUCCESS, ESMF_LogFoundError - use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_FieldGet + use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_StateGet, ESMF_FieldGet use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE use MOM_ocean_model, only: ocean_public_type, ocean_state_type use MOM_surface_forcing, only: ice_ocean_boundary_type @@ -49,7 +47,6 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices integer :: lbnd1, lbnd2 real :: slp_L, slp_R, slp_C, slope, u_min, u_max - real :: I_time_int !< The inverse of coupling time interval in s-1. integer :: day, secs type(ESMF_time) :: currTime real(ESMF_KIND_R8), pointer :: dataPtr_omask(:,:) @@ -61,8 +58,6 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:,:) - type(ESMF_TimeInterval) :: timeStep - integer :: dt_int !< time over which to advance the ocean (ocean_coupling_time_step), in sec character(len=*), parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" character(len=*), parameter :: subname = '(mom_export)' !----------------------------------------------------------------------- @@ -121,23 +116,6 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - ! Use Adcroft's rule of reciprocals; it does the right thing here. - call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_TimeIntervalGet( timeStep, s=dt_int, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (real(dt_int) > 0.0) then - I_time_int = 1.0 / real(dt_int) - else - I_time_int = 0.0 - end if - ! Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. ! The mask comes from "grid" that uses the usual MOM domain that has halos ! and does not use global indexing. @@ -154,20 +132,10 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) dataPtr_v(i1,j1) = ocean_public%v_surf(i,j) * grid%mask2dT(ig,jg) dataPtr_q(i1,j1) = 0. dataPtr_bldepth(i1,j1) = 0. ! TODO: this needs to be generalized - - ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 - if (ocn_public%frazil(ig,jg) > 0.0) then - ! Frazil: change from J/m^2 to W/m^2 - dataPtr_Fioo_q(i1,j1) = ocn_public%frazil(i,j) * grid%mask2dT(ig,jg) * I_time_int - else - ! Melt_potential: change from J/m^2 to W/m^2 - dataPtr_Fioo_q(i1,j1) = -ocn_public%melt_potential(i,j) * grid%mask2dT(ig,jg) * I_time_int !* ncouple_per_day - - ! make sure Melt_potential is always <= 0 - if (dataPtr_Fioo_q(i1,j1) > 0.0) then - dataPtr_Fioo_q(i1,j1) = 0.0 - endif - end if + !dataPtr_u(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%u_surf(i,j) & + ! - grid%sin_rot(ig,jg) * ocean_public%v_surf(i,j)) * grid%mask2dT(ig,jg) + !dataPtr_v(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%v_surf(i,j) & + ! + grid%sin_rot(ig,jg) * ocean_public%u_surf(i,j)) * grid%mask2dT(ig,jg) end do end do diff --git a/config_src/nuopc_driver/time_utils.F90 b/config_src/nuopc_driver/time_utils.F90 new file mode 100644 index 0000000000..f009a72e8e --- /dev/null +++ b/config_src/nuopc_driver/time_utils.F90 @@ -0,0 +1,161 @@ +module time_utils_mod + + use fms_mod, only: uppercase + use mpp_mod, only: mpp_error, FATAL + use time_manager_mod, only: time_type, set_time, set_date, get_date + use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR + use time_manager_mod, only: fms_get_calendar_type => get_calendar_type + use ESMF + + implicit none + private + + !-------------------- interface blocks --------------------- + interface fms2esmf_cal + module procedure fms2esmf_cal_c + module procedure fms2esmf_cal_i + end interface fms2esmf_cal + interface esmf2fms_time + module procedure esmf2fms_time_t + module procedure esmf2fms_timestep + end interface esmf2fms_time + + public fms2esmf_cal + public esmf2fms_time + public fms2esmf_time + public string_to_date + + contains + + !-------------------- module code --------------------- + + function fms2esmf_cal_c(calendar) +! ! Return Value: + type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_c +! ! Arguments: + character(len=*), intent(in) :: calendar + + select case( uppercase(trim(calendar)) ) + case( 'GREGORIAN' ) + fms2esmf_cal_c = ESMF_CALKIND_GREGORIAN + case( 'JULIAN' ) + fms2esmf_cal_c = ESMF_CALKIND_JULIAN + case( 'NOLEAP' ) + fms2esmf_cal_c = ESMF_CALKIND_NOLEAP + case( 'THIRTY_DAY' ) + fms2esmf_cal_c = ESMF_CALKIND_360DAY + case( 'NO_CALENDAR' ) + fms2esmf_cal_c = ESMF_CALKIND_NOCALENDAR + case default + call mpp_error(FATAL, & + 'ocean_solo: ocean_solo_nml entry calendar must be one of GREGORIAN|JULIAN|NOLEAP|THIRTY_DAY|NO_CALENDAR.' ) + end select + end function fms2esmf_cal_c + + function fms2esmf_cal_i(calendar) +! ! Return Value: + type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_i +! ! Arguments: + integer, intent(in) :: calendar + + select case(calendar) + case(THIRTY_DAY_MONTHS) + fms2esmf_cal_i = ESMF_CALKIND_360DAY + case(GREGORIAN) + fms2esmf_cal_i = ESMF_CALKIND_GREGORIAN + case(JULIAN) + fms2esmf_cal_i = ESMF_CALKIND_JULIAN + case(NOLEAP) + fms2esmf_cal_i = ESMF_CALKIND_NOLEAP + case(NO_CALENDAR) + fms2esmf_cal_i = ESMF_CALKIND_NOCALENDAR + end select + end function fms2esmf_cal_i + + function esmf2fms_time_t(time) + ! Return Value + type(Time_type) :: esmf2fms_time_t + ! Input Arguments + type(ESMF_Time), intent(in) :: time + ! Local Variables + integer :: yy, mm, dd, h, m, s + type(ESMF_CALKIND_FLAG) :: calkind + + integer :: rc + + call ESMF_TimeGet(time, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, & + calkindflag=calkind, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + esmf2fms_time_t = Set_date(yy, mm, dd, h, m, s) + + end function esmf2fms_time_t + + function esmf2fms_timestep(timestep) + ! Return Value + type(Time_type) :: esmf2fms_timestep + ! Input Arguments + type(ESMF_TimeInterval), intent(in):: timestep + ! Local Variables + integer :: s + type(ESMF_CALKIND_FLAG) :: calkind + + integer :: rc + + call ESMF_TimeIntervalGet(timestep, s=s, calkindflag=calkind, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + esmf2fms_timestep = set_time(s, 0) + + end function esmf2fms_timestep + + function fms2esmf_time(time, calkind) + ! Return Value + type(ESMF_Time) :: fms2esmf_time + ! Input Arguments + type(Time_type), intent(in) :: time + type(ESMF_CALKIND_FLAG), intent(in), optional :: calkind + ! Local Variables + integer :: yy, mm, d, h, m, s + type(ESMF_CALKIND_FLAG) :: l_calkind + + integer :: rc + + if(present(calkind)) then + l_calkind = calkind + else + l_calkind = fms2esmf_cal(fms_get_calendar_type()) + endif + + call get_date(time, yy, mm, d, h, m, s) + + call ESMF_TimeSet(fms2esmf_time, yy=yy, mm=mm, d=d, h=h, m=m, s=s, & + calkindflag=l_calkind, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end function fms2esmf_time + + function string_to_date(string, rc) + character(len=15), intent(in) :: string + integer, intent(out), optional :: rc + type(time_type) :: string_to_date + + integer :: yr,mon,day,hr,min,sec + + if(present(rc)) rc = ESMF_SUCCESS + + read(string, '(I4.4,I2.2,I2.2,".",I2.2,I2.2,I2.2)') yr, mon, day, hr, min, sec + string_to_date = set_date(yr, mon, day, hr, min, sec) + + end function string_to_date + +end module time_utils_mod From 0229d1d92f303e50ba06085233d0e3ad2aa355ae Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 4 Dec 2018 11:38:31 -0700 Subject: [PATCH 0941/1072] modifications to have nuopc cap working with latest dev/ncar code base --- config_src/nuopc_driver/MOM_ocean_model.F90 | 67 +++- config_src/nuopc_driver/mom_cap.F90 | 364 +++++++++++++++----- config_src/nuopc_driver/mom_cap_methods.F90 | 50 ++- 3 files changed, 369 insertions(+), 112 deletions(-) diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 17d66789b5..3d44587832 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -121,7 +121,9 @@ 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. - area => NULL() !< cell area of the ocean surface, in m2. + 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 named !! arrays of tracer-related surface fields. integer :: avg_kount !< A count of contributions to running @@ -242,6 +244,12 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! 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. @@ -343,10 +351,22 @@ 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"//& + "melt potential will not be computed.", units="m", default=-1.0, do_not_log=.true.) + + if (HFrz .gt. 0.0) then + use_melt_pot=.true. + else + use_melt_pot=.false. + endif + ! 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) + do_integrals=.true., gas_fields_ocn=gas_fields_ocn, use_meltpot=use_melt_pot) call surface_forcing_init(Time_in, OS%grid, param_file, OS%diag, & OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) @@ -636,8 +656,10 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%nstep = OS%nstep + 1 call enable_averaging(dt_coupling, OS%Time, OS%diag) - call mech_forcing_diags(OS%forces, OS%fluxes, dt_coupling, OS%grid, & - OS%diag, OS%forcing_CSp%handles) + call mech_forcing_diags(OS%forces, dt_coupling, OS%grid, OS%diag, OS%forcing_CSp%handles) + !TODO: this came in for the merge and is not consistent with the MOA branch + !call mech_forcing_diags(OS%forces, OS%fluxes, dt_coupling, OS%grid, OS%diag, OS%forcing_CSp%handles) + call disable_averaging(OS%diag) if (OS%fluxes%fluxes_used) then @@ -797,6 +819,8 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, Ocean_sfc%v_surf (isc:iec,jsc:jec), & Ocean_sfc%sea_lev(isc:iec,jsc:jec), & Ocean_sfc%area (isc:iec,jsc:jec), & + Ocean_sfc%OBLD (isc:iec,jsc:jec), & + Ocean_sfc%melt_potential(isc:iec,jsc:jec), & Ocean_sfc%frazil (isc:iec,jsc:jec)) Ocean_sfc%t_surf = 0.0 ! time averaged sst (Kelvin) passed to atmosphere/ice model @@ -805,6 +829,8 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, Ocean_sfc%v_surf = 0.0 ! time averaged v-current (m/sec) passed to atmosphere/ice models Ocean_sfc%sea_lev = 0.0 ! time averaged thickness of top model grid cell (m) plus patm/rho0/grav Ocean_sfc%frazil = 0.0 ! time accumulated frazil (J/m^2) passed to ice model + Ocean_sfc%melt_potential = 0.0 ! time accumulated melt potential (J/m^2) passed to ice model + Ocean_sfc%OBLD = 0.0 ! ocean boundary layer depth, in m Ocean_sfc%area = 0.0 Ocean_sfc%axes = diag%axesT1%handles !diag axes to be used by coupler tracer flux diagnostics @@ -889,6 +915,18 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z 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) * & @@ -1057,25 +1095,25 @@ subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc) case('btfHeat') array2D(isc:,jsc:) = 0 case('tlat') - array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatT(g_isc:g_iec,g_jsc:g_jec) case('tlon') - array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonT(g_isc:g_iec,g_jsc:g_jec) case('ulat') - array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatCu(g_isc:g_iec,g_jsc:g_jec) case('ulon') - array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonCu(g_isc:g_iec,g_jsc:g_jec) case('vlat') - array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatCv(g_isc:g_iec,g_jsc:g_jec) case('vlon') - array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonCv(g_isc:g_iec,g_jsc:g_jec) case('geoLatBu') - array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLatBu(g_isc:g_iec,g_jsc:g_jec) case('geoLonBu') - array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%grid%geoLonBu(g_isc:g_iec,g_jsc:g_jec) case('cos_rot') - array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 + array2D(isc:,jsc:) = OS%grid%cos_rot(g_isc:g_iec,g_jsc:g_jec) ! =1 case('sin_rot') - array2D(isc:,jsc:) = OS%grid%sin_rot(g_isc:g_iec,g_jsc:g_jec) ! =0 + array2D(isc:,jsc:) = OS%grid%sin_rot(g_isc:g_iec,g_jsc:g_jec) ! =0 case default call MOM_error(FATAL,'get_ocean_grid_data2D: unknown argument name='//name) end select @@ -1121,6 +1159,7 @@ 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%melt_potential ',mpp_chksum(ocn%melt_potential) call coupler_type_write_chksums(ocn%fields, outunit, 'ocean%') 100 FORMAT(" CHECKSUM::",A20," = ",Z20) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index eb8c003945..8e083fbe55 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -404,9 +404,9 @@ module mom_cap_mod use, intrinsic :: iso_fortran_env, only: output_unit - use ESMF - use NUOPC - use NUOPC_Model, & + use ESMF + use NUOPC + use NUOPC_Model, & model_routine_SS => SetServices, & model_label_Advance => label_Advance, & model_label_DataInitialize => label_DataInitialize, & @@ -456,7 +456,7 @@ module mom_cap_mod logical :: grid_attach_area = .false. character(len=128) :: scalar_field_name integer :: scalar_field_count - integer :: scalar_field_idx_grid_nx + integer :: scalar_field_idx_grid_nx integer :: scalar_field_idx_grid_ny character(len=*),parameter :: u_file_u = & __FILE__ @@ -578,23 +578,23 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + write_diagnostics = .false. call NUOPC_CompAttributeGet(gcomp, name="DumpFields", value=value, & isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) write_diagnostics=(trim(value)=="true") - + write(logmsg,*) write_diagnostics call ESMF_LogWrite('mom_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return profile_memory = .false. call NUOPC_CompAttributeGet(gcomp, name="ProfileMemory", value=value, & @@ -602,14 +602,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) profile_memory=(trim(value)=="true") write(logmsg,*) profile_memory call ESMF_LogWrite('mom_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return grid_attach_area = .false. call NUOPC_CompAttributeGet(gcomp, name="GridAttachArea", value=value, & @@ -617,14 +617,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) grid_attach_area=(trim(value)=="true") write(logmsg,*) grid_attach_area call ESMF_LogWrite('mom_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return scalar_field_name = "" call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=value, & @@ -632,14 +632,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - if (isPresent .and. isSet) then + return + if (isPresent .and. isSet) then scalar_field_name = trim(value) call ESMF_LogWrite('mom_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_count = 0 @@ -648,7 +648,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_count if (iostat /= 0) then @@ -662,7 +662,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_idx_grid_nx = 0 @@ -671,7 +671,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_nx if (iostat /= 0) then @@ -685,7 +685,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_idx_grid_ny = 0 @@ -694,7 +694,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny if (iostat /= 0) then @@ -708,16 +708,16 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - call NUOPC_CompAttributeAdd(gcomp, & + call NUOPC_CompAttributeAdd(gcomp, & attrList=(/'RestartFileToRead', 'RestartFileToWrite'/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + end subroutine !=============================================================================== @@ -766,7 +766,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: userRc character(len=512) :: restartfile ! Path/Name of restart file character(len=*), parameter :: subname='(mom_cap:InitializeAdvertise)' - !-------------------------------- + real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_frzmlt + real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_dhdx + real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_dhdy +!-------------------------------- rc = ESMF_SUCCESS @@ -774,7 +777,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return allocate(Ice_ocean_boundary) !allocate(ocean_state) ! ocean_model_init allocate this pointer @@ -827,11 +830,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! rsd need to figure out how to get this without share code !call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - !inst_name = "OCN"//trim(inst_suffix) + !inst_name = "OCN"//trim(inst_suffix) ! reset shr logging to my log file if (is_root_pe()) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & isPresent=isPresentDiro, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -842,7 +845,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresentDiro .and. isPresentLogfile) then open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) else @@ -853,7 +856,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) endif starttype = "" - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -867,7 +870,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif runtype = "" @@ -881,7 +884,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//": unknown starttype - "//trim(starttype), & line=__LINE__, file=__FILE__, rcToReturn=rc) - return + return endif if (len_trim(runtype) > 0) then @@ -889,9 +892,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - + restartfile = "" if (runtype == "initial") then ! startup (new run) - 'n' is needed below if we don't specify input_filename in input.nml @@ -914,36 +917,36 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - + call NUOPC_CompAttributeGet(gcomp, name='RestartFileToRead', & value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then restartfile = trim(cvalue) call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return else - call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & + call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & ESMF_LOGMSG_WARNING, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif end if - + ocean_public%is_ocean_pe = .true. if (len_trim(restartfile) > 0) then - call ocean_model_init(ocean_public, ocean_state, Time, Time, & + call ocean_model_init(ocean_public, ocean_state, Time, Time, & input_restart_file=trim(restartfile)) else call ocean_model_init(ocean_public, ocean_state, Time, Time) @@ -1008,7 +1011,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx @@ -1020,7 +1023,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - + ! EMC fields not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn @@ -1037,7 +1040,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") @@ -1103,19 +1106,18 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide") ! -> s_surf call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u" , "will provide") ! -> ocn_current_zonal call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! -> sea_surface_slope_zonal + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! -> sea_surface_slope_merid + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! -> freezing_melting_potential ! EMC fields not used - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") ! not in CESM - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") ! not in CESM + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev", "will provide") ! not in CESM ! Optional CESM fields currently not used - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen" , "will provide") ! not in EMC + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen", "will provide") ! not in EMC ! if (flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") ! end if @@ -1177,8 +1179,18 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide",& data=ocean_public%sea_lev) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide",& - data=ocean_public%frazil) + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide",& + ! data=ocean_public%frazil) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "accum_heat_frazil" , "will provide",& + data=Ocean_public%frazil) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "inst_melt_potential" , "will provide",& + data=Ocean_public%melt_potential) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential", "will provide", & + data=dataPtr_frzmlt) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide",& + data=ocean_public%frazil) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide",& + data=ocean_public%frazil) !JW #endif @@ -1303,7 +1315,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + !--------------------------------- ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total !--------------------------------- @@ -1324,7 +1336,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return - + !--------------------------------- ! get start and end indices of each tile and their PET !--------------------------------- @@ -1339,10 +1351,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return enddo end if - + !--------------------------------- ! create delayout and distgrid @@ -1425,7 +1437,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1437,9 +1449,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return deallocate(IndexList) - + !--------------------------------- ! create grid !--------------------------------- @@ -1730,7 +1742,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & scalar_field_name, scalar_field_count, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1783,7 +1795,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! line=__LINE__, & ! file=__FILE__)) & ! return ! bail out - + end subroutine InitializeRealize !=============================================================================== @@ -1914,6 +1926,7 @@ subroutine ModelAdvance(gcomp, rc) integer :: dth, dtm, dts, dt_cpld = 86400 integer :: isc,iec,jsc,jec,lbnd1,ubnd1,lbnd2,ubnd2 integer :: i,j,i1,j1 + real :: slp_L, slp_R, slp_C, slope, u_min, u_max !JW integer :: nc type(ESMF_Time) :: MyTime integer :: seconds, day, year, month, hour, minute @@ -1927,12 +1940,22 @@ subroutine ModelAdvance(gcomp, rc) real(ESMF_KIND_R8), pointer :: dataPtr_ocz(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_ocm(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_melt_potential(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_frzmlt(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) !JW + real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) !JW real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) + real(ESMF_KIND_R8), allocatable :: ssh(:,:) + real(ESMF_KIND_R8), allocatable :: sshx(:,:) + real(ESMF_KIND_R8), allocatable :: sshy(:,:) #endif type(ocean_grid_type), pointer :: ocean_grid character(240) :: msgString character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' + ! helper flag for debugging bounds + logical :: BoundsDebug = .false. + integer :: ijloc(2) !-------------------------------- rc = ESMF_SUCCESS @@ -2021,6 +2044,7 @@ subroutine ModelAdvance(gcomp, rc) call get_ocean_grid(ocean_state, ocean_grid) #ifdef CESMCOUPLED + call shr_file_setLogUnit (logunit) call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, logunit, runtype, clock, rc=rc) @@ -2028,7 +2052,9 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out + #else + call State_getFldPtr(exportState,'ocean_mask',dataPtr_mask,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2081,7 +2107,7 @@ subroutine ModelAdvance(gcomp, rc) mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) + + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) enddo enddo dataPtr_mzmf = mzmf @@ -2114,6 +2140,7 @@ subroutine ModelAdvance(gcomp, rc) if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") #ifdef CESMCOUPLED + call mom_export(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2151,14 +2178,175 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) + !call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + ! fixfrzmlt !JW + call State_getFldPtr(exportState,'accum_heat_frazil',dataPtr_frazil,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'inst_melt_potential',dataPtr_melt_potential,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frzmlt,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'sea_surface_slope_zonal',dataPtr_dhdx,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'sea_surface_slope_merid',dataPtr_dhdy,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out !JW + + allocate( ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW + allocate(sshx(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW + allocate(sshy(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW + ssh = 0.0_ESMF_KIND_R8 !JW + sshx = 0.0_ESMF_KIND_R8 !JW + sshy = 0.0_ESMF_KIND_R8 !JW + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! note: the following code is modified from NCAR nuopc driver mom_cap_methods + ! where is the rotation in that system? + ! + ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain + ! in order to update halos. i.e. does not use global indexing. + ! + ! here, isc,iec,jsc,jec are global indices on cap domain (no halos) + + do j=jsc,jec + do i=isc,iec + j1 = j - ocean_grid%jdg_offset + i1 = i - ocean_grid%idg_offset + ssh(i1,j1) = Ocean_public%sea_lev(i,j) + end do + end do + + ! Update halo of ssh so we can calculate gradients + call pass_var(ssh, ocean_grid%domain) + + ! calculation of slope on native mom domains (local indexing, halos) + ! stay inside of halos (ie 2:79,2:97) + ! d/dx ssh + do j = ocean_grid%jsd+1,ocean_grid%jed-1 + do i = ocean_grid%isd+1,ocean_grid%ied-1 + ! This is a simple second-order difference + !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = (ssh(I,j) - ssh(I-1,j)) * ocean_grid%mask2dCu(i-1,j) + if (ocean_grid%mask2dCu(i-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * ocean_grid%mask2dCu(i,j) + if (ocean_grid%mask2dCu(i+1,j)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + if ( (slp_L * slp_R) > 0.0 ) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + sshx(i,j) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) sshx(i,j) = 0.0 + end do + end do + + ! d/dy ssh + do j = ocean_grid%jsd+1,ocean_grid%jed-1 + do i = ocean_grid%isd+1,ocean_grid%ied-1 + ! This is a simple second-order difference + !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = ssh(i,J) - ssh(i,J-1) * ocean_grid%mask2dCv(i,j-1) + if (ocean_grid%mask2dCv(i,j-1)==0.) slp_L = 0. + slp_R = ssh(i,J+1) - ssh(i,J) * ocean_grid%mask2dCv(i,j) + if (ocean_grid%mask2dCv(i,j+1)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R + if ((slp_L * slp_R) > 0.0) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + sshy(i,j) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) sshy(i,j) = 0.0 + end do + end do + ! rotate slopes from tripolar grid back to lat/lon grid (CCW) + ! "grid" uses the usual MOM domain that has halos + ! and does not use global indexing. + ! x,y => latlon + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j + ocean_grid%jsc - lbnd2 + i1 = i + ocean_grid%isc - lbnd1 + dataPtr_dhdx(i,j) = ocean_grid%cos_rot(i1,j1)*sshx(i1,j1) & + + ocean_grid%sin_rot(i1,j1)*sshy(i1,j1) + dataPtr_dhdy(i,j) = ocean_grid%cos_rot(i1,j1)*sshy(i1,j1) & + - ocean_grid%sin_rot(i1,j1)*sshx(i1,j1) + enddo + enddo + deallocate(ssh); deallocate(sshx); deallocate(sshy) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling + dataPtr_melt_potential = -dataPtr_melt_potential/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling + !melt_potential, defined positive for T>Tfreeze + !so change sign + !testing + ijloc = maxloc(dataPtr_frazil) + if((sum(ijloc) .gt. 2) .and. & + (dataPtr_frazil(ijloc(1),ijloc(2)) .gt. 0.0))then + i1 = ijloc(1) - lbnd1 + isc + j1 = ijloc(2) - lbnd2 + jsc ! work around local vs global indexing + write (msgString,*)' MOM6 dataPtr_frazil at maxloc ',i1,j1,& + real(dataPtr_frazil(ijloc(1),ijloc(2)),4) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + + write (msgString,*)' MOM6 dataPtr_melt_potential at maxloc ',i1,j1,& + real(dataPtr_melt_potential(ijloc(1),ijloc(2)),4) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + endif + !testing + + dataPtr_melt_potential = min(dataPtr_melt_potential,0.0) + + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + if(dataPtr_frazil(i,j) .eq. 0.0)then + dataPtr_frzmlt(i,j) = dataPtr_melt_potential(i,j) + else + dataPtr_frzmlt(i,j) = dataPtr_frazil(i,j) + endif + enddo + enddo + dataPtr_frzmlt = max(-1000.0,min(1000.0,dataPtr_frzmlt)) + ! rotate ocn current from tripolar grid back to lat/lon grid (CCW) + ! "grid" uses the usual MOM domain that has halos + ! and does not use global indexing. + ! x,y => latlon ocz = dataPtr_ocz ocm = dataPtr_ocm do j = lbnd2, ubnd2 @@ -2177,26 +2365,26 @@ subroutine ModelAdvance(gcomp, rc) deallocate(ocz, ocm) #endif - + ! If restart alarm is ringing - write restart file call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmRingerOff(alarm, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + ! call into system specific method to get desired restart filename restartname = "" call ESMF_MethodExecute(gcomp, label="GetRestartFileToWrite", & @@ -2230,7 +2418,7 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out endif endif - + if (len_trim(restartname) == 0) then ! none provided, so use a default restart filename call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) @@ -2244,7 +2432,7 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & + write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & "ocn", year, month, day, hour, minute, seconds call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -2252,15 +2440,15 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out endif - + ! write restart file(s) call ocean_model_restart(ocean_state, restartname=restartname) - + if (is_root_pe()) then write(logunit,*) subname//' writing restart file ',trim(restartname) end if endif - + if (write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & timeslice=export_slice, relaxedFlag=.true., rc=rc) @@ -2270,9 +2458,9 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out export_slice = export_slice + 1 endif - + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") - + end subroutine ModelAdvance !=============================================================================== @@ -2354,9 +2542,9 @@ subroutine ModelSetRunClock(gcomp, rc) return ! bail out if (first_time) then - !-------------------------------- + !-------------------------------- ! set restart alarm - !-------------------------------- + !-------------------------------- ! defaults restart_n = 0 @@ -2390,7 +2578,7 @@ subroutine ModelSetRunClock(gcomp, rc) else restart_option = "none" endif - + call AlarmInit(mclock, & alarm = restart_alarm, & option = trim(restart_option), & @@ -2402,21 +2590,21 @@ subroutine ModelSetRunClock(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out first_time = .false. - - call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & + + call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + end if !-------------------------------- @@ -2537,7 +2725,7 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ integer, intent(in) :: scalar_id type(ESMF_State), intent(inout) :: State integer, intent(in) :: mytask - character(len=*), intent(in) :: scalar_name + character(len=*), intent(in) :: scalar_name integer, intent(in) :: scalar_count integer, intent(inout) :: rc @@ -2635,14 +2823,14 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + ! initialize to zero call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - fldptr = 0.0 + fldptr = 0.0 endif diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 6e3558efc5..a7de74bb82 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -1,8 +1,10 @@ module mom_cap_methods - use ESMF, only: ESMF_time, ESMF_ClockGet, ESMF_TimeGet, ESMF_State, ESMF_Clock + use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet + use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet + use ESMF, only: ESMF_State, ESMF_StateGet use ESMF, only: ESMF_KIND_R8, ESMF_Field, ESMF_SUCCESS, ESMF_LogFoundError - use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_StateGet, ESMF_FieldGet + use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_FieldGet use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE use MOM_ocean_model, only: ocean_public_type, ocean_state_type use MOM_surface_forcing, only: ice_ocean_boundary_type @@ -47,6 +49,7 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices integer :: lbnd1, lbnd2 real :: slp_L, slp_R, slp_C, slope, u_min, u_max + real :: I_time_int !< The inverse of coupling time interval in s-1. integer :: day, secs type(ESMF_time) :: currTime real(ESMF_KIND_R8), pointer :: dataPtr_omask(:,:) @@ -54,10 +57,12 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) real(ESMF_KIND_R8), pointer :: dataPtr_s(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_u(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_v(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_q(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fioo_q(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:,:) + type(ESMF_TimeInterval) :: timeStep + integer :: dt_int !< time over which to advance the ocean (ocean_coupling_time_step), in sec character(len=*), parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" character(len=*), parameter :: subname = '(mom_export)' !----------------------------------------------------------------------- @@ -89,7 +94,7 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(exportState,"Fioo_q", dataPtr_q, rc=rc) + call State_getFldPtr(exportState,"Fioo_q", dataPtr_fioo_q, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -116,6 +121,23 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + ! Use Adcroft's rule of reciprocals; it does the right thing here. + call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_TimeIntervalGet( timeStep, s=dt_int, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (real(dt_int) > 0.0) then + I_time_int = 1.0 / real(dt_int) + else + I_time_int = 0.0 + end if + ! Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. ! The mask comes from "grid" that uses the usual MOM domain that has halos ! and does not use global indexing. @@ -130,12 +152,20 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) dataPtr_s(i1,j1) = ocean_public%s_surf(i,j) * grid%mask2dT(ig,jg) dataPtr_u(i1,j1) = ocean_public%u_surf(i,j) * grid%mask2dT(ig,jg) dataPtr_v(i1,j1) = ocean_public%v_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_q(i1,j1) = 0. - dataPtr_bldepth(i1,j1) = 0. ! TODO: this needs to be generalized - !dataPtr_u(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%u_surf(i,j) & - ! - grid%sin_rot(ig,jg) * ocean_public%v_surf(i,j)) * grid%mask2dT(ig,jg) - !dataPtr_v(i1,j1) = (grid%cos_rot(ig,jg) * ocean_public%v_surf(i,j) & - ! + grid%sin_rot(ig,jg) * ocean_public%u_surf(i,j)) * grid%mask2dT(ig,jg) + dataPtr_bldepth(i1,j1) = ocean_public%OBLD(i,j) * grid%mask2dT(ig,jg) + ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 + if (ocean_public%frazil(ig,jg) > 0.0) then + ! Frazil: change from J/m^2 to W/m^2 + dataPtr_Fioo_q(i1,j1) = ocean_public%frazil(i,j) * grid%mask2dT(ig,jg) * I_time_int + else + ! Melt_potential: change from J/m^2 to W/m^2 + dataPtr_Fioo_q(i1,j1) = -ocean_public%melt_potential(i,j) * grid%mask2dT(ig,jg) * I_time_int !* ncouple_per_day + + ! make sure Melt_potential is always <= 0 + if (dataPtr_Fioo_q(i1,j1) > 0.0) then + dataPtr_Fioo_q(i1,j1) = 0.0 + endif + end if end do end do From eefd4dc81b7a849a463b76b1b1c4da3e19eff935 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 4 Dec 2018 15:25:34 -0700 Subject: [PATCH 0942/1072] removed trailing whitespace --- config_src/nuopc_driver/MOM_ocean_model.F90 | 9 +- config_src/nuopc_driver/mom_cap.F90 | 158 ++++++++++---------- 2 files changed, 83 insertions(+), 84 deletions(-) diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 3d44587832..28ae82750a 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -352,10 +352,10 @@ 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"//& - "melt potential will not be computed.", units="m", default=-1.0, do_not_log=.true.) + "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"//& + "melt potential will not be computed.", units="m", default=-1.0, do_not_log=.true.) if (HFrz .gt. 0.0) then use_melt_pot=.true. @@ -1176,4 +1176,3 @@ subroutine get_ocean_grid(OS, Gridp) end subroutine get_ocean_grid end module MOM_ocean_model - diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 8e083fbe55..14f92076e4 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -404,9 +404,9 @@ module mom_cap_mod use, intrinsic :: iso_fortran_env, only: output_unit - use ESMF - use NUOPC - use NUOPC_Model, & + use ESMF + use NUOPC + use NUOPC_Model, & model_routine_SS => SetServices, & model_label_Advance => label_Advance, & model_label_DataInitialize => label_DataInitialize, & @@ -456,7 +456,7 @@ module mom_cap_mod logical :: grid_attach_area = .false. character(len=128) :: scalar_field_name integer :: scalar_field_count - integer :: scalar_field_idx_grid_nx + integer :: scalar_field_idx_grid_nx integer :: scalar_field_idx_grid_ny character(len=*),parameter :: u_file_u = & __FILE__ @@ -578,23 +578,23 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + write_diagnostics = .false. call NUOPC_CompAttributeGet(gcomp, name="DumpFields", value=value, & isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) write_diagnostics=(trim(value)=="true") - + write(logmsg,*) write_diagnostics call ESMF_LogWrite('mom_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return profile_memory = .false. call NUOPC_CompAttributeGet(gcomp, name="ProfileMemory", value=value, & @@ -602,14 +602,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) profile_memory=(trim(value)=="true") write(logmsg,*) profile_memory call ESMF_LogWrite('mom_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return grid_attach_area = .false. call NUOPC_CompAttributeGet(gcomp, name="GridAttachArea", value=value, & @@ -617,14 +617,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) grid_attach_area=(trim(value)=="true") write(logmsg,*) grid_attach_area call ESMF_LogWrite('mom_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return scalar_field_name = "" call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=value, & @@ -632,14 +632,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - if (isPresent .and. isSet) then + return + if (isPresent .and. isSet) then scalar_field_name = trim(value) call ESMF_LogWrite('mom_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_count = 0 @@ -648,7 +648,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_count if (iostat /= 0) then @@ -662,7 +662,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_idx_grid_nx = 0 @@ -671,7 +671,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_nx if (iostat /= 0) then @@ -685,7 +685,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif scalar_field_idx_grid_ny = 0 @@ -694,7 +694,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny if (iostat /= 0) then @@ -708,16 +708,16 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - call NUOPC_CompAttributeAdd(gcomp, & + call NUOPC_CompAttributeAdd(gcomp, & attrList=(/'RestartFileToRead', 'RestartFileToWrite'/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return - + return + end subroutine !=============================================================================== @@ -768,7 +768,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(len=*), parameter :: subname='(mom_cap:InitializeAdvertise)' real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_frzmlt real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_dhdx - real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_dhdy + real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_dhdy !-------------------------------- rc = ESMF_SUCCESS @@ -777,7 +777,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return allocate(Ice_ocean_boundary) !allocate(ocean_state) ! ocean_model_init allocate this pointer @@ -830,11 +830,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! rsd need to figure out how to get this without share code !call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - !inst_name = "OCN"//trim(inst_suffix) + !inst_name = "OCN"//trim(inst_suffix) ! reset shr logging to my log file if (is_root_pe()) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & isPresent=isPresentDiro, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -845,7 +845,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresentDiro .and. isPresentLogfile) then open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) else @@ -856,7 +856,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) endif starttype = "" - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -870,7 +870,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif runtype = "" @@ -884,7 +884,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//": unknown starttype - "//trim(starttype), & line=__LINE__, file=__FILE__, rcToReturn=rc) - return + return endif if (len_trim(runtype) > 0) then @@ -892,9 +892,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - + restartfile = "" if (runtype == "initial") then ! startup (new run) - 'n' is needed below if we don't specify input_filename in input.nml @@ -917,36 +917,36 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif - + call NUOPC_CompAttributeGet(gcomp, name='RestartFileToRead', & value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return if (isPresent .and. isSet) then restartfile = trim(cvalue) call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return else - call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & + call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & ESMF_LOGMSG_WARNING, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return endif end if - + ocean_public%is_ocean_pe = .true. if (len_trim(restartfile) > 0) then - call ocean_model_init(ocean_public, ocean_state, Time, Time, & + call ocean_model_init(ocean_public, ocean_state, Time, Time, & input_restart_file=trim(restartfile)) else call ocean_model_init(ocean_public, ocean_state, Time, Time) @@ -1011,7 +1011,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx @@ -1023,7 +1023,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - + ! EMC fields not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn @@ -1040,7 +1040,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") @@ -1108,7 +1108,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! -> sea_surface_slope_zonal call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! -> sea_surface_slope_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! -> freezing_melting_potential ! EMC fields not used @@ -1117,7 +1117,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Optional CESM fields currently not used ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen", "will provide") ! not in EMC ! if (flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") ! end if @@ -1315,7 +1315,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + !--------------------------------- ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total !--------------------------------- @@ -1336,7 +1336,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return - + !--------------------------------- ! get start and end indices of each tile and their PET !--------------------------------- @@ -1351,10 +1351,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return enddo end if - + !--------------------------------- ! create delayout and distgrid @@ -1437,7 +1437,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1449,9 +1449,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & - return + return deallocate(IndexList) - + !--------------------------------- ! create grid !--------------------------------- @@ -1742,7 +1742,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & scalar_field_name, scalar_field_count, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1795,7 +1795,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! line=__LINE__, & ! file=__FILE__)) & ! return ! bail out - + end subroutine InitializeRealize !=============================================================================== @@ -2107,7 +2107,7 @@ subroutine ModelAdvance(gcomp, rc) mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) + + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) enddo enddo dataPtr_mzmf = mzmf @@ -2365,26 +2365,26 @@ subroutine ModelAdvance(gcomp, rc) deallocate(ocz, ocm) #endif - + ! If restart alarm is ringing - write restart file call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmRingerOff(alarm, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + ! call into system specific method to get desired restart filename restartname = "" call ESMF_MethodExecute(gcomp, label="GetRestartFileToWrite", & @@ -2418,7 +2418,7 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out endif endif - + if (len_trim(restartname) == 0) then ! none provided, so use a default restart filename call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) @@ -2432,7 +2432,7 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & + write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & "ocn", year, month, day, hour, minute, seconds call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -2440,15 +2440,15 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out endif - + ! write restart file(s) call ocean_model_restart(ocean_state, restartname=restartname) - + if (is_root_pe()) then write(logunit,*) subname//' writing restart file ',trim(restartname) end if endif - + if (write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & timeslice=export_slice, relaxedFlag=.true., rc=rc) @@ -2458,9 +2458,9 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out export_slice = export_slice + 1 endif - + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") - + end subroutine ModelAdvance !=============================================================================== @@ -2542,9 +2542,9 @@ subroutine ModelSetRunClock(gcomp, rc) return ! bail out if (first_time) then - !-------------------------------- + !-------------------------------- ! set restart alarm - !-------------------------------- + !-------------------------------- ! defaults restart_n = 0 @@ -2578,7 +2578,7 @@ subroutine ModelSetRunClock(gcomp, rc) else restart_option = "none" endif - + call AlarmInit(mclock, & alarm = restart_alarm, & option = trim(restart_option), & @@ -2590,21 +2590,21 @@ subroutine ModelSetRunClock(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out first_time = .false. - - call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & + + call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + end if !-------------------------------- @@ -2725,7 +2725,7 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ integer, intent(in) :: scalar_id type(ESMF_State), intent(inout) :: State integer, intent(in) :: mytask - character(len=*), intent(in) :: scalar_name + character(len=*), intent(in) :: scalar_name integer, intent(in) :: scalar_count integer, intent(inout) :: rc @@ -2823,14 +2823,14 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + ! initialize to zero call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - fldptr = 0.0 + fldptr = 0.0 endif From 0bc248cb279a2f57f27dcf24e29a06c1f71e2591 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 9 Dec 2018 11:58:48 -0700 Subject: [PATCH 0943/1072] identified source of restart problem - still needs to be resolved --- config_src/nuopc_driver/mom_cap_methods.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index a7de74bb82..26da8c8a56 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -156,15 +156,14 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 if (ocean_public%frazil(ig,jg) > 0.0) then ! Frazil: change from J/m^2 to W/m^2 - dataPtr_Fioo_q(i1,j1) = ocean_public%frazil(i,j) * grid%mask2dT(ig,jg) * I_time_int + ! NOTE: if this is uncommented - then restarts no longer work + !dataPtr_Fioo_q(i1,j1) = ocean_public%frazil(i,j) * grid%mask2dT(ig,jg) * I_time_int else ! Melt_potential: change from J/m^2 to W/m^2 dataPtr_Fioo_q(i1,j1) = -ocean_public%melt_potential(i,j) * grid%mask2dT(ig,jg) * I_time_int !* ncouple_per_day ! make sure Melt_potential is always <= 0 - if (dataPtr_Fioo_q(i1,j1) > 0.0) then - dataPtr_Fioo_q(i1,j1) = 0.0 - endif + if (dataPtr_Fioo_q(i1,j1) > 0.0) dataPtr_Fioo_q(i1,j1) = 0.0 end if end do end do From cef6178d9252af9933aade4004f50e9fb236fe80 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 9 Dec 2018 16:06:29 -0700 Subject: [PATCH 0944/1072] rewrote unified cap to have nems import and export routines now in mom_cap_methods.F90 --- config_src/nuopc_driver/mom_cap.F90 | 853 ++++++-------------- config_src/nuopc_driver/mom_cap_methods.F90 | 345 ++++++-- 2 files changed, 563 insertions(+), 635 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 14f92076e4..ad19ae4df5 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -147,23 +147,22 @@ !! !! call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_public, Time, Time_step_coupled) !! -!! Prior to this call, the cap performs a few steps: +!! Priori to the call to `update_ocean_model()`, the cap performs these steps !! - the `Time` and `Time_step_coupled` parameters, based on FMS types, are derived from the incoming ESMF clock !! - there are calls to two stubs: `ice_ocn_bnd_from_data()` and `external_coupler_sbc_before()` - these are currently !! inactive, but may be modified to read in import data from file or from an external coupler !! - diagnostics are optionally written to files `field_ocn_import_*`, one for each import field -!! - import fields are prepared: +!! - mom_import_cesm or mom_import_nems is called !! - the sign is reversed on `mean_evap_rate` and `mean_sensi_heat_flux` !! - momentum flux vectors are rotated to internal grid !! - optionally, a call is made to `ocean_model_restart()` at the interval `restart_interval` !! !! After the call to `update_ocean_model()`, the cap performs these steps: -!! - the `ocean_mask` export is set to match that of the internal MOM mask -!! - the `freezing_melting_potential` export is converted from J m-2 to W m-2 by dividing by the coupling interval -!! - vector rotations are applied to the `ocean_current_zonal` and `ocean_current_merid` exports, back to lat-lon grid -!! - diagnostics are optionally written to files `field_ocn_export_*`, one for each export field -!! - a call is made to `external_coupler_sbc_after()` to update exports from an external coupler (currently an inactive -!! stub) +!! - mom_export_cesm or mom_export_nems is called +!! - the `ocean_mask` export is set to match that of the internal MOM mask +!! - the `freezing_melting_potential` export is converted from J m-2 to W m-2 by dividing by the coupling interval +!! - vector rotations are applied to the `ocean_current_zonal` and `ocean_current_merid` exports, back to lat-lon grid +!! - diagnostics are optionally written to files `field_ocn_export_*`, one for each export field !! !! @subsubsection VectorRotations Vector Rotations !! @@ -397,10 +396,11 @@ module mom_cap_mod use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid use mom_cap_time, only: AlarmInit #ifdef CESMCOUPLED - use mom_cap_methods, only: mom_import, mom_export use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit use shr_file_mod, only: shr_file_setLogUnit, shr_file_setLogLevel #endif + use mom_cap_methods, only: mom_import_cesm, mom_export_cesm + use mom_cap_methods, only: mom_import_nems, mom_export_nems use, intrinsic :: iso_fortran_env, only: output_unit @@ -461,6 +461,12 @@ module mom_cap_mod character(len=*),parameter :: u_file_u = & __FILE__ +#ifdef CESMCOUPLED + logical :: cesm_coupled = .true. +#else + logical :: cesm_coupled = .false. +#endif + contains !=============================================================================== @@ -1000,199 +1006,166 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out -#ifdef CESMCOUPLED - - !--------- import fields ------------- - if (len_trim(scalar_field_name) > 0) then - call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") ! not in EMC - endif - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - - ! EMC fields not used - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") ! not in CESM - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") ! not in CESM - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") ! not in CESM - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") ! not in CESM - - ! CESM currently not used - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphidry" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphodry" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphiwet" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet1" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet2" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet3" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet4" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry1" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry2" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry3" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry4" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_bcphi" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_bcpho" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_flxdst" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "So_duu10n" , "will provide") - - ! Optional CESM fields currently not used - ! call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! read(cvalue,*) flds_co2a - ! call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) - ! call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! read(cvalue,*) flds_co2c - ! call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) - ! if (flds_co2a .or. flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_co2prog" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_co2diag" , "will provide") - ! end if - ! call NUOPC_CompAttributeGet(gcomp, name='ice_ncat', value=cvalue, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! read(cvalue,*) ice_ncat - ! call ESMF_LogWrite('ice_ncat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) - ! call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! read(cvalue,*) flds_i2o_per_cat - ! call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) - ! if (flds_i2o_per_cat) then - ! do num = 1, ice_ncat - ! name = 'Si_ifrac_' // cnum - ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") - ! name = 'PFioi_swpen_ifrac_' // cnum - ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") - ! end do - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sf_afrac" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sf_afracr" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_afracr", "will provide") - ! end if - ! do n = 1,shr_string_listGetNum(ndep_fields) - ! call shr_string_listGetName(ndep_fields, n, name) - ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") - ! end do - - !--------- export fields ------------- - if (len_trim(scalar_field_name) > 0) then - call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide") ! not in EMC - endif - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask" , "will provide") ! -> ocean_mask - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t" , "will provide") ! -> sea_surface_temperature - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide") ! -> s_surf - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u" , "will provide") ! -> ocn_current_zonal - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! -> sea_surface_slope_zonal - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! -> sea_surface_slope_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! -> freezing_melting_potential - - ! EMC fields not used - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev", "will provide") ! not in CESM - - ! Optional CESM fields currently not used - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen", "will provide") ! not in EMC - ! if (flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") - ! end if + if (cesm_coupled) then + !--------- import fields ------------- + if (len_trim(scalar_field_name) > 0) then + call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") ! not in EMC + endif + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface + + ! EMC fields not used + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") ! not in CESM + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") ! not in CESM + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") ! not in CESM + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") ! not in CESM + + ! CESM currently not used + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphidry" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphodry" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphiwet" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet1" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet2" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet3" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet4" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry1" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry2" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry3" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry4" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_bcphi" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_bcpho" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_flxdst" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "So_duu10n" , "will provide") + + ! Optional CESM fields currently not used + ! call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) flds_co2a + ! call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) + ! call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) flds_co2c + ! call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) + ! if (flds_co2a .or. flds_co2c) then + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_co2prog" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_co2diag" , "will provide") + ! end if + ! call NUOPC_CompAttributeGet(gcomp, name='ice_ncat', value=cvalue, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) ice_ncat + ! call ESMF_LogWrite('ice_ncat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) + ! call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) flds_i2o_per_cat + ! call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) + ! if (flds_i2o_per_cat) then + ! do num = 1, ice_ncat + ! name = 'Si_ifrac_' // cnum + ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") + ! name = 'PFioi_swpen_ifrac_' // cnum + ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") + ! end do + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sf_afrac" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sf_afracr" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_afracr", "will provide") + ! end if + ! do n = 1,shr_string_listGetNum(ndep_fields) + ! call shr_string_listGetName(ndep_fields, n, name) + ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") + ! end do + + !--------- export fields ------------- + if (len_trim(scalar_field_name) > 0) then + call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide") ! not in EMC + endif + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask" , "will provide") ! -> ocean_mask + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t" , "will provide") ! -> sea_surface_temperature + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide") ! -> s_surf + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u" , "will provide") ! -> ocn_current_zonal + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! -> sea_surface_slope_zonal + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! -> sea_surface_slope_merid + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! -> freezing_melting_potential + + ! EMC fields not used + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev", "will provide") ! not in CESM + + ! Optional CESM fields currently not used + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen", "will provide") ! not in EMC + ! if (flds_co2c) then + ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") + ! end if -#else + else - ! This sets pointers of the fldsToOcn to the iceocean_boundary_type - ! Don't point directly into mom data YET (last field is optional in interface) - ! instead, create space for the field when it's "realized". - - !--------- import fields ------------- - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx" , "will provide",& - data=Ice_ocean_boundary%u_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx" , "will provide",& - data=Ice_ocean_boundary%v_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide",& - data=Ice_ocean_boundary%t_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide",& - data=Ice_ocean_boundary%q_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide",& - data=Ice_ocean_boundary%salt_flux) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide",& - data=Ice_ocean_boundary%lw_flux ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide",& - data=Ice_ocean_boundary%sw_flux_vis_dir) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide",& - data=Ice_ocean_boundary%sw_flux_vis_dif) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide",& - data=Ice_ocean_boundary%sw_flux_nir_dir) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide",& - data=Ice_ocean_boundary%sw_flux_nir_dif) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide",& - data=Ice_ocean_boundary%lprec ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide",& - data=Ice_ocean_boundary%fprec ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide",& - data=Ice_ocean_boundary%runoff ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide",& - data=Ice_ocean_boundary%calving) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide",& - data=Ice_ocean_boundary%runoff_hflx ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide",& - data=Ice_ocean_boundary%calving_hflx) - call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide",& - data=Ice_ocean_boundary%p ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide",& - data=Ice_ocean_boundary%mi) - - !--------- export fields ------------- - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature" , "will provide",& - data=ocean_public%t_surf) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide",& - data=ocean_public%s_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide",& - data=ocean_public%u_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide",& - data=ocean_public%v_surf ) - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir" , "will provide") - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide",& - data=ocean_public%sea_lev) - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide",& - ! data=ocean_public%frazil) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "accum_heat_frazil" , "will provide",& - data=Ocean_public%frazil) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "inst_melt_potential" , "will provide",& - data=Ocean_public%melt_potential) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential", "will provide", & - data=dataPtr_frzmlt) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide",& - data=ocean_public%frazil) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide",& - data=ocean_public%frazil) !JW + !--------- import fields ------------- + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") + + !--------- export fields ------------- + ! This sets pointers of the fldsFrOcn to the ocean_public data (unlike the cesm copy paradigm) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature" , "will provide", data=ocean_public%t_surf) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide", data=ocean_public%s_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide", data=ocean_public%u_surf ) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide", data=ocean_public%v_surf ) + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir" , "will provide") + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=ocean_public%sea_lev) + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=ocean_public%frazil) + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "accum_heat_frazil" , "will provide", data=Ocean_public%frazil) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "inst_melt_potential" , "will provide", data=Ocean_public%melt_potential) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=dataPtr_frzmlt) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide", data=ocean_public%frazil) !JW + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide", data=ocean_public%frazil) !JW -#endif + end if do n = 1,fldsToOcn_num call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)%shortname, rc=rc) @@ -1212,8 +1185,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) end subroutine InitializeAdvertise - !=============================================================================== - +!=============================================================================== !> Called by NUOPC to realize import and export fields. "Realizing" a field !! means that its grid has been defined and an ESMF_Field object has been !! created and put into the import or export State. @@ -1817,6 +1789,7 @@ subroutine DataInitialize(gcomp, rc) type(ESMF_Field) :: field character(len=64),allocatable :: fieldNameList(:) character(len=*),parameter :: subname='(mom_cap:DataInitialize)' + !-------------------------------- ! query the Component for its clock, importState and exportState call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, exportState=exportState, rc=rc) @@ -1836,13 +1809,13 @@ subroutine DataInitialize(gcomp, rc) ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr call get_ocean_grid(ocean_state, ocean_grid) -#ifdef CESMCOUPLED - call mom_export(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out -#endif + if (cesm_coupled) then + call mom_export_cesm(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1920,42 +1893,17 @@ subroutine ModelAdvance(gcomp, rc) type (ocean_state_type), pointer :: ocean_state => NULL() type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() type(ocean_internalstate_wrapper) :: ocean_internalstate + type(ocean_grid_type) , pointer :: ocean_grid type(time_type) :: Time type(time_type) :: Time_step_coupled type(time_type) :: Time_restart_current integer :: dth, dtm, dts, dt_cpld = 86400 - integer :: isc,iec,jsc,jec,lbnd1,ubnd1,lbnd2,ubnd2 - integer :: i,j,i1,j1 - real :: slp_L, slp_R, slp_C, slope, u_min, u_max !JW integer :: nc type(ESMF_Time) :: MyTime integer :: seconds, day, year, month, hour, minute character(ESMF_MAXSTR) :: restartname, cvalue -#ifndef CESMCOUPLED - real(ESMF_KIND_R8), allocatable :: ofld(:,:), ocz(:,:), ocm(:,:) - real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_mmmf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_mzmf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ocz(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ocm(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_melt_potential(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_frzmlt(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) !JW - real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) !JW - real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) - real(ESMF_KIND_R8), allocatable :: ssh(:,:) - real(ESMF_KIND_R8), allocatable :: sshx(:,:) - real(ESMF_KIND_R8), allocatable :: sshy(:,:) -#endif - type(ocean_grid_type), pointer :: ocean_grid character(240) :: msgString character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' - ! helper flag for debugging bounds - logical :: BoundsDebug = .false. - integer :: ijloc(2) !-------------------------------- rc = ESMF_SUCCESS @@ -2017,6 +1965,10 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out + !--------------- + ! Determine dt_cpld (needed for export) + !--------------- + call ESMF_TimeIntervalGet(timeStep, h=dth, m=dtm, s=dts, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2027,6 +1979,10 @@ subroutine ModelAdvance(gcomp, rc) Time_step_coupled = esmf2fms_time(timeStep) dt_cpld = dth*3600+dtm*60+dts + !--------------- + ! Write diagnostics for import + !--------------- + if(write_diagnostics) then call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', & timeslice=import_slice, relaxedFlag=.true., rc=rc) @@ -2037,336 +1993,85 @@ subroutine ModelAdvance(gcomp, rc) import_slice = import_slice + 1 endif - ! rotate the lat/lon wind vector (CW) onto local tripolar coordinate system - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + !--------------- + ! Get ocean grid + !--------------- call get_ocean_grid(ocean_state, ocean_grid) -#ifdef CESMCOUPLED + !--------------- + ! Import data + !--------------- - call shr_file_setLogUnit (logunit) - - call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, logunit, runtype, clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - -#else - - call State_getFldPtr(exportState,'ocean_mask',dataPtr_mask,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - lbnd1 = lbound(dataPtr_mask,1) - ubnd1 = ubound(dataPtr_mask,1) - lbnd2 = lbound(dataPtr_mask,2) - ubnd2 = ubound(dataPtr_mask,2) - - call State_getFldPtr(importState,'mean_zonal_moment_flx',dataPtr_mzmf,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'mean_merid_moment_flx',dataPtr_mmmf,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'mean_evap_rate',dataPtr_evap,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'mean_sensi_heat_flx',dataPtr_sensi,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - dataPtr_evap = - dataPtr_evap - dataPtr_sensi = - dataPtr_sensi - - print *, 'lbnd1,ubnd1,lbnd2,ubnd2', lbnd1, ubnd1, lbnd2, ubnd2 - - allocate(mzmf(lbnd1:ubnd1,lbnd2:ubnd2)) - allocate(mmmf(lbnd1:ubnd1,lbnd2:ubnd2)) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 -! j1 = j - lbnd2 + jsc ! work around local vs global indexing -! i1 = i - lbnd1 + isc - j1 = j + ocean_grid%jsc - lbnd2 - i1 = i + ocean_grid%isc - lbnd1 -! mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & -! + ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) -! mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & -! - ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) - mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - - ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) - mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) - enddo - enddo - dataPtr_mzmf = mzmf - dataPtr_mmmf = mmmf - deallocate(mzmf, mmmf) - - !Optionally write restart files when currTime-startTime is integer multiples of restart_interval -! if (restart_interval > 0 ) then -! time_elapsed = currTime - startTime -! call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & -! line=__LINE__, & -! file=__FILE__)) & -! return ! bail out -! n_interval = time_elapsed_sec / restart_interval -! if ((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then -! time_restart_current = esmf2fms_time(currTime) -! timestamp = date_to_string(time_restart_current) -! call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=rc) -! write(*,*) 'calling ocean_model_restart' -! call ocean_model_restart(ocean_state, timestamp) -! endif -! endif -#endif + if (cesm_coupled) then + call shr_file_setLogUnit (logunit) + call mom_import_cesm(ocean_public, ocean_grid, importState, ice_ocean_boundary, & + logunit, runtype, clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else + call mom_import_nems(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + !--------------- ! Update MOM6 + !--------------- + + ! Optionally write restart files when currTime-startTime is integer multiples of restart_interval + ! if (restart_interval > 0 ) then + ! time_elapsed = currTime - startTime + ! call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + ! n_interval = time_elapsed_sec / restart_interval + ! if ((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then + ! time_restart_current = esmf2fms_time(currTime) + ! timestamp = date_to_string(time_restart_current) + ! call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=rc) + ! write(*,*) 'calling ocean_model_restart' + ! call ocean_model_restart(ocean_state, timestamp) + ! endif + ! endif if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled) if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") -#ifdef CESMCOUPLED - - call mom_export(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! reset shr logging to my original values - call shr_file_setLogUnit (output_unit) - -#else - - allocate(ofld(isc:iec,jsc:jec)) - - call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_mask(i,j) = nint(ofld(i1,j1)) - enddo - enddo - deallocate(ofld) - - ! Now rotate ocn current from tripolar grid back to lat/lon grid (CCW) - allocate(ocz(lbnd1:ubnd1,lbnd2:ubnd2)) - allocate(ocm(lbnd1:ubnd1,lbnd2:ubnd2)) - - call State_getFldPtr(exportState,'ocn_current_zonal',dataPtr_ocz,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'ocn_current_merid',dataPtr_ocm,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - !call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! fixfrzmlt !JW - call State_getFldPtr(exportState,'accum_heat_frazil',dataPtr_frazil,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'inst_melt_potential',dataPtr_melt_potential,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frzmlt,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'sea_surface_slope_zonal',dataPtr_dhdx,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(exportState,'sea_surface_slope_merid',dataPtr_dhdy,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out !JW - - allocate( ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW - allocate(sshx(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW - allocate(sshy(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW - ssh = 0.0_ESMF_KIND_R8 !JW - sshx = 0.0_ESMF_KIND_R8 !JW - sshy = 0.0_ESMF_KIND_R8 !JW - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! note: the following code is modified from NCAR nuopc driver mom_cap_methods - ! where is the rotation in that system? - ! - ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain - ! in order to update halos. i.e. does not use global indexing. - ! - ! here, isc,iec,jsc,jec are global indices on cap domain (no halos) - - do j=jsc,jec - do i=isc,iec - j1 = j - ocean_grid%jdg_offset - i1 = i - ocean_grid%idg_offset - ssh(i1,j1) = Ocean_public%sea_lev(i,j) - end do - end do - - ! Update halo of ssh so we can calculate gradients - call pass_var(ssh, ocean_grid%domain) - - ! calculation of slope on native mom domains (local indexing, halos) - ! stay inside of halos (ie 2:79,2:97) - ! d/dx ssh - do j = ocean_grid%jsd+1,ocean_grid%jed-1 - do i = ocean_grid%isd+1,ocean_grid%ied-1 - ! This is a simple second-order difference - !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = (ssh(I,j) - ssh(I-1,j)) * ocean_grid%mask2dCu(i-1,j) - if (ocean_grid%mask2dCu(i-1,j)==0.) slp_L = 0. - slp_R = (ssh(I+1,j) - ssh(I,j)) * ocean_grid%mask2dCu(i,j) - if (ocean_grid%mask2dCu(i+1,j)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - if ( (slp_L * slp_R) > 0.0 ) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - sshx(i,j) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) sshx(i,j) = 0.0 - end do - end do + !--------------- + ! Export Data + !--------------- - ! d/dy ssh - do j = ocean_grid%jsd+1,ocean_grid%jed-1 - do i = ocean_grid%isd+1,ocean_grid%ied-1 - ! This is a simple second-order difference - !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = ssh(i,J) - ssh(i,J-1) * ocean_grid%mask2dCv(i,j-1) - if (ocean_grid%mask2dCv(i,j-1)==0.) slp_L = 0. - slp_R = ssh(i,J+1) - ssh(i,J) * ocean_grid%mask2dCv(i,j) - if (ocean_grid%mask2dCv(i,j+1)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R - if ((slp_L * slp_R) > 0.0) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - sshy(i,j) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) sshy(i,j) = 0.0 - end do - end do - ! rotate slopes from tripolar grid back to lat/lon grid (CCW) - ! "grid" uses the usual MOM domain that has halos - ! and does not use global indexing. - ! x,y => latlon - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j + ocean_grid%jsc - lbnd2 - i1 = i + ocean_grid%isc - lbnd1 - dataPtr_dhdx(i,j) = ocean_grid%cos_rot(i1,j1)*sshx(i1,j1) & - + ocean_grid%sin_rot(i1,j1)*sshy(i1,j1) - dataPtr_dhdy(i,j) = ocean_grid%cos_rot(i1,j1)*sshy(i1,j1) & - - ocean_grid%sin_rot(i1,j1)*sshx(i1,j1) - enddo - enddo - deallocate(ssh); deallocate(sshx); deallocate(sshy) - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling - dataPtr_melt_potential = -dataPtr_melt_potential/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling - !melt_potential, defined positive for T>Tfreeze - !so change sign - !testing - ijloc = maxloc(dataPtr_frazil) - if((sum(ijloc) .gt. 2) .and. & - (dataPtr_frazil(ijloc(1),ijloc(2)) .gt. 0.0))then - i1 = ijloc(1) - lbnd1 + isc - j1 = ijloc(2) - lbnd2 + jsc ! work around local vs global indexing - write (msgString,*)' MOM6 dataPtr_frazil at maxloc ',i1,j1,& - real(dataPtr_frazil(ijloc(1),ijloc(2)),4) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - - write (msgString,*)' MOM6 dataPtr_melt_potential at maxloc ',i1,j1,& - real(dataPtr_melt_potential(ijloc(1),ijloc(2)),4) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - endif - !testing - - dataPtr_melt_potential = min(dataPtr_melt_potential,0.0) - - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - if(dataPtr_frazil(i,j) .eq. 0.0)then - dataPtr_frzmlt(i,j) = dataPtr_melt_potential(i,j) - else - dataPtr_frzmlt(i,j) = dataPtr_frazil(i,j) - endif - enddo - enddo - dataPtr_frzmlt = max(-1000.0,min(1000.0,dataPtr_frzmlt)) - - ! rotate ocn current from tripolar grid back to lat/lon grid (CCW) - ! "grid" uses the usual MOM domain that has halos - ! and does not use global indexing. - ! x,y => latlon - ocz = dataPtr_ocz - ocm = dataPtr_ocm - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j + ocean_grid%jsc - lbnd2 - i1 = i + ocean_grid%isc - lbnd1 - dataPtr_ocz(i,j) = ocean_grid%cos_rot(i1,j1)*ocz(i,j) & - + ocean_grid%sin_rot(i1,j1)*ocm(i,j) - dataPtr_ocm(i,j) = ocean_grid%cos_rot(i1,j1)*ocm(i,j) & - - ocean_grid%sin_rot(i1,j1)*ocz(i,j) - ! multiply by mask to zero out non-ocean points - dataPtr_ocz(i,j) = dataPtr_ocz(i,j) * dataPtr_mask(i,j) - dataPtr_ocm(i,j) = dataPtr_ocm(i,j) * dataPtr_mask(i,j) - enddo - enddo - deallocate(ocz, ocm) + if (cesm_coupled) then + call mom_export_cesm(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else + call mom_export_nems(ocean_state, ocean_public, ocean_grid, dt_cpld, exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if -#endif + if (cesm_coupled) then + ! reset shr logging to my original values + call shr_file_setLogUnit (output_unit) + end if + !--------------- ! If restart alarm is ringing - write restart file + !--------------- + call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2449,6 +2154,10 @@ subroutine ModelAdvance(gcomp, rc) end if endif + !--------------- + ! Write diagnostics + !--------------- + if (write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & timeslice=export_slice, relaxedFlag=.true., rc=rc) @@ -2673,11 +2382,11 @@ subroutine ocean_model_finalize(gcomp, rc) return ! bail out Time = esmf2fms_time(currTime) -#ifdef CESMCOUPLED - call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.false.) -#else - call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.true.) -#endif + if (cesm_coupled) then + call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.false.) + else + call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.true.) + end if call field_manager_end() call fms_io_exit() @@ -2687,35 +2396,7 @@ subroutine ocean_model_finalize(gcomp, rc) end subroutine ocean_model_finalize - !==================================================================== - - subroutine State_GetFldPtr(ST, fldname, fldptr, rc) - type(ESMF_State) , intent(in) :: ST - character(len=*) , intent(in) :: fldname - real(ESMF_KIND_R8) , pointer, intent(in) :: fldptr(:,:) - integer , intent(out), optional :: rc - - ! local variables - type(ESMF_Field) :: lfield - integer :: lrc - character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' - - call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (present(rc)) rc = lrc - - end subroutine State_GetFldPtr - - !----------------------------------------------------------------------------- +!=============================================================================== subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_count, rc) ! ---------------------------------------------- @@ -2756,7 +2437,7 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ end subroutine State_SetScalar - !----------------------------------------------------------------------------- +!=============================================================================== subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) @@ -2857,7 +2538,7 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) end subroutine MOM_RealizeFields - !----------------------------------------------------------------------------- +!=============================================================================== subroutine SetScalarField(field, rc) ! ---------------------------------------------- @@ -2889,7 +2570,7 @@ subroutine SetScalarField(field, rc) end subroutine SetScalarField - !----------------------------------------------------------------------------- +!=============================================================================== subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) ! ---------------------------------------------- @@ -2933,6 +2614,4 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) end subroutine fld_list_add - !----------------------------------------------------------------------------- - end module mom_cap_mod diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 26da8c8a56..e0ca9648c8 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -1,12 +1,18 @@ module mom_cap_methods + ! Cap import/export methods for both NEMS and CMEPS + + ! Masks, areas, center (tlat, tlon), and corner (ulat, ulon) coordinates are then added to the `ESMF_Grid` + ! by retrieving those fields from MOM with calls to `ocean_model_data_get()`. + + use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet - use ESMF, only: ESMF_State, ESMF_StateGet - use ESMF, only: ESMF_KIND_R8, ESMF_Field, ESMF_SUCCESS, ESMF_LogFoundError - use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_FieldGet + use ESMF, only: ESMF_State, ESMF_StateGet, ESMF_Field, ESMF_FieldGet + use ESMF, only: ESMF_KIND_R8, ESMF_SUCCESS, ESMF_LogFoundError + use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO, ESMF_LOGWRITE use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE - use MOM_ocean_model, only: ocean_public_type, ocean_state_type + use MOM_ocean_model, only: ocean_public_type, ocean_state_type, ocean_model_data_get use MOM_surface_forcing, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type use MOM_domains, only: pass_var @@ -18,25 +24,23 @@ module mom_cap_methods private ! Public member functions -#ifdef CESMCOUPLED - public :: mom_export - public :: mom_import -#endif + public :: mom_export_cesm + public :: mom_import_cesm + public :: mom_export_nems public :: mom_import_nems integer :: rc,dbrc integer :: import_cnt = 0 logical, parameter :: debug=.false. -!----------------------------------------------------------------------- +!=============================================================================== contains -!----------------------------------------------------------------------- +!=============================================================================== -#ifdef CESMCOUPLED !> Maps outgoing ocean data to ESMF State - !! See \ref section_mom_export for a summary of the data - !! that is transferred from MOM6 to MCT. - subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) + subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) + + ! Input/output variables type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid type(ESMF_State) , intent(inout) :: exportState !< outgoing data @@ -45,9 +49,9 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) integer , intent(inout) :: rc ! Local variables - real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo + real :: ssh(grid%isd:grid%ied,grid%jsd:grid%jed) !< Local copy of sea_lev with updated halo integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices - integer :: lbnd1, lbnd2 + integer :: lbnd1, lbnd2, ubnd1, ubnd2 real :: slp_L, slp_R, slp_C, slope, u_min, u_max real :: I_time_int !< The inverse of coupling time interval in s-1. integer :: day, secs @@ -156,8 +160,7 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 if (ocean_public%frazil(ig,jg) > 0.0) then ! Frazil: change from J/m^2 to W/m^2 - ! NOTE: if this is uncommented - then restarts no longer work - !dataPtr_Fioo_q(i1,j1) = ocean_public%frazil(i,j) * grid%mask2dT(ig,jg) * I_time_int + ! dataPtr_Fioo_q(i1,j1) = ocean_public%frazil(i,j) * grid%mask2dT(ig,jg) * I_time_int else ! Melt_potential: change from J/m^2 to W/m^2 dataPtr_Fioo_q(i1,j1) = -ocean_public%melt_potential(i,j) * grid%mask2dT(ig,jg) * I_time_int !* ncouple_per_day @@ -264,9 +267,9 @@ subroutine mom_export(ocean_public, grid, exportState, logunit, clock, rc) end do end if - end subroutine mom_export + end subroutine mom_export_cesm -!----------------------------------------------------------------------- +!=============================================================================== !> 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 @@ -274,7 +277,7 @@ end subroutine mom_export !! 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 mom_import(ocean_public, grid, importState, ice_ocean_boundary, & + subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, & logunit, runtype, clock, rc) type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state @@ -500,25 +503,271 @@ subroutine mom_import(ocean_public, grid, importState, ice_ocean_boundary, & end do end if - end subroutine mom_import -#endif - !----------------------------------------------------------------------------- + end subroutine mom_import_cesm + +!=============================================================================== + + subroutine mom_export_nems(ocean_state, ocean_public, ocean_grid, dt_cpld, exportState, rc) + + ! Input/output variables + type (ocean_state_type) , pointer :: ocean_state + type (ocean_public_type) , pointer :: ocean_public + type (ocean_grid_type) , pointer :: ocean_grid + integer , intent(in) :: dt_cpld + type(ESMF_State) , intent(inout) :: exportState !< outgoing data + integer , intent(out) :: rc + + ! Local variables + integer :: lbnd1, lbnd2, ubnd1, ubnd2 + integer :: i, j, i1, j1, ig, jg !< Grid indices + integer :: isc, iec, jsc, jec !< Grid indices + real :: slp_L, slp_R, slp_C, slope, u_min, u_max !JW + real(ESMF_KIND_R8), allocatable :: ofld(:,:) + real(ESMF_KIND_R8), allocatable :: ocz(:,:) + real(ESMF_KIND_R8), allocatable :: ocm(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ocz(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ocm(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_melt_potential(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_frzmlt(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) !JW + real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) !JW + real(ESMF_KIND_R8), allocatable :: ssh(:,:) + real(ESMF_KIND_R8), allocatable :: sshx(:,:) + real(ESMF_KIND_R8), allocatable :: sshy(:,:) + integer :: ijloc(2) + character(len=240) :: msgString + !-------------------------------- + + call State_getFldPtr(exportState,'ocn_current_zonal',dataPtr_ocz,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'ocn_current_merid',dataPtr_ocm,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + !call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + ! fixfrzmlt !JW + call State_getFldPtr(exportState,'accum_heat_frazil',dataPtr_frazil,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'inst_melt_potential',dataPtr_melt_potential,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frzmlt,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'sea_surface_slope_zonal',dataPtr_dhdx,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_getFldPtr(exportState,'sea_surface_slope_merid',dataPtr_dhdy,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out !JW + + allocate( ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW + allocate(sshx(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW + allocate(sshy(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW + ssh = 0.0_ESMF_KIND_R8 !JW + sshx = 0.0_ESMF_KIND_R8 !JW + sshy = 0.0_ESMF_KIND_R8 !JW + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! note: the following code is modified from NCAR nuopc driver mom_cap_methods + ! where is the rotation in that system? + ! + ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain + ! in order to update halos. i.e. does not use global indexing. + ! + ! here, isc,iec,jsc,jec are global indices on cap domain (no halos) + + do j=jsc,jec + do i=isc,iec + j1 = j - ocean_grid%jdg_offset + i1 = i - ocean_grid%idg_offset + ssh(i1,j1) = Ocean_public%sea_lev(i,j) + end do + end do + + ! Update halo of ssh so we can calculate gradients + call pass_var(ssh, ocean_grid%domain) + + ! calculation of slope on native mom domains (local indexing, halos) + ! stay inside of halos (ie 2:79,2:97) + ! d/dx ssh + do j = ocean_grid%jsd+1,ocean_grid%jed-1 + do i = ocean_grid%isd+1,ocean_grid%ied-1 + ! This is a simple second-order difference + !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = (ssh(I,j) - ssh(I-1,j)) * ocean_grid%mask2dCu(i-1,j) + if (ocean_grid%mask2dCu(i-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * ocean_grid%mask2dCu(i,j) + if (ocean_grid%mask2dCu(i+1,j)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + if ( (slp_L * slp_R) > 0.0 ) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + sshx(i,j) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) sshx(i,j) = 0.0 + end do + end do + + ! d/dy ssh + do j = ocean_grid%jsd+1,ocean_grid%jed-1 + do i = ocean_grid%isd+1,ocean_grid%ied-1 + ! This is a simple second-order difference + !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = ssh(i,J) - ssh(i,J-1) * ocean_grid%mask2dCv(i,j-1) + if (ocean_grid%mask2dCv(i,j-1)==0.) slp_L = 0. + slp_R = ssh(i,J+1) - ssh(i,J) * ocean_grid%mask2dCv(i,j) + if (ocean_grid%mask2dCv(i,j+1)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R + if ((slp_L * slp_R) > 0.0) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + sshy(i,j) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) sshy(i,j) = 0.0 + end do + end do + ! rotate slopes from tripolar grid back to lat/lon grid (CCW) + ! "grid" uses the usual MOM domain that has halos + ! and does not use global indexing. + ! x,y => latlon + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j + ocean_grid%jsc - lbnd2 + i1 = i + ocean_grid%isc - lbnd1 + dataPtr_dhdx(i,j) = ocean_grid%cos_rot(i1,j1)*sshx(i1,j1) & + + ocean_grid%sin_rot(i1,j1)*sshy(i1,j1) + dataPtr_dhdy(i,j) = ocean_grid%cos_rot(i1,j1)*sshy(i1,j1) & + - ocean_grid%sin_rot(i1,j1)*sshx(i1,j1) + enddo + enddo + deallocate(ssh); deallocate(sshx); deallocate(sshy) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling + + dataPtr_melt_potential = -dataPtr_melt_potential/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling + !melt_potential, defined positive for T>Tfreeze + !so change sign + !testing + ijloc = maxloc(dataPtr_frazil) + if((sum(ijloc) .gt. 2) .and. (dataPtr_frazil(ijloc(1),ijloc(2)) .gt. 0.0))then + i1 = ijloc(1) - lbnd1 + isc + j1 = ijloc(2) - lbnd2 + jsc ! work around local vs global indexing + + write (msgString,*)' MOM6 dataPtr_frazil at maxloc ',i1,j1,& + real(dataPtr_frazil(ijloc(1),ijloc(2)),4) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + + write (msgString,*)' MOM6 dataPtr_melt_potential at maxloc ',i1,j1,& + real(dataPtr_melt_potential(ijloc(1),ijloc(2)),4) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + endif + !testing + + dataPtr_melt_potential = min(dataPtr_melt_potential,0.0) + + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + if(dataPtr_frazil(i,j) .eq. 0.0)then + dataPtr_frzmlt(i,j) = dataPtr_melt_potential(i,j) + else + dataPtr_frzmlt(i,j) = dataPtr_frazil(i,j) + endif + enddo + enddo + dataPtr_frzmlt = max(-1000.0,min(1000.0,dataPtr_frzmlt)) + + ! rotate ocn current from tripolar grid back to lat/lon grid (CCW) + ! "grid" uses the usual MOM domain that has halos and does not use global indexing. + ! x,y => latlon + + allocate(ofld(isc:iec,jsc:jec)) + call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_mask(i,j) = nint(ofld(i1,j1)) + enddo + enddo + deallocate(ofld) - subroutine mom_import_nems(ocean_public, grid, importState, ice_ocean_boundary, rc) + allocate(ocz(lbnd1:ubnd1,lbnd2:ubnd2)) + allocate(ocm(lbnd1:ubnd1,lbnd2:ubnd2)) + ocz = dataPtr_ocz + ocm = dataPtr_ocm + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j + ocean_grid%jsc - lbnd2 + i1 = i + ocean_grid%isc - lbnd1 + dataPtr_ocz(i,j) = ocean_grid%cos_rot(i1,j1)*ocz(i,j) & + + ocean_grid%sin_rot(i1,j1)*ocm(i,j) + dataPtr_ocm(i,j) = ocean_grid%cos_rot(i1,j1)*ocm(i,j) & + - ocean_grid%sin_rot(i1,j1)*ocz(i,j) + ! multiply by mask to zero out non-ocean points + dataPtr_ocz(i,j) = dataPtr_ocz(i,j) * dataPtr_mask(i,j) + dataPtr_ocm(i,j) = dataPtr_ocm(i,j) * dataPtr_mask(i,j) + enddo + enddo + deallocate(ocz, ocm) + + end subroutine mom_export_nems + +!=============================================================================== + + subroutine mom_import_nems(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc) + ! Input/output variables type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state - type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid + type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid type(ESMF_State) , intent(inout) :: importState !< incoming data type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing integer , intent(inout) :: rc ! Local Variables - integer :: i, j, i1, j1, ig, jg ! Grid indices - integer :: isc, iec, jsc, jec ! Grid indices - integer :: i0, j0, is, js, ie, je - integer :: lbnd1, lbnd2 - integer :: ubnd1, ubnd2 - real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) + integer :: lbnd1,ubnd1,lbnd2,ubnd2 + integer :: i, j, i1, j1, ig, jg ! Grid indices + integer :: isc, iec, jsc, jec ! Grid indices + integer :: i0, j0, is, js, ie, je ! Grid indices real(ESMF_KIND_R8), pointer :: dataPtr_p(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_mmmf(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_mzmf(:,:) @@ -538,7 +787,6 @@ subroutine mom_import_nems(ocean_public, grid, importState, ice_ocean_boundary, real(ESMF_KIND_R8), pointer :: dataPtr_calving_hflx(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_mi(:,:) - real(ESMF_KIND_R8), allocatable :: ofld(:,:), ocz(:,:), ocm(:,:) real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) integer :: day, secs type(ESMF_time) :: currTime @@ -548,22 +796,22 @@ subroutine mom_import_nems(ocean_public, grid, importState, ice_ocean_boundary, rc = ESMF_SUCCESS - call State_getFldPtr(importState,"mean_zonal_moment_flx", dataPtr_mzmf, rc=rc) + call State_getFldPtr(importState,'mean_zonal_moment_flx',dataPtr_mzmf,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"mean_merid_moment_flx", dataPtr_mmmf, rc=rc) + call State_getFldPtr(importState,'mean_merid_moment_flx',dataPtr_mmmf,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"mean_sensi_heat_flx", dataPtr_sensi, rc=rc) + call State_getFldPtr(importState,'mean_evap_rate',dataPtr_evap,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"mean_evap_rate" , dataPtr_evap, rc=rc) + call State_getFldPtr(importState,'mean_sensi_heat_flx',dataPtr_sensi,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -573,12 +821,12 @@ subroutine mom_import_nems(ocean_public, grid, importState, ice_ocean_boundary, line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"mean_net_sw_ir_dif_flx" , dataPtr_swndr, rc=rc) + call State_getFldPtr(importState,"mean_net_sw_ir_dir_flx" , dataPtr_swndr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"mean_net_sw_ir_dir_flx" , dataPtr_swndf, rc=rc) + call State_getFldPtr(importState,"mean_net_sw_ir_dif_flx" , dataPtr_swndf, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -634,23 +882,24 @@ subroutine mom_import_nems(ocean_public, grid, importState, ice_ocean_boundary, file=__FILE__)) & return ! bail out + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + lbnd1 = lbound(dataPtr_p,1) ubnd1 = ubound(dataPtr_p,1) lbnd2 = lbound(dataPtr_p,2) ubnd2 = ubound(dataPtr_p,2) - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + print *, 'lbnd1,ubnd1,lbnd2,ubnd2', lbnd1, ubnd1, lbnd2, ubnd2 allocate(mzmf(lbnd1:ubnd1,lbnd2:ubnd2)) allocate(mmmf(lbnd1:ubnd1,lbnd2:ubnd2)) do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc ! work around local vs global indexing - i1 = i - lbnd1 + isc - mzmf(i,j) = grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - + grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) - mmmf(i,j) = grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - - grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) + j1 = j + ocean_grid%jsc - lbnd2 + i1 = i + ocean_grid%isc - lbnd1 + mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & + - ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) + mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & + + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) enddo enddo dataPtr_mzmf = mzmf @@ -685,7 +934,7 @@ subroutine mom_import_nems(ocean_public, grid, importState, ice_ocean_boundary, end subroutine mom_import_nems - !----------------------------------------------------------------------------- +!=============================================================================== subroutine State_GetFldPtr(ST, fldname, fldptr, rc) type(ESMF_State) , intent(in) :: ST From f0d557f2cf9e6a63168e62f9f169a00bbd03146e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 10 Dec 2018 12:39:59 -0700 Subject: [PATCH 0945/1072] more updates to get the nuopc and mct changes consistent --- .../nuopc_driver/MOM_surface_forcing.F90 | 139 ++++++++++++------ config_src/nuopc_driver/mom_cap.F90 | 46 +++--- config_src/nuopc_driver/mom_cap_methods.F90 | 48 +++--- 3 files changed, 149 insertions(+), 84 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 19a0ddbf86..cc8496a322 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -45,11 +45,15 @@ module MOM_surface_forcing #include -public convert_IOB_to_fluxes, convert_IOB_to_forces +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 ice_ocn_bnd_type_chksum +private apply_flux_adjustments +private apply_force_adjustments +private surface_forcing_end ! surface_forcing_CS is a structure containing pointers to the forcing fields ! which may be used to drive MOM. All fluxes are positive downward. @@ -147,11 +151,13 @@ module MOM_surface_forcing 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. 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) @@ -190,7 +196,15 @@ module MOM_surface_forcing integer :: id_clock_forcing +#ifdef CESMCOUPLED + logical :: cesm_coupled = .true. +#else + logical :: cesm_coupled = .false. +#endif + +!======================================================================= contains +!======================================================================= !> This subroutine translates the Ice_ocean_boundary_type into a MOM !! thermodynamic forcing type, including changes of units, sign conventions, @@ -418,50 +432,75 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & fluxes%fprec(i,j) = IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%q_flux)) & - fluxes%evap(i,j) = - IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%evap(i,j) = IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) - if (associated(IOB%runoff)) & - fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) + ! Note: currently runoff is treated differently for nems and cesm coupling + if (cesm_coupled) then + ! liquid runoff flux + if (associated(fluxes%lrunoff)) & + fluxes%lrunoff(i,j) = G%mask2dT(i,j) * IOB%rofl_flux(i-i0,j-j0) - if (associated(IOB%calving)) & - fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) + ! ice runoff flux + if (associated(fluxes%frunoff)) & + fluxes%frunoff(i,j) = G%mask2dT(i,j) * IOB%rofi_flux(i-i0,j-j0) - if (associated(IOB%ustar_berg)) & - fluxes%ustar_berg(i,j) = IOB%ustar_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(IOB%runoff_hflx)) & + fluxes%heat_content_lrunoff(i,j) = 0.0 * 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%calving_hflx)) & + fluxes%heat_content_frunoff(i,j) = 0.0 * G%mask2dT(i,j) + else + if (associated(IOB%runoff)) & + fluxes%lrunoff(i,j) = IOB%runoff(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%calving)) & + fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%ustar_berg)) & + fluxes%ustar_berg(i,j) = 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%runoff_hflx)) & - fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(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%calving_hflx)) & - fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) + if (associated(IOB%runoff_hflx)) & + fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * 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) + end if if (associated(IOB%lw_flux)) & fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%t_flux)) & - fluxes%sens(i,j) = - IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) - - fluxes%latent(i,j) = 0.0 - 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 - if (associated(IOB%calving)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion - fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion - endif - if (associated(IOB%q_flux)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor - fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor - endif + fluxes%sens(i,j) = IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) - fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) + ! Note: currently latent heat flux is treated differently for nems and cesm + if (cesm_coupled) then + if (associated(IOB%latent_flux)) & + fluxes%latent(i,j) = G%mask2dT(i,j) * IOB%latent_flux(i-i0,j-j0) + else + fluxes%latent(i,j) = 0.0 + 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 + if (associated(IOB%calving)) then + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion + endif + if (associated(IOB%q_flux)) then + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor + fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor + endif + + fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) + end if 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) @@ -500,15 +539,15 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & enddo ; enddo endif -!### if (associated(CS%ctrl_forcing_CSp)) then -!### do j=js,je ; do i=is,ie -!### SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) -!### SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) -!### SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) -!### enddo ; enddo -!### call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_restore, & -!### fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) -!### endif + !### if (associated(CS%ctrl_forcing_CSp)) then + !### do j=js,je ; do i=is,ie + !### SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) + !### SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) + !### SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) + !### enddo ; enddo + !### call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_restore, & + !### fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) + !### endif ! adjust the NET fresh-water flux to zero, if flagged if (CS%adjust_net_fresh_water_to_zero) then @@ -560,6 +599,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, 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. @@ -844,6 +885,8 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) call cpu_clock_end(id_clock_forcing) end subroutine convert_IOB_to_forces +!======================================================================= + !> Adds thermodynamic flux adjustments obtained via data_override !! Component name is 'OCN' !! Available adjustments are: @@ -889,6 +932,8 @@ subroutine apply_flux_adjustments(G, CS, Time, fluxes) ! 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: @@ -947,6 +992,8 @@ subroutine apply_force_adjustments(G, CS, Time, forces) end subroutine apply_force_adjustments +!======================================================================= + !> Save any restart files associated with the surface forcing. subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & filename_suffix) @@ -967,6 +1014,8 @@ subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & end subroutine forcing_save_restart +!======================================================================= + !> Initialize the surface forcing, including setting parameters and allocating permanent memory. subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, restore_temp) type(time_type), intent(in) :: Time !< The current model time @@ -1299,6 +1348,8 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res call cpu_clock_end(id_clock_forcing) end subroutine surface_forcing_init +!======================================================================= + !> 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 !< A pointer to the control structure returned by @@ -1317,6 +1368,8 @@ 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) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index ad19ae4df5..d15b102b33 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -467,7 +467,9 @@ module mom_cap_mod logical :: cesm_coupled = .false. #endif +!======================================================================= contains +!======================================================================= !=============================================================================== !> NUOPC SetService method is the only public entry point. @@ -979,6 +981,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) Ice_ocean_boundary% calving_hflx (isc:iec,jsc:jec), & Ice_ocean_boundary% mi (isc:iec,jsc:jec), & Ice_ocean_boundary% p (isc:iec,jsc:jec)) + if (cesm_coupled) then + allocate( Ice_ocean_boundary% rofl_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% rofi_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% latent_flux (isc:iec,jsc:jec)) + end if Ice_ocean_boundary%u_flux = 0.0 Ice_ocean_boundary%v_flux = 0.0 @@ -998,6 +1005,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) Ice_ocean_boundary%calving_hflx = 0.0 Ice_ocean_boundary%mi = 0.0 Ice_ocean_boundary%p = 0.0 + if (cesm_coupled) then + Ice_ocean_boundary%rofl_flux = 0.0 + Ice_ocean_boundary%rofi_flux = 0.0 + Ice_ocean_boundary%latent_flux = 0.0 + end if ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) @@ -1012,23 +1024,23 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (len_trim(scalar_field_name) > 0) then call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") ! not in EMC endif - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! -> mean_net_sw_ir_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! -> mean_net_sw_ir_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! -> mean_net_sw_vis_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr", "will provide") ! -> mean_net_sw_ir_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr", "will provide") ! -> mean_net_sw_vis_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf", "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf", "will provide") ! -> mean_net_sw_vis_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") ! -> mean latent heat flux + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") ! -> mean long wave up + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface ! EMC fields not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index e0ca9648c8..7ca7ab39ef 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -8,7 +8,7 @@ module mom_cap_methods use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet - use ESMF, only: ESMF_State, ESMF_StateGet, ESMF_Field, ESMF_FieldGet + use ESMF, only: ESMF_State, ESMF_StateGet, ESMF_Field, ESMF_FieldGet use ESMF, only: ESMF_KIND_R8, ESMF_SUCCESS, ESMF_LogFoundError use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO, ESMF_LOGWRITE use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE @@ -300,7 +300,6 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, real(ESMF_KIND_R8), pointer :: dataPtr_sen(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_lat(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_osalt(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_lwdn(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_lwup(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_swvdr(:,:) @@ -309,7 +308,7 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, real(ESMF_KIND_R8), pointer :: dataPtr_swndf(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_rofl(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_rofi(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_iosalt(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_salt(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_rain(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_snow(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_lamult(:,:) @@ -394,7 +393,7 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Fioi_salt" , dataPtr_iosalt, rc=rc) + call State_getFldPtr(importState,"Fioi_salt" , dataPtr_salt, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -430,23 +429,23 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, j1 = j + lbnd2 - jsc do i = isc, iec i1 = i + lbnd1 - isc - - ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) - ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) - ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) - ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) - ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) - ice_ocean_boundary%t_flux(i,j) = -dataPtr_sen(i1,j1) - ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) - ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(i1,j1) + dataPtr_lwdn(i1,j1) - ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(i1,j1) - ice_ocean_boundary%salt_flux(i,j) = dataPtr_iosalt(i1,j1) - ice_ocean_boundary%runoff(i,j) = dataPtr_rofl(i1,j1) + dataPtr_rofi(i1,j1) - !ice_ocean_boundary%salt_flux(i,j) = dataPtr_osalt(i1,j1) + ice_ocean_boundary%salt_flux(i,j) - !ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(i1,j1) + ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) ! surface pressure + ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) ! zonal surface stress - taux + ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) ! meridional surface stress - tauy + ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) ! liquid precipitation (rain) + ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) ! frozen precipitation (snow) + ice_ocean_boundary%t_flux(i,j) = dataPtr_sen(i1,j1) ! sensible heat flux (W/m2) + ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(i1,j1) ! latent heat flux (W/m^2) + ice_ocean_boundary%q_flux(i,j) = dataPtr_evap(i1,j1) ! specific humidity flux + ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(i1,j1) & + + dataPtr_lwdn(i1,j1) ! longwave radiation, sum up and down (W/m2) + ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) ! visible, direct shortwave (W/m2) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) ! visible, diffuse shortwave (W/m2) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) ! near-IR, direct shortwave (W/m2) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(i1,j1) ! near-IR, diffuse shortwave (W/m2) + ice_ocean_boundary%rofl_flux(i,j) = dataPtr_rofl(i1,j1) ! ice runoff + ice_ocean_boundary%rofi_flux(i,j) = dataPtr_rofi(i1,j1) ! liquid runoff + ice_ocean_boundary%salt_flux(i,j) = -dataPtr_salt(i1,j1) ! salt flux (minus sign needed here -GMM) enddo enddo @@ -460,6 +459,7 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, ! GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1) ! end do ! end do + end if ! debug output @@ -696,7 +696,7 @@ subroutine mom_export_nems(ocean_state, ocean_public, ocean_grid, dt_cpld, expor write (msgString,*)' MOM6 dataPtr_frazil at maxloc ',i1,j1,& real(dataPtr_frazil(ijloc(1),ijloc(2)),4) call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - + write (msgString,*)' MOM6 dataPtr_melt_potential at maxloc ',i1,j1,& real(dataPtr_melt_potential(ijloc(1),ijloc(2)),4) call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) @@ -913,8 +913,8 @@ subroutine mom_import_nems(ocean_public, ocean_grid, importState, ice_ocean_boun ice_ocean_boundary%u_flux(i,j) = dataPtr_mzmf(i1,j1) ice_ocean_boundary%v_flux(i,j) = dataPtr_mmmf(i1,j1) - ice_ocean_boundary%q_flux(i,j) = -dataPtr_evap(i1,j1) - ice_ocean_boundary%t_flux(i,j) = -dataPtr_sensi(i1,j1) + ice_ocean_boundary%q_flux(i,j) = dataPtr_evap(i1,j1) + ice_ocean_boundary%t_flux(i,j) = dataPtr_sensi(i1,j1) ice_ocean_boundary%salt_flux(i,j) = dataPtr_salt(i1,j1) ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwflux(i1,j1) ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) From acc2ef55fc3911a85e340a14d15aa7e9fdfcfaa0 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 10 Dec 2018 13:25:28 -0700 Subject: [PATCH 0946/1072] Move pointer assignment outside of the loop --- config_src/mct_driver/MOM_surface_forcing.F90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 6955c20aa1..9af22755cc 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -599,14 +599,15 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) forces%p_surf(i,j) = forces%p_surf_full(i,j) endif - if (CS%use_limited_P_SSH) then - forces%p_surf_SSH => forces%p_surf - else - forces%p_surf_SSH => forces%p_surf_full - endif - end if + endif end do; end do + if (CS%use_limited_P_SSH) then + forces%p_surf_SSH => forces%p_surf + else + forces%p_surf_SSH => forces%p_surf_full + endif + ! GMM, CIME uses AGRID. All the BGRID_NE code can be cleaned later wind_stagger = AGRID From 88fd8c674926aa5b43327389a71d405be3ce0f19 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 10 Dec 2018 13:31:55 -0700 Subject: [PATCH 0947/1072] Change end do to enddo --- config_src/mct_driver/MOM_surface_forcing.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 9af22755cc..20359f1950 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -600,7 +600,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) endif endif - end do; end do + enddo; enddo if (CS%use_limited_P_SSH) then forces%p_surf_SSH => forces%p_surf From 79cf0d03b2f6c7ee52f9f72bcbf14e9d8c6b934f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 10 Dec 2018 15:01:46 -0700 Subject: [PATCH 0948/1072] more updates to get mom6 working correctly --- .../nuopc_driver/MOM_surface_forcing.F90 | 66 ++++++++++--------- config_src/nuopc_driver/mom_cap_methods.F90 | 2 +- 2 files changed, 36 insertions(+), 32 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index cc8496a322..88848fc3c2 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -293,14 +293,16 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & call safe_alloc_ptr(fluxes%sw_nir_dir,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%sw_nir_dif,isd,ied,jsd,jed) - 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 - + if (.not. cesm_coupled) then + 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 + end if + call safe_alloc_ptr(fluxes%salt_flux,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%salt_flux_in,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) @@ -515,22 +517,24 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & enddo ; enddo - ! 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 - + if (.not. cesm_coupled) then + ! 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 + end if + ! more salt restoring logic if (associated(IOB%salt_flux)) then do j=js,je ; do i=is,ie @@ -656,16 +660,11 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) ! 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%use_limited_P_SSH) then - forces%p_surf_SSH => forces%p_surf - else - forces%p_surf_SSH => forces%p_surf_full - endif if (CS%rigid_sea_ice) then call safe_alloc_ptr(forces%rigidity_ice_u,IsdB,IedB,jsd,jed) @@ -689,6 +688,11 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) if (associated(forces%rigidity_ice_v)) forces%rigidity_ice_v(:,:) = 0.0 ! applied surface pressure from atmosphere and cryosphere + 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 diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 7ca7ab39ef..fe515ae123 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -160,7 +160,7 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 if (ocean_public%frazil(ig,jg) > 0.0) then ! Frazil: change from J/m^2 to W/m^2 - ! dataPtr_Fioo_q(i1,j1) = ocean_public%frazil(i,j) * grid%mask2dT(ig,jg) * I_time_int + dataPtr_Fioo_q(i1,j1) = ocean_public%frazil(i,j) * grid%mask2dT(ig,jg) * I_time_int else ! Melt_potential: change from J/m^2 to W/m^2 dataPtr_Fioo_q(i1,j1) = -ocean_public%melt_potential(i,j) * grid%mask2dT(ig,jg) * I_time_int !* ncouple_per_day From e0d604ccabdb47b49e2de8ca055bb9b960d2442c Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 11 Dec 2018 11:00:07 -0700 Subject: [PATCH 0949/1072] bug fixes and removal of trailing white space --- config_src/nuopc_driver/MOM_surface_forcing.F90 | 4 ++-- config_src/nuopc_driver/mom_cap.F90 | 2 +- config_src/nuopc_driver/mom_cap_methods.F90 | 2 +- src/ice_shelf/MOM_ice_shelf.F90 | 10 +++++----- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 4 ++-- 5 files changed, 11 insertions(+), 11 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 88848fc3c2..8b25fdf958 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -302,7 +302,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & fluxes%p_surf_SSH => fluxes%p_surf_full endif end if - + call safe_alloc_ptr(fluxes%salt_flux,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%salt_flux_in,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) @@ -534,7 +534,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & fluxes%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. endif end if - + ! more salt restoring logic if (associated(IOB%salt_flux)) then do j=js,je ; do i=is,ie diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index d15b102b33..efb8aa75d6 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -147,7 +147,7 @@ !! !! call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_public, Time, Time_step_coupled) !! -!! Priori to the call to `update_ocean_model()`, the cap performs these steps +!! Priori to the call to `update_ocean_model()`, the cap performs these steps !! - the `Time` and `Time_step_coupled` parameters, based on FMS types, are derived from the incoming ESMF clock !! - there are calls to two stubs: `ice_ocn_bnd_from_data()` and `external_coupler_sbc_before()` - these are currently !! inactive, but may be modified to read in import data from file or from an external coupler diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index fe515ae123..0f305296f3 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -158,7 +158,7 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) dataPtr_v(i1,j1) = ocean_public%v_surf(i,j) * grid%mask2dT(ig,jg) dataPtr_bldepth(i1,j1) = ocean_public%OBLD(i,j) * grid%mask2dT(ig,jg) ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 - if (ocean_public%frazil(ig,jg) > 0.0) then + if (ocean_public%frazil(i,j) > 0.0) then ! Frazil: change from J/m^2 to W/m^2 dataPtr_Fioo_q(i1,j1) = ocean_public%frazil(i,j) * grid%mask2dT(ig,jg) * I_time_int else diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 3a27c988c9..9abebcfe9a 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -308,7 +308,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) if (CS%mass_from_file) call update_shelf_mass(G, CS, ISS, Time) endif - if (CS%DEBUG) then + if (CS%debug) then call hchksum(fluxes%frac_shelf_h, "frac_shelf_h before apply melting", G%HI, haloshift=0) call hchksum(state%sst, "sst before apply melting", G%HI, haloshift=0) call hchksum(state%sss, "sss before apply melting", G%HI, haloshift=0) @@ -633,7 +633,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) call change_thickness_using_melt(ISS, G, time_step, fluxes, CS%density_ice, CS%debug) endif - if (CS%DEBUG) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, haloshift=0) + if (CS%debug) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, haloshift=0) call add_shelf_flux(G, CS, state, fluxes) @@ -675,7 +675,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) call cpu_clock_end(id_clock_shelf) - if (CS%DEBUG) call MOM_forcing_chksum("End of shelf calc flux", fluxes, G, haloshift=0) + if (CS%debug) call MOM_forcing_chksum("End of shelf calc flux", fluxes, G, haloshift=0) end subroutine shelf_calc_flux @@ -1043,7 +1043,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) endif enddo ; enddo - if (CS%DEBUG) then + if (CS%debug) then write(mesg,*) 'Mean melt flux (kg/(m^2 s)), dt = ', mean_melt_flux, CS%time_step call MOM_mesg(mesg) call MOM_forcing_chksum("After constant sea level", fluxes, G, haloshift=0) @@ -1483,7 +1483,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if (G%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) / G%areaT(i,j) enddo ; enddo ; endif - if (CS%DEBUG) then + if (CS%debug) then call hchksum(fluxes%frac_shelf_h, "IS init: frac_shelf_h", G%HI, haloshift=0) endif diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index eea9ee322a..eac698f67c 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -920,7 +920,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) call ice_shelf_solve_inner(CS, ISS, G, u, v, TAUDX, TAUDY, H_node, float_cond, & ISS%hmask, conv_flag, iters, time, Phi, Phisub) - if (CS%DEBUG) then + if (CS%debug) then call qchksum(u, "u shelf", G%HI, haloshift=2) call qchksum(v, "v shelf", G%HI, haloshift=2) endif @@ -3597,7 +3597,7 @@ subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) call pass_var(CS%t_shelf, G%domain) call pass_var(CS%tmask, G%domain) - if (CS%DEBUG) then + if (CS%debug) then call hchksum(CS%t_shelf, "temp after front", G%HI, haloshift=3) endif From 4b815771d30107d6038a0fd9d4ed04d8ae055ba6 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 12 Dec 2018 11:33:40 -0700 Subject: [PATCH 0950/1072] Fix indices bug in ocn_import --- config_src/mct_driver/ocn_cap_methods.F90 | 28 +++++++++++------------ 1 file changed, 13 insertions(+), 15 deletions(-) diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 92fe04bbdf..063cc13e96 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -33,7 +33,7 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, real(kind=8), optional , intent(in) :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition ! Local variables - integer :: i, j, ig, jg, isc, iec, jsc, jec ! Grid indices + integer :: i, j, isc, iec, jsc, jec ! Grid indices integer :: k integer :: day, secs, rc type(ESMF_time) :: currTime @@ -44,9 +44,7 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, k = 0 do j = jsc, jec - jg = j + grid%jsc - jsc do i = isc, iec - ig = i + grid%jsc - isc k = k + 1 ! Increment position within gindex ! taux @@ -80,16 +78,16 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, ice_ocean_boundary%meltw(i,j) = x2o(ind%x2o_Fioi_meltw,k) ! liquid runoff - ice_ocean_boundary%rofl_flux(i,j) = x2o(ind%x2o_Foxx_rofl,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%rofl_flux(i,j) = x2o(ind%x2o_Foxx_rofl,k) * GRID%mask2dT(i,j) ! ice runoff - ice_ocean_boundary%rofi_flux(i,j) = x2o(ind%x2o_Foxx_rofi,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%rofi_flux(i,j) = x2o(ind%x2o_Foxx_rofi,k) * GRID%mask2dT(i,j) ! surface pressure - ice_ocean_boundary%p(i,j) = x2o(ind%x2o_Sa_pslv,k) * GRID%mask2dT(ig,jg) + 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(ig,jg) + 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) @@ -97,15 +95,15 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, ! 4) near-IR, diffuse shortwave (W/m2) if (present(c1) .and. present(c2) .and. present(c3) .and. present(c4)) then ! Use runtime coefficients to decompose net short-wave heat flux into 4 components - ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c1 * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c2 * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c3 * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c4 * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c1 * GRID%mask2dT(i,j) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c2 * GRID%mask2dT(i,j) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c3 * GRID%mask2dT(i,j) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Foxx_swnet,k) * c4 * GRID%mask2dT(i,j) else - ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Faxa_swvdr,k) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Faxa_swvdf,k) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Faxa_swndr,k) * GRID%mask2dT(ig,jg) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Faxa_swndf,k) * GRID%mask2dT(ig,jg) + ice_ocean_boundary%sw_flux_vis_dir(i,j) = x2o(ind%x2o_Faxa_swvdr,k) * GRID%mask2dT(i,j) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = x2o(ind%x2o_Faxa_swvdf,k) * GRID%mask2dT(i,j) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = x2o(ind%x2o_Faxa_swndr,k) * GRID%mask2dT(i,j) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = x2o(ind%x2o_Faxa_swndf,k) * GRID%mask2dT(i,j) endif enddo enddo From c41cdb3df4e5527d7cf96c4f96d093c39fe676e0 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 12 Dec 2018 13:12:44 -0700 Subject: [PATCH 0951/1072] for cesm use mesh rather than grid - huge cost savings for initialization with CMEPS --- config_src/nuopc_driver/mom_cap.F90 | 834 +++++++++++--------- config_src/nuopc_driver/mom_cap_methods.F90 | 403 ++++------ 2 files changed, 643 insertions(+), 594 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index efb8aa75d6..dd7da83ebc 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -390,7 +390,7 @@ module mom_cap_mod use MOM_domains, only: pass_var use MOM_error_handler, only: is_root_pe use MOM_ocean_model, only: ice_ocean_boundary_type - use MOM_grid, only: ocean_grid_type + use MOM_grid, only: ocean_grid_type, get_global_grid_size use MOM_ocean_model, only: ocean_model_restart, ocean_public_type, ocean_state_type use MOM_ocean_model, only: ocean_model_data_get, ocean_model_init_sfc use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid @@ -1207,6 +1207,7 @@ end subroutine InitializeAdvertise !! @param exportState an ESMF_State object for export fields !! @param clock an ESMF_Clock object !! @param rc return code + subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -1215,14 +1216,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Local Variables type(ESMF_VM) :: vm - type(ESMF_Grid) :: gridIn - type(ESMF_Grid) :: gridOut + type(ESMF_Grid) :: gridIn, gridOut + type(ESMF_Mesh) :: Emesh, EmeshTemp type(ESMF_DeLayout) :: delayout type(ESMF_Distgrid) :: Distgrid type(ESMF_DistGridConnection), allocatable :: connectionList(:) type (ocean_public_type), pointer :: ocean_public => NULL() type (ocean_state_type), pointer :: ocean_state => NULL() type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_grid_type) , pointer :: ocean_grid type(ocean_internalstate_wrapper) :: ocean_internalstate integer :: npet, ntiles integer :: nxg, nyg, cnt @@ -1249,6 +1251,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) type(ESMF_Field) :: field_t_surf integer :: mpicom integer :: localPet + integer :: lsize + integer :: ig,jg, ni,nj,k + integer, allocatable :: gindex(:) ! global index space + character(len=256) :: cvalue character(len=*), parameter :: subname='(mom_cap:InitializeRealize)' !-------------------------------- @@ -1339,385 +1345,454 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) enddo end if - !--------------------------------- - ! create delayout and distgrid + ! Create either a grid or a mesh !--------------------------------- - allocate(deBlockList(2,2,ntiles)) - allocate(petMap(ntiles)) - allocate(deLabelList(ntiles)) - - do n = 1, ntiles - deLabelList(n) = n - deBlockList(1,1,n) = xb(n) - deBlockList(1,2,n) = xe(n) - deBlockList(2,1,n) = yb(n) - deBlockList(2,2,n) = ye(n) - petMap(n) = pe(n) - ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side - enddo + if (cesm_coupled) then - delayout = ESMF_DELayoutCreate(petMap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + !--------------------------------- + ! Create a MOM6 mesh + !--------------------------------- + + ! Get the ocean grid and sizes of global and computational domains + call get_ocean_grid(ocean_state, ocean_grid) + call get_global_grid_size(ocean_grid, ni, nj) + lsize = ( ocean_grid%iec - ocean_grid%isc + 1 ) * ( ocean_grid%jec - ocean_grid%jsc + 1 ) + + ! Create the global index space for the computational domain + allocate(gindex(lsize)) + k = 0 + do j = ocean_grid%jsc, ocean_grid%jec + jg = j + ocean_grid%jdg_offset + do i = ocean_grid%isc, ocean_grid%iec + ig = i + ocean_grid%idg_offset + k = k + 1 ! Increment position within gindex + gindex(k) = ni * (jg - 1) + ig + enddo + enddo - ! rsd this assumes tripole grid, but sometimes in CESM a bipole - ! grid is used -- need to introduce conditional logic here + DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return - allocate(connectionList(2)) + ! read in the mesh + call NUOPC_CompAttributeGet(gcomp, name='mesh_ocn', value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return - ! bipolar boundary condition at top row: nyg - call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & - tileIndexB=1, positionVector=(/nxg+1, 2*nyg+1/), & - orientationVector=(/-1, -2/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + EMeshTemp = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (localPet == 0) then + write(logunit,*)'mesh file for mom6 domain is ',trim(cvalue) + end if + + ! recreate the mesh using the above distGrid + EMesh = ESMF_MeshCreate(EMeshTemp, elementDistgrid=Distgrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return - ! periodic boundary condition along first dimension - call ESMF_DistGridConnectionSet(connectionList(2), tileIndexA=1, & - tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! realize the import and export fields using the mesh + call MOM_RealizeFields(importState, fldsToOcn_num, fldsToOcn, "Ocn import", mesh=Emesh, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call MOM_RealizeFields(exportState, fldsFrOcn_num, fldsFrOcn, "Ocn export", mesh=Emesh, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nxg,nyg/), & -! indexflag = ESMF_INDEX_DELOCAL, & - deBlockList=deBlockList, & -! deLabelList=deLabelList, & - delayout=delayout, & - connectionList=connectionList, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + else - deallocate(xb,xe,yb,ye,pe) - deallocate(connectionList) - deallocate(deLabelList) - deallocate(deBlockList) - deallocate(petMap) + !--------------------------------- + ! create a MOM6 grid + !--------------------------------- + + ! generate delayout and dist_grid + + allocate(deBlockList(2,2,ntiles)) + allocate(petMap(ntiles)) + allocate(deLabelList(ntiles)) + + do n = 1, ntiles + deLabelList(n) = n + deBlockList(1,1,n) = xb(n) + deBlockList(1,2,n) = xe(n) + deBlockList(2,1,n) = yb(n) + deBlockList(2,2,n) = ye(n) + petMap(n) = pe(n) + ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side + enddo - call ESMF_DistGridGet(distgrid=distgrid, localDE=0, elementCount=cnt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - allocate(indexList(cnt)) - write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - write(tmpstr,'(a,4i8)') subname//' distgrid list= ',& - indexList(1),indexList(cnt),minval(indexList), maxval(indexList) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - deallocate(IndexList) + delayout = ESMF_DELayoutCreate(petMap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - !--------------------------------- - ! create grid - !--------------------------------- + ! rsd this assumes tripole grid, but sometimes in CESM a bipole + ! grid is used -- need to introduce conditional logic here - gridIn = ESMF_GridCreate(distgrid=distgrid, & - gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & - coordSys = ESMF_COORDSYS_SPH_DEG, & - rc = rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + allocate(connectionList(2)) - mom_grid_i = gridIn + ! bipolar boundary condition at top row: nyg + call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & + tileIndexB=1, positionVector=(/nxg+1, 2*nyg+1/), & + orientationVector=(/-1, -2/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! periodic boundary condition along first dimension + call ESMF_DistGridConnectionSet(connectionList(2), tileIndexA=1, & + tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ! Attach area to the Grid optionally. By default the cell areas are computed. - if(grid_attach_area) then - call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif + distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nxg,nyg/), & + ! indexflag = ESMF_INDEX_DELOCAL, & + deBlockList=deBlockList, & + ! deLabelList=deLabelList, & + delayout=delayout, & + connectionList=connectionList, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call ESMF_GridGetCoord(gridIn, coordDim=1, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_xcen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridGetCoord(gridIn, coordDim=2, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_ycen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + deallocate(xb,xe,yb,ye,pe) + deallocate(connectionList) + deallocate(deLabelList) + deallocate(deBlockList) + deallocate(petMap) - call ESMF_GridGetCoord(gridIn, coordDim=1, & - staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=dataPtr_xcor, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridGetCoord(gridIn, coordDim=2, & - staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=dataPtr_ycor, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_DistGridGet(distgrid=distgrid, localDE=0, elementCount=cnt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + allocate(indexList(cnt)) + write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(tmpstr,'(a,4i8)') subname//' distgrid list= ',& + indexList(1),indexList(cnt),minval(indexList), maxval(indexList) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + deallocate(IndexList) - call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_MASK, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_mask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if(grid_attach_area) then - call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_area, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif + ! create grid - !--------------------------------- - ! load up area, mask, center and corner values - ! area, mask, and centers should be same size in mom and esmf grid - ! corner points may not be, need to offset corner points by 1 in i and j - ! for esmf and also need to "make up" j=1 values. use wraparound in i - !--------------------------------- + gridIn = ESMF_GridCreate(distgrid=distgrid, & + gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & + coordSys = ESMF_COORDSYS_SPH_DEG, & + rc = rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + mom_grid_i = gridIn - lbnd1 = lbound(dataPtr_mask,1) - ubnd1 = ubound(dataPtr_mask,1) - lbnd2 = lbound(dataPtr_mask,2) - ubnd2 = ubound(dataPtr_mask,2) + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - lbnd3 = lbound(dataPtr_xcor,1) - ubnd3 = ubound(dataPtr_xcor,1) - lbnd4 = lbound(dataPtr_xcor,2) - ubnd4 = ubound(dataPtr_xcor,2) + ! Attach area to the Grid optionally. By default the cell areas are computed. + if(grid_attach_area) then + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif - write(tmpstr,*) subname//' iscjsc = ',isc,iec,jsc,jec - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_GridGetCoord(gridIn, coordDim=1, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_xcen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridGetCoord(gridIn, coordDim=2, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_ycen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - write(tmpstr,*) subname//' lbub12 = ',lbnd1,ubnd1,lbnd2,ubnd2 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_GridGetCoord(gridIn, coordDim=1, & + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=dataPtr_xcor, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridGetCoord(gridIn, coordDim=2, & + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=dataPtr_ycor, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - write(tmpstr,*) subname//' lbub34 = ',lbnd3,ubnd3,lbnd4,ubnd4 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_MASK, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_mask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if(grid_attach_area) then + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_area, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif - if (iec-isc /= ubnd1-lbnd1 .or. jec-jsc /= ubnd2-lbnd2) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": fld and grid do not have the same size.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - allocate(ofld(isc:iec,jsc:jec)) - allocate(gfld(nxg,nyg)) + ! load up area, mask, center and corner values + ! area, mask, and centers should be same size in mom and esmf grid + ! corner points may not be, need to offset corner points by 1 in i and j + ! for esmf and also need to "make up" j=1 values. use wraparound in i - call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld mask = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld mask = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_mask(i,j) = nint(ofld(i1,j1)) - enddo - enddo + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - if(grid_attach_area) then - call ocean_model_data_get(ocean_state, ocean_public, 'area', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld area = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld area = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_area(i,j) = ofld(i1,j1) - enddo - enddo - endif + lbnd1 = lbound(dataPtr_mask,1) + ubnd1 = ubound(dataPtr_mask,1) + lbnd2 = lbound(dataPtr_mask,2) + ubnd2 = ubound(dataPtr_mask,2) - call ocean_model_data_get(ocean_state, ocean_public, 'tlon', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld xt = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld xt = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_xcen(i,j) = ofld(i1,j1) - dataPtr_xcen(i,j) = mod(dataPtr_xcen(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) - enddo - enddo + lbnd3 = lbound(dataPtr_xcor,1) + ubnd3 = ubound(dataPtr_xcor,1) + lbnd4 = lbound(dataPtr_xcor,2) + ubnd4 = ubound(dataPtr_xcor,2) - call ocean_model_data_get(ocean_state, ocean_public, 'tlat', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld yt = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld yt = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_ycen(i,j) = ofld(i1,j1) - enddo - enddo + write(tmpstr,*) subname//' iscjsc = ',isc,iec,jsc,jec + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call ocean_model_data_get(ocean_state, ocean_public, 'geoLonBu', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld xu = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld xu = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd4, ubnd4 - do i = lbnd3, ubnd3 - j1 = j - lbnd4 + jsc - 1 - i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 - if (j1 == 0) then - dataPtr_xcor(i,j) = 2*gfld(i1,1) - gfld(i1,2) -! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) > 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) - 360. -! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) < 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) + 360. - elseif (j1 >= 1 .and. j1 <= nyg) then - dataPtr_xcor(i,j) = gfld(i1,j1) - else - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": error in xu j1.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - dataPtr_xcor(i,j) = mod(dataPtr_xcor(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) - ! write(tmpstr,*) subname//' ijfld xu = ',i,i1,j,j1,dataPtr_xcor(i,j) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - enddo - enddo + write(tmpstr,*) subname//' lbub12 = ',lbnd1,ubnd1,lbnd2,ubnd2 + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - ! MOM6 runs on C-Grid. - call ocean_model_data_get(ocean_state, ocean_public, 'geoLatBu', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld yu = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld yu = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd4, ubnd4 - do i = lbnd3, ubnd3 - j1 = j - lbnd4 + jsc - 1 - i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 - if (j1 == 0) then - dataPtr_ycor(i,j) = 2*gfld(i1,1) - gfld(i1,2) - elseif (j1 >= 1 .and. j1 <= nyg) then - dataPtr_ycor(i,j) = gfld(i1,j1) - else - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": error in yu j1.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - ! write(tmpstr,*) subname//' ijfld yu = ',i,i1,j,j1,dataPtr_ycor(i,j) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - enddo - enddo + write(tmpstr,*) subname//' lbub34 = ',lbnd3,ubnd3,lbnd4,ubnd4 + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (iec-isc /= ubnd1-lbnd1 .or. jec-jsc /= ubnd2-lbnd2) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": fld and grid do not have the same size.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif - if(grid_attach_area) then - write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - endif + allocate(ofld(isc:iec,jsc:jec)) + allocate(gfld(nxg,nyg)) + + call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld mask = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call mpp_global_field(ocean_public%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld mask = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_mask(i,j) = nint(ofld(i1,j1)) + enddo + enddo - write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if(grid_attach_area) then + call ocean_model_data_get(ocean_state, ocean_public, 'area', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld area = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call mpp_global_field(ocean_public%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld area = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_area(i,j) = ofld(i1,j1) + enddo + enddo + endif - write(tmpstr,*) subname//' ycen = ',minval(dataPtr_ycen),maxval(dataPtr_ycen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ocean_model_data_get(ocean_state, ocean_public, 'tlon', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld xt = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call mpp_global_field(ocean_public%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld xt = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_xcen(i,j) = ofld(i1,j1) + dataPtr_xcen(i,j) = mod(dataPtr_xcen(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) + enddo + enddo - write(tmpstr,*) subname//' xcor = ',minval(dataPtr_xcor),maxval(dataPtr_xcor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ocean_model_data_get(ocean_state, ocean_public, 'tlat', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld yt = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call mpp_global_field(ocean_public%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld yt = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + dataPtr_ycen(i,j) = ofld(i1,j1) + enddo + enddo - write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ocean_model_data_get(ocean_state, ocean_public, 'geoLonBu', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld xu = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call mpp_global_field(ocean_public%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld xu = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + do j = lbnd4, ubnd4 + do i = lbnd3, ubnd3 + j1 = j - lbnd4 + jsc - 1 + i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 + if (j1 == 0) then + dataPtr_xcor(i,j) = 2*gfld(i1,1) - gfld(i1,2) + ! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) > 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) - 360. + ! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) < 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) + 360. + elseif (j1 >= 1 .and. j1 <= nyg) then + dataPtr_xcor(i,j) = gfld(i1,j1) + else + rc=ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": error in xu j1.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + dataPtr_xcor(i,j) = mod(dataPtr_xcor(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) + ! write(tmpstr,*) subname//' ijfld xu = ',i,i1,j,j1,dataPtr_xcor(i,j) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + enddo + enddo - deallocate(gfld) + ! MOM6 runs on C-Grid. + call ocean_model_data_get(ocean_state, ocean_public, 'geoLatBu', ofld, isc, jsc) + write(tmpstr,*) subname//' ofld yu = ',minval(ofld),maxval(ofld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call mpp_global_field(ocean_public%domain, ofld, gfld) + write(tmpstr,*) subname//' gfld yu = ',minval(gfld),maxval(gfld) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + do j = lbnd4, ubnd4 + do i = lbnd3, ubnd3 + j1 = j - lbnd4 + jsc - 1 + i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 + if (j1 == 0) then + dataPtr_ycor(i,j) = 2*gfld(i1,1) - gfld(i1,2) + elseif (j1 >= 1 .and. j1 <= nyg) then + dataPtr_ycor(i,j) = gfld(i1,j1) + else + rc=ESMF_FAILURE + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": error in yu j1.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + ! write(tmpstr,*) subname//' ijfld yu = ',i,i1,j,j1,dataPtr_ycor(i,j) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + enddo + enddo - gridOut = gridIn ! for now out same as in + write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - !--------------------------------- - ! realize fields on grid - !--------------------------------- + if(grid_attach_area) then + write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + endif + write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call MOM_RealizeFields(importState, gridIn , fldsToOcn_num, fldsToOcn, "Ocn import", rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + write(tmpstr,*) subname//' ycen = ',minval(dataPtr_ycen),maxval(dataPtr_ycen) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call MOM_RealizeFields(exportState, gridOut, fldsFrOcn_num, fldsFrOcn, "Ocn export", rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + write(tmpstr,*) subname//' xcor = ',minval(dataPtr_xcor),maxval(dataPtr_xcor) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + deallocate(gfld) + + gridOut = gridIn ! for now out same as in + + call MOM_RealizeFields(importState, fldsToOcn_num, fldsToOcn, "Ocn import", grid=gridIn, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call MOM_RealizeFields(exportState, fldsFrOcn_num, fldsFrOcn, "Ocn export", grid=gridOut, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end if + + !--------------------------------- + ! set scalar data in export state + !--------------------------------- if (len_trim(scalar_field_name) > 0) then call State_SetScalar(dble(nxg),scalar_field_idx_grid_nx, exportState, localPet, & @@ -1726,7 +1801,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & scalar_field_name, scalar_field_count, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1734,6 +1809,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out endif + + !--------------------------------- + ! realize fields on grid + !--------------------------------- call ESMF_StateGet(exportState, itemSearch="sea_surface_temperature", itemCount=icount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -2451,14 +2530,15 @@ end subroutine State_SetScalar !=============================================================================== - subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) + subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) - type(ESMF_State) , intent(inout) :: state - type(ESMF_Grid) , intent(in) :: grid - integer , intent(in) :: nfields - type(fld_list_type) , intent(inout) :: field_defs(:) - character(len=*) , intent(in) :: tag - integer , intent(inout) :: rc + type(ESMF_State) , intent(inout) :: state + integer , intent(in) :: nfields + type(fld_list_type) , intent(inout) :: field_defs(:) + character(len=*) , intent(in) :: tag + type(ESMF_Grid) , intent(in), optional :: grid + type(ESMF_Mesh) , intent(in), optional :: mesh + integer , intent(inout) :: rc integer :: i type(ESMF_Field) :: field @@ -2496,34 +2576,58 @@ subroutine MOM_RealizeFields(state, grid, nfields, field_defs, tag, rc) lbound(field_defs(i)%farrayPtr,1), ubound(field_defs(i)%farrayPtr,1), & lbound(field_defs(i)%farrayPtr,2), ubound(field_defs(i)%farrayPtr,2) call ESMF_LogWrite(tmpstr, ESMF_LOGMSG_INFO, rc=rc) - field = ESMF_FieldCreate(grid=grid, & - farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & - !farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + + if (present(grid)) then + field = ESMF_FieldCreate(grid=grid, & + farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & + !farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else if (present(mesh)) then + field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + else + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected.", & ESMF_LOGMSG_INFO, & line=__LINE__, & file=__FILE__, & rc=rc) - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (present(grid)) then - ! initialize to zero - call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - fldptr = 0.0 + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! initialize to zero + call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + fldptr = 0.0 + + else if (present(mesh)) then + + field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if endif diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 0f305296f3..ac85e73491 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -29,9 +29,13 @@ module mom_cap_methods public :: mom_export_nems public :: mom_import_nems + interface State_GetFldPtr + module procedure State_GetFldPtr_1d + module procedure State_GetFldPtr_2d + end interface + integer :: rc,dbrc integer :: import_cnt = 0 - logical, parameter :: debug=.false. !=============================================================================== contains @@ -51,20 +55,20 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) ! Local variables real :: ssh(grid%isd:grid%ied,grid%jsd:grid%jed) !< Local copy of sea_lev with updated halo integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices - integer :: lbnd1, lbnd2, ubnd1, ubnd2 + integer :: n real :: slp_L, slp_R, slp_C, slope, u_min, u_max real :: I_time_int !< The inverse of coupling time interval in s-1. integer :: day, secs type(ESMF_time) :: currTime - real(ESMF_KIND_R8), pointer :: dataPtr_omask(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_t(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_s(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_u(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_v(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_fioo_q(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_omask(:) + real(ESMF_KIND_R8), pointer :: dataPtr_t(:) + real(ESMF_KIND_R8), pointer :: dataPtr_s(:) + real(ESMF_KIND_R8), pointer :: dataPtr_u(:) + real(ESMF_KIND_R8), pointer :: dataPtr_v(:) + real(ESMF_KIND_R8), pointer :: dataPtr_fioo_q(:) + real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:) + real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:) + real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:) type(ESMF_TimeInterval) :: timeStep integer :: dt_int !< time over which to advance the ocean (ocean_coupling_time_step), in sec character(len=*), parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" @@ -120,11 +124,6 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) file=__FILE__)) & return ! bail out - lbnd1 = lbound(dataPtr_t,1) - lbnd2 = lbound(dataPtr_t,2) - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - ! Use Adcroft's rule of reciprocals; it does the right thing here. call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -145,30 +144,31 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) ! Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. ! The mask comes from "grid" that uses the usual MOM domain that has halos ! and does not use global indexing. - do j = jsc, jec - j1 = j + lbnd2 - jsc - jg = j + grid%jsc - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + grid%isc - isc - dataPtr_omask(i1,j1) = grid%mask2dT(ig,jg) - dataPtr_t(i1,j1) = ocean_public%t_surf(i,j) * grid%mask2dT(ig,jg) ! surface temp is in K - dataPtr_s(i1,j1) = ocean_public%s_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_u(i1,j1) = ocean_public%u_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_v(i1,j1) = ocean_public%v_surf(i,j) * grid%mask2dT(ig,jg) - dataPtr_bldepth(i1,j1) = ocean_public%OBLD(i,j) * grid%mask2dT(ig,jg) - ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 - if (ocean_public%frazil(i,j) > 0.0) then - ! Frazil: change from J/m^2 to W/m^2 - dataPtr_Fioo_q(i1,j1) = ocean_public%frazil(i,j) * grid%mask2dT(ig,jg) * I_time_int - else - ! Melt_potential: change from J/m^2 to W/m^2 - dataPtr_Fioo_q(i1,j1) = -ocean_public%melt_potential(i,j) * grid%mask2dT(ig,jg) * I_time_int !* ncouple_per_day - ! make sure Melt_potential is always <= 0 - if (dataPtr_Fioo_q(i1,j1) > 0.0) dataPtr_Fioo_q(i1,j1) = 0.0 - end if - end do + n = 0 + do j=grid%jsc, grid%jec + jg = j + grid%jdg_offset + do i=grid%isc,grid%iec + ig = i + grid%idg_offset + n = n+1 + dataPtr_omask(n) = grid%mask2dT(i,j) + dataPtr_t(n) = ocean_public%t_surf(ig,jg) * grid%mask2dT(i,j) ! surface temp is in K + dataPtr_s(n) = ocean_public%s_surf(ig,jg) * grid%mask2dT(i,j) + dataPtr_u(n) = ocean_public%u_surf(ig,jg) * grid%mask2dT(i,j) + dataPtr_v(n) = ocean_public%v_surf(ig,jg) * grid%mask2dT(i,j) + dataPtr_bldepth(n) = ocean_public%OBLD(ig,jg) * grid%mask2dT(i,j) + ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 + if (ocean_public%frazil(ig,jg) > 0.0) then + ! Frazil: change from J/m^2 to W/m^2 + dataPtr_Fioo_q(n) = ocean_public%frazil(ig,jg) * grid%mask2dT(i,j) * I_time_int + else + ! Melt_potential: change from J/m^2 to W/m^2 + dataPtr_Fioo_q(n) = -ocean_public%melt_potential(ig,jg) * grid%mask2dT(i,j) * I_time_int !* ncouple_per_day + + ! make sure Melt_potential is always <= 0 + if (dataPtr_Fioo_q(n) > 0.0) dataPtr_Fioo_q(n) = 0.0 + end if + end do end do ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain @@ -185,87 +185,65 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) call pass_var(ssh, grid%domain) ! d/dx ssh - do jg = jsc, jec - j = jg + grid%jsc - jsc - j1 = jg + lbnd2 - jsc - do ig = isc,iec - i = ig + grid%isc - isc - i1 = ig + lbnd1 - isc - - ! This is a simple second-order difference - !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(ig,jg) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(i-1,j) - if (grid%mask2dCu(i-1,j)==0.) slp_L = 0. - slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(i,j) - if (grid%mask2dCu(i+1,j)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - if ( (slp_L * slp_R) > 0.0 ) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - dataPtr_dhdx(i1,j1) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) dataPtr_dhdx(i1,j1) = 0.0 - end do - end do + n = 0 + do j=grid%jsc, grid%jec + do i=grid%isc,grid%iec + n = n+1 + ! This is a simple second-order difference + ! dataPtr_dhdx(n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) + if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(I,j) + if (grid%mask2dCu(I+1,j)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + if ( (slp_L * slp_R) > 0.0 ) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + endif + dataPtr_dhdx(n) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) dataPtr_dhdx(n) = 0.0 + enddo + enddo ! d/dy ssh - do jg = jsc, jec - j = jg + grid%jsc - jsc - j1 = jg + lbnd2 - jsc - do ig = isc,iec - i = ig + grid%isc - isc - i1 = ig + lbnd1 - isc - - ! This is a simple second-order difference - !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(ig,jg) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,j-1) - if (grid%mask2dCv(i,j-1)==0.) slp_L = 0. - slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,j) - if (grid%mask2dCv(i,j+1)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R - if ((slp_L * slp_R) > 0.0) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - dataPtr_dhdy(i1,j1) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) dataPtr_dhdy(i1,j1) = 0.0 - end do - end do - - if (debug .and. is_root_pe()) then - call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) - call ESMF_TimeGet(CurrTime, d=day, s=secs, rc=rc) - - do j = jsc, jec - j1 = j + lbnd2 - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - write(logunit,F01)'export: day, secs, j, i, t_surf = ',day,secs,j,i,dataPtr_t(i1,j1) - write(logunit,F01)'export: day, secs, j, i, s_surf = ',day,secs,j,i,dataPtr_s(i1,j1) - write(logunit,F01)'export: day, secs, j, i, u_surf = ',day,secs,j,i,dataPtr_u(i1,j1) - write(logunit,F01)'export: day, secs, j, i, v_surf = ',day,secs,j,i,dataPtr_v(i1,j1) - write(logunit,F01)'export: day, secs, j, i, dhdx = ',day,secs,j,i,dataPtr_dhdx(i1,j1) - write(logunit,F01)'export: day, secs, j, i, dhdy = ',day,secs,j,i,dataPtr_dhdy(i1,j1) - end do - end do - end if + n = 0 + do j=grid%jsc, grid%jec + do i=grid%isc,grid%iec + n = n+1 + ! This is a simple second-order difference + ! dataPtr_dhdy(n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) + if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. + + slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,J) + if (grid%mask2dCv(i,J+1)==0.) slp_R = 0. + + slp_C = 0.5 * (slp_L + slp_R) + !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R + if ((slp_L * slp_R) > 0.0) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + endif + dataPtr_dhdy(n) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) dataPtr_dhdy(n) = 0.0 + enddo + enddo end subroutine mom_export_cesm @@ -290,33 +268,31 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, integer , intent(inout) :: rc ! Local Variables - integer :: i, j, i1, j1, ig, jg ! Grid indices - integer :: isc, iec, jsc, jec ! Grid indices - integer :: i0, j0, is, js, ie, je - integer :: lbnd1, lbnd2 - real(ESMF_KIND_R8), pointer :: dataPtr_p(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_taux(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_tauy(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_sen(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lat(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lwdn(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lwup(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swvdr(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swvdf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swndr(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swndf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_rofl(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_rofi(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_salt(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_rain(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_snow(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lamult(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ustokes(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_vstokes(:,:) + integer :: i, j, n + integer :: isc, iec, jsc, jec integer :: day, secs type(ESMF_time) :: currTime logical :: do_import + real(ESMF_KIND_R8), pointer :: dataPtr_p(:) + real(ESMF_KIND_R8), pointer :: dataPtr_taux(:) + real(ESMF_KIND_R8), pointer :: dataPtr_tauy(:) + real(ESMF_KIND_R8), pointer :: dataPtr_sen(:) + real(ESMF_KIND_R8), pointer :: dataPtr_lat(:) + real(ESMF_KIND_R8), pointer :: dataPtr_evap(:) + real(ESMF_KIND_R8), pointer :: dataPtr_lwdn(:) + real(ESMF_KIND_R8), pointer :: dataPtr_lwup(:) + real(ESMF_KIND_R8), pointer :: dataPtr_swvdr(:) + real(ESMF_KIND_R8), pointer :: dataPtr_swvdf(:) + real(ESMF_KIND_R8), pointer :: dataPtr_swndr(:) + real(ESMF_KIND_R8), pointer :: dataPtr_swndf(:) + real(ESMF_KIND_R8), pointer :: dataPtr_rofl(:) + real(ESMF_KIND_R8), pointer :: dataPtr_rofi(:) + real(ESMF_KIND_R8), pointer :: dataPtr_salt(:) + real(ESMF_KIND_R8), pointer :: dataPtr_rain(:) + real(ESMF_KIND_R8), pointer :: dataPtr_snow(:) + real(ESMF_KIND_R8), pointer :: dataPtr_lamult(:) + real(ESMF_KIND_R8), pointer :: dataPtr_ustokes(:) + real(ESMF_KIND_R8), pointer :: dataPtr_vstokes(:) character(len=*), parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" character(len=*), parameter :: subname = '(mom_import)' !----------------------------------------------------------------------- @@ -409,98 +385,39 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, file=__FILE__)) & return ! bail out - lbnd1 = lbound(dataPtr_p,1) - lbnd2 = lbound(dataPtr_p,2) - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - ! import_cnt is used to skip using the import state at the first count import_cnt = import_cnt + 1 - if ((trim(runtype) == 'initial' .and. import_cnt <= 2)) then - ! This will skip the first time import information is given - do_import = .false. + do_import = .false. ! This will skip the first time import information is given else - do_import = .true. + do_import = .true. end if if (do_import) then - do j = jsc, jec - j1 = j + lbnd2 - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) ! surface pressure - ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(i1,j1) ! zonal surface stress - taux - ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(i1,j1) ! meridional surface stress - tauy - ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) ! liquid precipitation (rain) - ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) ! frozen precipitation (snow) - ice_ocean_boundary%t_flux(i,j) = dataPtr_sen(i1,j1) ! sensible heat flux (W/m2) - ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(i1,j1) ! latent heat flux (W/m^2) - ice_ocean_boundary%q_flux(i,j) = dataPtr_evap(i1,j1) ! specific humidity flux - ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(i1,j1) & - + dataPtr_lwdn(i1,j1) ! longwave radiation, sum up and down (W/m2) - ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) ! visible, direct shortwave (W/m2) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) ! visible, diffuse shortwave (W/m2) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) ! near-IR, direct shortwave (W/m2) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(i1,j1) ! near-IR, diffuse shortwave (W/m2) - ice_ocean_boundary%rofl_flux(i,j) = dataPtr_rofl(i1,j1) ! ice runoff - ice_ocean_boundary%rofi_flux(i,j) = dataPtr_rofi(i1,j1) ! liquid runoff - ice_ocean_boundary%salt_flux(i,j) = -dataPtr_salt(i1,j1) ! salt flux (minus sign needed here -GMM) + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + n = 0 + do j = jsc,jec + do i = isc,iec + n = n + 1 ! Increment position within gindex + ice_ocean_boundary%p(i,j) = dataPtr_p(n) ! surface pressure + ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(n) ! zonal surface stress - taux + ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(n) ! meridional surface stress - tauy + ice_ocean_boundary%lprec(i,j) = dataPtr_rain(n) ! liquid precipitation (rain) + ice_ocean_boundary%fprec(i,j) = dataPtr_snow(n) ! frozen precipitation (snow) + ice_ocean_boundary%t_flux(i,j) = dataPtr_sen(n) ! sensible heat flux (W/m2) + ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(n) ! latent heat flux (W/m^2) + ice_ocean_boundary%q_flux(i,j) = dataPtr_evap(n) ! specific humidity flux + ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(n) & + + dataPtr_lwdn(n) ! longwave radiation, sum up and down (W/m2) + ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(n) ! visible, direct shortwave (W/m2) + ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(n) ! visible, diffuse shortwave (W/m2) + ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(n) ! near-IR, direct shortwave (W/m2) + ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(n) ! near-IR, diffuse shortwave (W/m2) + ice_ocean_boundary%rofl_flux(i,j) = dataPtr_rofl(n) ! ice runoff + ice_ocean_boundary%rofi_flux(i,j) = dataPtr_rofi(n) ! liquid runoff + ice_ocean_boundary%salt_flux(i,j) = -dataPtr_salt(n) ! salt flux (minus sign needed here -GMM) enddo enddo - - ! do j = jsc, jec - ! jg = j + grid%jsc - jsc - ! do i = isc, iec - ! ig = i + grid%jsc - isc - ! ice_ocean_boundary%u_flux(i,j) = & - ! GRID%cos_rot(ig,jg)*dataPtr_taux(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_tauy(i1,j1) - ! ice_ocean_boundary%v_flux(i,j) = & - ! GRID%cos_rot(ig,jg)*dataPtr_tauy(i1,j1) + GRID%sin_rot(ig,jg)*dataPtr_taux(i1,j1) - ! end do - ! end do - - end if - - ! debug output - if (do_import .and. debug .and. is_root_pe()) then - call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) - call ESMF_TimeGet(CurrTime, d=day, s=secs, rc=rc) - - i0 = GRID%isc - isc - j0 = GRID%jsc - jsc - do j = GRID%jsc, GRID%jec - do i = GRID%isc, GRID%iec - write(logunit,F01)'import: day, secs, j, i, u_flux = '& - ,day,secs,j,i,ice_ocean_boundary%u_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, v_flux = '& - ,day,secs,j,i,ice_ocean_boundary%v_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, lprec = '& - ,day,secs,j,i,ice_ocean_boundary%lprec(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, lwrad = '& - ,day,secs,j,i,ice_ocean_boundary%lw_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, q_flux = '& - ,day,secs,j,i,ice_ocean_boundary%q_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, t_flux = '& - ,day,secs,j,i,ice_ocean_boundary%t_flux(i-i0,j-j0) - !write(logunit,F01)'import: day, secs, j, i, latent_flux = '& - ! ,day,secs,j,i,ice_ocean_boundary%latent_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, runoff = '& - ,day,secs,j,i,ice_ocean_boundary%runoff(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, psurf = '& - ,day,secs,j,i,ice_ocean_boundary%p(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, salt_flux = '& - ,day,secs,j,i,ice_ocean_boundary%salt_flux(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dir = '& - ,day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dir(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, sw_flux_vis_dif = '& - ,day,secs,j,i,ice_ocean_boundary%sw_flux_vis_dif(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dir = '& - ,day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i-i0,j-j0) - write(logunit,F01)'import: day, secs, j, i, sw_flux_nir_dif = '& - ,day,secs,j,i,ice_ocean_boundary%sw_flux_nir_dir(i-i0,j-j0) - end do - end do end if end subroutine mom_import_cesm @@ -936,8 +853,36 @@ end subroutine mom_import_nems !=============================================================================== - subroutine State_GetFldPtr(ST, fldname, fldptr, rc) - type(ESMF_State) , intent(in) :: ST + subroutine State_GetFldPtr_1d(State, fldname, fldptr, rc) + type(ESMF_State) , intent(in) :: State + character(len=*) , intent(in) :: fldname + real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:) + integer, optional , intent(out) :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrc + character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' + + call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (present(rc)) rc = lrc + + end subroutine State_GetFldPtr_1d + +!=============================================================================== + + subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc) + type(ESMF_State) , intent(in) :: State character(len=*) , intent(in) :: fldname real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:,:) integer, optional , intent(out) :: rc @@ -947,7 +892,7 @@ subroutine State_GetFldPtr(ST, fldname, fldptr, rc) integer :: lrc character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' - call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) + call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=lrc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -960,6 +905,6 @@ subroutine State_GetFldPtr(ST, fldname, fldptr, rc) if (present(rc)) rc = lrc - end subroutine State_GetFldPtr + end subroutine State_GetFldPtr_2d end module mom_cap_methods From 893254f56074ad8b373c4e56c237bd7b02329248 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 12 Dec 2018 14:35:24 -0700 Subject: [PATCH 0952/1072] removed trailing whitespace --- config_src/nuopc_driver/mom_cap.F90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index dd7da83ebc..efe0c17672 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1364,9 +1364,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) allocate(gindex(lsize)) k = 0 do j = ocean_grid%jsc, ocean_grid%jec - jg = j + ocean_grid%jdg_offset + jg = j + ocean_grid%jdg_offset do i = ocean_grid%isc, ocean_grid%iec - ig = i + ocean_grid%idg_offset + ig = i + ocean_grid%idg_offset k = k + 1 ! Increment position within gindex gindex(k) = ni * (jg - 1) + ig enddo @@ -1393,7 +1393,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (localPet == 0) then write(logunit,*)'mesh file for mom6 domain is ',trim(cvalue) end if - + ! recreate the mesh using the above distGrid EMesh = ESMF_MeshCreate(EMeshTemp, elementDistgrid=Distgrid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1418,9 +1418,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !--------------------------------- ! create a MOM6 grid !--------------------------------- - + ! generate delayout and dist_grid - + allocate(deBlockList(2,2,ntiles)) allocate(petMap(ntiles)) allocate(deLabelList(ntiles)) @@ -1781,13 +1781,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call MOM_RealizeFields(exportState, fldsFrOcn_num, fldsFrOcn, "Ocn export", grid=gridOut, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + end if !--------------------------------- @@ -1801,7 +1801,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & scalar_field_name, scalar_field_count, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1809,7 +1809,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out endif - + !--------------------------------- ! realize fields on grid !--------------------------------- From 83b410deee74a819a74341df2de0837b3ca6171b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 15 Dec 2018 04:38:04 -0500 Subject: [PATCH 0953/1072] Added comments explaining the '~>' notation Added comments explaining the unit scaling for dimensional consistency testing and the '~>' notation. Only comments are changed, and all answers are bitwise identical. --- config_src/coupled_driver/MOM_surface_forcing.F90 | 4 ++++ config_src/ice_solo_driver/user_surface_forcing.F90 | 4 ++++ src/ALE/MOM_ALE.F90 | 4 ++++ src/ALE/MOM_regridding.F90 | 4 ++++ src/core/MOM.F90 | 4 ++++ src/core/MOM_PressureForce_Montgomery.F90 | 4 ++++ src/core/MOM_PressureForce_analytic_FV.F90 | 4 ++++ src/core/MOM_PressureForce_blocked_AFV.F90 | 4 ++++ src/core/MOM_barotropic.F90 | 4 ++++ src/core/MOM_forcing_type.F90 | 4 ++++ src/core/MOM_grid.F90 | 4 ++++ src/core/MOM_isopycnal_slopes.F90 | 4 ++++ src/core/MOM_variables.F90 | 4 ++++ src/core/MOM_verticalGrid.F90 | 4 ++++ src/diagnostics/MOM_diag_to_Z.F90 | 4 ++++ src/diagnostics/MOM_diagnostics.F90 | 4 ++++ src/diagnostics/MOM_sum_output.F90 | 4 ++++ src/diagnostics/MOM_wave_speed.F90 | 4 ++++ src/diagnostics/MOM_wave_structure.F90 | 4 ++++ src/equation_of_state/MOM_EOS.F90 | 4 ++++ src/equation_of_state/MOM_EOS_Wright.F90 | 4 ++++ src/equation_of_state/MOM_EOS_linear.F90 | 4 ++++ src/framework/MOM_dyn_horgrid.F90 | 4 ++++ src/ice_shelf/MOM_ice_shelf.F90 | 4 ++++ src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 4 ++++ src/ice_shelf/MOM_ice_shelf_initialize.F90 | 4 ++++ src/ice_shelf/user_shelf_init.F90 | 4 ++++ src/initialization/MOM_coord_initialization.F90 | 4 ++++ src/initialization/MOM_grid_initialize.F90 | 4 ++++ src/initialization/MOM_shared_initialization.F90 | 4 ++++ src/initialization/MOM_state_initialization.F90 | 4 ++++ src/initialization/MOM_tracer_initialization_from_Z.F90 | 4 ++++ src/initialization/midas_vertmap.F90 | 4 ++++ src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 | 4 ++++ src/parameterizations/lateral/MOM_thickness_diffuse.F90 | 6 +++++- src/parameterizations/vertical/MOM_ALE_sponge.F90 | 4 ++++ src/parameterizations/vertical/MOM_CVMix_shear.F90 | 4 ++++ src/parameterizations/vertical/MOM_bkgnd_mixing.F90 | 4 ++++ src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 | 4 ++++ src/parameterizations/vertical/MOM_diabatic_aux.F90 | 4 ++++ src/parameterizations/vertical/MOM_diabatic_driver.F90 | 4 ++++ src/parameterizations/vertical/MOM_diapyc_energy_req.F90 | 4 ++++ src/parameterizations/vertical/MOM_energetic_PBL.F90 | 4 ++++ src/parameterizations/vertical/MOM_entrain_diffusive.F90 | 4 ++++ src/parameterizations/vertical/MOM_internal_tide_input.F90 | 4 ++++ src/parameterizations/vertical/MOM_kappa_shear.F90 | 4 ++++ src/parameterizations/vertical/MOM_set_diffusivity.F90 | 4 ++++ src/parameterizations/vertical/MOM_set_viscosity.F90 | 4 ++++ src/parameterizations/vertical/MOM_sponge.F90 | 4 ++++ src/parameterizations/vertical/MOM_tidal_mixing.F90 | 4 ++++ src/parameterizations/vertical/MOM_vert_friction.F90 | 4 ++++ src/tracer/DOME_tracer.F90 | 4 ++++ src/tracer/MOM_tracer_Z_init.F90 | 4 ++++ src/tracer/dye_example.F90 | 3 +++ src/user/BFB_initialization.F90 | 4 ++++ src/user/DOME2d_initialization.F90 | 4 ++++ src/user/DOME_initialization.F90 | 4 ++++ src/user/ISOMIP_initialization.F90 | 4 ++++ src/user/Kelvin_initialization.F90 | 4 ++++ src/user/MOM_wave_interface.F90 | 7 ++++--- src/user/Neverland_initialization.F90 | 4 ++++ src/user/Phillips_initialization.F90 | 4 ++++ src/user/SCM_CVMix_tests.F90 | 5 +++++ src/user/adjustment_initialization.F90 | 4 ++++ src/user/baroclinic_zone_initialization.F90 | 4 ++++ src/user/benchmark_initialization.F90 | 4 ++++ src/user/circle_obcs_initialization.F90 | 4 ++++ src/user/dumbbell_initialization.F90 | 4 ++++ src/user/external_gwave_initialization.F90 | 4 ++++ src/user/seamount_initialization.F90 | 4 ++++ src/user/user_change_diffusivity.F90 | 4 ++++ src/user/user_initialization.F90 | 4 ++++ 72 files changed, 289 insertions(+), 4 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index e10d0fb9ca..b7f9418959 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -51,6 +51,10 @@ module MOM_surface_forcing public ice_ocn_bnd_type_chksum public forcing_save_restart +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> surface_forcing_CS is a structure containing pointers to the forcing fields !! which may be used to drive MOM. All fluxes are positive downward. type, public :: surface_forcing_CS ; private diff --git a/config_src/ice_solo_driver/user_surface_forcing.F90 b/config_src/ice_solo_driver/user_surface_forcing.F90 index 06ba823d9c..a8e3669252 100644 --- a/config_src/ice_solo_driver/user_surface_forcing.F90 +++ b/config_src/ice_solo_driver/user_surface_forcing.F90 @@ -62,6 +62,10 @@ module user_surface_forcing public USER_wind_forcing, USER_buoyancy_forcing, USER_surface_forcing_init +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + type, public :: user_surface_forcing_CS ; private ! This control structure should be used to store any run-time variables ! associated with the user-specified forcing. It can be readily modified diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 607753cfac..9efa32b144 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -120,6 +120,10 @@ module MOM_ALE public ALE_remap_init_conds public ALE_register_diags +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + contains !> This routine is typically called (from initialize_MOM in file MOM.F90) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 5da749a8d0..64066a2cea 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -36,6 +36,10 @@ module MOM_regridding #include +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Regridding control structure type, public :: regridding_CS ; private diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 79eed5a912..0c4927abc1 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -136,6 +136,10 @@ module MOM #include +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> A structure with diagnostic IDs of the state variables type MOM_diag_IDs !>@{ 3-d state field diagnostic IDs diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index d2c533a34c..190cb3fc29 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -22,6 +22,10 @@ module MOM_PressureForce_Mont public PressureForce_Mont_Bouss, PressureForce_Mont_nonBouss, Set_pbce_Bouss public Set_pbce_nonBouss, PressureForce_Mont_init, PressureForce_Mont_end +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Control structure for the Montgomery potential form of pressure gradient type, public :: PressureForce_Mont_CS ; private logical :: tides !< If true, apply tidal momentum forcing. diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index e49f77d054..058051ff53 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -27,6 +27,10 @@ module MOM_PressureForce_AFV public PressureForce_AFV, PressureForce_AFV_init, PressureForce_AFV_end public PressureForce_AFV_Bouss, PressureForce_AFV_nonBouss +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Finite volume pressure gradient control structure type, public :: PressureForce_AFV_CS ; private logical :: tides !< If true, apply tidal momentum forcing. diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index affaa40012..4dc8c54e97 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -27,6 +27,10 @@ module MOM_PressureForce_blk_AFV public PressureForce_blk_AFV, PressureForce_blk_AFV_init, PressureForce_blk_AFV_end public PressureForce_blk_AFV_Bouss, PressureForce_blk_AFV_nonBouss +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Finite volume pressure gradient control structure type, public :: PressureForce_blk_AFV_CS ; private logical :: tides !< If true, apply tidal momentum forcing. diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 9a652e23a3..fb08e18ea8 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -58,6 +58,10 @@ module MOM_barotropic public btcalc, bt_mass_source, btstep, barotropic_init, barotropic_end public register_barotropic_restarts, set_dtbt +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> The barotropic stepping open boundary condition type type, private :: BT_OBC_type real, dimension(:,:), pointer :: Cg_u => NULL() !< The external wave speed at u-points, in m s-1. diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index ac72bafe32..d5a1bd23a6 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -35,6 +35,10 @@ module MOM_forcing_type public set_derived_forcing_fields, copy_back_forcing_fields public set_net_mass_forcing, get_net_mass_forcing +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Structure that contains pointers to the boundary forcing used to drive the !! liquid ocean simulated by MOM. !! diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 11fe7813cd..ac7bcd2180 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -16,6 +16,10 @@ module MOM_grid public MOM_grid_init, MOM_grid_end, set_derived_metrics, set_first_direction public isPointInCell, hor_index_type, get_global_grid_size, rescale_grid_bathymetry +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Ocean grid type. See mom_grid for details. type, public :: ocean_grid_type type(MOM_domain_type), pointer :: Domain => NULL() !< Ocean model domain diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 2c394c8ddc..df6b8ff655 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -15,6 +15,10 @@ module MOM_isopycnal_slopes public calc_isoneutral_slopes +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + contains !> Calculate isopycnal slopes, and optionally return N2 used in calculation. diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 246b5f764e..a5276f6e84 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -19,6 +19,10 @@ module MOM_variables public allocate_surface_state, deallocate_surface_state, MOM_thermovar_chksum public ocean_grid_type, alloc_BT_cont_type, dealloc_BT_cont_type +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> A structure for creating arrays of pointers to 3D arrays type, public :: p3d real, dimension(:,:,:), pointer :: p => NULL() !< A pointer to a 3D array diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 3d5d6db936..ab0f645a28 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -15,6 +15,10 @@ module MOM_verticalGrid public setVerticalGridAxes, fix_restart_scaling public get_flux_units, get_thickness_units, get_tr_flux_units +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Describes the vertical ocean grid, including unit conversion factors type, public :: verticalGrid_type diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index d02f4f5fbb..14d7ce36f8 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -38,6 +38,10 @@ module MOM_diag_to_Z public register_Zint_diag public calc_Zint_diags +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> The control structure for the MOM_diag_to_Z module type, public :: diag_to_Z_CS ; private ! The following arrays are used to store diagnostics calculated in this diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index d1dd451616..2a66dddea6 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -42,6 +42,10 @@ module MOM_diagnostics public register_transport_diags, post_transport_diagnostics public MOM_diagnostics_init, MOM_diagnostics_end +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> The control structure for the MOM_diagnostics module type, public :: diagnostics_CS ; private real :: mono_N2_column_fraction = 0. !< The lower fraction of water column over which N2 is limited as diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 2f526fc98e..30694ce4ff 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -33,6 +33,10 @@ module MOM_sum_output public write_energy, accumulate_net_input, MOM_sum_output_init +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + integer, parameter :: NUM_FIELDS = 17 !< Number of diagnostic fields !> A list of depths and corresponding globally integrated ocean area at each diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 2681314b36..6f58622a80 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -19,6 +19,10 @@ module MOM_wave_speed public wave_speed, wave_speeds, wave_speed_init, wave_speed_set_param +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Control structure for MOM_wave_speed type, public :: wave_speed_CS ; private logical :: use_ebt_mode = .false. !< If true, calculate the equivalent barotropic wave speed instead diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index fbec51196c..3a6932ae12 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -27,6 +27,10 @@ module MOM_wave_structure public wave_structure, wave_structure_init +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> The control structure for the MOM_wave_structure module type, public :: wave_structure_CS ; !private type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 3cd23a9b04..a7b7d92ab6 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -51,6 +51,10 @@ module MOM_EOS public gsw_sp_from_sr, gsw_pt_from_ct public extract_member_EOS +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Calculates density of sea water from T, S and P interface calculate_density module procedure calculate_density_scalar, calculate_density_array diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index 51ffe4b9f0..fc541986f3 100644 --- a/src/equation_of_state/MOM_EOS_Wright.F90 +++ b/src/equation_of_state/MOM_EOS_Wright.F90 @@ -20,6 +20,10 @@ module MOM_EOS_Wright public calculate_density_second_derivs_wright public int_density_dz_wright, int_spec_vol_dp_wright +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Compute the in situ density of sea water (in units of kg/m^3), or its anomaly with respect to !! a reference density, from salinity (in psu), potential temperature (in deg C), and pressure in Pa, diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90 index af961f4c43..83219d5adb 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -16,6 +16,10 @@ module MOM_EOS_linear public calculate_density_second_derivs_linear public int_density_dz_linear, int_spec_vol_dp_linear +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Compute the density of sea water (in kg/m^3), or its anomaly from a reference density, !! using a simple linear equation of state from salinity (in psu), potential temperature (in deg C) !! and pressure in Pa. diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 754af0cb8f..4fb0400b50 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -13,6 +13,10 @@ module MOM_dyn_horgrid public create_dyn_horgrid, destroy_dyn_horgrid, set_derived_dyn_horgrid public rescale_dyn_horgrid_bathymetry +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Describes the horizontal ocean grid with only dynamic memory arrays type, public :: dyn_horgrid_type type(MOM_domain_type), pointer :: Domain => NULL() !< Ocean model domain diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 995192830e..55b062ae42 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -62,6 +62,10 @@ module MOM_ice_shelf public shelf_calc_flux, add_shelf_flux, initialize_ice_shelf, ice_shelf_end public ice_shelf_save_restart, solo_time_step, add_shelf_forces +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Control structure that contains ice shelf parameters and diagnostics handles type, public :: ice_shelf_CS ; private ! Parameters diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 90ab481722..9633f23ed9 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -32,6 +32,10 @@ module MOM_ice_shelf_dynamics public ice_time_step_CFL, ice_shelf_dyn_end public shelf_advance_front, ice_shelf_min_thickness_calve, calve_to_mask +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> The control structure for the ice shelf dynamics. type, public :: ice_shelf_dyn_CS ; private real, pointer, dimension(:,:) :: u_shelf => NULL() !< the zonal (?) velocity of the ice shelf/sheet, diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index f39d58cd17..22f86d5887 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -17,6 +17,10 @@ module MOM_ice_shelf_initialize !MJHpublic initialize_ice_shelf_boundary, initialize_ice_thickness public initialize_ice_thickness +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + contains !> Initialize ice shelf thickness diff --git a/src/ice_shelf/user_shelf_init.F90 b/src/ice_shelf/user_shelf_init.F90 index 77cc175634..1afc7e2248 100644 --- a/src/ice_shelf/user_shelf_init.F90 +++ b/src/ice_shelf/user_shelf_init.F90 @@ -20,6 +20,10 @@ module user_shelf_init public USER_initialize_shelf_mass, USER_update_shelf_mass public USER_init_ice_thickness +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> The control structure for the user_ice_shelf module type, public :: user_ice_shelf_CS ; private real :: Rho_ocean !< The ocean's typical density, in kg m-2 Z-1. diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index a649cf222e..5dfa608cd9 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -25,6 +25,10 @@ module MOM_coord_initialization public MOM_initialize_coord +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + character(len=40) :: mdl = "MOM_coord_initialization" !< This module's name. contains diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 7136965b2d..b95c476b45 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -24,6 +24,10 @@ module MOM_grid_initialize public set_grid_metrics, initialize_masks, Adcroft_reciprocal +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Global positioning system (aka container for information to describe the grid) type, public :: GPS ; private real :: len_lon !< The longitudinal or x-direction length of the domain. diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 3681e86dd1..f86cd780c1 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -30,6 +30,10 @@ module MOM_shared_initialization public read_face_length_list, set_velocity_depth_max, set_velocity_depth_min public compute_global_grid_integrals, write_ocean_geometry_file +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + contains ! ----------------------------------------------------------------------------- diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index a4b49395ad..4d5ecf4caa 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -106,6 +106,10 @@ module MOM_state_initialization public MOM_initialize_state +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + character(len=40) :: mdl = "MOM_state_initialization" !< This module's name. contains diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 9c04b8ca39..07977eaa1c 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -33,6 +33,10 @@ module MOM_tracer_initialization_from_Z public :: MOM_initialize_tracer_from_Z +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + character(len=40) :: mdl = "MOM_tracer_initialization_from_Z" !< This module's name. contains diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index b7d1b43152..2db8e2d2c9 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -13,6 +13,10 @@ module MIDAS_vertmap public find_interfaces, meshgrid #endif +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Fill grid edges interface fill_boundaries module procedure fill_boundaries_real diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 2754ad06c0..3d0967c6bb 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -29,6 +29,10 @@ module MOM_mixed_layer_restrat public mixedlayer_restrat_init public mixedlayer_restrat_register_restarts +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Control structure for mom_mixed_layer_restrat type, public :: mixedlayer_restrat_CS ; private real :: ml_restrat_coef !< A non-dimensional factor by which the diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 9a7d7078df..c71727619f 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -20,10 +20,14 @@ module MOM_thickness_diffuse implicit none ; private +#include + public thickness_diffuse, thickness_diffuse_init, thickness_diffuse_end public vert_fill_TS -#include +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." !> Control structure for thickness diffusion type, public :: thickness_diffuse_CS ; private diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 8fe7267953..78a1f44fab 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -56,6 +56,10 @@ module MOM_ALE_sponge public get_ALE_sponge_thicknesses, get_ALE_sponge_nz_data public initialize_ALE_sponge, apply_ALE_sponge, ALE_sponge_end, init_ALE_sponge_diags +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> A structure for creating arrays of pointers to 3D arrays with extra gridding information type :: p3d integer :: id !< id for FMS external time interpolator diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index f53b8a6934..88997d5f3f 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -22,6 +22,10 @@ module MOM_CVMix_shear public calculate_CVMix_shear, CVMix_shear_init, CVMix_shear_is_used, CVMix_shear_end +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Control structure including parameters for CVMix interior shear schemes. type, public :: CVMix_shear_cs ! TODO: private logical :: use_LMD94 !< Flags to use the LMD94 scheme diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index e1e86b9e1a..e9899c2251 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -29,6 +29,10 @@ module MOM_bkgnd_mixing public calculate_bkgnd_mixing public sfc_bkgnd_mixing +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Control structure including parameters for this module. type, public :: bkgnd_mixing_cs ! TODO: private diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 858ad04189..29117e5fe9 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -23,6 +23,10 @@ module MOM_bulk_mixed_layer public bulkmixedlayer, bulkmixedlayer_init +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> The control structure with parameters for the MOM_bulk_mixed_layer module type, public :: bulkmixedlayer_CS ; private integer :: nkml !< The number of layers in the mixed layer. diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 0e7363e2aa..ea5a6781a8 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -28,6 +28,10 @@ module MOM_diabatic_aux public make_frazil, adjust_salt, insert_brine, differential_diffuse_T_S, triDiagTS public find_uv_at_h, diagnoseMLDbyDensityDifference, applyBoundaryFluxesInOut +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Control structure for diabatic_aux type, public :: diabatic_aux_CS ; private logical :: do_rivermix = .false. !< Provide additional TKE to mix river runoff at the diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 644cff264a..460b615173 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -85,6 +85,10 @@ module MOM_diabatic_driver public adiabatic_driver_init public legacy_diabatic +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Control structure for this module type, public:: diabatic_CS; private logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 85bcd08e88..686f8b5fef 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -18,6 +18,10 @@ module MOM_diapyc_energy_req public diapyc_energy_req_init, diapyc_energy_req_calc, diapyc_energy_req_test, diapyc_energy_req_end +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> This control structure holds parameters for the MOM_diapyc_energy_req module type, public :: diapyc_energy_req_CS ; private logical :: initialized = .false. !< A variable that is here because empty diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 88ef1c9a18..2578ea6a9e 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -25,6 +25,10 @@ module MOM_energetic_PBL public energetic_PBL, energetic_PBL_init, energetic_PBL_end public energetic_PBL_get_MLD +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> This control structure holds parameters for the MOM_energetic_PBL module type, public :: energetic_PBL_CS ; private real :: mstar !< The ratio of the friction velocity cubed to the TKE available to diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index dd00a28f85..1e01e1acdd 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -20,6 +20,10 @@ module MOM_entrain_diffusive public entrainment_diffusive, entrain_diffusive_init, entrain_diffusive_end +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> The control structure holding parametes for the MOM_entrain_diffusive module type, public :: entrain_diffusive_CS ; private logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index d0e31f1a1b..cf81c65fea 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -26,6 +26,10 @@ module MOM_int_tide_input public set_int_tide_input, int_tide_input_init, int_tide_input_end +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> This control structure holds parameters that regulate internal tide energy inputs. type, public :: int_tide_input_CS ; private logical :: debug !< If true, write verbose checksums for debugging. diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 9af56ebe67..fea80e97ee 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -26,6 +26,10 @@ module MOM_kappa_shear public Calculate_kappa_shear, Calc_kappa_shear_vertex, kappa_shear_init public kappa_shear_is_used, kappa_shear_at_vertex +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> This control structure holds the parameters that regulate shear mixing type, public :: Kappa_shear_CS ; private real :: RiNo_crit !< The critical shear Richardson number for diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 031b47ed5f..208779055c 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -47,6 +47,10 @@ module MOM_set_diffusivity public set_diffusivity_init public set_diffusivity_end +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> This control structure contains parameters for MOM_set_diffusivity. type, public :: set_diffusivity_CS ; private logical :: debug !< If true, write verbose checksums for debugging. diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 2d53db68de..56a356180f 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -34,6 +34,10 @@ module MOM_set_visc public set_viscous_BBL, set_viscous_ML, set_visc_init, set_visc_end public set_visc_register_restarts +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Control structure for MOM_set_visc type, public :: set_visc_CS ; private real :: Hbbl !< The static bottom boundary layer thickness, in diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index c656f6f1a5..bdd230d4fe 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -22,6 +22,10 @@ module MOM_sponge public set_up_sponge_field, set_up_sponge_ML_density public initialize_sponge, apply_sponge, sponge_end, init_sponge_diags +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> A structure for creating arrays of pointers to 3D arrays type, public :: p3d real, dimension(:,:,:), pointer :: p => NULL() !< A pointer to a 3D array diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index f995cf0739..7b075a6cef 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -36,6 +36,10 @@ module MOM_tidal_mixing public post_tidal_diagnostics public tidal_mixing_end +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Containers for tidal mixing diagnostics type, public :: tidal_mixing_diags ; private real, pointer, dimension(:,:,:) :: & diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index d956df2f59..77e336b71e 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -30,6 +30,10 @@ module MOM_vert_friction public vertvisc_limit_vel, vertvisc_init, vertvisc_end public updateCFLtruncationValue +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> The control structure with parameters and memory for the MOM_vert_friction module type, public :: vertvisc_CS ; private real :: Hmix !< The mixed layer thickness in thickness units (H). diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 6278561a3d..6a1155310e 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -32,6 +32,10 @@ module DOME_tracer public register_DOME_tracer, initialize_DOME_tracer public DOME_tracer_column_physics, DOME_tracer_surface_state, DOME_tracer_end +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + integer, parameter :: ntr = 11 !< The number of tracers in this module. !> The DOME_tracer control structure diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index b065915312..66f261ed8d 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -18,6 +18,10 @@ module MOM_tracer_Z_init public tracer_Z_init +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + contains !> This function initializes a tracer by reading a Z-space file, returning diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 348e2a822f..7f33034830 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -33,6 +33,9 @@ module regional_dyes public dye_tracer_column_physics, dye_tracer_surface_state public dye_stock, regional_dyes_end +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." !> The control structure for the regional dyes tracer package type, public :: dye_tracer_CS ; private diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index abf0d9fe53..78cb7fe163 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -20,6 +20,10 @@ module BFB_initialization public BFB_set_coord public BFB_initialize_sponges_southonly +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Unsafe model variable !! \todo Remove this module variable logical :: first_call = .true. diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index af1666fabd..14431314da 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -28,6 +28,10 @@ module DOME2d_initialization public DOME2d_initialize_temperature_salinity public DOME2d_initialize_sponges +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + character(len=40) :: mdl = "DOME2D_initialization" !< This module's name. contains diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 80fac3a4f0..10027759ba 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -28,6 +28,10 @@ module DOME_initialization public DOME_initialize_sponges public DOME_set_OBC_data +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + contains ! ----------------------------------------------------------------------------- diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index d8f1ab0935..eeaf5c9997 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -33,6 +33,10 @@ module ISOMIP_initialization public ISOMIP_initialize_temperature_salinity public ISOMIP_initialize_sponges +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + contains !> Initialization of topography for the ISOMIP configuration diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 33ce7d383a..fc6c1d5d62 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -27,6 +27,10 @@ module Kelvin_initialization public Kelvin_set_OBC_data, Kelvin_initialize_topography public register_Kelvin_OBC, Kelvin_OBC_end +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Control structure for Kelvin wave open boundaries. type, public :: Kelvin_OBC_CS ; private integer :: mode = 0 !< Vertical mode diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 9a98d55b21..725c8af156 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -17,9 +17,7 @@ module MOM_wave_interface use MOM_verticalgrid, only : verticalGrid_type use data_override_mod, only : data_override_init, data_override -implicit none - -private +implicit none ; private #include @@ -40,6 +38,9 @@ module MOM_wave_interface ! CL2 effects. public Waves_end ! public interface to deallocate and free wave related memory. +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." !> Container for all surface wave related parameters type, public :: wave_parameters_CS ; private diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index cd3fc19c32..4f628c0ea6 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -24,6 +24,10 @@ module Neverland_initialization public Neverland_initialize_topography public Neverland_initialize_thickness +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + contains !> This subroutine sets up the Neverland test case topography. diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index d8bad8bd4d..8b99fc972e 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -24,6 +24,10 @@ module Phillips_initialization public Phillips_initialize_sponges public Phillips_initialize_topography +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + ! This include declares and sets the variable "version". #include "version_variable.h" diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index 960bed6a1f..81c8aa2051 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -14,6 +14,7 @@ module SCM_CVMix_tests use MOM_time_manager, only : time_type, operator(+), operator(/), time_type_to_real use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, surface + implicit none ; private #include @@ -24,6 +25,10 @@ module SCM_CVMix_tests public SCM_CVMix_tests_buoyancy_forcing public SCM_CVMix_tests_CS +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Container for surface forcing parameters type SCM_CVMix_tests_CS private diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index 8ba8916538..2766e01a21 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -24,6 +24,10 @@ module adjustment_initialization public adjustment_initialize_thickness public adjustment_initialize_temperature_salinity +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + contains !> Initializes the layer thicknesses in the adjustment test case diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index 6c1f4d653b..ba9e02f10d 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -19,6 +19,10 @@ module baroclinic_zone_initialization public baroclinic_zone_init_temperature_salinity +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + contains !> Reads the parameters unique to this module diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index 25d0f6171c..c16bb9a23d 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -23,6 +23,10 @@ module benchmark_initialization public benchmark_initialize_thickness public benchmark_init_temperature_salinity +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + contains !> This subroutine sets up the benchmark test case topography. diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index 6cc6d922eb..c856797612 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -20,6 +20,10 @@ module circle_obcs_initialization public circle_obcs_initialize_thickness +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + contains !> This subroutine initializes layer thicknesses for the circle_obcs experiment. diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 3b6e6e105f..7415bc783a 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -31,6 +31,10 @@ module dumbbell_initialization public dumbbell_initialize_temperature_salinity public dumbbell_initialize_sponges +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + contains !> Initialization of topography. diff --git a/src/user/external_gwave_initialization.F90 b/src/user/external_gwave_initialization.F90 index 552733861f..adb9c620df 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -17,6 +17,10 @@ module external_gwave_initialization public external_gwave_initialize_thickness +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + contains !> This subroutine initializes layer thicknesses for the external_gwave experiment. diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 2172fa5efb..1f5070df47 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -30,6 +30,10 @@ module seamount_initialization public seamount_initialize_thickness public seamount_initialize_temperature_salinity +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + contains !> Initialization of topography. diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index 34157e8e49..19bcb44615 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -18,6 +18,10 @@ module user_change_diffusivity public user_change_diff, user_change_diff_init, user_change_diff_end +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> Control structure for user_change_diffusivity type, public :: user_change_diff_CS ; private real :: Kd_add !< The scale of a diffusivity that is added everywhere diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index a6a36d5dd6..c34bb8c1c1 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -25,6 +25,10 @@ module user_initialization public USER_initialize_velocity, USER_init_temperature_salinity public USER_initialize_sponges, USER_set_OBC_data, USER_set_rotation +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." + !> A module variable that should not be used. !! \todo Move this module variable into a control structure. logical :: first_call = .true. From 02b4ae541ea57b08a8e580448ec0cb91adbe297a Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 16 Dec 2018 18:46:40 -0700 Subject: [PATCH 0954/1072] changes for adding in fv3 --- config_src/nuopc_driver/mom_cap.F90 | 7 +- config_src/nuopc_driver/mom_cap_methods.F90 | 89 ++++++++++++++++++--- 2 files changed, 82 insertions(+), 14 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index efe0c17672..383cf09758 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1026,7 +1026,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) endif call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr", "will provide") ! -> mean_net_sw_ir_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr", "will provide") ! -> mean_net_sw_vis_dir_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf", "will provide") ! -> mean_net_sw_ir_dir_flx @@ -1035,12 +1034,16 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") ! -> mean latent heat flux - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") ! -> mean long wave up call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface + ! when coupled to cam + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") ! -> mean long wave up + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") ! -> mean long wave down + ! when coupled to fv3 + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx", "will_provide") ! EMC fields not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index ac85e73491..753cd9e011 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -12,6 +12,8 @@ module mom_cap_methods use ESMF, only: ESMF_KIND_R8, ESMF_SUCCESS, ESMF_LogFoundError use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO, ESMF_LOGWRITE use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE + use ESMF, only: ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND + use ESMF, only: operator(/=), operator(==) use MOM_ocean_model, only: ocean_public_type, ocean_state_type, ocean_model_data_get use MOM_surface_forcing, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type @@ -258,6 +260,7 @@ end subroutine mom_export_cesm subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, & logunit, runtype, clock, rc) + ! Input/output variables type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid type(ESMF_State) , intent(inout) :: importState !< incoming data @@ -268,11 +271,19 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, integer , intent(inout) :: rc ! Local Variables + type(ESMF_StateItem_Flag) :: itemFlag integer :: i, j, n integer :: isc, iec, jsc, jec + integer :: lsize integer :: day, secs type(ESMF_time) :: currTime logical :: do_import + ! import fields that are different for cam and fv3 + logical :: isPresent_lwup + logical :: isPresent_lwdn + logical :: isPresent_lwnet + logical :: isPresent_evap + ! from atm real(ESMF_KIND_R8), pointer :: dataPtr_p(:) real(ESMF_KIND_R8), pointer :: dataPtr_taux(:) real(ESMF_KIND_R8), pointer :: dataPtr_tauy(:) @@ -281,20 +292,25 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, real(ESMF_KIND_R8), pointer :: dataPtr_evap(:) real(ESMF_KIND_R8), pointer :: dataPtr_lwdn(:) real(ESMF_KIND_R8), pointer :: dataPtr_lwup(:) + real(ESMF_KIND_R8), pointer :: dataPtr_lwnet(:) + real(ESMF_KIND_R8), pointer :: dataPtr_rain(:) + real(ESMF_KIND_R8), pointer :: dataPtr_snow(:) real(ESMF_KIND_R8), pointer :: dataPtr_swvdr(:) real(ESMF_KIND_R8), pointer :: dataPtr_swvdf(:) real(ESMF_KIND_R8), pointer :: dataPtr_swndr(:) real(ESMF_KIND_R8), pointer :: dataPtr_swndf(:) + ! from river real(ESMF_KIND_R8), pointer :: dataPtr_rofl(:) real(ESMF_KIND_R8), pointer :: dataPtr_rofi(:) real(ESMF_KIND_R8), pointer :: dataPtr_salt(:) - real(ESMF_KIND_R8), pointer :: dataPtr_rain(:) - real(ESMF_KIND_R8), pointer :: dataPtr_snow(:) + ! from wave real(ESMF_KIND_R8), pointer :: dataPtr_lamult(:) real(ESMF_KIND_R8), pointer :: dataPtr_ustokes(:) real(ESMF_KIND_R8), pointer :: dataPtr_vstokes(:) - character(len=*), parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" - character(len=*), parameter :: subname = '(mom_import)' + ! + real(ESMF_KIND_R8), parameter :: const_lhvap = 2.501e6_ESMF_KIND_R8 ! latent heat of evaporation ~ J/kg + character(len=*) , parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" + character(len=*) , parameter :: subname = '(mom_import)' !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -349,43 +365,88 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Faxa_lwdn" , dataPtr_lwdn, rc=rc) + call State_getFldPtr(importState,"Foxx_rofl" , dataPtr_rofl, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Foxx_lwup" , dataPtr_lwup, rc=rc) + call State_getFldPtr(importState,"Foxx_rofi" , dataPtr_rofi, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Foxx_rofl" , dataPtr_rofl, rc=rc) + call State_getFldPtr(importState,"Fioi_salt" , dataPtr_salt, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Foxx_rofi" , dataPtr_rofi, rc=rc) + call State_getFldPtr(importState,"Faxa_rain" , dataPtr_rain, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Fioi_salt" , dataPtr_salt, rc=rc) + call State_getFldPtr(importState,"Faxa_snow" , dataPtr_snow, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Faxa_rain" , dataPtr_rain, rc=rc) + + ! ------- + ! Different treatment of long wave dependent on if cam, datm or fv3 + ! ------- + ! When running with cam or datm - need Foxx_lwup and Faxa_lwdn + ! When running with fv3 - need mean_net_lw_flx + + call ESMF_StateGet(importState, 'Foxx_lwup', itemFlag, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Faxa_snow" , dataPtr_snow, rc=rc) + if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + isPresent_lwup = .true. + call State_getFldPtr(importState,"Foxx_lwup", dataPtr_lwup, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else + isPresent_lwup = .false. + end if + call ESMF_StateGet(importState, 'Faxa_lwdn', itemFlag, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + isPresent_lwdn = .true. + call State_getFldPtr(importState, "Faxa_lwdn", dataPtr_lwdn, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else + isPresent_lwdn = .false. + end if + call ESMF_StateGet(importState, "mean_net_lw_flx", itemFlag, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + isPresent_lwnet = .true. + call State_getFldPtr(importState,"mean_net_lw_flx" , dataPtr_lwnet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else + isPresent_lwnet = .false. + end if + ! ------- ! import_cnt is used to skip using the import state at the first count + ! ------- + import_cnt = import_cnt + 1 if ((trim(runtype) == 'initial' .and. import_cnt <= 2)) then do_import = .false. ! This will skip the first time import information is given @@ -407,8 +468,12 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, ice_ocean_boundary%t_flux(i,j) = dataPtr_sen(n) ! sensible heat flux (W/m2) ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(n) ! latent heat flux (W/m^2) ice_ocean_boundary%q_flux(i,j) = dataPtr_evap(n) ! specific humidity flux - ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(n) & + if (isPresent_lwup .and. isPresent_lwdn) then + ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(n) & + dataPtr_lwdn(n) ! longwave radiation, sum up and down (W/m2) + else if (isPresent_lwnet) then + ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwnet(n) ! net longwave radiation, sum up and down (W/m2) + end if ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(n) ! visible, direct shortwave (W/m2) ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(n) ! visible, diffuse shortwave (W/m2) ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(n) ! near-IR, direct shortwave (W/m2) From c7206589f9f1ec197d2f01145bef30d3ae8d44f7 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 16 Dec 2018 22:40:35 -0700 Subject: [PATCH 0955/1072] first step in putting in correct fields for swnet to ocean --- config_src/nuopc_driver/mom_cap.F90 | 34 ++++++++++++--------- config_src/nuopc_driver/mom_cap_methods.F90 | 26 +++++++++++++++- 2 files changed, 44 insertions(+), 16 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 383cf09758..ab05add936 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1024,21 +1024,25 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (len_trim(scalar_field_name) > 0) then call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") ! not in EMC endif - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr", "will provide") ! -> mean_net_sw_ir_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr", "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf", "will provide") ! -> mean_net_sw_ir_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf", "will provide") ! -> mean_net_sw_vis_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") ! -> mean latent heat flux - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! incorrect - remove + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! incorrect - remove + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! incorrect - remove + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! incorrect - remove + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide") ! -> mean_net_sw_ir_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide") ! -> mean_net_sw_vis_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide") ! -> mean_net_sw_vis_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") ! -> mean latent heat flux + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface ! when coupled to cam call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") ! -> mean long wave up call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") ! -> mean long wave down diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 753cd9e011..edb600b535 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -308,7 +308,6 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, real(ESMF_KIND_R8), pointer :: dataPtr_ustokes(:) real(ESMF_KIND_R8), pointer :: dataPtr_vstokes(:) ! - real(ESMF_KIND_R8), parameter :: const_lhvap = 2.501e6_ESMF_KIND_R8 ! latent heat of evaporation ~ J/kg character(len=*) , parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" character(len=*) , parameter :: subname = '(mom_import)' !----------------------------------------------------------------------- @@ -320,6 +319,8 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, line=__LINE__, & file=__FILE__)) & return ! bail out + + ! TODO: remove these call State_getFldPtr(importState,"Faxa_swndr" , dataPtr_swndr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -340,6 +341,29 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, line=__LINE__, & file=__FILE__)) & return ! bail out + + ! TODO: add these + ! call State_getFldPtr(importState,"mean_net_sw_ir_dir_flx" , dataPtr_swndr, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + ! call State_getFldPtr(importState,"mean_net_sw_ir_dif_flx" , dataPtr_swndf, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + ! call State_getFldPtr(importState,"mean_net_sw_vis_dir_flx" , dataPtr_swvdr, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + ! call State_getFldPtr(importState,"mean_net_sw_vis_dif_flx" , dataPtr_swvdf, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + call State_getFldPtr(importState,"Foxx_taux" , dataPtr_taux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & From f8ee1e69309d7ca9169e5b1c606dc9621966fb91 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 17 Dec 2018 10:14:40 -0500 Subject: [PATCH 0956/1072] Renamed internal variables in EF4 Renamed internal variables in EF4 to avoid the use of single character variables that might be confused with the single-character rescaled units in greps. Also added to comments in MOM_bulkmixedlayer.F90 to clarify the units of variables that scale with H, using notation like 'in H ~> m or kg m-2'. Only comments are changed, and all answers are bitwise identical. --- .../vertical/MOM_bulk_mixed_layer.F90 | 259 +++++++++--------- 1 file changed, 124 insertions(+), 135 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 29117e5fe9..ddd653028e 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -47,9 +47,9 @@ module MOM_bulk_mixed_layer !! the mixed layer is converted to TKE, nondim. real :: bulk_Ri_convective !< The efficiency with which convectively !! released mean kinetic energy becomes TKE, nondim. - real :: Hmix_min !< The minimum mixed layer thickness in H. + real :: Hmix_min !< The minimum mixed layer thickness in H ~> m or kg m-2. real :: H_limit_fluxes !< When the total ocean depth is less than this - !! value, in H, scale away all surface forcing to + !! value, in H ~> m or kg m-2, scale away all surface forcing to !! avoid boiling the ocean. real :: ustar_min !< A minimum value of ustar to avoid numerical problems, !! in Z s-1 ~> m s-1. If the value is small enough, this should @@ -112,7 +112,7 @@ module MOM_bulk_mixed_layer ! These are terms in the mixed layer TKE budget, all in Z m2 s-3 ~> m3 s-3. real, allocatable, dimension(:,:) :: & - ML_depth, & !< The mixed layer depth in H. + ML_depth, & !< The mixed layer depth in H ~> m or kg m-2. diag_TKE_wind, & !< The wind source of TKE. diag_TKE_RiBulk, & !< The resolved KE source of TKE. diag_TKE_conv, & !< The convective source of TKE. @@ -234,7 +234,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! new, sorted index space. Here layer 0 is an initially massless layer that ! will be used to hold the new mixed layer properties. real, dimension(SZI_(G),SZK0_(GV)) :: & - h, & ! The layer thickness, in H (often m or kg m-2). + h, & ! The layer thickness, in H ~> m or kg m-2. T, & ! The layer temperatures, in deg C. S, & ! The layer salinities, in psu. R0, & ! The potential density referenced to the surface, in kg m-3. @@ -242,14 +242,14 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C real, dimension(SZI_(G),SZK_(GV)) :: & u, & ! The zonal velocity, in m s-1. v, & ! The meridional velocity, in m s-1. - h_orig, & ! The original thickness in H (often m or kg m-2). + h_orig, & ! The original thickness in H ~> m or kg m-2. d_eb, & ! The downward increase across a layer in the entrainment from - ! below, in H. The sign convention is that positive values of + ! below, in H ~> m or kg m-2. The sign convention is that positive values of ! d_eb correspond to a gain in mass by a layer by upward motion. d_ea, & ! The upward increase across a layer in the entrainment from - ! above, in H. The sign convention is that positive values of + ! above, in H ~> m or kg m-2. The sign convention is that positive values of ! d_ea mean a net gain in mass by a layer from downward motion. - eps ! The (small) thickness that must remain in a layer, in H. + eps ! The (small) thickness that must remain in a layer, in H ~> m or kg m-2. integer, dimension(SZI_(G),SZK_(GV)) :: & ksort ! The sorted k-index that each original layer goes to. real, dimension(SZI_(G),SZJ_(G)) :: & @@ -260,27 +260,27 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C Conv_En, & ! The turbulent kinetic energy source due to mixing down to ! the depth of free convection, in Z m2 s-2 ~> m3 s-2. htot, & ! The total depth of the layers being considered for - ! entrainment, in H. + ! entrainment, in H ~> m or kg m-2. R0_tot, & ! The integrated potential density referenced to the surface - ! of the layers which are fully entrained, in H kg m-3. + ! of the layers which are fully entrained, in H kg m-3 ~> kg m-2 or kg2 m-5. Rcv_tot, & ! The integrated coordinate value potential density of the - ! layers that are fully entrained, in H kg m-3. + ! layers that are fully entrained, in H kg m-3 ~> kg m-2 or kg2 m-5. Ttot, & ! The integrated temperature of layers which are fully - ! entrained, in H K. + ! entrained, in H K ~> m K or kg m-2 K. Stot, & ! The integrated salt of layers which are fully entrained, - ! in H PSU. + ! in H PSU ~> m PSU or PSU kg m-2. uhtot, & ! The depth integrated zonal and meridional velocities in the - vhtot, & ! mixed layer, in H m s-1. + vhtot, & ! mixed layer, in H m s-1 ~> m2 s-1 or kg m-1 s-1. netMassInOut, & ! The net mass flux (if non-Boussinsq) or volume flux (if ! Boussinesq - i.e. the fresh water flux (P+R-E)) into the - ! ocean over a time step, in H. + ! ocean over a time step, in H ~> m or kg m-2. NetMassOut, & ! The mass flux (if non-Boussinesq) or volume flux (if ! Boussinesq) over a time step from evaporating fresh water (H) Net_heat, & ! The net heating at the surface over a time step in K H. Any ! penetrating shortwave radiation is not included in Net_heat. Net_salt, & ! The surface salt flux into the ocean over a time step, psu H. - Idecay_len_TKE, & ! The inverse of a turbulence decay length scale, in H-1. + Idecay_len_TKE, & ! The inverse of a turbulence decay length scale, in H-1 ~> m-1 or m2 kg-1. p_ref, & ! Reference pressure for the potential density governing mixed ! layer dynamics, almost always 0 (or 1e5) Pa. p_ref_cv, & ! Reference pressure for the potential density which defines @@ -300,13 +300,13 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C Pen_SW_bnd ! The penetrating fraction of the shortwave heating integrated ! over a time step in each band, in K H. real, dimension(max(CS%nsw,1),SZI_(G),SZK_(GV)) :: & - opacity_band ! The opacity in each band, in H-1. The indicies are band, i, k. + opacity_band ! The opacity in each band, in H-1 ~> m-1 or m2 kg-1. The indicies are band, i, k. real :: cMKE(2,SZI_(G)) ! Coefficients of HpE and HpE^2 used in calculating the ! denominator of MKE_rate, in m-1 and m-2. real :: Irho0 ! 1.0 / rho_0 real :: Inkml, Inkmlm1! 1.0 / REAL(nkml) and 1.0 / REAL(nkml-1) - real :: Ih ! The inverse of a thickness, in H-1. + real :: Ih ! The inverse of a thickness, in H-1 ~> m-1 or m2 kg-1. real :: Idt ! The inverse of the timestep in s-1. real :: Idt_diag ! The inverse of the timestep used for diagnostics in s-1. real :: RmixConst @@ -314,7 +314,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C real, dimension(SZI_(G)) :: & dKE_FC, & ! The change in mean kinetic energy due to free convection, ! in Z m2 s-2 ~> m3 s-2. - h_CA ! The depth to which convective adjustment has gone in H. + h_CA ! The depth to which convective adjustment has gone in H ~> m or kg m-2. real, dimension(SZI_(G),SZK_(GV)) :: & dKE_CA, & ! The change in mean kinetic energy due to convective ! adjustment, in Z m2 s-2 ~> m3 s-2. @@ -328,15 +328,15 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C Hsfc_min, & ! The minimum thickness of the surface region based on the ! new mixed layer depth and the previous thickness of the ! neighboring water columns, in Z ~> m. - h_sum, & ! The total thickness of the water column, in H. - hmbl_prev ! The previous thickness of the mixed and buffer layers, in H. + h_sum, & ! The total thickness of the water column, in H ~> m or kg m-2. + hmbl_prev ! The previous thickness of the mixed and buffer layers, in H ~> m or kg m-2. real, dimension(SZI_(G)) :: & Hsfc, & ! The thickness of the surface region (mixed and buffer - ! layers before detrainment in to the interior, in H. + ! layers before detrainment in to the interior, in H ~> m or kg m-2. max_BL_det ! If non-negative, the maximum amount of entrainment from - ! the buffer layers that will be allowed this time step, in H. + ! the buffer layers that will be allowed this time step, in H ~> m or kg m-2. real :: dHsfc, dHD ! Local copies of nondimensional parameters. - real :: H_nbr ! A minimum thickness based on neighboring thicknesses, in H. + real :: H_nbr ! A minimum thickness based on neighboring thicknesses, in H ~> m or kg m-2. real :: absf_x_H ! The absolute value of f times the mixed layer thickness, ! in units of Z s-1. @@ -522,8 +522,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! The surface forcing is contained in the fluxes type. ! We aggregate the thermodynamic forcing for a time step into the following: - ! netMassInOut = water (H units) added/removed via surface fluxes - ! netMassOut = water (H units) removed via evaporating surface fluxes + ! netMassInOut = water (H ~> m or kg m-2) added/removed via surface fluxes + ! netMassOut = water (H ~> m or kg m-2) removed via evaporating surface fluxes ! net_heat = heat (degC * H) via surface fluxes ! net_salt = salt ( g(salt)/m2 for non-Bouss and ppt*m/s for Bouss ) via surface fluxes ! Pen_SW_bnd = components to penetrative shortwave radiation @@ -800,7 +800,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & dKE_CA, cTKE, j, G, GV, CS, nz_conv) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness, in H (often m or kg m-2). + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness, in H ~> m or kg m-2. !! The units of h are referred to as H below. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocities interpolated to h !! points, m s-1. @@ -813,11 +813,11 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: Rcv !< The coordinate defining potential !! density, in kg m-3. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_eb !< The downward increase across a layer - !! in the entrainment from below, in H. + !! in the entrainment from below, in H ~> m or kg m-2. !! Positive values go with mass gain by !! a layer. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: eps !< The negligibly small amount of water - !! that will be left in each layer, in H. + !! that will be left in each layer, in H ~> m or kg m-2. real, dimension(SZI_(G),SZK_(GV)), intent(out) :: dKE_CA !< The vertically integrated change in !! kinetic energy due to convective !! adjustment, in Z m2 s-2 ~> m3 s-2. @@ -837,22 +837,22 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & ! Local variables real, dimension(SZI_(G)) :: & htot, & ! The total depth of the layers being considered for - ! entrainment, in H. + ! entrainment, in H ~> m or kg m-2. R0_tot, & ! The integrated potential density referenced to the surface - ! of the layers which are fully entrained, in H kg m-3. + ! of the layers which are fully entrained, in H kg m-3 ~> kg m-2 or kg2 m-5. Rcv_tot, & ! The integrated coordinate value potential density of the - ! layers that are fully entrained, in H kg m-3. + ! layers that are fully entrained, in H kg m-3 ~> kg m-2 or kg2 m-5. Ttot, & ! The integrated temperature of layers which are fully - ! entrained, in H K. + ! entrained, in H K ~> m K or kg m-2 K. Stot, & ! The integrated salt of layers which are fully entrained, - ! in H PSU. + ! in H PSU ~> m PSU or PSU kg m-2. uhtot, & ! The depth integrated zonal and meridional velocities in - vhtot, & ! the mixed layer, in H m s-1. + vhtot, & ! the mixed layer, in H m s-1 ~> m2 s-1 or kg m-1 s-1. KE_orig, & ! The total mean kinetic energy in the mixed layer before ! convection, H m2 s-2. - h_orig_k1 ! The depth of layer k1 before convective adjustment, in H. - real :: h_ent ! The thickness from a layer that is entrained, in H. - real :: Ih ! The inverse of a thickness, in H-1. + h_orig_k1 ! The depth of layer k1 before convective adjustment, in H ~> m or kg m-2. + real :: h_ent ! The thickness from a layer that is entrained, in H ~> m or kg m-2. + real :: Ih ! The inverse of a thickness, in H-1 ~> m-1 or m2 kg-1. real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of ! the conversion from H to Z divided by the mean density, ! in m7 s-2 Z-1 H-2 kg-1. !### CHECK UNITS @@ -937,13 +937,13 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK_(GV)), & - intent(inout) :: h !< Layer thickness, in H (often m or kg m-2). + intent(inout) :: h !< Layer thickness, in H ~> m or kg m-2. !! The units of h are referred to as H below. real, dimension(SZI_(G),SZK_(GV)), & intent(inout) :: d_eb !< The downward increase across a layer in the - !! layer in the entrainment from below, in H. + !! layer in the entrainment from below, in H ~> m or kg m-2. !! Positive values go with mass gain by a layer. - real, dimension(SZI_(G)), intent(out) :: htot !< The accumulated mixed layer thickness, in H. + real, dimension(SZI_(G)), intent(out) :: htot !< The accumulated mixed layer thickness, in H ~> m or kg m-2. real, dimension(SZI_(G)), intent(out) :: Ttot !< The depth integrated mixed layer temperature, !! in deg C H. real, dimension(SZI_(G)), intent(out) :: Stot !< The depth integrated mixed layer salinity, @@ -952,10 +952,10 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! velocity, H m s-1. real, dimension(SZI_(G)), intent(out) :: vhtot !< The integrated mixed layer meridional !! velocity, H m s-1. - real, dimension(SZI_(G)), intent(out) :: R0_tot !< The integrated mixed layer potential - !! density referenced to 0 pressure, in H kg m-2. + real, dimension(SZI_(G)), intent(out) :: R0_tot !< The integrated mixed layer potential density referenced + !! to 0 pressure, in H kg m-2 ~> kg m-1 or kg2 m-4. real, dimension(SZI_(G)), intent(out) :: Rcv_tot !< The integrated mixed layer coordinate - !! variable potential density, in H kg m-2. + !! variable potential density, in H kg m-2 ~> kg m-1 or kg2 m-4. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: u !< Zonal velocities interpolated to h points, m s-1. real, dimension(SZI_(G),SZK_(GV)), & @@ -972,7 +972,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! density, in kg m-3. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: eps !< The negligibly small amount of water - !! that will be left in each layer, in H. + !! that will be left in each layer, in H ~> m or kg m-2. real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of R0 with respect to !! temperature, in kg m-3 degC-1. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of Rcv with respect to @@ -983,9 +983,9 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! salinity, in kg m-3 psu-1. real, dimension(SZI_(G)), intent(in) :: netMassInOut !< The net mass flux (if non-Boussinesq) !! or volume flux (if Boussinesq) into the ocean - !! within a time step in H. (I.e. P+R-E.) + !! within a time step in H ~> m or kg m-2. (I.e. P+R-E.) real, dimension(SZI_(G)), intent(in) :: netMassOut !< The mass or volume flux out of the ocean - !! within a time step in H. + !! within a time step in H ~> m or kg m-2. real, dimension(SZI_(G)), intent(in) :: Net_heat !< The net heating at the surface over a !! time step in K H. Any penetrating shortwave !! radiation is not included in Net_heat. @@ -998,7 +998,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! penetrating band, in K H, !! size nsw x SZI_(G). real, dimension(:,:,:), intent(in) :: opacity_band !< The opacity in each band of penetrating - !! shortwave radiation, in H-1. + !! shortwave radiation, in H-1 ~> m-1 or m2 kg-1. !! The indicies of opacity_band are band, i, k. real, dimension(SZI_(G)), intent(out) :: Conv_en !< The buoyant turbulent kinetic energy source !! due to free convection, in Z m2 s-2 ~> m3 s-2. @@ -1027,15 +1027,15 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! Local variables real, dimension(SZI_(G)) :: & - massOutRem, & ! Evaporation that remains to be supplied, in H. + massOutRem, & ! Evaporation that remains to be supplied, in H ~> m or kg m-2. netMassIn ! mass entering through ocean surface (H) real :: SW_trans ! The fraction of shortwave radiation ! that is not absorbed in a layer, ND. real :: Pen_absorbed ! The amount of penetrative shortwave radiation ! that is absorbed in a layer, in units of K H. real :: h_avail ! The thickness in a layer available for - ! entrainment, in H. - real :: h_ent ! The thickness from a layer that is entrained, in H. + ! entrainment, in H ~> m or kg m-2. + real :: h_ent ! The thickness from a layer that is entrained, in H ~> m or kg m-2. real :: T_precip ! The temperature of the precipitation, in deg C. real :: C1_3, C1_6 ! 1/3 and 1/6. real :: En_fn, Frac, x1 ! Nondimensional temporary variables. @@ -1043,14 +1043,14 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: dr_ent, dr_comp ! Temporary variables with units of kg m-3 H. real :: dr_dh ! The partial derivative of dr_ent with h_ent, in kg m-3. real :: h_min, h_max ! The minimum, maximum, and previous estimates for - real :: h_prev ! h_ent, in H. - real :: h_evap ! The thickness that is evaporated, in H. + real :: h_prev ! h_ent, in H ~> m or kg m-2. + real :: h_evap ! The thickness that is evaporated, in H ~> m or kg m-2. real :: dh_Newt ! The Newton's method estimate of the change in - ! h_ent between iterations, in H. + ! h_ent between iterations, in H ~> m or kg m-2. real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of ! the conversion from H to Z divided by the mean density, ! in m7 s-2 Z-1 H-2 kg-1. !### CHECK UNITS - real :: Angstrom ! The minimum layer thickness, in H. + real :: Angstrom ! The minimum layer thickness, in H ~> m or kg m-2. real :: opacity ! The opacity converted to units of H-1. real :: sum_Pen_En ! The potential energy change due to penetrating ! shortwave radiation, integrated over a layer, in @@ -1305,10 +1305,10 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G)), intent(in) :: htot !< The accumlated mixed layer thickness, in H + real, dimension(SZI_(G)), intent(in) :: htot !< The accumlated mixed layer thickness, in H ~> m or kg m-2 !! (often m or kg m-2). real, dimension(SZI_(G)), intent(in) :: h_CA !< The mixed layer depth after convective - !! adjustment, in H. + !! adjustment, in H ~> m or kg m-2. type(forcing), intent(in) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields !! have NULL ptrs. @@ -1328,7 +1328,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, real, dimension(SZI_(G)), intent(out) :: TKE !< The turbulent kinetic energy available for !! mixing over a time step, in Z m2 s-2 ~> m3 s-2. real, dimension(SZI_(G)), intent(out) :: Idecay_len_TKE !< The inverse of the vertical decay - !! scale for TKE, in H-1. + !! scale for TKE, in H-1 ~> m-1 or m2 kg-1. real, dimension(SZI_(G)), intent(in) :: TKE_river !< The turbulent kinetic energy available !! for driving mixing at river mouths !! integrated over a time step, in Z m2 s-2 ~> m3 s-2. @@ -1357,7 +1357,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, real :: MKE_rate_CA ! MKE_rate for convective adjustment, ND, 0 to 1. real :: MKE_rate_FC ! MKE_rate for free convection, ND, 0 to 1. real :: totEn_Z ! The total potential energy released by convection, Z3 s-2. - real :: Ih ! The inverse of a thickness, in H-1. + real :: Ih ! The inverse of a thickness, in H-1 ~> m-1 or m2 kg-1. real :: exp_kh ! The nondimensional decay of TKE across a layer, ND. real :: absf ! The absolute value of f averaged to thickness points, s-1. real :: U_star ! The friction velocity in Z s-1 ~> m s-1. @@ -1497,9 +1497,9 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! The units of h are referred to as H below. real, dimension(SZI_(G),SZK_(GV)), & intent(inout) :: d_eb !< The downward increase across a layer in the - !! layer in the entrainment from below, in H. + !! layer in the entrainment from below, in H ~> m or kg m-2. !! Positive values go with mass gain by a layer. - real, dimension(SZI_(G)), intent(inout) :: htot !< The accumlated mixed layer thickness, in H. + real, dimension(SZI_(G)), intent(inout) :: htot !< The accumlated mixed layer thickness, in H ~> m or kg m-2. real, dimension(SZI_(G)), intent(inout) :: Ttot !< The depth integrated mixed layer temperature, !! in deg C H. real, dimension(SZI_(G)), intent(inout) :: Stot !< The depth integrated mixed layer salinity, @@ -1508,10 +1508,10 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! velocity, H m s-1. real, dimension(SZI_(G)), intent(inout) :: vhtot !< The integrated mixed layer meridional !! velocity, H m s-1. - real, dimension(SZI_(G)), intent(inout) :: R0_tot !< The integrated mixed layer potential - !! density referenced to 0 pressure, in H kg m-3. - real, dimension(SZI_(G)), intent(inout) :: Rcv_tot !< The integrated mixed layer coordinate - !! variable potential density, in H kg m-3. + real, dimension(SZI_(G)), intent(inout) :: R0_tot !< The integrated mixed layer potential density + !! referenced to 0 pressure, in H kg m-3 ~> kg m-2 or kg2 m-5. + real, dimension(SZI_(G)), intent(inout) :: Rcv_tot !< The integrated mixed layer coordinate variable + !! potential density, in H kg m-3 ~> kg m-2 or kg2 m-5. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: u !< Zonal velocities interpolated to h points, m s-1. real, dimension(SZI_(G),SZK_(GV)), & @@ -1528,7 +1528,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! density, in kg m-3. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: eps !< The negligibly small amount of water - !! that will be left in each layer, in H. + !! that will be left in each layer, in H ~> m or kg m-2. real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of R0 with respect to !! temperature, in kg m-3 degC-1. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of Rcv with respect to @@ -1544,12 +1544,12 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! penetrating band, in K H, !! size nsw x SZI_(G). real, dimension(:,:,:), intent(in) :: opacity_band !< The opacity in each band of penetrating - !! shortwave radiation, in H-1. + !! shortwave radiation, in H-1 ~> m-1 or m2 kg-1. !! The indicies of opacity_band are band, i, k. real, dimension(SZI_(G)), intent(inout) :: TKE !< The turbulent kinetic energy !! available for mixing over a time !! step, in Z m2 s-2 ~> m3 s-2. - real, dimension(SZI_(G)), intent(inout) :: Idecay_len_TKE !< The vertical TKE decay rate, in H-1. + real, dimension(SZI_(G)), intent(inout) :: Idecay_len_TKE !< The vertical TKE decay rate, in H-1 ~> m-1 or m2 kg-1. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & intent(in) :: ksort !< The density-sorted k-indicies. @@ -1562,11 +1562,11 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! absorbed in a layer, nondimensional. real :: Pen_absorbed ! The amount of penetrative shortwave radiation ! that is absorbed in a layer, in units of K m. - real :: h_avail ! The thickness in a layer available for entrainment in H. - real :: h_ent ! The thickness from a layer that is entrained, in H. - real :: h_min, h_max ! Limits on the solution for h_ent, in H. + real :: h_avail ! The thickness in a layer available for entrainment in H ~> m or kg m-2. + real :: h_ent ! The thickness from a layer that is entrained, in H ~> m or kg m-2. + real :: h_min, h_max ! Limits on the solution for h_ent, in H ~> m or kg m-2. real :: dh_Newt ! The Newton's method estimate of the change in - ! h_ent between iterations, in H. + ! h_ent between iterations, in H ~> m or kg m-2. real :: MKE_rate ! The fraction of the energy in resolved shears ! within the mixed layer that will be eliminated ! within a timestep, nondim, 0 to 1. @@ -1589,9 +1589,9 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: dTKE_dh ! The partial derivative of TKE with h_ent, in Z m2 s-2 H-1 ~> m2 s-2 or m5 s-2 kg-1. real :: Pen_dTKE_dh_Contrib ! The penetrating shortwave contribution to ! dTKE_dh, in m2 s-2. - real :: EF4_val ! The result of EF4() (see later), in H-1. + real :: EF4_val ! The result of EF4() (see later), in H-1 ~> m-1 or m2 kg-1. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. + ! in roundoff and can be neglected, in H ~> m or kg m-2. real :: dEF4_dh ! The partial derivative of EF4 with h, in H-2. real :: Pen_En1 ! A nondimensional temporary variable. real :: kh, exp_kh ! Nondimensional temporary variables related to the @@ -1600,8 +1600,8 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: f1_x1, f2_x1 ! the relative decay of TKE and SW radiation across real :: f3_x1 ! a layer, and exponential-related functions of x1. real :: E_HxHpE ! Entrainment divided by the product of the new and old - ! thicknesses, in H-1. - real :: Hmix_min ! The minimum mixed layer depth in H. + ! thicknesses, in H-1 ~> m-1 or m2 kg-1. + real :: Hmix_min ! The minimum mixed layer depth in H ~> m or kg m-2. real :: opacity real :: C1_3, C1_6, C1_24 ! 1/3, 1/6, and 1/24. integer :: is, ie, nz, i, k, ks, itt, n @@ -1838,7 +1838,7 @@ subroutine sort_ML(h, R0, eps, G, GV, CS, ksort) real, dimension(SZI_(G),SZK_(GV)), intent(in) :: R0 !< The potential density used to sort !! the layers, in kg m-3. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: eps !< The (small) thickness that must - !! remain in each layer, in H. + !! remain in each layer, in H ~> m or kg m-2. type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a !! previous call to mixedlayer_init. integer, dimension(SZI_(G),SZK_(GV)), intent(out) :: ksort !< The k-index to use in the sort. @@ -1849,7 +1849,7 @@ subroutine sort_ML(h, R0, eps, G, GV, CS, ksort) ! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out) The units ! of h are referred to as H below. ! (in) R0 - The potential density used to sort the layers, in kg m-3. -! (in) eps - The (small) thickness that must remain in each layer, in H. +! (in) eps - The (small) thickness that must remain in each layer, in H ~> m or kg m-2. ! (in) tv - A structure containing pointers to any available ! thermodynamic fields. Absent fields have NULL ptrs. ! (in) j - The meridional row to work on. @@ -1914,7 +1914,7 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS real, dimension(SZK_(GV)), intent(in) :: RcvTgt !< The target value of Rcv for each !! layer, in kg m-3. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: eps !< The (small) thickness that must - !! remain in each layer, in H. + !! remain in each layer, in H ~> m or kg m-2. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea !< The upward increase across a !! layer in the entrainment from !! above, in m or kg m-2 (H). @@ -1922,7 +1922,7 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS !! thickness increases. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_eb !< The downward increase across a !! layer in the entrainment from - !! below, in H. Positive values go + !! below, in H ~> m or kg m-2. Positive values go !! with mass gain by a layer. integer, dimension(SZI_(G),SZK_(GV)), intent(in) :: ksort !< The density-sorted k-indicies. type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this @@ -1955,12 +1955,12 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS ! (in/out) R0 - Potential density referenced to surface pressure, in kg m-3. ! (in/out) Rcv - The coordinate defining potential density, in kg m-3. ! (in) RcvTgt - The target value of Rcv for each layer, in kg m-3. -! (in) eps - The (small) thickness that must remain in each layer, in H. +! (in) eps - The (small) thickness that must remain in each layer, in H ~> m or kg m-2. ! (in/out) d_ea - The upward increase across a layer in the entrainment from ! above, in m or kg m-2 (H). Positive d_ea goes with layer ! thickness increases. ! (in/out) d_eb - The downward increase across a layer in the entrainment from -! below, in H. Positive values go with mass gain by a layer. +! below, in H ~> m or kg m-2. Positive values go with mass gain by a layer. ! (in) ksort - The density-sorted k-indicies. ! (in) G - The ocean's grid structure. ! (in) GV - The ocean's vertical grid structure. @@ -2291,7 +2291,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, !! with salinity, in kg m-3 psu-1. real, dimension(SZI_(G)), intent(in) :: max_BL_det !< If non-negative, the maximum !! detrainment permitted from the buffer - !! layers, in H. + !! layers, in H ~> m or kg m-2. ! This subroutine moves any water left in the former mixed layers into the ! two buffer layers and may also move buffer layer water into the interior @@ -2299,35 +2299,35 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! Local variables real :: h_to_bl ! The total thickness detrained to the buffer - ! layers, in H (the units of h). + ! layers, in H ~> m or kg m-2. real :: R0_to_bl, Rcv_to_bl ! The depth integrated amount of R0, Rcv, T real :: T_to_bl, S_to_bl ! and S that is detrained to the buffer layer, ! in H kg m-3, H kg m-3, K H, and psu H. - real :: h_min_bl ! The minimum buffer layer thickness, in H. + real :: h_min_bl ! The minimum buffer layer thickness, in H ~> m or kg m-2. real :: h_min_bl_thick ! The minimum buffer layer thickness when the - ! mixed layer is very large, in H. + ! mixed layer is very large, in H ~> m or kg m-2. real :: h_min_bl_frac_ml = 0.05 ! The minimum buffer layer thickness relative ! to the total mixed layer thickness for thin ! mixed layers, nondim., maybe 0.1/CS%nkbl. real :: h1, h2 ! Scalar variables holding the values of - ! h(i,CS%nkml+1) and h(i,CS%nkml+2), in H. - real :: h1_avail ! The thickess of the upper buffer layer + ! h(i,CS%nkml+1) and h(i,CS%nkml+2), in H ~> m or kg m-2. + real :: h1_avail ! The thickness of the upper buffer layer ! available to move into the lower buffer - ! layer, in H. + ! layer, in H ~> m or kg m-2. real :: stays ! stays is the thickness of the upper buffer - ! layer that remains there, in units of H. + ! layer that remains there, in H ~> m or kg m-2. real :: stays_min, stays_max ! The minimum and maximum permitted values of - ! stays, in units of H. + ! stays, in H ~> m or kg m-2. logical :: mergeable_bl ! If true, it is an option to combine the two ! buffer layers and create water that matches ! the target density of an interior layer. real :: stays_merge ! If the two buffer layers can be combined ! stays_merge is the thickness of the upper - ! layer that remains, in units of H. - real :: stays_min_merge ! The minimum allowed value of stays_merge in H. + ! layer that remains, in H ~> m or kg m-2. + real :: stays_min_merge ! The minimum allowed value of stays_merge in H ~> m or kg m-2. real :: dR0_2dz, dRcv_2dz ! Half the vertical gradients of R0, Rcv, T, and ! real :: dT_2dz, dS_2dz ! S, in kg m-4, kg m-4, K m-1, and psu m-1. @@ -2337,19 +2337,19 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: dPE_extrap ! The potential energy change due to dispersive ! advection or mixing layers, divided by - ! rho_0*g, in units of H2. + ! rho_0*g, in H2 ~> m2 or kg2 m-4. real :: dPE_det, dPE_merge ! The energy required to mix the detrained water ! into the buffer layer or the merge the two ! buffer layers, both in units of J H2 Z m-5. real :: h_from_ml ! The amount of additional water that must be - ! drawn from the mixed layer, in H. + ! drawn from the mixed layer, in H ~> m or kg m-2. real :: h_det_h2 ! The amount of detrained water and mixed layer ! water that will go directly into the lower - ! buffer layer, in H. - real :: h_det_to_h2, h_ml_to_h2 ! All of the variables hA_to_hB are the - real :: h_det_to_h1, h_ml_to_h1 ! thickess fluxes from one layer to another, - real :: h1_to_h2, h1_to_k0 ! in H, with h_det the detrained water, h_ml + ! buffer layer, in H ~> m or kg m-2. + real :: h_det_to_h2, h_ml_to_h2 ! All of the variables hA_to_hB are the thickness fluxes + real :: h_det_to_h1, h_ml_to_h1 ! from one layer to another, in H ~> m or kg m-2, + real :: h1_to_h2, h1_to_k0 ! with h_det the detrained water, h_ml real :: h2_to_k1, h2_to_k1_rem ! the actively mixed layer, h1 and h2 the upper ! and lower buffer layers, and k0 and k1 the ! interior layers that are just lighter and @@ -2390,7 +2390,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, logical :: stable_Rcv ! If true, the buffer layers are stable with ! respect to the coordinate potential density. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. + ! in roundoff and can be neglected, in H ~> m or kg m-2. real :: s1en ! A work variable with units of H2 kg m s-3. real :: s1, s2, bh0 ! Work variables with units of H. @@ -2401,7 +2401,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: dR1, dR2, dR2b, dRk1 ! Assorted density difference work variables, real :: dR0, dR21, dRcv ! all with units of kg m-3. real :: dRcv_stays, dRcv_det, dRcv_lim - real :: Angstrom ! The minumum layer thickness, in H. + real :: Angstrom ! The minumum layer thickness, in H ~> m or kg m-2. real :: h2_to_k1_lim, T_new, S_new, T_max, T_min, S_max, S_min character(len=200) :: mesg @@ -3171,7 +3171,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e !! kg m-2 (H). Positive d_ea goes with !! layer thickness increases. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_eb !< The downward increase across a layer - !! in the entrainment from below, in H. + !! in the entrainment from below, in H ~> m or kg m-2. !! Positive values go with mass gain by !! a layer. integer, intent(in) :: j !< The meridional row to work on. @@ -3186,7 +3186,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e !! with salinity, in kg m-3 psu-1. real, dimension(SZI_(G)), intent(in) :: max_BL_det !< If non-negative, the maximum !! detrainment permitted from the buffer - !! layers, in H. + !! layers, in H ~> m or kg m-2. ! This subroutine moves any water left in the former mixed layers into the ! single buffer layers and may also move buffer layer water into the interior @@ -3204,24 +3204,24 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e ! above, in m or kg m-2 (H). Positive d_ea goes with layer ! thickness increases. ! (in/out) d_eb - The downward increase across a layer in the entrainment from -! below, in H. Positive values go with mass gain by a layer. +! below, in H ~> m or kg m-2. Positive values go with mass gain by a layer. ! (in) j - The meridional row to work on. ! (in) G - The ocean's grid structure. ! (in) GV - The ocean's vertical grid structure. ! (in) CS - The control structure returned by a previous call to ! mixedlayer_init. ! (in) max_BL_det - If non-negative, the maximum detrainment permitted -! from the buffer layers, in H. +! from the buffer layers, in H ~> m or kg m-2. ! (in/out) dRcv_dT - The partial derivative of coordinate defining potential ! density with potential temperature, in kg m-3 K-1. ! (in/out) dRcv_dS - The partial derivative of coordinate defining potential ! density with salinity, in kg m-3 psu-1. - real :: Ih ! The inverse of a thickness, in H-1. + real :: Ih ! The inverse of a thickness, in H-1 ~> m-1 or m2 kg-1. real :: h_ent ! The thickness from a layer that is - ! entrained, in H. - real :: max_det_rem(SZI_(G)) ! Remaining permitted detrainment, in H. + ! entrained, in H ~> m or kg m-2. + real :: max_det_rem(SZI_(G)) ! Remaining permitted detrainment, in H ~> m or kg m-2. real :: detrain(SZI_(G)) ! The thickness of fluid to detrain - ! from the mixed layer, in H. + ! from the mixed layer, in H ~> m or kg m-2. real :: Idt ! The inverse of the timestep in s-1. real :: dT_dR, dS_dR, dRml, dR0_dRcv, dT_dS_wt2 real :: I_denom ! A work variable with units of psu2 m6 kg-2. @@ -3739,36 +3739,25 @@ end subroutine bulkmixedlayer_init !! R = exp(-L*(H+E)) integral(LH to L(H+E)) L/(1-(1+x)exp(-x)) dx. !! The approximation to the integrand is good to within -2% at x~.3 !! and +25% at x~3.5, but the exponential deemphasizes the importance of -!! large x. When L=0, EF4 returns E/((H+E)*H). -function EF4(H, E, L, dR_de) - real, intent(in) :: H !< Total thickness, in m or kg m-2. (Intent in) The units of h - !! are referred to as H below. - real, intent(in) :: E !< Entrainment, in units of H. - real, intent(in) :: L !< The e-folding scale in H-1. +!! large x. When L=0, EF4 returns E/((Ht+E)*Ht). +function EF4(Ht, En, I_L, dR_de) + real, intent(in) :: Ht !< Total thickness, in H ~>m or kg m-2. + real, intent(in) :: En !< Entrainment, in H ~> m or kg m-2. + real, intent(in) :: I_L !< The e-folding scale in H-1 ~> m-1 or m2 kg-1 real, optional, intent(inout) :: dR_de !< The partial derivative of the result R with E, in H-2. - real :: EF4 -! This subroutine returns an approximation to the integral -! R = exp(-L*(H+E)) integral(LH to L(H+E)) L/(1-(1+x)exp(-x)) dx. -! The approximation to the integrand is good to within -2% at x~.3 -! and +25% at x~3.5, but the exponential deemphasizes the importance of -! large x. When L=0, EF4 returns E/((H+E)*H). -! -! Arguments: h - Total thickness, in m or kg m-2. (Intent in) The units -! of h are referred to as H below. -! (in) E - Entrainment, in units of H. -! (in) L - The e-folding scale in H-1. -! (out) dR_de - the partial derivative of the result R with E, in H-2. -! (return value) R - The integral, in units of H-1. + real :: EF4 !< The integral, in H-1 ~> m-1 or m2 kg-1. + + ! Local variables real :: exp_LHpE ! A nondimensional exponential decay. - real :: I_HpE ! An inverse thickness plus entrainment, in H-1. - real :: R ! The result of the integral above, in H-1. + real :: I_HpE ! An inverse thickness plus entrainment, in H-1 ~> m-1 or m2 kg-1. + real :: Res ! The result of the integral above, in H-1 ~> m-1 or m2 kg-1. - exp_LHpE = exp(-L*(E+H)) - I_HpE = 1.0/(H+E) - R = exp_LHpE * (E*I_HpE/H - 0.5*L*log(H*I_HpE) + 0.5*L*L*E) + exp_LHpE = exp(-I_L*(En+Ht)) + I_HpE = 1.0/(Ht+En) + Res = exp_LHpE * (En*I_HpE/Ht - 0.5*I_L*log(Ht*I_HpE) + 0.5*I_L*I_L*En) if (PRESENT(dR_de)) & - dR_de = -L*R + exp_LHpE*(I_HpE*I_HpE + 0.5*L*I_HpE + 0.5*L*L) - EF4 = R + dR_de = -I_L*Res + exp_LHpE*(I_HpE*I_HpE + 0.5*I_L*I_HpE + 0.5*I_L*I_L) + EF4 = Res end function EF4 From 80b7ba9389b217e16e61737b1fba65e91cc9f781 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 17 Dec 2018 10:15:35 -0500 Subject: [PATCH 0957/1072] Extended comments to clarify H units Added to comments to clarify the unscaled units of variables that scale with H, using notation like 'in H ~> m or kg m-2'. Only comments are changed, and all answers are bitwise identical. --- src/ALE/MOM_ALE.F90 | 13 +- src/ALE/MOM_regridding.F90 | 68 +++--- src/ALE/coord_adapt.F90 | 10 +- src/ALE/coord_hycom.F90 | 4 +- src/ALE/coord_rho.F90 | 2 +- src/ALE/coord_sigma.F90 | 8 +- src/ALE/coord_slight.F90 | 42 ++-- src/ALE/coord_zlike.F90 | 2 +- src/core/MOM.F90 | 2 +- src/core/MOM_CoriolisAdv.F90 | 4 +- src/core/MOM_PressureForce.F90 | 4 +- src/core/MOM_PressureForce_Montgomery.F90 | 4 +- src/core/MOM_PressureForce_analytic_FV.F90 | 12 +- src/core/MOM_PressureForce_blocked_AFV.F90 | 14 +- src/core/MOM_barotropic.F90 | 182 ++++++++-------- src/core/MOM_boundary_update.F90 | 2 +- src/core/MOM_checksum_packages.F90 | 6 +- src/core/MOM_continuity_PPM.F90 | 205 ++++++++++-------- src/core/MOM_dynamics_split_RK2.F90 | 2 +- src/core/MOM_dynamics_unsplit.F90 | 6 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 4 +- src/core/MOM_forcing_type.F90 | 46 ++-- src/core/MOM_interface_heights.F90 | 10 +- src/core/MOM_isopycnal_slopes.F90 | 20 +- src/core/MOM_variables.F90 | 28 +-- src/diagnostics/MOM_PointAccel.F90 | 8 +- src/diagnostics/MOM_diag_to_Z.F90 | 10 +- src/diagnostics/MOM_diagnostics.F90 | 24 +- src/diagnostics/MOM_sum_output.F90 | 2 +- src/diagnostics/MOM_wave_speed.F90 | 8 +- src/diagnostics/MOM_wave_structure.F90 | 2 +- src/framework/MOM_diag_mediator.F90 | 2 +- src/framework/MOM_spatial_means.F90 | 6 +- .../MOM_state_initialization.F90 | 21 +- .../MOM_tracer_initialization_from_Z.F90 | 4 +- src/initialization/midas_vertmap.F90 | 2 +- src/ocean_data_assim/MOM_oda_driver.F90 | 4 +- src/parameterizations/lateral/MOM_MEKE.F90 | 2 +- .../lateral/MOM_hor_visc.F90 | 14 +- .../lateral/MOM_internal_tides.F90 | 2 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 2 +- .../lateral/MOM_mixed_layer_restrat.F90 | 34 +-- .../lateral/MOM_thickness_diffuse.F90 | 35 +-- .../vertical/MOM_ALE_sponge.F90 | 4 +- .../vertical/MOM_diabatic_aux.F90 | 49 +++-- .../vertical/MOM_diabatic_driver.F90 | 8 +- .../vertical/MOM_diapyc_energy_req.F90 | 63 +++--- .../vertical/MOM_energetic_PBL.F90 | 71 +++--- .../vertical/MOM_entrain_diffusive.F90 | 167 +++++++------- .../vertical/MOM_full_convection.F90 | 41 ++-- .../vertical/MOM_geothermal.F90 | 18 +- .../vertical/MOM_internal_tide_input.F90 | 4 +- .../vertical/MOM_kappa_shear.F90 | 6 +- .../vertical/MOM_regularize_layers.F90 | 61 +++--- .../vertical/MOM_set_diffusivity.F90 | 17 +- .../vertical/MOM_set_viscosity.F90 | 104 ++++----- .../vertical/MOM_shortwave_abs.F90 | 19 +- src/parameterizations/vertical/MOM_sponge.F90 | 22 +- .../vertical/MOM_tidal_mixing.F90 | 10 +- .../vertical/MOM_vert_friction.F90 | 38 ++-- src/tracer/DOME_tracer.F90 | 4 +- src/tracer/MOM_OCMIP2_CFC.F90 | 6 +- src/tracer/MOM_generic_tracer.F90 | 6 +- src/tracer/MOM_offline_main.F90 | 6 +- src/tracer/MOM_tracer_Z_init.F90 | 2 +- src/tracer/MOM_tracer_advect.F90 | 12 +- src/tracer/MOM_tracer_diabatic.F90 | 10 +- src/tracer/MOM_tracer_flow_control.F90 | 6 +- src/tracer/MOM_tracer_hor_diff.F90 | 2 +- src/tracer/advection_test_tracer.F90 | 4 +- src/tracer/boundary_impulse_tracer.F90 | 4 +- src/tracer/dye_example.F90 | 4 +- src/tracer/dyed_obc_tracer.F90 | 2 +- src/tracer/ideal_age_example.F90 | 4 +- src/tracer/oil_tracer.F90 | 4 +- src/tracer/pseudo_salt_tracer.F90 | 4 +- src/tracer/tracer_example.F90 | 6 +- src/user/BFB_initialization.F90 | 4 +- src/user/DOME2d_initialization.F90 | 4 +- src/user/DOME_initialization.F90 | 2 +- src/user/ISOMIP_initialization.F90 | 4 +- src/user/Kelvin_initialization.F90 | 2 +- src/user/MOM_wave_interface.F90 | 6 +- src/user/Neverland_initialization.F90 | 2 +- src/user/Phillips_initialization.F90 | 13 +- src/user/Rossby_front_2d_initialization.F90 | 4 +- src/user/SCM_CVMix_tests.F90 | 2 +- src/user/adjustment_initialization.F90 | 4 +- src/user/baroclinic_zone_initialization.F90 | 2 +- src/user/benchmark_initialization.F90 | 13 +- src/user/circle_obcs_initialization.F90 | 4 +- src/user/external_gwave_initialization.F90 | 2 +- src/user/lock_exchange_initialization.F90 | 2 +- src/user/seamount_initialization.F90 | 6 +- src/user/sloshing_initialization.F90 | 4 +- src/user/soliton_initialization.F90 | 2 +- src/user/user_change_diffusivity.F90 | 2 +- src/user/user_initialization.F90 | 8 +- 98 files changed, 897 insertions(+), 865 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 9efa32b144..e194c5ebdb 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -305,7 +305,7 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, dt, frac_shelf_h) type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the - !! last time step in H (often m or Pa) + !! last time step in H ~> m or kg m-2 real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity field (m/s) real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< Meridional velocity field (m/s) type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure @@ -566,8 +566,9 @@ subroutine check_grid( G, GV, h, threshold ) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Current 3D grid obtained after the - !! last time step (H units) - real, intent(in) :: threshold !< Value below which to flag issues (H units) + !! last time step (H ~> m or kg m-2) + real, intent(in) :: threshold !< Value below which to flag issues, + !! in H ~> m or kg m-2 ! Local variables integer :: i, j @@ -965,7 +966,7 @@ subroutine pressure_gradient_plm( CS, S_t, S_b, T_t, T_b, G, GV, tv, h, bdry_ext intent(inout) :: T_b !< Temperature at the bottom edge of each layer type(thermo_var_ptrs), intent(in) :: tv !< thermodynamics structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< layer thickness in H + intent(in) :: h !< layer thickness in H ~> m or kg m-2 logical, intent(in) :: bdry_extrap !< If true, use high-order boundary !! extrapolation within boundary cells @@ -1039,7 +1040,7 @@ subroutine pressure_gradient_ppm( CS, S_t, S_b, T_t, T_b, G, GV, tv, h, bdry_ext intent(inout) :: T_b !< Temperature at the bottom edge of each layer type(thermo_var_ptrs), intent(in) :: tv !< thermodynamics structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< layer thicknesses in H + intent(in) :: h !< layer thicknesses in H ~> m or kg m-2 logical, intent(in) :: bdry_extrap !< If true, use high-order boundary !! extrapolation within boundary cells @@ -1227,7 +1228,7 @@ subroutine ALE_initThicknessToCoord( CS, G, GV, h ) type(ALE_CS), intent(inout) :: CS !< module control structure type(ocean_grid_type), intent(in) :: G !< module grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: h !< layer thickness in H + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: h !< layer thickness in H ~> m or kg m-2 ! Local variables integer :: i, j, k diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 64066a2cea..e65f590a28 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -64,11 +64,11 @@ module MOM_regridding logical :: target_density_set = .false. !> This array is set by function set_regrid_max_depths() - !! It specifies the maximum depth that every interface is allowed to take, in H. + !! It specifies the maximum depth that every interface is allowed to take, in H ~> m or kg m-2. real, dimension(:), allocatable :: max_interface_depths !> This array is set by function set_regrid_max_thickness() - !! It specifies the maximum depth that every interface is allowed to take, in H. + !! It specifies the maximum depth that every interface is allowed to take, in H ~> m or kg m-2. real, dimension(:), allocatable :: max_layer_thickness integer :: nk !< Number of layers/levels in generated grid @@ -80,7 +80,7 @@ module MOM_regridding !> Interpolation control structure type(interp_CS_type) :: interp_CS - !> Minimum thickness allowed when building the new grid through regridding, in H. + !> Minimum thickness allowed when building the new grid through regridding, in H ~> m or kg m-2. real :: min_thickness !> Reference pressure for potential density calculations (Pa) @@ -92,10 +92,10 @@ module MOM_regridding !! depth_of_time_filter_deep. real :: old_grid_weight = 0. - !> Depth above which no time-filtering of grid is applied (H units) + !> Depth above which no time-filtering of grid is applied (H ~> m or kg m-2) real :: depth_of_time_filter_shallow = 0. - !> Depth below which time-filtering of grid is applied at full effect (H units) + !> Depth below which time-filtering of grid is applied at full effect (H ~> m or kg m-2) real :: depth_of_time_filter_deep = 0. !> Fraction (between 0 and 1) of compressibility to add to potential density @@ -1136,8 +1136,9 @@ subroutine build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h) type(regridding_CS), intent(in) :: CS !< Regridding control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H - real, dimension(SZI_(G),SZJ_(G), CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth in H. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G), CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth + !! in H ~> m or kg m-2. real, dimension(:,:), optional, pointer :: frac_shelf_h !< Fractional ice shelf coverage. ! Local variables integer :: i, j, k @@ -1236,8 +1237,9 @@ subroutine build_sigma_grid( CS, G, GV, h, dzInterface ) type(regridding_CS), intent(in) :: CS !< Regridding control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H - real, dimension(SZI_(G),SZJ_(G), CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth in H. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G), CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth + !! in H ~> m or kg m-2 ! Local variables integer :: i, j, k @@ -1321,9 +1323,10 @@ subroutine build_rho_grid( G, GV, h, tv, dzInterface, remapCS, CS ) ! Arguments type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, dimension(SZI_(G),SZJ_(G), SZK_(GV)+1), intent(inout) :: dzInterface !< The change in interface depth in H + real, dimension(SZI_(G),SZJ_(G), SZK_(GV)+1), intent(inout) :: dzInterface !< The change in interface depth + !! in H ~> m or kg m-2 type(remapping_CS), intent(in) :: remapCS !< The remapping control structure type(regridding_CS), intent(in) :: CS !< Regridding control structure @@ -1434,16 +1437,16 @@ end subroutine build_rho_grid subroutine build_grid_HyCOM1( G, GV, h, tv, h_new, dzInterface, CS ) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Existing model thickness, in H units + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Existing model thickness, in H ~> m or kg m-2 type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure type(regridding_CS), intent(in) :: CS !< Regridding control structure - real, dimension(SZI_(G),SZJ_(G),CS%nk), intent(inout) :: h_new !< New layer thicknesses (H units) + real, dimension(SZI_(G),SZJ_(G),CS%nk), intent(inout) :: h_new !< New layer thicknesses, in H ~> m or kg m-2 real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< Changes in interface position ! Local variables - real, dimension(SZK_(GV)+1) :: z_col ! Source interface positions relative to the surface in H units (m or kg m-2) - real, dimension(CS%nk+1) :: z_col_new ! New interface positions relative to the surface in H units (m or kg m-2) - real, dimension(SZK_(GV)+1) :: dz_col ! The realized change in z_col in H units (m or kg m-2) + real, dimension(SZK_(GV)+1) :: z_col ! Source interface positions relative to the surface in H ~> m or kg m-2 + real, dimension(CS%nk+1) :: z_col_new ! New interface positions relative to the surface in H ~> m or kg m-2 + real, dimension(SZK_(GV)+1) :: dz_col ! The realized change in z_col in H ~> m or kg m-2 real, dimension(SZK_(GV)) :: p_col ! Layer pressure in Pa integer :: i, j, k, nki real :: depth @@ -1503,10 +1506,11 @@ end subroutine build_grid_HyCOM1 subroutine build_grid_adaptive(G, GV, h, tv, dzInterface, remapCS, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: dzInterface !< The change in interface depth in H + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: dzInterface !< The change in interface depth + !! in H ~> m or kg m-2 type(remapping_CS), intent(in) :: remapCS !< The remapping control structure type(regridding_CS), intent(in) :: CS !< Regridding control structure @@ -1568,13 +1572,14 @@ end subroutine build_grid_adaptive subroutine build_grid_SLight(G, GV, h, tv, dzInterface, CS) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Existing model thickness, in H units + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Existing model thickness, in H ~> m or kg m-2 type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: dzInterface !< Changes in interface position type(regridding_CS), intent(in) :: CS !< Regridding control structure - real, dimension(SZK_(GV)+1) :: z_col, z_col_new ! Interface positions relative to the surface in H units (m or kg m-2) - real, dimension(SZK_(GV)+1) :: dz_col ! The realized change in z_col in H units (m or kg m-2) + real, dimension(SZK_(GV)+1) :: z_col ! Interface positions relative to the surface in H ~> m or kg m-2 + real, dimension(SZK_(GV)+1) :: z_col_new ! Interface positions relative to the surface in H ~> m or kg m-2 + real, dimension(SZK_(GV)+1) :: dz_col ! The realized change in z_col in H ~> m or kg m-2 real, dimension(SZK_(GV)) :: p_col ! Layer pressure in Pa real :: depth integer :: i, j, k, nz @@ -1631,8 +1636,8 @@ end subroutine build_grid_SLight subroutine adjust_interface_motion( CS, nk, h_old, dz_int ) type(regridding_CS), intent(in) :: CS !< Regridding control structure integer, intent(in) :: nk !< Number of layers in h_old - real, dimension(nk), intent(in) :: h_old !< Minium allowed thickness of h (H units) - real, dimension(CS%nk+1), intent(inout) :: dz_int !< Minium allowed thickness of h (H units) + real, dimension(nk), intent(in) :: h_old !< Minium allowed thickness of h (H ~> m or kg m-2) + real, dimension(CS%nk+1), intent(inout) :: dz_int !< Minium allowed thickness of h (H ~> m or kg m-2) ! Local variables integer :: k real :: h_new, eps, h_total, h_err @@ -1697,9 +1702,10 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) ! Arguments type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(in) :: h !< Original layer thicknesses, in H - real, dimension(SZI_(G),SZJ_(G), SZK_(GV)+1), intent(inout) :: dzInterface !< The change in interface depth in H - real, intent(inout) :: h_new !< New layer thicknesses, in H + real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(in) :: h !< Original layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G), SZK_(GV)+1), intent(inout) :: dzInterface !< The change in interface + !! depth in H ~> m or kg m-2 + real, intent(inout) :: h_new !< New layer thicknesses, in H ~> m or kg m-2 type(regridding_CS), intent(in) :: CS !< Regridding control structure ! Local variables @@ -1803,7 +1809,7 @@ subroutine inflate_vanished_layers_old( CS, G, GV, h ) type(regridding_CS), intent(in) :: CS !< Regridding control structure type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2 ! Local variables integer :: i, j, k @@ -1835,7 +1841,7 @@ subroutine convective_adjustment(G, GV, h, tv) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables !------------------------------------------------------------------------------ ! Check each water column to see whether it is stratified. If not, sort the @@ -2202,8 +2208,8 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri real, optional, intent(in) :: min_thickness !< Minimum thickness allowed when building the new grid (H) real, optional, intent(in) :: old_grid_weight !< Weight given to old coordinate when time-filtering grid character(len=*), optional, intent(in) :: interp_scheme !< Interpolation method for state-dependent coordinates - real, optional, intent(in) :: depth_of_time_filter_shallow !< Depth to start cubic (H units) - real, optional, intent(in) :: depth_of_time_filter_deep !< Depth to end cubic (H units) + real, optional, intent(in) :: depth_of_time_filter_shallow !< Depth to start cubic (H ~> m or kg m-2) + real, optional, intent(in) :: depth_of_time_filter_deep !< Depth to end cubic (H ~> m or kg m-2) real, optional, intent(in) :: compress_fraction !< Fraction of compressibility to add to potential density real, optional, intent(in) :: dz_min_surface !< The fixed resolution in the topmost SLight_nkml_min layers (H) integer, optional, intent(in) :: nz_fixed_surface !< The number of fixed-thickness layers at the top of the model @@ -2219,7 +2225,7 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri logical, optional, intent(in) :: integrate_downward_for_e !< If true, integrate for interface positions downward !! from the top. real, optional, intent(in) :: adaptTimeRatio !< Ratio of the ALE timestep to the grid timescale, ND. - real, optional, intent(in) :: adaptZoom !< Depth of near-surface zooming region, in H. + real, optional, intent(in) :: adaptZoom !< Depth of near-surface zooming region, in H ~> m or kg m-2. real, optional, intent(in) :: adaptZoomCoeff !< Coefficient of near-surface zooming diffusivity, ND. real, optional, intent(in) :: adaptBuoyCoeff !< Coefficient of buoyancy diffusivity, ND. real, optional, intent(in) :: adaptAlpha !< Scaling factor on optimization tendency, ND. diff --git a/src/ALE/coord_adapt.F90 b/src/ALE/coord_adapt.F90 index 22e3c91610..b6a047c983 100644 --- a/src/ALE/coord_adapt.F90 +++ b/src/ALE/coord_adapt.F90 @@ -18,7 +18,7 @@ module coord_adapt !> Number of layers/levels integer :: nk - !> Nominal near-surface resolution in H + !> Nominal near-surface resolution in H ~> m or kg m-2 real, allocatable, dimension(:) :: coordinateResolution !> Ratio of optimisation and diffusion timescales @@ -27,7 +27,7 @@ module coord_adapt !> Nondimensional coefficient determining how much optimisation to apply real :: adaptAlpha - !> Near-surface zooming depth in H + !> Near-surface zooming depth in H ~> m or kg m-2 real :: adaptZoom !> Near-surface zooming coefficient @@ -93,7 +93,7 @@ subroutine set_adapt_params(CS, adaptTimeRatio, adaptAlpha, adaptZoom, adaptZoom real, optional, intent(in) :: adaptTimeRatio !< Ratio of optimisation and diffusion timescales real, optional, intent(in) :: adaptAlpha !< Nondimensional coefficient determining !! how much optimisation to apply - real, optional, intent(in) :: adaptZoom !< Near-surface zooming depth, in H + real, optional, intent(in) :: adaptZoom !< Near-surface zooming depth, in H ~> m or kg m-2 real, optional, intent(in) :: adaptZoomCoeff !< Near-surface zooming coefficient real, optional, intent(in) :: adaptBuoyCoeff !< Stratification-dependent diffusion coefficient real, optional, intent(in) :: adaptDrho0 !< Reference density difference for @@ -121,10 +121,10 @@ subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) !! thermodynamic variables integer, intent(in) :: i !< The i-index of the column to work on integer, intent(in) :: j !< The j-index of the column to work on - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: zInt !< Interface heights, in H (m or kg m-2). + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: zInt !< Interface heights, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: tInt !< Interface temperatures, in C real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: sInt !< Interface salinities, in psu - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 real, dimension(SZK_(GV)+1), intent(inout) :: zNext !< updated interface positions ! Local variables diff --git a/src/ALE/coord_hycom.F90 b/src/ALE/coord_hycom.F90 index aad807b62d..7341bf655d 100644 --- a/src/ALE/coord_hycom.F90 +++ b/src/ALE/coord_hycom.F90 @@ -99,12 +99,12 @@ subroutine build_hycom1_column(CS, eqn_of_state, nz, depth, h, T, S, p_col, & type(hycom_CS), intent(in) :: CS !< Coordinate control structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure integer, intent(in) :: nz !< Number of levels - real, intent(in) :: depth !< Depth of ocean bottom (positive in H) + real, intent(in) :: depth !< Depth of ocean bottom (positive in H ~> m or kg m-2) real, dimension(nz), intent(in) :: T !< Temperature of column (degC) real, dimension(nz), intent(in) :: S !< Salinity of column (psu) real, dimension(nz), intent(in) :: h !< Layer thicknesses, (in m or H) real, dimension(nz), intent(in) :: p_col !< Layer pressure in Pa - real, dimension(nz+1), intent(in) :: z_col !< Interface positions relative to the surface in H units (m or kg m-2) + real, dimension(nz+1), intent(in) :: z_col !< Interface positions relative to the surface in H ~> m or kg m-2 real, dimension(CS%nk+1), intent(inout) :: z_col_new !< Absolute positions of interfaces real, optional, intent(in) :: zScale !< Scaling factor from the input thicknesses in m !! to desired units for zInterface, perhaps m_to_H. diff --git a/src/ALE/coord_rho.F90 b/src/ALE/coord_rho.F90 index ff539cb474..b72dfd445c 100644 --- a/src/ALE/coord_rho.F90 +++ b/src/ALE/coord_rho.F90 @@ -96,7 +96,7 @@ subroutine build_rho_column(CS, nz, depth, h, T, S, eqn_of_state, z_interface, & type(rho_CS), intent(in) :: CS !< coord_rho control structure integer, intent(in) :: nz !< Number of levels on source grid (i.e. length of h, T, S) real, intent(in) :: depth !< Depth of ocean bottom (positive in m) - real, dimension(nz), intent(in) :: h !< Layer thicknesses, in H + real, dimension(nz), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 real, dimension(nz), intent(in) :: T !< T for source column real, dimension(nz), intent(in) :: S !< S for source column type(EOS_type), pointer :: eqn_of_state !< Equation of state structure diff --git a/src/ALE/coord_sigma.F90 b/src/ALE/coord_sigma.F90 index addb313a37..d16d743838 100644 --- a/src/ALE/coord_sigma.F90 +++ b/src/ALE/coord_sigma.F90 @@ -51,7 +51,7 @@ end subroutine end_coord_sigma !> This subroutine can be used to set the parameters for the coord_sigma module subroutine set_sigma_params(CS, min_thickness) type(sigma_CS), pointer :: CS !< Coordinate control structure - real, optional, intent(in) :: min_thickness !< Minimum allowed thickness, in H + real, optional, intent(in) :: min_thickness !< Minimum allowed thickness, in H ~> m or kg m-2 if (.not. associated(CS)) call MOM_error(FATAL, "set_sigma_params: CS not associated") @@ -62,9 +62,9 @@ end subroutine set_sigma_params !> Build a sigma coordinate column subroutine build_sigma_column(CS, depth, totalThickness, zInterface) type(sigma_CS), intent(in) :: CS !< Coordinate control structure - real, intent(in) :: depth !< Depth of ocean bottom (positive in H, often m) - real, intent(in) :: totalThickness !< Column thickness (positive in H) - real, dimension(CS%nk+1), intent(inout) :: zInterface !< Absolute positions of interfaces in H + real, intent(in) :: depth !< Depth of ocean bottom (positive in H ~> m or kg m-2) + real, intent(in) :: totalThickness !< Column thickness (positive in H ~> m or kg m-2) + real, dimension(CS%nk+1), intent(inout) :: zInterface !< Absolute positions of interfaces in H ~> m or kg m-2 ! Local variables integer :: k diff --git a/src/ALE/coord_slight.F90 b/src/ALE/coord_slight.F90 index 7090bb4429..cad0cfb824 100644 --- a/src/ALE/coord_slight.F90 +++ b/src/ALE/coord_slight.F90 @@ -45,7 +45,7 @@ module coord_slight logical :: fix_haloclines = .false. !> A length scale over which to filter T & S when looking for spuriously - !! unstable water mass profiles, in H. + !! unstable water mass profiles, in H ~> m or kg m-2. real :: halocline_filter_length !> A value of the stratification ratio that defines a problematic halocline region (nondim). @@ -54,10 +54,10 @@ module coord_slight !> Nominal density of interfaces, in kg m-3. real, allocatable, dimension(:) :: target_density - !> Maximum depths of interfaces, in H. + !> Maximum depths of interfaces, in H ~> m or kg m-2. real, allocatable, dimension(:) :: max_interface_depths - !> Maximum thicknesses of layers, in H. + !> Maximum thicknesses of layers, in H ~> m or kg m-2. real, allocatable, dimension(:) :: max_layer_thickness !> Interpolation control structure @@ -117,11 +117,11 @@ subroutine set_slight_params(CS, max_interface_depths, max_layer_thickness, & halocline_filter_length, halocline_strat_tol, interp_CS) type(slight_CS), pointer :: CS !< Coordinate control structure real, dimension(:), & - optional, intent(in) :: max_interface_depths !< Maximum depths of interfaces in H + optional, intent(in) :: max_interface_depths !< Maximum depths of interfaces in H ~> m or kg m-2 real, dimension(:), & - optional, intent(in) :: max_layer_thickness !< Maximum thicknesses of layers in H + optional, intent(in) :: max_layer_thickness !< Maximum thicknesses of layers in H ~> m or kg m-2 real, optional, intent(in) :: min_thickness !< Minimum thickness allowed when building the - !! new grid through regridding, in H + !! new grid through regridding, in H ~> m or kg m-2 real, optional, intent(in) :: compressibility_fraction !< Fraction (between 0 and 1) of !! compressibility to add to potential density profiles when !! interpolating for target grid positions. (nondim) @@ -136,7 +136,7 @@ subroutine set_slight_params(CS, max_interface_depths, max_layer_thickness, & logical, optional, intent(in) :: fix_haloclines !< If true, detect regions with much weaker than !! based on in-situ density, and use a stretched coordinate there. real, optional, intent(in) :: halocline_filter_length !< A length scale over which to filter T & S - !! when looking for spuriously unstable water mass profiles, in H. + !! when looking for spuriously unstable water mass profiles, in H ~> m or kg m-2. real, optional, intent(in) :: halocline_strat_tol !< A value of the stratification ratio that !! defines a problematic halocline region (nondim). type(interp_CS_type), & @@ -185,17 +185,17 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_Pa, H_subroundoff, & real, intent(in) :: H_to_Pa !< GV%H_to_Pa real, intent(in) :: H_subroundoff !< GV%H_subroundoff integer, intent(in) :: nz !< Number of levels - real, intent(in) :: depth !< Depth of ocean bottom (positive in H) + real, intent(in) :: depth !< Depth of ocean bottom (positive in H ~> m or kg m-2) real, dimension(nz), intent(in) :: T_col !< T for column real, dimension(nz), intent(in) :: S_col !< S for column - real, dimension(nz), intent(in) :: h_col !< Layer thicknesses, in H units (m or kg m-2) + real, dimension(nz), intent(in) :: h_col !< Layer thicknesses, in H ~> m or kg m-2 real, dimension(nz), intent(in) :: p_col !< Layer quantities - real, dimension(nz+1), intent(in) :: z_col !< Interface positions relative to the surface in H - real, dimension(nz+1), intent(inout) :: z_col_new !< Absolute positions of interfaces in H + real, dimension(nz+1), intent(in) :: z_col !< Interface positions relative to the surface in H ~> m or kg m-2 + real, dimension(nz+1), intent(inout) :: z_col_new !< Absolute positions of interfaces in H ~> m or kg m-2 real, optional, intent(in) :: h_neglect !< A negligibly small width for the purpose of - !! cell reconstructions in H. + !! cell reconstructions in H ~> m or kg m-2. real, optional, intent(in) :: h_neglect_edge !< A negligibly small width for the purpose - !! of edge value calculations in H. + !! of edge value calculations in H ~> m or kg m-2. ! Local variables real, dimension(nz) :: rho_col ! Layer quantities real, dimension(nz) :: T_f, S_f ! Filtered ayer quantities @@ -208,20 +208,20 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_Pa, H_subroundoff, & real :: H_to_cPa real :: drIS, drR, Fn_now, I_HStol, Fn_zero_val real :: z_int_unst - real :: dz ! A uniform layer thickness in very shallow water, in H. - real :: dz_ur ! The total thickness of an unstable region, in H. + real :: dz ! A uniform layer thickness in very shallow water, in H ~> m or kg m-2. + real :: dz_ur ! The total thickness of an unstable region, in H ~> m or kg m-2. real :: wgt, cowgt ! A weight and its complement, nondim. real :: rho_ml_av ! The average potential density in a near-surface region, in kg m-3. - real :: H_ml_av ! A thickness to try to use in taking the near-surface average, in H. + real :: H_ml_av ! A thickness to try to use in taking the near-surface average, in H ~> m or kg m-2. real :: rho_x_z ! A cumulative integral of a density, in kg m-3 H. - real :: z_wt ! The thickness actually used in taking the near-surface average, in H. + real :: z_wt ! The thickness actually used in taking the near-surface average, in H ~> m or kg m-2. real :: k_interior ! The (real) value of k where the interior grid starts. real :: k_int2 ! The (real) value of k where the interior grid starts. - real :: z_interior ! The depth where the interior grid starts, in H. - real :: z_ml_fix ! The depth at which the fixed-thickness near-surface layers end, in H. + real :: z_interior ! The depth where the interior grid starts, in H ~> m or kg m-2. + real :: z_ml_fix ! The depth at which the fixed-thickness near-surface layers end, in H ~> m or kg m-2. real :: dz_dk ! The thickness of layers between the fixed-thickness - ! near-surface layars and the interior, in H. - real :: Lfilt ! A filtering lengthscale, in H. + ! near-surface layars and the interior, in H ~> m or kg m-2. + real :: Lfilt ! A filtering lengthscale, in H ~> m or kg m-2. logical :: maximum_depths_set ! If true, the maximum depths of interface have been set. logical :: maximum_h_set ! If true, the maximum layer thicknesses have been set. real :: k2_used, k2here, dz_sum, z_max diff --git a/src/ALE/coord_zlike.F90 b/src/ALE/coord_zlike.F90 index 78e38ecd1b..7016605d5d 100644 --- a/src/ALE/coord_zlike.F90 +++ b/src/ALE/coord_zlike.F90 @@ -52,7 +52,7 @@ end subroutine end_coord_zlike !> Set parameters in the zlike structure subroutine set_zlike_params(CS, min_thickness) type(zlike_CS), pointer :: CS !< Coordinate control structure - real, optional, intent(in) :: min_thickness !< Minimum allowed thickness, in H + real, optional, intent(in) :: min_thickness !< Minimum allowed thickness, in H ~> m or kg m-2 if (.not. associated(CS)) call MOM_error(FATAL, "set_zlike_params: CS not associated") diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 0c4927abc1..fb7f9fc252 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -250,7 +250,7 @@ module MOM type(time_type) :: Z_diag_time !< next time to compute Z-space diagnostics real, dimension(:,:,:), pointer :: & - h_pre_dyn => NULL(), & !< The thickness before the transports, in H. + h_pre_dyn => NULL(), & !< The thickness before the transports, in H ~> m or kg m-2. T_pre_dyn => NULL(), & !< Temperature before the transports, in degC. S_pre_dyn => NULL() !< Salinity before the transports, in psu. type(accel_diag_ptrs) :: ADp !< structure containing pointers to accelerations, diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 948901ac63..b545ea2b78 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -143,13 +143,13 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) KE ! Kinetic energy per unit mass, KE = (u^2 + v^2)/2, in m2 s-2. real, dimension(SZIB_(G),SZJ_(G)) :: & hArea_u, & ! The cell area weighted thickness interpolated to u points - ! times the effective areas, in H m2. + ! times the effective areas, in H m2 ~> m3 or kg. KEx, & ! The zonal gradient of Kinetic energy per unit mass, ! KEx = d/dx KE, in m s-2. uh_center ! centered u times h at u-points real, dimension(SZI_(G),SZJB_(G)) :: & hArea_v, & ! The cell area weighted thickness interpolated to v points - ! times the effective areas, in H m2. + ! times the effective areas, in H m2 ~> m3 or kg. KEy, & ! The meridonal gradient of Kinetic energy per unit mass, ! KEy = d/dy KE, in m s-2. vh_center ! centered v times h at v-points diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index a872a5b88f..58098d785c 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -49,7 +49,7 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: PFu !< Zonal pressure force acceleration (m/s2) @@ -65,7 +65,7 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e !! due to eta anomalies, in m2 s-2 H-1. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(out) :: eta !< The bottom mass used to calculate PFu and PFv, - !! in H, with any tidal contributions. + !! in H ~> m or kg m-2, with any tidal contributions. if (CS%Analytic_FV_PGF .and. CS%blocked_AFV) then if (GV%Boussinesq) then diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 190cb3fc29..583d3c0729 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -621,7 +621,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) !! compensated), times g/rho_0, in m2 Z-1 s-2 ~> m s-2. ! Local variables - real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer thicknesses, in H-1. + real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer thicknesses, in H-1 ~> m-1 or m2 kg-1. real :: press(SZI_(G)) ! Interface pressure, in Pa. real :: T_int(SZI_(G)) ! Interface temperature in C. real :: S_int(SZI_(G)) ! Interface salinity in PSU. @@ -629,7 +629,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) real :: dR_dS(SZI_(G)) ! and salinity in kg m-3 K-1 and kg m-3 PSU-1. real :: rho_in_situ(SZI_(G)) !In-situ density at the top of a layer. real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1. - real :: Rho0xG ! g_Earth * Rho0 in kg s-2 m-1 Z-1 ~> kg m-2 m-2. + real :: Rho0xG ! g_Earth * Rho0 in kg s-2 m-1 Z-1 ~> kg s-2 m-2. logical :: use_EOS ! If true, density is calculated from T & S using ! an equation of state. real :: z_neglect ! A thickness that is so small it is usually lost diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 058051ff53..41b5ebe037 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -78,7 +78,7 @@ subroutine PressureForce_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbc !! anomaly in each layer due to eta anomalies, !! in m2 s-2 H-1. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to - !! calculate PFu and PFv, in H, with any tidal + !! calculate PFu and PFv, in H ~> m or kg m-2, with any tidal !! contributions or compressibility compensation. if (GV%Boussinesq) then @@ -115,7 +115,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p !! anomaly in each layer due to eta anomalies, !! in m2 s-2 H-1. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to - !! calculate PFu and PFv, in H, with any tidal + !! calculate PFu and PFv, in H ~> m or kg m-2, with any tidal !! contributions or compressibility compensation. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure in Pa. @@ -457,8 +457,8 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at !! anomaly in each layer due to eta anomalies, !! in m2 s-2 H-1. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to - !! calculate PFu and PFv, in H, with any tidal - !! contributions or compressibility compensation. + !! calculate PFu and PFv, in H ~> m or kg m-2, with any + !! tidal contributions or compressibility compensation. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in depth units (Z ~> m). real, dimension(SZI_(G),SZJ_(G)) :: & @@ -475,8 +475,8 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at ! the interface atop a layer, in Pa. dpa, & ! The change in pressure anomaly between the top and bottom ! of a layer, in Pa. - intz_dpa ! The vertical integral in depth of the pressure anomaly less - ! the pressure anomaly at the top of the layer, in H Pa (m Pa). + intz_dpa ! The vertical integral in depth of the pressure anomaly less the + ! pressure anomaly at the top of the layer, in H Pa ~> m Pa or kg m-2 Pa. real, dimension(SZIB_(G),SZJ_(G)) :: & intx_pa, & ! The zonal integral of the pressure anomaly along the interface ! atop a layer, divided by the grid spacing, in Pa. diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 4dc8c54e97..cbbb481037 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -78,7 +78,7 @@ subroutine PressureForce_blk_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, !! anomaly in each layer due to eta anomalies, !! in m2 s-2 H-1. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to - !! calculate PFu and PFv, in H, with any tidal + !! calculate PFu and PFv, in H ~> m or kg m-2, with any tidal !! contributions or compressibility compensation. if (GV%Boussinesq) then @@ -114,7 +114,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, !! anomaly in each layer due to eta anomalies, !! in m2 s-2 H-1. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to - !! calculate PFu and PFv, in H, with any tidal + !! calculate PFu and PFv, in H ~> m or kg m-2, with any tidal !! contributions or compressibility compensation. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure in Pa. @@ -428,7 +428,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H ~> m or kg m-2 type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration (m/s2) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration (m/s2) @@ -440,7 +440,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, !! anomaly in each layer due to eta anomalies, !! in m2 s-2 H-1. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to - !! calculate PFu and PFv, in H, with any tidal + !! calculate PFu and PFv, in H ~> m or kg m-2, with any tidal !! contributions or compressibility compensation. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in depth units (Z ~> m). @@ -458,8 +458,8 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, ! the interface atop a layer, in Pa. dpa_bk, & ! The change in pressure anomaly between the top and bottom ! of a layer, in Pa. - intz_dpa_bk ! The vertical integral in depth of the pressure anomaly less - ! the pressure anomaly at the top of the layer, in H Pa (m Pa). + intz_dpa_bk ! The vertical integral in depth of the pressure anomaly less the + ! pressure anomaly at the top of the layer, in H Pa ~> m Pa or kg m-2 Pa. real, dimension(SZDIB_(G%Block(1)),SZDJ_(G%Block(1))) :: & ! on block indices intx_pa_bk, & ! The zonal integral of the pressure anomaly along the interface ! atop a layer, divided by the grid spacing, in Pa. @@ -482,7 +482,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, ! density, in Pa (usually 2e7 Pa = 2000 dbar). real :: p0(SZI_(G)) ! An array of zeros to use for pressure in Pa. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. + ! in roundoff and can be neglected, in H ~> m or kg m-2. real :: I_Rho0 ! 1/Rho0. real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2 ~> m s-2. real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index fb08e18ea8..8bd76196b6 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -66,20 +66,20 @@ module MOM_barotropic type, private :: BT_OBC_type real, dimension(:,:), pointer :: Cg_u => NULL() !< The external wave speed at u-points, in m s-1. real, dimension(:,:), pointer :: Cg_v => NULL() !< The external wave speed at u-points, in m s-1. - real, dimension(:,:), pointer :: H_u => NULL() !< The total thickness at the u-points, in H (m or kg m-2). - real, dimension(:,:), pointer :: H_v => NULL() !< The total thickness at the v-points, in H (m or kg m-2). + real, dimension(:,:), pointer :: H_u => NULL() !< The total thickness at the u-points, in H ~> m or kg m-2. + real, dimension(:,:), pointer :: H_v => NULL() !< The total thickness at the v-points, in H ~> m or kg m-2. real, dimension(:,:), pointer :: uhbt => NULL() !< The zonal barotropic thickness fluxes specified - !! for open boundary conditions (if any), in units of H m2 s-1. + !! for open boundary conditions (if any), in H m2 s-1 ~> m3 s-1 or kg s-1. real, dimension(:,:), pointer :: vhbt => NULL() !< The meridional barotropic thickness fluxes specified - !! for open boundary conditions (if any), in units of H m2 s-1. + !! for open boundary conditions (if any), in H m2 s-1 ~> m3 s-1 or kg s-1. real, dimension(:,:), pointer :: ubt_outer => NULL() !< The zonal velocities just outside the domain, !! as set by the open boundary conditions, in units of m s-1. real, dimension(:,:), pointer :: vbt_outer => NULL() !< The meridional velocities just outside the domain, !! as set by the open boundary conditions, in units of m s-1. real, dimension(:,:), pointer :: eta_outer_u => NULL() !< The surface height outside of the domain - !! at a u-point with an open boundary condition, in units of H. + !! at a u-point with an open boundary condition, in H ~> m or kg m-2. real, dimension(:,:), pointer :: eta_outer_v => NULL() !< The surface height outside of the domain - !! at a v-point with an open boundary condition, in units of H. + !! at a v-point with an open boundary condition, in H ~> m or kg m-2. logical :: apply_u_OBCs !< True if this PE has an open boundary at a u-point. logical :: apply_v_OBCs !< True if this PE has an open boundary at a v-point. !>@{ Index ranges for the open boundary conditions @@ -104,10 +104,11 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: IDatu !< Inverse of the basin depth at u grid points, in Z-1 ~> m-1. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: lin_drag_u - !< A spatially varying linear drag coefficient acting on the zonal barotropic flow, in H s-1. + !< A spatially varying linear drag coefficient acting on the zonal barotropic flow, + !! in H s-1 ~> m s-1 or kg m-2 s-1. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt_IC !< The barotropic solvers estimate of the zonal transport as the initial condition for - !! the next call to btstep, in H m2 s-1. + !! the next call to btstep, in H m2 s-1 ~> m2 s-1 or kg s-1. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: ubt_IC !< The barotropic solvers estimate of the zonal velocity that will be the initial !! condition for the next call to btstep, in m s-1. @@ -116,10 +117,11 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: IDatv !< Inverse of the basin depth at v grid points, in Z-1 ~> m-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: lin_drag_v - !< A spatially varying linear drag coefficient acting on the zonal barotropic flow, in H s-1. + !< A spatially varying linear drag coefficient acting on the zonal barotropic flow, + !! in H s-1 ~> m s-1 or kg m-2 s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt_IC !< The barotropic solvers estimate of the zonal transport as the initial condition for - !! the next call to btstep, in H m2 s-1. + !! the next call to btstep, in H m2 s-1 ~> m2 s-1 or kg s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vbt_IC !< The barotropic solvers estimate of the zonal velocity that will be the initial !! condition for the next call to btstep, in m s-1. @@ -128,10 +130,10 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_cor !< The difference between the free surface height from the barotropic calculation and the sum !! of the layer thicknesses. This difference is imposed as a forcing term in the barotropic - !! calculation over a baroclinic timestep, in H (m or kg m-2). + !! calculation over a baroclinic timestep, in H ~> m or kg m-2. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_cor_bound - !< A limit on the rate at which eta_cor can be applied while avoiding instability, in units of H s-1. - !! This is only used if CS%bound_BT_corr is true. + !< A limit on the rate at which eta_cor can be applied while avoiding instability, + !! in H s-1 ~> m s-1 or kg m-2 s-1. This is only used if CS%bound_BT_corr is true. real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: & ua_polarity, & !< Test vector components for checking grid polarity. va_polarity, & !< Test vector components for checking grid polarity. @@ -311,40 +313,40 @@ module MOM_barotropic !> A desciption of the functional dependence of transport at a u-point type, private :: local_BT_cont_u_type real :: FA_u_EE !< The effective open face area for zonal barotropic transport - !! drawing from locations far to the east, in H m. + !! drawing from locations far to the east, in H m ~> m2 or kg m-1. real :: FA_u_E0 !< The effective open face area for zonal barotropic transport - !! drawing from nearby to the east, in H m. + !! drawing from nearby to the east, in H m ~> m2 or kg m-1. real :: FA_u_W0 !< The effective open face area for zonal barotropic transport - !! drawing from nearby to the west, in H m. + !! drawing from nearby to the west, in H m ~> m2 or kg m-1. real :: FA_u_WW !< The effective open face area for zonal barotropic transport - !! drawing from locations far to the west, in H m. + !! drawing from locations far to the west, in H m ~> m2 or kg m-1. real :: uBT_WW !< uBT_WW is the barotropic velocity, in m s-1, beyond which the marginal !! open face area is FA_u_WW. uBT_WW must be non-negative. real :: uBT_EE !< uBT_EE is a barotropic velocity, in m s-1, beyond which the marginal !! open face area is FA_u_EE. uBT_EE must be non-positive. - real :: uh_crvW !< The curvature of face area with velocity for flow from the west, in H s2 m-1. - real :: uh_crvE !< The curvature of face area with velocity for flow from the east, in H s2 m-1. - real :: uh_WW !< The zonal transport when ubt=ubt_WW, in H m2 s-1. - real :: uh_EE !< The zonal transport when ubt=ubt_EE, in H m2 s-1. + real :: uh_crvW !< The curvature of face area with velocity for flow from the west, in H s2 m-1 ~> s2 or kg s2 m-3. + real :: uh_crvE !< The curvature of face area with velocity for flow from the east, in H s2 m-1 ~> s2 or kg s2 m-3. + real :: uh_WW !< The zonal transport when ubt=ubt_WW, in H m2 s-1 ~> m2 s-1 or kg s-1. + real :: uh_EE !< The zonal transport when ubt=ubt_EE, in H m2 s-1 ~> m2 s-1 or kg s-1. end type local_BT_cont_u_type !> A desciption of the functional dependence of transport at a v-point type, private :: local_BT_cont_v_type real :: FA_v_NN !< The effective open face area for meridional barotropic transport - !! drawing from locations far to the north, in H m. + !! drawing from locations far to the north, in H m ~> m2 or kg m-1. real :: FA_v_N0 !< The effective open face area for meridional barotropic transport - !! drawing from nearby to the north, in H m. + !! drawing from nearby to the north, in H m ~> m2 or kg m-1. real :: FA_v_S0 !< The effective open face area for meridional barotropic transport - !! drawing from nearby to the south, in H m. + !! drawing from nearby to the south, in H m ~> m2 or kg m-1. real :: FA_v_SS !< The effective open face area for meridional barotropic transport - !! drawing from locations far to the south, in H m. + !! drawing from locations far to the south, in H m ~> m2 or kg m-1. real :: vBT_SS !< vBT_SS is the barotropic velocity, in m s-1, beyond which the marginal !! open face area is FA_v_SS. vBT_SS must be non-negative. real :: vBT_NN !< vBT_NN is the barotropic velocity, in m s-1, beyond which the marginal !! open face area is FA_v_NN. vBT_NN must be non-positive. - real :: vh_crvS !< The curvature of face area with velocity for flow from the south, in H s2 m-1. - real :: vh_crvn !< The curvature of face area with velocity for flow from the north, in H s2 m-1. - real :: vh_SS !< The meridional transport when vbt=vbt_SS, in H m2 s-1. - real :: vh_NN !< The meridional transport when vbt=vbt_NN, in H m2 s-1. + real :: vh_crvS !< The curvature of face area with velocity for flow from the south, in H s2 m-1 ~> s2 or kg s2 m-3. + real :: vh_crvn !< The curvature of face area with velocity for flow from the north, in H s2 m-1 ~> s2 or kg s2 m-3. + real :: vh_SS !< The meridional transport when vbt=vbt_SS, in H m2 s-1 ~> m2 s-1 or kg s-1. + real :: vh_NN !< The meridional transport when vbt=vbt_NN, in H m2 s-1 ~> m2 s-1 or kg s-1. end type local_BT_cont_v_type !> A container for passing around active tracer point memory limits @@ -392,7 +394,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_in !< The initial (3-D) zonal velocity, in m s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_in !< The initial (3-D) meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta_in !< The initial barotropic free surface height - !! anomaly or column mass anomaly, in H (m or kg m-2). + !! anomaly or column mass anomaly, in H ~> m or kg m-2. real, intent(in) :: dt !< The time increment to integrate over. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: bc_accel_u !< The zonal baroclinic accelerations, in m s-2. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: bc_accel_v !< The meridional baroclinic accelerations, @@ -444,10 +446,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, dimension(:,:), optional, pointer :: tauy_bot !< The meridional bottom frictional stress !! from ocean to the seafloor, in Pa. real, dimension(:,:,:), optional, pointer :: uh0 !< The zonal layer transports at reference - !! velocities, in H m s-1. + !! velocities, in H m s-1 ~> m2 s-1 or kg m-1 s-1. real, dimension(:,:,:), optional, pointer :: u_uh0 !< The velocities used to calculate uh0, in m s-1 real, dimension(:,:,:), optional, pointer :: vh0 !< The zonal layer transports at reference - !! velocities, in H m s-1. + !! velocities, in H m s-1 ~> m2 s-1 or kg m-1 s-1. real, dimension(:,:,:), optional, pointer :: v_vh0 !< The velocities used to calculate vh0, in m s-1 ! Local variables @@ -481,14 +483,14 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! not explicitly included in the barotropic equation, m s-2. u_accel_bt, & ! The difference between the zonal acceleration from the ! barotropic calculation and BT_force_u, in m s-2. - uhbt, & ! The zonal barotropic thickness fluxes, in H m2 s-1. + uhbt, & ! The zonal barotropic thickness fluxes, in H m2 s-1 ~> m2 s-1 or kg s-1. uhbt0, & ! The difference between the sum of the layer zonal thickness ! fluxes and the barotropic thickness flux using the same - ! velocity, in H m2 s-1. + ! velocity, in H m2 s-1 ~> m2 s-1 or kg s-1. ubt_old, & ! The starting value of ubt in a barotropic step, in m s-1. ubt_first, & ! The starting value of ubt in a series of barotropic steps, in m s-1. ubt_sum, & ! The sum of ubt over the time steps, in m s-1. - uhbt_sum, & ! The sum of uhbt over the time steps, in H m2 s-1. + uhbt_sum, & ! The sum of uhbt over the time steps, in H m2 s-1 ~> m2 s-1 or kg s-1. ubt_wtd, & ! A weighted sum used to find the filtered final ubt, in m s-1. ubt_trans, & ! The latest value of ubt used for a transport, in m s-1. azon, bzon, & ! _zon & _mer are the values of the Coriolis force which @@ -504,7 +506,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, Coru_bt_sum, & ! The summed zonal barotropic Coriolis acceleration, in m s-2. DCor_u, & ! A simply averaged depth at u points, in Z ~> m. Datu ! Basin depth at u-velocity grid points times the y-grid - ! spacing, in H m. + ! spacing, in H m ~> m2 or kg m-1. real, dimension(SZIW_(CS),SZJBW_(CS)) :: & vbt, & ! The meridional barotropic velocity in m s-1. bt_rem_v, & ! The fraction of the barotropic meridional velocity that @@ -514,14 +516,14 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! not explicitly included in the barotropic equation, m s-2. v_accel_bt, & ! The difference between the meridional acceleration from the ! barotropic calculation and BT_force_v, in m s-2. - vhbt, & ! The meridional barotropic thickness fluxes, in H m2 s-1. + vhbt, & ! The meridional barotropic thickness fluxes, in H m2 s-1 ~> m2 s-1 or kg s-1. vhbt0, & ! The difference between the sum of the layer meridional ! thickness fluxes and the barotropic thickness flux using - ! the same velocities, in H m2 s-1. + ! the same velocities, in H m2 s-1 ~> m2 s-1 or kg s-1. vbt_old, & ! The starting value of vbt in a barotropic step, in m s-1. vbt_first, & ! The starting value of ubt in a series of barotropic steps, in m s-1. vbt_sum, & ! The sum of vbt over the time steps, in m s-1. - vhbt_sum, & ! The sum of vhbt over the time steps, in H m2 s-1. + vhbt_sum, & ! The sum of vhbt over the time steps, in H m2 s-1 ~> m2 s-1 or kg s-1. vbt_wtd, & ! A weighted sum used to find the filtered final vbt, in m s-1. vbt_trans, & ! The latest value of vbt used for a transport, in m s-1. Cor_v, & ! The meridional Coriolis acceleration, in m s-2. @@ -535,14 +537,14 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! in m s-2. DCor_v, & ! A simply averaged depth at v points, in Z ~> m. Datv ! Basin depth at v-velocity grid points times the x-grid - ! spacing, in H m. + ! spacing, in H m ~> m2 or kg m-1. real, target, dimension(SZIW_(CS),SZJW_(CS)) :: & eta, & ! The barotropic free surface height anomaly or column mass - ! anomaly, in H (m or kg m-2) - eta_pred ! A predictor value of eta, in H (m or kg m-2) like eta. + ! anomaly, in H ~> m or kg m-2 + eta_pred ! A predictor value of eta, in H ~> m or kg m-2 like eta. real, dimension(:,:), pointer :: & eta_PF_BT ! A pointer to the eta array (either eta or eta_pred) that - ! determines the barotropic pressure force, in H (m or kg m-2) + ! determines the barotropic pressure force, in H ~> m or kg m-2 real, dimension(SZIW_(CS),SZJW_(CS)) :: & eta_sum, & ! eta summed across the timesteps, in m or kg m-2. eta_wtd, & ! A weighted estimate used to calculate eta_out, in m or kg m-2. @@ -609,13 +611,13 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real :: Idt_max2 ! The squared inverse of the local maximum stable ! barotropic time step, in s-2. real :: H_min_dyn ! The minimum depth to use in limiting the size of the - ! dynamic surface pressure for stability, in H. + ! dynamic surface pressure for stability, in H ~> m or kg m-2. real :: H_eff_dx2 ! The effective total thickness divided by the grid spacing - ! squared, in H m-2. + ! squared, in H m-2 ~> m-1 or kg m-4. real :: vel_tmp ! A temporary velocity, in m s-1. real :: u_max_cor, v_max_cor ! The maximum corrective velocities, in m s-1. - real :: Htot ! The total thickness, in units of H. - real :: eta_cor_max ! The maximum fluid that can be added as a correction to eta, in H. + real :: Htot ! The total thickness, in H ~> m or kg m-2. + real :: eta_cor_max ! The maximum fluid that can be added as a correction to eta, in H ~> m or kg m-2. real :: accel_underflow ! An acceleration that is so small it should be zeroed out. real, allocatable, dimension(:) :: wt_vel, wt_eta, wt_accel, wt_trans, wt_accel2 @@ -2268,7 +2270,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(barotropic_CS), pointer :: CS !< Barotropic control structure. real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta !< The barotropic free surface - !! height anomaly or column mass anomaly, in H. + !! height anomaly or column mass anomaly, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: pbce !< The baroclinic pressure !! anomaly in each layer due to free surface !! height anomalies, in m2 H-1 s-2. @@ -2291,10 +2293,10 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) ! (See Hallberg, J Comp Phys 1997 for a discussion.) real, dimension(SZIBS_(G),SZJ_(G)) :: & Datu ! Basin depth at u-velocity grid points times the y-grid - ! spacing, in H m. + ! spacing, in H m ~> m2 or kg m-1. real, dimension(SZI_(G),SZJBS_(G)) :: & Datv ! Basin depth at v-velocity grid points times the x-grid - ! spacing, in H m. + ! spacing, in H m ~> m2 or kg m-1. real :: det_de ! The partial derivative due to self-attraction and loading ! of the reference geopotential with the sea surface height. ! This is typically ~0.09 or less. @@ -2386,11 +2388,13 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of !! the argument arrays. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt !< the zonal barotropic velocity, in m s-1. - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: uhbt !< the zonal barotropic transport, in H m2 s-1. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: uhbt !< the zonal barotropic transport, + !! in H m2 s-1 ~> m2 s-1 or kg s-1. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_trans !< the zonal barotropic velocity used in !! transport, m s-1. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt !< the meridional barotropic velocity, in m s-1. - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vhbt !< the meridional barotropic transport, in H m2 s-1. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vhbt !< the meridional barotropic transport, + !! in H m2 s-1 ~> m2 s-1 or kg s-1. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt_trans !< the meridional BT velocity used in transports, !! m s-1. real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or @@ -2409,9 +2413,9 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate !! transports. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points, - !! in H m. + !! in H m ~> m2 or kg m-1. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points, - !! in H m. + !! in H m ~> m2 or kg m-1. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used !! for a dynamic estimate of the face areas at !! u-points. @@ -2420,17 +2424,19 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, !! v-points. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: uhbt0 !< A correction to the zonal transport so that !! the barotropic functions agree with the sum - !! of the layer transpotts, in H m2 s-1. + !! of the layer transports, + !! in H m2 s-1 ~> m2 s-1 or kg s-1. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vhbt0 !< A correction to the meridional transport so that !! the barotropic functions agree with the sum - !! of the layer transpotts, in H m2 s-1. + !! of the layer transports, + !! in H m2 s-1 ~> m2 s-1 or kg s-1. ! Local variables real :: vel_prev ! The previous velocity in m s-1. real :: vel_trans ! The combination of the previous and current velocity ! that does the mass transport, in m s-1. - real :: H_u ! The total thickness at the u-point, in H (often m or kg m-2). - real :: H_v ! The total thickness at the v-point, in H (often m or kg m-2). + real :: H_u ! The total thickness at the u-point, in H ~> m or kg m-2. + real :: H_v ! The total thickness at the v-point, in H ~> m or kg m-2. real :: cfl ! The CFL number at the point in question, ND. real :: u_inlet real :: v_inlet @@ -2566,9 +2572,9 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate !! transports. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points, - !! in H m. + !! in H m ~> m2 or kg m-1. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points, - !! in H m. + !! in H m ~> m2 or kg m-1. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used !! for a dynamic estimate of the face areas at !! u-points. @@ -2758,7 +2764,7 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. type(barotropic_CS), pointer :: CS !< The control structure returned by a previous !! call to barotropic_init. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -2767,7 +2773,7 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) optional, intent(in) :: h_v !< The specified thicknesses at v-points, in m or kg m-2. logical, optional, intent(in) :: may_use_default !< An optional logical argument !! to indicate that the default velocity point - !! thickesses may be used for this particular + !! thicknesses may be used for this particular !! calculation, even though the setting of !! CS%hvel_scheme would usually require that h_u !! and h_v be passed in. @@ -2778,21 +2784,21 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) real :: hatutot(SZIB_(G)) ! The sum of the layer thicknesses real :: hatvtot(SZI_(G)) ! interpolated to the u & v grid points. real :: Ihatutot(SZIB_(G)) ! Ihatutot and Ihatvtot are the inverses - real :: Ihatvtot(SZI_(G)) ! of hatutot and hatvtot, both in H-1. - real :: h_arith ! The arithmetic mean thickness, in H. - real :: h_harm ! The harmonic mean thicknesses, in H. + real :: Ihatvtot(SZI_(G)) ! of hatutot and hatvtot, both in H-1 ~> m-1 or m2 kg-1. + real :: h_arith ! The arithmetic mean thickness, in H ~> m or kg m-2. + real :: h_harm ! The harmonic mean thicknesses, in H ~> m or kg m-2. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. + ! in roundoff and can be neglected, in H ~> m or kg m-2. real :: wt_arith ! The nondimensional weight for the arithmetic ! mean thickness. The harmonic mean uses ! a weight of (1 - wt_arith). real :: Rh ! A ratio of summed thicknesses, nondim. real :: e_u(SZIB_(G),SZK_(G)+1) ! The interface heights at u-velocity and - real :: e_v(SZI_(G),SZK_(G)+1) ! v-velocity points in H. - real :: D_shallow_u(SZI_(G)) ! The shallower of the adjacent depths in H. - real :: D_shallow_v(SZIB_(G))! The shallower of the adjacent depths in H. - real :: htot ! The sum of the layer thicknesses, in H. - real :: Ihtot ! The inverse of htot, in H-1. + real :: e_v(SZI_(G),SZK_(G)+1) ! v-velocity points in H ~> m or kg m-2. + real :: D_shallow_u(SZI_(G)) ! The shallower of the adjacent depths in H ~> m or kg m-2. + real :: D_shallow_v(SZIB_(G))! The shallower of the adjacent depths in H ~> m or kg m-2. + real :: htot ! The sum of the layer thicknesses, in H ~> m or kg m-2. + real :: Ihtot ! The inverse of htot, in H-1 ~> m-1 or m2 kg-1. logical :: use_default, test_dflt, apply_OBCs integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, i, j, k @@ -3050,7 +3056,7 @@ end function find_uhbt !! velocity that is consistent with a given transport. function uhbt_to_ubt(uhbt, BTC, guess) result(ubt) real, intent(in) :: uhbt !< The barotropic zonal transport that should be inverted for, - !! in units of H m2 s-1. + !! in H m2 s-1 ~> m2 s-1 or kg s-1 ~> m3 s-1 or kg s-1. type(local_BT_cont_u_type), intent(in) :: BTC !< A structure containing various fields that allow the !! barotropic transports to be calculated consistently with the !! layers' continuity equations. @@ -3163,7 +3169,7 @@ end function find_vhbt !! velocity that is consistent with a given transport. function vhbt_to_vbt(vhbt, BTC, guess) result(vbt) real, intent(in) :: vhbt !< The barotropic meridional transport that should be - !! inverted for, in units of H m2 s-1. + !! inverted for, in H m2 s-1 ~> m2 s-1 or kg s-1 ~> m3 s-1 or kg s-1. type(local_BT_cont_v_type), intent(in) :: BTC !< A structure containing various fields that allow the !! barotropic transports to be calculated consistently !! with the layers' continuity equations. @@ -3388,11 +3394,13 @@ subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & real, dimension(SZIBW_(MS),SZJW_(MS)), & intent(in) :: ubt !< The linearization zonal barotropic velocity in m s-1. real, dimension(SZIBW_(MS),SZJW_(MS)), & - intent(in) :: uhbt !< The linearization zonal barotropic transport in H m2 s-1. + intent(in) :: uhbt !< The linearization zonal barotropic transport + !! in H m2 s-1 ~> m2 s-1 or kg s-1. real, dimension(SZIW_(MS),SZJBW_(MS)), & intent(in) :: vbt !< The linearization meridional barotropic velocity in m s-1. real, dimension(SZIW_(MS),SZJBW_(MS)), & - intent(in) :: vhbt !< The linearization meridional barotropic transport in H m2 s-1. + intent(in) :: vhbt !< The linearization meridional barotropic transport + !! in H m2 s-1 ~> m2 s-1 or kg s-1. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), & intent(out) :: BTCL_u !< A structure with the u information from BT_cont. type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), & @@ -3481,9 +3489,9 @@ subroutine BT_cont_to_face_areas(BT_cont, Datu, Datv, G, MS, halo, maximize) type(memory_size_type), intent(in) :: MS !< A type that describes the memory !! sizes of the argument arrays. real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), & - intent(out) :: Datu !< The effective zonal face area, in H m. + intent(out) :: Datu !< The effective zonal face area, in H m ~> m2 or kg m-1. real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), & - intent(out) :: Datv !< The effective meridional face area, in H m. + intent(out) :: Datv !< The effective meridional face area, in H m ~> m2 or kg m-1. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, optional, intent(in) :: halo !< The extra halo size to use here. logical, optional, intent(in) :: maximize !< If present and true, find the @@ -3529,16 +3537,16 @@ end subroutine swap subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the argument arrays. real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), & - intent(out) :: Datu !< The open zonal face area, in H m (m2 or kg m-1). + intent(out) :: Datu !< The open zonal face area, in H m ~> m2 or kg m-1. real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), & - intent(out) :: Datv !< The open meridional face area, in H m (m2 or kg m-1). + intent(out) :: Datv !< The open meridional face area, in H m ~> m2 or kg m-1. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(barotropic_CS), pointer :: CS !< The control structure returned by a previous !! call to barotropic_init. real, dimension(MS%isdw:MS%iedw,MS%jsdw:MS%jedw), & optional, intent(in) :: eta !< The barotropic free surface height anomaly - !! or column mass anomaly, in H (m or kg m-2). + !! or column mass anomaly, in H ~> m or kg m-2. integer, optional, intent(in) :: halo !< The halo size to use, default = 1. real, optional, intent(in) :: add_max !< A value to add to the maximum depth (used !! to overestimate the external wave speed) in Z ~> m. @@ -3626,7 +3634,7 @@ end subroutine find_face_areas subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The free surface height that is to be corrected, in m. logical, intent(in) :: set_cor !< A flag to indicate whether to set the corrective !! fluxes (and update the slowly varying part of eta_cor) @@ -3636,11 +3644,11 @@ subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) !! to barotropic_init. ! Local variables - real :: h_tot(SZI_(G)) ! The sum of the layer thicknesses, in H. + real :: h_tot(SZI_(G)) ! The sum of the layer thicknesses, in H ~> m or kg m-2. real :: eta_h(SZI_(G)) ! The free surface height determined from - ! the sum of the layer thicknesses, in H. + ! the sum of the layer thicknesses, in H ~> m or kg m-2. real :: d_eta ! The difference between estimates of the total - ! thicknesses, in H. + ! thicknesses, in H ~> m or kg m-2. real :: limit_dt ! The fractional mass-source limit divided by the ! thermodynamic time step, in s-1. integer :: is, ie, js, je, nz, i, j, k @@ -3694,7 +3702,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: eta !< Free surface height or column mass anomaly, in !! Z ~> m or H ~> kg m-2. @@ -3719,8 +3727,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, #include "version_variable.h" ! Local variables character(len=40) :: mdl = "MOM_barotropic" ! This module's name. - real :: Datu(SZIBS_(G),SZJ_(G)) ! Zonal open face area in H m. - real :: Datv(SZI_(G),SZJBS_(G)) ! Meridional open face area in H m. + real :: Datu(SZIBS_(G),SZJ_(G)) ! Zonal open face area in H m ~> m2 or kg m-1. + real :: Datv(SZI_(G),SZJBS_(G)) ! Meridional open face area in H m ~> m2 or kg m-1. real :: gtot_estimate ! Summed GV%g_prime, in m2 Z-1 s-2 ~> m s-2, to give an upper-bound estimate for pbce. real :: SSH_extra ! An estimate of how much higher SSH might get, for use ! in calculating the safe external wave speed, in Z ~> m. diff --git a/src/core/MOM_boundary_update.F90 b/src/core/MOM_boundary_update.F90 index 6ca49256f2..ec170627c0 100644 --- a/src/core/MOM_boundary_update.F90 +++ b/src/core/MOM_boundary_update.F90 @@ -115,7 +115,7 @@ subroutine update_OBC_data(OBC, G, GV, US, tv, h, CS, Time) type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< layer thicknesses, in H + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< layer thicknesses, in H ~> m or kg m-2 type(ocean_OBC_type), pointer :: OBC !< Open boundary structure type(update_OBC_CS), pointer :: CS !< Control structure for OBCs type(time_type), intent(in) :: Time !< Model time diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index d67695b8e6..ca2d7456d8 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -48,7 +48,7 @@ subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, haloshift, symmet real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: uh !< Volume flux through zonal faces = u*h*dy, m3 s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -84,7 +84,7 @@ subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, haloshift, symmetric) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< Meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric !! computationoal domain. @@ -220,7 +220,7 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. real, pointer, dimension(:,:,:), & intent(in) :: Temp !< Temperature in degree C. real, pointer, dimension(:,:,:), & diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index bdf6e3f9b1..a716457cca 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -83,9 +83,9 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< Meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: hin !< Initial layer thickness, in H. + intent(in) :: hin !< Initial layer thickness, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Final layer thickness, in H. + intent(inout) :: h !< Final layer thickness, in H ~> m or kg m-2. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: uh !< Zonal volume flux, u*h*dy, H m2 s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -120,10 +120,12 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, !< The meridional velocities that give vhbt as the depth-integrated transport, in m s-1. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt_aux - !< A second set of summed volume fluxes through zonal faces, in H m2 s-1. + !< A second set of summed volume fluxes through zonal faces, + !! in H m2 s-1 ~> m2 s-1 or kg s-1. real, dimension(SZI_(G),SZJB_(G)), & optional, intent(in) :: vhbt_aux - !< A second set of summed volume fluxes through meridional faces, in H m2 s-1. + !< A second set of summed volume fluxes through meridional faces, + !! in H m2 s-1 ~> m2 s-1 or kg s-1. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: u_cor_aux !< The zonal velocities that give uhbt_aux as the depth-integrated @@ -136,7 +138,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, !! the effective open face areas as a function of barotropic flow. ! Local variables - real :: h_min ! The minimum layer thickness, in H. h_min could be 0. + real :: h_min ! The minimum layer thickness, in H ~> m or kg m-2. h_min could be 0. type(loop_bounds_type) :: LB integer :: is, ie, js, je, nz, stencil integer :: i, j, k @@ -230,7 +232,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< Zonal velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_in !< Layer thickness used to calculate fluxes, in H. + intent(in) :: h_in !< Layer thickness used to calculate fluxes, in H ~> m or kg m-2. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: uh !< Volume flux through zonal faces = u*h*dy, H m2 s-1. real, intent(in) :: dt !< Time increment in s. @@ -248,7 +250,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & optional, intent(in) :: uhbt !< The summed volume flux through zonal faces, H m2 s-1. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt_aux - !< A second set of summed volume fluxes through zonal faces, in H m2 s-1. + !< A second set of summed volume fluxes through zonal faces, in H m2 s-1 ~> m2 s-1 or kg s-1. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: u_cor !< The zonal velocitiess (u with a barotropic correction) @@ -261,20 +263,20 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & !! effective open face areas as a function of barotropic flow. ! Local variables - real, dimension(SZIB_(G),SZK_(G)) :: duhdu ! Partial derivative of uh with u, in H m. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_L, h_R ! Left and right face thicknesses, in H. + real, dimension(SZIB_(G),SZK_(G)) :: duhdu ! Partial derivative of uh with u, in H m ~> m2 or kg m-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_L, h_R ! Left and right face thicknesses, in H ~> m or kg m-2. real, dimension(SZIB_(G)) :: & du, & ! Corrective barotropic change in the velocity, in m s-1. du_min_CFL, & ! Min/max limits on du correction du_max_CFL, & ! to avoid CFL violations - duhdu_tot_0, & ! Summed partial derivative of uh with u, in H m. - uh_tot_0, & ! Summed transport with no barotropic correction in H m2 s-1. + duhdu_tot_0, & ! Summed partial derivative of uh with u, in H m ~> m2 or kg m-1. + uh_tot_0, & ! Summed transport with no barotropic correction in H m2 s-1 ~> m2 s-1 or kg s-1. visc_rem_max ! The column maximum of visc_rem. logical, dimension(SZIB_(G)) :: do_I real, dimension(SZIB_(G),SZK_(G)) :: & visc_rem ! A 2-D copy of visc_rem_u or an array of 1's. - real, dimension(SZIB_(G)) :: FAuI ! A list of sums of zonal face areas, in H m. - real :: FA_u ! A sum of zonal face areas, in H m. + real, dimension(SZIB_(G)) :: FAuI ! A list of sums of zonal face areas, in H m ~> m2 or kg m-1. + real :: FA_u ! A sum of zonal face areas, in H m ~> m2 or kg m-1. real :: I_vrm ! 1.0 / visc_rem_max, nondim. real :: CFL_dt ! The maximum CFL ratio of the adjusted velocities divided by ! the time step, in s-1. @@ -541,13 +543,13 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, & !! of viscosity, and the fraction of a time-step's worth of a barotropic !! acceleration that a layer experiences after viscosity is applied. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZI_(G)), intent(in) :: h !< Layer thickness, in H. - real, dimension(SZI_(G)), intent(in) :: h_L !< Left thickness, in H. - real, dimension(SZI_(G)), intent(in) :: h_R !< Right thickness, in H. + real, dimension(SZI_(G)), intent(in) :: h !< Layer thickness, in H ~> m or kg m-2. + real, dimension(SZI_(G)), intent(in) :: h_L !< Left thickness, in H ~> m or kg m-2. + real, dimension(SZI_(G)), intent(in) :: h_R !< Right thickness, in H ~> m or kg m-2. real, dimension(SZIB_(G)), intent(inout) :: uh !< Zonal mass or volume - !! transport, in H m2 s-1. + !! transport, in H m2 s-1 ~> m2 s-1 or kg s-1. real, dimension(SZIB_(G)), intent(inout) :: duhdu !< Partial derivative of uh - !! with u, in H m. + !! with u, in H m ~> m2 or kg m-1. real, intent(in) :: dt !< Time increment in s. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. @@ -560,7 +562,7 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, & real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. real :: curv_3 ! A measure of the thickness curvature over a grid length, ! with the same units as h_in. - real :: h_marg ! The marginal thickness of a flux, in H. + real :: h_marg ! The marginal thickness of a flux, in H ~> m or kg m-2. integer :: i logical :: local_open_BC @@ -613,12 +615,12 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, & type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness used to - !! calculate fluxes, in H. + !! calculate fluxes, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the - !! reconstruction, in H. + !! reconstruction, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the - !! reconstruction, in H. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_u !< Thickness at zonal faces, in H. + !! reconstruction, in H ~> m or kg m-2. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_u !< Thickness at zonal faces, in H ~> m or kg m-2. real, intent(in) :: dt !< Time increment in s. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. logical, intent(in) :: vol_CFL !< If true, rescale the ratio @@ -637,8 +639,8 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, & real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. real :: curv_3 ! A measure of the thickness curvature over a grid length, ! with the same units as h_in. - real :: h_avg ! The average thickness of a flux, in H. - real :: h_marg ! The marginal thickness of a flux, in H. + real :: h_avg ! The average thickness of a flux, in H ~> m or kg m-2. + real :: h_marg ! The marginal thickness of a flux, in H ~> m or kg m-2. logical :: local_open_BC integer :: i, j, k, ish, ieh, jsh, jeh, nz, n ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke @@ -720,11 +722,11 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to - !! calculate fluxes, in H. + !! calculate fluxes, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the - !! reconstruction, in H. + !! reconstruction, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the - !! reconstruction, in H. + !! reconstruction, in H ~> m or kg m-2. real, dimension(SZIB_(G),SZK_(G)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step of viscosity, and !! the fraction of a time-step's worth of a barotropic acceleration that a layer @@ -737,9 +739,9 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable !! value of du, in m s-1. real, dimension(SZIB_(G)), intent(in) :: uh_tot_0 !< The summed transport - !! with 0 adjustment, in H m2 s-1. + !! with 0 adjustment, in H m2 s-1 ~> m2 s-1 or kg s-1. real, dimension(SZIB_(G)), intent(in) :: duhdu_tot_0 !< The partial derivative - !! of du_err with du at 0 adjustment, in H m. + !! of du_err with du at 0 adjustment, in H m ~> m2 or kg m-1. real, dimension(SZIB_(G)), intent(out) :: du !< !! The barotropic velocity adjustment, in m s-1. real, intent(in) :: dt !< Time increment in s. @@ -757,13 +759,13 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZIB_(G),SZK_(G)) :: & - uh_aux, & ! An auxiliary zonal volume flux, in H m s-1. - duhdu ! Partial derivative of uh with u, in H m. + uh_aux, & ! An auxiliary zonal volume flux, in H m s-1 ~> m2 s-1 or kg m-1 s-1. + duhdu ! Partial derivative of uh with u, in H m ~> m2 or kg m-1. real, dimension(SZIB_(G)) :: & - uh_err, & ! Difference between uhbt and the summed uh, in H m2 s-1. - uh_err_best, & ! The smallest value of uh_err found so far, in H m2 s-1. + uh_err, & ! Difference between uhbt and the summed uh, in H m2 s-1 ~> m2 s-1 or kg s-1. + uh_err_best, & ! The smallest value of uh_err found so far, in H m2 s-1 ~> m2 s-1 or kg s-1. u_new, & ! The velocity with the correction added, in m s-1. - duhdu_tot,&! Summed partial derivative of uh with u, in H m. + duhdu_tot,&! Summed partial derivative of uh with u, in H m ~> m2 or kg m-1. du_min, & ! Min/max limits on du correction based on CFL limits du_max ! and previous iterations, in m s-1. real :: du_prev ! The previous value of du, in m s-1. @@ -882,17 +884,17 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to - !! calculate fluxes, in H. + !! calculate fluxes, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the - !! reconstruction, in H. + !! reconstruction, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the - !! reconstruction, in H. + !! reconstruction, in H ~> m or kg m-2. type(BT_cont_type), intent(inout) :: BT_cont !< A structure with elements !! that describe the effective open face areas as a function of barotropic flow. real, dimension(SZIB_(G)), intent(in) :: uh_tot_0 !< The summed transport - !! with 0 adjustment, in H m2 s-1. + !! with 0 adjustment, in H m2 s-1 ~> m2 s-1 or kg s-1. real, dimension(SZIB_(G)), intent(in) :: duhdu_tot_0 !< The partial derivative - !! of du_err with du at 0 adjustment, in H m. + !! of du_err with du at 0 adjustment, in H m ~> m2 or kg m-1. real, dimension(SZIB_(G)), intent(in) :: du_max_CFL !< Maximum acceptable !! value of du, in m s-1. real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable @@ -921,13 +923,13 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, u_0, & ! transport (u_0) layer test velocities, in m s-1. FA_marg_L, & ! The effective layer marginal face areas with the westerly FA_marg_R, & ! (_L), easterly (_R), and zero-barotropic (_0) test - FA_marg_0, & ! velocities, in H m. + FA_marg_0, & ! velocities, in H m ~> m2 or kg m-1. uh_L, uh_R, & ! The layer transports with the westerly (_L), easterly (_R), - uh_0, & ! and zero-barotropic (_0) test velocities, in H m2 s-1. + uh_0, & ! and zero-barotropic (_0) test velocities, in H m2 s-1 ~> m2 s-1 or kg s-1. FAmt_L, FAmt_R, & ! The summed effective marginal face areas for the 3 - FAmt_0, & ! test velocities, in H m. + FAmt_0, & ! test velocities, in H m ~> m2 or kg m-1. uhtot_L, & ! The summed transport with the westerly (uhtot_L) and - uhtot_R ! and easterly (uhtot_R) test velocities, in H m2 s-1. + uhtot_R ! and easterly (uhtot_R) test velocities, in H m2 s-1 ~> m2 s-1 or kg s-1. real :: FA_0 ! The effective face area with 0 barotropic transport, in m H. real :: FA_avg ! The average effective face area, in m H, nominally given by ! the realized transport divided by the barotropic velocity. @@ -1047,7 +1049,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to - !! calculate fluxes, in H. + !! calculate fluxes, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vh !< Volume flux through meridional !! faces = v*h*dx, H m2 s-1. real, intent(in) :: dt !< Time increment in s. @@ -1064,7 +1066,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vhbt !< The summed volume flux through !< meridional faces, H m2 s-1. real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vhbt_aux !< A second set of summed volume fluxes - !! through meridional faces, in H m2 s-1. + !! through meridional faces, in H m2 s-1 ~> m2 s-1 or kg s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor !< The meridional velocitiess (v with a barotropic correction) @@ -1084,12 +1086,12 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & dv, & ! Corrective barotropic change in the velocity, in m s-1. dv_min_CFL, & ! Min/max limits on dv correction dv_max_CFL, & ! to avoid CFL violations - dvhdv_tot_0, & ! Summed partial derivative of vh with v, in H m. - vh_tot_0, & ! Summed transport with no barotropic correction in H m2 s-1. + dvhdv_tot_0, & ! Summed partial derivative of vh with v, in H m ~> m2 or kg m-1. + vh_tot_0, & ! Summed transport with no barotropic correction in H m2 s-1 ~> m2 s-1 or kg s-1. visc_rem_max ! The column maximum of visc_rem. logical, dimension(SZI_(G)) :: do_I - real, dimension(SZI_(G)) :: FAvi ! A list of sums of meridional face areas, in H m. - real :: FA_v ! A sum of meridional face areas, in H m. + real, dimension(SZI_(G)) :: FAvi ! A list of sums of meridional face areas, in H m ~> m2 or kg m-1. + real :: FA_v ! A sum of meridional face areas, in H m ~> m2 or kg m-1. real, dimension(SZI_(G),SZK_(G)) :: & visc_rem ! A 2-D copy of visc_rem_v or an array of 1's. real :: I_vrm ! 1.0 / visc_rem_max, nondim. @@ -1357,11 +1359,16 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, & !! of viscosity, and the fraction of a time-step's worth of a barotropic !! acceleration that a layer experiences after viscosity is applied. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h !< Layer thickness used to calculate fluxes, in H. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, in H. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_R !< Right thickness in the reconstruction, in H. - real, dimension(SZI_(G)), intent(inout) :: vh !< Meridional mass or volume transport, in H m2 s-1. - real, dimension(SZI_(G)), intent(inout) :: dvhdv !< Partial derivative of vh with v, in H m. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h !< Layer thickness used to calculate fluxes, + !! in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, + !! in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_R !< Right thickness in the reconstruction, + !! in H ~> m or kg m-2. + real, dimension(SZI_(G)), intent(inout) :: vh !< Meridional mass or volume transport, + !! in H m2 s-1 ~> m2 s-1 or kg s-1. + real, dimension(SZI_(G)), intent(inout) :: dvhdv !< Partial derivative of vh with v, + !! in H m ~> m2 or kg m-1. real, intent(in) :: dt !< Time increment in s. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. @@ -1427,10 +1434,14 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & marginal, visc_rem_v, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity, in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness used to calculate fluxes, in H. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, in H. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the reconstruction, in H. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: h_v !< Thickness at meridional faces, in H. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness used to calculate fluxes, + !! in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, + !! in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the reconstruction, + !! in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: h_v !< Thickness at meridional faces, + !! in H ~> m or kg m-2. real, intent(in) :: dt !< Time increment in s. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. logical, intent(in) :: vol_CFL !< If true, rescale the ratio @@ -1448,8 +1459,8 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. real :: curv_3 ! A measure of the thickness curvature over a grid length, ! with the same units as h_in. - real :: h_avg ! The average thickness of a flux, in H. - real :: h_marg ! The marginal thickness of a flux, in H. + real :: h_avg ! The average thickness of a flux, in H ~> m or kg m-2. + real :: h_marg ! The marginal thickness of a flux, in H ~> m or kg m-2. logical :: local_open_BC integer :: i, j, k, ish, ieh, jsh, jeh, n, nz ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke @@ -1533,11 +1544,11 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< Meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_in !< Layer thickness used to calculate fluxes, in H. + intent(in) :: h_in !< Layer thickness used to calculate fluxes, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& - intent(in) :: h_L !< Left thickness in the reconstruction, in H. + intent(in) :: h_L !< Left thickness in the reconstruction, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_R !< Right thickness in the reconstruction, in H. + intent(in) :: h_R !< Right thickness in the reconstruction, in H ~> m or kg m-2. real, dimension(SZI_(G),SZK_(G)), & intent(in) :: visc_rem !< Both the fraction of the momentum originally @@ -1549,9 +1560,10 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 optional, intent(in) :: vhbt !< The summed volume flux through meridional faces, H m2 s-1. real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv, in m s-1. real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv, in m s-1. - real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< The summed transport with 0 adjustment, in H m2 s-1. + real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< The summed transport with 0 adjustment, + !! in H m2 s-1 ~> m2 s-1 or kg s-1. real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< The partial derivative of dv_err with - !! dv at 0 adjustment, in H m. + !! dv at 0 adjustment, in H m ~> m2 or kg m-1. real, dimension(SZI_(G)), intent(out) :: dv !< The barotropic velocity adjustment, in m s-1. real, intent(in) :: dt !< Time increment in s. type(continuity_PPM_CS), pointer :: CS !< This module's control structure. @@ -1568,13 +1580,13 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & - vh_aux, & ! An auxiliary meridional volume flux, in H m s-1. - dvhdv ! Partial derivative of vh with v, in H m. + vh_aux, & ! An auxiliary meridional volume flux, in H m s-1 ~> m2 s-1 or kg m-1 s-1. + dvhdv ! Partial derivative of vh with v, in H m ~> m2 or kg m-1. real, dimension(SZI_(G)) :: & - vh_err, & ! Difference between vhbt and the summed vh, in H m2 s-1. - vh_err_best, & ! The smallest value of vh_err found so far, in H m2 s-1. + vh_err, & ! Difference between vhbt and the summed vh, in H m2 s-1 ~> m2 s-1 or kg s-1. + vh_err_best, & ! The smallest value of vh_err found so far, in H m2 s-1 ~> m2 s-1 or kg s-1. v_new, & ! The velocity with the correction added, in m s-1. - dvhdv_tot,&! Summed partial derivative of vh with u, in H m. + dvhdv_tot,&! Summed partial derivative of vh with u, in H m ~> m2 or kg m-1. dv_min, & ! Min/max limits on dv correction based on CFL limits dv_max ! and previous iterations, in m s-1. real :: dv_prev ! The previous value of dv, in m s-1. @@ -1692,15 +1704,18 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, visc_rem_max, j, ish, ieh, do_I) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity, in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to calculate fluxes, in H. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, in H. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the reconstruction, in H. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to calculate fluxes, + !! in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, + !! in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the reconstruction, + !! in H ~> m or kg m-2. type(BT_cont_type), intent(inout) :: BT_cont !< A structure with elements !! that describe the effective open face areas as a function of barotropic flow. real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< The summed transport - !! with 0 adjustment, in H m2 s-1. + !! with 0 adjustment, in H m2 s-1 ~> m2 s-1 or kg s-1. real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< The partial derivative - !! of du_err with dv at 0 adjustment, in H m. + !! of du_err with dv at 0 adjustment, in H m ~> m2 or kg m-1. real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv, in m s-1. real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv, in m s-1. real, intent(in) :: dt !< Time increment in s. @@ -1727,13 +1742,13 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, v_0, & ! transport (v_0) layer test velocities, in m s-1. FA_marg_L, & ! The effective layer marginal face areas with the southerly FA_marg_R, & ! (_L), northerly (_R), and zero-barotropic (_0) test - FA_marg_0, & ! velocities, in H m. + FA_marg_0, & ! velocities, in H m ~> m2 or kg m-1. vh_L, vh_R, & ! The layer transports with the southerly (_L), northerly (_R) - vh_0, & ! and zero-barotropic (_0) test velocities, in H m2 s-1. + vh_0, & ! and zero-barotropic (_0) test velocities, in H m2 s-1 ~> m2 s-1 or kg s-1. FAmt_L, FAmt_R, & ! The summed effective marginal face areas for the 3 - FAmt_0, & ! test velocities, in H m. + FAmt_0, & ! test velocities, in H m ~> m2 or kg m-1. vhtot_L, & ! The summed transport with the southerly (vhtot_L) and - vhtot_R ! and northerly (vhtot_R) test velocities, in H m2 s-1. + vhtot_R ! and northerly (vhtot_R) test velocities, in H m2 s-1 ~> m2 s-1 or kg s-1. real :: FA_0 ! The effective face area with 0 barotropic transport, in m H. real :: FA_avg ! The average effective face area, in m H, nominally given by ! the realized transport divided by the barotropic velocity. @@ -1847,9 +1862,11 @@ end subroutine set_merid_BT_cont !> Calculates left/right edge values for PPM reconstruction. subroutine PPM_reconstruction_x(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_2nd, OBC) type(ocean_grid_type), intent(in) :: G !< Ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Layer thickness, in H. - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_L !< Left thickness in the reconstruction, in H. - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_R !< Right thickness in the reconstruction, in H. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Layer thickness, in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_L !< Left thickness in the reconstruction, + !! in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_R !< Right thickness in the reconstruction, + !! in H ~> m or kg m-2. type(loop_bounds_type), intent(in) :: LB !< Active loop bounds structure. real, intent(in) :: h_min !< The minimum thickness !! that can be obtained by a concave parabolic fit. @@ -1984,9 +2001,11 @@ end subroutine PPM_reconstruction_x !> Calculates left/right edge values for PPM reconstruction. subroutine PPM_reconstruction_y(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_2nd, OBC) type(ocean_grid_type), intent(in) :: G !< Ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Layer thickness, in H. - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_L !< Left thickness in the reconstruction, in H. - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_R !< Right thickness in the reconstruction, in H. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Layer thickness, in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_L !< Left thickness in the reconstruction, + !! in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_R !< Right thickness in the reconstruction, + !! in H ~> m or kg m-2. type(loop_bounds_type), intent(in) :: LB !< Active loop bounds structure. real, intent(in) :: h_min !< The minimum thickness !! that can be obtained by a concave parabolic fit. @@ -2122,9 +2141,9 @@ end subroutine PPM_reconstruction_y !! than h_min, with a minimum of h_min otherwise. subroutine PPM_limit_pos(h_in, h_L, h_R, h_min, G, iis, iie, jis, jie) type(ocean_grid_type), intent(in) :: G !< Ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Layer thickness, in H. - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_L !< Left thickness in the reconstruction, in H. - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_R !< Right thickness in the reconstruction, in H. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Layer thickness, in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_L !< Left thickness in the reconstruction, in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_R !< Right thickness in the reconstruction, in H ~> m or kg m-2. real, intent(in) :: h_min !< The minimum thickness !! that can be obtained by a concave parabolic fit. integer, intent(in) :: iis !< Start of i index range. @@ -2163,9 +2182,11 @@ end subroutine PPM_limit_pos !! according to the monotonic prescription of Colella and Woodward, 1984. subroutine PPM_limit_CW84(h_in, h_L, h_R, G, iis, iie, jis, jie) type(ocean_grid_type), intent(in) :: G !< Ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Layer thickness, in H. - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_L !< Left thickness in the reconstruction, in H. - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_R !< Right thickness in the reconstruction, in H. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Layer thickness, in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_L !< Left thickness in the reconstruction, + !! in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_R !< Right thickness in the reconstruction, + !! in H ~> m or kg m-2. integer, intent(in) :: iis !< Start of i index range. integer, intent(in) :: iie !< End of i index range. integer, intent(in) :: jis !< Start of j index range. diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index c6cf3ab0e7..b0630d3b8d 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -101,7 +101,7 @@ module MOM_dynamics_split_RK2 ! The following variables are only used with the split time stepping scheme. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta !< Instantaneous free surface height (in Boussinesq !! mode) or column mass anomaly (in non-Boussinesq - !! mode), in units of H (m or kg m-2) + !! mode), in H ~> m or kg m-2 real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_av !< layer x-velocity with vertical mean replaced by !! time-mean barotropic velocity over a baroclinic !! timestep (m s-1) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index fa62036846..73fc1e40d7 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -188,7 +188,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity, in m s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity, in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2. !! (usually m or kg m-2). type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. @@ -211,7 +211,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume or mass !! transport since the last tracer advection, in m3 or kg. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height or - !! column mass, in H (m or kg m-2). + !! column mass, in H ~> m or kg m-2. type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit. type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with fields @@ -570,7 +570,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(inout) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , & - intent(inout) :: h !< Layer thicknesses, in H + intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2 !! (usually m or kg m-2). type(time_type), target, intent(in) :: Time !< The current model time. type(param_file_type), intent(in) :: param_file !< A structure to parse diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 472a9adabe..d11c4c4f4f 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -222,7 +222,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! or mass transport since the last !! tracer advection, in m3 or kg. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height - !! or column mass, in H (m or kg m-2). + !! or column mass, in H ~> m or kg m-2. type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit_RK2. type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with @@ -514,7 +514,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity, in m s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity, !! in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< Layer thicknesses, in H + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2 !! (usually m or kg m-2). type(time_type), target, intent(in) :: Time !< The current model time. type(param_file_type), intent(in) :: param_file !< A structure to parse diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index d5a1bd23a6..1fd946f9b9 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -350,15 +350,15 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, logical, intent(in) :: useRiverHeatContent !< logical for river heat content logical, intent(in) :: useCalvingHeatContent !< logical for calving heat content real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: h !< layer thickness (in H units) + intent(in) :: h !< layer thickness (in H ~> m or kg m-2) real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: T !< layer temperatures (deg C) + intent(in) :: T !< layer temperatures (degC) real, dimension(SZI_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux !! (if Bouss) of water in/out of ocean over - !! a time step (H units) + !! a time step (H ~> m or kg m-2) real, dimension(SZI_(G)), intent(out) :: netMassOut !< net mass flux (non-Bouss) or volume flux !! (if Bouss) of water leaving ocean surface - !! over a time step (H units). + !! over a time step (H ~> m or kg m-2). !! netMassOut < 0 means mass leaves ocean. real, dimension(SZI_(G)), intent(out) :: net_heat !< net heat at the surface accumulated over a !! time step for coupler + restoring. @@ -366,35 +366,41 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, !! (1) downwelling (penetrative) SW, !! (2) evaporation heat content, !! (since do not yet know evap temperature). - !! Units of net_heat are (K * H). - real, dimension(SZI_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated - !! over a time step (ppt * H) + !! Units are (degC H ~> degC m or degC kg m-2). + real, dimension(SZI_(G)), intent(out) :: net_salt !< surface salt flux into the ocean + !! accumulated over a time step, in + !! ppt H ~> ppt m or ppt kg m-2. real, dimension(:,:), intent(out) :: pen_SW_bnd !< penetrating SW flux, split into bands. - !! Units are (deg K * H) and array size - !! nsw x SZI_(G), where nsw=number of SW bands - !! in pen_SW_bnd. This heat flux is not part - !! of net_heat. + !! Units are (degC H ~> degC m or degC kg m-2) + !! and array size nsw x SZI_(G), where + !! nsw=number of SW bands in pen_SW_bnd. + !! This heat flux is not part of net_heat. type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available !! thermodynamic fields. Used to keep !! track of the heat flux associated with net !! mass fluxes into the ocean. logical, intent(in) :: aggregate_FW !< For determining how to aggregate forcing. real, dimension(SZI_(G)), & - optional, intent(out) :: nonpenSW !< Non-penetrating SW in degC H, used in net_heat. + optional, intent(out) :: nonpenSW !< Non-penetrating SW used in net_heat, in + !! degC H ~> degC m or degC kg m-2. !! Summed over SW bands when diagnosing nonpenSW. real, dimension(SZI_(G)), & - optional, intent(out) :: net_Heat_rate !< Rate of net surface heating in H K s-1. + optional, intent(out) :: net_Heat_rate !< Rate of net surface heating, in + !! degC H s-1 ~> degC m s-1 or degC kg m-2 s-1. real, dimension(SZI_(G)), & - optional, intent(out) :: net_salt_rate !< Surface salt flux into the ocean in ppt H s-1. + optional, intent(out) :: net_salt_rate !< Surface salt flux into the ocean in + !! ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1. real, dimension(SZI_(G)), & - optional, intent(out) :: netmassInOut_rate !< Rate of net mass flux into the ocean in H s-1. + optional, intent(out) :: netmassInOut_rate !< Rate of net mass flux into the ocean, in + !! H s-1 ~> m s-1 or kg m-2 s-1. real, dimension(:,:), & - optional, intent(out) :: pen_sw_bnd_rate !< Rate of penetrative shortwave heating in degC H s-1. + optional, intent(out) :: pen_sw_bnd_rate !< Rate of penetrative shortwave heating, in + !! degC H s-1 ~> degC m s-1 or degC kg m-2 s-1. logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating diagnostics ! local real :: htot(SZI_(G)) ! total ocean depth (m for Bouss or kg/m^2 for non-Bouss) - real :: Pen_sw_tot(SZI_(G)) ! sum across all bands of Pen_SW (K * H) + real :: Pen_sw_tot(SZI_(G)) ! sum across all bands of Pen_SW degC H ~> degC m or degC kg m-2. real :: pen_sw_tot_rate(SZI_(G)) ! Similar but sum but as a rate (no dt in calculation) real :: Ih_limit ! inverse depth at which surface fluxes start to be limited (1/H) real :: scale ! scale scales away fluxes if depth < FluxRescaleDepth @@ -775,15 +781,15 @@ subroutine extractFluxes2d(G, GV, fluxes, optics, nsw, dt, FluxRescaleDepth, & logical, intent(in) :: useRiverHeatContent !< logical for river heat content logical, intent(in) :: useCalvingHeatContent !< logical for calving heat content real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< layer thickness (in H units) + intent(in) :: h !< layer thickness (in H ~> m or kg m-2) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: T !< layer temperatures (deg C) real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux !! (if Bouss) of water in/out of ocean over - !! a time step (H units) + !! a time step (H ~> m or kg m-2) real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassOut !< net mass flux (non-Bouss) or volume flux !! (if Bouss) of water leaving ocean surface - !! over a time step (H units). + !! over a time step (H ~> m or kg m-2). real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_heat !< net heat at the surface accumulated over a !! time step associated with coupler + restore. !! Exclude two terms from net_heat: diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index 745e8c5b39..f6190f4bf3 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -32,7 +32,7 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 !! (usually m or kg m-2). type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to !! various thermodynamic @@ -42,7 +42,7 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic !! variable that gives the "correct" free surface height (Boussinesq) or total water !! column mass per unit area (non-Boussinesq). This is used to dilate the layer. - !! thicknesses when calculating interfaceheights, in H (m or kg m-2). + !! thicknesses when calculating interfaceheights, in H ~> m or kg m-2. integer, optional, intent(in) :: halo_size !< width of halo points on !! which to calculate eta. real, optional, intent(in) :: eta_to_m !< The conversion factor from @@ -147,7 +147,7 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 !! (usually m or kg m-2). type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to !! various thermodynamic @@ -157,7 +157,7 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) !! level (z=0) (m). real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic !! variable that gives the "correct" free surface height (Boussinesq) or total - !! water column mass per unit area (non-Boussinesq), in H (m or kg m-2). + !! water column mass per unit area (non-Boussinesq), in H ~> m or kg m-2. integer, optional, intent(in) :: halo_size !< width of halo points on !! which to calculate eta. real, optional, intent(in) :: eta_to_m !< The conversion factor from @@ -167,7 +167,7 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) p ! The pressure in Pa. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & dz_geo ! The change in geopotential height across a layer, in m2 s-2. - real :: htot(SZI_(G)) ! The sum of all layers' thicknesses, in H. + real :: htot(SZI_(G)) ! The sum of all layers' thicknesses, in H ~> m or kg m-2. real :: I_gEarth real :: Z_to_eta, H_to_eta, H_to_rho_eta ! Unit conversion factors with obvious names. integer i, j, k, is, ie, js, je, nz, halo diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index df6b8ff655..65cf848e36 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -27,7 +27,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface heights (in Z ~> m or units !! given by 1/eta_to_m) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various @@ -71,10 +71,10 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & real :: drdiA, drdiB ! Along layer zonal- and meridional- potential density real :: drdjA, drdjB ! gradients in the layers above (A) and below(B) the ! interface times the grid spacing, in kg m-3. - real :: drdkL, drdkR ! Vertical density differences across an interface, - ! in kg m-3. - real :: hg2A, hg2B, hg2L, hg2R ! Squares of geometric mean thicknesses, in H2. - real :: haA, haB, haL, haR ! Arithmetic mean thicknesses in H. + real :: drdkL, drdkR ! Vertical density differences across an interface, in kg m-3. + real :: hg2A, hg2B ! Squares of geometric mean thicknesses, in H2 ~> m2 or kg2 m-4. + real :: hg2L, hg2R ! Squares of geometric mean thicknesses, in H2 ~> m2 or kg2 m-4. + real :: haA, haB, haL, haR ! Arithmetic mean thicknesses in H ~> m or kg m-2. real :: dzaL, dzaR ! Temporary thicknesses in eta units (Z?). real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. real :: drdx, drdy ! Zonal and meridional density gradients, in kg m-4. @@ -84,10 +84,10 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & real :: mag_grad2 ! The squared magnitude of the 3-d density gradient, in kg2 m-8. real :: slope2_Ratio ! The ratio of the slope squared to slope_max squared. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. - real :: h_neglect2 ! h_neglect^2, in H2. - real :: dz_neglect ! A thickness in m that is so small it is usually lost - ! in roundoff and can be neglected, in eta units (Z?). + ! in roundoff and can be neglected, in H ~> m or kg m-2. + real :: h_neglect2 ! h_neglect^2, in H2 ~> m2 or kg2 m-4. + real :: dz_neglect ! A change in interface heighs that is so small it is usually lost + ! in roundoff and can be neglected, in Z ~> m. logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. real :: G_Rho0, N2, dzN2, H_x(SZIB_(G)), H_y(SZI_(G)) @@ -332,7 +332,7 @@ end subroutine calc_isoneutral_slopes subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Temperature (deg C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Salinity (psu) real, intent(in) :: kappa_dt !< A vertical diffusivity to use for smoothing diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index a5276f6e84..7269f5b1c5 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -128,10 +128,10 @@ module MOM_variables S => NULL(), & !< Pointer to the salinity state variable, in PSU or g/kg u => NULL(), & !< Pointer to the zonal velocity, in m s-1 v => NULL(), & !< Pointer to the meridional velocity, in m s-1 - h => NULL() !< Pointer to the layer thicknesses, in H (often m or kg m-2) + h => NULL() !< Pointer to the layer thicknesses, in H ~> m or kg m-2 real, pointer, dimension(:,:,:) :: & - uh => NULL(), & !< Pointer to zonal transports, in H m2 s-1 - vh => NULL() !< Pointer to meridional transports, in H m2 s-1 + uh => NULL(), & !< Pointer to zonal transports, in H m2 s-1 ~> m2 s-1 or kg s-1 + vh => NULL() !< Pointer to meridional transports, in H m2 s-1 ~> m2 s-1 or kg s-1 real, pointer, dimension(:,:,:) :: & CAu => NULL(), & !< Pointer to the zonal Coriolis and Advective acceleration, in m s-2 CAv => NULL(), & !< Pointer to the meridional Coriolis and Advective acceleration, in m s-2 @@ -226,7 +226,7 @@ module MOM_variables real, pointer, dimension(:,:) :: nkml_visc_v => NULL() !< The number of layers in the viscous surface mixed layer at v-points (nondimensional). real, pointer, dimension(:,:) :: & - MLD => NULL() !< Instantaneous active mixing layer depth (H units). + MLD => NULL() !< Instantaneous active mixing layer depth (H ~> m or kg m-2). real, pointer, dimension(:,:,:) :: & Ray_u => NULL(), & !< The Rayleigh drag velocity to be applied to each layer at u-points, in Z s-1 ~> m s-1. Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points, in Z s-1 ~> m s-1. @@ -262,31 +262,31 @@ module MOM_variables !! and how they will vary as the barotropic velocity is changed. type, public :: BT_cont_type real, allocatable :: FA_u_EE(:,:) !< The effective open face area for zonal barotropic transport - !! drawing from locations far to the east, in H m. + !! drawing from locations far to the east, in H m ~> m2 or kg m-1. real, allocatable :: FA_u_E0(:,:) !< The effective open face area for zonal barotropic transport - !! drawing from nearby to the east, in H m. + !! drawing from nearby to the east, in H m ~> m2 or kg m-1. real, allocatable :: FA_u_W0(:,:) !< The effective open face area for zonal barotropic transport - !! drawing from nearby to the west, in H m. + !! drawing from nearby to the west, in H m ~> m2 or kg m-1. real, allocatable :: FA_u_WW(:,:) !< The effective open face area for zonal barotropic transport - !! drawing from locations far to the west, in H m. + !! drawing from locations far to the west, in H m ~> m2 or kg m-1. real, allocatable :: uBT_WW(:,:) !< uBT_WW is the barotropic velocity, in m s-1, beyond which the marginal !! open face area is FA_u_WW. uBT_WW must be non-negative. real, allocatable :: uBT_EE(:,:) !< uBT_EE is a barotropic velocity, in m s-1, beyond which the marginal !! open face area is FA_u_EE. uBT_EE must be non-positive. real, allocatable :: FA_v_NN(:,:) !< The effective open face area for meridional barotropic transport - !! drawing from locations far to the north, in H m. + !! drawing from locations far to the north, in H m ~> m2 or kg m-1. real, allocatable :: FA_v_N0(:,:) !< The effective open face area for meridional barotropic transport - !! drawing from nearby to the north, in H m. + !! drawing from nearby to the north, in H m ~> m2 or kg m-1. real, allocatable :: FA_v_S0(:,:) !< The effective open face area for meridional barotropic transport - !! drawing from nearby to the south, in H m. + !! drawing from nearby to the south, in H m ~> m2 or kg m-1. real, allocatable :: FA_v_SS(:,:) !< The effective open face area for meridional barotropic transport - !! drawing from locations far to the south, in H m. + !! drawing from locations far to the south, in H m ~> m2 or kg m-1. real, allocatable :: vBT_SS(:,:) !< vBT_SS is the barotropic velocity, in m s-1, beyond which the marginal !! open face area is FA_v_SS. vBT_SS must be non-negative. real, allocatable :: vBT_NN(:,:) !< vBT_NN is the barotropic velocity, in m s-1, beyond which the marginal !! open face area is FA_v_NN. vBT_NN must be non-positive. - real, allocatable :: h_u(:,:,:) !< An effective thickness at zonal faces, in H. - real, allocatable :: h_v(:,:,:) !< An effective thickness at meridional faces, in H. + real, allocatable :: h_u(:,:,:) !< An effective thickness at zonal faces, in H ~> m or kg m-2. + real, allocatable :: h_v(:,:,:) !< An effective thickness at meridional faces, in H ~> m or kg m-2. type(group_pass_type) :: pass_polarity_BT !< Structure for polarity group halo updates type(group_pass_type) :: pass_FA_uv !< Structure for face area group halo updates end type BT_cont_type diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 7a03c1e06f..a59b9a73a4 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -75,7 +75,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: um !< The new zonal velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: hin !< The layer thickness, in H. + intent(in) :: hin !< The layer thickness, in H ~> m or kg m-2. type(accel_diag_ptrs), intent(in) :: ADp !< A structure pointing to the various !! accelerations in the momentum equations. type(cont_diag_ptrs), intent(in) :: CDp !< A structure with pointers to various terms @@ -90,7 +90,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, Z s-1. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, - !! from vertvisc, in H. + !! from vertvisc, in H ~> m or kg m-2. ! Local variables real :: f_eff, CFL real :: Angstrom @@ -406,7 +406,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: vm !< The new meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: hin !< The layer thickness, in H. + intent(in) :: hin !< The layer thickness, in H ~> m or kg m-2. type(accel_diag_ptrs), intent(in) :: ADp !< A structure pointing to the various !! accelerations in the momentum equations. type(cont_diag_ptrs), intent(in) :: CDp !< A structure with pointers to various terms in @@ -421,7 +421,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, Z s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, - !! from vertvisc, in H. + !! from vertvisc, in H ~> m or kg m-2. ! Local variables real :: f_eff, CFL real :: Angstrom diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index 14d7ce36f8..5b7488a6cb 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -153,7 +153,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, US, CS) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: ssh_in !< Sea surface height in meters. real, dimension(:,:), pointer :: frac_shelf_h !< The fraction of the cell area covered by @@ -184,7 +184,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, US, CS) ! Note that -1/2 <= z1 < z2 <= 1/2. real :: sl_tr(max(CS%num_tr_used,1)) ! normalized slope of the tracer ! within the cell, in tracer units - real :: Angstrom ! A minimal layer thickness, in H. + real :: Angstrom ! A minimal layer thickness, in H ~> m or kg m-2. real :: slope ! normalized slope of a variable within the cell real :: layer_ave(CS%nk_zspace) @@ -507,7 +507,7 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) !! transport (m3 or kg). real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh_int !< Time integrated meridional !! transport (m3 or kg). - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 !! (usually m or kg m-2). real, intent(in) :: dt !< The time difference in s since !! the last call to this @@ -517,7 +517,7 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) !! diag_to_Z_init. ! Local variables real, dimension(SZI_(G), SZJ_(G)) :: & - htot, & ! total layer thickness, in H + htot, & ! total layer thickness, in H ~> m or kg m-2 dilate ! Factor by which to dilate layers to convert them ! into z* space, in Z H-1 ~> 1 or m3 kg-1. (-G%D < z* < 0) @@ -751,7 +751,7 @@ end subroutine find_limited_slope subroutine calc_Zint_diags(h, in_ptrs, ids, num_diags, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. type(p3d), dimension(:), intent(in) :: in_ptrs !< Pointers to the diagnostics to be regridded integer, dimension(:), intent(in) :: ids !< The diagnostic IDs of the diagnostics integer, intent(in) :: num_diags !< The number of diagnostics to regrid diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 2a66dddea6..66a5dd33e3 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -193,13 +193,13 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: uh !< Transport through zonal faces = u*h*dy, in H m2 s-1. - !! I.e. units are m3/s(Bouss) or kg/s(non-Bouss). + intent(in) :: uh !< Transport through zonal faces = u*h*dy, + !! in H m2 s-1 ~> m3 s-1 or kg s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: vh !< Transport through meridional faces = v*h*dx, in H m2 s-1. - !! I.e. units are m3/s(Bouss) or kg/s(non-Bouss). + intent(in) :: vh !< Transport through meridional faces = v*h*dx, + !! in H m2 s-1 ~> m3 s-1 or kg s-1. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. type(accel_diag_ptrs), intent(in) :: ADp !< structure with pointers to @@ -769,7 +769,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. real, dimension(:,:), pointer :: p_surf !< A pointer to the surface pressure, in Pa. @@ -887,13 +887,13 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: uh !< Transport through zonal faces=u*h*dy, in H m2 s-1. - !! I.e. units are m3/s (Bouss) or kg/s(non-Bouss). + intent(in) :: uh !< Transport through zonal faces=u*h*dy, + !! in H m2 s-1 ~> m3 s-1 or kg s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: vh !< Transport through merid faces=v*h*dx, in H m2 s-1. - !! I.e. units are m3/s (Bouss) or kg/s(non-Bouss). + intent(in) :: vh !< Transport through merid faces=v*h*dx, + !! in H m2 s-1 ~> m3 s-1 or kg s-1. type(accel_diag_ptrs), intent(in) :: ADp !< Structure pointing to accelerations in momentum equation. type(cont_diag_ptrs), intent(in) :: CDp !< Structure pointing to terms in continuity equations. type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by a previous call to @@ -1322,7 +1322,7 @@ subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, d real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhtr !< Accumulated meridional thickness fluxes !! used to advect tracers (m3 or kg) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< The updated layer thicknesses, in H + intent(in) :: h !< The updated layer thicknesses, in H ~> m or kg m-2 type(transport_diag_IDs), intent(in) :: IDs !< A structure with the diagnostic IDs. type(diag_grid_storage), intent(inout) :: diag_pre_dyn !< Stored grids from before dynamics type(diag_ctrl), intent(inout) :: diag !< regulates diagnostic output diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 30694ce4ff..be956ac5f3 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -281,7 +281,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. type(time_type), intent(in) :: day !< The current model time. diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 6f58622a80..3f36b37d3e 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -51,7 +51,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thickness in units of H (m or kg/m2) + intent(in) :: h !< Layer thickness in H ~> m or kg m-2 type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZI_(G),SZJ_(G)), intent(out) :: cg1 !< First mode internal wave speed (m/s) type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed @@ -84,7 +84,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & real det, ddet, detKm1, detKm2, ddetKm1, ddetKm2 real :: lam, dlam, lam0 real :: min_h_frac - real :: Z_to_Pa ! A conversion factor from thickesses (in Z) to pressure (in Pa) + real :: Z_to_Pa ! A conversion factor from thicknesses (in Z) to pressure (in Pa) real, dimension(SZI_(G)) :: & htot, hmin, & ! Thicknesses in Z ~> m. H_here, HxT_here, HxS_here, HxR_here @@ -455,7 +455,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & mode_struct(1:kc)=0. endif ! Note that remapping_core_h requires that the same units be used - ! for both the source and target grid thicknesses, here in H. + ! for both the source and target grid thicknesses, here in H ~> m or kg m-2. call remapping_core_h(CS%remapping_CS, kc, GV%Z_to_H*Hc(:), mode_struct, & nz, h(i,j,:), modal_structure(i,j,:), 1.0e-30*GV%m_to_H, 1.0e-10*GV%m_to_H) endif @@ -563,7 +563,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) integer :: numint ! number of widows (intervals) in root searching range integer :: nrootsfound ! number of extra roots found (not including 1st root) real :: min_h_frac - real :: Z_to_Pa ! A conversion factor from thickesses (in Z) to pressure (in Pa) + real :: Z_to_Pa ! A conversion factor from thicknesses (in Z) to pressure (in Pa) real, dimension(SZI_(G)) :: & htot, hmin, & ! Thicknesses in Z ~> m. H_here, HxT_here, HxS_here, HxR_here diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 3a6932ae12..b5f2cbb129 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -91,7 +91,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 !! (usually m or kg m-2). type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index db9e391610..bc2f772e3a 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -950,7 +950,7 @@ subroutine post_data_3d(diag_field_id, field, diag_cs, is_static, mask, alt_h) real, optional, intent(in) :: mask(:,:,:) !< If present, use this real array as the data mask. real, dimension(:,:,:), & target, optional, intent(in) :: alt_h !< An alternate thickness to use for vertically - !! remapping this diagnostic, in H. + !! remapping this diagnostic, in H ~> m or kg m-2. ! Local variables type(diag_type), pointer :: diag => null() diff --git a/src/framework/MOM_spatial_means.F90 b/src/framework/MOM_spatial_means.F90 index 281b38c10a..699fdaa5c8 100644 --- a/src/framework/MOM_spatial_means.F90 +++ b/src/framework/MOM_spatial_means.F90 @@ -65,7 +65,7 @@ function global_layer_mean(var, h, G, GV) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: var !< The variable to average - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 real, dimension(SZK_(GV)) :: global_layer_mean real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: tmpForSumming, weight @@ -97,7 +97,7 @@ function global_volume_mean(var, h, G, GV) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: var !< The variable being averaged real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 real :: global_volume_mean !< The thickness-weighted average of var real :: weight_here @@ -123,7 +123,7 @@ function global_mass_integral(h, G, GV, var, on_PE_only) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: var !< The variable being integrated logical, optional, intent(in) :: on_PE_only !< If present and true, the sum is only diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 4d5ecf4caa..8b5f26292f 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -129,8 +129,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & intent(out) :: v !< The meridional velocity that is being !! initialized, in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(out) :: h !< Layer thicknesses, in H (usually m or - !! kg m-2) + intent(out) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic !! variables type(time_type), intent(inout) :: Time !< Time at the start of the run segment. @@ -705,7 +704,7 @@ subroutine adjustEtaToFitBathymetry(G, GV, US, eta, h) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: eta !< Interface heights, in Z ~> m. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2 ! Local variables integer :: i, j, k, is, ie, js, je, nz, contractions, dilations real :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria (m) @@ -778,7 +777,7 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H. + intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -834,7 +833,7 @@ subroutine initialize_thickness_list(h, G, GV, US, param_file, just_read_params) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H. + intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -915,9 +914,9 @@ subroutine convert_thickness(h, G, GV, US, tv) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Input geometric layer thicknesses (in H units), - !! being converted to layer pressure - !! thicknesses (also in H units). + intent(inout) :: h !< Input geometric layer thicknesses (in H ~> m + !! or kg m-2), being converted to layer pressure + !! thicknesses (also in H ~> m or kg m-2). type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables ! Local variables @@ -994,7 +993,7 @@ subroutine depress_surface(h, G, GV, US, param_file, tv, just_read_params) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1901,7 +1900,7 @@ end subroutine set_velocity_depth_min subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_params) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(out) :: h !< Layer thicknesses being initialized, in H + intent(out) :: h !< Layer thicknesses being initialized, in H ~> m or kg m-2 type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic !! variables including temperature and salinity type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -1973,7 +1972,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param real, dimension(:,:), allocatable, target :: frac_shelf_h real, dimension(:,:,:), allocatable, target :: tmpT1dIn, tmpS1dIn real, dimension(:,:,:), allocatable :: tmp_mask_in - real, dimension(:,:,:), allocatable :: h1 ! Thicknesses in H. + real, dimension(:,:,:), allocatable :: h1 ! Thicknesses in H ~> m or kg m-2. real, dimension(:,:,:), allocatable :: dz_interface ! Change in position of interface due to regridding real :: zTopOfCell, zBottomOfCell ! Heights in Z units, Z ~> m. type(regridding_CS) :: regridCS ! Regridding parameters and work arrays diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 07977eaa1c..a51053ca30 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -49,7 +49,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thickness, in H (often m or kg m-2). + intent(in) :: h !< Layer thickness, in H ~> m or kg m-2. real, dimension(:,:,:), pointer :: tr !< Pointer to array to be initialized type(param_file_type), intent(in) :: PF !< parameter file character(len=*), intent(in) :: src_file !< source filename @@ -81,7 +81,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ real, allocatable, dimension(:), target :: z_edges_in, z_in ! Local variables for ALE remapping - real, dimension(:,:,:), allocatable :: hSrc ! Source thicknesses in H units. + real, dimension(:,:,:), allocatable :: hSrc ! Source thicknesses in H ~> m or kg m-2. real, dimension(:), allocatable :: h1 ! A 1-d column of source thicknesses in Z ~> m. real :: zTopOfCell, zBottomOfCell, z_bathy ! Heights in Z ~> m. type(remapping_CS) :: remapCS ! Remapping parameters and work arrays diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index 2db8e2d2c9..83bec30cf5 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -174,7 +174,7 @@ function tracer_z_init(tr_in, z_edges, e, nkml, nkbl, land_fill, wet, nlay, nlev integer, dimension(size(tr_in,1),size(tr_in,2)) :: nlevs_data !< number of valid levels in the input dataset integer :: n,i,j,k,l,nx,ny,nz,nt,kz integer :: k_top,k_bot,k_bot_prev,kk,kstart - real :: sl_tr ! The tracer concentration slope times the layer thickess, in tracer units. + real :: sl_tr ! The tracer concentration slope times the layer thickness, in tracer units. real :: epsln_Z ! A negligibly thin layer thickness, in Z ~> m. real, dimension(size(tr_in,3)) :: wt !< The fractional weight for each layer in the range between z1 and z2 real, dimension(size(tr_in,3)) :: z1, z2 ! z1 and z2 are the fractional depths of the top and bottom diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 1ac6c2a035..1b152e4137 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -323,7 +323,7 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), pointer :: G !< domain and grid information for ocean model type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables type(ODA_CS), pointer :: CS !< ocean DA control structure @@ -383,7 +383,7 @@ end subroutine set_prior_tracer subroutine get_posterior_tracer(Time, CS, h, tv, increment) type(time_type), intent(in) :: Time !< the current model time type(ODA_CS), pointer :: CS !< ocean DA control structure - real, dimension(:,:,:), pointer :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(:,:,:), pointer :: h !< Layer thicknesses, in H ~> m or kg m-2 type(thermo_var_ptrs), pointer :: tv !< A structure pointing to various thermodynamic variables logical, optional, intent(in) :: increment !< True if returning increment only diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index a7433c58bb..d6cd7b9da7 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -98,7 +98,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h type(ocean_grid_type), intent(inout) :: G !< Ocean grid. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg m-2). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H ~> m or kg m-2. real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points (s-1). real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points (s-1). type(vertvisc_type), intent(in) :: visc !< The vertical viscosity type. diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 3be015faa4..c252a9a613 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -183,7 +183,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 !! (usually m or kg m-2). real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: diffu !< Zonal acceleration due to convergence of @@ -201,10 +201,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & u0, & ! Laplacian of u (m-1 s-1) - h_u ! Thickness interpolated to u points, in H. + h_u ! Thickness interpolated to u points, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJB_(G)) :: & v0, & ! Laplacian of v (m-1 s-1) - h_v ! Thickness interpolated to v points, in H. + h_v ! Thickness interpolated to v points, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G)) :: & sh_xx, & ! horizontal tension (du/dx - dv/dy) (1/sec) including metric terms @@ -248,12 +248,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, ! This is set equal to zero if modified Leith is not used. real :: Shear_mag ! magnitude of the shear (1/s) real :: Vort_mag ! magnitude of the vorticity (1/s) - real :: h2uq, h2vq ! temporary variables in units of H^2 (i.e. m2 or kg2 m-4). + real :: h2uq, h2vq ! temporary variables in H2 ~> m2 or kg2 m-4. real :: hu, hv ! Thicknesses interpolated by arithmetic means to corner ! points; these are first interpolated to u or v velocity - ! points where masks are applied, in units of H (i.e. m or kg m-2). - real :: hq ! harmonic mean of the harmonic means of the u- & v- - ! point thicknesses, in H; This form guarantees that hq/hu < 4. + ! points where masks are applied, in H ~> m or kg m-2. + real :: hq ! harmonic mean of the harmonic means of the u- & v- poing thicknesses, + ! in H ~> m or kg m-2; This form guarantees that hq/hu < 4. real :: h_neglect ! thickness so small it can be lost in roundoff and so neglected (H) real :: h_neglect3 ! h_neglect^3, in H3 real :: hrat_min ! minimum thicknesses at the 4 neighboring diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 527eca30bc..8586af8483 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -157,7 +157,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 !! (usually m or kg m-2). type(thermo_var_ptrs), intent(in) :: tv !< Pointer to thermodynamic variables !! (needed for wave structure). diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 4963ba4bf0..a1dd5211ff 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -588,7 +588,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop real :: Khth_Loc ! Locally calculated thickness mixing coefficient (m2/s) real :: H_cutoff ! Local estimate of a minimum thickness for masking (m) real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. + ! in roundoff and can be neglected, in H ~> m or kg m-2. real :: S2 ! Interface slope squared (non-dim) real :: N2 ! Brunt-Vaisala frequency (1/s) real :: Hup, Hdn ! Thickness from above, below (m or kg m-2) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 3d0967c6bb..b32593f003 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -63,8 +63,8 @@ module MOM_mixed_layer_restrat !! timing of diagnostic output. real, dimension(:,:), pointer :: & - MLD_filtered => NULL(), & !< Time-filtered MLD (H units) - MLD_filtered_slow => NULL() !< Slower time-filtered MLD (H units) + MLD_filtered => NULL(), & !< Time-filtered MLD (H ~> m or kg m-2) + MLD_filtered_slow => NULL() !< Slower time-filtered MLD (H ~> m or kg m-2) !>@{ !! Diagnostic identifier @@ -100,7 +100,7 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment (sec) real, dimension(:,:), pointer :: MLD !< Mixed layer depth provided by the - !! PBL scheme (H units) + !! PBL scheme (H ~> m or kg m-2) type(VarMix_CS), pointer :: VarMix !< Container for derived fields type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure @@ -139,11 +139,11 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! sublayer of the mixed layer, divided by dt, in units ! of H * m2 s-1 (i.e., m3 s-1 or kg s-1). real, dimension(SZI_(G),SZJ_(G)) :: & - MLD_fast, & ! Mixed layer depth actually used in MLE restratification parameterization (H units) - htot_fast, & ! The sum of the thicknesses of layers in the mixed layer (H units) + MLD_fast, & ! Mixed layer depth actually used in MLE restratification parameterization (H ~> m or kg m-2) + htot_fast, & ! The sum of the thicknesses of layers in the mixed layer (H ~> m or kg m-2) Rml_av_fast, & ! g_Rho0 times the average mixed layer density (m s-2) - MLD_slow, & ! Mixed layer depth actually used in MLE restratification parameterization (H units) - htot_slow, & ! The sum of the thicknesses of layers in the mixed layer (H units) + MLD_slow, & ! Mixed layer depth actually used in MLE restratification parameterization (H ~> m or kg m-2) + htot_slow, & ! The sum of the thicknesses of layers in the mixed layer (H ~> m or kg m-2) Rml_av_slow ! g_Rho0 times the average mixed layer density (m s-2) real :: g_Rho0 ! G_Earth/Rho0 (m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1) real :: rho_ml(SZI_(G)) ! Potential density relative to the surface (kg m-3) @@ -154,7 +154,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real :: u_star ! surface friction velocity, interpolated to velocity points, in Z s-1 ~> m s-1. real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer (s-1) real :: timescale ! mixing growth timescale (sec) - real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected (H units) + real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected (H ~> m or kg m-2) real :: dz_neglect ! A tiny thickness (in Z ~> m) that is usually lost in roundoff so can be neglected real :: I4dt ! 1/(4 dt) (sec-1) real :: Ihtot,Ihtot_slow! total mixed layer thickness @@ -164,9 +164,9 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! the mixed layer must be 0. real :: b(SZK_(G)) ! As for a(k) but for the slow-filtered MLD real :: uDml(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml(SZI_(G)) ! half of the mixed layer in H m2 s-1 (m3 s-1 or kg s-1). + real :: vDml(SZI_(G)) ! half of the mixed layer in H m2 s-1 ~> m3 s-1 or kg s-1. real :: uDml_slow(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml_slow(SZI_(G)) ! half of the mixed layer in H m2 s-1 (m3 s-1 or kg s-1). + real :: vDml_slow(SZI_(G)) ! half of the mixed layer in H m2 s-1 ~> m3 s-1 or kg s-1. real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! restratification timescales real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! in the zonal and meridional ! directions, in s, stored in 2-D @@ -174,7 +174,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real :: uDml_diag(SZIB_(G),SZJ_(G)), vDml_diag(SZI_(G),SZJB_(G)) integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz real, dimension(SZI_(G)) :: rhoSurf, deltaRhoAtKm1, deltaRhoAtK - real, dimension(SZI_(G)) :: dK, dKm1 ! Depths of layer centers, in H. + real, dimension(SZI_(G)) :: dK, dKm1 ! Depths of layer centers, in H ~> m or kg m-2. real, dimension(SZI_(G)) :: pRef_MLD ! A reference pressure for calculating the mixed layer densities, in Pa. real, dimension(SZI_(G)) :: rhoAtK, rho1, d1, pRef_N2 ! Used for N2 real :: aFac, bFac, ddRho @@ -565,7 +565,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) ! sublayer of the mixed layer, divided by dt, in units ! of H m2 s-1 (i.e., m3 s-1 or kg s-1). real, dimension(SZI_(G),SZJ_(G)) :: & - htot, & ! The sum of the thicknesses of layers in the mixed layer (H units) + htot, & ! The sum of the thicknesses of layers in the mixed layer (H ~> m or kg m-2) Rml_av ! g_Rho0 times the average mixed layer density (m s-2) real :: g_Rho0 ! G_Earth/Rho0 (m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1) real :: Rho0(SZI_(G)) ! Potential density relative to the surface (kg m-3) @@ -576,18 +576,18 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) real :: u_star ! surface friction velocity, interpolated to velocity points, in Z s-1 ~> m s-1. real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer (s-1) real :: timescale ! mixing growth timescale (sec) - real :: h_neglect ! tiny thickness usually lost in roundoff and can be neglected (H units) + real :: h_neglect ! tiny thickness usually lost in roundoff and can be neglected (H ~> m or kg m-2) real :: dz_neglect ! tiny thickness (in Z ~> m) that usually lost in roundoff and can be neglected (meter) real :: I4dt ! 1/(4 dt) - real :: I2htot ! Twice the total mixed layer thickness at velocity points (H units) - real :: z_topx2 ! depth of the top of a layer at velocity points (H units) - real :: hx2 ! layer thickness at velocity points (H units) + real :: I2htot ! Twice the total mixed layer thickness at velocity points (H ~> m or kg m-2) + real :: z_topx2 ! depth of the top of a layer at velocity points (H ~> m or kg m-2) + real :: hx2 ! layer thickness at velocity points (H ~> m or kg m-2) real :: a(SZK_(G)) ! A non-dimensional value relating the overall flux ! magnitudes (uDml & vDml) to the realized flux in a ! layer. The vertical sum of a() through the pieces of ! the mixed layer must be 0. real :: uDml(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml(SZI_(G)) ! half of the mixed layer in H m2 s-1 (m3 s-1 or kg s-1). + real :: vDml(SZI_(G)) ! half of the mixed layer in H m2 s-1 ~> m3 s-1 or kg s-1. real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! The restratification timescales real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! in the zonal and meridional ! directions (sec), stored in 2-D diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index c71727619f..b445b50bde 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -45,7 +45,7 @@ module MOM_thickness_diffuse !! graver vertical modes by smoothing in the vertical. real :: FGNV_scale !< A coefficient scaling the vertical smoothing term in the !! Ferrari et al., 2010, streamfunction formulation. - real :: FGNV_c_min !< A minium wave speed used in the Ferrari et al., 2010, + real :: FGNV_c_min !< A minimum wave speed used in the Ferrari et al., 2010, !! streamfunction formulation (m s-1). real :: N2_floor !< A floor for Brunt-Vasaila frequency in the Ferrari et al., 2010, !! streamfunction formulation (s-2). @@ -118,7 +118,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp real :: Khth_Loc_u(SZIB_(G), SZJ_(G)) real :: Khth_Loc(SZIB_(G), SZJB_(G)) ! locally calculated thickness diffusivity (m2/s) real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. + ! in roundoff and can be neglected, in H ~> m or kg m-2. real, dimension(:,:), pointer :: cg1 => null() !< Wave speed (m/s) logical :: use_VarMix, Resoln_scaled, use_stored_slopes, khth_use_ebt_struct integer :: i, j, k, is, ie, js, je, nz @@ -338,7 +338,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp ! Diagnose diffusivity at T-cell point. Do simple average, rather than ! thickness-weighted average, in order that KH_t is depth-independent ! in the case where KH_u and KH_v are depth independent. Otherwise, - ! if use thickess weighted average, the variations of thickness with + ! if use thickness weighted average, the variations of thickness with ! depth will place a spurious depth dependence to the diagnosed KH_t. if (CS%id_KH_t > 0 .or. CS%id_KH_t1 > 0) then do k=1,nz @@ -407,7 +407,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H ~> m or kg m-2 real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions (Z) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: Kh_u !< Thickness diffusivity on interfaces !! at u points (m2/s) @@ -440,12 +440,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV Rho, & ! Density itself, when a nonlinear equation of state is ! not in use. h_avail, & ! The mass available for diffusion out of each face, divided - ! by dt, in H m2 s-1. + ! by dt, in H m2 s-1 ~> m2 s-1 or kg s-1. h_frac ! The fraction of the mass in the column above the bottom ! interface of a layer that is within a layer, ND. 0 m2 s-1 or kg s-1. real, dimension(SZIB_(G)) :: & drho_dT_u, & ! The derivatives of density with temperature and drho_dS_u ! salinity at u points, in kg m-3 K-1 and kg m-3 psu-1. @@ -474,13 +474,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! in Z kg m-3 ~> kg m-2. real :: drdkDe_v(SZI_(G),SZK_(G)+1) ! Lateral difference of product of drdk and e at v-points, ! in Z kg m-3 ~> kg m-2. - real :: hg2A, hg2B, hg2L, hg2R ! Squares of geometric mean thicknesses, in H2. - real :: haA, haB, haL, haR ! Arithmetic mean thicknesses in H. + real :: hg2A, hg2B, hg2L, hg2R ! Squares of geometric mean thicknesses, in H2 ~> m2 or kg2 m-4. + real :: haA, haB, haL, haR ! Arithmetic mean thicknesses in H ~> m or kg m-2. real :: dzaL, dzaR ! Temporary thicknesses in Z ~> m. real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. real :: drdx, drdy ! Zonal and meridional density gradients, in kg m-4. real :: drdz ! Vertical density gradient, in units of kg m-3 Z-1 ~> kg m-4. - real :: h_harm ! Harmonic mean layer thickness, in H. + real :: h_harm ! Harmonic mean layer thickness, in H ~> m or kg m-2. real :: c2_h_u(SZIB_(G), SZK_(G)+1) ! Wave speed squared divided by h at u-points, in m2 Z-1 s-2 ~> m s-2. real :: c2_h_v(SZI_(G), SZK_(G)+1) ! Wave speed squared divided by h at v-points, in m2 Z-1 s-2 ~> m s-2. real :: hN2_u(SZIB_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above u-points, in m2 Z-1 s-2. @@ -491,7 +491,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: Sfn_unlim_v(SZI_(G), SZK_(G)+1) ! Streamfunction for v-points, in Z m2 s-1 ~> m3 s-1. real :: slope2_Ratio_u(SZIB_(G), SZK_(G)+1) ! The ratio of the slope squared to slope_max squared. real :: slope2_Ratio_v(SZI_(G), SZK_(G)+1) ! The ratio of the slope squared to slope_max squared. - real :: Sfn_in_h ! The overturning streamfunction, in H m2 s-1 (note units different from other Sfn vars). + real :: Sfn_in_h ! The overturning streamfunction, in H m2 s-1 ~> m2 s-1 or kg s-1 (note that + ! the units are different from other Sfn vars). real :: Sfn_safe ! The streamfunction that goes linearly back to 0 at the surface. This is a ! good thing to use when the slope is so large as to be meaningless (Z m2 s-1 ~> m3 s-1). real :: Slope ! The slope of density surfaces, calculated in a way @@ -499,8 +500,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: mag_grad2 ! The squared magnitude of the 3-d density gradient, in kg2 m-8. real :: I_slope_max2 ! The inverse of slope_max squared, nondimensional. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. - real :: h_neglect2 ! h_neglect^2, in H2. + ! in roundoff and can be neglected, in H ~> m or kg m-2. + real :: h_neglect2 ! h_neglect^2, in H2 ~> m2 or kg2 m-4. real :: dz_neglect ! A thickness, in Z ~> m, that is so small it is usually lost ! in roundoff and can be neglected, in Z ~> m. real :: G_scale ! The gravitational acceleration times some unit conversion @@ -1217,7 +1218,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & de_top ! The distances between the top of a layer and the top of the - ! region where the detangling is applied, in H. + ! region where the detangling is applied, in H ~> m or kg m-2. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & Kh_lay_u ! The tentative interface height diffusivity for each layer at ! u points, in m2 s-1. @@ -1226,8 +1227,8 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! v points, in m2 s-1. real, dimension(SZI_(G),SZJ_(G)) :: & de_bot ! The distances from the bottom of the region where the - ! detangling is applied, in H. - real :: h1, h2 ! The thinner and thicker surrounding thicknesses, in H, + ! detangling is applied, in H ~> m or kg m-2. + real :: h1, h2 ! The thinner and thicker surrounding thicknesses, in H ~> m or kg m-2, ! with the thinner modified near the boundaries to mask out ! thickness variations due to topography, etc. real :: jag_Rat ! The nondimensional jaggedness ratio for a layer, going @@ -1238,7 +1239,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! layers, nondim. real :: Kh_det ! The detangling diffusivity, in m2 s-1. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. + ! in roundoff and can be neglected, in H ~> m or kg m-2. real :: I_sl ! The absolute value of the larger in magnitude of the slopes ! above and below. @@ -1611,7 +1612,7 @@ end subroutine add_detangling_Kh subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H ~> m or kg m-2 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Input temperature (C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Input salinity (ppt) real, intent(in) :: kappa !< Constant diffusivity to use (Z2/s) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 78a1f44fab..50e35da04e 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -337,7 +337,7 @@ end function get_ALE_sponge_nz_data subroutine get_ALE_sponge_thicknesses(G, data_h, sponge_mask, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). real, allocatable, dimension(:,:,:), & - intent(inout) :: data_h !< The thicknesses of the sponge input layers, in H. + intent(inout) :: data_h !< The thicknesses of the sponge input layers, in H ~> m or kg m-2. logical, dimension(SZI_(G),SZJ_(G)), & intent(out) :: sponge_mask !< A logical mask that is true where !! sponges are being applied. @@ -845,7 +845,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thickness, in H (in) + intent(inout) :: h !< Layer thickness, in H ~> m or kg m-2 (in) real, intent(in) :: dt !< The amount of time covered by this call, in s (in). type(ALE_sponge_CS), pointer :: CS !< A pointer to the control structure for this module !! that is set by a previous call to initialize_sponge (in). diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index ea5a6781a8..6fc42b2312 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -86,7 +86,7 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf, halo) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any available !! thermodynamic fields. type(diabatic_aux_CS), intent(in) :: CS !< The control structure returned by a previous @@ -219,7 +219,7 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any !! available thermodynamic fields. type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom @@ -228,20 +228,20 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) ! local variables real, dimension(SZI_(G)) :: & - b1_T, b1_S, & ! Variables used by the tridiagonal solvers of T & S, in H. + b1_T, b1_S, & ! Variables used by the tridiagonal solvers of T & S, in H ~> m or kg m-2. d1_T, d1_S ! Variables used by the tridiagonal solvers, nondim. real, dimension(SZI_(G),SZK_(G)) :: & - c1_T, c1_S ! Variables used by the tridiagonal solvers, in H. + c1_T, c1_S ! Variables used by the tridiagonal solvers, in H ~> m or kg m-2. real, dimension(SZI_(G),SZK_(G)+1) :: & - mix_T, mix_S ! Mixing distances in both directions across each interface, in H. + mix_T, mix_S ! Mixing distances in both directions across each interface, in H ~> m or kg m-2. real :: h_tr ! h_tr is h at tracer points with a tiny thickness - ! added to ensure positive definiteness, in H. + ! added to ensure positive definiteness, in H ~> m or kg m-2. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. + ! in roundoff and can be neglected, in H ~> m or kg m-2. real :: I_h_int ! The inverse of the thickness associated with an - ! interface, in H-1. + ! interface, in H-1 ~> m-1 or m2 kg-1. real :: b_denom_T ! The first term in the denominators for the expressions - real :: b_denom_S ! for b1_T and b1_S, both in H. + real :: b_denom_S ! for b1_T and b1_S, both in H ~> m or kg m-2. real, dimension(:,:,:), pointer :: T=>NULL(), S=>NULL() real, dimension(:,:,:), pointer :: Kd_T=>NULL(), Kd_S=>NULL() ! Diffusivities in Z2 s-1 ~> m2 s-1. integer :: i, j, k, is, ie, js, je, nz @@ -322,7 +322,7 @@ subroutine adjust_salt(h, tv, G, GV, CS, halo) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any !! available thermodynamic fields. type(diabatic_aux_CS), intent(in) :: CS !< The control structure returned by a previous @@ -385,7 +385,7 @@ subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any !! available thermodynamic fields type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes @@ -508,11 +508,12 @@ subroutine triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, T, S) integer, intent(in) :: ie !< The end i-index to work on. integer, intent(in) :: js !< The start j-index to work on. integer, intent(in) :: je !< The end j-index to work on. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: hold !< The layer thicknesses before entrainment, in H. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: hold !< The layer thicknesses before entrainment, + !! in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: ea !< The amount of fluid entrained from the layer - !! above within this time step, in units of H. + !! above within this time step, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: eb !< The amount of fluid entrained from the layer - !! below within this time step, in units of H. + !! below within this time step, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: T !< Layer potential temperatures, in degC. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: S !< Layer salinities, in PSU. @@ -557,18 +558,18 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: u_h !< Zonal velocity interpolated to h points, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: v_h !< Meridional velocity interpolated to h points, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: ea !< The amount of fluid entrained from the layer - !! above within this time step, in units of H. + !! above within this time step, in H ~> m or kg m-2. !! Omitting ea is the same as setting it to 0. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: eb !< The amount of fluid entrained from the layer - !! below within this time step, in units of H. + !! below within this time step, in H ~> m or kg m-2. !! Omitting eb is the same as setting it to 0. ! local variables @@ -656,7 +657,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: id_MLD !< Handle (ID) of MLD diagnostic real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thickness, in H (usually m or kg m-3) + intent(in) :: h !< Layer thickness, in H ~> m or kg m-2 type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any !! available thermodynamic fields. real, intent(in) :: densityDiff !< Density difference to determine MLD (kg/m3) @@ -779,7 +780,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & type(forcing), intent(inout) :: fluxes !< Surface fluxes container type(optics_type), pointer :: optics !< Optical properties container real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thickness in H units + intent(inout) :: h !< Layer thickness in H ~> m or kg m-2 type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any !! available thermodynamic fields. logical, intent(in) :: aggregate_FW_forcing !< If False, treat in/out fluxes separately. @@ -810,9 +811,9 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & d_pres, & ! pressure change across a layer (Pa) p_lay, & ! average pressure in a layer (Pa) pres, & ! pressure at an interface (Pa) - netMassInOut, & ! surface water fluxes (H units) over time step - netMassIn, & ! mass entering ocean surface (H units) over a time step - netMassOut, & ! mass leaving ocean surface (H units) over a time step + netMassInOut, & ! surface water fluxes (H ~> m or kg m-2) over time step + netMassIn, & ! mass entering ocean surface (H ~> m or kg m-2) over a time step + netMassOut, & ! mass leaving ocean surface (H ~> m or kg m-2) over a time step netHeat, & ! heat (degC * H) via surface fluxes, excluding ! Pen_SW_bnd and netMassOut netSalt, & ! surface salt flux ( g(salt)/m2 for non-Bouss and ppt*H for Bouss ) @@ -926,10 +927,10 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & ! The surface forcing is contained in the fluxes type. ! We aggregate the thermodynamic forcing for a time step into the following: - ! netMassInOut = surface water fluxes (H units) over time step + ! netMassInOut = surface water fluxes (H ~> m or kg m-2) over time step ! = lprec + fprec + vprec + evap + lrunoff + frunoff ! note that lprec generally has sea ice melt/form included. - ! netMassOut = net mass leaving ocean surface (H units) over a time step. + ! netMassOut = net mass leaving ocean surface (H ~> m or kg m-2) over a time step. ! netMassOut < 0 means mass leaves ocean. ! netHeat = heat (degC * H) via surface fluxes, excluding the part ! contained in Pen_SW_bnd; and excluding heat_content of netMassOut < 0. diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 460b615173..a23857ba76 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -325,7 +325,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! These are targets so that the space can be shared with eaml & ebml. eatr, & ! The equivalent of ea and eb for tracers, which differ from ea and ebtr ! eb in that they tend to homogenize tracers in massless layers - ! near the boundaries in H (m for Bouss and kg/m^2 for non-Bouss) + ! near the boundaries in H ~> m or kg m-2 (for Bous or non-Bouss) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & Kd_int, & ! diapycnal diffusivity of interfaces (m^2/s) @@ -340,7 +340,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! The following 5 variables are only used with a bulk mixed layer. real, pointer, dimension(:,:,:) :: & - eaml, & ! The equivalent of ea and eb due to mixed layer processes, in H + eaml, & ! The equivalent of ea and eb due to mixed layer processes, in H ~> m or kg m-2 ebml ! (m for Bouss and kg/m^2 for non-Bouss). These will be ! pointers to eatr and ebtr so as to reuse the memory as ! the arrays are not needed at the same time. @@ -372,7 +372,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real :: Tr_ea_BBL ! The diffusive tracer thickness in the BBL that is ! coupled to the bottom within a timestep (m) - real :: htot(SZIB_(G)) ! The summed thickness from the bottom, in H. + real :: htot(SZIB_(G)) ! The summed thickness from the bottom, in H ~> m or kg m-2. real :: b1(SZIB_(G)), d1(SZIB_(G)) ! b1, c1, and d1 are variables used by the real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. @@ -1211,7 +1211,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! near the boundaries (m for Bouss and kg/m^2 for non-Bouss) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & - Kd_int, & ! diapycnal diffusivity of interfaces (m^2/s) + Kd_int, & ! diapycnal diffusivity of interfaces (Z^2/s) Kd_heat, & ! diapycnal diffusivity of heat (Z^2/s) Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (Z^2/s) Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (Z^2/s) diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 686f8b5fef..fe07a0d162 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -50,7 +50,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(G%isd:G%ied,G%jsd:G%jed,GV%ke), & - intent(in) :: h_3d !< Layer thickness before entrainment, in H. + intent(in) :: h_3d !< Layer thickness before entrainment, in H ~> m or kg m-2. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. !! Absent fields have NULL ptrs. @@ -63,10 +63,10 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) ! Local variables real, dimension(GV%ke) :: & T0, S0, & ! T0 & S0 are columns of initial temperatures and salinities, in degC and g/kg. - h_col ! h_col is a column of thicknesses h at tracer points, in H (m or kg m-2). + h_col ! h_col is a column of thicknesses h at tracer points, in H ~> m or kg m-2. real, dimension(GV%ke+1) :: & Kd, & ! A column of diapycnal diffusivities at interfaces, in Z2 s-1 ~> m2 s-1. - h_top, h_bot ! Distances from the top or bottom, in H. + h_top, h_bot ! Distances from the top or bottom, in H ~> m or kg m-2. real :: ustar, absf, htot real :: energy_Kd ! The energy used by diapycnal mixing in W m-2. real :: tmp1 ! A temporary array. @@ -123,7 +123,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(GV%ke), intent(in) :: h_in !< Layer thickness before entrainment, - !! in H (m or kg m-2). + !! in H ~> m or kg m-2. real, dimension(GV%ke), intent(in) :: T_in !< The layer temperatures, in degC. real, dimension(GV%ke), intent(in) :: S_in !< The layer salinities, in g kg-1. real, dimension(GV%ke+1), intent(in) :: Kd !< The interfaces diapycnal diffusivities, @@ -185,10 +185,10 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ! of mixing with layers lower in the water column, in ! units of J m-2 K-1 and J m-2 ppt-1. hp_a, & ! An effective pivot thickness of the layer including the effects - ! of coupling with layers above, in H. This is the first term + ! of coupling with layers above, in H ~> m or kg m-2. This is the first term ! in the denominator of b1 in a downward-oriented tridiagonal solver. hp_b, & ! An effective pivot thickness of the layer including the effects - ! of coupling with layers below, in H. This is the first term + ! of coupling with layers below, in H ~> m or kg m-2. This is the first term ! in the denominator of b1 in an upward-oriented tridiagonal solver. c1_a, & ! c1_a is used by a downward-oriented tridiagonal solver, ND. c1_b, & ! c1_b is used by an upward-oriented tridiagonal solver, ND. @@ -198,16 +198,16 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & pres, & ! Interface pressures in Pa. pres_Z, & ! Interface pressures with a rescaling factor to convert interface height ! movements into changes in column potential energy, in J m-2 Z-1. - z_Int, & ! Interface heights relative to the surface, in H. + z_Int, & ! Interface heights relative to the surface, in H ~> m or kg m-2. N2, & ! An estimate of the buoyancy frequency in s-2. Kddt_h, & ! The diapycnal diffusivity times a timestep divided by the - ! average thicknesses around a layer, in H (m or kg m-2). + ! average thicknesses around a layer, in H ~> m or kg m-2. Kddt_h_a, & ! The value of Kddt_h for layers above the central point in the - ! tridiagonal solver, in H. + ! tridiagonal solver, in H ~> m or kg m-2. Kddt_h_b, & ! The value of Kddt_h for layers below the central point in the - ! tridiagonal solver, in H. + ! tridiagonal solver, in H ~> m or kg m-2. Kd_so_far ! The value of Kddt_h that has been applied already in - ! calculating the energy changes, in H (m or kg m-2). + ! calculating the energy changes, in H ~> m or kg m-2. real, dimension(GV%ke+1,4) :: & PE_chg_k, & ! The integrated potential energy change within a timestep due ! to the diffusivity at interface K for 4 different orders of @@ -215,18 +215,18 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ColHt_cor_k ! The correction to the potential energy change due to ! changes in the net column height, in J m-2. real :: & - b1 ! b1 is used by the tridiagonal solver, in H-1. + b1 ! b1 is used by the tridiagonal solver, in H-1 ~> m-1 or m2 kg-1. real :: & - I_b1 ! The inverse of b1, in H. - real :: Kd0 ! The value of Kddt_h that has already been applied, in H. - real :: dKd ! The change in the value of Kddt_h, in H. + I_b1 ! The inverse of b1, in H ~> m or kg m-2. + real :: Kd0 ! The value of Kddt_h that has already been applied, in H ~> m or kg m-2. + real :: dKd ! The change in the value of Kddt_h, in H ~> m or kg m-2. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. + ! in roundoff and can be neglected, in H ~> m or kg m-2. real :: dTe_term ! A diffusivity-independent term related to the temperature ! change in the layer below the interface, in K H. real :: dSe_term ! A diffusivity-independent term related to the salinity ! change in the layer below the interface, in ppt H. - real :: Kddt_h_guess ! A guess of the final value of Kddt_h, in H. + real :: Kddt_h_guess ! A guess of the final value of Kddt_h, in H ~> m or kg m-2. real :: dMass ! The mass per unit area within a layer, in kg m-2. real :: dPres ! The hydrostatic pressure change across a layer, in Pa. real :: dMKE_max ! The maximum amount of mean kinetic energy that could be @@ -238,7 +238,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ! present interface, in J m-2. real :: ColHt_cor ! The correction to PE_chg that is made due to a net ! change in the column height, in J m-2. - real :: htot ! A running sum of thicknesses, in H. + real :: htot ! A running sum of thicknesses, in H ~> m or kg m-2. real :: dTe_t2, dT_km1_t2, dT_k_t2 ! Temporary arrays describing temperature changes. real :: dSe_t2, dS_km1_t2, dS_k_t2 ! Temporary arrays describing salinity changes. logical :: do_print @@ -970,18 +970,18 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & PE_chg, dPEc_dKd, dPE_max, dPEc_dKd_0, ColHt_cor) real, intent(in) :: Kddt_h0 !< The previously used diffusivity at an interface times !! the time step and divided by the average of the - !! thicknesses around the interface, in units of H (m or kg-2). + !! thicknesses around the interface, in H ~> m or kg m-2. real, intent(in) :: dKddt_h !< The trial change in the diffusivity at an interface times !! the time step and divided by the average of the - !! thicknesses around the interface, in units of H (m or kg-2). + !! thicknesses around the interface, in H ~> m or kg m-2. real, intent(in) :: hp_a !< The effective pivot thickness of the layer above the !! interface, given by h_k plus a term that !! is a fraction (determined from the tridiagonal solver) of - !! Kddt_h for the interface above, in H. + !! Kddt_h for the interface above, in H ~> m or kg m-2. real, intent(in) :: hp_b !< The effective pivot thickness of the layer below the !! interface, given by h_k plus a term that !! is a fraction (determined from the tridiagonal solver) of - !! Kddt_h for the interface above, in H. + !! Kddt_h for the interface above, in H ~> m or kg m-2. real, intent(in) :: Th_a !< An effective temperature times a thickness in the layer !! above, including implicit mixing effects with other !! yet higher layers, in K H. @@ -1042,8 +1042,8 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real, optional, intent(out) :: ColHt_cor !< The correction to PE_chg that is made due to a net !! change in the column height, in J m-2. - real :: hps ! The sum of the two effective pivot thicknesses, in H. - real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term, in H2. + real :: hps ! The sum of the two effective pivot thicknesses, in H ~> m or kg m-2. + real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term, in H2 ~> m2 or k2 m-4. real :: dT_c ! The core term in the expressions for the temperature changes, in K H2. real :: dS_c ! The core term in the expressions for the salinity changes, in psu H2. real :: PEc_core ! The diffusivity-independent core term in the expressions @@ -1120,12 +1120,12 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & PE_chg, dPEc_dKd, dPE_max, dPEc_dKd_0) real, intent(in) :: Kddt_h !< The diffusivity at an interface times the time step and !! divided by the average of the thicknesses around the - !! interface, in units of H (m or kg-2). - real, intent(in) :: h_k !< The thickness of the layer below the interface, in H. + !! interface, in H ~> m or kg m-2. + real, intent(in) :: h_k !< The thickness of the layer below the interface, in H ~> m or kg m-2. real, intent(in) :: b_den_1 !< The first term in the denominator of the pivot !! for the tridiagonal solver, given by h_k plus a term that !! is a fraction (determined from the tridiagonal solver) of - !! Kddt_h for the interface above, in H. + !! Kddt_h for the interface above, in H ~> m or kg m-2. real, intent(in) :: dTe_term !< A diffusivity-independent term related to the !! temperature change in the layer below the interface, in K H. real, intent(in) :: dSe_term !< A diffusivity-independent term related to the @@ -1189,14 +1189,15 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & ! this routine can also be used for an upward pass with the sense of direction ! reversed. - real :: b1 ! b1 is used by the tridiagonal solver, in H-1. + real :: b1 ! b1 is used by the tridiagonal solver, in H-1 ~> m-1 or m2 kg-1. real :: b1Kd ! Temporary array (nondim.) real :: ColHt_chg ! The change in column thickness in m. - real :: dColHt_max ! The change in column thickess for infinite diffusivity, in m. - real :: dColHt_dKd ! The partial derivative of column thickess with diffusivity, in s m-1. + real :: dColHt_max ! The change in column thickness for infinite diffusivity, in m. + real :: dColHt_dKd ! The partial derivative of column thickness with diffusivity, in s m-1. real :: dT_k, dT_km1 ! Temporary arrays in K. real :: dS_k, dS_km1 ! Temporary arrays in ppt. - real :: I_Kr_denom, dKr_dKd ! Temporary arrays in H-2 and nondim. + real :: I_Kr_denom ! Temporary arrays in H-2 ~> m-2 or m4 kg-2. + real :: dKr_dKd ! Nondimensional temporary array. real :: ddT_k_dKd, ddT_km1_dKd ! Temporary arrays in K H-1. real :: ddS_k_dKd, ddS_km1_dKd ! Temporary arrays in ppt H-1. diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 2578ea6a9e..90ae40e9d9 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -189,7 +189,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h_3d !< Layer thicknesses, in H (usually m or kg m-2). + intent(inout) :: h_3d !< Layer thicknesses, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u_3d !< Zonal velocities interpolated to h points, !! m s-1. @@ -263,7 +263,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Local variables real, dimension(SZI_(G),SZK_(GV)) :: & - h, & ! The layer thickness, in H (usually m or kg m-2). + h, & ! The layer thickness, in H ~> m or kg m-2. T, & ! The layer temperatures, in deg C. S, & ! The layer salinities, in psu. u, & ! The zonal velocity, in m s-1. @@ -281,14 +281,14 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS conv_PErel, & ! The potential energy that has been convectively released ! during this timestep, in J m-2 = kg s-2. A portion nstar_FC ! of conv_PErel is available to drive mixing. - htot, & ! The total depth of the layers above an interface, in H. + htot, & ! The total depth of the layers above an interface, in H ~> m or kg m-2. uhtot, & ! The depth integrated zonal and meridional velocities in the - vhtot, & ! layers above, in H m s-1. + vhtot, & ! layers above, in H m s-1 ~> m2 s-1 or kg m-1 s-1. mech_TKE_top, & ! The value of mech_TKE at the top of the column, in J m-2. conv_PErel_top, & ! The value of conv_PErel at the top of the column, in J m-2. - Idecay_len_TKE, & ! The inverse of a turbulence decay length scale, in H-1. - h_sum, & ! The total thickness of the water column, in H. + Idecay_len_TKE, & ! The inverse of a turbulence decay length scale, in H-1 ~> m-1 or m2 kg-1. + h_sum, & ! The total thickness of the water column, in H ~> m or kg m-2. absf ! The absolute value of f, in s-1. @@ -320,17 +320,17 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! including implicit mixing effects with other yet lower layers, in K H. real, dimension(SZI_(G)) :: & hp_a ! An effective pivot thickness of the layer including the effects - ! of coupling with layers above, in H. This is the first term + ! of coupling with layers above, in H ~> m or kg m-2. This is the first term ! in the denominator of b1 in a downward-oriented tridiagonal solver. real, dimension(SZK_(GV)+1) :: & MixLen_shape, & ! A nondimensional shape factor for the mixing length that ! gives it an appropriate assymptotic value at the bottom of ! the boundary layer. Kddt_h ! The diapycnal diffusivity times a timestep divided by the - ! average thicknesses around a layer, in H (m or kg m-2). - real :: b1 ! b1 is inverse of the pivot used by the tridiagonal solver, in H-1. + ! average thicknesses around a layer, in H ~> m or kg m-2. + real :: b1 ! b1 is inverse of the pivot used by the tridiagonal solver, in H-1 ~> m-1 or m2 kg-1. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. + ! in roundoff and can be neglected, in H ~> m or kg m-2. real :: dMass ! The mass per unit area within a layer, in kg m-2. real :: dPres ! The hydrostatic pressure change across a layer, in Pa. real :: dMKE_max ! The maximum amount of mean kinetic energy that could be @@ -339,18 +339,18 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! the water above the interface, in J m-2 = kg s-2. real :: MKE2_Hharm ! Twice the inverse of the harmonic mean of the thickness ! of a layer and the thickness of the water above, used in - ! the MKE conversion equation, in H-1. + ! the MKE conversion equation, in H-1 ~> m-1 or m2 kg-1. real :: dt_h ! The timestep divided by the averages of the thicknesses around - ! a layer, times a thickness conversion factor, in H s m-2. - real :: h_bot ! The distance from the bottom, in H. + ! a layer, times a thickness conversion factor, in H s m-2 ~> s m-1 or kg s m-4. + real :: h_bot ! The distance from the bottom, in H ~> m or kg m-2. real :: h_rsum ! The running sum of h from the top, in Z ~> m. - real :: I_hs ! The inverse of h_sum, in H-1. + real :: I_hs ! The inverse of h_sum, in H-1 ~> m-1 or m2 kg-1. real :: I_MLD ! The inverse of the current value of MLD, in Z-1 ~> m-1. real :: h_tt ! The distance from the surface or up to the next interface ! that did not exhibit turbulent mixing from this scheme plus - ! a surface mixing roughness length given by h_tt_min, in H. - real :: h_tt_min ! A surface roughness length, in H. + ! a surface mixing roughness length given by h_tt_min, in H ~> m or kg m-2. + real :: h_tt_min ! A surface roughness length, in H ~> m or kg m-2. real :: C1_3 ! = 1/3. real :: vonKar ! The vonKarman constant. @@ -386,7 +386,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 real :: dPEa_dKd_g0 real :: Kddt_h_g0 ! The first guess diapycnal diffusivity times a timestep divided - ! by the average thicknesses around a layer, in H (m or kg m-2). + ! by the average thicknesses around a layer, in H ~> m or kg m-2. real :: PE_chg_max ! The maximum PE change for very large values of Kddt_h(K). real :: dPEc_dKd_Kd0 ! The partial derivative of PE change with Kddt_h(K) ! for very small values of Kddt_h(K), in J m-2 H-1. @@ -397,11 +397,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! recent guess at Kddt_h(K), in J m-2. real :: dPEc_dKd ! The partial derivative of PE_chg with Kddt_h(K), in J m-2 H-1. real :: TKE_left_min, TKE_left_max, Kddt_h_max, Kddt_h_min - real :: Kddt_h_guess ! A guess at the value of Kddt_h(K), in H. - real :: Kddt_h_next ! The next guess at the value of Kddt_h(K), in H. - real :: dKddt_h ! The change between guesses at Kddt_h(K), in H. - real :: dKddt_h_Newt ! The change between guesses at Kddt_h(K) with Newton's method, in H. - real :: Kddt_h_newt ! The Newton's method next guess for Kddt_h(K), in H. + real :: Kddt_h_guess ! A guess at the value of Kddt_h(K), in H ~> m or kg m-2. + real :: Kddt_h_next ! The next guess at the value of Kddt_h(K), in H ~> m or kg m-2. + real :: dKddt_h ! The change between guesses at Kddt_h(K), in H ~> m or kg m-2. + real :: dKddt_h_Newt ! The change between guesses at Kddt_h(K) with Newton's method, in H ~> m or kg m-2. + real :: Kddt_h_newt ! The Newton's method next guess for Kddt_h(K), in H ~> m or kg m-2. real :: exp_kh ! The nondimensional decay of TKE across a layer, ND. logical :: use_Newt ! Use Newton's method for the next guess at Kddt_h(K). logical :: convectively_stable @@ -1556,18 +1556,18 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & PE_chg, dPEc_dKd, dPE_max, dPEc_dKd_0, ColHt_cor) real, intent(in) :: Kddt_h0 !< The previously used diffusivity at an interface times !! the time step and divided by the average of the - !! thicknesses around the interface, in units of H (m or kg-2). + !! thicknesses around the interface, in H ~> m or kg m-2. real, intent(in) :: dKddt_h !< The trial change in the diffusivity at an interface times !! the time step and divided by the average of the - !! thicknesses around the interface, in units of H (m or kg-2). + !! thicknesses around the interface, in H ~> m or kg m-2. real, intent(in) :: hp_a !< The effective pivot thickness of the layer above the !! interface, given by h_k plus a term that !! is a fraction (determined from the tridiagonal solver) of - !! Kddt_h for the interface above, in H. + !! Kddt_h for the interface above, in H ~> m or kg m-2. real, intent(in) :: hp_b !< The effective pivot thickness of the layer below the !! interface, given by h_k plus a term that !! is a fraction (determined from the tridiagonal solver) of - !! Kddt_h for the interface above, in H. + !! Kddt_h for the interface above, in H ~> m or kg m-2. real, intent(in) :: Th_a !< An effective temperature times a thickness in the layer !! above, including implicit mixing effects with other !! yet higher layers, in K H. @@ -1628,8 +1628,8 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real, optional, intent(out) :: ColHt_cor !< The correction to PE_chg that is made due to a net !! change in the column height, in J m-2. - real :: hps ! The sum of the two effective pivot thicknesses, in H. - real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term, in H2. + real :: hps ! The sum of the two effective pivot thicknesses, in H ~> m or kg m-2. + real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term, in H2 ~> m2 or kg2 m-4. real :: dT_c ! The core term in the expressions for the temperature changes, in K H2. real :: dS_c ! The core term in the expressions for the salinity changes, in psu H2. real :: PEc_core ! The diffusivity-independent core term in the expressions @@ -1705,12 +1705,12 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & PE_chg, dPEc_dKd, dPE_max, dPEc_dKd_0) real, intent(in) :: Kddt_h !< The diffusivity at an interface times the time step and !! divided by the average of the thicknesses around the - !! interface, in units of H (m or kg-2). - real, intent(in) :: h_k !< The thickness of the layer below the interface, in H. + !! interface, in H ~> m or kg m-2. + real, intent(in) :: h_k !< The thickness of the layer below the interface, in H ~> m or kg m-2. real, intent(in) :: b_den_1 !< The first term in the denominator of the pivot !! for the tridiagonal solver, given by h_k plus a term that !! is a fraction (determined from the tridiagonal solver) of - !! Kddt_h for the interface above, in H. + !! Kddt_h for the interface above, in H ~> m or kg m-2. real, intent(in) :: dTe_term !< A diffusivity-independent term related to the !! temperature change in the layer below the interface, in K H. real, intent(in) :: dSe_term !< A diffusivity-independent term related to the @@ -1774,14 +1774,15 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & ! this routine can also be used for an upward pass with the sense of direction ! reversed. - real :: b1 ! b1 is used by the tridiagonal solver, in H-1. + real :: b1 ! b1 is used by the tridiagonal solver, in H-1 ~> m-1 or m2 kg-1. real :: b1Kd ! Temporary array (nondim.) real :: ColHt_chg ! The change in column thickness in m. - real :: dColHt_max ! The change in column thickess for infinite diffusivity, in m. - real :: dColHt_dKd ! The partial derivative of column thickess with diffusivity, in s m-1. + real :: dColHt_max ! The change in column thickness for infinite diffusivity, in m. + real :: dColHt_dKd ! The partial derivative of column thickness with diffusivity, in s m-1. real :: dT_k, dT_km1 ! Temporary arrays in K. real :: dS_k, dS_km1 ! Temporary arrays in ppt. - real :: I_Kr_denom, dKr_dKd ! Temporary arrays in H-2 and nondim. + real :: I_Kr_denom ! Temporary array in H-2 ~> m-2 or m4 kg-2 + real :: dKr_dKd ! Nondimensional temporary array. real :: ddT_k_dKd, ddT_km1_dKd ! Temporary arrays in K H-1. real :: ddS_k_dKd, ddS_km1_dKd ! Temporary arrays in ppt H-1. diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 1e01e1acdd..e531520aa3 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -56,7 +56,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available !! thermodynamic fields. Absent fields have NULL !! ptrs. @@ -99,20 +99,20 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, ! translated into the same unints as h, m2 or kg2 m-4 (i.e. H2). real, dimension(SZI_(G),SZK_(G)) :: & F, & ! The density flux through a layer within a time step divided by the - ! density difference across the interface below the layer, in H. + ! density difference across the interface below the layer, in H ~> m or kg m-2. maxF, & ! maxF is the maximum value of F that will not deplete all of the - ! layers above or below a layer within a timestep, in H. + ! layers above or below a layer within a timestep, in H ~> m or kg m-2. minF, & ! minF is the minimum flux that should be expected in the absence of - ! interactions between layers, in H. - Fprev, &! The previous estimate of F, in H. + ! interactions between layers, in H ~> m or kg m-2. + Fprev, &! The previous estimate of F, in H ~> m or kg m-2. dFdfm, &! The partial derivative of F with respect to changes in F of the ! neighboring layers. Nondimensional. h_guess ! An estimate of the layer thicknesses after entrainment, but ! before the entrainments are adjusted to drive the layer - ! densities toward their target values, in H. + ! densities toward their target values, in H ~> m or kg m-2. real, dimension(SZI_(G),SZK_(G)+1) :: & Ent_bl ! The average entrainment upward and downward across - ! each interface around the buffer layers, in H. + ! each interface around the buffer layers, in H ~> m or kg m-2. real, allocatable, dimension(:,:,:) :: & Kd_eff, & ! The effective diffusivity that actually applies to each ! layer after the effects of boundary conditions are @@ -126,14 +126,14 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. real, dimension(SZI_(G)) :: & - htot, & ! The total thickness above or below a layer in H. + htot, & ! The total thickness above or below a layer in H ~> m or kg m-2. Rcv, & ! Value of the coordinate variable (potential density) ! based on the simulated T and S and P_Ref, kg m-3. pres, & ! Reference pressure (P_Ref) in Pa. eakb, & ! The entrainment from above by the layer below the buffer - ! layer (i.e. layer kb), in H. - ea_kbp1, & ! The entrainment from above by layer kb+1, in H. - eb_kmb, & ! The entrainment from below by the deepest buffer layer, in H. + ! layer (i.e. layer kb), in H ~> m or kg m-2. + ea_kbp1, & ! The entrainment from above by layer kb+1, in H ~> m or kg m-2. + eb_kmb, & ! The entrainment from below by the deepest buffer layer, in H ~> m or kg m-2. dS_kb, & ! The reference potential density difference across the ! interface between the buffer layers and layer kb, in kg m-3. dS_anom_lim, &! The amount by which dS_kb is reduced when limits are @@ -141,28 +141,28 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, I_dSkbp1, & ! The inverse of the potential density difference across the ! interface below layer kb, in m3 kg-1. dtKd_kb, & ! The diapycnal diffusivity in layer kb times the time step, - ! in units of H2. + ! in H2 ~> m2 or kg2 m-4. maxF_correct, & ! An amount by which to correct maxF due to excessive - ! surface heat loss, in H. + ! surface heat loss, in H ~> m or kg m-2. zeros, & ! An array of all zeros. (Usually used with units of H.) - max_eakb, & ! The maximum value of eakb that might be realized, in H. - min_eakb, & ! The minimum value of eakb that might be realized, in H. + max_eakb, & ! The maximum value of eakb that might be realized, in H ~> m or kg m-2. + min_eakb, & ! The minimum value of eakb that might be realized, in H ~> m or kg m-2. err_max_eakb0, & ! The value of error returned by determine_Ea_kb err_min_eakb0, & ! when eakb = min_eakb and max_eakb and ea_kbp1 = 0. err_eakb0, & ! A value of error returned by determine_Ea_kb. F_kb, & ! The value of F in layer kb, or equivalently the entrainment - ! from below by layer kb, in H. + ! from below by layer kb, in H ~> m or kg m-2. dFdfm_kb, & ! The partial derivative of F with fm, nondim. See dFdfm. - maxF_kb, & ! The maximum value of F_kb that might be realized, in H. - eakb_maxF, & ! The value of eakb that gives F_kb=maxF_kb, in H. - F_kb_maxEnt ! The value of F_kb when eakb = max_eakb, in H. + maxF_kb, & ! The maximum value of F_kb that might be realized, in H ~> m or kg m-2. + eakb_maxF, & ! The value of eakb that gives F_kb=maxF_kb, in H ~> m or kg m-2. + F_kb_maxEnt ! The value of F_kb when eakb = max_eakb, in H ~> m or kg m-2. real, dimension(SZI_(G),SZK_(G)) :: & Sref, & ! The reference potential density of the mixed and buffer layers, ! and of the two lightest interior layers (kb and kb+1) copied ! into layers kmb+1 and kmb+2, in kg m-3. h_bl ! The thicknesses of the mixed and buffer layers, and of the two ! lightest interior layers (kb and kb+1) copied into layers kmb+1 - ! and kmb+2, in H. + ! and kmb+2, in H ~> m or kg m-2. real, dimension(SZI_(G),SZK_(G)) :: & ds_dsp1, & ! The coordinate variable (sigma-2) difference across an @@ -185,20 +185,20 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, dRho_dT, dRho_dS ! The partial derivatives of potential density with ! temperature and salinity, in kg m-3 K-1 and kg m-3 psu-1. - real :: tolerance ! The tolerance within which E must be converged, in H. - real :: Angstrom ! The minimum layer thickness, in H. + real :: tolerance ! The tolerance within which E must be converged, in H ~> m or kg m-2. + real :: Angstrom ! The minimum layer thickness, in H ~> m or kg m-2. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. + ! in roundoff and can be neglected, in H ~> m or kg m-2. real :: F_cor ! A correction to the amount of F that is used to - ! entrain from the layer above, in H. + ! entrain from the layer above, in H ~> m or kg m-2. real :: Kd_here ! The effective diapycnal diffusivity, in H2 s-1. - real :: h_avail ! The thickness that is available for entrainment, in H. + real :: h_avail ! The thickness that is available for entrainment, in H ~> m or kg m-2. real :: dS_kb_eff ! The value of dS_kb after limiting is taken into account. real :: Rho_cor ! The depth-integrated potential density anomaly that ! needs to be corrected for, in kg m-2. - real :: ea_cor ! The corrective adjustment to eakb, in H. + real :: ea_cor ! The corrective adjustment to eakb, in H ~> m or kg m-2. real :: h1 ! The layer thickness after entrainment through the - ! interface below is taken into account, in H. + ! interface below is taken into account, in H ~> m or kg m-2. real :: Idt ! The inverse of the time step, in s-1. logical :: do_any @@ -897,9 +897,9 @@ subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb, real, dimension(SZI_(G),SZK_(G)), intent(in) :: F !< The density flux through a layer within !! a time step divided by the density !! difference across the interface below - !! the layer, in H. + !! the layer, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 integer, dimension(SZI_(G)), intent(in) :: kb !< The index of the lightest layer denser than !! the deepest buffer layer. integer, intent(in) :: kmb !< The number of mixed and buffer layers. @@ -910,16 +910,16 @@ subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb, !! a layer over the difference across the !! interface above the layer. real, dimension(SZI_(G)), intent(in) :: eakb !< The entrainment from above by the layer - !! below the buffer layer, in H. + !! below the buffer layer, in H ~> m or kg m-2. real, dimension(SZI_(G),SZK_(G)), intent(in) :: Ent_bl !< The average entrainment upward and !! downward across each interface around - !! the buffer layers, in H. + !! the buffer layers, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: ea !< The amount of fluid entrained from the layer - !! above within this time step, in H. + !! above within this time step, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: eb !< The amount of fluid entrained from the layer - !! below within this time step, in H. + !! below within this time step, in H ~> m or kg m-2. logical, dimension(SZI_(G)), & optional, intent(in) :: do_i_in !< Indicates which i-points to work on. ! This subroutine calculates the actual entrainments (ea and eb) and the @@ -1025,12 +1025,12 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 !! (usually m or kg m-2). real, dimension(SZI_(G),SZK_(G)+1), & intent(in) :: dtKd_int !< The diapycnal diffusivity across !! each interface times the time step, - !! in H2. + !! in H2 ~> m2 or kg2 m-4. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent !! fields have NULL ptrs. @@ -1045,14 +1045,14 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref real, dimension(SZI_(G),SZK_(G)+1), & intent(out) :: Ent_bl !< The average entrainment upward and !! downward across each interface around - !! the buffer layers, in H. + !! the buffer layers, in H ~> m or kg m-2. real, dimension(SZI_(G),SZK_(G)), intent(out) :: Sref !< The coordinate potential density - !! 1000 for each layer, in kg m-3. - real, dimension(SZI_(G),SZK_(G)), intent(out) :: h_bl !< The thickness of each layer, in H. + real, dimension(SZI_(G),SZK_(G)), intent(out) :: h_bl !< The thickness of each layer, in H ~> m or kg m-2. ! Arguments: h - Layer thickness, in m or kg m-2 (abbreviated as H below). ! (in) dtKd_int - The diapycnal diffusivity across each interface times -! the time step, in H2. +! the time step, in H2 ~> m2 or kg2 m-4. ! (in) tv - A structure containing pointers to any available ! thermodynamic fields. Absent fields have NULL ptrs. ! (in) kb - The index of the lightest layer denser than the @@ -1063,10 +1063,10 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref ! (in) CS - This module's control structure. ! (in) j - The meridional index upon which to work. ! (out) Ent_bl - The average entrainment upward and downward across -! each interface around the buffer layers, in H. +! each interface around the buffer layers, in H ~> m or kg m-2. ! (out) Sref - The coordinate potential density - 1000 for each layer, ! in kg m-3. -! (out) h_bl - The thickness of each layer, in H. +! (out) h_bl - The thickness of each layer, in H ~> m or kg m-2. ! This subroutine sets the average entrainment across each of the interfaces ! between buffer layers within a timestep. It also causes thin and relatively @@ -1080,16 +1080,16 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref ! based on the simulated T and S and P_Ref, kg m-3. pres, & ! Reference pressure (P_Ref) in Pa. frac_rem, & ! The fraction of the diffusion remaining, ND. - h_interior ! The interior thickness available for entrainment, in H. + h_interior ! The interior thickness available for entrainment, in H ~> m or kg m-2. real, dimension(SZI_(G), SZK_(G)) :: & S_est ! An estimate of the coordinate potential density - 1000 after ! entrainment for each layer, in kg m-3. - real :: max_ent ! The maximum possible entrainment, in H. - real :: dh ! An available thickness, in H. + real :: max_ent ! The maximum possible entrainment, in H ~> m or kg m-2. + real :: dh ! An available thickness, in H ~> m or kg m-2. real :: Kd_x_dt ! The diffusion that remains after thin layers are - ! entrained, in H2. + ! entrained, in H2 ~> m2 or kg2 m-4. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. + ! in roundoff and can be neglected, in H ~> m or kg m-2. integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke @@ -1223,9 +1223,9 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & !! (in kg m-3?). real, dimension(SZI_(G),SZK_(G)), intent(in) :: Ent_bl !< The average entrainment upward and !! downward across each interface - !! around the buffer layers, in H. + !! around the buffer layers, in H ~> m or kg m-2. real, dimension(SZI_(G)), intent(in) :: E_kb !< The entrainment by the top interior - !! layer, in H. + !! layer, in H ~> m or kg m-2. integer, intent(in) :: is !< The start of the i-index range to work on. integer, intent(in) :: ie !< The end of the i-index range to work on. integer, intent(in) :: kmb !< The number of mixed and buffer layers. @@ -1251,8 +1251,8 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & ! Arguments: h_bl - Layer thickness, in m or kg m-2 (abbreviated as H below). ! (in) Sref - Reference potential vorticity (in kg m-3?) ! (in) Ent_bl - The average entrainment upward and downward across -! each interface around the buffer layers, in H. -! (in) E_kb - The entrainment by the top interior layer, in H. +! each interface around the buffer layers, in H ~> m or kg m-2. +! (in) E_kb - The entrainment by the top interior layer, in H ~> m or kg m-2. ! (in) is, ie - The range of i-indices to work on. ! (in) kmb - The number of mixed and buffer layers. ! (in) G - The ocean's grid structure. @@ -1293,7 +1293,7 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & ! after exchange with the layer below, in m or kg m-2. logical, dimension(SZI_(G)) :: do_i real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. + ! in roundoff and can be neglected, in H ~> m or kg m-2. real :: h_tr ! h_tr is h at tracer points with a tiny thickness ! added to ensure positive definiteness, in m or kg m-2. real :: b_denom_1 ! The first term in the denominator of b1 in m or kg m-2. @@ -1483,19 +1483,20 @@ subroutine F_kb_to_ea_kb(h_bl, Sref, Ent_bl, I_dSkbp1, F_kb, kmb, i, & !! at index kmb+1, in units of kg m-3. real, dimension(SZI_(G),SZK_(G)), & intent(in) :: Ent_bl !< The average entrainment upward and downward - !! across each interface around the buffer layers, in H. + !! across each interface around the buffer layers, + !! in H ~> m or kg m-2. real, dimension(SZI_(G)), intent(in) :: I_dSkbp1 !< The inverse of the difference in reference !! potential density across the base of the !! uppermost interior layer, in units of m3 kg-1. real, dimension(SZI_(G)), intent(in) :: F_kb !< The entrainment from below by the - !! uppermost interior layer, in H + !! uppermost interior layer, in H ~> m or kg m-2 integer, intent(in) :: kmb !< The number of mixed and buffer layers. integer, intent(in) :: i !< The i-index to work on type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. real, dimension(SZI_(G)), intent(inout) :: ea_kb !< The entrainment from above by the layer below - !! the buffer layer (i.e. layer kb), in H. + !! the buffer layer (i.e. layer kb), in H ~> m or kg m-2. real, optional, intent(in) :: tol_in !< A tolerance for the iterative determination - !! of the entrainment, in H. + !! of the entrainment, in H ~> m or kg m-2. real :: max_ea, min_ea real :: err, err_min, err_max @@ -1615,20 +1616,20 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & !! kmb+1, in units of kg m-3. real, dimension(SZI_(G),SZK_(G)), intent(in) :: Ent_bl !< The average entrainment upward and !! downward across each interface around - !! the buffer layers, in H. + !! the buffer layers, in H ~> m or kg m-2. real, dimension(SZI_(G)), intent(in) :: I_dSkbp1 !< The inverse of the difference in !! reference potential density across !! the base of the uppermost interior !! layer, in units of m3 kg-1. real, dimension(SZI_(G)), intent(in) :: dtKd_kb !< The diapycnal diffusivity in the top !! interior layer times the time step, - !! in H2. + !! in H2 ~> m2 or kg2 m-4. real, dimension(SZI_(G)), intent(in) :: ea_kbp1 !< The entrainment from above by layer - !! kb+1, in H. + !! kb+1, in H ~> m or kg m-2. real, dimension(SZI_(G)), intent(in) :: min_eakb !< The minimum permissible rate of - !! entrainment, in H. + !! entrainment, in H ~> m or kg m-2. real, dimension(SZI_(G)), intent(in) :: max_eakb !< The maximum permissible rate of - !! entrainment, in H. + !! entrainment, in H ~> m or kg m-2. integer, intent(in) :: kmb !< The number of mixed and buffer layers. integer, intent(in) :: is !< The start of the i-index range to work on. integer, intent(in) :: ie !< The end of the i-index range to work on. @@ -1636,8 +1637,8 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & !! i-points to work on. type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. real, dimension(SZI_(G)), intent(inout) :: Ent !< The entrainment rate of the uppermost - !! interior layer, in H. The input value - !! is the first guess. + !! interior layer, in H ~> m or kg m-2. + !! The input value is the first guess. real, dimension(SZI_(G)), optional, intent(out) :: error !< The error (locally defined in this !! routine) associated with the returned !! solution. @@ -1650,14 +1651,14 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & real, dimension(SZI_(G)), optional, intent(out) :: F_kb !< The entrainment from below by the !! uppermost interior layer !! corresponding to the returned - !! value of Ent, in H. + !! value of Ent, in H ~> m or kg m-2. real, dimension(SZI_(G)), optional, intent(out) :: dFdfm_kb !< The partial derivative of F_kb with !! ea_kbp1, nondim. ! Arguments: h_bl - Layer thickness, with the top interior layer at k-index ! kmb+1, in units of m or kg m-2 (abbreviated as H below). ! (in) dtKd_kb - The diapycnal diffusivity in the top interior layer times -! the time step, in H2. +! the time step, in H2 ~> m2 or kg2 m-4. ! (in) Sref - The coordinate reference potential density, with the ! value of the topmost interior layer at layer kmb+1, ! in units of kg m-3. @@ -1665,16 +1666,16 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & ! density across the base of the uppermost interior layer, ! in units of m3 kg-1. ! (in) Ent_bl - The average entrainment upward and downward across -! each interface around the buffer layers, in H. -! (in) ea_kbp1 - The entrainment from above by layer kb+1, in H. -! (in) min_eakb - The minimum permissible rate of entrainment, in H. -! (in) max_eakb - The maximum permissible rate of entrainment, in H. +! each interface around the buffer layers, in H ~> m or kg m-2. +! (in) ea_kbp1 - The entrainment from above by layer kb+1, in H ~> m or kg m-2. +! (in) min_eakb - The minimum permissible rate of entrainment, in H ~> m or kg m-2. +! (in) max_eakb - The maximum permissible rate of entrainment, in H ~> m or kg m-2. ! (in) is, ie - The range of i-indices to work on. ! (in) do_i - A logical variable indicating which i-points to work on. ! (in) G - The ocean's grid structure. ! (in) GV - The ocean's vertical grid structure. ! (in) CS - This module's control structure. -! (in/out) Ent - The entrainment rate of the uppermost interior layer, in H. +! (in/out) Ent - The entrainment rate of the uppermost interior layer, in H ~> m or kg m-2. ! The input value is the first guess. ! (out,opt) error - The error (locally defined in this routine) associated with ! the returned solution. @@ -1682,7 +1683,7 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & ! associated with min_eakb and max_eakb when ea_kbp1 = 0, ! returned from a previous call to this routine. ! (out,opt) F_kb - The entrainment from below by the uppermost interior layer -! corresponding to the returned value of Ent, in H. +! corresponding to the returned value of Ent, in H ~> m or kg m-2. ! (out,out) dFdfm_kb - The partial derivative of F_kb with ea_kbp1, nondim. ! This subroutine determines the entrainment from above by the top interior @@ -1697,22 +1698,22 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & ! too much bigger than dS_kb or dS_kbp1, in kg m-3. ddSkb_dE, ddSlay_dE, & ! The derivatives of dS_kb and dS_Lay with E, ! in units of kg m-3 H-1. - derror_dE, & ! The derivative of err with E, in H. - err, & ! The "error" whose zero is being sought, in H2. - E_min, E_max, & ! The minimum and maximum values of E, in H. - error_minE, error_maxE ! err when E = E_min or E = E_max, in H2. - real :: err_est ! An estimate of what err will be, in H2. + derror_dE, & ! The derivative of err with E, in H ~> m or kg m-2. + err, & ! The "error" whose zero is being sought, in H2 ~> m2 or kg2 m-4. + E_min, E_max, & ! The minimum and maximum values of E, in H ~> m or kg m-2. + error_minE, error_maxE ! err when E = E_min or E = E_max, in H2 ~> m2 or kg2 m-4. + real :: err_est ! An estimate of what err will be, in H2 ~> m2 or kg2 m-4. real :: eL ! 1 or 0, depending on whether increases in E lead ! to decreases in the entrainment from below by the ! deepest buffer layer. real :: fa, fk, fm, fr ! Temporary variables used to calculate err, in ND, H2, H, H. - real :: tolerance ! The tolerance within which E must be converged, in H. - real :: E_prev ! The previous value of E, in H. + real :: tolerance ! The tolerance within which E must be converged, in H ~> m or kg m-2. + real :: E_prev ! The previous value of E, in H ~> m or kg m-2. logical, dimension(SZI_(G)) :: false_position ! If true, the false position ! method might be used for the next iteration. logical, dimension(SZI_(G)) :: redo_i ! If true, more work is needed on this column. logical :: do_any - real :: large_err ! A large error measure, in H2. + real :: large_err ! A large error measure, in H2 ~> m2 or kg2 m-4. integer :: i, it integer, parameter :: MAXIT = 30 @@ -1854,24 +1855,24 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & real, dimension(SZI_(G),SZK_(G)), & intent(in) :: Ent_bl !< The average entrainment upward and !! downward across each interface around - !! the buffer layers, in H. + !! the buffer layers, in H ~> m or kg m-2. real, dimension(SZI_(G)), intent(in) :: I_dSkbp1 !< The inverse of the difference in !! reference potential density across the !! base of the uppermost interior layer, !! in units of m3 kg-1. real, dimension(SZI_(G)), intent(in) :: min_ent_in !< The minimum value of ent to search, - !! in H. + !! in H ~> m or kg m-2. real, dimension(SZI_(G)), intent(in) :: max_ent_in !< The maximum value of ent to search, - !! in H. + !! in H ~> m or kg m-2. integer, intent(in) :: kmb !< The number of mixed and buffer layers. integer, intent(in) :: is !< The start of the i-index range to work on. integer, intent(in) :: ie !< The end of the i-index range to work on. type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. real, dimension(SZI_(G)), intent(out) :: maxF !< The maximum value of F !! = ent*ds_kb*I_dSkbp1 found in the range - !! min_ent < ent < max_ent, in H. + !! min_ent < ent < max_ent, in H ~> m or kg m-2. real, dimension(SZI_(G)), & - optional, intent(out) :: ent_maxF !< The value of ent at that maximum, in H. + optional, intent(out) :: ent_maxF !< The value of ent at that maximum, in H ~> m or kg m-2. logical, dimension(SZI_(G)), & optional, intent(in) :: do_i_in !< A logical array indicating which columns !! to work on. @@ -1879,7 +1880,7 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & optional, intent(out) :: F_lim_maxent !< If present, do not apply the limit in !! finding the maximum value, but return the !! limited value at ent=max_ent_in in this - !! array, in H. + !! array, in H ~> m or kg m-2. real, dimension(SZI_(G)), & optional, intent(in) :: F_thresh !< If F_thresh is present, return the first !! value found that has F > F_thresh, or diff --git a/src/parameterizations/vertical/MOM_full_convection.F90 b/src/parameterizations/vertical/MOM_full_convection.F90 index 299c230e0b..e32c536ec7 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -22,7 +22,7 @@ subroutine full_convection(G, GV, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, & type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -31,9 +31,9 @@ subroutine full_convection(G, GV, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, & intent(out) :: S_adj !< Adjusted salinity in ppt. real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface in Pa (or NULL). real, intent(in) :: Kddt_smooth !< A smoothing vertical - !! diffusivity times a timestep, in H2. + !! diffusivity times a timestep, in H2 ~> m2 or kg2 m-4. real, optional, intent(in) :: Kddt_convect !< A large convecting vertical - !! diffusivity times a timestep, in H2. + !! diffusivity times a timestep, in H2 ~> m2 or kg2 m-4. integer, optional, intent(in) :: halo !< Halo width over which to compute ! Local variables @@ -41,7 +41,7 @@ subroutine full_convection(G, GV, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, & drho_dT, & ! The derivatives of density with temperature and drho_dS ! salinity, in kg m-3 K-1 and kg m-3 psu-1. real :: h_neglect, h0 ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. + ! in roundoff and can be neglected, in H ~> m or kg m-2. ! logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. real, dimension(SZI_(G),SZK0_(G)) :: & Te_a, & ! A partially updated temperature estimate including the influnce from @@ -73,12 +73,12 @@ subroutine full_convection(G, GV, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, & ! and layers below in the final properies with a upward-first solver, nondim. ! d_b = 1.0 - c_b real, dimension(SZI_(G),SZK_(G)+1) :: & - mix !< The amount of mixing across the interface between layers, in H. - real :: mix_len ! The length-scale of mixing, when it is active, in H - real :: h_b, h_a ! The thicknessses of the layers above and below in interface, in H - real :: b_b, b_a ! Inverse pivots used by the tridiagonal solver, in H-1. + mix !< The amount of mixing across the interface between layers, in H ~> m or kg m-2. + real :: mix_len ! The length-scale of mixing, when it is active, in H ~> m or kg m-2 + real :: h_b, h_a ! The thicknessses of the layers above and below an interface, in H ~> m or kg m-2 + real :: b_b, b_a ! Inverse pivots used by the tridiagonal solver, in H-1 ~> m-1 or m2 kg-1. - real :: kap_dt_x2 ! The product of 2*kappa*dt in H2 (often m2 or kg2 m-4). + real :: kap_dt_x2 ! The product of 2*kappa*dt in H2 ~> m2 or kg2 m-4. logical, dimension(SZI_(G)) :: do_i ! Do more work on this column. logical, dimension(SZI_(G)) :: last_down ! The last setup pass was downward. @@ -283,10 +283,10 @@ function is_unstable(dRho_dT, dRho_dS, h_a, h_b, mix_A, mix_B, T_a, T_b, S_a, S_ Te_aa, Te_bb, Se_aa, Se_bb, d_A, d_B) real, intent(in) :: dRho_dT !< The derivative of in situ density with temperature in kg m-3 degC-1 real, intent(in) :: dRho_dS !< The derivative of in situ density with salinity in kg m-3 ppt-1 - real, intent(in) :: h_a !< The thickness of the layer above, in H - real, intent(in) :: h_b !< The thickness of the layer below, in H - real, intent(in) :: mix_A !< The time integrated mixing rate of the interface above, in H - real, intent(in) :: mix_B !< The time integrated mixing rate of the interface below, in H + real, intent(in) :: h_a !< The thickness of the layer above, in H ~> m or kg m-2 + real, intent(in) :: h_b !< The thickness of the layer below, in H ~> m or kg m-2 + real, intent(in) :: mix_A !< The time integrated mixing rate of the interface above, in H ~> m or kg m-2 + real, intent(in) :: mix_B !< The time integrated mixing rate of the interface below, in H ~> m or kg m-2 real, intent(in) :: T_a !< The initial temperature of the layer above, in degC real, intent(in) :: T_b !< The initial temperature of the layer below, in degC real, intent(in) :: S_a !< The initial salinity of the layer below, in ppt @@ -321,10 +321,10 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, j, p_surf, halo) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables - real, intent(in) :: Kddt !< A diffusivity times a time increment, in H2. + real, intent(in) :: Kddt !< A diffusivity times a time increment, in H2 ~> m2 or kg2 m-4. real, dimension(SZI_(G),SZK_(G)+1), & intent(out) :: dR_dT !< Derivative of locally referenced !! potential density with temperature, kg m-3 K-1 @@ -334,9 +334,10 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, j, p_surf, halo) integer, intent(in) :: j !< The j-point to work on. real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface in Pa (or NULL). integer, optional, intent(in) :: halo !< Halo width over which to compute + ! Local variables real :: mix(SZI_(G),SZK_(G)+1) ! The diffusive mixing length (kappa*dt)/dz - ! between layers within in a timestep in H. + ! between layers within in a timestep in H ~> m or kg m-2. real :: b1(SZI_(G)), d1(SZI_(G)) ! b1, c1, and d1 are variables used by the real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. real :: T_f(SZI_(G),SZK_(G)) ! Filtered temperatures in degC @@ -344,10 +345,10 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, j, p_surf, halo) real :: pres(SZI_(G)) ! Interface pressures, in Pa. real :: T_EOS(SZI_(G)) ! Filtered and vertically averaged temperatures in degC real :: S_EOS(SZI_(G)) ! Filtered and vertically averaged salinities in ppt - real :: kap_dt_x2 ! The product of 2*kappa*dt in H2 (often m2 or kg2 m-4). - real :: h_neglect, h0 ! Negligible thicknesses, in H (m or kg m-2), to - ! allow for zero thicknesses. - real :: h_tr ! The thickness at tracer points, plus h_neglect, in H. + real :: kap_dt_x2 ! The product of 2*kappa*dt in H2 ~> m2 or kg2 m-4. + real :: h_neglect, h0 ! Negligible thicknesses to allow for zero thicknesses, + ! in H ~> m or kg m-2. + real :: h_tr ! The thickness at tracer points, plus h_neglect, in H ~> m or kg m-2. integer :: i, k, is, ie, nz if (present(halo)) then diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index c09d85f5b5..df96b6492b 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -49,8 +49,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid !! structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H - !! (usually m or kg m-2). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers !! to any available thermodynamic !! fields. Absent fields have NULL @@ -59,14 +58,11 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: ea !< The amount of fluid moved !! downward into a layer; this !! should be increased due to mixed - !! layer detrainment, in the same - !! units as h - usually m or kg m-2 - !! (i.e., H). + !! layer detrainment, in H ~> m or kg m-2 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: eb !< The amount of fluid moved upward !! into a layer; this should be !! increased due to mixed layer - !! entrainment, in the same units as - !! h - usually m or kg m-2 (i.e., H) + !! entrainment, in H ~> m or kg m-2. type(geothermal_CS), pointer :: CS !< The control structure returned by !! a previous call to !! geothermal_init. @@ -74,7 +70,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) ! Local variables real, dimension(SZI_(G)) :: & heat_rem, & ! remaining heat (H * degC) - h_geo_rem, & ! remaining thickness to apply geothermal heating (units of H) + h_geo_rem, & ! remaining thickness to apply geothermal heating (H ~> m or kg m-2) Rcv_BL, & ! coordinate density in the deepest variable density layer (kg/m3) p_ref ! coordiante densities reference pressure (Pa) @@ -83,19 +79,19 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) dRcv_dT_, & ! partial derivative of coordinate density wrt temp (kg m-3 K-1) dRcv_dS_ ! partial derivative of coordinate density wrt saln (kg m-3 ppt-1) - real :: Angstrom, H_neglect ! small thicknesses in H + real :: Angstrom, H_neglect ! small thicknesses in H ~> m or kg m-2 real :: Rcv ! coordinate density of present layer (kg m-3) real :: Rcv_tgt ! coordinate density of target layer (kg m-3) real :: dRcv ! difference between Rcv and Rcv_tgt (kg m-3) real :: dRcv_dT ! partial derivative of coordinate density wrt temp ! in the present layer (kg m-3 K-1); usually negative - real :: h_heated ! thickness that is being heated (units of H) + real :: h_heated ! thickness that is being heated (H ~> m or kg m-2) real :: heat_avail ! heating available for the present layer (units of Kelvin * H) real :: heat_in_place ! heating to warm present layer w/o movement between layers (K * H) real :: heat_trans ! heating available to move water from present layer to target layer (K * H) real :: heating ! heating used to move water from present layer to target layer (K * H) ! 0 <= heating <= heat_trans - real :: h_transfer ! thickness moved between layers (units of H) + real :: h_transfer ! thickness moved between layers (H ~> m or kg m-2) real :: wt_in_place ! relative weighting that goes from 0 to 1 (non-dim) real :: I_h ! inverse thickness (units of 1/H) real :: dTemp ! temperature increase in a layer (Kelvin) diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index cf81c65fea..e5faa2e7ee 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -65,7 +65,7 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1 real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, in m s-1 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to the !! thermodynamic fields type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes @@ -128,7 +128,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to the !! thermodynamic fields real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_f !< Temperature after vertical filtering to diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index fea80e97ee..32b4571155 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -101,7 +101,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: v_in !< Initial meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. @@ -390,7 +390,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: v_in !< Initial meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: T_in !< Layer potential temperatures in degC real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -452,7 +452,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ real :: dz_in_lay ! The running sum of the thickness in a layer, in Z ~> m. real :: k0dt ! The background diffusivity times the timestep, in Z2 ~> m2. real :: dz_massless ! A layer thickness that is considered massless, in Z ~> m. - real :: I_hwt ! The inverse of the masked thickness weights, in H-1. + real :: I_hwt ! The inverse of the masked thickness weights, in H-1 ~> m-1 or m2 kg-1. real :: I_Prandtl logical :: use_temperature ! If true, temperature and salinity have been ! allocated and are being used as state variables. diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 5bf74bf66c..87e5408256 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -42,7 +42,7 @@ module MOM_regularize_layers real :: h_def_tol4 !< The value of the relative thickness deficit at which to do !! detrainment from the buffer layers to the interior at full !! force, now 50% of the way from h_def_tol1 to 1. - real :: Hmix_min !< The minimum mixed layer thickness in H. + real :: Hmix_min !< The minimum mixed layer thickness in H ~> m or kg m-2. type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. @@ -78,7 +78,7 @@ subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. @@ -86,13 +86,11 @@ subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: ea !< The amount of fluid moved downward into a !! layer; this should be increased due to mixed - !! layer detrainment, in the same units as - !! h - usually m or kg m-2 (i.e., H). + !! layer detrainment, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: eb !< The amount of fluid moved upward into a layer !! this should be increased due to mixed layer - !! entrainment, in the same units as h - usually - !! m or kg m-2 (i.e., H). + !! entrainment, in H ~> m or kg m-2. type(regularize_layers_CS), pointer :: CS !< The control structure returned by a previous !! call to regularize_layers_init. ! Local variables @@ -118,7 +116,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. @@ -126,13 +124,11 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: ea !< The amount of fluid moved downward into a !! layer; this should be increased due to mixed - !! layer detrainment, in the same units as h - - !! usually m or kg m-2 (i.e., H). + !! layer detrainment, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: eb !< The amount of fluid moved upward into a layer !! this should be increased due to mixed layer - !! entrainment, in the same units as h - usually - !! m or kg m-2 (i.e., H). + !! entrainment, in H ~> m or kg m-2. type(regularize_layers_CS), pointer :: CS !< The control structure returned by a previous !! call to regularize_layers_init. ! Local variables @@ -143,7 +139,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) real, dimension(SZI_(G),SZJ_(G)) :: & def_rat_h ! The ratio of the thickness deficit to the minimum depth, ND. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & - e ! The interface depths, in H, positive upward. + e ! The interface depths, in H ~> m or kg m-2, positive upward. #ifdef DEBUG_CODE real, dimension(SZIB_(G),SZJ_(G)) :: & @@ -153,24 +149,24 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) real, dimension(SZI_(G),SZJB_(G)) :: & def_rat_h2, def_rat_h3 real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & - ef ! The filtered interface depths, in H, positive upward. + ef ! The filtered interface depths, in H ~> m or kg m-2, positive upward. #endif real, dimension(SZI_(G),SZK_(G)+1) :: & - e_filt, e_2d ! The interface depths, in H, positive upward. + e_filt, e_2d ! The interface depths, in H ~> m or kg m-2, positive upward. real, dimension(SZI_(G),SZK_(G)) :: & - h_2d, & ! A 2-d version of h, in H. + h_2d, & ! A 2-d version of h, in H ~> m or kg m-2. T_2d, & ! A 2-d version of tv%T, in deg C. S_2d, & ! A 2-d version of tv%S, in PSU. Rcv, & ! A 2-d version of the coordinate density, in kg m-3. - h_2d_init, & ! The initial value of h_2d, in H. + h_2d_init, & ! The initial value of h_2d, in H ~> m or kg m-2. T_2d_init, & ! THe initial value of T_2d, in deg C. S_2d_init, & ! The initial value of S_2d, in PSU. d_eb, & ! The downward increase across a layer in the entrainment from - ! below, in H. The sign convention is that positive values of + ! below, in H ~> m or kg m-2. The sign convention is that positive values of ! d_eb correspond to a gain in mass by a layer by upward motion. d_ea ! The upward increase across a layer in the entrainment from - ! above, in H. The sign convention is that positive values of + ! above, in H ~> m or kg m-2. The sign convention is that positive values of ! d_ea mean a net gain in mass by a layer from downward motion. real, dimension(SZI_(G)) :: & p_ref_cv, & ! Reference pressure for the potential density which defines @@ -182,15 +178,15 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) h_tot3, Th_tot3, Sh_tot3, & h_tot2, Th_tot2, Sh_tot2 real, dimension(SZK_(G)) :: & - h_prev_1d ! The previous thicknesses, in H. + h_prev_1d ! The previous thicknesses, in H ~> m or kg m-2. real :: I_dtol ! The inverse of the tolerance changes, nondim. real :: I_dtol34 ! The inverse of the tolerance changes, nondim. - real :: h1, h2 ! Temporary thicknesses, in H. - real :: e_e, e_w, e_n, e_s ! Temporary interface heights, in H. + real :: h1, h2 ! Temporary thicknesses, in H ~> m or kg m-2. + real :: e_e, e_w, e_n, e_s ! Temporary interface heights, in H ~> m or kg m-2. real :: wt ! The weight of the filted interfaces in setting the targets, ND. real :: scale ! A scaling factor, ND. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. + ! in roundoff and can be neglected, in H ~> m or kg m-2. real, dimension(SZK_(G)+1) :: & int_flux, int_Tflux, int_Sflux, int_Rflux real :: h_add @@ -727,7 +723,7 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - intent(in) :: e !< Interface depths, in m or kg m-2. + intent(in) :: e !< Interface depths, in H ~> m or kg m-2 real, dimension(SZIB_(G),SZJ_(G)), & intent(out) :: def_rat_u !< The thickness deficit ratio at u points, !! nondim. @@ -746,25 +742,24 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & !! are aggregated into 1 layer, nondim. integer, optional, intent(in) :: halo !< An extra-wide halo size, 0 by default. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - optional, intent(in) :: h !< Layer thicknesses, in H (usually m or kg - !! m-2); if h is not present, vertical - !! differences in interface heights are used - !! instead. + optional, intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + !! If h is not present, vertical differences + !! in interface heights are used instead. ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & - h_def_u, & ! The vertically summed thickness deficits at u-points, in H. + h_def_u, & ! The vertically summed thickness deficits at u-points, in H ~> m or kg m-2. h_norm_u, & ! The vertically summed arithmetic mean thickness by which - ! h_def_u is normalized, in H. + ! h_def_u is normalized, in H ~> m or kg m-2. h_def2_u real, dimension(SZI_(G),SZJB_(G)) :: & - h_def_v, & ! The vertically summed thickness deficits at v-points, in H. + h_def_v, & ! The vertically summed thickness deficits at v-points, in H ~> m or kg m-2. h_norm_v, & ! The vertically summed arithmetic mean thickness by which - ! h_def_v is normalized, in H. + ! h_def_v is normalized, in H ~> m or kg m-2. h_def2_v real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. + ! in roundoff and can be neglected, in H ~> m or kg m-2. real :: Hmix_min ! CS%Hmix_min converted to units of H. - real :: h1, h2 ! Temporary thicknesses, in H. + real :: h1, h2 ! Temporary thicknesses, in H ~> m or kg m-2. integer :: i, j, k, is, ie, js, je, nz, nkmb is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 208779055c..f96d5c0fc8 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -210,7 +210,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: u_h !< Zonal velocity interpolated to h points, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -669,7 +669,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available !! thermodynamic fields. real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: dRho_int !< Change in locally referenced potential density @@ -873,7 +873,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available !! thermodynamic fields. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -1050,7 +1050,7 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available !! thermodynamic fields; absent fields have NULL ptrs. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: T_f !< layer temp in C with the values in massless layers !! filled vertically by diffusion. @@ -1142,7 +1142,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available !! thermodynamic fields. type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes @@ -1536,7 +1536,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(forcing), intent(in) :: fluxes !< Surface fluxes structure type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -1671,7 +1671,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom !! boundary layer properies, and related fields. @@ -1803,8 +1803,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m - !! or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any !! available thermodynamic fields; absent !! fields have NULL ptrs. diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 56a356180f..ff3055e7e7 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -52,8 +52,8 @@ module MOM_set_visc !! This might be Kv / (cdrag * drag_bg_vel) to give !! Kv as the minimum near-bottom viscosity. real :: Htbl_shelf !< A nominal thickness of the surface boundary layer for use - !! in calculating the near-surface velocity, in units of H. - real :: Htbl_shelf_min !< The minimum surface boundary layer thickness in H. + !! in calculating the near-surface velocity, in H ~> m or kg m-2. + real :: Htbl_shelf_min !< The minimum surface boundary layer thickness in H ~> m or kg m-2. real :: KV_BBL_min !< The minimum viscosity in the bottom boundary layer, in Z2 s-1 ~> m2 s-1. real :: KV_TBL_min !< The minimum viscosity in the top boundary layer, in Z2 s-1 ~> m2 s-1. logical :: bottomdraglaw !< If true, the bottom stress is calculated with a @@ -112,7 +112,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs.. @@ -137,9 +137,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! layer with salinity, in units of kg m-3 psu-1. press ! The pressure at which dR_dT and dR_dS are evaluated, in Pa. real :: htot ! Sum of the layer thicknesses up to some - ! point, in H (i.e., m or kg m-2). + ! point, in H ~> m or kg m-2. real :: htot_vel ! Sum of the layer thicknesses up to some - ! point, in H (i.e., m or kg m-2). + ! point, in H ~> m or kg m-2. real :: Rhtot ! Running sum of thicknesses times the ! layer potential densities in H kg m-3. @@ -154,9 +154,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real, dimension(SZIB_(G),SZK_(G)) :: & h_at_vel, & ! Layer thickness at a velocity point, using an upwind-biased ! second order accurate estimate based on the previous velocity - ! direction, in H. + ! direction, in H ~> m or kg m-2. h_vel, & ! Arithmetic mean of the layer thicknesses adjacent to a - ! velocity point, in H. + ! velocity point, in H ~> m or kg m-2. T_vel, & ! Arithmetic mean of the layer temperatures adjacent to a ! velocity point, in deg C. S_vel, & ! Arithmetic mean of the layer salinities adjacent to a @@ -165,7 +165,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! to a velocity point, in kg m-3. real :: h_vel_pos ! The arithmetic mean thickness at a velocity point - ! plus H_neglect to avoid 0 values, in H. + ! plus H_neglect to avoid 0 values, in H ~> m or kg m-2. real :: ustarsq ! 400 times the square of ustar, times ! Rho0 divided by G_Earth and the conversion ! from m to thickness units, in kg m-2 or kg2 m-5. @@ -178,8 +178,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: Dfn ! The increment in oldfn for entraining ! the layer, in H kg m-3. real :: Dh ! The increment in layer thickness from - ! the present layer, in H. - real :: bbl_thick ! The thickness of the bottom boundary layer in H. + ! the present layer, in H ~> m or kg m-2. + real :: bbl_thick ! The thickness of the bottom boundary layer in H ~> m or kg m-2. real :: bbl_thick_Z ! The thickness of the bottom boundary layer in Z ~> m. real :: C2f ! C2f = 2*f at velocity points. @@ -188,13 +188,13 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! magnitude near the bottom for use in the ! quadratic bottom drag, in m2 s-2. real :: hwtot ! Sum of the thicknesses used to calculate - ! the near-bottom velocity magnitude, in H. + ! the near-bottom velocity magnitude, in H ~> m or kg m-2. real :: hutot ! Running sum of thicknesses times the - ! velocity magnitudes, in H m s-1. + ! velocity magnitudes, in H m s-1 ~> m2 s-1 or kg m-1 s-1. real :: Thtot ! Running sum of thickness times temperature, in H C. real :: Shtot ! Running sum of thickness times salinity, in H psu. real :: hweight ! The thickness of a layer that is within Hbbl - ! of the bottom, in H. + ! of the bottom, in H ~> m or kg m-2. real :: v_at_u, u_at_v ! v at a u point or vice versa, m s-1. real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors, in kg s2 H m-3 Z-2. ! The 400 is a constant proposed by Killworth and Edwards, 1999. @@ -204,43 +204,43 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! density, in Pa (usually set to 2e7 Pa = 2000 dbar). ! The units H in the following are thickness units - typically m or kg m-2. - real :: D_vel ! The bottom depth at a velocity point, in H. - real :: Dp, Dm ! The depths at the edges of a velocity cell, in H. + real :: D_vel ! The bottom depth at a velocity point, in H ~> m or kg m-2. + real :: Dp, Dm ! The depths at the edges of a velocity cell, in H ~> m or kg m-2. real :: a ! a is the curvature of the bottom depth across a - ! cell, times the cell width squared, in H. - real :: a_3, a_12, C24_a ! a/3, a/12, and 24/a, in H, H, and H-1. + ! cell, times the cell width squared, in H ~> m or kg m-2. + real :: a_3, a_12, C24_a ! a/3, a/12, and 24/a, in H ~> m or kg m-2, H, and H-1. real :: slope ! The absolute value of the bottom depth slope across - ! a cell times the cell width, in H. + ! a cell times the cell width, in H ~> m or kg m-2. real :: apb_4a, ax2_3apb ! Various nondimensional ratios of a and slope. real :: a2x48_apb3, Iapb, Ibma_2 ! Combinations of a and slope with units of H-1. ! All of the following "volumes" have units of meters as they are normalized ! by the full horizontal area of a velocity cell. - real :: Vol_open ! The cell volume above which it is open, in H. + real :: Vol_open ! The cell volume above which it is open, in H ~> m or kg m-2. real :: Vol_direct ! With less than Vol_direct (in H), there is a direct ! solution of a cubic equation for L. real :: Vol_2_reg ! The cell volume above which there are two separate - ! open areas that must be integrated, in H. + ! open areas that must be integrated, in H ~> m or kg m-2. real :: vol ! The volume below the interface whose normalized - ! width is being sought, in H. + ! width is being sought, in H ~> m or kg m-2. real :: vol_below ! The volume below the interface below the one that - ! is currently under consideration, in H. + ! is currently under consideration, in H ~> m or kg m-2. real :: Vol_err ! The error in the volume with the latest estimate of - ! L, or the error for the interface below, in H. - real :: Vol_quit ! The volume error below which to quit iterating, in H. - real :: Vol_tol ! A volume error tolerance, in H. + ! L, or the error for the interface below, in H ~> m or kg m-2. + real :: Vol_quit ! The volume error below which to quit iterating, in H ~> m or kg m-2. + real :: Vol_tol ! A volume error tolerance, in H ~> m or kg m-2. real :: L(SZK_(G)+1) ! The fraction of the full cell width that is open at ! the depth of each interface, nondimensional. real :: L_direct ! The value of L above volume Vol_direct, nondim. real :: L_max, L_min ! Upper and lower bounds on the correct value for L. real :: Vol_err_max ! The volume errors for the upper and lower bounds on - real :: Vol_err_min ! the correct value for L, in H. - real :: Vol_0 ! A deeper volume with known width L0, in H. + real :: Vol_err_min ! the correct value for L, in H ~> m or kg m-2. + real :: Vol_0 ! A deeper volume with known width L0, in H ~> m or kg m-2. real :: L0 ! The value of L above volume Vol_0, nondim. - real :: dVol ! vol - Vol_0, in H. + real :: dVol ! vol - Vol_0, in H ~> m or kg m-2. real :: dV_dL2 ! The partial derivative of volume with L squared - ! evaluated at L=L0, in H. + ! evaluated at L=L0, in H ~> m or kg m-2. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. + ! in roundoff and can be neglected, in H ~> m or kg m-2. real :: ustH ! ustar converted to units of H s-1. real :: root ! A temporary variable with units of H s-1. @@ -912,7 +912,7 @@ function set_v_at_u(v, h, G, i, j, k, mask2dCv, OBC) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 integer, intent(in) :: i !< The i-index of the u-location to work on. integer, intent(in) :: j !< The j-index of the u-location to work on. integer, intent(in) :: k !< The k-index of the u-location to work on. @@ -922,8 +922,8 @@ function set_v_at_u(v, h, G, i, j, k, mask2dCv, OBC) real :: set_v_at_u !< The retur value of v at u points, in m s-1. ! This subroutine finds a thickness-weighted value of v at the u-points. - real :: hwt(0:1,-1:0) ! Masked weights used to average u onto v, in H. - real :: hwt_tot ! The sum of the masked thicknesses, in H. + real :: hwt(0:1,-1:0) ! Masked weights used to average u onto v, in H ~> m or kg m-2. + real :: hwt_tot ! The sum of the masked thicknesses, in H ~> m or kg m-2. integer :: i0, j0, i1, j1 do j0 = -1,0 ; do i0 = 0,1 ; i1 = i+i0 ; J1 = J+j0 @@ -955,7 +955,7 @@ function set_u_at_v(u, h, G, i, j, k, mask2dCu, OBC) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< The zonal velocity, in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 integer, intent(in) :: i !< The i-index of the u-location to work on. integer, intent(in) :: j !< The j-index of the u-location to work on. integer, intent(in) :: k !< The k-index of the u-location to work on. @@ -965,8 +965,8 @@ function set_u_at_v(u, h, G, i, j, k, mask2dCu, OBC) real :: set_u_at_v !< The return value of u at v points, in m s-1. ! This subroutine finds a thickness-weighted value of u at the v-points. - real :: hwt(-1:0,0:1) ! Masked weights used to average u onto v, in H. - real :: hwt_tot ! The sum of the masked thicknesses, in H. + real :: hwt(-1:0,0:1) ! Masked weights used to average u onto v, in H ~> m or kg m-2. + real :: hwt_tot ! The sum of the masked thicknesses, in H ~> m or kg m-2. integer :: i0, j0, i1, j1 do j0 = 0,1 ; do i0 = -1,0 ; I1 = I+i0 ; j1 = j+j0 @@ -1006,7 +1006,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available !! thermodynamic fields. Absent fields have !! NULL ptrs. @@ -1022,7 +1022,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! Local variables real, dimension(SZIB_(G)) :: & htot, & ! The total depth of the layers being that are within the - ! surface mixed layer, in H. + ! surface mixed layer, in H ~> m or kg m-2. Thtot, & ! The integrated temperature of layers that are within the ! surface mixed layer, in H degC. Shtot, & ! The integrated salt of layers that are within the @@ -1031,8 +1031,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! surface mixed layer, in H kg m-3. Rhtot is only used if no ! equation of state is used. uhtot, & ! The depth integrated zonal and meridional velocities within - vhtot, & ! the surface mixed layer, in H m s-1. - Idecay_len_TKE, & ! The inverse of a turbulence decay length scale, in H-1. + vhtot, & ! the surface mixed layer, in H m s-1 ~> m2 s-1 or kg m-1 s-1. + Idecay_len_TKE, & ! The inverse of a turbulence decay length scale, in H-1 ~> m-1 or m2 kg-1. dR_dT, & ! Partial derivative of the density at the base of layer nkml ! (roughly the base of the mixed layer) with temperature, in ! units of kg m-3 K-1. @@ -1051,7 +1051,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! are land or past open boundary conditions, nondim., 0 or 1. real :: h_at_vel(SZIB_(G),SZK_(G))! Layer thickness at velocity points, ! using an upwind-biased second order accurate estimate based - ! on the previous velocity direction, in H. + ! on the previous velocity direction, in H ~> m or kg m-2. integer :: k_massive(SZIB_(G)) ! The k-index of the deepest layer yet found ! that has more than h_tiny thickness and will be in the ! viscous mixed layer. @@ -1060,17 +1060,17 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! interior layer layer times the depth of the the mixed layer, ! in H2 m2 s-2. real :: htot_vel ! Sum of the layer thicknesses up to some - ! point, in H (i.e., m or kg m-2). + ! point, in H ~> m or kg m-2. real :: hwtot ! Sum of the thicknesses used to calculate - ! the near-bottom velocity magnitude, in H. + ! the near-bottom velocity magnitude, in H ~> m or kg m-2. real :: hutot ! Running sum of thicknesses times the - ! velocity magnitudes, in H m s-1. + ! velocity magnitudes, in H m s-1 ~> m2 s-1 or kg m-1 s-1. real :: hweight ! The thickness of a layer that is within Hbbl - ! of the bottom, in H. + ! of the bottom, in H ~> m or kg m-2. real :: tbl_thick_Z ! The thickness of the top boundary layer in Z ~> m. - real :: hlay ! The layer thickness at velocity points, in H. - real :: I_2hlay ! 1 / 2*hlay, in H-1. + real :: hlay ! The layer thickness at velocity points, in H ~> m or kg m-2. + real :: I_2hlay ! 1 / 2*hlay, in H-1 ~> m-1 or m2 kg-1. real :: T_lay ! The layer temperature at velocity points, in deg C. real :: S_lay ! The layer salinity at velocity points, in PSU. real :: Rlay ! The layer potential density at velocity points, in kg m-3. @@ -1099,19 +1099,19 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real :: Dfn ! The increment in oldfn for entraining ! the layer, in H kg m-3. real :: Dh ! The increment in layer thickness from - ! the present layer, in H. + ! the present layer, in H ~> m or kg m-2. real :: U_bg_sq ! The square of an assumed background velocity, for ! calculating the mean magnitude near the top for use in - ! the quadratic surface drag, in m2. - real :: h_tiny ! A very small thickness, in H. Layers that are less than + ! the quadratic surface drag, in m2 s-2. + real :: h_tiny ! A very small thickness, in H ~> m or kg m-2. Layers that are less than ! h_tiny can not be the deepest in the viscous mixed layer. real :: absf ! The absolute value of f averaged to velocity points, s-1. real :: U_star ! The friction velocity at velocity points, in Z s-1 ~> m s-1. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. + ! in roundoff and can be neglected, in H ~> m or kg m-2. real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors, in kg s2 H m-3 Z-2. ! The 400 is a constant proposed by Killworth and Edwards, 1999. - real :: ustar1 ! ustar in units of H/s + real :: ustar1 ! ustar in H s-1 ~> m s-1 or kg m-2 s-1 real :: h2f2 ! (h*2*f)^2 logical :: use_EOS, do_any, do_any_shelf, do_i(SZIB_(G)) integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, K2, nkmb, nkml, n diff --git a/src/parameterizations/vertical/MOM_shortwave_abs.F90 b/src/parameterizations/vertical/MOM_shortwave_abs.F90 index 410a41583a..fe1d8f302c 100644 --- a/src/parameterizations/vertical/MOM_shortwave_abs.F90 +++ b/src/parameterizations/vertical/MOM_shortwave_abs.F90 @@ -48,8 +48,7 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or - !! kg m-2). + real, dimension(SZI_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. real, dimension(:,:,:), intent(in) :: opacity_band !< Opacity in each band of !! penetrating shortwave radiation (1/H). !! The indicies are band, i, k. @@ -84,9 +83,9 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, !! nsw x SZI_(G). real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: eps !< Small thickness that must remain in !! each layer, and which will not be - !! subject to heating (units of H) + !! subject to heating (H ~> m or kg m-2) integer, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: ksort !< Density-sorted k-indicies. - real, dimension(SZI_(G)), optional, intent(in) :: htot !< Total mixed layer thickness, in H . + real, dimension(SZI_(G)), optional, intent(in) :: htot !< Total mixed layer thickness, in H ~> m or kg m-2. real, dimension(SZI_(G)), optional, intent(inout) :: Ttot !< Depth integrated mixed layer !! temperature (units of K H). real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: dSV_dT !< The partial derivative of specific @@ -104,7 +103,7 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, ! radiation that hits the bottom. real, dimension(SZI_(G)) :: & h_heat, & ! The thickness of the water column that will be heated by - ! any remaining shortwave radiation (H units). + ! any remaining shortwave radiation (H ~> m or kg m-2). T_chg, & ! The temperature change of thick layers due to the remaining ! shortwave radiation and contributions from T_chg_above, in K. Pen_SW_rem ! The sum across all wavelength bands of the penetrating shortwave @@ -130,7 +129,7 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, ! efficiency, instead of continuing to penetrate, in units ! of K H s-1. The default, 2.5e-11, is about 0.08 K m / century. real :: epsilon ! A small thickness that must remain in each - ! layer, and which will not be subject to heating (units of H) + ! layer, and which will not be subject to heating (H ~> m or kg m-2) real :: I_G_Earth real :: g_Hconv2 logical :: SW_Remains ! If true, some column has shortwave radiation that @@ -304,7 +303,7 @@ subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. real, dimension(:,:,:), intent(in) :: opacity_band !< opacity in each band of !! penetrating shortwave radiation, !! in m-1. The indicies are band, i, k. @@ -314,7 +313,7 @@ subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & real, intent(in) :: dt !< Time step (seconds). real, intent(in) :: H_limit_fluxes !< the total depth at which the !! surface fluxes start to be limited to avoid - !! excessive heating of a thin ocean (H units) + !! excessive heating of a thin ocean (H ~> m or kg m-2) logical, intent(in) :: absorbAllSW !< If true, ensure that all shortwave !! radiation is absorbed in the ocean water column. real, dimension(:,:), intent(in) :: iPen_SW_bnd !< The incident penetrating shortwave @@ -326,7 +325,7 @@ subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & !! interface, summed across all bands, in K H. ! Local variables real :: h_heat(SZI_(G)) ! thickness of the water column that receives - ! remaining shortwave radiation, in H. + ! remaining shortwave radiation, in H ~> m or kg m-2. real :: Pen_SW_rem(SZI_(G)) ! sum across all wavelength bands of the ! penetrating shortwave heating that hits the bottom ! and will be redistributed through the water column @@ -339,7 +338,7 @@ subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & ! not absorbed because the layers are too thin. real :: Ih_limit ! inverse of the total depth at which the ! surface fluxes start to be limited (1/H units) - real :: h_min_heat ! minimum thickness layer that should get heated (H units) + real :: h_min_heat ! minimum thickness layer that should get heated (H ~> m or kg m-2) real :: opt_depth ! optical depth of a layer (non-dim) real :: exp_OD ! exp(-opt_depth) (non-dim) logical :: SW_Remains ! If true, some column has shortwave radiation that diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index bdd230d4fe..0dd1418c8e 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -320,16 +320,16 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2 real, intent(in) :: dt !< The amount of time covered by this call, in s. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: ea !< An array to which the amount of fluid entrained !! from the layer above during this call will be - !! added, in H. + !! added, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: eb !< An array to which the amount of fluid entrained !! from the layer below during this call will be - !! added, in H. + !! added, in H ~> m or kg m-2. type(sponge_CS), pointer :: CS !< A pointer to the control structure for this module !! that is set by a previous call to initialize_sponge. real, dimension(SZI_(G),SZJ_(G)), & @@ -342,7 +342,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & w_int, & ! Water moved upward across an interface within a timestep, - ! in H. + ! in H ~> m or kg m-2. e_D ! Interface heights that are dilated to have a value of 0 ! at the surface, in the same units as G%bathyT (m or Z). real, dimension(SZI_(G), SZJ_(G)) :: & @@ -355,8 +355,8 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) real, allocatable, dimension(:,:,:) :: & fld_mean_anom ! THe i-mean tracer concentration anomalies. real, dimension(SZI_(G), SZK_(G)+1) :: & - h_above, & ! The total thickness above an interface, in H. - h_below ! The total thickness below an interface, in H. + h_above, & ! The total thickness above an interface, in H ~> m or kg m-2. + h_below ! The total thickness below an interface, in H ~> m or kg m-2. real, dimension(SZI_(G)) :: & dilate ! A nondimensional factor by which to dilate layers to ! give 0 at the surface. @@ -367,11 +367,11 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) ! profile must be stretched for the free surfaces ! heights in the two profiles to agree. real :: w ! The thickness of water moving upward through an - ! interface within 1 timestep, in H. - real :: wm ! wm is w if w is negative and 0 otherwise, in H. - real :: wb ! w at the interface below a layer, in H. - real :: wpb ! wpb is wb if wb is positive and 0 otherwise, in H. - real :: ea_k, eb_k ! in H + ! interface within 1 timestep, in H ~> m or kg m-2. + real :: wm ! wm is w if w is negative and 0 otherwise, in H ~> m or kg m-2. + real :: wb ! w at the interface below a layer, in H ~> m or kg m-2. + real :: wpb ! wpb is wb if wb is positive and 0 otherwise, in H ~> m or kg m-2. + real :: ea_k, eb_k ! in H ~> m or kg m-2 real :: damp ! The timestep times the local damping coefficient. ND. real :: I1pdamp ! I1pdamp is 1/(1 + damp). Nondimensional. real :: damp_1pdamp ! damp_1pdamp is damp/(1 + damp). Nondimensional. diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 7b075a6cef..5e227e43f2 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -466,7 +466,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, diag_to_Z_ CS%h2(i,j) = hamp*hamp utide = CS%tideamp(i,j) - ! Compute the fixed part of internal tidal forcing; units are [kg s-2] here. + ! Compute the fixed part of internal tidal forcing; units are [J m-2 = kg s-2] here. CS%TKE_itidal(i,j) = 0.5*US%Z_to_m * CS%kappa_h2_factor*GV%Rho0*& CS%kappa_itides * CS%h2(i,j) * utide*utide enddo ; enddo @@ -657,7 +657,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, C type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy !! frequency, in s-2. real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< The squared buoyancy frequency of the @@ -707,7 +707,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: N2_int !< The squared buoyancy !! frequency at the interfaces, in s-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: Kd_lay!< The diapycnal diffusivities in the layers, in Z2 s-1 ~> m2 s-1. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface @@ -929,7 +929,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy frequency !! frequency, in s-2. real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< The squared buoyancy frequency of the @@ -1420,7 +1420,7 @@ subroutine post_tidal_diagnostics(G, GV, h ,CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. type(tidal_mixing_cs), pointer :: CS !< The control structure for this module ! local diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 77e336b71e..f88c463627 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -38,7 +38,7 @@ module MOM_vert_friction type, public :: vertvisc_CS ; private real :: Hmix !< The mixed layer thickness in thickness units (H). real :: Hmix_stress !< The mixed layer thickness over which the wind - !! stress is applied with direct_stress, in H. + !! stress is applied with direct_stress, in H ~> m or kg m-2. real :: Kvml !< The mixed layer vertical viscosity in m2 s-1. real :: Kv !< The interior vertical viscosity in m2 s-1. real :: Hbbl !< The static bottom boundary layer thickness, in m. @@ -152,7 +152,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(inout) :: v !< Meridional velocity in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thickness in H + intent(in) :: h !< Layer thickness in H ~> m or kg m-2 type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces type(vertvisc_type), intent(inout) :: visc !< Viscosities and bottom drag real, intent(in) :: dt !< Time increment in s @@ -179,7 +179,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! while b1 has units of inverse thickness. real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver, ND. real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity, in Z s-1 ~> m s-1. - real :: b_denom_1 ! The first term in the denominator of b1, in H. + real :: b_denom_1 ! The first term in the denominator of b1, in H ~> m or kg m-2. real :: Hmix ! The mixed layer thickness over which stress ! is applied with direct_stress, translated into @@ -578,7 +578,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: v !< Meridional velocity in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thickness in H + intent(in) :: h !< Layer thickness in H ~> m or kg m-2 type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces type(vertvisc_type), intent(in) :: visc !< Viscosities and bottom drag real, intent(in) :: dt !< Time increment in s @@ -596,8 +596,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) ! given by 2*(h+ * h-)/(h+ + h-), in m or kg m-2 (H for short). h_arith, & ! The arithmetic mean thickness, in m or kg m-2. h_delta, & ! The lateral difference of thickness, in m or kg m-2. - hvel, & ! hvel is the thickness used at a velocity grid point, in H. - hvel_shelf ! The equivalent of hvel under shelves, in H. + hvel, & ! hvel is the thickness used at a velocity grid point, in H ~> m or kg m-2. + hvel_shelf ! The equivalent of hvel under shelves, in H ~> m or kg m-2. real, dimension(SZIB_(G),SZK_(G)+1) :: & a_cpl, & ! The drag coefficients across interfaces, in Z s-1 ~> m s-1. a_cpl times ! the velocity difference gives the stress across an interface. @@ -614,7 +614,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) ! of H-1 (i.e., m-1 or m2 kg-1). zcol1, & ! The height of the interfaces to the north and south of a zcol2, & ! v-point, in m or kg m-2. - Ztop_min, & ! The deeper of the two adjacent surface heights, in H. + Ztop_min, & ! The deeper of the two adjacent surface heights, in H ~> m or kg m-2. Dmin, & ! The shallower of the two adjacent bottom depths converted to ! thickness units, in m or kg m-2. zh, & ! An estimate of the interface's distance from the bottom @@ -624,16 +624,16 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) real, allocatable, dimension(:,:) :: hML_v ! Diagnostic of the mixed layer depth at v points, in m. real, allocatable, dimension(:,:,:) :: Kv_u !< Total vertical viscosity at u-points, in m2 s-1. real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points, in m2 s-1. - real :: zcol(SZI_(G)) ! The height of an interface at h-points, in H (m or kg m-2). + real :: zcol(SZI_(G)) ! The height of an interface at h-points, in H ~> m or kg m-2. real :: botfn ! A function which goes from 1 at the bottom to 0 much more ! than Hbbl into the interior. real :: topfn ! A function which goes from 1 at the top to 0 much more ! than Htbl into the interior. real :: z2 ! The distance from the bottom, normalized by Hbbl, nondim. real :: z2_wt ! A nondimensional (0-1) weight used when calculating z2. - real :: z_clear ! The clearance of an interface above the surrounding topography, in H. + real :: z_clear ! The clearance of an interface above the surrounding topography, in H ~> m or kg m-2. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. + ! in roundoff and can be neglected, in H ~> m or kg m-2. real :: I_valBL ! The inverse of a scaling factor determining when water is ! still within the boundary layer, as determined by the sum @@ -1048,18 +1048,18 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, real, dimension(SZIB_(G),SZK_(GV)+1), & intent(out) :: a_cpl !< Coupling coefficient across interfaces, in Z s-1 ~> m s-1. real, dimension(SZIB_(G),SZK_(GV)), & - intent(in) :: hvel !< Thickness at velocity points, in H + intent(in) :: hvel !< Thickness at velocity points, in H ~> m or kg m-2 logical, dimension(SZIB_(G)), & intent(in) :: do_i !< If true, determine coupling coefficient for a column real, dimension(SZIB_(G),SZK_(GV)), & intent(in) :: h_harm !< Harmonic mean of thicknesses around a velocity - !! grid point, in H - real, dimension(SZIB_(G)), intent(in) :: bbl_thick !< Bottom boundary layer thickness, in H + !! grid point, in H ~> m or kg m-2 + real, dimension(SZIB_(G)), intent(in) :: bbl_thick !< Bottom boundary layer thickness, in H ~> m or kg m-2 real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity, in Z2 s-1 ~> m2 s-1. real, dimension(SZIB_(G),SZK_(GV)+1), & intent(in) :: z_i !< Estimate of interface heights above the bottom, !! normalized by the bottom boundary layer thickness - real, dimension(SZIB_(G)), intent(out) :: h_ml !< Mixed layer depth, in H + real, dimension(SZIB_(G)), intent(out) :: h_ml !< Mixed layer depth, in H ~> m or kg m-2 integer, intent(in) :: j !< j-index to find coupling coefficient for real, intent(in) :: dt !< Time increment, in s type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure @@ -1084,16 +1084,16 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, tbl_thick real, dimension(SZIB_(G),SZK_(GV)) :: & Kv_add ! A viscosity to add, in Z2 s-1 ~> m2 s-1. - real :: h_shear ! The distance over which shears occur, H. - real :: r ! A thickness to compare with Hbbl, in H. + real :: h_shear ! The distance over which shears occur, in H ~> m or kg m-2. + real :: r ! A thickness to compare with Hbbl, in H ~> m or kg m-2. real :: visc_ml ! The mixed layer viscosity, in Z2 s-1 ~> m2 s-1. - real :: I_Hmix ! The inverse of the mixed layer thickness, in H-1. + real :: I_Hmix ! The inverse of the mixed layer thickness, in H-1 ~> m-1 or m2 kg-1. real :: a_ml ! The layer coupling coefficient across an interface in ! the mixed layer, in m s-1. real :: I_amax ! The inverse of the maximum coupling coefficient, in Z-1 ~> m-1.??? real :: temp1 ! A temporary variable in H Z real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. + ! in roundoff and can be neglected, in H ~> m or kg m-2. real :: z2 ! A copy of z_i, nondim. real :: topfn real :: a_top @@ -1365,7 +1365,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(inout) :: v !< Meridional velocity in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thickness in H + intent(in) :: h !< Layer thickness in H ~> m or kg m-2 type(accel_diag_ptrs), intent(in) :: ADp !< Acceleration diagnostic pointers type(cont_diag_ptrs), intent(in) :: CDp !< Continuity diagnostic pointers type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 6a1155310e..127f293c98 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -147,7 +147,7 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & logical, intent(in) :: restart !< .true. if the fields have already !! been read from a restart file. type(time_type), target, intent(in) :: day !< Time of the start of the run. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(diag_ctrl), target, intent(in) :: diag !< Structure used to regulate diagnostic output. type(ocean_OBC_type), pointer :: OBC !< Structure specifying open boundary options. type(DOME_tracer_CS), pointer :: CS !< The control structure returned by a previous @@ -175,7 +175,7 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & real :: tr_y ! Initial zonally uniform tracer concentrations. real :: dist2 ! The distance squared from a line, in m2. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H. + ! in roundoff and can be neglected, in H ~> m or kg m-2. real :: e(SZK_(G)+1), e_top, e_bot ! Heights in Z ~> m. real :: d_tr ! A change in tracer concentraions, in tracer units. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index 6712088988..304828313c 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -318,7 +318,7 @@ subroutine initialize_OCMIP2_CFC(restart, day, G, GV, US, h, diag, OBC, CS, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 !! (usually m or kg m-2). type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. @@ -362,7 +362,7 @@ end subroutine initialize_OCMIP2_CFC subroutine init_tracer_CFC(h, tr, name, land_val, IC_val, G, US, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: tr !< The tracer concentration array character(len=*), intent(in) :: name !< The tracer name real, intent(in) :: land_val !< A value the tracer takes over land @@ -496,7 +496,7 @@ function OCMIP2_CFC_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 !! (usually m or kg m-2). real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount !! of each tracer, in kg times diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index edcc636996..782ac3a533 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -231,7 +231,7 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(diag_ctrl), target, intent(in) :: diag !< Regulates diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies whether, @@ -600,7 +600,7 @@ end subroutine MOM_generic_tracer_column_physics function MOM_generic_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 real, dimension(:), intent(out) :: stocks !< The mass-weighted integrated amount of each !! tracer, in kg times concentration units. type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. @@ -750,7 +750,7 @@ subroutine MOM_generic_tracer_surface_state(state, h, G, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(surface), intent(inout) :: state !< A structure containing fields that !! describe the surface state of the ocean. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. ! Local variables diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 8a59f69a61..babb8d43e8 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -168,7 +168,7 @@ module MOM_offline_main real, allocatable, dimension(:,:) :: netMassIn !< Freshwater fluxes into the ocean real, allocatable, dimension(:,:) :: netMassOut !< Freshwater fluxes out of the ocean - real, allocatable, dimension(:,:) :: mld !< Mixed layer depths at thickness points, in H. + real, allocatable, dimension(:,:) :: mld !< Mixed layer depths at thickness points, in H ~> m or kg m-2. ! Allocatable arrays to read in entire fields during initialization real, allocatable, dimension(:,:,:,:) :: uhtr_all !< Entire field of zonal transport @@ -749,7 +749,7 @@ subroutine offline_fw_fluxes_into_ocean(G, GV, CS, fluxes, h, in_flux_optional) type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(forcing), intent(inout) :: fluxes !< Surface fluxes container real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thickness in H units + intent(inout) :: h !< Layer thickness in H ~> m or kg m-2 real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: in_flux_optional !< The total time-integrated amount !! of tracer that leaves with freshwater @@ -799,7 +799,7 @@ subroutine offline_fw_fluxes_out_ocean(G, GV, CS, fluxes, h, out_flux_optional) type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(forcing), intent(inout) :: fluxes !< Surface fluxes container real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thickness in H units + intent(inout) :: h !< Layer thickness in H ~> m or kg m-2 real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: out_flux_optional !< The total time-integrated amount !! of tracer that leaves with freshwater diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index 66f261ed8d..caac2a04fa 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -33,7 +33,7 @@ function tracer_Z_init(tr, h, filename, tr_name, G, US, missing_val, land_val) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: tr !< The tracer to initialize real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 character(len=*), intent(in) :: filename !< The name of the file to read from character(len=*), intent(in) :: tr_name !< The name of the tracer in the file ! type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 589ad07e19..34808f8127 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -328,11 +328,11 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(tracer_type), dimension(ntr), intent(inout) :: Tr !< The array of registered tracers to work on real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hprev !< cell volume at the end of previous - !! tracer change, in H m2 (m3 or kg) + !! tracer change, in H m2 ~> m3 or kg real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhr !< accumulated volume/mass flux through - !! the zonal face, in H m2 (m3 or kg) + !! the zonal face, in H m2 ~> m3 or kg real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: uh_neglect !< A tiny zonal mass flux that can - !! be neglected, in H m2 (m3 or kg) + !! be neglected, in H m2 ~> m3 or kg type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used logical, dimension(SZJ_(G),SZK_(G)), intent(inout) :: domore_u !< If true, there is more advection to be !! done in this u-row @@ -656,11 +656,11 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(tracer_type), dimension(ntr), intent(inout) :: Tr !< The array of registered tracers to work on real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hprev !< cell volume at the end of previous - !! tracer change, in H m2 (m3 or kg) + !! tracer change, in H m2 ~> m3 or kg real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhr !< accumulated volume/mass flux through - !! the meridional face, in H m2 (m3 or kg) + !! the meridional face, in H m2 ~> m3 or kg real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vh_neglect !< A tiny meridional mass flux that can - !! be neglected, in H m2 (m3 or kg) + !! be neglected, in H m2 ~> m3 or kg type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used logical, dimension(SZJB_(G),SZK_(G)), intent(inout) :: domore_v !< If true, there is more advection to be !! done in this v-row diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index c8ce7700db..42420b2c6b 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -230,7 +230,7 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Tr !< Tracer concentration on T-cell real, intent(in ) :: dt !< Time-step over which forcing is applied (s) type(forcing), intent(in ) :: fluxes !< Surface fluxes container - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness in H units + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness in H ~> m or kg m-2 real, intent(in ) :: evap_CFL_limit !< Limit on the fraction of the !! water that can be fluxed out of the top !! layer in a timestep (nondim) @@ -250,9 +250,9 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim real :: fractionOfForcing, hOld, Ithickness real :: RivermixConst ! A constant used in implementing river mixing, in Pa s. real, dimension(SZI_(G)) :: & - netMassInOut, & ! surface water fluxes (H units) over time step - netMassIn, & ! mass entering ocean surface (H units) over a time step - netMassOut ! mass leaving ocean surface (H units) over a time step + netMassInOut, & ! surface water fluxes (H ~> m or kg m-2) over time step + netMassIn, & ! mass entering ocean surface (H ~> m or kg m-2) over a time step + netMassOut ! mass leaving ocean surface (H ~> m or kg m-2) over a time step real, dimension(SZI_(G), SZK_(G)) :: h2d, Tr2d real, dimension(SZI_(G),SZJ_(G)) :: in_flux ! The total time-integrated amount of tracer! @@ -318,7 +318,7 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim ! We aggregate the thermodynamic forcing for a time step into the following: ! These should have been set and stored during a call to applyBoundaryFluxesInOut ! netMassIn = net mass entering at ocean surface over a timestep - ! netMassOut = net mass leaving ocean surface (H units) over a time step. + ! netMassOut = net mass leaving ocean surface (H ~> m or kg m-2) over a time step. ! netMassOut < 0 means mass leaves ocean. ! Note here that the aggregateFW flag has already been taken care of in the call to diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 6438a55ed2..c350142c8e 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -279,7 +279,7 @@ subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid !! structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h !< Layer thicknesses, in H + real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 !! (usually m or kg m-2) type(param_file_type), intent(in) :: param_file !< A structure to parse for !! run-time parameters @@ -598,7 +598,7 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni num_stocks, stock_index, got_min_max, global_min, global_max, & xgmin, ygmin, zgmin, xgmax, ygmax, zgmax) real, dimension(NIMEM_,NJMEM_,NKMEM_), & - intent(in) :: h !< Layer thicknesses, in H + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 !! (usually m or kg m-2). real, dimension(:), intent(out) :: stock_values !< The integrated amounts of a tracer !! on the current PE, usually in kg x concentration. @@ -798,7 +798,7 @@ subroutine call_tracer_surface_state(state, h, G, CS) type(surface), intent(inout) :: state !< A structure containing fields that !! describe the surface state of the ocean. real, dimension(NIMEM_,NJMEM_,NKMEM_), & - intent(in) :: h !< Layer thicknesses, in H + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 !! (usually m or kg m-2). type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 597b0fc822..77de7eb11d 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -587,7 +587,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & real, dimension(SZK_(G)) :: & h_demand_L, & ! The thickness in the left (_L) or right (_R) column that - h_demand_R, & ! is demanded to match the thickness in the counterpart, in H. + h_demand_R, & ! is demanded to match the thickness in the counterpart, in H ~> m or kg m-2. h_used_L, & ! The summed thickness from the left or right columns that h_used_R, & ! have actually been used, in m or kg m-2 (H). h_supply_frac_L, & ! The fraction of the demanded thickness that can diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index aeb1b3aae9..dbf57a5cc9 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -171,7 +171,7 @@ subroutine initialize_advection_test_tracer(restart, day, G, GV, h,diag, OBC, CS type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies @@ -354,7 +354,7 @@ end subroutine advection_test_tracer_surface_state !! If the stock_index is present, only the stock corresponding to that coded index is returned. function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 9b785fe41d..9624602a78 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -156,7 +156,7 @@ subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies @@ -287,7 +287,7 @@ end subroutine boundary_impulse_tracer_column_physics function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in ) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: h !< Layer thicknesses, in H ~> m or kg m-2 real, dimension(:), intent( out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units. type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 7f33034830..084d0f54ac 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -190,7 +190,7 @@ subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_C type(time_type), target, intent(in) :: day !< Time of the start of the run. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(diag_ctrl), target, intent(in) :: diag !< Structure used to regulate diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary @@ -328,7 +328,7 @@ end subroutine dye_tracer_column_physics !! returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. function dye_stock(h, stocks, G, GV, CS, names, units, stock_index) - real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of !! each tracer, in kg times concentration units. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index af69a39c52..b32b88b8f2 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -138,7 +138,7 @@ subroutine initialize_dyed_obc_tracer(restart, day, G, GV, h, diag, OBC, CS, dia logical, intent(in) :: restart !< .true. if the fields have already !! been read from a restart file. type(time_type), target, intent(in) :: day !< Time of the start of the run. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(diag_ctrl), target, intent(in) :: diag !< Structure used to regulate diagnostic output. type(ocean_OBC_type), pointer :: OBC !< Structure specifying open boundary options. type(dyed_obc_tracer_CS), pointer :: CS !< The control structure returned by a previous diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index 750fa83021..75ce468ef8 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -203,7 +203,7 @@ subroutine initialize_ideal_age_tracer(restart, day, G, GV, US, h, diag, OBC, CS type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies @@ -375,7 +375,7 @@ end subroutine ideal_age_tracer_column_physics function ideal_age_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 3130ba3804..91e3db41fb 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -210,7 +210,7 @@ subroutine initialize_oil_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies @@ -408,7 +408,7 @@ end subroutine oil_tracer_column_physics function oil_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units. type(oil_tracer_CS), pointer :: CS !< The control structure returned by a previous diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index d9f4d3f682..b2f11604d1 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -121,7 +121,7 @@ subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies @@ -254,7 +254,7 @@ end subroutine pseudo_salt_tracer_column_physics function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units. type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index bf6b504658..9db0ed049c 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -144,7 +144,7 @@ subroutine USER_initialize_tracer(restart, day, G, GV, h, diag, OBC, CS, & type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies @@ -364,7 +364,7 @@ function USER_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units. type(USER_tracer_example_CS), pointer :: CS !< The control structure returned by a @@ -411,7 +411,7 @@ subroutine USER_tracer_surface_state(state, h, G, CS) type(surface), intent(inout) :: state !< A structure containing fields that !! describe the surface state of the ocean. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 type(USER_tracer_example_CS), pointer :: CS !< The control structure returned by a previous !! call to register_USER_tracer. diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 78cb7fe163..17d5ff8072 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -85,12 +85,12 @@ subroutine BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, para type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(sponge_CS), pointer :: CSp !< A pointer to the sponge control structure real, dimension(NIMEM_, NJMEM_, NKMEM_), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 ! Local variables real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in depth units (Z ~> m). real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. - real :: H0(SZK_(G)) ! Resting layer thickesses in depth units (Z ~> m). + real :: H0(SZK_(G)) ! Resting layer thicknesses in depth units (Z ~> m). real :: min_depth ! The minimum ocean depth in depth units (Z ~> m). real :: damp, e_dense, damp_new, slat, wlon, lenlat, lenlon, nlat character(len=40) :: mdl = "BFB_initialize_sponges_southonly" ! This subroutine's name. diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 14431314da..19faf3bddc 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -94,7 +94,7 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, US, param_file, just_read_par type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H. + intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -226,7 +226,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature (degC) real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity (ppt) - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness in units of H (m or kg m-2) + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness in H ~> m or kg m-2 type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, optional, intent(in) :: just_read_params !< If present and true, this call will diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 10027759ba..54ca54371e 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -90,7 +90,7 @@ subroutine DOME_initialize_thickness(h, G, GV, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H. + intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index eeaf5c9997..157bdf8a93 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -134,7 +134,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, US, param_file, tv, just_read type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H. + intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any @@ -253,7 +253,7 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature (degC) real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity (ppt) - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg m-2) + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness in H ~> m or kg m-2 type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, optional, intent(in) :: just_read_params !< If present and true, this call will diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index fc6c1d5d62..db798a66c6 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -174,7 +174,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness, in H. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness, in H ~> m or kg m-2. type(time_type), intent(in) :: Time !< model time. ! The following variables are used to set up the transport in the Kelvin example. diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 725c8af156..ccbed29b29 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -872,7 +872,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & !! LA outputs are desired that are different than !! those used by the dynamical model. real, dimension(SZK_(GV)), optional, & - intent(in) :: H !< Grid layer thickness in H (m or kg/m2) + intent(in) :: H !< Grid layer thickness in H ~> m or kg m-2 real, dimension(SZK_(GV)), optional, & intent(in) :: U_H !< Zonal velocity at H point (m/s) real, dimension(SZK_(GV)), optional, & @@ -1189,7 +1189,7 @@ subroutine StokesMixing(G, GV, DT, h, u, v, Waves ) intent(in) :: GV !< Ocean vertical grid real, intent(in) :: Dt !< Time step of MOM6 [s] for explicit solver real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& - intent(in) :: h !< Layer/level thicknesses (units of H) + intent(in) :: h !< Layer/level thicknesses (H ~> m or kg m-2) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(inout) :: u !< Velocity i-component (m/s) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -1257,7 +1257,7 @@ subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES) intent(in) :: GV !< Ocean vertical grid real, intent(in) :: Dt !< Time step of MOM6 [s] CHECK IF PASSING RIGHT TIMESTEP real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer/level thicknesses (units of H) + intent(in) :: h !< Layer/level thicknesses (H ~> m or kg m-2) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(inout) :: u !< Velocity i-component (m/s) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index 4f628c0ea6..c007539093 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -114,7 +114,7 @@ subroutine Neverland_initialize_thickness(h, G, GV, US, param_file, eqn_of_state type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(out), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< The thickness that is being - !! initialized, in H. + !! initialized, in H ~> m or kg m-2. type(param_file_type), intent(in) :: param_file !< A structure indicating the open !! file to parse for model !! parameter values. diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 8b99fc972e..59115ee57a 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -39,7 +39,7 @@ subroutine Phillips_initialize_thickness(h, G, GV, US, param_file, just_read_par type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H. + intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -95,11 +95,10 @@ subroutine Phillips_initialize_thickness(h, G, GV, US, param_file, just_read_par enddo ; enddo do j=js,je ; do i=is,ie -! This sets the initial thickness (in H) of the layers. The ! -! thicknesses are set to insure that: 1. each layer is at least an ! -! Angstrom thick, and 2. the interfaces are where they should be ! -! based on the resting depths and interface height perturbations, ! -! as long at this doesn't interfere with 1. ! + ! This sets the initial thickness (in H ~> m or kg m-2) of the layers. The + ! thicknesses are set to insure that: 1. each layer is at least an Angstrom thick, and + ! 2. the interfaces are where they should be based on the resting depths and interface + ! height perturbations, as long at this doesn't interfere with 1. eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = eta_im(j,K) @@ -207,7 +206,7 @@ subroutine Phillips_initialize_sponges(G, GV, US, tv, param_file, CSp, h) type(sponge_CS), pointer :: CSp !< A pointer that is set to point to !! the control structure for the !! sponge module. - real, intent(in), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< Thickness field, in units of H. + real, intent(in), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< Thickness field, in H ~> m or kg m-2. ! Local variables real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces. diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index 975b96e866..7ca852c29a 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -39,7 +39,7 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, param_file, just_read_par type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H. + intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -112,7 +112,7 @@ subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature [deg C] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity [ppt] - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Thickness in H + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Thickness in H ~> m or kg m-2 type(param_file_type), intent(in) :: param_file !< Parameter file handle type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, optional, intent(in) :: just_read_params !< If present and true, this call will diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index 81c8aa2051..d829e2755c 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -55,7 +55,7 @@ module SCM_CVMix_tests subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read_params) real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(out) :: T !< Potential temperature (degC) real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(out) :: S !< Salinity (psu) - real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(in) :: h !< Layer thickness in H (often m or Pa) + real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(in) :: h !< Layer thickness in H ~> m or kg m-2 type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index 2766e01a21..e160f9e90e 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -36,7 +36,7 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H. + intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -187,7 +187,7 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, G, GV, param_file type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< The temperature that is being initialized. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< The salinity that is being initialized. - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< The model thicknesses in H (m or kg m-2). + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< The model thicknesses in H ~> m or kg m-2. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for model parameter values. type(EOS_type), pointer :: eqn_of_state !< Equation of state. diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index ba9e02f10d..5af68af8b9 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -81,7 +81,7 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, US, param_f type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature [deg C] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity [ppt] - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< The model thicknesses in H (m or kg m-2) + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< The model thicknesses in H ~> m or kg m-2 type(param_file_type), intent(in) :: param_file !< Parameter file handle logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing T & S. diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index c16bb9a23d..c7d7b911b8 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -87,7 +87,7 @@ subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H. + intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. type(EOS_type), pointer :: eqn_of_state !< integer that selects the @@ -172,13 +172,10 @@ subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state do k=1,nz ; e_pert(K) = 0.0 ; enddo -! The remainder of this subroutine should not be changed. ! - -! This sets the initial thickness (in H) of the layers. The ! -! thicknesses are set to insure that: 1. each layer is at least ! -! Gv%Angstrom_m thick, and 2. the interfaces are where they should be ! -! based on the resting depths and interface height perturbations, ! -! as long at this doesn't interfere with 1. ! + ! This sets the initial thickness (in H ~> m or kg m-2) of the layers. The thicknesses + ! are set to insure that: 1. each layer is at least Gv%Angstrom_m thick, and + ! 2. the interfaces are where they should be based on the resting depths and interface + ! height perturbations, as long at this doesn't interfere with 1. eta1D(nz+1) = -G%bathyT(i,j) do k=nz,2,-1 diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index c856797612..382b960716 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -31,7 +31,7 @@ subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_para type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H. + intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -41,7 +41,7 @@ subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_para ! negative because it is positive upward. real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! positive upward, in depth units (Z ~> m). - real :: IC_amp ! The amplitude of the initial height displacement, in H. + real :: IC_amp ! The amplitude of the initial height displacement, in H ~> m or kg m-2. real :: diskrad, rad, xCenter, xRadius, lonC, latC, xOffset logical :: just_read ! This include declares and sets the variable "version". diff --git a/src/user/external_gwave_initialization.F90 b/src/user/external_gwave_initialization.F90 index adb9c620df..e14796e6a8 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -29,7 +29,7 @@ subroutine external_gwave_initialize_thickness(h, G, GV, US, param_file, just_re type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H. + intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will diff --git a/src/user/lock_exchange_initialization.F90 b/src/user/lock_exchange_initialization.F90 index 4114b709c8..7be5cb9571 100644 --- a/src/user/lock_exchange_initialization.F90 +++ b/src/user/lock_exchange_initialization.F90 @@ -28,7 +28,7 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, US, param_file, just_rea type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H. + intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 1f5070df47..ea0f9d6a64 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -81,7 +81,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, US, param_file, just_read_p type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H. + intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -193,10 +193,10 @@ end subroutine seamount_initialize_thickness subroutine seamount_initialize_temperature_salinity ( T, S, h, G, GV, param_file, & eqn_of_state, just_read_params) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature (degC) real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity (ppt) - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness in H (m or Pa) + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness in H ~> m or kg m-2 type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, optional, intent(in) :: just_read_params !< If present and true, this call will diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index f192af804d..a4b7f2135b 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -58,7 +58,7 @@ subroutine sloshing_initialize_thickness ( h, G, GV, US, param_file, just_read_p type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H. + intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -182,7 +182,7 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature (degC). real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity (ppt). - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness in H (m or Pa). + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness in H ~> m or kg m-2. type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index 668497fe11..b9b34a0e13 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -33,7 +33,7 @@ subroutine soliton_initialize_thickness(h, G, GV, US) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H. + intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. integer :: i, j, k, is, ie, js, je, nz real :: x, y, x0, y0 diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index 19bcb44615..c8f6c26c53 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -46,7 +46,7 @@ module user_change_diffusivity subroutine user_change_diff(h, tv, G, GV, CS, Kd_lay, Kd_int, T_f, S_f, Kd_int_add) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in H (often m or kg m-2). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in H ~> m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers !! to any available thermodynamic !! fields. Absent fields have NULL ptrs. diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index c34bb8c1c1..47976a4c96 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -82,7 +82,7 @@ subroutine USER_initialize_thickness(h, G, GV, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thicknesses being initialized, in H. + intent(out) :: h !< The thicknesses being initialized, in H ~> m or kg m-2. type(param_file_type), intent(in) :: param_file !< A structure indicating the open !! file to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -98,7 +98,7 @@ subroutine USER_initialize_thickness(h, G, GV, param_file, just_read_params) if (just_read) return ! All run-time parameters have been read, so return. - h(:,:,1) = 0.0 ! h should be set in units of H. + h(:,:,1) = 0.0 ! h should be set in H ~> m or kg m-2. if (first_call) call write_user_log(param_file) @@ -178,7 +178,7 @@ subroutine USER_initialize_sponges(G, GV, use_temp, tv, param_file, CSp, h) !! parameter values. type(sponge_CS), pointer :: CSp !< A pointer to the sponge control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thicknesses, in units of H (m or kg m-2). + intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. call MOM_error(FATAL, & "USER_initialization.F90, USER_initialize_sponges: " // & "Unmodified user routine called - you must edit the routine to use it") @@ -243,7 +243,7 @@ end subroutine write_user_log !! here are: !! - u - Zonal velocity in m s-1. !! - v - Meridional velocity in m s-1. -!! - h - Layer thickness in H. (Must be positive.) +!! - h - Layer thickness in H ~> m or kg m-2. (Must be positive.) !! - G%bathyT - Basin depth in Z ~> m. (Must be positive.) !! - G%CoriolisBu - The Coriolis parameter, in s-1. !! - GV%g_prime - The reduced gravity at each interface, in m2 Z-1 s-2 ~> m s-2. From 53f947ce2a14799c3f2bf020c529eb537a43152c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 17 Dec 2018 17:24:05 -0500 Subject: [PATCH 0958/1072] Reduced use of square brackets in comments Cleaned up array-range syntax in comments using C-style square brackets for array indicies. These may be in conflict with the use of square brackets for links in markup language comments, like dOxyGen. Only comments are changed and all answers are bitwise identical. --- src/core/MOM_CoriolisAdv.F90 | 7 ++----- src/core/MOM_PressureForce_Montgomery.F90 | 14 ++++++-------- src/core/MOM_PressureForce_analytic_FV.F90 | 14 ++++++-------- src/core/MOM_PressureForce_blocked_AFV.F90 | 14 ++++++-------- src/core/MOM_variables.F90 | 4 ++-- .../vertical/MOM_vert_friction.F90 | 10 +++++----- 6 files changed, 27 insertions(+), 36 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index b545ea2b78..c0c58a6abc 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -211,11 +211,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) ! To work, the following fields must be set outside of the usual ! is to ie range before this subroutine is called: -! v[is-1,ie+1,ie+2], u[is-1,ie+1], vh[ie+1], uh[is-1], and -! h[is-1,ie+1,ie+2]. -! In the y-direction, the following fields must be set: -! v[js-1,je+1], u[js-1,je+1,je+2], vh[js-1], uh[je+1], and -! h[js-1,je+1,je+2]. +! v(is-1:ie+2,js-1:je+1), u(is-1:ie+1,js-1:je+2), h(is-1:ie+2,js-1:je+2), +! uh(is-1,ie,js:je+1) and vh(is:ie+1,js-1:je). if (.not.associated(CS)) call MOM_error(FATAL, & "MOM_CoriolisAdv: Module must be initialized before it is used.") diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 583d3c0729..5bfac86db9 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -56,10 +56,9 @@ module MOM_PressureForce_Mont !! non-Boussinesq fluid using the compressibility compensated (if appropriate) !! Montgomery-potential form described in Hallberg (Ocean Mod., 2005). !! -!! To work, the following fields must be set outside of the usual -!! ie to ie, je to je range before this subroutine is called: -!! h[ie+1] and h[je+1] and and (if tv%form_of_EOS is set) T[ie+1], S[ie+1], -!! T[je+1], and S[je+1]. +!! To work, the following fields must be set outside of the usual (is:ie,js:je) +!! range before this subroutine is called: +!! h(isB:ie+1,jsB:je+1), T(isB:ie+1,jsB:je+1), and S(isB:ie+1,jsB:je+1). subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, eta) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. @@ -355,10 +354,9 @@ end subroutine PressureForce_Mont_nonBouss !! !! Determines the acceleration due to pressure forces. !! -!! To work, the following fields must be set outside of the usual -!! ie to ie, je to je range before this subroutine is called: -!! h[ie+1] and h[je+1] and (if tv%form_of_EOS is set) T[ie+1], S[ie+1], -!! T[je+1], and S[je+1]. +!! To work, the following fields must be set outside of the usual (is:ie,js:je) +!! range before this subroutine is called: +!! h(isB:ie+1,jsB:je+1), T(isB:ie+1,jsB:je+1), and S(isB:ie+1,jsB:je+1). subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, eta) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 41b5ebe037..46a30f40ad 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -95,10 +95,9 @@ end subroutine PressureForce_AFV !! the analytic finite volume form of the Pressure gradient, and does not !! make the Boussinesq approximation. !! -!! To work, the following fields must be set outside of the usual -!! ie to ie, je to je range before this subroutine is called: -!! h[ie+1] and h[je+1] and (if tv%eqn_of_state is set) T[ie+1], S[ie+1], -!! T[je+1], and S[je+1]. +!! To work, the following fields must be set outside of the usual (is:ie,js:je) +!! range before this subroutine is called: +!! h(isB:ie+1,jsB:je+1), T(isB:ie+1,jsB:je+1), and S(isB:ie+1,jsB:je+1). subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, eta) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -437,10 +436,9 @@ end subroutine PressureForce_AFV_nonBouss !! Determines the acceleration due to hydrostatic pressure forces, using !! the finite volume form of the terms and analytic integrals in depth. !! -!! To work, the following fields must be set outside of the usual -!! ie to ie, je to je range before this subroutine is called: -!! h[ie+1] and h[je+1] and (if tv%eqn_of_state is set) T[ie+1], S[ie+1], -!! T[je+1], and S[je+1]. +!! To work, the following fields must be set outside of the usual (is:ie,js:je) +!! range before this subroutine is called: +!! h(isB:ie+1,jsB:je+1), T(isB:ie+1,jsB:je+1), and S(isB:ie+1,jsB:je+1). subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, eta) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index cbbb481037..5163eab828 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -95,10 +95,9 @@ end subroutine PressureForce_blk_AFV !! analytic finite volume form of the Pressure gradient, and does not make the !! Boussinesq approximation. This version uses code-blocking for threads. !! -!! To work, the following fields must be set outside of the usual -!! ie to ie, je to je range before this subroutine is called: -!! h[ie+1] and h[je+1] and (if tv%eqn_of_state is set) T[ie+1], S[ie+1], -!! T[je+1], and S[je+1]. +!! To work, the following fields must be set outside of the usual (is:ie,js:je) +!! range before this subroutine is called: +!! h(isB:ie+1,jsB:je+1), T(isB:ie+1,jsB:je+1), and S(isB:ie+1,jsB:je+1). subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, eta) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -420,10 +419,9 @@ end subroutine PressureForce_blk_AFV_nonBouss !! the finite volume form of the terms and analytic integrals in depth, making !! the Boussinesq approximation. This version uses code-blocking for threads. !! -!! To work, the following fields must be set outside of the usual -!! ie to ie, je to je range before this subroutine is called: -!! h[ie+1] and h[je+1] and (if tv%eqn_of_state is set) T[ie+1], S[ie+1], -!! T[je+1], and S[je+1]. +!! To work, the following fields must be set outside of the usual (is:ie,js:je) +!! range before this subroutine is called: +!! h(isB:ie+1,jsB:je+1), T(isB:ie+1,jsB:je+1), and S(isB:ie+1,jsB:je+1). subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, eta) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 7269f5b1c5..a19bdee61f 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -254,8 +254,8 @@ module MOM_variables real, pointer, dimension(:,:,:) :: TKE_turb => NULL() !< The turbulent kinetic energy per unit mass at the interfaces, in m2 s-2. !! This may be at the tracer or corner points - logical :: add_Kv_slow !< If True, add Kv_slow when calculating the 'coupling coefficient' (a[k]) - !! at the interfaces. This is done in find_coupling_coef. + logical :: add_Kv_slow !< If True, add Kv_slow when calculating the 'coupling coefficient' (a_cpl) + !! at the interfaces in find_coupling_coef. end type vertvisc_type !> Container for information about the summed layer transports diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index f88c463627..3bdae057eb 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -716,7 +716,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) endif ; endif ! The following block calculates the thicknesses at velocity -! grid points for the vertical viscosity (hvel[k]). Near the +! grid points for the vertical viscosity (hvel). Near the ! bottom an upwind biased thickness is used to control the effect ! of spurious Montgomery potential gradients at the bottom where ! nearly massless layers layers ride over the topography. @@ -883,7 +883,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) endif ; endif ! The following block calculates the thicknesses at velocity -! grid points for the vertical viscosity (hvel[k]). Near the +! grid points for the vertical viscosity (hvel). Near the ! bottom an upwind biased thickness is used to control the effect ! of spurious Montgomery potential gradients at the bottom where ! nearly massless layers layers ride over the topography. @@ -1037,9 +1037,9 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) end subroutine vertvisc_coef -!> Calculate the 'coupling coefficient' (a[k]) at the -!! interfaces. If BOTTOMDRAGLAW is defined, the minimum of Hbbl and half the -!! adjacent layer thicknesses are used to calculate a[k] near the bottom. +!> Calculate the 'coupling coefficient' (a_cpl) at the interfaces. +!! If BOTTOMDRAGLAW is defined, the minimum of Hbbl and half the adjacent +!! layer thicknesses are used to calculate a_cpl near the bottom. subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & dt, j, G, GV, US, CS, visc, forces, work_on_u, OBC, shelf) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure From c2d6ff1994123603a21283a030e2c9b2d5103b31 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 17 Dec 2018 17:59:16 -0500 Subject: [PATCH 0959/1072] Further reduced use of square brackets in comments Repplaced square brackets with parentheses in comments using C-style square brackets to express the relationships between array arguments in several tracer column physics routines. The use of square brackets may be in conflict with the use of square brackets for links in markup language comments, like dOxyGen. Also eliminated two trailing blanks. Only comments are changed and all answers are bitwise identical. --- src/core/MOM_CoriolisAdv.F90 | 2 +- src/tracer/DOME_tracer.F90 | 2 +- src/tracer/ISOMIP_tracer.F90 | 2 +- src/tracer/MOM_OCMIP2_CFC.F90 | 2 +- src/tracer/MOM_generic_tracer.F90 | 2 +- src/tracer/advection_test_tracer.F90 | 2 +- src/tracer/boundary_impulse_tracer.F90 | 2 +- src/tracer/dye_example.F90 | 2 +- src/tracer/dyed_obc_tracer.F90 | 2 +- src/tracer/ideal_age_example.F90 | 2 +- src/tracer/oil_tracer.F90 | 2 +- src/tracer/pseudo_salt_tracer.F90 | 2 +- src/tracer/tracer_example.F90 | 2 +- src/user/Phillips_initialization.F90 | 2 +- 14 files changed, 14 insertions(+), 14 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index c0c58a6abc..72f6a61a3a 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -212,7 +212,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) ! To work, the following fields must be set outside of the usual ! is to ie range before this subroutine is called: ! v(is-1:ie+2,js-1:je+1), u(is-1:ie+1,js-1:je+2), h(is-1:ie+2,js-1:je+2), -! uh(is-1,ie,js:je+1) and vh(is:ie+1,js-1:je). +! uh(is-1,ie,js:je+1) and vh(is:ie+1,js-1:je). if (.not.associated(CS)) call MOM_error(FATAL, & "MOM_CoriolisAdv: Module must be initialized before it is used.") diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 127f293c98..40b2680471 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -284,7 +284,7 @@ end subroutine initialize_DOME_tracer !! This is a simple example of a set of advected passive tracers. !! !! The arguments to this subroutine are redundant in that -!! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] +!! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) subroutine DOME_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 0707b54fb3..e4449aec8f 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -277,7 +277,7 @@ subroutine ISOMIP_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, G !! fluxes can be applied, in m ! The arguments to this subroutine are redundant in that -! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] +! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) ! Local variables real :: mmax diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index 304828313c..3ef9f3dbe2 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -437,7 +437,7 @@ subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS ! flux as a source. ! The arguments to this subroutine are redundant in that -! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] +! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) ! Local variables real :: b1(SZI_(G)) ! b1 and c1 are variables used by the diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 782ac3a533..997bfce9a4 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -461,7 +461,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which fluxes !! can be applied Stored previously in diabatic CS. ! The arguments to this subroutine are redundant in that - ! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] + ! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) ! Local variables character(len=fm_string_len), parameter :: sub_name = 'MOM_generic_tracer_column_physics' diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index dbf57a5cc9..74727bf7bd 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -290,7 +290,7 @@ subroutine advection_test_tracer_column_physics(h_old, h_new, ea, eb, fluxes, ! This is a simple example of a set of advected passive tracers. ! The arguments to this subroutine are redundant in that -! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] +! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified real :: b1(SZI_(G)) ! b1 and c1 are variables used by the diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 9624602a78..1facf4a9f5 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -240,7 +240,7 @@ subroutine boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, ! This is a simple example of a set of advected passive tracers. ! The arguments to this subroutine are redundant in that -! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] +! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) ! Local variables real :: Isecs_per_year = 1.0 / (365.0*86400.0) diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 084d0f54ac..832cb55bda 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -245,7 +245,7 @@ end subroutine initialize_dye_tracer !! tracer physics or chemistry to the tracers from this file. !! This is a simple example of a set of advected passive tracers. !! The arguments to this subroutine are redundant in that -!! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] +!! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index b32b88b8f2..3ca18d3e95 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -201,7 +201,7 @@ end subroutine initialize_dyed_obc_tracer !! This is a simple example of a set of advected passive tracers. !! !! The arguments to this subroutine are redundant in that -!! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] +!! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) subroutine dyed_obc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index 75ce468ef8..46e5ed4b75 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -313,7 +313,7 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, ! This is a simple example of a set of advected passive tracers. ! The arguments to this subroutine are redundant in that -! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] +! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified real :: sfc_val ! The surface value for the tracers. diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 91e3db41fb..7126f27b0e 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -329,7 +329,7 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS ! This is a simple example of a set of advected passive tracers. ! The arguments to this subroutine are redundant in that -! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] +! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index b2f11604d1..336ab77bb7 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -205,7 +205,7 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G ! tracer physics or chemistry to the tracers from this file. ! The arguments to this subroutine are redundant in that -! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] +! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) ! Local variables real :: year, h_total, scale, htot, Ih_limit diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 9db0ed049c..6345493d48 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -261,7 +261,7 @@ end subroutine USER_initialize_tracer !! tracer physics or chemistry to the tracers from this file. !! This is a simple example of a set of advected passive tracers. !! The arguments to this subroutine are redundant in that -!! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] +!! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) subroutine tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 59115ee57a..33cfb5a175 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -98,7 +98,7 @@ subroutine Phillips_initialize_thickness(h, G, GV, US, param_file, just_read_par ! This sets the initial thickness (in H ~> m or kg m-2) of the layers. The ! thicknesses are set to insure that: 1. each layer is at least an Angstrom thick, and ! 2. the interfaces are where they should be based on the resting depths and interface - ! height perturbations, as long at this doesn't interfere with 1. + ! height perturbations, as long at this doesn't interfere with 1. eta1D(nz+1) = -G%bathyT(i,j) do k=nz,1,-1 eta1D(K) = eta_im(j,K) From 4bdd6a43d9339dfff22c7da24f4fde9789439528 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 17 Dec 2018 21:20:30 -0700 Subject: [PATCH 0960/1072] fixed problem for netsw from mediator --- config_src/nuopc_driver/mom_cap.F90 | 4 --- config_src/nuopc_driver/mom_cap_methods.F90 | 32 +++------------------ 2 files changed, 4 insertions(+), 32 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index ab05add936..b04f493e05 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1026,10 +1026,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) endif call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" , "will provide") ! incorrect - remove - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" , "will provide") ! incorrect - remove - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" , "will provide") ! incorrect - remove - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" , "will provide") ! incorrect - remove call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide") ! -> mean_net_sw_ir_dif_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide") ! -> mean_net_sw_vis_dir_flx call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide") ! -> mean_net_sw_ir_dir_flx diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index edb600b535..d92406d6f2 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -319,51 +319,27 @@ subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, line=__LINE__, & file=__FILE__)) & return ! bail out - - ! TODO: remove these - call State_getFldPtr(importState,"Faxa_swndr" , dataPtr_swndr, rc=rc) + call State_getFldPtr(importState,"mean_net_sw_ir_dir_flx" , dataPtr_swndr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Faxa_swndf" , dataPtr_swndf, rc=rc) + call State_getFldPtr(importState,"mean_net_sw_ir_dif_flx" , dataPtr_swndf, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Faxa_swvdr" , dataPtr_swvdr, rc=rc) + call State_getFldPtr(importState,"mean_net_sw_vis_dir_flx" , dataPtr_swvdr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_getFldPtr(importState,"Faxa_swvdf" , dataPtr_swvdf, rc=rc) + call State_getFldPtr(importState,"mean_net_sw_vis_dif_flx" , dataPtr_swvdf, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - ! TODO: add these - ! call State_getFldPtr(importState,"mean_net_sw_ir_dir_flx" , dataPtr_swndr, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! call State_getFldPtr(importState,"mean_net_sw_ir_dif_flx" , dataPtr_swndf, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! call State_getFldPtr(importState,"mean_net_sw_vis_dir_flx" , dataPtr_swvdr, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! call State_getFldPtr(importState,"mean_net_sw_vis_dif_flx" , dataPtr_swvdf, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - call State_getFldPtr(importState,"Foxx_taux" , dataPtr_taux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & From 10fb249bc397264b3a27d3a17152a1102075d4c8 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 18 Dec 2018 06:36:18 -0700 Subject: [PATCH 0961/1072] Rotate fields from different coordinates This commit rotates vector fields imported from the coupler, namely the stresses, from true lat/lon to the local coordinates (regular transformation). It also rotates vector fields exported the coupler, surface currents and SSH gradients, from local coordinates to the to true lat/lon coordinates (inverse transformation). --- config_src/mct_driver/ocn_cap_methods.F90 | 39 +++++++++++++++-------- 1 file changed, 26 insertions(+), 13 deletions(-) diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 063cc13e96..ee965366be 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -47,11 +47,14 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, do i = isc, iec k = k + 1 ! Increment position within gindex + ! rotate taux and tauy from true zonal/meridional to local coordinates ! taux - ice_ocean_boundary%u_flux(i,j) = x2o(ind%x2o_Foxx_taux,k) + ice_ocean_boundary%u_flux(i,j) = GRID%cos_rot(i,j) * x2o(ind%x2o_Foxx_taux,k) & + + GRID%sin_rot(i,j) * x2o(ind%x2o_Foxx_tauy,k) ! tauy - ice_ocean_boundary%v_flux(i,j) = x2o(ind%x2o_Foxx_tauy,k) + ice_ocean_boundary%v_flux(i,j) = GRID%cos_rot(i,j) * x2o(ind%x2o_Foxx_tauy,k) & + - GRID%sin_rot(i,j) * x2o(ind%x2o_Foxx_taux,k) ! liquid precipitation (rain) ice_ocean_boundary%lprec(i,j) = x2o(ind%x2o_Faxa_rain,k) @@ -158,6 +161,8 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) ! Local variables real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo + real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: sshx!< Zonal SSH gradient, local coordinate. + real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: sshy!< Meridional SSH gradient, local coordinate. integer :: i, j, n, ig, jg !< Grid indices real :: slp_L, slp_R, slp_C, slope, u_min, u_max real :: I_time_int !< The inverse of coupling time interval in s-1. @@ -180,8 +185,13 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) ! surface temperature in Kelvin o2x(ind%o2x_So_t, n) = ocn_public%t_surf(ig,jg) * grid%mask2dT(i,j) o2x(ind%o2x_So_s, n) = ocn_public%s_surf(ig,jg) * grid%mask2dT(i,j) - o2x(ind%o2x_So_u, n) = ocn_public%u_surf(ig,jg) * grid%mask2dT(i,j) - o2x(ind%o2x_So_v, n) = ocn_public%v_surf(ig,jg) * grid%mask2dT(i,j) + ! rotate ocn current from local tripolar grid to true zonal/meridional (inverse transformation) + o2x(ind%o2x_So_u, n) = (grid%cos_rot(i,j) * ocn_public%u_surf(ig,jg) - & + grid%sin_rot(i,j) * ocn_public%v_surf(ig,jg)) * grid%mask2dT(i,j) + o2x(ind%o2x_So_v, n) = (grid%cos_rot(i,j) * ocn_public%v_surf(ig,jg) + & + grid%sin_rot(i,j) * ocn_public%u_surf(ig,jg)) * grid%mask2dT(i,j) + + ! boundary layer depth (m) o2x(ind%o2x_So_bldepth, n) = ocn_public%OBLD(ig,jg) * grid%mask2dT(i,j) ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 if (ocn_public%frazil(ig,jg) > 0.0) then @@ -203,9 +213,7 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) call pass_var(ssh, grid%domain) ! d/dx ssh - n = 0 do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec - n = n+1 ! This is a simple second-order difference ! o2x(ind%o2x_So_dhdx, n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) ! This is a PLM slope which might be less prone to the A-grid null mode @@ -225,14 +233,12 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) ! larger extreme values. slope = 0.0 endif - o2x(ind%o2x_So_dhdx, n) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdx, n) = 0.0 + sshx(i,j) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) sshx(i,j) = 0.0 enddo; enddo ! d/dy ssh - n = 0 do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec - n = n+1 ! This is a simple second-order difference ! o2x(ind%o2x_So_dhdy, n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) ! This is a PLM slope which might be less prone to the A-grid null mode @@ -243,7 +249,6 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) if (grid%mask2dCv(i,J+1)==0.) slp_R = 0. slp_C = 0.5 * (slp_L + slp_R) - !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R if ((slp_L * slp_R) > 0.0) then ! This limits the slope so that the edge values are bounded by the ! two cell averages spanning the edge. @@ -255,8 +260,16 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) ! larger extreme values. slope = 0.0 endif - o2x(ind%o2x_So_dhdy, n) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) o2x(ind%o2x_So_dhdy, n) = 0.0 + sshy(i,j) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) + if (grid%mask2dT(i,j)==0.) sshy(i,j) = 0.0 + enddo; enddo + + ! rotate ssh gradients from local coordinates to true zonal/meridional (inverse transformation) + n = 0 + do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec + n = n+1 + o2x(ind%o2x_So_dhdx, n) = grid%cos_rot(i,j) * sshx(i,j) - grid%sin_rot(i,j) * sshy(i,j) + o2x(ind%o2x_So_dhdy, n) = grid%cos_rot(i,j) * sshy(i,j) + grid%sin_rot(i,j) * sshx(i,j) enddo; enddo end subroutine ocn_export From 0e2066ddb61c0fbf88d099102838afe0612b2114 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 19 Dec 2018 03:42:56 -0500 Subject: [PATCH 0962/1072] Use square-bracket syntax in unit documentation Changed comments indicating the units of variables in some of the user directory modules to use square brackets, following the newly proposed MOM6 syntax convetion. This has been verified to give correct output via dOxygen. Only comments have been changed and all answers are bitwise identical. --- src/user/Idealized_Hurricane.F90 | 22 ++++++++--------- src/user/MOM_wave_interface.F90 | 8 +++--- src/user/Phillips_initialization.F90 | 27 ++++++++++++--------- src/user/Rossby_front_2d_initialization.F90 | 18 +++++++------- src/user/SCM_CVMix_tests.F90 | 11 ++++----- src/user/baroclinic_zone_initialization.F90 | 6 ++--- src/user/dense_water_initialization.F90 | 10 ++++---- src/user/soliton_initialization.F90 | 6 ++--- src/user/user_initialization.F90 | 2 +- 9 files changed, 56 insertions(+), 54 deletions(-) diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90 index 36aef6df6c..6efa0caf4b 100644 --- a/src/user/Idealized_Hurricane.F90 +++ b/src/user/Idealized_Hurricane.F90 @@ -45,15 +45,15 @@ module Idealized_hurricane type, public :: idealized_hurricane_CS ; private ! Parameters used to compute Holland radial wind profile - real :: rho_a !< Mean air density [kg/m3] + real :: rho_a !< Mean air density [kg m-3] real :: pressure_ambient !< Pressure at surface of ambient air [Pa] real :: pressure_central !< Pressure at surface at hurricane center [Pa] real :: rad_max_wind !< Radius of maximum winds [m] - real :: max_windspeed !< Maximum wind speeds [m/s] - real :: hurr_translation_spd !< Hurricane translation speed [m/s] - real :: hurr_translation_dir !< Hurricane translation speed [m/s] - real :: gustiness !< Gustiness (optional, used in u*) [m/s] - real :: Rho0 !< A reference ocean density [kg/m3] + real :: max_windspeed !< Maximum wind speeds [m s-1] + real :: hurr_translation_spd !< Hurricane translation speed [m s-1] + real :: hurr_translation_dir !< Hurricane translation speed [m s-1] + real :: gustiness !< Gustiness (optional, used in u*) [m s-1] + real :: Rho0 !< A reference ocean density [kg m-3] real :: Hurr_cen_Y0 !< The initial y position of the hurricane !! This experiment is conducted in a Cartesian !! grid and this is assumed to be in meters [m] @@ -69,7 +69,7 @@ module Idealized_hurricane ! Parameters used if in SCM (single column model) mode - logical :: SCM_mode !< Single Column Model Mode [nd] + logical :: SCM_mode !< If true this being used in Single Column Model mode logical :: BR_BENCH !< A "benchmark" configuration (which is meant to !! provide identical wind to reproduce a previous !! experiment, where that wind formula contained @@ -198,10 +198,10 @@ end subroutine idealized_hurricane_wind_init !> Computes the surface wind for the idealized hurricane test cases subroutine idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) - type(surface), intent(in) :: state !< Surface state structure - type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - type(time_type), intent(in) :: day !< Time in days - type(ocean_grid_type), intent(inout) :: G !< Grid structure + type(surface), intent(in) :: state !< Surface state structure + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + type(time_type), intent(in) :: day !< Time in days + type(ocean_grid_type), intent(inout) :: G !< Grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(idealized_hurricane_CS), pointer :: CS !< Container for idealized hurricane parameters diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index ccbed29b29..abf0e822df 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -1189,7 +1189,7 @@ subroutine StokesMixing(G, GV, DT, h, u, v, Waves ) intent(in) :: GV !< Ocean vertical grid real, intent(in) :: Dt !< Time step of MOM6 [s] for explicit solver real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& - intent(in) :: h !< Layer/level thicknesses (H ~> m or kg m-2) + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(inout) :: u !< Velocity i-component (m/s) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -1257,11 +1257,11 @@ subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES) intent(in) :: GV !< Ocean vertical grid real, intent(in) :: Dt !< Time step of MOM6 [s] CHECK IF PASSING RIGHT TIMESTEP real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer/level thicknesses (H ~> m or kg m-2) + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: u !< Velocity i-component (m/s) + intent(inout) :: u !< Velocity i-component [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: v !< Velocity j-component (m/s) + intent(inout) :: v !< Velocity j-component [m s-1] type(Wave_parameters_CS), & pointer :: Waves !< Surface wave related control structure. ! Local variables diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 33cfb5a175..d7a0a287d8 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -39,18 +39,20 @@ subroutine Phillips_initialize_thickness(h, G, GV, US, param_file, just_read_par type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. + intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces, in Z ~> m. - real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta, in Z ~> m. - real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface - ! positive upward, in Z ~> m. - real :: damp_rate, jet_width, jet_height, y_2 - real :: half_strat, half_depth + real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces [Z ~> m] + real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta [Z ~> m] + real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface, positive upward [Z ~> m] + real :: jet_width ! The width of the zonal-mean jet [km] + real :: jet_height ! The interface height scale associated with the zonal-mean jet [Z ~> m] + real :: y_2 + real :: half_strat ! The fractional depth where the stratification is centered [nondim] + real :: half_depth ! The depth where the stratification is centered [Z ~> m] logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "Phillips_initialize_thickness" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz @@ -64,8 +66,9 @@ subroutine Phillips_initialize_thickness(h, G, GV, US, param_file, just_read_par if (.not.just_read) call log_version(param_file, mdl, version) call get_param(param_file, mdl, "HALF_STRAT_DEPTH", half_strat, & - "The maximum depth of the ocean.", units="nondim", & - default = 0.5, do_not_log=just_read) +!### UNCOMMENT TO FIX THIS "The fractional depth where the stratification is centered.", & + "The maximum depth of the ocean.", & + units="nondim", default = 0.5, do_not_log=just_read) call get_param(param_file, mdl, "JET_WIDTH", jet_width, & "The width of the zonal-mean jet.", units="km", & fail_if_missing=.not.just_read, do_not_log=just_read) @@ -119,15 +122,15 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_p type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< i-component of velocity [m/s] + intent(out) :: u !< i-component of velocity [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< j-component of velocity [m/s] + intent(out) :: v !< j-component of velocity [m s-1] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: damp_rate, jet_width, jet_height, x_2, y_2 + real :: jet_width, jet_height, x_2, y_2 real :: velocity_amplitude, pi integer :: i, j, k, is, ie, js, je, nz, m logical :: just_read ! If true, just read parameters but set nothing. diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index 7ca852c29a..974604412e 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -28,9 +28,9 @@ module Rossby_front_2d_initialization public Rossby_front_initialize_velocity ! Parameters defining the initial conditions of this test case -real, parameter :: frontFractionalWidth = 0.5 !< Width of front as fraction of domain -real, parameter :: HMLmin = 0.25 !< Shallowest ML as fractional depth of ocean -real, parameter :: HMLmax = 0.75 !< Deepest ML as fractional depth of ocean +real, parameter :: frontFractionalWidth = 0.5 !< Width of front as fraction of domain [nondim] +real, parameter :: HMLmin = 0.25 !< Shallowest ML as fractional depth of ocean [nondim] +real, parameter :: HMLmax = 0.75 !< Deepest ML as fractional depth of ocean [nondim] contains @@ -39,7 +39,7 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, param_file, just_read_par type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. + intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -110,9 +110,9 @@ subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, & param_file, eqn_of_state, just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature [deg C] + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature [degC] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity [ppt] - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Thickness in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file handle type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -163,11 +163,11 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, param_file, just_rea type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< i-component of velocity [m/s] + intent(out) :: u !< i-component of velocity [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< j-component of velocity [m/s] + intent(out) :: v !< j-component of velocity [m s-1] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & - intent(in) :: h !< Thickness [H] + intent(in) :: h !< Thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index d829e2755c..ba8d90eeb1 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -30,10 +30,9 @@ module SCM_CVMix_tests ! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." !> Container for surface forcing parameters -type SCM_CVMix_tests_CS -private +type SCM_CVMix_tests_CS ; private logical :: UseWindStress !< True to use wind stress - logical :: UseHeatFlux !< True to use heat flux + logical :: UseHeatFlux !< True to use heat flux logical :: UseEvaporation !< True to use evaporation logical :: UseDiurnalSW !< True to use diurnal sw radiation real :: tau_x !< (Constant) Wind stress, X (Pa) @@ -112,8 +111,8 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read_par top = 0. ! Reference to surface bottom = 0. do k=1,nz - bottom = bottom - h(i,j,k)*GV%H_to_Z ! Interface below layer (in m) - zC = 0.5*( top + bottom ) ! Z of middle of layer (in m) + bottom = bottom - h(i,j,k)*GV%H_to_Z ! Interface below layer [Z ~> m] + zC = 0.5*( top + bottom ) ! Z of middle of layer [Z ~> m] DZ = min(0., zC + UpperLayerTempMLD) T(i,j,k) = max(LowerLayerMinTemp,LowerLayerTemp + LowerLayerdTdZ * DZ) DZ = min(0., zC + UpperLayerSaltMLD) @@ -255,7 +254,7 @@ subroutine SCM_CVMix_tests_buoyancy_forcing(state, fluxes, day, G, CS) if (CS%UseEvaporation) then do J=Jsq,Jeq ; do i=is,ie - ! Note CVMix test inputs give evaporation in m/s + ! Note CVMix test inputs give evaporation in [m s-1] ! This therefore must be converted to mass flux ! by multiplying by density fluxes%evap(i,J) = CS%surf_evap * CS%Rho0 diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index 5af68af8b9..2fb27e36c0 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -79,9 +79,9 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, US, param_f type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature [deg C] + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature [degC] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity [ppt] - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< The model thicknesses in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< The model thicknesses [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file handle logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing T & S. @@ -90,7 +90,7 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, US, param_f real :: T_ref, dTdz, dTdx, delta_T ! Parameters describing temperature distribution real :: S_ref, dSdz, dSdx, delta_S ! Parameters describing salinity distribution real :: L_zone ! Width of baroclinic zone - real :: zc, zi ! Depths in depth units (Z ~> m). + real :: zc, zi ! Depths in depth units [Z ~> m] real :: x, xd, xs, y, yd, fn real :: PI ! 3.1415926... calculated as 4*atan(1) logical :: just_read ! If true, just read parameters but set nothing. diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index f857978c8e..2233adb1a3 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -25,8 +25,8 @@ module dense_water_initialization character(len=40) :: mdl = "dense_water_initialization" !< Module name -real, parameter :: default_sill = 0.2 !< Default depth of the sill [nondim] -real, parameter :: default_shelf = 0.4 !< Default depth of the shelf [nondim] +real, parameter :: default_sill = 0.2 !< Default depth of the sill [nondim] +real, parameter :: default_shelf = 0.4 !< Default depth of the shelf [nondim] real, parameter :: default_mld = 0.25 !< Default depth of the mixed layer [nondim] contains @@ -100,9 +100,9 @@ subroutine dense_water_initialize_TS(G, GV, param_file, eqn_of_state, T, S, h, j type(verticalGrid_type), intent(in) :: GV !< Vertical grid control structure type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: eqn_of_state !< EOS structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Output temperature (degC) - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Output salinity (ppt) - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Output temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Output salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index b9b34a0e13..e4e2d6995c 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -65,9 +65,9 @@ end subroutine soliton_initialize_thickness !> Initialization of u and v in the equatorial Rossby soliton test subroutine soliton_initialize_velocity(u, v, h, G) type(ocean_grid_type), intent(in) :: G !< Grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: u !< i-component of velocity [m/s] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: v !< j-component of velocity [m/s] - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Thickness [H] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: u !< i-component of velocity [m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: v !< j-component of velocity [m s-1] + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Thickness [H ~> m or kg m-2] real :: x, y, x0, y0 real :: val1, val2, val3, val4 diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 47976a4c96..bf2f1401e9 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -107,7 +107,7 @@ end subroutine USER_initialize_thickness !> initialize velocities. subroutine USER_initialize_velocity(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. - real, dimension(SZIB_(G), SZJ_(G), SZK_(G)), intent(out) :: u !< i-component of velocity [m/s] + real, dimension(SZIB_(G), SZJ_(G), SZK_(G)), intent(out) :: u !< i-component of velocity [m s-1] real, dimension(SZI_(G), SZJB_(G), SZK_(G)), intent(out) :: v !< j-component of velocity [m/s] type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model From 7dab975372a5233580e19d86aa202efa0f7972dd Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 19 Dec 2018 04:11:44 -0500 Subject: [PATCH 0963/1072] Updated comments explaining the '~>' notation Updated comments explaining the unit scaling for dimensional consistency testing and the use of square brackets with the '~>' notation. Only comments are changed, and all answers are bitwise identical. --- config_src/coupled_driver/MOM_surface_forcing.F90 | 3 ++- config_src/ice_solo_driver/user_surface_forcing.F90 | 3 ++- src/ALE/MOM_ALE.F90 | 3 ++- src/ALE/MOM_regridding.F90 | 3 ++- src/core/MOM.F90 | 3 ++- src/core/MOM_PressureForce_Montgomery.F90 | 3 ++- src/core/MOM_PressureForce_analytic_FV.F90 | 3 ++- src/core/MOM_PressureForce_blocked_AFV.F90 | 3 ++- src/core/MOM_barotropic.F90 | 3 ++- src/core/MOM_forcing_type.F90 | 3 ++- src/core/MOM_grid.F90 | 3 ++- src/core/MOM_isopycnal_slopes.F90 | 3 ++- src/core/MOM_variables.F90 | 3 ++- src/core/MOM_verticalGrid.F90 | 3 ++- src/diagnostics/MOM_diag_to_Z.F90 | 3 ++- src/diagnostics/MOM_diagnostics.F90 | 3 ++- src/diagnostics/MOM_sum_output.F90 | 3 ++- src/diagnostics/MOM_wave_speed.F90 | 3 ++- src/diagnostics/MOM_wave_structure.F90 | 3 ++- src/equation_of_state/MOM_EOS.F90 | 3 ++- src/equation_of_state/MOM_EOS_Wright.F90 | 3 ++- src/equation_of_state/MOM_EOS_linear.F90 | 3 ++- src/framework/MOM_dyn_horgrid.F90 | 3 ++- src/ice_shelf/MOM_ice_shelf.F90 | 3 ++- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 3 ++- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 3 ++- src/ice_shelf/user_shelf_init.F90 | 3 ++- src/initialization/MOM_coord_initialization.F90 | 3 ++- src/initialization/MOM_grid_initialize.F90 | 3 ++- src/initialization/MOM_shared_initialization.F90 | 3 ++- src/initialization/MOM_state_initialization.F90 | 3 ++- src/initialization/MOM_tracer_initialization_from_Z.F90 | 3 ++- src/initialization/midas_vertmap.F90 | 3 ++- src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 | 3 ++- src/parameterizations/lateral/MOM_thickness_diffuse.F90 | 3 ++- src/parameterizations/vertical/MOM_ALE_sponge.F90 | 3 ++- src/parameterizations/vertical/MOM_CVMix_shear.F90 | 3 ++- src/parameterizations/vertical/MOM_bkgnd_mixing.F90 | 3 ++- src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 | 3 ++- src/parameterizations/vertical/MOM_diabatic_aux.F90 | 3 ++- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 3 ++- src/parameterizations/vertical/MOM_diapyc_energy_req.F90 | 3 ++- src/parameterizations/vertical/MOM_energetic_PBL.F90 | 3 ++- src/parameterizations/vertical/MOM_entrain_diffusive.F90 | 3 ++- src/parameterizations/vertical/MOM_internal_tide_input.F90 | 3 ++- src/parameterizations/vertical/MOM_kappa_shear.F90 | 3 ++- src/parameterizations/vertical/MOM_set_diffusivity.F90 | 3 ++- src/parameterizations/vertical/MOM_set_viscosity.F90 | 3 ++- src/parameterizations/vertical/MOM_sponge.F90 | 3 ++- src/parameterizations/vertical/MOM_tidal_mixing.F90 | 3 ++- src/parameterizations/vertical/MOM_vert_friction.F90 | 3 ++- src/tracer/DOME_tracer.F90 | 3 ++- src/tracer/MOM_tracer_Z_init.F90 | 3 ++- src/tracer/dye_example.F90 | 3 ++- src/user/BFB_initialization.F90 | 3 ++- src/user/DOME2d_initialization.F90 | 3 ++- src/user/DOME_initialization.F90 | 3 ++- src/user/ISOMIP_initialization.F90 | 3 ++- src/user/Kelvin_initialization.F90 | 3 ++- src/user/MOM_wave_interface.F90 | 3 ++- src/user/Neverland_initialization.F90 | 3 ++- src/user/Phillips_initialization.F90 | 3 ++- src/user/SCM_CVMix_tests.F90 | 3 ++- src/user/adjustment_initialization.F90 | 3 ++- src/user/baroclinic_zone_initialization.F90 | 3 ++- src/user/benchmark_initialization.F90 | 3 ++- src/user/circle_obcs_initialization.F90 | 3 ++- src/user/dumbbell_initialization.F90 | 3 ++- src/user/external_gwave_initialization.F90 | 3 ++- src/user/seamount_initialization.F90 | 3 ++- src/user/user_change_diffusivity.F90 | 3 ++- src/user/user_initialization.F90 | 3 ++- 72 files changed, 144 insertions(+), 72 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index b7f9418959..0545297003 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -53,7 +53,8 @@ module MOM_surface_forcing ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> surface_forcing_CS is a structure containing pointers to the forcing fields !! which may be used to drive MOM. All fluxes are positive downward. diff --git a/config_src/ice_solo_driver/user_surface_forcing.F90 b/config_src/ice_solo_driver/user_surface_forcing.F90 index a8e3669252..76545f085e 100644 --- a/config_src/ice_solo_driver/user_surface_forcing.F90 +++ b/config_src/ice_solo_driver/user_surface_forcing.F90 @@ -64,7 +64,8 @@ module user_surface_forcing ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. type, public :: user_surface_forcing_CS ; private ! This control structure should be used to store any run-time variables diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index e194c5ebdb..bb68f11397 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -122,7 +122,8 @@ module MOM_ALE ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. contains diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index e65f590a28..2074996fff 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -38,7 +38,8 @@ module MOM_regridding ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Regridding control structure type, public :: regridding_CS ; private diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index fb7f9fc252..f85c5b9ca1 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -138,7 +138,8 @@ module MOM ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> A structure with diagnostic IDs of the state variables type MOM_diag_IDs diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 5bfac86db9..f18f5b2b33 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -24,7 +24,8 @@ module MOM_PressureForce_Mont ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Control structure for the Montgomery potential form of pressure gradient type, public :: PressureForce_Mont_CS ; private diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 46a30f40ad..794d62418f 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -29,7 +29,8 @@ module MOM_PressureForce_AFV ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Finite volume pressure gradient control structure type, public :: PressureForce_AFV_CS ; private diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 5163eab828..da7ea5a08a 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -29,7 +29,8 @@ module MOM_PressureForce_blk_AFV ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Finite volume pressure gradient control structure type, public :: PressureForce_blk_AFV_CS ; private diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 8bd76196b6..9501f1ea4e 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -60,7 +60,8 @@ module MOM_barotropic ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> The barotropic stepping open boundary condition type type, private :: BT_OBC_type diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 1fd946f9b9..17feb0f5a2 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -37,7 +37,8 @@ module MOM_forcing_type ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Structure that contains pointers to the boundary forcing used to drive the !! liquid ocean simulated by MOM. diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index ac7bcd2180..37bd832f66 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -18,7 +18,8 @@ module MOM_grid ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Ocean grid type. See mom_grid for details. type, public :: ocean_grid_type diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 65cf848e36..0c52565512 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -17,7 +17,8 @@ module MOM_isopycnal_slopes ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. contains diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index a19bdee61f..591db8f634 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -21,7 +21,8 @@ module MOM_variables ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> A structure for creating arrays of pointers to 3D arrays type, public :: p3d diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index ab0f645a28..81dde3114b 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -17,7 +17,8 @@ module MOM_verticalGrid ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Describes the vertical ocean grid, including unit conversion factors type, public :: verticalGrid_type diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index 5b7488a6cb..5b0f238e58 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -40,7 +40,8 @@ module MOM_diag_to_Z ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> The control structure for the MOM_diag_to_Z module type, public :: diag_to_Z_CS ; private diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 66a5dd33e3..f40aad50e5 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -44,7 +44,8 @@ module MOM_diagnostics ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> The control structure for the MOM_diagnostics module type, public :: diagnostics_CS ; private diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index be956ac5f3..5fc1ebfb31 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -35,7 +35,8 @@ module MOM_sum_output ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. integer, parameter :: NUM_FIELDS = 17 !< Number of diagnostic fields diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 3f36b37d3e..289da4c9bc 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -21,7 +21,8 @@ module MOM_wave_speed ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Control structure for MOM_wave_speed type, public :: wave_speed_CS ; private diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index b5f2cbb129..576a6639c0 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -29,7 +29,8 @@ module MOM_wave_structure ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> The control structure for the MOM_wave_structure module type, public :: wave_structure_CS ; !private diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index a7b7d92ab6..30d1e1c8e0 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -53,7 +53,8 @@ module MOM_EOS ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Calculates density of sea water from T, S and P interface calculate_density diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index fc541986f3..96ce448de2 100644 --- a/src/equation_of_state/MOM_EOS_Wright.F90 +++ b/src/equation_of_state/MOM_EOS_Wright.F90 @@ -22,7 +22,8 @@ module MOM_EOS_Wright ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Compute the in situ density of sea water (in units of kg/m^3), or its anomaly with respect to diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90 index 83219d5adb..81851dc4ec 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -18,7 +18,8 @@ module MOM_EOS_linear ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Compute the density of sea water (in kg/m^3), or its anomaly from a reference density, !! using a simple linear equation of state from salinity (in psu), potential temperature (in deg C) diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 4fb0400b50..5eefa3d8e4 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -15,7 +15,8 @@ module MOM_dyn_horgrid ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Describes the horizontal ocean grid with only dynamic memory arrays type, public :: dyn_horgrid_type diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 55b062ae42..da4150cc97 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -64,7 +64,8 @@ module MOM_ice_shelf ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Control structure that contains ice shelf parameters and diagnostics handles type, public :: ice_shelf_CS ; private diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 9633f23ed9..fe2af30ba2 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -34,7 +34,8 @@ module MOM_ice_shelf_dynamics ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> The control structure for the ice shelf dynamics. type, public :: ice_shelf_dyn_CS ; private diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 22f86d5887..24ba9d838c 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -19,7 +19,8 @@ module MOM_ice_shelf_initialize ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. contains diff --git a/src/ice_shelf/user_shelf_init.F90 b/src/ice_shelf/user_shelf_init.F90 index 1afc7e2248..149713f2b3 100644 --- a/src/ice_shelf/user_shelf_init.F90 +++ b/src/ice_shelf/user_shelf_init.F90 @@ -22,7 +22,8 @@ module user_shelf_init ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> The control structure for the user_ice_shelf module type, public :: user_ice_shelf_CS ; private diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 5dfa608cd9..94d0b33545 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -27,7 +27,8 @@ module MOM_coord_initialization ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. character(len=40) :: mdl = "MOM_coord_initialization" !< This module's name. diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index b95c476b45..7972f6f6b4 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -26,7 +26,8 @@ module MOM_grid_initialize ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Global positioning system (aka container for information to describe the grid) type, public :: GPS ; private diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index f86cd780c1..7b74a124fe 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -32,7 +32,8 @@ module MOM_shared_initialization ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. contains diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 8b5f26292f..91f336485b 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -108,7 +108,8 @@ module MOM_state_initialization ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. character(len=40) :: mdl = "MOM_state_initialization" !< This module's name. diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index a51053ca30..7f8ee25c07 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -35,7 +35,8 @@ module MOM_tracer_initialization_from_Z ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. character(len=40) :: mdl = "MOM_tracer_initialization_from_Z" !< This module's name. diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index 83bec30cf5..17614addf6 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -15,7 +15,8 @@ module MIDAS_vertmap ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Fill grid edges interface fill_boundaries diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index b32593f003..a23acd72a0 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -31,7 +31,8 @@ module MOM_mixed_layer_restrat ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Control structure for mom_mixed_layer_restrat type, public :: mixedlayer_restrat_CS ; private diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index b445b50bde..3c8fac332d 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -27,7 +27,8 @@ module MOM_thickness_diffuse ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Control structure for thickness diffusion type, public :: thickness_diffuse_CS ; private diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 50e35da04e..4c0b2e2247 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -58,7 +58,8 @@ module MOM_ALE_sponge ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> A structure for creating arrays of pointers to 3D arrays with extra gridding information type :: p3d diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 88997d5f3f..a0a210168b 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -24,7 +24,8 @@ module MOM_CVMix_shear ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Control structure including parameters for CVMix interior shear schemes. type, public :: CVMix_shear_cs ! TODO: private diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index e9899c2251..cd124bf486 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -31,7 +31,8 @@ module MOM_bkgnd_mixing ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Control structure including parameters for this module. type, public :: bkgnd_mixing_cs ! TODO: private diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index ddd653028e..55d629a0b4 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -25,7 +25,8 @@ module MOM_bulk_mixed_layer ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> The control structure with parameters for the MOM_bulk_mixed_layer module type, public :: bulkmixedlayer_CS ; private diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 6fc42b2312..b9f7d9ce08 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -30,7 +30,8 @@ module MOM_diabatic_aux ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Control structure for diabatic_aux type, public :: diabatic_aux_CS ; private diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index a23857ba76..4929328214 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -87,7 +87,8 @@ module MOM_diabatic_driver ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Control structure for this module type, public:: diabatic_CS; private diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index fe07a0d162..dcaf931870 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -20,7 +20,8 @@ module MOM_diapyc_energy_req ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> This control structure holds parameters for the MOM_diapyc_energy_req module type, public :: diapyc_energy_req_CS ; private diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 90ae40e9d9..f712fdb93d 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -27,7 +27,8 @@ module MOM_energetic_PBL ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> This control structure holds parameters for the MOM_energetic_PBL module type, public :: energetic_PBL_CS ; private diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index e531520aa3..1bb76ebca4 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -22,7 +22,8 @@ module MOM_entrain_diffusive ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> The control structure holding parametes for the MOM_entrain_diffusive module type, public :: entrain_diffusive_CS ; private diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index e5faa2e7ee..802f0fa1ee 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -28,7 +28,8 @@ module MOM_int_tide_input ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> This control structure holds parameters that regulate internal tide energy inputs. type, public :: int_tide_input_CS ; private diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 32b4571155..7c217e0e63 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -28,7 +28,8 @@ module MOM_kappa_shear ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> This control structure holds the parameters that regulate shear mixing type, public :: Kappa_shear_CS ; private diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index f96d5c0fc8..360cdf2223 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -49,7 +49,8 @@ module MOM_set_diffusivity ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> This control structure contains parameters for MOM_set_diffusivity. type, public :: set_diffusivity_CS ; private diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index ff3055e7e7..6e04857817 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -36,7 +36,8 @@ module MOM_set_visc ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Control structure for MOM_set_visc type, public :: set_visc_CS ; private diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index 0dd1418c8e..a4c38c63a5 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -24,7 +24,8 @@ module MOM_sponge ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> A structure for creating arrays of pointers to 3D arrays type, public :: p3d diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 5e227e43f2..e3a5b43028 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -38,7 +38,8 @@ module MOM_tidal_mixing ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Containers for tidal mixing diagnostics type, public :: tidal_mixing_diags ; private diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 3bdae057eb..a19f5d2e75 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -32,7 +32,8 @@ module MOM_vert_friction ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> The control structure with parameters and memory for the MOM_vert_friction module type, public :: vertvisc_CS ; private diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 40b2680471..d56e22c173 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -34,7 +34,8 @@ module DOME_tracer ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. integer, parameter :: ntr = 11 !< The number of tracers in this module. diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index caac2a04fa..3eed664c3f 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -20,7 +20,8 @@ module MOM_tracer_Z_init ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. contains diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 832cb55bda..3734f0a2bd 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -35,7 +35,8 @@ module regional_dyes ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> The control structure for the regional dyes tracer package type, public :: dye_tracer_CS ; private diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 17d5ff8072..a29188cd16 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -22,7 +22,8 @@ module BFB_initialization ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Unsafe model variable !! \todo Remove this module variable diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 19faf3bddc..5dd4a73b1b 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -30,7 +30,8 @@ module DOME2d_initialization ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. character(len=40) :: mdl = "DOME2D_initialization" !< This module's name. diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 54ca54371e..7fd531ce28 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -30,7 +30,8 @@ module DOME_initialization ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. contains diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 157bdf8a93..34c313577a 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -35,7 +35,8 @@ module ISOMIP_initialization ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. contains diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index db798a66c6..b1c0587d2c 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -29,7 +29,8 @@ module Kelvin_initialization ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Control structure for Kelvin wave open boundaries. type, public :: Kelvin_OBC_CS ; private diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index abf0e822df..abcdfec6ab 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -40,7 +40,8 @@ module MOM_wave_interface ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Container for all surface wave related parameters type, public :: wave_parameters_CS ; private diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index c007539093..f20a08bc0f 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -26,7 +26,8 @@ module Neverland_initialization ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. contains diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index d7a0a287d8..6afa27f852 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -26,7 +26,8 @@ module Phillips_initialization ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. ! This include declares and sets the variable "version". #include "version_variable.h" diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index ba8d90eeb1..1ebdec2c80 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -27,7 +27,8 @@ module SCM_CVMix_tests ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Container for surface forcing parameters type SCM_CVMix_tests_CS ; private diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index e160f9e90e..8ed670b8a5 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -26,7 +26,8 @@ module adjustment_initialization ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. contains diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index 2fb27e36c0..10ddf57ff2 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -21,7 +21,8 @@ module baroclinic_zone_initialization ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. contains diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index c7d7b911b8..1c55e04ec0 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -25,7 +25,8 @@ module benchmark_initialization ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. contains diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index 382b960716..f83b9f696f 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -22,7 +22,8 @@ module circle_obcs_initialization ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. contains diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 7415bc783a..2d547ed9fb 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -33,7 +33,8 @@ module dumbbell_initialization ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. contains diff --git a/src/user/external_gwave_initialization.F90 b/src/user/external_gwave_initialization.F90 index e14796e6a8..286fa59237 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -19,7 +19,8 @@ module external_gwave_initialization ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. contains diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index ea0f9d6a64..29ed09e5d7 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -32,7 +32,8 @@ module seamount_initialization ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. contains diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index c8f6c26c53..fa90d27960 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -20,7 +20,8 @@ module user_change_diffusivity ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Control structure for user_change_diffusivity type, public :: user_change_diff_CS ; private diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index bf2f1401e9..2463205349 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -27,7 +27,8 @@ module user_initialization ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with -! their mks counterparts with notation like "a velocity, in Z T-1 ~> m s-1." +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> A module variable that should not be used. !! \todo Move this module variable into a control structure. From ad18eaff0fe7f8d964b075ac2ec3ca37caf08357 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 19 Dec 2018 08:34:58 -0500 Subject: [PATCH 0964/1072] Use square-brackets in height documentation Changed comments indicating the units of vertical velocities and heights to use square brackets, following the newly proposed MOM6 syntax convetion. Only comments have been changed and all answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 4 +- .../ice_solo_driver/user_surface_forcing.F90 | 2 +- src/ALE/MOM_ALE.F90 | 4 +- src/ALE/MOM_regridding.F90 | 2 +- src/core/MOM_PressureForce_Montgomery.F90 | 10 +- src/core/MOM_PressureForce_analytic_FV.F90 | 6 +- src/core/MOM_PressureForce_blocked_AFV.F90 | 4 +- src/core/MOM_barotropic.F90 | 22 +-- src/core/MOM_forcing_type.F90 | 10 +- src/core/MOM_isopycnal_slopes.F90 | 8 +- src/core/MOM_variables.F90 | 34 ++--- src/diagnostics/MOM_diag_to_Z.F90 | 17 ++- src/diagnostics/MOM_diagnostics.F90 | 4 +- src/diagnostics/MOM_sum_output.F90 | 34 ++--- src/diagnostics/MOM_wave_speed.F90 | 8 +- src/diagnostics/MOM_wave_structure.F90 | 2 +- src/equation_of_state/MOM_EOS.F90 | 38 ++--- src/equation_of_state/MOM_EOS_Wright.F90 | 10 +- src/equation_of_state/MOM_EOS_linear.F90 | 12 +- src/framework/MOM_dyn_horgrid.F90 | 10 +- src/ice_shelf/MOM_ice_shelf.F90 | 6 +- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 80 +++++------ src/ice_shelf/MOM_ice_shelf_initialize.F90 | 4 +- src/ice_shelf/user_shelf_init.F90 | 6 +- .../MOM_coord_initialization.F90 | 2 +- src/initialization/MOM_grid_initialize.F90 | 2 +- .../MOM_shared_initialization.F90 | 4 +- .../MOM_state_initialization.F90 | 18 +-- .../MOM_tracer_initialization_from_Z.F90 | 4 +- src/initialization/midas_vertmap.F90 | 8 +- .../lateral/MOM_mixed_layer_restrat.F90 | 14 +- .../lateral/MOM_thickness_diffuse.F90 | 36 ++--- .../vertical/MOM_ALE_sponge.F90 | 6 +- .../vertical/MOM_CVMix_shear.F90 | 4 +- .../vertical/MOM_bkgnd_mixing.F90 | 6 +- .../vertical/MOM_bulk_mixed_layer.F90 | 80 +++++------ .../vertical/MOM_diabatic_aux.F90 | 18 +-- .../vertical/MOM_diabatic_driver.F90 | 8 +- .../vertical/MOM_diapyc_energy_req.F90 | 30 ++-- .../vertical/MOM_energetic_PBL.F90 | 58 ++++---- .../vertical/MOM_entrain_diffusive.F90 | 8 +- .../vertical/MOM_internal_tide_input.F90 | 16 +-- .../vertical/MOM_kappa_shear.F90 | 124 ++++++++-------- .../vertical/MOM_set_diffusivity.F90 | 136 +++++++++--------- .../vertical/MOM_set_viscosity.F90 | 20 +-- src/parameterizations/vertical/MOM_sponge.F90 | 6 +- .../vertical/MOM_tidal_mixing.F90 | 64 ++++----- .../vertical/MOM_vert_friction.F90 | 34 ++--- src/tracer/DOME_tracer.F90 | 2 +- src/tracer/MOM_tracer_Z_init.F90 | 4 +- src/tracer/dye_example.F90 | 4 +- src/user/DOME2d_initialization.F90 | 6 +- src/user/DOME_initialization.F90 | 10 +- src/user/ISOMIP_initialization.F90 | 12 +- src/user/Kelvin_initialization.F90 | 2 +- src/user/MOM_wave_interface.F90 | 20 +-- src/user/Neverland_initialization.F90 | 4 +- src/user/Phillips_initialization.F90 | 8 +- src/user/SCM_CVMix_tests.F90 | 6 +- src/user/benchmark_initialization.F90 | 4 +- src/user/dumbbell_initialization.F90 | 8 +- src/user/external_gwave_initialization.F90 | 2 +- src/user/seamount_initialization.F90 | 8 +- src/user/user_change_diffusivity.F90 | 6 +- src/user/user_initialization.F90 | 2 +- 65 files changed, 574 insertions(+), 577 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 0545297003..ac62a9fddc 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -807,10 +807,10 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, real, dimension(SZI_(G),SZJB_(G)), & optional, intent(inout) :: tauy !< The meridional wind stresses on a C-grid, in Pa. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(inout) :: ustar !< The surface friction velocity, in Z s-1 ~> m s-1. + optional, intent(inout) :: ustar !< The surface friction velocity [Z s-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(out) :: gustless_ustar !< The surface friction velocity without - !! any contributions from gustiness, in Z s-1 ~> m s-1. + !! any contributions from gustiness [Z s-1 ~> m s-1]. integer, optional, intent(in) :: tau_halo !< The halo size of wind stresses to set, 0 by default. ! Local variables diff --git a/config_src/ice_solo_driver/user_surface_forcing.F90 b/config_src/ice_solo_driver/user_surface_forcing.F90 index 76545f085e..de3f475a25 100644 --- a/config_src/ice_solo_driver/user_surface_forcing.F90 +++ b/config_src/ice_solo_driver/user_surface_forcing.F90 @@ -108,7 +108,7 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) ! These are the stresses in the direction of the model grid (i.e. the same ! direction as the u- and v- velocities.) They are both in Pa. ! In addition, this subroutine can be used to set the surface friction -! velocity, forces%ustar, in Z s-1 ~> m s-1. This is needed with a bulk mixed layer. +! velocity, forces%ustar [Z s-1 ~> m s-1]. This is needed with a bulk mixed layer. ! ! Arguments: state - A structure containing fields that describe the ! surface state of the ocean. diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index bb68f11397..2f0db1dd74 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -135,7 +135,7 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS) type(param_file_type), intent(in) :: param_file !< Parameter file type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: max_depth !< The maximum depth of the ocean, in Z ~> m. + real, intent(in) :: max_depth !< The maximum depth of the ocean [Z ~> m]. type(ALE_CS), pointer :: CS !< Module control structure ! Local variables @@ -1108,7 +1108,7 @@ end subroutine pressure_gradient_ppm subroutine ALE_initRegridding(GV, US, max_depth, param_file, mdl, regridCS) type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: max_depth !< The maximum depth of the ocean, in Z ~> m. + real, intent(in) :: max_depth !< The maximum depth of the ocean [Z ~> m]. type(param_file_type), intent(in) :: param_file !< parameter file character(len=*), intent(in) :: mdl !< Name of calling module type(regridding_CS), intent(out) :: regridCS !< Regridding parameters and work arrays diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 2074996fff..fc43a41195 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -177,7 +177,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m type(regridding_CS), intent(inout) :: CS !< Regridding control structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: max_depth !< The maximum depth of the ocean, in Z ~> m. + real, intent(in) :: max_depth !< The maximum depth of the ocean [Z ~> m]. type(param_file_type), intent(in) :: param_file !< Parameter file character(len=*), intent(in) :: mdl !< Name of calling module. character(len=*), intent(in) :: coord_mode !< Coordinate mode diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index f18f5b2b33..71ee260775 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -104,7 +104,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb dp_star, & ! Layer thickness after compensation for compressibility, in Pa. SSH, & ! The sea surface height anomaly, in depth units (Z ~> m). e_tidal, & ! Bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in Z ~> m. + ! astronomical sources and self-attraction and loading [Z ~> m]. geopot_bot ! Bottom geopotential relative to time-mean sea level, ! including any tidal contributions, in units of m2 s-2. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate @@ -393,7 +393,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, real :: Rho_cv_BL(SZI_(G)) ! The coordinate potential density in ! the deepest variable density near-surface layer, in kg m-3. real :: h_star(SZI_(G),SZJ_(G)) ! Layer thickness after compensation - ! for compressibility, in Z ~> m. + ! for compressibility [Z ~> m]. real :: e_tidal(SZI_(G),SZJ_(G)) ! Bottom geopotential anomaly due to tidal ! forces from astronomical sources and self- ! attraction and loading, in depth units (Z ~> m). @@ -405,7 +405,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ! compensated density gradients, in m s-2. real :: dr ! Temporary variables. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in Z ~> m. + ! in roundoff and can be neglected [Z ~> m]. logical :: use_p_atm ! If true, use the atmospheric pressure. logical :: use_EOS ! If true, density is calculated from T & S using ! an equation of state. @@ -606,7 +606,7 @@ end subroutine PressureForce_Mont_Bouss subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height, in Z ~> m. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height [Z ~> m]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, intent(in) :: Rho0 !< The "Boussinesq" ocean density, in kg m-3. real, intent(in) :: GFS_scale !< Ratio between gravity applied to top interface @@ -632,7 +632,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) logical :: use_EOS ! If true, density is calculated from T & S using ! an equation of state. real :: z_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in Z ~> m. + ! in roundoff and can be neglected [Z ~> m]. integer :: Isq, Ieq, Jsq, Jeq, nz, i, j, k Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 794d62418f..a679334198 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -136,7 +136,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p dp, & ! The (positive) change in pressure across a layer, in Pa. SSH, & ! The sea surface height anomaly, in depth units (Z ~> m). e_tidal, & ! The bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in Z ~> m. + ! astronomical sources and self-attraction and loading [Z ~> m]. dM, & ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. za ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the @@ -462,7 +462,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in depth units (Z ~> m). real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in Z ~> m. + ! astronomical sources and self-attraction and loading [Z ~> m]. dM ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. real, dimension(SZI_(G)) :: & @@ -503,7 +503,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at real :: I_Rho0 ! 1/Rho0. real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. real :: Rho_ref ! The reference density in kg m-3. - real :: dz_neglect ! A minimal thickness in Z ~> m, like e. + real :: dz_neglect ! A minimal thickness [Z ~> m], like e. logical :: use_p_atm ! If true, use the atmospheric pressure. logical :: use_ALE ! If true, use an ALE pressure reconstruction. logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index da7ea5a08a..00d13c7c06 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -132,7 +132,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, dp, & ! The (positive) change in pressure across a layer, in Pa. SSH, & ! The sea surface height anomaly, in depth units (Z ~> m). e_tidal, & ! The bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in Z ~> m. + ! astronomical sources and self-attraction and loading [Z ~> m]. dM, & ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. za ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the @@ -486,7 +486,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2 ~> m s-2. real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. real :: Rho_ref ! The reference density in kg m-3. - real :: dz_neglect ! A minimal thickness in Z ~> m, like e. + real :: dz_neglect ! A minimal thickness [Z ~> m], like e. logical :: use_p_atm ! If true, use the atmospheric pressure. logical :: use_ALE ! If true, use an ALE pressure reconstruction. logical :: use_EOS ! If true, density is calculated from T & S using an diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 9501f1ea4e..8c7d1e477b 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -103,7 +103,7 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: frhatv !< The fraction of the total column thickness interpolated to v grid points in each layer, nondim. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: IDatu - !< Inverse of the basin depth at u grid points, in Z-1 ~> m-1. + !< Inverse of the basin depth at u grid points [Z-1 ~> m-1]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: lin_drag_u !< A spatially varying linear drag coefficient acting on the zonal barotropic flow, !! in H s-1 ~> m s-1 or kg m-2 s-1. @@ -116,7 +116,7 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: ubtav !< The barotropic zonal velocity averaged over the baroclinic time step, m s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: IDatv - !< Inverse of the basin depth at v grid points, in Z-1 ~> m-1. + !< Inverse of the basin depth at v grid points [Z-1 ~> m-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: lin_drag_v !< A spatially varying linear drag coefficient acting on the zonal barotropic flow, !! in H s-1 ~> m s-1 or kg m-2 s-1. @@ -143,15 +143,15 @@ module MOM_barotropic !< This is a copy of G%IareaT with wide halos, but will !! still utilize the macro IareaT when referenced, m-2. real ALLOCABLE_, dimension(NIMEMBW_,NJMEMW_) :: & - D_u_Cor, & !< A simply averaged depth at u points, in Z ~> m. + D_u_Cor, & !< A simply averaged depth at u points [Z ~> m]. dy_Cu, & !< A copy of G%dy_Cu with wide halos, in m. IdxCu !< A copy of G%IdxCu with wide halos, in m-1. real ALLOCABLE_, dimension(NIMEMW_,NJMEMBW_) :: & - D_v_Cor, & !< A simply averaged depth at v points, in Z ~> m. + D_v_Cor, & !< A simply averaged depth at v points [Z ~> m]. dx_Cv, & !< A copy of G%dx_Cv with wide halos, in m. IdyCv !< A copy of G%IdyCv with wide halos, in m-1. real ALLOCABLE_, dimension(NIMEMBW_,NJMEMBW_) :: & - q_D !< f / D at PV points, in Z-1 s-1 ~> m-1 s-1. + q_D !< f / D at PV points [Z-1 s-1 ~> m-1 s-1]. real, dimension(:,:,:), pointer :: frhatu1 => NULL() !< Predictor step values of frhatu stored for diagnostics. real, dimension(:,:,:), pointer :: frhatv1 => NULL() !< Predictor step values of frhatv stored for diagnostics. @@ -505,7 +505,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, Rayleigh_u, & ! A Rayleigh drag timescale operating at u-points, in s-1. PFu_bt_sum, & ! The summed zonal barotropic pressure gradient force, in m s-2. Coru_bt_sum, & ! The summed zonal barotropic Coriolis acceleration, in m s-2. - DCor_u, & ! A simply averaged depth at u points, in Z ~> m. + DCor_u, & ! A simply averaged depth at u points [Z ~> m]. Datu ! Basin depth at u-velocity grid points times the y-grid ! spacing, in H m ~> m2 or kg m-1. real, dimension(SZIW_(CS),SZJBW_(CS)) :: & @@ -536,7 +536,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! in m s-2. Corv_bt_sum, & ! The summed meridional barotropic Coriolis acceleration, ! in m s-2. - DCor_v, & ! A simply averaged depth at v points, in Z ~> m. + DCor_v, & ! A simply averaged depth at v points [Z ~> m]. Datv ! Basin depth at v-velocity grid points times the x-grid ! spacing, in H m ~> m2 or kg m-1. real, target, dimension(SZIW_(CS),SZJW_(CS)) :: & @@ -2282,7 +2282,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) !! acceleration, in m2 Z-1 s-2 ~> m s-2. real, optional, intent(in) :: SSH_add !< An additional contribution to SSH to !! provide a margin of error when - !! calculating the external wave speed, in Z ~> m. + !! calculating the external wave speed [Z ~> m]. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & @@ -2306,7 +2306,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) ! order 1. For stability, this may be made larger ! than physical problem would suggest. real :: add_SSH ! An additional contribution to SSH to provide a margin of error - ! when calculating the external wave speed, in Z ~> m. + ! when calculating the external wave speed [Z ~> m]. real :: min_max_dt2, Idt_max2, dtbt_max logical :: use_BT_cont type(memory_size_type) :: MS @@ -3550,7 +3550,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) !! or column mass anomaly, in H ~> m or kg m-2. integer, optional, intent(in) :: halo !< The halo size to use, default = 1. real, optional, intent(in) :: add_max !< A value to add to the maximum depth (used - !! to overestimate the external wave speed) in Z ~> m. + !! to overestimate the external wave speed) [Z ~> m]. ! Local variables real :: H1, H2 ! Temporary total thicknesses, in m or kg m-2. @@ -3732,7 +3732,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, real :: Datv(SZI_(G),SZJBS_(G)) ! Meridional open face area in H m ~> m2 or kg m-1. real :: gtot_estimate ! Summed GV%g_prime, in m2 Z-1 s-2 ~> m s-2, to give an upper-bound estimate for pbce. real :: SSH_extra ! An estimate of how much higher SSH might get, for use - ! in calculating the safe external wave speed, in Z ~> m. + ! in calculating the safe external wave speed [Z ~> m]. real :: dtbt_input, dtbt_tmp real :: wave_drag_scale ! A scaling factor for the barotropic linear wave drag ! piston velocities. diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 17feb0f5a2..f014c078ae 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -50,9 +50,9 @@ module MOM_forcing_type ! surface stress components and turbulent velocity scale real, pointer, dimension(:,:) :: & - ustar => NULL(), & !< surface friction velocity scale, in Z s-1 ~> m s-1. + ustar => NULL(), & !< surface friction velocity scale [Z s-1 ~> m s-1]. ustar_gustless => NULL() !< surface friction velocity scale without any - !! any augmentation for gustiness, in Z s-1 ~> m s-1. + !! any augmentation for gustiness [Z s-1 ~> m s-1]. ! surface buoyancy force, used when temperature is not a state variable real, pointer, dimension(:,:) :: & @@ -134,12 +134,12 @@ module MOM_forcing_type ! iceberg related inputs real, pointer, dimension(:,:) :: & - ustar_berg => NULL(), & !< iceberg contribution to top ustar, in Z s-1 ~> m s-1. + ustar_berg => NULL(), & !< iceberg contribution to top ustar [Z s-1 ~> m s-1]. area_berg => NULL(), & !< area of ocean surface covered by icebergs (m2/m2) mass_berg => NULL() !< mass of icebergs (kg/m2) ! land ice-shelf related inputs - real, pointer, dimension(:,:) :: ustar_shelf => NULL() !< Friction velocity under ice-shelves, in Z s-1 ~> m s-1. + real, pointer, dimension(:,:) :: ustar_shelf => NULL() !< Friction velocity under ice-shelves [Z s-1 ~> m s-1]. !! as computed by the ocean at the previous time step. real, pointer, dimension(:,:) :: frac_shelf_h => NULL() !< Fractional ice shelf coverage of h-cells, nondimensional !! cells, nondimensional from 0 to 1. This is only @@ -186,7 +186,7 @@ module MOM_forcing_type real, pointer, dimension(:,:) :: & taux => NULL(), & !< zonal wind stress (Pa) tauy => NULL(), & !< meridional wind stress (Pa) - ustar => NULL(), & !< surface friction velocity scale, in Z s-1 ~> m s-1. + ustar => NULL(), & !< surface friction velocity scale [Z s-1 ~> m s-1]. net_mass_src => NULL() !< The net mass source to the ocean, in kg m-2 s-1. ! applied surface pressure from other component models (e.g., atmos, sea ice, land ice) diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 0c52565512..edf7ba7e1f 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -29,12 +29,12 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface heights (in Z ~> m or units + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface heights [Z ~> m] or units !! given by 1/eta_to_m) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables real, intent(in) :: dt_kappa_smooth !< A smoothing vertical diffusivity - !! times a smoothing timescale, in Z2 ~> m2. + !! times a smoothing timescale [Z2 ~> m2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: slope_x !< Isopycnal slope in i-direction (nondim) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: slope_y !< Isopycnal slope in j-direction (nondim) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), & @@ -88,7 +88,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & ! in roundoff and can be neglected, in H ~> m or kg m-2. real :: h_neglect2 ! h_neglect^2, in H2 ~> m2 or kg2 m-4. real :: dz_neglect ! A change in interface heighs that is so small it is usually lost - ! in roundoff and can be neglected, in Z ~> m. + ! in roundoff and can be neglected [Z ~> m]. logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. real :: G_Rho0, N2, dzN2, H_x(SZIB_(G)), H_y(SZI_(G)) @@ -337,7 +337,7 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Temperature (deg C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Salinity (psu) real, intent(in) :: kappa_dt !< A vertical diffusivity to use for smoothing - !! times a smoothing timescale, in Z2 ~> m2. + !! times a smoothing timescale [Z2 ~> m2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature (deg C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filed salinity (psu) integer, optional, intent(in) :: halo_here !< Halo width over which to compute diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 591db8f634..6118d242d6 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -200,11 +200,11 @@ module MOM_variables real :: Prandtl_turb !< The Prandtl number for the turbulent diffusion !! that is captured in Kd_shear. real, pointer, dimension(:,:) :: & - bbl_thick_u => NULL(), & !< The bottom boundary layer thickness at the u-points, in Z ~> m. - bbl_thick_v => NULL(), & !< The bottom boundary layer thickness at the v-points, in Z ~> m. - kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points, in Z2 s-1 ~> m2 s-1. - kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points, in Z2 s-1 ~> m2 s-1. - ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points, in Z s-1 ~> m s-1. + bbl_thick_u => NULL(), & !< The bottom boundary layer thickness at the u-points [Z ~> m]. + bbl_thick_v => NULL(), & !< The bottom boundary layer thickness at the v-points [Z ~> m]. + kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points [Z2 s-1 ~> m2 s-1]. + kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points [Z2 s-1 ~> m2 s-1]. + ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points [Z s-1 ~> m s-1]. real, pointer, dimension(:,:) :: TKE_BBL => NULL() !< A term related to the bottom boundary layer source of turbulent kinetic !! energy, currently in units of m3 s-3, but will later be changed to W m-2. @@ -212,13 +212,13 @@ module MOM_variables taux_shelf => NULL(), & !< The zonal stresses on the ocean under shelves, in Pa. tauy_shelf => NULL() !< The meridional stresses on the ocean under shelves, in Pa. real, pointer, dimension(:,:) :: tbl_thick_shelf_u => NULL() - !< Thickness of the viscous top boundary layer under ice shelves at u-points, in Z ~> m. + !< Thickness of the viscous top boundary layer under ice shelves at u-points [Z ~> m]. real, pointer, dimension(:,:) :: tbl_thick_shelf_v => NULL() - !< Thickness of the viscous top boundary layer under ice shelves at v-points, in Z ~> m. + !< Thickness of the viscous top boundary layer under ice shelves at v-points [Z ~> m]. real, pointer, dimension(:,:) :: kv_tbl_shelf_u => NULL() - !< Viscosity in the viscous top boundary layer under ice shelves at u-points, in Z2 s-1 ~> m2 s-1. + !< Viscosity in the viscous top boundary layer under ice shelves at u-points [Z2 s-1 ~> m2 s-1]. real, pointer, dimension(:,:) :: kv_tbl_shelf_v => NULL() - !< Viscosity in the viscous top boundary layer under ice shelves at v-points, in Z2 s-1 ~> m2 s-1. + !< Viscosity in the viscous top boundary layer under ice shelves at v-points [Z2 s-1 ~> m2 s-1]. real, pointer, dimension(:,:) :: nkml_visc_u => NULL() !< The number of layers in the viscous surface mixed layer at u-points (nondimensional). !! This is not an integer because there may be fractional layers, and it is stored in @@ -229,29 +229,29 @@ module MOM_variables real, pointer, dimension(:,:) :: & MLD => NULL() !< Instantaneous active mixing layer depth (H ~> m or kg m-2). real, pointer, dimension(:,:,:) :: & - Ray_u => NULL(), & !< The Rayleigh drag velocity to be applied to each layer at u-points, in Z s-1 ~> m s-1. - Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points, in Z s-1 ~> m s-1. + Ray_u => NULL(), & !< The Rayleigh drag velocity to be applied to each layer at u-points [Z s-1 ~> m s-1]. + Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points [Z s-1 ~> m s-1]. real, pointer, dimension(:,:,:) :: Kd_extra_T => NULL() !< The extra diffusivity of temperature due to double diffusion relative to the - !! diffusivity of density, in Z2 s-1 ~> m2 s-1. + !! diffusivity of density [Z2 s-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Kd_extra_S => NULL() !< The extra diffusivity of salinity due to double diffusion relative to the - !! diffusivity of density, in Z2 s-1 ~> m2 s-1. + !! diffusivity of density [Z2 s-1 ~> m2 s-1]. ! One of Kd_extra_T and Kd_extra_S is always 0. Kd_extra_S is positive for salt fingering; ! Kd_extra_T is positive for double diffusive convection. They are only allocated if ! DOUBLE_DIFFUSION is true. real, pointer, dimension(:,:,:) :: Kd_shear => NULL() !< The shear-driven turbulent diapycnal diffusivity at the interfaces between layers - !! in tracer columns, in Z2 s-1 ~> m2 s-1. + !! in tracer columns [Z2 s-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Kv_shear => NULL() !< The shear-driven turbulent vertical viscosity at the interfaces between layers - !! in tracer columns, in Z2 s-1 ~> m2 s-1. + !! in tracer columns [Z2 s-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Kv_shear_Bu => NULL() !< The shear-driven turbulent vertical viscosity at the interfaces between layers in - !! corner columns, in Z2 s-1 ~> m2 s-1. + !! corner columns [Z2 s-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Kv_slow => NULL() !< The turbulent vertical viscosity component due to "slow" processes (e.g., tidal, - !! background, convection etc), in Z2 s-1 ~> m2 s-1. + !! background, convection etc) [Z2 s-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: TKE_turb => NULL() !< The turbulent kinetic energy per unit mass at the interfaces, in m2 s-2. !! This may be at the tracer or corner points diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index 5b0f238e58..2dd5ffbf4b 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -72,7 +72,7 @@ module MOM_diag_to_Z integer :: num_tr_used = 0 !< Th enumber of tracers in use. integer :: nk_zspace = -1 !< The number of levels in the z-space output - real, pointer :: Z_int(:) => NULL() !< interface depths of the z-space file, in Z ~> m. + real, pointer :: Z_int(:) => NULL() !< interface depths of the z-space file [Z ~> m]. !>@{ Axis groups for z-space diagnostic output type(axes_grp) :: axesBz, axesTz, axesCuz, axesCvz @@ -164,7 +164,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, US, CS) ! Local variables ! Note the deliberately reversed axes in h_f, u_f, v_f, and tr_f. real :: ssh(SZI_(G),SZJ_(G)) ! copy of ssh_in whose halos can be updated (meter or kg/m2) - real :: e(SZK_(G)+2) ! z-star interface heights in Z ~> m. + real :: e(SZK_(G)+2) ! z-star interface heights [Z ~> m]. real :: h_f(SZK_(G)+1,SZI_(G)) ! thicknesses of massive layers (meter or kg/m2) real :: u_f(SZK_(G)+1,SZIB_(G))! zonal velocity component in any massive layer real :: v_f(SZK_(G)+1,SZI_(G)) ! meridional velocity component in any massive layer @@ -172,8 +172,8 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, US, CS) real :: tr_f(SZK_(G),max(CS%num_tr_used,1),SZI_(G)) ! tracer concentration in massive layers integer :: nk_valid(SZIB_(G)) ! number of massive layers in a column - real :: D_pt(SZIB_(G)) ! bottom depth in Z ~> m. - real :: shelf_depth(SZIB_(G)) ! ice shelf depth in Z ~> m. + real :: D_pt(SZIB_(G)) ! bottom depth [Z ~> m]. + real :: shelf_depth(SZIB_(G)) ! ice shelf depth [Z ~> m]. real :: htot ! summed layer thicknesses (meter or kg/m2) real :: dilate ! proportion by which to dilate every layer real :: wt(SZK_(G)+1) ! fractional weight for each layer in the @@ -509,7 +509,6 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh_int !< Time integrated meridional !! transport (m3 or kg). real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 - !! (usually m or kg m-2). real, intent(in) :: dt !< The time difference in s since !! the last call to this !! subroutine. @@ -520,7 +519,7 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) real, dimension(SZI_(G), SZJ_(G)) :: & htot, & ! total layer thickness, in H ~> m or kg m-2 dilate ! Factor by which to dilate layers to convert them - ! into z* space, in Z H-1 ~> 1 or m3 kg-1. (-G%D < z* < 0) + ! into z* space [Z H-1 ~> 1 or m3 kg-1]. (-G%D < z* < 0) real, dimension(SZI_(G), max(CS%nk_zspace,1)) :: & uh_Z ! uh_int interpolated into depth space (m3 or kg) @@ -528,15 +527,15 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) vh_Z ! vh_int interpolated into depth space (m3 or kg) real :: h_rem ! dilated thickness of a layer that has yet to be mapped - ! into depth space (in Z ~> m) + ! into depth space [Z ~> m] real :: uh_rem ! integrated zonal transport of a layer that has yet to be ! mapped into depth space (m3 or kg) real :: vh_rem ! integrated meridional transport of a layer that has yet ! to be mapped into depth space (m3 or kg) real :: h_here ! thickness of a layer that is within the range of the - ! current depth level (in Z ~> m) + ! current depth level [Z ~> m] real :: h_above ! thickness of a layer that is above the current depth - ! level (in Z ~> m) + ! level [Z ~> m] real :: uh_here ! zonal transport of a layer that is attributed to the ! current depth level (m3 or kg) real :: vh_here ! meridional transport of a layer that is attributed to diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index f40aad50e5..1c82b5062f 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -780,9 +780,9 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) !! previous call to diagnostics_init. real, dimension(SZI_(G), SZJ_(G)) :: & - z_top, & ! Height of the top of a layer or the ocean, in Z ~> m. + z_top, & ! Height of the top of a layer or the ocean [Z ~> m]. z_bot, & ! Height of the bottom of a layer (for id_mass) or the - ! (positive) depth of the ocean (for id_col_ht), in Z ~> m. + ! (positive) depth of the ocean (for id_col_ht) [Z ~> m]. mass, & ! integrated mass of the water column, in kg m-2. For ! non-Boussinesq models this is rho*dz. For Boussinesq ! models, this is either the integral of in-situ density diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 5fc1ebfb31..5fc79ef3ee 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -62,7 +62,7 @@ module MOM_sum_output logical :: read_depth_list !< Read the depth list from a file if it exists !! and write it if it doesn't. character(len=200) :: depth_list_file !< The name of the depth list file. - real :: D_list_min_inc !< The minimum increment, in Z ~> m, between the depths of the + real :: D_list_min_inc !< The minimum increment [Z ~> m], between the depths of the !! entries in the depth-list file, 0 by default. logical :: use_temperature !< If true, temperature and salinity are state variables. real :: fresh_water_input !< The total mass of fresh water added by surface fluxes @@ -296,21 +296,21 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ optional, pointer :: OBC !< Open boundaries control structure. type(time_type), optional, intent(in) :: dt_forcing !< The forcing time step ! Local variables - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! The height of interfaces, in Z ~> m. + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! The height of interfaces [Z ~> m]. real :: areaTm(SZI_(G),SZJ_(G)) ! A masked version of areaT, in m2. real :: KE(SZK_(G)) ! The total kinetic energy of a layer, in J. real :: PE(SZK_(G)+1)! The available potential energy of an interface, in J. real :: KE_tot ! The total kinetic energy, in J. real :: PE_tot ! The total available potential energy, in J. real :: Z_0APE(SZK_(G)+1) ! The uniform depth which overlies the same - ! volume as is below an interface, in Z ~> m. + ! volume as is below an interface [Z ~> m]. real :: H_0APE(SZK_(G)+1) ! A version of Z_0APE, converted to m, usually positive. real :: toten ! The total kinetic & potential energies of ! all layers, in Joules (i.e. kg m2 s-2). real :: En_mass ! The total kinetic and potential energies divided by ! the total mass of the ocean, in m2 s-2. - real :: vol_lay(SZK_(G)) ! The volume of fluid in a layer, in Z m2 ~> m3. - real :: volbelow ! The volume of all layers beneath an interface in Z m2 ~> m3. + real :: vol_lay(SZK_(G)) ! The volume of fluid in a layer [Z m2 ~> m3]. + real :: volbelow ! The volume of all layers beneath an interface [Z m2 ~> m3]. real :: mass_lay(SZK_(G)) ! The mass of fluid in a layer, in kg. real :: mass_tot ! The total mass of the ocean in kg. real :: vol_tot ! The total ocean volume in m3. @@ -334,17 +334,17 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ ! to this subroutine, in Joules. real :: Heat_anom ! The change in heat that cannot be accounted for by ! the surface fluxes, in Joules. - real :: temp ! The mean potential temperature of the ocean, in C. + real :: temp ! The mean potential temperature of the ocean, in degC. real :: temp_chg ! The change in total heat divided by total heat capacity - ! of the ocean since the last call to this subroutine, C. + ! of the ocean since the last call to this subroutine, degC. real :: temp_anom ! The change in total heat that cannot be accounted for ! by the surface fluxes, divided by the total heat - ! capacity of the ocean, in C. - real :: hint ! The deviation of an interface from H, in Z ~> m. + ! capacity of the ocean, in degC. + real :: hint ! The deviation of an interface from H [Z ~> m]. real :: hbot ! 0 if the basin is deeper than H, or the - ! height of the basin depth over H otherwise, - ! in Z ~> m. This makes PE only include real fluid. - real :: hbelow ! The depth of fluid in all layers beneath an interface, in Z ~> m. + ! height of the basin depth over H otherwise [Z ~> m]. + ! This makes PE only include real fluid. + real :: hbelow ! The depth of fluid in all layers beneath an interface [Z ~> m]. type(EFP_type) :: & mass_EFP, & ! Extended fixed point sums of total mass, etc. salt_EFP, heat_EFP, salt_chg_EFP, heat_chg_EFP, mass_chg_EFP, & @@ -1065,15 +1065,15 @@ subroutine create_depth_list(G, CS) !! in which the ordered depth list is stored. ! Local variables real, dimension(G%Domain%niglobal*G%Domain%njglobal + 1) :: & - Dlist, & !< The global list of bottom depths, in Z ~> m. + Dlist, & !< The global list of bottom depths [Z ~> m]. AreaList !< The global list of cell areas, in m2. integer, dimension(G%Domain%niglobal*G%Domain%njglobal+1) :: & indx2 !< The position of an element in the original unsorted list. - real :: Dnow !< The depth now being considered for sorting, in Z ~> m. - real :: Dprev !< The most recent depth that was considered, in Z ~> m. - real :: vol !< The running sum of open volume below a deptn, in Z m2 ~> m3. + real :: Dnow !< The depth now being considered for sorting [Z ~> m]. + real :: Dprev !< The most recent depth that was considered [Z ~> m]. + real :: vol !< The running sum of open volume below a deptn [Z m2 ~> m3]. real :: area !< The open area at the current depth, in m2. - real :: D_list_prev !< The most recent depth added to the list, in Z ~> m. + real :: D_list_prev !< The most recent depth added to the list [Z ~> m]. logical :: add_to_list !< This depth should be included as an entry on the list. integer :: ir, indxt diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 289da4c9bc..19987c1b52 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -35,7 +35,7 @@ module MOM_wave_speed !! wave speed. This parameter controls the default behavior of !! wave_speed() which can be overridden by optional arguments. real :: mono_N2_depth = -1. !< The depth below which N2 is limited as monotonic for the purposes of - !! calculating the equivalent barotropic wave speed, in Z ~> m. + !! calculating the equivalent barotropic wave speed [Z ~> m]. !! This parameter controls the default behavior of wave_speed() which !! can be overridden by optional arguments. type(remapping_CS) :: remapping_CS !< Used for vertical remapping when calculating equivalent barotropic @@ -87,11 +87,11 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & real :: min_h_frac real :: Z_to_Pa ! A conversion factor from thicknesses (in Z) to pressure (in Pa) real, dimension(SZI_(G)) :: & - htot, hmin, & ! Thicknesses in Z ~> m. + htot, hmin, & ! Thicknesses [Z ~> m]. H_here, HxT_here, HxS_here, HxR_here real :: speed2_tot real :: I_Hnew, drxh_sum - real :: L2_to_Z2 ! A scaling factor squared from units of lateral distances to depths, in Z2 m-2 ~> 1. + real :: L2_to_Z2 ! A scaling factor squared from units of lateral distances to depths [Z2 m-2 ~> 1]. real, parameter :: tol1 = 0.0001, tol2 = 0.001 real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() real :: g_Rho0 ! G_Earth/Rho0 in m4 s-2 kg-1. @@ -566,7 +566,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) real :: min_h_frac real :: Z_to_Pa ! A conversion factor from thicknesses (in Z) to pressure (in Pa) real, dimension(SZI_(G)) :: & - htot, hmin, & ! Thicknesses in Z ~> m. + htot, hmin, & ! Thicknesses [Z ~> m]. H_here, HxT_here, HxS_here, HxR_here real :: speed2_tot ! overestimate of the mode-1 speed squared, m2 s-2 real :: speed2_min ! minimum mode speed (squared) to consider in root searching diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 576a6639c0..91ff8cbd2b 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -130,7 +130,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real :: min_h_frac real :: H_to_pres real, dimension(SZI_(G)) :: & - hmin, & ! Thicknesses in Z ~> m. + hmin, & ! Thicknesses [Z ~> m]. H_here, HxT_here, HxS_here, HxR_here real :: speed2_tot real :: I_Hnew, drxh_sum diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 30d1e1c8e0..ea0e6e4a11 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -632,7 +632,7 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, & real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_t !< Height at the top of the layer in depth units (Z ~> m). real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the bottom of the layer, in Z ~> m. + intent(in) :: z_b !< Height at the bottom of the layer [Z ~> m]. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to !! reduce the magnitude of each of the integrals. real, intent(in) :: rho_0 !< A density, in kg m-3, that is used to calculate the @@ -655,7 +655,7 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, & !! divided by the y grid spacing, in Pa. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. - real, optional, intent(in) :: dz_neglect !< A miniscule thickness change, in Z ~> m. + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change [Z ~> m]. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. @@ -883,7 +883,7 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_t !< Height at the top of the layer in depth units (Z ~> m). real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the bottom of the layer in Z ~> m. + intent(in) :: z_b !< Height at the bottom of the layer [Z ~> m]. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is !! subtracted out to reduce the magnitude !! of each of the integrals. @@ -909,7 +909,7 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, !! layer divided by the y grid spacing, in Pa. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. - real, optional, intent(in) :: dz_neglect !< A miniscule thickness change, in Z ~> m. + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change [Z ~> m]. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. real :: T5(5), S5(5), p5(5), r5(5) @@ -917,10 +917,10 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real :: w_left, w_right real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. real :: GxRho, I_Rho - real :: dz ! The layer thickness, in Z ~> m. - real :: hWght ! A pressure-thickness below topography, in Z ~> m. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Z ~> m. - real :: iDenom ! The inverse of the denominator in the weights, in Z-2 ~> m-2. + real :: dz ! The layer thickness [Z ~> m]. + real :: hWght ! A pressure-thickness below topography [Z ~> m]. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Z ~> m]. + real :: iDenom ! The inverse of the denominator in the weights [Z-2 ~> m-2]. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. @@ -1075,7 +1075,7 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & intent(in) :: z_t !< The geometric height at the top of the layer, !! in depth units (Z ~> m). real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< The geometric height at the bottom of the layer in Z ~> m. + intent(in) :: z_b !< The geometric height at the bottom of the layer [Z ~> m]. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to !! reduce the magnitude of each of the integrals. real, intent(in) :: rho_0 !< A density, in kg m-3, that is used to calculate the @@ -1130,16 +1130,16 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & real, parameter :: C1_90 = 1.0/90.0 ! A rational constant, ND. real :: GxRho ! Gravitational acceleration times density, in kg m-1 Z-1 s-2. real :: I_Rho ! The inverse of the reference density, in m3 kg-1. - real :: dz(HIO%iscB:HIO%iecB+1) ! Layer thicknesses at tracer points in Z ~> m. - real :: dz_x(5,HIO%iscB:HIO%iecB) ! Layer thicknesses along an x-line of subrid locations, in Z ~> m. - real :: dz_y(5,HIO%isc:HIO%iec) ! Layer thicknesses along a y-line of subrid locations, in Z ~> m. + real :: dz(HIO%iscB:HIO%iecB+1) ! Layer thicknesses at tracer points [Z ~> m]. + real :: dz_x(5,HIO%iscB:HIO%iecB) ! Layer thicknesses along an x-line of subrid locations [Z ~> m]. + real :: dz_y(5,HIO%isc:HIO%iec) ! Layer thicknesses along a y-line of subrid locations [Z ~> m]. real :: weight_t, weight_b ! Nondimensional wieghts of the top and bottom. real :: massWeightToggle ! A nondimensional toggle factor (0 or 1). real :: Ttl, Tbl, Ttr, Tbr ! Temperatures at the velocity cell corners, in degC. real :: Stl, Sbl, Str, Sbr ! Salinities at the velocity cell corners, in ppt. - real :: hWght ! A topographically limited thicknes weight, in Z ~> m. - real :: hL, hR ! Thicknesses to the left and right, in Z ~> m. - real :: iDenom ! The denominator of the thickness weight expressions, in Z-2 ~> m-2. + real :: hWght ! A topographically limited thicknes weight [Z ~> m]. + real :: hL, hR ! Thicknesses to the left and right [Z ~> m]. + real :: iDenom ! The denominator of the thickness weight expressions [Z-2 ~> m-2]. integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n integer :: iin, jin, ioff, joff integer :: pos @@ -1365,16 +1365,16 @@ subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_t real, intent(in) :: T_b !< Potential temperatue at the cell bottom (degC) real, intent(in) :: S_t !< Salinity at the cell top (ppt) real, intent(in) :: S_b !< Salinity at the cell bottom (ppt) - real, intent(in) :: z_t !< Absolute height of top of cell, in Z ~> m. (Boussinesq ????) - real, intent(in) :: z_b !< Absolute height of bottom of cell, in Z ~> m. + real, intent(in) :: z_t !< Absolute height of top of cell [Z ~> m]. (Boussinesq ????) + real, intent(in) :: z_b !< Absolute height of bottom of cell [Z ~> m]. real, intent(in) :: P_t !< Anomalous pressure of top of cell, relative to g*rho_ref*z_t (Pa) real, intent(in) :: P_tgt !< Target pressure at height z_out, relative to g*rho_ref*z_out (Pa) real, intent(in) :: rho_ref !< Reference density with which calculation are anomalous to real, intent(in) :: G_e !< Gravitational acceleration (m2 Z-1 s-2) type(EOS_type), pointer :: EOS !< Equation of state structure real, intent(out) :: P_b !< Pressure at the bottom of the cell (Pa) - real, intent(out) :: z_out !< Absolute depth at which anomalous pressure = p_tgt, in Z ~> m. - real, optional, intent(in) :: z_tol !< The tolerance in finding z_out, in Z ~> m. + real, intent(out) :: z_out !< Absolute depth at which anomalous pressure = p_tgt [Z ~> m]. + real, optional, intent(in) :: z_tol !< The tolerance in finding z_out [Z ~> m]. ! Local variables real :: top_weight, bottom_weight, rho_anom, w_left, w_right, GxRho, dz, dp, F_guess, F_l, F_r real :: Pa, Pa_left, Pa_right, Pa_tol ! Pressure anomalies, P = integral of g*(rho-rho_ref) dz diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index 96ce448de2..6579c20e82 100644 --- a/src/equation_of_state/MOM_EOS_Wright.F90 +++ b/src/equation_of_state/MOM_EOS_Wright.F90 @@ -409,7 +409,7 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_t !< Height at the top of the layer in depth units (Z ~> m). real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the top of the layer in Z ~> m. + intent(in) :: z_b !< Height at the top of the layer [Z ~> m]. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out !! to reduce the magnitude of each of the integrals. !! (The pressure is calucated as p~=-z*rho_0*G_e.) @@ -434,7 +434,7 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, !! layer divided by the y grid spacing, in Pa. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. - real, optional, intent(in) :: dz_neglect !< A miniscule thickness change in Z ~> m. + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change [Z ~> m]. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. @@ -445,9 +445,9 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real :: eps, eps2, rem real :: GxRho, I_Rho real :: p_ave, I_al0, I_Lzz - real :: dz ! The layer thickness, in Z ~> m. - real :: hWght ! A pressure-thickness below topography, in Z ~> m. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Z ~> m. + real :: dz ! The layer thickness [Z ~> m]. + real :: hWght ! A pressure-thickness below topography [Z ~> m]. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Z ~> m]. real :: iDenom ! The inverse of the denominator in the weights, in m-Z. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90 index 81851dc4ec..3743311394 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -330,7 +330,7 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_t !< Height at the top of the layer in depth units (Z ~> m). real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the top of the layer in Z ~> m. + intent(in) :: z_b !< Height at the top of the layer [Z ~> m]. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted !! out to reduce the magnitude of each of the !! integrals. @@ -361,16 +361,16 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, !! layer divided by the y grid spacing, in Pa. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. - real, optional, intent(in) :: dz_neglect !< A miniscule thickness change in Z ~> m. + real, optional, intent(in) :: dz_neglect !< A miniscule thickness change [Z ~> m]. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. ! Local variables real :: rho_anom ! The density anomaly from rho_ref, in kg m-3. real :: raL, raR ! rho_anom to the left and right, in kg m-3. - real :: dz, dzL, dzR ! Layer thicknesses in Z ~> m. - real :: hWght ! A pressure-thickness below topography, in Z ~> m. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Z ~> m. - real :: iDenom ! The inverse of the denominator in the weights, in Z-2 ~> m-2. + real :: dz, dzL, dzR ! Layer thicknesses [Z ~> m]. + real :: hWght ! A pressure-thickness below topography [Z ~> m]. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Z ~> m]. + real :: iDenom ! The inverse of the denominator in the weights [Z-2 ~> m-2]. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 5eefa3d8e4..8927be50d2 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -142,11 +142,11 @@ module MOM_dyn_horgrid !! basin depths at velocity points. Otherwise the effects of !! of topography are entirely determined from thickness points. real, allocatable, dimension(:,:) :: & - Dblock_u, & !< Topographic depths at u-points at which the flow is blocked, in Z ~> m. - Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu, in Z ~> m. + Dblock_u, & !< Topographic depths at u-points at which the flow is blocked [Z ~> m]. + Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu [Z ~> m]. real, allocatable, dimension(:,:) :: & - Dblock_v, & !< Topographic depths at v-points at which the flow is blocked, in Z ~> m. - Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv, in Z ~> m. + Dblock_v, & !< Topographic depths at v-points at which the flow is blocked [Z ~> m]. + Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv [Z ~> m]. real, allocatable, dimension(:,:) :: & CoriolisBu !< The Coriolis parameter at corner points, in s-1. real, allocatable, dimension(:,:) :: & @@ -164,7 +164,7 @@ module MOM_dyn_horgrid real :: len_lat = 0. !< The latitudinal (or y-coord) extent of physical domain real :: len_lon = 0. !< The longitudinal (or x-coord) extent of physical domain real :: Rad_Earth = 6.378e6 !< The radius of the planet in meters. - real :: max_depth !< The maximum depth of the ocean in Z ~> m. + real :: max_depth !< The maximum depth of the ocean [Z ~> m]. end type dyn_horgrid_type contains diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index da4150cc97..9ddb0c92bb 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -88,7 +88,7 @@ module MOM_ice_shelf real, pointer, dimension(:,:) :: & utide => NULL() !< tidal velocity, in m/s - real :: ustar_bg !< A minimum value for ustar under ice shelves, in Z s-1 ~> m s-1. + real :: ustar_bg !< A minimum value for ustar under ice shelves [Z s-1 ~> m s-1]. real :: cdrag !< drag coefficient under ice shelves , non-dimensional. real :: g_Earth !< The gravitational acceleration in m s-2. real :: Cp !< The heat capacity of sea water, in J kg-1 K-1. @@ -130,7 +130,7 @@ module MOM_ice_shelf !! shelf front(until we think of a better way to do it- !! but any difference will be negligible) logical :: calve_to_mask !< If true, calve any ice that passes outside of a masked area - real :: min_thickness_simple_calve !< min. ice shelf thickness criteria for calving, in Z ~> m. + real :: min_thickness_simple_calve !< min. ice shelf thickness criteria for calving [Z ~> m]. real :: T0 !< temperature at ocean surface in the restoring region, in degC real :: S0 !< Salinity at ocean surface in the restoring region, in ppt. real :: input_flux !< Ice volume flux at an upstream open boundary, in m3 s-1. @@ -880,7 +880,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) type(time_type) :: Time0!< The previous time (Time-dt) real, dimension(SZDI_(G),SZDJ_(G)) :: last_mass_shelf !< Ice shelf mass !! at at previous time (Time-dt), in kg/m^2 - real, dimension(SZDI_(G),SZDJ_(G)) :: last_h_shelf !< Ice shelf thickness in Z ~> m. + real, dimension(SZDI_(G),SZDJ_(G)) :: last_h_shelf !< Ice shelf thickness [Z ~> m]. !! at at previous time (Time-dt), in m real, dimension(SZDI_(G),SZDJ_(G)) :: last_hmask !< Ice shelf mask !! at at previous time (Time-dt) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index fe2af30ba2..7b134ac38d 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -57,9 +57,9 @@ module MOM_ice_shelf_dynamics real, pointer, dimension(:,:) :: u_face_mask_bdry => NULL() !< A duplicate copy of u_face_mask? real, pointer, dimension(:,:) :: v_face_mask_bdry => NULL() !< A duplicate copy of v_face_mask? real, pointer, dimension(:,:) :: u_flux_bdry_val => NULL() !< The ice volume flux into the cell through open boundary - !! u-faces (where u_face_mask=4), in Z m2 s-1 ~> m3 s-1??? + !! u-faces (where u_face_mask=4) [Z m2 s-1 ~> m3 s-1]??? real, pointer, dimension(:,:) :: v_flux_bdry_val => NULL() !< The ice volume flux into the cell through open boundary - !! v-faces (where v_face_mask=4), in Z m2 s-1 ~> m3 s-1??? + !! v-faces (where v_face_mask=4) [Z m2 s-1 ~> m3 s-1]??? ! needed where u_face_mask is equal to 4, similary for v_face_mask real, pointer, dimension(:,:) :: umask => NULL() !< u-mask on the actual degrees of freedom (B grid) !! 1=normal node, 3=inhomogeneous boundary node, @@ -73,7 +73,7 @@ module MOM_ice_shelf_dynamics !! in degC on corner-points (B grid) real, pointer, dimension(:,:) :: tmask => NULL() !< A mask on tracer points that is 1 where there is ice. real, pointer, dimension(:,:) :: ice_visc => NULL() !< Glen's law ice viscosity, perhaps in m. - real, pointer, dimension(:,:) :: thickness_bdry_val => NULL() !< The ice thickness at an inflowing boundary in Z ~> m. + real, pointer, dimension(:,:) :: thickness_bdry_val => NULL() !< The ice thickness at an inflowing boundary [Z ~> m]. real, pointer, dimension(:,:) :: u_bdry_val => NULL() !< The zonal ice velocity at inflowing boundaries in m/s??? real, pointer, dimension(:,:) :: v_bdry_val => NULL() !< The meridional ice velocity at inflowing boundaries in m/s??? real, pointer, dimension(:,:) :: h_bdry_val => NULL() !< The ice thickness at inflowing boundaries, in m. @@ -84,7 +84,7 @@ module MOM_ice_shelf_dynamics real, pointer, dimension(:,:) :: OD_rt => NULL() !< A running total for calculating OD_av. real, pointer, dimension(:,:) :: float_frac_rt => NULL() !< A running total for calculating float_frac. - real, pointer, dimension(:,:) :: OD_av => NULL() !< The time average open ocean depth, in Z ~> m. + real, pointer, dimension(:,:) :: OD_av => NULL() !< The time average open ocean depth [Z ~> m]. real, pointer, dimension(:,:) :: float_frac => NULL() !< Fraction of the time a cell is "exposed", i.e. the column !! thickness is below a threshold. !### [if float_frac = 1 ==> grounded; obviously counterintuitive; might fix] @@ -129,7 +129,7 @@ module MOM_ice_shelf_dynamics real :: thresh_float_col_depth !< The water column depth over which the shelf if considered to be floating logical :: moving_shelf_front !< Specify whether to advance shelf front (and calve). logical :: calve_to_mask !< If true, calve off the ice shelf when it passes the edge of a mask. - real :: min_thickness_simple_calve !< min. ice shelf thickness criteria for calving, in Z ~> m. + real :: min_thickness_simple_calve !< min. ice shelf thickness criteria for calving [Z ~> m]. real :: cg_tolerance !< The tolerance in the CG solver, relative to initial residual, that !! deterimnes when to stop the conguage gradient iterations. @@ -709,7 +709,7 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) ! o--- (3) ---o ! - real, dimension(SZDI_(G),SZDJ_(G)) :: h_after_uflux, h_after_vflux ! Ice thicknesses in Z ~> m. + real, dimension(SZDI_(G),SZDJ_(G)) :: h_after_uflux, h_after_vflux ! Ice thicknesses [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G),4) :: flux_enter integer :: isd, ied, jsd, jed, i, j, isc, iec, jsc, jec real :: rho, spy @@ -786,7 +786,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u, v, iters, time) real, dimension(SZDIB_(G),SZDJB_(G)) :: TAUDX, TAUDY, u_prev_iterate, v_prev_iterate, & u_bdry_cont, v_bdry_cont, Au, Av, err_u, err_v, & u_last, v_last - real, dimension(SZDIB_(G),SZDJB_(G)) :: H_node ! Ice shelf thickness at corners, in Z ~> m. + real, dimension(SZDIB_(G),SZDJB_(G)) :: H_node ! Ice shelf thickness at corners [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G)) :: float_cond ! An array indicating where the ice ! shelf is floating: 0 if floating, 1 if not. character(len=160) :: mesg ! The text of an error message @@ -1048,7 +1048,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c intent(in) :: taudy !< The y-direction driving stress, in ??? real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: H_node !< The ice shelf thickness at nodal (corner) - !! points, in Z ~> m. + !! points [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: float_cond !< An array indicating where the ice !! shelf is floating: 0 if floating, 1 if not. @@ -1426,13 +1426,13 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: h0 !< The initial ice shelf thicknesses in Z ~> m. + intent(in) :: h0 !< The initial ice shelf thicknesses [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_after_uflux !< The ice shelf thicknesses after - !! the zonal mass fluxes, in Z ~> m. + !! the zonal mass fluxes [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G),4), & intent(inout) :: flux_enter !< The ice volume flux into the cell - !! through the 4 cell boundaries, in Z m2 ~> m3. + !! through the 4 cell boundaries [Z m2 ~> m3]. ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells @@ -1455,7 +1455,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied integer :: i_off, j_off logical :: at_east_bdry, at_west_bdry, one_off_west_bdry, one_off_east_bdry - real, dimension(-2:2) :: stencil ! Thicknesses in Z ~> m. + real, dimension(-2:2) :: stencil ! Thicknesses [Z ~> m]. real :: u_face, & ! positive if out flux_diff_cell, phi, dxh, dyh, dxdyh character (len=1) :: debug_str @@ -1657,13 +1657,13 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: h_after_uflux !< The ice shelf thicknesses after - !! the zonal mass fluxes, in Z ~> m. + !! the zonal mass fluxes [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_after_vflux !< The ice shelf thicknesses after - !! the meridional mass fluxes, in Z ~> m. + !! the meridional mass fluxes [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G),4), & intent(inout) :: flux_enter !< The ice volume flux into the cell - !! through the 4 cell boundaries, in Z m2 ~> m3. + !! through the 4 cell boundaries [Z m2 ~> m3]. ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells @@ -1686,7 +1686,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, gjed, gied integer :: i_off, j_off logical :: at_north_bdry, at_south_bdry, one_off_west_bdry, one_off_east_bdry - real, dimension(-2:2) :: stencil ! Thicknesses in Z ~> m. + real, dimension(-2:2) :: stencil ! Thicknesses [Z ~> m]. real :: v_face, & ! positive if out flux_diff_cell, phi, dxh, dyh, dxdyh character(len=1) :: debug_str @@ -1696,7 +1696,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, do i=isd+2,ied-2 if (((i+i_off) <= G%domain%niglobal+G%domain%nihalo) .AND. & - ((i+i_off) >= G%domain%nihalo+1)) then ! based on mehmet's code - only if btw east & west boundaries + ((i+i_off) >= G%domain%nihalo+1)) then ! based on Mehmet's code - only if btw east & west boundaries stencil(:) = -1 @@ -1864,7 +1864,7 @@ subroutine shelf_advance_front(CS, ISS, G, flux_enter) type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G),4), & intent(inout) :: flux_enter !< The ice volume flux into the cell - !! through the 4 cell boundaries, in Z m2 ~> m3. + !! through the 4 cell boundaries [Z m2 ~> m3]. ! in this subroutine we go through the computational cells only and, if they are empty or partial cells, ! we find the reference thickness and update the shelf mass and partial area fraction and the hmask if necessary @@ -2039,13 +2039,13 @@ end subroutine shelf_advance_front subroutine ice_shelf_min_thickness_calve(G, h_shelf, area_shelf_h, hmask, thickness_calve) type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< The ice shelf thickness, in Z ~> m. + intent(inout) :: h_shelf !< The ice shelf thickness [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf - real, intent(in) :: thickness_calve !< The thickness at which to trigger calving, in Z ~> m. + real, intent(in) :: thickness_calve !< The thickness at which to trigger calving [Z ~> m]. integer :: i,j @@ -2066,7 +2066,7 @@ end subroutine ice_shelf_min_thickness_calve subroutine calve_to_mask(G, h_shelf, area_shelf_h, hmask, calve_mask) type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< The ice shelf thickness, in Z ~> m. + intent(inout) :: h_shelf !< The ice shelf thickness [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. real, dimension(SZDI_(G),SZDJ_(G)), & @@ -2095,7 +2095,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, TAUD_X, TAUD_Y, OD) type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. type(unit_scale_type), intent(in) :: US !< Pointer to a structure containing unit conversion factors real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: OD !< ocean floor depth at tracer points, in Z ~> m. + intent(in) :: OD !< ocean floor depth at tracer points [Z ~> m]. real, dimension(SZDIB_(G),SZDJB_(G)), & intent(inout) :: TAUD_X !< X-direction driving stress at q-points real, dimension(SZDIB_(G),SZDJB_(G)), & @@ -2112,8 +2112,8 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, TAUD_X, TAUD_Y, OD) ! "average" ocean depth -- and is needed to find surface elevation ! (it is assumed that base_ice = bed + OD) - real, dimension(SIZE(OD,1),SIZE(OD,2)) :: S, & ! surface elevation, in Z ~> m. - BASE ! basal elevation of shelf/stream, in Z ~> m. + real, dimension(SIZE(OD,1),SIZE(OD,2)) :: S, & ! surface elevation [Z ~> m]. + BASE ! basal elevation of shelf/stream [Z ~> m]. real :: rho, rhow, sx, sy, neumann_val, dxh, dyh, dxdyh, grav @@ -2288,8 +2288,8 @@ subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf - real, intent(in) :: input_flux !< The integrated inward ice thickness flux in Z m2 s-1 ~> m3 s-1. - real, intent(in) :: input_thick !< The ice thickness at boundaries, in Z ~> m. + real, intent(in) :: input_flux !< The integrated inward ice thickness flux [Z m2 s-1 ~> m3 s-1] + real, intent(in) :: input_thick !< The ice thickness at boundaries [Z ~> m]. logical, optional, intent(in) :: new_sim !< If present and false, this run is being restarted ! this will be a per-setup function. the boundary values of thickness and velocity @@ -2377,7 +2377,7 @@ subroutine CG_action(uret, vret, u, v, Phi, Phisub, umask, vmask, hmask, H_node, !! meridional flow at the corner point real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: H_node !< The ice shelf thickness at nodal (corner) - !! points, in Z ~> m. + !! points [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf @@ -2389,7 +2389,7 @@ subroutine CG_action(uret, vret, u, v, Phi, Phisub, umask, vmask, hmask, H_node, intent(in) :: float_cond !< An array indicating where the ice !! shelf is floating: 0 if floating, 1 if not. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points, in Z ~> m. + intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points [Z ~> m]. real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: beta !< A field related to the nonlinear part of the !! "linearized" basal stress. The exact form and @@ -2566,11 +2566,11 @@ subroutine CG_action_subgrid_basal(Phisub, H, U, V, DXDYH, bathyT, dens_ratio, U real, dimension(:,:,:,:,:,:), & intent(in) :: Phisub !< Quadrature structure weights at subgridscale !! locations for finite element calculations - real, dimension(2,2), intent(in) :: H !< The ice shelf thickness at nodal (corner) points, in Z ~> m. + real, dimension(2,2), intent(in) :: H !< The ice shelf thickness at nodal (corner) points [Z ~> m]. real, dimension(2,2), intent(in) :: U !< The zonal ice shelf velocity at vertices, in m/year real, dimension(2,2), intent(in) :: V !< The meridional ice shelf velocity at vertices, in m/year real, intent(in) :: DXDYH !< The tracer cell area, in m2 - real, intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points, in Z ~> m. + real, intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points [Z ~> m]. real, intent(in) :: dens_ratio !< The density of ice divided by the density !! of seawater, nondimensional real, dimension(2,2), intent(inout) :: Ucontr !< A field related to the subgridscale contributions to @@ -2630,7 +2630,7 @@ subroutine matrix_diagonal(CS, G, float_cond, H_node, nu, beta, hmask, dens_rati !! shelf is floating: 0 if floating, 1 if not. real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: H_node !< The ice shelf thickness at nodal - !! (corner) points, in Z ~> m. + !! (corner) points [Z ~> m]. real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: nu !< A field related to the ice viscosity from Glen's !! flow law. The exact form and units depend on the @@ -2772,9 +2772,9 @@ subroutine CG_diagonal_subgrid_basal (Phisub, H_node, DXDYH, bathyT, dens_ratio, intent(in) :: Phisub !< Quadrature structure weights at subgridscale !! locations for finite element calculations real, dimension(2,2), intent(in) :: H_node !< The ice shelf thickness at nodal (corner) - !! points, in Z ~> m. + !! points [Z ~> m]. real, intent(in) :: DXDYH !< The tracer cell area, in m2 - real, intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points, in Z ~> m. + real, intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points [Z ~> m]. real, intent(in) :: dens_ratio !< The density of ice divided by the density !! of seawater, nondimensional real, dimension(2,2), intent(inout) :: Ucontr !< A field related to the subgridscale contributions to @@ -2818,7 +2818,7 @@ subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, flo !! locations for finite element calculations real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: H_node !< The ice shelf thickness at nodal - !! (corner) points, in Z ~> m. + !! (corner) points [Z ~> m]. real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: nu !< A field related to the ice viscosity from Glen's !! flow law. The exact form and units depend on the @@ -3094,7 +3094,7 @@ subroutine update_OD_ffrac_uncoupled(CS, G, h_shelf) type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: h_shelf !< the thickness of the ice shelf in Z ~> m. + intent(in) :: h_shelf !< the thickness of the ice shelf [Z ~> m]. integer :: i, j, iters, isd, ied, jsd, jed real :: rhoi_rhow, OD @@ -3413,13 +3413,13 @@ end subroutine update_velocity_masks subroutine interpolate_H_to_B(G, h_shelf, hmask, H_node) type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: h_shelf !< The ice shelf thickness at tracer points, in Z ~> m. + intent(in) :: h_shelf !< The ice shelf thickness at tracer points [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDIB_(G),SZDJB_(G)), & intent(inout) :: H_node !< The ice shelf thickness at nodal (corner) - !! points, in Z ~> m. + !! points [Z ~> m]. integer :: i, j, isc, iec, jsc, jec, num_h, k, l real :: summ @@ -3630,7 +3630,7 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: h0 !< The initial ice shelf thicknesses in Z ~> m. + intent(in) :: h0 !< The initial ice shelf thicknesses [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_after_uflux !< The ice shelf thicknesses after !! the zonal mass fluxes, in m. @@ -3862,10 +3862,10 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: h_after_uflux !< The ice shelf thicknesses after - !! the zonal mass fluxes, in Z ~> m. + !! the zonal mass fluxes [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_after_vflux !< The ice shelf thicknesses after - !! the meridional mass fluxes, in Z ~> m. + !! the meridional mass fluxes [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G),4), & intent(inout) :: flux_enter !< The integrated temperature flux into !! the cell through the 4 cell boundaries, in degC Z m2 diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 24ba9d838c..9a54335544 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -28,7 +28,7 @@ module MOM_ice_shelf_initialize subroutine initialize_ice_thickness(h_shelf, area_shelf_h, hmask, G, US, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< The ice shelf thickness, in Z ~> m. + intent(inout) :: h_shelf !< The ice shelf thickness [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. real, dimension(SZDI_(G),SZDJ_(G)), & @@ -147,7 +147,7 @@ end subroutine initialize_ice_thickness_from_file subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, US, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< The ice shelf thickness, in Z ~> m. + intent(inout) :: h_shelf !< The ice shelf thickness [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. real, dimension(SZDI_(G),SZDJ_(G)), & diff --git a/src/ice_shelf/user_shelf_init.F90 b/src/ice_shelf/user_shelf_init.F90 index 149713f2b3..0953c6fcc0 100644 --- a/src/ice_shelf/user_shelf_init.F90 +++ b/src/ice_shelf/user_shelf_init.F90 @@ -28,8 +28,8 @@ module user_shelf_init !> The control structure for the user_ice_shelf module type, public :: user_ice_shelf_CS ; private real :: Rho_ocean !< The ocean's typical density, in kg m-2 Z-1. - real :: max_draft !< The maximum ocean draft of the ice shelf, in Z ~> m. - real :: min_draft !< The minimum ocean draft of the ice shelf, in Z ~> m. + real :: max_draft !< The maximum ocean draft of the ice shelf [Z ~> m]. + real :: min_draft !< The minimum ocean draft of the ice shelf [Z ~> m]. real :: flat_shelf_width !< The range over which the shelf is min_draft thick. real :: shelf_slope_scale !< The range over which the shelf slopes. real :: pos_shelf_edge_0 !< The x-position of the shelf edge at time 0, in km. @@ -139,7 +139,7 @@ subroutine USER_update_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, C real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< The ice shelf thickness, in Z ~> m. + intent(inout) :: h_shelf !< The ice shelf thickness [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 94d0b33545..c1b1b41096 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -44,7 +44,7 @@ subroutine MOM_initialize_coord(GV, US, PF, write_geom, output_dir, tv, max_dept logical, intent(in) :: write_geom !< If true, write grid geometry files. character(len=*), intent(in) :: output_dir !< The directory into which to write files. type(thermo_var_ptrs), intent(inout) :: tv !< The thermodynamic variable structure. - real, intent(in) :: max_depth !< The ocean's maximum depth, in Z ~> m. + real, intent(in) :: max_depth !< The ocean's maximum depth [Z ~> m]. ! Local character(len=200) :: config logical :: debug diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 7972f6f6b4..d4bf57922f 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -1229,7 +1229,7 @@ subroutine initialize_masks(G, PF, US) real :: m_to_Z_scale ! A unit conversion factor from m to Z. real :: Dmin ! The depth for masking in the same units as G%bathyT (Z ~> m). real :: min_depth ! The minimum ocean depth in the same units as G%bathyT (Z ~> m). - real :: mask_depth ! The depth shallower than which to mask a point as land, in Z ~> m. + real :: mask_depth ! The depth shallower than which to mask a point as land [Z ~> m]. character(len=40) :: mdl = "MOM_grid_init initialize_masks" integer :: i, j diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 7b74a124fe..dbbf11f61a 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -308,11 +308,11 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth ! Local variables real :: m_to_Z ! A dimensional rescaling factor. - real :: min_depth ! The minimum depth in Z ~> m. + real :: min_depth ! The minimum depth [Z ~> m]. real :: PI ! 3.1415926... calculated as 4*atan(1) real :: D0 ! A constant to make the maximum basin depth MAXIMUM_DEPTH. real :: expdecay ! A decay scale of associated with the sloping boundaries, in m. - real :: Dedge ! The depth, in Z ~> m, at the basin edge + real :: Dedge ! The depth [Z ~> m], at the basin edge ! real :: south_lat, west_lon, len_lon, len_lat, Rad_earth integer :: i, j, is, ie, js, je, isd, ied, jsd, jed character(len=40) :: mdl = "initialize_topography_named" ! This subroutine's name. diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 91f336485b..41ba74b115 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -704,7 +704,7 @@ subroutine adjustEtaToFitBathymetry(G, GV, US, eta, h) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: eta !< Interface heights, in Z ~> m. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: eta !< Interface heights [Z ~> m]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2 ! Local variables integer :: i, j, k, is, ie, js, je, nz, contractions, dilations @@ -1157,8 +1157,8 @@ subroutine cut_off_column_top(nk, tv, GV, G_earth, depth, min_thickness, & type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, intent(in) :: G_earth !< Gravitational acceleration (m2 Z-1 s-2) - real, intent(in) :: depth !< Depth of ocean column, in Z ~> m. - real, intent(in) :: min_thickness !< Smallest thickness allowed, in Z ~> m. + real, intent(in) :: depth !< Depth of ocean column [Z ~> m]. + real, intent(in) :: min_thickness !< Smallest thickness allowed [Z ~> m]. real, dimension(nk), intent(inout) :: T !< Layer mean temperature real, dimension(nk), intent(in) :: T_t !< Temperature at top of layer real, dimension(nk), intent(in) :: T_b !< Temperature at bottom of layer @@ -1170,7 +1170,7 @@ subroutine cut_off_column_top(nk, tv, GV, G_earth, depth, min_thickness, & type(remapping_CS), pointer :: remap_CS !< Remapping structure for remapping T and S, !! if associated real, optional, intent(in) :: z_tol !< The tolerance with which to find the depth - !! matching the specified pressure, in Z ~> m. + !! matching the specified pressure [Z ~> m]. ! Local variables real, dimension(nk+1) :: e ! Top and bottom edge values for reconstructions @@ -1940,11 +1940,11 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param integer :: kd, inconsistent integer :: nkd ! number of levels to use for regridding input arrays - real :: eps_Z ! A negligibly thin layer thickness, in Z ~> m. + real :: eps_Z ! A negligibly thin layer thickness [Z ~> m]. real :: PI_180 ! for conversion from degrees to radians real, dimension(:,:), pointer :: shelf_area => NULL() - real :: min_depth ! The minimum depth in Z ~> m. + real :: min_depth ! The minimum depth [Z ~> m]. real :: dilate real :: missing_value_temp, missing_value_salt logical :: correct_thickness @@ -1963,19 +1963,19 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param real, dimension(:), allocatable :: z_edges_in, z_in, Rb real, dimension(:,:,:), allocatable, target :: temp_z, salt_z, mask_z real, dimension(:,:,:), allocatable :: rho_z - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi ! Interface heights in Z ~> m. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi ! Interface heights [Z ~> m]. real, dimension(SZI_(G),SZJ_(G)) :: nlevs real, dimension(SZI_(G)) :: press ! Pressures in Pa. ! Local variables for ALE remapping - real, dimension(:), allocatable :: hTarget ! Target thicknesses in Z ~> m. + real, dimension(:), allocatable :: hTarget ! Target thicknesses [Z ~> m]. real, dimension(:,:), allocatable :: area_shelf_h real, dimension(:,:), allocatable, target :: frac_shelf_h real, dimension(:,:,:), allocatable, target :: tmpT1dIn, tmpS1dIn real, dimension(:,:,:), allocatable :: tmp_mask_in real, dimension(:,:,:), allocatable :: h1 ! Thicknesses in H ~> m or kg m-2. real, dimension(:,:,:), allocatable :: dz_interface ! Change in position of interface due to regridding - real :: zTopOfCell, zBottomOfCell ! Heights in Z units, Z ~> m. + real :: zTopOfCell, zBottomOfCell ! Heights in Z units [Z ~> m]. type(regridding_CS) :: regridCS ! Regridding parameters and work arrays type(remapping_CS) :: remapCS ! Remapping parameters and work arrays diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 7f8ee25c07..9f03a2bfd2 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -83,8 +83,8 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ ! Local variables for ALE remapping real, dimension(:,:,:), allocatable :: hSrc ! Source thicknesses in H ~> m or kg m-2. - real, dimension(:), allocatable :: h1 ! A 1-d column of source thicknesses in Z ~> m. - real :: zTopOfCell, zBottomOfCell, z_bathy ! Heights in Z ~> m. + real, dimension(:), allocatable :: h1 ! A 1-d column of source thicknesses [Z ~> m]. + real :: zTopOfCell, zBottomOfCell, z_bathy ! Heights [Z ~> m]. type(remapping_CS) :: remapCS ! Remapping parameters and work arrays real :: missing_value diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index 17614addf6..6ee37ad1ec 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -176,7 +176,7 @@ function tracer_z_init(tr_in, z_edges, e, nkml, nkbl, land_fill, wet, nlay, nlev integer :: n,i,j,k,l,nx,ny,nz,nt,kz integer :: k_top,k_bot,k_bot_prev,kk,kstart real :: sl_tr ! The tracer concentration slope times the layer thickness, in tracer units. - real :: epsln_Z ! A negligibly thin layer thickness, in Z ~> m. + real :: epsln_Z ! A negligibly thin layer thickness [Z ~> m]. real, dimension(size(tr_in,3)) :: wt !< The fractional weight for each layer in the range between z1 and z2 real, dimension(size(tr_in,3)) :: z1, z2 ! z1 and z2 are the fractional depths of the top and bottom ! limits of the part of a z-cell that contributes to a layer, relative @@ -565,13 +565,13 @@ function find_interfaces(rho, zin, Rb, depth, nlevs, nkml, nkbl, hml, debug, eps intent(in) :: zin !< Input data levels, in Z (often m). real, dimension(:), intent(in) :: Rb !< target interface densities (kg m-3) real, dimension(size(rho,1),size(rho,2)), & - intent(in) :: depth !< ocean depth in Z ~> m. + intent(in) :: depth !< ocean depth [Z ~> m]. real, dimension(size(rho,1),size(rho,2)), & optional, intent(in) :: nlevs !< number of valid points in each column logical, optional, intent(in) :: debug !< optional debug flag integer, optional, intent(in) :: nkml !< number of mixed layer pieces integer, optional, intent(in) :: nkbl !< number of buffer layer pieces - real, optional, intent(in) :: hml !< mixed layer depth, in Z ~> m. + real, optional, intent(in) :: hml !< mixed layer depth [Z ~> m]. real, optional, intent(in) :: eps_z !< A negligibly small layer thickness in the units of Z. real, dimension(size(rho,1),size(rho,2),size(Rb,1)) :: zi !< The returned interface, in the same units az zin. @@ -588,7 +588,7 @@ function find_interfaces(rho, zin, Rb, depth, nlevs, nkml, nkbl, hml, debug, eps integer :: n,i,j,k,l,nx,ny,nz,nt integer :: nlay,kk,nkml_,nkbl_ logical :: debug_ = .false. - real :: epsln_Z ! A negligibly thin layer thickness, in Z ~> m. + real :: epsln_Z ! A negligibly thin layer thickness [Z ~> m]. real :: epsln_rho ! A negligibly small density change, in kg m-3. real, parameter :: zoff=0.999 diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index a23acd72a0..b2a9b24241 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -150,13 +150,13 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real :: rho_ml(SZI_(G)) ! Potential density relative to the surface (kg m-3) real :: p0(SZI_(G)) ! A pressure of 0 (Pa) - real :: h_vel ! htot interpolated onto velocity points, in Z ~> m (not H). + real :: h_vel ! htot interpolated onto velocity points [Z ~> m] (not H). real :: absf ! absolute value of f, interpolated to velocity points (s-1) - real :: u_star ! surface friction velocity, interpolated to velocity points, in Z s-1 ~> m s-1. + real :: u_star ! surface friction velocity, interpolated to velocity points [Z s-1 ~> m s-1]. real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer (s-1) real :: timescale ! mixing growth timescale (sec) - real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected (H ~> m or kg m-2) - real :: dz_neglect ! A tiny thickness (in Z ~> m) that is usually lost in roundoff so can be neglected + real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected [H ~> m or kg m-2] + real :: dz_neglect ! A tiny thickness that is usually lost in roundoff so can be neglected [Z ~> m] real :: I4dt ! 1/(4 dt) (sec-1) real :: Ihtot,Ihtot_slow! total mixed layer thickness real :: a(SZK_(G)) ! A non-dimensional value relating the overall flux @@ -572,13 +572,13 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) real :: Rho0(SZI_(G)) ! Potential density relative to the surface (kg m-3) real :: p0(SZI_(G)) ! A pressure of 0 (Pa) - real :: h_vel ! htot interpolated onto velocity points (in Z ~> m; not H) + real :: h_vel ! htot interpolated onto velocity points [Z ~> m]. (The units are not H.) real :: absf ! absolute value of f, interpolated to velocity points (s-1) - real :: u_star ! surface friction velocity, interpolated to velocity points, in Z s-1 ~> m s-1. + real :: u_star ! surface friction velocity, interpolated to velocity points [Z s-1 ~> m s-1]. real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer (s-1) real :: timescale ! mixing growth timescale (sec) real :: h_neglect ! tiny thickness usually lost in roundoff and can be neglected (H ~> m or kg m-2) - real :: dz_neglect ! tiny thickness (in Z ~> m) that usually lost in roundoff and can be neglected (meter) + real :: dz_neglect ! tiny thickness that usually lost in roundoff and can be neglected [Z ~> m] real :: I4dt ! 1/(4 dt) real :: I2htot ! Twice the total mixed layer thickness at velocity points (H ~> m or kg m-2) real :: z_topx2 ! depth of the top of a layer at velocity points (H ~> m or kg m-2) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 3c8fac332d..288e58ea6e 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -93,7 +93,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion ! Local variables real :: e(SZI_(G), SZJ_(G), SZK_(G)+1) ! heights of interfaces, relative to mean - ! sea level, in Z ~> m, positive up. + ! sea level [Z ~> m], positive up. real :: uhD(SZIB_(G), SZJ_(G), SZK_(G)) ! uhD & vhD are the diffusive u*h & real :: vhD(SZI_(G), SZJB_(G), SZK_(G)) ! v*h fluxes (m2 H s-1) @@ -471,31 +471,31 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: drdkL, drdkR ! Vertical density differences across an interface, in kg m-3. real :: drdi_u(SZIB_(G), SZK_(G)+1) ! Copy of drdi at u-points in kg m-3. real :: drdj_v(SZI_(G), SZK_(G)+1) ! Copy of drdj at v-points in kg m-3. - real :: drdkDe_u(SZIB_(G),SZK_(G)+1) ! Lateral difference of product of drdk and e at u-points, - ! in Z kg m-3 ~> kg m-2. - real :: drdkDe_v(SZI_(G),SZK_(G)+1) ! Lateral difference of product of drdk and e at v-points, - ! in Z kg m-3 ~> kg m-2. + real :: drdkDe_u(SZIB_(G),SZK_(G)+1) ! Lateral difference of product of drdk and e at u-points + ! [Z kg m-3 ~> kg m-2]. + real :: drdkDe_v(SZI_(G),SZK_(G)+1) ! Lateral difference of product of drdk and e at v-points + ! [Z kg m-3 ~> kg m-2]. real :: hg2A, hg2B, hg2L, hg2R ! Squares of geometric mean thicknesses, in H2 ~> m2 or kg2 m-4. real :: haA, haB, haL, haR ! Arithmetic mean thicknesses in H ~> m or kg m-2. - real :: dzaL, dzaR ! Temporary thicknesses in Z ~> m. + real :: dzaL, dzaR ! Temporary thicknesses [Z ~> m]. real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. real :: drdx, drdy ! Zonal and meridional density gradients, in kg m-4. - real :: drdz ! Vertical density gradient, in units of kg m-3 Z-1 ~> kg m-4. + real :: drdz ! Vertical density gradient [kg m-3 Z-1 ~> kg m-4]. real :: h_harm ! Harmonic mean layer thickness, in H ~> m or kg m-2. - real :: c2_h_u(SZIB_(G), SZK_(G)+1) ! Wave speed squared divided by h at u-points, in m2 Z-1 s-2 ~> m s-2. - real :: c2_h_v(SZI_(G), SZK_(G)+1) ! Wave speed squared divided by h at v-points, in m2 Z-1 s-2 ~> m s-2. - real :: hN2_u(SZIB_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above u-points, in m2 Z-1 s-2. - real :: hN2_v(SZI_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above v-points, in m2 Z-1 s-2. - real :: Sfn_est ! Two preliminary estimates (before limiting) of the - ! overturning streamfunction, both in Z m2 s-1 ~> m3 s-1. - real :: Sfn_unlim_u(SZIB_(G), SZK_(G)+1) ! Streamfunction for u-points, in Z m2 s-1 ~> m3 s-1. - real :: Sfn_unlim_v(SZI_(G), SZK_(G)+1) ! Streamfunction for v-points, in Z m2 s-1 ~> m3 s-1. + real :: c2_h_u(SZIB_(G), SZK_(G)+1) ! Wave speed squared divided by h at u-points [m2 Z-1 s-2 ~> m s-2]. + real :: c2_h_v(SZI_(G), SZK_(G)+1) ! Wave speed squared divided by h at v-points [m2 Z-1 s-2 ~> m s-2]. + real :: hN2_u(SZIB_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above u-points [m2 Z-1 s-2 ~> m s-2]. + real :: hN2_v(SZI_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above v-points [m2 Z-1 s-2 ~> m s-2]. + real :: Sfn_est ! A preliminary estimate (before limiting) of the overturning + ! streamfunction [Z m2 s-1 ~> m3 s-1]. + real :: Sfn_unlim_u(SZIB_(G), SZK_(G)+1) ! Streamfunction for u-points [Z m2 s-1 ~> m3 s-1]. + real :: Sfn_unlim_v(SZI_(G), SZK_(G)+1) ! Streamfunction for v-points [Z m2 s-1 ~> m3 s-1]. real :: slope2_Ratio_u(SZIB_(G), SZK_(G)+1) ! The ratio of the slope squared to slope_max squared. real :: slope2_Ratio_v(SZI_(G), SZK_(G)+1) ! The ratio of the slope squared to slope_max squared. real :: Sfn_in_h ! The overturning streamfunction, in H m2 s-1 ~> m2 s-1 or kg s-1 (note that ! the units are different from other Sfn vars). real :: Sfn_safe ! The streamfunction that goes linearly back to 0 at the surface. This is a - ! good thing to use when the slope is so large as to be meaningless (Z m2 s-1 ~> m3 s-1). + ! good thing to use when the slope is so large as to be meaningless [Z m2 s-1 ~> m3 s-1]. real :: Slope ! The slope of density surfaces, calculated in a way ! that is always between -1 and 1, nondimensional. real :: mag_grad2 ! The squared magnitude of the 3-d density gradient, in kg2 m-8. @@ -503,8 +503,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H ~> m or kg m-2. real :: h_neglect2 ! h_neglect^2, in H2 ~> m2 or kg2 m-4. - real :: dz_neglect ! A thickness, in Z ~> m, that is so small it is usually lost - ! in roundoff and can be neglected, in Z ~> m. + real :: dz_neglect ! A thickness [Z ~> m], that is so small it is usually lost + ! in roundoff and can be neglected [Z ~> m]. real :: G_scale ! The gravitational acceleration times some unit conversion ! factors, in m3 Z-1 H-1 s-2 ~> m s-2 or m4 kg-1 s-2. logical :: use_EOS ! If true, density is calculated from T & S using an diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 4c0b2e2247..fe40137231 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -602,7 +602,7 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, f_p ! Local variables real, allocatable, dimension(:,:,:) :: sp_val !< Field to be used in the sponge real, allocatable, dimension(:,:,:) :: mask_z !< Field mask for the sponge data - real, allocatable, dimension(:), target :: z_in, z_edges_in ! Heights in Z ~> m. + real, allocatable, dimension(:), target :: z_in, z_edges_in ! Heights [Z ~> m]. real :: missing_value integer :: j, k, col integer :: isd,ied,jsd,jed @@ -612,9 +612,9 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, f_p character(len=256) :: mesg ! String for error messages ! Local variables for ALE remapping - real, dimension(:), allocatable :: hsrc ! Source thicknesses in Z ~> m. + real, dimension(:), allocatable :: hsrc ! Source thicknesses [Z ~> m]. real, dimension(:), allocatable :: tmpT1d - real :: zTopOfCell, zBottomOfCell ! Heights in Z ~> m. + real :: zTopOfCell, zBottomOfCell ! Heights [Z ~> m]. type(remapping_CS) :: remapCS ! Remapping parameters and work arrays if (.not.associated(CS)) return diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index a0a210168b..6402eec3be 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -65,9 +65,9 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface - !! (not layer!) in Z2 s-1 ~> m2 s-1. + !! (not layer!) [Z2 s-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface - !! (not layer!) in Z2 s-1 ~> m2 s-1. + !! (not layer!) [Z2 s-1 ~> m2 s-1]. type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous call to !! CVMix_shear_init. ! Local variables diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index cd124bf486..848f434d2e 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -389,10 +389,10 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, US, CS) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< squared buoyancy frequency associated !! with layers (1/s2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: kd_lay !< Diapycnal diffusivity of each layer, - !! in Z2 s-1 ~> m2 s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: kd_lay !< Diapycnal diffusivity of each layer + !! [Z2 s-1 ~> m2 s-1]. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) in Z2 s-1 ~> m2 s-1 + !! (not layer!) [Z2 s-1 ~> m2 s-1] integer, intent(in) :: j !< Meridional grid index type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by !! a previous call to bkgnd_mixing_init. diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 55d629a0b4..db1d58b743 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -52,9 +52,8 @@ module MOM_bulk_mixed_layer real :: H_limit_fluxes !< When the total ocean depth is less than this !! value, in H ~> m or kg m-2, scale away all surface forcing to !! avoid boiling the ocean. - real :: ustar_min !< A minimum value of ustar to avoid numerical problems, - !! in Z s-1 ~> m s-1. If the value is small enough, this should - !! not affect the solution. + real :: ustar_min !< A minimum value of ustar to avoid numerical problems [Z s-1 ~> m s-1]. + !! If the value is small enough, this should not affect the solution. real :: omega !< The Earth's rotation rate, in s-1. real :: dT_dS_wt !< When forced to extrapolate T & S to match the !! layer densities, this factor (in deg C / PSU) is @@ -88,7 +87,7 @@ module MOM_bulk_mixed_layer logical :: TKE_diagnostics = .false. !< If true, calculate extensive diagnostics of the TKE budget logical :: do_rivermix = .false. !< Provide additional TKE to mix river runoff !! at the river mouths to rivermix_depth - real :: rivermix_depth = 0.0 !< The depth of mixing if do_rivermix is true, in Z ~> m. + real :: rivermix_depth = 0.0 !< The depth of mixing if do_rivermix is true [Z ~> m]. logical :: limit_det !< If true, limit the extent of buffer layer !! detrainment to be consistent with neighbors. real :: lim_det_dH_sfc !< The fractional limit in the change between grid @@ -111,7 +110,7 @@ module MOM_bulk_mixed_layer real :: Allowed_S_chg !< The amount by which salinity is allowed !! to exceed previous values during detrainment, PSU. - ! These are terms in the mixed layer TKE budget, all in Z m2 s-3 ~> m3 s-3. + ! These are terms in the mixed layer TKE budget, all in [Z m2 s-3 ~> m3 s-3]. real, allocatable, dimension(:,:) :: & ML_depth, & !< The mixed layer depth in H ~> m or kg m-2. diag_TKE_wind, & !< The wind source of TKE. @@ -254,12 +253,12 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C integer, dimension(SZI_(G),SZK_(GV)) :: & ksort ! The sorted k-index that each original layer goes to. real, dimension(SZI_(G),SZJ_(G)) :: & - h_miss ! The summed absolute mismatch, in Z ~> m. + h_miss ! The summed absolute mismatch [Z ~> m]. real, dimension(SZI_(G)) :: & TKE, & ! The turbulent kinetic energy available for mixing over a - ! time step, in Z m2 s-2 ~> m3 s-2. + ! time step [Z m2 s-2 ~> m3 s-2]. Conv_En, & ! The turbulent kinetic energy source due to mixing down to - ! the depth of free convection, in Z m2 s-2 ~> m3 s-2. + ! the depth of free convection [Z m2 s-2 ~> m3 s-2]. htot, & ! The total depth of the layers being considered for ! entrainment, in H ~> m or kg m-2. R0_tot, & ! The integrated potential density referenced to the surface @@ -295,7 +294,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C dRcv_dS, & ! Partial derivative of the coordinate variable potential ! density in the mixed layer with salinity, in kg m-3 psu-1. TKE_river ! The turbulent kinetic energy available for mixing at rivermouths over a - ! time step, in Z m2 s-2 ~> m3 s-2. + ! time step [Z m2 s-2 ~> m3 s-2]. real, dimension(max(CS%nsw,1),SZI_(G)) :: & Pen_SW_bnd ! The penetrating fraction of the shortwave heating integrated @@ -313,22 +312,22 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C real :: RmixConst real, dimension(SZI_(G)) :: & - dKE_FC, & ! The change in mean kinetic energy due to free convection, - ! in Z m2 s-2 ~> m3 s-2. + dKE_FC, & ! The change in mean kinetic energy due to free convection + ! [Z m2 s-2 ~> m3 s-2]. h_CA ! The depth to which convective adjustment has gone in H ~> m or kg m-2. real, dimension(SZI_(G),SZK_(GV)) :: & dKE_CA, & ! The change in mean kinetic energy due to convective - ! adjustment, in Z m2 s-2 ~> m3 s-2. + ! adjustment [Z m2 s-2 ~> m3 s-2]. cTKE ! The turbulent kinetic energy source due to convective - ! adjustment, Z m2 s-2. + ! adjustment [Z m2 s-2 ~> m3 s-2]. real, dimension(SZI_(G),SZJ_(G)) :: & Hsfc_max, & ! The thickness of the surface region (mixed and buffer layers) - ! after entrainment but before any buffer layer detrainment, in Z ~> m. + ! after entrainment but before any buffer layer detrainment [Z ~> m]. Hsfc_used, & ! The thickness of the surface region after buffer layer ! detrainment, in units of Z. Hsfc_min, & ! The minimum thickness of the surface region based on the ! new mixed layer depth and the previous thickness of the - ! neighboring water columns, in Z ~> m. + ! neighboring water columns [Z ~> m]. h_sum, & ! The total thickness of the water column, in H ~> m or kg m-2. hmbl_prev ! The previous thickness of the mixed and buffer layers, in H ~> m or kg m-2. real, dimension(SZI_(G)) :: & @@ -339,9 +338,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C real :: dHsfc, dHD ! Local copies of nondimensional parameters. real :: H_nbr ! A minimum thickness based on neighboring thicknesses, in H ~> m or kg m-2. - real :: absf_x_H ! The absolute value of f times the mixed layer thickness, - ! in units of Z s-1. - real :: kU_star ! Ustar times the Von Karmen constant, in Z s-1 ~> m s-1. + real :: absf_x_H ! The absolute value of f times the mixed layer thickness [Z s-1 ~> m s-1]. + real :: kU_star ! Ustar times the Von Karmen constant [Z s-1 ~> m s-1]. real :: dt__diag ! A copy of dt_diag (if present) or dt, in s. logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. @@ -821,10 +819,10 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & !! that will be left in each layer, in H ~> m or kg m-2. real, dimension(SZI_(G),SZK_(GV)), intent(out) :: dKE_CA !< The vertically integrated change in !! kinetic energy due to convective - !! adjustment, in Z m2 s-2 ~> m3 s-2. + !! adjustment [Z m2 s-2 ~> m3 s-2]. real, dimension(SZI_(G),SZK_(GV)), intent(out) :: cTKE !< The buoyant turbulent kinetic energy - !! source due to convective adjustment, - !! in Z m2 s-2 ~> m3 s-2. + !! source due to convective adjustment + !! [Z m2 s-2 ~> m3 s-2]. integer, intent(in) :: j !< The j-index to work on. type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. integer, optional, intent(in) :: nz_conv !< If present, the number of layers @@ -1002,9 +1000,9 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! shortwave radiation, in H-1 ~> m-1 or m2 kg-1. !! The indicies of opacity_band are band, i, k. real, dimension(SZI_(G)), intent(out) :: Conv_en !< The buoyant turbulent kinetic energy source - !! due to free convection, in Z m2 s-2 ~> m3 s-2. + !! due to free convection [Z m2 s-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(out) :: dKE_FC !< The vertically integrated change in kinetic - !! energy due to free convection, in Z m2 s-2 ~> m3 s-2. + !! energy due to free convection [Z m2 s-2 ~> m3 s-2]. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & intent(in) :: ksort !< The density-sorted k-indices. @@ -1314,25 +1312,25 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, !! possible forcing fields. Unused fields !! have NULL ptrs. real, dimension(SZI_(G)), intent(inout) :: Conv_En !< The buoyant turbulent kinetic energy source - !! due to free convection, in Z m2 s-2 ~> m3 s-2. + !! due to free convection [Z m2 s-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(in) :: dKE_FC !< The vertically integrated change in - !! kinetic energy due to free convection, - !! in Z m2 s-2 ~> m3 s-2. + !! kinetic energy due to free convection + !! [Z m2 s-2 ~> m3 s-2]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: cTKE !< The buoyant turbulent kinetic energy - !! source due to convective adjustment, - !! in Z m2 s-2 ~> m3 s-2. + !! source due to convective adjustment + !! [Z m2 s-2 ~> m3 s-2]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: dKE_CA !< The vertically integrated change in !! kinetic energy due to convective - !! adjustment, in Z m2 s-2 ~> m3 s-2. + !! adjustment [Z m2 s-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(out) :: TKE !< The turbulent kinetic energy available for - !! mixing over a time step, in Z m2 s-2 ~> m3 s-2. + !! mixing over a time step [Z m2 s-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(out) :: Idecay_len_TKE !< The inverse of the vertical decay !! scale for TKE, in H-1 ~> m-1 or m2 kg-1. real, dimension(SZI_(G)), intent(in) :: TKE_river !< The turbulent kinetic energy available !! for driving mixing at river mouths - !! integrated over a time step, in Z m2 s-2 ~> m3 s-2. + !! integrated over a time step [Z m2 s-2 ~> m3 s-2]. real, dimension(2,SZI_(G)), intent(out) :: cMKE !< Coefficients of HpE and HpE^2 in !! calculating the denominator of MKE_rate, !! in H-1 and H-2. @@ -1348,22 +1346,22 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, ! convection to drive mechanical entrainment. ! Local variables - real :: dKE_conv ! The change in mean kinetic energy due to all convection, in Z m2 s-2 ~> m3 s-2. + real :: dKE_conv ! The change in mean kinetic energy due to all convection [Z m2 s-2 ~> m3 s-2]. real :: nstar_FC ! The effective efficiency with which the energy released by ! free convection is converted to TKE, often ~0.2, ND. real :: nstar_CA ! The effective efficiency with which the energy released by ! convective adjustment is converted to TKE, often ~0.2, ND. real :: TKE_CA ! The potential energy released by convective adjustment if - ! that release is positive, in Z m2 s-2 ~> m3 s-2. + ! that release is positive [Z m2 s-2 ~> m3 s-2]. real :: MKE_rate_CA ! MKE_rate for convective adjustment, ND, 0 to 1. real :: MKE_rate_FC ! MKE_rate for free convection, ND, 0 to 1. real :: totEn_Z ! The total potential energy released by convection, Z3 s-2. real :: Ih ! The inverse of a thickness, in H-1 ~> m-1 or m2 kg-1. real :: exp_kh ! The nondimensional decay of TKE across a layer, ND. real :: absf ! The absolute value of f averaged to thickness points, s-1. - real :: U_star ! The friction velocity in Z s-1 ~> m s-1. - real :: absf_Ustar ! The absolute value of f divided by U_star, in Z-1 ~> m-1. - real :: wind_TKE_src ! The surface wind source of TKE, in Z m2 s-3 ~> m3 s-3. + real :: U_star ! The friction velocity [Z s-1 ~> m s-1]. + real :: absf_Ustar ! The absolute value of f divided by U_star [Z-1 ~> m-1]. + real :: wind_TKE_src ! The surface wind source of TKE [Z m2 s-3 ~> m3 s-3]. real :: diag_wt ! The ratio of the current timestep to the diagnostic ! timestep (which may include 2 calls), ND. integer :: is, ie, nz, i @@ -1549,7 +1547,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! The indicies of opacity_band are band, i, k. real, dimension(SZI_(G)), intent(inout) :: TKE !< The turbulent kinetic energy !! available for mixing over a time - !! step, in Z m2 s-2 ~> m3 s-2. + !! step [Z m2 s-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(inout) :: Idecay_len_TKE !< The vertical TKE decay rate, in H-1 ~> m-1 or m2 kg-1. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & @@ -1584,10 +1582,10 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: C1 ! A temporary variable in units of m2 s-2. real :: dMKE ! A temporary variable related to the release of mean ! kinetic energy, with units of H Z m2 s-2. - real :: TKE_ent ! The TKE that remains if h_ent were entrained, in Z m2 s-2 ~> m3 s-2. + real :: TKE_ent ! The TKE that remains if h_ent were entrained [Z m2 s-2 ~> m3 s-2]. real :: TKE_ent1 ! The TKE that would remain, without considering the - ! release of mean kinetic energy, in Z m2 s-2 ~> m3 s-2. - real :: dTKE_dh ! The partial derivative of TKE with h_ent, in Z m2 s-2 H-1 ~> m2 s-2 or m5 s-2 kg-1. + ! release of mean kinetic energy [Z m2 s-2 ~> m3 s-2]. + real :: dTKE_dh ! The partial derivative of TKE with h_ent [Z m2 s-2 H-1 ~> m2 s-2 or m5 s-2 kg-1]. real :: Pen_dTKE_dh_Contrib ! The penetrating shortwave contribution to ! dTKE_dh, in m2 s-2. real :: EF4_val ! The result of EF4() (see later), in H-1 ~> m-1 or m2 kg-1. @@ -2387,7 +2385,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: Rho0xG ! Rho0 times G_Earth, in kg m-1 Z-1 s-2 ~> kg m-2 s-2. real :: I2Rho0 ! 1 / (2 Rho0), in m3 kg-1. real :: Idt_H2 ! The square of the conversion from thickness to Z - ! divided by the time step, in Z2 H-2 s-1 ~> s-1 or m6 kg-2 s-1. + ! divided by the time step [Z2 H-2 s-1 ~> s-1 or m6 kg-2 s-1]. logical :: stable_Rcv ! If true, the buffer layers are stable with ! respect to the coordinate potential density. real :: h_neglect ! A thickness that is so small it is usually lost diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index b9f7d9ce08..b3030bb28a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -37,7 +37,7 @@ module MOM_diabatic_aux type, public :: diabatic_aux_CS ; private logical :: do_rivermix = .false. !< Provide additional TKE to mix river runoff at the !! river mouths to a depth of "rivermix_depth" - real :: rivermix_depth = 0.0 !< The depth to which rivers are mixed if do_rivermix = T, in Z ~> m. + real :: rivermix_depth = 0.0 !< The depth to which rivers are mixed if do_rivermix = T [Z ~> m]. logical :: reclaim_frazil !< If true, try to use any frazil heat deficit to !! to cool the topmost layer down to the freezing !! point. The default is false. @@ -244,7 +244,7 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) real :: b_denom_T ! The first term in the denominators for the expressions real :: b_denom_S ! for b1_T and b1_S, both in H ~> m or kg m-2. real, dimension(:,:,:), pointer :: T=>NULL(), S=>NULL() - real, dimension(:,:,:), pointer :: Kd_T=>NULL(), Kd_S=>NULL() ! Diffusivities in Z2 s-1 ~> m2 s-1. + real, dimension(:,:,:), pointer :: Kd_T=>NULL(), Kd_S=>NULL() ! Diffusivities [Z2 s-1 ~> m2 s-1]. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -669,15 +669,15 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, ! Local variables real, dimension(SZI_(G)) :: deltaRhoAtKm1, deltaRhoAtK ! Density differences, in kg m-3. real, dimension(SZI_(G)) :: pRef_MLD, pRef_N2 ! Reference pressures in Pa. - real, dimension(SZI_(G)) :: dK, dKm1, d1 ! Depths in Z ~> m. + real, dimension(SZI_(G)) :: dK, dKm1, d1 ! Depths [Z ~> m]. real, dimension(SZI_(G)) :: rhoSurf, rhoAtK, rho1 ! Densities used for N2, in kg m-3. - real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth, in Z ~> m. + real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth [Z ~> m]. real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML, in s-2. - real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2, in Z2 ~> m2. + real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2 [Z2 ~> m2]. real :: Rho_x_gE ! The product of density, gravitational acceleartion and a unit ! conversion factor, in kg m-1 Z-1 s-2. real :: gE_Rho0 ! The gravitational acceleration divided by a mean density, in m4 s-2 kg-1. - real :: dz_subML ! Depth below ML over which to diagnose stratification, in Z ~> m. + real :: dz_subML ! Depth below ML over which to diagnose stratification [Z ~> m]. integer :: i, j, is, ie, js, je, k, nz, id_N2, id_SQ real :: aFac, ddRho @@ -799,7 +799,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & optional, intent(out) :: dSV_dS !< Partial derivative of specific volume with !! salinity, in m3 kg-1 / (g kg-1). real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface, in Z2 s-3 ~> m2 s-3. + optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface [Z2 s-3 ~> m2 s-3]. ! Local variables integer, parameter :: maxGroundings = 5 @@ -835,8 +835,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & real :: Temp_in, Salin_in ! real :: I_G_Earth real :: g_Hconv2 - real :: GoRho ! g_Earth times a unit conversion factor divided by density, - ! in Z m3 s-2 kg-1 ~> m4 s-2 kg-1 + real :: GoRho ! g_Earth times a unit conversion factor divided by density + ! [Z m3 s-2 kg-1 ~> m4 s-2 kg-1] logical :: calculate_energetics logical :: calculate_buoyancy integer :: i, j, is, ie, js, je, k, nz, n, nsw diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 4929328214..d24da9f883 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -153,11 +153,11 @@ module MOM_diabatic_driver !! operating. real :: Kd_BBL_tr !< A bottom boundary layer tracer diffusivity that !! will allow for explicitly specified bottom fluxes - !! in Z2 s-1 ~> m2 s-1. The entrainment at the bottom is at + !! [Z2 s-1 ~> m2 s-1]. The entrainment at the bottom is at !! least sqrt(Kd_BBL_tr*dt) over the same distance. real :: Kd_min_tr !< A minimal diffusivity that should always be !! applied to tracers, especially in massless layers - !! near the bottom, in Z2 s-1 ~> m2 s-1. + !! near the bottom [Z2 s-1 ~> m2 s-1]. real :: minimum_forcing_depth = 0.001 !< The smallest depth over which heat and freshwater !! fluxes are applied, in m. real :: evap_CFL_limit = 0.8 !< The largest fraction of a layer that can be @@ -391,7 +391,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & integer :: ig, jg ! global indices for testing testing itide point source (BDM) logical :: avg_enabled ! for testing internal tides (BDM) - real :: Kd_add_here ! An added diffusivity, in Z2 s-1 ~> m2 s-1. + real :: Kd_add_here ! An added diffusivity [Z2 s-1 ~> m2 s-1]. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -1274,7 +1274,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en integer :: ig, jg ! global indices for testing testing itide point source (BDM) logical :: avg_enabled ! for testing internal tides (BDM) - real :: Kd_add_here ! An added diffusivity, in Z2 s-1 ~> m2 s-1. + real :: Kd_add_here ! An added diffusivity [Z2 s-1 ~> m2 s-1]. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index dcaf931870..d7442297d5 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -59,14 +59,14 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) !! in s. type(diapyc_energy_req_CS), pointer :: CS !< This module's control structure. real, dimension(G%isd:G%ied,G%jsd:G%jed,GV%ke+1), & - optional, intent(in) :: Kd_int !< Interface diffusivities in Z2 s-1 ~> m2 s-1. + optional, intent(in) :: Kd_int !< Interface diffusivities [Z2 s-1 ~> m2 s-1]. ! Local variables real, dimension(GV%ke) :: & T0, S0, & ! T0 & S0 are columns of initial temperatures and salinities, in degC and g/kg. h_col ! h_col is a column of thicknesses h at tracer points, in H ~> m or kg m-2. real, dimension(GV%ke+1) :: & - Kd, & ! A column of diapycnal diffusivities at interfaces, in Z2 s-1 ~> m2 s-1. + Kd, & ! A column of diapycnal diffusivities at interfaces [Z2 s-1 ~> m2 s-1]. h_top, h_bot ! Distances from the top or bottom, in H ~> m or kg m-2. real :: ustar, absf, htot real :: energy_Kd ! The energy used by diapycnal mixing in W m-2. @@ -127,8 +127,8 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & !! in H ~> m or kg m-2. real, dimension(GV%ke), intent(in) :: T_in !< The layer temperatures, in degC. real, dimension(GV%ke), intent(in) :: S_in !< The layer salinities, in g kg-1. - real, dimension(GV%ke+1), intent(in) :: Kd !< The interfaces diapycnal diffusivities, - !! in Z2 s-1 ~> m2 s-1. + real, dimension(GV%ke+1), intent(in) :: Kd !< The interfaces diapycnal diffusivities + !! [Z2 s-1 ~> m2 s-1]. real, intent(in) :: dt !< The amount of time covered by this call, in s. real, intent(out) :: energy_Kd !< The column-integrated rate of energy !! consumption by diapycnal diffusion, in W m-2. @@ -170,13 +170,13 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & dT_to_dPE, & ! Partial derivative of column potential energy with the temperature dS_to_dPE, & ! and salinity changes within a layer, in J m-2 K-1 and J m-2 / (g kg-1). dT_to_dColHt, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt, & ! and salinity changes within a layer, in Z K-1 ~> m K-1 and Z ppt-1 ~> m ppt-1. + dS_to_dColHt, & ! and salinity changes within a layer [Z K-1 ~> m K-1] and [Z ppt-1 ~> m ppt-1]. dT_to_dColHt_a, & ! Partial derivatives of the total column height with the temperature dS_to_dColHt_a, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers higher in the water colun, in Z K-1 ~> m K-1 and Z ppt-1 ~> m ppt-1. + ! of mixing with layers higher in the water colun [Z K-1 ~> m K-1] and [Z ppt-1 ~> m ppt-1]. dT_to_dColHt_b, & ! Partial derivatives of the total column height with the temperature dS_to_dColHt_b, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers lower in the water colun, in Z K-1 ~> m K-1 and Z ppt-1 ~> m ppt-1. + ! of mixing with layers lower in the water colun [Z K-1 ~> m K-1] and [Z ppt-1 ~> m ppt-1]. dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature dS_to_dPE_a, & ! and salinity changes within a layer, including the implicit effects ! of mixing with layers higher in the water column, in @@ -1017,19 +1017,19 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real, intent(in) :: dT_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers above, in Z K-1 ~> m K-1. + !! in the temperatures of all the layers above [Z K-1 ~> m K-1]. real, intent(in) :: dS_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers above, in Z ppt-1 ~> m ppt-1. + !! in the salinities of all the layers above [Z ppt-1 ~> m ppt-1]. real, intent(in) :: dT_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers below, in Z K-1 ~> m K-1. + !! in the temperatures of all the layers below [Z K-1 ~> m K-1]. real, intent(in) :: dS_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers below, in Z ppt-1 ~> m ppt-1. + !! in the salinities of all the layers below [Z ppt-1 ~> m ppt-1]. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying !! Kddt_h at the present interface, in J m-2. @@ -1157,19 +1157,19 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & real, intent(in) :: dT_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers below, in Z K-1 ~> m K-1. + !! in the temperatures of all the layers below [Z K-1 ~> m K-1]. real, intent(in) :: dS_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers below, in Z ppt-1 ~> m ppt-1. + !! in the salinities of all the layers below [Z ppt-1 ~> m ppt-1]. real, intent(in) :: dT_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers above, in Z K-1 ~> m K-1. + !! in the temperatures of all the layers above [Z K-1 ~> m K-1]. real, intent(in) :: dS_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers above, in Z ppt-1 ~> m ppt-1. + !! in the salinities of all the layers above [Z ppt-1 ~> m ppt-1]. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying !! Kddt_h at the present interface, in J m-2. diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index f712fdb93d..2da2f97bbe 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -68,8 +68,8 @@ module MOM_energetic_PBL !! boundary layer thickness. The default is 0, but a !! value of 0.1 might be better justified by observations. real :: MLD_tol !< A tolerance for determining the boundary layer thickness when - !! Use_MLD_iteration is true, in Z ~> m. - real :: min_mix_len !< The minimum mixing length scale that will be used by ePBL, in Z ~> m. + !! Use_MLD_iteration is true [Z ~> m]. + real :: min_mix_len !< The minimum mixing length scale that will be used by ePBL [Z ~> m]. !! The default (0) does not set a minimum. real :: N2_Dissipation_Scale_Neg !< A nondimensional scaling factor controlling the loss of TKE !! due to enhanced dissipation in the presence of negative (unstable) @@ -151,8 +151,8 @@ module MOM_energetic_PBL diag_TKE_conv_decay, & !< The decay of convective TKE, in J m-2. diag_TKE_mixing,& !< The work done by TKE to deepen the mixed layer, in J m-2. ! Additional output parameters also 2d - ML_depth, & !< The mixed layer depth in Z ~> m. (result after iteration step) - ML_depth2, & !< The mixed layer depth in Z ~> m. (guess for iteration step) + ML_depth, & !< The mixed layer depth [Z ~> m]. (result after iteration step) + ML_depth2, & !< The mixed layer depth [Z ~> m]. (guess for iteration step) Enhance_M, & !< The enhancement to the turbulent velocity scale (non-dim) MSTAR_MIX, & !< Mstar used in EPBL MSTAR_LT, & !< Mstar for Langmuir turbulence @@ -216,12 +216,12 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS !! NULL ptrs. real, intent(in) :: dt !< Time increment, in s. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & - intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces, - !! in Z2 s-1 ~> m2 s-1. + intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces + !! [Z2 s-1 ~> m2 s-1]. type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous !! call to mixedlayer_init. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: Buoy_Flux !< The surface buoyancy flux in Z2 s-3 ~> m2 s-3. + intent(in) :: Buoy_Flux !< The surface buoyancy flux [Z2 s-3 ~> m2 s-3]. real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less !! than dt if there are two callse to !! mixedlayer, in s. @@ -295,12 +295,12 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, dimension(SZI_(G),SZK_(GV)) :: & dT_to_dColHt, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt, & ! and salinity changes within a layer, in Z K-1 ~> m K-1 and Z ppt-1 ~> m ppt-1. + dS_to_dColHt, & ! and salinity changes within a layer [Z K-1 ~> m K-1] and [Z ppt-1 ~> m ppt-1]. dT_to_dPE, & ! Partial derivatives of column potential energy with the temperature dS_to_dPE, & ! and salinity changes within a layer, in J m-2 K-1 and J m-2 ppt-1. dT_to_dColHt_a, & ! Partial derivatives of the total column height with the temperature dS_to_dColHt_a, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers higher in the water colun, in Z K-1 ~> m K-1 and Z ppt-1 ~> m ppt-1. + ! of mixing with layers higher in the water colun [Z K-1 ~> m K-1] and [Z ppt-1 ~> m ppt-1]. dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature dS_to_dPE_a ! and salinity changes within a layer, including the implicit effects ! of mixing with layers higher in the water column, in @@ -345,9 +345,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: dt_h ! The timestep divided by the averages of the thicknesses around ! a layer, times a thickness conversion factor, in H s m-2 ~> s m-1 or kg s m-4. real :: h_bot ! The distance from the bottom, in H ~> m or kg m-2. - real :: h_rsum ! The running sum of h from the top, in Z ~> m. + real :: h_rsum ! The running sum of h from the top [Z ~> m]. real :: I_hs ! The inverse of h_sum, in H-1 ~> m-1 or m2 kg-1. - real :: I_MLD ! The inverse of the current value of MLD, in Z-1 ~> m-1. + real :: I_MLD ! The inverse of the current value of MLD [Z-1 ~> m-1]. real :: h_tt ! The distance from the surface or up to the next interface ! that did not exhibit turbulent mixing from this scheme plus ! a surface mixing roughness length given by h_tt_min, in H ~> m or kg m-2. @@ -357,14 +357,14 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: vonKar ! The vonKarman constant. real :: I_dtrho ! 1.0 / (dt * Rho0) in m3 kg-1 s-1. This is ! used convert TKE back into ustar^3. - real :: U_star ! The surface friction velocity, in Z s-1 ~> m s-1. - real :: U_Star_Mean ! The surface friction without gustiness in Z s-1 ~> m s-1. + real :: U_star ! The surface friction velocity [Z s-1 ~> m s-1]. + real :: U_Star_Mean ! The surface friction without gustiness [Z s-1 ~> m s-1]. real :: vstar ! An in-situ turbulent velocity, in m s-1. real :: Enhance_M ! An enhancement factor for vstar, based here on Langmuir impact. real :: LA ! The Langmuir number (non-dim) real :: LAmod ! A modified Langmuir number accounting for other parameters. real :: hbs_here ! The local minimum of hb_hs and MixLen_shape, times a - ! conversion factor from H to Z, in Z H-1 ~> 1 or m3 kg-1. + ! conversion factor from H to Z [Z H-1 ~> 1 or m3 kg-1]. real :: nstar_FC ! The fraction of conv_PErel that can be converted to mixing, nondim. real :: TKE_reduc ! The fraction by which TKE and other energy fields are ! reduced to support mixing, nondim. between 0 and 1. @@ -383,7 +383,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: dPE_conv ! The convective change in column potential energy, in J m-2. real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K), in J m-2. real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K), in J m-2 H-1. - real :: Kd_guess0 ! A first guess of the diapycnal diffusivity, in Z2 s-1 ~> m2 s-1. + real :: Kd_guess0 ! A first guess of the diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 real :: dPEa_dKd_g0 real :: Kddt_h_g0 ! The first guess diapycnal diffusivity times a timestep divided @@ -416,7 +416,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: dt__diag ! A copy of dt_diag (if present) or dt, in s. real :: IdtdR0 ! = 1.0 / (dt__diag * Rho0), in m3 kg-1 s-1. real, dimension(SZI_(G),SZJ_(G)) :: & - Hsfc_used ! The thickness of the surface region in Z ~> m. + Hsfc_used ! The thickness of the surface region [Z ~> m]. logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. ! Local column copies of energy change diagnostics, all in J m-2. @@ -425,8 +425,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS !---------------------------------------------------------------------- !/BGR added Aug24,2016 for adding iteration to get boundary layer depth ! - needed to compute new mixing length. - real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration, in Z ~> m. - real :: max_MLD, min_MLD ! Iteration bounds, in Z ~> m, which are adjusted at each step + real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration [Z ~> m]. + real :: max_MLD, min_MLD ! Iteration bounds [Z ~> m], which are adjusted at each step ! - These are initialized based on surface/bottom ! 1. The iteration guesses a value (possibly from ! prev step or neighbor). @@ -476,9 +476,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: N2_dissipation real :: Bf_STABLE ! Buoyancy flux, capped at 0 (negative only) real :: Bf_UNSTABLE ! Buoyancy flux, floored at 0 (positive only) - real :: Stab_Scale ! Composite of stabilizing Ekman scale and Monin-Obukhov length scales, in Z ~> m. - real :: iL_Ekman ! Inverse of Ekman length scale, in Z-1 ~> m-1. - real :: iL_Obukhov ! Inverse of Obukhov length scale, in Z-1 ~> m-1. + real :: Stab_Scale ! Composite of stabilizing Ekman scale and Monin-Obukhov length scales [Z ~> m]. + real :: iL_Ekman ! Inverse of Ekman length scale [Z-1 ~> m-1]. + real :: iL_Obukhov ! Inverse of Obukhov length scale [Z-1 ~> m-1]. real :: MLD_o_Ekman ! > real :: MLD_o_Obukhov_stab ! Ratios of length scales where MLD is boundary layer depth real :: Ekman_o_Obukhov_stab ! > @@ -1603,19 +1603,19 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real, intent(in) :: dT_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers above, in Z K-1 ~> m K-1. + !! in the temperatures of all the layers above [Z K-1 ~> m K-1]. real, intent(in) :: dS_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers above, in Z ppt-1 ~> m ppt-1. + !! in the salinities of all the layers above [Z ppt-1 ~> m ppt-1]. real, intent(in) :: dT_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers below, in Z K-1 ~> m K-1. + !! in the temperatures of all the layers below [Z K-1 ~> m K-1]. real, intent(in) :: dS_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers below, in Z ppt-1 ~> m ppt-1. + !! in the salinities of all the layers below [Z ppt-1 ~> m ppt-1]. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying !! Kddt_h at the present interface, in J m-2. @@ -1742,19 +1742,19 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & real, intent(in) :: dT_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers below, in Z K-1 ~> m K-1. + !! in the temperatures of all the layers below [Z K-1 ~> m K-1]. real, intent(in) :: dS_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers below, in Z ppt-1 ~> m ppt-1. + !! in the salinities of all the layers below [Z ppt-1 ~> m ppt-1]. real, intent(in) :: dT_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers above, in Z K-1 ~> m K-1. + !! in the temperatures of all the layers above [Z K-1 ~> m K-1]. real, intent(in) :: dS_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes - !! in the salinities of all the layers above, in Z ppt-1 ~> m ppt-1. + !! in the salinities of all the layers above [Z ppt-1 ~> m ppt-1]. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying !! Kddt_h at the present interface, in J m-2. diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 1bb76ebca4..e5386237e5 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -79,11 +79,11 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, !! the buffer layer. ! At least one of the two following arguments must be present. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - optional, intent(in) :: Kd_Lay !< The diapycnal diffusivity of layers, - !! in Z2 s-1 ~> m2 s-1. + optional, intent(in) :: Kd_Lay !< The diapycnal diffusivity of layers + !! [Z2 s-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - optional, intent(in) :: Kd_int !< The diapycnal diffusivity of interfaces, - !! in Z2 s-1 ~> m2 s-1. + optional, intent(in) :: Kd_int !< The diapycnal diffusivity of interfaces + !! [Z2 s-1 ~> m2 s-1]. ! This subroutine calculates ea and eb, the rates at which a layer entrains ! from the layers above and below. The entrainment rates are proportional to diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 802f0fa1ee..4bae6f4998 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -52,7 +52,7 @@ module MOM_int_tide_input type, public :: int_tide_input_type real, allocatable, dimension(:,:) :: & TKE_itidal_input, & !< The internal tide TKE input at the bottom of the ocean, in W m-2. - h2, & !< The squared topographic roughness height, in Z2 ~> m2. + h2, & !< The squared topographic roughness height [Z2 ~> m2]. tideamp, & !< The amplitude of the tidal velocities, in m s-1. Nb !< The bottom stratification, in s-1. end type int_tide_input_type @@ -136,7 +136,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) !! smooth out the values in thin layers, in degC. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_f !< Salinity after vertical filtering to !! smooth out the values in thin layers, in PSU. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h2 !< Bottom topographic roughness, in Z2 ~> m2. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h2 !< Bottom topographic roughness [Z2 ~> m2]. type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes type(int_tide_input_CS), pointer :: CS !< This module's control structure. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: N2_bot !< The squared buoyancy freqency at the @@ -149,15 +149,15 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) Temp_int, & ! The temperature at each interface, in degC. Salin_int, & ! The salinity at each interface, in PSU. drho_bot, & - h_amp, & ! The amplitude of topographic roughness, in Z ~> m. - hb, & ! The depth below a layer, in Z ~> m. - z_from_bot, & ! The height of a layer center above the bottom, in Z ~> m. + h_amp, & ! The amplitude of topographic roughness [Z ~> m]. + hb, & ! The depth below a layer [Z ~> m]. + z_from_bot, & ! The height of a layer center above the bottom [Z ~> m]. dRho_dT, & ! The partial derivatives of density with temperature and dRho_dS ! salinity, in kg m-3 degC-1 and kg m-3 PSU-1. - real :: dz_int ! The thickness associated with an interface, in Z ~> m. + real :: dz_int ! The thickness associated with an interface [Z ~> m]. real :: G_Rho0 ! The gravitation acceleration divided by the Boussinesq - ! density, in Z m3 s-2 kg-1 ~> m4 s-2 kg-1. + ! density [Z m3 s-2 kg-1 ~> m4 s-2 kg-1]. logical :: do_i(SZI_(G)), do_any integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -264,7 +264,7 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) ! tidal amplitude file is not present. real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height. real :: kappa_itides ! topographic wavenumber and non-dimensional scaling - real :: min_zbot_itides ! Minimum ocean depth for internal tide conversion, in Z ~> m. + real :: min_zbot_itides ! Minimum ocean depth for internal tide conversion [Z ~> m]. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed if (associated(CS)) then diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 7c217e0e63..9a8a1cbea5 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -56,7 +56,7 @@ module MOM_kappa_shear !! the buoyancy and shear scales in the diffusivity !! equation, 0 to eliminate the shear scale. Nondim. real :: TKE_bg !< The background level of TKE, in m2 s-2. - real :: kappa_0 !< The background diapycnal diffusivity, in Z2 s-1 ~> m2 s-1. + real :: kappa_0 !< The background diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. real :: kappa_tol_err !< The fractional error in kappa that is tolerated. real :: Prandtl_turb !< Prandtl number used to convert Kd_shear into viscosity. integer :: nkml !< The number of layers in the mixed layer, as @@ -110,7 +110,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & !! (or NULL). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: kappa_io !< The diapycnal diffusivity at each interface - !! (not layer!) in Z2 s-1 ~> m2 s-1. Initially this is the + !! (not layer!) [Z2 s-1 ~> m2 s-1]. Initially this is the !! value from the previous timestep, which may !! accelerate the iteration toward convergence. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & @@ -121,7 +121,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & !! toward convergence. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: kv_io !< The vertical viscosity at each interface - !! (not layer!) in Z2 s-1 ~> m2 s-1. This discards any + !! (not layer!) [Z2 s-1 ~> m2 s-1]. This discards any !! previous value (i.e. it is intent out) and !! simply sets Kv = Prandtl * Kd_shear real, intent(in) :: dt !< Time increment, in s. @@ -139,27 +139,27 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & real, dimension(SZK_(GV)) :: & u, & ! The zonal velocity after a timestep of mixing, in m s-1. v, & ! The meridional velocity after a timestep of mixing, in m s-1. - Idz, & ! The inverse of the distance between TKE points, in Z-1 ~> m-1. + Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. T, & ! The potential temperature after a timestep of mixing, in C. Sal, & ! The salinity after a timestep of mixing, in psu. - dz, & ! The layer thickness, in Z ~> m. - u0xdz, & ! The initial zonal velocity times dz, in Z m s-1 ~> m2 s-1. - v0xdz, & ! The initial meridional velocity times dz, in Z m s-1 ~> m2 s-1. - T0xdz, & ! The initial temperature times dz, in C Z ~> C m. - S0xdz ! The initial salinity times dz, in PSU Z ~> PSU m. + dz, & ! The layer thickness [Z ~> m]. + u0xdz, & ! The initial zonal velocity times dz [Z m s-1 ~> m2 s-1]. + v0xdz, & ! The initial meridional velocity times dz [Z m s-1 ~> m2 s-1]. + T0xdz, & ! The initial temperature times dz [degC Z ~> degC m]. + S0xdz ! The initial salinity times dz [PSU Z ~> PSU m]. real, dimension(SZK_(GV)+1) :: & kappa, & ! The shear-driven diapycnal diffusivity at an interface, in ! units of Z2 s-1 ~> m2 s-1. tke, & ! The Turbulent Kinetic Energy per unit mass at an interface, ! in units of m2 s-2. - kappa_avg, & ! The time-weighted average of kappa, in Z2 s-1 ~> m2 s-1. + kappa_avg, & ! The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. tke_avg ! The time-weighted average of TKE, in m2 s-2. real :: f2 ! The squared Coriolis parameter of each column, in s-2. real :: surface_pres ! The top surface pressure, in Pa. - real :: dz_in_lay ! The running sum of the thickness in a layer, in Z ~> m. - real :: k0dt ! The background diffusivity times the timestep, in Z2 ~> m2. - real :: dz_massless ! A layer thickness that is considered massless, in Z ~> m. + real :: dz_in_lay ! The running sum of the thickness in a layer [Z ~> m]. + real :: k0dt ! The background diffusivity times the timestep [Z2 ~> m2]. + real :: dz_massless ! A layer thickness that is considered massless [Z ~> m]. logical :: use_temperature ! If true, temperature and salinity have been ! allocated and are being used as state variables. logical :: new_kappa = .true. ! If true, ignore the value of kappa from the @@ -403,7 +403,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ !! (or NULL). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: kappa_io !< The diapycnal diffusivity at each interface - !! (not layer!) in Z2 s-1 ~> m2 s-1. + !! (not layer!) [Z2 s-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & intent(inout) :: tke_io !< The turbulent kinetic energy per unit mass at !! each interface (not layer!) in m2 s-2. @@ -411,7 +411,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ !! timestep, which may accelerate the iteration !! toward convergence. real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & - intent(inout) :: kv_io !< The vertical viscosity at each interface in Z2 s-1 ~> m2 s-1. + intent(inout) :: kv_io !< The vertical viscosity at each interface [Z2 s-1 ~> m2 s-1]. !! The previous value is used to initialize kappa !! in the vertex columes as Kappa = Kv/Prandtl !! to accelerate the iteration toward covergence. @@ -426,16 +426,16 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ h_2d, & ! A 2-D version of h, but converted to m. u_2d, v_2d, T_2d, S_2d, rho_2d ! 2-D versions of u_in, v_in, T, S, and rho. real, dimension(SZIB_(G),SZK_(GV)+1,2) :: & - kappa_2d ! Quasi 2-D versions of kappa_io, in Z2 s-1 ~> m2 s-1. + kappa_2d ! Quasi 2-D versions of kappa_io [Z2 s-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZK_(GV)+1) :: & tke_2d ! 2-D version tke_io in m2 s-2. real, dimension(SZK_(GV)) :: & u, & ! The zonal velocity after a timestep of mixing, in m s-1. v, & ! The meridional velocity after a timestep of mixing, in m s-1. - Idz, & ! The inverse of the distance between TKE points, in Z-1 ~> m-1. + Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. T, & ! The potential temperature after a timestep of mixing, in C. Sal, & ! The salinity after a timestep of mixing, in psu. - dz, & ! The layer thickness, in Z ~> m. + dz, & ! The layer thickness [Z ~> m]. u0xdz, & ! The initial zonal velocity times dz, in m Z s-1. v0xdz, & ! The initial meridional velocity times dz, in m Z s-1. T0xdz, & ! The initial temperature times dz, in C Z. @@ -445,14 +445,14 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! units of m2 s-1. tke, & ! The Turbulent Kinetic Energy per unit mass at an interface, ! in units of m2 s-2. - kappa_avg, & ! The time-weighted average of kappa, in Z2 s-1 ~> m2 s-1. + kappa_avg, & ! The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. tke_avg ! The time-weighted average of TKE, in m2 s-2. real :: f2 ! The squared Coriolis parameter of each column, in s-2. real :: surface_pres ! The top surface pressure, in Pa. - real :: dz_in_lay ! The running sum of the thickness in a layer, in Z ~> m. - real :: k0dt ! The background diffusivity times the timestep, in Z2 ~> m2. - real :: dz_massless ! A layer thickness that is considered massless, in Z ~> m. + real :: dz_in_lay ! The running sum of the thickness in a layer [Z ~> m]. + real :: k0dt ! The background diffusivity times the timestep [Z2 ~> m2]. + real :: dz_massless ! A layer thickness that is considered massless [Z ~> m]. real :: I_hwt ! The inverse of the masked thickness weights, in H-1 ~> m-1 or m2 kg-1. real :: I_Prandtl logical :: use_temperature ! If true, temperature and salinity have been @@ -719,7 +719,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)+1), & - intent(inout) :: kappa !< The time-weighted average of kappa, in Z2 s-1 ~> m2 s-1. + intent(inout) :: kappa !< The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. real, dimension(SZK_(GV)+1), & intent(inout) :: tke !< The Turbulent Kinetic Energy per unit mass at !! an interface, in units of m2 s-2. @@ -727,17 +727,17 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real, intent(in) :: f2 !< The square of the Coriolis parameter, in s-2. real, intent(in) :: surface_pres !< The surface pressure, in Pa. real, dimension(SZK_(GV)), & - intent(in) :: dz !< The layer thickness, in Z ~> m. + intent(in) :: dz !< The layer thickness [Z ~> m]. real, dimension(SZK_(GV)), & - intent(in) :: u0xdz !< The initial zonal velocity times dz, in Z m s-1 ~> m2 s-1. + intent(in) :: u0xdz !< The initial zonal velocity times dz [Z m s-1 ~> m2 s-1]. real, dimension(SZK_(GV)), & - intent(in) :: v0xdz !< The initial meridional velocity times dz, in Z m s-1 ~> m2 s-1. + intent(in) :: v0xdz !< The initial meridional velocity times dz [Z m s-1 ~> m2 s-1]. real, dimension(SZK_(GV)), & intent(in) :: T0xdz !< The initial temperature times dz, in C Z ~> C m. real, dimension(SZK_(GV)), & intent(in) :: S0xdz !< The initial salinity times dz, in PSU Z ~> PSU m. real, dimension(SZK_(GV)+1), & - intent(out) :: kappa_avg !< The time-weighted average of kappa, in Z2 s-1 ~> m2 s-1. + intent(out) :: kappa_avg !< The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. real, dimension(SZK_(GV)+1), & intent(out) :: tke_avg !< The time-weighted average of TKE, in m2 s-2. real, intent(in) :: dt !< Time increment, in s. @@ -750,7 +750,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real, dimension(nzc) :: & u, & ! The zonal velocity after a timestep of mixing, in m s-1. v, & ! The meridional velocity after a timestep of mixing, in m s-1. - Idz, & ! The inverse of the distance between TKE points, in Z-1 ~> m-1. + Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. T, & ! The potential temperature after a timestep of mixing, in C. Sal, & ! The salinity after a timestep of mixing, in psu. u_test, v_test, T_test, S_test @@ -758,46 +758,46 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real, dimension(nzc+1) :: & N2, & ! The squared buoyancy frequency at an interface, in s-2. dz_Int, & ! The extent of a finite-volume space surrounding an interface, - ! as used in calculating kappa and TKE, in Z ~> m. + ! as used in calculating kappa and TKE [Z ~> m]. I_dz_int, & ! The inverse of the distance between velocity & density points - ! above and below an interface, in Z-1 ~> m-1. This is used to + ! above and below an interface [Z-1 ~> m-1]. This is used to ! calculate N2, shear, and fluxes, and it might differ from ! 1/dz_Int, as they have different uses. S2, & ! The squared shear at an interface, in s-2. a1, & ! a1 is the coupling between adjacent interfaces in the TKE, - ! velocity, and density equations, in Z s-1 or Z ~> m s-1 or m. + ! velocity, and density equations [Z s-1 ~> m s-1] or [Z ~> m] c1, & ! c1 is used in the tridiagonal (and similar) solvers. k_src, & ! The shear-dependent source term in the kappa equation, in s-1. kappa_src, & ! The shear-dependent source term in the kappa equation in s-1. - kappa_out, & ! The kappa that results from the kappa equation, in Z2 s-1 ~> m2 s-1. + kappa_out, & ! The kappa that results from the kappa equation [Z2 s-1 ~> m2 s-1]. kappa_mid, & ! The average of the initial and predictor estimates of kappa, ! in units of Z2 s-1. tke_pred, & ! The value of TKE from a predictor step, in m2 s-2. - kappa_pred, & ! The value of kappa from a predictor step, in Z2 s-1 ~> m2 s-1. + kappa_pred, & ! The value of kappa from a predictor step [Z2 s-1 ~> m2 s-1]. pressure, & ! The pressure at an interface, in Pa. T_int, & ! The temperature interpolated to an interface, in C. Sal_int, & ! The salinity interpolated to an interface, in psu. dbuoy_dT, & ! The partial derivatives of buoyancy with changes in temperature - dbuoy_dS, & ! and salinity, in Z s-2 K-1 ~> m s-2 K-1 and Z s-2 psu-1 ~> m s-2 psu-1. + dbuoy_dS, & ! and salinity, [Z s-2 K-1 ~> m s-2 K-1] and [Z s-2 psu-1 ~> m s-2 psu-1]. I_L2_bdry, & ! The inverse of the square of twice the harmonic mean - ! distance to the top and bottom boundaries, in Z-2 ~> m-2. - K_Q, & ! Diffusivity divided by TKE, in Z2 m-2 s ~> s. - K_Q_tmp, & ! A temporary copy of diffusivity divided by TKE, in Z2 m-2 s ~> s. + ! distance to the top and bottom boundaries [Z-2 ~> m-2]. + K_Q, & ! Diffusivity divided by TKE [Z2 m-2 s ~> s]. + K_Q_tmp, & ! A temporary copy of diffusivity divided by TKE [Z2 m-2 s ~> s]. local_src_avg, & ! The time-integral of the local source, nondim. tol_min, & ! Minimum tolerated ksrc for the corrector step, in s-1. tol_max, & ! Maximum tolerated ksrc for the corrector step, in s-1. tol_chg, & ! The tolerated change integrated in time, nondim. - dist_from_top, & ! The distance from the top surface, in Z ~> m. + dist_from_top, & ! The distance from the top surface [Z ~> m]. local_src ! The sum of all sources of kappa, including kappa_src and ! sources from the elliptic term, in s-1. - real :: dist_from_bot ! The distance from the bottom surface, in Z ~> m. + real :: dist_from_bot ! The distance from the bottom surface [Z ~> m]. real :: b1 ! The inverse of the pivot in the tridiagonal equations. real :: bd1 ! A term in the denominator of b1. real :: d1 ! 1 - c1 in the tridiagonal equations. real :: gR0 ! Rho_0 times g in kg m-2 s-2. - real :: g_R0 ! g_R0 is g/Rho in Z m3 kg-1 s-2 ~> m4 kg-1 s-2. - real :: Norm ! A factor that normalizes two weights to 1, in Z-2 ~> m-2. + real :: g_R0 ! g_R0 is g/Rho [Z m3 kg-1 s-2 ~> m4 kg-1 s-2]. + real :: Norm ! A factor that normalizes two weights to 1 [Z-2 ~> m-2]. real :: tol_dksrc, tol2 ! ### Tolerances that need to be set better later. real :: tol_dksrc_low ! The tolerance for the fractional decrease in ksrc ! within an iteration. 0 < tol_dksrc_low < 1. @@ -811,7 +811,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real :: Idtt ! Idtt = 1 / dt_test, in s-1. real :: dt_inc ! An increment to dt_test that is being tested, in s. - real :: k0dt ! The background diffusivity times the timestep, in Z2 ~> m2. + real :: k0dt ! The background diffusivity times the timestep [Z2 ~> m2]. logical :: valid_dt ! If true, all levels so far exhibit acceptably small ! changes in k_src. logical :: use_temperature ! If true, temperature and salinity have been @@ -1239,18 +1239,18 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & integer, intent(in) :: nz !< The number of layers (after eliminating massless !! layers?). real, dimension(nz+1), intent(in) :: kappa !< The diapycnal diffusivity at interfaces, - !! in Z2 s-1 ~> m2 s-1. + !! [Z2 s-1 ~> m2 s-1]. real, dimension(nz), intent(in) :: u0 !< The initial zonal velocity, in m s-1. real, dimension(nz), intent(in) :: v0 !< The initial meridional velocity, in m s-1. real, dimension(nz), intent(in) :: T0 !< The initial temperature, in C. real, dimension(nz), intent(in) :: S0 !< The initial salinity, in PSU. - real, dimension(nz), intent(in) :: dz !< The grid spacing of layers, in Z ~> m. - real, dimension(nz+1), intent(in) :: I_dz_int !< The inverse of the layer's thicknesses, - !! in Z-1 ~> m-1. + real, dimension(nz), intent(in) :: dz !< The grid spacing of layers [Z ~> m]. + real, dimension(nz+1), intent(in) :: I_dz_int !< The inverse of the layer's thicknesses + !! [Z-1 ~> m-1]. real, dimension(nz+1), intent(in) :: dbuoy_dT !< The partial derivative of buoyancy with - !! temperature, in Z s-2 C-1 ~> m s-2 C-1. + !! temperature [Z s-2 C-1 ~> m s-2 C-1]. real, dimension(nz+1), intent(in) :: dbuoy_dS !< The partial derivative of buoyancy with - !! salinity, in Z s-2 PSU-1 ~> m s-2 PSU-1. + !! salinity [Z s-2 PSU-1 ~> m s-2 PSU-1]. real, intent(in) :: dt !< The time step in s. real, dimension(nz), intent(inout) :: u !< The zonal velocity after dt, in m s-1. real, dimension(nz), intent(inout) :: v !< The meridional velocity after dt, in m s-1. @@ -1273,7 +1273,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & ! Local variables real, dimension(nz+1) :: c1 real :: L2_to_Z2 ! A conversion factor from horizontal length units to vertical depth - ! units squared, in Z2 m-2 ~> 1. + ! units squared [Z2 m-2 ~> 1]. real :: underflow_vel ! Velocities smaller in magnitude than underflow_vel are set to 0, in m s-1. real :: a_a, a_b, b1, d1, bd1, b1nz_0 integer :: k, ks, ke @@ -1378,13 +1378,13 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real, dimension(nz+1), intent(in) :: N2 !< The buoyancy frequency squared at interfaces, !! in s-2. real, dimension(nz+1), intent(in) :: S2 !< The squared shear at interfaces, in s-2. - real, dimension(nz+1), intent(in) :: kappa_in !< The initial guess at the diffusivity, - !! in Z2 s-1 ~> m2 s-1. - real, dimension(nz+1), intent(in) :: dz_Int !< The thicknesses associated with interfaces, - !! in Z-1 ~> m-1. + real, dimension(nz+1), intent(in) :: kappa_in !< The initial guess at the diffusivity + !! [Z2 s-1 ~> m2 s-1]. + real, dimension(nz+1), intent(in) :: dz_Int !< The thicknesses associated with interfaces + !! [Z-1 ~> m-1]. real, dimension(nz+1), intent(in) :: I_L2_bdry !< The inverse of the squared distance to !! boundaries, m2. - real, dimension(nz), intent(in) :: Idz !< The inverse grid spacing of layers, in Z-1 ~> m-1. + real, dimension(nz), intent(in) :: Idz !< The inverse grid spacing of layers [Z-1 ~> m-1]. real, intent(in) :: f2 !< The squared Coriolis parameter, in s-2. type(Kappa_shear_CS), pointer :: CS !< A pointer to this module's control structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -1394,8 +1394,8 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & !! interfaces, in s. real, dimension(nz+1), intent(out) :: tke !< The turbulent kinetic energy per unit mass at !! interfaces, in units of m2 s-2. - real, dimension(nz+1), intent(out) :: kappa !< The diapycnal diffusivity at interfaces, - !! in Z2 s-1 ~> m2 s-1. + real, dimension(nz+1), intent(out) :: kappa !< The diapycnal diffusivity at interfaces + !! [Z2 s-1 ~> m2 s-1]. real, dimension(nz+1), optional, & intent(out) :: kappa_src !< The source term for kappa, in s-1. real, dimension(nz+1), optional, & @@ -1409,7 +1409,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! equations, in m s-1. dQdz ! Half the partial derivative of TKE with depth, m s-2. real, dimension(nz+1) :: & - dK, & ! The change in kappa, in Z2 s-1 ~> m2 s-1. + dK, & ! The change in kappa [Z2 s-1 ~> m2 s-1]. dQ, & ! The change in TKE, in m2 s-2. cQ, cK, & ! cQ and cK are the upward influences in the tridiagonal and ! hexadiagonal solvers for the TKE and kappa equations, ND. @@ -1426,7 +1426,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! and stratification, in m2 s-3. (For convenience, ! a term involving the non-dissipation of q0 is also ! included here.) - real :: bQ, bK ! The inverse of the pivot in the tridiagonal equations, in Z-1 ~> m-1. + real :: bQ, bK ! The inverse of the pivot in the tridiagonal equations [Z-1 ~> m-1]. real :: bd1 ! A term in the denominator of bQ or bK. real :: cQcomp, cKcomp ! 1 - cQ or 1 - cK in the tridiagonal equations. real :: c_s2 ! The coefficient for the decay of TKE due to @@ -1439,7 +1439,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real :: Ilambda2 ! 1.0 / CS%lambda**2. real :: TKE_min ! The minimum value of shear-driven TKE that can be ! solved for, in m2 s-2. - real :: kappa0 ! The background diapycnal diffusivity, in Z2 s-1 ~> m2 s-1. + real :: kappa0 ! The background diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. real :: max_err ! The maximum value of norm_err in a column, nondim. real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0, Z2 s-1. @@ -1448,7 +1448,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real :: chg_by_k0 ! The value of k_src that leads to an increase of ! kappa_0 if only the diffusive term is a sink, in s-1. - real :: kappa_mean ! A mean value of kappa, in Z2 s-1 ~> m2 s-1. + real :: kappa_mean ! A mean value of kappa [Z2 s-1 ~> m2 s-1]. real :: Newton_test ! The value of relative error that will cause the next ! iteration to use Newton's method. ! Temporary variables used in the Newton's method iterations. @@ -1483,7 +1483,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & integer :: max_debug_itt ; parameter(max_debug_itt=20) real :: K_err_lin, Q_err_lin real, dimension(nz+1) :: & - kappa_prev, & ! The value of kappa at the start of the current iteration, in Z2 s-1 ~> m2 s-1. + kappa_prev, & ! The value of kappa at the start of the current iteration [Z2 s-1 ~> m2 s-1]. TKE_prev ! The value of TKE at the start of the current iteration, in m2 s-2. real, dimension(nz+1,1:max_debug_itt) :: & tke_it1, kappa_it1, kprev_it1, & ! Various values from each iteration. @@ -1582,7 +1582,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! terms. ke_tke = max(ke_kappa,ke_kappa_prev)+1 - ! aQ is the coupling between adjacent interfaces in Z s-1 ~> m s-1. + ! aQ is the coupling between adjacent interfaces [Z s-1 ~> m s-1]. do k=1,min(ke_tke,nz) aQ(k) = (0.5*(kappa(K)+kappa(K+1)) + kappa0) * Idz(k) enddo diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 360cdf2223..150554bca2 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -74,15 +74,15 @@ module MOM_set_diffusivity !! by bottom drag drives BBL diffusion (nondim) real :: cdrag !< quadratic drag coefficient (nondim) real :: IMax_decay !< inverse of a maximum decay scale for - !! bottom-drag driven turbulence, in Z-1 ~> m-1. - real :: Kv !< The interior vertical viscosity, in Z2 s-1 ~> m2 s-1. - real :: Kd !< interior diapycnal diffusivity, in Z2 s-1 ~> m2 s-1. - real :: Kd_min !< minimum diapycnal diffusivity, in Z2 s-1 ~> m2 s-1. - real :: Kd_max !< maximum increment for diapycnal diffusivity, in Z2 s-1 ~> m2 s-1. + !! bottom-drag driven turbulence [Z-1 ~> m-1]. + real :: Kv !< The interior vertical viscosity [Z2 s-1 ~> m2 s-1]. + real :: Kd !< interior diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. + real :: Kd_min !< minimum diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. + real :: Kd_max !< maximum increment for diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. !! Set to a negative value to have no limit. real :: Kd_add !< uniform diffusivity added everywhere without - !! filtering or scaling, in Z2 s-1 ~> m2 s-1. - real :: Kdml !< mixed layer diapycnal diffusivity, in Z2 s-1 ~> m2 s-1. + !! filtering or scaling [Z2 s-1 ~> m2 s-1]. + real :: Kdml !< mixed layer diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. !! when bulkmixedlayer==.false. real :: Hmix !< mixed layer thickness (meter) when !! bulkmixedlayer==.false. @@ -94,7 +94,7 @@ module MOM_set_diffusivity real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N (Z2 m-2 W m-3 ~> W m-3) real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N (Z2 m-2 W m-3 s ~> J m-3) real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 (Z2 m-2 W m-3 s2 ~> J s m-3) - real :: dissip_Kd_min !< Minimum Kd, in Z2 s-1 ~> m2 s-1, with dissipation Rho0*Kd_min*N^2 + real :: dissip_Kd_min !< Minimum Kd [Z2 s-1 ~> m2 s-1], with dissipation Rho0*Kd_min*N^2 real :: TKE_itide_max !< maximum internal tide conversion (W m-2) !! available to mix above the BBL @@ -113,7 +113,7 @@ module MOM_set_diffusivity !! where N2 is the squared buoyancy frequency (s-2) and OMEGA2 !! is the rotation rate of the earth squared. real :: ML_rad_kd_max !< Maximum diapycnal diffusivity due to turbulence - !! radiated from the base of the mixed layer, in Z2 s-1 ~> m2 s-1. + !! radiated from the base of the mixed layer [Z2 s-1 ~> m2 s-1]. real :: ML_rad_efold_coeff !< non-dim coefficient to scale penetration depth real :: ML_rad_coeff !< coefficient, which scales MSTAR*USTAR^3 to !! obtain energy available for mixing below @@ -122,7 +122,7 @@ module MOM_set_diffusivity !! to ML_rad as applied to the other surface !! sources of TKE in the mixed layer code. real :: ustar_min !< A minimum value of ustar to avoid numerical - !! problems, in Z s-1 ~> m s-1. If the value is small enough, + !! problems [Z s-1 ~> m s-1]. If the value is small enough, !! this parameter should not affect the solution. real :: TKE_decay !< ratio of natural Ekman depth to TKE decay scale (nondim) real :: mstar !< ratio of friction velocity cubed to @@ -176,12 +176,12 @@ module MOM_set_diffusivity Kd_BBL => NULL(), & !< BBL diffusivity at interfaces (m2/s) Kd_work => NULL(), & !< layer integrated work by diapycnal mixing (W/m2) maxTKE => NULL(), & !< energy required to entrain to h_max (m3/s3) - KT_extra => NULL(), & !< double diffusion diffusivity for temp, in Z2 s-1 ~> m2 s-1. - KS_extra => NULL() !< double diffusion diffusivity for saln, in Z2 s-1 ~> m2 s-1. + KT_extra => NULL(), & !< double diffusion diffusivity for temp [Z2 s-1 ~> m2 s-1]. + KS_extra => NULL() !< double diffusion diffusivity for saln [Z2 s-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: TKE_to_Kd => NULL() !< conversion rate (~1.0 / (G_Earth + dRho_lay)) between TKE - !! dissipated within a layer and Kd in that layer, - !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1 + !! dissipated within a layer and Kd in that layer + !! [Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1] end type diffusivity_diags @@ -683,8 +683,8 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & real, dimension(SZI_(G),SZK_(G)), intent(out) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, - !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1 + !! usually (~Rho_0 / (G_Earth * dRho_lay)) + !! [Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1] real, dimension(SZI_(G),SZK_(G)), intent(out) :: maxTKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness, in m3 s-3 integer, dimension(SZI_(G)), intent(out) :: kb !< Index of lightest layer denser than the buffer @@ -701,19 +701,19 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & maxEnt ! maxEnt is the maximum value of entrainment from below (with ! compensating entrainment from above to keep the layer ! density from changing) that will not deplete all of the - ! layers above or below a layer within a timestep, in Z ~> m. + ! layers above or below a layer within a timestep [Z ~> m]. real, dimension(SZI_(G)) :: & htot, & ! total thickness above or below a layer, or the - ! integrated thickness in the BBL, in Z ~> m. + ! integrated thickness in the BBL [Z ~> m]. mFkb, & ! total thickness in the mixed and buffer layers - ! times ds_dsp1, in Z ~> m. + ! times ds_dsp1 [Z ~> m]. p_ref, & ! array of tv%P_Ref pressures Rcv_kmb, & ! coordinate density in the lowest buffer layer p_0 ! An array of 0 pressures real :: dh_max ! maximum amount of entrainment a layer could ! undergo before entraining all fluid in the layers - ! above or below, in Z ~> m. + ! above or below [Z ~> m]. real :: dRho_lay ! density change across a layer (kg/m3) real :: Omega2 ! rotation rate squared (1/s2) real :: G_Rho0 ! gravitation accel divided by Bouss ref density (m4 s-2 kg-1) @@ -905,14 +905,14 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & Temp_int, & ! temperature at each interface (degC) Salin_int, & ! salinity at each interface (PPT) drho_bot, & - h_amp, & ! The topographic roughness amplitude, in Z ~> m. - hb, & ! The thickness of the bottom layer, in Z ~> m. - z_from_bot ! The hieght above the bottom, in Z ~> m. + h_amp, & ! The topographic roughness amplitude [Z ~> m]. + hb, & ! The thickness of the bottom layer [Z ~> m]. + z_from_bot ! The hieght above the bottom [Z ~> m]. real :: Rml_base ! density of the deepest variable density layer - real :: dz_int ! thickness associated with an interface, in Z ~> m. + real :: dz_int ! thickness associated with an interface [Z ~> m]. real :: G_Rho0 ! gravitation acceleration divided by Bouss reference density - ! times some unit conversion factors, in Z m3 s-2 kg-1 ~> m4 s-2 kg-1. + ! times some unit conversion factors [Z m3 s-2 kg-1 ~> m4 s-2 kg-1]. real :: H_neglect ! negligibly small thickness, in the same units as h. logical :: do_i(SZI_(G)), do_any @@ -1062,10 +1062,10 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) type(set_diffusivity_CS), pointer :: CS !< Module control structure. real, dimension(SZI_(G),SZK_(G)+1), & intent(out) :: Kd_T_dd !< Interface double diffusion diapycnal - !! diffusivity for temp, in Z2 s-1 ~> m2 s-1. + !! diffusivity for temp [Z2 s-1 ~> m2 s-1]. real, dimension(SZI_(G),SZK_(G)+1), & intent(out) :: Kd_S_dd !< Interface double diffusion diapycnal - !! diffusivity for saln, in Z2 s-1 ~> m2 s-1. + !! diffusivity for saln [Z2 s-1 ~> m2 s-1]. real, dimension(SZI_(G)) :: & dRho_dT, & ! partial derivatives of density wrt temp (kg m-3 degC-1) @@ -1079,12 +1079,12 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) real :: Rrho ! vertical density ratio real :: diff_dd ! factor for double-diffusion (nondim) - real :: Kd_dd ! The dominant double diffusive diffusivity, in Z2 s-1 ~> m2 s-1 + real :: Kd_dd ! The dominant double diffusive diffusivity [Z2 s-1 ~> m2 s-1] real :: prandtl ! flux ratio for diffusive convection regime real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio - real :: dsfmax ! max diffusivity in case of salt fingering, in Z2 s-1 ~> m2 s-1 - real :: Kv_molecular ! molecular viscosity, in Z2 s-1 ~> m2 s-1 + real :: dsfmax ! max diffusivity in case of salt fingering [Z2 s-1 ~> m2 s-1] + real :: Kv_molecular ! molecular viscosity [Z2 s-1 ~> m2 s-1] integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke @@ -1153,8 +1153,8 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, - !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1. + !! usually (~Rho_0 / (G_Earth * dRho_lay)) + !! [Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1] real, dimension(SZI_(G),SZK_(G)), intent(in) :: maxTKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness, in m3 s-3 integer, dimension(SZI_(G)), intent(in) :: kb !< Index of lightest layer denser than the buffer @@ -1162,11 +1162,11 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, - !! in Z2 s-1 ~> m2 s-1. + !! [Z2 s-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, - !! in Z2 s-1 ~> m2 s-1. - real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity, in Z2 s-1 ~> m2 s-1. + !! [Z2 s-1 ~> m2 s-1]. + real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity [Z2 s-1 ~> m2 s-1]. ! This routine adds diffusion sustained by flow energy extracted by bottom drag. @@ -1174,25 +1174,25 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & Rint ! coordinate density of an interface (kg/m3) real, dimension(SZI_(G)) :: & htot, & ! total thickness above or below a layer, or the - ! integrated thickness in the BBL, in Z ~> m. + ! integrated thickness in the BBL [Z ~> m]. rho_htot, & ! running integral with depth of density (Z kg/m3) gh_sum_top, & ! BBL value of g'h that can be supported by ! the local ustar, times R0_g (kg/m2) Rho_top, & ! density at top of the BBL (kg/m3) TKE, & ! turbulent kinetic energy available to drive ! bottom-boundary layer mixing in a layer (m3/s3) - I2decay ! inverse of twice the TKE decay scale, in Z-1 ~> m-1. + I2decay ! inverse of twice the TKE decay scale [Z-1 ~> m-1]. real :: TKE_to_layer ! TKE used to drive mixing in a layer (m3/s3) real :: TKE_Ray ! TKE from layer Rayleigh drag used to drive mixing in layer (m3/s3) real :: TKE_here ! TKE that goes into mixing in this layer (m3/s3) real :: dRl, dRbot ! temporaries holding density differences (kg/m3) real :: cdrag_sqrt ! square root of the drag coefficient (nondimensional) - real :: ustar_h ! value of ustar at a thickness point, in Z s-1 ~> m s-1. + real :: ustar_h ! value of ustar at a thickness point [Z s-1 ~> m s-1]. real :: absf ! average absolute Coriolis parameter around a thickness point (1/s) real :: R0_g ! Rho0 / G_Earth (kg s2 Z-1 m-4) real :: I_rho0 ! 1 / RHO0 - real :: delta_Kd ! increment to Kd from the bottom boundary layer mixing, in Z2 s-1 ~> m2 s-1. + real :: delta_Kd ! increment to Kd from the bottom boundary layer mixing [Z2 s-1 ~> m2 s-1]. logical :: Rayleigh_drag ! Set to true if Rayleigh drag velocities ! defined in visc, on the assumption that this ! extracted energy also drives diapycnal mixing. @@ -1404,17 +1404,17 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & real :: TKE_consumed ! TKE used for mixing in this layer (m3 s-3) real :: TKE_Kd_wall ! TKE associated with unlimited law of the wall mixing (m3 s-3) real :: cdrag_sqrt ! square root of the drag coefficient (nondimensional) - real :: ustar ! value of ustar at a thickness point, in Z s-1 ~> m s-1. + real :: ustar ! value of ustar at a thickness point [Z s-1 ~> m s-1]. real :: ustar2 ! square of ustar, for convenience (Z2/s2) real :: absf ! average absolute value of Coriolis parameter around a thickness point (1/sec) - real :: dh, dhm1 ! thickness of layers k and k-1, respecitvely, in Z ~> m. - real :: z_bot ! distance to interface k from bottom, in Z ~> m. - real :: D_minus_z ! distance to interface k from surface, in Z ~> m. - real :: total_thickness ! total thickness of water column, in Z ~> m. - real :: Idecay ! inverse of decay scale used for "Joule heating" loss of TKE with height, in Z-1 ~> m-1. - real :: Kd_wall ! Law of the wall diffusivity, in Z2 s-1 ~> m2 s-1. + real :: dh, dhm1 ! thickness of layers k and k-1, respecitvely [Z ~> m]. + real :: z_bot ! distance to interface k from bottom [Z ~> m]. + real :: D_minus_z ! distance to interface k from surface [Z ~> m]. + real :: total_thickness ! total thickness of water column [Z ~> m]. + real :: Idecay ! inverse of decay scale used for "Joule heating" loss of TKE with height [Z-1 ~> m-1]. + real :: Kd_wall ! Law of the wall diffusivity [Z2 s-1 ~> m2 s-1]. real :: Kd_lower ! diffusivity for lower interface (Z2/sec) - real :: ustar_D ! u* x D , in Z2 s-1 ~> m2 s-1. + real :: ustar_D ! u* x D [Z2 s-1 ~> m2 s-1]. real :: I_Rho0 ! 1 / rho0 real :: N2_min ! Minimum value of N2 to use in calculation of TKE_Kd_wall (1/s2) logical :: Rayleigh_drag ! Set to true if there are Rayleigh drag velocities defined in visc, on @@ -1472,9 +1472,9 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! Work upwards from the bottom, accumulating work used until it exceeds the available TKE input ! at the bottom. do k=G%ke,2,-1 - dh = GV%H_to_Z * h(i,j,k) ! Thickness of this level in Z ~> m. + dh = GV%H_to_Z * h(i,j,k) ! Thickness of this level [Z ~> m]. km1 = max(k-1, 1) - dhm1 = GV%H_to_Z * h(i,j,km1) ! Thickness of level above in Z ~> m. + dhm1 = GV%H_to_Z * h(i,j,km1) ! Thickness of level above [Z ~> m]. ! Add in additional energy input from bottom-drag against slopes (sides) if (Rayleigh_drag) TKE_remaining = TKE_remaining + & @@ -1488,7 +1488,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! This is energy loss in addition to work done as mixing, apparently to Joule heating. TKE_remaining = exp(-Idecay*dh) * TKE_remaining - z_bot = z_bot + h(i,j,k)*GV%H_to_Z ! Distance between upper interface of layer and the bottom, in Z ~> m. + z_bot = z_bot + h(i,j,k)*GV%H_to_Z ! Distance between upper interface of layer and the bottom [Z ~> m]. D_minus_z = max(total_thickness - z_bot, 0.) ! Thickness above layer, Z. ! Diffusivity using law of the wall, limited by rotation, at height z, in m2/s. @@ -1541,35 +1541,35 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, type(forcing), intent(in) :: fluxes !< Surface fluxes structure type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1 ~> m2 s-1. + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers [Z2 s-1 ~> m2 s-1]. integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, - !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1 + !! usually (~Rho_0 / (G_Earth * dRho_lay)) + !! [Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, - !! in Z2 s-1 ~> m2 s-1. + optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces + !! [Z2 s-1 ~> m2 s-1]. ! This routine adds effects of mixed layer radiation to the layer diffusivities. - real, dimension(SZI_(G)) :: h_ml ! Mixed layer thickness, in Z ~> m. + real, dimension(SZI_(G)) :: h_ml ! Mixed layer thickness [Z ~> m]. real, dimension(SZI_(G)) :: TKE_ml_flux - real, dimension(SZI_(G)) :: I_decay ! A decay rate in Z-1 ~> m-1. - real, dimension(SZI_(G)) :: Kd_mlr_ml ! Diffusivities associated with mixed layer radiation, in Z2 s-1 ~> m2 s-1. + real, dimension(SZI_(G)) :: I_decay ! A decay rate [Z-1 ~> m-1]. + real, dimension(SZI_(G)) :: Kd_mlr_ml ! Diffusivities associated with mixed layer radiation [Z2 s-1 ~> m2 s-1]. real :: f_sq ! The square of the local Coriolis parameter or a related variable, in s-2. - real :: h_ml_sq ! The square of the mixed layer thickness, in Z2 ~> m2. - real :: ustar_sq ! ustar squared in Z2 s-2 ~> m2 s-2. - real :: Kd_mlr ! A diffusivity associated with mixed layer turbulence radiation, in Z2 s-1 ~> m2 s-1. + real :: h_ml_sq ! The square of the mixed layer thickness [Z2 ~> m2]. + real :: ustar_sq ! ustar squared [Z2 s-2 ~> m2 s-2] + real :: Kd_mlr ! A diffusivity associated with mixed layer turbulence radiation [Z2 s-1 ~> m2 s-1]. real :: C1_6 ! 1/6 real :: Omega2 ! rotation rate squared, in s-2. real :: z1 ! layer thickness times I_decay (nondim) - real :: dzL ! thickness converted to Z ~> m. + real :: dzL ! thickness converted to heights [Z ~> m]. real :: I_decay_len2_TKE ! squared inverse decay lengthscale for - ! TKE, as used in the mixed layer code, in Z-2 ~> m-2. - real :: h_neglect ! negligibly small thickness, in Z ~> m. + ! TKE, as used in the mixed layer code [Z-2 ~> m-2]. + real :: h_neglect ! negligibly small thickness [Z ~> m]. logical :: do_any, do_i(SZI_(G)) integer :: i, k, is, ie, nz, kml @@ -1683,21 +1683,21 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) real, dimension(SZI_(G)) :: & htot ! total thickness above or below a layer, or the - ! integrated thickness in the BBL, in Z ~> m. + ! integrated thickness in the BBL [Z ~> m]. real, dimension(SZIB_(G)) :: & uhtot, & ! running integral of u in the BBL (Z m/s) - ustar, & ! bottom boundary layer turbulence speed, in Z s-1 ~> m s-1. + ustar, & ! bottom boundary layer turbulence speed [Z s-1 ~> m s-1]. u2_bbl ! square of the mean zonal velocity in the BBL (m2/s2) real :: vhtot(SZI_(G)) ! running integral of v in the BBL (Z m/sec) real, dimension(SZI_(G),SZJB_(G)) :: & - vstar, & ! ustar at at v-points, in Z s-1 ~> m s-1. + vstar, & ! ustar at at v-points [Z s-1 ~> m s-1]. v2_bbl ! square of average meridional velocity in BBL (m2/s2) real :: cdrag_sqrt ! square root of the drag coefficient (nondim) - real :: hvel ! thickness at velocity points, in Z ~> m. + real :: hvel ! thickness at velocity points [Z ~> m]. logical :: domore, do_i(SZI_(G)) integer :: i, j, k, is, ie, js, je, nz diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 6e04857817..3d5570ab3a 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -55,8 +55,8 @@ module MOM_set_visc real :: Htbl_shelf !< A nominal thickness of the surface boundary layer for use !! in calculating the near-surface velocity, in H ~> m or kg m-2. real :: Htbl_shelf_min !< The minimum surface boundary layer thickness in H ~> m or kg m-2. - real :: KV_BBL_min !< The minimum viscosity in the bottom boundary layer, in Z2 s-1 ~> m2 s-1. - real :: KV_TBL_min !< The minimum viscosity in the top boundary layer, in Z2 s-1 ~> m2 s-1. + real :: KV_BBL_min !< The minimum viscosity in the bottom boundary layer [Z2 s-1 ~> m2 s-1]. + real :: KV_TBL_min !< The minimum viscosity in the top boundary layer [Z2 s-1 ~> m2 s-1]. logical :: bottomdraglaw !< If true, the bottom stress is calculated with a !! drag law c_drag*|u|*u. The velocity magnitude !! may be an assumed value or it may be based on the @@ -75,7 +75,7 @@ module MOM_set_visc !! thickness of the viscous mixed layer. Nondim. real :: omega !< The Earth's rotation rate, in s-1. real :: ustar_min !< A minimum value of ustar to avoid numerical - !! problems, in Z s-1 ~> m s-1. If the value is small enough, + !! problems [Z s-1 ~> m s-1]. If the value is small enough, !! this should not affect the solution. real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE !! decay scale, nondimensional. @@ -171,7 +171,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! Rho0 divided by G_Earth and the conversion ! from m to thickness units, in kg m-2 or kg2 m-5. real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion - ! factor from lateral lengths to vertical depths, in Z m-1 ~> 1. + ! factor from lateral lengths to vertical depths [Z m-1 ~> 1]. real :: cdrag_sqrt ! Square root of the drag coefficient, nd. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, @@ -181,7 +181,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: Dh ! The increment in layer thickness from ! the present layer, in H ~> m or kg m-2. real :: bbl_thick ! The thickness of the bottom boundary layer in H ~> m or kg m-2. - real :: bbl_thick_Z ! The thickness of the bottom boundary layer in Z ~> m. + real :: bbl_thick_Z ! The thickness of the bottom boundary layer [Z ~> m]. real :: C2f ! C2f = 2*f at velocity points. real :: U_bg_sq ! The square of an assumed background @@ -248,7 +248,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: Cell_width ! The transverse width of the velocity cell, in m. real :: Rayleigh ! A nondimensional value that is multiplied by the layer's ! velocity magnitude to give the Rayleigh drag velocity, times - ! a lateral to vertical distance conversion factor, in Z L-1 ~> 1. + ! a lateral to vertical distance conversion factor [Z L-1 ~> 1]. real :: gam ! The ratio of the change in the open interface width ! to the open interface width atop a cell, nondim. real :: BBL_frac ! The fraction of a layer's drag that goes into the @@ -1040,7 +1040,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri dR_dS, & ! Partial derivative of the density at the base of layer nkml ! (roughly the base of the mixed layer) with salinity, in units ! of kg m-3 psu-1. - ustar, & ! The surface friction velocity under ice shelves, in Z s-1 ~> m s-1. + ustar, & ! The surface friction velocity under ice shelves [Z s-1 ~> m s-1]. press, & ! The pressure at which dR_dT and dR_dS are evaluated, in Pa. T_EOS, & ! T_EOS and S_EOS are the potential temperature and salnity at which dR_dT and dR_dS S_EOS ! which dR_dT and dR_dS are evaluated, in degC and PSU. @@ -1068,7 +1068,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! velocity magnitudes, in H m s-1 ~> m2 s-1 or kg m-1 s-1. real :: hweight ! The thickness of a layer that is within Hbbl ! of the bottom, in H ~> m or kg m-2. - real :: tbl_thick_Z ! The thickness of the top boundary layer in Z ~> m. + real :: tbl_thick_Z ! The thickness of the top boundary layer [Z ~> m]. real :: hlay ! The layer thickness at velocity points, in H ~> m or kg m-2. real :: I_2hlay ! 1 / 2*hlay, in H-1 ~> m-1 or m2 kg-1. @@ -1092,7 +1092,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! Rho0 divided by G_Earth and the conversion ! from m to thickness units, in kg m-2 or kg2 m-5. real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion - ! factor from lateral lengths to vertical depths, in Z m-1 ~> 1. + ! factor from lateral lengths to vertical depths [Z m-1 ~> 1]. real :: cdrag_sqrt ! Square root of the drag coefficient, ND. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, @@ -1107,7 +1107,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real :: h_tiny ! A very small thickness, in H ~> m or kg m-2. Layers that are less than ! h_tiny can not be the deepest in the viscous mixed layer. real :: absf ! The absolute value of f averaged to velocity points, s-1. - real :: U_star ! The friction velocity at velocity points, in Z s-1 ~> m s-1. + real :: U_star ! The friction velocity at velocity points [Z s-1 ~> m s-1]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H ~> m or kg m-2. real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors, in kg s2 H m-3 Z-2. diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index a4c38c63a5..1ddfa2d172 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -352,7 +352,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) fld_anom ! Anomalies in a tracer concentration, relative to the ! i-mean target value. real, dimension(SZJ_(G), SZK_(G)+1) :: & - eta_mean_anom ! The i-mean interface height anomalies, in Z ~> m. + eta_mean_anom ! The i-mean interface height anomalies [Z ~> m]. real, allocatable, dimension(:,:,:) :: & fld_mean_anom ! THe i-mean tracer concentration anomalies. real, dimension(SZI_(G), SZK_(G)+1) :: & @@ -362,8 +362,8 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) dilate ! A nondimensional factor by which to dilate layers to ! give 0 at the surface. - real :: e(SZK_(G)+1) ! The interface heights, in Z ~> m, usually negative. - real :: e0 ! The height of the free surface in Z ~> m. + real :: e(SZK_(G)+1) ! The interface heights [Z ~> m], usually negative. + real :: e0 ! The height of the free surface [Z ~> m]. real :: e_str ! A nondimensional amount by which the reference ! profile must be stretched for the free surfaces ! heights in the two profiles to agree. diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index e3a5b43028..15918e3795 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -44,9 +44,9 @@ module MOM_tidal_mixing !> Containers for tidal mixing diagnostics type, public :: tidal_mixing_diags ; private real, pointer, dimension(:,:,:) :: & - Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces, in Z2 s-1 ~> m2 s-1. + Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces [Z2 s-1 ~> m2 s-1]. Fl_itidal => NULL(),& !< vertical flux of tidal turbulent dissipation (m3 s-3) - Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces, in Z2 s-1 ~> m2 s-1. + Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces [Z2 s-1 ~> m2 s-1]. Kd_Niku_work => NULL(),& !< layer integrated work by lee-wave driven mixing (W m-2) Kd_Itidal_Work => NULL(),& !< layer integrated work by int tide driven mixing (W m-2) Kd_Lowmode_Work => NULL(),& !< layer integrated work by low mode driven mixing (W m-2) @@ -56,7 +56,7 @@ module MOM_tidal_mixing real, pointer, dimension(:,:,:) :: tidal_qe_md => NULL() !< Input tidal energy dissipated locally, !! interpolated to model vertical coordinate (W m-3?) real, pointer, dimension(:,:,:) :: Kd_lowmode => NULL() !< internal tide diffusivity at interfaces - !! due to propagating low modes, in Z2 s-1 ~> m2 s-1. + !! due to propagating low modes [Z2 s-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Fl_lowmode => NULL() !< vertical flux of tidal turbulent !! dissipation due to propagating low modes (m3/s3) real, pointer, dimension(:,:) :: & @@ -90,7 +90,7 @@ module MOM_tidal_mixing !! for dissipation of the lee waves. Schemes that are !! currently encoded are St Laurent et al (2002) and !! Polzin (2009). - real :: Int_tide_decay_scale !< decay scale for internal wave TKE, in Z ~> m. + real :: Int_tide_decay_scale !< decay scale for internal wave TKE [Z ~> m]. real :: Mu_itides !< efficiency for conversion of dissipation !! to potential energy (nondimensional) @@ -102,7 +102,7 @@ module MOM_tidal_mixing real :: Decay_scale_factor_lee !< Scaling factor for the decay scale of lee !! wave energy dissipation (nondimensional) - real :: min_zbot_itides !< minimum depth for internal tide conversion, in Z ~> m. + real :: min_zbot_itides !< minimum depth for internal tide conversion [Z ~> m]. logical :: Lowmode_itidal_dissipation = .false. !< If true, consider mixing due to breaking low !! modes that have been remotely generated using an internal tidal !! dissipation scheme to specify the vertical profile of the energy @@ -121,13 +121,13 @@ module MOM_tidal_mixing !! profile in Polzin formulation should not exceed !! Polzin_decay_scale_max_factor * depth of the ocean (nondimensional). real :: Polzin_min_decay_scale !< minimum decay scale of the tidal dissipation - !! profile in Polzin formulation, in Z ~> m. + !! profile in Polzin formulation [Z ~> m]. real :: TKE_itide_max !< maximum internal tide conversion (W m-2) !! available to mix above the BBL real :: utide !< constant tidal amplitude (m s-1) used if - real :: kappa_itides !< topographic wavenumber and non-dimensional scaling, in Z-1 ~> m-1. + real :: kappa_itides !< topographic wavenumber and non-dimensional scaling [Z-1 ~> m-1]. real :: kappa_h2_factor !< factor for the product of wavenumber * rms sgs height character(len=200) :: inputdir !< The directory in which to find input files @@ -142,7 +142,7 @@ module MOM_tidal_mixing type(CVMix_global_params_type) :: CVMix_glb_params !< CVMix-specific for Prandtl number only real :: tidal_max_coef !< CVMix-specific maximum allowable tidal diffusivity. [m^2/s] real :: tidal_diss_lim_tc !< CVMix-specific dissipation limit depth for - !! tidal-energy-constituent data, in Z ~> m. + !! tidal-energy-constituent data [Z ~> m]. type(remapping_CS) :: remap_CS !< The control structure for remapping ! Data containers @@ -669,22 +669,22 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, C real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, - !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1 + !! usually (~Rho_0 / (G_Earth * dRho_lay)) + !! [Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1] real, dimension(SZI_(G),SZK_(G)), intent(in) :: max_TKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness, in m3 s-3 type(tidal_mixing_cs), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1 ~> m2 s-1. + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers [Z2 s-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, - !! in Z2 s-1 ~> m2 s-1. + !! [Z2 s-1 ~> m2 s-1]. real, intent(in) :: Kd_max !< The maximum increment for diapycnal !! diffusivity due to TKE-based processes, - !! in Z2 s-1 ~> m2 s-1. + !! [Z2 s-1 ~> m2 s-1]. !! Set this to a negative value to have no limit. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) in Z2 s-1 ~> m2 s-1. + !! (not layer!) [Z2 s-1 ~> m2 s-1]. if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then if (CS%use_CVMix_tidal) then @@ -710,9 +710,9 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd_lay!< The diapycnal diffusivities in the layers, in Z2 s-1 ~> m2 s-1. + intent(inout) :: Kd_lay!< The diapycnal diffusivities in the layers [Z2 s-1 ~> m2 s-1]. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) in Z2 s-1 ~> m2 s-1. + !! (not layer!) [Z2 s-1 ~> m2 s-1]. ! Local variables real, dimension(SZK_(G)+1) :: Kd_tidal ! tidal diffusivity [m2/s] real, dimension(SZK_(G)+1) :: Kv_tidal ! tidal viscosity [m2/s] @@ -939,35 +939,35 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, - !! usually (~Rho_0 / (G_Earth * dRho_lay)), - !! in Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1 + !! usually (~Rho_0 / (G_Earth * dRho_lay)) + !! [Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1] real, dimension(SZI_(G),SZK_(G)), intent(in) :: max_TKE !< The energy required to for a layer to entrain !! to its maximum realizable thickness, in m3 s-3 type(tidal_mixing_cs), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers, in Z2 s-1 ~> m2 s-1. + intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers [Z2 s-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces, - !! in Z2 s-1 ~> m2 s-1. + optional, intent(inout) :: Kd_int !< The diapycnal diffusvity at interfaces + !! [Z2 s-1 ~> m2 s-1]. real, intent(in) :: Kd_max !< The maximum increment for diapycnal - !! diffusivity due to TKE-based processes, - !! in Z2 s-1 ~> m2 s-1. + !! diffusivity due to TKE-based processes + !! [Z2 s-1 ~> m2 s-1]. !! Set this to a negative value to have no limit. ! local real, dimension(SZI_(G)) :: & htot, & ! total thickness above or below a layer, or the - ! integrated thickness in the BBL, in Z ~> m. - htot_WKB, & ! WKB scaled distance from top to bottom, in Z ~> m. + ! integrated thickness in the BBL [Z ~> m]. + htot_WKB, & ! WKB scaled distance from top to bottom [Z ~> m]. TKE_itidal_bot, & ! internal tide TKE at ocean bottom (m3/s3) TKE_Niku_bot, & ! lee-wave TKE at ocean bottom (m3/s3) TKE_lowmode_bot, & ! internal tide TKE at ocean bottom lost from all remote low modes (m3/s3) (BDM) Inv_int, & ! inverse of TKE decay for int tide over the depth of the ocean (nondim) Inv_int_lee, & ! inverse of TKE decay for lee waves over the depth of the ocean (nondim) Inv_int_low, & ! inverse of TKE decay for low modes over the depth of the ocean (nondim) (BDM) - z0_Polzin, & ! TKE decay scale in Polzin formulation, in Z ~> m. - z0_Polzin_scaled, & ! TKE decay scale in Polzin formulation, in Z ~> m. + z0_Polzin, & ! TKE decay scale in Polzin formulation [Z ~> m]. + z0_Polzin_scaled, & ! TKE decay scale in Polzin formulation [Z ~> m]. ! multiplied by N2_bot/N2_meanz to be coherent with the WKB scaled z ! z*=int(N2/N2_bot) * N2_bot/N2_meanz = int(N2/N2_meanz) ! z0_Polzin_scaled = z0_Polzin * N2_bot/N2_meanz @@ -979,17 +979,17 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, TKE_frac_top_lee, & ! fraction of bottom TKE that should appear at top of a layer (nondim) TKE_frac_top_lowmode, & ! fraction of bottom TKE that should appear at top of a layer (nondim) (BDM) - z_from_bot, & ! distance from bottom, in Z ~> m. - z_from_bot_WKB ! WKB scaled distance from bottom, in Z ~> m. + z_from_bot, & ! distance from bottom [Z ~> m]. + z_from_bot_WKB ! WKB scaled distance from bottom [Z ~> m]. real :: I_rho0 ! 1 / RHO0, (m3/kg) - real :: Kd_add ! diffusivity to add in a layer, in Z2 s-1 ~> m2 s-1. + real :: Kd_add ! diffusivity to add in a layer [Z2 s-1 ~> m2 s-1]. real :: TKE_itide_lay ! internal tide TKE imparted to a layer (from barotropic) (m3/s3) real :: TKE_Niku_lay ! lee-wave TKE imparted to a layer (m3/s3) real :: TKE_lowmode_lay ! internal tide TKE imparted to a layer (from low mode) (m3/s3) (BDM) real :: frac_used ! fraction of TKE that can be used in a layer (nondim) - real :: Izeta ! inverse of TKE decay scale, in Z-1 ~> m-1. - real :: Izeta_lee ! inverse of TKE decay scale for lee waves, in Z-1 ~> m-1. + real :: Izeta ! inverse of TKE decay scale [Z-1 ~> m-1]. + real :: Izeta_lee ! inverse of TKE decay scale for lee waves [Z-1 ~> m-1]. real :: z0_psl ! temporary variable with units of Z ~> m. real :: TKE_lowmode_tot ! TKE from all low modes (W/m2) (BDM) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index a19f5d2e75..efcb533dce 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -66,17 +66,17 @@ module MOM_vert_friction type(time_type) :: rampStartTime !< The time at which the ramping of CFL_trunc starts real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) :: & - a_u !< The u-drag coefficient across an interface, in Z s-1 ~> m s-1. + a_u !< The u-drag coefficient across an interface [Z s-1 ~> m s-1]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - h_u !< The effective layer thickness at u-points, m or kg m-2. + h_u !< The effective layer thickness at u-points [H ~> m or kg m-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) :: & - a_v !< The v-drag coefficient across an interface, in Z s-1 ~> m s-1. + a_v !< The v-drag coefficient across an interface [Z s-1 ~> m s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - h_v !< The effective layer thickness at v-points, m or kg m-2. + h_v !< The effective layer thickness at v-points [H ~> m or kg m-2]. real, pointer, dimension(:,:) :: a1_shelf_u => NULL() !< The u-momentum coupling coefficient under - !! ice shelves in m s-1. Retained to determine stress under shelves. + !! ice shelves [Z s-1 ~> m s-1]. Retained to determine stress under shelves. real, pointer, dimension(:,:) :: a1_shelf_v => NULL() !< The v-momentum coupling coefficient under - !! ice shelves in m s-1. Retained to determine stress under shelves. + !! ice shelves [Z s-1 ~> m s-1]. Retained to determine stress under shelves. logical :: split !< If true, use the split time stepping scheme. logical :: bottomdraglaw !< If true, the bottom stress is calculated with a @@ -179,7 +179,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. c1 is nondimensional, ! while b1 has units of inverse thickness. real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver, ND. - real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity, in Z s-1 ~> m s-1. + real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity [Z s-1 ~> m s-1]. real :: b_denom_1 ! The first term in the denominator of b1, in H ~> m or kg m-2. real :: Hmix ! The mixed layer thickness over which stress @@ -600,14 +600,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) hvel, & ! hvel is the thickness used at a velocity grid point, in H ~> m or kg m-2. hvel_shelf ! The equivalent of hvel under shelves, in H ~> m or kg m-2. real, dimension(SZIB_(G),SZK_(G)+1) :: & - a_cpl, & ! The drag coefficients across interfaces, in Z s-1 ~> m s-1. a_cpl times + a_cpl, & ! The drag coefficients across interfaces [Z s-1 ~> m s-1]. a_cpl times ! the velocity difference gives the stress across an interface. a_shelf, & ! The drag coefficients across interfaces in water columns under - ! ice shelves, in Z s-1 ~> m s-1. + ! ice shelves [Z s-1 ~> m s-1]. z_i ! An estimate of each interface's height above the bottom, ! normalized by the bottom boundary layer thickness, nondim. real, dimension(SZIB_(G)) :: & - kv_bbl, & ! The bottom boundary layer viscosity in Z2 s-1 ~> m2 s-1. + kv_bbl, & ! The bottom boundary layer viscosity [Z2 s-1 ~> m2 s-1]. bbl_thick, & ! The bottom boundary layer thickness in m or kg m-2. I_Hbbl, & ! The inverse of the bottom boundary layer thickness, in units ! of H-1 (i.e., m-1 or m2 kg-1). @@ -1047,7 +1047,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZK_(GV)+1), & - intent(out) :: a_cpl !< Coupling coefficient across interfaces, in Z s-1 ~> m s-1. + intent(out) :: a_cpl !< Coupling coefficient across interfaces [Z s-1 ~> m s-1]. real, dimension(SZIB_(G),SZK_(GV)), & intent(in) :: hvel !< Thickness at velocity points, in H ~> m or kg m-2 logical, dimension(SZIB_(G)), & @@ -1056,7 +1056,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, intent(in) :: h_harm !< Harmonic mean of thicknesses around a velocity !! grid point, in H ~> m or kg m-2 real, dimension(SZIB_(G)), intent(in) :: bbl_thick !< Bottom boundary layer thickness, in H ~> m or kg m-2 - real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity, in Z2 s-1 ~> m2 s-1. + real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity [Z2 s-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZK_(GV)+1), & intent(in) :: z_i !< Estimate of interface heights above the bottom, !! normalized by the bottom boundary layer thickness @@ -1075,23 +1075,23 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! Local variables real, dimension(SZIB_(G)) :: & - u_star, & ! ustar at a velocity point, in Z s-1 ~> m s-1. + u_star, & ! ustar at a velocity point [Z s-1 ~> m s-1]. absf, & ! The average of the neighboring absolute values of f, in s-1. ! h_ml, & ! The mixed layer depth, in m or kg m-2. nk_visc, & ! The (real) interface index of the base of mixed layer. z_t, & ! The distance from the top, sometimes normalized ! by Hmix, in H or nondimensional. - kv_tbl, & ! The viscosity in a top boundary layer under ice, in Z2 s-1 ~> m2 s-1. + kv_tbl, & ! The viscosity in a top boundary layer under ice [Z2 s-1 ~> m2 s-1]. tbl_thick real, dimension(SZIB_(G),SZK_(GV)) :: & - Kv_add ! A viscosity to add, in Z2 s-1 ~> m2 s-1. + Kv_add ! A viscosity to add [Z2 s-1 ~> m2 s-1]. real :: h_shear ! The distance over which shears occur, in H ~> m or kg m-2. real :: r ! A thickness to compare with Hbbl, in H ~> m or kg m-2. - real :: visc_ml ! The mixed layer viscosity, in Z2 s-1 ~> m2 s-1. + real :: visc_ml ! The mixed layer viscosity [Z2 s-1 ~> m2 s-1]. real :: I_Hmix ! The inverse of the mixed layer thickness, in H-1 ~> m-1 or m2 kg-1. real :: a_ml ! The layer coupling coefficient across an interface in ! the mixed layer, in m s-1. - real :: I_amax ! The inverse of the maximum coupling coefficient, in Z-1 ~> m-1.??? + real :: I_amax ! The inverse of the maximum coupling coefficient [Z-1 ~> m-1].??? real :: temp1 ! A temporary variable in H Z real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H ~> m or kg m-2. diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index d56e22c173..7cb83ca557 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -177,7 +177,7 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & real :: dist2 ! The distance squared from a line, in m2. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in H ~> m or kg m-2. - real :: e(SZK_(G)+1), e_top, e_bot ! Heights in Z ~> m. + real :: e(SZK_(G)+1), e_top, e_bot ! Heights [Z ~> m]. real :: d_tr ! A change in tracer concentraions, in tracer units. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index 3eed664c3f..9bdaa2aac6 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -54,7 +54,7 @@ function tracer_Z_init(tr, h, filename, tr_name, G, US, missing_val, land_val) tr_in ! The z-space array of tracer concentrations that is read in. real, allocatable, dimension(:) :: & z_edges, & ! The depths of the cell edges or cell centers (depending on - ! the value of has_edges) in the input z* data, in Z ~> m. + ! the value of has_edges) in the input z* data [Z ~> m]. tr_1d, & ! A copy of the input tracer concentrations in a column. wt, & ! The fractional weight for each layer in the range between ! k_top and k_bot, nondim. @@ -62,7 +62,7 @@ function tracer_Z_init(tr, h, filename, tr_name, G, US, missing_val, land_val) z2 ! of a z-cell that contributes to a layer, relative to the cell ! center and normalized by the cell thickness, nondim. ! Note that -1/2 <= z1 <= z2 <= 1/2. - real :: e(SZK_(G)+1) ! The z-star interface heights in Z ~> m. + real :: e(SZK_(G)+1) ! The z-star interface heights [Z ~> m]. real :: landval ! The tracer value to use in land points. real :: sl_tr ! The normalized slope of the tracer ! within the cell, in tracer units. diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 3734f0a2bd..2a90d059b5 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -46,8 +46,8 @@ module regional_dyes real, allocatable, dimension(:) :: dye_source_maxlon !< Maximum longitude of region dye will be injected. real, allocatable, dimension(:) :: dye_source_minlat !< Minimum latitude of region dye will be injected. real, allocatable, dimension(:) :: dye_source_maxlat !< Maximum latitude of region dye will be injected. - real, allocatable, dimension(:) :: dye_source_mindepth !< Minimum depth of region dye will be injected, in Z ~> m. - real, allocatable, dimension(:) :: dye_source_maxdepth !< Maximum depth of region dye will be injected, in Z ~> m. + real, allocatable, dimension(:) :: dye_source_mindepth !< Minimum depth of region dye will be injected [Z ~> m]. + real, allocatable, dimension(:) :: dye_source_maxdepth !< Maximum depth of region dye will be injected [Z ~> m]. type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3? diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 5dd4a73b1b..63d9d2c690 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -370,11 +370,11 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. real :: S_ref, T_ref ! Reference salinity and temerature within surface layer real :: S_range, T_range ! Range of salinities and temperatures over the vertical - real :: e0(SZK_(G)+1) ! The resting interface heights, in Z ~> m, + real :: e0(SZK_(G)+1) ! The resting interface heights [Z ~> m], ! usually negative because it is positive upward. real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface - ! positive upward, in Z ~> m. - real :: d_eta(SZK_(G)) ! The layer thickness in a column, in Z ~> m. + ! positive upward [Z ~> m]. + real :: d_eta(SZK_(G)) ! The layer thickness in a column [Z ~> m]. real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay real :: dome2d_west_sponge_time_scale, dome2d_east_sponge_time_scale real :: dome2d_west_sponge_width, dome2d_east_sponge_width diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 7fd531ce28..701ef59e72 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -47,7 +47,7 @@ subroutine DOME_initialize_topography(D, G, param_file, max_depth, US) ! Local variables real :: m_to_Z ! A dimensional rescaling factor. - real :: min_depth ! The minimum and maximum depths in Z ~> m. + real :: min_depth ! The minimum and maximum depths [Z ~> m]. ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "DOME_initialize_topography" ! This subroutine's name. @@ -98,9 +98,9 @@ subroutine DOME_initialize_thickness(h, G, GV, param_file, just_read_params) !! only read parameters without changing h. real :: e0(SZK_(GV)+1) ! The resting interface heights, in m, usually - ! negative because it is positive upward, in Z ~> m. + ! negative because it is positive upward [Z ~> m]. real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface - ! positive upward, in Z ~> m. + ! positive upward [Z ~> m]. logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "DOME_initialize_thickness" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, nz @@ -161,7 +161,7 @@ subroutine DOME_initialize_sponges(G, GV, US, tv, PF, CSp) real :: temp(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for other variables. ! real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. - real :: H0(SZK_(G)) ! Interface heights in Z ~> m. + real :: H0(SZK_(G)) ! Interface heights [Z ~> m]. real :: min_depth real :: damp, e_dense, damp_new character(len=40) :: mdl = "DOME_initialize_sponges" ! This subroutine's name. @@ -265,7 +265,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 in kg m-3. ! The following variables are used to set up the transport in the DOME example. real :: tr_0, y1, y2, tr_k, rst, rsb, rc, v_k, lon_im1 - real :: D_edge ! The thickness, in Z ~> m, of the dense fluid at the + real :: D_edge ! The thickness [Z ~> m], of the dense fluid at the ! inner edge of the inflow. real :: g_prime_tot ! The reduced gravity across all layers, in m2 Z-1 s-2 ~> m s-2. real :: Def_Rad ! The deformation radius, based on fluid of diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 34c313577a..477890ad1e 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -50,17 +50,17 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: min_depth ! The minimum and maximum depths in Z ~> m. + real :: min_depth ! The minimum and maximum depths [Z ~> m]. real :: m_to_Z ! A dimensional rescaling factor. ! The following variables are used to set up the bathymetry in the ISOMIP example. real :: bmax ! max depth of bedrock topography real :: b0,b2,b4,b6 ! first, second, third and fourth bedrock topography coeff real :: xbar ! characteristic along-flow lenght scale of the bedrock - real :: dc ! depth of the trough compared with side walls in Z ~> m. + real :: dc ! depth of the trough compared with side walls [Z ~> m]. real :: fc ! characteristic width of the side walls of the channel real :: wc ! half-width of the trough real :: ly ! domain width (across ice flow) - real :: bx, by ! dummy vatiables in Z ~> m. + real :: bx, by ! dummy vatiables [Z ~> m]. real :: xtil ! dummy vatiable logical :: is_2D ! If true, use 2D setup ! This include declares and sets the variable "version". @@ -441,10 +441,10 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) real :: rho_sur, rho_bot, rho_range real :: dT_dz, dS_dz ! Gradients of T and S in degC/Z and PPT/Z. - real :: e0(SZK_(G)+1) ! The resting interface heights, in Z ~> m, usually + real :: e0(SZK_(G)+1) ! The resting interface heights [Z ~> m], usually ! negative because it is positive upward. - real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface, positive upward, in Z ~> m. - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in Z ~> m. + real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface, positive upward [Z ~> m]. + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta [Z ~> m]. real :: min_depth, dummy1, z real :: damp, rho_dummy, min_thickness, rho_tmp, xi0 character(len=40) :: verticalCoordinate, filename, state_file diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index b1c0587d2c..22c4a1d7fb 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -126,7 +126,7 @@ subroutine Kelvin_initialize_topography(D, G, param_file, max_depth, US) ! Local variables character(len=40) :: mdl = "Kelvin_initialize_topography" ! This subroutine's name. real :: m_to_Z ! A dimensional rescaling factor. - real :: min_depth ! The minimum and maximum depths in Z ~> m. + real :: min_depth ! The minimum and maximum depths [Z ~> m]. real :: PI ! 3.1415... real :: coast_offset1, coast_offset2, coast_angle, right_angle integer :: i, j diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index abcdfec6ab..ab34e3fa96 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -471,7 +471,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Thickness (m or kg/m2) real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: ustar !< Wind friction velocity, in Z s-1 ~> m s-1. + intent(in) :: ustar !< Wind friction velocity [Z s-1 ~> m s-1]. ! Local Variables real :: Top, MidPoint, Bottom, one_cm real :: DecayScale @@ -866,8 +866,8 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: i !< Meridional index of h-point integer, intent(in) :: j !< Zonal index of h-point - real, intent(in) :: ustar !< Friction velocity, in Z s-1 ~> m s-1. - real, intent(in) :: HBL !< (Positive) thickness of boundary layer, in Z ~> m. + real, intent(in) :: ustar !< Friction velocity [Z s-1 ~> m s-1]. + real, intent(in) :: HBL !< (Positive) thickness of boundary layer [Z ~> m]. logical, optional, intent(in) :: Override_MA !< Override to use misalignment in LA !! calculation. This can be used if diagnostic !! LA outputs are desired that are different than @@ -979,8 +979,8 @@ end subroutine get_Langmuir_Number !! - BGR remove u10 input !! - BGR note: fixed parameter values should be changed to "get_params" subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) - real, intent(in) :: ustar !< water-side surface friction velocity, in Z s-1 ~> m s-1. - real, intent(in) :: hbl !< boundary layer depth, in Z ~> m. + real, intent(in) :: ustar !< water-side surface friction velocity [Z s-1 ~> m s-1]. + real, intent(in) :: hbl !< boundary layer depth [Z ~> m]. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(out) :: UStokes_SL !< Surface layer averaged Stokes drift (m/s) @@ -1060,7 +1060,7 @@ end subroutine Get_StokesSL_LiFoxKemper subroutine Get_SL_Average_Prof( GV, AvgDepth, H, Profile, Average ) type(verticalGrid_type), & intent(in) :: GV !< Ocean vertical grid structure - real, intent(in) :: AvgDepth !< Depth to average over, in Z ~> m. + real, intent(in) :: AvgDepth !< Depth to average over [Z ~> m]. real, dimension(SZK_(GV)), & intent(in) :: H !< Grid thickness (H) real, dimension(SZK_(GV)), & @@ -1069,7 +1069,7 @@ subroutine Get_SL_Average_Prof( GV, AvgDepth, H, Profile, Average ) real, intent(out) :: Average !< Output quantity averaged over depth AvgDepth !! (used here for Stokes drift, m/s) !Local variables - real :: top, midpoint, bottom ! Depths in Z ~> m. + real :: top, midpoint, bottom ! Depths [Z ~> m]. real :: Sum integer :: kk @@ -1099,7 +1099,7 @@ end subroutine Get_SL_Average_Prof subroutine Get_SL_Average_Band( GV, AvgDepth, NB, WaveNumbers, SurfStokes, Average ) type(verticalGrid_type), & intent(in) :: GV !< Ocean vertical grid - real, intent(in) :: AvgDepth !< Depth to average over, in Z ~> m. + real, intent(in) :: AvgDepth !< Depth to average over [Z ~> m]. integer, intent(in) :: NB !< Number of bands used real, dimension(NB), & intent(in) :: WaveNumbers !< Wavenumber corresponding to each band (1/Z) @@ -1132,7 +1132,7 @@ end subroutine Get_SL_Average_Band subroutine DHH85_mid(GV, US, zpt, UStokes) type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: ZPT !< Depth to get Stokes drift, in Z ~> m. !### THIS IS NOT USED YET. + real, intent(in) :: ZPT !< Depth to get Stokes drift [Z ~> m]. !### THIS IS NOT USED YET. real, intent(out) :: UStokes !< Stokes drift (m/s) ! real :: ann, Bnn, Snn, Cnn, Dnn @@ -1199,7 +1199,7 @@ subroutine StokesMixing(G, GV, DT, h, u, v, Waves ) pointer :: Waves !< Surface wave related control structure. ! Local variables real :: dTauUp, dTauDn - real :: h_Lay ! The layer thickness at a velocity point, in Z ~> m. + real :: h_Lay ! The layer thickness at a velocity point [Z ~> m]. integer :: i,j,k ! This is a template to think about down-Stokes mixing. diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index f20a08bc0f..05e0eac1ba 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -126,8 +126,8 @@ subroutine Neverland_initialize_thickness(h, G, GV, US, param_file, eqn_of_state ! Local variables real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z ~> m), ! usually negative because it is positive upward. - real, dimension(SZK_(G)) :: h_profile ! Vector of initial thickness profile, in Z ~> m. - real :: e_interface ! Current interface position, in Z ~> m. + real, dimension(SZK_(G)) :: h_profile ! Vector of initial thickness profile [Z ~> m]. + real :: e_interface ! Current interface position [Z ~> m]. real :: x,y,r1,r2 ! x,y and radial coordinates for computation of initial pert. real :: pert_amp ! Amplitude of perturbations measured in Angstrom_H real :: h_noise ! Amplitude of noise to scale h by diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 6afa27f852..1f29307a10 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -214,17 +214,17 @@ subroutine Phillips_initialize_sponges(G, GV, US, tv, param_file, CSp, h) ! Local variables real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces. - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in Z ~> m. + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta [Z ~> m]. real :: temp(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for other variables. real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. - real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta, in Z ~> m. + real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta [Z ~> m]. real :: Idamp_im(SZJ_(G)) ! The inverse zonal-mean damping rate, in s-1. real :: damp_rate ! The inverse zonal-mean damping rate, in s-1. real :: jet_width ! The width of the zonal mean jet, in km. - real :: jet_height ! The interface height scale associated with the zonal-mean jet, in Z ~> m. + real :: jet_height ! The interface height scale associated with the zonal-mean jet [Z ~> m]. real :: y_2 ! The y-position relative to the channel center, in km. real :: half_strat ! The fractional depth where the straficiation is centered, ND. - real :: half_depth ! The depth where the stratification is centered, in Z ~> m. + real :: half_depth ! The depth where the stratification is centered [Z ~> m]. character(len=40) :: mdl = "Phillips_initialize_sponges" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index 1ebdec2c80..4a6dc73867 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -63,8 +63,8 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read_par logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: UpperLayerTempMLD !< Upper layer Temp MLD thickness, in Z ~> m. - real :: UpperLayerSaltMLD !< Upper layer Salt MLD thickness, in Z ~> m. + real :: UpperLayerTempMLD !< Upper layer Temp MLD thickness [Z ~> m]. + real :: UpperLayerSaltMLD !< Upper layer Salt MLD thickness [Z ~> m]. real :: UpperLayerTemp !< Upper layer temperature (SST if thickness 0) (deg C) real :: UpperLayerSalt !< Upper layer salinity (SSS if thickness 0) (PPT) real :: LowerLayerTemp !< Temp at top of lower layer (deg C) @@ -72,7 +72,7 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read_par real :: LowerLayerdTdz !< Temp gradient in lower layer, in degC / Z ~> degC m-1. real :: LowerLayerdSdz !< Salt gradient in lower layer, in PPT / Z ~> PPT m-1. real :: LowerLayerMinTemp !< Minimum temperature in lower layer - real :: zC, DZ, top, bottom ! Depths and thicknesses in Z ~> m. + real :: zC, DZ, top, bottom ! Depths and thicknesses [Z ~> m]. logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index 1c55e04ec0..f237c1b857 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -40,7 +40,7 @@ subroutine benchmark_initialize_topography(D, G, param_file, max_depth, US) type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: min_depth ! The minimum and maximum depths in Z ~> m. + real :: min_depth ! The minimum and maximum depths [Z ~> m]. real :: PI ! 3.1415926... calculated as 4*atan(1) real :: D0 ! A constant to make the maximum ! ! basin depth MAXIMUM_DEPTH. ! @@ -110,7 +110,7 @@ subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state real :: thermocline_scale ! The e-folding scale of the thermocline, in depth units (Z ~> m). real, dimension(SZK_(GV)) :: T0, pres, S0, rho_guess, drho, drho_dT, drho_dS real :: a_exp ! The fraction of the overall stratification that is exponential. - real :: I_ts, I_md ! Inverse lengthscales in Z-1 ~> m-1. + real :: I_ts, I_md ! Inverse lengthscales [Z-1 ~> m-1]. real :: T_frac ! A ratio of the interface temperature to the range ! between SST and the bottom temperature. real :: err, derr_dz ! The error between the profile's temperature and the diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 2d547ed9fb..3c9038a228 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -85,13 +85,13 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, US, param_file, just_read_p logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: e0(SZK_(G)+1) ! The resting interface heights, in Z ~> m, usually + real :: e0(SZK_(G)+1) ! The resting interface heights [Z ~> m], usually ! negative because it is positive upward. real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in Z ~> m. - real :: min_thickness ! The minimum layer thicknesses, in Z ~> m. + ! positive upward [Z ~> m]. + real :: min_thickness ! The minimum layer thicknesses [Z ~> m]. real :: S_surf, S_range, S_ref, S_light, S_dense ! Various salinities, in ppt. - real :: eta_IC_quanta ! The granularity of quantization of intial interface heights, in Z-1 ~> m-1. + real :: eta_IC_quanta ! The granularity of quantization of intial interface heights [Z-1 ~> m-1]. ! This include declares and sets the variable "version". # include "version_variable.h" character(len=20) :: verticalCoordinate diff --git a/src/user/external_gwave_initialization.F90 b/src/user/external_gwave_initialization.F90 index 286fa59237..b601b1c842 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -37,7 +37,7 @@ subroutine external_gwave_initialize_thickness(h, G, GV, US, param_file, just_re !! only read parameters without changing h. ! Local variables real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in Z ~> m. + ! positive upward [Z ~> m]. real :: ssh_anomaly_height ! Vertical height of ssh anomaly real :: ssh_anomaly_width ! Lateral width of anomaly logical :: just_read ! If true, just read parameters but set nothing. diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 29ed09e5d7..2e7ae74628 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -88,13 +88,13 @@ subroutine seamount_initialize_thickness ( h, G, GV, US, param_file, just_read_p logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: e0(SZK_(G)+1) ! The resting interface heights, in Z ~> m, usually + real :: e0(SZK_(G)+1) ! The resting interface heights [Z ~> m], usually ! negative because it is positive upward. real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in Z ~> m. - real :: min_thickness ! The minimum layer thicknesses, in Z ~> m. + ! positive upward [Z ~> m]. + real :: min_thickness ! The minimum layer thicknesses [Z ~> m]. real :: S_surf, S_range, S_ref, S_light, S_dense ! Various salinities, in ppt. - real :: eta_IC_quanta ! The granularity of quantization of intial interface heights, in Z-1 ~> m-1. + real :: eta_IC_quanta ! The granularity of quantization of intial interface heights [Z-1 ~> m-1]. character(len=20) :: verticalCoordinate logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, nz diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index fa90d27960..18975d4ec0 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -53,16 +53,16 @@ subroutine user_change_diff(h, tv, G, GV, CS, Kd_lay, Kd_int, T_f, S_f, Kd_int_a !! fields. Absent fields have NULL ptrs. type(user_change_diff_CS), pointer :: CS !< This module's control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity of - !! each layer in Z2 s-1 ~> m2 s-1. + !! each layer [Z2 s-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int !< The diapycnal diffusivity - !! at each interface in Z2 s-1 ~> m2 s-1. + !! at each interface [Z2 s-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: T_f !< Temperature with massless !! layers filled in vertically. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: S_f !< Salinity with massless !! layers filled in vertically. real, dimension(:,:,:), optional, pointer :: Kd_int_add !< The diapycnal !! diffusivity that is being added at - !! each interface in Z2 s-1 ~> m2 s-1. + !! each interface [Z2 s-1 ~> m2 s-1]. ! Local variables real :: Rcv(SZI_(G),SZK_(G)) ! The coordinate density in layers in kg m-3. real :: p_ref(SZI_(G)) ! An array of tv%P_Ref pressures. diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 2463205349..bd22e61116 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -245,7 +245,7 @@ end subroutine write_user_log !! - u - Zonal velocity in m s-1. !! - v - Meridional velocity in m s-1. !! - h - Layer thickness in H ~> m or kg m-2. (Must be positive.) -!! - G%bathyT - Basin depth in Z ~> m. (Must be positive.) +!! - G%bathyT - Basin depth [Z ~> m]. (Must be positive.) !! - G%CoriolisBu - The Coriolis parameter, in s-1. !! - GV%g_prime - The reduced gravity at each interface, in m2 Z-1 s-2 ~> m s-2. !! - GV%Rlay - Layer potential density (coordinate variable), kg m-3. From 9df06558b2cd5b4d405552fe97335f5f564f2b68 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 19 Dec 2018 17:44:00 -0500 Subject: [PATCH 0965/1072] Use square-brackets in thickness documentation Changed comments indicating the units of thicknesses and other variables to use square brackets, following the newly proposed MOM6 syntax convection. Only comments have been changed and all answers are bitwise identical. --- src/ALE/MOM_ALE.F90 | 12 +- src/ALE/MOM_regridding.F90 | 64 ++--- src/ALE/coord_adapt.F90 | 10 +- src/ALE/coord_hycom.F90 | 4 +- src/ALE/coord_rho.F90 | 2 +- src/ALE/coord_sigma.F90 | 8 +- src/ALE/coord_slight.F90 | 42 +-- src/ALE/coord_zlike.F90 | 2 +- src/core/MOM.F90 | 8 +- src/core/MOM_CoriolisAdv.F90 | 4 +- src/core/MOM_PressureForce.F90 | 4 +- src/core/MOM_PressureForce_Montgomery.F90 | 12 +- src/core/MOM_PressureForce_analytic_FV.F90 | 16 +- src/core/MOM_PressureForce_blocked_AFV.F90 | 24 +- src/core/MOM_barotropic.F90 | 200 +++++++------- src/core/MOM_boundary_update.F90 | 2 +- src/core/MOM_checksum_packages.F90 | 6 +- src/core/MOM_continuity_PPM.F90 | 212 +++++++------- src/core/MOM_dynamics_split_RK2.F90 | 2 +- src/core/MOM_dynamics_unsplit.F90 | 6 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 4 +- src/core/MOM_forcing_type.F90 | 50 ++-- src/core/MOM_grid.F90 | 2 +- src/core/MOM_interface_heights.F90 | 10 +- src/core/MOM_isopycnal_slopes.F90 | 14 +- src/core/MOM_variables.F90 | 28 +- src/core/MOM_verticalGrid.F90 | 4 +- src/diagnostics/MOM_PointAccel.F90 | 8 +- src/diagnostics/MOM_diag_to_Z.F90 | 10 +- src/diagnostics/MOM_diagnostics.F90 | 16 +- src/diagnostics/MOM_sum_output.F90 | 2 +- src/diagnostics/MOM_wave_speed.F90 | 6 +- src/diagnostics/MOM_wave_structure.F90 | 4 +- src/equation_of_state/MOM_EOS.F90 | 12 +- src/equation_of_state/MOM_EOS_Wright.F90 | 4 +- src/equation_of_state/MOM_EOS_linear.F90 | 4 +- src/framework/MOM_diag_mediator.F90 | 2 +- src/framework/MOM_spatial_means.F90 | 6 +- .../MOM_coord_initialization.F90 | 14 +- src/initialization/MOM_grid_initialize.F90 | 4 +- .../MOM_state_initialization.F90 | 33 ++- .../MOM_tracer_initialization_from_Z.F90 | 4 +- src/ocean_data_assim/MOM_oda_driver.F90 | 4 +- src/parameterizations/lateral/MOM_MEKE.F90 | 2 +- .../lateral/MOM_hor_visc.F90 | 12 +- .../lateral/MOM_internal_tides.F90 | 2 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 2 +- .../lateral/MOM_mixed_layer_restrat.F90 | 36 +-- .../lateral/MOM_thickness_diffuse.F90 | 34 +-- .../vertical/MOM_ALE_sponge.F90 | 4 +- .../vertical/MOM_bulk_mixed_layer.F90 | 260 +++++++++--------- .../vertical/MOM_diabatic_aux.F90 | 48 ++-- .../vertical/MOM_diabatic_driver.F90 | 6 +- .../vertical/MOM_diapyc_energy_req.F90 | 62 ++--- .../vertical/MOM_energetic_PBL.F90 | 66 ++--- .../vertical/MOM_entrain_diffusive.F90 | 170 ++++++------ .../vertical/MOM_full_convection.F90 | 38 +-- .../vertical/MOM_geothermal.F90 | 14 +- .../vertical/MOM_internal_tide_input.F90 | 4 +- .../vertical/MOM_kappa_shear.F90 | 91 +++--- .../vertical/MOM_regularize_layers.F90 | 52 ++-- .../vertical/MOM_set_diffusivity.F90 | 24 +- .../vertical/MOM_set_viscosity.F90 | 140 +++++----- .../vertical/MOM_shortwave_abs.F90 | 18 +- src/parameterizations/vertical/MOM_sponge.F90 | 22 +- .../vertical/MOM_tidal_mixing.F90 | 16 +- .../vertical/MOM_vert_friction.F90 | 42 +-- src/tracer/DOME_tracer.F90 | 4 +- src/tracer/MOM_OCMIP2_CFC.F90 | 6 +- src/tracer/MOM_generic_tracer.F90 | 6 +- src/tracer/MOM_offline_main.F90 | 6 +- src/tracer/MOM_tracer_Z_init.F90 | 2 +- src/tracer/MOM_tracer_advect.F90 | 12 +- src/tracer/MOM_tracer_diabatic.F90 | 10 +- src/tracer/MOM_tracer_flow_control.F90 | 6 +- src/tracer/MOM_tracer_hor_diff.F90 | 2 +- src/tracer/advection_test_tracer.F90 | 4 +- src/tracer/boundary_impulse_tracer.F90 | 4 +- src/tracer/dye_example.F90 | 4 +- src/tracer/dyed_obc_tracer.F90 | 2 +- src/tracer/ideal_age_example.F90 | 4 +- src/tracer/oil_tracer.F90 | 4 +- src/tracer/pseudo_salt_tracer.F90 | 4 +- src/tracer/tracer_example.F90 | 6 +- src/user/BFB_initialization.F90 | 10 +- src/user/DOME2d_initialization.F90 | 8 +- src/user/DOME_initialization.F90 | 4 +- src/user/ISOMIP_initialization.F90 | 10 +- src/user/Kelvin_initialization.F90 | 2 +- src/user/MOM_wave_interface.F90 | 4 +- src/user/Neverland_initialization.F90 | 4 +- src/user/Phillips_initialization.F90 | 4 +- src/user/SCM_CVMix_tests.F90 | 16 +- src/user/adjustment_initialization.F90 | 8 +- src/user/benchmark_initialization.F90 | 14 +- src/user/circle_obcs_initialization.F90 | 8 +- src/user/external_gwave_initialization.F90 | 2 +- src/user/lock_exchange_initialization.F90 | 2 +- src/user/seamount_initialization.F90 | 4 +- src/user/sloshing_initialization.F90 | 4 +- src/user/soliton_initialization.F90 | 2 +- src/user/user_change_diffusivity.F90 | 2 +- src/user/user_initialization.F90 | 12 +- 103 files changed, 1127 insertions(+), 1129 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 2f0db1dd74..2084ec2d7d 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -306,7 +306,7 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, dt, frac_shelf_h) type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the - !! last time step in H ~> m or kg m-2 + !! last time step [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity field (m/s) real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< Meridional velocity field (m/s) type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure @@ -567,9 +567,9 @@ subroutine check_grid( G, GV, h, threshold ) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Current 3D grid obtained after the - !! last time step (H ~> m or kg m-2) + !! last time step [H ~> m or kg m-2] real, intent(in) :: threshold !< Value below which to flag issues, - !! in H ~> m or kg m-2 + !! [H ~> m or kg m-2] ! Local variables integer :: i, j @@ -967,7 +967,7 @@ subroutine pressure_gradient_plm( CS, S_t, S_b, T_t, T_b, G, GV, tv, h, bdry_ext intent(inout) :: T_b !< Temperature at the bottom edge of each layer type(thermo_var_ptrs), intent(in) :: tv !< thermodynamics structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< layer thickness in H ~> m or kg m-2 + intent(in) :: h !< layer thickness [H ~> m or kg m-2] logical, intent(in) :: bdry_extrap !< If true, use high-order boundary !! extrapolation within boundary cells @@ -1041,7 +1041,7 @@ subroutine pressure_gradient_ppm( CS, S_t, S_b, T_t, T_b, G, GV, tv, h, bdry_ext intent(inout) :: T_b !< Temperature at the bottom edge of each layer type(thermo_var_ptrs), intent(in) :: tv !< thermodynamics structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< layer thicknesses in H ~> m or kg m-2 + intent(in) :: h !< layer thicknesses [H ~> m or kg m-2] logical, intent(in) :: bdry_extrap !< If true, use high-order boundary !! extrapolation within boundary cells @@ -1229,7 +1229,7 @@ subroutine ALE_initThicknessToCoord( CS, G, GV, h ) type(ALE_CS), intent(inout) :: CS !< module control structure type(ocean_grid_type), intent(in) :: G !< module grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: h !< layer thickness in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: h !< layer thickness [H ~> m or kg m-2] ! Local variables integer :: i, j, k diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index fc43a41195..e3e03e8300 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -65,11 +65,11 @@ module MOM_regridding logical :: target_density_set = .false. !> This array is set by function set_regrid_max_depths() - !! It specifies the maximum depth that every interface is allowed to take, in H ~> m or kg m-2. + !! It specifies the maximum depth that every interface is allowed to take [H ~> m or kg m-2]. real, dimension(:), allocatable :: max_interface_depths !> This array is set by function set_regrid_max_thickness() - !! It specifies the maximum depth that every interface is allowed to take, in H ~> m or kg m-2. + !! It specifies the maximum depth that every interface is allowed to take [H ~> m or kg m-2]. real, dimension(:), allocatable :: max_layer_thickness integer :: nk !< Number of layers/levels in generated grid @@ -81,7 +81,7 @@ module MOM_regridding !> Interpolation control structure type(interp_CS_type) :: interp_CS - !> Minimum thickness allowed when building the new grid through regridding, in H ~> m or kg m-2. + !> Minimum thickness allowed when building the new grid through regridding [H ~> m or kg m-2]. real :: min_thickness !> Reference pressure for potential density calculations (Pa) @@ -93,10 +93,10 @@ module MOM_regridding !! depth_of_time_filter_deep. real :: old_grid_weight = 0. - !> Depth above which no time-filtering of grid is applied (H ~> m or kg m-2) + !> Depth above which no time-filtering of grid is applied [H ~> m or kg m-2] real :: depth_of_time_filter_shallow = 0. - !> Depth below which time-filtering of grid is applied at full effect (H ~> m or kg m-2) + !> Depth below which time-filtering of grid is applied at full effect [H ~> m or kg m-2] real :: depth_of_time_filter_deep = 0. !> Fraction (between 0 and 1) of compressibility to add to potential density @@ -1137,9 +1137,9 @@ subroutine build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h) type(regridding_CS), intent(in) :: CS !< Regridding control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G), CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth - !! in H ~> m or kg m-2. + !! [H ~> m or kg m-2]. real, dimension(:,:), optional, pointer :: frac_shelf_h !< Fractional ice shelf coverage. ! Local variables integer :: i, j, k @@ -1238,9 +1238,9 @@ subroutine build_sigma_grid( CS, G, GV, h, dzInterface ) type(regridding_CS), intent(in) :: CS !< Regridding control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G), CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth - !! in H ~> m or kg m-2 + !! [H ~> m or kg m-2] ! Local variables integer :: i, j, k @@ -1324,10 +1324,10 @@ subroutine build_rho_grid( G, GV, h, tv, dzInterface, remapCS, CS ) ! Arguments type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, dimension(SZI_(G),SZJ_(G), SZK_(GV)+1), intent(inout) :: dzInterface !< The change in interface depth - !! in H ~> m or kg m-2 + !! [H ~> m or kg m-2] type(remapping_CS), intent(in) :: remapCS !< The remapping control structure type(regridding_CS), intent(in) :: CS !< Regridding control structure @@ -1438,16 +1438,16 @@ end subroutine build_rho_grid subroutine build_grid_HyCOM1( G, GV, h, tv, h_new, dzInterface, CS ) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Existing model thickness, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Existing model thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure type(regridding_CS), intent(in) :: CS !< Regridding control structure - real, dimension(SZI_(G),SZJ_(G),CS%nk), intent(inout) :: h_new !< New layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),CS%nk), intent(inout) :: h_new !< New layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< Changes in interface position ! Local variables - real, dimension(SZK_(GV)+1) :: z_col ! Source interface positions relative to the surface in H ~> m or kg m-2 - real, dimension(CS%nk+1) :: z_col_new ! New interface positions relative to the surface in H ~> m or kg m-2 - real, dimension(SZK_(GV)+1) :: dz_col ! The realized change in z_col in H ~> m or kg m-2 + real, dimension(SZK_(GV)+1) :: z_col ! Source interface positions relative to the surface [H ~> m or kg m-2] + real, dimension(CS%nk+1) :: z_col_new ! New interface positions relative to the surface [H ~> m or kg m-2] + real, dimension(SZK_(GV)+1) :: dz_col ! The realized change in z_col [H ~> m or kg m-2] real, dimension(SZK_(GV)) :: p_col ! Layer pressure in Pa integer :: i, j, k, nki real :: depth @@ -1507,11 +1507,11 @@ end subroutine build_grid_HyCOM1 subroutine build_grid_adaptive(G, GV, h, tv, dzInterface, remapCS, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: dzInterface !< The change in interface depth - !! in H ~> m or kg m-2 + !! [H ~> m or kg m-2] type(remapping_CS), intent(in) :: remapCS !< The remapping control structure type(regridding_CS), intent(in) :: CS !< Regridding control structure @@ -1573,14 +1573,14 @@ end subroutine build_grid_adaptive subroutine build_grid_SLight(G, GV, h, tv, dzInterface, CS) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Existing model thickness, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Existing model thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: dzInterface !< Changes in interface position type(regridding_CS), intent(in) :: CS !< Regridding control structure - real, dimension(SZK_(GV)+1) :: z_col ! Interface positions relative to the surface in H ~> m or kg m-2 - real, dimension(SZK_(GV)+1) :: z_col_new ! Interface positions relative to the surface in H ~> m or kg m-2 - real, dimension(SZK_(GV)+1) :: dz_col ! The realized change in z_col in H ~> m or kg m-2 + real, dimension(SZK_(GV)+1) :: z_col ! Interface positions relative to the surface [H ~> m or kg m-2] + real, dimension(SZK_(GV)+1) :: z_col_new ! Interface positions relative to the surface [H ~> m or kg m-2] + real, dimension(SZK_(GV)+1) :: dz_col ! The realized change in z_col [H ~> m or kg m-2] real, dimension(SZK_(GV)) :: p_col ! Layer pressure in Pa real :: depth integer :: i, j, k, nz @@ -1637,8 +1637,8 @@ end subroutine build_grid_SLight subroutine adjust_interface_motion( CS, nk, h_old, dz_int ) type(regridding_CS), intent(in) :: CS !< Regridding control structure integer, intent(in) :: nk !< Number of layers in h_old - real, dimension(nk), intent(in) :: h_old !< Minium allowed thickness of h (H ~> m or kg m-2) - real, dimension(CS%nk+1), intent(inout) :: dz_int !< Minium allowed thickness of h (H ~> m or kg m-2) + real, dimension(nk), intent(in) :: h_old !< Minium allowed thickness of h [H ~> m or kg m-2] + real, dimension(CS%nk+1), intent(inout) :: dz_int !< Minium allowed thickness of h [H ~> m or kg m-2] ! Local variables integer :: k real :: h_new, eps, h_total, h_err @@ -1703,10 +1703,10 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) ! Arguments type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(in) :: h !< Original layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(in) :: h !< Original layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G), SZK_(GV)+1), intent(inout) :: dzInterface !< The change in interface - !! depth in H ~> m or kg m-2 - real, intent(inout) :: h_new !< New layer thicknesses, in H ~> m or kg m-2 + !! depth [H ~> m or kg m-2] + real, intent(inout) :: h_new !< New layer thicknesses [H ~> m or kg m-2] type(regridding_CS), intent(in) :: CS !< Regridding control structure ! Local variables @@ -1810,7 +1810,7 @@ subroutine inflate_vanished_layers_old( CS, G, GV, h ) type(regridding_CS), intent(in) :: CS !< Regridding control structure type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] ! Local variables integer :: i, j, k @@ -1842,7 +1842,7 @@ subroutine convective_adjustment(G, GV, h, tv) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables !------------------------------------------------------------------------------ ! Check each water column to see whether it is stratified. If not, sort the @@ -2209,8 +2209,8 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri real, optional, intent(in) :: min_thickness !< Minimum thickness allowed when building the new grid (H) real, optional, intent(in) :: old_grid_weight !< Weight given to old coordinate when time-filtering grid character(len=*), optional, intent(in) :: interp_scheme !< Interpolation method for state-dependent coordinates - real, optional, intent(in) :: depth_of_time_filter_shallow !< Depth to start cubic (H ~> m or kg m-2) - real, optional, intent(in) :: depth_of_time_filter_deep !< Depth to end cubic (H ~> m or kg m-2) + real, optional, intent(in) :: depth_of_time_filter_shallow !< Depth to start cubic [H ~> m or kg m-2] + real, optional, intent(in) :: depth_of_time_filter_deep !< Depth to end cubic [H ~> m or kg m-2] real, optional, intent(in) :: compress_fraction !< Fraction of compressibility to add to potential density real, optional, intent(in) :: dz_min_surface !< The fixed resolution in the topmost SLight_nkml_min layers (H) integer, optional, intent(in) :: nz_fixed_surface !< The number of fixed-thickness layers at the top of the model @@ -2226,7 +2226,7 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri logical, optional, intent(in) :: integrate_downward_for_e !< If true, integrate for interface positions downward !! from the top. real, optional, intent(in) :: adaptTimeRatio !< Ratio of the ALE timestep to the grid timescale, ND. - real, optional, intent(in) :: adaptZoom !< Depth of near-surface zooming region, in H ~> m or kg m-2. + real, optional, intent(in) :: adaptZoom !< Depth of near-surface zooming region [H ~> m or kg m-2]. real, optional, intent(in) :: adaptZoomCoeff !< Coefficient of near-surface zooming diffusivity, ND. real, optional, intent(in) :: adaptBuoyCoeff !< Coefficient of buoyancy diffusivity, ND. real, optional, intent(in) :: adaptAlpha !< Scaling factor on optimization tendency, ND. diff --git a/src/ALE/coord_adapt.F90 b/src/ALE/coord_adapt.F90 index b6a047c983..c3d63280e4 100644 --- a/src/ALE/coord_adapt.F90 +++ b/src/ALE/coord_adapt.F90 @@ -18,7 +18,7 @@ module coord_adapt !> Number of layers/levels integer :: nk - !> Nominal near-surface resolution in H ~> m or kg m-2 + !> Nominal near-surface resolution [H ~> m or kg m-2] real, allocatable, dimension(:) :: coordinateResolution !> Ratio of optimisation and diffusion timescales @@ -27,7 +27,7 @@ module coord_adapt !> Nondimensional coefficient determining how much optimisation to apply real :: adaptAlpha - !> Near-surface zooming depth in H ~> m or kg m-2 + !> Near-surface zooming depth [H ~> m or kg m-2] real :: adaptZoom !> Near-surface zooming coefficient @@ -93,7 +93,7 @@ subroutine set_adapt_params(CS, adaptTimeRatio, adaptAlpha, adaptZoom, adaptZoom real, optional, intent(in) :: adaptTimeRatio !< Ratio of optimisation and diffusion timescales real, optional, intent(in) :: adaptAlpha !< Nondimensional coefficient determining !! how much optimisation to apply - real, optional, intent(in) :: adaptZoom !< Near-surface zooming depth, in H ~> m or kg m-2 + real, optional, intent(in) :: adaptZoom !< Near-surface zooming depth [H ~> m or kg m-2] real, optional, intent(in) :: adaptZoomCoeff !< Near-surface zooming coefficient real, optional, intent(in) :: adaptBuoyCoeff !< Stratification-dependent diffusion coefficient real, optional, intent(in) :: adaptDrho0 !< Reference density difference for @@ -121,10 +121,10 @@ subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) !! thermodynamic variables integer, intent(in) :: i !< The i-index of the column to work on integer, intent(in) :: j !< The j-index of the column to work on - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: zInt !< Interface heights, in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: zInt !< Interface heights [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: tInt !< Interface temperatures, in C real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: sInt !< Interface salinities, in psu - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZK_(GV)+1), intent(inout) :: zNext !< updated interface positions ! Local variables diff --git a/src/ALE/coord_hycom.F90 b/src/ALE/coord_hycom.F90 index 7341bf655d..4b38c683c7 100644 --- a/src/ALE/coord_hycom.F90 +++ b/src/ALE/coord_hycom.F90 @@ -99,12 +99,12 @@ subroutine build_hycom1_column(CS, eqn_of_state, nz, depth, h, T, S, p_col, & type(hycom_CS), intent(in) :: CS !< Coordinate control structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure integer, intent(in) :: nz !< Number of levels - real, intent(in) :: depth !< Depth of ocean bottom (positive in H ~> m or kg m-2) + real, intent(in) :: depth !< Depth of ocean bottom (positive [H ~> m or kg m-2]) real, dimension(nz), intent(in) :: T !< Temperature of column (degC) real, dimension(nz), intent(in) :: S !< Salinity of column (psu) real, dimension(nz), intent(in) :: h !< Layer thicknesses, (in m or H) real, dimension(nz), intent(in) :: p_col !< Layer pressure in Pa - real, dimension(nz+1), intent(in) :: z_col !< Interface positions relative to the surface in H ~> m or kg m-2 + real, dimension(nz+1), intent(in) :: z_col !< Interface positions relative to the surface [H ~> m or kg m-2] real, dimension(CS%nk+1), intent(inout) :: z_col_new !< Absolute positions of interfaces real, optional, intent(in) :: zScale !< Scaling factor from the input thicknesses in m !! to desired units for zInterface, perhaps m_to_H. diff --git a/src/ALE/coord_rho.F90 b/src/ALE/coord_rho.F90 index b72dfd445c..6c9ec71582 100644 --- a/src/ALE/coord_rho.F90 +++ b/src/ALE/coord_rho.F90 @@ -96,7 +96,7 @@ subroutine build_rho_column(CS, nz, depth, h, T, S, eqn_of_state, z_interface, & type(rho_CS), intent(in) :: CS !< coord_rho control structure integer, intent(in) :: nz !< Number of levels on source grid (i.e. length of h, T, S) real, intent(in) :: depth !< Depth of ocean bottom (positive in m) - real, dimension(nz), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(nz), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(nz), intent(in) :: T !< T for source column real, dimension(nz), intent(in) :: S !< S for source column type(EOS_type), pointer :: eqn_of_state !< Equation of state structure diff --git a/src/ALE/coord_sigma.F90 b/src/ALE/coord_sigma.F90 index d16d743838..0abc0c8e2b 100644 --- a/src/ALE/coord_sigma.F90 +++ b/src/ALE/coord_sigma.F90 @@ -51,7 +51,7 @@ end subroutine end_coord_sigma !> This subroutine can be used to set the parameters for the coord_sigma module subroutine set_sigma_params(CS, min_thickness) type(sigma_CS), pointer :: CS !< Coordinate control structure - real, optional, intent(in) :: min_thickness !< Minimum allowed thickness, in H ~> m or kg m-2 + real, optional, intent(in) :: min_thickness !< Minimum allowed thickness [H ~> m or kg m-2] if (.not. associated(CS)) call MOM_error(FATAL, "set_sigma_params: CS not associated") @@ -62,9 +62,9 @@ end subroutine set_sigma_params !> Build a sigma coordinate column subroutine build_sigma_column(CS, depth, totalThickness, zInterface) type(sigma_CS), intent(in) :: CS !< Coordinate control structure - real, intent(in) :: depth !< Depth of ocean bottom (positive in H ~> m or kg m-2) - real, intent(in) :: totalThickness !< Column thickness (positive in H ~> m or kg m-2) - real, dimension(CS%nk+1), intent(inout) :: zInterface !< Absolute positions of interfaces in H ~> m or kg m-2 + real, intent(in) :: depth !< Depth of ocean bottom (positive [H ~> m or kg m-2]) + real, intent(in) :: totalThickness !< Column thickness (positive [H ~> m or kg m-2]) + real, dimension(CS%nk+1), intent(inout) :: zInterface !< Absolute positions of interfaces [H ~> m or kg m-2] ! Local variables integer :: k diff --git a/src/ALE/coord_slight.F90 b/src/ALE/coord_slight.F90 index cad0cfb824..a6afd27f9b 100644 --- a/src/ALE/coord_slight.F90 +++ b/src/ALE/coord_slight.F90 @@ -45,7 +45,7 @@ module coord_slight logical :: fix_haloclines = .false. !> A length scale over which to filter T & S when looking for spuriously - !! unstable water mass profiles, in H ~> m or kg m-2. + !! unstable water mass profiles [H ~> m or kg m-2]. real :: halocline_filter_length !> A value of the stratification ratio that defines a problematic halocline region (nondim). @@ -54,10 +54,10 @@ module coord_slight !> Nominal density of interfaces, in kg m-3. real, allocatable, dimension(:) :: target_density - !> Maximum depths of interfaces, in H ~> m or kg m-2. + !> Maximum depths of interfaces [H ~> m or kg m-2]. real, allocatable, dimension(:) :: max_interface_depths - !> Maximum thicknesses of layers, in H ~> m or kg m-2. + !> Maximum thicknesses of layers [H ~> m or kg m-2]. real, allocatable, dimension(:) :: max_layer_thickness !> Interpolation control structure @@ -117,11 +117,11 @@ subroutine set_slight_params(CS, max_interface_depths, max_layer_thickness, & halocline_filter_length, halocline_strat_tol, interp_CS) type(slight_CS), pointer :: CS !< Coordinate control structure real, dimension(:), & - optional, intent(in) :: max_interface_depths !< Maximum depths of interfaces in H ~> m or kg m-2 + optional, intent(in) :: max_interface_depths !< Maximum depths of interfaces [H ~> m or kg m-2] real, dimension(:), & - optional, intent(in) :: max_layer_thickness !< Maximum thicknesses of layers in H ~> m or kg m-2 + optional, intent(in) :: max_layer_thickness !< Maximum thicknesses of layers [H ~> m or kg m-2] real, optional, intent(in) :: min_thickness !< Minimum thickness allowed when building the - !! new grid through regridding, in H ~> m or kg m-2 + !! new grid through regridding [H ~> m or kg m-2] real, optional, intent(in) :: compressibility_fraction !< Fraction (between 0 and 1) of !! compressibility to add to potential density profiles when !! interpolating for target grid positions. (nondim) @@ -136,7 +136,7 @@ subroutine set_slight_params(CS, max_interface_depths, max_layer_thickness, & logical, optional, intent(in) :: fix_haloclines !< If true, detect regions with much weaker than !! based on in-situ density, and use a stretched coordinate there. real, optional, intent(in) :: halocline_filter_length !< A length scale over which to filter T & S - !! when looking for spuriously unstable water mass profiles, in H ~> m or kg m-2. + !! when looking for spuriously unstable water mass profiles [H ~> m or kg m-2]. real, optional, intent(in) :: halocline_strat_tol !< A value of the stratification ratio that !! defines a problematic halocline region (nondim). type(interp_CS_type), & @@ -185,17 +185,17 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_Pa, H_subroundoff, & real, intent(in) :: H_to_Pa !< GV%H_to_Pa real, intent(in) :: H_subroundoff !< GV%H_subroundoff integer, intent(in) :: nz !< Number of levels - real, intent(in) :: depth !< Depth of ocean bottom (positive in H ~> m or kg m-2) + real, intent(in) :: depth !< Depth of ocean bottom (positive [H ~> m or kg m-2]) real, dimension(nz), intent(in) :: T_col !< T for column real, dimension(nz), intent(in) :: S_col !< S for column - real, dimension(nz), intent(in) :: h_col !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(nz), intent(in) :: h_col !< Layer thicknesses [H ~> m or kg m-2] real, dimension(nz), intent(in) :: p_col !< Layer quantities - real, dimension(nz+1), intent(in) :: z_col !< Interface positions relative to the surface in H ~> m or kg m-2 - real, dimension(nz+1), intent(inout) :: z_col_new !< Absolute positions of interfaces in H ~> m or kg m-2 + real, dimension(nz+1), intent(in) :: z_col !< Interface positions relative to the surface [H ~> m or kg m-2] + real, dimension(nz+1), intent(inout) :: z_col_new !< Absolute positions of interfaces [H ~> m or kg m-2] real, optional, intent(in) :: h_neglect !< A negligibly small width for the purpose of - !! cell reconstructions in H ~> m or kg m-2. + !! cell reconstructions [H ~> m or kg m-2]. real, optional, intent(in) :: h_neglect_edge !< A negligibly small width for the purpose - !! of edge value calculations in H ~> m or kg m-2. + !! of edge value calculations [H ~> m or kg m-2]. ! Local variables real, dimension(nz) :: rho_col ! Layer quantities real, dimension(nz) :: T_f, S_f ! Filtered ayer quantities @@ -208,20 +208,20 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_Pa, H_subroundoff, & real :: H_to_cPa real :: drIS, drR, Fn_now, I_HStol, Fn_zero_val real :: z_int_unst - real :: dz ! A uniform layer thickness in very shallow water, in H ~> m or kg m-2. - real :: dz_ur ! The total thickness of an unstable region, in H ~> m or kg m-2. + real :: dz ! A uniform layer thickness in very shallow water [H ~> m or kg m-2]. + real :: dz_ur ! The total thickness of an unstable region [H ~> m or kg m-2]. real :: wgt, cowgt ! A weight and its complement, nondim. real :: rho_ml_av ! The average potential density in a near-surface region, in kg m-3. - real :: H_ml_av ! A thickness to try to use in taking the near-surface average, in H ~> m or kg m-2. + real :: H_ml_av ! A thickness to try to use in taking the near-surface average [H ~> m or kg m-2]. real :: rho_x_z ! A cumulative integral of a density, in kg m-3 H. - real :: z_wt ! The thickness actually used in taking the near-surface average, in H ~> m or kg m-2. + real :: z_wt ! The thickness actually used in taking the near-surface average [H ~> m or kg m-2]. real :: k_interior ! The (real) value of k where the interior grid starts. real :: k_int2 ! The (real) value of k where the interior grid starts. - real :: z_interior ! The depth where the interior grid starts, in H ~> m or kg m-2. - real :: z_ml_fix ! The depth at which the fixed-thickness near-surface layers end, in H ~> m or kg m-2. + real :: z_interior ! The depth where the interior grid starts [H ~> m or kg m-2]. + real :: z_ml_fix ! The depth at which the fixed-thickness near-surface layers end [H ~> m or kg m-2]. real :: dz_dk ! The thickness of layers between the fixed-thickness - ! near-surface layars and the interior, in H ~> m or kg m-2. - real :: Lfilt ! A filtering lengthscale, in H ~> m or kg m-2. + ! near-surface layars and the interior [H ~> m or kg m-2]. + real :: Lfilt ! A filtering lengthscale [H ~> m or kg m-2]. logical :: maximum_depths_set ! If true, the maximum depths of interface have been set. logical :: maximum_h_set ! If true, the maximum layer thicknesses have been set. real :: k2_used, k2here, dz_sum, z_max diff --git a/src/ALE/coord_zlike.F90 b/src/ALE/coord_zlike.F90 index 7016605d5d..98bfa36fae 100644 --- a/src/ALE/coord_zlike.F90 +++ b/src/ALE/coord_zlike.F90 @@ -52,7 +52,7 @@ end subroutine end_coord_zlike !> Set parameters in the zlike structure subroutine set_zlike_params(CS, min_thickness) type(zlike_CS), pointer :: CS !< Coordinate control structure - real, optional, intent(in) :: min_thickness !< Minimum allowed thickness, in H ~> m or kg m-2 + real, optional, intent(in) :: min_thickness !< Minimum allowed thickness [H ~> m or kg m-2] if (.not. associated(CS)) call MOM_error(FATAL, "set_zlike_params: CS not associated") diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index f85c5b9ca1..02cce98b70 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -251,7 +251,7 @@ module MOM type(time_type) :: Z_diag_time !< next time to compute Z-space diagnostics real, dimension(:,:,:), pointer :: & - h_pre_dyn => NULL(), & !< The thickness before the transports, in H ~> m or kg m-2. + h_pre_dyn => NULL(), & !< The thickness before the transports [H ~> m or kg m-2]. T_pre_dyn => NULL(), & !< Temperature before the transports, in degC. S_pre_dyn => NULL() !< Salinity before the transports, in psu. type(accel_diag_ptrs) :: ADp !< structure containing pointers to accelerations, @@ -2712,10 +2712,10 @@ subroutine extract_surface_state(CS, sfc_state) u => NULL(), & !< u : zonal velocity component (m/s) v => NULL(), & !< v : meridional velocity component (m/s) h => NULL() !< h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) - real :: depth(SZI_(CS%G)) !< Distance from the surface in depth units (Z ~> m) + real :: depth(SZI_(CS%G)) !< Distance from the surface in depth units [Z ~> m] real :: depth_ml !< Depth over which to average to determine mixed - !! layer properties (Z ~> m) - real :: dh !< Thickness of a layer within the mixed layer (Z ~> m) + !! layer properties [Z ~> m] + real :: dh !< Thickness of a layer within the mixed layer [Z ~> m] real :: mass !< Mass per unit area of a layer (kg/m2) real :: bathy_m !< The depth of bathymetry in m (not Z), used for error checking. real :: T_freeze !< freezing temperature (oC) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 72f6a61a3a..cbd54f6307 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -143,13 +143,13 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) KE ! Kinetic energy per unit mass, KE = (u^2 + v^2)/2, in m2 s-2. real, dimension(SZIB_(G),SZJ_(G)) :: & hArea_u, & ! The cell area weighted thickness interpolated to u points - ! times the effective areas, in H m2 ~> m3 or kg. + ! times the effective areas [H m2 ~> m3 or kg]. KEx, & ! The zonal gradient of Kinetic energy per unit mass, ! KEx = d/dx KE, in m s-2. uh_center ! centered u times h at u-points real, dimension(SZI_(G),SZJB_(G)) :: & hArea_v, & ! The cell area weighted thickness interpolated to v points - ! times the effective areas, in H m2 ~> m3 or kg. + ! times the effective areas [H m2 ~> m3 or kg]. KEy, & ! The meridonal gradient of Kinetic energy per unit mass, ! KEy = d/dy KE, in m s-2. vh_center ! centered v times h at v-points diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index 58098d785c..a66b55b0f3 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -49,7 +49,7 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: PFu !< Zonal pressure force acceleration (m/s2) @@ -65,7 +65,7 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e !! due to eta anomalies, in m2 s-2 H-1. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(out) :: eta !< The bottom mass used to calculate PFu and PFv, - !! in H ~> m or kg m-2, with any tidal contributions. + !! [H ~> m or kg m-2], with any tidal contributions. if (CS%Analytic_FV_PGF .and. CS%blocked_AFV) then if (GV%Boussinesq) then diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 71ee260775..2d0f0156ae 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -102,7 +102,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! enable the use of a reduced gravity form of the equations, ! in m2 s-2. dp_star, & ! Layer thickness after compensation for compressibility, in Pa. - SSH, & ! The sea surface height anomaly, in depth units (Z ~> m). + SSH, & ! The sea surface height anomaly, in depth units [Z ~> m]. e_tidal, & ! Bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. geopot_bot ! Bottom geopotential relative to time-mean sea level, @@ -396,7 +396,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ! for compressibility [Z ~> m]. real :: e_tidal(SZI_(G),SZJ_(G)) ! Bottom geopotential anomaly due to tidal ! forces from astronomical sources and self- - ! attraction and loading, in depth units (Z ~> m). + ! attraction and loading, in depth units [Z ~> m]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, in Pa (usually 2e7 Pa = 2000 dbar). real :: I_Rho0 ! 1/Rho0, in m3 kg-1. @@ -617,18 +617,18 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) !! to free surface height anomalies, in m2 H-1 s-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: rho_star !< The layer densities (maybe compressibility - !! compensated), times g/rho_0, in m2 Z-1 s-2 ~> m s-2. + !! compensated), times g/rho_0 [m2 Z-1 s-2 ~> m s-2]. ! Local variables - real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer thicknesses, in H-1 ~> m-1 or m2 kg-1. + real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer thicknesses [H-1 ~> m-1 or m2 kg-1]. real :: press(SZI_(G)) ! Interface pressure, in Pa. real :: T_int(SZI_(G)) ! Interface temperature in C. real :: S_int(SZI_(G)) ! Interface salinity in PSU. real :: dR_dT(SZI_(G)) ! Partial derivatives of density with temperature real :: dR_dS(SZI_(G)) ! and salinity in kg m-3 K-1 and kg m-3 PSU-1. real :: rho_in_situ(SZI_(G)) !In-situ density at the top of a layer. - real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1. - real :: Rho0xG ! g_Earth * Rho0 in kg s-2 m-1 Z-1 ~> kg s-2 m-2. + real :: G_Rho0 ! G_Earth / Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1] + real :: Rho0xG ! g_Earth * Rho0 [kg s-2 m-1 Z-1 ~> kg s-2 m-2] logical :: use_EOS ! If true, density is calculated from T & S using ! an equation of state. real :: z_neglect ! A thickness that is so small it is usually lost diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index a679334198..b1536f1c2c 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -79,7 +79,7 @@ subroutine PressureForce_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbc !! anomaly in each layer due to eta anomalies, !! in m2 s-2 H-1. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to - !! calculate PFu and PFv, in H ~> m or kg m-2, with any tidal + !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal !! contributions or compressibility compensation. if (GV%Boussinesq) then @@ -115,7 +115,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p !! anomaly in each layer due to eta anomalies, !! in m2 s-2 H-1. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to - !! calculate PFu and PFv, in H ~> m or kg m-2, with any tidal + !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal !! contributions or compressibility compensation. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure in Pa. @@ -134,7 +134,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p ! the pressure anomaly at the top of the layer, in Pa m2 s-2. real, dimension(SZI_(G),SZJ_(G)) :: & dp, & ! The (positive) change in pressure across a layer, in Pa. - SSH, & ! The sea surface height anomaly, in depth units (Z ~> m). + SSH, & ! The sea surface height anomaly, in depth units [Z ~> m]. e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. dM, & ! The barotropic adjustment to the Montgomery potential to @@ -159,7 +159,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p real :: dp_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in Pa. - real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2 ~> m s-2. + real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. real :: I_gEarth ! The inverse of g_Earth_z, in s2 Z m-2 real :: alpha_anom ! The in-situ specific volume, averaged over a ! layer, less alpha_ref, in m3 kg-1. @@ -456,10 +456,10 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at !! anomaly in each layer due to eta anomalies, !! in m2 s-2 H-1. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to - !! calculate PFu and PFv, in H ~> m or kg m-2, with any + !! calculate PFu and PFv [H ~> m or kg m-2], with any !! tidal contributions or compressibility compensation. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in depth units (Z ~> m). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in depth units [Z ~> m]. real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. @@ -475,7 +475,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at dpa, & ! The change in pressure anomaly between the top and bottom ! of a layer, in Pa. intz_dpa ! The vertical integral in depth of the pressure anomaly less the - ! pressure anomaly at the top of the layer, in H Pa ~> m Pa or kg m-2 Pa. + ! pressure anomaly at the top of the layer [H Pa ~> m Pa or kg m-2 Pa]. real, dimension(SZIB_(G),SZJ_(G)) :: & intx_pa, & ! The zonal integral of the pressure anomaly along the interface ! atop a layer, divided by the grid spacing, in Pa. @@ -499,7 +499,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at real :: p0(SZI_(G)) ! An array of zeros to use for pressure in Pa. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in m. - real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2 ~> m s-2. + real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. real :: I_Rho0 ! 1/Rho0. real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. real :: Rho_ref ! The reference density in kg m-3. diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 00d13c7c06..c06cf2c90b 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -79,7 +79,7 @@ subroutine PressureForce_blk_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, !! anomaly in each layer due to eta anomalies, !! in m2 s-2 H-1. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to - !! calculate PFu and PFv, in H ~> m or kg m-2, with any tidal + !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal !! contributions or compressibility compensation. if (GV%Boussinesq) then @@ -114,7 +114,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, !! anomaly in each layer due to eta anomalies, !! in m2 s-2 H-1. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to - !! calculate PFu and PFv, in H ~> m or kg m-2, with any tidal + !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal !! contributions or compressibility compensation. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure in Pa. @@ -130,7 +130,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, ! the pressure anomaly at the top of the layer, in Pa m2 s-2. real, dimension(SZI_(G),SZJ_(G)) :: & dp, & ! The (positive) change in pressure across a layer, in Pa. - SSH, & ! The sea surface height anomaly, in depth units (Z ~> m). + SSH, & ! The sea surface height anomaly, in depth units [Z ~> m]. e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. dM, & ! The barotropic adjustment to the Montgomery potential to @@ -159,8 +159,8 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, real :: dp_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in Pa. - real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2 ~> m s-2. - real :: I_gEarth ! The inverse of g_Earth_z, in s2 Z m-2 ~> s2 m-1. + real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. + real :: I_gEarth ! The inverse of g_Earth_z [s2 Z m-2 ~> s2 m-1] real :: alpha_anom ! The in-situ specific volume, averaged over a ! layer, less alpha_ref, in m3 kg-1. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -427,7 +427,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration (m/s2) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration (m/s2) @@ -439,13 +439,13 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, !! anomaly in each layer due to eta anomalies, !! in m2 s-2 H-1. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to - !! calculate PFu and PFv, in H ~> m or kg m-2, with any tidal + !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal !! contributions or compressibility compensation. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in depth units (Z ~> m). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in depth units [Z ~> m]. real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from - ! astronomical sources and self-attraction and loading, in depth units (Z ~> m). + ! astronomical sources and self-attraction and loading, in depth units [Z ~> m]. dM ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model, in m2 s-2. real, dimension(SZI_(G)) :: & @@ -458,7 +458,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, dpa_bk, & ! The change in pressure anomaly between the top and bottom ! of a layer, in Pa. intz_dpa_bk ! The vertical integral in depth of the pressure anomaly less the - ! pressure anomaly at the top of the layer, in H Pa ~> m Pa or kg m-2 Pa. + ! pressure anomaly at the top of the layer [H Pa ~> m Pa or kg m-2 Pa]. real, dimension(SZDIB_(G%Block(1)),SZDJ_(G%Block(1))) :: & ! on block indices intx_pa_bk, & ! The zonal integral of the pressure anomaly along the interface ! atop a layer, divided by the grid spacing, in Pa. @@ -481,9 +481,9 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, ! density, in Pa (usually 2e7 Pa = 2000 dbar). real :: p0(SZI_(G)) ! An array of zeros to use for pressure in Pa. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: I_Rho0 ! 1/Rho0. - real :: g_Earth_z ! A scaled version of g_Earth, in m2 Z-1 s-2 ~> m s-2. + real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. real :: Rho_ref ! The reference density in kg m-3. real :: dz_neglect ! A minimal thickness [Z ~> m], like e. diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 8c7d1e477b..4a943ca84c 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -67,20 +67,20 @@ module MOM_barotropic type, private :: BT_OBC_type real, dimension(:,:), pointer :: Cg_u => NULL() !< The external wave speed at u-points, in m s-1. real, dimension(:,:), pointer :: Cg_v => NULL() !< The external wave speed at u-points, in m s-1. - real, dimension(:,:), pointer :: H_u => NULL() !< The total thickness at the u-points, in H ~> m or kg m-2. - real, dimension(:,:), pointer :: H_v => NULL() !< The total thickness at the v-points, in H ~> m or kg m-2. + real, dimension(:,:), pointer :: H_u => NULL() !< The total thickness at the u-points [H ~> m or kg m-2]. + real, dimension(:,:), pointer :: H_v => NULL() !< The total thickness at the v-points [H ~> m or kg m-2]. real, dimension(:,:), pointer :: uhbt => NULL() !< The zonal barotropic thickness fluxes specified - !! for open boundary conditions (if any), in H m2 s-1 ~> m3 s-1 or kg s-1. + !! for open boundary conditions (if any) [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(:,:), pointer :: vhbt => NULL() !< The meridional barotropic thickness fluxes specified - !! for open boundary conditions (if any), in H m2 s-1 ~> m3 s-1 or kg s-1. + !! for open boundary conditions (if any) [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(:,:), pointer :: ubt_outer => NULL() !< The zonal velocities just outside the domain, !! as set by the open boundary conditions, in units of m s-1. real, dimension(:,:), pointer :: vbt_outer => NULL() !< The meridional velocities just outside the domain, !! as set by the open boundary conditions, in units of m s-1. real, dimension(:,:), pointer :: eta_outer_u => NULL() !< The surface height outside of the domain - !! at a u-point with an open boundary condition, in H ~> m or kg m-2. + !! at a u-point with an open boundary condition [H ~> m or kg m-2]. real, dimension(:,:), pointer :: eta_outer_v => NULL() !< The surface height outside of the domain - !! at a v-point with an open boundary condition, in H ~> m or kg m-2. + !! at a v-point with an open boundary condition [H ~> m or kg m-2]. logical :: apply_u_OBCs !< True if this PE has an open boundary at a u-point. logical :: apply_v_OBCs !< True if this PE has an open boundary at a v-point. !>@{ Index ranges for the open boundary conditions @@ -105,11 +105,11 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: IDatu !< Inverse of the basin depth at u grid points [Z-1 ~> m-1]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: lin_drag_u - !< A spatially varying linear drag coefficient acting on the zonal barotropic flow, - !! in H s-1 ~> m s-1 or kg m-2 s-1. + !< A spatially varying linear drag coefficient acting on the zonal barotropic flow + !! [H s-1 ~> m s-1 or kg m-2 s-1]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt_IC !< The barotropic solvers estimate of the zonal transport as the initial condition for - !! the next call to btstep, in H m2 s-1 ~> m2 s-1 or kg s-1. + !! the next call to btstep [H m2 s-1 ~> m3 s-1 or kg s-1]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: ubt_IC !< The barotropic solvers estimate of the zonal velocity that will be the initial !! condition for the next call to btstep, in m s-1. @@ -118,11 +118,11 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: IDatv !< Inverse of the basin depth at v grid points [Z-1 ~> m-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: lin_drag_v - !< A spatially varying linear drag coefficient acting on the zonal barotropic flow, - !! in H s-1 ~> m s-1 or kg m-2 s-1. + !< A spatially varying linear drag coefficient acting on the zonal barotropic flow + !! [H s-1 ~> m s-1 or kg m-2 s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt_IC !< The barotropic solvers estimate of the zonal transport as the initial condition for - !! the next call to btstep, in H m2 s-1 ~> m2 s-1 or kg s-1. + !! the next call to btstep [H m2 s-1 ~> m3 s-1 or kg s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vbt_IC !< The barotropic solvers estimate of the zonal velocity that will be the initial !! condition for the next call to btstep, in m s-1. @@ -131,10 +131,10 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_cor !< The difference between the free surface height from the barotropic calculation and the sum !! of the layer thicknesses. This difference is imposed as a forcing term in the barotropic - !! calculation over a baroclinic timestep, in H ~> m or kg m-2. + !! calculation over a baroclinic timestep [H ~> m or kg m-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_cor_bound - !< A limit on the rate at which eta_cor can be applied while avoiding instability, - !! in H s-1 ~> m s-1 or kg m-2 s-1. This is only used if CS%bound_BT_corr is true. + !< A limit on the rate at which eta_cor can be applied while avoiding instability + !! [H s-1 ~> m s-1 or kg m-2 s-1]. This is only used if CS%bound_BT_corr is true. real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: & ua_polarity, & !< Test vector components for checking grid polarity. va_polarity, & !< Test vector components for checking grid polarity. @@ -314,40 +314,40 @@ module MOM_barotropic !> A desciption of the functional dependence of transport at a u-point type, private :: local_BT_cont_u_type real :: FA_u_EE !< The effective open face area for zonal barotropic transport - !! drawing from locations far to the east, in H m ~> m2 or kg m-1. + !! drawing from locations far to the east [H m ~> m2 or kg m-1]. real :: FA_u_E0 !< The effective open face area for zonal barotropic transport - !! drawing from nearby to the east, in H m ~> m2 or kg m-1. + !! drawing from nearby to the east [H m ~> m2 or kg m-1]. real :: FA_u_W0 !< The effective open face area for zonal barotropic transport - !! drawing from nearby to the west, in H m ~> m2 or kg m-1. + !! drawing from nearby to the west [H m ~> m2 or kg m-1]. real :: FA_u_WW !< The effective open face area for zonal barotropic transport - !! drawing from locations far to the west, in H m ~> m2 or kg m-1. + !! drawing from locations far to the west [H m ~> m2 or kg m-1]. real :: uBT_WW !< uBT_WW is the barotropic velocity, in m s-1, beyond which the marginal !! open face area is FA_u_WW. uBT_WW must be non-negative. real :: uBT_EE !< uBT_EE is a barotropic velocity, in m s-1, beyond which the marginal !! open face area is FA_u_EE. uBT_EE must be non-positive. - real :: uh_crvW !< The curvature of face area with velocity for flow from the west, in H s2 m-1 ~> s2 or kg s2 m-3. - real :: uh_crvE !< The curvature of face area with velocity for flow from the east, in H s2 m-1 ~> s2 or kg s2 m-3. - real :: uh_WW !< The zonal transport when ubt=ubt_WW, in H m2 s-1 ~> m2 s-1 or kg s-1. - real :: uh_EE !< The zonal transport when ubt=ubt_EE, in H m2 s-1 ~> m2 s-1 or kg s-1. + real :: uh_crvW !< The curvature of face area with velocity for flow from the west [H s2 m-1 ~> s2 or kg s2 m-3]. + real :: uh_crvE !< The curvature of face area with velocity for flow from the east [H s2 m-1 ~> s2 or kg s2 m-3]. + real :: uh_WW !< The zonal transport when ubt=ubt_WW [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: uh_EE !< The zonal transport when ubt=ubt_EE [H m2 s-1 ~> m3 s-1 or kg s-1]. end type local_BT_cont_u_type !> A desciption of the functional dependence of transport at a v-point type, private :: local_BT_cont_v_type real :: FA_v_NN !< The effective open face area for meridional barotropic transport - !! drawing from locations far to the north, in H m ~> m2 or kg m-1. + !! drawing from locations far to the north [H m ~> m2 or kg m-1]. real :: FA_v_N0 !< The effective open face area for meridional barotropic transport - !! drawing from nearby to the north, in H m ~> m2 or kg m-1. + !! drawing from nearby to the north [H m ~> m2 or kg m-1]. real :: FA_v_S0 !< The effective open face area for meridional barotropic transport - !! drawing from nearby to the south, in H m ~> m2 or kg m-1. + !! drawing from nearby to the south [H m ~> m2 or kg m-1]. real :: FA_v_SS !< The effective open face area for meridional barotropic transport - !! drawing from locations far to the south, in H m ~> m2 or kg m-1. + !! drawing from locations far to the south [H m ~> m2 or kg m-1]. real :: vBT_SS !< vBT_SS is the barotropic velocity, in m s-1, beyond which the marginal !! open face area is FA_v_SS. vBT_SS must be non-negative. real :: vBT_NN !< vBT_NN is the barotropic velocity, in m s-1, beyond which the marginal !! open face area is FA_v_NN. vBT_NN must be non-positive. - real :: vh_crvS !< The curvature of face area with velocity for flow from the south, in H s2 m-1 ~> s2 or kg s2 m-3. - real :: vh_crvn !< The curvature of face area with velocity for flow from the north, in H s2 m-1 ~> s2 or kg s2 m-3. - real :: vh_SS !< The meridional transport when vbt=vbt_SS, in H m2 s-1 ~> m2 s-1 or kg s-1. - real :: vh_NN !< The meridional transport when vbt=vbt_NN, in H m2 s-1 ~> m2 s-1 or kg s-1. + real :: vh_crvS !< The curvature of face area with velocity for flow from the south [H s2 m-1 ~> s2 or kg s2 m-3]. + real :: vh_crvn !< The curvature of face area with velocity for flow from the north [H s2 m-1 ~> s2 or kg s2 m-3]. + real :: vh_SS !< The meridional transport when vbt=vbt_SS [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: vh_NN !< The meridional transport when vbt=vbt_NN [H m2 s-1 ~> m3 s-1 or kg s-1]. end type local_BT_cont_v_type !> A container for passing around active tracer point memory limits @@ -395,7 +395,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_in !< The initial (3-D) zonal velocity, in m s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_in !< The initial (3-D) meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta_in !< The initial barotropic free surface height - !! anomaly or column mass anomaly, in H ~> m or kg m-2. + !! anomaly or column mass anomaly [H ~> m or kg m-2]. real, intent(in) :: dt !< The time increment to integrate over. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: bc_accel_u !< The zonal baroclinic accelerations, in m s-2. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: bc_accel_v !< The meridional baroclinic accelerations, @@ -447,10 +447,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, dimension(:,:), optional, pointer :: tauy_bot !< The meridional bottom frictional stress !! from ocean to the seafloor, in Pa. real, dimension(:,:,:), optional, pointer :: uh0 !< The zonal layer transports at reference - !! velocities, in H m s-1 ~> m2 s-1 or kg m-1 s-1. + !! velocities [H m s-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(:,:,:), optional, pointer :: u_uh0 !< The velocities used to calculate uh0, in m s-1 real, dimension(:,:,:), optional, pointer :: vh0 !< The zonal layer transports at reference - !! velocities, in H m s-1 ~> m2 s-1 or kg m-1 s-1. + !! velocities [H m s-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(:,:,:), optional, pointer :: v_vh0 !< The velocities used to calculate vh0, in m s-1 ! Local variables @@ -484,14 +484,14 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! not explicitly included in the barotropic equation, m s-2. u_accel_bt, & ! The difference between the zonal acceleration from the ! barotropic calculation and BT_force_u, in m s-2. - uhbt, & ! The zonal barotropic thickness fluxes, in H m2 s-1 ~> m2 s-1 or kg s-1. + uhbt, & ! The zonal barotropic thickness fluxes [H m2 s-1 ~> m3 s-1 or kg s-1]. uhbt0, & ! The difference between the sum of the layer zonal thickness ! fluxes and the barotropic thickness flux using the same - ! velocity, in H m2 s-1 ~> m2 s-1 or kg s-1. + ! velocity [H m2 s-1 ~> m3 s-1 or kg s-1]. ubt_old, & ! The starting value of ubt in a barotropic step, in m s-1. ubt_first, & ! The starting value of ubt in a series of barotropic steps, in m s-1. ubt_sum, & ! The sum of ubt over the time steps, in m s-1. - uhbt_sum, & ! The sum of uhbt over the time steps, in H m2 s-1 ~> m2 s-1 or kg s-1. + uhbt_sum, & ! The sum of uhbt over the time steps [H m2 s-1 ~> m3 s-1 or kg s-1]. ubt_wtd, & ! A weighted sum used to find the filtered final ubt, in m s-1. ubt_trans, & ! The latest value of ubt used for a transport, in m s-1. azon, bzon, & ! _zon & _mer are the values of the Coriolis force which @@ -507,7 +507,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, Coru_bt_sum, & ! The summed zonal barotropic Coriolis acceleration, in m s-2. DCor_u, & ! A simply averaged depth at u points [Z ~> m]. Datu ! Basin depth at u-velocity grid points times the y-grid - ! spacing, in H m ~> m2 or kg m-1. + ! spacing [H m ~> m2 or kg m-1]. real, dimension(SZIW_(CS),SZJBW_(CS)) :: & vbt, & ! The meridional barotropic velocity in m s-1. bt_rem_v, & ! The fraction of the barotropic meridional velocity that @@ -517,14 +517,14 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! not explicitly included in the barotropic equation, m s-2. v_accel_bt, & ! The difference between the meridional acceleration from the ! barotropic calculation and BT_force_v, in m s-2. - vhbt, & ! The meridional barotropic thickness fluxes, in H m2 s-1 ~> m2 s-1 or kg s-1. + vhbt, & ! The meridional barotropic thickness fluxes [H m2 s-1 ~> m3 s-1 or kg s-1]. vhbt0, & ! The difference between the sum of the layer meridional ! thickness fluxes and the barotropic thickness flux using - ! the same velocities, in H m2 s-1 ~> m2 s-1 or kg s-1. + ! the same velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. vbt_old, & ! The starting value of vbt in a barotropic step, in m s-1. vbt_first, & ! The starting value of ubt in a series of barotropic steps, in m s-1. vbt_sum, & ! The sum of vbt over the time steps, in m s-1. - vhbt_sum, & ! The sum of vhbt over the time steps, in H m2 s-1 ~> m2 s-1 or kg s-1. + vhbt_sum, & ! The sum of vhbt over the time steps [H m2 s-1 ~> m3 s-1 or kg s-1]. vbt_wtd, & ! A weighted sum used to find the filtered final vbt, in m s-1. vbt_trans, & ! The latest value of vbt used for a transport, in m s-1. Cor_v, & ! The meridional Coriolis acceleration, in m s-2. @@ -538,14 +538,14 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! in m s-2. DCor_v, & ! A simply averaged depth at v points [Z ~> m]. Datv ! Basin depth at v-velocity grid points times the x-grid - ! spacing, in H m ~> m2 or kg m-1. + ! spacing [H m ~> m2 or kg m-1]. real, target, dimension(SZIW_(CS),SZJW_(CS)) :: & eta, & ! The barotropic free surface height anomaly or column mass - ! anomaly, in H ~> m or kg m-2 - eta_pred ! A predictor value of eta, in H ~> m or kg m-2 like eta. + ! anomaly [H ~> m or kg m-2] + eta_pred ! A predictor value of eta [H ~> m or kg m-2] like eta. real, dimension(:,:), pointer :: & eta_PF_BT ! A pointer to the eta array (either eta or eta_pred) that - ! determines the barotropic pressure force, in H ~> m or kg m-2 + ! determines the barotropic pressure force [H ~> m or kg m-2] real, dimension(SZIW_(CS),SZJW_(CS)) :: & eta_sum, & ! eta summed across the timesteps, in m or kg m-2. eta_wtd, & ! A weighted estimate used to calculate eta_out, in m or kg m-2. @@ -612,13 +612,13 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real :: Idt_max2 ! The squared inverse of the local maximum stable ! barotropic time step, in s-2. real :: H_min_dyn ! The minimum depth to use in limiting the size of the - ! dynamic surface pressure for stability, in H ~> m or kg m-2. + ! dynamic surface pressure for stability [H ~> m or kg m-2]. real :: H_eff_dx2 ! The effective total thickness divided by the grid spacing - ! squared, in H m-2 ~> m-1 or kg m-4. + ! squared [H m-2 ~> m-1 or kg m-4]. real :: vel_tmp ! A temporary velocity, in m s-1. real :: u_max_cor, v_max_cor ! The maximum corrective velocities, in m s-1. - real :: Htot ! The total thickness, in H ~> m or kg m-2. - real :: eta_cor_max ! The maximum fluid that can be added as a correction to eta, in H ~> m or kg m-2. + real :: Htot ! The total thickness [H ~> m or kg m-2]. + real :: eta_cor_max ! The maximum fluid that can be added as a correction to eta [H ~> m or kg m-2]. real :: accel_underflow ! An acceleration that is so small it should be zeroed out. real, allocatable, dimension(:) :: wt_vel, wt_eta, wt_accel, wt_trans, wt_accel2 @@ -2271,7 +2271,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(barotropic_CS), pointer :: CS !< Barotropic control structure. real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta !< The barotropic free surface - !! height anomaly or column mass anomaly, in H ~> m or kg m-2. + !! height anomaly or column mass anomaly [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: pbce !< The baroclinic pressure !! anomaly in each layer due to free surface !! height anomalies, in m2 H-1 s-2. @@ -2279,7 +2279,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) !! the effective open face areas as a !! function of barotropic flow. real, optional, intent(in) :: gtot_est !< An estimate of the total gravitational - !! acceleration, in m2 Z-1 s-2 ~> m s-2. + !! acceleration [m2 Z-1 s-2 ~> m s-2]. real, optional, intent(in) :: SSH_add !< An additional contribution to SSH to !! provide a margin of error when !! calculating the external wave speed [Z ~> m]. @@ -2294,10 +2294,10 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) ! (See Hallberg, J Comp Phys 1997 for a discussion.) real, dimension(SZIBS_(G),SZJ_(G)) :: & Datu ! Basin depth at u-velocity grid points times the y-grid - ! spacing, in H m ~> m2 or kg m-1. + ! spacing [H m ~> m2 or kg m-1]. real, dimension(SZI_(G),SZJBS_(G)) :: & Datv ! Basin depth at v-velocity grid points times the x-grid - ! spacing, in H m ~> m2 or kg m-1. + ! spacing [H m ~> m2 or kg m-1]. real :: det_de ! The partial derivative due to self-attraction and loading ! of the reference geopotential with the sea surface height. ! This is typically ~0.09 or less. @@ -2389,13 +2389,13 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of !! the argument arrays. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt !< the zonal barotropic velocity, in m s-1. - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: uhbt !< the zonal barotropic transport, - !! in H m2 s-1 ~> m2 s-1 or kg s-1. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: uhbt !< the zonal barotropic transport + !! [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_trans !< the zonal barotropic velocity used in !! transport, m s-1. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt !< the meridional barotropic velocity, in m s-1. - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vhbt !< the meridional barotropic transport, - !! in H m2 s-1 ~> m2 s-1 or kg s-1. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vhbt !< the meridional barotropic transport + !! [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt_trans !< the meridional BT velocity used in transports, !! m s-1. real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or @@ -2413,10 +2413,10 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, !! in determining the transport. logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate !! transports. - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points, - !! in H m ~> m2 or kg m-1. - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points, - !! in H m ~> m2 or kg m-1. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points + !! [H m ~> m2 or kg m-1]. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points + !! [H m ~> m2 or kg m-1]. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used !! for a dynamic estimate of the face areas at !! u-points. @@ -2425,19 +2425,19 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, !! v-points. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: uhbt0 !< A correction to the zonal transport so that !! the barotropic functions agree with the sum - !! of the layer transports, - !! in H m2 s-1 ~> m2 s-1 or kg s-1. + !! of the layer transports + !! [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vhbt0 !< A correction to the meridional transport so that !! the barotropic functions agree with the sum - !! of the layer transports, - !! in H m2 s-1 ~> m2 s-1 or kg s-1. + !! of the layer transports + !! [H m2 s-1 ~> m3 s-1 or kg s-1]. ! Local variables real :: vel_prev ! The previous velocity in m s-1. real :: vel_trans ! The combination of the previous and current velocity ! that does the mass transport, in m s-1. - real :: H_u ! The total thickness at the u-point, in H ~> m or kg m-2. - real :: H_v ! The total thickness at the v-point, in H ~> m or kg m-2. + real :: H_u ! The total thickness at the u-point [H ~> m or kg m-2]. + real :: H_v ! The total thickness at the v-point [H ~> m or kg m-2]. real :: cfl ! The CFL number at the point in question, ND. real :: u_inlet real :: v_inlet @@ -2572,10 +2572,10 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co integer, intent(in) :: halo !< The extra halo size to use here. logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate !! transports. - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points, - !! in H m ~> m2 or kg m-1. - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points, - !! in H m ~> m2 or kg m-1. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points + !! [H m ~> m2 or kg m-1]. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points + !! [H m ~> m2 or kg m-1]. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used !! for a dynamic estimate of the face areas at !! u-points. @@ -2765,7 +2765,7 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(barotropic_CS), pointer :: CS !< The control structure returned by a previous !! call to barotropic_init. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -2785,21 +2785,21 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) real :: hatutot(SZIB_(G)) ! The sum of the layer thicknesses real :: hatvtot(SZI_(G)) ! interpolated to the u & v grid points. real :: Ihatutot(SZIB_(G)) ! Ihatutot and Ihatvtot are the inverses - real :: Ihatvtot(SZI_(G)) ! of hatutot and hatvtot, both in H-1 ~> m-1 or m2 kg-1. - real :: h_arith ! The arithmetic mean thickness, in H ~> m or kg m-2. - real :: h_harm ! The harmonic mean thicknesses, in H ~> m or kg m-2. + real :: Ihatvtot(SZI_(G)) ! of hatutot and hatvtot, both [H-1 ~> m-1 or m2 kg-1]. + real :: h_arith ! The arithmetic mean thickness [H ~> m or kg m-2]. + real :: h_harm ! The harmonic mean thicknesses [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: wt_arith ! The nondimensional weight for the arithmetic ! mean thickness. The harmonic mean uses ! a weight of (1 - wt_arith). real :: Rh ! A ratio of summed thicknesses, nondim. real :: e_u(SZIB_(G),SZK_(G)+1) ! The interface heights at u-velocity and - real :: e_v(SZI_(G),SZK_(G)+1) ! v-velocity points in H ~> m or kg m-2. - real :: D_shallow_u(SZI_(G)) ! The shallower of the adjacent depths in H ~> m or kg m-2. - real :: D_shallow_v(SZIB_(G))! The shallower of the adjacent depths in H ~> m or kg m-2. - real :: htot ! The sum of the layer thicknesses, in H ~> m or kg m-2. - real :: Ihtot ! The inverse of htot, in H-1 ~> m-1 or m2 kg-1. + real :: e_v(SZI_(G),SZK_(G)+1) ! v-velocity points [H ~> m or kg m-2]. + real :: D_shallow_u(SZI_(G)) ! The shallower of the adjacent depths [H ~> m or kg m-2]. + real :: D_shallow_v(SZIB_(G))! The shallower of the adjacent depths [H ~> m or kg m-2]. + real :: htot ! The sum of the layer thicknesses [H ~> m or kg m-2]. + real :: Ihtot ! The inverse of htot [H-1 ~> m-1 or m2 kg-1]. logical :: use_default, test_dflt, apply_OBCs integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, i, j, k @@ -3057,7 +3057,7 @@ end function find_uhbt !! velocity that is consistent with a given transport. function uhbt_to_ubt(uhbt, BTC, guess) result(ubt) real, intent(in) :: uhbt !< The barotropic zonal transport that should be inverted for, - !! in H m2 s-1 ~> m2 s-1 or kg s-1 ~> m3 s-1 or kg s-1. + !! [H m2 s-1 ~> m3 s-1 or kg s-1]. type(local_BT_cont_u_type), intent(in) :: BTC !< A structure containing various fields that allow the !! barotropic transports to be calculated consistently with the !! layers' continuity equations. @@ -3170,7 +3170,7 @@ end function find_vhbt !! velocity that is consistent with a given transport. function vhbt_to_vbt(vhbt, BTC, guess) result(vbt) real, intent(in) :: vhbt !< The barotropic meridional transport that should be - !! inverted for, in H m2 s-1 ~> m2 s-1 or kg s-1 ~> m3 s-1 or kg s-1. + !! inverted for [H m2 s-1 ~> m3 s-1 or kg s-1]. type(local_BT_cont_v_type), intent(in) :: BTC !< A structure containing various fields that allow the !! barotropic transports to be calculated consistently !! with the layers' continuity equations. @@ -3396,12 +3396,12 @@ subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & intent(in) :: ubt !< The linearization zonal barotropic velocity in m s-1. real, dimension(SZIBW_(MS),SZJW_(MS)), & intent(in) :: uhbt !< The linearization zonal barotropic transport - !! in H m2 s-1 ~> m2 s-1 or kg s-1. + !! [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), & intent(in) :: vbt !< The linearization meridional barotropic velocity in m s-1. real, dimension(SZIW_(MS),SZJBW_(MS)), & intent(in) :: vhbt !< The linearization meridional barotropic transport - !! in H m2 s-1 ~> m2 s-1 or kg s-1. + !! [H m2 s-1 ~> m3 s-1 or kg s-1]. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), & intent(out) :: BTCL_u !< A structure with the u information from BT_cont. type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), & @@ -3490,9 +3490,9 @@ subroutine BT_cont_to_face_areas(BT_cont, Datu, Datv, G, MS, halo, maximize) type(memory_size_type), intent(in) :: MS !< A type that describes the memory !! sizes of the argument arrays. real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), & - intent(out) :: Datu !< The effective zonal face area, in H m ~> m2 or kg m-1. + intent(out) :: Datu !< The effective zonal face area [H m ~> m2 or kg m-1]. real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), & - intent(out) :: Datv !< The effective meridional face area, in H m ~> m2 or kg m-1. + intent(out) :: Datv !< The effective meridional face area [H m ~> m2 or kg m-1]. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, optional, intent(in) :: halo !< The extra halo size to use here. logical, optional, intent(in) :: maximize !< If present and true, find the @@ -3538,16 +3538,16 @@ end subroutine swap subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the argument arrays. real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), & - intent(out) :: Datu !< The open zonal face area, in H m ~> m2 or kg m-1. + intent(out) :: Datu !< The open zonal face area [H m ~> m2 or kg m-1]. real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), & - intent(out) :: Datv !< The open meridional face area, in H m ~> m2 or kg m-1. + intent(out) :: Datv !< The open meridional face area [H m ~> m2 or kg m-1]. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(barotropic_CS), pointer :: CS !< The control structure returned by a previous !! call to barotropic_init. real, dimension(MS%isdw:MS%iedw,MS%jsdw:MS%jedw), & optional, intent(in) :: eta !< The barotropic free surface height anomaly - !! or column mass anomaly, in H ~> m or kg m-2. + !! or column mass anomaly [H ~> m or kg m-2]. integer, optional, intent(in) :: halo !< The halo size to use, default = 1. real, optional, intent(in) :: add_max !< A value to add to the maximum depth (used !! to overestimate the external wave speed) [Z ~> m]. @@ -3635,7 +3635,7 @@ end subroutine find_face_areas subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The free surface height that is to be corrected, in m. logical, intent(in) :: set_cor !< A flag to indicate whether to set the corrective !! fluxes (and update the slowly varying part of eta_cor) @@ -3645,11 +3645,11 @@ subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) !! to barotropic_init. ! Local variables - real :: h_tot(SZI_(G)) ! The sum of the layer thicknesses, in H ~> m or kg m-2. + real :: h_tot(SZI_(G)) ! The sum of the layer thicknesses [H ~> m or kg m-2]. real :: eta_h(SZI_(G)) ! The free surface height determined from - ! the sum of the layer thicknesses, in H ~> m or kg m-2. + ! the sum of the layer thicknesses [H ~> m or kg m-2]. real :: d_eta ! The difference between estimates of the total - ! thicknesses, in H ~> m or kg m-2. + ! thicknesses [H ~> m or kg m-2]. real :: limit_dt ! The fractional mass-source limit divided by the ! thermodynamic time step, in s-1. integer :: is, ie, js, je, nz, i, j, k @@ -3703,10 +3703,10 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: eta !< Free surface height or column mass anomaly, in - !! Z ~> m or H ~> kg m-2. + intent(in) :: eta !< Free surface height or column mass anomaly + !! [Z ~> m] or [H ~> kg m-2]. type(time_type), target, intent(in) :: Time !< The current model time. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic @@ -3728,9 +3728,9 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, #include "version_variable.h" ! Local variables character(len=40) :: mdl = "MOM_barotropic" ! This module's name. - real :: Datu(SZIBS_(G),SZJ_(G)) ! Zonal open face area in H m ~> m2 or kg m-1. - real :: Datv(SZI_(G),SZJBS_(G)) ! Meridional open face area in H m ~> m2 or kg m-1. - real :: gtot_estimate ! Summed GV%g_prime, in m2 Z-1 s-2 ~> m s-2, to give an upper-bound estimate for pbce. + real :: Datu(SZIBS_(G),SZJ_(G)) ! Zonal open face area [H m ~> m2 or kg m-1]. + real :: Datv(SZI_(G),SZJBS_(G)) ! Meridional open face area [H m ~> m2 or kg m-1]. + real :: gtot_estimate ! Summed GV%g_prime [m2 Z-1 s-2 ~> m s-2], to give an upper-bound estimate for pbce. real :: SSH_extra ! An estimate of how much higher SSH might get, for use ! in calculating the safe external wave speed [Z ~> m]. real :: dtbt_input, dtbt_tmp diff --git a/src/core/MOM_boundary_update.F90 b/src/core/MOM_boundary_update.F90 index ec170627c0..ae78c6fd0d 100644 --- a/src/core/MOM_boundary_update.F90 +++ b/src/core/MOM_boundary_update.F90 @@ -115,7 +115,7 @@ subroutine update_OBC_data(OBC, G, GV, US, tv, h, CS, Time) type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< layer thicknesses [H ~> m or kg m-2] type(ocean_OBC_type), pointer :: OBC !< Open boundary structure type(update_OBC_CS), pointer :: CS !< Control structure for OBCs type(time_type), intent(in) :: Time !< Model time diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index ca2d7456d8..1b32fc72e5 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -48,7 +48,7 @@ subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, haloshift, symmet real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: uh !< Volume flux through zonal faces = u*h*dy, m3 s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -84,7 +84,7 @@ subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, haloshift, symmetric) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< Meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric !! computationoal domain. @@ -220,7 +220,7 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, pointer, dimension(:,:,:), & intent(in) :: Temp !< Temperature in degree C. real, pointer, dimension(:,:,:), & diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index a716457cca..0131599340 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -83,9 +83,9 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< Meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: hin !< Initial layer thickness, in H ~> m or kg m-2. + intent(in) :: hin !< Initial layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Final layer thickness, in H ~> m or kg m-2. + intent(inout) :: h !< Final layer thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: uh !< Zonal volume flux, u*h*dy, H m2 s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -120,12 +120,12 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, !< The meridional velocities that give vhbt as the depth-integrated transport, in m s-1. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt_aux - !< A second set of summed volume fluxes through zonal faces, - !! in H m2 s-1 ~> m2 s-1 or kg s-1. + !< A second set of summed volume fluxes through zonal faces + !! [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G)), & optional, intent(in) :: vhbt_aux - !< A second set of summed volume fluxes through meridional faces, - !! in H m2 s-1 ~> m2 s-1 or kg s-1. + !< A second set of summed volume fluxes through meridional faces + !! [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: u_cor_aux !< The zonal velocities that give uhbt_aux as the depth-integrated @@ -138,7 +138,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, !! the effective open face areas as a function of barotropic flow. ! Local variables - real :: h_min ! The minimum layer thickness, in H ~> m or kg m-2. h_min could be 0. + real :: h_min ! The minimum layer thickness [H ~> m or kg m-2]. h_min could be 0. type(loop_bounds_type) :: LB integer :: is, ie, js, je, nz, stencil integer :: i, j, k @@ -232,7 +232,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< Zonal velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_in !< Layer thickness used to calculate fluxes, in H ~> m or kg m-2. + intent(in) :: h_in !< Layer thickness used to calculate fluxes [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: uh !< Volume flux through zonal faces = u*h*dy, H m2 s-1. real, intent(in) :: dt !< Time increment in s. @@ -250,7 +250,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & optional, intent(in) :: uhbt !< The summed volume flux through zonal faces, H m2 s-1. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt_aux - !< A second set of summed volume fluxes through zonal faces, in H m2 s-1 ~> m2 s-1 or kg s-1. + !< A second set of summed volume fluxes through zonal faces [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: u_cor !< The zonal velocitiess (u with a barotropic correction) @@ -263,20 +263,20 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & !! effective open face areas as a function of barotropic flow. ! Local variables - real, dimension(SZIB_(G),SZK_(G)) :: duhdu ! Partial derivative of uh with u, in H m ~> m2 or kg m-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_L, h_R ! Left and right face thicknesses, in H ~> m or kg m-2. + real, dimension(SZIB_(G),SZK_(G)) :: duhdu ! Partial derivative of uh with u [H m ~> m2 or kg m-1]. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_L, h_R ! Left and right face thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G)) :: & du, & ! Corrective barotropic change in the velocity, in m s-1. du_min_CFL, & ! Min/max limits on du correction du_max_CFL, & ! to avoid CFL violations - duhdu_tot_0, & ! Summed partial derivative of uh with u, in H m ~> m2 or kg m-1. - uh_tot_0, & ! Summed transport with no barotropic correction in H m2 s-1 ~> m2 s-1 or kg s-1. + duhdu_tot_0, & ! Summed partial derivative of uh with u [H m ~> m2 or kg m-1]. + uh_tot_0, & ! Summed transport with no barotropic correction [H m2 s-1 ~> m3 s-1 or kg s-1]. visc_rem_max ! The column maximum of visc_rem. logical, dimension(SZIB_(G)) :: do_I real, dimension(SZIB_(G),SZK_(G)) :: & visc_rem ! A 2-D copy of visc_rem_u or an array of 1's. - real, dimension(SZIB_(G)) :: FAuI ! A list of sums of zonal face areas, in H m ~> m2 or kg m-1. - real :: FA_u ! A sum of zonal face areas, in H m ~> m2 or kg m-1. + real, dimension(SZIB_(G)) :: FAuI ! A list of sums of zonal face areas [H m ~> m2 or kg m-1]. + real :: FA_u ! A sum of zonal face areas [H m ~> m2 or kg m-1]. real :: I_vrm ! 1.0 / visc_rem_max, nondim. real :: CFL_dt ! The maximum CFL ratio of the adjusted velocities divided by ! the time step, in s-1. @@ -543,13 +543,13 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, & !! of viscosity, and the fraction of a time-step's worth of a barotropic !! acceleration that a layer experiences after viscosity is applied. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZI_(G)), intent(in) :: h !< Layer thickness, in H ~> m or kg m-2. - real, dimension(SZI_(G)), intent(in) :: h_L !< Left thickness, in H ~> m or kg m-2. - real, dimension(SZI_(G)), intent(in) :: h_R !< Right thickness, in H ~> m or kg m-2. + real, dimension(SZI_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. + real, dimension(SZI_(G)), intent(in) :: h_L !< Left thickness [H ~> m or kg m-2]. + real, dimension(SZI_(G)), intent(in) :: h_R !< Right thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G)), intent(inout) :: uh !< Zonal mass or volume - !! transport, in H m2 s-1 ~> m2 s-1 or kg s-1. + !! transport [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(inout) :: duhdu !< Partial derivative of uh - !! with u, in H m ~> m2 or kg m-1. + !! with u [H m ~> m2 or kg m-1]. real, intent(in) :: dt !< Time increment in s. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. @@ -562,7 +562,7 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, & real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. real :: curv_3 ! A measure of the thickness curvature over a grid length, ! with the same units as h_in. - real :: h_marg ! The marginal thickness of a flux, in H ~> m or kg m-2. + real :: h_marg ! The marginal thickness of a flux [H ~> m or kg m-2]. integer :: i logical :: local_open_BC @@ -615,12 +615,12 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, & type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness used to - !! calculate fluxes, in H ~> m or kg m-2. + !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the - !! reconstruction, in H ~> m or kg m-2. + !! reconstruction [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the - !! reconstruction, in H ~> m or kg m-2. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_u !< Thickness at zonal faces, in H ~> m or kg m-2. + !! reconstruction [H ~> m or kg m-2]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_u !< Thickness at zonal faces [H ~> m or kg m-2]. real, intent(in) :: dt !< Time increment in s. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. logical, intent(in) :: vol_CFL !< If true, rescale the ratio @@ -639,8 +639,8 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, & real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. real :: curv_3 ! A measure of the thickness curvature over a grid length, ! with the same units as h_in. - real :: h_avg ! The average thickness of a flux, in H ~> m or kg m-2. - real :: h_marg ! The marginal thickness of a flux, in H ~> m or kg m-2. + real :: h_avg ! The average thickness of a flux [H ~> m or kg m-2]. + real :: h_marg ! The marginal thickness of a flux [H ~> m or kg m-2]. logical :: local_open_BC integer :: i, j, k, ish, ieh, jsh, jeh, nz, n ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke @@ -722,11 +722,11 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to - !! calculate fluxes, in H ~> m or kg m-2. + !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the - !! reconstruction, in H ~> m or kg m-2. + !! reconstruction [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the - !! reconstruction, in H ~> m or kg m-2. + !! reconstruction [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZK_(G)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step of viscosity, and !! the fraction of a time-step's worth of a barotropic acceleration that a layer @@ -739,9 +739,9 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable !! value of du, in m s-1. real, dimension(SZIB_(G)), intent(in) :: uh_tot_0 !< The summed transport - !! with 0 adjustment, in H m2 s-1 ~> m2 s-1 or kg s-1. + !! with 0 adjustment [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(in) :: duhdu_tot_0 !< The partial derivative - !! of du_err with du at 0 adjustment, in H m ~> m2 or kg m-1. + !! of du_err with du at 0 adjustment [H m ~> m2 or kg m-1]. real, dimension(SZIB_(G)), intent(out) :: du !< !! The barotropic velocity adjustment, in m s-1. real, intent(in) :: dt !< Time increment in s. @@ -759,13 +759,13 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZIB_(G),SZK_(G)) :: & - uh_aux, & ! An auxiliary zonal volume flux, in H m s-1 ~> m2 s-1 or kg m-1 s-1. - duhdu ! Partial derivative of uh with u, in H m ~> m2 or kg m-1. + uh_aux, & ! An auxiliary zonal volume flux [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + duhdu ! Partial derivative of uh with u [H m ~> m2 or kg m-1]. real, dimension(SZIB_(G)) :: & - uh_err, & ! Difference between uhbt and the summed uh, in H m2 s-1 ~> m2 s-1 or kg s-1. - uh_err_best, & ! The smallest value of uh_err found so far, in H m2 s-1 ~> m2 s-1 or kg s-1. + uh_err, & ! Difference between uhbt and the summed uh [H m2 s-1 ~> m3 s-1 or kg s-1]. + uh_err_best, & ! The smallest value of uh_err found so far [H m2 s-1 ~> m3 s-1 or kg s-1]. u_new, & ! The velocity with the correction added, in m s-1. - duhdu_tot,&! Summed partial derivative of uh with u, in H m ~> m2 or kg m-1. + duhdu_tot,&! Summed partial derivative of uh with u [H m ~> m2 or kg m-1]. du_min, & ! Min/max limits on du correction based on CFL limits du_max ! and previous iterations, in m s-1. real :: du_prev ! The previous value of du, in m s-1. @@ -884,17 +884,17 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to - !! calculate fluxes, in H ~> m or kg m-2. + !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the - !! reconstruction, in H ~> m or kg m-2. + !! reconstruction [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the - !! reconstruction, in H ~> m or kg m-2. + !! reconstruction [H ~> m or kg m-2]. type(BT_cont_type), intent(inout) :: BT_cont !< A structure with elements !! that describe the effective open face areas as a function of barotropic flow. real, dimension(SZIB_(G)), intent(in) :: uh_tot_0 !< The summed transport - !! with 0 adjustment, in H m2 s-1 ~> m2 s-1 or kg s-1. + !! with 0 adjustment [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(in) :: duhdu_tot_0 !< The partial derivative - !! of du_err with du at 0 adjustment, in H m ~> m2 or kg m-1. + !! of du_err with du at 0 adjustment [H m ~> m2 or kg m-1]. real, dimension(SZIB_(G)), intent(in) :: du_max_CFL !< Maximum acceptable !! value of du, in m s-1. real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable @@ -923,13 +923,13 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, u_0, & ! transport (u_0) layer test velocities, in m s-1. FA_marg_L, & ! The effective layer marginal face areas with the westerly FA_marg_R, & ! (_L), easterly (_R), and zero-barotropic (_0) test - FA_marg_0, & ! velocities, in H m ~> m2 or kg m-1. + FA_marg_0, & ! velocities [H m ~> m2 or kg m-1]. uh_L, uh_R, & ! The layer transports with the westerly (_L), easterly (_R), - uh_0, & ! and zero-barotropic (_0) test velocities, in H m2 s-1 ~> m2 s-1 or kg s-1. + uh_0, & ! and zero-barotropic (_0) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. FAmt_L, FAmt_R, & ! The summed effective marginal face areas for the 3 - FAmt_0, & ! test velocities, in H m ~> m2 or kg m-1. + FAmt_0, & ! test velocities [H m ~> m2 or kg m-1]. uhtot_L, & ! The summed transport with the westerly (uhtot_L) and - uhtot_R ! and easterly (uhtot_R) test velocities, in H m2 s-1 ~> m2 s-1 or kg s-1. + uhtot_R ! and easterly (uhtot_R) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. real :: FA_0 ! The effective face area with 0 barotropic transport, in m H. real :: FA_avg ! The average effective face area, in m H, nominally given by ! the realized transport divided by the barotropic velocity. @@ -1049,7 +1049,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to - !! calculate fluxes, in H ~> m or kg m-2. + !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vh !< Volume flux through meridional !! faces = v*h*dx, H m2 s-1. real, intent(in) :: dt !< Time increment in s. @@ -1066,7 +1066,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vhbt !< The summed volume flux through !< meridional faces, H m2 s-1. real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vhbt_aux !< A second set of summed volume fluxes - !! through meridional faces, in H m2 s-1 ~> m2 s-1 or kg s-1. + !! through meridional faces [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor !< The meridional velocitiess (v with a barotropic correction) @@ -1086,12 +1086,12 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & dv, & ! Corrective barotropic change in the velocity, in m s-1. dv_min_CFL, & ! Min/max limits on dv correction dv_max_CFL, & ! to avoid CFL violations - dvhdv_tot_0, & ! Summed partial derivative of vh with v, in H m ~> m2 or kg m-1. - vh_tot_0, & ! Summed transport with no barotropic correction in H m2 s-1 ~> m2 s-1 or kg s-1. + dvhdv_tot_0, & ! Summed partial derivative of vh with v [H m ~> m2 or kg m-1]. + vh_tot_0, & ! Summed transport with no barotropic correction [H m2 s-1 ~> m3 s-1 or kg s-1]. visc_rem_max ! The column maximum of visc_rem. logical, dimension(SZI_(G)) :: do_I - real, dimension(SZI_(G)) :: FAvi ! A list of sums of meridional face areas, in H m ~> m2 or kg m-1. - real :: FA_v ! A sum of meridional face areas, in H m ~> m2 or kg m-1. + real, dimension(SZI_(G)) :: FAvi ! A list of sums of meridional face areas [H m ~> m2 or kg m-1]. + real :: FA_v ! A sum of meridional face areas [H m ~> m2 or kg m-1]. real, dimension(SZI_(G),SZK_(G)) :: & visc_rem ! A 2-D copy of visc_rem_v or an array of 1's. real :: I_vrm ! 1.0 / visc_rem_max, nondim. @@ -1360,15 +1360,15 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, & !! acceleration that a layer experiences after viscosity is applied. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h !< Layer thickness used to calculate fluxes, - !! in H ~> m or kg m-2. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, - !! in H ~> m or kg m-2. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_R !< Right thickness in the reconstruction, - !! in H ~> m or kg m-2. - real, dimension(SZI_(G)), intent(inout) :: vh !< Meridional mass or volume transport, - !! in H m2 s-1 ~> m2 s-1 or kg s-1. - real, dimension(SZI_(G)), intent(inout) :: dvhdv !< Partial derivative of vh with v, - !! in H m ~> m2 or kg m-1. + !! [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_L !< Left thickness in the reconstruction + !! [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_R !< Right thickness in the reconstruction + !! [H ~> m or kg m-2]. + real, dimension(SZI_(G)), intent(inout) :: vh !< Meridional mass or volume transport + !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + real, dimension(SZI_(G)), intent(inout) :: dvhdv !< Partial derivative of vh with v + !! [H m ~> m2 or kg m-1]. real, intent(in) :: dt !< Time increment in s. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. @@ -1435,13 +1435,13 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness used to calculate fluxes, - !! in H ~> m or kg m-2. + !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, - !! in H ~> m or kg m-2. + !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the reconstruction, - !! in H ~> m or kg m-2. + !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: h_v !< Thickness at meridional faces, - !! in H ~> m or kg m-2. + !! [H ~> m or kg m-2]. real, intent(in) :: dt !< Time increment in s. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. logical, intent(in) :: vol_CFL !< If true, rescale the ratio @@ -1459,8 +1459,8 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. real :: curv_3 ! A measure of the thickness curvature over a grid length, ! with the same units as h_in. - real :: h_avg ! The average thickness of a flux, in H ~> m or kg m-2. - real :: h_marg ! The marginal thickness of a flux, in H ~> m or kg m-2. + real :: h_avg ! The average thickness of a flux [H ~> m or kg m-2]. + real :: h_marg ! The marginal thickness of a flux [H ~> m or kg m-2]. logical :: local_open_BC integer :: i, j, k, ish, ieh, jsh, jeh, n, nz ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke @@ -1544,26 +1544,26 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< Meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_in !< Layer thickness used to calculate fluxes, in H ~> m or kg m-2. + intent(in) :: h_in !< Layer thickness used to calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& - intent(in) :: h_L !< Left thickness in the reconstruction, in H ~> m or kg m-2. + intent(in) :: h_L !< Left thickness in the reconstruction [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_R !< Right thickness in the reconstruction, in H ~> m or kg m-2. - real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: visc_rem + intent(in) :: h_R !< Right thickness in the reconstruction [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZK_(G)), intent(in) :: visc_rem !< Both the fraction of the momentum originally !! in a layer that remains after a time-step of viscosity, and the !! fraction of a time-step's worth of a barotropic acceleration that !! a layer experiences after viscosity is applied. Non-dimensional !! between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G)), & - optional, intent(in) :: vhbt !< The summed volume flux through meridional faces, H m2 s-1. + optional, intent(in) :: vhbt !< The summed volume flux through meridional faces + !! [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv, in m s-1. real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv, in m s-1. - real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< The summed transport with 0 adjustment, - !! in H m2 s-1 ~> m2 s-1 or kg s-1. + real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< The summed transport with 0 adjustment + !! [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< The partial derivative of dv_err with - !! dv at 0 adjustment, in H m ~> m2 or kg m-1. + !! dv at 0 adjustment [H m ~> m2 or kg m-1]. real, dimension(SZI_(G)), intent(out) :: dv !< The barotropic velocity adjustment, in m s-1. real, intent(in) :: dt !< Time increment in s. type(continuity_PPM_CS), pointer :: CS !< This module's control structure. @@ -1572,21 +1572,21 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 integer, intent(in) :: ieh !< End of index range. logical, dimension(SZI_(G)), & intent(in) :: do_I_in !< A flag indicating which I values to work on. - logical, optional, intent(in) :: full_precision !< A flag indicating - !! how carefully to iterate. The default is .true. (more accurate). + logical, optional, intent(in) :: full_precision !< A flag indicating how carefully to + !! iterate. The default is .true. (more accurate). real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - optional, intent(inout) :: vh_3d !< Volume flux through - !! meridional faces = v*h*dx, H m2 s-1. + optional, intent(inout) :: vh_3d !< Volume flux through meridional + !! faces = v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & - vh_aux, & ! An auxiliary meridional volume flux, in H m s-1 ~> m2 s-1 or kg m-1 s-1. - dvhdv ! Partial derivative of vh with v, in H m ~> m2 or kg m-1. + vh_aux, & ! An auxiliary meridional volume flux [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + dvhdv ! Partial derivative of vh with v [H m ~> m2 or kg m-1]. real, dimension(SZI_(G)) :: & - vh_err, & ! Difference between vhbt and the summed vh, in H m2 s-1 ~> m2 s-1 or kg s-1. - vh_err_best, & ! The smallest value of vh_err found so far, in H m2 s-1 ~> m2 s-1 or kg s-1. + vh_err, & ! Difference between vhbt and the summed vh [H m2 s-1 ~> m3 s-1 or kg s-1]. + vh_err_best, & ! The smallest value of vh_err found so far [H m2 s-1 ~> m3 s-1 or kg s-1]. v_new, & ! The velocity with the correction added, in m s-1. - dvhdv_tot,&! Summed partial derivative of vh with u, in H m ~> m2 or kg m-1. + dvhdv_tot,&! Summed partial derivative of vh with u [H m ~> m2 or kg m-1]. dv_min, & ! Min/max limits on dv correction based on CFL limits dv_max ! and previous iterations, in m s-1. real :: dv_prev ! The previous value of dv, in m s-1. @@ -1705,17 +1705,17 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to calculate fluxes, - !! in H ~> m or kg m-2. + !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, - !! in H ~> m or kg m-2. + !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the reconstruction, - !! in H ~> m or kg m-2. + !! [H ~> m or kg m-2]. type(BT_cont_type), intent(inout) :: BT_cont !< A structure with elements !! that describe the effective open face areas as a function of barotropic flow. real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< The summed transport - !! with 0 adjustment, in H m2 s-1 ~> m2 s-1 or kg s-1. + !! with 0 adjustment [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< The partial derivative - !! of du_err with dv at 0 adjustment, in H m ~> m2 or kg m-1. + !! of du_err with dv at 0 adjustment [H m ~> m2 or kg m-1]. real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv, in m s-1. real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv, in m s-1. real, intent(in) :: dt !< Time increment in s. @@ -1742,13 +1742,13 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, v_0, & ! transport (v_0) layer test velocities, in m s-1. FA_marg_L, & ! The effective layer marginal face areas with the southerly FA_marg_R, & ! (_L), northerly (_R), and zero-barotropic (_0) test - FA_marg_0, & ! velocities, in H m ~> m2 or kg m-1. + FA_marg_0, & ! velocities [H m ~> m2 or kg m-1]. vh_L, vh_R, & ! The layer transports with the southerly (_L), northerly (_R) - vh_0, & ! and zero-barotropic (_0) test velocities, in H m2 s-1 ~> m2 s-1 or kg s-1. + vh_0, & ! and zero-barotropic (_0) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. FAmt_L, FAmt_R, & ! The summed effective marginal face areas for the 3 - FAmt_0, & ! test velocities, in H m ~> m2 or kg m-1. + FAmt_0, & ! test velocities [H m ~> m2 or kg m-1]. vhtot_L, & ! The summed transport with the southerly (vhtot_L) and - vhtot_R ! and northerly (vhtot_R) test velocities, in H m2 s-1 ~> m2 s-1 or kg s-1. + vhtot_R ! and northerly (vhtot_R) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. real :: FA_0 ! The effective face area with 0 barotropic transport, in m H. real :: FA_avg ! The average effective face area, in m H, nominally given by ! the realized transport divided by the barotropic velocity. @@ -1862,11 +1862,11 @@ end subroutine set_merid_BT_cont !> Calculates left/right edge values for PPM reconstruction. subroutine PPM_reconstruction_x(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_2nd, OBC) type(ocean_grid_type), intent(in) :: G !< Ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Layer thickness, in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_L !< Left thickness in the reconstruction, - !! in H ~> m or kg m-2. + !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_R !< Right thickness in the reconstruction, - !! in H ~> m or kg m-2. + !! [H ~> m or kg m-2]. type(loop_bounds_type), intent(in) :: LB !< Active loop bounds structure. real, intent(in) :: h_min !< The minimum thickness !! that can be obtained by a concave parabolic fit. @@ -2001,11 +2001,11 @@ end subroutine PPM_reconstruction_x !> Calculates left/right edge values for PPM reconstruction. subroutine PPM_reconstruction_y(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_2nd, OBC) type(ocean_grid_type), intent(in) :: G !< Ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Layer thickness, in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_L !< Left thickness in the reconstruction, - !! in H ~> m or kg m-2. + !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_R !< Right thickness in the reconstruction, - !! in H ~> m or kg m-2. + !! [H ~> m or kg m-2]. type(loop_bounds_type), intent(in) :: LB !< Active loop bounds structure. real, intent(in) :: h_min !< The minimum thickness !! that can be obtained by a concave parabolic fit. @@ -2141,9 +2141,9 @@ end subroutine PPM_reconstruction_y !! than h_min, with a minimum of h_min otherwise. subroutine PPM_limit_pos(h_in, h_L, h_R, h_min, G, iis, iie, jis, jie) type(ocean_grid_type), intent(in) :: G !< Ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Layer thickness, in H ~> m or kg m-2. - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_L !< Left thickness in the reconstruction, in H ~> m or kg m-2. - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_R !< Right thickness in the reconstruction, in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Layer thickness [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_L !< Left thickness in the reconstruction [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_R !< Right thickness in the reconstruction [H ~> m or kg m-2]. real, intent(in) :: h_min !< The minimum thickness !! that can be obtained by a concave parabolic fit. integer, intent(in) :: iis !< Start of i index range. @@ -2182,11 +2182,11 @@ end subroutine PPM_limit_pos !! according to the monotonic prescription of Colella and Woodward, 1984. subroutine PPM_limit_CW84(h_in, h_L, h_R, G, iis, iie, jis, jie) type(ocean_grid_type), intent(in) :: G !< Ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Layer thickness, in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_L !< Left thickness in the reconstruction, - !! in H ~> m or kg m-2. + !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_R !< Right thickness in the reconstruction, - !! in H ~> m or kg m-2. + !! [H ~> m or kg m-2]. integer, intent(in) :: iis !< Start of i index range. integer, intent(in) :: iie !< End of i index range. integer, intent(in) :: jis !< Start of j index range. diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index b0630d3b8d..969bce8786 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -101,7 +101,7 @@ module MOM_dynamics_split_RK2 ! The following variables are only used with the split time stepping scheme. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta !< Instantaneous free surface height (in Boussinesq !! mode) or column mass anomaly (in non-Boussinesq - !! mode), in H ~> m or kg m-2 + !! mode) [H ~> m or kg m-2] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_av !< layer x-velocity with vertical mean replaced by !! time-mean barotropic velocity over a baroclinic !! timestep (m s-1) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 73fc1e40d7..060b89dd16 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -188,7 +188,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity, in m s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity, in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. !! (usually m or kg m-2). type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. @@ -211,7 +211,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume or mass !! transport since the last tracer advection, in m3 or kg. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height or - !! column mass, in H ~> m or kg m-2. + !! column mass [H ~> m or kg m-2]. type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit. type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with fields @@ -570,7 +570,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(inout) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , & - intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] !! (usually m or kg m-2). type(time_type), target, intent(in) :: Time !< The current model time. type(param_file_type), intent(in) :: param_file !< A structure to parse diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index d11c4c4f4f..df8a41ea68 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -222,7 +222,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! or mass transport since the last !! tracer advection, in m3 or kg. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height - !! or column mass, in H ~> m or kg m-2. + !! or column mass [H ~> m or kg m-2]. type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up by !! initialize_dyn_unsplit_RK2. type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with @@ -514,7 +514,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity, in m s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity, !! in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] !! (usually m or kg m-2). type(time_type), target, intent(in) :: Time !< The current model time. type(param_file_type), intent(in) :: param_file !< A structure to parse diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index f014c078ae..91daa43d22 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -351,15 +351,15 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, logical, intent(in) :: useRiverHeatContent !< logical for river heat content logical, intent(in) :: useCalvingHeatContent !< logical for calving heat content real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: h !< layer thickness (in H ~> m or kg m-2) + intent(in) :: h !< layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZK_(G)), & intent(in) :: T !< layer temperatures (degC) real, dimension(SZI_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux !! (if Bouss) of water in/out of ocean over - !! a time step (H ~> m or kg m-2) + !! a time step [H ~> m or kg m-2] real, dimension(SZI_(G)), intent(out) :: netMassOut !< net mass flux (non-Bouss) or volume flux !! (if Bouss) of water leaving ocean surface - !! over a time step (H ~> m or kg m-2). + !! over a time step [H ~> m or kg m-2]. !! netMassOut < 0 means mass leaves ocean. real, dimension(SZI_(G)), intent(out) :: net_heat !< net heat at the surface accumulated over a !! time step for coupler + restoring. @@ -367,12 +367,12 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, !! (1) downwelling (penetrative) SW, !! (2) evaporation heat content, !! (since do not yet know evap temperature). - !! Units are (degC H ~> degC m or degC kg m-2). + !! [degC H ~> degC m or degC kg m-2]. real, dimension(SZI_(G)), intent(out) :: net_salt !< surface salt flux into the ocean - !! accumulated over a time step, in - !! ppt H ~> ppt m or ppt kg m-2. + !! accumulated over a time step + !! [ppt H ~> ppt m or ppt kg m-2]. real, dimension(:,:), intent(out) :: pen_SW_bnd !< penetrating SW flux, split into bands. - !! Units are (degC H ~> degC m or degC kg m-2) + !! [degC H ~> degC m or degC kg m-2] !! and array size nsw x SZI_(G), where !! nsw=number of SW bands in pen_SW_bnd. !! This heat flux is not part of net_heat. @@ -382,26 +382,26 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, !! mass fluxes into the ocean. logical, intent(in) :: aggregate_FW !< For determining how to aggregate forcing. real, dimension(SZI_(G)), & - optional, intent(out) :: nonpenSW !< Non-penetrating SW used in net_heat, in - !! degC H ~> degC m or degC kg m-2. + optional, intent(out) :: nonpenSW !< Non-penetrating SW used in net_heat + !! [degC H ~> degC m or degC kg m-2]. !! Summed over SW bands when diagnosing nonpenSW. real, dimension(SZI_(G)), & - optional, intent(out) :: net_Heat_rate !< Rate of net surface heating, in - !! degC H s-1 ~> degC m s-1 or degC kg m-2 s-1. + optional, intent(out) :: net_Heat_rate !< Rate of net surface heating + !! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1]. real, dimension(SZI_(G)), & - optional, intent(out) :: net_salt_rate !< Surface salt flux into the ocean in - !! ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1. + optional, intent(out) :: net_salt_rate !< Surface salt flux into the ocean + !! [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1]. real, dimension(SZI_(G)), & - optional, intent(out) :: netmassInOut_rate !< Rate of net mass flux into the ocean, in - !! H s-1 ~> m s-1 or kg m-2 s-1. + optional, intent(out) :: netmassInOut_rate !< Rate of net mass flux into the ocean + !! [H s-1 ~> m s-1 or kg m-2 s-1]. real, dimension(:,:), & - optional, intent(out) :: pen_sw_bnd_rate !< Rate of penetrative shortwave heating, in - !! degC H s-1 ~> degC m s-1 or degC kg m-2 s-1. + optional, intent(out) :: pen_sw_bnd_rate !< Rate of penetrative shortwave heating + !! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1]. logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating diagnostics ! local - real :: htot(SZI_(G)) ! total ocean depth (m for Bouss or kg/m^2 for non-Bouss) - real :: Pen_sw_tot(SZI_(G)) ! sum across all bands of Pen_SW degC H ~> degC m or degC kg m-2. + real :: htot(SZI_(G)) ! total ocean depth [H ~> m or kg m-2] + real :: Pen_sw_tot(SZI_(G)) ! sum across all bands of Pen_SW [degC H ~> degC m or degC kg m-2]. real :: pen_sw_tot_rate(SZI_(G)) ! Similar but sum but as a rate (no dt in calculation) real :: Ih_limit ! inverse depth at which surface fluxes start to be limited (1/H) real :: scale ! scale scales away fluxes if depth < FluxRescaleDepth @@ -782,15 +782,15 @@ subroutine extractFluxes2d(G, GV, fluxes, optics, nsw, dt, FluxRescaleDepth, & logical, intent(in) :: useRiverHeatContent !< logical for river heat content logical, intent(in) :: useCalvingHeatContent !< logical for calving heat content real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< layer thickness (in H ~> m or kg m-2) + intent(in) :: h !< layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: T !< layer temperatures (deg C) real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux !! (if Bouss) of water in/out of ocean over - !! a time step (H ~> m or kg m-2) + !! a time step [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassOut !< net mass flux (non-Bouss) or volume flux !! (if Bouss) of water leaving ocean surface - !! over a time step (H ~> m or kg m-2). + !! over a time step [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_heat !< net heat at the surface accumulated over a !! time step associated with coupler + restore. !! Exclude two terms from net_heat: @@ -1977,11 +1977,11 @@ subroutine set_derived_forcing_fields(forces, fluxes, G, US, Rho0) type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(ocean_grid_type), intent(in) :: G !< grid type type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: Rho0 !< A reference density of seawater, in kg m-3, + real, intent(in) :: Rho0 !< A reference density of seawater [kg m-3], !! as used to calculate ustar. - real :: taux2, tauy2 ! Squared wind stress components, in Pa^2. - real :: Irho0 ! Inverse of the mean density rescaled to (Z2 m / kg ~> m3 kg-1) + real :: taux2, tauy2 ! Squared wind stress components [Pa2]. + real :: Irho0 ! Inverse of the mean density rescaled to [Z2 m / kg ~> m3 kg-1] integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 37bd832f66..8a62950574 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -169,7 +169,7 @@ module MOM_grid real :: len_lat = 0. !< The latitudinal (or y-coord) extent of physical domain real :: len_lon = 0. !< The longitudinal (or x-coord) extent of physical domain real :: Rad_Earth = 6.378e6 !< The radius of the planet in meters. - real :: max_depth !< The maximum depth of the ocean in depth units (Z ~> m). + real :: max_depth !< The maximum depth of the ocean in depth units [Z ~> m]. end type ocean_grid_type contains diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index f6190f4bf3..a02ba33870 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -32,7 +32,7 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] !! (usually m or kg m-2). type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to !! various thermodynamic @@ -42,7 +42,7 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic !! variable that gives the "correct" free surface height (Boussinesq) or total water !! column mass per unit area (non-Boussinesq). This is used to dilate the layer. - !! thicknesses when calculating interfaceheights, in H ~> m or kg m-2. + !! thicknesses when calculating interfaceheights [H ~> m or kg m-2]. integer, optional, intent(in) :: halo_size !< width of halo points on !! which to calculate eta. real, optional, intent(in) :: eta_to_m !< The conversion factor from @@ -147,7 +147,7 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] !! (usually m or kg m-2). type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to !! various thermodynamic @@ -157,7 +157,7 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) !! level (z=0) (m). real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic !! variable that gives the "correct" free surface height (Boussinesq) or total - !! water column mass per unit area (non-Boussinesq), in H ~> m or kg m-2. + !! water column mass per unit area (non-Boussinesq) [H ~> m or kg m-2]. integer, optional, intent(in) :: halo_size !< width of halo points on !! which to calculate eta. real, optional, intent(in) :: eta_to_m !< The conversion factor from @@ -167,7 +167,7 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) p ! The pressure in Pa. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & dz_geo ! The change in geopotential height across a layer, in m2 s-2. - real :: htot(SZI_(G)) ! The sum of all layers' thicknesses, in H ~> m or kg m-2. + real :: htot(SZI_(G)) ! The sum of all layers' thicknesses [H ~> m or kg m-2]. real :: I_gEarth real :: Z_to_eta, H_to_eta, H_to_rho_eta ! Unit conversion factors with obvious names. integer i, j, k, is, ie, js, je, nz, halo diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index edf7ba7e1f..edc304dd02 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -28,7 +28,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface heights [Z ~> m] or units !! given by 1/eta_to_m) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various @@ -73,9 +73,9 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & real :: drdjA, drdjB ! gradients in the layers above (A) and below(B) the ! interface times the grid spacing, in kg m-3. real :: drdkL, drdkR ! Vertical density differences across an interface, in kg m-3. - real :: hg2A, hg2B ! Squares of geometric mean thicknesses, in H2 ~> m2 or kg2 m-4. - real :: hg2L, hg2R ! Squares of geometric mean thicknesses, in H2 ~> m2 or kg2 m-4. - real :: haA, haB, haL, haR ! Arithmetic mean thicknesses in H ~> m or kg m-2. + real :: hg2A, hg2B ! Squares of geometric mean thicknesses [H2 ~> m2 or kg2 m-4]. + real :: hg2L, hg2R ! Squares of geometric mean thicknesses [H2 ~> m2 or kg2 m-4]. + real :: haA, haB, haL, haR ! Arithmetic mean thicknesses [H ~> m or kg m-2]. real :: dzaL, dzaR ! Temporary thicknesses in eta units (Z?). real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. real :: drdx, drdy ! Zonal and meridional density gradients, in kg m-4. @@ -85,8 +85,8 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & real :: mag_grad2 ! The squared magnitude of the 3-d density gradient, in kg2 m-8. real :: slope2_Ratio ! The ratio of the slope squared to slope_max squared. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. - real :: h_neglect2 ! h_neglect^2, in H2 ~> m2 or kg2 m-4. + ! in roundoff and can be neglected [H ~> m or kg m-2]. + real :: h_neglect2 ! h_neglect^2 [H2 ~> m2 or kg2 m-4]. real :: dz_neglect ! A change in interface heighs that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. logical :: use_EOS ! If true, density is calculated from T & S using an @@ -333,7 +333,7 @@ end subroutine calc_isoneutral_slopes subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Temperature (deg C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Salinity (psu) real, intent(in) :: kappa_dt !< A vertical diffusivity to use for smoothing diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 6118d242d6..57720bb865 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -129,10 +129,10 @@ module MOM_variables S => NULL(), & !< Pointer to the salinity state variable, in PSU or g/kg u => NULL(), & !< Pointer to the zonal velocity, in m s-1 v => NULL(), & !< Pointer to the meridional velocity, in m s-1 - h => NULL() !< Pointer to the layer thicknesses, in H ~> m or kg m-2 + h => NULL() !< Pointer to the layer thicknesses [H ~> m or kg m-2] real, pointer, dimension(:,:,:) :: & - uh => NULL(), & !< Pointer to zonal transports, in H m2 s-1 ~> m2 s-1 or kg s-1 - vh => NULL() !< Pointer to meridional transports, in H m2 s-1 ~> m2 s-1 or kg s-1 + uh => NULL(), & !< Pointer to zonal transports [H m2 s-1 ~> m3 s-1 or kg s-1] + vh => NULL() !< Pointer to meridional transports [H m2 s-1 ~> m3 s-1 or kg s-1] real, pointer, dimension(:,:,:) :: & CAu => NULL(), & !< Pointer to the zonal Coriolis and Advective acceleration, in m s-2 CAv => NULL(), & !< Pointer to the meridional Coriolis and Advective acceleration, in m s-2 @@ -227,7 +227,7 @@ module MOM_variables real, pointer, dimension(:,:) :: nkml_visc_v => NULL() !< The number of layers in the viscous surface mixed layer at v-points (nondimensional). real, pointer, dimension(:,:) :: & - MLD => NULL() !< Instantaneous active mixing layer depth (H ~> m or kg m-2). + MLD => NULL() !< Instantaneous active mixing layer depth [H ~> m or kg m-2]. real, pointer, dimension(:,:,:) :: & Ray_u => NULL(), & !< The Rayleigh drag velocity to be applied to each layer at u-points [Z s-1 ~> m s-1]. Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points [Z s-1 ~> m s-1]. @@ -263,31 +263,31 @@ module MOM_variables !! and how they will vary as the barotropic velocity is changed. type, public :: BT_cont_type real, allocatable :: FA_u_EE(:,:) !< The effective open face area for zonal barotropic transport - !! drawing from locations far to the east, in H m ~> m2 or kg m-1. + !! drawing from locations far to the east [H m ~> m2 or kg m-1]. real, allocatable :: FA_u_E0(:,:) !< The effective open face area for zonal barotropic transport - !! drawing from nearby to the east, in H m ~> m2 or kg m-1. + !! drawing from nearby to the east [H m ~> m2 or kg m-1]. real, allocatable :: FA_u_W0(:,:) !< The effective open face area for zonal barotropic transport - !! drawing from nearby to the west, in H m ~> m2 or kg m-1. + !! drawing from nearby to the west [H m ~> m2 or kg m-1]. real, allocatable :: FA_u_WW(:,:) !< The effective open face area for zonal barotropic transport - !! drawing from locations far to the west, in H m ~> m2 or kg m-1. + !! drawing from locations far to the west [H m ~> m2 or kg m-1]. real, allocatable :: uBT_WW(:,:) !< uBT_WW is the barotropic velocity, in m s-1, beyond which the marginal !! open face area is FA_u_WW. uBT_WW must be non-negative. real, allocatable :: uBT_EE(:,:) !< uBT_EE is a barotropic velocity, in m s-1, beyond which the marginal !! open face area is FA_u_EE. uBT_EE must be non-positive. real, allocatable :: FA_v_NN(:,:) !< The effective open face area for meridional barotropic transport - !! drawing from locations far to the north, in H m ~> m2 or kg m-1. + !! drawing from locations far to the north [H m ~> m2 or kg m-1]. real, allocatable :: FA_v_N0(:,:) !< The effective open face area for meridional barotropic transport - !! drawing from nearby to the north, in H m ~> m2 or kg m-1. + !! drawing from nearby to the north [H m ~> m2 or kg m-1]. real, allocatable :: FA_v_S0(:,:) !< The effective open face area for meridional barotropic transport - !! drawing from nearby to the south, in H m ~> m2 or kg m-1. + !! drawing from nearby to the south [H m ~> m2 or kg m-1]. real, allocatable :: FA_v_SS(:,:) !< The effective open face area for meridional barotropic transport - !! drawing from locations far to the south, in H m ~> m2 or kg m-1. + !! drawing from locations far to the south [H m ~> m2 or kg m-1]. real, allocatable :: vBT_SS(:,:) !< vBT_SS is the barotropic velocity, in m s-1, beyond which the marginal !! open face area is FA_v_SS. vBT_SS must be non-negative. real, allocatable :: vBT_NN(:,:) !< vBT_NN is the barotropic velocity, in m s-1, beyond which the marginal !! open face area is FA_v_NN. vBT_NN must be non-positive. - real, allocatable :: h_u(:,:,:) !< An effective thickness at zonal faces, in H ~> m or kg m-2. - real, allocatable :: h_v(:,:,:) !< An effective thickness at meridional faces, in H ~> m or kg m-2. + real, allocatable :: h_u(:,:,:) !< An effective thickness at zonal faces [H ~> m or kg m-2]. + real, allocatable :: h_v(:,:,:) !< An effective thickness at meridional faces [H ~> m or kg m-2]. type(group_pass_type) :: pass_polarity_BT !< Structure for polarity group halo updates type(group_pass_type) :: pass_FA_uv !< Structure for face area group halo updates end type BT_cont_type diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 81dde3114b..84a6ed350d 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -26,7 +26,7 @@ module MOM_verticalGrid ! Commonly used parameters integer :: ke !< The number of layers/levels in the vertical real :: max_depth !< The maximum depth of the ocean in Z (often m). - real :: g_Earth !< The gravitational acceleration in m2 Z-1 s-2 ~> m s-2. + real :: g_Earth !< The gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. real :: Rho0 !< The density used in the Boussinesq approximation or nominal !! density used to convert depths into mass units, in kg m-3. @@ -47,7 +47,7 @@ module MOM_verticalGrid !! Angstrom or larger without changing it at the bit level, in thickness units. !! If Angstrom is 0 or exceedingly small, this is negligible compared to 1e-17 m. real, allocatable, dimension(:) :: & - g_prime, & !< The reduced gravity at each interface, in m2 Z-1 s-2 ~> m s-2. + g_prime, & !< The reduced gravity at each interface [m2 Z-1 s-2 ~> m s-2]. Rlay !< The target coordinate value (potential density) in each layer in kg m-3. integer :: nkml = 0 !< The number of layers at the top that should be treated !! as parts of a homogenous region. diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index a59b9a73a4..1c21ed4f90 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -75,7 +75,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: um !< The new zonal velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: hin !< The layer thickness, in H ~> m or kg m-2. + intent(in) :: hin !< The layer thickness [H ~> m or kg m-2]. type(accel_diag_ptrs), intent(in) :: ADp !< A structure pointing to the various !! accelerations in the momentum equations. type(cont_diag_ptrs), intent(in) :: CDp !< A structure with pointers to various terms @@ -90,7 +90,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, Z s-1. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, - !! from vertvisc, in H ~> m or kg m-2. + !! from vertvisc [H ~> m or kg m-2]. ! Local variables real :: f_eff, CFL real :: Angstrom @@ -406,7 +406,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: vm !< The new meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: hin !< The layer thickness, in H ~> m or kg m-2. + intent(in) :: hin !< The layer thickness [H ~> m or kg m-2]. type(accel_diag_ptrs), intent(in) :: ADp !< A structure pointing to the various !! accelerations in the momentum equations. type(cont_diag_ptrs), intent(in) :: CDp !< A structure with pointers to various terms in @@ -421,7 +421,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, Z s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, - !! from vertvisc, in H ~> m or kg m-2. + !! from vertvisc [H ~> m or kg m-2]. ! Local variables real :: f_eff, CFL real :: Angstrom diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index 2dd5ffbf4b..23890d6d34 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -154,7 +154,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, US, CS) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: ssh_in !< Sea surface height in meters. real, dimension(:,:), pointer :: frac_shelf_h !< The fraction of the cell area covered by @@ -185,7 +185,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, US, CS) ! Note that -1/2 <= z1 < z2 <= 1/2. real :: sl_tr(max(CS%num_tr_used,1)) ! normalized slope of the tracer ! within the cell, in tracer units - real :: Angstrom ! A minimal layer thickness, in H ~> m or kg m-2. + real :: Angstrom ! A minimal layer thickness [H ~> m or kg m-2]. real :: slope ! normalized slope of a variable within the cell real :: layer_ave(CS%nk_zspace) @@ -508,7 +508,7 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) !! transport (m3 or kg). real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh_int !< Time integrated meridional !! transport (m3 or kg). - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, intent(in) :: dt !< The time difference in s since !! the last call to this !! subroutine. @@ -517,7 +517,7 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) !! diag_to_Z_init. ! Local variables real, dimension(SZI_(G), SZJ_(G)) :: & - htot, & ! total layer thickness, in H ~> m or kg m-2 + htot, & ! total layer thickness [H ~> m or kg m-2] dilate ! Factor by which to dilate layers to convert them ! into z* space [Z H-1 ~> 1 or m3 kg-1]. (-G%D < z* < 0) @@ -751,7 +751,7 @@ end subroutine find_limited_slope subroutine calc_Zint_diags(h, in_ptrs, ids, num_diags, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(p3d), dimension(:), intent(in) :: in_ptrs !< Pointers to the diagnostics to be regridded integer, dimension(:), intent(in) :: ids !< The diagnostic IDs of the diagnostics integer, intent(in) :: num_diags !< The number of diagnostics to regrid diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 1c82b5062f..6e6668aca7 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -194,13 +194,13 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: uh !< Transport through zonal faces = u*h*dy, - !! in H m2 s-1 ~> m3 s-1 or kg s-1. + !! [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: vh !< Transport through meridional faces = v*h*dx, - !! in H m2 s-1 ~> m3 s-1 or kg s-1. + !! [H m2 s-1 ~> m3 s-1 or kg s-1]. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. type(accel_diag_ptrs), intent(in) :: ADp !< structure with pointers to @@ -770,7 +770,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. real, dimension(:,:), pointer :: p_surf !< A pointer to the surface pressure, in Pa. @@ -888,13 +888,13 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: uh !< Transport through zonal faces=u*h*dy, - !! in H m2 s-1 ~> m3 s-1 or kg s-1. + !! [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: vh !< Transport through merid faces=v*h*dx, - !! in H m2 s-1 ~> m3 s-1 or kg s-1. + !! [H m2 s-1 ~> m3 s-1 or kg s-1]. type(accel_diag_ptrs), intent(in) :: ADp !< Structure pointing to accelerations in momentum equation. type(cont_diag_ptrs), intent(in) :: CDp !< Structure pointing to terms in continuity equations. type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by a previous call to @@ -1323,7 +1323,7 @@ subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, d real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhtr !< Accumulated meridional thickness fluxes !! used to advect tracers (m3 or kg) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< The updated layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< The updated layer thicknesses [H ~> m or kg m-2] type(transport_diag_IDs), intent(in) :: IDs !< A structure with the diagnostic IDs. type(diag_grid_storage), intent(inout) :: diag_pre_dyn !< Stored grids from before dynamics type(diag_ctrl), intent(inout) :: diag !< regulates diagnostic output diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 5fc79ef3ee..4f38fac043 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -282,7 +282,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. type(time_type), intent(in) :: day !< The current model time. diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 19987c1b52..dd0ea1e524 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -52,7 +52,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thickness in H ~> m or kg m-2 + intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZI_(G),SZJ_(G)), intent(out) :: cg1 !< First mode internal wave speed (m/s) type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed @@ -73,7 +73,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & real, dimension(SZK_(G)+1) :: & dRho_dT, dRho_dS, & pres, T_int, S_int, & - gprime ! The reduced gravity across each interface, in m2 Z-1 s-2 ~> m s-2. + gprime ! The reduced gravity across each interface [m2 Z-1 s-2 ~> m s-2]. real, dimension(SZK_(G)) :: & Igl, Igu ! The inverse of the reduced gravity across an interface times ! the thickness of the layer below (Igl) or above (Igu) it, @@ -456,7 +456,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & mode_struct(1:kc)=0. endif ! Note that remapping_core_h requires that the same units be used - ! for both the source and target grid thicknesses, here in H ~> m or kg m-2. + ! for both the source and target grid thicknesses, here [H ~> m or kg m-2]. call remapping_core_h(CS%remapping_CS, kc, GV%Z_to_H*Hc(:), mode_struct, & nz, h(i,j,:), modal_structure(i,j,:), 1.0e-30*GV%m_to_H, 1.0e-10*GV%m_to_H) endif diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 91ff8cbd2b..af959b8279 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -92,7 +92,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] !! (usually m or kg m-2). type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. @@ -114,7 +114,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real, dimension(SZK_(G)+1) :: & dRho_dT, dRho_dS, & pres, T_int, S_int, & - gprime ! The reduced gravity across each interface, in m2 Z-1 s-2 ~> m s-2. + gprime ! The reduced gravity across each interface [m2 Z-1 s-2 ~> m s-2]. real, dimension(SZK_(G)) :: & Igl, Igu ! The inverse of the reduced gravity across an interface times ! the thickness of the layer below (Igl) or above (Igu) it, diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index ea0e6e4a11..fe0ae76e6f 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -630,14 +630,14 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, & real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S !< Salinity (PSU) real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in depth units (Z ~> m). + intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_b !< Height at the bottom of the layer [Z ~> m]. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to !! reduce the magnitude of each of the integrals. real, intent(in) :: rho_0 !< A density, in kg m-3, that is used to calculate the !! pressure (as p~=-z*rho_0*G_e) used in the equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2 ~> m s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly across the layer, in Pa. @@ -881,7 +881,7 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S !< Salinity of the layer in PSU. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in depth units (Z ~> m). + intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_b !< Height at the bottom of the layer [Z ~> m]. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is @@ -890,7 +890,7 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, intent(in) :: rho_0 !< A density, in kg m-3, that is used !! to calculate the pressure (as p~=-z*rho_0*G_e) !! used in the equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2 ~> m s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly @@ -1073,14 +1073,14 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & intent(in) :: S_b !< Salinity at the cell bottom (ppt) real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_t !< The geometric height at the top of the layer, - !! in depth units (Z ~> m). + !! in depth units [Z ~> m]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_b !< The geometric height at the bottom of the layer [Z ~> m]. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to !! reduce the magnitude of each of the integrals. real, intent(in) :: rho_0 !< A density, in kg m-3, that is used to calculate the !! pressure (as p~=-z*rho_0*G_e) used in the equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2 ~> m s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. real, intent(in) :: dz_subroundoff !< A miniscule thickness !! change with the same units as z_t real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index 6579c20e82..110ac44c9b 100644 --- a/src/equation_of_state/MOM_EOS_Wright.F90 +++ b/src/equation_of_state/MOM_EOS_Wright.F90 @@ -407,7 +407,7 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S !< Salinity in PSU. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in depth units (Z ~> m). + intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_b !< Height at the top of the layer [Z ~> m]. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out @@ -416,7 +416,7 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, intent(in) :: rho_0 !< Density, in kg m-3, that is used to calculate the !! pressure (as p~=-z*rho_0*G_e) used in the !! equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2 ~> m s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly across the !! layer, in Pa. diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90 index 3743311394..d2ef8c8550 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -328,7 +328,7 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: S !< Salinity in PSU. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in depth units (Z ~> m). + intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_b !< Height at the top of the layer [Z ~> m]. real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted @@ -338,7 +338,7 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, !! the pressure (as p~=-z*rho_0_pres*G_e) used in !! the equation of state. rho_0_pres is not used !! here. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m2 Z-1 s-2 ~> m s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. real, intent(in) :: dRho_dT !< The derivative of density with temperature, !! in kg m-3 C-1. diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index bc2f772e3a..e4375bda42 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -950,7 +950,7 @@ subroutine post_data_3d(diag_field_id, field, diag_cs, is_static, mask, alt_h) real, optional, intent(in) :: mask(:,:,:) !< If present, use this real array as the data mask. real, dimension(:,:,:), & target, optional, intent(in) :: alt_h !< An alternate thickness to use for vertically - !! remapping this diagnostic, in H ~> m or kg m-2. + !! remapping this diagnostic [H ~> m or kg m-2]. ! Local variables type(diag_type), pointer :: diag => null() diff --git a/src/framework/MOM_spatial_means.F90 b/src/framework/MOM_spatial_means.F90 index 699fdaa5c8..00f1474879 100644 --- a/src/framework/MOM_spatial_means.F90 +++ b/src/framework/MOM_spatial_means.F90 @@ -65,7 +65,7 @@ function global_layer_mean(var, h, G, GV) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: var !< The variable to average - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZK_(GV)) :: global_layer_mean real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: tmpForSumming, weight @@ -97,7 +97,7 @@ function global_volume_mean(var, h, G, GV) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: var !< The variable being averaged real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real :: global_volume_mean !< The thickness-weighted average of var real :: weight_here @@ -123,7 +123,7 @@ function global_mass_integral(h, G, GV, var, on_PE_only) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: var !< The variable being integrated logical, optional, intent(in) :: on_PE_only !< If present and true, the sum is only diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index c1b1b41096..0f34782f7f 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -126,7 +126,7 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! in m2 Z-1 s-2 ~> m s-2. + !! [m2 Z-1 s-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters @@ -160,7 +160,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! in m2 Z-1 s-2 ~> m s-2. + !! [m2 Z-1 s-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters @@ -203,7 +203,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! in m2 Z-1 s-2 ~> m s-2. + !! [m2 Z-1 s-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time @@ -255,7 +255,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, & real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! in m2 Z-1 s-2 ~> m s-2. + !! [m2 Z-1 s-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time @@ -304,7 +304,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, & real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! in m2 Z-1 s-2 ~> m s-2. + !! [m2 Z-1 s-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time @@ -386,7 +386,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! in m2 Z-1 s-2 ~> m s-2. + !! [m2 Z-1 s-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters @@ -437,7 +437,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! in m2 Z-1 s-2 ~> m s-2. + !! [m2 Z-1 s-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index d4bf57922f..d0a5be6b96 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -1227,8 +1227,8 @@ subroutine initialize_masks(G, PF, US) type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables real :: m_to_Z_scale ! A unit conversion factor from m to Z. - real :: Dmin ! The depth for masking in the same units as G%bathyT (Z ~> m). - real :: min_depth ! The minimum ocean depth in the same units as G%bathyT (Z ~> m). + real :: Dmin ! The depth for masking in the same units as G%bathyT [Z ~> m]. + real :: min_depth ! The minimum ocean depth in the same units as G%bathyT [Z ~> m]. real :: mask_depth ! The depth shallower than which to mask a point as land [Z ~> m]. character(len=40) :: mdl = "MOM_grid_init initialize_masks" integer :: i, j diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 41ba74b115..39814f122c 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -130,7 +130,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & intent(out) :: v !< The meridional velocity that is being !! initialized, in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(out) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(out) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic !! variables type(time_type), intent(inout) :: Time !< Time at the start of the run segment. @@ -705,7 +705,7 @@ subroutine adjustEtaToFitBathymetry(G, GV, US, eta, h) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: eta !< Interface heights [Z ~> m]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] ! Local variables integer :: i, j, k, is, ie, js, je, nz, contractions, dilations real :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria (m) @@ -778,7 +778,7 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. + intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -834,17 +834,17 @@ subroutine initialize_thickness_list(h, G, GV, US, param_file, just_read_params) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. + intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables character(len=40) :: mdl = "initialize_thickness_list" ! This subroutine's name. - real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z ~> m), + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units [Z ~> m], ! usually negative because it is positive upward. real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in depth units (Z ~> m). + ! positive upward, in depth units [Z ~> m]. logical :: just_read ! If true, just read parameters but set nothing. character(len=200) :: filename, eta_file, inputdir ! Strings for file/path character(len=72) :: eta_var @@ -911,15 +911,14 @@ end subroutine initialize_thickness_search !> Converts thickness from geometric to pressure units subroutine convert_thickness(h, G, GV, US, tv) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Input geometric layer thicknesses (in H ~> m - !! or kg m-2), being converted to layer pressure - !! thicknesses (also in H ~> m or kg m-2). - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various - !! thermodynamic variables + intent(inout) :: h !< Input geometric layer thicknesses being converted + !! to layer pressure [H ~> m or kg m-2]. + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & p_top, p_bot @@ -994,7 +993,7 @@ subroutine depress_surface(h, G, GV, US, param_file, tv, just_read_params) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1901,7 +1900,7 @@ end subroutine set_velocity_depth_min subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_params) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(out) :: h !< Layer thicknesses being initialized, in H ~> m or kg m-2 + intent(out) :: h !< Layer thicknesses being initialized [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic !! variables including temperature and salinity type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -1973,7 +1972,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param real, dimension(:,:), allocatable, target :: frac_shelf_h real, dimension(:,:,:), allocatable, target :: tmpT1dIn, tmpS1dIn real, dimension(:,:,:), allocatable :: tmp_mask_in - real, dimension(:,:,:), allocatable :: h1 ! Thicknesses in H ~> m or kg m-2. + real, dimension(:,:,:), allocatable :: h1 ! Thicknesses [H ~> m or kg m-2]. real, dimension(:,:,:), allocatable :: dz_interface ! Change in position of interface due to regridding real :: zTopOfCell, zBottomOfCell ! Heights in Z units [Z ~> m]. type(regridding_CS) :: regridCS ! Regridding parameters and work arrays diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 9f03a2bfd2..27511e1593 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -50,7 +50,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thickness, in H ~> m or kg m-2. + intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. real, dimension(:,:,:), pointer :: tr !< Pointer to array to be initialized type(param_file_type), intent(in) :: PF !< parameter file character(len=*), intent(in) :: src_file !< source filename @@ -82,7 +82,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ real, allocatable, dimension(:), target :: z_edges_in, z_in ! Local variables for ALE remapping - real, dimension(:,:,:), allocatable :: hSrc ! Source thicknesses in H ~> m or kg m-2. + real, dimension(:,:,:), allocatable :: hSrc ! Source thicknesses [H ~> m or kg m-2]. real, dimension(:), allocatable :: h1 ! A 1-d column of source thicknesses [Z ~> m]. real :: zTopOfCell, zBottomOfCell, z_bathy ! Heights [Z ~> m]. type(remapping_CS) :: remapCS ! Remapping parameters and work arrays diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 1b152e4137..116d74859d 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -323,7 +323,7 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), pointer :: G !< domain and grid information for ocean model type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables type(ODA_CS), pointer :: CS !< ocean DA control structure @@ -383,7 +383,7 @@ end subroutine set_prior_tracer subroutine get_posterior_tracer(Time, CS, h, tv, increment) type(time_type), intent(in) :: Time !< the current model time type(ODA_CS), pointer :: CS !< ocean DA control structure - real, dimension(:,:,:), pointer :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(:,:,:), pointer :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), pointer :: tv !< A structure pointing to various thermodynamic variables logical, optional, intent(in) :: increment !< True if returning increment only diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index d6cd7b9da7..936e76237a 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -98,7 +98,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h type(ocean_grid_type), intent(inout) :: G !< Ocean grid. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points (s-1). real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points (s-1). type(vertvisc_type), intent(in) :: visc !< The vertical viscosity type. diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index c252a9a613..6d359183b5 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -183,7 +183,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] !! (usually m or kg m-2). real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: diffu !< Zonal acceleration due to convergence of @@ -201,10 +201,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & u0, & ! Laplacian of u (m-1 s-1) - h_u ! Thickness interpolated to u points, in H ~> m or kg m-2. + h_u ! Thickness interpolated to u points [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJB_(G)) :: & v0, & ! Laplacian of v (m-1 s-1) - h_v ! Thickness interpolated to v points, in H ~> m or kg m-2. + h_v ! Thickness interpolated to v points [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)) :: & sh_xx, & ! horizontal tension (du/dx - dv/dy) (1/sec) including metric terms @@ -248,12 +248,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, ! This is set equal to zero if modified Leith is not used. real :: Shear_mag ! magnitude of the shear (1/s) real :: Vort_mag ! magnitude of the vorticity (1/s) - real :: h2uq, h2vq ! temporary variables in H2 ~> m2 or kg2 m-4. + real :: h2uq, h2vq ! temporary variables [H2 ~> m2 or kg2 m-4]. real :: hu, hv ! Thicknesses interpolated by arithmetic means to corner ! points; these are first interpolated to u or v velocity - ! points where masks are applied, in H ~> m or kg m-2. + ! points where masks are applied [H ~> m or kg m-2]. real :: hq ! harmonic mean of the harmonic means of the u- & v- poing thicknesses, - ! in H ~> m or kg m-2; This form guarantees that hq/hu < 4. + ! [H ~> m or kg m-2]; This form guarantees that hq/hu < 4. real :: h_neglect ! thickness so small it can be lost in roundoff and so neglected (H) real :: h_neglect3 ! h_neglect^3, in H3 real :: hrat_min ! minimum thicknesses at the 4 neighboring diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 8586af8483..64a7bd0405 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -157,7 +157,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] !! (usually m or kg m-2). type(thermo_var_ptrs), intent(in) :: tv !< Pointer to thermodynamic variables !! (needed for wave structure). diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index a1dd5211ff..a7b0a75f15 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -588,7 +588,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop real :: Khth_Loc ! Locally calculated thickness mixing coefficient (m2/s) real :: H_cutoff ! Local estimate of a minimum thickness for masking (m) real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: S2 ! Interface slope squared (non-dim) real :: N2 ! Brunt-Vaisala frequency (1/s) real :: Hup, Hdn ! Thickness from above, below (m or kg m-2) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index b2a9b24241..8396c5e5c3 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -64,8 +64,8 @@ module MOM_mixed_layer_restrat !! timing of diagnostic output. real, dimension(:,:), pointer :: & - MLD_filtered => NULL(), & !< Time-filtered MLD (H ~> m or kg m-2) - MLD_filtered_slow => NULL() !< Slower time-filtered MLD (H ~> m or kg m-2) + MLD_filtered => NULL(), & !< Time-filtered MLD [H ~> m or kg m-2] + MLD_filtered_slow => NULL() !< Slower time-filtered MLD [H ~> m or kg m-2] !>@{ !! Diagnostic identifier @@ -101,7 +101,7 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment (sec) real, dimension(:,:), pointer :: MLD !< Mixed layer depth provided by the - !! PBL scheme (H ~> m or kg m-2) + !! PBL scheme [H ~> m or kg m-2] type(VarMix_CS), pointer :: VarMix !< Container for derived fields type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure @@ -140,13 +140,13 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! sublayer of the mixed layer, divided by dt, in units ! of H * m2 s-1 (i.e., m3 s-1 or kg s-1). real, dimension(SZI_(G),SZJ_(G)) :: & - MLD_fast, & ! Mixed layer depth actually used in MLE restratification parameterization (H ~> m or kg m-2) - htot_fast, & ! The sum of the thicknesses of layers in the mixed layer (H ~> m or kg m-2) + MLD_fast, & ! Mixed layer depth actually used in MLE restratification parameterization [H ~> m or kg m-2] + htot_fast, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] Rml_av_fast, & ! g_Rho0 times the average mixed layer density (m s-2) - MLD_slow, & ! Mixed layer depth actually used in MLE restratification parameterization (H ~> m or kg m-2) - htot_slow, & ! The sum of the thicknesses of layers in the mixed layer (H ~> m or kg m-2) + MLD_slow, & ! Mixed layer depth actually used in MLE restratification parameterization [H ~> m or kg m-2] + htot_slow, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] Rml_av_slow ! g_Rho0 times the average mixed layer density (m s-2) - real :: g_Rho0 ! G_Earth/Rho0 (m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1) + real :: g_Rho0 ! G_Earth/Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1] real :: rho_ml(SZI_(G)) ! Potential density relative to the surface (kg m-3) real :: p0(SZI_(G)) ! A pressure of 0 (Pa) @@ -165,9 +165,9 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! the mixed layer must be 0. real :: b(SZK_(G)) ! As for a(k) but for the slow-filtered MLD real :: uDml(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml(SZI_(G)) ! half of the mixed layer in H m2 s-1 ~> m3 s-1 or kg s-1. + real :: vDml(SZI_(G)) ! half of the mixed layer [H m2 s-1 ~> m3 s-1 or kg s-1]. real :: uDml_slow(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml_slow(SZI_(G)) ! half of the mixed layer in H m2 s-1 ~> m3 s-1 or kg s-1. + real :: vDml_slow(SZI_(G)) ! half of the mixed layer [H m2 s-1 ~> m3 s-1 or kg s-1]. real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! restratification timescales real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! in the zonal and meridional ! directions, in s, stored in 2-D @@ -175,7 +175,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real :: uDml_diag(SZIB_(G),SZJ_(G)), vDml_diag(SZI_(G),SZJB_(G)) integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz real, dimension(SZI_(G)) :: rhoSurf, deltaRhoAtKm1, deltaRhoAtK - real, dimension(SZI_(G)) :: dK, dKm1 ! Depths of layer centers, in H ~> m or kg m-2. + real, dimension(SZI_(G)) :: dK, dKm1 ! Depths of layer centers [H ~> m or kg m-2]. real, dimension(SZI_(G)) :: pRef_MLD ! A reference pressure for calculating the mixed layer densities, in Pa. real, dimension(SZI_(G)) :: rhoAtK, rho1, d1, pRef_N2 ! Used for N2 real :: aFac, bFac, ddRho @@ -566,9 +566,9 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) ! sublayer of the mixed layer, divided by dt, in units ! of H m2 s-1 (i.e., m3 s-1 or kg s-1). real, dimension(SZI_(G),SZJ_(G)) :: & - htot, & ! The sum of the thicknesses of layers in the mixed layer (H ~> m or kg m-2) + htot, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] Rml_av ! g_Rho0 times the average mixed layer density (m s-2) - real :: g_Rho0 ! G_Earth/Rho0 (m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1) + real :: g_Rho0 ! G_Earth/Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1] real :: Rho0(SZI_(G)) ! Potential density relative to the surface (kg m-3) real :: p0(SZI_(G)) ! A pressure of 0 (Pa) @@ -577,18 +577,18 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) real :: u_star ! surface friction velocity, interpolated to velocity points [Z s-1 ~> m s-1]. real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer (s-1) real :: timescale ! mixing growth timescale (sec) - real :: h_neglect ! tiny thickness usually lost in roundoff and can be neglected (H ~> m or kg m-2) + real :: h_neglect ! tiny thickness usually lost in roundoff and can be neglected [H ~> m or kg m-2] real :: dz_neglect ! tiny thickness that usually lost in roundoff and can be neglected [Z ~> m] real :: I4dt ! 1/(4 dt) - real :: I2htot ! Twice the total mixed layer thickness at velocity points (H ~> m or kg m-2) - real :: z_topx2 ! depth of the top of a layer at velocity points (H ~> m or kg m-2) - real :: hx2 ! layer thickness at velocity points (H ~> m or kg m-2) + real :: I2htot ! Twice the total mixed layer thickness at velocity points [H ~> m or kg m-2] + real :: z_topx2 ! depth of the top of a layer at velocity points [H ~> m or kg m-2] + real :: hx2 ! layer thickness at velocity points [H ~> m or kg m-2] real :: a(SZK_(G)) ! A non-dimensional value relating the overall flux ! magnitudes (uDml & vDml) to the realized flux in a ! layer. The vertical sum of a() through the pieces of ! the mixed layer must be 0. real :: uDml(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml(SZI_(G)) ! half of the mixed layer in H m2 s-1 ~> m3 s-1 or kg s-1. + real :: vDml(SZI_(G)) ! half of the mixed layer [H m2 s-1 ~> m3 s-1 or kg s-1]. real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! The restratification timescales real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! in the zonal and meridional ! directions (sec), stored in 2-D diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 288e58ea6e..750108610a 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -119,7 +119,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp real :: Khth_Loc_u(SZIB_(G), SZJ_(G)) real :: Khth_Loc(SZIB_(G), SZJB_(G)) ! locally calculated thickness diffusivity (m2/s) real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real, dimension(:,:), pointer :: cg1 => null() !< Wave speed (m/s) logical :: use_VarMix, Resoln_scaled, use_stored_slopes, khth_use_ebt_struct integer :: i, j, k, is, ie, js, je, nz @@ -408,7 +408,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions (Z) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: Kh_u !< Thickness diffusivity on interfaces !! at u points (m2/s) @@ -441,12 +441,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV Rho, & ! Density itself, when a nonlinear equation of state is ! not in use. h_avail, & ! The mass available for diffusion out of each face, divided - ! by dt, in H m2 s-1 ~> m2 s-1 or kg s-1. + ! by dt [H m2 s-1 ~> m3 s-1 or kg s-1]. h_frac ! The fraction of the mass in the column above the bottom ! interface of a layer that is within a layer, ND. 0 m2 s-1 or kg s-1. + h_avail_rsum ! The running sum of h_avail above an interface [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)) :: & drho_dT_u, & ! The derivatives of density with temperature and drho_dS_u ! salinity at u points, in kg m-3 K-1 and kg m-3 psu-1. @@ -475,13 +475,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! [Z kg m-3 ~> kg m-2]. real :: drdkDe_v(SZI_(G),SZK_(G)+1) ! Lateral difference of product of drdk and e at v-points ! [Z kg m-3 ~> kg m-2]. - real :: hg2A, hg2B, hg2L, hg2R ! Squares of geometric mean thicknesses, in H2 ~> m2 or kg2 m-4. - real :: haA, haB, haL, haR ! Arithmetic mean thicknesses in H ~> m or kg m-2. + real :: hg2A, hg2B, hg2L, hg2R ! Squares of geometric mean thicknesses [H2 ~> m2 or kg2 m-4]. + real :: haA, haB, haL, haR ! Arithmetic mean thicknesses [H ~> m or kg m-2]. real :: dzaL, dzaR ! Temporary thicknesses [Z ~> m]. real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. real :: drdx, drdy ! Zonal and meridional density gradients, in kg m-4. real :: drdz ! Vertical density gradient [kg m-3 Z-1 ~> kg m-4]. - real :: h_harm ! Harmonic mean layer thickness, in H ~> m or kg m-2. + real :: h_harm ! Harmonic mean layer thickness [H ~> m or kg m-2]. real :: c2_h_u(SZIB_(G), SZK_(G)+1) ! Wave speed squared divided by h at u-points [m2 Z-1 s-2 ~> m s-2]. real :: c2_h_v(SZI_(G), SZK_(G)+1) ! Wave speed squared divided by h at v-points [m2 Z-1 s-2 ~> m s-2]. real :: hN2_u(SZIB_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above u-points [m2 Z-1 s-2 ~> m s-2]. @@ -492,7 +492,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: Sfn_unlim_v(SZI_(G), SZK_(G)+1) ! Streamfunction for v-points [Z m2 s-1 ~> m3 s-1]. real :: slope2_Ratio_u(SZIB_(G), SZK_(G)+1) ! The ratio of the slope squared to slope_max squared. real :: slope2_Ratio_v(SZI_(G), SZK_(G)+1) ! The ratio of the slope squared to slope_max squared. - real :: Sfn_in_h ! The overturning streamfunction, in H m2 s-1 ~> m2 s-1 or kg s-1 (note that + real :: Sfn_in_h ! The overturning streamfunction [H m2 s-1 ~> m3 s-1 or kg s-1] (note that ! the units are different from other Sfn vars). real :: Sfn_safe ! The streamfunction that goes linearly back to 0 at the surface. This is a ! good thing to use when the slope is so large as to be meaningless [Z m2 s-1 ~> m3 s-1]. @@ -501,18 +501,18 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: mag_grad2 ! The squared magnitude of the 3-d density gradient, in kg2 m-8. real :: I_slope_max2 ! The inverse of slope_max squared, nondimensional. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. - real :: h_neglect2 ! h_neglect^2, in H2 ~> m2 or kg2 m-4. + ! in roundoff and can be neglected [H ~> m or kg m-2]. + real :: h_neglect2 ! h_neglect^2 [H2 ~> m2 or kg2 m-4]. real :: dz_neglect ! A thickness [Z ~> m], that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. real :: G_scale ! The gravitational acceleration times some unit conversion - ! factors, in m3 Z-1 H-1 s-2 ~> m s-2 or m4 kg-1 s-2. + ! factors [m3 Z-1 H-1 s-2 ~> m s-2 or m4 kg-1 s-2]. logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. logical :: find_work ! If true, find the change in energy due to the fluxes. integer :: nk_linear ! The number of layers over which the streamfunction ! goes to 0. - real :: G_rho0 ! g/Rho0, in m5 Z-1 s-2 ~> m4 s-2. + real :: G_rho0 ! g/Rho0 [m5 Z-1 s-2 ~> m4 s-2]. real :: N2_floor ! A floor for N2 to avoid degeneracy in the elliptic solver ! times unit conversion factors (s-2 m2 Z-2) real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: diag_sfn_x, diag_sfn_unlim_x ! Diagnostics @@ -1219,7 +1219,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & de_top ! The distances between the top of a layer and the top of the - ! region where the detangling is applied, in H ~> m or kg m-2. + ! region where the detangling is applied [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & Kh_lay_u ! The tentative interface height diffusivity for each layer at ! u points, in m2 s-1. @@ -1228,8 +1228,8 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! v points, in m2 s-1. real, dimension(SZI_(G),SZJ_(G)) :: & de_bot ! The distances from the bottom of the region where the - ! detangling is applied, in H ~> m or kg m-2. - real :: h1, h2 ! The thinner and thicker surrounding thicknesses, in H ~> m or kg m-2, + ! detangling is applied [H ~> m or kg m-2]. + real :: h1, h2 ! The thinner and thicker surrounding thicknesses [H ~> m or kg m-2], ! with the thinner modified near the boundaries to mask out ! thickness variations due to topography, etc. real :: jag_Rat ! The nondimensional jaggedness ratio for a layer, going @@ -1240,7 +1240,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! layers, nondim. real :: Kh_det ! The detangling diffusivity, in m2 s-1. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: I_sl ! The absolute value of the larger in magnitude of the slopes ! above and below. @@ -1613,7 +1613,7 @@ end subroutine add_detangling_Kh subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Input temperature (C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Input salinity (ppt) real, intent(in) :: kappa !< Constant diffusivity to use (Z2/s) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index fe40137231..61930040df 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -338,7 +338,7 @@ end function get_ALE_sponge_nz_data subroutine get_ALE_sponge_thicknesses(G, data_h, sponge_mask, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). real, allocatable, dimension(:,:,:), & - intent(inout) :: data_h !< The thicknesses of the sponge input layers, in H ~> m or kg m-2. + intent(inout) :: data_h !< The thicknesses of the sponge input layers [H ~> m or kg m-2]. logical, dimension(SZI_(G),SZJ_(G)), & intent(out) :: sponge_mask !< A logical mask that is true where !! sponges are being applied. @@ -846,7 +846,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thickness, in H ~> m or kg m-2 (in) + intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] (in) real, intent(in) :: dt !< The amount of time covered by this call, in s (in). type(ALE_sponge_CS), pointer :: CS !< A pointer to the control structure for this module !! that is set by a previous call to initialize_sponge (in). diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index db1d58b743..49d02ca800 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -48,9 +48,9 @@ module MOM_bulk_mixed_layer !! the mixed layer is converted to TKE, nondim. real :: bulk_Ri_convective !< The efficiency with which convectively !! released mean kinetic energy becomes TKE, nondim. - real :: Hmix_min !< The minimum mixed layer thickness in H ~> m or kg m-2. + real :: Hmix_min !< The minimum mixed layer thickness [H ~> m or kg m-2]. real :: H_limit_fluxes !< When the total ocean depth is less than this - !! value, in H ~> m or kg m-2, scale away all surface forcing to + !! value [H ~> m or kg m-2], scale away all surface forcing to !! avoid boiling the ocean. real :: ustar_min !< A minimum value of ustar to avoid numerical problems [Z s-1 ~> m s-1]. !! If the value is small enough, this should not affect the solution. @@ -112,7 +112,7 @@ module MOM_bulk_mixed_layer ! These are terms in the mixed layer TKE budget, all in [Z m2 s-3 ~> m3 s-3]. real, allocatable, dimension(:,:) :: & - ML_depth, & !< The mixed layer depth in H ~> m or kg m-2. + ML_depth, & !< The mixed layer depth [H ~> m or kg m-2]. diag_TKE_wind, & !< The wind source of TKE. diag_TKE_RiBulk, & !< The resolved KE source of TKE. diag_TKE_conv, & !< The convective source of TKE. @@ -234,7 +234,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! new, sorted index space. Here layer 0 is an initially massless layer that ! will be used to hold the new mixed layer properties. real, dimension(SZI_(G),SZK0_(GV)) :: & - h, & ! The layer thickness, in H ~> m or kg m-2. + h, & ! The layer thickness [H ~> m or kg m-2]. T, & ! The layer temperatures, in deg C. S, & ! The layer salinities, in psu. R0, & ! The potential density referenced to the surface, in kg m-3. @@ -242,14 +242,14 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C real, dimension(SZI_(G),SZK_(GV)) :: & u, & ! The zonal velocity, in m s-1. v, & ! The meridional velocity, in m s-1. - h_orig, & ! The original thickness in H ~> m or kg m-2. + h_orig, & ! The original thickness [H ~> m or kg m-2]. d_eb, & ! The downward increase across a layer in the entrainment from - ! below, in H ~> m or kg m-2. The sign convention is that positive values of + ! below [H ~> m or kg m-2]. The sign convention is that positive values of ! d_eb correspond to a gain in mass by a layer by upward motion. d_ea, & ! The upward increase across a layer in the entrainment from - ! above, in H ~> m or kg m-2. The sign convention is that positive values of + ! above [H ~> m or kg m-2]. The sign convention is that positive values of ! d_ea mean a net gain in mass by a layer from downward motion. - eps ! The (small) thickness that must remain in a layer, in H ~> m or kg m-2. + eps ! The (small) thickness that must remain in a layer [H ~> m or kg m-2]. integer, dimension(SZI_(G),SZK_(GV)) :: & ksort ! The sorted k-index that each original layer goes to. real, dimension(SZI_(G),SZJ_(G)) :: & @@ -260,27 +260,27 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C Conv_En, & ! The turbulent kinetic energy source due to mixing down to ! the depth of free convection [Z m2 s-2 ~> m3 s-2]. htot, & ! The total depth of the layers being considered for - ! entrainment, in H ~> m or kg m-2. + ! entrainment [H ~> m or kg m-2]. R0_tot, & ! The integrated potential density referenced to the surface - ! of the layers which are fully entrained, in H kg m-3 ~> kg m-2 or kg2 m-5. + ! of the layers which are fully entrained [H kg m-3 ~> kg m-2 or kg2 m-5]. Rcv_tot, & ! The integrated coordinate value potential density of the - ! layers that are fully entrained, in H kg m-3 ~> kg m-2 or kg2 m-5. + ! layers that are fully entrained [H kg m-3 ~> kg m-2 or kg2 m-5]. Ttot, & ! The integrated temperature of layers which are fully - ! entrained, in H K ~> m K or kg m-2 K. - Stot, & ! The integrated salt of layers which are fully entrained, - ! in H PSU ~> m PSU or PSU kg m-2. + ! entrained [degC H ~> degC m or degC kg m-2]. + Stot, & ! The integrated salt of layers which are fully entrained + ! [H PSU ~> m PSU or PSU kg m-2]. uhtot, & ! The depth integrated zonal and meridional velocities in the - vhtot, & ! mixed layer, in H m s-1 ~> m2 s-1 or kg m-1 s-1. + vhtot, & ! mixed layer [H m s-1 ~> m2 s-1 or kg m-1 s-1]. netMassInOut, & ! The net mass flux (if non-Boussinsq) or volume flux (if ! Boussinesq - i.e. the fresh water flux (P+R-E)) into the - ! ocean over a time step, in H ~> m or kg m-2. + ! ocean over a time step [H ~> m or kg m-2]. NetMassOut, & ! The mass flux (if non-Boussinesq) or volume flux (if ! Boussinesq) over a time step from evaporating fresh water (H) Net_heat, & ! The net heating at the surface over a time step in K H. Any ! penetrating shortwave radiation is not included in Net_heat. Net_salt, & ! The surface salt flux into the ocean over a time step, psu H. - Idecay_len_TKE, & ! The inverse of a turbulence decay length scale, in H-1 ~> m-1 or m2 kg-1. + Idecay_len_TKE, & ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. p_ref, & ! Reference pressure for the potential density governing mixed ! layer dynamics, almost always 0 (or 1e5) Pa. p_ref_cv, & ! Reference pressure for the potential density which defines @@ -300,13 +300,13 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C Pen_SW_bnd ! The penetrating fraction of the shortwave heating integrated ! over a time step in each band, in K H. real, dimension(max(CS%nsw,1),SZI_(G),SZK_(GV)) :: & - opacity_band ! The opacity in each band, in H-1 ~> m-1 or m2 kg-1. The indicies are band, i, k. + opacity_band ! The opacity in each band [H-1 ~> m-1 or m2 kg-1]. The indicies are band, i, k. real :: cMKE(2,SZI_(G)) ! Coefficients of HpE and HpE^2 used in calculating the ! denominator of MKE_rate, in m-1 and m-2. real :: Irho0 ! 1.0 / rho_0 real :: Inkml, Inkmlm1! 1.0 / REAL(nkml) and 1.0 / REAL(nkml-1) - real :: Ih ! The inverse of a thickness, in H-1 ~> m-1 or m2 kg-1. + real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. real :: Idt ! The inverse of the timestep in s-1. real :: Idt_diag ! The inverse of the timestep used for diagnostics in s-1. real :: RmixConst @@ -314,7 +314,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C real, dimension(SZI_(G)) :: & dKE_FC, & ! The change in mean kinetic energy due to free convection ! [Z m2 s-2 ~> m3 s-2]. - h_CA ! The depth to which convective adjustment has gone in H ~> m or kg m-2. + h_CA ! The depth to which convective adjustment has gone [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)) :: & dKE_CA, & ! The change in mean kinetic energy due to convective ! adjustment [Z m2 s-2 ~> m3 s-2]. @@ -328,15 +328,15 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C Hsfc_min, & ! The minimum thickness of the surface region based on the ! new mixed layer depth and the previous thickness of the ! neighboring water columns [Z ~> m]. - h_sum, & ! The total thickness of the water column, in H ~> m or kg m-2. - hmbl_prev ! The previous thickness of the mixed and buffer layers, in H ~> m or kg m-2. + h_sum, & ! The total thickness of the water column [H ~> m or kg m-2]. + hmbl_prev ! The previous thickness of the mixed and buffer layers [H ~> m or kg m-2]. real, dimension(SZI_(G)) :: & Hsfc, & ! The thickness of the surface region (mixed and buffer - ! layers before detrainment in to the interior, in H ~> m or kg m-2. + ! layers before detrainment in to the interior [H ~> m or kg m-2]. max_BL_det ! If non-negative, the maximum amount of entrainment from - ! the buffer layers that will be allowed this time step, in H ~> m or kg m-2. + ! the buffer layers that will be allowed this time step [H ~> m or kg m-2]. real :: dHsfc, dHD ! Local copies of nondimensional parameters. - real :: H_nbr ! A minimum thickness based on neighboring thicknesses, in H ~> m or kg m-2. + real :: H_nbr ! A minimum thickness based on neighboring thicknesses [H ~> m or kg m-2]. real :: absf_x_H ! The absolute value of f times the mixed layer thickness [Z s-1 ~> m s-1]. real :: kU_star ! Ustar times the Von Karmen constant [Z s-1 ~> m s-1]. @@ -521,8 +521,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! The surface forcing is contained in the fluxes type. ! We aggregate the thermodynamic forcing for a time step into the following: - ! netMassInOut = water (H ~> m or kg m-2) added/removed via surface fluxes - ! netMassOut = water (H ~> m or kg m-2) removed via evaporating surface fluxes + ! netMassInOut = water [H ~> m or kg m-2] added/removed via surface fluxes + ! netMassOut = water [H ~> m or kg m-2] removed via evaporating surface fluxes ! net_heat = heat (degC * H) via surface fluxes ! net_salt = salt ( g(salt)/m2 for non-Bouss and ppt*m/s for Bouss ) via surface fluxes ! Pen_SW_bnd = components to penetrative shortwave radiation @@ -799,7 +799,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & dKE_CA, cTKE, j, G, GV, CS, nz_conv) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness, in H ~> m or kg m-2. + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. !! The units of h are referred to as H below. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocities interpolated to h !! points, m s-1. @@ -812,11 +812,11 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: Rcv !< The coordinate defining potential !! density, in kg m-3. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_eb !< The downward increase across a layer - !! in the entrainment from below, in H ~> m or kg m-2. + !! in the entrainment from below [H ~> m or kg m-2]. !! Positive values go with mass gain by !! a layer. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: eps !< The negligibly small amount of water - !! that will be left in each layer, in H ~> m or kg m-2. + !! that will be left in each layer [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)), intent(out) :: dKE_CA !< The vertically integrated change in !! kinetic energy due to convective !! adjustment [Z m2 s-2 ~> m3 s-2]. @@ -836,22 +836,22 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & ! Local variables real, dimension(SZI_(G)) :: & htot, & ! The total depth of the layers being considered for - ! entrainment, in H ~> m or kg m-2. + ! entrainment [H ~> m or kg m-2]. R0_tot, & ! The integrated potential density referenced to the surface - ! of the layers which are fully entrained, in H kg m-3 ~> kg m-2 or kg2 m-5. + ! of the layers which are fully entrained [H kg m-3 ~> kg m-2 or kg2 m-5]. Rcv_tot, & ! The integrated coordinate value potential density of the - ! layers that are fully entrained, in H kg m-3 ~> kg m-2 or kg2 m-5. + ! layers that are fully entrained [H kg m-3 ~> kg m-2 or kg2 m-5]. Ttot, & ! The integrated temperature of layers which are fully - ! entrained, in H K ~> m K or kg m-2 K. - Stot, & ! The integrated salt of layers which are fully entrained, - ! in H PSU ~> m PSU or PSU kg m-2. + ! entrained [degC H ~> degC m or degC kg m-2]. + Stot, & ! The integrated salt of layers which are fully entrained + ! [H PSU ~> m PSU or PSU kg m-2]. uhtot, & ! The depth integrated zonal and meridional velocities in - vhtot, & ! the mixed layer, in H m s-1 ~> m2 s-1 or kg m-1 s-1. + vhtot, & ! the mixed layer [H m s-1 ~> m2 s-1 or kg m-1 s-1]. KE_orig, & ! The total mean kinetic energy in the mixed layer before ! convection, H m2 s-2. - h_orig_k1 ! The depth of layer k1 before convective adjustment, in H ~> m or kg m-2. - real :: h_ent ! The thickness from a layer that is entrained, in H ~> m or kg m-2. - real :: Ih ! The inverse of a thickness, in H-1 ~> m-1 or m2 kg-1. + h_orig_k1 ! The depth of layer k1 before convective adjustment [H ~> m or kg m-2]. + real :: h_ent ! The thickness from a layer that is entrained [H ~> m or kg m-2]. + real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of ! the conversion from H to Z divided by the mean density, ! in m7 s-2 Z-1 H-2 kg-1. !### CHECK UNITS @@ -936,25 +936,25 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK_(GV)), & - intent(inout) :: h !< Layer thickness, in H ~> m or kg m-2. + intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. !! The units of h are referred to as H below. real, dimension(SZI_(G),SZK_(GV)), & intent(inout) :: d_eb !< The downward increase across a layer in the - !! layer in the entrainment from below, in H ~> m or kg m-2. + !! layer in the entrainment from below [H ~> m or kg m-2]. !! Positive values go with mass gain by a layer. - real, dimension(SZI_(G)), intent(out) :: htot !< The accumulated mixed layer thickness, in H ~> m or kg m-2. - real, dimension(SZI_(G)), intent(out) :: Ttot !< The depth integrated mixed layer temperature, - !! in deg C H. - real, dimension(SZI_(G)), intent(out) :: Stot !< The depth integrated mixed layer salinity, - !! in psu H. + real, dimension(SZI_(G)), intent(out) :: htot !< The accumulated mixed layer thickness [H ~> m or kg m-2]. + real, dimension(SZI_(G)), intent(out) :: Ttot !< The depth integrated mixed layer temperature + !! [degC H ~> degC m or degC kg m-2]. + real, dimension(SZI_(G)), intent(out) :: Stot !< The depth integrated mixed layer salinity + !! [PSU H ~> PSU m or PSU kg m-2]. real, dimension(SZI_(G)), intent(out) :: uhtot !< The depth integrated mixed layer zonal !! velocity, H m s-1. real, dimension(SZI_(G)), intent(out) :: vhtot !< The integrated mixed layer meridional !! velocity, H m s-1. real, dimension(SZI_(G)), intent(out) :: R0_tot !< The integrated mixed layer potential density referenced - !! to 0 pressure, in H kg m-2 ~> kg m-1 or kg2 m-4. + !! to 0 pressure [H kg m-2 ~> kg m-1 or kg2 m-4]. real, dimension(SZI_(G)), intent(out) :: Rcv_tot !< The integrated mixed layer coordinate - !! variable potential density, in H kg m-2 ~> kg m-1 or kg2 m-4. + !! variable potential density [H kg m-2 ~> kg m-1 or kg2 m-4]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: u !< Zonal velocities interpolated to h points, m s-1. real, dimension(SZI_(G),SZK_(GV)), & @@ -971,7 +971,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! density, in kg m-3. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: eps !< The negligibly small amount of water - !! that will be left in each layer, in H ~> m or kg m-2. + !! that will be left in each layer [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of R0 with respect to !! temperature, in kg m-3 degC-1. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of Rcv with respect to @@ -982,14 +982,14 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! salinity, in kg m-3 psu-1. real, dimension(SZI_(G)), intent(in) :: netMassInOut !< The net mass flux (if non-Boussinesq) !! or volume flux (if Boussinesq) into the ocean - !! within a time step in H ~> m or kg m-2. (I.e. P+R-E.) + !! within a time step [H ~> m or kg m-2]. (I.e. P+R-E.) real, dimension(SZI_(G)), intent(in) :: netMassOut !< The mass or volume flux out of the ocean - !! within a time step in H ~> m or kg m-2. + !! within a time step [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: Net_heat !< The net heating at the surface over a !! time step in K H. Any penetrating shortwave !! radiation is not included in Net_heat. real, dimension(SZI_(G)), intent(in) :: Net_salt !< The net surface salt flux into the ocean - !! over a time step in psu H. + !! over a time step [PSU H ~> PSU m or PSU kg m-2]. integer, intent(in) :: nsw !< The number of bands of penetrating !! shortwave radiation. real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave @@ -997,7 +997,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! penetrating band, in K H, !! size nsw x SZI_(G). real, dimension(:,:,:), intent(in) :: opacity_band !< The opacity in each band of penetrating - !! shortwave radiation, in H-1 ~> m-1 or m2 kg-1. + !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. !! The indicies of opacity_band are band, i, k. real, dimension(SZI_(G)), intent(out) :: Conv_en !< The buoyant turbulent kinetic energy source !! due to free convection [Z m2 s-2 ~> m3 s-2]. @@ -1026,15 +1026,15 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! Local variables real, dimension(SZI_(G)) :: & - massOutRem, & ! Evaporation that remains to be supplied, in H ~> m or kg m-2. + massOutRem, & ! Evaporation that remains to be supplied [H ~> m or kg m-2]. netMassIn ! mass entering through ocean surface (H) real :: SW_trans ! The fraction of shortwave radiation ! that is not absorbed in a layer, ND. real :: Pen_absorbed ! The amount of penetrative shortwave radiation ! that is absorbed in a layer, in units of K H. real :: h_avail ! The thickness in a layer available for - ! entrainment, in H ~> m or kg m-2. - real :: h_ent ! The thickness from a layer that is entrained, in H ~> m or kg m-2. + ! entrainment [H ~> m or kg m-2]. + real :: h_ent ! The thickness from a layer that is entrained [H ~> m or kg m-2]. real :: T_precip ! The temperature of the precipitation, in deg C. real :: C1_3, C1_6 ! 1/3 and 1/6. real :: En_fn, Frac, x1 ! Nondimensional temporary variables. @@ -1042,14 +1042,14 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: dr_ent, dr_comp ! Temporary variables with units of kg m-3 H. real :: dr_dh ! The partial derivative of dr_ent with h_ent, in kg m-3. real :: h_min, h_max ! The minimum, maximum, and previous estimates for - real :: h_prev ! h_ent, in H ~> m or kg m-2. - real :: h_evap ! The thickness that is evaporated, in H ~> m or kg m-2. + real :: h_prev ! h_ent [H ~> m or kg m-2]. + real :: h_evap ! The thickness that is evaporated [H ~> m or kg m-2]. real :: dh_Newt ! The Newton's method estimate of the change in - ! h_ent between iterations, in H ~> m or kg m-2. + ! h_ent between iterations [H ~> m or kg m-2]. real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of ! the conversion from H to Z divided by the mean density, ! in m7 s-2 Z-1 H-2 kg-1. !### CHECK UNITS - real :: Angstrom ! The minimum layer thickness, in H ~> m or kg m-2. + real :: Angstrom ! The minimum layer thickness [H ~> m or kg m-2]. real :: opacity ! The opacity converted to units of H-1. real :: sum_Pen_En ! The potential energy change due to penetrating ! shortwave radiation, integrated over a layer, in @@ -1304,10 +1304,10 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G)), intent(in) :: htot !< The accumlated mixed layer thickness, in H ~> m or kg m-2 + real, dimension(SZI_(G)), intent(in) :: htot !< The accumlated mixed layer thickness [H ~> m or kg m-2] !! (often m or kg m-2). real, dimension(SZI_(G)), intent(in) :: h_CA !< The mixed layer depth after convective - !! adjustment, in H ~> m or kg m-2. + !! adjustment [H ~> m or kg m-2]. type(forcing), intent(in) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields !! have NULL ptrs. @@ -1327,7 +1327,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, real, dimension(SZI_(G)), intent(out) :: TKE !< The turbulent kinetic energy available for !! mixing over a time step [Z m2 s-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(out) :: Idecay_len_TKE !< The inverse of the vertical decay - !! scale for TKE, in H-1 ~> m-1 or m2 kg-1. + !! scale for TKE [H-1 ~> m-1 or m2 kg-1]. real, dimension(SZI_(G)), intent(in) :: TKE_river !< The turbulent kinetic energy available !! for driving mixing at river mouths !! integrated over a time step [Z m2 s-2 ~> m3 s-2]. @@ -1356,7 +1356,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, real :: MKE_rate_CA ! MKE_rate for convective adjustment, ND, 0 to 1. real :: MKE_rate_FC ! MKE_rate for free convection, ND, 0 to 1. real :: totEn_Z ! The total potential energy released by convection, Z3 s-2. - real :: Ih ! The inverse of a thickness, in H-1 ~> m-1 or m2 kg-1. + real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. real :: exp_kh ! The nondimensional decay of TKE across a layer, ND. real :: absf ! The absolute value of f averaged to thickness points, s-1. real :: U_star ! The friction velocity [Z s-1 ~> m s-1]. @@ -1496,21 +1496,21 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! The units of h are referred to as H below. real, dimension(SZI_(G),SZK_(GV)), & intent(inout) :: d_eb !< The downward increase across a layer in the - !! layer in the entrainment from below, in H ~> m or kg m-2. + !! layer in the entrainment from below [H ~> m or kg m-2]. !! Positive values go with mass gain by a layer. - real, dimension(SZI_(G)), intent(inout) :: htot !< The accumlated mixed layer thickness, in H ~> m or kg m-2. - real, dimension(SZI_(G)), intent(inout) :: Ttot !< The depth integrated mixed layer temperature, - !! in deg C H. - real, dimension(SZI_(G)), intent(inout) :: Stot !< The depth integrated mixed layer salinity, - !! in psu H. + real, dimension(SZI_(G)), intent(inout) :: htot !< The accumlated mixed layer thickness [H ~> m or kg m-2]. + real, dimension(SZI_(G)), intent(inout) :: Ttot !< The depth integrated mixed layer temperature + !! [degC H ~> degC m or degC kg m-2]. + real, dimension(SZI_(G)), intent(inout) :: Stot !< The depth integrated mixed layer salinity + !! [PSU H ~> PSU m or PSU kg m-2]. real, dimension(SZI_(G)), intent(inout) :: uhtot !< The depth integrated mixed layer zonal !! velocity, H m s-1. real, dimension(SZI_(G)), intent(inout) :: vhtot !< The integrated mixed layer meridional !! velocity, H m s-1. real, dimension(SZI_(G)), intent(inout) :: R0_tot !< The integrated mixed layer potential density - !! referenced to 0 pressure, in H kg m-3 ~> kg m-2 or kg2 m-5. + !! referenced to 0 pressure [H kg m-3 ~> kg m-2 or kg2 m-5]. real, dimension(SZI_(G)), intent(inout) :: Rcv_tot !< The integrated mixed layer coordinate variable - !! potential density, in H kg m-3 ~> kg m-2 or kg2 m-5. + !! potential density [H kg m-3 ~> kg m-2 or kg2 m-5]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: u !< Zonal velocities interpolated to h points, m s-1. real, dimension(SZI_(G),SZK_(GV)), & @@ -1527,7 +1527,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! density, in kg m-3. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: eps !< The negligibly small amount of water - !! that will be left in each layer, in H ~> m or kg m-2. + !! that will be left in each layer [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of R0 with respect to !! temperature, in kg m-3 degC-1. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of Rcv with respect to @@ -1543,12 +1543,12 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! penetrating band, in K H, !! size nsw x SZI_(G). real, dimension(:,:,:), intent(in) :: opacity_band !< The opacity in each band of penetrating - !! shortwave radiation, in H-1 ~> m-1 or m2 kg-1. + !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. !! The indicies of opacity_band are band, i, k. real, dimension(SZI_(G)), intent(inout) :: TKE !< The turbulent kinetic energy !! available for mixing over a time !! step [Z m2 s-2 ~> m3 s-2]. - real, dimension(SZI_(G)), intent(inout) :: Idecay_len_TKE !< The vertical TKE decay rate, in H-1 ~> m-1 or m2 kg-1. + real, dimension(SZI_(G)), intent(inout) :: Idecay_len_TKE !< The vertical TKE decay rate [H-1 ~> m-1 or m2 kg-1]. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & intent(in) :: ksort !< The density-sorted k-indicies. @@ -1561,11 +1561,11 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! absorbed in a layer, nondimensional. real :: Pen_absorbed ! The amount of penetrative shortwave radiation ! that is absorbed in a layer, in units of K m. - real :: h_avail ! The thickness in a layer available for entrainment in H ~> m or kg m-2. - real :: h_ent ! The thickness from a layer that is entrained, in H ~> m or kg m-2. - real :: h_min, h_max ! Limits on the solution for h_ent, in H ~> m or kg m-2. + real :: h_avail ! The thickness in a layer available for entrainment [H ~> m or kg m-2]. + real :: h_ent ! The thickness from a layer that is entrained [H ~> m or kg m-2]. + real :: h_min, h_max ! Limits on the solution for h_ent [H ~> m or kg m-2]. real :: dh_Newt ! The Newton's method estimate of the change in - ! h_ent between iterations, in H ~> m or kg m-2. + ! h_ent between iterations [H ~> m or kg m-2]. real :: MKE_rate ! The fraction of the energy in resolved shears ! within the mixed layer that will be eliminated ! within a timestep, nondim, 0 to 1. @@ -1588,10 +1588,10 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: dTKE_dh ! The partial derivative of TKE with h_ent [Z m2 s-2 H-1 ~> m2 s-2 or m5 s-2 kg-1]. real :: Pen_dTKE_dh_Contrib ! The penetrating shortwave contribution to ! dTKE_dh, in m2 s-2. - real :: EF4_val ! The result of EF4() (see later), in H-1 ~> m-1 or m2 kg-1. + real :: EF4_val ! The result of EF4() (see later) [H-1 ~> m-1 or m2 kg-1]. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. - real :: dEF4_dh ! The partial derivative of EF4 with h, in H-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. + real :: dEF4_dh ! The partial derivative of EF4 with h [H-2 ~> m-2 or m4 kg-2]. real :: Pen_En1 ! A nondimensional temporary variable. real :: kh, exp_kh ! Nondimensional temporary variables related to the real :: f1_kh ! fractional decay of TKE across a layer. @@ -1599,8 +1599,8 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: f1_x1, f2_x1 ! the relative decay of TKE and SW radiation across real :: f3_x1 ! a layer, and exponential-related functions of x1. real :: E_HxHpE ! Entrainment divided by the product of the new and old - ! thicknesses, in H-1 ~> m-1 or m2 kg-1. - real :: Hmix_min ! The minimum mixed layer depth in H ~> m or kg m-2. + ! thicknesses [H-1 ~> m-1 or m2 kg-1]. + real :: Hmix_min ! The minimum mixed layer depth [H ~> m or kg m-2]. real :: opacity real :: C1_3, C1_6, C1_24 ! 1/3, 1/6, and 1/24. integer :: is, ie, nz, i, k, ks, itt, n @@ -1837,7 +1837,7 @@ subroutine sort_ML(h, R0, eps, G, GV, CS, ksort) real, dimension(SZI_(G),SZK_(GV)), intent(in) :: R0 !< The potential density used to sort !! the layers, in kg m-3. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: eps !< The (small) thickness that must - !! remain in each layer, in H ~> m or kg m-2. + !! remain in each layer [H ~> m or kg m-2]. type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a !! previous call to mixedlayer_init. integer, dimension(SZI_(G),SZK_(GV)), intent(out) :: ksort !< The k-index to use in the sort. @@ -1848,7 +1848,7 @@ subroutine sort_ML(h, R0, eps, G, GV, CS, ksort) ! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out) The units ! of h are referred to as H below. ! (in) R0 - The potential density used to sort the layers, in kg m-3. -! (in) eps - The (small) thickness that must remain in each layer, in H ~> m or kg m-2. +! (in) eps - The (small) thickness that must remain in each layer [H ~> m or kg m-2]. ! (in) tv - A structure containing pointers to any available ! thermodynamic fields. Absent fields have NULL ptrs. ! (in) j - The meridional row to work on. @@ -1913,7 +1913,7 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS real, dimension(SZK_(GV)), intent(in) :: RcvTgt !< The target value of Rcv for each !! layer, in kg m-3. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: eps !< The (small) thickness that must - !! remain in each layer, in H ~> m or kg m-2. + !! remain in each layer [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea !< The upward increase across a !! layer in the entrainment from !! above, in m or kg m-2 (H). @@ -1921,7 +1921,7 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS !! thickness increases. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_eb !< The downward increase across a !! layer in the entrainment from - !! below, in H ~> m or kg m-2. Positive values go + !! below [H ~> m or kg m-2]. Positive values go !! with mass gain by a layer. integer, dimension(SZI_(G),SZK_(GV)), intent(in) :: ksort !< The density-sorted k-indicies. type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this @@ -1954,12 +1954,12 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS ! (in/out) R0 - Potential density referenced to surface pressure, in kg m-3. ! (in/out) Rcv - The coordinate defining potential density, in kg m-3. ! (in) RcvTgt - The target value of Rcv for each layer, in kg m-3. -! (in) eps - The (small) thickness that must remain in each layer, in H ~> m or kg m-2. +! (in) eps - The (small) thickness that must remain in each layer [H ~> m or kg m-2]. ! (in/out) d_ea - The upward increase across a layer in the entrainment from ! above, in m or kg m-2 (H). Positive d_ea goes with layer ! thickness increases. ! (in/out) d_eb - The downward increase across a layer in the entrainment from -! below, in H ~> m or kg m-2. Positive values go with mass gain by a layer. +! below [H ~> m or kg m-2]. Positive values go with mass gain by a layer. ! (in) ksort - The density-sorted k-indicies. ! (in) G - The ocean's grid structure. ! (in) GV - The ocean's vertical grid structure. @@ -2290,7 +2290,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, !! with salinity, in kg m-3 psu-1. real, dimension(SZI_(G)), intent(in) :: max_BL_det !< If non-negative, the maximum !! detrainment permitted from the buffer - !! layers, in H ~> m or kg m-2. + !! layers [H ~> m or kg m-2]. ! This subroutine moves any water left in the former mixed layers into the ! two buffer layers and may also move buffer layer water into the interior @@ -2298,35 +2298,39 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! Local variables real :: h_to_bl ! The total thickness detrained to the buffer - ! layers, in H ~> m or kg m-2. - real :: R0_to_bl, Rcv_to_bl ! The depth integrated amount of R0, Rcv, T - real :: T_to_bl, S_to_bl ! and S that is detrained to the buffer layer, - ! in H kg m-3, H kg m-3, K H, and psu H. - - real :: h_min_bl ! The minimum buffer layer thickness, in H ~> m or kg m-2. + ! layers [H ~> m or kg m-2]. + real :: R0_to_bl ! The depth integrated amount of R0 that is detrained to the + ! buffer layer [H kg m-3 ~> kg m-2 or kg2 m-5] + real :: Rcv_to_bl ! The depth integrated amount of Rcv that is detrained to the + ! buffer layer [H kg m-3 ~> kg m-2 or kg2 m-5] + real :: T_to_bl ! The depth integrated amount of T that is detrained to the + ! buffer layer [degC H ~> degC m or degC kg m-2] + real :: S_to_bl ! The depth integrated amount of S that is detrained to the + ! buffer layer [PSU H ~> PSU m or PSU kg m-2] + real :: h_min_bl ! The minimum buffer layer thickness [H ~> m or kg m-2]. real :: h_min_bl_thick ! The minimum buffer layer thickness when the - ! mixed layer is very large, in H ~> m or kg m-2. + ! mixed layer is very large [H ~> m or kg m-2]. real :: h_min_bl_frac_ml = 0.05 ! The minimum buffer layer thickness relative ! to the total mixed layer thickness for thin ! mixed layers, nondim., maybe 0.1/CS%nkbl. real :: h1, h2 ! Scalar variables holding the values of - ! h(i,CS%nkml+1) and h(i,CS%nkml+2), in H ~> m or kg m-2. + ! h(i,CS%nkml+1) and h(i,CS%nkml+2) [H ~> m or kg m-2]. real :: h1_avail ! The thickness of the upper buffer layer ! available to move into the lower buffer - ! layer, in H ~> m or kg m-2. + ! layer [H ~> m or kg m-2]. real :: stays ! stays is the thickness of the upper buffer - ! layer that remains there, in H ~> m or kg m-2. + ! layer that remains there [H ~> m or kg m-2]. real :: stays_min, stays_max ! The minimum and maximum permitted values of - ! stays, in H ~> m or kg m-2. + ! stays [H ~> m or kg m-2]. logical :: mergeable_bl ! If true, it is an option to combine the two ! buffer layers and create water that matches ! the target density of an interior layer. real :: stays_merge ! If the two buffer layers can be combined ! stays_merge is the thickness of the upper - ! layer that remains, in H ~> m or kg m-2. - real :: stays_min_merge ! The minimum allowed value of stays_merge in H ~> m or kg m-2. + ! layer that remains [H ~> m or kg m-2]. + real :: stays_min_merge ! The minimum allowed value of stays_merge [H ~> m or kg m-2]. real :: dR0_2dz, dRcv_2dz ! Half the vertical gradients of R0, Rcv, T, and ! real :: dT_2dz, dS_2dz ! S, in kg m-4, kg m-4, K m-1, and psu m-1. @@ -2336,18 +2340,18 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: dPE_extrap ! The potential energy change due to dispersive ! advection or mixing layers, divided by - ! rho_0*g, in H2 ~> m2 or kg2 m-4. + ! rho_0*g [H2 ~> m2 or kg2 m-4]. real :: dPE_det, dPE_merge ! The energy required to mix the detrained water ! into the buffer layer or the merge the two ! buffer layers, both in units of J H2 Z m-5. real :: h_from_ml ! The amount of additional water that must be - ! drawn from the mixed layer, in H ~> m or kg m-2. + ! drawn from the mixed layer [H ~> m or kg m-2]. real :: h_det_h2 ! The amount of detrained water and mixed layer ! water that will go directly into the lower - ! buffer layer, in H ~> m or kg m-2. + ! buffer layer [H ~> m or kg m-2]. real :: h_det_to_h2, h_ml_to_h2 ! All of the variables hA_to_hB are the thickness fluxes - real :: h_det_to_h1, h_ml_to_h1 ! from one layer to another, in H ~> m or kg m-2, + real :: h_det_to_h1, h_ml_to_h1 ! from one layer to another [H ~> m or kg m-2], real :: h1_to_h2, h1_to_k0 ! with h_det the detrained water, h_ml real :: h2_to_k1, h2_to_k1_rem ! the actively mixed layer, h1 and h2 the upper ! and lower buffer layers, and k0 and k1 the @@ -2381,15 +2385,15 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! K psu-1 and psu K-1. real :: I_denom ! A work variable with units of psu2 m6 kg-2. - real :: G_2 ! 1/2 G_Earth, in m2 Z-1 s-2 ~> m s-2. - real :: Rho0xG ! Rho0 times G_Earth, in kg m-1 Z-1 s-2 ~> kg m-2 s-2. + real :: G_2 ! 1/2 G_Earth [m2 Z-1 s-2 ~> m s-2]. + real :: Rho0xG ! Rho0 times G_Earth [kg m-1 Z-1 s-2 ~> kg m-2 s-2]. real :: I2Rho0 ! 1 / (2 Rho0), in m3 kg-1. real :: Idt_H2 ! The square of the conversion from thickness to Z ! divided by the time step [Z2 H-2 s-1 ~> s-1 or m6 kg-2 s-1]. logical :: stable_Rcv ! If true, the buffer layers are stable with ! respect to the coordinate potential density. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: s1en ! A work variable with units of H2 kg m s-3. real :: s1, s2, bh0 ! Work variables with units of H. @@ -2400,7 +2404,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: dR1, dR2, dR2b, dRk1 ! Assorted density difference work variables, real :: dR0, dR21, dRcv ! all with units of kg m-3. real :: dRcv_stays, dRcv_det, dRcv_lim - real :: Angstrom ! The minumum layer thickness, in H ~> m or kg m-2. + real :: Angstrom ! The minumum layer thickness [H ~> m or kg m-2]. real :: h2_to_k1_lim, T_new, S_new, T_max, T_min, S_max, S_min character(len=200) :: mesg @@ -3170,7 +3174,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e !! kg m-2 (H). Positive d_ea goes with !! layer thickness increases. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_eb !< The downward increase across a layer - !! in the entrainment from below, in H ~> m or kg m-2. + !! in the entrainment from below [H ~> m or kg m-2]. !! Positive values go with mass gain by !! a layer. integer, intent(in) :: j !< The meridional row to work on. @@ -3185,7 +3189,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e !! with salinity, in kg m-3 psu-1. real, dimension(SZI_(G)), intent(in) :: max_BL_det !< If non-negative, the maximum !! detrainment permitted from the buffer - !! layers, in H ~> m or kg m-2. + !! layers [H ~> m or kg m-2]. ! This subroutine moves any water left in the former mixed layers into the ! single buffer layers and may also move buffer layer water into the interior @@ -3203,24 +3207,24 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e ! above, in m or kg m-2 (H). Positive d_ea goes with layer ! thickness increases. ! (in/out) d_eb - The downward increase across a layer in the entrainment from -! below, in H ~> m or kg m-2. Positive values go with mass gain by a layer. +! below [H ~> m or kg m-2]. Positive values go with mass gain by a layer. ! (in) j - The meridional row to work on. ! (in) G - The ocean's grid structure. ! (in) GV - The ocean's vertical grid structure. ! (in) CS - The control structure returned by a previous call to ! mixedlayer_init. ! (in) max_BL_det - If non-negative, the maximum detrainment permitted -! from the buffer layers, in H ~> m or kg m-2. +! from the buffer layers [H ~> m or kg m-2]. ! (in/out) dRcv_dT - The partial derivative of coordinate defining potential ! density with potential temperature, in kg m-3 K-1. ! (in/out) dRcv_dS - The partial derivative of coordinate defining potential ! density with salinity, in kg m-3 psu-1. - real :: Ih ! The inverse of a thickness, in H-1 ~> m-1 or m2 kg-1. + real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. real :: h_ent ! The thickness from a layer that is - ! entrained, in H ~> m or kg m-2. - real :: max_det_rem(SZI_(G)) ! Remaining permitted detrainment, in H ~> m or kg m-2. + ! entrained [H ~> m or kg m-2]. + real :: max_det_rem(SZI_(G)) ! Remaining permitted detrainment [H ~> m or kg m-2]. real :: detrain(SZI_(G)) ! The thickness of fluid to detrain - ! from the mixed layer, in H ~> m or kg m-2. + ! from the mixed layer [H ~> m or kg m-2]. real :: Idt ! The inverse of the timestep in s-1. real :: dT_dR, dS_dR, dRml, dR0_dRcv, dT_dS_wt2 real :: I_denom ! A work variable with units of psu2 m6 kg-2. @@ -3740,16 +3744,16 @@ end subroutine bulkmixedlayer_init !! and +25% at x~3.5, but the exponential deemphasizes the importance of !! large x. When L=0, EF4 returns E/((Ht+E)*Ht). function EF4(Ht, En, I_L, dR_de) - real, intent(in) :: Ht !< Total thickness, in H ~>m or kg m-2. - real, intent(in) :: En !< Entrainment, in H ~> m or kg m-2. - real, intent(in) :: I_L !< The e-folding scale in H-1 ~> m-1 or m2 kg-1 - real, optional, intent(inout) :: dR_de !< The partial derivative of the result R with E, in H-2. - real :: EF4 !< The integral, in H-1 ~> m-1 or m2 kg-1. + real, intent(in) :: Ht !< Total thickness [H ~> m or kg m-2]. + real, intent(in) :: En !< Entrainment [H ~> m or kg m-2]. + real, intent(in) :: I_L !< The e-folding scale [H-1 ~> m-1 or m2 kg-1] + real, optional, intent(inout) :: dR_de !< The partial derivative of the result R with E [H-2 ~> m-2 or m4 kg-2]. + real :: EF4 !< The integral [H-1 ~> m-1 or m2 kg-1]. ! Local variables real :: exp_LHpE ! A nondimensional exponential decay. - real :: I_HpE ! An inverse thickness plus entrainment, in H-1 ~> m-1 or m2 kg-1. - real :: Res ! The result of the integral above, in H-1 ~> m-1 or m2 kg-1. + real :: I_HpE ! An inverse thickness plus entrainment [H-1 ~> m-1 or m2 kg-1]. + real :: Res ! The result of the integral above [H-1 ~> m-1 or m2 kg-1]. exp_LHpE = exp(-I_L*(En+Ht)) I_HpE = 1.0/(Ht+En) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index b3030bb28a..5601597a22 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -87,7 +87,7 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf, halo) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any available !! thermodynamic fields. type(diabatic_aux_CS), intent(in) :: CS !< The control structure returned by a previous @@ -220,7 +220,7 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any !! available thermodynamic fields. type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom @@ -229,20 +229,20 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) ! local variables real, dimension(SZI_(G)) :: & - b1_T, b1_S, & ! Variables used by the tridiagonal solvers of T & S, in H ~> m or kg m-2. + b1_T, b1_S, & ! Variables used by the tridiagonal solvers of T & S [H ~> m or kg m-2]. d1_T, d1_S ! Variables used by the tridiagonal solvers, nondim. real, dimension(SZI_(G),SZK_(G)) :: & - c1_T, c1_S ! Variables used by the tridiagonal solvers, in H ~> m or kg m-2. + c1_T, c1_S ! Variables used by the tridiagonal solvers [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(G)+1) :: & - mix_T, mix_S ! Mixing distances in both directions across each interface, in H ~> m or kg m-2. + mix_T, mix_S ! Mixing distances in both directions across each interface [H ~> m or kg m-2]. real :: h_tr ! h_tr is h at tracer points with a tiny thickness - ! added to ensure positive definiteness, in H ~> m or kg m-2. + ! added to ensure positive definiteness [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: I_h_int ! The inverse of the thickness associated with an - ! interface, in H-1 ~> m-1 or m2 kg-1. + ! interface [H-1 ~> m-1 or m2 kg-1]. real :: b_denom_T ! The first term in the denominators for the expressions - real :: b_denom_S ! for b1_T and b1_S, both in H ~> m or kg m-2. + real :: b_denom_S ! for b1_T and b1_S, both [H ~> m or kg m-2]. real, dimension(:,:,:), pointer :: T=>NULL(), S=>NULL() real, dimension(:,:,:), pointer :: Kd_T=>NULL(), Kd_S=>NULL() ! Diffusivities [Z2 s-1 ~> m2 s-1]. integer :: i, j, k, is, ie, js, je, nz @@ -323,7 +323,7 @@ subroutine adjust_salt(h, tv, G, GV, CS, halo) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any !! available thermodynamic fields. type(diabatic_aux_CS), intent(in) :: CS !< The control structure returned by a previous @@ -386,7 +386,7 @@ subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any !! available thermodynamic fields type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes @@ -510,11 +510,11 @@ subroutine triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, T, S) integer, intent(in) :: js !< The start j-index to work on. integer, intent(in) :: je !< The end j-index to work on. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: hold !< The layer thicknesses before entrainment, - !! in H ~> m or kg m-2. + !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: ea !< The amount of fluid entrained from the layer - !! above within this time step, in H ~> m or kg m-2. + !! above within this time step [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: eb !< The amount of fluid entrained from the layer - !! below within this time step, in H ~> m or kg m-2. + !! below within this time step [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: T !< Layer potential temperatures, in degC. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: S !< Layer salinities, in PSU. @@ -559,18 +559,18 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: u_h !< Zonal velocity interpolated to h points, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: v_h !< Meridional velocity interpolated to h points, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: ea !< The amount of fluid entrained from the layer - !! above within this time step, in H ~> m or kg m-2. + !! above within this time step [H ~> m or kg m-2]. !! Omitting ea is the same as setting it to 0. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: eb !< The amount of fluid entrained from the layer - !! below within this time step, in H ~> m or kg m-2. + !! below within this time step [H ~> m or kg m-2]. !! Omitting eb is the same as setting it to 0. ! local variables @@ -658,7 +658,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: id_MLD !< Handle (ID) of MLD diagnostic real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thickness, in H ~> m or kg m-2 + intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any !! available thermodynamic fields. real, intent(in) :: densityDiff !< Density difference to determine MLD (kg/m3) @@ -781,7 +781,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & type(forcing), intent(inout) :: fluxes !< Surface fluxes container type(optics_type), pointer :: optics !< Optical properties container real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thickness in H ~> m or kg m-2 + intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any !! available thermodynamic fields. logical, intent(in) :: aggregate_FW_forcing !< If False, treat in/out fluxes separately. @@ -812,9 +812,9 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & d_pres, & ! pressure change across a layer (Pa) p_lay, & ! average pressure in a layer (Pa) pres, & ! pressure at an interface (Pa) - netMassInOut, & ! surface water fluxes (H ~> m or kg m-2) over time step - netMassIn, & ! mass entering ocean surface (H ~> m or kg m-2) over a time step - netMassOut, & ! mass leaving ocean surface (H ~> m or kg m-2) over a time step + netMassInOut, & ! surface water fluxes [H ~> m or kg m-2] over time step + netMassIn, & ! mass entering ocean surface [H ~> m or kg m-2] over a time step + netMassOut, & ! mass leaving ocean surface [H ~> m or kg m-2] over a time step netHeat, & ! heat (degC * H) via surface fluxes, excluding ! Pen_SW_bnd and netMassOut netSalt, & ! surface salt flux ( g(salt)/m2 for non-Bouss and ppt*H for Bouss ) @@ -928,10 +928,10 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & ! The surface forcing is contained in the fluxes type. ! We aggregate the thermodynamic forcing for a time step into the following: - ! netMassInOut = surface water fluxes (H ~> m or kg m-2) over time step + ! netMassInOut = surface water fluxes [H ~> m or kg m-2] over time step ! = lprec + fprec + vprec + evap + lrunoff + frunoff ! note that lprec generally has sea ice melt/form included. - ! netMassOut = net mass leaving ocean surface (H ~> m or kg m-2) over a time step. + ! netMassOut = net mass leaving ocean surface [H ~> m or kg m-2] over a time step. ! netMassOut < 0 means mass leaves ocean. ! netHeat = heat (degC * H) via surface fluxes, excluding the part ! contained in Pen_SW_bnd; and excluding heat_content of netMassOut < 0. diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index d24da9f883..609ee1743d 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -326,7 +326,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! These are targets so that the space can be shared with eaml & ebml. eatr, & ! The equivalent of ea and eb for tracers, which differ from ea and ebtr ! eb in that they tend to homogenize tracers in massless layers - ! near the boundaries in H ~> m or kg m-2 (for Bous or non-Bouss) + ! near the boundaries [H ~> m or kg m-2] (for Bous or non-Bouss) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & Kd_int, & ! diapycnal diffusivity of interfaces (m^2/s) @@ -341,7 +341,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! The following 5 variables are only used with a bulk mixed layer. real, pointer, dimension(:,:,:) :: & - eaml, & ! The equivalent of ea and eb due to mixed layer processes, in H ~> m or kg m-2 + eaml, & ! The equivalent of ea and eb due to mixed layer processes [H ~> m or kg m-2] ebml ! (m for Bouss and kg/m^2 for non-Bouss). These will be ! pointers to eatr and ebtr so as to reuse the memory as ! the arrays are not needed at the same time. @@ -373,7 +373,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real :: Tr_ea_BBL ! The diffusive tracer thickness in the BBL that is ! coupled to the bottom within a timestep (m) - real :: htot(SZIB_(G)) ! The summed thickness from the bottom, in H ~> m or kg m-2. + real :: htot(SZIB_(G)) ! The summed thickness from the bottom [H ~> m or kg m-2]. real :: b1(SZIB_(G)), d1(SZIB_(G)) ! b1, c1, and d1 are variables used by the real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index d7442297d5..e1e03ff39e 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -51,7 +51,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(G%isd:G%ied,G%jsd:G%jed,GV%ke), & - intent(in) :: h_3d !< Layer thickness before entrainment, in H ~> m or kg m-2. + intent(in) :: h_3d !< Layer thickness before entrainment [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. !! Absent fields have NULL ptrs. @@ -64,10 +64,10 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) ! Local variables real, dimension(GV%ke) :: & T0, S0, & ! T0 & S0 are columns of initial temperatures and salinities, in degC and g/kg. - h_col ! h_col is a column of thicknesses h at tracer points, in H ~> m or kg m-2. + h_col ! h_col is a column of thicknesses h at tracer points [H ~> m or kg m-2]. real, dimension(GV%ke+1) :: & Kd, & ! A column of diapycnal diffusivities at interfaces [Z2 s-1 ~> m2 s-1]. - h_top, h_bot ! Distances from the top or bottom, in H ~> m or kg m-2. + h_top, h_bot ! Distances from the top or bottom [H ~> m or kg m-2]. real :: ustar, absf, htot real :: energy_Kd ! The energy used by diapycnal mixing in W m-2. real :: tmp1 ! A temporary array. @@ -124,7 +124,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(GV%ke), intent(in) :: h_in !< Layer thickness before entrainment, - !! in H ~> m or kg m-2. + !! [H ~> m or kg m-2]. real, dimension(GV%ke), intent(in) :: T_in !< The layer temperatures, in degC. real, dimension(GV%ke), intent(in) :: S_in !< The layer salinities, in g kg-1. real, dimension(GV%ke+1), intent(in) :: Kd !< The interfaces diapycnal diffusivities @@ -186,10 +186,10 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ! of mixing with layers lower in the water column, in ! units of J m-2 K-1 and J m-2 ppt-1. hp_a, & ! An effective pivot thickness of the layer including the effects - ! of coupling with layers above, in H ~> m or kg m-2. This is the first term + ! of coupling with layers above [H ~> m or kg m-2]. This is the first term ! in the denominator of b1 in a downward-oriented tridiagonal solver. hp_b, & ! An effective pivot thickness of the layer including the effects - ! of coupling with layers below, in H ~> m or kg m-2. This is the first term + ! of coupling with layers below [H ~> m or kg m-2]. This is the first term ! in the denominator of b1 in an upward-oriented tridiagonal solver. c1_a, & ! c1_a is used by a downward-oriented tridiagonal solver, ND. c1_b, & ! c1_b is used by an upward-oriented tridiagonal solver, ND. @@ -199,16 +199,16 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & pres, & ! Interface pressures in Pa. pres_Z, & ! Interface pressures with a rescaling factor to convert interface height ! movements into changes in column potential energy, in J m-2 Z-1. - z_Int, & ! Interface heights relative to the surface, in H ~> m or kg m-2. + z_Int, & ! Interface heights relative to the surface [H ~> m or kg m-2]. N2, & ! An estimate of the buoyancy frequency in s-2. Kddt_h, & ! The diapycnal diffusivity times a timestep divided by the - ! average thicknesses around a layer, in H ~> m or kg m-2. + ! average thicknesses around a layer [H ~> m or kg m-2]. Kddt_h_a, & ! The value of Kddt_h for layers above the central point in the - ! tridiagonal solver, in H ~> m or kg m-2. + ! tridiagonal solver [H ~> m or kg m-2]. Kddt_h_b, & ! The value of Kddt_h for layers below the central point in the - ! tridiagonal solver, in H ~> m or kg m-2. + ! tridiagonal solver [H ~> m or kg m-2]. Kd_so_far ! The value of Kddt_h that has been applied already in - ! calculating the energy changes, in H ~> m or kg m-2. + ! calculating the energy changes [H ~> m or kg m-2]. real, dimension(GV%ke+1,4) :: & PE_chg_k, & ! The integrated potential energy change within a timestep due ! to the diffusivity at interface K for 4 different orders of @@ -216,18 +216,18 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ColHt_cor_k ! The correction to the potential energy change due to ! changes in the net column height, in J m-2. real :: & - b1 ! b1 is used by the tridiagonal solver, in H-1 ~> m-1 or m2 kg-1. + b1 ! b1 is used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. real :: & - I_b1 ! The inverse of b1, in H ~> m or kg m-2. - real :: Kd0 ! The value of Kddt_h that has already been applied, in H ~> m or kg m-2. - real :: dKd ! The change in the value of Kddt_h, in H ~> m or kg m-2. + I_b1 ! The inverse of b1 [H ~> m or kg m-2]. + real :: Kd0 ! The value of Kddt_h that has already been applied [H ~> m or kg m-2]. + real :: dKd ! The change in the value of Kddt_h [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: dTe_term ! A diffusivity-independent term related to the temperature ! change in the layer below the interface, in K H. real :: dSe_term ! A diffusivity-independent term related to the salinity ! change in the layer below the interface, in ppt H. - real :: Kddt_h_guess ! A guess of the final value of Kddt_h, in H ~> m or kg m-2. + real :: Kddt_h_guess ! A guess of the final value of Kddt_h [H ~> m or kg m-2]. real :: dMass ! The mass per unit area within a layer, in kg m-2. real :: dPres ! The hydrostatic pressure change across a layer, in Pa. real :: dMKE_max ! The maximum amount of mean kinetic energy that could be @@ -239,7 +239,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ! present interface, in J m-2. real :: ColHt_cor ! The correction to PE_chg that is made due to a net ! change in the column height, in J m-2. - real :: htot ! A running sum of thicknesses, in H ~> m or kg m-2. + real :: htot ! A running sum of thicknesses [H ~> m or kg m-2]. real :: dTe_t2, dT_km1_t2, dT_k_t2 ! Temporary arrays describing temperature changes. real :: dSe_t2, dS_km1_t2, dS_k_t2 ! Temporary arrays describing salinity changes. logical :: do_print @@ -971,18 +971,18 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & PE_chg, dPEc_dKd, dPE_max, dPEc_dKd_0, ColHt_cor) real, intent(in) :: Kddt_h0 !< The previously used diffusivity at an interface times !! the time step and divided by the average of the - !! thicknesses around the interface, in H ~> m or kg m-2. + !! thicknesses around the interface [H ~> m or kg m-2]. real, intent(in) :: dKddt_h !< The trial change in the diffusivity at an interface times !! the time step and divided by the average of the - !! thicknesses around the interface, in H ~> m or kg m-2. + !! thicknesses around the interface [H ~> m or kg m-2]. real, intent(in) :: hp_a !< The effective pivot thickness of the layer above the !! interface, given by h_k plus a term that !! is a fraction (determined from the tridiagonal solver) of - !! Kddt_h for the interface above, in H ~> m or kg m-2. + !! Kddt_h for the interface above [H ~> m or kg m-2]. real, intent(in) :: hp_b !< The effective pivot thickness of the layer below the !! interface, given by h_k plus a term that !! is a fraction (determined from the tridiagonal solver) of - !! Kddt_h for the interface above, in H ~> m or kg m-2. + !! Kddt_h for the interface above [H ~> m or kg m-2]. real, intent(in) :: Th_a !< An effective temperature times a thickness in the layer !! above, including implicit mixing effects with other !! yet higher layers, in K H. @@ -1043,10 +1043,10 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real, optional, intent(out) :: ColHt_cor !< The correction to PE_chg that is made due to a net !! change in the column height, in J m-2. - real :: hps ! The sum of the two effective pivot thicknesses, in H ~> m or kg m-2. - real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term, in H2 ~> m2 or k2 m-4. - real :: dT_c ! The core term in the expressions for the temperature changes, in K H2. - real :: dS_c ! The core term in the expressions for the salinity changes, in psu H2. + real :: hps ! The sum of the two effective pivot thicknesses [H ~> m or kg m-2]. + real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term [H2 ~> m2 or kg2 m-4]. + real :: dT_c ! The core term in the expressions for the temperature changes [K H2 ~> K m2 or K kg2 m-4]. + real :: dS_c ! The core term in the expressions for the salinity changes [psu H2 ~> psu m2 or psu kg2 m-4]. real :: PEc_core ! The diffusivity-independent core term in the expressions ! for the potential energy changes, J m-3. real :: ColHt_core ! The diffusivity-independent core term in the expressions @@ -1121,12 +1121,12 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & PE_chg, dPEc_dKd, dPE_max, dPEc_dKd_0) real, intent(in) :: Kddt_h !< The diffusivity at an interface times the time step and !! divided by the average of the thicknesses around the - !! interface, in H ~> m or kg m-2. - real, intent(in) :: h_k !< The thickness of the layer below the interface, in H ~> m or kg m-2. + !! interface [H ~> m or kg m-2]. + real, intent(in) :: h_k !< The thickness of the layer below the interface [H ~> m or kg m-2]. real, intent(in) :: b_den_1 !< The first term in the denominator of the pivot !! for the tridiagonal solver, given by h_k plus a term that !! is a fraction (determined from the tridiagonal solver) of - !! Kddt_h for the interface above, in H ~> m or kg m-2. + !! Kddt_h for the interface above [H ~> m or kg m-2]. real, intent(in) :: dTe_term !< A diffusivity-independent term related to the !! temperature change in the layer below the interface, in K H. real, intent(in) :: dSe_term !< A diffusivity-independent term related to the @@ -1190,14 +1190,14 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & ! this routine can also be used for an upward pass with the sense of direction ! reversed. - real :: b1 ! b1 is used by the tridiagonal solver, in H-1 ~> m-1 or m2 kg-1. + real :: b1 ! b1 is used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. real :: b1Kd ! Temporary array (nondim.) real :: ColHt_chg ! The change in column thickness in m. real :: dColHt_max ! The change in column thickness for infinite diffusivity, in m. real :: dColHt_dKd ! The partial derivative of column thickness with diffusivity, in s m-1. real :: dT_k, dT_km1 ! Temporary arrays in K. real :: dS_k, dS_km1 ! Temporary arrays in ppt. - real :: I_Kr_denom ! Temporary arrays in H-2 ~> m-2 or m4 kg-2. + real :: I_Kr_denom ! Temporary arrays [H-2 ~> m-2 or m4 kg-2]. real :: dKr_dKd ! Nondimensional temporary array. real :: ddT_k_dKd, ddT_km1_dKd ! Temporary arrays in K H-1. real :: ddS_k_dKd, ddS_km1_dKd ! Temporary arrays in ppt H-1. diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 2da2f97bbe..dfcb67be84 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -190,7 +190,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h_3d !< Layer thicknesses, in H ~> m or kg m-2. + intent(inout) :: h_3d !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u_3d !< Zonal velocities interpolated to h points, !! m s-1. @@ -264,7 +264,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Local variables real, dimension(SZI_(G),SZK_(GV)) :: & - h, & ! The layer thickness, in H ~> m or kg m-2. + h, & ! The layer thickness [H ~> m or kg m-2]. T, & ! The layer temperatures, in deg C. S, & ! The layer salinities, in psu. u, & ! The zonal velocity, in m s-1. @@ -282,14 +282,14 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS conv_PErel, & ! The potential energy that has been convectively released ! during this timestep, in J m-2 = kg s-2. A portion nstar_FC ! of conv_PErel is available to drive mixing. - htot, & ! The total depth of the layers above an interface, in H ~> m or kg m-2. + htot, & ! The total depth of the layers above an interface [H ~> m or kg m-2]. uhtot, & ! The depth integrated zonal and meridional velocities in the - vhtot, & ! layers above, in H m s-1 ~> m2 s-1 or kg m-1 s-1. + vhtot, & ! layers above [H m s-1 ~> m2 s-1 or kg m-1 s-1]. mech_TKE_top, & ! The value of mech_TKE at the top of the column, in J m-2. conv_PErel_top, & ! The value of conv_PErel at the top of the column, in J m-2. - Idecay_len_TKE, & ! The inverse of a turbulence decay length scale, in H-1 ~> m-1 or m2 kg-1. - h_sum, & ! The total thickness of the water column, in H ~> m or kg m-2. + Idecay_len_TKE, & ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. + h_sum, & ! The total thickness of the water column [H ~> m or kg m-2]. absf ! The absolute value of f, in s-1. @@ -321,17 +321,17 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! including implicit mixing effects with other yet lower layers, in K H. real, dimension(SZI_(G)) :: & hp_a ! An effective pivot thickness of the layer including the effects - ! of coupling with layers above, in H ~> m or kg m-2. This is the first term + ! of coupling with layers above [H ~> m or kg m-2]. This is the first term ! in the denominator of b1 in a downward-oriented tridiagonal solver. real, dimension(SZK_(GV)+1) :: & MixLen_shape, & ! A nondimensional shape factor for the mixing length that ! gives it an appropriate assymptotic value at the bottom of ! the boundary layer. Kddt_h ! The diapycnal diffusivity times a timestep divided by the - ! average thicknesses around a layer, in H ~> m or kg m-2. - real :: b1 ! b1 is inverse of the pivot used by the tridiagonal solver, in H-1 ~> m-1 or m2 kg-1. + ! average thicknesses around a layer [H ~> m or kg m-2]. + real :: b1 ! b1 is inverse of the pivot used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: dMass ! The mass per unit area within a layer, in kg m-2. real :: dPres ! The hydrostatic pressure change across a layer, in Pa. real :: dMKE_max ! The maximum amount of mean kinetic energy that could be @@ -340,18 +340,18 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! the water above the interface, in J m-2 = kg s-2. real :: MKE2_Hharm ! Twice the inverse of the harmonic mean of the thickness ! of a layer and the thickness of the water above, used in - ! the MKE conversion equation, in H-1 ~> m-1 or m2 kg-1. + ! the MKE conversion equation [H-1 ~> m-1 or m2 kg-1]. real :: dt_h ! The timestep divided by the averages of the thicknesses around - ! a layer, times a thickness conversion factor, in H s m-2 ~> s m-1 or kg s m-4. - real :: h_bot ! The distance from the bottom, in H ~> m or kg m-2. + ! a layer, times a thickness conversion factor [H s m-2 ~> s m-1 or kg s m-4]. + real :: h_bot ! The distance from the bottom [H ~> m or kg m-2]. real :: h_rsum ! The running sum of h from the top [Z ~> m]. - real :: I_hs ! The inverse of h_sum, in H-1 ~> m-1 or m2 kg-1. + real :: I_hs ! The inverse of h_sum [H-1 ~> m-1 or m2 kg-1]. real :: I_MLD ! The inverse of the current value of MLD [Z-1 ~> m-1]. real :: h_tt ! The distance from the surface or up to the next interface ! that did not exhibit turbulent mixing from this scheme plus - ! a surface mixing roughness length given by h_tt_min, in H ~> m or kg m-2. - real :: h_tt_min ! A surface roughness length, in H ~> m or kg m-2. + ! a surface mixing roughness length given by h_tt_min [H ~> m or kg m-2]. + real :: h_tt_min ! A surface roughness length [H ~> m or kg m-2]. real :: C1_3 ! = 1/3. real :: vonKar ! The vonKarman constant. @@ -387,7 +387,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 real :: dPEa_dKd_g0 real :: Kddt_h_g0 ! The first guess diapycnal diffusivity times a timestep divided - ! by the average thicknesses around a layer, in H ~> m or kg m-2. + ! by the average thicknesses around a layer [H ~> m or kg m-2]. real :: PE_chg_max ! The maximum PE change for very large values of Kddt_h(K). real :: dPEc_dKd_Kd0 ! The partial derivative of PE change with Kddt_h(K) ! for very small values of Kddt_h(K), in J m-2 H-1. @@ -398,11 +398,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! recent guess at Kddt_h(K), in J m-2. real :: dPEc_dKd ! The partial derivative of PE_chg with Kddt_h(K), in J m-2 H-1. real :: TKE_left_min, TKE_left_max, Kddt_h_max, Kddt_h_min - real :: Kddt_h_guess ! A guess at the value of Kddt_h(K), in H ~> m or kg m-2. - real :: Kddt_h_next ! The next guess at the value of Kddt_h(K), in H ~> m or kg m-2. - real :: dKddt_h ! The change between guesses at Kddt_h(K), in H ~> m or kg m-2. - real :: dKddt_h_Newt ! The change between guesses at Kddt_h(K) with Newton's method, in H ~> m or kg m-2. - real :: Kddt_h_newt ! The Newton's method next guess for Kddt_h(K), in H ~> m or kg m-2. + real :: Kddt_h_guess ! A guess at the value of Kddt_h(K) [H ~> m or kg m-2]. + real :: Kddt_h_next ! The next guess at the value of Kddt_h(K) [H ~> m or kg m-2]. + real :: dKddt_h ! The change between guesses at Kddt_h(K) [H ~> m or kg m-2]. + real :: dKddt_h_Newt ! The change between guesses at Kddt_h(K) with Newton's method [H ~> m or kg m-2]. + real :: Kddt_h_newt ! The Newton's method next guess for Kddt_h(K) [H ~> m or kg m-2]. real :: exp_kh ! The nondimensional decay of TKE across a layer, ND. logical :: use_Newt ! Use Newton's method for the next guess at Kddt_h(K). logical :: convectively_stable @@ -1557,18 +1557,18 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & PE_chg, dPEc_dKd, dPE_max, dPEc_dKd_0, ColHt_cor) real, intent(in) :: Kddt_h0 !< The previously used diffusivity at an interface times !! the time step and divided by the average of the - !! thicknesses around the interface, in H ~> m or kg m-2. + !! thicknesses around the interface [H ~> m or kg m-2]. real, intent(in) :: dKddt_h !< The trial change in the diffusivity at an interface times !! the time step and divided by the average of the - !! thicknesses around the interface, in H ~> m or kg m-2. + !! thicknesses around the interface [H ~> m or kg m-2]. real, intent(in) :: hp_a !< The effective pivot thickness of the layer above the !! interface, given by h_k plus a term that !! is a fraction (determined from the tridiagonal solver) of - !! Kddt_h for the interface above, in H ~> m or kg m-2. + !! Kddt_h for the interface above [H ~> m or kg m-2]. real, intent(in) :: hp_b !< The effective pivot thickness of the layer below the !! interface, given by h_k plus a term that !! is a fraction (determined from the tridiagonal solver) of - !! Kddt_h for the interface above, in H ~> m or kg m-2. + !! Kddt_h for the interface above [H ~> m or kg m-2]. real, intent(in) :: Th_a !< An effective temperature times a thickness in the layer !! above, including implicit mixing effects with other !! yet higher layers, in K H. @@ -1629,8 +1629,8 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real, optional, intent(out) :: ColHt_cor !< The correction to PE_chg that is made due to a net !! change in the column height, in J m-2. - real :: hps ! The sum of the two effective pivot thicknesses, in H ~> m or kg m-2. - real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term, in H2 ~> m2 or kg2 m-4. + real :: hps ! The sum of the two effective pivot thicknesses [H ~> m or kg m-2]. + real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term [H2 ~> m2 or kg2 m-4]. real :: dT_c ! The core term in the expressions for the temperature changes, in K H2. real :: dS_c ! The core term in the expressions for the salinity changes, in psu H2. real :: PEc_core ! The diffusivity-independent core term in the expressions @@ -1706,12 +1706,12 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & PE_chg, dPEc_dKd, dPE_max, dPEc_dKd_0) real, intent(in) :: Kddt_h !< The diffusivity at an interface times the time step and !! divided by the average of the thicknesses around the - !! interface, in H ~> m or kg m-2. - real, intent(in) :: h_k !< The thickness of the layer below the interface, in H ~> m or kg m-2. + !! interface [H ~> m or kg m-2]. + real, intent(in) :: h_k !< The thickness of the layer below the interface [H ~> m or kg m-2]. real, intent(in) :: b_den_1 !< The first term in the denominator of the pivot !! for the tridiagonal solver, given by h_k plus a term that !! is a fraction (determined from the tridiagonal solver) of - !! Kddt_h for the interface above, in H ~> m or kg m-2. + !! Kddt_h for the interface above [H ~> m or kg m-2]. real, intent(in) :: dTe_term !< A diffusivity-independent term related to the !! temperature change in the layer below the interface, in K H. real, intent(in) :: dSe_term !< A diffusivity-independent term related to the @@ -1775,14 +1775,14 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & ! this routine can also be used for an upward pass with the sense of direction ! reversed. - real :: b1 ! b1 is used by the tridiagonal solver, in H-1 ~> m-1 or m2 kg-1. + real :: b1 ! b1 is used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. real :: b1Kd ! Temporary array (nondim.) real :: ColHt_chg ! The change in column thickness in m. real :: dColHt_max ! The change in column thickness for infinite diffusivity, in m. real :: dColHt_dKd ! The partial derivative of column thickness with diffusivity, in s m-1. real :: dT_k, dT_km1 ! Temporary arrays in K. real :: dS_k, dS_km1 ! Temporary arrays in ppt. - real :: I_Kr_denom ! Temporary array in H-2 ~> m-2 or m4 kg-2 + real :: I_Kr_denom ! Temporary array [H-2 ~> m-2 or m4 kg-2] real :: dKr_dKd ! Nondimensional temporary array. real :: ddT_k_dKd, ddT_km1_dKd ! Temporary arrays in K H-1. real :: ddS_k_dKd, ddS_km1_dKd ! Temporary arrays in ppt H-1. diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index e5386237e5..8f2200ad86 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -57,7 +57,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available !! thermodynamic fields. Absent fields have NULL !! ptrs. @@ -100,20 +100,20 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, ! translated into the same unints as h, m2 or kg2 m-4 (i.e. H2). real, dimension(SZI_(G),SZK_(G)) :: & F, & ! The density flux through a layer within a time step divided by the - ! density difference across the interface below the layer, in H ~> m or kg m-2. + ! density difference across the interface below the layer [H ~> m or kg m-2]. maxF, & ! maxF is the maximum value of F that will not deplete all of the - ! layers above or below a layer within a timestep, in H ~> m or kg m-2. + ! layers above or below a layer within a timestep [H ~> m or kg m-2]. minF, & ! minF is the minimum flux that should be expected in the absence of - ! interactions between layers, in H ~> m or kg m-2. - Fprev, &! The previous estimate of F, in H ~> m or kg m-2. + ! interactions between layers [H ~> m or kg m-2]. + Fprev, &! The previous estimate of F [H ~> m or kg m-2]. dFdfm, &! The partial derivative of F with respect to changes in F of the ! neighboring layers. Nondimensional. h_guess ! An estimate of the layer thicknesses after entrainment, but ! before the entrainments are adjusted to drive the layer - ! densities toward their target values, in H ~> m or kg m-2. + ! densities toward their target values [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(G)+1) :: & Ent_bl ! The average entrainment upward and downward across - ! each interface around the buffer layers, in H ~> m or kg m-2. + ! each interface around the buffer layers [H ~> m or kg m-2]. real, allocatable, dimension(:,:,:) :: & Kd_eff, & ! The effective diffusivity that actually applies to each ! layer after the effects of boundary conditions are @@ -127,43 +127,43 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. real, dimension(SZI_(G)) :: & - htot, & ! The total thickness above or below a layer in H ~> m or kg m-2. + htot, & ! The total thickness above or below a layer [H ~> m or kg m-2]. Rcv, & ! Value of the coordinate variable (potential density) ! based on the simulated T and S and P_Ref, kg m-3. pres, & ! Reference pressure (P_Ref) in Pa. eakb, & ! The entrainment from above by the layer below the buffer - ! layer (i.e. layer kb), in H ~> m or kg m-2. - ea_kbp1, & ! The entrainment from above by layer kb+1, in H ~> m or kg m-2. - eb_kmb, & ! The entrainment from below by the deepest buffer layer, in H ~> m or kg m-2. + ! layer (i.e. layer kb) [H ~> m or kg m-2]. + ea_kbp1, & ! The entrainment from above by layer kb+1 [H ~> m or kg m-2]. + eb_kmb, & ! The entrainment from below by the deepest buffer layer [H ~> m or kg m-2]. dS_kb, & ! The reference potential density difference across the ! interface between the buffer layers and layer kb, in kg m-3. dS_anom_lim, &! The amount by which dS_kb is reduced when limits are ! applied, in kg m-3. I_dSkbp1, & ! The inverse of the potential density difference across the ! interface below layer kb, in m3 kg-1. - dtKd_kb, & ! The diapycnal diffusivity in layer kb times the time step, - ! in H2 ~> m2 or kg2 m-4. + dtKd_kb, & ! The diapycnal diffusivity in layer kb times the time step + ! [H2 ~> m2 or kg2 m-4]. maxF_correct, & ! An amount by which to correct maxF due to excessive - ! surface heat loss, in H ~> m or kg m-2. + ! surface heat loss [H ~> m or kg m-2]. zeros, & ! An array of all zeros. (Usually used with units of H.) - max_eakb, & ! The maximum value of eakb that might be realized, in H ~> m or kg m-2. - min_eakb, & ! The minimum value of eakb that might be realized, in H ~> m or kg m-2. + max_eakb, & ! The maximum value of eakb that might be realized [H ~> m or kg m-2]. + min_eakb, & ! The minimum value of eakb that might be realized [H ~> m or kg m-2]. err_max_eakb0, & ! The value of error returned by determine_Ea_kb err_min_eakb0, & ! when eakb = min_eakb and max_eakb and ea_kbp1 = 0. err_eakb0, & ! A value of error returned by determine_Ea_kb. F_kb, & ! The value of F in layer kb, or equivalently the entrainment - ! from below by layer kb, in H ~> m or kg m-2. + ! from below by layer kb [H ~> m or kg m-2]. dFdfm_kb, & ! The partial derivative of F with fm, nondim. See dFdfm. - maxF_kb, & ! The maximum value of F_kb that might be realized, in H ~> m or kg m-2. - eakb_maxF, & ! The value of eakb that gives F_kb=maxF_kb, in H ~> m or kg m-2. - F_kb_maxEnt ! The value of F_kb when eakb = max_eakb, in H ~> m or kg m-2. + maxF_kb, & ! The maximum value of F_kb that might be realized [H ~> m or kg m-2]. + eakb_maxF, & ! The value of eakb that gives F_kb=maxF_kb [H ~> m or kg m-2]. + F_kb_maxEnt ! The value of F_kb when eakb = max_eakb [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(G)) :: & Sref, & ! The reference potential density of the mixed and buffer layers, ! and of the two lightest interior layers (kb and kb+1) copied ! into layers kmb+1 and kmb+2, in kg m-3. h_bl ! The thicknesses of the mixed and buffer layers, and of the two ! lightest interior layers (kb and kb+1) copied into layers kmb+1 - ! and kmb+2, in H ~> m or kg m-2. + ! and kmb+2 [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(G)) :: & ds_dsp1, & ! The coordinate variable (sigma-2) difference across an @@ -186,20 +186,20 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, dRho_dT, dRho_dS ! The partial derivatives of potential density with ! temperature and salinity, in kg m-3 K-1 and kg m-3 psu-1. - real :: tolerance ! The tolerance within which E must be converged, in H ~> m or kg m-2. - real :: Angstrom ! The minimum layer thickness, in H ~> m or kg m-2. + real :: tolerance ! The tolerance within which E must be converged [H ~> m or kg m-2]. + real :: Angstrom ! The minimum layer thickness [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: F_cor ! A correction to the amount of F that is used to - ! entrain from the layer above, in H ~> m or kg m-2. + ! entrain from the layer above [H ~> m or kg m-2]. real :: Kd_here ! The effective diapycnal diffusivity, in H2 s-1. - real :: h_avail ! The thickness that is available for entrainment, in H ~> m or kg m-2. + real :: h_avail ! The thickness that is available for entrainment [H ~> m or kg m-2]. real :: dS_kb_eff ! The value of dS_kb after limiting is taken into account. real :: Rho_cor ! The depth-integrated potential density anomaly that ! needs to be corrected for, in kg m-2. - real :: ea_cor ! The corrective adjustment to eakb, in H ~> m or kg m-2. + real :: ea_cor ! The corrective adjustment to eakb [H ~> m or kg m-2]. real :: h1 ! The layer thickness after entrainment through the - ! interface below is taken into account, in H ~> m or kg m-2. + ! interface below is taken into account [H ~> m or kg m-2]. real :: Idt ! The inverse of the time step, in s-1. logical :: do_any @@ -898,9 +898,9 @@ subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb, real, dimension(SZI_(G),SZK_(G)), intent(in) :: F !< The density flux through a layer within !! a time step divided by the density !! difference across the interface below - !! the layer, in H ~> m or kg m-2. + !! the layer [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] integer, dimension(SZI_(G)), intent(in) :: kb !< The index of the lightest layer denser than !! the deepest buffer layer. integer, intent(in) :: kmb !< The number of mixed and buffer layers. @@ -911,16 +911,16 @@ subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb, !! a layer over the difference across the !! interface above the layer. real, dimension(SZI_(G)), intent(in) :: eakb !< The entrainment from above by the layer - !! below the buffer layer, in H ~> m or kg m-2. + !! below the buffer layer [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(G)), intent(in) :: Ent_bl !< The average entrainment upward and !! downward across each interface around - !! the buffer layers, in H ~> m or kg m-2. + !! the buffer layers [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: ea !< The amount of fluid entrained from the layer - !! above within this time step, in H ~> m or kg m-2. + !! above within this time step [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: eb !< The amount of fluid entrained from the layer - !! below within this time step, in H ~> m or kg m-2. + !! below within this time step [H ~> m or kg m-2]. logical, dimension(SZI_(G)), & optional, intent(in) :: do_i_in !< Indicates which i-points to work on. ! This subroutine calculates the actual entrainments (ea and eb) and the @@ -1026,12 +1026,12 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] !! (usually m or kg m-2). real, dimension(SZI_(G),SZK_(G)+1), & intent(in) :: dtKd_int !< The diapycnal diffusivity across - !! each interface times the time step, - !! in H2 ~> m2 or kg2 m-4. + !! each interface times the time step + !! [H2 ~> m2 or kg2 m-4]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent !! fields have NULL ptrs. @@ -1046,14 +1046,14 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref real, dimension(SZI_(G),SZK_(G)+1), & intent(out) :: Ent_bl !< The average entrainment upward and !! downward across each interface around - !! the buffer layers, in H ~> m or kg m-2. + !! the buffer layers [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(G)), intent(out) :: Sref !< The coordinate potential density - !! 1000 for each layer, in kg m-3. - real, dimension(SZI_(G),SZK_(G)), intent(out) :: h_bl !< The thickness of each layer, in H ~> m or kg m-2. + real, dimension(SZI_(G),SZK_(G)), intent(out) :: h_bl !< The thickness of each layer [H ~> m or kg m-2]. ! Arguments: h - Layer thickness, in m or kg m-2 (abbreviated as H below). ! (in) dtKd_int - The diapycnal diffusivity across each interface times -! the time step, in H2 ~> m2 or kg2 m-4. +! the time step [H2 ~> m2 or kg2 m-4]. ! (in) tv - A structure containing pointers to any available ! thermodynamic fields. Absent fields have NULL ptrs. ! (in) kb - The index of the lightest layer denser than the @@ -1064,10 +1064,10 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref ! (in) CS - This module's control structure. ! (in) j - The meridional index upon which to work. ! (out) Ent_bl - The average entrainment upward and downward across -! each interface around the buffer layers, in H ~> m or kg m-2. +! each interface around the buffer layers [H ~> m or kg m-2]. ! (out) Sref - The coordinate potential density - 1000 for each layer, ! in kg m-3. -! (out) h_bl - The thickness of each layer, in H ~> m or kg m-2. +! (out) h_bl - The thickness of each layer [H ~> m or kg m-2]. ! This subroutine sets the average entrainment across each of the interfaces ! between buffer layers within a timestep. It also causes thin and relatively @@ -1081,16 +1081,16 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref ! based on the simulated T and S and P_Ref, kg m-3. pres, & ! Reference pressure (P_Ref) in Pa. frac_rem, & ! The fraction of the diffusion remaining, ND. - h_interior ! The interior thickness available for entrainment, in H ~> m or kg m-2. + h_interior ! The interior thickness available for entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G), SZK_(G)) :: & S_est ! An estimate of the coordinate potential density - 1000 after ! entrainment for each layer, in kg m-3. - real :: max_ent ! The maximum possible entrainment, in H ~> m or kg m-2. - real :: dh ! An available thickness, in H ~> m or kg m-2. + real :: max_ent ! The maximum possible entrainment [H ~> m or kg m-2]. + real :: dh ! An available thickness [H ~> m or kg m-2]. real :: Kd_x_dt ! The diffusion that remains after thin layers are - ! entrained, in H2 ~> m2 or kg2 m-4. + ! entrained [H2 ~> m2 or kg2 m-4]. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke @@ -1224,9 +1224,9 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & !! (in kg m-3?). real, dimension(SZI_(G),SZK_(G)), intent(in) :: Ent_bl !< The average entrainment upward and !! downward across each interface - !! around the buffer layers, in H ~> m or kg m-2. + !! around the buffer layers [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: E_kb !< The entrainment by the top interior - !! layer, in H ~> m or kg m-2. + !! layer [H ~> m or kg m-2]. integer, intent(in) :: is !< The start of the i-index range to work on. integer, intent(in) :: ie !< The end of the i-index range to work on. integer, intent(in) :: kmb !< The number of mixed and buffer layers. @@ -1252,8 +1252,8 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & ! Arguments: h_bl - Layer thickness, in m or kg m-2 (abbreviated as H below). ! (in) Sref - Reference potential vorticity (in kg m-3?) ! (in) Ent_bl - The average entrainment upward and downward across -! each interface around the buffer layers, in H ~> m or kg m-2. -! (in) E_kb - The entrainment by the top interior layer, in H ~> m or kg m-2. +! each interface around the buffer layers [H ~> m or kg m-2]. +! (in) E_kb - The entrainment by the top interior layer [H ~> m or kg m-2]. ! (in) is, ie - The range of i-indices to work on. ! (in) kmb - The number of mixed and buffer layers. ! (in) G - The ocean's grid structure. @@ -1294,7 +1294,7 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & ! after exchange with the layer below, in m or kg m-2. logical, dimension(SZI_(G)) :: do_i real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: h_tr ! h_tr is h at tracer points with a tiny thickness ! added to ensure positive definiteness, in m or kg m-2. real :: b_denom_1 ! The first term in the denominator of b1 in m or kg m-2. @@ -1485,19 +1485,19 @@ subroutine F_kb_to_ea_kb(h_bl, Sref, Ent_bl, I_dSkbp1, F_kb, kmb, i, & real, dimension(SZI_(G),SZK_(G)), & intent(in) :: Ent_bl !< The average entrainment upward and downward !! across each interface around the buffer layers, - !! in H ~> m or kg m-2. + !! [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: I_dSkbp1 !< The inverse of the difference in reference !! potential density across the base of the !! uppermost interior layer, in units of m3 kg-1. real, dimension(SZI_(G)), intent(in) :: F_kb !< The entrainment from below by the - !! uppermost interior layer, in H ~> m or kg m-2 + !! uppermost interior layer [H ~> m or kg m-2] integer, intent(in) :: kmb !< The number of mixed and buffer layers. integer, intent(in) :: i !< The i-index to work on type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. real, dimension(SZI_(G)), intent(inout) :: ea_kb !< The entrainment from above by the layer below - !! the buffer layer (i.e. layer kb), in H ~> m or kg m-2. + !! the buffer layer (i.e. layer kb) [H ~> m or kg m-2]. real, optional, intent(in) :: tol_in !< A tolerance for the iterative determination - !! of the entrainment, in H ~> m or kg m-2. + !! of the entrainment [H ~> m or kg m-2]. real :: max_ea, min_ea real :: err, err_min, err_max @@ -1617,20 +1617,20 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & !! kmb+1, in units of kg m-3. real, dimension(SZI_(G),SZK_(G)), intent(in) :: Ent_bl !< The average entrainment upward and !! downward across each interface around - !! the buffer layers, in H ~> m or kg m-2. + !! the buffer layers [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: I_dSkbp1 !< The inverse of the difference in !! reference potential density across !! the base of the uppermost interior !! layer, in units of m3 kg-1. real, dimension(SZI_(G)), intent(in) :: dtKd_kb !< The diapycnal diffusivity in the top - !! interior layer times the time step, - !! in H2 ~> m2 or kg2 m-4. + !! interior layer times the time step + !! [H2 ~> m2 or kg2 m-4]. real, dimension(SZI_(G)), intent(in) :: ea_kbp1 !< The entrainment from above by layer - !! kb+1, in H ~> m or kg m-2. + !! kb+1 [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: min_eakb !< The minimum permissible rate of - !! entrainment, in H ~> m or kg m-2. + !! entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: max_eakb !< The maximum permissible rate of - !! entrainment, in H ~> m or kg m-2. + !! entrainment [H ~> m or kg m-2]. integer, intent(in) :: kmb !< The number of mixed and buffer layers. integer, intent(in) :: is !< The start of the i-index range to work on. integer, intent(in) :: ie !< The end of the i-index range to work on. @@ -1638,7 +1638,7 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & !! i-points to work on. type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. real, dimension(SZI_(G)), intent(inout) :: Ent !< The entrainment rate of the uppermost - !! interior layer, in H ~> m or kg m-2. + !! interior layer [H ~> m or kg m-2]. !! The input value is the first guess. real, dimension(SZI_(G)), optional, intent(out) :: error !< The error (locally defined in this !! routine) associated with the returned @@ -1652,14 +1652,14 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & real, dimension(SZI_(G)), optional, intent(out) :: F_kb !< The entrainment from below by the !! uppermost interior layer !! corresponding to the returned - !! value of Ent, in H ~> m or kg m-2. + !! value of Ent [H ~> m or kg m-2]. real, dimension(SZI_(G)), optional, intent(out) :: dFdfm_kb !< The partial derivative of F_kb with !! ea_kbp1, nondim. ! Arguments: h_bl - Layer thickness, with the top interior layer at k-index ! kmb+1, in units of m or kg m-2 (abbreviated as H below). ! (in) dtKd_kb - The diapycnal diffusivity in the top interior layer times -! the time step, in H2 ~> m2 or kg2 m-4. +! the time step [H2 ~> m2 or kg2 m-4]. ! (in) Sref - The coordinate reference potential density, with the ! value of the topmost interior layer at layer kmb+1, ! in units of kg m-3. @@ -1667,16 +1667,16 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & ! density across the base of the uppermost interior layer, ! in units of m3 kg-1. ! (in) Ent_bl - The average entrainment upward and downward across -! each interface around the buffer layers, in H ~> m or kg m-2. -! (in) ea_kbp1 - The entrainment from above by layer kb+1, in H ~> m or kg m-2. -! (in) min_eakb - The minimum permissible rate of entrainment, in H ~> m or kg m-2. -! (in) max_eakb - The maximum permissible rate of entrainment, in H ~> m or kg m-2. +! each interface around the buffer layers [H ~> m or kg m-2]. +! (in) ea_kbp1 - The entrainment from above by layer kb+1 [H ~> m or kg m-2]. +! (in) min_eakb - The minimum permissible rate of entrainment [H ~> m or kg m-2]. +! (in) max_eakb - The maximum permissible rate of entrainment [H ~> m or kg m-2]. ! (in) is, ie - The range of i-indices to work on. ! (in) do_i - A logical variable indicating which i-points to work on. ! (in) G - The ocean's grid structure. ! (in) GV - The ocean's vertical grid structure. ! (in) CS - This module's control structure. -! (in/out) Ent - The entrainment rate of the uppermost interior layer, in H ~> m or kg m-2. +! (in/out) Ent - The entrainment rate of the uppermost interior layer [H ~> m or kg m-2]. ! The input value is the first guess. ! (out,opt) error - The error (locally defined in this routine) associated with ! the returned solution. @@ -1684,7 +1684,7 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & ! associated with min_eakb and max_eakb when ea_kbp1 = 0, ! returned from a previous call to this routine. ! (out,opt) F_kb - The entrainment from below by the uppermost interior layer -! corresponding to the returned value of Ent, in H ~> m or kg m-2. +! corresponding to the returned value of Ent [H ~> m or kg m-2]. ! (out,out) dFdfm_kb - The partial derivative of F_kb with ea_kbp1, nondim. ! This subroutine determines the entrainment from above by the top interior @@ -1699,22 +1699,22 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & ! too much bigger than dS_kb or dS_kbp1, in kg m-3. ddSkb_dE, ddSlay_dE, & ! The derivatives of dS_kb and dS_Lay with E, ! in units of kg m-3 H-1. - derror_dE, & ! The derivative of err with E, in H ~> m or kg m-2. - err, & ! The "error" whose zero is being sought, in H2 ~> m2 or kg2 m-4. - E_min, E_max, & ! The minimum and maximum values of E, in H ~> m or kg m-2. - error_minE, error_maxE ! err when E = E_min or E = E_max, in H2 ~> m2 or kg2 m-4. - real :: err_est ! An estimate of what err will be, in H2 ~> m2 or kg2 m-4. + derror_dE, & ! The derivative of err with E [H ~> m or kg m-2]. + err, & ! The "error" whose zero is being sought [H2 ~> m2 or kg2 m-4]. + E_min, E_max, & ! The minimum and maximum values of E [H ~> m or kg m-2]. + error_minE, error_maxE ! err when E = E_min or E = E_max [H2 ~> m2 or kg2 m-4]. + real :: err_est ! An estimate of what err will be [H2 ~> m2 or kg2 m-4]. real :: eL ! 1 or 0, depending on whether increases in E lead ! to decreases in the entrainment from below by the ! deepest buffer layer. real :: fa, fk, fm, fr ! Temporary variables used to calculate err, in ND, H2, H, H. - real :: tolerance ! The tolerance within which E must be converged, in H ~> m or kg m-2. - real :: E_prev ! The previous value of E, in H ~> m or kg m-2. + real :: tolerance ! The tolerance within which E must be converged [H ~> m or kg m-2]. + real :: E_prev ! The previous value of E [H ~> m or kg m-2]. logical, dimension(SZI_(G)) :: false_position ! If true, the false position ! method might be used for the next iteration. logical, dimension(SZI_(G)) :: redo_i ! If true, more work is needed on this column. logical :: do_any - real :: large_err ! A large error measure, in H2 ~> m2 or kg2 m-4. + real :: large_err ! A large error measure [H2 ~> m2 or kg2 m-4]. integer :: i, it integer, parameter :: MAXIT = 30 @@ -1856,24 +1856,24 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & real, dimension(SZI_(G),SZK_(G)), & intent(in) :: Ent_bl !< The average entrainment upward and !! downward across each interface around - !! the buffer layers, in H ~> m or kg m-2. + !! the buffer layers [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: I_dSkbp1 !< The inverse of the difference in !! reference potential density across the !! base of the uppermost interior layer, !! in units of m3 kg-1. real, dimension(SZI_(G)), intent(in) :: min_ent_in !< The minimum value of ent to search, - !! in H ~> m or kg m-2. + !! [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: max_ent_in !< The maximum value of ent to search, - !! in H ~> m or kg m-2. + !! [H ~> m or kg m-2]. integer, intent(in) :: kmb !< The number of mixed and buffer layers. integer, intent(in) :: is !< The start of the i-index range to work on. integer, intent(in) :: ie !< The end of the i-index range to work on. type(entrain_diffusive_CS), pointer :: CS !< This module's control structure. real, dimension(SZI_(G)), intent(out) :: maxF !< The maximum value of F !! = ent*ds_kb*I_dSkbp1 found in the range - !! min_ent < ent < max_ent, in H ~> m or kg m-2. + !! min_ent < ent < max_ent [H ~> m or kg m-2]. real, dimension(SZI_(G)), & - optional, intent(out) :: ent_maxF !< The value of ent at that maximum, in H ~> m or kg m-2. + optional, intent(out) :: ent_maxF !< The value of ent at that maximum [H ~> m or kg m-2]. logical, dimension(SZI_(G)), & optional, intent(in) :: do_i_in !< A logical array indicating which columns !! to work on. @@ -1881,7 +1881,7 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & optional, intent(out) :: F_lim_maxent !< If present, do not apply the limit in !! finding the maximum value, but return the !! limited value at ent=max_ent_in in this - !! array, in H ~> m or kg m-2. + !! array [H ~> m or kg m-2]. real, dimension(SZI_(G)), & optional, intent(in) :: F_thresh !< If F_thresh is present, return the first !! value found that has F > F_thresh, or diff --git a/src/parameterizations/vertical/MOM_full_convection.F90 b/src/parameterizations/vertical/MOM_full_convection.F90 index e32c536ec7..7851e4806c 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -22,7 +22,7 @@ subroutine full_convection(G, GV, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, & type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -31,9 +31,9 @@ subroutine full_convection(G, GV, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, & intent(out) :: S_adj !< Adjusted salinity in ppt. real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface in Pa (or NULL). real, intent(in) :: Kddt_smooth !< A smoothing vertical - !! diffusivity times a timestep, in H2 ~> m2 or kg2 m-4. + !! diffusivity times a timestep [H2 ~> m2 or kg2 m-4]. real, optional, intent(in) :: Kddt_convect !< A large convecting vertical - !! diffusivity times a timestep, in H2 ~> m2 or kg2 m-4. + !! diffusivity times a timestep [H2 ~> m2 or kg2 m-4]. integer, optional, intent(in) :: halo !< Halo width over which to compute ! Local variables @@ -41,7 +41,7 @@ subroutine full_convection(G, GV, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, & drho_dT, & ! The derivatives of density with temperature and drho_dS ! salinity, in kg m-3 K-1 and kg m-3 psu-1. real :: h_neglect, h0 ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. ! logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. real, dimension(SZI_(G),SZK0_(G)) :: & Te_a, & ! A partially updated temperature estimate including the influnce from @@ -73,12 +73,12 @@ subroutine full_convection(G, GV, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, & ! and layers below in the final properies with a upward-first solver, nondim. ! d_b = 1.0 - c_b real, dimension(SZI_(G),SZK_(G)+1) :: & - mix !< The amount of mixing across the interface between layers, in H ~> m or kg m-2. - real :: mix_len ! The length-scale of mixing, when it is active, in H ~> m or kg m-2 - real :: h_b, h_a ! The thicknessses of the layers above and below an interface, in H ~> m or kg m-2 - real :: b_b, b_a ! Inverse pivots used by the tridiagonal solver, in H-1 ~> m-1 or m2 kg-1. + mix !< The amount of mixing across the interface between layers [H ~> m or kg m-2]. + real :: mix_len ! The length-scale of mixing, when it is active [H ~> m or kg m-2] + real :: h_b, h_a ! The thicknessses of the layers above and below an interface [H ~> m or kg m-2] + real :: b_b, b_a ! Inverse pivots used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. - real :: kap_dt_x2 ! The product of 2*kappa*dt in H2 ~> m2 or kg2 m-4. + real :: kap_dt_x2 ! The product of 2*kappa*dt [H2 ~> m2 or kg2 m-4]. logical, dimension(SZI_(G)) :: do_i ! Do more work on this column. logical, dimension(SZI_(G)) :: last_down ! The last setup pass was downward. @@ -283,10 +283,10 @@ function is_unstable(dRho_dT, dRho_dS, h_a, h_b, mix_A, mix_B, T_a, T_b, S_a, S_ Te_aa, Te_bb, Se_aa, Se_bb, d_A, d_B) real, intent(in) :: dRho_dT !< The derivative of in situ density with temperature in kg m-3 degC-1 real, intent(in) :: dRho_dS !< The derivative of in situ density with salinity in kg m-3 ppt-1 - real, intent(in) :: h_a !< The thickness of the layer above, in H ~> m or kg m-2 - real, intent(in) :: h_b !< The thickness of the layer below, in H ~> m or kg m-2 - real, intent(in) :: mix_A !< The time integrated mixing rate of the interface above, in H ~> m or kg m-2 - real, intent(in) :: mix_B !< The time integrated mixing rate of the interface below, in H ~> m or kg m-2 + real, intent(in) :: h_a !< The thickness of the layer above [H ~> m or kg m-2] + real, intent(in) :: h_b !< The thickness of the layer below [H ~> m or kg m-2] + real, intent(in) :: mix_A !< The time integrated mixing rate of the interface above [H ~> m or kg m-2] + real, intent(in) :: mix_B !< The time integrated mixing rate of the interface below [H ~> m or kg m-2] real, intent(in) :: T_a !< The initial temperature of the layer above, in degC real, intent(in) :: T_b !< The initial temperature of the layer below, in degC real, intent(in) :: S_a !< The initial salinity of the layer below, in ppt @@ -321,10 +321,10 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, j, p_surf, halo) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables - real, intent(in) :: Kddt !< A diffusivity times a time increment, in H2 ~> m2 or kg2 m-4. + real, intent(in) :: Kddt !< A diffusivity times a time increment [H2 ~> m2 or kg2 m-4]. real, dimension(SZI_(G),SZK_(G)+1), & intent(out) :: dR_dT !< Derivative of locally referenced !! potential density with temperature, kg m-3 K-1 @@ -337,7 +337,7 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, j, p_surf, halo) ! Local variables real :: mix(SZI_(G),SZK_(G)+1) ! The diffusive mixing length (kappa*dt)/dz - ! between layers within in a timestep in H ~> m or kg m-2. + ! between layers within in a timestep [H ~> m or kg m-2]. real :: b1(SZI_(G)), d1(SZI_(G)) ! b1, c1, and d1 are variables used by the real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. real :: T_f(SZI_(G),SZK_(G)) ! Filtered temperatures in degC @@ -345,10 +345,10 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, j, p_surf, halo) real :: pres(SZI_(G)) ! Interface pressures, in Pa. real :: T_EOS(SZI_(G)) ! Filtered and vertically averaged temperatures in degC real :: S_EOS(SZI_(G)) ! Filtered and vertically averaged salinities in ppt - real :: kap_dt_x2 ! The product of 2*kappa*dt in H2 ~> m2 or kg2 m-4. + real :: kap_dt_x2 ! The product of 2*kappa*dt [H2 ~> m2 or kg2 m-4]. real :: h_neglect, h0 ! Negligible thicknesses to allow for zero thicknesses, - ! in H ~> m or kg m-2. - real :: h_tr ! The thickness at tracer points, plus h_neglect, in H ~> m or kg m-2. + ! [H ~> m or kg m-2]. + real :: h_tr ! The thickness at tracer points, plus h_neglect [H ~> m or kg m-2]. integer :: i, k, is, ie, nz if (present(halo)) then diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index df96b6492b..2bffbfbb96 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -49,7 +49,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid !! structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers !! to any available thermodynamic !! fields. Absent fields have NULL @@ -58,11 +58,11 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: ea !< The amount of fluid moved !! downward into a layer; this !! should be increased due to mixed - !! layer detrainment, in H ~> m or kg m-2 + !! layer detrainment [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: eb !< The amount of fluid moved upward !! into a layer; this should be !! increased due to mixed layer - !! entrainment, in H ~> m or kg m-2. + !! entrainment [H ~> m or kg m-2]. type(geothermal_CS), pointer :: CS !< The control structure returned by !! a previous call to !! geothermal_init. @@ -70,7 +70,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) ! Local variables real, dimension(SZI_(G)) :: & heat_rem, & ! remaining heat (H * degC) - h_geo_rem, & ! remaining thickness to apply geothermal heating (H ~> m or kg m-2) + h_geo_rem, & ! remaining thickness to apply geothermal heating [H ~> m or kg m-2] Rcv_BL, & ! coordinate density in the deepest variable density layer (kg/m3) p_ref ! coordiante densities reference pressure (Pa) @@ -79,19 +79,19 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) dRcv_dT_, & ! partial derivative of coordinate density wrt temp (kg m-3 K-1) dRcv_dS_ ! partial derivative of coordinate density wrt saln (kg m-3 ppt-1) - real :: Angstrom, H_neglect ! small thicknesses in H ~> m or kg m-2 + real :: Angstrom, H_neglect ! small thicknesses [H ~> m or kg m-2] real :: Rcv ! coordinate density of present layer (kg m-3) real :: Rcv_tgt ! coordinate density of target layer (kg m-3) real :: dRcv ! difference between Rcv and Rcv_tgt (kg m-3) real :: dRcv_dT ! partial derivative of coordinate density wrt temp ! in the present layer (kg m-3 K-1); usually negative - real :: h_heated ! thickness that is being heated (H ~> m or kg m-2) + real :: h_heated ! thickness that is being heated [H ~> m or kg m-2] real :: heat_avail ! heating available for the present layer (units of Kelvin * H) real :: heat_in_place ! heating to warm present layer w/o movement between layers (K * H) real :: heat_trans ! heating available to move water from present layer to target layer (K * H) real :: heating ! heating used to move water from present layer to target layer (K * H) ! 0 <= heating <= heat_trans - real :: h_transfer ! thickness moved between layers (H ~> m or kg m-2) + real :: h_transfer ! thickness moved between layers [H ~> m or kg m-2] real :: wt_in_place ! relative weighting that goes from 0 to 1 (non-dim) real :: I_h ! inverse thickness (units of 1/H) real :: dTemp ! temperature increase in a layer (Kelvin) diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 4bae6f4998..8a628c201e 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -66,7 +66,7 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1 real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, in m s-1 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to the !! thermodynamic fields type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes @@ -129,7 +129,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to the !! thermodynamic fields real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_f !< Temperature after vertical filtering to diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 9a8a1cbea5..6fe7a62e9f 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -55,7 +55,7 @@ module MOM_kappa_shear real :: lambda2_N_S !< The square of the ratio of the coefficients of !! the buoyancy and shear scales in the diffusivity !! equation, 0 to eliminate the shear scale. Nondim. - real :: TKE_bg !< The background level of TKE, in m2 s-2. + real :: TKE_bg !< The background level of TKE [m2 s-2]. real :: kappa_0 !< The background diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. real :: kappa_tol_err !< The fractional error in kappa that is tolerated. real :: Prandtl_turb !< Prandtl number used to convert Kd_shear into viscosity. @@ -102,7 +102,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: v_in !< Initial meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. @@ -140,22 +140,20 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & u, & ! The zonal velocity after a timestep of mixing, in m s-1. v, & ! The meridional velocity after a timestep of mixing, in m s-1. Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. - T, & ! The potential temperature after a timestep of mixing, in C. - Sal, & ! The salinity after a timestep of mixing, in psu. + T, & ! The potential temperature after a timestep of mixing [degC]. + Sal, & ! The salinity after a timestep of mixing [PSU]. dz, & ! The layer thickness [Z ~> m]. u0xdz, & ! The initial zonal velocity times dz [Z m s-1 ~> m2 s-1]. v0xdz, & ! The initial meridional velocity times dz [Z m s-1 ~> m2 s-1]. T0xdz, & ! The initial temperature times dz [degC Z ~> degC m]. S0xdz ! The initial salinity times dz [PSU Z ~> PSU m]. real, dimension(SZK_(GV)+1) :: & - kappa, & ! The shear-driven diapycnal diffusivity at an interface, in - ! units of Z2 s-1 ~> m2 s-1. - tke, & ! The Turbulent Kinetic Energy per unit mass at an interface, - ! in units of m2 s-2. + kappa, & ! The shear-driven diapycnal diffusivity at an interface [Z2 s-1 ~> m2 s-1]. + tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [m2 s-2]. kappa_avg, & ! The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. - tke_avg ! The time-weighted average of TKE, in m2 s-2. - real :: f2 ! The squared Coriolis parameter of each column, in s-2. - real :: surface_pres ! The top surface pressure, in Pa. + tke_avg ! The time-weighted average of TKE [m2 s-2]. + real :: f2 ! The squared Coriolis parameter of each column [s-2]. + real :: surface_pres ! The top surface pressure [Pa]. real :: dz_in_lay ! The running sum of the thickness in a layer [Z ~> m]. real :: k0dt ! The background diffusivity times the timestep [Z2 ~> m2]. @@ -186,7 +184,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & real :: wt(SZK_(GV)+1), wt_tot, I_wt_tot, wt_itt real, dimension(SZK_(GV)+1) :: & Ri_k, tke_prev, dtke, dkap, dtke_norm, & - ksrc_av ! The average through the iterations of k_src, in s-1. + ksrc_av ! The average through the iterations of k_src [s-1]. real, dimension(SZK_(GV)+1,0:max_debug_itt) :: & tke_it1, N2_it1, Sh2_it1, ksrc_it1, kappa_it1, kprev_it1 real, dimension(SZK_(GV)+1,1:max_debug_itt) :: & @@ -391,7 +389,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: v_in !< Initial meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: T_in !< Layer potential temperatures in degC real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -446,14 +444,14 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ tke, & ! The Turbulent Kinetic Energy per unit mass at an interface, ! in units of m2 s-2. kappa_avg, & ! The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. - tke_avg ! The time-weighted average of TKE, in m2 s-2. - real :: f2 ! The squared Coriolis parameter of each column, in s-2. + tke_avg ! The time-weighted average of TKE [m2 s-2]. + real :: f2 ! The squared Coriolis parameter of each column [s-2]. real :: surface_pres ! The top surface pressure, in Pa. real :: dz_in_lay ! The running sum of the thickness in a layer [Z ~> m]. real :: k0dt ! The background diffusivity times the timestep [Z2 ~> m2]. real :: dz_massless ! A layer thickness that is considered massless [Z ~> m]. - real :: I_hwt ! The inverse of the masked thickness weights, in H-1 ~> m-1 or m2 kg-1. + real :: I_hwt ! The inverse of the masked thickness weights [H-1 ~> m-1 or m2 kg-1]. real :: I_Prandtl logical :: use_temperature ! If true, temperature and salinity have been ! allocated and are being used as state variables. @@ -482,7 +480,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ real :: wt(SZK_(GV)+1), wt_tot, I_wt_tot, wt_itt real, dimension(SZK_(GV)+1) :: & Ri_k, tke_prev, dtke, dkappa, dtke_norm, & - ksrc_av ! The average through the iterations of k_src, in s-1. + ksrc_av ! The average through the iterations of k_src [s-1]. real, dimension(SZK_(GV)+1,0:max_debug_itt) :: & tke_it1, N2_it1, Sh2_it1, ksrc_it1, kappa_it1, kprev_it1 real, dimension(SZK_(GV)+1,1:max_debug_itt) :: & @@ -724,7 +722,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & intent(inout) :: tke !< The Turbulent Kinetic Energy per unit mass at !! an interface, in units of m2 s-2. integer, intent(in) :: nzc !< The number of active layers in the column. - real, intent(in) :: f2 !< The square of the Coriolis parameter, in s-2. + real, intent(in) :: f2 !< The square of the Coriolis parameter [s-2]. real, intent(in) :: surface_pres !< The surface pressure, in Pa. real, dimension(SZK_(GV)), & intent(in) :: dz !< The layer thickness [Z ~> m]. @@ -733,13 +731,13 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real, dimension(SZK_(GV)), & intent(in) :: v0xdz !< The initial meridional velocity times dz [Z m s-1 ~> m2 s-1]. real, dimension(SZK_(GV)), & - intent(in) :: T0xdz !< The initial temperature times dz, in C Z ~> C m. + intent(in) :: T0xdz !< The initial temperature times dz [degC Z ~> degC m]. real, dimension(SZK_(GV)), & - intent(in) :: S0xdz !< The initial salinity times dz, in PSU Z ~> PSU m. + intent(in) :: S0xdz !< The initial salinity times dz [PSU Z ~> PSU m]. real, dimension(SZK_(GV)+1), & intent(out) :: kappa_avg !< The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. real, dimension(SZK_(GV)+1), & - intent(out) :: tke_avg !< The time-weighted average of TKE, in m2 s-2. + intent(out) :: tke_avg !< The time-weighted average of TKE [m2 s-2]. real, intent(in) :: dt !< Time increment, in s. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields @@ -756,23 +754,23 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & u_test, v_test, T_test, S_test real, dimension(nzc+1) :: & - N2, & ! The squared buoyancy frequency at an interface, in s-2. + N2, & ! The squared buoyancy frequency at an interface [s-2]. dz_Int, & ! The extent of a finite-volume space surrounding an interface, ! as used in calculating kappa and TKE [Z ~> m]. I_dz_int, & ! The inverse of the distance between velocity & density points ! above and below an interface [Z-1 ~> m-1]. This is used to ! calculate N2, shear, and fluxes, and it might differ from ! 1/dz_Int, as they have different uses. - S2, & ! The squared shear at an interface, in s-2. + S2, & ! The squared shear at an interface [s-2]. a1, & ! a1 is the coupling between adjacent interfaces in the TKE, ! velocity, and density equations [Z s-1 ~> m s-1] or [Z ~> m] c1, & ! c1 is used in the tridiagonal (and similar) solvers. - k_src, & ! The shear-dependent source term in the kappa equation, in s-1. + k_src, & ! The shear-dependent source term in the kappa equation [s-1]. kappa_src, & ! The shear-dependent source term in the kappa equation in s-1. kappa_out, & ! The kappa that results from the kappa equation [Z2 s-1 ~> m2 s-1]. kappa_mid, & ! The average of the initial and predictor estimates of kappa, ! in units of Z2 s-1. - tke_pred, & ! The value of TKE from a predictor step, in m2 s-2. + tke_pred, & ! The value of TKE from a predictor step [m2 s-2]. kappa_pred, & ! The value of kappa from a predictor step [Z2 s-1 ~> m2 s-1]. pressure, & ! The pressure at an interface, in Pa. T_int, & ! The temperature interpolated to an interface, in C. @@ -784,12 +782,12 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & K_Q, & ! Diffusivity divided by TKE [Z2 m-2 s ~> s]. K_Q_tmp, & ! A temporary copy of diffusivity divided by TKE [Z2 m-2 s ~> s]. local_src_avg, & ! The time-integral of the local source, nondim. - tol_min, & ! Minimum tolerated ksrc for the corrector step, in s-1. - tol_max, & ! Maximum tolerated ksrc for the corrector step, in s-1. + tol_min, & ! Minimum tolerated ksrc for the corrector step [s-1]. + tol_max, & ! Maximum tolerated ksrc for the corrector step [s-1]. tol_chg, & ! The tolerated change integrated in time, nondim. dist_from_top, & ! The distance from the top surface [Z ~> m]. local_src ! The sum of all sources of kappa, including kappa_src and - ! sources from the elliptic term, in s-1. + ! sources from the elliptic term [s-1]. real :: dist_from_bot ! The distance from the bottom surface [Z ~> m]. real :: b1 ! The inverse of the pivot in the tridiagonal equations. @@ -808,7 +806,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real :: dt_wt ! The fractional weight of the current iteration, ND. real :: dt_test ! A time-step that is being tested for whether it ! gives acceptably small changes in k_src, in s. - real :: Idtt ! Idtt = 1 / dt_test, in s-1. + real :: Idtt ! Idtt = 1 / dt_test [s-1]. real :: dt_inc ! An increment to dt_test that is being tested, in s. real :: k0dt ! The background diffusivity times the timestep [Z2 ~> m2]. @@ -1262,7 +1260,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & intent(inout) :: N2 !< The buoyancy frequency squared at interfaces, !! in s-2. real, dimension(nz+1), optional, & - intent(inout) :: S2 !< The squared shear at interfaces, in s-2. + intent(inout) :: S2 !< The squared shear at interfaces [s-2]. integer, optional, intent(in) :: ks_int !< The topmost k-index with a non-zero diffusivity. integer, optional, intent(in) :: ke_int !< The bottommost k-index with a non-zero !! diffusivity. @@ -1377,15 +1375,15 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & integer, intent(in) :: nz !< The number of layers to work on. real, dimension(nz+1), intent(in) :: N2 !< The buoyancy frequency squared at interfaces, !! in s-2. - real, dimension(nz+1), intent(in) :: S2 !< The squared shear at interfaces, in s-2. + real, dimension(nz+1), intent(in) :: S2 !< The squared shear at interfaces [s-2]. real, dimension(nz+1), intent(in) :: kappa_in !< The initial guess at the diffusivity !! [Z2 s-1 ~> m2 s-1]. real, dimension(nz+1), intent(in) :: dz_Int !< The thicknesses associated with interfaces !! [Z-1 ~> m-1]. real, dimension(nz+1), intent(in) :: I_L2_bdry !< The inverse of the squared distance to - !! boundaries, m2. + !! boundaries [m-2]. real, dimension(nz), intent(in) :: Idz !< The inverse grid spacing of layers [Z-1 ~> m-1]. - real, intent(in) :: f2 !< The squared Coriolis parameter, in s-2. + real, intent(in) :: f2 !< The squared Coriolis parameter [s-2]. type(Kappa_shear_CS), pointer :: CS !< A pointer to this module's control structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1397,7 +1395,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real, dimension(nz+1), intent(out) :: kappa !< The diapycnal diffusivity at interfaces !! [Z2 s-1 ~> m2 s-1]. real, dimension(nz+1), optional, & - intent(out) :: kappa_src !< The source term for kappa, in s-1. + intent(out) :: kappa_src !< The source term for kappa [s-1]. real, dimension(nz+1), optional, & intent(out) :: local_src !< The sum of all local sources for kappa, !! in s-1. @@ -1405,20 +1403,19 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! Local variables real, dimension(nz) :: & - aQ, & ! aQ is the coupling between adjacent interfaces in the TKE - ! equations, in m s-1. - dQdz ! Half the partial derivative of TKE with depth, m s-2. + aQ, & ! aQ is the coupling between adjacent interfaces in the TKE equations [m s-1]. + dQdz ! Half the partial derivative of TKE with depth [m s-2]. real, dimension(nz+1) :: & dK, & ! The change in kappa [Z2 s-1 ~> m2 s-1]. - dQ, & ! The change in TKE, in m2 s-2. + dQ, & ! The change in TKE [m2 s-2]. cQ, cK, & ! cQ and cK are the upward influences in the tridiagonal and ! hexadiagonal solvers for the TKE and kappa equations, ND. I_Ld2, & ! 1/Ld^2, where Ld is the effective decay length scale - ! for kappa, in units of Z-2. - TKE_decay, & ! The local TKE decay rate in s-1. - k_src, & ! The source term in the kappa equation, in s-1. - dQmdK, & ! With Newton's method the change in dQ(k-1) due to dK(k), m2 s Z-2. - dKdQ, & ! With Newton's method the change in dK(k) due to dQ(k), Z2 m-2 s-1. + ! for kappa [Z-2 ~> m-2]. + TKE_decay, & ! The local TKE decay rate [s-1]. + k_src, & ! The source term in the kappa equation [s-1]. + dQmdK, & ! With Newton's method the change in dQ(k-1) due to dK(k) [m2 s Z-2 ~> s]. + dKdQ, & ! With Newton's method the change in dK(k) due to dQ(k) [Z2 m-2 s-1 ~> s-1]. e1 ! The fractional change in a layer TKE due to a change in the ! TKE of the layer above when all the kappas below are 0. ! e1 is nondimensional, and 0 < e1 < 1. @@ -1435,10 +1432,10 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! stratification (i.e. proportional to N*tke), nondim. real :: Ri_crit ! The critical shear Richardson number for shear- ! driven mixing. The theoretical value is 0.25. - real :: q0 ! The background level of TKE, in m2 s-2. + real :: q0 ! The background level of TKE [m2 s-2]. real :: Ilambda2 ! 1.0 / CS%lambda**2. real :: TKE_min ! The minimum value of shear-driven TKE that can be - ! solved for, in m2 s-2. + ! solved for [m2 s-2]. real :: kappa0 ! The background diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. real :: max_err ! The maximum value of norm_err in a column, nondim. real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0, Z2 s-1. @@ -1446,7 +1443,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real :: eden1, eden2, I_eden, ome ! Variables used in calculating e1. real :: diffusive_src ! The diffusive source in the kappa equation, in m s-1. real :: chg_by_k0 ! The value of k_src that leads to an increase of - ! kappa_0 if only the diffusive term is a sink, in s-1. + ! kappa_0 if only the diffusive term is a sink [s-1]. real :: kappa_mean ! A mean value of kappa [Z2 s-1 ~> m2 s-1]. real :: Newton_test ! The value of relative error that will cause the next @@ -1484,7 +1481,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real :: K_err_lin, Q_err_lin real, dimension(nz+1) :: & kappa_prev, & ! The value of kappa at the start of the current iteration [Z2 s-1 ~> m2 s-1]. - TKE_prev ! The value of TKE at the start of the current iteration, in m2 s-2. + TKE_prev ! The value of TKE at the start of the current iteration [m2 s-2]. real, dimension(nz+1,1:max_debug_itt) :: & tke_it1, kappa_it1, kprev_it1, & ! Various values from each iteration. dkappa_it1, K_Q_it1, d_dkappa_it1, dkappa_norm_it1 diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 87e5408256..287c440d0d 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -42,7 +42,7 @@ module MOM_regularize_layers real :: h_def_tol4 !< The value of the relative thickness deficit at which to do !! detrainment from the buffer layers to the interior at full !! force, now 50% of the way from h_def_tol1 to 1. - real :: Hmix_min !< The minimum mixed layer thickness in H ~> m or kg m-2. + real :: Hmix_min !< The minimum mixed layer thickness [H ~> m or kg m-2]. type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. @@ -78,7 +78,7 @@ subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. @@ -86,11 +86,11 @@ subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: ea !< The amount of fluid moved downward into a !! layer; this should be increased due to mixed - !! layer detrainment, in H ~> m or kg m-2. + !! layer detrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: eb !< The amount of fluid moved upward into a layer !! this should be increased due to mixed layer - !! entrainment, in H ~> m or kg m-2. + !! entrainment [H ~> m or kg m-2]. type(regularize_layers_CS), pointer :: CS !< The control structure returned by a previous !! call to regularize_layers_init. ! Local variables @@ -116,7 +116,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. @@ -124,11 +124,11 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: ea !< The amount of fluid moved downward into a !! layer; this should be increased due to mixed - !! layer detrainment, in H ~> m or kg m-2. + !! layer detrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: eb !< The amount of fluid moved upward into a layer !! this should be increased due to mixed layer - !! entrainment, in H ~> m or kg m-2. + !! entrainment [H ~> m or kg m-2]. type(regularize_layers_CS), pointer :: CS !< The control structure returned by a previous !! call to regularize_layers_init. ! Local variables @@ -139,7 +139,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) real, dimension(SZI_(G),SZJ_(G)) :: & def_rat_h ! The ratio of the thickness deficit to the minimum depth, ND. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & - e ! The interface depths, in H ~> m or kg m-2, positive upward. + e ! The interface depths [H ~> m or kg m-2], positive upward. #ifdef DEBUG_CODE real, dimension(SZIB_(G),SZJ_(G)) :: & @@ -149,24 +149,24 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) real, dimension(SZI_(G),SZJB_(G)) :: & def_rat_h2, def_rat_h3 real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & - ef ! The filtered interface depths, in H ~> m or kg m-2, positive upward. + ef ! The filtered interface depths [H ~> m or kg m-2], positive upward. #endif real, dimension(SZI_(G),SZK_(G)+1) :: & - e_filt, e_2d ! The interface depths, in H ~> m or kg m-2, positive upward. + e_filt, e_2d ! The interface depths [H ~> m or kg m-2], positive upward. real, dimension(SZI_(G),SZK_(G)) :: & - h_2d, & ! A 2-d version of h, in H ~> m or kg m-2. + h_2d, & ! A 2-d version of h [H ~> m or kg m-2]. T_2d, & ! A 2-d version of tv%T, in deg C. S_2d, & ! A 2-d version of tv%S, in PSU. Rcv, & ! A 2-d version of the coordinate density, in kg m-3. - h_2d_init, & ! The initial value of h_2d, in H ~> m or kg m-2. + h_2d_init, & ! The initial value of h_2d [H ~> m or kg m-2]. T_2d_init, & ! THe initial value of T_2d, in deg C. S_2d_init, & ! The initial value of S_2d, in PSU. d_eb, & ! The downward increase across a layer in the entrainment from - ! below, in H ~> m or kg m-2. The sign convention is that positive values of + ! below [H ~> m or kg m-2]. The sign convention is that positive values of ! d_eb correspond to a gain in mass by a layer by upward motion. d_ea ! The upward increase across a layer in the entrainment from - ! above, in H ~> m or kg m-2. The sign convention is that positive values of + ! above [H ~> m or kg m-2]. The sign convention is that positive values of ! d_ea mean a net gain in mass by a layer from downward motion. real, dimension(SZI_(G)) :: & p_ref_cv, & ! Reference pressure for the potential density which defines @@ -178,15 +178,15 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) h_tot3, Th_tot3, Sh_tot3, & h_tot2, Th_tot2, Sh_tot2 real, dimension(SZK_(G)) :: & - h_prev_1d ! The previous thicknesses, in H ~> m or kg m-2. + h_prev_1d ! The previous thicknesses [H ~> m or kg m-2]. real :: I_dtol ! The inverse of the tolerance changes, nondim. real :: I_dtol34 ! The inverse of the tolerance changes, nondim. - real :: h1, h2 ! Temporary thicknesses, in H ~> m or kg m-2. - real :: e_e, e_w, e_n, e_s ! Temporary interface heights, in H ~> m or kg m-2. + real :: h1, h2 ! Temporary thicknesses [H ~> m or kg m-2]. + real :: e_e, e_w, e_n, e_s ! Temporary interface heights [H ~> m or kg m-2]. real :: wt ! The weight of the filted interfaces in setting the targets, ND. real :: scale ! A scaling factor, ND. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real, dimension(SZK_(G)+1) :: & int_flux, int_Tflux, int_Sflux, int_Rflux real :: h_add @@ -723,7 +723,7 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - intent(in) :: e !< Interface depths, in H ~> m or kg m-2 + intent(in) :: e !< Interface depths [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G)), & intent(out) :: def_rat_u !< The thickness deficit ratio at u points, !! nondim. @@ -742,24 +742,24 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & !! are aggregated into 1 layer, nondim. integer, optional, intent(in) :: halo !< An extra-wide halo size, 0 by default. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - optional, intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + optional, intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. !! If h is not present, vertical differences !! in interface heights are used instead. ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & - h_def_u, & ! The vertically summed thickness deficits at u-points, in H ~> m or kg m-2. + h_def_u, & ! The vertically summed thickness deficits at u-points [H ~> m or kg m-2]. h_norm_u, & ! The vertically summed arithmetic mean thickness by which - ! h_def_u is normalized, in H ~> m or kg m-2. + ! h_def_u is normalized [H ~> m or kg m-2]. h_def2_u real, dimension(SZI_(G),SZJB_(G)) :: & - h_def_v, & ! The vertically summed thickness deficits at v-points, in H ~> m or kg m-2. + h_def_v, & ! The vertically summed thickness deficits at v-points [H ~> m or kg m-2]. h_norm_v, & ! The vertically summed arithmetic mean thickness by which - ! h_def_v is normalized, in H ~> m or kg m-2. + ! h_def_v is normalized [H ~> m or kg m-2]. h_def2_v real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: Hmix_min ! CS%Hmix_min converted to units of H. - real :: h1, h2 ! Temporary thicknesses, in H ~> m or kg m-2. + real :: h1, h2 ! Temporary thicknesses [H ~> m or kg m-2]. integer :: i, j, k, is, ie, js, je, nz, nkmb is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 150554bca2..7293a43058 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -90,10 +90,10 @@ module MOM_set_diffusivity logical :: limit_dissipation !< If enabled, dissipation is limited to be larger !! than the following: - real :: dissip_min !< Minimum dissipation (Z2 m-2 W m-3 ~> W m-3) - real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N (Z2 m-2 W m-3 ~> W m-3) - real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N (Z2 m-2 W m-3 s ~> J m-3) - real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 (Z2 m-2 W m-3 s2 ~> J s m-3) + real :: dissip_min !< Minimum dissipation [Z2 m-2 W m-3 ~> W m-3] + real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N [Z2 m-2 W m-3 ~> W m-3] + real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N [Z2 m-2 W m-3 s ~> J m-3] + real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 [Z2 m-2 W m-3 s2 ~> J s m-3] real :: dissip_Kd_min !< Minimum Kd [Z2 s-1 ~> m2 s-1], with dissipation Rho0*Kd_min*N^2 real :: TKE_itide_max !< maximum internal tide conversion (W m-2) @@ -211,7 +211,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: u_h !< Zonal velocity interpolated to h points, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -670,7 +670,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available !! thermodynamic fields. real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: dRho_int !< Change in locally referenced potential density @@ -874,7 +874,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available !! thermodynamic fields. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -1051,7 +1051,7 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available !! thermodynamic fields; absent fields have NULL ptrs. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: T_f !< layer temp in C with the values in massless layers !! filled vertically by diffusion. @@ -1143,7 +1143,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available !! thermodynamic fields. type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes @@ -1537,7 +1537,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(forcing), intent(in) :: fluxes !< Surface fluxes structure type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -1672,7 +1672,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom !! boundary layer properies, and related fields. @@ -1804,7 +1804,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any !! available thermodynamic fields; absent !! fields have NULL ptrs. diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 3d5570ab3a..24f0a20130 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -53,8 +53,8 @@ module MOM_set_visc !! This might be Kv / (cdrag * drag_bg_vel) to give !! Kv as the minimum near-bottom viscosity. real :: Htbl_shelf !< A nominal thickness of the surface boundary layer for use - !! in calculating the near-surface velocity, in H ~> m or kg m-2. - real :: Htbl_shelf_min !< The minimum surface boundary layer thickness in H ~> m or kg m-2. + !! in calculating the near-surface velocity [H ~> m or kg m-2]. + real :: Htbl_shelf_min !< The minimum surface boundary layer thickness [H ~> m or kg m-2]. real :: KV_BBL_min !< The minimum viscosity in the bottom boundary layer [Z2 s-1 ~> m2 s-1]. real :: KV_TBL_min !< The minimum viscosity in the top boundary layer [Z2 s-1 ~> m2 s-1]. logical :: bottomdraglaw !< If true, the bottom stress is calculated with a @@ -113,7 +113,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs.. @@ -138,12 +138,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! layer with salinity, in units of kg m-3 psu-1. press ! The pressure at which dR_dT and dR_dS are evaluated, in Pa. real :: htot ! Sum of the layer thicknesses up to some - ! point, in H ~> m or kg m-2. + ! point [H ~> m or kg m-2]. real :: htot_vel ! Sum of the layer thicknesses up to some - ! point, in H ~> m or kg m-2. + ! point [H ~> m or kg m-2]. - real :: Rhtot ! Running sum of thicknesses times the - ! layer potential densities in H kg m-3. + real :: Rhtot ! Running sum of thicknesses times the layer potential + ! densities [H kg m-3 ~> kg m-2 or kg2 m-5]. real, dimension(SZIB_(G),SZJ_(G)) :: & D_u, & ! Bottom depth interpolated to u points, in depth units (m). mask_u ! A mask that disables any contributions from u points that @@ -155,9 +155,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real, dimension(SZIB_(G),SZK_(G)) :: & h_at_vel, & ! Layer thickness at a velocity point, using an upwind-biased ! second order accurate estimate based on the previous velocity - ! direction, in H ~> m or kg m-2. + ! direction [H ~> m or kg m-2]. h_vel, & ! Arithmetic mean of the layer thicknesses adjacent to a - ! velocity point, in H ~> m or kg m-2. + ! velocity point [H ~> m or kg m-2]. T_vel, & ! Arithmetic mean of the layer temperatures adjacent to a ! velocity point, in deg C. S_vel, & ! Arithmetic mean of the layer salinities adjacent to a @@ -166,7 +166,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! to a velocity point, in kg m-3. real :: h_vel_pos ! The arithmetic mean thickness at a velocity point - ! plus H_neglect to avoid 0 values, in H ~> m or kg m-2. + ! plus H_neglect to avoid 0 values [H ~> m or kg m-2]. real :: ustarsq ! 400 times the square of ustar, times ! Rho0 divided by G_Earth and the conversion ! from m to thickness units, in kg m-2 or kg2 m-5. @@ -175,12 +175,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: cdrag_sqrt ! Square root of the drag coefficient, nd. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, - ! divided by G_Earth, in H kg m-3. + ! divided by G_Earth [H kg m-3 ~> kg m-2 or kg2 m-5]. real :: Dfn ! The increment in oldfn for entraining - ! the layer, in H kg m-3. + ! the layer [H kg m-3 ~> kg m-2 or kg2 m-5]. real :: Dh ! The increment in layer thickness from - ! the present layer, in H ~> m or kg m-2. - real :: bbl_thick ! The thickness of the bottom boundary layer in H ~> m or kg m-2. + ! the present layer [H ~> m or kg m-2]. + real :: bbl_thick ! The thickness of the bottom boundary layer [H ~> m or kg m-2]. real :: bbl_thick_Z ! The thickness of the bottom boundary layer [Z ~> m]. real :: C2f ! C2f = 2*f at velocity points. @@ -189,13 +189,13 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! magnitude near the bottom for use in the ! quadratic bottom drag, in m2 s-2. real :: hwtot ! Sum of the thicknesses used to calculate - ! the near-bottom velocity magnitude, in H ~> m or kg m-2. + ! the near-bottom velocity magnitude [H ~> m or kg m-2]. real :: hutot ! Running sum of thicknesses times the - ! velocity magnitudes, in H m s-1 ~> m2 s-1 or kg m-1 s-1. - real :: Thtot ! Running sum of thickness times temperature, in H C. - real :: Shtot ! Running sum of thickness times salinity, in H psu. + ! velocity magnitudes [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + real :: Thtot ! Running sum of thickness times temperature [degC H ~> degC m or degC kg m-2]. + real :: Shtot ! Running sum of thickness times salinity [PSU H ~> PSU m or PSU kg m-2]. real :: hweight ! The thickness of a layer that is within Hbbl - ! of the bottom, in H ~> m or kg m-2. + ! of the bottom [H ~> m or kg m-2]. real :: v_at_u, u_at_v ! v at a u point or vice versa, m s-1. real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors, in kg s2 H m-3 Z-2. ! The 400 is a constant proposed by Killworth and Edwards, 1999. @@ -205,43 +205,43 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! density, in Pa (usually set to 2e7 Pa = 2000 dbar). ! The units H in the following are thickness units - typically m or kg m-2. - real :: D_vel ! The bottom depth at a velocity point, in H ~> m or kg m-2. - real :: Dp, Dm ! The depths at the edges of a velocity cell, in H ~> m or kg m-2. + real :: D_vel ! The bottom depth at a velocity point [H ~> m or kg m-2]. + real :: Dp, Dm ! The depths at the edges of a velocity cell [H ~> m or kg m-2]. real :: a ! a is the curvature of the bottom depth across a - ! cell, times the cell width squared, in H ~> m or kg m-2. - real :: a_3, a_12, C24_a ! a/3, a/12, and 24/a, in H ~> m or kg m-2, H, and H-1. + ! cell, times the cell width squared [H ~> m or kg m-2]. + real :: a_3, a_12, C24_a ! a/3, a/12, and 24/a [H ~> m or kg m-2], H, and H-1. real :: slope ! The absolute value of the bottom depth slope across - ! a cell times the cell width, in H ~> m or kg m-2. + ! a cell times the cell width [H ~> m or kg m-2]. real :: apb_4a, ax2_3apb ! Various nondimensional ratios of a and slope. real :: a2x48_apb3, Iapb, Ibma_2 ! Combinations of a and slope with units of H-1. ! All of the following "volumes" have units of meters as they are normalized ! by the full horizontal area of a velocity cell. - real :: Vol_open ! The cell volume above which it is open, in H ~> m or kg m-2. - real :: Vol_direct ! With less than Vol_direct (in H), there is a direct + real :: Vol_open ! The cell volume above which it is open [H ~> m or kg m-2]. + real :: Vol_direct ! With less than Vol_direct [H ~> m or kg m-2], there is a direct ! solution of a cubic equation for L. real :: Vol_2_reg ! The cell volume above which there are two separate - ! open areas that must be integrated, in H ~> m or kg m-2. + ! open areas that must be integrated [H ~> m or kg m-2]. real :: vol ! The volume below the interface whose normalized - ! width is being sought, in H ~> m or kg m-2. + ! width is being sought [H ~> m or kg m-2]. real :: vol_below ! The volume below the interface below the one that - ! is currently under consideration, in H ~> m or kg m-2. + ! is currently under consideration [H ~> m or kg m-2]. real :: Vol_err ! The error in the volume with the latest estimate of - ! L, or the error for the interface below, in H ~> m or kg m-2. - real :: Vol_quit ! The volume error below which to quit iterating, in H ~> m or kg m-2. - real :: Vol_tol ! A volume error tolerance, in H ~> m or kg m-2. + ! L, or the error for the interface below [H ~> m or kg m-2]. + real :: Vol_quit ! The volume error below which to quit iterating [H ~> m or kg m-2]. + real :: Vol_tol ! A volume error tolerance [H ~> m or kg m-2]. real :: L(SZK_(G)+1) ! The fraction of the full cell width that is open at ! the depth of each interface, nondimensional. real :: L_direct ! The value of L above volume Vol_direct, nondim. real :: L_max, L_min ! Upper and lower bounds on the correct value for L. real :: Vol_err_max ! The volume errors for the upper and lower bounds on - real :: Vol_err_min ! the correct value for L, in H ~> m or kg m-2. - real :: Vol_0 ! A deeper volume with known width L0, in H ~> m or kg m-2. + real :: Vol_err_min ! the correct value for L [H ~> m or kg m-2]. + real :: Vol_0 ! A deeper volume with known width L0 [H ~> m or kg m-2]. real :: L0 ! The value of L above volume Vol_0, nondim. - real :: dVol ! vol - Vol_0, in H ~> m or kg m-2. + real :: dVol ! vol - Vol_0 [H ~> m or kg m-2]. real :: dV_dL2 ! The partial derivative of volume with L squared - ! evaluated at L=L0, in H ~> m or kg m-2. + ! evaluated at L=L0 [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: ustH ! ustar converted to units of H s-1. real :: root ! A temporary variable with units of H s-1. @@ -913,7 +913,7 @@ function set_v_at_u(v, h, G, i, j, k, mask2dCv, OBC) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] integer, intent(in) :: i !< The i-index of the u-location to work on. integer, intent(in) :: j !< The j-index of the u-location to work on. integer, intent(in) :: k !< The k-index of the u-location to work on. @@ -923,8 +923,8 @@ function set_v_at_u(v, h, G, i, j, k, mask2dCv, OBC) real :: set_v_at_u !< The retur value of v at u points, in m s-1. ! This subroutine finds a thickness-weighted value of v at the u-points. - real :: hwt(0:1,-1:0) ! Masked weights used to average u onto v, in H ~> m or kg m-2. - real :: hwt_tot ! The sum of the masked thicknesses, in H ~> m or kg m-2. + real :: hwt(0:1,-1:0) ! Masked weights used to average u onto v [H ~> m or kg m-2]. + real :: hwt_tot ! The sum of the masked thicknesses [H ~> m or kg m-2]. integer :: i0, j0, i1, j1 do j0 = -1,0 ; do i0 = 0,1 ; i1 = i+i0 ; J1 = J+j0 @@ -956,7 +956,7 @@ function set_u_at_v(u, h, G, i, j, k, mask2dCu, OBC) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< The zonal velocity, in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] integer, intent(in) :: i !< The i-index of the u-location to work on. integer, intent(in) :: j !< The j-index of the u-location to work on. integer, intent(in) :: k !< The k-index of the u-location to work on. @@ -966,8 +966,8 @@ function set_u_at_v(u, h, G, i, j, k, mask2dCu, OBC) real :: set_u_at_v !< The return value of u at v points, in m s-1. ! This subroutine finds a thickness-weighted value of u at the v-points. - real :: hwt(-1:0,0:1) ! Masked weights used to average u onto v, in H ~> m or kg m-2. - real :: hwt_tot ! The sum of the masked thicknesses, in H ~> m or kg m-2. + real :: hwt(-1:0,0:1) ! Masked weights used to average u onto v [H ~> m or kg m-2]. + real :: hwt_tot ! The sum of the masked thicknesses [H ~> m or kg m-2]. integer :: i0, j0, i1, j1 do j0 = 0,1 ; do i0 = -1,0 ; I1 = I+i0 ; j1 = j+j0 @@ -1007,7 +1007,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available !! thermodynamic fields. Absent fields have !! NULL ptrs. @@ -1023,27 +1023,25 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! Local variables real, dimension(SZIB_(G)) :: & htot, & ! The total depth of the layers being that are within the - ! surface mixed layer, in H ~> m or kg m-2. + ! surface mixed layer [H ~> m or kg m-2]. Thtot, & ! The integrated temperature of layers that are within the - ! surface mixed layer, in H degC. + ! surface mixed layer [H degC ~> m degC or kg degC m-2] Shtot, & ! The integrated salt of layers that are within the - ! surface mixed layer H PSU. + ! surface mixed layer [H PSU ~> m PSU or kg PSU m-2]. Rhtot, & ! The integrated density of layers that are within the - ! surface mixed layer, in H kg m-3. Rhtot is only used if no + ! surface mixed layer, [H kg m-3 ~> kg m-2 or kg2 m-5]. Rhtot is only used if no ! equation of state is used. uhtot, & ! The depth integrated zonal and meridional velocities within - vhtot, & ! the surface mixed layer, in H m s-1 ~> m2 s-1 or kg m-1 s-1. - Idecay_len_TKE, & ! The inverse of a turbulence decay length scale, in H-1 ~> m-1 or m2 kg-1. + vhtot, & ! the surface mixed layer [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + Idecay_len_TKE, & ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. dR_dT, & ! Partial derivative of the density at the base of layer nkml - ! (roughly the base of the mixed layer) with temperature, in - ! units of kg m-3 K-1. + ! (roughly the base of the mixed layer) with temperature [kg m-3 K-1]. dR_dS, & ! Partial derivative of the density at the base of layer nkml - ! (roughly the base of the mixed layer) with salinity, in units - ! of kg m-3 psu-1. + ! (roughly the base of the mixed layer) with salinity [kg m-3 psu-1]. ustar, & ! The surface friction velocity under ice shelves [Z s-1 ~> m s-1]. press, & ! The pressure at which dR_dT and dR_dS are evaluated, in Pa. - T_EOS, & ! T_EOS and S_EOS are the potential temperature and salnity at which dR_dT and dR_dS - S_EOS ! which dR_dT and dR_dS are evaluated, in degC and PSU. + T_EOS, & ! The potential temperature at which dR_dT and dR_dS are evaluated [degC] + S_EOS ! The salinity at which dR_dT and dR_dS are evaluated [PSU]. real, dimension(SZIB_(G),SZJ_(G)) :: & mask_u ! A mask that disables any contributions from u points that ! are land or past open boundary conditions, nondim., 0 or 1. @@ -1052,26 +1050,26 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! are land or past open boundary conditions, nondim., 0 or 1. real :: h_at_vel(SZIB_(G),SZK_(G))! Layer thickness at velocity points, ! using an upwind-biased second order accurate estimate based - ! on the previous velocity direction, in H ~> m or kg m-2. + ! on the previous velocity direction [H ~> m or kg m-2]. integer :: k_massive(SZIB_(G)) ! The k-index of the deepest layer yet found ! that has more than h_tiny thickness and will be in the ! viscous mixed layer. real :: Uh2 ! The squared magnitude of the difference between the velocity ! integrated through the mixed layer and the velocity of the - ! interior layer layer times the depth of the the mixed layer, - ! in H2 m2 s-2. + ! interior layer layer times the depth of the the mixed layer + ! [H2 m2 s-2 ~> m4 s-2 or kg2 m-2 s-2]. real :: htot_vel ! Sum of the layer thicknesses up to some - ! point, in H ~> m or kg m-2. + ! point [H ~> m or kg m-2]. real :: hwtot ! Sum of the thicknesses used to calculate - ! the near-bottom velocity magnitude, in H ~> m or kg m-2. + ! the near-bottom velocity magnitude [H ~> m or kg m-2]. real :: hutot ! Running sum of thicknesses times the - ! velocity magnitudes, in H m s-1 ~> m2 s-1 or kg m-1 s-1. + ! velocity magnitudes [H m s-1 ~> m2 s-1 or kg m-1 s-1]. real :: hweight ! The thickness of a layer that is within Hbbl - ! of the bottom, in H ~> m or kg m-2. + ! of the bottom [H ~> m or kg m-2]. real :: tbl_thick_Z ! The thickness of the top boundary layer [Z ~> m]. - real :: hlay ! The layer thickness at velocity points, in H ~> m or kg m-2. - real :: I_2hlay ! 1 / 2*hlay, in H-1 ~> m-1 or m2 kg-1. + real :: hlay ! The layer thickness at velocity points [H ~> m or kg m-2]. + real :: I_2hlay ! 1 / 2*hlay [H-1 ~> m-1 or m2 kg-1]. real :: T_lay ! The layer temperature at velocity points, in deg C. real :: S_lay ! The layer salinity at velocity points, in PSU. real :: Rlay ! The layer potential density at velocity points, in kg m-3. @@ -1096,23 +1094,23 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real :: cdrag_sqrt ! Square root of the drag coefficient, ND. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, - ! divided by G_Earth, in H kg m-3. + ! divided by G_Earth [H kg m-3 ~> kg m-2 or kg2 m-5]. real :: Dfn ! The increment in oldfn for entraining - ! the layer, in H kg m-3. + ! the layer [H kg m-3 ~> kg m-2 or kg2 m-5]. real :: Dh ! The increment in layer thickness from - ! the present layer, in H ~> m or kg m-2. + ! the present layer [H ~> m or kg m-2]. real :: U_bg_sq ! The square of an assumed background velocity, for ! calculating the mean magnitude near the top for use in ! the quadratic surface drag, in m2 s-2. - real :: h_tiny ! A very small thickness, in H ~> m or kg m-2. Layers that are less than + real :: h_tiny ! A very small thickness [H ~> m or kg m-2]. Layers that are less than ! h_tiny can not be the deepest in the viscous mixed layer. real :: absf ! The absolute value of f averaged to velocity points, s-1. real :: U_star ! The friction velocity at velocity points [Z s-1 ~> m s-1]. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors, in kg s2 H m-3 Z-2. ! The 400 is a constant proposed by Killworth and Edwards, 1999. - real :: ustar1 ! ustar in H s-1 ~> m s-1 or kg m-2 s-1 + real :: ustar1 ! ustar [H s-1 ~> m s-1 or kg m-2 s-1] real :: h2f2 ! (h*2*f)^2 logical :: use_EOS, do_any, do_any_shelf, do_i(SZIB_(G)) integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, K2, nkmb, nkml, n diff --git a/src/parameterizations/vertical/MOM_shortwave_abs.F90 b/src/parameterizations/vertical/MOM_shortwave_abs.F90 index fe1d8f302c..a1b7ef6e1c 100644 --- a/src/parameterizations/vertical/MOM_shortwave_abs.F90 +++ b/src/parameterizations/vertical/MOM_shortwave_abs.F90 @@ -48,7 +48,7 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + real, dimension(SZI_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(:,:,:), intent(in) :: opacity_band !< Opacity in each band of !! penetrating shortwave radiation (1/H). !! The indicies are band, i, k. @@ -83,9 +83,9 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, !! nsw x SZI_(G). real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: eps !< Small thickness that must remain in !! each layer, and which will not be - !! subject to heating (H ~> m or kg m-2) + !! subject to heating [H ~> m or kg m-2] integer, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: ksort !< Density-sorted k-indicies. - real, dimension(SZI_(G)), optional, intent(in) :: htot !< Total mixed layer thickness, in H ~> m or kg m-2. + real, dimension(SZI_(G)), optional, intent(in) :: htot !< Total mixed layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G)), optional, intent(inout) :: Ttot !< Depth integrated mixed layer !! temperature (units of K H). real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: dSV_dT !< The partial derivative of specific @@ -103,7 +103,7 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, ! radiation that hits the bottom. real, dimension(SZI_(G)) :: & h_heat, & ! The thickness of the water column that will be heated by - ! any remaining shortwave radiation (H ~> m or kg m-2). + ! any remaining shortwave radiation [H ~> m or kg m-2]. T_chg, & ! The temperature change of thick layers due to the remaining ! shortwave radiation and contributions from T_chg_above, in K. Pen_SW_rem ! The sum across all wavelength bands of the penetrating shortwave @@ -129,7 +129,7 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, ! efficiency, instead of continuing to penetrate, in units ! of K H s-1. The default, 2.5e-11, is about 0.08 K m / century. real :: epsilon ! A small thickness that must remain in each - ! layer, and which will not be subject to heating (H ~> m or kg m-2) + ! layer, and which will not be subject to heating [H ~> m or kg m-2] real :: I_G_Earth real :: g_Hconv2 logical :: SW_Remains ! If true, some column has shortwave radiation that @@ -303,7 +303,7 @@ subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(:,:,:), intent(in) :: opacity_band !< opacity in each band of !! penetrating shortwave radiation, !! in m-1. The indicies are band, i, k. @@ -313,7 +313,7 @@ subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & real, intent(in) :: dt !< Time step (seconds). real, intent(in) :: H_limit_fluxes !< the total depth at which the !! surface fluxes start to be limited to avoid - !! excessive heating of a thin ocean (H ~> m or kg m-2) + !! excessive heating of a thin ocean [H ~> m or kg m-2] logical, intent(in) :: absorbAllSW !< If true, ensure that all shortwave !! radiation is absorbed in the ocean water column. real, dimension(:,:), intent(in) :: iPen_SW_bnd !< The incident penetrating shortwave @@ -325,7 +325,7 @@ subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & !! interface, summed across all bands, in K H. ! Local variables real :: h_heat(SZI_(G)) ! thickness of the water column that receives - ! remaining shortwave radiation, in H ~> m or kg m-2. + ! remaining shortwave radiation [H ~> m or kg m-2]. real :: Pen_SW_rem(SZI_(G)) ! sum across all wavelength bands of the ! penetrating shortwave heating that hits the bottom ! and will be redistributed through the water column @@ -338,7 +338,7 @@ subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & ! not absorbed because the layers are too thin. real :: Ih_limit ! inverse of the total depth at which the ! surface fluxes start to be limited (1/H units) - real :: h_min_heat ! minimum thickness layer that should get heated (H ~> m or kg m-2) + real :: h_min_heat ! minimum thickness layer that should get heated [H ~> m or kg m-2] real :: opt_depth ! optical depth of a layer (non-dim) real :: exp_OD ! exp(-opt_depth) (non-dim) logical :: SW_Remains ! If true, some column has shortwave radiation that diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index 1ddfa2d172..ddcc379406 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -321,16 +321,16 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] real, intent(in) :: dt !< The amount of time covered by this call, in s. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: ea !< An array to which the amount of fluid entrained !! from the layer above during this call will be - !! added, in H ~> m or kg m-2. + !! added [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: eb !< An array to which the amount of fluid entrained !! from the layer below during this call will be - !! added, in H ~> m or kg m-2. + !! added [H ~> m or kg m-2]. type(sponge_CS), pointer :: CS !< A pointer to the control structure for this module !! that is set by a previous call to initialize_sponge. real, dimension(SZI_(G),SZJ_(G)), & @@ -343,7 +343,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & w_int, & ! Water moved upward across an interface within a timestep, - ! in H ~> m or kg m-2. + ! [H ~> m or kg m-2]. e_D ! Interface heights that are dilated to have a value of 0 ! at the surface, in the same units as G%bathyT (m or Z). real, dimension(SZI_(G), SZJ_(G)) :: & @@ -356,8 +356,8 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) real, allocatable, dimension(:,:,:) :: & fld_mean_anom ! THe i-mean tracer concentration anomalies. real, dimension(SZI_(G), SZK_(G)+1) :: & - h_above, & ! The total thickness above an interface, in H ~> m or kg m-2. - h_below ! The total thickness below an interface, in H ~> m or kg m-2. + h_above, & ! The total thickness above an interface [H ~> m or kg m-2]. + h_below ! The total thickness below an interface [H ~> m or kg m-2]. real, dimension(SZI_(G)) :: & dilate ! A nondimensional factor by which to dilate layers to ! give 0 at the surface. @@ -368,11 +368,11 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) ! profile must be stretched for the free surfaces ! heights in the two profiles to agree. real :: w ! The thickness of water moving upward through an - ! interface within 1 timestep, in H ~> m or kg m-2. - real :: wm ! wm is w if w is negative and 0 otherwise, in H ~> m or kg m-2. - real :: wb ! w at the interface below a layer, in H ~> m or kg m-2. - real :: wpb ! wpb is wb if wb is positive and 0 otherwise, in H ~> m or kg m-2. - real :: ea_k, eb_k ! in H ~> m or kg m-2 + ! interface within 1 timestep [H ~> m or kg m-2]. + real :: wm ! wm is w if w is negative and 0 otherwise [H ~> m or kg m-2]. + real :: wb ! w at the interface below a layer [H ~> m or kg m-2]. + real :: wpb ! wpb is wb if wb is positive and 0 otherwise [H ~> m or kg m-2]. + real :: ea_k, eb_k ! [H ~> m or kg m-2] real :: damp ! The timestep times the local damping coefficient. ND. real :: I1pdamp ! I1pdamp is 1/(1 + damp). Nondimensional. real :: damp_1pdamp ! damp_1pdamp is damp/(1 + damp). Nondimensional. diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 15918e3795..b49f17771b 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -658,7 +658,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, C type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy !! frequency, in s-2. real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< The squared buoyancy frequency of the @@ -708,7 +708,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: N2_int !< The squared buoyancy !! frequency at the interfaces, in s-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: Kd_lay!< The diapycnal diffusivities in the layers [Z2 s-1 ~> m2 s-1]. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface @@ -930,7 +930,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy frequency !! frequency, in s-2. real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< The squared buoyancy frequency of the @@ -971,7 +971,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, ! multiplied by N2_bot/N2_meanz to be coherent with the WKB scaled z ! z*=int(N2/N2_bot) * N2_bot/N2_meanz = int(N2/N2_meanz) ! z0_Polzin_scaled = z0_Polzin * N2_bot/N2_meanz - N2_meanz, & ! vertically averaged squared buoyancy frequency (1/s2) for WKB scaling + N2_meanz, & ! vertically averaged squared buoyancy frequency [s-2] for WKB scaling TKE_itidal_rem, & ! remaining internal tide TKE (from barotropic source) TKE_Niku_rem, & ! remaining lee-wave TKE TKE_lowmode_rem, & ! remaining internal tide TKE (from propagating low mode source) (BDM) @@ -985,13 +985,13 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, real :: I_rho0 ! 1 / RHO0, (m3/kg) real :: Kd_add ! diffusivity to add in a layer [Z2 s-1 ~> m2 s-1]. real :: TKE_itide_lay ! internal tide TKE imparted to a layer (from barotropic) (m3/s3) - real :: TKE_Niku_lay ! lee-wave TKE imparted to a layer (m3/s3) + real :: TKE_Niku_lay ! lee-wave TKE imparted to a layer [m3 s-3] real :: TKE_lowmode_lay ! internal tide TKE imparted to a layer (from low mode) (m3/s3) (BDM) real :: frac_used ! fraction of TKE that can be used in a layer (nondim) real :: Izeta ! inverse of TKE decay scale [Z-1 ~> m-1]. real :: Izeta_lee ! inverse of TKE decay scale for lee waves [Z-1 ~> m-1]. - real :: z0_psl ! temporary variable with units of Z ~> m. - real :: TKE_lowmode_tot ! TKE from all low modes (W/m2) (BDM) + real :: z0_psl ! temporary variable [Z ~> m]. + real :: TKE_lowmode_tot ! TKE from all low modes [W m-2] (BDM) logical :: use_Polzin, use_Simmons character(len=160) :: mesg ! The text of an error message @@ -1421,7 +1421,7 @@ subroutine post_tidal_diagnostics(G, GV, h ,CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(tidal_mixing_cs), pointer :: CS !< The control structure for this module ! local diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index efcb533dce..f8aa0bd7b4 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -39,7 +39,7 @@ module MOM_vert_friction type, public :: vertvisc_CS ; private real :: Hmix !< The mixed layer thickness in thickness units (H). real :: Hmix_stress !< The mixed layer thickness over which the wind - !! stress is applied with direct_stress, in H ~> m or kg m-2. + !! stress is applied with direct_stress [H ~> m or kg m-2]. real :: Kvml !< The mixed layer vertical viscosity in m2 s-1. real :: Kv !< The interior vertical viscosity in m2 s-1. real :: Hbbl !< The static bottom boundary layer thickness, in m. @@ -153,7 +153,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(inout) :: v !< Meridional velocity in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thickness in H ~> m or kg m-2 + intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces type(vertvisc_type), intent(inout) :: visc !< Viscosities and bottom drag real, intent(in) :: dt !< Time increment in s @@ -180,7 +180,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! while b1 has units of inverse thickness. real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver, ND. real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity [Z s-1 ~> m s-1]. - real :: b_denom_1 ! The first term in the denominator of b1, in H ~> m or kg m-2. + real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. real :: Hmix ! The mixed layer thickness over which stress ! is applied with direct_stress, translated into @@ -579,7 +579,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in) :: v !< Meridional velocity in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thickness in H ~> m or kg m-2 + intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces type(vertvisc_type), intent(in) :: visc !< Viscosities and bottom drag real, intent(in) :: dt !< Time increment in s @@ -597,8 +597,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) ! given by 2*(h+ * h-)/(h+ + h-), in m or kg m-2 (H for short). h_arith, & ! The arithmetic mean thickness, in m or kg m-2. h_delta, & ! The lateral difference of thickness, in m or kg m-2. - hvel, & ! hvel is the thickness used at a velocity grid point, in H ~> m or kg m-2. - hvel_shelf ! The equivalent of hvel under shelves, in H ~> m or kg m-2. + hvel, & ! hvel is the thickness used at a velocity grid point [H ~> m or kg m-2]. + hvel_shelf ! The equivalent of hvel under shelves [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZK_(G)+1) :: & a_cpl, & ! The drag coefficients across interfaces [Z s-1 ~> m s-1]. a_cpl times ! the velocity difference gives the stress across an interface. @@ -615,7 +615,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) ! of H-1 (i.e., m-1 or m2 kg-1). zcol1, & ! The height of the interfaces to the north and south of a zcol2, & ! v-point, in m or kg m-2. - Ztop_min, & ! The deeper of the two adjacent surface heights, in H ~> m or kg m-2. + Ztop_min, & ! The deeper of the two adjacent surface heights [H ~> m or kg m-2]. Dmin, & ! The shallower of the two adjacent bottom depths converted to ! thickness units, in m or kg m-2. zh, & ! An estimate of the interface's distance from the bottom @@ -625,16 +625,16 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) real, allocatable, dimension(:,:) :: hML_v ! Diagnostic of the mixed layer depth at v points, in m. real, allocatable, dimension(:,:,:) :: Kv_u !< Total vertical viscosity at u-points, in m2 s-1. real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points, in m2 s-1. - real :: zcol(SZI_(G)) ! The height of an interface at h-points, in H ~> m or kg m-2. + real :: zcol(SZI_(G)) ! The height of an interface at h-points [H ~> m or kg m-2]. real :: botfn ! A function which goes from 1 at the bottom to 0 much more ! than Hbbl into the interior. real :: topfn ! A function which goes from 1 at the top to 0 much more ! than Htbl into the interior. real :: z2 ! The distance from the bottom, normalized by Hbbl, nondim. real :: z2_wt ! A nondimensional (0-1) weight used when calculating z2. - real :: z_clear ! The clearance of an interface above the surrounding topography, in H ~> m or kg m-2. + real :: z_clear ! The clearance of an interface above the surrounding topography [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: I_valBL ! The inverse of a scaling factor determining when water is ! still within the boundary layer, as determined by the sum @@ -1049,18 +1049,18 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, real, dimension(SZIB_(G),SZK_(GV)+1), & intent(out) :: a_cpl !< Coupling coefficient across interfaces [Z s-1 ~> m s-1]. real, dimension(SZIB_(G),SZK_(GV)), & - intent(in) :: hvel !< Thickness at velocity points, in H ~> m or kg m-2 + intent(in) :: hvel !< Thickness at velocity points [H ~> m or kg m-2] logical, dimension(SZIB_(G)), & intent(in) :: do_i !< If true, determine coupling coefficient for a column real, dimension(SZIB_(G),SZK_(GV)), & intent(in) :: h_harm !< Harmonic mean of thicknesses around a velocity - !! grid point, in H ~> m or kg m-2 - real, dimension(SZIB_(G)), intent(in) :: bbl_thick !< Bottom boundary layer thickness, in H ~> m or kg m-2 + !! grid point [H ~> m or kg m-2] + real, dimension(SZIB_(G)), intent(in) :: bbl_thick !< Bottom boundary layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity [Z2 s-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZK_(GV)+1), & intent(in) :: z_i !< Estimate of interface heights above the bottom, !! normalized by the bottom boundary layer thickness - real, dimension(SZIB_(G)), intent(out) :: h_ml !< Mixed layer depth, in H ~> m or kg m-2 + real, dimension(SZIB_(G)), intent(out) :: h_ml !< Mixed layer depth [H ~> m or kg m-2] integer, intent(in) :: j !< j-index to find coupling coefficient for real, intent(in) :: dt !< Time increment, in s type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure @@ -1077,7 +1077,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, real, dimension(SZIB_(G)) :: & u_star, & ! ustar at a velocity point [Z s-1 ~> m s-1]. absf, & ! The average of the neighboring absolute values of f, in s-1. -! h_ml, & ! The mixed layer depth, in m or kg m-2. +! h_ml, & ! The mixed layer depth [H ~> m or kg m-2]. nk_visc, & ! The (real) interface index of the base of mixed layer. z_t, & ! The distance from the top, sometimes normalized ! by Hmix, in H or nondimensional. @@ -1085,16 +1085,16 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, tbl_thick real, dimension(SZIB_(G),SZK_(GV)) :: & Kv_add ! A viscosity to add [Z2 s-1 ~> m2 s-1]. - real :: h_shear ! The distance over which shears occur, in H ~> m or kg m-2. - real :: r ! A thickness to compare with Hbbl, in H ~> m or kg m-2. + real :: h_shear ! The distance over which shears occur [H ~> m or kg m-2]. + real :: r ! A thickness to compare with Hbbl [H ~> m or kg m-2]. real :: visc_ml ! The mixed layer viscosity [Z2 s-1 ~> m2 s-1]. - real :: I_Hmix ! The inverse of the mixed layer thickness, in H-1 ~> m-1 or m2 kg-1. + real :: I_Hmix ! The inverse of the mixed layer thickness [H-1 ~> m-1 or m2 kg-1]. real :: a_ml ! The layer coupling coefficient across an interface in ! the mixed layer, in m s-1. real :: I_amax ! The inverse of the maximum coupling coefficient [Z-1 ~> m-1].??? - real :: temp1 ! A temporary variable in H Z + real :: temp1 ! A temporary variable [H Z ~> m2 or kg m-1] real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: z2 ! A copy of z_i, nondim. real :: topfn real :: a_top @@ -1366,7 +1366,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(inout) :: v !< Meridional velocity in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thickness in H ~> m or kg m-2 + intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(accel_diag_ptrs), intent(in) :: ADp !< Acceleration diagnostic pointers type(cont_diag_ptrs), intent(in) :: CDp !< Continuity diagnostic pointers type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 7cb83ca557..80b56aad6c 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -148,7 +148,7 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & logical, intent(in) :: restart !< .true. if the fields have already !! been read from a restart file. type(time_type), target, intent(in) :: day !< Time of the start of the run. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< Structure used to regulate diagnostic output. type(ocean_OBC_type), pointer :: OBC !< Structure specifying open boundary options. type(DOME_tracer_CS), pointer :: CS !< The control structure returned by a previous @@ -176,7 +176,7 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & real :: tr_y ! Initial zonally uniform tracer concentrations. real :: dist2 ! The distance squared from a line, in m2. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in H ~> m or kg m-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: e(SZK_(G)+1), e_top, e_bot ! Heights [Z ~> m]. real :: d_tr ! A change in tracer concentraions, in tracer units. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index 3ef9f3dbe2..ee558399b9 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -318,7 +318,7 @@ subroutine initialize_OCMIP2_CFC(restart, day, G, GV, US, h, diag, OBC, CS, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] !! (usually m or kg m-2). type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. @@ -362,7 +362,7 @@ end subroutine initialize_OCMIP2_CFC subroutine init_tracer_CFC(h, tr, name, land_val, IC_val, G, US, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: tr !< The tracer concentration array character(len=*), intent(in) :: name !< The tracer name real, intent(in) :: land_val !< A value the tracer takes over land @@ -496,7 +496,7 @@ function OCMIP2_CFC_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] !! (usually m or kg m-2). real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount !! of each tracer, in kg times diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 997bfce9a4..f59f76fd21 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -231,7 +231,7 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(diag_ctrl), target, intent(in) :: diag !< Regulates diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies whether, @@ -600,7 +600,7 @@ end subroutine MOM_generic_tracer_column_physics function MOM_generic_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< The mass-weighted integrated amount of each !! tracer, in kg times concentration units. type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. @@ -750,7 +750,7 @@ subroutine MOM_generic_tracer_surface_state(state, h, G, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(surface), intent(inout) :: state !< A structure containing fields that !! describe the surface state of the ocean. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. ! Local variables diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index babb8d43e8..bb8b483f5f 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -168,7 +168,7 @@ module MOM_offline_main real, allocatable, dimension(:,:) :: netMassIn !< Freshwater fluxes into the ocean real, allocatable, dimension(:,:) :: netMassOut !< Freshwater fluxes out of the ocean - real, allocatable, dimension(:,:) :: mld !< Mixed layer depths at thickness points, in H ~> m or kg m-2. + real, allocatable, dimension(:,:) :: mld !< Mixed layer depths at thickness points [H ~> m or kg m-2]. ! Allocatable arrays to read in entire fields during initialization real, allocatable, dimension(:,:,:,:) :: uhtr_all !< Entire field of zonal transport @@ -749,7 +749,7 @@ subroutine offline_fw_fluxes_into_ocean(G, GV, CS, fluxes, h, in_flux_optional) type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(forcing), intent(inout) :: fluxes !< Surface fluxes container real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thickness in H ~> m or kg m-2 + intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: in_flux_optional !< The total time-integrated amount !! of tracer that leaves with freshwater @@ -799,7 +799,7 @@ subroutine offline_fw_fluxes_out_ocean(G, GV, CS, fluxes, h, out_flux_optional) type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(forcing), intent(inout) :: fluxes !< Surface fluxes container real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thickness in H ~> m or kg m-2 + intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: out_flux_optional !< The total time-integrated amount !! of tracer that leaves with freshwater diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index 9bdaa2aac6..b1f5c8cdae 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -34,7 +34,7 @@ function tracer_Z_init(tr, h, filename, tr_name, G, US, missing_val, land_val) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: tr !< The tracer to initialize real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] character(len=*), intent(in) :: filename !< The name of the file to read from character(len=*), intent(in) :: tr_name !< The name of the tracer in the file ! type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 34808f8127..ab80d00481 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -328,11 +328,11 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(tracer_type), dimension(ntr), intent(inout) :: Tr !< The array of registered tracers to work on real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hprev !< cell volume at the end of previous - !! tracer change, in H m2 ~> m3 or kg + !! tracer change [H m2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhr !< accumulated volume/mass flux through - !! the zonal face, in H m2 ~> m3 or kg + !! the zonal face [H m2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: uh_neglect !< A tiny zonal mass flux that can - !! be neglected, in H m2 ~> m3 or kg + !! be neglected [H m2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used logical, dimension(SZJ_(G),SZK_(G)), intent(inout) :: domore_u !< If true, there is more advection to be !! done in this u-row @@ -656,11 +656,11 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(tracer_type), dimension(ntr), intent(inout) :: Tr !< The array of registered tracers to work on real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hprev !< cell volume at the end of previous - !! tracer change, in H m2 ~> m3 or kg + !! tracer change [H m2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhr !< accumulated volume/mass flux through - !! the meridional face, in H m2 ~> m3 or kg + !! the meridional face [H m2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vh_neglect !< A tiny meridional mass flux that can - !! be neglected, in H m2 ~> m3 or kg + !! be neglected [H m2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used logical, dimension(SZJB_(G),SZK_(G)), intent(inout) :: domore_v !< If true, there is more advection to be !! done in this v-row diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index 42420b2c6b..22a8c98ca5 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -230,7 +230,7 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Tr !< Tracer concentration on T-cell real, intent(in ) :: dt !< Time-step over which forcing is applied (s) type(forcing), intent(in ) :: fluxes !< Surface fluxes container - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, intent(in ) :: evap_CFL_limit !< Limit on the fraction of the !! water that can be fluxed out of the top !! layer in a timestep (nondim) @@ -250,9 +250,9 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim real :: fractionOfForcing, hOld, Ithickness real :: RivermixConst ! A constant used in implementing river mixing, in Pa s. real, dimension(SZI_(G)) :: & - netMassInOut, & ! surface water fluxes (H ~> m or kg m-2) over time step - netMassIn, & ! mass entering ocean surface (H ~> m or kg m-2) over a time step - netMassOut ! mass leaving ocean surface (H ~> m or kg m-2) over a time step + netMassInOut, & ! surface water fluxes [H ~> m or kg m-2] over time step + netMassIn, & ! mass entering ocean surface [H ~> m or kg m-2] over a time step + netMassOut ! mass leaving ocean surface [H ~> m or kg m-2] over a time step real, dimension(SZI_(G), SZK_(G)) :: h2d, Tr2d real, dimension(SZI_(G),SZJ_(G)) :: in_flux ! The total time-integrated amount of tracer! @@ -318,7 +318,7 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim ! We aggregate the thermodynamic forcing for a time step into the following: ! These should have been set and stored during a call to applyBoundaryFluxesInOut ! netMassIn = net mass entering at ocean surface over a timestep - ! netMassOut = net mass leaving ocean surface (H ~> m or kg m-2) over a time step. + ! netMassOut = net mass leaving ocean surface [H ~> m or kg m-2] over a time step. ! netMassOut < 0 means mass leaves ocean. ! Note here that the aggregateFW flag has already been taken care of in the call to diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index c350142c8e..728b2170dc 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -279,7 +279,7 @@ subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid !! structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] !! (usually m or kg m-2) type(param_file_type), intent(in) :: param_file !< A structure to parse for !! run-time parameters @@ -598,7 +598,7 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni num_stocks, stock_index, got_min_max, global_min, global_max, & xgmin, ygmin, zgmin, xgmax, ygmax, zgmax) real, dimension(NIMEM_,NJMEM_,NKMEM_), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] !! (usually m or kg m-2). real, dimension(:), intent(out) :: stock_values !< The integrated amounts of a tracer !! on the current PE, usually in kg x concentration. @@ -798,7 +798,7 @@ subroutine call_tracer_surface_state(state, h, G, CS) type(surface), intent(inout) :: state !< A structure containing fields that !! describe the surface state of the ocean. real, dimension(NIMEM_,NJMEM_,NKMEM_), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] !! (usually m or kg m-2). type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 77de7eb11d..288c7e2ce1 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -587,7 +587,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & real, dimension(SZK_(G)) :: & h_demand_L, & ! The thickness in the left (_L) or right (_R) column that - h_demand_R, & ! is demanded to match the thickness in the counterpart, in H ~> m or kg m-2. + h_demand_R, & ! is demanded to match the thickness in the counterpart [H ~> m or kg m-2]. h_used_L, & ! The summed thickness from the left or right columns that h_used_R, & ! have actually been used, in m or kg m-2 (H). h_supply_frac_L, & ! The fraction of the demanded thickness that can diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 74727bf7bd..e815ca656e 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -171,7 +171,7 @@ subroutine initialize_advection_test_tracer(restart, day, G, GV, h,diag, OBC, CS type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies @@ -354,7 +354,7 @@ end subroutine advection_test_tracer_surface_state !! If the stock_index is present, only the stock corresponding to that coded index is returned. function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 1facf4a9f5..a218f6ea9e 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -156,7 +156,7 @@ subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies @@ -287,7 +287,7 @@ end subroutine boundary_impulse_tracer_column_physics function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in ) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent( out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units. type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 2a90d059b5..e0fe85c362 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -191,7 +191,7 @@ subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_C type(time_type), target, intent(in) :: day !< Time of the start of the run. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< Structure used to regulate diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary @@ -329,7 +329,7 @@ end subroutine dye_tracer_column_physics !! returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. function dye_stock(h, stocks, G, GV, CS, names, units, stock_index) - real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of !! each tracer, in kg times concentration units. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index 3ca18d3e95..20c35644db 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -138,7 +138,7 @@ subroutine initialize_dyed_obc_tracer(restart, day, G, GV, h, diag, OBC, CS, dia logical, intent(in) :: restart !< .true. if the fields have already !! been read from a restart file. type(time_type), target, intent(in) :: day !< Time of the start of the run. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< Structure used to regulate diagnostic output. type(ocean_OBC_type), pointer :: OBC !< Structure specifying open boundary options. type(dyed_obc_tracer_CS), pointer :: CS !< The control structure returned by a previous diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index 46e5ed4b75..0788c45c7e 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -203,7 +203,7 @@ subroutine initialize_ideal_age_tracer(restart, day, G, GV, US, h, diag, OBC, CS type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies @@ -375,7 +375,7 @@ end subroutine ideal_age_tracer_column_physics function ideal_age_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 7126f27b0e..c6eff02a02 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -210,7 +210,7 @@ subroutine initialize_oil_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies @@ -408,7 +408,7 @@ end subroutine oil_tracer_column_physics function oil_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units. type(oil_tracer_CS), pointer :: CS !< The control structure returned by a previous diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index 336ab77bb7..621d57af8b 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -121,7 +121,7 @@ subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies @@ -254,7 +254,7 @@ end subroutine pseudo_salt_tracer_column_physics function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units. type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 6345493d48..6a928d448d 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -144,7 +144,7 @@ subroutine USER_initialize_tracer(restart, day, G, GV, h, diag, OBC, CS, & type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies @@ -364,7 +364,7 @@ function USER_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units. type(USER_tracer_example_CS), pointer :: CS !< The control structure returned by a @@ -411,7 +411,7 @@ subroutine USER_tracer_surface_state(state, h, G, CS) type(surface), intent(inout) :: state !< A structure containing fields that !! describe the surface state of the ocean. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(USER_tracer_example_CS), pointer :: CS !< The control structure returned by a previous !! call to register_USER_tracer. diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index a29188cd16..3b42e595dc 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -38,7 +38,7 @@ module BFB_initialization subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) real, dimension(NKMEM_), intent(out) :: Rlay !< Layer potential density. real, dimension(NKMEM_), intent(out) :: g_prime !< The reduced gravity at - !! each interface, in m2 Z-1 s-2 ~> m s-2. + !! each interface [m2 Z-1 s-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(EOS_type), pointer :: eqn_of_state !< Integer that selects the @@ -86,13 +86,13 @@ subroutine BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, para type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(sponge_CS), pointer :: CSp !< A pointer to the sponge control structure real, dimension(NIMEM_, NJMEM_, NKMEM_), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2 + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] ! Local variables - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in depth units (Z ~> m). + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in depth units [Z ~> m]. real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. - real :: H0(SZK_(G)) ! Resting layer thicknesses in depth units (Z ~> m). - real :: min_depth ! The minimum ocean depth in depth units (Z ~> m). + real :: H0(SZK_(G)) ! Resting layer thicknesses in depth units [Z ~> m]. + real :: min_depth ! The minimum ocean depth in depth units [Z ~> m]. real :: damp, e_dense, damp_new, slat, wlon, lenlat, lenlon, nlat character(len=40) :: mdl = "BFB_initialize_sponges_southonly" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 63d9d2c690..41d65bb050 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -95,17 +95,17 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, US, param_file, just_read_par type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. + intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(GV)) ! The resting interface heights, in depth units (Z ~> m), usually + real :: e0(SZK_(GV)) ! The resting interface heights, in depth units [Z ~> m], usually ! negative because it is positive upward. real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface - ! positive upward, in depth units (Z ~> m). + ! positive upward, in depth units [Z ~> m]. integer :: i, j, k, is, ie, js, je, nz real :: x real :: delta_h @@ -227,7 +227,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature (degC) real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity (ppt) - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, optional, intent(in) :: just_read_params !< If present and true, this call will diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 701ef59e72..3df0d0402d 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -91,7 +91,7 @@ subroutine DOME_initialize_thickness(h, G, GV, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. + intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -267,7 +267,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) real :: tr_0, y1, y2, tr_k, rst, rsb, rc, v_k, lon_im1 real :: D_edge ! The thickness [Z ~> m], of the dense fluid at the ! inner edge of the inflow. - real :: g_prime_tot ! The reduced gravity across all layers, in m2 Z-1 s-2 ~> m s-2. + real :: g_prime_tot ! The reduced gravity across all layers [m2 Z-1 s-2 ~> m s-2]. real :: Def_Rad ! The deformation radius, based on fluid of ! thickness D_edge, in the same units as lat. real :: Ri_trans ! The shear Richardson number in the transition diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 477890ad1e..47c65d60b9 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -135,7 +135,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, US, param_file, tv, just_read type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. + intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any @@ -144,10 +144,10 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, US, param_file, tv, just_read logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z ~> m), + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units [Z ~> m], ! usually negative because it is positive upward. real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in depth units (Z ~> m). + ! positive upward, in depth units [Z ~> m]. integer :: i, j, k, is, ie, js, je, nz, tmp1 real :: x real :: rho_range @@ -254,7 +254,7 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature (degC) real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity (ppt) - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -262,7 +262,7 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, ! Local variables integer :: i, j, k, is, ie, js, je, nz, itt real :: x, ds, dt, rho_sur, rho_bot - real :: xi0, xi1 ! Heights in depth units (Z ~> m). + real :: xi0, xi1 ! Heights in depth units [Z ~> m]. real :: S_sur, T_sur, S_bot, T_bot real :: dT_dz, dS_dz ! Gradients of T and S in degC/Z and PPT/Z. real :: z ! vertical position in z space diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 22c4a1d7fb..483ee043d5 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -175,7 +175,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness, in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness [H ~> m or kg m-2]. type(time_type), intent(in) :: Time !< model time. ! The following variables are used to set up the transport in the Kelvin example. diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index ab34e3fa96..3bd2c35553 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -104,7 +104,7 @@ module MOM_wave_interface !! Horizontal -> V points !! 3rd dimension -> Freq/Wavenumber real, allocatable, dimension(:,:,:), public :: & - KvS !< Viscosity for Stokes Drift shear (Z2/s ~> m2 s-1) + KvS !< Viscosity for Stokes Drift shear [Z2/s ~> m2 s-1] ! Pointers to auxiliary fields type(time_type), pointer, public :: Time !< A pointer to the ocean model's clock. @@ -873,7 +873,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & !! LA outputs are desired that are different than !! those used by the dynamical model. real, dimension(SZK_(GV)), optional, & - intent(in) :: H !< Grid layer thickness in H ~> m or kg m-2 + intent(in) :: H !< Grid layer thickness [H ~> m or kg m-2] real, dimension(SZK_(GV)), optional, & intent(in) :: U_H !< Zonal velocity at H point (m/s) real, dimension(SZK_(GV)), optional, & diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index 05e0eac1ba..842cbea0e9 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -115,7 +115,7 @@ subroutine Neverland_initialize_thickness(h, G, GV, US, param_file, eqn_of_state type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(out), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< The thickness that is being - !! initialized, in H ~> m or kg m-2. + !! initialized [H ~> m or kg m-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open !! file to parse for model !! parameter values. @@ -124,7 +124,7 @@ subroutine Neverland_initialize_thickness(h, G, GV, US, param_file, eqn_of_state real, intent(in) :: P_Ref !< The coordinate-density !! reference pressure in Pa. ! Local variables - real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z ~> m), + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units [Z ~> m], ! usually negative because it is positive upward. real, dimension(SZK_(G)) :: h_profile ! Vector of initial thickness profile [Z ~> m]. real :: e_interface ! Current interface position [Z ~> m]. diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 1f29307a10..ae21cd0d17 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -99,7 +99,7 @@ subroutine Phillips_initialize_thickness(h, G, GV, US, param_file, just_read_par enddo ; enddo do j=js,je ; do i=is,ie - ! This sets the initial thickness (in H ~> m or kg m-2) of the layers. The + ! This sets the initial thickness in [H ~> m or kg m-2] of the layers. The ! thicknesses are set to insure that: 1. each layer is at least an Angstrom thick, and ! 2. the interfaces are where they should be based on the resting depths and interface ! height perturbations, as long at this doesn't interfere with 1. @@ -210,7 +210,7 @@ subroutine Phillips_initialize_sponges(G, GV, US, tv, param_file, CSp, h) type(sponge_CS), pointer :: CSp !< A pointer that is set to point to !! the control structure for the !! sponge module. - real, intent(in), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< Thickness field, in H ~> m or kg m-2. + real, intent(in), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< Thickness field [H ~> m or kg m-2]. ! Local variables real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces. diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index 4a6dc73867..c0616b1497 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -55,7 +55,7 @@ module SCM_CVMix_tests subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read_params) real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(out) :: T !< Potential temperature (degC) real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(out) :: S !< Salinity (psu) - real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(in) :: h !< Layer thickness in H ~> m or kg m-2 + real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -65,13 +65,13 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read_par ! Local variables real :: UpperLayerTempMLD !< Upper layer Temp MLD thickness [Z ~> m]. real :: UpperLayerSaltMLD !< Upper layer Salt MLD thickness [Z ~> m]. - real :: UpperLayerTemp !< Upper layer temperature (SST if thickness 0) (deg C) - real :: UpperLayerSalt !< Upper layer salinity (SSS if thickness 0) (PPT) - real :: LowerLayerTemp !< Temp at top of lower layer (deg C) - real :: LowerLayerSalt !< Salt at top of lower layer (PPT) - real :: LowerLayerdTdz !< Temp gradient in lower layer, in degC / Z ~> degC m-1. - real :: LowerLayerdSdz !< Salt gradient in lower layer, in PPT / Z ~> PPT m-1. - real :: LowerLayerMinTemp !< Minimum temperature in lower layer + real :: UpperLayerTemp !< Upper layer temperature (SST if thickness 0) [degC] + real :: UpperLayerSalt !< Upper layer salinity (SSS if thickness 0) [ppt] + real :: LowerLayerTemp !< Temp at top of lower layer [degC] + real :: LowerLayerSalt !< Salt at top of lower layer [ppt] + real :: LowerLayerdTdz !< Temp gradient in lower layer [degC / Z ~> degC m-1]. + real :: LowerLayerdSdz !< Salt gradient in lower layer [ppt / Z ~> ppt m-1]. + real :: LowerLayerMinTemp !< Minimum temperature in lower layer [degC] real :: zC, DZ, top, bottom ! Depths and thicknesses [Z ~> m]. logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index 8ed670b8a5..28033d8799 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -37,16 +37,16 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. + intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units (Z ~> m), usually + real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units [Z ~> m], usually ! negative because it is positive upward. real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface - ! positive upward, in depth units (Z ~> m). + ! positive upward, in depth units [Z ~> m]. real :: x, y, yy, delta_S_strat, dSdz, delta_S, S_ref real :: min_thickness, adjustment_width, adjustment_delta, adjustment_deltaS real :: front_wave_amp, front_wave_length, front_wave_asym @@ -188,7 +188,7 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, G, GV, param_file type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< The temperature that is being initialized. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< The salinity that is being initialized. - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< The model thicknesses in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< The model thicknesses [H ~> m or kg m-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for model parameter values. type(EOS_type), pointer :: eqn_of_state !< Equation of state. diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index f237c1b857..6ae086006a 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -88,7 +88,7 @@ subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. + intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. type(EOS_type), pointer :: eqn_of_state !< integer that selects the @@ -98,16 +98,16 @@ subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units (Z ~> m), + real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units [Z ~> m], ! usually negative because it is positive upward. real :: e_pert(SZK_(GV)+1) ! Interface height perturbations, positive upward, - ! in depth units (Z ~> m). + ! in depth units [Z ~> m]. real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface - ! positive upward, in depth units (Z ~> m). + ! positive upward, in depth units [Z ~> m]. real :: SST ! The initial sea surface temperature, in deg C. real :: T_int ! The initial temperature of an interface, in deg C. - real :: ML_depth ! The specified initial mixed layer depth, in depth units (Z ~> m). - real :: thermocline_scale ! The e-folding scale of the thermocline, in depth units (Z ~> m). + real :: ML_depth ! The specified initial mixed layer depth, in depth units [Z ~> m]. + real :: thermocline_scale ! The e-folding scale of the thermocline, in depth units [Z ~> m]. real, dimension(SZK_(GV)) :: T0, pres, S0, rho_guess, drho, drho_dT, drho_dS real :: a_exp ! The fraction of the overall stratification that is exponential. real :: I_ts, I_md ! Inverse lengthscales [Z-1 ~> m-1]. @@ -173,7 +173,7 @@ subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state do k=1,nz ; e_pert(K) = 0.0 ; enddo - ! This sets the initial thickness (in H ~> m or kg m-2) of the layers. The thicknesses + ! This sets the initial thickness (in [H ~> m or kg m-2]) of the layers. The thicknesses ! are set to insure that: 1. each layer is at least Gv%Angstrom_m thick, and ! 2. the interfaces are where they should be based on the resting depths and interface ! height perturbations, as long at this doesn't interfere with 1. diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index f83b9f696f..4372586820 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -32,17 +32,17 @@ subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_para type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. + intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units (Z ~> m), usually + real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units [Z ~> m], usually ! negative because it is positive upward. real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface - ! positive upward, in depth units (Z ~> m). - real :: IC_amp ! The amplitude of the initial height displacement, in H ~> m or kg m-2. + ! positive upward, in depth units [Z ~> m]. + real :: IC_amp ! The amplitude of the initial height displacement [H ~> m or kg m-2]. real :: diskrad, rad, xCenter, xRadius, lonC, latC, xOffset logical :: just_read ! This include declares and sets the variable "version". diff --git a/src/user/external_gwave_initialization.F90 b/src/user/external_gwave_initialization.F90 index b601b1c842..2ef3ca2fb7 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -30,7 +30,7 @@ subroutine external_gwave_initialize_thickness(h, G, GV, US, param_file, just_re type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. + intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will diff --git a/src/user/lock_exchange_initialization.F90 b/src/user/lock_exchange_initialization.F90 index 7be5cb9571..064d5465bd 100644 --- a/src/user/lock_exchange_initialization.F90 +++ b/src/user/lock_exchange_initialization.F90 @@ -28,7 +28,7 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, US, param_file, just_rea type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. + intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 2e7ae74628..ea26d12b58 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -82,7 +82,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, US, param_file, just_read_p type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. + intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -197,7 +197,7 @@ subroutine seamount_initialize_temperature_salinity ( T, S, h, G, GV, param_file type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature (degC) real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity (ppt) - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness in H ~> m or kg m-2 + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, optional, intent(in) :: just_read_params !< If present and true, this call will diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index a4b7f2135b..d49264920d 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -58,7 +58,7 @@ subroutine sloshing_initialize_thickness ( h, G, GV, US, param_file, just_read_p type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. + intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -182,7 +182,7 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature (degC). real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity (ppt). - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index e4e2d6995c..033a8f0e52 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -33,7 +33,7 @@ subroutine soliton_initialize_thickness(h, G, GV, US) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in H ~> m or kg m-2. + intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. integer :: i, j, k, is, ie, js, je, nz real :: x, y, x0, y0 diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index 18975d4ec0..9438e0d4f9 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -47,7 +47,7 @@ module user_change_diffusivity subroutine user_change_diff(h, tv, G, GV, CS, Kd_lay, Kd_int, T_f, S_f, Kd_int_add) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in H ~> m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers !! to any available thermodynamic !! fields. Absent fields have NULL ptrs. diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index bd22e61116..754cff9f39 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -42,7 +42,7 @@ subroutine USER_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) !! structure. real, dimension(:), intent(out) :: Rlay !< Layer potential density. real, dimension(:), intent(out) :: g_prime !< The reduced gravity at - !! each interface, in m2 Z-1 s-2 ~> m s-2. + !! each interface [m2 Z-1 s-2 ~> m s-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. @@ -83,7 +83,7 @@ subroutine USER_initialize_thickness(h, G, GV, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thicknesses being initialized, in H ~> m or kg m-2. + intent(out) :: h !< The thicknesses being initialized [H ~> m or kg m-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open !! file to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -99,7 +99,7 @@ subroutine USER_initialize_thickness(h, G, GV, param_file, just_read_params) if (just_read) return ! All run-time parameters have been read, so return. - h(:,:,1) = 0.0 ! h should be set in H ~> m or kg m-2. + h(:,:,1) = 0.0 ! h should be set [H ~> m or kg m-2]. if (first_call) call write_user_log(param_file) @@ -179,7 +179,7 @@ subroutine USER_initialize_sponges(G, GV, use_temp, tv, param_file, CSp, h) !! parameter values. type(sponge_CS), pointer :: CSp !< A pointer to the sponge control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thicknesses, in H ~> m or kg m-2. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. call MOM_error(FATAL, & "USER_initialization.F90, USER_initialize_sponges: " // & "Unmodified user routine called - you must edit the routine to use it") @@ -244,10 +244,10 @@ end subroutine write_user_log !! here are: !! - u - Zonal velocity in m s-1. !! - v - Meridional velocity in m s-1. -!! - h - Layer thickness in H ~> m or kg m-2. (Must be positive.) +!! - h - Layer thickness [H ~> m or kg m-2]. (Must be positive.) !! - G%bathyT - Basin depth [Z ~> m]. (Must be positive.) !! - G%CoriolisBu - The Coriolis parameter, in s-1. -!! - GV%g_prime - The reduced gravity at each interface, in m2 Z-1 s-2 ~> m s-2. +!! - GV%g_prime - The reduced gravity at each interface [m2 Z-1 s-2 ~> m s-2]. !! - GV%Rlay - Layer potential density (coordinate variable), kg m-3. !! If ENABLE_THERMODYNAMICS is defined: !! - T - Temperature in C. From e424e0b7369d7c96d60d1cd86f1838e7a79d9f25 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 20 Dec 2018 05:06:38 -0500 Subject: [PATCH 0966/1072] Document additional thickness variable units Documented additional thickness variable units and their unscaled equivalents. Also eliminated several redundant argument documentation blocks. Only comments have been changed and all answers are bitwise identical. --- .../lateral/MOM_hor_visc.F90 | 5 +- .../lateral/MOM_internal_tides.F90 | 1 - .../lateral/MOM_lateral_mixing_coeffs.F90 | 20 +-- .../lateral/MOM_thickness_diffuse.F90 | 28 ++-- .../vertical/MOM_ALE_sponge.F90 | 34 ++--- .../vertical/MOM_CVMix_conv.F90 | 2 +- .../vertical/MOM_CVMix_ddiff.F90 | 6 +- .../vertical/MOM_CVMix_shear.F90 | 2 +- .../vertical/MOM_bkgnd_mixing.F90 | 12 +- .../vertical/MOM_bulk_mixed_layer.F90 | 142 ++++-------------- .../vertical/MOM_diabatic_aux.F90 | 19 +-- .../vertical/MOM_diapyc_energy_req.F90 | 8 +- .../vertical/MOM_entrain_diffusive.F90 | 110 +++----------- .../vertical/MOM_set_diffusivity.F90 | 2 +- .../vertical/MOM_set_viscosity.F90 | 17 +-- .../vertical/MOM_shortwave_abs.F90 | 14 +- .../vertical/MOM_vert_friction.F90 | 38 +++-- 17 files changed, 142 insertions(+), 318 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 6d359183b5..22aae5f7dc 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -184,7 +184,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, intent(in) :: v !< The meridional velocity, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - !! (usually m or kg m-2). real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: diffu !< Zonal acceleration due to convergence of !! along-coordinate stress tensor (m/s2) @@ -254,8 +253,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, ! points where masks are applied [H ~> m or kg m-2]. real :: hq ! harmonic mean of the harmonic means of the u- & v- poing thicknesses, ! [H ~> m or kg m-2]; This form guarantees that hq/hu < 4. - real :: h_neglect ! thickness so small it can be lost in roundoff and so neglected (H) - real :: h_neglect3 ! h_neglect^3, in H3 + real :: h_neglect ! thickness so small it can be lost in roundoff and so neglected [H ~> m or kg m-2] + real :: h_neglect3 ! h_neglect^3 [H3 ~> m3 or kg3 m-6] real :: hrat_min ! minimum thicknesses at the 4 neighboring ! velocity points divided by the thickness at the stress ! point (h or q point) (nondimensional) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 64a7bd0405..fc2430b4e5 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -158,7 +158,6 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - !! (usually m or kg m-2). type(thermo_var_ptrs), intent(in) :: tv !< Pointer to thermodynamic variables !! (needed for wave structure). real, dimension(SZI_(G),SZJ_(G)), intent(in) :: TKE_itidal_input !< The energy input to the diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index a7b0a75f15..18fc6beecb 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -132,7 +132,7 @@ module MOM_lateral_mixing_coeffs !> Calculates and stores the non-dimensional resolution functions subroutine calc_resoln_function(h, tv, G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -382,7 +382,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, intent(in) :: dt !< Time increment (s) type(VarMix_CS), pointer :: CS !< Variable mixing coefficients @@ -423,7 +423,7 @@ end subroutine calc_slope_functions subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: slope_x !< Zonal isoneutral slope real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: N2_u !< Brunt-Vaisala frequency at u-points (1/s2) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: slope_y !< Meridional isoneutral slope @@ -434,8 +434,8 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) real :: Khth_Loc ! Locally calculated thickness mixing coefficient (m2/s) real :: S2 ! Interface slope squared (non-dim) real :: N2 ! Brunt-Vaisala frequency (1/s) - real :: Hup, Hdn ! Thickness from above, below (m or kg m-2) - real :: H_geom ! The geometric mean of Hup*Hdn, in m or kg m-2. + real :: Hup, Hdn ! Thickness from above, below [H ~> m or kg m-2] + real :: H_geom ! The geometric mean of Hup*Hdn [H ~> m or kg m-2]. integer :: is, ie, js, je, nz integer :: i, j, k, kb_max real :: S2max, wNE, wSE, wSW, wNW @@ -575,7 +575,7 @@ end subroutine calc_Visbeck_coeffs !! interface positions only, not accounting for density variations. subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slopes) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(VarMix_CS), pointer :: CS !< Variable mixing coefficients @@ -586,16 +586,16 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop real :: E_x(SZIB_(G), SZJ_(G)) ! X-slope of interface at u points (for diagnostics) real :: E_y(SZI_(G), SZJB_(G)) ! Y-slope of interface at v points (for diagnostics) real :: Khth_Loc ! Locally calculated thickness mixing coefficient (m2/s) - real :: H_cutoff ! Local estimate of a minimum thickness for masking (m) + real :: H_cutoff ! Local estimate of a minimum thickness for masking [H ~> m or kg m-2] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: S2 ! Interface slope squared (non-dim) real :: N2 ! Brunt-Vaisala frequency (1/s) - real :: Hup, Hdn ! Thickness from above, below (m or kg m-2) - real :: H_geom ! The geometric mean of Hup*Hdn, in m or kg m-2. + real :: Hup, Hdn ! Thickness from above, below [H ~> m or kg m-2] + real :: H_geom ! The geometric mean of Hup*Hdn [H ~> m or kg m-2]. real :: Z_to_L ! A conversion factor between from units for e to the ! units for lateral distances. - real :: one_meter ! One meter in thickness units of m or kg m-2. + real :: one_meter ! One meter in thickness units [H ~> m or kg m-2]. integer :: is, ie, js, je, nz integer :: i, j, k, kb_max real :: SN_u_local(SZIB_(G), SZJ_(G),SZK_(G)) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 750108610a..59972f95fe 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -82,7 +82,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux (m2 H) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux (m2 H) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure @@ -123,8 +123,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp real, dimension(:,:), pointer :: cg1 => null() !< Wave speed (m/s) logical :: use_VarMix, Resoln_scaled, use_stored_slopes, khth_use_ebt_struct integer :: i, j, k, is, ie, js, je, nz - real :: hu(SZI_(G), SZJ_(G)) ! u-thickness (H) - real :: hv(SZI_(G), SZJ_(G)) ! v-thickness (H) + real :: hu(SZI_(G), SZJ_(G)) ! u-thickness [H ~> m or kg m-2] + real :: hv(SZI_(G), SZJ_(G)) ! v-thickness [H ~> m or kg m-2] real :: KH_u_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities (m2/sec) real :: KH_v_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities (m2/sec) @@ -1195,8 +1195,8 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (H) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions (Z) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions [Z ~> m] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kh_u !< Thickness diffusivity on interfaces !! at u points (m2/s) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: Kh_v !< Thickness diffusivity on interfaces @@ -1624,20 +1624,16 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) !! 0 by default ! Local variables real :: ent(SZI_(G),SZK_(G)+1) ! The diffusive entrainment (kappa*dt)/dz - ! between layers in a timestep in m or kg m-2. + ! between layers in a timestep [H ~> m or kg m-2]. real :: b1(SZI_(G)), d1(SZI_(G)) ! b1, c1, and d1 are variables used by the real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. - real :: kap_dt_x2 ! The product of 2*kappa*dt, converted to - ! the same units as h, in m2 or kg2 m-4. - real :: h0 ! A negligible thickness, in m or kg m-2, to - ! allow for zero thicknesses. - real :: h_neglect ! A thickness that is so small it is usually - ! lost in roundoff and can be neglected - ! (m for Bouss and kg/m^2 for non-Bouss). - ! 0 < h_neglect << h0. + real :: kap_dt_x2 ! The product of 2*kappa*dt [H2 ~> m2 or kg2 m-4]. + real :: h0 ! A negligible thickness to allow for zero + ! thicknesses [H ~> m or kg m-2]. + real :: h_neglect ! A thickness that is so small it is usually lost in roundoff + ! and can be neglected [H ~> m or kg m-2]. 0 < h_neglect << h0. real :: h_tr ! h_tr is h at tracer points with a tiny thickness - ! added to ensure positive definiteness - ! (m for Bouss, kg/m^2 for non-Bouss) + ! added to ensure positive definiteness [H ~> m or kg m-2]. integer :: i, j, k, is, ie, js, je, nz, halo halo=0 ; if (present(halo_here)) halo = max(halo_here,0) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 61930040df..c896da03f0 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -110,9 +110,9 @@ module MOM_ALE_sponge integer, pointer :: col_i_v(:) => NULL() !< Array of the i-indicies of each v-columns being damped. integer, pointer :: col_j_v(:) => NULL() !< Array of the j-indicies of each v-columns being damped. - real, pointer :: Iresttime_col(:) => NULL() !< The inverse restoring time of each tracer column. - real, pointer :: Iresttime_col_u(:) => NULL() !< The inverse restoring time of each u-column. - real, pointer :: Iresttime_col_v(:) => NULL() !< The inverse restoring time of each v-column. + real, pointer :: Iresttime_col(:) => NULL() !< The inverse restoring time of each tracer column [s-1]. + real, pointer :: Iresttime_col_u(:) => NULL() !< The inverse restoring time of each u-column [s-1]. + real, pointer :: Iresttime_col_v(:) => NULL() !< The inverse restoring time of each v-column [s-1]. type(p3d) :: var(MAX_FIELDS_) !< Pointers to the fields that are being damped. type(p2d) :: Ref_val(MAX_FIELDS_) !< The values to which the fields are damped. @@ -139,25 +139,25 @@ module MOM_ALE_sponge !! points are included in the sponges. It also stores the target interface heights. subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_data) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). - integer, intent(in) :: nz_data !< The total number of sponge input layers (in). - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time, in s-1 (in). + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + integer, intent(in) :: nz_data !< The total number of sponge input layers. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time [s-1]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file - !! to parse for model parameter values (in). + !! to parse for model parameter values. type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module (in/out). real, dimension(SZI_(G),SZJ_(G),nz_data), intent(in) :: data_h !< The thicknesses of the sponge - !! input layers, in thickness units (H). + !! input layers [H ~> m or kg m-2]. ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_sponge" ! This module's name. logical :: use_sponge - real, allocatable, dimension(:,:,:) :: data_hu !< thickness at u points - real, allocatable, dimension(:,:,:) :: data_hv !< thickness at v points - real, allocatable, dimension(:,:) :: Iresttime_u !< inverse of the restoring time at u points, s-1 - real, allocatable, dimension(:,:) :: Iresttime_v !< inverse of the restoring time at v points, s-1 + real, allocatable, dimension(:,:,:) :: data_hu !< thickness at u points [H ~> m or kg m-2] + real, allocatable, dimension(:,:,:) :: data_hv !< thickness at v points [H ~> m or kg m-2] + real, allocatable, dimension(:,:) :: Iresttime_u !< inverse of the restoring time at u points [s-1] + real, allocatable, dimension(:,:) :: Iresttime_v !< inverse of the restoring time at v points [s-1] logical :: bndExtrapolation = .true. ! If true, extrapolate boundaries integer :: i, j, k, col, total_sponge_cols, total_sponge_cols_u, total_sponge_cols_v character(len=10) :: remapScheme @@ -374,10 +374,10 @@ end subroutine get_ALE_sponge_thicknesses !! points are included in the sponges. subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time, in s-1 (in). + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time [s-1]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse - !! for model parameter values (in). + !! for model parameter values. type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module (in/out). @@ -387,8 +387,8 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) #include "version_variable.h" character(len=40) :: mdl = "MOM_sponge" ! This module's name. logical :: use_sponge - real, allocatable, dimension(:,:) :: Iresttime_u !< inverse of the restoring time at u points, s-1 - real, allocatable, dimension(:,:) :: Iresttime_v !< inverse of the restoring time at v points, s-1 + real, allocatable, dimension(:,:) :: Iresttime_u !< inverse of the restoring time at u points [s-1] + real, allocatable, dimension(:,:) :: Iresttime_v !< inverse of the restoring time at v points [s-1] logical :: bndExtrapolation = .true. ! If true, extrapolate boundaries integer :: i, j, k, col, total_sponge_cols, total_sponge_cols_u, total_sponge_cols_v character(len=10) :: remapScheme diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 215c1c4dbf..4bb0bd726c 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -152,7 +152,7 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. type(CVMix_conv_cs), pointer :: CS !< The control structure returned !! by a previous call to CVMix_conv_init. diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index 7f01b39378..7dd4ad7675 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -167,15 +167,15 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_T !< Interface double diffusion diapycnal !! diffusivity for temp (Z2/sec). real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_S !< Interface double diffusion diapycnal !! diffusivity for salt (Z2/sec). - type(CVMix_ddiff_cs), pointer :: CS !< The control structure returned + type(CVMix_ddiff_cs), pointer :: CS !< The control structure returned !! by a previous call to CVMix_ddiff_init. - integer, intent(in) :: j !< Meridional grid indice. + integer, intent(in) :: j !< Meridional grid indice. ! Local variables real, dimension(SZK_(G)) :: & cellHeight, & !< Height of cell centers (m) diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 6402eec3be..7ba09a935a 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -62,7 +62,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: u_H !< Initial zonal velocity on T points, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: v_H !< Initial meridional velocity on T points, in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface !! (not layer!) [Z2 s-1 ~> m2 s-1]. diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 848f434d2e..27d7d3e046 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -66,7 +66,7 @@ module MOM_bkgnd_mixing !! are in the range of -2 to 2; 0.4 reproduces CM2M. real :: Kdml !< mixed layer diapycnal diffusivity (Z2/s) !! when bulkmixedlayer==.false. - real :: Hmix !< mixed layer thickness (Z) when bulkmixedlayer==.false. + real :: Hmix !< mixed layer thickness [Z ~> m] when bulkmixedlayer==.false. logical :: Kd_tanh_lat_fn !< If true, use the tanh dependence of Kd_sfc on !! latitude, like GFDL CM2.1/CM2M. There is no !! physical justification for this form, and it can @@ -385,10 +385,10 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< squared buoyancy frequency associated - !! with layers (1/s2) + !! with layers [s-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: kd_lay !< Diapycnal diffusivity of each layer !! [Z2 s-1 ~> m2 s-1]. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface @@ -401,9 +401,9 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, US, CS) real, dimension(SZK_(G)+1) :: depth_int !< distance from surface of the interfaces (m) real, dimension(SZK_(G)+1) :: Kd_col !< Diffusivities at the interfaces (m2 s-1) real, dimension(SZK_(G)+1) :: Kv_col !< Viscosities at the interfaces (m2 s-1) - real, dimension(SZI_(G)) :: depth !< distance from surface of an interface (Z) - real :: depth_c !< depth of the center of a layer (Z) - real :: I_Hmix !< inverse of fixed mixed layer thickness (1/Z) + real, dimension(SZI_(G)) :: depth !< distance from surface of an interface [Z ~> m] + real :: depth_c !< depth of the center of a layer [Z ~> m] + real :: I_Hmix !< inverse of fixed mixed layer thickness [Z-1 ~> m-1] real :: I_2Omega !< 1/(2 Omega) (sec) real :: N_2Omega real :: N02_N2 diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 49d02ca800..4f223cb35a 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -179,15 +179,13 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h_3d !< Layer thickness, in m or kg m-2. - !! (Intent in/out) The units of h are - !! referred to as H below. + intent(inout) :: h_3d !< Layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: u_3d !< Zonal velocities interpolated to h points, - !! m s-1. + intent(in) :: u_3d !< Zonal velocities interpolated to h points + !! [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: v_3d !< Zonal velocities interpolated to h points, - !! m s-1. + intent(in) :: v_3d !< Zonal velocities interpolated to h points + !! [m s-1]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent !! fields have NULL ptrs. @@ -198,13 +196,11 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: ea !< The amount of fluid moved downward into a !! layer; this should be increased due to - !! mixed layer detrainment, in the same units - !! as h - usually m or kg m-2 (i.e., H). + !! mixed layer detrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: eb !< The amount of fluid moved upward into a !! layer; this should be increased due to - !! mixed layer entrainment, in the same units - !! as h - usually m or kg m-2 (i.e., H). + !! mixed layer entrainment [H ~> m or kg m-2]. type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a !! previous call to mixedlayer_init. type(optics_type), pointer :: optics !< The structure containing the inverse of the @@ -275,8 +271,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C netMassInOut, & ! The net mass flux (if non-Boussinsq) or volume flux (if ! Boussinesq - i.e. the fresh water flux (P+R-E)) into the ! ocean over a time step [H ~> m or kg m-2]. - NetMassOut, & ! The mass flux (if non-Boussinesq) or volume flux (if - ! Boussinesq) over a time step from evaporating fresh water (H) + NetMassOut, & ! The mass flux (if non-Boussinesq) or volume flux (if Boussinesq) + ! over a time step from evaporating fresh water [H ~> m or kg m-2] Net_heat, & ! The net heating at the surface over a time step in K H. Any ! penetrating shortwave radiation is not included in Net_heat. Net_salt, & ! The surface salt flux into the ocean over a time step, psu H. @@ -1027,7 +1023,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! Local variables real, dimension(SZI_(G)) :: & massOutRem, & ! Evaporation that remains to be supplied [H ~> m or kg m-2]. - netMassIn ! mass entering through ocean surface (H) + netMassIn ! mass entering through ocean surface [H ~> m or kg m-2] real :: SW_trans ! The fraction of shortwave radiation ! that is not absorbed in a layer, ND. real :: Pen_absorbed ! The amount of penetrative shortwave radiation @@ -1304,8 +1300,8 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G)), intent(in) :: htot !< The accumlated mixed layer thickness [H ~> m or kg m-2] - !! (often m or kg m-2). + real, dimension(SZI_(G)), intent(in) :: htot !< The accumulated mixed layer thickness + !! [H ~> m or kg m-2] real, dimension(SZI_(G)), intent(in) :: h_CA !< The mixed layer depth after convective !! adjustment [H ~> m or kg m-2]. type(forcing), intent(in) :: fluxes !< A structure containing pointers to any @@ -1333,7 +1329,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, !! integrated over a time step [Z m2 s-2 ~> m3 s-2]. real, dimension(2,SZI_(G)), intent(out) :: cMKE !< Coefficients of HpE and HpE^2 in !! calculating the denominator of MKE_rate, - !! in H-1 and H-2. + !! [H-1 ~> m-1 or m2 kg-1] and [H-2 ~> m-2 or m4 kg-2]. real, intent(in) :: dt !< The time step in s. real, intent(in) :: Idt_diag !< The inverse of the accumulated diagnostic !! time interval, in s-1. @@ -1492,8 +1488,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZK_(GV)), & - intent(inout) :: h !< Layer thickness, in m or kg m-2. - !! The units of h are referred to as H below. + intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)), & intent(inout) :: d_eb !< The downward increase across a layer in the !! layer in the entrainment from below [H ~> m or kg m-2]. @@ -1831,9 +1826,7 @@ end subroutine mechanical_entrainment subroutine sort_ML(h, R0, eps, G, GV, CS, ksort) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZK_(GV)), intent(in) :: h !< Layer thickness, in m or kg m-2. - !! (Intent in/out) The units of h are - !! referred to as H below. + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: R0 !< The potential density used to sort !! the layers, in kg m-3. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: eps !< The (small) thickness that must @@ -1842,21 +1835,7 @@ subroutine sort_ML(h, R0, eps, G, GV, CS, ksort) !! previous call to mixedlayer_init. integer, dimension(SZI_(G),SZK_(GV)), intent(out) :: ksort !< The k-index to use in the sort. -! This subroutine generates an array of indices that are sorted by layer -! density. - -! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out) The units -! of h are referred to as H below. -! (in) R0 - The potential density used to sort the layers, in kg m-3. -! (in) eps - The (small) thickness that must remain in each layer [H ~> m or kg m-2]. -! (in) tv - A structure containing pointers to any available -! thermodynamic fields. Absent fields have NULL ptrs. -! (in) j - The meridional row to work on. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! mixedlayer_init. -! (out) ksort - The k-index to use in the sort. + ! Local variables real :: R0sort(SZI_(G),SZK_(GV)) integer :: nsort(SZI_(G)) logical :: done_sorting(SZI_(G)) @@ -1900,9 +1879,7 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid !! structure. - real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: h !< Layer thickness, in m or kg m-2. - !! (Intent in/out) The units of h - !! are referred to as H below. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. !! Layer 0 is the new mixed layer. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Layer temperatures, in deg C. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Layer salinities, in psu. @@ -1916,7 +1893,7 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS !! remain in each layer [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea !< The upward increase across a !! layer in the entrainment from - !! above, in m or kg m-2 (H). + !! above [H ~> m or kg m-2]. !! Positive d_ea goes with layer !! thickness increases. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_eb !< The downward increase across a @@ -1943,36 +1920,6 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS !! density with salinity, !! in kg m-3 psu-1. -! This subroutine actually moves properties between layers to achieve a -! resorted state, with all of the resorted water either moved into the correct -! interior layers or in the top nkmb layers. -! -! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out) The units of -! h are referred to as H below. Layer 0 is the new mixed layer. -! (in/out) T - Layer temperatures, in deg C. -! (in/out) S - Layer salinities, in psu. -! (in/out) R0 - Potential density referenced to surface pressure, in kg m-3. -! (in/out) Rcv - The coordinate defining potential density, in kg m-3. -! (in) RcvTgt - The target value of Rcv for each layer, in kg m-3. -! (in) eps - The (small) thickness that must remain in each layer [H ~> m or kg m-2]. -! (in/out) d_ea - The upward increase across a layer in the entrainment from -! above, in m or kg m-2 (H). Positive d_ea goes with layer -! thickness increases. -! (in/out) d_eb - The downward increase across a layer in the entrainment from -! below [H ~> m or kg m-2]. Positive values go with mass gain by a layer. -! (in) ksort - The density-sorted k-indicies. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure for this module. -! (in/out) dR0_dT - The partial derivative of potential density referenced -! to the surface with potential temperature, in kg m-3 K-1. -! (in/out) dR0_dS - The partial derivative of cpotential density referenced -! to the surface with salinity, in kg m-3 psu-1. -! (in/out) dRcv_dT - The partial derivative of coordinate defining potential -! density with potential temperature, in kg m-3 K-1. -! (in/out) dRcv_dS - The partial derivative of coordinate defining potential -! density with salinity, in kg m-3 psu-1. - ! If there are no massive light layers above the deepest of the mixed- and ! buffer layers, do nothing (except perhaps to reshuffle these layers). ! If there are nkbl or fewer layers above the deepest mixed- or buffer- @@ -1985,6 +1932,8 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS ! those buffer layers into peices that match the target density of the two ! nearest interior layers. ! Otherwise, if there are more than nkbl+1 remaining massive layers + + ! Local variables real :: h_move, h_tgt_old, I_hnew real :: dT_dS_wt2, dT_dR, dS_dR, I_denom real :: Rcv_int @@ -2252,9 +2201,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, dR0_dT, dR0_dS, dRcv_dT, dRcv_dS, max_BL_det) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: h !< Layer thickness, in m or kg m-2. - !! (Intent in/out) The units of h are - !! referred to as H below. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. !! Layer 0 is the new mixed layer. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Potential temperature, in C. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Salinity, in psu. @@ -2267,9 +2214,9 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real, intent(in) :: dt !< Time increment, in s. real, intent(in) :: dt_diag !< The diagnostic time step, in s. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea !< The upward increase across a layer in - !! the entrainment from above, in m or - !! kg m-2 (H). Positive d_ea goes with - !! layer thickness increases. + !! the entrainment from above + !! [H ~> m or kg m-2]. Positive d_ea + !! goes with layer thickness increases. integer, intent(in) :: j !< The meridional row to work on. type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a !! previous call to mixedlayer_init. @@ -3154,10 +3101,8 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e j, G, GV, CS, dRcv_dT, dRcv_dS, max_BL_det) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: h !< Layer thickness, in m or kg m-2. - !! (Intent in/out) The units of h are - !! referred to as H below. Layer 0 is - !! the new mixed layer. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. + !! Layer 0 is the new mixed layer. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Potential temperature, in C. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Salinity, in psu. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: R0 !< Potential density referenced to @@ -3170,9 +3115,9 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e real, intent(in) :: dt_diag !< The accumulated time interval for !! diagnostics, in s. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea !< The upward increase across a layer in - !! the entrainment from above, in m or - !! kg m-2 (H). Positive d_ea goes with - !! layer thickness increases. + !! the entrainment from above + !! [H ~> m or kg m-2]. Positive d_ea + !! goes with layer thickness increases. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_eb !< The downward increase across a layer !! in the entrainment from below [H ~> m or kg m-2]. !! Positive values go with mass gain by @@ -3191,34 +3136,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e !! detrainment permitted from the buffer !! layers [H ~> m or kg m-2]. -! This subroutine moves any water left in the former mixed layers into the -! single buffer layers and may also move buffer layer water into the interior -! isopycnal layers. - -! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out) The units of -! h are referred to as H below. Layer 0 is the new mixed layer. -! (in/out) T - Potential temperature, in C. -! (in/out) S - Salinity, in psu. -! (in/out) R0 - Potential density referenced to surface pressure, in kg m-3. -! (in/out) Rcv - The coordinate defining potential density, in kg m-3. -! (in) RcvTgt - The target value of Rcv for each layer, in kg m-3. -! (in) dt - Time increment, in s. -! (in/out) d_ea - The upward increase across a layer in the entrainment from -! above, in m or kg m-2 (H). Positive d_ea goes with layer -! thickness increases. -! (in/out) d_eb - The downward increase across a layer in the entrainment from -! below [H ~> m or kg m-2]. Positive values go with mass gain by a layer. -! (in) j - The meridional row to work on. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! mixedlayer_init. -! (in) max_BL_det - If non-negative, the maximum detrainment permitted -! from the buffer layers [H ~> m or kg m-2]. -! (in/out) dRcv_dT - The partial derivative of coordinate defining potential -! density with potential temperature, in kg m-3 K-1. -! (in/out) dRcv_dS - The partial derivative of coordinate defining potential -! density with salinity, in kg m-3 psu-1. + ! Local variables real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. real :: h_ent ! The thickness from a layer that is ! entrained [H ~> m or kg m-2]. diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 5601597a22..9bd338a79c 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -96,20 +96,7 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf, halo) optional, intent(in) :: p_surf !< The pressure at the ocean surface, in Pa. integer, optional, intent(in) :: halo !< Halo width over which to calculate frazil -! Frazil formation keeps the temperature above the freezing point. -! This subroutine warms any water that is colder than the (currently -! surface) freezing point up to the freezing point and accumulates -! the required heat (in J m-2) in tv%frazil. -! The expression, below, for the freezing point of sea water comes -! from Millero (1978) via Appendix A of Gill, 1982. - -! Arguments: h - Layer thickness, in m or kg m-2. -! (in/out) tv - A structure containing pointers to any available -! thermodynamic fields. Absent fields have NULL ptrs. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! diabatic_driver_init. + ! Local variables real, dimension(SZI_(G)) :: & fraz_col, & ! The accumulated heat requirement due to frazil, in J. T_freeze, & ! The freezing potential temperature at the current salinity, C. @@ -574,9 +561,9 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) !! Omitting eb is the same as setting it to 0. ! local variables - real :: b_denom_1 ! The first term in the denominator of b1 in m or kg m-2. + real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m or kg m-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: b1(SZI_(G)), d1(SZI_(G)), c1(SZI_(G),SZK_(G)) real :: a_n(SZI_(G)), a_s(SZI_(G)) ! Fractional weights of the neighboring real :: a_e(SZI_(G)), a_w(SZI_(G)) ! velocity points, ~1/2 in the open diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index e1e03ff39e..757c2120ab 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -149,7 +149,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & real, dimension(GV%ke) :: & p_lay, & ! Average pressure of a layer, in Pa. - dSV_dT, & ! Partial derivative of specific volume with temperature, in m3 kg-1 K-1. + dSV_dT, & ! Partial derivative of specific volume with temperature, in m3 kg-1 degC-1. dSV_dS, & ! Partial derivative of specific volume with salinity, in m3 kg-1 / (g kg-1). T0, S0, & ! Initial temperatures and salinities. Te, Se, & ! Running incomplete estimates of the new temperatures and salinities. @@ -160,11 +160,11 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & dTe_a, dSe_a, & ! Running (1-way) estimates of temperature and salinity change. dTe_b, dSe_b, & ! Running (1-way) estimates of temperature and salinity change. Th_a, & ! An effective temperature times a thickness in the layer above, - ! including implicit mixing effects with other yet higher layers, in K H. + ! including implicit mixing effects with other yet higher layers, in degC H. Sh_a, & ! An effective salinity times a thickness in the layer above, ! including implicit mixing effects with other yet higher layers, in ppt H. Th_b, & ! An effective temperature times a thickness in the layer below, - ! including implicit mixing effects with other yet lower layers, in K H. + ! including implicit mixing effects with other yet lower layers, in degC H. Sh_b, & ! An effective salinity times a thickness in the layer below, ! including implicit mixing effects with other yet lower layers, in ppt H. dT_to_dPE, & ! Partial derivative of column potential energy with the temperature @@ -194,7 +194,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & c1_a, & ! c1_a is used by a downward-oriented tridiagonal solver, ND. c1_b, & ! c1_b is used by an upward-oriented tridiagonal solver, ND. h_tr ! h_tr is h at tracer points with a h_neglect added to - ! ensure positive definiteness, in m or kg m-2. + ! ensure positive definiteness [H ~> m or kg m-2]. real, dimension(GV%ke+1) :: & pres, & ! Interface pressures in Pa. pres_Z, & ! Interface pressures with a rescaling factor to convert interface height diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 8f2200ad86..3459c72f51 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -68,12 +68,10 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, !! call to entrain_diffusive_init. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: ea !< The amount of fluid entrained from the layer - !! above within this time step, in the same units - !! as h, m or kg m-2. + !! above within this time step [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: eb !< The amount of fluid entrained from the layer - !! below within this time step, in the same units - !! as h, m or kg m-2. + !! below within this time step [H ~> m or kg m-2]. integer, dimension(SZI_(G),SZJ_(G)), & optional, intent(inout) :: kb_out !< The index of the lightest layer denser than !! the buffer layer. @@ -91,13 +89,10 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, ! differences between layers. The scheme that is used here is described in ! detail in Hallberg, Mon. Wea. Rev. 2000. -! In the comments below, H is used as shorthand for the units of h, m or kg m-2. real, dimension(SZI_(G),SZK_(G)) :: & - dtKd ! The layer diapycnal diffusivity times the time step, translated - ! into the same unints as h, m2 or kg2 m-4 (i.e. H2). + dtKd ! The layer diapycnal diffusivity times the time step [H2 ~> m2 or kg2 m-4]. real, dimension(SZI_(G),SZK_(G)+1) :: & - dtKd_int ! The diapycnal diffusivity at the interfaces times the time step, - ! translated into the same unints as h, m2 or kg2 m-4 (i.e. H2). + dtKd_int ! The diapycnal diffusivity at the interfaces times the time step [H2 ~> m2 or kg2 m-4] real, dimension(SZI_(G),SZK_(G)) :: & F, & ! The density flux through a layer within a time step divided by the ! density difference across the interface below the layer [H ~> m or kg m-2]. @@ -928,7 +923,7 @@ subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb, ! mixed layer. real :: h1 ! The thickness in excess of the minimum that will remain - ! after exchange with the layer below, in m or kg m-2. + ! after exchange with the layer below [H ~> m or kg m-2]. logical :: do_i(SZI_(G)) integer :: i, k, is, ie, nz @@ -1027,7 +1022,6 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - !! (usually m or kg m-2). real, dimension(SZI_(G),SZK_(G)+1), & intent(in) :: dtKd_int !< The diapycnal diffusivity across !! each interface times the time step @@ -1051,30 +1045,13 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref !! 1000 for each layer, in kg m-3. real, dimension(SZI_(G),SZK_(G)), intent(out) :: h_bl !< The thickness of each layer [H ~> m or kg m-2]. -! Arguments: h - Layer thickness, in m or kg m-2 (abbreviated as H below). -! (in) dtKd_int - The diapycnal diffusivity across each interface times -! the time step [H2 ~> m2 or kg2 m-4]. -! (in) tv - A structure containing pointers to any available -! thermodynamic fields. Absent fields have NULL ptrs. -! (in) kb - The index of the lightest layer denser than the -! buffer layer or 1 if there is no buffer layer. -! (in) do_i - A logical variable indicating which i-points to work on. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - This module's control structure. -! (in) j - The meridional index upon which to work. -! (out) Ent_bl - The average entrainment upward and downward across -! each interface around the buffer layers [H ~> m or kg m-2]. -! (out) Sref - The coordinate potential density - 1000 for each layer, -! in kg m-3. -! (out) h_bl - The thickness of each layer [H ~> m or kg m-2]. - ! This subroutine sets the average entrainment across each of the interfaces ! between buffer layers within a timestep. It also causes thin and relatively ! light interior layers to be entrained by the deepest buffer layer. ! Also find the initial coordinate potential densities (Sref) of each layer. - ! Does there need to be limiting when the layers below are all thin? + + ! Local variables real, dimension(SZI_(G)) :: & b1, d1, & ! Variables used by the tridiagonal solver, in H-1 and ND. Rcv, & ! Value of the coordinate variable (potential density) @@ -1218,10 +1195,8 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid !! structure. - real, dimension(SZI_(G),SZK_(G)), intent(in) :: h_bl !< Layer thickness, in m or kg m-2 - !! (abbreviated as H below). - real, dimension(SZI_(G),SZK_(G)), intent(in) :: Sref !< Reference potential vorticity - !! (in kg m-3?). + real, dimension(SZI_(G),SZK_(G)), intent(in) :: h_bl !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZK_(G)), intent(in) :: Sref !< Reference potential density [kg m-3] real, dimension(SZI_(G),SZK_(G)), intent(in) :: Ent_bl !< The average entrainment upward and !! downward across each interface !! around the buffer layers [H ~> m or kg m-2]. @@ -1249,24 +1224,7 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & !! buffer layer, in kg m-3. logical, dimension(SZI_(G)), optional, intent(in) :: do_i_in !< If present, determines which !! columns are worked on. -! Arguments: h_bl - Layer thickness, in m or kg m-2 (abbreviated as H below). -! (in) Sref - Reference potential vorticity (in kg m-3?) -! (in) Ent_bl - The average entrainment upward and downward across -! each interface around the buffer layers [H ~> m or kg m-2]. -! (in) E_kb - The entrainment by the top interior layer [H ~> m or kg m-2]. -! (in) is, ie - The range of i-indices to work on. -! (in) kmb - The number of mixed and buffer layers. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) limit - If true, limit dSkb and dSlay to avoid negative values. -! (out) dSkb - The limited potential density difference across the -! interface between the bottommost buffer layer and the -! topmost interior layer. dSkb > 0. -! (out,opt) dSlay - The limited potential density difference across the -! topmost interior layer. 0 < dSkb -! (out,opt) ddSkb_dE - The partial derivative of dSkb with E, in kg m-3 H-1. -! (out,opt) ddSlay_dE - The partial derivative of dSlay with E, in kg m-3 H-1. -! (in,opt) do_i_in - If present, determines which columns are worked on. + ! Note that dSkb, ddSkb_dE, dSlay, ddSlay_dE, and dS_anom_lim are declared ! intent inout because they should not change where do_i_in is false. @@ -1282,6 +1240,8 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & ! exceed the density differences across an interface. ! Additionally, the partial derivatives of dSkb and dSlay with E_kb could ! also be returned. + + ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & b1, c1, & ! b1 and c1 are variables used by the tridiagonal solver. S, dS_dE, & ! The coordinate density and its derivative with R. @@ -1291,13 +1251,13 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & real :: d1(SZI_(G)) ! d1 = 1.0-c1 is also used by the tridiagonal solver. real :: src ! A source term for dS_dR. real :: h1 ! The thickness in excess of the minimum that will remain - ! after exchange with the layer below, in m or kg m-2. + ! after exchange with the layer below [H ~> m or kg m-2]. logical, dimension(SZI_(G)) :: do_i real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: h_tr ! h_tr is h at tracer points with a tiny thickness - ! added to ensure positive definiteness, in m or kg m-2. - real :: b_denom_1 ! The first term in the denominator of b1 in m or kg m-2. + ! added to ensure positive definiteness [H ~> m or kg m-2]. + real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. real :: rat real :: dS_kbp1, IdS_kbp1 real :: deriv_dSLay @@ -1609,8 +1569,7 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK_(G)), intent(in) :: h_bl !< Layer thickness, with the top interior - !! layer at k-index kmb+1, in units of m - !! or kg m-2 (abbreviated as H below). + !! layer at k-index kmb+1 [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(G)), intent(in) :: Sref !< The coordinate reference potential !! density, with the value of the !! topmost interior layer at layer @@ -1656,40 +1615,11 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & real, dimension(SZI_(G)), optional, intent(out) :: dFdfm_kb !< The partial derivative of F_kb with !! ea_kbp1, nondim. -! Arguments: h_bl - Layer thickness, with the top interior layer at k-index -! kmb+1, in units of m or kg m-2 (abbreviated as H below). -! (in) dtKd_kb - The diapycnal diffusivity in the top interior layer times -! the time step [H2 ~> m2 or kg2 m-4]. -! (in) Sref - The coordinate reference potential density, with the -! value of the topmost interior layer at layer kmb+1, -! in units of kg m-3. -! (in) I_dSkbp1 - The inverse of the difference in reference potential -! density across the base of the uppermost interior layer, -! in units of m3 kg-1. -! (in) Ent_bl - The average entrainment upward and downward across -! each interface around the buffer layers [H ~> m or kg m-2]. -! (in) ea_kbp1 - The entrainment from above by layer kb+1 [H ~> m or kg m-2]. -! (in) min_eakb - The minimum permissible rate of entrainment [H ~> m or kg m-2]. -! (in) max_eakb - The maximum permissible rate of entrainment [H ~> m or kg m-2]. -! (in) is, ie - The range of i-indices to work on. -! (in) do_i - A logical variable indicating which i-points to work on. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - This module's control structure. -! (in/out) Ent - The entrainment rate of the uppermost interior layer [H ~> m or kg m-2]. -! The input value is the first guess. -! (out,opt) error - The error (locally defined in this routine) associated with -! the returned solution. -! (in,opt) error_min_eakb0, error_max_eakb0 - The errors (locally defined) -! associated with min_eakb and max_eakb when ea_kbp1 = 0, -! returned from a previous call to this routine. -! (out,opt) F_kb - The entrainment from below by the uppermost interior layer -! corresponding to the returned value of Ent [H ~> m or kg m-2]. -! (out,out) dFdfm_kb - The partial derivative of F_kb with ea_kbp1, nondim. - ! This subroutine determines the entrainment from above by the top interior ! layer (labeled kb elsewhere) given an entrainment by the layer below it, ! constrained to be within the provided bounds. + + ! Local variables real, dimension(SZI_(G)) :: & dS_kb, & ! The coordinate-density difference between the ! layer kb and deepest buffer layer, limited to @@ -1698,7 +1628,7 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & ! kb, limited to ensure that it is positive and not ! too much bigger than dS_kb or dS_kbp1, in kg m-3. ddSkb_dE, ddSlay_dE, & ! The derivatives of dS_kb and dS_Lay with E, - ! in units of kg m-3 H-1. + ! in kg m-3 H-1. derror_dE, & ! The derivative of err with E [H ~> m or kg m-2]. err, & ! The "error" whose zero is being sought [H2 ~> m2 or kg2 m-4]. E_min, E_max, & ! The minimum and maximum values of E [H ~> m or kg m-2]. @@ -1849,7 +1779,7 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: h_bl !< Layer thickness, in m or kg m-2 + intent(in) :: h_bl !< Layer thickness [H ~> m or kg m-2] !! (abbreviated as H below). real, dimension(SZI_(G),SZK_(G)), & intent(in) :: Sref !< Reference potential density (in kg m-3?). diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 7293a43058..50ba6ffddc 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1380,7 +1380,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< v component of flow (m s-1) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thickness (m or kg m-2) + intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available !! thermodynamic fields. type(forcing), intent(in) :: fluxes !< Surface fluxes structure diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 24f0a20130..cd4950c14a 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -41,15 +41,13 @@ module MOM_set_visc !> Control structure for MOM_set_visc type, public :: set_visc_CS ; private - real :: Hbbl !< The static bottom boundary layer thickness, in - !! the same units as thickness (m or kg m-2). + real :: Hbbl !< The static bottom boundary layer thickness [H ~> m or kg m-2] real :: cdrag !< The quadratic drag coefficient. real :: c_Smag !< The Laplacian Smagorinsky coefficient for !! calculating the drag in channels. real :: drag_bg_vel !< An assumed unresolved background velocity for !! calculating the bottom drag, in m s-1. - real :: BBL_thick_min !< The minimum bottom boundary layer thickness in - !! the same units as thickness (H, often m or kg m-2). + real :: BBL_thick_min !< The minimum bottom boundary layer thickness [H ~> m or kg m-2]. !! This might be Kv / (cdrag * drag_bg_vel) to give !! Kv as the minimum near-bottom viscosity. real :: Htbl_shelf !< A nominal thickness of the surface boundary layer for use @@ -129,7 +127,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real, dimension(SZIB_(G)) :: & ustar, & ! The bottom friction velocity, in m s-1. T_EOS, & ! The temperature used to calculate the partial derivatives - ! of density with T and S, in deg C. + ! of density with T and S, in degC. S_EOS, & ! The salinity used to calculate the partial derivatives ! of density with T and S, in PSU. dR_dT, & ! Partial derivative of the density in the bottom boundary @@ -159,7 +157,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) h_vel, & ! Arithmetic mean of the layer thicknesses adjacent to a ! velocity point [H ~> m or kg m-2]. T_vel, & ! Arithmetic mean of the layer temperatures adjacent to a - ! velocity point, in deg C. + ! velocity point, in degC. S_vel, & ! Arithmetic mean of the layer salinities adjacent to a ! velocity point, in PSU. Rml_vel ! Arithmetic mean of the layer coordinate densities adjacent @@ -196,7 +194,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: Shtot ! Running sum of thickness times salinity [PSU H ~> PSU m or PSU kg m-2]. real :: hweight ! The thickness of a layer that is within Hbbl ! of the bottom [H ~> m or kg m-2]. - real :: v_at_u, u_at_v ! v at a u point or vice versa, m s-1. + real :: v_at_u, u_at_v ! v at a u point or vice versa [m s-1]. real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors, in kg s2 H m-3 Z-2. ! The 400 is a constant proposed by Killworth and Edwards, 1999. real, dimension(SZI_(G),SZJ_(G),max(GV%nk_rho_varies,1)) :: & @@ -204,7 +202,6 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, in Pa (usually set to 2e7 Pa = 2000 dbar). - ! The units H in the following are thickness units - typically m or kg m-2. real :: D_vel ! The bottom depth at a velocity point [H ~> m or kg m-2]. real :: Dp, Dm ! The depths at the edges of a velocity cell [H ~> m or kg m-2]. real :: a ! a is the curvature of the bottom depth across a @@ -242,8 +239,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! evaluated at L=L0 [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: ustH ! ustar converted to units of H s-1. - real :: root ! A temporary variable with units of H s-1. + real :: ustH ! ustar converted to units of H s-1 [H s-1 ~> m s-1 or kg m-2 s-1]. + real :: root ! A temporary variable [H s-1 ~> m s-1 or kg m-2 s-1]. real :: Cell_width ! The transverse width of the velocity cell, in m. real :: Rayleigh ! A nondimensional value that is multiplied by the layer's diff --git a/src/parameterizations/vertical/MOM_shortwave_abs.F90 b/src/parameterizations/vertical/MOM_shortwave_abs.F90 index a1b7ef6e1c..7cda4285a8 100644 --- a/src/parameterizations/vertical/MOM_shortwave_abs.F90 +++ b/src/parameterizations/vertical/MOM_shortwave_abs.F90 @@ -58,10 +58,10 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, real, intent(in) :: dt !< Time step (seconds). real, intent(in) :: H_limit_fluxes !< If the total ocean depth is !! less than this, they are scaled away - !! to avoid numerical instabilities. (H) - !! This would not be necessary if a - !! finite heat capacity mud-layer - !! were added. + !! to avoid numerical instabilities + !! [H ~> m or kg m-2]. This would + !! not be necessary if a finite heat + !! capacity mud-layer were added. logical, intent(in) :: adjustAbsorptionProfile !< If true, apply !! heating above the layers in which it !! should have occurred to get the @@ -75,7 +75,7 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, !! shortwave that should be absorbed by !! each layer. real, dimension(SZI_(G),SZK_(G)), intent(inout) :: T !< Layer potential/conservative - !! temperatures (deg C) + !! temperatures [degC] real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< Penetrating shortwave heating in !! each band that hits the bottom and !! will be redistributed through the @@ -114,8 +114,8 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, real :: unabsorbed ! fraction of the shortwave radiation that ! is not absorbed because the layers are too thin real :: Ih_limit ! inverse of the total depth at which the - ! surface fluxes start to be limited (1/H) - real :: h_min_heat ! minimum thickness layer that should get heated (H) + ! surface fluxes start to be limited [H-1 ~> m-1 or m2 kg-1] + real :: h_min_heat ! minimum thickness layer that should get heated [H ~> m or kg m-2] real :: opt_depth ! optical depth of a layer (non-dim) real :: exp_OD ! exp(-opt_depth) (non-dim) real :: heat_bnd ! heating due to absorption in the current diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index f8aa0bd7b4..2e8809529c 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -37,12 +37,12 @@ module MOM_vert_friction !> The control structure with parameters and memory for the MOM_vert_friction module type, public :: vertvisc_CS ; private - real :: Hmix !< The mixed layer thickness in thickness units (H). + real :: Hmix !< The mixed layer thickness in thickness units [H ~> m or kg m-2]. real :: Hmix_stress !< The mixed layer thickness over which the wind !! stress is applied with direct_stress [H ~> m or kg m-2]. real :: Kvml !< The mixed layer vertical viscosity in m2 s-1. real :: Kv !< The interior vertical viscosity in m2 s-1. - real :: Hbbl !< The static bottom boundary layer thickness, in m. + real :: Hbbl !< The static bottom boundary layer thickness [H ~> m or kg m-2]. real :: Kvbbl !< The vertical viscosity in the bottom boundary !! layer, in m2 s-1. @@ -183,25 +183,23 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. real :: Hmix ! The mixed layer thickness over which stress - ! is applied with direct_stress, translated into - ! thickness units - either m or kg m-2. - real :: I_Hmix ! The inverse of Hmix, in m-1 or m2 kg-1. + ! is applied with direct_stress [H ~> m or kg m-2]. + real :: I_Hmix ! The inverse of Hmix [H-1 ~> m-1 or m2 kg-1]. real :: Idt ! The inverse of the time step, in s-1. real :: dt_Rho0 ! The time step divided by the mean ! density, in s m3 kg-1. real :: Rho0 ! A density used to convert drag laws into stress in ! Pa, in kg m-3. real :: dt_Z_to_H ! The time step times the conversion from Z to the - ! units of thickness - either s or s m3 kg-1. + ! units of thickness - [s H Z-1 ~> s or s kg m-3]. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m or kg m-2. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: stress ! The surface stress times the time step, divided - ! by the density, in units of m2 s-1. + ! by the density [m2 s-1]. real :: zDS, hfr, h_a ! Temporary variables used with direct_stress. - real :: surface_stress(SZIB_(G))! The same as stress, unless the wind - ! stress is applied as a body force, in - ! units of m2 s-1. + real :: surface_stress(SZIB_(G))! The same as stress, unless the wind stress + ! stress is applied as a body force [m2 s-1]. logical :: do_i(SZIB_(G)) logical :: DoStokesMixing @@ -484,7 +482,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver, ND. real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity times the ! time step, in m. - real :: b_denom_1 ! The first term in the denominator of b1, in m or kg m-2. + real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. real :: dt_Z_to_H ! The time step times the conversion from Z to the ! units of thickness - either s or s m3 kg-1. logical :: do_i(SZIB_(G)) @@ -594,9 +592,9 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) real, dimension(SZIB_(G),SZK_(G)) :: & h_harm, & ! Harmonic mean of the thicknesses around a velocity grid point, - ! given by 2*(h+ * h-)/(h+ + h-), in m or kg m-2 (H for short). - h_arith, & ! The arithmetic mean thickness, in m or kg m-2. - h_delta, & ! The lateral difference of thickness, in m or kg m-2. + ! given by 2*(h+ * h-)/(h+ + h-) [H ~> m or kg m-2] (H for short). + h_arith, & ! The arithmetic mean thickness [H ~> m or kg m-2]. + h_delta, & ! The lateral difference of thickness [H ~> m or kg m-2]. hvel, & ! hvel is the thickness used at a velocity grid point [H ~> m or kg m-2]. hvel_shelf ! The equivalent of hvel under shelves [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZK_(G)+1) :: & @@ -608,19 +606,19 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) ! normalized by the bottom boundary layer thickness, nondim. real, dimension(SZIB_(G)) :: & kv_bbl, & ! The bottom boundary layer viscosity [Z2 s-1 ~> m2 s-1]. - bbl_thick, & ! The bottom boundary layer thickness in m or kg m-2. + bbl_thick, & ! The bottom boundary layer thickness [H ~> m or kg m-2]. I_Hbbl, & ! The inverse of the bottom boundary layer thickness, in units ! of H-1 (i.e., m-1 or m2 kg-1). I_Htbl, & ! The inverse of the top boundary layer thickness, in units ! of H-1 (i.e., m-1 or m2 kg-1). zcol1, & ! The height of the interfaces to the north and south of a - zcol2, & ! v-point, in m or kg m-2. + zcol2, & ! v-point [H ~> m or kg m-2]. Ztop_min, & ! The deeper of the two adjacent surface heights [H ~> m or kg m-2]. Dmin, & ! The shallower of the two adjacent bottom depths converted to - ! thickness units, in m or kg m-2. + ! thickness units [H ~> m or kg m-2]. zh, & ! An estimate of the interface's distance from the bottom - ! based on harmonic mean thicknesses, in m or kg m-2. - h_ml ! The mixed layer depth, in m or kg m-2. + ! based on harmonic mean thicknesses [H ~> m or kg m-2]. + h_ml ! The mixed layer depth [H ~> m or kg m-2]. real, allocatable, dimension(:,:) :: hML_u ! Diagnostic of the mixed layer depth at u points, in m. real, allocatable, dimension(:,:) :: hML_v ! Diagnostic of the mixed layer depth at v points, in m. real, allocatable, dimension(:,:,:) :: Kv_u !< Total vertical viscosity at u-points, in m2 s-1. From 23eea80571177f37a6613a229fb59c1ae0b4adaf Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 20 Dec 2018 14:51:54 -0500 Subject: [PATCH 0967/1072] Document more variable units with square brackets Changed comments to use the square bracket notation to document the units of about 1000 more variables. Only comments have been changed and all answers are bitwise identical. --- src/ALE/MOM_regridding.F90 | 22 +-- src/core/MOM_CoriolisAdv.F90 | 117 +++++++------- src/core/MOM_PressureForce_Montgomery.F90 | 66 ++++---- src/core/MOM_PressureForce_analytic_FV.F90 | 44 ++--- src/core/MOM_PressureForce_blocked_AFV.F90 | 48 +++--- src/core/MOM_barotropic.F90 | 25 +-- src/core/MOM_continuity_PPM.F90 | 30 ++-- src/core/MOM_dynamics_split_RK2.F90 | 88 +++++----- src/core/MOM_forcing_type.F90 | 18 +-- src/core/MOM_interface_heights.F90 | 23 ++- src/core/MOM_isopycnal_slopes.F90 | 14 +- src/core/MOM_variables.F90 | 91 ++++++----- src/core/MOM_verticalGrid.F90 | 2 +- src/diagnostics/MOM_PointAccel.F90 | 16 +- src/diagnostics/MOM_diag_to_Z.F90 | 20 +-- src/diagnostics/MOM_diagnostics.F90 | 43 +++-- src/diagnostics/MOM_sum_output.F90 | 24 +-- src/diagnostics/MOM_wave_speed.F90 | 10 +- src/diagnostics/MOM_wave_structure.F90 | 8 +- src/equation_of_state/MOM_EOS.F90 | 134 ++++++++-------- src/equation_of_state/MOM_EOS_NEMO.F90 | 18 +-- src/equation_of_state/MOM_EOS_TEOS10.F90 | 22 +-- src/equation_of_state/MOM_EOS_UNESCO.F90 | 26 +-- src/equation_of_state/MOM_EOS_Wright.F90 | 66 ++++---- src/equation_of_state/MOM_EOS_linear.F90 | 70 ++++---- src/ice_shelf/MOM_ice_shelf.F90 | 30 ++-- src/ice_shelf/user_shelf_init.F90 | 2 +- .../MOM_fixed_initialization.F90 | 2 +- .../MOM_state_initialization.F90 | 28 ++-- src/initialization/midas_vertmap.F90 | 41 ++--- src/parameterizations/lateral/MOM_MEKE.F90 | 6 +- .../lateral/MOM_internal_tides.F90 | 28 ++-- .../lateral/MOM_thickness_diffuse.F90 | 32 ++-- .../lateral/MOM_tidal_forcing.F90 | 8 +- .../vertical/MOM_bulk_mixed_layer.F90 | 150 +++++++++--------- .../vertical/MOM_diabatic_aux.F90 | 43 ++--- .../vertical/MOM_diapyc_energy_req.F90 | 26 +-- .../vertical/MOM_energetic_PBL.F90 | 80 +++++----- .../vertical/MOM_entrain_diffusive.F90 | 46 +++--- .../vertical/MOM_kappa_shear.F90 | 86 +++++----- .../vertical/MOM_regularize_layers.F90 | 40 ++--- .../vertical/MOM_set_diffusivity.F90 | 15 +- .../vertical/MOM_set_viscosity.F90 | 102 ++++++------ .../vertical/MOM_shortwave_abs.F90 | 45 +++--- .../vertical/MOM_vert_friction.F90 | 37 ++--- src/tracer/MOM_neutral_diffusion.F90 | 38 ++--- src/tracer/MOM_tracer_advect.F90 | 50 +++--- src/tracer/MOM_tracer_diabatic.F90 | 9 +- src/tracer/MOM_tracer_hor_diff.F90 | 32 ++-- src/tracer/ideal_age_example.F90 | 3 +- src/tracer/oil_tracer.F90 | 4 +- src/tracer/pseudo_salt_tracer.F90 | 2 +- src/user/BFB_surface_forcing.F90 | 10 +- src/user/DOME2d_initialization.F90 | 2 +- src/user/DOME_initialization.F90 | 2 +- src/user/ISOMIP_initialization.F90 | 2 +- src/user/Idealized_Hurricane.F90 | 4 +- src/user/MOM_controlled_forcing.F90 | 14 +- src/user/MOM_wave_interface.F90 | 2 +- src/user/Phillips_initialization.F90 | 12 +- src/user/Rossby_front_2d_initialization.F90 | 4 +- src/user/benchmark_initialization.F90 | 8 +- src/user/dumbbell_surface_forcing.F90 | 12 +- src/user/sloshing_initialization.F90 | 2 +- src/user/user_initialization.F90 | 11 +- 65 files changed, 1052 insertions(+), 1063 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index e3e03e8300..df06f42960 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -47,7 +47,7 @@ module MOM_regridding !> This array is set by function setCoordinateResolution() !! It contains the "resolution" or delta coordinate of the target !! coorindate. It has the units of the target coordinate, e.g. - !! Z (often meters) for z*, non-dimensional for sigma, etc. + !! [Z ~> m] for z*, non-dimensional for sigma, etc. real, dimension(:), allocatable :: coordinateResolution !> This is a scaling factor that restores coordinateResolution to values in @@ -194,14 +194,16 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m logical :: tmpLogical, fix_haloclines, set_max, do_sum, main_parameters logical :: coord_is_state_dependent, ierr real :: filt_len, strat_tol, index_scale, tmpReal - real :: maximum_depth !< The maximum depth of the ocean, in m. + real :: maximum_depth !< The maximum depth of the ocean [m] (not in Z). real :: dz_fixed_sfc, Rho_avg_depth, nlay_sfc_int real :: adaptTimeRatio, adaptZoom, adaptZoomCoeff, adaptBuoyCoeff, adaptAlpha integer :: nz_fixed_sfc, k, nzf(4) real, dimension(:), allocatable :: dz ! Resolution (thickness) in units of coordinate - real, dimension(:), allocatable :: h_max ! Maximum layer thicknesses, in m. - real, dimension(:), allocatable :: dz_max ! Thicknesses used to find maximum interface depths, in m. - real, dimension(:), allocatable :: z_max ! Maximum interface depths, in m. + real, dimension(:), allocatable :: h_max ! Maximum layer thicknesses [H ~> m or kg m-2] + real, dimension(:), allocatable :: z_max ! Maximum interface depths [H ~> m or kg m-2] or other + ! units depending on the coordinate + real, dimension(:), allocatable :: dz_max ! Thicknesses used to find maximum interface depths + ! [H ~> m or kg m-2] or other units real, dimension(:), allocatable :: rho_target ! Target density used in HYBRID mode ! Thicknesses that give level centers corresponding to table 2 of WOA09 real, dimension(40) :: woa09_dz = (/ 5., 10., 10., 15., 22.5, 25., 25., 25., & @@ -226,7 +228,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m if (main_parameters) then ! Read coordinate units parameter (main model = REGRIDDING_COORDINATE_UNITS) call get_param(param_file, mdl, "REGRIDDING_COORDINATE_UNITS", coord_units, & - "Units of the regridding coordinuate.",& + "Units of the regridding coordinuate.",& !### Spelling error "coordinuate" default=coordinateUnits(coord_mode)) else coord_units=coordinateUnits(coord_mode) @@ -1473,7 +1475,7 @@ subroutine build_grid_HyCOM1( G, GV, h, tv, h_new, dzInterface, CS ) z_col(1) = 0. ! Work downward rather than bottom up do K = 1, GV%ke - z_col(K+1) = z_col(K) + h(i,j,k) ! Work in units of h (m or Pa) + z_col(K+1) = z_col(K) + h(i,j,k) ! Work in units of [H ~> m or kg m-2] p_col(k) = CS%ref_pressure + CS%compressibility_fraction * & ( 0.5 * ( z_col(K) + z_col(K+1) ) * GV%H_to_Pa - CS%ref_pressure ) enddo @@ -1605,7 +1607,7 @@ subroutine build_grid_SLight(G, GV, h, tv, dzInterface, CS) depth = G%bathyT(i,j) * GV%Z_to_H z_col(1) = 0. ! Work downward rather than bottom up do K=1,nz - z_col(K+1) = z_col(K) + h(i, j, k) ! Work in units of h (m or Pa) + z_col(K+1) = z_col(K) + h(i, j, k) ! Work in units of [H ~> m or kg m-2] p_col(k) = CS%ref_pressure + CS%compressibility_fraction * & ( 0.5 * ( z_col(K) + z_col(K+1) ) * GV%H_to_Pa - CS%ref_pressure ) enddo @@ -1901,7 +1903,7 @@ end subroutine convective_adjustment !------------------------------------------------------------------------------ -!> Return a uniform resolution vector in the units of the coordinata +!> Return a uniform resolution vector in the units of the coordinate function uniformResolution(nk,coordMode,maxDepth,rhoLight,rhoHeavy) !------------------------------------------------------------------------------ ! Calculate a vector of uniform resolution in the units of the coordinate @@ -2329,7 +2331,7 @@ end function get_rho_CS function getStaticThickness( CS, SSH, depth ) type(regridding_CS), intent(in) :: CS !< Regridding control structure real, intent(in) :: SSH !< The sea surface height, in the same units as depth - real, intent(in) :: depth !< The maximum depth of the grid, perhaps in m. + real, intent(in) :: depth !< The maximum depth of the grid, often [Z ~> m] real, dimension(CS%nk) :: getStaticThickness !< The returned thicknesses in the units of depth ! Local integer :: k diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index cbd54f6307..85ae345bfc 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -108,89 +108,88 @@ module MOM_CoriolisAdv !> Calculates the Coriolis and momentum advection contributions to the acceleration. subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) - type(ocean_grid_type), intent(in) :: G !< Ocen grid structure + type(ocean_grid_type), intent(in) :: G !< Ocen grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity (m/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg/m2) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uh !< Zonal transport u*h*dy (m3/s or kg/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh !< Meridional transport v*h*dx (m3/s or kg/s) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uh !< Zonal transport u*h*dy + !! [H m2 s-1 ~> m3 s-1 or kg s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh !< Meridional transport v*h*dx + !! [H m2 s-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: CAu !< Zonal acceleration due to Coriolis - !! and momentum advection, in m/s2. + !! and momentum advection [m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: CAv !< Meridional acceleration due to Coriolis - !! and momentum advection, in m/s2. + !! and momentum advection [m s-2]. type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(accel_diag_ptrs), intent(inout) :: AD !< Storage for acceleration diagnostics type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv - ! Local variables + ! Local variables real, dimension(SZIB_(G),SZJB_(G)) :: & - q, & ! Layer potential vorticity, in m-1 s-1. - Ih_q, & ! The inverse of thickness interpolated to q pointes, in - ! units of m-1 or m2 kg-1. - Area_q ! The sum of the ocean areas at the 4 adjacent thickness - ! points, in m2. + q, & ! Layer potential vorticity [m-1 s-1]. + Ih_q, & ! The inverse of thickness interpolated to q points [H-1 ~> m-1 or m2 kg-1]. + Area_q ! The sum of the ocean areas at the 4 adjacent thickness points [m2]. real, dimension(SZIB_(G),SZJ_(G)) :: & a, b, c, d ! a, b, c, & d are combinations of the potential vorticities ! surrounding an h grid point. At small scales, a = q/4, - ! b = q/4, etc. All are in units of m-1 s-1 or m2 kg-1 s-1, + ! b = q/4, etc. All are in [H-1 s-1 ~> m-1 s-1 or m2 kg-1 s-1], ! and use the indexing of the corresponding u point. real, dimension(SZI_(G),SZJ_(G)) :: & Area_h, & ! The ocean area at h points, in m2. Area_h is used to find the ! average thickness in the denominator of q. 0 for land points. - KE ! Kinetic energy per unit mass, KE = (u^2 + v^2)/2, in m2 s-2. + KE ! Kinetic energy per unit mass [m2 s-2], KE = (u^2 + v^2)/2. real, dimension(SZIB_(G),SZJ_(G)) :: & hArea_u, & ! The cell area weighted thickness interpolated to u points ! times the effective areas [H m2 ~> m3 or kg]. - KEx, & ! The zonal gradient of Kinetic energy per unit mass, - ! KEx = d/dx KE, in m s-2. - uh_center ! centered u times h at u-points + KEx, & ! The zonal gradient of Kinetic energy per unit mass [m s-2], + ! KEx = d/dx KE. + uh_center ! Transport based on arithmetic mean h at u-points [H m2 s-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G)) :: & hArea_v, & ! The cell area weighted thickness interpolated to v points ! times the effective areas [H m2 ~> m3 or kg]. - KEy, & ! The meridonal gradient of Kinetic energy per unit mass, - ! KEy = d/dy KE, in m s-2. - vh_center ! centered v times h at v-points + KEy, & ! The meridonal gradient of Kinetic energy per unit mass [m s-2], + ! KEy = d/dy KE. + vh_center ! Transport based on arithmetic mean h at v-points [H m2 s-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G)) :: & uh_min, uh_max, & ! The smallest and largest estimates of the volume - vh_min, vh_max, & ! fluxes through the faces (i.e. u*h*dy & v*h*dx), - ! in m3 s-1 or kg s-1. + vh_min, vh_max, & ! fluxes through the faces (i.e. u*h*dy & v*h*dx) + ! [H m2 s-1 ~> m3 s-1 or kg s-1]. ep_u, ep_v ! Additional pseudo-Coriolis terms in the Arakawa and Lamb - ! discretization, in m-1 s-1 or m2 kg-1 s-1. + ! discretization [H-1 s-1 ~> m-1 s-1 or m2 kg-1 s-1]. real, dimension(SZIB_(G),SZJB_(G)) :: & - dvdx,dudy, &! Contributions to the circulation around q-points (m2 s-1) - abs_vort, & ! Absolute vorticity at q-points, in s-1. - q2, & ! Relative vorticity over thickness. + dvdx,dudy, &! Contributions to the circulation around q-points [m2 s-1] + abs_vort, & ! Absolute vorticity at q-points [s-1]. + q2, & ! Relative vorticity over thickness [H-1 s-1 ~> m-1 s-1 or m2 kg-1 s-1]. max_fvq, & ! The maximum or minimum of the min_fvq, & ! adjacent values of (-u) or v times - max_fuq, & ! the absolute vorticity, in m s-2. + max_fuq, & ! the absolute vorticity [m s-2]. min_fuq ! All are defined at q points. real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & - PV, & ! A diagnostic array of the potential vorticities, in m-1 s-1. - RV ! A diagnostic array of the relative vorticities, in s-1. - real :: fv1, fv2, fu1, fu2 ! (f+rv)*v or (f+rv)*u in m s-2. - real :: max_fv, max_fu ! The maximum or minimum of the neighbor- - real :: min_fv, min_fu ! max(min)_fu(v)q, in m s-2. + PV, & ! A diagnostic array of the potential vorticities [m-1 s-1]. + RV ! A diagnostic array of the relative vorticities [s-1]. + real :: fv1, fv2, fu1, fu2 ! (f+rv)*v or (f+rv)*u [m s-2]. + real :: max_fv, max_fu ! The maximum or minimum of the neighboring Coriolis + real :: min_fv, min_fu ! accelerations [m s-2], i.e. max(min)_fu(v)q. real, parameter :: C1_12=1.0/12.0 ! C1_12 = 1/12 real, parameter :: C1_24=1.0/24.0 ! C1_24 = 1/24 - real :: absolute_vorticity ! Absolute vorticity, in s-1. - real :: relative_vorticity ! Relative vorticity, in s-1. - real :: Ih ! Inverse of thickness, m-1 or m2 kg-1. + real :: absolute_vorticity ! Absolute vorticity [s-1]. + real :: relative_vorticity ! Relative vorticity [s-1]. + real :: Ih ! Inverse of thickness [H-1 ~> m-1 or m2 kg-1]. real :: max_Ihq, min_Ihq ! The maximum and minimum of the nearby Ihq. real :: hArea_q ! The sum of area times thickness of the cells - ! surrounding a q point, in m3 or kg. + ! surrounding a q point [H m2 ~> m3 or kg]. real :: h_neglect ! A thickness that is so small it is usually - ! lost in roundoff and can be neglected, in m. - real :: temp1, temp2 ! Temporary variables, in m2 s-2. - real, parameter :: eps_vel=1.0e-10 ! A tiny, positive velocity, in m s-1. + ! lost in roundoff and can be neglected [H ~> m or kg m-2]. + real :: temp1, temp2 ! Temporary variables [m2 s-2]. + real, parameter :: eps_vel=1.0e-10 ! A tiny, positive velocity [m s-1]. - real :: uhc, vhc ! Centered estimates of uh and vh in m3 s-1 or kg s-1. - real :: uhm, vhm ! The input estimates of uh and vh in m3 s-1 or kg s-1. - real :: c1, c2, c3, slope ! Nondimensional parameters for the Coriolis - ! limiter scheme. + real :: uhc, vhc ! Centered estimates of uh and vh [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: uhm, vhm ! The input estimates of uh and vh [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: c1, c2, c3, slope ! Nondimensional parameters for the Coriolis limiter scheme. real :: Fe_m2 ! Nondimensional temporary variables asssociated with real :: rat_lin ! the ARAKAWA_LAMB_BLEND scheme. @@ -202,11 +201,11 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) ! the other two with the ARAKAWA_LAMB_BLEND scheme, ! nondimensional between 0 and 1. - real :: Heff1, Heff2 ! Temporary effective H at U or V points in m or kg m-2. - real :: Heff3, Heff4 ! Temporary effective H at U or V points in m or kg m-2. - real :: h_tiny ! A very small thickness, in m or kg m-2. - real :: UHeff, VHeff ! More temporary variables, in m3 s-1 or kg s-1. - real :: QUHeff,QVHeff ! More temporary variables, in m3 s-2 or kg s-2. + real :: Heff1, Heff2 ! Temporary effective H at U or V points [H ~> m or kg m-2]. + real :: Heff3, Heff4 ! Temporary effective H at U or V points [H ~> m or kg m-2]. + real :: h_tiny ! A very small thickness [H ~> m or kg m-2]. + real :: UHeff, VHeff ! More temporary variables [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: QUHeff,QVHeff ! More temporary variables [H m2 s-1 ~> m3 s-1 or kg s-1]. integer :: i, j, k, n, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz ! To work, the following fields must be set outside of the usual @@ -839,21 +838,21 @@ end subroutine CorAdCalc !> Calculates the acceleration due to the gradient of kinetic energy. subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, CS) type(ocean_grid_type), intent(in) :: G !< Ocen grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity (m/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg/m2) - real, dimension(SZI_(G) ,SZJ_(G) ), intent(out) :: KE !< Kinetic energy (m2/s2) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G) ,SZJ_(G) ), intent(out) :: KE !< Kinetic energy [m2 s-2] real, dimension(SZIB_(G),SZJ_(G) ), intent(out) :: KEx !< Zonal acceleration due to kinetic - !! energy gradient (m/s2) + !! energy gradient [m s-2] real, dimension(SZI_(G) ,SZJB_(G)), intent(out) :: KEy !< Meridional acceleration due to kinetic - !! energy gradient (m/s2) + !! energy gradient [m s-2] integer, intent(in) :: k !< Layer number to calculate for type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv ! Local variables - real :: um, up, vm, vp ! Temporary variables with units of m s-1. - real :: um2, up2, vm2, vp2 ! Temporary variables with units of m2 s-2. - real :: um2a, up2a, vm2a, vp2a ! Temporary variables with units of m4 s-2. + real :: um, up, vm, vp ! Temporary variables [m s-1]. + real :: um2, up2, vm2, vp2 ! Temporary variables [m2 s-2]. + real :: um2a, up2a, vm2a, vp2a ! Temporary variables [m4 s-2]. integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, n is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 2d0f0156ae..97e032500b 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -31,8 +31,8 @@ module MOM_PressureForce_Mont type, public :: PressureForce_Mont_CS ; private logical :: tides !< If true, apply tidal momentum forcing. real :: Rho0 !< The density used in the Boussinesq - !! approximation, in kg m-3. - real :: Rho_atm !< The assumed atmospheric density, in kg m-3. + !! approximation [kg m-3]. + real :: Rho_atm !< The assumed atmospheric density [kg m-3]. !! By default, Rho_atm is 0. real :: GFS_scale !< Ratio between gravity applied to top interface !! and the gravitational acceleration of the planet. @@ -76,14 +76,14 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: pbce !< The baroclinic pressure anomaly in !! each layer due to free surface height anomalies, - !! in m2 s-2 H-1. + !! [m2 s-2 H-1 ~> m s-2 or m4 kg-1 s-2]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< Free surface height, in m. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - M, & ! The Montgomery potential, M = (p/rho + gz) , in m2 s-2. + M, & ! The Montgomery potential, M = (p/rho + gz) [m2 s-2]. alpha_star, & ! Compression adjusted specific volume, in m3 kg-1. - dz_geo ! The change in geopotential across a layer, in m2 s-2. + dz_geo ! The change in geopotential across a layer [m2 s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure in Pa. ! p may be adjusted (with a nonlinear equation of state) so that ! its derivative compensates for the adiabatic compressibility @@ -92,28 +92,28 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb T_tmp, & ! Temporary array of temperatures where layers that are lighter ! than the mixed layer have the mixed layer's properties, in C. S_tmp ! Temporary array of salinities where layers that are lighter - ! than the mixed layer have the mixed layer's properties, in psu. + ! than the mixed layer have the mixed layer's properties [PSU]. real, dimension(SZI_(G)) :: Rho_cv_BL ! The coordinate potential density in the - ! deepest variable density near-surface layer, in kg m-3. + ! deepest variable density near-surface layer [kg m-3]. real, dimension(SZI_(G),SZJ_(G)) :: & dM, & ! A barotropic correction to the Montgomery potentials to ! enable the use of a reduced gravity form of the equations, ! in m2 s-2. - dp_star, & ! Layer thickness after compensation for compressibility, in Pa. + dp_star, & ! Layer thickness after compensation for compressibility [Pa]. SSH, & ! The sea surface height anomaly, in depth units [Z ~> m]. e_tidal, & ! Bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. geopot_bot ! Bottom geopotential relative to time-mean sea level, - ! including any tidal contributions, in units of m2 s-2. + ! including any tidal contributions [m2 s-2]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, in Pa (usually 2e7 Pa = 2000 dbar). - real :: rho_in_situ(SZI_(G)) !In-situ density of a layer, in kg m-3. + real :: rho_in_situ(SZI_(G)) !In-situ density of a layer [kg m-3]. real :: PFu_bc, PFv_bc ! The pressure gradient force due to along-layer - ! compensated density gradients, in m s-2. + ! compensated density gradients [m s-2] real :: dp_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in Pa. + ! in roundoff and can be neglected [Pa]. logical :: use_p_atm ! If true, use the atmospheric pressure. logical :: use_EOS ! If true, density is calculated from T & S using ! an equation of state. @@ -125,9 +125,9 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb real :: I_gEarth ! The inverse of g_Earth, in s2 Z m-2 real :: dalpha real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). - real :: alpha_Lay(SZK_(G)) ! The specific volume of each layer, in kg m-3. + real :: alpha_Lay(SZK_(G)) ! The specific volume of each layer [kg m-3]. real :: dalpha_int(SZK_(G)+1) ! The change in specific volume across each - ! interface, in kg m-3. + ! interface [kg m-3]. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer :: i, j, k is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -362,7 +362,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration due to pressure gradients !! (equal to -dM/dx) in m/s2. @@ -372,26 +372,26 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean in Pa. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure anomaly in - !! each layer due to free surface height anomalies, - !! in m2 s-2 H-1. + !! each layer due to free surface height anomalies + !! [m2 s-2 H-1 ~> m s-2]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< Free surface height, in m. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - M, & ! The Montgomery potential, M = (p/rho + gz) , in m2 s-2. + M, & ! The Montgomery potential, M = (p/rho + gz) [m2 s-2]. rho_star ! In-situ density divided by the derivative with depth of the - ! corrected e times (G_Earth/Rho0). In units of m s-2. + ! corrected e times (G_Earth/Rho0) [m2 Z-1 s-2 ~> m s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in m. - ! e may be adjusted (with a nonlinearequation of state) so that + ! e may be adjusted (with a nonlinear equation of state) so that ! its derivative compensates for the adiabatic compressibility ! in seawater, but e will still be close to the interface depth. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & T_tmp, & ! Temporary array of temperatures where layers that are lighter - ! than the mixed layer have the mixed layer's properties, in C. + ! than the mixed layer have the mixed layer's properties [degC]. S_tmp ! Temporary array of salinities where layers that are lighter - ! than the mixed layer have the mixed layer's properties, in psu. + ! than the mixed layer have the mixed layer's properties [PSU]. real :: Rho_cv_BL(SZI_(G)) ! The coordinate potential density in - ! the deepest variable density near-surface layer, in kg m-3. + ! the deepest variable density near-surface layer [kg m-3]. real :: h_star(SZI_(G),SZJ_(G)) ! Layer thickness after compensation ! for compressibility [Z ~> m]. real :: e_tidal(SZI_(G),SZJ_(G)) ! Bottom geopotential anomaly due to tidal @@ -399,10 +399,10 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ! attraction and loading, in depth units [Z ~> m]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, in Pa (usually 2e7 Pa = 2000 dbar). - real :: I_Rho0 ! 1/Rho0, in m3 kg-1. - real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. + real :: I_Rho0 ! 1/Rho0 [m3 kg-1]. + real :: G_Rho0 ! G_Earth / Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. real :: PFu_bc, PFv_bc ! The pressure gradient force due to along-layer - ! compensated density gradients, in m s-2. + ! compensated density gradients [m s-2] real :: dr ! Temporary variables. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. @@ -608,7 +608,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height [Z ~> m]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, intent(in) :: Rho0 !< The "Boussinesq" ocean density, in kg m-3. + real, intent(in) :: Rho0 !< The "Boussinesq" ocean density [kg m-3]. real, intent(in) :: GFS_scale !< Ratio between gravity applied to top interface !! and the gravitational acceleration of the planet. !! Usually this ratio is 1. @@ -621,7 +621,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) ! Local variables real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer thicknesses [H-1 ~> m-1 or m2 kg-1]. - real :: press(SZI_(G)) ! Interface pressure, in Pa. + real :: press(SZI_(G)) ! Interface pressure [Pa]. real :: T_int(SZI_(G)) ! Interface temperature in C. real :: S_int(SZI_(G)) ! Interface salinity in PSU. real :: dR_dT(SZI_(G)) ! Partial derivatives of density with temperature @@ -705,7 +705,7 @@ end subroutine Set_pbce_Bouss subroutine Set_pbce_nonBouss(p, tv, G, GV, GFS_scale, pbce, alpha_star) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: p !< Interface pressures, in Pa. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: p !< Interface pressures [Pa]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, intent(in) :: GFS_scale !< Ratio between gravity applied to top interface !! and the gravitational acceleration of the planet. @@ -723,14 +723,14 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, GFS_scale, pbce, alpha_star) real :: S_int(SZI_(G)) ! Interface salinity in PSU. real :: dR_dT(SZI_(G)) ! Partial derivatives of density with temperature real :: dR_dS(SZI_(G)) ! and salinity in kg m-3 K-1 and kg m-3 PSU-1. - real :: rho_in_situ(SZI_(G)) !In-situ density at an interface, in kg m-3. - real :: alpha_Lay(SZK_(G)) ! The specific volume of each layer, in kg m-3. + real :: rho_in_situ(SZI_(G)) !In-situ density at an interface [kg m-3]. + real :: alpha_Lay(SZK_(G)) ! The specific volume of each layer [kg m-3]. real :: dalpha_int(SZK_(G)+1) ! The change in specific volume across each - ! interface, in kg m-3. + ! interface [kg m-3]. real :: dP_dH ! A factor that converts from thickness to pressure, ! usually in Pa m2 kg-1. real :: dp_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in Pa. + ! in roundoff and can be neglected [Pa]. logical :: use_EOS ! If true, density is calculated from T & S using ! an equation of state. integer :: Isq, Ieq, Jsq, Jeq, nz, i, j, k diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index b1536f1c2c..1776638127 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -36,7 +36,7 @@ module MOM_PressureForce_AFV type, public :: PressureForce_AFV_CS ; private logical :: tides !< If true, apply tidal momentum forcing. real :: Rho0 !< The density used in the Boussinesq - !! approximation, in kg m-3. + !! approximation [kg m-3]. real :: GFS_scale !< A scaling of the surface pressure gradients to !! allow the use of a reduced gravity model. type(time_type), pointer :: Time !< A pointer to the ocean model's clock. @@ -67,7 +67,7 @@ subroutine PressureForce_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbc type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration (m/s2) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration (m/s2) @@ -123,42 +123,42 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p T_tmp, & ! Temporary array of temperatures where layers that are lighter ! than the mixed layer have the mixed layer's properties, in C. S_tmp ! Temporary array of salinities where layers that are lighter - ! than the mixed layer have the mixed layer's properties, in psu. + ! than the mixed layer have the mixed layer's properties [PSU]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & S_t, S_b, T_t, T_b ! Top and bottom edge values for linear reconstructions ! of salinity and temperature within each layer. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & dza, & ! The change in geopotential anomaly between the top and bottom - ! of a layer, in m2 s-2. + ! of a layer [m2 s-2]. intp_dza ! The vertical integral in depth of the pressure anomaly less ! the pressure anomaly at the top of the layer, in Pa m2 s-2. real, dimension(SZI_(G),SZJ_(G)) :: & - dp, & ! The (positive) change in pressure across a layer, in Pa. + dp, & ! The (positive) change in pressure across a layer [Pa]. SSH, & ! The sea surface height anomaly, in depth units [Z ~> m]. e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. dM, & ! The barotropic adjustment to the Montgomery potential to - ! account for a reduced gravity model, in m2 s-2. + ! account for a reduced gravity model [m2 s-2]. za ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the - ! interface atop a layer, in m2 s-2. + ! interface atop a layer [m2 s-2]. real, dimension(SZI_(G)) :: Rho_cv_BL ! The coordinate potential density in the deepest variable - ! density near-surface layer, in kg m-3. + ! density near-surface layer [kg m-3]. real, dimension(SZIB_(G),SZJ_(G)) :: & intx_za ! The zonal integral of the geopotential anomaly along the ! interface below a layer, divided by the grid spacing, m2 s-2. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & - intx_dza ! The change in intx_za through a layer, in m2 s-2. + intx_dza ! The change in intx_za through a layer [m2 s-2]. real, dimension(SZI_(G),SZJB_(G)) :: & inty_za ! The meridional integral of the geopotential anomaly along the ! interface below a layer, divided by the grid spacing, m2 s-2. real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & - inty_dza ! The change in inty_za through a layer, in m2 s-2. + inty_dza ! The change in inty_za through a layer [m2 s-2]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, in Pa (usually 2e7 Pa = 2000 dbar). real :: dp_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in Pa. + ! in roundoff and can be neglected [Pa]. real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. real :: I_gEarth ! The inverse of g_Earth_z, in s2 Z m-2 real :: alpha_anom ! The in-situ specific volume, averaged over a @@ -171,7 +171,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p real :: alpha_ref ! A reference specific volume, in m3 kg-1, that is used ! to reduce the impact of truncation errors. - real :: rho_in_situ(SZI_(G)) ! The in situ density, in kg m-3. + real :: rho_in_situ(SZI_(G)) ! The in situ density [kg m-3]. real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). ! real :: oneatm = 101325.0 ! 1 atm in Pa (kg/ms2) real, parameter :: C1_6 = 1.0/6.0 @@ -464,36 +464,36 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. dM ! The barotropic adjustment to the Montgomery potential to - ! account for a reduced gravity model, in m2 s-2. + ! account for a reduced gravity model [m2 s-2]. real, dimension(SZI_(G)) :: & Rho_cv_BL ! The coordinate potential density in the deepest variable - ! density near-surface layer, in kg m-3. + ! density near-surface layer [kg m-3]. real, dimension(SZI_(G),SZJ_(G)) :: & dz, & ! The change in geopotential thickness through a layer, m2 s-2. pa, & ! The pressure anomaly (i.e. pressure + g*RHO_0*e) at the - ! the interface atop a layer, in Pa. + ! the interface atop a layer [Pa]. dpa, & ! The change in pressure anomaly between the top and bottom - ! of a layer, in Pa. + ! of a layer [Pa]. intz_dpa ! The vertical integral in depth of the pressure anomaly less the ! pressure anomaly at the top of the layer [H Pa ~> m Pa or kg m-2 Pa]. real, dimension(SZIB_(G),SZJ_(G)) :: & intx_pa, & ! The zonal integral of the pressure anomaly along the interface - ! atop a layer, divided by the grid spacing, in Pa. - intx_dpa ! The change in intx_pa through a layer, in Pa. + ! atop a layer, divided by the grid spacing [Pa]. + intx_dpa ! The change in intx_pa through a layer [Pa]. real, dimension(SZI_(G),SZJB_(G)) :: & inty_pa, & ! The meridional integral of the pressure anomaly along the - ! interface atop a layer, divided by the grid spacing, in Pa. - inty_dpa ! The change in inty_pa through a layer, in Pa. + ! interface atop a layer, divided by the grid spacing [Pa]. + inty_dpa ! The change in inty_pa through a layer [Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & T_tmp, & ! Temporary array of temperatures where layers that are lighter ! than the mixed layer have the mixed layer's properties, in C. S_tmp ! Temporary array of salinities where layers that are lighter - ! than the mixed layer have the mixed layer's properties, in psu. + ! than the mixed layer have the mixed layer's properties [PSU]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & S_t, S_b, T_t, T_b ! Top and bottom edge values for linear reconstructions ! of salinity and temperature within each layer. - real :: rho_in_situ(SZI_(G)) ! The in situ density, in kg m-3. + real :: rho_in_situ(SZI_(G)) ! The in situ density [kg m-3]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, in Pa (usually 2e7 Pa = 2000 dbar). real :: p0(SZI_(G)) ! An array of zeros to use for pressure in Pa. diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index c06cf2c90b..73a4440b9c 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -36,7 +36,7 @@ module MOM_PressureForce_blk_AFV type, public :: PressureForce_blk_AFV_CS ; private logical :: tides !< If true, apply tidal momentum forcing. real :: Rho0 !< The density used in the Boussinesq - !! approximation, in kg m-3. + !! approximation [kg m-3]. real :: GFS_scale !< A scaling of the surface pressure gradients to !! allow the use of a reduced gravity model. type(time_type), pointer :: Time !< A pointer to the ocean model's clock. @@ -67,7 +67,7 @@ subroutine PressureForce_blk_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration (m/s2) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration (m/s2) @@ -122,43 +122,43 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, T_tmp, & ! Temporary array of temperatures where layers that are lighter ! than the mixed layer have the mixed layer's properties, in C. S_tmp ! Temporary array of salinities where layers that are lighter - ! than the mixed layer have the mixed layer's properties, in psu. + ! than the mixed layer have the mixed layer's properties [PSU]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & dza, & ! The change in geopotential anomaly between the top and bottom - ! of a layer, in m2 s-2. + ! of a layer [m2 s-2]. intp_dza ! The vertical integral in depth of the pressure anomaly less ! the pressure anomaly at the top of the layer, in Pa m2 s-2. real, dimension(SZI_(G),SZJ_(G)) :: & - dp, & ! The (positive) change in pressure across a layer, in Pa. + dp, & ! The (positive) change in pressure across a layer [Pa]. SSH, & ! The sea surface height anomaly, in depth units [Z ~> m]. e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. dM, & ! The barotropic adjustment to the Montgomery potential to - ! account for a reduced gravity model, in m2 s-2. + ! account for a reduced gravity model [m2 s-2]. za ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the - ! interface atop a layer, in m2 s-2. + ! interface atop a layer [m2 s-2]. real, dimension(SZDI_(G%Block(1)),SZDJ_(G%Block(1))) :: & ! on block indices - dp_bk, & ! The (positive) change in pressure across a layer, in Pa. + dp_bk, & ! The (positive) change in pressure across a layer [Pa]. za_bk ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the - ! interface atop a layer, in m2 s-2. + ! interface atop a layer [m2 s-2]. real, dimension(SZI_(G)) :: Rho_cv_BL ! The coordinate potential density in the deepest variable - ! density near-surface layer, in kg m-3. + ! density near-surface layer [kg m-3]. real, dimension(SZDIB_(G%Block(1)),SZDJ_(G%Block(1))) :: & ! on block indices intx_za_bk ! The zonal integral of the geopotential anomaly along the ! interface below a layer, divided by the grid spacing, m2 s-2. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & - intx_dza ! The change in intx_za through a layer, in m2 s-2. + intx_dza ! The change in intx_za through a layer [m2 s-2]. real, dimension(SZDI_(G%Block(1)),SZDJB_(G%Block(1))) :: & ! on block indices inty_za_bk ! The meridional integral of the geopotential anomaly along the ! interface below a layer, divided by the grid spacing, m2 s-2. real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & - inty_dza ! The change in inty_za through a layer, in m2 s-2. + inty_dza ! The change in inty_za through a layer [m2 s-2]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, in Pa (usually 2e7 Pa = 2000 dbar). real :: dp_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in Pa. + ! in roundoff and can be neglected [Pa]. real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. real :: I_gEarth ! The inverse of g_Earth_z [s2 Z m-2 ~> s2 m-1] real :: alpha_anom ! The in-situ specific volume, averaged over a @@ -170,7 +170,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, real :: alpha_ref ! A reference specific volume, in m3 kg-1, that is used ! to reduce the impact of truncation errors. - real :: rho_in_situ(SZI_(G)) ! The in situ density, in kg m-3. + real :: rho_in_situ(SZI_(G)) ! The in situ density [kg m-3]. real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). ! real :: oneatm = 101325.0 ! 1 atm in Pa (kg/ms2) real, parameter :: C1_6 = 1.0/6.0 @@ -447,36 +447,36 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading, in depth units [Z ~> m]. dM ! The barotropic adjustment to the Montgomery potential to - ! account for a reduced gravity model, in m2 s-2. + ! account for a reduced gravity model [m2 s-2]. real, dimension(SZI_(G)) :: & Rho_cv_BL ! The coordinate potential density in the deepest variable - ! density near-surface layer, in kg m-3. + ! density near-surface layer [kg m-3]. real, dimension(SZDI_(G%Block(1)),SZDJ_(G%Block(1))) :: & ! on block indices dz_bk, & ! The change in geopotential thickness through a layer, m2 s-2. pa_bk, & ! The pressure anomaly (i.e. pressure + g*RHO_0*e) at the - ! the interface atop a layer, in Pa. + ! the interface atop a layer [Pa]. dpa_bk, & ! The change in pressure anomaly between the top and bottom - ! of a layer, in Pa. + ! of a layer [Pa]. intz_dpa_bk ! The vertical integral in depth of the pressure anomaly less the ! pressure anomaly at the top of the layer [H Pa ~> m Pa or kg m-2 Pa]. real, dimension(SZDIB_(G%Block(1)),SZDJ_(G%Block(1))) :: & ! on block indices intx_pa_bk, & ! The zonal integral of the pressure anomaly along the interface - ! atop a layer, divided by the grid spacing, in Pa. - intx_dpa_bk ! The change in intx_pa through a layer, in Pa. + ! atop a layer, divided by the grid spacing [Pa]. + intx_dpa_bk ! The change in intx_pa through a layer [Pa]. real, dimension(SZDI_(G%Block(1)),SZDJB_(G%Block(1))) :: & ! on block indices inty_pa_bk, & ! The meridional integral of the pressure anomaly along the - ! interface atop a layer, divided by the grid spacing, in Pa. - inty_dpa_bk ! The change in inty_pa through a layer, in Pa. + ! interface atop a layer, divided by the grid spacing [Pa]. + inty_dpa_bk ! The change in inty_pa through a layer [Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & T_tmp, & ! Temporary array of temperatures where layers that are lighter ! than the mixed layer have the mixed layer's properties, in C. S_tmp ! Temporary array of salinities where layers that are lighter - ! than the mixed layer have the mixed layer's properties, in psu. + ! than the mixed layer have the mixed layer's properties [PSU]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & S_t, S_b, T_t, T_b ! Top and bottom edge values for linear reconstructions ! of salinity and temperature within each layer. - real :: rho_in_situ(SZI_(G)) ! The in situ density, in kg m-3. + real :: rho_in_situ(SZI_(G)) ! The in situ density [kg m-3]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, in Pa (usually 2e7 Pa = 2000 dbar). real :: p0(SZI_(G)) ! An array of zeros to use for pressure in Pa. diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 4a943ca84c..3dabe03fb1 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -74,9 +74,9 @@ module MOM_barotropic real, dimension(:,:), pointer :: vhbt => NULL() !< The meridional barotropic thickness fluxes specified !! for open boundary conditions (if any) [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(:,:), pointer :: ubt_outer => NULL() !< The zonal velocities just outside the domain, - !! as set by the open boundary conditions, in units of m s-1. + !! as set by the open boundary conditions [m s-1]. real, dimension(:,:), pointer :: vbt_outer => NULL() !< The meridional velocities just outside the domain, - !! as set by the open boundary conditions, in units of m s-1. + !! as set by the open boundary conditions [m s-1]. real, dimension(:,:), pointer :: eta_outer_u => NULL() !< The surface height outside of the domain !! at a u-point with an open boundary condition [H ~> m or kg m-2]. real, dimension(:,:), pointer :: eta_outer_v => NULL() !< The surface height outside of the domain @@ -402,7 +402,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! in m s-2. type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: pbce !< The baroclinic pressure anomaly in each layer - !! due to free surface height anomalies, in m2 H-1 s-2. + !! due to free surface height anomalies + !! [m2 H-1 s-2 ~> m s-2 or m4 kg-1 s-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta_PF_in !< The 2-D eta field (either SSH anomaly or !! column mass anomaly) that was used to calculate the input !! pressure gradient accelerations (or its final value if @@ -496,8 +497,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ubt_trans, & ! The latest value of ubt used for a transport, in m s-1. azon, bzon, & ! _zon & _mer are the values of the Coriolis force which czon, dzon, & ! are applied to the neighboring values of vbtav & ubtav, - amer, bmer, & ! respectively to get the barotropic inertial rotation, - cmer, dmer, & ! in units of s-1. + amer, bmer, & ! respectively to get the barotropic inertial rotation + cmer, dmer, & ! [s-1]. Cor_u, & ! The zonal Coriolis acceleration, in m s-2. Cor_ref_u, & ! The zonal barotropic Coriolis acceleration due ! to the reference velocities, in m s-2. @@ -559,8 +560,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, gtot_E, & ! gtot_X is the effective total reduced gravity used to relate gtot_W, & ! free surface height deviations to pressure forces (including gtot_N, & ! GFS and baroclinic contributions) in the barotropic momentum - gtot_S, & ! equations half a grid-point in the X-direction (X is N, S, - ! E, or W) from the thickness point. gtot_X has units of m2 H-1 s-2. + gtot_S, & ! equations half a grid-point in the X-direction (X is N, S, E, or W) + ! from the thickness point [m2 H-1 s-2 ~> m s-2 or m4 kg-1 s-2]. ! (See Hallberg, J Comp Phys 1997 for a discussion.) eta_src, & ! The source of eta per barotropic timestep, in m or kg m-2. dyn_coef_eta, & ! The coefficient relating the changes in eta to the @@ -1405,12 +1406,12 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, dyn_coef_max = CS%const_dyn_psurf * max(0.0, 1.0 - dtbt**2 * Idt_max2) / & (dtbt**2 * H_eff_dx2) - ! ice_strength has units of m s-2. rigidity_ice_[uv] has units of m3 s-1. + ! ice_strength has units of [m s-2]. rigidity_ice_[uv] has units of [m3 s-1]. ice_strength = ((forces%rigidity_ice_u(I,j) + forces%rigidity_ice_u(I-1,j)) + & (forces%rigidity_ice_v(i,J) + forces%rigidity_ice_v(i,J-1))) / & (CS%ice_strength_length**2 * dtbt) - ! Units of dyn_coef: m2 s-2 H-1 + ! Units of dyn_coef: [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1] dyn_coef_eta(i,j) = min(dyn_coef_max, ice_strength * GV%H_to_m) enddo ; enddo ; endif endif @@ -2274,7 +2275,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) !! height anomaly or column mass anomaly [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: pbce !< The baroclinic pressure !! anomaly in each layer due to free surface - !! height anomalies, in m2 H-1 s-2. + !! height anomalies [m2 H-1 s-2 ~> m s-2 or m4 kg-1 s-2]. type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe !! the effective open face areas as a !! function of barotropic flow. @@ -2289,8 +2290,8 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) gtot_E, & ! gtot_X is the effective total reduced gravity used to relate gtot_W, & ! free surface height deviations to pressure forces (including gtot_N, & ! GFS and baroclinic contributions) in the barotropic momentum - gtot_S ! equations half a grid-point in the X-direction (X is N, S, - ! E, or W) from the thickness point. gtot_X has units of m2 H-1 s-2. + gtot_S ! equations half a grid-point in the X-direction (X is N, S, E, or W) + ! from the thickness point [m2 H-1 s-2 ~> m s-2 or m4 kg-1 s-2]. ! (See Hallberg, J Comp Phys 1997 for a discussion.) real, dimension(SZIBS_(G),SZJ_(G)) :: & Datu ! Basin depth at u-velocity grid points times the y-grid diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 0131599340..a0669a4ef9 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -75,9 +75,8 @@ module MOM_continuity_PPM subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, & visc_rem_u, visc_rem_v, u_cor, v_cor, & uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) - ! In the following documentation, H is used for the units of thickness (usually m or kg m-2.) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(continuity_PPM_CS), pointer :: CS !< Module's control structure. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(continuity_PPM_CS), pointer :: CS !< Module's control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< Zonal velocity, in m s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -87,15 +86,17 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Final layer thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: uh !< Zonal volume flux, u*h*dy, H m2 s-1. + intent(out) :: uh !< Zonal volume flux, u*h*dy [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: vh !< Meridional volume flux, v*h*dx, H m2 s-1. + intent(out) :: vh !< Meridional volume flux, v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. real, intent(in) :: dt !< Time increment in s. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(in) :: uhbt !< The summed volume flux through zonal faces, H m2 s-1. + optional, intent(in) :: uhbt !< The summed volume flux through zonal faces + !! [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(in) :: vhbt !< The summed volume flux through meridional faces, H m2 s-1. + optional, intent(in) :: vhbt !< The summed volume flux through meridional faces + !! [H m2 s-1 ~> m3 s-1 or kg s-1]. type(ocean_OBC_type), & optional, pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -234,7 +235,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h_in !< Layer thickness used to calculate fluxes [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: uh !< Volume flux through zonal faces = u*h*dy, H m2 s-1. + intent(out) :: uh !< Volume flux through zonal faces = u*h*dy + !! [H m2 s-1 ~> m3 s-1 or kg s-1]. real, intent(in) :: dt !< Time increment in s. type(continuity_PPM_CS), pointer :: CS !< This module's control structure. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. @@ -247,7 +249,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & !! acceleration that a layer experiences after viscosity is applied. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(in) :: uhbt !< The summed volume flux through zonal faces, H m2 s-1. + optional, intent(in) :: uhbt !< The summed volume flux through zonal faces + !! [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt_aux !< A second set of summed volume fluxes through zonal faces [H m2 s-1 ~> m3 s-1 or kg s-1]. @@ -733,7 +736,8 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & !! experiences after viscosity is applied. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G)), optional, intent(in) :: uhbt !< The summed volume flux - !! through zonal faces, H m2 s-1. + !! through zonal faces [H m2 s-1 ~> m3 s-1 or kg s-1]. + real, dimension(SZIB_(G)), intent(in) :: du_max_CFL !< Maximum acceptable !! value of du, in m s-1. real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable @@ -755,7 +759,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & !! A flag indicating how carefully to iterate. The !! default is .true. (more accurate). real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), optional, intent(inout) :: uh_3d !< - !! Volume flux through zonal faces = u*h*dy, H m2 s-1. + !! Volume flux through zonal faces = u*h*dy [H m2 s-1 ~> m3 s-1 or kg s-1]. type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZIB_(G),SZK_(G)) :: & @@ -1051,7 +1055,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vh !< Volume flux through meridional - !! faces = v*h*dx, H m2 s-1. + !! faces = v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. real, intent(in) :: dt !< Time increment in s. type(continuity_PPM_CS), pointer :: CS !< This module's control structure. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. @@ -1064,7 +1068,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & !! that a layer experiences after viscosity is applied. Nondimensional between !! 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vhbt !< The summed volume flux through - !< meridional faces, H m2 s-1. + !< meridional faces [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vhbt_aux !< A second set of summed volume fluxes !! through meridional faces [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 969bce8786..44c57576d8 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -68,14 +68,14 @@ module MOM_dynamics_split_RK2 !> MOM_dynamics_split_RK2 module control structure type, public :: MOM_dyn_split_RK2_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - CAu, & !< CAu = f*v - u.grad(u) in m s-2. - PFu, & !< PFu = -dM/dx, in m s-2. - diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor, in m s-2. + CAu, & !< CAu = f*v - u.grad(u) [m s-2] + PFu, & !< PFu = -dM/dx [m s-2] + diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-2] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - CAv, & !< CAv = -f*u - u.grad(v) in m s-2. - PFv, & !< PFv = -dM/dy, in m s-2. - diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor, in m s-2. + CAv, & !< CAv = -f*u - u.grad(v) [m s-2] + PFv, & !< PFv = -dM/dy [m s-2] + diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-2] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: visc_rem_u !< Both the fraction of the zonal momentum originally in a @@ -86,7 +86,7 @@ module MOM_dynamics_split_RK2 real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_accel_bt !< The zonal layer accelerations due to the difference between !! the barotropic accelerations and the baroclinic accelerations - !! that were fed into the barotopic calculation, in m s-2. + !! that were fed into the barotopic calculation [m s-2] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: visc_rem_v !< Both the fraction of the meridional momentum originally in !! a layer that remains after a time-step of viscosity, and the @@ -96,7 +96,7 @@ module MOM_dynamics_split_RK2 real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_accel_bt !< The meridional layer accelerations due to the difference between !! the barotropic accelerations and the baroclinic accelerations - !! that were fed into the barotopic calculation, in m s-2. + !! that were fed into the barotopic calculation [m s-2] ! The following variables are only used with the split time stepping scheme. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta !< Instantaneous free surface height (in Boussinesq @@ -104,26 +104,26 @@ module MOM_dynamics_split_RK2 !! mode) [H ~> m or kg m-2] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_av !< layer x-velocity with vertical mean replaced by !! time-mean barotropic velocity over a baroclinic - !! timestep (m s-1) + !! timestep [m s-1] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_av !< layer y-velocity with vertical mean replaced by !! time-mean barotropic velocity over a baroclinic - !! timestep (m s-1) + !! timestep [m s-1] real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: h_av !< arithmetic mean of two successive layer - !! thicknesses (m or kg m-2) + !! thicknesses [H ~> m or kg m-2] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_PF !< instantaneous SSH used in calculating PFu and - !! PFv (meter) + !! PFv [H ~> m or kg m-2] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt !< average x-volume or mass flux determined by the - !! barotropic solver (m3 s-1 or kg s-1). uhbt should - !! be (roughly?) equal to vertical sum of uh. + !! barotropic solver [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! uhbt is roughly equal to the vertical sum of uh. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt !< average y-volume or mass flux determined by the - !! barotropic solver (m3 s-1 or kg s-1). vhbt should - !! be (roughly?) equal to vertical sum of vh. + !! barotropic solver [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! vhbt is roughly equal to vertical sum of vh. real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: pbce !< pbce times eta gives the baroclinic pressure !! anomaly in each layer due to free surface height - !! anomalies. pbce has units of m2 H-1 s-2. + !! anomalies [m2 H-1 s-2 ~> m s-2 or m4 kg-1 s-2]. - real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor (Pa) - real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor (Pa) + real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor [Pa] + real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor [Pa] type(BT_cont_type), pointer :: BT_cont => NULL() !< A structure with elements that describe the !! effective summed open face areas as a function !! of barotropic flow. @@ -239,28 +239,30 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & target, intent(inout) :: v !< merid velocity (m/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< layer thickness (m or kg/m2) + intent(inout) :: h !< layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic type type(vertvisc_type), intent(inout) :: visc !< vertical visc, bottom drag, and related type(time_type), intent(in) :: Time_local !< model time at end of time step real, intent(in) :: dt !< time step (sec) type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, dimension(:,:), pointer :: p_surf_begin !< surf pressure at start of this dynamic - !! time step (Pa) + !! time step [Pa] real, dimension(:,:), pointer :: p_surf_end !< surf pressure at end of this dynamic - !! time step (Pa) + !! time step [Pa] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - target, intent(inout) :: uh !< zonal volume/mass transport (m3/s or kg/s) + target, intent(inout) :: uh !< zonal volume/mass transport + !! [H m2 s-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - target, intent(inout) :: vh !< merid volume/mass transport (m3/s or kg/s) + target, intent(inout) :: vh !< merid volume/mass transport + !! [H m2 s-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(inout) :: uhtr !< accumulatated zonal volume/mass transport - !! since last tracer advection (m3 or kg) + !! since last tracer advection [H m2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(inout) :: vhtr !< accumulatated merid volume/mass transport - !! since last tracer advection (m3 or kg) + !! since last tracer advection [H m2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< free surface height or column mass time - !! averaged over time step (m or kg/m2) + !! averaged over time step [H ~> m or kg m-2] type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure logical, intent(in) :: calc_dtbt !< if true, recalculate barotropic time step type(VarMix_CS), pointer :: VarMix !< specify the spatially varying viscosities @@ -269,24 +271,24 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !! fields related to the surface wave conditions real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocity in m s-1. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocity in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: hp ! Predicted thickness in m or kg m-2 (H). + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocity [m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocity [m s-1]. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: hp ! Predicted thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_bc_accel real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_bc_accel ! u_bc_accel and v_bc_accel are the summed baroclinic accelerations of each - ! layer calculated by the non-barotropic part of the model, both in m s-2. + ! layer calculated by the non-barotropic part of the model [m s-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: uh_in real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: vh_in ! uh_in and vh_in are the zonal or meridional mass transports that would be - ! obtained using the initial velocities, both in m3 s-1 or kg s-1. + ! obtained using the initial velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G)) :: uhbt_out real, dimension(SZI_(G),SZJB_(G)) :: vhbt_out ! uhbt_out and vhbt_out are the vertically summed transports from the - ! barotropic solver based on its final velocities, both in m3 s-1 or kg s-1. + ! barotropic solver based on its final velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJ_(G)) :: eta_pred ! eta_pred is the predictor value of the free surface height or column mass, @@ -296,12 +298,12 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: v_adj ! u_adj and v_adj are the zonal or meridional velocities after u and v ! have been barotropically adjusted so the resulting transports match - ! uhbt_out and vhbt_out, both in m s-1. + ! uhbt_out and vhbt_out [m s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_old_rad_OBC real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_old_rad_OBC ! u_old_rad_OBC and v_old_rad_OBC are the starting velocities, which are - ! saved for use in the Flather open boundary condition code, both in m s-1. + ! saved for use in the Flather open boundary condition code [m s-1]. real :: Pa_to_eta ! A factor that converts pressures to the units of eta. real, pointer, dimension(:,:) :: & @@ -312,8 +314,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & real, pointer, dimension(:,:,:) :: & uh_ptr => NULL(), u_ptr => NULL(), vh_ptr => NULL(), v_ptr => NULL(), & u_init => NULL(), v_init => NULL(), & ! Pointers to u and v or u_adj and v_adj. - u_av, & ! The zonal velocity time-averaged over a time step, in m s-1. - v_av, & ! The meridional velocity time-averaged over a time step, in m s-1. + u_av, & ! The zonal velocity time-averaged over a time step [m s-1]. + v_av, & ! The meridional velocity time-averaged over a time step [m s-1]. h_av ! The layer thickness time-averaged over a time step, in m or ! kg m-2. real :: Idt @@ -880,9 +882,9 @@ subroutine register_restarts_dyn_split_RK2(HI, GV, param_file, CS, restart_CS, u type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure type(MOM_restart_CS), pointer :: restart_CS !< restart control structure real, dimension(SZIB_(HI),SZJ_(HI),SZK_(GV)), & - target, intent(inout) :: uh !< zonal volume/mass transport (m3/s or kg/s) + target, intent(inout) :: uh !< zonal volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(HI),SZJB_(HI),SZK_(GV)), & - target, intent(inout) :: vh !< merid volume/mass transport (m3/s or kg/s) + target, intent(inout) :: vh !< merid volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1] type(vardesc) :: vd character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. @@ -961,12 +963,12 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param intent(inout) :: u !< zonal velocity (m/s) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(inout) :: v !< merid velocity (m/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - target, intent(inout) :: uh !< zonal volume/mass transport (m3 s-1 or kg s-1) + target, intent(inout) :: uh !< zonal volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - target, intent(inout) :: vh !< merid volume/mass transport (m3 s-1 or kg s-1) - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: eta !< free surface height or column mass (m or kg m-2) + target, intent(inout) :: vh !< merid volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: eta !< free surface height or column mass [H ~> m or kg m-2] type(time_type), target, intent(in) :: Time !< current model time type(param_file_type), intent(in) :: param_file !< parameter file for parsing type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 91daa43d22..5190eceeb9 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -113,10 +113,10 @@ module MOM_forcing_type ! applied surface pressure from other component models (e.g., atmos, sea ice, land ice) real, pointer, dimension(:,:) :: p_surf_full => NULL() - !< Pressure at the top ocean interface (Pa). + !< Pressure at the top ocean interface [Pa]. !! if there is sea-ice, then p_surf_flux is at ice-ocean interface real, pointer, dimension(:,:) :: p_surf => NULL() - !< Pressure at the top ocean interface (Pa) as used to drive the ocean model. + !< Pressure at the top ocean interface [Pa] as used to drive the ocean model. !! If p_surf is limited, p_surf may be smaller than p_surf_full, otherwise they are the same. real, pointer, dimension(:,:) :: p_surf_SSH => NULL() !< Pressure at the top ocean interface that is used in corrections to the sea surface @@ -159,7 +159,7 @@ module MOM_forcing_type logical :: fluxes_used = .true. !< If true, all of the heat, salt, and mass !! fluxes have been applied to the ocean. real :: dt_buoy_accum = -1.0 !< The amount of time over which the buoyancy fluxes - !! should be applied, in s. If negative, this forcing + !! should be applied [s]. If negative, this forcing !! type variable has not yet been inialized. real :: C_p !< heat capacity of seawater ( J/(K kg) ). @@ -184,17 +184,17 @@ module MOM_forcing_type type, public :: mech_forcing ! surface stress components and turbulent velocity scale real, pointer, dimension(:,:) :: & - taux => NULL(), & !< zonal wind stress (Pa) - tauy => NULL(), & !< meridional wind stress (Pa) + taux => NULL(), & !< zonal wind stress [Pa] + tauy => NULL(), & !< meridional wind stress [Pa] ustar => NULL(), & !< surface friction velocity scale [Z s-1 ~> m s-1]. net_mass_src => NULL() !< The net mass source to the ocean, in kg m-2 s-1. ! applied surface pressure from other component models (e.g., atmos, sea ice, land ice) real, pointer, dimension(:,:) :: p_surf_full => NULL() - !< Pressure at the top ocean interface (Pa). + !< Pressure at the top ocean interface [Pa]. !! if there is sea-ice, then p_surf_flux is at ice-ocean interface real, pointer, dimension(:,:) :: p_surf => NULL() - !< Pressure at the top ocean interface (Pa) as used to drive the ocean model. + !< Pressure at the top ocean interface [Pa] as used to drive the ocean model. !! If p_surf is limited, p_surf may be smaller than p_surf_full, otherwise they are the same. real, pointer, dimension(:,:) :: p_surf_SSH => NULL() !< Pressure at the top ocean interface that is used in corrections to the sea surface @@ -217,7 +217,7 @@ module MOM_forcing_type rigidity_ice_u => NULL(), & !< Depth-integrated lateral viscosity of ice shelves or sea ice at u-points (m3/s) rigidity_ice_v => NULL() !< Depth-integrated lateral viscosity of ice shelves or sea ice at v-points (m3/s) real :: dt_force_accum = -1.0 !< The amount of time over which the mechanical forcing fluxes - !! have been averaged, in s. + !! have been averaged [s]. logical :: net_mass_src_set = .false. !< If true, an estimate of net_mass_src has been provided. logical :: accumulate_p_surf = .false. !< If true, the surface pressure due to the atmosphere !! and various types of ice needs to be accumulated, and the @@ -853,7 +853,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, real, dimension( SZI_(G) ) :: netEvap ! net FW flux leaving ocean via evaporation (m/s for Bouss) real, dimension( SZI_(G) ) :: netHeat ! net temp flux (K m/s) real, dimension( optics%nbands, SZI_(G) ) :: penSWbnd ! SW penetration bands - real, dimension( SZI_(G) ) :: pressure ! pressurea the surface (Pa) + real, dimension( SZI_(G) ) :: pressure ! pressurea the surface [Pa] real, dimension( SZI_(G) ) :: dRhodT ! density partial derivative wrt temp real, dimension( SZI_(G) ) :: dRhodS ! density partial derivative wrt saln real, dimension(SZI_(G),SZK_(G)+1) :: netPen diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index a02ba33870..709a38f9d9 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -33,12 +33,10 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - !! (usually m or kg m-2). - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to - !! various thermodynamic - !! variables. + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: eta !< layer interface heights - !! (Z or 1/eta_to_m m). + !! [Z ~> m] or 1/eta_to_m m). real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic !! variable that gives the "correct" free surface height (Boussinesq) or total water !! column mass per unit area (non-Boussinesq). This is used to dilate the layer. @@ -51,7 +49,7 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) ! Local variables real :: p(SZI_(G),SZJ_(G),SZK_(G)+1) real :: dz_geo(SZI_(G),SZJ_(G),SZK_(G)) ! The change in geopotential height - ! across a layer, in m2 s-2. + ! across a layer [m2 s-2]. real :: dilate(SZI_(G)) ! non-dimensional dilation factor real :: htot(SZI_(G)) ! total thickness H real :: I_gEarth @@ -148,13 +146,10 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - !! (usually m or kg m-2). - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to - !! various thermodynamic - !! variables. - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta !< free surface height - !! relative to mean sea - !! level (z=0) (m). + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta !< free surface height relative to + !! mean sea level (z=0) often [Z ~> m]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic !! variable that gives the "correct" free surface height (Boussinesq) or total !! water column mass per unit area (non-Boussinesq) [H ~> m or kg m-2]. @@ -166,7 +161,7 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & p ! The pressure in Pa. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - dz_geo ! The change in geopotential height across a layer, in m2 s-2. + dz_geo ! The change in geopotential height across a layer [m2 s-2]. real :: htot(SZI_(G)) ! The sum of all layers' thicknesses [H ~> m or kg m-2]. real :: I_gEarth real :: Z_to_eta, H_to_eta, H_to_rho_eta ! Unit conversion factors with obvious names. diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index edc304dd02..359cba9ef3 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -56,7 +56,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & Rho ! Density itself, when a nonlinear equation of state is ! not in use. real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & - pres ! The pressure at an interface, in Pa. + pres ! The pressure at an interface [Pa]. real, dimension(SZIB_(G)) :: & drho_dT_u, & ! The derivatives of density with temperature and drho_dS_u ! salinity at u points, in kg m-3 K-1 and kg m-3 psu-1. @@ -71,18 +71,18 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & pres_v ! the v-point in the horizontal. real :: drdiA, drdiB ! Along layer zonal- and meridional- potential density real :: drdjA, drdjB ! gradients in the layers above (A) and below(B) the - ! interface times the grid spacing, in kg m-3. - real :: drdkL, drdkR ! Vertical density differences across an interface, in kg m-3. + ! interface times the grid spacing [kg m-3]. + real :: drdkL, drdkR ! Vertical density differences across an interface [kg m-3]. real :: hg2A, hg2B ! Squares of geometric mean thicknesses [H2 ~> m2 or kg2 m-4]. real :: hg2L, hg2R ! Squares of geometric mean thicknesses [H2 ~> m2 or kg2 m-4]. real :: haA, haB, haL, haR ! Arithmetic mean thicknesses [H ~> m or kg m-2]. - real :: dzaL, dzaR ! Temporary thicknesses in eta units (Z?). + real :: dzaL, dzaR ! Temporary thicknesses in eta units [Z ~> m]. real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. - real :: drdx, drdy ! Zonal and meridional density gradients, in kg m-4. - real :: drdz ! Vertical density gradient, in units of kg m-3 Z-1. + real :: drdx, drdy ! Zonal and meridional density gradients [kg m-4]. + real :: drdz ! Vertical density gradient [kg m-3 Z-1 ~> kg m-4]. real :: Slope ! The slope of density surfaces, calculated in a way ! that is always between -1 and 1. - real :: mag_grad2 ! The squared magnitude of the 3-d density gradient, in kg2 m-8. + real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [kg2 m-8]. real :: slope2_Ratio ! The ratio of the slope squared to slope_max squared. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 57720bb865..cd121de985 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -53,12 +53,12 @@ module MOM_variables salt_deficit !< The salt needed to maintain the ocean column at a minimum !! salinity of 0.01 PSU over the call to step_MOM, in kgSalt m-2. logical :: T_is_conT = .false. !< If true, the temperature variable SST is actually the - !! conservative temperature, in degC. + !! conservative temperature [degC]. logical :: S_is_absS = .false. !< If true, the salinity variable SSS is actually the !! absolute salinity, in g/kg. real, pointer, dimension(:,:) :: & - taux_shelf => NULL(), & !< The zonal stresses on the ocean under shelves, in Pa. - tauy_shelf => NULL() !< The meridional stresses on the ocean under shelves, in Pa. + taux_shelf => NULL(), & !< The zonal stresses on the ocean under shelves [Pa]. + tauy_shelf => NULL() !< The meridional stresses on the ocean under shelves [Pa]. real, pointer, dimension(:,:) :: frazil => NULL() !< The energy needed to heat the ocean column to the freezing point during the call !! to step_MOM, in J m-2. @@ -81,41 +81,39 @@ module MOM_variables !! potential temperature, salinity, heat capacity, and the equation of state control structure. type, public :: thermo_var_ptrs ! If allocated, the following variables have nz layers. - real, pointer :: T(:,:,:) => NULL() !< Potential temperature in C. - real, pointer :: S(:,:,:) => NULL() !< Salnity in psu or ppt. + real, pointer :: T(:,:,:) => NULL() !< Potential temperature [degC]. + real, pointer :: S(:,:,:) => NULL() !< Salnity [PSU] or [ppt]. type(EOS_type), pointer :: eqn_of_state => NULL() !< Type that indicates the !! equation of state to use. - real :: P_Ref !< The coordinate-density reference pressure in Pa. + real :: P_Ref !< The coordinate-density reference pressure [Pa]. !! This is the pressure used to calculate Rml from !! T and S when eqn_of_state is associated. - real :: C_p !< The heat capacity of seawater, in J K-1 kg-1. + real :: C_p !< The heat capacity of seawater [J K-1 kg-1]. !! When conservative temperature is used, this is !! constant and exactly 3991.86795711963 J K kg-1. logical :: T_is_conT = .false. !< If true, the temperature variable tv%T is - !! actually the conservative temperature, in degC. + !! actually the conservative temperature [degC]. logical :: S_is_absS = .false. !< If true, the salinity variable tv%S is - !! actually the absolute salinity, in g/kg. + !! actually the absolute salinity, in [gSalt/kg]. ! These arrays are accumulated fluxes for communication with other components. real, dimension(:,:), pointer :: frazil => NULL() !< The energy needed to heat the ocean column to the - !! freezing point since calculate_surface_state was - !! last called, in units of J m-2. + !! freezing point since calculate_surface_state was2 + !! last called [J m-2]. real, dimension(:,:), pointer :: salt_deficit => NULL() !< The salt needed to maintain the ocean column !! at a minumum salinity of 0.01 PSU since the last time - !! that calculate_surface_state was called, in units - !! of gSalt m-2. + !! that calculate_surface_state was called, [gSalt m-2]. real, dimension(:,:), pointer :: TempxPmE => NULL() !< The net inflow of water into the ocean times the !! temperature at which this inflow occurs since the - !! last call to calculate_surface_state, in units of - !! deg C kg m-2. This should be prescribed in the - !! forcing fields, but as it often is not, this is a - !! useful heat budget diagnostic. + !! last call to calculate_surface_state [degC kg m-2]. + !! This should be prescribed in the forcing fields, but + !! as it often is not, this is a useful heat budget diagnostic. real, dimension(:,:), pointer :: internal_heat => NULL() !< Any internal or geothermal heat sources that !! have been applied to the ocean since the last call to - !! calculate_surface_state, in units of deg C kg m-2. + !! calculate_surface_state [degC kg m-2]. end type thermo_var_ptrs !> Pointers to all of the prognostic variables allocated in MOM_variables.F90 and MOM.F90. @@ -140,7 +138,8 @@ module MOM_variables PFv => NULL(), & !< Pointer to the meridional Pressure force acceleration, in m s-2 diffu => NULL(), & !< Pointer to the zonal acceleration due to lateral viscosity, in m s-2 diffv => NULL(), & !< Pointer to the meridional acceleration due to lateral viscosity, in m s-2 - pbce => NULL(), & !< Pointer to the baroclinic pressure force dependency on free surface movement, in s-2 + pbce => NULL(), & !< Pointer to the baroclinic pressure force dependency on free surface movement + !! [m2 s-2 H-1 ~> m s-2 or m4 kg-1 s-2] u_accel_bt => NULL(), & !< Pointer to the zonal barotropic-solver acceleration, in m s-2 v_accel_bt => NULL() !< Pointer to the meridional barotropic-solver acceleration, in m s-2 real, pointer, dimension(:,:,:) :: & @@ -155,16 +154,16 @@ module MOM_variables ! Each of the following fields has nz layers. real, pointer, dimension(:,:,:) :: & - diffu => NULL(), & !< Zonal acceleration due to along isopycnal viscosity, in m s-2. - diffv => NULL(), & !< Meridional acceleration due to along isopycnal viscosity, in m s-2. - CAu => NULL(), & !< Zonal Coriolis and momentum advection accelerations, in m s-2. - CAv => NULL(), & !< Meridional Coriolis and momentum advection accelerations, in m s-2. - PFu => NULL(), & !< Zonal acceleration due to pressure forces, in m s-2. - PFv => NULL(), & !< Meridional acceleration due to pressure forces, in m s-2. - du_dt_visc => NULL(), &!< Zonal acceleration due to vertical viscosity, in m s-2. - dv_dt_visc => NULL(), &!< Meridional acceleration due to vertical viscosity, in m s-2. - du_dt_dia => NULL(), & !< Zonal acceleration due to diapycnal mixing, in m s-2. - dv_dt_dia => NULL() !< Meridional acceleration due to diapycnal mixing, in m s-2. + diffu => NULL(), & !< Zonal acceleration due to along isopycnal viscosity [m s-2] + diffv => NULL(), & !< Meridional acceleration due to along isopycnal viscosity [m s-2] + CAu => NULL(), & !< Zonal Coriolis and momentum advection accelerations [m s-2] + CAv => NULL(), & !< Meridional Coriolis and momentum advection accelerations [m s-2] + PFu => NULL(), & !< Zonal acceleration due to pressure forces [m s-2] + PFv => NULL(), & !< Meridional acceleration due to pressure forces [m s-2] + du_dt_visc => NULL(), &!< Zonal acceleration due to vertical viscosity [m s-2] + dv_dt_visc => NULL(), &!< Meridional acceleration due to vertical viscosity [m s-2] + du_dt_dia => NULL(), & !< Zonal acceleration due to diapycnal mixing [m s-2] + dv_dt_dia => NULL() !< Meridional acceleration due to diapycnal mixing [m s-2] real, pointer, dimension(:,:,:) :: du_other => NULL() !< Zonal velocity changes due to any other processes that are !! not due to any explicit accelerations, in m s-1. @@ -173,10 +172,10 @@ module MOM_variables !! not due to any explicit accelerations, in m s-1. ! These accelerations are sub-terms included in the accelerations above. - real, pointer :: gradKEu(:,:,:) => NULL() !< gradKEu = - d/dx(u2), in m s-2. - real, pointer :: gradKEv(:,:,:) => NULL() !< gradKEv = - d/dy(u2), in m s-2. - real, pointer :: rv_x_v(:,:,:) => NULL() !< rv_x_v = rv * v at u, in m s-2. - real, pointer :: rv_x_u(:,:,:) => NULL() !< rv_x_u = rv * u at v, in m s-2. + real, pointer :: gradKEu(:,:,:) => NULL() !< gradKEu = - d/dx(u2) [m s-2] + real, pointer :: gradKEv(:,:,:) => NULL() !< gradKEv = - d/dy(u2) [m s-2] + real, pointer :: rv_x_v(:,:,:) => NULL() !< rv_x_v = rv * v at u [m s-2] + real, pointer :: rv_x_u(:,:,:) => NULL() !< rv_x_u = rv * u at v [m s-2] end type accel_diag_ptrs @@ -185,13 +184,13 @@ module MOM_variables ! Each of the following fields has nz layers. real, pointer, dimension(:,:,:) :: & - uh => NULL(), & !< Resolved zonal layer thickness fluxes, in m3 s-1 or kg s-1 - vh => NULL(), & !< Resolved meridional layer thickness fluxes, in m3 s-1 or kg s-1 - uhGM => NULL(), & !< Isopycnal height diffusion induced zonal volume fluxes in m3 s-1 or kg s-1 - vhGM => NULL() !< Isopycnal height diffusion induced meridional volume fluxes in m3 s-1 or kg s-1 + uh => NULL(), & !< Resolved zonal layer thickness fluxes, [H m2 s-1 ~> m3 s-1 or kg s-1] + vh => NULL(), & !< Resolved meridional layer thickness fluxes, [H m2 s-1 ~> m3 s-1 or kg s-1] + uhGM => NULL(), & !< Isopycnal height diffusion induced zonal volume fluxes [H m2 s-1 ~> m3 s-1 or kg s-1] + vhGM => NULL() !< Isopycnal height diffusion induced meridional volume fluxes [H m2 s-1 ~> m3 s-1 or kg s-1] ! Each of the following fields is found at nz+1 interfaces. - real, pointer :: diapyc_vel(:,:,:) => NULL() !< The net diapycnal velocity, in m s-1 or kg m-2 s-1 + real, pointer :: diapyc_vel(:,:,:) => NULL() !< The net diapycnal velocity [H s-1 ~> m s-1 or kg m-2 s-1] end type cont_diag_ptrs @@ -207,10 +206,10 @@ module MOM_variables ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points [Z s-1 ~> m s-1]. real, pointer, dimension(:,:) :: TKE_BBL => NULL() !< A term related to the bottom boundary layer source of turbulent kinetic - !! energy, currently in units of m3 s-3, but will later be changed to W m-2. + !! energy, currently in [m3 s-3], but will later be changed to [W m-2]. real, pointer, dimension(:,:) :: & - taux_shelf => NULL(), & !< The zonal stresses on the ocean under shelves, in Pa. - tauy_shelf => NULL() !< The meridional stresses on the ocean under shelves, in Pa. + taux_shelf => NULL(), & !< The zonal stresses on the ocean under shelves [Pa]. + tauy_shelf => NULL() !< The meridional stresses on the ocean under shelves [Pa]. real, pointer, dimension(:,:) :: tbl_thick_shelf_u => NULL() !< Thickness of the viscous top boundary layer under ice shelves at u-points [Z ~> m]. real, pointer, dimension(:,:) :: tbl_thick_shelf_v => NULL() @@ -253,7 +252,7 @@ module MOM_variables !< The turbulent vertical viscosity component due to "slow" processes (e.g., tidal, !! background, convection etc) [Z2 s-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: TKE_turb => NULL() - !< The turbulent kinetic energy per unit mass at the interfaces, in m2 s-2. + !< The turbulent kinetic energy per unit mass at the interfaces [m2 s-2]. !! This may be at the tracer or corner points logical :: add_Kv_slow !< If True, add Kv_slow when calculating the 'coupling coefficient' (a_cpl) !! at the interfaces in find_coupling_coef. @@ -270,9 +269,9 @@ module MOM_variables !! drawing from nearby to the west [H m ~> m2 or kg m-1]. real, allocatable :: FA_u_WW(:,:) !< The effective open face area for zonal barotropic transport !! drawing from locations far to the west [H m ~> m2 or kg m-1]. - real, allocatable :: uBT_WW(:,:) !< uBT_WW is the barotropic velocity, in m s-1, beyond which the marginal + real, allocatable :: uBT_WW(:,:) !< uBT_WW is the barotropic velocity [m s-1], beyond which the marginal !! open face area is FA_u_WW. uBT_WW must be non-negative. - real, allocatable :: uBT_EE(:,:) !< uBT_EE is a barotropic velocity, in m s-1, beyond which the marginal + real, allocatable :: uBT_EE(:,:) !< uBT_EE is a barotropic velocity [m s-1], beyond which the marginal !! open face area is FA_u_EE. uBT_EE must be non-positive. real, allocatable :: FA_v_NN(:,:) !< The effective open face area for meridional barotropic transport !! drawing from locations far to the north [H m ~> m2 or kg m-1]. @@ -282,9 +281,9 @@ module MOM_variables !! drawing from nearby to the south [H m ~> m2 or kg m-1]. real, allocatable :: FA_v_SS(:,:) !< The effective open face area for meridional barotropic transport !! drawing from locations far to the south [H m ~> m2 or kg m-1]. - real, allocatable :: vBT_SS(:,:) !< vBT_SS is the barotropic velocity, in m s-1, beyond which the marginal + real, allocatable :: vBT_SS(:,:) !< vBT_SS is the barotropic velocity, [m s-1], beyond which the marginal !! open face area is FA_v_SS. vBT_SS must be non-negative. - real, allocatable :: vBT_NN(:,:) !< vBT_NN is the barotropic velocity, in m s-1, beyond which the marginal + real, allocatable :: vBT_NN(:,:) !< vBT_NN is the barotropic velocity, [m s-1], beyond which the marginal !! open face area is FA_v_NN. vBT_NN must be non-positive. real, allocatable :: h_u(:,:,:) !< An effective thickness at zonal faces [H ~> m or kg m-2]. real, allocatable :: h_v(:,:,:) !< An effective thickness at meridional faces [H ~> m or kg m-2]. diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 84a6ed350d..ac3d5d4a6d 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -28,7 +28,7 @@ module MOM_verticalGrid real :: max_depth !< The maximum depth of the ocean in Z (often m). real :: g_Earth !< The gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. real :: Rho0 !< The density used in the Boussinesq approximation or nominal - !! density used to convert depths into mass units, in kg m-3. + !! density used to convert depths into mass units [kg m-3]. ! Vertical coordinate descriptions for diagnostics and I/O character(len=40) :: zAxisUnits !< The units that vertical coordinates are written in diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 1c21ed4f90..d6ba417d3a 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -51,13 +51,13 @@ module MOM_PointAccel v_av => NULL(), & !< Time average velocity in m s-1. u_prev => NULL(), & !< Previous u-velocity in m s-1. v_prev => NULL(), & !< Previous v-velocity in m s-1. - T => NULL(), & !< Temperature in deg C. - S => NULL(), & !< Salinity in ppt - u_accel_bt => NULL(), & !< Barotropic u-acclerations in m s-2. - v_accel_bt => NULL() !< Barotropic v-acclerations in m s-2. + T => NULL(), & !< Temperature [degC]. + S => NULL(), & !< Salinity [ppt]. + u_accel_bt => NULL(), & !< Barotropic u-acclerations [m s-2] + v_accel_bt => NULL() !< Barotropic v-acclerations [m s-2] real, pointer, dimension(:,:,:) :: pbce => NULL() !< pbce times eta gives the baroclinic - !! pressure anomaly in each layer due to free surface height anomalies. - !! pbce has units of m s-2. + !! pressure anomaly in each layer due to free surface height anomalies + !! [m2 s-2 H-1 ~> m s-2 or m4 kg-1 s-2]. end type PointAccel_CS @@ -80,7 +80,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st !! accelerations in the momentum equations. type(cont_diag_ptrs), intent(in) :: CDp !< A structure with pointers to various terms !! in the continuity equations. - real, intent(in) :: dt !< The ocean dynamics time step, in s. + real, intent(in) :: dt !< The ocean dynamics time step [s]. type(PointAccel_CS), pointer :: CS !< The control structure returned by a previous !! call to PointAccel_init. real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report, in m s-1. @@ -411,7 +411,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st !! accelerations in the momentum equations. type(cont_diag_ptrs), intent(in) :: CDp !< A structure with pointers to various terms in !! the continuity equations. - real, intent(in) :: dt !< The ocean dynamics time step, in s. + real, intent(in) :: dt !< The ocean dynamics time step [s]. type(PointAccel_CS), pointer :: CS !< The control structure returned by a previous !! call to PointAccel_init. real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report, in m s-1. diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index 23890d6d34..a984fb26e1 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -51,8 +51,8 @@ module MOM_diag_to_Z real, pointer, dimension(:,:,:) :: & u_z => NULL(), & !< zonal velocity remapped to depth space (m/s) v_z => NULL(), & !< meridional velocity remapped to depth space (m/s) - uh_z => NULL(), & !< zonal transport remapped to depth space (m3/s or kg/s) - vh_z => NULL() !< meridional transport remapped to depth space (m3/s or kg/s) + uh_z => NULL(), & !< zonal transport remapped to depth space [H m2 s-1 ~> m3 s-1 or kg s-1] + vh_z => NULL() !< meridional transport remapped to depth space [H m2 s-1 ~> m3 s-1 or kg s-1] type(p3d) :: tr_z(MAX_FIELDS_) !< array of tracers, remapped to depth space type(p3d) :: tr_model(MAX_FIELDS_) !< pointers to an array of tracers @@ -505,9 +505,9 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid !! structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uh_int !< Time integrated zonal - !! transport (m3 or kg). + !! transport [H m2 ~> m3 or kg]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh_int !< Time integrated meridional - !! transport (m3 or kg). + !! transport [H m2 ~> m3 or kg]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, intent(in) :: dt !< The time difference in s since !! the last call to this @@ -522,24 +522,24 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) ! into z* space [Z H-1 ~> 1 or m3 kg-1]. (-G%D < z* < 0) real, dimension(SZI_(G), max(CS%nk_zspace,1)) :: & - uh_Z ! uh_int interpolated into depth space (m3 or kg) + uh_Z ! uh_int interpolated into depth space [H m2 ~> m3 or kg] real, dimension(SZIB_(G), max(CS%nk_zspace,1)) :: & - vh_Z ! vh_int interpolated into depth space (m3 or kg) + vh_Z ! vh_int interpolated into depth space [H m2 ~> m3 or kg] real :: h_rem ! dilated thickness of a layer that has yet to be mapped ! into depth space [Z ~> m] real :: uh_rem ! integrated zonal transport of a layer that has yet to be - ! mapped into depth space (m3 or kg) + ! mapped into depth space [H m2 ~> m3 or kg] real :: vh_rem ! integrated meridional transport of a layer that has yet - ! to be mapped into depth space (m3 or kg) + ! to be mapped into depth space [H m2 ~> m3 or kg] real :: h_here ! thickness of a layer that is within the range of the ! current depth level [Z ~> m] real :: h_above ! thickness of a layer that is above the current depth ! level [Z ~> m] real :: uh_here ! zonal transport of a layer that is attributed to the - ! current depth level (m3 or kg) + ! current depth level [H m2 ~> m3 or kg] real :: vh_here ! meridional transport of a layer that is attributed to - ! the current depth level (m3 or kg) + ! the current depth level [H m2 ~> m3 or kg] real :: Idt ! inverse of the time step (sec) real :: z_int_above(SZIB_(G)) ! height of the interface atop a layer (meter or kg/m2) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 6e6668aca7..61d3230d44 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -91,20 +91,19 @@ module MOM_diagnostics cfl_cg1_x => NULL(), & !< i-component of CFL for first baroclinic gravity wave speed, nondim cfl_cg1_y => NULL() !< j-component of CFL for first baroclinic gravity wave speed, nondim - ! arrays to hold diagnostics in the layer-integrated energy budget. - ! all except KE have units of m3 s-3 (when Boussinesq). + ! The following arrays hold diagnostics in the layer-integrated energy budget. real, pointer, dimension(:,:,:) :: & - KE => NULL(), & !< KE per unit mass, in m2 s-2 - dKE_dt => NULL(), & !< time derivative of the layer KE - PE_to_KE => NULL(), & !< potential energy to KE term - KE_CorAdv => NULL(), & !< KE source from the combined Coriolis and advection terms. + KE => NULL(), & !< KE per unit mass [m2 s-2] + dKE_dt => NULL(), & !< time derivative of the layer KE [m3 s-3] + PE_to_KE => NULL(), & !< potential energy to KE term [m3 s-3] + KE_CorAdv => NULL(), & !< KE source from the combined Coriolis and advection terms [m3 s-3]. !! The Coriolis source should be zero, but is not due to truncation !! errors. There should be near-cancellation of the global integral !! of this spurious Coriolis source. - KE_adv => NULL(),& !< KE source from along-layer advection - KE_visc => NULL(),& !< KE source from vertical viscosity - KE_horvisc => NULL(),& !< KE source from horizontal viscosity - KE_dia => NULL() !< KE source from diapycnal diffusion + KE_adv => NULL(), & !< KE source from along-layer advection [m3 s-3] + KE_visc => NULL(), & !< KE source from vertical viscosity [m3 s-3] + KE_horvisc => NULL(), & !< KE source from horizontal viscosity [m3 s-3] + KE_dia => NULL() !< KE source from diapycnal diffusion [m3 s-3] !>@{ Diagnostic IDs integer :: id_u = -1, id_v = -1, id_h = -1 @@ -207,7 +206,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & !! accelerations in momentum equation. type(cont_diag_ptrs), intent(in) :: CDp !< structure with pointers to !! terms in continuity equation. - real, dimension(:,:), pointer :: p_surf !< A pointer to the surface pressure, in Pa. + real, dimension(:,:), pointer :: p_surf !< A pointer to the surface pressure [Pa]. !! If p_surf is not associated, it is the same !! as setting the surface pressure to 0. real, intent(in) :: dt !< The time difference in s since the last @@ -223,7 +222,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! Local variables integer i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb - ! coordinate variable potential density, in kg m-3. + ! coordinate variable potential density [kg m-3]. real :: Rcv(SZI_(G),SZJ_(G),SZK_(G)) ! Two temporary work arrays real :: work_3d(SZI_(G),SZJ_(G),SZK_(G)) @@ -347,7 +346,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif else ! thkcello = dp/(rho*g) for non-Boussinesq do j=js,je - if (associated(p_surf)) then ! Pressure loading at top of surface layer (Pa) + if (associated(p_surf)) then ! Pressure loading at top of surface layer [Pa] do i=is,ie pressure_1d(i) = p_surf(i,j) enddo @@ -357,7 +356,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & enddo endif do k=1,nz ! Integrate vertically downward for pressure - do i=is,ie ! Pressure for EOS at the layer center (Pa) + do i=is,ie ! Pressure for EOS at the layer center [Pa] pressure_1d(i) = pressure_1d(i) + 0.5*GV%H_to_Pa*h(i,j,k) enddo ! Store in-situ density (kg/m3) in work_3d @@ -366,7 +365,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & do i=is,ie ! Cell thickness = dz = dp/(g*rho) (meter); store in work_3d work_3d(i,j,k) = (GV%H_to_kg_m2*h(i,j,k)) / work_3d(i,j,k) enddo - do i=is,ie ! Pressure for EOS at the bottom interface (Pa) + do i=is,ie ! Pressure for EOS at the bottom interface [Pa] pressure_1d(i) = pressure_1d(i) + 0.5*GV%H_to_Pa*h(i,j,k) enddo enddo ! k @@ -773,7 +772,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. - real, dimension(:,:), pointer :: p_surf !< A pointer to the surface pressure, in Pa. + real, dimension(:,:), pointer :: p_surf !< A pointer to the surface pressure [Pa]. !! If p_surf is not associated, it is the same !! as setting the surface pressure to 0. type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by a @@ -790,7 +789,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) btm_pres,&! The pressure at the ocean bottom, or CMIP variable 'pbo'. ! This is the column mass multiplied by gravity plus the pressure ! at the ocean surface. - dpress, & ! Change in hydrostatic pressure across a layer, in Pa. + dpress, & ! Change in hydrostatic pressure across a layer [Pa]. tr_int ! vertical integral of a tracer times density, ! (Rho_0 in a Boussinesq model) in TR kg m-2. real :: IG_Earth ! Inverse of gravitational acceleration, in s2 m-1. @@ -1111,7 +1110,7 @@ end subroutine register_time_deriv !> This subroutine calculates all registered time derivatives. subroutine calculate_derivs(dt, G, CS) - real, intent(in) :: dt !< The time interval over which differences occur, in s. + real, intent(in) :: dt !< The time interval over which differences occur [s]. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by previous call to !! diagnostics_init. @@ -1178,7 +1177,7 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output - real, intent(in) :: dt_int !< total time step associated with these diagnostics, in s. + real, intent(in) :: dt_int !< total time step associated with these diagnostics [s]. type(surface), intent(in) :: sfc_state !< structure describing the ocean surface state type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables real, dimension(SZI_(G),SZJ_(G)), & @@ -1319,15 +1318,15 @@ subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, d type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uhtr !< Accumulated zonal thickness fluxes - !! used to advect tracers (m3 or kg) + !! used to advect tracers [H m2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhtr !< Accumulated meridional thickness fluxes - !! used to advect tracers (m3 or kg) + !! used to advect tracers [H m2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< The updated layer thicknesses [H ~> m or kg m-2] type(transport_diag_IDs), intent(in) :: IDs !< A structure with the diagnostic IDs. type(diag_grid_storage), intent(inout) :: diag_pre_dyn !< Stored grids from before dynamics type(diag_ctrl), intent(inout) :: diag !< regulates diagnostic output - real, intent(in) :: dt_trans !< total time step associated with the transports, in s. + real, intent(in) :: dt_trans !< total time step associated with the transports [s]. type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A control structure for remapping !! the transports to depth space type(tracer_registry_type), pointer :: Reg !< Pointer to the tracer registry diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 4f38fac043..aa05140cf9 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -83,7 +83,7 @@ module MOM_sum_output type(EFP_type) :: heat_prev_EFP !< An extended fixed point version of heat_prev type(EFP_type) :: salt_prev_EFP !< An extended fixed point version of salt_prev type(EFP_type) :: mass_prev_EFP !< An extended fixed point version of mass_prev - real :: dt !< The baroclinic dynamics time step, in s. + real :: dt !< The baroclinic dynamics time step [s]. type(time_type) :: energysavedays !< The interval between writing the energies !! and other integral quantities of the run. @@ -98,14 +98,14 @@ module MOM_sum_output !! of calls to write_energy and revert to the standard !! energysavedays interval - real :: timeunit !< The length of the units for the time axis, in s. + real :: timeunit !< The length of the units for the time axis [s]. logical :: date_stamped_output !< If true, use dates (not times) in messages to stdout. type(time_type) :: Start_time !< The start time of the simulation. ! Start_time is set in MOM_initialization.F90 integer, pointer :: ntrunc => NULL() !< The number of times the velocity has been !! truncated since the last call to write_energy. real :: max_Energy !< The maximum permitted energy per unit mass. If there is - !! more energy than this, the model should stop, in m2 s-2. + !! more energy than this, the model should stop [m2 s-2]. integer :: maxtrunc !< The number of truncations per energy save !! interval at which the run is stopped. logical :: write_stocks !< If true, write the integrated tracer amounts @@ -308,7 +308,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ real :: toten ! The total kinetic & potential energies of ! all layers, in Joules (i.e. kg m2 s-2). real :: En_mass ! The total kinetic and potential energies divided by - ! the total mass of the ocean, in m2 s-2. + ! the total mass of the ocean [m2 s-2]. real :: vol_lay(SZK_(G)) ! The volume of fluid in a layer [Z m2 ~> m3]. real :: volbelow ! The volume of all layers beneath an interface [Z m2 ~> m3]. real :: mass_lay(SZK_(G)) ! The mass of fluid in a layer, in kg. @@ -323,9 +323,9 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ ! to this subroutine, in PSU kg. real :: Salt_anom ! The change in salt that cannot be accounted for by ! the surface fluxes, in PSU kg. - real :: salin ! The mean salinity of the ocean, in PSU. + real :: salin ! The mean salinity of the ocean [PSU]. real :: salin_chg ! The change in total salt since the last call - ! to this subroutine divided by total mass, in PSU. + ! to this subroutine divided by total mass [PSU]. real :: salin_anom ! The change in total salt that cannot be accounted for by ! the surface fluxes divided by total mass in PSU. real :: salin_mass_in ! The mass of salt input since the last call, kg. @@ -334,12 +334,12 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ ! to this subroutine, in Joules. real :: Heat_anom ! The change in heat that cannot be accounted for by ! the surface fluxes, in Joules. - real :: temp ! The mean potential temperature of the ocean, in degC. + real :: temp ! The mean potential temperature of the ocean [degC]. real :: temp_chg ! The change in total heat divided by total heat capacity ! of the ocean since the last call to this subroutine, degC. real :: temp_anom ! The change in total heat that cannot be accounted for ! by the surface fluxes, divided by the total heat - ! capacity of the ocean, in degC. + ! capacity of the ocean [degC]. real :: hint ! The deviation of an interface from H [Z ~> m]. real :: hbot ! 0 if the basin is deeper than H, or the ! height of the basin depth over H otherwise [Z ~> m]. @@ -349,9 +349,9 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ mass_EFP, & ! Extended fixed point sums of total mass, etc. salt_EFP, heat_EFP, salt_chg_EFP, heat_chg_EFP, mass_chg_EFP, & mass_anom_EFP, salt_anom_EFP, heat_anom_EFP - real :: CFL_trans ! A transport-based definition of the CFL number, nondim. - real :: CFL_lin ! A simpler definition of the CFL number, nondim. - real :: max_CFL(2) ! The maxima of the CFL numbers, nondim. + real :: CFL_trans ! A transport-based definition of the CFL number [nondim]. + real :: CFL_lin ! A simpler definition of the CFL number [nondim]. + real :: max_CFL(2) ! The maxima of the CFL numbers [nondim]. real :: Irho0 ! The inverse of the reference density, in m3 kg-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & tmp1 ! A temporary array @@ -911,7 +911,7 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) !! forcing fields. Unused fields are unallocated. type(surface), intent(in) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. - real, intent(in) :: dt !< The amount of time over which to average, in s. + real, intent(in) :: dt !< The amount of time over which to average [s]. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(Sum_output_CS), pointer :: CS !< The control structure returned by a previous call !! to MOM_sum_output_init. diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index dd0ea1e524..94f0775e4b 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -76,8 +76,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & gprime ! The reduced gravity across each interface [m2 Z-1 s-2 ~> m s-2]. real, dimension(SZK_(G)) :: & Igl, Igu ! The inverse of the reduced gravity across an interface times - ! the thickness of the layer below (Igl) or above (Igu) it, - ! in units of s2 m-2. + ! the thickness of the layer below (Igl) or above (Igu) it [s2 m-2]. real, dimension(SZK_(G),SZI_(G)) :: & Hf, Tf, Sf, Rf real, dimension(SZK_(G)) :: & @@ -520,7 +519,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables integer, intent(in) :: nmodes !< Number of modes real, dimension(G%isd:G%ied,G%jsd:G%jed,nmodes), intent(out) :: cn !< Waves speeds (m/s) @@ -531,11 +530,10 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) real, dimension(SZK_(G)+1) :: & dRho_dT, dRho_dS, & pres, T_int, S_int, & - gprime ! The reduced gravity across each interface, in m s-2. + gprime ! The reduced gravity across each interface [m s-2] real, dimension(SZK_(G)) :: & Igl, Igu ! The inverse of the reduced gravity across an interface times - ! the thickness of the layer below (Igl) or above (Igu) it, - ! in units of s2 m-2. + ! the thickness of the layer below (Igl) or above (Igu) it [s2 m-2]. real, dimension(SZK_(G)-1) :: & a_diag, b_diag, c_diag ! diagonals of tridiagonal matrix; one value for each diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index af959b8279..6ca42835a8 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -50,7 +50,7 @@ module MOM_wave_structure real, allocatable, dimension(:,:,:) :: z_depths !< Depths of layer interfaces, in m. real, allocatable, dimension(:,:,:) :: N2 - !< Squared buoyancy frequency at each interface, in S-2. + !< Squared buoyancy frequency at each interface [s-2]. integer, allocatable, dimension(:,:):: num_intfaces !< Number of layer interfaces (including surface and bottom) real :: int_tide_source_x !< X Location of generation site @@ -100,7 +100,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo !! internal gravity wave speed, !! in m s-1. integer, intent(in) :: ModeNum !< Mode number - real, intent(in) :: freq !< Intrinsic wave frequency, in s-1. + real, intent(in) :: freq !< Intrinsic wave frequency [s-1]. type(wave_structure_CS), pointer :: CS !< The control structure returned !! by a previous call to !! wave_structure_init. @@ -118,7 +118,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real, dimension(SZK_(G)) :: & Igl, Igu ! The inverse of the reduced gravity across an interface times ! the thickness of the layer below (Igl) or above (Igu) it, - ! in units of s2 m-2. + ! [s2 m-2]. real, dimension(SZK_(G),SZI_(G)) :: & Hf, Tf, Sf, Rf real, dimension(SZK_(G)) :: & @@ -157,7 +157,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real :: w2avg ! average of squared vertical velocity structure funtion real :: int_dwdz2, int_w2, int_N2w2, KE_term, PE_term, W0 ! terms in vertically averaged energy equation - real :: gp_unscaled ! A version of gprime rescaled to units of m s-2. + real :: gp_unscaled ! A version of gprime rescaled to [m s-2]. real, dimension(SZK_(G)-1) :: lam_z ! product of eigen value and gprime(k); one value for each ! interface (excluding surface and bottom) real, dimension(SZK_(G)-1) :: a_diag, b_diag, c_diag diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index fe0ae76e6f..43b99b46e0 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -91,7 +91,7 @@ module MOM_EOS !! code for the integrals of density. logical :: Compressible = .true. !< If true, in situ density is a function of pressure. ! The following parameters are used with the linear equation of state only. - real :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. + real :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. real :: dRho_dT !< The partial derivatives of density with temperature real :: dRho_dS !< and salinity, in kg m-3 K-1 and kg m-3 psu-1. ! The following parameters are use with the linear expression for the freezing @@ -571,7 +571,7 @@ subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(out) :: dza !< The change in the geopotential anomaly across - !! the layer, in m2 s-2. + !! the layer [m2 s-2]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & optional, intent(out) :: intp_dza !< The integral in pressure through the layer of the !! geopotential anomaly relative to the anomaly at the bottom of the @@ -579,11 +579,11 @@ subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), & optional, intent(out) :: intx_dza !< The integral in x of the difference between the !! geopotential anomaly at the top and bottom of the layer divided by - !! the x grid spacing, in m2 s-2. + !! the x grid spacing [m2 s-2]. real, dimension(HI%isd:HI%ied,HI%JsdB:HI%JedB), & optional, intent(out) :: inty_dza !< The integral in y of the difference between the !! geopotential anomaly at the top and bottom of the layer divided by - !! the y grid spacing, in m2 s-2. + !! the y grid spacing [m2 s-2]. integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate dza. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & optional, intent(in) :: bathyP !< The pressure at the bathymetry in Pa @@ -640,7 +640,7 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, & real, intent(in) :: G_e !< The Earth's gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & - intent(out) :: dpa !< The change in the pressure anomaly across the layer, in Pa. + intent(out) :: dpa !< The change in the pressure anomaly across the layer [Pa]. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer of !! the pressure anomaly relative to the anomaly at the @@ -648,13 +648,13 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, & real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the layer - !! divided by the x grid spacing, in Pa. + !! divided by the x grid spacing [Pa]. real, dimension(HIO%isd:HIO%ied,HIO%JsdB:HIO%JedB), & optional, intent(out) :: inty_dpa !< The integral in y of the difference between the !! pressure anomaly at the top and bottom of the layer - !! divided by the y grid spacing, in Pa. + !! divided by the y grid spacing [Pa]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. + optional, intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m]. real, optional, intent(in) :: dz_neglect !< A miniscule thickness change [Z ~> m]. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. @@ -894,7 +894,7 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly - !! across the layer, in Pa. + !! across the layer [Pa]. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the !! layer of the pressure anomaly relative to the @@ -902,13 +902,13 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between !! the pressure anomaly at the top and bottom of the - !! layer divided by the x grid spacing, in Pa. + !! layer divided by the x grid spacing [Pa]. real, dimension(HIO%isd:HIO%ied,HIO%JsdB:HIO%JedB), & optional, intent(out) :: inty_dpa !< The integral in y of the difference between !! the pressure anomaly at the top and bottom of the - !! layer divided by the y grid spacing, in Pa. + !! layer divided by the y grid spacing [Pa]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. + optional, intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m]. real, optional, intent(in) :: dz_neglect !< A miniscule thickness change [Z ~> m]. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. @@ -921,12 +921,12 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real :: hWght ! A pressure-thickness below topography [Z ~> m]. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Z ~> m]. real :: iDenom ! The inverse of the denominator in the weights [Z-2 ~> m-2]. - real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. - real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. - real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. + real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim]. + real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim]. + real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim]. + real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns [nondim]. real :: intz(5) ! The gravitational acceleration times the integrals of density - ! with height at the 5 sub-column locations, in Pa. + ! with height at the 5 sub-column locations [Pa]. logical :: do_massWeight ! Indicates whether to do mass weighting. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j, m, n, ioff, joff @@ -1084,10 +1084,10 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & real, intent(in) :: dz_subroundoff !< A miniscule thickness !! change with the same units as z_t real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: bathyT !< The depth of the bathymetry in units of Z. + intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m]. type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & - intent(out) :: dpa !< The change in the pressure anomaly across the layer, in Pa. + intent(out) :: dpa !< The change in the pressure anomaly across the layer [Pa]. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer of !! the pressure anomaly relative to the anomaly at the @@ -1095,11 +1095,11 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the layer - !! divided by the x grid spacing, in Pa. + !! divided by the x grid spacing [Pa]. real, dimension(HIO%isd:HIO%ied,HIO%JsdB:HIO%JedB), & optional, intent(out) :: inty_dpa !< The integral in y of the difference between the !! pressure anomaly at the top and bottom of the layer - !! divided by the y grid spacing, in Pa. + !! divided by the y grid spacing [Pa]. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. ! This subroutine calculates (by numerical quadrature) integrals of @@ -1114,20 +1114,20 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & ! a linear interpolation is used to compute intermediate values. ! Local variables - real :: T5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Temperatures along a line of subgrid locations, in degC - real :: S5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Salinities along a line of subgrid locations, in ppt - real :: p5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Pressures along a line of subgrid locations, in Pa - real :: r5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Densities along a line of subgrid locations, in kg m-3 - real :: T15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Temperatures at an array of subgrid locations, in degC - real :: S15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Salinities at an array of subgrid locations, in ppt - real :: p15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Pressures at an array of subgrid locations, in Pa - real :: r15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Densities at an array of subgrid locations, in kg m-3 - real :: wt_t(5), wt_b(5) ! Top and bottom weights, ND. + real :: T5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Temperatures along a line of subgrid locations, in degC. + real :: S5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Salinities along a line of subgrid locations, in ppt. + real :: p5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Pressures along a line of subgrid locations, in Pa. + real :: r5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Densities along a line of subgrid locations, in kg m-3. + real :: T15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Temperatures at an array of subgrid locations, in degC. + real :: S15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Salinities at an array of subgrid locations, in ppt. + real :: p15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Pressures at an array of subgrid locations, in Pa. + real :: r15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Densities at an array of subgrid locations, in kg m-3. + real :: wt_t(5), wt_b(5) ! Top and bottom weights [nondim]. real :: rho_anom ! A density anomaly in kg m-3. - real :: w_left, w_right ! Left and right weights, ND. + real :: w_left, w_right ! Left and right weights [nondim]. real :: intz(5) ! The gravitational acceleration times the integrals of density - ! with height at the 5 sub-column locations, in Pa. - real, parameter :: C1_90 = 1.0/90.0 ! A rational constant, ND. + ! with height at the 5 sub-column locations [Pa]. + real, parameter :: C1_90 = 1.0/90.0 ! A rational constant [nondim]. real :: GxRho ! Gravitational acceleration times density, in kg m-1 Z-1 s-2. real :: I_Rho ! The inverse of the reference density, in m3 kg-1. real :: dz(HIO%iscB:HIO%iecB+1) ! Layer thicknesses at tracer points [Z ~> m]. @@ -1135,7 +1135,7 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & real :: dz_y(5,HIO%isc:HIO%iec) ! Layer thicknesses along a y-line of subrid locations [Z ~> m]. real :: weight_t, weight_b ! Nondimensional wieghts of the top and bottom. real :: massWeightToggle ! A nondimensional toggle factor (0 or 1). - real :: Ttl, Tbl, Ttr, Tbr ! Temperatures at the velocity cell corners, in degC. + real :: Ttl, Tbl, Ttr, Tbr ! Temperatures at the velocity cell corners [degC]. real :: Stl, Sbl, Str, Sbr ! Salinities at the velocity cell corners, in ppt. real :: hWght ! A topographically limited thicknes weight [Z ~> m]. real :: hL, hR ! Thicknesses to the left and right [Z ~> m]. @@ -1400,7 +1400,7 @@ subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_t Pa_left = P_t - P_tgt ! Pa_left < 0 F_r = 1. Pa_right = P_b - P_tgt ! Pa_right > 0 - Pa_tol = GxRho * 1.e-5 ! 1e-5 has diimensions of m, but should be converted to the units of z. + Pa_tol = GxRho * 1.e-5 ! 1e-5 has dimensions of m, but should be converted to the units of z. if (present(z_tol)) Pa_tol = GxRho * z_tol F_guess = F_l - Pa_left / ( Pa_right -Pa_left ) * ( F_r - F_l ) Pa = Pa_right - Pa_left ! To get into iterative loop @@ -1441,7 +1441,7 @@ real function frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, pos, EO real, intent(in) :: z_b !< The geometric height at the bottom of the layer, usually in m real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to !! reduce the magnitude of each of the integrals. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration [m s-2] real, intent(in) :: pos !< The fractional vertical position, nondim, 0 to 1. type(EOS_type), pointer :: EOS !< Equation of state structure ! Local variables @@ -1499,10 +1499,10 @@ subroutine int_density_dz_generic_ppm (T, T_t, T_b, S, S_t, S_b, & !! reduce the magnitude of each of the integrals. real, intent(in) :: rho_0 !< A density, in kg m-3, that is used to calculate the !! pressure (as p~=-z*rho_0*G_e) used in the equation of state. - real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m s-2. + real, intent(in) :: G_e !< The Earth's gravitational acceleration [m s-2] type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & - intent(out) :: dpa !< The change in the pressure anomaly across the layer, in Pa. + intent(out) :: dpa !< The change in the pressure anomaly across the layer [Pa]. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer of !! the pressure anomaly relative to the anomaly at the @@ -1510,11 +1510,11 @@ subroutine int_density_dz_generic_ppm (T, T_t, T_b, S, S_t, S_b, & real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the layer - !! divided by the x grid spacing, in Pa. + !! divided by the x grid spacing [Pa]. real, dimension(HIO%isd:HIO%ied,HIO%JsdB:HIO%JedB), & optional, intent(out) :: inty_dpa !< The integral in y of the difference between the !! pressure anomaly at the top and bottom of the layer - !! divided by the y grid spacing, in Pa. + !! divided by the y grid spacing [Pa]. ! This subroutine calculates (by numerical quadrature) integrals of ! pressure anomalies across layers, which are required for calculating the @@ -1540,7 +1540,7 @@ subroutine int_density_dz_generic_ppm (T, T_t, T_b, S, S_t, S_b, & ! (The pressure is calucated as p~=-z*rho_0*G_e.) ! (in) rho_0 - A density, in kg m-3, that is used to calculate the pressure ! (as p~=-z*rho_0*G_e) used in the equation of state. -! (in) G_e - The Earth's gravitational acceleration, in m s-2. +! (in) G_e - The Earth's gravitational acceleration [m s-2] ! (in) G - The ocean's grid structure. ! (in) form_of_eos - integer that selects the eqn of state. ! (out) dpa - The change in the pressure anomaly across the layer, @@ -1550,10 +1550,10 @@ subroutine int_density_dz_generic_ppm (T, T_t, T_b, S, S_t, S_b, & ! the layer, in Pa m. ! (out,opt) intx_dpa - The integral in x of the difference between the ! pressure anomaly at the top and bottom of the layer -! divided by the x grid spacing, in Pa. +! divided by the x grid spacing [Pa]. ! (out,opt) inty_dpa - The integral in y of the difference between the ! pressure anomaly at the top and bottom of the layer -! divided by the y grid spacing, in Pa. +! divided by the y grid spacing [Pa]. real :: T5(5), S5(5), p5(5), r5(5) real :: rho_anom @@ -1959,7 +1959,7 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, & type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(out) :: dza !< The change in the geopotential anomaly - !! across the layer, in m2 s-2. + !! across the layer [m2 s-2]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & optional, intent(out) :: intp_dza !< The integral in pressure through the !! layer of the geopotential anomaly relative to the anomaly @@ -1967,11 +1967,11 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, & real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), & optional, intent(out) :: intx_dza !< The integral in x of the difference !! between the geopotential anomaly at the top and bottom of - !! the layer divided by the x grid spacing, in m2 s-2. + !! the layer divided by the x grid spacing [m2 s-2]. real, dimension(HI%isd:HI%ied,HI%JsdB:HI%JedB), & optional, intent(out) :: inty_dza !< The integral in y of the difference !! between the geopotential anomaly at the top and bottom of - !! the layer divided by the y grid spacing, in m2 s-2. + !! the layer divided by the y grid spacing [m2 s-2]. integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate dza. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & optional, intent(in) :: bathyP !< The pressure at the bathymetry in Pa @@ -1989,17 +1989,17 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, & real :: T5(5), S5(5), p5(5), a5(5) real :: alpha_anom ! The depth averaged specific density anomaly in m3 kg-1. - real :: dp ! The pressure change through a layer, in Pa. -! real :: dp_90(2:4) ! The pressure change through a layer divided by 90, in Pa. - real :: hWght ! A pressure-thickness below topography, in Pa. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Pa. + real :: dp ! The pressure change through a layer [Pa]. +! real :: dp_90(2:4) ! The pressure change through a layer divided by 90 [Pa]. + real :: hWght ! A pressure-thickness below topography [Pa]. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Pa]. real :: iDenom ! The inverse of the denominator in the weights, in Pa-2. - real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. - real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. - real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. + real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim]. + real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim]. + real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim]. + real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns [nondim]. real :: intp(5) ! The integrals of specific volume with pressure at the - ! 5 sub-column locations, in m2 s-2. + ! 5 sub-column locations [m2 s-2]. logical :: do_massWeight ! Indicates whether to do mass weighting. real, parameter :: C1_90 = 1.0/90.0 ! A rational constant. integer :: Isq, Ieq, Jsq, Jeq, ish, ieh, jsh, jeh, i, j, m, n, halo @@ -2157,7 +2157,7 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(out) :: dza !< The change in the geopotential anomaly - !! across the layer, in m2 s-2. + !! across the layer [m2 s-2]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & optional, intent(out) :: intp_dza !< The integral in pressure through the !! layer of the geopotential anomaly relative to the anomaly @@ -2165,11 +2165,11 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), & optional, intent(out) :: intx_dza !< The integral in x of the difference !! between the geopotential anomaly at the top and bottom of - !! the layer divided by the x grid spacing, in m2 s-2. + !! the layer divided by the x grid spacing [m2 s-2]. real, dimension(HI%isd:HI%ied,HI%JsdB:HI%JedB), & optional, intent(out) :: inty_dza !< The integral in y of the difference !! between the geopotential anomaly at the top and bottom of - !! the layer divided by the y grid spacing, in m2 s-2. + !! the layer divided by the y grid spacing [m2 s-2]. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting !! to interpolate T/S for top and bottom integrals. @@ -2186,17 +2186,17 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, real :: T_top, T_bot, S_top, S_bot, P_top, P_bot real :: alpha_anom ! The depth averaged specific density anomaly in m3 kg-1. - real :: dp ! The pressure change through a layer, in Pa. - real :: dp_90(2:4) ! The pressure change through a layer divided by 90, in Pa. - real :: hWght ! A pressure-thickness below topography, in Pa. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Pa. + real :: dp ! The pressure change through a layer [Pa]. + real :: dp_90(2:4) ! The pressure change through a layer divided by 90 [Pa]. + real :: hWght ! A pressure-thickness below topography [Pa]. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Pa]. real :: iDenom ! The inverse of the denominator in the weights, in Pa-2. - real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. - real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. - real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. + real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim]. + real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim]. + real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim]. + real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns [nondim]. real :: intp(5) ! The integrals of specific volume with pressure at the - ! 5 sub-column locations, in m2 s-2. + ! 5 sub-column locations [m2 s-2]. real, parameter :: C1_90 = 1.0/90.0 ! A rational constant. logical :: do_massWeight ! Indicates whether to do mass weighting. integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n, pos diff --git a/src/equation_of_state/MOM_EOS_NEMO.F90 b/src/equation_of_state/MOM_EOS_NEMO.F90 index c925301607..fcc005ca61 100644 --- a/src/equation_of_state/MOM_EOS_NEMO.F90 +++ b/src/equation_of_state/MOM_EOS_NEMO.F90 @@ -22,7 +22,7 @@ module MOM_EOS_NEMO public calculate_density_derivs_nemo public calculate_density_scalar_nemo, calculate_density_array_nemo -!> Compute the in situ density of sea water (units of kg/m^3), or its anomaly with respect to +!> Compute the in situ density of sea water ([kg m-3]), or its anomaly with respect to !! a reference density, from absolute salinity (g/kg), conservative temperature (in deg C), !! and pressure in Pa, using the expressions derived for use with NEMO interface calculate_density_nemo @@ -174,8 +174,8 @@ module MOM_EOS_NEMO contains !> This subroutine computes the in situ density of sea water (rho in -!! units of kg/m^3) from absolute salinity (S in g/kg), conservative temperature -!! (T in deg C), and pressure in Pa. It uses the expressions derived for use +!! [kg m-3]) from absolute salinity (S [g kg-1]), conservative temperature +!! (T [degC]), and pressure in Pa. It uses the expressions derived for use !! with NEMO. subroutine calculate_density_scalar_nemo(T, S, pressure, rho, rho_ref) real, intent(in) :: T !< Conservative temperature in C. @@ -199,8 +199,8 @@ subroutine calculate_density_scalar_nemo(T, S, pressure, rho, rho_ref) end subroutine calculate_density_scalar_nemo !> This subroutine computes the in situ density of sea water (rho in -!! units of kg/m^3) from absolute salinity (S in g/kg), conservative temperature -!! (T in deg C), and pressure in Pa. It uses the expressions derived for use +!! [kg m-3]) from absolute salinity (S [g kg-1]), conservative temperature +!! (T [degC]), and pressure in Pa. It uses the expressions derived for use !! with NEMO. subroutine calculate_density_array_nemo(T, S, pressure, rho, start, npts, rho_ref) real, dimension(:), intent(in) :: T !< Conservative temperature in C. @@ -339,7 +339,7 @@ end subroutine calculate_density_derivs_array_nemo !> Wrapper to calculate_density_derivs_array for scalar inputs subroutine calculate_density_derivs_scalar_nemo(T, S, pressure, drho_dt, drho_ds) - real, intent(in) :: T !< Potential temperature relative to the surface in C. + real, intent(in) :: T !< Potential temperature relative to the surface in degC. real, intent(in) :: S !< Salinity in PSU. real, intent(in) :: pressure !< Pressure in Pa. real, intent(out) :: drho_dT !< The partial derivative of density with potential @@ -361,9 +361,9 @@ subroutine calculate_density_derivs_scalar_nemo(T, S, pressure, drho_dt, drho_ds drho_ds = drds0(1) end subroutine calculate_density_derivs_scalar_nemo -!> Compute the in situ density of sea water (rho in units of kg/m^3) and the compressibility -!! (drho/dp = C_sound^-2, stored as drho_dp in units of s2 m-2) from absolute salinity -!! (sal in g/kg), conservative temperature (T in deg C), and pressure in Pa, using the expressions +!> Compute the in situ density of sea water (rho in [kg m-3]) and the compressibility +!! (drho/dp = C_sound^-2, stored as drho_dp [s2 m-2]) from absolute salinity +!! (sal in g/kg), conservative temperature (T [degC]), and pressure in Pa, using the expressions !! derived for use with NEMO. subroutine calculate_compress_nemo(T, S, pressure, rho, drho_dp, start, npts) real, intent(in), dimension(:) :: T !< Conservative temperature in C. diff --git a/src/equation_of_state/MOM_EOS_TEOS10.F90 b/src/equation_of_state/MOM_EOS_TEOS10.F90 index 4a139582a3..813a51307e 100644 --- a/src/equation_of_state/MOM_EOS_TEOS10.F90 +++ b/src/equation_of_state/MOM_EOS_TEOS10.F90 @@ -22,14 +22,14 @@ module MOM_EOS_TEOS10 public calculate_density_second_derivs_teos10 public gsw_sp_from_sr, gsw_pt_from_ct -!> Compute the in situ density of sea water (units of kg/m^3), or its anomaly with respect to +!> Compute the in situ density of sea water ([kg m-3]), or its anomaly with respect to !! a reference density, from absolute salinity (g/kg), conservative temperature (in deg C), !! and pressure in Pa, using the TEOS10 expressions. interface calculate_density_teos10 module procedure calculate_density_scalar_teos10, calculate_density_array_teos10 end interface calculate_density_teos10 -!> Compute the in situ specific volume of sea water (in units of m^3/kg), or an anomaly with respect +!> Compute the in situ specific volume of sea water (in [m3 kg-1]), or an anomaly with respect !! to a reference specific volume, from absolute salinity (in g/kg), conservative temperature !! (in deg C), and pressure in Pa, using the TEOS10 expressions. interface calculate_spec_vol_teos10 @@ -53,8 +53,8 @@ module MOM_EOS_TEOS10 contains !> This subroutine computes the in situ density of sea water (rho in -!! units of kg/m^3) from absolute salinity (S in g/kg), conservative temperature -!! (T in deg C), and pressure in Pa. It uses the expression from the +!! [kg m-3]) from absolute salinity (S [g kg-1]), conservative temperature +!! (T [degC]), and pressure in Pa. It uses the expression from the !! TEOS10 website. subroutine calculate_density_scalar_teos10(T, S, pressure, rho, rho_ref) real, intent(in) :: T !< Conservative temperature in C. @@ -77,8 +77,8 @@ subroutine calculate_density_scalar_teos10(T, S, pressure, rho, rho_ref) end subroutine calculate_density_scalar_teos10 !> This subroutine computes the in situ density of sea water (rho in -!! units of kg/m^3) from absolute salinity (S in g/kg), conservative temperature -!! (T in deg C), and pressure in Pa. It uses the expression from the +!! [kg m-3]) from absolute salinity (S [g kg-1]), conservative temperature +!! (T [degC]), and pressure in Pa. It uses the expression from the !! TEOS10 website. subroutine calculate_density_array_teos10(T, S, pressure, rho, start, npts, rho_ref) real, dimension(:), intent(in) :: T !< Conservative temperature in C. @@ -109,7 +109,7 @@ subroutine calculate_density_array_teos10(T, S, pressure, rho, start, npts, rho_ end subroutine calculate_density_array_teos10 !> This subroutine computes the in situ specific volume of sea water (specvol in -!! units of m^3/kg) from absolute salinity (S in g/kg), conservative temperature (T in deg C) +!! [m3 kg-1]) from absolute salinity (S [g kg-1]), conservative temperature (T [degC]) !! and pressure in Pa, using the TEOS10 equation of state. !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_scalar_teos10(T, S, pressure, specvol, spv_ref) @@ -130,7 +130,7 @@ end subroutine calculate_spec_vol_scalar_teos10 !> This subroutine computes the in situ specific volume of sea water (specvol in -!! units of m^3/kg) from absolute salinity (S in g/kg), conservative temperature (T in deg C) +!! [m3 kg-1]) from absolute salinity (S [g kg-1]), conservative temperature (T [degC]) !! and pressure in Pa, using the TEOS10 equation of state. !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_array_teos10(T, S, pressure, specvol, start, npts, spv_ref) @@ -306,9 +306,9 @@ subroutine calculate_density_second_derivs_array_teos10(T, S, pressure, drho_dS_ end subroutine calculate_density_second_derivs_array_teos10 !> This subroutine computes the in situ density of sea water (rho in -!! units of kg/m^3) and the compressibility (drho/dp = C_sound^-2) -!! (drho_dp in units of s2 m-2) from absolute salinity (sal in g/kg), -!! conservative temperature (T in deg C), and pressure in Pa. It uses the +!! [kg m-3]) and the compressibility (drho/dp = C_sound^-2) +!! (drho_dp [s2 m-2]) from absolute salinity (sal in g/kg), +!! conservative temperature (T [degC]), and pressure in Pa. It uses the !! subroutines from TEOS10 website subroutine calculate_compress_teos10(T, S, pressure, rho, drho_dp, start, npts) real, intent(in), dimension(:) :: T !< Conservative temperature in C. diff --git a/src/equation_of_state/MOM_EOS_UNESCO.F90 b/src/equation_of_state/MOM_EOS_UNESCO.F90 index eaad8d0128..2b6c5469ee 100644 --- a/src/equation_of_state/MOM_EOS_UNESCO.F90 +++ b/src/equation_of_state/MOM_EOS_UNESCO.F90 @@ -16,14 +16,14 @@ module MOM_EOS_UNESCO public calculate_density_derivs_UNESCO public calculate_density_scalar_UNESCO, calculate_density_array_UNESCO -!> Compute the in situ density of sea water (in units of kg/m^3), or its anomaly with respect to +!> Compute the in situ density of sea water (in [kg m-3]), or its anomaly with respect to !! a reference density, from salinity (in psu), potential temperature (in deg C), and pressure in Pa, !! using the UNESCO (1981) equation of state. interface calculate_density_UNESCO module procedure calculate_density_scalar_UNESCO, calculate_density_array_UNESCO end interface calculate_density_UNESCO -!> Compute the in situ specific volume of sea water (in units of m^3/kg), or an anomaly with respect +!> Compute the in situ specific volume of sea water (in [m3 kg-1]), or an anomaly with respect !! to a reference specific volume, from salinity (in psu), potential temperature (in deg C), and !! pressure in Pa, using the UNESCO (1981) equation of state. interface calculate_spec_vol_UNESCO @@ -54,8 +54,8 @@ module MOM_EOS_UNESCO contains !> This subroutine computes the in situ density of sea water (rho in -!! units of kg/m^3) from salinity (S in psu), potential temperature -!! (T in deg C), and pressure in Pa, using the UNESCO (1981) equation of state. +!! [kg m-3]) from salinity (S [PSU]), potential temperature +!! (T [degC]), and pressure in Pa, using the UNESCO (1981) equation of state. subroutine calculate_density_scalar_UNESCO(T, S, pressure, rho, rho_ref) real, intent(in) :: T !< Potential temperature relative to the surface in C. real, intent(in) :: S !< Salinity in PSU. @@ -77,8 +77,8 @@ subroutine calculate_density_scalar_UNESCO(T, S, pressure, rho, rho_ref) end subroutine calculate_density_scalar_UNESCO !> This subroutine computes the in situ density of sea water (rho in -!! units of kg/m^3) from salinity (S in psu), potential temperature -!! (T in deg C), and pressure in Pa, using the UNESCO (1981) equation of state. +!! [kg m-3]) from salinity (S [PSU]), potential temperature +!! (T [degC]), and pressure in Pa, using the UNESCO (1981) equation of state. subroutine calculate_density_array_UNESCO(T, S, pressure, rho, start, npts, rho_ref) real, dimension(:), intent(in) :: T !< potential temperature relative to the surface in C. real, dimension(:), intent(in) :: S !< salinity in PSU. @@ -92,8 +92,8 @@ subroutine calculate_density_array_UNESCO(T, S, pressure, rho, start, npts, rho_ real :: t_local, t2, t3, t4, t5 ! Temperature to the 1st - 5th power. real :: s_local, s32, s2 ! Salinity to the 1st, 3/2, & 2nd power. real :: p1, p2 ! Pressure (in bars) to the 1st and 2nd power. - real :: rho0 ! Density at 1 bar pressure, in kg m-3. - real :: sig0 ! The anomaly of rho0 from R00, in kg m-3. + real :: rho0 ! Density at 1 bar pressure [kg m-3]. + real :: sig0 ! The anomaly of rho0 from R00 [kg m-3]. real :: ks ! The secant bulk modulus in bar. integer :: j @@ -131,7 +131,7 @@ subroutine calculate_density_array_UNESCO(T, S, pressure, rho, start, npts, rho_ end subroutine calculate_density_array_UNESCO !> This subroutine computes the in situ specific volume of sea water (specvol in -!! units of m^3/kg) from salinity (S in psu), potential temperature (T in deg C) +!! [m3 kg-1]) from salinity (S [PSU]), potential temperature (T [degC]) !! and pressure in Pa, using the UNESCO (1981) equation of state. !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_scalar_UNESCO(T, S, pressure, specvol, spv_ref) @@ -152,7 +152,7 @@ subroutine calculate_spec_vol_scalar_UNESCO(T, S, pressure, specvol, spv_ref) end subroutine calculate_spec_vol_scalar_UNESCO !> This subroutine computes the in situ specific volume of sea water (specvol in -!! units of m^3/kg) from salinity (S in psu), potential temperature (T in deg C) +!! [m3 kg-1]) from salinity (S [PSU]), potential temperature (T [degC]) !! and pressure in Pa, using the UNESCO (1981) equation of state. !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_array_UNESCO(T, S, pressure, specvol, start, npts, spv_ref) @@ -169,7 +169,7 @@ subroutine calculate_spec_vol_array_UNESCO(T, S, pressure, specvol, start, npts, real :: t_local, t2, t3, t4, t5; ! Temperature to the 1st - 5th power. real :: s_local, s32, s2; ! Salinity to the 1st, 3/2, & 2nd power. real :: p1, p2; ! Pressure (in bars) to the 1st and 2nd power. - real :: rho0; ! Density at 1 bar pressure, in kg m-3. + real :: rho0; ! Density at 1 bar pressure [kg m-3]. real :: ks; ! The secant bulk modulus in bar. integer :: j @@ -225,7 +225,7 @@ subroutine calculate_density_derivs_UNESCO(T, S, pressure, drho_dT, drho_dS, sta real :: t_local, t2, t3, t4, t5; ! Temperature to the 1st - 5th power. real :: s12, s_local, s32, s2; ! Salinity to the 1/2 - 2nd powers. real :: p1, p2; ! Pressure (in bars) to the 1st & 2nd power. - real :: rho0; ! Density at 1 bar pressure, in kg m-3. + real :: rho0; ! Density at 1 bar pressure [kg m-3]. real :: ks; ! The secant bulk modulus, in bar. real :: drho0_dT; ! Derivative of rho0 with T, in kg m-3 K-1. real :: drho0_dS; ! Derivative of rho0 with S, kg m-3 psu-1. @@ -296,7 +296,7 @@ subroutine calculate_compress_UNESCO(T, S, pressure, rho, drho_dp, start, npts) real :: t_local, t2, t3, t4, t5; ! Temperature to the 1st - 5th power. real :: s_local, s32, s2; ! Salinity to the 1st, 3/2, & 2nd power. real :: p1, p2; ! Pressure (in bars) to the 1st and 2nd power. - real :: rho0; ! Density at 1 bar pressure, in kg m-3. + real :: rho0; ! Density at 1 bar pressure [kg m-3]. real :: ks; ! The secant bulk modulus in bar. real :: ks_0, ks_1, ks_2 real :: dks_dp; ! The derivative of the secant bulk modulus diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index 110ac44c9b..ba1b7f436e 100644 --- a/src/equation_of_state/MOM_EOS_Wright.F90 +++ b/src/equation_of_state/MOM_EOS_Wright.F90 @@ -26,14 +26,14 @@ module MOM_EOS_Wright ! vary with the Boussinesq approximation, the Boussinesq variant is given first. -!> Compute the in situ density of sea water (in units of kg/m^3), or its anomaly with respect to +!> Compute the in situ density of sea water (in [kg m-3]), or its anomaly with respect to !! a reference density, from salinity (in psu), potential temperature (in deg C), and pressure in Pa, !! using the expressions from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. interface calculate_density_wright module procedure calculate_density_scalar_wright, calculate_density_array_wright end interface calculate_density_wright -!> Compute the in situ specific volume of sea water (in units of m^3/kg), or an anomaly with respect +!> Compute the in situ specific volume of sea water (in [m3 kg-1]), or an anomaly with respect !! to a reference specific volume, from salinity (in psu), potential temperature (in deg C), and !! pressure in Pa, using the expressions from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. interface calculate_spec_vol_wright @@ -74,8 +74,8 @@ module MOM_EOS_Wright contains !> This subroutine computes the in situ density of sea water (rho in -!! units of kg/m^3) from salinity (S in psu), potential temperature -!! (T in deg C), and pressure in Pa. It uses the expression from +!! [kg m-3]) from salinity (S [PSU]), potential temperature +!! (T [degC]), and pressure in Pa. It uses the expression from !! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. subroutine calculate_density_scalar_wright(T, S, pressure, rho, rho_ref) real, intent(in) :: T !< Potential temperature relative to the surface in C. @@ -86,8 +86,8 @@ subroutine calculate_density_scalar_wright(T, S, pressure, rho, rho_ref) ! *====================================================================* ! * This subroutine computes the in situ density of sea water (rho in * -! * units of kg/m^3) from salinity (S in psu), potential temperature * -! * (T in deg C), and pressure in Pa. It uses the expression from * +! * [kg m-3]) from salinity (S [PSU]), potential temperature * +! * (T [degC]), and pressure in Pa. It uses the expression from * ! * Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. * ! * Coded by R. Hallberg, 7/00 * ! *====================================================================* @@ -104,8 +104,8 @@ subroutine calculate_density_scalar_wright(T, S, pressure, rho, rho_ref) end subroutine calculate_density_scalar_wright !> This subroutine computes the in situ density of sea water (rho in -!! units of kg/m^3) from salinity (S in psu), potential temperature -!! (T in deg C), and pressure in Pa. It uses the expression from +!! [kg m-3]) from salinity (S [PSU]), potential temperature +!! (T [degC]), and pressure in Pa. It uses the expression from !! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. subroutine calculate_density_array_wright(T, S, pressure, rho, start, npts, rho_ref) real, dimension(:), intent(in) :: T !< potential temperature relative to the surface in C. @@ -143,7 +143,7 @@ subroutine calculate_density_array_wright(T, S, pressure, rho, start, npts, rho_ end subroutine calculate_density_array_wright !> This subroutine computes the in situ specific volume of sea water (specvol in -!! units of m^3/kg) from salinity (S in psu), potential temperature (T in deg C) +!! [m3 kg-1]) from salinity (S [PSU]), potential temperature (T [degC]) !! and pressure in Pa. It uses the expression from !! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. !! If spv_ref is present, specvol is an anomaly from spv_ref. @@ -164,7 +164,7 @@ subroutine calculate_spec_vol_scalar_wright(T, S, pressure, specvol, spv_ref) end subroutine calculate_spec_vol_scalar_wright !> This subroutine computes the in situ specific volume of sea water (specvol in -!! units of m^3/kg) from salinity (S in psu), potential temperature (T in deg C) +!! [m3 kg-1]) from salinity (S [PSU]), potential temperature (T [degC]) !! and pressure in Pa. It uses the expression from !! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. !! If spv_ref is present, specvol is an anomaly from spv_ref. @@ -361,9 +361,9 @@ subroutine calculate_specvol_derivs_wright(T, S, pressure, dSV_dT, dSV_dS, start end subroutine calculate_specvol_derivs_wright !> This subroutine computes the in situ density of sea water (rho in -!! units of kg/m^3) and the compressibility (drho/dp = C_sound^-2) -!! (drho_dp in units of s2 m-2) from salinity (sal in psu), potential -!! temperature (T in deg C), and pressure in Pa. It uses the expressions +!! [kg m-3]) and the compressibility (drho/dp = C_sound^-2) +!! (drho_dp [s2 m-2]) from salinity (sal in psu), potential +!! temperature (T [degC]), and pressure in Pa. It uses the expressions !! from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. !! Coded by R. Hallberg, 1/01 subroutine calculate_compress_wright(T, S, pressure, rho, drho_dp, start, npts) @@ -419,7 +419,7 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, intent(in) :: G_e !< The Earth's gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly across the - !! layer, in Pa. + !! layer [Pa]. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer !! of the pressure anomaly relative to the anomaly @@ -427,13 +427,13 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the - !! layer divided by the x grid spacing, in Pa. + !! layer divided by the x grid spacing [Pa]. real, dimension(HIO%isd:HIO%ied,HIO%JsdB:HIO%JedB), & optional, intent(out) :: inty_dpa !< The integral in y of the difference between the !! pressure anomaly at the top and bottom of the - !! layer divided by the y grid spacing, in Pa. + !! layer divided by the y grid spacing [Pa]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. + optional, intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m]. real, optional, intent(in) :: dz_neglect !< A miniscule thickness change [Z ~> m]. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. @@ -441,7 +441,7 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, ! Local variables real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed) :: al0_2d, p0_2d, lambda_2d real :: al0, p0, lambda - real :: rho_anom ! The density anomaly from rho_ref, in kg m-3. + real :: rho_anom ! The density anomaly from rho_ref [kg m-3]. real :: eps, eps2, rem real :: GxRho, I_Rho real :: p_ave, I_al0, I_Lzz @@ -449,12 +449,12 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real :: hWght ! A pressure-thickness below topography [Z ~> m]. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Z ~> m]. real :: iDenom ! The inverse of the denominator in the weights, in m-Z. - real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. - real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. - real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. + real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim]. + real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim]. + real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim]. + real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns [nondim]. real :: intz(5) ! The integrals of density with height at the - ! 5 sub-column locations, in Pa. + ! 5 sub-column locations [Pa]. logical :: do_massWeight ! Indicates whether to do mass weighting. real, parameter :: C1_3 = 1.0/3.0, C1_7 = 1.0/7.0 ! Rational constants. real, parameter :: C1_9 = 1.0/9.0, C1_90 = 1.0/90.0 ! Rational constants. @@ -620,7 +620,7 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & !! effects of roundoff. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(out) :: dza !< The change in the geopotential anomaly across - !! the layer, in m2 s-2. + !! the layer [m2 s-2]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & optional, intent(out) :: intp_dza !< The integral in pressure through the layer of !! the geopotential anomaly relative to the anomaly @@ -638,7 +638,7 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate !! dza. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - optional, intent(in) :: bathyP !< The pressure at the bathymetry in Pa + optional, intent(in) :: bathyP !< The pressure at the bathymetry [Pa] real, optional, intent(in) :: dP_neglect !< A miniscule pressure change with !! the same units as p_t (Pa?) logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting @@ -650,16 +650,16 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & real :: p_ave real :: rem, eps, eps2 real :: alpha_anom ! The depth averaged specific density anomaly in m3 kg-1. - real :: dp ! The pressure change through a layer, in Pa. - real :: hWght ! A pressure-thickness below topography, in Pa. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Pa. + real :: dp ! The pressure change through a layer [Pa]. + real :: hWght ! A pressure-thickness below topography [Pa]. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Pa]. real :: iDenom ! The inverse of the denominator in the weights, in Pa-2. - real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. - real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. - real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. + real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim]. + real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim]. + real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim]. + real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns [nondim]. real :: intp(5) ! The integrals of specific volume with pressure at the - ! 5 sub-column locations, in m2 s-2. + ! 5 sub-column locations [m2 s-2]. logical :: do_massWeight ! Indicates whether to do mass weighting. real, parameter :: C1_3 = 1.0/3.0, C1_7 = 1.0/7.0 ! Rational constants. real, parameter :: C1_9 = 1.0/9.0, C1_90 = 1.0/90.0 ! Rational constants. diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90 index d2ef8c8550..85fddc284e 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -52,14 +52,14 @@ module MOM_EOS_linear !> This subroutine computes the density of sea water with a trivial !! linear equation of state (in kg m-3) from salinity (sal in PSU), -!! potential temperature (T in deg C), and pressure in Pa. +!! potential temperature (T [degC]), and pressure in Pa. subroutine calculate_density_scalar_linear(T, S, pressure, rho, & Rho_T0_S0, dRho_dT, dRho_dS, rho_ref) real, intent(in) :: T !< Potential temperature relative to the surface in C. real, intent(in) :: S !< Salinity in PSU. real, intent(in) :: pressure !< Pressure in Pa. real, intent(out) :: rho !< In situ density in kg m-3. - real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. + real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. real, intent(in) :: dRho_dT !< The derivatives of density with temperature !! in kg m-3 C-1. real, intent(in) :: dRho_dS !< The derivatives of density with salinity @@ -76,7 +76,7 @@ end subroutine calculate_density_scalar_linear !> This subroutine computes the density of sea water with a trivial !! linear equation of state (in kg/m^3) from salinity (sal in psu), -!! potential temperature (T in deg C), and pressure in Pa. +!! potential temperature (T [degC]), and pressure in Pa. subroutine calculate_density_array_linear(T, S, pressure, rho, start, npts, & Rho_T0_S0, dRho_dT, dRho_dS, rho_ref) real, dimension(:), intent(in) :: T !< potential temperature relative to the surface in C. @@ -85,7 +85,7 @@ subroutine calculate_density_array_linear(T, S, pressure, rho, start, npts, & real, dimension(:), intent(out) :: rho !< in situ density in kg m-3. integer, intent(in) :: start !< the starting point in the arrays. integer, intent(in) :: npts !< the number of values to calculate. - real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. + real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. real, intent(in) :: dRho_dT !< The derivatives of density with temperature !! in kg m-3 C-1. real, intent(in) :: dRho_dS !< The derivatives of density with salinity @@ -103,7 +103,7 @@ subroutine calculate_density_array_linear(T, S, pressure, rho, start, npts, & end subroutine calculate_density_array_linear !> This subroutine computes the in situ specific volume of sea water (specvol in -!! units of m^3/kg) from salinity (S in psu), potential temperature (T in deg C) +!! [m3 kg-1]) from salinity (S [PSU]), potential temperature (T [degC]) !! and pressure in Pa, using a trivial linear equation of state for density. !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_scalar_linear(T, S, pressure, specvol, & @@ -113,7 +113,7 @@ subroutine calculate_spec_vol_scalar_linear(T, S, pressure, specvol, & real, intent(in) :: S !< salinity in PSU. real, intent(in) :: pressure !< pressure in Pa. real, intent(out) :: specvol !< in situ specific volume in m3 kg-1. - real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. + real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. real, intent(in) :: dRho_dT !< The derivatives of density with temperature in kg m-3 C-1. real, intent(in) :: dRho_dS !< The derivatives of density with salinity in kg m-3 psu-1. real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1. @@ -130,7 +130,7 @@ subroutine calculate_spec_vol_scalar_linear(T, S, pressure, specvol, & end subroutine calculate_spec_vol_scalar_linear !> This subroutine computes the in situ specific volume of sea water (specvol in -!! units of m^3/kg) from salinity (S in psu), potential temperature (T in deg C) +!! [m3 kg-1]) from salinity (S [PSU]), potential temperature (T [degC]) !! and pressure in Pa, using a trivial linear equation of state for density. !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_array_linear(T, S, pressure, specvol, start, npts, & @@ -142,7 +142,7 @@ subroutine calculate_spec_vol_array_linear(T, S, pressure, specvol, start, npts, real, dimension(:), intent(out) :: specvol !< in situ specific volume in m3 kg-1. integer, intent(in) :: start !< the starting point in the arrays. integer, intent(in) :: npts !< the number of values to calculate. - real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. + real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. real, intent(in) :: dRho_dT !< The derivatives of density with temperature in kg m-3 C-1. real, intent(in) :: dRho_dS !< The derivatives of density with salinity in kg m-3 psu-1. real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1. @@ -170,7 +170,7 @@ subroutine calculate_density_derivs_array_linear(T, S, pressure, drho_dT_out, & !! potential temperature, in kg m-3 K-1. real, intent(out), dimension(:) :: drho_dS_out !< The partial derivative of density with !! salinity, in kg m-3 psu-1. - real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. + real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. real, intent(in) :: dRho_dT !< The derivatives of density with temperature in kg m-3 C-1. real, intent(in) :: dRho_dS !< The derivatives of density with salinity in kg m-3 psu-1. integer, intent(in) :: start !< The starting point in the arrays. @@ -197,7 +197,7 @@ subroutine calculate_density_derivs_scalar_linear(T, S, pressure, drho_dT_out, & !! potential temperature, in kg m-3 K-1. real, intent(out) :: drho_dS_out !< The partial derivative of density with !! salinity, in kg m-3 psu-1. - real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. + real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. real, intent(in) :: dRho_dT !< The derivatives of density with temperature in kg m-3 C-1. real, intent(in) :: dRho_dS !< The derivatives of density with salinity in kg m-3 psu-1. drho_dT_out = dRho_dT @@ -267,7 +267,7 @@ subroutine calculate_specvol_derivs_linear(T, S, pressure, dSV_dT, dSV_dS, & !! potential temperature, in m3 kg-1 K-1. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. - real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. + real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. real, intent(in) :: dRho_dT !< The derivative of density with !! temperature, in kg m-3 C-1. real, intent(in) :: dRho_dS !< The derivative of density with @@ -300,7 +300,7 @@ subroutine calculate_compress_linear(T, S, pressure, rho, drho_dp, start, npts,& !! in s2 m-2. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. - real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. + real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. real, intent(in) :: dRho_dT !< The derivative of density with !! temperature, in kg m-3 C-1. real, intent(in) :: dRho_dS !< The derivative of density with @@ -339,14 +339,14 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, !! the equation of state. rho_0_pres is not used !! here. real, intent(in) :: G_e !< The Earth's gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. - real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. + real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. real, intent(in) :: dRho_dT !< The derivative of density with temperature, !! in kg m-3 C-1. real, intent(in) :: dRho_dS !< The derivative of density with salinity, !! in kg m-3 psu-1. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly across the - !! layer, in Pa. + !! layer [Pa]. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer !! of the pressure anomaly relative to the anomaly @@ -354,29 +354,29 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the - !! layer divided by the x grid spacing, in Pa. + !! layer divided by the x grid spacing [Pa]. real, dimension(HIO%isd:HIO%ied,HIO%JsdB:HIO%JedB), & optional, intent(out) :: inty_dpa !< The integral in y of the difference between the !! pressure anomaly at the top and bottom of the - !! layer divided by the y grid spacing, in Pa. + !! layer divided by the y grid spacing [Pa]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - optional, intent(in) :: bathyT !< The depth of the bathymetry in units of Z. + optional, intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m]. real, optional, intent(in) :: dz_neglect !< A miniscule thickness change [Z ~> m]. logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. ! Local variables - real :: rho_anom ! The density anomaly from rho_ref, in kg m-3. - real :: raL, raR ! rho_anom to the left and right, in kg m-3. + real :: rho_anom ! The density anomaly from rho_ref [kg m-3]. + real :: raL, raR ! rho_anom to the left and right [kg m-3]. real :: dz, dzL, dzR ! Layer thicknesses [Z ~> m]. real :: hWght ! A pressure-thickness below topography [Z ~> m]. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Z ~> m]. real :: iDenom ! The inverse of the denominator in the weights [Z-2 ~> m-2]. - real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. - real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. - real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. + real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim]. + real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim]. + real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim]. + real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns [nondim]. real :: intz(5) ! The integrals of density with height at the - ! 5 sub-column locations, in Pa. + ! 5 sub-column locations [Pa]. logical :: do_massWeight ! Indicates whether to do mass weighting. real, parameter :: C1_6 = 1.0/6.0, C1_90 = 1.0/90.0 ! Rational constants. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j, ioff, joff, m @@ -508,14 +508,14 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, & !! to reduce the magnitude of each of the integrals, m3 kg-1. The calculation is !! mathematically identical with different values of alpha_ref, but this reduces the !! effects of roundoff. - real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. + real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. real, intent(in) :: dRho_dT !< The derivative of density with temperature, !! in kg m-3 C-1. real, intent(in) :: dRho_dS !< The derivative of density with salinity, !! in kg m-3 psu-1. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(out) :: dza !< The change in the geopotential anomaly across - !! the layer, in m2 s-2. + !! the layer [m2 s-2]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & optional, intent(out) :: intp_dza !< The integral in pressure through the layer of !! the geopotential anomaly relative to the anomaly @@ -538,19 +538,19 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, & logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting !! to interpolate T/S for top and bottom integrals. ! Local variables - real :: dRho_TS ! The density anomaly due to T and S, in kg m-3. + real :: dRho_TS ! The density anomaly due to T and S [kg m-3]. real :: alpha_anom ! The specific volume anomaly from 1/rho_ref, in m3 kg-1. - real :: aaL, aaR ! rho_anom to the left and right, in kg m-3. + real :: aaL, aaR ! rho_anom to the left and right [kg m-3]. real :: dp, dpL, dpR ! Layer pressure thicknesses in Pa. - real :: hWght ! A pressure-thickness below topography, in Pa. - real :: hL, hR ! Pressure-thicknesses of the columns to the left and right, in Pa. + real :: hWght ! A pressure-thickness below topography [Pa]. + real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Pa]. real :: iDenom ! The inverse of the denominator in the weights, in Pa-2. - real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column, nonDim. - real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column, nonDim. - real :: wt_L, wt_R ! The linear weights of the left and right columns, nonDim. - real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns, nonDim. + real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim]. + real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim]. + real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim]. + real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns [nondim]. real :: intp(5) ! The integrals of specific volume with pressure at the - ! 5 sub-column locations, in m2 s-2. + ! 5 sub-column locations [m2 s-2]. logical :: do_massWeight ! Indicates whether to do mass weighting. real, parameter :: C1_6 = 1.0/6.0, C1_90 = 1.0/90.0 ! Rational constants. integer :: Isq, Ieq, Jsq, Jeq, ish, ieh, jsh, jeh, i, j, m, halo diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 9ddb0c92bb..73058efc6d 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -90,16 +90,16 @@ module MOM_ice_shelf real :: ustar_bg !< A minimum value for ustar under ice shelves [Z s-1 ~> m s-1]. real :: cdrag !< drag coefficient under ice shelves , non-dimensional. - real :: g_Earth !< The gravitational acceleration in m s-2. + real :: g_Earth !< The gravitational acceleration [m s-2] real :: Cp !< The heat capacity of sea water, in J kg-1 K-1. real :: Rho0 !< A reference ocean density in kg/m3. real :: Cp_ice !< The heat capacity of fresh ice, in J kg-1 K-1. real :: gamma_t !< The (fixed) turbulent exchange velocity in the !< 2-equation formulation, in m s-1. - real :: Salin_ice !< The salinity of shelf ice, in PSU. + real :: Salin_ice !< The salinity of shelf ice [PSU]. real :: Temp_ice !< The core temperature of shelf ice, in C. real :: kv_ice !< The viscosity of ice, in m2 s-1. - real :: density_ice !< A typical density of ice, in kg m-3. + real :: density_ice !< A typical density of ice [kg m-3]. real :: rho_ice !< Nominal ice density in kg m-2 Z-1 real :: kv_molec !< The molecular kinematic viscosity of sea water, m2 s-1. real :: kd_molec_salt!< The molecular diffusivity of salt, in m2 s-1. @@ -196,7 +196,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) !! thermodynamic or mass-flux forcing fields. type(time_type), intent(in) :: Time !< Start time of the fluxes. real, intent(in) :: time_step !< Length of time over which - !! these fluxes will be applied, in s. + !! these fluxes will be applied [s]. type(ice_shelf_CS), pointer :: CS !< A pointer to the control structure !! returned by a previous call to !! initialize_ice_shelf. @@ -211,10 +211,10 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) real, dimension(SZI_(CS%grid)) :: & Rhoml, & !< Ocean mixed layer density in kg m-3. dR0_dT, & !< Partial derivative of the mixed layer density - !< with temperature, in units of kg m-3 K-1. + !< with temperature [kg m-3 degC-1]. dR0_dS, & !< Partial derivative of the mixed layer density - !< with salinity, in units of kg m-3 psu-1. - p_int !< The pressure at the ice-ocean interface, in Pa. + !< with salinity [kg m-3 PSU-1]. + p_int !< The pressure at the ice-ocean interface [Pa]. real, dimension(SZI_(CS%grid),SZJ_(CS%grid)) :: & exch_vel_t, & !< Sub-shelf thermal exchange velocity, in m/s @@ -233,17 +233,17 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) real :: I_ZETA_N !< The inverse of ZETA_N. real :: LF, I_LF !< Latent Heat of fusion (J kg-1) and its inverse. real :: I_VK !< The inverse of VK. - real :: PR, SC !< The Prandtl number and Schmidt number, nondim. + real :: PR, SC !< The Prandtl number and Schmidt number [nondim]. ! 3 equations formulation variables real, dimension(SZDI_(CS%grid),SZDJ_(CS%grid)) :: & - Sbdry !< Salinities in the ocean at the interface with the ice shelf, in PSU. + Sbdry !< Salinities in the ocean at the interface with the ice shelf [PSU]. real :: Sbdry_it real :: Sbdry1, Sbdry2, S_a, S_b, S_c ! use to find salt roots - real :: dS_it !< The interface salinity change during an iteration, in PSU. + real :: dS_it !< The interface salinity change during an iteration [PSU]. real :: hBL_neut !< The neutral boundary layer thickness, in m. real :: hBL_neut_h_molec !< The ratio of the neutral boundary layer thickness - !! to the molecular boundary layer thickness, ND. + !! to the molecular boundary layer thickness [nondim]. real :: wT_flux !< The vertical fluxes of heat and buoyancy just inside the real :: wB_flux !< ocean, in C m s-1 and m2 s-3, ###CURRENTLY POSITIVE UPWARD. real :: dB_dS !< The derivative of buoyancy with salinity, in m s-2 PSU-1. @@ -700,7 +700,7 @@ subroutine change_thickness_using_melt(ISS, G, time_step, fluxes, rho_ice, debug type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe !! the ice-shelf state - real, intent(in) :: time_step !< The time step for this update, in s. + real, intent(in) :: time_step !< The time step for this update [s]. type(forcing), intent(inout) :: fluxes !< structure containing pointers to any possible !! thermodynamic or mass-flux forcing fields. real, intent(in) :: rho_ice !< The density of ice-shelf ice, in kg m-2 Z-1. @@ -865,11 +865,11 @@ subroutine add_shelf_flux(G, CS, state, fluxes) ! local variables real :: Irho0 !< The inverse of the mean density in m3 kg-1. - real :: frac_area !< The fractional area covered by the ice shelf, nondim. + real :: frac_area !< The fractional area covered by the ice shelf [nondim]. real :: shelf_mass0 !< Total ice shelf mass at previous time (Time-dt). real :: shelf_mass1 !< Total ice shelf mass at current time (Time). real :: delta_mass_shelf!< Change in ice shelf mass over one time step in kg/s - real :: taux2, tauy2 !< The squared surface stresses, in Pa. + real :: taux2, tauy2 !< The squared surface stresses [Pa]. real :: press_ice !< The pressure of the ice shelf per unit area of ocean (not ice) in Pa. real :: asu1, asu2 !< Ocean areas covered by ice shelves at neighboring u- real :: asv1, asv2 !< and v-points, in m2. @@ -1744,7 +1744,7 @@ end subroutine ice_shelf_end !> This routine is for stepping a stand-alone ice shelf model without an ocean. subroutine solo_time_step(CS, time_step, nsteps, Time, min_time_step_in) type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure - real, intent(in) :: time_step !< The time interval for this update, in s. + real, intent(in) :: time_step !< The time interval for this update [s]. integer, intent(inout) :: nsteps !< The running number of ice shelf steps. type(time_type), intent(inout) :: Time !< The current model time real, optional, intent(in) :: min_time_step_in !< The minimum permitted time step in s. diff --git a/src/ice_shelf/user_shelf_init.F90 b/src/ice_shelf/user_shelf_init.F90 index 0953c6fcc0..b541e2ec26 100644 --- a/src/ice_shelf/user_shelf_init.F90 +++ b/src/ice_shelf/user_shelf_init.F90 @@ -69,7 +69,7 @@ subroutine USER_initialize_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, ! This subroutine sets up the initial mass and area covered by the ice shelf. - real :: Rho_ocean ! The ocean's typical density, in kg m-3. + real :: Rho_ocean ! The ocean's typical density [kg m-3]. real :: max_draft ! The maximum ocean draft of the ice shelf, in m. real :: min_draft ! The minimum ocean draft of the ice shelf, in m. real :: flat_shelf_width ! The range over which the shelf is min_draft thick. diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 63774b98f8..761da880b4 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -146,7 +146,7 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) endif ! Calculate the value of the Coriolis parameter at the latitude ! -! of the q grid points, in s-1. +! of the q grid points [s-1]. call MOM_initialize_rotation(G%CoriolisBu, G, PF) ! Calculate the components of grad f (beta) call MOM_calculate_grad_Coriolis(G%dF_dx, G%dF_dy, G) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 39814f122c..03de3d5402 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -154,7 +154,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & character(len=200) :: config real :: H_rescale ! A rescaling factor for thicknesses from the representation in ! a restart file to the internal representation in this run. - real :: dt ! The baroclinic dynamics timestep for this run, in s. + real :: dt ! The baroclinic dynamics timestep for this run [s]. logical :: from_Z_file, useALE logical :: new_sim integer :: write_geom @@ -923,7 +923,7 @@ subroutine convert_thickness(h, G, GV, US, tv) real, dimension(SZI_(G),SZJ_(G)) :: & p_top, p_bot real :: dz_geo(SZI_(G),SZJ_(G)) ! The change in geopotential height - ! across a layer, in m2 s-2. + ! across a layer [m2 s-2]. real :: rho(SZI_(G)) real :: I_gEarth real :: Hm_rho_to_Pa ! A conversion factor from the input geometric thicknesses @@ -1003,7 +1003,7 @@ subroutine depress_surface(h, G, GV, US, param_file, tv, just_read_params) eta_sfc ! The free surface height that the model should use, in m. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & eta ! The free surface height that the model should use, in m. - real :: dilate ! A ratio by which layers are dilated, nondim. + real :: dilate ! A ratio by which layers are dilated [nondim]. real :: scale_factor ! A scaling factor for the eta_sfc values that are read ! in, which can be used to change units, for example. character(len=40) :: mdl = "depress_surface" ! This subroutine's name. @@ -1085,7 +1085,7 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params) !! only read parameters without changing h. ! Local variables character(len=200) :: mdl = "trim_for_ice" - real, dimension(SZI_(G),SZJ_(G)) :: p_surf ! Imposed pressure on ocean at surface (Pa) + real, dimension(SZI_(G),SZJ_(G)) :: p_surf ! Imposed pressure on ocean at surface [Pa] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: S_t, S_b ! Top and bottom edge values for reconstructions real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_t, T_b ! of salinity and temperature within each layer. character(len=200) :: inputdir, filename, p_surf_file, p_surf_var ! Strings for file/path @@ -1155,16 +1155,16 @@ subroutine cut_off_column_top(nk, tv, GV, G_earth, depth, min_thickness, & integer, intent(in) :: nk !< Number of layers type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, intent(in) :: G_earth !< Gravitational acceleration (m2 Z-1 s-2) + real, intent(in) :: G_earth !< Gravitational acceleration [m2 Z-1 s-2 ~> m s-2] real, intent(in) :: depth !< Depth of ocean column [Z ~> m]. real, intent(in) :: min_thickness !< Smallest thickness allowed [Z ~> m]. - real, dimension(nk), intent(inout) :: T !< Layer mean temperature - real, dimension(nk), intent(in) :: T_t !< Temperature at top of layer - real, dimension(nk), intent(in) :: T_b !< Temperature at bottom of layer - real, dimension(nk), intent(inout) :: S !< Layer mean salinity - real, dimension(nk), intent(in) :: S_t !< Salinity at top of layer - real, dimension(nk), intent(in) :: S_b !< Salinity at bottom of layer - real, intent(in) :: p_surf !< Imposed pressure on ocean at surface (Pa) + real, dimension(nk), intent(inout) :: T !< Layer mean temperature [degC] + real, dimension(nk), intent(in) :: T_t !< Temperature at top of layer [degC] + real, dimension(nk), intent(in) :: T_b !< Temperature at bottom of layer [degC] + real, dimension(nk), intent(inout) :: S !< Layer mean salinity [ppt] + real, dimension(nk), intent(in) :: S_t !< Salinity at top of layer [ppt] + real, dimension(nk), intent(in) :: S_b !< Salinity at bottom of layer [ppt] + real, intent(in) :: p_surf !< Imposed pressure on ocean at surface [Pa] real, dimension(nk), intent(inout) :: h !< Layer thickness (H units, m or Pa) type(remapping_CS), pointer :: remap_CS !< Remapping structure for remapping T and S, !! if associated @@ -1686,8 +1686,8 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, param_file, C real, dimension (SZI_(G),SZJ_(G)) :: & tmp_2d ! A temporary array for tracers. - real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. - real :: pres(SZI_(G)) ! An array of the reference pressure, in Pa. + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate [s-1]. + real :: pres(SZI_(G)) ! An array of the reference pressure [Pa]. integer :: i, j, k, is, ie, js, je, nz integer :: isd, ied, jsd, jed diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index 6ee37ad1ec..70c83f9206 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -39,7 +39,7 @@ module MIDAS_vertmap !! Ocean. Tech., 14, 735-740. function wright_eos_2d(T,S,p) result(rho) real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and Salinity (psu) - real, intent(in) :: p !< pressure (Pa) + real, intent(in) :: p !< pressure [Pa] real(kind=8), dimension(size(T,1),size(T,2)) :: rho !< potential density (kg m-3) ! Local variables real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5 @@ -75,7 +75,7 @@ end function wright_eos_2d !! Ocean. Tech., 14, 735-740. function alpha_wright_eos_2d(T,S,p) result(drho_dT) real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and Salinity (psu) - real, intent(in) :: p !< pressure (Pa) + real, intent(in) :: p !< pressure [Pa] real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dT !< partial derivative of density with !! respect to temperature (kg m-3 C-1) ! Local variables @@ -115,9 +115,9 @@ end function alpha_wright_eos_2d !! Ocean. Tech., 14, 735-740. function beta_wright_eos_2d(T,S,p) result(drho_dS) real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and salinity (psu) - real, intent(in) :: p !< pressure (Pa) + real, intent(in) :: p !< pressure [Pa] real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dS !< partial derivative of density with - !! respect to salinity (kg m-3 PSU-1) + !! respect to salinity [kg m-3 PSU-1] ! Local variables real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5 real(kind=8) :: al0,lam,p0,I_denom,I_denom2 @@ -151,10 +151,11 @@ end function beta_wright_eos_2d function tracer_z_init(tr_in, z_edges, e, nkml, nkbl, land_fill, wet, nlay, nlevs, & debug, i_debug, j_debug, eps_z) result(tr) real, dimension(:,:,:), intent(in) :: tr_in !< The z-space array of tracer concentrations that is read in. - real, dimension(size(tr_in,3)+1), intent(in) :: z_edges !< The depths of the cell edges in the input z* data (Z or m) + real, dimension(size(tr_in,3)+1), intent(in) :: z_edges !< The depths of the cell edges in the input z* data + !! [Z ~> m or m] integer, intent(in) :: nlay !< The number of vertical layers in the target grid real, dimension(size(tr_in,1),size(tr_in,2),nlay+1), & - intent(in) :: e !< The depths of the target layer interfaces (Z or m) + intent(in) :: e !< The depths of the target layer interfaces [Z ~> m or m] integer, intent(in) :: nkml !< The number of mixed layers integer, intent(in) :: nkbl !< The number of buffer layers real, intent(in) :: land_fill !< fill in data over land (1) @@ -165,7 +166,7 @@ function tracer_z_init(tr_in, z_edges, e, nkml, nkbl, land_fill, wet, nlay, nlev logical, optional, intent(in) :: debug !< optional debug flag integer, optional, intent(in) :: i_debug !< i-index of point for debugging integer, optional, intent(in) :: j_debug !< j-index of point for debugging - real, optional, intent(in) :: eps_z !< A negligibly small layer thickness in the units of Z. + real, optional, intent(in) :: eps_z !< A negligibly small layer thickness [Z ~> m or m]. real, dimension(size(tr_in,1),size(tr_in,2),nlay) :: tr !< tracers in layer space ! Local variables @@ -180,7 +181,7 @@ function tracer_z_init(tr_in, z_edges, e, nkml, nkbl, land_fill, wet, nlay, nlev real, dimension(size(tr_in,3)) :: wt !< The fractional weight for each layer in the range between z1 and z2 real, dimension(size(tr_in,3)) :: z1, z2 ! z1 and z2 are the fractional depths of the top and bottom ! limits of the part of a z-cell that contributes to a layer, relative - ! to the cell center and normalized by the cell thickness, nondim. + ! to the cell center and normalized by the cell thickness [nondim]. ! Note that -1/2 <= z1 <= z2 <= 1/2. logical :: debug_msg, debug_, debug_pt @@ -347,8 +348,8 @@ end function bisect_fast subroutine determine_temperature(temp, salt, R, p_ref, niter, land_fill, h, k_start) real(kind=8), dimension(:,:,:), intent(inout) :: temp !< potential temperature (degC) real(kind=8), dimension(:,:,:), intent(inout) :: salt !< salinity (PSU) - real(kind=8), dimension(size(temp,3)), intent(in) :: R !< desired potential density, in kg m-3. - real, intent(in) :: p_ref !< reference pressure, in Pa. + real(kind=8), dimension(size(temp,3)), intent(in) :: R !< desired potential density [kg m-3]. + real, intent(in) :: p_ref !< reference pressure [Pa]. integer, intent(in) :: niter !< maximum number of iterations integer, intent(in) :: k_start !< starting index (i.e. below the buffer layer) real, intent(in) :: land_fill !< land fill value @@ -362,8 +363,8 @@ subroutine determine_temperature(temp, salt, R, p_ref, niter, land_fill, h, k_st subroutine determine_temperature(temp, salt, R, p_ref, niter, land_fill, h, k_start, eos) real, dimension(:,:,:), intent(inout) :: temp !< potential temperature (degC) real, dimension(:,:,:), intent(inout) :: salt !< salinity (PSU) - real, dimension(size(temp,3)), intent(in) :: R !< desired potential density, in kg m-3. - real, intent(in) :: p_ref !< reference pressure, in Pa. + real, dimension(size(temp,3)), intent(in) :: R !< desired potential density [kg m-3]. + real, intent(in) :: p_ref !< reference pressure [Pa]. integer, intent(in) :: niter !< maximum number of iterations integer, intent(in) :: k_start !< starting index (i.e. below the buffer layer) real, intent(in) :: land_fill !< land fill value @@ -471,9 +472,9 @@ subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z integer, intent(in) :: k_start !< The layer at which to start searching. integer, intent(out) :: k_top !< The index of the top layer that overlap with the depth range. integer, intent(out) :: k_bot !< The index of the bottom layer that overlap with the depth range. - real, dimension(:), intent(out) :: wt !< The relative weights of each layer from k_top to k_bot, nondim. - real, dimension(:), intent(out) :: z1 !< Depth of the top limit of layer that contributes to a level, nondim. - real, dimension(:), intent(out) :: z2 !< Depth of the bottom limit of layer that contributes to a level, nondim. + real, dimension(:), intent(out) :: wt !< The relative weights of each layer from k_top to k_bot [nondim]. + real, dimension(:), intent(out) :: z1 !< Depth of the top limit of layer that contributes to a level [nondim]. + real, dimension(:), intent(out) :: z2 !< Depth of the bottom limit of layer that contributes to a level [nondim]. ! Local variables real :: Ih, e_c, tot_wt, I_totwt @@ -560,10 +561,10 @@ end function find_limited_slope !> Find interface positions corresponding to density profile function find_interfaces(rho, zin, Rb, depth, nlevs, nkml, nkbl, hml, debug, eps_z) result(zi) real, dimension(:,:,:), & - intent(in) :: rho !< potential density in z-space (kg m-3) + intent(in) :: rho !< potential density in z-space [kg m-3] real, dimension(size(rho,3)), & - intent(in) :: zin !< Input data levels, in Z (often m). - real, dimension(:), intent(in) :: Rb !< target interface densities (kg m-3) + intent(in) :: zin !< Input data levels [Z ~> m or m]. + real, dimension(:), intent(in) :: Rb !< target interface densities [kg m-3] real, dimension(size(rho,1),size(rho,2)), & intent(in) :: depth !< ocean depth [Z ~> m]. real, dimension(size(rho,1),size(rho,2)), & @@ -572,7 +573,7 @@ function find_interfaces(rho, zin, Rb, depth, nlevs, nkml, nkbl, hml, debug, eps integer, optional, intent(in) :: nkml !< number of mixed layer pieces integer, optional, intent(in) :: nkbl !< number of buffer layer pieces real, optional, intent(in) :: hml !< mixed layer depth [Z ~> m]. - real, optional, intent(in) :: eps_z !< A negligibly small layer thickness in the units of Z. + real, optional, intent(in) :: eps_z !< A negligibly small layer thickness [Z ~> m or m]. real, dimension(size(rho,1),size(rho,2),size(Rb,1)) :: zi !< The returned interface, in the same units az zin. ! Local variables @@ -589,7 +590,7 @@ function find_interfaces(rho, zin, Rb, depth, nlevs, nkml, nkbl, hml, debug, eps integer :: nlay,kk,nkml_,nkbl_ logical :: debug_ = .false. real :: epsln_Z ! A negligibly thin layer thickness [Z ~> m]. - real :: epsln_rho ! A negligibly small density change, in kg m-3. + real :: epsln_rho ! A negligibly small density change [kg m-3]. real, parameter :: zoff=0.999 nlay=size(Rb)-1 diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 936e76237a..4e0174adff 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -112,11 +112,11 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h mass, & ! The total mass of the water column, in kg m-2. I_mass, & ! The inverse of mass, in m2 kg-1. src, & ! The sum of all MEKE sources, in m2 s-3. - MEKE_decay, & ! The MEKE decay timescale, in s-1. + MEKE_decay, & ! The MEKE decay timescale [s-1]. MEKE_GM_src, & ! The MEKE source from thickness mixing, in m2 s-3. MEKE_mom_src, & ! The MEKE source from momentum, in m2 s-3. drag_rate_visc, & - drag_rate, & ! The MEKE spindown timescale due to bottom drag, in s-1. + drag_rate, & ! The MEKE spindown timescale due to bottom drag [s-1]. LmixScale, & ! Square of eddy mixing length, in m2. barotrFac2, & ! Ratio of EKE_barotropic / EKE (nondim)/ bottomFac2 ! Ratio of EKE_bottom / EKE (nondim)/ @@ -137,7 +137,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h real :: advFac real :: mass_neglect ! A negligible mass, in kg m-2. real :: ldamping ! The MEKE damping rate in s-1. - real :: Rho0 ! A density used to convert mass to distance, in kg m-3. + real :: Rho0 ! A density used to convert mass to distance [kg m-3]. real :: sdt ! dt to use locally (could be scaled to accelerate) real :: sdt_damp ! dt for damping (sdt could be split). logical :: use_drag_rate ! Flag to indicate drag_rate is finite diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index fc2430b4e5..bffe03cd3d 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -106,7 +106,7 @@ module MOM_internal_tides !< The internal wave energy density as a function of (i,j,angle,frequency,mode) real, dimension(:,:,:), pointer :: En_restart => NULL() !< The internal wave energy density as a function of (i,j,angle); temporary for restart - real, allocatable, dimension(:) :: frequency !< The frequency of each band, in s-1. + real, allocatable, dimension(:) :: frequency !< The frequency of each band [s-1]. !### Delete later real :: int_tide_source_x !< X Location of generation site for internal tide testing @@ -164,9 +164,9 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & !! internal waves, in W m-2. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: vel_btTide !< Barotropic velocity read !! from file, in m s-1. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Nb !< Near-bottom buoyancy frequency, in s-1. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Nb !< Near-bottom buoyancy frequency [s-1]. real, intent(in) :: dt !< Length of time over which these fluxes - !! will be applied, in s. + !! will be applied [s]. type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. real, dimension(SZI_(G),SZJ_(G),CS%nMode), & @@ -627,7 +627,7 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: Nb !< Near-bottom stratification, in s-1. + intent(in) :: Nb !< Near-bottom stratification [s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%nFreq,CS%nMode), & intent(inout) :: Ub !< Rms (over one period) near-bottom horizontal !! mode velocity, in m s-1. @@ -639,7 +639,7 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle,CS%nFreq,CS%nMode), & intent(out) :: TKE_loss !< Energy loss rate, in W m-2 !! (q*rho*kappa*h^2*N*U^2). - real, intent(in) :: dt !< Time increment, in s. + real, intent(in) :: dt !< Time increment [s]. logical,optional, intent(in) :: full_halos !< If true, do the calculation over the !! entirecomputational domain. ! Local variables @@ -740,8 +740,8 @@ subroutine refract(En, cn, freq, dt, G, NAngle, use_PPMang) !! in J m-2 radian-1. real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(in) :: cn !< Baroclinic mode speed, in m s-1. - real, intent(in) :: freq !< Wave frequency, in s-1. - real, intent(in) :: dt !< Time step, in s. + real, intent(in) :: freq !< Wave frequency [s-1]. + real, intent(in) :: dt !< Time step [s]. logical, intent(in) :: use_PPMang !< If true, use PPM for advection rather !! than upwind. ! Local variables @@ -756,8 +756,8 @@ subroutine refract(En, cn, freq, dt, G, NAngle, use_PPMang) Flux_E real, dimension(SZI_(G),SZJ_(G),1-stencil:NAngle+stencil) :: & CFL_ang - real :: f2 ! The squared Coriolis parameter, in s-2. - real :: favg ! The average Coriolis parameter at a point, in s-1. + real :: f2 ! The squared Coriolis parameter [s-2]. + real :: favg ! The average Coriolis parameter at a point [s-1]. real :: df2_dy, df2_dx ! The x- and y- gradients of the squared Coriolis parameter, in s-2 m-1. real :: df_dy, df_dx ! The x- and y- gradients of the Coriolis parameter, in s-1 m-1. real :: dlnCn_dx ! The x-gradient of the wave speed divided by itself in m-1. @@ -960,8 +960,8 @@ subroutine propagate(En, cn, freq, dt, G, CS, NAngle) !! in J m-2 radian-1. real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(in) :: cn !< Baroclinic mode speed, in m s-1. - real, intent(in) :: freq !< Wave frequency, in s-1. - real, intent(in) :: dt !< Time step, in s. + real, intent(in) :: freq !< Wave frequency [s-1]. + real, intent(in) :: dt !< Time step [s]. type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. ! Local variables @@ -976,7 +976,7 @@ subroutine propagate(En, cn, freq, dt, G, CS, NAngle) cos_angle, sin_angle real, dimension(NAngle) :: & Cgx_av, Cgy_av, dCgx, dCgy - real :: f2 ! The squared Coriolis parameter, in s-2. + real :: f2 ! The squared Coriolis parameter [s-2]. real :: Angle_size, I_Angle_size, angle real :: Ifreq, freq2 real, parameter :: cn_subRO = 1e-100 @@ -1528,7 +1528,7 @@ subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, j, ish, ieh, vol_CFL) logical, intent(in) :: vol_CFL !< If true, rescale the ratio of face areas to !! the cell areas when estimating the CFL number. ! Local variables - real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. + real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim]. real :: curv_3 ! A measure of the thickness curvature over a grid length, ! with the same units as h_in. integer :: i @@ -1573,7 +1573,7 @@ subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, J, ish, ieh, vol_CFL) !! areas to the cell areas when estimating !! the CFL number. ! Local variables - real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. + real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim]. real :: curv_3 ! A measure of the thickness curvature over a grid length, ! with the same units as h_in. integer :: i diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 59972f95fe..d55b73d858 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -443,9 +443,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV h_avail, & ! The mass available for diffusion out of each face, divided ! by dt [H m2 s-1 ~> m3 s-1 or kg s-1]. h_frac ! The fraction of the mass in the column above the bottom - ! interface of a layer that is within a layer, ND. 0 m3 s-1 or kg s-1]. real, dimension(SZIB_(G)) :: & drho_dT_u, & ! The derivatives of density with temperature and @@ -467,8 +467,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: I4dt ! 1 / 4 dt in s-1. real :: drdiA, drdiB ! Along layer zonal- and meridional- potential density real :: drdjA, drdjB ! gradients in the layers above (A) and below(B) the - ! interface times the grid spacing, in kg m-3. - real :: drdkL, drdkR ! Vertical density differences across an interface, in kg m-3. + ! interface times the grid spacing [kg m-3]. + real :: drdkL, drdkR ! Vertical density differences across an interface [kg m-3]. real :: drdi_u(SZIB_(G), SZK_(G)+1) ! Copy of drdi at u-points in kg m-3. real :: drdj_v(SZI_(G), SZK_(G)+1) ! Copy of drdj at v-points in kg m-3. real :: drdkDe_u(SZIB_(G),SZK_(G)+1) ! Lateral difference of product of drdk and e at u-points @@ -1237,7 +1237,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! between the arithmetic and harmonic mean thicknesses ! normalized by the arithmetic mean thickness. real :: Kh_scale ! A ratio by which Kh_u_CFL is scaled for maximally jagged - ! layers, nondim. + ! layers [nondim]. real :: Kh_det ! The detangling diffusivity, in m2 s-1. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -1245,19 +1245,19 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV real :: I_sl ! The absolute value of the larger in magnitude of the slopes ! above and below. real :: Rsl ! The ratio of the smaller magnitude slope to the larger - ! magnitude one, ND. 0 <= Rsl <1. - real :: IRsl ! The (limited) inverse of Rsl, ND. 1 < IRsl <= 1e9. + ! magnitude one [nondim]. 0 <= Rsl <1. + real :: IRsl ! The (limited) inverse of Rsl [nondim]. 1 < IRsl <= 1e9. real :: dH ! The thickness gradient divided by the damping timescale ! and the ratio of the face length to the adjacent cell ! areas for comparability with the diffusivities, in m2 s-1. real :: adH ! The absolute value of dH, in m2 s-1. real :: sign ! 1 or -1, with the same sign as the layer thickness gradient. - real :: sl_K ! The sign-corrected slope of the interface above, ND. - real :: sl_Kp1 ! The sign-corrected slope of the interface below, ND. - real :: I_sl_K ! The (limited) inverse of sl_K, ND. - real :: I_sl_Kp1 ! The (limited) inverse of sl_Kp1, ND. + real :: sl_K ! The sign-corrected slope of the interface above [nondim]. + real :: sl_Kp1 ! The sign-corrected slope of the interface below [nondim]. + real :: I_sl_K ! The (limited) inverse of sl_K [nondim]. + real :: I_sl_Kp1 ! The (limited) inverse of sl_Kp1 [nondim]. real :: I_4t ! A quarter of a unit conversion factor divided by - ! the damping timescale, in s-1. + ! the damping timescale [s-1]. real :: Fn_R ! A function of Rsl, such that Rsl < Fn_R < 1. real :: denom, I_denom ! A denominator and its inverse, various units. real :: Kh_min ! A local floor on the diffusivity, in m2 s-1. @@ -1283,13 +1283,13 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Kh(I,K) >= Kh_min_p(I,K)*Kh(I,K+1) + Kh0_min_p(I,K) ! Kh(I,K) <= Kh_max_m(I,K)*Kh(I,K-1) + Kh0_max_m(I,K) ! Kh(I,K) <= Kh_max_p(I,K)*Kh(I,K+1) + Kh0_max_p(I,K) - Kh_min_m , & ! See above, ND. + Kh_min_m , & ! See above [nondim]. Kh0_min_m , & ! See above, in m2 s-1. - Kh_max_m , & ! See above, ND. + Kh_max_m , & ! See above [nondim]. Kh0_max_m, & ! See above, in m2 s-1. - Kh_min_p , & ! See above, ND. + Kh_min_p , & ! See above [nondim]. Kh0_min_p , & ! See above, in m2 s-1. - Kh_max_p , & ! See above, ND. + Kh_max_p , & ! See above [nondim]. Kh0_max_p ! See above, in m2 s-1. real, dimension(SZIB_(G)) :: & Kh_max_max ! The maximum diffusivity permitted in a column. diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index a552bfe1ca..b71ad46fc7 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -36,10 +36,10 @@ module MOM_tidal_forcing !! and bottom geopotential anomalies. integer :: nc !< The number of tidal constituents in use. real, dimension(MAX_CONSTITUENTS) :: & - freq, & !< The frequency of a tidal constituent, in s-1. + freq, & !< The frequency of a tidal constituent [s-1]. phase0, & !< The phase of a tidal constituent at time 0, in radians. amp, & !< The amplitude of a tidal constituent at time 0, in m. - love_no !< The Love number of a tidal constituent at time 0, ND. + love_no !< The Love number of a tidal constituent at time 0 [nondim]. integer :: struct(MAX_CONSTITUENTS) !< An encoded spatial structure for each constituent character (len=16) :: const_name(MAX_CONSTITUENTS) !< The name of each constituent @@ -379,7 +379,7 @@ subroutine tidal_forcing_sensitivity(G, CS, deta_tidal_deta) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(tidal_forcing_CS), pointer :: CS !< The control structure returned by a previous call to tidal_forcing_init. real, intent(out) :: deta_tidal_deta !< The partial derivative of eta_tidal with - !! the local value of eta, nondim. + !! the local value of eta [nondim]. if (CS%USE_SAL_SCALAR .and. CS%USE_PREV_TIDES) then deta_tidal_deta = 2.0*CS%SAL_SCALAR @@ -407,7 +407,7 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta, m_to !! previous call to tidal_forcing_init. real, optional, intent(out) :: deta_tidal_deta !< The partial derivative of !! eta_tidal with the local value of - !! eta, nondim. + !! eta [nondim]. real, optional, intent(in) :: m_to_Z !< A scaling factor from m to the units of eta. ! Local variables diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 4f223cb35a..07f4958e16 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -36,25 +36,25 @@ module MOM_bulk_mixed_layer real :: mstar !< The ratio of the friction velocity cubed to the !! TKE input to the mixed layer, nondimensional. real :: nstar !< The fraction of the TKE input to the mixed layer - !! available to drive entrainment, nondim. + !! available to drive entrainment [nondim]. real :: nstar2 !< The fraction of potential energy released by - !! convective adjustment that drives entrainment, ND. + !! convective adjustment that drives entrainment [nondim]. logical :: absorb_all_SW !< If true, all shortwave radiation is absorbed by the !! ocean, instead of passing through to the bottom mud. real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE !! decay scale, nondimensional. real :: bulk_Ri_ML !< The efficiency with which mean kinetic energy !! released by mechanically forced entrainment of - !! the mixed layer is converted to TKE, nondim. + !! the mixed layer is converted to TKE [nondim]. real :: bulk_Ri_convective !< The efficiency with which convectively - !! released mean kinetic energy becomes TKE, nondim. + !! released mean kinetic energy becomes TKE [nondim]. real :: Hmix_min !< The minimum mixed layer thickness [H ~> m or kg m-2]. real :: H_limit_fluxes !< When the total ocean depth is less than this !! value [H ~> m or kg m-2], scale away all surface forcing to !! avoid boiling the ocean. real :: ustar_min !< A minimum value of ustar to avoid numerical problems [Z s-1 ~> m s-1]. !! If the value is small enough, this should not affect the solution. - real :: omega !< The Earth's rotation rate, in s-1. + real :: omega !< The Earth's rotation rate [s-1]. real :: dT_dS_wt !< When forced to extrapolate T & S to match the !! layer densities, this factor (in deg C / PSU) is !! combined with the derivatives of density with T & S @@ -92,7 +92,7 @@ module MOM_bulk_mixed_layer !! detrainment to be consistent with neighbors. real :: lim_det_dH_sfc !< The fractional limit in the change between grid !! points of the surface region (mixed & buffer - !! layer) thickness, nondim. 0.5 by default. + !! layer) thickness [nondim]. 0.5 by default. real :: lim_det_dH_bathy !< The fraction of the total depth by which the !! thickness of the surface region (mixed & buffer !! layer) is allowed to change between grid points. @@ -192,7 +192,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields !! have NULL ptrs. - real, intent(in) :: dt !< Time increment, in s. + real, intent(in) :: dt !< Time increment [s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: ea !< The amount of fluid moved downward into a !! layer; this should be increased due to @@ -213,7 +213,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C !! being applied separately. real, optional, intent(in) :: dt_diag !< The diagnostic time step, !! which may be less than dt if there are - !! two callse to mixedlayer, in s. + !! two callse to mixedlayer [s]. logical, optional, intent(in) :: last_call !< if true, this is the last call !! to mixedlayer in the current time step, so !! diagnostics will be written. The default is @@ -231,10 +231,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! will be used to hold the new mixed layer properties. real, dimension(SZI_(G),SZK0_(GV)) :: & h, & ! The layer thickness [H ~> m or kg m-2]. - T, & ! The layer temperatures, in deg C. - S, & ! The layer salinities, in psu. - R0, & ! The potential density referenced to the surface, in kg m-3. - Rcv ! The coordinate variable potential density, in kg m-3. + T, & ! The layer temperatures [degC]. + S, & ! The layer salinities [PSU]. + R0, & ! The potential density referenced to the surface [kg m-3]. + Rcv ! The coordinate variable potential density [kg m-3]. real, dimension(SZI_(G),SZK_(GV)) :: & u, & ! The zonal velocity, in m s-1. v, & ! The meridional velocity, in m s-1. @@ -280,13 +280,13 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C p_ref, & ! Reference pressure for the potential density governing mixed ! layer dynamics, almost always 0 (or 1e5) Pa. p_ref_cv, & ! Reference pressure for the potential density which defines - ! the coordinate variable, set to P_Ref, in Pa. + ! the coordinate variable, set to P_Ref [Pa]. dR0_dT, & ! Partial derivative of the mixed layer potential density with - ! temperature, in units of kg m-3 K-1. + ! temperature [kg m-3 degC-1]. dRcv_dT, & ! Partial derivative of the coordinate variable potential ! density in the mixed layer with temperature, in kg m-3 K-1. dR0_dS, & ! Partial derivative of the mixed layer potential density with - ! salinity, in units of kg m-3 psu-1. + ! salinity [kg m-3 PSU-1]. dRcv_dS, & ! Partial derivative of the coordinate variable potential ! density in the mixed layer with salinity, in kg m-3 psu-1. TKE_river ! The turbulent kinetic energy available for mixing at rivermouths over a @@ -320,7 +320,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C Hsfc_max, & ! The thickness of the surface region (mixed and buffer layers) ! after entrainment but before any buffer layer detrainment [Z ~> m]. Hsfc_used, & ! The thickness of the surface region after buffer layer - ! detrainment, in units of Z. + ! detrainment [Z ~> m]. Hsfc_min, & ! The minimum thickness of the surface region based on the ! new mixed layer depth and the previous thickness of the ! neighboring water columns [Z ~> m]. @@ -336,7 +336,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C real :: absf_x_H ! The absolute value of f times the mixed layer thickness [Z s-1 ~> m s-1]. real :: kU_star ! Ustar times the Von Karmen constant [Z s-1 ~> m s-1]. - real :: dt__diag ! A copy of dt_diag (if present) or dt, in s. + real :: dt__diag ! A copy of dt_diag (if present) or dt [s]. logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. integer :: i, j, k, is, ie, js, je, nz, nkmb, n @@ -801,12 +801,12 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & !! points, m s-1. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: v !< Zonal velocities interpolated to h !! points, m s-1. - real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: T !< Layer temperatures, in deg C. - real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: S !< Layer salinities, in psu. + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: T !< Layer temperatures [degC]. + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: S !< Layer salinities [PSU]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: R0 !< Potential density referenced to - !! surface pressure, in kg m-3. + !! surface pressure [kg m-3]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: Rcv !< The coordinate defining potential - !! density, in kg m-3. + !! density [kg m-3]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_eb !< The downward increase across a layer !! in the entrainment from below [H ~> m or kg m-2]. !! Positive values go with mass gain by @@ -956,15 +956,15 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: v !< Zonal velocities interpolated to h points, m s-1. real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: T !< Layer temperatures, in deg C. + intent(in) :: T !< Layer temperatures [degC]. real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: S !< Layer salinities, in psu. + intent(in) :: S !< Layer salinities [PSU]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: R0 !< Potential density referenced to - !! surface pressure, in kg m-3. + !! surface pressure [kg m-3]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: Rcv !< The coordinate defining potential - !! density, in kg m-3. + !! density [kg m-3]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: eps !< The negligibly small amount of water !! that will be left in each layer [H ~> m or kg m-2]. @@ -1010,7 +1010,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields !! have NULL ptrs. - real, intent(in) :: dt !< Time increment, in s. + real, intent(in) :: dt !< Time increment [s]. logical, intent(in) :: aggregate_FW_forcing !< If true, the net incoming and !! outgoing surface freshwater fluxes are !! combined before being applied, instead of @@ -1025,18 +1025,18 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & massOutRem, & ! Evaporation that remains to be supplied [H ~> m or kg m-2]. netMassIn ! mass entering through ocean surface [H ~> m or kg m-2] real :: SW_trans ! The fraction of shortwave radiation - ! that is not absorbed in a layer, ND. + ! that is not absorbed in a layer [nondim]. real :: Pen_absorbed ! The amount of penetrative shortwave radiation - ! that is absorbed in a layer, in units of K H. + ! that is absorbed in a layer [degC H ~> degC m or degC kg m-2]. real :: h_avail ! The thickness in a layer available for ! entrainment [H ~> m or kg m-2]. real :: h_ent ! The thickness from a layer that is entrained [H ~> m or kg m-2]. - real :: T_precip ! The temperature of the precipitation, in deg C. + real :: T_precip ! The temperature of the precipitation [degC]. real :: C1_3, C1_6 ! 1/3 and 1/6. real :: En_fn, Frac, x1 ! Nondimensional temporary variables. - real :: dr, dr0 ! Temporary variables with units of kg m-3 H. - real :: dr_ent, dr_comp ! Temporary variables with units of kg m-3 H. - real :: dr_dh ! The partial derivative of dr_ent with h_ent, in kg m-3. + real :: dr, dr0 ! Temporary variables [kg m-3 H ~> kg m-2 or kg2 m-5]. + real :: dr_ent, dr_comp ! Temporary variables [kg m-3 H ~> kg m-2 or kg2 m-5]. + real :: dr_dh ! The partial derivative of dr_ent with h_ent [kg m-3]. real :: h_min, h_max ! The minimum, maximum, and previous estimates for real :: h_prev ! h_ent [H ~> m or kg m-2]. real :: h_evap ! The thickness that is evaporated [H ~> m or kg m-2]. @@ -1332,7 +1332,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, !! [H-1 ~> m-1 or m2 kg-1] and [H-2 ~> m-2 or m4 kg-2]. real, intent(in) :: dt !< The time step in s. real, intent(in) :: Idt_diag !< The inverse of the accumulated diagnostic - !! time interval, in s-1. + !! time interval [s-1]. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & intent(in) :: ksort !< The density-sorted k-indicies. @@ -1344,22 +1344,22 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, ! Local variables real :: dKE_conv ! The change in mean kinetic energy due to all convection [Z m2 s-2 ~> m3 s-2]. real :: nstar_FC ! The effective efficiency with which the energy released by - ! free convection is converted to TKE, often ~0.2, ND. + ! free convection is converted to TKE, often ~0.2 [nondim]. real :: nstar_CA ! The effective efficiency with which the energy released by - ! convective adjustment is converted to TKE, often ~0.2, ND. + ! convective adjustment is converted to TKE, often ~0.2 [nondim]. real :: TKE_CA ! The potential energy released by convective adjustment if ! that release is positive [Z m2 s-2 ~> m3 s-2]. real :: MKE_rate_CA ! MKE_rate for convective adjustment, ND, 0 to 1. real :: MKE_rate_FC ! MKE_rate for free convection, ND, 0 to 1. real :: totEn_Z ! The total potential energy released by convection, Z3 s-2. real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. - real :: exp_kh ! The nondimensional decay of TKE across a layer, ND. + real :: exp_kh ! The nondimensional decay of TKE across a layer [nondim]. real :: absf ! The absolute value of f averaged to thickness points, s-1. real :: U_star ! The friction velocity [Z s-1 ~> m s-1]. real :: absf_Ustar ! The absolute value of f divided by U_star [Z-1 ~> m-1]. real :: wind_TKE_src ! The surface wind source of TKE [Z m2 s-3 ~> m3 s-3]. real :: diag_wt ! The ratio of the current timestep to the diagnostic - ! timestep (which may include 2 calls), ND. + ! timestep (which may include 2 calls) [nondim]. integer :: is, ie, nz, i is = G%isc ; ie = G%iec ; nz = GV%ke @@ -1511,15 +1511,15 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: v !< Zonal velocities interpolated to h points, m s-1. real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: T !< Layer temperatures, in deg C. + intent(in) :: T !< Layer temperatures [degC]. real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: S !< Layer salinities, in psu. + intent(in) :: S !< Layer salinities [PSU]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: R0 !< Potential density referenced to - !! surface pressure, in kg m-3. + !! surface pressure [kg m-3]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: Rcv !< The coordinate defining potential - !! density, in kg m-3. + !! density [kg m-3]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: eps !< The negligibly small amount of water !! that will be left in each layer [H ~> m or kg m-2]. @@ -1530,7 +1530,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(2,SZI_(G)), intent(in) :: cMKE !< Coefficients of HpE and HpE^2 used in calculating !! the denominator of MKE_rate, in m-1 and m-2. real, intent(in) :: Idt_diag !< The inverse of the accumulated diagnostic - !! time interval, in s-1. + !! time interval [s-1]. integer, intent(in) :: nsw !< The number of bands of penetrating !! shortwave radiation. real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave @@ -1571,10 +1571,10 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: TKE_full_ent ! The TKE remaining if a layer is fully entrained, ! in units of Z m2 s-2. real :: dRL ! Work required to mix water from the next layer - ! across the mixed layer, in m2 s-2. + ! across the mixed layer [m2 s-2]. real :: Pen_En_Contrib ! Penetrating SW contributions to the changes in - ! TKE, divided by layer thickness in m, in m2 s-2. - real :: C1 ! A temporary variable in units of m2 s-2. + ! TKE, divided by layer thickness in m [m2 s-2]. + real :: C1 ! A temporary variable [m2 s-2]. real :: dMKE ! A temporary variable related to the release of mean ! kinetic energy, with units of H Z m2 s-2. real :: TKE_ent ! The TKE that remains if h_ent were entrained [Z m2 s-2 ~> m3 s-2]. @@ -1582,7 +1582,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! release of mean kinetic energy [Z m2 s-2 ~> m3 s-2]. real :: dTKE_dh ! The partial derivative of TKE with h_ent [Z m2 s-2 H-1 ~> m2 s-2 or m5 s-2 kg-1]. real :: Pen_dTKE_dh_Contrib ! The penetrating shortwave contribution to - ! dTKE_dh, in m2 s-2. + ! dTKE_dh [m2 s-2]. real :: EF4_val ! The result of EF4() (see later) [H-1 ~> m-1 or m2 kg-1]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -1828,7 +1828,7 @@ subroutine sort_ML(h, R0, eps, G, GV, CS, ksort) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: R0 !< The potential density used to sort - !! the layers, in kg m-3. + !! the layers [kg m-3]. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: eps !< The (small) thickness that must !! remain in each layer [H ~> m or kg m-2]. type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a @@ -1881,14 +1881,14 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS !! structure. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. !! Layer 0 is the new mixed layer. - real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Layer temperatures, in deg C. - real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Layer salinities, in psu. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Layer temperatures [degC]. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Layer salinities [PSU]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: R0 !< Potential density referenced to - !! surface pressure, in kg m-3. + !! surface pressure [kg m-3]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: Rcv !< The coordinate defining - !! potential density, in kg m-3. + !! potential density [kg m-3]. real, dimension(SZK_(GV)), intent(in) :: RcvTgt !< The target value of Rcv for each - !! layer, in kg m-3. + !! layer [kg m-3]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: eps !< The (small) thickness that must !! remain in each layer [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea !< The upward increase across a @@ -2204,15 +2204,15 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. !! Layer 0 is the new mixed layer. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Potential temperature, in C. - real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Salinity, in psu. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Salinity [PSU]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: R0 !< Potential density referenced to - !! surface pressure, in kg m-3. + !! surface pressure [kg m-3]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: Rcv !< The coordinate defining potential - !! density, in kg m-3. + !! density [kg m-3]. real, dimension(SZK_(GV)), intent(in) :: RcvTgt !< The target value of Rcv for each - !! layer, in kg m-3. - real, intent(in) :: dt !< Time increment, in s. - real, intent(in) :: dt_diag !< The diagnostic time step, in s. + !! layer [kg m-3]. + real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_diag !< The diagnostic time step [s]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea !< The upward increase across a layer in !! the entrainment from above !! [H ~> m or kg m-2]. Positive d_ea @@ -2259,7 +2259,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! mixed layer is very large [H ~> m or kg m-2]. real :: h_min_bl_frac_ml = 0.05 ! The minimum buffer layer thickness relative ! to the total mixed layer thickness for thin - ! mixed layers, nondim., maybe 0.1/CS%nkbl. + ! mixed layers [nondim], maybe 0.1/CS%nkbl. real :: h1, h2 ! Scalar variables holding the values of ! h(i,CS%nkml+1) and h(i,CS%nkml+2) [H ~> m or kg m-2]. @@ -2311,10 +2311,10 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: dSpice_det, dSpice_stays! The spiciness difference between an original ! buffer layer and the water that moves into ! an interior layer or that stays in that - ! layer, in kg m-3. + ! layer [kg m-3]. real :: dSpice_lim, dSpice_lim2 ! Limits to the spiciness difference between ! the lower buffer layer and the water that - ! moves into an interior layer, in kg m-3. + ! moves into an interior layer [kg m-3]. real :: dSpice_2dz ! The vertical gradient of spiciness used for ! advection, in kg m-4. @@ -2324,17 +2324,17 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: num_events ! The number of detrainment events over which ! to prefer merging the buffer layers. real :: detrainment_timescale ! The typical timescale for a detrainment - ! event, in s. + ! event [s]. real :: dPE_time_ratio ! Larger of 1 and the detrainment_timescale ! over dt, nondimensional. real :: dT_dS_gauge, dS_dT_gauge ! The relative scales of temperature and ! salinity changes in defining spiciness, in - ! K psu-1 and psu K-1. + ! [degC psu-1] and [psu degC-1]. real :: I_denom ! A work variable with units of psu2 m6 kg-2. real :: G_2 ! 1/2 G_Earth [m2 Z-1 s-2 ~> m s-2]. real :: Rho0xG ! Rho0 times G_Earth [kg m-1 Z-1 s-2 ~> kg m-2 s-2]. - real :: I2Rho0 ! 1 / (2 Rho0), in m3 kg-1. + real :: I2Rho0 ! 1 / (2 Rho0) [m3 kg-1]. real :: Idt_H2 ! The square of the conversion from thickness to Z ! divided by the time step [Z2 H-2 s-1 ~> s-1 or m6 kg-2 s-1]. logical :: stable_Rcv ! If true, the buffer layers are stable with @@ -2342,14 +2342,14 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: s1en ! A work variable with units of H2 kg m s-3. - real :: s1, s2, bh0 ! Work variables with units of H. - real :: s3sq ! A work variable with units of H2. + real :: s1en ! A work variable [H2 kg m s-3 ~> kg m3 s-3 or kg3 m-3 s-3]. + real :: s1, s2, bh0 ! Work variables [H ~> m or kg m-2]. + real :: s3sq ! A work variable [H2 ~> m2 or kg2 m-4]. real :: I_ya, b1 ! Nondimensional work variables. real :: Ih, Ihdet, Ih1f, Ih2f ! Assorted inverse thickness work variables, - real :: Ihk0, Ihk1, Ih12 ! all with units of H-1. + real :: Ihk0, Ihk1, Ih12 ! all in [H-1 ~> m-1 or m2 kg-1]. real :: dR1, dR2, dR2b, dRk1 ! Assorted density difference work variables, - real :: dR0, dR21, dRcv ! all with units of kg m-3. + real :: dR0, dR21, dRcv ! all in [kg m-3]. real :: dRcv_stays, dRcv_det, dRcv_lim real :: Angstrom ! The minumum layer thickness [H ~> m or kg m-2]. @@ -3104,16 +3104,16 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. !! Layer 0 is the new mixed layer. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Potential temperature, in C. - real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Salinity, in psu. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Salinity [PSU]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: R0 !< Potential density referenced to - !! surface pressure, in kg m-3. + !! surface pressure [kg m-3]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: Rcv !< The coordinate defining potential - !! density, in kg m-3. + !! density [kg m-3]. real, dimension(SZK_(GV)), intent(in) :: RcvTgt !< The target value of Rcv for each - !! layer, in kg m-3. - real, intent(in) :: dt !< Time increment, in s. + !! layer [kg m-3]. + real, intent(in) :: dt !< Time increment [s]. real, intent(in) :: dt_diag !< The accumulated time interval for - !! diagnostics, in s. + !! diagnostics [s]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea !< The upward increase across a layer in !! the entrainment from above !! [H ~> m or kg m-2]. Positive d_ea diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 9bd338a79c..9e69a284b3 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -93,7 +93,7 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf, halo) type(diabatic_aux_CS), intent(in) :: CS !< The control structure returned by a previous !! call to diabatic_aux_init. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(in) :: p_surf !< The pressure at the ocean surface, in Pa. + optional, intent(in) :: p_surf !< The pressure at the ocean surface [Pa]. integer, optional, intent(in) :: halo !< Halo width over which to calculate frazil ! Local variables @@ -212,12 +212,12 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) !! available thermodynamic fields. type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom !! boundary layer properies, and related fields. - real, intent(in) :: dt !< Time increment, in s. + real, intent(in) :: dt !< Time increment [s]. ! local variables real, dimension(SZI_(G)) :: & b1_T, b1_S, & ! Variables used by the tridiagonal solvers of T & S [H ~> m or kg m-2]. - d1_T, d1_S ! Variables used by the tridiagonal solvers, nondim. + d1_T, d1_S ! Variables used by the tridiagonal solvers [nondim]. real, dimension(SZI_(G),SZK_(G)) :: & c1_T, c1_S ! Variables used by the tridiagonal solvers [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(G)+1) :: & @@ -380,7 +380,7 @@ subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) integer, intent(in) :: nkmb !< The number of layers in the mixed and buffer layers type(diabatic_aux_CS), intent(in) :: CS !< The control structure returned by a previous !! call to diabatic_aux_init - real, intent(in) :: dt !< The thermodyanmic time step, in s. + real, intent(in) :: dt !< The thermodyanmic time step [s]. integer, intent(in) :: id_brine_lay !< The handle for a diagnostic !! which layer receivees the brine. @@ -502,8 +502,8 @@ subroutine triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, T, S) !! above within this time step [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: eb !< The amount of fluid entrained from the layer !! below within this time step [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: T !< Layer potential temperatures, in degC. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: S !< Layer salinities, in PSU. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: T !< Layer potential temperatures [degC]. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: S !< Layer salinities [PSU]. ! Local variables real :: b1(SZIB_(G)), d1(SZIB_(G)) ! b1, c1, and d1 are variables used by the @@ -654,12 +654,12 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, integer, optional, intent(in) :: id_MLDsq !< Optional handle (ID) of squared MLD ! Local variables - real, dimension(SZI_(G)) :: deltaRhoAtKm1, deltaRhoAtK ! Density differences, in kg m-3. + real, dimension(SZI_(G)) :: deltaRhoAtKm1, deltaRhoAtK ! Density differences [kg m-3]. real, dimension(SZI_(G)) :: pRef_MLD, pRef_N2 ! Reference pressures in Pa. real, dimension(SZI_(G)) :: dK, dKm1, d1 ! Depths [Z ~> m]. - real, dimension(SZI_(G)) :: rhoSurf, rhoAtK, rho1 ! Densities used for N2, in kg m-3. + real, dimension(SZI_(G)) :: rhoSurf, rhoAtK, rho1 ! Densities used for N2 [kg m-3]. real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth [Z ~> m]. - real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML, in s-2. + real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML [s-2]. real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2 [Z2 ~> m2]. real :: Rho_x_gE ! The product of density, gravitational acceleartion and a unit ! conversion factor, in kg m-1 Z-1 s-2. @@ -794,24 +794,27 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & real :: H_limit_fluxes, IforcingDepthScale, Idt real :: dThickness, dTemp, dSalt real :: fractionOfForcing, hOld, Ithickness - real :: RivermixConst ! A constant used in implementing river mixing, in Pa s. + real :: RivermixConst ! A constant used in implementing river mixing [Pa s]. real, dimension(SZI_(G)) :: & - d_pres, & ! pressure change across a layer (Pa) - p_lay, & ! average pressure in a layer (Pa) - pres, & ! pressure at an interface (Pa) + d_pres, & ! pressure change across a layer [Pa] + p_lay, & ! average pressure in a layer [Pa] + pres, & ! pressure at an interface [Pa] netMassInOut, & ! surface water fluxes [H ~> m or kg m-2] over time step netMassIn, & ! mass entering ocean surface [H ~> m or kg m-2] over a time step netMassOut, & ! mass leaving ocean surface [H ~> m or kg m-2] over a time step - netHeat, & ! heat (degC * H) via surface fluxes, excluding - ! Pen_SW_bnd and netMassOut + netHeat, & ! heat via surface fluxes excluding Pen_SW_bnd and netMassOut + ! [degC H ~> degC m or degC kg m-2] netSalt, & ! surface salt flux ( g(salt)/m2 for non-Bouss and ppt*H for Bouss ) + ! [ppt H ~> ppt m or ppt kg m-2] nonpenSW, & ! non-downwelling SW, which is absorbed at ocean surface - SurfPressure, & ! Surface pressure (approximated as 0.0) - dRhodT, & ! change in density per change in temperature - dRhodS, & ! change in density per change in salinity - netheat_rate, & ! netheat but for dt=1 (e.g. returns a rate) + ! [degC H ~> degC m or degC kg m-2] + SurfPressure, & ! Surface pressure (approximated as 0.0) [Pa] + dRhodT, & ! change in density per change in temperature [kg m-3 degC-1] + dRhodS, & ! change in density per change in salinity [kg m-3 ppt-1] + netheat_rate, & ! netheat but for dt=1 [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] netsalt_rate, & ! netsalt but for dt=1 (e.g. returns a rate) - netMassInOut_rate! netmassinout but for dt=1 (e.g. returns a rate) + ! [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1] + netMassInOut_rate! netmassinout but for dt=1 [H s-1 ~> m s-1 or kg m-2 s-1] real, dimension(SZI_(G), SZK_(G)) :: h2d, T2d real, dimension(SZI_(G), SZK_(G)) :: pen_TKE_2d, dSV_dT_2d real, dimension(SZI_(G),SZK_(G)+1) :: netPen diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 757c2120ab..0cf25147c8 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -125,11 +125,11 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(GV%ke), intent(in) :: h_in !< Layer thickness before entrainment, !! [H ~> m or kg m-2]. - real, dimension(GV%ke), intent(in) :: T_in !< The layer temperatures, in degC. + real, dimension(GV%ke), intent(in) :: T_in !< The layer temperatures [degC]. real, dimension(GV%ke), intent(in) :: S_in !< The layer salinities, in g kg-1. real, dimension(GV%ke+1), intent(in) :: Kd !< The interfaces diapycnal diffusivities !! [Z2 s-1 ~> m2 s-1]. - real, intent(in) :: dt !< The amount of time covered by this call, in s. + real, intent(in) :: dt !< The amount of time covered by this call [s]. real, intent(out) :: energy_Kd !< The column-integrated rate of energy !! consumption by diapycnal diffusion, in W m-2. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any @@ -148,7 +148,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ! for other bits of code. real, dimension(GV%ke) :: & - p_lay, & ! Average pressure of a layer, in Pa. + p_lay, & ! Average pressure of a layer [Pa]. dSV_dT, & ! Partial derivative of specific volume with temperature, in m3 kg-1 degC-1. dSV_dS, & ! Partial derivative of specific volume with salinity, in m3 kg-1 / (g kg-1). T0, S0, & ! Initial temperatures and salinities. @@ -180,19 +180,19 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature dS_to_dPE_a, & ! and salinity changes within a layer, including the implicit effects ! of mixing with layers higher in the water column, in - ! units of J m-2 K-1 and J m-2 ppt-1. + ! units of [J m-2 degC-1] and [J m-2 ppt-1]. dT_to_dPE_b, & ! Partial derivatives of column potential energy with the temperature dS_to_dPE_b, & ! and salinity changes within a layer, including the implicit effects ! of mixing with layers lower in the water column, in - ! units of J m-2 K-1 and J m-2 ppt-1. + ! units of [J m-2 degC-1] and [J m-2 ppt-1]. hp_a, & ! An effective pivot thickness of the layer including the effects ! of coupling with layers above [H ~> m or kg m-2]. This is the first term ! in the denominator of b1 in a downward-oriented tridiagonal solver. hp_b, & ! An effective pivot thickness of the layer including the effects ! of coupling with layers below [H ~> m or kg m-2]. This is the first term ! in the denominator of b1 in an upward-oriented tridiagonal solver. - c1_a, & ! c1_a is used by a downward-oriented tridiagonal solver, ND. - c1_b, & ! c1_b is used by an upward-oriented tridiagonal solver, ND. + c1_a, & ! c1_a is used by a downward-oriented tridiagonal solver [nondim]. + c1_b, & ! c1_b is used by an upward-oriented tridiagonal solver [nondim]. h_tr ! h_tr is h at tracer points with a h_neglect added to ! ensure positive definiteness [H ~> m or kg m-2]. real, dimension(GV%ke+1) :: & @@ -229,12 +229,12 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ! change in the layer below the interface, in ppt H. real :: Kddt_h_guess ! A guess of the final value of Kddt_h [H ~> m or kg m-2]. real :: dMass ! The mass per unit area within a layer, in kg m-2. - real :: dPres ! The hydrostatic pressure change across a layer, in Pa. + real :: dPres ! The hydrostatic pressure change across a layer [Pa]. real :: dMKE_max ! The maximum amount of mean kinetic energy that could be ! converted to turbulent kinetic energy if the velocity in ! the layer below an interface were homogenized with all of ! the water above the interface, in J m-2 = kg s-2. - real :: rho_here ! The in-situ density, in kg m-3. + real :: rho_here ! The in-situ density [kg m-3]. real :: PE_change ! The change in column potential energy from applying Kddt_h at the ! present interface, in J m-2. real :: ColHt_cor ! The correction to PE_chg that is made due to a net @@ -1034,12 +1034,12 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying !! Kddt_h at the present interface, in J m-2. real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h, - !! in units of J m-2 H-1. + !! [J m-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could !! be realizedd by applying a huge value of Kddt_h at the !! present interface, in J m-2. real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the - !! limit where Kddt_h = 0, in J m-2 H-1. + !! limit where Kddt_h = 0 [J m-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: ColHt_cor !< The correction to PE_chg that is made due to a net !! change in the column height, in J m-2. @@ -1174,12 +1174,12 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying !! Kddt_h at the present interface, in J m-2. real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h, - !! in units of J m-2 H-1. + !! [J m-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could !! be realizedd by applying a huge value of Kddt_h at the !! present interface, in J m-2. real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the - !! limit where Kddt_h = 0, in J m-2 H-1. + !! limit where Kddt_h = 0 [J m-2 H-1 ~> J m-3 or J kg-1]. ! This subroutine determines the total potential energy change due to mixing ! at an interface, including all of the implicit effects of the prescribed diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index dfcb67be84..1debb96b3b 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -37,26 +37,26 @@ module MOM_energetic_PBL !! integrated shear production minus the vertically integrated !! dissipation of TKE produced by shear. real :: nstar !< The fraction of the TKE input to the mixed layer available to drive - !! entrainment, nondim. This quantity is the vertically integrated + !! entrainment [nondim]. This quantity is the vertically integrated !! buoyancy production minus the vertically integrated dissipation of !! TKE produced by buoyancy. real :: MixLenExponent !< Exponent in the mixing length shape-function. !! 1 is law-of-the-wall at top and bottom, !! 2 is more KPP like. - real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE decay scale, nondim. + real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE decay scale [nondim]. real :: MKE_to_TKE_effic !< The efficiency with which mean kinetic energy released by !! mechanically forced entrainment of the mixed layer is converted to - !! TKE, nondim. + !! TKE [nondim]. ! real :: Hmix_min !< The minimum mixed layer thickness in m. real :: ustar_min !< A minimum value of ustar to avoid numerical problems, in m s-1. !! If the value is small enough, this should not affect the solution. - real :: omega !< The Earth's rotation rate, in s-1. + real :: omega !< The Earth's rotation rate [s-1]. real :: omega_frac !< When setting the decay scale for turbulence, use this fraction of !! the absolute rotation rate blended with the local value of f, as !! sqrt((1-of)*f^2 + of*4*omega^2). real :: wstar_ustar_coef !< A ratio relating the efficiency with which convectively released !! energy is converted to a turbulent velocity, relative to - !! mechanically forced turbulent kinetic energy, nondim. + !! mechanically forced turbulent kinetic energy [nondim]. !! Making this larger increases the diffusivity. real :: vstar_scale_fac !< An overall nondimensional scaling factor for vstar times a unit !! conversion factor. Making this larger increases the diffusivity. @@ -214,7 +214,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields have !! NULL ptrs. - real, intent(in) :: dt !< Time increment, in s. + real, intent(in) :: dt !< Time increment [s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces !! [Z2 s-1 ~> m2 s-1]. @@ -224,7 +224,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS intent(in) :: Buoy_Flux !< The surface buoyancy flux [Z2 s-3 ~> m2 s-3]. real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less !! than dt if there are two callse to - !! mixedlayer, in s. + !! mixedlayer [s]. logical, optional, intent(in) :: last_call !< If true, this is the last call to !! mixedlayer in the current time step, so !! diagnostics will be written. The default @@ -236,7 +236,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: dS_expected !< The values of salinity change that !! should be expected when the returned - !! diffusivities are applied, in psu. + !! diffusivities are applied [PSU]. type(wave_parameters_CS), & optional, pointer :: Waves !< Wave CS @@ -265,8 +265,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Local variables real, dimension(SZI_(G),SZK_(GV)) :: & h, & ! The layer thickness [H ~> m or kg m-2]. - T, & ! The layer temperatures, in deg C. - S, & ! The layer salinities, in psu. + T, & ! The layer temperatures [degC]. + S, & ! The layer salinities [PSU]. u, & ! The zonal velocity, in m s-1. v ! The meridional velocity, in m s-1. real, dimension(SZI_(G),SZK_(GV)+1) :: & @@ -275,7 +275,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS pres_Z, & ! Interface pressures with a rescaling factor to convert interface height ! movements into changes in column potential energy, in J m-2 Z-1. hb_hs ! The distance from the bottom over the thickness of the - ! water column, nondim. + ! water column [nondim]. real, dimension(SZI_(G)) :: & mech_TKE, & ! The mechanically generated turbulent kinetic energy ! available for mixing over a time step, in J m-2 = kg s-2. @@ -290,35 +290,35 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS Idecay_len_TKE, & ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. h_sum, & ! The total thickness of the water column [H ~> m or kg m-2]. - absf ! The absolute value of f, in s-1. + absf ! The absolute value of f [s-1]. real, dimension(SZI_(G),SZK_(GV)) :: & dT_to_dColHt, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt, & ! and salinity changes within a layer [Z K-1 ~> m K-1] and [Z ppt-1 ~> m ppt-1]. + dS_to_dColHt, & ! and salinity changes within a layer [Z degC-1 ~> m degC-1] and [Z ppt-1 ~> m ppt-1]. dT_to_dPE, & ! Partial derivatives of column potential energy with the temperature - dS_to_dPE, & ! and salinity changes within a layer, in J m-2 K-1 and J m-2 ppt-1. + dS_to_dPE, & ! and salinity changes within a layer, in [J m-2 degC-1] and [J m-2 ppt-1]. dT_to_dColHt_a, & ! Partial derivatives of the total column height with the temperature dS_to_dColHt_a, & ! and salinity changes within a layer, including the implicit effects ! of mixing with layers higher in the water colun [Z K-1 ~> m K-1] and [Z ppt-1 ~> m ppt-1]. dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature dS_to_dPE_a ! and salinity changes within a layer, including the implicit effects ! of mixing with layers higher in the water column, in - ! units of J m-2 K-1 and J m-2 ppt-1. + ! units of [J m-2 degC-1] and [J m-2 ppt-1]. real, dimension(SZK_(GV)) :: & - T0, S0, & ! Initial values of T and S in the column, in K and ppt. - Te, Se, & ! Estimated final values of T and S in the column, in K and ppt. - c1, & ! c1 is used by the tridiagonal solver, ND. + T0, S0, & ! Initial values of T and S in the column, in [degC] and [ppt]. + Te, Se, & ! Estimated final values of T and S in the column, in [degC] and [ppt]. + c1, & ! c1 is used by the tridiagonal solver [nondim]. dTe, dSe ! Running (1-way) estimates of temperature and salinity change. real, dimension(SZK_(GV)) :: & - Th_a, & ! An effective temperature times a thickness in the layer above, - ! including implicit mixing effects with other yet higher layers, in K H. - Sh_a, & ! An effective salinity times a thickness in the layer above, - ! including implicit mixing effects with other yet higher layers, in K H. - Th_b, & ! An effective temperature times a thickness in the layer below, - ! including implicit mixing effects with other yet lower layers, in K H. - Sh_b ! An effective salinity times a thickness in the layer below, - ! including implicit mixing effects with other yet lower layers, in K H. + Th_a, & ! An effective temperature times a thickness in the layer above, including implicit + ! mixing effects with other yet higher layers [degC H ~> degC m or degC kg m-2]. + Sh_a, & ! An effective salinity times a thickness in the layer above, including implicit + ! mixing effects with other yet higher layers [ppt H ~> ppt m or ppt kg m-2]. + Th_b, & ! An effective temperature times a thickness in the layer below, including implicit + ! mixing effects with other yet lower layers [degC H ~> degC m or degC kg m-2]. + Sh_b ! An effective salinity times a thickness in the layer below, including implicit + ! mixing effects with other yet lower layers [ppt H ~> ppt m or ppt kg m-2]. real, dimension(SZI_(G)) :: & hp_a ! An effective pivot thickness of the layer including the effects ! of coupling with layers above [H ~> m or kg m-2]. This is the first term @@ -333,7 +333,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: dMass ! The mass per unit area within a layer, in kg m-2. - real :: dPres ! The hydrostatic pressure change across a layer, in Pa. + real :: dPres ! The hydrostatic pressure change across a layer [Pa]. real :: dMKE_max ! The maximum amount of mean kinetic energy that could be ! converted to turbulent kinetic energy if the velocity in ! the layer below an interface were homogenized with all of @@ -365,9 +365,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: LAmod ! A modified Langmuir number accounting for other parameters. real :: hbs_here ! The local minimum of hb_hs and MixLen_shape, times a ! conversion factor from H to Z [Z H-1 ~> 1 or m3 kg-1]. - real :: nstar_FC ! The fraction of conv_PErel that can be converted to mixing, nondim. + real :: nstar_FC ! The fraction of conv_PErel that can be converted to mixing [nondim]. real :: TKE_reduc ! The fraction by which TKE and other energy fields are - ! reduced to support mixing, nondim. between 0 and 1. + ! reduced to support mixing [nondim]. between 0 and 1. real :: tot_TKE ! The total TKE available to support mixing at interface K, in J m-2. real :: TKE_here ! The total TKE at this point in the algorithm, in J m-2. real :: dT_km1_t2 ! A diffusivity-independent term related to the temperature @@ -382,7 +382,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: dSe_t2 ! A part of dSe_term, in ppt H. real :: dPE_conv ! The convective change in column potential energy, in J m-2. real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K), in J m-2. - real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K), in J m-2 H-1. + real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K) [J m-2 H-1 ~> J m-3 or J kg-1]. real :: Kd_guess0 ! A first guess of the diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 real :: dPEa_dKd_g0 @@ -390,20 +390,20 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! by the average thicknesses around a layer [H ~> m or kg m-2]. real :: PE_chg_max ! The maximum PE change for very large values of Kddt_h(K). real :: dPEc_dKd_Kd0 ! The partial derivative of PE change with Kddt_h(K) - ! for very small values of Kddt_h(K), in J m-2 H-1. + ! for very small values of Kddt_h(K) [J m-2 H-1 ~> J m-3 or J kg-1]. real :: PE_chg ! The change in potential energy due to mixing at an ! interface, in J m-2, positive for the column increasing ! in potential energy (i.e., consuming TKE). real :: TKE_left ! The amount of turbulent kinetic energy left for the most ! recent guess at Kddt_h(K), in J m-2. - real :: dPEc_dKd ! The partial derivative of PE_chg with Kddt_h(K), in J m-2 H-1. + real :: dPEc_dKd ! The partial derivative of PE_chg with Kddt_h(K) [J m-2 H-1 ~> J m-3 or J kg-1]. real :: TKE_left_min, TKE_left_max, Kddt_h_max, Kddt_h_min real :: Kddt_h_guess ! A guess at the value of Kddt_h(K) [H ~> m or kg m-2]. real :: Kddt_h_next ! The next guess at the value of Kddt_h(K) [H ~> m or kg m-2]. real :: dKddt_h ! The change between guesses at Kddt_h(K) [H ~> m or kg m-2]. real :: dKddt_h_Newt ! The change between guesses at Kddt_h(K) with Newton's method [H ~> m or kg m-2]. real :: Kddt_h_newt ! The Newton's method next guess for Kddt_h(K) [H ~> m or kg m-2]. - real :: exp_kh ! The nondimensional decay of TKE across a layer, ND. + real :: exp_kh ! The nondimensional decay of TKE across a layer [nondim]. logical :: use_Newt ! Use Newton's method for the next guess at Kddt_h(K). logical :: convectively_stable logical, dimension(SZI_(G)) :: & @@ -413,7 +413,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! from the surface. ! The following is only used as a diagnostic. - real :: dt__diag ! A copy of dt_diag (if present) or dt, in s. + real :: dt__diag ! A copy of dt_diag (if present) or dt [s]. real :: IdtdR0 ! = 1.0 / (dt__diag * Rho0), in m3 kg-1 s-1. real, dimension(SZI_(G),SZJ_(G)) :: & Hsfc_used ! The thickness of the surface region [Z ~> m]. @@ -1619,13 +1619,13 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying !! Kddt_h at the present interface, in J m-2. - real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h, - !! in units of J m-2 H-1. + real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h + !! [J m-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could !! be realizedd by applying a huge value of Kddt_h at the !! present interface, in J m-2. real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the - !! limit where Kddt_h = 0, in J m-2 H-1. + !! limit where Kddt_h = 0 [J m-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: ColHt_cor !< The correction to PE_chg that is made due to a net !! change in the column height, in J m-2. @@ -1758,13 +1758,13 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying !! Kddt_h at the present interface, in J m-2. - real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h, - !! in units of J m-2 H-1. + real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h + !! [J m-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could !! be realizedd by applying a huge value of Kddt_h at the !! present interface, in J m-2. real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the - !! limit where Kddt_h = 0, in J m-2 H-1. + !! limit where Kddt_h = 0 [J m-2 H-1 ~> J m-3 or J kg-1]. ! This subroutine determines the total potential energy change due to mixing ! at an interface, including all of the implicit effects of the prescribed diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 3459c72f51..43556d0e0d 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -131,9 +131,9 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, ea_kbp1, & ! The entrainment from above by layer kb+1 [H ~> m or kg m-2]. eb_kmb, & ! The entrainment from below by the deepest buffer layer [H ~> m or kg m-2]. dS_kb, & ! The reference potential density difference across the - ! interface between the buffer layers and layer kb, in kg m-3. + ! interface between the buffer layers and layer kb [kg m-3]. dS_anom_lim, &! The amount by which dS_kb is reduced when limits are - ! applied, in kg m-3. + ! applied [kg m-3]. I_dSkbp1, & ! The inverse of the potential density difference across the ! interface below layer kb, in m3 kg-1. dtKd_kb, & ! The diapycnal diffusivity in layer kb times the time step @@ -148,14 +148,14 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, err_eakb0, & ! A value of error returned by determine_Ea_kb. F_kb, & ! The value of F in layer kb, or equivalently the entrainment ! from below by layer kb [H ~> m or kg m-2]. - dFdfm_kb, & ! The partial derivative of F with fm, nondim. See dFdfm. + dFdfm_kb, & ! The partial derivative of F with fm [nondim]. See dFdfm. maxF_kb, & ! The maximum value of F_kb that might be realized [H ~> m or kg m-2]. eakb_maxF, & ! The value of eakb that gives F_kb=maxF_kb [H ~> m or kg m-2]. F_kb_maxEnt ! The value of F_kb when eakb = max_eakb [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(G)) :: & Sref, & ! The reference potential density of the mixed and buffer layers, ! and of the two lightest interior layers (kb and kb+1) copied - ! into layers kmb+1 and kmb+2, in kg m-3. + ! into layers kmb+1 and kmb+2 [kg m-3]. h_bl ! The thicknesses of the mixed and buffer layers, and of the two ! lightest interior layers (kb and kb+1) copied into layers kmb+1 ! and kmb+2 [H ~> m or kg m-2]. @@ -172,10 +172,10 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, ! 4*ds_Lay*(1/ds_k + 1/ds_k+1). Nondim. real :: dRHo ! The change in locally referenced potential density between - ! the layers above and below an interface, in kg m-3. + ! the layers above and below an interface [kg m-3]. real :: g_2dt ! 0.5 * G_Earth / dt, times unit conversion factors, in m3 H-2 s-3. real, dimension(SZI_(G)) :: & - pressure, & ! The pressure at an interface, in Pa. + pressure, & ! The pressure at an interface [Pa]. T_eos, S_eos, & ! The potential temperature and salinity at which to ! evaluate dRho_dT and dRho_dS, in degC and PSU. dRho_dT, dRho_dS ! The partial derivatives of potential density with @@ -195,7 +195,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, real :: ea_cor ! The corrective adjustment to eakb [H ~> m or kg m-2]. real :: h1 ! The layer thickness after entrainment through the ! interface below is taken into account [H ~> m or kg m-2]. - real :: Idt ! The inverse of the time step, in s-1. + real :: Idt ! The inverse of the time step [s-1]. logical :: do_any logical :: do_i(SZI_(G)), did_i(SZI_(G)), reiterate, correct_density @@ -1042,7 +1042,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref !! downward across each interface around !! the buffer layers [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(G)), intent(out) :: Sref !< The coordinate potential density - - !! 1000 for each layer, in kg m-3. + !! 1000 for each layer [kg m-3]. real, dimension(SZI_(G),SZK_(G)), intent(out) :: h_bl !< The thickness of each layer [H ~> m or kg m-2]. ! This subroutine sets the average entrainment across each of the interfaces @@ -1057,11 +1057,11 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref Rcv, & ! Value of the coordinate variable (potential density) ! based on the simulated T and S and P_Ref, kg m-3. pres, & ! Reference pressure (P_Ref) in Pa. - frac_rem, & ! The fraction of the diffusion remaining, ND. + frac_rem, & ! The fraction of the diffusion remaining [nondim]. h_interior ! The interior thickness available for entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G), SZK_(G)) :: & S_est ! An estimate of the coordinate potential density - 1000 after - ! entrainment for each layer, in kg m-3. + ! entrainment for each layer [kg m-3]. real :: max_ent ! The maximum possible entrainment [H ~> m or kg m-2]. real :: dh ! An available thickness [H ~> m or kg m-2]. real :: Kd_x_dt ! The diffusion that remains after thin layers are @@ -1221,7 +1221,7 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & !! with E, in kg m-3 H-1. real, dimension(SZI_(G)), optional, intent(inout) :: dS_anom_lim !< A limiting value to use for !! the density anomalies below the - !! buffer layer, in kg m-3. + !! buffer layer [kg m-3]. logical, dimension(SZI_(G)), optional, intent(in) :: do_i_in !< If present, determines which !! columns are worked on. @@ -1436,19 +1436,18 @@ subroutine F_kb_to_ea_kb(h_bl, Sref, Ent_bl, I_dSkbp1, F_kb, kmb, i, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZK_(G)), & intent(in) :: h_bl !< Layer thickness, with the top interior - !! layer at k-index kmb+1, in units of m - !! or kg m-2 (abbreviated as H below). + !! layer at k-index kmb+1 [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(G)), & intent(in) :: Sref !< The coordinate reference potential density, !! with the value of the topmost interior layer - !! at index kmb+1, in units of kg m-3. + !! at index kmb+1 [kg m-3]. real, dimension(SZI_(G),SZK_(G)), & intent(in) :: Ent_bl !< The average entrainment upward and downward !! across each interface around the buffer layers, !! [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: I_dSkbp1 !< The inverse of the difference in reference !! potential density across the base of the - !! uppermost interior layer, in units of m3 kg-1. + !! uppermost interior layer [m3 kg-1]. real, dimension(SZI_(G)), intent(in) :: F_kb !< The entrainment from below by the !! uppermost interior layer [H ~> m or kg m-2] integer, intent(in) :: kmb !< The number of mixed and buffer layers. @@ -1573,14 +1572,14 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & real, dimension(SZI_(G),SZK_(G)), intent(in) :: Sref !< The coordinate reference potential !! density, with the value of the !! topmost interior layer at layer - !! kmb+1, in units of kg m-3. + !! kmb+1 [kg m-3]. real, dimension(SZI_(G),SZK_(G)), intent(in) :: Ent_bl !< The average entrainment upward and !! downward across each interface around !! the buffer layers [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: I_dSkbp1 !< The inverse of the difference in !! reference potential density across !! the base of the uppermost interior - !! layer, in units of m3 kg-1. + !! layer [m3 kg-1]. real, dimension(SZI_(G)), intent(in) :: dtKd_kb !< The diapycnal diffusivity in the top !! interior layer times the time step !! [H2 ~> m2 or kg2 m-4]. @@ -1613,7 +1612,7 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & !! corresponding to the returned !! value of Ent [H ~> m or kg m-2]. real, dimension(SZI_(G)), optional, intent(out) :: dFdfm_kb !< The partial derivative of F_kb with - !! ea_kbp1, nondim. + !! ea_kbp1 [nondim]. ! This subroutine determines the entrainment from above by the top interior ! layer (labeled kb elsewhere) given an entrainment by the layer below it, @@ -1623,10 +1622,10 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & real, dimension(SZI_(G)) :: & dS_kb, & ! The coordinate-density difference between the ! layer kb and deepest buffer layer, limited to - ! ensure that it is positive, in kg m-3. + ! ensure that it is positive [kg m-3]. dS_Lay, & ! The coordinate-density difference across layer ! kb, limited to ensure that it is positive and not - ! too much bigger than dS_kb or dS_kbp1, in kg m-3. + ! too much bigger than dS_kb or dS_kbp1 [kg m-3]. ddSkb_dE, ddSlay_dE, & ! The derivatives of dS_kb and dS_Lay with E, ! in kg m-3 H-1. derror_dE, & ! The derivative of err with E [H ~> m or kg m-2]. @@ -1780,17 +1779,16 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK_(G)), & intent(in) :: h_bl !< Layer thickness [H ~> m or kg m-2] - !! (abbreviated as H below). real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: Sref !< Reference potential density (in kg m-3?). + intent(in) :: Sref !< Reference potential density [kg m-3]. real, dimension(SZI_(G),SZK_(G)), & intent(in) :: Ent_bl !< The average entrainment upward and !! downward across each interface around !! the buffer layers [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: I_dSkbp1 !< The inverse of the difference in !! reference potential density across the - !! base of the uppermost interior layer, - !! in units of m3 kg-1. + !! base of the uppermost interior layer + !! [m3 kg-1]. real, dimension(SZI_(G)), intent(in) :: min_ent_in !< The minimum value of ent to search, !! [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: max_ent_in !< The maximum value of ent to search, diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 6fe7a62e9f..3ac50b6049 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -41,13 +41,13 @@ module MOM_kappa_shear !! is 0.085-0.089. real :: FRi_curvature !< A constant giving the curvature of the function !! of the Richardson number that relates shear to - !! sources in the kappa equation, Nondim. + !! sources in the kappa equation [nondim]. !! The values found by Jackson et al. are -0.97 - -0.89. real :: C_N !< The coefficient for the decay of TKE due to - !! stratification (i.e. proportional to N*tke), ND. + !! stratification (i.e. proportional to N*tke) [nondim]. !! The values found by Jackson et al. are 0.24-0.28. real :: C_S !< The coefficient for the decay of TKE due to - !! shear (i.e. proportional to |S|*tke), ND. + !! shear (i.e. proportional to |S|*tke) [nondim]. !! The values found by Jackson et al. are 0.14-0.12. real :: lambda !< The coefficient for the buoyancy length scale !! in the kappa equation. Nondimensional. @@ -124,7 +124,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & !! (not layer!) [Z2 s-1 ~> m2 s-1]. This discards any !! previous value (i.e. it is intent out) and !! simply sets Kv = Prandtl * Kd_shear - real, intent(in) :: dt !< Time increment, in s. + real, intent(in) :: dt !< Time increment [s]. type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous !! call to kappa_shear_init. logical, optional, intent(in) :: initialize_all !< If present and false, the previous @@ -167,7 +167,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & ! interfaces and the interfaces with massless layers ! merged into nearby massive layers. real, dimension(SZK_(GV)+1) :: kf ! The fractional weight of interface kc+1 for - ! interpolating back to the original index space, ND. + ! interpolating back to the original index space [nondim]. integer :: is, ie, js, je, i, j, k, nz, nzc ! Diagnostics that should be deleted? @@ -413,7 +413,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ !! The previous value is used to initialize kappa !! in the vertex columes as Kappa = Kv/Prandtl !! to accelerate the iteration toward covergence. - real, intent(in) :: dt !< Time increment, in s. + real, intent(in) :: dt !< Time increment [s]. type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous !! call to kappa_shear_init. logical, optional, intent(in) :: initialize_all !< If present and false, the previous @@ -426,27 +426,25 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ real, dimension(SZIB_(G),SZK_(GV)+1,2) :: & kappa_2d ! Quasi 2-D versions of kappa_io [Z2 s-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZK_(GV)+1) :: & - tke_2d ! 2-D version tke_io in m2 s-2. + tke_2d ! 2-D version tke_io [m2 s-2]. real, dimension(SZK_(GV)) :: & u, & ! The zonal velocity after a timestep of mixing, in m s-1. v, & ! The meridional velocity after a timestep of mixing, in m s-1. Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. T, & ! The potential temperature after a timestep of mixing, in C. - Sal, & ! The salinity after a timestep of mixing, in psu. + Sal, & ! The salinity after a timestep of mixing [PSU]. dz, & ! The layer thickness [Z ~> m]. - u0xdz, & ! The initial zonal velocity times dz, in m Z s-1. - v0xdz, & ! The initial meridional velocity times dz, in m Z s-1. - T0xdz, & ! The initial temperature times dz, in C Z. - S0xdz ! The initial salinity times dz, in PSU Z. + u0xdz, & ! The initial zonal velocity times dz [m Z s-1 ~> m2 s-1]. + v0xdz, & ! The initial meridional velocity times dz [m Z s-1 ~> m2 s-1]. + T0xdz, & ! The initial temperature times dz [degC Z ~> degC m]. + S0xdz ! The initial salinity times dz [PSU Z ~> PSU m]. real, dimension(SZK_(GV)+1) :: & - kappa, & ! The shear-driven diapycnal diffusivity at an interface, in - ! units of m2 s-1. - tke, & ! The Turbulent Kinetic Energy per unit mass at an interface, - ! in units of m2 s-2. + kappa, & ! The shear-driven diapycnal diffusivity at an interface [Z2 s-1 ~> m2 s-1]. + tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [m2 s-2]. kappa_avg, & ! The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. tke_avg ! The time-weighted average of TKE [m2 s-2]. real :: f2 ! The squared Coriolis parameter of each column [s-2]. - real :: surface_pres ! The top surface pressure, in Pa. + real :: surface_pres ! The top surface pressure [Pa]. real :: dz_in_lay ! The running sum of the thickness in a layer [Z ~> m]. real :: k0dt ! The background diffusivity times the timestep [Z2 ~> m2]. @@ -463,7 +461,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! interfaces and the interfaces with massless layers ! merged into nearby massive layers. real, dimension(SZK_(GV)+1) :: kf ! The fractional weight of interface kc+1 for - ! interpolating back to the original index space, ND. + ! interpolating back to the original index space [nondim]. integer :: IsB, IeB, JsB, JeB, i, j, k, nz, nzc, J2, J2m1 ! Diagnostics that should be deleted? @@ -720,10 +718,10 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & intent(inout) :: kappa !< The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. real, dimension(SZK_(GV)+1), & intent(inout) :: tke !< The Turbulent Kinetic Energy per unit mass at - !! an interface, in units of m2 s-2. + !! an interface [m2 s-2]. integer, intent(in) :: nzc !< The number of active layers in the column. real, intent(in) :: f2 !< The square of the Coriolis parameter [s-2]. - real, intent(in) :: surface_pres !< The surface pressure, in Pa. + real, intent(in) :: surface_pres !< The surface pressure [Pa]. real, dimension(SZK_(GV)), & intent(in) :: dz !< The layer thickness [Z ~> m]. real, dimension(SZK_(GV)), & @@ -738,7 +736,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & intent(out) :: kappa_avg !< The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. real, dimension(SZK_(GV)+1), & intent(out) :: tke_avg !< The time-weighted average of TKE [m2 s-2]. - real, intent(in) :: dt !< Time increment, in s. + real, intent(in) :: dt !< Time increment [s]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. @@ -749,8 +747,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & u, & ! The zonal velocity after a timestep of mixing, in m s-1. v, & ! The meridional velocity after a timestep of mixing, in m s-1. Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. - T, & ! The potential temperature after a timestep of mixing, in C. - Sal, & ! The salinity after a timestep of mixing, in psu. + T, & ! The potential temperature after a timestep of mixing [degC]. + Sal, & ! The salinity after a timestep of mixing [PSU]. u_test, v_test, T_test, S_test real, dimension(nzc+1) :: & @@ -768,23 +766,22 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & k_src, & ! The shear-dependent source term in the kappa equation [s-1]. kappa_src, & ! The shear-dependent source term in the kappa equation in s-1. kappa_out, & ! The kappa that results from the kappa equation [Z2 s-1 ~> m2 s-1]. - kappa_mid, & ! The average of the initial and predictor estimates of kappa, - ! in units of Z2 s-1. + kappa_mid, & ! The average of the initial and predictor estimates of kappa [Z2 s-1 ~> m2 s-1]. tke_pred, & ! The value of TKE from a predictor step [m2 s-2]. kappa_pred, & ! The value of kappa from a predictor step [Z2 s-1 ~> m2 s-1]. - pressure, & ! The pressure at an interface, in Pa. - T_int, & ! The temperature interpolated to an interface, in C. - Sal_int, & ! The salinity interpolated to an interface, in psu. + pressure, & ! The pressure at an interface [Pa]. + T_int, & ! The temperature interpolated to an interface [degC]. + Sal_int, & ! The salinity interpolated to an interface [PSU]. dbuoy_dT, & ! The partial derivatives of buoyancy with changes in temperature dbuoy_dS, & ! and salinity, [Z s-2 K-1 ~> m s-2 K-1] and [Z s-2 psu-1 ~> m s-2 psu-1]. I_L2_bdry, & ! The inverse of the square of twice the harmonic mean ! distance to the top and bottom boundaries [Z-2 ~> m-2]. K_Q, & ! Diffusivity divided by TKE [Z2 m-2 s ~> s]. K_Q_tmp, & ! A temporary copy of diffusivity divided by TKE [Z2 m-2 s ~> s]. - local_src_avg, & ! The time-integral of the local source, nondim. + local_src_avg, & ! The time-integral of the local source [nondim]. tol_min, & ! Minimum tolerated ksrc for the corrector step [s-1]. tol_max, & ! Maximum tolerated ksrc for the corrector step [s-1]. - tol_chg, & ! The tolerated change integrated in time, nondim. + tol_chg, & ! The tolerated change integrated in time [nondim]. dist_from_top, & ! The distance from the top surface [Z ~> m]. local_src ! The sum of all sources of kappa, including kappa_src and ! sources from the elliptic term [s-1]. @@ -801,13 +798,13 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! within an iteration. 0 < tol_dksrc_low < 1. real :: Ri_crit ! The critical shear Richardson number for shear- ! driven mixing. The theoretical value is 0.25. - real :: dt_rem ! The remaining time to advance the solution, in s. - real :: dt_now ! The time step used in the current iteration, in s. - real :: dt_wt ! The fractional weight of the current iteration, ND. + real :: dt_rem ! The remaining time to advance the solution [s]. + real :: dt_now ! The time step used in the current iteration [s]. + real :: dt_wt ! The fractional weight of the current iteration [nondim]. real :: dt_test ! A time-step that is being tested for whether it - ! gives acceptably small changes in k_src, in s. + ! gives acceptably small changes in k_src [s]. real :: Idtt ! Idtt = 1 / dt_test [s-1]. - real :: dt_inc ! An increment to dt_test that is being tested, in s. + real :: dt_inc ! An increment to dt_test that is being tested [s]. real :: k0dt ! The background diffusivity times the timestep [Z2 ~> m2]. logical :: valid_dt ! If true, all levels so far exhibit acceptably small @@ -1241,7 +1238,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & real, dimension(nz), intent(in) :: u0 !< The initial zonal velocity, in m s-1. real, dimension(nz), intent(in) :: v0 !< The initial meridional velocity, in m s-1. real, dimension(nz), intent(in) :: T0 !< The initial temperature, in C. - real, dimension(nz), intent(in) :: S0 !< The initial salinity, in PSU. + real, dimension(nz), intent(in) :: S0 !< The initial salinity [PSU]. real, dimension(nz), intent(in) :: dz !< The grid spacing of layers [Z ~> m]. real, dimension(nz+1), intent(in) :: I_dz_int !< The inverse of the layer's thicknesses !! [Z-1 ~> m-1]. @@ -1253,7 +1250,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & real, dimension(nz), intent(inout) :: u !< The zonal velocity after dt, in m s-1. real, dimension(nz), intent(inout) :: v !< The meridional velocity after dt, in m s-1. real, dimension(nz), intent(inout) :: T !< The temperature after dt, in C. - real, dimension(nz), intent(inout) :: Sal !< The salinity after dt, in PSU. + real, dimension(nz), intent(inout) :: Sal !< The salinity after dt [PSU]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(nz+1), optional, & @@ -1373,8 +1370,7 @@ end subroutine calculate_projected_state subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & nz, CS, GV, US, K_Q, tke, kappa, kappa_src, local_src) integer, intent(in) :: nz !< The number of layers to work on. - real, dimension(nz+1), intent(in) :: N2 !< The buoyancy frequency squared at interfaces, - !! in s-2. + real, dimension(nz+1), intent(in) :: N2 !< The buoyancy frequency squared at interfaces [s-2]. real, dimension(nz+1), intent(in) :: S2 !< The squared shear at interfaces [s-2]. real, dimension(nz+1), intent(in) :: kappa_in !< The initial guess at the diffusivity !! [Z2 s-1 ~> m2 s-1]. @@ -1389,9 +1385,9 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(nz+1), intent(inout) :: K_Q !< The shear-driven diapycnal diffusivity divided by !! the turbulent kinetic energy per unit mass at - !! interfaces, in s. + !! interfaces [s]. real, dimension(nz+1), intent(out) :: tke !< The turbulent kinetic energy per unit mass at - !! interfaces, in units of m2 s-2. + !! interfaces [m2 s-2]. real, dimension(nz+1), intent(out) :: kappa !< The diapycnal diffusivity at interfaces !! [Z2 s-1 ~> m2 s-1]. real, dimension(nz+1), optional, & @@ -1409,7 +1405,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dK, & ! The change in kappa [Z2 s-1 ~> m2 s-1]. dQ, & ! The change in TKE [m2 s-2]. cQ, cK, & ! cQ and cK are the upward influences in the tridiagonal and - ! hexadiagonal solvers for the TKE and kappa equations, ND. + ! hexadiagonal solvers for the TKE and kappa equations [nondim]. I_Ld2, & ! 1/Ld^2, where Ld is the effective decay length scale ! for kappa [Z-2 ~> m-2]. TKE_decay, & ! The local TKE decay rate [s-1]. @@ -1429,7 +1425,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real :: c_s2 ! The coefficient for the decay of TKE due to ! shear (i.e. proportional to |S|*tke), nondimensional. real :: c_n2 ! The coefficient for the decay of TKE due to - ! stratification (i.e. proportional to N*tke), nondim. + ! stratification (i.e. proportional to N*tke) [nondim]. real :: Ri_crit ! The critical shear Richardson number for shear- ! driven mixing. The theoretical value is 0.25. real :: q0 ! The background level of TKE [m2 s-2]. @@ -1437,7 +1433,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real :: TKE_min ! The minimum value of shear-driven TKE that can be ! solved for [m2 s-2]. real :: kappa0 ! The background diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. - real :: max_err ! The maximum value of norm_err in a column, nondim. + real :: max_err ! The maximum value of norm_err in a column [nondim]. real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0, Z2 s-1. real :: eden1, eden2, I_eden, ome ! Variables used in calculating e1. @@ -1486,7 +1482,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & tke_it1, kappa_it1, kprev_it1, & ! Various values from each iteration. dkappa_it1, K_Q_it1, d_dkappa_it1, dkappa_norm_it1 real :: norm_err ! The absolute change in kappa between iterations, - ! normalized by the value of kappa, nondim. + ! normalized by the value of kappa [nondim]. real :: max_TKE_err, min_TKE_err, TKE_err(nz) ! Various normalized TKE changes. integer :: it2 #endif diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 287c440d0d..73bfd1c192 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -133,11 +133,11 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) !! call to regularize_layers_init. ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & - def_rat_u ! The ratio of the thickness deficit to the minimum depth, ND. + def_rat_u ! The ratio of the thickness deficit to the minimum depth [nondim]. real, dimension(SZI_(G),SZJB_(G)) :: & - def_rat_v ! The ratio of the thickness deficit to the minimum depth, ND. + def_rat_v ! The ratio of the thickness deficit to the minimum depth [nondim]. real, dimension(SZI_(G),SZJ_(G)) :: & - def_rat_h ! The ratio of the thickness deficit to the minimum depth, ND. + def_rat_h ! The ratio of the thickness deficit to the minimum depth [nondim]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & e ! The interface depths [H ~> m or kg m-2], positive upward. @@ -156,12 +156,12 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) e_filt, e_2d ! The interface depths [H ~> m or kg m-2], positive upward. real, dimension(SZI_(G),SZK_(G)) :: & h_2d, & ! A 2-d version of h [H ~> m or kg m-2]. - T_2d, & ! A 2-d version of tv%T, in deg C. - S_2d, & ! A 2-d version of tv%S, in PSU. - Rcv, & ! A 2-d version of the coordinate density, in kg m-3. + T_2d, & ! A 2-d version of tv%T [degC]. + S_2d, & ! A 2-d version of tv%S [PSU]. + Rcv, & ! A 2-d version of the coordinate density [kg m-3]. h_2d_init, & ! The initial value of h_2d [H ~> m or kg m-2]. - T_2d_init, & ! THe initial value of T_2d, in deg C. - S_2d_init, & ! The initial value of S_2d, in PSU. + T_2d_init, & ! THe initial value of T_2d [degC]. + S_2d_init, & ! The initial value of S_2d [PSU]. d_eb, & ! The downward increase across a layer in the entrainment from ! below [H ~> m or kg m-2]. The sign convention is that positive values of ! d_eb correspond to a gain in mass by a layer by upward motion. @@ -170,21 +170,21 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) ! d_ea mean a net gain in mass by a layer from downward motion. real, dimension(SZI_(G)) :: & p_ref_cv, & ! Reference pressure for the potential density which defines - ! the coordinate variable, set to P_Ref, in Pa. + ! the coordinate variable, set to P_Ref [Pa]. Rcv_tol, & ! A tolerence, relative to the target density differences - ! between layers, for detraining into the interior, ND. + ! between layers, for detraining into the interior [nondim]. h_add_tgt, h_add_tot, & h_tot1, Th_tot1, Sh_tot1, & h_tot3, Th_tot3, Sh_tot3, & h_tot2, Th_tot2, Sh_tot2 real, dimension(SZK_(G)) :: & h_prev_1d ! The previous thicknesses [H ~> m or kg m-2]. - real :: I_dtol ! The inverse of the tolerance changes, nondim. - real :: I_dtol34 ! The inverse of the tolerance changes, nondim. + real :: I_dtol ! The inverse of the tolerance changes [nondim]. + real :: I_dtol34 ! The inverse of the tolerance changes [nondim]. real :: h1, h2 ! Temporary thicknesses [H ~> m or kg m-2]. real :: e_e, e_w, e_n, e_s ! Temporary interface heights [H ~> m or kg m-2]. - real :: wt ! The weight of the filted interfaces in setting the targets, ND. - real :: scale ! A scaling factor, ND. + real :: wt ! The weight of the filted interfaces in setting the targets [nondim]. + real :: scale ! A scaling factor [nondim]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real, dimension(SZK_(G)+1) :: & @@ -193,7 +193,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) real :: h_det_tot real :: max_def_rat real :: Rcv_min_det ! The lightest (min) and densest (max) coordinate density - real :: Rcv_max_det ! that can detrain into a layer, in kg m-3. + real :: Rcv_max_det ! that can detrain into a layer [kg m-3]. real :: int_top, int_bot real :: h_predicted @@ -726,20 +726,20 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & intent(in) :: e !< Interface depths [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G)), & intent(out) :: def_rat_u !< The thickness deficit ratio at u points, - !! nondim. + !! [nondim]. real, dimension(SZI_(G),SZJB_(G)), & intent(out) :: def_rat_v !< The thickness deficit ratio at v points, - !! nondim. + !! [nondim]. type(regularize_layers_CS), pointer :: CS !< The control structure returned by a !! previous call to regularize_layers_init. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(out) :: def_rat_u_2lay !< The thickness deficit ratio at u !! points when the mixed and buffer layers - !! are aggregated into 1 layer, nondim. + !! are aggregated into 1 layer [nondim]. real, dimension(SZI_(G),SZJB_(G)), & optional, intent(out) :: def_rat_v_2lay !< The thickness deficit ratio at v !! pointswhen the mixed and buffer layers - !! are aggregated into 1 layer, nondim. + !! are aggregated into 1 layer [nondim]. integer, optional, intent(in) :: halo !< An extra-wide halo size, 0 by default. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. @@ -758,7 +758,7 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, & h_def2_v real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: Hmix_min ! CS%Hmix_min converted to units of H. + real :: Hmix_min ! A local copy of CS%Hmix_min [H ~> m or kg m-2]. real :: h1, h2 ! Temporary thicknesses [H ~> m or kg m-2]. integer :: i, j, k, is, ie, js, je, nz, nkmb diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 50ba6ffddc..5dee563b35 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -499,12 +499,12 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif if (CS%limit_dissipation) then - do k=2,nz-1 ; do i=is,ie ! This calculates the dissipation ONLY from Kd calculated in this routine - ! dissip has units of W/m3 (kg/m3 * m2/s * 1/s2 = J/s/m3) + ! dissip has units of W/m3 (= kg/m3 * m2/s * 1/s2) ! 1) a global constant, ! 2) a dissipation proportional to N (aka Gargett) and ! 3) dissipation corresponding to a (nearly) constant diffusivity. + do k=2,nz-1 ; do i=is,ie dissip = max( CS%dissip_min, & ! Const. floor on dissip. CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_lay(i,k)), & ! Floor aka Gargett CS%dissip_N2 * N2_lay(i,k) ) ! Floor of Kd_min*rho0/F_Ri @@ -513,11 +513,6 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & enddo ; enddo if (present(Kd_int)) then ; do K=2,nz ; do i=is,ie - ! This calculates the dissipation ONLY from Kd calculated in this routine - ! dissip has units of W/m3 (kg/m3 * m2/s * 1/s2 = J/s/m3) - ! 1) a global constant, - ! 2) a dissipation proportional to N (aka Gargett) and - ! 3) dissipation corresponding to a (nearly) constant diffusivity. dissip = max( CS%dissip_min, & ! Const. floor on dissip. CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_int(i,K)), & ! Floor aka Gargett CS%dissip_N2 * N2_int(i,K) ) ! Floor of Kd_min*rho0/F_Ri @@ -529,7 +524,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(dd%Kd_work)) then do k=1,nz ; do i=is,ie dd%Kd_Work(i,j,k) = GV%Rho0 * US%Z_to_m**3*Kd_lay(i,j,k) * N2_lay(i,k) * & - GV%H_to_Z*h(i,j,k) ! Watt m-2 s or kg s-3 + GV%H_to_Z*h(i,j,k) ! Watt m-2 s = kg s-3 enddo ; enddo endif enddo ! j-loop @@ -674,7 +669,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available !! thermodynamic fields. real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: dRho_int !< Change in locally referenced potential density - !! across each interface, in kg m-3. + !! across each interface [kg m-3]. real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< The squared buoyancy frequency of the !! layers, in s-2. integer, intent(in) :: j !< j-index of row to work on @@ -888,7 +883,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZK_(G)+1), & intent(out) :: dRho_int !< Change in locally referenced potential density - !! across each interface, in kg m-3. + !! across each interface [kg m-3]. real, dimension(SZI_(G),SZK_(G)+1), & intent(out) :: N2_int !< The squared buoyancy frequency at the interfaces, in s-2. real, dimension(SZI_(G),SZK_(G)), & diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index cd4950c14a..7f86d51df3 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -71,7 +71,7 @@ module MOM_set_visc !! determine the mixed layer thickness for viscosity. real :: bulk_Ri_ML !< The bulk mixed layer used to determine the !! thickness of the viscous mixed layer. Nondim. - real :: omega !< The Earth's rotation rate, in s-1. + real :: omega !< The Earth's rotation rate [s-1]. real :: ustar_min !< A minimum value of ustar to avoid numerical !! problems [Z s-1 ~> m s-1]. If the value is small enough, !! this should not affect the solution. @@ -127,29 +127,27 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real, dimension(SZIB_(G)) :: & ustar, & ! The bottom friction velocity, in m s-1. T_EOS, & ! The temperature used to calculate the partial derivatives - ! of density with T and S, in degC. + ! of density with T and S [degC]. S_EOS, & ! The salinity used to calculate the partial derivatives - ! of density with T and S, in PSU. + ! of density with T and S [PSU]. dR_dT, & ! Partial derivative of the density in the bottom boundary - ! layer with temperature, in units of kg m-3 K-1. + ! layer with temperature [kg m-3 degC-1]. dR_dS, & ! Partial derivative of the density in the bottom boundary - ! layer with salinity, in units of kg m-3 psu-1. - press ! The pressure at which dR_dT and dR_dS are evaluated, in Pa. - real :: htot ! Sum of the layer thicknesses up to some - ! point [H ~> m or kg m-2]. - real :: htot_vel ! Sum of the layer thicknesses up to some - ! point [H ~> m or kg m-2]. - - real :: Rhtot ! Running sum of thicknesses times the layer potential - ! densities [H kg m-3 ~> kg m-2 or kg2 m-5]. + ! layer with salinity [kg m-3 PSU-1]. + press ! The pressure at which dR_dT and dR_dS are evaluated [Pa]. + real :: htot ! Sum of the layer thicknesses up to some point [H ~> m or kg m-2]. + real :: htot_vel ! Sum of the layer thicknesses up to some point [H ~> m or kg m-2]. + + real :: Rhtot ! Running sum of thicknesses times the layer potential + ! densities [H kg m-3 ~> kg m-2 or kg2 m-5]. real, dimension(SZIB_(G),SZJ_(G)) :: & - D_u, & ! Bottom depth interpolated to u points, in depth units (m). + D_u, & ! Bottom depth interpolated to u points [Z ~> m]. mask_u ! A mask that disables any contributions from u points that - ! are land or past open boundary conditions, nondim., 0 or 1. + ! are land or past open boundary conditions [nondim], 0 or 1. real, dimension(SZI_(G),SZJB_(G)) :: & - D_v, & ! Bottom depth interpolated to v points, in depth units (m). + D_v, & ! Bottom depth interpolated to v points [Z ~> m]. mask_v ! A mask that disables any contributions from v points that - ! are land or past open boundary conditions, nondim., 0 or 1. + ! are land or past open boundary conditions [nondim], 0 or 1. real, dimension(SZIB_(G),SZK_(G)) :: & h_at_vel, & ! Layer thickness at a velocity point, using an upwind-biased ! second order accurate estimate based on the previous velocity @@ -157,11 +155,11 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) h_vel, & ! Arithmetic mean of the layer thicknesses adjacent to a ! velocity point [H ~> m or kg m-2]. T_vel, & ! Arithmetic mean of the layer temperatures adjacent to a - ! velocity point, in degC. + ! velocity point [degC]. S_vel, & ! Arithmetic mean of the layer salinities adjacent to a - ! velocity point, in PSU. + ! velocity point [PSU]. Rml_vel ! Arithmetic mean of the layer coordinate densities adjacent - ! to a velocity point, in kg m-3. + ! to a velocity point [kg m-3]. real :: h_vel_pos ! The arithmetic mean thickness at a velocity point ! plus H_neglect to avoid 0 values [H ~> m or kg m-2]. @@ -170,7 +168,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! from m to thickness units, in kg m-2 or kg2 m-5. real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion ! factor from lateral lengths to vertical depths [Z m-1 ~> 1]. - real :: cdrag_sqrt ! Square root of the drag coefficient, nd. + real :: cdrag_sqrt ! Square root of the drag coefficient [nondim]. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, ! divided by G_Earth [H kg m-3 ~> kg m-2 or kg2 m-5]. @@ -195,23 +193,25 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: hweight ! The thickness of a layer that is within Hbbl ! of the bottom [H ~> m or kg m-2]. real :: v_at_u, u_at_v ! v at a u point or vice versa [m s-1]. - real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors, in kg s2 H m-3 Z-2. + real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors + ! [kg s2 H m-3 Z-2 ~> kg s2 m-4 or kg2 s2 m-7]. ! The 400 is a constant proposed by Killworth and Edwards, 1999. real, dimension(SZI_(G),SZJ_(G),max(GV%nk_rho_varies,1)) :: & - Rml ! The mixed layer coordinate density, in kg m-3. + Rml ! The mixed layer coordinate density [kg m-3]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate - ! density, in Pa (usually set to 2e7 Pa = 2000 dbar). + ! density [Pa] (usually set to 2e7 Pa = 2000 dbar). real :: D_vel ! The bottom depth at a velocity point [H ~> m or kg m-2]. real :: Dp, Dm ! The depths at the edges of a velocity cell [H ~> m or kg m-2]. real :: a ! a is the curvature of the bottom depth across a ! cell, times the cell width squared [H ~> m or kg m-2]. - real :: a_3, a_12, C24_a ! a/3, a/12, and 24/a [H ~> m or kg m-2], H, and H-1. + real :: a_3, a_12 ! a/3 and a/12 [H ~> m or kg m-2]. + real :: C24_a ! 24/a [H-1 ~> m-1 or m2 kg-1]. real :: slope ! The absolute value of the bottom depth slope across ! a cell times the cell width [H ~> m or kg m-2]. real :: apb_4a, ax2_3apb ! Various nondimensional ratios of a and slope. - real :: a2x48_apb3, Iapb, Ibma_2 ! Combinations of a and slope with units of H-1. - ! All of the following "volumes" have units of meters as they are normalized + real :: a2x48_apb3, Iapb, Ibma_2 ! Combinations of a and slope [H-1 ~> m-1 or m2 kg-1]. + ! All of the following "volumes" have units of thickness because they are normalized ! by the full horizontal area of a velocity cell. real :: Vol_open ! The cell volume above which it is open [H ~> m or kg m-2]. real :: Vol_direct ! With less than Vol_direct [H ~> m or kg m-2], there is a direct @@ -228,12 +228,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: Vol_tol ! A volume error tolerance [H ~> m or kg m-2]. real :: L(SZK_(G)+1) ! The fraction of the full cell width that is open at ! the depth of each interface, nondimensional. - real :: L_direct ! The value of L above volume Vol_direct, nondim. + real :: L_direct ! The value of L above volume Vol_direct [nondim]. real :: L_max, L_min ! Upper and lower bounds on the correct value for L. real :: Vol_err_max ! The volume errors for the upper and lower bounds on real :: Vol_err_min ! the correct value for L [H ~> m or kg m-2]. real :: Vol_0 ! A deeper volume with known width L0 [H ~> m or kg m-2]. - real :: L0 ! The value of L above volume Vol_0, nondim. + real :: L0 ! The value of L above volume Vol_0 [nondim]. real :: dVol ! vol - Vol_0 [H ~> m or kg m-2]. real :: dV_dL2 ! The partial derivative of volume with L squared ! evaluated at L=L0 [H ~> m or kg m-2]. @@ -247,11 +247,11 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! velocity magnitude to give the Rayleigh drag velocity, times ! a lateral to vertical distance conversion factor [Z L-1 ~> 1]. real :: gam ! The ratio of the change in the open interface width - ! to the open interface width atop a cell, nondim. + ! to the open interface width atop a cell [nondim]. real :: BBL_frac ! The fraction of a layer's drag that goes into the - ! viscous bottom boundary layer, nondim. + ! viscous bottom boundary layer [nondim]. real :: BBL_visc_frac ! The fraction of all the drag that is expressed as - ! a viscous bottom boundary layer, nondim. + ! a viscous bottom boundary layer [nondim]. real, parameter :: C1_3 = 1.0/3.0, C1_6 = 1.0/6.0, C1_12 = 1.0/12.0 real :: C2pi_3 ! An irrational constant, 2/3 pi. real :: tmp ! A temporary variable. @@ -1022,11 +1022,11 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri htot, & ! The total depth of the layers being that are within the ! surface mixed layer [H ~> m or kg m-2]. Thtot, & ! The integrated temperature of layers that are within the - ! surface mixed layer [H degC ~> m degC or kg degC m-2] + ! surface mixed layer [H degC ~> m degC or kg degC m-2]. Shtot, & ! The integrated salt of layers that are within the ! surface mixed layer [H PSU ~> m PSU or kg PSU m-2]. - Rhtot, & ! The integrated density of layers that are within the - ! surface mixed layer, [H kg m-3 ~> kg m-2 or kg2 m-5]. Rhtot is only used if no + Rhtot, & ! The integrated density of layers that are within the surface mixed layer + ! [H kg m-3 ~> kg m-2 or kg2 m-5]. Rhtot is only used if no ! equation of state is used. uhtot, & ! The depth integrated zonal and meridional velocities within vhtot, & ! the surface mixed layer [H m s-1 ~> m2 s-1 or kg m-1 s-1]. @@ -1036,15 +1036,15 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri dR_dS, & ! Partial derivative of the density at the base of layer nkml ! (roughly the base of the mixed layer) with salinity [kg m-3 psu-1]. ustar, & ! The surface friction velocity under ice shelves [Z s-1 ~> m s-1]. - press, & ! The pressure at which dR_dT and dR_dS are evaluated, in Pa. + press, & ! The pressure at which dR_dT and dR_dS are evaluated [Pa]. T_EOS, & ! The potential temperature at which dR_dT and dR_dS are evaluated [degC] S_EOS ! The salinity at which dR_dT and dR_dS are evaluated [PSU]. real, dimension(SZIB_(G),SZJ_(G)) :: & mask_u ! A mask that disables any contributions from u points that - ! are land or past open boundary conditions, nondim., 0 or 1. + ! are land or past open boundary conditions [nondim], 0 or 1. real, dimension(SZI_(G),SZJB_(G)) :: & mask_v ! A mask that disables any contributions from v points that - ! are land or past open boundary conditions, nondim., 0 or 1. + ! are land or past open boundary conditions [nondim], 0 or 1. real :: h_at_vel(SZIB_(G),SZK_(G))! Layer thickness at velocity points, ! using an upwind-biased second order accurate estimate based ! on the previous velocity direction [H ~> m or kg m-2]. @@ -1055,8 +1055,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! integrated through the mixed layer and the velocity of the ! interior layer layer times the depth of the the mixed layer ! [H2 m2 s-2 ~> m4 s-2 or kg2 m-2 s-2]. - real :: htot_vel ! Sum of the layer thicknesses up to some - ! point [H ~> m or kg m-2]. + real :: htot_vel ! Sum of the layer thicknesses up to some point [H ~> m or kg m-2]. real :: hwtot ! Sum of the thicknesses used to calculate ! the near-bottom velocity magnitude [H ~> m or kg m-2]. real :: hutot ! Running sum of thicknesses times the @@ -1067,10 +1066,10 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real :: hlay ! The layer thickness at velocity points [H ~> m or kg m-2]. real :: I_2hlay ! 1 / 2*hlay [H-1 ~> m-1 or m2 kg-1]. - real :: T_lay ! The layer temperature at velocity points, in deg C. - real :: S_lay ! The layer salinity at velocity points, in PSU. - real :: Rlay ! The layer potential density at velocity points, in kg m-3. - real :: Rlb ! The potential density of the layer below, in kg m-3. + real :: T_lay ! The layer temperature at velocity points [degC]. + real :: S_lay ! The layer salinity at velocity points [PSU]. + real :: Rlay ! The layer potential density at velocity points [kg m-3]. + real :: Rlb ! The potential density of the layer below [kg m-3]. real :: v_at_u ! The meridonal velocity at a zonal velocity point in m s-1. real :: u_at_v ! The zonal velocity at a meridonal velocity point in m s-1. real :: gHprime ! The mixed-layer internal gravity wave speed squared, based @@ -1080,15 +1079,15 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! viscous mixed layer, including reduction for turbulent ! decay. Nondimensional. real :: dt_Rho0 ! The time step divided by the conversion from the layer - ! thickness to layer mass, in s H m2 kg-1. - real :: g_H_Rho0 ! The gravitational acceleration times the conversion from - ! H to m divided by the mean density, in m5 s-2 H-1 kg-1. + ! thickness to layer mass [s H m2 kg-1 ~> s m3 kg-1 or s]. + real :: g_H_Rho0 ! The gravitational acceleration times the conversion from H to m divided + ! by the mean density [m5 s-2 H-1 kg-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2]. real :: ustarsq ! 400 times the square of ustar, times ! Rho0 divided by G_Earth and the conversion - ! from m to thickness units, in kg m-2 or kg2 m-5. + ! from m to thickness units [H kg m-3 ~> kg m-2 or kg2 m-5]. real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion ! factor from lateral lengths to vertical depths [Z m-1 ~> 1]. - real :: cdrag_sqrt ! Square root of the drag coefficient, ND. + real :: cdrag_sqrt ! Square root of the drag coefficient [nondim]. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, ! divided by G_Earth [H kg m-3 ~> kg m-2 or kg2 m-5]. @@ -1105,10 +1104,11 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real :: U_star ! The friction velocity at velocity points [Z s-1 ~> m s-1]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors, in kg s2 H m-3 Z-2. + real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors + ! [kg s2 H m-3 Z-2 ~> kg s2 m-4 or kg2 s2 m-7]. ! The 400 is a constant proposed by Killworth and Edwards, 1999. real :: ustar1 ! ustar [H s-1 ~> m s-1 or kg m-2 s-1] - real :: h2f2 ! (h*2*f)^2 + real :: h2f2 ! (h*2*f)^2 [H2 s-2 ~> m2 s-2 or kg2 m-4 s-2] logical :: use_EOS, do_any, do_any_shelf, do_i(SZIB_(G)) integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, K2, nkmb, nkml, n type(ocean_OBC_type), pointer :: OBC => NULL() diff --git a/src/parameterizations/vertical/MOM_shortwave_abs.F90 b/src/parameterizations/vertical/MOM_shortwave_abs.F90 index 7cda4285a8..991ebc84d5 100644 --- a/src/parameterizations/vertical/MOM_shortwave_abs.F90 +++ b/src/parameterizations/vertical/MOM_shortwave_abs.F90 @@ -77,17 +77,17 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, real, dimension(SZI_(G),SZK_(G)), intent(inout) :: T !< Layer potential/conservative !! temperatures [degC] real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< Penetrating shortwave heating in - !! each band that hits the bottom and - !! will be redistributed through the - !! water column (units of K*H), size - !! nsw x SZI_(G). + !! each band that hits the bottom and will + !! will be redistributed through the water + !! column [degC H ~> degC m or degC kg m-2], + !! size nsw x SZI_(G). real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: eps !< Small thickness that must remain in !! each layer, and which will not be !! subject to heating [H ~> m or kg m-2] integer, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: ksort !< Density-sorted k-indicies. real, dimension(SZI_(G)), optional, intent(in) :: htot !< Total mixed layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G)), optional, intent(inout) :: Ttot !< Depth integrated mixed layer - !! temperature (units of K H). + !! temperature [degC H ~> degC m or degC kg m-2] real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: dSV_dT !< The partial derivative of specific !! volume with temperature, in m3 kg-1 K-1. real, dimension(SZI_(G),SZK_(G)), optional, intent(inout) :: TKE !< The TKE sink from mixing the heating @@ -95,7 +95,7 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & T_chg_above ! A temperature change that will be applied to all the thick - ! layers above a given layer, in K. This is only nonzero if + ! layers above a given layer [degC]. This is only nonzero if ! adjustAbsorptionProfile is true, in which case the net ! change in the temperature of a layer is the sum of the ! direct heating of that layer plus T_chg_above from all of @@ -108,7 +108,7 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, ! shortwave radiation and contributions from T_chg_above, in K. Pen_SW_rem ! The sum across all wavelength bands of the penetrating shortwave ! heating that hits the bottom and will be redistributed through - ! the water column (in units of K H) + ! the water column [degC H ~> degC m or degC kg m-2] real :: SW_trans ! fraction of shortwave radiation that is not ! absorbed in a layer (nondimensional) real :: unabsorbed ! fraction of the shortwave radiation that @@ -116,18 +116,18 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, real :: Ih_limit ! inverse of the total depth at which the ! surface fluxes start to be limited [H-1 ~> m-1 or m2 kg-1] real :: h_min_heat ! minimum thickness layer that should get heated [H ~> m or kg m-2] - real :: opt_depth ! optical depth of a layer (non-dim) - real :: exp_OD ! exp(-opt_depth) (non-dim) + real :: opt_depth ! optical depth of a layer [nondim] + real :: exp_OD ! exp(-opt_depth) [nondim] real :: heat_bnd ! heating due to absorption in the current ! layer by the current band, including any piece that - ! is moved upward (K H units) + ! is moved upward [degC H ~> degC m or degC kg m-2] real :: SWa ! fraction of the absorbed shortwave that is - ! moved to layers above with adjustAbsorptionProfile (non-dim) + ! moved to layers above with adjustAbsorptionProfile [nondim] real :: coSWa_frac ! The fraction of SWa that is actually moved upward. - real :: min_SW_heating ! A minimum remaining shortwave heating rate that will be - ! simply absorbed in the next layer for computational - ! efficiency, instead of continuing to penetrate, in units - ! of K H s-1. The default, 2.5e-11, is about 0.08 K m / century. + real :: min_SW_heating ! A minimum remaining shortwave heating rate that will be simply + ! absorbed in the next layer for computational efficiency, instead of + ! continuing to penetrate [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1]. + ! The default, 2.5e-11, is about 0.08 degC m / century. real :: epsilon ! A small thickness that must remain in each ! layer, and which will not be subject to heating [H ~> m or kg m-2] real :: I_G_Earth @@ -310,7 +310,7 @@ subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & integer, intent(in) :: nsw !< number of bands of penetrating !! shortwave radiation. integer, intent(in) :: j !< j-index to work on. - real, intent(in) :: dt !< Time step (seconds). + real, intent(in) :: dt !< Time step [s]. real, intent(in) :: H_limit_fluxes !< the total depth at which the !! surface fluxes start to be limited to avoid !! excessive heating of a thin ocean [H ~> m or kg m-2] @@ -319,17 +319,18 @@ subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & real, dimension(:,:), intent(in) :: iPen_SW_bnd !< The incident penetrating shortwave !! heating in each band that hits the bottom and !! will be redistributed through the water column - !! (K H units); size nsw x SZI_(G). + !! [degC H ~> degC m or degC kg m-2]; size nsw x SZI_(G). real, dimension(SZI_(G),SZK_(G)+1), & intent(inout) :: netPen !< Net penetrating shortwave heat flux at each - !! interface, summed across all bands, in K H. + !! interface, summed across all bands + !! [degC H ~> degC m or degC kg m-2]. ! Local variables real :: h_heat(SZI_(G)) ! thickness of the water column that receives ! remaining shortwave radiation [H ~> m or kg m-2]. real :: Pen_SW_rem(SZI_(G)) ! sum across all wavelength bands of the ! penetrating shortwave heating that hits the bottom ! and will be redistributed through the water column - ! (K H units) + ! [degC H ~> degC m or degC kg m-2] real, dimension(size(iPen_SW_bnd,1),size(iPen_SW_bnd,2)) :: Pen_SW_bnd real :: SW_trans ! fraction of shortwave radiation not @@ -337,10 +338,10 @@ subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & real :: unabsorbed ! fraction of the shortwave radiation ! not absorbed because the layers are too thin. real :: Ih_limit ! inverse of the total depth at which the - ! surface fluxes start to be limited (1/H units) + ! surface fluxes start to be limited [H-1 ~> m-1 or m2 kg-1] real :: h_min_heat ! minimum thickness layer that should get heated [H ~> m or kg m-2] - real :: opt_depth ! optical depth of a layer (non-dim) - real :: exp_OD ! exp(-opt_depth) (non-dim) + real :: opt_depth ! optical depth of a layer [nondim] + real :: exp_OD ! exp(-opt_depth) [nondim] logical :: SW_Remains ! If true, some column has shortwave radiation that ! was not entirely absorbed. diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 2e8809529c..91853f8c4e 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -175,21 +175,18 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! Local variables - real :: b1(SZIB_(G)) ! b1 and c1 are variables used by the - real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. c1 is nondimensional, - ! while b1 has units of inverse thickness. - real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver, ND. + real :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. + real :: c1(SZIB_(G),SZK_(G)) ! A variable used by the tridiagonal solver [nondim]. + real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver [nondim]. real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity [Z s-1 ~> m s-1]. real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. real :: Hmix ! The mixed layer thickness over which stress ! is applied with direct_stress [H ~> m or kg m-2]. real :: I_Hmix ! The inverse of Hmix [H-1 ~> m-1 or m2 kg-1]. - real :: Idt ! The inverse of the time step, in s-1. - real :: dt_Rho0 ! The time step divided by the mean - ! density, in s m3 kg-1. - real :: Rho0 ! A density used to convert drag laws into stress in - ! Pa, in kg m-3. + real :: Idt ! The inverse of the time step [s-1]. + real :: dt_Rho0 ! The time step divided by the mean density [s m3 kg-1]. + real :: Rho0 ! A density used to convert drag laws into stress in Pa [kg m-3]. real :: dt_Z_to_H ! The time step times the conversion from Z to the ! units of thickness - [s H Z-1 ~> s or s kg m-3]. real :: h_neglect ! A thickness that is so small it is usually lost @@ -465,26 +462,24 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) type(vertvisc_type), intent(in) :: visc !< Viscosities and bottom drag real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: visc_rem_u !< Fraction of a time-step's worth of a - !! barotopic acceleration that a layer experiences - !! after viscosity is applied in the zonal direction + !! barotopic acceleration that a layer experiences after + !! viscosity is applied in the zonal direction [nondim] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(inout) :: visc_rem_v !< Fraction of a time-step's worth of a - !! barotopic acceleration that a layer experiences - !! after viscosity is applied in the meridional direction + !! barotopic acceleration that a layer experiences after + !! viscosity is applied in the meridional direction [nondim] real, intent(in) :: dt !< Time increment in s type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure ! Local variables - real :: b1(SZIB_(G)) ! b1 and c1 are variables used by the - real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. c1 is nondimensional, - ! while b1 has units of inverse thickness. - real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver, ND. - real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity times the - ! time step, in m. + real :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. + real :: c1(SZIB_(G),SZK_(G)) ! A variable used by the tridiagonal solver [nondim]. + real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver [nondim]. + real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity times the time step [m]. real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. real :: dt_Z_to_H ! The time step times the conversion from Z to the - ! units of thickness - either s or s m3 kg-1. + ! units of thickness [s H Z-1 ~> s or s kg m-3]. logical :: do_i(SZIB_(G)) integer :: i, j, k, is, ie, Isq, Ieq, Jsq, Jeq, nz @@ -1074,7 +1069,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, real, dimension(SZIB_(G)) :: & u_star, & ! ustar at a velocity point [Z s-1 ~> m s-1]. - absf, & ! The average of the neighboring absolute values of f, in s-1. + absf, & ! The average of the neighboring absolute values of f [s-1]. ! h_ml, & ! The mixed layer depth [H ~> m or kg m-2]. nk_visc, & ! The (real) interface index of the base of mixed layer. z_t, & ! The distance from the top, sometimes normalized diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index b7d9dba592..19e32fe057 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -71,7 +71,7 @@ module MOM_neutral_diffusion real, allocatable, dimension(:,:,:) :: dRdS !< dRho/dS (kg/m3/ppt) at interfaces real, allocatable, dimension(:,:,:) :: Tint !< Interface T (degC) real, allocatable, dimension(:,:,:) :: Sint !< Interface S (ppt) - real, allocatable, dimension(:,:,:) :: Pint !< Interface pressure (Pa) + real, allocatable, dimension(:,:,:) :: Pint !< Interface pressure [Pa] ! Variables needed for discontinuous reconstructions real, allocatable, dimension(:,:,:,:) :: T_i !< Top edge reconstruction of temperature (degC) real, allocatable, dimension(:,:,:,:) :: S_i !< Top edge reconstruction of salinity (ppt) @@ -808,12 +808,12 @@ end function fvlsq_slope subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdSl, Pr, Tr, Sr, & dRdTr, dRdSr, PoL, PoR, KoL, KoR, hEff) integer, intent(in) :: nk !< Number of levels - real, dimension(nk+1), intent(in) :: Pl !< Left-column interface pressure (Pa) + real, dimension(nk+1), intent(in) :: Pl !< Left-column interface pressure [Pa] real, dimension(nk+1), intent(in) :: Tl !< Left-column interface potential temperature (degC) real, dimension(nk+1), intent(in) :: Sl !< Left-column interface salinity (ppt) real, dimension(nk+1), intent(in) :: dRdTl !< Left-column dRho/dT (kg/m3/degC) real, dimension(nk+1), intent(in) :: dRdSl !< Left-column dRho/dS (kg/m3/ppt) - real, dimension(nk+1), intent(in) :: Pr !< Right-column interface pressure (Pa) + real, dimension(nk+1), intent(in) :: Pr !< Right-column interface pressure [Pa] real, dimension(nk+1), intent(in) :: Tr !< Right-column interface potential temperature (degC) real, dimension(nk+1), intent(in) :: Sr !< Right-column interface salinity (ppt) real, dimension(nk+1), intent(in) :: dRdTr !< Left-column dRho/dT (kg/m3/degC) @@ -824,7 +824,7 @@ subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdS !! layer KoR of right column integer, dimension(2*nk+2), intent(inout) :: KoL !< Index of first left interface above neutral surface integer, dimension(2*nk+2), intent(inout) :: KoR !< Index of first right interface above neutral surface - real, dimension(2*nk+1), intent(inout) :: hEff !< Effective thickness between two neutral surfaces (Pa) + real, dimension(2*nk+1), intent(inout) :: hEff !< Effective thickness between two neutral surfaces [Pa] ! Local variables integer :: ns ! Number of neutral surfaces @@ -993,14 +993,14 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, Pres_l, hcol type(neutral_diffusion_CS), intent(inout) :: CS !< Neutral diffusion control structure integer, intent(in) :: nk !< Number of levels integer, intent(in) :: ns !< Number of neutral surfaces - real, dimension(nk+1), intent(in) :: Pres_l !< Left-column interface pressure (Pa) + real, dimension(nk+1), intent(in) :: Pres_l !< Left-column interface pressure [Pa] real, dimension(nk), intent(in) :: hcol_l !< Left-column layer thicknesses real, dimension(nk,2), intent(in) :: Tl !< Left-column top interface potential temperature (degC) real, dimension(nk,2), intent(in) :: Sl !< Left-column top interface salinity (ppt) real, dimension(nk,2), intent(in) :: dRdT_l !< Left-column, top interface dRho/dT (kg/m3/degC) real, dimension(nk,2), intent(in) :: dRdS_l !< Left-column, top interface dRho/dS (kg/m3/ppt) logical, dimension(nk), intent(in) :: stable_l !< Left-column, top interface dRho/dS (kg/m3/ppt) - real, dimension(nk+1), intent(in) :: Pres_r !< Right-column interface pressure (Pa) + real, dimension(nk+1), intent(in) :: Pres_r !< Right-column interface pressure [Pa] real, dimension(nk), intent(in) :: hcol_r !< Left-column layer thicknesses real, dimension(nk,2), intent(in) :: Tr !< Right-column top interface potential temperature (degC) real, dimension(nk,2), intent(in) :: Sr !< Right-column top interface salinity (ppt) @@ -1013,7 +1013,7 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, Pres_l, hcol !! layer KoR of right column integer, dimension(4*nk), intent(inout) :: KoL !< Index of first left interface above neutral surface integer, dimension(4*nk), intent(inout) :: KoR !< Index of first right interface above neutral surface - real, dimension(4*nk-1), intent(inout) :: hEff !< Effective thickness between two neutral surfaces (Pa) + real, dimension(4*nk-1), intent(inout) :: hEff !< Effective thickness between two neutral surfaces [Pa] real, dimension(nk,CS%deg+1), & optional, intent(in) :: ppoly_T_l !< Left-column coefficients of T reconstruction real, dimension(nk,CS%deg+1), & @@ -1264,7 +1264,7 @@ end subroutine find_neutral_surface_positions_discontinuous real function absolute_position(n,ns,Pint,Karr,NParr,k_surface) integer, intent(in) :: n !< Number of levels integer, intent(in) :: ns !< Number of neutral surfaces - real, intent(in) :: Pint(n+1) !< Position of interfaces (Pa) + real, intent(in) :: Pint(n+1) !< Position of interfaces [Pa] integer, intent(in) :: Karr(ns) !< Index of interface above position real, intent(in) :: NParr(ns) !< Non-dimensional position within layer Karr(:) integer, intent(in) :: k_surface !< k-interface to query @@ -1281,11 +1281,11 @@ end function absolute_position function absolute_positions(n,ns,Pint,Karr,NParr) integer, intent(in) :: n !< Number of levels integer, intent(in) :: ns !< Number of neutral surfaces - real, intent(in) :: Pint(n+1) !< Position of interface (Pa) + real, intent(in) :: Pint(n+1) !< Position of interface [Pa] integer, intent(in) :: Karr(ns) !< Indexes of interfaces about positions real, intent(in) :: NParr(ns) !< Non-dimensional positions within layers Karr(:) - real, dimension(ns) :: absolute_positions ! Absolute positions (Pa) + real, dimension(ns) :: absolute_positions ! Absolute positions [Pa] ! Local variables integer :: k_surface, k @@ -1302,8 +1302,8 @@ subroutine neutral_surface_flux(nk, nsurf, deg, hl, hr, Tl, Tr, PiL, PiR, KoL, K integer, intent(in) :: nk !< Number of levels integer, intent(in) :: nsurf !< Number of neutral surfaces integer, intent(in) :: deg !< Degree of polynomial reconstructions - real, dimension(nk), intent(in) :: hl !< Left-column layer thickness (Pa) - real, dimension(nk), intent(in) :: hr !< Right-column layer thickness (Pa) + real, dimension(nk), intent(in) :: hl !< Left-column layer thickness [Pa] + real, dimension(nk), intent(in) :: hr !< Right-column layer thickness [Pa] real, dimension(nk), intent(in) :: Tl !< Left-column layer tracer (conc, e.g. degC) real, dimension(nk), intent(in) :: Tr !< Right-column layer tracer (conc, e.g. degC) real, dimension(nsurf), intent(in) :: PiL !< Fractional position of neutral surface @@ -1312,7 +1312,7 @@ subroutine neutral_surface_flux(nk, nsurf, deg, hl, hr, Tl, Tr, PiL, PiR, KoL, K !! within layer KoR of right column integer, dimension(nsurf), intent(in) :: KoL !< Index of first left interface above neutral surface integer, dimension(nsurf), intent(in) :: KoR !< Index of first right interface above neutral surface - real, dimension(nsurf-1), intent(in) :: hEff !< Effective thickness between two neutral surfaces (Pa) + real, dimension(nsurf-1), intent(in) :: hEff !< Effective thickness between two neutral surfaces [Pa] real, dimension(nsurf-1), intent(inout) :: Flx !< Flux of tracer between pairs of neutral layers (conc H) logical, intent(in) :: continuous !< True if using continuous reconstruction real, intent(in) :: h_neglect !< A negligibly small width for the @@ -1992,7 +1992,7 @@ logical function test_fv_diff(verbose, hkm1, hk, hkp1, Skm1, Sk, Skp1, Ptrue, ti real, intent(in) :: Skm1 !< Left cell average value real, intent(in) :: Sk !< Center cell average value real, intent(in) :: Skp1 !< Right cell average value - real, intent(in) :: Ptrue !< True answer (Pa) + real, intent(in) :: Ptrue !< True answer [Pa] character(len=*), intent(in) :: title !< Title for messages ! Local variables @@ -2024,7 +2024,7 @@ logical function test_fvlsq_slope(verbose, hkm1, hk, hkp1, Skm1, Sk, Skp1, Ptrue real, intent(in) :: Skm1 !< Left cell average value real, intent(in) :: Sk !< Center cell average value real, intent(in) :: Skp1 !< Right cell average value - real, intent(in) :: Ptrue !< True answer (Pa) + real, intent(in) :: Ptrue !< True answer [Pa] character(len=*), intent(in) :: title !< Title for messages ! Local variables @@ -2051,10 +2051,10 @@ end function test_fvlsq_slope logical function test_ifndp(verbose, rhoNeg, Pneg, rhoPos, Ppos, Ptrue, title) logical, intent(in) :: verbose !< If true, write results to stdout real, intent(in) :: rhoNeg !< Lighter density (kg/m3) - real, intent(in) :: Pneg !< Interface position of lighter density (Pa) + real, intent(in) :: Pneg !< Interface position of lighter density [Pa] real, intent(in) :: rhoPos !< Heavier density (kg/m3) - real, intent(in) :: Ppos !< Interface position of heavier density (Pa) - real, intent(in) :: Ptrue !< True answer (Pa) + real, intent(in) :: Ppos !< Interface position of heavier density [Pa] + real, intent(in) :: Ptrue !< True answer [Pa] character(len=*), intent(in) :: title !< Title for messages ! Local variables @@ -2156,7 +2156,7 @@ logical function test_nsp(verbose, ns, KoL, KoR, pL, pR, hEff, KoL0, KoR0, pL0, integer, dimension(ns), intent(in) :: KoR !< Index of first right interface above neutral surface real, dimension(ns), intent(in) :: pL !< Fractional position of neutral surface within layer KoL of left column real, dimension(ns), intent(in) :: pR !< Fractional position of neutral surface within layer KoR of right column - real, dimension(ns-1), intent(in) :: hEff !< Effective thickness between two neutral surfaces (Pa) + real, dimension(ns-1), intent(in) :: hEff !< Effective thickness between two neutral surfaces [Pa] integer, dimension(ns), intent(in) :: KoL0 !< Correct value for KoL integer, dimension(ns), intent(in) :: KoR0 !< Correct value for KoR real, dimension(ns), intent(in) :: pL0 !< Correct value for pL diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index ab80d00481..4d28375426 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -28,7 +28,7 @@ module MOM_tracer_advect !> Control structure for this module type, public :: tracer_advect_CS ; private - real :: dt !< The baroclinic dynamics time step, in s. + real :: dt !< The baroclinic dynamics time step [s]. type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the !< timing of diagnostic output. logical :: debug !< If true, write verbose checksums for debugging purposes. @@ -52,40 +52,42 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_end !< layer thickness after advection (m or kg m-2) + intent(in) :: h_end !< layer thickness after advection [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: uhtr !< accumulated volume/mass flux through zonal face (m3 or kg) + intent(in) :: uhtr !< accumulated volume/mass flux through zonal face [H m2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: vhtr !< accumulated volume/mass flux through merid face (m3 or kg) + intent(in) :: vhtr !< accumulated volume/mass flux through merid face [H m2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used real, intent(in) :: dt !< time increment (seconds) type(tracer_advect_CS), pointer :: CS !< control structure for module type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - optional, intent(in) :: h_prev_opt !< layer thickness before advection (m or kg m-2) + optional, intent(in) :: h_prev_opt !< layer thickness before advection [H ~> m or kg m-2] integer, optional, intent(in) :: max_iter_in !< The maximum number of iterations logical, optional, intent(in) :: x_first_in !< If present, indicate whether to update !! first in the x- or y-direction. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - optional, intent(out) :: uhr_out !< accumulated volume/mass flux through zonal face (m3 or kg) + optional, intent(out) :: uhr_out !< accumulated volume/mass flux through zonal face + !! [H m2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - optional, intent(out) :: vhr_out !< accumulated volume/mass flux through merid face (m3 or kg) + optional, intent(out) :: vhr_out !< accumulated volume/mass flux through merid face + !! [H m2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - optional, intent(out) :: h_out !< layer thickness before advection (m or kg m-2) + optional, intent(out) :: h_out !< layer thickness before advection [H ~> m or kg m-2] type(tracer_type) :: Tr(MAX_FIELDS_) ! The array of registered tracers real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - hprev ! cell volume at the end of previous tracer change (m3) + hprev ! cell volume at the end of previous tracer change [H m2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & - uhr ! The remaining zonal thickness flux (m3) + uhr ! The remaining zonal thickness flux [H m2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & - vhr ! The remaining meridional thickness fluxes (m3) + vhr ! The remaining meridional thickness fluxes [H m2 ~> m3 or kg] real :: uh_neglect(SZIB_(G),SZJ_(G)) ! uh_neglect and vh_neglect are the real :: vh_neglect(SZI_(G),SZJB_(G)) ! magnitude of remaining transports that - ! can be simply discarded (m3 or kg). + ! can be simply discarded [H m2 ~> m3 or kg]. - real :: landvolfill ! An arbitrary? nonzero cell volume, m3. - real :: Idt ! 1/dt in s-1. + real :: landvolfill ! An arbitrary? nonzero cell volume [H m2 ~> m3 or kg]. + real :: Idt ! 1/dt [s-1]. logical :: domore_u(SZJ_(G),SZK_(G)) ! domore__ indicate whether there is more logical :: domore_v(SZJB_(G),SZK_(G)) ! advection to be done in the corresponding ! row or column. @@ -336,7 +338,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used logical, dimension(SZJ_(G),SZK_(G)), intent(inout) :: domore_u !< If true, there is more advection to be !! done in this u-row - real, intent(in) :: Idt !< The inverse of dt, in s-1 + real, intent(in) :: Idt !< The inverse of dt [s-1] integer, intent(in) :: ntr !< The number of tracers integer, intent(in) :: is !< The starting tracer i-index to work on integer, intent(in) :: ie !< The ending tracer i-index to work on @@ -349,7 +351,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & real, dimension(SZI_(G),ntr) :: & slope_x ! The concentration slope per grid point in units of - ! concentration (nondim.). + ! concentration [nondim]. real, dimension(SZIB_(G),ntr) :: & flux_x ! The tracer flux across a boundary in m3*conc or kg*conc. real :: maxslope ! The maximum concentration slope per grid point @@ -357,11 +359,11 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & real :: hup, hlos ! hup is the upwind volume, hlos is the ! part of that volume that might be lost ! due to advection out the other side of - ! the grid box, both in m3 or kg. + ! the grid box, both in [H m2 ~> m3 or kg]. real :: uhh(SZIB_(G)) ! The zonal flux that occurs during the - ! current iteration, in m3 or kg. + ! current iteration [H m2 ~> m3 or kg]. real, dimension(SZIB_(G)) :: & - hlst, Ihnew, & ! Work variables with units of m3 or kg and m-3 or kg-1. + hlst, Ihnew, & ! Work variables with units of [H m2 ~> m3 or kg] and [H-1 m-2 ~> m-3 or kg-1]. CFL ! A nondimensional work variable. real :: min_h ! The minimum thickness that can be realized during ! any of the passes, in m or kg m-2. @@ -683,18 +685,18 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & real :: maxslope ! The maximum concentration slope per grid point ! consistent with monotonicity, in conc. (nondim.). real :: vhh(SZI_(G),SZJB_(G)) ! The meridional flux that occurs during the - ! current iteration, in m3 or kg. + ! current iteration [H m2 ~> m3 or kg]. real :: hup, hlos ! hup is the upwind volume, hlos is the ! part of that volume that might be lost ! due to advection out the other side of - ! the grid box, both in m3 or kg. + ! the grid box, both in [H m2 ~> m3 or kg]. real, dimension(SZIB_(G)) :: & - hlst, Ihnew, & ! Work variables with units of m3 or kg and m-3 or kg-1. + hlst, Ihnew, & ! Work variables with units of [H m2 ~> m3 or kg] and [H-1 m-2 ~> m-3 or kg-1]. CFL ! A nondimensional work variable. real :: min_h ! The minimum thickness that can be realized during - ! any of the passes, in m or kg m-2. + ! any of the passes [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m. + ! in roundoff and can be neglected [H ~> m or kg m-2]. logical :: do_j_tr(SZJ_(G)) ! If true, calculate the tracer profiles. logical :: do_i(SZIB_(G)) ! If true, work on given points. logical :: do_any_i diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index 22a8c98ca5..90de360e6d 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -26,11 +26,12 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & sfc_flux, btm_flux, btm_reservoir, sink_rate, convert_flux_in) type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< layer thickness before entrainment (m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< layer thickness before entrainment + !! [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: ea !< amount of fluid entrained from the layer - !! above (units of h_work) + !! above [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: eb !< amount of fluid entrained from the layer - !! below (units of h_work) + !! below [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: tr !< tracer concentration (in concentration units CU) real, intent(in) :: dt !< amount of time covered by this call (seconds) real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: sfc_flux !< surface flux of the tracer in units @@ -53,7 +54,7 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & real, dimension(SZI_(G)) :: & b1, & !< b1 is used by the tridiagonal solver, in m-1 or m2 kg-1. d1 !! d1=1-c1 is used by the tridiagonal solver, nondimensional. - real :: c1(SZI_(G),SZK_(GV)) !< c1 is used by the tridiagonal solver, ND. + real :: c1(SZI_(G),SZK_(GV)) !< c1 is used by the tridiagonal solver [nondim]. real :: h_minus_dsink(SZI_(G),SZK_(GV)) !< The layer thickness minus the !! difference in sinking rates across the layer, in m or kg m-2. !! By construction, 0 <= h_minus_dsink < h_work. diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 288c7e2ce1..4855ff68cc 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -34,7 +34,7 @@ module MOM_tracer_hor_diff !> The ocntrol structure for along-layer and epineutral tracer diffusion type, public :: tracer_hor_diff_CS ; private - real :: dt !< The baroclinic dynamics time step, in s. + real :: dt !< The baroclinic dynamics time step [s]. real :: KhTr !< The along-isopycnal tracer diffusivity in m2/s. real :: KhTr_Slope_Cff !< The non-dimensional coefficient in KhTr formula real :: KhTr_min !< Minimum along-isopycnal tracer diffusivity in m2/s. @@ -97,7 +97,7 @@ module MOM_tracer_hor_diff subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_flag, read_khdt_x, read_khdt_y) type(ocean_grid_type), intent(inout) :: G !< Grid type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thickness (m or kg m-2) + intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, intent(in) :: dt !< time step (seconds) type(MEKE_type), pointer :: MEKE !< MEKE type type(VarMix_CS), pointer :: VarMix !< Variable mixing type @@ -125,7 +125,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla Ihdxdy, & ! The inverse of the volume or mass of fluid in a layer in a ! grid cell, in m-3 or kg-1. Kh_h, & ! The tracer diffusivity averaged to tracer points, in m2 s-1. - CFL, & ! A diffusive CFL number for each cell, nondim. + CFL, & ! A diffusive CFL number for each cell [nondim]. dTr ! The change in a tracer's concentration, in units of ! concentration. @@ -149,13 +149,13 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla integer :: i, j, k, m, is, ie, js, je, nz, ntr, itt, num_itts real :: I_numitts ! The inverse of the number of iterations, num_itts. real :: scale ! The fraction of khdt_x or khdt_y that is applied in this - ! layer for this iteration, nondim. - real :: Idt ! The inverse of the time step, in s-1. + ! layer for this iteration [nondim]. + real :: Idt ! The inverse of the time step [s-1]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in m. real :: Kh_loc ! The local value of Kh, in m2 s-1. - real :: Res_Fn ! The local value of the resolution function, nondim. - real :: Rd_dx ! The local value of deformation radius over grid-spacing, nondim. + real :: Res_Fn ! The local value of the resolution function [nondim]. + real :: Rd_dx ! The local value of deformation radius over grid-spacing [nondim]. real :: normalize ! normalization used for diagnostic Kh_h; diffusivity averaged to h-points. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -541,7 +541,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & GV, CS, tv, num_itts) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness (m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness [H ~> m or kg m-2] real, intent(in) :: dt !< time step type(tracer_type), intent(inout) :: Tr(:) !< tracer array integer, intent(in) :: ntr !< number of tracers @@ -553,18 +553,18 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & real, dimension(SZI_(G), SZJ_(G)) :: & - Rml_max ! The maximum coordinate density within the mixed layer, in kg m-3. + Rml_max ! The maximum coordinate density within the mixed layer [kg m-3]. real, dimension(SZI_(G), SZJ_(G), max(1,GV%nk_rho_varies)) :: & - rho_coord ! The coordinate density that is used to mix along, in kg m-3. + rho_coord ! The coordinate density that is used to mix along [kg m-3]. ! The naming mnemnonic is a=above,b=below,L=Left,R=Right,u=u-point,v=v-point. ! These are 1-D arrays of pointers to 2-d arrays to minimize memory usage. type(p2d), dimension(SZJ_(G)) :: & - deep_wt_Lu, deep_wt_Ru, & ! The relative weighting of the deeper of a pair, ND. + deep_wt_Lu, deep_wt_Ru, & ! The relative weighting of the deeper of a pair [nondim]. hP_Lu, hP_Ru ! The total thickness on each side for each pair, in m or kg m-2. type(p2d), dimension(SZJB_(G)) :: & - deep_wt_Lv, deep_wt_Rv, & ! The relative weighting of the deeper of a pair, ND. + deep_wt_Lv, deep_wt_Rv, & ! The relative weighting of the deeper of a pair [nondim]. hP_Lv, hP_Rv ! The total thickness on each side for each pair, in m or kg m-2. type(p2di), dimension(SZJ_(G)) :: & @@ -579,7 +579,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: Tr_flux_3d, Tr_adj_vert_L, Tr_adj_vert_R real, dimension(SZI_(G), SZK_(G), SZJ_(G)) :: & - rho_srt, & ! The density of each layer of the sorted columns, in kg m-3. + rho_srt, & ! The density of each layer of the sorted columns [kg m-3]. h_srt ! The thickness of each layer of the sorted columns, in m or kg m-2. integer, dimension(SZI_(G), SZK_(G), SZJ_(G)) :: & k0_srt ! The original k-index that each layer of the sorted column @@ -610,9 +610,9 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & nPv ! The number of epipycnal pairings at each v-point. real :: h_exclude ! A thickness that layers must attain to be considered ! for inclusion in mixing, in m. - real :: Idt ! The inverse of the time step, in s-1. + real :: Idt ! The inverse of the time step [s-1]. real :: I_maxitt ! The inverse of the maximum number of iterations. - real :: rho_pair, rho_a, rho_b ! Temporary densities, in kg m-3. + real :: rho_pair, rho_a, rho_b ! Temporary densities [kg m-3]. real :: Tr_min_face ! The minimum and maximum tracer concentrations real :: Tr_max_face ! associated with a pairing, in conc. real :: Tr_La, Tr_Lb ! The 4 tracer concentrations that might be @@ -623,7 +623,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & real :: Tr_adj_vert ! A downward vertical adjustment to Tr_flux between the ! two cells that make up one side of the pairing, in conc m3. real :: h_L, h_R ! Thicknesses to the left and right, in m or kg m-2 (H). - real :: wt_a, wt_b ! Fractional weights of layers above and below, ND. + real :: wt_a, wt_b ! Fractional weights of layers above and below [nondim]. real :: vol ! A cell volume or mass, in m3 or kg (H m2). logical, dimension(SZK_(G)) :: & left_set, & ! If true, the left or right point determines the density of diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index 0788c45c7e..c9a3baf184 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -50,8 +50,7 @@ module ideal_age_example real, dimension(NTR_MAX) :: IC_val = 0.0 !< The (uniform) initial condition value. real, dimension(NTR_MAX) :: young_val = 0.0 !< The value assigned to tr at the surface. real, dimension(NTR_MAX) :: land_val = -1.0 !< The value of tr used where land is masked out. - real, dimension(NTR_MAX) :: sfc_growth_rate !< The exponential growth rate for the surface value, - !! in units of year-1. + real, dimension(NTR_MAX) :: sfc_growth_rate !< The exponential growth rate for the surface value [year-1]. real, dimension(NTR_MAX) :: tracer_start_year !< The year in which tracers start aging, or at which the !! surface value equals young_val, in years. logical :: tracers_may_reinit !< If true, these tracers be set up via the initialization code if diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index c6eff02a02..76bb591657 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -57,8 +57,8 @@ module oil_tracer real, dimension(NTR_MAX) :: IC_val = 0.0 !< The (uniform) initial condition value. real, dimension(NTR_MAX) :: young_val = 0.0 !< The value assigned to tr at the surface. real, dimension(NTR_MAX) :: land_val = -1.0 !< The value of tr used where land is masked out. - real, dimension(NTR_MAX) :: sfc_growth_rate !< The exponential growth rate for the surface value, in units of year-1. - real, dimension(NTR_MAX) :: oil_decay_days !< Decay time scale of oil (in days) + real, dimension(NTR_MAX) :: sfc_growth_rate !< The exponential growth rate for the surface value [year-1]. + real, dimension(NTR_MAX) :: oil_decay_days !< Decay time scale of oil [days] real, dimension(NTR_MAX) :: oil_decay_rate !< Decay rate of oil (in s^-1) calculated from oil_decay_days integer, dimension(NTR_MAX) :: oil_source_k !< Layer of source logical :: oil_may_reinit !< If true, oil tracers may be reset by the initialization code diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index 621d57af8b..6fdd3f1cfe 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -42,7 +42,7 @@ module pseudo_salt_tracer real, pointer :: ps(:,:,:) => NULL() !< The array of pseudo-salt tracer used in this !! subroutine, in psu real, pointer :: diff(:,:,:) => NULL() !< The difference between the pseudo-salt - !! tracer and the real salt, in psu. + !! tracer and the real salt [PSU]. logical :: pseudo_salt_may_reinit = .true. !< Hard coding since this should not matter integer :: id_psd = -1 !< A diagnostic ID diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index edcdb002cf..77a3ea591d 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -28,11 +28,11 @@ module BFB_surface_forcing !! state variables. logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. real :: Rho0 !< The density used in the Boussinesq - !! approximation, in kg m-3. - real :: G_Earth !< The gravitational acceleration in m s-2. + !! approximation [kg m-3]. + real :: G_Earth !< The gravitational acceleration [m s-2] real :: Flux_const !< The restoring rate at the surface, in m s-1. real :: gust_const !< A constant unresolved background gustiness - !! that contributes to ustar, in Pa. + !! that contributes to ustar [Pa]. real :: SST_s !< SST at the southern edge of the linear !! forcing ramp real :: SST_n !< SST at the northern edge of the linear @@ -68,9 +68,9 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) !! BFB_surface_forcing_init. ! Local variables real :: Temp_restore ! The temperature that is being restored toward, in C. - real :: Salin_restore ! The salinity that is being restored toward, in PSU. + real :: Salin_restore ! The salinity that is being restored toward [PSU]. real :: density_restore ! The potential density that is being restored - ! toward, in kg m-3. + ! toward [kg m-3]. real :: rhoXcp ! The mean density times the heat capacity, in J m-3 K-1. real :: buoy_rest_const ! A constant relating density anomalies to the ! restoring buoyancy flux, in m5 s-3 kg-1. diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 41d65bb050..9657f602dd 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -367,7 +367,7 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) real :: RHO(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for RHO real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness, in m. real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for thickness - real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate [s-1]. real :: S_ref, T_ref ! Reference salinity and temerature within surface layer real :: S_range, T_range ! Range of salinities and temperatures over the vertical real :: e0(SZK_(G)+1) ! The resting interface heights [Z ~> m], diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 3df0d0402d..1c97a9e780 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -159,7 +159,7 @@ subroutine DOME_initialize_sponges(G, GV, US, tv, PF, CSp) real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta. real :: temp(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for other variables. ! - real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate [s-1]. real :: H0(SZK_(G)) ! Interface heights [Z ~> m]. real :: min_depth diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 47c65d60b9..0883305aa7 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -433,7 +433,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) real :: S(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for salt real :: RHO(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for RHO real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness - real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate [s-1]. real :: TNUDG ! Nudging time scale, days real :: S_sur, T_sur ! Surface salinity and temerature in sponge real :: S_bot, T_bot ! Bottom salinity and temerature in sponge diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90 index 6efa0caf4b..c29e3beded 100644 --- a/src/user/Idealized_Hurricane.F90 +++ b/src/user/Idealized_Hurricane.F90 @@ -553,7 +553,7 @@ subroutine SCM_idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) U_TS = CS%hurr_translation_spd/2.*cos(transdir) V_TS = CS%hurr_translation_spd/2.*sin(transdir) - ! Set the surface wind stresses, in units of Pa. A positive taux + ! Set the surface wind stresses, in [Pa]. A positive taux ! accelerates the ocean to the (pseudo-)east. ! The i-loop extends to is-1 so that taux can be used later in the ! calculation of ustar - otherwise the lower bound would be Isq. @@ -601,7 +601,7 @@ subroutine SCM_idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) endif forces%tauy(I,j) = CS%rho_a * G%mask2dCv(I,j) * Cd*du10*dV enddo ; enddo - ! Set the surface friction velocity, in units of m s-1. ustar is always positive. + ! Set the surface friction velocity [m s-1]. ustar is always positive. do j=js,je ; do i=is,ie ! This expression can be changed if desired, but need not be. forces%ustar(i,j) = US%m_to_Z * G%mask2dT(i,j) * sqrt(CS%gustiness/CS%Rho0 + & diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index 2034a16bb4..898160c61d 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -36,12 +36,12 @@ module MOM_controlled_forcing logical :: do_integrated !< If true, use time-integrated anomalies to control !! the surface state. integer :: num_cycle !< The number of elements in the forcing cycle. - real :: heat_int_rate !< The rate at which heating anomalies accumulate, in s-1. - real :: prec_int_rate !< The rate at which precipitation anomalies accumulate, in s-1. + real :: heat_int_rate !< The rate at which heating anomalies accumulate [s-1]. + real :: prec_int_rate !< The rate at which precipitation anomalies accumulate [s-1]. real :: heat_cyc_rate !< The rate at which cyclical heating anomaliess - !! accumulate, in s-1. + !! accumulate [s-1]. real :: prec_cyc_rate !< The rate at which cyclical precipitation anomaliess - !! accumulate, in s-1. + !! accumulate [s-1]. real :: Len2 !< The square of the length scale over which the anomalies !! are smoothed via a Laplacian filter, in m2. real :: lam_heat !< A constant of proportionality between SST anomalies @@ -81,7 +81,7 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec day_start, dt, G, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SST_anom !< The sea surface temperature - !! anomalies, in deg C. + !! anomalies [degC]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SSS_anom !< The sea surface salinity !! anomlies, in g kg-1. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SSS_mean !< The mean sea surface @@ -95,7 +95,7 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec !! subroutine, in kg m-2 s-1. type(time_type), intent(in) :: day_start !< Start time of the fluxes. real, intent(in) :: dt !< Length of time over which these - !! fluxes will be applied, in s. + !! fluxes will be applied [s]. type(ctrl_forcing_CS), pointer :: CS !< A pointer to the control structure !! returned by a previous call to !! ctrl_forcing_init. @@ -107,7 +107,7 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec flux_heat_y, & flux_prec_y type(time_type) :: day_end - real :: coef ! A heat-flux coefficient with units of m2. + real :: coef ! A heat-flux coefficient [m2]. real :: mr_st, mr_end, mr_mid, mr_prev, mr_next real :: dt_wt, dt_heat_rate, dt_prec_rate real :: dt1_heat_rate, dt1_prec_rate, dt2_heat_rate, dt2_prec_rate diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 3bd2c35553..e20fe5ccee 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -469,7 +469,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Thickness (m or kg/m2) + intent(in) :: h !< Thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: ustar !< Wind friction velocity [Z s-1 ~> m s-1]. ! Local Variables diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index ae21cd0d17..7970538c0c 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -216,14 +216,14 @@ subroutine Phillips_initialize_sponges(G, GV, US, tv, param_file, CSp, h) real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces. real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta [Z ~> m]. real :: temp(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for other variables. - real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate [s-1]. real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta [Z ~> m]. - real :: Idamp_im(SZJ_(G)) ! The inverse zonal-mean damping rate, in s-1. - real :: damp_rate ! The inverse zonal-mean damping rate, in s-1. + real :: Idamp_im(SZJ_(G)) ! The inverse zonal-mean damping rate [s-1]. + real :: damp_rate ! The inverse zonal-mean damping rate [s-1]. real :: jet_width ! The width of the zonal mean jet, in km. real :: jet_height ! The interface height scale associated with the zonal-mean jet [Z ~> m]. real :: y_2 ! The y-position relative to the channel center, in km. - real :: half_strat ! The fractional depth where the straficiation is centered, ND. + real :: half_strat ! The fractional depth where the straficiation is centered [nondim]. real :: half_depth ! The depth where the stratification is centered [Z ~> m]. character(len=40) :: mdl = "Phillips_initialize_sponges" ! This subroutine's name. @@ -352,8 +352,8 @@ end subroutine Phillips_initialize_topography !! v - Meridional velocity in m s-1. !! h - Layer thickness in m. (Must be positive.) !! D - Basin depth in m. (Must be positive.) -!! f - The Coriolis parameter, in s-1. -!! g - The reduced gravity at each interface, in m s-2. +!! f - The Coriolis parameter [s-1]. +!! g - The reduced gravity at each interface [m s-2] !! Rlay - Layer potential density (coordinate variable) in kg m-3. !! If ENABLE_THERMODYNAMICS is defined: !! T - Temperature in C. diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index 974604412e..a3f23361f7 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -177,9 +177,9 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, param_file, just_rea real :: T_range ! Range of salinities and temperatures over the vertical real :: dUdT ! Factor to convert dT/dy into dU/dz, g*alpha/f real :: dRho_dT - real :: Dml, zi, zc, zm ! Depths in units of Z. + real :: Dml, zi, zc, zm ! Depths [Z ~> m]. real :: f, Ty - real :: hAtU ! Interpolated layer thickness in units of Z. + real :: hAtU ! Interpolated layer thickness [Z ~> m]. integer :: i, j, k, is, ie, js, je, nz logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: verticalCoordinate diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index 6ae086006a..cfbad108f2 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -34,7 +34,7 @@ module benchmark_initialization subroutine benchmark_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth in m or [Z ~> m] if US is present type(param_file_type), intent(in) :: param_file !< Parameter file structure real, intent(in) :: max_depth !< Maximum model depth in the units of D type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type @@ -104,8 +104,8 @@ subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state ! in depth units [Z ~> m]. real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! positive upward, in depth units [Z ~> m]. - real :: SST ! The initial sea surface temperature, in deg C. - real :: T_int ! The initial temperature of an interface, in deg C. + real :: SST ! The initial sea surface temperature [degC]. + real :: T_int ! The initial temperature of an interface [degC]. real :: ML_depth ! The specified initial mixed layer depth, in depth units [Z ~> m]. real :: thermocline_scale ! The e-folding scale of the thermocline, in depth units [Z ~> m]. real, dimension(SZK_(GV)) :: T0, pres, S0, rho_guess, drho, drho_dT, drho_dS @@ -234,7 +234,7 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, param_file, & ! kg m-3 PSU-1. ! real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 in kg m-3. ! real :: PI ! 3.1415926... calculated as 4*atan(1) - real :: SST ! The initial sea surface temperature, in deg C. + real :: SST ! The initial sea surface temperature [degC]. real :: lat logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "benchmark_init_temperature_salinity" ! This subroutine's name. diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index d206914e2a..3fdba94a3f 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -27,11 +27,11 @@ module dumbbell_surface_forcing !! state variables. logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. real :: Rho0 !< The density used in the Boussinesq - !! approximation, in kg m-3. - real :: G_Earth !< The gravitational acceleration in m s-2. + !! approximation [kg m-3]. + real :: G_Earth !< The gravitational acceleration [m s-2] real :: Flux_const !< The restoring rate at the surface, in m s-1. real :: gust_const !< A constant unresolved background gustiness - !! that contributes to ustar, in Pa. + !! that contributes to ustar [Pa]. real :: slp_amplitude !< The amplitude of pressure loading (in Pa) applied !! to the reservoirs real :: slp_period !< Period of sinusoidal pressure wave @@ -39,7 +39,7 @@ module dumbbell_surface_forcing forcing_mask !< A mask regulating where forcing occurs real, dimension(:,:), allocatable :: & S_restore !< The surface salinity field toward which to - !! restore, in PSU. + !! restore [PSU]. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the !! timing of diagnostic output. end type dumbbell_surface_forcing_CS @@ -61,9 +61,9 @@ subroutine dumbbell_buoyancy_forcing(state, fluxes, day, dt, G, CS) !! call to dumbbell_surface_forcing_init ! Local variables real :: Temp_restore ! The temperature that is being restored toward, in C. - real :: Salin_restore ! The salinity that is being restored toward, in PSU. + real :: Salin_restore ! The salinity that is being restored toward [PSU]. real :: density_restore ! The potential density that is being restored - ! toward, in kg m-3. + ! toward [kg m-3]. real :: rhoXcp ! The mean density times the heat capacity, in J m-3 K-1. real :: buoy_rest_const ! A constant relating density anomalies to the ! restoring buoyancy flux, in m5 s-3 kg-1. diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index d49264920d..37d7c1b8c9 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -65,7 +65,7 @@ subroutine sloshing_initialize_thickness ( h, G, GV, US, param_file, just_read_p !! only read parameters without changing h. real :: displ(SZK_(G)+1) ! The interface displacement in depth units. - real :: z_unif(SZK_(G)+1) ! Fractional uniform interface heights, nondim. + real :: z_unif(SZK_(G)+1) ! Fractional uniform interface heights [nondim]. real :: z_inter(SZK_(G)+1) ! Interface heights, in depth units. real :: a0 ! The displacement amplitude in depth units. real :: weight_z ! A (misused?) depth-space weighting, in inconsistent units. diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 754cff9f39..5272d60897 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -246,15 +246,14 @@ end subroutine write_user_log !! - v - Meridional velocity in m s-1. !! - h - Layer thickness [H ~> m or kg m-2]. (Must be positive.) !! - G%bathyT - Basin depth [Z ~> m]. (Must be positive.) -!! - G%CoriolisBu - The Coriolis parameter, in s-1. +!! - G%CoriolisBu - The Coriolis parameter [s-1]. !! - GV%g_prime - The reduced gravity at each interface [m2 Z-1 s-2 ~> m s-2]. -!! - GV%Rlay - Layer potential density (coordinate variable), kg m-3. +!! - GV%Rlay - Layer potential density (coordinate variable) [kg m-3]. !! If ENABLE_THERMODYNAMICS is defined: -!! - T - Temperature in C. -!! - S - Salinity in psu. +!! - T - Temperature [degC]. +!! - S - Salinity [psu]. !! If BULKMIXEDLAYER is defined: -!! - Rml - Mixed layer and buffer layer potential densities in -!! units of kg m-3. +!! - Rml - Mixed layer and buffer layer potential densities [kg m-3]. !! If SPONGE is defined: !! - A series of subroutine calls are made to set up the damping !! rates and reference profiles for all variables that are damped From dd34d004cb09a19e32c1335441258087975a0f2b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 20 Dec 2018 17:59:17 -0500 Subject: [PATCH 0968/1072] Document velocity units with square brackets Changed comments to use the square bracket notation to document the units of about 1000 velocity, acceleration, and time interval arguments. Also eliminated several redundant argument documentation blocks. Only comments have been changed and all answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 14 +- config_src/coupled_driver/ocean_model_MOM.F90 | 14 +- .../ice_solo_driver/MOM_surface_forcing.F90 | 2 +- .../ice_solo_driver/user_surface_forcing.F90 | 4 +- config_src/mct_driver/MOM_ocean_model.F90 | 2 +- config_src/mct_driver/MOM_surface_forcing.F90 | 12 +- config_src/mct_driver/ocn_comp_mct.F90 | 6 +- config_src/mct_driver/ocn_cpl_indices.F90 | 4 +- .../solo_driver/MESO_surface_forcing.F90 | 4 +- .../solo_driver/MOM_surface_forcing.F90 | 8 +- .../solo_driver/Neverland_surface_forcing.F90 | 4 +- .../solo_driver/user_surface_forcing.F90 | 4 +- src/ALE/MOM_ALE.F90 | 37 +++-- src/ALE/MOM_regridding.F90 | 8 +- src/ALE/coord_adapt.F90 | 7 +- src/ALE/coord_slight.F90 | 12 +- src/core/MOM.F90 | 80 +++++----- src/core/MOM_PressureForce.F90 | 6 +- src/core/MOM_PressureForce_analytic_FV.F90 | 24 +-- src/core/MOM_PressureForce_blocked_AFV.F90 | 24 +-- src/core/MOM_barotropic.F90 | 136 +++++++++-------- src/core/MOM_checksum_packages.F90 | 27 ++-- src/core/MOM_continuity.F90 | 2 +- src/core/MOM_continuity_PPM.F90 | 144 +++++++++--------- src/core/MOM_dynamics_split_RK2.F90 | 8 +- src/core/MOM_dynamics_unsplit.F90 | 26 ++-- src/core/MOM_dynamics_unsplit_RK2.F90 | 30 ++-- src/core/MOM_forcing_type.F90 | 28 ++-- src/core/MOM_grid.F90 | 2 +- src/core/MOM_open_boundary.F90 | 22 +-- src/core/MOM_variables.F90 | 36 ++--- src/diagnostics/MOM_PointAccel.F90 | 16 +- src/diagnostics/MOM_diag_to_Z.F90 | 8 +- src/diagnostics/MOM_diagnostics.F90 | 12 +- src/diagnostics/MOM_sum_output.F90 | 6 +- src/diagnostics/MOM_wave_speed.F90 | 4 +- src/diagnostics/MOM_wave_structure.F90 | 13 +- src/ice_shelf/MOM_ice_shelf.F90 | 39 ++--- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 14 +- src/ice_shelf/MOM_marine_ice.F90 | 14 +- .../MOM_coord_initialization.F90 | 20 +-- .../MOM_state_initialization.F90 | 27 ++-- src/parameterizations/lateral/MOM_MEKE.F90 | 82 +++++----- .../lateral/MOM_hor_visc.F90 | 16 +- .../lateral/MOM_internal_tides.F90 | 99 ++++++------ .../lateral/MOM_lateral_mixing_coeffs.F90 | 8 +- .../lateral/MOM_mixed_layer_restrat.F90 | 6 +- .../lateral/MOM_thickness_diffuse.F90 | 12 +- .../lateral/MOM_tidal_forcing.F90 | 4 +- .../vertical/MOM_CVMix_KPP.F90 | 38 ++--- .../vertical/MOM_CVMix_shear.F90 | 4 +- .../vertical/MOM_bulk_mixed_layer.F90 | 8 +- .../vertical/MOM_diabatic_aux.F90 | 22 +-- .../vertical/MOM_diabatic_driver.F90 | 16 +- .../vertical/MOM_diapyc_energy_req.F90 | 5 +- .../vertical/MOM_energetic_PBL.F90 | 16 +- .../vertical/MOM_entrain_diffusive.F90 | 22 +-- .../vertical/MOM_geothermal.F90 | 44 +++--- .../vertical/MOM_internal_tide_input.F90 | 16 +- .../vertical/MOM_kappa_shear.F90 | 47 +++--- .../vertical/MOM_regularize_layers.F90 | 4 +- .../vertical/MOM_set_diffusivity.F90 | 26 ++-- .../vertical/MOM_set_viscosity.F90 | 26 ++-- src/parameterizations/vertical/MOM_sponge.F90 | 24 +-- .../vertical/MOM_tidal_mixing.F90 | 4 +- .../vertical/MOM_vert_friction.F90 | 23 ++- src/tracer/MOM_tracer_diabatic.F90 | 2 +- src/tracer/MOM_tracer_flow_control.F90 | 81 ++-------- src/tracer/MOM_tracer_hor_diff.F90 | 14 +- src/user/BFB_surface_forcing.F90 | 2 +- src/user/MOM_wave_interface.F90 | 36 ++--- src/user/Phillips_initialization.F90 | 4 +- src/user/SCM_CVMix_tests.F90 | 24 +-- src/user/dumbbell_surface_forcing.F90 | 2 +- src/user/user_initialization.F90 | 4 +- 75 files changed, 804 insertions(+), 847 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index ac62a9fddc..32800b8212 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -94,9 +94,9 @@ module MOM_surface_forcing gust => NULL() !< A spatially varying unresolved background gustiness that !! contributes to ustar (Pa). gust is used when read_gust_2d is true. real, pointer, dimension(:,:) :: & - ustar_tidal => NULL() !< Tidal contribution to the bottom friction velocity (m/s) + 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, in m s-1. + 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 @@ -112,7 +112,7 @@ module MOM_surface_forcing !! salinity to a specified value. logical :: restore_temp !< If true, the coupled MOM driver adds a term to restore sea !! surface temperature to a specified value. - real :: Flux_const !< Piston velocity for surface restoring (m/s) + 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) logical :: adjust_net_srestore_by_scaling !< Adjust srestore w/o moving zero contour @@ -172,7 +172,7 @@ module MOM_surface_forcing 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(:,:) :: stress_mag =>NULL() !< The time-mean magnitude of the stress on the ocean (Pa) - real, pointer, dimension(:,:) :: ustar_berg =>NULL() !< frictional velocity beneath icebergs (m/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) @@ -587,7 +587,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ real, dimension(SZI_(G),SZJ_(G)) :: & rigidity_at_h, & ! Ice rigidity at tracer points (m3 s-1) net_mass_src, & ! A temporary of net mass sources, in kg m-2 s-1. - ustar_tmp ! A temporary array of ustar values, in m s-1. + ustar_tmp ! A temporary array of ustar values [m s-1]. 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) ) @@ -1142,7 +1142,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) !! structure for this module ! Local variables - real :: utide ! The RMS tidal velocity, in m s-1. + real :: utide ! The RMS tidal velocity [m s-1]. type(directories) :: dirs logical :: new_sim, iceberg_flux_diags type(time_type) :: Time_frc @@ -1333,7 +1333,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) 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. diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 32cdd843ff..ce42e26b45 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -240,7 +240,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) !! internal variables in the ice model. ! Local variables real :: Rho0 ! The Boussinesq ocean density, in kg m-3. - real :: G_Earth ! The gravitational acceleration in m s-2. + real :: G_Earth ! The gravitational acceleration [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. @@ -439,7 +439,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda logical, optional, intent(in) :: end_cycle !< This indicates whether this call is to be !! treated as the last call to step_MOM in a !! time-stepping cycle; missing is like true. - real, optional, intent(in) :: cycle_length !< The duration of a coupled time stepping cycle, in s. + real, optional, intent(in) :: cycle_length !< The duration of a coupled time stepping cycle [s]. ! Local variables type(time_type) :: Time_seg_start ! Stores the ocean model time at the start of this call to allow @@ -447,11 +447,11 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda 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 of the current fluxes. - real :: dt_coupling ! The coupling time step in seconds. - 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. + real :: dt_coupling ! The coupling time step [s]. + real :: dt_therm ! A limited and quantized version of OS%dt_therm [s]. + real :: dt_dyn ! The dynamics time step [s]. + real :: dtdia ! The diabatic time step [s]. + real :: t_elapsed_seg ! The elapsed time in this update segment [s]. integer :: n ! The internal iteration counter. integer :: nts ! The number of baroclinic dynamics time steps in a thermodynamic step. integer :: n_max ! The number of calls to step_MOM dynamics in this call to update_ocean_model. diff --git a/config_src/ice_solo_driver/MOM_surface_forcing.F90 b/config_src/ice_solo_driver/MOM_surface_forcing.F90 index 301b8a9eea..cc0ff6723a 100644 --- a/config_src/ice_solo_driver/MOM_surface_forcing.F90 +++ b/config_src/ice_solo_driver/MOM_surface_forcing.F90 @@ -104,7 +104,7 @@ module MOM_surface_forcing real :: Rho0 ! Boussinesq reference density (kg/m^3) real :: G_Earth ! gravitational acceleration (m/s^2) - real :: Flux_const ! piston velocity for surface restoring (m/s) + real :: Flux_const ! piston velocity for surface restoring [m s-1] real :: gust_const ! constant unresolved background gustiness for ustar (Pa) logical :: read_gust_2d ! if true, use 2-dimensional gustiness supplied from a file diff --git a/config_src/ice_solo_driver/user_surface_forcing.F90 b/config_src/ice_solo_driver/user_surface_forcing.F90 index de3f475a25..639f81cfb6 100644 --- a/config_src/ice_solo_driver/user_surface_forcing.F90 +++ b/config_src/ice_solo_driver/user_surface_forcing.F90 @@ -80,8 +80,8 @@ module user_surface_forcing logical :: restorebuoy ! If true, use restoring surface buoyancy forcing. real :: Rho0 ! The density used in the Boussinesq ! approximation, in kg m-3. - real :: G_Earth ! The gravitational acceleration in m s-2. - real :: Flux_const ! The restoring rate at the surface, in m s-1. + real :: G_Earth ! The gravitational acceleration [m s-2]. + real :: Flux_const ! The restoring rate at the surface [m s-1]. real :: gust_const ! A constant unresolved background gustiness ! that contributes to ustar, in Pa. diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 1a3a06b4d8..a8f67c1e79 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -248,7 +248,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! been used in a previous call to initialize_ocean_type. real :: Rho0 !< The Boussinesq ocean density, in kg m-3. - real :: G_Earth !< The gravitational acceleration in m s-2. + 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 diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 1e07e791e8..173ffd1e3d 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -94,10 +94,10 @@ module MOM_surface_forcing gust => NULL(), & !< spatially varying unresolved background !! 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) + 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, in m s-1. + !! 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 @@ -110,7 +110,7 @@ module MOM_surface_forcing !! sea-ice viscosity becomes effective, in 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) + 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) logical :: adjust_net_srestore_by_scaling !< adjust srestore w/o moving zero contour @@ -169,7 +169,7 @@ module MOM_surface_forcing 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(:,:) :: 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) @@ -979,7 +979,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, !! temp/salt restoring will be applied ! local variables - real :: utide !< The RMS tidal velocity, in m s-1. + real :: utide !< The RMS tidal velocity [m s-1]. type(directories) :: dirs logical :: new_sim, iceberg_flux_diags type(time_type) :: Time_frc @@ -1150,7 +1150,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, 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. diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 97692ccc65..c2e8423e4b 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -765,7 +765,7 @@ end subroutine ocean_model_init_sfc !! x2o_Foxx_rof !! !! Variables in MOM6 fluxes that are **NOT** filled by the coupler: -!! ustar_berg, frictional velocity beneath icebergs (m/s) +!! ustar_berg, frictional velocity beneath icebergs [m s-1] !! area_berg, area covered by icebergs(m2/m2) !! mass_berg, mass of icebergs(kg/m2) !! runoff_hflx, heat content of liquid runoff (W/m2) @@ -804,8 +804,8 @@ end subroutine ocean_model_init_sfc !! !! Surface temperature (Kelvin) !! Surface salinity (psu) -!! Surface eastward velocity (m/s) -!! Surface northward velocity (m/s) +!! Surface eastward velocity [m s-1] +!! Surface northward velocity [m s-1] !! Zonal slope in the sea surface height !! Meridional slope in the sea surface height !! diff --git a/config_src/mct_driver/ocn_cpl_indices.F90 b/config_src/mct_driver/ocn_cpl_indices.F90 index 52f94f6106..645b358ec1 100644 --- a/config_src/mct_driver/ocn_cpl_indices.F90 +++ b/config_src/mct_driver/ocn_cpl_indices.F90 @@ -10,8 +10,8 @@ module ocn_cpl_indices type cpl_indices_type ! ocean to coupler integer :: o2x_So_t !< Surface potential temperature (deg C) - integer :: o2x_So_u !< Surface zonal velocity (m/s) - integer :: o2x_So_v !< Surface meridional velocity (m/s) + integer :: o2x_So_u !< Surface zonal velocity [m s-1] + integer :: o2x_So_v !< Surface meridional velocity [m s-1] integer :: o2x_So_s !< Surface salinity (PSU) integer :: o2x_So_dhdx !< Zonal slope in the sea surface height integer :: o2x_So_dhdy !< Meridional lope in the sea surface height diff --git a/config_src/solo_driver/MESO_surface_forcing.F90 b/config_src/solo_driver/MESO_surface_forcing.F90 index 68852f89d9..5371ceca91 100644 --- a/config_src/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/solo_driver/MESO_surface_forcing.F90 @@ -27,8 +27,8 @@ module MESO_surface_forcing logical :: use_temperature !< If true, temperature and salinity are used as state variables. logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. real :: Rho0 !< The density used in the Boussinesq approximation, in kg m-3. - real :: G_Earth !< The gravitational acceleration in m s-2. - real :: Flux_const !< The restoring rate at the surface, in m s-1. + real :: G_Earth !< The gravitational acceleration [m s-2]. + real :: Flux_const !< The restoring rate at the surface [m s-1]. real :: gust_const !< A constant unresolved background gustiness !! that contributes to ustar, in Pa. real, dimension(:,:), pointer :: & diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index d404edf9f3..765dbc59a9 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -80,9 +80,9 @@ module MOM_surface_forcing real :: Rho0 !< Boussinesq reference density (kg/m^3) real :: G_Earth !< gravitational acceleration (m/s^2) - real :: Flux_const !< piston velocity for surface restoring (m/s) - real :: Flux_const_T !< piston velocity for surface temperature restoring (m/s) - real :: Flux_const_S !< piston velocity for surface salinity restoring (m/s) + real :: Flux_const !< piston velocity for surface restoring [m s-1] + real :: Flux_const_T !< piston velocity for surface temperature restoring [m s-1] + real :: Flux_const_S !< piston velocity for surface salinity restoring [m s-1] real :: latent_heat_fusion !< latent heat of fusion (J/kg) real :: latent_heat_vapor !< latent heat of vaporization (J/kg) real :: tau_x0 !< Constant zonal wind stress used in the WIND_CONFIG="const" forcing @@ -672,7 +672,7 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS) ! Local variables real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal and psuedo-meridional real :: temp_y(SZI_(G),SZJ_(G)) ! wind stresses at h-points, in Pa. - real :: temp_ustar(SZI_(G),SZJ_(G)) ! ustar in m s-1 (not rescaled). + real :: temp_ustar(SZI_(G),SZJ_(G)) ! ustar [m s-1] (not rescaled). integer :: i, j, is_in, ie_in, js_in, je_in logical :: read_uStar diff --git a/config_src/solo_driver/Neverland_surface_forcing.F90 b/config_src/solo_driver/Neverland_surface_forcing.F90 index 192d894661..c727b62833 100644 --- a/config_src/solo_driver/Neverland_surface_forcing.F90 +++ b/config_src/solo_driver/Neverland_surface_forcing.F90 @@ -33,8 +33,8 @@ module Neverland_surface_forcing logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. real :: Rho0 !< The density used in the Boussinesq !! approximation, in kg m-3. - real :: G_Earth !< The gravitational acceleration in m s-2. - real :: flux_const !< The restoring rate at the surface, in m s-1. + real :: G_Earth !< The gravitational acceleration [m s-2]. + real :: flux_const !< The restoring rate at the surface [m s-1]. real, dimension(:,:), pointer :: & buoy_restore(:,:) => NULL() !< The pattern to restore buoyancy to. character(len=200) :: inputdir !< The directory where NetCDF input files are. diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90 index 1d2cd158ae..99be485499 100644 --- a/config_src/solo_driver/user_surface_forcing.F90 +++ b/config_src/solo_driver/user_surface_forcing.F90 @@ -34,8 +34,8 @@ module user_surface_forcing logical :: use_temperature !< If true, temperature and salinity are used as state variables. logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. real :: Rho0 !< The density used in the Boussinesq approximation, in kg m-3. - real :: G_Earth !< The gravitational acceleration in m s-2. - real :: Flux_const !< The restoring rate at the surface, in m s-1. + real :: G_Earth !< The gravitational acceleration [m s-2]. + real :: Flux_const !< The restoring rate at the surface [m s-1]. real :: gust_const !< A constant unresolved background gustiness !! that contributes to ustar, in Pa. diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 2084ec2d7d..f6c84dff5a 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -277,7 +277,7 @@ subroutine adjustGridForIntegrity( CS, G, GV, h ) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid thickness that - !! are to be adjusted (m or Pa) + !! are to be adjusted [H ~> m or kg-2] call inflate_vanished_layers_old( CS%regridCS, G, GV, h(:,:,:) ) end subroutine adjustGridForIntegrity @@ -307,8 +307,8 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, dt, frac_shelf_h) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the !! last time step [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity field (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< Meridional velocity field (m/s) + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity field [m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< Meridional velocity field [m s-1] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure type(tracer_registry_type), pointer :: Reg !< Tracer registry structure type(ALE_CS), pointer :: CS !< Regridding parameters and options @@ -317,7 +317,7 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, dt, frac_shelf_h) ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: dzRegrid ! The change in grid interface positions real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: eta_preale - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_new ! New 3D grid obtained after last time step (m or Pa) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_new ! New 3D grid obtained after last time step [H ~> m or kg-2] integer :: nk, i, j, k, isc, iec, jsc, jec logical :: ice_shelf @@ -391,14 +391,14 @@ subroutine ALE_main_offline( G, GV, h, tv, Reg, CS, dt) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the - !! last time step (m or Pa) + !! last time step [H ~> m or kg-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure type(tracer_registry_type), pointer :: Reg !< Tracer registry structure type(ALE_CS), pointer :: CS !< Regridding parameters and options real, optional, intent(in) :: dt !< Time step between calls to ALE_main() ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(GV)+1) :: dzRegrid ! The change in grid interface positions - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_new ! New 3D grid obtained after last time step (m or Pa) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_new ! New 3D grid obtained after last time step [H ~> m or kg-2] integer :: nk, i, j, k, isc, iec, jsc, jec nk = GV%ke; isc = G%isc; iec = G%iec; jsc = G%jsc; jec = G%jec @@ -523,10 +523,10 @@ subroutine ALE_offline_tracer_final( G, GV, h, tv, h_target, Reg, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the - !! last time step (m or Pa) + !! last time step [H ~> m or kg-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h_target !< Current 3D grid obtained after - !! last time step (m or Pa) + !! last time step [H ~> m or kg-2] type(tracer_registry_type), pointer :: Reg !< Tracer registry structure type(ALE_CS), pointer :: CS !< Regridding parameters and options ! Local variables @@ -597,7 +597,7 @@ subroutine ALE_build_grid( G, GV, regridCS, remapCS, h, tv, debug, frac_shelf_h type(remapping_CS), intent(in) :: remapCS !< Remapping parameters and options type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamical variable structure real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the - !! last time step (m or Pa) + !! last time step [H ~> m or kg-2] logical, optional, intent(in) :: debug !< If true, show the call tree real, dimension(:,:), optional, pointer :: frac_shelf_h !< Fractional ice shelf coverage ! Local variables @@ -723,15 +723,18 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, type(ALE_CS), intent(in) :: CS_ALE !< ALE control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Thickness of source grid (m or Pa) - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Thickness of destination grid (m or Pa) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Thickness of source grid + !! [H ~> m or kg-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Thickness of destination grid + !! [H ~> m or kg-2] type(tracer_registry_type), pointer :: Reg !< Tracer registry structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & - optional, intent(in) :: dxInterface !< Change in interface position (Hm or Pa) + optional, intent(in) :: dxInterface !< Change in interface position + !! [H ~> m or kg-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - optional, intent(inout) :: u !< Zonal velocity component (m/s) + optional, intent(inout) :: u !< Zonal velocity component [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - optional, intent(inout) :: v !< Meridional velocity component (m/s) + optional, intent(inout) :: v !< Meridional velocity component [m s-1] logical, optional, intent(in) :: debug !< If true, show the call tree real, optional, intent(in) :: dt !< time step for diagnostics ! Local variables @@ -894,9 +897,11 @@ subroutine ALE_remap_scalar(CS, G, GV, nk_src, h_src, s_src, h_dst, s_dst, all_c type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure integer, intent(in) :: nk_src !< Number of levels on source grid - real, dimension(SZI_(G),SZJ_(G),nk_src), intent(in) :: h_src !< Level thickness of source grid (m or Pa) + real, dimension(SZI_(G),SZJ_(G),nk_src), intent(in) :: h_src !< Level thickness of source grid + !! [H ~> m or kg-2] real, dimension(SZI_(G),SZJ_(G),nk_src), intent(in) :: s_src !< Scalar on source grid - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)),intent(in) :: h_dst !< Level thickness of destination grid (m or Pa) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)),intent(in) :: h_dst !< Level thickness of destination grid + !! [H ~> m or kg-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)),intent(inout) :: s_dst !< Scalar on destination grid logical, optional, intent(in) :: all_cells !< If false, only reconstruct for !! non-vanished cells. Use all vanished diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index df06f42960..db97286f95 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -2208,16 +2208,18 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri adaptTimeRatio, adaptZoom, adaptZoomCoeff, adaptBuoyCoeff, adaptAlpha, adaptDoMin) type(regridding_CS), intent(inout) :: CS !< Regridding control structure logical, optional, intent(in) :: boundary_extrapolation !< Extrapolate in boundary cells - real, optional, intent(in) :: min_thickness !< Minimum thickness allowed when building the new grid (H) + real, optional, intent(in) :: min_thickness !< Minimum thickness allowed when building the + !! new grid [H ~> m or kg m-2] real, optional, intent(in) :: old_grid_weight !< Weight given to old coordinate when time-filtering grid character(len=*), optional, intent(in) :: interp_scheme !< Interpolation method for state-dependent coordinates real, optional, intent(in) :: depth_of_time_filter_shallow !< Depth to start cubic [H ~> m or kg m-2] real, optional, intent(in) :: depth_of_time_filter_deep !< Depth to end cubic [H ~> m or kg m-2] real, optional, intent(in) :: compress_fraction !< Fraction of compressibility to add to potential density - real, optional, intent(in) :: dz_min_surface !< The fixed resolution in the topmost SLight_nkml_min layers (H) + real, optional, intent(in) :: dz_min_surface !< The fixed resolution in the topmost + !! SLight_nkml_min layers [H ~> m or kg m-2] integer, optional, intent(in) :: nz_fixed_surface !< The number of fixed-thickness layers at the top of the model real, optional, intent(in) :: Rho_ml_avg_depth !< Averaging depth over which to determine mixed layer potential - !! density (H) + !! density [H ~> m or kg m-2] real, optional, intent(in) :: nlay_ML_to_interior !< Number of layers to offset the mixed layer density to find !! resolved stratification (nondim) logical, optional, intent(in) :: fix_haloclines !< Detect regions with much weaker stratification in the coordinate diff --git a/src/ALE/coord_adapt.F90 b/src/ALE/coord_adapt.F90 index c3d63280e4..9a18b836ae 100644 --- a/src/ALE/coord_adapt.F90 +++ b/src/ALE/coord_adapt.F90 @@ -36,7 +36,7 @@ module coord_adapt !> Stratification-dependent diffusion coefficient real :: adaptBuoyCoeff - !> Reference density difference for stratification-dependent diffusion in kg m-3 + !> Reference density difference for stratification-dependent diffusion [kg m-3] real :: adaptDrho0 !> If true, form a HYCOM1-like mixed layet by preventing interfaces @@ -52,7 +52,8 @@ module coord_adapt subroutine init_coord_adapt(CS, nk, coordinateResolution, m_to_H) type(adapt_CS), pointer :: CS !< Unassociated pointer to hold the control structure integer, intent(in) :: nk !< Number of layers in the grid - real, dimension(:), intent(in) :: coordinateResolution !< Nominal near-surface resolution (H) + real, dimension(:), intent(in) :: coordinateResolution !< Nominal near-surface resolution [m] or + !! other units specified with m_to_H real, optional, intent(in) :: m_to_H !< A conversion factor from m to the units of thicknesses real :: m_to_H_rescale ! A unit conversion factor. @@ -72,7 +73,7 @@ subroutine init_coord_adapt(CS, nk, coordinateResolution, m_to_H) CS%adaptZoom = 200.0 * m_to_H_rescale CS%adaptZoomCoeff = 0.0 ! Nondim. CS%adaptBuoyCoeff = 0.0 ! Nondim. - CS%adaptDrho0 = 0.5 ! kg m-3 + CS%adaptDrho0 = 0.5 ! [kg m-3] end subroutine init_coord_adapt diff --git a/src/ALE/coord_slight.F90 b/src/ALE/coord_slight.F90 index a6afd27f9b..935804e301 100644 --- a/src/ALE/coord_slight.F90 +++ b/src/ALE/coord_slight.F90 @@ -17,10 +17,10 @@ module coord_slight !> Number of layers/levels integer :: nk - !> Minimum thickness allowed when building the new grid through regridding (H) + !> Minimum thickness allowed when building the new grid through regridding [H ~> m or kg m-2] real :: min_thickness - !> Reference pressure for potential density calculations (Pa) + !> Reference pressure for potential density calculations [Pa] real :: ref_pressure !> Fraction (between 0 and 1) of compressibility to add to potential density @@ -28,7 +28,7 @@ module coord_slight real :: compressibility_fraction ! The following 4 parameters were introduced for use with the SLight coordinate: - !> Depth over which to average to determine the mixed layer potential density (H) + !> Depth over which to average to determine the mixed layer potential density [H ~> m or kg m-2] real :: Rho_ML_avg_depth !> Number of layers to offset the mixed layer density to find resolved stratification (nondim) @@ -37,7 +37,7 @@ module coord_slight !> The number of fixed-thickness layers at the top of the model integer :: nz_fixed_surface = 2 - !> The fixed resolution in the topmost SLight_nkml_min layers (H) + !> The fixed resolution in the topmost SLight_nkml_min layers [H ~> m or kg m-2] real :: dz_ml_min !> If true, detect regions with much weaker stratification in the coordinate @@ -126,11 +126,11 @@ subroutine set_slight_params(CS, max_interface_depths, max_layer_thickness, & !! compressibility to add to potential density profiles when !! interpolating for target grid positions. (nondim) real, optional, intent(in) :: dz_ml_min !< The fixed resolution in the topmost - !! SLight_nkml_min layers (H) + !! SLight_nkml_min layers [H ~> m or kg m-2] integer, optional, intent(in) :: nz_fixed_surface !< The number of fixed-thickness layers at the !! top of the model real, optional, intent(in) :: Rho_ML_avg_depth !< Depth over which to average to determine - !! the mixed layer potential density (H) + !! the mixed layer potential density [H ~> m or kg m-2] real, optional, intent(in) :: nlay_ML_offset !< Number of layers to offset the mixed layer !! density to find resolved stratification (nondim) logical, optional, intent(in) :: fix_haloclines !< If true, detect regions with much weaker than diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 02cce98b70..c254143cdc 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -153,32 +153,32 @@ module MOM !! the state of the ocean. type, public :: MOM_control_struct ; private real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: & - h, & !< layer thickness (m or kg/m2 (H)) - T, & !< potential temperature (degrees C) - S !< salinity (ppt) + h, & !< layer thickness [H ~> m or kg m-2] + T, & !< potential temperature [degC] + S !< salinity [ppt] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - u, & !< zonal velocity component (m/s) - uh, & !< uh = u * h * dy at u grid points (m3/s or kg/s) - uhtr !< accumulated zonal thickness fluxes to advect tracers (m3 or kg) + u, & !< zonal velocity component [m s-1] + uh, & !< uh = u * h * dy at u grid points [H m2 s-1 ~> m3 s-1 or kg s-1] + uhtr !< accumulated zonal thickness fluxes to advect tracers [H m2 ~> m3 or kg] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - v, & !< meridional velocity (m/s) - vh, & !< vh = v * h * dx at v grid points (m3/s or kg/s) - vhtr !< accumulated meridional thickness fluxes to advect tracers (m3 or kg) + v, & !< meridional velocity [m s-1] + vh, & !< vh = v * h * dx at v grid points [H m2 s-1 ~> m3 s-1 or kg s-1] + vhtr !< accumulated meridional thickness fluxes to advect tracers [H m2 ~> m3 or kg] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ssh_rint - !< A running time integral of the sea surface height, in s m. + !< A running time integral of the sea surface height [s m]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ave_ssh_ibc !< time-averaged (over a forcing time step) sea surface height !! with a correction for the inverse barometer (meter) real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_av_bc !< free surface height or column mass time averaged over the last - !! baroclinic dynamics time step (m or kg/m2) + !! baroclinic dynamics time step [H ~> m or kg m-2] real, dimension(:,:), pointer :: & Hml => NULL() !< active mixed layer depth, in m real :: time_in_cycle !< The running time of the current time-stepping cycle !! in calls that step the dynamics, and also the length of - !! the time integral of ssh_rint, in s. + !! the time integral of ssh_rint [s]. real :: time_in_thermo_cycle !< The running time of the current time-stepping - !! cycle in calls that step the thermodynamics, in s. + !! cycle in calls that step the thermodynamics [s]. type(ocean_grid_type) :: G !< structure containing metrics and grid info type(verticalGrid_type), pointer :: & @@ -217,8 +217,8 @@ module MOM !! This is intended for running MOM6 in offline tracer mode type(time_type), pointer :: Time !< pointer to the ocean clock - real :: dt !< (baroclinic) dynamics time step (seconds) - real :: dt_therm !< thermodynamics time step (seconds) + real :: dt !< (baroclinic) dynamics time step [s] + real :: dt_therm !< thermodynamics time step [s] logical :: thermo_spans_coupling !< If true, thermodynamic and tracer time !! steps can span multiple coupled time steps. integer :: nstep_tot = 0 !< The total number of dynamic timesteps tcaaken @@ -408,7 +408,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & !! tracer and mass exchange forcing fields type(surface), intent(inout) :: sfc_state !< surface ocean state type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - real, intent(in) :: time_interval !< time interval covered by this run segment, in s. + real, intent(in) :: time_interval !< time interval covered by this run segment [s]. type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM type(Wave_parameters_CS), & optional, pointer :: Waves !< An optional pointer to a wave property CS @@ -423,7 +423,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & !! treated as the last call to step_MOM in a !! time-stepping cycle; missing is like true. real, optional, intent(in) :: cycle_length !< The amount of time in a coupled time - !! stepping cycle, in s. + !! stepping cycle [s]. logical, optional, intent(in) :: reset_therm !< This indicates whether the running sums of !! thermodynamic quantities should be reset. !! If missing, this is like start_cycle. @@ -440,17 +440,17 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, n integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - real :: dt ! baroclinic time step (sec) - real :: dtth ! time step for thickness diffusion (sec) - real :: dtdia ! time step for diabatic processes (sec) - real :: dt_therm ! a limited and quantized version of CS%dt_therm (sec) - real :: dt_therm_here ! a further limited value of dt_therm (sec) + real :: dt ! baroclinic time step [s] + real :: dtth ! time step for thickness diffusion [s] + real :: dtdia ! time step for diabatic processes [s] + real :: dt_therm ! a limited and quantized version of CS%dt_therm [s] + real :: dt_therm_here ! a further limited value of dt_therm [s] real :: wt_end, wt_beg real :: bbl_time_int ! The amount of time over which the calculated BBL ! properties will apply, for use in diagnostics, or 0 - ! if it is not to be calculated anew (sec). - real :: rel_time = 0.0 ! relative time since start of this call (sec). + ! if it is not to be calculated anew [s]. + real :: rel_time = 0.0 ! relative time since start of this call [s]. logical :: calc_dtbt ! Indicates whether the dynamically adjusted ! barotropic time step needs to be updated. @@ -465,16 +465,16 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & logical :: cycle_end ! If true, do calculations and diagnostics that are only done at ! the end of a stepping cycle (whatever that may mean). logical :: therm_reset ! If true, reset running sums of thermodynamic quantities. - real :: cycle_time ! The length of the coupled time-stepping cycle, in s. + real :: cycle_time ! The length of the coupled time-stepping cycle [s]. real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: & ssh ! sea surface height, which may be based on eta_av (meter) real, dimension(:,:,:), pointer :: & - u => NULL(), & ! u : zonal velocity component (m/s) - v => NULL(), & ! v : meridional velocity component (m/s) - h => NULL() ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) + u => NULL(), & ! u : zonal velocity component [m s-1] + v => NULL(), & ! v : meridional velocity component [m s-1] + h => NULL() ! h : layer thickness [H ~> m or kg m-2] real, dimension(:,:), pointer :: & - p_surf => NULL() ! A pointer to the ocean surface pressure, in Pa. + p_surf => NULL() ! A pointer to the ocean surface pressure [Pa]. real :: I_wt_ssh type(time_type) :: Time_local, end_time_thermo, Time_temp @@ -881,13 +881,13 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to the surface !! pressure at the beginning of this dynamic - !! step, intent in, in Pa. + !! step, intent in [Pa]. real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the surface !! pressure at the end of this dynamic step, - !! intent in, in Pa. - real, intent(in) :: dt !< time interval covered by this call, in s. + !! intent in [Pa]. + real, intent(in) :: dt !< time interval covered by this call [s]. real, intent(in) :: dt_thermo !< time interval covered by any updates that may - !! span multiple dynamics steps, in s. + !! span multiple dynamics steps [s]. real, intent(in) :: bbl_time_int !< time interval over which updates to the !! bottom boundary layer properties will apply, !! in s, or zero not to update the properties. @@ -905,8 +905,8 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & ! various unit conversion factors type(MOM_diag_IDs), pointer :: IDs => NULL() ! A structure with the diagnostic IDs. real, dimension(:,:,:), pointer :: & - u => NULL(), & ! u : zonal velocity component (m/s) - v => NULL(), & ! v : meridional velocity component (m/s) + u => NULL(), & ! u : zonal velocity component [m s-1] + v => NULL(), & ! v : meridional velocity component [m s-1] h => NULL() ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) logical :: calc_dtbt ! Indicates whether the dynamically adjusted @@ -1136,9 +1136,9 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & type(verticalGrid_type), intent(inout) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: u !< zonal velocity (m/s) + intent(inout) :: u !< zonal velocity [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: v !< meridional velocity (m/s) + intent(inout) :: v !< meridional velocity [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< layer thickness (m or kg/m2) type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables @@ -1539,7 +1539,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz integer :: IsdB, IedB, JsdB, JedB real :: dtbt - real :: Z_diag_int ! minimum interval between calc depth-space diagnostics (sec) + real :: Z_diag_int ! minimum interval between calc depth-space diagnostics [s] real, allocatable, dimension(:,:,:) :: e ! interface heights (meter) real, allocatable, dimension(:,:) :: eta ! free surface height (m) or bottom press (Pa) @@ -2709,8 +2709,8 @@ subroutine extract_surface_state(CS, sfc_state) !! metrics and related information type(verticalGrid_type), pointer :: GV => NULL() real, dimension(:,:,:), pointer :: & - u => NULL(), & !< u : zonal velocity component (m/s) - v => NULL(), & !< v : meridional velocity component (m/s) + u => NULL(), & !< u : zonal velocity component [m s-1] + v => NULL(), & !< v : meridional velocity component [m s-1] h => NULL() !< h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) real :: depth(SZI_(CS%G)) !< Distance from the surface in depth units [Z ~> m] real :: depth_ml !< Depth over which to average to determine mixed diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index a66b55b0f3..831fa6d1a3 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -52,9 +52,9 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: PFu !< Zonal pressure force acceleration (m/s2) + intent(out) :: PFu !< Zonal pressure force acceleration [m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: PFv !< Meridional pressure force acceleration (m/s2) + intent(out) :: PFv !< Meridional pressure force acceleration [m s-2] type(PressureForce_CS), pointer :: CS !< Pressure force control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), & @@ -62,7 +62,7 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e !! atmosphere-ocean interface in Pa. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: pbce !< The baroclinic pressure anomaly in each layer - !! due to eta anomalies, in m2 s-2 H-1. + !! due to eta anomalies [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(out) :: eta !< The bottom mass used to calculate PFu and PFv, !! [H ~> m or kg m-2], with any tidal contributions. diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 1776638127..603b0b815f 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -69,15 +69,15 @@ subroutine PressureForce_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbc type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration (m/s2) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration (m/s2) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean !! or atmosphere-ocean interface in Pa. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure - !! anomaly in each layer due to eta anomalies, - !! in m2 s-2 H-1. + !! anomaly in each layer due to eta anomalies + !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal !! contributions or compressibility compensation. @@ -105,15 +105,15 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (kg/m2) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration (m/s2) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration (m/s2) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean !! or atmosphere-ocean interface in Pa. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure - !! anomaly in each layer due to eta anomalies, - !! in m2 s-2 H-1. + !! anomaly in each layer due to eta anomalies + !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal !! contributions or compressibility compensation. @@ -446,15 +446,15 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (kg/m2) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration (m/s2) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration (m/s2) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean !! or atmosphere-ocean interface in Pa. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure - !! anomaly in each layer due to eta anomalies, - !! in m2 s-2 H-1. + !! anomaly in each layer due to eta anomalies + !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to !! calculate PFu and PFv [H ~> m or kg m-2], with any !! tidal contributions or compressibility compensation. diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 73a4440b9c..a9de1401b1 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -69,15 +69,15 @@ subroutine PressureForce_blk_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration (m/s2) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration (m/s2) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] type(PressureForce_blk_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean !! or atmosphere-ocean interface in Pa. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure - !! anomaly in each layer due to eta anomalies, - !! in m2 s-2 H-1. + !! anomaly in each layer due to eta anomalies + !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal !! contributions or compressibility compensation. @@ -105,14 +105,14 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (kg/m2) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration (m/s2) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration (m/s2) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] type(PressureForce_blk_AFV_CS), pointer :: CS !< Finite volume PGF control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean !! or atmosphere-ocean interface in Pa. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure - !! anomaly in each layer due to eta anomalies, - !! in m2 s-2 H-1. + !! anomaly in each layer due to eta anomalies + !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal !! contributions or compressibility compensation. @@ -429,15 +429,15 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration (m/s2) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration (m/s2) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] type(PressureForce_blk_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean !! or atmosphere-ocean interface in Pa. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure - !! anomaly in each layer due to eta anomalies, - !! in m2 s-2 H-1. + !! anomaly in each layer due to eta anomalies + !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal !! contributions or compressibility compensation. diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 3dabe03fb1..9c45e0854c 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -65,8 +65,8 @@ module MOM_barotropic !> The barotropic stepping open boundary condition type type, private :: BT_OBC_type - real, dimension(:,:), pointer :: Cg_u => NULL() !< The external wave speed at u-points, in m s-1. - real, dimension(:,:), pointer :: Cg_v => NULL() !< The external wave speed at u-points, in m s-1. + real, dimension(:,:), pointer :: Cg_u => NULL() !< The external wave speed at u-points [m s-1]. + real, dimension(:,:), pointer :: Cg_v => NULL() !< The external wave speed at u-points [m s-1]. real, dimension(:,:), pointer :: H_u => NULL() !< The total thickness at the u-points [H ~> m or kg m-2]. real, dimension(:,:), pointer :: H_v => NULL() !< The total thickness at the v-points [H ~> m or kg m-2]. real, dimension(:,:), pointer :: uhbt => NULL() !< The zonal barotropic thickness fluxes specified @@ -112,7 +112,7 @@ module MOM_barotropic !! the next call to btstep [H m2 s-1 ~> m3 s-1 or kg s-1]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: ubt_IC !< The barotropic solvers estimate of the zonal velocity that will be the initial - !! condition for the next call to btstep, in m s-1. + !! condition for the next call to btstep [m s-1]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: ubtav !< The barotropic zonal velocity averaged over the baroclinic time step, m s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: IDatv @@ -125,7 +125,7 @@ module MOM_barotropic !! the next call to btstep [H m2 s-1 ~> m3 s-1 or kg s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vbt_IC !< The barotropic solvers estimate of the zonal velocity that will be the initial - !! condition for the next call to btstep, in m s-1. + !! condition for the next call to btstep [m s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vbtav !< The barotropic meridional velocity averaged over the baroclinic time step, m s-1. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_cor @@ -161,12 +161,12 @@ module MOM_barotropic real :: Rho0 !< The density used in the Boussinesq !! approximation, in kg m-3. - real :: dtbt !< The barotropic time step, in s. + real :: dtbt !< The barotropic time step [s]. real :: dtbt_fraction !< The fraction of the maximum time-step that !! should used. The default is 0.98. - real :: dtbt_max !< The maximum stable barotropic time step, in s. + real :: dtbt_max !< The maximum stable barotropic time step [s]. real :: dt_bt_filter !< The time-scale over which the barotropic mode - !! solutions are filtered, in s. This can never + !! solutions are filtered [s]. This can never !! be taken to be longer than 2*dt. The default, 0, !! applies no filtering. integer :: nstep_last = 0 !< The number of barotropic timesteps per baroclinic @@ -241,9 +241,9 @@ module MOM_barotropic logical :: debug !< If true, write verbose checksums for debugging purposes. logical :: debug_bt !< If true, write verbose checksums for debugging purposes. real :: vel_underflow !< Velocity components smaller than vel_underflow - !! are set to 0, in m s-1. + !! are set to 0 [m s-1]. real :: maxvel !< Velocity components greater than maxvel are - !! truncated to maxvel, in m s-1. + !! truncated to maxvel [m s-1]. real :: CFL_trunc !< If clip_velocity is true, velocity components will !! be truncated when they are large enough that the !! corresponding CFL number exceeds this value, nondim. @@ -321,9 +321,9 @@ module MOM_barotropic !! drawing from nearby to the west [H m ~> m2 or kg m-1]. real :: FA_u_WW !< The effective open face area for zonal barotropic transport !! drawing from locations far to the west [H m ~> m2 or kg m-1]. - real :: uBT_WW !< uBT_WW is the barotropic velocity, in m s-1, beyond which the marginal + real :: uBT_WW !< uBT_WW is the barotropic velocity [m s-1], beyond which the marginal !! open face area is FA_u_WW. uBT_WW must be non-negative. - real :: uBT_EE !< uBT_EE is a barotropic velocity, in m s-1, beyond which the marginal + real :: uBT_EE !< uBT_EE is a barotropic velocity [m s-1], beyond which the marginal !! open face area is FA_u_EE. uBT_EE must be non-positive. real :: uh_crvW !< The curvature of face area with velocity for flow from the west [H s2 m-1 ~> s2 or kg s2 m-3]. real :: uh_crvE !< The curvature of face area with velocity for flow from the east [H s2 m-1 ~> s2 or kg s2 m-3]. @@ -340,9 +340,9 @@ module MOM_barotropic !! drawing from nearby to the south [H m ~> m2 or kg m-1]. real :: FA_v_SS !< The effective open face area for meridional barotropic transport !! drawing from locations far to the south [H m ~> m2 or kg m-1]. - real :: vBT_SS !< vBT_SS is the barotropic velocity, in m s-1, beyond which the marginal + real :: vBT_SS !< vBT_SS is the barotropic velocity [m s-1], beyond which the marginal !! open face area is FA_v_SS. vBT_SS must be non-negative. - real :: vBT_NN !< vBT_NN is the barotropic velocity, in m s-1, beyond which the marginal + real :: vBT_NN !< vBT_NN is the barotropic velocity [m s-1], beyond which the marginal !! open face area is FA_v_NN. vBT_NN must be non-positive. real :: vh_crvS !< The curvature of face area with velocity for flow from the south [H s2 m-1 ~> s2 or kg s2 m-3]. real :: vh_crvn !< The curvature of face area with velocity for flow from the north [H s2 m-1 ~> s2 or kg s2 m-3]. @@ -392,14 +392,14 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_in !< The initial (3-D) zonal velocity, in m s-1. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_in !< The initial (3-D) meridional velocity, in m s-1. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_in !< The initial (3-D) zonal velocity [m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_in !< The initial (3-D) meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta_in !< The initial barotropic free surface height !! anomaly or column mass anomaly [H ~> m or kg m-2]. real, intent(in) :: dt !< The time increment to integrate over. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: bc_accel_u !< The zonal baroclinic accelerations, in m s-2. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: bc_accel_u !< The zonal baroclinic accelerations [m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: bc_accel_v !< The meridional baroclinic accelerations, - !! in m s-2. + !! [m s-2]. type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: pbce !< The baroclinic pressure anomaly in each layer !! due to free surface height anomalies @@ -411,12 +411,12 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! Note: eta_in, pbce, and eta_PF_in must have up-to-date !! values in the first point of their halos. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_Cor !< The (3-D) zonal-velocities used to - !! calculate the Coriolis terms in bc_accel_u, in m s-1. + !! calculate the Coriolis terms in bc_accel_u [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_Cor !< Ditto for meridonal bc_accel_v. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: accel_layer_u !< The zonal acceleration of each layer due - !! to the barotropic calculation, in m s-2. + !! to the barotropic calculation [m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: accel_layer_v !< The meridional acceleration of each layer - !! due to the barotropic calculation, in m s-2. + !! due to the barotropic calculation [m s-2]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_out !< The final barotropic free surface !! height anomaly or column mass anomaly, in m or kg m-2. real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: uhbtav !< the barotropic zonal volume or mass @@ -449,15 +449,15 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! from ocean to the seafloor, in Pa. real, dimension(:,:,:), optional, pointer :: uh0 !< The zonal layer transports at reference !! velocities [H m s-1 ~> m2 s-1 or kg m-1 s-1]. - real, dimension(:,:,:), optional, pointer :: u_uh0 !< The velocities used to calculate uh0, in m s-1 + real, dimension(:,:,:), optional, pointer :: u_uh0 !< The velocities used to calculate uh0 [m s-1] real, dimension(:,:,:), optional, pointer :: vh0 !< The zonal layer transports at reference !! velocities [H m s-1 ~> m2 s-1 or kg m-1 s-1]. - real, dimension(:,:,:), optional, pointer :: v_vh0 !< The velocities used to calculate vh0, in m s-1 + real, dimension(:,:,:), optional, pointer :: v_vh0 !< The velocities used to calculate vh0 [m s-1] ! Local variables real :: ubt_Cor(SZIB_(G),SZJ_(G)) ! The barotropic velocities that had been real :: vbt_Cor(SZI_(G),SZJB_(G)) ! used to calculate the input Coriolis - ! terms, in m s-1. + ! terms [m s-1]. real :: wt_u(SZIB_(G),SZJ_(G),SZK_(G)) ! wt_u and wt_v are the real :: wt_v(SZI_(G),SZJB_(G),SZK_(G)) ! normalized weights to ! be used in calculating barotropic velocities, possibly with @@ -477,66 +477,66 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! These are always allocated with symmetric memory and wide halos. real :: q(SZIBW_(CS),SZJBW_(CS)) ! A pseudo potential vorticity in s-1 m-1. real, dimension(SZIBW_(CS),SZJW_(CS)) :: & - ubt, & ! The zonal barotropic velocity in m s-1. + ubt, & ! The zonal barotropic velocity [m s-1]. bt_rem_u, & ! The fraction of the barotropic zonal velocity that remains ! after a time step, the remainder being lost to bottom drag. ! bt_rem_u is a nondimensional number between 0 and 1. BT_force_u, & ! The vertical average of all of the u-accelerations that are ! not explicitly included in the barotropic equation, m s-2. u_accel_bt, & ! The difference between the zonal acceleration from the - ! barotropic calculation and BT_force_u, in m s-2. + ! barotropic calculation and BT_force_u [m s-2]. uhbt, & ! The zonal barotropic thickness fluxes [H m2 s-1 ~> m3 s-1 or kg s-1]. uhbt0, & ! The difference between the sum of the layer zonal thickness ! fluxes and the barotropic thickness flux using the same ! velocity [H m2 s-1 ~> m3 s-1 or kg s-1]. - ubt_old, & ! The starting value of ubt in a barotropic step, in m s-1. - ubt_first, & ! The starting value of ubt in a series of barotropic steps, in m s-1. - ubt_sum, & ! The sum of ubt over the time steps, in m s-1. + ubt_old, & ! The starting value of ubt in a barotropic step [m s-1]. + ubt_first, & ! The starting value of ubt in a series of barotropic steps [m s-1]. + ubt_sum, & ! The sum of ubt over the time steps [m s-1]. uhbt_sum, & ! The sum of uhbt over the time steps [H m2 s-1 ~> m3 s-1 or kg s-1]. - ubt_wtd, & ! A weighted sum used to find the filtered final ubt, in m s-1. - ubt_trans, & ! The latest value of ubt used for a transport, in m s-1. + ubt_wtd, & ! A weighted sum used to find the filtered final ubt [m s-1]. + ubt_trans, & ! The latest value of ubt used for a transport [m s-1]. azon, bzon, & ! _zon & _mer are the values of the Coriolis force which czon, dzon, & ! are applied to the neighboring values of vbtav & ubtav, amer, bmer, & ! respectively to get the barotropic inertial rotation cmer, dmer, & ! [s-1]. - Cor_u, & ! The zonal Coriolis acceleration, in m s-2. + Cor_u, & ! The zonal Coriolis acceleration [m s-2]. Cor_ref_u, & ! The zonal barotropic Coriolis acceleration due - ! to the reference velocities, in m s-2. - PFu, & ! The zonal pressure force acceleration, in m s-2. + ! to the reference velocities [m s-2]. + PFu, & ! The zonal pressure force acceleration [m s-2]. Rayleigh_u, & ! A Rayleigh drag timescale operating at u-points, in s-1. - PFu_bt_sum, & ! The summed zonal barotropic pressure gradient force, in m s-2. - Coru_bt_sum, & ! The summed zonal barotropic Coriolis acceleration, in m s-2. + PFu_bt_sum, & ! The summed zonal barotropic pressure gradient force [m s-2]. + Coru_bt_sum, & ! The summed zonal barotropic Coriolis acceleration [m s-2]. DCor_u, & ! A simply averaged depth at u points [Z ~> m]. Datu ! Basin depth at u-velocity grid points times the y-grid ! spacing [H m ~> m2 or kg m-1]. real, dimension(SZIW_(CS),SZJBW_(CS)) :: & - vbt, & ! The meridional barotropic velocity in m s-1. + vbt, & ! The meridional barotropic velocity [m s-1]. bt_rem_v, & ! The fraction of the barotropic meridional velocity that ! remains after a time step, the rest being lost to bottom ! drag. bt_rem_v is a nondimensional number between 0 and 1. BT_force_v, & ! The vertical average of all of the v-accelerations that are ! not explicitly included in the barotropic equation, m s-2. v_accel_bt, & ! The difference between the meridional acceleration from the - ! barotropic calculation and BT_force_v, in m s-2. + ! barotropic calculation and BT_force_v [m s-2]. vhbt, & ! The meridional barotropic thickness fluxes [H m2 s-1 ~> m3 s-1 or kg s-1]. vhbt0, & ! The difference between the sum of the layer meridional ! thickness fluxes and the barotropic thickness flux using ! the same velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. - vbt_old, & ! The starting value of vbt in a barotropic step, in m s-1. - vbt_first, & ! The starting value of ubt in a series of barotropic steps, in m s-1. - vbt_sum, & ! The sum of vbt over the time steps, in m s-1. + vbt_old, & ! The starting value of vbt in a barotropic step [m s-1]. + vbt_first, & ! The starting value of ubt in a series of barotropic steps [m s-1]. + vbt_sum, & ! The sum of vbt over the time steps [m s-1]. vhbt_sum, & ! The sum of vhbt over the time steps [H m2 s-1 ~> m3 s-1 or kg s-1]. - vbt_wtd, & ! A weighted sum used to find the filtered final vbt, in m s-1. - vbt_trans, & ! The latest value of vbt used for a transport, in m s-1. - Cor_v, & ! The meridional Coriolis acceleration, in m s-2. + vbt_wtd, & ! A weighted sum used to find the filtered final vbt [m s-1]. + vbt_trans, & ! The latest value of vbt used for a transport [m s-1]. + Cor_v, & ! The meridional Coriolis acceleration [m s-2]. Cor_ref_v, & ! The meridional barotropic Coriolis acceleration due - ! to the reference velocities, in m s-2. - PFv, & ! The meridional pressure force acceleration, in m s-2. + ! to the reference velocities [m s-2]. + PFv, & ! The meridional pressure force acceleration [m s-2]. Rayleigh_v, & ! A Rayleigh drag timescale operating at v-points, in s-1. PFv_bt_sum, & ! The summed meridional barotropic pressure gradient force, - ! in m s-2. + ! [m s-2]. Corv_bt_sum, & ! The summed meridional barotropic Coriolis acceleration, - ! in m s-2. + ! [m s-2]. DCor_v, & ! A simply averaged depth at v points [Z ~> m]. Datv ! Basin depth at v-velocity grid points times the x-grid ! spacing [H m ~> m2 or kg m-1]. @@ -565,7 +565,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! (See Hallberg, J Comp Phys 1997 for a discussion.) eta_src, & ! The source of eta per barotropic timestep, in m or kg m-2. dyn_coef_eta, & ! The coefficient relating the changes in eta to the - ! dynamic surface pressure under rigid ice, in m2 s-2 H-1. + ! dynamic surface pressure under rigid ice + ! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. p_surf_dyn ! A dynamic surface pressure under rigid ice, in m2 s-2. type(local_BT_cont_u_type), dimension(SZIBW_(CS),SZJW_(CS)) :: & BTCL_u ! A repackaged version of the u-point information in BT_cont. @@ -580,7 +581,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real :: mass_to_Z ! The depth unit converison divided by the mean density (Rho0), in m3 kg-1. real :: visc_rem ! A work variable that may equal visc_rem_[uv]. Nondim. - real :: vel_prev ! The previous velocity in m s-1. + real :: vel_prev ! The previous velocity [m s-1]. real :: dtbt ! The barotropic time step in s. real :: bebt ! A copy of CS%bebt. real :: be_proj ! The fractional amount by which velocities are projected @@ -608,16 +609,17 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, logical :: ice_is_rigid, nonblock_setup, interp_eta_PF logical :: project_velocity, add_uh0 - real :: dyn_coef_max ! The maximum stable value of dyn_coef_eta, in m2 s-2 H-1. - real :: ice_strength = 0.0 ! The effective strength of the ice in m s-2. + real :: dyn_coef_max ! The maximum stable value of dyn_coef_eta + ! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. + real :: ice_strength = 0.0 ! The effective strength of the ice [m s-2]. real :: Idt_max2 ! The squared inverse of the local maximum stable ! barotropic time step, in s-2. real :: H_min_dyn ! The minimum depth to use in limiting the size of the ! dynamic surface pressure for stability [H ~> m or kg m-2]. real :: H_eff_dx2 ! The effective total thickness divided by the grid spacing ! squared [H m-2 ~> m-1 or kg m-4]. - real :: vel_tmp ! A temporary velocity, in m s-1. - real :: u_max_cor, v_max_cor ! The maximum corrective velocities, in m s-1. + real :: vel_tmp ! A temporary velocity [m s-1]. + real :: u_max_cor, v_max_cor ! The maximum corrective velocities [m s-1]. real :: Htot ! The total thickness [H ~> m or kg m-2]. real :: eta_cor_max ! The maximum fluid that can be added as a correction to eta [H ~> m or kg m-2]. real :: accel_underflow ! An acceleration that is so small it should be zeroed out. @@ -625,7 +627,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, allocatable, dimension(:) :: wt_vel, wt_eta, wt_accel, wt_trans, wt_accel2 real :: sum_wt_vel, sum_wt_eta, sum_wt_accel, sum_wt_trans real :: I_sum_wt_vel, I_sum_wt_eta, I_sum_wt_accel, I_sum_wt_trans - real :: dt_filt ! The half-width of the barotropic filter, in s. + real :: dt_filt ! The half-width of the barotropic filter [s]. real :: trans_wt1, trans_wt2 ! weight used to compute ubt_trans and vbt_trans integer :: nfilter @@ -2389,12 +2391,12 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of !! the argument arrays. - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt !< the zonal barotropic velocity, in m s-1. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt !< the zonal barotropic velocity [m s-1]. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: uhbt !< the zonal barotropic transport !! [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_trans !< the zonal barotropic velocity used in !! transport, m s-1. - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt !< the meridional barotropic velocity, in m s-1. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt !< the meridional barotropic velocity [m s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vhbt !< the meridional barotropic transport !! [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt_trans !< the meridional BT velocity used in transports, @@ -2409,7 +2411,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, !! related to the open boundary conditions, !! set by set_up_BT_OBC. integer, intent(in) :: halo !< The extra halo size to use here. - real, intent(in) :: dtbt !< The time step, in s. + real, intent(in) :: dtbt !< The time step [s]. real, intent(in) :: bebt !< The fractional weighting of the future velocity !! in determining the transport. logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate @@ -2434,9 +2436,9 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, !! [H m2 s-1 ~> m3 s-1 or kg s-1]. ! Local variables - real :: vel_prev ! The previous velocity in m s-1. + real :: vel_prev ! The previous velocity [m s-1]. real :: vel_trans ! The combination of the previous and current velocity - ! that does the mass transport, in m s-1. + ! that does the mass transport [m s-1]. real :: H_u ! The total thickness at the u-point [H ~> m or kg m-2]. real :: H_v ! The total thickness at the v-point [H ~> m or kg m-2]. real :: cfl ! The CFL number at the point in question, ND. @@ -3034,7 +3036,7 @@ end subroutine btcalc !> The function find_uhbt determines the zonal transport for a given velocity. function find_uhbt(u, BTC) result(uhbt) - real, intent(in) :: u !< The local zonal velocity, in m s-1 + real, intent(in) :: u !< The local zonal velocity [m s-1] type(local_BT_cont_u_type), intent(in) :: BTC !< A structure containing various fields that !! allow the barotropic transports to be calculated consistently !! with the layers' continuity equations. @@ -3064,7 +3066,7 @@ function uhbt_to_ubt(uhbt, BTC, guess) result(ubt) !! layers' continuity equations. real, optional, intent(in) :: guess !< A guess at what ubt will be. The result is not allowed !! to be dramatically larger than guess. - real :: ubt !< The result - The velocity that gives uhbt transport, in m s-1. + real :: ubt !< The result - The velocity that gives uhbt transport [m s-1]. ! Local variables real :: ubt_min, ubt_max, uhbt_err, derr_du @@ -3148,7 +3150,7 @@ end function uhbt_to_ubt !> The function find_vhbt determines the meridional transport for a given velocity. function find_vhbt(v, BTC) result(vhbt) - real, intent(in) :: v !< The local meridional velocity, in m s-1 + real, intent(in) :: v !< The local meridional velocity [m s-1] type(local_BT_cont_v_type), intent(in) :: BTC !< A structure containing various fields that !! allow the barotropic transports to be calculated consistently !! with the layers' continuity equations. @@ -3177,7 +3179,7 @@ function vhbt_to_vbt(vhbt, BTC, guess) result(vbt) !! with the layers' continuity equations. real, optional, intent(in) :: guess !< A guess at what vbt will be. The result is not allowed !! to be dramatically larger than guess. - real :: vbt !< The result - The velocity that gives vhbt transport, in m s-1. + real :: vbt !< The result - The velocity that gives vhbt transport [m s-1]. ! Local variables real :: vbt_min, vbt_max, vhbt_err, derr_dv @@ -3394,12 +3396,12 @@ subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & G, MS, halo) type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the argument arrays. real, dimension(SZIBW_(MS),SZJW_(MS)), & - intent(in) :: ubt !< The linearization zonal barotropic velocity in m s-1. + intent(in) :: ubt !< The linearization zonal barotropic velocity [m s-1]. real, dimension(SZIBW_(MS),SZJW_(MS)), & intent(in) :: uhbt !< The linearization zonal barotropic transport !! [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), & - intent(in) :: vbt !< The linearization meridional barotropic velocity in m s-1. + intent(in) :: vbt !< The linearization meridional barotropic velocity [m s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), & intent(in) :: vhbt !< The linearization meridional barotropic transport !! [H m2 s-1 ~> m3 s-1 or kg s-1]. @@ -3700,9 +3702,9 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity, in m s-1. + intent(in) :: u !< The zonal velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity, in m s-1. + intent(in) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 1b32fc72e5..0984185c34 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -44,9 +44,9 @@ subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, haloshift, symmet type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity, in m s-1. + intent(in) :: u !< The zonal velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity, in m s-1. + intent(in) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -80,9 +80,9 @@ subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, haloshift, symmetric) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Zonal velocity, in m s-1. + intent(in) :: u !< Zonal velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Meridional velocity, in m s-1. + intent(in) :: v !< Meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). @@ -163,25 +163,26 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, pbce, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: CAu !< Zonal acceleration due to Coriolis - !! and momentum advection terms, in m s-2. + !! and momentum advection terms [m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: CAv !< Meridional acceleration due to Coriolis - !! and momentum advection terms, in m s-2. + !! and momentum advection terms [m s-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: PFu !< Zonal acceleration due to pressure gradients - !! (equal to -dM/dx) in m s-2. + !! (equal to -dM/dx) [m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: PFv !< Meridional acceleration due to pressure gradients - !! (equal to -dM/dy) in m s-2. + !! (equal to -dM/dy) [m s-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: diffu !< Zonal acceleration due to convergence of the - !! along-isopycnal stress tensor, in m s-2. + !! along-isopycnal stress tensor [m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: diffv !< Meridional acceleration due to convergence of - !! the along-isopycnal stress tensor, in m s-2. + !! the along-isopycnal stress tensor [m s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: pbce !< The baroclinic pressure anomaly in each layer - !! due to free surface height anomalies, in m2 s-2 H-1. + !! due to free surface height anomalies + !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: u_accel_bt !< The zonal acceleration from terms in the !! barotropic solver,in m s-2. @@ -216,9 +217,9 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity, in m s-1. + intent(in) :: u !< The zonal velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity, in m s-1. + intent(in) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, pointer, dimension(:,:,:), & diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index 121bbfbdb0..ac130d7ba4 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -57,7 +57,7 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: vh !< Volume flux through meridional faces = !! v*h*dx, in m3/s. - real, intent(in) :: dt !< Time increment, in s. + real, intent(in) :: dt !< Time increment [s]. type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The vertically summed volume diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index a0669a4ef9..9cc9198ef2 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -35,14 +35,14 @@ module MOM_continuity_PPM !! of the higher order interpolation. real :: tol_eta !< The tolerance for free-surface height !! discrepancies between the barotropic solution and - !! the sum of the layer thicknesses, in m. + !! the sum of the layer thicknesses [H ~> m or kg m-2]. real :: tol_vel !< The tolerance for barotropic velocity !! discrepancies between the barotropic solution and - !! the sum of the layer thicknesses, in m s-1. + !! the sum of the layer thicknesses [m s-1]. real :: tol_eta_aux !< The tolerance for free-surface height !! discrepancies between the barotropic solution and !! the sum of the layer thicknesses when calculating - !! the auxiliary corrected velocities, in m. + !! the auxiliary corrected velocities [H ~> m or kg m-2]. real :: CFL_limit_adjust !< The maximum CFL of the adjusted velocities, ND. logical :: aggress_adjust !< If true, allow the adjusted velocities to have a !! relative CFL change up to 0.5. False by default. @@ -78,9 +78,9 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(continuity_PPM_CS), pointer :: CS !< Module's control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Zonal velocity, in m s-1. + intent(in) :: u !< Zonal velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Meridional velocity, in m s-1. + intent(in) :: v !< Meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: hin !< Initial layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -89,7 +89,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, intent(out) :: uh !< Zonal volume flux, u*h*dy [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: vh !< Meridional volume flux, v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, intent(in) :: dt !< Time increment in s. + real, intent(in) :: dt !< Time increment [s]. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The summed volume flux through zonal faces @@ -115,10 +115,10 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: u_cor - !< The zonal velocities that give uhbt as the depth-integrated transport, in m s-1. + !< The zonal velocities that give uhbt as the depth-integrated transport [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor - !< The meridional velocities that give vhbt as the depth-integrated transport, in m s-1. + !< The meridional velocities that give vhbt as the depth-integrated transport [m s-1]. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt_aux !< A second set of summed volume fluxes through zonal faces @@ -130,11 +130,11 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: u_cor_aux !< The zonal velocities that give uhbt_aux as the depth-integrated - !! transports, in m s-1. + !! transports [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor_aux !< The meridional velocities that give vhbt_aux as the depth-integrated - !! transports, in m s-1. + !! transports [m s-1]. type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe !! the effective open face areas as a function of barotropic flow. @@ -231,13 +231,13 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Zonal velocity, in m s-1. + intent(in) :: u !< Zonal velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h_in !< Layer thickness used to calculate fluxes [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: uh !< Volume flux through zonal faces = u*h*dy !! [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, intent(in) :: dt !< Time increment in s. + real, intent(in) :: dt !< Time increment [s]. type(continuity_PPM_CS), pointer :: CS !< This module's control structure. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. type(ocean_OBC_type), & @@ -261,7 +261,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: u_cor_aux !< The zonal velocities (u with a barotropic correction) - !! that give uhbt_aux as the depth-integrated transports, in m s-1. + !! that give uhbt_aux as the depth-integrated transports [m s-1]. type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe the !! effective open face areas as a function of barotropic flow. @@ -269,7 +269,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & real, dimension(SZIB_(G),SZK_(G)) :: duhdu ! Partial derivative of uh with u [H m ~> m2 or kg m-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_L, h_R ! Left and right face thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G)) :: & - du, & ! Corrective barotropic change in the velocity, in m s-1. + du, & ! Corrective barotropic change in the velocity [m s-1]. du_min_CFL, & ! Min/max limits on du correction du_max_CFL, & ! to avoid CFL violations duhdu_tot_0, & ! Summed partial derivative of uh with u [H m ~> m2 or kg m-1]. @@ -284,7 +284,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & real :: CFL_dt ! The maximum CFL ratio of the adjusted velocities divided by ! the time step, in s-1. real :: I_dt ! 1.0 / dt, in s-1. - real :: du_lim ! The velocity change that give a relative CFL of 1, in m s-1. + real :: du_lim ! The velocity change that give a relative CFL of 1 [m s-1]. real :: dx_E, dx_W ! Effective x-grid spacings to the east and west, in m. integer :: i, j, k, ish, ieh, jsh, jeh, n, nz logical :: do_aux, local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC @@ -540,7 +540,7 @@ end subroutine zonal_mass_flux subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, & ish, ieh, do_I, vol_CFL, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZIB_(G)), intent(in) :: u !< Zonal velocity, in m s-1. + real, dimension(SZIB_(G)), intent(in) :: u !< Zonal velocity [m s-1]. real, dimension(SZIB_(G)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step !! of viscosity, and the fraction of a time-step's worth of a barotropic @@ -553,7 +553,7 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, & !! transport [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(inout) :: duhdu !< Partial derivative of uh !! with u [H m ~> m2 or kg m-1]. - real, intent(in) :: dt !< Time increment in s. + real, intent(in) :: dt !< Time increment [s]. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. integer, intent(in) :: ieh !< End of index range. @@ -616,7 +616,7 @@ end subroutine zonal_flux_layer subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, & marginal, visc_rem_u, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity, in m s-1. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the @@ -624,7 +624,7 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the !! reconstruction [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_u !< Thickness at zonal faces [H ~> m or kg m-2]. - real, intent(in) :: dt !< Time increment in s. + real, intent(in) :: dt !< Time increment [s]. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. logical, intent(in) :: vol_CFL !< If true, rescale the ratio !! of face areas to the cell areas when estimating the CFL number. @@ -723,7 +723,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & du, du_max_CFL, du_min_CFL, dt, G, CS, visc_rem, & j, ish, ieh, do_I_in, full_precision, uh_3d, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity, in m s-1. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the @@ -739,16 +739,16 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & !! through zonal faces [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(in) :: du_max_CFL !< Maximum acceptable - !! value of du, in m s-1. + !! value of du [m s-1]. real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable - !! value of du, in m s-1. + !! value of du [m s-1]. real, dimension(SZIB_(G)), intent(in) :: uh_tot_0 !< The summed transport !! with 0 adjustment [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(in) :: duhdu_tot_0 !< The partial derivative !! of du_err with du at 0 adjustment [H m ~> m2 or kg m-1]. real, dimension(SZIB_(G)), intent(out) :: du !< - !! The barotropic velocity adjustment, in m s-1. - real, intent(in) :: dt !< Time increment in s. + !! The barotropic velocity adjustment [m s-1]. + real, intent(in) :: dt !< Time increment [s]. type(continuity_PPM_CS), pointer :: CS !< This module's control structure. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. @@ -768,14 +768,14 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & real, dimension(SZIB_(G)) :: & uh_err, & ! Difference between uhbt and the summed uh [H m2 s-1 ~> m3 s-1 or kg s-1]. uh_err_best, & ! The smallest value of uh_err found so far [H m2 s-1 ~> m3 s-1 or kg s-1]. - u_new, & ! The velocity with the correction added, in m s-1. + u_new, & ! The velocity with the correction added [m s-1]. duhdu_tot,&! Summed partial derivative of uh with u [H m ~> m2 or kg m-1]. du_min, & ! Min/max limits on du correction based on CFL limits - du_max ! and previous iterations, in m s-1. - real :: du_prev ! The previous value of du, in m s-1. - real :: ddu ! The change in du from the previous iteration, in m s-1. - real :: tol_eta ! The tolerance for the current iteration, in m. - real :: tol_vel ! The tolerance for velocity in the current iteration, m s-1. + du_max ! and previous iterations [m s-1]. + real :: du_prev ! The previous value of du [m s-1]. + real :: ddu ! The change in du from the previous iteration [m s-1]. + real :: tol_eta ! The tolerance for the current iteration [H ~> m or kg m-2]. + real :: tol_vel ! The tolerance for velocity in the current iteration [m s-1]. integer :: i, k, nz, itt, max_itts = 20 logical :: full_prec, domore, do_I(SZIB_(G)) @@ -886,7 +886,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, du_max_CFL, du_min_CFL, dt, G, CS, visc_rem, & visc_rem_max, j, ish, ieh, do_I) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity, in m s-1. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the @@ -900,10 +900,10 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, real, dimension(SZIB_(G)), intent(in) :: duhdu_tot_0 !< The partial derivative !! of du_err with du at 0 adjustment [H m ~> m2 or kg m-1]. real, dimension(SZIB_(G)), intent(in) :: du_max_CFL !< Maximum acceptable - !! value of du, in m s-1. + !! value of du [m s-1]. real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable - !! value of du, in m s-1. - real, intent(in) :: dt !< Time increment in s. + !! value of du [m s-1]. + real, intent(in) :: dt !< Time increment [s]. type(continuity_PPM_CS), pointer :: CS !< This module's control structure. real, dimension(SZIB_(G),SZK_(G)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step of viscosity, and @@ -922,9 +922,9 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, duL, duR, & ! The barotropic velocity increments that give the westerly ! (duL) and easterly (duR) test velocities. zeros, & ! An array of full of 0's. - du_CFL, & ! The velocity increment that corresponds to CFL_min, in m s-1. + du_CFL, & ! The velocity increment that corresponds to CFL_min [m s-1]. u_L, u_R, & ! The westerly (u_L), easterly (u_R), and zero-barotropic - u_0, & ! transport (u_0) layer test velocities, in m s-1. + u_0, & ! transport (u_0) layer test velocities [m s-1]. FA_marg_L, & ! The effective layer marginal face areas with the westerly FA_marg_R, & ! (_L), easterly (_R), and zero-barotropic (_0) test FA_marg_0, & ! velocities [H m ~> m2 or kg m-1]. @@ -1051,12 +1051,12 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & visc_rem_v, v_cor, vhbt_aux, v_cor_aux, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vh !< Volume flux through meridional !! faces = v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, intent(in) :: dt !< Time increment in s. + real, intent(in) :: dt !< Time increment [s]. type(continuity_PPM_CS), pointer :: CS !< This module's control structure. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. type(ocean_OBC_type), optional, pointer :: OBC !< Open boundary condition type @@ -1074,20 +1074,20 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor !< The meridional velocitiess (v with a barotropic correction) - !! that give vhbt as the depth-integrated transport, m s-1. + !! that give vhbt as the depth-integrated transport [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor_aux !< The meridional velocities (v with a barotropic correction) - !! that give vhbt_aux as the depth-integrated transports, in m s-1. + !! that give vhbt_aux as the depth-integrated transports [m s-1]. type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe !! the effective open face areas as a function of barotropic flow. ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & - dvhdv ! Partial derivative of vh with v, in m2. + dvhdv ! Partial derivative of vh with v [H m ~> m2 or kg m-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - h_L, h_R ! Left and right face thicknesses, in m. + h_L, h_R ! Left and right face thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G)) :: & - dv, & ! Corrective barotropic change in the velocity, in m s-1. + dv, & ! Corrective barotropic change in the velocity [m s-1]. dv_min_CFL, & ! Min/max limits on dv correction dv_max_CFL, & ! to avoid CFL violations dvhdv_tot_0, & ! Summed partial derivative of vh with v [H m ~> m2 or kg m-1]. @@ -1102,8 +1102,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & real :: CFL_dt ! The maximum CFL ratio of the adjusted velocities divided by ! the time step, in s-1. real :: I_dt ! 1.0 / dt, in s-1. - real :: dv_lim ! The velocity change that give a relative CFL of 1, in m s-1. - real :: dy_N, dy_S ! Effective y-grid spacings to the north and south, in m. + real :: dv_lim ! The velocity change that give a relative CFL of 1 [m s-1]. + real :: dy_N, dy_S ! Effective y-grid spacings to the north and south [m]. integer :: i, j, k, ish, ieh, jsh, jeh, n, nz logical :: do_aux, local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC logical :: local_Flather_OBC, is_simple, local_open_BC @@ -1357,7 +1357,7 @@ end subroutine meridional_mass_flux subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, & ish, ieh, do_I, vol_CFL, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZI_(G)), intent(in) :: v !< Meridional velocity, in m s-1. + real, dimension(SZI_(G)), intent(in) :: v !< Meridional velocity [m s-1]. real, dimension(SZI_(G)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step !! of viscosity, and the fraction of a time-step's worth of a barotropic @@ -1373,7 +1373,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, & !! [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(inout) :: dvhdv !< Partial derivative of vh with v !! [H m ~> m2 or kg m-1]. - real, intent(in) :: dt !< Time increment in s. + real, intent(in) :: dt !< Time increment [s]. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. integer, intent(in) :: ieh !< End of index range. @@ -1384,8 +1384,8 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, & ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. real :: curv_3 ! A measure of the thickness curvature over a grid length, - ! with the same units as h_in. - real :: h_marg ! The marginal thickness of a flux, in m. + ! with the same units as h, i.e. [H ~> m or kg m-2]. + real :: h_marg ! The marginal thickness of a flux [H ~> m or kg m-2]. integer :: i logical :: local_open_BC @@ -1437,7 +1437,7 @@ end subroutine merid_flux_layer subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & marginal, visc_rem_v, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness used to calculate fluxes, !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, @@ -1446,7 +1446,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: h_v !< Thickness at meridional faces, !! [H ~> m or kg m-2]. - real, intent(in) :: dt !< Time increment in s. + real, intent(in) :: dt !< Time increment [s]. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. logical, intent(in) :: vol_CFL !< If true, rescale the ratio !! of face areas to the cell areas when estimating the CFL number. @@ -1546,7 +1546,7 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 j, ish, ieh, do_I_in, full_precision, vh_3d, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Meridional velocity, in m s-1. + intent(in) :: v !< Meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h_in !< Layer thickness used to calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& @@ -1562,14 +1562,14 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 real, dimension(SZI_(G)), & optional, intent(in) :: vhbt !< The summed volume flux through meridional faces !! [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv, in m s-1. - real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv, in m s-1. + real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv [m s-1]. + real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv [m s-1]. real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< The summed transport with 0 adjustment !! [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< The partial derivative of dv_err with !! dv at 0 adjustment [H m ~> m2 or kg m-1]. - real, dimension(SZI_(G)), intent(out) :: dv !< The barotropic velocity adjustment, in m s-1. - real, intent(in) :: dt !< Time increment in s. + real, dimension(SZI_(G)), intent(out) :: dv !< The barotropic velocity adjustment [m s-1]. + real, intent(in) :: dt !< Time increment [s]. type(continuity_PPM_CS), pointer :: CS !< This module's control structure. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. @@ -1589,14 +1589,14 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 real, dimension(SZI_(G)) :: & vh_err, & ! Difference between vhbt and the summed vh [H m2 s-1 ~> m3 s-1 or kg s-1]. vh_err_best, & ! The smallest value of vh_err found so far [H m2 s-1 ~> m3 s-1 or kg s-1]. - v_new, & ! The velocity with the correction added, in m s-1. + v_new, & ! The velocity with the correction added [m s-1]. dvhdv_tot,&! Summed partial derivative of vh with u [H m ~> m2 or kg m-1]. dv_min, & ! Min/max limits on dv correction based on CFL limits - dv_max ! and previous iterations, in m s-1. - real :: dv_prev ! The previous value of dv, in m s-1. - real :: ddv ! The change in dv from the previous iteration, in m s-1. - real :: tol_eta ! The tolerance for the current iteration, in m. - real :: tol_vel ! The tolerance for velocity in the current iteration, m s-1. + dv_max ! and previous iterations [m s-1]. + real :: dv_prev ! The previous value of dv [m s-1]. + real :: ddv ! The change in dv from the previous iteration [m s-1]. + real :: tol_eta ! The tolerance for the current iteration [H ~> m or kg m-2]. + real :: tol_vel ! The tolerance for velocity in the current iteration [m s-1]. integer :: i, k, nz, itt, max_itts = 20 logical :: full_prec, domore, do_I(SZI_(G)) @@ -1707,7 +1707,7 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, dv_max_CFL, dv_min_CFL, dt, G, CS, visc_rem, & visc_rem_max, j, ish, ieh, do_I) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to calculate fluxes, !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, @@ -1720,9 +1720,9 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, !! with 0 adjustment [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< The partial derivative !! of du_err with dv at 0 adjustment [H m ~> m2 or kg m-1]. - real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv, in m s-1. - real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv, in m s-1. - real, intent(in) :: dt !< Time increment in s. + real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv [m s-1]. + real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv [m s-1]. + real, intent(in) :: dt !< Time increment [s]. type(continuity_PPM_CS), pointer :: CS !< This module's control structure. real, dimension(SZI_(G),SZK_(G)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step @@ -1737,13 +1737,13 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, !! which I values to work on. ! Local variables real, dimension(SZI_(G)) :: & - dv0, & ! The barotropic velocity increment that gives 0 transport, m s-1. + dv0, & ! The barotropic velocity increment that gives 0 transport [m s-1]. dvL, dvR, & ! The barotropic velocity increments that give the southerly ! (dvL) and northerly (dvR) test velocities. zeros, & ! An array of full of 0's. - dv_CFL, & ! The velocity increment that corresponds to CFL_min, in m s-1. + dv_CFL, & ! The velocity increment that corresponds to CFL_min [m s-1]. v_L, v_R, & ! The southerly (v_L), northerly (v_R), and zero-barotropic - v_0, & ! transport (v_0) layer test velocities, in m s-1. + v_0, & ! transport (v_0) layer test velocities [m s-1]. FA_marg_L, & ! The effective layer marginal face areas with the southerly FA_marg_R, & ! (_L), northerly (_R), and zero-barotropic (_0) test FA_marg_0, & ! velocities [H m ~> m2 or kg m-1]. @@ -1753,8 +1753,8 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, FAmt_0, & ! test velocities [H m ~> m2 or kg m-1]. vhtot_L, & ! The summed transport with the southerly (vhtot_L) and vhtot_R ! and northerly (vhtot_R) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: FA_0 ! The effective face area with 0 barotropic transport, in m H. - real :: FA_avg ! The average effective face area, in m H, nominally given by + real :: FA_0 ! The effective face area with 0 barotropic transport [H m ~> m2 or kg m-1]. + real :: FA_avg ! The average effective face area [H m ~> m2 or kg m-1], nominally given by ! the realized transport divided by the barotropic velocity. real :: visc_rem_lim ! The larger of visc_rem and min_visc_rem, ND. This ! limiting is necessary to keep the inverse of visc_rem @@ -2236,7 +2236,7 @@ end function ratio_max !> Initializes continuity_ppm_cs subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) - type(time_type), target, intent(in) :: Time !< Time increment in s. + type(time_type), target, intent(in) :: Time !< Time increment [s]. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(param_file_type), intent(in) :: param_file !< A structure indicating diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 44c57576d8..427fbcaee4 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -235,9 +235,9 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - target, intent(inout) :: u !< zonal velocity (m/s) + target, intent(inout) :: u !< zonal velocity [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - target, intent(inout) :: v !< merid velocity (m/s) + target, intent(inout) :: v !< merid velocity [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic type @@ -960,9 +960,9 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: u !< zonal velocity (m/s) + intent(inout) :: u !< zonal velocity [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: v !< merid velocity (m/s) + intent(inout) :: v !< merid velocity [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & target, intent(inout) :: uh !< zonal volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1] diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 060b89dd16..73fe114597 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -106,14 +106,14 @@ module MOM_dynamics_unsplit !> MOM_dynamics_unsplit module control structure type, public :: MOM_dyn_unsplit_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - CAu, & !< CAu = f*v - u.grad(u) in m s-2. - PFu, & !< PFu = -dM/dx, in m s-2. - diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor, in m s-2. + CAu, & !< CAu = f*v - u.grad(u) [m s-2]. + PFu, & !< PFu = -dM/dx [m s-2]. + diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - CAv, & !< CAv = -f*u - u.grad(v) in m s-2. - PFv, & !< PFv = -dM/dy, in m s-2. - diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor, in m s-2. + CAv, & !< CAv = -f*u - u.grad(v) [m s-2]. + PFv, & !< PFv = -dM/dy [m s-2]. + diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-2]. real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor (Pa) real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor (Pa) @@ -186,8 +186,8 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity, in m s-1. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity, in m s-1. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity [m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. !! (usually m or kg m-2). type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various @@ -196,12 +196,12 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & !! viscosities, bottom drag viscosities, and related fields. type(time_type), intent(in) :: Time_local !< The model time at the end !! of the time step. - real, intent(in) :: dt !< The dynamics time step, in s. + real, intent(in) :: dt !< The dynamics time step [s]. type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to the surface - !! pressure at the start of this dynamic step, in Pa. + !! pressure at the start of this dynamic step [Pa]. real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the surface - !! pressure at the end of this dynamic step, in Pa. + !! pressure at the end of this dynamic step [Pa]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh !< The zonal volume or mass transport, !! in m3 s-1 or kg s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh !< The meridional volume or mass @@ -566,9 +566,9 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: u !< The zonal velocity, in m s-1. + intent(inout) :: u !< The zonal velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: v !< The meridional velocity, in m s-1. + intent(inout) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , & intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] !! (usually m or kg m-2). diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index df8a41ea68..ca4edfb0a3 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -102,14 +102,14 @@ module MOM_dynamics_unsplit_RK2 !> MOM_dynamics_unsplit_RK2 module control structure type, public :: MOM_dyn_unsplit_RK2_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - CAu, & !< CAu = f*v - u.grad(u) in m s-2. - PFu, & !< PFu = -dM/dx, in m s-2. - diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor, in m s-2. + CAu, & !< CAu = f*v - u.grad(u) [m s-2]. + PFu, & !< PFu = -dM/dx [m s-2]. + diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - CAv, & !< CAv = -f*u - u.grad(v) in m s-2. - PFv, & !< PFv = -dM/dy, in m s-2. - diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor, in m s-2. + CAv, & !< CAv = -f*u - u.grad(v) [m s-2]. + PFv, & !< PFv = -dM/dy [m s-2]. + diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-2]. real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor (Pa) real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor (Pa) @@ -189,9 +189,9 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u_in !< The input and output zonal - !! velocity, in m s-1. + !! velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v_in !< The input and output meridional - !! velocity, in m s-1. + !! velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_in !< The input and output layer thicknesses, !! in m or kg m-2, depending on whether !! the Boussinesq approximation is made. @@ -202,15 +202,14 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! viscosities, and related fields. type(time_type), intent(in) :: Time_local !< The model time at the end of !! the time step. - real, intent(in) :: dt !< The baroclinic dynamics time step, - !! in s. + real, intent(in) :: dt !< The baroclinic dynamics time step [s]. type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to !! the surface pressure at the beginning - !! of this dynamic step, in Pa. + !! of this dynamic step [Pa]. real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to !! the surface pressure at the end of - !! this dynamic step, in Pa. + !! this dynamic step [Pa]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh !< The zonal volume or mass transport, !! in m3 s-1 or kg s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh !< The meridional volume or mass @@ -511,9 +510,8 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity, in m s-1. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity, - !! in m s-1. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity [m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] !! (usually m or kg m-2). type(time_type), target, intent(in) :: Time !< The current model time. @@ -528,7 +526,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< A set of pointers to the !! various accelerations in the momentum equations, which can !! be used for later derived diagnostics, like energy budgets. - type(cont_diag_ptrs), target, intent(inout) :: Cont_diag ! NULL(), & !< tidal energy source driving mixing in bottom boundary layer (W/m^2) - ustar_tidal => NULL() !< tidal contribution to bottom ustar (m/s) + ustar_tidal => NULL() !< tidal contribution to bottom ustar [m s-1] ! iceberg related inputs real, pointer, dimension(:,:) :: & @@ -346,14 +346,15 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, type(optics_type), pointer :: optics !< pointer to optics integer, intent(in) :: nsw !< number of bands of penetrating SW integer, intent(in) :: j !< j-index to work on - real, intent(in) :: dt !< time step in seconds - real, intent(in) :: FluxRescaleDepth !< min ocean depth before scale away fluxes (H) + real, intent(in) :: dt !< time step [s] + real, intent(in) :: FluxRescaleDepth !< min ocean depth before fluxes + !! are scaled away [H ~> m or kg m-2] logical, intent(in) :: useRiverHeatContent !< logical for river heat content logical, intent(in) :: useCalvingHeatContent !< logical for calving heat content real, dimension(SZI_(G),SZK_(G)), & intent(in) :: h !< layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: T !< layer temperatures (degC) + intent(in) :: T !< layer temperatures [degC] real, dimension(SZI_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux !! (if Bouss) of water in/out of ocean over !! a time step [H ~> m or kg m-2] @@ -778,14 +779,15 @@ subroutine extractFluxes2d(G, GV, fluxes, optics, nsw, dt, FluxRescaleDepth, & type(optics_type), pointer :: optics !< pointer to optics integer, intent(in) :: nsw !< number of bands of penetrating SW real, intent(in) :: dt !< time step in seconds - real, intent(in) :: FluxRescaleDepth !< min ocean depth before scale away fluxes (H) + real, intent(in) :: FluxRescaleDepth !< min ocean depth before fluxes + !! are scaled away [H ~> m or kg m-2] logical, intent(in) :: useRiverHeatContent !< logical for river heat content logical, intent(in) :: useCalvingHeatContent !< logical for calving heat content real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: T !< layer temperatures (deg C) - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux + intent(in) :: T !< layer temperatures [degC] + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux !! (if Bouss) of water in/out of ocean over !! a time step [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassOut !< net mass flux (non-Bouss) or volume flux @@ -797,11 +799,11 @@ subroutine extractFluxes2d(G, GV, fluxes, optics, nsw, dt, FluxRescaleDepth, & !! (1) downwelling (penetrative) SW, !! (2) evaporation heat content, !! (since do not yet know temperature of evap). - !! Units of net_heat are (K * H). + !! Units of net_heat are (degC H). real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated - !! over a time step (ppt * H) + !! over a time step (ppt H) real, dimension(:,:,:), intent(out) :: pen_SW_bnd !< penetrating shortwave flux, split into bands. - !! Units (deg K * H) & array size nsw x SZI_(G), + !! Units (degC H) & array size nsw x SZI_(G), !! where nsw=number of SW bands in pen_SW_bnd. !! This heat flux is not in net_heat. type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available @@ -836,8 +838,8 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(forcing), intent(inout) :: fluxes !< surface fluxes type(optics_type), pointer :: optics !< penetrating SW optics - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness (H) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< prognostic temp(deg C) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< prognostic temp (degC) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< salinity (ppt) type(thermo_var_ptrs), intent(inout) :: tv !< thermodynamics type integer, intent(in) :: j !< j-row to work on @@ -926,7 +928,7 @@ subroutine calculateBuoyancyFlux2d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(forcing), intent(inout) :: fluxes !< surface fluxes type(optics_type), pointer :: optics !< SW ocean optics - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness (H) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< temperature (deg C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< salinity (ppt) type(thermo_var_ptrs), intent(inout) :: tv !< thermodynamics type diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 8a62950574..2db50716e9 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -152,7 +152,7 @@ module MOM_grid real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points, in s-1 m-1. df_dy !< Derivative d/dy f (Coriolis parameter) at h-points, in s-1 m-1. - real :: g_Earth !< The gravitational acceleration in m s-2. + real :: g_Earth !< The gravitational acceleration [m s-2]. ! These variables are global sums that are useful for 1-d diagnostics real :: areaT_global !< Global sum of h-cell area in m2 diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 8fd4cc06f5..d101f9a91e 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -75,7 +75,7 @@ module MOM_open_boundary integer :: nk_src !< Number of vertical levels in the source data real, dimension(:,:,:), pointer :: dz_src=>NULL() !< vertical grid cell spacing of the incoming segment data (m) real, dimension(:,:,:), pointer :: buffer_dst=>NULL() !< buffer src data remapped to the target vertical grid - real, dimension(:,:), pointer :: bt_vel=>NULL() !< barotropic velocity (m s-1) + real, dimension(:,:), pointer :: bt_vel=>NULL() !< barotropic velocity [m s-1] real :: value !< constant value if fid is equal to -1 end type OBC_segment_data_type @@ -145,15 +145,15 @@ module MOM_open_boundary real, pointer, dimension(:,:) :: Htot=>NULL() !< The total column thickness (m) at OBC-points. real, pointer, dimension(:,:,:) :: h=>NULL() !< The cell thickness (m) at OBC-points. real, pointer, dimension(:,:,:) :: normal_vel=>NULL() !< The layer velocity normal to the OB - !! segment (m s-1). + !! segment [m s-1]. real, pointer, dimension(:,:,:) :: tangential_vel=>NULL() !< The layer velocity tangential to the - !! OB segment (m s-1). + !! OB segment [m s-1]. real, pointer, dimension(:,:,:) :: tangential_grad=>NULL() !< The gradient of the velocity tangential - !! to the OB segment (m s-1). + !! to the OB segment [m s-1]. real, pointer, dimension(:,:,:) :: normal_trans=>NULL() !< The layer transport normal to the OB !! segment (m3 s-1). real, pointer, dimension(:,:) :: normal_vel_bt=>NULL() !< The barotropic velocity normal to - !! the OB segment (m s-1). + !! the OB segment [m s-1]. real, pointer, dimension(:,:) :: eta=>NULL() !< The sea-surface elevation along the segment (m). real, pointer, dimension(:,:,:) :: grad_normal=>NULL() !< The gradient of the normal flow along the !! segment (s-1) @@ -168,9 +168,9 @@ module MOM_open_boundary real, pointer, dimension(:,:,:) :: cff_normal=>NULL() !< The denominator for oblique radiation !! for normal velocity real, pointer, dimension(:,:,:) :: nudged_normal_vel=>NULL() !< The layer velocity normal to the OB segment - !! that values should be nudged towards (m s-1). + !! that values should be nudged towards [m s-1]. real, pointer, dimension(:,:,:) :: nudged_tangential_vel=>NULL() !< The layer velocity tangential to the OB segment - !! that values should be nudged towards (m s-1). + !! that values should be nudged towards [m s-1]. real, pointer, dimension(:,:,:) :: nudged_tangential_grad=>NULL() !< The layer dvdx or dudy towards which nudging !! can occur (s-1). type(segment_tracer_registry_type), pointer :: tr_Reg=> NULL()!< A pointer to the tracer registry for the segment. @@ -226,7 +226,7 @@ module MOM_open_boundary logical :: zero_biharmonic = .false. !< If True, zeros the Laplacian of flow on open boundaries for !! use in the biharmonic viscosity term. logical :: brushcutter_mode = .false. !< If True, read data on supergrid. - real :: g_Earth !< The gravitational acceleration in m s-2. + real :: g_Earth !< The gravitational acceleration [m s-2]. ! Properties of the segments used. type(OBC_segment_type), pointer, dimension(:) :: & segment => NULL() !< List of segment objects. @@ -241,7 +241,7 @@ module MOM_open_boundary !! new time level (1) or the running mean (0) for velocities. !! Valid values range from 0 to 1, with a default of 0.3. real :: rx_max !< The maximum magnitude of the baroclinic radiation - !! velocity (or speed of characteristics), in m s-1. The + !! velocity (or speed of characteristics) [m s-1]. The !! default value is 10 m s-1. logical :: OBC_pe !< Is there an open boundary on this tile? type(remapping_CS), pointer :: remap_CS !< ALE remapping control structure for segments only @@ -2836,8 +2836,8 @@ end subroutine deallocate_OBC_segment_data subroutine open_boundary_test_extern_uv(G, OBC, u, v) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(ocean_OBC_type), pointer :: OBC !< Open boundary structure - real, dimension(SZIB_(G),SZJ_(G), SZK_(G)),intent(inout) :: u !< Zonal velocity (m/s) - real, dimension(SZI_(G),SZJB_(G), SZK_(G)),intent(inout) :: v !< Meridional velocity (m/s) + real, dimension(SZIB_(G),SZJ_(G), SZK_(G)),intent(inout) :: u !< Zonal velocity [m s-1] + real, dimension(SZI_(G),SZJB_(G), SZK_(G)),intent(inout) :: v !< Meridional velocity [m s-1] ! Local variables integer :: i, j, k, n diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index cd121de985..7404c25a43 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -41,8 +41,8 @@ module MOM_variables SSS, & !< The sea surface salinity in psu. sfc_density, & !< The mixed layer density in kg m-3. Hml, & !< The mixed layer depth in m. - u, & !< The mixed layer zonal velocity in m s-1. - v, & !< The mixed layer meridional velocity in m s-1. + u, & !< The mixed layer zonal velocity [m s-1]. + v, & !< The mixed layer meridional velocity [m s-1]. sea_lev, & !< The sea level in m. If a reduced surface gravity is !! used, that is compensated for in sea_lev. melt_potential, & !< instantaneous amount of heat that can be used to melt sea ice, @@ -125,28 +125,28 @@ module MOM_variables real, pointer, dimension(:,:,:) :: & T => NULL(), & !< Pointer to the temperature state variable, in deg C S => NULL(), & !< Pointer to the salinity state variable, in PSU or g/kg - u => NULL(), & !< Pointer to the zonal velocity, in m s-1 - v => NULL(), & !< Pointer to the meridional velocity, in m s-1 + u => NULL(), & !< Pointer to the zonal velocity [m s-1] + v => NULL(), & !< Pointer to the meridional velocity [m s-1] h => NULL() !< Pointer to the layer thicknesses [H ~> m or kg m-2] real, pointer, dimension(:,:,:) :: & uh => NULL(), & !< Pointer to zonal transports [H m2 s-1 ~> m3 s-1 or kg s-1] vh => NULL() !< Pointer to meridional transports [H m2 s-1 ~> m3 s-1 or kg s-1] real, pointer, dimension(:,:,:) :: & - CAu => NULL(), & !< Pointer to the zonal Coriolis and Advective acceleration, in m s-2 - CAv => NULL(), & !< Pointer to the meridional Coriolis and Advective acceleration, in m s-2 - PFu => NULL(), & !< Pointer to the zonal Pressure force acceleration, in m s-2 - PFv => NULL(), & !< Pointer to the meridional Pressure force acceleration, in m s-2 - diffu => NULL(), & !< Pointer to the zonal acceleration due to lateral viscosity, in m s-2 - diffv => NULL(), & !< Pointer to the meridional acceleration due to lateral viscosity, in m s-2 + CAu => NULL(), & !< Pointer to the zonal Coriolis and Advective acceleration [m s-2] + CAv => NULL(), & !< Pointer to the meridional Coriolis and Advective acceleration [m s-2] + PFu => NULL(), & !< Pointer to the zonal Pressure force acceleration [m s-2] + PFv => NULL(), & !< Pointer to the meridional Pressure force acceleration [m s-2] + diffu => NULL(), & !< Pointer to the zonal acceleration due to lateral viscosity [m s-2] + diffv => NULL(), & !< Pointer to the meridional acceleration due to lateral viscosity [m s-2] pbce => NULL(), & !< Pointer to the baroclinic pressure force dependency on free surface movement !! [m2 s-2 H-1 ~> m s-2 or m4 kg-1 s-2] - u_accel_bt => NULL(), & !< Pointer to the zonal barotropic-solver acceleration, in m s-2 - v_accel_bt => NULL() !< Pointer to the meridional barotropic-solver acceleration, in m s-2 + u_accel_bt => NULL(), & !< Pointer to the zonal barotropic-solver acceleration [m s-2] + v_accel_bt => NULL() !< Pointer to the meridional barotropic-solver acceleration [m s-2] real, pointer, dimension(:,:,:) :: & - u_av => NULL(), & !< Pointer to zonal velocity averaged over the timestep, in m s-1 - v_av => NULL(), & !< Pointer to meridional velocity averaged over the timestep, in m s-1 - u_prev => NULL(), & !< Pointer to zonal velocity at the end of the last timestep, in m s-1 - v_prev => NULL() !< Pointer to meridional velocity at the end of the last timestep, in m s-1 + u_av => NULL(), & !< Pointer to zonal velocity averaged over the timestep [m s-1] + v_av => NULL(), & !< Pointer to meridional velocity averaged over the timestep [m s-1] + u_prev => NULL(), & !< Pointer to zonal velocity at the end of the last timestep [m s-1] + v_prev => NULL() !< Pointer to meridional velocity at the end of the last timestep [m s-1] end type ocean_internal_state !> Pointers to arrays with accelerations, which can later be used for derived diagnostics, like energy balances. @@ -166,10 +166,10 @@ module MOM_variables dv_dt_dia => NULL() !< Meridional acceleration due to diapycnal mixing [m s-2] real, pointer, dimension(:,:,:) :: du_other => NULL() !< Zonal velocity changes due to any other processes that are - !! not due to any explicit accelerations, in m s-1. + !! not due to any explicit accelerations [m s-1]. real, pointer, dimension(:,:,:) :: dv_other => NULL() !< Meridional velocity changes due to any other processes that are - !! not due to any explicit accelerations, in m s-1. + !! not due to any explicit accelerations [m s-1]. ! These accelerations are sub-terms included in the accelerations above. real, pointer :: gradKEu(:,:,:) => NULL() !< gradKEu = - d/dx(u2) [m s-2] diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index d6ba417d3a..4b6f3982c8 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -47,10 +47,10 @@ module MOM_PointAccel ! that are used to step the physical model forward. They all use the same ! names as the variables they point to in MOM.F90 real, pointer, dimension(:,:,:) :: & - u_av => NULL(), & !< Time average u-velocity in m s-1. - v_av => NULL(), & !< Time average velocity in m s-1. - u_prev => NULL(), & !< Previous u-velocity in m s-1. - v_prev => NULL(), & !< Previous v-velocity in m s-1. + u_av => NULL(), & !< Time average u-velocity [m s-1]. + v_av => NULL(), & !< Time average velocity [m s-1]. + u_prev => NULL(), & !< Previous u-velocity [m s-1]. + v_prev => NULL(), & !< Previous v-velocity [m s-1]. T => NULL(), & !< Temperature [degC]. S => NULL(), & !< Salinity [ppt]. u_accel_bt => NULL(), & !< Barotropic u-acclerations [m s-2] @@ -73,7 +73,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: um !< The new zonal velocity, in m s-1. + intent(in) :: um !< The new zonal velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: hin !< The layer thickness [H ~> m or kg m-2]. type(accel_diag_ptrs), intent(in) :: ADp !< A structure pointing to the various @@ -83,7 +83,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st real, intent(in) :: dt !< The ocean dynamics time step [s]. type(PointAccel_CS), pointer :: CS !< The control structure returned by a previous !! call to PointAccel_init. - real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report, in m s-1. + real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [m s-1]. real, optional, intent(in) :: str !< The surface wind stress integrated over a time !! step, in m2 s-1. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -404,7 +404,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: vm !< The new meridional velocity, in m s-1. + intent(in) :: vm !< The new meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: hin !< The layer thickness [H ~> m or kg m-2]. type(accel_diag_ptrs), intent(in) :: ADp !< A structure pointing to the various @@ -414,7 +414,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st real, intent(in) :: dt !< The ocean dynamics time step [s]. type(PointAccel_CS), pointer :: CS !< The control structure returned by a previous !! call to PointAccel_init. - real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report, in m s-1. + real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [m s-1]. real, optional, intent(in) :: str !< The surface wind stress integrated over a time !! step, in m2 s-1. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index a984fb26e1..10ccc424a0 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -49,8 +49,8 @@ module MOM_diag_to_Z ! module and unavailable outside of it. real, pointer, dimension(:,:,:) :: & - u_z => NULL(), & !< zonal velocity remapped to depth space (m/s) - v_z => NULL(), & !< meridional velocity remapped to depth space (m/s) + u_z => NULL(), & !< zonal velocity remapped to depth space [m s-1] + v_z => NULL(), & !< meridional velocity remapped to depth space [m s-1] uh_z => NULL(), & !< zonal transport remapped to depth space [H m2 s-1 ~> m3 s-1 or kg s-1] vh_z => NULL() !< meridional transport remapped to depth space [H m2 s-1 ~> m3 s-1 or kg s-1] @@ -150,9 +150,9 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, US, CS) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity, in m s-1. + intent(in) :: u !< The zonal velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity, in m s-1. + intent(in) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 61d3230d44..1bc72c5ba4 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -69,7 +69,7 @@ module MOM_diagnostics real, pointer, dimension(:,:,:) :: & du_dt => NULL(), & !< net i-acceleration in m/s2 dv_dt => NULL(), & !< net j-acceleration in m/s2 - dh_dt => NULL(), & !< thickness rate of change in (m/s) or kg/(m2*s) + dh_dt => NULL(), & !< thickness rate of change in [m s-1] or kg/(m2*s) p_ebt => NULL() !< Equivalent barotropic modal structure real, pointer, dimension(:,:,:) :: h_Rlay => NULL() !< Layer thicknesses in potential density @@ -85,7 +85,7 @@ module MOM_diagnostics ! following fields are 2-D. real, pointer, dimension(:,:) :: & - cg1 => NULL(), & !< First baroclinic gravity wave speed, in m s-1 + cg1 => NULL(), & !< First baroclinic gravity wave speed [m s-1] Rd1 => NULL(), & !< First baroclinic deformation radius, in m cfl_cg1 => NULL(), & !< CFL for first baroclinic gravity wave speed, nondim cfl_cg1_x => NULL(), & !< i-component of CFL for first baroclinic gravity wave speed, nondim @@ -189,9 +189,9 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity, in m s-1. + intent(in) :: u !< The zonal velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity, in m s-1. + intent(in) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -883,9 +883,9 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity, in m s-1. + intent(in) :: u !< The zonal velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity, in m s-1. + intent(in) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index aa05140cf9..7ae94450df 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -278,9 +278,9 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity, in m s-1. + intent(in) :: u !< The zonal velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity, in m s-1. + intent(in) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various @@ -1003,7 +1003,7 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) ! enddo ; enddo ; endif if (associated(fluxes%salt_flux)) then ; do j=js,je ; do i=is,ie - ! convert salt_flux from kg (salt)/(m^2 s) to ppt * (m/s). + ! convert salt_flux from kg (salt)/(m^2 s) to ppt * [m s-1]. salt_in(i,j) = dt*G%areaT(i,j)*(1000.0*fluxes%salt_flux(i,j)) enddo ; enddo ; endif endif diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 94f0775e4b..76111123cb 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -54,7 +54,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: cg1 !< First mode internal wave speed (m/s) + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: cg1 !< First mode internal wave speed [m s-1] type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed logical, optional, intent(in) :: full_halos !< If true, do the calculation !! over the entire computational domain. @@ -522,7 +522,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables integer, intent(in) :: nmodes !< Number of modes - real, dimension(G%isd:G%ied,G%jsd:G%jed,nmodes), intent(out) :: cn !< Waves speeds (m/s) + real, dimension(G%isd:G%ied,G%jsd:G%jed,nmodes), intent(out) :: cn !< Waves speeds [m s-1] type(wave_speed_CS), optional, pointer :: CS !< Control structure for MOM_wave_speed logical, optional, intent(in) :: full_halos !< If true, do the calculation !! over the entire computational domain. diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 6ca42835a8..4fbcda9907 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -37,16 +37,16 @@ module MOM_wave_structure type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. real, allocatable, dimension(:,:,:) :: w_strct - !< Vertical structure of vertical velocity (normalized), in m s-1. + !< Vertical structure of vertical velocity (normalized) [m s-1]. real, allocatable, dimension(:,:,:) :: u_strct - !< Vertical structure of horizontal velocity (normalized), in m s-1. + !< Vertical structure of horizontal velocity (normalized) [m s-1]. real, allocatable, dimension(:,:,:) :: W_profile !< Vertical profile of w_hat(z), where !! w(x,y,z,t) = w_hat(z)*exp(i(kx+ly-freq*t)) is the full time- - !! varying vertical velocity with w_hat(z) = W0*w_strct(z), in m s-1. + !! varying vertical velocity with w_hat(z) = W0*w_strct(z) [m s-1]. real, allocatable, dimension(:,:,:) :: Uavg_profile !< Vertical profile of the magnitude of horizontal velocity, - !! (u^2+v^2)^0.5, averaged over a period, in m s-1. + !! (u^2+v^2)^0.5, averaged over a period [m s-1]. real, allocatable, dimension(:,:,:) :: z_depths !< Depths of layer interfaces, in m. real, allocatable, dimension(:,:,:) :: N2 @@ -96,9 +96,8 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo !! (usually m or kg m-2). type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: cn !< The (non-rotational) mode - !! internal gravity wave speed, - !! in m s-1. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: cn !< The (non-rotational) mode internal + !! gravity wave speed [m s-1]. integer, intent(in) :: ModeNum !< Mode number real, intent(in) :: freq !< Intrinsic wave frequency [s-1]. type(wave_structure_CS), pointer :: CS !< The control structure returned diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 73058efc6d..0b64f38d75 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -91,20 +91,20 @@ module MOM_ice_shelf real :: ustar_bg !< A minimum value for ustar under ice shelves [Z s-1 ~> m s-1]. real :: cdrag !< drag coefficient under ice shelves , non-dimensional. real :: g_Earth !< The gravitational acceleration [m s-2] - real :: Cp !< The heat capacity of sea water, in J kg-1 K-1. + real :: Cp !< The heat capacity of sea water [J kg-1 degC-1]. real :: Rho0 !< A reference ocean density in kg/m3. - real :: Cp_ice !< The heat capacity of fresh ice, in J kg-1 K-1. + real :: Cp_ice !< The heat capacity of fresh ice [J kg-1 degC-1]. real :: gamma_t !< The (fixed) turbulent exchange velocity in the - !< 2-equation formulation, in m s-1. + !< 2-equation formulation [m s-1]. real :: Salin_ice !< The salinity of shelf ice [PSU]. - real :: Temp_ice !< The core temperature of shelf ice, in C. - real :: kv_ice !< The viscosity of ice, in m2 s-1. + real :: Temp_ice !< The core temperature of shelf ice, in degC. + real :: kv_ice !< The viscosity of ice [m2 s-1]. real :: density_ice !< A typical density of ice [kg m-3]. real :: rho_ice !< Nominal ice density in kg m-2 Z-1 - real :: kv_molec !< The molecular kinematic viscosity of sea water, m2 s-1. - real :: kd_molec_salt!< The molecular diffusivity of salt, in m2 s-1. - real :: kd_molec_temp!< The molecular diffusivity of heat, in m2 s-1. - real :: Lat_fusion !< The latent heat of fusion, in J kg-1. + real :: kv_molec !< The molecular kinematic viscosity of sea water [m2 s-1]. + real :: kd_molec_salt!< The molecular diffusivity of salt [m2 s-1]. + real :: kd_molec_temp!< The molecular diffusivity of heat [m2 s-1]. + real :: Lat_fusion !< The latent heat of fusion [J kg-1]. real :: Gamma_T_3EQ !< Nondimensional heat-transfer coefficient, used in the 3Eq. formulation !< This number should be specified by the user. real :: col_thick_melt_threshold !< if the mixed layer is below this threshold, melt rate @@ -127,13 +127,13 @@ module MOM_ice_shelf !! should be exclusive) real :: density_ocean_avg !< this does not affect ocean circulation OR thermodynamics !! it is to estimate the gravitational driving force at the - !! shelf front(until we think of a better way to do it- + !! shelf front (until we think of a better way to do it, !! but any difference will be negligible) logical :: calve_to_mask !< If true, calve any ice that passes outside of a masked area real :: min_thickness_simple_calve !< min. ice shelf thickness criteria for calving [Z ~> m]. real :: T0 !< temperature at ocean surface in the restoring region, in degC real :: S0 !< Salinity at ocean surface in the restoring region, in ppt. - real :: input_flux !< Ice volume flux at an upstream open boundary, in m3 s-1. + real :: input_flux !< Ice volume flux at an upstream open boundary [m3 s-1]. real :: input_thickness !< Ice thickness at an upstream open boundary, in m. type(time_type) :: Time !< The component's time. @@ -209,7 +209,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) !! the ice-shelf state real, dimension(SZI_(CS%grid)) :: & - Rhoml, & !< Ocean mixed layer density in kg m-3. + Rhoml, & !< Ocean mixed layer density [kg m-3]. dR0_dT, & !< Partial derivative of the mixed layer density !< with temperature [kg m-3 degC-1]. dR0_dS, & !< Partial derivative of the mixed layer density @@ -231,7 +231,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) !! viscosity is linearly increasing. (Was 1/8. Why?) real, parameter :: RC = 0.20 ! critical flux Richardson number. real :: I_ZETA_N !< The inverse of ZETA_N. - real :: LF, I_LF !< Latent Heat of fusion (J kg-1) and its inverse. + real :: LF, I_LF !< Latent Heat of fusion [J kg-1] and its inverse. real :: I_VK !< The inverse of VK. real :: PR, SC !< The Prandtl number and Schmidt number [nondim]. @@ -241,13 +241,14 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) real :: Sbdry_it real :: Sbdry1, Sbdry2, S_a, S_b, S_c ! use to find salt roots real :: dS_it !< The interface salinity change during an iteration [PSU]. - real :: hBL_neut !< The neutral boundary layer thickness, in m. + real :: hBL_neut !< The neutral boundary layer thickness [m]. real :: hBL_neut_h_molec !< The ratio of the neutral boundary layer thickness !! to the molecular boundary layer thickness [nondim]. - real :: wT_flux !< The vertical fluxes of heat and buoyancy just inside the - real :: wB_flux !< ocean, in C m s-1 and m2 s-3, ###CURRENTLY POSITIVE UPWARD. - real :: dB_dS !< The derivative of buoyancy with salinity, in m s-2 PSU-1. - real :: dB_dT !< The derivative of buoyancy with temperature, in m s-2 C-1. + !### THESE ARE CURRENTLY POSITIVE UPWARD. + real :: wT_flux !< The vertical flux of heat just inside the ocean [degC m s-1]. + real :: wB_flux !< The vertical flux of heat just inside the ocean [m2 s-3]. + real :: dB_dS !< The derivative of buoyancy with salinity [m s-2 PSU-1]. + real :: dB_dT !< The derivative of buoyancy with temperature [m s-2 degC-1]. real :: I_n_star, n_star_term, absf real :: dIns_dwB !< The partial derivative of I_n_star with wB_flux, in ???. real :: dT_ustar, dS_ustar @@ -1747,7 +1748,7 @@ subroutine solo_time_step(CS, time_step, nsteps, Time, min_time_step_in) real, intent(in) :: time_step !< The time interval for this update [s]. integer, intent(inout) :: nsteps !< The running number of ice shelf steps. type(time_type), intent(inout) :: Time !< The current model time - real, optional, intent(in) :: min_time_step_in !< The minimum permitted time step in s. + real, optional, intent(in) :: min_time_step_in !< The minimum permitted time step [s]. type(ocean_grid_type), pointer :: G => NULL() type(unit_scale_type), pointer :: US => NULL() ! Pointer to a structure containing diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 7b134ac38d..41035cbf66 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -96,9 +96,9 @@ module MOM_ice_shelf_dynamics ! (maybe longer) because it will depend on ocean values that are averaged over ! this time interval, and solving for the equiliabrated flow will begin to lose ! meaning if it is done too frequently. - real :: elapsed_velocity_time !< The elapsed time since the ice velocies were last udated, in s. + real :: elapsed_velocity_time !< The elapsed time since the ice velocies were last udated [s]. - real :: g_Earth !< The gravitational acceleration in m s-2. + real :: g_Earth !< The gravitational acceleration [m s-2]. real :: density_ice !< A typical density of ice, in kg m-3. logical :: GL_regularize !< whether to regularize the floatation condition @@ -1421,7 +1421,7 @@ end subroutine ice_shelf_solve_inner subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_uflux, flux_enter) type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step !< The time step for this update, in s. + real, intent(in) :: time_step !< The time step for this update [s]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf @@ -1651,7 +1651,7 @@ end subroutine ice_shelf_advect_thickness_x subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, h_after_vflux, flux_enter) type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step !< The time step for this update, in s. + real, intent(in) :: time_step !< The time step for this update [s]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf @@ -3481,7 +3481,7 @@ subroutine ice_shelf_temp(CS, ISS, G, US, time_step, melt_rate, Time) !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. type(unit_scale_type), intent(in) :: US !< Pointer to a structure containing unit conversion factors - real, intent(in) :: time_step !< The time step for this update, in s. + real, intent(in) :: time_step !< The time step for this update [s]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: melt_rate !< basal melt rate in kg/m^2/s type(time_type), intent(in) :: Time !< The current model time @@ -3625,7 +3625,7 @@ end subroutine ice_shelf_temp subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, flux_enter) type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step !< The time step for this update, in s. + real, intent(in) :: time_step !< The time step for this update [s]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf @@ -3856,7 +3856,7 @@ end subroutine ice_shelf_advect_temp_x subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_after_vflux, flux_enter) type(ice_shelf_dyn_CS), intent(in) :: CS !< A pointer to the ice shelf control structure type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step !< The time step for this update, in s. + real, intent(in) :: time_step !< The time step for this update [s]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf diff --git a/src/ice_shelf/MOM_marine_ice.F90 b/src/ice_shelf/MOM_marine_ice.F90 index 8592273775..cbce4e2deb 100644 --- a/src/ice_shelf/MOM_marine_ice.F90 +++ b/src/ice_shelf/MOM_marine_ice.F90 @@ -29,8 +29,8 @@ module MOM_marine_ice 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) + real :: latent_heat_fusion !< Latent heat of fusion [J kg-1] + real :: density_iceberg !< A typical density of icebergs [kg m-3] (for ice rigidity) type(time_type), pointer :: Time !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the timing of diagnostic output. @@ -48,10 +48,10 @@ subroutine iceberg_forces(G, forces, use_ice_shelf, sfc_state, & type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. logical, intent(in) :: use_ice_shelf !< If true, this configuration uses ice shelves. - real, intent(in) :: time_step !< The coupling time step, in s. + real, intent(in) :: time_step !< The coupling time step [s]. type(marine_ice_CS), pointer :: CS !< Pointer to the control structure for MOM_marine_ice - real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1. + real :: kv_rho_ice ! The viscosity of ice divided by its density [m5 kg-1 s-1]. integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec !This routine adds iceberg data to the ice shelf data (if ice shelf is used) @@ -110,11 +110,11 @@ subroutine iceberg_fluxes(G, fluxes, use_ice_shelf, sfc_state, & type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. logical, intent(in) :: use_ice_shelf !< If true, this configuration uses ice shelves. - real, intent(in) :: time_step !< The coupling time step, in s. + real, intent(in) :: time_step !< The coupling time step [s]. type(marine_ice_CS), pointer :: CS !< Pointer to the control structure for MOM_marine_ice - real :: fraz ! refreezing rate in kg m-2 s-1 - real :: I_dt_LHF ! The inverse of the timestep times the latent heat of fusion, in kg J-1 s-1. + real :: fraz ! refreezing rate [kg m-2 s-1] + real :: I_dt_LHF ! The inverse of the timestep times the latent heat of fusion [kg J-1 s-1]. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 0f34782f7f..f77cdfbfe9 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -131,8 +131,8 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, US, param_file) 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 ! Local variables - real :: g_int ! Reduced gravities across the internal interfaces, in m s-2. - real :: g_fs ! Reduced gravity across the free surface, in m s-2. + real :: g_int ! Reduced gravities across the internal interfaces [m s-2]. + real :: g_fs ! Reduced gravity across the free surface [m s-2]. character(len=40) :: mdl = "set_coord_from_gprime" ! This subroutine's name. integer :: k, nz nz = GV%ke @@ -165,7 +165,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, US, param_file) 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 ! Local variables - real :: g_fs ! Reduced gravity across the free surface, in m s-2. + real :: g_fs ! Reduced gravity across the free surface [m s-2]. real :: Rlay_Ref! The surface layer's target density, in kg m-3. real :: RLay_range ! The range of densities, in kg m-3. character(len=40) :: mdl = "set_coord_from_layer_density" ! This subroutine's name. @@ -214,8 +214,8 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state ! Local variables real :: T_ref ! Reference temperature real :: S_ref ! Reference salinity - real :: g_int ! Reduced gravities across the internal interfaces, in m s-2. - real :: g_fs ! Reduced gravity across the free surface, in m s-2. + real :: g_int ! Reduced gravities across the internal interfaces [m s-2]. + real :: g_fs ! Reduced gravity across the free surface [m s-2]. character(len=40) :: mdl = "set_coord_from_TS_ref" ! This subroutine's name. integer :: k, nz nz = GV%ke @@ -265,7 +265,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, & !! in Pa. ! Local variables real, dimension(GV%ke) :: T0, S0, Pref - real :: g_fs ! Reduced gravity across the free surface, in m s-2. + real :: g_fs ! Reduced gravity across the free surface [m s-2]. integer :: k, nz character(len=40) :: mdl = "set_coord_from_TS_profile" ! This subroutine's name. character(len=200) :: filename, coord_file, inputdir ! Strings for file/path @@ -319,7 +319,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, & ! of the range to that in the lighter part of the range. ! Setting this greater than 1 increases the resolution for ! the denser water. - real :: g_fs ! Reduced gravity across the free surface, in m s-2. + real :: g_fs ! Reduced gravity across the free surface [m s-2]. real :: a1, frac_dense, k_frac integer :: k, nz, k_light character(len=40) :: mdl = "set_coord_from_TS_range" ! This subroutine's name. @@ -391,7 +391,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, US, param_file) 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 ! Local variables - real :: g_fs ! Reduced gravity across the free surface, in m s-2. + real :: g_fs ! Reduced gravity across the free surface [m s-2]. integer :: k, nz character(len=40) :: mdl = "set_coord_from_file" ! This subroutine's name. character(len=40) :: coord_var @@ -481,12 +481,12 @@ subroutine set_coord_to_none(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density). real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, - !! in m s-2. + !! [m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables - real :: g_fs ! Reduced gravity across the free surface, in m s-2. + real :: g_fs ! Reduced gravity across the free surface [m s-2]. character(len=40) :: mdl = "set_coord_to_none" ! This subroutine's name. integer :: k, nz nz = GV%ke diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 03de3d5402..fed47ca7a0 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -124,11 +124,11 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< The zonal velocity that is being initialized, - !! in m s-1 + intent(out) :: u !< The zonal velocity that is being + !! initialized [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: v !< The meridional velocity that is being - !! initialized, in m s-1 + !! initialized [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic @@ -159,8 +159,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & logical :: new_sim integer :: write_geom logical :: use_temperature, use_sponge, use_OBC - logical :: use_EOS ! If true, density is calculated from T & S using an - ! equation of state. + logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. logical :: depress_sfc ! If true, remove the mass that would be displaced ! by a large surface pressure by squeezing the column. logical :: trim_ic_for_p_surf ! If true, remove the mass that would be displaced @@ -1239,9 +1238,9 @@ end subroutine cut_off_column_top subroutine initialize_velocity_from_file(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 + intent(out) :: u !< The zonal velocity that is being initialized [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 + intent(out) :: v !< The meridional velocity that is being initialized [m s-1] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1279,9 +1278,9 @@ end subroutine initialize_velocity_from_file subroutine initialize_velocity_zero(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 + intent(out) :: u !< The zonal velocity that is being initialized [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 + intent(out) :: v !< The meridional velocity that is being initialized [m s-1] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1313,9 +1312,9 @@ end subroutine initialize_velocity_zero subroutine initialize_velocity_uniform(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 + intent(out) :: u !< The zonal velocity that is being initialized [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 + intent(out) :: v !< The meridional velocity that is being initialized [m s-1] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1353,9 +1352,9 @@ end subroutine initialize_velocity_uniform subroutine initialize_velocity_circular(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 + intent(out) :: u !< The zonal velocity that is being initialized [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 + intent(out) :: v !< The meridional velocity that is being initialized [m s-1] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1373,7 +1372,7 @@ subroutine initialize_velocity_circular(u, v, G, param_file, just_read_params) call get_param(param_file, mdl, "CIRCULAR_MAX_U", circular_max_u, & "The amplitude of zonal flow from which to scale the\n"// & - "circular stream function (m/s).", & + "circular stream function [m s-1].", & units="m s-1", default=0., do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 4e0174adff..1f0a3fa73d 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -48,7 +48,7 @@ module MOM_MEKE real :: MEKE_BGsrc !< Background energy source for MEKE in W/kg (= m2 s-3). real :: MEKE_dtScale !< Scale factor to accelerate time-stepping (non-dim.) real :: MEKE_KhCoeff !< Scaling factor to convert MEKE into Kh (non-dim.) - real :: MEKE_Uscale !< MEKE velocity scale for bottom drag (m/s) + real :: MEKE_Uscale !< MEKE velocity scale for bottom drag [m s-1] real :: MEKE_KH !< Background lateral diffusion of MEKE (m^2/s) real :: MEKE_K4 !< Background bi-harmonic diffusivity (of MEKE) (m^4/s) real :: KhMEKE_Fac !< A factor relating MEKE%Kh to the diffusivity used for @@ -99,47 +99,47 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points (s-1). - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points (s-1). + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [s-1]. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [s-1]. type(vertvisc_type), intent(in) :: visc !< The vertical viscosity type. - real, intent(in) :: dt !< Model(baroclinic) time-step (s). + real, intent(in) :: dt !< Model(baroclinic) time-step [s]. type(MEKE_CS), pointer :: CS !< MEKE control structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: hu !< Zonal mass flux (H m2 s-1). - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: hv !< Meridional mass flux (H m2 s-1). + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: hu !< Zonal mass flux [H m2 s-1 ~> m3 s-1 or kg s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: hv !< Meridional mass flux [H m2 s-1 ~> m3 s-1 or kg s-1] ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - mass, & ! The total mass of the water column, in kg m-2. - I_mass, & ! The inverse of mass, in m2 kg-1. - src, & ! The sum of all MEKE sources, in m2 s-3. + mass, & ! The total mass of the water column [kg m-2]. + I_mass, & ! The inverse of mass [m2 kg-1]. + src, & ! The sum of all MEKE sources [m2 s-3]. MEKE_decay, & ! The MEKE decay timescale [s-1]. - MEKE_GM_src, & ! The MEKE source from thickness mixing, in m2 s-3. - MEKE_mom_src, & ! The MEKE source from momentum, in m2 s-3. + MEKE_GM_src, & ! The MEKE source from thickness mixing [m2 s-3]. + MEKE_mom_src, & ! The MEKE source from momentum [m2 s-3]. drag_rate_visc, & drag_rate, & ! The MEKE spindown timescale due to bottom drag [s-1]. LmixScale, & ! Square of eddy mixing length, in m2. - barotrFac2, & ! Ratio of EKE_barotropic / EKE (nondim)/ - bottomFac2 ! Ratio of EKE_bottom / EKE (nondim)/ + barotrFac2, & ! Ratio of EKE_barotropic / EKE [nondim] + bottomFac2 ! Ratio of EKE_bottom / EKE [nondim] real, dimension(SZIB_(G),SZJ_(G)) :: & - MEKE_uflux, & ! The zonal diffusive flux of MEKE, in kg m2 s-3. - Kh_u, & ! The zonal diffusivity that is actually used, in m2 s-1. - baroHu, & ! Depth integrated zonal mass flux (H m2 s-1). + MEKE_uflux, & ! The zonal diffusive flux of MEKE [kg m2 s-3]. + Kh_u, & ! The zonal diffusivity that is actually used [m2 s-1]. + baroHu, & ! Depth integrated zonal mass flux [H m2 s-1 ~> m3 s-1 or kg s-1]. drag_vel_u ! A (vertical) viscosity associated with bottom drag at - ! u-points, in m s-1. + ! u-points [m s-1]. real, dimension(SZI_(G),SZJB_(G)) :: & - MEKE_vflux, & ! The meridional diffusive flux of MEKE, in kg m2 s-3. - Kh_v, & ! The meridional diffusivity that is actually used, in m2 s-1. - baroHv, & ! Depth integrated meridional mass flux (H m2 s-1). + MEKE_vflux, & ! The meridional diffusive flux of MEKE [kg m2 s-3]. + Kh_v, & ! The meridional diffusivity that is actually used [m2 s-1]. + baroHv, & ! Depth integrated meridional mass flux [H m2 s-1 ~> m3 s-1 or kg s-1]. drag_vel_v ! A (vertical) viscosity associated with bottom drag at - ! v-points, in m s-1. + ! v-points [m s-1]. real :: Kh_here, Inv_Kh_max, K4_here real :: cdrag2 real :: advFac - real :: mass_neglect ! A negligible mass, in kg m-2. - real :: ldamping ! The MEKE damping rate in s-1. + real :: mass_neglect ! A negligible mass [kg m-2]. + real :: ldamping ! The MEKE damping rate [s-1]. real :: Rho0 ! A density used to convert mass to distance [kg m-3]. - real :: sdt ! dt to use locally (could be scaled to accelerate) - real :: sdt_damp ! dt for damping (sdt could be split). + real :: sdt ! dt to use locally [s] (could be scaled to accelerate) + real :: sdt_damp ! dt for damping [s] (sdt could be split). logical :: use_drag_rate ! Flag to indicate drag_rate is finite integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz @@ -553,8 +553,8 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(MEKE_CS), pointer :: CS !< MEKE control structure. type(MEKE_type), pointer :: MEKE !< MEKE data. - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points (s-1). - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points (s-1). + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [s-1]. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: drag_rate_visc !< Mean flow contrib. to drag rate real, dimension(SZI_(G),SZJ_(G)), intent(in) :: I_mass !< Inverse of column mass. ! Local variables @@ -563,7 +563,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m real :: EKE, EKEmin, EKEmax, resid, ResMin, ResMax, EKEerr real :: FatH ! Coriolis parameter at h points; to compute topographic beta integer :: i, j, is, ie, js, je, n1, n2 - real, parameter :: tolerance = 1.e-12 ! Width of EKE bracket in m^2 s^-2. + real, parameter :: tolerance = 1.e-12 ! Width of EKE bracket [m2 s-2]. logical :: useSecant, debugIteration is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -682,12 +682,12 @@ subroutine MEKE_lengthScales(CS, MEKE, G, US, SN_u, SN_v, & type(MEKE_type), pointer :: MEKE !< MEKE data. type(ocean_grid_type), intent(inout) :: G !< Ocean grid. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points (s-1). - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points (s-1). - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: EKE !< Eddy kinetic energy (m2/s2). + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [s-1]. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [s-1]. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: EKE !< Eddy kinetic energy [m2 s-2]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: bottomFac2 !< gamma_b^2 real, dimension(SZI_(G),SZJ_(G)), intent(out) :: barotrFac2 !< gamma_t^2 - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: LmixScale !< Eddy mixing length (m). + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: LmixScale !< Eddy mixing length [m]. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: Lrhines, Leady real :: beta, SN, FatH @@ -727,19 +727,19 @@ end subroutine MEKE_lengthScales subroutine MEKE_lengthScales_0d(CS, area, beta, depth, Rd_dx, SN, EKE, Z_to_L, & bottomFac2, barotrFac2, LmixScale, Lrhines, Leady) type(MEKE_CS), pointer :: CS !< MEKE control structure. - real, intent(in) :: area !< Grid cell area (m2) - real, intent(in) :: beta !< Planetary beta = |grad F| (s-1 m-1) - real, intent(in) :: depth !< Ocean depth (Z) - real, intent(in) :: Rd_dx !< Resolution Ld/dx (nondim). - real, intent(in) :: SN !< Eady growth rate (s-1). - real, intent(in) :: EKE !< Eddy kinetic energy (m s-1). + real, intent(in) :: area !< Grid cell area [m2] + real, intent(in) :: beta !< Planetary beta = |grad F| [s-1 m-1] + real, intent(in) :: depth !< Ocean depth [Z ~> m] + real, intent(in) :: Rd_dx !< Resolution Ld/dx [nondim]. + real, intent(in) :: SN !< Eady growth rate [s-1]. + real, intent(in) :: EKE !< Eddy kinetic energy [m s-1]. real, intent(in) :: Z_to_L !< A conversion factor from depth units (Z) to !! the units for lateral distances (L). real, intent(out) :: bottomFac2 !< gamma_b^2 real, intent(out) :: barotrFac2 !< gamma_t^2 - real, intent(out) :: LmixScale !< Eddy mixing length (m). - real, intent(out) :: Lrhines !< Rhines length scale (m). - real, intent(out) :: Leady !< Eady length scale (m). + real, intent(out) :: LmixScale !< Eddy mixing length [m]. + real, intent(out) :: Lrhines !< Rhines length scale [m]. + real, intent(out) :: Leady !< Eady length scale [m]. ! Local variables real :: Lgrid, Ldeform, LdeformLim, Ue, Lfrict diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 22aae5f7dc..ef1cf16c7b 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -179,17 +179,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity, in m s-1. + intent(in) :: u !< The zonal velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity, in m s-1. + intent(in) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: diffu !< Zonal acceleration due to convergence of - !! along-coordinate stress tensor (m/s2) + !! along-coordinate stress tensor [m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: diffv !< Meridional acceleration due to convergence - !! of along-coordinate stress tensor (m/s2). + !! of along-coordinate stress tensor [m s-2]. type(MEKE_type), pointer :: MEKE !< Pointer to a structure containing fields !! related to Mesoscale Eddy Kinetic Energy. type(VarMix_CS), pointer :: VarMix !< Pointer to a structure with fields that @@ -978,8 +978,8 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) ! grid spacing, to limit biharmonic viscosity real :: Kh ! Lapacian horizontal viscosity (m2/s) real :: Ah ! biharmonic horizontal viscosity (m4/s) - real :: Kh_vel_scale ! this speed (m/s) times grid spacing gives Lap visc - real :: Ah_vel_scale ! this speed (m/s) times grid spacing cubed gives bih visc + real :: Kh_vel_scale ! this speed [m s-1] times grid spacing gives Lap visc + real :: Ah_vel_scale ! this speed [m s-1] times grid spacing cubed gives bih visc real :: Smag_Lap_const ! nondimensional Laplacian Smagorinsky constant real :: Smag_bi_const ! nondimensional biharmonic Smagorinsky constant real :: Leith_Lap_const ! nondimensional Laplacian Leith constant @@ -987,10 +987,10 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) real :: dt ! dynamics time step (sec) real :: Idt ! inverse of dt (1/s) real :: denom ! work variable; the denominator of a fraction - real :: maxvel ! largest permitted velocity components (m/s) + real :: maxvel ! largest permitted velocity components [m s-1] real :: bound_Cor_vel ! grid-scale velocity variations at which value ! the quadratically varying biharmonic viscosity - ! balances Coriolis acceleration (m/s) + ! balances Coriolis acceleration [m s-1] real :: Kh_sin_lat ! Amplitude of latitudinally dependent viscosity (m2/s) real :: Kh_pwr_of_sine ! Power used to raise sin(lat) when using Kh_sin_lat logical :: bound_Cor_def ! parameter setting of BOUND_CORIOLIS diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index bffe03cd3d..c5499debf9 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -161,16 +161,16 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & type(thermo_var_ptrs), intent(in) :: tv !< Pointer to thermodynamic variables !! (needed for wave structure). real, dimension(SZI_(G),SZJ_(G)), intent(in) :: TKE_itidal_input !< The energy input to the - !! internal waves, in W m-2. + !! internal waves [W m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: vel_btTide !< Barotropic velocity read - !! from file, in m s-1. + !! from file [m s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Nb !< Near-bottom buoyancy frequency [s-1]. real, intent(in) :: dt !< Length of time over which these fluxes !! will be applied [s]. type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. real, dimension(SZI_(G),SZJ_(G),CS%nMode), & - intent(in) :: cn !< The internal wave speeds of each mode, in m s-1. + intent(in) :: cn !< The internal wave speeds of each mode [m s-1]. ! Local variables real, dimension(SZI_(G),SZJ_(G),2) :: & test @@ -586,7 +586,7 @@ subroutine sum_En(G, CS, En, label) type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle), & - intent(in) :: En !< The energy density of the internal tides, in J m-2. + intent(in) :: En !< The energy density of the internal tides [J m-2]. character(len=*), intent(in) :: label !< A label to use in error messages ! Local variables integer :: m,fr,a @@ -630,14 +630,14 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, intent(in) :: Nb !< Near-bottom stratification [s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%nFreq,CS%nMode), & intent(inout) :: Ub !< Rms (over one period) near-bottom horizontal - !! mode velocity, in m s-1. + !! mode velocity [m s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(in) :: TKE_loss_fixed !< Fixed part of energy loss, !! in kg Z-2 (rho*kappa*h^2). real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle,CS%nFreq,CS%nMode), & - intent(inout) :: En !< Energy density of the internal waves, in J m-2. + intent(inout) :: En !< Energy density of the internal waves [J m-2]. real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle,CS%nFreq,CS%nMode), & - intent(out) :: TKE_loss !< Energy loss rate, in W m-2 + intent(out) :: TKE_loss !< Energy loss rate [W m-2] !! (q*rho*kappa*h^2*N*U^2). real, intent(in) :: dt !< Time increment [s]. logical,optional, intent(in) :: full_halos !< If true, do the calculation over the @@ -650,7 +650,7 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, real :: frac_per_sector ! fraction of energy in each wedge real :: q_itides ! fraction of energy actually lost to mixing (remainder, 1-q, is ! assumed to stay in propagating mode for now - BDM) - real :: loss_rate ! approximate loss rate for implicit calc, s-1 + real :: loss_rate ! approximate loss rate for implicit calc [s-1] real, parameter :: En_negl = 1e-30 ! negilibly small number to prevent division by zero is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -720,7 +720,7 @@ subroutine get_lowmode_loss(i,j,G,CS,mechanism,TKE_loss_sum) !! previous call to int_tide_init. character(len=*), intent(in) :: mechanism !< The named mechanism of loss to return real, intent(out) :: TKE_loss_sum !< Total energy loss rate due to specified - !! mechanism, in W m-2. + !! mechanism [W m-2]. if (mechanism == 'LeakDrag') TKE_loss_sum = CS%tot_leak_loss(i,j) ! not used for mixing yet if (mechanism == 'QuadDrag') TKE_loss_sum = CS%tot_quad_loss(i,j) ! not used for mixing yet @@ -737,9 +737,9 @@ subroutine refract(En, cn, freq, dt, G, NAngle, use_PPMang) real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), & intent(inout) :: En !< The internal gravity wave energy density as a !! function of space and angular resolution, - !! in J m-2 radian-1. + !! [J m-2 radian-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: cn !< Baroclinic mode speed, in m s-1. + intent(in) :: cn !< Baroclinic mode speed [m s-1]. real, intent(in) :: freq !< Wave frequency [s-1]. real, intent(in) :: dt !< Time step [s]. logical, intent(in) :: use_PPMang !< If true, use PPM for advection rather @@ -872,15 +872,15 @@ end subroutine refract subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. - real, intent(in) :: dt !< Time increment in s. + real, intent(in) :: dt !< Time increment [s]. integer, intent(in) :: halo_ang !< The halo size in angular space real, dimension(1-halo_ang:NAngle+halo_ang), & intent(in) :: En2d !< The internal gravity wave energy density as a - !! function of angular resolution, in J m-2 radian-1. + !! function of angular resolution [J m-2 radian-1]. real, dimension(1-halo_ang:NAngle+halo_ang), & intent(in) :: CFL_ang !< The CFL number of the energy advection across angles real, dimension(0:NAngle), intent(out) :: Flux_En !< The time integrated internal wave energy flux - !! across angles, in J m-2 radian-1. + !! across angles [J m-2 radian-1]. ! Local variables real :: flux real :: u_ang @@ -957,21 +957,21 @@ subroutine propagate(En, cn, freq, dt, G, CS, NAngle) real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), & intent(inout) :: En !< The internal gravity wave energy density as a !! function of space and angular resolution, - !! in J m-2 radian-1. + !! [J m-2 radian-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: cn !< Baroclinic mode speed, in m s-1. + intent(in) :: cn !< Baroclinic mode speed [m s-1]. real, intent(in) :: freq !< Wave frequency [s-1]. real, intent(in) :: dt !< Time step [s]. type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. ! Local variables real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: & - speed ! The magnitude of the group velocity at the q points for corner adv, in m s-1. + speed ! The magnitude of the group velocity at the q points for corner adv [m s-1]. integer, parameter :: stencil = 2 real, dimension(SZIB_(G),SZJ_(G)) :: & - speed_x ! The magnitude of the group velocity at the Cu points, in m s-1. + speed_x ! The magnitude of the group velocity at the Cu points [m s-1]. real, dimension(SZI_(G),SZJB_(G)) :: & - speed_y ! The magnitude of the group velocity at the Cv points, in m s-1. + speed_y ! The magnitude of the group velocity at the Cv points [m s-1]. real, dimension(0:NAngle) :: & cos_angle, sin_angle real, dimension(NAngle) :: & @@ -1080,14 +1080,14 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(inout) :: En !< The energy density integrated over an angular - !! band, in W m-2, intent in/out. + !! band [W m-2], intent in/out. real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed), & intent(in) :: speed !< The magnitude of the group velocity at the cell - !! corner points, in m s-1. + !! corner points [m s-1]. integer, intent(in) :: energized_wedge !< Index of current ray direction. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. - real, intent(in) :: dt !< Time increment in s. + real, intent(in) :: dt !< Time increment [s]. type(int_tide_CS), pointer :: CS !< The control structure returned by a previous !! call to continuity_PPM_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. @@ -1343,20 +1343,20 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) !! discretized wave energy spectrum. real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle), & intent(inout) :: En !< The energy density integrated over an angular - !! band, in J m-2, intent in/out. + !! band [J m-2], intent in/out. real, dimension(G%IsdB:G%IedB,G%jsd:G%jed), & intent(in) :: speed_x !< The magnitude of the group velocity at the - !! Cu points, in m s-1. + !! Cu points [m s-1]. real, dimension(Nangle), intent(in) :: Cgx_av !< The average x-projection in each angular band. real, dimension(Nangle), intent(in) :: dCgx !< The difference in x-projections between the !! edges of each angular band. - real, intent(in) :: dt !< Time increment in s. + real, intent(in) :: dt !< Time increment [s]. type(int_tide_CS), pointer :: CS !< The control structure returned by a previous call !! to continuity_PPM_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - EnL, EnR ! Left and right face energy densities, in J m-2. + EnL, EnR ! Left and right face energy densities [J m-2]. real, dimension(SZIB_(G),SZJ_(G)) :: & flux_x ! The internal wave energy flux, in J s-1. real, dimension(SZIB_(G)) :: & @@ -1426,20 +1426,20 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) !! discretized wave energy spectrum. real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle), & intent(inout) :: En !< The energy density integrated over an angular - !! band, in J m-2, intent in/out. + !! band [J m-2], intent in/out. real, dimension(G%isd:G%ied,G%JsdB:G%JedB), & intent(in) :: speed_y !< The magnitude of the group velocity at the - !! Cv points, in m s-1. + !! Cv points [m s-1]. real, dimension(Nangle), intent(in) :: Cgy_av !< The average y-projection in each angular band. real, dimension(Nangle), intent(in) :: dCgy !< The difference in y-projections between the !! edges of each angular band. - real, intent(in) :: dt !< Time increment in s. + real, intent(in) :: dt !< Time increment [s]. type(int_tide_CS), pointer :: CS !< The control structure returned by a previous call !! to continuity_PPM_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - EnL, EnR ! South and north face energy densities, in J m-2. + EnL, EnR ! South and north face energy densities [J m-2]. real, dimension(SZI_(G),SZJB_(G)) :: & flux_y ! The internal wave energy flux, in J s-1. real, dimension(SZI_(G)) :: & @@ -1512,16 +1512,15 @@ end subroutine propagate_y !> Evaluates the zonal mass or volume fluxes in a layer. subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, j, ish, ieh, vol_CFL) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, dimension(SZIB_(G)), intent(in) :: u !< The zonal velocity, in m s-1. - real, dimension(SZI_(G)), intent(in) :: h !< Energy density used to calculate the fluxes, - !! in J m-2. - real, dimension(SZI_(G)), intent(in) :: hL !< Left- Energy densities in the reconstruction, - !! in J m-2. - real, dimension(SZI_(G)), intent(in) :: hR !< Right- Energy densities in the reconstruction, - !! in J m-2. - real, dimension(SZIB_(G)), intent(inout) :: uh !< The zonal energy transport, - !! in J s-1. - real, intent(in) :: dt !< Time increment in s. + real, dimension(SZIB_(G)), intent(in) :: u !< The zonal velocity [m s-1]. + real, dimension(SZI_(G)), intent(in) :: h !< Energy density used to calculate the fluxes + !! [J m-2]. + real, dimension(SZI_(G)), intent(in) :: hL !< Left- Energy densities in the reconstruction + !! [J m-2]. + real, dimension(SZI_(G)), intent(in) :: hR !< Right- Energy densities in the reconstruction + !! [J m-2]. + real, dimension(SZIB_(G)), intent(inout) :: uh !< The zonal energy transport [J s-1]. + real, intent(in) :: dt !< Time increment [s]. integer, intent(in) :: j !< The j-index to work on. integer, intent(in) :: ish !< The start i-index range to work on. integer, intent(in) :: ieh !< The end i-index range to work on. @@ -1556,16 +1555,16 @@ end subroutine zonal_flux_En !> Evaluates the meridional mass or volume fluxes in a layer. subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, J, ish, ieh, vol_CFL) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, dimension(SZI_(G)), intent(in) :: v !< The meridional velocity, in m s-1. + real, dimension(SZI_(G)), intent(in) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h !< Energy density used to calculate the - !! fluxes, in J m-2. + !! fluxes [J m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hL !< Left- Energy densities in the - !! reconstruction, in J m-2. + !! reconstruction [J m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hR !< Right- Energy densities in the - !! reconstruction, in J m-2. + !! reconstruction [J m-2]. real, dimension(SZI_(G)), intent(inout) :: vh !< The meridional energy transport, !! in J s-1. - real, intent(in) :: dt !< Time increment in s. + real, intent(in) :: dt !< Time increment [s]. integer, intent(in) :: J !< The j-index to work on. integer, intent(in) :: ish !< The start i-index range to work on. integer, intent(in) :: ieh !< The end i-index range to work on. @@ -1604,8 +1603,8 @@ subroutine reflect(En, NAngle, CS, G, LB) !! discretized wave energy spectrum. real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), & intent(inout) :: En !< The internal gravity wave energy density as a - !! function of space and angular resolution, - !! in J m-2 radian-1. + !! function of space and angular resolution + !! [J m-2 radian-1]. type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. @@ -1718,8 +1717,8 @@ subroutine teleport(En, NAngle, CS, G, LB) !! discretized wave energy spectrum. real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), & intent(inout) :: En !< The internal gravity wave energy density as a - !! function of space and angular resolution, - !! in J m-2 radian-1. + !! function of space and angular resolution + !! [J m-2 radian-1]. type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. @@ -1818,7 +1817,7 @@ subroutine correct_halo_rotation(En, test, G, NAngle) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(:,:,:,:,:), intent(inout) :: En !< The internal gravity wave energy density as a !! function of space, angular orientation, frequency, - !! and vertical mode, in J m-2 radian-1. + !! and vertical mode [J m-2 radian-1]. real, dimension(SZI_(G),SZJ_(G),2), & intent(in) :: test !< An x-unit vector that has been passed through !! the halo updates, to enable the rotation of the diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 18fc6beecb..81b3da296b 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -60,7 +60,7 @@ module MOM_lateral_mixing_coeffs SN_v => NULL(), & !< S*N at v-points (s^-1) L2u => NULL(), & !< Length scale^2 at u-points (m^2) L2v => NULL(), & !< Length scale^2 at v-points (m^2) - cg1 => NULL(), & !< The first baroclinic gravity wave speed in m s-1. + cg1 => NULL(), & !< The first baroclinic gravity wave speed [m s-1]. Res_fn_h => NULL(), & !< Non-dimensional function of the ratio the first baroclinic !! deformation radius to the grid spacing at h points. Res_fn_q => NULL(), & !< Non-dimensional function of the ratio the first baroclinic @@ -138,9 +138,9 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(VarMix_CS), pointer :: CS !< Variable mixing coefficients ! Local variables - real :: cg1_q ! The gravity wave speed interpolated to q points, in m s-1. - real :: cg1_u ! The gravity wave speed interpolated to u points, in m s-1. - real :: cg1_v ! The gravity wave speed interpolated to v points, in m s-1. + real :: cg1_q ! The gravity wave speed interpolated to q points [m s-1]. + real :: cg1_u ! The gravity wave speed interpolated to u points [m s-1]. + real :: cg1_v ! The gravity wave speed interpolated to v points [m s-1]. real :: dx_term integer :: power_2 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 8396c5e5c3..7512a0d00c 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -142,10 +142,10 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real, dimension(SZI_(G),SZJ_(G)) :: & MLD_fast, & ! Mixed layer depth actually used in MLE restratification parameterization [H ~> m or kg m-2] htot_fast, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] - Rml_av_fast, & ! g_Rho0 times the average mixed layer density (m s-2) + Rml_av_fast, & ! g_Rho0 times the average mixed layer density [m s-2] MLD_slow, & ! Mixed layer depth actually used in MLE restratification parameterization [H ~> m or kg m-2] htot_slow, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] - Rml_av_slow ! g_Rho0 times the average mixed layer density (m s-2) + Rml_av_slow ! g_Rho0 times the average mixed layer density [m s-2] real :: g_Rho0 ! G_Earth/Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1] real :: rho_ml(SZI_(G)) ! Potential density relative to the surface (kg m-3) real :: p0(SZI_(G)) ! A pressure of 0 (Pa) @@ -567,7 +567,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) ! of H m2 s-1 (i.e., m3 s-1 or kg s-1). real, dimension(SZI_(G),SZJ_(G)) :: & htot, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] - Rml_av ! g_Rho0 times the average mixed layer density (m s-2) + Rml_av ! g_Rho0 times the average mixed layer density [m s-2] real :: g_Rho0 ! G_Earth/Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1] real :: Rho0(SZI_(G)) ! Potential density relative to the surface (kg m-3) real :: p0(SZI_(G)) ! A pressure of 0 (Pa) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index d55b73d858..37d3394328 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -47,7 +47,7 @@ module MOM_thickness_diffuse real :: FGNV_scale !< A coefficient scaling the vertical smoothing term in the !! Ferrari et al., 2010, streamfunction formulation. real :: FGNV_c_min !< A minimum wave speed used in the Ferrari et al., 2010, - !! streamfunction formulation (m s-1). + !! streamfunction formulation [m s-1]. real :: N2_floor !< A floor for Brunt-Vasaila frequency in the Ferrari et al., 2010, !! streamfunction formulation (s-2). logical :: detangle_interfaces !< If true, add 3-d structured interface height @@ -120,7 +120,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp real :: Khth_Loc(SZIB_(G), SZJB_(G)) ! locally calculated thickness diffusivity (m2/s) real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real, dimension(:,:), pointer :: cg1 => null() !< Wave speed (m/s) + real, dimension(:,:), pointer :: cg1 => null() !< Wave speed [m s-1] logical :: use_VarMix, Resoln_scaled, use_stored_slopes, khth_use_ebt_struct integer :: i, j, k, is, ie, js, je, nz real :: hu(SZI_(G), SZJ_(G)) ! u-thickness [H ~> m or kg m-2] @@ -409,7 +409,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions (Z) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions [Z ~> m] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: Kh_u !< Thickness diffusivity on interfaces !! at u points (m2/s) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: Kh_v !< Thickness diffusivity on interfaces @@ -417,7 +417,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uhD !< Zonal mass fluxes (m2 H s-1) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vhD !< Meridional mass fluxes (m2 H s-1) - real, dimension(:,:), pointer :: cg1 !< Wave speed (m/s) + real, dimension(:,:), pointer :: cg1 !< Wave speed [m s-1] real, intent(in) :: dt !< Time increment (s) type(MEKE_type), pointer :: MEKE !< MEKE control structue type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion @@ -1159,8 +1159,8 @@ end subroutine thickness_diffuse_full !> Tridiagonal solver for streamfunction at interfaces subroutine streamfn_solver(nk, c2_h, hN2, sfn) integer, intent(in) :: nk !< Number of layers - real, dimension(nk), intent(in) :: c2_h !< Wave speed squared over thickness in layers (m s-2) - real, dimension(nk+1), intent(in) :: hN2 !< Thickness times N2 at interfaces (m s-2) + real, dimension(nk), intent(in) :: c2_h !< Wave speed squared over thickness in layers [m s-2] + real, dimension(nk+1), intent(in) :: hN2 !< Thickness times N2 at interfaces [m s-2] real, dimension(nk+1), intent(inout) :: sfn !< Streamfunction (Z m2 s-1 or arbitrary units) !! On entry, equals diffusivity times slope. !! On exit, equals the streamfunction. diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index b71ad46fc7..538c56fb5e 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -400,9 +400,9 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta, m_to type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(time_type), intent(in) :: Time !< The time for the caluculation. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The sea surface height anomaly from - !! a time-mean geoid in depth units (Z). + !! a time-mean geoid [Z ~> m]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_tidal !< The tidal forcing geopotential height - !! anomalies, in depth units (Z). + !! anomalies [Z ~> m]. type(tidal_forcing_CS), pointer :: CS !< The control structure returned by a !! previous call to tidal_forcing_init. real, optional, intent(out) :: deta_tidal_deta !< The partial derivative of diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 67c4173b96..0c309140bc 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -151,7 +151,7 @@ module MOM_CVMix_KPP real, allocatable, dimension(:,:,:) :: Uz2 !< Square of bulk difference in resolved velocity (m2/s2) real, allocatable, dimension(:,:,:) :: BulkRi !< Bulk Richardson number for each layer (dimensionless) real, allocatable, dimension(:,:,:) :: sigma !< Sigma coordinate (dimensionless) - real, allocatable, dimension(:,:,:) :: Ws !< Turbulent velocity scale for scalars (m/s) + real, allocatable, dimension(:,:,:) :: Ws !< Turbulent velocity scale for scalars [m s-1] real, allocatable, dimension(:,:,:) :: N !< Brunt-Vaisala frequency (1/s) real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency (1/s2) real, allocatable, dimension(:,:,:) :: Vt2 !< Unresolved squared turbulence velocity for bulk Ri (m2/s2) @@ -160,8 +160,8 @@ module MOM_CVMix_KPP real, allocatable, dimension(:,:,:) :: Kv_KPP !< Viscosity due to KPP (m2/s) real, allocatable, dimension(:,:) :: Tsurf !< Temperature of surface layer (C) real, allocatable, dimension(:,:) :: Ssurf !< Salinity of surface layer (ppt) - real, allocatable, dimension(:,:) :: Usurf !< i-velocity of surface layer (m/s) - real, allocatable, dimension(:,:) :: Vsurf !< j-velocity of surface layer (m/s) + real, allocatable, dimension(:,:) :: Usurf !< i-velocity of surface layer [m s-1] + real, allocatable, dimension(:,:) :: Vsurf !< j-velocity of surface layer [m s-1] real, allocatable, dimension(:,:,:) :: EnhK !< Enhancement for mixing coefficient real, allocatable, dimension(:,:,:) :: EnhVt2 !< Enhancement for Vt2 @@ -595,8 +595,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & !< (out) Vertical diffusivity including KPP (Z2/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP (Z2/s) !< (out) Vertical viscosity including KPP (Z2/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport (m/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport (m/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport [m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport [m s-1] ! Local variables integer :: i, j, k ! Loop indices @@ -694,7 +694,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & CS%kOBL(i,j), & ! (in) level (+fraction) of OBL extent nonLocalTrans(:,1),& ! (out) Non-local heat transport (non-dimensional) nonLocalTrans(:,2),& ! (out) Non-local salt transport (non-dimensional) - surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) + surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) G%ke, & ! (in) Number of levels to compute coeffs for G%ke, & ! (in) Number of levels in array shape @@ -802,7 +802,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & ! therefore, don't repeat this operation here ! CS%Vt2(i,j,:) = CVmix_kpp_compute_unresolved_shear( & ! cellHeight(1:G%ke), & ! Depth of cell center (m) -! ws_cntr=Ws_1d, & ! Turbulent velocity scale profile, at centers (m/s) +! ws_cntr=Ws_1d, & ! Turbulent velocity scale profile, at centers [m s-1] ! N_iface=CS%N(i,j,:), & ! Buoyancy frequency at interface (1/s) ! CVmix_kpp_params_user=CS%KPP_params ) ! KPP parameters endif @@ -879,8 +879,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< potential/cons temp (deg C) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< Salinity (ppt) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Velocity i-component (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Velocity j-component (m/s) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Velocity i-component [m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Velocity j-component [m s-1] type(EOS_type), pointer :: EOS !< Equation of state real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (Z/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux (m2/s3) @@ -891,7 +891,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) real, dimension( G%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces (1/s2) - real, dimension( G%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars (m/s) + real, dimension( G%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars [m s-1] real, dimension( G%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number real, dimension( G%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri (m2/s2) real, dimension( G%ke ) :: surfBuoyFlux2 @@ -1103,14 +1103,14 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF CS%surf_layer_ext, & ! (in) Normalized surface layer depth; sigma = CS%surf_layer_ext -cellHeight, & ! (in) Assume here that OBL depth (m) = -cellHeight(k) surfBuoyFlux2, & ! (in) Buoyancy flux at surface (m2/s3) - surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) - w_s=Ws_1d, & ! (out) Turbulent velocity scale profile (m/s) + surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] + w_s=Ws_1d, & ! (out) Turbulent velocity scale profile [m s-1] CVMix_kpp_params_user=CS%KPP_params ) !Compute CVMix VT2 CS%Vt2(i,j,:) = CVmix_kpp_compute_unresolved_shear( & zt_cntr=cellHeight(1:G%ke), & ! Depth of cell center (m) - ws_cntr=Ws_1d, & ! Turbulent velocity scale profile, at centers (m/s) + ws_cntr=Ws_1d, & ! Turbulent velocity scale profile, at centers [m s-1] N_iface=CS%N(i,j,:), & ! Buoyancy frequency at interface (1/s) CVmix_kpp_params_user=CS%KPP_params ) ! KPP parameters @@ -1161,7 +1161,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF delta_buoy_cntr=GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) (1/s) delta_Vsqr_cntr=deltaU2, & ! Square of resolved velocity difference (m2/s2) Vt_sqr_cntr=CS%Vt2(i,j,:), & - ws_cntr=Ws_1d, & ! Turbulent velocity scale profile (m/s) + ws_cntr=Ws_1d, & ! Turbulent velocity scale profile [m s-1] N_iface=CS%N(i,j,:)) ! Buoyancy frequency (1/s) @@ -1174,7 +1174,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF CS%OBLdepth(i,j), & ! (out) OBL depth (m) CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent zt_cntr=cellHeight, & ! (in) Height of cell centers (m) - surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) + surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) Coriolis=Coriolis, & ! (in) Coriolis parameter (1/s) CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters @@ -1239,7 +1239,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! cellHeight(1:G%ke), & ! Depth of cell center (m) ! GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) (1/s) ! deltaU2, & ! Square of resolved velocity difference (m2/s2) - ! ws_cntr=Ws_1d, & ! Turbulent velocity scale profile (m/s) + ! ws_cntr=Ws_1d, & ! Turbulent velocity scale profile [m s-1] ! N_iface=CS%N ) ! Buoyancy frequency (1/s) ! surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit @@ -1251,7 +1251,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! CS%OBLdepth(i,j), & ! (out) OBL depth (m) ! CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent ! zt_cntr=cellHeight, & ! (in) Height of cell centers (m) - ! surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) + ! surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] ! surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) ! Coriolis=Coriolis, & ! (in) Coriolis parameter (1/s) ! CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters @@ -1280,8 +1280,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF -CellHeight/CS%OBLdepth(i,j), & ! (in) Normalized boundary layer coordinate CS%OBLdepth(i,j), & ! (in) OBL depth (m) surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) - surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) - w_s=Ws_1d, & ! (out) Turbulent velocity scale profile (m/s) + surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] + w_s=Ws_1d, & ! (out) Turbulent velocity scale profile [m s-1] CVMix_kpp_params_user=CS%KPP_params) ! KPP parameters CS%Ws(i,j,:) = Ws_1d(:) endif diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 7ba09a935a..b976ddc3a4 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -60,8 +60,8 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: u_H !< Initial zonal velocity on T points, in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: v_H !< Initial meridional velocity on T points, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: u_H !< Initial zonal velocity on T points [m s-1]. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: v_H !< Initial meridional velocity on T points [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 07f4958e16..b060621ceb 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -236,8 +236,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C R0, & ! The potential density referenced to the surface [kg m-3]. Rcv ! The coordinate variable potential density [kg m-3]. real, dimension(SZI_(G),SZK_(GV)) :: & - u, & ! The zonal velocity, in m s-1. - v, & ! The meridional velocity, in m s-1. + u, & ! The zonal velocity [m s-1]. + v, & ! The meridional velocity [m s-1]. h_orig, & ! The original thickness [H ~> m or kg m-2]. d_eb, & ! The downward increase across a layer in the entrainment from ! below [H ~> m or kg m-2]. The sign convention is that positive values of @@ -1330,7 +1330,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, real, dimension(2,SZI_(G)), intent(out) :: cMKE !< Coefficients of HpE and HpE^2 in !! calculating the denominator of MKE_rate, !! [H-1 ~> m-1 or m2 kg-1] and [H-2 ~> m-2 or m4 kg-2]. - real, intent(in) :: dt !< The time step in s. + real, intent(in) :: dt !< The time step [s]. real, intent(in) :: Idt_diag !< The inverse of the accumulated diagnostic !! time interval [s-1]. integer, intent(in) :: j !< The j-index to work on. @@ -1351,7 +1351,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, ! that release is positive [Z m2 s-2 ~> m3 s-2]. real :: MKE_rate_CA ! MKE_rate for convective adjustment, ND, 0 to 1. real :: MKE_rate_FC ! MKE_rate for free convection, ND, 0 to 1. - real :: totEn_Z ! The total potential energy released by convection, Z3 s-2. + real :: totEn_Z ! The total potential energy released by convection, [Z3 s-2 ~> m3 s-2]. real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. real :: exp_kh ! The nondimensional decay of TKE across a layer [nondim]. real :: absf ! The absolute value of f averaged to thickness points, s-1. diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 9e69a284b3..bd514c3a1d 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -66,10 +66,14 @@ module MOM_diabatic_aux integer :: id_nonpenSW_diag = -1 !< Diagnostic ID of Non-penetrative shortwave heating ! Optional diagnostic arrays - real, allocatable, dimension(:,:) :: createdH !< The amount of volume added in order to avoid grounding (m/s) - real, allocatable, dimension(:,:,:) :: penSW_diag !< Heating in a layer from convergence of penetrative SW (W/m2) - real, allocatable, dimension(:,:,:) :: penSWflux_diag !< Penetrative SW flux at base of grid layer (W/m2) - real, allocatable, dimension(:,:) :: nonpenSW_diag !< Non-downwelling SW radiation (W/m2) at ocean surface + real, allocatable, dimension(:,:) :: createdH !< The amount of volume added in order to + !! avoid grounding [m s-1] + real, allocatable, dimension(:,:,:) :: penSW_diag !< Heating in a layer from convergence of + !! penetrative SW [W m-2] + real, allocatable, dimension(:,:,:) :: penSWflux_diag !< Penetrative SW flux at base of grid + !! layer [W m-2] + real, allocatable, dimension(:,:) :: nonpenSW_diag !< Non-downwelling SW radiation at ocean + !! surface [W m-2] end type diabatic_aux_CS @@ -542,15 +546,15 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity, in m s-1 + intent(in) :: u !< The zonal velocity [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity, in m s-1 + intent(in) :: v !< The meridional velocity [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u_h !< Zonal velocity interpolated to h points, in m s-1. + intent(out) :: u_h !< Zonal velocity interpolated to h points [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(out) :: v_h !< Meridional velocity interpolated to h points, in m s-1. + intent(out) :: v_h !< Meridional velocity interpolated to h points [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: ea !< The amount of fluid entrained from the layer !! above within this time step [H ~> m or kg m-2]. @@ -1201,7 +1205,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & tv%T(i,j,k) = T2d(i,k) enddo ; enddo - ! Diagnose heating (W/m2) applied to a grid cell from SW penetration + ! Diagnose heating [W m-2] applied to a grid cell from SW penetration ! Also diagnose the penetrative SW heat flux at base of layer. if (CS%id_penSW_diag > 0 .or. CS%id_penSWflux_diag > 0) then diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 609ee1743d..336bbc8a06 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -246,8 +246,8 @@ module MOM_diabatic_driver type(group_pass_type) :: pass_Kv !< For group halo pass type(diag_grid_storage) :: diag_grids_prev!< Stores diagnostic grids at some previous point in the algorithm ! Data arrays for communicating between components - real, allocatable, dimension(:,:,:) :: KPP_NLTheat !< KPP non-local transport for heat (m/s) - real, allocatable, dimension(:,:,:) :: KPP_NLTscalar !< KPP non-local transport for scalars (m/s) + real, allocatable, dimension(:,:,:) :: KPP_NLTheat !< KPP non-local transport for heat [m s-1] + real, allocatable, dimension(:,:,:) :: KPP_NLTscalar !< KPP non-local transport for scalars [m s-1] real, allocatable, dimension(:,:,:) :: KPP_buoy_flux !< KPP forcing buoyancy flux (m^2/s^3) real, allocatable, dimension(:,:) :: KPP_temp_flux !< KPP effective temperature flux (K m/s) real, allocatable, dimension(:,:) :: KPP_salt_flux !< KPP effective salt flux (ppt m/s) @@ -270,8 +270,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity (m/s) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness (m for Bouss / kg/m2 for non-Bouss) type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs @@ -308,7 +308,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & dSV_dS, & ! and salinity in m^3/(kg K) and m^3/(kg ppt). cTKE, & ! convective TKE requirements for each layer in J/m^2. u_h, & ! zonal and meridional velocities at thickness points after - v_h ! entrainment (m/s) + v_h ! entrainment [m s-1] real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & cn ! baroclinic gravity wave speeds real, dimension(SZI_(G),SZJ_(G)) :: & @@ -1156,8 +1156,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity (m/s) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness (m for Bouss / kg/m2 for non-Bouss) type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs @@ -1189,7 +1189,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en dSV_dS, & ! and salinity in m^3/(kg K) and m^3/(kg ppt). cTKE, & ! convective TKE requirements for each layer in J/m^2. u_h, & ! zonal and meridional velocities at thickness points after - v_h ! entrainment (m/s) + v_h ! entrainment [m s-1] real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & cn ! baroclinic gravity wave speeds (formerly cg1 - BDM) diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 0cf25147c8..b6efc01c04 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -55,8 +55,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. !! Absent fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call, - !! in s. + real, intent(in) :: dt !< The amount of time covered by this call [s]. type(diapyc_energy_req_CS), pointer :: CS !< This module's control structure. real, dimension(G%isd:G%ied,G%jsd:G%jed,GV%ke+1), & optional, intent(in) :: Kd_int !< Interface diffusivities [Z2 s-1 ~> m2 s-1]. @@ -69,7 +68,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) Kd, & ! A column of diapycnal diffusivities at interfaces [Z2 s-1 ~> m2 s-1]. h_top, h_bot ! Distances from the top or bottom [H ~> m or kg m-2]. real :: ustar, absf, htot - real :: energy_Kd ! The energy used by diapycnal mixing in W m-2. + real :: energy_Kd ! The energy used by diapycnal mixing [W m-2]. real :: tmp1 ! A temporary array. integer :: i, j, k, is, ie, js, je, nz, itt logical :: may_print diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 1debb96b3b..40884ca01f 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -48,7 +48,7 @@ module MOM_energetic_PBL !! mechanically forced entrainment of the mixed layer is converted to !! TKE [nondim]. ! real :: Hmix_min !< The minimum mixed layer thickness in m. - real :: ustar_min !< A minimum value of ustar to avoid numerical problems, in m s-1. + real :: ustar_min !< A minimum value of ustar to avoid numerical problems [m s-1]. !! If the value is small enough, this should not affect the solution. real :: omega !< The Earth's rotation rate [s-1]. real :: omega_frac !< When setting the decay scale for turbulence, use this fraction of @@ -267,8 +267,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS h, & ! The layer thickness [H ~> m or kg m-2]. T, & ! The layer temperatures [degC]. S, & ! The layer salinities [PSU]. - u, & ! The zonal velocity, in m s-1. - v ! The meridional velocity, in m s-1. + u, & ! The zonal velocity [m s-1]. + v ! The meridional velocity [m s-1]. real, dimension(SZI_(G),SZK_(GV)+1) :: & Kd, & ! The diapycnal diffusivity, in m2 s-1. pres, & ! Interface pressures in Pa. @@ -359,7 +359,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! used convert TKE back into ustar^3. real :: U_star ! The surface friction velocity [Z s-1 ~> m s-1]. real :: U_Star_Mean ! The surface friction without gustiness [Z s-1 ~> m s-1]. - real :: vstar ! An in-situ turbulent velocity, in m s-1. + real :: vstar ! An in-situ turbulent velocity [m s-1]. real :: Enhance_M ! An enhancement factor for vstar, based here on Langmuir impact. real :: LA ! The Langmuir number (non-dim) real :: LAmod ! A modified Langmuir number accounting for other parameters. @@ -1872,10 +1872,10 @@ end subroutine energetic_PBL_get_MLD !> Computes wind speed from ustar_air based on COARE 3.5 Cd relationship subroutine ust_2_u10_coare3p5(USTair, U10, GV, US) - real, intent(in) :: USTair !< Ustar in the air, in m s-1. + real, intent(in) :: USTair !< Ustar in the air [m s-1]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(out) :: U10 !< The 10 m wind speed, in m s-1. + real, intent(out) :: U10 !< The 10 m wind speed [m s-1]. real, parameter :: vonkar = 0.4 real, parameter :: nu=1e-6 @@ -1918,14 +1918,14 @@ end subroutine ust_2_u10_coare3p5 !> This subroutine returns the Langmuir number, given ustar and the boundary !! layer thickness, inclusion conversion to the 10m wind. subroutine get_LA_windsea(ustar, hbl, GV, US, LA) - real, intent(in) :: ustar !< The water-side surface friction velocity (m/s) + real, intent(in) :: ustar !< The water-side surface friction velocity [m s-1] real, intent(in) :: hbl !< The ocean boundary layer depth (m) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(out) :: LA !< The Langmuir number returned from this module ! Original description: ! This function returns the enhancement factor, given the 10-meter -! wind (m/s), friction velocity (m/s) and the boundary layer depth (m). +! wind [m s-1], friction velocity [m s-1] and the boundary layer depth (m). ! Update (Jan/25): ! Converted from function to subroutine, now returns Langmuir number. ! Computes 10m wind internally, so only ustar and hbl need passed to diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 43556d0e0d..5bebd8ea60 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -53,9 +53,9 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity, in m s-1. + intent(in) :: u !< The zonal velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity, in m s-1. + intent(in) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available @@ -63,7 +63,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, !! ptrs. type(forcing), intent(in) :: fluxes !< A structure of surface fluxes that may !! be used. - real, intent(in) :: dt !< The time increment in s. + real, intent(in) :: dt !< The time increment [s]. type(entrain_diffusive_CS), pointer :: CS !< The control structure returned by a previous !! call to entrain_diffusive_init. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -112,9 +112,9 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, real, allocatable, dimension(:,:,:) :: & Kd_eff, & ! The effective diffusivity that actually applies to each ! layer after the effects of boundary conditions are - ! considered, in m2 s-1. + ! considered [Z2 s-1 ~> m2 s-1]. diff_work ! The work actually done by diffusion across each - ! interface, in W m-2. Sum vertically for the total work. + ! interface [W m-2]. Sum vertically for the total work. real :: hm, fm, fr, fk ! Work variables with units of H, H, H, and H2. @@ -124,7 +124,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, real, dimension(SZI_(G)) :: & htot, & ! The total thickness above or below a layer [H ~> m or kg m-2]. Rcv, & ! Value of the coordinate variable (potential density) - ! based on the simulated T and S and P_Ref, kg m-3. + ! based on the simulated T and S and P_Ref [kg m-3]. pres, & ! Reference pressure (P_Ref) in Pa. eakb, & ! The entrainment from above by the layer below the buffer ! layer (i.e. layer kb) [H ~> m or kg m-2]. @@ -135,7 +135,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, dS_anom_lim, &! The amount by which dS_kb is reduced when limits are ! applied [kg m-3]. I_dSkbp1, & ! The inverse of the potential density difference across the - ! interface below layer kb, in m3 kg-1. + ! interface below layer kb [m3 kg-1]. dtKd_kb, & ! The diapycnal diffusivity in layer kb times the time step ! [H2 ~> m2 or kg2 m-4]. maxF_correct, & ! An amount by which to correct maxF due to excessive @@ -177,9 +177,9 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, real, dimension(SZI_(G)) :: & pressure, & ! The pressure at an interface [Pa]. T_eos, S_eos, & ! The potential temperature and salinity at which to - ! evaluate dRho_dT and dRho_dS, in degC and PSU. + ! evaluate dRho_dT and dRho_dS [degC] and [PSU]. dRho_dT, dRho_dS ! The partial derivatives of potential density with - ! temperature and salinity, in kg m-3 K-1 and kg m-3 psu-1. + ! temperature and salinity, [kg m-3 degC-1] and [kg m-3 ppt-1]. real :: tolerance ! The tolerance within which E must be converged [H ~> m or kg m-2]. real :: Angstrom ! The minimum layer thickness [H ~> m or kg m-2]. @@ -187,11 +187,11 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: F_cor ! A correction to the amount of F that is used to ! entrain from the layer above [H ~> m or kg m-2]. - real :: Kd_here ! The effective diapycnal diffusivity, in H2 s-1. + real :: Kd_here ! The effective diapycnal diffusivity [H2 s-1 ~> m2 s-1 or kg2 m-4 s-1]. real :: h_avail ! The thickness that is available for entrainment [H ~> m or kg m-2]. real :: dS_kb_eff ! The value of dS_kb after limiting is taken into account. real :: Rho_cor ! The depth-integrated potential density anomaly that - ! needs to be corrected for, in kg m-2. + ! needs to be corrected for [H kg m-3 ~> kg m-2 or kg2 m-5]. real :: ea_cor ! The corrective adjustment to eakb [H ~> m or kg m-2]. real :: h1 ! The layer thickness after entrainment through the ! interface below is taken into account [H ~> m or kg m-2]. diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 2bffbfbb96..9ebb03772e 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -24,10 +24,10 @@ module MOM_geothermal type, public :: geothermal_CS ; private real :: dRcv_dT_inplace !< The value of dRcv_dT above which (dRcv_dT is !! negative) the water is heated in place instead - !! of moving upward between layers, in kg m-3 K-1. - real, pointer :: geo_heat(:,:) => NULL() !< The geothermal heat flux, in W m-2. + !! of moving upward between layers [kg m-3 degC-1]. + real, pointer :: geo_heat(:,:) => NULL() !< The geothermal heat flux [W m-2]. real :: geothermal_thick !< The thickness over which geothermal heating is - !! applied, in m. + !! applied [m] (not [H]). logical :: apply_geothermal !< If true, geothermal heating will be applied !! otherwise GEOTHERMAL_SCALE has been set to 0 and !! there is no heat to apply. @@ -54,7 +54,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) !! to any available thermodynamic !! fields. Absent fields have NULL !! ptrs. - real, intent(in) :: dt !< Time increment, in s. + real, intent(in) :: dt !< Time increment [s]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: ea !< The amount of fluid moved !! downward into a layer; this !! should be increased due to mixed @@ -71,31 +71,35 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) real, dimension(SZI_(G)) :: & heat_rem, & ! remaining heat (H * degC) h_geo_rem, & ! remaining thickness to apply geothermal heating [H ~> m or kg m-2] - Rcv_BL, & ! coordinate density in the deepest variable density layer (kg/m3) - p_ref ! coordiante densities reference pressure (Pa) + Rcv_BL, & ! coordinate density in the deepest variable density layer [kg m-3] + p_ref ! coordiante densities reference pressure [Pa] real, dimension(2) :: & - T2, S2, & ! temp and saln in the present and target layers (degC and ppt) - dRcv_dT_, & ! partial derivative of coordinate density wrt temp (kg m-3 K-1) - dRcv_dS_ ! partial derivative of coordinate density wrt saln (kg m-3 ppt-1) + T2, S2, & ! temp and saln in the present and target layers [degC] and [ppt] + dRcv_dT_, & ! partial derivative of coordinate density wrt temp [kg m-3 degC-1] + dRcv_dS_ ! partial derivative of coordinate density wrt saln [kg m-3 ppt-1] real :: Angstrom, H_neglect ! small thicknesses [H ~> m or kg m-2] - real :: Rcv ! coordinate density of present layer (kg m-3) - real :: Rcv_tgt ! coordinate density of target layer (kg m-3) - real :: dRcv ! difference between Rcv and Rcv_tgt (kg m-3) + real :: Rcv ! coordinate density of present layer [kg m-3] + real :: Rcv_tgt ! coordinate density of target layer [kg m-3] + real :: dRcv ! difference between Rcv and Rcv_tgt [kg m-3] real :: dRcv_dT ! partial derivative of coordinate density wrt temp ! in the present layer (kg m-3 K-1); usually negative real :: h_heated ! thickness that is being heated [H ~> m or kg m-2] - real :: heat_avail ! heating available for the present layer (units of Kelvin * H) - real :: heat_in_place ! heating to warm present layer w/o movement between layers (K * H) - real :: heat_trans ! heating available to move water from present layer to target layer (K * H) - real :: heating ! heating used to move water from present layer to target layer (K * H) + real :: heat_avail ! heating available for the present layer [degC H ~> degC m or degC kg m-2] + real :: heat_in_place ! heating to warm present layer w/o movement between layers + ! [degC H ~> degC m or degC kg m-2] + real :: heat_trans ! heating available to move water from present layer to target + ! layer [degC H ~> degC m or degC kg m-2] + real :: heating ! heating used to move water from present layer to target layer + ! [degC H ~> degC m or degC kg m-2] ! 0 <= heating <= heat_trans real :: h_transfer ! thickness moved between layers [H ~> m or kg m-2] - real :: wt_in_place ! relative weighting that goes from 0 to 1 (non-dim) - real :: I_h ! inverse thickness (units of 1/H) - real :: dTemp ! temperature increase in a layer (Kelvin) - real :: Irho_cp ! inverse of heat capacity per unit layer volume (units K H m2 J-1) + real :: wt_in_place ! relative weighting that goes from 0 to 1 [nondim] + real :: I_h ! inverse thickness [H-1 ~> m-1 or m2 kg-1] + real :: dTemp ! temperature increase in a layer [degC] + real :: Irho_cp ! inverse of heat capacity per unit layer volume + ! [degC H m2 J-1 ~> degC m3 J-1 or degC kg J-1] logical :: do_i(SZI_(G)) integer :: i, j, k, is, ie, js, je, nz, k2, i2 diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 8a628c201e..f5142c27fc 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -53,7 +53,7 @@ module MOM_int_tide_input real, allocatable, dimension(:,:) :: & TKE_itidal_input, & !< The internal tide TKE input at the bottom of the ocean, in W m-2. h2, & !< The squared topographic roughness height [Z2 ~> m2]. - tideamp, & !< The amplitude of the tidal velocities, in m s-1. + tideamp, & !< The amplitude of the tidal velocities [m s-1]. Nb !< The bottom stratification, in s-1. end type int_tide_input_type @@ -64,22 +64,22 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1 - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, in m s-1 + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity [m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to the !! thermodynamic fields type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes type(int_tide_input_type), intent(inout) :: itide !< A structure containing fields related !! to the internal tide sources. - real, intent(in) :: dt !< The time increment in s. + real, intent(in) :: dt !< The time increment [s]. type(int_tide_input_CS), pointer :: CS !< This module's control structure. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & N2_bot ! The bottom squared buoyancy frequency, in s-2. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - T_f, S_f ! The temperature and salinity in C and PSU with the values in + T_f, S_f ! The temperature and salinity in [degC] and [ppt] with the values in ! the massless layers filled vertically by diffusion. logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. @@ -95,8 +95,8 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) if (.not.associated(CS)) call MOM_error(FATAL,"set_diffusivity: "//& "Module must be initialized before it is used.") - kappa_fill = 1.e-3*US%m_to_Z**2 !### Dimensional constant in m2 s-1. - dt_fill = 7200. !### Dimensionalconstant in s. + kappa_fill = 1.e-3*US%m_to_Z**2 !### Dimensional constant [m2 s-1]. + dt_fill = 7200. !### Dimensionalconstant [s]. use_EOS = associated(tv%eqn_of_state) @@ -260,7 +260,7 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) character(len=200) :: filename, tideamp_file, h2_file real :: mask_itidal - real :: utide ! constant tidal amplitude (m s-1) to be used if + real :: utide ! constant tidal amplitude [m s-1] to be used if ! tidal amplitude file is not present. real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height. real :: kappa_itides ! topographic wavenumber and non-dimensional scaling diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 3ac50b6049..341af67534 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -73,7 +73,7 @@ module MOM_kappa_shear !! massive layers in this calculation. ! I can think of no good reason why this should be false. - RWH real :: vel_underflow !< Velocity components smaller than vel_underflow - !! are set to 0, in m s-1. + !! are set to 0 [m s-1]. ! logical :: layer_stagger = .false. ! If true, do the calculations centered at ! layers, rather than the interfaces. logical :: debug = .false. !< If true, write verbose debugging messages. @@ -98,9 +98,9 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: u_in !< Initial zonal velocity, in m s-1. (Intent in) + intent(in) :: u_in !< Initial zonal velocity [m s-1]. (Intent in) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: v_in !< Initial meridional velocity, in m s-1. + intent(in) :: v_in !< Initial meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any @@ -137,8 +137,8 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & real, dimension(SZI_(G),SZK_(GV)+1) :: & kappa_2d, tke_2d ! 2-D versions of various kappa_io and tke_io. real, dimension(SZK_(GV)) :: & - u, & ! The zonal velocity after a timestep of mixing, in m s-1. - v, & ! The meridional velocity after a timestep of mixing, in m s-1. + u, & ! The zonal velocity after a timestep of mixing [m s-1]. + v, & ! The meridional velocity after a timestep of mixing [m s-1]. Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. T, & ! The potential temperature after a timestep of mixing [degC]. Sal, & ! The salinity after a timestep of mixing [PSU]. @@ -385,9 +385,9 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: u_in !< Initial zonal velocity, in m s-1. (Intent in) + intent(in) :: u_in !< Initial zonal velocity [m s-1]. (Intent in) real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(in) :: v_in !< Initial meridional velocity, in m s-1. + intent(in) :: v_in !< Initial meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -428,8 +428,8 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ real, dimension(SZIB_(G),SZK_(GV)+1) :: & tke_2d ! 2-D version tke_io [m2 s-2]. real, dimension(SZK_(GV)) :: & - u, & ! The zonal velocity after a timestep of mixing, in m s-1. - v, & ! The meridional velocity after a timestep of mixing, in m s-1. + u, & ! The zonal velocity after a timestep of mixing [m s-1]. + v, & ! The meridional velocity after a timestep of mixing [m s-1]. Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. T, & ! The potential temperature after a timestep of mixing, in C. Sal, & ! The salinity after a timestep of mixing [PSU]. @@ -744,8 +744,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & !! call to kappa_shear_init. real, dimension(nzc) :: & - u, & ! The zonal velocity after a timestep of mixing, in m s-1. - v, & ! The meridional velocity after a timestep of mixing, in m s-1. + u, & ! The zonal velocity after a timestep of mixing [m s-1]. + v, & ! The meridional velocity after a timestep of mixing [m s-1]. Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. T, & ! The potential temperature after a timestep of mixing [degC]. Sal, & ! The salinity after a timestep of mixing [PSU]. @@ -1235,27 +1235,26 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & !! layers?). real, dimension(nz+1), intent(in) :: kappa !< The diapycnal diffusivity at interfaces, !! [Z2 s-1 ~> m2 s-1]. - real, dimension(nz), intent(in) :: u0 !< The initial zonal velocity, in m s-1. - real, dimension(nz), intent(in) :: v0 !< The initial meridional velocity, in m s-1. - real, dimension(nz), intent(in) :: T0 !< The initial temperature, in C. + real, dimension(nz), intent(in) :: u0 !< The initial zonal velocity [m s-1]. + real, dimension(nz), intent(in) :: v0 !< The initial meridional velocity [m s-1]. + real, dimension(nz), intent(in) :: T0 !< The initial temperature [degC]. real, dimension(nz), intent(in) :: S0 !< The initial salinity [PSU]. real, dimension(nz), intent(in) :: dz !< The grid spacing of layers [Z ~> m]. real, dimension(nz+1), intent(in) :: I_dz_int !< The inverse of the layer's thicknesses !! [Z-1 ~> m-1]. real, dimension(nz+1), intent(in) :: dbuoy_dT !< The partial derivative of buoyancy with - !! temperature [Z s-2 C-1 ~> m s-2 C-1]. + !! temperature [Z s-2 degC-1 ~> m s-2 degC-1]. real, dimension(nz+1), intent(in) :: dbuoy_dS !< The partial derivative of buoyancy with !! salinity [Z s-2 PSU-1 ~> m s-2 PSU-1]. - real, intent(in) :: dt !< The time step in s. - real, dimension(nz), intent(inout) :: u !< The zonal velocity after dt, in m s-1. - real, dimension(nz), intent(inout) :: v !< The meridional velocity after dt, in m s-1. - real, dimension(nz), intent(inout) :: T !< The temperature after dt, in C. + real, intent(in) :: dt !< The time step [s]. + real, dimension(nz), intent(inout) :: u !< The zonal velocity after dt [m s-1]. + real, dimension(nz), intent(inout) :: v !< The meridional velocity after dt [m s-1]. + real, dimension(nz), intent(inout) :: T !< The temperature after dt [degC]. real, dimension(nz), intent(inout) :: Sal !< The salinity after dt [PSU]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(nz+1), optional, & - intent(inout) :: N2 !< The buoyancy frequency squared at interfaces, - !! in s-2. + intent(inout) :: N2 !< The buoyancy frequency squared at interfaces [s-2]. real, dimension(nz+1), optional, & intent(inout) :: S2 !< The squared shear at interfaces [s-2]. integer, optional, intent(in) :: ks_int !< The topmost k-index with a non-zero diffusivity. @@ -1263,13 +1262,13 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & !! diffusivity. real, optional, intent(in) :: vel_underflow !< If present and true, any velocities that !! are smaller in magnitude than this value are - !! set to 0, in m s-1. + !! set to 0 [m s-1]. ! Local variables real, dimension(nz+1) :: c1 real :: L2_to_Z2 ! A conversion factor from horizontal length units to vertical depth ! units squared [Z2 m-2 ~> 1]. - real :: underflow_vel ! Velocities smaller in magnitude than underflow_vel are set to 0, in m s-1. + real :: underflow_vel ! Velocities smaller in magnitude than underflow_vel are set to 0 [m s-1]. real :: a_a, a_b, b1, d1, bd1, b1nz_0 integer :: k, ks, ke @@ -1437,7 +1436,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0, Z2 s-1. real :: eden1, eden2, I_eden, ome ! Variables used in calculating e1. - real :: diffusive_src ! The diffusive source in the kappa equation, in m s-1. + real :: diffusive_src ! The diffusive source in the kappa equation [m s-1]. real :: chg_by_k0 ! The value of k_src that leads to an increase of ! kappa_0 if only the diffusive term is a sink [s-1]. diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 73bfd1c192..c1b1d68698 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -82,7 +82,7 @@ subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, CS) type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. - real, intent(in) :: dt !< Time increment, in s. + real, intent(in) :: dt !< Time increment [s]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: ea !< The amount of fluid moved downward into a !! layer; this should be increased due to mixed @@ -120,7 +120,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. - real, intent(in) :: dt !< Time increment, in s. + real, intent(in) :: dt !< Time increment [s]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: ea !< The amount of fluid moved downward into a !! layer; this should be increased due to mixed diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 5dee563b35..8222d04a2c 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -207,15 +207,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity, in m s-1. + intent(in) :: u !< The zonal velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity, in m s-1. + intent(in) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u_h !< Zonal velocity interpolated to h points, in m s-1. + intent(in) :: u_h !< Zonal velocity interpolated to h points [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: v_h !< Meridional velocity interpolated to h points, in m s-1. + intent(in) :: v_h !< Meridional velocity interpolated to h points [m s-1]. type(thermo_var_ptrs), intent(inout) :: tv !< Structure with pointers to thermodynamic !! fields. Out is for tv%TempxPmE. type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes @@ -283,8 +283,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & "Module must be initialized before it is used.") I_Rho0 = 1.0/GV%Rho0 - kappa_fill = 1.e-3*US%m_to_Z**2 !### Dimensional constant in m2 s-1. - dt_fill = 7200. !### Dimensionalconstant in s. + kappa_fill = 1.e-3*US%m_to_Z**2 !### Dimensional constant [m2 s-1]. + dt_fill = 7200. !### Dimensionalconstant [s]. Omega2 = CS%Omega*CS%Omega use_EOS = associated(tv%eqn_of_state) @@ -1134,9 +1134,9 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity, in m s-1 + intent(in) :: u !< The zonal velocity [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity, in m s-1 + intent(in) :: v !< The meridional velocity [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available @@ -1371,9 +1371,9 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< u component of flow (m s-1) + intent(in) :: u !< u component of flow [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< v component of flow (m s-1) + intent(in) :: v !< v component of flow [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available @@ -1437,7 +1437,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) ! Non-zero on equator! - ! u* at the bottom, in m s-1. + ! u* at the bottom [m s-1]. ustar = visc%ustar_BBL(i,j) ustar2 = ustar**2 ! In add_drag_diffusivity(), fluxes%ustar_tidal is added in. This might be double counting @@ -1663,9 +1663,9 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity, in m s-1 + intent(in) :: u !< The zonal velocity [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity, in m s-1 + intent(in) :: v !< The meridional velocity [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 7f86d51df3..d5fc24f16d 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -46,7 +46,7 @@ module MOM_set_visc real :: c_Smag !< The Laplacian Smagorinsky coefficient for !! calculating the drag in channels. real :: drag_bg_vel !< An assumed unresolved background velocity for - !! calculating the bottom drag, in m s-1. + !! calculating the bottom drag [m s-1]. real :: BBL_thick_min !< The minimum bottom boundary layer thickness [H ~> m or kg m-2]. !! This might be Kv / (cdrag * drag_bg_vel) to give !! Kv as the minimum near-bottom viscosity. @@ -107,9 +107,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity, in m s-1. + intent(in) :: u !< The zonal velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity, in m s-1. + intent(in) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any @@ -125,7 +125,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! Local variables real, dimension(SZIB_(G)) :: & - ustar, & ! The bottom friction velocity, in m s-1. + ustar, & ! The bottom friction velocity [m s-1]. T_EOS, & ! The temperature used to calculate the partial derivatives ! of density with T and S [degC]. S_EOS, & ! The salinity used to calculate the partial derivatives @@ -908,7 +908,7 @@ end subroutine set_viscous_BBL function set_v_at_u(v, h, G, i, j, k, mask2dCv, OBC) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity, in m s-1 + intent(in) :: v !< The meridional velocity [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] integer, intent(in) :: i !< The i-index of the u-location to work on. @@ -917,7 +917,7 @@ function set_v_at_u(v, h, G, i, j, k, mask2dCv, OBC) real, dimension(SZI_(G),SZJB_(G)),& intent(in) :: mask2dCv !< A multiplicative mask of the v-points type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure - real :: set_v_at_u !< The retur value of v at u points, in m s-1. + real :: set_v_at_u !< The retur value of v at u points [m s-1]. ! This subroutine finds a thickness-weighted value of v at the u-points. real :: hwt(0:1,-1:0) ! Masked weights used to average u onto v [H ~> m or kg m-2]. @@ -951,7 +951,7 @@ end function set_v_at_u function set_u_at_v(u, h, G, i, j, k, mask2dCu, OBC) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity, in m s-1 + intent(in) :: u !< The zonal velocity [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] integer, intent(in) :: i !< The i-index of the u-location to work on. @@ -960,7 +960,7 @@ function set_u_at_v(u, h, G, i, j, k, mask2dCu, OBC) real, dimension(SZIB_(G),SZJ_(G)), & intent(in) :: mask2dCu !< A multiplicative mask of the u-points type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure - real :: set_u_at_v !< The return value of u at v points, in m s-1. + real :: set_u_at_v !< The return value of u at v points [m s-1]. ! This subroutine finds a thickness-weighted value of u at the v-points. real :: hwt(-1:0,0:1) ! Masked weights used to average u onto v [H ~> m or kg m-2]. @@ -1000,9 +1000,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity, in m s-1. + intent(in) :: u !< The zonal velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity, in m s-1. + intent(in) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available @@ -1011,7 +1011,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities and !! related fields. - real, intent(in) :: dt !< Time increment in s. + real, intent(in) :: dt !< Time increment [s]. type(set_visc_CS), pointer :: CS !< The control structure returned by a previous !! call to vertvisc_init. logical, optional, intent(in) :: symmetrize !< If present and true, do extra calculations @@ -1070,8 +1070,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real :: S_lay ! The layer salinity at velocity points [PSU]. real :: Rlay ! The layer potential density at velocity points [kg m-3]. real :: Rlb ! The potential density of the layer below [kg m-3]. - real :: v_at_u ! The meridonal velocity at a zonal velocity point in m s-1. - real :: u_at_v ! The zonal velocity at a meridonal velocity point in m s-1. + real :: v_at_u ! The meridonal velocity at a zonal velocity point [m s-1]. + real :: u_at_v ! The zonal velocity at a meridonal velocity point [m s-1]. real :: gHprime ! The mixed-layer internal gravity wave speed squared, based ! on the mixed layer thickness and density difference across ! the base of the mixed layer, in m2 s-2. diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index ddcc379406..964942695f 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -58,7 +58,7 @@ module MOM_sponge real, pointer :: Rcv_ml_ref(:) => NULL() !< The value toward which the mixed layer !! coordinate-density is being damped, in kg m-3. real, pointer :: Ref_eta(:,:) => NULL() !< The value toward which the interface - !! heights are being damped, in depth units (Z). + !! heights are being damped [Z ~> m]. type(p3d) :: var(MAX_FIELDS_) !< Pointers to the fields that are being damped. type(p2d) :: Ref_val(MAX_FIELDS_) !< The values to which the fields are damped. @@ -68,7 +68,7 @@ module MOM_sponge real, pointer :: Rcv_ml_ref_im(:) => NULL() !! The value toward which the i-mean !< mixed layer coordinate-density is being damped, in kg m-3. real, pointer :: Ref_eta_im(:,:) => NULL() !< The value toward which the i-mean - !! interface heights are being damped, in depth units (Z). + !! interface heights are being damped [Z ~> m]. type(p2d) :: Ref_val_im(MAX_FIELDS_) !< The values toward which the i-means of !! fields are damped. @@ -90,7 +90,7 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: Iresttime !< The inverse of the restoring time, in s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - intent(in) :: int_height !< The interface heights to damp back toward, in depth units (Z). + intent(in) :: int_height !< The interface heights to damp back toward [Z ~> m]. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(sponge_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module @@ -100,7 +100,7 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & !! the zonal mean properties, in s-1. real, dimension(SZJ_(G),SZK_(G)+1), & optional, intent(in) :: int_height_i_mean !< The interface heights toward which to - !! damp the zonal mean heights, in depth units (Z). + !! damp the zonal mean heights [Z ~> m]. ! This include declares and sets the variable "version". @@ -322,7 +322,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, intent(in) :: dt !< The amount of time covered by this call, in s. + real, intent(in) :: dt !< The amount of time covered by this call [s]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: ea !< An array to which the amount of fluid entrained !! from the layer above during this call will be @@ -334,7 +334,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) type(sponge_CS), pointer :: CS !< A pointer to the control structure for this module !! that is set by a previous call to initialize_sponge. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(inout) :: Rcv_ml !< The coordinate density of the mixed layer in kg m-2. + optional, intent(inout) :: Rcv_ml !< The coordinate density of the mixed layer [kg m-3]. ! This subroutine applies damping to the layers thicknesses, mixed ! layer buoyancy, and a variety of tracers for every column where @@ -345,10 +345,10 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) w_int, & ! Water moved upward across an interface within a timestep, ! [H ~> m or kg m-2]. e_D ! Interface heights that are dilated to have a value of 0 - ! at the surface, in the same units as G%bathyT (m or Z). + ! at the surface [Z ~> m]. real, dimension(SZI_(G), SZJ_(G)) :: & eta_anom, & ! Anomalies in the interface height, relative to the i-mean - ! target value, in depth units (Z). + ! target value [Z ~> m]. fld_anom ! Anomalies in a tracer concentration, relative to the ! i-mean target value. real, dimension(SZJ_(G), SZK_(G)+1) :: & @@ -360,7 +360,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) h_below ! The total thickness below an interface [H ~> m or kg m-2]. real, dimension(SZI_(G)) :: & dilate ! A nondimensional factor by which to dilate layers to - ! give 0 at the surface. + ! give 0 at the surface [nondim]. real :: e(SZK_(G)+1) ! The interface heights [Z ~> m], usually negative. real :: e0 ! The height of the free surface [Z ~> m]. @@ -373,9 +373,9 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) real :: wb ! w at the interface below a layer [H ~> m or kg m-2]. real :: wpb ! wpb is wb if wb is positive and 0 otherwise [H ~> m or kg m-2]. real :: ea_k, eb_k ! [H ~> m or kg m-2] - real :: damp ! The timestep times the local damping coefficient. ND. - real :: I1pdamp ! I1pdamp is 1/(1 + damp). Nondimensional. - real :: damp_1pdamp ! damp_1pdamp is damp/(1 + damp). Nondimensional. + real :: damp ! The timestep times the local damping coefficient [nondim]. + real :: I1pdamp ! I1pdamp is 1/(1 + damp). [nondim] + real :: damp_1pdamp ! damp_1pdamp is damp/(1 + damp). [nondim] real :: Idt ! 1.0/dt, in s-1. integer :: c, m, nkmb, i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index b49f17771b..8eb78abdfa 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -126,7 +126,7 @@ module MOM_tidal_mixing real :: TKE_itide_max !< maximum internal tide conversion (W m-2) !! available to mix above the BBL - real :: utide !< constant tidal amplitude (m s-1) used if + real :: utide !< constant tidal amplitude [m s-1] used if real :: kappa_itides !< topographic wavenumber and non-dimensional scaling [Z-1 ~> m-1]. real :: kappa_h2_factor !< factor for the product of wavenumber * rms sgs height character(len=200) :: inputdir !< The directory in which to find input files @@ -153,7 +153,7 @@ module MOM_tidal_mixing real, pointer, dimension(:,:) :: Nb => NULL() !< The near bottom buoyancy frequency, in s-1. real, pointer, dimension(:,:) :: mask_itidal => NULL() !< A mask of where internal tide energy is input real, pointer, dimension(:,:) :: h2 => NULL() !< Squared bottom depth variance, in m2. - real, pointer, dimension(:,:) :: tideamp => NULL() !< RMS tidal amplitude [m/s] + real, pointer, dimension(:,:) :: tideamp => NULL() !< RMS tidal amplitude [m s-1] real, allocatable, dimension(:) :: h_src !< tidal constituent input layer thickness [m] real, allocatable, dimension(:,:) :: tidal_qe_2d !< Tidal energy input times the local dissipation !! fraction, q*E(x,y), with the CVMix implementation diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 91853f8c4e..b89dc8a280 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -46,10 +46,9 @@ module MOM_vert_friction real :: Kvbbl !< The vertical viscosity in the bottom boundary !! layer, in m2 s-1. - real :: maxvel !< Velocity components greater than maxvel, - !! in m s-1, are truncated. + real :: maxvel !< Velocity components greater than maxvel are truncated [m s-1]. real :: vel_underflow !< Velocity components smaller than vel_underflow - !! are set to 0, in m s-1. + !! are set to 0 [m s-1]. logical :: CFL_based_trunc !< If true, base truncations on CFL numbers, not !! absolute velocities. real :: CFL_trunc !< Velocity components will be truncated when they @@ -149,9 +148,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: u !< Zonal velocity in m s-1 + intent(inout) :: u !< Zonal velocity [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: v !< Meridional velocity in m s-1 + intent(inout) :: v !< Meridional velocity [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces @@ -568,9 +567,9 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: u !< Zonal velocity in m s-1 + intent(in) :: u !< Zonal velocity [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(in) :: v !< Meridional velocity in m s-1 + intent(in) :: v !< Meridional velocity [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces @@ -580,7 +579,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure ! Field from forces used in this subroutine: - ! ustar: the friction velocity in m s-1, used here as the mixing + ! ustar: the friction velocity [m s-1], used here as the mixing ! velocity in the mixed layer if NKML > 1 in a bulk mixed layer. ! Local variables @@ -1083,7 +1082,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, real :: visc_ml ! The mixed layer viscosity [Z2 s-1 ~> m2 s-1]. real :: I_Hmix ! The inverse of the mixed layer thickness [H-1 ~> m-1 or m2 kg-1]. real :: a_ml ! The layer coupling coefficient across an interface in - ! the mixed layer, in m s-1. + ! the mixed layer [m s-1]. real :: I_amax ! The inverse of the maximum coupling coefficient [Z-1 ~> m-1].??? real :: temp1 ! A temporary variable [H Z ~> m2 or kg m-1] real :: h_neglect ! A thickness that is so small it is usually lost @@ -1355,9 +1354,9 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: u !< Zonal velocity in m s-1 + intent(inout) :: u !< Zonal velocity [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: v !< Meridional velocity in m s-1 + intent(inout) :: v !< Meridional velocity [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(accel_diag_ptrs), intent(in) :: ADp !< Acceleration diagnostic pointers @@ -1370,7 +1369,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS ! Local variables real :: maxvel ! Velocities components greater than maxvel - real :: truncvel ! are truncated to truncvel, both in m s-1. + real :: truncvel ! are truncated to truncvel, both [m s-1]. real :: CFL ! The local CFL number. real :: H_report ! A thickness below which not to report truncations. real :: dt_Rho0 ! The timestep divided by the Boussinesq density, in dt m3 kg-1. diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index 90de360e6d..e7684d12fb 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -40,7 +40,7 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & !! tracer, in units of (CU * kg m-2 s-1) real, dimension(SZI_(G),SZJ_(G)), optional,intent(inout) :: btm_reservoir !< amount of tracer in a bottom reservoir !! (units of CU kg m-2; formerly CU m) - real, optional,intent(in) :: sink_rate !< rate at which the tracer sinks, in m s-1 + real, optional,intent(in) :: sink_rate !< rate at which the tracer sinks [m s-1] logical, optional,intent(in) :: convert_flux_in !< True if the specified sfc_flux needs !! to be integrated in time diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 728b2170dc..308702d961 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -391,19 +391,6 @@ subroutine call_tracer_set_forcing(state, fluxes, day_start, day_interval, G, CS type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a !! previous call to call_tracer_register. -! This subroutine calls the individual tracer modules' subroutines to -! specify or read quantities related to their surface forcing. -! Arguments: state - A structure containing fields that describe the -! surface state of the ocean. -! (out) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) day_start - Start time of the fluxes. -! (in) day_interval - Length of time over which these fluxes -! will be applied. -! (in) G - The ocean's grid structure. -! (in) CS - The control structure returned by a previous call to -! call_tracer_register. - if (.not. associated(CS)) call MOM_error(FATAL, "call_tracer_set_forcing"// & "Module must be initialized via call_tracer_register before it is used.") ! if (CS%use_ideal_age) & @@ -412,27 +399,25 @@ subroutine call_tracer_set_forcing(state, fluxes, day_start, day_interval, G, CS end subroutine call_tracer_set_forcing -!> This subroutine calls all registered tracer column physics -!! subroutines. +!> This subroutine calls all registered tracer column physics subroutines. subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, tv, optics, CS, & debug, evap_CFL_limit, minimum_forcing_depth) - real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h_old !< Layer thickness before entrainment, - !! in m (Boussinesq) or kg m-2 - !! (non-Boussinesq). - real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h_new !< Layer thickness after entrainment, - !! in m or kg m-2. + real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h_old !< Layer thickness before entrainment + !! [H ~> m or kg m-2]. + real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h_new !< Layer thickness after entrainment + !! [H ~> m or kg m-2]. real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: ea !< an array to which the amount of !! fluid entrained from the layer above during this call - !! will be added, in m or kg m-2, the same as h_old. + !! will be added [H ~> m or kg m-2]. real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: eb !< an array to which the amount of !! fluid entrained from the layer below during this call - !! will be added, in m or kg m-2, the same as h_old. + !! will be added [H ~> m or kg m-2]. type(forcing), intent(in) :: fluxes !< A structure containing pointers to !! any possible forcing fields. !! Unused fields have NULL ptrs. - real, dimension(NIMEM_,NJMEM_), intent(in) :: Hml !< Mixed layer depth (m) + real, dimension(NIMEM_,NJMEM_), intent(in) :: Hml !< Mixed layer depth [H ~> m or kg m-2] real, intent(in) :: dt !< The amount of time covered by this - !! call, in s + !! call [s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid !! structure. @@ -448,34 +433,7 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, !! the water that can be fluxed out !! of the top layer in a timestep (nondim) real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over - !! which fluxes can be applied, in m - -! This subroutine calls all registered tracer column physics -! subroutines. - -! Arguments: h_old - Layer thickness before entrainment, in m (Boussinesq) -! or kg m-2 (non-Boussinesq). -! (in) h_new - Layer thickness after entrainment, in m or kg m-2. -! (in) ea - an array to which the amount of fluid entrained -! from the layer above during this call will be -! added, in m or kg m-2, the same as h_old. -! (in) eb - an array to which the amount of fluid entrained -! from the layer below during this call will be -! added, in m or kg m-2, the same as h_old. -! (in) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) dt - The amount of time covered by this call, in s. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) tv - The structure containing thermodynamic variables. -! (in) optics - The structure containing optical properties. -! (in) CS - The control structure returned by a previous call to -! call_tracer_register. -! (in) evap_CFL_limit - Limits how much water can be fluxed out of the top layer -! Stored previously in diabatic CS. -! (in) minimum_forcing_depth - The smallest depth over which fluxes can be applied -! Stored previously in diabatic CS. -! (in) debug - Calculates checksums + !! which fluxes can be applied [H ~> m or kg m-2] if (.not. associated(CS)) call MOM_error(FATAL, "call_tracer_column_fns: "// & "Module must be initialized via call_tracer_register before it is used.") @@ -598,8 +556,7 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni num_stocks, stock_index, got_min_max, global_min, global_max, & xgmin, ygmin, zgmin, xgmax, ygmax, zgmax) real, dimension(NIMEM_,NJMEM_,NKMEM_), & - intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - !! (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stock_values !< The integrated amounts of a tracer !! on the current PE, usually in kg x concentration. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -626,22 +583,8 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni real, dimension(:), optional, intent(out) :: xgmax !< The x-position of the global maximum real, dimension(:), optional, intent(out) :: ygmax !< The y-position of the global maximum real, dimension(:), optional, intent(out) :: zgmax !< The z-position of the global maximum -! This subroutine calls all registered tracer packages to enable them to -! add to the surface state returned to the coupler. These routines are optional. -! Arguments: h - Layer thickness, in m (Boussinesq) or kg m-2 (non-Boussinesq). -! (out) stock_values - The integrated amounts of a tracer on the current -! PE, usually in kg x concentration. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! call_tracer_register. -! (out,opt) stock_names - Diagnostic names to use for each stock. -! (out,opt) stock_units - Units to use in the metadata for each stock. -! (out,opt) num_stocks - The number of tracer stocks being returned. -! (in,opt) stock_index - The integer stock index from stocks_constans_mod of -! the stock to be returned. If this is present and -! greater than 0, only a single stock can be returned. + ! Local variables character(len=200), dimension(MAX_FIELDS_) :: names, units character(len=200) :: set_pkg_name real, dimension(MAX_FIELDS_) :: values diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 4855ff68cc..bc212617a0 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -561,11 +561,11 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & ! These are 1-D arrays of pointers to 2-d arrays to minimize memory usage. type(p2d), dimension(SZJ_(G)) :: & deep_wt_Lu, deep_wt_Ru, & ! The relative weighting of the deeper of a pair [nondim]. - hP_Lu, hP_Ru ! The total thickness on each side for each pair, in m or kg m-2. + hP_Lu, hP_Ru ! The total thickness on each side for each pair [H ~> m or kg m-2]. type(p2d), dimension(SZJB_(G)) :: & deep_wt_Lv, deep_wt_Rv, & ! The relative weighting of the deeper of a pair [nondim]. - hP_Lv, hP_Rv ! The total thickness on each side for each pair, in m or kg m-2. + hP_Lv, hP_Rv ! The total thickness on each side for each pair [H ~> m or kg m-2]. type(p2di), dimension(SZJ_(G)) :: & k0b_Lu, k0a_Lu, & ! The original k-indices of the layers that participate @@ -580,7 +580,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & real, dimension(SZI_(G), SZK_(G), SZJ_(G)) :: & rho_srt, & ! The density of each layer of the sorted columns [kg m-3]. - h_srt ! The thickness of each layer of the sorted columns, in m or kg m-2. + h_srt ! The thickness of each layer of the sorted columns [H ~> m or kg m-2]. integer, dimension(SZI_(G), SZK_(G), SZJ_(G)) :: & k0_srt ! The original k-index that each layer of the sorted column ! corresponds to. @@ -589,7 +589,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & h_demand_L, & ! The thickness in the left (_L) or right (_R) column that h_demand_R, & ! is demanded to match the thickness in the counterpart [H ~> m or kg m-2]. h_used_L, & ! The summed thickness from the left or right columns that - h_used_R, & ! have actually been used, in m or kg m-2 (H). + h_used_R, & ! have actually been used [H ~> m or kg m-2]. h_supply_frac_L, & ! The fraction of the demanded thickness that can h_supply_frac_R ! actually be supplied from a layer. integer, dimension(SZK_(G)) :: & @@ -609,7 +609,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & integer, dimension(SZI_(G), SZJB_(G)) :: & nPv ! The number of epipycnal pairings at each v-point. real :: h_exclude ! A thickness that layers must attain to be considered - ! for inclusion in mixing, in m. + ! for inclusion in mixing [H ~> m or kg m-2]. real :: Idt ! The inverse of the time step [s-1]. real :: I_maxitt ! The inverse of the maximum number of iterations. real :: rho_pair, rho_a, rho_b ! Temporary densities [kg m-3]. @@ -622,9 +622,9 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & real :: Tr_flux ! The tracer flux from left to right in a pair, in conc m3. real :: Tr_adj_vert ! A downward vertical adjustment to Tr_flux between the ! two cells that make up one side of the pairing, in conc m3. - real :: h_L, h_R ! Thicknesses to the left and right, in m or kg m-2 (H). + real :: h_L, h_R ! Thicknesses to the left and right [H ~> m or kg m-2]. real :: wt_a, wt_b ! Fractional weights of layers above and below [nondim]. - real :: vol ! A cell volume or mass, in m3 or kg (H m2). + real :: vol ! A cell volume or mass [H m2 ~> m3 or kg]. logical, dimension(SZK_(G)) :: & left_set, & ! If true, the left or right point determines the density of right_set ! of the trio. If densities are exactly equal, both are true. diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 77a3ea591d..43d89eb223 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -30,7 +30,7 @@ module BFB_surface_forcing real :: Rho0 !< The density used in the Boussinesq !! approximation [kg m-3]. real :: G_Earth !< The gravitational acceleration [m s-2] - real :: Flux_const !< The restoring rate at the surface, in m s-1. + real :: Flux_const !< The restoring rate at the surface [m s-1]. real :: gust_const !< A constant unresolved background gustiness !! that contributes to ustar [Pa]. real :: SST_s !< SST at the southern edge of the linear diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index e20fe5ccee..956f8b3287 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -73,9 +73,9 @@ module MOM_wave_interface real, allocatable, dimension(:), public :: & Freq_Cen !< Frequency bands for read/coupled (1/s) real, allocatable, dimension(:), public :: & - PrescribedSurfStkX !< Surface Stokes drift if prescribed (m/s) + PrescribedSurfStkX !< Surface Stokes drift if prescribed [m s-1] real, allocatable, dimension(:), public :: & - PrescribedSurfStkY !< Surface Stokes drift if prescribed (m/s) + PrescribedSurfStkY !< Surface Stokes drift if prescribed [m s-1] real, allocatable, dimension(:,:,:), public :: & Us_x !< 3d Stokes drift profile (zonal, m/s) !! Horizontal -> U points @@ -875,9 +875,9 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & real, dimension(SZK_(GV)), optional, & intent(in) :: H !< Grid layer thickness [H ~> m or kg m-2] real, dimension(SZK_(GV)), optional, & - intent(in) :: U_H !< Zonal velocity at H point (m/s) + intent(in) :: U_H !< Zonal velocity at H point [m s-1] real, dimension(SZK_(GV)), optional, & - intent(in) :: V_H !< Meridional velocity at H point (m/s) + intent(in) :: V_H !< Meridional velocity at H point [m s-1] type(Wave_parameters_CS), & pointer :: Waves !< Surface wave control structure. @@ -966,7 +966,7 @@ end subroutine get_Langmuir_Number !! !! Original description: !! - This function returns the enhancement factor, given the 10-meter -!! wind (m/s), friction velocity (m/s) and the boundary layer depth (m). +!! wind [m s-1], friction velocity [m s-1] and the boundary layer depth (m). !! !! Update (Jan/25): !! - Converted from function to subroutine, now returns Langmuir number. @@ -983,7 +983,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) real, intent(in) :: hbl !< boundary layer depth [Z ~> m]. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(out) :: UStokes_SL !< Surface layer averaged Stokes drift (m/s) + real, intent(out) :: UStokes_SL !< Surface layer averaged Stokes drift [m s-1] real, intent(out) :: LA !< Langmuir number ! Local variables ! parameters @@ -1062,12 +1062,12 @@ subroutine Get_SL_Average_Prof( GV, AvgDepth, H, Profile, Average ) intent(in) :: GV !< Ocean vertical grid structure real, intent(in) :: AvgDepth !< Depth to average over [Z ~> m]. real, dimension(SZK_(GV)), & - intent(in) :: H !< Grid thickness (H) + intent(in) :: H !< Grid thickness [H ~> m or kg m-2] real, dimension(SZK_(GV)), & - intent(in) :: Profile !< Profile of quantity to be averaged - !! (used here for Stokes drift, m/s) - real, intent(out) :: Average !< Output quantity averaged over depth AvgDepth - !! (used here for Stokes drift, m/s) + intent(in) :: Profile !< Profile of quantity to be averaged [arbitrary] + !! (used here for Stokes drift) + real, intent(out) :: Average !< Output quantity averaged over depth AvgDepth [arbitrary] + !! (used here for Stokes drift) !Local variables real :: top, midpoint, bottom ! Depths [Z ~> m]. real :: Sum @@ -1104,8 +1104,8 @@ subroutine Get_SL_Average_Band( GV, AvgDepth, NB, WaveNumbers, SurfStokes, Avera real, dimension(NB), & intent(in) :: WaveNumbers !< Wavenumber corresponding to each band (1/Z) real, dimension(NB), & - intent(in) :: SurfStokes !< Surface Stokes drift for each band (m/s) - real, intent(out) :: Average !< Output average Stokes drift over depth AvgDepth (m/s) + intent(in) :: SurfStokes !< Surface Stokes drift for each band [m s-1] + real, intent(out) :: Average !< Output average Stokes drift over depth AvgDepth [m s-1] ! Local variables integer :: bb @@ -1133,7 +1133,7 @@ subroutine DHH85_mid(GV, US, zpt, UStokes) type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: ZPT !< Depth to get Stokes drift [Z ~> m]. !### THIS IS NOT USED YET. - real, intent(out) :: UStokes !< Stokes drift (m/s) + real, intent(out) :: UStokes !< Stokes drift [m s-1] ! real :: ann, Bnn, Snn, Cnn, Dnn real :: omega_peak, omega, u10, WA, domega @@ -1192,9 +1192,9 @@ subroutine StokesMixing(G, GV, DT, h, u, v, Waves ) real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: u !< Velocity i-component (m/s) + intent(inout) :: u !< Velocity i-component [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: v !< Velocity j-component (m/s) + intent(inout) :: v !< Velocity j-component [m s-1] type(Wave_parameters_CS), & pointer :: Waves !< Surface wave related control structure. ! Local variables @@ -1295,8 +1295,8 @@ end subroutine CoriolisStokes !! wind speed for wind-wave relationships. Should be a fine way to estimate !! the neutral wind-speed as written here. subroutine ust_2_u10_coare3p5(USTair, U10, GV, US) - real, intent(in) :: USTair !< Wind friction velocity (m/s) - real, intent(out) :: U10 !< 10-m neutral wind speed (m/s) + real, intent(in) :: USTair !< Wind friction velocity [m s-1] + real, intent(out) :: U10 !< 10-m neutral wind speed [m s-1] type(verticalGrid_type), intent(in) :: GV !< vertical grid type type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 7970538c0c..ef9ebdf46e 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -348,8 +348,8 @@ end subroutine Phillips_initialize_topography !! The one argument passed to initialize, Time, is set to the !! current time of the simulation. The fields which are initialized !! here are: -!! u - Zonal velocity in m s-1. -!! v - Meridional velocity in m s-1. +!! u - Zonal velocity [m s-1]. +!! v - Meridional velocity [m s-1]. !! h - Layer thickness in m. (Must be positive.) !! D - Basin depth in m. (Must be positive.) !! f - The Coriolis parameter [s-1]. diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index c0616b1497..88500eaacd 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -36,12 +36,12 @@ module SCM_CVMix_tests logical :: UseHeatFlux !< True to use heat flux logical :: UseEvaporation !< True to use evaporation logical :: UseDiurnalSW !< True to use diurnal sw radiation - real :: tau_x !< (Constant) Wind stress, X (Pa) - real :: tau_y !< (Constant) Wind stress, Y (Pa) - real :: surf_HF !< (Constant) Heat flux (m K s^{-1}) - real :: surf_evap !< (Constant) Evaporation rate (m/s) - real :: Max_sw !< maximum of diurnal sw radiation (m K s^{-1}) - real,public :: Rho0 !< reference density copied for easy passing + real :: tau_x !< (Constant) Wind stress, X [Pa] + real :: tau_y !< (Constant) Wind stress, Y [Pa] + real :: surf_HF !< (Constant) Heat flux [m degC s-1] + real :: surf_evap !< (Constant) Evaporation rate [m s-1] + real :: Max_sw !< maximum of diurnal sw radiation [m degC s-1] + real,public :: Rho0 !< reference density copied for easy passing [kg m-3] end type ! This include declares and sets the variable "version". @@ -53,8 +53,8 @@ module SCM_CVMix_tests !> Initializes temperature and salinity for the SCM CVMix test example subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read_params) - real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(out) :: T !< Potential temperature (degC) - real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(out) :: S !< Salinity (psu) + real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(out) :: T !< Potential temperature [degC] + real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(out) :: S !< Salinity [psu] real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -225,10 +225,10 @@ end subroutine SCM_CVMix_tests_wind_forcing subroutine SCM_CVMix_tests_buoyancy_forcing(state, fluxes, day, G, CS) - type(surface), intent(in) :: state !< Surface state structure - type(forcing), intent(inout) :: fluxes !< Surface fluxes structure - type(time_type), intent(in) :: day !< Time in days (seconds?) - type(ocean_grid_type), intent(inout) :: G !< Grid structure + type(surface), intent(in) :: state !< Surface state structure + type(forcing), intent(inout) :: fluxes !< Surface fluxes structure + type(time_type), intent(in) :: day !< Time in days (seconds?) + type(ocean_grid_type), intent(inout) :: G !< Grid structure type(SCM_CVMix_tests_CS), pointer :: CS !< Container for SCM parameters ! Local variables diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index 3fdba94a3f..8e51461c0e 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -29,7 +29,7 @@ module dumbbell_surface_forcing real :: Rho0 !< The density used in the Boussinesq !! approximation [kg m-3]. real :: G_Earth !< The gravitational acceleration [m s-2] - real :: Flux_const !< The restoring rate at the surface, in m s-1. + real :: Flux_const !< The restoring rate at the surface [m s-1]. real :: gust_const !< A constant unresolved background gustiness !! that contributes to ustar [Pa]. real :: slp_amplitude !< The amplitude of pressure loading (in Pa) applied diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 5272d60897..7e6fc1f07e 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -242,8 +242,8 @@ end subroutine write_user_log !! The one argument passed to initialize, Time, is set to the !! current time of the simulation. The fields which are initialized !! here are: -!! - u - Zonal velocity in m s-1. -!! - v - Meridional velocity in m s-1. +!! - u - Zonal velocity [m s-1]. +!! - v - Meridional velocity [m s-1]. !! - h - Layer thickness [H ~> m or kg m-2]. (Must be positive.) !! - G%bathyT - Basin depth [Z ~> m]. (Must be positive.) !! - G%CoriolisBu - The Coriolis parameter [s-1]. From 17c460821643a7b4f3a2fd64b6d6c04a83ef9c2e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 21 Dec 2018 04:04:16 -0500 Subject: [PATCH 0969/1072] Document frequency units with square brackets Changed comments to use the square bracket notation to document the units of about 50 frequency, inverse timescale, or potential vorticity variables. Only comments have been changed and all answers are bitwise identical. --- config_src/mct_driver/ocn_cap_methods.F90 | 2 +- src/core/MOM_barotropic.F90 | 14 +++++++------- src/core/MOM_continuity_PPM.F90 | 12 ++++++------ src/core/MOM_grid.F90 | 6 +++--- src/core/MOM_open_boundary.F90 | 6 +++--- src/diagnostics/MOM_diagnostics.F90 | 2 +- src/framework/MOM_dyn_horgrid.F90 | 6 +++--- .../MOM_shared_initialization.F90 | 2 +- src/parameterizations/lateral/MOM_MEKE.F90 | 2 +- src/parameterizations/lateral/MOM_hor_visc.F90 | 18 +++++++++--------- .../lateral/MOM_internal_tides.F90 | 4 ++-- .../lateral/MOM_lateral_mixing_coeffs.F90 | 4 ++-- .../lateral/MOM_mixed_layer_restrat.F90 | 8 ++++---- .../lateral/MOM_thickness_diffuse.F90 | 2 +- .../vertical/MOM_ALE_sponge.F90 | 2 +- .../vertical/MOM_CVMix_KPP.F90 | 18 +++++++++--------- .../vertical/MOM_bulk_mixed_layer.F90 | 6 +++--- .../vertical/MOM_diabatic_driver.F90 | 8 ++++---- .../vertical/MOM_internal_tide_input.F90 | 2 +- .../vertical/MOM_kappa_shear.F90 | 4 ++-- .../vertical/MOM_set_diffusivity.F90 | 4 ++-- src/parameterizations/vertical/MOM_sponge.F90 | 6 +++--- .../vertical/MOM_tidal_mixing.F90 | 4 ++-- src/tracer/MOM_tracer_advect.F90 | 2 +- src/user/BFB_initialization.F90 | 4 ++-- src/user/DOME_initialization.F90 | 2 +- src/user/ISOMIP_initialization.F90 | 2 +- src/user/Kelvin_initialization.F90 | 4 ++-- src/user/MOM_wave_interface.F90 | 2 +- 29 files changed, 79 insertions(+), 79 deletions(-) diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 95fd084bdc..a04e3af4aa 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -154,7 +154,7 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) real, dimension(grid%isd:grid%ied,grid%jsd:grid%jed) :: ssh !< Local copy of sea_lev with updated halo integer :: i, j, n, ig, jg !< Grid indices real :: slp_L, slp_R, slp_C, slope, u_min, u_max - real :: I_time_int !< The inverse of coupling time interval in s-1. + real :: I_time_int !< The inverse of coupling time interval [s-1]. !----------------------------------------------------------------------- diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 9c45e0854c..05dad87285 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -475,14 +475,14 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! of H (m or kg m-2, the same as eta and h). ! These are always allocated with symmetric memory and wide halos. - real :: q(SZIBW_(CS),SZJBW_(CS)) ! A pseudo potential vorticity in s-1 m-1. + real :: q(SZIBW_(CS),SZJBW_(CS)) ! A pseudo potential vorticity [s-1 Z-1 ~> s-1 m-1]. real, dimension(SZIBW_(CS),SZJW_(CS)) :: & ubt, & ! The zonal barotropic velocity [m s-1]. bt_rem_u, & ! The fraction of the barotropic zonal velocity that remains ! after a time step, the remainder being lost to bottom drag. ! bt_rem_u is a nondimensional number between 0 and 1. BT_force_u, & ! The vertical average of all of the u-accelerations that are - ! not explicitly included in the barotropic equation, m s-2. + ! not explicitly included in the barotropic equation [m s-2]. u_accel_bt, & ! The difference between the zonal acceleration from the ! barotropic calculation and BT_force_u [m s-2]. uhbt, & ! The zonal barotropic thickness fluxes [H m2 s-1 ~> m3 s-1 or kg s-1]. @@ -503,7 +503,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, Cor_ref_u, & ! The zonal barotropic Coriolis acceleration due ! to the reference velocities [m s-2]. PFu, & ! The zonal pressure force acceleration [m s-2]. - Rayleigh_u, & ! A Rayleigh drag timescale operating at u-points, in s-1. + Rayleigh_u, & ! A Rayleigh drag timescale operating at u-points [s-1]. PFu_bt_sum, & ! The summed zonal barotropic pressure gradient force [m s-2]. Coru_bt_sum, & ! The summed zonal barotropic Coriolis acceleration [m s-2]. DCor_u, & ! A simply averaged depth at u points [Z ~> m]. @@ -515,7 +515,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! remains after a time step, the rest being lost to bottom ! drag. bt_rem_v is a nondimensional number between 0 and 1. BT_force_v, & ! The vertical average of all of the v-accelerations that are - ! not explicitly included in the barotropic equation, m s-2. + ! not explicitly included in the barotropic equation [m s-2]. v_accel_bt, & ! The difference between the meridional acceleration from the ! barotropic calculation and BT_force_v [m s-2]. vhbt, & ! The meridional barotropic thickness fluxes [H m2 s-1 ~> m3 s-1 or kg s-1]. @@ -532,7 +532,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, Cor_ref_v, & ! The meridional barotropic Coriolis acceleration due ! to the reference velocities [m s-2]. PFv, & ! The meridional pressure force acceleration [m s-2]. - Rayleigh_v, & ! A Rayleigh drag timescale operating at v-points, in s-1. + Rayleigh_v, & ! A Rayleigh drag timescale operating at v-points [s-1]. PFv_bt_sum, & ! The summed meridional barotropic pressure gradient force, ! [m s-2]. Corv_bt_sum, & ! The summed meridional barotropic Coriolis acceleration, @@ -587,7 +587,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real :: be_proj ! The fractional amount by which velocities are projected ! when project_velocity is true. For now be_proj is set ! to equal bebt, as they have similar roles and meanings. - real :: Idt ! The inverse of dt, in s-1. + real :: Idt ! The inverse of dt [s-1]. real :: det_de ! The partial derivative due to self-attraction and loading ! of the reference geopotential with the sea surface height. ! This is typically ~0.09 or less. @@ -3654,7 +3654,7 @@ subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) real :: d_eta ! The difference between estimates of the total ! thicknesses [H ~> m or kg m-2]. real :: limit_dt ! The fractional mass-source limit divided by the - ! thermodynamic time step, in s-1. + ! thermodynamic time step [s-1]. integer :: is, ie, js, je, nz, i, j, k real, parameter :: frac_cor = 0.25 real, parameter :: slow_rate = 0.125 diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 9cc9198ef2..0dfcfbdc12 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -282,8 +282,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & real :: FA_u ! A sum of zonal face areas [H m ~> m2 or kg m-1]. real :: I_vrm ! 1.0 / visc_rem_max, nondim. real :: CFL_dt ! The maximum CFL ratio of the adjusted velocities divided by - ! the time step, in s-1. - real :: I_dt ! 1.0 / dt, in s-1. + ! the time step [s-1]. + real :: I_dt ! 1.0 / dt [s-1]. real :: du_lim ! The velocity change that give a relative CFL of 1 [m s-1]. real :: dx_E, dx_W ! Effective x-grid spacings to the east and west, in m. integer :: i, j, k, ish, ieh, jsh, jeh, n, nz @@ -946,7 +946,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, ! of visc_rem from leading to large CFL numbers. real :: CFL_min ! A minimal increment in the CFL to try to ensure that the ! flow is truly upwind, ND. - real :: Idt ! The inverse of the time step, in s-1. + real :: Idt ! The inverse of the time step [s-1]. logical :: domore integer :: i, k, nz @@ -1100,8 +1100,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & visc_rem ! A 2-D copy of visc_rem_v or an array of 1's. real :: I_vrm ! 1.0 / visc_rem_max, nondim. real :: CFL_dt ! The maximum CFL ratio of the adjusted velocities divided by - ! the time step, in s-1. - real :: I_dt ! 1.0 / dt, in s-1. + ! the time step [s-1]. + real :: I_dt ! 1.0 / dt [s-1]. real :: dv_lim ! The velocity change that give a relative CFL of 1 [m s-1]. real :: dy_N, dy_S ! Effective y-grid spacings to the north and south [m]. integer :: i, j, k, ish, ieh, jsh, jeh, n, nz @@ -1765,7 +1765,7 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, ! of visc_rem from leading to large CFL numbers. real :: CFL_min ! A minimal increment in the CFL to try to ensure that the ! flow is truly upwind, ND. - real :: Idt ! The inverse of the time step, in s-1. + real :: Idt ! The inverse of the time step [s-1]. logical :: domore integer :: i, k, nz diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 2db50716e9..8b9f4334b6 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -148,10 +148,10 @@ module MOM_grid Dblock_v, & !< Topographic depths at v-points at which the flow is blocked, in depth units. Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv, in depth units. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - CoriolisBu !< The Coriolis parameter at corner points, in s-1. + CoriolisBu !< The Coriolis parameter at corner points [s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points, in s-1 m-1. - df_dy !< Derivative d/dy f (Coriolis parameter) at h-points, in s-1 m-1. + df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [s-1 m-1]. + df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [s-1 m-1]. real :: g_Earth !< The gravitational acceleration [m s-2]. ! These variables are global sums that are useful for 1-d diagnostics diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index d101f9a91e..e5eeaf0660 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -156,9 +156,9 @@ module MOM_open_boundary !! the OB segment [m s-1]. real, pointer, dimension(:,:) :: eta=>NULL() !< The sea-surface elevation along the segment (m). real, pointer, dimension(:,:,:) :: grad_normal=>NULL() !< The gradient of the normal flow along the - !! segment (s-1) + !! segment [s-1] real, pointer, dimension(:,:,:) :: grad_tan=>NULL() !< The gradient of the tangential flow along the - !! segment (s-1) + !! segment [s-1] real, pointer, dimension(:,:,:) :: grad_gradient=>NULL() !< The gradient of the gradient of tangential flow along the !! segment (m-1 s-1) real, pointer, dimension(:,:,:) :: rx_normal=>NULL() !< The rx_old_u value for radiation coeff @@ -172,7 +172,7 @@ module MOM_open_boundary real, pointer, dimension(:,:,:) :: nudged_tangential_vel=>NULL() !< The layer velocity tangential to the OB segment !! that values should be nudged towards [m s-1]. real, pointer, dimension(:,:,:) :: nudged_tangential_grad=>NULL() !< The layer dvdx or dudy towards which nudging - !! can occur (s-1). + !! can occur [s-1]. type(segment_tracer_registry_type), pointer :: tr_Reg=> NULL()!< A pointer to the tracer registry for the segment. type(hor_index_type) :: HI !< Horizontal index ranges real :: Tr_InvLscale3_out !< An effective inverse length scale cubed (m-3) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 1bc72c5ba4..2ec42b4da9 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1188,7 +1188,7 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv real, dimension(SZI_(G),SZJ_(G)) :: work_2d ! A 2-d work array real, dimension(SZI_(G),SZJ_(G)) :: & zos ! dynamic sea lev (zero area mean) from inverse-barometer adjusted ssh (meter) - real :: I_time_int ! The inverse of the time interval in s-1. + real :: I_time_int ! The inverse of the time interval [s-1]. real :: zos_area_mean, volo, ssh_ga integer :: i, j, is, ie, js, je diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 8927be50d2..7b4f2e87ca 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -148,10 +148,10 @@ module MOM_dyn_horgrid Dblock_v, & !< Topographic depths at v-points at which the flow is blocked [Z ~> m]. Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv [Z ~> m]. real, allocatable, dimension(:,:) :: & - CoriolisBu !< The Coriolis parameter at corner points, in s-1. + CoriolisBu !< The Coriolis parameter at corner points [s-1]. real, allocatable, dimension(:,:) :: & - df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points, in s-1 m-1. - df_dy !< Derivative d/dy f (Coriolis parameter) at h-points, in s-1 m-1. + df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [s-1 m-1]. + df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [s-1 m-1]. ! These variables are global sums that are useful for 1-d diagnostics real :: areaT_global !< Global sum of h-cell area in m2 diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index dbbf11f61a..906939e76b 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -56,7 +56,7 @@ end subroutine MOM_shared_init_init !> MOM_initialize_rotation makes the appropriate call to set up the Coriolis parameter. subroutine MOM_initialize_rotation(f, G, PF, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type - real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent(out) :: f !< The Coriolis parameter in s-1 + real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent(out) :: f !< The Coriolis parameter [s-1] type(param_file_type), intent(in) :: PF !< Parameter file structure type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 1f0a3fa73d..adf523bdfe 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -33,7 +33,7 @@ module MOM_MEKE ! Parameters real :: MEKE_FrCoeff !< Efficiency of conversion of ME into MEKE (non-dim) real :: MEKE_GMcoeff !< Efficiency of conversion of PE into MEKE (non-dim) - real :: MEKE_damping !< Local depth-independent MEKE dissipation rate in s-1. + real :: MEKE_damping !< Local depth-independent MEKE dissipation rate [s-1]. real :: MEKE_Cd_scale !< The ratio of the bottom eddy velocity to the column mean !! eddy velocity, i.e. sqrt(2*MEKE). This should be less than 1 !! to account for the surface intensification of MEKE. diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index ef1cf16c7b..ce8dbbf773 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -213,7 +213,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, FrictWorkIntz ! depth integrated energy dissipated by lateral friction (W/m2) real, dimension(SZIB_(G),SZJB_(G)) :: & - dvdx, dudy, & ! components in the shearing strain (s-1) + dvdx, dudy, & ! components in the shearing strain [s-1] sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) (1/sec) including metric terms str_xy, & ! str_xy is the cross term in the stress tensor (H m2 s-2) bhstr_xy, & ! A copy of str_xy that only contains the biharmonic contribution (H m2 s-2) @@ -245,8 +245,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, real :: mod_Leith ! nondimensional coefficient for divergence part of modified Leith ! viscosity. Here set equal to nondimensional Laplacian Leith constant. ! This is set equal to zero if modified Leith is not used. - real :: Shear_mag ! magnitude of the shear (1/s) - real :: Vort_mag ! magnitude of the vorticity (1/s) + real :: Shear_mag ! magnitude of the shear [s-1] + real :: Vort_mag ! magnitude of the vorticity [s-1] real :: h2uq, h2vq ! temporary variables [H2 ~> m2 or kg2 m-4]. real :: hu, hv ! Thicknesses interpolated by arithmetic means to corner ! points; these are first interpolated to u or v velocity @@ -263,8 +263,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, real :: Kh_scale ! A factor between 0 and 1 by which the horizontal ! Laplacian viscosity is rescaled real :: RoScl ! The scaling function for MEKE source term - real :: FatH ! abs(f) at h-point for MEKE source term (s-1) - real :: local_strain ! Local variable for interpolating computed strain rates (s-1). + real :: FatH ! abs(f) at h-point for MEKE source term [s-1] + real :: local_strain ! Local variable for interpolating computed strain rates [s-1]. logical :: rescale_Kh, legacy_bound logical :: find_FrictWork @@ -969,12 +969,12 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) real :: grid_sp_h3 ! Harmonic mean of the squares of the grid^(3/2) real :: grid_sp_q2 ! spacings at h and q points (m2) real :: grid_sp_q3 ! spacings at h and q points^(3/2) (m3) - real :: Kh_Limit ! A coefficient (1/s) used, along with the + real :: Kh_Limit ! A coefficient [s-1] used, along with the ! grid spacing, to limit Laplacian viscosity. real :: fmax ! maximum absolute value of f at the four - ! vorticity points around a thickness point (1/s) + ! vorticity points around a thickness point [s-1] real :: BoundCorConst ! constant (s2/m2) - real :: Ah_Limit ! coefficient (1/s) used, along with the + real :: Ah_Limit ! coefficient [s-1] used, along with the ! grid spacing, to limit biharmonic viscosity real :: Kh ! Lapacian horizontal viscosity (m2/s) real :: Ah ! biharmonic horizontal viscosity (m4/s) @@ -985,7 +985,7 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) real :: Leith_Lap_const ! nondimensional Laplacian Leith constant real :: Leith_bi_const ! nondimensional biharmonic Leith constant real :: dt ! dynamics time step (sec) - real :: Idt ! inverse of dt (1/s) + real :: Idt ! inverse of dt [s-1] real :: denom ! work variable; the denominator of a fraction real :: maxvel ! largest permitted velocity components [m s-1] real :: bound_Cor_vel ! grid-scale velocity variations at which value diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index c5499debf9..f4b260469c 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -432,7 +432,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Dissipate energy if Fr>1; done here with an arbitrary time scale if (Fr2_max > 1.0) then En_initial = sum(CS%En(i,j,:,fr,m)) ! for debugging - ! Calculate effective decay rate (s-1) if breaking occurs over a time step + ! Calculate effective decay rate [s-1] if breaking occurs over a time step loss_rate = (1/Fr2_max - 1.0)/dt do a=1,CS%nAngle ! Determine effective dissipation rate (Wm-2) @@ -759,7 +759,7 @@ subroutine refract(En, cn, freq, dt, G, NAngle, use_PPMang) real :: f2 ! The squared Coriolis parameter [s-2]. real :: favg ! The average Coriolis parameter at a point [s-1]. real :: df2_dy, df2_dx ! The x- and y- gradients of the squared Coriolis parameter, in s-2 m-1. - real :: df_dy, df_dx ! The x- and y- gradients of the Coriolis parameter, in s-1 m-1. + real :: df_dy, df_dx ! The x- and y- gradients of the Coriolis parameter [s-1 m-1]. real :: dlnCn_dx ! The x-gradient of the wave speed divided by itself in m-1. real :: dlnCn_dy ! The y-gradient of the wave speed divided by itself in m-1. real :: Angle_size, dt_Angle_size, angle diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 81b3da296b..121064062e 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -433,7 +433,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) ! Local variables real :: Khth_Loc ! Locally calculated thickness mixing coefficient (m2/s) real :: S2 ! Interface slope squared (non-dim) - real :: N2 ! Brunt-Vaisala frequency (1/s) + real :: N2 ! Brunt-Vaisala frequency [s-1] real :: Hup, Hdn ! Thickness from above, below [H ~> m or kg m-2] real :: H_geom ! The geometric mean of Hup*Hdn [H ~> m or kg m-2]. integer :: is, ie, js, je, nz @@ -590,7 +590,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: S2 ! Interface slope squared (non-dim) - real :: N2 ! Brunt-Vaisala frequency (1/s) + real :: N2 ! Brunt-Vaisala frequency [s-1] real :: Hup, Hdn ! Thickness from above, below [H ~> m or kg m-2] real :: H_geom ! The geometric mean of Hup*Hdn [H ~> m or kg m-2]. real :: Z_to_L ! A conversion factor between from units for e to the diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 7512a0d00c..722c755fa4 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -151,9 +151,9 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real :: p0(SZI_(G)) ! A pressure of 0 (Pa) real :: h_vel ! htot interpolated onto velocity points [Z ~> m] (not H). - real :: absf ! absolute value of f, interpolated to velocity points (s-1) + real :: absf ! absolute value of f, interpolated to velocity points [s-1] real :: u_star ! surface friction velocity, interpolated to velocity points [Z s-1 ~> m s-1]. - real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer (s-1) + real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [s-1] real :: timescale ! mixing growth timescale (sec) real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected [H ~> m or kg m-2] real :: dz_neglect ! A tiny thickness that is usually lost in roundoff so can be neglected [Z ~> m] @@ -573,9 +573,9 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) real :: p0(SZI_(G)) ! A pressure of 0 (Pa) real :: h_vel ! htot interpolated onto velocity points [Z ~> m]. (The units are not H.) - real :: absf ! absolute value of f, interpolated to velocity points (s-1) + real :: absf ! absolute value of f, interpolated to velocity points [s-1] real :: u_star ! surface friction velocity, interpolated to velocity points [Z s-1 ~> m s-1]. - real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer (s-1) + real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [s-1] real :: timescale ! mixing growth timescale (sec) real :: h_neglect ! tiny thickness usually lost in roundoff and can be neglected [H ~> m or kg m-2] real :: dz_neglect ! tiny thickness that usually lost in roundoff and can be neglected [Z ~> m] diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 37d3394328..073fd1d099 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -464,7 +464,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: Work_u(SZIB_(G), SZJ_(G)) ! The work being done by the thickness real :: Work_v(SZI_(G), SZJB_(G)) ! diffusion integrated over a cell, in W. real :: Work_h ! The work averaged over an h-cell in W m-2. - real :: I4dt ! 1 / 4 dt in s-1. + real :: I4dt ! 1 / 4 dt [s-1]. real :: drdiA, drdiB ! Along layer zonal- and meridional- potential density real :: drdjA, drdjB ! gradients in the layers above (A) and below(B) the ! interface times the grid spacing [kg m-3]. diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index c896da03f0..f90649c2c9 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -854,7 +854,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) real :: damp ! The timestep times the local damping coefficient. ND. real :: I1pdamp ! I1pdamp is 1/(1 + damp). Nondimensional. - real :: Idt ! 1.0/dt, in s-1. + real :: Idt ! 1.0/dt [s-1]. real :: m_to_Z ! A unit conversion factor from m to Z. real, allocatable, dimension(:) :: tmp_val2 ! data values on the original grid real, dimension(SZK_(G)) :: tmp_val1 ! data values remapped to model grid diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 0c309140bc..212a9390b9 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -152,7 +152,7 @@ module MOM_CVMix_KPP real, allocatable, dimension(:,:,:) :: BulkRi !< Bulk Richardson number for each layer (dimensionless) real, allocatable, dimension(:,:,:) :: sigma !< Sigma coordinate (dimensionless) real, allocatable, dimension(:,:,:) :: Ws !< Turbulent velocity scale for scalars [m s-1] - real, allocatable, dimension(:,:,:) :: N !< Brunt-Vaisala frequency (1/s) + real, allocatable, dimension(:,:,:) :: N !< Brunt-Vaisala frequency [s-1] real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency (1/s2) real, allocatable, dimension(:,:,:) :: Vt2 !< Unresolved squared turbulence velocity for bulk Ri (m2/s2) real, allocatable, dimension(:,:,:) :: Kt_KPP !< Temp diffusivity from KPP (m2/s) @@ -803,7 +803,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & ! CS%Vt2(i,j,:) = CVmix_kpp_compute_unresolved_shear( & ! cellHeight(1:G%ke), & ! Depth of cell center (m) ! ws_cntr=Ws_1d, & ! Turbulent velocity scale profile, at centers [m s-1] -! N_iface=CS%N(i,j,:), & ! Buoyancy frequency at interface (1/s) +! N_iface=CS%N(i,j,:), & ! Buoyancy frequency at interface [s-1] ! CVmix_kpp_params_user=CS%KPP_params ) ! KPP parameters endif @@ -1111,7 +1111,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF CS%Vt2(i,j,:) = CVmix_kpp_compute_unresolved_shear( & zt_cntr=cellHeight(1:G%ke), & ! Depth of cell center (m) ws_cntr=Ws_1d, & ! Turbulent velocity scale profile, at centers [m s-1] - N_iface=CS%N(i,j,:), & ! Buoyancy frequency at interface (1/s) + N_iface=CS%N(i,j,:), & ! Buoyancy frequency at interface [s-1] CVmix_kpp_params_user=CS%KPP_params ) ! KPP parameters !Modify CVMix VT2 @@ -1158,11 +1158,11 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! Calculate Bulk Richardson number from eq (21) of LMD94 BulkRi_1d = CVmix_kpp_compute_bulk_Richardson( & zt_cntr = cellHeight(1:G%ke), & ! Depth of cell center (m) - delta_buoy_cntr=GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) (1/s) + delta_buoy_cntr=GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) [s-1] delta_Vsqr_cntr=deltaU2, & ! Square of resolved velocity difference (m2/s2) Vt_sqr_cntr=CS%Vt2(i,j,:), & ws_cntr=Ws_1d, & ! Turbulent velocity scale profile [m s-1] - N_iface=CS%N(i,j,:)) ! Buoyancy frequency (1/s) + N_iface=CS%N(i,j,:)) ! Buoyancy frequency [s-1] surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit @@ -1176,7 +1176,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF zt_cntr=cellHeight, & ! (in) Height of cell centers (m) surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) - Coriolis=Coriolis, & ! (in) Coriolis parameter (1/s) + Coriolis=Coriolis, & ! (in) Coriolis parameter [s-1] CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters ! A hack to avoid KPP reaching the bottom. It was needed during development @@ -1237,10 +1237,10 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! BulkRi_1d = CVMix_kpp_compute_bulk_Richardson( & ! cellHeight(1:G%ke), & ! Depth of cell center (m) - ! GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) (1/s) + ! GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) [s-1] ! deltaU2, & ! Square of resolved velocity difference (m2/s2) ! ws_cntr=Ws_1d, & ! Turbulent velocity scale profile [m s-1] - ! N_iface=CS%N ) ! Buoyancy frequency (1/s) + ! N_iface=CS%N ) ! Buoyancy frequency [s-1] ! surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit ! ! h to Monin-Obukov (default is false, ie. not used) @@ -1253,7 +1253,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! zt_cntr=cellHeight, & ! (in) Height of cell centers (m) ! surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] ! surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) - ! Coriolis=Coriolis, & ! (in) Coriolis parameter (1/s) + ! Coriolis=Coriolis, & ! (in) Coriolis parameter [s-1] ! CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters ! if (CS%deepOBLoffset>0.) then diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index b060621ceb..ca3974be8d 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -303,8 +303,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C real :: Irho0 ! 1.0 / rho_0 real :: Inkml, Inkmlm1! 1.0 / REAL(nkml) and 1.0 / REAL(nkml-1) real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. - real :: Idt ! The inverse of the timestep in s-1. - real :: Idt_diag ! The inverse of the timestep used for diagnostics in s-1. + real :: Idt ! The inverse of the timestep [s-1]. + real :: Idt_diag ! The inverse of the timestep used for diagnostics [s-1]. real :: RmixConst real, dimension(SZI_(G)) :: & @@ -3143,7 +3143,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e real :: max_det_rem(SZI_(G)) ! Remaining permitted detrainment [H ~> m or kg m-2]. real :: detrain(SZI_(G)) ! The thickness of fluid to detrain ! from the mixed layer [H ~> m or kg m-2]. - real :: Idt ! The inverse of the timestep in s-1. + real :: Idt ! The inverse of the timestep [s-1]. real :: dT_dR, dS_dR, dRml, dR0_dRcv, dT_dS_wt2 real :: I_denom ! A work variable with units of psu2 m6 kg-2. real :: Sdown, Tdown diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 336bbc8a06..b791011880 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -380,7 +380,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real :: Ent_int ! The diffusive entrainment rate at an interface ! (H units = m for Bouss, kg/m^2 for non-Bouss). real :: dt_mix ! amount of time over which to apply mixing (seconds) - real :: Idt ! inverse time step (1/s) + real :: Idt ! inverse time step [s-1] type(p3d) :: z_ptrs(7) ! pointers to diagnostics to be interpolated to depth integer :: num_z_diags ! number of diagnostics to be interpolated to depth @@ -1263,7 +1263,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en real :: Ent_int ! The diffusive entrainment rate at an interface ! (H units = m for Bouss, kg/m^2 for non-Bouss). real :: dt_mix ! amount of time over which to apply mixing (seconds) - real :: Idt ! inverse time step (1/s) + real :: Idt ! inverse time step [s-1] type(p3d) :: z_ptrs(7) ! pointers to diagnostics to be interpolated to depth integer :: num_z_diags ! number of diagnostics to be interpolated to depth @@ -2503,7 +2503,7 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d real, dimension(SZI_(G),SZJ_(G)) :: work_2d - real :: Idt ! The inverse of the timestep, in s-1 + real :: Idt ! The inverse of the timestep [s-1] real :: ppt2mks = 0.001 ! Conversion factor from g/kg to kg/kg. integer :: i, j, k, is, ie, js, je, nz @@ -2593,7 +2593,7 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d real, dimension(SZI_(G),SZJ_(G)) :: work_2d - real :: Idt ! The inverse of the timestep, in s-1 + real :: Idt ! The inverse of the timestep [s-1] real :: ppt2mks = 0.001 ! Conversion factor from g/kg to kg/kg. integer :: i, j, k, is, ie, js, je, nz diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index f5142c27fc..ce34cfada0 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -54,7 +54,7 @@ module MOM_int_tide_input TKE_itidal_input, & !< The internal tide TKE input at the bottom of the ocean, in W m-2. h2, & !< The squared topographic roughness height [Z2 ~> m2]. tideamp, & !< The amplitude of the tidal velocities [m s-1]. - Nb !< The bottom stratification, in s-1. + Nb !< The bottom stratification [s-1]. end type int_tide_input_type contains diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 341af67534..d687f5cf57 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -764,7 +764,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! velocity, and density equations [Z s-1 ~> m s-1] or [Z ~> m] c1, & ! c1 is used in the tridiagonal (and similar) solvers. k_src, & ! The shear-dependent source term in the kappa equation [s-1]. - kappa_src, & ! The shear-dependent source term in the kappa equation in s-1. + kappa_src, & ! The shear-dependent source term in the kappa equation [s-1]. kappa_out, & ! The kappa that results from the kappa equation [Z2 s-1 ~> m2 s-1]. kappa_mid, & ! The average of the initial and predictor estimates of kappa [Z2 s-1 ~> m2 s-1]. tke_pred, & ! The value of TKE from a predictor step [m2 s-2]. @@ -1393,7 +1393,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & intent(out) :: kappa_src !< The source term for kappa [s-1]. real, dimension(nz+1), optional, & intent(out) :: local_src !< The sum of all local sources for kappa, - !! in s-1. + !! [s-1]. ! This subroutine calculates new, consistent estimates of TKE and kappa. ! Local variables diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 8222d04a2c..b318f6a923 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -98,7 +98,7 @@ module MOM_set_diffusivity real :: TKE_itide_max !< maximum internal tide conversion (W m-2) !! available to mix above the BBL - real :: omega !< Earth's rotation frequency (s-1) + real :: omega !< Earth's rotation frequency [s-1] logical :: ML_radiation !< allow a fraction of TKE available from wind work !! to penetrate below mixed layer base with a vertical !! decay scale determined by the minimum of @@ -1184,7 +1184,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & real :: dRl, dRbot ! temporaries holding density differences (kg/m3) real :: cdrag_sqrt ! square root of the drag coefficient (nondimensional) real :: ustar_h ! value of ustar at a thickness point [Z s-1 ~> m s-1]. - real :: absf ! average absolute Coriolis parameter around a thickness point (1/s) + real :: absf ! average absolute Coriolis parameter around a thickness point [s-1] real :: R0_g ! Rho0 / G_Earth (kg s2 Z-1 m-4) real :: I_rho0 ! 1 / RHO0 real :: delta_Kd ! increment to Kd from the bottom boundary layer mixing [Z2 s-1 ~> m2 s-1]. diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index 964942695f..758f15e2e2 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -88,7 +88,7 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & Iresttime_i_mean, int_height_i_mean) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: Iresttime !< The inverse of the restoring time, in s-1. + intent(in) :: Iresttime !< The inverse of the restoring time [s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & intent(in) :: int_height !< The interface heights to damp back toward [Z ~> m]. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters @@ -97,7 +97,7 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZJ_(G)), & optional, intent(in) :: Iresttime_i_mean !< The inverse of the restoring time for - !! the zonal mean properties, in s-1. + !! the zonal mean properties [s-1]. real, dimension(SZJ_(G),SZK_(G)+1), & optional, intent(in) :: int_height_i_mean !< The interface heights toward which to !! damp the zonal mean heights [Z ~> m]. @@ -376,7 +376,7 @@ subroutine apply_sponge(h, dt, G, GV, ea, eb, CS, Rcv_ml) real :: damp ! The timestep times the local damping coefficient [nondim]. real :: I1pdamp ! I1pdamp is 1/(1 + damp). [nondim] real :: damp_1pdamp ! damp_1pdamp is damp/(1 + damp). [nondim] - real :: Idt ! 1.0/dt, in s-1. + real :: Idt ! 1.0/dt [s-1]. integer :: c, m, nkmb, i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 8eb78abdfa..af2733136a 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -114,7 +114,7 @@ module MOM_tidal_mixing real :: Nbotref_Polzin !< Reference value for the buoyancy frequency at the !! ocean bottom used in Polzin formulation of the - !! vertical scale of decay of tidal dissipation (1/s) + !! vertical scale of decay of tidal dissipation [s-1] real :: Polzin_decay_scale_factor !< Scaling factor for the decay length scale !! of the tidal dissipation profile in Polzin (nondimensional) real :: Polzin_decay_scale_max_factor !< The decay length scale of tidal dissipation @@ -150,7 +150,7 @@ module MOM_tidal_mixing !! in W m-2 real, pointer, dimension(:,:) :: TKE_itidal => NULL() !< The internal Turbulent Kinetic Energy input divided !! by the bottom stratfication, in J m-2. - real, pointer, dimension(:,:) :: Nb => NULL() !< The near bottom buoyancy frequency, in s-1. + real, pointer, dimension(:,:) :: Nb => NULL() !< The near bottom buoyancy frequency [s-1]. real, pointer, dimension(:,:) :: mask_itidal => NULL() !< A mask of where internal tide energy is input real, pointer, dimension(:,:) :: h2 => NULL() !< Squared bottom depth variance, in m2. real, pointer, dimension(:,:) :: tideamp => NULL() !< RMS tidal amplitude [m s-1] diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 4d28375426..fab0990c4e 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -666,7 +666,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used logical, dimension(SZJB_(G),SZK_(G)), intent(inout) :: domore_v !< If true, there is more advection to be !! done in this v-row - real, intent(in) :: Idt !< The inverse of dt, in s-1 + real, intent(in) :: Idt !< The inverse of dt [s-1] integer, intent(in) :: ntr !< The number of tracers integer, intent(in) :: is !< The starting tracer i-index to work on integer, intent(in) :: ie !< The ending tracer i-index to work on diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 3b42e595dc..31223d5686 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -90,7 +90,7 @@ subroutine BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, para ! Local variables real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, in depth units [Z ~> m]. - real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate [s-1]. real :: H0(SZK_(G)) ! Resting layer thicknesses in depth units [Z ~> m]. real :: min_depth ! The minimum ocean depth in depth units [Z ~> m]. real :: damp, e_dense, damp_new, slat, wlon, lenlat, lenlon, nlat @@ -102,7 +102,7 @@ subroutine BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, para eta(:,:,:) = 0.0 ; Idamp(:,:) = 0.0 -! Here the inverse damping time, in s-1, is set. Set Idamp to 0 ! +! Here the inverse damping time [s-1], is set. Set Idamp to 0 ! ! wherever there is no sponge, and the subroutines that are called ! ! will automatically set up the sponges only where Idamp is positive! ! and mask2dT is 1. ! diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 1c97a9e780..cf492cf99e 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -172,7 +172,7 @@ subroutine DOME_initialize_sponges(G, GV, US, tv, PF, CSp) eta(:,:,:) = 0.0 ; temp(:,:,:) = 0.0 ; Idamp(:,:) = 0.0 -! Here the inverse damping time, in s-1, is set. Set Idamp to 0 ! +! Here the inverse damping time [s-1], is set. Set Idamp to 0 ! ! wherever there is no sponge, and the subroutines that are called ! ! will automatically set up the sponges only where Idamp is positive! ! and mask2dT is 1. ! diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 0883305aa7..bd2ad1f1d6 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -493,7 +493,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) if (associated(ACSp)) call MOM_error(FATAL, & "ISOMIP_initialize_sponges called with an associated ALE-sponge control structure.") - ! Here the inverse damping time, in s-1, is set. Set Idamp to 0 ! + ! Here the inverse damping time [s-1], is set. Set Idamp to 0 ! ! wherever there is no sponge, and the subroutines that are called ! ! will automatically set up the sponges only where Idamp is positive! ! and mask2dT is 1. diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 483ee043d5..85e11435dc 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -180,11 +180,11 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) ! The following variables are used to set up the transport in the Kelvin example. real :: time_sec, cff - real :: N0 ! Brunt-Vaisala frequency in s-1 + real :: N0 ! Brunt-Vaisala frequency [s-1] real :: plx !< Longshore wave parameter real :: pmz !< Vertical wave parameter real :: lambda !< Offshore decay scale - real :: omega !< Wave frequency in s-1 + real :: omega !< Wave frequency [s-1] real :: PI integer :: i, j, k, n, is, ie, js, je, isd, ied, jsd, jed, nz integer :: IsdB, IedB, JsdB, JedB diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 956f8b3287..47d9b7b6fe 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -71,7 +71,7 @@ module MOM_wave_interface real, allocatable, dimension(:), public :: & WaveNum_Cen !< Wavenumber bands for read/coupled (1/m) real, allocatable, dimension(:), public :: & - Freq_Cen !< Frequency bands for read/coupled (1/s) + Freq_Cen !< Frequency bands for read/coupled [s-1] real, allocatable, dimension(:), public :: & PrescribedSurfStkX !< Surface Stokes drift if prescribed [m s-1] real, allocatable, dimension(:), public :: & From 00a8cdc83d74ccaf4187733eba8a84649aba01b7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 21 Dec 2018 08:06:28 -0500 Subject: [PATCH 0970/1072] dOxyGenize ice_solo_driver/MOM_surface_forcing.F90 Added dOxyGen comments describing the arguments and routines in ice_solo_driver/MOM_surface_forcing.F90 and added square bracket comments describing the units of the variables in this routine. Also eliminated several redundant argument documentation blocks. Only comments have been changed and all answers are bitwise identical. --- .../ice_solo_driver/MOM_surface_forcing.F90 | 260 ++++++------------ 1 file changed, 88 insertions(+), 172 deletions(-) diff --git a/config_src/ice_solo_driver/MOM_surface_forcing.F90 b/config_src/ice_solo_driver/MOM_surface_forcing.F90 index cc0ff6723a..4b39c16a00 100644 --- a/config_src/ice_solo_driver/MOM_surface_forcing.F90 +++ b/config_src/ice_solo_driver/MOM_surface_forcing.F90 @@ -74,8 +74,6 @@ module MOM_surface_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface -! use MESO_surface_forcing, only : MESO_wind_forcing, MESO_buoyancy_forcing -! use MESO_surface_forcing, only : MESO_surface_forcing_init, MESO_surface_forcing_CS use user_surface_forcing, only : USER_wind_forcing, USER_buoyancy_forcing use user_surface_forcing, only : USER_surface_forcing_init, user_surface_forcing_CS use user_revise_forcing, only : user_alter_forcing, user_revise_forcing_init @@ -102,18 +100,18 @@ module MOM_surface_forcing real :: south_lat ! southern latitude of the domain real :: len_lat ! domain length in latitude - real :: Rho0 ! Boussinesq reference density (kg/m^3) - real :: G_Earth ! gravitational acceleration (m/s^2) + real :: Rho0 ! Boussinesq reference density [kg m-3] + real :: G_Earth ! gravitational acceleration [m s-2] real :: Flux_const ! piston velocity for surface restoring [m s-1] - 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 2-dimensional gustiness supplied from a file - real, pointer :: gust(:,:) => NULL() ! spatially varying unresolved background gustiness (Pa) + real, pointer :: gust(:,:) => NULL() ! spatially varying unresolved background gustiness [Pa] ! gust is used when read_gust_2d is true. - real, pointer :: T_Restore(:,:) => NULL() ! temperature to damp (restore) the SST to (deg C) - real, pointer :: S_Restore(:,:) => NULL() ! salinity to damp (restore) the SSS (g/kg) - real, pointer :: Dens_Restore(:,:) => NULL() ! density to damp (restore) surface density (kg/m^3) + real, pointer :: T_Restore(:,:) => NULL() ! temperature to damp (restore) the SST to [degC] + real, pointer :: S_Restore(:,:) => NULL() ! salinity to damp (restore) the SSS [ppt] + real, pointer :: Dens_Restore(:,:) => NULL() ! density to damp (restore) surface density [kg m-3] integer :: wind_last_lev_read = -1 ! The last time level read from the wind input files integer :: buoy_last_lev_read = -1 ! The last time level read from buoyancy input files @@ -167,6 +165,8 @@ module MOM_surface_forcing contains +!> This subroutine calls other subroutines in this file to get surface forcing fields. +!! It also allocates and initializes the fields in the flux type. subroutine set_forcing(sfc_state, forcing, fluxes, day_start, day_interval, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. @@ -176,21 +176,11 @@ subroutine set_forcing(sfc_state, forcing, fluxes, day_start, day_interval, G, U type(time_type), intent(in) :: day_interval !< Length of time over which these fluxes applied type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by - !! a previous surface_forcing_init call + type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by a + !! previous surface_forcing_init call -! This subroutine calls other subroutines in this file to get surface forcing fields. -! It also allocates and initializes the fields in the flux type. - -! Arguments: -! (inout) state = structure describing ocean surface state -! (inout) fluxes = structure with pointers to forcing fields; unused have NULL ptrs -! (in) day_start = Start time of the fluxes -! (in) day_interval = Length of time over which these fluxes applied -! (in) G = ocean grid structure -! (in) CS = pointer to control struct returned by previous surface_forcing_init call - - real :: dt ! length of time in seconds over which fluxes applied + ! Local variables + real :: dt ! length of time over which fluxes applied [s] type(time_type) :: day_center ! central time of the fluxes. integer :: intdt integer :: isd, ied, jsd, jed @@ -297,17 +287,13 @@ subroutine set_forcing(sfc_state, forcing, fluxes, day_start, day_interval, G, U call cpu_clock_end(id_clock_forcing) end subroutine set_forcing +!> This subroutine allocates arrays for buoyancy forcing. subroutine buoyancy_forcing_allocate(fluxes, G, CS) - type(forcing), intent(inout) :: fluxes + type(forcing), intent(inout) :: fluxes !< A structure with pointers to thermodynamic + !! forcing fields that will be allocated here type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(surface_forcing_CS), pointer :: CS - -! This subroutine allocates arrays for buoyancy forcing. - -! Arguments: -! (inout) fluxes = structure with pointers to forcing fields; unused have NULL ptrs -! (in) G = ocean grid structure -! (in) CS = pointer to control struct returned by previous surface_forcing_init call + type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by a + !! previous surface_forcing_init call integer :: isd, ied, jsd, jed isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -336,6 +322,7 @@ subroutine buoyancy_forcing_allocate(fluxes, G, CS) end subroutine buoyancy_forcing_allocate +! This subroutine sets the surface wind stresses to zero subroutine wind_forcing_zero(sfc_state, forces, day, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. @@ -343,16 +330,8 @@ subroutine wind_forcing_zero(sfc_state, forces, day, G, US, CS) type(time_type), intent(in) :: day !< Time used for determining the fluxes. 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(surface_forcing_CS), pointer :: CS - -! subroutine sets the surface wind stresses to zero - -! Arguments: -! state = structure describing ocean surface state -! (out) fluxes = structure with pointers to forcing fields; unused have NULL ptrs -! (in) day = time of the fluxes -! (in) G = ocean grid structure -! (in) CS = pointer to control struct returned by previous surface_forcing_init call + type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by a + !! previous surface_forcing_init call real :: PI integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq @@ -389,23 +368,17 @@ subroutine wind_forcing_zero(sfc_state, forces, day, G, US, CS) end subroutine wind_forcing_zero +!> This subroutine sets the surface wind stresses according to double gyre. subroutine wind_forcing_2gyre(sfc_state, forces, day, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(time_type), intent(in) :: day !< Time used for determining the fluxes. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(surface_forcing_CS), pointer :: CS - -! This subroutine sets the surface wind stresses according to double gyre. - -! Arguments: -! state = structure describing ocean surface state -! (out) fluxes = structure with pointers to forcing fields; unused have NULL ptrs -! (in) day = time of the fluxes -! (in) G = ocean grid structure -! (in) CS = pointer to control struct returned by previous surface_forcing_init call + type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by a + !! previous surface_forcing_init call + ! Local variables real :: PI integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -432,23 +405,17 @@ subroutine wind_forcing_2gyre(sfc_state, forces, day, G, CS) end subroutine wind_forcing_2gyre +!> This subroutine sets the surface wind stresses according to single gyre. subroutine wind_forcing_1gyre(sfc_state, forces, day, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(time_type), intent(in) :: day !< Time used for determining the fluxes. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(surface_forcing_CS), pointer :: CS - -! This subroutine sets the surface wind stresses according to single gyre. - -! Arguments: -! state = structure describing ocean surface state -! (out) fluxes = structure with pointers to forcing fields; unused have NULL ptrs -! (in) day = time of the fluxes -! (in) G = ocean grid structure -! (in) CS = pointer to control struct returned by previous surface_forcing_init call + type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by a + !! previous surface_forcing_init call + ! Local variables real :: PI integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -474,6 +441,7 @@ subroutine wind_forcing_1gyre(sfc_state, forces, day, G, CS) end subroutine wind_forcing_1gyre +!> This subroutine sets the surface wind stresses according to gyres. subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. @@ -481,17 +449,10 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) type(time_type), intent(in) :: day !< Time used for determining the fluxes. 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(surface_forcing_CS), pointer :: CS - -! This subroutine sets the surface wind stresses according to gyres. - -! Arguments: -! state = structure describing ocean surface state -! (out) fluxes = structure with pointers to forcing fields; unused have NULL ptrs -! (in) day = time of the fluxes -! (in) G = ocean grid structure -! (in) CS = pointer to control struct returned by previous surface_forcing_init call + type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by a + !! previous surface_forcing_init call + ! Local variables real :: PI, y integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -502,7 +463,7 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - ! steady surface wind stresses (Pa) + ! steady surface wind stresses [Pa] PI = 4.0*atan(1.0) do j=jsd,jed ; do I=IsdB,IedB @@ -526,7 +487,7 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) call callTree_leave("wind_forcing_gyres") end subroutine wind_forcing_gyres - +!> This subroutine sets the surface wind stresses by reading a file. subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. @@ -534,17 +495,10 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) type(time_type), intent(in) :: day !< Time used for determining the fluxes. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(surface_forcing_CS), pointer :: CS - -! This subroutine sets the surface wind stresses. - -! Arguments: -! state = structure describing ocean surface state -! (out) fluxes = structure with pointers to forcing fields; unused have NULL ptrs -! (in) day = time of the fluxes -! (in) G = ocean grid structure -! (in) CS = pointer to control struct returned by previous surface_forcing_init call + type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by a + !! previous surface_forcing_init call + ! Local variables integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB integer :: time_lev ! With fields from a file, this must @@ -633,30 +587,21 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) end subroutine wind_forcing_from_file +!> This subroutine specifies the current surface fluxes of buoyancy, temperature and fresh water +!! by reading a file. It may also be modified to add surface fluxes of user provided tracers. subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. - type(forcing), intent(inout) :: fluxes + type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< Time used for determining the fluxes. real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply, in s + !! the fluxes apply [s] type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(surface_forcing_CS), pointer :: CS - -! This subroutine specifies the current surface fluxes of buoyancy -! temperature and fresh water. It may also be modified to add -! surface fluxes of user provided tracers. -! -! Arguments: -! state = structure describing ocean surface state -! (out) fluxes = structure with pointers to forcing fields; unused have NULL ptrs -! (in) day = time of the fluxes -! (in) dt = amount of time over which the fluxes apply -! (in) G = ocean grid structure -! (in) CS = pointer to control struct returned by previous surface_forcing_init call - - real :: rhoXcp ! mean density times the heat capacity, in J m-3 K-1. - real :: Irho0 ! inverse Boussinesq reference density, in m3 kg-1. + type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by a + !! previous surface_forcing_init call + + real :: rhoXcp ! mean density times the heat capacity [J m-3 degC-1]. + real :: Irho0 ! inverse Boussinesq reference density [m3 kg-1]. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed integer :: time_lev ! With fields from a file, this must @@ -667,12 +612,12 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) real, dimension(SZI_(G),SZJ_(G)) :: & temp, & ! A 2-d temporary work array with various units. SST_anom, & ! Instantaneous sea surface temperature anomalies from a - ! target (observed) value, in deg C. + ! target (observed) value [degC]. SSS_anom, & ! Instantaneous sea surface salinity anomalies from a target - ! (observed) value, in g kg-1. + ! (observed) value [ppt]. SSS_mean ! A (mean?) salinity about which to normalize local salinity ! anomalies when calculating restorative precipitation - ! anomalies, in g kg-1. + ! anomalies [ppt]. call callTree_enter("buoyancy_forcing_from_files, MOM_surface_forcing.F90") @@ -838,28 +783,19 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) end subroutine buoyancy_forcing_from_files +!> This subroutine specifies the current surface fluxes of buoyancy, temperature and fresh water. +!! It may also be modified to add surface fluxes of user provided tracers. +!! This case has zero surface buoyancy forcing. subroutine buoyancy_forcing_zero(sfc_state, fluxes, day, dt, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. - type(forcing), intent(inout) :: fluxes + type(forcing), intent(inout) :: fluxes !< A structure with pointers to thermodynamic forcing fields type(time_type), intent(in) :: day !< Time used for determining the fluxes. real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply, in s + !! the fluxes apply [s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(surface_forcing_CS), pointer :: CS - -! This subroutine specifies the current surface fluxes of buoyancy -! temperature and fresh water. It may also be modified to add -! surface fluxes of user provided tracers. -! This case has zero surface buoyancy forcing. - -! Arguments: -! (inout) state = structure describing ocean surface state -! (inout) fluxes = structure with pointers to forcing fields; unused have NULL ptrs -! (in) day = time of the fluxes -! (in) dt = amount of time over which the fluxes apply -! (in) G = ocean grid structure -! (in) CS = pointer to control struct returned by previous surface_forcing_init call + type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by a + !! previous surface_forcing_init call integer :: i, j, is, ie, js, je @@ -867,7 +803,6 @@ subroutine buoyancy_forcing_zero(sfc_state, fluxes, day, dt, G, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - ! allocate and initialize arrays call buoyancy_forcing_allocate(fluxes, G, CS) @@ -896,29 +831,20 @@ subroutine buoyancy_forcing_zero(sfc_state, fluxes, day, dt, G, CS) call callTree_leave("buoyancy_forcing_zero") end subroutine buoyancy_forcing_zero - +!> This subroutine specifies the current surface fluxes of buoyancy, temperature and fresh water. +!! It may also be modified to add surface fluxes of user provided tracers. subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. - type(forcing), intent(inout) :: fluxes + type(forcing), intent(inout) :: fluxes !< A structure with pointers to thermodynamic forcing fields type(time_type), intent(in) :: day !< Time used for determining the fluxes. real, intent(in) :: dt !< The amount of time over which !! the fluxes apply, in s type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(surface_forcing_CS), pointer :: CS - -! This subroutine specifies the current surface fluxes of buoyancy -! temperature and fresh water. It may also be modified to add -! surface fluxes of user provided tracers. -! -! Arguments: -! (inout) state = structure describing ocean surface state -! (inout) fluxes = structure with pointers to forcing fields; unused have NULL ptrs -! (in) day = time of the fluxes -! (in) dt = amount of time over which the fluxes apply -! (in) G = ocean grid structure -! (in) CS = pointer to control struct returned by previous surface_forcing_init call + type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by a + !! previous surface_forcing_init call + ! Local variables real :: y, T_restore, S_restore integer :: i, j, is, ie, js, je @@ -991,24 +917,19 @@ subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, CS) call callTree_leave("buoyancy_forcing_linear") end subroutine buoyancy_forcing_linear - +!> 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 + 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 - character(len=*), intent(in) :: directory - logical, optional, intent(in) :: time_stamped - character(len=*), optional, intent(in) :: filename_suffix -! Arguments: CS - A pointer to the control structure returned by a previous -! call to surface_forcing_init. -! (in) G - The ocean's grid structure. -! (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) time_stamped - If true, the restart file names include -! a unique time stamp. The default is false. -! (in, opt) filename_suffix - An 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 @@ -1017,23 +938,19 @@ subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & end subroutine forcing_save_restart +!> Initialize the surface forcing, including setting parameters and allocating permanent memory. subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_CSp) - type(time_type), intent(in) :: Time + 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(in) :: diag - type(surface_forcing_CS), pointer :: CS - type(tracer_flow_control_CS), pointer :: tracer_flow_CSp -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module -! (in) tracer_flow_CSp - A pointer to the control structure of the tracer -! flow control module. + type(diag_ctrl), target, intent(in) :: 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 + type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< A pointer to the control structure of + !! the tracer flow control module. + + ! Local variables type(directories) :: dirs logical :: new_sim type(time_type) :: Time_frc @@ -1262,14 +1179,13 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C call cpu_clock_end(id_clock_forcing) end subroutine surface_forcing_init - +!> 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 surface_forcing_init call + !! that will be deallocated here. + type(forcing), optional, intent(inout) :: fluxes !< A structure containing pointers to any possible + !! forcing fields that will be deallocated here. if (present(fluxes)) call deallocate_forcing_type(fluxes) From 78e96595115c1775cc8860f3966ea795c814953b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 21 Dec 2018 08:27:55 -0500 Subject: [PATCH 0971/1072] Documented miscellaneous variable units Changed comments to use the square bracket notation to document the units of about 500 additional variables. Also corrected the name of bad_val_col_thick. Also eliminated several redundant argument documentation blocks. Only comments have been changed and all answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 133 +++++++++--------- .../ice_solo_driver/user_surface_forcing.F90 | 2 +- .../solo_driver/MESO_surface_forcing.F90 | 2 +- config_src/solo_driver/MOM_driver.F90 | 10 +- .../solo_driver/MOM_surface_forcing.F90 | 12 +- .../solo_driver/user_surface_forcing.F90 | 2 +- src/core/MOM.F90 | 77 +++++----- src/core/MOM_PressureForce_Montgomery.F90 | 10 +- src/core/MOM_PressureForce_analytic_FV.F90 | 6 +- src/core/MOM_barotropic.F90 | 49 +++---- src/core/MOM_continuity.F90 | 4 +- src/core/MOM_dynamics_split_RK2.F90 | 2 +- src/core/MOM_dynamics_unsplit.F90 | 2 - src/core/MOM_dynamics_unsplit_RK2.F90 | 3 +- src/core/MOM_forcing_type.F90 | 6 +- src/core/MOM_isopycnal_slopes.F90 | 4 +- src/core/MOM_open_boundary.F90 | 2 +- src/diagnostics/MOM_diag_to_Z.F90 | 10 +- src/diagnostics/MOM_diagnostics.F90 | 40 +++--- src/diagnostics/MOM_wave_speed.F90 | 2 +- src/diagnostics/MOM_wave_structure.F90 | 1 - src/framework/MOM_diag_mediator.F90 | 8 +- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 81 +++++------ src/ocean_data_assim/MOM_oda_driver.F90 | 4 +- .../lateral/MOM_internal_tides.F90 | 2 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 8 +- .../lateral/MOM_mixed_layer_restrat.F90 | 60 ++++---- .../vertical/MOM_ALE_sponge.F90 | 2 +- .../vertical/MOM_diabatic_driver.F90 | 24 ++-- .../vertical/MOM_diapyc_energy_req.F90 | 66 ++++----- .../vertical/MOM_energetic_PBL.F90 | 86 +++++------ .../vertical/MOM_internal_tide_input.F90 | 4 +- .../vertical/MOM_kappa_shear.F90 | 6 +- .../vertical/MOM_set_diffusivity.F90 | 12 +- .../vertical/MOM_tidal_mixing.F90 | 14 +- .../vertical/MOM_vert_friction.F90 | 12 +- src/tracer/DOME_tracer.F90 | 12 +- src/tracer/ISOMIP_tracer.F90 | 14 +- src/tracer/MOM_OCMIP2_CFC.F90 | 18 ++- src/tracer/MOM_generic_tracer.F90 | 14 +- src/tracer/MOM_offline_main.F90 | 27 ++-- src/tracer/MOM_tracer_Z_init.F90 | 2 +- src/tracer/MOM_tracer_advect.F90 | 2 +- src/tracer/MOM_tracer_diabatic.F90 | 35 +++-- src/tracer/MOM_tracer_flow_control.F90 | 11 -- src/tracer/advection_test_tracer.F90 | 12 +- src/tracer/boundary_impulse_tracer.F90 | 12 +- src/tracer/dye_example.F90 | 12 +- src/tracer/dyed_obc_tracer.F90 | 10 +- src/tracer/ideal_age_example.F90 | 12 +- src/tracer/oil_tracer.F90 | 16 +-- src/tracer/pseudo_salt_tracer.F90 | 12 +- src/tracer/tracer_example.F90 | 12 +- src/user/BFB_surface_forcing.F90 | 2 +- src/user/dumbbell_surface_forcing.F90 | 4 +- 55 files changed, 485 insertions(+), 522 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 32800b8212..6d161aad00 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -64,12 +64,12 @@ module MOM_surface_forcing !! the winds that are being provided in calls to !! 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). + real :: wind_stress_multiplier !< A multiplier applied to incoming wind stress [nondim]. - 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 [m2] + real :: latent_heat_fusion !< Latent heat of fusion [J kg-1] + real :: latent_heat_vapor !< Latent heat of vaporization [J kg-1] real :: max_p_surf !< The maximum surface pressure that can be !! exerted by the atmosphere and floating sea-ice, @@ -85,14 +85,14 @@ module MOM_surface_forcing !! type without any further adjustments to drive the ocean dynamics. !! The actual net mass source may differ due to corrections. - 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. + !! by drag on the tidal flows [W m-2]. real, pointer, dimension(:,:) :: & gust => NULL() !< A spatially varying unresolved background gustiness that - !! contributes to ustar (Pa). gust is used when read_gust_2d is true. + !! contributes to ustar [Pa]. gust is used when read_gust_2d is true. real, pointer, dimension(:,:) :: & ustar_tidal => NULL() !< Tidal contribution to the bottom friction velocity [m s-1] real :: cd_tides !< Drag coefficient that applies to the tides (nondimensional) @@ -101,11 +101,11 @@ module MOM_surface_forcing 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 :: Kv_sea_ice !< Viscosity in sea-ice that resists sheared vertical motions [m2 s-1] 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. + !! becomes effective [kg m-2], typically of order 1000 kg m-2. logical :: allow_flux_adjustments !< If true, use data_override to obtain flux adjustments logical :: restore_salt !< If true, the coupled MOM driver adds a term to restore surface @@ -121,7 +121,7 @@ module MOM_surface_forcing 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) + 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 @@ -157,33 +157,33 @@ module MOM_surface_forcing !> ice_ocean_boundary_type is a structure corresponding to forcing, but with the elements, units, !! and conventions that exactly conform to the use for MOM6-based coupled models. type, public :: ice_ocean_boundary_type - 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(:,:) :: 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(:,:) :: stress_mag =>NULL() !< The time-mean magnitude of the stress on the ocean (Pa) + 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 m-2] + real, pointer, dimension(:,:) :: q_flux =>NULL() !< specific humidity flux [kg m-2 s-1] + real, pointer, dimension(:,:) :: salt_flux =>NULL() !< salt flux [kg m-2 s-1] + real, pointer, dimension(:,:) :: lw_flux =>NULL() !< long wave radiation [W m-2] + real, pointer, dimension(:,:) :: sw_flux_vis_dir =>NULL() !< direct visible sw radiation [W m-2] + real, pointer, dimension(:,:) :: sw_flux_vis_dif =>NULL() !< diffuse visible sw radiation [W m-2] + real, pointer, dimension(:,:) :: sw_flux_nir_dir =>NULL() !< direct Near InfraRed sw radiation [W m-2] + real, pointer, dimension(:,:) :: sw_flux_nir_dif =>NULL() !< diffuse Near InfraRed sw radiation [W m-2] + real, pointer, dimension(:,:) :: lprec =>NULL() !< mass flux of liquid precip [kg m-2 s-1] + real, pointer, dimension(:,:) :: fprec =>NULL() !< mass flux of frozen precip [kg m-2 s-1] + real, pointer, dimension(:,:) :: runoff =>NULL() !< mass flux of liquid runoff [kg m-2 s-1] + real, pointer, dimension(:,:) :: calving =>NULL() !< mass flux of frozen runoff [kg m-2 s-1] + real, pointer, dimension(:,:) :: stress_mag =>NULL() !< The time-mean magnitude of the stress on the ocean [Pa] 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(:,:) :: area_berg =>NULL() !< fractional area covered by icebergs [m2 m-2] + real, pointer, dimension(:,:) :: mass_berg =>NULL() !< mass of icebergs per unit ocean area [kg m-2] + real, pointer, dimension(:,:) :: runoff_hflx =>NULL() !< heat content of liquid runoff [W m-2] + real, pointer, dimension(:,:) :: calving_hflx =>NULL() !< heat content of frozen runoff [W m-2] 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) + !< on ocean surface [Pa] + real, pointer, dimension(:,:) :: mi =>NULL() !< mass of ice per unit ocean area [kg m-2] 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) + !! outside of the ocean model [m3 s-1] 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. @@ -218,27 +218,26 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc !! surface state of the ocean. 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) + data_restore, & ! The surface value toward which to restore [ppt] or [degC] + SST_anom, & ! Instantaneous sea surface temperature anomalies from a target value [degC] + SSS_anom, & ! Instantaneous sea surface salinity anomalies from a target value [ppt] SSS_mean, & ! A (mean?) salinity about which to normalize local salinity - ! anomalies when calculating restorative precipitation anomalies (g/kg) + ! anomalies when calculating restorative precipitation anomalies [ppt] 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) + ! to be restored toward its target value [kg m-1 s-1] + net_FW, & ! The area integrated net freshwater flux into the ocean [kg s-1] + net_FW2, & ! The area integrated net freshwater flux into the ocean [kg s-1] + work_sum, & ! A 2-d array that is used as the work space for global sums [m2] or [kg s-1] 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 - real :: delta_sss ! temporary storage for sss diff from restoring value - real :: delta_sst ! temporary storage for sst diff from restoring value + real :: delta_sss ! temporary storage for sss diff from restoring value [ppt] + real :: delta_sst ! temporary storage for sst diff from restoring value [degC] - real :: C_p ! heat capacity of seawater ( J/(K kg) ) + real :: C_p ! heat capacity of seawater [J degC-1 kg-1] 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) @@ -579,20 +578,20 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ !! previous call to surface_forcing_init. real, optional, intent(in) :: dt_forcing !< A time interval over which to apply the !! current value of ustar as a weighted running - !! average, in s, or if 0 do not average ustar. + !! average [s], or if 0 do not average ustar. !! Missing is equivalent to 0. logical, optional, intent(in) :: reset_avg !< If true, reset the time average. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - rigidity_at_h, & ! Ice rigidity at tracer points (m3 s-1) - net_mass_src, & ! A temporary of net mass sources, in kg m-2 s-1. + rigidity_at_h, & ! Ice rigidity at tracer points [m3 s-1] + net_mass_src, & ! A temporary of net mass sources [kg m-2 s-1]. ustar_tmp ! A temporary array of ustar values [m s-1]. - 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) + real :: I_GEarth ! 1.0 / G%G_Earth [s2 m-1] + real :: Kv_rho_ice ! (CS%kv_sea_ice / CS%density_sea_ice) [m5 s-1 kg-1] + 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] real :: wt1, wt2 ! Relative weights of previous and current values of ustar, ND. integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 @@ -803,9 +802,9 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(inout) :: taux !< The zonal wind stresses on a C-grid, in Pa. + optional, intent(inout) :: taux !< The zonal wind stresses on a C-grid [Pa]. real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(inout) :: tauy !< The meridional wind stresses on a C-grid, in Pa. + optional, intent(inout) :: tauy !< The meridional wind stresses on a C-grid [Pa]. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(inout) :: ustar !< The surface friction velocity [Z s-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G)), & @@ -814,17 +813,17 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, integer, optional, intent(in) :: tau_halo !< The halo size of wind stresses to set, 0 by default. ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: taux_in_A ! Zonal wind stresses (in Pa) at h points - real, dimension(SZI_(G),SZJ_(G)) :: tauy_in_A ! Meridional wind stresses (in Pa) at h points - real, dimension(SZIB_(G),SZJ_(G)) :: taux_in_C ! Zonal wind stresses (in Pa) at u points - real, dimension(SZI_(G),SZJB_(G)) :: tauy_in_C ! Meridional wind stresses (in Pa) at v points - real, dimension(SZIB_(G),SZJB_(G)) :: taux_in_B ! Zonal wind stresses (in Pa) at q points - real, dimension(SZIB_(G),SZJB_(G)) :: tauy_in_B ! Meridional wind stresses (in Pa) at q points - - real :: gustiness ! unresolved gustiness that contributes to ustar (Pa) - real :: Irho0 ! Inverse of the mean density rescaled to (Z2 m / kg) - real :: taux2, tauy2 ! squared wind stresses (Pa^2) - real :: tau_mag ! magnitude of the wind stress (Pa) + real, dimension(SZI_(G),SZJ_(G)) :: taux_in_A ! Zonal wind stresses [Pa] at h points + real, dimension(SZI_(G),SZJ_(G)) :: tauy_in_A ! Meridional wind stresses [Pa] at h points + real, dimension(SZIB_(G),SZJ_(G)) :: taux_in_C ! Zonal wind stresses [Pa] at u points + real, dimension(SZI_(G),SZJB_(G)) :: tauy_in_C ! Meridional wind stresses [Pa] at v points + real, dimension(SZIB_(G),SZJB_(G)) :: taux_in_B ! Zonal wind stresses [Pa] at q points + real, dimension(SZIB_(G),SZJB_(G)) :: tauy_in_B ! Meridional wind stresses [Pa] at q points + + real :: gustiness ! unresolved gustiness that contributes to ustar [Pa] + real :: Irho0 ! Inverse of the mean density rescaled to [Z2 m kg-1 ~> m3 kg-1] + real :: taux2, tauy2 ! squared wind stresses [Pa2] + real :: tau_mag ! magnitude of the wind stress [Pa] logical :: do_ustar, do_gustless integer :: wind_stagger ! AGRID, BGRID_NE, or CGRID_NE (integers from MOM_domains) @@ -1064,8 +1063,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 diff --git a/config_src/ice_solo_driver/user_surface_forcing.F90 b/config_src/ice_solo_driver/user_surface_forcing.F90 index 639f81cfb6..56baa4579e 100644 --- a/config_src/ice_solo_driver/user_surface_forcing.F90 +++ b/config_src/ice_solo_driver/user_surface_forcing.F90 @@ -167,7 +167,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply, in s + !! the fluxes apply [s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned !! by a previous call to user_surface_forcing_init diff --git a/config_src/solo_driver/MESO_surface_forcing.F90 b/config_src/solo_driver/MESO_surface_forcing.F90 index 5371ceca91..fd172cfaf1 100644 --- a/config_src/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/solo_driver/MESO_surface_forcing.F90 @@ -60,7 +60,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply, in s + !! the fluxes apply [s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(MESO_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by !! a previous call to MESO_surface_forcing_init diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 5ccb00c1ae..14890af0f8 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -127,14 +127,14 @@ program MOM_main type(time_type) :: restart_time ! The next time to write restart files. type(time_type) :: Time_step_ocean ! A time_type version of dt_forcing. - real :: elapsed_time = 0.0 ! Elapsed time in this run in seconds. + real :: elapsed_time = 0.0 ! Elapsed time in this run [s]. logical :: elapsed_time_master ! If true, elapsed time is used to set the ! model's master clock (Time). This is needed ! if Time_step_ocean is not an exact ! representation of dt_forcing. - real :: dt_forcing ! The coupling time step in seconds. - real :: dt ! The baroclinic dynamics time step, in seconds. - real :: dt_off ! Offline time step in seconds + real :: dt_forcing ! The coupling time step [s]. + real :: dt ! The baroclinic dynamics time step [s]. + real :: dt_off ! Offline time step [s]. integer :: ntstep ! The number of baroclinic dynamics time steps ! within dt_forcing. real :: dt_therm @@ -150,7 +150,7 @@ program MOM_main ! restart file is saved at the end of a run segment ! unless Restart_control is negative. - real :: Time_unit ! The time unit in seconds for the following input fields. + real :: Time_unit ! The time unit for the following input fields [s]. type(time_type) :: restint ! The time between saves of the restart file. type(time_type) :: daymax ! The final day of the simulation. diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 765dbc59a9..ed990dbbaa 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -226,7 +226,7 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, US type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call ! Local variables - real :: dt ! length of time in seconds over which fluxes applied + real :: dt ! length of time over which fluxes applied [s] type(time_type) :: day_center ! central time of the fluxes. integer :: isd, ied, jsd, jed isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -735,7 +735,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply, in s + !! the fluxes apply [s] type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call @@ -1013,7 +1013,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, CS type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply, in s + !! the fluxes apply [s] type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call @@ -1179,7 +1179,7 @@ subroutine buoyancy_forcing_zero(sfc_state, fluxes, day, dt, G, CS) type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply, in s + !! the fluxes apply [s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call @@ -1222,7 +1222,7 @@ subroutine buoyancy_forcing_const(sfc_state, fluxes, day, dt, G, CS) type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply, in s + !! the fluxes apply [s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call @@ -1264,7 +1264,7 @@ subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, CS) type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply, in s + !! the fluxes apply [s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90 index 99be485499..ce77d6dd8c 100644 --- a/config_src/solo_driver/user_surface_forcing.F90 +++ b/config_src/solo_driver/user_surface_forcing.F90 @@ -104,7 +104,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields type(time_type), intent(in) :: day !< The time of the fluxes real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply, in s + !! the fluxes apply [s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned !! by a previous call to user_surface_forcing_init diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c254143cdc..ae6ab26b5d 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -239,10 +239,9 @@ module MOM logical :: mixedlayer_restrat !< If true, use submesoscale mixed layer restratifying scheme. logical :: useMEKE !< If true, call the MEKE parameterization. logical :: useWaves !< If true, update Stokes drift - real :: dtbt_reset_period !< The time interval in seconds between dynamic - !! recalculation of the barotropic time step. If - !! this is negative, it is never calculated, and - !! if it is 0, it is calculated every step. + real :: dtbt_reset_period !< The time interval between dynamic recalculation of the + !! barotropic time step [s]. If this is negative dtbt is never + !! calculated, and if it is 0, dtbt is calculated every step. type(time_type) :: dtbt_reset_interval !< A time_time representation of dtbt_reset_period. type(time_type) :: dtbt_reset_time !< The next time DTBT should be calculated. @@ -252,15 +251,15 @@ module MOM real, dimension(:,:,:), pointer :: & h_pre_dyn => NULL(), & !< The thickness before the transports [H ~> m or kg m-2]. - T_pre_dyn => NULL(), & !< Temperature before the transports, in degC. - S_pre_dyn => NULL() !< Salinity before the transports, in psu. + T_pre_dyn => NULL(), & !< Temperature before the transports [degC]. + S_pre_dyn => NULL() !< Salinity before the transports [ppt]. type(accel_diag_ptrs) :: ADp !< structure containing pointers to accelerations, !! for derived diagnostics (e.g., energy budgets) type(cont_diag_ptrs) :: CDp !< structure containing pointers to continuity equation !! terms, for derived diagnostics (e.g., energy budgets) real, dimension(:,:,:), pointer :: & - u_prev => NULL(), & !< previous value of u stored for diagnostics - v_prev => NULL() !< previous value of v stored for diagnostics + u_prev => NULL(), & !< previous value of u stored for diagnostics [m s-1] + v_prev => NULL() !< previous value of v stored for diagnostics [m s-1] logical :: interp_p_surf !< If true, linearly interpolate surface pressure !! over the coupling time step, using specified value @@ -269,9 +268,9 @@ module MOM !! a previous time-step or the ocean restart file. !! This is only valid when interp_p_surf is true. real, dimension(:,:), pointer :: & - p_surf_prev => NULL(), & !< surface pressure (Pa) at end previous call to step_MOM - p_surf_begin => NULL(), & !< surface pressure (Pa) at start of step_MOM_dyn_... - p_surf_end => NULL() !< surface pressure (Pa) at end of step_MOM_dyn_... + p_surf_prev => NULL(), & !< surface pressure [Pa] at end previous call to step_MOM + p_surf_begin => NULL(), & !< surface pressure [Pa] at start of step_MOM_dyn_... + p_surf_end => NULL() !< surface pressure [Pa] at end of step_MOM_dyn_... ! Variables needed to reach between start and finish phases of initialization logical :: write_IC !< If true, then the initial conditions will be written to file @@ -282,23 +281,23 @@ module MOM ! These elements are used to control the calculation and error checking of the surface state real :: Hmix !< Diagnostic mixed layer thickness over which to - !! average surface tracer properties (in depth units, Z) when - !! bulk mixed layer is not used, or a negative value + !! average surface tracer properties when a bulk + !! mixed layer is not used [Z ~> m], or a negative value !! if a bulk mixed layer is being used. real :: HFrz !< If HFrz > 0, 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. real :: Hmix_UV !< Depth scale over which to average surface flow to - !! feedback to the coupler/driver (in depth units, Z) when + !! feedback to the coupler/driver [Z ~> m] when !! bulk mixed layer is not used, or a negative value !! if a bulk mixed layer is being used. logical :: check_bad_sfc_vals !< If true, scan surface state for ridiculous values. - real :: bad_val_ssh_max !< Maximum SSH before triggering bad value message - real :: bad_val_sst_max !< Maximum SST before triggering bad value message - real :: bad_val_sst_min !< Minimum SST before triggering bad value message - real :: bad_val_sss_max !< Maximum SSS before triggering bad value message - real :: bad_vol_col_thick !< Minimum column thickness before triggering bad value message + real :: bad_val_ssh_max !< Maximum SSH before triggering bad value message [m] + real :: bad_val_sst_max !< Maximum SST before triggering bad value message [degC] + real :: bad_val_sst_min !< Minimum SST before triggering bad value message [degC] + real :: bad_val_sss_max !< Maximum SSS before triggering bad value message [ppt] + real :: bad_val_col_thick !< Minimum column thickness before triggering bad value message [m] type(MOM_diag_IDs) :: IDs !< Handles used for diagnostics. type(transport_diag_IDs) :: transport_IDs !< Handles used for transport diagnostics. @@ -889,8 +888,8 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & real, intent(in) :: dt_thermo !< time interval covered by any updates that may !! span multiple dynamics steps [s]. real, intent(in) :: bbl_time_int !< time interval over which updates to the - !! bottom boundary layer properties will apply, - !! in s, or zero not to update the properties. + !! bottom boundary layer properties will apply [s], + !! or zero not to update the properties. type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM type(time_type), intent(in) :: Time_local !< End time of a segment, as a time type type(wave_parameters_CS), & @@ -907,7 +906,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & real, dimension(:,:,:), pointer :: & u => NULL(), & ! u : zonal velocity component [m s-1] v => NULL(), & ! v : meridional velocity component [m s-1] - h => NULL() ! h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) + h => NULL() ! h : layer thickness [H ~> m or kg m-2] logical :: calc_dtbt ! Indicates whether the dynamically adjusted ! barotropic time step needs to be updated. @@ -1067,7 +1066,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, h, Time_local) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< layer thicknesses after the transports (m or kg/m2) + intent(in) :: h !< layer thicknesses after the transports [H ~> m or kg m-2] type(time_type), intent(in) :: Time_local !< The model time at the end !! of the time step. type(group_pass_type) :: pass_T_S @@ -1140,10 +1139,10 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(inout) :: v !< meridional velocity [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< layer thickness (m or kg/m2) + intent(inout) :: h !< layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables type(forcing), intent(inout) :: fluxes !< pointers to forcing fields - real, intent(in) :: dtdia !< The time interval over which to advance, in s + real, intent(in) :: dtdia !< The time interval over which to advance [s] type(time_type), intent(in) :: Time_end_thermo !< End of averaging interval for thermo diags logical, intent(in) :: update_BBL !< If true, calculate the bottom boundary layer properties. type(wave_parameters_CS), & @@ -1533,8 +1532,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & type(unit_scale_type), pointer :: US => NULL() character(len=4), parameter :: vers_num = 'v2.0' -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz integer :: IsdB, IedB, JsdB, JedB @@ -1542,14 +1541,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & real :: Z_diag_int ! minimum interval between calc depth-space diagnostics [s] real, allocatable, dimension(:,:,:) :: e ! interface heights (meter) - real, allocatable, dimension(:,:) :: eta ! free surface height (m) or bottom press (Pa) - real, allocatable, dimension(:,:) :: area_shelf_h ! area occupied by ice shelf - real, dimension(:,:), allocatable, target :: frac_shelf_h ! fraction of total area occupied by ice shelf + real, allocatable, dimension(:,:) :: eta ! free surface height [m] or column mass [kg m-2] + real, allocatable, dimension(:,:) :: area_shelf_h ! area occupied by ice shelf [m2] + real, dimension(:,:), allocatable, target :: frac_shelf_h ! fraction of total area occupied by ice shelf [nondim] real, dimension(:,:), pointer :: shelf_area => NULL() type(MOM_restart_CS), pointer :: restart_CSp_tmp => NULL() type(group_pass_type) :: tmp_pass_uv_T_S_h, pass_uv_T_S_h - ! GMM, the following *is not* used. Should we delete it? - type(group_pass_type) :: tmp_pass_Kv_shear real :: default_val ! default value for a parameter logical :: write_geom_files ! If true, write out the grid geometry files. @@ -1881,7 +1878,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "The value of SST below which a bad value message is \n"//& "triggered, if CHECK_BAD_SURFACE_VALS is true.", & units="deg C", default=-2.1) - call get_param(param_file, "MOM", "BAD_VAL_COLUMN_THICKNESS", CS%bad_vol_col_thick, & + call get_param(param_file, "MOM", "BAD_VAL_COLUMN_THICKNESS", CS%bad_val_col_thick, & "The value of column thickness below which a bad value message is \n"//& "triggered, if CHECK_BAD_SURFACE_VALS is true.", units="m", & default=0.0) @@ -2704,22 +2701,22 @@ subroutine extract_surface_state(CS, sfc_state) !! data in this structure is intent out. ! local - real :: hu, hv + real :: hu, hv ! Thicknesses interpolated to velocity points [H ~> m or kg m-2] type(ocean_grid_type), pointer :: G => NULL() !< pointer to a structure containing !! metrics and related information type(verticalGrid_type), pointer :: GV => NULL() real, dimension(:,:,:), pointer :: & u => NULL(), & !< u : zonal velocity component [m s-1] v => NULL(), & !< v : meridional velocity component [m s-1] - h => NULL() !< h : layer thickness (meter (Bouss) or kg/m2 (non-Bouss)) + h => NULL() !< h : layer thickness [H ~> m or kg m-2] real :: depth(SZI_(CS%G)) !< Distance from the surface in depth units [Z ~> m] real :: depth_ml !< Depth over which to average to determine mixed !! layer properties [Z ~> m] real :: dh !< Thickness of a layer within the mixed layer [Z ~> m] - real :: mass !< Mass per unit area of a layer (kg/m2) - real :: bathy_m !< The depth of bathymetry in m (not Z), used for error checking. - real :: T_freeze !< freezing temperature (oC) - real :: delT(SZI_(CS%G)) !< T-T_freeze (oC) + real :: mass !< Mass per unit area of a layer [kg m-2] + real :: bathy_m !< The depth of bathymetry [m] (not Z), used for error checking. + real :: T_freeze !< freezing temperature [degC] + real :: delT(SZI_(CS%G)) !< T-T_freeze [degC] logical :: use_temperature !< If true, temp and saln used as state variables. integer :: i, j, k, is, ie, js, je, nz, numberOfErrors integer :: isd, ied, jsd, jed @@ -2988,7 +2985,7 @@ subroutine extract_surface_state(CS, sfc_state) localError = sfc_state%sea_lev(i,j)<=-bathy_m & .or. sfc_state%sea_lev(i,j)>= CS%bad_val_ssh_max & .or. sfc_state%sea_lev(i,j)<=-CS%bad_val_ssh_max & - .or. sfc_state%sea_lev(i,j) + bathy_m < CS%bad_vol_col_thick + .or. sfc_state%sea_lev(i,j) + bathy_m < CS%bad_val_col_thick if (use_temperature) localError = localError & .or. sfc_state%SSS(i,j)<0. & .or. sfc_state%SSS(i,j)>=CS%bad_val_sss_max & diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 97e032500b..aa228c5a6d 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -122,8 +122,8 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! barotropic and baroclinic pieces. type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. - real :: I_gEarth ! The inverse of g_Earth, in s2 Z m-2 - real :: dalpha + real :: I_gEarth ! The inverse of g_Earth [s2 Z m-2 ~> s2 m-1] +! real :: dalpha real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). real :: alpha_Lay(SZK_(G)) ! The specific volume of each layer [kg m-3]. real :: dalpha_int(SZK_(G)+1) ! The change in specific volume across each @@ -365,12 +365,12 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration due to pressure gradients - !! (equal to -dM/dx) in m/s2. + !! (equal to -dM/dx) [m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration due to pressure gradients - !! (equal to -dM/dy) in m/s2. + !! (equal to -dM/dy) [m s2]. type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean or - !! atmosphere-ocean in Pa. + !! atmosphere-ocean [Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure anomaly in !! each layer due to free surface height anomalies !! [m2 s-2 H-1 ~> m s-2]. diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 603b0b815f..1b380ac334 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -160,7 +160,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p real :: dp_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [Pa]. real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. - real :: I_gEarth ! The inverse of g_Earth_z, in s2 Z m-2 + real :: I_gEarth ! The inverse of g_Earth_z [s2 Z m-2 ~> s2 m-1] real :: alpha_anom ! The in-situ specific volume, averaged over a ! layer, less alpha_ref, in m3 kg-1. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -500,9 +500,9 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in m. real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. - real :: I_Rho0 ! 1/Rho0. + real :: I_Rho0 ! 1/Rho0 [m3 kg-1]. real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. - real :: Rho_ref ! The reference density in kg m-3. + real :: Rho_ref ! The reference density [kg m-3]. real :: dz_neglect ! A minimal thickness [Z ~> m], like e. logical :: use_p_atm ! If true, use the atmospheric pressure. logical :: use_ALE ! If true, use an ALE pressure reconstruction. diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 05dad87285..9b661fa46c 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -407,7 +407,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta_PF_in !< The 2-D eta field (either SSH anomaly or !! column mass anomaly) that was used to calculate the input !! pressure gradient accelerations (or its final value if - !! eta_PF_start is provided, in m or kg m-2. + !! eta_PF_start is provided [H ~> m or kg m-2]. !! Note: eta_in, pbce, and eta_PF_in must have up-to-date !! values in the first point of their halos. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_Cor !< The (3-D) zonal-velocities used to @@ -418,7 +418,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: accel_layer_v !< The meridional acceleration of each layer !! due to the barotropic calculation [m s-2]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_out !< The final barotropic free surface - !! height anomaly or column mass anomaly, in m or kg m-2. + !! height anomaly or column mass anomaly [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: uhbtav !< the barotropic zonal volume or mass !! fluxes averaged through the barotropic steps, in !! m3 s-1 or kg s-1. @@ -435,7 +435,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: visc_rem_v !< Ditto for meridional direction. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: etaav !< The free surface height or column mass - !! averaged over the barotropic integration, in m or kg m-2. + !! averaged over the barotropic integration [H ~> m or kg m-2]. type(ocean_OBC_type), optional, pointer :: OBC !< The open boundary condition structure. type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe !! the effective open face areas as a function of barotropic @@ -471,8 +471,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, dimension(SZI_(G),SZJ_(G)) :: & e_anom ! The anomaly in the sea surface height or column mass ! averaged between the beginning and end of the time step, - ! relative to eta_PF, with SAL effects included, in units - ! of H (m or kg m-2, the same as eta and h). + ! relative to eta_PF, with SAL effects included [H ~> m or kg m-2]. ! These are always allocated with symmetric memory and wide halos. real :: q(SZIBW_(CS),SZJBW_(CS)) ! A pseudo potential vorticity [s-1 Z-1 ~> s-1 m-1]. @@ -548,22 +547,22 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, eta_PF_BT ! A pointer to the eta array (either eta or eta_pred) that ! determines the barotropic pressure force [H ~> m or kg m-2] real, dimension(SZIW_(CS),SZJW_(CS)) :: & - eta_sum, & ! eta summed across the timesteps, in m or kg m-2. - eta_wtd, & ! A weighted estimate used to calculate eta_out, in m or kg m-2. + eta_sum, & ! eta summed across the timesteps [H ~> m or kg m-2]. + eta_wtd, & ! A weighted estimate used to calculate eta_out [H ~> m or kg m-2]. eta_PF, & ! A local copy of the 2-D eta field (either SSH anomaly or ! column mass anomaly) that was used to calculate the input - ! pressure gradient accelerations, in m or kg m-2. + ! pressure gradient accelerations [H ~> m or kg m-2]. eta_PF_1, & ! The initial value of eta_PF, when interp_eta_PF is - ! true, in m or kg m-2. + ! true [H ~> m or kg m-2]. d_eta_PF, & ! The change in eta_PF over the barotropic time stepping when - ! interp_eta_PF is true, in m or kg m-2. + ! interp_eta_PF is true [H ~> m or kg m-2]. gtot_E, & ! gtot_X is the effective total reduced gravity used to relate gtot_W, & ! free surface height deviations to pressure forces (including gtot_N, & ! GFS and baroclinic contributions) in the barotropic momentum gtot_S, & ! equations half a grid-point in the X-direction (X is N, S, E, or W) ! from the thickness point [m2 H-1 s-2 ~> m s-2 or m4 kg-1 s-2]. ! (See Hallberg, J Comp Phys 1997 for a discussion.) - eta_src, & ! The source of eta per barotropic timestep, in m or kg m-2. + eta_src, & ! The source of eta per barotropic timestep [H ~> m or kg m-2]. dyn_coef_eta, & ! The coefficient relating the changes in eta to the ! dynamic surface pressure under rigid ice ! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. @@ -582,7 +581,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real :: mass_to_Z ! The depth unit converison divided by the mean density (Rho0), in m3 kg-1. real :: visc_rem ! A work variable that may equal visc_rem_[uv]. Nondim. real :: vel_prev ! The previous velocity [m s-1]. - real :: dtbt ! The barotropic time step in s. + real :: dtbt ! The barotropic time step [s]. real :: bebt ! A copy of CS%bebt. real :: be_proj ! The fractional amount by which velocities are projected ! when project_velocity is true. For now be_proj is set @@ -613,7 +612,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real :: ice_strength = 0.0 ! The effective strength of the ice [m s-2]. real :: Idt_max2 ! The squared inverse of the local maximum stable - ! barotropic time step, in s-2. + ! barotropic time step [s-2]. real :: H_min_dyn ! The minimum depth to use in limiting the size of the ! dynamic surface pressure for stability [H ~> m or kg m-2]. real :: H_eff_dx2 ! The effective total thickness divided by the grid spacing @@ -2402,7 +2401,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt_trans !< the meridional BT velocity used in transports, !! m s-1. real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or - !! column mass anomaly, in m or kg m-2. + !! column mass anomaly [H ~> m or kg m-2]. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: ubt_old !< The starting value of ubt in a barotropic step, !! m s-1. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vbt_old !< The starting value of vbt in a barotropic step, @@ -2565,7 +2564,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the !! argument arrays. real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or - !! column mass anomaly, in m or kg m-2. + !! column mass anomaly [H ~> m or kg m-2]. type(BT_OBC_type), intent(inout) :: BT_OBC !< A structure with the private barotropic arrays !! related to the open boundary conditions, !! set by set_up_BT_OBC. @@ -2772,9 +2771,9 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) type(barotropic_CS), pointer :: CS !< The control structure returned by a previous !! call to barotropic_init. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - optional, intent(in) :: h_u !< The specified thicknesses at u-points, in m or kg m-2. + optional, intent(in) :: h_u !< The specified thicknesses at u-points [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - optional, intent(in) :: h_v !< The specified thicknesses at v-points, in m or kg m-2. + optional, intent(in) :: h_v !< The specified thicknesses at v-points [H ~> m or kg m-2]. logical, optional, intent(in) :: may_use_default !< An optional logical argument !! to indicate that the default velocity point !! thicknesses may be used for this particular @@ -2784,18 +2783,16 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) type(ocean_OBC_type), optional, pointer :: OBC !< Open boundary control structure. ! Local variables -! All of these variables are in the same units as h - usually m or kg m-2. - real :: hatutot(SZIB_(G)) ! The sum of the layer thicknesses - real :: hatvtot(SZI_(G)) ! interpolated to the u & v grid points. - real :: Ihatutot(SZIB_(G)) ! Ihatutot and Ihatvtot are the inverses - real :: Ihatvtot(SZI_(G)) ! of hatutot and hatvtot, both [H-1 ~> m-1 or m2 kg-1]. + real :: hatutot(SZIB_(G)) ! The sum of the layer thicknesses interpolated to u points [H ~> m or kg m-2]. + real :: hatvtot(SZI_(G)) ! The sum of the layer thicknesses interpolated to v points [H ~> m or kg m-2]. + real :: Ihatutot(SZIB_(G)) ! Ihatutot is the inverse of hatutot [H-1 ~> m-1 or m2 kg-1]. + real :: Ihatvtot(SZI_(G)) ! Ihatvtot is the inverse of hatvtot [H-1 ~> m-1 or m2 kg-1]. real :: h_arith ! The arithmetic mean thickness [H ~> m or kg m-2]. real :: h_harm ! The harmonic mean thicknesses [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: wt_arith ! The nondimensional weight for the arithmetic - ! mean thickness. The harmonic mean uses - ! a weight of (1 - wt_arith). + real :: wt_arith ! The nondimensional weight for the arithmetic mean thickness. + ! The harmonic mean uses a weight of (1 - wt_arith). real :: Rh ! A ratio of summed thicknesses, nondim. real :: e_u(SZIB_(G),SZK_(G)+1) ! The interface heights at u-velocity and real :: e_v(SZI_(G),SZK_(G)+1) ! v-velocity points [H ~> m or kg m-2]. @@ -3556,7 +3553,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) !! to overestimate the external wave speed) [Z ~> m]. ! Local variables - real :: H1, H2 ! Temporary total thicknesses, in m or kg m-2. + real :: H1, H2 ! Temporary total thicknesses [H ~> m or kg m-2]. integer :: i, j, is, ie, js, je, hs is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec hs = 1 ; if (present(halo)) hs = max(halo,0) diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index ac130d7ba4..f2efa147f2 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -48,9 +48,9 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: v !< Meridional velocity, in m/s. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: hin !< Initial layer thickness, in m or kg/m2. + intent(in) :: hin !< Initial layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Final layer thickness, in m or kg/m2. + intent(inout) :: h !< Final layer thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: uh !< Volume flux through zonal faces = !! u*h*dy, in m3/s. diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 427fbcaee4..abe14df5f6 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -292,7 +292,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & real, dimension(SZI_(G),SZJ_(G)) :: eta_pred ! eta_pred is the predictor value of the free surface height or column mass, - ! in m or kg m-2. + ! [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: u_adj real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: v_adj diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 73fe114597..73ffc9aad5 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -189,7 +189,6 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. - !! (usually m or kg m-2). type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical @@ -571,7 +570,6 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS intent(inout) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , & intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] - !! (usually m or kg m-2). type(time_type), target, intent(in) :: Time !< The current model time. type(param_file_type), intent(in) :: param_file !< A structure to parse !! for run-time parameters. diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index ca4edfb0a3..6aa4ce2e15 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -193,7 +193,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v_in !< The input and output meridional !! velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_in !< The input and output layer thicknesses, - !! in m or kg m-2, depending on whether + !! [H ~> m or kg m-2], depending on whether !! the Boussinesq approximation is made. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. @@ -513,7 +513,6 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] - !! (usually m or kg m-2). type(time_type), target, intent(in) :: Time !< The current model time. type(param_file_type), intent(in) :: param_file !< A structure to parse !! for run-time parameters. diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 0d114de515..1800b3c793 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -778,7 +778,7 @@ subroutine extractFluxes2d(G, GV, fluxes, optics, nsw, dt, FluxRescaleDepth, & type(forcing), intent(inout) :: fluxes !< structure containing pointers to forcing. type(optics_type), pointer :: optics !< pointer to optics integer, intent(in) :: nsw !< number of bands of penetrating SW - real, intent(in) :: dt !< time step in seconds + real, intent(in) :: dt !< time step [s] real, intent(in) :: FluxRescaleDepth !< min ocean depth before fluxes !! are scaled away [H ~> m or kg m-2] logical, intent(in) :: useRiverHeatContent !< logical for river heat content @@ -1774,7 +1774,7 @@ subroutine forcing_accumulate(flux_tmp, forces, fluxes, dt, G, wt2) type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces type(forcing), intent(inout) :: fluxes !< A structure containing time-averaged !! thermodynamic forcing fields - real, intent(in) :: dt !< The elapsed time since the last call to this subroutine, in s + real, intent(in) :: dt !< The elapsed time since the last call to this subroutine [s] type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure real, intent(out) :: wt2 !< The relative weight of the new fluxes @@ -1793,7 +1793,7 @@ subroutine fluxes_accumulate(flux_tmp, fluxes, dt, G, wt2, forces) !! thermodynamic forcing fields type(forcing), intent(inout) :: fluxes !< A structure containing time-averaged !! thermodynamic forcing fields - real, intent(in) :: dt !< The elapsed time since the last call to this subroutine, in s + real, intent(in) :: dt !< The elapsed time since the last call to this subroutine [s] type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure real, intent(out) :: wt2 !< The relative weight of the new fluxes type(mech_forcing), optional, intent(in) :: forces !< A structure with the driving mechanical forces diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 359cba9ef3..8742a0d945 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -343,12 +343,12 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here) integer, optional, intent(in) :: halo_here !< Halo width over which to compute ! Local variables real :: ent(SZI_(G),SZK_(G)+1) ! The diffusive entrainment (kappa*dt)/dz - ! between layers in a timestep in m or kg m-2. + ! between layers in a timestep [H ~> m or kg m-2]. real :: b1(SZI_(G)), d1(SZI_(G)) ! b1, c1, and d1 are variables used by the real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. real :: kap_dt_x2 ! The product of 2*kappa*dt, converted to ! the same units as h, in m2 or kg2 m-4. - real :: h_neglect ! A negligible thickness, in m or kg m-2, to + real :: h_neglect ! A negligible thickness [H ~> m or kg m-2], to ! allow for zero thicknesses. integer :: i, j, k, is, ie, js, je, nz, halo diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index e5eeaf0660..6e9d6cccf1 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -2879,7 +2879,7 @@ end subroutine open_boundary_test_extern_uv subroutine open_boundary_test_extern_h(G, OBC, h) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(ocean_OBC_type), pointer :: OBC !< Open boundary structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)),intent(inout) :: h !< Layer thickness (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G), SZK_(G)),intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] ! Local variables integer :: i, j, k, n diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index 10ccc424a0..66e6246d07 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -163,9 +163,9 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, US, CS) !! to diag_to_Z_init. ! Local variables ! Note the deliberately reversed axes in h_f, u_f, v_f, and tr_f. - real :: ssh(SZI_(G),SZJ_(G)) ! copy of ssh_in whose halos can be updated (meter or kg/m2) + real :: ssh(SZI_(G),SZJ_(G)) ! copy of ssh_in whose halos can be updated [H ~> m or kg m-2] real :: e(SZK_(G)+2) ! z-star interface heights [Z ~> m]. - real :: h_f(SZK_(G)+1,SZI_(G)) ! thicknesses of massive layers (meter or kg/m2) + real :: h_f(SZK_(G)+1,SZI_(G)) ! thicknesses of massive layers [H ~> m or kg m-2] real :: u_f(SZK_(G)+1,SZIB_(G))! zonal velocity component in any massive layer real :: v_f(SZK_(G)+1,SZI_(G)) ! meridional velocity component in any massive layer @@ -174,7 +174,7 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, US, CS) real :: D_pt(SZIB_(G)) ! bottom depth [Z ~> m]. real :: shelf_depth(SZIB_(G)) ! ice shelf depth [Z ~> m]. - real :: htot ! summed layer thicknesses (meter or kg/m2) + real :: htot ! summed layer thicknesses [H ~> m or kg m-2] real :: dilate ! proportion by which to dilate every layer real :: wt(SZK_(G)+1) ! fractional weight for each layer in the ! range between k_top and k_bot (nondim) @@ -542,7 +542,7 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) ! the current depth level [H m2 ~> m3 or kg] real :: Idt ! inverse of the time step (sec) - real :: z_int_above(SZIB_(G)) ! height of the interface atop a layer (meter or kg/m2) + real :: z_int_above(SZIB_(G)) ! height of the interface atop a layer [H ~> m or kg m-2] integer :: kz(SZIB_(G)) ! index of depth level that is being contributed to @@ -765,7 +765,7 @@ subroutine calc_Zint_diags(h, in_ptrs, ids, num_diags, G, GV, CS) real, dimension(max(num_diags,1),SZI_(G),SZK_(G)+1) :: diag2d real, dimension(SZI_(G)) :: & - htot, & ! summed layer thicknesses (meter or kg/m2) + htot, & ! summed layer thicknesses [H ~> m or kg m-2] dilate ! proportion by which to dilate every layer real :: wt ! weighting of the interface above in the ! interpolation to target depths diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 2ec42b4da9..4d894ba1a2 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -53,7 +53,7 @@ module MOM_diagnostics !! monotonic for the purposes of calculating the equivalent !! barotropic wave speed. real :: mono_N2_depth = -1. !< The depth below which N2 is limited as monotonic for the purposes of - !! calculating the equivalent barotropic wave speed. (m) + !! calculating the equivalent barotropic wave speed [m]. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. @@ -62,31 +62,31 @@ module MOM_diagnostics ! following fields have nz+1 levels. real, pointer, dimension(:,:,:) :: & - e => NULL(), & !< interface height (metre) - e_D => NULL() !< interface height above bottom (metre) + e => NULL(), & !< interface height [Z ~> m] + e_D => NULL() !< interface height above bottom [Z ~> m] ! following fields have nz layers. real, pointer, dimension(:,:,:) :: & - du_dt => NULL(), & !< net i-acceleration in m/s2 - dv_dt => NULL(), & !< net j-acceleration in m/s2 - dh_dt => NULL(), & !< thickness rate of change in [m s-1] or kg/(m2*s) - p_ebt => NULL() !< Equivalent barotropic modal structure + du_dt => NULL(), & !< net i-acceleration [m s-2] + dv_dt => NULL(), & !< net j-acceleration [m s-2] + dh_dt => NULL(), & !< thickness rate of change [H s-1 ~> m s-1 or kg m-2 s-1] + p_ebt => NULL() !< Equivalent barotropic modal structure [nondim] real, pointer, dimension(:,:,:) :: h_Rlay => NULL() !< Layer thicknesses in potential density - !! coordinates, in m (Bouss) or kg/m2 (non-Bouss) + !! coordinates [H ~> m or kg m-2] real, pointer, dimension(:,:,:) :: uh_Rlay => NULL() !< Zonal transports in potential density - !! coordinates in m3/s (Bouss) or kg/s (non-Bouss) + !! coordinates [H m2 s-1 ~> m3 s-1 or kg s-1] real, pointer, dimension(:,:,:) :: vh_Rlay => NULL() !< Meridional transports in potential density - !! coordinates in m3/s (Bouss) or kg/s (non-Bouss) + !! coordinates [H m2 s-1 ~> m3 s-1 or kg s-1] real, pointer, dimension(:,:,:) :: uhGM_Rlay => NULL() !< Zonal Gent-McWilliams transports in potential density - !! coordinates, in m3/s (Bouss) or kg/s (non-Bouss) + !! coordinates [H m2 s-1 ~> m3 s-1 or kg s-1] real, pointer, dimension(:,:,:) :: vhGM_Rlay => NULL() !< Meridional Gent-McWilliams transports in potential density - !! coordinates, in m3/s (Bouss) or kg/s (non-Bouss) + !! coordinates [H m2 s-1 ~> m3 s-1 or kg s-1] ! following fields are 2-D. real, pointer, dimension(:,:) :: & cg1 => NULL(), & !< First baroclinic gravity wave speed [m s-1] - Rd1 => NULL(), & !< First baroclinic deformation radius, in m + Rd1 => NULL(), & !< First baroclinic deformation radius [m] cfl_cg1 => NULL(), & !< CFL for first baroclinic gravity wave speed, nondim cfl_cg1_x => NULL(), & !< i-component of CFL for first baroclinic gravity wave speed, nondim cfl_cg1_y => NULL() !< j-component of CFL for first baroclinic gravity wave speed, nondim @@ -209,8 +209,8 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & real, dimension(:,:), pointer :: p_surf !< A pointer to the surface pressure [Pa]. !! If p_surf is not associated, it is the same !! as setting the surface pressure to 0. - real, intent(in) :: dt !< The time difference in s since the last - !! call to this subroutine. + real, intent(in) :: dt !< The time difference since the last + !! call to this subroutine [s]. type(diag_grid_storage), intent(in) :: diag_pre_sync !< Target grids from previous timestep type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by a !! previous call to diagnostics_init. @@ -218,7 +218,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & optional, intent(in) :: eta_bt !< An optional barotropic !! variable that gives the "correct" free surface height (Boussinesq) or total water column !! mass per unit area (non-Boussinesq). This is used to dilate the layer thicknesses when - !! calculating interface heights, in m or kg m-2. + !! calculating interface heights [H ~> m or kg m-2]. ! Local variables integer i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb @@ -782,17 +782,17 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) z_top, & ! Height of the top of a layer or the ocean [Z ~> m]. z_bot, & ! Height of the bottom of a layer (for id_mass) or the ! (positive) depth of the ocean (for id_col_ht) [Z ~> m]. - mass, & ! integrated mass of the water column, in kg m-2. For + mass, & ! integrated mass of the water column [kg m-2]. For ! non-Boussinesq models this is rho*dz. For Boussinesq ! models, this is either the integral of in-situ density ! (rho*dz for col_mass) or reference density (Rho_0*dz for mass_wt). btm_pres,&! The pressure at the ocean bottom, or CMIP variable 'pbo'. ! This is the column mass multiplied by gravity plus the pressure - ! at the ocean surface. + ! at the ocean surface [Pa]. dpress, & ! Change in hydrostatic pressure across a layer [Pa]. tr_int ! vertical integral of a tracer times density, - ! (Rho_0 in a Boussinesq model) in TR kg m-2. - real :: IG_Earth ! Inverse of gravitational acceleration, in s2 m-1. + ! (Rho_0 in a Boussinesq model) [TR kg m-2]. + real :: IG_Earth ! Inverse of gravitational acceleration [s2 m-1]. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 76111123cb..bf54d89deb 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -65,7 +65,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & !! for the purposes of calculating vertical modal structure. real, optional, intent(in) :: mono_N2_depth !< A depth below which N2 is limited as !! monotonic for the purposes of calculating vertical - !! modal structure, in m. + !! modal structure [m]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: modal_structure !< Normalized model structure (non-dim) diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 4fbcda9907..40e579b18a 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -93,7 +93,6 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - !! (usually m or kg m-2). type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: cn !< The (non-rotational) mode internal diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index e4375bda42..7d6fd2be60 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -161,8 +161,8 @@ module MOM_diag_mediator integer :: ied !< The end i-index of cell centers within the data domain integer :: jsd !< The start j-index of cell centers within the data domain integer :: jed !< The end j-index of cell centers within the data domain - real :: time_int !< The time interval in s for any fields - !! that are offered for averaging. + real :: time_int !< The time interval for any fields + !! that are offered for averaging [s]. type(time_type) :: time_end !< The end time of the valid !! interval for any offered field. logical :: ave_enabled = .false. !< True if averaging is enabled. @@ -1244,7 +1244,7 @@ end subroutine post_xy_average !> This subroutine enables the accumulation of time averages over the specified time interval. subroutine enable_averaging(time_int_in, time_end_in, diag_cs) - real, intent(in) :: time_int_in !< The time interval in s over which any + real, intent(in) :: time_int_in !< The time interval [s] over which any !! values that are offered are valid. type(time_type), intent(in) :: time_end_in !< The end time of the valid interval type(diag_ctrl), intent(inout) :: diag_CS !< Structure used to regulate diagnostic output @@ -1271,7 +1271,7 @@ end subroutine disable_averaging !! currently enabled. .true. is returned if it is. function query_averaging_enabled(diag_cs, time_int, time_end) type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output - real, optional, intent(out) :: time_int !< Current setting of diag%time_int, in s + real, optional, intent(out) :: time_int !< Current setting of diag%time_int [s] type(time_type), optional, intent(out) :: time_end !< Current setting of diag%time_end logical :: query_averaging_enabled diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 41035cbf66..c61d8acc36 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -39,10 +39,10 @@ module MOM_ice_shelf_dynamics !> The control structure for the ice shelf dynamics. type, public :: ice_shelf_dyn_CS ; private - real, pointer, dimension(:,:) :: u_shelf => NULL() !< the zonal (?) velocity of the ice shelf/sheet, - !! in meters per second??? on q-points (B grid) - real, pointer, dimension(:,:) :: v_shelf => NULL() !< the meridional velocity of the ice shelf/sheet, - !! in m/s ?? on q-points (B grid) + real, pointer, dimension(:,:) :: u_shelf => NULL() !< the zonal (?) velocity of the ice shelf/sheet + !! on q-points (B grid) [m s-1]?? + real, pointer, dimension(:,:) :: v_shelf => NULL() !< the meridional velocity of the ice shelf/sheet + !! on q-points (B grid) [m s-1]?? real, pointer, dimension(:,:) :: u_face_mask => NULL() !< mask for velocity boundary conditions on the C-grid !! u-face - this is because the FEM cares about FACES THAT GET INTEGRATED OVER, @@ -57,9 +57,9 @@ module MOM_ice_shelf_dynamics real, pointer, dimension(:,:) :: u_face_mask_bdry => NULL() !< A duplicate copy of u_face_mask? real, pointer, dimension(:,:) :: v_face_mask_bdry => NULL() !< A duplicate copy of v_face_mask? real, pointer, dimension(:,:) :: u_flux_bdry_val => NULL() !< The ice volume flux into the cell through open boundary - !! u-faces (where u_face_mask=4) [Z m2 s-1 ~> m3 s-1]??? + !! u-faces (where u_face_mask=4) [Z m2 s-1 ~> m3 s-1]?? real, pointer, dimension(:,:) :: v_flux_bdry_val => NULL() !< The ice volume flux into the cell through open boundary - !! v-faces (where v_face_mask=4) [Z m2 s-1 ~> m3 s-1]??? + !! v-faces (where v_face_mask=4) [Z m2 s-1 ~> m3 s-1]?? ! needed where u_face_mask is equal to 4, similary for v_face_mask real, pointer, dimension(:,:) :: umask => NULL() !< u-mask on the actual degrees of freedom (B grid) !! 1=normal node, 3=inhomogeneous boundary node, @@ -70,14 +70,14 @@ module MOM_ice_shelf_dynamics real, pointer, dimension(:,:) :: calve_mask => NULL() !< a mask to prevent the ice shelf front from !! advancing past its initial position (but it may retreat) real, pointer, dimension(:,:) :: t_shelf => NULL() !< Veritcally integrated temperature in the ice shelf/stream, - !! in degC on corner-points (B grid) + !! on corner-points (B grid) [degC] real, pointer, dimension(:,:) :: tmask => NULL() !< A mask on tracer points that is 1 where there is ice. - real, pointer, dimension(:,:) :: ice_visc => NULL() !< Glen's law ice viscosity, perhaps in m. + real, pointer, dimension(:,:) :: ice_visc => NULL() !< Glen's law ice viscosity, perhaps in [m]. real, pointer, dimension(:,:) :: thickness_bdry_val => NULL() !< The ice thickness at an inflowing boundary [Z ~> m]. - real, pointer, dimension(:,:) :: u_bdry_val => NULL() !< The zonal ice velocity at inflowing boundaries in m/s??? - real, pointer, dimension(:,:) :: v_bdry_val => NULL() !< The meridional ice velocity at inflowing boundaries in m/s??? - real, pointer, dimension(:,:) :: h_bdry_val => NULL() !< The ice thickness at inflowing boundaries, in m. - real, pointer, dimension(:,:) :: t_bdry_val => NULL() !< The ice temperature at inflowing boundaries, in deg C. + real, pointer, dimension(:,:) :: u_bdry_val => NULL() !< The zonal ice velocity at inflowing boundaries [m s-1]?? + real, pointer, dimension(:,:) :: v_bdry_val => NULL() !< The meridional ice velocity at inflowing boundaries [m s-1]?? + real, pointer, dimension(:,:) :: h_bdry_val => NULL() !< The ice thickness at inflowing boundaries [m]. + real, pointer, dimension(:,:) :: t_bdry_val => NULL() !< The ice temperature at inflowing boundaries [degC]. real, pointer, dimension(:,:) :: taub_beta_eff => NULL() !< nonlinear part of "linearized" basal stress. !! The exact form depends on basal law exponent and/or whether flow is "hybridized" a la Goldberg 2011 @@ -90,8 +90,8 @@ module MOM_ice_shelf_dynamics !### [if float_frac = 1 ==> grounded; obviously counterintuitive; might fix] integer :: OD_rt_counter = 0 !< A counter of the number of contributions to OD_rt. - real :: velocity_update_time_step !< The time in s to update the ice shelf velocity through the - !! nonlinear elliptic equation, or 0 to update every timestep. + real :: velocity_update_time_step !< The time interval over which to update the ice shelf velocity + !! using the nonlinear elliptic equation, or 0 to update every timestep [s]. ! DNGoldberg thinks this should be done no more often than about once a day ! (maybe longer) because it will depend on ocean values that are averaged over ! this time interval, and solving for the equiliabrated flow will begin to lose @@ -99,10 +99,10 @@ module MOM_ice_shelf_dynamics real :: elapsed_velocity_time !< The elapsed time since the ice velocies were last udated [s]. real :: g_Earth !< The gravitational acceleration [m s-2]. - real :: density_ice !< A typical density of ice, in kg m-3. + real :: density_ice !< A typical density of ice [kg m-3]. - logical :: GL_regularize !< whether to regularize the floatation condition - !! at the grounding line a la Goldberg Holland Schoof 2009 + logical :: GL_regularize !< Specifies whether to regularize the floatation condition + !! at the grounding line as in Goldberg Holland Schoof 2009 integer :: n_sub_regularize !< partition of cell over which to integrate for !! interpolated grounding line the (rectangular) is @@ -116,16 +116,16 @@ module MOM_ice_shelf_dynamics real :: CFL_factor !< A factor used to limit subcycled advective timestep in uncoupled runs !! i.e. dt <= CFL_factor * min(dx / u) - real :: A_glen_isothermal !< Ice viscosity parameter in Glen's Lawa, in Pa-1/3 a. + real :: A_glen_isothermal !< Ice viscosity parameter in Glen's Lawa, [Pa-1/3 year]. real :: n_glen !< Nonlinearity exponent in Glen's Law - real :: eps_glen_min !< Min. strain rate to avoid infinite Glen's law viscosity, in a-1. + real :: eps_glen_min !< Min. strain rate to avoid infinite Glen's law viscosity, [year-1]. real :: C_basal_friction !< Ceofficient in sliding law tau_b = C u^(n_basal_friction), in !! units="Pa (m-a)-(n_basal_friction) real :: n_basal_friction !< Exponent in sliding law tau_b = C u^(m_slide) - real :: density_ocean_avg !< this does not affect ocean circulation OR thermodynamics - !! it is to estimate the gravitational driving force at the - !! shelf front(until we think of a better way to do it- - !! but any difference will be negligible) + real :: density_ocean_avg !< This does not affect ocean circulation or thermodynamics. + !! It is used to estimate the gravitational driving force at the + !! shelf front (until we think of a better way to do it, + !! but any difference will be negligible). real :: thresh_float_col_depth !< The water column depth over which the shelf if considered to be floating logical :: moving_shelf_front !< Specify whether to advance shelf front (and calve). logical :: calve_to_mask !< If true, calve off the ice shelf when it passes the edge of a mask. @@ -138,7 +138,7 @@ module MOM_ice_shelf_dynamics integer :: cg_max_iterations !< The maximum number of iterations that can be used in the CG solver integer :: nonlin_solve_err_mode !< 1: exit vel solve based on nonlin residual !! 2: exit based on "fixed point" metric (|u - u_last| / |u| < tol where | | is infty-norm - logical :: use_reproducing_sums !< use new reproducing sums of Bob & Alistair for global sums. + logical :: use_reproducing_sums !< Use reproducing global sums. ! ids for outputting intermediate thickness in advection subroutine (debugging) !integer :: id_h_after_uflux = -1, id_h_after_vflux = -1, id_h_after_adv = -1 @@ -570,11 +570,11 @@ end subroutine initialize_diagnostic_fields !> This function returns the global maximum timestep that can be taken based on the current !! ice velocities. Because it involves finding a global minimum, it can be suprisingly expensive. function ice_time_step_CFL(CS, ISS, G) - type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure + type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe - !! the ice-shelf state - type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - real :: ice_time_step_CFL !< The maximum permitted timestep, in s, based on the ice velocities. + !! the ice-shelf state + type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. + real :: ice_time_step_CFL !< The maximum permitted timestep based on the ice velocities [s]. real :: ratio, min_ratio real :: local_u_max, local_v_max @@ -606,11 +606,11 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. type(unit_scale_type), intent(in) :: US !< Pointer to a structure containing unit conversion factors - real, intent(in) :: time_step !< time step in sec + real, intent(in) :: time_step !< time step [s] type(time_type), intent(in) :: Time !< The current model time real, dimension(SZDI_(G),SZDJ_(G)), & - optional, intent(in) :: ocean_mass !< If present this is the mass puer unit area - !! of the ocean in kg m-2. + optional, intent(in) :: ocean_mass !< If present this is the mass per unit area + !! of the ocean [kg m-2]. logical, optional, intent(in) :: coupled_grounding !< If true, the grounding line is !! determined by coupled ice-ocean dynamics logical, optional, intent(in) :: must_update_vel !< Always update the ice velocities if true. @@ -668,17 +668,11 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. - real, intent(in) :: time_step !< time step in sec + real, intent(in) :: time_step !< time step [s] type(time_type), intent(in) :: Time !< The current model time -! time_step: time step in sec ! 3/8/11 DNG -! Arguments: -! CS - A structure containing the ice shelf state - including current velocities -! h0 - an array containing the thickness at the beginning of the call -! h_after_uflux - an array containing the thickness after advection in u-direction -! h_after_vflux - similar ! ! This subroutine takes the velocity (on the Bgrid) and timesteps h_t = - div (uh) once. ! ADDITIONALLY, it will update the volume of ice in partially-filled cells, and update @@ -3483,19 +3477,10 @@ subroutine ice_shelf_temp(CS, ISS, G, US, time_step, melt_rate, Time) type(unit_scale_type), intent(in) :: US !< Pointer to a structure containing unit conversion factors real, intent(in) :: time_step !< The time step for this update [s]. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: melt_rate !< basal melt rate in kg/m^2/s + intent(in) :: melt_rate !< basal melt rate [kg m-2 s-1] type(time_type), intent(in) :: Time !< The current model time -! time_step: time step in sec -! melt_rate: basal melt rate in kg/m^2/s - ! 5/23/12 OVS -! Arguments: -! CS - A structure containing the ice shelf state - including current velocities -! t0 - an array containing temperature at the beginning of the call -! t_after_uflux - an array containing the temperature after advection in u-direction -! t_after_vflux - similar -! ! This subroutine takes the velocity (on the Bgrid) and timesteps ! (HT)_t = - div (uHT) + (adot Tsurf -bdot Tbot) once and then calculates T=HT/H ! diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 116d74859d..7681827628 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -73,7 +73,7 @@ module MOM_oda_driver_mod type(domain2d), pointer :: mpp_domain => NULL() !< Pointer to a mpp domain object for DA type(grid_type), pointer :: oda_grid !< local tracer grid - real, pointer, dimension(:,:,:) :: h => NULL() ! NULL() ! m or kg m-2] for DA type(thermo_var_ptrs), pointer :: tv => NULL() !< pointer to thermodynamic variables integer :: ni !< global i-direction grid size integer :: nj !< global j-direction grid size @@ -549,7 +549,7 @@ subroutine apply_oda_tracer_increments(dt,G,tv,h,CS) type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< layer thickness (m or kg/m2) + intent(in) :: h !< layer thickness [H ~> m or kg m-2] type(ODA_CS), intent(inout) :: CS !< the data assimilation structure end subroutine apply_oda_tracer_increments diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index f4b260469c..fea15385be 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -758,7 +758,7 @@ subroutine refract(En, cn, freq, dt, G, NAngle, use_PPMang) CFL_ang real :: f2 ! The squared Coriolis parameter [s-2]. real :: favg ! The average Coriolis parameter at a point [s-1]. - real :: df2_dy, df2_dx ! The x- and y- gradients of the squared Coriolis parameter, in s-2 m-1. + real :: df2_dy, df2_dx ! The x- and y- gradients of the squared Coriolis parameter [s-2 m-1]. real :: df_dy, df_dx ! The x- and y- gradients of the Coriolis parameter [s-1 m-1]. real :: dlnCn_dx ! The x-gradient of the wave speed divided by itself in m-1. real :: dlnCn_dy ! The y-gradient of the wave speed divided by itself in m-1. diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 121064062e..28ad7bc31f 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -389,8 +389,8 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & e ! The interface heights relative to mean sea level, in m. - real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: N2_u ! Square of Brunt-Vaisala freq at u-points, in s-2 - real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: N2_v ! Square of Brunt-Vaisala freq at v-points, in s-2 + real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: N2_u ! Square of Brunt-Vaisala freq at u-points [s-2] + real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: N2_v ! Square of Brunt-Vaisala freq at v-points [s-2] if (.not. associated(CS)) call MOM_error(FATAL, "MOM_lateral_mixing_coeffs.F90, calc_slope_functions:"//& "Module must be initialized before it is used.") @@ -431,7 +431,6 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) type(VarMix_CS), pointer :: CS !< Variable mixing coefficients ! Local variables - real :: Khth_Loc ! Locally calculated thickness mixing coefficient (m2/s) real :: S2 ! Interface slope squared (non-dim) real :: N2 ! Brunt-Vaisala frequency [s-1] real :: Hup, Hdn ! Thickness from above, below [H ~> m or kg m-2] @@ -585,7 +584,6 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop ! Local variables real :: E_x(SZIB_(G), SZJ_(G)) ! X-slope of interface at u points (for diagnostics) real :: E_y(SZI_(G), SZJB_(G)) ! Y-slope of interface at v points (for diagnostics) - real :: Khth_Loc ! Locally calculated thickness mixing coefficient (m2/s) real :: H_cutoff ! Local estimate of a minimum thickness for masking [H ~> m or kg m-2] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -722,7 +720,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) real :: KhTr_Slope_Cff, KhTh_Slope_Cff, oneOrTwo, N2_filter_depth real :: KhTr_passivity_coeff real, parameter :: absurdly_small_freq2 = 1e-34 ! A miniscule frequency - ! squared that is used to avoid division by 0, in s-2. This + ! squared that is used to avoid division by 0 [s-2]. This ! value is roughly (pi / (the age of the universe) )^2. logical :: Gill_equatorial_Ld, use_FGNV_streamfn, use_MEKE, in_use real :: MLE_front_length diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 722c755fa4..e8f16f89c2 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -94,12 +94,14 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness (H units = m or kg/m2) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux (m3 or kg) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux (m3 or kg) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux + !! [H m2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux + !! [H m2 ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: dt !< Time increment (sec) + real, intent(in) :: dt !< Time increment [s] real, dimension(:,:), pointer :: MLD !< Mixed layer depth provided by the !! PBL scheme [H ~> m or kg m-2] type(VarMix_CS), pointer :: VarMix !< Container for derived fields @@ -122,23 +124,24 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness (H units = m or kg/m2) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux (m3 or kg) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux (m3 or kg) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux + !! [H m2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux + !! [H m2 ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: dt !< Time increment (sec) + real, intent(in) :: dt !< Time increment [s] real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by the - !! PBL scheme, in m (not H) + !! PBL scheme [m] (not H) type(VarMix_CS), pointer :: VarMix !< Container for derived fields type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure ! Local variables - real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport (m3/s or kg/s) - real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport (m3/s or kg/s) + real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport [H m2 s-1 ~> m3 s-1 or kg s-1] + real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport [H m2 s-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & h_avail ! The volume available for diffusion out of each face of each - ! sublayer of the mixed layer, divided by dt, in units - ! of H * m2 s-1 (i.e., m3 s-1 or kg s-1). + ! sublayer of the mixed layer, divided by dt [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & MLD_fast, & ! Mixed layer depth actually used in MLE restratification parameterization [H ~> m or kg m-2] htot_fast, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] @@ -147,18 +150,18 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var htot_slow, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] Rml_av_slow ! g_Rho0 times the average mixed layer density [m s-2] real :: g_Rho0 ! G_Earth/Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1] - real :: rho_ml(SZI_(G)) ! Potential density relative to the surface (kg m-3) - real :: p0(SZI_(G)) ! A pressure of 0 (Pa) + real :: rho_ml(SZI_(G)) ! Potential density relative to the surface [kg m-3] + real :: p0(SZI_(G)) ! A pressure of 0 [Pa] real :: h_vel ! htot interpolated onto velocity points [Z ~> m] (not H). real :: absf ! absolute value of f, interpolated to velocity points [s-1] real :: u_star ! surface friction velocity, interpolated to velocity points [Z s-1 ~> m s-1]. real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [s-1] - real :: timescale ! mixing growth timescale (sec) + real :: timescale ! mixing growth timescale [s] real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected [H ~> m or kg m-2] real :: dz_neglect ! A tiny thickness that is usually lost in roundoff so can be neglected [Z ~> m] - real :: I4dt ! 1/(4 dt) (sec-1) - real :: Ihtot,Ihtot_slow! total mixed layer thickness + real :: I4dt ! 1/(4 dt) [s-1] + real :: Ihtot,Ihtot_slow! Inverses of the total mixed layer thickness [H-1 ~> m-1 or m2 kg-1] real :: a(SZK_(G)) ! A non-dimensional value relating the overall flux ! magnitudes (uDml & vDml) to the realized flux in a ! layer. The vertical sum of a() through the pieces of @@ -168,10 +171,9 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real :: vDml(SZI_(G)) ! half of the mixed layer [H m2 s-1 ~> m3 s-1 or kg s-1]. real :: uDml_slow(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper real :: vDml_slow(SZI_(G)) ! half of the mixed layer [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! restratification timescales - real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! in the zonal and meridional - ! directions, in s, stored in 2-D - ! arrays for diagnostic purposes. + real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! restratification timescales in the zonal and + real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! meridional directions [s], stored in 2-D arrays + ! for diagnostic purposes. real :: uDml_diag(SZIB_(G),SZJ_(G)), vDml_diag(SZI_(G),SZJB_(G)) integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz real, dimension(SZI_(G)) :: rhoSurf, deltaRhoAtKm1, deltaRhoAtK @@ -551,16 +553,18 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness (H units = m or kg/m2) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux (m3 or kg) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux (m3 or kg) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux + !! [H m2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux + !! [H m2 ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: dt !< Time increment (sec) + real, intent(in) :: dt !< Time increment [s] type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure ! Local variables - real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport (m3/s or kg/s) - real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport (m3/s or kg/s) + real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport [H m2 s-1 ~> m3 s-1 or kg s-1] + real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport [H m2 s-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & h_avail ! The volume available for diffusion out of each face of each ! sublayer of the mixed layer, divided by dt, in units diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index f90649c2c9..815e132846 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -847,7 +847,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] (in) - real, intent(in) :: dt !< The amount of time covered by this call, in s (in). + real, intent(in) :: dt !< The amount of time covered by this call [s]. type(ALE_sponge_CS), pointer :: CS !< A pointer to the control structure for this module !! that is set by a previous call to initialize_sponge (in). type(time_type), optional, intent(in) :: Time !< The current model date diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index b791011880..60672c9886 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -2470,7 +2470,7 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, & subroutine adiabatic(h, tv, fluxes, dt, G, GV, CS) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< thickness (m for Bouss or kg/m2 for non-Bouss) + intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields type(forcing), intent(inout) :: fluxes !< boundary fluxes real, intent(in) :: dt !< time step (seconds) @@ -2494,10 +2494,10 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< thickness (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: temp_old !< temperature prior to diabatic physics - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: saln_old !< salinity prior to diabatic physics (PPT) - real, intent(in) :: dt !< time step (sec) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: saln_old !< salinity prior to diabatic physics [ppt] + real, intent(in) :: dt !< time step [s] type(diabatic_CS), pointer :: CS !< module control structure ! Local variables @@ -2580,14 +2580,14 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< thickness after boundary flux application (m or kg/m2) + intent(in) :: h !< thickness after boundary flux application [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: temp_old !< temperature prior to boundary flux application + intent(in) :: temp_old !< temperature prior to boundary flux application [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: saln_old !< salinity prior to boundary flux application (PPT) + intent(in) :: saln_old !< salinity prior to boundary flux application [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_old !< thickness prior to boundary flux application (m or kg/m2) - real, intent(in) :: dt !< time step (sec) + intent(in) :: h_old !< thickness prior to boundary flux application [H ~> m or kg m-2] + real, intent(in) :: dt !< time step [s] type(diabatic_CS), pointer :: CS !< module control structure ! Local variables @@ -2676,9 +2676,9 @@ subroutine diagnose_frazil_tendency(tv, h, temp_old, dt, G, GV, CS) type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(diabatic_CS), pointer :: CS !< module control structure type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< thickness (m or kg/m2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: temp_old !< temperature prior to frazil formation - real, intent(in) :: dt !< time step (sec) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: temp_old !< temperature prior to frazil formation [degC] + real, intent(in) :: dt !< time step [s] real, dimension(SZI_(G),SZJ_(G)) :: work_2d real :: Idt diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index b6efc01c04..45dcca30c6 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -167,7 +167,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & Sh_b, & ! An effective salinity times a thickness in the layer below, ! including implicit mixing effects with other yet lower layers, in ppt H. dT_to_dPE, & ! Partial derivative of column potential energy with the temperature - dS_to_dPE, & ! and salinity changes within a layer, in J m-2 K-1 and J m-2 / (g kg-1). + dS_to_dPE, & ! and salinity changes within a layer [J m-2 degC-1] and J m-2 / (g kg-1). dT_to_dColHt, & ! Partial derivatives of the total column height with the temperature dS_to_dColHt, & ! and salinity changes within a layer [Z K-1 ~> m K-1] and [Z ppt-1 ~> m ppt-1]. dT_to_dColHt_a, & ! Partial derivatives of the total column height with the temperature @@ -197,9 +197,9 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & real, dimension(GV%ke+1) :: & pres, & ! Interface pressures in Pa. pres_Z, & ! Interface pressures with a rescaling factor to convert interface height - ! movements into changes in column potential energy, in J m-2 Z-1. + ! movements into changes in column potential energy [J m-2 Z-1 ~> J m-3]. z_Int, & ! Interface heights relative to the surface [H ~> m or kg m-2]. - N2, & ! An estimate of the buoyancy frequency in s-2. + N2, & ! An estimate of the buoyancy frequency [s-2]. Kddt_h, & ! The diapycnal diffusivity times a timestep divided by the ! average thicknesses around a layer [H ~> m or kg m-2]. Kddt_h_a, & ! The value of Kddt_h for layers above the central point in the @@ -211,9 +211,9 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & real, dimension(GV%ke+1,4) :: & PE_chg_k, & ! The integrated potential energy change within a timestep due ! to the diffusivity at interface K for 4 different orders of - ! accumulating the diffusivities, in J m-2. + ! accumulating the diffusivities [J m-2]. ColHt_cor_k ! The correction to the potential energy change due to - ! changes in the net column height, in J m-2. + ! changes in the net column height [J m-2]. real :: & b1 ! b1 is used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. real :: & @@ -232,12 +232,12 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & real :: dMKE_max ! The maximum amount of mean kinetic energy that could be ! converted to turbulent kinetic energy if the velocity in ! the layer below an interface were homogenized with all of - ! the water above the interface, in J m-2 = kg s-2. + ! the water above the interface [J m-2 = kg s-2]. real :: rho_here ! The in-situ density [kg m-3]. real :: PE_change ! The change in column potential energy from applying Kddt_h at the - ! present interface, in J m-2. + ! present interface [J m-2]. real :: ColHt_cor ! The correction to PE_chg that is made due to a net - ! change in the column height, in J m-2. + ! change in the column height [J m-2]. real :: htot ! A running sum of thicknesses [H ~> m or kg m-2]. real :: dTe_t2, dT_km1_t2, dT_k_t2 ! Temporary arrays describing temperature changes. real :: dSe_t2, dS_km1_t2, dS_k_t2 ! Temporary arrays describing salinity changes. @@ -997,22 +997,22 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real, intent(in) :: dT_to_dPE_a !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers above, in J m-2 K-1. + !! in the temperatures of all the layers above [J m-2 degC-1]. real, intent(in) :: dS_to_dPE_a !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers above, in J m-2 ppt-1. + !! in the salinities of all the layers above [J m-2 ppt-1]. real, intent(in) :: dT_to_dPE_b !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers below, in J m-2 K-1. + !! in the temperatures of all the layers below [J m-2 degC-1]. real, intent(in) :: dS_to_dPE_b !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers below, in J m-2 ppt-1. + !! in the salinities of all the layers below [J m-2 ppt-1]. real, intent(in) :: pres_Z !< The hydrostatic interface pressure, which is used to relate !! the changes in column thickness to the energy that is radiated - !! as gravity waves and unavailable to drive mixing, in J m-2 Z-1. + !! as gravity waves and unavailable to drive mixing [J m-2 Z-1 ~> J m-3]. real, intent(in) :: dT_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes @@ -1031,16 +1031,16 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & !! in the salinities of all the layers below [Z ppt-1 ~> m ppt-1]. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying - !! Kddt_h at the present interface, in J m-2. + !! Kddt_h at the present interface [J m-2]. real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h, !! [J m-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could !! be realizedd by applying a huge value of Kddt_h at the - !! present interface, in J m-2. + !! present interface [J m-2]. real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the !! limit where Kddt_h = 0 [J m-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: ColHt_cor !< The correction to PE_chg that is made due to a net - !! change in the column height, in J m-2. + !! change in the column height [J m-2]. real :: hps ! The sum of the two effective pivot thicknesses [H ~> m or kg m-2]. real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term [H2 ~> m2 or kg2 m-4]. @@ -1136,23 +1136,23 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & !! salinity change in the layer above the interface, in ppt. real, intent(in) :: pres_Z !< The hydrostatic interface pressure, which is used to relate !! the changes in column thickness to the energy that is radiated - !! as gravity waves and unavailable to drive mixing, in J m-2 Z-1. + !! as gravity waves and unavailable to drive mixing [J m-2 Z-1 ~> J m-3]. real, intent(in) :: dT_to_dPE_k !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers below, in J m-2 K-1. + !! in the temperatures of all the layers below [J m-2 degC-1]. real, intent(in) :: dS_to_dPE_k !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers below, in J m-2 ppt-1. + !! in the salinities of all the layers below [J m-2 ppt-1]. real, intent(in) :: dT_to_dPEa !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers above, in J m-2 K-1. + !! in the temperatures of all the layers above [J m-2 degC-1]. real, intent(in) :: dS_to_dPEa !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers above, in J m-2 ppt-1. + !! in the salinities of all the layers above [J m-2 ppt-1]. real, intent(in) :: dT_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes @@ -1171,12 +1171,12 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & !! in the salinities of all the layers above [Z ppt-1 ~> m ppt-1]. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying - !! Kddt_h at the present interface, in J m-2. + !! Kddt_h at the present interface [J m-2]. real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h, !! [J m-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could - !! be realizedd by applying a huge value of Kddt_h at the - !! present interface, in J m-2. + !! be realized by applying a huge value of Kddt_h at the + !! present interface [J m-2]. real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the !! limit where Kddt_h = 0 [J m-2 H-1 ~> J m-3 or J kg-1]. @@ -1190,16 +1190,16 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & ! reversed. real :: b1 ! b1 is used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. - real :: b1Kd ! Temporary array (nondim.) - real :: ColHt_chg ! The change in column thickness in m. - real :: dColHt_max ! The change in column thickness for infinite diffusivity, in m. - real :: dColHt_dKd ! The partial derivative of column thickness with diffusivity, in s m-1. - real :: dT_k, dT_km1 ! Temporary arrays in K. - real :: dS_k, dS_km1 ! Temporary arrays in ppt. + real :: b1Kd ! Temporary array [nondim] + real :: ColHt_chg ! The change in column thickness [Z ~> m]. + real :: dColHt_max ! The change in column thickness for infinite diffusivity [Z ~> m]. + real :: dColHt_dKd ! The partial derivative of column thickness with diffusivity [s Z-1 ~> s m-1]. + real :: dT_k, dT_km1 ! Temporary arrays [degC]. + real :: dS_k, dS_km1 ! Temporary arrays [ppt]. real :: I_Kr_denom ! Temporary arrays [H-2 ~> m-2 or m4 kg-2]. - real :: dKr_dKd ! Nondimensional temporary array. - real :: ddT_k_dKd, ddT_km1_dKd ! Temporary arrays in K H-1. - real :: ddS_k_dKd, ddS_km1_dKd ! Temporary arrays in ppt H-1. + real :: dKr_dKd ! Nondimensional temporary array [nondim]. + real :: ddT_k_dKd, ddT_km1_dKd ! Temporary arrays [degC H-1 ~> m-1 or m2 kg-1]. + real :: ddS_k_dKd, ddS_km1_dKd ! Temporary arrays [ppt H-1 ~> ppt m-1 or ppt m2 kg-1]. b1 = 1.0 / (b_den_1 + Kddt_h) b1Kd = Kddt_h*b1 diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 40884ca01f..43294f6538 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -143,13 +143,13 @@ module MOM_energetic_PBL ! These are terms in the mixed layer TKE budget, all in J m-2 = kg s-2. real, allocatable, dimension(:,:) :: & - diag_TKE_wind, & !< The wind source of TKE, in J m-2. - diag_TKE_MKE, & !< The resolved KE source of TKE, in J m-2. - diag_TKE_conv, & !< The convective source of TKE, in J m-2. - diag_TKE_forcing, & !< The TKE sink required to mix surface penetrating shortwave heating, in J m-2. - diag_TKE_mech_decay, & !< The decay of mechanical TKE, in J m-2. - diag_TKE_conv_decay, & !< The decay of convective TKE, in J m-2. - diag_TKE_mixing,& !< The work done by TKE to deepen the mixed layer, in J m-2. + diag_TKE_wind, & !< The wind source of TKE [J m-2]. + diag_TKE_MKE, & !< The resolved KE source of TKE [J m-2]. + diag_TKE_conv, & !< The convective source of TKE [J m-2]. + diag_TKE_forcing, & !< The TKE sink required to mix surface penetrating shortwave heating [J m-2]. + diag_TKE_mech_decay, & !< The decay of mechanical TKE [J m-2]. + diag_TKE_conv_decay, & !< The decay of convective TKE [J m-2]. + diag_TKE_mixing,& !< The work done by TKE to deepen the mixed layer [J m-2]. ! Additional output parameters also 2d ML_depth, & !< The mixed layer depth [Z ~> m]. (result after iteration step) ML_depth2, & !< The mixed layer depth [Z ~> m]. (guess for iteration step) @@ -207,7 +207,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: TKE_forced !< The forcing requirements to homogenize the !! forcing that has been applied to each layer - !! through each layer, in J m-2. + !! through each layer [J m-2]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. @@ -273,20 +273,20 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS Kd, & ! The diapycnal diffusivity, in m2 s-1. pres, & ! Interface pressures in Pa. pres_Z, & ! Interface pressures with a rescaling factor to convert interface height - ! movements into changes in column potential energy, in J m-2 Z-1. + ! movements into changes in column potential energy [J m-2 Z-1 ~> J m-3]. hb_hs ! The distance from the bottom over the thickness of the ! water column [nondim]. real, dimension(SZI_(G)) :: & mech_TKE, & ! The mechanically generated turbulent kinetic energy - ! available for mixing over a time step, in J m-2 = kg s-2. + ! available for mixing over a time step [J m-2 = kg s-2]. conv_PErel, & ! The potential energy that has been convectively released - ! during this timestep, in J m-2 = kg s-2. A portion nstar_FC + ! during this timestep [J m-2 = kg s-2]. A portion nstar_FC ! of conv_PErel is available to drive mixing. htot, & ! The total depth of the layers above an interface [H ~> m or kg m-2]. uhtot, & ! The depth integrated zonal and meridional velocities in the vhtot, & ! layers above [H m s-1 ~> m2 s-1 or kg m-1 s-1]. - mech_TKE_top, & ! The value of mech_TKE at the top of the column, in J m-2. - conv_PErel_top, & ! The value of conv_PErel at the top of the column, in J m-2. + mech_TKE_top, & ! The value of mech_TKE at the top of the column [J m-2]. + conv_PErel_top, & ! The value of conv_PErel at the top of the column [J m-2]. Idecay_len_TKE, & ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. h_sum, & ! The total thickness of the water column [H ~> m or kg m-2]. @@ -337,7 +337,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: dMKE_max ! The maximum amount of mean kinetic energy that could be ! converted to turbulent kinetic energy if the velocity in ! the layer below an interface were homogenized with all of - ! the water above the interface, in J m-2 = kg s-2. + ! the water above the interface [J m-2 = kg s-2]. real :: MKE2_Hharm ! Twice the inverse of the harmonic mean of the thickness ! of a layer and the thickness of the water above, used in ! the MKE conversion equation [H-1 ~> m-1 or m2 kg-1]. @@ -368,8 +368,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: nstar_FC ! The fraction of conv_PErel that can be converted to mixing [nondim]. real :: TKE_reduc ! The fraction by which TKE and other energy fields are ! reduced to support mixing [nondim]. between 0 and 1. - real :: tot_TKE ! The total TKE available to support mixing at interface K, in J m-2. - real :: TKE_here ! The total TKE at this point in the algorithm, in J m-2. + real :: tot_TKE ! The total TKE available to support mixing at interface K [J m-2]. + real :: TKE_here ! The total TKE at this point in the algorithm [J m-2]. real :: dT_km1_t2 ! A diffusivity-independent term related to the temperature ! change in the layer above the interface, in K. real :: dS_km1_t2 ! A diffusivity-independent term related to the salinity @@ -380,8 +380,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! change in the layer above the interface, in ppt H. real :: dTe_t2 ! A part of dTe_term, in K H. real :: dSe_t2 ! A part of dSe_term, in ppt H. - real :: dPE_conv ! The convective change in column potential energy, in J m-2. - real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K), in J m-2. + real :: dPE_conv ! The convective change in column potential energy [J m-2]. + real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K) [J m-2]. real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K) [J m-2 H-1 ~> J m-3 or J kg-1]. real :: Kd_guess0 ! A first guess of the diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 @@ -392,10 +392,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: dPEc_dKd_Kd0 ! The partial derivative of PE change with Kddt_h(K) ! for very small values of Kddt_h(K) [J m-2 H-1 ~> J m-3 or J kg-1]. real :: PE_chg ! The change in potential energy due to mixing at an - ! interface, in J m-2, positive for the column increasing + ! interface [J m-2], positive for the column increasing ! in potential energy (i.e., consuming TKE). real :: TKE_left ! The amount of turbulent kinetic energy left for the most - ! recent guess at Kddt_h(K), in J m-2. + ! recent guess at Kddt_h(K) [J m-2]. real :: dPEc_dKd ! The partial derivative of PE_chg with Kddt_h(K) [J m-2 H-1 ~> J m-3 or J kg-1]. real :: TKE_left_min, TKE_left_max, Kddt_h_max, Kddt_h_min real :: Kddt_h_guess ! A guess at the value of Kddt_h(K) [H ~> m or kg m-2]. @@ -419,7 +419,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS Hsfc_used ! The thickness of the surface region [Z ~> m]. logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. - ! Local column copies of energy change diagnostics, all in J m-2. + ! Local column copies of energy change diagnostics, all [J m-2]. real :: dTKE_conv, dTKE_forcing, dTKE_mixing real :: dTKE_MKE, dTKE_mech_decay, dTKE_conv_decay !---------------------------------------------------------------------- @@ -1584,22 +1584,22 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real, intent(in) :: dT_to_dPE_a !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers above, in J m-2 K-1. + !! in the temperatures of all the layers above [J m-2 degC-1]. real, intent(in) :: dS_to_dPE_a !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers above, in J m-2 ppt-1. + !! in the salinities of all the layers above [J m-2 ppt-1]. real, intent(in) :: dT_to_dPE_b !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers below, in J m-2 K-1. + !! in the temperatures of all the layers below [J m-2 degC-1]. real, intent(in) :: dS_to_dPE_b !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers below, in J m-2 ppt-1. + !! in the salinities of all the layers below [J m-2 ppt-1]. real, intent(in) :: pres_Z !< The rescaled hydrostatic interface pressure, which relates !! the changes in column thickness to the energy that is radiated - !! as gravity waves and unavailable to drive mixing, in J m-2 Z-1. + !! as gravity waves and unavailable to drive mixing [J m-2 Z-1 ~> J m-3]. real, intent(in) :: dT_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes @@ -1618,16 +1618,16 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & !! in the salinities of all the layers below [Z ppt-1 ~> m ppt-1]. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying - !! Kddt_h at the present interface, in J m-2. + !! Kddt_h at the present interface [J m-2]. real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h !! [J m-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could !! be realizedd by applying a huge value of Kddt_h at the - !! present interface, in J m-2. + !! present interface [J m-2]. real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the !! limit where Kddt_h = 0 [J m-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: ColHt_cor !< The correction to PE_chg that is made due to a net - !! change in the column height, in J m-2. + !! change in the column height [J m-2]. real :: hps ! The sum of the two effective pivot thicknesses [H ~> m or kg m-2]. real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term [H2 ~> m2 or kg2 m-4]. @@ -1722,23 +1722,23 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & !! salinity change in the layer above the interface, in ppt. real, intent(in) :: pres_Z !< The rescaled hydrostatic interface pressure, which relates !! the changes in column thickness to the energy that is radiated - !! as gravity waves and unavailable to drive mixing, in J m-2 Z-1. + !! as gravity waves and unavailable to drive mixing [J m-2 Z-1 ~> J m-3]. real, intent(in) :: dT_to_dPE_k !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers below, in J m-2 K-1. + !! in the temperatures of all the layers below [J m-2 degC-1]. real, intent(in) :: dS_to_dPE_k !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers below, in J m-2 ppt-1. + !! in the salinities of all the layers below [J m-2 ppt-1]. real, intent(in) :: dT_to_dPEa !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers above, in J m-2 K-1. + !! in the temperatures of all the layers above [J m-2 degC-1]. real, intent(in) :: dS_to_dPEa !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating !! a layer's salinity change to the change in column !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers above, in J m-2 ppt-1. + !! in the salinities of all the layers above [J m-2 ppt-1]. real, intent(in) :: dT_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes @@ -1757,12 +1757,12 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & !! in the salinities of all the layers above [Z ppt-1 ~> m ppt-1]. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying - !! Kddt_h at the present interface, in J m-2. + !! Kddt_h at the present interface [J m-2]. real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h !! [J m-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could !! be realizedd by applying a huge value of Kddt_h at the - !! present interface, in J m-2. + !! present interface [J m-2]. real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the !! limit where Kddt_h = 0 [J m-2 H-1 ~> J m-3 or J kg-1]. @@ -1777,15 +1777,15 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & real :: b1 ! b1 is used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. real :: b1Kd ! Temporary array (nondim.) - real :: ColHt_chg ! The change in column thickness in m. - real :: dColHt_max ! The change in column thickness for infinite diffusivity, in m. - real :: dColHt_dKd ! The partial derivative of column thickness with diffusivity, in s m-1. - real :: dT_k, dT_km1 ! Temporary arrays in K. - real :: dS_k, dS_km1 ! Temporary arrays in ppt. + real :: ColHt_chg ! The change in column thickness [Z ~> m]. + real :: dColHt_max ! The change in column thickness for infinite diffusivity [Z ~> m]. + real :: dColHt_dKd ! The partial derivative of column thickness with diffusivity [s Z-1 ~> s m-1]. + real :: dT_k, dT_km1 ! Temporary arrays [degC]. + real :: dS_k, dS_km1 ! Temporary arrays [ppt]. real :: I_Kr_denom ! Temporary array [H-2 ~> m-2 or m4 kg-2] real :: dKr_dKd ! Nondimensional temporary array. - real :: ddT_k_dKd, ddT_km1_dKd ! Temporary arrays in K H-1. - real :: ddS_k_dKd, ddS_km1_dKd ! Temporary arrays in ppt H-1. + real :: ddT_k_dKd, ddT_km1_dKd ! Temporary arrays [degC H-1 ~> m-1 or m2 kg-1]. + real :: ddS_k_dKd, ddS_km1_dKd ! Temporary arrays [ppt H-1 ~> ppt m-1 or ppt m2 kg-1]. b1 = 1.0 / (b_den_1 + Kddt_h) b1Kd = Kddt_h*b1 diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index ce34cfada0..5f00086e17 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -76,7 +76,7 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) type(int_tide_input_CS), pointer :: CS !< This module's control structure. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - N2_bot ! The bottom squared buoyancy frequency, in s-2. + N2_bot ! The bottom squared buoyancy frequency [s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & T_f, S_f ! The temperature and salinity in [degC] and [ppt] with the values in @@ -140,7 +140,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes type(int_tide_input_CS), pointer :: CS !< This module's control structure. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: N2_bot !< The squared buoyancy freqency at the - !! ocean bottom, in s-2. + !! ocean bottom [s-2]. ! Local variables real, dimension(SZI_(G),SZK_(G)+1) :: & dRho_int ! The unfiltered density differences across interfaces. diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index d687f5cf57..b4eab1c9ea 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -1433,7 +1433,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! solved for [m2 s-2]. real :: kappa0 ! The background diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. real :: max_err ! The maximum value of norm_err in a column [nondim]. - real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0, Z2 s-1. + real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0 [Z2 s-1 ~> m2 s-1]. real :: eden1, eden2, I_eden, ome ! Variables used in calculating e1. real :: diffusive_src ! The diffusive source in the kappa equation [m s-1]. @@ -1446,11 +1446,11 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! Temporary variables used in the Newton's method iterations. real :: decay_term_k ! The decay term in the diffusivity equation real :: decay_term_Q ! The decay term in the TKE equation - real :: I_Q ! The inverse of TKE, in s2 m-2 + real :: I_Q ! The inverse of TKE [s2 m-2] real :: kap_src real :: v1, v2 real :: Z2_to_L2 ! A conversion factor from vertical depth units to horizontal length - ! units squared, in m2 Z-2. + ! units squared [m2 Z-2]. real :: tol_err ! The tolerance for max_err that determines when to ! stop iterating. real :: Newton_err ! The tolerance for max_err that determines when to diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index b318f6a923..714a58e238 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -671,7 +671,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: dRho_int !< Change in locally referenced potential density !! across each interface [kg m-3]. real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< The squared buoyancy frequency of the - !! layers, in s-2. + !! layers [s-2]. integer, intent(in) :: j !< j-index of row to work on real, intent(in) :: dt !< Time increment (sec). type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure @@ -885,10 +885,10 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & intent(out) :: dRho_int !< Change in locally referenced potential density !! across each interface [kg m-3]. real, dimension(SZI_(G),SZK_(G)+1), & - intent(out) :: N2_int !< The squared buoyancy frequency at the interfaces, in s-2. + intent(out) :: N2_int !< The squared buoyancy frequency at the interfaces [s-2]. real, dimension(SZI_(G),SZK_(G)), & - intent(out) :: N2_lay !< The squared buoyancy frequency of the layers, in s-2. - real, dimension(SZI_(G)), intent(out) :: N2_bot !< The near-bottom squared buoyancy frequency, in s-2. + intent(out) :: N2_lay !< The squared buoyancy frequency of the layers [s-2]. + real, dimension(SZI_(G)), intent(out) :: N2_bot !< The near-bottom squared buoyancy frequency [s-2]. ! Local variables real, dimension(SZI_(G),SZK_(G)+1) :: & dRho_int_unfilt, & ! unfiltered density differences across interfaces @@ -1554,12 +1554,12 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, real, dimension(SZI_(G)) :: I_decay ! A decay rate [Z-1 ~> m-1]. real, dimension(SZI_(G)) :: Kd_mlr_ml ! Diffusivities associated with mixed layer radiation [Z2 s-1 ~> m2 s-1]. - real :: f_sq ! The square of the local Coriolis parameter or a related variable, in s-2. + real :: f_sq ! The square of the local Coriolis parameter or a related variable [s-2]. real :: h_ml_sq ! The square of the mixed layer thickness [Z2 ~> m2]. real :: ustar_sq ! ustar squared [Z2 s-2 ~> m2 s-2] real :: Kd_mlr ! A diffusivity associated with mixed layer turbulence radiation [Z2 s-1 ~> m2 s-1]. real :: C1_6 ! 1/6 - real :: Omega2 ! rotation rate squared, in s-2. + real :: Omega2 ! rotation rate squared [s-2]. real :: z1 ! layer thickness times I_decay (nondim) real :: dzL ! thickness converted to heights [Z ~> m]. real :: I_decay_len2_TKE ! squared inverse decay lengthscale for diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index af2733136a..b0e59346e4 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -660,11 +660,11 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, C real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy - !! frequency, in s-2. + !! frequency [s-2]. real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< The squared buoyancy frequency of the - !! layers, in s-2. + !! layers [s-2]. real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: N2_int !< The squared buoyancy frequency at the - !! interfaces, in s-2. + !! interfaces [s-2]. integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the @@ -706,7 +706,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tidal_mixing_cs), pointer :: CS !< This module's control structure. real, dimension(SZI_(G),SZK_(G)+1), intent(in) :: N2_int !< The squared buoyancy - !! frequency at the interfaces, in s-2. + !! frequency at the interfaces [s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -932,9 +932,9 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy frequency - !! frequency, in s-2. + !! frequency [s-2]. real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< The squared buoyancy frequency of the - !! layers, in s-2. + !! layers [s-2]. integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G),SZK_(G)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the @@ -1068,7 +1068,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, do i=is,ie CS%Nb(i,j) = sqrt(N2_bot(i)) - !### In the code below 1.0e-14 is a dimensional constant in s-3 + !### In the code below 1.0e-14 is a dimensional constant in [s-3] if ((CS%tideamp(i,j) > 0.0) .and. & (CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14) ) then z0_polzin(i) = US%m_to_Z * CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index b89dc8a280..178eeff516 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -155,7 +155,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces type(vertvisc_type), intent(inout) :: visc !< Viscosities and bottom drag - real, intent(in) :: dt !< Time increment in s + real, intent(in) :: dt !< Time increment [s] type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure type(accel_diag_ptrs), intent(inout) :: ADp !< Accelerations in the momentum !! equations for diagnostics @@ -467,7 +467,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) intent(inout) :: visc_rem_v !< Fraction of a time-step's worth of a !! barotopic acceleration that a layer experiences after !! viscosity is applied in the meridional direction [nondim] - real, intent(in) :: dt !< Time increment in s + real, intent(in) :: dt !< Time increment [s] type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure ! Local variables @@ -574,7 +574,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces type(vertvisc_type), intent(in) :: visc !< Viscosities and bottom drag - real, intent(in) :: dt !< Time increment in s + real, intent(in) :: dt !< Time increment [s] type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure @@ -1054,7 +1054,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, !! normalized by the bottom boundary layer thickness real, dimension(SZIB_(G)), intent(out) :: h_ml !< Mixed layer depth [H ~> m or kg m-2] integer, intent(in) :: j !< j-index to find coupling coefficient for - real, intent(in) :: dt !< Time increment, in s + real, intent(in) :: dt !< Time increment [s] type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure type(vertvisc_type), intent(in) :: visc !< Structure containing viscosities and bottom drag type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces @@ -1363,7 +1363,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS type(cont_diag_ptrs), intent(in) :: CDp !< Continuity diagnostic pointers type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces type(vertvisc_type), intent(in) :: visc !< Viscosities and bottom drag - real, intent(in) :: dt !< Time increment in s + real, intent(in) :: dt !< Time increment [s] type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure ! Local variables @@ -1372,7 +1372,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS real :: truncvel ! are truncated to truncvel, both [m s-1]. real :: CFL ! The local CFL number. real :: H_report ! A thickness below which not to report truncations. - real :: dt_Rho0 ! The timestep divided by the Boussinesq density, in dt m3 kg-1. + real :: dt_Rho0 ! The timestep divided by the Boussinesq density [s m3 kg-1]. real :: vel_report(SZIB_(G),SZJB_(G)) real :: u_old(SZIB_(G),SZJ_(G),SZK_(G)) real :: v_old(SZI_(G),SZJB_(G),SZK_(G)) diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 80b56aad6c..34fbde08c7 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -291,20 +291,20 @@ subroutine DOME_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. + intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. + intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be - !! added, in m or kg m-2. + !! added [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be - !! added, in m or kg m-2. + !! added [H ~> m or kg m-2]. type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic !! and tracer forcing fields. Unused fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call, in s + real, intent(in) :: dt !< The amount of time covered by this call [s] type(DOME_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to DOME_register_tracer. real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can @@ -346,7 +346,7 @@ subroutine DOME_tracer_surface_state(state, h, G, CS) type(surface), intent(inout) :: state !< A structure containing fields that !! describe the surface state of the ocean. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thickness, in m or kg m-2. + intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(DOME_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to DOME_register_tracer. diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index e4449aec8f..2096157a41 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -153,7 +153,7 @@ subroutine initialize_ISOMIP_tracer(restart, day, G, GV, h, diag, OBC, CS, & logical, intent(in) :: restart !< .true. if the fields have already !! been read from a restart file. type(time_type), target, intent(in) :: day !< Time of the start of the run. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies @@ -255,20 +255,20 @@ subroutine ISOMIP_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, G type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. + intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. + intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be - !! added, in m or kg m-2. + !! added [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be - !! added, in m or kg m-2. + !! added [H ~> m or kg m-2]. type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic !! and tracer forcing fields. Unused fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call, in s + real, intent(in) :: dt !< The amount of time covered by this call [s] type(ISOMIP_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to ISOMIP_register_tracer. real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can @@ -335,7 +335,7 @@ subroutine ISOMIP_tracer_surface_state(state, h, G, CS) type(surface), intent(inout) :: state !< A structure containing fields that !! describe the surface state of the ocean. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thickness, in m or kg m-2. + intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(ISOMIP_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to ISOMIP_register_tracer. diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index ee558399b9..9a2ba54ba3 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -318,8 +318,7 @@ subroutine initialize_OCMIP2_CFC(restart, day, G, GV, US, h, diag, OBC, CS, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - !! (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type @@ -411,20 +410,20 @@ subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. + intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. + intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be - !! added, in m or kg m-2. + !! added [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be - !! added, in m or kg m-2. + !! added [H ~> m or kg m-2]. type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic !! and tracer forcing fields. Unused fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call, in s + real, intent(in) :: dt !< The amount of time covered by this call [s] type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a !! previous call to register_OCMIP2_CFC. real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can @@ -496,8 +495,7 @@ function OCMIP2_CFC_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - !! (usually m or kg m-2). + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount !! of each tracer, in kg times !! concentration units. @@ -548,7 +546,7 @@ subroutine OCMIP2_CFC_surface_state(state, h, G, CS) type(surface), intent(inout) :: state !< A structure containing fields that !! describe the surface state of the ocean. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thickness, in m or kg m-2. + intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a previous !! call to register_OCMIP2_CFC. diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index f59f76fd21..50ba29367d 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -440,19 +440,19 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. + intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. + intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: ea !< The amount of fluid entrained from the layer - !! above during this call, in m or kg m-2. + !! above during this call [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: eb !< The amount of fluid entrained from the layer - !! below during this call, in m or kg m-2. + !! below during this call [H ~> m or kg m-2]. type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic !! and tracer forcing fields. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Hml !< Mixed layer depth - real, intent(in) :: dt !< The amount of time covered by this call, in s + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Hml !< Mixed layer depth [H ~> m or kg m-2] + real, intent(in) :: dt !< The amount of time covered by this call [s] type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables type(optics_type), intent(in) :: optics !< The structure containing optical properties. @@ -463,7 +463,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, ! The arguments to this subroutine are redundant in that ! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) -! Local variables + ! Local variables character(len=fm_string_len), parameter :: sub_name = 'MOM_generic_tracer_column_physics' type(g_tracer_type), pointer :: g_tracer, g_tracer_next diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index bb8b483f5f..5b395d4a58 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -112,8 +112,8 @@ module MOM_offline_main integer :: num_off_iter !< Number of advection iterations per offline step integer :: num_vert_iter !< Number of vertical iterations per offline step integer :: off_ale_mod !< Sets how frequently the ALE step is done during the advection - real :: dt_offline !< Timestep used for offline tracers - real :: dt_offline_vertical !< Timestep used for calls to tracer vertical physics + real :: dt_offline !< Timestep used for offline tracers [s] + real :: dt_offline_vertical !< Timestep used for calls to tracer vertical physics [s] real :: evap_CFL_limit !< Copied from diabatic_CS controlling how tracers follow freshwater fluxes real :: minimum_forcing_depth !< Copied from diabatic_CS controlling how tracers follow freshwater fluxes real :: Kd_max !< Runtime parameter specifying the maximum value of vertical diffusivity @@ -205,7 +205,8 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock type(offline_transport_CS), pointer :: CS !< control structure for offline module integer, intent(in) :: id_clock_ALE !< Clock for ALE routines real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), & - intent(inout) :: h_pre !< layer thicknesses before advection in m or kg m-2 + intent(inout) :: h_pre !< layer thicknesses before advection + !! [H ~> m or kg m-2] real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)), & intent(inout) :: uhtr !< Zonal mass transport in m3 or kg real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)), & @@ -646,7 +647,7 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, e type(time_type), intent(in) :: Time_end !< time interval type(offline_transport_CS), pointer :: CS !< control structure from initialize_MOM real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), & - intent(inout) :: h_pre !< layer thicknesses before advection in m or kg m-2 + intent(inout) :: h_pre !< layer thicknesses before advection [H ~> m or kg m-2] real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), & intent(inout) :: eatr !< Entrainment from layer above in m or kg-2 real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), & @@ -1186,18 +1187,20 @@ subroutine extract_offline_main(CS, uhtr, vhtr, eatr, ebtr, h_end, accumulated_t dt_offline, dt_offline_vertical, skip_diffusion) type(offline_transport_CS), target, intent(in ) :: CS !< Offline control structure ! Returned optional arguments - real, dimension(:,:,:), optional, pointer :: uhtr !< Remaining zonal mass transport - real, dimension(:,:,:), optional, pointer :: vhtr !< Remaining meridional mass transport + real, dimension(:,:,:), optional, pointer :: uhtr !< Remaining zonal mass transport [H m2 ~> m3 or kg] + real, dimension(:,:,:), optional, pointer :: vhtr !< Remaining meridional mass transport [H m2 ~> m3 or kg] real, dimension(:,:,:), optional, pointer :: eatr !< Amount of fluid entrained from the layer above within - !! one time step (m for Bouss, kg/m^2 for non-Bouss) + !! one time step [H ~> m or kg m-2] real, dimension(:,:,:), optional, pointer :: ebtr !< Amount of fluid entrained from the layer below within - !! one time step (m for Bouss, kg/m^2 for non-Bouss) - real, dimension(:,:,:), optional, pointer :: h_end !< Thicknesses at the end of offline timestep in m or kg m-2 + !! one time step [H ~> m or kg m-2] + real, dimension(:,:,:), optional, pointer :: h_end !< Thicknesses at the end of offline timestep + !! [H ~> m or kg m-2] + !### Why are the following variables integers? integer, optional, pointer :: accumulated_time !< Length of time accumulated in the - !! current offline interval - integer, optional, intent( out) :: dt_offline !< Timestep used for offline tracers + !! current offline interval [s] + integer, optional, intent( out) :: dt_offline !< Timestep used for offline tracers [s] integer, optional, intent( out) :: dt_offline_vertical !< Timestep used for calls to tracer - !! vertical physics + !! vertical physics [s] logical, optional, intent( out) :: skip_diffusion !< Skips horizontal diffusion of tracers ! Pointers to 3d members diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index b1f5c8cdae..dd44fb15b2 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -66,7 +66,7 @@ function tracer_Z_init(tr, h, filename, tr_name, G, US, missing_val, land_val) real :: landval ! The tracer value to use in land points. real :: sl_tr ! The normalized slope of the tracer ! within the cell, in tracer units. - real :: htot(SZI_(G)) ! The vertical sum of h, in m or kg m-2. + real :: htot(SZI_(G)) ! The vertical sum of h [H ~> m or kg m-2]. real :: dilate ! The amount by which the thicknesses are dilated to ! create a z-star coordinate, nondim or in m3 kg-1. real :: missing ! The missing value for the tracer. diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index fab0990c4e..0a61bd173b 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -366,7 +366,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & hlst, Ihnew, & ! Work variables with units of [H m2 ~> m3 or kg] and [H-1 m-2 ~> m-3 or kg-1]. CFL ! A nondimensional work variable. real :: min_h ! The minimum thickness that can be realized during - ! any of the passes, in m or kg m-2. + ! any of the passes [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in m. logical :: do_i(SZIB_(G)) ! If true, work on given points. diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index e7684d12fb..a27bb56fcd 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -32,40 +32,37 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & !! above [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: eb !< amount of fluid entrained from the layer !! below [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: tr !< tracer concentration (in concentration units CU) - real, intent(in) :: dt !< amount of time covered by this call (seconds) - real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: sfc_flux !< surface flux of the tracer in units - !! of (CU * kg m-2 s-1) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: tr !< tracer concentration in concentration units [CU] + real, intent(in) :: dt !< amount of time covered by this call [s] + real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: sfc_flux !< surface flux of the tracer [CU kg m-2 s-1] real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: btm_flux !< The (negative upward) bottom flux of the - !! tracer, in units of (CU * kg m-2 s-1) + !! tracer [CU kg m-2 s-1] real, dimension(SZI_(G),SZJ_(G)), optional,intent(inout) :: btm_reservoir !< amount of tracer in a bottom reservoir - !! (units of CU kg m-2; formerly CU m) + !! [CU kg m-2]; formerly [CU m] real, optional,intent(in) :: sink_rate !< rate at which the tracer sinks [m s-1] logical, optional,intent(in) :: convert_flux_in !< True if the specified sfc_flux needs !! to be integrated in time ! local variables - real :: sink_dist !< The distance the tracer sinks in a time step, in m or kg m-2. + real :: sink_dist !< The distance the tracer sinks in a time step [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)) :: & - sfc_src, & !< The time-integrated surface source of the tracer, in - !! units of m or kg m-2 times a concentration. - btm_src !< The time-integrated bottom source of the tracer, in - !! units of m or kg m-2 times a concentration. + sfc_src, & !< The time-integrated surface source of the tracer [CU H ~> CU m or CU kg m-2]. + btm_src !< The time-integrated bottom source of the tracer [CU H ~> CU m or CU kg m-2]. real, dimension(SZI_(G)) :: & - b1, & !< b1 is used by the tridiagonal solver, in m-1 or m2 kg-1. + b1, & !< b1 is used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. d1 !! d1=1-c1 is used by the tridiagonal solver, nondimensional. real :: c1(SZI_(G),SZK_(GV)) !< c1 is used by the tridiagonal solver [nondim]. real :: h_minus_dsink(SZI_(G),SZK_(GV)) !< The layer thickness minus the - !! difference in sinking rates across the layer, in m or kg m-2. + !! difference in sinking rates across the layer [H ~> m or kg m-2]. !! By construction, 0 <= h_minus_dsink < h_work. real :: sink(SZI_(G),SZK_(GV)+1) !< The tracer's sinking distances at the !! interfaces, limited to prevent characteristics from - !! crossing within a single timestep, in m or kg m-2. - real :: b_denom_1 !< The first term in the denominator of b1, in m or kg m-2. + !! crossing within a single timestep [H ~> m or kg m-2]. + real :: b_denom_1 !< The first term in the denominator of b1 [H ~> m or kg m-2]. real :: h_tr !< h_tr is h at tracer points with a h_neglect added to - !! ensure positive definiteness, in m or kg m-2. + !! ensure positive definiteness [H ~> m or kg m-2]. real :: h_neglect !< A thickness that is so small it is usually lost - !! in roundoff and can be neglected, in m. + !! in roundoff and can be neglected [H ~> m or kg m-2]. logical :: convert_flux = .true. @@ -229,14 +226,14 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim type(ocean_grid_type), intent(in ) :: G !< Grid structure type(verticalGrid_type), intent(in ) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Tr !< Tracer concentration on T-cell - real, intent(in ) :: dt !< Time-step over which forcing is applied (s) + real, intent(in ) :: dt !< Time-step over which forcing is applied [s] type(forcing), intent(in ) :: fluxes !< Surface fluxes container real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, intent(in ) :: evap_CFL_limit !< Limit on the fraction of the !! water that can be fluxed out of the top !! layer in a timestep (nondim) real, intent(in ) :: minimum_forcing_depth !< The smallest depth over - !! which fluxes can be applied, in m + !! which fluxes can be applied [m] real, dimension(SZI_(G),SZJ_(G)), optional, intent(in ) :: in_flux_optional !< The total time-integrated !! amount of tracer that enters with freshwater real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: out_flux_optional !< The total time-integrated diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 308702d961..64044c1851 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -280,7 +280,6 @@ subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag !! structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - !! (usually m or kg m-2) type(param_file_type), intent(in) :: param_file !< A structure to parse for !! run-time parameters type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to @@ -742,19 +741,9 @@ subroutine call_tracer_surface_state(state, h, G, CS) !! describe the surface state of the ocean. real, dimension(NIMEM_,NJMEM_,NKMEM_), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - !! (usually m or kg m-2). type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a !! previous call to call_tracer_register. -! This subroutine calls all registered tracer packages to enable them to -! add to the surface state returned to the coupler. These routines are optional. - -! Arguments: state - A structure containing fields that describe the -! surface state of the ocean. -! (in) h - Layer thickness, in m (Boussinesq) or kg m-2 (non-Boussinesq). -! (in) G - The ocean's grid structure. -! (in) CS - The control structure returned by a previous call to -! call_tracer_register. if (.not. associated(CS)) call MOM_error(FATAL, "call_tracer_surface_state: "// & "Module must be initialized via call_tracer_register before it is used.") diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index e815ca656e..a7ba71c86b 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -265,20 +265,20 @@ subroutine advection_test_tracer_column_physics(h_old, h_new, ea, eb, fluxes, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. + intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. + intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be - !! added, in m or kg m-2. + !! added [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be - !! added, in m or kg m-2. + !! added [H ~> m or kg m-2]. type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic !! and tracer forcing fields. Unused fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call, in s + real, intent(in) :: dt !< The amount of time covered by this call [s] type(advection_test_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_advection_test_tracer. real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can @@ -325,7 +325,7 @@ subroutine advection_test_tracer_surface_state(state, h, G, CS) type(surface), intent(inout) :: state !< A structure containing fields that !! describe the surface state of the ocean. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thickness, in m or kg m-2. + intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(advection_test_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_advection_test_tracer. diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index a218f6ea9e..be82ab579b 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -211,20 +211,20 @@ subroutine boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. + intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. + intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be - !! added, in m or kg m-2. + !! added [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be - !! added, in m or kg m-2. + !! added [H ~> m or kg m-2]. type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic !! and tracer forcing fields. Unused fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call, in s + real, intent(in) :: dt !< The amount of time covered by this call [s] type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_boundary_impulse_tracer. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various @@ -340,7 +340,7 @@ subroutine boundary_impulse_tracer_surface_state(state, h, G, CS) type(surface), intent(inout) :: state !< A structure containing fields that !! describe the surface state of the ocean. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thickness, in m or kg m-2. + intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_boundary_impulse_tracer. diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index e0fe85c362..61c97a7fb4 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -252,20 +252,20 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. + intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. + intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be - !! added, in m or kg m-2. + !! added [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be - !! added, in m or kg m-2. + !! added [H ~> m or kg m-2]. type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic !! and tracer forcing fields. Unused fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call, in s + real, intent(in) :: dt !< The amount of time covered by this call [s] type(dye_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_dye_tracer. real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can @@ -380,7 +380,7 @@ subroutine dye_tracer_surface_state(state, h, G, CS) type(surface), intent(inout) :: state !< A structure containing fields that !! describe the surface state of the ocean. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thickness, in m or kg m-2. + intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(dye_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_dye_tracer. diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index 20c35644db..39d5093394 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -207,20 +207,20 @@ subroutine dyed_obc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. + intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. + intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be - !! added, in m or kg m-2. + !! added [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be - !! added, in m or kg m-2. + !! added [H ~> m or kg m-2]. type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic !! and tracer forcing fields. Unused fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call, in s + real, intent(in) :: dt !< The amount of time covered by this call [s] type(dyed_obc_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to dyed_obc_register_tracer. real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index c9a3baf184..c238ee9409 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -287,20 +287,20 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. + intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. + intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be - !! added, in m or kg m-2. + !! added [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be - !! added, in m or kg m-2. + !! added [H ~> m or kg m-2]. type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic !! and tracer forcing fields. Unused fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call, in s + real, intent(in) :: dt !< The amount of time covered by this call [s] type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_ideal_age_tracer. real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can @@ -425,7 +425,7 @@ subroutine ideal_age_tracer_surface_state(state, h, G, CS) type(surface), intent(inout) :: state !< A structure containing fields that !! describe the surface state of the ocean. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thickness, in m or kg m-2. + intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_ideal_age_tracer. diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 76bb591657..3eef40b489 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -303,20 +303,20 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. + intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. + intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be - !! added, in m or kg m-2. + !! added [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be - !! added, in m or kg m-2. + !! added [H ~> m or kg m-2]. type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic !! and tracer forcing fields. Unused fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call, in s + real, intent(in) :: dt !< The amount of time covered by this call [s] type(oil_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_oil_tracer. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables @@ -366,8 +366,8 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS if (CS%oil_decay_rate(m)>0.) then CS%tr(i,j,k,m) = G%mask2dT(i,j)*max(1.-dt*CS%oil_decay_rate(m),0.)*CS%tr(i,j,k,m) ! Safest elseif (CS%oil_decay_rate(m)<0.) then - ldecay = 12.*(3.0**(-(tv%T(i,j,k)-20.)/10.)) ! Timescale in days - ldecay = 1./(86400.*ldecay) ! Rate in s^-1 + ldecay = 12.*(3.0**(-(tv%T(i,j,k)-20.)/10.)) ! Timescale [days] + ldecay = 1./(86400.*ldecay) ! Rate [s-1] CS%tr(i,j,k,m) = G%mask2dT(i,j)*max(1.-dt*ldecay,0.)*CS%tr(i,j,k,m) endif enddo ; enddo ; enddo @@ -460,7 +460,7 @@ subroutine oil_tracer_surface_state(state, h, G, CS) type(surface), intent(inout) :: state !< A structure containing fields that !! describe the surface state of the ocean. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thickness, in m or kg m-2. + intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(oil_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_oil_tracer. diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index 6fdd3f1cfe..c1d2d7a778 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -178,20 +178,20 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. + intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. + intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be - !! added, in m or kg m-2. + !! added [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be - !! added, in m or kg m-2. + !! added [H ~> m or kg m-2]. type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic !! and tracer forcing fields. Unused fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call, in s + real, intent(in) :: dt !< The amount of time covered by this call [s] type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_pseudo_salt_tracer. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables @@ -305,7 +305,7 @@ subroutine pseudo_salt_tracer_surface_state(state, h, G, CS) type(surface), intent(inout) :: state !< A structure containing fields that !! describe the surface state of the ocean. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thickness, in m or kg m-2. + intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_pseudo_salt_tracer. diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 6a928d448d..b45358d429 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -266,20 +266,20 @@ subroutine tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_old !< Layer thickness before entrainment, in m or kg m-2. + intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_new !< Layer thickness after entrainment, in m or kg m-2. + intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be - !! added, in m or kg m-2. + !! added [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be - !! added, in m or kg m-2. + !! added [H ~> m or kg m-2]. type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic !! and tracer forcing fields. Unused fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call, in s + real, intent(in) :: dt !< The amount of time covered by this call [s] type(USER_tracer_example_CS), pointer :: CS !< The control structure returned by a previous !! call to USER_register_tracer_example. @@ -291,7 +291,7 @@ subroutine tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS) real :: d1(SZI_(G)) ! d1=1-c1 is used by the tridiagonal solver. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in m. - real :: b_denom_1 ! The first term in the denominator of b1, in m or kg m-2. + real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. integer :: i, j, k, is, ie, js, je, nz, m ! The following array (trdc) determines the behavior of the tracer diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 43d89eb223..687cabcfb3 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -61,7 +61,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) !! have NULL ptrs. type(time_type), intent(in) :: day !< Time of the fluxes. real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply, in s + !! the fluxes apply [s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(BFB_surface_forcing_CS), pointer :: CS !< A pointer to the control structure !! returned by a previous call to diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index 8e51461c0e..2f9f52e49c 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -55,7 +55,7 @@ subroutine dumbbell_buoyancy_forcing(state, fluxes, day, dt, G, CS) !! have NULL ptrs. type(time_type), intent(in) :: day !< Time of the fluxes. real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply, in s + !! the fluxes apply [s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(dumbbell_surface_forcing_CS), pointer :: CS !< A control structure returned by a previous !! call to dumbbell_surface_forcing_init @@ -144,7 +144,7 @@ subroutine dumbbell_dynamic_forcing(state, fluxes, day, dt, G, CS) !! have NULL ptrs. type(time_type), intent(in) :: day !< Time of the fluxes. real, intent(in) :: dt !< The amount of time over which - !! the fluxes apply, in s + !! the fluxes apply [s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(dumbbell_surface_forcing_CS), pointer :: CS !< A control structure returned by a previous !! call to dumbbell_surface_forcing_init From 6976ac606aa3d71179efb7e3e53f5d8ac7dc5916 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 21 Dec 2018 14:27:06 -0500 Subject: [PATCH 0972/1072] Documented density variable units Changed comments to use the square bracket notation to document the units of about 500 density and related variables. Also eliminated several redundant argument documentation blocks. Only comments have been changed and all answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 4 +- config_src/coupled_driver/ocean_model_MOM.F90 | 2 +- .../ice_solo_driver/user_surface_forcing.F90 | 42 +- config_src/mct_driver/MOM_ocean_model.F90 | 2 +- .../solo_driver/MESO_surface_forcing.F90 | 12 +- .../solo_driver/Neverland_surface_forcing.F90 | 4 +- .../solo_driver/user_surface_forcing.F90 | 12 +- src/ALE/coord_rho.F90 | 4 +- src/ALE/coord_slight.F90 | 10 +- src/ALE/regrid_interp.F90 | 2 +- src/core/MOM.F90 | 15 +- src/core/MOM_PressureForce_Montgomery.F90 | 86 ++-- src/core/MOM_PressureForce_blocked_AFV.F90 | 70 ++-- src/core/MOM_barotropic.F90 | 22 +- src/core/MOM_dynamics_unsplit.F90 | 10 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 10 +- src/core/MOM_isopycnal_slopes.F90 | 28 +- src/core/MOM_variables.F90 | 36 +- src/core/MOM_verticalGrid.F90 | 14 +- src/diagnostics/MOM_diagnostics.F90 | 4 +- src/equation_of_state/MOM_EOS.F90 | 366 +++++++++--------- src/equation_of_state/MOM_EOS_NEMO.F90 | 58 +-- src/equation_of_state/MOM_EOS_TEOS10.F90 | 98 ++--- src/equation_of_state/MOM_EOS_UNESCO.F90 | 110 +++--- src/equation_of_state/MOM_EOS_Wright.F90 | 176 +++++---- src/equation_of_state/MOM_EOS_linear.F90 | 220 ++++++----- .../MOM_coord_initialization.F90 | 22 +- .../MOM_state_initialization.F90 | 55 +-- .../lateral/MOM_mixed_layer_restrat.F90 | 31 +- .../lateral/MOM_thickness_diffuse.F90 | 59 +-- .../vertical/MOM_CVMix_ddiff.F90 | 4 +- .../vertical/MOM_bulk_mixed_layer.F90 | 88 ++--- .../vertical/MOM_entrain_diffusive.F90 | 23 +- .../vertical/MOM_full_convection.F90 | 10 +- .../vertical/MOM_internal_tide_input.F90 | 2 +- .../vertical/MOM_set_diffusivity.F90 | 8 +- .../vertical/MOM_set_viscosity.F90 | 8 +- src/parameterizations/vertical/MOM_sponge.F90 | 8 +- src/tracer/MOM_offline_main.F90 | 8 +- src/tracer/MOM_tracer_hor_diff.F90 | 4 +- src/user/BFB_surface_forcing.F90 | 6 +- src/user/DOME_initialization.F90 | 8 +- src/user/ISOMIP_initialization.F90 | 24 +- src/user/Phillips_initialization.F90 | 6 +- src/user/benchmark_initialization.F90 | 14 +- src/user/dumbbell_surface_forcing.F90 | 10 +- src/user/user_change_diffusivity.F90 | 12 +- 47 files changed, 904 insertions(+), 923 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 6d161aad00..1b8770fba4 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -228,7 +228,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc net_FW, & ! The area integrated net freshwater flux into the ocean [kg s-1] net_FW2, & ! The area integrated net freshwater flux into the ocean [kg s-1] work_sum, & ! A 2-d array that is used as the work space for global sums [m2] or [kg s-1] - open_ocn_mask ! a binary field indicating where ice is present based on frazil criteria + open_ocn_mask ! a binary field indicating where ice is present based on frazil criteria [nondim] 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 @@ -1019,7 +1019,7 @@ subroutine apply_flux_adjustments(G, CS, Time, fluxes) type(forcing), intent(inout) :: fluxes !< Surface fluxes structure ! Local variables - 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 ! Various fluxes at h points [W m-2] or [kg m-2 s-1] integer :: isc, iec, jsc, jec, i, j logical :: overrode_h diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index ce42e26b45..57d0882870 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -239,7 +239,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) !! tracer fluxes, and can be used to spawn related !! internal variables in the ice model. ! Local variables - real :: Rho0 ! The Boussinesq ocean density, in kg m-3. + real :: Rho0 ! The Boussinesq ocean density [kg m-3]. real :: G_Earth ! The gravitational acceleration [m s-2]. real :: HFrz !< If HFrz > 0 (m), melt potential will be computed. !! The actual depth over which melt potential is computed will diff --git a/config_src/ice_solo_driver/user_surface_forcing.F90 b/config_src/ice_solo_driver/user_surface_forcing.F90 index 56baa4579e..41694af97c 100644 --- a/config_src/ice_solo_driver/user_surface_forcing.F90 +++ b/config_src/ice_solo_driver/user_surface_forcing.F90 @@ -79,7 +79,7 @@ module user_surface_forcing ! state variables. logical :: restorebuoy ! If true, use restoring surface buoyancy forcing. real :: Rho0 ! The density used in the Boussinesq - ! approximation, in kg m-3. + ! approximation [kg m-3]. real :: G_Earth ! The gravitational acceleration [m s-2]. real :: Flux_const ! The restoring rate at the surface [m s-1]. real :: gust_const ! A constant unresolved background gustiness @@ -109,15 +109,6 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) ! direction as the u- and v- velocities.) They are both in Pa. ! In addition, this subroutine can be used to set the surface friction ! velocity, forces%ustar [Z s-1 ~> m s-1]. This is needed with a bulk mixed layer. -! -! Arguments: state - A structure containing fields that describe the -! surface state of the ocean. -! (out) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) day - Time of the fluxes. -! (in) G - The ocean's grid structure. -! (in) CS - A pointer to the control structure returned by a previous -! call to user_surface_forcing_init integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -186,24 +177,13 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! are in W m-2 and positive for heat going into the ocean. All fresh water ! fluxes are in kg m-2 s-1 and positive for water moving into the ocean. -! Arguments: state - A structure containing fields that describe the -! surface state of the ocean. -! (out) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) day_start - Start time of the fluxes. -! (in) day_interval - Length of time over which these fluxes -! will be applied. -! (in) G - The ocean's grid structure. -! (in) CS - A pointer to the control structure returned by a previous -! call to user_surface_forcing_init - real :: Temp_restore ! The temperature that is being restored toward, in C. real :: Salin_restore ! The salinity that is being restored toward, in PSU. real :: density_restore ! The potential density that is being restored - ! toward, in kg m-3. - real :: rhoXcp ! The mean density times the heat capacity, in J m-3 K-1. + ! toward [kg m-3]. + real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. real :: buoy_rest_const ! A constant relating density anomalies to the - ! restoring buoyancy flux, in m5 s-3 kg-1. + ! restoring buoyancy flux [m5 s-3 kg-1]. integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -294,7 +274,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) buoy_rest_const = -1.0 * (CS%G_Earth * CS%Flux_const) / CS%Rho0 do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential - ! density in kg m-3 that is being restored toward. + ! density [kg m-3] that is being restored toward. density_restore = 1030.0 fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & @@ -314,16 +294,8 @@ subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS) type(user_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to !! the control structure for this module -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module - -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "user_surface_forcing" ! This module's name. if (associated(CS)) then diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index a8f67c1e79..64ef660dbf 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -247,7 +247,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! 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, in kg m-3. + 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. diff --git a/config_src/solo_driver/MESO_surface_forcing.F90 b/config_src/solo_driver/MESO_surface_forcing.F90 index fd172cfaf1..e6f35274bf 100644 --- a/config_src/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/solo_driver/MESO_surface_forcing.F90 @@ -26,7 +26,7 @@ module MESO_surface_forcing logical :: use_temperature !< If true, temperature and salinity are used as state variables. logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. - real :: Rho0 !< The density used in the Boussinesq approximation, in kg m-3. + real :: Rho0 !< The density used in the Boussinesq approximation [kg m-3]. real :: G_Earth !< The gravitational acceleration [m s-2]. real :: Flux_const !< The restoring rate at the surface [m s-1]. real :: gust_const !< A constant unresolved background gustiness @@ -75,13 +75,13 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! are in W m-2 and positive for heat going into the ocean. All fresh water ! fluxes are in kg m-2 s-1 and positive for water moving into the ocean. - real :: Temp_restore ! The temperature that is being restored toward, in C. + real :: Temp_restore ! The temperature that is being restored toward [degC]. real :: Salin_restore ! The salinity that is being restored toward, in PSU. real :: density_restore ! The potential density that is being restored - ! toward, in kg m-3. - real :: rhoXcp ! The mean density times the heat capacity, in J m-3 K-1. + ! toward [kg m-3]. + real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. real :: buoy_rest_const ! A constant relating density anomalies to the - ! restoring buoyancy flux, in m5 s-3 kg-1. + ! restoring buoyancy flux [m5 s-3 kg-1]. integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -192,7 +192,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) buoy_rest_const = -1.0 * (CS%G_Earth * CS%Flux_const) / CS%Rho0 do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential - ! density in kg m-3 that is being restored toward. + ! density [kg m-3] that is being restored toward. density_restore = 1030.0 fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & diff --git a/config_src/solo_driver/Neverland_surface_forcing.F90 b/config_src/solo_driver/Neverland_surface_forcing.F90 index c727b62833..bd99299531 100644 --- a/config_src/solo_driver/Neverland_surface_forcing.F90 +++ b/config_src/solo_driver/Neverland_surface_forcing.F90 @@ -32,7 +32,7 @@ module Neverland_surface_forcing logical :: use_temperature !< If true, use temperature and salinity. logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. real :: Rho0 !< The density used in the Boussinesq - !! approximation, in kg m-3. + !! approximation [kg m-3]. real :: G_Earth !< The gravitational acceleration [m s-2]. real :: flux_const !< The restoring rate at the surface [m s-1]. real, dimension(:,:), pointer :: & @@ -197,7 +197,7 @@ subroutine Neverland_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) buoy_rest_const = -1.0 * (CS%G_Earth * CS%flux_const) / CS%Rho0 do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential - ! density in kg m-3 that is being restored toward. + ! density [kg m-3] that is being restored toward. density_restore = 1030.0 fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90 index ce77d6dd8c..4472ea9a76 100644 --- a/config_src/solo_driver/user_surface_forcing.F90 +++ b/config_src/solo_driver/user_surface_forcing.F90 @@ -33,7 +33,7 @@ module user_surface_forcing logical :: use_temperature !< If true, temperature and salinity are used as state variables. logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. - real :: Rho0 !< The density used in the Boussinesq approximation, in kg m-3. + real :: Rho0 !< The density used in the Boussinesq approximation [kg m-3]. real :: G_Earth !< The gravitational acceleration [m s-2]. real :: Flux_const !< The restoring rate at the surface [m s-1]. real :: gust_const !< A constant unresolved background gustiness @@ -124,13 +124,13 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! fluxes are in kg m-2 s-1 and positive for water moving into the ocean. ! Local variables - real :: Temp_restore ! The temperature that is being restored toward, in C. + real :: Temp_restore ! The temperature that is being restored toward [degC]. real :: Salin_restore ! The salinity that is being restored toward, in PSU. real :: density_restore ! The potential density that is being restored - ! toward, in kg m-3. - real :: rhoXcp ! The mean density times the heat capacity, in J m-3 K-1. + ! toward [kg m-3]. + real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. real :: buoy_rest_const ! A constant relating density anomalies to the - ! restoring buoyancy flux, in m5 s-3 kg-1. + ! restoring buoyancy flux [m5 s-3 kg-1]. integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -221,7 +221,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) buoy_rest_const = -1.0 * (CS%G_Earth * CS%Flux_const) / CS%Rho0 do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential - ! density in kg m-3 that is being restored toward. + ! density [kg m-3] that is being restored toward. density_restore = 1030.0 fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & diff --git a/src/ALE/coord_rho.F90 b/src/ALE/coord_rho.F90 index 6c9ec71582..16c05943aa 100644 --- a/src/ALE/coord_rho.F90 +++ b/src/ALE/coord_rho.F90 @@ -26,7 +26,7 @@ module coord_rho !! If false, integrate from the bottom upward, as does the rest of the model. logical :: integrate_downward_for_e = .false. - !> Nominal density of interfaces, in kg m-3 + !> Nominal density of interfaces [kg m-3] real, allocatable, dimension(:) :: target_density !> Interpolation control structure @@ -47,7 +47,7 @@ subroutine init_coord_rho(CS, nk, ref_pressure, target_density, interp_CS) type(rho_CS), pointer :: CS !< Unassociated pointer to hold the control structure integer, intent(in) :: nk !< Number of layers in the grid real, intent(in) :: ref_pressure !< Nominal density of interfaces in Pa - real, dimension(:), intent(in) :: target_density !< Nominal density of interfaces in kg m-3 + real, dimension(:), intent(in) :: target_density !< Nominal density of interfaces [kg m-3] type(interp_CS_type), intent(in) :: interp_CS !< Controls for interpolation if (associated(CS)) call MOM_error(FATAL, "init_coord_rho: CS already associated!") diff --git a/src/ALE/coord_slight.F90 b/src/ALE/coord_slight.F90 index 935804e301..d510388414 100644 --- a/src/ALE/coord_slight.F90 +++ b/src/ALE/coord_slight.F90 @@ -51,7 +51,7 @@ module coord_slight !> A value of the stratification ratio that defines a problematic halocline region (nondim). real :: halocline_strat_tol - !> Nominal density of interfaces, in kg m-3. + !> Nominal density of interfaces [kg m-3]. real, allocatable, dimension(:) :: target_density !> Maximum depths of interfaces [H ~> m or kg m-2]. @@ -73,7 +73,7 @@ subroutine init_coord_slight(CS, nk, ref_pressure, target_density, interp_CS, m_ type(slight_CS), pointer :: CS !< Unassociated pointer to hold the control structure integer, intent(in) :: nk !< Number of layers in the grid real, intent(in) :: ref_pressure !< Nominal density of interfaces in Pa - real, dimension(:), intent(in) :: target_density !< Nominal density of interfaces in kg m-3 + real, dimension(:), intent(in) :: target_density !< Nominal density of interfaces [kg m-3] type(interp_CS_type), intent(in) :: interp_CS !< Controls for interpolation real, optional, intent(in) :: m_to_H !< A conversion factor from m to the units of thicknesses @@ -211,9 +211,9 @@ subroutine build_slight_column(CS, eqn_of_state, H_to_Pa, H_subroundoff, & real :: dz ! A uniform layer thickness in very shallow water [H ~> m or kg m-2]. real :: dz_ur ! The total thickness of an unstable region [H ~> m or kg m-2]. real :: wgt, cowgt ! A weight and its complement, nondim. - real :: rho_ml_av ! The average potential density in a near-surface region, in kg m-3. + real :: rho_ml_av ! The average potential density in a near-surface region [kg m-3]. real :: H_ml_av ! A thickness to try to use in taking the near-surface average [H ~> m or kg m-2]. - real :: rho_x_z ! A cumulative integral of a density, in kg m-3 H. + real :: rho_x_z ! A cumulative integral of a density [kg m-3 H ~> kg m-2 or kg2 m-5]. real :: z_wt ! The thickness actually used in taking the near-surface average [H ~> m or kg m-2]. real :: k_interior ! The (real) value of k where the interior grid starts. real :: k_int2 ! The (real) value of k where the interior grid starts. @@ -503,7 +503,7 @@ subroutine rho_interfaces_col(rho_col, h_col, z_col, rho_tgt, nz, z_col_new, & real, dimension(nz,DEGREE_MAX+1) :: ppoly_i_coefficients ! Coefficients of polynomial logical, dimension(nz) :: unstable_lay ! If true, this layer is in an unstable region. logical, dimension(nz+1) :: unstable_int ! If true, this interface is in an unstable region. - real :: rt ! The current target density, in kg m-3. + real :: rt ! The current target density [kg m-3]. real :: zf ! The fractional z-position within a layer of the target density. real :: rfn real :: a(5) ! Coefficients of a local polynomial minus the target density. diff --git a/src/ALE/regrid_interp.F90 b/src/ALE/regrid_interp.F90 index 9bc794a2ef..d2c384c15e 100644 --- a/src/ALE/regrid_interp.F90 +++ b/src/ALE/regrid_interp.F90 @@ -298,7 +298,7 @@ end subroutine interpolate_grid subroutine build_and_interpolate_grid(CS, densities, n0, h0, x0, target_values, & n1, h1, x1, h_neglect, h_neglect_edge) type(interp_CS_type), intent(in) :: CS !< A control structure for regrid_interp - real, dimension(:), intent(in) :: densities !< Input cell densities, in kg m-3 + real, dimension(:), intent(in) :: densities !< Input cell densities [kg m-3] real, dimension(:), intent(in) :: target_values !< Target values of interfaces integer, intent(in) :: n0 !< The number of points on the input grid real, dimension(:), intent(in) :: h0 !< Initial cell widths diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index ae6ab26b5d..08e33c27db 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1537,11 +1537,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz integer :: IsdB, IedB, JsdB, JedB - real :: dtbt - real :: Z_diag_int ! minimum interval between calc depth-space diagnostics [s] + real :: dtbt ! The barotropic timestep [s] + real :: Z_diag_int ! minimum interval between calc depth-space diagnosetics [s] - real, allocatable, dimension(:,:,:) :: e ! interface heights (meter) - real, allocatable, dimension(:,:) :: eta ! free surface height [m] or column mass [kg m-2] + real, allocatable, dimension(:,:) :: eta ! free surface height or column mass [H ~> m or kg m-2] real, allocatable, dimension(:,:) :: area_shelf_h ! area occupied by ice shelf [m2] real, dimension(:,:), allocatable, target :: frac_shelf_h ! fraction of total area occupied by ice shelf [nondim] real, dimension(:,:), pointer :: shelf_area => NULL() @@ -2660,14 +2659,14 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS) type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: ssh !< time mean surface height (m) - real, dimension(:,:), optional, pointer :: p_atm !< atmospheric pressure (Pascal) + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: ssh !< time mean surface height [m] + real, dimension(:,:), optional, pointer :: p_atm !< atmospheric pressure [Pa] logical, optional, intent(in) :: use_EOS !< If true, calculate the density for !! the SSH correction using the equation of state. real :: Rho_conv ! The density used to convert surface pressure to - ! a corrected effective SSH, in kg m-3. - real :: IgR0 ! The SSH conversion factor from Pa to m. + ! a corrected effective SSH [kg m-3]. + real :: IgR0 ! The SSH conversion factor from Pa to m [m Pa-1]. logical :: calc_rho integer :: i, j, is, ie, js, je diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index aa228c5a6d..986a5cdb48 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -34,15 +34,15 @@ module MOM_PressureForce_Mont !! approximation [kg m-3]. real :: Rho_atm !< The assumed atmospheric density [kg m-3]. !! By default, Rho_atm is 0. - real :: GFS_scale !< Ratio between gravity applied to top interface - !! and the gravitational acceleration of the planet. + real :: GFS_scale !< Ratio between gravity applied to top interface and the + !! gravitational acceleration of the planet [nondim]. !! Usually this ratio is 1. type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate !! the timing of diagnostic output. real, pointer :: PFu_bc(:,:,:) => NULL() !< Accelerations due to pressure real, pointer :: PFv_bc(:,:,:) => NULL() !< gradients deriving from density - !! gradients within layers, m s-2. + !! gradients within layers [m s-2]. !>@{ Diagnostic IDs integer :: id_PFu_bc = -1, id_PFv_bc = -1, id_e_tidal = -1 !!@} @@ -63,44 +63,44 @@ module MOM_PressureForce_Mont subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, eta) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in kg/m2. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, [H ~> kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration due to pressure gradients - !! (equal to -dM/dx) in m/s2. + !! (equal to -dM/dx) [m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration due to pressure gradients - !! (equal to -dM/dy) in m/s2. + !! (equal to -dM/dy) [m s-2]. type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean or - !! atmosphere-ocean in Pa. + !! atmosphere-ocean [Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: pbce !< The baroclinic pressure anomaly in !! each layer due to free surface height anomalies, !! [m2 s-2 H-1 ~> m s-2 or m4 kg-1 s-2]. - real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< Free surface height, in m. + real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< Free surface height [H ~> kg m-1]. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & M, & ! The Montgomery potential, M = (p/rho + gz) [m2 s-2]. - alpha_star, & ! Compression adjusted specific volume, in m3 kg-1. + alpha_star, & ! Compression adjusted specific volume [m3 kg-1]. dz_geo ! The change in geopotential across a layer [m2 s-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure in Pa. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure [Pa]. ! p may be adjusted (with a nonlinear equation of state) so that ! its derivative compensates for the adiabatic compressibility ! in seawater, but p will still be close to the pressure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & T_tmp, & ! Temporary array of temperatures where layers that are lighter - ! than the mixed layer have the mixed layer's properties, in C. + ! than the mixed layer have the mixed layer's properties [degC]. S_tmp ! Temporary array of salinities where layers that are lighter - ! than the mixed layer have the mixed layer's properties [PSU]. + ! than the mixed layer have the mixed layer's properties [ppt]. real, dimension(SZI_(G)) :: Rho_cv_BL ! The coordinate potential density in the ! deepest variable density near-surface layer [kg m-3]. real, dimension(SZI_(G),SZJ_(G)) :: & dM, & ! A barotropic correction to the Montgomery potentials to - ! enable the use of a reduced gravity form of the equations, - ! in m2 s-2. + ! enable the use of a reduced gravity form of the equations + ! [m2 s-2]. dp_star, & ! Layer thickness after compensation for compressibility [Pa]. SSH, & ! The sea surface height anomaly, in depth units [Z ~> m]. e_tidal, & ! Bottom geopotential anomaly due to tidal forces from @@ -108,7 +108,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb geopot_bot ! Bottom geopotential relative to time-mean sea level, ! including any tidal contributions [m2 s-2]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate - ! density, in Pa (usually 2e7 Pa = 2000 dbar). + ! density [Pa] (usually 2e7 Pa = 2000 dbar). real :: rho_in_situ(SZI_(G)) !In-situ density of a layer [kg m-3]. real :: PFu_bc, PFv_bc ! The pressure gradient force due to along-layer ! compensated density gradients [m s-2] @@ -374,7 +374,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure anomaly in !! each layer due to free surface height anomalies !! [m2 s-2 H-1 ~> m s-2]. - real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< Free surface height, in m. + real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< Free surface height [H ~> m]. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & M, & ! The Montgomery potential, M = (p/rho + gz) [m2 s-2]. @@ -403,7 +403,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, real :: G_Rho0 ! G_Earth / Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. real :: PFu_bc, PFv_bc ! The pressure gradient force due to along-layer ! compensated density gradients [m s-2] - real :: dr ! Temporary variables. +! real :: dr ! Temporary variables. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -609,12 +609,13 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height [Z ~> m]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, intent(in) :: Rho0 !< The "Boussinesq" ocean density [kg m-3]. - real, intent(in) :: GFS_scale !< Ratio between gravity applied to top interface - !! and the gravitational acceleration of the planet. - !! Usually this ratio is 1. + real, intent(in) :: GFS_scale !< Ratio between gravity applied to top + !! interface and the gravitational acceleration of + !! the planet [nondim]. Usually this ratio is 1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: pbce !< The baroclinic pressure anomaly in each layer due - !! to free surface height anomalies, in m2 H-1 s-2. + !! to free surface height anomalies + !! [m2 H-1 s-2 ~> m4 kg-2 s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: rho_star !< The layer densities (maybe compressibility !! compensated), times g/rho_0 [m2 Z-1 s-2 ~> m s-2]. @@ -622,11 +623,11 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) ! Local variables real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer thicknesses [H-1 ~> m-1 or m2 kg-1]. real :: press(SZI_(G)) ! Interface pressure [Pa]. - real :: T_int(SZI_(G)) ! Interface temperature in C. - real :: S_int(SZI_(G)) ! Interface salinity in PSU. - real :: dR_dT(SZI_(G)) ! Partial derivatives of density with temperature - real :: dR_dS(SZI_(G)) ! and salinity in kg m-3 K-1 and kg m-3 PSU-1. - real :: rho_in_situ(SZI_(G)) !In-situ density at the top of a layer. + real :: T_int(SZI_(G)) ! Interface temperature [degC]. + real :: S_int(SZI_(G)) ! Interface salinity [ppt]. + real :: dR_dT(SZI_(G)) ! Partial derivative of density with temperature [kg m-3 degC-1]. + real :: dR_dS(SZI_(G)) ! Partial derivative of density with salinity [kg m-3 ppt-1]. + real :: rho_in_situ(SZI_(G)) !In-situ density at the top of a layer [kg m-3]. real :: G_Rho0 ! G_Earth / Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1] real :: Rho0xG ! g_Earth * Rho0 [kg s-2 m-1 Z-1 ~> kg s-2 m-2] logical :: use_EOS ! If true, density is calculated from T & S using @@ -707,28 +708,27 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, GFS_scale, pbce, alpha_star) type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: p !< Interface pressures [Pa]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, intent(in) :: GFS_scale !< Ratio between gravity applied to top interface - !! and the gravitational acceleration of the planet. - !! Usually this ratio is 1. + real, intent(in) :: GFS_scale !< Ratio between gravity applied to top + !! interface and the gravitational acceleration of + !! the planet [nondim]. Usually this ratio is 1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: pbce !< The baroclinic pressure anomaly in each layer due - !! to free surface height anomalies, in m2 H-1 s-2. + !! to free surface height anomalies + !! [m2 H-1 s-2 ~> m4 kg-2 s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: alpha_star !< The layer specific volumes - !! (maybe compressibility compensated), in m3 kg-1. + !! (maybe compressibility compensated) [m3 kg-1]. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & dpbce, & ! A barotropic correction to the pbce to enable the use of - ! a reduced gravity form of the equations, in m4 s-2 kg-1. - C_htot ! dP_dH divided by the total ocean pressure, m2 kg-1. - real :: T_int(SZI_(G)) ! Interface temperature in C. - real :: S_int(SZI_(G)) ! Interface salinity in PSU. - real :: dR_dT(SZI_(G)) ! Partial derivatives of density with temperature - real :: dR_dS(SZI_(G)) ! and salinity in kg m-3 K-1 and kg m-3 PSU-1. - real :: rho_in_situ(SZI_(G)) !In-situ density at an interface [kg m-3]. + ! a reduced gravity form of the equations [m4 s-2 kg-1]. + C_htot ! dP_dH divided by the total ocean pressure [m2 kg-1]. + real :: T_int(SZI_(G)) ! Interface temperature [degC]. + real :: S_int(SZI_(G)) ! Interface salinity [ppt]. + real :: dR_dT(SZI_(G)) ! Partial derivative of density with temperature [kg m-3 degC-1]. + real :: dR_dS(SZI_(G)) ! Partial derivative of density with salinity [kg m-3 ppt-1]. + real :: rho_in_situ(SZI_(G)) ! In-situ density at an interface [kg m-3]. real :: alpha_Lay(SZK_(G)) ! The specific volume of each layer [kg m-3]. - real :: dalpha_int(SZK_(G)+1) ! The change in specific volume across each - ! interface [kg m-3]. - real :: dP_dH ! A factor that converts from thickness to pressure, - ! usually in Pa m2 kg-1. + real :: dalpha_int(SZK_(G)+1) ! The change in specific volume across each interface [kg m-3]. + real :: dP_dH ! A factor that converts from thickness to pressure [Pa H-1 ~> Pa m2 kg-1]. real :: dp_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [Pa]. logical :: use_EOS ! If true, density is calculated from T & S using diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index a9de1401b1..d94adf7872 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -38,7 +38,7 @@ module MOM_PressureForce_blk_AFV real :: Rho0 !< The density used in the Boussinesq !! approximation [kg m-3]. real :: GFS_scale !< A scaling of the surface pressure gradients to - !! allow the use of a reduced gravity model. + !! allow the use of a reduced gravity model [nondim]. type(time_type), pointer :: Time !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the !! timing of diagnostic output. @@ -74,7 +74,7 @@ subroutine PressureForce_blk_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, type(PressureForce_blk_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean - !! or atmosphere-ocean interface in Pa. + !! or atmosphere-ocean interface [Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure !! anomaly in each layer due to eta anomalies !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. @@ -103,7 +103,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] @@ -117,17 +117,17 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal !! contributions or compressibility compensation. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure in Pa. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure [Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & T_tmp, & ! Temporary array of temperatures where layers that are lighter - ! than the mixed layer have the mixed layer's properties, in C. + ! than the mixed layer have the mixed layer's properties [degC]. S_tmp ! Temporary array of salinities where layers that are lighter ! than the mixed layer have the mixed layer's properties [PSU]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & dza, & ! The change in geopotential anomaly between the top and bottom ! of a layer [m2 s-2]. intp_dza ! The vertical integral in depth of the pressure anomaly less - ! the pressure anomaly at the top of the layer, in Pa m2 s-2. + ! the pressure anomaly at the top of the layer [Pa m2 s-2]. real, dimension(SZI_(G),SZJ_(G)) :: & dp, & ! The (positive) change in pressure across a layer [Pa]. SSH, & ! The sea surface height anomaly, in depth units [Z ~> m]. @@ -146,29 +146,29 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, ! density near-surface layer [kg m-3]. real, dimension(SZDIB_(G%Block(1)),SZDJ_(G%Block(1))) :: & ! on block indices intx_za_bk ! The zonal integral of the geopotential anomaly along the - ! interface below a layer, divided by the grid spacing, m2 s-2. + ! interface below a layer, divided by the grid spacing [m2 s-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & intx_dza ! The change in intx_za through a layer [m2 s-2]. real, dimension(SZDI_(G%Block(1)),SZDJB_(G%Block(1))) :: & ! on block indices inty_za_bk ! The meridional integral of the geopotential anomaly along the - ! interface below a layer, divided by the grid spacing, m2 s-2. + ! interface below a layer, divided by the grid spacing [m2 s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & inty_dza ! The change in inty_za through a layer [m2 s-2]. - real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate - ! density, in Pa (usually 2e7 Pa = 2000 dbar). - - real :: dp_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected [Pa]. - real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. - real :: I_gEarth ! The inverse of g_Earth_z [s2 Z m-2 ~> s2 m-1] - real :: alpha_anom ! The in-situ specific volume, averaged over a - ! layer, less alpha_ref, in m3 kg-1. - logical :: use_p_atm ! If true, use the atmospheric pressure. + real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate + ! density [Pa] (usually 2e7 Pa = 2000 dbar). + + real :: dp_neglect ! A thickness that is so small it is usually lost + ! in roundoff and can be neglected [Pa]. + real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. + real :: I_gEarth ! The inverse of g_Earth_z [s2 Z m-2 ~> s2 m-1] + real :: alpha_anom ! The in-situ specific volume, averaged over a + ! layer, less alpha_ref [m3 kg-1]. + logical :: use_p_atm ! If true, use the atmospheric pressure. logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. - real :: alpha_ref ! A reference specific volume, in m3 kg-1, that is used + real :: alpha_ref ! A reference specific volume [m3 kg-1], that is used ! to reduce the impact of truncation errors. real :: rho_in_situ(SZI_(G)) ! The in situ density [kg m-3]. real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). @@ -452,7 +452,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, Rho_cv_BL ! The coordinate potential density in the deepest variable ! density near-surface layer [kg m-3]. real, dimension(SZDI_(G%Block(1)),SZDJ_(G%Block(1))) :: & ! on block indices - dz_bk, & ! The change in geopotential thickness through a layer, m2 s-2. + dz_bk, & ! The change in geopotential thickness through a layer [m2 s-2]. pa_bk, & ! The pressure anomaly (i.e. pressure + g*RHO_0*e) at the ! the interface atop a layer [Pa]. dpa_bk, & ! The change in pressure anomaly between the top and bottom @@ -470,25 +470,25 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & T_tmp, & ! Temporary array of temperatures where layers that are lighter - ! than the mixed layer have the mixed layer's properties, in C. + ! than the mixed layer have the mixed layer's properties [degC]. S_tmp ! Temporary array of salinities where layers that are lighter ! than the mixed layer have the mixed layer's properties [PSU]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - S_t, S_b, T_t, T_b ! Top and bottom edge values for linear reconstructions - ! of salinity and temperature within each layer. + S_t, S_b, & ! Top and bottom edge salinities for linear reconstructions within each layer [ppt]. + T_t, T_b ! Top and bottom edge temperatures for linear reconstructions within each layer [degC]. real :: rho_in_situ(SZI_(G)) ! The in situ density [kg m-3]. - real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate - ! density, in Pa (usually 2e7 Pa = 2000 dbar). - real :: p0(SZI_(G)) ! An array of zeros to use for pressure in Pa. - real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: I_Rho0 ! 1/Rho0. - real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. - real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. - real :: Rho_ref ! The reference density in kg m-3. - real :: dz_neglect ! A minimal thickness [Z ~> m], like e. - logical :: use_p_atm ! If true, use the atmospheric pressure. - logical :: use_ALE ! If true, use an ALE pressure reconstruction. + real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate + ! density [Pa] (usually 2e7 Pa = 2000 dbar). + real :: p0(SZI_(G)) ! An array of zeros to use for pressure [Pa]. + real :: h_neglect ! A thickness that is so small it is usually lost + ! in roundoff and can be neglected [H ~> m or kg m-2]. + real :: I_Rho0 ! 1/Rho0 [m3 kg-1]. + real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. + real :: G_Rho0 ! G_Earth / Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. + real :: Rho_ref ! The reference density [kg m-3]. + real :: dz_neglect ! A minimal thickness [Z ~> m], like e. + logical :: use_p_atm ! If true, use the atmospheric pressure. + logical :: use_ALE ! If true, use an ALE pressure reconstruction. logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 9b661fa46c..9f83205fc6 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -160,7 +160,7 @@ module MOM_barotropic !! for applying open boundary conditions. real :: Rho0 !< The density used in the Boussinesq - !! approximation, in kg m-3. + !! approximation [kg m-3 ~> m or kg m-2]. real :: dtbt !< The barotropic time step [s]. real :: dtbt_fraction !< The fraction of the maximum time-step that !! should used. The default is 0.98. @@ -420,11 +420,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_out !< The final barotropic free surface !! height anomaly or column mass anomaly [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: uhbtav !< the barotropic zonal volume or mass - !! fluxes averaged through the barotropic steps, in - !! m3 s-1 or kg s-1. + !! fluxes averaged through the barotropic steps + !! [H m2 s-1 ~> m3 or kg s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(out) :: vhbtav !< the barotropic meridional volume or mass - !! fluxes averaged through the barotropic steps, in - !! m3 s-1 or kg s-1. + !! fluxes averaged through the barotropic steps + !! [H m2 s-1 ~> m3 or kg s-1]. type(barotropic_CS), pointer :: CS !< The control structure returned by a !! previous call to barotropic_init. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: visc_rem_u !< Both the fraction of the momentum @@ -433,7 +433,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! barotropic acceleration that a layer experiences after !! viscosity is applied, in the zonal direction. Nondimensional !! between 0 (at the bottom) and 1 (far above the bottom). - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: visc_rem_v !< Ditto for meridional direction. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: visc_rem_v !< Ditto for meridional direction [nondim]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: etaav !< The free surface height or column mass !! averaged over the barotropic integration [H ~> m or kg m-2]. type(ocean_OBC_type), optional, pointer :: OBC !< The open boundary condition structure. @@ -441,12 +441,12 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! the effective open face areas as a function of barotropic !! flow. real, dimension(:,:), optional, pointer :: eta_PF_start !< The eta field consistent with the pressure - !! gradient at the start of the barotropic stepping, in m or - !! kg m-2. + !! gradient at the start of the barotropic stepping + !! [H ~> m or kg m-2]. real, dimension(:,:), optional, pointer :: taux_bot !< The zonal bottom frictional stress from - !! ocean to the seafloor, in Pa. + !! ocean to the seafloor [Pa]. real, dimension(:,:), optional, pointer :: tauy_bot !< The meridional bottom frictional stress - !! from ocean to the seafloor, in Pa. + !! from ocean to the seafloor [Pa]. real, dimension(:,:,:), optional, pointer :: uh0 !< The zonal layer transports at reference !! velocities [H m s-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(:,:,:), optional, pointer :: u_uh0 !< The velocities used to calculate uh0 [m s-1] @@ -578,7 +578,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, dimension(SZIW_(CS),SZJBW_(CS)) :: & vbt_prev, vhbt_prev, vbt_sum_prev, vhbt_sum_prev, vbt_wtd_prev ! for OBC - real :: mass_to_Z ! The depth unit converison divided by the mean density (Rho0), in m3 kg-1. + real :: mass_to_Z ! The depth unit converison divided by the mean density (Rho0) [m3 kg-1]. real :: visc_rem ! A work variable that may equal visc_rem_[uv]. Nondim. real :: vel_prev ! The previous velocity [m s-1]. real :: dtbt ! The barotropic time step [s]. diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 73ffc9aad5..887a6c4f54 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -201,14 +201,14 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & !! pressure at the start of this dynamic step [Pa]. real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the surface !! pressure at the end of this dynamic step [Pa]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh !< The zonal volume or mass transport, - !! in m3 s-1 or kg s-1. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh !< The zonal volume or mass transport + !! [H m2 s-1 ~> m3 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh !< The meridional volume or mass - !! transport, in m3 s-1 or kg s-1. + !! transport [H m2 s-1 ~> m3 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< The accumulated zonal volume or mass - !! transport since the last tracer advection, in m3 or kg. + !! transport since the last tracer advection [H m2 ~> m3 or kg]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume or mass - !! transport since the last tracer advection, in m3 or kg. + !! transport since the last tracer advection [H m2 ~> m3 or kg]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height or !! column mass [H ~> m or kg m-2]. type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 6aa4ce2e15..e3625dd6a3 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -210,16 +210,16 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to !! the surface pressure at the end of !! this dynamic step [Pa]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh !< The zonal volume or mass transport, - !! in m3 s-1 or kg s-1. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh !< The zonal volume or mass transport + !! [H m2 s-1 ~> m3 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh !< The meridional volume or mass - !! transport, in m3 s-1 or kg s-1. + !! transport [H m2 s-1 ~> m3 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< The accumulated zonal volume or !! mass transport since the last - !! tracer advection, in m3 or kg. + !! tracer advection [H m2 ~> m3 or kg]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume !! or mass transport since the last - !! tracer advection, in m3 or kg. + !! tracer advection [H m2 ~> m3 or kg]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height !! or column mass [H ~> m or kg m-2]. type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up by diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 8742a0d945..03f89f7061 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -58,17 +58,19 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & pres ! The pressure at an interface [Pa]. real, dimension(SZIB_(G)) :: & - drho_dT_u, & ! The derivatives of density with temperature and - drho_dS_u ! salinity at u points, in kg m-3 K-1 and kg m-3 psu-1. + drho_dT_u, & ! The derivative of density with temperature at u points [kg m-3 degC-1]. + drho_dS_u ! The derivative of density with salinity at u points [kg m-3 ppt-1]. real, dimension(SZI_(G)) :: & - drho_dT_v, & ! The derivatives of density with temperature and - drho_dS_v ! salinity at v points, in kg m-3 K-1 and kg m-3 psu-1. + drho_dT_v, & ! The derivative of density with temperature at v points [kg m-3 degC-1]. + drho_dS_v ! The derivative of density with salinity at v points [kg m-3 ppt-1]. real, dimension(SZIB_(G)) :: & - T_u, S_u, & ! Temperature, salinity, and pressure on the interface at - pres_u ! the u-point in the horizontal. + T_u, & ! Temperature on the interface at the u-point [degC]. + S_u, & ! Salinity on the interface at the u-point [ppt]. + pres_u ! Pressure on the interface at the u-point [Pa]. real, dimension(SZI_(G)) :: & - T_v, S_v, & ! Temperature, salinity, and pressure on the interface at - pres_v ! the v-point in the horizontal. + T_v, & ! Temperature on the interface at the v-point [degC]. + S_v, & ! Salinity on the interface at the v-point [ppt]. + pres_v ! Pressure on the interface at the v-point [Pa]. real :: drdiA, drdiB ! Along layer zonal- and meridional- potential density real :: drdjA, drdjB ! gradients in the layers above (A) and below(B) the ! interface times the grid spacing [kg m-3]. @@ -334,12 +336,12 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Temperature (deg C) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Salinity (psu) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Salinity [ppt] real, intent(in) :: kappa_dt !< A vertical diffusivity to use for smoothing !! times a smoothing timescale [Z2 ~> m2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature (deg C) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filed salinity (psu) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filed salinity [ppt] integer, optional, intent(in) :: halo_here !< Halo width over which to compute ! Local variables real :: ent(SZI_(G),SZK_(G)+1) ! The diffusive entrainment (kappa*dt)/dz @@ -347,7 +349,7 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here) real :: b1(SZI_(G)), d1(SZI_(G)) ! b1, c1, and d1 are variables used by the real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. real :: kap_dt_x2 ! The product of 2*kappa*dt, converted to - ! the same units as h, in m2 or kg2 m-4. + ! the same units as h squared, [H2 ~> m2 or kg2 m-4]. real :: h_neglect ! A negligible thickness [H ~> m or kg m-2], to ! allow for zero thicknesses. integer :: i, j, k, is, ie, js, je, nz, halo diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 7404c25a43..8db9a02f79 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -37,38 +37,38 @@ module MOM_variables !! will be returned to a the calling program type, public :: surface real, allocatable, dimension(:,:) :: & - SST, & !< The sea surface temperature in C. - SSS, & !< The sea surface salinity in psu. - sfc_density, & !< The mixed layer density in kg m-3. - Hml, & !< The mixed layer depth in m. + SST, & !< The sea surface temperature [degC]. + SSS, & !< The sea surface salinity [ppt ~> psu or gSalt/kg]. + sfc_density, & !< The mixed layer density [kg m-3]. + Hml, & !< The mixed layer depth [m]. u, & !< The mixed layer zonal velocity [m s-1]. v, & !< The mixed layer meridional velocity [m s-1]. - sea_lev, & !< The sea level in m. If a reduced surface gravity is + sea_lev, & !< The sea level [m]. If a reduced surface gravity is !! used, that is compensated for in sea_lev. melt_potential, & !< instantaneous amount of heat that can be used to melt sea ice, !! in J m-2. This is computed w.r.t. surface freezing temperature. - ocean_mass, & !< The total mass of the ocean in kg m-2. - ocean_heat, & !< The total heat content of the ocean in C kg m-2. - ocean_salt, & !< The total salt content of the ocean in kgSalt m-2. + ocean_mass, & !< The total mass of the ocean [kg m-2]. + ocean_heat, & !< The total heat content of the ocean in [degC kg m-2]. + ocean_salt, & !< The total salt content of the ocean in [kgSalt m-2]. salt_deficit !< The salt needed to maintain the ocean column at a minimum - !! salinity of 0.01 PSU over the call to step_MOM, in kgSalt m-2. + !! salinity of 0.01 PSU over the call to step_MOM [kgSalt m-2]. logical :: T_is_conT = .false. !< If true, the temperature variable SST is actually the - !! conservative temperature [degC]. + !! conservative temperature in [degC]. logical :: S_is_absS = .false. !< If true, the salinity variable SSS is actually the - !! absolute salinity, in g/kg. + !! absolute salinity in [g/kg]. real, pointer, dimension(:,:) :: & taux_shelf => NULL(), & !< The zonal stresses on the ocean under shelves [Pa]. tauy_shelf => NULL() !< The meridional stresses on the ocean under shelves [Pa]. real, pointer, dimension(:,:) :: frazil => NULL() !< The energy needed to heat the ocean column to the freezing point during the call - !! to step_MOM, in J m-2. + !! to step_MOM [J m-2]. real, pointer, dimension(:,:) :: TempxPmE => NULL() !< The net inflow of water into the ocean times the temperature at which this inflow - !! occurs during the call to step_MOM, in deg C kg m-2. This should be prescribed in the + !! occurs during the call to step_MOM [degC kg m-2]. This should be prescribed in the !! forcing fields, but as it often is not, this is a useful heat budget diagnostic. real, pointer, dimension(:,:) :: internal_heat => NULL() !< Any internal or geothermal heat sources that are applied to the ocean integrated - !! over the call to step_MOM, in deg C kg m-2. + !! over the call to step_MOM [degC kg m-2]. type(coupler_2d_bc_type) :: tr_fields !< A structure that may contain an !! array of named fields describing tracer-related quantities. !### NOTE: ALL OF THE ARRAYS IN TR_FIELDS USE THE COUPLER'S INDEXING CONVENTION AND HAVE NO @@ -123,8 +123,8 @@ module MOM_variables !! they refer to in MOM.F90. type, public :: ocean_internal_state real, pointer, dimension(:,:,:) :: & - T => NULL(), & !< Pointer to the temperature state variable, in deg C - S => NULL(), & !< Pointer to the salinity state variable, in PSU or g/kg + T => NULL(), & !< Pointer to the temperature state variable [degC] + S => NULL(), & !< Pointer to the salinity state variable [ppt ~> PSU or g/kg] u => NULL(), & !< Pointer to the zonal velocity [m s-1] v => NULL(), & !< Pointer to the meridional velocity [m s-1] h => NULL() !< Pointer to the layer thicknesses [H ~> m or kg m-2] @@ -197,7 +197,7 @@ module MOM_variables !> Vertical viscosities, drag coefficients, and related fields. type, public :: vertvisc_type real :: Prandtl_turb !< The Prandtl number for the turbulent diffusion - !! that is captured in Kd_shear. + !! that is captured in Kd_shear [nondim]. real, pointer, dimension(:,:) :: & bbl_thick_u => NULL(), & !< The bottom boundary layer thickness at the u-points [Z ~> m]. bbl_thick_v => NULL(), & !< The bottom boundary layer thickness at the v-points [Z ~> m]. @@ -224,7 +224,7 @@ module MOM_variables !! terms of layers, not depth, to facilitate the movement of the viscous boundary layer !! with the flow. real, pointer, dimension(:,:) :: nkml_visc_v => NULL() - !< The number of layers in the viscous surface mixed layer at v-points (nondimensional). + !< The number of layers in the viscous surface mixed layer at v-points [nondim]. real, pointer, dimension(:,:) :: & MLD => NULL() !< Instantaneous active mixing layer depth [H ~> m or kg m-2]. real, pointer, dimension(:,:,:) :: & diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index ac3d5d4a6d..a824553a84 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -25,7 +25,7 @@ module MOM_verticalGrid ! Commonly used parameters integer :: ke !< The number of layers/levels in the vertical - real :: max_depth !< The maximum depth of the ocean in Z (often m). + real :: max_depth !< The maximum depth of the ocean [Z ~> m]. real :: g_Earth !< The gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. real :: Rho0 !< The density used in the Boussinesq approximation or nominal !! density used to convert depths into mass units [kg m-3]. @@ -40,15 +40,15 @@ module MOM_verticalGrid ! The following variables give information about the vertical grid. logical :: Boussinesq !< If true, make the Boussinesq approximation. - real :: Angstrom_H !< A one-Angstrom thickness in the model thickness units. - real :: Angstrom_Z !< A one-Angstrom thickness in the model depth units. - real :: Angstrom_m !< A one-Angstrom thickness in m. + real :: Angstrom_H !< A one-Angstrom thickness in the model thickness units [H ~> m or kg m-2]. + real :: Angstrom_Z !< A one-Angstrom thickness in the model depth units [Z ~> m]. + real :: Angstrom_m !< A one-Angstrom thickness [m]. real :: H_subroundoff !< A thickness that is so small that it can be added to a thickness of - !! Angstrom or larger without changing it at the bit level, in thickness units. + !! Angstrom or larger without changing it at the bit level [H ~> m or kg m-2]. !! If Angstrom is 0 or exceedingly small, this is negligible compared to 1e-17 m. real, allocatable, dimension(:) :: & g_prime, & !< The reduced gravity at each interface [m2 Z-1 s-2 ~> m s-2]. - Rlay !< The target coordinate value (potential density) in each layer in kg m-3. + Rlay !< The target coordinate value (potential density) in each layer [kg m-3]. integer :: nkml = 0 !< The number of layers at the top that should be treated !! as parts of a homogenous region. integer :: nk_rho_varies = 0 !< The number of layers at the top where the @@ -57,7 +57,7 @@ module MOM_verticalGrid real :: kg_m2_to_H !< A constant that translates thicknesses from kg m-2 to the units of thickness. real :: m_to_H !< A constant that translates distances in m to the units of thickness. real :: H_to_m !< A constant that translates distances in the units of thickness to m. - real :: H_to_Pa !< A constant that translates the units of thickness to pressure in Pa. + real :: H_to_Pa !< A constant that translates the units of thickness to pressure [Pa]. real :: H_to_Z !< A constant that translates thickness units to the units of depth. real :: Z_to_H !< A constant that translates depth units to thickness units. diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 4d894ba1a2..37e4b6c03b 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -699,8 +699,8 @@ end subroutine calculate_diagnostic_fields !! weights that should be assigned to elements k and k+1. subroutine find_weights(Rlist, R_in, k, nz, wt, wt_p) real, dimension(:), & - intent(in) :: Rlist !< The list of target densities, in kg m-3 - real, intent(in) :: R_in !< The density being inserted into Rlist, in kg m-3 + intent(in) :: Rlist !< The list of target densities [kg m-3] + real, intent(in) :: R_in !< The density being inserted into Rlist [kg m-3] integer, intent(inout) :: k !< The value of k such that Rlist(k) <= R_in < Rlist(k+1) !! The input value is a first guess integer, intent(in) :: nz !< The number of layers in Rlist diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 43b99b46e0..a872d3d5a6 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -92,13 +92,13 @@ module MOM_EOS logical :: Compressible = .true. !< If true, in situ density is a function of pressure. ! The following parameters are used with the linear equation of state only. real :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. - real :: dRho_dT !< The partial derivatives of density with temperature - real :: dRho_dS !< and salinity, in kg m-3 K-1 and kg m-3 psu-1. + real :: dRho_dT !< The partial derivative of density with temperature [kg m-3 degC-1] + real :: dRho_dS !< The partial derivative of density with salinity [kg m-3 ppt-1]. ! The following parameters are use with the linear expression for the freezing ! point only. - real :: TFr_S0_P0 !< The freezing potential temperature at S=0, P=0 in deg C. - real :: dTFr_dS !< The derivative of freezing point with salinity, in deg C PSU-1. - real :: dTFr_dp !< The derivative of freezing point with pressure, in deg C Pa-1. + real :: TFr_S0_P0 !< The freezing potential temperature at S=0, P=0 [degC]. + real :: dTFr_dS !< The derivative of freezing point with salinity [deg C ppt-1]. + real :: dTFr_dp !< The derivative of freezing point with pressure [deg C Pa-1]. ! logical :: test_EOS = .true. ! If true, test the equation of state end type EOS_type @@ -131,12 +131,12 @@ module MOM_EOS !> Calls the appropriate subroutine to calculate density of sea water for scalar inputs. !! If rho_ref is present, the anomaly with respect to rho_ref is returned. subroutine calculate_density_scalar(T, S, pressure, rho, EOS, rho_ref) - real, intent(in) :: T !< Potential temperature referenced to the surface (degC) - real, intent(in) :: S !< Salinity (PSU) - real, intent(in) :: pressure !< Pressure (Pa) - real, intent(out) :: rho !< Density (in-situ if pressure is local) (kg m-3) + real, intent(in) :: T !< Potential temperature referenced to the surface [degC] + real, intent(in) :: S !< Salinity [ppt] + real, intent(in) :: pressure !< Pressure [Pa] + real, intent(out) :: rho !< Density (in-situ if pressure is local) [kg m-3] type(EOS_type), pointer :: EOS !< Equation of state structure - real, optional, intent(in) :: rho_ref !< A reference density in kg m-3. + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_scalar called with an unassociated EOS_type EOS.") @@ -163,14 +163,14 @@ end subroutine calculate_density_scalar !> Calls the appropriate subroutine to calculate the density of sea water for 1-D array inputs. !! If rho_ref is present, the anomaly with respect to rho_ref is returned. subroutine calculate_density_array(T, S, pressure, rho, start, npts, EOS, rho_ref) - real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface (degC) - real, dimension(:), intent(in) :: S !< Salinity (PSU) - real, dimension(:), intent(in) :: pressure !< Pressure (Pa) - real, dimension(:), intent(out) :: rho !< Density (in-situ if pressure is local) (kg m-3) + real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] + real, dimension(:), intent(in) :: S !< Salinity [ppt] + real, dimension(:), intent(in) :: pressure !< Pressure [Pa] + real, dimension(:), intent(out) :: rho !< Density (in-situ if pressure is local) [kg m-3] integer, intent(in) :: start !< Start index for computation integer, intent(in) :: npts !< Number of point to compute type(EOS_type), pointer :: EOS !< Equation of state structure - real, optional, intent(in) :: rho_ref !< A reference density in kg m-3. + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_array called with an unassociated EOS_type EOS.") @@ -197,12 +197,12 @@ end subroutine calculate_density_array !> Calls the appropriate subroutine to calculate specific volume of sea water !! for scalar inputs. subroutine calculate_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref) - real, intent(in) :: T !< Potential temperature referenced to the surface (degC) - real, intent(in) :: S !< Salinity (PSU) - real, intent(in) :: pressure !< Pressure (Pa) + real, intent(in) :: T !< Potential temperature referenced to the surface [degC] + real, intent(in) :: S !< Salinity [ppt] + real, intent(in) :: pressure !< Pressure [Pa] real, intent(out) :: specvol !< specific volume (in-situ if pressure is local) (m3 kg-1) type(EOS_type), pointer :: EOS !< Equation of state structure - real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1. + real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. real :: rho @@ -238,14 +238,14 @@ end subroutine calculate_spec_vol_scalar !! for 1-D array inputs. subroutine calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, spv_ref) real, dimension(:), intent(in) :: T !< potential temperature relative to the surface - !! in C. - real, dimension(:), intent(in) :: S !< salinity in PSU. - real, dimension(:), intent(in) :: pressure !< pressure in Pa. - real, dimension(:), intent(out) :: specvol !< in situ specific volume in kg m-3. + !! [degC]. + real, dimension(:), intent(in) :: S !< salinity [ppt]. + real, dimension(:), intent(in) :: pressure !< pressure [Pa]. + real, dimension(:), intent(out) :: specvol !< in situ specific volume [kg m-3]. integer, intent(in) :: start !< the starting point in the arrays. integer, intent(in) :: npts !< the number of values to calculate. type(EOS_type), pointer :: EOS !< Equation of state structure - real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1. + real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. real, dimension(size(specvol)) :: rho @@ -280,10 +280,10 @@ end subroutine calculate_spec_vol_array !> Calls the appropriate subroutine to calculate the freezing point for scalar inputs. subroutine calculate_TFreeze_scalar(S, pressure, T_fr, EOS) - real, intent(in) :: S !< Salinity (PSU) - real, intent(in) :: pressure !< Pressure (Pa) + real, intent(in) :: S !< Salinity [ppt] + real, intent(in) :: pressure !< Pressure [Pa] real, intent(out) :: T_fr !< Freezing point potential temperature referenced - !! to the surface (degC) + !! to the surface [degC] type(EOS_type), pointer :: EOS !< Equation of state structure if (.not.associated(EOS)) call MOM_error(FATAL, & @@ -306,10 +306,10 @@ end subroutine calculate_TFreeze_scalar !> Calls the appropriate subroutine to calculate the freezing point for a 1-D array. subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS) - real, dimension(:), intent(in) :: S !< Salinity (PSU) - real, dimension(:), intent(in) :: pressure !< Pressure (Pa) + real, dimension(:), intent(in) :: S !< Salinity [ppt] + real, dimension(:), intent(in) :: pressure !< Pressure [Pa] real, dimension(:), intent(out) :: T_fr !< Freezing point potential temperature referenced - !! to the surface (degC) + !! to the surface [degC] integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), pointer :: EOS !< Equation of state structure @@ -334,17 +334,17 @@ end subroutine calculate_TFreeze_array !> Calls the appropriate subroutine to calculate density derivatives for 1-D array inputs. subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, start, npts, EOS) - real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface (degC) - real, dimension(:), intent(in) :: S !< Salinity (PSU) - real, dimension(:), intent(in) :: pressure !< Pressure (Pa) + real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] + real, dimension(:), intent(in) :: S !< Salinity [ppt] + real, dimension(:), intent(in) :: pressure !< Pressure [Pa] real, dimension(:), intent(out) :: drho_dT !< The partial derivative of density with potential - !! temperature, in kg m-3 K-1. + !! temperature [kg m-3 degC-1]. real, dimension(:), intent(out) :: drho_dS !< The partial derivative of density with salinity, - !! in kg m-3 psu-1. + !! in [kg m-3 ppt-1]. integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), pointer :: EOS !< Equation of state structure - !! + if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") @@ -370,13 +370,13 @@ end subroutine calculate_density_derivs_array !> Calls the appropriate subroutines to calculate density derivatives by promoting a scalar !! to a one-element array subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS) - real, intent(in) :: T !< Potential temperature referenced to the surface (degC) - real, intent(in) :: S !< Salinity (PSU) - real, intent(in) :: pressure !< Pressure (Pa) + real, intent(in) :: T !< Potential temperature referenced to the surface [degC] + real, intent(in) :: S !< Salinity [ppt] + real, intent(in) :: pressure !< Pressure [Pa] real, intent(out) :: drho_dT !< The partial derivative of density with potential - !! temperature, in kg m-3 K-1. + !! temperature [kg m-3 degC-1]. real, intent(out) :: drho_dS !< The partial derivative of density with salinity, - !! in kg m-3 psu-1. + !! in [kg m-3 ppt-1]. type(EOS_type), pointer :: EOS !< Equation of state structure if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") @@ -399,18 +399,23 @@ end subroutine calculate_density_derivs_scalar !> Calls the appropriate subroutine to calculate density second derivatives for 1-D array inputs. subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & drho_dS_dP, drho_dT_dP, start, npts, EOS) - real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface (degC) - real, dimension(:), intent(in) :: S !< Salinity (PSU) - real, dimension(:), intent(in) :: pressure !< Pressure (Pa) - real, dimension(:), intent(out) :: drho_dS_dS !< Partial derivative of beta with respect to S - real, dimension(:), intent(out) :: drho_dS_dT !< Partial derivative of beta with resepct to T - real, dimension(:), intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect to T - real, dimension(:), intent(out) :: drho_dS_dP !< Partial derivative of beta with respect to pressure - real, dimension(:), intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect to pressure + real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] + real, dimension(:), intent(in) :: S !< Salinity [ppt] + real, dimension(:), intent(in) :: pressure !< Pressure [Pa] + real, dimension(:), intent(out) :: drho_dS_dS !< Partial derivative of beta with respect + !! to S [kg m-3 ppt-2] + real, dimension(:), intent(out) :: drho_dS_dT !< Partial derivative of beta with respcct + !! to T [kg m-3 ppt-1 degC-1] + real, dimension(:), intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect + !! to T [kg m-3 degC-2] + real, dimension(:), intent(out) :: drho_dS_dP !< Partial derivative of beta with respect + !! to pressure [kg m-3 ppt-1 Pa-1] + real, dimension(:), intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect + !! to pressure [kg m-3 degC-1 Pa-1] integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), pointer :: EOS !< Equation of state structure - !! + if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") @@ -434,16 +439,21 @@ end subroutine calculate_density_second_derivs_array !> Calls the appropriate subroutine to calculate density second derivatives for scalar nputs. subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & drho_dS_dP, drho_dT_dP, EOS) - real, intent(in) :: T !< Potential temperature referenced to the surface (degC) - real, intent(in) :: S !< Salinity (PSU) - real, intent(in) :: pressure !< Pressure (Pa) - real, intent(out) :: drho_dS_dS !< Partial derivative of beta with respect to S - real, intent(out) :: drho_dS_dT !< Partial derivative of beta with resepct to T - real, intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect to T - real, intent(out) :: drho_dS_dP !< Partial derivative of beta with respect to pressure - real, intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect to pressure + real, intent(in) :: T !< Potential temperature referenced to the surface [degC] + real, intent(in) :: S !< Salinity [ppt] + real, intent(in) :: pressure !< Pressure [Pa] + real, intent(out) :: drho_dS_dS !< Partial derivative of beta with respect + !! to S [kg m-3 ppt-2] + real, intent(out) :: drho_dS_dT !< Partial derivative of beta with respcct + !! to T [kg m-3 ppt-1 degC-1] + real, intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect + !! to T [kg m-3 degC-2] + real, intent(out) :: drho_dS_dP !< Partial derivative of beta with respect + !! to pressure [kg m-3 ppt-1 Pa-1] + real, intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect + !! to pressure [kg m-3 degC-1 Pa-1] type(EOS_type), pointer :: EOS !< Equation of state structure - !! + if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") @@ -466,13 +476,13 @@ end subroutine calculate_density_second_derivs_scalar !> Calls the appropriate subroutine to calculate specific volume derivatives for an array. subroutine calculate_specific_vol_derivs(T, S, pressure, dSV_dT, dSV_dS, start, npts, EOS) - real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface (degC) - real, dimension(:), intent(in) :: S !< Salinity (PSU) - real, dimension(:), intent(in) :: pressure !< Pressure (Pa) + real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] + real, dimension(:), intent(in) :: S !< Salinity [ppt] + real, dimension(:), intent(in) :: pressure !< Pressure [Pa] real, dimension(:), intent(out) :: dSV_dT !< The partial derivative of specific volume with potential - !! temperature, in m3 kg-1 K-1. - real, dimension(:), intent(out) :: dSV_dS !< The partial derivative of specific volume with salinity, - !! in m3 kg-1 / (g/kg). + !! temperature [m3 kg-1 degC-1]. + real, dimension(:), intent(out) :: dSV_dS !< The partial derivative of specific volume with salinity + !! [m3 kg-1 ppt-1]. integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), pointer :: EOS !< Equation of state structure @@ -514,10 +524,10 @@ end subroutine calculate_specific_vol_derivs !> Calls the appropriate subroutine to calculate the density and compressibility for 1-D array inputs. subroutine calculate_compress(T, S, pressure, rho, drho_dp, start, npts, EOS) - real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface (degC) - real, dimension(:), intent(in) :: S !< Salinity (PSU) - real, dimension(:), intent(in) :: pressure !< Pressure (Pa) - real, dimension(:), intent(out) :: rho !< In situ density in kg m-3. + real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface [degC] + real, dimension(:), intent(in) :: S !< Salinity [ppt] + real, dimension(:), intent(in) :: pressure !< Pressure [Pa] + real, dimension(:), intent(out) :: rho !< In situ density [kg m-3]. real, dimension(:), intent(out) :: drho_dp !< The partial derivative of density with pressure !! (also the inverse of the square of sound speed) in s2 m-2. integer, intent(in) :: start !< Starting index within the array @@ -557,13 +567,13 @@ subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & bathyP, dP_tiny, useMassWghtInterp) type(hor_index_type), intent(in) :: HI !< The horizontal index structure real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: T !< Potential temperature referenced to the surface (degC) + intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: S !< Salinity (PSU) + intent(in) :: S !< Salinity [ppt] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_t !< Pressure at the top of the layer in Pa. + intent(in) :: p_t !< Pressure at the top of the layer [Pa]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_b !< Pressure at the bottom of the layer in Pa. + intent(in) :: p_b !< Pressure at the bottom of the layer [Pa]. real, intent(in) :: alpha_ref !< A mean specific volume that is subtracted out !! to reduce the magnitude of each of the integrals, m3 kg-1. The !! calculation is mathematically identical with different values of @@ -575,7 +585,7 @@ subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & optional, intent(out) :: intp_dza !< The integral in pressure through the layer of the !! geopotential anomaly relative to the anomaly at the bottom of the - !! layer, in Pa m2 s-2. + !! layer [Pa m2 s-2]. real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), & optional, intent(out) :: intx_dza !< The integral in x of the difference between the !! geopotential anomaly at the top and bottom of the layer divided by @@ -626,16 +636,16 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, & type(hor_index_type), intent(in) :: HII !< Ocean horizontal index structures for the input arrays type(hor_index_type), intent(in) :: HIO !< Ocean horizontal index structures for the output arrays real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: T !< Potential temperature referenced to the surface (degC) + intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: S !< Salinity (PSU) + intent(in) :: S !< Salinity [ppt] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_b !< Height at the bottom of the layer [Z ~> m]. - real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to + real, intent(in) :: rho_ref !< A mean density [kg m-3], that is subtracted out to !! reduce the magnitude of each of the integrals. - real, intent(in) :: rho_0 !< A density, in kg m-3, that is used to calculate the + real, intent(in) :: rho_0 !< A density [kg m-3], that is used to calculate the !! pressure (as p~=-z*rho_0*G_e) used in the equation of state. real, intent(in) :: G_e !< The Earth's gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. type(EOS_type), pointer :: EOS !< Equation of state structure @@ -644,7 +654,7 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, EOS, & real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer of !! the pressure anomaly relative to the anomaly at the - !! top of the layer, in Pa Z. + !! top of the layer [Pa Z ~> Pa m]. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the layer @@ -804,11 +814,11 @@ subroutine EOS_manual_init(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Co logical, optional, intent(in) :: EOS_quadrature !< If true, always use the generic (quadrature) !! code for the integrals of density. logical, optional, intent(in) :: Compressible !< If true, in situ density is a function of pressure. - real , optional, intent(in) :: Rho_T0_S0 !< Density at T=0 degC and S=0 ppt (kg m-3) + real , optional, intent(in) :: Rho_T0_S0 !< Density at T=0 degC and S=0 ppt [kg m-3] real , optional, intent(in) :: drho_dT !< Partial derivative of density with temperature - !! in (kg m-3 degC-1) + !! in [kg m-3 degC-1] real , optional, intent(in) :: dRho_dS !< Partial derivative of density with salinity - !! in (kg m-3 ppt-1) + !! in [kg m-3 ppt-1] real , optional, intent(in) :: TFr_S0_P0 !< The freezing potential temperature at S=0, P=0 in deg C. real , optional, intent(in) :: dTFr_dS !< The derivative of freezing point with salinity, !! in deg C PSU-1. @@ -848,9 +858,9 @@ end subroutine EOS_end !! EOS_type (EOS argument) to be set to use the linear equation of state !! independent from the rest of the model. subroutine EOS_use_linear(Rho_T0_S0, dRho_dT, dRho_dS, EOS, use_quadrature) - real, intent(in) :: Rho_T0_S0 !< Density at T=0 degC and S=0 ppt (kg m-3) - real, intent(in) :: dRho_dT !< Partial derivative of density with temperature (kg m-3 degC-1) - real, intent(in) :: dRho_dS !< Partial derivative of density with salinity (kg m-3 ppt-1) + real, intent(in) :: Rho_T0_S0 !< Density at T=0 degC and S=0 ppt [kg m-3] + real, intent(in) :: dRho_dT !< Partial derivative of density with temperature [kg m-3 degC-1] + real, intent(in) :: dRho_dS !< Partial derivative of density with salinity [kg m-3 ppt-1] logical, optional, intent(in) :: use_quadrature !< If true, always use the generic (quadrature) !! code for the integrals of density. type(EOS_type), pointer :: EOS !< Equation of state structure @@ -877,17 +887,17 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, type(hor_index_type), intent(in) :: HII !< Horizontal index type for input variables. type(hor_index_type), intent(in) :: HIO !< Horizontal index type for output variables. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: T !< Potential temperature of the layer in C. + intent(in) :: T !< Potential temperature of the layer [degC]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: S !< Salinity of the layer in PSU. + intent(in) :: S !< Salinity of the layer [ppt]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_b !< Height at the bottom of the layer [Z ~> m]. - real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is + real, intent(in) :: rho_ref !< A mean density [kg m-3], that is !! subtracted out to reduce the magnitude !! of each of the integrals. - real, intent(in) :: rho_0 !< A density, in kg m-3, that is used + real, intent(in) :: rho_0 !< A density [kg m-3], that is used !! to calculate the pressure (as p~=-z*rho_0*G_e) !! used in the equation of state. real, intent(in) :: G_e !< The Earth's gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. @@ -898,7 +908,7 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the !! layer of the pressure anomaly relative to the - !! anomaly at the top of the layer, in Pa Z. + !! anomaly at the top of the layer [Pa Z ~> Pa m]. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between !! the pressure anomaly at the top and bottom of the @@ -913,7 +923,7 @@ subroutine int_density_dz_generic(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. real :: T5(5), S5(5), p5(5), r5(5) - real :: rho_anom ! The depth averaged density anomaly in kg m-3. + real :: rho_anom ! The depth averaged density anomaly [kg m-3]. real :: w_left, w_right real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. real :: GxRho, I_Rho @@ -1064,25 +1074,24 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & type(hor_index_type), intent(in) :: HII !< Ocean horizontal index structures for the input arrays type(hor_index_type), intent(in) :: HIO !< Ocean horizontal index structures for the output arrays real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: T_t !< Potential temperatue at the cell top (degC) + intent(in) :: T_t !< Potential temperatue at the cell top [degC] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: T_b !< Potential temperatue at the cell bottom (degC) + intent(in) :: T_b !< Potential temperatue at the cell bottom [degC] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: S_t !< Salinity at the cell top (ppt) + intent(in) :: S_t !< Salinity at the cell top [ppt] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: S_b !< Salinity at the cell bottom (ppt) + intent(in) :: S_b !< Salinity at the cell bottom [ppt] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_t !< The geometric height at the top of the layer, !! in depth units [Z ~> m]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_b !< The geometric height at the bottom of the layer [Z ~> m]. - real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to + real, intent(in) :: rho_ref !< A mean density [kg m-3], that is subtracted out to !! reduce the magnitude of each of the integrals. - real, intent(in) :: rho_0 !< A density, in kg m-3, that is used to calculate the + real, intent(in) :: rho_0 !< A density [kg m-3], that is used to calculate the !! pressure (as p~=-z*rho_0*G_e) used in the equation of state. real, intent(in) :: G_e !< The Earth's gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. - real, intent(in) :: dz_subroundoff !< A miniscule thickness - !! change with the same units as z_t + real, intent(in) :: dz_subroundoff !< A miniscule thickness change [Z ~> m]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m]. type(EOS_type), pointer :: EOS !< Equation of state structure @@ -1091,7 +1100,7 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer of !! the pressure anomaly relative to the anomaly at the - !! top of the layer, in Pa Z. + !! top of the layer [Pa Z]. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the layer @@ -1114,29 +1123,29 @@ subroutine int_density_dz_generic_plm (T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, & ! a linear interpolation is used to compute intermediate values. ! Local variables - real :: T5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Temperatures along a line of subgrid locations, in degC. - real :: S5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Salinities along a line of subgrid locations, in ppt. - real :: p5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Pressures along a line of subgrid locations, in Pa. - real :: r5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Densities along a line of subgrid locations, in kg m-3. - real :: T15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Temperatures at an array of subgrid locations, in degC. - real :: S15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Salinities at an array of subgrid locations, in ppt. - real :: p15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Pressures at an array of subgrid locations, in Pa. - real :: r15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Densities at an array of subgrid locations, in kg m-3. + real :: T5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Temperatures along a line of subgrid locations [degC]. + real :: S5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Salinities along a line of subgrid locations [ppt]. + real :: p5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Pressures along a line of subgrid locations [Pa]. + real :: r5((5*HIO%iscB+1):(5*(HIO%iecB+2))) ! Densities along a line of subgrid locations [kg m-3]. + real :: T15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Temperatures at an array of subgrid locations [degC]. + real :: S15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Salinities at an array of subgrid locations [ppt]. + real :: p15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Pressures at an array of subgrid locations [Pa]. + real :: r15((15*HIO%iscB+1):(15*(HIO%iecB+1))) ! Densities at an array of subgrid locations [kg m-3]. real :: wt_t(5), wt_b(5) ! Top and bottom weights [nondim]. - real :: rho_anom ! A density anomaly in kg m-3. + real :: rho_anom ! A density anomaly [kg m-3]. real :: w_left, w_right ! Left and right weights [nondim]. real :: intz(5) ! The gravitational acceleration times the integrals of density ! with height at the 5 sub-column locations [Pa]. real, parameter :: C1_90 = 1.0/90.0 ! A rational constant [nondim]. - real :: GxRho ! Gravitational acceleration times density, in kg m-1 Z-1 s-2. - real :: I_Rho ! The inverse of the reference density, in m3 kg-1. + real :: GxRho ! Gravitational acceleration times density [kg m-1 Z-1 s-2 ~> kg m-2 s-2]. + real :: I_Rho ! The inverse of the reference density [m3 kg-1]. real :: dz(HIO%iscB:HIO%iecB+1) ! Layer thicknesses at tracer points [Z ~> m]. real :: dz_x(5,HIO%iscB:HIO%iecB) ! Layer thicknesses along an x-line of subrid locations [Z ~> m]. real :: dz_y(5,HIO%isc:HIO%iec) ! Layer thicknesses along a y-line of subrid locations [Z ~> m]. real :: weight_t, weight_b ! Nondimensional wieghts of the top and bottom. real :: massWeightToggle ! A nondimensional toggle factor (0 or 1). real :: Ttl, Tbl, Ttr, Tbr ! Temperatures at the velocity cell corners [degC]. - real :: Stl, Sbl, Str, Sbr ! Salinities at the velocity cell corners, in ppt. + real :: Stl, Sbl, Str, Sbr ! Salinities at the velocity cell corners [ppt]. real :: hWght ! A topographically limited thicknes weight [Z ~> m]. real :: hL, hR ! Thicknesses to the left and right [Z ~> m]. real :: iDenom ! The denominator of the thickness weight expressions [Z-2 ~> m-2]. @@ -1361,18 +1370,18 @@ end subroutine int_density_dz_generic_plm !> Find the depth at which the reconstructed pressure matches P_tgt subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_tgt, & rho_ref, G_e, EOS, P_b, z_out, z_tol) - real, intent(in) :: T_t !< Potential temperatue at the cell top (degC) - real, intent(in) :: T_b !< Potential temperatue at the cell bottom (degC) - real, intent(in) :: S_t !< Salinity at the cell top (ppt) - real, intent(in) :: S_b !< Salinity at the cell bottom (ppt) + real, intent(in) :: T_t !< Potential temperatue at the cell top [degC] + real, intent(in) :: T_b !< Potential temperatue at the cell bottom [degC] + real, intent(in) :: S_t !< Salinity at the cell top [ppt] + real, intent(in) :: S_b !< Salinity at the cell bottom [ppt] real, intent(in) :: z_t !< Absolute height of top of cell [Z ~> m]. (Boussinesq ????) real, intent(in) :: z_b !< Absolute height of bottom of cell [Z ~> m]. - real, intent(in) :: P_t !< Anomalous pressure of top of cell, relative to g*rho_ref*z_t (Pa) - real, intent(in) :: P_tgt !< Target pressure at height z_out, relative to g*rho_ref*z_out (Pa) + real, intent(in) :: P_t !< Anomalous pressure of top of cell, relative to g*rho_ref*z_t [Pa] + real, intent(in) :: P_tgt !< Target pressure at height z_out, relative to g*rho_ref*z_out [Pa] real, intent(in) :: rho_ref !< Reference density with which calculation are anomalous to real, intent(in) :: G_e !< Gravitational acceleration (m2 Z-1 s-2) type(EOS_type), pointer :: EOS !< Equation of state structure - real, intent(out) :: P_b !< Pressure at the bottom of the cell (Pa) + real, intent(out) :: P_b !< Pressure at the bottom of the cell [Pa] real, intent(out) :: z_out !< Absolute depth at which anomalous pressure = p_tgt [Z ~> m]. real, optional, intent(in) :: z_tol !< The tolerance in finding z_out [Z ~> m]. ! Local variables @@ -1433,16 +1442,16 @@ end subroutine find_depth_of_pressure_in_cell !> Returns change in anomalous pressure change from top to non-dimensional !! position pos between z_t and z_b real function frac_dp_at_pos(T_t, T_b, S_t, S_b, z_t, z_b, rho_ref, G_e, pos, EOS) - real, intent(in) :: T_t !< Potential temperatue at the cell top (degC) - real, intent(in) :: T_b !< Potential temperatue at the cell bottom (degC) - real, intent(in) :: S_t !< Salinity at the cell top (ppt) - real, intent(in) :: S_b !< Salinity at the cell bottom (ppt) - real, intent(in) :: z_t !< The geometric height at the top of the layer, usually in m - real, intent(in) :: z_b !< The geometric height at the bottom of the layer, usually in m - real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to + real, intent(in) :: T_t !< Potential temperatue at the cell top [degC] + real, intent(in) :: T_b !< Potential temperatue at the cell bottom [degC] + real, intent(in) :: S_t !< Salinity at the cell top [ppt] + real, intent(in) :: S_b !< Salinity at the cell bottom [ppt] + real, intent(in) :: z_t !< The geometric height at the top of the layer [Z ~> m] + real, intent(in) :: z_b !< The geometric height at the bottom of the layer [Z ~> m] + real, intent(in) :: rho_ref !< A mean density [kg m-3], that is subtracted out to !! reduce the magnitude of each of the integrals. real, intent(in) :: G_e !< The Earth's gravitational acceleration [m s-2] - real, intent(in) :: pos !< The fractional vertical position, nondim, 0 to 1. + real, intent(in) :: pos !< The fractional vertical position, 0 to 1 [nondim]. type(EOS_type), pointer :: EOS !< Equation of state structure ! Local variables real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. @@ -1480,24 +1489,24 @@ subroutine int_density_dz_generic_ppm (T, T_t, T_b, S, S_t, S_b, & type(hor_index_type), intent(in) :: HII !< Ocean horizontal index structures for the input arrays type(hor_index_type), intent(in) :: HIO !< Ocean horizontal index structures for the output arrays real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: T !< Potential temperature referenced to the surface (degC) + intent(in) :: T !< Potential temperature referenced to the surface [degC] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: T_t !< Potential temperatue at the cell top (degC) + intent(in) :: T_t !< Potential temperatue at the cell top [degC] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: T_b !< Potential temperatue at the cell bottom (degC) + intent(in) :: T_b !< Potential temperatue at the cell bottom [degC] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: S !< Salinity (PSU) + intent(in) :: S !< Salinity [ppt] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: S_t !< Salinity at the cell top (ppt) + intent(in) :: S_t !< Salinity at the cell top [ppt] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: S_b !< Salinity at the cell bottom (ppt) + intent(in) :: S_b !< Salinity at the cell bottom [ppt] real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_t !< Height at the top of the layer in m. + intent(in) :: z_t !< Height at the top of the layer [Z ~> m]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: z_b !< Height at the bottom of the layer in m. - real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out to + intent(in) :: z_b !< Height at the bottom of the layer [Z ~> m]. + real, intent(in) :: rho_ref !< A mean density [kg m-3], that is subtracted out to !! reduce the magnitude of each of the integrals. - real, intent(in) :: rho_0 !< A density, in kg m-3, that is used to calculate the + real, intent(in) :: rho_0 !< A density [kg m-3], that is used to calculate the !! pressure (as p~=-z*rho_0*G_e) used in the equation of state. real, intent(in) :: G_e !< The Earth's gravitational acceleration [m s-2] type(EOS_type), pointer :: EOS !< Equation of state structure @@ -1506,7 +1515,7 @@ subroutine int_density_dz_generic_ppm (T, T_t, T_b, S, S_t, S_b, & real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer of !! the pressure anomaly relative to the anomaly at the - !! top of the layer, in Pa m. + !! top of the layer [Pa Z ~> Pa m]. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the layer @@ -1526,35 +1535,8 @@ subroutine int_density_dz_generic_ppm (T, T_t, T_b, S, S_t, S_b, & ! It is assumed that the salinity and temperature profiles are linear in the ! vertical. The top and bottom values within each layer are provided and ! a linear interpolation is used to compute intermediate values. -! -! Arguments: T - potential temperature relative to the surface in C -! (the 't' and 'b' subscripts refer to the values at -! the top and the bottom of each layer) -! (in) S - salinity in PSU. -! (the 't' and 'b' subscripts refer to the values at -! the top and the bottom of each layer) -! (in) z_t - height at the top of the layer in m. -! (in) z_b - height at the top of the layer in m. -! (in) rho_ref - A mean density, in kg m-3, that is subtracted out to reduce -! the magnitude of each of the integrals. -! (The pressure is calucated as p~=-z*rho_0*G_e.) -! (in) rho_0 - A density, in kg m-3, that is used to calculate the pressure -! (as p~=-z*rho_0*G_e) used in the equation of state. -! (in) G_e - The Earth's gravitational acceleration [m s-2] -! (in) G - The ocean's grid structure. -! (in) form_of_eos - integer that selects the eqn of state. -! (out) dpa - The change in the pressure anomaly across the layer, -! in Pa. -! (out,opt) intz_dpa - The integral through the thickness of the layer of the -! pressure anomaly relative to the anomaly at the top of -! the layer, in Pa m. -! (out,opt) intx_dpa - The integral in x of the difference between the -! pressure anomaly at the top and bottom of the layer -! divided by the x grid spacing [Pa]. -! (out,opt) inty_dpa - The integral in y of the difference between the -! pressure anomaly at the top and bottom of the layer -! divided by the y grid spacing [Pa]. + ! Local variables real :: T5(5), S5(5), p5(5), r5(5) real :: rho_anom real :: w_left, w_right, intz(5) @@ -1562,8 +1544,8 @@ subroutine int_density_dz_generic_ppm (T, T_t, T_b, S, S_t, S_b, & real :: GxRho, I_Rho real :: dz real :: weight_t, weight_b - real :: s0, s1, s2 ! parabola coefficients for S - real :: t0, t1, t2 ! parabola coefficients for T + real :: s0, s1, s2 ! parabola coefficients for S [ppt] + real :: t0, t1, t2 ! parabola coefficients for T [degC] real :: xi ! normalized coordinate real :: T_top, T_mid, T_bot real :: S_top, S_mid, S_bot @@ -1944,16 +1926,16 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, & bathyP, dP_neglect, useMassWghtInterp) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: T !< Potential temperature of the layer in C. + intent(in) :: T !< Potential temperature of the layer [degC]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: S !< Salinity of the layer in PSU. + intent(in) :: S !< Salinity of the layer [ppt]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_t !< Pressure atop the layer in Pa. + intent(in) :: p_t !< Pressure atop the layer [Pa]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_b !< Pressure below the layer in Pa. + intent(in) :: p_b !< Pressure below the layer [Pa]. real, intent(in) :: alpha_ref !< A mean specific volume that is !! subtracted out to reduce the magnitude of each of the - !! integrals, in m3 kg-1. The calculation is mathematically + !! integrals [m3 kg-1]. The calculation is mathematically !! identical with different values of alpha_ref, but alpha_ref !! alters the effects of roundoff, and answers do change. type(EOS_type), pointer :: EOS !< Equation of state structure @@ -1963,7 +1945,7 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, & real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & optional, intent(out) :: intp_dza !< The integral in pressure through the !! layer of the geopotential anomaly relative to the anomaly - !! at the bottom of the layer, in Pa m2 s-2. + !! at the bottom of the layer [Pa m2 s-2]. real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), & optional, intent(out) :: intx_dza !< The integral in x of the difference !! between the geopotential anomaly at the top and bottom of @@ -1988,12 +1970,12 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, & ! series for log(1-eps/1+eps) that assumes that |eps| < 0.34. real :: T5(5), S5(5), p5(5), a5(5) - real :: alpha_anom ! The depth averaged specific density anomaly in m3 kg-1. + real :: alpha_anom ! The depth averaged specific density anomaly [m3 kg-1]. real :: dp ! The pressure change through a layer [Pa]. ! real :: dp_90(2:4) ! The pressure change through a layer divided by 90 [Pa]. real :: hWght ! A pressure-thickness below topography [Pa]. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Pa]. - real :: iDenom ! The inverse of the denominator in the weights, in Pa-2. + real :: iDenom ! The inverse of the denominator in the weights [Pa-2]. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim]. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim]. real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim]. @@ -2134,20 +2116,20 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, intp_dza, intx_dza, inty_dza, useMassWghtInterp) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: T_t !< Potential temperature at the top of the layer in C. + intent(in) :: T_t !< Potential temperature at the top of the layer [degC]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: T_b !< Potential temperature at the bottom of the layer in C. + intent(in) :: T_b !< Potential temperature at the bottom of the layer [degC]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: S_t !< Salinity at the top the layer in PSU. + intent(in) :: S_t !< Salinity at the top the layer [ppt]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: S_b !< Salinity at the bottom the layer in PSU. + intent(in) :: S_b !< Salinity at the bottom the layer [ppt]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_t !< Pressure atop the layer in Pa. + intent(in) :: p_t !< Pressure atop the layer [Pa]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_b !< Pressure below the layer in Pa. + intent(in) :: p_b !< Pressure below the layer [Pa]. real, intent(in) :: alpha_ref !< A mean specific volume that is !! subtracted out to reduce the magnitude of each of the - !! integrals, in m3 kg-1. The calculation is mathematically + !! integrals [m3 kg-1]. The calculation is mathematically !! identical with different values of alpha_ref, but alpha_ref !! alters the effects of roundoff, and answers do change. real, intent(in) :: dP_neglect !< A miniscule pressure change with @@ -2161,7 +2143,7 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & optional, intent(out) :: intp_dza !< The integral in pressure through the !! layer of the geopotential anomaly relative to the anomaly - !! at the bottom of the layer, in Pa m2 s-2. + !! at the bottom of the layer [Pa m2 s-2]. real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), & optional, intent(out) :: intx_dza !< The integral in x of the difference !! between the geopotential anomaly at the top and bottom of @@ -2185,12 +2167,12 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, real :: wt_t(5), wt_b(5) real :: T_top, T_bot, S_top, S_bot, P_top, P_bot - real :: alpha_anom ! The depth averaged specific density anomaly in m3 kg-1. + real :: alpha_anom ! The depth averaged specific density anomaly [m3 kg-1]. real :: dp ! The pressure change through a layer [Pa]. real :: dp_90(2:4) ! The pressure change through a layer divided by 90 [Pa]. real :: hWght ! A pressure-thickness below topography [Pa]. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Pa]. - real :: iDenom ! The inverse of the denominator in the weights, in Pa-2. + real :: iDenom ! The inverse of the denominator in the weights [Pa-2]. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim]. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim]. real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim]. @@ -2360,10 +2342,10 @@ subroutine convert_temp_salt_for_TEOS10(T, S, press, G, kd, mask_z, EOS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & - intent(inout) :: T !< Potential temperature referenced to the surface (degC) + intent(inout) :: T !< Potential temperature referenced to the surface [degC] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & - intent(inout) :: S !< Salinity (PSU) - real, dimension(:), intent(in) :: press !< Pressure at the top of the layer in Pa. + intent(inout) :: S !< Salinity [ppt] + real, dimension(:), intent(in) :: press !< Pressure at the top of the layer [Pa]. type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & intent(in) :: mask_z !< 3d mask regulating which points to convert. @@ -2398,11 +2380,11 @@ subroutine extract_member_EOS(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, logical, optional, intent(out) :: EOS_quadrature !< If true, always use the generic (quadrature) !! code for the integrals of density. logical, optional, intent(out) :: Compressible !< If true, in situ density is a function of pressure. - real , optional, intent(out) :: Rho_T0_S0 !< Density at T=0 degC and S=0 ppt (kg m-3) + real , optional, intent(out) :: Rho_T0_S0 !< Density at T=0 degC and S=0 ppt [kg m-3] real , optional, intent(out) :: drho_dT !< Partial derivative of density with temperature - !! in (kg m-3 degC-1) + !! in [kg m-3 degC-1] real , optional, intent(out) :: dRho_dS !< Partial derivative of density with salinity - !! in (kg m-3 ppt-1) + !! in [kg m-3 ppt-1] real , optional, intent(out) :: TFr_S0_P0 !< The freezing potential temperature at S=0, P=0 in deg C. real , optional, intent(out) :: dTFr_dS !< The derivative of freezing point with salinity, !! in deg C PSU-1. diff --git a/src/equation_of_state/MOM_EOS_NEMO.F90 b/src/equation_of_state/MOM_EOS_NEMO.F90 index fcc005ca61..97ed9f8540 100644 --- a/src/equation_of_state/MOM_EOS_NEMO.F90 +++ b/src/equation_of_state/MOM_EOS_NEMO.F90 @@ -24,7 +24,7 @@ module MOM_EOS_NEMO !> Compute the in situ density of sea water ([kg m-3]), or its anomaly with respect to !! a reference density, from absolute salinity (g/kg), conservative temperature (in deg C), -!! and pressure in Pa, using the expressions derived for use with NEMO +!! and pressure [Pa], using the expressions derived for use with NEMO interface calculate_density_nemo module procedure calculate_density_scalar_nemo, calculate_density_array_nemo end interface calculate_density_nemo @@ -175,14 +175,14 @@ module MOM_EOS_NEMO !> This subroutine computes the in situ density of sea water (rho in !! [kg m-3]) from absolute salinity (S [g kg-1]), conservative temperature -!! (T [degC]), and pressure in Pa. It uses the expressions derived for use +!! (T [degC]), and pressure [Pa]. It uses the expressions derived for use !! with NEMO. subroutine calculate_density_scalar_nemo(T, S, pressure, rho, rho_ref) - real, intent(in) :: T !< Conservative temperature in C. - real, intent(in) :: S !< Absolute salinity in g/kg. - real, intent(in) :: pressure !< Pressure in Pa. - real, intent(out) :: rho !< In situ density in kg m-3. - real, optional, intent(in) :: rho_ref !< A reference density in kg m-3. + real, intent(in) :: T !< Conservative temperature [degC]. + real, intent(in) :: S !< Absolute salinity [g kg-1]. + real, intent(in) :: pressure !< pressure [Pa]. + real, intent(out) :: rho !< In situ density [kg m-3]. + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. real :: al0, p0, lambda integer :: j @@ -200,16 +200,16 @@ end subroutine calculate_density_scalar_nemo !> This subroutine computes the in situ density of sea water (rho in !! [kg m-3]) from absolute salinity (S [g kg-1]), conservative temperature -!! (T [degC]), and pressure in Pa. It uses the expressions derived for use +!! (T [degC]), and pressure [Pa]. It uses the expressions derived for use !! with NEMO. subroutine calculate_density_array_nemo(T, S, pressure, rho, start, npts, rho_ref) - real, dimension(:), intent(in) :: T !< Conservative temperature in C. - real, dimension(:), intent(in) :: S !< Absolute salinity in g/kg - real, dimension(:), intent(in) :: pressure !< pressure in Pa. - real, dimension(:), intent(out) :: rho !< in situ density in kg m-3. + real, dimension(:), intent(in) :: T !< Conservative temperature [degC]. + real, dimension(:), intent(in) :: S !< Absolute salinity [g kg-1]. + real, dimension(:), intent(in) :: pressure !< pressure [Pa]. + real, dimension(:), intent(out) :: rho !< in situ density [kg m-3]. integer, intent(in) :: start !< the starting point in the arrays. integer, intent(in) :: npts !< the number of values to calculate. - real, optional, intent(in) :: rho_ref !< A reference density in kg m-3. + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. ! Local variables real :: zp, zt, zh, zs, zr0, zn, zn0, zn1, zn2, zn3, zs0 @@ -265,13 +265,13 @@ end subroutine calculate_density_array_nemo !> For a given thermodynamic state, calculate the derivatives of density with conservative !! temperature and absolute salinity, using the expressions derived for use with NEMO. subroutine calculate_density_derivs_array_nemo(T, S, pressure, drho_dT, drho_dS, start, npts) - real, intent(in), dimension(:) :: T !< Conservative temperature in C. - real, intent(in), dimension(:) :: S !< Absolute salinity in g/kg. - real, intent(in), dimension(:) :: pressure !< Pressure in Pa. + real, intent(in), dimension(:) :: T !< Conservative temperature [degC]. + real, intent(in), dimension(:) :: S !< Absolute salinity [g kg-1]. + real, intent(in), dimension(:) :: pressure !< pressure [Pa]. real, intent(out), dimension(:) :: drho_dT !< The partial derivative of density with potential - !! temperature, in kg m-3 K-1. + !! temperature [kg m-3 degC-1]. real, intent(out), dimension(:) :: drho_dS !< The partial derivative of density with salinity, - !! in kg m-3 psu-1. + !! in [kg m-3 ppt-1]. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. @@ -339,13 +339,13 @@ end subroutine calculate_density_derivs_array_nemo !> Wrapper to calculate_density_derivs_array for scalar inputs subroutine calculate_density_derivs_scalar_nemo(T, S, pressure, drho_dt, drho_ds) - real, intent(in) :: T !< Potential temperature relative to the surface in degC. - real, intent(in) :: S !< Salinity in PSU. - real, intent(in) :: pressure !< Pressure in Pa. + real, intent(in) :: T !< Potential temperature relative to the surface [degC]. + real, intent(in) :: S !< Salinity [g kg-1]. + real, intent(in) :: pressure !< Pressure [Pa]. real, intent(out) :: drho_dT !< The partial derivative of density with potential - !! temperature, in kg m-3 K-1. + !! temperature [kg m-3 degC-1]. real, intent(out) :: drho_dS !< The partial derivative of density with salinity, - !! in kg m-3 psu-1. + !! in [kg m-3 ppt-1]. ! Local variables real :: al0, p0, lambda integer :: j @@ -363,16 +363,16 @@ end subroutine calculate_density_derivs_scalar_nemo !> Compute the in situ density of sea water (rho in [kg m-3]) and the compressibility !! (drho/dp = C_sound^-2, stored as drho_dp [s2 m-2]) from absolute salinity -!! (sal in g/kg), conservative temperature (T [degC]), and pressure in Pa, using the expressions +!! (sal in g/kg), conservative temperature (T [degC]), and pressure [Pa], using the expressions !! derived for use with NEMO. subroutine calculate_compress_nemo(T, S, pressure, rho, drho_dp, start, npts) - real, intent(in), dimension(:) :: T !< Conservative temperature in C. - real, intent(in), dimension(:) :: S !< Absolute salinity in g/kg. - real, intent(in), dimension(:) :: pressure !< Pressure in Pa. - real, intent(out), dimension(:) :: rho !< In situ density in kg m-3. + real, intent(in), dimension(:) :: T !< Conservative temperature [degC]. + real, intent(in), dimension(:) :: S !< Absolute salinity [g/kg]. + real, intent(in), dimension(:) :: pressure !< pressure [Pa]. + real, intent(out), dimension(:) :: rho !< In situ density [kg m-3]. real, intent(out), dimension(:) :: drho_dp !< The partial derivative of density with pressure !! (also the inverse of the square of sound speed) - !! in s2 m-2. + !! [s2 m-2]. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. diff --git a/src/equation_of_state/MOM_EOS_TEOS10.F90 b/src/equation_of_state/MOM_EOS_TEOS10.F90 index 813a51307e..7c148443a5 100644 --- a/src/equation_of_state/MOM_EOS_TEOS10.F90 +++ b/src/equation_of_state/MOM_EOS_TEOS10.F90 @@ -24,14 +24,14 @@ module MOM_EOS_TEOS10 !> Compute the in situ density of sea water ([kg m-3]), or its anomaly with respect to !! a reference density, from absolute salinity (g/kg), conservative temperature (in deg C), -!! and pressure in Pa, using the TEOS10 expressions. +!! and pressure [Pa], using the TEOS10 expressions. interface calculate_density_teos10 module procedure calculate_density_scalar_teos10, calculate_density_array_teos10 end interface calculate_density_teos10 !> Compute the in situ specific volume of sea water (in [m3 kg-1]), or an anomaly with respect !! to a reference specific volume, from absolute salinity (in g/kg), conservative temperature -!! (in deg C), and pressure in Pa, using the TEOS10 expressions. +!! (in deg C), and pressure [Pa], using the TEOS10 expressions. interface calculate_spec_vol_teos10 module procedure calculate_spec_vol_scalar_teos10, calculate_spec_vol_array_teos10 end interface calculate_spec_vol_teos10 @@ -54,14 +54,14 @@ module MOM_EOS_TEOS10 !> This subroutine computes the in situ density of sea water (rho in !! [kg m-3]) from absolute salinity (S [g kg-1]), conservative temperature -!! (T [degC]), and pressure in Pa. It uses the expression from the +!! (T [degC]), and pressure [Pa]. It uses the expression from the !! TEOS10 website. subroutine calculate_density_scalar_teos10(T, S, pressure, rho, rho_ref) - real, intent(in) :: T !< Conservative temperature in C. - real, intent(in) :: S !< Absolute salinity in g/kg. - real, intent(in) :: pressure !< Pressure in Pa. - real, intent(out) :: rho !< In situ density in kg m-3. - real, optional, intent(in) :: rho_ref !< A reference density in kg m-3. + real, intent(in) :: T !< Conservative temperature [degC]. + real, intent(in) :: S !< Absolute salinity [g kg-1]. + real, intent(in) :: pressure !< pressure [Pa]. + real, intent(out) :: rho !< In situ density [kg m-3]. + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. ! Local variables real, dimension(1) :: T0, S0, pressure0 @@ -78,16 +78,16 @@ end subroutine calculate_density_scalar_teos10 !> This subroutine computes the in situ density of sea water (rho in !! [kg m-3]) from absolute salinity (S [g kg-1]), conservative temperature -!! (T [degC]), and pressure in Pa. It uses the expression from the +!! (T [degC]), and pressure [Pa]. It uses the expression from the !! TEOS10 website. subroutine calculate_density_array_teos10(T, S, pressure, rho, start, npts, rho_ref) - real, dimension(:), intent(in) :: T !< Conservative temperature in C. - real, dimension(:), intent(in) :: S !< Absolute salinity in g/kg - real, dimension(:), intent(in) :: pressure !< pressure in Pa. - real, dimension(:), intent(out) :: rho !< in situ density in kg m-3. + real, dimension(:), intent(in) :: T !< Conservative temperature [degC]. + real, dimension(:), intent(in) :: S !< Absolute salinity [g kg-1] + real, dimension(:), intent(in) :: pressure !< pressure [Pa]. + real, dimension(:), intent(out) :: rho !< in situ density [kg m-3]. integer, intent(in) :: start !< the starting point in the arrays. integer, intent(in) :: npts !< the number of values to calculate. - real, optional, intent(in) :: rho_ref !< A reference density in kg m-3. + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. ! Local variables real :: zs, zt, zp @@ -110,14 +110,14 @@ end subroutine calculate_density_array_teos10 !> This subroutine computes the in situ specific volume of sea water (specvol in !! [m3 kg-1]) from absolute salinity (S [g kg-1]), conservative temperature (T [degC]) -!! and pressure in Pa, using the TEOS10 equation of state. +!! and pressure [Pa], using the TEOS10 equation of state. !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_scalar_teos10(T, S, pressure, specvol, spv_ref) - real, intent(in) :: T !< Conservative temperature in C. - real, intent(in) :: S !< Absolute salinity in g/kg - real, intent(in) :: pressure !< pressure in Pa. - real, intent(out) :: specvol !< in situ specific volume in m3 kg-1. - real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1. + real, intent(in) :: T !< Conservative temperature [degC]. + real, intent(in) :: S !< Absolute salinity [g kg-1] + real, intent(in) :: pressure !< pressure [Pa]. + real, intent(out) :: specvol !< in situ specific volume [m3 kg-1]. + real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. ! Local variables real, dimension(1) :: T0, S0, pressure0, spv0 @@ -131,17 +131,17 @@ end subroutine calculate_spec_vol_scalar_teos10 !> This subroutine computes the in situ specific volume of sea water (specvol in !! [m3 kg-1]) from absolute salinity (S [g kg-1]), conservative temperature (T [degC]) -!! and pressure in Pa, using the TEOS10 equation of state. +!! and pressure [Pa], using the TEOS10 equation of state. !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_array_teos10(T, S, pressure, specvol, start, npts, spv_ref) real, dimension(:), intent(in) :: T !< Conservative temperature relative to the surface - !! in C. - real, dimension(:), intent(in) :: S !< salinity in g/kg. - real, dimension(:), intent(in) :: pressure !< pressure in Pa. - real, dimension(:), intent(out) :: specvol !< in situ specific volume in m3 kg-1. + !! [degC]. + real, dimension(:), intent(in) :: S !< salinity [g kg-1]. + real, dimension(:), intent(in) :: pressure !< pressure [Pa]. + real, dimension(:), intent(out) :: specvol !< in situ specific volume [m3 kg-1]. integer, intent(in) :: start !< the starting point in the arrays. integer, intent(in) :: npts !< the number of values to calculate. - real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1. + real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. ! Local variables real :: zs, zt, zp @@ -166,11 +166,11 @@ end subroutine calculate_spec_vol_array_teos10 !> For a given thermodynamic state, calculate the derivatives of density with conservative !! temperature and absolute salinity, using the TEOS10 expressions. subroutine calculate_density_derivs_array_teos10(T, S, pressure, drho_dT, drho_dS, start, npts) - real, intent(in), dimension(:) :: T !< Conservative temperature in C. - real, intent(in), dimension(:) :: S !< Absolute salinity in g/kg. - real, intent(in), dimension(:) :: pressure !< Pressure in Pa. + real, intent(in), dimension(:) :: T !< Conservative temperature [degC]. + real, intent(in), dimension(:) :: S !< Absolute salinity [g kg-1]. + real, intent(in), dimension(:) :: pressure !< pressure [Pa]. real, intent(out), dimension(:) :: drho_dT !< The partial derivative of density with conservative - !! temperature, in kg m-3 K-1. + !! temperature [kg m-3 degC-1]. real, intent(out), dimension(:) :: drho_dS !< The partial derivative of density with absolute salinity, !! in kg m-3 (g/kg)-1. integer, intent(in) :: start !< The starting point in the arrays. @@ -197,11 +197,11 @@ end subroutine calculate_density_derivs_array_teos10 !> For a given thermodynamic state, calculate the derivatives of density with conservative !! temperature and absolute salinity, using the TEOS10 expressions. subroutine calculate_density_derivs_scalar_teos10(T, S, pressure, drho_dT, drho_dS) - real, intent(in) :: T !< Conservative temperature in C - real, intent(in) :: S !< Absolute Salinity in g/kg - real, intent(in) :: pressure !< Pressure in Pa. + real, intent(in) :: T !< Conservative temperature [degC] + real, intent(in) :: S !< Absolute Salinity [g kg-1] + real, intent(in) :: pressure !< pressure [Pa]. real, intent(out) :: drho_dT !< The partial derivative of density with conservative - !! temperature, in kg m-3 K-1. + !! temperature [kg m-3 degC-1]. real, intent(out) :: drho_dS !< The partial derivative of density with absolute salinity, !! in kg m-3 (g/kg)-1. @@ -218,9 +218,9 @@ end subroutine calculate_density_derivs_scalar_teos10 !> For a given thermodynamic state, calculate the derivatives of specific volume with conservative !! temperature and absolute salinity, using the TEOS10 expressions. subroutine calculate_specvol_derivs_teos10(T, S, pressure, dSV_dT, dSV_dS, start, npts) - real, intent(in), dimension(:) :: T !< Conservative temperature in C. - real, intent(in), dimension(:) :: S !< Absolute salinity in g/kg. - real, intent(in), dimension(:) :: pressure !< Pressure in Pa. + real, intent(in), dimension(:) :: T !< Conservative temperature [degC]. + real, intent(in), dimension(:) :: S !< Absolute salinity [g kg-1]. + real, intent(in), dimension(:) :: pressure !< pressure [Pa]. real, intent(out), dimension(:) :: dSV_dT !< The partial derivative of specific volume with !! conservative temperature, in m3 kg-1 K-1. real, intent(out), dimension(:) :: dSV_dS !< The partial derivative of specific volume with @@ -249,9 +249,9 @@ end subroutine calculate_specvol_derivs_teos10 !> Calculate the 5 second derivatives of the equation of state for scalar inputs subroutine calculate_density_second_derivs_scalar_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, & drho_dT_dT, drho_dS_dP, drho_dT_dP) - real, intent(in) :: T !< Conservative temperature in C - real, intent(in) :: S !< Absolute Salinity in g/kg - real, intent(in) :: pressure !< Pressure in Pa. + real, intent(in) :: T !< Conservative temperature [degC] + real, intent(in) :: S !< Absolute Salinity [g kg-1] + real, intent(in) :: pressure !< pressure [Pa]. real, intent(out) :: drho_dS_dS !< Partial derivative of beta with respect to S real, intent(out) :: drho_dS_dT !< Partial derivative of beta with resepct to T real, intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect to T @@ -274,9 +274,9 @@ end subroutine calculate_density_second_derivs_scalar_teos10 !> Calculate the 5 second derivatives of the equation of state for scalar inputs subroutine calculate_density_second_derivs_array_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, & drho_dT_dT, drho_dS_dP, drho_dT_dP, start, npts) - real, dimension(:), intent(in) :: T !< Conservative temperature in C - real, dimension(:), intent(in) :: S !< Absolute Salinity in g/kg - real, dimension(:), intent(in) :: pressure !< Pressure in Pa. + real, dimension(:), intent(in) :: T !< Conservative temperature [degC] + real, dimension(:), intent(in) :: S !< Absolute Salinity [g kg-1] + real, dimension(:), intent(in) :: pressure !< pressure [Pa]. real, dimension(:), intent(out) :: drho_dS_dS !< Partial derivative of beta with respect to S real, dimension(:), intent(out) :: drho_dS_dT !< Partial derivative of beta with resepct to T real, dimension(:), intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect to T @@ -308,16 +308,16 @@ end subroutine calculate_density_second_derivs_array_teos10 !> This subroutine computes the in situ density of sea water (rho in !! [kg m-3]) and the compressibility (drho/dp = C_sound^-2) !! (drho_dp [s2 m-2]) from absolute salinity (sal in g/kg), -!! conservative temperature (T [degC]), and pressure in Pa. It uses the +!! conservative temperature (T [degC]), and pressure [Pa]. It uses the !! subroutines from TEOS10 website subroutine calculate_compress_teos10(T, S, pressure, rho, drho_dp, start, npts) - real, intent(in), dimension(:) :: T !< Conservative temperature in C. - real, intent(in), dimension(:) :: S !< Absolute salinity in g/kg. - real, intent(in), dimension(:) :: pressure !< Pressure in Pa. - real, intent(out), dimension(:) :: rho !< In situ density in kg m-3. + real, intent(in), dimension(:) :: T !< Conservative temperature [degC]. + real, intent(in), dimension(:) :: S !< Absolute salinity [g kg-1]. + real, intent(in), dimension(:) :: pressure !< Pressure [Pa]. + real, intent(out), dimension(:) :: rho !< In situ density [kg m-3]. real, intent(out), dimension(:) :: drho_dp !< The partial derivative of density with pressure !! (also the inverse of the square of sound speed) - !! in s2 m-2. + !! [s2 m-2]. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. diff --git a/src/equation_of_state/MOM_EOS_UNESCO.F90 b/src/equation_of_state/MOM_EOS_UNESCO.F90 index 2b6c5469ee..1d3450d871 100644 --- a/src/equation_of_state/MOM_EOS_UNESCO.F90 +++ b/src/equation_of_state/MOM_EOS_UNESCO.F90 @@ -57,11 +57,11 @@ module MOM_EOS_UNESCO !! [kg m-3]) from salinity (S [PSU]), potential temperature !! (T [degC]), and pressure in Pa, using the UNESCO (1981) equation of state. subroutine calculate_density_scalar_UNESCO(T, S, pressure, rho, rho_ref) - real, intent(in) :: T !< Potential temperature relative to the surface in C. - real, intent(in) :: S !< Salinity in PSU. - real, intent(in) :: pressure !< Pressure in Pa. - real, intent(out) :: rho !< In situ density in kg m-3. - real, optional, intent(in) :: rho_ref !< A reference density in kg m-3. + real, intent(in) :: T !< Potential temperature relative to the surface [degC]. + real, intent(in) :: S !< Salinity [PSU]. + real, intent(in) :: pressure !< pressure [Pa]. + real, intent(out) :: rho !< In situ density [kg m-3]. + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. ! Local variables real, dimension(1) :: T0, S0, pressure0 @@ -80,21 +80,21 @@ end subroutine calculate_density_scalar_UNESCO !! [kg m-3]) from salinity (S [PSU]), potential temperature !! (T [degC]), and pressure in Pa, using the UNESCO (1981) equation of state. subroutine calculate_density_array_UNESCO(T, S, pressure, rho, start, npts, rho_ref) - real, dimension(:), intent(in) :: T !< potential temperature relative to the surface in C. - real, dimension(:), intent(in) :: S !< salinity in PSU. - real, dimension(:), intent(in) :: pressure !< pressure in Pa. - real, dimension(:), intent(out) :: rho !< in situ density in kg m-3. + real, dimension(:), intent(in) :: T !< potential temperature relative to the surface [degC]. + real, dimension(:), intent(in) :: S !< salinity [PSU]. + real, dimension(:), intent(in) :: pressure !< pressure [Pa]. + real, dimension(:), intent(out) :: rho !< in situ density [kg m-3]. integer, intent(in) :: start !< the starting point in the arrays. integer, intent(in) :: npts !< the number of values to calculate. - real, optional, intent(in) :: rho_ref !< A reference density in kg m-3. + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. ! Local variables - real :: t_local, t2, t3, t4, t5 ! Temperature to the 1st - 5th power. - real :: s_local, s32, s2 ! Salinity to the 1st, 3/2, & 2nd power. - real :: p1, p2 ! Pressure (in bars) to the 1st and 2nd power. + real :: t_local, t2, t3, t4, t5 ! Temperature to the 1st - 5th power [degC^n]. + real :: s_local, s32, s2 ! Salinity to the 1st, 3/2, & 2nd power [PSU^n]. + real :: p1, p2 ! Pressure (in bars) to the 1st and 2nd power [bar] and [bar2]. real :: rho0 ! Density at 1 bar pressure [kg m-3]. real :: sig0 ! The anomaly of rho0 from R00 [kg m-3]. - real :: ks ! The secant bulk modulus in bar. + real :: ks ! The secant bulk modulus [bar]. integer :: j do j=start,start+npts-1 @@ -136,11 +136,11 @@ end subroutine calculate_density_array_UNESCO !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_scalar_UNESCO(T, S, pressure, specvol, spv_ref) real, intent(in) :: T !< potential temperature relative to the surface - !! in C. - real, intent(in) :: S !< salinity in PSU. - real, intent(in) :: pressure !< pressure in Pa. - real, intent(out) :: specvol !< in situ specific volume in m3 kg-1. - real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1. + !! [degC]. + real, intent(in) :: S !< salinity [PSU]. + real, intent(in) :: pressure !< pressure [Pa]. + real, intent(out) :: specvol !< in situ specific volume [m3 kg-1]. + real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. ! Local variables real, dimension(1) :: T0, S0, pressure0, spv0 @@ -157,20 +157,20 @@ end subroutine calculate_spec_vol_scalar_UNESCO !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_array_UNESCO(T, S, pressure, specvol, start, npts, spv_ref) real, dimension(:), intent(in) :: T !< potential temperature relative to the surface - !! in C. - real, dimension(:), intent(in) :: S !< salinity in PSU. - real, dimension(:), intent(in) :: pressure !< pressure in Pa. - real, dimension(:), intent(out) :: specvol !< in situ specific volume in m3 kg-1. + !! [degC]. + real, dimension(:), intent(in) :: S !< salinity [PSU]. + real, dimension(:), intent(in) :: pressure !< pressure [Pa]. + real, dimension(:), intent(out) :: specvol !< in situ specific volume [m3 kg-1]. integer, intent(in) :: start !< the starting point in the arrays. integer, intent(in) :: npts !< the number of values to calculate. - real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1. + real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. ! Local variables - real :: t_local, t2, t3, t4, t5; ! Temperature to the 1st - 5th power. - real :: s_local, s32, s2; ! Salinity to the 1st, 3/2, & 2nd power. - real :: p1, p2; ! Pressure (in bars) to the 1st and 2nd power. - real :: rho0; ! Density at 1 bar pressure [kg m-3]. - real :: ks; ! The secant bulk modulus in bar. + real :: t_local, t2, t3, t4, t5 ! Temperature to the 1st - 5th power [degC^n]. + real :: s_local, s32, s2 ! Salinity to the 1st, 3/2, & 2nd power [PSU^n]. + real :: p1, p2 ! Pressure (in bars) to the 1st and 2nd power [bar] and [bar2]. + real :: rho0 ! Density at 1 bar pressure [kg m-3]. + real :: ks ! The secant bulk modulus [bar]. integer :: j do j=start,start+npts-1 @@ -211,27 +211,27 @@ end subroutine calculate_spec_vol_array_UNESCO !! with potential temperature and salinity. subroutine calculate_density_derivs_UNESCO(T, S, pressure, drho_dT, drho_dS, start, npts) real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface - !! in C. - real, intent(in), dimension(:) :: S !< Salinity in PSU. - real, intent(in), dimension(:) :: pressure !< Pressure in Pa. + !! [degC]. + real, intent(in), dimension(:) :: S !< Salinity [PSU]. + real, intent(in), dimension(:) :: pressure !< Pressure [Pa]. real, intent(out), dimension(:) :: drho_dT !< The partial derivative of density with potential - !! temperature, in kg m-3 K-1. + !! temperature [kg m-3 degC-1]. real, intent(out), dimension(:) :: drho_dS !< The partial derivative of density with salinity, - !! in kg m-3 psu-1. + !! in [kg m-3 PSU-1]. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real :: t_local, t2, t3, t4, t5; ! Temperature to the 1st - 5th power. - real :: s12, s_local, s32, s2; ! Salinity to the 1/2 - 2nd powers. - real :: p1, p2; ! Pressure (in bars) to the 1st & 2nd power. - real :: rho0; ! Density at 1 bar pressure [kg m-3]. - real :: ks; ! The secant bulk modulus, in bar. - real :: drho0_dT; ! Derivative of rho0 with T, in kg m-3 K-1. - real :: drho0_dS; ! Derivative of rho0 with S, kg m-3 psu-1. - real :: dks_dT; ! Derivative of ks with T, in bar K-1. - real :: dks_dS; ! Derivative of ks with S, in bar psu-1. - real :: denom; ! 1.0 / (ks - p1) in bar-1. + real :: t_local, t2, t3, t4, t5 ! Temperature to the 1st - 5th power [degC^n]. + real :: s12, s_local, s32, s2 ! Salinity to the 1/2 - 2nd powers [PSU^n]. + real :: p1, p2 ! Pressure to the 1st & 2nd power [bar] and [bar2]. + real :: rho0 ! Density at 1 bar pressure [kg m-3]. + real :: ks ! The secant bulk modulus [bar]. + real :: drho0_dT ! Derivative of rho0 with T [kg m-3 degC-1]. + real :: drho0_dS ! Derivative of rho0 with S [kg m-3 PSU-1]. + real :: dks_dT ! Derivative of ks with T [bar degC-1]. + real :: dks_dS ! Derivative of ks with S [bar psu-1]. + real :: denom ! 1.0 / (ks - p1) [bar-1]. integer :: j do j=start,start+npts-1 @@ -282,24 +282,24 @@ end subroutine calculate_density_derivs_UNESCO !! salinity, potential temperature, and pressure. subroutine calculate_compress_UNESCO(T, S, pressure, rho, drho_dp, start, npts) real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface - !! in C. - real, intent(in), dimension(:) :: S !< Salinity in PSU. - real, intent(in), dimension(:) :: pressure !< Pressure in Pa. - real, intent(out), dimension(:) :: rho !< In situ density in kg m-3. + !! [degC]. + real, intent(in), dimension(:) :: S !< Salinity [PSU]. + real, intent(in), dimension(:) :: pressure !< Pressure [Pa]. + real, intent(out), dimension(:) :: rho !< In situ density [kg m-3]. real, intent(out), dimension(:) :: drho_dp !< The partial derivative of density with pressure !! (also the inverse of the square of sound speed) - !! in s2 m-2. + !! [s2 m-2]. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real :: t_local, t2, t3, t4, t5; ! Temperature to the 1st - 5th power. - real :: s_local, s32, s2; ! Salinity to the 1st, 3/2, & 2nd power. - real :: p1, p2; ! Pressure (in bars) to the 1st and 2nd power. - real :: rho0; ! Density at 1 bar pressure [kg m-3]. - real :: ks; ! The secant bulk modulus in bar. + real :: t_local, t2, t3, t4, t5 ! Temperature to the 1st - 5th power [degC^n]. + real :: s_local, s32, s2 ! Salinity to the 1st, 3/2, & 2nd power [PSU^n]. + real :: p1, p2 ! Pressure to the 1st & 2nd power [bar] and [bar2]. + real :: rho0 ! Density at 1 bar pressure [kg m-3]. + real :: ks ! The secant bulk modulus [bar]. real :: ks_0, ks_1, ks_2 - real :: dks_dp; ! The derivative of the secant bulk modulus + real :: dks_dp ! The derivative of the secant bulk modulus ! with pressure, nondimensional. integer :: j diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index ba1b7f436e..899f32b27d 100644 --- a/src/equation_of_state/MOM_EOS_Wright.F90 +++ b/src/equation_of_state/MOM_EOS_Wright.F90 @@ -27,7 +27,7 @@ module MOM_EOS_Wright !> Compute the in situ density of sea water (in [kg m-3]), or its anomaly with respect to -!! a reference density, from salinity (in psu), potential temperature (in deg C), and pressure in Pa, +!! a reference density, from salinity (in psu), potential temperature (in deg C), and pressure [Pa], !! using the expressions from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. interface calculate_density_wright module procedure calculate_density_scalar_wright, calculate_density_array_wright @@ -35,7 +35,7 @@ module MOM_EOS_Wright !> Compute the in situ specific volume of sea water (in [m3 kg-1]), or an anomaly with respect !! to a reference specific volume, from salinity (in psu), potential temperature (in deg C), and -!! pressure in Pa, using the expressions from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. +!! pressure [Pa], using the expressions from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. interface calculate_spec_vol_wright module procedure calculate_spec_vol_scalar_wright, calculate_spec_vol_array_wright end interface calculate_spec_vol_wright @@ -75,19 +75,19 @@ module MOM_EOS_Wright !> This subroutine computes the in situ density of sea water (rho in !! [kg m-3]) from salinity (S [PSU]), potential temperature -!! (T [degC]), and pressure in Pa. It uses the expression from +!! (T [degC]), and pressure [Pa]. It uses the expression from !! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. subroutine calculate_density_scalar_wright(T, S, pressure, rho, rho_ref) - real, intent(in) :: T !< Potential temperature relative to the surface in C. - real, intent(in) :: S !< Salinity in PSU. - real, intent(in) :: pressure !< Pressure in Pa. - real, intent(out) :: rho !< In situ density in kg m-3. - real, optional, intent(in) :: rho_ref !< A reference density in kg m-3. + real, intent(in) :: T !< Potential temperature relative to the surface [degC]. + real, intent(in) :: S !< Salinity [PSU]. + real, intent(in) :: pressure !< pressure [Pa]. + real, intent(out) :: rho !< In situ density [kg m-3]. + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. ! *====================================================================* ! * This subroutine computes the in situ density of sea water (rho in * ! * [kg m-3]) from salinity (S [PSU]), potential temperature * -! * (T [degC]), and pressure in Pa. It uses the expression from * +! * (T [degC]), and pressure [Pa]. It uses the expression from * ! * Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. * ! * Coded by R. Hallberg, 7/00 * ! *====================================================================* @@ -105,16 +105,16 @@ end subroutine calculate_density_scalar_wright !> This subroutine computes the in situ density of sea water (rho in !! [kg m-3]) from salinity (S [PSU]), potential temperature -!! (T [degC]), and pressure in Pa. It uses the expression from +!! (T [degC]), and pressure [Pa]. It uses the expression from !! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. subroutine calculate_density_array_wright(T, S, pressure, rho, start, npts, rho_ref) - real, dimension(:), intent(in) :: T !< potential temperature relative to the surface in C. - real, dimension(:), intent(in) :: S !< salinity in PSU. - real, dimension(:), intent(in) :: pressure !< pressure in Pa. - real, dimension(:), intent(out) :: rho !< in situ density in kg m-3. + real, dimension(:), intent(in) :: T !< potential temperature relative to the surface [degC]. + real, dimension(:), intent(in) :: S !< salinity [PSU]. + real, dimension(:), intent(in) :: pressure !< pressure [Pa]. + real, dimension(:), intent(out) :: rho !< in situ density [kg m-3]. integer, intent(in) :: start !< the starting point in the arrays. integer, intent(in) :: npts !< the number of values to calculate. - real, optional, intent(in) :: rho_ref !< A reference density in kg m-3. + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. ! Original coded by R. Hallberg, 7/00, anomaly coded in 3/18. ! Local variables @@ -144,15 +144,15 @@ end subroutine calculate_density_array_wright !> This subroutine computes the in situ specific volume of sea water (specvol in !! [m3 kg-1]) from salinity (S [PSU]), potential temperature (T [degC]) -!! and pressure in Pa. It uses the expression from +!! and pressure [Pa]. It uses the expression from !! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_scalar_wright(T, S, pressure, specvol, spv_ref) - real, intent(in) :: T !< potential temperature relative to the surface in C. - real, intent(in) :: S !< salinity in PSU. - real, intent(in) :: pressure !< pressure in Pa. - real, intent(out) :: specvol !< in situ specific volume in m3 kg-1. - real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1. + real, intent(in) :: T !< potential temperature relative to the surface [degC]. + real, intent(in) :: S !< salinity [PSU]. + real, intent(in) :: pressure !< pressure [Pa]. + real, intent(out) :: specvol !< in situ specific volume [m3 kg-1]. + real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. ! Local variables real, dimension(1) :: T0, S0, pressure0, spv0 @@ -165,18 +165,18 @@ end subroutine calculate_spec_vol_scalar_wright !> This subroutine computes the in situ specific volume of sea water (specvol in !! [m3 kg-1]) from salinity (S [PSU]), potential temperature (T [degC]) -!! and pressure in Pa. It uses the expression from +!! and pressure [Pa]. It uses the expression from !! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_array_wright(T, S, pressure, specvol, start, npts, spv_ref) - real, dimension(:), intent(in) :: T !< potential temperature relative to the surface - !! in C. - real, dimension(:), intent(in) :: S !< salinity in PSU. - real, dimension(:), intent(in) :: pressure !< pressure in Pa. - real, dimension(:), intent(out) :: specvol !< in situ specific volume in m3 kg-1. + real, dimension(:), intent(in) :: T !< potential temperature relative to the + !! surface [degC]. + real, dimension(:), intent(in) :: S !< salinity [PSU]. + real, dimension(:), intent(in) :: pressure !< pressure [Pa]. + real, dimension(:), intent(out) :: specvol !< in situ specific volume [m3 kg-1]. integer, intent(in) :: start !< the starting point in the arrays. integer, intent(in) :: npts !< the number of values to calculate. - real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1. + real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. ! Local variables real :: al0, p0, lambda @@ -197,14 +197,14 @@ end subroutine calculate_spec_vol_array_wright !> For a given thermodynamic state, return the thermal/haline expansion coefficients subroutine calculate_density_derivs_array_wright(T, S, pressure, drho_dT, drho_dS, start, npts) - real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface - !! in C. - real, intent(in), dimension(:) :: S !< Salinity in PSU. - real, intent(in), dimension(:) :: pressure !< Pressure in Pa. + real, intent(in), dimension(:) :: T !< Potential temperature relative to the + !! surface [degC]. + real, intent(in), dimension(:) :: S !< Salinity [PSU]. + real, intent(in), dimension(:) :: pressure !< pressure [Pa]. real, intent(out), dimension(:) :: drho_dT !< The partial derivative of density with potential - !! temperature, in kg m-3 K-1. + !! temperature [kg m-3 degC-1]. real, intent(out), dimension(:) :: drho_dS !< The partial derivative of density with salinity, - !! in kg m-3 psu-1. + !! in [kg m-3 PSU-1]. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. @@ -232,13 +232,13 @@ end subroutine calculate_density_derivs_array_wright !> The scalar version of calculate_density_derivs which promotes scalar inputs to a 1-element array and then !! demotes the output back to a scalar subroutine calculate_density_derivs_scalar_wright(T, S, pressure, drho_dT, drho_dS) - real, intent(in) :: T !< Potential temperature relative to the surface in C. - real, intent(in) :: S !< Salinity in PSU. - real, intent(in) :: pressure !< Pressure in Pa. + real, intent(in) :: T !< Potential temperature relative to the surface [degC]. + real, intent(in) :: S !< Salinity [PSU]. + real, intent(in) :: pressure !< pressure [Pa]. real, intent(out) :: drho_dT !< The partial derivative of density with potential - !! temperature, in kg m-3 K-1. + !! temperature [kg m-3 degC-1]. real, intent(out) :: drho_dS !< The partial derivative of density with salinity, - !! in kg m-3 psu-1. + !! in [kg m-3 PSU-1]. ! Local variables needed to promote the input/output scalars to 1-element arrays real, dimension(1) :: T0, S0, P0 @@ -256,14 +256,19 @@ end subroutine calculate_density_derivs_scalar_wright !> Second derivatives of density with respect to temperature, salinity, and pressure subroutine calculate_density_second_derivs_array_wright(T, S, P, drho_ds_ds, drho_ds_dt, drho_dt_dt, & drho_ds_dp, drho_dt_dp, start, npts) - real, dimension(:), intent(in ) :: T !< Potential temperature referenced to 0 dbar - real, dimension(:), intent(in ) :: S !< Salinity in PSU - real, dimension(:), intent(in ) :: P !< Pressure in Pa - real, dimension(:), intent( out) :: drho_ds_ds !< Partial derivative of beta with respect to S - real, dimension(:), intent( out) :: drho_ds_dt !< Partial derivative of beta with resepct to T - real, dimension(:), intent( out) :: drho_dt_dt !< Partial derivative of alpha with respect to T - real, dimension(:), intent( out) :: drho_ds_dp !< Partial derivative of beta with respect to pressure - real, dimension(:), intent( out) :: drho_dt_dp !< Partial derivative of alpha with respect to pressure + real, dimension(:), intent(in ) :: T !< Potential temperature referenced to 0 dbar [degC] + real, dimension(:), intent(in ) :: S !< Salinity [PSU] + real, dimension(:), intent(in ) :: P !< Pressure [Pa] + real, dimension(:), intent( out) :: drho_ds_ds !< Partial derivative of beta with respect + !! to S [kg m-3 PSU-2] + real, dimension(:), intent( out) :: drho_ds_dt !< Partial derivative of beta with respcct + !! to T [kg m-3 PSU-1 degC-1] + real, dimension(:), intent( out) :: drho_dt_dt !< Partial derivative of alpha with respect + !! to T [kg m-3 degC-2] + real, dimension(:), intent( out) :: drho_ds_dp !< Partial derivative of beta with respect + !! to pressure [kg m-3 PSU-1 Pa-1] + real, dimension(:), intent( out) :: drho_dt_dp !< Partial derivative of alpha with respect + !! to pressure [kg m-3 degC-1 Pa-1] integer, intent(in ) :: start !< Starting index in T,S,P integer, intent(in ) :: npts !< Number of points to loop over @@ -304,13 +309,18 @@ end subroutine calculate_density_second_derivs_array_wright subroutine calculate_density_second_derivs_scalar_wright(T, S, P, drho_ds_ds, drho_ds_dt, drho_dt_dt, & drho_ds_dp, drho_dt_dp) real, intent(in ) :: T !< Potential temperature referenced to 0 dbar - real, intent(in ) :: S !< Salinity in PSU - real, intent(in ) :: P !< Pressure in Pa - real, intent( out) :: drho_ds_ds !< Partial derivative of beta with respect to S - real, intent( out) :: drho_ds_dt !< Partial derivative of beta with resepct to T - real, intent( out) :: drho_dt_dt !< Partial derivative of alpha with respect to T - real, intent( out) :: drho_ds_dp !< Partial derivative of beta with respect to pressure - real, intent( out) :: drho_dt_dp !< Partial derivative of alpha with respect to pressure + real, intent(in ) :: S !< Salinity [PSU] + real, intent(in ) :: P !< pressure [Pa] + real, intent( out) :: drho_ds_ds !< Partial derivative of beta with respect + !! to S [kg m-3 PSU-2] + real, intent( out) :: drho_ds_dt !< Partial derivative of beta with respcct + !! to T [kg m-3 PSU-1 degC-1] + real, intent( out) :: drho_dt_dt !< Partial derivative of alpha with respect + !! to T [kg m-3 degC-2] + real, intent( out) :: drho_ds_dp !< Partial derivative of beta with respect + !! to pressure [kg m-3 PSU-1 Pa-1] + real, intent( out) :: drho_dt_dp !< Partial derivative of alpha with respect + !! to pressure [kg m-3 degC-1 Pa-1] ! Local variables real, dimension(1) :: T0, S0, P0 real, dimension(1) :: drdsds, drdsdt, drdtdt, drdsdp, drdtdp @@ -330,13 +340,13 @@ end subroutine calculate_density_second_derivs_scalar_wright !> For a given thermodynamic state, return the partial derivatives of specific volume !! with temperature and salinity subroutine calculate_specvol_derivs_wright(T, S, pressure, dSV_dT, dSV_dS, start, npts) - real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface in C. - real, intent(in), dimension(:) :: S !< Salinity in g/kg. - real, intent(in), dimension(:) :: pressure !< Pressure in Pa. + real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface [degC]. + real, intent(in), dimension(:) :: S !< Salinity [PSU]. + real, intent(in), dimension(:) :: pressure !< pressure [Pa]. real, intent(out), dimension(:) :: dSV_dT !< The partial derivative of specific volume with - !! potential temperature, in m3 kg-1 K-1. + !! potential temperature [m3 kg-1 degC-1]. real, intent(out), dimension(:) :: dSV_dS !< The partial derivative of specific volume with - !! salinity, in m3 kg-1 / (g/kg). + !! salinity [m3 kg-1 / Pa]. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. @@ -363,17 +373,17 @@ end subroutine calculate_specvol_derivs_wright !> This subroutine computes the in situ density of sea water (rho in !! [kg m-3]) and the compressibility (drho/dp = C_sound^-2) !! (drho_dp [s2 m-2]) from salinity (sal in psu), potential -!! temperature (T [degC]), and pressure in Pa. It uses the expressions +!! temperature (T [degC]), and pressure [Pa]. It uses the expressions !! from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. !! Coded by R. Hallberg, 1/01 subroutine calculate_compress_wright(T, S, pressure, rho, drho_dp, start, npts) - real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface in C. - real, intent(in), dimension(:) :: S !< Salinity in PSU. - real, intent(in), dimension(:) :: pressure !< Pressure in Pa. - real, intent(out), dimension(:) :: rho !< In situ density in kg m-3. + real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface [degC]. + real, intent(in), dimension(:) :: S !< Salinity [PSU]. + real, intent(in), dimension(:) :: pressure !< pressure [Pa]. + real, intent(out), dimension(:) :: rho !< In situ density [kg m-3]. real, intent(out), dimension(:) :: drho_dp !< The partial derivative of density with pressure !! (also the inverse of the square of sound speed) - !! in s2 m-2. + !! [s2 m-2]. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. @@ -403,17 +413,17 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, type(hor_index_type), intent(in) :: HIO !< The horizontal index type for the output arrays. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: T !< Potential temperature relative to the surface - !! in C. + !! [degC]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: S !< Salinity in PSU. + intent(in) :: S !< Salinity [PSU]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_b !< Height at the top of the layer [Z ~> m]. - real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out + real, intent(in) :: rho_ref !< A mean density [kg m-3], that is subtracted out !! to reduce the magnitude of each of the integrals. !! (The pressure is calucated as p~=-z*rho_0*G_e.) - real, intent(in) :: rho_0 !< Density, in kg m-3, that is used to calculate the + real, intent(in) :: rho_0 !< Density [kg m-3], that is used to calculate the !! pressure (as p~=-z*rho_0*G_e) used in the !! equation of state. real, intent(in) :: G_e !< The Earth's gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. @@ -423,7 +433,7 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer !! of the pressure anomaly relative to the anomaly - !! at the top of the layer, in Pa Z. + !! at the top of the layer [Pa Z ~> Pa m]. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the @@ -448,7 +458,7 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, real :: dz ! The layer thickness [Z ~> m]. real :: hWght ! A pressure-thickness below topography [Z ~> m]. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Z ~> m]. - real :: iDenom ! The inverse of the denominator in the weights, in m-Z. + real :: iDenom ! The inverse of the denominator in the weights [Z-2 ~> m-2]. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim]. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim]. real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim]. @@ -607,15 +617,15 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & type(hor_index_type), intent(in) :: HI !< The ocean's horizontal index type. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: T !< Potential temperature relative to the surface - !! in C. + !! [degC]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: S !< Salinity in PSU. + intent(in) :: S !< Salinity [PSU]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_t !< Pressure at the top of the layer in Pa. + intent(in) :: p_t !< Pressure at the top of the layer [Pa]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_b !< Pressure at the top of the layer in Pa. + intent(in) :: p_b !< Pressure at the top of the layer [Pa]. real, intent(in) :: spv_ref !< A mean specific volume that is subtracted out - !! to reduce the magnitude of each of the integrals, m3 kg-1.The calculation is + !! to reduce the magnitude of each of the integrals [m3 kg-1]. The calculation is !! mathematically identical with different values of spv_ref, but this reduces the !! effects of roundoff. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & @@ -624,23 +634,21 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & optional, intent(out) :: intp_dza !< The integral in pressure through the layer of !! the geopotential anomaly relative to the anomaly - !! at the bottom of the layer, in Pa m2 s-2. + !! at the bottom of the layer [Pa m2 s-2]. real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), & optional, intent(out) :: intx_dza !< The integral in x of the difference between the !! geopotential anomaly at the top and bottom of - !! the layer divided by the x grid spacing, - !! in m2 s-2. + !! the layer divided by the x grid spacing [m2 s-2]. real, dimension(HI%isd:HI%ied,HI%JsdB:HI%JedB), & optional, intent(out) :: inty_dza !< The integral in y of the difference between the !! geopotential anomaly at the top and bottom of - !! the layer divided by the y grid spacing, - !! in m2 s-2. + !! the layer divided by the y grid spacing [m2 s-2]. integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate !! dza. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & optional, intent(in) :: bathyP !< The pressure at the bathymetry [Pa] real, optional, intent(in) :: dP_neglect !< A miniscule pressure change with - !! the same units as p_t (Pa?) + !! the same units as p_t [Pa] logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting !! to interpolate T/S for top and bottom integrals. @@ -649,11 +657,11 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & real :: al0, p0, lambda real :: p_ave real :: rem, eps, eps2 - real :: alpha_anom ! The depth averaged specific density anomaly in m3 kg-1. + real :: alpha_anom ! The depth averaged specific volume anomaly [m3 kg-1]. real :: dp ! The pressure change through a layer [Pa]. real :: hWght ! A pressure-thickness below topography [Pa]. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Pa]. - real :: iDenom ! The inverse of the denominator in the weights, in Pa-2. + real :: iDenom ! The inverse of the denominator in the weights [Pa-2]. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim]. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim]. real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim]. diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90 index 85fddc284e..a5e123ad4d 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -23,14 +23,14 @@ module MOM_EOS_linear !> Compute the density of sea water (in kg/m^3), or its anomaly from a reference density, !! using a simple linear equation of state from salinity (in psu), potential temperature (in deg C) -!! and pressure in Pa. +!! and pressure [Pa]. interface calculate_density_linear module procedure calculate_density_scalar_linear, calculate_density_array_linear end interface calculate_density_linear !> Compute the specific volume of sea water (in m^3/kg), or its anomaly from a reference value, !! using a simple linear equation of state from salinity (in psu), potential temperature (in deg C) -!! and pressure in Pa. +!! and pressure [Pa]. interface calculate_spec_vol_linear module procedure calculate_spec_vol_scalar_linear, calculate_spec_vol_array_linear end interface calculate_spec_vol_linear @@ -52,19 +52,19 @@ module MOM_EOS_linear !> This subroutine computes the density of sea water with a trivial !! linear equation of state (in kg m-3) from salinity (sal in PSU), -!! potential temperature (T [degC]), and pressure in Pa. +!! potential temperature (T [degC]), and pressure [Pa]. subroutine calculate_density_scalar_linear(T, S, pressure, rho, & Rho_T0_S0, dRho_dT, dRho_dS, rho_ref) - real, intent(in) :: T !< Potential temperature relative to the surface in C. - real, intent(in) :: S !< Salinity in PSU. - real, intent(in) :: pressure !< Pressure in Pa. - real, intent(out) :: rho !< In situ density in kg m-3. + real, intent(in) :: T !< Potential temperature relative to the surface [degC]. + real, intent(in) :: S !< Salinity [PSU]. + real, intent(in) :: pressure !< pressure [Pa]. + real, intent(out) :: rho !< In situ density [kg m-3]. real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. real, intent(in) :: dRho_dT !< The derivatives of density with temperature - !! in kg m-3 C-1. + !! [kg m-3 degC-1]. real, intent(in) :: dRho_dS !< The derivatives of density with salinity - !! in kg m-3 psu-1. - real, optional, intent(in) :: rho_ref !< A reference density in kg m-3. + !! in [kg m-3 ppt-1]. + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. if (present(rho_ref)) then rho = (Rho_T0_S0 - rho_ref) + (dRho_dT*T + dRho_dS*S) @@ -76,21 +76,21 @@ end subroutine calculate_density_scalar_linear !> This subroutine computes the density of sea water with a trivial !! linear equation of state (in kg/m^3) from salinity (sal in psu), -!! potential temperature (T [degC]), and pressure in Pa. +!! potential temperature (T [degC]), and pressure [Pa]. subroutine calculate_density_array_linear(T, S, pressure, rho, start, npts, & Rho_T0_S0, dRho_dT, dRho_dS, rho_ref) - real, dimension(:), intent(in) :: T !< potential temperature relative to the surface in C. - real, dimension(:), intent(in) :: S !< salinity in PSU. - real, dimension(:), intent(in) :: pressure !< pressure in Pa. - real, dimension(:), intent(out) :: rho !< in situ density in kg m-3. + real, dimension(:), intent(in) :: T !< potential temperature relative to the surface [degC]. + real, dimension(:), intent(in) :: S !< salinity [PSU]. + real, dimension(:), intent(in) :: pressure !< pressure [Pa]. + real, dimension(:), intent(out) :: rho !< in situ density [kg m-3]. integer, intent(in) :: start !< the starting point in the arrays. integer, intent(in) :: npts !< the number of values to calculate. real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. real, intent(in) :: dRho_dT !< The derivatives of density with temperature - !! in kg m-3 C-1. + !! [kg m-3 degC-1]. real, intent(in) :: dRho_dS !< The derivatives of density with salinity - !! in kg m-3 psu-1. - real, optional, intent(in) :: rho_ref !< A reference density in kg m-3. + !! in [kg m-3 ppt-1]. + real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. ! Local variables integer :: j @@ -104,19 +104,19 @@ end subroutine calculate_density_array_linear !> This subroutine computes the in situ specific volume of sea water (specvol in !! [m3 kg-1]) from salinity (S [PSU]), potential temperature (T [degC]) -!! and pressure in Pa, using a trivial linear equation of state for density. +!! and pressure [Pa], using a trivial linear equation of state for density. !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_scalar_linear(T, S, pressure, specvol, & Rho_T0_S0, dRho_dT, dRho_dS, spv_ref) real, intent(in) :: T !< potential temperature relative to the surface - !! in C. - real, intent(in) :: S !< salinity in PSU. - real, intent(in) :: pressure !< pressure in Pa. - real, intent(out) :: specvol !< in situ specific volume in m3 kg-1. + !! [degC]. + real, intent(in) :: S !< Salinity [PSU]. + real, intent(in) :: pressure !< Pressure [Pa]. + real, intent(out) :: specvol !< In situ specific volume [m3 kg-1]. real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. - real, intent(in) :: dRho_dT !< The derivatives of density with temperature in kg m-3 C-1. - real, intent(in) :: dRho_dS !< The derivatives of density with salinity in kg m-3 psu-1. - real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1. + real, intent(in) :: dRho_dT !< The derivatives of density with temperature [kg m-3 degC-1]. + real, intent(in) :: dRho_dS !< The derivatives of density with salinity [kg m-3 ppt-1]. + real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. ! Local variables integer :: j @@ -131,21 +131,21 @@ end subroutine calculate_spec_vol_scalar_linear !> This subroutine computes the in situ specific volume of sea water (specvol in !! [m3 kg-1]) from salinity (S [PSU]), potential temperature (T [degC]) -!! and pressure in Pa, using a trivial linear equation of state for density. +!! and pressure [Pa], using a trivial linear equation of state for density. !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_array_linear(T, S, pressure, specvol, start, npts, & Rho_T0_S0, dRho_dT, dRho_dS, spv_ref) real, dimension(:), intent(in) :: T !< potential temperature relative to the surface - !! in C. - real, dimension(:), intent(in) :: S !< salinity in PSU. - real, dimension(:), intent(in) :: pressure !< pressure in Pa. - real, dimension(:), intent(out) :: specvol !< in situ specific volume in m3 kg-1. + !! [degC]. + real, dimension(:), intent(in) :: S !< Salinity [PSU]. + real, dimension(:), intent(in) :: pressure !< Pressure [Pa]. + real, dimension(:), intent(out) :: specvol !< in situ specific volume [m3 kg-1]. integer, intent(in) :: start !< the starting point in the arrays. integer, intent(in) :: npts !< the number of values to calculate. real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. - real, intent(in) :: dRho_dT !< The derivatives of density with temperature in kg m-3 C-1. - real, intent(in) :: dRho_dS !< The derivatives of density with salinity in kg m-3 psu-1. - real, optional, intent(in) :: spv_ref !< A reference specific volume in m3 kg-1. + real, intent(in) :: dRho_dT !< The derivatives of density with temperature [kg m-3 degC-1]. + real, intent(in) :: dRho_dS !< The derivatives of density with salinity [kg m-3 ppt-1]. + real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. ! Local variables integer :: j @@ -163,16 +163,16 @@ end subroutine calculate_spec_vol_array_linear subroutine calculate_density_derivs_array_linear(T, S, pressure, drho_dT_out, & drho_dS_out, Rho_T0_S0, dRho_dT, dRho_dS, start, npts) real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface - !! in C. - real, intent(in), dimension(:) :: S !< Salinity in PSU. - real, intent(in), dimension(:) :: pressure !< Pressure in Pa. + !! [degC]. + real, intent(in), dimension(:) :: S !< Salinity [PSU]. + real, intent(in), dimension(:) :: pressure !< Pressure [Pa]. real, intent(out), dimension(:) :: drho_dT_out !< The partial derivative of density with - !! potential temperature, in kg m-3 K-1. + !! potential temperature [kg m-3 degC-1]. real, intent(out), dimension(:) :: drho_dS_out !< The partial derivative of density with - !! salinity, in kg m-3 psu-1. + !! salinity [kg m-3 ppt-1]. real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. - real, intent(in) :: dRho_dT !< The derivatives of density with temperature in kg m-3 C-1. - real, intent(in) :: dRho_dS !< The derivatives of density with salinity in kg m-3 psu-1. + real, intent(in) :: dRho_dT !< The derivative of density with temperature [kg m-3 degC-1]. + real, intent(in) :: dRho_dS !< The derivative of density with salinity [kg m-3 ppt-1]. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. ! Local variables @@ -190,16 +190,16 @@ end subroutine calculate_density_derivs_array_linear subroutine calculate_density_derivs_scalar_linear(T, S, pressure, drho_dT_out, & drho_dS_out, Rho_T0_S0, dRho_dT, dRho_dS) real, intent(in) :: T !< Potential temperature relative to the surface - !! in C. - real, intent(in) :: S !< Salinity in PSU. - real, intent(in) :: pressure !< Pressure in Pa. + !! [degC]. + real, intent(in) :: S !< Salinity [PSU]. + real, intent(in) :: pressure !< pressure [Pa]. real, intent(out) :: drho_dT_out !< The partial derivative of density with - !! potential temperature, in kg m-3 K-1. + !! potential temperature [kg m-3 degC-1]. real, intent(out) :: drho_dS_out !< The partial derivative of density with - !! salinity, in kg m-3 psu-1. + !! salinity [kg m-3 ppt-1]. real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. - real, intent(in) :: dRho_dT !< The derivatives of density with temperature in kg m-3 C-1. - real, intent(in) :: dRho_dS !< The derivatives of density with salinity in kg m-3 psu-1. + real, intent(in) :: dRho_dT !< The derivatives of density with temperature [kg m-3 degC-1]. + real, intent(in) :: dRho_dS !< The derivatives of density with salinity [kg m-3 ppt-1]. drho_dT_out = dRho_dT drho_dS_out = dRho_dS @@ -207,17 +207,21 @@ end subroutine calculate_density_derivs_scalar_linear !> This subroutine calculates the five, partial second derivatives of density w.r.t. !! potential temperature and salinity and pressure which for a linear equation of state should all be 0. -subroutine calculate_density_second_derivs_scalar_linear(T, S,pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT,& - drho_dS_dP, drho_dT_dP) - real, intent(in) :: T !< Potential temperature relative to the surface - !! in C. - real, intent(in) :: S !< Salinity in PSU. - real, intent(in) :: pressure !< Pressure in Pa. - real, intent(out) :: drho_dS_dS !< The partial derivative of density with - real, intent(out) :: drho_dS_dT !< The partial derivative of density with - real, intent(out) :: drho_dT_dT !< The partial derivative of density with - real, intent(out) :: drho_dS_dP !< The partial derivative of density with - real, intent(out) :: drho_dT_dP !< The partial derivative of density with +subroutine calculate_density_second_derivs_scalar_linear(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP) + real, intent(in) :: T !< Potential temperature relative to the surface [degC]. + real, intent(in) :: S !< Salinity [PSU]. + real, intent(in) :: pressure !< pressure [Pa]. + real, intent(out) :: drho_dS_dS !< The second derivative of density with + !! salinity [kg m-3 PSU-2]. + real, intent(out) :: drho_dS_dT !< The second derivative of density with + !! temperature and salinity [kg m-3 ppt-1 degC-1]. + real, intent(out) :: drho_dT_dT !< The second derivative of density with + !! temperature [kg m-3 degC-2]. + real, intent(out) :: drho_dS_dP !< The second derivative of density with + !! salinity and pressure [kg m-3 PSU-1 Pa-1]. + real, intent(out) :: drho_dT_dP !< The second derivative of density with + !! temperature and pressure [kg m-3 degC-1 Pa-1]. drho_dS_dS = 0. drho_dS_dT = 0. @@ -231,15 +235,19 @@ end subroutine calculate_density_second_derivs_scalar_linear !! potential temperature and salinity and pressure which for a linear equation of state should all be 0. subroutine calculate_density_second_derivs_array_linear(T, S,pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT,& drho_dS_dP, drho_dT_dP, start, npts) - real, dimension(:), intent(in) :: T !< Potential temperature relative to the surface - !! in C. - real, dimension(:), intent(in) :: S !< Salinity in PSU. - real, dimension(:), intent(in) :: pressure !< Pressure in Pa. - real, dimension(:), intent(out) :: drho_dS_dS !< The partial derivative of density with - real, dimension(:), intent(out) :: drho_dS_dT !< The partial derivative of density with - real, dimension(:), intent(out) :: drho_dT_dT !< The partial derivative of density with - real, dimension(:), intent(out) :: drho_dS_dP !< The partial derivative of density with - real, dimension(:), intent(out) :: drho_dT_dP !< The partial derivative of density with + real, dimension(:), intent(in) :: T !< Potential temperature relative to the surface [degC]. + real, dimension(:), intent(in) :: S !< Salinity [PSU]. + real, dimension(:), intent(in) :: pressure !< pressure [Pa]. + real, dimension(:), intent(out) :: drho_dS_dS !< The second derivative of density with + !! salinity [kg m-3 PSU-2]. + real, dimension(:), intent(out) :: drho_dS_dT !< The second derivative of density with + !! temperature and salinity [kg m-3 ppt-1 degC-1]. + real, dimension(:), intent(out) :: drho_dT_dT !< The second derivative of density with + !! temperature [kg m-3 degC-2]. + real, dimension(:), intent(out) :: drho_dS_dP !< The second derivative of density with + !! salinity and pressure [kg m-3 PSU-1 Pa-1]. + real, dimension(:), intent(out) :: drho_dT_dP !< The second derivative of density with + !! temperature and pressure [kg m-3 degC-1 Pa-1]. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. ! Local variables @@ -258,20 +266,20 @@ end subroutine calculate_density_second_derivs_array_linear subroutine calculate_specvol_derivs_linear(T, S, pressure, dSV_dT, dSV_dS, & start, npts, Rho_T0_S0, dRho_dT, dRho_dS) real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface - !! in C. - real, intent(in), dimension(:) :: S !< Salinity in g/kg. - real, intent(in), dimension(:) :: pressure !< Pressure in Pa. + !! [degC]. + real, intent(in), dimension(:) :: S !< Salinity [PSU]. + real, intent(in), dimension(:) :: pressure !< pressure [Pa]. real, intent(out), dimension(:) :: dSV_dS !< The partial derivative of specific volume with - !! salinity, in m3 kg-1 / (g/kg). + !! salinity [m3 kg-1 PSU-1]. real, intent(out), dimension(:) :: dSV_dT !< The partial derivative of specific volume with - !! potential temperature, in m3 kg-1 K-1. + !! potential temperature [m3 kg-1 degC-1]. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. real, intent(in) :: dRho_dT !< The derivative of density with - !! temperature, in kg m-3 C-1. + !! temperature, [kg m-3 degC-1]. real, intent(in) :: dRho_dS !< The derivative of density with - !! salinity, in kg m-3 psu-1. + !! salinity [kg m-3 ppt-1]. ! Local variables real :: I_rho2 integer :: j @@ -291,20 +299,20 @@ end subroutine calculate_specvol_derivs_linear subroutine calculate_compress_linear(T, S, pressure, rho, drho_dp, start, npts,& Rho_T0_S0, dRho_dT, dRho_dS) real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface - !! in C. - real, intent(in), dimension(:) :: S !< Salinity in PSU. - real, intent(in), dimension(:) :: pressure !< Pressure in Pa. - real, intent(out), dimension(:) :: rho !< In situ density in kg m-3. + !! [degC]. + real, intent(in), dimension(:) :: S !< Salinity [PSU]. + real, intent(in), dimension(:) :: pressure !< pressure [Pa]. + real, intent(out), dimension(:) :: rho !< In situ density [kg m-3]. real, intent(out), dimension(:) :: drho_dp !< The partial derivative of density with pressure !! (also the inverse of the square of sound speed) - !! in s2 m-2. + !! [s2 m-2]. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. real, intent(in) :: dRho_dT !< The derivative of density with - !! temperature, in kg m-3 C-1. + !! temperature [kg m-3 degC-1]. real, intent(in) :: dRho_dS !< The derivative of density with - !! salinity, in kg m-3 psu-1. + !! salinity [kg m-3 ppt-1]. ! Local variables integer :: j @@ -324,33 +332,33 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, type(hor_index_type), intent(in) :: HIO !< The horizontal index type for the output arrays. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: T !< Potential temperature relative to the surface - !! in C. + !! [degC]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: S !< Salinity in PSU. + intent(in) :: S !< Salinity [PSU]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m]. real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & intent(in) :: z_b !< Height at the top of the layer [Z ~> m]. - real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted + real, intent(in) :: rho_ref !< A mean density [kg m-3], that is subtracted !! out to reduce the magnitude of each of the !! integrals. - real, intent(in) :: rho_0_pres !< A density, in kg m-3, that is used to calculate + real, intent(in) :: rho_0_pres !< A density [kg m-3], that is used to calculate !! the pressure (as p~=-z*rho_0_pres*G_e) used in !! the equation of state. rho_0_pres is not used !! here. real, intent(in) :: G_e !< The Earth's gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. real, intent(in) :: dRho_dT !< The derivative of density with temperature, - !! in kg m-3 C-1. + !! [kg m-3 degC-1]. real, intent(in) :: dRho_dS !< The derivative of density with salinity, - !! in kg m-3 psu-1. + !! in [kg m-3 ppt-1]. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & intent(out) :: dpa !< The change in the pressure anomaly across the !! layer [Pa]. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer !! of the pressure anomaly relative to the anomaly - !! at the top of the layer, in Pa Z. + !! at the top of the layer [Pa Z]. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & optional, intent(out) :: intx_dpa !< The integral in x of the difference between the !! pressure anomaly at the top and bottom of the @@ -497,54 +505,54 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, & type(hor_index_type), intent(in) :: HI !< The ocean's horizontal index type. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: T !< Potential temperature relative to the surface - !! in C. + !! [degC]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: S !< Salinity in PSU. + intent(in) :: S !< Salinity [PSU]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_t !< Pressure at the top of the layer in Pa. + intent(in) :: p_t !< Pressure at the top of the layer [Pa]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: p_b !< Pressure at the top of the layer in Pa. + intent(in) :: p_b !< Pressure at the top of the layer [Pa]. real, intent(in) :: alpha_ref !< A mean specific volume that is subtracted out !! to reduce the magnitude of each of the integrals, m3 kg-1. The calculation is !! mathematically identical with different values of alpha_ref, but this reduces the !! effects of roundoff. real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0 [kg m-3]. - real, intent(in) :: dRho_dT !< The derivative of density with temperature, - !! in kg m-3 C-1. + real, intent(in) :: dRho_dT !< The derivative of density with temperature + !! [kg m-3 degC-1]. real, intent(in) :: dRho_dS !< The derivative of density with salinity, - !! in kg m-3 psu-1. + !! in [kg m-3 ppt-1]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(out) :: dza !< The change in the geopotential anomaly across !! the layer [m2 s-2]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & optional, intent(out) :: intp_dza !< The integral in pressure through the layer of !! the geopotential anomaly relative to the anomaly - !! at the bottom of the layer, in Pa m2 s-2. + !! at the bottom of the layer [Pa m2 s-2]. real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), & optional, intent(out) :: intx_dza !< The integral in x of the difference between the !! geopotential anomaly at the top and bottom of - !! the layer divided by the x grid spacing, - !! in m2 s-2. + !! the layer divided by the x grid spacing + !! [m2 s-2]. real, dimension(HI%isd:HI%ied,HI%JsdB:HI%JedB), & optional, intent(out) :: inty_dza !< The integral in y of the difference between the !! geopotential anomaly at the top and bottom of - !! the layer divided by the y grid spacing, - !! in m2 s-2. + !! the layer divided by the y grid spacing + !! [m2 s-2]. integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate dza. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - optional, intent(in) :: bathyP !< The pressure at the bathymetry in Pa + optional, intent(in) :: bathyP !< The pressure at the bathymetry [Pa] real, optional, intent(in) :: dP_neglect !< A miniscule pressure change with - !! the same units as p_t (Pa?) + !! the same units as p_t [Pa] logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting !! to interpolate T/S for top and bottom integrals. ! Local variables real :: dRho_TS ! The density anomaly due to T and S [kg m-3]. - real :: alpha_anom ! The specific volume anomaly from 1/rho_ref, in m3 kg-1. + real :: alpha_anom ! The specific volume anomaly from 1/rho_ref [m3 kg-1]. real :: aaL, aaR ! rho_anom to the left and right [kg m-3]. - real :: dp, dpL, dpR ! Layer pressure thicknesses in Pa. + real :: dp, dpL, dpR ! Layer pressure thicknesses [Pa]. real :: hWght ! A pressure-thickness below topography [Pa]. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Pa]. - real :: iDenom ! The inverse of the denominator in the weights, in Pa-2. + real :: iDenom ! The inverse of the denominator in the weights [Pa-2]. real :: hWt_LL, hWt_LR ! hWt_LA is the weighted influence of A on the left column [nondim]. real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim]. real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim]. diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index f77cdfbfe9..0c26418486 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -124,7 +124,7 @@ end subroutine MOM_initialize_coord !> Sets the layer densities (Rlay) and the interface reduced gravities (g). subroutine set_coord_from_gprime(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values - !! (potential density). + !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces !! [m2 Z-1 s-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -158,7 +158,7 @@ end subroutine set_coord_from_gprime !> Sets the layer densities (Rlay) and the interface reduced gravities (g). subroutine set_coord_from_layer_density(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values - !! (potential density). + !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces !! [m2 Z-1 s-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -166,8 +166,8 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, US, param_file) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables real :: g_fs ! Reduced gravity across the free surface [m s-2]. - real :: Rlay_Ref! The surface layer's target density, in kg m-3. - real :: RLay_range ! The range of densities, in kg m-3. + real :: Rlay_Ref! The surface layer's target density [kg m-3]. + real :: RLay_range ! The range of densities [kg m-3]. character(len=40) :: mdl = "set_coord_from_layer_density" ! This subroutine's name. integer :: k, nz nz = GV%ke @@ -201,7 +201,7 @@ end subroutine set_coord_from_layer_density subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state, & P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values - !! (potential density). + !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces !! [m2 Z-1 s-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -253,7 +253,7 @@ end subroutine set_coord_from_TS_ref subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, & eqn_of_state, P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values - !! (potential density). + !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces !! [m2 Z-1 s-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -302,7 +302,7 @@ end subroutine set_coord_from_TS_profile subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, & eqn_of_state, P_Ref) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values - !! (potential density). + !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces !! [m2 Z-1 s-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -384,7 +384,7 @@ end subroutine set_coord_from_TS_range ! Sets the layer densities (Rlay) and the interface reduced gravities (g) from data in file. subroutine set_coord_from_file(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values - !! (potential density). + !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces !! [m2 Z-1 s-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -435,7 +435,7 @@ end subroutine set_coord_from_file !! (defaulting to 2.0 if not defined) subroutine set_coord_linear(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values - !! (potential density). + !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces !! [m2 Z-1 s-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -479,9 +479,9 @@ end subroutine set_coord_linear !! might be used. subroutine set_coord_to_none(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values - !! (potential density). + !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, - !! [m s-2]. + !! [m2 Z-1 s-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index fed47ca7a0..ba2b29d765 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -612,7 +612,7 @@ subroutine initialize_thickness_from_file(h, G, GV, US, param_file, file_has_thi type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in m. + intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, intent(in) :: file_has_thickness !< If true, this file contains layer @@ -1073,13 +1073,13 @@ end subroutine depress_surface !! where the hydrostatic pressure matches an imposed surface pressure read from file. subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params) type(param_file_type), intent(in) :: PF !< Parameter file structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ALE_CS), pointer :: ALE_CSp !< ALE control structure type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< Layer thickness (H units, m or Pa) + intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables @@ -1412,8 +1412,10 @@ end subroutine initialize_velocity_circular !> Initializes temperature and salinity from file subroutine initialize_temp_salt_from_file(T, S, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is being initialized. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is + !! being initialized [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is + !! being initialized [ppt] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. @@ -1465,12 +1467,14 @@ end subroutine initialize_temp_salt_from_file !> Initializes temperature and salinity from a 1D profile subroutine initialize_temp_salt_from_profile(T, S, G, param_file, just_read_params) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is being initialized. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is being initialized. - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is + !! being initialized [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is + !! being initialized [ppt] + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters logical, optional, intent(in) :: just_read_params !< If present and true, this call will - !! only read parameters without changing h. + !! only read parameters without changing h. ! Local variables real, dimension(SZK_(G)) :: T0, S0 integer :: i, j, k @@ -1510,23 +1514,26 @@ end subroutine initialize_temp_salt_from_profile subroutine initialize_temp_salt_fit(T, S, G, GV, param_file, eqn_of_state, P_Ref, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is being initialized. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is + !! being initialized [degC]. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is being + !! initialized [ppt]. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(EOS_type), pointer :: eqn_of_state !< Integer that selects the equatio of state. real, intent(in) :: P_Ref !< The coordinate-density reference pressure - !! in Pa. + !! [Pa]. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables - real :: T0(SZK_(G)), S0(SZK_(G)) - real :: T_Ref ! Reference Temperature - real :: S_Ref ! Reference Salinity - real :: pres(SZK_(G)) ! An array of the reference pressure in Pa. - real :: drho_dT(SZK_(G)) ! Derivative of density with temperature in kg m-3 K-1. - real :: drho_dS(SZK_(G)) ! Derivative of density with salinity in kg m-3 PSU-1. - real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 in kg m-3. + real :: T0(SZK_(G)) ! Layer potential temperatures [degC] + real :: S0(SZK_(G)) ! Layer salinities [degC] + real :: T_Ref ! Reference Temperature [degC] + real :: S_Ref ! Reference Salinity [ppt] + real :: pres(SZK_(G)) ! An array of the reference pressure [Pa]. + real :: drho_dT(SZK_(G)) ! Derivative of density with temperature [kg m-3 degC-1]. + real :: drho_dS(SZK_(G)) ! Derivative of density with salinity [kg m-3 ppt-1]. + real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 [kg m-3]. logical :: fit_salin ! If true, accept the prescribed temperature and fit the salinity. logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "initialize_temp_salt_fit" ! This subroutine's name. @@ -1599,8 +1606,10 @@ end subroutine initialize_temp_salt_fit !! number, not the physical position). subroutine initialize_temp_salt_linear(T, S, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is being initialized. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is + !! being initialized [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is + !! being initialized [ppt] type(param_file_type), intent(in) :: param_file !< A structure to parse for !! run-time parameters logical, optional, intent(in) :: just_read_params !< If present and true, diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index e8f16f89c2..d7c47e8b01 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -36,28 +36,26 @@ module MOM_mixed_layer_restrat !> Control structure for mom_mixed_layer_restrat type, public :: mixedlayer_restrat_CS ; private - real :: ml_restrat_coef !< A non-dimensional factor by which the - !! instability is enhanced over what would be - !! predicted based on the resolved gradients. This - !! increases with grid spacing^2, up to something + real :: ml_restrat_coef !< A non-dimensional factor by which the instability is enhanced + !! over what would be predicted based on the resolved gradients + !! [nondim]. This increases with grid spacing^2, up to something !! of order 500. - real :: ml_restrat_coef2 !< As for ml_restrat_coef but using the slow filtered MLD. - real :: front_length !< If non-zero, is the frontal-length scale used to calculate the + real :: ml_restrat_coef2 !< As for ml_restrat_coef but using the slow filtered MLD [nondim]. + real :: front_length !< If non-zero, is the frontal-length scale [m] used to calculate the !! upscaling of buoyancy gradients that is otherwise represented !! by the parameter FOX_KEMPER_ML_RESTRAT_COEF. If MLE_FRONT_LENGTH is !! non-zero, it is recommended to set FOX_KEMPER_ML_RESTRAT_COEF=1.0. logical :: MLE_use_PBL_MLD !< If true, use the MLD provided by the PBL parameterization. !! if false, MLE will calculate a MLD based on a density difference !! based on the parameter MLE_DENSITY_DIFF. - real :: MLE_MLD_decay_time !< Time-scale to use in a running-mean when MLD is retreating (s). - real :: MLE_MLD_decay_time2 !< Time-scale to use in a running-mean when filtered MLD is retreating (s). - real :: MLE_density_diff !< Density difference used in detecting mixed-layer - !! depth (kg/m3). + real :: MLE_MLD_decay_time !< Time-scale to use in a running-mean when MLD is retreating [s]. + real :: MLE_MLD_decay_time2 !< Time-scale to use in a running-mean when filtered MLD is retreating [s]. + real :: MLE_density_diff !< Density difference used in detecting mixed-layer depth [kgm-3]. real :: MLE_tail_dh !< Fraction by which to extend the mixed-layer restratification !! depth used for a smoother stream function at the base of - !! the mixed-layer. - real :: MLE_MLD_stretch !< A scaling coefficient for stretching/shrinking the MLD - !! used in the MLE scheme. This simply multiplies MLD wherever used. + !! the mixed-layer [nondim]. + real :: MLE_MLD_stretch !< A scaling coefficient for stretching/shrinking the MLD used in + !! the MLE scheme [nondim]. This simply multiplies MLD wherever used. logical :: MLE_use_MLD_ave_bug !< If true, do not account for MLD mismatch to interface positions. logical :: debug = .false. !< If true, calculate checksums of fields for debugging. type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the @@ -567,14 +565,13 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport [H m2 s-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & h_avail ! The volume available for diffusion out of each face of each - ! sublayer of the mixed layer, divided by dt, in units - ! of H m2 s-1 (i.e., m3 s-1 or kg s-1). + ! sublayer of the mixed layer, divided by dt [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & htot, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] Rml_av ! g_Rho0 times the average mixed layer density [m s-2] real :: g_Rho0 ! G_Earth/Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1] - real :: Rho0(SZI_(G)) ! Potential density relative to the surface (kg m-3) - real :: p0(SZI_(G)) ! A pressure of 0 (Pa) + real :: Rho0(SZI_(G)) ! Potential density relative to the surface [kg m-3] + real :: p0(SZI_(G)) ! A pressure of 0 [Pa] real :: h_vel ! htot interpolated onto velocity points [Z ~> m]. (The units are not H.) real :: absf ! absolute value of f, interpolated to velocity points [s-1] diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 073fd1d099..d9837e1875 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -411,15 +411,17 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions [Z ~> m] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: Kh_u !< Thickness diffusivity on interfaces - !! at u points (m2/s) + !! at u points [m2 s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: Kh_v !< Thickness diffusivity on interfaces - !! at v points (m2/s) + !! at v points [m2 s-1] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uhD !< Zonal mass fluxes (m2 H s-1) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vhD !< Meridional mass fluxes (m2 H s-1) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uhD !< Zonal mass fluxes + !! [H m2 s-1 ~> m3 s-1 or kg s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vhD !< Meridional mass fluxes + !! [H m2 s-1 ~> m3 s-1 or kg s-1] real, dimension(:,:), pointer :: cg1 !< Wave speed [m s-1] - real, intent(in) :: dt !< Time increment (s) - type(MEKE_type), pointer :: MEKE !< MEKE control structue + real, intent(in) :: dt !< Time increment [s] + type(MEKE_type), pointer :: MEKE !< MEKE control structure type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), optional, intent(in) :: int_slope_u !< Ratio that determine how much of !! the isopycnal slopes are taken directly from the @@ -434,11 +436,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & - T, & ! The temperature (or density) in C, with the values in + T, & ! The temperature (or density) [degC], with the values in ! in massless layers filled vertically by diffusion. - S, & ! The filled salinity, in PSU, with the values in + S, & ! The filled salinity [ppt], with the values in ! in massless layers filled vertically by diffusion. - Rho, & ! Density itself, when a nonlinear equation of state is + Rho, & ! Density itself [kg m-3], when a nonlinear equation of state is ! not in use. h_avail, & ! The mass available for diffusion out of each face, divided ! by dt [H m2 s-1 ~> m3 s-1 or kg s-1]. @@ -448,29 +450,31 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV pres, & ! The pressure at an interface [Pa]. h_avail_rsum ! The running sum of h_avail above an interface [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)) :: & - drho_dT_u, & ! The derivatives of density with temperature and - drho_dS_u ! salinity at u points, in kg m-3 K-1 and kg m-3 psu-1. + drho_dT_u, & ! The derivative of density with temperature at u points [kg m-3 degC-1] + drho_dS_u ! The derivative of density with salinity at u points [kg m-3 ppt-1]. real, dimension(SZI_(G)) :: & - drho_dT_v, & ! The derivatives of density with temperature and - drho_dS_v ! salinity at v points, in kg m-3 K-1 and kg m-3 psu-1. - real :: uhtot(SZIB_(G), SZJ_(G)) ! The vertical sum of uhD, in m3 s-1. - real :: vhtot(SZI_(G), SZJB_(G)) ! The vertical sum of vhD, in m3 s-1. + drho_dT_v, & ! The derivative of density with temperature at v points [kg m-3 degC-1] + drho_dS_v ! The derivative of density with salinity at v points [kg m-3 ppt-1]. + real :: uhtot(SZIB_(G), SZJ_(G)) ! The vertical sum of uhD [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: vhtot(SZI_(G), SZJB_(G)) ! The vertical sum of vhD [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)) :: & - T_u, S_u, & ! Temperature, salinity, and pressure on the interface at - pres_u ! the u-point in the horizontal. + T_u, & ! Temperature on the interface at the u-point [degC]. + S_u, & ! Salinity on the interface at the u-point [ppt]. + pres_u ! Pressure on the interface at the u-point [Pa]. real, dimension(SZI_(G)) :: & - T_v, S_v, & ! Temperature, salinity, and pressure on the interface at - pres_v ! the v-point in the horizontal. + T_v, & ! Temperature on the interface at the v-point [degC]. + S_v, & ! Salinity on the interface at the v-point [ppt]. + pres_v ! Pressure on the interface at the v-point [Pa]. real :: Work_u(SZIB_(G), SZJ_(G)) ! The work being done by the thickness - real :: Work_v(SZI_(G), SZJB_(G)) ! diffusion integrated over a cell, in W. - real :: Work_h ! The work averaged over an h-cell in W m-2. + real :: Work_v(SZI_(G), SZJB_(G)) ! diffusion integrated over a cell [W]. + real :: Work_h ! The work averaged over an h-cell [W m-2]. real :: I4dt ! 1 / 4 dt [s-1]. real :: drdiA, drdiB ! Along layer zonal- and meridional- potential density real :: drdjA, drdjB ! gradients in the layers above (A) and below(B) the ! interface times the grid spacing [kg m-3]. real :: drdkL, drdkR ! Vertical density differences across an interface [kg m-3]. - real :: drdi_u(SZIB_(G), SZK_(G)+1) ! Copy of drdi at u-points in kg m-3. - real :: drdj_v(SZI_(G), SZK_(G)+1) ! Copy of drdj at v-points in kg m-3. + real :: drdi_u(SZIB_(G), SZK_(G)+1) ! Copy of drdi at u-points [kg m-3]. + real :: drdj_v(SZI_(G), SZK_(G)+1) ! Copy of drdj at v-points [kg m-3]. real :: drdkDe_u(SZIB_(G),SZK_(G)+1) ! Lateral difference of product of drdk and e at u-points ! [Z kg m-3 ~> kg m-2]. real :: drdkDe_v(SZI_(G),SZK_(G)+1) ! Lateral difference of product of drdk and e at v-points @@ -479,7 +483,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: haA, haB, haL, haR ! Arithmetic mean thicknesses [H ~> m or kg m-2]. real :: dzaL, dzaR ! Temporary thicknesses [Z ~> m]. real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. - real :: drdx, drdy ! Zonal and meridional density gradients, in kg m-4. + real :: drdx, drdy ! Zonal and meridional density gradients [kg m-4]. real :: drdz ! Vertical density gradient [kg m-3 Z-1 ~> kg m-4]. real :: h_harm ! Harmonic mean layer thickness [H ~> m or kg m-2]. real :: c2_h_u(SZIB_(G), SZK_(G)+1) ! Wave speed squared divided by h at u-points [m2 Z-1 s-2 ~> m s-2]. @@ -498,7 +502,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! good thing to use when the slope is so large as to be meaningless [Z m2 s-1 ~> m3 s-1]. real :: Slope ! The slope of density surfaces, calculated in a way ! that is always between -1 and 1, nondimensional. - real :: mag_grad2 ! The squared magnitude of the 3-d density gradient, in kg2 m-8. + real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [kg2 m-8]. real :: I_slope_max2 ! The inverse of slope_max squared, nondimensional. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -510,11 +514,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. logical :: find_work ! If true, find the change in energy due to the fluxes. - integer :: nk_linear ! The number of layers over which the streamfunction - ! goes to 0. + integer :: nk_linear ! The number of layers over which the streamfunction goes to 0. real :: G_rho0 ! g/Rho0 [m5 Z-1 s-2 ~> m4 s-2]. real :: N2_floor ! A floor for N2 to avoid degeneracy in the elliptic solver - ! times unit conversion factors (s-2 m2 Z-2) + ! times unit conversion factors [s-2 m2 Z-2 ~> s-2] real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: diag_sfn_x, diag_sfn_unlim_x ! Diagnostics real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: diag_sfn_y, diag_sfn_unlim_y ! Diagnostics logical :: present_int_slope_u, present_int_slope_v diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index 7dd4ad7675..07d6216be1 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -179,8 +179,8 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS) ! Local variables real, dimension(SZK_(G)) :: & cellHeight, & !< Height of cell centers (m) - dRho_dT, & !< partial derivatives of density wrt temp (kg m-3 degC-1) - dRho_dS, & !< partial derivatives of density wrt saln (kg m-3 PPT-1) + dRho_dT, & !< partial derivatives of density wrt temp [kg m-3 degC-1] + dRho_dS, & !< partial derivatives of density wrt saln [kg m-3 ppt-1] pres_int, & !< pressure at each interface (Pa) temp_int, & !< temp and at interfaces (degC) salt_int, & !< salt at at interfaces diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index ca3974be8d..4bf30a5a60 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -284,11 +284,11 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C dR0_dT, & ! Partial derivative of the mixed layer potential density with ! temperature [kg m-3 degC-1]. dRcv_dT, & ! Partial derivative of the coordinate variable potential - ! density in the mixed layer with temperature, in kg m-3 K-1. + ! density in the mixed layer with temperature [kg m-3 degC-1]. dR0_dS, & ! Partial derivative of the mixed layer potential density with ! salinity [kg m-3 PSU-1]. dRcv_dS, & ! Partial derivative of the coordinate variable potential - ! density in the mixed layer with salinity, in kg m-3 psu-1. + ! density in the mixed layer with salinity [kg m-3 ppt-1]. TKE_river ! The turbulent kinetic energy available for mixing at rivermouths over a ! time step [Z m2 s-2 ~> m3 s-2]. @@ -969,13 +969,13 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & intent(in) :: eps !< The negligibly small amount of water !! that will be left in each layer [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of R0 with respect to - !! temperature, in kg m-3 degC-1. + !! temperature [kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of Rcv with respect to - !! temperature, in kg m-3 degC-1. + !! temperature [kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dR0_dS !< The partial derivative of R0 with respect to - !! salinity, in kg m-3 psu-1. + !! salinity [kg m-3 ppt-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dS !< The partial derivative of Rcv with respect to - !! salinity, in kg m-3 psu-1. + !! salinity [kg m-3 ppt-1]. real, dimension(SZI_(G)), intent(in) :: netMassInOut !< The net mass flux (if non-Boussinesq) !! or volume flux (if Boussinesq) into the ocean !! within a time step [H ~> m or kg m-2]. (I.e. P+R-E.) @@ -1044,18 +1044,18 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! h_ent between iterations [H ~> m or kg m-2]. real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of ! the conversion from H to Z divided by the mean density, - ! in m7 s-2 Z-1 H-2 kg-1. !### CHECK UNITS + ! [m7 s-2 Z-1 H-2 kg-1 ~> m4 s-2 kg-1 or m10 s-2 kg-3]. real :: Angstrom ! The minimum layer thickness [H ~> m or kg m-2]. - real :: opacity ! The opacity converted to units of H-1. + real :: opacity ! The opacity converted to inverse thickness units [H-1 ~> m-1 or m2 kg-1] real :: sum_Pen_En ! The potential energy change due to penetrating - ! shortwave radiation, integrated over a layer, in - ! H kg m-3. - real :: Idt ! 1.0/dt + ! shortwave radiation, integrated over a layer + ! [H kg m-3 ~> kg m-2 or kg2 m-5]. + real :: Idt ! 1.0/dt [s-1] real :: netHeatOut ! accumulated heat content of mass leaving ocean integer :: is, ie, nz, i, k, ks, itt, n real, dimension(max(nsw,1)) :: & - C2, & ! Temporary variable with units of kg m-3 H-1. - r_SW_top ! Temporary variables with units of H kg m-3. + C2, & ! Temporary variable [kg m-3 H-1 ~> kg m-4 or m-1]. + r_SW_top ! Temporary variables [H kg m-3 ~> kg m-2 or kg2 m-5]. Angstrom = GV%Angstrom_H C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 @@ -1524,22 +1524,22 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & intent(in) :: eps !< The negligibly small amount of water !! that will be left in each layer [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of R0 with respect to - !! temperature, in kg m-3 degC-1. + !! temperature [kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of Rcv with respect to - !! temperature, in kg m-3 degC-1. + !! temperature [kg m-3 degC-1]. real, dimension(2,SZI_(G)), intent(in) :: cMKE !< Coefficients of HpE and HpE^2 used in calculating !! the denominator of MKE_rate, in m-1 and m-2. real, intent(in) :: Idt_diag !< The inverse of the accumulated diagnostic !! time interval [s-1]. integer, intent(in) :: nsw !< The number of bands of penetrating !! shortwave radiation. - real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave - !! heating at the sea surface in each - !! penetrating band, in K H, + real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave heating at the + !! sea surface in each penetrating band + !! [degC H ~> degC m or degC kg m-2], !! size nsw x SZI_(G). real, dimension(:,:,:), intent(in) :: opacity_band !< The opacity in each band of penetrating !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. - !! The indicies of opacity_band are band, i, k. + !! The indicies of opacity_band are (band, i, k). real, dimension(SZI_(G)), intent(inout) :: TKE !< The turbulent kinetic energy !! available for mixing over a time !! step [Z m2 s-2 ~> m3 s-2]. @@ -1555,7 +1555,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: SW_trans ! The fraction of shortwave radiation that is not ! absorbed in a layer, nondimensional. real :: Pen_absorbed ! The amount of penetrative shortwave radiation - ! that is absorbed in a layer, in units of K m. + ! that is absorbed in a layer [degC H ~> degC m or degC kg m-2]. real :: h_avail ! The thickness in a layer available for entrainment [H ~> m or kg m-2]. real :: h_ent ! The thickness from a layer that is entrained [H ~> m or kg m-2]. real :: h_min, h_max ! Limits on the solution for h_ent [H ~> m or kg m-2]. @@ -1564,12 +1564,12 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: MKE_rate ! The fraction of the energy in resolved shears ! within the mixed layer that will be eliminated ! within a timestep, nondim, 0 to 1. - real :: HpE ! The current thickness plus entrainment, H. + real :: HpE ! The current thickness plus entrainment [H ~> m or kg m-2]. real :: g_H_2Rho0 ! Half the gravitational acceleration times the ! conversion from H to m divided by the mean density, ! in m5 s-2 H-1 kg-1. - real :: TKE_full_ent ! The TKE remaining if a layer is fully entrained, - ! in units of Z m2 s-2. + real :: TKE_full_ent ! The TKE remaining if a layer is fully entrained + ! [Z m2 s-2 ~> m3 s-2]. real :: dRL ! Work required to mix water from the next layer ! across the mixed layer [m2 s-2]. real :: Pen_En_Contrib ! Penetrating SW contributions to the changes in @@ -1906,19 +1906,19 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of !! potential density referenced !! to the surface with potential - !! temperature, in kg m-3 K-1. + !! temperature [kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dR0_dS !< The partial derivative of !! cpotential density referenced !! to the surface with salinity, - !! in kg m-3 psu-1. + !! [kg m-3 ppt-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of !! coordinate defining potential !! density with potential - !! temperature, in kg m-3 K-1. + !! temperature [kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dS !< The partial derivative of !! coordinate defining potential !! density with salinity, - !! in kg m-3 psu-1. + !! [kg m-3 ppt-1]. ! If there are no massive light layers above the deepest of the mixed- and ! buffer layers, do nothing (except perhaps to reshuffle these layers). @@ -2203,7 +2203,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. !! Layer 0 is the new mixed layer. - real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Potential temperature, in C. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Potential temperature [degC]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Salinity [PSU]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: R0 !< Potential density referenced to !! surface pressure [kg m-3]. @@ -2223,18 +2223,18 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of !! potential density referenced to the !! surface with potential temperature, - !! in kg m-3 K-1. + !! [kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dR0_dS !< The partial derivative of !! cpotential density referenced to the - !! surface with salinity, - !! in kg m-3 psu-1. + !! surface with salinity + !! [kg m-3 ppt-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of !! coordinate defining potential density !! with potential temperature, - !! in kg m-3 K-1. + !! [kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dS !< The partial derivative of !! coordinate defining potential density - !! with salinity, in kg m-3 psu-1. + !! with salinity [kg m-3 ppt-1]. real, dimension(SZI_(G)), intent(in) :: max_BL_det !< If non-negative, the maximum !! detrainment permitted from the buffer !! layers [H ~> m or kg m-2]. @@ -3103,7 +3103,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. !! Layer 0 is the new mixed layer. - real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Potential temperature, in C. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Potential temperature [degC]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Salinity [PSU]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: R0 !< Potential density referenced to !! surface pressure [kg m-3]. @@ -3127,11 +3127,11 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e !! previous call to mixedlayer_init. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of !! coordinate defining potential density - !! with potential temperature, - !! in kg m-3 K-1. + !! with potential temperature + !! [kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dS !< The partial derivative of !! coordinate defining potential density - !! with salinity, in kg m-3 psu-1. + !! with salinity [kg m-3 ppt-1]. real, dimension(SZI_(G)), intent(in) :: max_BL_det !< If non-negative, the maximum !! detrainment permitted from the buffer !! layers [H ~> m or kg m-2]. @@ -3145,15 +3145,15 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e ! from the mixed layer [H ~> m or kg m-2]. real :: Idt ! The inverse of the timestep [s-1]. real :: dT_dR, dS_dR, dRml, dR0_dRcv, dT_dS_wt2 - real :: I_denom ! A work variable with units of psu2 m6 kg-2. + real :: I_denom ! A work variable [ppt2 m6 kg-2]. real :: Sdown, Tdown real :: dt_Time, Timescale = 86400.0*30.0! *365.0/12.0 - real :: g_H2_2Rho0dt ! Half the gravitational acceleration times the square of - ! the conversion from H to m divided by the mean - ! density times the time step, in m7 s-3 Z-1 H-2 kg-1. !### CHECK UNITS - real :: g_H2_2dt ! Half the gravitational acceleration times the - ! square of the conversion from H to m divided - ! by the diagnostic time step, in m4 Z-1 H-2 s-3. + real :: g_H2_2Rho0dt ! Half the gravitational acceleration times the square of the + ! conversion from H to m divided by the mean density times the time + ! step [m7 s-3 Z-1 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. + real :: g_H2_2dt ! Half the gravitational acceleration times the square of the + ! conversion from H to m divided by the diagnostic time step + ! [m4 Z-1 H-2 s-3 ~> m s-3 or m7 kg-2 s-3]. logical :: splittable_BL(SZI_(G)), orthogonal_extrap real :: x1 diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 5bebd8ea60..e31b078922 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -33,7 +33,8 @@ module MOM_entrain_diffusive !! their target variables by the diapycnal mixing. integer :: max_ent_it !< The maximum number of iterations that may be used to !! calculate the diapycnal entrainment. - real :: Tolerance_Ent !< The tolerance with which to solve for entrainment values, in m. + real :: Tolerance_Ent !< The tolerance with which to solve for entrainment values + !! [H ~> m or kg m-2]. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. integer :: id_Kd = -1 !< Diagnostic ID for diffusivity @@ -125,7 +126,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, htot, & ! The total thickness above or below a layer [H ~> m or kg m-2]. Rcv, & ! Value of the coordinate variable (potential density) ! based on the simulated T and S and P_Ref [kg m-3]. - pres, & ! Reference pressure (P_Ref) in Pa. + pres, & ! Reference pressure (P_Ref) [Pa]. eakb, & ! The entrainment from above by the layer below the buffer ! layer (i.e. layer kb) [H ~> m or kg m-2]. ea_kbp1, & ! The entrainment from above by layer kb+1 [H ~> m or kg m-2]. @@ -140,7 +141,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, ! [H2 ~> m2 or kg2 m-4]. maxF_correct, & ! An amount by which to correct maxF due to excessive ! surface heat loss [H ~> m or kg m-2]. - zeros, & ! An array of all zeros. (Usually used with units of H.) + zeros, & ! An array of all zeros. (Usually used with [H ~> m or kg m-2].) max_eakb, & ! The maximum value of eakb that might be realized [H ~> m or kg m-2]. min_eakb, & ! The minimum value of eakb that might be realized [H ~> m or kg m-2]. err_max_eakb0, & ! The value of error returned by determine_Ea_kb @@ -1041,7 +1042,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref intent(out) :: Ent_bl !< The average entrainment upward and !! downward across each interface around !! the buffer layers [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZK_(G)), intent(out) :: Sref !< The coordinate potential density - + real, dimension(SZI_(G),SZK_(G)), intent(out) :: Sref !< The coordinate potential density minus !! 1000 for each layer [kg m-3]. real, dimension(SZI_(G),SZK_(G)), intent(out) :: h_bl !< The thickness of each layer [H ~> m or kg m-2]. @@ -1053,10 +1054,10 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, CS, j, Ent_bl, Sref ! Local variables real, dimension(SZI_(G)) :: & - b1, d1, & ! Variables used by the tridiagonal solver, in H-1 and ND. + b1, d1, & ! Variables used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1] and [nondim]. Rcv, & ! Value of the coordinate variable (potential density) - ! based on the simulated T and S and P_Ref, kg m-3. - pres, & ! Reference pressure (P_Ref) in Pa. + ! based on the simulated T and S and P_Ref [kg m-3]. + pres, & ! Reference pressure (P_Ref) [Pa]. frac_rem, & ! The fraction of the diffusion remaining [nondim]. h_interior ! The interior thickness available for entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G), SZK_(G)) :: & @@ -1213,12 +1214,12 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & !! and the topmost interior layer. !! dSkb > 0. real, dimension(SZI_(G)), optional, intent(inout) :: ddSkb_dE !< The partial derivative of dSkb - !! with E, in kg m-3 H-1. + !! with E [kg m-3 H-1 ~> kg m-4 or m-1]. real, dimension(SZI_(G)), optional, intent(inout) :: dSlay !< The limited potential density !! difference across the topmost !! interior layer. 0 < dSkb real, dimension(SZI_(G)), optional, intent(inout) :: ddSlay_dE !< The partial derivative of dSlay - !! with E, in kg m-3 H-1. + !! with E [kg m-3 H-1 ~> kg m-4 or m-1]. real, dimension(SZI_(G)), optional, intent(inout) :: dS_anom_lim !< A limiting value to use for !! the density anomalies below the !! buffer layer [kg m-3]. @@ -1626,8 +1627,8 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & dS_Lay, & ! The coordinate-density difference across layer ! kb, limited to ensure that it is positive and not ! too much bigger than dS_kb or dS_kbp1 [kg m-3]. - ddSkb_dE, ddSlay_dE, & ! The derivatives of dS_kb and dS_Lay with E, - ! in kg m-3 H-1. + ddSkb_dE, ddSlay_dE, & ! The derivatives of dS_kb and dS_Lay with E + ! [kg m-3 H-1 ~> kg m-4 or m-1]. derror_dE, & ! The derivative of err with E [H ~> m or kg m-2]. err, & ! The "error" whose zero is being sought [H2 ~> m2 or kg2 m-4]. E_min, E_max, & ! The minimum and maximum values of E [H ~> m or kg m-2]. diff --git a/src/parameterizations/vertical/MOM_full_convection.F90 b/src/parameterizations/vertical/MOM_full_convection.F90 index 7851e4806c..866dd16114 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -39,7 +39,7 @@ subroutine full_convection(G, GV, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, & ! Local variables real, dimension(SZI_(G),SZK_(G)+1) :: & drho_dT, & ! The derivatives of density with temperature and - drho_dS ! salinity, in kg m-3 K-1 and kg m-3 psu-1. + drho_dS ! salinity [kg m-3 degC-1] and [kg m-3 ppt-1]. real :: h_neglect, h0 ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. ! logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. @@ -281,8 +281,8 @@ end subroutine full_convection !! above and below, including partial calculations from a tridiagonal solver. function is_unstable(dRho_dT, dRho_dS, h_a, h_b, mix_A, mix_B, T_a, T_b, S_a, S_b, & Te_aa, Te_bb, Se_aa, Se_bb, d_A, d_B) - real, intent(in) :: dRho_dT !< The derivative of in situ density with temperature in kg m-3 degC-1 - real, intent(in) :: dRho_dS !< The derivative of in situ density with salinity in kg m-3 ppt-1 + real, intent(in) :: dRho_dT !< The derivative of in situ density with temperature [kg m-3 degC-1] + real, intent(in) :: dRho_dS !< The derivative of in situ density with salinity [kg m-3 ppt-1] real, intent(in) :: h_a !< The thickness of the layer above [H ~> m or kg m-2] real, intent(in) :: h_b !< The thickness of the layer below [H ~> m or kg m-2] real, intent(in) :: mix_A !< The time integrated mixing rate of the interface above [H ~> m or kg m-2] @@ -327,10 +327,10 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, j, p_surf, halo) real, intent(in) :: Kddt !< A diffusivity times a time increment [H2 ~> m2 or kg2 m-4]. real, dimension(SZI_(G),SZK_(G)+1), & intent(out) :: dR_dT !< Derivative of locally referenced - !! potential density with temperature, kg m-3 K-1 + !! potential density with temperature [kg m-3 degC-1] real, dimension(SZI_(G),SZK_(G)+1), & intent(out) :: dR_dS !< Derivative of locally referenced - !! potential density with salinity, kg m-3 ppt-1 + !! potential density with salinity [kg m-3 ppt-1] integer, intent(in) :: j !< The j-point to work on. real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface in Pa (or NULL). integer, optional, intent(in) :: halo !< Halo width over which to compute diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 5f00086e17..daf6ae043c 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -153,7 +153,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) hb, & ! The depth below a layer [Z ~> m]. z_from_bot, & ! The height of a layer center above the bottom [Z ~> m]. dRho_dT, & ! The partial derivatives of density with temperature and - dRho_dS ! salinity, in kg m-3 degC-1 and kg m-3 PSU-1. + dRho_dS ! salinity [kg m-3 degC-1] and [kg m-3 ppt-1]. real :: dz_int ! The thickness associated with an interface [Z ~> m]. real :: G_Rho0 ! The gravitation acceleration divided by the Boussinesq diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 714a58e238..c717689140 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -892,8 +892,8 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & ! Local variables real, dimension(SZI_(G),SZK_(G)+1) :: & dRho_int_unfilt, & ! unfiltered density differences across interfaces - dRho_dT, & ! partial derivative of density wrt temp (kg m-3 degC-1) - dRho_dS ! partial derivative of density wrt saln (kg m-3 PPT-1) + dRho_dT, & ! partial derivative of density wrt temp [kg m-3 degC-1] + dRho_dS ! partial derivative of density wrt saln [kg m-3 ppt-1] real, dimension(SZI_(G)) :: & pres, & ! pressure at each interface (Pa) @@ -1063,8 +1063,8 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) !! diffusivity for saln [Z2 s-1 ~> m2 s-1]. real, dimension(SZI_(G)) :: & - dRho_dT, & ! partial derivatives of density wrt temp (kg m-3 degC-1) - dRho_dS, & ! partial derivatives of density wrt saln (kg m-3 PPT-1) + dRho_dT, & ! partial derivatives of density wrt temp [kg m-3 degC-1] + dRho_dS, & ! partial derivatives of density wrt saln [kg m-3 ppt-1] pres, & ! pressure at each interface (Pa) Temp_int, & ! temp and saln at interfaces Salin_int diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index d5fc24f16d..caf6c52ee5 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -125,15 +125,15 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! Local variables real, dimension(SZIB_(G)) :: & - ustar, & ! The bottom friction velocity [m s-1]. + ustar, & ! The bottom friction velocity [Z s-1 ~> m s-1]. T_EOS, & ! The temperature used to calculate the partial derivatives ! of density with T and S [degC]. S_EOS, & ! The salinity used to calculate the partial derivatives - ! of density with T and S [PSU]. + ! of density with T and S [ppt]. dR_dT, & ! Partial derivative of the density in the bottom boundary ! layer with temperature [kg m-3 degC-1]. dR_dS, & ! Partial derivative of the density in the bottom boundary - ! layer with salinity [kg m-3 PSU-1]. + ! layer with salinity [kg m-3 ppt-1]. press ! The pressure at which dR_dT and dR_dS are evaluated [Pa]. real :: htot ! Sum of the layer thicknesses up to some point [H ~> m or kg m-2]. real :: htot_vel ! Sum of the layer thicknesses up to some point [H ~> m or kg m-2]. @@ -165,7 +165,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! plus H_neglect to avoid 0 values [H ~> m or kg m-2]. real :: ustarsq ! 400 times the square of ustar, times ! Rho0 divided by G_Earth and the conversion - ! from m to thickness units, in kg m-2 or kg2 m-5. + ! from m to thickness units [H kg m-3 ~> kg m-2 or kg2 m-5]. real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion ! factor from lateral lengths to vertical depths [Z m-1 ~> 1]. real :: cdrag_sqrt ! Square root of the drag coefficient [nondim]. diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index 758f15e2e2..eaa2faf765 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -56,7 +56,7 @@ module MOM_sponge integer, pointer :: col_j(:) => NULL() !< Array of the j-indicies of each of the columns being damped. real, pointer :: Iresttime_col(:) => NULL() !< The inverse restoring time of each column. real, pointer :: Rcv_ml_ref(:) => NULL() !< The value toward which the mixed layer - !! coordinate-density is being damped, in kg m-3. + !! coordinate-density is being damped [kg m-3]. real, pointer :: Ref_eta(:,:) => NULL() !< The value toward which the interface !! heights are being damped [Z ~> m]. type(p3d) :: var(MAX_FIELDS_) !< Pointers to the fields that are being damped. @@ -66,7 +66,7 @@ module MOM_sponge real, pointer :: Iresttime_im(:) => NULL() !< The inverse restoring time of !! each row for i-mean sponges. real, pointer :: Rcv_ml_ref_im(:) => NULL() !! The value toward which the i-mean - !< mixed layer coordinate-density is being damped, in kg m-3. + !< mixed layer coordinate-density is being damped [kg m-3]. real, pointer :: Ref_eta_im(:,:) => NULL() !< The value toward which the i-mean !! interface heights are being damped [Z ~> m]. type(p2d) :: Ref_val_im(MAX_FIELDS_) !< The values toward which the i-means of @@ -273,12 +273,12 @@ end subroutine set_up_sponge_field subroutine set_up_sponge_ML_density(sp_val, G, CS, sp_val_i_mean) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: sp_val !< The reference values of the mixed layer density, in kg m-3 + intent(in) :: sp_val !< The reference values of the mixed layer density [kg m-3] type(sponge_CS), pointer :: CS !< A pointer to the control structure for this module that is !! set by a previous call to initialize_sponge. real, dimension(SZJ_(G)), & optional, intent(in) :: sp_val_i_mean !< the reference values of the zonal mean mixed - !! layer density in kg m-3, for use if Iresttime_i_mean > 0. + !! layer density [kg m-3], for use if Iresttime_i_mean > 0. ! This subroutine stores the reference value for mixed layer density. It is ! handled differently from other values because it is only used in determining ! which layers can be inflated. diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 5b395d4a58..4f6ce6b5bb 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -208,9 +208,9 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock intent(inout) :: h_pre !< layer thicknesses before advection !! [H ~> m or kg m-2] real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)), & - intent(inout) :: uhtr !< Zonal mass transport in m3 or kg + intent(inout) :: uhtr !< Zonal mass transport [H m2 ~> m3 or kg] real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)), & - intent(inout) :: vhtr !< Meridional mass transport in m3 or kg + intent(inout) :: vhtr !< Meridional mass transport [H m2 ~> m3 or kg] logical, intent( out) :: converged !< True if the iterations have converged ! Local pointers @@ -649,9 +649,9 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, e real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), & intent(inout) :: h_pre !< layer thicknesses before advection [H ~> m or kg m-2] real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), & - intent(inout) :: eatr !< Entrainment from layer above in m or kg-2 + intent(inout) :: eatr !< Entrainment from layer above [H ~> m or kg m-2] real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), & - intent(inout) :: ebtr !< Entrainment from layer below in m or kg-2 + intent(inout) :: ebtr !< Entrainment from layer below [H ~> m or kg m-2] real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: sw, sw_vis, sw_nir !< Save old value of shortwave radiation real :: hval diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index bc212617a0..7884823acc 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -133,13 +133,13 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla khdt_x, & ! The value of Khtr*dt times the open face width divided by ! the distance between adjacent tracer points, in m2. Coef_x, & ! The coefficients relating zonal tracer differences - ! to time-integrated fluxes, in m3 or kg. + ! to time-integrated fluxes [H m2 ~> m3 or kg]. Kh_u ! Tracer mixing coefficient at u-points, in m2 s-1. real, dimension(SZI_(G),SZJB_(G)) :: & khdt_y, & ! The value of Khtr*dt times the open face width divided by ! the distance between adjacent tracer points, in m2. Coef_y, & ! The coefficients relating meridional tracer differences - ! to time-integrated fluxes, in m3 or kg. + ! to time-integrated fluxes [H m2 ~> m3 or kg]. Kh_v ! Tracer mixing coefficient at u-points, in m2 s-1. real :: khdt_max ! The local limiting value of khdt_x or khdt_y, in m2. diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 687cabcfb3..811d8ca5b6 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -71,9 +71,9 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) real :: Salin_restore ! The salinity that is being restored toward [PSU]. real :: density_restore ! The potential density that is being restored ! toward [kg m-3]. - real :: rhoXcp ! The mean density times the heat capacity, in J m-3 K-1. + real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. real :: buoy_rest_const ! A constant relating density anomalies to the - ! restoring buoyancy flux, in m5 s-3 kg-1. + ! restoring buoyancy flux [m5 s-3 kg-1]. integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -156,7 +156,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) Temp_restore = 0.0 do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential - ! density in kg m-3 that is being restored toward. + ! density [kg m-3] that is being restored toward. if (G%geoLatT(i,j) < CS%lfrslat) then Temp_restore = CS%SST_s elseif (G%geoLatT(i,j) > CS%lfrnlat) then diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index cf492cf99e..98f142ff74 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -259,10 +259,10 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) ! Local variables ! The following variables are used to set the target temperature and salinity. real :: T0(SZK_(G)), S0(SZK_(G)) - real :: pres(SZK_(G)) ! An array of the reference pressure in Pa. - real :: drho_dT(SZK_(G)) ! Derivative of density with temperature in kg m-3 K-1. ! - real :: drho_dS(SZK_(G)) ! Derivative of density with salinity in kg m-3 PSU-1. ! - real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 in kg m-3. + real :: pres(SZK_(G)) ! An array of the reference pressure [Pa]. + real :: drho_dT(SZK_(G)) ! Derivative of density with temperature [kg m-3 degC-1]. + real :: drho_dS(SZK_(G)) ! Derivative of density with salinity [kg m-3 ppt-1]. + real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 [kg m-3]. ! The following variables are used to set up the transport in the DOME example. real :: tr_0, y1, y2, tr_k, rst, rsb, rc, v_k, lon_im1 real :: D_edge ! The thickness [Z ~> m], of the dense fluid at the diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index bd2ad1f1d6..dfa9b1d892 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -252,8 +252,8 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, eqn_of_state, just_read_params) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature (degC) - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity (ppt) + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature [degC] + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure @@ -263,19 +263,21 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, integer :: i, j, k, is, ie, js, je, nz, itt real :: x, ds, dt, rho_sur, rho_bot real :: xi0, xi1 ! Heights in depth units [Z ~> m]. - real :: S_sur, T_sur, S_bot, T_bot - real :: dT_dz, dS_dz ! Gradients of T and S in degC/Z and PPT/Z. - real :: z ! vertical position in z space - character(len=256) :: mesg ! The text of an error message + real :: S_sur, S_bot ! Salinity at the surface and bottom [ppt] + real :: T_sur, T_bot ! Temperature at the bottom [degC] + real :: dT_dz ! Vertical gradient of temperature [degC Z-1 ~> degC m-1]. + real :: dS_dz ! Vertical gradient of salinity [ppt Z-1 ~> ppt m-1]. + real :: z ! vertical position in z space [Z ~> m] + character(len=256) :: mesg ! The text of an error message character(len=40) :: verticalCoordinate, density_profile real :: rho_tmp - logical :: just_read ! If true, just read parameters but set nothing. + logical :: just_read ! If true, just read parameters but set nothing. logical :: fit_salin ! If true, accept the prescribed temperature and fit the salinity. real :: T0(SZK_(G)), S0(SZK_(G)) - real :: drho_dT(SZK_(G)) ! Derivative of density with temperature in kg m-3 K-1. ! - real :: drho_dS(SZK_(G)) ! Derivative of density with salinity in kg m-3 PSU-1. ! - real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 in kg m-3. - real :: pres(SZK_(G)) ! An array of the reference pressure in Pa. (zero here) + real :: drho_dT(SZK_(G)) ! Derivative of density with temperature [kg m-3 degC-1]. + real :: drho_dS(SZK_(G)) ! Derivative of density with salinity [kg m-3 ppt-1]. + real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 [kg m-3]. + real :: pres(SZK_(G)) ! An array of the reference pressure [Pa]. (zero here) real :: drho_dT1, drho_dS1, T_Ref, S_Ref is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke pres(:) = 0.0 diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index ef9ebdf46e..357396b794 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -354,10 +354,10 @@ end subroutine Phillips_initialize_topography !! D - Basin depth in m. (Must be positive.) !! f - The Coriolis parameter [s-1]. !! g - The reduced gravity at each interface [m s-2] -!! Rlay - Layer potential density (coordinate variable) in kg m-3. +!! Rlay - Layer potential density (coordinate variable) [kg m-3]. !! If ENABLE_THERMODYNAMICS is defined: -!! T - Temperature in C. -!! S - Salinity in psu. +!! T - Temperature [degC]. +!! S - Salinity [ppt]. !! If SPONGE is defined: !! A series of subroutine calls are made to set up the damping !! rates and reference profiles for all variables that are damped diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index cfbad108f2..859a878446 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -94,7 +94,7 @@ subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state type(EOS_type), pointer :: eqn_of_state !< integer that selects the !! equation of state. real, intent(in) :: P_Ref !< The coordinate-density - !! reference pressure in Pa. + !! reference pressure [Pa]. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables @@ -222,17 +222,15 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, param_file, & type(EOS_type), pointer :: eqn_of_state !< integer that selects the !! equation of state. real, intent(in) :: P_Ref !< The coordinate-density - !! reference pressure in Pa. + !! reference pressure [Pa]. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. ! Local variables real :: T0(SZK_(G)), S0(SZK_(G)) - real :: pres(SZK_(G)) ! Reference pressure in kg m-3. ! - real :: drho_dT(SZK_(G)) ! Derivative of density with temperature in ! - ! kg m-3 K-1. ! - real :: drho_dS(SZK_(G)) ! Derivative of density with salinity in ! - ! kg m-3 PSU-1. ! - real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 in kg m-3. ! + real :: pres(SZK_(G)) ! Reference pressure [kg m-3]. + real :: drho_dT(SZK_(G)) ! Derivative of density with temperature [kg m-3 degC-1]. + real :: drho_dS(SZK_(G)) ! Derivative of density with salinity [kg m-3 ppt-1]. + real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 [kg m-3]. real :: PI ! 3.1415926... calculated as 4*atan(1) real :: SST ! The initial sea surface temperature [degC]. real :: lat diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index 2f9f52e49c..340a34c2db 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -32,7 +32,7 @@ module dumbbell_surface_forcing real :: Flux_const !< The restoring rate at the surface [m s-1]. real :: gust_const !< A constant unresolved background gustiness !! that contributes to ustar [Pa]. - real :: slp_amplitude !< The amplitude of pressure loading (in Pa) applied + real :: slp_amplitude !< The amplitude of pressure loading [Pa] applied !! to the reservoirs real :: slp_period !< Period of sinusoidal pressure wave real, dimension(:,:), allocatable :: & @@ -60,13 +60,13 @@ subroutine dumbbell_buoyancy_forcing(state, fluxes, day, dt, G, CS) type(dumbbell_surface_forcing_CS), pointer :: CS !< A control structure returned by a previous !! call to dumbbell_surface_forcing_init ! Local variables - real :: Temp_restore ! The temperature that is being restored toward, in C. + real :: Temp_restore ! The temperature that is being restored toward [degC]. real :: Salin_restore ! The salinity that is being restored toward [PSU]. real :: density_restore ! The potential density that is being restored ! toward [kg m-3]. - real :: rhoXcp ! The mean density times the heat capacity, in J m-3 K-1. + real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. real :: buoy_rest_const ! A constant relating density anomalies to the - ! restoring buoyancy flux, in m5 s-3 kg-1. + ! restoring buoyancy flux [m5 s-3 kg-1]. integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -123,7 +123,7 @@ subroutine dumbbell_buoyancy_forcing(state, fluxes, day, dt, G, CS) if (CS%use_temperature .and. CS%restorebuoy) then do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential - ! density in kg m-3 that is being restored toward. + ! density [kg m-3] that is being restored toward. if (CS%forcing_mask(i,j)>0.) then fluxes%vprec(i,j) = - (G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)) * & ((CS%S_restore(i,j) - state%SSS(i,j)) / & diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index 9438e0d4f9..4d9fb72a4e 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -26,12 +26,12 @@ module user_change_diffusivity !> Control structure for user_change_diffusivity type, public :: user_change_diff_CS ; private real :: Kd_add !< The scale of a diffusivity that is added everywhere - !! without any filtering or scaling, in m2 s-1. + !! without any filtering or scaling [Z2 s-1 ~> m2 s-1]. real :: lat_range(4) !< 4 values that define the latitude range over which - !! a diffusivity scaled by Kd_add is added, in deg. + !! a diffusivity scaled by Kd_add is added [degLat]. real :: rho_range(4) !< 4 values that define the coordinate potential !! density range over which a diffusivity scaled by - !! Kd_add is added, in kg m-3. + !! Kd_add is added [kg m-3]. logical :: use_abs_lat !< If true, use the absolute value of latitude when !! setting lat_range. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to @@ -57,14 +57,14 @@ subroutine user_change_diff(h, tv, G, GV, CS, Kd_lay, Kd_int, T_f, S_f, Kd_int_a real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int !< The diapycnal diffusivity !! at each interface [Z2 s-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: T_f !< Temperature with massless - !! layers filled in vertically. + !! layers filled in vertically [degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: S_f !< Salinity with massless - !! layers filled in vertically. + !! layers filled in vertically [ppt]. real, dimension(:,:,:), optional, pointer :: Kd_int_add !< The diapycnal !! diffusivity that is being added at !! each interface [Z2 s-1 ~> m2 s-1]. ! Local variables - real :: Rcv(SZI_(G),SZK_(G)) ! The coordinate density in layers in kg m-3. + real :: Rcv(SZI_(G),SZK_(G)) ! The coordinate density in layers [kg m-3]. real :: p_ref(SZI_(G)) ! An array of tv%P_Ref pressures. real :: rho_fn ! The density dependence of the input function, 0-1, ND. real :: lat_fn ! The latitude dependence of the input function, 0-1, ND. From e0c3d49a7600871aab1fe1dd1912cbb833d01157 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 21 Dec 2018 17:02:28 -0500 Subject: [PATCH 0973/1072] Documented temperature variable units Changed comments to use the square bracket notation to document the units of about 350 temperature, salinity and various other variables. Also eliminated several redundant argument documentation blocks. Only comments have been changed and all answers are bitwise identical. --- .../ice_solo_driver/user_surface_forcing.F90 | 11 +- .../solo_driver/MESO_surface_forcing.F90 | 14 +- .../solo_driver/MOM_surface_forcing.F90 | 54 ++--- .../solo_driver/user_surface_forcing.F90 | 4 +- src/core/MOM_PressureForce_analytic_FV.F90 | 4 +- src/core/MOM_checksum_packages.F90 | 14 +- src/core/MOM_continuity.F90 | 8 +- src/core/MOM_isopycnal_slopes.F90 | 7 +- src/diagnostics/MOM_sum_output.F90 | 95 ++++---- src/equation_of_state/MOM_EOS_TEOS10.F90 | 4 +- src/ice_shelf/MOM_ice_shelf.F90 | 10 +- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 4 +- .../vertical/MOM_diabatic_aux.F90 | 24 +- .../vertical/MOM_diapyc_energy_req.F90 | 98 ++++---- .../vertical/MOM_energetic_PBL.F90 | 67 +++--- .../vertical/MOM_entrain_diffusive.F90 | 19 +- .../vertical/MOM_full_convection.F90 | 40 ++-- .../vertical/MOM_internal_tide_input.F90 | 16 +- .../vertical/MOM_set_diffusivity.F90 | 210 ++++++++---------- .../vertical/MOM_shortwave_abs.F90 | 6 +- .../vertical/MOM_tidal_mixing.F90 | 4 +- src/user/dumbbell_initialization.F90 | 2 +- src/user/seamount_initialization.F90 | 2 +- 23 files changed, 353 insertions(+), 364 deletions(-) diff --git a/config_src/ice_solo_driver/user_surface_forcing.F90 b/config_src/ice_solo_driver/user_surface_forcing.F90 index 41694af97c..bbfa4560fb 100644 --- a/config_src/ice_solo_driver/user_surface_forcing.F90 +++ b/config_src/ice_solo_driver/user_surface_forcing.F90 @@ -83,7 +83,7 @@ module user_surface_forcing real :: G_Earth ! The gravitational acceleration [m s-2]. real :: Flux_const ! The restoring rate at the surface [m s-1]. real :: gust_const ! A constant unresolved background gustiness - ! that contributes to ustar, in Pa. + ! that contributes to ustar [Pa]. type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the ! timing of diagnostic output. @@ -126,7 +126,7 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) ! Allocate the forcing arrays, if necessary. call allocate_mech_forcing(G, forces, stress=.true., ustar=.true.) - ! Set the surface wind stresses, in units of Pa. A positive taux + ! Set the surface wind stresses [Pa]. A positive taux ! accelerates the ocean to the (pseudo-)east. ! The i-loop extends to is-1 so that taux can be used later in the @@ -138,8 +138,7 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) forces%tauy(i,J) = G%mask2dCv(i,J) * 0.0 ! Change this to the desired expression. enddo ; enddo - ! Set the surface friction velocity, in units of m s-1. ustar - ! is always positive. + ! Set the surface friction velocity [Z s-1 ~> m s-1]. ustar is always positive. if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie ! This expression can be changed if desired, but need not be. forces%ustar(i,j) = US%m_to_Z * G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & @@ -177,8 +176,8 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! are in W m-2 and positive for heat going into the ocean. All fresh water ! fluxes are in kg m-2 s-1 and positive for water moving into the ocean. - real :: Temp_restore ! The temperature that is being restored toward, in C. - real :: Salin_restore ! The salinity that is being restored toward, in PSU. + real :: Temp_restore ! The temperature that is being restored toward [C]. + real :: Salin_restore ! The salinity that is being restored toward [ppt] real :: density_restore ! The potential density that is being restored ! toward [kg m-3]. real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. diff --git a/config_src/solo_driver/MESO_surface_forcing.F90 b/config_src/solo_driver/MESO_surface_forcing.F90 index e6f35274bf..a676b35bc0 100644 --- a/config_src/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/solo_driver/MESO_surface_forcing.F90 @@ -30,14 +30,14 @@ module MESO_surface_forcing real :: G_Earth !< The gravitational acceleration [m s-2]. real :: Flux_const !< The restoring rate at the surface [m s-1]. real :: gust_const !< A constant unresolved background gustiness - !! that contributes to ustar, in Pa. + !! that contributes to ustar [Pa]. real, dimension(:,:), pointer :: & - T_Restore(:,:) => NULL(), & !< The temperature to restore the SST toward, in C. - S_Restore(:,:) => NULL(), & !< The salinity to restore the sea surface salnity toward, in PSU. - PmE(:,:) => NULL(), & !< The prescribed precip minus evap, in m s-1. - Solar(:,:) => NULL() !< The shortwave forcing into the ocean, in W m-2 m s-1. + T_Restore(:,:) => NULL(), & !< The temperature to restore the SST toward [degC]. + S_Restore(:,:) => NULL(), & !< The salinity to restore the sea surface salnity toward [ppt] + PmE(:,:) => NULL(), & !< The prescribed precip minus evap [m s-1]. + Solar(:,:) => NULL() !< The shortwave forcing into the ocean [W m-2]. real, dimension(:,:), pointer :: Heat(:,:) => NULL() !< The prescribed longwave, latent and sensible - !! heat flux into the ocean, in W m-2. + !! heat flux into the ocean [W m-2]. character(len=200) :: inputdir !< The directory where NetCDF input files are. character(len=200) :: salinityrestore_file !< The file with the target sea surface salinity character(len=200) :: SSTrestore_file !< The file with the target sea surface temperature @@ -76,7 +76,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! fluxes are in kg m-2 s-1 and positive for water moving into the ocean. real :: Temp_restore ! The temperature that is being restored toward [degC]. - real :: Salin_restore ! The salinity that is being restored toward, in PSU. + real :: Salin_restore ! The salinity that is being restored toward [ppt] real :: density_restore ! The potential density that is being restored ! toward [kg m-3]. real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index ed990dbbaa..529b5087f4 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -78,32 +78,32 @@ module MOM_surface_forcing real :: south_lat !< southern latitude of the domain real :: len_lat !< domain length in latitude - real :: Rho0 !< Boussinesq reference density (kg/m^3) - real :: G_Earth !< gravitational acceleration (m/s^2) + real :: Rho0 !< Boussinesq reference density [kg m-3] + real :: G_Earth !< gravitational acceleration [m s-2] real :: Flux_const !< piston velocity for surface restoring [m s-1] real :: Flux_const_T !< piston velocity for surface temperature restoring [m s-1] real :: Flux_const_S !< piston velocity for surface salinity restoring [m s-1] - real :: latent_heat_fusion !< latent heat of fusion (J/kg) - real :: latent_heat_vapor !< latent heat of vaporization (J/kg) + real :: latent_heat_fusion !< latent heat of fusion [J kg] + real :: latent_heat_vapor !< latent heat of vaporization [J kg] real :: tau_x0 !< Constant zonal wind stress used in the WIND_CONFIG="const" forcing real :: tau_y0 !< Constant meridional wind stress used in the WIND_CONFIG="const" forcing - 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 2-dimensional gustiness supplied from a file - real, pointer :: gust(:,:) => NULL() !< spatially varying unresolved background gustiness (Pa) + real, pointer :: gust(:,:) => NULL() !< spatially varying unresolved background gustiness [Pa] !! gust is used when read_gust_2d is true. - real, pointer :: T_Restore(:,:) => NULL() !< temperature to damp (restore) the SST to (deg C) - real, pointer :: S_Restore(:,:) => NULL() !< salinity to damp (restore) the SSS (g/kg) - real, pointer :: Dens_Restore(:,:) => NULL() !< density to damp (restore) surface density (kg/m^3) + real, pointer :: T_Restore(:,:) => NULL() !< temperature to damp (restore) the SST to [degC] + real, pointer :: S_Restore(:,:) => NULL() !< salinity to damp (restore) the SSS [ppt] + real, pointer :: Dens_Restore(:,:) => NULL() !< density to damp (restore) surface density [kg m-3] integer :: buoy_last_lev_read = -1 !< The last time level read from buoyancy input files ! if WIND_CONFIG=='gyres' then use the following as = A, B, C and n respectively for ! taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L) - real :: gyres_taux_const !< A constant wind stress, in Pa. - real :: gyres_taux_sin_amp !< The amplitude of cosine wind stress gyres, in Pa, if WIND_CONFIG=='gyres'. - real :: gyres_taux_cos_amp !< The amplitude of cosine wind stress gyres, in Pa, if WIND_CONFIG=='gyres'. + real :: gyres_taux_const !< A constant wind stress [Pa]. + real :: gyres_taux_sin_amp !< The amplitude of cosine wind stress gyres [Pa], if WIND_CONFIG=='gyres'. + real :: gyres_taux_cos_amp !< The amplitude of cosine wind stress gyres [Pa], if WIND_CONFIG=='gyres'. real :: gyres_taux_n_pis !< The number of sine lobes in the basin if if WIND_CONFIG=='gyres' @@ -360,8 +360,8 @@ subroutine wind_forcing_const(sfc_state, forces, tau_x0, tau_y0, day, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: tau_x0 !< The zonal wind stress in Pa - real, intent(in) :: tau_y0 !< The meridional wind stress in Pa + real, intent(in) :: tau_x0 !< The zonal wind stress [Pa] + real, intent(in) :: tau_y0 !< The meridional wind stress [Pa] type(time_type), intent(in) :: day !< The time of the fluxes type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -484,7 +484,7 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - ! steady surface wind stresses (Pa) + ! steady surface wind stresses [Pa] PI = 4.0*atan(1.0) do j=js-1,je+1 ; do I=is-1,Ieq @@ -522,7 +522,7 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) ! Local variables character(len=200) :: filename ! The name of the input file. real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal and psuedo-meridional - real :: temp_y(SZI_(G),SZJ_(G)) ! wind stresses at h-points, in Pa. + real :: temp_y(SZI_(G),SZJ_(G)) ! wind stresses at h-points [Pa]. integer :: time_lev_daily ! The time levels to read for fields with integer :: time_lev_monthly ! daily and montly cycles. integer :: time_lev ! The time level that is used for a field. @@ -671,7 +671,7 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS) !! a previous surface_forcing_init call ! Local variables real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal and psuedo-meridional - real :: temp_y(SZI_(G),SZJ_(G)) ! wind stresses at h-points, in Pa. + real :: temp_y(SZI_(G),SZJ_(G)) ! wind stresses at h-points [Pa]. real :: temp_ustar(SZI_(G),SZJ_(G)) ! ustar [m s-1] (not rescaled). integer :: i, j, is_in, ie_in, js_in, je_in logical :: read_uStar @@ -743,15 +743,15 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) real, dimension(SZI_(G),SZJ_(G)) :: & temp, & ! A 2-d temporary work array with various units. SST_anom, & ! Instantaneous sea surface temperature anomalies from a - ! target (observed) value, in deg C. + ! target (observed) value [degC]. SSS_anom, & ! Instantaneous sea surface salinity anomalies from a target - ! (observed) value, in g kg-1. + ! (observed) value [ppt]. SSS_mean ! A (mean?) salinity about which to normalize local salinity ! anomalies when calculating restorative precipitation - ! anomalies, in g kg-1. + ! anomalies [ppt]. - real :: rhoXcp ! reference density times heat capacity (J/(m^3 * K)) - real :: Irho0 ! inverse of the Boussinesq reference density (m^3/kg) + real :: rhoXcp ! reference density times heat capacity [J m-3 degC-1] + real :: Irho0 ! inverse of the Boussinesq reference density [m3 kg-1] integer :: time_lev_daily ! time levels to read for fields with daily cycle integer :: time_lev_monthly ! time levels to read for fields with monthly cycle @@ -1021,14 +1021,14 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, CS real, dimension(SZI_(G),SZJ_(G)) :: & temp, & ! A 2-d temporary work array with various units. SST_anom, & ! Instantaneous sea surface temperature anomalies from a - ! target (observed) value, in deg C. + ! target (observed) value [degC]. SSS_anom, & ! Instantaneous sea surface salinity anomalies from a target - ! (observed) value, in g kg-1. + ! (observed) value [ppt]. SSS_mean ! A (mean?) salinity about which to normalize local salinity ! anomalies when calculating restorative precipitation - ! anomalies, in g kg-1. - real :: rhoXcp ! The mean density times the heat capacity, in J m-3 K-1. - real :: Irho0 ! The inverse of the Boussinesq density, in m3 kg-1. + ! anomalies [ppt]. + real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. + real :: Irho0 ! The inverse of the Boussinesq density [m3 kg-1]. integer :: time_lev_daily ! The time levels to read for fields with integer :: time_lev_monthly ! daily and montly cycles. diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90 index 4472ea9a76..92d07c774a 100644 --- a/config_src/solo_driver/user_surface_forcing.F90 +++ b/config_src/solo_driver/user_surface_forcing.F90 @@ -37,7 +37,7 @@ module user_surface_forcing real :: G_Earth !< The gravitational acceleration [m s-2]. real :: Flux_const !< The restoring rate at the surface [m s-1]. real :: gust_const !< A constant unresolved background gustiness - !! that contributes to ustar, in Pa. + !! that contributes to ustar [Pa]. type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the !! timing of diagnostic output. @@ -125,7 +125,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! Local variables real :: Temp_restore ! The temperature that is being restored toward [degC]. - real :: Salin_restore ! The salinity that is being restored toward, in PSU. + real :: Salin_restore ! The salinity that is being restored toward [ppt] real :: density_restore ! The potential density that is being restored ! toward [kg m-3]. real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 1b380ac334..044aef35a4 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -162,14 +162,14 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. real :: I_gEarth ! The inverse of g_Earth_z [s2 Z m-2 ~> s2 m-1] real :: alpha_anom ! The in-situ specific volume, averaged over a - ! layer, less alpha_ref, in m3 kg-1. + ! layer, less alpha_ref [m3 kg-1]. logical :: use_p_atm ! If true, use the atmospheric pressure. logical :: use_ALE ! If true, use an ALE pressure reconstruction. logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. - real :: alpha_ref ! A reference specific volume, in m3 kg-1, that is used + real :: alpha_ref ! A reference specific volume [m3 kg-1], that is used ! to reduce the impact of truncation errors. real :: rho_in_situ(SZI_(G)) ! The in situ density [kg m-3]. real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 0984185c34..a71f4bab48 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -50,9 +50,11 @@ subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, haloshift, symmet real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: uh !< Volume flux through zonal faces = u*h*dy, m3 s-1. + intent(in) :: uh !< Volume flux through zonal faces = u*h*dy + !! [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: vh !< Volume flux through meridional faces = v*h*dx, in m3 s-1. + intent(in) :: vh !< Volume flux through meridional faces = v*h*dx + !! [H m2 s-1 ~> m3 s-1 or kg s-1]. integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric !! computationoal domain. @@ -185,10 +187,10 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, pbce, !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: u_accel_bt !< The zonal acceleration from terms in the - !! barotropic solver,in m s-2. + !! barotropic solver [m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(in) :: v_accel_bt !< The meridional acceleration from terms in - !! the barotropic solver,in m s-2. + !! the barotropic solver [m s-2]. logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric !! computationoal domain. @@ -223,9 +225,9 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, pointer, dimension(:,:,:), & - intent(in) :: Temp !< Temperature in degree C. + intent(in) :: Temp !< Temperature [degC]. real, pointer, dimension(:,:,:), & - intent(in) :: Salt !< Salinity, in ppt. + intent(in) :: Salt !< Salinity [ppt]. logical, optional, intent(in) :: allowChange !< do not flag an error !! if the statistics change. logical, optional, intent(in) :: permitDiminishing !< do not flag error diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index f2efa147f2..66ec869e0c 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -53,18 +53,18 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, & intent(inout) :: h !< Final layer thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: uh !< Volume flux through zonal faces = - !! u*h*dy, in m3/s. + !! u*h*dy [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: vh !< Volume flux through meridional faces = - !! v*h*dx, in m3/s. + !! v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. real, intent(in) :: dt !< Time increment [s]. type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The vertically summed volume - !! flux through zonal faces, in m3/s. + !! flux through zonal faces [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G)), & optional, intent(in) :: vhbt !< The vertically summed volume - !! flux through meridional faces, in m3/s. + !! flux through meridional faces [H m2 s-1 ~> m3 s-1 or kg s-1]. type(ocean_OBC_type), & optional, pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 03f89f7061..e5e2045c7a 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -49,12 +49,11 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & ! (This argument has been tested but for now serves no purpose.) !! of eta to m; US%Z_to_m by default. ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & - T, & ! The temperature (or density) in C, with the values in + T, & ! The temperature [degC], with the values in ! in massless layers filled vertically by diffusion. - S, & ! The filled salinity, in PSU, with the values in + S, & ! The filled salinity [PSU], with the values in ! in massless layers filled vertically by diffusion. - Rho ! Density itself, when a nonlinear equation of state is - ! not in use. + Rho ! Density itself, when a nonlinear equation of state is not in use [kg m-3]. real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & pres ! The pressure at an interface [Pa]. real, dimension(SZIB_(G)) :: & diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 7ae94450df..3f3da7296c 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -43,9 +43,9 @@ module MOM_sum_output !> A list of depths and corresponding globally integrated ocean area at each !! depth and the ocean volume below each depth. type :: Depth_List - real :: depth !< A depth, in m. - real :: area !< The cross-sectional area of the ocean at that depth, in m2. - real :: vol_below !< The ocean volume below that depth, in m3. + real :: depth !< A depth [m]. + real :: area !< The cross-sectional area of the ocean at that depth [m2]. + real :: vol_below !< The ocean volume below that depth [m3]. end type Depth_List !> The control structure for the MOM_sum_output module @@ -66,17 +66,17 @@ module MOM_sum_output !! entries in the depth-list file, 0 by default. logical :: use_temperature !< If true, temperature and salinity are state variables. real :: fresh_water_input !< The total mass of fresh water added by surface fluxes - !! since the last time that write_energy was called, in kg. + !! since the last time that write_energy was called [kg]. real :: mass_prev !< The total ocean mass the last time that - !! write_energy was called, in kg. + !! write_energy was called [kg]. real :: salt_prev !< The total amount of salt in the ocean the last - !! time that write_energy was called, in PSU kg. + !! time that write_energy was called [ppt kg]. real :: net_salt_input !< The total salt added by surface fluxes since the last - !! time that write_energy was called, in PSU kg. + !! time that write_energy was called [ppt kg]. real :: heat_prev !< The total amount of heat in the ocean the last - !! time that write_energy was called, in Joules. + !! time that write_energy was called [J]. real :: net_heat_input !< The total heat added by surface fluxes since the last - !! the last time that write_energy was called, in Joules. + !! the last time that write_energy was called [J]. type(EFP_type) :: fresh_water_in_EFP !< An extended fixed point version of fresh_water_input type(EFP_type) :: net_salt_in_EFP !< An extended fixed point version of net_salt_input type(EFP_type) :: net_heat_in_EFP !< An extended fixed point version of net_heat_input @@ -136,8 +136,9 @@ subroutine MOM_sum_output_init(G, US, param_file, directory, ntrnc, & type(Sum_output_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module. ! Local variables - real :: Time_unit ! The time unit in seconds for ENERGYSAVEDAYS. - real :: Rho_0, maxvel + real :: Time_unit ! The time unit in seconds for ENERGYSAVEDAYS. + real :: Rho_0 ! A reference density [kg m-3] + real :: maxvel ! The maximum permitted velocity [m s-1] ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_sum_output" ! This module's name. @@ -297,43 +298,43 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ type(time_type), optional, intent(in) :: dt_forcing !< The forcing time step ! Local variables real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! The height of interfaces [Z ~> m]. - real :: areaTm(SZI_(G),SZJ_(G)) ! A masked version of areaT, in m2. - real :: KE(SZK_(G)) ! The total kinetic energy of a layer, in J. - real :: PE(SZK_(G)+1)! The available potential energy of an interface, in J. - real :: KE_tot ! The total kinetic energy, in J. - real :: PE_tot ! The total available potential energy, in J. + real :: areaTm(SZI_(G),SZJ_(G)) ! A masked version of areaT [m2]. + real :: KE(SZK_(G)) ! The total kinetic energy of a layer [J]. + real :: PE(SZK_(G)+1)! The available potential energy of an interface [J]. + real :: KE_tot ! The total kinetic energy [J]. + real :: PE_tot ! The total available potential energy [J]. real :: Z_0APE(SZK_(G)+1) ! The uniform depth which overlies the same ! volume as is below an interface [Z ~> m]. real :: H_0APE(SZK_(G)+1) ! A version of Z_0APE, converted to m, usually positive. real :: toten ! The total kinetic & potential energies of - ! all layers, in Joules (i.e. kg m2 s-2). + ! all layers [J] (i.e. kg m2 s-2). real :: En_mass ! The total kinetic and potential energies divided by ! the total mass of the ocean [m2 s-2]. real :: vol_lay(SZK_(G)) ! The volume of fluid in a layer [Z m2 ~> m3]. real :: volbelow ! The volume of all layers beneath an interface [Z m2 ~> m3]. - real :: mass_lay(SZK_(G)) ! The mass of fluid in a layer, in kg. - real :: mass_tot ! The total mass of the ocean in kg. - real :: vol_tot ! The total ocean volume in m3. + real :: mass_lay(SZK_(G)) ! The mass of fluid in a layer [kg]. + real :: mass_tot ! The total mass of the ocean [kg]. + real :: vol_tot ! The total ocean volume [m3]. real :: mass_chg ! The change in total ocean mass of fresh water since - ! the last call to this subroutine, in kg. + ! the last call to this subroutine [kg]. real :: mass_anom ! The change in fresh water that cannot be accounted for - ! by the surface fluxes, in kg. - real :: Salt ! The total amount of salt in the ocean, in PSU kg. + ! by the surface fluxes [kg]. + real :: Salt ! The total amount of salt in the ocean [ppt kg]. real :: Salt_chg ! The change in total ocean salt since the last call - ! to this subroutine, in PSU kg. + ! to this subroutine [ppt kg]. real :: Salt_anom ! The change in salt that cannot be accounted for by - ! the surface fluxes, in PSU kg. - real :: salin ! The mean salinity of the ocean [PSU]. + ! the surface fluxes [ppt kg]. + real :: salin ! The mean salinity of the ocean [ppt]. real :: salin_chg ! The change in total salt since the last call - ! to this subroutine divided by total mass [PSU]. + ! to this subroutine divided by total mass [ppt]. real :: salin_anom ! The change in total salt that cannot be accounted for by - ! the surface fluxes divided by total mass in PSU. - real :: salin_mass_in ! The mass of salt input since the last call, kg. - real :: Heat ! The total amount of Heat in the ocean, in Joules. + ! the surface fluxes divided by total mass [ppt]. + real :: salin_mass_in ! The mass of salt input since the last call [kg]. + real :: Heat ! The total amount of Heat in the ocean [J]. real :: Heat_chg ! The change in total ocean heat since the last call - ! to this subroutine, in Joules. + ! to this subroutine [J]. real :: Heat_anom ! The change in heat that cannot be accounted for by - ! the surface fluxes, in Joules. + ! the surface fluxes [J]. real :: temp ! The mean potential temperature of the ocean [degC]. real :: temp_chg ! The change in total heat divided by total heat capacity ! of the ocean since the last call to this subroutine, degC. @@ -352,13 +353,13 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ real :: CFL_trans ! A transport-based definition of the CFL number [nondim]. real :: CFL_lin ! A simpler definition of the CFL number [nondim]. real :: max_CFL(2) ! The maxima of the CFL numbers [nondim]. - real :: Irho0 ! The inverse of the reference density, in m3 kg-1. + real :: Irho0 ! The inverse of the reference density [m3 kg-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & tmp1 ! A temporary array real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & - PE_pt ! The potential energy at each point, in J. + PE_pt ! The potential energy at each point [J]. real, dimension(SZI_(G),SZJ_(G)) :: & - Temp_int, Salt_int ! Layer and cell integrated heat and salt, in J and g Salt. + Temp_int, Salt_int ! Layer and cell integrated heat and salt [J] and [g Salt]. real :: H_to_kg_m2 ! Local copy of a unit conversion factor. integer :: num_nc_fields ! The number of fields that will actually go into ! the NetCDF file. @@ -917,23 +918,23 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) !! to MOM_sum_output_init. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - FW_in, & ! The net fresh water input, integrated over a timestep in kg. + FW_in, & ! The net fresh water input, integrated over a timestep [kg]. salt_in, & ! The total salt added by surface fluxes, integrated - ! over a time step in ppt*kg. + ! over a time step [ppt kg]. heat_in ! The total heat added by surface fluxes, integrated - ! over a time step in Joules. + ! over a time step [J]. real :: FW_input ! The net fresh water input, integrated over a timestep - ! and summed over space, in kg. + ! and summed over space [kg]. real :: salt_input ! The total salt added by surface fluxes, integrated - ! over a time step and summed over space, in ppt * kg. + ! over a time step and summed over space [ppt kg]. real :: heat_input ! The total heat added by boundary fluxes, integrated - ! over a time step and summed over space, in Joules. - real :: C_p ! The heat capacity of seawater, in J K-1 kg-1. + ! over a time step and summed over space [J]. + real :: C_p ! The heat capacity of seawater [J degC-1 kg-1]. type(EFP_type) :: & - FW_in_EFP, & ! Extended fixed point versions of FW_input, salt_input, and - salt_in_EFP, & ! heat_input, in kg, ppt*kg, and Joules. - heat_in_EFP + FW_in_EFP, & ! Extended fixed point version of FW_input [kg] + salt_in_EFP, & ! Extended fixed point version of salt_input [ppt kg] + heat_in_EFP ! Extended fixed point version of heat_input [J] real :: inputs(3) ! A mixed array for combining the sums integer :: i, j, is, ie, js, je @@ -1066,13 +1067,13 @@ subroutine create_depth_list(G, CS) ! Local variables real, dimension(G%Domain%niglobal*G%Domain%njglobal + 1) :: & Dlist, & !< The global list of bottom depths [Z ~> m]. - AreaList !< The global list of cell areas, in m2. + AreaList !< The global list of cell areas [m2]. integer, dimension(G%Domain%niglobal*G%Domain%njglobal+1) :: & indx2 !< The position of an element in the original unsorted list. real :: Dnow !< The depth now being considered for sorting [Z ~> m]. real :: Dprev !< The most recent depth that was considered [Z ~> m]. real :: vol !< The running sum of open volume below a deptn [Z m2 ~> m3]. - real :: area !< The open area at the current depth, in m2. + real :: area !< The open area at the current depth [m2]. real :: D_list_prev !< The most recent depth added to the list [Z ~> m]. logical :: add_to_list !< This depth should be included as an entry on the list. diff --git a/src/equation_of_state/MOM_EOS_TEOS10.F90 b/src/equation_of_state/MOM_EOS_TEOS10.F90 index 7c148443a5..fc14d5f892 100644 --- a/src/equation_of_state/MOM_EOS_TEOS10.F90 +++ b/src/equation_of_state/MOM_EOS_TEOS10.F90 @@ -222,9 +222,9 @@ subroutine calculate_specvol_derivs_teos10(T, S, pressure, dSV_dT, dSV_dS, start real, intent(in), dimension(:) :: S !< Absolute salinity [g kg-1]. real, intent(in), dimension(:) :: pressure !< pressure [Pa]. real, intent(out), dimension(:) :: dSV_dT !< The partial derivative of specific volume with - !! conservative temperature, in m3 kg-1 K-1. + !! conservative temperature [m3 kg-1 degC-1]. real, intent(out), dimension(:) :: dSV_dS !< The partial derivative of specific volume with - !! absolute salinity, in m3 kg-1 / (g/kg). + !! absolute salinity [m3 kg-1 (g/kg)-1]. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 0b64f38d75..affbed728c 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -96,8 +96,8 @@ module MOM_ice_shelf real :: Cp_ice !< The heat capacity of fresh ice [J kg-1 degC-1]. real :: gamma_t !< The (fixed) turbulent exchange velocity in the !< 2-equation formulation [m s-1]. - real :: Salin_ice !< The salinity of shelf ice [PSU]. - real :: Temp_ice !< The core temperature of shelf ice, in degC. + real :: Salin_ice !< The salinity of shelf ice [ppt]. + real :: Temp_ice !< The core temperature of shelf ice [degC]. real :: kv_ice !< The viscosity of ice [m2 s-1]. real :: density_ice !< A typical density of ice [kg m-3]. real :: rho_ice !< Nominal ice density in kg m-2 Z-1 @@ -131,10 +131,10 @@ module MOM_ice_shelf !! but any difference will be negligible) logical :: calve_to_mask !< If true, calve any ice that passes outside of a masked area real :: min_thickness_simple_calve !< min. ice shelf thickness criteria for calving [Z ~> m]. - real :: T0 !< temperature at ocean surface in the restoring region, in degC - real :: S0 !< Salinity at ocean surface in the restoring region, in ppt. + real :: T0 !< temperature at ocean surface in the restoring region [degC] + real :: S0 !< Salinity at ocean surface in the restoring region [ppt]. real :: input_flux !< Ice volume flux at an upstream open boundary [m3 s-1]. - real :: input_thickness !< Ice thickness at an upstream open boundary, in m. + real :: input_thickness !< Ice thickness at an upstream open boundary [m]. type(time_type) :: Time !< The component's time. type(EOS_type), pointer :: eqn_of_state => NULL() !< Type that indicates the diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index c61d8acc36..4ffdc6d255 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -3621,7 +3621,7 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f !! the zonal mass fluxes, in m. real, dimension(SZDI_(G),SZDJ_(G),4), & intent(inout) :: flux_enter !< The integrated temperature flux into - !! the cell through the 4 cell boundaries, in degC Z m2 + !! the cell through the 4 cell boundaries [degC Z m2 ~> degC m3] ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells @@ -3853,7 +3853,7 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft !! the meridional mass fluxes [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G),4), & intent(inout) :: flux_enter !< The integrated temperature flux into - !! the cell through the 4 cell boundaries, in degC Z m2 + !! the cell through the 4 cell boundaries [degC Z m2 ~> degC m3] ! use will be made of ISS%hmask here - its value at the boundary will be zero, just like uncovered cells diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index bd514c3a1d..811cc15592 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -102,12 +102,12 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf, halo) ! Local variables real, dimension(SZI_(G)) :: & - fraz_col, & ! The accumulated heat requirement due to frazil, in J. - T_freeze, & ! The freezing potential temperature at the current salinity, C. + fraz_col, & ! The accumulated heat requirement due to frazil [J]. + T_freeze, & ! The freezing potential temperature at the current salinity [degC]. ps ! pressure real, dimension(SZI_(G),SZK_(G)) :: & - pressure ! The pressure at the middle of each layer in Pa. - real :: hc ! A layer's heat capacity in J m-2 K-1. + pressure ! The pressure at the middle of each layer [Pa]. + real :: hc ! A layer's heat capacity [J m-2 degC-1]. logical :: T_fr_set ! True if the freezing point has been calculated for a ! row of points. integer :: i, j, k, is, ie, js, je, nz @@ -659,15 +659,15 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, ! Local variables real, dimension(SZI_(G)) :: deltaRhoAtKm1, deltaRhoAtK ! Density differences [kg m-3]. - real, dimension(SZI_(G)) :: pRef_MLD, pRef_N2 ! Reference pressures in Pa. + real, dimension(SZI_(G)) :: pRef_MLD, pRef_N2 ! Reference pressures [Pa]. real, dimension(SZI_(G)) :: dK, dKm1, d1 ! Depths [Z ~> m]. real, dimension(SZI_(G)) :: rhoSurf, rhoAtK, rho1 ! Densities used for N2 [kg m-3]. real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth [Z ~> m]. real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML [s-2]. real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2 [Z2 ~> m2]. real :: Rho_x_gE ! The product of density, gravitational acceleartion and a unit - ! conversion factor, in kg m-1 Z-1 s-2. - real :: gE_Rho0 ! The gravitational acceleration divided by a mean density, in m4 s-2 kg-1. + ! conversion factor [kg m-1 Z-1 s-2 ~> kg m-2 s-2]. + real :: gE_Rho0 ! The gravitational acceleration divided by a mean density [m4 s-2 kg-1]. real :: dz_subML ! Depth below ML over which to diagnose stratification [Z ~> m]. integer :: i, j, is, ie, js, je, k, nz, id_N2, id_SQ real :: aFac, ddRho @@ -768,7 +768,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: dt !< Time-step over which forcing is applied (s) + real, intent(in) :: dt !< Time-step over which forcing is applied [s] type(forcing), intent(inout) :: fluxes !< Surface fluxes container type(optics_type), pointer :: optics !< Optical properties container real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -779,16 +779,16 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & real, intent(in) :: evap_CFL_limit !< The largest fraction of a layer that !! can be evaporated in one time-step (non-dim). real, intent(in) :: minimum_forcing_depth !< The smallest depth over which - !! heat and freshwater fluxes is applied, in m. + !! heat and freshwater fluxes is applied [m]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: cTKE !< Turbulent kinetic energy requirement to mix - !! forcing through each layer, in W m-2 + !! forcing through each layer [W m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: dSV_dT !< Partial derivative of specific volume with - !! potential temperature, in m3 kg-1 K-1. + !! potential temperature [m3 kg-1 degC-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: dSV_dS !< Partial derivative of specific volume with - !! salinity, in m3 kg-1 / (g kg-1). + !! salinity [m3 kg-1 ppt-1]. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface [Z2 s-3 ~> m2 s-3]. diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 45dcca30c6..fe20811bc9 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -62,7 +62,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) ! Local variables real, dimension(GV%ke) :: & - T0, S0, & ! T0 & S0 are columns of initial temperatures and salinities, in degC and g/kg. + T0, S0, & ! T0 & S0 are columns of initial temperatures and salinities [degC] and g/kg. h_col ! h_col is a column of thicknesses h at tracer points [H ~> m or kg m-2]. real, dimension(GV%ke+1) :: & Kd, & ! A column of diapycnal diffusivities at interfaces [Z2 s-1 ~> m2 s-1]. @@ -125,12 +125,12 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & real, dimension(GV%ke), intent(in) :: h_in !< Layer thickness before entrainment, !! [H ~> m or kg m-2]. real, dimension(GV%ke), intent(in) :: T_in !< The layer temperatures [degC]. - real, dimension(GV%ke), intent(in) :: S_in !< The layer salinities, in g kg-1. + real, dimension(GV%ke), intent(in) :: S_in !< The layer salinities [ppt]. real, dimension(GV%ke+1), intent(in) :: Kd !< The interfaces diapycnal diffusivities !! [Z2 s-1 ~> m2 s-1]. real, intent(in) :: dt !< The amount of time covered by this call [s]. real, intent(out) :: energy_Kd !< The column-integrated rate of energy - !! consumption by diapycnal diffusion, in W m-2. + !! consumption by diapycnal diffusion [W m-2]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. !! Absent fields have NULL ptrs. @@ -148,34 +148,34 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & real, dimension(GV%ke) :: & p_lay, & ! Average pressure of a layer [Pa]. - dSV_dT, & ! Partial derivative of specific volume with temperature, in m3 kg-1 degC-1. - dSV_dS, & ! Partial derivative of specific volume with salinity, in m3 kg-1 / (g kg-1). - T0, S0, & ! Initial temperatures and salinities. - Te, Se, & ! Running incomplete estimates of the new temperatures and salinities. - Te_a, Se_a, & ! Running incomplete estimates of the new temperatures and salinities. - Te_b, Se_b, & ! Running incomplete estimates of the new temperatures and salinities. - Tf, Sf, & ! New final values of the temperatures and salinities. - dTe, dSe, & ! Running (1-way) estimates of temperature and salinity change. - dTe_a, dSe_a, & ! Running (1-way) estimates of temperature and salinity change. - dTe_b, dSe_b, & ! Running (1-way) estimates of temperature and salinity change. - Th_a, & ! An effective temperature times a thickness in the layer above, - ! including implicit mixing effects with other yet higher layers, in degC H. - Sh_a, & ! An effective salinity times a thickness in the layer above, - ! including implicit mixing effects with other yet higher layers, in ppt H. - Th_b, & ! An effective temperature times a thickness in the layer below, - ! including implicit mixing effects with other yet lower layers, in degC H. - Sh_b, & ! An effective salinity times a thickness in the layer below, - ! including implicit mixing effects with other yet lower layers, in ppt H. + dSV_dT, & ! Partial derivative of specific volume with temperature [m3 kg-1 degC-1]. + dSV_dS, & ! Partial derivative of specific volume with salinity [m3 kg-1 ppt-1]. + T0, S0, & ! Initial temperatures and salinities [degC] and [ppt]. + Te, Se, & ! Running incomplete estimates of the new temperatures and salinities [degC] and [ppt]. + Te_a, Se_a, & ! Running incomplete estimates of the new temperatures and salinities [degC] and [ppt]. + Te_b, Se_b, & ! Running incomplete estimates of the new temperatures and salinities [degC] and [ppt]. + Tf, Sf, & ! New final values of the temperatures and salinities [degC] and [ppt]. + dTe, dSe, & ! Running (1-way) estimates of temperature and salinity change [degC] and [ppt]. + dTe_a, dSe_a, & ! Running (1-way) estimates of temperature and salinity change [degC] and [ppt]. + dTe_b, dSe_b, & ! Running (1-way) estimates of temperature and salinity change [degC] and [ppt]. + Th_a, & ! An effective temperature times a thickness in the layer above, including implicit + ! mixing effects with other yet higher layers [degC H ~> degC m or degC kg m-2]. + Sh_a, & ! An effective salinity times a thickness in the layer above, including implicit + ! mixing effects with other yet higher layers [ppt H ~> ppt m or ppt kg m-2]. + Th_b, & ! An effective temperature times a thickness in the layer below, including implicit + ! mixing effects with other yet lower layers [degC H ~> degC m or degC kg m-2]. + Sh_b, & ! An effective salinity times a thickness in the layer below, including implicit + ! mixing effects with other yet lower layers [ppt H ~> ppt m or ppt kg m-2]. dT_to_dPE, & ! Partial derivative of column potential energy with the temperature - dS_to_dPE, & ! and salinity changes within a layer [J m-2 degC-1] and J m-2 / (g kg-1). + dS_to_dPE, & ! and salinity changes within a layer [J m-2 degC-1] and [J m-2 ppt-1]. dT_to_dColHt, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt, & ! and salinity changes within a layer [Z K-1 ~> m K-1] and [Z ppt-1 ~> m ppt-1]. + dS_to_dColHt, & ! and salinity changes within a layer [Z degC-1 ~> m degC-1] and [Z ppt-1 ~> m ppt-1]. dT_to_dColHt_a, & ! Partial derivatives of the total column height with the temperature dS_to_dColHt_a, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers higher in the water colun [Z K-1 ~> m K-1] and [Z ppt-1 ~> m ppt-1]. + ! of mixing with layers higher in the water colun [Z degC-1 ~> m degC-1] and [Z ppt-1 ~> m ppt-1]. dT_to_dColHt_b, & ! Partial derivatives of the total column height with the temperature dS_to_dColHt_b, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers lower in the water colun [Z K-1 ~> m K-1] and [Z ppt-1 ~> m ppt-1]. + ! of mixing with layers lower in the water colun [Z degC-1 ~> m degC-1] and [Z ppt-1 ~> m ppt-1]. dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature dS_to_dPE_a, & ! and salinity changes within a layer, including the implicit effects ! of mixing with layers higher in the water column, in @@ -223,11 +223,11 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: dTe_term ! A diffusivity-independent term related to the temperature - ! change in the layer below the interface, in K H. + ! change in the layer below the interface [degC H ~> degC m or degC kg m-2]. real :: dSe_term ! A diffusivity-independent term related to the salinity - ! change in the layer below the interface, in ppt H. + ! change in the layer below the interface [ppt H ~> ppt m or ppt kg m-2]. real :: Kddt_h_guess ! A guess of the final value of Kddt_h [H ~> m or kg m-2]. - real :: dMass ! The mass per unit area within a layer, in kg m-2. + real :: dMass ! The mass per unit area within a layer [kg m-2]. real :: dPres ! The hydrostatic pressure change across a layer [Pa]. real :: dMKE_max ! The maximum amount of mean kinetic energy that could be ! converted to turbulent kinetic energy if the velocity in @@ -239,8 +239,8 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & real :: ColHt_cor ! The correction to PE_chg that is made due to a net ! change in the column height [J m-2]. real :: htot ! A running sum of thicknesses [H ~> m or kg m-2]. - real :: dTe_t2, dT_km1_t2, dT_k_t2 ! Temporary arrays describing temperature changes. - real :: dSe_t2, dS_km1_t2, dS_k_t2 ! Temporary arrays describing salinity changes. + real :: dTe_t2, dT_km1_t2, dT_k_t2 ! Temporary arrays describing temperature changes [degC]. + real :: dSe_t2, dS_km1_t2, dS_k_t2 ! Temporary arrays describing salinity changes [ppt]. logical :: do_print ! The following are a bunch of diagnostic arrays for debugging purposes. @@ -984,16 +984,16 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & !! Kddt_h for the interface above [H ~> m or kg m-2]. real, intent(in) :: Th_a !< An effective temperature times a thickness in the layer !! above, including implicit mixing effects with other - !! yet higher layers, in K H. + !! yet higher layers [degC H ~> degC m or degC kg m-2]. real, intent(in) :: Sh_a !< An effective salinity times a thickness in the layer !! above, including implicit mixing effects with other - !! yet higher layers, in K H. + !! yet higher layers [ppt H ~> ppt m or ppt kg m-2]. real, intent(in) :: Th_b !< An effective temperature times a thickness in the layer !! below, including implicit mixing effects with other - !! yet lower layers, in K H. + !! yet lower layers [degC H ~> degC m or degC kg m-2]. real, intent(in) :: Sh_b !< An effective salinity times a thickness in the layer !! below, including implicit mixing effects with other - !! yet lower layers, in K H. + !! yet lower layers [ppt H ~> ppt m or ppt kg m-2]. real, intent(in) :: dT_to_dPE_a !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column !! potential energy, including all implicit diffusive changes @@ -1016,7 +1016,7 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real, intent(in) :: dT_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers above [Z K-1 ~> m K-1]. + !! in the temperatures of all the layers above [Z degC-1 ~> m degC-1]. real, intent(in) :: dS_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes @@ -1024,7 +1024,7 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real, intent(in) :: dT_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers below [Z K-1 ~> m K-1]. + !! in the temperatures of all the layers below [Z degC-1 ~> m degC-1]. real, intent(in) :: dS_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes @@ -1044,14 +1044,14 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real :: hps ! The sum of the two effective pivot thicknesses [H ~> m or kg m-2]. real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term [H2 ~> m2 or kg2 m-4]. - real :: dT_c ! The core term in the expressions for the temperature changes [K H2 ~> K m2 or K kg2 m-4]. + real :: dT_c ! The core term in the expressions for the temperature changes [degC H2 ~> degC m2 or degC kg2 m-4]. real :: dS_c ! The core term in the expressions for the salinity changes [psu H2 ~> psu m2 or psu kg2 m-4]. real :: PEc_core ! The diffusivity-independent core term in the expressions - ! for the potential energy changes, J m-3. + ! for the potential energy changes [J m-3]. real :: ColHt_core ! The diffusivity-independent core term in the expressions - ! for the column height changes, J m-3. - real :: ColHt_chg ! The change in the column height, in m. - real :: y1 ! A local temporary term, in units of H-3 or H-4 in various contexts. + ! for the column height changes [J m-3]. + real :: ColHt_chg ! The change in the column height [Z ~> m]. + real :: y1 ! A local temporary term, in [H-3] or [H-4] in various contexts. ! The expression for the change in potential energy used here is derived ! from the expression for the final estimates of the changes in temperature @@ -1126,14 +1126,14 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & !! for the tridiagonal solver, given by h_k plus a term that !! is a fraction (determined from the tridiagonal solver) of !! Kddt_h for the interface above [H ~> m or kg m-2]. - real, intent(in) :: dTe_term !< A diffusivity-independent term related to the - !! temperature change in the layer below the interface, in K H. - real, intent(in) :: dSe_term !< A diffusivity-independent term related to the - !! salinity change in the layer below the interface, in ppt H. + real, intent(in) :: dTe_term !< A diffusivity-independent term related to the temperature change + !! in the layer below the interface [degC H ~> degC m or degC kg m-2]. + real, intent(in) :: dSe_term !< A diffusivity-independent term related to the salinity change + !! in the layer below the interface [ppt H ~> ppt m or ppt kg m-2]. real, intent(in) :: dT_km1_t2 !< A diffusivity-independent term related to the - !! temperature change in the layer above the interface, in K. + !! temperature change in the layer above the interface [degC]. real, intent(in) :: dS_km1_t2 !< A diffusivity-independent term related to the - !! salinity change in the layer above the interface, in ppt. + !! salinity change in the layer above the interface [ppt]. real, intent(in) :: pres_Z !< The hydrostatic interface pressure, which is used to relate !! the changes in column thickness to the energy that is radiated !! as gravity waves and unavailable to drive mixing [J m-2 Z-1 ~> J m-3]. @@ -1156,7 +1156,7 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & real, intent(in) :: dT_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers below [Z K-1 ~> m K-1]. + !! in the temperatures of all the layers below [Z degC-1 ~> m degC-1]. real, intent(in) :: dS_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes @@ -1164,7 +1164,7 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & real, intent(in) :: dT_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers above [Z K-1 ~> m K-1]. + !! in the temperatures of all the layers above [Z degC-1 ~> m degC-1]. real, intent(in) :: dS_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 43294f6538..ec5d7dc5c0 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -153,7 +153,7 @@ module MOM_energetic_PBL ! Additional output parameters also 2d ML_depth, & !< The mixed layer depth [Z ~> m]. (result after iteration step) ML_depth2, & !< The mixed layer depth [Z ~> m]. (guess for iteration step) - Enhance_M, & !< The enhancement to the turbulent velocity scale (non-dim) + Enhance_M, & !< The enhancement to the turbulent velocity scale [nondim] MSTAR_MIX, & !< Mstar used in EPBL MSTAR_LT, & !< Mstar for Langmuir turbulence MLD_EKMAN, & !< MLD over Ekman length @@ -192,18 +192,18 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h_3d !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: u_3d !< Zonal velocities interpolated to h points, - !! m s-1. + intent(in) :: u_3d !< Zonal velocities interpolated to h points + !! [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: v_3d !< Zonal velocities interpolated to h points, - !! m s-1. + intent(in) :: v_3d !< Zonal velocities interpolated to h points + !! [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: dSV_dT !< The partial derivative of in-situ specific - !! volume with potential temperature, - !! in m3 kg-1 K-1. + !! volume with potential temperature + !! [m3 kg-1 K-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: dSV_dS !< The partial derivative of in-situ specific - !! volume with salinity, in m3 kg-1 ppt-1. + !! volume with salinity [m3 kg-1 ppt-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: TKE_forced !< The forcing requirements to homogenize the !! forcing that has been applied to each layer @@ -232,7 +232,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: dT_expected !< The values of temperature change that !! should be expected when the returned - !! diffusivities are applied, in K. + !! diffusivities are applied [degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: dS_expected !< The values of salinity change that !! should be expected when the returned @@ -271,7 +271,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS v ! The meridional velocity [m s-1]. real, dimension(SZI_(G),SZK_(GV)+1) :: & Kd, & ! The diapycnal diffusivity, in m2 s-1. - pres, & ! Interface pressures in Pa. + pres, & ! Interface pressures [Pa]. pres_Z, & ! Interface pressures with a rescaling factor to convert interface height ! movements into changes in column potential energy [J m-2 Z-1 ~> J m-3]. hb_hs ! The distance from the bottom over the thickness of the @@ -332,7 +332,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: b1 ! b1 is inverse of the pivot used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: dMass ! The mass per unit area within a layer, in kg m-2. + real :: dMass ! The mass per unit area within a layer [kg m-2]. real :: dPres ! The hydrostatic pressure change across a layer [Pa]. real :: dMKE_max ! The maximum amount of mean kinetic energy that could be ! converted to turbulent kinetic energy if the velocity in @@ -355,13 +355,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: C1_3 ! = 1/3. real :: vonKar ! The vonKarman constant. - real :: I_dtrho ! 1.0 / (dt * Rho0) in m3 kg-1 s-1. This is + real :: I_dtrho ! 1.0 / (dt * Rho0) in [m3 kg-1 s-1]. This is ! used convert TKE back into ustar^3. real :: U_star ! The surface friction velocity [Z s-1 ~> m s-1]. real :: U_Star_Mean ! The surface friction without gustiness [Z s-1 ~> m s-1]. real :: vstar ! An in-situ turbulent velocity [m s-1]. real :: Enhance_M ! An enhancement factor for vstar, based here on Langmuir impact. - real :: LA ! The Langmuir number (non-dim) + real :: LA ! The Langmuir number [nondim] real :: LAmod ! A modified Langmuir number accounting for other parameters. real :: hbs_here ! The local minimum of hb_hs and MixLen_shape, times a ! conversion factor from H to Z [Z H-1 ~> 1 or m3 kg-1]. @@ -371,20 +371,20 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: tot_TKE ! The total TKE available to support mixing at interface K [J m-2]. real :: TKE_here ! The total TKE at this point in the algorithm [J m-2]. real :: dT_km1_t2 ! A diffusivity-independent term related to the temperature - ! change in the layer above the interface, in K. + ! change in the layer above the interface [degC]. real :: dS_km1_t2 ! A diffusivity-independent term related to the salinity - ! change in the layer above the interface, in ppt. + ! change in the layer above the interface [ppt]. real :: dTe_term ! A diffusivity-independent term related to the temperature - ! change in the layer below the interface, in K H. + ! change in the layer below the interface [degC H ~> degC m or degC kg m-2]. real :: dSe_term ! A diffusivity-independent term related to the salinity - ! change in the layer above the interface, in ppt H. - real :: dTe_t2 ! A part of dTe_term, in K H. - real :: dSe_t2 ! A part of dSe_term, in ppt H. + ! change in the layer above the interface [ppt H ~> ppt m or ppt kg m-2]. + real :: dTe_t2 ! A part of dTe_term [degC H ~> degC m or degC kg m-2]. + real :: dSe_t2 ! A part of dSe_term [ppt H ~> ppt m or ppt kg m-2]. real :: dPE_conv ! The convective change in column potential energy [J m-2]. real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K) [J m-2]. real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K) [J m-2 H-1 ~> J m-3 or J kg-1]. real :: Kd_guess0 ! A first guess of the diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. - real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 + real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 [J m-2] real :: dPEa_dKd_g0 real :: Kddt_h_g0 ! The first guess diapycnal diffusivity times a timestep divided ! by the average thicknesses around a layer [H ~> m or kg m-2]. @@ -397,7 +397,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: TKE_left ! The amount of turbulent kinetic energy left for the most ! recent guess at Kddt_h(K) [J m-2]. real :: dPEc_dKd ! The partial derivative of PE_chg with Kddt_h(K) [J m-2 H-1 ~> J m-3 or J kg-1]. - real :: TKE_left_min, TKE_left_max, Kddt_h_max, Kddt_h_min + real :: TKE_left_min, TKE_left_max ! Maximum and minimum values of TKE_left [J m-2]. + real :: Kddt_h_max, Kddt_h_min ! Maximum and minimum values of Kddt_h(K) [H ~> m or kg m-2]. real :: Kddt_h_guess ! A guess at the value of Kddt_h(K) [H ~> m or kg m-2]. real :: Kddt_h_next ! The next guess at the value of Kddt_h(K) [H ~> m or kg m-2]. real :: dKddt_h ! The change between guesses at Kddt_h(K) [H ~> m or kg m-2]. @@ -414,7 +415,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! The following is only used as a diagnostic. real :: dt__diag ! A copy of dt_diag (if present) or dt [s]. - real :: IdtdR0 ! = 1.0 / (dt__diag * Rho0), in m3 kg-1 s-1. + real :: IdtdR0 ! = 1.0 / (dt__diag * Rho0) [m3 kg-1 s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & Hsfc_used ! The thickness of the surface region [Z ~> m]. logical :: write_diags ! If true, write out diagnostics with this step. @@ -1571,16 +1572,16 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & !! Kddt_h for the interface above [H ~> m or kg m-2]. real, intent(in) :: Th_a !< An effective temperature times a thickness in the layer !! above, including implicit mixing effects with other - !! yet higher layers, in K H. + !! yet higher layers [degC H ~> degC m or degC kg m-2]. real, intent(in) :: Sh_a !< An effective salinity times a thickness in the layer !! above, including implicit mixing effects with other - !! yet higher layers, in K H. + !! yet higher layers [degC H ~> degC m or degC kg m-2]. real, intent(in) :: Th_b !< An effective temperature times a thickness in the layer !! below, including implicit mixing effects with other - !! yet lower layers, in K H. + !! yet lower layers [degC H ~> degC m or degC kg m-2]. real, intent(in) :: Sh_b !< An effective salinity times a thickness in the layer !! below, including implicit mixing effects with other - !! yet lower layers, in K H. + !! yet lower layers [degC H ~> degC m or degC kg m-2]. real, intent(in) :: dT_to_dPE_a !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating !! a layer's temperature change to the change in column !! potential energy, including all implicit diffusive changes @@ -1631,7 +1632,7 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real :: hps ! The sum of the two effective pivot thicknesses [H ~> m or kg m-2]. real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term [H2 ~> m2 or kg2 m-4]. - real :: dT_c ! The core term in the expressions for the temperature changes, in K H2. + real :: dT_c ! The core term in the expressions for the temperature changes [degC H ~> degC m or degC kg m-2]2. real :: dS_c ! The core term in the expressions for the salinity changes, in psu H2. real :: PEc_core ! The diffusivity-independent core term in the expressions ! for the potential energy changes, J m-3. @@ -1712,14 +1713,14 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & !! for the tridiagonal solver, given by h_k plus a term that !! is a fraction (determined from the tridiagonal solver) of !! Kddt_h for the interface above [H ~> m or kg m-2]. - real, intent(in) :: dTe_term !< A diffusivity-independent term related to the - !! temperature change in the layer below the interface, in K H. - real, intent(in) :: dSe_term !< A diffusivity-independent term related to the - !! salinity change in the layer below the interface, in ppt H. + real, intent(in) :: dTe_term !< A diffusivity-independent term related to the temperature change + !! in the layer below the interface [degC H ~> degC m or degC kg m-2]. + real, intent(in) :: dSe_term !< A diffusivity-independent term related to the salinity change + !! in the layer below the interface [ppt H ~> ppt m or ppt kg m-2]. real, intent(in) :: dT_km1_t2 !< A diffusivity-independent term related to the - !! temperature change in the layer above the interface, in K. + !! temperature change in the layer above the interface [degC]. real, intent(in) :: dS_km1_t2 !< A diffusivity-independent term related to the - !! salinity change in the layer above the interface, in ppt. + !! salinity change in the layer above the interface [ppt]. real, intent(in) :: pres_Z !< The rescaled hydrostatic interface pressure, which relates !! the changes in column thickness to the energy that is radiated !! as gravity waves and unavailable to drive mixing [J m-2 Z-1 ~> J m-3]. diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index e31b078922..9a0a46ec67 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -103,7 +103,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, ! interactions between layers [H ~> m or kg m-2]. Fprev, &! The previous estimate of F [H ~> m or kg m-2]. dFdfm, &! The partial derivative of F with respect to changes in F of the - ! neighboring layers. Nondimensional. + ! neighboring layers. [nondim] h_guess ! An estimate of the layer thicknesses after entrainment, but ! before the entrainments are adjusted to drive the layer ! densities toward their target values [H ~> m or kg m-2]. @@ -164,17 +164,18 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, real, dimension(SZI_(G),SZK_(G)) :: & ds_dsp1, & ! The coordinate variable (sigma-2) difference across an ! interface divided by the difference across the interface - ! below it. Nondimensional. + ! below it. [nondim] dsp1_ds, & ! The inverse coordinate variable (sigma-2) difference ! across an interface times the difference across the - ! interface above it. Nondimensional. - I2p2dsp1_ds, & ! 1 / (2 + 2 * ds_k+1 / ds_k). Nondimensional. + ! interface above it. [nondim] + I2p2dsp1_ds, & ! 1 / (2 + 2 * ds_k+1 / ds_k). [nondim] grats ! 2*(2 + ds_k+1 / ds_k + ds_k / ds_k+1) = - ! 4*ds_Lay*(1/ds_k + 1/ds_k+1). Nondim. + ! 4*ds_Lay*(1/ds_k + 1/ds_k+1). [nondim] real :: dRHo ! The change in locally referenced potential density between ! the layers above and below an interface [kg m-3]. - real :: g_2dt ! 0.5 * G_Earth / dt, times unit conversion factors, in m3 H-2 s-3. + real :: g_2dt ! 0.5 * G_Earth / dt, times unit conversion factors + ! [m3 H-2 s-3 ~> m s-3 or m7 kg-2 s-3]. real, dimension(SZI_(G)) :: & pressure, & ! The pressure at an interface [Pa]. T_eos, S_eos, & ! The potential temperature and salinity at which to @@ -1262,9 +1263,9 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & real :: rat real :: dS_kbp1, IdS_kbp1 real :: deriv_dSLay - real :: Inv_term ! Nondimensional. - real :: f1, df1_drat ! Nondimensional temporary variables. - real :: z, dz_drat, f2, df2_dz, expz ! Nondimensional temporary variables. + real :: Inv_term ! [nondim] + real :: f1, df1_drat ! Temporary variables [nondim]. + real :: z, dz_drat, f2, df2_dz, expz ! Temporary variables [nondim]. real :: eps_dSLay, eps_dSkb ! Small nondimensional constants. integer :: i, k diff --git a/src/parameterizations/vertical/MOM_full_convection.F90 b/src/parameterizations/vertical/MOM_full_convection.F90 index 866dd16114..a47e113fc4 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -26,9 +26,9 @@ subroutine full_convection(G, GV, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, & type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(out) :: T_adj !< Adjusted potential temperature in degC. + intent(out) :: T_adj !< Adjusted potential temperature [degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(out) :: S_adj !< Adjusted salinity in ppt. + intent(out) :: S_adj !< Adjusted salinity [ppt]. real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface in Pa (or NULL). real, intent(in) :: Kddt_smooth !< A smoothing vertical !! diffusivity times a timestep [H2 ~> m2 or kg2 m-4]. @@ -45,20 +45,20 @@ subroutine full_convection(G, GV, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, & ! logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. real, dimension(SZI_(G),SZK0_(G)) :: & Te_a, & ! A partially updated temperature estimate including the influnce from - ! mixing with layers above rescaled by a factor of d_a, in degC. + ! mixing with layers above rescaled by a factor of d_a [degC]. ! This array is discreted on tracer cells, but contains an extra ! layer at the top for algorithmic convenience. Se_a ! A partially updated salinity estimate including the influnce from - ! mixing with layers above rescaled by a factor of d_a, in ppt. + ! mixing with layers above rescaled by a factor of d_a [ppt]. ! This array is discreted on tracer cells, but contains an extra ! layer at the top for algorithmic convenience. real, dimension(SZI_(G),SZK_(G)+1) :: & Te_b, & ! A partially updated temperature estimate including the influnce from - ! mixing with layers below rescaled by a factor of d_b, in degC. + ! mixing with layers below rescaled by a factor of d_b [degC]. ! This array is discreted on tracer cells, but contains an extra ! layer at the bottom for algorithmic convenience. Se_b ! A partially updated salinity estimate including the influnce from - ! mixing with layers below rescaled by a factor of d_b, in ppt. + ! mixing with layers below rescaled by a factor of d_b [ppt]. ! This array is discreted on tracer cells, but contains an extra ! layer at the bottom for algorithmic convenience. real, dimension(SZI_(G),SZK_(G)+1) :: & @@ -287,14 +287,14 @@ function is_unstable(dRho_dT, dRho_dS, h_a, h_b, mix_A, mix_B, T_a, T_b, S_a, S_ real, intent(in) :: h_b !< The thickness of the layer below [H ~> m or kg m-2] real, intent(in) :: mix_A !< The time integrated mixing rate of the interface above [H ~> m or kg m-2] real, intent(in) :: mix_B !< The time integrated mixing rate of the interface below [H ~> m or kg m-2] - real, intent(in) :: T_a !< The initial temperature of the layer above, in degC - real, intent(in) :: T_b !< The initial temperature of the layer below, in degC - real, intent(in) :: S_a !< The initial salinity of the layer below, in ppt - real, intent(in) :: S_b !< The initial salinity of the layer below, in ppt - real, intent(in) :: Te_aa !< The estimated temperature two layers above rescaled by d_A, in degC - real, intent(in) :: Te_bb !< The estimated temperature two layers below rescaled by d_B, in degC - real, intent(in) :: Se_aa !< The estimated salinity two layers above rescaled by d_A, in ppt - real, intent(in) :: Se_bb !< The estimated salinity two layers below rescaled by d_B, in ppt + real, intent(in) :: T_a !< The initial temperature of the layer above [degC] + real, intent(in) :: T_b !< The initial temperature of the layer below [degC] + real, intent(in) :: S_a !< The initial salinity of the layer below [ppt] + real, intent(in) :: S_b !< The initial salinity of the layer below [ppt] + real, intent(in) :: Te_aa !< The estimated temperature two layers above rescaled by d_A [degC] + real, intent(in) :: Te_bb !< The estimated temperature two layers below rescaled by d_B [degC] + real, intent(in) :: Se_aa !< The estimated salinity two layers above rescaled by d_A [ppt] + real, intent(in) :: Se_bb !< The estimated salinity two layers below rescaled by d_B [ppt] real, intent(in) :: d_A !< The rescaling dependency across the interface above, nondim. real, intent(in) :: d_B !< The rescaling dependency across the interface below, nondim. logical :: is_unstable !< The return value, true if the profile is statically unstable @@ -332,7 +332,7 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, j, p_surf, halo) intent(out) :: dR_dS !< Derivative of locally referenced !! potential density with salinity [kg m-3 ppt-1] integer, intent(in) :: j !< The j-point to work on. - real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface in Pa (or NULL). + real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [Pa]. integer, optional, intent(in) :: halo !< Halo width over which to compute ! Local variables @@ -340,11 +340,11 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, j, p_surf, halo) ! between layers within in a timestep [H ~> m or kg m-2]. real :: b1(SZI_(G)), d1(SZI_(G)) ! b1, c1, and d1 are variables used by the real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. - real :: T_f(SZI_(G),SZK_(G)) ! Filtered temperatures in degC - real :: S_f(SZI_(G),SZK_(G)) ! Filtered salinities in ppt - real :: pres(SZI_(G)) ! Interface pressures, in Pa. - real :: T_EOS(SZI_(G)) ! Filtered and vertically averaged temperatures in degC - real :: S_EOS(SZI_(G)) ! Filtered and vertically averaged salinities in ppt + real :: T_f(SZI_(G),SZK_(G)) ! Filtered temperatures [degC] + real :: S_f(SZI_(G),SZK_(G)) ! Filtered salinities [ppt] + real :: pres(SZI_(G)) ! Interface pressures [Pa]. + real :: T_EOS(SZI_(G)) ! Filtered and vertically averaged temperatures [degC] + real :: S_EOS(SZI_(G)) ! Filtered and vertically averaged salinities [ppt] real :: kap_dt_x2 ! The product of 2*kappa*dt [H2 ~> m2 or kg2 m-4]. real :: h_neglect, h0 ! Negligible thicknesses to allow for zero thicknesses, ! [H ~> m or kg m-2]. diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index daf6ae043c..773a7a4835 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -36,11 +36,11 @@ module MOM_int_tide_input logical :: debug !< If true, write verbose checksums for debugging. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. - real :: TKE_itide_max !< Maximum Internal tide conversion (W m-2) - !! available to mix above the BBL + real :: TKE_itide_max !< Maximum Internal tide conversion + !! available to mix above the BBL [W m-2] real, allocatable, dimension(:,:) :: TKE_itidal_coef - !< The time-invariant field that enters the TKE_itidal input calculation, in J m-2. + !< The time-invariant field that enters the TKE_itidal input calculation [J m-2]. character(len=200) :: inputdir !< The directory for input files. !>@{ Diagnostic IDs @@ -133,9 +133,9 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to the !! thermodynamic fields real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_f !< Temperature after vertical filtering to - !! smooth out the values in thin layers, in degC. + !! smooth out the values in thin layers [degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_f !< Salinity after vertical filtering to - !! smooth out the values in thin layers, in PSU. + !! smooth out the values in thin layers [ppt]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h2 !< Bottom topographic roughness [Z2 ~> m2]. type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes type(int_tide_input_CS), pointer :: CS !< This module's control structure. @@ -145,9 +145,9 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) real, dimension(SZI_(G),SZK_(G)+1) :: & dRho_int ! The unfiltered density differences across interfaces. real, dimension(SZI_(G)) :: & - pres, & ! The pressure at each interface, in Pa. - Temp_int, & ! The temperature at each interface, in degC. - Salin_int, & ! The salinity at each interface, in PSU. + pres, & ! The pressure at each interface [Pa]. + Temp_int, & ! The temperature at each interface [degC]. + Salin_int, & ! The salinity at each interface [ppt]. drho_bot, & h_amp, & ! The amplitude of topographic roughness [Z ~> m]. hb, & ! The depth below a layer [Z ~> m]. diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index c717689140..1646a6650b 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -71,8 +71,8 @@ module MOM_set_diffusivity logical :: use_LOTW_BBL_diffusivity !< If true, use simpler/less precise, BBL diffusivity. logical :: LOTW_BBL_use_omega !< If true, use simpler/less precise, BBL diffusivity. real :: BBL_effic !< efficiency with which the energy extracted - !! by bottom drag drives BBL diffusion (nondim) - real :: cdrag !< quadratic drag coefficient (nondim) + !! by bottom drag drives BBL diffusion [nondim] + real :: cdrag !< quadratic drag coefficient [nondim] real :: IMax_decay !< inverse of a maximum decay scale for !! bottom-drag driven turbulence [Z-1 ~> m-1]. real :: Kv !< The interior vertical viscosity [Z2 s-1 ~> m2 s-1]. @@ -84,8 +84,7 @@ module MOM_set_diffusivity !! filtering or scaling [Z2 s-1 ~> m2 s-1]. real :: Kdml !< mixed layer diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. !! when bulkmixedlayer==.false. - real :: Hmix !< mixed layer thickness (meter) when - !! bulkmixedlayer==.false. + real :: Hmix !< mixed layer thickness [meter] when BULKMIXEDLAYER==.false. type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostic output timing logical :: limit_dissipation !< If enabled, dissipation is limited to be larger @@ -96,7 +95,7 @@ module MOM_set_diffusivity real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 [Z2 m-2 W m-3 s2 ~> J s m-3] real :: dissip_Kd_min !< Minimum Kd [Z2 s-1 ~> m2 s-1], with dissipation Rho0*Kd_min*N^2 - real :: TKE_itide_max !< maximum internal tide conversion (W m-2) + real :: TKE_itide_max !< maximum internal tide conversion [W m-2] !! available to mix above the BBL real :: omega !< Earth's rotation frequency [s-1] logical :: ML_radiation !< allow a fraction of TKE available from wind work @@ -110,23 +109,23 @@ module MOM_set_diffusivity !! of exp(-h_ML*Idecay_len_TkE), where Idecay_len_TKE is !! calculated the same way as in the mixed layer code. !! The diapycnal diffusivity is KD(k) = E/(N2(k)+OMEGA2), - !! where N2 is the squared buoyancy frequency (s-2) and OMEGA2 + !! where N2 is the squared buoyancy frequency [s-2] and OMEGA2 !! is the rotation rate of the earth squared. real :: ML_rad_kd_max !< Maximum diapycnal diffusivity due to turbulence !! radiated from the base of the mixed layer [Z2 s-1 ~> m2 s-1]. real :: ML_rad_efold_coeff !< non-dim coefficient to scale penetration depth real :: ML_rad_coeff !< coefficient, which scales MSTAR*USTAR^3 to !! obtain energy available for mixing below - !! mixed layer base (nondimensional) + !! mixed layer base [nondim] logical :: ML_rad_TKE_decay !< If true, apply same exponential decay !! to ML_rad as applied to the other surface !! sources of TKE in the mixed layer code. real :: ustar_min !< A minimum value of ustar to avoid numerical !! problems [Z s-1 ~> m s-1]. If the value is small enough, !! this parameter should not affect the solution. - real :: TKE_decay !< ratio of natural Ekman depth to TKE decay scale (nondim) + real :: TKE_decay !< ratio of natural Ekman depth to TKE decay scale [nondim] real :: mstar !< ratio of friction velocity cubed to - !! TKE input to the mixed layer (nondim) + !! TKE input to the mixed layer [nondim] logical :: ML_use_omega !< If true, use absolute rotation rate instead !! of the vertical component of rotation when !! setting the decay scale for mixed layer turbulence. @@ -145,8 +144,8 @@ module MOM_set_diffusivity logical :: simple_TKE_to_Kd !< If true, uses a simple estimate of Kd/TKE that !! does not rely on a layer-formulation. real :: Max_Rrho_salt_fingers !< max density ratio for salt fingering - real :: Max_salt_diff_salt_fingers !< max salt diffusivity for salt fingers (m2/s) - real :: Kv_molecular !< molecular visc for double diff convect (m2/s) + real :: Max_salt_diff_salt_fingers !< max salt diffusivity for salt fingers [Z2 s-1 ~> m2 s-1] + real :: Kv_molecular !< molecular visc for double diff convect [Z2 s-1 ~> m2 s-1] character(len=200) :: inputdir !< The directory in which input files are found type(user_change_diff_CS), pointer :: user_change_diff_CSp => NULL() !< Control structure for a child module @@ -171,11 +170,11 @@ module MOM_set_diffusivity !> This structure has memory for used in calculating diagnostics of diffusivity type diffusivity_diags real, pointer, dimension(:,:,:) :: & - N2_3d => NULL(), & !< squared buoyancy frequency at interfaces (1/s2) - Kd_user => NULL(), & !< user-added diffusivity at interfaces (m2/s) - Kd_BBL => NULL(), & !< BBL diffusivity at interfaces (m2/s) - Kd_work => NULL(), & !< layer integrated work by diapycnal mixing (W/m2) - maxTKE => NULL(), & !< energy required to entrain to h_max (m3/s3) + N2_3d => NULL(), & !< squared buoyancy frequency at interfaces [s-2] + Kd_user => NULL(), & !< user-added diffusivity at interfaces [Z2 s-1 ~> m2 s-1] + Kd_BBL => NULL(), & !< BBL diffusivity at interfaces [Z2 s-1 ~> m2 s-1] + Kd_work => NULL(), & !< layer integrated work by diapycnal mixing [W m-2] + maxTKE => NULL(), & !< energy required to entrain to h_max [m3 s-3] KT_extra => NULL(), & !< double diffusion diffusivity for temp [Z2 s-1 ~> m2 s-1]. KS_extra => NULL() !< double diffusion diffusivity for saln [Z2 s-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: TKE_to_Kd => NULL() @@ -223,42 +222,42 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & !! properties of the ocean. type(vertvisc_type), intent(inout) :: visc !< Structure containing vertical viscosities, bottom !! boundary layer properies, and related fields. - real, intent(in) :: dt !< Time increment (sec). + real, intent(in) :: dt !< Time increment [s]. type(set_diffusivity_CS), pointer :: CS !< Module control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(out) :: Kd_lay !< Diapycnal diffusivity of each layer (m2/sec). + intent(out) :: Kd_lay !< Diapycnal diffusivity of each layer [Z2 s-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - optional, intent(out) :: Kd_int !< Diapycnal diffusivity at each interface (m2/sec). + optional, intent(out) :: Kd_int !< Diapycnal diffusivity at each interface [Z2 s-1 ~> m2 s-1]. ! local variables real, dimension(SZI_(G)) :: & - N2_bot ! bottom squared buoyancy frequency (1/s2) + N2_bot ! bottom squared buoyancy frequency [s-2] type(diffusivity_diags) :: dd ! structure w/ arrays of pointers to avail diags real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - T_f, S_f ! Temperature and salinity (in deg C and ppt) with + T_f, S_f ! Temperature and salinity [degC] and [ppt] with ! massless layers filled vertically by diffusion. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - T_adj, S_adj ! Temperature and salinity (in deg C and ppt) + T_adj, S_adj ! Temperature and salinity [degC] and [ppt] ! after full convective adjustment. real, dimension(SZI_(G),SZK_(G)) :: & - N2_lay, & !< squared buoyancy frequency associated with layers (1/s2) - maxTKE, & !< energy required to entrain to h_max (m3/s3) + N2_lay, & !< squared buoyancy frequency associated with layers [s-2] + maxTKE, & !< energy required to entrain to h_max [m3 s-3] TKE_to_Kd !< conversion rate (~1.0 / (G_Earth + dRho_lay)) between !< TKE dissipated within a layer and Kd in that layer, in - !< m2 s-1 / m3 s-3 = s2 m-1. + !< m2 s-1 / m3 s-3 = [s2 m-1]. real, dimension(SZI_(G),SZK_(G)+1) :: & - N2_int, & !< squared buoyancy frequency associated at interfaces (1/s2) - dRho_int, & !< locally ref potential density difference across interfaces (kg/m3) - KT_extra, & !< double difusion diffusivity of temperature (Z2/sec) - KS_extra !< double difusion diffusivity of salinity (Z2/sec) + N2_int, & !< squared buoyancy frequency associated at interfaces [s-2] + dRho_int, & !< locally ref potential density difference across interfaces [kg m-3] + KT_extra, & !< double difusion diffusivity of temperature [Z2 s-1 ~> m2 s-1] + KS_extra !< double difusion diffusivity of salinity [Z2 s-1 ~> m2 s-1] - real :: I_Rho0 ! inverse of Boussinesq density (m3/kg) - real :: dissip ! local variable for dissipation calculations (Z2 W/m5) - real :: Omega2 ! squared absolute rotation rate (1/s2) + real :: I_Rho0 ! inverse of Boussinesq density [m3 kg-1] + real :: dissip ! local variable for dissipation calculations [Z2 W m-5 ~> W m-3] + real :: Omega2 ! squared absolute rotation rate [s-2] logical :: use_EOS ! If true, compute density from T/S using equation of state. type(p3d) :: z_ptrs(6) ! pointers to diagns to be interpolated into depth space @@ -681,18 +680,18 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & !! usually (~Rho_0 / (G_Earth * dRho_lay)) !! [Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1] real, dimension(SZI_(G),SZK_(G)), intent(out) :: maxTKE !< The energy required to for a layer to entrain - !! to its maximum realizable thickness, in m3 s-3 + !! to its maximum realizable thickness [m3 s-3] integer, dimension(SZI_(G)), intent(out) :: kb !< Index of lightest layer denser than the buffer !! layer, or -1 without a bulk mixed layer. ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & ds_dsp1, & ! coordinate variable (sigma-2) difference across an ! interface divided by the difference across the interface - ! below it (nondimensional) + ! below it [nondim] dsp1_ds, & ! inverse coordinate variable (sigma-2) difference ! across an interface times the difference across the - ! interface above it (nondimensional) - rho_0, & ! Layer potential densities relative to surface pressure (kg/m3) + ! interface above it [nondim] + rho_0, & ! Layer potential densities relative to surface pressure [kg m-3] maxEnt ! maxEnt is the maximum value of entrainment from below (with ! compensating entrainment from above to keep the layer ! density from changing) that will not deplete all of the @@ -709,13 +708,13 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & real :: dh_max ! maximum amount of entrainment a layer could ! undergo before entraining all fluid in the layers ! above or below [Z ~> m]. - real :: dRho_lay ! density change across a layer (kg/m3) - real :: Omega2 ! rotation rate squared (1/s2) - real :: G_Rho0 ! gravitation accel divided by Bouss ref density (m4 s-2 kg-1) - real :: I_Rho0 ! inverse of Boussinesq reference density (m3/kg) - real :: I_dt ! 1/dt (1/sec) - real :: H_neglect ! negligibly small thickness (units as h) - real :: hN2pO2 ! h * (N^2 + Omega^2), in m3 s-2 Z-2. + real :: dRho_lay ! density change across a layer [kg m-3] + real :: Omega2 ! rotation rate squared [s-2] + real :: G_Rho0 ! gravitation accel divided by Bouss ref density [m4 s-2 kg-1] + real :: I_Rho0 ! inverse of Boussinesq reference density [m3 kg-1] + real :: I_dt ! 1/dt [s-1] + real :: H_neglect ! negligibly small thickness [H ~> m or kg m-2] + real :: hN2pO2 ! h (N^2 + Omega^2), in [m3 s-2 Z-2 ~> m s-2]. logical :: do_i(SZI_(G)) integer :: i, k, is, ie, nz, i_rem, kmb, kb_min @@ -896,9 +895,9 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & dRho_dS ! partial derivative of density wrt saln [kg m-3 ppt-1] real, dimension(SZI_(G)) :: & - pres, & ! pressure at each interface (Pa) - Temp_int, & ! temperature at each interface (degC) - Salin_int, & ! salinity at each interface (PPT) + pres, & ! pressure at each interface [Pa] + Temp_int, & ! temperature at each interface [degC] + Salin_int, & ! salinity at each interface [ppt] drho_bot, & h_amp, & ! The topographic roughness amplitude [Z ~> m]. hb, & ! The thickness of the bottom layer [Z ~> m]. @@ -1065,19 +1064,19 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) real, dimension(SZI_(G)) :: & dRho_dT, & ! partial derivatives of density wrt temp [kg m-3 degC-1] dRho_dS, & ! partial derivatives of density wrt saln [kg m-3 ppt-1] - pres, & ! pressure at each interface (Pa) - Temp_int, & ! temp and saln at interfaces - Salin_int + pres, & ! pressure at each interface [Pa] + Temp_int, & ! temperature at interfaces [degC] + Salin_int ! Salinity at interfaces [ppt] - real :: alpha_dT ! density difference between layers due to temp diffs (kg/m3) - real :: beta_dS ! density difference between layers due to saln diffs (kg/m3) + real :: alpha_dT ! density difference between layers due to temp diffs [kg m-3] + real :: beta_dS ! density difference between layers due to saln diffs [kg m-3] - real :: Rrho ! vertical density ratio - real :: diff_dd ! factor for double-diffusion (nondim) + real :: Rrho ! vertical density ratio [nondim] + real :: diff_dd ! factor for double-diffusion [nondim] real :: Kd_dd ! The dominant double diffusive diffusivity [Z2 s-1 ~> m2 s-1] real :: prandtl ! flux ratio for diffusive convection regime - real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio + real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio [nondim] real :: dsfmax ! max diffusivity in case of salt fingering [Z2 s-1 ~> m2 s-1] real :: Kv_molecular ! molecular viscosity [Z2 s-1 ~> m2 s-1] @@ -1085,8 +1084,8 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) is = G%isc ; ie = G%iec ; nz = G%ke if (associated(tv%eqn_of_state)) then - dsfmax = US%m_to_Z**2 * 1.e-4 ! max salt fingering diffusivity rescaled to (Z2/sec) - Kv_molecular = US%m_to_Z**2 * 1.5e-6 ! molecular viscosity rescaled to (Z2/sec) + dsfmax = US%m_to_Z**2 * 1.e-4 ! max salt fingering diffusivity rescaled to [Z2 s-1 ~> m2 s-1] + Kv_molecular = US%m_to_Z**2 * 1.5e-6 ! molecular viscosity rescaled to [Z2 s-1 ~> m2 s-1] do i=is,ie pres(i) = 0.0 ; Kd_T_dd(i,1) = 0.0 ; Kd_S_dd(i,1) = 0.0 @@ -1151,7 +1150,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & !! usually (~Rho_0 / (G_Earth * dRho_lay)) !! [Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1] real, dimension(SZI_(G),SZK_(G)), intent(in) :: maxTKE !< The energy required to for a layer to entrain - !! to its maximum realizable thickness, in m3 s-3 + !! to its maximum realizable thickness [m3 s-3] integer, dimension(SZI_(G)), intent(in) :: kb !< Index of lightest layer denser than the buffer !! layer, or -1 without a bulk mixed layer type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure @@ -1166,27 +1165,27 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ! This routine adds diffusion sustained by flow energy extracted by bottom drag. real, dimension(SZK_(G)+1) :: & - Rint ! coordinate density of an interface (kg/m3) + Rint ! coordinate density of an interface [kg m-3] real, dimension(SZI_(G)) :: & htot, & ! total thickness above or below a layer, or the ! integrated thickness in the BBL [Z ~> m]. - rho_htot, & ! running integral with depth of density (Z kg/m3) + rho_htot, & ! running integral with depth of density [Z kg m-3 ~> kg m-2] gh_sum_top, & ! BBL value of g'h that can be supported by - ! the local ustar, times R0_g (kg/m2) - Rho_top, & ! density at top of the BBL (kg/m3) + ! the local ustar, times R0_g [kg m-2] + Rho_top, & ! density at top of the BBL [kg m-3] TKE, & ! turbulent kinetic energy available to drive - ! bottom-boundary layer mixing in a layer (m3/s3) + ! bottom-boundary layer mixing in a layer [m3 s-3] I2decay ! inverse of twice the TKE decay scale [Z-1 ~> m-1]. - real :: TKE_to_layer ! TKE used to drive mixing in a layer (m3/s3) - real :: TKE_Ray ! TKE from layer Rayleigh drag used to drive mixing in layer (m3/s3) - real :: TKE_here ! TKE that goes into mixing in this layer (m3/s3) - real :: dRl, dRbot ! temporaries holding density differences (kg/m3) - real :: cdrag_sqrt ! square root of the drag coefficient (nondimensional) + real :: TKE_to_layer ! TKE used to drive mixing in a layer [m3 s-3] + real :: TKE_Ray ! TKE from layer Rayleigh drag used to drive mixing in layer [m3 s-3] + real :: TKE_here ! TKE that goes into mixing in this layer [m3 s-3] + real :: dRl, dRbot ! temporaries holding density differences [kg m-3] + real :: cdrag_sqrt ! square root of the drag coefficient [nondim] real :: ustar_h ! value of ustar at a thickness point [Z s-1 ~> m s-1]. real :: absf ! average absolute Coriolis parameter around a thickness point [s-1] - real :: R0_g ! Rho0 / G_Earth (kg s2 Z-1 m-4) - real :: I_rho0 ! 1 / RHO0 + real :: R0_g ! Rho0 / G_Earth [kg s2 Z-1 m-4 ~> kg s2 m-5] + real :: I_rho0 ! 1 / RHO0 [m3 kg-1] real :: delta_Kd ! increment to Kd from the bottom boundary layer mixing [Z2 s-1 ~> m2 s-1]. logical :: Rayleigh_drag ! Set to true if Rayleigh drag velocities ! defined in visc, on the assumption that this @@ -1383,24 +1382,24 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & !! boundary layer properies, and related fields. integer, intent(in) :: j !< j-index of row to work on real, dimension(SZI_(G),SZK_(G)+1), & - intent(in) :: N2_int !< Square of Brunt-Vaisala at interfaces (s-2) + intent(in) :: N2_int !< Square of Brunt-Vaisala at interfaces [s-2] type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: Kd_lay !< Layer net diffusivity (m2 s-1) + intent(inout) :: Kd_lay !< Layer net diffusivity [Z2 s-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), & - intent(inout) :: Kd_int !< Interface net diffusivity (m2 s-1) - real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity (m2 s-1) + intent(inout) :: Kd_int !< Interface net diffusivity [Z2 s-1 ~> m2 s-1] + real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity [Z2 s-1 ~> m2 s-1] ! Local variables - real :: TKE_column ! net TKE input into the column (m3 s-3) - real :: TKE_to_layer ! TKE used to drive mixing in a layer (m3 s-3) - real :: TKE_Ray ! TKE from a layer Rayleigh drag used to drive mixing in that layer (m3 s-3) - real :: TKE_remaining ! remaining TKE available for mixing in this layer and above (m3 s-3) - real :: TKE_consumed ! TKE used for mixing in this layer (m3 s-3) - real :: TKE_Kd_wall ! TKE associated with unlimited law of the wall mixing (m3 s-3) - real :: cdrag_sqrt ! square root of the drag coefficient (nondimensional) + real :: TKE_column ! net TKE input into the column [m3 s-3] + real :: TKE_to_layer ! TKE used to drive mixing in a layer [m3 s-3] + real :: TKE_Ray ! TKE from a layer Rayleigh drag used to drive mixing in that layer [m3 s-3] + real :: TKE_remaining ! remaining TKE available for mixing in this layer and above [m3 s-3] + real :: TKE_consumed ! TKE used for mixing in this layer [m3 s-3] + real :: TKE_Kd_wall ! TKE associated with unlimited law of the wall mixing [m3 s-3] + real :: cdrag_sqrt ! square root of the drag coefficient [nondim] real :: ustar ! value of ustar at a thickness point [Z s-1 ~> m s-1]. - real :: ustar2 ! square of ustar, for convenience (Z2/s2) + real :: ustar2 ! square of ustar, for convenience [Z2 s-2 ~> m2 s-2] real :: absf ! average absolute value of Coriolis parameter around a thickness point (1/sec) real :: dh, dhm1 ! thickness of layers k and k-1, respecitvely [Z ~> m]. real :: z_bot ! distance to interface k from bottom [Z ~> m]. @@ -1408,10 +1407,10 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & real :: total_thickness ! total thickness of water column [Z ~> m]. real :: Idecay ! inverse of decay scale used for "Joule heating" loss of TKE with height [Z-1 ~> m-1]. real :: Kd_wall ! Law of the wall diffusivity [Z2 s-1 ~> m2 s-1]. - real :: Kd_lower ! diffusivity for lower interface (Z2/sec) + real :: Kd_lower ! diffusivity for lower interface [Z2 s-1 ~> m2 s-1] real :: ustar_D ! u* x D [Z2 s-1 ~> m2 s-1]. real :: I_Rho0 ! 1 / rho0 - real :: N2_min ! Minimum value of N2 to use in calculation of TKE_Kd_wall (1/s2) + real :: N2_min ! Minimum value of N2 to use in calculation of TKE_Kd_wall [s-2] logical :: Rayleigh_drag ! Set to true if there are Rayleigh drag velocities defined in visc, on ! the assumption that this extracted energy also drives diapycnal mixing. integer :: i, k, km1 @@ -1449,11 +1448,11 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & Idecay = CS%IMax_decay if ((ustar > 0.0) .and. (absf > CS%IMax_decay*ustar)) Idecay = absf / ustar - ! Energy input at the bottom, in m3 s-3. + ! Energy input at the bottom [m3 s-3]. ! (Note that visc%TKE_BBL is in m3 s-3, set in set_BBL_TKE().) ! I am still unsure about sqrt(cdrag) in this expressions - AJA TKE_column = cdrag_sqrt * visc%TKE_BBL(i,j) - ! Add in tidal dissipation energy at the bottom, in m3 s-3. + ! Add in tidal dissipation energy at the bottom [m3 s-3]. ! Note that TKE_tidal is in W m-2. if (associated(fluxes%TKE_tidal)) TKE_column = TKE_column + fluxes%TKE_tidal(i,j) * I_Rho0 TKE_column = CS%BBL_effic * TKE_column ! Only use a fraction of the mechanical dissipation for mixing. @@ -1495,7 +1494,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ( ustar_D + absf * ( z_bot * D_minus_z ) ) endif - ! TKE associated with Kd_wall, in m3 s-2. + ! TKE associated with Kd_wall [m3 s-2]. ! This calculation if for the volume spanning the interface. TKE_Kd_wall = US%Z_to_m**3*Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) @@ -1560,7 +1559,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, real :: Kd_mlr ! A diffusivity associated with mixed layer turbulence radiation [Z2 s-1 ~> m2 s-1]. real :: C1_6 ! 1/6 real :: Omega2 ! rotation rate squared [s-2]. - real :: z1 ! layer thickness times I_decay (nondim) + real :: z1 ! layer thickness times I_decay [nondim] real :: dzL ! thickness converted to heights [Z ~> m]. real :: I_decay_len2_TKE ! squared inverse decay lengthscale for ! TKE, as used in the mixed layer code [Z-2 ~> m-2]. @@ -1681,17 +1680,17 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) ! integrated thickness in the BBL [Z ~> m]. real, dimension(SZIB_(G)) :: & - uhtot, & ! running integral of u in the BBL (Z m/s) + uhtot, & ! running integral of u in the BBL [Z m s-1 ~> m2 s-1] ustar, & ! bottom boundary layer turbulence speed [Z s-1 ~> m s-1]. - u2_bbl ! square of the mean zonal velocity in the BBL (m2/s2) + u2_bbl ! square of the mean zonal velocity in the BBL [m2 s-2] - real :: vhtot(SZI_(G)) ! running integral of v in the BBL (Z m/sec) + real :: vhtot(SZI_(G)) ! running integral of v in the BBL [Z m s-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G)) :: & vstar, & ! ustar at at v-points [Z s-1 ~> m s-1]. - v2_bbl ! square of average meridional velocity in BBL (m2/s2) + v2_bbl ! square of average meridional velocity in BBL [m2 s-2] - real :: cdrag_sqrt ! square root of the drag coefficient (nondim) + real :: cdrag_sqrt ! square root of the drag coefficient [nondim] real :: hvel ! thickness at velocity points [Z ~> m]. logical :: domore, do_i(SZI_(G)) @@ -1811,31 +1810,18 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) real, dimension(SZI_(G),SZK_(G)), intent(out) :: ds_dsp1 !< Coordinate variable (sigma-2) !! difference across an interface divided by !! the difference across the interface below - !! it (nondimensional) + !! it [nondim] real, dimension(SZI_(G),SZK_(G)), & optional, intent(in) :: rho_0 !< Layer potential densities relative to - !! surface press (kg/m3). - -! Arguments: -! (in) h - layer thickness (meter) -! (in) tv - structure containing pointers to any available -! thermodynamic fields; absent fields have NULL ptrs -! (in) kb - index of lightest layer denser than the buffer layer -! (in) G - ocean grid structure -! (in) GV - The ocean's vertical grid structure. -! (in) CS - control structure returned by previous call to diabatic_entrain_init -! (in) j - meridional index upon which to work -! (in) ds_dsp1 - coordinate variable (sigma-2) difference across an -! interface divided by the difference across the interface -! below it (nondimensional) -! (in) rho_0 - layer potential densities relative to surface press (kg/m3) - - real :: g_R0 ! g_R0 is g/Rho (m5 Z-1 kg-1 s-2) + !! surface press [kg m-3]. + + ! Local variables + real :: g_R0 ! g_R0 is g/Rho [m5 Z-1 kg-1 s-2 ~> m4 kg-1 s-2] real :: eps, tmp ! nondimensional temproray variables real :: a(SZK_(G)), a_0(SZK_(G)) ! nondimensional temporary variables real :: p_ref(SZI_(G)) ! an array of tv%P_Ref pressures - real :: Rcv(SZI_(G),SZK_(G)) ! coordinate density in the mixed and buffer layers (kg/m3) - real :: I_Drho ! temporary variable (m3/kg) + real :: Rcv(SZI_(G),SZK_(G)) ! coordinate density in the mixed and buffer layers [kg m-3] + real :: I_Drho ! temporary variable [m3 kg-1] integer :: i, k, k3, is, ie, nz, kmb is = G%isc ; ie = G%iec ; nz = G%ke diff --git a/src/parameterizations/vertical/MOM_shortwave_abs.F90 b/src/parameterizations/vertical/MOM_shortwave_abs.F90 index 991ebc84d5..6666658f08 100644 --- a/src/parameterizations/vertical/MOM_shortwave_abs.F90 +++ b/src/parameterizations/vertical/MOM_shortwave_abs.F90 @@ -89,9 +89,9 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, real, dimension(SZI_(G)), optional, intent(inout) :: Ttot !< Depth integrated mixed layer !! temperature [degC H ~> degC m or degC kg m-2] real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: dSV_dT !< The partial derivative of specific - !! volume with temperature, in m3 kg-1 K-1. + !! volume with temperature [m3 kg-1 degC-1]. real, dimension(SZI_(G),SZK_(G)), optional, intent(inout) :: TKE !< The TKE sink from mixing the heating - !! throughout a layer, in J m-2. + !! throughout a layer [J m-2]. ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & T_chg_above ! A temperature change that will be applied to all the thick @@ -105,7 +105,7 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, h_heat, & ! The thickness of the water column that will be heated by ! any remaining shortwave radiation [H ~> m or kg m-2]. T_chg, & ! The temperature change of thick layers due to the remaining - ! shortwave radiation and contributions from T_chg_above, in K. + ! shortwave radiation and contributions from T_chg_above [degC]. Pen_SW_rem ! The sum across all wavelength bands of the penetrating shortwave ! heating that hits the bottom and will be redistributed through ! the water column [degC H ~> degC m or degC kg m-2] diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index b0e59346e4..fdda545d0b 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -672,7 +672,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, C !! usually (~Rho_0 / (G_Earth * dRho_lay)) !! [Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1] real, dimension(SZI_(G),SZK_(G)), intent(in) :: max_TKE !< The energy required to for a layer to entrain - !! to its maximum realizable thickness, in m3 s-3 + !! to its maximum realizable thickness [m3 s-3] type(tidal_mixing_cs), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers [Z2 s-1 ~> m2 s-1]. @@ -942,7 +942,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, !! usually (~Rho_0 / (G_Earth * dRho_lay)) !! [Z2 s-1 / m3 s-3 = Z2 s2 m-3 ~> s2 m-1] real, dimension(SZI_(G),SZK_(G)), intent(in) :: max_TKE !< The energy required to for a layer to entrain - !! to its maximum realizable thickness, in m3 s-3 + !! to its maximum realizable thickness [m3 s-3] type(tidal_mixing_cs), pointer :: CS !< The control structure for this module real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: Kd_lay !< The diapycnal diffusvity in layers [Z2 s-1 ~> m2 s-1]. diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 3c9038a228..54a060841c 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -90,7 +90,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, US, param_file, just_read_p real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! positive upward [Z ~> m]. real :: min_thickness ! The minimum layer thicknesses [Z ~> m]. - real :: S_surf, S_range, S_ref, S_light, S_dense ! Various salinities, in ppt. + real :: S_surf, S_range, S_ref, S_light, S_dense ! Various salinities [ppt]. real :: eta_IC_quanta ! The granularity of quantization of intial interface heights [Z-1 ~> m-1]. ! This include declares and sets the variable "version". # include "version_variable.h" diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index ea26d12b58..2c7dc2f530 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -93,7 +93,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, US, param_file, just_read_p real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! positive upward [Z ~> m]. real :: min_thickness ! The minimum layer thicknesses [Z ~> m]. - real :: S_surf, S_range, S_ref, S_light, S_dense ! Various salinities, in ppt. + real :: S_surf, S_range, S_ref, S_light, S_dense ! Various salinities [ppt]. real :: eta_IC_quanta ! The granularity of quantization of intial interface heights [Z-1 ~> m-1]. character(len=20) :: verticalCoordinate logical :: just_read ! If true, just read parameters but set nothing. From 3d0c946eda93306fad61caeaea8e97cb4371b431 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 21 Dec 2018 19:29:14 -0500 Subject: [PATCH 0974/1072] Documented units of 280 more variables Changed comments to use the square bracket notation to document the units of about 280 more variables, including lateral viscosities. Also eliminated another redundant argument documentation block. Only comments have been changed and all answers are bitwise identical. --- src/ALE/coord_adapt.F90 | 4 +- src/ALE/coord_rho.F90 | 22 +-- src/ALE/coord_zlike.F90 | 8 +- src/core/MOM_PressureForce_analytic_FV.F90 | 36 +++-- src/core/MOM_barotropic.F90 | 2 +- src/core/MOM_continuity.F90 | 12 +- src/core/MOM_open_boundary.F90 | 4 +- src/diagnostics/MOM_PointAccel.F90 | 8 +- src/equation_of_state/MOM_EOS.F90 | 20 +-- src/equation_of_state/MOM_TFreeze.F90 | 70 ++++---- src/ice_shelf/MOM_ice_shelf.F90 | 8 +- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 26 +-- src/ice_shelf/MOM_ice_shelf_state.F90 | 16 +- .../lateral/MOM_MEKE_types.F90 | 16 +- .../lateral/MOM_hor_visc.F90 | 150 +++++++++--------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 38 ++--- .../lateral/MOM_thickness_diffuse.F90 | 36 ++--- .../vertical/MOM_CVMix_ddiff.F90 | 20 +-- .../vertical/MOM_energetic_PBL.F90 | 29 ++-- .../vertical/MOM_kappa_shear.F90 | 4 +- .../vertical/MOM_set_viscosity.F90 | 8 +- .../vertical/MOM_vert_friction.F90 | 26 ++- src/tracer/MOM_tracer_hor_diff.F90 | 32 ++-- src/user/BFB_surface_forcing.F90 | 2 +- src/user/MOM_wave_interface.F90 | 6 +- 25 files changed, 298 insertions(+), 305 deletions(-) diff --git a/src/ALE/coord_adapt.F90 b/src/ALE/coord_adapt.F90 index 9a18b836ae..98bbeb7b10 100644 --- a/src/ALE/coord_adapt.F90 +++ b/src/ALE/coord_adapt.F90 @@ -123,8 +123,8 @@ subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) integer, intent(in) :: i !< The i-index of the column to work on integer, intent(in) :: j !< The j-index of the column to work on real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: zInt !< Interface heights [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: tInt !< Interface temperatures, in C - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: sInt !< Interface salinities, in psu + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: tInt !< Interface temperatures [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: sInt !< Interface salinities [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZK_(GV)+1), intent(inout) :: zNext !< updated interface positions diff --git a/src/ALE/coord_rho.F90 b/src/ALE/coord_rho.F90 index 16c05943aa..b98844505f 100644 --- a/src/ALE/coord_rho.F90 +++ b/src/ALE/coord_rho.F90 @@ -16,10 +16,10 @@ module coord_rho !> Number of layers integer :: nk - !> Minimum thickness allowed for layers, in m + !> Minimum thickness allowed for layers, often in [H ~> m or kg m-2] real :: min_thickness = 0. - !> Reference pressure for density calculations, in Pa + !> Reference pressure for density calculations [Pa] real :: ref_pressure !> If true, integrate for interface positions from the top downward. @@ -73,7 +73,7 @@ end subroutine end_coord_rho !> This subroutine can be used to set the parameters for the coord_rho module subroutine set_rho_params(CS, min_thickness, integrate_downward_for_e, interp_CS) type(rho_CS), pointer :: CS !< Coordinate control structure - real, optional, intent(in) :: min_thickness !< Minimum allowed thickness, in m + real, optional, intent(in) :: min_thickness !< Minimum allowed thickness [H ~> m or kg m-2] logical, optional, intent(in) :: integrate_downward_for_e !< If true, integrate for interface !! positions from the top downward. If false, integrate !! from the bottom upward, as does the rest of the model. @@ -189,18 +189,18 @@ subroutine build_rho_column_iteratively(CS, remapCS, nz, depth, h, T, S, eqn_of_ type(rho_CS), intent(in) :: CS !< Regridding control structure type(remapping_CS), intent(in) :: remapCS !< Remapping parameters and options integer, intent(in) :: nz !< Number of levels - real, intent(in) :: depth !< Depth of ocean bottom (positive in m) - real, dimension(nz), intent(in) :: h !< Layer thicknesses, in m - real, dimension(nz), intent(in) :: T !< T for column - real, dimension(nz), intent(in) :: S !< S for column + real, intent(in) :: depth !< Depth of ocean bottom [Z ~> m] + real, dimension(nz), intent(in) :: h !< Layer thicknesses in Z coordinates [Z ~> m] + real, dimension(nz), intent(in) :: T !< T for column [degC] + real, dimension(nz), intent(in) :: S !< S for column [ppt] type(EOS_type), pointer :: eqn_of_state !< Equation of state structure real, dimension(nz+1), intent(inout) :: zInterface !< Absolute positions of interfaces real, optional, intent(in) :: h_neglect !< A negligibly small width for the !! purpose of cell reconstructions - !! in the same units as h + !! in the same units as h [Z ~> m] real, optional, intent(in) :: h_neglect_edge !< A negligibly small width !! for the purpose of edge value calculations - !! in the same units as h + !! in the same units as h [Z ~> m] ! Local variables integer :: k, m integer :: count_nonzero_layers @@ -349,9 +349,9 @@ end subroutine copy_finite_thicknesses subroutine old_inflate_layers_1d( min_thickness, nk, h ) ! Argument - real, intent(in) :: min_thickness !< Minimum allowed thickness, in m + real, intent(in) :: min_thickness !< Minimum allowed thickness [H ~> m or kg m-2] integer, intent(in) :: nk !< Number of layers in the grid - real, dimension(:), intent(inout) :: h !< Layer thicknesses, in m + real, dimension(:), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] ! Local variable integer :: k diff --git a/src/ALE/coord_zlike.F90 b/src/ALE/coord_zlike.F90 index 98bfa36fae..1f4949431d 100644 --- a/src/ALE/coord_zlike.F90 +++ b/src/ALE/coord_zlike.F90 @@ -13,11 +13,11 @@ module coord_zlike !> Number of levels to be generated integer :: nk - !> Minimum thickness allowed for layers, in the same thickness units that will - !! be used in all subsequent calls to build_zstar_column with this structure. + !> Minimum thickness allowed for layers, in the same thickness units (perhaps [H ~> m or kg m-2]) + !! that will be used in all subsequent calls to build_zstar_column with this structure. real :: min_thickness - !> Target coordinate resolution, usually in Z (often m) + !> Target coordinate resolution, usually in [Z ~> m] real, allocatable, dimension(:) :: coordinateResolution end type zlike_CS @@ -29,7 +29,7 @@ module coord_zlike subroutine init_coord_zlike(CS, nk, coordinateResolution) type(zlike_CS), pointer :: CS !< Unassociated pointer to hold the control structure integer, intent(in) :: nk !< Number of levels in the grid - real, dimension(:), intent(in) :: coordinateResolution !< Target coordinate resolution, in Z (often m) + real, dimension(:), intent(in) :: coordinateResolution !< Target coordinate resolution [Z ~> m] if (associated(CS)) call MOM_error(FATAL, "init_coord_zlike: CS already associated!") allocate(CS) diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 044aef35a4..97bc80ef7f 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -38,7 +38,7 @@ module MOM_PressureForce_AFV real :: Rho0 !< The density used in the Boussinesq !! approximation [kg m-3]. real :: GFS_scale !< A scaling of the surface pressure gradients to - !! allow the use of a reduced gravity model. + !! allow the use of a reduced gravity model [nondim]. type(time_type), pointer :: Time !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the !! timing of diagnostic output. @@ -103,7 +103,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> kg/m2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] @@ -121,17 +121,19 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure in Pa. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & T_tmp, & ! Temporary array of temperatures where layers that are lighter - ! than the mixed layer have the mixed layer's properties, in C. + ! than the mixed layer have the mixed layer's properties [degC]. S_tmp ! Temporary array of salinities where layers that are lighter ! than the mixed layer have the mixed layer's properties [PSU]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - S_t, S_b, T_t, T_b ! Top and bottom edge values for linear reconstructions - ! of salinity and temperature within each layer. + S_t, & ! Top and bottom edge values for linear reconstructions + S_b, & ! of salinity within each layer [ppt]. + T_t, & ! Top and bottom edge values for linear reconstructions + T_b ! of temperature within each layer [degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & dza, & ! The change in geopotential anomaly between the top and bottom ! of a layer [m2 s-2]. intp_dza ! The vertical integral in depth of the pressure anomaly less - ! the pressure anomaly at the top of the layer, in Pa m2 s-2. + ! the pressure anomaly at the top of the layer [Pa m2 s-2]. real, dimension(SZI_(G),SZJ_(G)) :: & dp, & ! The (positive) change in pressure across a layer [Pa]. SSH, & ! The sea surface height anomaly, in depth units [Z ~> m]. @@ -146,16 +148,16 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p ! density near-surface layer [kg m-3]. real, dimension(SZIB_(G),SZJ_(G)) :: & intx_za ! The zonal integral of the geopotential anomaly along the - ! interface below a layer, divided by the grid spacing, m2 s-2. + ! interface below a layer, divided by the grid spacing [m2 s-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & intx_dza ! The change in intx_za through a layer [m2 s-2]. real, dimension(SZI_(G),SZJB_(G)) :: & inty_za ! The meridional integral of the geopotential anomaly along the - ! interface below a layer, divided by the grid spacing, m2 s-2. + ! interface below a layer, divided by the grid spacing [m2 s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & inty_dza ! The change in inty_za through a layer [m2 s-2]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate - ! density, in Pa (usually 2e7 Pa = 2000 dbar). + ! density, [Pa] (usually 2e7 Pa = 2000 dbar). real :: dp_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [Pa]. @@ -444,14 +446,14 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean - !! or atmosphere-ocean interface in Pa. + !! or atmosphere-ocean interface [Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure !! anomaly in each layer due to eta anomalies !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. @@ -469,7 +471,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at Rho_cv_BL ! The coordinate potential density in the deepest variable ! density near-surface layer [kg m-3]. real, dimension(SZI_(G),SZJ_(G)) :: & - dz, & ! The change in geopotential thickness through a layer, m2 s-2. + dz, & ! The change in geopotential thickness through a layer [m2 s-2]. pa, & ! The pressure anomaly (i.e. pressure + g*RHO_0*e) at the ! the interface atop a layer [Pa]. dpa, & ! The change in pressure anomaly between the top and bottom @@ -487,7 +489,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & T_tmp, & ! Temporary array of temperatures where layers that are lighter - ! than the mixed layer have the mixed layer's properties, in C. + ! than the mixed layer have the mixed layer's properties [degC]. S_tmp ! Temporary array of salinities where layers that are lighter ! than the mixed layer have the mixed layer's properties [PSU]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & @@ -495,13 +497,13 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at ! of salinity and temperature within each layer. real :: rho_in_situ(SZI_(G)) ! The in situ density [kg m-3]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate - ! density, in Pa (usually 2e7 Pa = 2000 dbar). - real :: p0(SZI_(G)) ! An array of zeros to use for pressure in Pa. + ! density, [Pa] (usually 2e7 Pa = 2000 dbar). + real :: p0(SZI_(G)) ! An array of zeros to use for pressure [Pa]. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m. + ! in roundoff and can be neglected [H ~> m]. real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. real :: I_Rho0 ! 1/Rho0 [m3 kg-1]. - real :: G_Rho0 ! G_Earth / Rho0 in m5 Z-1 s-2 kg-1. + real :: G_Rho0 ! G_Earth / Rho0 in [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. real :: Rho_ref ! The reference density [kg m-3]. real :: dz_neglect ! A minimal thickness [Z ~> m], like e. logical :: use_p_atm ! If true, use the atmospheric pressure. diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 9f83205fc6..889cce741d 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -566,7 +566,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, dyn_coef_eta, & ! The coefficient relating the changes in eta to the ! dynamic surface pressure under rigid ice ! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. - p_surf_dyn ! A dynamic surface pressure under rigid ice, in m2 s-2. + p_surf_dyn ! A dynamic surface pressure under rigid ice [m2 s-2]. type(local_BT_cont_u_type), dimension(SZIBW_(CS),SZJW_(CS)) :: & BTCL_u ! A repackaged version of the u-point information in BT_cont. type(local_BT_cont_v_type), dimension(SZIW_(CS),SZJBW_(CS)) :: & diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index 66ec869e0c..931370a7d0 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -44,9 +44,9 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, & type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Zonal velocity, in m/s. + intent(in) :: u !< Zonal velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Meridional velocity, in m/s. + intent(in) :: v !< Meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: hin !< Initial layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -79,10 +79,10 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, & !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: u_cor !< The zonal velocities that - !! give uhbt as the depth-integrated transport, in m/s. + !! give uhbt as the depth-integrated transport [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor !< The meridional velocities that - !! give vhbt as the depth-integrated transport, in m/s. + !! give vhbt as the depth-integrated transport [m s-1]. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt_aux !< A second summed zonal !! volume flux in m3/s. @@ -91,10 +91,10 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, & !! volume flux in m3/s. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(inout) :: u_cor_aux !< The zonal velocities - !! that give uhbt_aux as the depth-integrated transport, in m/s. + !! that give uhbt_aux as the depth-integrated transport [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(inout) :: v_cor_aux !< The meridional velocities - !! that give vhbt_aux as the depth-integrated transport, in m/s. + !! that give vhbt_aux as the depth-integrated transport [m s-1]. type(BT_cont_type), & optional, pointer :: BT_cont !< A structure with elements !! that describe the effective open face areas as a function of barotropic flow. diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 6e9d6cccf1..f7ce76969f 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -251,10 +251,10 @@ module MOM_open_boundary real, pointer, dimension(:,:,:) :: cff_normal => NULL() !< Array storage for restarts real :: silly_h !< A silly value of thickness outside of the domain that !! can be used to test the independence of the OBCs to - !! this external data, in m. + !! this external data [H ~> m or kg m-2]. real :: silly_u !< A silly value of velocity outside of the domain that !! can be used to test the independence of the OBCs to - !! this external data, in m/s. + !! this external data [m s-1]. end type ocean_OBC_type !> Control structure for open boundaries that read from files. diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 4b6f3982c8..a642cd0205 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -85,9 +85,9 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st !! call to PointAccel_init. real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [m s-1]. real, optional, intent(in) :: str !< The surface wind stress integrated over a time - !! step, in m2 s-1. + !! step divided by the Boussinesq density [m2 s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, Z s-1. + optional, intent(in) :: a !< The layer coupling coefficients from vertvisc [Z s-1 ~> m s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, !! from vertvisc [H ~> m or kg m-2]. @@ -416,9 +416,9 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st !! call to PointAccel_init. real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [m s-1]. real, optional, intent(in) :: str !< The surface wind stress integrated over a time - !! step, in m2 s-1. + !! step divided by the Boussinesq density [m2 s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - optional, intent(in) :: a !< The layer coupling coefficients from vertvisc, Z s-1. + optional, intent(in) :: a !< The layer coupling coefficients from vertvisc [Z s-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, !! from vertvisc [H ~> m or kg m-2]. diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index a872d3d5a6..e4435a60df 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -819,11 +819,11 @@ subroutine EOS_manual_init(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Co !! in [kg m-3 degC-1] real , optional, intent(in) :: dRho_dS !< Partial derivative of density with salinity !! in [kg m-3 ppt-1] - real , optional, intent(in) :: TFr_S0_P0 !< The freezing potential temperature at S=0, P=0 in deg C. - real , optional, intent(in) :: dTFr_dS !< The derivative of freezing point with salinity, - !! in deg C PSU-1. - real , optional, intent(in) :: dTFr_dp !< The derivative of freezing point with pressure, - !! in deg C Pa-1. + real , optional, intent(in) :: TFr_S0_P0 !< The freezing potential temperature at S=0, P=0 [degC]. + real , optional, intent(in) :: dTFr_dS !< The derivative of freezing point with salinity + !! in [degC ppt-1]. + real , optional, intent(in) :: dTFr_dp !< The derivative of freezing point with pressure + !! in [degC Pa-1]. if (present(form_of_EOS )) EOS%form_of_EOS = form_of_EOS if (present(form_of_TFreeze)) EOS%form_of_TFreeze = form_of_TFreeze @@ -2385,11 +2385,11 @@ subroutine extract_member_EOS(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, !! in [kg m-3 degC-1] real , optional, intent(out) :: dRho_dS !< Partial derivative of density with salinity !! in [kg m-3 ppt-1] - real , optional, intent(out) :: TFr_S0_P0 !< The freezing potential temperature at S=0, P=0 in deg C. - real , optional, intent(out) :: dTFr_dS !< The derivative of freezing point with salinity, - !! in deg C PSU-1. - real , optional, intent(out) :: dTFr_dp !< The derivative of freezing point with pressure, - !! in deg C Pa-1. + real , optional, intent(out) :: TFr_S0_P0 !< The freezing potential temperature at S=0, P=0 [degC]. + real , optional, intent(out) :: dTFr_dS !< The derivative of freezing point with salinity + !! [degC PSU-1]. + real , optional, intent(out) :: dTFr_dp !< The derivative of freezing point with pressure + !! [degC Pa-1]. if (present(form_of_EOS )) form_of_EOS = EOS%form_of_EOS if (present(form_of_TFreeze)) form_of_TFreeze = EOS%form_of_TFreeze diff --git a/src/equation_of_state/MOM_TFreeze.F90 b/src/equation_of_state/MOM_TFreeze.F90 index 99937181c0..50233cae60 100644 --- a/src/equation_of_state/MOM_TFreeze.F90 +++ b/src/equation_of_state/MOM_TFreeze.F90 @@ -13,14 +13,14 @@ module MOM_TFreeze public calculate_TFreeze_linear, calculate_TFreeze_Millero, calculate_TFreeze_teos10 -!> Compute the freezing point potential temperature (in deg C) from salinity (in psu) and -!! pressure (in Pa) using a simple linear expression, with coefficients passed in as arguments. +!> Compute the freezing point potential temperature [degC] from salinity [ppt] and +!! pressure [Pa] using a simple linear expression, with coefficients passed in as arguments. interface calculate_TFreeze_linear module procedure calculate_TFreeze_linear_scalar, calculate_TFreeze_linear_array end interface calculate_TFreeze_linear -!> Compute the freezing point potential temperature (in deg C) from salinity (in psu) and -!! pressure (in Pa) using the expression from Millero (1978) (and in appendix A of Gill 1982), +!> Compute the freezing point potential temperature [degC] from salinity [PSU] and +!! pressure [Pa] using the expression from Millero (1978) (and in appendix A of Gill 1982), !! but with the of the pressure dependence changed from 7.53e-8 to 7.75e-8 to make this an !! expression for potential temperature (not in situ temperature), using a !! value that is correct at the freezing point at 35 PSU and 5e6 Pa (500 dbar). @@ -28,8 +28,8 @@ module MOM_TFreeze module procedure calculate_TFreeze_Millero_scalar, calculate_TFreeze_Millero_array end interface calculate_TFreeze_Millero -!> Compute the freezing point conservative temperature (in deg C) from absolute salinity (in g/kg) -!! and pressure (in Pa) using the TEOS10 package. +!> Compute the freezing point conservative temperature [degC] from absolute salinity [g/kg] +!! and pressure [Pa] using the TEOS10 package. interface calculate_TFreeze_teos10 module procedure calculate_TFreeze_teos10_scalar, calculate_TFreeze_teos10_array end interface calculate_TFreeze_teos10 @@ -37,38 +37,38 @@ module MOM_TFreeze contains !> This subroutine computes the freezing point potential temperature -!! (in deg C) from salinity (in psu), and pressure (in Pa) using a simple +!! [degC] from salinity [ppt], and pressure [Pa] using a simple !! linear expression, with coefficients passed in as arguments. subroutine calculate_TFreeze_linear_scalar(S, pres, T_Fr, TFr_S0_P0, & dTFr_dS, dTFr_dp) - real, intent(in) :: S !< salinity in PSU. - real, intent(in) :: pres !< pressure in Pa. - real, intent(out) :: T_Fr !< Freezing point potential temperature in deg C. - real, intent(in) :: TFr_S0_P0 !< The freezing point at S=0, p=0, in deg C. + real, intent(in) :: S !< salinity [ppt]. + real, intent(in) :: pres !< pressure [Pa]. + real, intent(out) :: T_Fr !< Freezing point potential temperature [degC]. + real, intent(in) :: TFr_S0_P0 !< The freezing point at S=0, p=0 [degC]. real, intent(in) :: dTFr_dS !< The derivative of freezing point with salinity, - !! in deg C PSU-1. + !! [degC ppt-1]. real, intent(in) :: dTFr_dp !< The derivative of freezing point with pressure, - !! in deg C Pa-1. + !! [degC Pa-1]. T_Fr = (TFr_S0_P0 + dTFr_dS*S) + dTFr_dp*pres end subroutine calculate_TFreeze_linear_scalar !> This subroutine computes an array of freezing point potential temperatures -!! (in deg C) from salinity (in psu), and pressure (in Pa) using a simple +!! [degC] from salinity [ppt], and pressure [Pa] using a simple !! linear expression, with coefficients passed in as arguments. subroutine calculate_TFreeze_linear_array(S, pres, T_Fr, start, npts, & TFr_S0_P0, dTFr_dS, dTFr_dp) - real, dimension(:), intent(in) :: S !< salinity in PSU. - real, dimension(:), intent(in) :: pres !< pressure in Pa. - real, dimension(:), intent(out) :: T_Fr !< Freezing point potential temperature in deg C. + real, dimension(:), intent(in) :: S !< salinity [ppt]. + real, dimension(:), intent(in) :: pres !< pressure [Pa]. + real, dimension(:), intent(out) :: T_Fr !< Freezing point potential temperature [degC]. integer, intent(in) :: start !< the starting point in the arrays. integer, intent(in) :: npts !< the number of values to calculate. - real, intent(in) :: TFr_S0_P0 !< The freezing point at S=0, p=0, in deg C. + real, intent(in) :: TFr_S0_P0 !< The freezing point at S=0, p=0, [degC]. real, intent(in) :: dTFr_dS !< The derivative of freezing point with salinity, - !! in deg C PSU-1. + !! [degC PSU-1]. real, intent(in) :: dTFr_dp !< The derivative of freezing point with pressure, - !! in deg C Pa-1. + !! [degC Pa-1]. integer :: j do j=start,start+npts-1 @@ -78,15 +78,15 @@ subroutine calculate_TFreeze_linear_array(S, pres, T_Fr, start, npts, & end subroutine calculate_TFreeze_linear_array !> This subroutine computes the freezing point potential temperature -!! (in deg C) from salinity (in psu), and pressure (in Pa) using the expression +!! [degC] from salinity [ppt], and pressure [Pa] using the expression !! from Millero (1978) (and in appendix A of Gill 1982), but with the of the !! pressure dependence changed from 7.53e-8 to 7.75e-8 to make this an !! expression for potential temperature (not in situ temperature), using a !! value that is correct at the freezing point at 35 PSU and 5e6 Pa (500 dbar). subroutine calculate_TFreeze_Millero_scalar(S, pres, T_Fr) real, intent(in) :: S !< Salinity in PSU. - real, intent(in) :: pres !< Pressure in Pa. - real, intent(out) :: T_Fr !< Freezing point potential temperature in deg C. + real, intent(in) :: pres !< Pressure [Pa]. + real, intent(out) :: T_Fr !< Freezing point potential temperature [degC]. ! Local variables real, parameter :: cS1 = -0.0575, cS3_2 = 1.710523e-3, cS2 = -2.154996e-4 @@ -97,15 +97,15 @@ subroutine calculate_TFreeze_Millero_scalar(S, pres, T_Fr) end subroutine calculate_TFreeze_Millero_scalar !> This subroutine computes the freezing point potential temperature -!! (in deg C) from salinity (in psu), and pressure (in Pa) using the expression +!! [degC] from salinity [ppt], and pressure [Pa] using the expression !! from Millero (1978) (and in appendix A of Gill 1982), but with the of the !! pressure dependence changed from 7.53e-8 to 7.75e-8 to make this an !! expression for potential temperature (not in situ temperature), using a !! value that is correct at the freezing point at 35 PSU and 5e6 Pa (500 dbar). subroutine calculate_TFreeze_Millero_array(S, pres, T_Fr, start, npts) - real, dimension(:), intent(in) :: S !< Salinity in PSU. - real, dimension(:), intent(in) :: pres !< Pressure in Pa. - real, dimension(:), intent(out) :: T_Fr !< Freezing point potential temperature in deg C. + real, dimension(:), intent(in) :: S !< Salinity [PSU]. + real, dimension(:), intent(in) :: pres !< Pressure [Pa]. + real, dimension(:), intent(out) :: T_Fr !< Freezing point potential temperature [degC]. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. @@ -122,12 +122,12 @@ subroutine calculate_TFreeze_Millero_array(S, pres, T_Fr, start, npts) end subroutine calculate_TFreeze_Millero_array !> This subroutine computes the freezing point conservative temperature -!! (in deg C) from absolute salinity (in g/kg), and pressure (in Pa) using the +!! [degC] from absolute salinity [g/kg], and pressure [Pa] using the !! TEOS10 package. subroutine calculate_TFreeze_teos10_scalar(S, pres, T_Fr) - real, intent(in) :: S !< Absolute salinity in g/kg. - real, intent(in) :: pres !< Pressure in Pa. - real, intent(out) :: T_Fr !< Freezing point conservative temperature in deg C. + real, intent(in) :: S !< Absolute salinity [g/kg]. + real, intent(in) :: pres !< Pressure [Pa]. + real, intent(out) :: T_Fr !< Freezing point conservative temperature [degC]. ! Local variables real, dimension(1) :: S0, pres0 @@ -142,12 +142,12 @@ subroutine calculate_TFreeze_teos10_scalar(S, pres, T_Fr) end subroutine calculate_TFreeze_teos10_scalar !> This subroutine computes the freezing point conservative temperature -!! (in deg C) from absolute salinity (in g/kg), and pressure (in Pa) using the +!! [degC] from absolute salinity [g/kg], and pressure [Pa] using the !! TEOS10 package. subroutine calculate_TFreeze_teos10_array(S, pres, T_Fr, start, npts) - real, dimension(:), intent(in) :: S !< absolute salinity in g/kg. - real, dimension(:), intent(in) :: pres !< pressure in Pa. - real, dimension(:), intent(out) :: T_Fr !< Freezing point conservative temperature in deg C. + real, dimension(:), intent(in) :: S !< absolute salinity [g/kg]. + real, dimension(:), intent(in) :: pres !< pressure [Pa]. + real, dimension(:), intent(out) :: T_Fr !< Freezing point conservative temperature [degC]. integer, intent(in) :: start !< the starting point in the arrays. integer, intent(in) :: npts !< the number of values to calculate. diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index affbed728c..8fe71574e6 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -79,14 +79,14 @@ module MOM_ice_shelf type(ocean_grid_type), pointer :: ocn_grid => NULL() !< A pointer to the ocean model grid !! The rest is private real :: flux_factor = 1.0 !< A factor that can be used to turn off ice shelf - !! melting (flux_factor = 0). + !! melting (flux_factor = 0) [nondim]. character(len=128) :: restart_output_dir = ' ' !< The directory in which to write restart files type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe !! the ice-shelf state type(ice_shelf_dyn_CS), pointer :: dCS => NULL() !< The control structure for the ice-shelf dynamics. real, pointer, dimension(:,:) :: & - utide => NULL() !< tidal velocity, in m/s + utide => NULL() !< tidal velocity [m s-1] real :: ustar_bg !< A minimum value for ustar under ice shelves [Z s-1 ~> m s-1]. real :: cdrag !< drag coefficient under ice shelves , non-dimensional. @@ -217,8 +217,8 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) p_int !< The pressure at the ice-ocean interface [Pa]. real, dimension(SZI_(CS%grid),SZJ_(CS%grid)) :: & - exch_vel_t, & !< Sub-shelf thermal exchange velocity, in m/s - exch_vel_s !< Sub-shelf salt exchange velocity, in m/s + exch_vel_t, & !< Sub-shelf thermal exchange velocity [m s-1] + exch_vel_s !< Sub-shelf salt exchange velocity [m s-1] real, dimension(SZDI_(CS%grid),SZDJ_(CS%grid)) :: & mass_flux !< total mass flux of freshwater across diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 9a54335544..945b634e91 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -30,7 +30,7 @@ subroutine initialize_ice_thickness(h_shelf, area_shelf_h, hmask, G, US, PF) real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_shelf !< The ice shelf thickness [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. + intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf [m2]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf @@ -60,9 +60,9 @@ end subroutine initialize_ice_thickness subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, US, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< The ice shelf thickness, in m. + intent(inout) :: h_shelf !< The ice shelf thickness [m]. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. + intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf [m2]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf @@ -72,7 +72,7 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, U ! This subroutine reads ice thickness and area from a file and puts it into ! h_shelf and area_shelf_h in m (and dimensionless) and updates hmask character(len=200) :: filename,thickness_file,inputdir ! Strings for file/path - character(len=200) :: thickness_varname, area_varname! Variable name in file + character(len=200) :: thickness_varname, area_varname ! Variable name in file character(len=40) :: mdl = "initialize_ice_thickness_from_file" ! This subroutine's name. integer :: i, j, isc, jsc, iec, jec real :: len_sidestress, mask, udh @@ -149,7 +149,7 @@ subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, US, real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_shelf !< The ice shelf thickness [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. + intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf [m2]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf @@ -248,18 +248,18 @@ end subroutine initialize_ice_thickness_channel ! intent(inout) :: u_face_mask_bdry !< A boundary-type mask at C-grid u faces ! real, dimension(SZIB_(G),SZJ_(G)), & ! intent(inout) :: u_flux_bdry_val !< The boundary thickness flux through - !! C-grid u faces, in m2 s-1. + !! C-grid u faces [m2 s-1]. ! real, dimension(SZI_(G),SZJB_(G)), & ! intent(inout) :: v_face_mask_bdry !< A boundary-type mask at C-grid v faces ! real, dimension(SZI_(G),SZJB_(G)), & ! intent(inout) :: v_flux_bdry_val !< The boundary thickness flux through - !! C-grid v faces, in m2 s-1. + !! C-grid v faces [m2 s-1]. ! real, dimension(SZIB_(G),SZJB_(G)), & ! intent(inout) :: u_bdry_val !< The zonal ice shelf velocity at open - !! boundary vertices, in m/yr. + !! boundary vertices [m yr-1]. ! real, dimension(SZIB_(G),SZJB_(G)), & ! intent(inout) :: v_bdry_val !< The meridional ice shelf velocity at open - !! boundary vertices, in m/yr. + !! boundary vertices [m yr-1]. ! real, dimension(SZDI_(G),SZDJ_(G)), & ! intent(inout) :: h_bdry_val !< The ice shelf thickness at open boundaries ! real, dimension(SZDI_(G),SZDJ_(G)), & @@ -304,18 +304,18 @@ end subroutine initialize_ice_thickness_channel ! intent(inout) :: u_face_mask_bdry !< A boundary-type mask at C-grid u faces ! real, dimension(SZIB_(G),SZJ_(G)), & ! intent(inout) :: u_flux_bdry_val !< The boundary thickness flux through - !! C-grid u faces, in m2 s-1. + !! C-grid u faces [m2 s-1]. ! real, dimension(SZI_(G),SZJB_(G)), & ! intent(inout) :: v_face_mask_bdry !< A boundary-type mask at C-grid v faces ! real, dimension(SZI_(G),SZJB_(G)), & ! intent(inout) :: v_flux_bdry_val !< The boundary thickness flux through - !! C-grid v faces, in m2 s-1. + !! C-grid v faces [m2 s-1]. ! real, dimension(SZIB_(G),SZJB_(G)), & ! intent(inout) :: u_bdry_val !< The zonal ice shelf velocity at open - !! boundary vertices, in m/yr. + !! boundary vertices [m yr-1]. ! real, dimension(SZIB_(G),SZJB_(G)), & ! intent(inout) :: v_bdry_val !< The meridional ice shelf velocity at open - !! boundary vertices, in m/yr. + !! boundary vertices [m yr-1]. ! real, dimension(SZDI_(G),SZDJ_(G)), & ! intent(inout) :: h_bdry_val !< The ice shelf thickness at open boundaries ! real, dimension(SZDI_(G),SZDJ_(G)), & diff --git a/src/ice_shelf/MOM_ice_shelf_state.F90 b/src/ice_shelf/MOM_ice_shelf_state.F90 index fe9ec8d74b..414a3389d6 100644 --- a/src/ice_shelf/MOM_ice_shelf_state.F90 +++ b/src/ice_shelf/MOM_ice_shelf_state.F90 @@ -23,9 +23,9 @@ module MOM_ice_shelf_state !> Structure that describes the ice shelf state type, public :: ice_shelf_state real, pointer, dimension(:,:) :: & - mass_shelf => NULL(), & !< The mass per unit area of the ice shelf or sheet, in kg m-2. - area_shelf_h => NULL(), & !< The area per cell covered by the ice shelf, in m2. - h_shelf => NULL(), & !< the thickness of the shelf in m, redundant with mass but may + mass_shelf => NULL(), & !< The mass per unit area of the ice shelf or sheet [kg m-2]. + area_shelf_h => NULL(), & !< The area per cell covered by the ice shelf [m2]. + h_shelf => NULL(), & !< the thickness of the shelf [m], redundant with mass but may !! make the code more readable hmask => NULL(),& !< Mask used to indicate ice-covered or partiall-covered cells !! 1: fully covered, solve for velocity here (for now all @@ -38,16 +38,16 @@ module MOM_ice_shelf_state !! otherwise the wrong nodes will be included in velocity calcs. tflux_ocn => NULL(), & !< The UPWARD sensible ocean heat flux at the - !! ocean-ice interface, in W m-2. + !! ocean-ice interface [m-2]. salt_flux => NULL(), & !< The downward salt flux at the ocean-ice - !! interface, in kg m-2 s-1. + !! interface [kg m-2 s-1]. water_flux => NULL(), & !< The net downward liquid water flux at the - !! ocean-ice interface, in kg m-2 s-1. + !! ocean-ice interface [kg m-2 s-1]. tflux_shelf => NULL(), & !< The UPWARD diffusive heat flux in the ice - !! shelf at the ice-ocean interface, in W m-2. + !! shelf at the ice-ocean interface [W m-2]. tfreeze => NULL() !< The freezing point potential temperature - !! an the ice-ocean interface, in deg C. + !! an the ice-ocean interface [degC]. end type ice_shelf_state diff --git a/src/parameterizations/lateral/MOM_MEKE_types.F90 b/src/parameterizations/lateral/MOM_MEKE_types.F90 index 2b637af239..22ed34c6c2 100644 --- a/src/parameterizations/lateral/MOM_MEKE_types.F90 +++ b/src/parameterizations/lateral/MOM_MEKE_types.F90 @@ -8,18 +8,18 @@ module MOM_MEKE_types type, public :: MEKE_type ! Variables real, dimension(:,:), pointer :: & - MEKE => NULL(), & !< Vertically averaged eddy kinetic energy, in m2 s-2. - GM_src => NULL(), & !< MEKE source due to thickness mixing (GM), in W m-2. - mom_src => NULL(),& !< MEKE source from lateral friction in the momentum equations, in W m-2. - Kh => NULL(), & !< The MEKE-derived lateral mixing coefficient in m2 s-1. - Rd_dx_h => NULL() !< The deformation radius compared with the grid spacing, nondim. + MEKE => NULL(), & !< Vertically averaged eddy kinetic energy [m2 s-2]. + GM_src => NULL(), & !< MEKE source due to thickness mixing (GM) [W m-2]. + mom_src => NULL(),& !< MEKE source from lateral friction in the momentum equations [W m-2]. + Kh => NULL(), & !< The MEKE-derived lateral mixing coefficient [m2 s-1. + Rd_dx_h => NULL() !< The deformation radius compared with the grid spacing [nondim]. !! Rd_dx_h is copied from VarMix_CS. - real, dimension(:,:), pointer :: Ku => NULL() !< The MEKE-derived lateral viscosity coefficient in m2 s-1. + real, dimension(:,:), pointer :: Ku => NULL() !< The MEKE-derived lateral viscosity coefficient [m2 s-1]. !! This viscosity can be negative when representing backscatter !! from unresolved eddies (see Jansen and Held, 2014). ! Parameters - real :: KhTh_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTh, nondim - real :: KhTr_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTr, nondim. + real :: KhTh_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTh [nondim] + real :: KhTr_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTr [nondim]. real :: backscatter_Ro_pow = 0.0 !< Power in Rossby number function for backscatter. real :: backscatter_Ro_c = 0.0 !< Coefficient in Rossby number function for backscatter. end type MEKE_type diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index ce8dbbf773..9150dead11 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -60,94 +60,94 @@ module MOM_hor_visc !! scales quadratically with the velocity shears. logical :: use_Kh_bg_2d !< Read 2d background viscosity from a file. real :: Kh_bg_min !< The minimum value allowed for Laplacian horizontal - !! viscosity, in m2 s-1. The default is 0.0 + !! viscosity [m2 s-1]. The default is 0.0 logical :: use_land_mask !< Use the land mask for the computation of thicknesses !! at velocity locations. This eliminates the dependence on !! arbitrary values over land or outside of the domain. !! Default is False to maintain answers with legacy experiments !! but should be changed to True for new experiments. logical :: anisotropic !< If true, allow anisotropic component to the viscosity. - real :: Kh_aniso !< The anisotropic viscosity in m2 s-1. + real :: Kh_aniso !< The anisotropic viscosity [m2 s-1]. logical :: dynamic_aniso !< If true, the anisotropic viscosity is recomputed as a function !! of state. This is set depending on ANISOTROPIC_MODE. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Kh_bg_xx - !< The background Laplacian viscosity at h points, in units - !! of m2 s-1. The actual viscosity may be the larger of this + !< The background Laplacian viscosity at h points [m2 s-1]. + !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Kh_bg_2d - !< The background Laplacian viscosity at h points, in units - !! of m2 s-1. The actual viscosity may be the larger of this + !< The background Laplacian viscosity at h points [m2 s-1]. + !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Ah_bg_xx - !< The background biharmonic viscosity at h points, in units - !! of m4 s-1. The actual viscosity may be the larger of this + !< The background biharmonic viscosity at h points [m4 s-1]. + !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Biharm_Const2_xx !< A constant relating the biharmonic viscosity to the - !! square of the velocity shear, in m4 s. This value is + !! square of the velocity shear [m4 s]. This value is !! set to be the magnitude of the Coriolis terms once the !! velocity differences reach a value of order 1/2 MAXVEL. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: reduction_xx !< The amount by which stresses through h points are reduced !! due to partial barriers. Nondimensional. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - Kh_Max_xx, & !< The maximum permitted Laplacian viscosity, m2 s-1. - Ah_Max_xx, & !< The maximum permitted biharmonic viscosity, m4 s-1. + Kh_Max_xx, & !< The maximum permitted Laplacian viscosity [m2 s-1]. + Ah_Max_xx, & !< The maximum permitted biharmonic viscosity [m4 s-1]. n1n2_h, & !< Factor n1*n2 in the anisotropic direction tensor at h-points n1n1_m_n2n2_h !< Factor n1**2-n2**2 in the anisotropic direction tensor at h-points real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Kh_bg_xy - !< The background Laplacian viscosity at q points, in units - !! of m2 s-1. The actual viscosity may be the larger of this + !< The background Laplacian viscosity at q points [m2 s-1]. + !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Ah_bg_xy - !< The background biharmonic viscosity at q points, in units - !! of m4 s-1. The actual viscosity may be the larger of this + !< The background biharmonic viscosity at q points [m4 s-1]. + !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Biharm_Const2_xy !< A constant relating the biharmonic viscosity to the - !! square of the velocity shear, in m4 s. This value is + !! square of the velocity shear [m4 s]. This value is !! set to be the magnitude of the Coriolis terms once the !! velocity differences reach a value of order 1/2 MAXVEL. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: reduction_xy !< The amount by which stresses through q points are reduced - !! due to partial barriers. Nondimensional. + !! due to partial barriers [nondim]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - Kh_Max_xy, & !< The maximum permitted Laplacian viscosity, m2 s-1. - Ah_Max_xy, & !< The maximum permitted biharmonic viscosity, m4 s-1. + Kh_Max_xy, & !< The maximum permitted Laplacian viscosity [m2 s-1]. + Ah_Max_xy, & !< The maximum permitted biharmonic viscosity [m4 s-1]. n1n2_q, & !< Factor n1*n2 in the anisotropic direction tensor at q-points n1n1_m_n2n2_q !< Factor n1**2-n2**2 in the anisotropic direction tensor at q-points real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - dx2h, & !< Pre-calculated dx^2 at h points, in m2 - dy2h, & !< Pre-calculated dy^2 at h points, in m2 - dx_dyT, & !< Pre-calculated dx/dy at h points, nondim - dy_dxT !< Pre-calculated dy/dx at h points, nondim + dx2h, & !< Pre-calculated dx^2 at h points [m2] + dy2h, & !< Pre-calculated dy^2 at h points [m2] + dx_dyT, & !< Pre-calculated dx/dy at h points [nondim] + dy_dxT !< Pre-calculated dy/dx at h points [nondim] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - dx2q, & !< Pre-calculated dx^2 at q points, in m2 - dy2q, & !< Pre-calculated dy^2 at q points, in m2 - dx_dyBu, & !< Pre-calculated dx/dy at q points, nondim - dy_dxBu !< Pre-calculated dy/dx at q points, nondim + dx2q, & !< Pre-calculated dx^2 at q points [m2] + dy2q, & !< Pre-calculated dy^2 at q points [m2] + dx_dyBu, & !< Pre-calculated dx/dy at q points [nondim] + dy_dxBu !< Pre-calculated dy/dx at q points [nondim] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & - Idx2dyCu, & !< 1/(dx^2 dy) at u points, in m-3 - Idxdy2u !< 1/(dx dy^2) at u points, in m-3 + Idx2dyCu, & !< 1/(dx^2 dy) at u points [m-3] + Idxdy2u !< 1/(dx dy^2) at u points [m-3] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - Idx2dyCv, & !< 1/(dx^2 dy) at v points, in m-3 - Idxdy2v !< 1/(dx dy^2) at v points, in m-3 + Idx2dyCv, & !< 1/(dx^2 dy) at v points [m-3] + Idxdy2v !< 1/(dx dy^2) at v points [m-3] ! The following variables are precalculated time-invariant combinations of ! parameters and metric terms. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - Laplac_Const_xx, & !< Laplacian metric-dependent constants (nondim) - Biharm_Const_xx, & !< Biharmonic metric-dependent constants (nondim) - Laplac3_Const_xx, & !< Laplacian metric-dependent constants (nondim) - Biharm5_Const_xx !< Biharmonic metric-dependent constants (nondim) + Laplac_Const_xx, & !< Laplacian metric-dependent constants [nondim] + Biharm_Const_xx, & !< Biharmonic metric-dependent constants [nondim] + Laplac3_Const_xx, & !< Laplacian metric-dependent constants [nondim] + Biharm5_Const_xx !< Biharmonic metric-dependent constants [nondim] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - Laplac_Const_xy, & !< Laplacian metric-dependent constants (nondim) - Biharm_Const_xy, & !< Biharmonic metric-dependent constants (nondim) - Laplac3_Const_xy, & !< Laplacian metric-dependent constants (nondim) - Biharm5_Const_xy !< Biharmonic metric-dependent constants (nondim) + Laplac_Const_xy, & !< Laplacian metric-dependent constants [nondim] + Biharm_Const_xy, & !< Biharmonic metric-dependent constants [nondim] + Laplac3_Const_xy, & !< Laplacian metric-dependent constants [nondim] + Biharm5_Const_xy !< Biharmonic metric-dependent constants [nondim] type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostics @@ -199,49 +199,49 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, type(ocean_OBC_type), optional, pointer :: OBC !< Pointer to an open boundary condition type ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & - u0, & ! Laplacian of u (m-1 s-1) + u0, & ! Laplacian of u [m-1 s-1] h_u ! Thickness interpolated to u points [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJB_(G)) :: & - v0, & ! Laplacian of v (m-1 s-1) + v0, & ! Laplacian of v [m-1 s-1] h_v ! Thickness interpolated to v points [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)) :: & - sh_xx, & ! horizontal tension (du/dx - dv/dy) (1/sec) including metric terms - str_xx,& ! str_xx is the diagonal term in the stress tensor (H m2 s-2) - bhstr_xx,& ! A copy of str_xx that only contains the biharmonic contribution (H m2 s-2) - div_xx, & ! horizontal divergence (du/dx + dv/dy) (1/sec) including metric terms - FrictWorkIntz ! depth integrated energy dissipated by lateral friction (W/m2) + sh_xx, & ! horizontal tension (du/dx - dv/dy) including metric terms [s-1] + str_xx,& ! str_xx is the diagonal term in the stress tensor [H m2 s-2 ~> m3 s-2 or kg s-2] + bhstr_xx,& ! A copy of str_xx that only contains the biharmonic contribution [H m2 s-2 ~> m3 s-2 or kg s-2] + div_xx, & ! horizontal divergence (du/dx + dv/dy) including metric terms [s-1] + FrictWorkIntz ! depth integrated energy dissipated by lateral friction [W m-2] real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! components in the shearing strain [s-1] - sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) (1/sec) including metric terms - str_xy, & ! str_xy is the cross term in the stress tensor (H m2 s-2) - bhstr_xy, & ! A copy of str_xy that only contains the biharmonic contribution (H m2 s-2) - vort_xy ! vertical vorticity (dv/dx - du/dy) (1/sec) including metric terms + sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) including metric terms [s-1] + str_xy, & ! str_xy is the cross term in the stress tensor [H m2 s-2 ~> m3 s-2 or kg s-2] + bhstr_xy, & ! A copy of str_xy that only contains the biharmonic contribution [H m2 s-2 ~> m3 s-2 or kg s-2] + vort_xy ! vertical vorticity (dv/dx - du/dy) including metric terms [s-1] real, dimension(SZI_(G),SZJB_(G)) :: & - vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) (m-1 sec-1) including metric terms - div_xx_dy ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 sec-1) including metric terms + vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) including metric terms [m-1 s-1] + div_xx_dy ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) including metric terms [m-1 s-1] real, dimension(SZIB_(G),SZJ_(G)) :: & - vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 sec-1) including metric terms - div_xx_dx ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 sec-1) including metric terms + vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) including metric terms [m-1 s-1] + div_xx_dx ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) including metric terms [m-1 s-1] real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & - Ah_q, & ! biharmonic viscosity at corner points (m4/s) - Kh_q ! Laplacian viscosity at corner points (m2/s) + Ah_q, & ! biharmonic viscosity at corner points [m4 s-1] + Kh_q ! Laplacian viscosity at corner points [m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - Ah_h, & ! biharmonic viscosity at thickness points (m4/s) - Kh_h, & ! Laplacian viscosity at thickness points (m2/s) - FrictWork ! energy dissipated by lateral friction (W/m2) - - real :: Ah ! biharmonic viscosity (m4/s) - real :: Kh ! Laplacian viscosity (m2/s) - real :: AhSm ! Smagorinsky biharmonic viscosity (m4/s) - real :: KhSm ! Smagorinsky Laplacian viscosity (m2/s) - real :: AhLth ! 2D Leith biharmonic viscosity (m4/s) - real :: KhLth ! 2D Leith Laplacian viscosity (m2/s) + Ah_h, & ! biharmonic viscosity at thickness points [m4 s-1] + Kh_h, & ! Laplacian viscosity at thickness points [m2 s-1] + FrictWork ! energy dissipated by lateral friction [W m-2] + + real :: Ah ! biharmonic viscosity [m4 s-1] + real :: Kh ! Laplacian viscosity [m2 s-1] + real :: AhSm ! Smagorinsky biharmonic viscosity [m4 s-1] + real :: KhSm ! Smagorinsky Laplacian viscosity [m2 s-1] + real :: AhLth ! 2D Leith biharmonic viscosity [m4 s-1] + real :: KhLth ! 2D Leith Laplacian viscosity [m2 s-1] real :: mod_Leith ! nondimensional coefficient for divergence part of modified Leith ! viscosity. Here set equal to nondimensional Laplacian Leith constant. ! This is set equal to zero if modified Leith is not used. @@ -257,12 +257,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, real :: h_neglect3 ! h_neglect^3 [H3 ~> m3 or kg3 m-6] real :: hrat_min ! minimum thicknesses at the 4 neighboring ! velocity points divided by the thickness at the stress - ! point (h or q point) (nondimensional) + ! point (h or q point) [nondim] real :: visc_bound_rem ! fraction of overall viscous bounds that - ! remain to be applied (nondim) + ! remain to be applied [nondim] real :: Kh_scale ! A factor between 0 and 1 by which the horizontal - ! Laplacian viscosity is rescaled - real :: RoScl ! The scaling function for MEKE source term + ! Laplacian viscosity is rescaled [nondim] + real :: RoScl ! The scaling function for MEKE source term [nondim] real :: FatH ! abs(f) at h-point for MEKE source term [s-1] real :: local_strain ! Local variable for interpolating computed strain rates [s-1]. @@ -976,8 +976,8 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) real :: BoundCorConst ! constant (s2/m2) real :: Ah_Limit ! coefficient [s-1] used, along with the ! grid spacing, to limit biharmonic viscosity - real :: Kh ! Lapacian horizontal viscosity (m2/s) - real :: Ah ! biharmonic horizontal viscosity (m4/s) + real :: Kh ! Lapacian horizontal viscosity [m2 s-1] + real :: Ah ! biharmonic horizontal viscosity [m4 s-1] real :: Kh_vel_scale ! this speed [m s-1] times grid spacing gives Lap visc real :: Ah_vel_scale ! this speed [m s-1] times grid spacing cubed gives bih visc real :: Smag_Lap_const ! nondimensional Laplacian Smagorinsky constant @@ -991,7 +991,7 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) real :: bound_Cor_vel ! grid-scale velocity variations at which value ! the quadratically varying biharmonic viscosity ! balances Coriolis acceleration [m s-1] - real :: Kh_sin_lat ! Amplitude of latitudinally dependent viscosity (m2/s) + real :: Kh_sin_lat ! Amplitude of latitudinally dependent viscosity [m2 s-1] real :: Kh_pwr_of_sine ! Power used to raise sin(lat) when using Kh_sin_lat logical :: bound_Cor_def ! parameter setting of BOUND_CORIOLIS logical :: get_all ! If true, read and log all parameters, regardless of @@ -1618,8 +1618,8 @@ end subroutine hor_visc_init !! With n1=1 and n2=0, this recovers the approach of Large et al, 2001. subroutine align_aniso_tensor_to_grid(CS, n1, n2) type(hor_visc_CS), pointer :: CS !< Control structure for horizontal viscosity - real, intent(in) :: n1 !< i-component of direction vector (nondim) - real, intent(in) :: n2 !< j-component of direction vector (nondim) + real, intent(in) :: n1 !< i-component of direction vector [nondim] + real, intent(in) :: n2 !< j-component of direction vector [nondim] ! Local variables real :: recip_n2_norm diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 28ad7bc31f..b1714e174d 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -56,10 +56,10 @@ module MOM_lateral_mixing_coeffs logical :: calculate_Eady_growth_rate !< If true, calculate all the Eady growth rate. !! This parameter is set depending on other parameters. real, dimension(:,:), pointer :: & - SN_u => NULL(), & !< S*N at u-points (s^-1) - SN_v => NULL(), & !< S*N at v-points (s^-1) - L2u => NULL(), & !< Length scale^2 at u-points (m^2) - L2v => NULL(), & !< Length scale^2 at v-points (m^2) + SN_u => NULL(), & !< S*N at u-points [s-1] + SN_v => NULL(), & !< S*N at v-points [s-1] + L2u => NULL(), & !< Length scale^2 at u-points [m2] + L2v => NULL(), & !< Length scale^2 at v-points [m2] cg1 => NULL(), & !< The first baroclinic gravity wave speed [m s-1]. Res_fn_h => NULL(), & !< Non-dimensional function of the ratio the first baroclinic !! deformation radius to the grid spacing at h points. @@ -78,19 +78,19 @@ module MOM_lateral_mixing_coeffs beta_dx2_v => NULL(), & !< The magnitude of the gradient of the Coriolis parameter !! times the grid spacing squared at v points. f2_dx2_h => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at h, in m2 s-2. + !! spacing squared at h [m-2 s-2]. f2_dx2_q => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at q, in m2 s-2. + !! spacing squared at q [m-2 s-2]. f2_dx2_u => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at u, in m2 s-2. + !! spacing squared at u [m-2 s-2]. f2_dx2_v => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at v, in m2 s-2. - Rd_dx_h => NULL() !< Deformation radius over grid spacing (non-dim.) + !! spacing squared at v [m-2 s-2]. + Rd_dx_h => NULL() !< Deformation radius over grid spacing [nondim] real, dimension(:,:,:), pointer :: & - slope_x => NULL(), & !< Zonal isopycnal slope (non-dimensional) - slope_y => NULL(), & !< Meridional isopycnal slope (non-dimensional) - ebt_struct => NULL() !< Vertical structure function to scale diffusivities with (non-dim) + slope_x => NULL(), & !< Zonal isopycnal slope [nondim] + slope_y => NULL(), & !< Meridional isopycnal slope [nondim] + ebt_struct => NULL() !< Vertical structure function to scale diffusivities with [nondim] ! Parameters integer :: VarMix_Ktop !< Top layer to start downward integrals @@ -101,7 +101,7 @@ module MOM_lateral_mixing_coeffs real :: Res_coef_visc !< A non-dimensional number that determines the function !! of resolution, used for lateral viscosity, as: !! F = 1 / (1 + (Res_coef_visc*Ld/dx)^Res_fn_power) - real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers (m2/s) + real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [m2 s-1] integer :: Res_fn_power_khth !< The power of dx/Ld in the KhTh resolution function. Any !! positive integer power may be used, but even powers !! and especially 2 are coded to be more efficient. @@ -384,11 +384,11 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, intent(in) :: dt !< Time increment (s) + real, intent(in) :: dt !< Time increment [s] type(VarMix_CS), pointer :: CS !< Variable mixing coefficients ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & - e ! The interface heights relative to mean sea level, in m. + e ! The interface heights relative to mean sea level [Z ~> m]. real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: N2_u ! Square of Brunt-Vaisala freq at u-points [s-2] real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: N2_v ! Square of Brunt-Vaisala freq at v-points [s-2] @@ -425,13 +425,13 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: slope_x !< Zonal isoneutral slope - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: N2_u !< Brunt-Vaisala frequency at u-points (1/s2) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: N2_u !< Brunt-Vaisala frequency at u-points [s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: slope_y !< Meridional isoneutral slope - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: N2_v !< Brunt-Vaisala frequency at v-points (1/s2) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: N2_v !< Brunt-Vaisala frequency at v-points [s-2] type(VarMix_CS), pointer :: CS !< Variable mixing coefficients ! Local variables - real :: S2 ! Interface slope squared (non-dim) + real :: S2 ! Interface slope squared [nondim] real :: N2 ! Brunt-Vaisala frequency [s-1] real :: Hup, Hdn ! Thickness from above, below [H ~> m or kg m-2] real :: H_geom ! The geometric mean of Hup*Hdn [H ~> m or kg m-2]. @@ -587,7 +587,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop real :: H_cutoff ! Local estimate of a minimum thickness for masking [H ~> m or kg m-2] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: S2 ! Interface slope squared (non-dim) + real :: S2 ! Interface slope squared [nondim] real :: N2 ! Brunt-Vaisala frequency [s-1] real :: Hup, Hdn ! Thickness from above, below [H ~> m or kg m-2] real :: H_geom ! The geometric mean of Hup*Hdn [H ~> m or kg m-2]. diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index d9837e1875..94c02cf2b4 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -166,7 +166,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp (dt*(G%IdxCv(i,J)*G%IdxCv(i,J) + G%IdyCv(i,J)*G%IdyCv(i,J))) enddo ; enddo - ! Calculates interface heights, e, in m. + ! Calculates interface heights, e, in [Z ~> m]. call find_eta(h, tv, G, GV, US, e, halo_size=1) ! Set the diffusivities. @@ -1225,10 +1225,10 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! region where the detangling is applied [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & Kh_lay_u ! The tentative interface height diffusivity for each layer at - ! u points, in m2 s-1. + ! u points [m2 s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & Kh_lay_v ! The tentative interface height diffusivity for each layer at - ! v points, in m2 s-1. + ! v points [m2 s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & de_bot ! The distances from the bottom of the region where the ! detangling is applied [H ~> m or kg m-2]. @@ -1241,7 +1241,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! normalized by the arithmetic mean thickness. real :: Kh_scale ! A ratio by which Kh_u_CFL is scaled for maximally jagged ! layers [nondim]. - real :: Kh_det ! The detangling diffusivity, in m2 s-1. + real :: Kh_det ! The detangling diffusivity [m2 s-1]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -1252,8 +1252,8 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV real :: IRsl ! The (limited) inverse of Rsl [nondim]. 1 < IRsl <= 1e9. real :: dH ! The thickness gradient divided by the damping timescale ! and the ratio of the face length to the adjacent cell - ! areas for comparability with the diffusivities, in m2 s-1. - real :: adH ! The absolute value of dH, in m2 s-1. + ! areas for comparability with the diffusivities [m2 s-1]. + real :: adH ! The absolute value of dH [m2 s-1]. real :: sign ! 1 or -1, with the same sign as the layer thickness gradient. real :: sl_K ! The sign-corrected slope of the interface above [nondim]. real :: sl_Kp1 ! The sign-corrected slope of the interface below [nondim]. @@ -1263,22 +1263,22 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! the damping timescale [s-1]. real :: Fn_R ! A function of Rsl, such that Rsl < Fn_R < 1. real :: denom, I_denom ! A denominator and its inverse, various units. - real :: Kh_min ! A local floor on the diffusivity, in m2 s-1. - real :: Kh_max ! A local ceiling on the diffusivity, in m2 s-1. + real :: Kh_min ! A local floor on the diffusivity [m2 s-1]. + real :: Kh_max ! A local ceiling on the diffusivity [m2 s-1]. real :: wt1, wt2 ! Nondimensional weights. ! Variables used only in testing code. ! real, dimension(SZK_(G)) :: uh_here ! real, dimension(SZK_(G)+1) :: Sfn - real :: dKh ! An increment in the diffusivity, in m2 s-1. + real :: dKh ! An increment in the diffusivity [m2 s-1]. real, dimension(SZIB_(G),SZK_(G)+1) :: & - Kh_bg, & ! The background (floor) value of Kh, in m2 s-1. - Kh, & ! The tentative value of Kh, in m2 s-1. - Kh_detangle, & ! The detangling diffusivity that could be used, in m2 s-1. + Kh_bg, & ! The background (floor) value of Kh [m2 s-1]. + Kh, & ! The tentative value of Kh [m2 s-1]. + Kh_detangle, & ! The detangling diffusivity that could be used [m2 s-1]. Kh_min_max_p, & ! The smallest ceiling that can be placed on Kh(I,K) - ! based on the value of Kh(I,K+1), in m2 s-1. + ! based on the value of Kh(I,K+1) [m2 s-1]. Kh_min_max_m, & ! The smallest ceiling that can be placed on Kh(I,K) - ! based on the value of Kh(I,K-1), in m2 s-1. + ! based on the value of Kh(I,K-1) [m2 s-1]. ! The following are variables that define the relationships between ! successive values of Kh. ! Search for Kh that satisfy... @@ -1287,13 +1287,13 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Kh(I,K) <= Kh_max_m(I,K)*Kh(I,K-1) + Kh0_max_m(I,K) ! Kh(I,K) <= Kh_max_p(I,K)*Kh(I,K+1) + Kh0_max_p(I,K) Kh_min_m , & ! See above [nondim]. - Kh0_min_m , & ! See above, in m2 s-1. + Kh0_min_m , & ! See above [m2 s-1]. Kh_max_m , & ! See above [nondim]. - Kh0_max_m, & ! See above, in m2 s-1. + Kh0_max_m, & ! See above [m2 s-1]. Kh_min_p , & ! See above [nondim]. - Kh0_min_p , & ! See above, in m2 s-1. + Kh0_min_p , & ! See above [m2 s-1]. Kh_max_p , & ! See above [nondim]. - Kh0_max_p ! See above, in m2 s-1. + Kh0_max_p ! See above [m2 s-1]. real, dimension(SZIB_(G)) :: & Kh_max_max ! The maximum diffusivity permitted in a column. logical, dimension(SZIB_(G)) :: & diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index 07d6216be1..e636672817 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -170,27 +170,27 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_T !< Interface double diffusion diapycnal - !! diffusivity for temp (Z2/sec). + !! diffusivity for temp [Z2 s-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_S !< Interface double diffusion diapycnal - !! diffusivity for salt (Z2/sec). + !! diffusivity for salt [Z2 s-1 ~> m2 s-1]. type(CVMix_ddiff_cs), pointer :: CS !< The control structure returned !! by a previous call to CVMix_ddiff_init. integer, intent(in) :: j !< Meridional grid indice. ! Local variables real, dimension(SZK_(G)) :: & - cellHeight, & !< Height of cell centers (m) + cellHeight, & !< Height of cell centers [m] dRho_dT, & !< partial derivatives of density wrt temp [kg m-3 degC-1] dRho_dS, & !< partial derivatives of density wrt saln [kg m-3 ppt-1] - pres_int, & !< pressure at each interface (Pa) - temp_int, & !< temp and at interfaces (degC) - salt_int, & !< salt at at interfaces + pres_int, & !< pressure at each interface [Pa] + temp_int, & !< temp and at interfaces [degC] + salt_int, & !< salt at at interfaces [ppt] alpha_dT, & !< alpha*dT across interfaces beta_dS, & !< beta*dS across interfaces - dT, & !< temp. difference between adjacent layers (degC) - dS !< salt difference between adjacent layers + dT, & !< temp. difference between adjacent layers [degC] + dS !< salt difference between adjacent layers [ppt] real, dimension(SZK_(G)+1) :: & - Kd1_T, & !< Diapycanal diffusivity of temperature, in m2 s-1. - Kd1_S !< Diapycanal diffusivity of salinity, in m2 s-1. + Kd1_T, & !< Diapycanal diffusivity of temperature [m2 s-1]. + Kd1_S !< Diapycanal diffusivity of salinity [m2 s-1]. real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) integer :: kOBL !< level of OBL extent diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index ec5d7dc5c0..8c35442461 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -270,7 +270,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS u, & ! The zonal velocity [m s-1]. v ! The meridional velocity [m s-1]. real, dimension(SZI_(G),SZK_(GV)+1) :: & - Kd, & ! The diapycnal diffusivity, in m2 s-1. + Kd, & ! The diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. pres, & ! Interface pressures [Pa]. pres_Z, & ! Interface pressures with a rescaling factor to convert interface height ! movements into changes in column potential energy [J m-2 Z-1 ~> J m-3]. @@ -1632,13 +1632,13 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real :: hps ! The sum of the two effective pivot thicknesses [H ~> m or kg m-2]. real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term [H2 ~> m2 or kg2 m-4]. - real :: dT_c ! The core term in the expressions for the temperature changes [degC H ~> degC m or degC kg m-2]2. - real :: dS_c ! The core term in the expressions for the salinity changes, in psu H2. + real :: dT_c ! The core term in the expressions for the temperature changes [degC H2 ~> degC m2 or degC kg2 m-4]. + real :: dS_c ! The core term in the expressions for the salinity changes [ppt H2 ~> ppt m2 or ppt kg2 m-4]. real :: PEc_core ! The diffusivity-independent core term in the expressions - ! for the potential energy changes, J m-3. + ! for the potential energy changes [J m-3]. real :: ColHt_core ! The diffusivity-independent core term in the expressions - ! for the column height changes, J m-3. - real :: ColHt_chg ! The change in the column height, in m. + ! for the column height changes [J m-3]. + real :: ColHt_chg ! The change in the column height [H ~> m or kg m-2]. real :: y1 ! A local temporary term, in units of H-3 or H-4 in various contexts. ! The expression for the change in potential energy used here is derived @@ -1777,7 +1777,7 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & ! reversed. real :: b1 ! b1 is used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. - real :: b1Kd ! Temporary array (nondim.) + real :: b1Kd ! Temporary array [nondim] real :: ColHt_chg ! The change in column thickness [Z ~> m]. real :: dColHt_max ! The change in column thickness for infinite diffusivity [Z ~> m]. real :: dColHt_dKd ! The partial derivative of column thickness with diffusivity [s Z-1 ~> s m-1]. @@ -1857,7 +1857,7 @@ subroutine energetic_PBL_get_MLD(CS, MLD, G, US, m_to_MLD_units) type(energetic_PBL_CS), pointer :: CS !< Control structure for ePBL type(ocean_grid_type), intent(in) :: G !< Grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: MLD !< Depth of ePBL active mixing layer, in m + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: MLD !< Depth of ePBL active mixing layer [m or other units] real, optional, intent(in) :: m_to_MLD_units !< A conversion factor to the desired units for MLD ! Local variables real :: scale ! A dimensional rescaling factor @@ -2019,16 +2019,9 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic output type(energetic_PBL_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module -! This include declares and sets the variable "version". -#include "version_variable.h" + ! Local variables + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_energetic_PBL" ! This module's name. real :: omega_frac_dflt integer :: isd, ied, jsd, jed diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index b4eab1c9ea..3037f49e0b 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -431,7 +431,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ u, & ! The zonal velocity after a timestep of mixing [m s-1]. v, & ! The meridional velocity after a timestep of mixing [m s-1]. Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. - T, & ! The potential temperature after a timestep of mixing, in C. + T, & ! The potential temperature after a timestep of mixing [degC]. Sal, & ! The salinity after a timestep of mixing [PSU]. dz, & ! The layer thickness [Z ~> m]. u0xdz, & ! The initial zonal velocity times dz [m Z s-1 ~> m2 s-1]. @@ -1415,7 +1415,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! TKE of the layer above when all the kappas below are 0. ! e1 is nondimensional, and 0 < e1 < 1. real :: tke_src ! The net source of TKE due to mixing against the shear - ! and stratification, in m2 s-3. (For convenience, + ! and stratification [m2 s-3]. (For convenience, ! a term involving the non-dissipation of q0 is also ! included here.) real :: bQ, bK ! The inverse of the pivot in the tridiagonal equations [Z-1 ~> m-1]. diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index caf6c52ee5..00945505ed 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -183,7 +183,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: U_bg_sq ! The square of an assumed background ! velocity, for calculating the mean ! magnitude near the bottom for use in the - ! quadratic bottom drag, in m2 s-2. + ! quadratic bottom drag [m2 s-2]. real :: hwtot ! Sum of the thicknesses used to calculate ! the near-bottom velocity magnitude [H ~> m or kg m-2]. real :: hutot ! Running sum of thicknesses times the @@ -242,7 +242,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: ustH ! ustar converted to units of H s-1 [H s-1 ~> m s-1 or kg m-2 s-1]. real :: root ! A temporary variable [H s-1 ~> m s-1 or kg m-2 s-1]. - real :: Cell_width ! The transverse width of the velocity cell, in m. + real :: Cell_width ! The transverse width of the velocity cell [m]. real :: Rayleigh ! A nondimensional value that is multiplied by the layer's ! velocity magnitude to give the Rayleigh drag velocity, times ! a lateral to vertical distance conversion factor [Z L-1 ~> 1]. @@ -1074,7 +1074,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real :: u_at_v ! The zonal velocity at a meridonal velocity point [m s-1]. real :: gHprime ! The mixed-layer internal gravity wave speed squared, based ! on the mixed layer thickness and density difference across - ! the base of the mixed layer, in m2 s-2. + ! the base of the mixed layer [m2 s-2]. real :: RiBulk ! The bulk Richardson number below which water is in the ! viscous mixed layer, including reduction for turbulent ! decay. Nondimensional. @@ -1097,7 +1097,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! the present layer [H ~> m or kg m-2]. real :: U_bg_sq ! The square of an assumed background velocity, for ! calculating the mean magnitude near the top for use in - ! the quadratic surface drag, in m2 s-2. + ! the quadratic surface drag [m2 s-2]. real :: h_tiny ! A very small thickness [H ~> m or kg m-2]. Layers that are less than ! h_tiny can not be the deepest in the viscous mixed layer. real :: absf ! The absolute value of f averaged to velocity points, s-1. diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 178eeff516..94eb79eca1 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -40,11 +40,11 @@ module MOM_vert_friction real :: Hmix !< The mixed layer thickness in thickness units [H ~> m or kg m-2]. real :: Hmix_stress !< The mixed layer thickness over which the wind !! stress is applied with direct_stress [H ~> m or kg m-2]. - real :: Kvml !< The mixed layer vertical viscosity in m2 s-1. - real :: Kv !< The interior vertical viscosity in m2 s-1. + real :: Kvml !< The mixed layer vertical viscosity [Z2 s-1 ~> m2 s-1]. + real :: Kv !< The interior vertical viscosity [Z2 s-1 ~> m2 s-1]. real :: Hbbl !< The static bottom boundary layer thickness [H ~> m or kg m-2]. real :: Kvbbl !< The vertical viscosity in the bottom boundary - !! layer, in m2 s-1. + !! layer [Z2 s-1 ~> m2 s-1]. real :: maxvel !< Velocity components greater than maxvel are truncated [m s-1]. real :: vel_underflow !< Velocity components smaller than vel_underflow @@ -601,10 +601,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) real, dimension(SZIB_(G)) :: & kv_bbl, & ! The bottom boundary layer viscosity [Z2 s-1 ~> m2 s-1]. bbl_thick, & ! The bottom boundary layer thickness [H ~> m or kg m-2]. - I_Hbbl, & ! The inverse of the bottom boundary layer thickness, in units - ! of H-1 (i.e., m-1 or m2 kg-1). - I_Htbl, & ! The inverse of the top boundary layer thickness, in units - ! of H-1 (i.e., m-1 or m2 kg-1). + I_Hbbl, & ! The inverse of the bottom boundary layer thickness [H-1 ~> m-1 or m2 kg-1]. + I_Htbl, & ! The inverse of the top boundary layer thickness [H-1 ~> m-1 or m2 kg-1]. zcol1, & ! The height of the interfaces to the north and south of a zcol2, & ! v-point [H ~> m or kg m-2]. Ztop_min, & ! The deeper of the two adjacent surface heights [H ~> m or kg m-2]. @@ -613,10 +611,10 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) zh, & ! An estimate of the interface's distance from the bottom ! based on harmonic mean thicknesses [H ~> m or kg m-2]. h_ml ! The mixed layer depth [H ~> m or kg m-2]. - real, allocatable, dimension(:,:) :: hML_u ! Diagnostic of the mixed layer depth at u points, in m. - real, allocatable, dimension(:,:) :: hML_v ! Diagnostic of the mixed layer depth at v points, in m. - real, allocatable, dimension(:,:,:) :: Kv_u !< Total vertical viscosity at u-points, in m2 s-1. - real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points, in m2 s-1. + real, allocatable, dimension(:,:) :: hML_u ! Diagnostic of the mixed layer depth at u points [H ~> m or kg m-2]. + real, allocatable, dimension(:,:) :: hML_v ! Diagnostic of the mixed layer depth at v points [H ~> m or kg m-2]. + real, allocatable, dimension(:,:,:) :: Kv_u !< Total vertical viscosity at u-points [Z2 s-1 ~> m2 s-1]. + real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points [Z2 s-1 ~> m2 s-1]. real :: zcol(SZI_(G)) ! The height of an interface at h-points [H ~> m or kg m-2]. real :: botfn ! A function which goes from 1 at the bottom to 0 much more ! than Hbbl into the interior. @@ -1072,7 +1070,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! h_ml, & ! The mixed layer depth [H ~> m or kg m-2]. nk_visc, & ! The (real) interface index of the base of mixed layer. z_t, & ! The distance from the top, sometimes normalized - ! by Hmix, in H or nondimensional. + ! by Hmix, [H ~> m or kg m-2] or [nondim]. kv_tbl, & ! The viscosity in a top boundary layer under ice [Z2 s-1 ~> m2 s-1]. tbl_thick real, dimension(SZIB_(G),SZK_(GV)) :: & @@ -1579,8 +1577,8 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & ! Local variables real :: hmix_str_dflt - real :: Kv_dflt ! A default viscosity in m2 s-1. - real :: Hmix_m ! A boundary layer thickness, in m. + real :: Kv_dflt ! A default viscosity [m2 s-1]. + real :: Hmix_m ! A boundary layer thickness [m]. integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz ! This include declares and sets the variable "version". #include "version_variable.h" diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 7884823acc..efd8ea2e2d 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -123,26 +123,26 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla real, dimension(SZI_(G),SZJ_(G)) :: & Ihdxdy, & ! The inverse of the volume or mass of fluid in a layer in a - ! grid cell, in m-3 or kg-1. - Kh_h, & ! The tracer diffusivity averaged to tracer points, in m2 s-1. + ! grid cell [H-1 m-2 ~> m-3 or kg-1]. + Kh_h, & ! The tracer diffusivity averaged to tracer points [m2 s-1]. CFL, & ! A diffusive CFL number for each cell [nondim]. dTr ! The change in a tracer's concentration, in units of - ! concentration. + ! concentration [Conc]. real, dimension(SZIB_(G),SZJ_(G)) :: & khdt_x, & ! The value of Khtr*dt times the open face width divided by - ! the distance between adjacent tracer points, in m2. + ! the distance between adjacent tracer points [m2]. Coef_x, & ! The coefficients relating zonal tracer differences ! to time-integrated fluxes [H m2 ~> m3 or kg]. - Kh_u ! Tracer mixing coefficient at u-points, in m2 s-1. + Kh_u ! Tracer mixing coefficient at u-points [m2 s-1]. real, dimension(SZI_(G),SZJB_(G)) :: & khdt_y, & ! The value of Khtr*dt times the open face width divided by - ! the distance between adjacent tracer points, in m2. + ! the distance between adjacent tracer points [m2]. Coef_y, & ! The coefficients relating meridional tracer differences ! to time-integrated fluxes [H m2 ~> m3 or kg]. - Kh_v ! Tracer mixing coefficient at u-points, in m2 s-1. + Kh_v ! Tracer mixing coefficient at u-points [m2 s-1]. - real :: khdt_max ! The local limiting value of khdt_x or khdt_y, in m2. + real :: khdt_max ! The local limiting value of khdt_x or khdt_y [m2]. real :: max_CFL ! The global maximum of the diffusive CFL number. logical :: use_VarMix, Resoln_scaled, do_online, use_Eady integer :: S_idx, T_idx ! Indices for temperature and salinity if needed @@ -152,8 +152,8 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla ! layer for this iteration [nondim]. real :: Idt ! The inverse of the time step [s-1]. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m. - real :: Kh_loc ! The local value of Kh, in m2 s-1. + ! in roundoff and can be neglected [H ~> m or kg m-2]. + real :: Kh_loc ! The local value of Kh [m2 s-1]. real :: Res_Fn ! The local value of the resolution function [nondim]. real :: Rd_dx ! The local value of deformation radius over grid-spacing [nondim]. real :: normalize ! normalization used for diagnostic Kh_h; diffusivity averaged to h-points. @@ -575,7 +575,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & k0b_Rv, k0a_Rv ! in each pair of mixing at v-faces. real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & - tr_flux_conv ! The flux convergence of tracers, in TR m3 or TR kg. + tr_flux_conv ! The flux convergence of tracers [conc H m2 ~> conc m3 or conc kg] real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: Tr_flux_3d, Tr_adj_vert_L, Tr_adj_vert_R real, dimension(SZI_(G), SZK_(G), SZJ_(G)) :: & @@ -614,14 +614,14 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & real :: I_maxitt ! The inverse of the maximum number of iterations. real :: rho_pair, rho_a, rho_b ! Temporary densities [kg m-3]. real :: Tr_min_face ! The minimum and maximum tracer concentrations - real :: Tr_max_face ! associated with a pairing, in conc. + real :: Tr_max_face ! associated with a pairing [Conc] real :: Tr_La, Tr_Lb ! The 4 tracer concentrations that might be - real :: Tr_Ra, Tr_Rb ! associated with a pairing, in conc. + real :: Tr_Ra, Tr_Rb ! associated with a pairing [Conc] real :: Tr_av_L ! The average tracer concentrations on the left and right - real :: Tr_av_R ! sides of a pairing, in conc. - real :: Tr_flux ! The tracer flux from left to right in a pair, in conc m3. + real :: Tr_av_R ! sides of a pairing [Conc]. + real :: Tr_flux ! The tracer flux from left to right in a pair [conc H m2 ~> conc m3 or conc kg]. real :: Tr_adj_vert ! A downward vertical adjustment to Tr_flux between the - ! two cells that make up one side of the pairing, in conc m3. + ! two cells that make up one side of the pairing [conc H m2 ~> conc m3 or conc kg]. real :: h_L, h_R ! Thicknesses to the left and right [H ~> m or kg m-2]. real :: wt_a, wt_b ! Fractional weights of layers above and below [nondim]. real :: vol ! A cell volume or mass [H m2 ~> m3 or kg]. diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 811d8ca5b6..5bf7584cb7 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -67,7 +67,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) !! returned by a previous call to !! BFB_surface_forcing_init. ! Local variables - real :: Temp_restore ! The temperature that is being restored toward, in C. + real :: Temp_restore ! The temperature that is being restored toward [degC]. real :: Salin_restore ! The salinity that is being restored toward [PSU]. real :: density_restore ! The potential density that is being restored ! toward [kg m-3]. diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 47d9b7b6fe..260512ecfa 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -692,14 +692,14 @@ end subroutine Update_Stokes_Drift !! using the data_override procedures. subroutine Surface_Bands_by_data_override(day_center, G, GV, US, CS) use NETCDF - type(time_type), intent(in) :: day_center !< Center of timestep (s) + type(time_type), intent(in) :: day_center !< Center of timestep type(wave_parameters_CS), pointer :: CS !< Wave structure type(ocean_grid_type), intent(inout) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal and psuedo-meridional - real :: temp_y(SZI_(G),SZJ_(G)) ! Stokes drift of band at h-points, in m/s + real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal Stokes drift of band at h-points [m s-1] + real :: temp_y(SZI_(G),SZJ_(G)) ! Psuedo-meridional Stokes drift of band at h-points [m s-1] real :: Top, MidPoint integer :: b integer :: i, j From 00b3289fa71118fd5f482f801bbbdeb5f38f41e3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 21 Dec 2018 20:00:09 -0500 Subject: [PATCH 0975/1072] Documented units of 110 core variables Changed comments to use the square bracket notation to document the units of about 110 core directory variables. Only comments have been changed and all answers are bitwise identical. --- src/core/MOM.F90 | 12 ++-- src/core/MOM_CoriolisAdv.F90 | 4 +- src/core/MOM_PressureForce_Montgomery.F90 | 2 +- src/core/MOM_barotropic.F90 | 43 +++++++------ src/core/MOM_continuity_PPM.F90 | 28 ++++----- src/core/MOM_forcing_type.F90 | 73 ++++++++++++----------- src/core/MOM_grid.F90 | 68 ++++++++++----------- src/core/MOM_variables.F90 | 4 +- 8 files changed, 119 insertions(+), 115 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 08e33c27db..b5490ab497 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -168,12 +168,12 @@ module MOM !< A running time integral of the sea surface height [s m]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ave_ssh_ibc !< time-averaged (over a forcing time step) sea surface height - !! with a correction for the inverse barometer (meter) + !! with a correction for the inverse barometer [m] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_av_bc !< free surface height or column mass time averaged over the last !! baroclinic dynamics time step [H ~> m or kg m-2] real, dimension(:,:), pointer :: & - Hml => NULL() !< active mixed layer depth, in m + Hml => NULL() !< active mixed layer depth [m] real :: time_in_cycle !< The running time of the current time-stepping cycle !! in calls that step the dynamics, and also the length of !! the time integral of ssh_rint [s]. @@ -2912,7 +2912,7 @@ subroutine extract_surface_state(CS, sfc_state) sfc_state%melt_potential(i,j) = 0.0 if (G%mask2dT(i,j)>0.) then - ! instantaneous melt_potential, in J/m^2 + ! instantaneous melt_potential [J m-2] sfc_state%melt_potential(i,j) = CS%tv%C_p * CS%GV%Rho0 * delT(i) endif enddo @@ -3072,9 +3072,9 @@ end subroutine get_MOM_state_elements !> Find the global integrals of various quantities. subroutine get_ocean_stocks(CS, mass, heat, salt, on_PE_only) type(MOM_control_struct), pointer :: CS !< MOM control structure - real, optional, intent(out) :: heat !< The globally integrated integrated ocean heat, in J. - real, optional, intent(out) :: salt !< The globally integrated integrated ocean salt, in kg. - real, optional, intent(out) :: mass !< The globally integrated integrated ocean mass, in kg. + real, optional, intent(out) :: heat !< The globally integrated integrated ocean heat [J]. + real, optional, intent(out) :: salt !< The globally integrated integrated ocean salt [kg]. + real, optional, intent(out) :: mass !< The globally integrated integrated ocean mass [kg]. logical, optional, intent(in) :: on_PE_only !< If present and true, only sum on the local PE. if (present(mass)) & diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 85ae345bfc..450d71d23e 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -138,7 +138,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) ! and use the indexing of the corresponding u point. real, dimension(SZI_(G),SZJ_(G)) :: & - Area_h, & ! The ocean area at h points, in m2. Area_h is used to find the + Area_h, & ! The ocean area at h points [m2]. Area_h is used to find the ! average thickness in the denominator of q. 0 for land points. KE ! Kinetic energy per unit mass [m2 s-2], KE = (u^2 + v^2)/2. real, dimension(SZIB_(G),SZJ_(G)) :: & @@ -179,7 +179,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) real :: absolute_vorticity ! Absolute vorticity [s-1]. real :: relative_vorticity ! Relative vorticity [s-1]. real :: Ih ! Inverse of thickness [H-1 ~> m-1 or m2 kg-1]. - real :: max_Ihq, min_Ihq ! The maximum and minimum of the nearby Ihq. + real :: max_Ihq, min_Ihq ! The maximum and minimum of the nearby Ihq [H-1 ~> m-1 or m2 kg-1]. real :: hArea_q ! The sum of area times thickness of the cells ! surrounding a q point [H m2 ~> m3 or kg]. real :: h_neglect ! A thickness that is so small it is usually diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 986a5cdb48..eded96fa65 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -398,7 +398,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ! forces from astronomical sources and self- ! attraction and loading, in depth units [Z ~> m]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate - ! density, in Pa (usually 2e7 Pa = 2000 dbar). + ! density [Pa] (usually 2e7 Pa = 2000 dbar). real :: I_Rho0 ! 1/Rho0 [m3 kg-1]. real :: G_Rho0 ! G_Earth / Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. real :: PFu_bc, PFv_bc ! The pressure gradient force due to along-layer diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 889cce741d..cdc5ed0251 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -114,7 +114,7 @@ module MOM_barotropic !< The barotropic solvers estimate of the zonal velocity that will be the initial !! condition for the next call to btstep [m s-1]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: ubtav - !< The barotropic zonal velocity averaged over the baroclinic time step, m s-1. + !< The barotropic zonal velocity averaged over the baroclinic time step [m s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: IDatv !< Inverse of the basin depth at v grid points [Z-1 ~> m-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: lin_drag_v @@ -127,7 +127,7 @@ module MOM_barotropic !< The barotropic solvers estimate of the zonal velocity that will be the initial !! condition for the next call to btstep [m s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vbtav - !< The barotropic meridional velocity averaged over the baroclinic time step, m s-1. + !< The barotropic meridional velocity averaged over the baroclinic time step [m s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_cor !< The difference between the free surface height from the barotropic calculation and the sum !! of the layer thicknesses. This difference is imposed as a forcing term in the barotropic @@ -138,18 +138,18 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: & ua_polarity, & !< Test vector components for checking grid polarity. va_polarity, & !< Test vector components for checking grid polarity. - bathyT !< A copy of bathyT (ocean bottom depth) with wide halos, in depth units + bathyT !< A copy of bathyT (ocean bottom depth) with wide halos [Z ~> m] real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: IareaT !< This is a copy of G%IareaT with wide halos, but will !! still utilize the macro IareaT when referenced, m-2. real ALLOCABLE_, dimension(NIMEMBW_,NJMEMW_) :: & D_u_Cor, & !< A simply averaged depth at u points [Z ~> m]. - dy_Cu, & !< A copy of G%dy_Cu with wide halos, in m. - IdxCu !< A copy of G%IdxCu with wide halos, in m-1. + dy_Cu, & !< A copy of G%dy_Cu with wide halos [m]. + IdxCu !< A copy of G%IdxCu with wide halos [m-1]. real ALLOCABLE_, dimension(NIMEMW_,NJMEMBW_) :: & D_v_Cor, & !< A simply averaged depth at v points [Z ~> m]. - dx_Cv, & !< A copy of G%dx_Cv with wide halos, in m. - IdyCv !< A copy of G%IdyCv with wide halos, in m-1. + dx_Cv, & !< A copy of G%dx_Cv with wide halos [m]. + IdyCv !< A copy of G%IdyCv with wide halos [m-1]. real ALLOCABLE_, dimension(NIMEMBW_,NJMEMBW_) :: & q_D !< f / D at PV points [Z-1 s-1 ~> m-1 s-1]. @@ -159,8 +159,7 @@ module MOM_barotropic type(BT_OBC_type) :: BT_OBC !< A structure with all of this modules fields !! for applying open boundary conditions. - real :: Rho0 !< The density used in the Boussinesq - !! approximation [kg m-3 ~> m or kg m-2]. + real :: Rho0 !< The density used in the Boussinesq approximation [kg m-3]. real :: dtbt !< The barotropic time step [s]. real :: dtbt_fraction !< The fraction of the maximum time-step that !! should used. The default is 0.98. @@ -210,11 +209,10 @@ module MOM_barotropic logical :: dynamic_psurf !< If true, add a dynamic pressure due to a viscous !! ice shelf, for instance. real :: Dmin_dyn_psurf !< The minimum depth to use in limiting the size - !! of the dynamic surface pressure for stability, - !! in m. + !! of the dynamic surface pressure for stability [m]. real :: ice_strength_length !< The length scale at which the damping rate !! due to the ice strength should be the same as if - !! a Laplacian were applied, in m. + !! a Laplacian were applied [m]. real :: const_dyn_psurf !< The constant that scales the dynamic surface !! pressure, nondim. Stable values are < ~1.0. !! The default is 0.9. @@ -596,7 +594,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! than physical problem would suggest. real :: Instep ! The inverse of the number of barotropic time steps ! to take. - real :: wt_end ! The weighting of the final value of eta_PF, ND. + real :: wt_end ! The weighting of the final value of eta_PF [nondim] integer :: nstep ! The number of barotropic time steps to take. type(time_type) :: & time_bt_start, & ! The starting time of the barotropic steps. @@ -2394,18 +2392,18 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: uhbt !< the zonal barotropic transport !! [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_trans !< the zonal barotropic velocity used in - !! transport, m s-1. + !! transport [m s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt !< the meridional barotropic velocity [m s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vhbt !< the meridional barotropic transport !! [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt_trans !< the meridional BT velocity used in transports, - !! m s-1. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt_trans !< the meridional BT velocity used in + !! transports [m s-1]. real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or !! column mass anomaly [H ~> m or kg m-2]. - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: ubt_old !< The starting value of ubt in a barotropic step, - !! m s-1. - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vbt_old !< The starting value of vbt in a barotropic step, - !! m s-1. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: ubt_old !< The starting value of ubt in a barotropic + !! step [m s-1]. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vbt_old !< The starting value of vbt in a barotropic + !! step [m s-1]. type(BT_OBC_type), intent(in) :: BT_OBC !< A structure with the private barotropic arrays !! related to the open boundary conditions, !! set by set_up_BT_OBC. @@ -2440,7 +2438,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, ! that does the mass transport [m s-1]. real :: H_u ! The total thickness at the u-point [H ~> m or kg m-2]. real :: H_v ! The total thickness at the v-point [H ~> m or kg m-2]. - real :: cfl ! The CFL number at the point in question, ND. + real :: cfl ! The CFL number at the point in question [nondim] real :: u_inlet real :: v_inlet real :: h_in @@ -3636,7 +3634,8 @@ subroutine bt_mass_source(h, eta, set_cor, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The free surface height that is to be corrected, in m. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The free surface height that is to be + !! corrected [H ~> m or kg m-2]. logical, intent(in) :: set_cor !< A flag to indicate whether to set the corrective !! fluxes (and update the slowly varying part of eta_cor) !! (.true.) or whether to incrementally update the diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 0dfcfbdc12..3f6b699b20 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -43,7 +43,7 @@ module MOM_continuity_PPM !! discrepancies between the barotropic solution and !! the sum of the layer thicknesses when calculating !! the auxiliary corrected velocities [H ~> m or kg m-2]. - real :: CFL_limit_adjust !< The maximum CFL of the adjusted velocities, ND. + real :: CFL_limit_adjust !< The maximum CFL of the adjusted velocities [nondim] logical :: aggress_adjust !< If true, allow the adjusted velocities to have a !! relative CFL change up to 0.5. False by default. logical :: vol_CFL !< If true, use the ratio of the open face lengths @@ -285,7 +285,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & ! the time step [s-1]. real :: I_dt ! 1.0 / dt [s-1]. real :: du_lim ! The velocity change that give a relative CFL of 1 [m s-1]. - real :: dx_E, dx_W ! Effective x-grid spacings to the east and west, in m. + real :: dx_E, dx_W ! Effective x-grid spacings to the east and west [m]. integer :: i, j, k, ish, ieh, jsh, jeh, n, nz logical :: do_aux, local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC logical :: local_Flather_OBC, local_open_BC, is_simple @@ -562,7 +562,7 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, & !! ratio of face areas to the cell areas when estimating the CFL number. type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables - real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. + real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim] real :: curv_3 ! A measure of the thickness curvature over a grid length, ! with the same units as h_in. real :: h_marg ! The marginal thickness of a flux [H ~> m or kg m-2]. @@ -639,7 +639,7 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, & type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables - real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. + real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim] real :: curv_3 ! A measure of the thickness curvature over a grid length, ! with the same units as h_in. real :: h_avg ! The average thickness of a flux [H ~> m or kg m-2]. @@ -918,7 +918,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, !! which I values to work on. ! Local variables real, dimension(SZIB_(G)) :: & - du0, & ! The barotropic velocity increment that gives 0 transport, m s-1. + du0, & ! The barotropic velocity increment that gives 0 transport [m s-1]. duL, duR, & ! The barotropic velocity increments that give the westerly ! (duL) and easterly (duR) test velocities. zeros, & ! An array of full of 0's. @@ -934,10 +934,10 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, FAmt_0, & ! test velocities [H m ~> m2 or kg m-1]. uhtot_L, & ! The summed transport with the westerly (uhtot_L) and uhtot_R ! and easterly (uhtot_R) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: FA_0 ! The effective face area with 0 barotropic transport, in m H. - real :: FA_avg ! The average effective face area, in m H, nominally given by + real :: FA_0 ! The effective face area with 0 barotropic transport [m H ~> m2 or kg m]. + real :: FA_avg ! The average effective face area [m H ~> m2 or kg m], nominally given by ! the realized transport divided by the barotropic velocity. - real :: visc_rem_lim ! The larger of visc_rem and min_visc_rem, ND. This + real :: visc_rem_lim ! The larger of visc_rem and min_visc_rem [nondim] This ! limiting is necessary to keep the inverse of visc_rem ! from leading to large CFL numbers. real :: min_visc_rem ! The smallest permitted value for visc_rem that is used @@ -945,7 +945,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, ! flow direction. This is necessary to keep the inverse ! of visc_rem from leading to large CFL numbers. real :: CFL_min ! A minimal increment in the CFL to try to ensure that the - ! flow is truly upwind, ND. + ! flow is truly upwind [nondim] real :: Idt ! The inverse of the time step [s-1]. logical :: domore integer :: i, k, nz @@ -1382,7 +1382,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, & !! ratio of face areas to the cell areas when estimating the CFL number. type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables - real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. + real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim] real :: curv_3 ! A measure of the thickness curvature over a grid length, ! with the same units as h, i.e. [H ~> m or kg m-2]. real :: h_marg ! The marginal thickness of a flux [H ~> m or kg m-2]. @@ -1460,7 +1460,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables - real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. + real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim] real :: curv_3 ! A measure of the thickness curvature over a grid length, ! with the same units as h_in. real :: h_avg ! The average thickness of a flux [H ~> m or kg m-2]. @@ -1756,7 +1756,7 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, real :: FA_0 ! The effective face area with 0 barotropic transport [H m ~> m2 or kg m-1]. real :: FA_avg ! The average effective face area [H m ~> m2 or kg m-1], nominally given by ! the realized transport divided by the barotropic velocity. - real :: visc_rem_lim ! The larger of visc_rem and min_visc_rem, ND. This + real :: visc_rem_lim ! The larger of visc_rem and min_visc_rem [nondim] This ! limiting is necessary to keep the inverse of visc_rem ! from leading to large CFL numbers. real :: min_visc_rem ! The smallest permitted value for visc_rem that is used @@ -1764,7 +1764,7 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, ! flow direction. This is necessary to keep the inverse ! of visc_rem from leading to large CFL numbers. real :: CFL_min ! A minimal increment in the CFL to try to ensure that the - ! flow is truly upwind, ND. + ! flow is truly upwind [nondim] real :: Idt ! The inverse of the time step [s-1]. logical :: domore integer :: i, k, nz @@ -2246,7 +2246,7 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) type(continuity_PPM_CS), pointer :: CS !< Module's control structure. !> This include declares and sets the variable "version". #include "version_variable.h" - real :: tol_eta_m ! An unscaled version of tol_eta, in m. + real :: tol_eta_m ! An unscaled version of tol_eta [m]. character(len=40) :: mdl = "MOM_continuity_PPM" ! This module's name. if (associated(CS)) then diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 1800b3c793..a62831979e 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -187,7 +187,7 @@ module MOM_forcing_type taux => NULL(), & !< zonal wind stress [Pa] tauy => NULL(), & !< meridional wind stress [Pa] ustar => NULL(), & !< surface friction velocity scale [Z s-1 ~> m s-1]. - net_mass_src => NULL() !< The net mass source to the ocean, in kg m-2 s-1. + net_mass_src => NULL() !< The net mass source to the ocean [kg m-2 s-1]. ! applied surface pressure from other component models (e.g., atmos, sea ice, land ice) real, pointer, dimension(:,:) :: p_surf_full => NULL() @@ -203,19 +203,19 @@ module MOM_forcing_type ! iceberg related inputs real, pointer, dimension(:,:) :: & - area_berg => NULL(), & !< area of ocean surface covered by icebergs (m2/m2) - mass_berg => NULL() !< mass of icebergs (kg/m2) + area_berg => NULL(), & !< fractional area of ocean surface covered by icebergs [m2 m-2] + mass_berg => NULL() !< mass of icebergs per unit ocean area [kg m-2] ! land ice-shelf related inputs real, pointer, dimension(:,:) :: frac_shelf_u => NULL() !< Fractional ice shelf coverage of u-cells, - !! nondimensional from 0 to 1. This is only associated if ice shelves are enabled, + !! nondimensional from 0 to 1 [nondim]. This is only associated if ice shelves are enabled, !! and is exactly 0 away from shelves or on land. real, pointer, dimension(:,:) :: frac_shelf_v => NULL() !< Fractional ice shelf coverage of v-cells, - !! nondimensional from 0 to 1. This is only associated if ice shelves are enabled, + !! nondimensional from 0 to 1 [nondim]. This is only associated if ice shelves are enabled, !! and is exactly 0 away from shelves or on land. real, pointer, dimension(:,:) :: & - rigidity_ice_u => NULL(), & !< Depth-integrated lateral viscosity of ice shelves or sea ice at u-points (m3/s) - rigidity_ice_v => NULL() !< Depth-integrated lateral viscosity of ice shelves or sea ice at v-points (m3/s) + rigidity_ice_u => NULL(), & !< Depth-integrated lateral viscosity of ice shelves or sea ice at u-points [m3 s-1] + rigidity_ice_v => NULL() !< Depth-integrated lateral viscosity of ice shelves or sea ice at v-points [m3 s-1] real :: dt_force_accum = -1.0 !< The amount of time over which the mechanical forcing fluxes !! have been averaged [s]. logical :: net_mass_src_set = .false. !< If true, an estimate of net_mass_src has been provided. @@ -404,11 +404,11 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, real :: htot(SZI_(G)) ! total ocean depth [H ~> m or kg m-2] real :: Pen_sw_tot(SZI_(G)) ! sum across all bands of Pen_SW [degC H ~> degC m or degC kg m-2]. real :: pen_sw_tot_rate(SZI_(G)) ! Similar but sum but as a rate (no dt in calculation) - real :: Ih_limit ! inverse depth at which surface fluxes start to be limited (1/H) + real :: Ih_limit ! inverse depth at which surface fluxes start to be limited [H-1 ~> m-1 or m2 kg-1] real :: scale ! scale scales away fluxes if depth < FluxRescaleDepth real :: J_m2_to_H ! converts J/m^2 to H units (m for Bouss and kg/m^2 for non-Bouss) - real :: Irho0 ! 1.0 / Rho0 - real :: I_Cp ! 1.0 / C_p + real :: Irho0 ! 1.0 / Rho0 [m3 kg-1] + real :: I_Cp ! 1.0 / C_p [kg decC J-1] logical :: calculate_diags ! Indicate to calculate/update diagnostic arrays character(len=200) :: mesg integer :: is, ie, nz, i, k, n @@ -799,13 +799,13 @@ subroutine extractFluxes2d(G, GV, fluxes, optics, nsw, dt, FluxRescaleDepth, & !! (1) downwelling (penetrative) SW, !! (2) evaporation heat content, !! (since do not yet know temperature of evap). - !! Units of net_heat are (degC H). + !! [degC H ~> degC m or degC kg m-2] real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated - !! over a time step (ppt H) + !! over a time step [ppt H ~> ppt m or ppt kg m-2] real, dimension(:,:,:), intent(out) :: pen_SW_bnd !< penetrating shortwave flux, split into bands. - !! Units (degC H) & array size nsw x SZI_(G), - !! where nsw=number of SW bands in pen_SW_bnd. - !! This heat flux is not in net_heat. + !! [degC H ~> degC m or degC kg m-2] array size + !! nsw x SZI_(G), where nsw=number of SW bands in + !! pen_SW_bnd. This heat flux is not in net_heat. type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available !! thermodynamic fields. Here it is used to keep !! track of the heat flux associated with net @@ -839,25 +839,28 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, type(forcing), intent(inout) :: fluxes !< surface fluxes type(optics_type), pointer :: optics !< penetrating SW optics real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< prognostic temp (degC) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< salinity (ppt) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< prognostic temp [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< salinity [ppt] type(thermo_var_ptrs), intent(inout) :: tv !< thermodynamics type integer, intent(in) :: j !< j-row to work on - real, dimension(SZI_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoyancy flux (m^2/s^3) - real, dimension(SZI_(G)), intent(inout) :: netHeatMinusSW !< surf Heat flux (K H/s) - real, dimension(SZI_(G)), intent(inout) :: netSalt !< surf salt flux (ppt H/s) + real, dimension(SZI_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoyancy flux [m2 s-3] + real, dimension(SZI_(G)), intent(inout) :: netHeatMinusSW !< surf Heat flux + !! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] + real, dimension(SZI_(G)), intent(inout) :: netSalt !< surf salt flux + !! [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1] logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating !! diagnostics inside extractFluxes1d() ! local variables integer :: nsw, start, npts, k real, parameter :: dt = 1. ! to return a rate from extractFluxes1d - real, dimension( SZI_(G) ) :: netH ! net FW flux (m/s for Bouss) - real, dimension( SZI_(G) ) :: netEvap ! net FW flux leaving ocean via evaporation (m/s for Bouss) - real, dimension( SZI_(G) ) :: netHeat ! net temp flux (K m/s) + real, dimension( SZI_(G) ) :: netH ! net FW flux [H s-1 ~> m s-1 or kg m-2 s-1] + real, dimension( SZI_(G) ) :: netEvap ! net FW flux leaving ocean via evaporation + ! [H s-1 ~> m s-1 or kg m-2 s-1] + real, dimension( SZI_(G) ) :: netHeat ! net temp flux [degC H s-1 ~> degC m s-2 or degC kg m-2 s-1] real, dimension( optics%nbands, SZI_(G) ) :: penSWbnd ! SW penetration bands real, dimension( SZI_(G) ) :: pressure ! pressurea the surface [Pa] - real, dimension( SZI_(G) ) :: dRhodT ! density partial derivative wrt temp - real, dimension( SZI_(G) ) :: dRhodS ! density partial derivative wrt saln + real, dimension( SZI_(G) ) :: dRhodT ! density partial derivative wrt temp [kg m-3 degC-1] + real, dimension( SZI_(G) ) :: dRhodS ! density partial derivative wrt saln [kg m-3 ppt-1] real, dimension(SZI_(G),SZK_(G)+1) :: netPen logical :: useRiverHeatContent @@ -929,17 +932,19 @@ subroutine calculateBuoyancyFlux2d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, type(forcing), intent(inout) :: fluxes !< surface fluxes type(optics_type), pointer :: optics !< SW ocean optics real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< temperature (deg C) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< salinity (ppt) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< salinity [ppt] type(thermo_var_ptrs), intent(inout) :: tv !< thermodynamics type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoy flux (m^2/s^3) - real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netHeatMinusSW !< surf temp flux (K H) - real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netSalt !< surf salt flux (ppt H) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoy flux [m2 s-3] + real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netHeatMinusSW !< surf temp flux + !! [degC H ~> degC m or degC kg m-2] + real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netSalt !< surf salt flux + !! [ppt H ~> ppt m or ppt kg m-2] logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating !! diagnostics inside extractFluxes1d() ! local variables - real, dimension( SZI_(G) ) :: netT ! net temperature flux (K m/s) - real, dimension( SZI_(G) ) :: netS ! net saln flux (ppt m/s) + real, dimension( SZI_(G) ) :: netT ! net temperature flux [degC H s-1 ~> degC m s-2 or degC kg m-2 s-1] + real, dimension( SZI_(G) ) :: netS ! net saln flux !! [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1] integer :: j netT(G%isc:G%iec) = 0. ; netS(G%isc:G%iec) = 0. @@ -1936,7 +1941,7 @@ subroutine copy_common_forcing_fields(forces, fluxes, G, skip_pres) type(ocean_grid_type), intent(in) :: G !< grid type logical, optional, intent(in) :: skip_pres !< If present and true, do not copy pressure fields. - real :: taux2, tauy2 ! Squared wind stress components, in Pa^2. + real :: taux2, tauy2 ! Squared wind stress components [Pa2]. logical :: do_pres integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -2064,7 +2069,7 @@ subroutine copy_back_forcing_fields(fluxes, forces, G) type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces type(ocean_grid_type), intent(in) :: G !< grid type - real :: taux2, tauy2 ! Squared wind stress components, in Pa^2. + real :: taux2, tauy2 ! Squared wind stress components [Pa2]. integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 8b9f4334b6..7893b6ed86 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -75,12 +75,12 @@ module MOM_grid mask2dT, & !< 0 for land points and 1 for ocean points on the h-grid. Nd. geoLatT, & !< The geographic latitude at q points in degrees of latitude or m. geoLonT, & !< The geographic longitude at q points in degrees of longitude or m. - dxT, & !< dxT is delta x at h points, in m. - IdxT, & !< 1/dxT in m-1. - dyT, & !< dyT is delta y at h points, in m, and IdyT is 1/dyT in m-1. - IdyT, & !< dyT is delta y at h points, in m, and IdyT is 1/dyT in m-1. - areaT, & !< The area of an h-cell, in m2. - IareaT, & !< 1/areaT, in m-2. + dxT, & !< dxT is delta x at h points [m]. + IdxT, & !< 1/dxT [m-1]. + dyT, & !< dyT is delta y at h points [m]. + IdyT, & !< IdyT is 1/dyT [m-1]. + areaT, & !< The area of an h-cell [m2]. + IareaT, & !< 1/areaT [m-2]. sin_rot, & !< The sine of the angular rotation between the local model grid's northward !! and the true northward directions. cos_rot !< The cosine of the angular rotation between the local model grid's northward @@ -90,36 +90,36 @@ module MOM_grid mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid. Nondim. geoLatCu, & !< The geographic latitude at u points in degrees of latitude or m. geoLonCu, & !< The geographic longitude at u points in degrees of longitude or m. - dxCu, & !< dxCu is delta x at u points, in m. - IdxCu, & !< 1/dxCu in m-1. - dyCu, & !< dyCu is delta y at u points, in m. - IdyCu, & !< 1/dyCu in m-1. - dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell in m. - IareaCu, & !< The masked inverse areas of u-grid cells in m2. - areaCu !< The areas of the u-grid cells in m2. + dxCu, & !< dxCu is delta x at u points [m]. + IdxCu, & !< 1/dxCu [m-1]. + dyCu, & !< dyCu is delta y at u points [m]. + IdyCu, & !< 1/dyCu [m-1]. + dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [m]. + IareaCu, & !< The masked inverse areas of u-grid cells [m2]. + areaCu !< The areas of the u-grid cells [m2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid. Nondim. geoLatCv, & !< The geographic latitude at v points in degrees of latitude or m. geoLonCv, & !< The geographic longitude at v points in degrees of longitude or m. - dxCv, & !< dxCv is delta x at v points, in m. - IdxCv, & !< 1/dxCv in m-1. - dyCv, & !< dyCv is delta y at v points, in m. - IdyCv, & !< 1/dyCv in m-1. - dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell in m. - IareaCv, & !< The masked inverse areas of v-grid cells in m2. - areaCv !< The areas of the v-grid cells in m2. + dxCv, & !< dxCv is delta x at v points [m]. + IdxCv, & !< 1/dxCv [m-1]. + dyCv, & !< dyCv is delta y at v points [m]. + IdyCv, & !< 1/dyCv [m-1]. + dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [m]. + IareaCv, & !< The masked inverse areas of v-grid cells [m2]. + areaCv !< The areas of the v-grid cells [m2]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid. Nondim. geoLatBu, & !< The geographic latitude at q points in degrees of latitude or m. geoLonBu, & !< The geographic longitude at q points in degrees of longitude or m. - dxBu, & !< dxBu is delta x at q points, in m. - IdxBu, & !< 1/dxBu in m-1. - dyBu, & !< dyBu is delta y at q points, in m. - IdyBu, & !< 1/dyBu in m-1. - areaBu, & !< areaBu is the area of a q-cell, in m2 - IareaBu !< IareaBu = 1/areaBu in m-2. + dxBu, & !< dxBu is delta x at q points [m]. + IdxBu, & !< 1/dxBu [m-1]. + dyBu, & !< dyBu is delta y at q points [m]. + IdyBu, & !< 1/dyBu [m-1]. + areaBu, & !< areaBu is the area of a q-cell [m2] + IareaBu !< IareaBu = 1/areaBu [m-2]. real, pointer, dimension(:) :: & gridLatT => NULL(), & !< The latitude of T points for the purpose of labeling the output axes. @@ -136,17 +136,17 @@ module MOM_grid y_axis_units !< The units that are used in labeling the y coordinate axes. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - bathyT !< Ocean bottom depth at tracer points, in depth units. + bathyT !< Ocean bottom depth at tracer points, in depth units [Z ~> m]. logical :: bathymetry_at_vel !< If true, there are separate values for the !! basin depths at velocity points. Otherwise the effects of !! of topography are entirely determined from thickness points. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & - Dblock_u, & !< Topographic depths at u-points at which the flow is blocked, in depth units. - Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu, in depth units. + Dblock_u, & !< Topographic depths at u-points at which the flow is blocked [Z ~> m]. + Dopen_u !< Topographic depths at u-points at which the flow is open at width dy_Cu [Z ~> m]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - Dblock_v, & !< Topographic depths at v-points at which the flow is blocked, in depth units. - Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv, in depth units. + Dblock_v, & !< Topographic depths at v-points at which the flow is blocked [Z ~> m]. + Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv [Z ~> m]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & CoriolisBu !< The Coriolis parameter at corner points [s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & @@ -155,8 +155,8 @@ module MOM_grid real :: g_Earth !< The gravitational acceleration [m s-2]. ! These variables are global sums that are useful for 1-d diagnostics - real :: areaT_global !< Global sum of h-cell area in m2 - real :: IareaT_global !< Global sum of inverse h-cell area (1/areaT_global) in m2. + real :: areaT_global !< Global sum of h-cell area [m2] + real :: IareaT_global !< Global sum of inverse h-cell area (1/areaT_global) [m2]. ! These variables are for block structures. integer :: nblocks !< The number of sub-PE blocks on this PE @@ -168,7 +168,7 @@ module MOM_grid real :: west_lon !< The longitude (or x-coordinate) of the first u-line real :: len_lat = 0. !< The latitudinal (or y-coord) extent of physical domain real :: len_lon = 0. !< The longitudinal (or x-coord) extent of physical domain - real :: Rad_Earth = 6.378e6 !< The radius of the planet in meters. + real :: Rad_Earth = 6.378e6 !< The radius of the planet [m]. real :: max_depth !< The maximum depth of the ocean in depth units [Z ~> m]. end type ocean_grid_type diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 8db9a02f79..6469335f28 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -82,7 +82,7 @@ module MOM_variables type, public :: thermo_var_ptrs ! If allocated, the following variables have nz layers. real, pointer :: T(:,:,:) => NULL() !< Potential temperature [degC]. - real, pointer :: S(:,:,:) => NULL() !< Salnity [PSU] or [ppt]. + real, pointer :: S(:,:,:) => NULL() !< Salnity [PSU] or [gSalt/kg], generically [ppt]. type(EOS_type), pointer :: eqn_of_state => NULL() !< Type that indicates the !! equation of state to use. real :: P_Ref !< The coordinate-density reference pressure [Pa]. @@ -94,7 +94,7 @@ module MOM_variables logical :: T_is_conT = .false. !< If true, the temperature variable tv%T is !! actually the conservative temperature [degC]. logical :: S_is_absS = .false. !< If true, the salinity variable tv%S is - !! actually the absolute salinity, in [gSalt/kg]. + !! actually the absolute salinity in units of [gSalt/kg]. ! These arrays are accumulated fluxes for communication with other components. real, dimension(:,:), pointer :: frazil => NULL() !< The energy needed to heat the ocean column to the From 026f7d8909e03ca5625b5ec6c2c9294df016a494 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 21 Dec 2018 23:36:06 -0500 Subject: [PATCH 0976/1072] Documented units of 50 grid variables Changed comments to use the square bracket notation to document the units of about 50 dyn_horgrid or diagnostic variables. Only comments have been changed and all answers are bitwise identical. --- src/core/MOM_forcing_type.F90 | 72 ++++++++++----------- src/diagnostics/MOM_diagnostics.F90 | 17 +++-- src/diagnostics/MOM_wave_structure.F90 | 2 +- src/framework/MOM_dyn_horgrid.F90 | 88 +++++++++++++------------- 4 files changed, 91 insertions(+), 88 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index a62831979e..d39191e5e9 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -141,8 +141,8 @@ module MOM_forcing_type ! land ice-shelf related inputs real, pointer, dimension(:,:) :: ustar_shelf => NULL() !< Friction velocity under ice-shelves [Z s-1 ~> m s-1]. !! as computed by the ocean at the previous time step. - real, pointer, dimension(:,:) :: frac_shelf_h => NULL() !< Fractional ice shelf coverage of h-cells, nondimensional - !! cells, nondimensional from 0 to 1. This is only + real, pointer, dimension(:,:) :: frac_shelf_h => NULL() !< Fractional ice shelf coverage of + !! h-cells, nondimensional from 0 to 1. This is only !! associated if ice shelves are enabled, and are !! exactly 0 away from shelves or on land. real, pointer, dimension(:,:) :: iceshelf_melt => NULL() !< Ice shelf melt rate (positive) @@ -773,44 +773,44 @@ subroutine extractFluxes2d(G, GV, fluxes, optics, nsw, dt, FluxRescaleDepth, & netMassInOut, netMassOut, net_heat, Net_salt, Pen_SW_bnd, tv, & aggregate_FW) - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(forcing), intent(inout) :: fluxes !< structure containing pointers to forcing. - type(optics_type), pointer :: optics !< pointer to optics - integer, intent(in) :: nsw !< number of bands of penetrating SW - real, intent(in) :: dt !< time step [s] - real, intent(in) :: FluxRescaleDepth !< min ocean depth before fluxes - !! are scaled away [H ~> m or kg m-2] + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(forcing), intent(inout) :: fluxes !< structure containing pointers to forcing. + type(optics_type), pointer :: optics !< pointer to optics + integer, intent(in) :: nsw !< number of bands of penetrating SW + real, intent(in) :: dt !< time step [s] + real, intent(in) :: FluxRescaleDepth !< min ocean depth before fluxes + !! are scaled away [H ~> m or kg m-2] logical, intent(in) :: useRiverHeatContent !< logical for river heat content logical, intent(in) :: useCalvingHeatContent !< logical for calving heat content real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< layer thickness [H ~> m or kg m-2] + intent(in) :: h !< layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: T !< layer temperatures [degC] - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux - !! (if Bouss) of water in/out of ocean over - !! a time step [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassOut !< net mass flux (non-Bouss) or volume flux - !! (if Bouss) of water leaving ocean surface - !! over a time step [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_heat !< net heat at the surface accumulated over a - !! time step associated with coupler + restore. - !! Exclude two terms from net_heat: - !! (1) downwelling (penetrative) SW, - !! (2) evaporation heat content, - !! (since do not yet know temperature of evap). - !! [degC H ~> degC m or degC kg m-2] - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated - !! over a time step [ppt H ~> ppt m or ppt kg m-2] - real, dimension(:,:,:), intent(out) :: pen_SW_bnd !< penetrating shortwave flux, split into bands. - !! [degC H ~> degC m or degC kg m-2] array size - !! nsw x SZI_(G), where nsw=number of SW bands in - !! pen_SW_bnd. This heat flux is not in net_heat. - type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available - !! thermodynamic fields. Here it is used to keep - !! track of the heat flux associated with net - !! mass fluxes into the ocean. - logical, intent(in) :: aggregate_FW !< For determining how to aggregate the forcing. + intent(in) :: T !< layer temperatures [degC] + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux + !! (if Bouss) of water in/out of ocean over + !! a time step [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassOut !< net mass flux (non-Bouss) or volume flux + !! (if Bouss) of water leaving ocean surface + !! over a time step [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_heat !< net heat at the surface accumulated over a + !! time step associated with coupler + restore. + !! Exclude two terms from net_heat: + !! (1) downwelling (penetrative) SW, + !! (2) evaporation heat content, + !! (since do not yet know temperature of evap). + !! [degC H ~> degC m or degC kg m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated + !! over a time step [ppt H ~> ppt m or ppt kg m-2] + real, dimension(:,:,:), intent(out) :: pen_SW_bnd !< penetrating shortwave flux, split into bands. + !! [degC H ~> degC m or degC kg m-2] array size + !! nsw x SZI_(G), where nsw=number of SW bands in + !! pen_SW_bnd. This heat flux is not in net_heat. + type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available + !! thermodynamic fields. Here it is used to keep + !! track of the heat flux associated with net + !! mass fluxes into the ocean. + logical, intent(in) :: aggregate_FW !< For determining how to aggregate the forcing. integer :: j !$OMP parallel do default(none) shared(G, GV, fluxes, optics, nsw,dt,FluxRescaleDepth, & diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 37e4b6c03b..caa0f3cd00 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1331,13 +1331,16 @@ subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, d !! the transports to depth space type(tracer_registry_type), pointer :: Reg !< Pointer to the tracer registry - real, dimension(SZIB_(G), SZJ_(G)) :: umo2d ! Diagnostics of integrated mass transport, in kg s-1 - real, dimension(SZI_(G), SZJB_(G)) :: vmo2d ! Diagnostics of integrated mass transport, in kg s-1 - real, dimension(SZIB_(G), SZJ_(G), SZK_(G)) :: umo ! Diagnostics of layer mass transport, in kg s-1 - real, dimension(SZI_(G), SZJB_(G), SZK_(G)) :: vmo ! Diagnostics of layer mass transport, in kg s-1 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_tend ! Change in layer thickness due to dynamics m s-1 - real :: Idt - real :: H_to_kg_m2_dt ! A conversion factor from accumulated transports to fluxes, in kg m-2 H-1 s-1. + ! Local variables + real, dimension(SZIB_(G), SZJ_(G)) :: umo2d ! Diagnostics of integrated mass transport [kg s-1] + real, dimension(SZI_(G), SZJB_(G)) :: vmo2d ! Diagnostics of integrated mass transport [kg s-1] + real, dimension(SZIB_(G), SZJ_(G), SZK_(G)) :: umo ! Diagnostics of layer mass transport [kg s-1] + real, dimension(SZI_(G), SZJB_(G), SZK_(G)) :: vmo ! Diagnostics of layer mass transport [kg s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_tend ! Change in layer thickness due to dynamics + ! [H s-1 ~> m s-1 or kg m-2 s-1]. + real :: Idt ! The inverse of the time interval [s-1] + real :: H_to_kg_m2_dt ! A conversion factor from accumulated transports to fluxes + ! [kg m-2 H-1 s-1 ~> kg m-3 s-1 or s-1]. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 40e579b18a..64592e7303 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -48,7 +48,7 @@ module MOM_wave_structure !< Vertical profile of the magnitude of horizontal velocity, !! (u^2+v^2)^0.5, averaged over a period [m s-1]. real, allocatable, dimension(:,:,:) :: z_depths - !< Depths of layer interfaces, in m. + !< Depths of layer interfaces [m]. real, allocatable, dimension(:,:,:) :: N2 !< Squared buoyancy frequency at each interface [s-2]. integer, allocatable, dimension(:,:):: num_intfaces diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 7b4f2e87ca..11155d73e6 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -67,56 +67,56 @@ module MOM_dyn_horgrid !! during the course of the run via calls to set_first_direction. real, allocatable, dimension(:,:) :: & - mask2dT, & !< 0 for land points and 1 for ocean points on the h-grid. Nd. - geoLatT, & !< The geographic latitude at q points in degrees of latitude or m. - geoLonT, & !< The geographic longitude at q points in degrees of longitude or m. - dxT, & !< dxT is delta x at h points, in m. - IdxT, & !< 1/dxT in m-1. - dyT, & !< dyT is delta y at h points, in m, and IdyT is 1/dyT in m-1. - IdyT, & !< dyT is delta y at h points, in m, and IdyT is 1/dyT in m-1. - areaT, & !< The area of an h-cell, in m2. - IareaT !< 1/areaT, in m-2. + mask2dT, & !< 0 for land points and 1 for ocean points on the h-grid [nondim]. + geoLatT, & !< The geographic latitude at q points [degrees of latitude] or [m]. + geoLonT, & !< The geographic longitude at q points [degrees of longitude] or [m]. + dxT, & !< dxT is delta x at h points [m]. + IdxT, & !< 1/dxT [m-1]. + dyT, & !< dyT is delta y at h points [m]. + IdyT, & !< IdyT is 1/dyT [m-1]. + areaT, & !< The area of an h-cell [m2]. + IareaT !< 1/areaT [m-2]. real, allocatable, dimension(:,:) :: sin_rot !< The sine of the angular rotation between the local model grid's northward - !! and the true northward directions. + !! and the true northward directions [nondim]. real, allocatable, dimension(:,:) :: cos_rot !< The cosine of the angular rotation between the local model grid's northward - !! and the true northward directions. + !! and the true northward directions [nondim]. real, allocatable, dimension(:,:) :: & - mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid. Nondim. - geoLatCu, & !< The geographic latitude at u points in degrees of latitude or m. - geoLonCu, & !< The geographic longitude at u points in degrees of longitude or m. - dxCu, & !< dxCu is delta x at u points, in m. - IdxCu, & !< 1/dxCu in m-1. - dyCu, & !< dyCu is delta y at u points, in m. - IdyCu, & !< 1/dyCu in m-1. - dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell in m. - IareaCu, & !< The masked inverse areas of u-grid cells in m2. - areaCu !< The areas of the u-grid cells in m2. + mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid [nondim]. + geoLatCu, & !< The geographic latitude at u points [degrees of latitude] or [m]. + geoLonCu, & !< The geographic longitude at u points [degrees of longitude] or [m]. + dxCu, & !< dxCu is delta x at u points [m]. + IdxCu, & !< 1/dxCu [m-1]. + dyCu, & !< dyCu is delta y at u points [m]. + IdyCu, & !< 1/dyCu [m-1]. + dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [m]. + IareaCu, & !< The masked inverse areas of u-grid cells [m2]. + areaCu !< The areas of the u-grid cells [m2]. real, allocatable, dimension(:,:) :: & - mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid. Nondim. - geoLatCv, & !< The geographic latitude at v points in degrees of latitude or m. - geoLonCv, & !< The geographic longitude at v points in degrees of longitude or m. - dxCv, & !< dxCv is delta x at v points, in m. - IdxCv, & !< 1/dxCv in m-1. - dyCv, & !< dyCv is delta y at v points, in m. - IdyCv, & !< 1/dyCv in m-1. - dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell in m. - IareaCv, & !< The masked inverse areas of v-grid cells in m2. - areaCv !< The areas of the v-grid cells in m2. + mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid [nondim]. + geoLatCv, & !< The geographic latitude at v points [degrees of latitude] or [m]. + geoLonCv, & !< The geographic longitude at v points [degrees of longitude] or [m]. + dxCv, & !< dxCv is delta x at v points [m]. + IdxCv, & !< 1/dxCv [m-1]. + dyCv, & !< dyCv is delta y at v points [m]. + IdyCv, & !< 1/dyCv [m-1]. + dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [m]. + IareaCv, & !< The masked inverse areas of v-grid cells [m2]. + areaCv !< The areas of the v-grid cells [m2]. real, allocatable, dimension(:,:) :: & - mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid. Nondim. - geoLatBu, & !< The geographic latitude at q points in degrees of latitude or m. - geoLonBu, & !< The geographic longitude at q points in degrees of longitude or m. - dxBu, & !< dxBu is delta x at q points, in m. - IdxBu, & !< 1/dxBu in m-1. - dyBu, & !< dyBu is delta y at q points, in m. - IdyBu, & !< 1/dyBu in m-1. - areaBu, & !< areaBu is the area of a q-cell, in m2 - IareaBu !< IareaBu = 1/areaBu in m-2. + mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid [nondim]. + geoLatBu, & !< The geographic latitude at q points [degrees of latitude] or [m]. + geoLonBu, & !< The geographic longitude at q points [degrees of longitude] or [m]. + dxBu, & !< dxBu is delta x at q points [m]. + IdxBu, & !< 1/dxBu [m-1]. + dyBu, & !< dyBu is delta y at q points [m]. + IdyBu, & !< 1/dyBu [m-1]. + areaBu, & !< areaBu is the area of a q-cell [m2] + IareaBu !< IareaBu = 1/areaBu [m-2]. real, pointer, dimension(:) :: gridLatT => NULL() !< The latitude of T points for the purpose of labeling the output axes. @@ -136,7 +136,7 @@ module MOM_dyn_horgrid ! Except on a Cartesian grid, these are usually some variant of "degrees". real, allocatable, dimension(:,:) :: & - bathyT !< Ocean bottom depth at tracer points, in depth units. + bathyT !< Ocean bottom depth at tracer points, in depth units [Z ~> m]. logical :: bathymetry_at_vel !< If true, there are separate values for the !! basin depths at velocity points. Otherwise the effects of @@ -154,8 +154,8 @@ module MOM_dyn_horgrid df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [s-1 m-1]. ! These variables are global sums that are useful for 1-d diagnostics - real :: areaT_global !< Global sum of h-cell area in m2 - real :: IareaT_global !< Global sum of inverse h-cell area (1/areaT_global) in m2 + real :: areaT_global !< Global sum of h-cell area [m2] + real :: IareaT_global !< Global sum of inverse h-cell area (1/areaT_global) [m-2] ! These parameters are run-time parameters that are used during some ! initialization routines (but not all) @@ -163,7 +163,7 @@ module MOM_dyn_horgrid real :: west_lon !< The longitude (or x-coordinate) of the first u-line real :: len_lat = 0. !< The latitudinal (or y-coord) extent of physical domain real :: len_lon = 0. !< The longitudinal (or x-coord) extent of physical domain - real :: Rad_Earth = 6.378e6 !< The radius of the planet in meters. + real :: Rad_Earth = 6.378e6 !< The radius of the planet [m]. real :: max_depth !< The maximum depth of the ocean [Z ~> m]. end type dyn_horgrid_type From b308b2acd4b84e6bd98ed012fda964116913b1b7 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 29 Dec 2018 09:28:46 -0700 Subject: [PATCH 0977/1072] new unified import method for grids or meshes --- .../nuopc_driver/MOM_surface_forcing.F90 | 21 +- config_src/nuopc_driver/mom_cap.F90 | 15 +- config_src/nuopc_driver/mom_cap_methods.F90 | 1113 ++++++++++------- 3 files changed, 654 insertions(+), 495 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 8b25fdf958..b652b5fc9e 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -445,18 +445,12 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & ! ice runoff flux if (associated(fluxes%frunoff)) & fluxes%frunoff(i,j) = G%mask2dT(i,j) * IOB%rofi_flux(i-i0,j-j0) - - ! 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(IOB%runoff_hflx)) & - fluxes%heat_content_lrunoff(i,j) = 0.0 * G%mask2dT(i,j) - - if (associated(IOB%calving_hflx)) & - fluxes%heat_content_frunoff(i,j) = 0.0 * G%mask2dT(i,j) else if (associated(IOB%runoff)) & fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) + end if + if (.not. cesm_coupled) then if (associated(IOB%calving)) & fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) @@ -469,13 +463,14 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & if (associated(IOB%mass_berg)) & fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) - if (associated(IOB%runoff_hflx)) & - fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * 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) end if + if (associated(IOB%runoff_hflx)) & + fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * 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) + if (associated(IOB%lw_flux)) & fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index b04f493e05..56bda62fdc 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -152,8 +152,7 @@ !! - there are calls to two stubs: `ice_ocn_bnd_from_data()` and `external_coupler_sbc_before()` - these are currently !! inactive, but may be modified to read in import data from file or from an external coupler !! - diagnostics are optionally written to files `field_ocn_import_*`, one for each import field -!! - mom_import_cesm or mom_import_nems is called -!! - the sign is reversed on `mean_evap_rate` and `mean_sensi_heat_flux` +!! - mom_import is called !! - momentum flux vectors are rotated to internal grid !! - optionally, a call is made to `ocean_model_restart()` at the interval `restart_interval` !! @@ -399,8 +398,7 @@ module mom_cap_mod use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit use shr_file_mod, only: shr_file_setLogUnit, shr_file_setLogLevel #endif - use mom_cap_methods, only: mom_import_cesm, mom_export_cesm - use mom_cap_methods, only: mom_import_nems, mom_export_nems + use mom_cap_methods, only: mom_import, mom_export_cesm, mom_export_nems use, intrinsic :: iso_fortran_env, only: output_unit @@ -1904,7 +1902,7 @@ subroutine DataInitialize(gcomp, rc) call get_ocean_grid(ocean_state, ocean_grid) if (cesm_coupled) then - call mom_export_cesm(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) + call mom_export_cesm(ocean_public, ocean_grid, exportState, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -2099,14 +2097,13 @@ subroutine ModelAdvance(gcomp, rc) if (cesm_coupled) then call shr_file_setLogUnit (logunit) - call mom_import_cesm(ocean_public, ocean_grid, importState, ice_ocean_boundary, & - logunit, runtype, clock, rc=rc) + call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype=runtype, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out else - call mom_import_nems(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc) + call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -2144,7 +2141,7 @@ subroutine ModelAdvance(gcomp, rc) !--------------- if (cesm_coupled) then - call mom_export_cesm(ocean_public, ocean_grid, exportState, logunit, clock, rc=rc) + call mom_export_cesm(ocean_public, ocean_grid, exportState, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index d92406d6f2..209e27130e 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -6,13 +6,21 @@ module mom_cap_methods ! by retrieving those fields from MOM with calls to `ocean_model_data_get()`. + use NUOPC, only: NUOPC_Advertise, NUOPC_Realize, NUOPC_IsConnected + use NUOPC_Model, only: NUOPC_ModelGet use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet - use ESMF, only: ESMF_State, ESMF_StateGet, ESMF_Field, ESMF_FieldGet + use ESMF, only: ESMF_State, ESMF_StateGet, ESMF_StateRemove + use ESMF, only: ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate + use ESMF, only: ESMF_GridComp, ESMF_Mesh, ESMF_Grid, ESMF_GridCreate + use ESMF, only: ESMF_DistGrid, ESMF_DistGridCreate use ESMF, only: ESMF_KIND_R8, ESMF_SUCCESS, ESMF_LogFoundError use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO, ESMF_LOGWRITE use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE use ESMF, only: ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND + use ESMF, only: ESMF_GEOMTYPE_FLAG, ESMF_GEOMTYPE_GRID, ESMF_GEOMTYPE_MESH + use ESMF, only: ESMF_RC_VAL_OUTOFRANGE, ESMF_INDEX_DELOCAL, ESMF_MESHLOC_ELEMENT + use ESMF, only: ESMF_TYPEKIND_R8 use ESMF, only: operator(/=), operator(==) use MOM_ocean_model, only: ocean_public_type, ocean_state_type, ocean_model_data_get use MOM_surface_forcing, only: ice_ocean_boundary_type @@ -26,36 +34,443 @@ module mom_cap_methods private ! Public member functions + public :: mom_import public :: mom_export_cesm - public :: mom_import_cesm public :: mom_export_nems - public :: mom_import_nems + + private :: state_getimport interface State_GetFldPtr module procedure State_GetFldPtr_1d module procedure State_GetFldPtr_2d end interface +#ifdef CESMCOUPLED + logical :: cesm_coupled = .true. + type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_MESH +#else + logical :: cesm_coupled = .false. + type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID +#endif + integer :: rc,dbrc integer :: import_cnt = 0 !=============================================================================== contains +!=============================================================================== + + !> This function has a few purposes: + !! (1) it imports surface fluxes using data from the mediator; and + !! (2) 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. + + subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype, rc) + + ! Input/output variables + type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state + type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid + type(ESMF_State) , intent(inout) :: importState !< incoming data from mediator + type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing + character(len=*), optional , intent(in) :: runtype !< For cesm only, type of run + integer , intent(inout) :: rc + + ! Local Variables + type(ESMF_StateItem_Flag) :: itemFlag + integer :: i, j, n + integer :: isc, iec, jsc, jec + logical :: do_import + logical :: isPresent_lwup + logical :: isPresent_lwdn + logical :: isPresent_lwnet + character(len=128) :: fldname + character(len=128) :: fldname_x + character(len=128) :: fldname_y + real(ESMF_KIND_R8), allocatable :: taux(:,:) + real(ESMF_KIND_R8), allocatable :: tauy(:,:) + character(len=*) , parameter :: subname = '(mom_import_cesm)' + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! ------- + ! import_cnt is used to skip using the import state at the first count for cesm + ! ------- + + if (present(runtype)) then + import_cnt = import_cnt + 1 + if ((trim(runtype) == 'initial' .and. import_cnt <= 2)) then + do_import = .false. ! This will skip the first time import information is given + else + do_import = .true. + end if + else + do_import = .true. + end if + + if (do_import) then + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + + !---- + ! surface height pressure + !---- + if (cesm_coupled) then + fldname = 'Sa_pslv' + else + fldname = 'inst_pres_height_surface' + end if + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%p, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! near-IR, direct shortwave (W/m2) + !---- + call state_getimport(importState, 'mean_net_sw_ir_dir_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! near-IR, diffuse shortwave (W/m2) + !---- + call state_getimport(importState, 'mean_net_sw_ir_dif_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! visible, direct shortwave (W/m2) + !---- + call state_getimport(importState, 'mean_net_sw_vis_dir_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! visible, diffuse shortwave (W/m2) + !---- + call state_getimport(importState, 'mean_net_sw_vis_dif_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! ------- + ! Net longwave radiation (W/m2) + ! ------- + ! Different treatment of long wave dependent on atmosphere + ! When running with cam or datm - need Foxx_lwup and Faxa_lwdn + ! When running with fv3 - need mean_net_lw_flx + + call ESMF_StateGet(importState, 'Foxx_lwup', itemFlag, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + isPresent_lwup = .true. + else + isPresent_lwup = .false. + end if + call ESMF_StateGet(importState, 'Faxa_lwdn', itemFlag, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + isPresent_lwdn = .true. + else + isPresent_lwdn = .false. + end if + call ESMF_StateGet(importState, "mean_net_lw_flx", itemFlag, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + isPresent_lwnet = .true. + else + isPresent_lwnet = .false. + end if + + if (isPresent_lwup .and. isPresent_lwdn) then + ! longwave radiation, sum up and down (W/m2) + call state_getimport(importState, 'Foxx_lwup', & + isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call state_getimport(importState, 'Faxa_lwdn', & + isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, do_sum=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else if (isPresent_lwnet) then + ! net longwave radiation, sum up and down (W/m2) + call state_getimport(importState, 'mean_net_lw_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, do_sum=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + + !---- + ! zonal and meridional surface stress + !---- + if (cesm_coupled) then + fldname_x = 'Foxx_taux' + fldname_y = 'Foxx_tauy' + else + fldname_x = 'mean_zonal_moment_flx' + fldname_y = 'mean_merid_moment_flx' + end if + + allocate (taux(isc:iec,jsc:jec)) + allocate (tauy(isc:iec,jsc:jec)) + call state_getimport(importState, trim(fldname_x), isc, iec, jsc, jec, taux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call state_getimport(importState, trim(fldname_y), isc, iec, jsc, jec, tauy, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! rotate taux and tauy from true zonal/meridional to local coordinates + ! Note - this is the latest calculation from Gustavo - pointed out that the NEMS calculation is incorrect + if (cesm_coupled) then + do j = jsc, jec + do i = isc, iec + ! TODO (mvertens, 2018-12-28): create a new baseline with these changes + !ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(i,j) * taux(i,j) + ocean_grid%sin_rot(i,j) * tauy(i,j) + !ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(i,j) * tauy(i,j) - ocean_grid%sin_rot(i,j) * taux(i,j) + ice_ocean_boundary%u_flux(i,j) = taux(i,j) + ice_ocean_boundary%v_flux(i,j) = tauy(i,j) + end do + end do + else + do j = jsc, jec + do i = isc, iec + ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(i,j)*taux(i,j) - ocean_grid%sin_rot(i,j)*tauy(i,j) + ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(i,j)*tauy(i,j) + ocean_grid%sin_rot(1,j)*taux(i,j) + end do + end do + end if + + !---- + ! sensible heat flux (W/m2) + !---- + if (cesm_coupled) then + fldname = 'Foxx_sen' + else + fldname = 'mean_sensi_heat_flx' + end if + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%t_flux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! latent heat flux (W/m2) + !---- + if (cesm_coupled) then + ! Note - this field is not exported by the nems mediator + fldname = 'Foxx_lat' + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%latent_flux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + + !---- + ! specific humidity flux (W/m2) + !---- + if (cesm_coupled) then + fldname = 'Foxx_evap' + else + fldname = 'mean_evap_rate' + end if + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%q_flux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! liquid precipitation (rain) + !---- + if (cesm_coupled) then + fldname = 'Faxa_rain' + else + fldname = 'mean_prec_rate' + end if + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%lprec, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! frozen precipitation (snow) + !---- + if (cesm_coupled) then + fldname = 'Faxa_snow' + else + fldname = 'mean_fprec_rate' + end if + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%fprec, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! runoff and heat content of runoff + !---- + if (cesm_coupled) then + ! liquid runoff + fldname = 'Foxx_rofl' + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%rofl_flux,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! ice runoff + fldname = 'Foxx_rofi' + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%rofi_flux,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! GMM, cime does not not have an equivalent for heat_content_lrunoff and + ! heat_content_frunoff. Setting these to zero for now. + ice_ocean_boundary%runoff_hflx(:,:) = 0._ESMF_KIND_R8 + ice_ocean_boundary%calving_hflx(:,:) = 0._ESMF_KIND_R8 + + else + ! total runoff + fldname = 'mean_runoff_rate' + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%runoff, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! heat content of runoff + fldname = 'mean_runoff_heat_flux' + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%runoff_hflx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + + !---- + ! calving rate and heat flux + !---- + if (.not. cesm_coupled) then + fldname = 'mean_calving_rate' + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%calving, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + fldname = 'mean_calving_heat_flux' + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%calving_hflx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + + !---- + ! salt flux from ice + !---- + if (cesm_coupled) then + fldname = 'Fioi_salt' + else + fldname = 'mean_salt_rate' + end if + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%salt_flux,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (cesm_coupled) then + ! salt flux (minus sign needed here -GMM) + ! TODO (mvertens, 2018-12-28): NEMS does not have a minus sign - which one is right? + do j = jsc,jec + do i = isc,iec + ice_ocean_boundary%salt_flux(i,j) = - ice_ocean_boundary%salt_flux(i,j) + enddo + enddo + end if + + !---- + ! mass of overlying ice + !---- + if (.not. cesm_coupled) then + fldname = 'mass_of_overlying_ice' + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + + end if + + end subroutine mom_import + !=============================================================================== !> Maps outgoing ocean data to ESMF State - subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) + subroutine mom_export_cesm(ocean_public, ocean_grid, exportState, clock, rc) ! Input/output variables type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state - type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid + type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid type(ESMF_State) , intent(inout) :: exportState !< outgoing data - integer , intent(in) :: logunit type(ESMF_Clock) , intent(in) :: clock integer , intent(inout) :: rc ! Local variables - real :: ssh(grid%isd:grid%ied,grid%jsd:grid%jed) !< Local copy of sea_lev with updated halo + real :: ssh(ocean_grid%isd:ocean_grid%ied, ocean_grid%jsd:ocean_grid%jed) !< Local copy of sea_lev with updated halo integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices integer :: n real :: slp_L, slp_R, slp_C, slope, u_min, u_max @@ -73,7 +488,6 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:) type(ESMF_TimeInterval) :: timeStep integer :: dt_int !< time over which to advance the ocean (ocean_coupling_time_step), in sec - character(len=*), parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" character(len=*), parameter :: subname = '(mom_export)' !----------------------------------------------------------------------- @@ -84,41 +498,49 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,"So_t", dataPtr_t, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,"So_s", dataPtr_s, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,"So_u", dataPtr_u, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,"So_v", dataPtr_v, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,"Fioo_q", dataPtr_fioo_q, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,"So_dhdx", dataPtr_dhdx, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,"So_dhdy", dataPtr_dhdy, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + !TODO: need to add the So_bldepth since this is needed for the wave model call State_getFldPtr(exportState,"So_bldepth", dataPtr_bldepth, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -126,6 +548,8 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) file=__FILE__)) & return ! bail out + !---------------- + ! Use Adcroft's rule of reciprocals; it does the right thing here. call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -143,29 +567,30 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) I_time_int = 0.0 end if + ! Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. ! The mask comes from "grid" that uses the usual MOM domain that has halos ! and does not use global indexing. n = 0 - do j=grid%jsc, grid%jec - jg = j + grid%jdg_offset - do i=grid%isc,grid%iec - ig = i + grid%idg_offset + do j=ocean_grid%jsc, ocean_grid%jec + jg = j + ocean_grid%jdg_offset + do i=ocean_grid%isc,ocean_grid%iec + ig = i + ocean_grid%idg_offset n = n+1 - dataPtr_omask(n) = grid%mask2dT(i,j) - dataPtr_t(n) = ocean_public%t_surf(ig,jg) * grid%mask2dT(i,j) ! surface temp is in K - dataPtr_s(n) = ocean_public%s_surf(ig,jg) * grid%mask2dT(i,j) - dataPtr_u(n) = ocean_public%u_surf(ig,jg) * grid%mask2dT(i,j) - dataPtr_v(n) = ocean_public%v_surf(ig,jg) * grid%mask2dT(i,j) - dataPtr_bldepth(n) = ocean_public%OBLD(ig,jg) * grid%mask2dT(i,j) + dataPtr_omask(n) = ocean_grid%mask2dT(i,j) + dataPtr_t(n) = ocean_public%t_surf(ig,jg) * ocean_grid%mask2dT(i,j) ! surface temp is in K + dataPtr_s(n) = ocean_public%s_surf(ig,jg) * ocean_grid%mask2dT(i,j) + dataPtr_u(n) = ocean_public%u_surf(ig,jg) * ocean_grid%mask2dT(i,j) + dataPtr_v(n) = ocean_public%v_surf(ig,jg) * ocean_grid%mask2dT(i,j) + dataPtr_bldepth(n) = ocean_public%OBLD(ig,jg) * ocean_grid%mask2dT(i,j) ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 if (ocean_public%frazil(ig,jg) > 0.0) then ! Frazil: change from J/m^2 to W/m^2 - dataPtr_Fioo_q(n) = ocean_public%frazil(ig,jg) * grid%mask2dT(i,j) * I_time_int + dataPtr_Fioo_q(n) = ocean_public%frazil(ig,jg) * ocean_grid%mask2dT(i,j) * I_time_int else ! Melt_potential: change from J/m^2 to W/m^2 - dataPtr_Fioo_q(n) = -ocean_public%melt_potential(ig,jg) * grid%mask2dT(i,j) * I_time_int !* ncouple_per_day + dataPtr_Fioo_q(n) = -ocean_public%melt_potential(ig,jg) * ocean_grid%mask2dT(i,j) * I_time_int !* ncouple_per_day ! make sure Melt_potential is always <= 0 if (dataPtr_Fioo_q(n) > 0.0) dataPtr_Fioo_q(n) = 0.0 @@ -173,31 +598,32 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) end do end do - ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain - ! in order to update halos. i.e. does not use global indexing. - do j=grid%jsc, grid%jec - jg = j + grid%jdg_offset - do i=grid%isc,grid%iec - ig = i + grid%idg_offset + ! Make a copy of ssh in order to do a halo update. + ! ssh has global indexing with halos + + do j = ocean_grid%jsc, ocean_grid%jec + jg = j + ocean_grid%jdg_offset + do i = ocean_grid%isc,ocean_grid%iec + ig = i + ocean_grid%idg_offset ssh(i,j) = ocean_public%sea_lev(ig,jg) end do end do ! Update halo of ssh so we can calculate gradients - call pass_var(ssh, grid%domain) + call pass_var(ssh, ocean_grid%domain) ! d/dx ssh n = 0 - do j=grid%jsc, grid%jec - do i=grid%isc,grid%iec + do j=ocean_grid%jsc, ocean_grid%jec + do i=ocean_grid%isc,ocean_grid%iec n = n+1 ! This is a simple second-order difference - ! dataPtr_dhdx(n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) - if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. - slp_R = (ssh(I+1,j) - ssh(I,j)) * grid%mask2dCu(I,j) - if (grid%mask2dCu(I+1,j)==0.) slp_R = 0. + ! dataPtr_dhdx(n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-ocean_grid null mode + slp_L = (ssh(I,j) - ssh(I-1,j)) * ocean_grid%mask2dCu(I-1,j) + if (ocean_grid%mask2dCu(I-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * ocean_grid%mask2dCu(I,j) + if (ocean_grid%mask2dCu(I+1,j)==0.) slp_R = 0. slp_C = 0.5 * (slp_L + slp_R) if ( (slp_L * slp_R) > 0.0 ) then ! This limits the slope so that the edge values are bounded by the @@ -210,24 +636,24 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) ! larger extreme values. slope = 0.0 endif - dataPtr_dhdx(n) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) dataPtr_dhdx(n) = 0.0 + dataPtr_dhdx(n) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) dataPtr_dhdx(n) = 0.0 enddo enddo ! d/dy ssh n = 0 - do j=grid%jsc, grid%jec - do i=grid%isc,grid%iec + do j=ocean_grid%jsc, ocean_grid%jec + do i=ocean_grid%isc,ocean_grid%iec n = n+1 ! This is a simple second-order difference - ! dataPtr_dhdy(n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) - if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. + ! dataPtr_dhdy(n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) + ! This is a PLM slope which might be less prone to the A-ocean_grid null mode + slp_L = ssh(i,J) - ssh(i,J-1) * ocean_grid%mask2dCv(i,J-1) + if (ocean_grid%mask2dCv(i,J-1)==0.) slp_L = 0. - slp_R = ssh(i,J+1) - ssh(i,J) * grid%mask2dCv(i,J) - if (grid%mask2dCv(i,J+1)==0.) slp_R = 0. + slp_R = ssh(i,J+1) - ssh(i,J) * ocean_grid%mask2dCv(i,J) + if (ocean_grid%mask2dCv(i,J+1)==0.) slp_R = 0. slp_C = 0.5 * (slp_L + slp_R) !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R @@ -242,251 +668,13 @@ subroutine mom_export_cesm(ocean_public, grid, exportState, logunit, clock, rc) ! larger extreme values. slope = 0.0 endif - dataPtr_dhdy(n) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) - if (grid%mask2dT(i,j)==0.) dataPtr_dhdy(n) = 0.0 + dataPtr_dhdy(n) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) dataPtr_dhdy(n) = 0.0 enddo enddo end subroutine mom_export_cesm -!=============================================================================== - - !> 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. - subroutine mom_import_cesm(ocean_public, grid, importState, ice_ocean_boundary, & - logunit, runtype, clock, rc) - - ! Input/output variables - type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state - type(ocean_grid_type) , intent(in) :: grid !< Ocean model grid - type(ESMF_State) , intent(inout) :: importState !< incoming data - type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing - type(ESMF_Clock) , intent(in) :: clock - integer , intent(in) :: logunit - character(len=*) , intent(in) :: runtype - integer , intent(inout) :: rc - - ! Local Variables - type(ESMF_StateItem_Flag) :: itemFlag - integer :: i, j, n - integer :: isc, iec, jsc, jec - integer :: lsize - integer :: day, secs - type(ESMF_time) :: currTime - logical :: do_import - ! import fields that are different for cam and fv3 - logical :: isPresent_lwup - logical :: isPresent_lwdn - logical :: isPresent_lwnet - logical :: isPresent_evap - ! from atm - real(ESMF_KIND_R8), pointer :: dataPtr_p(:) - real(ESMF_KIND_R8), pointer :: dataPtr_taux(:) - real(ESMF_KIND_R8), pointer :: dataPtr_tauy(:) - real(ESMF_KIND_R8), pointer :: dataPtr_sen(:) - real(ESMF_KIND_R8), pointer :: dataPtr_lat(:) - real(ESMF_KIND_R8), pointer :: dataPtr_evap(:) - real(ESMF_KIND_R8), pointer :: dataPtr_lwdn(:) - real(ESMF_KIND_R8), pointer :: dataPtr_lwup(:) - real(ESMF_KIND_R8), pointer :: dataPtr_lwnet(:) - real(ESMF_KIND_R8), pointer :: dataPtr_rain(:) - real(ESMF_KIND_R8), pointer :: dataPtr_snow(:) - real(ESMF_KIND_R8), pointer :: dataPtr_swvdr(:) - real(ESMF_KIND_R8), pointer :: dataPtr_swvdf(:) - real(ESMF_KIND_R8), pointer :: dataPtr_swndr(:) - real(ESMF_KIND_R8), pointer :: dataPtr_swndf(:) - ! from river - real(ESMF_KIND_R8), pointer :: dataPtr_rofl(:) - real(ESMF_KIND_R8), pointer :: dataPtr_rofi(:) - real(ESMF_KIND_R8), pointer :: dataPtr_salt(:) - ! from wave - real(ESMF_KIND_R8), pointer :: dataPtr_lamult(:) - real(ESMF_KIND_R8), pointer :: dataPtr_ustokes(:) - real(ESMF_KIND_R8), pointer :: dataPtr_vstokes(:) - ! - character(len=*) , parameter :: F01 = "('(mom_import) ',a,4(i6,2x),d21.14)" - character(len=*) , parameter :: subname = '(mom_import)' - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - call State_getFldPtr(importState,'Sa_pslv', dataPtr_p,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_net_sw_ir_dir_flx" , dataPtr_swndr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_net_sw_ir_dif_flx" , dataPtr_swndf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_net_sw_vis_dir_flx" , dataPtr_swvdr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_net_sw_vis_dif_flx" , dataPtr_swvdf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call State_getFldPtr(importState,"Foxx_taux" , dataPtr_taux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_tauy" , dataPtr_tauy, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_sen" , dataPtr_sen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_lat" , dataPtr_lat, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_evap" , dataPtr_evap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_rofl" , dataPtr_rofl, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Foxx_rofi" , dataPtr_rofi, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Fioi_salt" , dataPtr_salt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Faxa_rain" , dataPtr_rain, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"Faxa_snow" , dataPtr_snow, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! ------- - ! Different treatment of long wave dependent on if cam, datm or fv3 - ! ------- - ! When running with cam or datm - need Foxx_lwup and Faxa_lwdn - ! When running with fv3 - need mean_net_lw_flx - - call ESMF_StateGet(importState, 'Foxx_lwup', itemFlag, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - isPresent_lwup = .true. - call State_getFldPtr(importState,"Foxx_lwup", dataPtr_lwup, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else - isPresent_lwup = .false. - end if - call ESMF_StateGet(importState, 'Faxa_lwdn', itemFlag, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - isPresent_lwdn = .true. - call State_getFldPtr(importState, "Faxa_lwdn", dataPtr_lwdn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else - isPresent_lwdn = .false. - end if - call ESMF_StateGet(importState, "mean_net_lw_flx", itemFlag, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - isPresent_lwnet = .true. - call State_getFldPtr(importState,"mean_net_lw_flx" , dataPtr_lwnet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else - isPresent_lwnet = .false. - end if - - ! ------- - ! import_cnt is used to skip using the import state at the first count - ! ------- - - import_cnt = import_cnt + 1 - if ((trim(runtype) == 'initial' .and. import_cnt <= 2)) then - do_import = .false. ! This will skip the first time import information is given - else - do_import = .true. - end if - - if (do_import) then - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - n = 0 - do j = jsc,jec - do i = isc,iec - n = n + 1 ! Increment position within gindex - ice_ocean_boundary%p(i,j) = dataPtr_p(n) ! surface pressure - ice_ocean_boundary%u_flux(i,j) = dataPtr_taux(n) ! zonal surface stress - taux - ice_ocean_boundary%v_flux(i,j) = dataPtr_tauy(n) ! meridional surface stress - tauy - ice_ocean_boundary%lprec(i,j) = dataPtr_rain(n) ! liquid precipitation (rain) - ice_ocean_boundary%fprec(i,j) = dataPtr_snow(n) ! frozen precipitation (snow) - ice_ocean_boundary%t_flux(i,j) = dataPtr_sen(n) ! sensible heat flux (W/m2) - ice_ocean_boundary%latent_flux(i,j) = dataPtr_lat(n) ! latent heat flux (W/m^2) - ice_ocean_boundary%q_flux(i,j) = dataPtr_evap(n) ! specific humidity flux - if (isPresent_lwup .and. isPresent_lwdn) then - ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwup(n) & - + dataPtr_lwdn(n) ! longwave radiation, sum up and down (W/m2) - else if (isPresent_lwnet) then - ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwnet(n) ! net longwave radiation, sum up and down (W/m2) - end if - ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(n) ! visible, direct shortwave (W/m2) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(n) ! visible, diffuse shortwave (W/m2) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(n) ! near-IR, direct shortwave (W/m2) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(n) ! near-IR, diffuse shortwave (W/m2) - ice_ocean_boundary%rofl_flux(i,j) = dataPtr_rofl(n) ! ice runoff - ice_ocean_boundary%rofi_flux(i,j) = dataPtr_rofi(n) ! liquid runoff - ice_ocean_boundary%salt_flux(i,j) = -dataPtr_salt(n) ! salt flux (minus sign needed here -GMM) - enddo - enddo - end if - - end subroutine mom_import_cesm - !=============================================================================== subroutine mom_export_nems(ocean_state, ocean_public, ocean_grid, dt_cpld, exportState, rc) @@ -527,37 +715,37 @@ subroutine mom_export_nems(ocean_state, ocean_public, ocean_grid, dt_cpld, expor line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,'ocn_current_merid',dataPtr_ocm,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - !call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frazil,rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! fixfrzmlt !JW + call State_getFldPtr(exportState,'accum_heat_frazil',dataPtr_frazil,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,'inst_melt_potential',dataPtr_melt_potential,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frzmlt,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,'sea_surface_slope_zonal',dataPtr_dhdx,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + call State_getFldPtr(exportState,'sea_surface_slope_merid',dataPtr_dhdy,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -647,10 +835,17 @@ subroutine mom_export_nems(ocean_state, ocean_public, ocean_grid, dt_cpld, expor if (ocean_grid%mask2dT(i,j)==0.) sshy(i,j) = 0.0 end do end do + ! rotate slopes from tripolar grid back to lat/lon grid (CCW) ! "grid" uses the usual MOM domain that has halos ! and does not use global indexing. ! x,y => latlon + + lbnd1 = lbound(dataPtr_dhdx,1) + ubnd1 = ubound(dataPtr_dhdx,1) + lbnd2 = lbound(dataPtr_dhdx,2) + ubnd2 = ubound(dataPtr_dhdx,2) + do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 j1 = j + ocean_grid%jsc - lbnd2 @@ -734,188 +929,6 @@ subroutine mom_export_nems(ocean_state, ocean_public, ocean_grid, dt_cpld, expor end subroutine mom_export_nems -!=============================================================================== - - subroutine mom_import_nems(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc) - - ! Input/output variables - type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state - type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid - type(ESMF_State) , intent(inout) :: importState !< incoming data - type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing - integer , intent(inout) :: rc - - ! Local Variables - integer :: lbnd1,ubnd1,lbnd2,ubnd2 - integer :: i, j, i1, j1, ig, jg ! Grid indices - integer :: isc, iec, jsc, jec ! Grid indices - integer :: i0, j0, is, js, ie, je ! Grid indices - real(ESMF_KIND_R8), pointer :: dataPtr_p(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_mmmf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_mzmf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_sensi(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_evap(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_salt(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_lwflux(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swvdr(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swvdf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swndr(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_swndf(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_runoff(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_rain(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_snow(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_calving(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_runoff_hflx(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_calving_hflx(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_mi(:,:) - - real(ESMF_KIND_R8), allocatable :: mmmf(:,:), mzmf(:,:) - integer :: day, secs - type(ESMF_time) :: currTime - logical :: do_import - character(len=*), parameter :: subname = '(mom_import_nems)' - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - call State_getFldPtr(importState,'mean_zonal_moment_flx',dataPtr_mzmf,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'mean_merid_moment_flx',dataPtr_mmmf,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'mean_evap_rate',dataPtr_evap,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'mean_sensi_heat_flx',dataPtr_sensi,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_salt_rate" , dataPtr_salt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_net_sw_ir_dir_flx" , dataPtr_swndr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_net_sw_ir_dif_flx" , dataPtr_swndf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_net_sw_vis_dir_flx" , dataPtr_swvdr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_net_sw_vis_dif_flx" , dataPtr_swvdf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_prec_rate" , dataPtr_rain, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_fprec_rate" , dataPtr_snow, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_runoff_rate" , dataPtr_runoff, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_calving_rate" , dataPtr_calving, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_runoff_heat_flux" , dataPtr_runoff_hflx, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mean_calving_heat_flux" , dataPtr_calving_hflx, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,'inst_pres_height_surface', dataPtr_p,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_getFldPtr(importState,"mass_of_overlying_ice" , dataPtr_mi, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - - lbnd1 = lbound(dataPtr_p,1) - ubnd1 = ubound(dataPtr_p,1) - lbnd2 = lbound(dataPtr_p,2) - ubnd2 = ubound(dataPtr_p,2) - print *, 'lbnd1,ubnd1,lbnd2,ubnd2', lbnd1, ubnd1, lbnd2, ubnd2 - - allocate(mzmf(lbnd1:ubnd1,lbnd2:ubnd2)) - allocate(mmmf(lbnd1:ubnd1,lbnd2:ubnd2)) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j + ocean_grid%jsc - lbnd2 - i1 = i + ocean_grid%isc - lbnd1 - mzmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mzmf(i,j) & - - ocean_grid%sin_rot(i1,j1)*dataPtr_mmmf(i,j) - mmmf(i,j) = ocean_grid%cos_rot(i1,j1)*dataPtr_mmmf(i,j) & - + ocean_grid%sin_rot(i1,j1)*dataPtr_mzmf(i,j) - enddo - enddo - dataPtr_mzmf = mzmf - dataPtr_mmmf = mmmf - deallocate(mzmf, mmmf) - - do j = jsc, jec - j1 = j + lbnd2 - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - - ice_ocean_boundary%u_flux(i,j) = dataPtr_mzmf(i1,j1) - ice_ocean_boundary%v_flux(i,j) = dataPtr_mmmf(i1,j1) - ice_ocean_boundary%q_flux(i,j) = dataPtr_evap(i1,j1) - ice_ocean_boundary%t_flux(i,j) = dataPtr_sensi(i1,j1) - ice_ocean_boundary%salt_flux(i,j) = dataPtr_salt(i1,j1) - ice_ocean_boundary%lw_flux(i,j) = dataPtr_lwflux(i1,j1) - ice_ocean_boundary%sw_flux_vis_dir(i,j) = dataPtr_swvdr(i1,j1) - ice_ocean_boundary%sw_flux_vis_dif(i,j) = dataPtr_swvdf(i1,j1) - ice_ocean_boundary%sw_flux_nir_dir(i,j) = dataPtr_swndr(i1,j1) - ice_ocean_boundary%sw_flux_nir_dif(i,j) = dataPtr_swndf(i1,j1) - ice_ocean_boundary%lprec(i,j) = dataPtr_rain(i1,j1) - ice_ocean_boundary%fprec(i,j) = dataPtr_snow(i1,j1) - ice_ocean_boundary%runoff(i,j) = dataPtr_runoff(i1,j1) - ice_ocean_boundary%calving(i,j) = dataPtr_calving(i1,j1) - ice_ocean_boundary%runoff_hflx(i,j) = dataPtr_runoff_hflx(i1,j1) - ice_ocean_boundary%calving_hflx(i,j) = dataPtr_calving_hflx(i1,j1) - ice_ocean_boundary%p(i,j) = dataPtr_p(i1,j1) - ice_ocean_boundary%mi(i,j) = dataPtr_mi(i1,j1) - enddo - enddo - - end subroutine mom_import_nems - !=============================================================================== subroutine State_GetFldPtr_1d(State, fldname, fldptr, rc) @@ -972,4 +985,158 @@ subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc) end subroutine State_GetFldPtr_2d + !=============================================================================== + + subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, rc) + + ! ---------------------------------------------- + ! Map import state field to output array + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fldname + integer , intent(in) :: isc + integer , intent(in) :: iec + integer , intent(in) :: jsc + integer , intent(in) :: jec + real (ESMF_KIND_R8) , intent(inout) :: output(isc:iec,jsc:jec) + logical, optional , intent(in) :: do_sum + integer , intent(out) :: rc + + ! local variables + integer :: n, i, j, i1, j1 + integer :: lbnd1,lbnd2 + real(ESMF_KIND_R8), pointer :: dataPtr1d(:) + real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) + character(len=*) , parameter :: subname='(mom_cap_methods:state_getimport)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + if (geomtype == ESMF_GEOMTYPE_MESH) then + + ! get field pointer + call state_getfldptr(state, trim(fldname), dataptr1d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! determine output array + n = 0 + do j = jsc,jec + do i = isc,iec + n = n + 1 + if (present(do_sum)) then + output(i,j) = output(i,j) + dataPtr1d(n) + else + output(i,j) = dataPtr1d(n) + end if + end do + end do + + else if (geomtype == ESMF_GEOMTYPE_GRID) then + + call state_getfldptr(state, trim(fldname), dataptr2d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr2d,1) + lbnd2 = lbound(dataPtr2d,2) + + do j = jsc, jec + j1 = j + lbnd2 - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + if (present(do_sum)) then + output(i,j) = output(i,j) + dataPtr2d(i1,j1) + else + output(i,j) = dataPtr2d(i1,j1) + end if + end do + end do + + end if + + end subroutine State_GetImport + + !=============================================================================== + + subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid, rc) + + ! ---------------------------------------------- + ! Map input array to export state + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State) , intent(inout) :: state + character(len=*) , intent(in) :: fldname + integer , intent(in) :: isc + integer , intent(in) :: iec + integer , intent(in) :: jsc + integer , intent(in) :: jec + real (ESMF_KIND_R8) , intent(in) :: input(isc:iec,jsc:jec) + type(ocean_grid_type) , intent(in) :: ocean_grid + integer , intent(out) :: rc + + ! local variables + integer :: n, i, j, i1, j1, ig,jg + integer :: lbnd1,lbnd2 + real(ESMF_KIND_R8), pointer :: dataPtr1d(:) + real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) + character(len=*) , parameter :: subname='(mom_cap_methods_:state_setimport)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + ! Indexing notes: + ! input array from "ocean_public" uses local indexing without halos + ! mask from "ocean_grid" uses global indexing with halos + + if (geomtype == ESMF_GEOMTYPE_MESH) then + + call state_getfldptr(state, trim(fldname), dataptr1d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + n = 0 + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + n = n+1 + dataPtr1d(n) = input(i,j) * ocean_grid%mask2dT(ig,jg) + end do + end do + + else if (geomtype == ESMF_GEOMTYPE_GRID) then + + call state_getfldptr(state, trim(fldname), dataptr2d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr2d,1) + lbnd2 = lbound(dataPtr2d,2) + + do j = jsc, jec + j1 = j + lbnd2 - jsc + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + ig = i + ocean_grid%isc - isc + dataPtr2d(i1,j1) = input(i,j) * ocean_grid%mask2dT(ig,jg) + end do + end do + + end if + + end subroutine State_SetExport + end module mom_cap_methods From 38751ddc672247f68e9c59c67f10c37785b8c7e6 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 29 Dec 2018 19:15:53 -0700 Subject: [PATCH 0978/1072] updates to unify nems and cesm caps without separate import/export routines --- config_src/nuopc_driver/mom_cap.F90 | 165 ++--- config_src/nuopc_driver/mom_cap_methods.F90 | 716 +++++++++----------- 2 files changed, 383 insertions(+), 498 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 56bda62fdc..e7dfb579f5 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -157,7 +157,7 @@ !! - optionally, a call is made to `ocean_model_restart()` at the interval `restart_interval` !! !! After the call to `update_ocean_model()`, the cap performs these steps: -!! - mom_export_cesm or mom_export_nems is called +!! - mom_export is called !! - the `ocean_mask` export is set to match that of the internal MOM mask !! - the `freezing_melting_potential` export is converted from J m-2 to W m-2 by dividing by the coupling interval !! - vector rotations are applied to the `ocean_current_zonal` and `ocean_current_merid` exports, back to lat-lon grid @@ -398,7 +398,7 @@ module mom_cap_mod use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit use shr_file_mod, only: shr_file_setLogUnit, shr_file_setLogLevel #endif - use mom_cap_methods, only: mom_import, mom_export_cesm, mom_export_nems + use mom_cap_methods, only: mom_import, mom_export use, intrinsic :: iso_fortran_env, only: output_unit @@ -1037,11 +1037,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - ! when coupled to cam - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") ! -> mean long wave up - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") ! -> mean long wave down - ! when coupled to fv3 - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx", "will_provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") ! -> mean long wave up (coupled to cam) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") ! -> mean long wave down (coupled to cam) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will_provide") ! -> coupled to fv3 ! EMC fields not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi @@ -1051,70 +1049,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") ! not in CESM ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") ! not in CESM - ! CESM currently not used - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_prec" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphidry" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphodry" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_bcphiwet" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphidry" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphodry" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_ocphiwet" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet1" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet2" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet3" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstwet4" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry1" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry2" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry3" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_dstdry4" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_bcphi" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_bcpho" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_flxdst" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "So_duu10n" , "will provide") - - ! Optional CESM fields currently not used - ! call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! read(cvalue,*) flds_co2a - ! call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) - ! call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! read(cvalue,*) flds_co2c - ! call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) - ! if (flds_co2a .or. flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_co2prog" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_co2diag" , "will provide") - ! end if - ! call NUOPC_CompAttributeGet(gcomp, name='ice_ncat', value=cvalue, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! read(cvalue,*) ice_ncat - ! call ESMF_LogWrite('ice_ncat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) - ! call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! read(cvalue,*) flds_i2o_per_cat - ! call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) - ! if (flds_i2o_per_cat) then - ! do num = 1, ice_ncat - ! name = 'Si_ifrac_' // cnum - ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") - ! name = 'PFioi_swpen_ifrac_' // cnum - ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") - ! end do - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sf_afrac" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sf_afracr" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_afracr", "will provide") - ! end if - ! do n = 1,shr_string_listGetNum(ndep_fields) - ! call shr_string_listGetName(ndep_fields, n, name) - ! call fld_list_add(fldsToOcn_num, fldsToOcn, trim(name), "will provide") - ! end do + ! CESM currently not used + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") !--------- export fields ------------- if (len_trim(scalar_field_name) > 0) then @@ -1127,17 +1069,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! -> sea_surface_slope_zonal call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! -> sea_surface_slope_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! -> not in EMC call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! -> freezing_melting_potential - ! EMC fields not used - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev", "will provide") ! not in CESM + ! EMC fields not used in CESM + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev", "will provide") - ! Optional CESM fields currently not used - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen", "will provide") ! not in EMC - ! if (flds_co2c) then - ! call fld_list_add(fldsToOcn_num, fldsFrOcn, "Faoo_fco2_ocn" , "will provide") - ! end if + ! CESM fields currently not used in EMC + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen", "will provide") else @@ -1162,22 +1101,17 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") !--------- export fields ------------- - ! This sets pointers of the fldsFrOcn to the ocean_public data (unlike the cesm copy paradigm) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature" , "will provide", data=ocean_public%t_surf) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide", data=ocean_public%s_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide", data=ocean_public%u_surf ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide", data=ocean_public%v_surf ) - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_idir" , "will provide") - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_jdir" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide", data=ocean_public%sea_lev) - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=ocean_public%frazil) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "accum_heat_frazil" , "will provide", data=Ocean_public%frazil) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "inst_melt_potential" , "will provide", data=Ocean_public%melt_potential) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide", data=dataPtr_frzmlt) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide", data=ocean_public%frazil) !JW - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide", data=ocean_public%frazil) !JW - + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "accum_heat_frazil" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "inst_melt_potential" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide") end if do n = 1,fldsToOcn_num @@ -1878,6 +1812,7 @@ subroutine DataInitialize(gcomp, rc) type(ocean_grid_type), pointer :: ocean_grid character(240) :: msgString integer :: fieldCount, n + integer :: dt_cpld = 86400 type(ESMF_Field) :: field character(len=64),allocatable :: fieldNameList(:) character(len=*),parameter :: subname='(mom_cap:DataInitialize)' @@ -1902,7 +1837,7 @@ subroutine DataInitialize(gcomp, rc) call get_ocean_grid(ocean_state, ocean_grid) if (cesm_coupled) then - call mom_export_cesm(ocean_public, ocean_grid, exportState, clock, rc=rc) + call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, dt_cpld, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -2069,7 +2004,7 @@ subroutine ModelAdvance(gcomp, rc) Time = esmf2fms_time(currTime) Time_step_coupled = esmf2fms_time(timeStep) - dt_cpld = dth*3600+dtm*60+dts + dt_cpld = dth*3600 + dtm*60 + dts !--------------- ! Write diagnostics for import @@ -2095,20 +2030,19 @@ subroutine ModelAdvance(gcomp, rc) ! Import data !--------------- +#ifdef CESMCOUPLED + call shr_file_setLogUnit (logunit) +#endif + if (cesm_coupled) then - call shr_file_setLogUnit (logunit) call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype=runtype, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out else call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out end if + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out !--------------- ! Update MOM6 @@ -2140,24 +2074,17 @@ subroutine ModelAdvance(gcomp, rc) ! Export Data !--------------- - if (cesm_coupled) then - call mom_export_cesm(ocean_public, ocean_grid, exportState, clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else - call mom_export_nems(ocean_state, ocean_public, ocean_grid, dt_cpld, exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if + call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, dt_cpld, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - if (cesm_coupled) then +#ifdef CESM_COUPLED ! reset shr logging to my original values call shr_file_setLogUnit (output_unit) end if +#endif !--------------- ! If restart alarm is ringing - write restart file diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 209e27130e..98de08358b 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -10,7 +10,7 @@ module mom_cap_methods use NUOPC_Model, only: NUOPC_ModelGet use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet - use ESMF, only: ESMF_State, ESMF_StateGet, ESMF_StateRemove + use ESMF, only: ESMF_State, ESMF_StateGet use ESMF, only: ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate use ESMF, only: ESMF_GridComp, ESMF_Mesh, ESMF_Grid, ESMF_GridCreate use ESMF, only: ESMF_DistGrid, ESMF_DistGridCreate @@ -35,10 +35,10 @@ module mom_cap_methods ! Public member functions public :: mom_import - public :: mom_export_cesm - public :: mom_export_nems + public :: mom_export - private :: state_getimport + private :: State_getImport + private :: State_setExport interface State_GetFldPtr module procedure State_GetFldPtr_1d @@ -78,7 +78,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! Local Variables type(ESMF_StateItem_Flag) :: itemFlag - integer :: i, j, n + integer :: i, j, ig, jg, n integer :: isc, iec, jsc, jec logical :: do_import logical :: isPresent_lwup @@ -257,19 +257,27 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! Note - this is the latest calculation from Gustavo - pointed out that the NEMS calculation is incorrect if (cesm_coupled) then do j = jsc, jec + jg = j + ocean_grid%jsc - jsc do i = isc, iec + ig = i + ocean_grid%isc - isc ! TODO (mvertens, 2018-12-28): create a new baseline with these changes - !ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(i,j) * taux(i,j) + ocean_grid%sin_rot(i,j) * tauy(i,j) - !ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(i,j) * tauy(i,j) - ocean_grid%sin_rot(i,j) * taux(i,j) + ! ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg) * taux(i,j) & + ! + ocean_grid%sin_rot(ig,jg) * tauy(i,j) + ! ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg) * tauy(i,j) & + ! - ocean_grid%sin_rot(ig,jg) * taux(i,j) ice_ocean_boundary%u_flux(i,j) = taux(i,j) ice_ocean_boundary%v_flux(i,j) = tauy(i,j) end do end do else do j = jsc, jec + jg = j + ocean_grid%jsc - jsc do i = isc, iec - ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(i,j)*taux(i,j) - ocean_grid%sin_rot(i,j)*tauy(i,j) - ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(i,j)*tauy(i,j) + ocean_grid%sin_rot(1,j)*taux(i,j) + ig = i + ocean_grid%isc - isc + ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg)*taux(i,j) & + - ocean_grid%sin_rot(ig,jg)*tauy(i,j) + ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg)*tauy(i,j) & + + ocean_grid%sin_rot(ig,jg)*taux(i,j) end do end do end if @@ -460,332 +468,331 @@ end subroutine mom_import !=============================================================================== !> Maps outgoing ocean data to ESMF State - subroutine mom_export_cesm(ocean_public, ocean_grid, exportState, clock, rc) + subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, dt_cpld, rc) ! Input/output variables type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid + type (ocean_state_type) , pointer :: ocean_state type(ESMF_State) , intent(inout) :: exportState !< outgoing data - type(ESMF_Clock) , intent(in) :: clock + type(ESMF_Clock) , intent(in) :: clock ! cesm + integer , intent(in) :: dt_cpld ! nems integer , intent(inout) :: rc ! Local variables - real :: ssh(ocean_grid%isd:ocean_grid%ied, ocean_grid%jsd:ocean_grid%jed) !< Local copy of sea_lev with updated halo - integer :: i, j, i1, j1, ig, jg, isc, iec, jsc, jec !< Grid indices - integer :: n - real :: slp_L, slp_R, slp_C, slope, u_min, u_max - real :: I_time_int !< The inverse of coupling time interval in s-1. - integer :: day, secs - type(ESMF_time) :: currTime - real(ESMF_KIND_R8), pointer :: dataPtr_omask(:) - real(ESMF_KIND_R8), pointer :: dataPtr_t(:) - real(ESMF_KIND_R8), pointer :: dataPtr_s(:) - real(ESMF_KIND_R8), pointer :: dataPtr_u(:) - real(ESMF_KIND_R8), pointer :: dataPtr_v(:) - real(ESMF_KIND_R8), pointer :: dataPtr_fioo_q(:) - real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:) - real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:) - real(ESMF_KIND_R8), pointer :: dataPtr_bldepth(:) - type(ESMF_TimeInterval) :: timeStep - integer :: dt_int !< time over which to advance the ocean (ocean_coupling_time_step), in sec + integer :: i, j, ig, jg ! grid indices + integer :: isc, iec, jsc, jec ! local indices + integer :: iloc, jloc ! local indices + integer :: n + real :: slp_L, slp_R, slp_C + real :: slope, u_min, u_max + integer :: day, secs + type(ESMF_TimeInterval) :: timeStep + integer :: dt_int + real :: inv_dt_int !< The inverse of coupling time interval in s-1. + character(len=128) :: fldname + character(len=128) :: fldname_x + character(len=128) :: fldname_y + real(ESMF_KIND_R8), allocatable :: omask(:,:) + real(ESMF_KIND_R8), allocatable :: melt_potential(:,:) + real(ESMF_KIND_R8), allocatable :: frazil(:,:) + real(ESMF_KIND_R8), allocatable :: frzmlt(:,:) + real(ESMF_KIND_R8), allocatable :: ocz(:,:), ocm(:,:) + real(ESMF_KIND_R8), allocatable :: ocz_rot(:,:), ocm_rot(:,:) + real(ESMF_KIND_R8), allocatable :: ssh(:,:) + real(ESMF_KIND_R8), allocatable :: dhdx(:,:), dhdy(:,:) + real(ESMF_KIND_R8), allocatable :: dhdx_rot(:,:), dhdy_rot(:,:) character(len=*), parameter :: subname = '(mom_export)' !----------------------------------------------------------------------- rc = ESMF_SUCCESS - call State_getFldPtr(exportState,"So_omask", dataPtr_omask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call State_getFldPtr(exportState,"So_t", dataPtr_t, rc=rc) + ! Use Adcroft's rule of reciprocals; it does the right thing here. + call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - - call State_getFldPtr(exportState,"So_s", dataPtr_s, rc=rc) + call ESMF_TimeIntervalGet( timeStep, s=dt_int, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + if (real(dt_int) > 0.0) then + inv_dt_int = 1.0 / real(dt_int) + else + inv_dt_int = 0.0 + end if - call State_getFldPtr(exportState,"So_u", dataPtr_u, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + !---------------- + ! Copy from ocean_public to exportstate. + !---------------- - call State_getFldPtr(exportState,"So_v", dataPtr_v, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - call State_getFldPtr(exportState,"Fioo_q", dataPtr_fioo_q, rc=rc) + ! ------- + ! ocean mask + ! ------- + if (cesm_coupled) then + fldname = 'So_omask' + else + fldname = 'ocean_mask' + end if + allocate(omask(isc:iec, jsc:jec)) + ! TODO (mvertens, 2018-12-29): which is the correct formulation? + if (cesm_coupled) then + omask(:,:) = 1._ESMF_KIND_R8 + else + call ocean_model_data_get(ocean_state, ocean_public, 'mask', omask, isc, jsc) + do j = jsc,jec + do i = isc,iec + omask(i,j) = nint(omask(i,j)) + enddo + enddo + end if + call State_SetExport(exportState, trim(fldname), & + isc, iec, jsc, jec, omask, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call State_getFldPtr(exportState,"So_dhdx", dataPtr_dhdx, rc=rc) + ! ------- + ! Sea surface temperature + ! ------- + if (cesm_coupled) then + fldname = 'So_t' + else + fldname = 'sea_surface_temperature' + end if + call State_SetExport(exportState, trim(fldname), & + isc, iec, jsc, jec, ocean_public%t_surf, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call State_getFldPtr(exportState,"So_dhdy", dataPtr_dhdy, rc=rc) + ! ------- + ! Sea surface salinity + ! ------- + if (cesm_coupled) then + fldname = 'So_s' + else + fldname = 's_surf' + end if + call State_SetExport(exportState, trim(fldname), & + isc, iec, jsc, jec, ocean_public%s_surf, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out - !TODO: need to add the So_bldepth since this is needed for the wave model - call State_getFldPtr(exportState,"So_bldepth", dataPtr_bldepth, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! ------- + ! zonal and meridional currents + ! ------- + if (cesm_coupled) then + fldname_x = 'So_u' + fldname_y = 'So_v' + else + fldname_x = 'ocn_current_zonal' + fldname_y = 'ocn_current_merid' + end if - !---------------- + if (cesm_coupled) then + call State_SetExport(exportState, trim(fldname_x), & + isc, iec, jsc, jec, ocean_public%u_surf, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ! Use Adcroft's rule of reciprocals; it does the right thing here. - call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_TimeIntervalGet( timeStep, s=dt_int, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (real(dt_int) > 0.0) then - I_time_int = 1.0 / real(dt_int) + call State_SetExport(exportState, trim(fldname_y), & + isc, iec, jsc, jec, ocean_public%v_surf, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out else - I_time_int = 0.0 - end if + ! rotate ocn current from tripolar grid back to lat/lon grid x,y => latlon (CCW) + ! "ocean_grid" has halos and uses global indexing. - ! Copy from ocean_public to exportstate. ocean_public uses global indexing with no halos. - ! The mask comes from "grid" that uses the usual MOM domain that has halos - ! and does not use global indexing. - - n = 0 - do j=ocean_grid%jsc, ocean_grid%jec - jg = j + ocean_grid%jdg_offset - do i=ocean_grid%isc,ocean_grid%iec - ig = i + ocean_grid%idg_offset - n = n+1 - dataPtr_omask(n) = ocean_grid%mask2dT(i,j) - dataPtr_t(n) = ocean_public%t_surf(ig,jg) * ocean_grid%mask2dT(i,j) ! surface temp is in K - dataPtr_s(n) = ocean_public%s_surf(ig,jg) * ocean_grid%mask2dT(i,j) - dataPtr_u(n) = ocean_public%u_surf(ig,jg) * ocean_grid%mask2dT(i,j) - dataPtr_v(n) = ocean_public%v_surf(ig,jg) * ocean_grid%mask2dT(i,j) - dataPtr_bldepth(n) = ocean_public%OBLD(ig,jg) * ocean_grid%mask2dT(i,j) - ! ocean melt and freeze potential (o2x_Fioo_q), W m-2 - if (ocean_public%frazil(ig,jg) > 0.0) then - ! Frazil: change from J/m^2 to W/m^2 - dataPtr_Fioo_q(n) = ocean_public%frazil(ig,jg) * ocean_grid%mask2dT(i,j) * I_time_int - else - ! Melt_potential: change from J/m^2 to W/m^2 - dataPtr_Fioo_q(n) = -ocean_public%melt_potential(ig,jg) * ocean_grid%mask2dT(i,j) * I_time_int !* ncouple_per_day - - ! make sure Melt_potential is always <= 0 - if (dataPtr_Fioo_q(n) > 0.0) dataPtr_Fioo_q(n) = 0.0 - end if - end do - end do + allocate(ocz(isc:iec, jsc:jec)) + allocate(ocm(isc:iec, jsc:jec)) + allocate(ocz_rot(isc:iec, jsc:jec)) + allocate(ocm_rot(isc:iec, jsc:jec)) - ! Make a copy of ssh in order to do a halo update. - ! ssh has global indexing with halos + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + ocz(i,j) = ocean_public%u_surf(i,j) + ocm(i,j) = ocean_public%v_surf(i,j) + ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) & + + ocean_grid%sin_rot(ig,jg)*ocm(i,j) + ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) & + - ocean_grid%sin_rot(ig,jg)*ocz(i,j) + end do + end do - do j = ocean_grid%jsc, ocean_grid%jec - jg = j + ocean_grid%jdg_offset - do i = ocean_grid%isc,ocean_grid%iec - ig = i + ocean_grid%idg_offset - ssh(i,j) = ocean_public%sea_lev(ig,jg) - end do - end do + call State_SetExport(exportState, trim(fldname_x), & + isc, iec, jsc, jec, ocz_rot, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ! Update halo of ssh so we can calculate gradients - call pass_var(ssh, ocean_grid%domain) + call State_SetExport(exportState, trim(fldname_y), & + isc, iec, jsc, jec, ocm_rot, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ! d/dx ssh - n = 0 - do j=ocean_grid%jsc, ocean_grid%jec - do i=ocean_grid%isc,ocean_grid%iec - n = n+1 - ! This is a simple second-order difference - ! dataPtr_dhdx(n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) - ! This is a PLM slope which might be less prone to the A-ocean_grid null mode - slp_L = (ssh(I,j) - ssh(I-1,j)) * ocean_grid%mask2dCu(I-1,j) - if (ocean_grid%mask2dCu(I-1,j)==0.) slp_L = 0. - slp_R = (ssh(I+1,j) - ssh(I,j)) * ocean_grid%mask2dCu(I,j) - if (ocean_grid%mask2dCu(I+1,j)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - if ( (slp_L * slp_R) > 0.0 ) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - endif - dataPtr_dhdx(n) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) dataPtr_dhdx(n) = 0.0 - enddo - enddo + end if - ! d/dy ssh - n = 0 - do j=ocean_grid%jsc, ocean_grid%jec - do i=ocean_grid%isc,ocean_grid%iec - n = n+1 - ! This is a simple second-order difference - ! dataPtr_dhdy(n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) - ! This is a PLM slope which might be less prone to the A-ocean_grid null mode - slp_L = ssh(i,J) - ssh(i,J-1) * ocean_grid%mask2dCv(i,J-1) - if (ocean_grid%mask2dCv(i,J-1)==0.) slp_L = 0. - - slp_R = ssh(i,J+1) - ssh(i,J) * ocean_grid%mask2dCv(i,J) - if (ocean_grid%mask2dCv(i,J+1)==0.) slp_R = 0. - - slp_C = 0.5 * (slp_L + slp_R) - !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R - if ((slp_L * slp_R) > 0.0) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - endif - dataPtr_dhdy(n) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) dataPtr_dhdy(n) = 0.0 - enddo - enddo + ! ------- + ! Boundary layer depth + ! ------- + if (cesm_coupled) then + fldname = 'So_bldepth' + call State_SetExport(exportState, trim(fldname), & + isc, iec, jsc, jec, ocean_public%obld, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if - end subroutine mom_export_cesm + ! ------- + ! Oean melt and freeze potential + ! ------- + ! melt_potential, defined positive for T>Tfreeze, so need to change sign + ! Convert from J/m^2 to W/m^2 and make sure Melt_potential is always <= 0 -!=============================================================================== + if (cesm_coupled) then + fldname = 'Fioo_q' + else + fldname = 'inst_melt_potential' + end if + allocate(melt_potential(isc:iec, jsc:jec)) + if (cesm_coupled) then + do j = jsc,jec + do i = isc,iec + if (ocean_public%frazil(i,j) > 0.0) then + melt_potential(i,j) = ocean_public%frazil(i,j) * inv_dt_int + else + melt_potential(i,j) = -ocean_public%melt_potential(i,j) * inv_dt_int + if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 + end if + end do + end do + else + do j = jsc,jec + do i = isc,iec + ! TODO (mvertens, 2018-12-29): use inv_dt_int from cesm - and not the original implementation? + melt_potential(i,j) = -melt_potential(i,j) / dt_cpld + if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 + end do + end do + end if + call State_SetExport(exportState, trim(fldname), & + isc, iec, jsc, jec, melt_potential, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - subroutine mom_export_nems(ocean_state, ocean_public, ocean_grid, dt_cpld, exportState, rc) + ! ------- + ! frazil and freezing melting potential (nems only) + ! ------- + if (.not. cesm_coupled) then + allocate(frazil(isc:iec, jsc:jec)) + allocate(frzmlt(isc:iec, jsc:jec)) - ! Input/output variables - type (ocean_state_type) , pointer :: ocean_state - type (ocean_public_type) , pointer :: ocean_public - type (ocean_grid_type) , pointer :: ocean_grid - integer , intent(in) :: dt_cpld - type(ESMF_State) , intent(inout) :: exportState !< outgoing data - integer , intent(out) :: rc + do j = jsc,jec + do i = isc,iec + !convert from J/m^2 to W/m^2 for CICE coupling + frazil(i,j) = ocean_public%frazil(i,j)/dt_cpld + if (frazil(i,j) == 0.0) then + frzmlt(i,j) = melt_potential(i,j) + else + frzmlt(i,j) = frazil(i,j) + endif + frzmlt(i,j) = max(-1000.0,min(1000.0,frzmlt(i,j))) + end do + end do - ! Local variables - integer :: lbnd1, lbnd2, ubnd1, ubnd2 - integer :: i, j, i1, j1, ig, jg !< Grid indices - integer :: isc, iec, jsc, jec !< Grid indices - real :: slp_L, slp_R, slp_C, slope, u_min, u_max !JW - real(ESMF_KIND_R8), allocatable :: ofld(:,:) - real(ESMF_KIND_R8), allocatable :: ocz(:,:) - real(ESMF_KIND_R8), allocatable :: ocm(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ocz(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ocm(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_frazil(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_melt_potential(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_frzmlt(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_dhdx(:,:) !JW - real(ESMF_KIND_R8), pointer :: dataPtr_dhdy(:,:) !JW - real(ESMF_KIND_R8), allocatable :: ssh(:,:) - real(ESMF_KIND_R8), allocatable :: sshx(:,:) - real(ESMF_KIND_R8), allocatable :: sshy(:,:) - integer :: ijloc(2) - character(len=240) :: msgString - !-------------------------------- + fldname = 'accum_heat_frazil' + call State_SetExport(exportState, trim(fldname), & + isc, iec, jsc, jec, frazil, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call State_getFldPtr(exportState,'ocn_current_zonal',dataPtr_ocz,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + fldname = 'freezing_melting_potential' + call State_SetExport(exportState, trim(fldname), & + isc, iec, jsc, jec, frzmlt, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if - call State_getFldPtr(exportState,'ocn_current_merid',dataPtr_ocm,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! ------- + ! Sea level (nems only) + ! ------- + if (.not. cesm_coupled) then + fldname = 'sea_level' - call State_getFldPtr(exportState,'accum_heat_frazil',dataPtr_frazil,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call State_SetExport(exportState, trim(fldname), & + isc, iec, jsc, jec, ocean_public%sea_lev, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if - call State_getFldPtr(exportState,'inst_melt_potential',dataPtr_melt_potential,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + !---------------- + ! Sea-surface zonal and meridional slopes + !---------------- - call State_getFldPtr(exportState,'freezing_melting_potential',dataPtr_frzmlt,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (cesm_coupled) then + fldname_x = 'So_dhdx' + fldname_y = 'So_dhdy' + else + fldname_x = 'sea_surface_slope_zonal' + fldname_x = 'sea_surface_slope_merid' + end if - call State_getFldPtr(exportState,'sea_surface_slope_zonal',dataPtr_dhdx,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + allocate(ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !global indices + allocate(dhdx(isc:iec, jsc:jec)) !local indices + allocate(dhdy(isc:iec, jsc:jec)) !local indices + ssh = 0.0_ESMF_KIND_R8 + dhdx = 0.0_ESMF_KIND_R8 + dhdy = 0.0_ESMF_KIND_R8 - call State_getFldPtr(exportState,'sea_surface_slope_merid',dataPtr_dhdy,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out !JW - - allocate( ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW - allocate(sshx(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW - allocate(sshy(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !JW - ssh = 0.0_ESMF_KIND_R8 !JW - sshx = 0.0_ESMF_KIND_R8 !JW - sshy = 0.0_ESMF_KIND_R8 !JW - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! note: the following code is modified from NCAR nuopc driver mom_cap_methods - ! where is the rotation in that system? - ! - ! Make a copy of ssh in order to do a halo update. We use the usual MOM domain - ! in order to update halos. i.e. does not use global indexing. - ! - ! here, isc,iec,jsc,jec are global indices on cap domain (no halos) - - do j=jsc,jec - do i=isc,iec - j1 = j - ocean_grid%jdg_offset - i1 = i - ocean_grid%idg_offset - ssh(i1,j1) = Ocean_public%sea_lev(i,j) - end do + ! Make a copy of ssh in order to do a halo update (ssh has global indexing with halos) + do j = ocean_grid%jsc, ocean_grid%jec + jloc = j + ocean_grid%jdg_offset + do i = ocean_grid%isc,ocean_grid%iec + iloc = i + ocean_grid%idg_offset + ssh(i,j) = ocean_public%sea_lev(iloc,jloc) + end do end do ! Update halo of ssh so we can calculate gradients call pass_var(ssh, ocean_grid%domain) - ! calculation of slope on native mom domains (local indexing, halos) - ! stay inside of halos (ie 2:79,2:97) ! d/dx ssh - do j = ocean_grid%jsd+1,ocean_grid%jed-1 - do i = ocean_grid%isd+1,ocean_grid%ied-1 - ! This is a simple second-order difference - !dataPtr_dhdx(i1,j1) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) + ! This is a simple second-order difference + ! dhdx(i,j) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) + + do jloc = jsc, jec + j = jloc + ocean_grid%jsc - jsc + do iloc = isc,iec + i = iloc + ocean_grid%isc - isc ! This is a PLM slope which might be less prone to the A-grid null mode slp_L = (ssh(I,j) - ssh(I-1,j)) * ocean_grid%mask2dCu(i-1,j) if (ocean_grid%mask2dCu(i-1,j)==0.) slp_L = 0. @@ -803,23 +810,25 @@ subroutine mom_export_nems(ocean_state, ocean_public, ocean_grid, dt_cpld, expor ! larger extreme values. slope = 0.0 end if - sshx(i,j) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) sshx(i,j) = 0.0 + dhdx(iloc,jloc) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) dhdx(iloc,jloc) = 0.0 end do end do ! d/dy ssh - do j = ocean_grid%jsd+1,ocean_grid%jed-1 - do i = ocean_grid%isd+1,ocean_grid%ied-1 - ! This is a simple second-order difference - !dataPtr_dhdy(i1,j1) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) - ! This is a PLM slope which might be less prone to the A-grid null mode + ! This is a simple second-order difference + ! dhdy(i,j) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) + + do jloc = jsc, jec + j = jloc + ocean_grid%jsc - jsc + do iloc = isc,iec + i = iloc + ocean_grid%isc - isc + ! This is a PLM slope which might be less prone to the A-ocean_grid null mode slp_L = ssh(i,J) - ssh(i,J-1) * ocean_grid%mask2dCv(i,j-1) if (ocean_grid%mask2dCv(i,j-1)==0.) slp_L = 0. slp_R = ssh(i,J+1) - ssh(i,J) * ocean_grid%mask2dCv(i,j) if (ocean_grid%mask2dCv(i,j+1)==0.) slp_R = 0. slp_C = 0.5 * (slp_L + slp_R) - !write(6,*)'slp_L, slp_R,i,j,slp_L*slp_R', slp_L, slp_R,i,j,slp_L*slp_R if ((slp_L * slp_R) > 0.0) then ! This limits the slope so that the edge values are bounded by the ! two cell averages spanning the edge. @@ -831,103 +840,52 @@ subroutine mom_export_nems(ocean_state, ocean_public, ocean_grid, dt_cpld, expor ! larger extreme values. slope = 0.0 end if - sshy(i,j) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) sshy(i,j) = 0.0 + dhdy(iloc,jloc) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) dhdy(iloc,jloc) = 0.0 end do end do - ! rotate slopes from tripolar grid back to lat/lon grid (CCW) - ! "grid" uses the usual MOM domain that has halos - ! and does not use global indexing. - ! x,y => latlon - - lbnd1 = lbound(dataPtr_dhdx,1) - ubnd1 = ubound(dataPtr_dhdx,1) - lbnd2 = lbound(dataPtr_dhdx,2) - ubnd2 = ubound(dataPtr_dhdx,2) - - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j + ocean_grid%jsc - lbnd2 - i1 = i + ocean_grid%isc - lbnd1 - dataPtr_dhdx(i,j) = ocean_grid%cos_rot(i1,j1)*sshx(i1,j1) & - + ocean_grid%sin_rot(i1,j1)*sshy(i1,j1) - dataPtr_dhdy(i,j) = ocean_grid%cos_rot(i1,j1)*sshy(i1,j1) & - - ocean_grid%sin_rot(i1,j1)*sshx(i1,j1) - enddo - enddo - deallocate(ssh); deallocate(sshx); deallocate(sshy) - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - dataPtr_frazil = dataPtr_frazil/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling - - dataPtr_melt_potential = -dataPtr_melt_potential/dt_cpld !convert from J/m^2 to W/m^2 for CICE coupling - !melt_potential, defined positive for T>Tfreeze - !so change sign - !testing - ijloc = maxloc(dataPtr_frazil) - if((sum(ijloc) .gt. 2) .and. (dataPtr_frazil(ijloc(1),ijloc(2)) .gt. 0.0))then - i1 = ijloc(1) - lbnd1 + isc - j1 = ijloc(2) - lbnd2 + jsc ! work around local vs global indexing - - write (msgString,*)' MOM6 dataPtr_frazil at maxloc ',i1,j1,& - real(dataPtr_frazil(ijloc(1),ijloc(2)),4) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - - write (msgString,*)' MOM6 dataPtr_melt_potential at maxloc ',i1,j1,& - real(dataPtr_melt_potential(ijloc(1),ijloc(2)),4) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - endif - !testing - - dataPtr_melt_potential = min(dataPtr_melt_potential,0.0) - - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - if(dataPtr_frazil(i,j) .eq. 0.0)then - dataPtr_frzmlt(i,j) = dataPtr_melt_potential(i,j) - else - dataPtr_frzmlt(i,j) = dataPtr_frazil(i,j) - endif - enddo - enddo - dataPtr_frzmlt = max(-1000.0,min(1000.0,dataPtr_frzmlt)) - - ! rotate ocn current from tripolar grid back to lat/lon grid (CCW) - ! "grid" uses the usual MOM domain that has halos and does not use global indexing. - ! x,y => latlon - - allocate(ofld(isc:iec,jsc:jec)) - call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_mask(i,j) = nint(ofld(i1,j1)) - enddo - enddo - deallocate(ofld) - - allocate(ocz(lbnd1:ubnd1,lbnd2:ubnd2)) - allocate(ocm(lbnd1:ubnd1,lbnd2:ubnd2)) - ocz = dataPtr_ocz - ocm = dataPtr_ocm - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j + ocean_grid%jsc - lbnd2 - i1 = i + ocean_grid%isc - lbnd1 - dataPtr_ocz(i,j) = ocean_grid%cos_rot(i1,j1)*ocz(i,j) & - + ocean_grid%sin_rot(i1,j1)*ocm(i,j) - dataPtr_ocm(i,j) = ocean_grid%cos_rot(i1,j1)*ocm(i,j) & - - ocean_grid%sin_rot(i1,j1)*ocz(i,j) - ! multiply by mask to zero out non-ocean points - dataPtr_ocz(i,j) = dataPtr_ocz(i,j) * dataPtr_mask(i,j) - dataPtr_ocm(i,j) = dataPtr_ocm(i,j) * dataPtr_mask(i,j) - enddo - enddo - deallocate(ocz, ocm) - - end subroutine mom_export_nems + if (cesm_coupled) then + ! TODO (mvertens, 2018-12-29): do we want to do the rotation like for nems? + ! and is the nems rotation correct (since GM pointed out that the NEMS taux, tauy rotation was not) + call State_SetExport(exportState, trim(fldname_x), isc, iec, jsc, jec, dhdx, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_SetExport(exportState, trim(fldname_y), isc, iec, jsc, jec, dhdy, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + else + ! rotate slopes from tripolar grid back to lat/lon grid, x,y => latlon (CCW) + ! "ocean_grid" uses has halos and uses global indexing. + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) & + + ocean_grid%sin_rot(ig,jg)*dhdy(i,j) + dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) & + - ocean_grid%sin_rot(ig,jg)*dhdx(i,j) + end do + end do + + call State_SetExport(exportState, trim(fldname_x), isc, iec, jsc, jec, dhdx_rot, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call State_SetExport(exportState, trim(fldname_y), isc, iec, jsc, jec, dhdy_rot, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + + end subroutine mom_export !=============================================================================== From 8af6c8c3baa854383cba65beea271782a6777d7f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 30 Dec 2018 18:20:38 -0700 Subject: [PATCH 0979/1072] updates to set grid or mesh only in one place --- .../nuopc_driver/MOM_surface_forcing.F90 | 7 +--- config_src/nuopc_driver/mom_cap.F90 | 39 +++++++------------ config_src/nuopc_driver/mom_cap_methods.F90 | 12 +----- config_src/nuopc_driver/mom_cap_share.F90 | 34 ++++++++++++++++ 4 files changed, 51 insertions(+), 41 deletions(-) create mode 100644 config_src/nuopc_driver/mom_cap_share.F90 diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index b652b5fc9e..6528336402 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -40,6 +40,7 @@ module MOM_surface_forcing 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 +use mom_cap_share implicit none ; private @@ -196,12 +197,6 @@ module MOM_surface_forcing integer :: id_clock_forcing -#ifdef CESMCOUPLED - logical :: cesm_coupled = .true. -#else - logical :: cesm_coupled = .false. -#endif - !======================================================================= contains !======================================================================= diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index e7dfb579f5..bc409dbfd7 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -394,11 +394,8 @@ module mom_cap_mod use MOM_ocean_model, only: ocean_model_data_get, ocean_model_init_sfc use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid use mom_cap_time, only: AlarmInit -#ifdef CESMCOUPLED - use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit - use shr_file_mod, only: shr_file_setLogUnit, shr_file_setLogLevel -#endif use mom_cap_methods, only: mom_import, mom_export + use mom_cap_share use, intrinsic :: iso_fortran_env, only: output_unit @@ -459,12 +456,6 @@ module mom_cap_mod character(len=*),parameter :: u_file_u = & __FILE__ -#ifdef CESMCOUPLED - logical :: cesm_coupled = .true. -#else - logical :: cesm_coupled = .false. -#endif - !======================================================================= contains !======================================================================= @@ -1195,9 +1186,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) rc = ESMF_SUCCESS -#ifdef CESMCOUPLED - call shr_file_setLogUnit (logunit) -#endif + if (cesm_coupled) then + call shr_file_setLogUnit (logunit) + end if !---------------------------------------------------------------------------- ! Get pointers to ocean internal state @@ -1284,7 +1275,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Create either a grid or a mesh !--------------------------------- - if (cesm_coupled) then + if (geomtype == ESMF_GEOMTYPE_MESH) then !--------------------------------- ! Create a MOM6 mesh @@ -1348,7 +1339,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out - else + else if (geomtype == ESMF_GEOMTYPE_GRID) then !--------------------------------- ! create a MOM6 grid @@ -1936,9 +1927,9 @@ subroutine ModelAdvance(gcomp, rc) rc = ESMF_SUCCESS if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") -#ifdef CESMCOUPLED - call shr_file_setLogUnit (logunit) -#endif + if (cesm_coupled) then + call shr_file_setLogUnit (logunit) + end if ! query the Component for its clock, importState and exportState call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & @@ -2030,9 +2021,9 @@ subroutine ModelAdvance(gcomp, rc) ! Import data !--------------- -#ifdef CESMCOUPLED - call shr_file_setLogUnit (logunit) -#endif + if (cesm_coupled) then + call shr_file_setLogUnit (logunit) + end if if (cesm_coupled) then call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype=runtype, rc=rc) @@ -2080,11 +2071,9 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out -#ifdef CESM_COUPLED - ! reset shr logging to my original values - call shr_file_setLogUnit (output_unit) + if (cesm_coupled) then + call shr_file_setLogUnit (logunit) end if -#endif !--------------- ! If restart alarm is ringing - write restart file diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 98de08358b..a33dbf4c22 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -28,6 +28,7 @@ module mom_cap_methods use MOM_domains, only: pass_var use MOM_error_handler, only: is_root_pe use mpp_domains_mod, only: mpp_get_compute_domain + use mom_cap_share ! By default make data private implicit none @@ -45,16 +46,7 @@ module mom_cap_methods module procedure State_GetFldPtr_2d end interface -#ifdef CESMCOUPLED - logical :: cesm_coupled = .true. - type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_MESH -#else - logical :: cesm_coupled = .false. - type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID -#endif - - integer :: rc,dbrc - integer :: import_cnt = 0 + integer :: import_cnt = 0 !=============================================================================== contains diff --git a/config_src/nuopc_driver/mom_cap_share.F90 b/config_src/nuopc_driver/mom_cap_share.F90 new file mode 100644 index 0000000000..59dc8ac0ba --- /dev/null +++ b/config_src/nuopc_driver/mom_cap_share.F90 @@ -0,0 +1,34 @@ +module mom_cap_share + ! Temporary module for sharing ccp defs and other settings + ! betwen NEMS and CMEPS + + use ESMF , only: ESMF_GeomType_Flag + use ESMF , only: ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID +#ifdef CESMCOUPLED + use shr_file_mod , only: shr_file_setLogUnit, shr_file_getLogUnit +#endif + + implicit none + public + + integer :: shrlogUnit + +#ifdef CESMCOUPLED + logical :: cesm_coupled = .true. + type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_MESH +#else + logical :: cesm_coupled = .false. + type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID +#endif + +contains + +#ifndef CESMCOUPLED + subroutine shr_file_setLogUnit(nunit) + integer, intent(in) :: nunit + ! do nothing for this stub - its just here to replace + ! having cppdefs in the main program + end subroutine shr_file_setLogUnit +#endif + +end module mom_cap_share From c9faeac64f2ae137b1b3c8d5858c1e4b56e77971 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 30 Dec 2018 18:21:37 -0700 Subject: [PATCH 0980/1072] removed trailing whitespace --- config_src/nuopc_driver/mom_cap.F90 | 2 +- config_src/nuopc_driver/mom_cap_methods.F90 | 26 ++++++++++----------- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index bc409dbfd7..8c3f4ee982 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1040,7 +1040,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") ! not in CESM ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") ! not in CESM - ! CESM currently not used + ! CESM currently not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index a33dbf4c22..b108971dcd 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -52,8 +52,8 @@ module mom_cap_methods contains !=============================================================================== - !> This function has a few purposes: - !! (1) it imports surface fluxes using data from the mediator; and + !> This function has a few purposes: + !! (1) it imports surface fluxes using data from the mediator; and !! (2) 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. @@ -162,7 +162,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! ------- ! Net longwave radiation (W/m2) ! ------- - ! Different treatment of long wave dependent on atmosphere + ! Different treatment of long wave dependent on atmosphere ! When running with cam or datm - need Foxx_lwup and Faxa_lwdn ! When running with fv3 - need mean_net_lw_flx @@ -431,7 +431,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, file=__FILE__)) & return ! bail out if (cesm_coupled) then - ! salt flux (minus sign needed here -GMM) + ! salt flux (minus sign needed here -GMM) ! TODO (mvertens, 2018-12-28): NEMS does not have a minus sign - which one is right? do j = jsc,jec do i = isc,iec @@ -439,7 +439,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, enddo enddo end if - + !---- ! mass of overlying ice !---- @@ -517,7 +517,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, end if !---------------- - ! Copy from ocean_public to exportstate. + ! Copy from ocean_public to exportstate. !---------------- call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) @@ -675,7 +675,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, melt_potential(i,j) = ocean_public%frazil(i,j) * inv_dt_int else melt_potential(i,j) = -ocean_public%melt_potential(i,j) * inv_dt_int - if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 + if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 end if end do end do @@ -684,7 +684,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, do i = isc,iec ! TODO (mvertens, 2018-12-29): use inv_dt_int from cesm - and not the original implementation? melt_potential(i,j) = -melt_potential(i,j) / dt_cpld - if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 + if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 end do end do end if @@ -705,7 +705,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, do j = jsc,jec do i = isc,iec !convert from J/m^2 to W/m^2 for CICE coupling - frazil(i,j) = ocean_public%frazil(i,j)/dt_cpld + frazil(i,j) = ocean_public%frazil(i,j)/dt_cpld if (frazil(i,j) == 0.0) then frzmlt(i,j) = melt_potential(i,j) else @@ -876,7 +876,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, file=__FILE__)) & return ! bail out end if - + end subroutine mom_export !=============================================================================== @@ -977,7 +977,7 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r n = 0 do j = jsc,jec do i = isc,iec - n = n + 1 + n = n + 1 if (present(do_sum)) then output(i,j) = output(i,j) + dataPtr1d(n) else @@ -1076,12 +1076,12 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid lbnd2 = lbound(dataPtr2d,2) do j = jsc, jec - j1 = j + lbnd2 - jsc + j1 = j + lbnd2 - jsc jg = j + ocean_grid%jsc - jsc do i = isc, iec i1 = i + lbnd1 - isc ig = i + ocean_grid%isc - isc - dataPtr2d(i1,j1) = input(i,j) * ocean_grid%mask2dT(ig,jg) + dataPtr2d(i1,j1) = input(i,j) * ocean_grid%mask2dT(ig,jg) end do end do From 5a2dd8be0aaeb3a5aa4fba8aed120ee841ad553a Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 31 Dec 2018 10:09:03 -0700 Subject: [PATCH 0981/1072] more unification --- config_src/nuopc_driver/mom_cap.F90 | 234 ++++++++------- config_src/nuopc_driver/mom_cap_methods.F90 | 303 +++++++++++--------- config_src/nuopc_driver/mom_cap_share.F90 | 8 + 3 files changed, 283 insertions(+), 262 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 8c3f4ee982..662a8bd011 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -429,8 +429,6 @@ module mom_cap_mod character(len=64) :: stdname character(len=64) :: shortname character(len=64) :: transferOffer - logical :: assoc ! is the farrayPtr associated with internal data - real(ESMF_KIND_R8), dimension(:,:), pointer :: farrayPtr end type fld_list_type integer,parameter :: fldsMax = 100 @@ -443,7 +441,6 @@ module mom_cap_mod integer :: import_slice = 1 integer :: export_slice = 1 character(len=256) :: tmpstr - type(ESMF_Grid) :: mom_grid_i logical :: write_diagnostics = .false. character(len=32) :: runtype ! run type integer :: logunit ! stdout logging unit number @@ -763,9 +760,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: userRc character(len=512) :: restartfile ! Path/Name of restart file character(len=*), parameter :: subname='(mom_cap:InitializeAdvertise)' - real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_frzmlt - real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_dhdx - real(ESMF_KIND_R8), dimension(:,:), pointer :: dataPtr_dhdy !-------------------------------- rc = ESMF_SUCCESS @@ -1167,7 +1161,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: nblocks_tot logical :: found real(ESMF_KIND_R8), allocatable :: ofld(:,:), gfld(:,:) - real(ESMF_KIND_R8), pointer :: t_surf(:,:) + real(ESMF_KIND_R8), pointer :: t_surf1d(:,:) + real(ESMF_KIND_R8), pointer :: t_surf2d(:,:) integer(ESMF_KIND_I4), pointer :: dataPtr_mask(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_area(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_xcen(:,:) @@ -1180,6 +1175,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: lsize integer :: ig,jg, ni,nj,k integer, allocatable :: gindex(:) ! global index space + character(len=128) :: fldname character(len=256) :: cvalue character(len=*), parameter :: subname='(mom_cap:InitializeRealize)' !-------------------------------- @@ -1333,6 +1329,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out + call MOM_RealizeFields(exportState, fldsFrOcn_num, fldsFrOcn, "Ocn export", mesh=Emesh, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1450,8 +1447,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out - mom_grid_i = gridIn - call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1737,46 +1732,58 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) endif !--------------------------------- - ! realize fields on grid + ! set surface temperature to 0 if ocean mask is 0 !--------------------------------- - call ESMF_StateGet(exportState, itemSearch="sea_surface_temperature", itemCount=icount, rc=rc) + ! TODO (mvertens, 2018-12-30): is this really necessary? for now only do this for grid + + if (cesm_coupled) then + fldname = 'So_t' + else + fldname = 'sea_surface_temperature' + end if + + call ESMF_StateGet(exportState, itemSearch=trim(fldname), itemCount=icount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out ! Do sst initialization if it's part of export state - if(icount /= 0) then - - call ESMF_StateGet(exportState, itemName='sea_surface_temperature', field=field_t_surf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_FieldGet(field_t_surf, localDe=0, farrayPtr=t_surf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) - - lbnd1 = lbound(t_surf,1) - ubnd1 = ubound(t_surf,1) - lbnd2 = lbound(t_surf,2) - ubnd2 = ubound(t_surf,2) - - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - if (ofld(i1,j1) == 0.) t_surf(i,j) = 0.0 - enddo - enddo + if (icount /= 0) then + call ESMF_StateGet(exportState, itemName=trim(fldname), field=field_t_surf, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) + + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_FieldGet(field_t_surf, localDe=0, farrayPtr=t_surf2d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(t_surf2d,1) + ubnd1 = ubound(t_surf2d,1) + lbnd2 = lbound(t_surf2d,2) + ubnd2 = ubound(t_surf2d,2) + + do j = lbnd2, ubnd2 + do i = lbnd1, ubnd1 + j1 = j - lbnd2 + jsc + i1 = i - lbnd1 + isc + if (ofld(i1,j1) == 0.) t_surf2d(i,j) = 0.0 + enddo + enddo + end if + end if - deallocate(ofld) - endif + !--------------------------------- + ! write out diagnostics + !--------------------------------- !call NUOPC_Write(exportState, fileNamePrefix='post_realize_field_ocn_export_', & ! timeslice=1, relaxedFlag=.true., rc=rc) @@ -1784,7 +1791,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! line=__LINE__, & ! file=__FILE__)) & ! return ! bail out - + end subroutine InitializeRealize !=============================================================================== @@ -2409,6 +2416,7 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ ! ---------------------------------------------- ! Set scalar data from State for a particular name ! ---------------------------------------------- + real(ESMF_KIND_R8),intent(in) :: value integer, intent(in) :: scalar_id type(ESMF_State), intent(inout) :: State @@ -2418,10 +2426,10 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ integer, intent(inout) :: rc ! local variables - integer :: ierr, len type(ESMF_Field) :: field real(ESMF_KIND_R8), pointer :: farrayptr(:,:) character(len=*), parameter :: subname='(mom_cap:State_SetScalar)' + !-------------------------------------------------------- rc = ESMF_SUCCESS @@ -2448,6 +2456,7 @@ end subroutine State_SetScalar subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) + ! input/output variables type(ESMF_State) , intent(inout) :: state integer , intent(in) :: nfields type(fld_list_type) , intent(inout) :: field_defs(:) @@ -2456,13 +2465,13 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) type(ESMF_Mesh) , intent(in), optional :: mesh integer , intent(inout) :: rc - integer :: i - type(ESMF_Field) :: field - integer :: npet, nx, ny, pet - integer :: elb(2), eub(2), clb(2), cub(2), tlb(2), tub(2) - type(ESMF_VM) :: vm - real(ESMF_KIND_R8), pointer :: fldptr(:,:) + ! local variables + integer :: i + type(ESMF_Field) :: field + real(ESMF_KIND_R8), pointer :: fldptr1d(:) ! for mesh + real(ESMF_KIND_R8), pointer :: fldptr2d(:,:) ! for grid character(len=*),parameter :: subname='(mom_cap:MOM_RealizeFields)' + !-------------------------------------------------------- rc = ESMF_SUCCESS @@ -2471,45 +2480,18 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) if (NUOPC_IsConnected(state, fieldName=field_defs(i)%shortname)) then if (field_defs(i)%shortname == scalar_field_name) then + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected on root pe.", & ESMF_LOGMSG_INFO, & line=__LINE__, & file=__FILE__, & rc=rc) + call SetScalarField(field, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - elseif (field_defs(i)%assoc) then - call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname)& - // " is connected and associated.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=rc) - write(tmpstr,'(a,4i12)') subname//trim(tag)//' Field '//trim(field_defs(i)%shortname)//':', & - lbound(field_defs(i)%farrayPtr,1), ubound(field_defs(i)%farrayPtr,1), & - lbound(field_defs(i)%farrayPtr,2), ubound(field_defs(i)%farrayPtr,2) - call ESMF_LogWrite(tmpstr, ESMF_LOGMSG_INFO, rc=rc) - - if (present(grid)) then - field = ESMF_FieldCreate(grid=grid, & - farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & - !farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_GLOBAL, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else if (present(mesh)) then - field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if else @@ -2518,6 +2500,7 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) line=__LINE__, & file=__FILE__, & rc=rc) + if (present(grid)) then field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & @@ -2527,13 +2510,13 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) file=__FILE__)) & return ! bail out - ! initialize to zero - call ESMF_FieldGet(field, farrayPtr=fldptr, rc=rc) + ! initialize fldptr to zero + call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - fldptr = 0.0 + fldptr2d(:,:) = 0.0 else if (present(mesh)) then @@ -2543,16 +2526,28 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) line=__LINE__, & file=__FILE__)) & return ! bail out + + ! initialize fldptr to zero + call ESMF_FieldGet(field, farrayPtr=fldptr1d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + fldptr1d(:) = 0.0 + end if endif + ! Realize connected field call NUOPC_Realize(state, field=field, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - else + + else ! field is not connected + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is not connected.", & ESMF_LOGMSG_INFO, & line=__LINE__, & @@ -2564,63 +2559,67 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) line=__LINE__, & file=__FILE__)) & return ! bail out + endif enddo - end subroutine MOM_RealizeFields + contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -!=============================================================================== + subroutine SetScalarField(field, rc) - subroutine SetScalarField(field, rc) - ! ---------------------------------------------- - ! create a field with scalar data on the root pe - ! ---------------------------------------------- - type(ESMF_Field), intent(inout) :: field - integer, intent(inout) :: rc + ! create a field with scalar data on the root pe + type(ESMF_Field), intent(inout) :: field + integer, intent(inout) :: rc - ! local variables - type(ESMF_Distgrid) :: distgrid - type(ESMF_Grid) :: grid - character(len=*), parameter :: subname='(mom_cap:SetScalarField)' + ! local variables + type(ESMF_Distgrid) :: distgrid + type(ESMF_Grid) :: grid + character(len=*), parameter :: subname='(mom_cap:SetScalarField)' - rc = ESMF_SUCCESS + rc = ESMF_SUCCESS - ! create a DistGrid with a single index space element, which gets mapped onto DE 0. - distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/1/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! create a DistGrid with a single index space element, which gets mapped onto DE 0. + distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/1/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - grid = ESMF_GridCreate(distgrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + grid = ESMF_GridCreate(distgrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - field = ESMF_FieldCreate(name=trim(scalar_field_name), grid=grid, & - typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), & - ungriddedUBound=(/scalar_field_count/), & ! num of scalar values - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + field = ESMF_FieldCreate(name=trim(scalar_field_name), grid=grid, typekind=ESMF_TYPEKIND_R8, & + ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), rc=rc) ! num of scalar values + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - end subroutine SetScalarField + end subroutine SetScalarField + + end subroutine MOM_RealizeFields !=============================================================================== - subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) + subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname) ! ---------------------------------------------- ! Set up a list of field information ! ---------------------------------------------- - integer, intent(inout) :: num - type(fld_list_type), intent(inout) :: fldlist(:) - character(len=*), intent(in) :: stdname - character(len=*), intent(in) :: transferOffer - real(ESMF_KIND_R8), dimension(:,:), optional, target :: data - character(len=*), intent(in),optional :: shortname + integer, intent(inout) :: num + type(fld_list_type), intent(inout) :: fldlist(:) + character(len=*), intent(in) :: stdname + character(len=*), intent(in) :: transferOffer + character(len=*), optional, intent(in) :: shortname ! local variables integer :: rc character(len=*), parameter :: subname='(mom_cap:fld_list_add)' ! fill in the new entry - num = num + 1 if (num > fldsMax) then call ESMF_LogSetError(ESMF_RC_VAL_OUTOFRANGE, & @@ -2636,13 +2635,6 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, data, shortname) fldlist(num)%shortname = trim(stdname) endif fldlist(num)%transferOffer = trim(transferOffer) - if (present(data)) then - fldlist(num)%assoc = .true. - ! The following sets up the data pointer that will be used in the realize call - fldlist(num)%farrayPtr => data - else - fldlist(num)%assoc = .false. - endif end subroutine fld_list_add diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index b108971dcd..19e4c01251 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -5,9 +5,6 @@ module mom_cap_methods ! Masks, areas, center (tlat, tlon), and corner (ulat, ulon) coordinates are then added to the `ESMF_Grid` ! by retrieving those fields from MOM with calls to `ocean_model_data_get()`. - - use NUOPC, only: NUOPC_Advertise, NUOPC_Realize, NUOPC_IsConnected - use NUOPC_Model, only: NUOPC_ModelGet use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet use ESMF, only: ESMF_State, ESMF_StateGet @@ -430,6 +427,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, line=__LINE__, & file=__FILE__)) & return ! bail out + if (cesm_coupled) then ! salt flux (minus sign needed here -GMM) ! TODO (mvertens, 2018-12-28): NEMS does not have a minus sign - which one is right? @@ -443,8 +441,9 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! mass of overlying ice !---- - if (.not. cesm_coupled) then - fldname = 'mass_of_overlying_ice' + fldname = 'mass_of_overlying_ice' + call ESMF_StateGet(importState, trim(fldname), itemFlag) + if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then call state_getimport(importState, trim(fldname), & isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -476,12 +475,16 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, integer :: isc, iec, jsc, jec ! local indices integer :: iloc, jloc ! local indices integer :: n + integer :: icount real :: slp_L, slp_R, slp_C real :: slope, u_min, u_max integer :: day, secs type(ESMF_TimeInterval) :: timeStep integer :: dt_int real :: inv_dt_int !< The inverse of coupling time interval in s-1. + type(ESMF_StateItem_Flag) :: itemFlag + type(ESMF_StateItem_Flag) :: itemFlag1 + type(ESMF_StateItem_Flag) :: itemFlag2 character(len=128) :: fldname character(len=128) :: fldname_x character(len=128) :: fldname_y @@ -590,30 +593,31 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, fldname_y = 'ocn_current_merid' end if - if (cesm_coupled) then - call State_SetExport(exportState, trim(fldname_x), & - isc, iec, jsc, jec, ocean_public%u_surf, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call State_SetExport(exportState, trim(fldname_y), & - isc, iec, jsc, jec, ocean_public%v_surf, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else + ! rotate ocn current from tripolar grid back to lat/lon grid x,y => latlon (CCW) + ! "ocean_grid" has halos and uses global indexing. - ! rotate ocn current from tripolar grid back to lat/lon grid x,y => latlon (CCW) - ! "ocean_grid" has halos and uses global indexing. + ! TODO (mvertens, 2018-12-30): Only one of these is correct - the cesm_coupled one is the + ! latest and is the one that GM feels is the correct one - allocate(ocz(isc:iec, jsc:jec)) - allocate(ocm(isc:iec, jsc:jec)) - allocate(ocz_rot(isc:iec, jsc:jec)) - allocate(ocm_rot(isc:iec, jsc:jec)) + allocate(ocz(isc:iec, jsc:jec)) + allocate(ocm(isc:iec, jsc:jec)) + allocate(ocz_rot(isc:iec, jsc:jec)) + allocate(ocm_rot(isc:iec, jsc:jec)) + if (cesm_coupled) then + ! do j = jsc, jec + ! jg = j + ocean_grid%jsc - jsc + ! do i = isc, iec + ! ig = i + ocean_grid%isc - isc + ! ocz(i,j) = ocean_public%u_surf(i,j) + ! ocm(i,j) = ocean_public%v_surf(i,j) + ! ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) & + ! - ocean_grid%sin_rot(ig,jg)*ocm(i,j) + ! ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) & + ! + ocean_grid%sin_rot(ig,jg)*ocz(i,j) + ! end do + ! end do + else do j = jsc, jec jg = j + ocean_grid%jsc - jsc do i = isc, iec @@ -626,28 +630,28 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, - ocean_grid%sin_rot(ig,jg)*ocz(i,j) end do end do - - call State_SetExport(exportState, trim(fldname_x), & - isc, iec, jsc, jec, ocz_rot, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call State_SetExport(exportState, trim(fldname_y), & - isc, iec, jsc, jec, ocm_rot, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if + call State_SetExport(exportState, trim(fldname_x), & + isc, iec, jsc, jec, ocean_public%u_surf, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call State_SetExport(exportState, trim(fldname_y), & + isc, iec, jsc, jec, ocean_public%v_surf, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ! ------- ! Boundary layer depth ! ------- - if (cesm_coupled) then - fldname = 'So_bldepth' + fldname = 'So_bldepth' + call ESMF_StateGet(exportState, trim(fldname), itemFlag, rc=rc) + if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then call State_SetExport(exportState, trim(fldname), & isc, iec, jsc, jec, ocean_public%obld, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -696,9 +700,13 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, return ! bail out ! ------- - ! frazil and freezing melting potential (nems only) + ! frazil and freezing melting potential ! ------- - if (.not. cesm_coupled) then + + call ESMF_StateGet(exportState, 'accum_heat_frazil' , itemFlag1) + call ESMF_StateGet(exportState, 'freezing_melting_potential', itemFlag2) + if (itemFlag1 /= ESMF_STATEITEM_NOTFOUND .and. itemFlag2 /= ESMF_STATEITEM_NOTFOUND) then + allocate(frazil(isc:iec, jsc:jec)) allocate(frzmlt(isc:iec, jsc:jec)) @@ -733,11 +741,11 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, end if ! ------- - ! Sea level (nems only) + ! Sea level ! ------- - if (.not. cesm_coupled) then - fldname = 'sea_level' - + fldname = 'sea_level' + call ESMF_StateGet(exportState, trim(fldname), itemFlag, rc=rc) + if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then call State_SetExport(exportState, trim(fldname), & isc, iec, jsc, jec, ocean_public%sea_lev, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -837,23 +845,23 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, end do end do - if (cesm_coupled) then - ! TODO (mvertens, 2018-12-29): do we want to do the rotation like for nems? - ! and is the nems rotation correct (since GM pointed out that the NEMS taux, tauy rotation was not) - call State_SetExport(exportState, trim(fldname_x), isc, iec, jsc, jec, dhdx, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_SetExport(exportState, trim(fldname_y), isc, iec, jsc, jec, dhdy, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! rotate slopes from tripolar grid back to lat/lon grid, x,y => latlon (CCW) + ! "ocean_grid" uses has halos and uses global indexing. + ! TODO (mvertens, 2018-12-30): Only one of these is correct - the cesm_coupled one is the + ! latest and is the one that GM feels is the correct one + if (cesm_coupled) then + ! do j = jsc, jec + ! jg = j + ocean_grid%jsc - jsc + ! do i = isc, iec + ! ig = i + ocean_grid%isc - isc + ! dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) & + ! - ocean_grid%sin_rot(ig,jg)*dhdy(i,j) + ! dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) & + ! + ocean_grid%sin_rot(ig,jg)*dhdx(i,j) + ! end do + ! end do else - ! rotate slopes from tripolar grid back to lat/lon grid, x,y => latlon (CCW) - ! "ocean_grid" uses has halos and uses global indexing. do j = jsc, jec jg = j + ocean_grid%jsc - jsc do i = isc, iec @@ -864,19 +872,20 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, - ocean_grid%sin_rot(ig,jg)*dhdx(i,j) end do end do - - call State_SetExport(exportState, trim(fldname_x), isc, iec, jsc, jec, dhdx_rot, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call State_SetExport(exportState, trim(fldname_y), isc, iec, jsc, jec, dhdy_rot, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out end if + call State_SetExport(exportState, trim(fldname_x), isc, iec, jsc, jec, dhdx, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call State_SetExport(exportState, trim(fldname_y), isc, iec, jsc, jec, dhdy, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end subroutine mom_export !=============================================================================== @@ -955,6 +964,7 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r integer , intent(out) :: rc ! local variables + type(ESMF_StateItem_Flag) :: itemFlag integer :: n, i, j, i1, j1 integer :: lbnd1,lbnd2 real(ESMF_KIND_R8), pointer :: dataPtr1d(:) @@ -964,50 +974,55 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r rc = ESMF_SUCCESS - if (geomtype == ESMF_GEOMTYPE_MESH) then + call ESMF_StateGet(State, trim(fldname), itemFlag, rc=rc) + if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then - ! get field pointer - call state_getfldptr(state, trim(fldname), dataptr1d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (geomtype == ESMF_GEOMTYPE_MESH) then - ! determine output array - n = 0 - do j = jsc,jec - do i = isc,iec - n = n + 1 - if (present(do_sum)) then - output(i,j) = output(i,j) + dataPtr1d(n) - else - output(i,j) = dataPtr1d(n) - end if + ! get field pointer + call state_getfldptr(state, trim(fldname), dataptr1d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! determine output array + n = 0 + do j = jsc,jec + do i = isc,iec + n = n + 1 + if (present(do_sum)) then + output(i,j) = output(i,j) + dataPtr1d(n) + else + output(i,j) = dataPtr1d(n) + end if + end do end do - end do - else if (geomtype == ESMF_GEOMTYPE_GRID) then + else if (geomtype == ESMF_GEOMTYPE_GRID) then - call state_getfldptr(state, trim(fldname), dataptr2d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call state_getfldptr(state, trim(fldname), dataptr2d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - lbnd1 = lbound(dataPtr2d,1) - lbnd2 = lbound(dataPtr2d,2) + lbnd1 = lbound(dataPtr2d,1) + lbnd2 = lbound(dataPtr2d,2) - do j = jsc, jec - j1 = j + lbnd2 - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - if (present(do_sum)) then - output(i,j) = output(i,j) + dataPtr2d(i1,j1) - else - output(i,j) = dataPtr2d(i1,j1) - end if + do j = jsc, jec + j1 = j + lbnd2 - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + if (present(do_sum)) then + output(i,j) = output(i,j) + dataPtr2d(i1,j1) + else + output(i,j) = dataPtr2d(i1,j1) + end if + end do end do - end do + + end if end if @@ -1033,6 +1048,7 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid integer , intent(out) :: rc ! local variables + type(ESMF_StateItem_Flag) :: itemFlag integer :: n, i, j, i1, j1, ig,jg integer :: lbnd1,lbnd2 real(ESMF_KIND_R8), pointer :: dataPtr1d(:) @@ -1046,44 +1062,49 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid ! input array from "ocean_public" uses local indexing without halos ! mask from "ocean_grid" uses global indexing with halos - if (geomtype == ESMF_GEOMTYPE_MESH) then + call ESMF_StateGet(State, trim(fldname), itemFlag, rc=rc) + if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then - call state_getfldptr(state, trim(fldname), dataptr1d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (geomtype == ESMF_GEOMTYPE_MESH) then - n = 0 - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - n = n+1 - dataPtr1d(n) = input(i,j) * ocean_grid%mask2dT(ig,jg) + call state_getfldptr(state, trim(fldname), dataptr1d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + n = 0 + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + n = n+1 + dataPtr1d(n) = input(i,j) * ocean_grid%mask2dT(ig,jg) + end do end do - end do - else if (geomtype == ESMF_GEOMTYPE_GRID) then + else if (geomtype == ESMF_GEOMTYPE_GRID) then - call state_getfldptr(state, trim(fldname), dataptr2d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call state_getfldptr(state, trim(fldname), dataptr2d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - lbnd1 = lbound(dataPtr2d,1) - lbnd2 = lbound(dataPtr2d,2) + lbnd1 = lbound(dataPtr2d,1) + lbnd2 = lbound(dataPtr2d,2) - do j = jsc, jec - j1 = j + lbnd2 - jsc - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + ocean_grid%isc - isc - dataPtr2d(i1,j1) = input(i,j) * ocean_grid%mask2dT(ig,jg) + do j = jsc, jec + j1 = j + lbnd2 - jsc + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + ig = i + ocean_grid%isc - isc + dataPtr2d(i1,j1) = input(i,j) * ocean_grid%mask2dT(ig,jg) + end do end do - end do + + end if end if diff --git a/config_src/nuopc_driver/mom_cap_share.F90 b/config_src/nuopc_driver/mom_cap_share.F90 index 59dc8ac0ba..cc13f39548 100644 --- a/config_src/nuopc_driver/mom_cap_share.F90 +++ b/config_src/nuopc_driver/mom_cap_share.F90 @@ -21,7 +21,9 @@ module mom_cap_share type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID #endif +!======================================================================= contains +!======================================================================= #ifndef CESMCOUPLED subroutine shr_file_setLogUnit(nunit) @@ -29,6 +31,12 @@ subroutine shr_file_setLogUnit(nunit) ! do nothing for this stub - its just here to replace ! having cppdefs in the main program end subroutine shr_file_setLogUnit + + subroutine shr_file_getLogUnit(nunit) + integer, intent(in) :: nunit + ! do nothing for this stub - its just here to replace + ! having cppdefs in the main program + end subroutine shr_file_getLogUnit #endif end module mom_cap_share From 9deec5d14a2a316f6177a53a81d57a8fc9727b39 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 31 Dec 2018 10:09:44 -0700 Subject: [PATCH 0982/1072] removed trailing whitespace --- config_src/nuopc_driver/mom_cap.F90 | 12 ++++++------ config_src/nuopc_driver/mom_cap_methods.F90 | 6 +++--- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 662a8bd011..515131178e 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1732,7 +1732,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) endif !--------------------------------- - ! set surface temperature to 0 if ocean mask is 0 + ! set surface temperature to 0 if ocean mask is 0 !--------------------------------- ! TODO (mvertens, 2018-12-30): is this really necessary? for now only do this for grid @@ -1756,21 +1756,21 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - + call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) - + if (geomtype == ESMF_GEOMTYPE_GRID) then call ESMF_FieldGet(field_t_surf, localDe=0, farrayPtr=t_surf2d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - + lbnd1 = lbound(t_surf2d,1) ubnd1 = ubound(t_surf2d,1) lbnd2 = lbound(t_surf2d,2) ubnd2 = ubound(t_surf2d,2) - + do j = lbnd2, ubnd2 do i = lbnd1, ubnd1 j1 = j - lbnd2 + jsc @@ -1791,7 +1791,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! line=__LINE__, & ! file=__FILE__)) & ! return ! bail out - + end subroutine InitializeRealize !=============================================================================== diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 19e4c01251..5eb719fcea 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -638,7 +638,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, line=__LINE__, & file=__FILE__)) & return ! bail out - + call State_SetExport(exportState, trim(fldname_y), & isc, iec, jsc, jec, ocean_public%v_surf, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -700,7 +700,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, return ! bail out ! ------- - ! frazil and freezing melting potential + ! frazil and freezing melting potential ! ------- call ESMF_StateGet(exportState, 'accum_heat_frazil' , itemFlag1) @@ -741,7 +741,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, end if ! ------- - ! Sea level + ! Sea level ! ------- fldname = 'sea_level' call ESMF_StateGet(exportState, trim(fldname), itemFlag, rc=rc) From 1d61f0aa21d6d1b5c1ee1c00a2026dde9dc17321 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 31 Dec 2018 19:46:01 -0700 Subject: [PATCH 0983/1072] rename import swnet fluxes for cesm --- config_src/nuopc_driver/mom_cap.F90 | 43 ++++++++++----------- config_src/nuopc_driver/mom_cap_methods.F90 | 30 ++++++++++++-- 2 files changed, 47 insertions(+), 26 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 515131178e..964e758c1d 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1007,39 +1007,38 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (len_trim(scalar_field_name) > 0) then call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") ! not in EMC endif - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide") ! -> mean_net_sw_ir_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide") ! -> mean_net_sw_ir_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide") ! -> mean_net_sw_vis_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") ! -> mean latent heat flux - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") ! -> mean long wave up (coupled to cam) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") ! -> mean long wave down (coupled to cam) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will_provide") ! -> coupled to fv3 + call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_vdr" , "will provide") ! -> mean_net_sw_ir_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_vdf" , "will provide") ! -> mean_net_sw_vis_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_idr" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_idf" , "will provide") ! -> mean_net_sw_vis_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") ! -> mean latent heat flux + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") ! -> liquid runoff + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") ! -> ice runoff + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") ! -> mean long wave up (coupled to cam) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") ! -> mean long wave down (coupled to cam) + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will_provide") ! -> coupled to fv3 ! EMC fields not used - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") ! not in CESM + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") ! not in CESM + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") ! not in CESM ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") ! not in CESM ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") ! not in CESM - ! CESM currently not used + ! CESM fields currently not used ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 5eb719fcea..68ea03a8bf 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -119,7 +119,12 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! near-IR, direct shortwave (W/m2) !---- - call state_getimport(importState, 'mean_net_sw_ir_dir_flx', & + if (cesm_coupled) then + fldname = 'Foxx_swnet_idr' + else + fldname = 'mean_net_sw_ir_dir_flx' + end if + call state_getimport(importState, trim(fldname), & isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -129,7 +134,12 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! near-IR, diffuse shortwave (W/m2) !---- - call state_getimport(importState, 'mean_net_sw_ir_dif_flx', & + if (cesm_coupled) then + fldname = 'Foxx_swnet_idf' + else + fldname = 'mean_net_sw_ir_dif_flx' + end if + call state_getimport(importState, trim(fldname), & isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -139,7 +149,12 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! visible, direct shortwave (W/m2) !---- - call state_getimport(importState, 'mean_net_sw_vis_dir_flx', & + if (cesm_coupled) then + fldname = 'Foxx_swnet_vdr' + else + fldname = 'mean_net_sw_vis_dir_flx' + end if + call state_getimport(importState, trim(fldname), & isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -149,7 +164,12 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! visible, diffuse shortwave (W/m2) !---- - call state_getimport(importState, 'mean_net_sw_vis_dif_flx', & + if (cesm_coupled) then + fldname = 'Foxx_swnet_vdf' + else + fldname = 'mean_net_sw_vis_dif_flx' + end if + call state_getimport(importState, trim(fldname), & isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -173,6 +193,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, else isPresent_lwup = .false. end if + call ESMF_StateGet(importState, 'Faxa_lwdn', itemFlag, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -183,6 +204,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, else isPresent_lwdn = .false. end if + call ESMF_StateGet(importState, "mean_net_lw_flx", itemFlag, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & From a3ab66e858a3c324ce740300eea8c7dd3fda3ea0 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 31 Dec 2018 20:30:13 -0700 Subject: [PATCH 0984/1072] turned on rotations of stress, current and slope deriv in cesm mode --- config_src/nuopc_driver/mom_cap_methods.F90 | 56 ++++++++++----------- 1 file changed, 26 insertions(+), 30 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 68ea03a8bf..ff33b4418d 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -23,7 +23,6 @@ module mom_cap_methods use MOM_surface_forcing, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type use MOM_domains, only: pass_var - use MOM_error_handler, only: is_root_pe use mpp_domains_mod, only: mpp_get_compute_domain use mom_cap_share @@ -271,13 +270,10 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, jg = j + ocean_grid%jsc - jsc do i = isc, iec ig = i + ocean_grid%isc - isc - ! TODO (mvertens, 2018-12-28): create a new baseline with these changes - ! ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg) * taux(i,j) & - ! + ocean_grid%sin_rot(ig,jg) * tauy(i,j) - ! ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg) * tauy(i,j) & - ! - ocean_grid%sin_rot(ig,jg) * taux(i,j) - ice_ocean_boundary%u_flux(i,j) = taux(i,j) - ice_ocean_boundary%v_flux(i,j) = tauy(i,j) + ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg) * taux(i,j) & + + ocean_grid%sin_rot(ig,jg) * tauy(i,j) + ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg) * tauy(i,j) & + - ocean_grid%sin_rot(ig,jg) * taux(i,j) end do end do else @@ -627,18 +623,18 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, allocate(ocm_rot(isc:iec, jsc:jec)) if (cesm_coupled) then - ! do j = jsc, jec - ! jg = j + ocean_grid%jsc - jsc - ! do i = isc, iec - ! ig = i + ocean_grid%isc - isc - ! ocz(i,j) = ocean_public%u_surf(i,j) - ! ocm(i,j) = ocean_public%v_surf(i,j) - ! ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) & - ! - ocean_grid%sin_rot(ig,jg)*ocm(i,j) - ! ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) & - ! + ocean_grid%sin_rot(ig,jg)*ocz(i,j) - ! end do - ! end do + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + ocz(i,j) = ocean_public%u_surf(i,j) + ocm(i,j) = ocean_public%v_surf(i,j) + ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) & + - ocean_grid%sin_rot(ig,jg)*ocm(i,j) + ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) & + + ocean_grid%sin_rot(ig,jg)*ocz(i,j) + end do + end do else do j = jsc, jec jg = j + ocean_grid%jsc - jsc @@ -873,16 +869,16 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! TODO (mvertens, 2018-12-30): Only one of these is correct - the cesm_coupled one is the ! latest and is the one that GM feels is the correct one if (cesm_coupled) then - ! do j = jsc, jec - ! jg = j + ocean_grid%jsc - jsc - ! do i = isc, iec - ! ig = i + ocean_grid%isc - isc - ! dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) & - ! - ocean_grid%sin_rot(ig,jg)*dhdy(i,j) - ! dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) & - ! + ocean_grid%sin_rot(ig,jg)*dhdx(i,j) - ! end do - ! end do + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) & + - ocean_grid%sin_rot(ig,jg)*dhdy(i,j) + dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) & + + ocean_grid%sin_rot(ig,jg)*dhdx(i,j) + end do + end do else do j = jsc, jec jg = j + ocean_grid%jsc - jsc From a22a7ef7e19db9a4a6bf4606ffa6397a76bfd13e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 31 Dec 2018 21:05:17 -0700 Subject: [PATCH 0985/1072] added required allocatable --- config_src/nuopc_driver/mom_cap_methods.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index ff33b4418d..9632189c46 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -785,8 +785,10 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, end if allocate(ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !global indices - allocate(dhdx(isc:iec, jsc:jec)) !local indices - allocate(dhdy(isc:iec, jsc:jec)) !local indices + allocate(dhdx(isc:iec, jsc:jec)) !local indices + allocate(dhdy(isc:iec, jsc:jec)) !local indices + allocate(dhdx_rot(isc:iec, jsc:jec)) !local indices + allocate(dhdy_rot(isc:iec, jsc:jec)) !local indices ssh = 0.0_ESMF_KIND_R8 dhdx = 0.0_ESMF_KIND_R8 dhdy = 0.0_ESMF_KIND_R8 From fe0aedbf7a8da06384b582075d76bb7d3b436663 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 1 Jan 2019 18:58:43 -0700 Subject: [PATCH 0986/1072] removed separate receive of lwup and lwdn to compute lwnet for cesm_coupled mode --- .../nuopc_driver/MOM_surface_forcing.F90 | 67 ++++----- config_src/nuopc_driver/mom_cap.F90 | 137 ++++++++---------- config_src/nuopc_driver/mom_cap_methods.F90 | 62 +------- 3 files changed, 97 insertions(+), 169 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 6528336402..a21b00f839 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -185,14 +185,14 @@ module MOM_surface_forcing !! 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. + 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 @@ -417,7 +417,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & enddo ; enddo endif - ! obtain fluxes from IOB; note the staggering of indices i0 = is - isc_bnd ; j0 = js - jsc_bnd do j=js,je ; do i=is,ie @@ -431,34 +430,28 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & if (associated(IOB%q_flux)) & fluxes%evap(i,j) = IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) - ! Note: currently runoff is treated differently for nems and cesm coupling - if (cesm_coupled) then - ! liquid runoff flux - if (associated(fluxes%lrunoff)) & - fluxes%lrunoff(i,j) = G%mask2dT(i,j) * IOB%rofl_flux(i-i0,j-j0) - - ! ice runoff flux - if (associated(fluxes%frunoff)) & - fluxes%frunoff(i,j) = G%mask2dT(i,j) * IOB%rofi_flux(i-i0,j-j0) - else - if (associated(IOB%runoff)) & - fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) + ! 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 - if (.not. cesm_coupled) then - if (associated(IOB%calving)) & - fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) - - if (associated(IOB%ustar_berg)) & - fluxes%ustar_berg(i,j) = IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) + ! ice runoff flux + 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%area_berg)) & - fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) + if (associated(IOB%ustar_berg)) & + fluxes%ustar_berg(i,j) = IOB%ustar_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%area_berg)) & + fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) - end if + if (associated(IOB%mass_berg)) & + fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%runoff_hflx)) & fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) @@ -473,9 +466,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & fluxes%sens(i,j) = IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) ! Note: currently latent heat flux is treated differently for nems and cesm - if (cesm_coupled) then - if (associated(IOB%latent_flux)) & - fluxes%latent(i,j) = G%mask2dT(i,j) * IOB%latent_flux(i-i0,j-j0) + if (associated(IOB%latent_flux)) then + fluxes%latent(i,j) = G%mask2dT(i,j) * IOB%latent_flux(i-i0,j-j0) else fluxes%latent(i,j) = 0.0 if (associated(IOB%fprec)) then @@ -490,18 +482,21 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor endif - fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) end if 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) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 964e758c1d..b03ee9c0d3 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -222,28 +222,28 @@ !! !! @subsection ImportFields Import Fields !! -!! Standard Name | Units | Model Variable | Description | Notes +!! Standard Name | Units | Model Variable | Description | Notes !! --------------------------|------------|-----------------|---------------------------------------|------------------- !! inst_pres_height_surface | Pa | p | pressure of overlying sea ice and atmosphere -!! mass_of_overlying_sea_ice | kg | mi | mass of overlying sea ice | | +!! mass_of_overlying_sea_ice | kg | mi | mass of overlying sea ice | | !! mean_calving_heat_flx | W m-2 | calving_hflx | heat flux, relative to 0C, of frozen land water into ocean -!! mean_calving_rate | kg m-2 s-1 | calving | mass flux of frozen runoff | | -!! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | sign reversed (- evap) -!! mean_fprec_rate | kg m-2 s-1 | fprec | mass flux of frozen precip | | +!! mean_calving_rate | kg m-2 s-1 | calving | mass flux of frozen runoff | | +!! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | sign reversed (- evap) +!! mean_fprec_rate | kg m-2 s-1 | fprec | mass flux of frozen precip | | !! mean_merid_moment_flx | Pa | v_flux | j-directed wind stress into ocean -!! | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar -!! mean_net_lw_flx | W m-2 | lw_flux | long wave radiation | | +!! | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar +!! mean_net_lw_flx | W m-2 | lw_flux | long wave radiation | | !! mean_net_sw_ir_dif_flx | W m-2 | sw_flux_nir_dif | diffuse near IR shortwave radiation| | -!! mean_net_sw_ir_dir_flx | W m-2 | sw_flux_nir_dir | direct near IR shortwave radiation| | +!! mean_net_sw_ir_dir_flx | W m-2 | sw_flux_nir_dir | direct near IR shortwave radiation | | !! mean_net_sw_vis_dif_flx | W m-2 | sw_flux_vis_dif | diffuse visible shortware radiation| | -!! mean_net_sw_vis_dir_flx | W m-2 | sw_flux_vis_dir | direct visible shortware radiation| | -!! mean_prec_rate | kg m-2 s-1 | lprec | mass flux of liquid precip | | +!! mean_net_sw_vis_dir_flx | W m-2 | sw_flux_vis_dir | direct visible shortware radiation | | +!! mean_prec_rate | kg m-2 s-1 | lprec | mass flux of liquid precip | | !! mean_runoff_heat_flx | W m-2 | runoff_hflx | heat flux, relative to 0C, of liquid land water into ocean -!! mean_runoff_rate | kg m-2 s-1 | runoff | mass flux of liquid runoff | | -!! mean_salt_rate | kg m-2 s-1 | salt_flux | salt flux | | -!! mean_sensi_heat_flx | W m-2 | t_flux | sensible heat flux into ocean | sign reversed (- sensi) +!! mean_runoff_rate | kg m-2 s-1 | runoff | mass flux of liquid runoff | | +!! mean_salt_rate | kg m-2 s-1 | salt_flux | salt flux | | +!! mean_sensi_heat_flx | W m-2 | t_flux | sensible heat flux into ocean | sign reversed (- sensi) !! mean_zonal_moment_flx | Pa | u_flux | j-directed wind stress into ocean -!! | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar +!! | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar !! !! !! @subsection ExportField Export Fields @@ -254,15 +254,15 @@ !! Standard Name | Units | Model Variable | Description | Notes !! ---------------------------|-------|----------------|-------------------------------------------|-------------------- !! freezing_melting_potential | W m-2 | frazil | accumulated heating from frazil formation -!! | cap converts model units (J m-2) to (W m-2) for export +!! | cap converts model units (J m-2) to (W m-2) for export !! ocean_mask | | | ocean mask | | !! ocn_current_merid | m s-1 | v_surf | j-directed surface velocity on u-cell -!! | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon +!! | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon !! ocn_current_zonal | m s-1 | u_surf | i-directed surface velocity on u-cell -!! | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon +!! | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon !! s_surf | psu | s_surf | sea surface salinity on t-cell | | !! sea_lev | m | sea_lev | sea level -!! | model computation is eta_t + patm/(rho0*grav) - eta_geoid - eta_tide +!! | model computation is eta_t + patm/(rho0*grav) - eta_geoid - eta_tide !! sea_surface_temperature | K | t_surf | sea surface temperature on t-cell | | !! !! @subsection MemoryManagement Memory Management @@ -1001,66 +1001,51 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out + ! CESM fields currently not used in cesm_coupled + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") + ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") + ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen", "will provide") + if (cesm_coupled) then !--------- import fields ------------- if (len_trim(scalar_field_name) > 0) then call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") ! not in EMC endif - call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_vdr" , "will provide") ! -> mean_net_sw_ir_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_vdf" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_idr" , "will provide") ! -> mean_net_sw_ir_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_idf" , "will provide") ! -> mean_net_sw_vis_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") ! -> mean latent heat flux - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") ! -> liquid runoff - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") ! -> ice runoff - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" , "will provide") ! -> mean long wave up (coupled to cam) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" , "will provide") ! -> mean long wave down (coupled to cam) - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will_provide") ! -> coupled to fv3 - - ! EMC fields not used - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") ! for CESM lwup + lwdn - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! for CESM rofl + rofi - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") ! not in CESM - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") ! not in CESM - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") ! not in CESM - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") ! not in CESM - - ! CESM fields currently not used - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") ! -> mean latent heat flux + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwnet" , "will_provide") ! -> mean net lwnet + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_vdr" , "will provide") ! -> mean_net_sw_ir_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_vdf" , "will provide") ! -> mean_net_sw_vis_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_idr" , "will provide") ! -> mean_net_sw_ir_dir_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_idf" , "will provide") ! -> mean_net_sw_vis_dif_flx + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") ! -> liquid runoff + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") ! -> ice runoff + call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface !--------- export fields ------------- if (len_trim(scalar_field_name) > 0) then call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide") ! not in EMC endif - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask" , "will provide") ! -> ocean_mask - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t" , "will provide") ! -> sea_surface_temperature - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide") ! -> s_surf - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u" , "will provide") ! -> ocn_current_zonal - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! -> sea_surface_slope_zonal - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! -> sea_surface_slope_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! -> not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! -> freezing_melting_potential - - ! EMC fields not used in CESM - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev", "will provide") - - ! CESM fields currently not used in EMC - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen", "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask" , "will provide") ! -> ocean_mask + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t" , "will provide") ! -> sea_surface_temperature + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide") ! -> s_surf + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u" , "will provide") ! -> ocn_current_zonal + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! -> sea_surface_slope_zonal + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! -> sea_surface_slope_merid + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! -> not in EMC + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! -> freezing_melting_potential else @@ -1077,12 +1062,12 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! not used in NEMS + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") ! not used in NEMS + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") ! not used in NEMS + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") ! not used in NEMS + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") ! not used in NEMS !--------- export fields ------------- call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") @@ -1090,12 +1075,12 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "accum_heat_frazil" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "inst_melt_potential" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "accum_heat_frazil" , "will provide") ! not used in NEMS + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "inst_melt_potential" , "will provide") ! not used in NEMS + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") ! not used in NEMS end if do n = 1,fldsToOcn_num diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 9632189c46..c1de995004 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -69,9 +69,6 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, integer :: i, j, ig, jg, n integer :: isc, iec, jsc, jec logical :: do_import - logical :: isPresent_lwup - logical :: isPresent_lwdn - logical :: isPresent_lwnet character(len=128) :: fldname character(len=128) :: fldname_x character(len=128) :: fldname_y @@ -178,66 +175,17 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! ------- ! Net longwave radiation (W/m2) ! ------- - ! Different treatment of long wave dependent on atmosphere - ! When running with cam or datm - need Foxx_lwup and Faxa_lwdn - ! When running with fv3 - need mean_net_lw_flx - - call ESMF_StateGet(importState, 'Foxx_lwup', itemFlag, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - isPresent_lwup = .true. - else - isPresent_lwup = .false. - end if - - call ESMF_StateGet(importState, 'Faxa_lwdn', itemFlag, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - isPresent_lwdn = .true. + if (cesm_coupled) then + fldname = 'Foxx_lwnet' else - isPresent_lwdn = .false. + fldname = 'mean_net_lw_flx' end if - - call ESMF_StateGet(importState, "mean_net_lw_flx", itemFlag, rc=rc) + call state_getimport(importState, trim(fldname), & + isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - isPresent_lwnet = .true. - else - isPresent_lwnet = .false. - end if - - if (isPresent_lwup .and. isPresent_lwdn) then - ! longwave radiation, sum up and down (W/m2) - call state_getimport(importState, 'Foxx_lwup', & - isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call state_getimport(importState, 'Faxa_lwdn', & - isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, do_sum=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - else if (isPresent_lwnet) then - ! net longwave radiation, sum up and down (W/m2) - call state_getimport(importState, 'mean_net_lw_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, do_sum=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if !---- ! zonal and meridional surface stress From e472d93d11086e9a21a11e261b791714a500a7e1 Mon Sep 17 00:00:00 2001 From: Rocky Dunlap Date: Thu, 24 Jan 2019 14:10:36 -0700 Subject: [PATCH 0987/1072] Do not end diag manager. This seems to be needed in order for the coupled system with FV3 and MOM to finalize. --- config_src/nuopc_driver/MOM_ocean_model.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 28ae82750a..0e962bfdc1 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -741,7 +741,7 @@ subroutine ocean_model_end(Ocean_sfc, Ocean_state, Time, write_restart) logical, intent(in) :: write_restart !< true => write restart file call ocean_model_save_restart(Ocean_state, Time) - call diag_mediator_end(Time, Ocean_state%diag, end_diag_manager=.true.) + call diag_mediator_end(Time, Ocean_state%diag, end_diag_manager=.false.) 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 From c2473a792ebba87ecbb0154472785c856351ea58 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 28 Jan 2019 19:14:55 -0500 Subject: [PATCH 0988/1072] Documented 300 miscellaneous variable units Changed comments to use the square bracket notation to document the units of about 300 additional variables. Also eliminated several redundant argument documentation blocks. Only comments have been changed and all answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 20 +-- config_src/coupled_driver/ocean_model_MOM.F90 | 22 +-- .../ice_solo_driver/MOM_surface_forcing.F90 | 2 +- .../ice_solo_driver/user_surface_forcing.F90 | 2 +- .../solo_driver/MESO_surface_forcing.F90 | 2 +- .../solo_driver/MOM_surface_forcing.F90 | 4 +- .../solo_driver/Neverland_surface_forcing.F90 | 4 +- .../solo_driver/user_surface_forcing.F90 | 2 +- src/core/MOM_continuity.F90 | 4 +- src/core/MOM_dynamics_split_RK2.F90 | 7 +- src/core/MOM_forcing_type.F90 | 2 +- src/core/MOM_open_boundary.F90 | 20 +-- src/core/MOM_variables.F90 | 4 +- src/diagnostics/MOM_debugging.F90 | 4 +- src/diagnostics/MOM_diag_to_Z.F90 | 2 +- src/diagnostics/MOM_wave_speed.F90 | 6 +- src/equation_of_state/MOM_EOS_TEOS10.F90 | 4 +- src/equation_of_state/MOM_EOS_linear.F90 | 2 +- src/ice_shelf/MOM_ice_shelf.F90 | 42 ++--- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 36 ++--- src/ice_shelf/MOM_marine_ice.F90 | 6 +- src/ice_shelf/user_shelf_init.F90 | 44 ++---- src/initialization/MOM_grid_initialize.F90 | 2 +- .../MOM_shared_initialization.F90 | 2 +- .../MOM_state_initialization.F90 | 14 +- src/initialization/midas_vertmap.F90 | 30 ++-- src/ocean_data_assim/MOM_oda_driver.F90 | 2 +- src/parameterizations/lateral/MOM_MEKE.F90 | 10 +- .../lateral/MOM_hor_visc.F90 | 14 +- .../lateral/MOM_internal_tides.F90 | 14 +- .../lateral/MOM_mixed_layer_restrat.F90 | 6 +- .../lateral/MOM_tidal_forcing.F90 | 8 +- .../vertical/MOM_bkgnd_mixing.F90 | 2 +- .../vertical/MOM_bulk_mixed_layer.F90 | 40 ++--- .../vertical/MOM_diabatic_aux.F90 | 2 +- .../vertical/MOM_diabatic_driver.F90 | 148 +++++++++--------- .../vertical/MOM_diapyc_energy_req.F90 | 2 +- .../vertical/MOM_energetic_PBL.F90 | 12 +- .../vertical/MOM_full_convection.F90 | 2 +- .../vertical/MOM_geothermal.F90 | 2 +- .../vertical/MOM_internal_tide_input.F90 | 2 +- .../vertical/MOM_kappa_shear.F90 | 15 +- .../vertical/MOM_opacity.F90 | 30 ++-- .../vertical/MOM_set_diffusivity.F90 | 10 +- .../vertical/MOM_set_viscosity.F90 | 2 +- .../vertical/MOM_shortwave_abs.F90 | 6 +- .../vertical/MOM_tidal_mixing.F90 | 13 +- .../vertical/MOM_vert_friction.F90 | 8 +- src/tracer/DOME_tracer.F90 | 4 +- src/tracer/ISOMIP_tracer.F90 | 6 +- src/tracer/MOM_OCMIP2_CFC.F90 | 7 +- src/tracer/MOM_generic_tracer.F90 | 2 +- src/tracer/MOM_offline_aux.F90 | 58 +++---- src/tracer/MOM_tracer_advect.F90 | 4 +- src/tracer/MOM_tracer_diabatic.F90 | 2 +- src/tracer/MOM_tracer_flow_control.F90 | 2 +- src/tracer/MOM_tracer_hor_diff.F90 | 16 +- src/tracer/advection_test_tracer.F90 | 8 +- src/tracer/boundary_impulse_tracer.F90 | 4 +- src/tracer/dye_example.F90 | 4 +- src/tracer/dyed_obc_tracer.F90 | 4 +- src/tracer/ideal_age_example.F90 | 4 +- src/tracer/oil_tracer.F90 | 4 +- src/tracer/pseudo_salt_tracer.F90 | 4 +- src/tracer/tracer_example.F90 | 6 +- src/user/BFB_surface_forcing.F90 | 2 +- src/user/DOME2d_initialization.F90 | 10 +- src/user/DOME_initialization.F90 | 2 +- src/user/MOM_controlled_forcing.F90 | 18 +-- src/user/Neverland_initialization.F90 | 2 +- src/user/SCM_CVMix_tests.F90 | 2 +- src/user/dumbbell_initialization.F90 | 8 +- src/user/dumbbell_surface_forcing.F90 | 2 +- src/user/lock_exchange_initialization.F90 | 11 +- 74 files changed, 402 insertions(+), 433 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 1b8770fba4..09d7da3119 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -72,11 +72,11 @@ module MOM_surface_forcing real :: latent_heat_vapor !< Latent heat of vaporization [J kg-1] real :: max_p_surf !< The maximum surface pressure that can be - !! exerted by the atmosphere and floating sea-ice, - !! in Pa. 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. + !! exerted by the atmosphere and floating sea-ice [Pa]. + !! 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. logical :: use_limited_P_SSH !< 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 @@ -1009,9 +1009,9 @@ end subroutine extract_IOB_stresses !> Adds thermodynamic flux adjustments obtained via data_override !! Component name is 'OCN' !! Available adjustments are: -!! - 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) +!! - hflx_adj (Heat flux into the ocean [W m-2]) +!! - sflx_adj (Salt flux into the ocean [kg salt m-2 s-1]) +!! - prcme_adj (Fresh water flux into the ocean [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 @@ -1054,8 +1054,8 @@ end subroutine apply_flux_adjustments !> Adds mechanical forcing 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) +!! - taux_adj (Zonal wind stress delta, positive to the east [Pa]) +!! - tauy_adj (Meridional wind stress delta, positive to the north [Pa]) subroutine apply_force_adjustments(G, CS, Time, forces) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(surface_forcing_CS), pointer :: CS !< Surface forcing control structure diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 57d0882870..5af0b774b0 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -113,13 +113,13 @@ module ocean_model_mod real, pointer, dimension(:,:) :: & t_surf => NULL(), & !< SST on t-cell (degrees Kelvin) s_surf => NULL(), & !< SSS on t-cell (psu) - u_surf => NULL(), & !< i-velocity at the locations indicated by stagger, m/s. - v_surf => NULL(), & !< j-velocity at the locations indicated by stagger, m/s. + u_surf => NULL(), & !< i-velocity at the locations indicated by stagger [m s-1]. + v_surf => NULL(), & !< j-velocity at the locations indicated by stagger [m s-1]. sea_lev => NULL(), & !< Sea level in m after correction for surface pressure, - !! i.e. dzt(1) + eta_t + patm/rho0/grav (m) - frazil =>NULL(), & !< Accumulated heating (in Joules/m^2) from frazil + !! i.e. dzt(1) + eta_t + patm/rho0/grav [m] + frazil =>NULL(), & !< Accumulated heating [J m-2] from frazil !! formation in the ocean. - area => NULL() !< cell area of the ocean surface, in m2. + area => NULL() !< cell area of the ocean surface [m2]. 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 @@ -154,8 +154,8 @@ module ocean_model_mod logical :: icebergs_alter_ocean !< If true, the icebergs can change ocean the !! ocean dynamics and forcing fluxes. real :: press_to_z !< A conversion factor between pressure and ocean - !! depth in m, usually 1/(rho_0*g), in m Pa-1. - real :: C_p !< The heat capacity of seawater, in J K-1 kg-1. + !! depth in m, usually 1/(rho_0*g) [m Pa-1]. + real :: C_p !< The heat capacity of seawater [J degC-1 kg-1]. logical :: offline_tracer_mode = .false. !< If false, use the model in prognostic mode !! with the barotropic and baroclinic dynamics, thermodynamics, !! etc. stepped forward integrated in time. @@ -169,8 +169,8 @@ module ocean_model_mod !! 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) + real :: dt !< (baroclinic) dynamics time step [s] + real :: dt_therm !< thermodynamics time step [s] 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 @@ -820,9 +820,9 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z !! 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) :: patm(:,:) !< The pressure at the ocean surface [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. + !! ocean depth in m, usually 1/(rho_0*g) [m Pa-1]. ! Local variables real :: IgR0 character(len=48) :: val_str diff --git a/config_src/ice_solo_driver/MOM_surface_forcing.F90 b/config_src/ice_solo_driver/MOM_surface_forcing.F90 index 4b39c16a00..aec37b2a4a 100644 --- a/config_src/ice_solo_driver/MOM_surface_forcing.F90 +++ b/config_src/ice_solo_driver/MOM_surface_forcing.F90 @@ -505,7 +505,7 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) ! be reset, depending on the time. character(len=200) :: filename ! The name of the input file. real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal and psuedo-meridional - real :: temp_y(SZI_(G),SZJ_(G)) ! wind stresses at h-points, in Pa. + real :: temp_y(SZI_(G),SZJ_(G)) ! wind stresses at h-points [Pa]. integer :: days, seconds call callTree_enter("wind_forcing_from_file, MOM_surface_forcing.F90") diff --git a/config_src/ice_solo_driver/user_surface_forcing.F90 b/config_src/ice_solo_driver/user_surface_forcing.F90 index bbfa4560fb..ce5f88b3ca 100644 --- a/config_src/ice_solo_driver/user_surface_forcing.F90 +++ b/config_src/ice_solo_driver/user_surface_forcing.F90 @@ -236,7 +236,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) enddo ; enddo else ! This is the buoyancy only mode. do j=js,je ; do i=is,ie - ! fluxes%buoy is the buoyancy flux into the ocean in m2 s-3. A positive + ! fluxes%buoy is the buoyancy flux into the ocean [m2 s-3]. A positive ! buoyancy flux is of the same sign as heating the ocean. fluxes%buoy(i,j) = 0.0 * G%mask2dT(i,j) enddo ; enddo diff --git a/config_src/solo_driver/MESO_surface_forcing.F90 b/config_src/solo_driver/MESO_surface_forcing.F90 index a676b35bc0..4904b4f7eb 100644 --- a/config_src/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/solo_driver/MESO_surface_forcing.F90 @@ -153,7 +153,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) enddo ; enddo else ! This is the buoyancy only mode. do j=js,je ; do i=is,ie - ! fluxes%buoy is the buoyancy flux into the ocean in m2 s-3. A positive + ! fluxes%buoy is the buoyancy flux into the ocean [m2 s-3]. A positive ! buoyancy flux is of the same sign as heating the ocean. fluxes%buoy(i,j) = 0.0 * G%mask2dT(i,j) enddo ; enddo diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 529b5087f4..75a1ec321a 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -83,8 +83,8 @@ module MOM_surface_forcing real :: Flux_const !< piston velocity for surface restoring [m s-1] real :: Flux_const_T !< piston velocity for surface temperature restoring [m s-1] real :: Flux_const_S !< piston velocity for surface salinity restoring [m s-1] - real :: latent_heat_fusion !< latent heat of fusion [J kg] - real :: latent_heat_vapor !< latent heat of vaporization [J kg] + real :: latent_heat_fusion !< latent heat of fusion [J kg-1] + real :: latent_heat_vapor !< latent heat of vaporization [J kg-1] real :: tau_x0 !< Constant zonal wind stress used in the WIND_CONFIG="const" forcing real :: tau_y0 !< Constant meridional wind stress used in the WIND_CONFIG="const" forcing diff --git a/config_src/solo_driver/Neverland_surface_forcing.F90 b/config_src/solo_driver/Neverland_surface_forcing.F90 index bd99299531..94726a62c3 100644 --- a/config_src/solo_driver/Neverland_surface_forcing.F90 +++ b/config_src/solo_driver/Neverland_surface_forcing.F90 @@ -145,7 +145,7 @@ subroutine Neverland_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) type(Neverland_surface_forcing_CS), pointer :: CS !< Control structure for this module. ! Local variables real :: buoy_rest_const ! A constant relating density anomalies to the - ! restoring buoyancy flux, in m5 s-3 kg-1. + ! restoring buoyancy flux [m5 s-3 kg-1]. real :: density_restore ! De integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -179,7 +179,7 @@ subroutine Neverland_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) "Temperature/salinity restoring not coded!" ) else ! This is the buoyancy only mode. do j=js,je ; do i=is,ie - ! fluxes%buoy is the buoyancy flux into the ocean in m2 s-3. A positive + ! fluxes%buoy is the buoyancy flux into the ocean [m2 s-3]. A positive ! buoyancy flux is of the same sign as heating the ocean. fluxes%buoy(i,j) = 0.0 * G%mask2dT(i,j) enddo ; enddo diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90 index 92d07c774a..30589372be 100644 --- a/config_src/solo_driver/user_surface_forcing.F90 +++ b/config_src/solo_driver/user_surface_forcing.F90 @@ -184,7 +184,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) enddo ; enddo else ! This is the buoyancy only mode. do j=js,je ; do i=is,ie - ! fluxes%buoy is the buoyancy flux into the ocean in m2 s-3. A positive + ! fluxes%buoy is the buoyancy flux into the ocean [m2 s-3]. A positive ! buoyancy flux is of the same sign as heating the ocean. fluxes%buoy(i,j) = 0.0 * G%mask2dT(i,j) enddo ; enddo diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index 931370a7d0..cf4dc09897 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -85,10 +85,10 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, & !! give vhbt as the depth-integrated transport [m s-1]. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt_aux !< A second summed zonal - !! volume flux in m3/s. + !! volume flux [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G)), & optional, intent(in) :: vhbt_aux !< A second summed meridional - !! volume flux in m3/s. + !! volume flux [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(inout) :: u_cor_aux !< The zonal velocities !! that give uhbt_aux as the depth-integrated transport [m s-1]. diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index abe14df5f6..2a4eeaf21a 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -243,7 +243,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic type type(vertvisc_type), intent(inout) :: visc !< vertical visc, bottom drag, and related type(time_type), intent(in) :: Time_local !< model time at end of time step - real, intent(in) :: dt !< time step (sec) + real, intent(in) :: dt !< time step [s] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, dimension(:,:), pointer :: p_surf_begin !< surf pressure at start of this dynamic !! time step [Pa] @@ -316,8 +316,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & u_init => NULL(), v_init => NULL(), & ! Pointers to u and v or u_adj and v_adj. u_av, & ! The zonal velocity time-averaged over a time step [m s-1]. v_av, & ! The meridional velocity time-averaged over a time step [m s-1]. - h_av ! The layer thickness time-averaged over a time step, in m or - ! kg m-2. + h_av ! The layer thickness time-averaged over a time step [H ~> m or kg m-2]. real :: Idt logical :: dyn_p_surf logical :: BT_cont_BT_thick ! If true, use the BT_cont_type to estimate the @@ -974,7 +973,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure type(MOM_restart_CS), pointer :: restart_CS !< restart control structure - real, intent(in) :: dt !< time step (sec) + real, intent(in) :: dt !< time step [s] type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< points to momentum equation terms for !! budget analysis type(cont_diag_ptrs), target, intent(inout) :: Cont_diag !< points to terms in continuity equation diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index d39191e5e9..f6fc793946 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -2035,7 +2035,7 @@ subroutine get_net_mass_forcing(fluxes, G, net_mass_src) type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields type(ocean_grid_type), intent(in) :: G !< The ocean grid type real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_mass_src !< The net mass flux of water into the ocean - !! in kg m-2 s-1. + !! [kg m-2 s-1]. integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index f7ce76969f..c78c08933e 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -73,7 +73,7 @@ module MOM_open_boundary real, pointer, dimension(:,:,:) :: buffer_src=>NULL() !< buffer for segment data located at cell faces !! and on the original vertical grid integer :: nk_src !< Number of vertical levels in the source data - real, dimension(:,:,:), pointer :: dz_src=>NULL() !< vertical grid cell spacing of the incoming segment data (m) + real, dimension(:,:,:), pointer :: dz_src=>NULL() !< vertical grid cell spacing of the incoming segment data [m] real, dimension(:,:,:), pointer :: buffer_dst=>NULL() !< buffer src data remapped to the target vertical grid real, dimension(:,:), pointer :: bt_vel=>NULL() !< barotropic velocity [m s-1] real :: value !< constant value if fid is equal to -1 @@ -135,15 +135,15 @@ module MOM_open_boundary integer :: Ie_obc !< i-indices of boundary segment. integer :: Js_obc !< j-indices of boundary segment. integer :: Je_obc !< j-indices of boundary segment. - real :: Velocity_nudging_timescale_in !< Nudging timescale on inflow (s). - real :: Velocity_nudging_timescale_out !< Nudging timescale on outflow (s). + real :: Velocity_nudging_timescale_in !< Nudging timescale on inflow [s]. + real :: Velocity_nudging_timescale_out !< Nudging timescale on outflow [s]. logical :: on_pe !< true if segment is located in the computational domain logical :: temp_segment_data_exists !< true if temperature data arrays are present logical :: salt_segment_data_exists !< true if salinity data arrays are present - real, pointer, dimension(:,:) :: Cg=>NULL() !< The external gravity - !! wave speed (m -s) at OBC-points. - real, pointer, dimension(:,:) :: Htot=>NULL() !< The total column thickness (m) at OBC-points. - real, pointer, dimension(:,:,:) :: h=>NULL() !< The cell thickness (m) at OBC-points. + real, pointer, dimension(:,:) :: Cg=>NULL() !< The external gravity wave speed [m s-1] + !! at OBC-points. + real, pointer, dimension(:,:) :: Htot=>NULL() !< The total column thickness [m] at OBC-points. + real, pointer, dimension(:,:,:) :: h=>NULL() !< The cell thickness [m] at OBC-points. real, pointer, dimension(:,:,:) :: normal_vel=>NULL() !< The layer velocity normal to the OB !! segment [m s-1]. real, pointer, dimension(:,:,:) :: tangential_vel=>NULL() !< The layer velocity tangential to the @@ -154,13 +154,13 @@ module MOM_open_boundary !! segment (m3 s-1). real, pointer, dimension(:,:) :: normal_vel_bt=>NULL() !< The barotropic velocity normal to !! the OB segment [m s-1]. - real, pointer, dimension(:,:) :: eta=>NULL() !< The sea-surface elevation along the segment (m). + real, pointer, dimension(:,:) :: eta=>NULL() !< The sea-surface elevation along the segment [m]. real, pointer, dimension(:,:,:) :: grad_normal=>NULL() !< The gradient of the normal flow along the !! segment [s-1] real, pointer, dimension(:,:,:) :: grad_tan=>NULL() !< The gradient of the tangential flow along the !! segment [s-1] real, pointer, dimension(:,:,:) :: grad_gradient=>NULL() !< The gradient of the gradient of tangential flow along the - !! segment (m-1 s-1) + !! segment [m-1 s-1] real, pointer, dimension(:,:,:) :: rx_normal=>NULL() !< The rx_old_u value for radiation coeff !! for normal velocity real, pointer, dimension(:,:,:) :: ry_normal=>NULL() !< The tangential value for radiation coeff @@ -175,7 +175,7 @@ module MOM_open_boundary !! can occur [s-1]. type(segment_tracer_registry_type), pointer :: tr_Reg=> NULL()!< A pointer to the tracer registry for the segment. type(hor_index_type) :: HI !< Horizontal index ranges - real :: Tr_InvLscale3_out !< An effective inverse length scale cubed (m-3) + real :: Tr_InvLscale3_out !< An effective inverse length scale cubed [m-3] real :: Tr_InvLscale3_in !< for restoring the tracer concentration in a !! ficticious reservior towards interior values !! when flow is exiting the domain, or towards diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 6469335f28..92b5f4f918 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -88,9 +88,9 @@ module MOM_variables real :: P_Ref !< The coordinate-density reference pressure [Pa]. !! This is the pressure used to calculate Rml from !! T and S when eqn_of_state is associated. - real :: C_p !< The heat capacity of seawater [J K-1 kg-1]. + real :: C_p !< The heat capacity of seawater [J degC-1 kg-1]. !! When conservative temperature is used, this is - !! constant and exactly 3991.86795711963 J K kg-1. + !! constant and exactly 3991.86795711963 J degC-1 kg-1. logical :: T_is_conT = .false. !< If true, the temperature variable tv%T is !! actually the conservative temperature [degC]. logical :: S_is_absS = .false. !< If true, the salinity variable tv%S is diff --git a/src/diagnostics/MOM_debugging.F90 b/src/diagnostics/MOM_debugging.F90 index 92ee5898d5..79a56cae2f 100644 --- a/src/diagnostics/MOM_debugging.F90 +++ b/src/diagnostics/MOM_debugging.F90 @@ -726,7 +726,7 @@ end subroutine chksum_vec_A2d function totalStuff(HI, hThick, areaT, stuff) type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: hThick !< The array of thicknesses to use as weights - real, dimension(HI%isd:,HI%jsd:), intent(in) :: areaT !< The array of cell areas in m2 + real, dimension(HI%isd:,HI%jsd:), intent(in) :: areaT !< The array of cell areas [m2] real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: stuff !< The array of stuff to be summed real :: totalStuff !< the globally integrated amoutn of stuff ! Local variables @@ -746,7 +746,7 @@ end function totalStuff subroutine totalTandS(HI, hThick, areaT, temperature, salinity, mesg) type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: hThick !< The array of thicknesses to use as weights - real, dimension(HI%isd:,HI%jsd:), intent(in) :: areaT !< The array of cell areas in m2 + real, dimension(HI%isd:,HI%jsd:), intent(in) :: areaT !< The array of cell areas [m2] real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: temperature !< The temperature field to sum real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: salinity !< The salinity field to sum character(len=*), intent(in) :: mesg !< An identifying message diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index 66e6246d07..07769f6077 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -540,7 +540,7 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) ! current depth level [H m2 ~> m3 or kg] real :: vh_here ! meridional transport of a layer that is attributed to ! the current depth level [H m2 ~> m3 or kg] - real :: Idt ! inverse of the time step (sec) + real :: Idt ! inverse of the time step [s] real :: z_int_above(SZIB_(G)) ! height of the interface atop a layer [H ~> m or kg m-2] diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index bf54d89deb..872c6f4783 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -93,7 +93,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & real :: L2_to_Z2 ! A scaling factor squared from units of lateral distances to depths [Z2 m-2 ~> 1]. real, parameter :: tol1 = 0.0001, tol2 = 0.001 real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() - real :: g_Rho0 ! G_Earth/Rho0 in m4 s-2 kg-1. + real :: g_Rho0 ! G_Earth/Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. real :: rescale, I_rescale integer :: kf(SZI_(G)) integer, parameter :: max_itt = 10 @@ -566,14 +566,14 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) real, dimension(SZI_(G)) :: & htot, hmin, & ! Thicknesses [Z ~> m]. H_here, HxT_here, HxS_here, HxR_here - real :: speed2_tot ! overestimate of the mode-1 speed squared, m2 s-2 + real :: speed2_tot ! overestimate of the mode-1 speed squared [m2 s-2] real :: speed2_min ! minimum mode speed (squared) to consider in root searching real, parameter :: reduct_factor = 0.5 ! factor used in setting speed2_min real :: I_Hnew, drxh_sum real, parameter :: tol1 = 0.0001, tol2 = 0.001 real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() - real :: g_Rho0 ! G_Earth/Rho0 in m4 s-2 kg-1. + real :: g_Rho0 ! G_Earth/Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. integer :: kf(SZI_(G)) integer, parameter :: max_itt = 10 logical :: use_EOS ! If true, density is calculated from T & S using the equation of state. diff --git a/src/equation_of_state/MOM_EOS_TEOS10.F90 b/src/equation_of_state/MOM_EOS_TEOS10.F90 index fc14d5f892..bbe9982b6f 100644 --- a/src/equation_of_state/MOM_EOS_TEOS10.F90 +++ b/src/equation_of_state/MOM_EOS_TEOS10.F90 @@ -172,7 +172,7 @@ subroutine calculate_density_derivs_array_teos10(T, S, pressure, drho_dT, drho_d real, intent(out), dimension(:) :: drho_dT !< The partial derivative of density with conservative !! temperature [kg m-3 degC-1]. real, intent(out), dimension(:) :: drho_dS !< The partial derivative of density with absolute salinity, - !! in kg m-3 (g/kg)-1. + !! [kg m-3 (g/kg)-1]. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. @@ -203,7 +203,7 @@ subroutine calculate_density_derivs_scalar_teos10(T, S, pressure, drho_dT, drho_ real, intent(out) :: drho_dT !< The partial derivative of density with conservative !! temperature [kg m-3 degC-1]. real, intent(out) :: drho_dS !< The partial derivative of density with absolute salinity, - !! in kg m-3 (g/kg)-1. + !! [kg m-3 (g/kg)-1]. ! Local variables real :: zs, zt, zp diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90 index a5e123ad4d..55b3835681 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -51,7 +51,7 @@ module MOM_EOS_linear contains !> This subroutine computes the density of sea water with a trivial -!! linear equation of state (in kg m-3) from salinity (sal in PSU), +!! linear equation of state (in [kg m-3]) from salinity (sal [PSU]), !! potential temperature (T [degC]), and pressure [Pa]. subroutine calculate_density_scalar_linear(T, S, pressure, rho, & Rho_T0_S0, dRho_dT, dRho_dS, rho_ref) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 8fe71574e6..f3f8e761b7 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -89,10 +89,10 @@ module MOM_ice_shelf utide => NULL() !< tidal velocity [m s-1] real :: ustar_bg !< A minimum value for ustar under ice shelves [Z s-1 ~> m s-1]. - real :: cdrag !< drag coefficient under ice shelves , non-dimensional. + real :: cdrag !< drag coefficient under ice shelves [nondim]. real :: g_Earth !< The gravitational acceleration [m s-2] real :: Cp !< The heat capacity of sea water [J kg-1 degC-1]. - real :: Rho0 !< A reference ocean density in kg/m3. + real :: Rho0 !< A reference ocean density [kg m-3]. real :: Cp_ice !< The heat capacity of fresh ice [J kg-1 degC-1]. real :: gamma_t !< The (fixed) turbulent exchange velocity in the !< 2-equation formulation [m s-1]. @@ -100,7 +100,7 @@ module MOM_ice_shelf real :: Temp_ice !< The core temperature of shelf ice [degC]. real :: kv_ice !< The viscosity of ice [m2 s-1]. real :: density_ice !< A typical density of ice [kg m-3]. - real :: rho_ice !< Nominal ice density in kg m-2 Z-1 + real :: rho_ice !< Nominal ice density [kg m-2 Z-1 ~> kg m-3]. real :: kv_molec !< The molecular kinematic viscosity of sea water [m2 s-1]. real :: kd_molec_salt!< The molecular diffusivity of salt [m2 s-1]. real :: kd_molec_temp!< The molecular diffusivity of heat [m2 s-1]. @@ -704,7 +704,7 @@ subroutine change_thickness_using_melt(ISS, G, time_step, fluxes, rho_ice, debug real, intent(in) :: time_step !< The time step for this update [s]. type(forcing), intent(inout) :: fluxes !< structure containing pointers to any possible !! thermodynamic or mass-flux forcing fields. - real, intent(in) :: rho_ice !< The density of ice-shelf ice, in kg m-2 Z-1. + real, intent(in) :: rho_ice !< The density of ice-shelf ice [kg m-2 Z-1 ~> kg m-3]. logical, optional, intent(in) :: debug !< If present and true, write chksums ! locals @@ -756,8 +756,8 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces logical, optional, intent(in) :: do_shelf_area !< If true find the shelf-covered areas. - real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1. - real :: press_ice ! The pressure of the ice shelf per unit area of ocean (not ice) in Pa. + real :: kv_rho_ice ! The viscosity of ice divided by its density [m5 kg-1 s-1]. + real :: press_ice ! The pressure of the ice shelf per unit area of ocean (not ice) [Pa]. logical :: find_area ! If true find the shelf areas at u & v points. type(ice_shelf_state), pointer :: ISS => NULL() ! A structure with elements that describe ! the ice-shelf state @@ -835,7 +835,7 @@ subroutine add_shelf_pressure(G, CS, fluxes) type(ice_shelf_CS), intent(in) :: CS !< This module's control structure. type(forcing), intent(inout) :: fluxes !< A structure of surface fluxes that may be updated. - real :: press_ice !< The pressure of the ice shelf per unit area of ocean (not ice) in Pa. + real :: press_ice !< The pressure of the ice shelf per unit area of ocean (not ice) [Pa]. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -865,32 +865,32 @@ subroutine add_shelf_flux(G, CS, state, fluxes) type(forcing), intent(inout) :: fluxes !< A structure of surface fluxes that may be used/updated. ! local variables - real :: Irho0 !< The inverse of the mean density in m3 kg-1. + real :: Irho0 !< The inverse of the mean density [m3 kg-1]. real :: frac_area !< The fractional area covered by the ice shelf [nondim]. real :: shelf_mass0 !< Total ice shelf mass at previous time (Time-dt). real :: shelf_mass1 !< Total ice shelf mass at current time (Time). - real :: delta_mass_shelf!< Change in ice shelf mass over one time step in kg/s + real :: delta_mass_shelf!< Change in ice shelf mass over one time step [kg s-1] real :: taux2, tauy2 !< The squared surface stresses [Pa]. - real :: press_ice !< The pressure of the ice shelf per unit area of ocean (not ice) in Pa. + real :: press_ice !< The pressure of the ice shelf per unit area of ocean (not ice) [Pa]. real :: asu1, asu2 !< Ocean areas covered by ice shelves at neighboring u- - real :: asv1, asv2 !< and v-points, in m2. - real :: fraz !< refreezing rate in kg m-2 s-1 - real :: mean_melt_flux !< spatial mean melt flux kg/s - real :: sponge_area !< total area of sponge region - real :: t0 !< The previous time (Time-dt) in sec. + real :: asv1, asv2 !< and v-points [m2]. + real :: fraz !< refreezing rate [kg m-2 s-1] + real :: mean_melt_flux !< spatial mean melt flux [kg s-1] or [kg m-2 s-1] at various points in the code. + real :: sponge_area !< total area of sponge region [m2] + real :: t0 !< The previous time (Time-dt) [s]. type(time_type) :: Time0!< The previous time (Time-dt) real, dimension(SZDI_(G),SZDJ_(G)) :: last_mass_shelf !< Ice shelf mass - !! at at previous time (Time-dt), in kg/m^2 - real, dimension(SZDI_(G),SZDJ_(G)) :: last_h_shelf !< Ice shelf thickness [Z ~> m]. - !! at at previous time (Time-dt), in m + !! at at previous time (Time-dt) [kg m-2] + real, dimension(SZDI_(G),SZDJ_(G)) :: last_h_shelf !< Ice shelf thickness [Z ~> m] + !! at at previous time (Time-dt) real, dimension(SZDI_(G),SZDJ_(G)) :: last_hmask !< Ice shelf mask !! at at previous time (Time-dt) - real, dimension(SZDI_(G),SZDJ_(G)) :: last_area_shelf_h !< Ice shelf area - !! at at previous time (Time-dt), m^2 + real, dimension(SZDI_(G),SZDJ_(G)) :: last_area_shelf_h !< Ice shelf area [m2] + !! at at previous time (Time-dt) type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe !! the ice-shelf state - real :: kv_rho_ice ! The viscosity of ice divided by its density, in m5 kg-1 s-1. + real :: kv_rho_ice ! The viscosity of ice divided by its density [m5 kg-1 s-1] real, parameter :: rho_fw = 1000.0 ! fresh water density character(len=160) :: mesg ! The text of an error message integer :: i, j, is, ie, js, je, isd, ied, jsd, jed diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 4ffdc6d255..b53021bbb2 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -771,9 +771,9 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u, v, iters, time) type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. type(unit_scale_type), intent(in) :: US !< Pointer to a structure containing unit conversion factors real, dimension(SZDIB_(G),SZDJB_(G)), & - intent(inout) :: u !< The zonal ice shelf velocity at vertices, in m/year + intent(inout) :: u !< The zonal ice shelf velocity at vertices [m year-1] real, dimension(SZDIB_(G),SZDJB_(G)), & - intent(inout) :: v !< The meridional ice shelf velocity at vertices, in m/year + intent(inout) :: v !< The meridional ice shelf velocity at vertices [m year-1] integer, intent(out) :: iters !< The number of iterations used in the solver. type(time_type), intent(in) :: Time !< The current model time @@ -1033,9 +1033,9 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, dimension(SZDIB_(G),SZDJB_(G)), & - intent(inout) :: u !< The zonal ice shelf velocity at vertices, in m/year + intent(inout) :: u !< The zonal ice shelf velocity at vertices [m year-1] real, dimension(SZDIB_(G),SZDJB_(G)), & - intent(inout) :: v !< The meridional ice shelf velocity at vertices, in m/year + intent(inout) :: v !< The meridional ice shelf velocity at vertices [m year-1] real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: taudx !< The x-direction driving stress, in ??? real, dimension(SZDIB_(G),SZDJB_(G)), & @@ -2035,7 +2035,7 @@ subroutine ice_shelf_min_thickness_calve(G, h_shelf, area_shelf_h, hmask, thickn real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_shelf !< The ice shelf thickness [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. + intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf [m2]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf @@ -2062,7 +2062,7 @@ subroutine calve_to_mask(G, h_shelf, area_shelf_h, hmask, calve_mask) real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_shelf !< The ice shelf thickness [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. + intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf [m2]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf @@ -2360,9 +2360,9 @@ subroutine CG_action(uret, vret, u, v, Phi, Phisub, umask, vmask, hmask, H_node, intent(in) :: Phisub !< Quadrature structure weights at subgridscale !! locations for finite element calculations real, dimension(SZDIB_(G),SZDJB_(G)), & - intent(in) :: u !< The zonal ice shelf velocity at vertices, in m/year + intent(in) :: u !< The zonal ice shelf velocity at vertices [m year-1] real, dimension(SZDIB_(G),SZDJB_(G)), & - intent(in) :: v !< The meridional ice shelf velocity at vertices, in m/year + intent(in) :: v !< The meridional ice shelf velocity at vertices [m year-1] real, dimension(SZDIB_(G),SZDJB_(G)), & intent(in) :: umask !< A coded mask indicating the nature of the !! zonal flow at the corner point @@ -2390,7 +2390,7 @@ subroutine CG_action(uret, vret, u, v, Phi, Phisub, umask, vmask, hmask, H_node, !! units depend on the basal law exponent. ! and/or whether flow is "hybridized" real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: dxdyh !< The tracer cell area, in m2 + intent(in) :: dxdyh !< The tracer cell area [m2] real, intent(in) :: dens_ratio !< The density of ice divided by the density !! of seawater, nondimensional integer, intent(in) :: is !< The starting i-index to work on @@ -2561,9 +2561,9 @@ subroutine CG_action_subgrid_basal(Phisub, H, U, V, DXDYH, bathyT, dens_ratio, U intent(in) :: Phisub !< Quadrature structure weights at subgridscale !! locations for finite element calculations real, dimension(2,2), intent(in) :: H !< The ice shelf thickness at nodal (corner) points [Z ~> m]. - real, dimension(2,2), intent(in) :: U !< The zonal ice shelf velocity at vertices, in m/year - real, dimension(2,2), intent(in) :: V !< The meridional ice shelf velocity at vertices, in m/year - real, intent(in) :: DXDYH !< The tracer cell area, in m2 + real, dimension(2,2), intent(in) :: U !< The zonal ice shelf velocity at vertices [m year-1] + real, dimension(2,2), intent(in) :: V !< The meridional ice shelf velocity at vertices [m year-1] + real, intent(in) :: DXDYH !< The tracer cell area [m2] real, intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points [Z ~> m]. real, intent(in) :: dens_ratio !< The density of ice divided by the density !! of seawater, nondimensional @@ -2767,7 +2767,7 @@ subroutine CG_diagonal_subgrid_basal (Phisub, H_node, DXDYH, bathyT, dens_ratio, !! locations for finite element calculations real, dimension(2,2), intent(in) :: H_node !< The ice shelf thickness at nodal (corner) !! points [Z ~> m]. - real, intent(in) :: DXDYH !< The tracer cell area, in m2 + real, intent(in) :: DXDYH !< The tracer cell area [m2] real, intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points [Z ~> m]. real, intent(in) :: dens_ratio !< The density of ice divided by the density !! of seawater, nondimensional @@ -2991,9 +2991,9 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u, v) type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. type(unit_scale_type), intent(in) :: US !< Pointer to a structure containing unit conversion factors real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & - intent(inout) :: u !< The zonal ice shelf velocity, in m/year. + intent(inout) :: u !< The zonal ice shelf velocity [m year-1]. real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & - intent(inout) :: v !< The meridional ice shelf velocity, in m/year. + intent(inout) :: v !< The meridional ice shelf velocity [m year-1]. ! update DEPTH_INTEGRATED viscosity, based on horizontal strain rates - this is for bilinear FEM solve ! so there is an "upper" and "lower" bilinear viscosity @@ -3049,7 +3049,7 @@ subroutine update_OD_ffrac(CS, G, US, ocean_mass, find_avg) type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. type(unit_scale_type), intent(in) :: US !< Pointer to a structure containing unit conversion factors real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: ocean_mass !< The mass per unit area of the ocean in kg m-2. + intent(in) :: ocean_mass !< The mass per unit area of the ocean [kg m-2]. logical, intent(in) :: find_avg !< If true, find the average of OD and ffrac, and !! reset the underlying running sums to 0. @@ -3120,7 +3120,7 @@ subroutine bilinear_shape_functions (X, Y, Phi, area) real, dimension(4), intent(in) :: Y !< The y-positions of the vertices of the quadrilateral. real, dimension(8,4), intent(inout) :: Phi !< The gradients of bilinear basis elements at Gaussian !! quadrature points surrounding the cell verticies. - real, intent(out) :: area !< The quadrilateral cell area, in m2. + real, intent(out) :: area !< The quadrilateral cell area [m2]. ! X and Y must be passed in the form ! 3 - 4 @@ -3618,7 +3618,7 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f intent(in) :: h0 !< The initial ice shelf thicknesses [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_after_uflux !< The ice shelf thicknesses after - !! the zonal mass fluxes, in m. + !! the zonal mass fluxes [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G),4), & intent(inout) :: flux_enter !< The integrated temperature flux into !! the cell through the 4 cell boundaries [degC Z m2 ~> degC m3] diff --git a/src/ice_shelf/MOM_marine_ice.F90 b/src/ice_shelf/MOM_marine_ice.F90 index cbce4e2deb..d4e83561a7 100644 --- a/src/ice_shelf/MOM_marine_ice.F90 +++ b/src/ice_shelf/MOM_marine_ice.F90 @@ -25,7 +25,7 @@ module MOM_marine_ice !> Control structure for MOM_marine_ice type, public :: marine_ice_CS ; private - real :: kv_iceberg !< The viscosity of the icebergs in m2/s (for ice rigidity) + real :: kv_iceberg !< The viscosity of the icebergs [m2 s-1] (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. @@ -152,8 +152,8 @@ subroutine iceberg_fluxes(G, fluxes, use_ice_shelf, sfc_state, & if (associated(fluxes%latent)) fluxes%latent(i,j) = 0.0 if (associated(fluxes%evap)) fluxes%evap(i,j) = 0.0 - ! Add frazil formation diagnosed by the ocean model (J m-2) in the - ! form of surface layer evaporation (kg m-2 s-1). Update lprec in the + ! Add frazil formation diagnosed by the ocean model [J m-2] in the + ! form of surface layer evaporation [kg m-2 s-1]. Update lprec in the ! control structure for diagnostic purposes. if (associated(sfc_state%frazil)) then diff --git a/src/ice_shelf/user_shelf_init.F90 b/src/ice_shelf/user_shelf_init.F90 index b541e2ec26..2829f712e0 100644 --- a/src/ice_shelf/user_shelf_init.F90 +++ b/src/ice_shelf/user_shelf_init.F90 @@ -27,13 +27,13 @@ module user_shelf_init !> The control structure for the user_ice_shelf module type, public :: user_ice_shelf_CS ; private - real :: Rho_ocean !< The ocean's typical density, in kg m-2 Z-1. + real :: Rho_ocean !< The ocean's typical density [kg m-2 Z-1]. real :: max_draft !< The maximum ocean draft of the ice shelf [Z ~> m]. real :: min_draft !< The minimum ocean draft of the ice shelf [Z ~> m]. - real :: flat_shelf_width !< The range over which the shelf is min_draft thick. - real :: shelf_slope_scale !< The range over which the shelf slopes. - real :: pos_shelf_edge_0 !< The x-position of the shelf edge at time 0, in km. - real :: shelf_speed !< The ice shelf speed of translation, in km day-1 + real :: flat_shelf_width !< The range over which the shelf is min_draft thick [km]. + real :: shelf_slope_scale !< The range over which the shelf slopes [km]. + real :: pos_shelf_edge_0 !< The x-position of the shelf edge at time 0 [km]. + real :: shelf_speed !< The ice shelf speed of translation [km day-1] logical :: first_call = .true. !< If true, this module has not been called before. end type user_ice_shelf_CS @@ -45,11 +45,11 @@ subroutine USER_initialize_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & intent(out) :: mass_shelf !< The ice shelf mass per unit area averaged - !! over the full ocean cell, in kg m-2. + !! over the full ocean cell [kg m-2]. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(out) :: h_shelf !< The ice shelf thickness, in m. + intent(out) :: h_shelf !< The ice shelf thickness [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(out) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. + intent(out) :: area_shelf_h !< The area per cell covered by the ice shelf [m2]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(out) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf @@ -59,19 +59,10 @@ subroutine USER_initialize_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, logical, intent(in) :: new_sim !< If true, this is a new run; otherwise it is !! being started from a restart file. -! Arguments: mass_shelf - The mass per unit area averaged over the full ocean -! cell, in kg m-2. (Intent out) -! (out) area_shelf_h - The area of the ocean cell that is covered by the -! rigid ice shelf, in m2. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. - - ! This subroutine sets up the initial mass and area covered by the ice shelf. real :: Rho_ocean ! The ocean's typical density [kg m-3]. - real :: max_draft ! The maximum ocean draft of the ice shelf, in m. - real :: min_draft ! The minimum ocean draft of the ice shelf, in m. + real :: max_draft ! The maximum ocean draft of the ice shelf [Z ~> m]. + real :: min_draft ! The minimum ocean draft of the ice shelf [Z ~> m]. real :: flat_shelf_width ! The range over which the shelf is min_draft thick. real :: c1 ! The maximum depths in m. character(len=40) :: mdl = "USER_initialize_shelf_mass" ! This subroutine's name. @@ -112,9 +103,9 @@ end subroutine USER_initialize_shelf_mass subroutine USER_init_ice_thickness(h_shelf, area_shelf_h, hmask, G, US, param_file) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & - intent(out) :: h_shelf !< The ice shelf thickness, in m. + intent(out) :: h_shelf !< The ice shelf thickness [m]. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(out) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. + intent(out) :: area_shelf_h !< The area per cell covered by the ice shelf [m2]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(out) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf @@ -135,9 +126,9 @@ subroutine USER_update_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, C type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: mass_shelf !< The ice shelf mass per unit area averaged - !! over the full ocean cell, in kg m-2. + !! over the full ocean cell [kg m-2]. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf, in m2. + intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf [m2]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_shelf !< The ice shelf thickness [Z ~> m]. real, dimension(SZDI_(G),SZDJ_(G)), & @@ -147,13 +138,6 @@ subroutine USER_update_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, C type(time_type), intent(in) :: Time !< The current model time logical, intent(in) :: new_sim !< If true, this the start of a new run. -! Arguments: mass_shelf - The mass per unit area averaged over the full ocean -! cell, in kg m-2. (Intent out) -! (out) area_shelf_h - The area of the ocean cell that is covered by the -! rigid ice shelf, in m2. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. real :: c1, edge_pos, slope_pos integer :: i, j diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index d0a5be6b96..3da13a3063 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -37,7 +37,7 @@ module MOM_grid_initialize !! starting value for the x-axis. real :: south_lat !< The southern latitude of the domain or the equivalent !! starting value for the y-axis. - real :: Rad_Earth !< The radius of the Earth, in m. + real :: Rad_Earth !< The radius of the Earth [m]. real :: Lat_enhance_factor !< The amount by which the meridional resolution !! is enhanced within LAT_EQ_ENHANCE of the equator. real :: Lat_eq_enhance !< The latitude range to the north and south of the equator diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 906939e76b..7613eae6b0 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -311,7 +311,7 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth real :: min_depth ! The minimum depth [Z ~> m]. real :: PI ! 3.1415926... calculated as 4*atan(1) real :: D0 ! A constant to make the maximum basin depth MAXIMUM_DEPTH. - real :: expdecay ! A decay scale of associated with the sloping boundaries, in m. + real :: expdecay ! A decay scale of associated with the sloping boundaries [m]. real :: Dedge ! The depth [Z ~> m], at the basin edge ! real :: south_lat, west_lon, len_lon, len_lat, Rad_earth integer :: i, j, is, ie, js, je, isd, ied, jsd, jed diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index ba2b29d765..56c68001b8 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -925,8 +925,8 @@ subroutine convert_thickness(h, G, GV, US, tv) ! across a layer [m2 s-2]. real :: rho(SZI_(G)) real :: I_gEarth - real :: Hm_rho_to_Pa ! A conversion factor from the input geometric thicknesses - ! times the layer densities into Pa, in Pa m3 / H kg. + real :: Hm_rho_to_Pa ! A conversion factor from the input geometric thicknesses times the + ! layer densities into Pa [Pa m3 H-1 kg-1 ~> s-2 m2 or s-2 m5 kg-1]. logical :: Boussinesq integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: itt, max_itt @@ -999,9 +999,9 @@ subroutine depress_surface(h, G, GV, US, param_file, tv, just_read_params) !! only read parameters without changing h. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - eta_sfc ! The free surface height that the model should use, in m. + eta_sfc ! The free surface height that the model should use [m]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & - eta ! The free surface height that the model should use, in m. + eta ! The free surface height that the model should use [m]. real :: dilate ! A ratio by which layers are dilated [nondim]. real :: scale_factor ! A scaling factor for the eta_sfc values that are read ! in, which can be used to change units, for example. @@ -1686,8 +1686,8 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, param_file, C type(time_type), intent(in) :: Time !< Time at the start of the run segment. Time_in !! overrides any value set for Time. ! Local variables - real, allocatable, dimension(:,:,:) :: eta ! The target interface heights, in m. - real, allocatable, dimension(:,:,:) :: h ! The target interface thicknesses, in m. + real, allocatable, dimension(:,:,:) :: eta ! The target interface heights [Z ~> m]. + real, allocatable, dimension(:,:,:) :: h ! The target interface thicknesses [H ~> m or kg m-2]. real, dimension (SZI_(G),SZJ_(G),SZK_(G)) :: & tmp, tmp2 ! A temporary array for tracers. @@ -1972,7 +1972,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param real, dimension(:,:,:), allocatable :: rho_z real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: zi ! Interface heights [Z ~> m]. real, dimension(SZI_(G),SZJ_(G)) :: nlevs - real, dimension(SZI_(G)) :: press ! Pressures in Pa. + real, dimension(SZI_(G)) :: press ! Pressures [Pa]. ! Local variables for ALE remapping real, dimension(:), allocatable :: hTarget ! Target thicknesses [Z ~> m]. diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index 70c83f9206..9277d42f21 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -30,7 +30,7 @@ module MIDAS_vertmap contains #ifdef PY_SOLO -!> Calculate seawater equation of state, given T[degC],S[PSU],p[Pa] +!> Calculate seawater equation of state, given T[degC], S[PSU], and p[Pa] !! Returns density [kg m-3] !! !! These EOS routines are needed only for the stand-alone version of the code @@ -38,9 +38,9 @@ module MIDAS_vertmap !! sea water using the formulae given by Wright, 1997, J. Atmos. !! Ocean. Tech., 14, 735-740. function wright_eos_2d(T,S,p) result(rho) - real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and Salinity (psu) + real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature [degC] and Salinity [psu] real, intent(in) :: p !< pressure [Pa] - real(kind=8), dimension(size(T,1),size(T,2)) :: rho !< potential density (kg m-3) + real(kind=8), dimension(size(T,1),size(T,2)) :: rho !< potential density [kg m-3] ! Local variables real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5 real(kind=8) :: al0,lam,p0,I_denom @@ -68,16 +68,16 @@ function wright_eos_2d(T,S,p) result(rho) end function wright_eos_2d !> Calculate seawater thermal expansion coefficient given T[degC],S[PSU],p[Pa] -!! Returns density [kg m-3 C-1] +!! Returns density [kg m-3 degC-1] !! !! The subroutines in this file implement the equation of state for !! sea water using the formulae given by Wright, 1997, J. Atmos. !! Ocean. Tech., 14, 735-740. function alpha_wright_eos_2d(T,S,p) result(drho_dT) - real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and Salinity (psu) + real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature [degC] and Salinity [psu] real, intent(in) :: p !< pressure [Pa] real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dT !< partial derivative of density with - !! respect to temperature (kg m-3 C-1) + !! respect to temperature [kg m-3 degC-1] ! Local variables real(kind=8) :: a0,a1,a2,b0,b1,b2,b3,b4,b5,c0,c1,c2,c3,c4,c5 real(kind=8) :: al0,lam,p0,I_denom,I_denom2 @@ -114,7 +114,7 @@ end function alpha_wright_eos_2d !! sea water using the formulae given by Wright, 1997, J. Atmos. !! Ocean. Tech., 14, 735-740. function beta_wright_eos_2d(T,S,p) result(drho_dS) - real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature (degC) and salinity (psu) + real(kind=8), dimension(:,:), intent(in) :: T,S !< temperature [degC] and salinity [psu] real, intent(in) :: p !< pressure [Pa] real(kind=8), dimension(size(T,1),size(T,2)) :: drho_dS !< partial derivative of density with !! respect to salinity [kg m-3 PSU-1] @@ -346,8 +346,8 @@ end function bisect_fast !> This subroutine determines the potential temperature and salinity that !! is consistent with the target density using provided initial guess subroutine determine_temperature(temp, salt, R, p_ref, niter, land_fill, h, k_start) - real(kind=8), dimension(:,:,:), intent(inout) :: temp !< potential temperature (degC) - real(kind=8), dimension(:,:,:), intent(inout) :: salt !< salinity (PSU) + real(kind=8), dimension(:,:,:), intent(inout) :: temp !< potential temperature [degC] + real(kind=8), dimension(:,:,:), intent(inout) :: salt !< salinity [PSU] real(kind=8), dimension(size(temp,3)), intent(in) :: R !< desired potential density [kg m-3]. real, intent(in) :: p_ref !< reference pressure [Pa]. integer, intent(in) :: niter !< maximum number of iterations @@ -361,8 +361,8 @@ subroutine determine_temperature(temp, salt, R, p_ref, niter, land_fill, h, k_st !> This subroutine determines the potential temperature and salinity that !! is consistent with the target density using provided initial guess subroutine determine_temperature(temp, salt, R, p_ref, niter, land_fill, h, k_start, eos) - real, dimension(:,:,:), intent(inout) :: temp !< potential temperature (degC) - real, dimension(:,:,:), intent(inout) :: salt !< salinity (PSU) + real, dimension(:,:,:), intent(inout) :: temp !< potential temperature [degC] + real, dimension(:,:,:), intent(inout) :: salt !< salinity [PSU] real, dimension(size(temp,3)), intent(in) :: R !< desired potential density [kg m-3]. real, intent(in) :: p_ref !< reference pressure [Pa]. integer, intent(in) :: niter !< maximum number of iterations @@ -465,9 +465,9 @@ end subroutine determine_temperature !! of each layer that overlaps that depth range. !! Note that by convention, e decreases with increasing k and Z_top > Z_bot. subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z2) - real, dimension(:), intent(in) :: e !< The interface positions, in m or Z. - real, intent(in) :: Z_top !< The top of the range being mapped to, in m or Z. - real, intent(in) :: Z_bot !< The bottom of the range being mapped to, in m or Z. + real, dimension(:), intent(in) :: e !< The interface positions, [Z ~> m] or other units. + real, intent(in) :: Z_top !< The top of the range being mapped to, [Z ~> m] or other units. + real, intent(in) :: Z_bot !< The bottom of the range being mapped to, [Z ~> m] or other units. integer, intent(in) :: k_max !< The number of valid layers. integer, intent(in) :: k_start !< The layer at which to start searching. integer, intent(out) :: k_top !< The index of the top layer that overlap with the depth range. @@ -528,7 +528,7 @@ end subroutine find_overlap !! a piecewise limited scheme. function find_limited_slope(val, e, k) result(slope) real, dimension(:), intent(in) :: val !< An column the values that are being interpolated. - real, dimension(:), intent(in) :: e !< A column's interface heights, in Z or m. + real, dimension(:), intent(in) :: e !< A column's interface heights [Z ~> m] or other units. integer, intent(in) :: k !< The layer whose slope is being determined. real :: slope !< The normalized slope in the intracell distribution of val. ! Local variables diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 7681827628..1a9bf92c57 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -545,7 +545,7 @@ end subroutine save_obs_diff !> Apply increments to tracers subroutine apply_oda_tracer_increments(dt,G,tv,h,CS) - real, intent(in) :: dt !< The tracer timestep (seconds) + real, intent(in) :: dt !< The tracer timestep [s] type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index adf523bdfe..606a234271 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -45,18 +45,18 @@ module MOM_MEKE !! first baroclinic deformation radius. logical :: use_old_lscale !< Use the old formula for mixing length scale. real :: cdrag !< The bottom drag coefficient for MEKE (non-dim). - real :: MEKE_BGsrc !< Background energy source for MEKE in W/kg (= m2 s-3). + real :: MEKE_BGsrc !< Background energy source for MEKE [W kg-1] (= m2 s-3). real :: MEKE_dtScale !< Scale factor to accelerate time-stepping (non-dim.) real :: MEKE_KhCoeff !< Scaling factor to convert MEKE into Kh (non-dim.) real :: MEKE_Uscale !< MEKE velocity scale for bottom drag [m s-1] - real :: MEKE_KH !< Background lateral diffusion of MEKE (m^2/s) - real :: MEKE_K4 !< Background bi-harmonic diffusivity (of MEKE) (m^4/s) + real :: MEKE_KH !< Background lateral diffusion of MEKE [m2 s-1] + real :: MEKE_K4 !< Background bi-harmonic diffusivity (of MEKE) [m4 s-1] real :: KhMEKE_Fac !< A factor relating MEKE%Kh to the diffusivity used for !! MEKE itself (nondimensional). real :: viscosity_coeff !< The scaling coefficient in the expression for !! viscosity used to parameterize lateral momentum mixing !! by unresolved eddies represented by MEKE. - real :: Lfixed !< Fixed mixing length scale, in m. + real :: Lfixed !< Fixed mixing length scale [m]. real :: aDeform !< Weighting towards deformation scale of mixing length (non-dim.) real :: aRhines !< Weighting towards Rhines scale of mixing length (non-dim.) real :: aFrict !< Weighting towards frictional arrest scale of mixing length (non-dim.) @@ -117,7 +117,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h MEKE_mom_src, & ! The MEKE source from momentum [m2 s-3]. drag_rate_visc, & drag_rate, & ! The MEKE spindown timescale due to bottom drag [s-1]. - LmixScale, & ! Square of eddy mixing length, in m2. + LmixScale, & ! Square of eddy mixing length [m2]. barotrFac2, & ! Ratio of EKE_barotropic / EKE [nondim] bottomFac2 ! Ratio of EKE_bottom / EKE [nondim] real, dimension(SZIB_(G),SZJ_(G)) :: & diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 9150dead11..a980704d21 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -964,16 +964,16 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) real, dimension(SZIB_(G),SZJ_(G)) :: u0u, u0v real, dimension(SZI_(G),SZJB_(G)) :: v0u, v0v ! u0v is the Laplacian sensitivities to the v velocities - ! at u points, in m-2, with u0u, v0u, and v0v defined similarly. - real :: grid_sp_h2 ! Harmonic mean of the squares of the grid - real :: grid_sp_h3 ! Harmonic mean of the squares of the grid^(3/2) - real :: grid_sp_q2 ! spacings at h and q points (m2) - real :: grid_sp_q3 ! spacings at h and q points^(3/2) (m3) + ! at u points [m-2], with u0u, v0u, and v0v defined similarly. + real :: grid_sp_h2 ! Harmonic mean of the squares of the grid [m2] + real :: grid_sp_h3 ! Harmonic mean of the squares of the grid^(3/2) [m3] + real :: grid_sp_q2 ! spacings at h and q points [m2] + real :: grid_sp_q3 ! spacings at h and q points^(3/2) [m3] real :: Kh_Limit ! A coefficient [s-1] used, along with the ! grid spacing, to limit Laplacian viscosity. real :: fmax ! maximum absolute value of f at the four ! vorticity points around a thickness point [s-1] - real :: BoundCorConst ! constant (s2/m2) + real :: BoundCorConst ! A constant used when using viscosity to bound the Coriolis accelerations [s2 m-2] real :: Ah_Limit ! coefficient [s-1] used, along with the ! grid spacing, to limit biharmonic viscosity real :: Kh ! Lapacian horizontal viscosity [m2 s-1] @@ -984,7 +984,7 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) real :: Smag_bi_const ! nondimensional biharmonic Smagorinsky constant real :: Leith_Lap_const ! nondimensional Laplacian Leith constant real :: Leith_bi_const ! nondimensional biharmonic Leith constant - real :: dt ! dynamics time step (sec) + real :: dt ! dynamics time step [s] real :: Idt ! inverse of dt [s-1] real :: denom ! work variable; the denominator of a fraction real :: maxvel ! largest permitted velocity components [m s-1] diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index fea15385be..c9341a061a 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -74,7 +74,7 @@ module MOM_internal_tides !< energy lost due to wave breaking [W m-2] real, allocatable, dimension(:,:) :: TKE_itidal_loss_fixed !< fixed part of the energy lost due to small-scale drag - !! [kg Z-2] here; will be multiplied by N and En to get into [W m-2] + !! [kg Z-2 ~> kg m-2] here; will be multiplied by N and En to get into [W m-2] real, allocatable, dimension(:,:,:,:,:) :: TKE_itidal_loss !< energy lost due to small-scale wave drag [W m-2] real, allocatable, dimension(:,:) :: tot_leak_loss !< Energy loss rates due to misc bakground processes, @@ -623,17 +623,17 @@ end subroutine sum_En !! scattering over small-scale roughness along the lines of Jayne & St. Laurent (2001). subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, dt, full_halos) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(in) :: Nb !< Near-bottom stratification [s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%nFreq,CS%nMode), & - intent(inout) :: Ub !< Rms (over one period) near-bottom horizontal + intent(inout) :: Ub !< RMS (over one period) near-bottom horizontal !! mode velocity [m s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: TKE_loss_fixed !< Fixed part of energy loss, - !! in kg Z-2 (rho*kappa*h^2). + intent(in) :: TKE_loss_fixed !< Fixed part of energy loss [kg Z-2 ~> kg m-2] + !! (rho*kappa*h^2). real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle,CS%nFreq,CS%nMode), & intent(inout) :: En !< Energy density of the internal waves [J m-2]. real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle,CS%nFreq,CS%nMode), & @@ -760,8 +760,8 @@ subroutine refract(En, cn, freq, dt, G, NAngle, use_PPMang) real :: favg ! The average Coriolis parameter at a point [s-1]. real :: df2_dy, df2_dx ! The x- and y- gradients of the squared Coriolis parameter [s-2 m-1]. real :: df_dy, df_dx ! The x- and y- gradients of the Coriolis parameter [s-1 m-1]. - real :: dlnCn_dx ! The x-gradient of the wave speed divided by itself in m-1. - real :: dlnCn_dy ! The y-gradient of the wave speed divided by itself in m-1. + real :: dlnCn_dx ! The x-gradient of the wave speed divided by itself [m-1]. + real :: dlnCn_dy ! The y-gradient of the wave speed divided by itself [m-1]. real :: Angle_size, dt_Angle_size, angle real :: Ifreq, Kmag2, I_Kmag real, parameter :: cn_subRO = 1e-100 diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index d7c47e8b01..d2a1abb730 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -176,7 +176,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz real, dimension(SZI_(G)) :: rhoSurf, deltaRhoAtKm1, deltaRhoAtK real, dimension(SZI_(G)) :: dK, dKm1 ! Depths of layer centers [H ~> m or kg m-2]. - real, dimension(SZI_(G)) :: pRef_MLD ! A reference pressure for calculating the mixed layer densities, in Pa. + real, dimension(SZI_(G)) :: pRef_MLD ! A reference pressure for calculating the mixed layer densities [Pa]. real, dimension(SZI_(G)) :: rhoAtK, rho1, d1, pRef_N2 ! Used for N2 real :: aFac, bFac, ddRho real :: hAtVel, zpa, zpb, dh, res_scaling_fac, I_l_f @@ -577,7 +577,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) real :: absf ! absolute value of f, interpolated to velocity points [s-1] real :: u_star ! surface friction velocity, interpolated to velocity points [Z s-1 ~> m s-1]. real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [s-1] - real :: timescale ! mixing growth timescale (sec) + real :: timescale ! mixing growth timescale [s] real :: h_neglect ! tiny thickness usually lost in roundoff and can be neglected [H ~> m or kg m-2] real :: dz_neglect ! tiny thickness that usually lost in roundoff and can be neglected [Z ~> m] real :: I4dt ! 1/(4 dt) @@ -592,7 +592,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) real :: vDml(SZI_(G)) ! half of the mixed layer [H m2 s-1 ~> m3 s-1 or kg s-1]. real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! The restratification timescales real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! in the zonal and meridional - ! directions (sec), stored in 2-D + ! directions [s], stored in 2-D ! arrays for diagnostic purposes. real :: uDml_diag(SZIB_(G),SZJ_(G)), vDml_diag(SZI_(G),SZJB_(G)) logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index 538c56fb5e..075c69ed65 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -22,7 +22,7 @@ module MOM_tidal_forcing integer, parameter :: MAX_CONSTITUENTS = 10 !< The maximum number of tidal !! constituents that could be used. -!> The control structure for the MOM_tidal_forcing mldule +!> The control structure for the MOM_tidal_forcing module type, public :: tidal_forcing_CS ; private logical :: use_sal_scalar !< If true, use the scalar approximation when !! calculating self-attraction and loading. @@ -38,7 +38,7 @@ module MOM_tidal_forcing real, dimension(MAX_CONSTITUENTS) :: & freq, & !< The frequency of a tidal constituent [s-1]. phase0, & !< The phase of a tidal constituent at time 0, in radians. - amp, & !< The amplitude of a tidal constituent at time 0, in m. + amp, & !< The amplitude of a tidal constituent at time 0 [m]. love_no !< The Love number of a tidal constituent at time 0 [nondim]. integer :: struct(MAX_CONSTITUENTS) !< An encoded spatial structure for each constituent character (len=16) :: const_name(MAX_CONSTITUENTS) !< The name of each constituent @@ -48,10 +48,10 @@ module MOM_tidal_forcing cos_struct => NULL(), & !< be associated with the astronomical forcing. cosphasesal => NULL(), & !< The cosine and sine of the phase of the sinphasesal => NULL(), & !< self-attraction and loading amphidromes. - ampsal => NULL(), & !< The amplitude of the SAL, in m. + ampsal => NULL(), & !< The amplitude of the SAL [m]. cosphase_prev => NULL(), & !< The cosine and sine of the phase of the sinphase_prev => NULL(), & !< amphidromes in the previous tidal solutions. - amp_prev => NULL() !< The amplitude of the previous tidal solution, in m. + amp_prev => NULL() !< The amplitude of the previous tidal solution [m]. end type tidal_forcing_CS integer :: id_clock_tides !< CPU clock for tides diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 27d7d3e046..931d2ec15e 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -404,7 +404,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, US, CS) real, dimension(SZI_(G)) :: depth !< distance from surface of an interface [Z ~> m] real :: depth_c !< depth of the center of a layer [Z ~> m] real :: I_Hmix !< inverse of fixed mixed layer thickness [Z-1 ~> m-1] - real :: I_2Omega !< 1/(2 Omega) (sec) + real :: I_2Omega !< 1/(2 Omega) [s] real :: N_2Omega real :: N02_N2 real :: I_x30 !< 2/acos(2) = 1/(sin(30 deg) * acosh(1/sin(30 deg))) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 4bf30a5a60..32a8886a53 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -205,8 +205,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C !! previous call to mixedlayer_init. type(optics_type), pointer :: optics !< The structure containing the inverse of the !! vertical absorption decay scale for - !! penetrating shortwave radiation, in m-1. - real, dimension(:,:), pointer :: Hml !< Active mixed layer depth, in m. + !! penetrating shortwave radiation [m-1]. + real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [m]. logical, intent(in) :: aggregate_FW_forcing !< If true, the net incoming and !! outgoing surface freshwater fluxes are !! combined before being applied, instead of @@ -219,12 +219,12 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C !! diagnostics will be written. The default is !! .true. - ! Local variiables + ! Local variables real, dimension(SZI_(G),SZK_(GV)) :: & eaml, & ! The amount of fluid moved downward into a layer due to mixed - ! mixed layer detrainment, in m. (I.e. entrainment from above.) + ! layer detrainment [H ~> m or kg m-2]. (I.e. entrainment from above.) ebml ! The amount of fluid moved upward into a layer due to mixed - ! mixed layer detrainment, in m. (I.e. entrainment from below.) + ! layer detrainment [H ~> m or kg m-2]. (I.e. entrainment from below.) ! If there is resorting, the vertical coordinate for these variables is the ! new, sorted index space. Here layer 0 is an initially massless layer that @@ -273,8 +273,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! ocean over a time step [H ~> m or kg m-2]. NetMassOut, & ! The mass flux (if non-Boussinesq) or volume flux (if Boussinesq) ! over a time step from evaporating fresh water [H ~> m or kg m-2] - Net_heat, & ! The net heating at the surface over a time step in K H. Any - ! penetrating shortwave radiation is not included in Net_heat. + Net_heat, & ! The net heating at the surface over a time step [degC H ~> degC m or degC kg m-2]. + ! Any penetrating shortwave radiation is not included in Net_heat. Net_salt, & ! The surface salt flux into the ocean over a time step, psu H. Idecay_len_TKE, & ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. p_ref, & ! Reference pressure for the potential density governing mixed @@ -294,13 +294,14 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C real, dimension(max(CS%nsw,1),SZI_(G)) :: & Pen_SW_bnd ! The penetrating fraction of the shortwave heating integrated - ! over a time step in each band, in K H. + ! over a time step in each band [degC H ~> degC m or degC kg m-2]. real, dimension(max(CS%nsw,1),SZI_(G),SZK_(GV)) :: & opacity_band ! The opacity in each band [H-1 ~> m-1 or m2 kg-1]. The indicies are band, i, k. real :: cMKE(2,SZI_(G)) ! Coefficients of HpE and HpE^2 used in calculating the - ! denominator of MKE_rate, in m-1 and m-2. - real :: Irho0 ! 1.0 / rho_0 + ! denominator of MKE_rate; the two elements have differing + ! units of [H-1 ~> m-1 or m2 kg-1] and [H-2 ~> m-2 or m4 kg-2]. + real :: Irho0 ! 1.0 / rho_0 [m3 kg-1] real :: Inkml, Inkmlm1! 1.0 / REAL(nkml) and 1.0 / REAL(nkml-1) real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. real :: Idt ! The inverse of the timestep [s-1]. @@ -982,7 +983,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G)), intent(in) :: netMassOut !< The mass or volume flux out of the ocean !! within a time step [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: Net_heat !< The net heating at the surface over a - !! time step in K H. Any penetrating shortwave + !! time step [degC H ~> degC m or degC kg m-2]. Any penetrating shortwave !! radiation is not included in Net_heat. real, dimension(SZI_(G)), intent(in) :: Net_salt !< The net surface salt flux into the ocean !! over a time step [PSU H ~> PSU m or PSU kg m-2]. @@ -990,7 +991,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! shortwave radiation. real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave !! heating at the sea surface in each - !! penetrating band, in K H, + !! penetrating band [degC H ~> degC m or degC kg m-2], !! size nsw x SZI_(G). real, dimension(:,:,:), intent(in) :: opacity_band !< The opacity in each band of penetrating !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. @@ -1527,8 +1528,9 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! temperature [kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of Rcv with respect to !! temperature [kg m-3 degC-1]. - real, dimension(2,SZI_(G)), intent(in) :: cMKE !< Coefficients of HpE and HpE^2 used in calculating - !! the denominator of MKE_rate, in m-1 and m-2. + real, dimension(2,SZI_(G)), intent(in) :: cMKE !< Coefficients of HpE and HpE^2 used in calculating the + !! denominator of MKE_rate; the two elements have differing + !! units of [H-1 ~> m-1 or m2 kg-1] and [H-2 ~> m-2 or m4 kg-2]. real, intent(in) :: Idt_diag !< The inverse of the accumulated diagnostic !! time interval [s-1]. integer, intent(in) :: nsw !< The number of bands of penetrating @@ -2279,8 +2281,8 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! layer that remains [H ~> m or kg m-2]. real :: stays_min_merge ! The minimum allowed value of stays_merge [H ~> m or kg m-2]. - real :: dR0_2dz, dRcv_2dz ! Half the vertical gradients of R0, Rcv, T, and -! real :: dT_2dz, dS_2dz ! S, in kg m-4, kg m-4, K m-1, and psu m-1. + real :: dR0_2dz, dRcv_2dz ! Half the vertical gradients of R0 and Rcv [kg m-3 H-1 ~> kg m-4 or m-1] +! real :: dT_2dz, dS_2dz ! Half the vertical gradients of T and S, in degC H-1, and ppt H-1. real :: scale_slope ! A nondimensional number < 1 used to scale down ! the slope within the upper buffer layer when ! water MUST be detrained to the lower layer. @@ -2305,7 +2307,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! interior layers that are just lighter and ! just denser than the lower buffer layer. - real :: R0_det, T_det, S_det ! Detrained values of R0, T, and S. + real :: R0_det, T_det, S_det ! Detrained values of R0 [kg m-3], T [degC], and S [ppt]. real :: Rcv_stays, R0_stays ! Values of Rcv and R0 that stay in a layer. real :: T_stays, S_stays ! Values of T and S that stay in a layer. real :: dSpice_det, dSpice_stays! The spiciness difference between an original @@ -2316,7 +2318,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! the lower buffer layer and the water that ! moves into an interior layer [kg m-3]. real :: dSpice_2dz ! The vertical gradient of spiciness used for - ! advection, in kg m-4. + ! advection [kg m-3 H-1 ~> kg m-4 or m-1]. real :: dPE_ratio ! Multiplier of dPE_det at which merging is ! permitted - here (detrainment_per_day/dt)*30 @@ -2330,7 +2332,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: dT_dS_gauge, dS_dT_gauge ! The relative scales of temperature and ! salinity changes in defining spiciness, in ! [degC psu-1] and [psu degC-1]. - real :: I_denom ! A work variable with units of psu2 m6 kg-2. + real :: I_denom ! A work variable with units of [ppt2 m6 kg-2]. real :: G_2 ! 1/2 G_Earth [m2 Z-1 s-2 ~> m s-2]. real :: Rho0xG ! Rho0 times G_Earth [kg m-1 Z-1 s-2 ~> kg m-2 s-2]. diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 811cc15592..53ab8c886d 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -399,7 +399,7 @@ subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) real :: S(SZI_(G),SZK_(G)) real :: h_2d(SZI_(G),SZK_(G)) real :: Rcv(SZI_(G),SZK_(G)) - real :: mc ! A layer's mass in kg m-2 . + real :: mc ! A layer's mass [kg m-2]. real :: s_new,R_new,t0,scale, cdz integer :: i, j, k, is, ie, js, je, nz, ks diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 60672c9886..fe1ed975d6 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -159,7 +159,7 @@ module MOM_diabatic_driver !! applied to tracers, especially in massless layers !! near the bottom [Z2 s-1 ~> m2 s-1]. real :: minimum_forcing_depth = 0.001 !< The smallest depth over which heat and freshwater - !! fluxes are applied, in m. + !! fluxes are applied [m]. real :: evap_CFL_limit = 0.8 !< The largest fraction of a layer that can be !! evaporated in one time-step (non-dim). integer :: halo_TS_diff = 0 !< The temperature, salinity and thickness halo size that @@ -248,9 +248,9 @@ module MOM_diabatic_driver ! Data arrays for communicating between components real, allocatable, dimension(:,:,:) :: KPP_NLTheat !< KPP non-local transport for heat [m s-1] real, allocatable, dimension(:,:,:) :: KPP_NLTscalar !< KPP non-local transport for scalars [m s-1] - real, allocatable, dimension(:,:,:) :: KPP_buoy_flux !< KPP forcing buoyancy flux (m^2/s^3) - real, allocatable, dimension(:,:) :: KPP_temp_flux !< KPP effective temperature flux (K m/s) - real, allocatable, dimension(:,:) :: KPP_salt_flux !< KPP effective salt flux (ppt m/s) + real, allocatable, dimension(:,:,:) :: KPP_buoy_flux !< KPP forcing buoyancy flux [m2 s-3] + real, allocatable, dimension(:,:) :: KPP_temp_flux !< KPP effective temperature flux [degC m s-1] + real, allocatable, dimension(:,:) :: KPP_salt_flux !< KPP effective salt flux [ppt m s-1] type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) end type diabatic_CS @@ -272,10 +272,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness (m for Bouss / kg/m2 for non-Bouss) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs - real, dimension(:,:), pointer :: Hml !< mixed layer depth, m + real, dimension(:,:), pointer :: Hml !< mixed layer depth [m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and @@ -283,7 +283,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations - real, intent(in) :: dt !< time increment (seconds) + real, intent(in) :: dt !< time increment [s] type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves @@ -291,22 +291,22 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & ea_s, & ! amount of fluid entrained from the layer above within - ! one time step (m for Bouss, kg/m^2 for non-Bouss) + ! one time step [H ~> m or kg m-2] eb_s, & ! amount of fluid entrained from the layer below within - ! one time step (m for Bouss, kg/m^2 for non-Bouss) + ! one time step [H ~> m or kg m-2] ea_t, & ! amount of fluid entrained from the layer above within - ! one time step (m for Bouss, kg/m^2 for non-Bouss) + ! one time step [H ~> m or kg m-2] eb_t, & ! amount of fluid entrained from the layer below within - ! one time step (m for Bouss, kg/m^2 for non-Bouss) - Kd_lay, & ! diapycnal diffusivity of layers (Z^2/sec) - h_orig, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) - h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) + ! one time step [H ~> m or kg m-2] + Kd_lay, & ! diapycnal diffusivity of layers [Z2 s-1 ~> m2 s-1] + h_orig, & ! initial layer thicknesses [H ~> m or kg m-2] + h_prebound, & ! initial layer thicknesses [H ~> m or kg m-2] ! hold, & ! layer thickness before diapycnal entrainment, and later ! the initial layer thicknesses (if a mixed layer is used), - ! (m for Bouss, kg/m^2 for non-Bouss) + ! [H ~> m or kg m-2] dSV_dT, & ! The partial derivatives of specific volume with temperature - dSV_dS, & ! and salinity in m^3/(kg K) and m^3/(kg ppt). - cTKE, & ! convective TKE requirements for each layer in J/m^2. + dSV_dS, & ! and salinity in [m3 kg-1 degC-1] and [m3 kg-1 ppt-1]. + cTKE, & ! convective TKE requirements for each layer [J/m^2]. u_h, & ! zonal and meridional velocities at thickness points after v_h ! entrainment [m s-1] real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & @@ -329,20 +329,20 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! near the boundaries [H ~> m or kg m-2] (for Bous or non-Bouss) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & - Kd_int, & ! diapycnal diffusivity of interfaces (m^2/s) - Kd_heat, & ! diapycnal diffusivity of heat (Z^2/s) - Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (Z^2/s) - Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (Z^2/s) - eta, & ! Interface heights before diapycnal mixing, in m. - Tdif_flx, & ! diffusive diapycnal heat flux across interfaces (K m/s) - Tadv_flx, & ! advective diapycnal heat flux across interfaces (K m/s) - Sdif_flx, & ! diffusive diapycnal salt flux across interfaces (ppt m/s) - Sadv_flx ! advective diapycnal salt flux across interfaces (ppt m/s) + Kd_int, & ! diapycnal diffusivity of interfaces [Z2 s-1 ~> m2 s-1] + Kd_heat, & ! diapycnal diffusivity of heat [Z2 s-1 ~> m2 s-1] + Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 s-1 ~> m2 s-1] + Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 s-1 ~> m2 s-1] + eta, & ! Interface heights before diapycnal mixing [m]. + Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC m s-1] + Tadv_flx, & ! advective diapycnal heat flux across interfaces [degC m s-1] + Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [ppt m s-1] + Sadv_flx ! advective diapycnal salt flux across interfaces [ppt m s-1] ! The following 5 variables are only used with a bulk mixed layer. real, pointer, dimension(:,:,:) :: & eaml, & ! The equivalent of ea and eb due to mixed layer processes [H ~> m or kg m-2] - ebml ! (m for Bouss and kg/m^2 for non-Bouss). These will be + ebml ! [H ~> m or kg m-2]. These will be ! pointers to eatr and ebtr so as to reuse the memory as ! the arrays are not needed at the same time. @@ -351,7 +351,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real :: p_ref_cv(SZI_(G)) ! Reference pressure for the potential ! density which defines the coordinate - ! variable, set to P_Ref, in Pa. + ! variable, set to P_Ref [Pa]. logical :: in_boundary(SZI_(G)) ! True if there are no massive layers below, ! where massive is defined as sufficiently thick that @@ -359,27 +359,26 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! the entrainment - usually sqrt(Kd*dt). real :: b_denom_1 ! The first term in the denominator of b1 - ! (m for Bouss, kg/m^2 for non-Bouss) + ! [H ~> m or kg m-2] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected - ! (m for Bouss and kg/m^2 for non-Bouss) - real :: h_neglect2 ! h_neglect^2 (m^2 for Bouss, kg^2/m^4 for non-Bouss) + ! [H ~> m or kg m-2] + real :: h_neglect2 ! h_neglect^2 [H2 ~> m2 or kg2 m-4] real :: add_ent ! Entrainment that needs to be added when mixing tracers - ! (m for Bouss and kg/m^2 for non-Bouss) - real :: eaval ! eaval is 2*ea at velocity grid points (m for Bouss, kg/m^2 for non-Bouss) - real :: hval ! hval is 2*h at velocity grid points (m for Bouss, kg/m^2 for non-Bouss) + ! [H ~> m or kg m-2] + real :: eaval ! eaval is 2*ea at velocity grid points [H ~> m or kg m-2] + real :: hval ! hval is 2*h at velocity grid points [H ~> m or kg m-2] real :: h_tr ! h_tr is h at tracer points with a tiny thickness - ! added to ensure positive definiteness (m for Bouss, kg/m^2 for non-Bouss) + ! added to ensure positive definiteness [H ~> m or kg m-2] real :: Tr_ea_BBL ! The diffusive tracer thickness in the BBL that is - ! coupled to the bottom within a timestep (m) + ! coupled to the bottom within a timestep [H ~> m or kg m-2] real :: htot(SZIB_(G)) ! The summed thickness from the bottom [H ~> m or kg m-2]. real :: b1(SZIB_(G)), d1(SZIB_(G)) ! b1, c1, and d1 are variables used by the real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. - real :: Ent_int ! The diffusive entrainment rate at an interface - ! (H units = m for Bouss, kg/m^2 for non-Bouss). - real :: dt_mix ! amount of time over which to apply mixing (seconds) + real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2] + real :: dt_mix ! amount of time over which to apply mixing [s] real :: Idt ! inverse time step [s-1] type(p3d) :: z_ptrs(7) ! pointers to diagnostics to be interpolated to depth @@ -1158,7 +1157,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness (m for Bouss / kg/m2 for non-Bouss) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs real, dimension(:,:), pointer :: Hml !< active mixed layer depth @@ -1169,25 +1168,25 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !! equations, to enable the later derived !! diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations - real, intent(in) :: dt !< time increment (seconds) + real, intent(in) :: dt !< time increment [s] type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & ea, & ! amount of fluid entrained from the layer above within - ! one time step (m for Bouss, kg/m^2 for non-Bouss) + ! one time step [H ~> m or kg m-2] eb, & ! amount of fluid entrained from the layer below within - ! one time step (m for Bouss, kg/m^2 for non-Bouss) - Kd_lay, & ! diapycnal diffusivity of layers (Z^2/sec) - h_orig, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) - h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) + ! one time step [H ~> m or kg m-2] + Kd_lay, & ! diapycnal diffusivity of layers [Z2 s-1 ~> m2 s-1] + h_orig, & ! initial layer thicknesses [H ~> m or kg m-2] + h_prebound, & ! initial layer thicknesses [H ~> m or kg m-2] hold, & ! layer thickness before diapycnal entrainment, and later ! the initial layer thicknesses (if a mixed layer is used), - ! (m for Bouss, kg/m^2 for non-Bouss) - dSV_dT, & ! The partial derivatives of specific volume with temperature - dSV_dS, & ! and salinity in m^3/(kg K) and m^3/(kg ppt). - cTKE, & ! convective TKE requirements for each layer in J/m^2. + ! [H ~> m or kg m-2] + dSV_dT, & ! The partial derivative of specific volume with temperature [m3 kg-1 degC-1] + dSV_dS, & ! The partial derivative of specific volume with salinity [m3 kg-1 ppt-1]. + cTKE, & ! convective TKE requirements for each layer [J m-2]. u_h, & ! zonal and meridional velocities at thickness points after v_h ! entrainment [m s-1] @@ -1209,23 +1208,23 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! These are targets so that the space can be shared with eaml & ebml. eatr, & ! The equivalent of ea and eb for tracers, which differ from ea and ebtr ! eb in that they tend to homogenize tracers in massless layers - ! near the boundaries (m for Bouss and kg/m^2 for non-Bouss) + ! near the boundaries [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & - Kd_int, & ! diapycnal diffusivity of interfaces (Z^2/s) - Kd_heat, & ! diapycnal diffusivity of heat (Z^2/s) - Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (Z^2/s) - Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (Z^2/s) - eta, & ! Interface heights before diapycnal mixing, in m. - Tdif_flx, & ! diffusive diapycnal heat flux across interfaces (K m/s) - Tadv_flx, & ! advective diapycnal heat flux across interfaces (K m/s) - Sdif_flx, & ! diffusive diapycnal salt flux across interfaces (ppt m/s) - Sadv_flx ! advective diapycnal salt flux across interfaces (ppt m/s) + Kd_int, & ! diapycnal diffusivity of interfaces [Z2 s-1 ~> m2 s-1] + Kd_heat, & ! diapycnal diffusivity of heat [Z2 s-1 ~> m2 s-1] + Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 s-1 ~> m2 s-1] + Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 s-1 ~> m2 s-1] + eta, & ! Interface heights before diapycnal mixing [m]. + Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC m s-1] + Tadv_flx, & ! advective diapycnal heat flux across interfaces [degC m s-1] + Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [ppt m s-1] + Sadv_flx ! advective diapycnal salt flux across interfaces [ppt m s-1] ! The following 5 variables are only used with a bulk mixed layer. real, pointer, dimension(:,:,:) :: & eaml, & ! The equivalent of ea and eb due to mixed layer processes, - ebml ! (m for Bouss and kg/m^2 for non-Bouss). These will be + ebml ! [H ~> m or kg m-2]. These will be ! pointers to eatr and ebtr so as to reuse the memory as ! the arrays are not needed at the same time. @@ -1234,7 +1233,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en real :: p_ref_cv(SZI_(G)) ! Reference pressure for the potential ! density which defines the coordinate - ! variable, set to P_Ref, in Pa. + ! variable, set to P_Ref [Pa]. logical :: in_boundary(SZI_(G)) ! True if there are no massive layers below, ! where massive is defined as sufficiently thick that @@ -1242,27 +1241,26 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! the entrainment - usually sqrt(Kd*dt). real :: b_denom_1 ! The first term in the denominator of b1 - ! (m for Bouss, kg/m^2 for non-Bouss) + ! [H ~> m or kg m-2] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected - ! (m for Bouss and kg/m^2 for non-Bouss) - real :: h_neglect2 ! h_neglect^2 (m^2 for Bouss, kg^2/m^4 for non-Bouss) + ! [H ~> m or kg m-2] + real :: h_neglect2 ! h_neglect^2 [H2 ~> m2 or kg2 m-4] real :: add_ent ! Entrainment that needs to be added when mixing tracers - ! (m for Bouss and kg/m^2 for non-Bouss) - real :: eaval ! eaval is 2*ea at velocity grid points (m for Bouss, kg/m^2 for non-Bouss) - real :: hval ! hval is 2*h at velocity grid points (m for Bouss, kg/m^2 for non-Bouss) + ! [H ~> m or kg m-2] + real :: eaval ! eaval is 2*ea at velocity grid points [H ~> m or kg m-2] + real :: hval ! hval is 2*h at velocity grid points [H ~> m or kg m-2] real :: h_tr ! h_tr is h at tracer points with a tiny thickness - ! added to ensure positive definiteness (m for Bouss, kg/m^2 for non-Bouss) + ! added to ensure positive definiteness [H ~> m or kg m-2] real :: Tr_ea_BBL ! The diffusive tracer thickness in the BBL that is ! coupled to the bottom within a timestep (m) - real :: htot(SZIB_(G)) ! The summed thickness from the bottom, in m. + real :: htot(SZIB_(G)) ! The summed thickness from the bottom [H ~> m or kg m-2]. real :: b1(SZIB_(G)), d1(SZIB_(G)) ! b1, c1, and d1 are variables used by the real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. - real :: Ent_int ! The diffusive entrainment rate at an interface - ! (H units = m for Bouss, kg/m^2 for non-Bouss). - real :: dt_mix ! amount of time over which to apply mixing (seconds) + real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2]. + real :: dt_mix ! amount of time over which to apply mixing [s] real :: Idt ! inverse time step [s-1] type(p3d) :: z_ptrs(7) ! pointers to diagnostics to be interpolated to depth @@ -2454,7 +2452,7 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, & real, optional, intent( out) :: evap_CFL_limit ! CS%opacity_CSp @@ -2473,7 +2471,7 @@ subroutine adiabatic(h, tv, fluxes, dt, G, GV, CS) intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields type(forcing), intent(inout) :: fluxes !< boundary fluxes - real, intent(in) :: dt !< time step (seconds) + real, intent(in) :: dt !< time step [s] type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(diabatic_CS), pointer :: CS !< module control structure diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index fe20811bc9..53e4b29178 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -195,7 +195,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & h_tr ! h_tr is h at tracer points with a h_neglect added to ! ensure positive definiteness [H ~> m or kg m-2]. real, dimension(GV%ke+1) :: & - pres, & ! Interface pressures in Pa. + pres, & ! Interface pressures [Pa]. pres_Z, & ! Interface pressures with a rescaling factor to convert interface height ! movements into changes in column potential energy [J m-2 Z-1 ~> J m-3]. z_Int, & ! Interface heights relative to the surface [H ~> m or kg m-2]. diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 8c35442461..1f91f300c1 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -200,7 +200,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: dSV_dT !< The partial derivative of in-situ specific !! volume with potential temperature - !! [m3 kg-1 K-1]. + !! [m3 kg-1 degC-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: dSV_dS !< The partial derivative of in-situ specific !! volume with salinity [m3 kg-1 ppt-1]. @@ -300,7 +300,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS dS_to_dPE, & ! and salinity changes within a layer, in [J m-2 degC-1] and [J m-2 ppt-1]. dT_to_dColHt_a, & ! Partial derivatives of the total column height with the temperature dS_to_dColHt_a, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers higher in the water colun [Z K-1 ~> m K-1] and [Z ppt-1 ~> m ppt-1]. + ! of mixing with layers higher in the water colun [Z degC-1 ~> m degC-1] and [Z ppt-1 ~> m ppt-1]. dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature dS_to_dPE_a ! and salinity changes within a layer, including the implicit effects ! of mixing with layers higher in the water column, in @@ -1604,7 +1604,7 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real, intent(in) :: dT_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers above [Z K-1 ~> m K-1]. + !! in the temperatures of all the layers above [Z degC-1 ~> m degC-1]. real, intent(in) :: dS_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes @@ -1612,7 +1612,7 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real, intent(in) :: dT_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers below [Z K-1 ~> m K-1]. + !! in the temperatures of all the layers below [Z degC-1 ~> m degC-1]. real, intent(in) :: dS_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes @@ -1743,7 +1743,7 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & real, intent(in) :: dT_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers below [Z K-1 ~> m K-1]. + !! in the temperatures of all the layers below [Z degC-1 ~> m degC-1]. real, intent(in) :: dS_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes @@ -1751,7 +1751,7 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & real, intent(in) :: dT_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column !! height, including all implicit diffusive changes - !! in the temperatures of all the layers above [Z K-1 ~> m K-1]. + !! in the temperatures of all the layers above [Z degC-1 ~> m degC-1]. real, intent(in) :: dS_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes diff --git a/src/parameterizations/vertical/MOM_full_convection.F90 b/src/parameterizations/vertical/MOM_full_convection.F90 index a47e113fc4..5fd3d67b36 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -29,7 +29,7 @@ subroutine full_convection(G, GV, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, & intent(out) :: T_adj !< Adjusted potential temperature [degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: S_adj !< Adjusted salinity [ppt]. - real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface in Pa (or NULL). + real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [Pa] (or NULL). real, intent(in) :: Kddt_smooth !< A smoothing vertical !! diffusivity times a timestep [H2 ~> m2 or kg2 m-4]. real, optional, intent(in) :: Kddt_convect !< A large convecting vertical diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 9ebb03772e..c05756c97b 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -84,7 +84,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) real :: Rcv_tgt ! coordinate density of target layer [kg m-3] real :: dRcv ! difference between Rcv and Rcv_tgt [kg m-3] real :: dRcv_dT ! partial derivative of coordinate density wrt temp - ! in the present layer (kg m-3 K-1); usually negative + ! in the present layer [kg m-3 degC-1]; usually negative real :: h_heated ! thickness that is being heated [H ~> m or kg m-2] real :: heat_avail ! heating available for the present layer [degC H ~> degC m or degC kg m-2] real :: heat_in_place ! heating to warm present layer w/o movement between layers diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 773a7a4835..111e8d44e2 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -51,7 +51,7 @@ module MOM_int_tide_input !> This type is used to exchange fields related to the internal tides. type, public :: int_tide_input_type real, allocatable, dimension(:,:) :: & - TKE_itidal_input, & !< The internal tide TKE input at the bottom of the ocean, in W m-2. + TKE_itidal_input, & !< The internal tide TKE input at the bottom of the ocean [W m-2]. h2, & !< The squared topographic roughness height [Z2 ~> m2]. tideamp, & !< The amplitude of the tidal velocities [m s-1]. Nb !< The bottom stratification [s-1]. diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 3037f49e0b..1a7fa0fa06 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -106,8 +106,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. - real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface in Pa - !! (or NULL). + real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [Pa] (or NULL). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: kappa_io !< The diapycnal diffusivity at each interface !! (not layer!) [Z2 s-1 ~> m2 s-1]. Initially this is the @@ -115,7 +114,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & !! accelerate the iteration toward convergence. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: tke_io !< The turbulent kinetic energy per unit mass at - !! each interface (not layer!) in m2 s-2. + !! each interface (not layer!) [m2 s-2]. !! Initially this is the value from the previous !! timestep, which may accelerate the iteration !! toward convergence. @@ -391,20 +390,20 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: T_in !< Layer potential temperatures in degC + intent(in) :: T_in !< Layer potential temperatures [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: S_in !< Layer salinities in ppt. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. - real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface in Pa + real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [Pa] !! (or NULL). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: kappa_io !< The diapycnal diffusivity at each interface !! (not layer!) [Z2 s-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & intent(inout) :: tke_io !< The turbulent kinetic energy per unit mass at - !! each interface (not layer!) in m2 s-2. + !! each interface (not layer!) [m2 s-2]. !! Initially this is the value from the previous !! timestep, which may accelerate the iteration !! toward convergence. @@ -773,7 +772,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & T_int, & ! The temperature interpolated to an interface [degC]. Sal_int, & ! The salinity interpolated to an interface [PSU]. dbuoy_dT, & ! The partial derivatives of buoyancy with changes in temperature - dbuoy_dS, & ! and salinity, [Z s-2 K-1 ~> m s-2 K-1] and [Z s-2 psu-1 ~> m s-2 psu-1]. + dbuoy_dS, & ! and salinity, [Z s-2 degC-1 ~> m s-2 degC-1] and [Z s-2 psu-1 ~> m s-2 psu-1]. I_L2_bdry, & ! The inverse of the square of twice the harmonic mean ! distance to the top and bottom boundaries [Z-2 ~> m-2]. K_Q, & ! Diffusivity divided by TKE [Z2 m-2 s ~> s]. @@ -790,7 +789,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real :: b1 ! The inverse of the pivot in the tridiagonal equations. real :: bd1 ! A term in the denominator of b1. real :: d1 ! 1 - c1 in the tridiagonal equations. - real :: gR0 ! Rho_0 times g in kg m-2 s-2. + real :: gR0 ! Rho_0 times g [kg m-2 s-2]. real :: g_R0 ! g_R0 is g/Rho [Z m3 kg-1 s-2 ~> m4 kg-1 s-2]. real :: Norm ! A factor that normalizes two weights to 1 [Z-2 ~> m-2]. real :: tol_dksrc, tol2 ! ### Tolerances that need to be set better later. diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index db90deeaca..ff1871233a 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -31,15 +31,15 @@ module MOM_opacity !! water properties into the opacity (i.e., the e-folding depth) and !! (perhaps) the number of bands of penetrating shortwave radiation to use. real :: pen_sw_scale !< The vertical absorption e-folding depth of the - !! penetrating shortwave radiation, in m. + !! penetrating shortwave radiation [m]. real :: pen_sw_scale_2nd !< The vertical absorption e-folding depth of the - !! (2nd) penetrating shortwave radiation, in m. + !! (2nd) penetrating shortwave radiation [m]. real :: SW_1ST_EXP_RATIO !< Ratio for 1st exp decay in Two Exp decay opacity real :: pen_sw_frac !< The fraction of shortwave radiation that is !! penetrating with a constant e-folding approach. real :: blue_frac !< The fraction of the penetrating shortwave !! radiation that is in the blue band, ND. - real :: opacity_land_value !< The value to use for opacity over land, in m-1. + real :: opacity_land_value !< The value to use for opacity over land [m-1]. !! The default is 10 m-1 - a value for muddy water. integer :: sbc_chl !< An integer handle used in time interpolation of !! chlorophyll read from a file. @@ -79,25 +79,16 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) type(opacity_CS), pointer :: CS !< The control structure earlier set up by !! opacity_init. -! Arguments: (inout) opacity - The inverse of the vertical absorption decay -! scale for penetrating shortwave radiation, in m-1. -! (inout) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure earlier set up by opacity_init. - ! local variables integer :: i, j, k, n, is, ie, js, je, nz - real :: inv_sw_pen_scale ! The inverse of the e-folding scale, in m-1. + real :: inv_sw_pen_scale ! The inverse of the e-folding scale [m-1]. real :: Inv_nbands ! The inverse of the number of bands of penetrating ! shortwave radiation. logical :: call_for_surface ! if horizontal slice is the surface layer real :: tmp(SZI_(G),SZJ_(G),SZK_(G)) ! A 3-d temporary array. - real :: chl(SZI_(G),SZJ_(G),SZK_(G)) ! The concentration of chlorophyll-A - ! in mg m-3. + real :: chl(SZI_(G),SZJ_(G),SZK_(G)) ! The concentration of chlorophyll-A [mg m-3]. real :: Pen_SW_tot(SZI_(G),SZJ_(G)) ! The penetrating shortwave radiation - ! summed across all bands, in W m-2. + ! summed across all bands [W m-2]. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke if (.not. associated(CS)) call MOM_error(FATAL, "set_opacity: "// & @@ -210,18 +201,17 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) optional, intent(in) :: chl_in !< A 3-d field of chlorophyll A, !! in mg m-3. - real :: chl_data(SZI_(G),SZJ_(G)) ! The chlorophyll A concentrations in - ! a layer, in mg/m^3. + real :: chl_data(SZI_(G),SZJ_(G)) ! The chlorophyll A concentrations in a layer [mg m-3]. real :: Inv_nbands ! The inverse of the number of bands of penetrating ! shortwave radiation. real :: Inv_nbands_nir ! The inverse of the number of bands of penetrating ! near-infrafed radiation. real :: SW_pen_tot ! The sum across the bands of the penetrating - ! shortwave radiation, in W m-2. + ! shortwave radiation [W m-2]. real :: SW_vis_tot ! The sum across the visible bands of shortwave - ! radiation, in W m-2. + ! radiation [W m-2]. real :: SW_nir_tot ! The sum across the near infrared bands of shortwave - ! radiation, in W m-2. + ! radiation [W m-2]. type(time_type) :: day character(len=128) :: mesg integer :: i, j, k, n, is, ie, js, je, nz, nbands diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 1646a6650b..18cdefa177 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -672,7 +672,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & real, dimension(SZI_(G),SZK_(G)), intent(in) :: N2_lay !< The squared buoyancy frequency of the !! layers [s-2]. integer, intent(in) :: j !< j-index of row to work on - real, intent(in) :: dt !< Time increment (sec). + real, intent(in) :: dt !< Time increment [s]. type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZK_(G)), intent(out) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the @@ -1400,7 +1400,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & real :: cdrag_sqrt ! square root of the drag coefficient [nondim] real :: ustar ! value of ustar at a thickness point [Z s-1 ~> m s-1]. real :: ustar2 ! square of ustar, for convenience [Z2 s-2 ~> m2 s-2] - real :: absf ! average absolute value of Coriolis parameter around a thickness point (1/sec) + real :: absf ! average absolute value of Coriolis parameter around a thickness point [s-1] real :: dh, dhm1 ! thickness of layers k and k-1, respecitvely [Z ~> m]. real :: z_bot ! distance to interface k from bottom [Z ~> m]. real :: D_minus_z ! distance to interface k from surface [Z ~> m]. @@ -1453,12 +1453,12 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! I am still unsure about sqrt(cdrag) in this expressions - AJA TKE_column = cdrag_sqrt * visc%TKE_BBL(i,j) ! Add in tidal dissipation energy at the bottom [m3 s-3]. - ! Note that TKE_tidal is in W m-2. + ! Note that TKE_tidal is in [W m-2]. if (associated(fluxes%TKE_tidal)) TKE_column = TKE_column + fluxes%TKE_tidal(i,j) * I_Rho0 TKE_column = CS%BBL_effic * TKE_column ! Only use a fraction of the mechanical dissipation for mixing. TKE_remaining = TKE_column - total_thickness = ( sum(h(i,j,:)) + GV%H_subroundoff )* GV%H_to_Z ! Total column thickness, in m. + total_thickness = ( sum(h(i,j,:)) + GV%H_subroundoff )* GV%H_to_Z ! Total column thickness [Z ~> m]. ustar_D = ustar * total_thickness z_bot = 0. Kd_lower = 0. ! Diffusivity on bottom boundary. @@ -1485,7 +1485,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & z_bot = z_bot + h(i,j,k)*GV%H_to_Z ! Distance between upper interface of layer and the bottom [Z ~> m]. D_minus_z = max(total_thickness - z_bot, 0.) ! Thickness above layer, Z. - ! Diffusivity using law of the wall, limited by rotation, at height z, in m2/s. + ! Diffusivity using law of the wall, limited by rotation, at height z [m2 s-1]. ! This calculation is at the upper interface of the layer if ( ustar_D + absf * ( z_bot * D_minus_z ) == 0.) then Kd_wall = 0. diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 00945505ed..cb07d230e4 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1032,7 +1032,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri vhtot, & ! the surface mixed layer [H m s-1 ~> m2 s-1 or kg m-1 s-1]. Idecay_len_TKE, & ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. dR_dT, & ! Partial derivative of the density at the base of layer nkml - ! (roughly the base of the mixed layer) with temperature [kg m-3 K-1]. + ! (roughly the base of the mixed layer) with temperature [kg m-3 degC-1]. dR_dS, & ! Partial derivative of the density at the base of layer nkml ! (roughly the base of the mixed layer) with salinity [kg m-3 psu-1]. ustar, & ! The surface friction velocity under ice shelves [Z s-1 ~> m s-1]. diff --git a/src/parameterizations/vertical/MOM_shortwave_abs.F90 b/src/parameterizations/vertical/MOM_shortwave_abs.F90 index 6666658f08..7e6878455a 100644 --- a/src/parameterizations/vertical/MOM_shortwave_abs.F90 +++ b/src/parameterizations/vertical/MOM_shortwave_abs.F90 @@ -55,7 +55,7 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, integer, intent(in) :: nsw !< Number of bands of penetrating !! shortwave radiation. integer, intent(in) :: j !< j-index to work on. - real, intent(in) :: dt !< Time step (seconds). + real, intent(in) :: dt !< Time step [s]. real, intent(in) :: H_limit_fluxes !< If the total ocean depth is !! less than this, they are scaled away !! to avoid numerical instabilities @@ -305,8 +305,8 @@ subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & real, dimension(SZI_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(:,:,:), intent(in) :: opacity_band !< opacity in each band of - !! penetrating shortwave radiation, - !! in m-1. The indicies are band, i, k. + !! penetrating shortwave radiation [m-1]. + !! The indicies are band, i, k. integer, intent(in) :: nsw !< number of bands of penetrating !! shortwave radiation. integer, intent(in) :: j !< j-index to work on. diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index fdda545d0b..328f258311 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -123,7 +123,7 @@ module MOM_tidal_mixing real :: Polzin_min_decay_scale !< minimum decay scale of the tidal dissipation !! profile in Polzin formulation [Z ~> m]. - real :: TKE_itide_max !< maximum internal tide conversion (W m-2) + real :: TKE_itide_max !< maximum internal tide conversion [W m-2] !! available to mix above the BBL real :: utide !< constant tidal amplitude [m s-1] used if @@ -146,20 +146,19 @@ module MOM_tidal_mixing type(remapping_CS) :: remap_CS !< The control structure for remapping ! Data containers - real, pointer, dimension(:,:) :: TKE_Niku => NULL() !< Lee wave driven Turbulent Kinetic Energy input, - !! in W m-2 + real, pointer, dimension(:,:) :: TKE_Niku => NULL() !< Lee wave driven Turbulent Kinetic Energy input [W m-2] real, pointer, dimension(:,:) :: TKE_itidal => NULL() !< The internal Turbulent Kinetic Energy input divided - !! by the bottom stratfication, in J m-2. + !! by the bottom stratfication [J m-2]. real, pointer, dimension(:,:) :: Nb => NULL() !< The near bottom buoyancy frequency [s-1]. real, pointer, dimension(:,:) :: mask_itidal => NULL() !< A mask of where internal tide energy is input - real, pointer, dimension(:,:) :: h2 => NULL() !< Squared bottom depth variance, in m2. + real, pointer, dimension(:,:) :: h2 => NULL() !< Squared bottom depth variance [m2]. real, pointer, dimension(:,:) :: tideamp => NULL() !< RMS tidal amplitude [m s-1] real, allocatable, dimension(:) :: h_src !< tidal constituent input layer thickness [m] real, allocatable, dimension(:,:) :: tidal_qe_2d !< Tidal energy input times the local dissipation !! fraction, q*E(x,y), with the CVMix implementation - !! of Jayne et al tidal mixing, in W m-2. + !! of Jayne et al tidal mixing [W m-2]. !! TODO: make this E(x,y) only - real, allocatable, dimension(:,:,:) :: tidal_qe_3d_in !< q*E(x,y,z) with the Schmittner parameterization, in W m-3? + real, allocatable, dimension(:,:,:) :: tidal_qe_3d_in !< q*E(x,y,z) with the Schmittner parameterization [W m-3?] ! Diagnostics type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostic output timing diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 94eb79eca1..e462fc2bac 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -162,15 +162,15 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & type(cont_diag_ptrs), intent(inout) :: CDp !< Continuity equation terms type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(out) :: taux_bot !< Zonal bottom stress from ocean to rock in Pa + optional, intent(out) :: taux_bot !< Zonal bottom stress from ocean to rock [Pa] real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(out) :: tauy_bot !< Meridional bottom stress from ocean to rock in Pa + optional, intent(out) :: tauy_bot !< Meridional bottom stress from ocean to rock [Pa] type(wave_parameters_CS), & optional, pointer :: Waves !< Container for wave/Stokes information ! Fields from forces used in this subroutine: - ! taux: Zonal wind stress in Pa. - ! tauy: Meridional wind stress in Pa. + ! taux: Zonal wind stress [Pa]. + ! tauy: Meridional wind stress [Pa]. ! Local variables diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 34fbde08c7..5793f75914 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -174,7 +174,7 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & real, pointer :: tr_ptr(:,:,:) => NULL() real :: PI ! 3.1415926... calculated as 4*atan(1) real :: tr_y ! Initial zonally uniform tracer concentrations. - real :: dist2 ! The distance squared from a line, in m2. + real :: dist2 ! The distance squared from a line [m2]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: e(SZK_(G)+1), e_top, e_bot ! Heights [Z ~> m]. @@ -310,7 +310,7 @@ subroutine DOME_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can !! be fluxed out of the top layer in a timestep (nondim) real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which - !! fluxes can be applied, in m + !! fluxes can be applied [m] ! Local variables real :: b1(SZI_(G)) ! b1 and c1 are variables used by the diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 2096157a41..c7909300e0 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -181,9 +181,9 @@ subroutine initialize_ISOMIP_tracer(restart, day, G, GV, h, diag, OBC, CS, & real, pointer :: tr_ptr(:,:,:) => NULL() real :: PI ! 3.1415926... calculated as 4*atan(1) real :: tr_y ! Initial zonally uniform tracer concentrations. - real :: dist2 ! The distance squared from a line, in m2. + real :: dist2 ! The distance squared from a line [m2]. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: e(SZK_(G)+1), e_top, e_bot, d_tr integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB @@ -274,7 +274,7 @@ subroutine ISOMIP_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, G real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can !! be fluxed out of the top layer in a timestep (nondim) real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which - !! fluxes can be applied, in m + !! fluxes can be applied [m] ! The arguments to this subroutine are redundant in that ! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index 9a2ba54ba3..3dbbde970f 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -429,7 +429,7 @@ subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can !! be fluxed out of the top layer in a timestep (nondim) real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which - !! fluxes can be applied, in m + !! fluxes can be applied [m] ! This subroutine applies diapycnal diffusion and any other column ! tracer physics or chemistry to the tracers from this file. ! CFCs are relatively simple, as they are passive tracers. with only a surface @@ -496,9 +496,8 @@ function OCMIP2_CFC_stock(h, stocks, G, GV, CS, names, units, stock_index) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount - !! of each tracer, in kg times - !! concentration units. + real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each + !! tracer, in kg times concentration units [kg conc]. type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a !! previous call to register_OCMIP2_CFC. character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 50ba29367d..93f72b239d 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -602,7 +602,7 @@ function MOM_generic_tracer_stock(h, stocks, G, GV, CS, names, units, stock_inde type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< The mass-weighted integrated amount of each - !! tracer, in kg times concentration units. + !! tracer, in kg times concentration units [kg conc]. type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated. diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index dc616e8a49..89f4a6eef4 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -47,13 +47,13 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) type(ocean_grid_type), pointer :: G !< ocean grid structure type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: uhtr !< Accumulated mass flux through zonal face, in kg + intent(in) :: uhtr !< Accumulated mass flux through zonal face [kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: vhtr !< Accumulated mass flux through meridional face, in kg + intent(in) :: vhtr !< Accumulated mass flux through meridional face [kg] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_pre !< Previous layer thicknesses, in kg m-2. + intent(in) :: h_pre !< Previous layer thicknesses [kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h_new !< Updated layer thicknesses, in kg m-2. + intent(inout) :: h_new !< Updated layer thicknesses [kg m-2]. ! Local variables integer :: i, j, k, m, is, ie, js, je, nz @@ -86,15 +86,15 @@ subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new) type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: ea !< Mass of fluid entrained from the layer - !! above within this timestep, in kg m-2 + !! above within this timestep [kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: eb !< Mass of fluid entrained from the layer - !! below within this timestep, in kg m-2 + !! below within this timestep [kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h_pre !< Layer thicknesses at the end of the previous - !! step, in kg m-2. + !! step [kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h_new !< Updated layer thicknesses, in kg m-2. + intent(inout) :: h_new !< Updated layer thicknesses [kg m-2]. ! Local variables integer :: i, j, k, m, is, ie, js, je, nz @@ -138,18 +138,18 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) type(ocean_grid_type), pointer :: G !< ocean grid structure type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: uh !< Mass flux through zonal face, in kg + intent(inout) :: uh !< Mass flux through zonal face [kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: vh !< Mass flux through meridional face, in kg + intent(inout) :: vh !< Mass flux through meridional face [kg] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: ea !< Mass of fluid entrained from the layer - !! above within this timestep, in kg m-2 + !! above within this timestep [kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: eb !< Mass of fluid entrained from the layer - !! below within this timestep, in kg m-2 + !! below within this timestep [kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h_pre !< Layer thicknesses at the end of the previous - !! step, in kg m-2. + !! step [kg m-2]. ! Local variables integer :: i, j, k, m, is, ie, js, je, nz @@ -242,9 +242,9 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in ) :: hvol !< Mass of water in the cells at the end - !! of the previous timestep, in kg + !! of the previous timestep [kg] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: uh !< Zonal mass transport within a timestep, in kg + intent(inout) :: uh !< Zonal mass transport within a timestep [kg] real, dimension(SZIB_(G),SZK_(G)) :: uh2d real, dimension(SZIB_(G)) :: uh2d_sum @@ -313,9 +313,9 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in ) :: hvol !< Mass of water in the cells at the end - !! of the previous timestep, in kg + !! of the previous timestep [kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: vh !< Meridional mass transport within a timestep, in kg + intent(inout) :: vh !< Meridional mass transport within a timestep [kg] real, dimension(SZJB_(G),SZK_(G)) :: vh2d real, dimension(SZJB_(G)) :: vh2d_sum @@ -386,9 +386,9 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in ) :: hvol !< Mass of water in the cells at the end - !! of the previous timestep, in kg + !! of the previous timestep [kg] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: uh !< Zonal mass transport within a timestep, in kg + intent(inout) :: uh !< Zonal mass transport within a timestep [kg] real, dimension(SZIB_(G),SZK_(G)) :: uh2d real, dimension(SZI_(G),SZK_(G)) :: h2d @@ -482,9 +482,9 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in ) :: hvol !< Mass of water in the cells at the end - !! of the previous timestep, in kg + !! of the previous timestep [kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: vh !< Meridional mass transport within a timestep, in kg + intent(inout) :: vh !< Meridional mass transport within a timestep [kg] real, dimension(SZJB_(G),SZK_(G)) :: vh2d real, dimension(SZJB_(G)) :: vh2d_sum @@ -637,9 +637,9 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ character(len=*), intent(in ) :: snap_file !< Name of file with snapshot fields character(len=*), intent(in ) :: surf_file !< Name of file with surface fields real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: uhtr !< Zonal mass fluxes in kg + intent(inout) :: uhtr !< Zonal mass fluxes [kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: vhtr !< Meridional mass fluxes in kg + intent(inout) :: vhtr !< Meridional mass fluxes [kg] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h_end !< End of timestep layer thickness real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -770,12 +770,12 @@ subroutine update_offline_from_arrays(G, GV, nk_input, ridx_sum, mean_file, sum_ character(len=200), intent(in ) :: mean_file !< Name of file with averages fields character(len=200), intent(in ) :: sum_file !< Name of file with summed fields character(len=200), intent(in ) :: snap_file !< Name of file with snapshot fields - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Zonal mass fluxes in kg - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Meridional mass fluxes in kg - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hend !< End of timestep layer thickness in kg m-2 - real, dimension(:,:,:,:), allocatable, intent(inout) :: uhtr_all !< Zonal mass fluxes in kg - real, dimension(:,:,:,:), allocatable, intent(inout) :: vhtr_all !< Meridional mass fluxes in kg - real, dimension(:,:,:,:), allocatable, intent(inout) :: hend_all !< End of timestep layer thickness in kg m-2 + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Zonal mass fluxes [kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Meridional mass fluxes [kg] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hend !< End of timestep layer thickness [kg m-2] + real, dimension(:,:,:,:), allocatable, intent(inout) :: uhtr_all !< Zonal mass fluxes [kg] + real, dimension(:,:,:,:), allocatable, intent(inout) :: vhtr_all !< Meridional mass fluxes [kg] + real, dimension(:,:,:,:), allocatable, intent(inout) :: hend_all !< End of timestep layer thickness [kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: temp !< Temperature array real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: salt !< Salinity array real, dimension(:,:,:,:), allocatable, intent(inout) :: temp_all !< Temperature array diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 0a61bd173b..03fc01ab06 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -58,7 +58,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: vhtr !< accumulated volume/mass flux through merid face [H m2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used - real, intent(in) :: dt !< time increment (seconds) + real, intent(in) :: dt !< time increment [s] type(tracer_advect_CS), pointer :: CS !< control structure for module type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -368,7 +368,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & real :: min_h ! The minimum thickness that can be realized during ! any of the passes [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m. + ! in roundoff and can be neglected [H ~> m or kg m-2]. logical :: do_i(SZIB_(G)) ! If true, work on given points. logical :: do_any_i integer :: i, j, m, n, i_up, stencil diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index a27bb56fcd..d7212ac8f0 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -246,7 +246,7 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim real :: H_limit_fluxes, IforcingDepthScale, Idt real :: dThickness, dTracer real :: fractionOfForcing, hOld, Ithickness - real :: RivermixConst ! A constant used in implementing river mixing, in Pa s. + real :: RivermixConst ! A constant used in implementing river mixing [Pa s]. real, dimension(SZI_(G)) :: & netMassInOut, & ! surface water fluxes [H ~> m or kg m-2] over time step netMassIn, & ! mass entering ocean surface [H ~> m or kg m-2] over a time step diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 64044c1851..eb33e423ec 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -557,7 +557,7 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni real, dimension(NIMEM_,NJMEM_,NKMEM_), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stock_values !< The integrated amounts of a tracer - !! on the current PE, usually in kg x concentration. + !! on the current PE, usually in kg x concentration [kg conc]. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index efd8ea2e2d..c5f581e976 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -35,20 +35,20 @@ module MOM_tracer_hor_diff !> The ocntrol structure for along-layer and epineutral tracer diffusion type, public :: tracer_hor_diff_CS ; private real :: dt !< The baroclinic dynamics time step [s]. - real :: KhTr !< The along-isopycnal tracer diffusivity in m2/s. + real :: KhTr !< The along-isopycnal tracer diffusivity [m2 s-1]. real :: KhTr_Slope_Cff !< The non-dimensional coefficient in KhTr formula - real :: KhTr_min !< Minimum along-isopycnal tracer diffusivity in m2/s. - real :: KhTr_max !< Maximum along-isopycnal tracer diffusivity in m2/s. + real :: KhTr_min !< Minimum along-isopycnal tracer diffusivity [m2 s-1]. + real :: KhTr_max !< Maximum along-isopycnal tracer diffusivity [m2 s-1]. real :: KhTr_passivity_coeff !< Passivity coefficient that scales Rd/dx (default = 0) !! where passivity is the ratio between along-isopycnal - !! tracer mixing and thickness mixing - real :: KhTr_passivity_min !< Passivity minimum (default = 1/2) + !! tracer mixing and thickness mixing [nondim] + real :: KhTr_passivity_min !< Passivity minimum (default = 1/2) [nondim] real :: ML_KhTR_scale !< With Diffuse_ML_interior, the ratio of the !! truly horizontal diffusivity in the mixed - !! layer to the epipycnal diffusivity. Nondim. + !! layer to the epipycnal diffusivity [nondim]. real :: max_diff_CFL !< If positive, locally limit the along-isopycnal !! tracer diffusivity to keep the diffusive CFL - !! locally at or below this value. Nondim. + !! locally at or below this value [nondim]. logical :: Diffuse_ML_interior !< If true, diffuse along isopycnals between !! the mixed layer and the interior. logical :: check_diffusive_CFL !< If true, automatically iterate the diffusion @@ -98,7 +98,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla type(ocean_grid_type), intent(inout) :: G !< Grid type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, intent(in) :: dt !< time step (seconds) + real, intent(in) :: dt !< time step [s] type(MEKE_type), pointer :: MEKE !< MEKE type type(VarMix_CS), pointer :: VarMix !< Variable mixing type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index a7ba71c86b..d235989885 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -198,9 +198,9 @@ subroutine initialize_advection_test_tracer(restart, day, G, GV, h,diag, OBC, CS real, pointer :: tr_ptr(:,:,:) => NULL() real :: PI ! 3.1415926... calculated as 4*atan(1) real :: tr_y ! Initial zonally uniform tracer concentrations. - real :: dist2 ! The distance squared from a line, in m2. + real :: dist2 ! The distance squared from a line [m2]. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m. + ! in roundoff and can be neglected [H ~> m or kg m-2]. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB real :: tmpx, tmpy, locx, locy @@ -284,7 +284,7 @@ subroutine advection_test_tracer_column_physics(h_old, h_new, ea, eb, fluxes, real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can !! be fluxed out of the top layer in a timestep (nondim) real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which - !! fluxes can be applied, in m + !! fluxes can be applied [m] ! This subroutine applies diapycnal diffusion and any other column ! tracer physics or chemistry to the tracers from this file. ! This is a simple example of a set of advected passive tracers. @@ -356,7 +356,7 @@ function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each - !! tracer, in kg times concentration units. + !! tracer, in kg times concentration units [kg conc]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(advection_test_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_advection_test_tracer. diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index be82ab579b..e874a9c9ec 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -233,7 +233,7 @@ subroutine boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can !! be fluxed out of the top layer in a timestep (nondim) real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which - !! fluxes can be applied, in m + !! fluxes can be applied [m] ! This subroutine applies diapycnal diffusion and any other column ! tracer physics or chemistry to the tracers from this file. @@ -289,7 +289,7 @@ function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index) type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent( out) :: stocks !< the mass-weighted integrated amount of each - !! tracer, in kg times concentration units. + !! tracer, in kg times concentration units [kg conc]. type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_boundary_impulse_tracer. character(len=*), dimension(:), intent( out) :: names !< The names of the stocks calculated. diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 61c97a7fb4..bc1df121ab 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -271,7 +271,7 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can !! be fluxed out of the top layer in a timestep (nondim) real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which - !! fluxes can be applied, in m + !! fluxes can be applied [m] ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified @@ -331,7 +331,7 @@ end subroutine dye_tracer_column_physics function dye_stock(h, stocks, G, GV, CS, names, units, stock_index) real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of - !! each tracer, in kg times concentration units. + !! each tracer, in kg times concentration units [kg conc]. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(dye_tracer_CS), pointer :: CS !< The control structure returned by a diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index 39d5093394..c8852687f2 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -160,7 +160,7 @@ subroutine initialize_dyed_obc_tracer(restart, day, G, GV, h, diag, OBC, CS, dia ! kg(tracer) kg(water)-1 m3 s-1 or kg(tracer) s-1. real, pointer :: tr_ptr(:,:,:) => NULL() real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: e(SZK_(G)+1), e_top, e_bot, d_tr integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB @@ -226,7 +226,7 @@ subroutine dyed_obc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can !! be fluxed out of the top layer in a timestep (nondim) real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which - !! fluxes can be applied, in m + !! fluxes can be applied [m] ! Local variables real :: b1(SZI_(G)) ! b1 and c1 are variables used by the diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index c238ee9409..d648a902eb 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -306,7 +306,7 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can !! be fluxed out of the top layer in a timestep (nondim) real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which - !! fluxes can be applied, in m + !! fluxes can be applied [m] ! This subroutine applies diapycnal diffusion and any other column ! tracer physics or chemistry to the tracers from this file. ! This is a simple example of a set of advected passive tracers. @@ -376,7 +376,7 @@ function ideal_age_stock(h, stocks, G, GV, CS, names, units, stock_index) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each - !! tracer, in kg times concentration units. + !! tracer, in kg times concentration units [kg conc]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_ideal_age_tracer. diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 3eef40b489..e200d2c5a7 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -323,7 +323,7 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can !! be fluxed out of the top layer in a timestep (nondim) real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which - !! fluxes can be applied, in m + !! fluxes can be applied [m] ! This subroutine applies diapycnal diffusion and any other column ! tracer physics or chemistry to the tracers from this file. ! This is a simple example of a set of advected passive tracers. @@ -410,7 +410,7 @@ function oil_stock(h, stocks, G, GV, CS, names, units, stock_index) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each - !! tracer, in kg times concentration units. + !! tracer, in kg times concentration units [kg conc]. type(oil_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_oil_tracer. character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index c1d2d7a778..9f39537cb4 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -199,7 +199,7 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can !! be fluxed out of the top layer in a timestep (nondim) real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which - !! fluxes can be applied, in m + !! fluxes can be applied [m] ! This subroutine applies diapycnal diffusion and any other column ! tracer physics or chemistry to the tracers from this file. @@ -256,7 +256,7 @@ function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each - !! tracer, in kg times concentration units. + !! tracer, in kg times concentration units [kg conc]. type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_pseudo_salt_tracer. character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index b45358d429..26ea3fb957 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -167,7 +167,7 @@ subroutine USER_initialize_tracer(restart, day, G, GV, h, diag, OBC, CS, & real, pointer :: tr_ptr(:,:,:) => NULL() real :: PI ! 3.1415926... calculated as 4*atan(1) real :: tr_y ! Initial zonally uniform tracer concentrations. - real :: dist2 ! The distance squared from a line, in m2. + real :: dist2 ! The distance squared from a line [m2]. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB, lntr @@ -290,7 +290,7 @@ subroutine tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS) real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. real :: d1(SZI_(G)) ! d1=1-c1 is used by the tridiagonal solver. real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected, in m. + ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. integer :: i, j, k, is, ie, js, je, nz, m @@ -366,7 +366,7 @@ function USER_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each - !! tracer, in kg times concentration units. + !! tracer, in kg times concentration units [kg conc]. type(USER_tracer_example_CS), pointer :: CS !< The control structure returned by a !! previous call to register_USER_tracer. character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 5bf7584cb7..010e531973 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -118,7 +118,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) enddo ; enddo else ! This is the buoyancy only mode. do j=js,je ; do i=is,ie - ! fluxes%buoy is the buoyancy flux into the ocean in m2 s-3. A positive + ! fluxes%buoy is the buoyancy flux into the ocean [m2 s-3]. A positive ! buoyancy flux is of the same sign as heating the ocean. fluxes%buoy(i,j) = 0.0 * G%mask2dT(i,j) enddo ; enddo diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 9657f602dd..365e10fdbf 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -362,11 +362,11 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) type(sponge_CS), pointer :: CSp !< Layer-mode sponge structure type(ALE_sponge_CS), pointer :: ACSp !< ALE-mode sponge structure ! Local variables - real :: T(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for temp - real :: S(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for salt - real :: RHO(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for RHO - real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness, in m. - real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for thickness + real :: T(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for temp [degC] + real :: S(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for salt [ppt] + real :: RHO(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for RHO [kg m-3] + real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness [H ~> m or kg m-2]. + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for thickness [Z ~> m] real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate [s-1]. real :: S_ref, T_ref ! Reference salinity and temerature within surface layer real :: S_range, T_range ! Range of salinities and temperatures over the vertical diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 98f142ff74..e3685ae16f 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -97,7 +97,7 @@ subroutine DOME_initialize_thickness(h, G, GV, param_file, just_read_params) logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: e0(SZK_(GV)+1) ! The resting interface heights, in m, usually + real :: e0(SZK_(GV)+1) ! The resting interface heights [Z ~> m], usually ! negative because it is positive upward [Z ~> m]. real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! positive upward [Z ~> m]. diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index 898160c61d..a061fcb3eb 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -43,16 +43,16 @@ module MOM_controlled_forcing real :: prec_cyc_rate !< The rate at which cyclical precipitation anomaliess !! accumulate [s-1]. real :: Len2 !< The square of the length scale over which the anomalies - !! are smoothed via a Laplacian filter, in m2. + !! are smoothed via a Laplacian filter [m2]. real :: lam_heat !< A constant of proportionality between SST anomalies - !! and heat fluxes, in W m-2 K-1. + !! and heat fluxes [W m-2 degC-1]. real :: lam_prec !< A constant of proportionality between SSS anomalies - !! (normalised by mean SSS) and precipitation, in kg m-2. + !! (normalised by mean SSS) and precipitation [kg m-2]. real :: lam_cyc_heat !< A constant of proportionality between cyclical SST - !! anomalies and corrective heat fluxes, in W m-2 K-1. + !! anomalies and corrective heat fluxes [W m-2 degC-1]. real :: lam_cyc_prec !< A constant of proportionality between cyclical SSS !! anomalies (normalised by mean SSS) and corrective - !! precipitation, in kg m-2. + !! precipitation [kg m-2]. !>@{ Pointers for data. !! \todo Needs more complete documentation. @@ -83,16 +83,16 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SST_anom !< The sea surface temperature !! anomalies [degC]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SSS_anom !< The sea surface salinity - !! anomlies, in g kg-1. + !! anomlies [ppt]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SSS_mean !< The mean sea surface - !! salinity, in g kg-1. + !! salinity [ppt]. real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: virt_heat !< Virtual (corrective) heat !! fluxes that are augmented - !! in this subroutine, in W m-2. + !! in this subroutine [W m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: virt_precip !< Virtual (corrective) !! precipitation fluxes that !! are augmented in this - !! subroutine, in kg m-2 s-1. + !! subroutine [kg m-2 s-1]. type(time_type), intent(in) :: day_start !< Start time of the fluxes. real, intent(in) :: dt !< Length of time over which these !! fluxes will be applied [s]. diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index 842cbea0e9..949530e773 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -122,7 +122,7 @@ subroutine Neverland_initialize_thickness(h, G, GV, US, param_file, eqn_of_state type(EOS_type), pointer :: eqn_of_state !< integer that selects the !! equation of state. real, intent(in) :: P_Ref !< The coordinate-density - !! reference pressure in Pa. + !! reference pressure [Pa]. ! Local variables real :: e0(SZK_(G)+1) ! The resting interface heights, in depth units [Z ~> m], ! usually negative because it is positive upward. diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index 88500eaacd..e24db1bcda 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -227,7 +227,7 @@ end subroutine SCM_CVMix_tests_wind_forcing subroutine SCM_CVMix_tests_buoyancy_forcing(state, fluxes, day, G, CS) type(surface), intent(in) :: state !< Surface state structure type(forcing), intent(inout) :: fluxes !< Surface fluxes structure - type(time_type), intent(in) :: day !< Time in days (seconds?) + type(time_type), intent(in) :: day !< Current model time type(ocean_grid_type), intent(inout) :: G !< Grid structure type(SCM_CVMix_tests_CS), pointer :: CS !< Container for SCM parameters diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 54a060841c..c6e6354ef3 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -79,7 +79,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, US, param_file, just_read_p type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized, in m. + intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -195,9 +195,9 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, param_file eqn_of_state, just_read_params) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature (degC) - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity (ppt) - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness (m or Pa) + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature [degC] + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity [ppt] + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, optional, intent(in) :: just_read_params !< If present and true, this call will diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index 340a34c2db..ff5e7a1619 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -114,7 +114,7 @@ subroutine dumbbell_buoyancy_forcing(state, fluxes, day, dt, G, CS) enddo ; enddo else ! This is the buoyancy only mode. do j=js,je ; do i=is,ie - ! fluxes%buoy is the buoyancy flux into the ocean in m2 s-3. A positive + ! fluxes%buoy is the buoyancy flux into the ocean [m2 s-3]. A positive ! buoyancy flux is of the same sign as heating the ocean. fluxes%buoy(i,j) = 0.0 * G%mask2dT(i,j) enddo ; enddo diff --git a/src/user/lock_exchange_initialization.F90 b/src/user/lock_exchange_initialization.F90 index 064d5465bd..c442f63891 100644 --- a/src/user/lock_exchange_initialization.F90 +++ b/src/user/lock_exchange_initialization.F90 @@ -34,12 +34,11 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, US, param_file, just_rea logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: e0(SZK_(GV)) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: e_pert(SZK_(GV)) ! Interface height perturbations, positive ! - ! upward, in m. ! - real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(GV)) ! The resting interface heights [Z ~> m], usually + ! negative because it is positive upward. + real :: e_pert(SZK_(GV)) ! Interface height perturbations, positive upward [Z ~> m]. + real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface + ! positive upward [Z ~> m]. real :: front_displacement ! Vertical displacement acrodd front real :: thermocline_thickness ! Thickness of stratified region logical :: just_read ! If true, just read parameters but set nothing. From bf1fa4b4bf30e1ba6c3a6a8e9b476de4719e01c0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 29 Jan 2019 13:56:07 -0500 Subject: [PATCH 0989/1072] Documented 288 parameterization variable units Changed comments to use the square bracket notation to document the units of about 288 variables in the parameterization directories, many of them diffusivities, energy budget terms or nondimensional ratios. Only comments have been changed and all answers are bitwise identical. --- src/parameterizations/lateral/MOM_MEKE.F90 | 32 +-- .../lateral/MOM_internal_tides.F90 | 17 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 10 +- .../lateral/MOM_thickness_diffuse.F90 | 80 +++---- .../vertical/MOM_ALE_sponge.F90 | 4 +- .../vertical/MOM_CVMix_KPP.F90 | 209 +++++++++--------- .../vertical/MOM_CVMix_conv.F90 | 24 +- .../vertical/MOM_CVMix_ddiff.F90 | 26 +-- .../vertical/MOM_CVMix_shear.F90 | 8 +- .../vertical/MOM_bkgnd_mixing.F90 | 32 +-- .../vertical/MOM_bulk_mixed_layer.F90 | 18 +- .../vertical/MOM_diabatic_aux.F90 | 10 +- .../vertical/MOM_diabatic_driver.F90 | 16 +- .../vertical/MOM_energetic_PBL.F90 | 30 +-- .../vertical/MOM_entrain_diffusive.F90 | 6 +- .../vertical/MOM_geothermal.F90 | 5 +- .../vertical/MOM_opacity.F90 | 2 +- .../vertical/MOM_set_viscosity.F90 | 2 +- .../vertical/MOM_shortwave_abs.F90 | 16 +- .../vertical/MOM_tidal_mixing.F90 | 68 +++--- .../vertical/MOM_vert_friction.F90 | 2 +- 21 files changed, 312 insertions(+), 305 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 606a234271..21e06ebcef 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -31,40 +31,40 @@ module MOM_MEKE !> Control structure that contains MEKE parameters and diagnostics handles type, public :: MEKE_CS ; private ! Parameters - real :: MEKE_FrCoeff !< Efficiency of conversion of ME into MEKE (non-dim) - real :: MEKE_GMcoeff !< Efficiency of conversion of PE into MEKE (non-dim) + real :: MEKE_FrCoeff !< Efficiency of conversion of ME into MEKE [nondim] + real :: MEKE_GMcoeff !< Efficiency of conversion of PE into MEKE [nondim] real :: MEKE_damping !< Local depth-independent MEKE dissipation rate [s-1]. real :: MEKE_Cd_scale !< The ratio of the bottom eddy velocity to the column mean !! eddy velocity, i.e. sqrt(2*MEKE). This should be less than 1 !! to account for the surface intensification of MEKE. - real :: MEKE_Cb !< Coefficient in the \f$\gamma_{bot}\f$ expression (non-dim) - real :: MEKE_min_gamma!< Minimum value of gamma_b^2 allowed (non-dim) - real :: MEKE_Ct !< Coefficient in the \f$\gamma_{bt}\f$ expression (non-dim) + real :: MEKE_Cb !< Coefficient in the \f$\gamma_{bot}\f$ expression [nondim] + real :: MEKE_min_gamma!< Minimum value of gamma_b^2 allowed [nondim] + real :: MEKE_Ct !< Coefficient in the \f$\gamma_{bt}\f$ expression [nondim] logical :: visc_drag !< If true use the vertvisc_type to calculate bottom drag. logical :: Rd_as_max_scale !< If true the length scale can not exceed the !! first baroclinic deformation radius. logical :: use_old_lscale !< Use the old formula for mixing length scale. - real :: cdrag !< The bottom drag coefficient for MEKE (non-dim). + real :: cdrag !< The bottom drag coefficient for MEKE [nondim]. real :: MEKE_BGsrc !< Background energy source for MEKE [W kg-1] (= m2 s-3). - real :: MEKE_dtScale !< Scale factor to accelerate time-stepping (non-dim.) - real :: MEKE_KhCoeff !< Scaling factor to convert MEKE into Kh (non-dim.) + real :: MEKE_dtScale !< Scale factor to accelerate time-stepping [nondim] + real :: MEKE_KhCoeff !< Scaling factor to convert MEKE into Kh [nondim] real :: MEKE_Uscale !< MEKE velocity scale for bottom drag [m s-1] real :: MEKE_KH !< Background lateral diffusion of MEKE [m2 s-1] real :: MEKE_K4 !< Background bi-harmonic diffusivity (of MEKE) [m4 s-1] real :: KhMEKE_Fac !< A factor relating MEKE%Kh to the diffusivity used for - !! MEKE itself (nondimensional). + !! MEKE itself [nondim]. real :: viscosity_coeff !< The scaling coefficient in the expression for !! viscosity used to parameterize lateral momentum mixing !! by unresolved eddies represented by MEKE. real :: Lfixed !< Fixed mixing length scale [m]. - real :: aDeform !< Weighting towards deformation scale of mixing length (non-dim.) - real :: aRhines !< Weighting towards Rhines scale of mixing length (non-dim.) - real :: aFrict !< Weighting towards frictional arrest scale of mixing length (non-dim.) - real :: aEady !< Weighting towards Eady scale of mixing length (non-dim.) - real :: aGrid !< Weighting towards grid scale of mixing length (non-dim.) - real :: MEKE_advection_factor !< A scaling in front of the advection of MEKE (non-dim.) + real :: aDeform !< Weighting towards deformation scale of mixing length [nondim] + real :: aRhines !< Weighting towards Rhines scale of mixing length [nondim] + real :: aFrict !< Weighting towards frictional arrest scale of mixing length [nondim] + real :: aEady !< Weighting towards Eady scale of mixing length [nondim] + real :: aGrid !< Weighting towards grid scale of mixing length [nondim] + real :: MEKE_advection_factor !< A scaling in front of the advection of MEKE [nondim] real :: MEKE_topographic_beta !< Weight for how much topographic beta is considered - !! when computing beta in Rhines scale (non-dim.) + !! when computing beta in Rhines scale [nondim] logical :: initialize !< If True, invokes a steady state solver to calculate MEKE. logical :: debug !< If true, write out checksums of data for debugging diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index c9341a061a..4052f948a3 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -87,13 +87,13 @@ module MOM_internal_tides !! summed over angle, frequency and mode [W m-2] real, allocatable, dimension(:,:) :: tot_allprocesses_loss !< Energy loss rates due to all processes, !! summed over angle, frequency and mode [W m-2] - real :: q_itides !< fraction of local dissipation (nondimensional) + real :: q_itides !< fraction of local dissipation [nondim] real :: En_sum !< global sum of energy for use in debugging type(time_type), pointer :: Time => NULL() !< A pointer to the model's clock. character(len=200) :: inputdir !< directory to look for coastline angle file real :: decay_rate !< A constant rate at which internal tide energy is !! lost to the interior ocean internal wave field. - real :: cdrag !< The bottom drag coefficient (non-dim). + real :: cdrag !< The bottom drag coefficient [nondim]. logical :: apply_background_drag !< If true, apply a drag due to background processes as a sink. logical :: apply_bottom_drag @@ -632,7 +632,7 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, intent(inout) :: Ub !< RMS (over one period) near-bottom horizontal !! mode velocity [m s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: TKE_loss_fixed !< Fixed part of energy loss [kg Z-2 ~> kg m-2] + intent(in) :: TKE_loss_fixed !< Fixed part of energy loss [kg Z-2 ~> kg m-2] !! (rho*kappa*h^2). real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle,CS%nFreq,CS%nMode), & intent(inout) :: En !< Energy density of the internal waves [J m-2]. @@ -1358,12 +1358,12 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) real, dimension(SZI_(G),SZJ_(G)) :: & EnL, EnR ! Left and right face energy densities [J m-2]. real, dimension(SZIB_(G),SZJ_(G)) :: & - flux_x ! The internal wave energy flux, in J s-1. + flux_x ! The internal wave energy flux [J s-1]. real, dimension(SZIB_(G)) :: & cg_p, cg_m, flux1, flux2 !real, dimension(SZI_(G),SZJB_(G),Nangle) :: En_m, En_p real, dimension(SZI_(G),SZJB_(G),Nangle) :: & - Fdt_m, Fdt_p! Left and right energy fluxes, in J + Fdt_m, Fdt_p! Left and right energy fluxes [J] integer :: i, j, k, ish, ieh, jsh, jeh, a ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh @@ -1441,12 +1441,12 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) real, dimension(SZI_(G),SZJ_(G)) :: & EnL, EnR ! South and north face energy densities [J m-2]. real, dimension(SZI_(G),SZJB_(G)) :: & - flux_y ! The internal wave energy flux, in J s-1. + flux_y ! The internal wave energy flux [J s-1]. real, dimension(SZI_(G)) :: & cg_p, cg_m, flux1, flux2 !real, dimension(SZI_(G),SZJB_(G),Nangle) :: En_m, En_p real, dimension(SZI_(G),SZJB_(G),Nangle) :: & - Fdt_m, Fdt_p! South and north energy fluxes, in J + Fdt_m, Fdt_p! South and north energy fluxes [J] character(len=160) :: mesg ! The text of an error message integer :: i, j, k, ish, ieh, jsh, jeh, a @@ -1562,8 +1562,7 @@ subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, J, ish, ieh, vol_CFL) !! reconstruction [J m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hR !< Right- Energy densities in the !! reconstruction [J m-2]. - real, dimension(SZI_(G)), intent(inout) :: vh !< The meridional energy transport, - !! in J s-1. + real, dimension(SZI_(G)), intent(inout) :: vh !< The meridional energy transport [J s-1]. real, intent(in) :: dt !< Time increment [s]. integer, intent(in) :: J !< The j-index to work on. integer, intent(in) :: ish !< The start i-index range to work on. diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index b1714e174d..3f250bc935 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -108,7 +108,7 @@ module MOM_lateral_mixing_coeffs integer :: Res_fn_power_visc !< The power of dx/Ld in the Kh resolution function. Any !! positive integer power may be used, but even powers !! and especially 2 are coded to be more efficient. - real :: Visbeck_S_max !< Upper bound on slope used in Eady growth rate (nondim). + real :: Visbeck_S_max !< Upper bound on slope used in Eady growth rate [nondim]. ! Diagnostics !>@{ @@ -174,7 +174,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) endif ! Calculate and store the ratio between deformation radius and grid-spacing - ! at h-points (non-dimensional). + ! at h-points [nondim]. if (CS%calculate_rd_dx) then if (.not. associated(CS%Rd_dx_h)) call MOM_error(FATAL, & "calc_resoln_function: %Rd_dx_h is not associated with calculate_rd_dx.") @@ -578,12 +578,12 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(VarMix_CS), pointer :: CS !< Variable mixing coefficients - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface position (m) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface position [Z ~> m] logical, intent(in) :: calculate_slopes !< If true, calculate slopes internally !! otherwise use slopes stored in CS ! Local variables - real :: E_x(SZIB_(G), SZJ_(G)) ! X-slope of interface at u points (for diagnostics) - real :: E_y(SZI_(G), SZJB_(G)) ! Y-slope of interface at v points (for diagnostics) + real :: E_x(SZIB_(G), SZJ_(G)) ! X-slope of interface at u points [nondim] (for diagnostics) + real :: E_y(SZI_(G), SZJB_(G)) ! Y-slope of interface at v points [nondim] (for diagnostics) real :: H_cutoff ! Local estimate of a minimum thickness for masking [H ~> m or kg m-2] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 94c02cf2b4..802e26a404 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -32,36 +32,36 @@ module MOM_thickness_diffuse !> Control structure for thickness diffusion type, public :: thickness_diffuse_CS ; private - real :: Khth !< Background interface depth diffusivity (m2 s-1) - real :: Khth_Slope_Cff !< Slope dependence coefficient of Khth (m2 s-1) + real :: Khth !< Background interface depth diffusivity [m2 s-1] + real :: Khth_Slope_Cff !< Slope dependence coefficient of Khth [m2 s-1] real :: max_Khth_CFL !< Maximum value of the diffusive CFL for thickness diffusion - real :: Khth_Min !< Minimum value of Khth (m2 s-1) - real :: Khth_Max !< Maximum value of Khth (m2 s-1), or 0 for no max - real :: slope_max !< Slopes steeper than slope_max are limited in some way. + real :: Khth_Min !< Minimum value of Khth [m2 s-1] + real :: Khth_Max !< Maximum value of Khth [m2 s-1], or 0 for no max + real :: slope_max !< Slopes steeper than slope_max are limited in some way [nondim]. real :: kappa_smooth !< Vertical diffusivity used to interpolate more - !! sensible values of T & S into thin layers. + !! sensible values of T & S into thin layers [Z2 s-1 ~> m2 s-1]. logical :: thickness_diffuse !< If true, interfaces heights are diffused. logical :: use_FGNV_streamfn !< If true, use the streamfunction formulation of !! Ferrari et al., 2010, which effectively emphasizes !! graver vertical modes by smoothing in the vertical. real :: FGNV_scale !< A coefficient scaling the vertical smoothing term in the - !! Ferrari et al., 2010, streamfunction formulation. + !! Ferrari et al., 2010, streamfunction formulation [nondim]. real :: FGNV_c_min !< A minimum wave speed used in the Ferrari et al., 2010, !! streamfunction formulation [m s-1]. real :: N2_floor !< A floor for Brunt-Vasaila frequency in the Ferrari et al., 2010, - !! streamfunction formulation (s-2). + !! streamfunction formulation [s-2]. logical :: detangle_interfaces !< If true, add 3-d structured interface height !! diffusivities to horizontally smooth jagged layers. real :: detangle_time !< If detangle_interfaces is true, this is the !! timescale over which maximally jagged grid-scale - !! thickness variations are suppressed. This must be + !! thickness variations are suppressed [s]. This must be !! longer than DT, or 0 (the default) to use DT. integer :: nkml !< number of layers within mixed layer logical :: debug !< write verbose checksums for debugging purposes type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics - real, pointer :: GMwork(:,:) => NULL() !< Work by thickness diffusivity (W m-2) - real, pointer :: diagSlopeX(:,:,:) => NULL() !< Diagnostic: zonal neutral slope (nondim) - real, pointer :: diagSlopeY(:,:,:) => NULL() !< Diagnostic: zonal neutral slope (nondim) + real, pointer :: GMwork(:,:) => NULL() !< Work by thickness diffusivity [W m-2] + real, pointer :: diagSlopeX(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [nondim] + real, pointer :: diagSlopeY(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [nondim] !>@{ !! Diagnostic identifier @@ -83,10 +83,12 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux (m2 H) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux (m2 H) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux + !! [m2 H ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux + !! [m2 H ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, intent(in) :: dt !< Time increment (s) + real, intent(in) :: dt !< Time increment [s] type(MEKE_type), pointer :: MEKE !< MEKE control structure type(VarMix_CS), pointer :: VarMix !< Variable mixing coefficients type(cont_diag_ptrs), intent(inout) :: CDp !< Diagnostics for the continuity equation @@ -94,30 +96,30 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp ! Local variables real :: e(SZI_(G), SZJ_(G), SZK_(G)+1) ! heights of interfaces, relative to mean ! sea level [Z ~> m], positive up. - real :: uhD(SZIB_(G), SZJ_(G), SZK_(G)) ! uhD & vhD are the diffusive u*h & - real :: vhD(SZI_(G), SZJB_(G), SZK_(G)) ! v*h fluxes (m2 H s-1) + real :: uhD(SZIB_(G), SZJ_(G), SZK_(G)) ! Diffusive u*h fluxes [m2 H s-1 ~> m3 s-1 or kg s-1] + real :: vhD(SZI_(G), SZJB_(G), SZK_(G)) ! Diffusive v*h fluxes [m2 H s-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: & - KH_u, & ! interface height diffusivities in u-columns (m2 s-1) + KH_u, & ! interface height diffusivities in u-columns [m2 s-1] int_slope_u ! A nondimensional ratio from 0 to 1 that gives the relative ! weighting of the interface slopes to that calculated also ! using density gradients at u points. The physically correct ! slopes occur at 0, while 1 is used for numerical closures. real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: & - KH_v, & ! interface height diffusivities in v-columns (m2 s-1) + KH_v, & ! interface height diffusivities in v-columns [m2 s-1] int_slope_v ! A nondimensional ratio from 0 to 1 that gives the relative ! weighting of the interface slopes to that calculated also ! using density gradients at v points. The physically correct ! slopes occur at 0, while 1 is used for numerical closures. real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & - KH_t ! diagnosed diffusivity at tracer points (m^2/s) + KH_t ! diagnosed diffusivity at tracer points [m2 s-1] real, dimension(SZIB_(G), SZJ_(G)) :: & - KH_u_CFL ! The maximum stable interface height diffusivity at u grid points (m2 s-1) + KH_u_CFL ! The maximum stable interface height diffusivity at u grid points [m2 s-1] real, dimension(SZI_(G), SZJB_(G)) :: & - KH_v_CFL ! The maximum stable interface height diffusivity at v grid points (m2 s-1) + KH_v_CFL ! The maximum stable interface height diffusivity at v grid points [m2 s-1] real :: Khth_Loc_u(SZIB_(G), SZJ_(G)) - real :: Khth_Loc(SZIB_(G), SZJB_(G)) ! locally calculated thickness diffusivity (m2/s) + real :: Khth_Loc(SZIB_(G), SZJB_(G)) ! locally calculated thickness diffusivity [m2 s-1] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real, dimension(:,:), pointer :: cg1 => null() !< Wave speed [m s-1] @@ -125,8 +127,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp integer :: i, j, k, is, ie, js, je, nz real :: hu(SZI_(G), SZJ_(G)) ! u-thickness [H ~> m or kg m-2] real :: hv(SZI_(G), SZJ_(G)) ! v-thickness [H ~> m or kg m-2] - real :: KH_u_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities (m2/sec) - real :: KH_v_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities (m2/sec) + real :: KH_u_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [m2 s-1] + real :: KH_v_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [m2 s-1] if (.not. associated(CS)) call MOM_error(FATAL, "MOM_thickness_diffuse:"// & "Module must be initialized before it is used.") @@ -708,7 +710,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV endif if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope - ! Estimate the streamfunction at each interface (m3 s-1). + ! Estimate the streamfunction at each interface [m3 s-1]. Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*US%m_to_Z*Slope) ! Avoid moving dense water upslope from below the level of @@ -954,7 +956,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV endif if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope - ! Estimate the streamfunction at each interface (m3 s-1). + ! Estimate the streamfunction at each interface [m3 s-1]. Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*US%m_to_Z*Slope) ! Avoid moving dense water upslope from below the level of @@ -1164,7 +1166,7 @@ subroutine streamfn_solver(nk, c2_h, hN2, sfn) integer, intent(in) :: nk !< Number of layers real, dimension(nk), intent(in) :: c2_h !< Wave speed squared over thickness in layers [m s-2] real, dimension(nk+1), intent(in) :: hN2 !< Thickness times N2 at interfaces [m s-2] - real, dimension(nk+1), intent(inout) :: sfn !< Streamfunction (Z m2 s-1 or arbitrary units) + real, dimension(nk+1), intent(inout) :: sfn !< Streamfunction [Z m2 s-1 ~> m3 s-1] or arbitrary units !! On entry, equals diffusivity times slope. !! On exit, equals the streamfunction. ! Local variables @@ -1201,15 +1203,15 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions [Z ~> m] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kh_u !< Thickness diffusivity on interfaces - !! at u points (m2/s) + !! at u points [m2 s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: Kh_v !< Thickness diffusivity on interfaces - !! at v points (m2/s) + !! at v points [m2 s-1] real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Kh_u_CFL !< Maximum stable thickness diffusivity - !! at u points (m2/s) + !! at u points [m2 s-1] real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Kh_v_CFL !< Maximum stable thickness diffusivity - !! at v points (m2/s) + !! at v points [m2 s-1] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, intent(in) :: dt !< Time increment (s) + real, intent(in) :: dt !< Time increment [s] type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: int_slope_u !< Ratio that determine how much of !! the isopycnal slopes are taken directly from the @@ -1617,12 +1619,12 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Input temperature (C) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Input salinity (ppt) - real, intent(in) :: kappa !< Constant diffusivity to use (Z2/s) - real, intent(in) :: dt !< Time increment (s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature (C) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filled salinity (ppt) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Input temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Input salinity [ppt] + real, intent(in) :: kappa !< Constant diffusivity to use [Z2 s-1 ~> m2 s-1] + real, intent(in) :: dt !< Time increment [s] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filled salinity [ppt] integer, optional, intent(in) :: halo_here !< Number of halo points to work on, !! 0 by default ! Local variables diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 815e132846..7678a4b799 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -852,8 +852,8 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) !! that is set by a previous call to initialize_sponge (in). type(time_type), optional, intent(in) :: Time !< The current model date - real :: damp ! The timestep times the local damping coefficient. ND. - real :: I1pdamp ! I1pdamp is 1/(1 + damp). Nondimensional. + real :: damp ! The timestep times the local damping coefficient [nondim]. + real :: I1pdamp ! I1pdamp is 1/(1 + damp). [nondim]. real :: Idt ! 1.0/dt [s-1]. real :: m_to_Z ! A unit conversion factor from m to Z. real, allocatable, dimension(:) :: tmp_val2 ! data values on the original grid diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 212a9390b9..ef0e9504ac 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -80,10 +80,10 @@ module MOM_CVMix_KPP logical :: computeMoninObukhov !< If True, compute Monin-Obukhov limit for OBLdepth logical :: passiveMode !< If True, makes KPP passive meaning it does NOT alter the diffusivity real :: deepOBLoffset !< If non-zero, is a distance from the bottom that the OBL can not - !! penetrate through (m) - real :: minOBLdepth !< If non-zero, is a minimum depth for the OBL (m) - real :: surf_layer_ext !< Fraction of OBL depth considered in the surface layer (nondim) - real :: minVtsqr !< Min for the squared unresolved velocity used in Rib CVMix calculation (m2/s2) + !! penetrate through [m] + real :: minOBLdepth !< If non-zero, is a minimum depth for the OBL [m] + real :: surf_layer_ext !< Fraction of OBL depth considered in the surface layer [nondim] + real :: minVtsqr !< Min for the squared unresolved velocity used in Rib CVMix calculation [m2 s-2] logical :: fixedOBLdepth !< If True, will fix the OBL depth at fixedOBLdepth_value real :: fixedOBLdepth_value !< value for the fixed OBL depth when fixedOBLdepth==True. logical :: debug !< If True, calculate checksums and write debugging information @@ -101,7 +101,7 @@ module MOM_CVMix_KPP !! in the vicinity of vanished layers. ! smg: obsolete below logical :: correctSurfLayerAvg !< If true, applies a correction to the averaging of surface layer properties - real :: surfLayerDepth !< A guess at the depth of the surface layer (which should 0.1 of OBLdepth) (m) + real :: surfLayerDepth !< A guess at the depth of the surface layer (which should 0.1 of OBLdepth) [m] ! smg: obsolete above integer :: SW_METHOD !< Sets method for using shortwave radiation in surface buoyancy flux logical :: LT_K_Enhancement !< Flags if enhancing mixing coefficients due to LT @@ -143,23 +143,23 @@ module MOM_CVMix_KPP !!@} ! Diagnostics arrays - real, allocatable, dimension(:,:) :: OBLdepth !< Depth (positive) of OBL (m) - real, allocatable, dimension(:,:) :: OBLdepth_original !< Depth (positive) of OBL (m) without smoothing + real, allocatable, dimension(:,:) :: OBLdepth !< Depth (positive) of OBL [m] + real, allocatable, dimension(:,:) :: OBLdepth_original !< Depth (positive) of OBL [m] without smoothing real, allocatable, dimension(:,:) :: kOBL !< Level (+fraction) of OBL extent - real, allocatable, dimension(:,:) :: OBLdepthprev !< previous Depth (positive) of OBL (m) - real, allocatable, dimension(:,:,:) :: dRho !< Bulk difference in density (kg/m3) - real, allocatable, dimension(:,:,:) :: Uz2 !< Square of bulk difference in resolved velocity (m2/s2) + real, allocatable, dimension(:,:) :: OBLdepthprev !< previous Depth (positive) of OBL [m] + real, allocatable, dimension(:,:,:) :: dRho !< Bulk difference in density [kg m-3] + real, allocatable, dimension(:,:,:) :: Uz2 !< Square of bulk difference in resolved velocity [m2 s-2] real, allocatable, dimension(:,:,:) :: BulkRi !< Bulk Richardson number for each layer (dimensionless) real, allocatable, dimension(:,:,:) :: sigma !< Sigma coordinate (dimensionless) real, allocatable, dimension(:,:,:) :: Ws !< Turbulent velocity scale for scalars [m s-1] real, allocatable, dimension(:,:,:) :: N !< Brunt-Vaisala frequency [s-1] - real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency (1/s2) - real, allocatable, dimension(:,:,:) :: Vt2 !< Unresolved squared turbulence velocity for bulk Ri (m2/s2) - real, allocatable, dimension(:,:,:) :: Kt_KPP !< Temp diffusivity from KPP (m2/s) - real, allocatable, dimension(:,:,:) :: Ks_KPP !< Scalar diffusivity from KPP (m2/s) - real, allocatable, dimension(:,:,:) :: Kv_KPP !< Viscosity due to KPP (m2/s) - real, allocatable, dimension(:,:) :: Tsurf !< Temperature of surface layer (C) - real, allocatable, dimension(:,:) :: Ssurf !< Salinity of surface layer (ppt) + real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency [s-2] + real, allocatable, dimension(:,:,:) :: Vt2 !< Unresolved squared turbulence velocity for bulk Ri [m2 s-2] + real, allocatable, dimension(:,:,:) :: Kt_KPP !< Temp diffusivity from KPP [m2 s-1] + real, allocatable, dimension(:,:,:) :: Ks_KPP !< Scalar diffusivity from KPP [m2 s-1] + real, allocatable, dimension(:,:,:) :: Kv_KPP !< Viscosity due to KPP [m2 s-1] + real, allocatable, dimension(:,:) :: Tsurf !< Temperature of surface layer [degC] + real, allocatable, dimension(:,:) :: Ssurf !< Salinity of surface layer [ppt] real, allocatable, dimension(:,:) :: Usurf !< i-velocity of surface layer [m s-1] real, allocatable, dimension(:,:) :: Vsurf !< j-velocity of surface layer [m s-1] real, allocatable, dimension(:,:,:) :: EnhK !< Enhancement for mixing coefficient @@ -586,30 +586,33 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (Z/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux (m2/s3) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP (Z2/s) - !< (out) Vertical diffusivity including KPP (Z2/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP (Z2/s) - !< (out) Vertical diffusivity including KPP (Z2/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP (Z2/s) - !< (out) Vertical viscosity including KPP (Z2/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity [Z s-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [m2 s-3] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP + !! (out) Vertical diffusivity including KPP + !! [Z2 s-1 ~> m2 s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP + !! (out) Vertical diffusivity including KPP + !! [Z2 s-1 ~> m2 s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP + !! (out) Vertical viscosity including KPP + !! [Z2 s-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport [m s-1] ! Local variables integer :: i, j, k ! Loop indices - real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) - real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) - real, dimension( G%ke+1, 2) :: Kdiffusivity ! Vertical diffusivity at interfaces (m2/s) - real, dimension( G%ke+1 ) :: Kviscosity ! Vertical viscosity at interfaces (m2/s) - real, dimension( G%ke+1, 2) :: nonLocalTrans ! Non-local transport for heat/salt at interfaces (non-dimensional) + real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface [m] (negative in ocean) + real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [m] (negative in ocean) + real, dimension( G%ke+1, 2) :: Kdiffusivity ! Vertical diffusivity at interfaces [m2 s-1] + real, dimension( G%ke+1 ) :: Kviscosity ! Vertical viscosity at interfaces [m2 s-1] + real, dimension( G%ke+1, 2) :: nonLocalTrans ! Non-local transport for heat/salt at interfaces [nondim] real :: surfFricVel, surfBuoyFlux real :: sigma, sigmaRatio - real :: dh ! The local thickness used for calculating interface positions (m) - real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) + real :: dh ! The local thickness used for calculating interface positions [m] + real :: hcorr ! A cumulative correction arising from inflation of vanished layers [m] ! For Langmuir Calculations real :: LangEnhK ! Langmuir enhancement for mixing coefficient @@ -674,28 +677,28 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & ! If option "MatchBoth" is selected in CVMix, MOM should be capable of matching. if (.not. (CS%MatchTechnique == 'MatchBoth')) then - Kdiffusivity(:,:) = 0. ! Diffusivities for heat and salt (m2/s) - Kviscosity(:) = 0. ! Viscosity (m2/s) + Kdiffusivity(:,:) = 0. ! Diffusivities for heat and salt [m2 s-1] + Kviscosity(:) = 0. ! Viscosity [m2 s-1] else Kdiffusivity(:,1) = US%Z_to_m**2 * Kt(i,j,:) Kdiffusivity(:,2) = US%Z_to_m**2 * Ks(i,j,:) Kviscosity(:) = US%Z_to_m**2 * Kv(i,j,:) endif - call CVMix_coeffs_kpp(Kviscosity(:), & ! (inout) Total viscosity (m2/s) - Kdiffusivity(:,1), & ! (inout) Total heat diffusivity (m2/s) - Kdiffusivity(:,2), & ! (inout) Total salt diffusivity (m2/s) - iFaceHeight, & ! (in) Height of interfaces (m) - cellHeight, & ! (in) Height of level centers (m) - Kviscosity(:), & ! (in) Original viscosity (m2/s) - Kdiffusivity(:,1), & ! (in) Original heat diffusivity (m2/s) - Kdiffusivity(:,2), & ! (in) Original salt diffusivity (m2/s) - CS%OBLdepth(i,j), & ! (in) OBL depth (m) + call CVMix_coeffs_kpp(Kviscosity(:), & ! (inout) Total viscosity [m2 s-1] + Kdiffusivity(:,1), & ! (inout) Total heat diffusivity [m2 s-1] + Kdiffusivity(:,2), & ! (inout) Total salt diffusivity [m2 s-1] + iFaceHeight, & ! (in) Height of interfaces [m] + cellHeight, & ! (in) Height of level centers [m] + Kviscosity(:), & ! (in) Original viscosity [m2 s-1] + Kdiffusivity(:,1), & ! (in) Original heat diffusivity [m2 s-1] + Kdiffusivity(:,2), & ! (in) Original salt diffusivity [m2 s-1] + CS%OBLdepth(i,j), & ! (in) OBL depth [m] CS%kOBL(i,j), & ! (in) level (+fraction) of OBL extent - nonLocalTrans(:,1),& ! (out) Non-local heat transport (non-dimensional) - nonLocalTrans(:,2),& ! (out) Non-local salt transport (non-dimensional) + nonLocalTrans(:,1),& ! (out) Non-local heat transport [nondim] + nonLocalTrans(:,2),& ! (out) Non-local salt transport [nondim] surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] - surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) + surfBuoyFlux, & ! (in) Buoyancy flux at surface [m2 s-3] G%ke, & ! (in) Number of levels to compute coeffs for G%ke, & ! (in) Number of levels in array shape CVMix_kpp_params_user=CS%KPP_params ) @@ -801,7 +804,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & !BGR Now computing VT2 above so can modify for LT ! therefore, don't repeat this operation here ! CS%Vt2(i,j,:) = CVmix_kpp_compute_unresolved_shear( & -! cellHeight(1:G%ke), & ! Depth of cell center (m) +! cellHeight(1:G%ke), & ! Depth of cell center [m] ! ws_cntr=Ws_1d, & ! Turbulent velocity scale profile, at centers [m s-1] ! N_iface=CS%N(i,j,:), & ! Buoyancy frequency at interface [s-1] ! CVmix_kpp_params_user=CS%KPP_params ) ! KPP parameters @@ -876,24 +879,24 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF type(ocean_grid_type), intent(inout) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< potential/cons temp (deg C) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< Salinity (ppt) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< potential/cons temp [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< Salinity [ppt] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Velocity i-component [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Velocity j-component [m s-1] type(EOS_type), pointer :: EOS !< Equation of state - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (Z/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux (m2/s3) + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity [Z s-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [m2 s-3] type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS ! Local variables integer :: i, j, k, km1 ! Loop indices - real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) - real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) - real, dimension( G%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces (1/s2) + real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface [m] (negative in ocean) + real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [m] (negative in ocean) + real, dimension( G%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces [s-2] real, dimension( G%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars [m s-1] real, dimension( G%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number - real, dimension( G%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri (m2/s2) + real, dimension( G%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri [m2 s-2] real, dimension( G%ke ) :: surfBuoyFlux2 real, dimension( G%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer @@ -906,16 +909,16 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF real :: surfFricVel, surfBuoyFlux, Coriolis real :: GoRho, pRef, rho1, rhoK, Uk, Vk, sigma, sigmaRatio - real :: zBottomMinusOffset ! Height of bottom plus a little bit (m) + real :: zBottomMinusOffset ! Height of bottom plus a little bit [m] real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth. - real :: hTot ! Running sum of thickness used in the surface layer average (m) - real :: delH ! Thickness of a layer (m) + real :: hTot ! Running sum of thickness used in the surface layer average [m] + real :: delH ! Thickness of a layer [m] real :: surfHtemp, surfTemp ! Integral and average of temp over the surface layer real :: surfHsalt, surfSalt ! Integral and average of saln over the surface layer real :: surfHu, surfU ! Integral and average of u over the surface layer real :: surfHv, surfV ! Integral and average of v over the surface layer - real :: dh ! The local thickness used for calculating interface positions (m) - real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) + real :: dh ! The local thickness used for calculating interface positions [m] + real :: hcorr ! A cumulative correction arising from inflation of vanished layers [m] integer :: kk, ksfc, ktmp ! For Langmuir Calculations @@ -1101,15 +1104,15 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! sigma=CS%surf_layer_ext for this calculation. call CVMix_kpp_compute_turbulent_scales( & CS%surf_layer_ext, & ! (in) Normalized surface layer depth; sigma = CS%surf_layer_ext - -cellHeight, & ! (in) Assume here that OBL depth (m) = -cellHeight(k) - surfBuoyFlux2, & ! (in) Buoyancy flux at surface (m2/s3) + -cellHeight, & ! (in) Assume here that OBL depth [m] = -cellHeight(k) + surfBuoyFlux2, & ! (in) Buoyancy flux at surface [m2 s-3] surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] w_s=Ws_1d, & ! (out) Turbulent velocity scale profile [m s-1] CVMix_kpp_params_user=CS%KPP_params ) !Compute CVMix VT2 CS%Vt2(i,j,:) = CVmix_kpp_compute_unresolved_shear( & - zt_cntr=cellHeight(1:G%ke), & ! Depth of cell center (m) + zt_cntr=cellHeight(1:G%ke), & ! Depth of cell center [m] ws_cntr=Ws_1d, & ! Turbulent velocity scale profile, at centers [m s-1] N_iface=CS%N(i,j,:), & ! Buoyancy frequency at interface [s-1] CVmix_kpp_params_user=CS%KPP_params ) ! KPP parameters @@ -1157,9 +1160,9 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! Calculate Bulk Richardson number from eq (21) of LMD94 BulkRi_1d = CVmix_kpp_compute_bulk_Richardson( & - zt_cntr = cellHeight(1:G%ke), & ! Depth of cell center (m) + zt_cntr = cellHeight(1:G%ke), & ! Depth of cell center [m] delta_buoy_cntr=GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) [s-1] - delta_Vsqr_cntr=deltaU2, & ! Square of resolved velocity difference (m2/s2) + delta_Vsqr_cntr=deltaU2, & ! Square of resolved velocity difference [m2 s-2] Vt_sqr_cntr=CS%Vt2(i,j,:), & ws_cntr=Ws_1d, & ! Turbulent velocity scale profile [m s-1] N_iface=CS%N(i,j,:)) ! Buoyancy frequency [s-1] @@ -1170,12 +1173,12 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF call CVMix_kpp_compute_OBL_depth( & BulkRi_1d, & ! (in) Bulk Richardson number - iFaceHeight, & ! (in) Height of interfaces (m) - CS%OBLdepth(i,j), & ! (out) OBL depth (m) + iFaceHeight, & ! (in) Height of interfaces [m] + CS%OBLdepth(i,j), & ! (out) OBL depth [m] CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent - zt_cntr=cellHeight, & ! (in) Height of cell centers (m) + zt_cntr=cellHeight, & ! (in) Height of cell centers [m] surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] - surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) + surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface [m2 s-3] Coriolis=Coriolis, & ! (in) Coriolis parameter [s-1] CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters @@ -1236,9 +1239,9 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! enddo ! BulkRi_1d = CVMix_kpp_compute_bulk_Richardson( & - ! cellHeight(1:G%ke), & ! Depth of cell center (m) + ! cellHeight(1:G%ke), & ! Depth of cell center [m] ! GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) [s-1] - ! deltaU2, & ! Square of resolved velocity difference (m2/s2) + ! deltaU2, & ! Square of resolved velocity difference [m2 s-2] ! ws_cntr=Ws_1d, & ! Turbulent velocity scale profile [m s-1] ! N_iface=CS%N ) ! Buoyancy frequency [s-1] @@ -1247,12 +1250,12 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! call CVMix_kpp_compute_OBL_depth( & ! BulkRi_1d, & ! (in) Bulk Richardson number - ! iFaceHeight, & ! (in) Height of interfaces (m) - ! CS%OBLdepth(i,j), & ! (out) OBL depth (m) + ! iFaceHeight, & ! (in) Height of interfaces [m] + ! CS%OBLdepth(i,j), & ! (out) OBL depth [m] ! CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent - ! zt_cntr=cellHeight, & ! (in) Height of cell centers (m) + ! zt_cntr=cellHeight, & ! (in) Height of cell centers [m] ! surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] - ! surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) + ! surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface [m2 s-3] ! Coriolis=Coriolis, & ! (in) Coriolis parameter [s-1] ! CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters @@ -1278,8 +1281,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF if (CS%id_Ws > 0) then call CVMix_kpp_compute_turbulent_scales( & -CellHeight/CS%OBLdepth(i,j), & ! (in) Normalized boundary layer coordinate - CS%OBLdepth(i,j), & ! (in) OBL depth (m) - surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) + CS%OBLdepth(i,j), & ! (in) OBL depth [m] + surfBuoyFlux, & ! (in) Buoyancy flux at surface [m2 s-3] surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] w_s=Ws_1d, & ! (out) Turbulent velocity scale profile [m s-1] CVMix_kpp_params_user=CS%KPP_params) ! KPP parameters @@ -1326,20 +1329,20 @@ end subroutine KPP_compute_BLD !> Apply a 1-1-4-1-1 Laplacian filter one time on BLD to reduce any horizontal two-grid-point noise subroutine KPP_smooth_BLD(CS,G,GV,h) ! Arguments - type(KPP_CS), pointer :: CS !< Control structure - type(ocean_grid_type), intent(inout) :: G !< Ocean grid - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) + type(KPP_CS), pointer :: CS !< Control structure + type(ocean_grid_type), intent(inout) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] ! local real, dimension(SZI_(G),SZJ_(G)) :: OBLdepth_original ! Original OBL depths computed by CVMix - real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) + real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface [m] ! (negative in the ocean) - real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) + real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [m] ! (negative in the ocean) real :: wc, ww, we, wn, ws ! averaging weights for smoothing - real :: dh ! The local thickness used for calculating interface positions (m) - real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) + real :: dh ! The local thickness used for calculating interface positions [m] + real :: hcorr ! A cumulative correction arising from inflation of vanished layers [m] real :: pref integer :: i, j, k, s @@ -1430,7 +1433,7 @@ subroutine KPP_get_BLD(CS, BLD, G) type(KPP_CS), pointer :: CS !< Control structure for !! this module type(ocean_grid_type), intent(in) :: G !< Grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: BLD!< bnd. layer depth (m) + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: BLD!< bnd. layer depth [m] ! Local variables integer :: i,j do j = G%jsc, G%jec ; do i = G%isc, G%iec @@ -1442,15 +1445,16 @@ end subroutine KPP_get_BLD subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, & dt, scalar, C_p) - type(KPP_CS), intent(in) :: CS !< Control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thickness (units of H) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: nonLocalTrans !< Non-local transport (non-dimensional) - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of scalar (H/s * scalar) - real, intent(in) :: dt !< Time-step (s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: scalar !< temperature - real, intent(in) :: C_p !< Seawater specific heat capacity (J/(kg*K)) + type(KPP_CS), intent(in) :: CS !< Control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: nonLocalTrans !< Non-local transport [nondim] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of scalar + !! [conc H s-1 ~> conc m s-1 or conc kg m-2 s-1] + real, intent(in) :: dt !< Time-step [s] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: scalar !< temperature + real, intent(in) :: C_p !< Seawater specific heat capacity [J kg-1 degC-1] integer :: i, j, k real, dimension( SZI_(G), SZJ_(G), SZK_(G) ) :: dtracer @@ -1504,11 +1508,12 @@ subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, type(KPP_CS), intent(in) :: CS !< Control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thickness (units of H) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: nonLocalTrans !< Non-local transport (non-dimensional) - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of scalar (H/s * scalar) - real, intent(in) :: dt !< Time-step (s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: scalar !< Scalar (scalar units) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: nonLocalTrans !< Non-local transport [nondim] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of scalar + !! [conc H s-1 ~> conc m s-1 or conc kg m-2 s-1] + real, intent(in) :: dt !< Time-step [s] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: scalar !< Scalar (scalar units [conc]) integer :: i, j, k real, dimension( SZI_(G), SZJ_(G), SZK_(G) ) :: dtracer diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 4bb0bd726c..19327cd007 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -27,11 +27,11 @@ module MOM_CVMix_conv type, public :: CVMix_conv_cs ! Parameters - real :: kd_conv_const !< diffusivity constant used in convective regime (m2/s) - real :: kv_conv_const !< viscosity constant used in convective regime (m2/s) + real :: kd_conv_const !< diffusivity constant used in convective regime [m2 s-1] + real :: kv_conv_const !< viscosity constant used in convective regime [m2 s-1] real :: bv_sqr_conv !< Threshold for squared buoyancy frequency - !! needed to trigger Brunt-Vaisala parameterization (1/s^2) - real :: min_thickness !< Minimum thickness allowed (m) + !! needed to trigger Brunt-Vaisala parameterization [s-2] + real :: min_thickness !< Minimum thickness allowed [m] logical :: debug !< If true, turn on debugging ! Daignostic handles and pointers @@ -41,9 +41,9 @@ module MOM_CVMix_conv !!@} ! Diagnostics arrays - real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency (1/s2) - real, allocatable, dimension(:,:,:) :: kd_conv !< Diffusivity added by convection (m2/s) - real, allocatable, dimension(:,:,:) :: kv_conv !< Viscosity added by convection (m2/s) + real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency [s-2] + real, allocatable, dimension(:,:,:) :: kd_conv !< Diffusivity added by convection [m2 s-1] + real, allocatable, dimension(:,:,:) :: kv_conv !< Viscosity added by convection [m2 s-1] end type CVMix_conv_cs @@ -156,17 +156,17 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl) type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. type(CVMix_conv_cs), pointer :: CS !< The control structure returned !! by a previous call to CVMix_conv_init. - real, dimension(:,:), optional, pointer :: hbl!< Depth of ocean boundary layer (m) + real, dimension(:,:), optional, pointer :: hbl!< Depth of ocean boundary layer [m] ! local variables real, dimension(SZK_(G)) :: rho_lwr !< Adiabatic Water Density, this is a dummy !! variable since here convection is always !! computed based on Brunt Vaisala. real, dimension(SZK_(G)) :: rho_1d !< water density in a column, this is also !! a dummy variable, same reason as above. - real, dimension(SZK_(G)+1) :: kv_col !< Viscosities at interfaces in the column (m2 s-1) - real, dimension(SZK_(G)+1) :: kd_col !< Diffusivities at interfaces in the column (m2 s-1) - real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) - real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m) + real, dimension(SZK_(G)+1) :: kv_col !< Viscosities at interfaces in the column [m2 s-1] + real, dimension(SZK_(G)+1) :: kd_col !< Diffusivities at interfaces in the column [m2 s-1] + real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces [m] + real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers [m] integer :: kOBL !< level of OBL extent real :: pref, g_o_rho0, rhok, rhokm1, dz, dh, hcorr integer :: i, j, k diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index e636672817..0e80f166c5 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -26,16 +26,16 @@ module MOM_CVMix_ddiff type, public :: CVMix_ddiff_cs ! Parameters - real :: strat_param_max !< maximum value for the stratification parameter (nondim) + real :: strat_param_max !< maximum value for the stratification parameter [nondim] real :: kappa_ddiff_s !< leading coefficient in formula for salt-fingering regime - !! for salinity diffusion (m^2/s) - real :: ddiff_exp1 !< interior exponent in salt-fingering regime formula (nondim) - real :: ddiff_exp2 !< exterior exponent in salt-fingering regime formula (nondim) - real :: mol_diff !< molecular diffusivity (m^2/s) - real :: kappa_ddiff_param1 !< exterior coefficient in diffusive convection regime (nondim) - real :: kappa_ddiff_param2 !< middle coefficient in diffusive convection regime (nondim) - real :: kappa_ddiff_param3 !< interior coefficient in diffusive convection regime (nondim) - real :: min_thickness !< Minimum thickness allowed (m) + !! for salinity diffusion [m2 s-1] + real :: ddiff_exp1 !< interior exponent in salt-fingering regime formula [nondim] + real :: ddiff_exp2 !< exterior exponent in salt-fingering regime formula [nondim] + real :: mol_diff !< molecular diffusivity [m2 s-1] + real :: kappa_ddiff_param1 !< exterior coefficient in diffusive convection regime [nondim] + real :: kappa_ddiff_param2 !< middle coefficient in diffusive convection regime [nondim] + real :: kappa_ddiff_param3 !< interior coefficient in diffusive convection regime [nondim] + real :: min_thickness !< Minimum thickness allowed [m] character(len=4) :: diff_conv_type !< type of diffusive convection to use. Options are Marmorino & !! Caldwell 1976 ("MC76"; default) and Kelley 1988, 1990 ("K90") logical :: debug !< If true, turn on debugging @@ -47,9 +47,9 @@ module MOM_CVMix_ddiff !!@} ! Diagnostics arrays -! real, allocatable, dimension(:,:,:) :: KT_extra !< Double diffusion diffusivity for temp (Z2/s) -! real, allocatable, dimension(:,:,:) :: KS_extra !< Double diffusion diffusivity for salt (Z2/s) - real, allocatable, dimension(:,:,:) :: R_rho !< Double-diffusion density ratio (nondim) +! real, allocatable, dimension(:,:,:) :: KT_extra !< Double diffusion diffusivity for temp [Z2 s-1 ~> m2 s-1] +! real, allocatable, dimension(:,:,:) :: KS_extra !< Double diffusion diffusivity for salt [Z2 s-1 ~> m2 s-1] + real, allocatable, dimension(:,:,:) :: R_rho !< Double-diffusion density ratio [nondim] end type CVMix_ddiff_cs @@ -192,7 +192,7 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS) Kd1_T, & !< Diapycanal diffusivity of temperature [m2 s-1]. Kd1_S !< Diapycanal diffusivity of salinity [m2 s-1]. - real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) + real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces [m] integer :: kOBL !< level of OBL extent real :: pref, g_o_rho0, rhok, rhokm1, dz, dh, hcorr integer :: i, k diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index b976ddc3a4..06fa74bdc7 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -36,8 +36,8 @@ module MOM_CVMix_shear real :: Nu_zero !< LMD94 maximum interior diffusivity real :: KPP_exp !< Exponent of unitless factor of diff. !! for KPP internal shear mixing scheme. - real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency (1/s2) - real, allocatable, dimension(:,:,:) :: S2 !< Squared shear frequency (1/s2) + real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency [s-2] + real, allocatable, dimension(:,:,:) :: S2 !< Squared shear frequency [s-2] real, allocatable, dimension(:,:,:) :: ri_grad !< Gradient Richardson number real, allocatable, dimension(:,:,:) :: ri_grad_smooth !< Gradient Richardson number !! after smoothing @@ -76,8 +76,8 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) real :: pref, DU, DV, DRHO, DZ, N2, S2, dummy real, dimension(2*(G%ke)) :: pres_1d, temp_1d, salt_1d, rho_1d real, dimension(G%ke+1) :: Ri_Grad !< Gradient Richardson number - real, dimension(G%ke+1) :: Kvisc !< Vertical viscosity at interfaces (m2/s) - real, dimension(G%ke+1) :: Kdiff !< Diapycnal diffusivity at interfaces (m2/s) + real, dimension(G%ke+1) :: Kvisc !< Vertical viscosity at interfaces [m2 s-1] + real, dimension(G%ke+1) :: Kdiff !< Diapycnal diffusivity at interfaces [m2 s-1] real, parameter :: epsln = 1.e-10 !< Threshold to identify vanished layers ! some constants diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 931d2ec15e..7d683944a2 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -39,13 +39,13 @@ module MOM_bkgnd_mixing ! Parameters real :: Bryan_Lewis_c1 !< The vertical diffusivity values for Bryan-Lewis profile - !! at |z|=D (m2/s) + !! at |z|=D [m2 s-1] real :: Bryan_Lewis_c2 !< The amplitude of variation in diffusivity for the - !! Bryan-Lewis diffusivity profile (m2/s) + !! Bryan-Lewis diffusivity profile [m2 s-1] real :: Bryan_Lewis_c3 !< The inverse length scale for transition region in the - !! Bryan-Lewis diffusivity profile (1/m) + !! Bryan-Lewis diffusivity profile [m-1] real :: Bryan_Lewis_c4 !< The depth where diffusivity is Bryan_Lewis_bl1 in the - !! Bryan-Lewis profile (m) + !! Bryan-Lewis profile [m] real :: bckgrnd_vdc1 !< Background diffusivity (Ledwell) when !! horiz_varying_background=.true. real :: bckgrnd_vdc_eq !! Equatorial diffusivity (Gregg) when @@ -54,8 +54,8 @@ module MOM_bkgnd_mixing !! horiz_varying_background=.true. real :: bckgrnd_vdc_ban !< Banda Sea diffusivity (Gordon) when !! horiz_varying_background=.true. - real :: Kd_min !< minimum diapycnal diffusivity (Z2/s) - real :: Kd !< interior diapycnal diffusivity (Z2/s) + real :: Kd_min !< minimum diapycnal diffusivity [Z2 s-1 ~> m2 s-1] + real :: Kd !< interior diapycnal diffusivity [Z2 s-1 ~> m2 s-1] real :: N0_2Omega !< ratio of the typical Buoyancy frequency to !! twice the Earth's rotation period, used with the !! Henyey scaling from the mixing @@ -64,7 +64,7 @@ module MOM_bkgnd_mixing real :: Kd_tanh_lat_scale !< A nondimensional scaling for the range of !! diffusivities with Kd_tanh_lat_fn. Valid values !! are in the range of -2 to 2; 0.4 reproduces CM2M. - real :: Kdml !< mixed layer diapycnal diffusivity (Z2/s) + real :: Kdml !< mixed layer diapycnal diffusivity [Z2 s-1 ~> m2 s-1] !! when bulkmixedlayer==.false. real :: Hmix !< mixed layer thickness [Z ~> m] when bulkmixedlayer==.false. logical :: Kd_tanh_lat_fn !< If true, use the tanh dependence of Kd_sfc on @@ -100,10 +100,10 @@ module MOM_bkgnd_mixing integer :: id_kd_bkgnd = -1 !< Diagnotic IDs integer :: id_kv_bkgnd = -1 !< Diagnostic IDs - real, allocatable, dimension(:,:) :: Kd_sfc !< surface value of the diffusivity (Z2/s) + real, allocatable, dimension(:,:) :: Kd_sfc !< surface value of the diffusivity [Z2 s-1 ~> m2 s-1] ! Diagnostics arrays - real, allocatable, dimension(:,:,:) :: kd_bkgnd !< Background diffusivity (Z2/s) - real, allocatable, dimension(:,:,:) :: kv_bkgnd !< Background viscosity (Z2/s) + real, allocatable, dimension(:,:,:) :: kd_bkgnd !< Background diffusivity [Z2 s-1 ~> m2 s-1] + real, allocatable, dimension(:,:,:) :: kv_bkgnd !< Background viscosity [Z2 s-1 ~> m2 s-1] character(len=40) :: bkgnd_scheme_str = "none" !< Background scheme identifier @@ -125,7 +125,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) type(bkgnd_mixing_cs), pointer :: CS !< This module's control structure. ! Local variables - real :: Kv ! The interior vertical viscosity (m2/s) - read to set prandtl + real :: Kv ! The interior vertical viscosity [m2 s-1] - read to set prandtl ! number unless it is provided as a parameter real :: prandtl_bkgnd_comp ! Kv/CS%Kd. Gets compared with user-specified prandtl_bkgnd. @@ -335,7 +335,7 @@ subroutine sfc_bkgnd_mixing(G, US, CS) ! local variables real :: I_x30 !< 2/acos(2) = 1/(sin(30 deg) * acosh(1/sin(30 deg))) real :: deg_to_rad !< factor converting degrees to radians, pi/180. - real :: abs_sin !< absolute value of sine of latitude (nondim) + real :: abs_sin !< absolute value of sine of latitude [nondim] real :: epsilon integer :: i, j, k, is, ie, js, je @@ -398,9 +398,9 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, US, CS) !! a previous call to bkgnd_mixing_init. ! local variables - real, dimension(SZK_(G)+1) :: depth_int !< distance from surface of the interfaces (m) - real, dimension(SZK_(G)+1) :: Kd_col !< Diffusivities at the interfaces (m2 s-1) - real, dimension(SZK_(G)+1) :: Kv_col !< Viscosities at the interfaces (m2 s-1) + real, dimension(SZK_(G)+1) :: depth_int !< distance from surface of the interfaces [m] + real, dimension(SZK_(G)+1) :: Kd_col !< Diffusivities at the interfaces [m2 s-1] + real, dimension(SZK_(G)+1) :: Kv_col !< Viscosities at the interfaces [m2 s-1] real, dimension(SZI_(G)) :: depth !< distance from surface of an interface [Z ~> m] real :: depth_c !< depth of the center of a layer [Z ~> m] real :: I_Hmix !< inverse of fixed mixed layer thickness [Z-1 ~> m-1] @@ -409,7 +409,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, Kv, j, G, GV, US, CS) real :: N02_N2 real :: I_x30 !< 2/acos(2) = 1/(sin(30 deg) * acosh(1/sin(30 deg))) real :: deg_to_rad !< factor converting degrees to radians, pi/180. - real :: abs_sin !< absolute value of sine of latitude (nondim) + real :: abs_sin !< absolute value of sine of latitude [nondim] real :: epsilon real :: bckgrnd_vdc_psin !< PSI diffusivity in northern hemisphere real :: bckgrnd_vdc_psis !< PSI diffusivity in southern hemisphere diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 32a8886a53..51da4af494 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -499,7 +499,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! as follows: ! TKE_river[m3 s-3] = 0.5*rivermix_depth*g*Irho0*drho_ds* ! River*(Samb - Sriver) = CS%mstar*U_star^3 - ! where River is in units of m s-1. + ! where River is in units of [m s-1]. ! Samb = Ambient salinity at the mouth of the estuary ! rivermix_depth = The prescribed depth over which to mix river inflow ! drho_ds = The gradient of density wrt salt at the ambient surface salinity. @@ -520,8 +520,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! We aggregate the thermodynamic forcing for a time step into the following: ! netMassInOut = water [H ~> m or kg m-2] added/removed via surface fluxes ! netMassOut = water [H ~> m or kg m-2] removed via evaporating surface fluxes - ! net_heat = heat (degC * H) via surface fluxes - ! net_salt = salt ( g(salt)/m2 for non-Bouss and ppt*m/s for Bouss ) via surface fluxes + ! net_heat = heat via surface fluxes [degC H ~> degC m or degC kg m-2] + ! net_salt = salt via surface fluxes [ppt H ~> dppt m or gSalt m-2] ! Pen_SW_bnd = components to penetrative shortwave radiation call extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & CS%H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & @@ -982,9 +982,9 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! within a time step [H ~> m or kg m-2]. (I.e. P+R-E.) real, dimension(SZI_(G)), intent(in) :: netMassOut !< The mass or volume flux out of the ocean !! within a time step [H ~> m or kg m-2]. - real, dimension(SZI_(G)), intent(in) :: Net_heat !< The net heating at the surface over a - !! time step [degC H ~> degC m or degC kg m-2]. Any penetrating shortwave - !! radiation is not included in Net_heat. + real, dimension(SZI_(G)), intent(in) :: Net_heat !< The net heating at the surface over a time + !! step [degC H ~> degC m or degC kg m-2]. Any penetrating + !! shortwave radiation is not included in Net_heat. real, dimension(SZI_(G)), intent(in) :: Net_salt !< The net surface salt flux into the ocean !! over a time step [PSU H ~> PSU m or PSU kg m-2]. integer, intent(in) :: nsw !< The number of bands of penetrating @@ -1350,8 +1350,8 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, ! convective adjustment is converted to TKE, often ~0.2 [nondim]. real :: TKE_CA ! The potential energy released by convective adjustment if ! that release is positive [Z m2 s-2 ~> m3 s-2]. - real :: MKE_rate_CA ! MKE_rate for convective adjustment, ND, 0 to 1. - real :: MKE_rate_FC ! MKE_rate for free convection, ND, 0 to 1. + real :: MKE_rate_CA ! MKE_rate for convective adjustment [nondim], 0 to 1. + real :: MKE_rate_FC ! MKE_rate for free convection [nondim], 0 to 1. real :: totEn_Z ! The total potential energy released by convection, [Z3 s-2 ~> m3 s-2]. real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. real :: exp_kh ! The nondimensional decay of TKE across a layer [nondim]. @@ -2292,7 +2292,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! rho_0*g [H2 ~> m2 or kg2 m-4]. real :: dPE_det, dPE_merge ! The energy required to mix the detrained water ! into the buffer layer or the merge the two - ! buffer layers, both in units of J H2 Z m-5. + ! buffer layers [J H2 Z m-5 ~> J m-2 or J kg2 m-8]. real :: h_from_ml ! The amount of additional water that must be ! drawn from the mixed layer [H ~> m or kg m-2]. diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 53ab8c886d..6600e4f6b7 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -652,7 +652,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any !! available thermodynamic fields. - real, intent(in) :: densityDiff !< Density difference to determine MLD (kg/m3) + real, intent(in) :: densityDiff !< Density difference to determine MLD [kg m-3] type(diag_ctrl), pointer :: diagPtr !< Diagnostics structure integer, optional, intent(in) :: id_N2subML !< Optional handle (ID) of subML stratification integer, optional, intent(in) :: id_MLDsq !< Optional handle (ID) of squared MLD @@ -777,7 +777,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & !! available thermodynamic fields. logical, intent(in) :: aggregate_FW_forcing !< If False, treat in/out fluxes separately. real, intent(in) :: evap_CFL_limit !< The largest fraction of a layer that - !! can be evaporated in one time-step (non-dim). + !! can be evaporated in one time-step [nondim]. real, intent(in) :: minimum_forcing_depth !< The smallest depth over which !! heat and freshwater fluxes is applied [m]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -927,9 +927,9 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & ! note that lprec generally has sea ice melt/form included. ! netMassOut = net mass leaving ocean surface [H ~> m or kg m-2] over a time step. ! netMassOut < 0 means mass leaves ocean. - ! netHeat = heat (degC * H) via surface fluxes, excluding the part + ! netHeat = heat via surface fluxes [degC H ~> degC m or degC kg m-2], excluding the part ! contained in Pen_SW_bnd; and excluding heat_content of netMassOut < 0. - ! netSalt = surface salt fluxes ( g(salt)/m2 for non-Bouss and ppt*H for Bouss ) + ! netSalt = surface salt fluxes [ppt H ~> dppt m or gSalt m-2] ! Pen_SW_bnd = components to penetrative shortwave radiation split according to bands. ! This field provides that portion of SW from atmosphere that in fact ! enters to the ocean and participates in pentrative SW heating. @@ -1035,7 +1035,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & ! as follows: ! TKE_river[m3 s-3] = 0.5*rivermix_depth*g*(1/rho)*drho_ds* ! River*(Samb - Sriver) = CS%mstar*U_star^3 - ! where River is in units of m s-1. + ! where River is in units of [m s-1]. ! Samb = Ambient salinity at the mouth of the estuary ! rivermix_depth = The prescribed depth over which to mix river inflow ! drho_ds = The gradient of density wrt salt at the ambient surface salinity. diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index fe1ed975d6..200d3efdf7 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -161,7 +161,7 @@ module MOM_diabatic_driver real :: minimum_forcing_depth = 0.001 !< The smallest depth over which heat and freshwater !! fluxes are applied [m]. real :: evap_CFL_limit = 0.8 !< The largest fraction of a layer that can be - !! evaporated in one time-step (non-dim). + !! evaporated in one time-step [nondim]. integer :: halo_TS_diff = 0 !< The temperature, salinity and thickness halo size that !! must be valid for the diffusivity calculations. logical :: useKPP = .false. !< use CVMix/KPP diffusivities and non-local transport @@ -313,7 +313,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & cn ! baroclinic gravity wave speeds real, dimension(SZI_(G),SZJ_(G)) :: & Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges - SkinBuoyFlux! 2d surface buoyancy flux (Z2/s3), used by ePBL + SkinBuoyFlux! 2d surface buoyancy flux [Z2 s-3 ~> m2 s-3], used by ePBL real, dimension(SZI_(G),SZJ_(G),G%ke) :: h_diag ! diagnostic array for thickness real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp real, dimension(SZI_(G),SZJ_(G),G%ke) :: saln_diag ! diagnostic array for salinity @@ -347,7 +347,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! the arrays are not needed at the same time. integer :: kb(SZI_(G),SZJ_(G)) ! index of the lightest layer denser - ! than the buffer laye (nondimensional) + ! than the buffer layer [nondim] real :: p_ref_cv(SZI_(G)) ! Reference pressure for the potential ! density which defines the coordinate @@ -1195,7 +1195,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en real, dimension(SZI_(G),SZJ_(G)) :: & Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges - SkinBuoyFlux! 2d surface buoyancy flux (m2/s3), used by ePBL + SkinBuoyFlux! 2d surface buoyancy flux [m2 s-3], used by ePBL real, dimension(SZI_(G),SZJ_(G),G%ke) :: h_diag ! diagnostic array for thickness real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp real, dimension(SZI_(G),SZJ_(G),G%ke) :: saln_diag ! diagnostic array for salinity @@ -1229,7 +1229,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! the arrays are not needed at the same time. integer :: kb(SZI_(G),SZJ_(G)) ! index of the lightest layer denser - ! than the buffer laye (nondimensional) + ! than the buffer layer [nondim] real :: p_ref_cv(SZI_(G)) ! Reference pressure for the potential ! density which defines the coordinate @@ -1253,7 +1253,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en real :: h_tr ! h_tr is h at tracer points with a tiny thickness ! added to ensure positive definiteness [H ~> m or kg m-2] real :: Tr_ea_BBL ! The diffusive tracer thickness in the BBL that is - ! coupled to the bottom within a timestep (m) + ! coupled to the bottom within a timestep [H ~> m or kg m-2] real :: htot(SZIB_(G)) ! The summed thickness from the bottom [H ~> m or kg m-2]. real :: b1(SZIB_(G)), d1(SZIB_(G)) ! b1, c1, and d1 are variables used by the @@ -2073,7 +2073,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! mixing of passive tracers from massless boundary layers to interior call cpu_clock_begin(id_clock_tracers) if (CS%mix_boundary_tracers) then - Tr_ea_BBL = sqrt(dt*CS%Kd_BBL_tr) + Tr_ea_BBL = sqrt(dt*CS%Kd_BBL_tr) !### I think this needs GV%Z_to_H !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je do i=is,ie @@ -2450,7 +2450,7 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, & type(opacity_CS), optional, pointer :: opacity_CSp !< A pointer to be set to the opacity control structure type(optics_type), optional, pointer :: optics_CSp !< A pointer to be set to the optics control structure real, optional, intent( out) :: evap_CFL_limit !NULL() !< A structure that is used to regulate the !! timing of diagnostic output. - ! These are terms in the mixed layer TKE budget, all in J m-2 = kg s-2. + ! These are terms in the mixed layer TKE budget, all in [J m-2] = [kg s-2]. real, allocatable, dimension(:,:) :: & diag_TKE_wind, & !< The wind source of TKE [J m-2]. diag_TKE_MKE, & !< The resolved KE source of TKE [J m-2]. @@ -154,17 +154,17 @@ module MOM_energetic_PBL ML_depth, & !< The mixed layer depth [Z ~> m]. (result after iteration step) ML_depth2, & !< The mixed layer depth [Z ~> m]. (guess for iteration step) Enhance_M, & !< The enhancement to the turbulent velocity scale [nondim] - MSTAR_MIX, & !< Mstar used in EPBL - MSTAR_LT, & !< Mstar for Langmuir turbulence - MLD_EKMAN, & !< MLD over Ekman length - MLD_OBUKHOV, & !< MLD over Obukhov length - EKMAN_OBUKHOV, & !< Ekman over Obukhov length - LA, & !< Langmuir number - LA_MOD !< Modified Langmuir number + MSTAR_MIX, & !< Mstar used in EPBL [nondim] + MSTAR_LT, & !< Mstar for Langmuir turbulence [nondim] + MLD_EKMAN, & !< MLD over Ekman length [nondim] + MLD_OBUKHOV, & !< MLD over Obukhov length [nondim] + EKMAN_OBUKHOV, & !< Ekman over Obukhov length [nondim] + LA, & !< Langmuir number [nondim] + LA_MOD !< Modified Langmuir number [nondim] real, allocatable, dimension(:,:,:) :: & - Velocity_Scale, & !< The velocity scale used in getting Kd - Mixing_Length !< The length scale used in getting Kd + Velocity_Scale, & !< The velocity scale used in getting Kd [Z s-1 ~> m s-1] + Mixing_Length !< The length scale used in getting Kd [Z ~> m] !>@{ Diagnostic IDs integer :: id_ML_depth = -1, id_TKE_wind = -1, id_TKE_mixing = -1 integer :: id_TKE_MKE = -1, id_TKE_conv = -1, id_TKE_forcing = -1 @@ -1639,7 +1639,7 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real :: ColHt_core ! The diffusivity-independent core term in the expressions ! for the column height changes [J m-3]. real :: ColHt_chg ! The change in the column height [H ~> m or kg m-2]. - real :: y1 ! A local temporary term, in units of H-3 or H-4 in various contexts. + real :: y1 ! A local temporary term, [H-3 ~> m-3 or m6 kg-3] or [H-4 ~> m-4 or m8 kg-4] in various contexts. ! The expression for the change in potential energy used here is derived ! from the expression for the final estimates of the changes in temperature @@ -1920,13 +1920,13 @@ end subroutine ust_2_u10_coare3p5 !! layer thickness, inclusion conversion to the 10m wind. subroutine get_LA_windsea(ustar, hbl, GV, US, LA) real, intent(in) :: ustar !< The water-side surface friction velocity [m s-1] - real, intent(in) :: hbl !< The ocean boundary layer depth (m) + real, intent(in) :: hbl !< The ocean boundary layer depth [m] type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(out) :: LA !< The Langmuir number returned from this module ! Original description: ! This function returns the enhancement factor, given the 10-meter -! wind [m s-1], friction velocity [m s-1] and the boundary layer depth (m). +! wind [m s-1], friction velocity [m s-1] and the boundary layer depth [m]. ! Update (Jan/25): ! Converted from function to subroutine, now returns Langmuir number. ! Computes 10m wind internally, so only ustar and hbl need passed to @@ -2242,8 +2242,8 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) CS%id_TKE_conv = register_diag_field('ocean_model', 'ePBL_TKE_conv', diag%axesT1, & Time, 'Convective source of mixed layer TKE', 'm3 s-3') CS%id_TKE_forcing = register_diag_field('ocean_model', 'ePBL_TKE_forcing', diag%axesT1, & - Time, 'TKE consumed by mixing surface forcing or penetrative shortwave radation'//& - ' through model layers', 'm3 s-3') + Time, 'TKE consumed by mixing surface forcing or penetrative shortwave radation '//& + 'through model layers', 'm3 s-3') CS%id_TKE_mixing = register_diag_field('ocean_model', 'ePBL_TKE_mixing', diag%axesT1, & Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3') CS%id_TKE_mech_decay = register_diag_field('ocean_model', 'ePBL_TKE_mech_decay', diag%axesT1, & diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 9a0a46ec67..5a4369f79b 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -1638,7 +1638,9 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & real :: eL ! 1 or 0, depending on whether increases in E lead ! to decreases in the entrainment from below by the ! deepest buffer layer. - real :: fa, fk, fm, fr ! Temporary variables used to calculate err, in ND, H2, H, H. + real :: fa ! Temporary variable used to calculate err [nondim]. + real :: fk ! Temporary variable used to calculate err [H2 ~> m2 or kg2 m-4]. + real :: fm, fr ! Temporary variables used to calculate err [H ~> m or kg m-2]. real :: tolerance ! The tolerance within which E must be converged [H ~> m or kg m-2]. real :: E_prev ! The previous value of E [H ~> m or kg m-2]. logical, dimension(SZI_(G)) :: false_position ! If true, the false position @@ -2117,7 +2119,7 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "MAX_ENT_IT", CS%max_ent_it, & "The maximum number of iterations that may be used to \n"//& "calculate the interior diapycnal entrainment.", default=5) -! In this module, KD is only used to set the default for TOLERANCE_ENT. (m2 s-1) +! In this module, KD is only used to set the default for TOLERANCE_ENT. [m2 s-1] call get_param(param_file, mdl, "KD", Kd, fail_if_missing=.true.) call get_param(param_file, mdl, "DT", dt, & "The (baroclinic) dynamics time step.", units = "s", & diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index c05756c97b..7ca06c6139 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -47,8 +47,7 @@ module MOM_geothermal !! be applied to the ocean is returned (WHERE)? subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid - !! structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers !! to any available thermodynamic @@ -69,7 +68,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) integer, optional, intent(in) :: halo !< Halo width over which to work ! Local variables real, dimension(SZI_(G)) :: & - heat_rem, & ! remaining heat (H * degC) + heat_rem, & ! remaining heat [H degC ~> m degC or kg degC m-2] h_geo_rem, & ! remaining thickness to apply geothermal heating [H ~> m or kg m-2] Rcv_BL, & ! coordinate density in the deepest variable density layer [kg m-3] p_ref ! coordiante densities reference pressure [Pa] diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index ff1871233a..e89ded7e13 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -38,7 +38,7 @@ module MOM_opacity real :: pen_sw_frac !< The fraction of shortwave radiation that is !! penetrating with a constant e-folding approach. real :: blue_frac !< The fraction of the penetrating shortwave - !! radiation that is in the blue band, ND. + !! radiation that is in the blue band [nondim]. real :: opacity_land_value !< The value to use for opacity over land [m-1]. !! The default is 10 m-1 - a value for muddy water. integer :: sbc_chl !< An integer handle used in time interpolation of diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index cb07d230e4..b327116f75 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1683,7 +1683,7 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) logical :: adiabatic, useKPP, useEPBL logical :: use_CVMix_shear, MLE_use_PBL_MLD, use_CVMix_conv integer :: isd, ied, jsd, jed, nz - real :: hfreeze !< If hfreeze > 0 (m), melt potential will be computed. + real :: hfreeze !< If hfreeze > 0 [m], melt potential will be computed. character(len=40) :: mdl = "MOM_set_visc" ! This module's name. isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke diff --git a/src/parameterizations/vertical/MOM_shortwave_abs.F90 b/src/parameterizations/vertical/MOM_shortwave_abs.F90 index 7e6878455a..cf0da1c5f3 100644 --- a/src/parameterizations/vertical/MOM_shortwave_abs.F90 +++ b/src/parameterizations/vertical/MOM_shortwave_abs.F90 @@ -20,16 +20,16 @@ module MOM_shortwave_abs integer :: nbands !< number of penetrating bands of SW radiation - real, pointer, dimension(:,:,:,:) :: opacity_band => NULL() !< SW optical depth per unit thickness (1/m) + real, pointer, dimension(:,:,:,:) :: opacity_band => NULL() !< SW optical depth per unit thickness [m-1] !! The number of radiation bands is most rapidly varying (first) index. - real, pointer, dimension(:,:,:) :: SW_pen_band => NULL() !< shortwave radiation (W/m^2) at the surface + real, pointer, dimension(:,:,:) :: SW_pen_band => NULL() !< shortwave radiation [W m-2] at the surface !! in each of the nbands bands that penetrates beyond the surface. !! The most rapidly varying dimension is the band. real, pointer, dimension(:) :: & - min_wavelength_band => NULL(), & !< The minimum wavelength in each band of penetrating shortwave radiation (nm) - max_wavelength_band => NULL() !< The maximum wavelength in each band of penetrating shortwave radiation (nm) + min_wavelength_band => NULL(), & !< The minimum wavelength in each band of penetrating shortwave radiation [nm] + max_wavelength_band => NULL() !< The maximum wavelength in each band of penetrating shortwave radiation [nm] end type optics_type @@ -49,8 +49,8 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(:,:,:), intent(in) :: opacity_band !< Opacity in each band of - !! penetrating shortwave radiation (1/H). + real, dimension(:,:,:), intent(in) :: opacity_band !< Opacity in each band of penetrating + !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. !! The indicies are band, i, k. integer, intent(in) :: nsw !< Number of bands of penetrating !! shortwave radiation. @@ -110,7 +110,7 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, ! heating that hits the bottom and will be redistributed through ! the water column [degC H ~> degC m or degC kg m-2] real :: SW_trans ! fraction of shortwave radiation that is not - ! absorbed in a layer (nondimensional) + ! absorbed in a layer [nondim] real :: unabsorbed ! fraction of the shortwave radiation that ! is not absorbed because the layers are too thin real :: Ih_limit ! inverse of the total depth at which the @@ -334,7 +334,7 @@ subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & real, dimension(size(iPen_SW_bnd,1),size(iPen_SW_bnd,2)) :: Pen_SW_bnd real :: SW_trans ! fraction of shortwave radiation not - ! absorbed in a layer (nondimensional) + ! absorbed in a layer [nondim] real :: unabsorbed ! fraction of the shortwave radiation ! not absorbed because the layers are too thin. real :: Ih_limit ! inverse of the total depth at which the diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 328f258311..6f85bc5dbe 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -45,26 +45,26 @@ module MOM_tidal_mixing type, public :: tidal_mixing_diags ; private real, pointer, dimension(:,:,:) :: & Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces [Z2 s-1 ~> m2 s-1]. - Fl_itidal => NULL(),& !< vertical flux of tidal turbulent dissipation (m3 s-3) + Fl_itidal => NULL(),& !< vertical flux of tidal turbulent dissipation [m3 s-3] Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces [Z2 s-1 ~> m2 s-1]. - Kd_Niku_work => NULL(),& !< layer integrated work by lee-wave driven mixing (W m-2) - Kd_Itidal_Work => NULL(),& !< layer integrated work by int tide driven mixing (W m-2) - Kd_Lowmode_Work => NULL(),& !< layer integrated work by low mode driven mixing (W m-2) - N2_int => NULL(),& !< Bouyancy frequency squared at interfaces (s-2) - vert_dep_3d => NULL(),& !< The 3-d mixing energy deposition (W m-3) + Kd_Niku_work => NULL(),& !< layer integrated work by lee-wave driven mixing [W m-2] + Kd_Itidal_Work => NULL(),& !< layer integrated work by int tide driven mixing [W m-2] + Kd_Lowmode_Work => NULL(),& !< layer integrated work by low mode driven mixing [W m-2] + N2_int => NULL(),& !< Bouyancy frequency squared at interfaces [s-2] + vert_dep_3d => NULL(),& !< The 3-d mixing energy deposition [W m-3] Schmittner_coeff_3d => NULL() !< The coefficient in the Schmittner et al mixing scheme, in UNITS? real, pointer, dimension(:,:,:) :: tidal_qe_md => NULL() !< Input tidal energy dissipated locally, - !! interpolated to model vertical coordinate (W m-3?) + !! interpolated to model vertical coordinate [W m-3?] real, pointer, dimension(:,:,:) :: Kd_lowmode => NULL() !< internal tide diffusivity at interfaces !! due to propagating low modes [Z2 s-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Fl_lowmode => NULL() !< vertical flux of tidal turbulent - !! dissipation due to propagating low modes (m3/s3) + !! dissipation due to propagating low modes [m3 s-3] real, pointer, dimension(:,:) :: & - TKE_itidal_used => NULL(),& !< internal tide TKE input at ocean bottom (W/m2) - N2_bot => NULL(),& !< bottom squared buoyancy frequency (1/s2) - N2_meanz => NULL(),& !< vertically averaged buoyancy frequency (1/s2) + TKE_itidal_used => NULL(),& !< internal tide TKE input at ocean bottom [W m-2] + N2_bot => NULL(),& !< bottom squared buoyancy frequency [s-2] + N2_meanz => NULL(),& !< vertically averaged buoyancy frequency [s-2] Polzin_decay_scale_scaled => NULL(),& !< vertical scale of decay for tidal dissipation - Polzin_decay_scale => NULL(),& !< vertical decay scale for tidal diss with Polzin (meter) + Polzin_decay_scale => NULL(),& !< vertical decay scale for tidal diss with Polzin [m] Simmons_coeff_2d => NULL() !< The Simmons et al mixing coefficient end type @@ -93,14 +93,14 @@ module MOM_tidal_mixing real :: Int_tide_decay_scale !< decay scale for internal wave TKE [Z ~> m]. real :: Mu_itides !< efficiency for conversion of dissipation - !! to potential energy (nondimensional) + !! to potential energy [nondim] - real :: Gamma_itides !< fraction of local dissipation (nondimensional) + real :: Gamma_itides !< fraction of local dissipation [nondim] real :: Gamma_lee !< fraction of local dissipation for lee waves - !! (Nikurashin's energy input) (nondimensional) + !! (Nikurashin's energy input) [nondim] real :: Decay_scale_factor_lee !< Scaling factor for the decay scale of lee - !! wave energy dissipation (nondimensional) + !! wave energy dissipation [nondim] real :: min_zbot_itides !< minimum depth for internal tide conversion [Z ~> m]. logical :: Lowmode_itidal_dissipation = .false. !< If true, consider mixing due to breaking low @@ -116,10 +116,10 @@ module MOM_tidal_mixing !! ocean bottom used in Polzin formulation of the !! vertical scale of decay of tidal dissipation [s-1] real :: Polzin_decay_scale_factor !< Scaling factor for the decay length scale - !! of the tidal dissipation profile in Polzin (nondimensional) + !! of the tidal dissipation profile in Polzin [nondim] real :: Polzin_decay_scale_max_factor !< The decay length scale of tidal dissipation !! profile in Polzin formulation should not exceed - !! Polzin_decay_scale_max_factor * depth of the ocean (nondimensional). + !! Polzin_decay_scale_max_factor * depth of the ocean [nondim]. real :: Polzin_min_decay_scale !< minimum decay scale of the tidal dissipation !! profile in Polzin formulation [Z ~> m]. @@ -716,9 +716,9 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) real, dimension(SZK_(G)+1) :: Kd_tidal ! tidal diffusivity [m2/s] real, dimension(SZK_(G)+1) :: Kv_tidal ! tidal viscosity [m2/s] real, dimension(SZK_(G)+1) :: vert_dep ! vertical deposition - real, dimension(SZK_(G)+1) :: iFaceHeight ! Height of interfaces (m) + real, dimension(SZK_(G)+1) :: iFaceHeight ! Height of interfaces [m] real, dimension(SZK_(G)+1) :: SchmittnerSocn - real, dimension(SZK_(G)) :: cellHeight ! Height of cell centers (m) + real, dimension(SZK_(G)) :: cellHeight ! Height of cell centers [m] real, dimension(SZK_(G)) :: tidal_qe_md ! Tidal dissipation energy interpolated from 3d input ! to model coordinates real, dimension(SZK_(G)) :: Schmittner_coeff @@ -959,12 +959,12 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, htot, & ! total thickness above or below a layer, or the ! integrated thickness in the BBL [Z ~> m]. htot_WKB, & ! WKB scaled distance from top to bottom [Z ~> m]. - TKE_itidal_bot, & ! internal tide TKE at ocean bottom (m3/s3) - TKE_Niku_bot, & ! lee-wave TKE at ocean bottom (m3/s3) - TKE_lowmode_bot, & ! internal tide TKE at ocean bottom lost from all remote low modes (m3/s3) (BDM) - Inv_int, & ! inverse of TKE decay for int tide over the depth of the ocean (nondim) - Inv_int_lee, & ! inverse of TKE decay for lee waves over the depth of the ocean (nondim) - Inv_int_low, & ! inverse of TKE decay for low modes over the depth of the ocean (nondim) (BDM) + TKE_itidal_bot, & ! internal tide TKE at ocean bottom [m3 s-3] + TKE_Niku_bot, & ! lee-wave TKE at ocean bottom [m3 s-3] + TKE_lowmode_bot, & ! internal tide TKE at ocean bottom lost from all remote low modes [m3 s-3] (BDM) + Inv_int, & ! inverse of TKE decay for int tide over the depth of the ocean [nondim] + Inv_int_lee, & ! inverse of TKE decay for lee waves over the depth of the ocean [nondim] + Inv_int_low, & ! inverse of TKE decay for low modes over the depth of the ocean [nondim] (BDM) z0_Polzin, & ! TKE decay scale in Polzin formulation [Z ~> m]. z0_Polzin_scaled, & ! TKE decay scale in Polzin formulation [Z ~> m]. ! multiplied by N2_bot/N2_meanz to be coherent with the WKB scaled z @@ -974,19 +974,19 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, TKE_itidal_rem, & ! remaining internal tide TKE (from barotropic source) TKE_Niku_rem, & ! remaining lee-wave TKE TKE_lowmode_rem, & ! remaining internal tide TKE (from propagating low mode source) (BDM) - TKE_frac_top, & ! fraction of bottom TKE that should appear at top of a layer (nondim) - TKE_frac_top_lee, & ! fraction of bottom TKE that should appear at top of a layer (nondim) + TKE_frac_top, & ! fraction of bottom TKE that should appear at top of a layer [nondim] + TKE_frac_top_lee, & ! fraction of bottom TKE that should appear at top of a layer [nondim] TKE_frac_top_lowmode, & - ! fraction of bottom TKE that should appear at top of a layer (nondim) (BDM) + ! fraction of bottom TKE that should appear at top of a layer [nondim] (BDM) z_from_bot, & ! distance from bottom [Z ~> m]. z_from_bot_WKB ! WKB scaled distance from bottom [Z ~> m]. - real :: I_rho0 ! 1 / RHO0, (m3/kg) + real :: I_rho0 ! 1 / RHO0 [m3 kg-1] real :: Kd_add ! diffusivity to add in a layer [Z2 s-1 ~> m2 s-1]. - real :: TKE_itide_lay ! internal tide TKE imparted to a layer (from barotropic) (m3/s3) + real :: TKE_itide_lay ! internal tide TKE imparted to a layer (from barotropic) [m3 s-3] real :: TKE_Niku_lay ! lee-wave TKE imparted to a layer [m3 s-3] - real :: TKE_lowmode_lay ! internal tide TKE imparted to a layer (from low mode) (m3/s3) (BDM) - real :: frac_used ! fraction of TKE that can be used in a layer (nondim) + real :: TKE_lowmode_lay ! internal tide TKE imparted to a layer (from low mode) [m3 s-3] (BDM) + real :: frac_used ! fraction of TKE that can be used in a layer [nondim] real :: Izeta ! inverse of TKE decay scale [Z-1 ~> m-1]. real :: Izeta_lee ! inverse of TKE decay scale for lee waves [Z-1 ~> m-1]. real :: z0_psl ! temporary variable [Z ~> m]. @@ -1516,7 +1516,7 @@ subroutine read_tidal_energy(G, US, tidal_energy_type, tidal_energy_file, CS) type(tidal_mixing_cs), pointer :: CS !< The control structure for this module ! local integer :: i, j, isd, ied, jsd, jed, nz - real, allocatable, dimension(:,:) :: tidal_energy_flux_2d ! input tidal energy flux at T-grid points (W/m^2) + real, allocatable, dimension(:,:) :: tidal_energy_flux_2d ! input tidal energy flux at T-grid points [W m-2] isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index e462fc2bac..5400f8c1df 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -586,7 +586,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) real, dimension(SZIB_(G),SZK_(G)) :: & h_harm, & ! Harmonic mean of the thicknesses around a velocity grid point, - ! given by 2*(h+ * h-)/(h+ + h-) [H ~> m or kg m-2] (H for short). + ! given by 2*(h+ * h-)/(h+ + h-) [H ~> m or kg m-2]. h_arith, & ! The arithmetic mean thickness [H ~> m or kg m-2]. h_delta, & ! The lateral difference of thickness [H ~> m or kg m-2]. hvel, & ! hvel is the thickness used at a velocity grid point [H ~> m or kg m-2]. From ea5c097f2fea029ddf1d882486710195704a8bf2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 29 Jan 2019 13:59:41 -0500 Subject: [PATCH 0990/1072] Documented 116 tracer variable units Changed comments to use the square bracket notation to document the units of about 116 variables in the tracer directory. Only comments have been changed and all answers are bitwise identical. --- src/tracer/DOME_tracer.F90 | 2 +- src/tracer/ISOMIP_tracer.F90 | 2 +- src/tracer/MOM_OCMIP2_CFC.F90 | 54 ++++++++------- src/tracer/MOM_neutral_diffusion.F90 | 85 ++++++++++++------------ src/tracer/MOM_neutral_diffusion_aux.F90 | 12 ++-- src/tracer/MOM_offline_main.F90 | 4 +- src/tracer/MOM_tracer_advect.F90 | 22 +++--- src/tracer/MOM_tracer_diabatic.F90 | 2 +- src/tracer/MOM_tracer_flow_control.F90 | 2 +- src/tracer/MOM_tracer_hor_diff.F90 | 3 +- src/tracer/MOM_tracer_registry.F90 | 28 +++++--- src/tracer/advection_test_tracer.F90 | 2 +- src/tracer/boundary_impulse_tracer.F90 | 24 +++---- src/tracer/dye_example.F90 | 2 +- src/tracer/dyed_obc_tracer.F90 | 2 +- src/tracer/ideal_age_example.F90 | 2 +- src/tracer/oil_tracer.F90 | 6 +- src/tracer/pseudo_salt_tracer.F90 | 2 +- 18 files changed, 133 insertions(+), 123 deletions(-) diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 5793f75914..45eebb983e 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -308,7 +308,7 @@ subroutine DOME_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, type(DOME_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to DOME_register_tracer. real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can - !! be fluxed out of the top layer in a timestep (nondim) + !! be fluxed out of the top layer in a timestep [nondim] real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which !! fluxes can be applied [m] diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index c7909300e0..36bc3edb65 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -272,7 +272,7 @@ subroutine ISOMIP_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, G type(ISOMIP_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to ISOMIP_register_tracer. real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can - !! be fluxed out of the top layer in a timestep (nondim) + !! be fluxed out of the top layer in a timestep [nondim] real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which !! fluxes can be applied [m] diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index 3dbbde970f..805409c16b 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -45,24 +45,28 @@ module MOM_OCMIP2_CFC type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the MOM6 tracer registry real, pointer, dimension(:,:,:) :: & - CFC11 => NULL(), & !< The CFC11 concentration in mol m-3. - CFC12 => NULL() !< The CFC12 concentration in mol m-3. + CFC11 => NULL(), & !< The CFC11 concentration [mol m-3]. + CFC12 => NULL() !< The CFC12 concentration [mol m-3]. ! In the following variables a suffix of _11 refers to CFC11 and _12 to CFC12. !>@{ Coefficients used in the CFC11 and CFC12 solubility calculation - real :: a1_11, a2_11, a3_11, a4_11 ! Coefficients in the calculation of the - real :: a1_12, a2_12, a3_12, a4_12 ! CFC11 and CFC12 Schmidt numbers, in - ! units of ND, degC-1, degC-2, degC-3. - real :: d1_11, d2_11, d3_11, d4_11 ! Coefficients in the calculation of the - real :: d1_12, d2_12, d3_12, d4_12 ! CFC11 and CFC12 solubilities, in units - ! of ND, K-1, log(K)^-1, K-2. - real :: e1_11, e2_11, e3_11 ! More coefficients in the calculation of - real :: e1_12, e2_12, e3_12 ! the CFC11 and CFC12 solubilities, in - ! units of PSU-1, PSU-1 K-1, PSU-1 K-2. + real :: a1_11, a1_12 ! Coefficients for calculating CFC11 and CFC12 Schmidt numbers [nondim] + real :: a2_11, a2_12 ! Coefficients for calculating CFC11 and CFC12 Schmidt numbers [degC-1] + real :: a3_11, a3_12 ! Coefficients for calculating CFC11 and CFC12 Schmidt numbers [degC-2] + real :: a4_11, a4_12 ! Coefficients for calculating CFC11 and CFC12 Schmidt numbers [degC-3] + + real :: d1_11, d1_12 ! Coefficients for calculating CFC11 and CFC12 solubilities [nondim] + real :: d2_11, d2_12 ! Coefficients for calculating CFC11 and CFC12 solubilities [hectoKelvin-1] + real :: d3_11, d3_12 ! Coefficients for calculating CFC11 and CFC12 solubilities [log(hectoKelvin)-1] + real :: d4_11, d4_12 ! Coefficients for calculating CFC11 and CFC12 solubilities [hectoKelvin-2] + + real :: e1_11, e1_12 ! Coefficients for calculating CFC11 and CFC12 solubilities [PSU-1] + real :: e2_11, e2_12 ! Coefficients for calculating CFC11 and CFC12 solubilities [PSU-1 hectoKelvin-1] + real :: e3_11, e3_12 ! Coefficients for calculating CFC11 and CFC12 solubilities [PSU-2 hectoKelvin-2] !!@} - real :: CFC11_IC_val = 0.0 !< The initial value assigned to CFC11. - real :: CFC12_IC_val = 0.0 !< The initial value assigned to CFC12. - real :: CFC11_land_val = -1.0 !< The value of CFC11 used where land is masked out. - real :: CFC12_land_val = -1.0 !< The value of CFC12 used where land is masked out. + real :: CFC11_IC_val = 0.0 !< The initial value assigned to CFC11 [mol m-3]. + real :: CFC12_IC_val = 0.0 !< The initial value assigned to CFC12 [mol m-3]. + real :: CFC11_land_val = -1.0 !< The value of CFC11 used where land is masked out [mol m-3]. + real :: CFC12_land_val = -1.0 !< The value of CFC12 used where land is masked out [mol m-3]. logical :: tracers_may_reinit !< If true, tracers may be reset via the initialization code !! if they are not found in the restart files. character(len=16) :: CFC11_name !< CFC11 variable name @@ -427,7 +431,7 @@ subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a !! previous call to register_OCMIP2_CFC. real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can - !! be fluxed out of the top layer in a timestep (nondim) + !! be fluxed out of the top layer in a timestep [nondim] real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which !! fluxes can be applied [m] ! This subroutine applies diapycnal diffusion and any other column @@ -551,15 +555,15 @@ subroutine OCMIP2_CFC_surface_state(state, h, G, CS) ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - CFC11_Csurf, & ! The CFC-11 and CFC-12 surface concentrations times the - CFC12_Csurf, & ! Schmidt number term, both in mol m-3. - CFC11_alpha, & ! The CFC-11 solubility in mol m-3 pptv-1. - CFC12_alpha ! The CFC-12 solubility in mol m-3 pptv-1. - real :: ta ! Absolute sea surface temperature in units of dekaKelvin!?! - real :: sal ! Surface salinity in PSU. - real :: SST ! Sea surface temperature in degrees Celsius. - real :: alpha_11 ! The solubility of CFC 11 in mol m-3 pptv-1. - real :: alpha_12 ! The solubility of CFC 12 in mol m-3 pptv-1. + CFC11_Csurf, & ! The CFC-11 surface concentrations times the Schmidt number term [mol m-3]. + CFC12_Csurf, & ! The CFC-12 surface concentrations times the Schmidt number term [mol m-3]. + CFC11_alpha, & ! The CFC-11 solubility [mol m-3 pptv-1]. + CFC12_alpha ! The CFC-12 solubility [mol m-3 pptv-1]. + real :: ta ! Absolute sea surface temperature [hectoKelvin] (Why use such bizzare units?) + real :: sal ! Surface salinity [PSU]. + real :: SST ! Sea surface temperature [degC]. + real :: alpha_11 ! The solubility of CFC 11 [mol m-3 pptv-1]. + real :: alpha_12 ! The solubility of CFC 12 [mol m-3 pptv-1]. real :: sc_11, sc_12 ! The Schmidt numbers of CFC 11 and CFC 12. real :: sc_no_term ! A term related to the Schmidt number. integer :: i, j, m, is, ie, js, je, idim(4), jdim(4) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 19e32fe057..d5a6f45c5f 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -55,28 +55,28 @@ module MOM_neutral_diffusion !! at a u-point integer, allocatable, dimension(:,:,:) :: uKoR !< Index of right interface corresponding to neutral surface, !! at a u-point - real, allocatable, dimension(:,:,:) :: uHeff !< Effective thickness at u-point (H units) + real, allocatable, dimension(:,:,:) :: uHeff !< Effective thickness at u-point [H ~> m or kg m-2] real, allocatable, dimension(:,:,:) :: vPoL !< Non-dimensional position with left layer uKoL-1, v-point real, allocatable, dimension(:,:,:) :: vPoR !< Non-dimensional position with right layer uKoR-1, v-point integer, allocatable, dimension(:,:,:) :: vKoL !< Index of left interface corresponding to neutral surface, !! at a v-point integer, allocatable, dimension(:,:,:) :: vKoR !< Index of right interface corresponding to neutral surface, !! at a v-point - real, allocatable, dimension(:,:,:) :: vHeff !< Effective thickness at v-point (H units) + real, allocatable, dimension(:,:,:) :: vHeff !< Effective thickness at v-point [H ~> m or kg m-2] ! Coefficients of polynomial reconstructions for temperature and salinity real, allocatable, dimension(:,:,:,:) :: ppoly_coeffs_T !< Polynomial coefficients for temperature real, allocatable, dimension(:,:,:,:) :: ppoly_coeffs_S !< Polynomial coefficients for salinity ! Variables needed for continuous reconstructions - real, allocatable, dimension(:,:,:) :: dRdT !< dRho/dT (kg/m3/degC) at interfaces - real, allocatable, dimension(:,:,:) :: dRdS !< dRho/dS (kg/m3/ppt) at interfaces - real, allocatable, dimension(:,:,:) :: Tint !< Interface T (degC) - real, allocatable, dimension(:,:,:) :: Sint !< Interface S (ppt) + real, allocatable, dimension(:,:,:) :: dRdT !< dRho/dT [kg m-3 degC-1] at interfaces + real, allocatable, dimension(:,:,:) :: dRdS !< dRho/dS [kg m-3 ppt-1] at interfaces + real, allocatable, dimension(:,:,:) :: Tint !< Interface T [degC] + real, allocatable, dimension(:,:,:) :: Sint !< Interface S [ppt] real, allocatable, dimension(:,:,:) :: Pint !< Interface pressure [Pa] ! Variables needed for discontinuous reconstructions - real, allocatable, dimension(:,:,:,:) :: T_i !< Top edge reconstruction of temperature (degC) - real, allocatable, dimension(:,:,:,:) :: S_i !< Top edge reconstruction of salinity (ppt) - real, allocatable, dimension(:,:,:,:) :: dRdT_i !< dRho/dT (kg/m3/degC) at top edge - real, allocatable, dimension(:,:,:,:) :: dRdS_i !< dRho/dS (kg/m3/ppt) at top edge + real, allocatable, dimension(:,:,:,:) :: T_i !< Top edge reconstruction of temperature [degC] + real, allocatable, dimension(:,:,:,:) :: S_i !< Top edge reconstruction of salinity [ppt] + real, allocatable, dimension(:,:,:,:) :: dRdT_i !< dRho/dT [kg m-3 degC-1] at top edge + real, allocatable, dimension(:,:,:,:) :: dRdS_i !< dRho/dS [kg m-3 ppt-1] at top edge integer, allocatable, dimension(:,:) :: ns !< Number of interfacs in a column logical, allocatable, dimension(:,:,:) :: stable_cell !< True if the cell is stably stratified wrt to the next cell type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to @@ -233,9 +233,9 @@ end function neutral_diffusion_init subroutine neutral_diffusion_calc_coeffs(G, GV, h, T, S, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (H units) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T !< Potential temperature (degC) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S !< Salinity (ppt) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T !< Potential temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S !< Salinity [ppt] type(neutral_diffusion_CS), pointer :: CS !< Neutral diffusion control structure ! Local variables @@ -410,17 +410,18 @@ end subroutine neutral_diffusion_calc_coeffs subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (H units) - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Coef_x !< dt * Kh * dy / dx at u-points (m^2) - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Coef_y !< dt * Kh * dx / dy at v-points (m^2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Coef_x !< dt * Kh * dy / dx at u-points [m2] + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Coef_y !< dt * Kh * dx / dy at v-points [m2] real, intent(in) :: dt !< Tracer time step * I_numitts !! (I_numitts in tracer_hordiff) type(tracer_registry_type), pointer :: Reg !< Tracer registry type(neutral_diffusion_CS), pointer :: CS !< Neutral diffusion control structure ! Local variables - real, dimension(SZIB_(G),SZJ_(G),CS%nsurf-1) :: uFlx ! Zonal flux of tracer (concentration * H) - real, dimension(SZI_(G),SZJB_(G),CS%nsurf-1) :: vFlx ! Meridional flux of tracer (concentration * H) + real, dimension(SZIB_(G),SZJ_(G),CS%nsurf-1) :: uFlx ! Zonal flux of tracer [H conc ~> m conc or conc kg m-2] + real, dimension(SZI_(G),SZJB_(G),CS%nsurf-1) :: vFlx ! Meridional flux of tracer + ! [H conc ~> m conc or conc kg m-2] real, dimension(SZI_(G),SZJ_(G),G%ke) :: tendency ! tendency array for diagn real, dimension(SZI_(G),SZJ_(G)) :: tendency_2d ! depth integrated content tendency for diagn real, dimension(SZIB_(G),SZJ_(G)) :: trans_x_2d ! depth integrated diffusive tracer x-transport diagn @@ -568,12 +569,12 @@ end subroutine neutral_diffusion !> Returns interface scalar, Si, for a column of layer values, S. subroutine interface_scalar(nk, h, S, Si, i_method, h_neglect) integer, intent(in) :: nk !< Number of levels - real, dimension(nk), intent(in) :: h !< Layer thickness (H units) + real, dimension(nk), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(nk), intent(in) :: S !< Layer scalar (conc, e.g. ppt) real, dimension(nk+1), intent(inout) :: Si !< Interface scalar (conc, e.g. ppt) integer, intent(in) :: i_method !< =1 use average of PLM edges !! =2 use continuous PPM edge interpolation - real, intent(in) :: h_neglect !< A negligibly small thickness (H units) + real, intent(in) :: h_neglect !< A negligibly small thickness [H ~> m or kg m-2] ! Local variables integer :: k, km2, kp1 real, dimension(nk) :: diff @@ -613,7 +614,7 @@ real function ppm_edge(hkm1, hk, hkp1, hkp2, Ak, Akp1, Pk, Pkp1, h_neglect) real, intent(in) :: Akp1 !< Average scalar value of cell k+1 real, intent(in) :: Pk !< PLM slope for cell k real, intent(in) :: Pkp1 !< PLM slope for cell k+1 - real, intent(in) :: h_neglect !< A negligibly small thickness (H units) + real, intent(in) :: h_neglect !< A negligibly small thickness [H ~> m or kg m-2] ! Local variables real :: R_hk_hkp1, R_2hk_hkp1, R_hk_2hkp1, f1, f2, f3, f4 @@ -684,7 +685,7 @@ end function signum !! The limiting follows equation 1.8 in Colella & Woodward, 1984: JCP 54, 174-201. subroutine PLM_diff(nk, h, S, c_method, b_method, diff) integer, intent(in) :: nk !< Number of levels - real, dimension(nk), intent(in) :: h !< Layer thickness (H units) + real, dimension(nk), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(nk), intent(in) :: S !< Layer salinity (conc, e.g. ppt) integer, intent(in) :: c_method !< Method to use for the centered difference integer, intent(in) :: b_method !< =1, use PCM in first/last cell, =2 uses linear extrapolation @@ -809,15 +810,15 @@ subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdS dRdTr, dRdSr, PoL, PoR, KoL, KoR, hEff) integer, intent(in) :: nk !< Number of levels real, dimension(nk+1), intent(in) :: Pl !< Left-column interface pressure [Pa] - real, dimension(nk+1), intent(in) :: Tl !< Left-column interface potential temperature (degC) - real, dimension(nk+1), intent(in) :: Sl !< Left-column interface salinity (ppt) - real, dimension(nk+1), intent(in) :: dRdTl !< Left-column dRho/dT (kg/m3/degC) - real, dimension(nk+1), intent(in) :: dRdSl !< Left-column dRho/dS (kg/m3/ppt) + real, dimension(nk+1), intent(in) :: Tl !< Left-column interface potential temperature [degC] + real, dimension(nk+1), intent(in) :: Sl !< Left-column interface salinity [ppt] + real, dimension(nk+1), intent(in) :: dRdTl !< Left-column dRho/dT [kg m-3 degC-1] + real, dimension(nk+1), intent(in) :: dRdSl !< Left-column dRho/dS [kg m-3 ppt-1] real, dimension(nk+1), intent(in) :: Pr !< Right-column interface pressure [Pa] - real, dimension(nk+1), intent(in) :: Tr !< Right-column interface potential temperature (degC) - real, dimension(nk+1), intent(in) :: Sr !< Right-column interface salinity (ppt) - real, dimension(nk+1), intent(in) :: dRdTr !< Left-column dRho/dT (kg/m3/degC) - real, dimension(nk+1), intent(in) :: dRdSr !< Left-column dRho/dS (kg/m3/ppt) + real, dimension(nk+1), intent(in) :: Tr !< Right-column interface potential temperature [degC] + real, dimension(nk+1), intent(in) :: Sr !< Right-column interface salinity [ppt] + real, dimension(nk+1), intent(in) :: dRdTr !< Left-column dRho/dT [kg m-3 degC-1] + real, dimension(nk+1), intent(in) :: dRdSr !< Left-column dRho/dS [kg m-3 ppt-1] real, dimension(2*nk+2), intent(inout) :: PoL !< Fractional position of neutral surface within !! layer KoL of left column real, dimension(2*nk+2), intent(inout) :: PoR !< Fractional position of neutral surface within @@ -995,18 +996,18 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, Pres_l, hcol integer, intent(in) :: ns !< Number of neutral surfaces real, dimension(nk+1), intent(in) :: Pres_l !< Left-column interface pressure [Pa] real, dimension(nk), intent(in) :: hcol_l !< Left-column layer thicknesses - real, dimension(nk,2), intent(in) :: Tl !< Left-column top interface potential temperature (degC) - real, dimension(nk,2), intent(in) :: Sl !< Left-column top interface salinity (ppt) - real, dimension(nk,2), intent(in) :: dRdT_l !< Left-column, top interface dRho/dT (kg/m3/degC) - real, dimension(nk,2), intent(in) :: dRdS_l !< Left-column, top interface dRho/dS (kg/m3/ppt) - logical, dimension(nk), intent(in) :: stable_l !< Left-column, top interface dRho/dS (kg/m3/ppt) + real, dimension(nk,2), intent(in) :: Tl !< Left-column top interface potential temperature [degC] + real, dimension(nk,2), intent(in) :: Sl !< Left-column top interface salinity [ppt] + real, dimension(nk,2), intent(in) :: dRdT_l !< Left-column, top interface dRho/dT [kg m-3 degC-1] + real, dimension(nk,2), intent(in) :: dRdS_l !< Left-column, top interface dRho/dS [kg m-3 ppt-1] + logical, dimension(nk), intent(in) :: stable_l !< Left-column, top interface is stable real, dimension(nk+1), intent(in) :: Pres_r !< Right-column interface pressure [Pa] real, dimension(nk), intent(in) :: hcol_r !< Left-column layer thicknesses - real, dimension(nk,2), intent(in) :: Tr !< Right-column top interface potential temperature (degC) - real, dimension(nk,2), intent(in) :: Sr !< Right-column top interface salinity (ppt) - real, dimension(nk,2), intent(in) :: dRdT_r !< Right-column, top interface dRho/dT (kg/m3/degC) - real, dimension(nk,2), intent(in) :: dRdS_r !< Right-column, top interface dRho/dS (kg/m3/ppt) - logical, dimension(nk), intent(in) :: stable_r !< Left-column, top interface dRho/dS (kg/m3/ppt) + real, dimension(nk,2), intent(in) :: Tr !< Right-column top interface potential temperature [degC] + real, dimension(nk,2), intent(in) :: Sr !< Right-column top interface salinity [ppt] + real, dimension(nk,2), intent(in) :: dRdT_r !< Right-column, top interface dRho/dT [kg m-3 degC-1] + real, dimension(nk,2), intent(in) :: dRdS_r !< Right-column, top interface dRho/dS [kg m-3 ppt-1] + logical, dimension(nk), intent(in) :: stable_r !< Right-column, top interface is stable real, dimension(4*nk), intent(inout) :: PoL !< Fractional position of neutral surface within !! layer KoL of left column real, dimension(4*nk), intent(inout) :: PoR !< Fractional position of neutral surface within @@ -2050,9 +2051,9 @@ end function test_fvlsq_slope !> Returns true if a test of interpolate_for_nondim_position() fails, and conditionally writes results to stream logical function test_ifndp(verbose, rhoNeg, Pneg, rhoPos, Ppos, Ptrue, title) logical, intent(in) :: verbose !< If true, write results to stdout - real, intent(in) :: rhoNeg !< Lighter density (kg/m3) + real, intent(in) :: rhoNeg !< Lighter density [kg m-3] real, intent(in) :: Pneg !< Interface position of lighter density [Pa] - real, intent(in) :: rhoPos !< Heavier density (kg/m3) + real, intent(in) :: rhoPos !< Heavier density [kg m-3] real, intent(in) :: Ppos !< Interface position of heavier density [Pa] real, intent(in) :: Ptrue !< True answer [Pa] character(len=*), intent(in) :: title !< Title for messages diff --git a/src/tracer/MOM_neutral_diffusion_aux.F90 b/src/tracer/MOM_neutral_diffusion_aux.F90 index c25564b8da..88df1ddbc5 100644 --- a/src/tracer/MOM_neutral_diffusion_aux.F90 +++ b/src/tracer/MOM_neutral_diffusion_aux.F90 @@ -24,8 +24,8 @@ module MOM_neutral_diffusion_aux type, public :: ndiff_aux_CS_type ; private integer :: nterm !< Number of terms in polynomial (deg+1) integer :: max_iter !< Maximum number of iterations - real :: drho_tol !< Tolerance criterion for difference in density (kg/m3) - real :: xtol !< Criterion for how much position changes (nondim) + real :: drho_tol !< Tolerance criterion for difference in density [kg m-3] + real :: xtol !< Criterion for how much position changes [nondim] real :: ref_pres !< Determines whether a constant reference pressure is used everywhere or locally referenced !< density is done. ref_pres <-1 is the latter, ref_pres >= 0. otherwise logical :: force_brent = .false. !< Use Brent's method instead of Newton even when second derivatives are available @@ -62,10 +62,10 @@ end subroutine set_ndiff_aux_params !! For an layer to be unstable the top interface must be denser than the bottom or the bottom interface of the layer subroutine mark_unstable_cells(nk, dRdT, dRdS,T, S, stable_cell, ns) integer, intent(in) :: nk !< Number of levels in a column - real, dimension(nk,2), intent(in) :: dRdT !< drho/dT (kg/m3/degC) at interfaces - real, dimension(nk,2), intent(in) :: dRdS !< drho/dS (kg/m3/ppt) at interfaces - real, dimension(nk,2), intent(in) :: T !< drho/dS (kg/m3/ppt) at interfaces - real, dimension(nk,2), intent(in) :: S !< drho/dS (kg/m3/ppt) at interfaces + real, dimension(nk,2), intent(in) :: dRdT !< drho/dT [kg m-3 degC-1] at interfaces + real, dimension(nk,2), intent(in) :: dRdS !< drho/dS [kg m-3 ppt-1] at interfaces + real, dimension(nk,2), intent(in) :: T !< Temperature [degC] at interfaces + real, dimension(nk,2), intent(in) :: S !< Salinity [ppt] at interfaces logical, dimension(nk), intent( out) :: stable_cell !< True if this cell is unstably stratified integer, intent( out) :: ns !< Number of neutral surfaces in unmasked part of the column diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 4f6ce6b5bb..a4676583bd 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -158,10 +158,10 @@ module MOM_offline_main ! Fields at T-point real, allocatable, dimension(:,:,:) :: eatr !< Amount of fluid entrained from the layer above within - !! one time step (m for Bouss, kg/m^2 for non-Bouss) + !! one time step [H ~> m or kg m-2] real, allocatable, dimension(:,:,:) :: ebtr !< Amount of fluid entrained from the layer below within - !! one time step (m for Bouss, kg/m^2 for non-Bouss) + !! one time step [H ~> m or kg m-2] ! Fields at T-points on interfaces real, allocatable, dimension(:,:,:) :: Kd !< Vertical diffusivity real, allocatable, dimension(:,:,:) :: h_end !< Thicknesses at the end of offline timestep diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 03fc01ab06..201f8aeb6f 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -350,12 +350,11 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & !! for PPM interface values real, dimension(SZI_(G),ntr) :: & - slope_x ! The concentration slope per grid point in units of - ! concentration [nondim]. + slope_x ! The concentration slope per grid point [conc]. real, dimension(SZIB_(G),ntr) :: & - flux_x ! The tracer flux across a boundary in m3*conc or kg*conc. + flux_x ! The tracer flux across a boundary [H m2 conc ~> m3 conc or kg conc]. real :: maxslope ! The maximum concentration slope per grid point - ! consistent with monotonicity, in conc. (nondim.). + ! consistent with monotonicity [conc]. real :: hup, hlos ! hup is the upwind volume, hlos is the ! part of that volume that might be lost ! due to advection out the other side of @@ -363,8 +362,9 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & real :: uhh(SZIB_(G)) ! The zonal flux that occurs during the ! current iteration [H m2 ~> m3 or kg]. real, dimension(SZIB_(G)) :: & - hlst, Ihnew, & ! Work variables with units of [H m2 ~> m3 or kg] and [H-1 m-2 ~> m-3 or kg-1]. - CFL ! A nondimensional work variable. + hlst, & ! Work variable [H m2 ~> m3 or kg]. + Ihnew, & ! Work variable [H-1 m-2 ~> m-3 or kg-1]. + CFL ! A nondimensional work variable [nondim]. real :: min_h ! The minimum thickness that can be realized during ! any of the passes [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost @@ -678,12 +678,11 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & !! for PPM interface values real, dimension(SZI_(G),ntr,SZJ_(G)) :: & - slope_y ! The concentration slope per grid point in units of - ! concentration (nondim.). + slope_y ! The concentration slope per grid point [conc]. real, dimension(SZI_(G),ntr,SZJB_(G)) :: & - flux_y ! The tracer flux across a boundary in m3 * conc or kg*conc. + flux_y ! The tracer flux across a boundary [H m2 conc ~> m3 conc or kg conc]. real :: maxslope ! The maximum concentration slope per grid point - ! consistent with monotonicity, in conc. (nondim.). + ! consistent with monotonicity [conc]. real :: vhh(SZI_(G),SZJB_(G)) ! The meridional flux that occurs during the ! current iteration [H m2 ~> m3 or kg]. real :: hup, hlos ! hup is the upwind volume, hlos is the @@ -691,7 +690,8 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & ! due to advection out the other side of ! the grid box, both in [H m2 ~> m3 or kg]. real, dimension(SZIB_(G)) :: & - hlst, Ihnew, & ! Work variables with units of [H m2 ~> m3 or kg] and [H-1 m-2 ~> m-3 or kg-1]. + hlst, & ! Work variable [H m2 ~> m3 or kg]. + Ihnew, & ! Work variable [H-1 m-2 ~> m-3 or kg-1]. CFL ! A nondimensional work variable. real :: min_h ! The minimum thickness that can be realized during ! any of the passes [H ~> m or kg m-2]. diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index d7212ac8f0..f7f8028d91 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -231,7 +231,7 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, intent(in ) :: evap_CFL_limit !< Limit on the fraction of the !! water that can be fluxed out of the top - !! layer in a timestep (nondim) + !! layer in a timestep [nondim] real, intent(in ) :: minimum_forcing_depth !< The smallest depth over !! which fluxes can be applied [m] real, dimension(SZI_(G),SZJ_(G)), optional, intent(in ) :: in_flux_optional !< The total time-integrated diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index eb33e423ec..a3c75bd7fd 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -430,7 +430,7 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, logical, intent(in) :: debug !< If true calculate checksums real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of !! the water that can be fluxed out - !! of the top layer in a timestep (nondim) + !! of the top layer in a timestep [nondim] real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over !! which fluxes can be applied [H ~> m or kg m-2] diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index c5f581e976..48ec698696 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -126,8 +126,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla ! grid cell [H-1 m-2 ~> m-3 or kg-1]. Kh_h, & ! The tracer diffusivity averaged to tracer points [m2 s-1]. CFL, & ! A diffusive CFL number for each cell [nondim]. - dTr ! The change in a tracer's concentration, in units of - ! concentration [Conc]. + dTr ! The change in a tracer's concentration, in units of concentration [Conc]. real, dimension(SZIB_(G),SZJ_(G)) :: & khdt_x, & ! The value of Khtr*dt times the open face width divided by diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index 6491006c7f..f5c7d65f03 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -37,42 +37,48 @@ module MOM_tracer_registry !> The tracer type type, public :: tracer_type - real, dimension(:,:,:), pointer :: t => NULL() !< tracer concentration array -! real :: OBC_inflow_conc= 0.0 !< tracer concentration for generic inflows + real, dimension(:,:,:), pointer :: t => NULL() !< tracer concentration array [conc] +! real :: OBC_inflow_conc= 0.0 !< tracer concentration for generic inflows [conc] ! real, dimension(:,:,:), pointer :: OBC_in_u => NULL() !< structured values for flow into the domain ! !! specified in OBCs through u-face of cell ! real, dimension(:,:,:), pointer :: OBC_in_v => NULL() !< structured values for flow into the domain ! !! specified in OBCs through v-face of cell real, dimension(:,:,:), pointer :: ad_x => NULL() !< diagnostic array for x-advective tracer flux + !! [conc H m2 s-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:,:), pointer :: ad_y => NULL() !< diagnostic array for y-advective tracer flux + !! [conc H m2 s-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), pointer :: ad2d_x => NULL() !< diagnostic vertical sum x-advective tracer flux - !! in units of (conc * m3/s or conc * kg/s) + !! [conc H m2 s-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), pointer :: ad2d_y => NULL() !< diagnostic vertical sum y-advective tracer flux - !! in units of (conc * m3/s or conc * kg/s) + !! [conc H m2 s-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:,:), pointer :: df_x => NULL() !< diagnostic array for x-diffusive tracer flux + !! [conc H m2 s-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:,:), pointer :: df_y => NULL() !< diagnostic array for y-diffusive tracer flux + !! [conc H m2 s-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), pointer :: df2d_x => NULL() !< diagnostic vertical sum x-diffusive flux - !! in units of (conc * m3/s or conc * kg/s) + !! [conc H m2 s-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), pointer :: df2d_y => NULL() !< diagnostic vertical sum y-diffusive flux - !! in units of (conc * m3/s or conc * kg/s) + !! [conc H m2 s-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), pointer :: df2d_conc_x => NULL() !< diagnostic vertical sum x-diffusive content flux - !! in units of (conc * m3/s or conc * kg/s) + !! [conc H m2 s-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), pointer :: df2d_conc_y => NULL() !< diagnostic vertical sum y-diffusive content flux - !! in units of (conc * m3/s or conc * kg/s) + !! [conc H m2 s-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:,:), pointer :: advection_xy => NULL() !< convergence of lateral advective tracer fluxes + !! [conc H s-1 ~> conc m s-1 or conc kg m-2 s-1] real, dimension(:,:,:), pointer :: diff_cont_xy => NULL() !< convergence of lateral diffusive tracer fluxes + !! [conc H s-1 ~> conc m s-1 or conc kg m-2 s-1] real, dimension(:,:,:), pointer :: diff_conc_xy => NULL() !< convergence of lateral diffusive tracer fluxes - !! expressed as a change in concentration + !! expressed as a change in concentration [conc s-1] real, dimension(:,:,:), pointer :: t_prev => NULL() !< tracer concentration array at a previous - !! timestep used for diagnostics + !! timestep used for diagnostics [conc] real, dimension(:,:,:), pointer :: Trxh_prev => NULL() !< layer integrated tracer concentration array !! at a previous timestep used for diagnostics character(len=32) :: name !< tracer name used for diagnostics and error messages - character(len=64) :: units !< Physical dimensions of the variable + character(len=64) :: units !< Physical dimensions of the tracer concentration character(len=240) :: longname !< Long name of the variable ! type(vardesc), pointer :: vd => NULL() !< metadata describing the tracer logical :: registry_diags = .false. !< If true, use the registry to set up the diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index d235989885..34f788c952 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -282,7 +282,7 @@ subroutine advection_test_tracer_column_physics(h_old, h_new, ea, eb, fluxes, type(advection_test_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_advection_test_tracer. real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can - !! be fluxed out of the top layer in a timestep (nondim) + !! be fluxed out of the top layer in a timestep [nondim] real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which !! fluxes can be applied [m] ! This subroutine applies diapycnal diffusion and any other column diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index e874a9c9ec..fa95d8aa77 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -231,7 +231,7 @@ subroutine boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, !! thermodynamic variables logical, intent(in) :: debug !< If true calculate checksums real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can - !! be fluxed out of the top layer in a timestep (nondim) + !! be fluxed out of the top layer in a timestep [nondim] real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which !! fluxes can be applied [m] @@ -285,17 +285,17 @@ end subroutine boundary_impulse_tracer_column_physics !> Calculate total inventory of tracer function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index) - type(ocean_grid_type), intent(in ) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(:), intent( out) :: stocks !< the mass-weighted integrated amount of each - !! tracer, in kg times concentration units [kg conc]. - type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous - !! call to register_boundary_impulse_tracer. - character(len=*), dimension(:), intent( out) :: names !< The names of the stocks calculated. - character(len=*), dimension(:), intent( out) :: units !< The units of the stocks calculated. - integer, optional, intent(in ) :: stock_index !< The coded index of a specific stock - !! being sought. + type(ocean_grid_type), intent(in ) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(:), intent( out) :: stocks !< the mass-weighted integrated amount of each + !! tracer, in kg times concentration units [kg conc]. + type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_boundary_impulse_tracer. + character(len=*), dimension(:), intent( out) :: names !< The names of the stocks calculated. + character(len=*), dimension(:), intent( out) :: units !< The units of the stocks calculated. + integer, optional, intent(in ) :: stock_index !< The coded index of a specific stock + !! being sought. integer :: boundary_impulse_stock !< Return value: the number of stocks calculated here. ! This function calculates the mass-weighted integral of all tracer stocks, diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index bc1df121ab..51b5ab6c08 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -269,7 +269,7 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS type(dye_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_dye_tracer. real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can - !! be fluxed out of the top layer in a timestep (nondim) + !! be fluxed out of the top layer in a timestep [nondim] real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which !! fluxes can be applied [m] diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index c8852687f2..7abbafa5fc 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -224,7 +224,7 @@ subroutine dyed_obc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, type(dyed_obc_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to dyed_obc_register_tracer. real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can - !! be fluxed out of the top layer in a timestep (nondim) + !! be fluxed out of the top layer in a timestep [nondim] real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which !! fluxes can be applied [m] diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index d648a902eb..562947a011 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -304,7 +304,7 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_ideal_age_tracer. real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can - !! be fluxed out of the top layer in a timestep (nondim) + !! be fluxed out of the top layer in a timestep [nondim] real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which !! fluxes can be applied [m] ! This subroutine applies diapycnal diffusion and any other column diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index e200d2c5a7..6156c20e24 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -46,7 +46,7 @@ module oil_tracer real :: oil_source_latitude !< Longitude of source location (geographic) integer :: oil_source_i=-999 !< Local i of source location (computational) integer :: oil_source_j=-999 !< Local j of source location (computational) - real :: oil_source_rate !< Rate of oil injection (kg/s) + real :: oil_source_rate !< Rate of oil injection [kg s-1] real :: oil_start_year !< The year in which tracers start aging, or at which the !! surface value equals young_val, in years. real :: oil_end_year !< The year in which tracers start aging, or at which the @@ -59,7 +59,7 @@ module oil_tracer real, dimension(NTR_MAX) :: land_val = -1.0 !< The value of tr used where land is masked out. real, dimension(NTR_MAX) :: sfc_growth_rate !< The exponential growth rate for the surface value [year-1]. real, dimension(NTR_MAX) :: oil_decay_days !< Decay time scale of oil [days] - real, dimension(NTR_MAX) :: oil_decay_rate !< Decay rate of oil (in s^-1) calculated from oil_decay_days + real, dimension(NTR_MAX) :: oil_decay_rate !< Decay rate of oil [s-1] calculated from oil_decay_days integer, dimension(NTR_MAX) :: oil_source_k !< Layer of source logical :: oil_may_reinit !< If true, oil tracers may be reset by the initialization code !! if they are not found in the restart files. @@ -321,7 +321,7 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS !! call to register_oil_tracer. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can - !! be fluxed out of the top layer in a timestep (nondim) + !! be fluxed out of the top layer in a timestep [nondim] real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which !! fluxes can be applied [m] ! This subroutine applies diapycnal diffusion and any other column diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index 9f39537cb4..1234e4a1b4 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -197,7 +197,7 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables logical, intent(in) :: debug !< If true calculate checksums real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can - !! be fluxed out of the top layer in a timestep (nondim) + !! be fluxed out of the top layer in a timestep [nondim] real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which !! fluxes can be applied [m] From dea748adc442256c81252b3c5e8b012ea2c1581a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 29 Jan 2019 14:02:57 -0500 Subject: [PATCH 0991/1072] Documented 170 variable units Changed comments to use the square bracket notation to document the units of about 170 variables, many of them heat fluxes, themodynamic variables or nondimensional ratios. Only comments have been changed and all answers are bitwise identical. --- src/ALE/MOM_regridding.F90 | 49 ++++---- src/ALE/MOM_remapping.F90 | 2 +- src/ALE/coord_hycom.F90 | 16 +-- src/ALE/coord_sigma.F90 | 2 +- src/ALE/coord_slight.F90 | 12 +- src/core/MOM.F90 | 4 +- src/core/MOM_PressureForce_analytic_FV.F90 | 2 +- src/core/MOM_PressureForce_blocked_AFV.F90 | 2 +- src/core/MOM_forcing_type.F90 | 108 +++++++++--------- src/core/MOM_isopycnal_slopes.F90 | 12 +- src/core/MOM_open_boundary.F90 | 10 +- src/core/MOM_variables.F90 | 6 +- src/diagnostics/MOM_diag_to_Z.F90 | 8 +- src/diagnostics/MOM_diagnostics.F90 | 18 +-- src/diagnostics/MOM_wave_speed.F90 | 2 +- src/diagnostics/MOM_wave_structure.F90 | 14 +-- src/equation_of_state/MOM_EOS.F90 | 4 +- src/framework/MOM_io.F90 | 4 +- src/ice_shelf/MOM_ice_shelf.F90 | 4 +- .../MOM_fixed_initialization.F90 | 14 ++- .../MOM_state_initialization.F90 | 4 +- src/initialization/midas_vertmap.F90 | 2 +- src/user/BFB_surface_forcing.F90 | 35 +++--- src/user/DOME2d_initialization.F90 | 4 +- src/user/MOM_wave_interface.F90 | 16 +-- src/user/baroclinic_zone_initialization.F90 | 18 +-- src/user/dumbbell_surface_forcing.F90 | 13 +-- src/user/seamount_initialization.F90 | 4 +- src/user/sloshing_initialization.F90 | 4 +- src/user/user_change_diffusivity.F90 | 4 +- src/user/user_initialization.F90 | 4 +- 31 files changed, 197 insertions(+), 204 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index db97286f95..8a3f0ca29a 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -87,7 +87,7 @@ module MOM_regridding !> Reference pressure for potential density calculations (Pa) real :: ref_pressure = 2.e7 - !> Weight given to old coordinate when blending between new and old grids (nondim) + !> Weight given to old coordinate when blending between new and old grids [nondim] !! Used only below depth_of_time_filter_shallow, with a cubic variation !! from zero to full effect between depth_of_time_filter_shallow and !! depth_of_time_filter_deep. @@ -100,7 +100,7 @@ module MOM_regridding real :: depth_of_time_filter_deep = 0. !> Fraction (between 0 and 1) of compressibility to add to potential density - !! profiles when interpolating for target grid positions. (nondim) + !! profiles when interpolating for target grid positions. [nondim] real :: compressibility_fraction = 0. !> If true, each interface is given a maximum depth based on a rescaling of @@ -184,6 +184,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m character(len=*), intent(in) :: param_prefix !< String to prefix to parameter names. !! If empty, causes main model parameters to be used. character(len=*), intent(in) :: param_suffix !< String to append to parameter names. + ! Local variables integer :: ke ! Number of levels character(len=80) :: string, string2, varName ! Temporary strings @@ -194,18 +195,19 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m logical :: tmpLogical, fix_haloclines, set_max, do_sum, main_parameters logical :: coord_is_state_dependent, ierr real :: filt_len, strat_tol, index_scale, tmpReal - real :: maximum_depth !< The maximum depth of the ocean [m] (not in Z). + real :: maximum_depth ! The maximum depth of the ocean [m] (not in Z). real :: dz_fixed_sfc, Rho_avg_depth, nlay_sfc_int real :: adaptTimeRatio, adaptZoom, adaptZoomCoeff, adaptBuoyCoeff, adaptAlpha integer :: nz_fixed_sfc, k, nzf(4) - real, dimension(:), allocatable :: dz ! Resolution (thickness) in units of coordinate + real, dimension(:), allocatable :: dz ! Resolution (thickness) in units of coordinate, which may be + ! [m] or [Z ~> m] or [H ~> m or kg m-2] or [kg m-3] or other units. real, dimension(:), allocatable :: h_max ! Maximum layer thicknesses [H ~> m or kg m-2] real, dimension(:), allocatable :: z_max ! Maximum interface depths [H ~> m or kg m-2] or other ! units depending on the coordinate real, dimension(:), allocatable :: dz_max ! Thicknesses used to find maximum interface depths ! [H ~> m or kg m-2] or other units - real, dimension(:), allocatable :: rho_target ! Target density used in HYBRID mode - ! Thicknesses that give level centers corresponding to table 2 of WOA09 + real, dimension(:), allocatable :: rho_target ! Target density used in HYBRID mode [kg m-3] + ! Thicknesses [m] that give level centers corresponding to table 2 of WOA09 real, dimension(40) :: woa09_dz = (/ 5., 10., 10., 15., 22.5, 25., 25., 25., & 37.5, 50., 50., 75., 100., 100., 100., 100., & 100., 100., 100., 100., 100., 100., 100., 175., & @@ -918,10 +920,11 @@ end subroutine calc_h_new_by_dz !> Check that the total thickness of two grids match subroutine check_remapping_grid( G, GV, h, dzInterface, msg ) - type(ocean_grid_type), intent(in) :: G !< Grid structure - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses (m) - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: dzInterface !< Change in interface positions (m) + type(ocean_grid_type), intent(in) :: G !< Grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: dzInterface !< Change in interface positions + !! [H ~> m or kg m-2] character(len=*), intent(in) :: msg !< Message to append to errors ! Local variables integer :: i, j @@ -936,8 +939,8 @@ end subroutine check_remapping_grid !> Check that the total thickness of new and old grids are consistent subroutine check_grid_column( nk, depth, h, dzInterface, msg ) integer, intent(in) :: nk !< Number of cells - real, intent(in) :: depth !< Depth of bottom (m or arbitrary units) - real, dimension(nk), intent(in) :: h !< Cell thicknesses (m or arbitrary units) + real, intent(in) :: depth !< Depth of bottom [Z ~> m] or arbitrary units + real, dimension(nk), intent(in) :: h !< Cell thicknesses [Z ~> m] or arbitrary units real, dimension(nk+1), intent(in) :: dzInterface !< Change in interface positions (same units as h) character(len=*), intent(in) :: msg !< Message to append to errors ! Local variables @@ -998,9 +1001,9 @@ end subroutine check_grid_column subroutine filtered_grid_motion( CS, nk, z_old, z_new, dz_g ) type(regridding_CS), intent(in) :: CS !< Regridding control structure integer, intent(in) :: nk !< Number of cells in source grid - real, dimension(nk+1), intent(in) :: z_old !< Old grid position (m) - real, dimension(CS%nk+1), intent(in) :: z_new !< New grid position (m) - real, dimension(CS%nk+1), intent(inout) :: dz_g !< Change in interface positions (m) + real, dimension(nk+1), intent(in) :: z_old !< Old grid position [m] + real, dimension(CS%nk+1), intent(in) :: z_new !< New grid position [m] + real, dimension(CS%nk+1), intent(inout) :: dz_g !< Change in interface positions [m] ! Local variables real :: sgn ! The sign convention for downward. real :: dz_tgt, zr1, z_old_k @@ -1475,7 +1478,7 @@ subroutine build_grid_HyCOM1( G, GV, h, tv, h_new, dzInterface, CS ) z_col(1) = 0. ! Work downward rather than bottom up do K = 1, GV%ke - z_col(K+1) = z_col(K) + h(i,j,k) ! Work in units of [H ~> m or kg m-2] + z_col(K+1) = z_col(K) + h(i,j,k) p_col(k) = CS%ref_pressure + CS%compressibility_fraction * & ( 0.5 * ( z_col(K) + z_col(K+1) ) * GV%H_to_Pa - CS%ref_pressure ) enddo @@ -1607,7 +1610,7 @@ subroutine build_grid_SLight(G, GV, h, tv, dzInterface, CS) depth = G%bathyT(i,j) * GV%Z_to_H z_col(1) = 0. ! Work downward rather than bottom up do K=1,nz - z_col(K+1) = z_col(K) + h(i, j, k) ! Work in units of [H ~> m or kg m-2] + z_col(K+1) = z_col(K) + h(i,j,k) p_col(k) = CS%ref_pressure + CS%compressibility_fraction * & ( 0.5 * ( z_col(K) + z_col(K+1) ) * GV%H_to_Pa - CS%ref_pressure ) enddo @@ -2221,19 +2224,19 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri real, optional, intent(in) :: Rho_ml_avg_depth !< Averaging depth over which to determine mixed layer potential !! density [H ~> m or kg m-2] real, optional, intent(in) :: nlay_ML_to_interior !< Number of layers to offset the mixed layer density to find - !! resolved stratification (nondim) + !! resolved stratification [nondim] logical, optional, intent(in) :: fix_haloclines !< Detect regions with much weaker stratification in the coordinate real, optional, intent(in) :: halocline_filt_len !< Length scale over which to filter T & S when looking for - !! spuriously unstable water mass profiles (m) + !! spuriously unstable water mass profiles [m] real, optional, intent(in) :: halocline_strat_tol !< Value of the stratification ratio that defines a problematic !! halocline region. logical, optional, intent(in) :: integrate_downward_for_e !< If true, integrate for interface positions downward !! from the top. - real, optional, intent(in) :: adaptTimeRatio !< Ratio of the ALE timestep to the grid timescale, ND. + real, optional, intent(in) :: adaptTimeRatio !< Ratio of the ALE timestep to the grid timescale [nondim]. real, optional, intent(in) :: adaptZoom !< Depth of near-surface zooming region [H ~> m or kg m-2]. - real, optional, intent(in) :: adaptZoomCoeff !< Coefficient of near-surface zooming diffusivity, ND. - real, optional, intent(in) :: adaptBuoyCoeff !< Coefficient of buoyancy diffusivity, ND. - real, optional, intent(in) :: adaptAlpha !< Scaling factor on optimization tendency, ND. + real, optional, intent(in) :: adaptZoomCoeff !< Coefficient of near-surface zooming diffusivity [nondim]. + real, optional, intent(in) :: adaptBuoyCoeff !< Coefficient of buoyancy diffusivity [nondim]. + real, optional, intent(in) :: adaptAlpha !< Scaling factor on optimization tendency [nondim]. logical, optional, intent(in) :: adaptDoMin !< If true, make a HyCOM-like mixed layer by !! preventing interfaces from being shallower than !! the depths specified by the regridding coordinate. diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index c0620122c1..f399aa2c0f 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -71,7 +71,7 @@ module MOM_remapping ! outside of the range 0 to 1. #define __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ -real, parameter :: hNeglect_dflt = 1.E-30 !< A dimensional (H units) number that can be +real, parameter :: hNeglect_dflt = 1.E-30 !< A thickness [H ~> m or kg m-2] that can be !! added to thicknesses in a denominator without !! changing the numerical result, except where !! a division by zero would otherwise occur. diff --git a/src/ALE/coord_hycom.F90 b/src/ALE/coord_hycom.F90 index 4b38c683c7..6928425e33 100644 --- a/src/ALE/coord_hycom.F90 +++ b/src/ALE/coord_hycom.F90 @@ -39,8 +39,8 @@ module coord_hycom subroutine init_coord_hycom(CS, nk, coordinateResolution, target_density, interp_CS) type(hycom_CS), pointer :: CS !< Unassociated pointer to hold the control structure integer, intent(in) :: nk !< Number of layers in generated grid - real, dimension(nk), intent(in) :: coordinateResolution !< Nominal near-surface resolution (m) - real, dimension(nk+1),intent(in) :: target_density !< Interface target densities (kg/m3) + real, dimension(nk), intent(in) :: coordinateResolution !< Nominal near-surface resolution [m] + real, dimension(nk+1),intent(in) :: target_density !< Interface target densities [kg m-3] type(interp_CS_type), intent(in) :: interp_CS !< Controls for interpolation if (associated(CS)) call MOM_error(FATAL, "init_coord_hycom: CS already associated!") @@ -100,13 +100,13 @@ subroutine build_hycom1_column(CS, eqn_of_state, nz, depth, h, T, S, p_col, & type(EOS_type), pointer :: eqn_of_state !< Equation of state structure integer, intent(in) :: nz !< Number of levels real, intent(in) :: depth !< Depth of ocean bottom (positive [H ~> m or kg m-2]) - real, dimension(nz), intent(in) :: T !< Temperature of column (degC) - real, dimension(nz), intent(in) :: S !< Salinity of column (psu) - real, dimension(nz), intent(in) :: h !< Layer thicknesses, (in m or H) - real, dimension(nz), intent(in) :: p_col !< Layer pressure in Pa + real, dimension(nz), intent(in) :: T !< Temperature of column [degC] + real, dimension(nz), intent(in) :: S !< Salinity of column [ppt] + real, dimension(nz), intent(in) :: h !< Layer thicknesses, in [m] or [H ~> m or kg m-2] + real, dimension(nz), intent(in) :: p_col !< Layer pressure [Pa] real, dimension(nz+1), intent(in) :: z_col !< Interface positions relative to the surface [H ~> m or kg m-2] real, dimension(CS%nk+1), intent(inout) :: z_col_new !< Absolute positions of interfaces - real, optional, intent(in) :: zScale !< Scaling factor from the input thicknesses in m + real, optional, intent(in) :: zScale !< Scaling factor from the input thicknesses in [m] !! to desired units for zInterface, perhaps m_to_H. real, optional, intent(in) :: h_neglect !< A negligibly small width for the !! purpose of cell reconstructions @@ -121,7 +121,7 @@ subroutine build_hycom1_column(CS, eqn_of_state, nz, depth, h, T, S, p_col, & real, dimension(CS%nk) :: h_col_new ! New layer thicknesses real :: z_scale real :: stretching ! z* stretching, converts z* to z. - real :: nominal_z ! Nominal depth of interface is using z* (m or Pa) + real :: nominal_z ! Nominal depth of interface when using z* [Z ~> m] real :: hNew logical :: maximum_depths_set ! If true, the maximum depths of interface have been set. logical :: maximum_h_set ! If true, the maximum layer thicknesses have been set. diff --git a/src/ALE/coord_sigma.F90 b/src/ALE/coord_sigma.F90 index 0abc0c8e2b..3bf666ec52 100644 --- a/src/ALE/coord_sigma.F90 +++ b/src/ALE/coord_sigma.F90 @@ -28,7 +28,7 @@ module coord_sigma subroutine init_coord_sigma(CS, nk, coordinateResolution) type(sigma_CS), pointer :: CS !< Unassociated pointer to hold the control structure integer, intent(in) :: nk !< Number of layers in the grid - real, dimension(:), intent(in) :: coordinateResolution !< Nominal coordinate resolution (nondim) + real, dimension(:), intent(in) :: coordinateResolution !< Nominal coordinate resolution [nondim] if (associated(CS)) call MOM_error(FATAL, "init_coord_sigma: CS already associated!") allocate(CS) diff --git a/src/ALE/coord_slight.F90 b/src/ALE/coord_slight.F90 index d510388414..fa726548b8 100644 --- a/src/ALE/coord_slight.F90 +++ b/src/ALE/coord_slight.F90 @@ -24,14 +24,14 @@ module coord_slight real :: ref_pressure !> Fraction (between 0 and 1) of compressibility to add to potential density - !! profiles when interpolating for target grid positions. (nondim) + !! profiles when interpolating for target grid positions. [nondim] real :: compressibility_fraction ! The following 4 parameters were introduced for use with the SLight coordinate: !> Depth over which to average to determine the mixed layer potential density [H ~> m or kg m-2] real :: Rho_ML_avg_depth - !> Number of layers to offset the mixed layer density to find resolved stratification (nondim) + !> Number of layers to offset the mixed layer density to find resolved stratification [nondim] real :: nlay_ml_offset !> The number of fixed-thickness layers at the top of the model @@ -48,7 +48,7 @@ module coord_slight !! unstable water mass profiles [H ~> m or kg m-2]. real :: halocline_filter_length - !> A value of the stratification ratio that defines a problematic halocline region (nondim). + !> A value of the stratification ratio that defines a problematic halocline region [nondim]. real :: halocline_strat_tol !> Nominal density of interfaces [kg m-3]. @@ -124,7 +124,7 @@ subroutine set_slight_params(CS, max_interface_depths, max_layer_thickness, & !! new grid through regridding [H ~> m or kg m-2] real, optional, intent(in) :: compressibility_fraction !< Fraction (between 0 and 1) of !! compressibility to add to potential density profiles when - !! interpolating for target grid positions. (nondim) + !! interpolating for target grid positions. [nondim] real, optional, intent(in) :: dz_ml_min !< The fixed resolution in the topmost !! SLight_nkml_min layers [H ~> m or kg m-2] integer, optional, intent(in) :: nz_fixed_surface !< The number of fixed-thickness layers at the @@ -132,13 +132,13 @@ subroutine set_slight_params(CS, max_interface_depths, max_layer_thickness, & real, optional, intent(in) :: Rho_ML_avg_depth !< Depth over which to average to determine !! the mixed layer potential density [H ~> m or kg m-2] real, optional, intent(in) :: nlay_ML_offset !< Number of layers to offset the mixed layer - !! density to find resolved stratification (nondim) + !! density to find resolved stratification [nondim] logical, optional, intent(in) :: fix_haloclines !< If true, detect regions with much weaker than !! based on in-situ density, and use a stretched coordinate there. real, optional, intent(in) :: halocline_filter_length !< A length scale over which to filter T & S !! when looking for spuriously unstable water mass profiles [H ~> m or kg m-2]. real, optional, intent(in) :: halocline_strat_tol !< A value of the stratification ratio that - !! defines a problematic halocline region (nondim). + !! defines a problematic halocline region [nondim]. type(interp_CS_type), & optional, intent(in) :: interp_CS !< Controls for interpolation diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index b5490ab497..1b364d7ef0 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -466,7 +466,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & logical :: therm_reset ! If true, reset running sums of thermodynamic quantities. real :: cycle_time ! The length of the coupled time-stepping cycle [s]. real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: & - ssh ! sea surface height, which may be based on eta_av (meter) + ssh ! sea surface height, which may be based on eta_av [m] real, dimension(:,:,:), pointer :: & u => NULL(), & ! u : zonal velocity component [m s-1] @@ -2488,7 +2488,7 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) type(unit_scale_type), pointer :: US => NULL() ! Pointer to a structure containing ! various unit conversion factors type(MOM_restart_CS), pointer :: restart_CSp_tmp => NULL() - real, allocatable :: z_interface(:,:,:) ! Interface heights (meter) + real, allocatable :: z_interface(:,:,:) ! Interface heights [m] type(vardesc) :: vd call cpu_clock_begin(id_clock_init) diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 97bc80ef7f..1bb1fe9c5a 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -175,7 +175,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p ! to reduce the impact of truncation errors. real :: rho_in_situ(SZI_(G)) ! The in situ density [kg m-3]. real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). -! real :: oneatm = 101325.0 ! 1 atm in Pa (kg/ms2) +! real :: oneatm = 101325.0 ! 1 atm in [Pa] = [kg m-1 s-2] real, parameter :: C1_6 = 1.0/6.0 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer :: i, j, k diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index d94adf7872..5c6cbd3dcb 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -172,7 +172,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, ! to reduce the impact of truncation errors. real :: rho_in_situ(SZI_(G)) ! The in situ density [kg m-3]. real :: Pa_to_H ! A factor to convert from Pa to the thicknesss units (H). -! real :: oneatm = 101325.0 ! 1 atm in Pa (kg/ms2) +! real :: oneatm = 101325.0 ! 1 atm in [Pa] = [kg m-1 s-2] real, parameter :: C1_6 = 1.0/6.0 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer :: is_bk, ie_bk, js_bk, je_bk, Isq_bk, Ieq_bk, Jsq_bk, Jeq_bk diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index f6fc793946..4cc413926d 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -56,60 +56,60 @@ module MOM_forcing_type ! surface buoyancy force, used when temperature is not a state variable real, pointer, dimension(:,:) :: & - buoy => NULL() !< buoyancy flux (m^2/s^3) + buoy => NULL() !< buoyancy flux [m2 s-3] - ! radiative heat fluxes into the ocean (W/m^2) + ! radiative heat fluxes into the ocean [W m-2] real, pointer, dimension(:,:) :: & - sw => NULL(), & !< shortwave (W/m^2) - sw_vis_dir => NULL(), & !< visible, direct shortwave (W/m^2) - sw_vis_dif => NULL(), & !< visible, diffuse shortwave (W/m^2) - sw_nir_dir => NULL(), & !< near-IR, direct shortwave (W/m^2) - sw_nir_dif => NULL(), & !< near-IR, diffuse shortwave (W/m^2) - lw => NULL() !< longwave (W/m^2) (typically negative) - - ! turbulent heat fluxes into the ocean (W/m^2) + sw => NULL(), & !< shortwave [W m-2] + sw_vis_dir => NULL(), & !< visible, direct shortwave [W m-2] + sw_vis_dif => NULL(), & !< visible, diffuse shortwave [W m-2] + sw_nir_dir => NULL(), & !< near-IR, direct shortwave [W m-2] + sw_nir_dif => NULL(), & !< near-IR, diffuse shortwave [W m-2] + lw => NULL() !< longwave [W m-2] (typically negative) + + ! turbulent heat fluxes into the ocean [W m-2] real, pointer, dimension(:,:) :: & - latent => NULL(), & !< latent (W/m^2) (typically < 0) - sens => NULL(), & !< sensible (W/m^2) (typically negative) - heat_added => NULL() !< additional heat flux from SST restoring or flux adjustments (W/m^2) + latent => NULL(), & !< latent [W m-2] (typically < 0) + sens => NULL(), & !< sensible [W m-2] (typically negative) + heat_added => NULL() !< additional heat flux from SST restoring or flux adjustments [W m-2] ! components of latent heat fluxes used for diagnostic purposes real, pointer, dimension(:,:) :: & - latent_evap_diag => NULL(), & !< latent (W/m^2) from evaporating liquid water (typically < 0) - latent_fprec_diag => NULL(), & !< latent (W/m^2) from melting fprec (typically < 0) - latent_frunoff_diag => NULL() !< latent (W/m^2) from melting frunoff (calving) (typically < 0) + latent_evap_diag => NULL(), & !< latent [W m-2] from evaporating liquid water (typically < 0) + latent_fprec_diag => NULL(), & !< latent [W m-2] from melting fprec (typically < 0) + latent_frunoff_diag => NULL() !< latent [W m-2] from melting frunoff (calving) (typically < 0) - ! water mass fluxes into the ocean ( kg/(m^2 s) ); these fluxes impact the ocean mass + ! water mass fluxes into the ocean [kg m-2 s-1]; these fluxes impact the ocean mass real, pointer, dimension(:,:) :: & - evap => NULL(), & !< (-1)*fresh water flux evaporated out of the ocean ( kg/(m^2 s) ) - lprec => NULL(), & !< precipitating liquid water into the ocean ( kg/(m^2 s) ) - fprec => NULL(), & !< precipitating frozen water into the ocean ( kg/(m^2 s) ) - vprec => NULL(), & !< virtual liquid precip associated w/ SSS restoring ( kg/(m^2 s) ) - lrunoff => NULL(), & !< liquid river runoff entering ocean ( kg/(m^2 s) ) - frunoff => NULL(), & !< frozen river runoff (calving) entering ocean ( kg/(m^2 s) ) - seaice_melt => NULL(), & !< seaice melt (positive) or formation (negative) ( kg/(m^2 s) ) - netMassIn => NULL(), & !< Sum of water mass flux out of the ocean ( kg/(m^2 s) ) - netMassOut => NULL(), & !< Net water mass flux into of the ocean ( kg/(m^2 s) ) - netSalt => NULL() !< Net salt entering the ocean + evap => NULL(), & !< (-1)*fresh water flux evaporated out of the ocean [kg m-2 s-1] + lprec => NULL(), & !< precipitating liquid water into the ocean [kg m-2 s-1] + fprec => NULL(), & !< precipitating frozen water into the ocean [kg m-2 s-1] + vprec => NULL(), & !< virtual liquid precip associated w/ SSS restoring [kg m-2 s-1] + lrunoff => NULL(), & !< liquid river runoff entering ocean [kg m-2 s-1] + frunoff => NULL(), & !< frozen river runoff (calving) entering ocean [kg m-2 s-1] + seaice_melt => NULL(), & !< seaice melt (positive) or formation (negative) [kg m-2 s-1] + netMassIn => NULL(), & !< Sum of water mass flux out of the ocean [kg m-2 s-1] + netMassOut => NULL(), & !< Net water mass flux into of the ocean [kg m-2 s-1] + netSalt => NULL() !< Net salt entering the ocean [kgSalt m-2 s-1] ! heat associated with water crossing ocean surface real, pointer, dimension(:,:) :: & - heat_content_cond => NULL(), & !< heat content associated with condensating water (W/m^2) - heat_content_lprec => NULL(), & !< heat content associated with liquid >0 precip (W/m^2) (diagnostic) - heat_content_fprec => NULL(), & !< heat content associated with frozen precip (W/m^2) - heat_content_vprec => NULL(), & !< heat content associated with virtual >0 precip (W/m^2) - heat_content_lrunoff => NULL(), & !< heat content associated with liquid runoff (W/m^2) - heat_content_frunoff => NULL(), & !< heat content associated with frozen runoff (W/m^2) - heat_content_icemelt => NULL(), & !< heat content associated with liquid sea ice (W/m^2) - heat_content_massout => NULL(), & !< heat content associated with mass leaving ocean (W/m^2) - heat_content_massin => NULL() !< heat content associated with mass entering ocean (W/m^2) + heat_content_cond => NULL(), & !< heat content associated with condensating water [W m-2] + heat_content_lprec => NULL(), & !< heat content associated with liquid >0 precip [W m-2] (diagnostic) + heat_content_fprec => NULL(), & !< heat content associated with frozen precip [W m-2] + heat_content_vprec => NULL(), & !< heat content associated with virtual >0 precip [W m-2] + heat_content_lrunoff => NULL(), & !< heat content associated with liquid runoff [W m-2] + heat_content_frunoff => NULL(), & !< heat content associated with frozen runoff [W m-2] + heat_content_icemelt => NULL(), & !< heat content associated with liquid sea ice [W m-2] + heat_content_massout => NULL(), & !< heat content associated with mass leaving ocean [W m-2] + heat_content_massin => NULL() !< heat content associated with mass entering ocean [W m-2] ! salt mass flux (contributes to ocean mass only if non-Bouss ) real, pointer, dimension(:,:) :: & - salt_flux => NULL(), & !< net salt flux into the ocean ( kg salt/(m^2 s) ) - salt_flux_in => NULL(), & !< salt flux provided to the ocean from coupler ( kg salt/(m^2 s) ) + salt_flux => NULL(), & !< net salt flux into the ocean [kgSalt m-2 s-1] + salt_flux_in => NULL(), & !< salt flux provided to the ocean from coupler [kgSalt m-2 s-1] salt_flux_added => NULL() !< additional salt flux from restoring or flux adjustment before adjustment - !! to net zero ( kg salt/(m^2 s) ) + !! to net zero [kgSalt m-2 s-1] ! applied surface pressure from other component models (e.g., atmos, sea ice, land ice) real, pointer, dimension(:,:) :: p_surf_full => NULL() @@ -119,7 +119,7 @@ module MOM_forcing_type !< Pressure at the top ocean interface [Pa] as used to drive the ocean model. !! If p_surf is limited, p_surf may be smaller than p_surf_full, otherwise they are the same. real, pointer, dimension(:,:) :: p_surf_SSH => NULL() - !< Pressure at the top ocean interface that is used in corrections to the sea surface + !< Pressure at the top ocean interface [Pa] that is used in corrections to the sea surface !! height field that is passed back to the calling routines. !! p_surf_SSH may point to p_surf or to p_surf_full. logical :: accumulate_p_surf = .false. !< If true, the surface pressure due to the atmosphere @@ -129,14 +129,14 @@ module MOM_forcing_type ! tide related inputs real, pointer, dimension(:,:) :: & - TKE_tidal => NULL(), & !< tidal energy source driving mixing in bottom boundary layer (W/m^2) + TKE_tidal => NULL(), & !< tidal energy source driving mixing in bottom boundary layer [W m-2] ustar_tidal => NULL() !< tidal contribution to bottom ustar [m s-1] ! iceberg related inputs real, pointer, dimension(:,:) :: & ustar_berg => NULL(), & !< iceberg contribution to top ustar [Z s-1 ~> m s-1]. - area_berg => NULL(), & !< area of ocean surface covered by icebergs (m2/m2) - mass_berg => NULL() !< mass of icebergs (kg/m2) + area_berg => NULL(), & !< area of ocean surface covered by icebergs [m2 m-2] + mass_berg => NULL() !< mass of icebergs [kg m-2] ! land ice-shelf related inputs real, pointer, dimension(:,:) :: ustar_shelf => NULL() !< Friction velocity under ice-shelves [Z s-1 ~> m s-1]. @@ -146,15 +146,15 @@ module MOM_forcing_type !! associated if ice shelves are enabled, and are !! exactly 0 away from shelves or on land. real, pointer, dimension(:,:) :: iceshelf_melt => NULL() !< Ice shelf melt rate (positive) - !! or freezing (negative) (in m/year) + !! or freezing (negative) [m year-1] ! Scalars set by surface forcing modules - real :: vPrecGlobalAdj !< adjustment to restoring vprec to zero out global net ( kg/(m^2 s) ) - real :: saltFluxGlobalAdj !< adjustment to restoring salt flux to zero out global net ( kg salt/(m^2 s) ) - real :: netFWGlobalAdj !< adjustment to net fresh water to zero out global net ( kg/(m^2 s) ) - real :: vPrecGlobalScl !< scaling of restoring vprec to zero out global net ( -1..1 ) - real :: saltFluxGlobalScl !< scaling of restoring salt flux to zero out global net ( -1..1 ) - real :: netFWGlobalScl !< scaling of net fresh water to zero out global net ( -1..1 ) + real :: vPrecGlobalAdj !< adjustment to restoring vprec to zero out global net [kg m-2 s-1] + real :: saltFluxGlobalAdj !< adjustment to restoring salt flux to zero out global net [kgSalt m-2 s-1] + real :: netFWGlobalAdj !< adjustment to net fresh water to zero out global net [kg m-2 s-1] + real :: vPrecGlobalScl !< scaling of restoring vprec to zero out global net ( -1..1 ) [nondim] + real :: saltFluxGlobalScl !< scaling of restoring salt flux to zero out global net ( -1..1 ) [nondim] + real :: netFWGlobalScl !< scaling of net fresh water to zero out global net ( -1..1 ) [nondim] logical :: fluxes_used = .true. !< If true, all of the heat, salt, and mass !! fluxes have been applied to the ocean. @@ -162,7 +162,7 @@ module MOM_forcing_type !! should be applied [s]. If negative, this forcing !! type variable has not yet been inialized. - real :: C_p !< heat capacity of seawater ( J/(K kg) ). + real :: C_p !< heat capacity of seawater [J kg-1 degC-1]. !! C_p is is the same value as in thermovar_ptrs_type. ! passive tracer surface fluxes @@ -884,9 +884,9 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, ! The surface forcing is contained in the fluxes type. ! We aggregate the thermodynamic forcing for a time step into the following: - ! netH = water (H units/s) added/removed via surface fluxes - ! netHeat = heat (degC * H/s) via surface fluxes - ! netSalt = salt ( g(salt)/m2 for non-Bouss and ppt*m for Bouss /s) via surface fluxes + ! netH = water added/removed via surface fluxes [H s-1 ~> m s-1 or kg m-2 s-1] + ! netHeat = heat via surface fluxes [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] + ! netSalt = salt via surface fluxes [ppt H s-1 ~> ppt m s-1 or gSalt m-2 s-1] ! Note that unlike other calls to extractFLuxes1d() that return the time-integrated flux ! this call returns the rate because dt=1 call extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index e5e2045c7a..f5775fc2c4 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -35,14 +35,14 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & !! thermodynamic variables real, intent(in) :: dt_kappa_smooth !< A smoothing vertical diffusivity !! times a smoothing timescale [Z2 ~> m2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: slope_x !< Isopycnal slope in i-direction (nondim) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: slope_y !< Isopycnal slope in j-direction (nondim) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: slope_x !< Isopycnal slope in i-direction [nondim] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: slope_y !< Isopycnal slope in j-direction [nondim] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: N2_u !< Brunt-Vaisala frequency squared at - !! interfaces between u-points (s-2) + !! interfaces between u-points [s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), & optional, intent(inout) :: N2_v !< Brunt-Vaisala frequency squared at - !! interfaces between u-points (s-2) + !! interfaces between u-points [s-2] integer, optional, intent(in) :: halo !< Halo width over which to compute ! real, optional, intent(in) :: eta_to_m !< The conversion factor from the units @@ -234,7 +234,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & slope_x(I,j,K) = 0.0 endif - if (present_N2_u) N2_u(I,j,k) = G_Rho0 * drdz * G%mask2dCu(I,j) ! Square of Brunt-Vaisala frequency (s-2) + if (present_N2_u) N2_u(I,j,k) = G_Rho0 * drdz * G%mask2dCu(I,j) ! Square of Brunt-Vaisala frequency [s-2] else ! With .not.use_EOS, the layers are constant density. slope_x(I,j,K) = (Z_to_L*(e(i,j,K)-e(i+1,j,K))) * G%IdxCu(I,j) @@ -318,7 +318,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & slope_y(i,J,K) = 0.0 endif - if (present_N2_v) N2_v(i,J,k) = G_Rho0 * drdz * G%mask2dCv(i,J) ! Square of Brunt-Vaisala frequency (s-2) + if (present_N2_v) N2_v(i,J,k) = G_Rho0 * drdz * G%mask2dCv(i,J) ! Square of Brunt-Vaisala frequency [s-2] else ! With .not.use_EOS, the layers are constant density. slope_y(i,J,K) = (Z_to_L*(e(i,j,K)-e(i,j+1,K))) * G%IdyCv(i,J) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index c78c08933e..c59eafc4c2 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -151,7 +151,7 @@ module MOM_open_boundary real, pointer, dimension(:,:,:) :: tangential_grad=>NULL() !< The gradient of the velocity tangential !! to the OB segment [m s-1]. real, pointer, dimension(:,:,:) :: normal_trans=>NULL() !< The layer transport normal to the OB - !! segment (m3 s-1). + !! segment [m3 s-1]. real, pointer, dimension(:,:) :: normal_vel_bt=>NULL() !< The barotropic velocity normal to !! the OB segment [m s-1]. real, pointer, dimension(:,:) :: eta=>NULL() !< The sea-surface elevation along the segment [m]. @@ -1412,8 +1412,8 @@ end subroutine open_boundary_impose_normal_slope subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv) type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(dyn_horgrid_type), intent(inout) :: G !< Ocean grid structure - real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: areaCu !< Area of a u-cell (m2) - real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: areaCv !< Area of a u-cell (m2) + real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: areaCu !< Area of a u-cell [m2] + real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: areaCv !< Area of a u-cell [m2] ! Local variables integer :: i, j, n type(OBC_segment_type), pointer :: segment => NULL() @@ -2921,7 +2921,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(ocean_OBC_type), pointer :: OBC !< Open boundary structure type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(inout) :: h !< Thickness + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(inout) :: h !< Thickness [m] type(time_type), intent(in) :: Time !< Model time ! Local variables integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed @@ -2930,7 +2930,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) character(len=200) :: filename, OBC_file, inputdir ! Strings for file/path type(OBC_segment_type), pointer :: segment => NULL() integer, dimension(4) :: siz,siz2 - real :: sumh ! column sum of thicknesses (m) + real :: sumh ! column sum of thicknesses [m] integer :: ni_seg, nj_seg ! number of src gridpoints along the segments integer :: i2, j2 ! indices for referencing local domain array integer :: is_obc, ie_obc, js_obc, je_obc ! segment indices within local domain diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 92b5f4f918..c623848c15 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -45,8 +45,8 @@ module MOM_variables v, & !< The mixed layer meridional velocity [m s-1]. sea_lev, & !< The sea level [m]. If a reduced surface gravity is !! used, that is compensated for in sea_lev. - melt_potential, & !< instantaneous amount of heat that can be used to melt sea ice, - !! in J m-2. This is computed w.r.t. surface freezing temperature. + melt_potential, & !< Instantaneous amount of heat that can be used to melt sea ice [J m-2]. + !! This is computed w.r.t. surface freezing temperature. ocean_mass, & !< The total mass of the ocean [kg m-2]. ocean_heat, & !< The total heat content of the ocean in [degC kg m-2]. ocean_salt, & !< The total salt content of the ocean in [kgSalt m-2]. @@ -219,7 +219,7 @@ module MOM_variables real, pointer, dimension(:,:) :: kv_tbl_shelf_v => NULL() !< Viscosity in the viscous top boundary layer under ice shelves at v-points [Z2 s-1 ~> m2 s-1]. real, pointer, dimension(:,:) :: nkml_visc_u => NULL() - !< The number of layers in the viscous surface mixed layer at u-points (nondimensional). + !< The number of layers in the viscous surface mixed layer at u-points [nondim]. !! This is not an integer because there may be fractional layers, and it is stored in !! terms of layers, not depth, to facilitate the movement of the viscous boundary layer !! with the flow. diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index 07769f6077..3c50f00061 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -177,11 +177,11 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, US, CS) real :: htot ! summed layer thicknesses [H ~> m or kg m-2] real :: dilate ! proportion by which to dilate every layer real :: wt(SZK_(G)+1) ! fractional weight for each layer in the - ! range between k_top and k_bot (nondim) + ! range between k_top and k_bot [nondim] real :: z1(SZK_(G)+1) ! z1 and z2 are the depths of the top and bottom real :: z2(SZK_(G)+1) ! limits of the part of a layer that contributes ! to a depth level, relative to the cell center - ! and normalized by the cell thickness (nondim) + ! and normalized by the cell thickness [nondim] ! Note that -1/2 <= z1 < z2 <= 1/2. real :: sl_tr(max(CS%num_tr_used,1)) ! normalized slope of the tracer ! within the cell, in tracer units @@ -674,10 +674,10 @@ subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z real, dimension(:), intent(out) :: wt !< Relative weights of each layer from k_top to k_bot. real, dimension(:), intent(out) :: z1 !< Depth of the top limits of the part of !! a layer that contributes to a depth level, relative to the cell center and normalized - !! by the cell thickness (nondim). Note that -1/2 <= z1 < z2 <= 1/2. + !! by the cell thickness [nondim]. Note that -1/2 <= z1 < z2 <= 1/2. real, dimension(:), intent(out) :: z2 !< Depths of the bottom limit of the part of !! a layer that contributes to a depth level, relative to the cell center and normalized - !! by the cell thickness (nondim). Note that -1/2 <= z1 < z2 <= 1/2. + !! by the cell thickness [nondim]. Note that -1/2 <= z1 < z2 <= 1/2. ! Local variables real :: Ih, e_c, tot_wt, I_totwt integer :: k diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index caa0f3cd00..cd3c87b922 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -233,13 +233,13 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & real :: pressure_1d(SZI_(G)) ! Temporary array for pressure when calling EOS real :: wt, wt_p - ! squared Coriolis parameter at to h-points (1/s2) + ! squared Coriolis parameter at to h-points [s-2] real :: f2_h - ! magnitude of the gradient of f (1/(m*s)) + ! magnitude of the gradient of f [s-1 m-1] real :: mag_beta - ! frequency squared used to avoid division by 0 (1/s2) + ! frequency squared used to avoid division by 0 [s-2] ! value is roughly (pi / (the age of the universe) )^2. real, parameter :: absurdly_small_freq2 = 1e-34 @@ -327,7 +327,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & call post_data(CS%id_masso, masso, CS%diag) endif - ! diagnose thickness/volumes of grid cells (meter) + ! diagnose thickness/volumes of grid cells [m] if (CS%id_thkcello>0 .or. CS%id_volcello>0) then if (GV%Boussinesq) then ! thkcello = h for Boussinesq if (CS%id_thkcello > 0) then ; if (GV%H_to_m == 1.0) then @@ -359,7 +359,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & do i=is,ie ! Pressure for EOS at the layer center [Pa] pressure_1d(i) = pressure_1d(i) + 0.5*GV%H_to_Pa*h(i,j,k) enddo - ! Store in-situ density (kg/m3) in work_3d + ! Store in-situ density [kg m-3] in work_3d call calculate_density(tv%T(:,j,k),tv%S(:,j,k), pressure_1d, & work_3d(:,j,k), is, ie-is+1, tv%eqn_of_state) do i=is,ie ! Cell thickness = dz = dp/(g*rho) (meter); store in work_3d @@ -1140,7 +1140,7 @@ subroutine post_surface_dyn_diags(IDs, G, diag, sfc_state, ssh) type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output type(surface), intent(in) :: sfc_state !< structure describing the ocean surface state real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: ssh !< Time mean surface height without corrections for ice displacement (m) + intent(in) :: ssh !< Time mean surface height without corrections for ice displacement [m] ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: work_2d ! A 2-d work array @@ -1181,13 +1181,13 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv type(surface), intent(in) :: sfc_state !< structure describing the ocean surface state type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: ssh !< Time mean surface height without corrections for ice displacement (m) + intent(in) :: ssh !< Time mean surface height without corrections for ice displacement [m] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ssh_ibc !< Time mean surface height with corrections - !! for ice displacement and the inverse barometer (m) + !! for ice displacement and the inverse barometer [m] real, dimension(SZI_(G),SZJ_(G)) :: work_2d ! A 2-d work array real, dimension(SZI_(G),SZJ_(G)) :: & - zos ! dynamic sea lev (zero area mean) from inverse-barometer adjusted ssh (meter) + zos ! dynamic sea lev (zero area mean) from inverse-barometer adjusted ssh [m] real :: I_time_int ! The inverse of the time interval [s-1]. real :: zos_area_mean, volo, ssh_ga integer :: i, j, is, ie, js, je diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 872c6f4783..0c4b0386a4 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -67,7 +67,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & !! monotonic for the purposes of calculating vertical !! modal structure [m]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - optional, intent(out) :: modal_structure !< Normalized model structure (non-dim) + optional, intent(out) :: modal_structure !< Normalized model structure [nondim] ! Local variables real, dimension(SZK_(G)+1) :: & diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 64592e7303..28ad4c6bfc 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -99,15 +99,12 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo !! gravity wave speed [m s-1]. integer, intent(in) :: ModeNum !< Mode number real, intent(in) :: freq !< Intrinsic wave frequency [s-1]. - type(wave_structure_CS), pointer :: CS !< The control structure returned - !! by a previous call to - !! wave_structure_init. + type(wave_structure_CS), pointer :: CS !< The control structure returned by a + !! previous call to wave_structure_init. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(in) :: En !< Internal wave energy density, - !! in Jm-2. + optional, intent(in) :: En !< Internal wave energy density [J m-2]. logical,optional, intent(in) :: full_halos !< If true, do the calculation - !! over the entire computational - !! domain. + !! over the entire computational domain. ! Local variables real, dimension(SZK_(G)+1) :: & dRho_dT, dRho_dS, & @@ -115,8 +112,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo gprime ! The reduced gravity across each interface [m2 Z-1 s-2 ~> m s-2]. real, dimension(SZK_(G)) :: & Igl, Igu ! The inverse of the reduced gravity across an interface times - ! the thickness of the layer below (Igl) or above (Igu) it, - ! [s2 m-2]. + ! the thickness of the layer below (Igl) or above (Igu) it [s2 m-2]. real, dimension(SZK_(G),SZI_(G)) :: & Hf, Tf, Sf, Rf real, dimension(SZK_(G)) :: & diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index e4435a60df..4538f9c8ae 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -200,7 +200,7 @@ subroutine calculate_spec_vol_scalar(T, S, pressure, specvol, EOS, spv_ref) real, intent(in) :: T !< Potential temperature referenced to the surface [degC] real, intent(in) :: S !< Salinity [ppt] real, intent(in) :: pressure !< Pressure [Pa] - real, intent(out) :: specvol !< specific volume (in-situ if pressure is local) (m3 kg-1) + real, intent(out) :: specvol !< specific volume (in-situ if pressure is local) [m3 kg-1] type(EOS_type), pointer :: EOS !< Equation of state structure real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. @@ -1379,7 +1379,7 @@ subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_t real, intent(in) :: P_t !< Anomalous pressure of top of cell, relative to g*rho_ref*z_t [Pa] real, intent(in) :: P_tgt !< Target pressure at height z_out, relative to g*rho_ref*z_out [Pa] real, intent(in) :: rho_ref !< Reference density with which calculation are anomalous to - real, intent(in) :: G_e !< Gravitational acceleration (m2 Z-1 s-2) + real, intent(in) :: G_e !< Gravitational acceleration [m2 Z-1 s-2 ~> m s-2] type(EOS_type), pointer :: EOS !< Equation of state structure real, intent(out) :: P_b !< Pressure at the bottom of the cell [Pa] real, intent(out) :: z_out !< Absolute depth at which anomalous pressure = p_tgt [Z ~> m]. diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index db0afa3d8a..c516c96e86 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -97,7 +97,7 @@ subroutine create_file(unit, filename, vars, novars, fields, threading, timeunit integer, intent(in) :: novars !< number of fields written to filename type(fieldtype), intent(inout) :: fields(:) !< array of fieldtypes for each variable integer, optional, intent(in) :: threading !< SINGLE_FILE or MULTIPLE - real, optional, intent(in) :: timeunit !< length, in seconds, of the units for time. The + real, optional, intent(in) :: timeunit !< length of the units for time [s]. The !! default value is 86400.0, for 1 day. type(ocean_grid_type), optional, intent(in) :: G !< ocean horizontal grid structure; G or dG !! is required if the new file uses any @@ -357,7 +357,7 @@ subroutine reopen_file(unit, filename, vars, novars, fields, threading, timeunit integer, intent(in) :: novars !< number of fields written to filename type(fieldtype), intent(inout) :: fields(:) !< array of fieldtypes for each variable integer, optional, intent(in) :: threading !< SINGLE_FILE or MULTIPLE - real, optional, intent(in) :: timeunit !< length, in seconds, of the units for time. The + real, optional, intent(in) :: timeunit !< length of the units for time [s]. The !! default value is 86400.0, for 1 day. type(ocean_grid_type), optional, intent(in) :: G !< ocean horizontal grid structure; G or dG !! is required if a new file uses any diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index f3f8e761b7..5cbf1f4056 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -629,7 +629,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) !!!!!!!!!!!!!!!!!!!!!!!!!!!!End of safety checks !!!!!!!!!!!!!!!!!!! enddo ; enddo ! i- and j-loops - ! mass flux (kg/s), part of ISOMIP diags. + ! mass flux [kg s-1], part of ISOMIP diags. mass_flux(:,:) = 0.0 mass_flux(:,:) = ISS%water_flux(:,:) * ISS%area_shelf_h(:,:) @@ -1056,7 +1056,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) enddo ; enddo if (CS%DEBUG) then - write(mesg,*) 'Mean melt flux (kg/(m^2 s)), dt = ', mean_melt_flux, CS%time_step + write(mesg,*) 'Mean melt flux [kg m-2 s-1], dt = ', mean_melt_flux, CS%time_step call MOM_mesg(mesg) call MOM_forcing_chksum("After constant sea level", fluxes, G, CS%US, haloshift=0) endif diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 761da880b4..c2f188bc6f 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -169,18 +169,20 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) end subroutine MOM_initialize_fixed !> MOM_initialize_topography makes the appropriate call to set up the bathymetry. At this -!! point the topography is in units of m, but this can be changed later. +!! point the topography is in units of [m], but this can be changed later. subroutine MOM_initialize_topography(D, max_depth, G, PF, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m + intent(out) :: D !< Ocean bottom depth [m] type(param_file_type), intent(in) :: PF !< Parameter file structure - real, intent(out) :: max_depth !< Maximum depth of model in m + real, intent(out) :: max_depth !< Maximum depth of model [m] type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type -! This subroutine makes the appropriate call to set up the bottom depth. -! This is a separate subroutine so that it can be made public and shared with -! the ice-sheet code or other components. + ! This subroutine makes the appropriate call to set up the bottom depth. + ! This is a separate subroutine so that it can be made public and shared with + ! the ice-sheet code or other components. + + ! Local variables real :: m_to_Z, Z_to_m ! Dimensional rescaling factors character(len=40) :: mdl = "MOM_initialize_topography" ! This subroutine's name. character(len=200) :: config diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 56c68001b8..d426550762 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -707,7 +707,7 @@ subroutine adjustEtaToFitBathymetry(G, GV, US, eta, h) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] ! Local variables integer :: i, j, k, is, ie, js, je, nz, contractions, dilations - real :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria (m) + real :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria [Z ~> m] real :: hTmp, eTmp, dilate character(len=100) :: mesg @@ -1164,7 +1164,7 @@ subroutine cut_off_column_top(nk, tv, GV, G_earth, depth, min_thickness, & real, dimension(nk), intent(in) :: S_t !< Salinity at top of layer [ppt] real, dimension(nk), intent(in) :: S_b !< Salinity at bottom of layer [ppt] real, intent(in) :: p_surf !< Imposed pressure on ocean at surface [Pa] - real, dimension(nk), intent(inout) :: h !< Layer thickness (H units, m or Pa) + real, dimension(nk), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] type(remapping_CS), pointer :: remap_CS !< Remapping structure for remapping T and S, !! if associated real, optional, intent(in) :: z_tol !< The tolerance with which to find the depth diff --git a/src/initialization/midas_vertmap.F90 b/src/initialization/midas_vertmap.F90 index 9277d42f21..a985cf2982 100644 --- a/src/initialization/midas_vertmap.F90 +++ b/src/initialization/midas_vertmap.F90 @@ -714,7 +714,7 @@ end subroutine meshgrid !! in each region is an approximation to del2(zi)=0 subject to !! boundary conditions along the valid points curve bounding this region. subroutine smooth_heights(zi,fill,bad,sor,niter,cyclic_x, tripolar_n) - real, dimension(:,:), intent(inout) :: zi !< interface positions (m) + real, dimension(:,:), intent(inout) :: zi !< interface positions [m] or arbitrary integer, dimension(size(zi,1),size(zi,2)), intent(in) :: fill !< points to be smoothed integer, dimension(size(zi,1),size(zi,2)), intent(in) :: bad !< ignore these points real, intent(in) :: sor !< successive over-relaxation coefficient (typically 0.6) diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 010e531973..4555a52f1d 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -24,27 +24,20 @@ module BFB_surface_forcing !> Control structure for BFB_surface_forcing type, public :: BFB_surface_forcing_CS ; private - logical :: use_temperature !< If true, temperature and salinity are used as - !! state variables. + logical :: use_temperature !< If true, temperature and salinity are used as state variables. logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. - real :: Rho0 !< The density used in the Boussinesq - !! approximation [kg m-3]. - real :: G_Earth !< The gravitational acceleration [m s-2] - real :: Flux_const !< The restoring rate at the surface [m s-1]. - real :: gust_const !< A constant unresolved background gustiness + real :: Rho0 !< The density used in the Boussinesq approximation [kg m-3]. + real :: G_Earth !< The gravitational acceleration [m s-2] + real :: Flux_const !< The restoring rate at the surface [m s-1]. + real :: gust_const !< A constant unresolved background gustiness !! that contributes to ustar [Pa]. - real :: SST_s !< SST at the southern edge of the linear - !! forcing ramp - real :: SST_n !< SST at the northern edge of the linear - !! forcing ramp - real :: lfrslat !< Southern latitude where the linear forcing ramp - !! begins - real :: lfrnlat !< Northern latitude where the linear forcing ramp - !! ends - real :: drho_dt !< Rate of change of density with temperature. - !! Note that temperature is being used as a dummy - !! variable here. All temperatures are converted - !! into density. + real :: SST_s !< SST at the southern edge of the linear forcing ramp [degC] + real :: SST_n !< SST at the northern edge of the linear forcing ramp [degC] + real :: lfrslat !< Southern latitude where the linear forcing ramp begins [degLat] + real :: lfrnlat !< Northern latitude where the linear forcing ramp ends [degLat] + real :: drho_dt !< Rate of change of density with temperature [kg m-3 degC-1]. + !! Note that temperature is being used as a dummy variable here. + !! All temperatures are converted into density. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. @@ -102,7 +95,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) ! Set whichever fluxes are to be used here. Any fluxes that ! are always zero do not need to be changed here. do j=js,je ; do i=is,ie - ! Fluxes of fresh water through the surface are in units of kg m-2 s-1 + ! Fluxes of fresh water through the surface are in units of [kg m-2 s-1] ! and are positive downward - i.e. evaporation should be negative. fluxes%evap(i,j) = -0.0 * G%mask2dT(i,j) fluxes%lprec(i,j) = 0.0 * G%mask2dT(i,j) @@ -110,7 +103,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) ! vprec will be set later, if it is needed for salinity restoring. fluxes%vprec(i,j) = 0.0 - ! Heat fluxes are in units of W m-2 and are positive into the ocean. + ! Heat fluxes are in units of [W m-2] and are positive into the ocean. fluxes%lw(i,j) = 0.0 * G%mask2dT(i,j) fluxes%latent(i,j) = 0.0 * G%mask2dT(i,j) fluxes%sens(i,j) = 0.0 * G%mask2dT(i,j) diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 365e10fdbf..b81061ab29 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -225,8 +225,8 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, eqn_of_state, just_read_params) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature (degC) - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity (ppt) + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature [degC] + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 260512ecfa..fedd46ab03 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -69,7 +69,7 @@ module MOM_wave_interface ! Surface Wave Dependent 1d/2d/3d vars real, allocatable, dimension(:), public :: & - WaveNum_Cen !< Wavenumber bands for read/coupled (1/m) + WaveNum_Cen !< Wavenumber bands for read/coupled [m-1] real, allocatable, dimension(:), public :: & Freq_Cen !< Frequency bands for read/coupled [s-1] real, allocatable, dimension(:), public :: & @@ -77,11 +77,11 @@ module MOM_wave_interface real, allocatable, dimension(:), public :: & PrescribedSurfStkY !< Surface Stokes drift if prescribed [m s-1] real, allocatable, dimension(:,:,:), public :: & - Us_x !< 3d Stokes drift profile (zonal, m/s) + Us_x !< 3d zonal Stokes drift profile [m s-1] !! Horizontal -> U points !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & - Us_y !< 3d Stokes drift profile (meridional, m/s) + Us_y !< 3d meridional Stokes drift profile [m s-1] !! Horizontal -> V points !! Vertical -> Mid-points real, allocatable, dimension(:,:), public :: & @@ -189,7 +189,7 @@ module MOM_wave_interface !> Initializes parameters related to MOM_wave_interface subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) - type(time_type), target, intent(in) :: Time !< Time (s) + type(time_type), target, intent(in) :: Time !< Model time type(ocean_grid_type), intent(inout) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -426,8 +426,8 @@ subroutine Update_Surface_Waves(G, GV, US, Day, dt, CS) type(ocean_grid_type), intent(inout) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(time_type), intent(in) :: Day !< Time (s) - type(time_type), intent(in) :: dt !< Timestep (s) + type(time_type), intent(in) :: Day !< Current model time + type(time_type), intent(in) :: dt !< Timestep as a time-type ! Local variables integer :: ii, jj, kk, b type(time_type) :: Day_Center @@ -966,7 +966,7 @@ end subroutine get_Langmuir_Number !! !! Original description: !! - This function returns the enhancement factor, given the 10-meter -!! wind [m s-1], friction velocity [m s-1] and the boundary layer depth (m). +!! wind [m s-1], friction velocity [m s-1] and the boundary layer depth [m]. !! !! Update (Jan/25): !! - Converted from function to subroutine, now returns Langmuir number. @@ -1102,7 +1102,7 @@ subroutine Get_SL_Average_Band( GV, AvgDepth, NB, WaveNumbers, SurfStokes, Avera real, intent(in) :: AvgDepth !< Depth to average over [Z ~> m]. integer, intent(in) :: NB !< Number of bands used real, dimension(NB), & - intent(in) :: WaveNumbers !< Wavenumber corresponding to each band (1/Z) + intent(in) :: WaveNumbers !< Wavenumber corresponding to each band [Z-1 ~> m-1] real, dimension(NB), & intent(in) :: SurfStokes !< Surface Stokes drift for each band [m s-1] real, intent(out) :: Average !< Output average Stokes drift over depth AvgDepth [m s-1] diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index 10ddf57ff2..8f3ad67ca9 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -33,15 +33,15 @@ subroutine bcz_params(G, GV, US, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handle - real, intent(out) :: S_ref !< Reference salinity (ppt) - real, intent(out) :: dSdz !< Salinity stratification (ppt/Z) - real, intent(out) :: delta_S !< Salinity difference across baroclinic zone (ppt) - real, intent(out) :: dSdx !< Linear salinity gradient (ppt/m) - real, intent(out) :: T_ref !< Reference temperature (ppt) - real, intent(out) :: dTdz !< Temperature stratification (ppt/Z) - real, intent(out) :: delta_T !< Temperature difference across baroclinic zone (ppt) - real, intent(out) :: dTdx !< Linear temperature gradient (ppt/m) - real, intent(out) :: L_zone !< Width of baroclinic zone (m) + real, intent(out) :: S_ref !< Reference salinity [ppt] + real, intent(out) :: dSdz !< Salinity stratification [ppt Z-1 ~> ppt m-1] + real, intent(out) :: delta_S !< Salinity difference across baroclinic zone [ppt] + real, intent(out) :: dSdx !< Linear salinity gradient [ppt m-1] + real, intent(out) :: T_ref !< Reference temperature [degC] + real, intent(out) :: dTdz !< Temperature stratification [degC Z-1 ~> degC m-1] + real, intent(out) :: delta_T !< Temperature difference across baroclinic zone [degC] + real, intent(out) :: dTdx !< Linear temperature gradient [degC m-1] + real, intent(out) :: L_zone !< Width of baroclinic zone [m] logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index ff5e7a1619..095884d232 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -26,11 +26,10 @@ module dumbbell_surface_forcing logical :: use_temperature !< If true, temperature and salinity are used as !! state variables. logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. - real :: Rho0 !< The density used in the Boussinesq - !! approximation [kg m-3]. - real :: G_Earth !< The gravitational acceleration [m s-2] - real :: Flux_const !< The restoring rate at the surface [m s-1]. - real :: gust_const !< A constant unresolved background gustiness + real :: Rho0 !< The density used in the Boussinesq approximation [kg m-3]. + real :: G_Earth !< The gravitational acceleration [m s-2] + real :: Flux_const !< The restoring rate at the surface [m s-1]. + real :: gust_const !< A constant unresolved background gustiness !! that contributes to ustar [Pa]. real :: slp_amplitude !< The amplitude of pressure loading [Pa] applied !! to the reservoirs @@ -98,7 +97,7 @@ subroutine dumbbell_buoyancy_forcing(state, fluxes, day, dt, G, CS) ! Set whichever fluxes are to be used here. Any fluxes that ! are always zero do not need to be changed here. do j=js,je ; do i=is,ie - ! Fluxes of fresh water through the surface are in units of kg m-2 s-1 + ! Fluxes of fresh water through the surface are in units of [kg m-2 s-1] ! and are positive downward - i.e. evaporation should be negative. fluxes%evap(i,j) = -0.0 * G%mask2dT(i,j) fluxes%lprec(i,j) = 0.0 * G%mask2dT(i,j) @@ -106,7 +105,7 @@ subroutine dumbbell_buoyancy_forcing(state, fluxes, day, dt, G, CS) ! vprec will be set later, if it is needed for salinity restoring. fluxes%vprec(i,j) = 0.0 - ! Heat fluxes are in units of W m-2 and are positive into the ocean. + ! Heat fluxes are in units of [W m-2] and are positive into the ocean. fluxes%lw(i,j) = 0.0 * G%mask2dT(i,j) fluxes%latent(i,j) = 0.0 * G%mask2dT(i,j) fluxes%sens(i,j) = 0.0 * G%mask2dT(i,j) diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 2c7dc2f530..6180ff2e00 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -195,8 +195,8 @@ subroutine seamount_initialize_temperature_salinity ( T, S, h, G, GV, param_file eqn_of_state, just_read_params) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature (degC) - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity (ppt) + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature [degC] + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index 37d7c1b8c9..990d43fda4 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -180,8 +180,8 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, param_file eqn_of_state, just_read_params) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature (degC). - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity (ppt). + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature [degC]. + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity [ppt]. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index 4d9fb72a4e..5a29614506 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -66,8 +66,8 @@ subroutine user_change_diff(h, tv, G, GV, CS, Kd_lay, Kd_int, T_f, S_f, Kd_int_a ! Local variables real :: Rcv(SZI_(G),SZK_(G)) ! The coordinate density in layers [kg m-3]. real :: p_ref(SZI_(G)) ! An array of tv%P_Ref pressures. - real :: rho_fn ! The density dependence of the input function, 0-1, ND. - real :: lat_fn ! The latitude dependence of the input function, 0-1, ND. + real :: rho_fn ! The density dependence of the input function, 0-1 [nondim]. + real :: lat_fn ! The latitude dependence of the input function, 0-1 [nondim]. logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. logical :: store_Kd_add ! Save the added diffusivity as a diagnostic if true. diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 7e6fc1f07e..1de9c3664a 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -137,8 +137,8 @@ end subroutine USER_initialize_velocity !! into T(:,:,:) and S(:,:,:). subroutine USER_init_temperature_salinity(T, S, G, param_file, eqn_of_state, just_read_params) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature (degC). - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity (ppt). + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature [degC]. + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity [ppt]. type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. From 06631bd9f1bd31b350ae495b4cab51f7b9370f68 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 30 Jan 2019 09:57:08 -0500 Subject: [PATCH 0992/1072] Documented 93 thermodynamic variable units Changed comments to use the square bracket notation to document the units of about 93 variables, including changing the units of salinity from PSU to ppt in many places. Only comments have been changed and all answers are bitwise identical. --- .../ice_solo_driver/user_surface_forcing.F90 | 20 +++++----- .../solo_driver/MESO_surface_forcing.F90 | 8 ++-- .../solo_driver/user_surface_forcing.F90 | 10 ++--- src/ALE/MOM_regridding.F90 | 4 +- src/ALE/coord_rho.F90 | 2 +- src/ALE/coord_slight.F90 | 2 +- src/core/MOM_PressureForce.F90 | 2 +- src/core/MOM_PressureForce_Montgomery.F90 | 2 +- src/core/MOM_PressureForce_analytic_FV.F90 | 10 ++--- src/core/MOM_PressureForce_blocked_AFV.F90 | 8 ++-- src/core/MOM_interface_heights.F90 | 2 +- src/core/MOM_isopycnal_slopes.F90 | 2 +- src/diagnostics/MOM_sum_output.F90 | 2 +- src/equation_of_state/MOM_EOS.F90 | 10 ++--- src/equation_of_state/MOM_EOS_UNESCO.F90 | 14 +++---- src/ice_shelf/MOM_ice_shelf.F90 | 8 ++-- .../MOM_coord_initialization.F90 | 15 ++++--- .../MOM_state_initialization.F90 | 2 +- .../vertical/MOM_bulk_mixed_layer.F90 | 40 +++++++++---------- .../vertical/MOM_diabatic_aux.F90 | 2 +- .../vertical/MOM_energetic_PBL.F90 | 4 +- .../vertical/MOM_entrain_diffusive.F90 | 2 +- .../vertical/MOM_kappa_shear.F90 | 22 +++++----- .../vertical/MOM_regularize_layers.F90 | 4 +- .../vertical/MOM_set_diffusivity.F90 | 16 ++++---- .../vertical/MOM_set_viscosity.F90 | 12 +++--- src/tracer/pseudo_salt_tracer.F90 | 4 +- src/user/BFB_surface_forcing.F90 | 6 +-- src/user/ISOMIP_initialization.F90 | 4 +- src/user/dumbbell_surface_forcing.F90 | 4 +- 30 files changed, 120 insertions(+), 123 deletions(-) diff --git a/config_src/ice_solo_driver/user_surface_forcing.F90 b/config_src/ice_solo_driver/user_surface_forcing.F90 index ce5f88b3ca..33c66a3c40 100644 --- a/config_src/ice_solo_driver/user_surface_forcing.F90 +++ b/config_src/ice_solo_driver/user_surface_forcing.F90 @@ -91,9 +91,9 @@ module user_surface_forcing contains -!> This subroutine sets the surface wind stresses, forces%taux and forces%tauy. +!> This subroutine sets the surface wind stresses, forces%taux and forces%tauy, in [Pa]. !! These are the stresses in the direction of the model grid (i.e. the same -!! direction as the u- and v- velocities.) They are both in Pa. +!! direction as the u- and v- velocities). subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. @@ -104,11 +104,9 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) type(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned !! by a previous call to user_surface_forcing_init -! This subroutine sets the surface wind stresses, forces%taux and forces%tauy. -! These are the stresses in the direction of the model grid (i.e. the same -! direction as the u- and v- velocities.) They are both in Pa. -! In addition, this subroutine can be used to set the surface friction -! velocity, forces%ustar [Z s-1 ~> m s-1]. This is needed with a bulk mixed layer. +! This subroutine sets the surface wind stresses, forces%taux and forces%tauy [Pa]. +! In addition, this subroutine can be used to set the surface friction velocity, +! forces%ustar [Z s-1 ~> m s-1], which is needed with a bulk mixed layer. integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -220,7 +218,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! Set whichever fluxes are to be used here. Any fluxes that ! are always zero do not need to be changed here. do j=js,je ; do i=is,ie - ! Fluxes of fresh water through the surface are in units of kg m-2 s-1 + ! Fluxes of fresh water through the surface are in units of [kg m-2 s-1] ! and are positive downward - i.e. evaporation should be negative. fluxes%evap(i,j) = -0.0 * G%mask2dT(i,j) fluxes%lprec(i,j) = 0.0 * G%mask2dT(i,j) @@ -228,7 +226,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! vprec will be set later, if it is needed for salinity restoring. fluxes%vprec(i,j) = 0.0 - ! Heat fluxes are in units of W m-2 and are positive into the ocean. + ! Heat fluxes are in units of [W m-2] and are positive into the ocean. fluxes%lw(i,j) = 0.0 * G%mask2dT(i,j) fluxes%latent(i,j) = 0.0 * G%mask2dT(i,j) fluxes%sens(i,j) = 0.0 * G%mask2dT(i,j) @@ -252,8 +250,8 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) rhoXcp = CS%Rho0 * fluxes%C_p do j=js,je ; do i=is,ie - ! Set Temp_restore and Salin_restore to the temperature (in C) and - ! salinity (in PSU) that are being restored toward. + ! Set Temp_restore and Salin_restore to the temperature (in degC) and + ! salinity (in ppt or PSU) that are being restored toward. Temp_restore = 0.0 Salin_restore = 0.0 diff --git a/config_src/solo_driver/MESO_surface_forcing.F90 b/config_src/solo_driver/MESO_surface_forcing.F90 index 4904b4f7eb..28dc5305f1 100644 --- a/config_src/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/solo_driver/MESO_surface_forcing.F90 @@ -137,7 +137,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! Set whichever fluxes are to be used here. Any fluxes that ! are always zero do not need to be changed here. do j=js,je ; do i=is,ie - ! Fluxes of fresh water through the surface are in units of kg m-2 s-1 + ! Fluxes of fresh water through the surface are in units of [kg m-2 s-1] ! and are positive downward - i.e. evaporation should be negative. fluxes%evap(i,j) = -0.0 * G%mask2dT(i,j) fluxes%lprec(i,j) = CS%PmE(i,j) * CS%Rho0 * G%mask2dT(i,j) @@ -145,7 +145,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! vprec will be set later, if it is needed for salinity restoring. fluxes%vprec(i,j) = 0.0 - ! Heat fluxes are in units of W m-2 and are positive into the ocean. + ! Heat fluxes are in units of [W m-2] and are positive into the ocean. fluxes%lw(i,j) = 0.0 * G%mask2dT(i,j) fluxes%latent(i,j) = 0.0 * G%mask2dT(i,j) fluxes%sens(i,j) = CS%Heat(i,j) * G%mask2dT(i,j) @@ -169,8 +169,8 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) rhoXcp = CS%Rho0 * fluxes%C_p do j=js,je ; do i=is,ie - ! Set Temp_restore and Salin_restore to the temperature (in C) and - ! salinity (in PSU) that are being restored toward. + ! Set Temp_restore and Salin_restore to the temperature (in degC) and + ! salinity (in ppt or PSU) that are being restored toward. if (G%mask2dT(i,j) > 0) then fluxes%heat_added(i,j) = G%mask2dT(i,j) * & ((CS%T_Restore(i,j) - sfc_state%SST(i,j)) * rhoXcp * CS%Flux_const) diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90 index 30589372be..a9787b9348 100644 --- a/config_src/solo_driver/user_surface_forcing.F90 +++ b/config_src/solo_driver/user_surface_forcing.F90 @@ -45,9 +45,9 @@ module user_surface_forcing contains -!> This subroutine sets the surface wind stresses, forces%taux and forces%tauy. +!> This subroutine sets the surface wind stresses, forces%taux and forces%tauy, in [Pa]. !! These are the stresses in the direction of the model grid (i.e. the same -!! direction as the u- and v- velocities.) They are both in Pa. +!! direction as the u- and v- velocities). subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. @@ -168,7 +168,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! Set whichever fluxes are to be used here. Any fluxes that ! are always zero do not need to be changed here. do j=js,je ; do i=is,ie - ! Fluxes of fresh water through the surface are in units of kg m-2 s-1 + ! Fluxes of fresh water through the surface are in units of [kg m-2 s-1] ! and are positive downward - i.e. evaporation should be negative. fluxes%evap(i,j) = -0.0 * G%mask2dT(i,j) fluxes%lprec(i,j) = 0.0 * G%mask2dT(i,j) @@ -200,8 +200,8 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) rhoXcp = CS%Rho0 * fluxes%C_p do j=js,je ; do i=is,ie - ! Set Temp_restore and Salin_restore to the temperature (in C) and - ! salinity (in PSU) that are being restored toward. + ! Set Temp_restore and Salin_restore to the temperature (in degC) and + ! salinity (in PSU or ppt) that are being restored toward. Temp_restore = 0.0 Salin_restore = 0.0 diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 8a3f0ca29a..2a1bcd5bcb 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -1453,7 +1453,7 @@ subroutine build_grid_HyCOM1( G, GV, h, tv, h_new, dzInterface, CS ) real, dimension(SZK_(GV)+1) :: z_col ! Source interface positions relative to the surface [H ~> m or kg m-2] real, dimension(CS%nk+1) :: z_col_new ! New interface positions relative to the surface [H ~> m or kg m-2] real, dimension(SZK_(GV)+1) :: dz_col ! The realized change in z_col [H ~> m or kg m-2] - real, dimension(SZK_(GV)) :: p_col ! Layer pressure in Pa + real, dimension(SZK_(GV)) :: p_col ! Layer center pressure [Pa] integer :: i, j, k, nki real :: depth real :: h_neglect, h_neglect_edge @@ -1586,7 +1586,7 @@ subroutine build_grid_SLight(G, GV, h, tv, dzInterface, CS) real, dimension(SZK_(GV)+1) :: z_col ! Interface positions relative to the surface [H ~> m or kg m-2] real, dimension(SZK_(GV)+1) :: z_col_new ! Interface positions relative to the surface [H ~> m or kg m-2] real, dimension(SZK_(GV)+1) :: dz_col ! The realized change in z_col [H ~> m or kg m-2] - real, dimension(SZK_(GV)) :: p_col ! Layer pressure in Pa + real, dimension(SZK_(GV)) :: p_col ! Layer center pressure [Pa] real :: depth integer :: i, j, k, nz real :: h_neglect, h_neglect_edge diff --git a/src/ALE/coord_rho.F90 b/src/ALE/coord_rho.F90 index b98844505f..452b3dfa09 100644 --- a/src/ALE/coord_rho.F90 +++ b/src/ALE/coord_rho.F90 @@ -46,7 +46,7 @@ module coord_rho subroutine init_coord_rho(CS, nk, ref_pressure, target_density, interp_CS) type(rho_CS), pointer :: CS !< Unassociated pointer to hold the control structure integer, intent(in) :: nk !< Number of layers in the grid - real, intent(in) :: ref_pressure !< Nominal density of interfaces in Pa + real, intent(in) :: ref_pressure !< Coordinate reference pressure [Pa] real, dimension(:), intent(in) :: target_density !< Nominal density of interfaces [kg m-3] type(interp_CS_type), intent(in) :: interp_CS !< Controls for interpolation diff --git a/src/ALE/coord_slight.F90 b/src/ALE/coord_slight.F90 index fa726548b8..8eb623d664 100644 --- a/src/ALE/coord_slight.F90 +++ b/src/ALE/coord_slight.F90 @@ -72,7 +72,7 @@ module coord_slight subroutine init_coord_slight(CS, nk, ref_pressure, target_density, interp_CS, m_to_H) type(slight_CS), pointer :: CS !< Unassociated pointer to hold the control structure integer, intent(in) :: nk !< Number of layers in the grid - real, intent(in) :: ref_pressure !< Nominal density of interfaces in Pa + real, intent(in) :: ref_pressure !< Coordinate reference pressure [Pa] real, dimension(:), intent(in) :: target_density !< Nominal density of interfaces [kg m-3] type(interp_CS_type), intent(in) :: interp_CS !< Controls for interpolation real, optional, intent(in) :: m_to_H !< A conversion factor from m to the units of thicknesses diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index 831fa6d1a3..110963789b 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -59,7 +59,7 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), & optional, pointer :: p_atm !< The pressure at the ice-ocean or - !! atmosphere-ocean interface in Pa. + !! atmosphere-ocean interface [Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: pbce !< The baroclinic pressure anomaly in each layer !! due to eta anomalies [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index eded96fa65..09d3e64266 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -388,7 +388,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, T_tmp, & ! Temporary array of temperatures where layers that are lighter ! than the mixed layer have the mixed layer's properties [degC]. S_tmp ! Temporary array of salinities where layers that are lighter - ! than the mixed layer have the mixed layer's properties [PSU]. + ! than the mixed layer have the mixed layer's properties [ppt]. real :: Rho_cv_BL(SZI_(G)) ! The coordinate potential density in ! the deepest variable density near-surface layer [kg m-3]. diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 1bb1fe9c5a..a8fcae3596 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -74,7 +74,7 @@ subroutine PressureForce_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbc type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean - !! or atmosphere-ocean interface in Pa. + !! or atmosphere-ocean interface [Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure !! anomaly in each layer due to eta anomalies !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. @@ -110,7 +110,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean - !! or atmosphere-ocean interface in Pa. + !! or atmosphere-ocean interface [Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure !! anomaly in each layer due to eta anomalies !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. @@ -118,12 +118,12 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal !! contributions or compressibility compensation. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure in Pa. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure [Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & T_tmp, & ! Temporary array of temperatures where layers that are lighter ! than the mixed layer have the mixed layer's properties [degC]. S_tmp ! Temporary array of salinities where layers that are lighter - ! than the mixed layer have the mixed layer's properties [PSU]. + ! than the mixed layer have the mixed layer's properties [ppt]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & S_t, & ! Top and bottom edge values for linear reconstructions S_b, & ! of salinity within each layer [ppt]. @@ -491,7 +491,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at T_tmp, & ! Temporary array of temperatures where layers that are lighter ! than the mixed layer have the mixed layer's properties [degC]. S_tmp ! Temporary array of salinities where layers that are lighter - ! than the mixed layer have the mixed layer's properties [PSU]. + ! than the mixed layer have the mixed layer's properties [ppt]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & S_t, S_b, T_t, T_b ! Top and bottom edge values for linear reconstructions ! of salinity and temperature within each layer. diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 5c6cbd3dcb..a675eebaf4 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -109,7 +109,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] type(PressureForce_blk_AFV_CS), pointer :: CS !< Finite volume PGF control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean - !! or atmosphere-ocean interface in Pa. + !! or atmosphere-ocean interface [Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure !! anomaly in each layer due to eta anomalies !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. @@ -122,7 +122,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, T_tmp, & ! Temporary array of temperatures where layers that are lighter ! than the mixed layer have the mixed layer's properties [degC]. S_tmp ! Temporary array of salinities where layers that are lighter - ! than the mixed layer have the mixed layer's properties [PSU]. + ! than the mixed layer have the mixed layer's properties [ppt]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & dza, & ! The change in geopotential anomaly between the top and bottom ! of a layer [m2 s-2]. @@ -434,7 +434,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, type(PressureForce_blk_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean - !! or atmosphere-ocean interface in Pa. + !! or atmosphere-ocean interface [Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: pbce !< The baroclinic pressure !! anomaly in each layer due to eta anomalies !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. @@ -472,7 +472,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, T_tmp, & ! Temporary array of temperatures where layers that are lighter ! than the mixed layer have the mixed layer's properties [degC]. S_tmp ! Temporary array of salinities where layers that are lighter - ! than the mixed layer have the mixed layer's properties [PSU]. + ! than the mixed layer have the mixed layer's properties [ppt]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & S_t, S_b, & ! Top and bottom edge salinities for linear reconstructions within each layer [ppt]. T_t, T_b ! Top and bottom edge temperatures for linear reconstructions within each layer [degC]. diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index 709a38f9d9..de0064932d 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -159,7 +159,7 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) !! the units of eta to m; by default this is US%Z_to_m. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & - p ! The pressure in Pa. + p ! The pressure at interfaces [Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & dz_geo ! The change in geopotential height across a layer [m2 s-2]. real :: htot(SZI_(G)) ! The sum of all layers' thicknesses [H ~> m or kg m-2]. diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index f5775fc2c4..11975aa5dc 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -51,7 +51,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & T, & ! The temperature [degC], with the values in ! in massless layers filled vertically by diffusion. - S, & ! The filled salinity [PSU], with the values in + S, & ! The filled salinity [ppt], with the values in ! in massless layers filled vertically by diffusion. Rho ! Density itself, when a nonlinear equation of state is not in use [kg m-3]. real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 3f3da7296c..e6dcbf11bc 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -737,7 +737,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ if (GV%Boussinesq) then mass_anom_EFP = mass_chg_EFP - CS%fresh_water_in_EFP else - ! net_salt_input needs to be converted from psu m s-1 to kg m-2 s-1. + ! net_salt_input needs to be converted from ppt m s-1 to kg m-2 s-1. mass_anom_EFP = mass_chg_EFP - CS%fresh_water_in_EFP if (CS%use_temperature) & salin_mass_in = 0.001*EFP_to_real(CS%net_salt_in_EFP) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 4538f9c8ae..b06ffa0a79 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -97,8 +97,8 @@ module MOM_EOS ! The following parameters are use with the linear expression for the freezing ! point only. real :: TFr_S0_P0 !< The freezing potential temperature at S=0, P=0 [degC]. - real :: dTFr_dS !< The derivative of freezing point with salinity [deg C ppt-1]. - real :: dTFr_dp !< The derivative of freezing point with pressure [deg C Pa-1]. + real :: dTFr_dS !< The derivative of freezing point with salinity [degC ppt-1]. + real :: dTFr_dp !< The derivative of freezing point with pressure [degC Pa-1]. ! logical :: test_EOS = .true. ! If true, test the equation of state end type EOS_type @@ -596,7 +596,7 @@ subroutine int_specific_vol_dp(T, S, p_t, p_b, alpha_ref, HI, EOS, & !! the y grid spacing [m2 s-2]. integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate dza. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - optional, intent(in) :: bathyP !< The pressure at the bathymetry in Pa + optional, intent(in) :: bathyP !< The pressure at the bathymetry [Pa] real, optional, intent(in) :: dP_tiny !< A miniscule pressure change with !! the same units as p_t (Pa?) logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting @@ -1956,7 +1956,7 @@ subroutine int_spec_vol_dp_generic(T, S, p_t, p_b, alpha_ref, HI, EOS, & !! the layer divided by the y grid spacing [m2 s-2]. integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate dza. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - optional, intent(in) :: bathyP !< The pressure at the bathymetry in Pa + optional, intent(in) :: bathyP !< The pressure at the bathymetry [Pa] real, optional, intent(in) :: dP_neglect !< A miniscule pressure change with !! the same units as p_t (Pa?) logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting @@ -2135,7 +2135,7 @@ subroutine int_spec_vol_dp_generic_plm(T_t, T_b, S_t, S_b, p_t, p_b, alpha_ref, real, intent(in) :: dP_neglect !< A miniscule pressure change with !! the same units as p_t (Pa?) real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: bathyP !< The pressure at the bathymetry in Pa + intent(in) :: bathyP !< The pressure at the bathymetry [Pa] type(EOS_type), pointer :: EOS !< Equation of state structure real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(out) :: dza !< The change in the geopotential anomaly diff --git a/src/equation_of_state/MOM_EOS_UNESCO.F90 b/src/equation_of_state/MOM_EOS_UNESCO.F90 index 1d3450d871..c7dbad3b66 100644 --- a/src/equation_of_state/MOM_EOS_UNESCO.F90 +++ b/src/equation_of_state/MOM_EOS_UNESCO.F90 @@ -17,15 +17,15 @@ module MOM_EOS_UNESCO public calculate_density_scalar_UNESCO, calculate_density_array_UNESCO !> Compute the in situ density of sea water (in [kg m-3]), or its anomaly with respect to -!! a reference density, from salinity (in psu), potential temperature (in deg C), and pressure in Pa, +!! a reference density, from salinity [PSU], potential temperature [degC], and pressure [Pa], !! using the UNESCO (1981) equation of state. interface calculate_density_UNESCO module procedure calculate_density_scalar_UNESCO, calculate_density_array_UNESCO end interface calculate_density_UNESCO !> Compute the in situ specific volume of sea water (in [m3 kg-1]), or an anomaly with respect -!! to a reference specific volume, from salinity (in psu), potential temperature (in deg C), and -!! pressure in Pa, using the UNESCO (1981) equation of state. +!! to a reference specific volume, from salinity [PSU], potential temperature [degC], and +!! pressure [Pa], using the UNESCO (1981) equation of state. interface calculate_spec_vol_UNESCO module procedure calculate_spec_vol_scalar_UNESCO, calculate_spec_vol_array_UNESCO end interface calculate_spec_vol_UNESCO @@ -55,7 +55,7 @@ module MOM_EOS_UNESCO !> This subroutine computes the in situ density of sea water (rho in !! [kg m-3]) from salinity (S [PSU]), potential temperature -!! (T [degC]), and pressure in Pa, using the UNESCO (1981) equation of state. +!! (T [degC]), and pressure [Pa], using the UNESCO (1981) equation of state. subroutine calculate_density_scalar_UNESCO(T, S, pressure, rho, rho_ref) real, intent(in) :: T !< Potential temperature relative to the surface [degC]. real, intent(in) :: S !< Salinity [PSU]. @@ -78,7 +78,7 @@ end subroutine calculate_density_scalar_UNESCO !> This subroutine computes the in situ density of sea water (rho in !! [kg m-3]) from salinity (S [PSU]), potential temperature -!! (T [degC]), and pressure in Pa, using the UNESCO (1981) equation of state. +!! (T [degC]), and pressure [Pa], using the UNESCO (1981) equation of state. subroutine calculate_density_array_UNESCO(T, S, pressure, rho, start, npts, rho_ref) real, dimension(:), intent(in) :: T !< potential temperature relative to the surface [degC]. real, dimension(:), intent(in) :: S !< salinity [PSU]. @@ -132,7 +132,7 @@ end subroutine calculate_density_array_UNESCO !> This subroutine computes the in situ specific volume of sea water (specvol in !! [m3 kg-1]) from salinity (S [PSU]), potential temperature (T [degC]) -!! and pressure in Pa, using the UNESCO (1981) equation of state. +!! and pressure [Pa], using the UNESCO (1981) equation of state. !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_scalar_UNESCO(T, S, pressure, specvol, spv_ref) real, intent(in) :: T !< potential temperature relative to the surface @@ -153,7 +153,7 @@ end subroutine calculate_spec_vol_scalar_UNESCO !> This subroutine computes the in situ specific volume of sea water (specvol in !! [m3 kg-1]) from salinity (S [PSU]), potential temperature (T [degC]) -!! and pressure in Pa, using the UNESCO (1981) equation of state. +!! and pressure [Pa], using the UNESCO (1981) equation of state. !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_array_UNESCO(T, S, pressure, specvol, start, npts, spv_ref) real, dimension(:), intent(in) :: T !< potential temperature relative to the surface diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 5cbf1f4056..fa4d2b0581 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -213,7 +213,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) dR0_dT, & !< Partial derivative of the mixed layer density !< with temperature [kg m-3 degC-1]. dR0_dS, & !< Partial derivative of the mixed layer density - !< with salinity [kg m-3 PSU-1]. + !< with salinity [kg m-3 ppt-1]. p_int !< The pressure at the ice-ocean interface [Pa]. real, dimension(SZI_(CS%grid),SZJ_(CS%grid)) :: & @@ -237,17 +237,17 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) ! 3 equations formulation variables real, dimension(SZDI_(CS%grid),SZDJ_(CS%grid)) :: & - Sbdry !< Salinities in the ocean at the interface with the ice shelf [PSU]. + Sbdry !< Salinities in the ocean at the interface with the ice shelf [ppt]. real :: Sbdry_it real :: Sbdry1, Sbdry2, S_a, S_b, S_c ! use to find salt roots - real :: dS_it !< The interface salinity change during an iteration [PSU]. + real :: dS_it !< The interface salinity change during an iteration [ppt]. real :: hBL_neut !< The neutral boundary layer thickness [m]. real :: hBL_neut_h_molec !< The ratio of the neutral boundary layer thickness !! to the molecular boundary layer thickness [nondim]. !### THESE ARE CURRENTLY POSITIVE UPWARD. real :: wT_flux !< The vertical flux of heat just inside the ocean [degC m s-1]. real :: wB_flux !< The vertical flux of heat just inside the ocean [m2 s-3]. - real :: dB_dS !< The derivative of buoyancy with salinity [m s-2 PSU-1]. + real :: dB_dS !< The derivative of buoyancy with salinity [m s-2 ppt-1]. real :: dB_dT !< The derivative of buoyancy with temperature [m s-2 degC-1]. real :: I_n_star, n_star_term, absf real :: dIns_dwB !< The partial derivative of I_n_star with wB_flux, in ???. diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 0c26418486..8899627cc7 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -209,8 +209,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters type(EOS_type), pointer :: eqn_of_state !< integer selecting the equation of state. - real, intent(in) :: P_Ref !< The coordinate-density reference pressure - !! in Pa. + real, intent(in) :: P_Ref !< The coordinate-density reference pressure [Pa]. ! Local variables real :: T_ref ! Reference temperature real :: S_ref ! Reference salinity @@ -261,8 +260,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, & type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters type(EOS_type), pointer :: eqn_of_state !< integer that selects equation of state. - real, intent(in) :: P_Ref !< The coordinate-density reference pressure - !! in Pa. + real, intent(in) :: P_Ref !< The coordinate-density reference pressure [Pa]. ! Local variables real, dimension(GV%ke) :: T0, S0, Pref real :: g_fs ! Reduced gravity across the free surface [m s-2]. @@ -310,11 +308,12 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, & type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters type(EOS_type), pointer :: eqn_of_state !< integer that selects equation of state - real, intent(in) :: P_Ref !< The coordinate-density reference pressure - !! in Pa. + real, intent(in) :: P_Ref !< The coordinate-density reference pressure [Pa] + + ! Local variables real, dimension(GV%ke) :: T0, S0, Pref - real :: S_Ref, S_Light, S_Dense ! Salinity range parameters in PSU. - real :: T_Ref, T_Light, T_Dense ! Temperature range parameters in dec C. + real :: S_Ref, S_Light, S_Dense ! Salinity range parameters [ppt]. + real :: T_Ref, T_Light, T_Dense ! Temperature range parameters [decC]. real :: res_rat ! The ratio of density space resolution in the denser part ! of the range to that in the lighter part of the range. ! Setting this greater than 1 increases the resolution for diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index d426550762..4c7b720f67 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -2103,7 +2103,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param ! lon (degrees_E), lat (degrees_N), depth(meters) ! variables: ! ptemp(lon,lat,depth) : degC, potential temperature - ! salt (lon,lat,depth) : PSU, salinity + ! salt (lon,lat,depth) : ppt, salinity ! ! The first record will be read if there are multiple time levels. ! The observation grid MUST tile the model grid. If the model grid extends diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 51da4af494..9b3aee8e7d 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -56,12 +56,12 @@ module MOM_bulk_mixed_layer !! If the value is small enough, this should not affect the solution. real :: omega !< The Earth's rotation rate [s-1]. real :: dT_dS_wt !< When forced to extrapolate T & S to match the - !! layer densities, this factor (in deg C / PSU) is + !! layer densities, this factor (in degC / ppt) is !! combined with the derivatives of density with T & S !! to determines what direction is orthogonal to !! density contours. It should be a typical value of !! (dR/dS) / (dR/dT) in oceanic profiles. - !! 6 K psu-1 might be reasonable. + !! 6 degC ppt-1 might be reasonable. real :: BL_extrap_lim !< A limit on the density range over which !! extrapolation can occur when detraining from the !! buffer layers, relative to the density range @@ -108,7 +108,7 @@ module MOM_bulk_mixed_layer real :: Allowed_T_chg !< The amount by which temperature is allowed !! to exceed previous values during detrainment, K. real :: Allowed_S_chg !< The amount by which salinity is allowed - !! to exceed previous values during detrainment, PSU. + !! to exceed previous values during detrainment, ppt. ! These are terms in the mixed layer TKE budget, all in [Z m2 s-3 ~> m3 s-3]. real, allocatable, dimension(:,:) :: & @@ -232,7 +232,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C real, dimension(SZI_(G),SZK0_(GV)) :: & h, & ! The layer thickness [H ~> m or kg m-2]. T, & ! The layer temperatures [degC]. - S, & ! The layer salinities [PSU]. + S, & ! The layer salinities [ppt]. R0, & ! The potential density referenced to the surface [kg m-3]. Rcv ! The coordinate variable potential density [kg m-3]. real, dimension(SZI_(G),SZK_(GV)) :: & @@ -264,7 +264,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C Ttot, & ! The integrated temperature of layers which are fully ! entrained [degC H ~> degC m or degC kg m-2]. Stot, & ! The integrated salt of layers which are fully entrained - ! [H PSU ~> m PSU or PSU kg m-2]. + ! [H ppt ~> m ppt or ppt kg m-2]. uhtot, & ! The depth integrated zonal and meridional velocities in the vhtot, & ! mixed layer [H m s-1 ~> m2 s-1 or kg m-1 s-1]. @@ -275,7 +275,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! over a time step from evaporating fresh water [H ~> m or kg m-2] Net_heat, & ! The net heating at the surface over a time step [degC H ~> degC m or degC kg m-2]. ! Any penetrating shortwave radiation is not included in Net_heat. - Net_salt, & ! The surface salt flux into the ocean over a time step, psu H. + Net_salt, & ! The surface salt flux into the ocean over a time step, ppt H. Idecay_len_TKE, & ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. p_ref, & ! Reference pressure for the potential density governing mixed ! layer dynamics, almost always 0 (or 1e5) Pa. @@ -286,7 +286,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C dRcv_dT, & ! Partial derivative of the coordinate variable potential ! density in the mixed layer with temperature [kg m-3 degC-1]. dR0_dS, & ! Partial derivative of the mixed layer potential density with - ! salinity [kg m-3 PSU-1]. + ! salinity [kg m-3 ppt-1]. dRcv_dS, & ! Partial derivative of the coordinate variable potential ! density in the mixed layer with salinity [kg m-3 ppt-1]. TKE_river ! The turbulent kinetic energy available for mixing at rivermouths over a @@ -452,7 +452,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C enddo ; enddo if (id_clock_EOS>0) call cpu_clock_begin(id_clock_EOS) - ! Calculate an estimate of the mid-mixed layer pressure (in Pa) + ! Calculate an estimate of the mid-mixed layer pressure [Pa] do i=is,ie ; p_ref(i) = 0.0 ; enddo do k=1,CS%nkml ; do i=is,ie p_ref(i) = p_ref(i) + 0.5*GV%H_to_Pa*h(i,k) @@ -803,7 +803,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: v !< Zonal velocities interpolated to h !! points, m s-1. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: T !< Layer temperatures [degC]. - real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: S !< Layer salinities [PSU]. + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: S !< Layer salinities [ppt]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: R0 !< Potential density referenced to !! surface pressure [kg m-3]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: Rcv !< The coordinate defining potential @@ -841,7 +841,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & Ttot, & ! The integrated temperature of layers which are fully ! entrained [degC H ~> degC m or degC kg m-2]. Stot, & ! The integrated salt of layers which are fully entrained - ! [H PSU ~> m PSU or PSU kg m-2]. + ! [H ppt ~> m ppt or ppt kg m-2]. uhtot, & ! The depth integrated zonal and meridional velocities in vhtot, & ! the mixed layer [H m s-1 ~> m2 s-1 or kg m-1 s-1]. KE_orig, & ! The total mean kinetic energy in the mixed layer before @@ -943,7 +943,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G)), intent(out) :: Ttot !< The depth integrated mixed layer temperature !! [degC H ~> degC m or degC kg m-2]. real, dimension(SZI_(G)), intent(out) :: Stot !< The depth integrated mixed layer salinity - !! [PSU H ~> PSU m or PSU kg m-2]. + !! [ppt H ~> ppt m or ppt kg m-2]. real, dimension(SZI_(G)), intent(out) :: uhtot !< The depth integrated mixed layer zonal !! velocity, H m s-1. real, dimension(SZI_(G)), intent(out) :: vhtot !< The integrated mixed layer meridional @@ -959,7 +959,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: T !< Layer temperatures [degC]. real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: S !< Layer salinities [PSU]. + intent(in) :: S !< Layer salinities [ppt]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: R0 !< Potential density referenced to !! surface pressure [kg m-3]. @@ -986,7 +986,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! step [degC H ~> degC m or degC kg m-2]. Any penetrating !! shortwave radiation is not included in Net_heat. real, dimension(SZI_(G)), intent(in) :: Net_salt !< The net surface salt flux into the ocean - !! over a time step [PSU H ~> PSU m or PSU kg m-2]. + !! over a time step [ppt H ~> ppt m or ppt kg m-2]. integer, intent(in) :: nsw !< The number of bands of penetrating !! shortwave radiation. real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave @@ -1498,7 +1498,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G)), intent(inout) :: Ttot !< The depth integrated mixed layer temperature !! [degC H ~> degC m or degC kg m-2]. real, dimension(SZI_(G)), intent(inout) :: Stot !< The depth integrated mixed layer salinity - !! [PSU H ~> PSU m or PSU kg m-2]. + !! [ppt H ~> ppt m or ppt kg m-2]. real, dimension(SZI_(G)), intent(inout) :: uhtot !< The depth integrated mixed layer zonal !! velocity, H m s-1. real, dimension(SZI_(G)), intent(inout) :: vhtot !< The integrated mixed layer meridional @@ -1514,7 +1514,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: T !< Layer temperatures [degC]. real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: S !< Layer salinities [PSU]. + intent(in) :: S !< Layer salinities [ppt]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: R0 !< Potential density referenced to !! surface pressure [kg m-3]. @@ -1884,7 +1884,7 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. !! Layer 0 is the new mixed layer. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Layer temperatures [degC]. - real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Layer salinities [PSU]. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Layer salinities [ppt]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: R0 !< Potential density referenced to !! surface pressure [kg m-3]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: Rcv !< The coordinate defining @@ -2206,7 +2206,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. !! Layer 0 is the new mixed layer. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Potential temperature [degC]. - real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Salinity [PSU]. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Salinity [ppt]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: R0 !< Potential density referenced to !! surface pressure [kg m-3]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: Rcv !< The coordinate defining potential @@ -2255,7 +2255,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: T_to_bl ! The depth integrated amount of T that is detrained to the ! buffer layer [degC H ~> degC m or degC kg m-2] real :: S_to_bl ! The depth integrated amount of S that is detrained to the - ! buffer layer [PSU H ~> PSU m or PSU kg m-2] + ! buffer layer [ppt H ~> ppt m or ppt kg m-2] real :: h_min_bl ! The minimum buffer layer thickness [H ~> m or kg m-2]. real :: h_min_bl_thick ! The minimum buffer layer thickness when the ! mixed layer is very large [H ~> m or kg m-2]. @@ -2331,7 +2331,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! over dt, nondimensional. real :: dT_dS_gauge, dS_dT_gauge ! The relative scales of temperature and ! salinity changes in defining spiciness, in - ! [degC psu-1] and [psu degC-1]. + ! [degC ppt-1] and [ppt degC-1]. real :: I_denom ! A work variable with units of [ppt2 m6 kg-2]. real :: G_2 ! 1/2 G_Earth [m2 Z-1 s-2 ~> m s-2]. @@ -3106,7 +3106,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. !! Layer 0 is the new mixed layer. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Potential temperature [degC]. - real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Salinity [PSU]. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Salinity [ppt]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: R0 !< Potential density referenced to !! surface pressure [kg m-3]. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: Rcv !< The coordinate defining potential diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 6600e4f6b7..7cb566ddba 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -507,7 +507,7 @@ subroutine triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, T, S) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: eb !< The amount of fluid entrained from the layer !! below within this time step [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: T !< Layer potential temperatures [degC]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: S !< Layer salinities [PSU]. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: S !< Layer salinities [ppt]. ! Local variables real :: b1(SZIB_(G)), d1(SZIB_(G)) ! b1, c1, and d1 are variables used by the diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 47b0cd0cd9..5d4d70ec30 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -236,7 +236,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: dS_expected !< The values of salinity change that !! should be expected when the returned - !! diffusivities are applied [PSU]. + !! diffusivities are applied [ppt]. type(wave_parameters_CS), & optional, pointer :: Waves !< Wave CS @@ -266,7 +266,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, dimension(SZI_(G),SZK_(GV)) :: & h, & ! The layer thickness [H ~> m or kg m-2]. T, & ! The layer temperatures [degC]. - S, & ! The layer salinities [PSU]. + S, & ! The layer salinities [ppt]. u, & ! The zonal velocity [m s-1]. v ! The meridional velocity [m s-1]. real, dimension(SZI_(G),SZK_(GV)+1) :: & diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 5a4369f79b..824bab78b2 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -179,7 +179,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, real, dimension(SZI_(G)) :: & pressure, & ! The pressure at an interface [Pa]. T_eos, S_eos, & ! The potential temperature and salinity at which to - ! evaluate dRho_dT and dRho_dS [degC] and [PSU]. + ! evaluate dRho_dT and dRho_dS [degC] and [ppt]. dRho_dT, dRho_dS ! The partial derivatives of potential density with ! temperature and salinity, [kg m-3 degC-1] and [kg m-3 ppt-1]. diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 1a7fa0fa06..a92106444e 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -140,12 +140,12 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & v, & ! The meridional velocity after a timestep of mixing [m s-1]. Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. T, & ! The potential temperature after a timestep of mixing [degC]. - Sal, & ! The salinity after a timestep of mixing [PSU]. + Sal, & ! The salinity after a timestep of mixing [ppt]. dz, & ! The layer thickness [Z ~> m]. u0xdz, & ! The initial zonal velocity times dz [Z m s-1 ~> m2 s-1]. v0xdz, & ! The initial meridional velocity times dz [Z m s-1 ~> m2 s-1]. T0xdz, & ! The initial temperature times dz [degC Z ~> degC m]. - S0xdz ! The initial salinity times dz [PSU Z ~> PSU m]. + S0xdz ! The initial salinity times dz [ppt Z ~> ppt m]. real, dimension(SZK_(GV)+1) :: & kappa, & ! The shear-driven diapycnal diffusivity at an interface [Z2 s-1 ~> m2 s-1]. tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [m2 s-2]. @@ -431,12 +431,12 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ v, & ! The meridional velocity after a timestep of mixing [m s-1]. Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. T, & ! The potential temperature after a timestep of mixing [degC]. - Sal, & ! The salinity after a timestep of mixing [PSU]. + Sal, & ! The salinity after a timestep of mixing [ppt]. dz, & ! The layer thickness [Z ~> m]. u0xdz, & ! The initial zonal velocity times dz [m Z s-1 ~> m2 s-1]. v0xdz, & ! The initial meridional velocity times dz [m Z s-1 ~> m2 s-1]. T0xdz, & ! The initial temperature times dz [degC Z ~> degC m]. - S0xdz ! The initial salinity times dz [PSU Z ~> PSU m]. + S0xdz ! The initial salinity times dz [ppt Z ~> ppt m]. real, dimension(SZK_(GV)+1) :: & kappa, & ! The shear-driven diapycnal diffusivity at an interface [Z2 s-1 ~> m2 s-1]. tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [m2 s-2]. @@ -730,7 +730,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real, dimension(SZK_(GV)), & intent(in) :: T0xdz !< The initial temperature times dz [degC Z ~> degC m]. real, dimension(SZK_(GV)), & - intent(in) :: S0xdz !< The initial salinity times dz [PSU Z ~> PSU m]. + intent(in) :: S0xdz !< The initial salinity times dz [ppt Z ~> ppt m]. real, dimension(SZK_(GV)+1), & intent(out) :: kappa_avg !< The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. real, dimension(SZK_(GV)+1), & @@ -747,7 +747,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & v, & ! The meridional velocity after a timestep of mixing [m s-1]. Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. T, & ! The potential temperature after a timestep of mixing [degC]. - Sal, & ! The salinity after a timestep of mixing [PSU]. + Sal, & ! The salinity after a timestep of mixing [ppt]. u_test, v_test, T_test, S_test real, dimension(nzc+1) :: & @@ -770,9 +770,9 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & kappa_pred, & ! The value of kappa from a predictor step [Z2 s-1 ~> m2 s-1]. pressure, & ! The pressure at an interface [Pa]. T_int, & ! The temperature interpolated to an interface [degC]. - Sal_int, & ! The salinity interpolated to an interface [PSU]. + Sal_int, & ! The salinity interpolated to an interface [ppt]. dbuoy_dT, & ! The partial derivatives of buoyancy with changes in temperature - dbuoy_dS, & ! and salinity, [Z s-2 degC-1 ~> m s-2 degC-1] and [Z s-2 psu-1 ~> m s-2 psu-1]. + dbuoy_dS, & ! and salinity, [Z s-2 degC-1 ~> m s-2 degC-1] and [Z s-2 ppt-1 ~> m s-2 ppt-1]. I_L2_bdry, & ! The inverse of the square of twice the harmonic mean ! distance to the top and bottom boundaries [Z-2 ~> m-2]. K_Q, & ! Diffusivity divided by TKE [Z2 m-2 s ~> s]. @@ -1237,19 +1237,19 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & real, dimension(nz), intent(in) :: u0 !< The initial zonal velocity [m s-1]. real, dimension(nz), intent(in) :: v0 !< The initial meridional velocity [m s-1]. real, dimension(nz), intent(in) :: T0 !< The initial temperature [degC]. - real, dimension(nz), intent(in) :: S0 !< The initial salinity [PSU]. + real, dimension(nz), intent(in) :: S0 !< The initial salinity [ppt]. real, dimension(nz), intent(in) :: dz !< The grid spacing of layers [Z ~> m]. real, dimension(nz+1), intent(in) :: I_dz_int !< The inverse of the layer's thicknesses !! [Z-1 ~> m-1]. real, dimension(nz+1), intent(in) :: dbuoy_dT !< The partial derivative of buoyancy with !! temperature [Z s-2 degC-1 ~> m s-2 degC-1]. real, dimension(nz+1), intent(in) :: dbuoy_dS !< The partial derivative of buoyancy with - !! salinity [Z s-2 PSU-1 ~> m s-2 PSU-1]. + !! salinity [Z s-2 ppt-1 ~> m s-2 ppt-1]. real, intent(in) :: dt !< The time step [s]. real, dimension(nz), intent(inout) :: u !< The zonal velocity after dt [m s-1]. real, dimension(nz), intent(inout) :: v !< The meridional velocity after dt [m s-1]. real, dimension(nz), intent(inout) :: T !< The temperature after dt [degC]. - real, dimension(nz), intent(inout) :: Sal !< The salinity after dt [PSU]. + real, dimension(nz), intent(inout) :: Sal !< The salinity after dt [ppt]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(nz+1), optional, & diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index c1b1d68698..989b2f0154 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -157,11 +157,11 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, CS) real, dimension(SZI_(G),SZK_(G)) :: & h_2d, & ! A 2-d version of h [H ~> m or kg m-2]. T_2d, & ! A 2-d version of tv%T [degC]. - S_2d, & ! A 2-d version of tv%S [PSU]. + S_2d, & ! A 2-d version of tv%S [ppt]. Rcv, & ! A 2-d version of the coordinate density [kg m-3]. h_2d_init, & ! The initial value of h_2d [H ~> m or kg m-2]. T_2d_init, & ! THe initial value of T_2d [degC]. - S_2d_init, & ! The initial value of S_2d [PSU]. + S_2d_init, & ! The initial value of S_2d [ppt]. d_eb, & ! The downward increase across a layer in the entrainment from ! below [H ~> m or kg m-2]. The sign convention is that positive values of ! d_eb correspond to a gain in mass by a layer by upward motion. diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 18cdefa177..e4214c8d16 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -872,11 +872,11 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available !! thermodynamic fields. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: T_f !< layer temp in C with the values in massless layers - !! filled vertically by diffusion. + intent(in) :: T_f !< layer temperature with the values in massless layers + !! filled vertically by diffusion [degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: S_f !< Layer salinities in PPT with values in massless - !! layers filled vertically by diffusion. + intent(in) :: S_f !< Layer salinities with values in massless + !! layers filled vertically by diffusion [ppt]. type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes integer, intent(in) :: j !< j-index of row to work on type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure @@ -1047,11 +1047,11 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: T_f !< layer temp in C with the values in massless layers - !! filled vertically by diffusion. + intent(in) :: T_f !< layer temperatures with the values in massless layers + !! filled vertically by diffusion [degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: S_f !< Layer salinities in PPT with values in massless - !! layers filled vertically by diffusion. + intent(in) :: S_f !< Layer salinities with values in massless + !! layers filled vertically by diffusion [ppt]. integer, intent(in) :: j !< Meridional index upon which to work. type(set_diffusivity_CS), pointer :: CS !< Module control structure. real, dimension(SZI_(G),SZK_(G)+1), & diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index b327116f75..7eba2fbac0 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -157,7 +157,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) T_vel, & ! Arithmetic mean of the layer temperatures adjacent to a ! velocity point [degC]. S_vel, & ! Arithmetic mean of the layer salinities adjacent to a - ! velocity point [PSU]. + ! velocity point [ppt]. Rml_vel ! Arithmetic mean of the layer coordinate densities adjacent ! to a velocity point [kg m-3]. @@ -189,7 +189,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: hutot ! Running sum of thicknesses times the ! velocity magnitudes [H m s-1 ~> m2 s-1 or kg m-1 s-1]. real :: Thtot ! Running sum of thickness times temperature [degC H ~> degC m or degC kg m-2]. - real :: Shtot ! Running sum of thickness times salinity [PSU H ~> PSU m or PSU kg m-2]. + real :: Shtot ! Running sum of thickness times salinity [ppt H ~> ppt m or ppt kg m-2]. real :: hweight ! The thickness of a layer that is within Hbbl ! of the bottom [H ~> m or kg m-2]. real :: v_at_u, u_at_v ! v at a u point or vice versa [m s-1]. @@ -1024,7 +1024,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri Thtot, & ! The integrated temperature of layers that are within the ! surface mixed layer [H degC ~> m degC or kg degC m-2]. Shtot, & ! The integrated salt of layers that are within the - ! surface mixed layer [H PSU ~> m PSU or kg PSU m-2]. + ! surface mixed layer [H ppt ~> m ppt or kg ppt m-2]. Rhtot, & ! The integrated density of layers that are within the surface mixed layer ! [H kg m-3 ~> kg m-2 or kg2 m-5]. Rhtot is only used if no ! equation of state is used. @@ -1034,11 +1034,11 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri dR_dT, & ! Partial derivative of the density at the base of layer nkml ! (roughly the base of the mixed layer) with temperature [kg m-3 degC-1]. dR_dS, & ! Partial derivative of the density at the base of layer nkml - ! (roughly the base of the mixed layer) with salinity [kg m-3 psu-1]. + ! (roughly the base of the mixed layer) with salinity [kg m-3 ppt-1]. ustar, & ! The surface friction velocity under ice shelves [Z s-1 ~> m s-1]. press, & ! The pressure at which dR_dT and dR_dS are evaluated [Pa]. T_EOS, & ! The potential temperature at which dR_dT and dR_dS are evaluated [degC] - S_EOS ! The salinity at which dR_dT and dR_dS are evaluated [PSU]. + S_EOS ! The salinity at which dR_dT and dR_dS are evaluated [ppt]. real, dimension(SZIB_(G),SZJ_(G)) :: & mask_u ! A mask that disables any contributions from u points that ! are land or past open boundary conditions [nondim], 0 or 1. @@ -1067,7 +1067,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real :: hlay ! The layer thickness at velocity points [H ~> m or kg m-2]. real :: I_2hlay ! 1 / 2*hlay [H-1 ~> m-1 or m2 kg-1]. real :: T_lay ! The layer temperature at velocity points [degC]. - real :: S_lay ! The layer salinity at velocity points [PSU]. + real :: S_lay ! The layer salinity at velocity points [ppt]. real :: Rlay ! The layer potential density at velocity points [kg m-3]. real :: Rlb ! The potential density of the layer below [kg m-3]. real :: v_at_u ! The meridonal velocity at a zonal velocity point [m s-1]. diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index 1234e4a1b4..e41ab90095 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -40,9 +40,9 @@ module pseudo_salt_tracer type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the MOM tracer registry real, pointer :: ps(:,:,:) => NULL() !< The array of pseudo-salt tracer used in this - !! subroutine, in psu + !! subroutine [ppt} real, pointer :: diff(:,:,:) => NULL() !< The difference between the pseudo-salt - !! tracer and the real salt [PSU]. + !! tracer and the real salt [ppt]. logical :: pseudo_salt_may_reinit = .true. !< Hard coding since this should not matter integer :: id_psd = -1 !< A diagnostic ID diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 4555a52f1d..3d54df5955 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -61,7 +61,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) !! BFB_surface_forcing_init. ! Local variables real :: Temp_restore ! The temperature that is being restored toward [degC]. - real :: Salin_restore ! The salinity that is being restored toward [PSU]. + real :: Salin_restore ! The salinity that is being restored toward [ppt]. real :: density_restore ! The potential density that is being restored ! toward [kg m-3]. real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. @@ -127,8 +127,8 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) rhoXcp = CS%Rho0 * fluxes%C_p do j=js,je ; do i=is,ie - ! Set Temp_restore and Salin_restore to the temperature (in C) and - ! salinity (in PSU) that are being restored toward. + ! Set Temp_restore and Salin_restore to the temperature (in degC) and + ! salinity (in ppt) that are being restored toward. Temp_restore = 0.0 Salin_restore = 0.0 diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index dfa9b1d892..39c9321111 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -473,10 +473,10 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) do_not_log=.true.) call get_param(PF, mdl, "ISOMIP_S_SUR_SPONGE", s_sur, & - 'Surface salinity in sponge layer.', default=s_ref) ! units="PSU") + 'Surface salinity in sponge layer.', default=s_ref) ! units="ppt") call get_param(PF, mdl, "ISOMIP_S_BOT_SPONGE", s_bot, & - 'Bottom salinity in sponge layer.', default=s_ref) ! units="PSU") + 'Bottom salinity in sponge layer.', default=s_ref) ! units="ppt") call get_param(PF, mdl, "ISOMIP_T_SUR_SPONGE", t_sur, & 'Surface temperature in sponge layer.', default=t_ref) ! units="degC") diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index 095884d232..7a2360fc7a 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -38,7 +38,7 @@ module dumbbell_surface_forcing forcing_mask !< A mask regulating where forcing occurs real, dimension(:,:), allocatable :: & S_restore !< The surface salinity field toward which to - !! restore [PSU]. + !! restore [ppt]. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the !! timing of diagnostic output. end type dumbbell_surface_forcing_CS @@ -60,7 +60,7 @@ subroutine dumbbell_buoyancy_forcing(state, fluxes, day, dt, G, CS) !! call to dumbbell_surface_forcing_init ! Local variables real :: Temp_restore ! The temperature that is being restored toward [degC]. - real :: Salin_restore ! The salinity that is being restored toward [PSU]. + real :: Salin_restore ! The salinity that is being restored toward [ppt]. real :: density_restore ! The potential density that is being restored ! toward [kg m-3]. real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. From ddb73dc5016a7f6e203bc78ea8ff50d5fddeb976 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 30 Jan 2019 14:08:25 -0700 Subject: [PATCH 0993/1072] Rename meltw to seaice_melt and melth to seaice_melt_heat This commit renames meltw and melth to seaice_melt and seaice_melt_heat, respectively. It also renames heat_content_meltw to heat_content_icemelt. --- config_src/mct_driver/MOM_surface_forcing.F90 | 160 +++++++------- config_src/mct_driver/ocn_cap_methods.F90 | 20 +- src/core/MOM_forcing_type.F90 | 199 +++++++++--------- src/diagnostics/MOM_sum_output.F90 | 8 +- 4 files changed, 192 insertions(+), 195 deletions(-) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 84713622ca..1aae536399 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -151,33 +151,33 @@ module MOM_surface_forcing ! 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 (kg/m2/s) - real, pointer, dimension(:,:) :: rofi_flux =>NULL() !< ice runoff (kg/m2/s) - 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(:,:) :: melth =>NULL() !< sea ice and snow melt heat flux (W/m2) - real, pointer, dimension(:,:) :: meltw =>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(:,:) :: 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 + real, pointer, dimension(:,:) :: latent_flux =>NULL() !< latent flux (W/m2) + real, pointer, dimension(:,:) :: rofl_flux =>NULL() !< liquid runoff (kg/m2/s) + real, pointer, dimension(:,:) :: rofi_flux =>NULL() !< ice runoff (kg/m2/s) + 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(:,:) :: 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 + 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) @@ -445,12 +445,12 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & fluxes%sens(i,j) = G%mask2dT(i,j) * IOB%t_flux(i-i0,j-j0) ! sea ice and snow melt heat flux (W/m2) - if (associated(fluxes%melth)) & - fluxes%melth(i,j) = G%mask2dT(i,j) * IOB%melth(i-i0,j-j0) + if (associated(fluxes%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%meltw)) & - fluxes%meltw(i,j) = G%mask2dT(i,j) * IOB%meltw(i-i0,j-j0) + if (associated(fluxes%seaice_melt)) & + fluxes%seaice_melt(i,j) = G%mask2dT(i,j) * IOB%seaice_melt(i-i0,j-j0) ! latent heat flux (W/m^2) if (associated(fluxes%latent)) & @@ -483,7 +483,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & sign_for_net_FW_bug = 1. if (CS%use_net_FW_adjustment_sign_bug) sign_for_net_FW_bug = -1. do j=js,je ; do i=is,ie - net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j) + fluxes%meltw(i,j)) + & + 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 @@ -493,7 +493,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, CS, & ! 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 meltw and melth, respectively. + ! 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) @@ -787,8 +787,8 @@ subroutine IOB_allocate(IOB, 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% melth (isc:iec,jsc:jec), & - IOB% meltw (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), & @@ -807,31 +807,31 @@ subroutine IOB_allocate(IOB, 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%melth = 0.0 - IOB%meltw = 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 + 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 @@ -1331,30 +1331,30 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) 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%melth ', mpp_chksum( iobt%melth ) - write(outunit,100) 'iobt%meltw ', mpp_chksum( iobt%meltw ) - 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%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 ) 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 ee965366be..a5c98a83dc 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -75,10 +75,10 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, ice_ocean_boundary%latent_flux(i,j) = x2o(ind%x2o_Foxx_lat,k) ! snow&ice melt heat flux (W/m^2) - ice_ocean_boundary%melth(i,j) = x2o(ind%x2o_Fioi_melth,k) + ice_ocean_boundary%seaice_melt_heat(i,j) = x2o(ind%x2o_Fioi_melth,k) ! water flux from snow&ice melt (kg/m2/s) - ice_ocean_boundary%meltw(i,j) = x2o(ind%x2o_Fioi_meltw,k) + ice_ocean_boundary%seaice_melt(i,j) = x2o(ind%x2o_Fioi_meltw,k) ! liquid runoff ice_ocean_boundary%rofl_flux(i,j) = x2o(ind%x2o_Foxx_rofl,k) * GRID%mask2dT(i,j) @@ -117,14 +117,14 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, do j = GRID%jsc, GRID%jec do i = GRID%isc, GRID%iec - write(logunit,F01)'import: day, secs, j, i, u_flux = ',day,secs,j,i,ice_ocean_boundary%u_flux(i,j) - write(logunit,F01)'import: day, secs, j, i, v_flux = ',day,secs,j,i,ice_ocean_boundary%v_flux(i,j) - write(logunit,F01)'import: day, secs, j, i, lprec = ',day,secs,j,i,ice_ocean_boundary%lprec(i,j) - write(logunit,F01)'import: day, secs, j, i, lwrad = ',day,secs,j,i,ice_ocean_boundary%lw_flux(i,j) - write(logunit,F01)'import: day, secs, j, i, q_flux = ',day,secs,j,i,ice_ocean_boundary%q_flux(i,j) - write(logunit,F01)'import: day, secs, j, i, t_flux = ',day,secs,j,i,ice_ocean_boundary%t_flux(i,j) - write(logunit,F01)'import: day, secs, j, i, melth = ',day,secs,j,i,ice_ocean_boundary%melth(i,j) - write(logunit,F01)'import: day, secs, j, i, meltw = ',day,secs,j,i,ice_ocean_boundary%meltw(i,j) + write(logunit,F01)'import: day, secs, j, i, u_flux = ',day,secs,j,i,ice_ocean_boundary%u_flux(i,j) + write(logunit,F01)'import: day, secs, j, i, v_flux = ',day,secs,j,i,ice_ocean_boundary%v_flux(i,j) + write(logunit,F01)'import: day, secs, j, i, lprec = ',day,secs,j,i,ice_ocean_boundary%lprec(i,j) + write(logunit,F01)'import: day, secs, j, i, lwrad = ',day,secs,j,i,ice_ocean_boundary%lw_flux(i,j) + write(logunit,F01)'import: day, secs, j, i, q_flux = ',day,secs,j,i,ice_ocean_boundary%q_flux(i,j) + write(logunit,F01)'import: day, secs, j, i, t_flux = ',day,secs,j,i,ice_ocean_boundary%t_flux(i,j) + write(logunit,F01)'import: day, secs, j, i, seaice_melt_heat = ',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 = ',& diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 03a568b4f4..c5cec683a3 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -63,10 +63,10 @@ module MOM_forcing_type ! turbulent heat fluxes into the ocean (W/m^2) real, pointer, dimension(:,:) :: & - latent => NULL(), & !< latent (W/m^2) (typically < 0) - sens => NULL(), & !< sensible (W/m^2) (typically negative) - melth => NULL(), & !< sea ice and snow melt (W/m^2) (typically negative) - heat_added => NULL() !< additional heat flux from SST restoring or flux adjustments (W/m^2) + latent => NULL(), & !< latent (W/m^2) (typically < 0) + sens => NULL(), & !< sensible (W/m^2) (typically negative) + seaice_melt_heat => NULL(), & !< sea ice and snow melt or formation (W/m^2) (typically negative) + heat_added => NULL() !< additional heat flux from SST restoring or flux adjustments (W/m^2) ! components of latent heat fluxes used for diagnostic purposes real, pointer, dimension(:,:) :: & @@ -82,7 +82,7 @@ module MOM_forcing_type vprec => NULL(), & !< virtual liquid precip associated w/ SSS restoring ( kg/(m^2 s) ) lrunoff => NULL(), & !< liquid river runoff entering ocean ( kg/(m^2 s) ) frunoff => NULL(), & !< frozen river runoff (calving) entering ocean ( kg/(m^2 s) ) - meltw => NULL(), & !< snow/seaice melt (positive) or formation (negative) ( kg/(m^2 s) ) + seaice_melt => NULL(), & !< snow/seaice melt (positive) or formation (negative) ( kg/(m^2 s) ) netMassIn => NULL(), & !< Sum of water mass flux out of the ocean ( kg/(m^2 s) ) netMassOut => NULL(), & !< Net water mass flux into of the ocean ( kg/(m^2 s) ) netSalt => NULL() !< Net salt entering the ocean @@ -91,12 +91,11 @@ module MOM_forcing_type real, pointer, dimension(:,:) :: & heat_content_cond => NULL(), & !< heat content associated with condensating water (W/m^2) heat_content_lprec => NULL(), & !< heat content associated with liquid >0 precip (W/m^2) (diagnostic) - heat_content_meltw => NULL(), & !< heat content associated with snow/seaice melt/freeze (W/m^2) + heat_content_icemelt => NULL(), & !< heat content associated with snow/seaice melt/formation (W/m^2) heat_content_fprec => NULL(), & !< heat content associated with frozen precip (W/m^2) heat_content_vprec => NULL(), & !< heat content associated with virtual >0 precip (W/m^2) heat_content_lrunoff => NULL(), & !< heat content associated with liquid runoff (W/m^2) heat_content_frunoff => NULL(), & !< heat content associated with frozen runoff (W/m^2) - heat_content_icemelt => NULL(), & !< heat content associated with liquid sea ice (W/m^2) heat_content_massout => NULL(), & !< heat content associated with mass leaving ocean (W/m^2) heat_content_massin => NULL() !< heat content associated with mass entering ocean (W/m^2) @@ -237,7 +236,7 @@ module MOM_forcing_type integer :: id_lrunoff = -1, id_frunoff = -1 integer :: id_net_massout = -1, id_net_massin = -1 integer :: id_massout_flux = -1, id_massin_flux = -1 - integer :: id_meltw = -1 + integer :: id_seaice_melt = -1 ! global area integrated mass flux diagnostic handles integer :: id_total_prcme = -1, id_total_evap = -1 @@ -245,7 +244,7 @@ module MOM_forcing_type integer :: id_total_lprec = -1, id_total_fprec = -1 integer :: id_total_lrunoff = -1, id_total_frunoff = -1 integer :: id_total_net_massout = -1, id_total_net_massin = -1 - integer :: id_total_meltw = -1 + integer :: id_total_seaice_melt = -1 ! global area averaged mass flux diagnostic handles integer :: id_prcme_ga = -1, id_evap_ga = -1 @@ -265,7 +264,7 @@ module MOM_forcing_type integer :: id_heat_content_vprec = -1, id_heat_content_massout = -1 integer :: id_heat_added = -1, id_heat_content_massin = -1 integer :: id_hfrainds = -1, id_hfrunoffds = -1 - integer :: id_melth = -1, id_heat_content_meltw = -1 + integer :: id_seaice_melt_heat = -1, id_heat_content_icemelt = -1 ! global area integrated heat flux diagnostic handles integer :: id_total_net_heat_coupler = -1, id_total_net_heat_surface = -1 @@ -278,7 +277,7 @@ module MOM_forcing_type integer :: id_total_heat_content_cond = -1, id_total_heat_content_surfwater= -1 integer :: id_total_heat_content_vprec = -1, id_total_heat_content_massout = -1 integer :: id_total_heat_added = -1, id_total_heat_content_massin = -1 - integer :: id_total_melth = -1, id_total_heat_content_meltw = -1 + integer :: id_total_seaice_melt_heat = -1, id_total_heat_content_icemelt = -1 ! global area averaged heat flux diagnostic handles integer :: id_net_heat_coupler_ga = -1, id_net_heat_surface_ga = -1 @@ -497,7 +496,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, + fluxes%evap(i,j) ) & + fluxes%lrunoff(i,j) ) & + fluxes%vprec(i,j) ) & - + fluxes%meltw(i,j) ) & + + fluxes%seaice_melt(i,j)) & + fluxes%frunoff(i,j) )) if (do_NMIOr) then ! Repeat the above code w/ dt=1s for legacy reasons @@ -506,7 +505,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, + fluxes%evap(i,j) ) & + fluxes%lrunoff(i,j) ) & + fluxes%vprec(i,j) ) & - + fluxes%meltw(i,j) ) & + + fluxes%seaice_melt(i,j)) & + fluxes%frunoff(i,j) )) endif @@ -538,9 +537,9 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, netMassOut(i) = netMassOut(i) + fluxes%lprec(i,j) endif - ! meltw < 0 means sea ice formation taking water from the ocean. - if (fluxes%meltw(i,j) < 0.0) then - netMassOut(i) = netMassOut(i) + fluxes%meltw(i,j) + ! seaice_melt < 0 means sea ice formation taking water from the ocean. + if (fluxes%seaice_melt(i,j) < 0.0) then + netMassOut(i) = netMassOut(i) + fluxes%seaice_melt(i,j) endif ! vprec < 0 means virtual evaporation arising from surface salinity restoring, @@ -558,15 +557,15 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! surface heat fluxes from radiation and turbulent fluxes (K * H) ! (H=m for Bouss, H=kg/m2 for non-Bouss) - ! CIME provides heat flux from snow&ice melt (melth), so this is added below - if (associated(fluxes%melth)) then + ! CIME provides heat flux from snow&ice melt (seaice_melt_heat), so this is added below + if (associated(fluxes%seaice_melt_heat)) then net_heat(i) = scale * dt * J_m2_to_H * & ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j) + & - fluxes%melth(i,j)) ) + fluxes%seaice_melt_heat(i,j)) ) !Repeats above code w/ dt=1. for legacy reason if (do_NHR) net_heat_rate(i) = scale * J_m2_to_H * & ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j) + & - fluxes%melth(i,j))) + fluxes%seaice_melt_heat(i,j))) else net_heat(i) = scale * dt * J_m2_to_H * & ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)) ) @@ -730,12 +729,12 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, endif endif - ! Following lprec and fprec, water flux due to sea ice melt (meltw) enters at SST - GMM - if (associated(fluxes%heat_content_meltw)) then - if (fluxes%meltw(i,j) > 0.0) then - fluxes%heat_content_meltw(i,j) = fluxes%C_p*fluxes%meltw(i,j)*T(i,1) + ! Following lprec and fprec, water flux due to sea ice melt (seaice_melt) enters at SST - GMM + if (associated(fluxes%heat_content_icemelt)) then + if (fluxes%seaice_melt(i,j) > 0.0) then + fluxes%heat_content_icemelt(i,j) = fluxes%C_p*fluxes%seaice_melt(i,j)*T(i,1) else - fluxes%heat_content_meltw(i,j) = 0.0 + fluxes%heat_content_icemelt(i,j) = 0.0 endif endif @@ -1023,10 +1022,10 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, haloshift) call hchksum(fluxes%fprec, mesg//" fluxes%fprec",G%HI,haloshift=hshift) if (associated(fluxes%vprec)) & call hchksum(fluxes%vprec, mesg//" fluxes%vprec",G%HI,haloshift=hshift) - if (associated(fluxes%meltw)) & - call hchksum(fluxes%meltw, mesg//" fluxes%meltw",G%HI,haloshift=hshift) - if (associated(fluxes%melth)) & - call hchksum(fluxes%melth, mesg//" fluxes%melth",G%HI,haloshift=hshift) + if (associated(fluxes%seaice_melt)) & + call hchksum(fluxes%seaice_melt, mesg//" fluxes%seaice_melt",G%HI,haloshift=hshift) + if (associated(fluxes%seaice_melt_heat)) & + call hchksum(fluxes%seaice_melt_heat, mesg//" fluxes%seaice_melt_heat",G%HI,haloshift=hshift) if (associated(fluxes%p_surf)) & call hchksum(fluxes%p_surf, mesg//" fluxes%p_surf",G%HI,haloshift=hshift) if (associated(fluxes%salt_flux)) & @@ -1047,8 +1046,8 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, haloshift) call hchksum(fluxes%heat_content_lprec, mesg//" fluxes%heat_content_lprec",G%HI,haloshift=hshift) if (associated(fluxes%heat_content_fprec)) & call hchksum(fluxes%heat_content_fprec, mesg//" fluxes%heat_content_fprec",G%HI,haloshift=hshift) - if (associated(fluxes%heat_content_meltw)) & - call hchksum(fluxes%heat_content_meltw, mesg//" fluxes%heat_content_meltw",G%HI,haloshift=hshift) + if (associated(fluxes%heat_content_icemelt)) & + call hchksum(fluxes%heat_content_icemelt, mesg//" fluxes%heat_content_icemelt",G%HI,haloshift=hshift) if (associated(fluxes%heat_content_cond)) & call hchksum(fluxes%heat_content_cond, mesg//" fluxes%heat_content_cond",G%HI,haloshift=hshift) if (associated(fluxes%heat_content_massout)) & @@ -1138,8 +1137,8 @@ subroutine forcing_SinglePointPrint(fluxes, G, i, j, mesg) call locMsg(fluxes%lprec,'lprec') call locMsg(fluxes%fprec,'fprec') call locMsg(fluxes%vprec,'vprec') - call locMsg(fluxes%meltw,'meltw') - call locMsg(fluxes%melth,'melth') + call locMsg(fluxes%seaice_melt,'seaice_melt') + call locMsg(fluxes%seaice_melt_heat,'seaice_melt_heat') call locMsg(fluxes%p_surf,'p_surf') call locMsg(fluxes%salt_flux,'salt_flux') call locMsg(fluxes%TKE_tidal,'TKE_tidal') @@ -1150,7 +1149,7 @@ subroutine forcing_SinglePointPrint(fluxes, G, i, j, mesg) call locMsg(fluxes%heat_content_frunoff,'heat_content_frunoff') call locMsg(fluxes%heat_content_lprec,'heat_content_lprec') call locMsg(fluxes%heat_content_fprec,'heat_content_fprec') - call locMsg(fluxes%heat_content_meltw,'heat_content_meltw') + call locMsg(fluxes%heat_content_icemelt,'heat_content_icemelt') call locMsg(fluxes%heat_content_vprec,'heat_content_vprec') call locMsg(fluxes%heat_content_cond,'heat_content_cond') call locMsg(fluxes%heat_content_cond,'heat_content_massout') @@ -1247,10 +1246,8 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use cmor_long_name='Water Evaporation Flux Where Ice Free Ocean over Sea') ! smg: seaice_melt field requires updates to the sea ice model - ! gmm: MCT provides this field - ! TODO: confirm cmor field name - handles%id_meltw = register_diag_field('ocean_model', 'meltw', & - diag%axesT1, Time, 'water flux to ocean from snow/sea ice melt(> 0) or form(< 0)', & + handles%id_seaice_melt = register_diag_field('ocean_model', 'seaice_melt', & + diag%axesT1, Time, 'water flux to ocean from snow/sea ice melting(> 0) or formation(< 0)', & 'kg m-2 s-1', & standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics', & cmor_field_name='fsitherm', & @@ -1317,9 +1314,7 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use cmor_long_name='Evaporation Where Ice Free Ocean over Sea Area Integrated') ! seaice_melt field requires updates to the sea ice model - ! gmm: MCT provides this field - ! TODO: confirm cmor field name - handles%id_total_meltw = register_scalar_field('ocean_model', 'total_meltw', Time, diag, & + handles%id_total_icemelt = register_scalar_field('ocean_model', 'total_icemelt', Time, diag, & long_name='Area integrated sea ice melt (>0) or form (<0)', units='kg s-1', & standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics_area_integrated', & cmor_field_name='total_fsitherm', & @@ -1424,8 +1419,8 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use diag%axesT1,Time,'Heat content (relative to 0degC) of frozen prec entering ocean',& 'W m-2') - handles%id_heat_content_meltw = register_diag_field('ocean_model', 'heat_content_meltw',& - diag%axesT1,Time,'Heat content (relative to 0degC) of water flux due to sea ice melting entering ocean',& + handles%id_heat_content_icemelt = register_diag_field('ocean_model', 'heat_content_icemelt',& + diag%axesT1,Time,'Heat content (relative to 0degC) of water flux due to sea ice melting/freezing',& 'W m-2') handles%id_heat_content_vprec = register_diag_field('ocean_model', 'heat_content_vprec', & @@ -1458,14 +1453,15 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use 'W m-2') handles%id_net_heat_coupler = register_diag_field('ocean_model', 'net_heat_coupler', & - diag%axesT1,Time,'Surface ocean heat flux from SW+LW+latent+sensible+melth (via the coupler)',& + diag%axesT1,Time,'Surface ocean heat flux from SW+LW+latent+sensible+seaice_melt_heat (via the coupler)',& 'W m-2') handles%id_net_heat_surface = register_diag_field('ocean_model', 'net_heat_surface',diag%axesT1, & - Time,'Surface ocean heat flux from SW+LW+lat+sens+mass transfer+frazil+restore+melth or flux adjustments', 'W m-2',& + Time,'Surface ocean heat flux from SW+LW+lat+sens+mass transfer+frazil+restore+seaice_melt_heat', & + 'or flux adjustments', 'W m-2',& standard_name='surface_downward_heat_flux_in_sea_water', cmor_field_name='hfds', & cmor_standard_name='surface_downward_heat_flux_in_sea_water', & - cmor_long_name='Surface ocean heat flux from SW+LW+latent+sensible+masstransfer+frazil+melth') + cmor_long_name='Surface ocean heat flux from SW+LW+latent+sensible+masstransfer+frazil+seaice_melt_heat') handles%id_sw = register_diag_field('ocean_model', 'SW', diag%axesT1, Time, & 'Shortwave radiation flux into ocean', 'W m-2', & @@ -1518,8 +1514,8 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use cmor_standard_name='surface_downward_sensible_heat_flux', & cmor_long_name='Surface Downward Sensible Heat Flux') - handles%id_melth = register_diag_field('ocean_model', 'melth', diag%axesT1, Time,& - 'Heat flux into ocean from snow and sea ice melt', 'W m-2', & + handles%id_seaice_melt_heat = register_diag_field('ocean_model', 'seaice_melt_heat', diag%axesT1, Time,& + 'Heat flux into ocean due to snow and sea ice melt/freeze', 'W m-2', & standard_name='snow_ice_melt_heat_flux', & !GMM TODO cmor_field_name='hfsso', & cmor_standard_name='snow_ice_melt_heat_flux', & @@ -1564,10 +1560,10 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use long_name='Area integrated heat content (relative to 0C) of frozen precip',& units='W') - handles%id_total_heat_content_meltw = register_scalar_field('ocean_model', & - 'total_heat_content_meltw', Time, diag, & - long_name='Area integrated heat content (relative to 0C) of water flux due to melting',& - units='W') + handles%id_total_heat_content_icemelt = register_scalar_field('ocean_model', & + 'total_heat_content_icemelt', Time, diag, & + long_name='Area integrated heat content (relative to 0C) of water flux due sea ice '& + 'melting/freezing', units='W') handles%id_total_heat_content_vprec = register_scalar_field('ocean_model', & 'total_heat_content_vprec', Time, diag, & @@ -1600,7 +1596,7 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use handles%id_total_net_heat_coupler = register_scalar_field('ocean_model', & 'total_net_heat_coupler', Time, diag, & - long_name='Area integrated surface heat flux from SW+LW+latent+sensible+melth (via the coupler)',& + long_name='Area integrated surface heat flux from SW+LW+latent+sensible+seaice_melt_heat (via the coupler)',& units='W') handles%id_total_net_heat_surface = register_scalar_field('ocean_model', & @@ -1681,8 +1677,8 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use long_name='Area integrated surface heat flux from restoring and/or flux adjustment', & units='W') - handles%id_total_melth = register_scalar_field('ocean_model',& - 'total_melth', Time, diag, & + handles%id_total_seaice_melt_heat = register_scalar_field('ocean_model',& + 'total_seaice_melt_heat', Time, diag, & long_name='Area integrated surface heat flux from snow and sea ice melt', & units='W') @@ -1691,12 +1687,13 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use handles%id_net_heat_coupler_ga = register_scalar_field('ocean_model', & 'net_heat_coupler_ga', Time, diag, & - long_name='Area averaged surface heat flux from SW+LW+latent+sensible+melth (via the coupler)',& + long_name='Area averaged surface heat flux from SW+LW+latent+sensible+seaice_melt_heat (via the coupler)',& units='W m-2') handles%id_net_heat_surface_ga = register_scalar_field('ocean_model', & 'net_heat_surface_ga', Time, diag, & - long_name='Area averaged surface heat flux from SW+LW+lat+sens+mass+frazil+restore+melth or flux adjustments', & + long_name='Area averaged surface heat flux from SW+LW+lat+sens+mass+frazil+restore+seaice_melt_heat', & + ' or flux adjustments', & units='W m-2', & cmor_field_name='ave_hfds', & cmor_standard_name='surface_downward_heat_flux_in_sea_water_area_averaged', & @@ -1895,7 +1892,7 @@ subroutine fluxes_accumulate(flux_tmp, fluxes, dt, G, wt2, forces) fluxes%vprec(i,j) = wt1*fluxes%vprec(i,j) + wt2*flux_tmp%vprec(i,j) fluxes%lrunoff(i,j) = wt1*fluxes%lrunoff(i,j) + wt2*flux_tmp%lrunoff(i,j) fluxes%frunoff(i,j) = wt1*fluxes%frunoff(i,j) + wt2*flux_tmp%frunoff(i,j) - fluxes%meltw(i,j) = wt1*fluxes%meltw(i,j) + wt2*flux_tmp%meltw(i,j) + fluxes%seaice_melt(i,j) = wt1*fluxes%seaice_melt(i,j) + wt2*flux_tmp%seaice_melt(i,j) fluxes%sw(i,j) = wt1*fluxes%sw(i,j) + wt2*flux_tmp%sw(i,j) fluxes%sw_vis_dir(i,j) = wt1*fluxes%sw_vis_dir(i,j) + wt2*flux_tmp%sw_vis_dir(i,j) fluxes%sw_vis_dif(i,j) = wt1*fluxes%sw_vis_dif(i,j) + wt2*flux_tmp%sw_vis_dif(i,j) @@ -1928,9 +1925,9 @@ subroutine fluxes_accumulate(flux_tmp, fluxes, dt, G, wt2, forces) fluxes%heat_content_fprec(i,j) = wt1*fluxes%heat_content_fprec(i,j) + wt2*flux_tmp%heat_content_fprec(i,j) enddo ; enddo endif - if (associated(fluxes%heat_content_meltw) .and. associated(flux_tmp%heat_content_meltw)) then + if (associated(fluxes%heat_content_icemelt) .and. associated(flux_tmp%heat_content_icemelt)) then do j=js,je ; do i=is,ie - fluxes%heat_content_meltw(i,j) = wt1*fluxes%heat_content_meltw(i,j) + wt2*flux_tmp%heat_content_meltw(i,j) + fluxes%heat_content_icemelt(i,j) = wt1*fluxes%heat_content_icemelt(i,j) + wt2*flux_tmp%heat_content_icemelt(i,j) enddo ; enddo endif if (associated(fluxes%heat_content_vprec) .and. associated(flux_tmp%heat_content_vprec)) then @@ -2102,8 +2099,8 @@ subroutine get_net_mass_forcing(fluxes, G, net_mass_src) if (associated(fluxes%evap)) then ; do j=js,je ; do i=is,ie net_mass_src(i,j) = net_mass_src(i,j) + fluxes%evap(i,j) enddo ; enddo ; endif - if (associated(fluxes%meltw)) then ; do j=js,je ; do i=is,ie - net_mass_src(i,j) = net_mass_src(i,j) + fluxes%meltw(i,j) + if (associated(fluxes%seaice_melt)) then ; do j=js,je ; do i=is,ie + net_mass_src(i,j) = net_mass_src(i,j) + fluxes%seaice_melt(i,j) enddo ; enddo ; endif end subroutine get_net_mass_forcing @@ -2202,7 +2199,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%lrunoff)) res(i,j) = res(i,j)+fluxes%lrunoff(i,j) if (associated(fluxes%frunoff)) res(i,j) = res(i,j)+fluxes%frunoff(i,j) if (associated(fluxes%vprec)) res(i,j) = res(i,j)+fluxes%vprec(i,j) - if (associated(fluxes%meltw)) res(i,j) = res(i,j)+fluxes%meltw(i,j) + if (associated(fluxes%seaice_melt)) res(i,j) = res(i,j)+fluxes%seaice_melt(i,j) enddo ; enddo if (handles%id_prcme > 0) call post_data(handles%id_prcme, res, diag) if (handles%id_total_prcme > 0) then @@ -2218,10 +2215,10 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (handles%id_net_massout > 0 .or. handles%id_total_net_massout > 0) then do j=js,je ; do i=is,ie res(i,j) = 0.0 - if (fluxes%lprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%lprec(i,j) - if (fluxes%vprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%vprec(i,j) - if (fluxes%evap(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) - if (fluxes%meltw(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%meltw(i,j) + if (fluxes%lprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%lprec(i,j) + if (fluxes%vprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%vprec(i,j) + if (fluxes%evap(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) + if (fluxes%seaice_melt(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%seaice_melt(i,j) enddo ; enddo if (handles%id_net_massout > 0) call post_data(handles%id_net_massout, res, diag) if (handles%id_total_net_massout > 0) then @@ -2235,11 +2232,11 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (handles%id_net_massin > 0 .or. handles%id_total_net_massin > 0) then do j=js,je ; do i=is,ie res(i,j) = fluxes%fprec(i,j) + fluxes%lrunoff(i,j) + fluxes%frunoff(i,j) - if (fluxes%lprec(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%lprec(i,j) - if (fluxes%vprec(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%vprec(i,j) + if (fluxes%lprec(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%lprec(i,j) + if (fluxes%vprec(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%vprec(i,j) ! fluxes%cond is not needed because it is derived from %evap > 0 - if (fluxes%evap(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) - if (fluxes%meltw(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%meltw(i,j) + if (fluxes%evap(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) + if (fluxes%seaice_melt(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%seaice_melt(i,j) enddo ; enddo if (handles%id_net_massin > 0) call post_data(handles%id_net_massin, res, diag) if (handles%id_total_net_massin > 0) then @@ -2328,11 +2325,11 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) endif endif - if (associated(fluxes%meltw)) then - if (handles%id_meltw > 0) call post_data(handles%id_meltw, fluxes%meltw, diag) - if (handles%id_total_meltw > 0) then - total_transport = global_area_integral(fluxes%meltw,G) - call post_data(handles%id_total_meltw, total_transport, diag) + if (associated(fluxes%seaice_melt)) then + if (handles%id_seaice_melt > 0) call post_data(handles%id_seaice_melt, fluxes%seaice_melt, diag) + if (handles%id_total_seaice_melt > 0) then + total_transport = global_area_integral(fluxes%seaice_melt,G) + call post_data(handles%id_total_seaice_melt, total_transport, diag) endif endif @@ -2366,11 +2363,11 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) call post_data(handles%id_total_heat_content_fprec, total_transport, diag) endif - if ((handles%id_heat_content_meltw > 0) .and. associated(fluxes%heat_content_meltw)) & - call post_data(handles%id_heat_content_meltw, fluxes%heat_content_meltw, diag) - if ((handles%id_total_heat_content_meltw > 0) .and. associated(fluxes%heat_content_meltw)) then - total_transport = global_area_integral(fluxes%heat_content_meltw,G) - call post_data(handles%id_total_heat_content_meltw, total_transport, diag) + if ((handles%id_heat_content_icemelt > 0) .and. associated(fluxes%heat_content_icemelt)) & + call post_data(handles%id_heat_content_icemelt, fluxes%heat_content_icemelt, diag) + if ((handles%id_total_heat_content_icemelt > 0) .and. associated(fluxes%heat_content_icemelt)) then + total_transport = global_area_integral(fluxes%heat_content_icemelt,G) + call post_data(handles%id_total_heat_content_icemelt, total_transport, diag) endif if ((handles%id_heat_content_vprec > 0) .and. associated(fluxes%heat_content_vprec)) & @@ -2405,11 +2402,11 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) handles%id_net_heat_coupler_ga > 0. ) then do j=js,je ; do i=is,ie res(i,j) = 0.0 - if (associated(fluxes%LW)) res(i,j) = res(i,j) + fluxes%LW(i,j) - if (associated(fluxes%latent)) res(i,j) = res(i,j) + fluxes%latent(i,j) - if (associated(fluxes%sens)) res(i,j) = res(i,j) + fluxes%sens(i,j) - if (associated(fluxes%SW)) res(i,j) = res(i,j) + fluxes%SW(i,j) - if (associated(fluxes%melth)) res(i,j) = res(i,j) + fluxes%melth(i,j) + if (associated(fluxes%LW)) res(i,j) = res(i,j) + fluxes%LW(i,j) + if (associated(fluxes%latent)) res(i,j) = res(i,j) + fluxes%latent(i,j) + if (associated(fluxes%sens)) res(i,j) = res(i,j) + fluxes%sens(i,j) + if (associated(fluxes%SW)) res(i,j) = res(i,j) + fluxes%SW(i,j) + if (associated(fluxes%seaice_melt_heat)) res(i,j) = res(i,j) + fluxes%seaice_melt_heat(i,j) enddo ; enddo if (handles%id_net_heat_coupler > 0) call post_data(handles%id_net_heat_coupler, res, diag) if (handles%id_total_net_heat_coupler > 0) then @@ -2430,7 +2427,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%latent)) res(i,j) = res(i,j) + fluxes%latent(i,j) if (associated(fluxes%sens)) res(i,j) = res(i,j) + fluxes%sens(i,j) if (associated(fluxes%SW)) res(i,j) = res(i,j) + fluxes%SW(i,j) - if (associated(fluxes%melth)) res(i,j) = res(i,j) + fluxes%melth(i,j) + if (associated(fluxes%seaice_melt_heat)) res(i,j) = res(i,j) + fluxes%seaice_melt_heat(i,j) if (associated(sfc_state%frazil)) res(i,j) = res(i,j) + sfc_state%frazil(i,j) * I_dt !if (associated(sfc_state%TempXpme)) then ! res(i,j) = res(i,j) + sfc_state%TempXpme(i,j) * fluxes%C_p * I_dt @@ -2439,7 +2436,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) if (associated(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) if (associated(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) - if (associated(fluxes%heat_content_meltw)) res(i,j) = res(i,j) + fluxes%heat_content_meltw(i,j) + if (associated(fluxes%heat_content_icemelt)) res(i,j) = res(i,j) + fluxes%heat_content_icemelt(i,j) if (associated(fluxes%heat_content_vprec)) res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j) if (associated(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) if (associated(fluxes%heat_content_massout)) res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j) @@ -2467,7 +2464,7 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) if (associated(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) if (associated(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) if (associated(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) - if (associated(fluxes%heat_content_meltw)) res(i,j) = res(i,j) + fluxes%heat_content_meltw(i,j) + if (associated(fluxes%heat_content_icemelt)) res(i,j) = res(i,j) + fluxes%heat_content_icemelt(i,j) if (associated(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) if (associated(fluxes%heat_content_vprec)) res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j) if (associated(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) @@ -2600,13 +2597,13 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) call post_data(handles%id_sens, fluxes%sens, diag) endif - if ((handles%id_melth > 0) .and. associated(fluxes%melth)) then - call post_data(handles%id_melth, fluxes%melth, diag) + if ((handles%id_seaice_melt_heat > 0) .and. associated(fluxes%seaice_melt_heat)) then + call post_data(handles%id_seaice_melt_heat, fluxes%seaice_melt_heat, diag) endif - if ((handles%id_total_melth > 0) .and. associated(fluxes%melth)) then - total_transport = global_area_integral(fluxes%melth,G) - call post_data(handles%id_total_melth, total_transport, diag) + if ((handles%id_total_seaice_melt_heat > 0) .and. associated(fluxes%seaice_melt_heat)) then + total_transport = global_area_integral(fluxes%seaice_melt_heat,G) + call post_data(handles%id_total_seaice_melt_heat, total_transport, diag) endif if ((handles%id_total_sens > 0) .and. associated(fluxes%sens)) then @@ -2722,11 +2719,11 @@ subroutine allocate_forcing_type(G, fluxes, water, heat, ustar, press, shelf, ic call myAlloc(fluxes%vprec,isd,ied,jsd,jed, water) call myAlloc(fluxes%lrunoff,isd,ied,jsd,jed, water) call myAlloc(fluxes%frunoff,isd,ied,jsd,jed, water) - call myAlloc(fluxes%meltw,isd,ied,jsd,jed, water) + call myAlloc(fluxes%seaice_melt,isd,ied,jsd,jed, water) call myAlloc(fluxes%netMassOut,isd,ied,jsd,jed, water) call myAlloc(fluxes%netMassIn,isd,ied,jsd,jed, water) call myAlloc(fluxes%netSalt,isd,ied,jsd,jed, water) - call myAlloc(fluxes%melth,isd,ied,jsd,jed, heat) + call myAlloc(fluxes%seaice_melt_heat,isd,ied,jsd,jed, heat) call myAlloc(fluxes%sw,isd,ied,jsd,jed, heat) call myAlloc(fluxes%lw,isd,ied,jsd,jed, heat) call myAlloc(fluxes%latent,isd,ied,jsd,jed, heat) @@ -2739,7 +2736,7 @@ subroutine allocate_forcing_type(G, fluxes, water, heat, ustar, press, shelf, ic if (present(heat) .and. present(water)) then ; if (heat .and. water) then call myAlloc(fluxes%heat_content_cond,isd,ied,jsd,jed, .true.) - call myAlloc(fluxes%heat_content_meltw,isd,ied,jsd,jed, .true.) + call myAlloc(fluxes%heat_content_icemelt,isd,ied,jsd,jed, .true.) call myAlloc(fluxes%heat_content_lprec,isd,ied,jsd,jed, .true.) call myAlloc(fluxes%heat_content_fprec,isd,ied,jsd,jed, .true.) call myAlloc(fluxes%heat_content_vprec,isd,ied,jsd,jed, .true.) @@ -2822,7 +2819,7 @@ subroutine deallocate_forcing_type(fluxes) if (associated(fluxes%ustar_gustless)) deallocate(fluxes%ustar_gustless) if (associated(fluxes%buoy)) deallocate(fluxes%buoy) if (associated(fluxes%sw)) deallocate(fluxes%sw) - if (associated(fluxes%melth)) deallocate(fluxes%melth) + if (associated(fluxes%seaice_melt_heat)) deallocate(fluxes%seaice_melt_heat) if (associated(fluxes%sw_vis_dir)) deallocate(fluxes%sw_vis_dir) if (associated(fluxes%sw_vis_dif)) deallocate(fluxes%sw_vis_dif) if (associated(fluxes%sw_nir_dir)) deallocate(fluxes%sw_nir_dir) @@ -2836,7 +2833,7 @@ subroutine deallocate_forcing_type(fluxes) if (associated(fluxes%heat_added)) deallocate(fluxes%heat_added) if (associated(fluxes%heat_content_lrunoff)) deallocate(fluxes%heat_content_lrunoff) if (associated(fluxes%heat_content_frunoff)) deallocate(fluxes%heat_content_frunoff) - if (associated(fluxes%heat_content_meltw)) deallocate(fluxes%heat_content_meltw) + if (associated(fluxes%heat_content_icemelt)) deallocate(fluxes%heat_content_icemelt) if (associated(fluxes%heat_content_lprec)) deallocate(fluxes%heat_content_lprec) if (associated(fluxes%heat_content_fprec)) deallocate(fluxes%heat_content_fprec) if (associated(fluxes%heat_content_cond)) deallocate(fluxes%heat_content_cond) @@ -2848,7 +2845,7 @@ subroutine deallocate_forcing_type(fluxes) if (associated(fluxes%vprec)) deallocate(fluxes%vprec) if (associated(fluxes%lrunoff)) deallocate(fluxes%lrunoff) if (associated(fluxes%frunoff)) deallocate(fluxes%frunoff) - if (associated(fluxes%meltw)) deallocate(fluxes%meltw) + if (associated(fluxes%seaice_melt)) deallocate(fluxes%seaice_melt) if (associated(fluxes%salt_flux)) deallocate(fluxes%salt_flux) if (associated(fluxes%p_surf_full)) deallocate(fluxes%p_surf_full) if (associated(fluxes%p_surf)) deallocate(fluxes%p_surf) @@ -2986,7 +2983,7 @@ end subroutine deallocate_mech_forcing !! * non-penetrative = non-downwelling shortwave; portion of SW !! totally absorbed in the k=1 cell. !! The non-penetrative SW is combined with -!! LW+LAT+SENS+MELTH in net_heat inside routine +!! LW+LAT+SENS+seaice_melt_heat in net_heat inside routine !! extractFluxes1d. Notably, for many cases, !! non-penetrative SW = 0. !! * penetrative = that portion of shortwave penetrating below diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 6640a864c2..8265dc3cbf 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -952,8 +952,8 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) endif endif - if (associated(fluxes%meltw)) then ; do j=js,je ; do i=is,ie - FW_in(i,j) = FW_in(i,j) + dt * G%areaT(i,j) * fluxes%meltw(i,j) + if (associated(fluxes%seaice_melt)) then ; do j=js,je ; do i=is,ie + FW_in(i,j) = FW_in(i,j) + dt * G%areaT(i,j) * fluxes%seaice_melt(i,j) enddo ; enddo ; endif salt_in(:,:) = 0.0 ; heat_in(:,:) = 0.0 @@ -964,8 +964,8 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) (fluxes%lw(i,j) + (fluxes%latent(i,j) + fluxes%sens(i,j)))) enddo ; enddo ; endif - if (associated(fluxes%melth)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + dt*G%areaT(i,j) * fluxes%melth(i,j) + if (associated(fluxes%seaice_melt_heat)) then ; do j=js,je ; do i=is,ie + heat_in(i,j) = heat_in(i,j) + dt*G%areaT(i,j) * fluxes%seaice_melt_heat(i,j) enddo ; enddo ; endif ! smg: new code From e67fdaf9ade603abf6cc5bd9ebda3874263f14dc Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 30 Jan 2019 14:37:03 -0700 Subject: [PATCH 0994/1072] Fix syntax errors --- src/core/MOM_forcing_type.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index c5cec683a3..1b2633dbaa 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -1314,7 +1314,7 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use cmor_long_name='Evaporation Where Ice Free Ocean over Sea Area Integrated') ! seaice_melt field requires updates to the sea ice model - handles%id_total_icemelt = register_scalar_field('ocean_model', 'total_icemelt', Time, diag, & + handles%id_total_seaice_melt = register_scalar_field('ocean_model', 'total_icemelt', Time, diag, & long_name='Area integrated sea ice melt (>0) or form (<0)', units='kg s-1', & standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics_area_integrated', & cmor_field_name='total_fsitherm', & @@ -1456,9 +1456,9 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use diag%axesT1,Time,'Surface ocean heat flux from SW+LW+latent+sensible+seaice_melt_heat (via the coupler)',& 'W m-2') - handles%id_net_heat_surface = register_diag_field('ocean_model', 'net_heat_surface',diag%axesT1, & - Time,'Surface ocean heat flux from SW+LW+lat+sens+mass transfer+frazil+restore+seaice_melt_heat', & - 'or flux adjustments', 'W m-2',& + handles%id_net_heat_surface = register_diag_field('ocean_model', 'net_heat_surface',diag%axesT1, Time, & + 'Surface ocean heat flux from SW+LW+lat+sens+mass transfer+frazil+restore+seaice_melt_heat or flux adjustments',& + 'W m-2',& standard_name='surface_downward_heat_flux_in_sea_water', cmor_field_name='hfds', & cmor_standard_name='surface_downward_heat_flux_in_sea_water', & cmor_long_name='Surface ocean heat flux from SW+LW+latent+sensible+masstransfer+frazil+seaice_melt_heat') @@ -1692,7 +1692,7 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use handles%id_net_heat_surface_ga = register_scalar_field('ocean_model', & 'net_heat_surface_ga', Time, diag, & - long_name='Area averaged surface heat flux from SW+LW+lat+sens+mass+frazil+restore+seaice_melt_heat', & + long_name='Area averaged surface heat flux from SW+LW+lat+sens+mass+frazil+restore+seaice_melt_heat'& ' or flux adjustments', & units='W m-2', & cmor_field_name='ave_hfds', & From c1f804b777b64232d05b0f8777761d3d47568c7e Mon Sep 17 00:00:00 2001 From: Rocky Dunlap Date: Wed, 30 Jan 2019 21:50:32 +0000 Subject: [PATCH 0995/1072] Move statement that should be inside an if block --- config_src/nuopc_driver/mom_cap.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index b03ee9c0d3..8e55795b9a 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1741,9 +1741,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out - call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) - if (geomtype == ESMF_GEOMTYPE_GRID) then + + call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) + call ESMF_FieldGet(field_t_surf, localDe=0, farrayPtr=t_surf2d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & From 91933c1b573a49d16aeb9f40ece36120274f0cec Mon Sep 17 00:00:00 2001 From: Rocky Dunlap Date: Wed, 30 Jan 2019 21:53:52 +0000 Subject: [PATCH 0996/1072] Revert "Do not end diag manager. This seems to be needed in order for the coupled system with FV3 and MOM to finalize." This reverts commit e472d93d11086e9a21a11e261b791714a500a7e1. --- config_src/nuopc_driver/MOM_ocean_model.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 0e962bfdc1..28ae82750a 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -741,7 +741,7 @@ subroutine ocean_model_end(Ocean_sfc, Ocean_state, Time, write_restart) logical, intent(in) :: write_restart !< true => write restart file call ocean_model_save_restart(Ocean_state, Time) - call diag_mediator_end(Time, Ocean_state%diag, end_diag_manager=.false.) + call diag_mediator_end(Time, Ocean_state%diag, end_diag_manager=.true.) 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 From c9c88de06154fa5788e027101d63e0968dc1a309 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 30 Jan 2019 15:42:37 -0700 Subject: [PATCH 0997/1072] Fix more syntax errors --- src/core/MOM_forcing_type.F90 | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 1b2633dbaa..1edb0df298 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -1561,9 +1561,9 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use units='W') handles%id_total_heat_content_icemelt = register_scalar_field('ocean_model', & - 'total_heat_content_icemelt', Time, diag, & - long_name='Area integrated heat content (relative to 0C) of water flux due sea ice '& - 'melting/freezing', units='W') + 'total_heat_content_icemelt', Time, diag,long_name= & + 'Area integrated heat content (relative to 0C) of water flux due sea ice melting/freezing', & + units='W') handles%id_total_heat_content_vprec = register_scalar_field('ocean_model', & 'total_heat_content_vprec', Time, diag, & @@ -1691,9 +1691,8 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use units='W m-2') handles%id_net_heat_surface_ga = register_scalar_field('ocean_model', & - 'net_heat_surface_ga', Time, diag, & - long_name='Area averaged surface heat flux from SW+LW+lat+sens+mass+frazil+restore+seaice_melt_heat'& - ' or flux adjustments', & + 'net_heat_surface_ga', Time, diag, long_name= & + 'Area averaged surface heat flux from SW+LW+lat+sens+mass+frazil+restore+seaice_melt_heat or flux adjustments' & units='W m-2', & cmor_field_name='ave_hfds', & cmor_standard_name='surface_downward_heat_flux_in_sea_water_area_averaged', & From 7e76893b0e1e12c15a14e07d55bc487b3a6d4d9b Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 30 Jan 2019 15:57:33 -0700 Subject: [PATCH 0998/1072] Proper syntax is overrated. Fix more of them. --- src/core/MOM_forcing_type.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 1edb0df298..701f25aac0 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -1692,7 +1692,7 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use handles%id_net_heat_surface_ga = register_scalar_field('ocean_model', & 'net_heat_surface_ga', Time, diag, long_name= & - 'Area averaged surface heat flux from SW+LW+lat+sens+mass+frazil+restore+seaice_melt_heat or flux adjustments' & + 'Area averaged surface heat flux from SW+LW+lat+sens+mass+frazil+restore+seaice_melt_heat or flux adjustments', & units='W m-2', & cmor_field_name='ave_hfds', & cmor_standard_name='surface_downward_heat_flux_in_sea_water_area_averaged', & From 5a5fc420c27c1382245d0e0541b434027474e654 Mon Sep 17 00:00:00 2001 From: Rocky Dunlap Date: Thu, 31 Jan 2019 15:48:42 -0600 Subject: [PATCH 0999/1072] Added check to allow running MOM with debug flags on --- src/core/MOM.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 1a590bb5b8..8ff49c628c 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1153,7 +1153,10 @@ subroutine step_MOM_thermo(CS, G, GV, u, v, h, tv, fluxes, dtdia, & call enable_averaging(dtdia, Time_end_thermo, CS%diag) - call apply_oda_tracer_increments(dtdia,G,tv,h,CS%odaCS) + ! added check in order to run MOM with debug flags + if (CS%ensemble_ocean) then + call apply_oda_tracer_increments(dtdia,G,tv,h,CS%odaCS) + end if if (update_BBL) then ! Calculate the BBL properties and store them inside visc (u,h). From 8233da23165adc2ac9a2c409af09b17ce7cec137 Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Thu, 31 Jan 2019 17:43:00 -0500 Subject: [PATCH 1000/1072] Diagnostics downsampling, shorten line more than 120 chars long - This update shortens the lines that were more than 120 chars long. --- src/framework/MOM_diag_mediator.F90 | 49 +++++++++++++++-------------- 1 file changed, 25 insertions(+), 24 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index cfc4eebb51..d862f8c815 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -144,24 +144,24 @@ module MOM_diag_mediator end type diag_grid_storage !> integers to encode the total cell methods -!integer :: PPP=111 !< x:point,y:point,z:point, this kind of diagnostic is not currently present in diag_table.MOM6 -!integer :: PPS=112 !< x:point,y:point,z:sum , this kind of diagnostic is not currently present in diag_table.MOM6 -!integer :: PPM=113 !< x:point,y:point,z:mean , this kind of diagnostic is not currently present in diag_table.MOM6 -integer :: PSP=121 !< x:point,y:sum,z:point -integer :: PSS=122 !< x:point,y:sum,z:point -integer :: PSM=123 !< x:point,y:sum,z:mean -integer :: PMP=131 !< x:point,y:mean,z:point -integer :: PMM=133 !< x:point,y:mean,z:mean -integer :: SPP=211 !< x:sum,y:point,z:point -integer :: SPS=212 !< x:sum,y:point,z:sum -integer :: SSP=221 !< x:sum;y:sum,z:point -integer :: MPP=311 !< x:mean,y:point,z:point -integer :: MPM=313 !< x:mean,y:point,z:mean -integer :: MMP=331 !< x:mean,y:mean,z:point -integer :: MMS=332 !< x:mean,y:mean,z:sum -integer :: SSS=222 !< x:sum,y:sum,z:sum -integer :: MMM=333 !< x:mean,y:mean,z:mean -integer :: MSK=-1 !< Use the downsample method of a mask +!integer :: PPP=111 ! x:point,y:point,z:point, this kind of diagnostic is not currently present in diag_table.MOM6 +!integer :: PPS=112 ! x:point,y:point,z:sum , this kind of diagnostic is not currently present in diag_table.MOM6 +!integer :: PPM=113 ! x:point,y:point,z:mean , this kind of diagnostic is not currently present in diag_table.MOM6 +integer :: PSP=121 ! x:point,y:sum,z:point +integer :: PSS=122 ! x:point,y:sum,z:point +integer :: PSM=123 ! x:point,y:sum,z:mean +integer :: PMP=131 ! x:point,y:mean,z:point +integer :: PMM=133 ! x:point,y:mean,z:mean +integer :: SPP=211 ! x:sum,y:point,z:point +integer :: SPS=212 ! x:sum,y:point,z:sum +integer :: SSP=221 ! x:sum;y:sum,z:point +integer :: MPP=311 ! x:mean,y:point,z:point +integer :: MPM=313 ! x:mean,y:point,z:mean +integer :: MMP=331 ! x:mean,y:mean,z:point +integer :: MMS=332 ! x:mean,y:mean,z:sum +integer :: SSS=222 ! x:sum,y:sum,z:sum +integer :: MMM=333 ! x:mean,y:mean,z:mean +integer :: MSK=-1 ! Use the downsample method of a mask !> This type is used to represent a diagnostic at the diag_mediator level. !! @@ -794,7 +794,7 @@ subroutine set_masks_for_axes_dsamp(G, diag_cs) !The downsampled mask is needed for sending out the diagnostics output via diag_manager !The non-downsampled mask is needed for downsampling the diagnostics field do dl=2,MAX_DSAMP_LEV - if(dl .ne. 2) call MOM_error(FATAL, "set_masks_for_axes_dsamp: Downsample level other than 2 is not supported yet!") + if(dl .ne. 2) call MOM_error(FATAL, "set_masks_for_axes_dsamp: Downsample level other than 2 is not supported!") do c=1, diag_cs%num_diag_coords ! Level/layer h-points in diagnostic coordinate axes => diag_cs%remap_axesTL(c) @@ -834,7 +834,7 @@ subroutine set_masks_for_axes_dsamp(G, diag_cs) ! Interface q-points in diagnostic coordinate axes => diag_cs%remap_axesBi(c) call downsample_mask(axes%mask3d, diag_cs%dsamp(dl)%remap_axesBi(c)%dsamp(dl)%mask3d, dl,G%IscB,G%JscB, & - G%HId2%IscB,G%HId2%IecB,G%HId2%JscB,G%HId2%JecB,G%HId2%IsdB,G%HId2%IedB,G%HId2%JsdB,G%HId2%JedB)!set downsampled mask + G%HId2%IscB,G%HId2%IecB,G%HId2%JscB,G%HId2%JecB,G%HId2%IsdB,G%HId2%IedB,G%HId2%JsdB,G%HId2%JedB) diag_cs%dsamp(dl)%remap_axesBi(c)%mask3d => axes%mask3d !set non-downsampled mask enddo enddo @@ -3543,16 +3543,17 @@ subroutine downsample_diag_indices_get(fo1,fo2, dl, diag_cs,isv,iev,jsv,jev) character(len=500) :: mesg logical, save :: first_check = .true. - !Check ONCE that the downsampled diag-compute domain is commensurate with the original non-downsampled diag-compute domain + !Check ONCE that the downsampled diag-compute domain is commensurate with the original + !non-downsampled diag-compute domain. !This is a major limitation of the current implementation of the downsampled diagnostics. !We assume that the compute domain can be subdivided to dl*dl cells, hence avoiding the need of halo updates. !We want this check to error out only if there was a downsampled diagnostics requested and about to post that is - !why the check is here and not in the init routines. This check need to be done only once, hence the outer if statement + !why the check is here and not in the init routines. This check need to be done only once, hence the outer if. if(first_check) then if(mod(diag_cs%ie-diag_cs%is+1, dl) .ne. 0 .OR. mod(diag_cs%je-diag_cs%js+1, dl) .ne. 0) then write (mesg,*) "Non-commensurate downsampled domain is not supported. "//& - "Please choose a layout such that NIGLOBAL/Layout_X and NJGLOBAL/Layout_Y are both divisible by dl=",dl, " Current domain extents: ",& - diag_cs%is,diag_cs%ie, diag_cs%js,diag_cs%je + "Please choose a layout such that NIGLOBAL/Layout_X and NJGLOBAL/Layout_Y are both divisible by dl=",dl,& + " Current domain extents: ", diag_cs%is,diag_cs%ie, diag_cs%js,diag_cs%je call MOM_error(FATAL,"downsample_diag_indices_get: "//trim(mesg)) endif first_check = .false. From 501b90bf23390247aa39b6e23aa2791e18bd8428 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 5 Feb 2019 13:20:33 -0700 Subject: [PATCH 1001/1072] removed mom_cap_share.F90 --- .../nuopc_driver/MOM_surface_forcing.F90 | 7 +++- config_src/nuopc_driver/mom_cap.F90 | 38 +++++++++++++++-- config_src/nuopc_driver/mom_cap_methods.F90 | 19 ++++++++- config_src/nuopc_driver/mom_cap_share.F90 | 42 ------------------- 4 files changed, 57 insertions(+), 49 deletions(-) delete mode 100644 config_src/nuopc_driver/mom_cap_share.F90 diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index a21b00f839..68355a79a3 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -40,7 +40,6 @@ module MOM_surface_forcing 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 -use mom_cap_share implicit none ; private @@ -197,6 +196,12 @@ module MOM_surface_forcing integer :: id_clock_forcing +#ifdef CESMCOUPLED + logical :: cesm_coupled = .true. +#else + logical :: cesm_coupled = .false. +#endif + !======================================================================= contains !======================================================================= diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 8e55795b9a..5a44f3d6e4 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -394,8 +394,11 @@ module mom_cap_mod use MOM_ocean_model, only: ocean_model_data_get, ocean_model_init_sfc use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid use mom_cap_time, only: AlarmInit - use mom_cap_methods, only: mom_import, mom_export - use mom_cap_share + use mom_cap_methods, only: mom_import, mom_export, mom_set_geomtype +#ifdef CESMCOUPLED + use shr_file_mod, only: shr_file_setLogUnit, shr_file_getLogUnit +#endif + use time_utils_mod, only: esmf2fms_time use, intrinsic :: iso_fortran_env, only: output_unit @@ -408,8 +411,6 @@ module mom_cap_mod model_label_SetRunClock => label_SetRunClock, & model_label_Finalize => label_Finalize - use time_utils_mod, only: esmf2fms_time - implicit none private @@ -453,6 +454,14 @@ module mom_cap_mod character(len=*),parameter :: u_file_u = & __FILE__ +#ifdef CESMCOUPLED + logical :: cesm_coupled = .true. + type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_MESH +#else + logical :: cesm_coupled = .false. + type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID +#endif + !======================================================================= contains !======================================================================= @@ -1766,6 +1775,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if end if + !--------------------------------- + ! Set module variable geomtype in mom_cap_methods + !--------------------------------- + call mom_set_geomtype(geomtype, cesm_coupled) + !--------------------------------- ! write out diagnostics !--------------------------------- @@ -2623,4 +2637,20 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname) end subroutine fld_list_add +!======================================================================= + +#ifndef CESMCOUPLED + subroutine shr_file_setLogUnit(nunit) + integer, intent(in) :: nunit + ! do nothing for this stub - its just here to replace + ! having cppdefs in the main program + end subroutine shr_file_setLogUnit + + subroutine shr_file_getLogUnit(nunit) + integer, intent(in) :: nunit + ! do nothing for this stub - its just here to replace + ! having cppdefs in the main program + end subroutine shr_file_getLogUnit +#endif + end module mom_cap_mod diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index c1de995004..f428c09d4e 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -24,13 +24,13 @@ module mom_cap_methods use MOM_grid, only: ocean_grid_type use MOM_domains, only: pass_var use mpp_domains_mod, only: mpp_get_compute_domain - use mom_cap_share ! By default make data private implicit none private ! Public member functions + public :: mom_set_geomtype public :: mom_import public :: mom_export @@ -42,10 +42,25 @@ module mom_cap_methods module procedure State_GetFldPtr_2d end interface - integer :: import_cnt = 0 + integer :: import_cnt = 0 + type(ESMF_GeomType_Flag) :: geomtype + logical :: cesm_coupled !=============================================================================== contains +!=============================================================================== + + subroutine mom_set_geomtype(geomtype_in, cesm_coupled_in) + ! Set module variable geomtype and cesm_coupled + + type(ESMF_GeomType_Flag), intent(in) :: geomtype_in !< mesh or grid + logical , intent(in) :: cesm_coupled_in !< nems or cmeps + + geomtype = geomtype_in + cesm_coupled = cesm_coupled_in + + end subroutine mom_set_geomtype + !=============================================================================== !> This function has a few purposes: diff --git a/config_src/nuopc_driver/mom_cap_share.F90 b/config_src/nuopc_driver/mom_cap_share.F90 deleted file mode 100644 index cc13f39548..0000000000 --- a/config_src/nuopc_driver/mom_cap_share.F90 +++ /dev/null @@ -1,42 +0,0 @@ -module mom_cap_share - ! Temporary module for sharing ccp defs and other settings - ! betwen NEMS and CMEPS - - use ESMF , only: ESMF_GeomType_Flag - use ESMF , only: ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID -#ifdef CESMCOUPLED - use shr_file_mod , only: shr_file_setLogUnit, shr_file_getLogUnit -#endif - - implicit none - public - - integer :: shrlogUnit - -#ifdef CESMCOUPLED - logical :: cesm_coupled = .true. - type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_MESH -#else - logical :: cesm_coupled = .false. - type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID -#endif - -!======================================================================= -contains -!======================================================================= - -#ifndef CESMCOUPLED - subroutine shr_file_setLogUnit(nunit) - integer, intent(in) :: nunit - ! do nothing for this stub - its just here to replace - ! having cppdefs in the main program - end subroutine shr_file_setLogUnit - - subroutine shr_file_getLogUnit(nunit) - integer, intent(in) :: nunit - ! do nothing for this stub - its just here to replace - ! having cppdefs in the main program - end subroutine shr_file_getLogUnit -#endif - -end module mom_cap_share From fb2773620976877b52e101663ac9cdee4163c3c8 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 5 Feb 2019 22:20:11 +0000 Subject: [PATCH 1002/1072] Fixed line lengths >120 - 2 lines in config_src/mct_driver/ocn_cap_methods.F90 and 1 line in src/core/MOM_forcing_type.F90 were over 120 characters. - No answer changes. --- config_src/mct_driver/ocn_cap_methods.F90 | 6 ++++-- src/core/MOM_forcing_type.F90 | 3 ++- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index a5c98a83dc..7ec581628e 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -123,8 +123,10 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, write(logunit,F01)'import: day, secs, j, i, lwrad = ',day,secs,j,i,ice_ocean_boundary%lw_flux(i,j) write(logunit,F01)'import: day, secs, j, i, q_flux = ',day,secs,j,i,ice_ocean_boundary%q_flux(i,j) write(logunit,F01)'import: day, secs, j, i, t_flux = ',day,secs,j,i,ice_ocean_boundary%t_flux(i,j) - write(logunit,F01)'import: day, secs, j, i, seaice_melt_heat = ',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, seaice_melt_heat = ',& + 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 = ',& diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 701f25aac0..361c9ee009 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -1457,7 +1457,8 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use 'W m-2') handles%id_net_heat_surface = register_diag_field('ocean_model', 'net_heat_surface',diag%axesT1, Time, & - 'Surface ocean heat flux from SW+LW+lat+sens+mass transfer+frazil+restore+seaice_melt_heat or flux adjustments',& + 'Surface ocean heat flux from SW+LW+lat+sens+mass transfer+frazil+restore+seaice_melt_heat or '// & + 'flux adjustments',& 'W m-2',& standard_name='surface_downward_heat_flux_in_sea_water', cmor_field_name='hfds', & cmor_standard_name='surface_downward_heat_flux_in_sea_water', & From dc54281b97fd984b865a379e4cedad99e35d0ea6 Mon Sep 17 00:00:00 2001 From: Rocky Dunlap Date: Wed, 6 Feb 2019 12:15:39 -0700 Subject: [PATCH 1003/1072] Workaround for scalar field tranfer error - requires changes in CIME and CICE --- config_src/nuopc_driver/mom_cap.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 8e55795b9a..79c8486766 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -2432,7 +2432,7 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ return endif - farrayptr(1,scalar_id) = value + farrayptr(scalar_id,1) = value endif end subroutine State_SetScalar @@ -2578,7 +2578,7 @@ subroutine SetScalarField(field, rc) return ! bail out field = ESMF_FieldCreate(name=trim(scalar_field_name), grid=grid, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), rc=rc) ! num of scalar values + ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), gridToFieldMap=(/2/), rc=rc) ! num of scalar values if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & From e95bbe39853b32d7a48d979683a2ac1ec76effda Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 14 Feb 2019 20:04:45 +0000 Subject: [PATCH 1004/1072] Fixes of typos/bugs for unifyMOM2019 cap --- config_src/nuopc_driver/mom_cap_methods.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index f428c09d4e..38ef24c94f 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -614,14 +614,14 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, end if call State_SetExport(exportState, trim(fldname_x), & - isc, iec, jsc, jec, ocean_public%u_surf, ocean_grid, rc=rc) + isc, iec, jsc, jec, ocz_rot, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out call State_SetExport(exportState, trim(fldname_y), & - isc, iec, jsc, jec, ocean_public%v_surf, ocean_grid, rc=rc) + isc, iec, jsc, jec, ocm_rot, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -840,7 +840,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ig = i + ocean_grid%isc - isc dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) & - ocean_grid%sin_rot(ig,jg)*dhdy(i,j) - dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) & + dhdy_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) & + ocean_grid%sin_rot(ig,jg)*dhdx(i,j) end do end do @@ -851,19 +851,19 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ig = i + ocean_grid%isc - isc dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) & + ocean_grid%sin_rot(ig,jg)*dhdy(i,j) - dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) & + dhdy_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) & - ocean_grid%sin_rot(ig,jg)*dhdx(i,j) end do end do end if - call State_SetExport(exportState, trim(fldname_x), isc, iec, jsc, jec, dhdx, ocean_grid, rc=rc) + call State_SetExport(exportState, trim(fldname_x), isc, iec, jsc, jec, dhdx_rot, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_SetExport(exportState, trim(fldname_y), isc, iec, jsc, jec, dhdy, ocean_grid, rc=rc) + call State_SetExport(exportState, trim(fldname_y), isc, iec, jsc, jec, dhdy_rot, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1036,7 +1036,7 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid integer :: lbnd1,lbnd2 real(ESMF_KIND_R8), pointer :: dataPtr1d(:) real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) - character(len=*) , parameter :: subname='(mom_cap_methods_:state_setimport)' + character(len=*) , parameter :: subname='(mom_cap_methods_:state_setexport)' ! ---------------------------------------------- rc = ESMF_SUCCESS From 3c4624da014ce56342ce5303a1d17384fa3c4442 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sun, 17 Feb 2019 12:30:45 +0000 Subject: [PATCH 1005/1072] Two typo fixes; next round will contain resolution of rotations, removal of unneeded EMC code, fixed comments regarding local/global indices --- config_src/nuopc_driver/mom_cap_methods.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 38ef24c94f..16a13b0d27 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -744,7 +744,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, fldname_y = 'So_dhdy' else fldname_x = 'sea_surface_slope_zonal' - fldname_x = 'sea_surface_slope_merid' + fldname_y = 'sea_surface_slope_merid' end if allocate(ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !global indices @@ -1036,7 +1036,7 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid integer :: lbnd1,lbnd2 real(ESMF_KIND_R8), pointer :: dataPtr1d(:) real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) - character(len=*) , parameter :: subname='(mom_cap_methods_:state_setexport)' + character(len=*) , parameter :: subname='(mom_cap_methods:state_setexport)' ! ---------------------------------------------- rc = ESMF_SUCCESS From b1bdecfa2cbea4303e54d1a27556a90ce7dda9b7 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 18 Feb 2019 12:50:49 -0700 Subject: [PATCH 1006/1072] major cleanup of mom_cap_methods.F90 and mom_cap.F90 to unify cap further - this will NOT be bfb --- .../nuopc_driver/MOM_surface_forcing.F90 | 50 +- config_src/nuopc_driver/mom_cap.F90 | 221 +++---- config_src/nuopc_driver/mom_cap_methods.F90 | 598 ++++++------------ 3 files changed, 282 insertions(+), 587 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 68355a79a3..17aa40de6d 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -155,7 +155,6 @@ module MOM_surface_forcing ! 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) @@ -293,15 +292,13 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & call safe_alloc_ptr(fluxes%sw_nir_dir,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%sw_nir_dif,isd,ied,jsd,jed) - if (.not. cesm_coupled) then - 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 - end if + 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) @@ -470,25 +467,20 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & if (associated(IOB%t_flux)) & fluxes%sens(i,j) = IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) - ! Note: currently latent heat flux is treated differently for nems and cesm - if (associated(IOB%latent_flux)) then - fluxes%latent(i,j) = G%mask2dT(i,j) * IOB%latent_flux(i-i0,j-j0) - else - fluxes%latent(i,j) = 0.0 - 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 - if (associated(IOB%calving)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion - fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion - endif - if (associated(IOB%q_flux)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor - fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor - endif - fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) - end if + fluxes%latent(i,j) = 0.0 + 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 + if (associated(IOB%calving)) then + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion + endif + if (associated(IOB%q_flux)) then + fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor + fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor + endif + fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) 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) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 5a44f3d6e4..a41ca3ed3a 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -34,15 +34,13 @@ !! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_howtodoc/) !! how-to document. !! -!! The MOM cap package includes the cap itself (mom_cap.F90, a Fortran module), a +!! The MOM cap package includes the cap code itself (mom_cap.F90 and mom_cap_methods.F90), a !! set of time utilities (time_utils.F90) for converting between ESMF and FMS -!! time types, and two makefiles. Also included are self-describing dependency -!! makefile fragments (mom.mk and mom.mk.template), although these can be generated -!! by the makefiles for specific installations of the MOM cap. +!! time type and two modules MOM_ocean_model.F90 and MOM_surface_forcing.F90. !! !! @subsection CapSubroutines Cap Subroutines !! -!! The MOM cap Fortran module contains a set of subroutines that are required +!! The MOM cap Fortran modules contains a set of subroutines that are required !! by NUOPC. These subroutines are called by the NUOPC infrastructure according !! to a predefined calling sequence. Some subroutines are called during !! initialization of the coupled system, some during the run of the coupled @@ -447,10 +445,10 @@ module mom_cap_mod integer :: logunit ! stdout logging unit number logical :: profile_memory = .true. logical :: grid_attach_area = .false. - character(len=128) :: scalar_field_name - integer :: scalar_field_count - integer :: scalar_field_idx_grid_nx - integer :: scalar_field_idx_grid_ny + character(len=128) :: scalar_field_name = '' + integer :: scalar_field_count = 0 + integer :: scalar_field_idx_grid_nx = 0 + integer :: scalar_field_idx_grid_ny = 0 character(len=*),parameter :: u_file_u = & __FILE__ @@ -755,7 +753,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) type(time_type) :: DT integer :: DT_OCEAN integer :: isc,iec,jsc,jec - integer :: dt_cpld = 86400 integer :: year=0, month=0, day=0, hour=0, minute=0, second=0 integer :: mpi_comm_mom integer :: i,n @@ -824,7 +821,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call diag_manager_init ! this ocean connector will be driven at set interval - dt_cpld = DT_OCEAN DT = set_time (DT_OCEAN, 0) Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) @@ -946,8 +942,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ocean_public%is_ocean_pe = .true. if (len_trim(restartfile) > 0) then - call ocean_model_init(ocean_public, ocean_state, Time, Time, & - input_restart_file=trim(restartfile)) + call ocean_model_init(ocean_public, ocean_state, Time, Time, input_restart_file=trim(restartfile)) else call ocean_model_init(ocean_public, ocean_state, Time, Time) endif @@ -955,6 +950,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ocean_model_init_sfc(ocean_state, ocean_public) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + allocate ( Ice_ocean_boundary% u_flux (isc:iec,jsc:jec), & Ice_ocean_boundary% v_flux (isc:iec,jsc:jec), & Ice_ocean_boundary% t_flux (isc:iec,jsc:jec), & @@ -967,17 +963,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) Ice_ocean_boundary% sw_flux_nir_dif (isc:iec,jsc:jec), & Ice_ocean_boundary% lprec (isc:iec,jsc:jec), & Ice_ocean_boundary% fprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% mi (isc:iec,jsc:jec), & + Ice_ocean_boundary% p (isc:iec,jsc:jec), & Ice_ocean_boundary% runoff (isc:iec,jsc:jec), & Ice_ocean_boundary% calving (isc:iec,jsc:jec), & Ice_ocean_boundary% runoff_hflx (isc:iec,jsc:jec), & Ice_ocean_boundary% calving_hflx (isc:iec,jsc:jec), & - Ice_ocean_boundary% mi (isc:iec,jsc:jec), & - Ice_ocean_boundary% p (isc:iec,jsc:jec)) - if (cesm_coupled) then - allocate( Ice_ocean_boundary% rofl_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% rofi_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% latent_flux (isc:iec,jsc:jec)) - end if + Ice_ocean_boundary% rofl_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% rofi_flux (isc:iec,jsc:jec)) Ice_ocean_boundary%u_flux = 0.0 Ice_ocean_boundary%v_flux = 0.0 @@ -991,17 +984,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) Ice_ocean_boundary%sw_flux_nir_dif = 0.0 Ice_ocean_boundary%lprec = 0.0 Ice_ocean_boundary%fprec = 0.0 + Ice_ocean_boundary%mi = 0.0 + Ice_ocean_boundary%p = 0.0 Ice_ocean_boundary%runoff = 0.0 Ice_ocean_boundary%calving = 0.0 Ice_ocean_boundary%runoff_hflx = 0.0 Ice_ocean_boundary%calving_hflx = 0.0 - Ice_ocean_boundary%mi = 0.0 - Ice_ocean_boundary%p = 0.0 - if (cesm_coupled) then - Ice_ocean_boundary%rofl_flux = 0.0 - Ice_ocean_boundary%rofi_flux = 0.0 - Ice_ocean_boundary%latent_flux = 0.0 - end if + Ice_ocean_boundary%rofl_flux = 0.0 + Ice_ocean_boundary%rofi_flux = 0.0 ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) @@ -1010,88 +1000,55 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out - ! CESM fields currently not used in cesm_coupled - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") - ! call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - ! call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen", "will provide") - if (cesm_coupled) then - - !--------- import fields ------------- - if (len_trim(scalar_field_name) > 0) then - call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") ! not in EMC - endif - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") ! -> mean_zonal_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") ! -> mean_merid_moment_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") ! -> mean_sensi_heat_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" , "will provide") ! -> mean latent heat flux - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") ! -> mean_evap_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! -> mean_salt_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwnet" , "will_provide") ! -> mean net lwnet - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_vdr" , "will provide") ! -> mean_net_sw_ir_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_vdf" , "will provide") ! -> mean_net_sw_vis_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_idr" , "will provide") ! -> mean_net_sw_ir_dir_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_idf" , "will provide") ! -> mean_net_sw_vis_dif_flx - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") ! -> mean_prec_rat - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") ! -> mean_fprec_rate - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") ! -> liquid runoff - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") ! -> ice runoff - call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") ! -> inst_pres_height_surface - - !--------- export fields ------------- if (len_trim(scalar_field_name) > 0) then - call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide") ! not in EMC + call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide") endif - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask" , "will provide") ! -> ocean_mask - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t" , "will provide") ! -> sea_surface_temperature - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide") ! -> s_surf - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u" , "will provide") ! -> ocn_current_zonal - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") ! -> ocn_current_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") ! -> sea_surface_slope_zonal - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") ! -> sea_surface_slope_merid - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") ! -> not in EMC - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") ! -> freezing_melting_potential - + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen" , "will provide") else - - !--------- import fields ------------- - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") ! not used in NEMS - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") ! not used in NEMS - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") ! not used in NEMS - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") ! not used in NEMS - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") ! not used in NEMS - - !--------- export fields ------------- - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "accum_heat_frazil" , "will provide") ! not used in NEMS - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "inst_melt_potential" , "will provide") ! not used in NEMS - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") ! not used in NEMS + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") end if + !--------- import fields ------------- + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide") ! from ice + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") !-> liquid runoff + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") !-> ice runoff + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") + + !--------- export fields ------------- + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") + do n = 1,fldsToOcn_num call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)%shortname, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1134,6 +1091,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) type(ESMF_DeLayout) :: delayout type(ESMF_Distgrid) :: Distgrid type(ESMF_DistGridConnection), allocatable :: connectionList(:) + type(ESMF_StateItem_Flag) :: itemFlag type (ocean_public_type), pointer :: ocean_public => NULL() type (ocean_state_type), pointer :: ocean_state => NULL() type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() @@ -1148,7 +1106,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer, allocatable :: deLabelList(:) integer, allocatable :: indexList(:) integer :: ioff, joff - integer :: i, j, n, i1, j1, n1, icount + integer :: i, j, n, i1, j1, n1 integer :: lbnd1,ubnd1,lbnd2,ubnd2 integer :: lbnd3,ubnd3,lbnd4,ubnd4 integer :: nblocks_tot @@ -1175,9 +1133,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) rc = ESMF_SUCCESS - if (cesm_coupled) then - call shr_file_setLogUnit (logunit) - end if + call shr_file_setLogUnit (logunit) !---------------------------------------------------------------------------- ! Get pointers to ocean internal state @@ -1730,28 +1686,17 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! TODO (mvertens, 2018-12-30): is this really necessary? for now only do this for grid - if (cesm_coupled) then - fldname = 'So_t' - else - fldname = 'sea_surface_temperature' - end if - - call ESMF_StateGet(exportState, itemSearch=trim(fldname), itemCount=icount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - ! Do sst initialization if it's part of export state - if (icount /= 0) then - call ESMF_StateGet(exportState, itemName=trim(fldname), field=field_t_surf, rc=rc) + call ESMF_StateGet(exportState, 'sea_surface_temperature', itemFlag) + if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then + + call ESMF_StateGet(exportState, 'sea_surface_temperature', field=field_t_surf, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out if (geomtype == ESMF_GEOMTYPE_GRID) then - call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) call ESMF_FieldGet(field_t_surf, localDe=0, farrayPtr=t_surf2d, rc=rc) @@ -1778,7 +1723,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !--------------------------------- ! Set module variable geomtype in mom_cap_methods !--------------------------------- - call mom_set_geomtype(geomtype, cesm_coupled) + call mom_set_geomtype(geomtype) !--------------------------------- ! write out diagnostics @@ -1809,7 +1754,6 @@ subroutine DataInitialize(gcomp, rc) type(ocean_grid_type), pointer :: ocean_grid character(240) :: msgString integer :: fieldCount, n - integer :: dt_cpld = 86400 type(ESMF_Field) :: field character(len=64),allocatable :: fieldNameList(:) character(len=*),parameter :: subname='(mom_cap:DataInitialize)' @@ -1834,7 +1778,7 @@ subroutine DataInitialize(gcomp, rc) call get_ocean_grid(ocean_state, ocean_grid) if (cesm_coupled) then - call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, dt_cpld, rc=rc) + call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1921,7 +1865,7 @@ subroutine ModelAdvance(gcomp, rc) type(time_type) :: Time type(time_type) :: Time_step_coupled type(time_type) :: Time_restart_current - integer :: dth, dtm, dts, dt_cpld = 86400 + integer :: dth, dtm, dts integer :: nc type(ESMF_Time) :: MyTime integer :: seconds, day, year, month, hour, minute @@ -1933,9 +1877,7 @@ subroutine ModelAdvance(gcomp, rc) rc = ESMF_SUCCESS if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") - if (cesm_coupled) then - call shr_file_setLogUnit (logunit) - end if + call shr_file_setLogUnit (logunit) ! query the Component for its clock, importState and exportState call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & @@ -1989,19 +1931,8 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out - !--------------- - ! Determine dt_cpld (needed for export) - !--------------- - - call ESMF_TimeIntervalGet(timeStep, h=dth, m=dtm, s=dts, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - Time = esmf2fms_time(currTime) Time_step_coupled = esmf2fms_time(timeStep) - dt_cpld = dth*3600 + dtm*60 + dts !--------------- ! Write diagnostics for import @@ -2027,9 +1958,7 @@ subroutine ModelAdvance(gcomp, rc) ! Import data !--------------- - if (cesm_coupled) then - call shr_file_setLogUnit (logunit) - end if + call shr_file_setLogUnit (logunit) if (cesm_coupled) then call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype=runtype, rc=rc) @@ -2071,15 +2000,13 @@ subroutine ModelAdvance(gcomp, rc) ! Export Data !--------------- - call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, dt_cpld, rc=rc) + call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - if (cesm_coupled) then - call shr_file_setLogUnit (logunit) - end if + call shr_file_setLogUnit (logunit) !--------------- ! If restart alarm is ringing - write restart file diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index f428c09d4e..1b5a963b51 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -43,21 +43,18 @@ module mom_cap_methods end interface integer :: import_cnt = 0 - type(ESMF_GeomType_Flag) :: geomtype - logical :: cesm_coupled + type(ESMF_GeomType_Flag) :: geomtype !=============================================================================== contains !=============================================================================== - subroutine mom_set_geomtype(geomtype_in, cesm_coupled_in) - ! Set module variable geomtype and cesm_coupled + subroutine mom_set_geomtype(geomtype_in) + ! Set module variable geomtype type(ESMF_GeomType_Flag), intent(in) :: geomtype_in !< mesh or grid - logical , intent(in) :: cesm_coupled_in !< nems or cmeps geomtype = geomtype_in - cesm_coupled = cesm_coupled_in end subroutine mom_set_geomtype @@ -66,8 +63,6 @@ end subroutine mom_set_geomtype !> This function has a few purposes: !! (1) it imports surface fluxes using data from the mediator; and !! (2) 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. subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype, rc) @@ -80,16 +75,13 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, integer , intent(inout) :: rc ! Local Variables - type(ESMF_StateItem_Flag) :: itemFlag integer :: i, j, ig, jg, n integer :: isc, iec, jsc, jec logical :: do_import character(len=128) :: fldname - character(len=128) :: fldname_x - character(len=128) :: fldname_y real(ESMF_KIND_R8), allocatable :: taux(:,:) real(ESMF_KIND_R8), allocatable :: tauy(:,:) - character(len=*) , parameter :: subname = '(mom_import_cesm)' + character(len=*) , parameter :: subname = '(mom_import)' !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -110,17 +102,13 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, end if if (do_import) then + ! The following are global indices without halos call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) !---- ! surface height pressure !---- - if (cesm_coupled) then - fldname = 'Sa_pslv' - else - fldname = 'inst_pres_height_surface' - end if - call state_getimport(importState, trim(fldname), & + call state_getimport(importState, 'inst_pres_height_surface', & isc, iec, jsc, jec, ice_ocean_boundary%p, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -130,12 +118,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! near-IR, direct shortwave (W/m2) !---- - if (cesm_coupled) then - fldname = 'Foxx_swnet_idr' - else - fldname = 'mean_net_sw_ir_dir_flx' - end if - call state_getimport(importState, trim(fldname), & + call state_getimport(importState, 'mean_net_sw_ir_dir_flx', & isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -145,12 +128,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! near-IR, diffuse shortwave (W/m2) !---- - if (cesm_coupled) then - fldname = 'Foxx_swnet_idf' - else - fldname = 'mean_net_sw_ir_dif_flx' - end if - call state_getimport(importState, trim(fldname), & + call state_getimport(importState, 'mean_net_sw_ir_dif_flx', & isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -160,12 +138,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! visible, direct shortwave (W/m2) !---- - if (cesm_coupled) then - fldname = 'Foxx_swnet_vdr' - else - fldname = 'mean_net_sw_vis_dir_flx' - end if - call state_getimport(importState, trim(fldname), & + call state_getimport(importState, 'mean_net_sw_vis_dir_flx', & isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -175,12 +148,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! visible, diffuse shortwave (W/m2) !---- - if (cesm_coupled) then - fldname = 'Foxx_swnet_vdf' - else - fldname = 'mean_net_sw_vis_dif_flx' - end if - call state_getimport(importState, trim(fldname), & + call state_getimport(importState, 'mean_net_sw_vis_dif_flx', & isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -190,12 +158,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! ------- ! Net longwave radiation (W/m2) ! ------- - if (cesm_coupled) then - fldname = 'Foxx_lwnet' - else - fldname = 'mean_net_lw_flx' - end if - call state_getimport(importState, trim(fldname), & + call state_getimport(importState, 'mean_net_lw_flx', & isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -205,62 +168,38 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! zonal and meridional surface stress !---- - if (cesm_coupled) then - fldname_x = 'Foxx_taux' - fldname_y = 'Foxx_tauy' - else - fldname_x = 'mean_zonal_moment_flx' - fldname_y = 'mean_merid_moment_flx' - end if - allocate (taux(isc:iec,jsc:jec)) allocate (tauy(isc:iec,jsc:jec)) - call state_getimport(importState, trim(fldname_x), isc, iec, jsc, jec, taux, rc=rc) + + call state_getimport(importState, 'mean_zonal_moment_flx', isc, iec, jsc, jec, taux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call state_getimport(importState, trim(fldname_y), isc, iec, jsc, jec, tauy, rc=rc) + call state_getimport(importState, 'mean_merid_moment_flx', isc, iec, jsc, jec, tauy, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out ! rotate taux and tauy from true zonal/meridional to local coordinates - ! Note - this is the latest calculation from Gustavo - pointed out that the NEMS calculation is incorrect - if (cesm_coupled) then - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg) * taux(i,j) & - + ocean_grid%sin_rot(ig,jg) * tauy(i,j) - ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg) * tauy(i,j) & - - ocean_grid%sin_rot(ig,jg) * taux(i,j) - end do - end do - else - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg)*taux(i,j) & - - ocean_grid%sin_rot(ig,jg)*tauy(i,j) - ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg)*tauy(i,j) & - + ocean_grid%sin_rot(ig,jg)*taux(i,j) - end do + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg)*taux(i,j) & + - ocean_grid%sin_rot(ig,jg)*tauy(i,j) + ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg)*tauy(i,j) & + + ocean_grid%sin_rot(ig,jg)*taux(i,j) end do - end if + end do + + deallocate(taux, tauy) !---- ! sensible heat flux (W/m2) !---- - if (cesm_coupled) then - fldname = 'Foxx_sen' - else - fldname = 'mean_sensi_heat_flx' - end if - call state_getimport(importState, trim(fldname), & + call state_getimport(importState, 'mean_sensi_heat_flx', & isc, iec, jsc, jec, ice_ocean_boundary%t_flux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -268,28 +207,9 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, return ! bail out !---- - ! latent heat flux (W/m2) + ! evaporation flux (W/m2) !---- - if (cesm_coupled) then - ! Note - this field is not exported by the nems mediator - fldname = 'Foxx_lat' - call state_getimport(importState, trim(fldname), & - isc, iec, jsc, jec, ice_ocean_boundary%latent_flux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if - - !---- - ! specific humidity flux (W/m2) - !---- - if (cesm_coupled) then - fldname = 'Foxx_evap' - else - fldname = 'mean_evap_rate' - end if - call state_getimport(importState, trim(fldname), & + call state_getimport(importState, 'mean_evap_rate', & isc, iec, jsc, jec, ice_ocean_boundary%q_flux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -299,12 +219,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! liquid precipitation (rain) !---- - if (cesm_coupled) then - fldname = 'Faxa_rain' - else - fldname = 'mean_prec_rate' - end if - call state_getimport(importState, trim(fldname), & + call state_getimport(importState, 'mean_prec_rate', & isc, iec, jsc, jec, ice_ocean_boundary%lprec, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -314,12 +229,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! frozen precipitation (snow) !---- - if (cesm_coupled) then - fldname = 'Faxa_snow' - else - fldname = 'mean_fprec_rate' - end if - call state_getimport(importState, trim(fldname), & + call state_getimport(importState, 'mean_fprec_rate', & isc, iec, jsc, jec, ice_ocean_boundary%fprec, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -329,109 +239,97 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! runoff and heat content of runoff !---- - if (cesm_coupled) then - ! liquid runoff - fldname = 'Foxx_rofl' - call state_getimport(importState, trim(fldname), & - isc, iec, jsc, jec, ice_ocean_boundary%rofl_flux,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! Note - preset values to 0, if field does not exist in importState, then will simply return + ! and preset value will be used - ! ice runoff - fldname = 'Foxx_rofi' - call state_getimport(importState, trim(fldname), & - isc, iec, jsc, jec, ice_ocean_boundary%rofi_flux,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! liquid runoff + ice_ocean_boundary%rofl_flux (:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'Foxx_rofl', & + isc, iec, jsc, jec, ice_ocean_boundary%rofl_flux,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ! GMM, cime does not not have an equivalent for heat_content_lrunoff and - ! heat_content_frunoff. Setting these to zero for now. - ice_ocean_boundary%runoff_hflx(:,:) = 0._ESMF_KIND_R8 - ice_ocean_boundary%calving_hflx(:,:) = 0._ESMF_KIND_R8 + ! ice runoff + ice_ocean_boundary%rofi_flux (:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'Foxx_rofi', & + isc, iec, jsc, jec, ice_ocean_boundary%rofi_flux,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - else - ! total runoff - fldname = 'mean_runoff_rate' - call state_getimport(importState, trim(fldname), & - isc, iec, jsc, jec, ice_ocean_boundary%runoff, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! total runoff + ice_ocean_boundary%runoff (:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_runoff_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%runoff, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ! heat content of runoff - fldname = 'mean_runoff_heat_flux' - call state_getimport(importState, trim(fldname), & - isc, iec, jsc, jec, ice_ocean_boundary%runoff_hflx, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if + ! heat content of runoff + ice_ocean_boundary%runoff_hflx(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_runoff_heat_flux', & + isc, iec, jsc, jec, ice_ocean_boundary%runoff_hflx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! calving rate and heat flux !---- - if (.not. cesm_coupled) then - fldname = 'mean_calving_rate' - call state_getimport(importState, trim(fldname), & - isc, iec, jsc, jec, ice_ocean_boundary%calving, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! Note - preset values to 0, if field does not exist in importState, then will simply return + ! and preset value will be used - fldname = 'mean_calving_heat_flux' - call state_getimport(importState, trim(fldname), & - isc, iec, jsc, jec, ice_ocean_boundary%calving_hflx, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if + ice_ocean_boundary%calving(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_calving_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%calving, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ice_ocean_boundary%calving_hflx(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_calving_heat_flux', & + isc, iec, jsc, jec, ice_ocean_boundary%calving_hflx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! salt flux from ice !---- - if (cesm_coupled) then - fldname = 'Fioi_salt' - else - fldname = 'mean_salt_rate' - end if - call state_getimport(importState, trim(fldname), & + call state_getimport(importState, 'mean_salt_rate', & isc, iec, jsc, jec, ice_ocean_boundary%salt_flux,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - if (cesm_coupled) then - ! salt flux (minus sign needed here -GMM) - ! TODO (mvertens, 2018-12-28): NEMS does not have a minus sign - which one is right? - do j = jsc,jec - do i = isc,iec - ice_ocean_boundary%salt_flux(i,j) = - ice_ocean_boundary%salt_flux(i,j) - enddo + ! TODO: salt flux (minus sign needed here -GMM) - this does not match either NEMS or MCT - so not put in below + do j = jsc,jec + do i = isc,iec + ice_ocean_boundary%salt_flux(i,j) = ice_ocean_boundary%salt_flux(i,j) enddo - end if + enddo !---- ! mass of overlying ice !---- - fldname = 'mass_of_overlying_ice' - call ESMF_StateGet(importState, trim(fldname), itemFlag) - if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then - call state_getimport(importState, trim(fldname), & - isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if + ! Note - preset values to 0, if field does not exist in importState, then will simply return + ! and preset value will be used + + ice_ocean_boundary%mi(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mass_of_overlying_ice', & + isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out end if @@ -440,21 +338,21 @@ end subroutine mom_import !=============================================================================== !> Maps outgoing ocean data to ESMF State - subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, dt_cpld, rc) + subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc) ! Input/output variables type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid - type (ocean_state_type) , pointer :: ocean_state + type(ocean_state_type) , pointer :: ocean_state type(ESMF_State) , intent(inout) :: exportState !< outgoing data - type(ESMF_Clock) , intent(in) :: clock ! cesm - integer , intent(in) :: dt_cpld ! nems + type(ESMF_Clock) , intent(in) :: clock integer , intent(inout) :: rc ! Local variables - integer :: i, j, ig, jg ! grid indices - integer :: isc, iec, jsc, jec ! local indices - integer :: iloc, jloc ! local indices + integer :: i, j, ig, jg ! indices + integer :: isc, iec, jsc, jec ! indices + integer :: iloc, jloc ! indices + integer :: iglob, jglob ! indices integer :: n integer :: icount real :: slp_L, slp_R, slp_C @@ -464,21 +362,14 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, integer :: dt_int real :: inv_dt_int !< The inverse of coupling time interval in s-1. type(ESMF_StateItem_Flag) :: itemFlag - type(ESMF_StateItem_Flag) :: itemFlag1 - type(ESMF_StateItem_Flag) :: itemFlag2 - character(len=128) :: fldname - character(len=128) :: fldname_x - character(len=128) :: fldname_y real(ESMF_KIND_R8), allocatable :: omask(:,:) real(ESMF_KIND_R8), allocatable :: melt_potential(:,:) - real(ESMF_KIND_R8), allocatable :: frazil(:,:) - real(ESMF_KIND_R8), allocatable :: frzmlt(:,:) real(ESMF_KIND_R8), allocatable :: ocz(:,:), ocm(:,:) real(ESMF_KIND_R8), allocatable :: ocz_rot(:,:), ocm_rot(:,:) real(ESMF_KIND_R8), allocatable :: ssh(:,:) real(ESMF_KIND_R8), allocatable :: dhdx(:,:), dhdy(:,:) real(ESMF_KIND_R8), allocatable :: dhdx_rot(:,:), dhdy_rot(:,:) - character(len=*), parameter :: subname = '(mom_export)' + character(len=*) , parameter :: subname = '(mom_export)' !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -489,11 +380,13 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, line=__LINE__, & file=__FILE__)) & return ! bail out + call ESMF_TimeIntervalGet( timeStep, s=dt_int, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + if (real(dt_int) > 0.0) then inv_dt_int = 1.0 / real(dt_int) else @@ -509,39 +402,27 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! ------- ! ocean mask ! ------- - if (cesm_coupled) then - fldname = 'So_omask' - else - fldname = 'ocean_mask' - end if allocate(omask(isc:iec, jsc:jec)) - ! TODO (mvertens, 2018-12-29): which is the correct formulation? - if (cesm_coupled) then - omask(:,:) = 1._ESMF_KIND_R8 - else - call ocean_model_data_get(ocean_state, ocean_public, 'mask', omask, isc, jsc) - do j = jsc,jec - do i = isc,iec - omask(i,j) = nint(omask(i,j)) - enddo + call ocean_model_data_get(ocean_state, ocean_public, 'mask', omask, isc, jsc) + do j = jsc,jec + do i = isc,iec + omask(i,j) = nint(omask(i,j)) enddo - end if - call State_SetExport(exportState, trim(fldname), & + enddo + + call State_SetExport(exportState, 'ocean_mask', & isc, iec, jsc, jec, omask, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + deallocate(omask) + ! ------- ! Sea surface temperature ! ------- - if (cesm_coupled) then - fldname = 'So_t' - else - fldname = 'sea_surface_temperature' - end if - call State_SetExport(exportState, trim(fldname), & + call State_SetExport(exportState, 'sea_surface_temperature', & isc, iec, jsc, jec, ocean_public%t_surf, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -551,12 +432,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! ------- ! Sea surface salinity ! ------- - if (cesm_coupled) then - fldname = 'So_s' - else - fldname = 's_surf' - end if - call State_SetExport(exportState, trim(fldname), & + call State_SetExport(exportState, 's_surf', & isc, iec, jsc, jec, ocean_public%s_surf, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -566,74 +442,47 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! ------- ! zonal and meridional currents ! ------- - if (cesm_coupled) then - fldname_x = 'So_u' - fldname_y = 'So_v' - else - fldname_x = 'ocn_current_zonal' - fldname_y = 'ocn_current_merid' - end if ! rotate ocn current from tripolar grid back to lat/lon grid x,y => latlon (CCW) - ! "ocean_grid" has halos and uses global indexing. - - ! TODO (mvertens, 2018-12-30): Only one of these is correct - the cesm_coupled one is the - ! latest and is the one that GM feels is the correct one + ! "ocean_grid%isc" has no halos and uses local indexing. allocate(ocz(isc:iec, jsc:jec)) allocate(ocm(isc:iec, jsc:jec)) allocate(ocz_rot(isc:iec, jsc:jec)) allocate(ocm_rot(isc:iec, jsc:jec)) - if (cesm_coupled) then - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - ocz(i,j) = ocean_public%u_surf(i,j) - ocm(i,j) = ocean_public%v_surf(i,j) - ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) & - - ocean_grid%sin_rot(ig,jg)*ocm(i,j) - ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) & - + ocean_grid%sin_rot(ig,jg)*ocz(i,j) - end do + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + ocz(i,j) = ocean_public%u_surf(i,j) + ocm(i,j) = ocean_public%v_surf(i,j) + ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) + ocean_grid%sin_rot(ig,jg)*ocm(i,j) + ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) - ocean_grid%sin_rot(ig,jg)*ocz(i,j) end do - else - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - ocz(i,j) = ocean_public%u_surf(i,j) - ocm(i,j) = ocean_public%v_surf(i,j) - ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) & - + ocean_grid%sin_rot(ig,jg)*ocm(i,j) - ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) & - - ocean_grid%sin_rot(ig,jg)*ocz(i,j) - end do - end do - end if + end do - call State_SetExport(exportState, trim(fldname_x), & - isc, iec, jsc, jec, ocean_public%u_surf, ocean_grid, rc=rc) + call State_SetExport(exportState, 'ocn_current_zonal', & + isc, iec, jsc, jec, ocz_rot, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - - call State_SetExport(exportState, trim(fldname_y), & - isc, iec, jsc, jec, ocean_public%v_surf, ocean_grid, rc=rc) + call State_SetExport(exportState, 'ocn_current_merid', & + isc, iec, jsc, jec, ocm_rot, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + deallocate(ocz, ocm, ocz_rot, ocm_rot) + ! ------- ! Boundary layer depth ! ------- - fldname = 'So_bldepth' - call ESMF_StateGet(exportState, trim(fldname), itemFlag, rc=rc) + call ESMF_StateGet(exportState, 'So_bldepth', itemFlag, rc=rc) if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then - call State_SetExport(exportState, trim(fldname), & + call State_SetExport(exportState, 'So_bldepth', & isc, iec, jsc, jec, ocean_public%obld, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -642,92 +491,39 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, end if ! ------- - ! Oean melt and freeze potential + ! Freezing melting potential ! ------- ! melt_potential, defined positive for T>Tfreeze, so need to change sign ! Convert from J/m^2 to W/m^2 and make sure Melt_potential is always <= 0 - if (cesm_coupled) then - fldname = 'Fioo_q' - else - fldname = 'inst_melt_potential' - end if allocate(melt_potential(isc:iec, jsc:jec)) - if (cesm_coupled) then - do j = jsc,jec - do i = isc,iec - if (ocean_public%frazil(i,j) > 0.0) then - melt_potential(i,j) = ocean_public%frazil(i,j) * inv_dt_int - else - melt_potential(i,j) = -ocean_public%melt_potential(i,j) * inv_dt_int - if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 - end if - end do - end do - else - do j = jsc,jec - do i = isc,iec - ! TODO (mvertens, 2018-12-29): use inv_dt_int from cesm - and not the original implementation? - melt_potential(i,j) = -melt_potential(i,j) / dt_cpld + + do j = jsc,jec + do i = isc,iec + if (ocean_public%frazil(i,j) > 0.0) then + melt_potential(i,j) = ocean_public%frazil(i,j) * inv_dt_int + else + melt_potential(i,j) = -ocean_public%melt_potential(i,j) * inv_dt_int if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 - end do + end if end do - end if - call State_SetExport(exportState, trim(fldname), & + end do + + call State_SetExport(exportState, 'freezing_melting_potential', & isc, iec, jsc, jec, melt_potential, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - ! ------- - ! frazil and freezing melting potential - ! ------- - - call ESMF_StateGet(exportState, 'accum_heat_frazil' , itemFlag1) - call ESMF_StateGet(exportState, 'freezing_melting_potential', itemFlag2) - if (itemFlag1 /= ESMF_STATEITEM_NOTFOUND .and. itemFlag2 /= ESMF_STATEITEM_NOTFOUND) then - - allocate(frazil(isc:iec, jsc:jec)) - allocate(frzmlt(isc:iec, jsc:jec)) - - do j = jsc,jec - do i = isc,iec - !convert from J/m^2 to W/m^2 for CICE coupling - frazil(i,j) = ocean_public%frazil(i,j)/dt_cpld - if (frazil(i,j) == 0.0) then - frzmlt(i,j) = melt_potential(i,j) - else - frzmlt(i,j) = frazil(i,j) - endif - frzmlt(i,j) = max(-1000.0,min(1000.0,frzmlt(i,j))) - end do - end do - - fldname = 'accum_heat_frazil' - call State_SetExport(exportState, trim(fldname), & - isc, iec, jsc, jec, frazil, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - fldname = 'freezing_melting_potential' - call State_SetExport(exportState, trim(fldname), & - isc, iec, jsc, jec, frzmlt, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if + deallocate(melt_potential) ! ------- ! Sea level ! ------- - fldname = 'sea_level' - call ESMF_StateGet(exportState, trim(fldname), itemFlag, rc=rc) + call ESMF_StateGet(exportState, 'sea_level', itemFlag, rc=rc) if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then - call State_SetExport(exportState, trim(fldname), & + call State_SetExport(exportState, 'sea_level', & isc, iec, jsc, jec, ocean_public%sea_lev, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -739,24 +535,17 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! Sea-surface zonal and meridional slopes !---------------- - if (cesm_coupled) then - fldname_x = 'So_dhdx' - fldname_y = 'So_dhdy' - else - fldname_x = 'sea_surface_slope_zonal' - fldname_x = 'sea_surface_slope_merid' - end if + allocate(ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) ! local indices with halos + allocate(dhdx(isc:iec, jsc:jec)) !global indices without halos + allocate(dhdy(isc:iec, jsc:jec)) !global indices without halos + allocate(dhdx_rot(isc:iec, jsc:jec)) !global indices without halos + allocate(dhdy_rot(isc:iec, jsc:jec)) !global indices without halos - allocate(ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) !global indices - allocate(dhdx(isc:iec, jsc:jec)) !local indices - allocate(dhdy(isc:iec, jsc:jec)) !local indices - allocate(dhdx_rot(isc:iec, jsc:jec)) !local indices - allocate(dhdy_rot(isc:iec, jsc:jec)) !local indices ssh = 0.0_ESMF_KIND_R8 dhdx = 0.0_ESMF_KIND_R8 dhdy = 0.0_ESMF_KIND_R8 - ! Make a copy of ssh in order to do a halo update (ssh has global indexing with halos) + ! Make a copy of ssh in order to do a halo update (ssh has local indexing with halos) do j = ocean_grid%jsc, ocean_grid%jec jloc = j + ocean_grid%jdg_offset do i = ocean_grid%isc,ocean_grid%iec @@ -765,17 +554,17 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, end do end do - ! Update halo of ssh so we can calculate gradients + ! Update halo of ssh so we can calculate gradients (local indexing) call pass_var(ssh, ocean_grid%domain) ! d/dx ssh ! This is a simple second-order difference ! dhdx(i,j) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) - do jloc = jsc, jec - j = jloc + ocean_grid%jsc - jsc - do iloc = isc,iec - i = iloc + ocean_grid%isc - isc + do jglob = jsc, jec + j = jglob + ocean_grid%jsc - jsc + do iglob = isc,iec + i = iglob + ocean_grid%isc - isc ! This is a PLM slope which might be less prone to the A-grid null mode slp_L = (ssh(I,j) - ssh(I-1,j)) * ocean_grid%mask2dCu(i-1,j) if (ocean_grid%mask2dCu(i-1,j)==0.) slp_L = 0. @@ -793,8 +582,8 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! larger extreme values. slope = 0.0 end if - dhdx(iloc,jloc) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) dhdx(iloc,jloc) = 0.0 + dhdx(iglob,jglob) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) dhdx(iglob,jglob) = 0.0 end do end do @@ -802,10 +591,10 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! This is a simple second-order difference ! dhdy(i,j) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) - do jloc = jsc, jec - j = jloc + ocean_grid%jsc - jsc - do iloc = isc,iec - i = iloc + ocean_grid%isc - isc + do jglob = jsc, jec + j = jglob + ocean_grid%jsc - jsc + do iglob = isc,iec + i = iglob + ocean_grid%isc - isc ! This is a PLM slope which might be less prone to the A-ocean_grid null mode slp_L = ssh(i,J) - ssh(i,J-1) * ocean_grid%mask2dCv(i,j-1) if (ocean_grid%mask2dCv(i,j-1)==0.) slp_L = 0. @@ -823,52 +612,39 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! larger extreme values. slope = 0.0 end if - dhdy(iloc,jloc) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) dhdy(iloc,jloc) = 0.0 + dhdy(iglob,jglob) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) dhdy(iglob,jglob) = 0.0 end do end do ! rotate slopes from tripolar grid back to lat/lon grid, x,y => latlon (CCW) ! "ocean_grid" uses has halos and uses global indexing. - ! TODO (mvertens, 2018-12-30): Only one of these is correct - the cesm_coupled one is the - ! latest and is the one that GM feels is the correct one - if (cesm_coupled) then - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) & - - ocean_grid%sin_rot(ig,jg)*dhdy(i,j) - dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) & - + ocean_grid%sin_rot(ig,jg)*dhdx(i,j) - end do + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) + ocean_grid%sin_rot(ig,jg)*dhdy(i,j) + dhdy_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) - ocean_grid%sin_rot(ig,jg)*dhdx(i,j) end do - else - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) & - + ocean_grid%sin_rot(ig,jg)*dhdy(i,j) - dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) & - - ocean_grid%sin_rot(ig,jg)*dhdx(i,j) - end do - end do - end if + end do - call State_SetExport(exportState, trim(fldname_x), isc, iec, jsc, jec, dhdx, ocean_grid, rc=rc) + call State_SetExport(exportState, 'sea_surface_slope_zonal', & + isc, iec, jsc, jec, dhdx_rot, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call State_SetExport(exportState, trim(fldname_y), isc, iec, jsc, jec, dhdy, ocean_grid, rc=rc) + call State_SetExport(exportState, 'sea_surface_slope_merid', & + isc, iec, jsc, jec, dhdy_rot, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + deallocate(ssh, dhdx, dhdy, dhdx_rot, dhdy_rot) + end subroutine mom_export !=============================================================================== From 7a6ff0b0c5acc97fb7619c1500835533c9f27bba Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 18 Feb 2019 12:53:58 -0700 Subject: [PATCH 1007/1072] changes for restart --- config_src/nuopc_driver/mom_cap.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index a41ca3ed3a..bf5a2d4eac 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -2373,7 +2373,7 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ return endif - farrayptr(1,scalar_id) = value + farrayptr(scalar_id,1) = value endif end subroutine State_SetScalar @@ -2519,7 +2519,7 @@ subroutine SetScalarField(field, rc) return ! bail out field = ESMF_FieldCreate(name=trim(scalar_field_name), grid=grid, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), rc=rc) ! num of scalar values + ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), gridToFieldMap=(/2/), rc=rc) ! num of scalar values if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & From 794a632ef98342cc153c200fec0a0f5a1b309b29 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 21 Feb 2019 18:06:46 +0000 Subject: [PATCH 1008/1072] Commenting out unused fields not in the Nems field dictionary. --- config_src/nuopc_driver/mom_cap.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index bf5a2d4eac..1124715a4f 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1031,8 +1031,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") !-> liquid runoff - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") !-> ice runoff + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") !-> liquid runoff + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") !-> ice runoff !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") @@ -1047,7 +1047,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") do n = 1,fldsToOcn_num call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)%shortname, rc=rc) From 1cf399bf24bbac05938902c1a934d55ace354df1 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 21 Feb 2019 19:53:23 +0000 Subject: [PATCH 1009/1072] dumpMOMinternal is added behind ifdef flag --- config_src/nuopc_driver/mom_cap.F90 | 62 +++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 1124715a4f..c1baa99a1a 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -439,6 +439,7 @@ module mom_cap_mod integer :: debug = 0 integer :: import_slice = 1 integer :: export_slice = 1 + integer :: internal_slice = 1 character(len=256) :: tmpstr logical :: write_diagnostics = .false. character(len=32) :: runtype ! run type @@ -458,6 +459,8 @@ module mom_cap_mod #else logical :: cesm_coupled = .false. type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID + ! for internal field dumps + type(ESMF_Grid), save :: mom_grid_i #endif !======================================================================= @@ -1396,6 +1399,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out + ! save a copy to dump internal fields + mom_grid_i = gridIn + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2108,6 +2114,17 @@ subroutine ModelAdvance(gcomp, rc) export_slice = export_slice + 1 endif +#ifndef CESMCOUPLED + ! dump specified internal files; uncommentd lines will dump fields even if mediator dumps are turned off + !call dumpMomInternal(mom_grid_i, internal_slice, "mean_zonal_moment_flx", Ice_ocean_boundary%u_flux) + !call dumpMomInternal(mom_grid_i, internal_slice, "mean_merid_moment_flx", Ice_ocean_boundary%v_flux) + call dumpMomInternal(mom_grid_i, internal_slice, "mean_sensi_heat_flx" , Ice_ocean_boundary%t_flux) + call dumpMomInternal(mom_grid_i, internal_slice, "mean_evap_rate" , Ice_ocean_boundary%q_flux) + call dumpMomInternal(mom_grid_i, internal_slice, "mean_salt_rate" , Ice_ocean_boundary%salt_flux) + !call dumpMomInternal(mom_grid_i, internal_slice, "mean_prec_rate" , Ice_ocean_boundary%lprec ) + !call dumpMomInternal(mom_grid_i, internal_slice, "mean_fprec_rate" , Ice_ocean_boundary%fprec ) + internal_slice = internal_slice + 1 +#endif if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") end subroutine ModelAdvance @@ -2580,4 +2597,49 @@ subroutine shr_file_getLogUnit(nunit) end subroutine shr_file_getLogUnit #endif +!======================================================================= + +#ifndef CESMCOUPLED + subroutine dumpMomInternal(grid, slice, stdname, farray) + + type(ESMF_Grid) :: grid + integer, intent(in) :: slice + character(len=*) :: stdname + real(ESMF_KIND_R8), dimension(:,:), target :: farray + + type(ESMF_Field) :: field + real(ESMF_KIND_R8), dimension(:,:), pointer :: f2d + integer :: rc + + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, & + indexflag=ESMF_INDEX_DELOCAL, & + name=stdname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_FieldGet(field, farrayPtr=f2d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + f2d(:,:) = farray(:,:) + + call ESMF_FieldWrite(field, fileName='field_ocn_internal_'//trim(stdname)//'.nc', & + timeslice=slice, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_FieldDestroy(field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end subroutine dumpMomInternal +#endif end module mom_cap_mod From f7cfc94da9d9319c3321cfafeb6007b03280cc5d Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sun, 24 Feb 2019 16:59:21 +0000 Subject: [PATCH 1010/1072] Remove code relating to dump internal. This has been moved to separate branch unifyMOA2019withDump --- config_src/nuopc_driver/mom_cap.F90 | 69 ++------------------- config_src/nuopc_driver/mom_cap_methods.F90 | 18 +++--- 2 files changed, 16 insertions(+), 71 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index c1baa99a1a..d0acf3e219 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -439,7 +439,6 @@ module mom_cap_mod integer :: debug = 0 integer :: import_slice = 1 integer :: export_slice = 1 - integer :: internal_slice = 1 character(len=256) :: tmpstr logical :: write_diagnostics = .false. character(len=32) :: runtype ! run type @@ -459,8 +458,6 @@ module mom_cap_mod #else logical :: cesm_coupled = .false. type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID - ! for internal field dumps - type(ESMF_Grid), save :: mom_grid_i #endif !======================================================================= @@ -1399,9 +1396,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out - ! save a copy to dump internal fields - mom_grid_i = gridIn - call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1476,7 +1470,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) return ! bail out endif - + ! TODO: This should be cleaned up now that the ocean_grid is available. + ! Mask, area, center and corner positions are all available. The mask + ! area and center points can be placed in the grid using the same scheme + ! as all other ocean_grid variables are used. The corner points require + ! special treatment to reproduce the original ESMF grid (DLW) + ! load up area, mask, center and corner values ! area, mask, and centers should be same size in mom and esmf grid ! corner points may not be, need to offset corner points by 1 in i and j @@ -2114,17 +2113,6 @@ subroutine ModelAdvance(gcomp, rc) export_slice = export_slice + 1 endif -#ifndef CESMCOUPLED - ! dump specified internal files; uncommentd lines will dump fields even if mediator dumps are turned off - !call dumpMomInternal(mom_grid_i, internal_slice, "mean_zonal_moment_flx", Ice_ocean_boundary%u_flux) - !call dumpMomInternal(mom_grid_i, internal_slice, "mean_merid_moment_flx", Ice_ocean_boundary%v_flux) - call dumpMomInternal(mom_grid_i, internal_slice, "mean_sensi_heat_flx" , Ice_ocean_boundary%t_flux) - call dumpMomInternal(mom_grid_i, internal_slice, "mean_evap_rate" , Ice_ocean_boundary%q_flux) - call dumpMomInternal(mom_grid_i, internal_slice, "mean_salt_rate" , Ice_ocean_boundary%salt_flux) - !call dumpMomInternal(mom_grid_i, internal_slice, "mean_prec_rate" , Ice_ocean_boundary%lprec ) - !call dumpMomInternal(mom_grid_i, internal_slice, "mean_fprec_rate" , Ice_ocean_boundary%fprec ) - internal_slice = internal_slice + 1 -#endif if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") end subroutine ModelAdvance @@ -2597,49 +2585,4 @@ subroutine shr_file_getLogUnit(nunit) end subroutine shr_file_getLogUnit #endif -!======================================================================= - -#ifndef CESMCOUPLED - subroutine dumpMomInternal(grid, slice, stdname, farray) - - type(ESMF_Grid) :: grid - integer, intent(in) :: slice - character(len=*) :: stdname - real(ESMF_KIND_R8), dimension(:,:), target :: farray - - type(ESMF_Field) :: field - real(ESMF_KIND_R8), dimension(:,:), pointer :: f2d - integer :: rc - - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, & - indexflag=ESMF_INDEX_DELOCAL, & - name=stdname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_FieldGet(field, farrayPtr=f2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - f2d(:,:) = farray(:,:) - - call ESMF_FieldWrite(field, fileName='field_ocn_internal_'//trim(stdname)//'.nc', & - timeslice=slice, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_FieldDestroy(field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end subroutine dumpMomInternal -#endif end module mom_cap_mod diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 615752177a..1383af5155 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -2,9 +2,6 @@ module mom_cap_methods ! Cap import/export methods for both NEMS and CMEPS - ! Masks, areas, center (tlat, tlon), and corner (ulat, ulon) coordinates are then added to the `ESMF_Grid` - ! by retrieving those fields from MOM with calls to `ocean_model_data_get()`. - use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet use ESMF, only: ESMF_State, ESMF_StateGet @@ -19,7 +16,8 @@ module mom_cap_methods use ESMF, only: ESMF_RC_VAL_OUTOFRANGE, ESMF_INDEX_DELOCAL, ESMF_MESHLOC_ELEMENT use ESMF, only: ESMF_TYPEKIND_R8 use ESMF, only: operator(/=), operator(==) - use MOM_ocean_model, only: ocean_public_type, ocean_state_type, ocean_model_data_get + !DLW + use MOM_ocean_model, only: ocean_public_type, ocean_state_type use MOM_surface_forcing, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type use MOM_domains, only: pass_var @@ -82,6 +80,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, real(ESMF_KIND_R8), allocatable :: taux(:,:) real(ESMF_KIND_R8), allocatable :: tauy(:,:) character(len=*) , parameter :: subname = '(mom_import)' + !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -402,11 +401,14 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! ------- ! ocean mask ! ------- + + !DLW: Retrieve omask from ocean_grid, as for other grid variables allocate(omask(isc:iec, jsc:jec)) - call ocean_model_data_get(ocean_state, ocean_public, 'mask', omask, isc, jsc) - do j = jsc,jec - do i = isc,iec - omask(i,j) = nint(omask(i,j)) + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + omask(i,j) = nint(ocean_grid%mask2dT(ig,jg)) enddo enddo From a8c5699aa7dbd2601ca04b02951c7d0400a45d85 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 24 Feb 2019 20:18:29 -0700 Subject: [PATCH 1011/1072] fixed IOB%salt_flux sign in MOM_surface_forcing and added hooks for seaice_melt_heat and seaice_melt_water --- .../nuopc_driver/MOM_surface_forcing.F90 | 165 +++++++++--------- config_src/nuopc_driver/mom_cap.F90 | 3 + config_src/nuopc_driver/mom_cap_methods.F90 | 25 ++- 3 files changed, 108 insertions(+), 85 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 17aa40de6d..0facbd43e8 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -155,52 +155,48 @@ module MOM_surface_forcing ! 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(:,:) :: 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(:,:) :: 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. + 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_water =>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 -#ifdef CESMCOUPLED - logical :: cesm_coupled = .true. -#else - logical :: cesm_coupled = .false. -#endif - !======================================================================= contains !======================================================================= @@ -467,6 +463,14 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & 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) + + ! ! 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) + fluxes%latent(i,j) = 0.0 if (associated(IOB%fprec)) then fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion @@ -499,29 +503,26 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & enddo ; enddo - if (.not. cesm_coupled) then - ! 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. + ! 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 - end if + fluxes%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. + endif - ! more salt restoring logic 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) ) + 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 @@ -543,12 +544,16 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j) + ! net_FW(i,j) = netFW(i,j) + fluxes%seaice_melt(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) @@ -1369,27 +1374,29 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) 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%q_flux ', mpp_chksum( iobt%q_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%runoff ', mpp_chksum( iobt%runoff ) - 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_water' , mpp_chksum( iobt%seaice_melt_water) + 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/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index bf5a2d4eac..fce60ab01a 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1033,6 +1033,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") !-> liquid runoff call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") !-> ice runoff + !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_water" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_heat" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 1b5a963b51..bf9851a01b 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -310,12 +310,25 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, file=__FILE__)) & return ! bail out - ! TODO: salt flux (minus sign needed here -GMM) - this does not match either NEMS or MCT - so not put in below - do j = jsc,jec - do i = isc,iec - ice_ocean_boundary%salt_flux(i,j) = ice_ocean_boundary%salt_flux(i,j) - enddo - enddo + ! !---- + ! ! snow&ice melt heat flux (W/m^2) + ! !---- + ! call state_getimport(importState, 'seaice_melt_heat', & + ! isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_heat,rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + + ! !---- + ! ! snow&ice melt water flux (W/m^2) + ! !---- + ! call state_getimport(importState, 'seaice_melt_water', & + ! isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_water,rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out !---- ! mass of overlying ice From 8447a7d3835bac0a642e7b1de226859c3719aca0 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 25 Feb 2019 16:08:10 +0000 Subject: [PATCH 1012/1072] Simplify creation of ESMF grid using halo values available from ocean_grid. Remove ocean_model_data_get from cap since no longer required --- config_src/nuopc_driver/mom_cap.F90 | 192 +++++--------------- config_src/nuopc_driver/mom_cap_methods.F90 | 2 - 2 files changed, 45 insertions(+), 149 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index d0acf3e219..e3e3e9175b 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -366,7 +366,7 @@ module mom_cap_mod use fms_io_mod, only: fms_io_exit use mpp_domains_mod, only: domain2d, mpp_get_compute_domain, mpp_get_compute_domains use mpp_domains_mod, only: mpp_get_ntile_count, mpp_get_pelist, mpp_get_global_domain - use mpp_domains_mod, only: mpp_get_domain_npes, mpp_global_field + use mpp_domains_mod, only: mpp_get_domain_npes use mpp_io_mod, only: mpp_open, MPP_RDONLY, MPP_ASCII, MPP_OVERWR, MPP_APPEND, mpp_close, MPP_SINGLE use mpp_mod, only: input_nml_file, mpp_error, FATAL, NOTE, mpp_pe, mpp_npes, mpp_set_current_pelist use mpp_mod, only: stdlog, stdout, mpp_root_pe, mpp_clock_id @@ -389,7 +389,7 @@ module mom_cap_mod use MOM_ocean_model, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type, get_global_grid_size use MOM_ocean_model, only: ocean_model_restart, ocean_public_type, ocean_state_type - use MOM_ocean_model, only: ocean_model_data_get, ocean_model_init_sfc + use MOM_ocean_model, only: ocean_model_init_sfc use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid use mom_cap_time, only: AlarmInit use mom_cap_methods, only: mom_import, mom_export, mom_set_geomtype @@ -1106,13 +1106,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer, allocatable :: deLabelList(:) integer, allocatable :: indexList(:) integer :: ioff, joff - integer :: i, j, n, i1, j1, n1 + integer :: i, j, n, i1, j1, n1, jlast integer :: lbnd1,ubnd1,lbnd2,ubnd2 integer :: lbnd3,ubnd3,lbnd4,ubnd4 integer :: nblocks_tot logical :: found - real(ESMF_KIND_R8), allocatable :: ofld(:,:), gfld(:,:) - real(ESMF_KIND_R8), pointer :: t_surf1d(:,:) real(ESMF_KIND_R8), pointer :: t_surf2d(:,:) integer(ESMF_KIND_I4), pointer :: dataPtr_mask(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_area(:,:) @@ -1220,14 +1218,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Create either a grid or a mesh !--------------------------------- + !Get the ocean grid and sizes of global and computational domains + call get_ocean_grid(ocean_state, ocean_grid) + if (geomtype == ESMF_GEOMTYPE_MESH) then !--------------------------------- ! Create a MOM6 mesh !--------------------------------- - ! Get the ocean grid and sizes of global and computational domains - call get_ocean_grid(ocean_state, ocean_grid) call get_global_grid_size(ocean_grid, ni, nj) lsize = ( ocean_grid%iec - ocean_grid%isc + 1 ) * ( ocean_grid%jec - ocean_grid%jsc + 1 ) @@ -1470,17 +1469,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) return ! bail out endif - ! TODO: This should be cleaned up now that the ocean_grid is available. - ! Mask, area, center and corner positions are all available. The mask - ! area and center points can be placed in the grid using the same scheme - ! as all other ocean_grid variables are used. The corner points require - ! special treatment to reproduce the original ESMF grid (DLW) - ! load up area, mask, center and corner values ! area, mask, and centers should be same size in mom and esmf grid ! corner points may not be, need to offset corner points by 1 in i and j - ! for esmf and also need to "make up" j=1 values. use wraparound in i - + ! retrieve these values directly from ocean_grid, which contains halos + ! values for j=1 and wrap-around in i. on tripole seam, decomposition + ! domains are 1 larger in j; to load corner values need to loop one extra row + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) lbnd1 = lbound(dataPtr_mask,1) @@ -1509,123 +1504,31 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) return endif - allocate(ofld(isc:iec,jsc:jec)) - allocate(gfld(nxg,nyg)) - - call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld mask = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld mask = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_mask(i,j) = nint(ofld(i1,j1)) - enddo - enddo - - if(grid_attach_area) then - call ocean_model_data_get(ocean_state, ocean_public, 'area', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld area = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld area = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_area(i,j) = ofld(i1,j1) - enddo - enddo - endif - - call ocean_model_data_get(ocean_state, ocean_public, 'tlon', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld xt = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld xt = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_xcen(i,j) = ofld(i1,j1) - dataPtr_xcen(i,j) = mod(dataPtr_xcen(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) - enddo - enddo - - call ocean_model_data_get(ocean_state, ocean_public, 'tlat', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld yt = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld yt = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - dataPtr_ycen(i,j) = ofld(i1,j1) - enddo - enddo - - call ocean_model_data_get(ocean_state, ocean_public, 'geoLonBu', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld xu = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld xu = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd4, ubnd4 - do i = lbnd3, ubnd3 - j1 = j - lbnd4 + jsc - 1 - i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 - if (j1 == 0) then - dataPtr_xcor(i,j) = 2*gfld(i1,1) - gfld(i1,2) - ! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) > 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) - 360. - ! if (dataPtr_xcor(i,j)-dataPtr_xcen(i,j) < 180.) dataPtr_xcor(i,j) = dataPtr_xcor(i,j) + 360. - elseif (j1 >= 1 .and. j1 <= nyg) then - dataPtr_xcor(i,j) = gfld(i1,j1) - else - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": error in xu j1.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - dataPtr_xcor(i,j) = mod(dataPtr_xcor(i,j)+720.0_ESMF_KIND_R8,360.0_ESMF_KIND_R8) - ! write(tmpstr,*) subname//' ijfld xu = ',i,i1,j,j1,dataPtr_xcor(i,j) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - enddo - enddo - - ! MOM6 runs on C-Grid. - call ocean_model_data_get(ocean_state, ocean_public, 'geoLatBu', ofld, isc, jsc) - write(tmpstr,*) subname//' ofld yu = ',minval(ofld),maxval(ofld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call mpp_global_field(ocean_public%domain, ofld, gfld) - write(tmpstr,*) subname//' gfld yu = ',minval(gfld),maxval(gfld) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - do j = lbnd4, ubnd4 - do i = lbnd3, ubnd3 - j1 = j - lbnd4 + jsc - 1 - i1 = mod(i - lbnd3 + isc - 2 + nxg, nxg) + 1 - if (j1 == 0) then - dataPtr_ycor(i,j) = 2*gfld(i1,1) - gfld(i1,2) - elseif (j1 >= 1 .and. j1 <= nyg) then - dataPtr_ycor(i,j) = gfld(i1,j1) - else - rc=ESMF_FAILURE - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": error in yu j1.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return ! bail out - endif - ! write(tmpstr,*) subname//' ijfld yu = ',i,i1,j,j1,dataPtr_ycor(i,j) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - enddo - enddo + do j = jsc, jec + j1 = j + lbnd2 - jsc + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + ig = i + ocean_grid%isc - isc + dataPtr_mask(i1,j1) = ocean_grid%mask2dT(ig,jg) + dataPtr_xcen(i1,j1) = ocean_grid%geolonT(ig,jg) + dataPtr_ycen(i1,j1) = ocean_grid%geolatT(ig,jg) + end do + end do + + jlast = jec + if(jec .eq. nyg)jlast = jec+1 + + do j = jsc, jlast + j1 = j + lbnd4 - jsc + jg = j + ocean_grid%jsc - jsc - 1 + do i = isc, iec + i1 = i + lbnd3 - isc + ig = i + ocean_grid%isc - isc - 1 + dataPtr_xcor(i1,j1) = ocean_grid%geolonBu(ig,jg) + dataPtr_ycor(i1,j1) = ocean_grid%geolatBu(ig,jg) + end do + end do write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) @@ -1647,8 +1550,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - deallocate(gfld) - gridOut = gridIn ! for now out same as in call MOM_RealizeFields(importState, fldsToOcn_num, fldsToOcn, "Ocn import", grid=gridIn, rc=rc) @@ -1702,7 +1603,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) return ! bail out if (geomtype == ESMF_GEOMTYPE_GRID) then - call ocean_model_data_get(ocean_state, ocean_public, 'mask', ofld, isc, jsc) call ESMF_FieldGet(field_t_surf, localDe=0, farrayPtr=t_surf2d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1710,18 +1610,16 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out - lbnd1 = lbound(t_surf2d,1) - ubnd1 = ubound(t_surf2d,1) - lbnd2 = lbound(t_surf2d,2) - ubnd2 = ubound(t_surf2d,2) - - do j = lbnd2, ubnd2 - do i = lbnd1, ubnd1 - j1 = j - lbnd2 + jsc - i1 = i - lbnd1 + isc - if (ofld(i1,j1) == 0.) t_surf2d(i,j) = 0.0 - enddo - enddo + do j = jsc, jec + j1 = j + lbnd2 - jsc + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + ig = i + ocean_grid%isc - isc + if(ocean_grid%mask2dT(ig,jg) == 0.)t_surf2d(i1,j1) = 0.0 + end do + end do + end if end if diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 1383af5155..57fb0c4efe 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -16,7 +16,6 @@ module mom_cap_methods use ESMF, only: ESMF_RC_VAL_OUTOFRANGE, ESMF_INDEX_DELOCAL, ESMF_MESHLOC_ELEMENT use ESMF, only: ESMF_TYPEKIND_R8 use ESMF, only: operator(/=), operator(==) - !DLW use MOM_ocean_model, only: ocean_public_type, ocean_state_type use MOM_surface_forcing, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type @@ -402,7 +401,6 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! ocean mask ! ------- - !DLW: Retrieve omask from ocean_grid, as for other grid variables allocate(omask(isc:iec, jsc:jec)) do j = jsc, jec jg = j + ocean_grid%jsc - jsc From 319bf81aaf68a5369c2cf68b46cc827106ac523b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 26 Feb 2019 09:23:58 -0700 Subject: [PATCH 1013/1072] fixed minus signs --- config_src/nuopc_driver/MOM_ocean_model.F90 | 3 --- config_src/nuopc_driver/MOM_surface_forcing.F90 | 14 +++++++------- 2 files changed, 7 insertions(+), 10 deletions(-) diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 28ae82750a..71a8933fbc 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -657,9 +657,6 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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) - !TODO: this came in for the merge and is not consistent with the MOA branch - !call mech_forcing_diags(OS%forces, OS%fluxes, dt_coupling, OS%grid, OS%diag, OS%forcing_CSp%handles) - call disable_averaging(OS%diag) if (OS%fluxes%fluxes_used) then diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 0facbd43e8..eb4a7a5771 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -469,20 +469,20 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & ! ! 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) + ! fluxes%seaice_melt(i,j) = G%mask2dT(i,j) * IOB%seaice_melt_water(i-i0,j-j0) fluxes%latent(i,j) = 0.0 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 + 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 if (associated(IOB%calving)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion - fluxes%latent_frunoff_diag(i,j) = -G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent(i,j) = fluxes%latent(i,j) + IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent_frunoff_diag(i,j) = G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion endif if (associated(IOB%q_flux)) then - fluxes%latent(i,j) = fluxes%latent(i,j) - IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor - fluxes%latent_evap_diag(i,j) = -G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor + fluxes%latent(i,j) = fluxes%latent(i,j) + IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor + fluxes%latent_evap_diag(i,j) = G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor endif fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) From 76b0f4d62a517cf2edada476086a5fc0a82ef282 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 26 Feb 2019 16:34:32 +0000 Subject: [PATCH 1014/1072] add code for dataPtr_area when creating the grid and attaching area to grid --- config_src/nuopc_driver/mom_cap.F90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index e3e3e9175b..53b9920060 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1513,11 +1513,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) dataPtr_mask(i1,j1) = ocean_grid%mask2dT(ig,jg) dataPtr_xcen(i1,j1) = ocean_grid%geolonT(ig,jg) dataPtr_ycen(i1,j1) = ocean_grid%geolatT(ig,jg) + if(grid_attach_area) then + dataPtr_area(i1,j1) = ocean_grid%areaT(ig,jg) + end if end do end do - jlast = jec - if(jec .eq. nyg)jlast = jec+1 + jlast = jec + if(jec == nyg)jlast = jec+1 do j = jsc, jlast j1 = j + lbnd4 - jsc From 7a392f70600b68a324d575267bce88315e74da95 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 27 Feb 2019 19:06:14 +0000 Subject: [PATCH 1015/1072] Final changes for unified cap. Removed t_surf initialization since not required. A few textural changes. --- config_src/nuopc_driver/mom_cap.F90 | 53 +++------------------ config_src/nuopc_driver/mom_cap_methods.F90 | 6 +-- 2 files changed, 10 insertions(+), 49 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 2d7005ebc1..c8ee4668c7 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1031,10 +1031,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide") call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") !-> liquid runoff - !call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") !-> ice runoff - !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_water" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_heat" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") !-> liquid runoff + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") !-> ice runoff + !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_water" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_heat" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") @@ -1050,7 +1050,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") do n = 1,fldsToOcn_num call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)%shortname, rc=rc) @@ -1114,14 +1114,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: lbnd3,ubnd3,lbnd4,ubnd4 integer :: nblocks_tot logical :: found - real(ESMF_KIND_R8), pointer :: t_surf2d(:,:) integer(ESMF_KIND_I4), pointer :: dataPtr_mask(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_area(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_xcen(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_ycen(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_xcor(:,:) real(ESMF_KIND_R8), pointer :: dataPtr_ycor(:,:) - type(ESMF_Field) :: field_t_surf integer :: mpicom integer :: localPet integer :: lsize @@ -1475,8 +1473,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! load up area, mask, center and corner values ! area, mask, and centers should be same size in mom and esmf grid ! corner points may not be, need to offset corner points by 1 in i and j - ! retrieve these values directly from ocean_grid, which contains halos - ! values for j=1 and wrap-around in i. on tripole seam, decomposition + ! retrieve these values directly from ocean_grid, which contains halo + ! values for j=0 and wrap-around in i. on tripole seam, decomposition ! domains are 1 larger in j; to load corner values need to loop one extra row call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) @@ -1592,43 +1590,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) return ! bail out endif - !--------------------------------- - ! set surface temperature to 0 if ocean mask is 0 - !--------------------------------- - - ! TODO (mvertens, 2018-12-30): is this really necessary? for now only do this for grid - - ! Do sst initialization if it's part of export state - call ESMF_StateGet(exportState, 'sea_surface_temperature', itemFlag) - if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then - - call ESMF_StateGet(exportState, 'sea_surface_temperature', field=field_t_surf, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (geomtype == ESMF_GEOMTYPE_GRID) then - - call ESMF_FieldGet(field_t_surf, localDe=0, farrayPtr=t_surf2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - do j = jsc, jec - j1 = j + lbnd2 - jsc - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + ocean_grid%isc - isc - if(ocean_grid%mask2dT(ig,jg) == 0.)t_surf2d(i1,j1) = 0.0 - end do - end do - - end if - end if - !--------------------------------- ! Set module variable geomtype in mom_cap_methods !--------------------------------- diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 40fba4b654..65360abeee 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -457,7 +457,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! ------- ! rotate ocn current from tripolar grid back to lat/lon grid x,y => latlon (CCW) - ! "ocean_grid%isc" has no halos and uses local indexing. + ! "ocean_grid" has halos and uses local indexing. allocate(ocz(isc:iec, jsc:jec)) allocate(ocm(isc:iec, jsc:jec)) @@ -632,7 +632,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, end do ! rotate slopes from tripolar grid back to lat/lon grid, x,y => latlon (CCW) - ! "ocean_grid" uses has halos and uses global indexing. + ! "ocean_grid" uses has halos and uses local indexing. do j = jsc, jec jg = j + ocean_grid%jsc - jsc @@ -833,7 +833,7 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid ! Indexing notes: ! input array from "ocean_public" uses local indexing without halos - ! mask from "ocean_grid" uses global indexing with halos + ! mask from "ocean_grid" uses local indexing with halos call ESMF_StateGet(State, trim(fldname), itemFlag, rc=rc) if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then From 9b7b127bafdd35a95510348c71ba94d25fe717e5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 27 Feb 2019 18:22:31 -0500 Subject: [PATCH 1016/1072] +New variants of safe_alloc_ptr & safe_alloc_alloc Added new overloaded variants of safe_alloc_ptr and safe_alloc_alloc to allow the index range of the third (vertical) index to have an arbitrary starting value. All answers are bitwise identical. --- src/framework/MOM_safe_alloc.F90 | 39 +++++++++++++++++++++++++++++--- 1 file changed, 36 insertions(+), 3 deletions(-) diff --git a/src/framework/MOM_safe_alloc.F90 b/src/framework/MOM_safe_alloc.F90 index 75f5fda74e..47dd8376a3 100644 --- a/src/framework/MOM_safe_alloc.F90 +++ b/src/framework/MOM_safe_alloc.F90 @@ -10,13 +10,14 @@ module MOM_safe_alloc !> Allocate a pointer to a 1-d, 2-d or 3-d array interface safe_alloc_ptr - module procedure safe_alloc_ptr_3d_2arg, safe_alloc_ptr_2d_2arg + module procedure safe_alloc_ptr_3d_3arg, safe_alloc_ptr_3d_6arg, safe_alloc_ptr_2d_2arg module procedure safe_alloc_ptr_3d, safe_alloc_ptr_2d, safe_alloc_ptr_1d end interface safe_alloc_ptr !> Allocate a 2-d or 3-d allocatable array interface safe_alloc_alloc module procedure safe_alloc_allocatable_3d, safe_alloc_allocatable_2d + module procedure safe_alloc_allocatable_3d_6arg end interface safe_alloc_alloc ! This combined interface might work with a later version of Fortran, but @@ -57,7 +58,7 @@ subroutine safe_alloc_ptr_2d_2arg(ptr, ni, nj) end subroutine safe_alloc_ptr_2d_2arg !> Allocate a pointer to a 3-d array based on its dimension sizes -subroutine safe_alloc_ptr_3d_2arg(ptr, ni, nj, nk) +subroutine safe_alloc_ptr_3d_3arg(ptr, ni, nj, nk) real, dimension(:,:,:), pointer :: ptr !< A pointer to allocate integer, intent(in) :: ni !< The size of the 1st dimension of the array integer, intent(in) :: nj !< The size of the 2nd dimension of the array @@ -66,7 +67,7 @@ subroutine safe_alloc_ptr_3d_2arg(ptr, ni, nj, nk) allocate(ptr(ni,nj,nk)) ptr(:,:,:) = 0.0 endif -end subroutine safe_alloc_ptr_3d_2arg +end subroutine safe_alloc_ptr_3d_3arg !> Allocate a pointer to a 2-d array based on its index starting and ending values subroutine safe_alloc_ptr_2d(ptr, is, ie, js, je) @@ -95,6 +96,22 @@ subroutine safe_alloc_ptr_3d(ptr, is, ie, js, je, nk) endif end subroutine safe_alloc_ptr_3d +!> Allocate a pointer to a 3-d array based on its index starting and ending values +subroutine safe_alloc_ptr_3d_6arg(ptr, is, ie, js, je, ks, ke) + real, dimension(:,:,:), pointer :: ptr !< A pointer to allocate + integer, intent(in) :: is !< The start index to allocate for the 1st dimension + integer, intent(in) :: ie !< The end index to allocate for the 1st dimension + integer, intent(in) :: js !< The start index to allocate for the 2nd dimension + integer, intent(in) :: je !< The end index to allocate for the 2nd dimension + integer, intent(in) :: ks !< The start index to allocate for the 3rd dimension + integer, intent(in) :: ke !< The end index to allocate for the 3rd dimension + if (.not.associated(ptr)) then + allocate(ptr(is:ie,js:je,ks:ke)) + ptr(:,:,:) = 0.0 + endif +end subroutine safe_alloc_ptr_3d_6arg + + !> Allocate a 2-d allocatable array based on its index starting and ending values subroutine safe_alloc_allocatable_2d(ptr, is, ie, js, je) real, dimension(:,:), allocatable :: ptr !< An allocatable array to allocate @@ -109,6 +126,7 @@ subroutine safe_alloc_allocatable_2d(ptr, is, ie, js, je) end subroutine safe_alloc_allocatable_2d !> Allocate a 3-d allocatable array based on its index starting and ending values +!! and k-index size subroutine safe_alloc_allocatable_3d(ptr, is, ie, js, je, nk) real, dimension(:,:,:), allocatable :: ptr !< An allocatable array to allocate integer, intent(in) :: is !< The start index to allocate for the 1st dimension @@ -122,4 +140,19 @@ subroutine safe_alloc_allocatable_3d(ptr, is, ie, js, je, nk) endif end subroutine safe_alloc_allocatable_3d +!> Allocate a 3-d allocatable array based on its 6 index starting and ending values +subroutine safe_alloc_allocatable_3d_6arg(ptr, is, ie, js, je, ks, ke) + real, dimension(:,:,:), allocatable :: ptr !< An allocatable array to allocate + integer, intent(in) :: is !< The start index to allocate for the 1st dimension + integer, intent(in) :: ie !< The end index to allocate for the 1st dimension + integer, intent(in) :: js !< The start index to allocate for the 2nd dimension + integer, intent(in) :: je !< The end index to allocate for the 2nd dimension + integer, intent(in) :: ks !< The start index to allocate for the 3rd dimension + integer, intent(in) :: ke !< The end index to allocate for the 3rd dimension + if (.not.allocated(ptr)) then + allocate(ptr(is:ie,js:je,ks:ke)) + ptr(:,:,:) = 0.0 + endif +end subroutine safe_alloc_allocatable_3d_6arg + end module MOM_safe_alloc From 0ff4c5b195ea9599aea322053edf36f57151ec27 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 27 Feb 2019 18:22:56 -0500 Subject: [PATCH 1017/1072] Trap or deal with instances when dt=0 in diabatic Added error messages and Adcroft reciprocals to trap or handle cases when dt=0 in various routines in MOM_diabatic_driver including diabatic and legacy_diabatic. All answers are bitwise identical. --- .../vertical/MOM_diabatic_driver.F90 | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 200d3efdf7..24a529716d 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -422,6 +422,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & eaml => eatr ; ebml => ebtr ! inverse time step + if (dt == 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & + "diabatic was called with a zero length timestep.") + if (dt < 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & + "diabatic was called with a negative timestep.") Idt = 1.0 / dt if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & @@ -1301,6 +1305,10 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en eaml => eatr ; ebml => ebtr ! inverse time step + if (dt == 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & + "legacy_diabatic was called with a zero length timestep.") + if (dt < 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & + "legacy_diabatic was called with a negative timestep.") Idt = 1.0 / dt if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & @@ -2506,7 +2514,7 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - Idt = 1/dt + Idt = 0.0 ; if (dt > 0.0) Idt = 1. / dt work_3d(:,:,:) = 0.0 work_2d(:,:) = 0.0 @@ -2596,7 +2604,7 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - Idt = 1/dt + Idt = 0.0 ; if (dt > 0.0) Idt = 1. / dt work_3d(:,:,:) = 0.0 work_2d(:,:) = 0.0 @@ -2683,7 +2691,7 @@ subroutine diagnose_frazil_tendency(tv, h, temp_old, dt, G, GV, CS) integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - Idt = 1/dt + Idt = 0.0 ; if (dt > 0.0) Idt = 1. / dt ! temperature tendency if (CS%id_frazil_temp_tend > 0) then From b6fa3428e84a54a2469aa24ad1d2e644b1270cef Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 27 Feb 2019 18:24:06 -0500 Subject: [PATCH 1018/1072] +Opt args to step_MOM can override DIABATIC_FIRST Allow optional arguments to step_MOM to effectively override the value of DIABATIC_FIRST. All answers are bitwise identical in the existing test cases. --- src/core/MOM.F90 | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 1b364d7ef0..21ec2e6dc6 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -734,8 +734,13 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & !=========================================================================== ! This is the second place where the diabatic processes and remapping could occur. - if (CS%t_dyn_rel_adv == 0.0 .and. do_thermo .and. .not.CS%diabatic_first) then + if ((CS%t_dyn_rel_adv==0.0) .and. do_thermo .and. (.not.CS%diabatic_first)) then + dtdia = CS%t_dyn_rel_thermo + ! If the MOM6 dynamic and thermodynamic time stepping is being orchestrated + ! by the coupler, the value of diabatic_first does not matter. + if ((CS%t_dyn_rel_thermo==0.0) .and. .not.do_dyn) dtdia = dt + if (CS%thermo_spans_coupling .and. (CS%dt_therm > 1.5*cycle_time) .and. & (abs(dt_therm - dtdia) > 1e-6*dt_therm)) then call MOM_error(FATAL, "step_MOM: Mismatch between dt_therm and dtdia "//& @@ -750,7 +755,13 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & Time_local, .false., Waves=Waves) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia - CS%t_dyn_rel_thermo = 0.0 + + if ((CS%t_dyn_rel_thermo==0.0) .and. .not.do_dyn) then + ! The diabatic processes are now ahead of the dynamics by dtdia. + CS%t_dyn_rel_thermo = -dtdia + else ! The diabatic processes and the dynamics are synchronized. + CS%t_dyn_rel_thermo = 0.0 + endif if (dtdia > dt) & ! Reset CS%Time to its previous value. CS%Time = Time_start + real_to_time(rel_time - 0.5*dt) From b43284b3d2fde78faca467e7fa91314d4efbe694 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 28 Feb 2019 09:52:11 -0700 Subject: [PATCH 1019/1072] updated documentation --- config_src/nuopc_driver/mom_cap.F90 | 199 +++++++++++----------------- 1 file changed, 74 insertions(+), 125 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index c8ee4668c7..3fda902d3c 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -4,6 +4,7 @@ !! @date 5/10/13 Original documentation !! @author Rocky Dunlap (rocky.dunlap@noaa.gov) !! @date 1/12/17 Moved to doxygen +!! @date 2/28/19 Rewrote for unified cap !! !! @tableofcontents !! @@ -11,11 +12,13 @@ !! !! **This MOM cap has been tested with MOM6.** !! -!! This document describes the MOM "cap", which is a small software layer that is -!! required when the [MOM ocean model] (http://mom-ocean.org/web) +!! This document describes the MOM NUOPC "cap", which is a light weight software layer that is +!! required when the [MOM ocean model](https://github.com/NOAA-GFDL/MOM6/tree/dev/master) !! is used in [National Unified Operation Prediction Capability] -!! (http://www.earthsystemcog.org/projects/nuopc) (NUOPC) coupled systems. -!! The NUOPC Layer is a software layer built on top of the [Earth System Modeling +!! (http://www.earthsystemcog.org/projects/nuopc) (NUOPC) coupled systems. Also see the +!! [MOM wiki](https://github.com/NOAA-GFDL/MOM6-Examples/wiki) for more documentation. +!! +!! NUOPC is a software layer built on top of the [Earth System Modeling !! Framework] (https://www.earthsystemcog.org/projects/esmf) (ESMF). !! ESMF is a high-performance modeling framework that provides !! data structures, interfaces, and operations suited for building coupled models @@ -25,63 +28,31 @@ !! Layer software is designed to work with typical high-performance models in the !! Earth sciences domain, most of which are written in Fortran and are based on a !! distributed memory model of parallelism (MPI). +!! !! A NUOPC "cap" is a Fortran module that serves as the interface to a model !! when it's used in a NUOPC-based coupled system. -!! The term "cap" is used because it is a small software layer that sits on top +!! The term "cap" is used because it is a light weight software layer that sits on top !! of model code, making calls into it and exposing model data structures in a -!! standard way. For more information about creating NUOPC caps in general, please -!! see the [Building a NUOPC Model] -!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_howtodoc/) -!! how-to document. +!! standard way. !! -!! The MOM cap package includes the cap code itself (mom_cap.F90 and mom_cap_methods.F90), a -!! set of time utilities (time_utils.F90) for converting between ESMF and FMS -!! time type and two modules MOM_ocean_model.F90 and MOM_surface_forcing.F90. +!! The MOM cap package includes the cap code itself (mom_cap.F90, mom_cap_methods.F90 +!! and mom_cap_time.F90), a set of time utilities (time_utils.F90) for converting between ESMF and FMS +!! time type and two modules MOM_ocean_model.F90 and MOM_surface_forcing.F90. MOM_surface_forcing.F90 +!! converts the input ESMF data (import data) to a MOM-specific data type (surface_forcing_CS). +!! MOM_ocean_model.F90 contains routines for initialization, update and finalization of the ocean model state. !! !! @subsection CapSubroutines Cap Subroutines !! -!! The MOM cap Fortran modules contains a set of subroutines that are required +!! The MOM cap modules contains a set of subroutines that are required !! by NUOPC. These subroutines are called by the NUOPC infrastructure according !! to a predefined calling sequence. Some subroutines are called during !! initialization of the coupled system, some during the run of the coupled -!! system, and some during finalization of the coupled system. The initialization -!! sequence is the most complex and is governed by the NUOPC technical rules. -!! Details about the initialization sequence can be found in the [NUOPC Reference Manual] -!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html -!! #SECTION00034000000000000000). +!! system, and some during finalization of the coupled system. !! -!! A particularly important part of the NUOPC intialization sequence is to establish -!! field connections between models. Simply put, a field connection is established -!! when a field output by one model can be consumed by another. As an example, the -!! MOM model is able to accept a precipitation rate when coupled to an atmosphere -!! model. In this case a field connection will be established between the precipitation -!! rate exported from the atmosphere and the precipitation rate imported into the -!! MOM model. Because models may uses different variable names for physical -!! quantities, NUOPC relies on a set of standard names and a built-in, extensible -!! standard name dictionary to match fields between models. More information about -!! the use of standard names can be found in the [NUOPC Reference Manual] -!! (http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_0/NUOPC_refdoc/node3.html -!! #SECTION00032000000000000000). -!! -!! Two key initialization phases that appear in every NUOPC cap, including this MOM -!! cap are the field "advertise" and field "realize" phases. *Advertise* is a special -!! NUOPC term that refers to a model participating in a coupled system -!! providing a list of standard names of required import fields and available export -!! fields. In other words, each model will advertise to the other models which physical fields -!! it needs and which fields it can provide when coupled. NUOPC compares all of the advertised -!! standard names and creates a set of unidirectional links, each from one export field -!! in a model to one import field in another model. When these connections have been established, -!! all models in the coupled system need to provide a description of their geographic -!! grid (e.g., lat-lon, tri-polar, cubed sphere, etc.) and allocate their connected -!! fields on that grid. In NUOPC terms, this is refered to as *realizing* a set of -!! fields. NUOPC relies on ESMF data types for this, such as the [ESMF_Grid] -!! (http://www.earthsystemmodeling.org/esmf_releases/public/last/ESMF_refdoc/node5.html#SECTION05080000000000000000) -!! type, which describes logically rectangular grids and the [ESMF_Field] -!! (http://www.earthsystemmodeling.org/esmf_releases/public/last/ESMF_refdoc/node5.html#SECTION05030000000000000000) -!! type, which wraps a models data arrays and provides basic metadata. Because ESMF supports -!! interpolation between different grids (sometimes called "regridding" or "grid remapping"), -!! it is not necessary that models share a grid. As you will see below -!! the *advertise* and *realize* phases each have a subroutine in the HYCOM cap. +!! The initialization sequence is the most complex and is governed by the NUOPC technical rules. +!! Details about the initialization sequence can be found in the [NUOPC Reference Manual] +!! (http://www.earthsystemmodeling.org/esmf_releases/last_built/NUOPC_refdoc/). +!! The cap requires beta snapshot ESMF v8.0.0bs16 or later. !! !! The following table summarizes the NUOPC-required subroutines that appear in the !! MOM cap. The "Phase" column says whether the subroutine is called during the @@ -93,7 +64,7 @@ !! | (IPD) version to use !! Init | [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) | Advertises standard names of import !! | and export fields -!! Init | [InitializeRealize] (@ref mom_cap_mod::initializerealize) | Creates an ESMF_Grid for the MOM grid +!! Init | [InitializeRealize] (@ref mom_cap_mod::initializerealize) | Creates an ESMF_Grid or ESMF_Mesh !! | as well as ESMF_Fields for import !! | and export fields !! Run | [ModelAdvance] (@ref mom_cap_mod::modeladvance) | Advances the model by a timestep @@ -104,8 +75,12 @@ !! !! @subsection DomainCreation Domain Creation !! -!! The MOM tripolar grid is represented as a 2D `ESMF_Grid` and coupling fields are placed -!! on this grid. Calls related to creating the grid are located in the [InitializeRealize] +!! The cap can accomodate a MOM tripolar grid which is represented either as a 2D `ESMF_Grid` or +!! as a 1D `ESMF_Mesh`. Other MOM grids (e.g. a bipolar grid) can be represented as a 1d `ESMF_Mesh` only. +!! Coupling fields are placed on either the `ESMF_Grid` or `ESMF_Mesh`. +!! Note that for either the `ESMF_Grid` or `ESMF_Mesh` representation, the fields are translated into +!! a 2D MOM specific surface boundary type and the distinction between the two is no longer there. +!! Calls related to creating the grid are located in the [InitializeRealize] !! (@ref mom_cap_mod::initializerealize) subroutine, which is called by the NUOPC infrastructure !! during the intialization sequence. !! @@ -117,16 +92,23 @@ !! (to retrieve decomposition block indices) and `mpp_get_pelist()` (to determine how !! blocks are assigned to processors). !! -!! The grid is created in several steps: +!! The `ESMF_Grid` is created in several steps: !! - an `ESMF_DELayout` is created based on the pelist from MOM !! - an `ESMF_DistGrid` is created over the global index space. Connections are set !! up so that the index space is periodic in the first dimension and has a !! fold at the top for the bipole. The decompostion blocks are also passed in !! along with the `ESMF_DELayout` mentioned above. !! - an `ESMF_Grid` is then created by passing in the above `ESMF_DistGrid`. +!! - masks, areas, center (tlat, tlon), and corner (ulat, ulon) coordinates are then added to the `ESMF_Grid` +!! by retrieving those fields from the MOM datatype `ocean_grid` elements. +!! +!! The `ESMF_Mesh` is also created in several steps: +!! - the target mesh is generated offline. +!! - a temporary mesh is created from an input file specified by the config variable `mesh_ocn`. +!! the mesh has a distribution that is automatically generated by ESMF when reading in the mesh +!! - an `ESMF_DistGrid` is created from the global index space for the computational domain. +!! - the final `ESMF_Mesh` is then created by distributing the temporary mesh using the created `ESMF_DistGrid`. !! -!! Masks, areas, center (tlat, tlon), and corner (ulat, ulon) coordinates are then added to the `ESMF_Grid` -!! by retrieving those fields from MOM with calls to `ocean_model_data_get()`. !! !! @subsection Initialization Initialization !! @@ -147,12 +129,9 @@ !! !! Priori to the call to `update_ocean_model()`, the cap performs these steps !! - the `Time` and `Time_step_coupled` parameters, based on FMS types, are derived from the incoming ESMF clock -!! - there are calls to two stubs: `ice_ocn_bnd_from_data()` and `external_coupler_sbc_before()` - these are currently -!! inactive, but may be modified to read in import data from file or from an external coupler !! - diagnostics are optionally written to files `field_ocn_import_*`, one for each import field -!! - mom_import is called +!! - mom_import is called and translates to the ESMF input data to a MOM specific data type !! - momentum flux vectors are rotated to internal grid -!! - optionally, a call is made to `ocean_model_restart()` at the interval `restart_interval` !! !! After the call to `update_ocean_model()`, the cap performs these steps: !! - mom_export is called @@ -160,6 +139,7 @@ !! - the `freezing_melting_potential` export is converted from J m-2 to W m-2 by dividing by the coupling interval !! - vector rotations are applied to the `ocean_current_zonal` and `ocean_current_merid` exports, back to lat-lon grid !! - diagnostics are optionally written to files `field_ocn_export_*`, one for each export field +!! - optionally, a call is made to `ocean_model_restart()` at the interval `restart_interval` !! !! @subsubsection VectorRotations Vector Rotations !! @@ -226,7 +206,7 @@ !! mass_of_overlying_sea_ice | kg | mi | mass of overlying sea ice | | !! mean_calving_heat_flx | W m-2 | calving_hflx | heat flux, relative to 0C, of frozen land water into ocean !! mean_calving_rate | kg m-2 s-1 | calving | mass flux of frozen runoff | | -!! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | sign reversed (- evap) +!! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | !! mean_fprec_rate | kg m-2 s-1 | fprec | mass flux of frozen precip | | !! mean_merid_moment_flx | Pa | v_flux | j-directed wind stress into ocean !! | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar @@ -239,8 +219,8 @@ !! mean_runoff_heat_flx | W m-2 | runoff_hflx | heat flux, relative to 0C, of liquid land water into ocean !! mean_runoff_rate | kg m-2 s-1 | runoff | mass flux of liquid runoff | | !! mean_salt_rate | kg m-2 s-1 | salt_flux | salt flux | | -!! mean_sensi_heat_flx | W m-2 | t_flux | sensible heat flux into ocean | sign reversed (- sensi) -!! mean_zonal_moment_flx | Pa | u_flux | j-directed wind stress into ocean +!! mean_sensi_heat_flx | W m-2 | t_flux | sensible heat flux into ocean | +!! mean_zonal_moment_flx | Pa | u_flux | i-directed wind stress into ocean !! | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar !! !! @@ -251,7 +231,7 @@ !! !! Standard Name | Units | Model Variable | Description | Notes !! ---------------------------|-------|----------------|-------------------------------------------|-------------------- -!! freezing_melting_potential | W m-2 | frazil | accumulated heating from frazil formation +!! freezing_melting_potential | W m-2 | combination of frazil and melt_potential !! | cap converts model units (J m-2) to (W m-2) for export !! ocean_mask | | | ocean mask | | !! ocn_current_merid | m s-1 | v_surf | j-directed surface velocity on u-cell @@ -259,9 +239,10 @@ !! ocn_current_zonal | m s-1 | u_surf | i-directed surface velocity on u-cell !! | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon !! s_surf | psu | s_surf | sea surface salinity on t-cell | | -!! sea_lev | m | sea_lev | sea level -!! | model computation is eta_t + patm/(rho0*grav) - eta_geoid - eta_tide !! sea_surface_temperature | K | t_surf | sea surface temperature on t-cell | | +!! sea_surface_slope_zonal ! unitless | created from ssh | sea surface zonal slope +!! sea_surface_slope_merid ! unitless | created from ssh | sea surface meridional slope +!! so_bldepth ! m ! obld | ocean surface boundary layer depth !! !! @subsection MemoryManagement Memory Management !! @@ -308,53 +289,20 @@ !! named "field_ocn_internal_.nc". In all cases these NetCDF files will !! contain a time series of field data. !! -!! @section BuildingAndInstalling Building and Installing -!! -!! There are two makefiles included with the MOM cap, makefile and makefile.nuopc. -!! The makefile.nuopc file is intended to be used within another build system, such -!! as the NEMSAppBuilder. The regular makefile can be used generally for building -!! and installing the cap. Two variables must be customized at the top: -!! - `INSTALLDIR` - where to copy the cap library and dependent libraries -!! - `NEMSMOMDIR` - location of the MOM library and FMS library -!! -!! To install run: -!! $ make install -!! -!! A makefile fragment, mom.mk, will also be copied into the directory. The fragment -!! defines several variables that can be used by another build system to include the -!! MOM cap and its dependencies. -!! -!! @subsection Dependencies Dependencies -!! -!! The MOM cap is dependent on the MOM library itself (lib_ocean.a) and the FMS -!! library (lib_FMS.a). -!! !! @section RuntimeConfiguration Runtime Configuration !! !! At runtime, the MOM cap can be configured with several options provided !! as ESMF attributes. Attributes can be set in the cap by the NUOPC Driver -!! above this cap, or in some systems (e.g., NEMS) attributes are set by +!! above this cap, or in some systems ESMF attributes are set by !! reading in from a configuration file. The available attributes are: !! !! * `DumpFields` - when set to "true", write out diagnostic NetCDF files for import/export/internal fields !! * `ProfileMemory` - when set to "true", write out memory usage information to the ESMF log files; this -!! information is written when entering and leaving the [ModelAdvance] -!! (@ref mom_cap_mod::modeladvance) subroutine and before and after the call to +!! information is written when entering and leaving the [ModelAdvance] +!! (@ref mom_cap_mod::modeladvance) subroutine and before and after the call to !! `update_ocean_model()`. !! * `restart_interval` - integer number of seconds indicating the interval at -!! which to call `ocean_model_restart()`; no restarts written if set to 0 -!! * `GridAttachArea` - when set to "true", this option indicates that MOM grid attaches cell area -!! using internal values computed in MOM. The default value is "false", grid cell area will -!! be computed in ESMF. -!! -!! -!! @section Repository -!! The MOM NUOPC cap is maintained in a GitHub repository: -!! https://github.com/feiliuesmf/nems_mom_cap -!! -!! @section References -!! -!! - [MOM Home Page] (http://mom-ocean.org/web) +!! which to call `ocean_model_restart()`; no restarts written if set to 0 !! !! module mom_cap_mod @@ -1036,7 +984,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_water" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_heat" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") @@ -1050,7 +998,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide") call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") do n = 1,fldsToOcn_num call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)%shortname, rc=rc) @@ -1474,9 +1422,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! area, mask, and centers should be same size in mom and esmf grid ! corner points may not be, need to offset corner points by 1 in i and j ! retrieve these values directly from ocean_grid, which contains halo - ! values for j=0 and wrap-around in i. on tripole seam, decomposition + ! values for j=0 and wrap-around in i. on tripole seam, decomposition ! domains are 1 larger in j; to load corner values need to loop one extra row - + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) lbnd1 = lbound(dataPtr_mask,1) @@ -1844,24 +1792,6 @@ subroutine ModelAdvance(gcomp, rc) ! Update MOM6 !--------------- - ! Optionally write restart files when currTime-startTime is integer multiples of restart_interval - ! if (restart_interval > 0 ) then - ! time_elapsed = currTime - startTime - ! call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! n_interval = time_elapsed_sec / restart_interval - ! if ((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then - ! time_restart_current = esmf2fms_time(currTime) - ! timestamp = date_to_string(time_restart_current) - ! call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=rc) - ! write(*,*) 'calling ocean_model_restart' - ! call ocean_model_restart(ocean_state, timestamp) - ! endif - ! endif - if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled) if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") @@ -1956,6 +1886,25 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out endif + ! TODO: address if this requirement is being met for the DA group + ! Optionally write restart files when currTime-startTime is integer multiples of restart_interval + ! if (restart_interval > 0 ) then + ! time_elapsed = currTime - startTime + ! call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + ! n_interval = time_elapsed_sec / restart_interval + ! if ((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then + ! time_restart_current = esmf2fms_time(currTime) + ! timestamp = date_to_string(time_restart_current) + ! call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=rc) + ! write(*,*) 'calling ocean_model_restart' + ! call ocean_model_restart(ocean_state, timestamp) + ! endif + ! endif + ! write restart file(s) call ocean_model_restart(ocean_state, restartname=restartname) From 1603ed98c96430b07f5684f941a7c50f76d1300e Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Fri, 1 Mar 2019 15:46:42 -0500 Subject: [PATCH 1020/1072] Fix bug causing openmp answers change - The new structure US was missing a openmp share() declaration --- src/parameterizations/vertical/MOM_vert_friction.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 5400f8c1df..e01374b5c6 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -669,7 +669,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) allocate(CS%a1_shelf_v(G%isd:G%ied,G%JsdB:G%JedB)) ; CS%a1_shelf_v(:,:)=0.0 endif - !$OMP parallel do default(private) shared(G,GV,CS,visc,Isq,Ieq,nz,u,h,forces,hML_u, & + !$OMP parallel do default(private) shared(G,GV,US,CS,visc,Isq,Ieq,nz,u,h,forces,hML_u, & !$OMP OBC,h_neglect,dt,I_valBL,Kv_u) & !$OMP firstprivate(i_hbbl) do j=G%Jsc,G%Jec @@ -836,7 +836,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) ! Now work on v-points. - !$OMP parallel do default(private) shared(G,GV,CS,visc,is,ie,Jsq,Jeq,nz,v,h,forces,hML_v, & + !$OMP parallel do default(private) shared(G,GV,CS,US,visc,is,ie,Jsq,Jeq,nz,v,h,forces,hML_v, & !$OMP OBC,h_neglect,dt,I_valBL,Kv_v) & !$OMP firstprivate(i_hbbl) do J=Jsq,Jeq From cec62451b0d8cc9a03785a9bb875f136d63f902a Mon Sep 17 00:00:00 2001 From: "Jessica.Meixner" Date: Wed, 6 Mar 2019 13:27:05 +0000 Subject: [PATCH 1021/1072] reverting files that were not meant to be changed --- src/core/MOM.F90 | 5 +---- src/ice_shelf/MOM_ice_shelf.F90 | 10 +++++----- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 4 ++-- 3 files changed, 8 insertions(+), 11 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 8ff49c628c..1a590bb5b8 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1153,10 +1153,7 @@ subroutine step_MOM_thermo(CS, G, GV, u, v, h, tv, fluxes, dtdia, & call enable_averaging(dtdia, Time_end_thermo, CS%diag) - ! added check in order to run MOM with debug flags - if (CS%ensemble_ocean) then - call apply_oda_tracer_increments(dtdia,G,tv,h,CS%odaCS) - end if + call apply_oda_tracer_increments(dtdia,G,tv,h,CS%odaCS) if (update_BBL) then ! Calculate the BBL properties and store them inside visc (u,h). diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 9abebcfe9a..3a27c988c9 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -308,7 +308,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) if (CS%mass_from_file) call update_shelf_mass(G, CS, ISS, Time) endif - if (CS%debug) then + if (CS%DEBUG) then call hchksum(fluxes%frac_shelf_h, "frac_shelf_h before apply melting", G%HI, haloshift=0) call hchksum(state%sst, "sst before apply melting", G%HI, haloshift=0) call hchksum(state%sss, "sss before apply melting", G%HI, haloshift=0) @@ -633,7 +633,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) call change_thickness_using_melt(ISS, G, time_step, fluxes, CS%density_ice, CS%debug) endif - if (CS%debug) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, haloshift=0) + if (CS%DEBUG) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, haloshift=0) call add_shelf_flux(G, CS, state, fluxes) @@ -675,7 +675,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) call cpu_clock_end(id_clock_shelf) - if (CS%debug) call MOM_forcing_chksum("End of shelf calc flux", fluxes, G, haloshift=0) + if (CS%DEBUG) call MOM_forcing_chksum("End of shelf calc flux", fluxes, G, haloshift=0) end subroutine shelf_calc_flux @@ -1043,7 +1043,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) endif enddo ; enddo - if (CS%debug) then + if (CS%DEBUG) then write(mesg,*) 'Mean melt flux (kg/(m^2 s)), dt = ', mean_melt_flux, CS%time_step call MOM_mesg(mesg) call MOM_forcing_chksum("After constant sea level", fluxes, G, haloshift=0) @@ -1483,7 +1483,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl if (G%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) / G%areaT(i,j) enddo ; enddo ; endif - if (CS%debug) then + if (CS%DEBUG) then call hchksum(fluxes%frac_shelf_h, "IS init: frac_shelf_h", G%HI, haloshift=0) endif diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index eac698f67c..eea9ee322a 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -920,7 +920,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, u, v, iters, time) call ice_shelf_solve_inner(CS, ISS, G, u, v, TAUDX, TAUDY, H_node, float_cond, & ISS%hmask, conv_flag, iters, time, Phi, Phisub) - if (CS%debug) then + if (CS%DEBUG) then call qchksum(u, "u shelf", G%HI, haloshift=2) call qchksum(v, "v shelf", G%HI, haloshift=2) endif @@ -3597,7 +3597,7 @@ subroutine ice_shelf_temp(CS, ISS, G, time_step, melt_rate, Time) call pass_var(CS%t_shelf, G%domain) call pass_var(CS%tmask, G%domain) - if (CS%debug) then + if (CS%DEBUG) then call hchksum(CS%t_shelf, "temp after front", G%HI, haloshift=3) endif From 6e5e587339a804204759650e6ec1f2644d801de7 Mon Sep 17 00:00:00 2001 From: "Jessica.Meixner" Date: Wed, 6 Mar 2019 21:07:20 -0500 Subject: [PATCH 1022/1072] removing trailing white space and fixing lines longer than 120 --- .../nuopc_driver/MOM_surface_forcing.F90 | 4 +-- config_src/nuopc_driver/mom_cap.F90 | 27 ++++++++++--------- 2 files changed, 17 insertions(+), 14 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index eb4a7a5771..eebda0b8fc 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -162,8 +162,8 @@ module MOM_surface_forcing 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_water =>NULL() !< water flux due to sea ice and snow melting (kg/m2/s) + real, pointer, dimension(:,:) :: seaice_melt_heat =>NULL() !< sea ice and snow melt heat flux (W/m2) + real, pointer, dimension(:,:) :: seaice_melt_water =>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) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 3fda902d3c..f465cb9183 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -47,7 +47,7 @@ !! by NUOPC. These subroutines are called by the NUOPC infrastructure according !! to a predefined calling sequence. Some subroutines are called during !! initialization of the coupled system, some during the run of the coupled -!! system, and some during finalization of the coupled system. +!! system, and some during finalization of the coupled system. !! !! The initialization sequence is the most complex and is governed by the NUOPC technical rules. !! Details about the initialization sequence can be found in the [NUOPC Reference Manual] @@ -64,7 +64,7 @@ !! | (IPD) version to use !! Init | [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) | Advertises standard names of import !! | and export fields -!! Init | [InitializeRealize] (@ref mom_cap_mod::initializerealize) | Creates an ESMF_Grid or ESMF_Mesh +!! Init | [InitializeRealize] (@ref mom_cap_mod::initializerealize) | Creates an ESMF_Grid or ESMF_Mesh !! | as well as ESMF_Fields for import !! | and export fields !! Run | [ModelAdvance] (@ref mom_cap_mod::modeladvance) | Advances the model by a timestep @@ -75,7 +75,7 @@ !! !! @subsection DomainCreation Domain Creation !! -!! The cap can accomodate a MOM tripolar grid which is represented either as a 2D `ESMF_Grid` or +!! The cap can accomodate a MOM tripolar grid which is represented either as a 2D `ESMF_Grid` or !! as a 1D `ESMF_Mesh`. Other MOM grids (e.g. a bipolar grid) can be represented as a 1d `ESMF_Mesh` only. !! Coupling fields are placed on either the `ESMF_Grid` or `ESMF_Mesh`. !! Note that for either the `ESMF_Grid` or `ESMF_Mesh` representation, the fields are translated into @@ -206,7 +206,7 @@ !! mass_of_overlying_sea_ice | kg | mi | mass of overlying sea ice | | !! mean_calving_heat_flx | W m-2 | calving_hflx | heat flux, relative to 0C, of frozen land water into ocean !! mean_calving_rate | kg m-2 s-1 | calving | mass flux of frozen runoff | | -!! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | +!! mean_evap_rate | kg m-2 s-1 | q_flux | specific humidity flux | !! mean_fprec_rate | kg m-2 s-1 | fprec | mass flux of frozen precip | | !! mean_merid_moment_flx | Pa | v_flux | j-directed wind stress into ocean !! | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar @@ -219,7 +219,7 @@ !! mean_runoff_heat_flx | W m-2 | runoff_hflx | heat flux, relative to 0C, of liquid land water into ocean !! mean_runoff_rate | kg m-2 s-1 | runoff | mass flux of liquid runoff | | !! mean_salt_rate | kg m-2 s-1 | salt_flux | salt flux | | -!! mean_sensi_heat_flx | W m-2 | t_flux | sensible heat flux into ocean | +!! mean_sensi_heat_flx | W m-2 | t_flux | sensible heat flux into ocean | !! mean_zonal_moment_flx | Pa | u_flux | i-directed wind stress into ocean !! | [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar !! @@ -231,17 +231,19 @@ !! !! Standard Name | Units | Model Variable | Description | Notes !! ---------------------------|-------|----------------|-------------------------------------------|-------------------- -!! freezing_melting_potential | W m-2 | combination of frazil and melt_potential +!! freezing_melting_potential | W m-2 | combination of frazil and melt_potential !! | cap converts model units (J m-2) to (W m-2) for export !! ocean_mask | | | ocean mask | | !! ocn_current_merid | m s-1 | v_surf | j-directed surface velocity on u-cell -!! | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon +!! | [vector rotation] (@ref VectorRotations) applied +!! | - tripolar to lat-lon !! ocn_current_zonal | m s-1 | u_surf | i-directed surface velocity on u-cell -!! | [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon +!! | [vector rotation] (@ref VectorRotations) applied +!! | - tripolar to lat-lon !! s_surf | psu | s_surf | sea surface salinity on t-cell | | !! sea_surface_temperature | K | t_surf | sea surface temperature on t-cell | | -!! sea_surface_slope_zonal ! unitless | created from ssh | sea surface zonal slope -!! sea_surface_slope_merid ! unitless | created from ssh | sea surface meridional slope +!! sea_surface_slope_zonal ! unitless | created from ssh | sea surface zonal slope +!! sea_surface_slope_merid ! unitless | created from ssh | sea surface meridional slope !! so_bldepth ! m ! obld | ocean surface boundary layer depth !! !! @subsection MemoryManagement Memory Management @@ -878,7 +880,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return else - call ESMF_LogWrite('mom_cap: restart requested but no RestartFileToRead attribute provided - will use input.nml', & + call ESMF_LogWrite('mom_cap: restart requested, no RestartFileToRead attribute provided-will use input.nml',& ESMF_LOGMSG_WARNING, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -2337,8 +2339,9 @@ subroutine SetScalarField(field, rc) file=__FILE__)) & return ! bail out + ! num of scalar values field = ESMF_FieldCreate(name=trim(scalar_field_name), grid=grid, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), gridToFieldMap=(/2/), rc=rc) ! num of scalar values + ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), gridToFieldMap=(/2/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & From 0a1a313b3bcef90def5277fb619287573c24f5da Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 11 Mar 2019 19:24:51 -0400 Subject: [PATCH 1023/1072] Correct thermo clock with update_ocean_model calls Store the thermodynamic clock at the start of update_ocean_model so that it does not get incorrectly updated during purely dynamic steps. When both dynamics and thermodynamics are stepped together, nothing is changed, but when they are stepped separately, this correct the thermodynamic clock that is used primarily for diagnostics. All answers are bitwise identical in the existing test cases. --- config_src/coupled_driver/ocean_model_MOM.F90 | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 5af0b774b0..b62f479354 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -442,8 +442,12 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda real, optional, intent(in) :: cycle_length !< The duration of a coupled time stepping cycle [s]. ! Local variables - type(time_type) :: Time_seg_start ! Stores the ocean model time at the start of this call to allow - ! step_MOM to temporarily change the time as seen by internal modules. + type(time_type) :: Time_seg_start ! Stores the dynamic or thermodynamic ocean model time at the + ! start of this call to allow step_MOM to temporarily change the time + ! as seen by internal modules. + type(time_type) :: Time_thermo_start ! Stores the ocean model thermodynamics time at the start of + ! this call to allow step_MOM to temporarily change the time as 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 of the current fluxes. @@ -563,6 +567,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%restart_CSp) endif + Time_thermo_start = OS%Time Time_seg_start = OS%Time ; if (do_dyn) Time_seg_start = OS%Time_dyn Time1 = Time_seg_start @@ -576,7 +581,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda 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 + else ! Step both the dynamics and thermodynamics with separate calls. 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)) @@ -636,7 +641,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda if (do_dyn) OS%Time_dyn = Time_seg_start + Ocean_coupling_time_step if (do_dyn) OS%nstep = OS%nstep + 1 - OS%Time = Time_seg_start ! Reset the clock to compensate for shared pointers. + OS%Time = Time_thermo_start ! Reset the clock to compensate for shared pointers. if (do_thermo) OS%Time = OS%Time + Ocean_coupling_time_step if (do_thermo) OS%nstep_thermo = OS%nstep_thermo + 1 From c19640baf4338a8a3b4420a660208e1ed53f456b Mon Sep 17 00:00:00 2001 From: Navid Constantinou Date: Tue, 12 Mar 2019 14:25:48 +1100 Subject: [PATCH 1024/1072] changes vector notation and fixes typos --- docs/equations/ALE-algorithm.rst | 25 ++++++++-------- docs/equations/general_coordinate.rst | 12 ++++---- docs/equations/governing.rst | 38 ++++++++++++------------ docs/equations/notation.rst | 14 ++++----- docs/equations/vector_invariant_eqns.rst | 18 +++++------ 5 files changed, 53 insertions(+), 54 deletions(-) diff --git a/docs/equations/ALE-algorithm.rst b/docs/equations/ALE-algorithm.rst index 694b050b8e..2234fd40b8 100644 --- a/docs/equations/ALE-algorithm.rst +++ b/docs/equations/ALE-algorithm.rst @@ -5,24 +5,24 @@ The semi-discrete, vertically integrated, Boussinesq hydrostatic equations of motion in general-coordinate :math:`r` are .. math:: - D_t \vec{u} + f \hat{k} \wedge \vec{u} + \nabla_z \Phi + \frac{1}{\rho_o} \nabla_z p &= \nabla \cdot \vec{\underline{\tau}} \\ - \rho \delta_k \Phi + \delta_k p &= 0 \\ - \partial_t h + \nabla_r \cdot ( h \vec{u} ) + \delta_k ( z_r \dot{r} ) &= 0 \\ - \partial_t h \theta + \nabla_r \cdot ( h \vec{u} \theta ) + \delta_k ( z_r \dot{r} \theta ) &= \nabla \cdot \vec{Q}_\theta \\ - \partial_t h S + \nabla_r \cdot ( h \vec{u} S ) + \delta_k ( z_r \dot{r} S ) &= \nabla \cdot \vec{Q}_S \\ - \rho &= \rho(S, \theta, z) + D_t \boldsymbol{u} + f \widehat{\boldsymbol{k}} \wedge \boldsymbol{u} + \boldsymbol{\nabla}_z \Phi + \frac{1}{\rho_o} \boldsymbol{\nabla}_z p &= \boldsymbol{\nabla} \cdot \boldsymbol{\underline{\tau}} ,\\ + \rho \delta_k \Phi + \delta_k p &= 0 ,\\ + \partial_t h + \nabla_r \cdot ( h \boldsymbol{u} ) + \delta_k ( z_r \dot{r} ) &= 0 ,\\ + \partial_t h \theta + \nabla_r \cdot ( h \boldsymbol{u} \theta ) + \delta_k ( z_r \dot{r} \theta ) &= \boldsymbol{\nabla} \cdot \boldsymbol{Q}_\theta ,\\ + \partial_t h S + \nabla_r \cdot ( h \boldsymbol{u} S ) + \delta_k ( z_r \dot{r} S ) &= \boldsymbol{\nabla} \cdot \boldsymbol{Q}_S ,\\ + \rho &= \rho(S, \theta, z) . The Arbitrary-Lagrangian-Eulerian algorithm we use is quasi-Lagrangian in that in the first (Lagrangian) phase, regardless of the current mesh (or coordinate :math:`r`) we integrate the equations forward with :math:`\dot{r}=0`, i.e.: .. math:: - D_t \vec{u} + f \hat{k} \wedge \vec{u} + \nabla_z \Phi + \frac{1}{\rho_o} \nabla_z p &= \nabla \cdot \vec{\underline{\tau}} \\ - \rho \delta_k \Phi + \delta_k p &= 0 \\ - \partial_t h + \nabla_r \cdot ( h \vec{u} ) &= 0 \\ - \partial_t h \theta + \nabla_r \cdot ( h \vec{u} \theta ) &= \nabla \cdot \vec{Q}_\theta \\ - \partial_t h S + \nabla_r \cdot ( h \vec{u} S ) &= \nabla \cdot \vec{Q}_S \\ - \rho &= \rho(S, \theta, z) + D_t \boldsymbol{u} + f \widehat{\boldsymbol{k}} \wedge \boldsymbol{u} + \boldsymbol{\nabla}_z \Phi + \frac{1}{\rho_o} \boldsymbol{\nabla}_z p &= \boldsymbol{\nabla} \cdot \boldsymbol{\underline{\tau}} ,\\ + \rho \delta_k \Phi + \delta_k p &= 0 ,\\ + \partial_t h + \nabla_r \cdot ( h \boldsymbol{u} ) &= 0 ,\\ + \partial_t (h \theta) + \nabla_r \cdot ( h \boldsymbol{u} \theta ) &= \boldsymbol{\nabla} \cdot \boldsymbol{Q}_\theta ,\\ + \partial_t (h S) + \nabla_r \cdot ( h \boldsymbol{u} S ) &= \boldsymbol{\nabla} \cdot \boldsymbol{Q}_S ,\\ + \rho &= \rho(S, \theta, z) . Notice that by setting :math:`\dot{r}=0` all the terms with the metric :math:`z_r` disappeared. @@ -31,4 +31,3 @@ After a finite amount of time, the mesh (:math:`h`) may become very distorted or unrelated to the intended mesh. At any point in time, we can simply define a new mesh and remap from the current mesh to the new mesh without an explicit change in the physical state. - diff --git a/docs/equations/general_coordinate.rst b/docs/equations/general_coordinate.rst index 377adc9421..ca2d79025b 100644 --- a/docs/equations/general_coordinate.rst +++ b/docs/equations/general_coordinate.rst @@ -9,9 +9,9 @@ The Boussinesq hydrostatic equations of motion in general-coordinate :math:`r` are .. math:: - D_t \vec{u} + f \hat{k} \wedge \vec{u} + \nabla_z \Phi + \frac{1}{\rho_o} \nabla_z p &= \nabla \cdot \vec{\underline{\tau}} \\ - \rho \partial_z \Phi + \partial_z p &= 0 \\ - \partial_t z_r + \nabla_r \cdot ( z_r \vec{u} ) + \partial_r ( z_r \dot{r} ) &= 0 \\ - \partial_t z_r \theta + \nabla_r \cdot ( z_r \vec{u} \theta ) + \partial_r ( z_r \dot{r} \theta ) &= \nabla \cdot \vec{Q}_\theta \\ - \partial_t z_r S + \nabla_r \cdot ( z_r \vec{u} S ) + \partial_r ( z_r \dot{r} S ) &= \nabla \cdot \vec{Q}_S \\ - \rho &= \rho(S, \theta, z) + D_t \boldsymbol{u} + f \widehat{\boldsymbol{k}} \wedge \boldsymbol{u} + \boldsymbol{\nabla}_z \Phi + \frac{1}{\rho_o} \boldsymbol{\nabla}_z p &= \boldsymbol{\nabla} \cdotp \boldsymbol{\underline{\tau}} ,\\ + \rho \partial_z \Phi + \partial_z p &= 0 ,\\ + \partial_t z_r + \nabla_r \cdotp ( z_r \boldsymbol{u} ) + \partial_r ( z_r \dot{r} ) &= 0 ,\\ + \partial_t z_r \theta + \nabla_r \cdotp ( z_r \boldsymbol{u} \theta ) + \partial_r ( z_r \dot{r} \theta ) &= \boldsymbol{\nabla} \cdotp \boldsymbol{Q}_\theta ,\\ + \partial_t z_r S + \nabla_r \cdotp ( z_r \boldsymbol{u} S ) + \partial_r ( z_r \dot{r} S ) &= \boldsymbol{\nabla} \cdotp \boldsymbol{Q}_S ,\\ + \rho &= \rho(S, \theta, z) . diff --git a/docs/equations/governing.rst b/docs/equations/governing.rst index 4687b2f8fc..ae31e9634c 100644 --- a/docs/equations/governing.rst +++ b/docs/equations/governing.rst @@ -6,39 +6,39 @@ Governing equations The Boussinesq hydrostatic equations of motion in height coordinates are .. math:: - D_t \vec{u} + f \hat{k} \wedge \vec{u} + \nabla_z \Phi + \frac{1}{\rho_o} \nabla_z p &= \nabla \cdot \vec{\underline{\tau}} \\ - \rho \partial_z \Phi + \partial_z p &= 0 \\ - \nabla_z \cdot \vec{u} + \partial_z w &= 0 \\ - D_t \theta &= \nabla \cdot \vec{Q}_\theta \\ - D_t S &= \nabla \cdot \vec{Q}_S \\ - \rho &= \rho(S, \theta, z) - -where notation is described in :ref:`equations-notation`. :math:`\vec{\underline{\tau}}` is the stress tensori and -:math:`\vec{Q}_\theta` and :math:`\vec{Q}_S` are fluxes of heat and salt respectively. + D_t \boldsymbol{u} + f \widehat{\boldsymbol{k}} \wedge \boldsymbol{u} + \boldsymbol{\nabla}_z \Phi + \frac{1}{\rho_o} \boldsymbol{\nabla}_z p &= \boldsymbol{\nabla} \cdotp \boldsymbol{\underline{\tau}} , \\ + \rho \partial_z \Phi + \partial_z p &= 0 , \\ + \boldsymbol{\nabla}_z \cdotp \boldsymbol{u} + \partial_z w &= 0 , \\ + D_t \theta &= \boldsymbol{\nabla} \cdotp \boldsymbol{Q}_\theta , \\ + D_t S &= \boldsymbol{\nabla} \cdotp \boldsymbol{Q}_S , \\ + \rho &= \rho(S, \theta, z) , + +where notation is described in :ref:`equations-notation`. :math:`\boldsymbol{\underline{\tau}}` is the stress tensori and +:math:`\boldsymbol{Q}_\theta` and :math:`\boldsymbol{Q}_S` are fluxes of heat and salt respectively. .. :ref:`vector_invariant` The total derivative is .. math:: - D_t &\equiv \partial_t + \vec{v} \cdot \nabla \\ - &= \partial_t + \vec{u} \cdot \nabla_z + w \partial_z + D_t & \equiv \partial_t + \boldsymbol{v} \cdotp \boldsymbol{\nabla} \\ + &= \partial_t + \boldsymbol{u} \cdotp \boldsymbol{\nabla}_z + w \partial_z . The non-divergence of flow allows a total derivative to be re-written in flux form: .. math:: - D_t \theta &= \partial_t + \nabla \cdot ( \vec{v} \theta ) \\ - &= \partial_t + \nabla_z \cdot ( \vec{u} \theta ) + \partial_z ( w \theta ) + D_t \theta &= \partial_t + \boldsymbol{\nabla} \cdotp ( \boldsymbol{v} \theta ) \\ + &= \partial_t + \boldsymbol{\nabla}_z \cdotp ( \boldsymbol{u} \theta ) + \partial_z ( w \theta ) . The above equations of motion can thus be written as: .. math:: - D_t \vec{u} + f \hat{k} \wedge \vec{u} + \nabla_z \Phi + \frac{1}{\rho_o} \nabla_z p &= \nabla \cdot \vec{\underline{\tau}} \\ - \rho \partial_z \Phi + \partial_z p &= 0 \\ - \nabla_z \cdot \vec{u} + \partial_z w &= 0 \\ - \partial_t \theta + \nabla_z \cdot ( \vec{u} \theta ) + \partial_z ( w \theta ) &= \nabla \cdot \vec{Q}_\theta \\ - \partial_t S + \nabla_z \cdot ( \vec{u} S ) + \partial_z ( w S ) &= \nabla \cdot \vec{Q}_S \\ - \rho &= \rho(S, \theta, z) + D_t \boldsymbol{u} + f \widehat{\boldsymbol{k}} \wedge \boldsymbol{u} + \boldsymbol{\nabla}_z \Phi + \frac{1}{\rho_o} \boldsymbol{\nabla}_z p &= \boldsymbol{\nabla} \cdotp \boldsymbol{\underline{\tau}} ,\\ + \rho \partial_z \Phi + \partial_z p &= 0 ,\\ + \boldsymbol{\nabla}_z \cdotp \boldsymbol{u} + \partial_z w &= 0 ,\\ + \partial_t \theta + \boldsymbol{\nabla}_z \cdotp ( \boldsymbol{u} \theta ) + \partial_z ( w \theta ) &= \boldsymbol{\nabla} \cdotp \boldsymbol{Q}_\theta ,\\ + \partial_t S + \boldsymbol{\nabla}_z \cdotp ( \boldsymbol{u} S ) + \partial_z ( w S ) &= \nabla \cdotp \boldsymbol{Q}_S ,\\ + \rho &= \rho(S, \theta, z) . .. toctree:: vector_invariant_eqns diff --git a/docs/equations/notation.rst b/docs/equations/notation.rst index e15cc204c9..6a1337b2a4 100644 --- a/docs/equations/notation.rst +++ b/docs/equations/notation.rst @@ -16,28 +16,28 @@ Horizontal components of velocity are indicated by :math:`u` and :math:`v` and v :math:`p` is pressure and :math:`\Phi` is geo-potential: -.. math: - \Phi = g z +.. math:: + \Phi = g z . The thermodynamic state variables are usually salinity, :math:`S`, and potential temperature, :math:`\theta` or the absolute salinity and conservative temperature, depending on the equation of state. :math:`\rho` is in-situ density. Vector notation --------------- -The three-dimensional velocity vector is denoted :math:`\vec{v}` +The three-dimensional velocity vector is denoted :math:`\boldsymbol{v}` .. math:: - \vec{v} = \vec{u} + \vec{k} w + \boldsymbol{v} = \boldsymbol{u} + \widehat{\boldsymbol{k}} w , -where :math:`\vec{k}` is the unit vector pointed in the upward vertical direction and :math:`\vec{u} = (u,v,0)` is the horizontal +where :math:`\widehat{\boldsymbol{k}}` is the unit vector pointed in the upward vertical direction and :math:`\boldsymbol{u} = (u, v, 0)` is the horizontal component of velocity normal to the vertical. The gradient operator without a suffix is three dimensional: .. math:: - \nabla = ( \nabla_z, \partial_z ) . + \boldsymbol{\nabla} = ( \boldsymbol{\nabla}_z, \boldsymbol{\nabla}_z ) . but a suffix indicates a lateral gradient along a surface of constant property indicated by the suffix: .. math:: - \nabla_z = \left( \left. \partial_x \right|_z, \left. \partial_y \right|_z, 0 \right) . + \boldsymbol{\nabla}_z = \left( \left. \partial_x \right|_z, \left. \partial_y \right|_z, 0 \right) . diff --git a/docs/equations/vector_invariant_eqns.rst b/docs/equations/vector_invariant_eqns.rst index 22c3b10ee1..50b00ad92c 100644 --- a/docs/equations/vector_invariant_eqns.rst +++ b/docs/equations/vector_invariant_eqns.rst @@ -8,18 +8,18 @@ MOM6 solve the momentum equations written in vector-invariant form. An identity allows the total derivative of velocity to be written in the vector-invariant form: .. math:: - D_t \vec{u} &= \partial_t \vec{u} + \vec{v} \cdot \nabla \vec{u} \\ - &= \partial_t \vec{u} + \vec{u} \cdot \nabla_z \vec{u} + w \partial_z \vec{u} \\ - &= \partial_t \vec{u} + \left( \nabla \wedge \vec{u} \right) \wedge \vec{v} + \nabla \frac{1}{2} \left|\vec{u}\right|^2 + D_t \boldsymbol{u} &= \partial_t \boldsymbol{u} + \boldsymbol{v} \cdotp \boldsymbol{\nabla} \boldsymbol{u} \\ + &= \partial_t \boldsymbol{u} + \boldsymbol{u} \cdotp \boldsymbol{\nabla}_z \boldsymbol{u} + w \partial_z \boldsymbol{u} \\ + &= \partial_t \boldsymbol{u} + \left( \boldsymbol{\nabla} \wedge \boldsymbol{u} \right) \wedge \boldsymbol{v} + \boldsymbol{\nabla} \underbrace{\frac{1}{2} \left|\boldsymbol{u}\right|^2}_{\equiv K} . The flux-form equations of motion in height coordinates can thus be written succinctly as: .. math:: - \partial_t \vec{u} + \left( f \hat{k} + \nabla \wedge \vec{u} \right) \wedge \vec{v} + \nabla K - + \frac{\rho}{\rho_o} \nabla \Phi + \frac{1}{\rho_o} \nabla p &= \nabla \cdot \vec{\underline{\tau}} \\ - \nabla_z \cdot \vec{u} + \partial_z w &= 0 \\ - \partial_t \theta + \nabla_z \cdot ( \vec{u} \theta ) + \partial_z ( w \theta ) &= \nabla \cdot \vec{Q}_\theta \\ - \partial_t S + \nabla_z \cdot ( \vec{u} S ) + \partial_z ( w S ) &= \nabla \cdot \vec{Q}_S \\ - \rho &= \rho(S, \theta, z) + \partial_t \boldsymbol{u} + \left( f \widehat{\boldsymbol{k}} + \boldsymbol{\nabla} \wedge \boldsymbol{u} \right) \wedge \boldsymbol{v} + \boldsymbol{\nabla} K + + \frac{\rho}{\rho_o} \boldsymbol{\nabla} \Phi + \frac{1}{\rho_o} \boldsymbol{\nabla} p &= \boldsymbol{\nabla} \cdotp \boldsymbol{\underline{\tau}} ,\\ + \boldsymbol{\nabla}_z \cdotp \boldsymbol{u} + \partial_z w &= 0 ,\\ + \partial_t \theta + \boldsymbol{\nabla}_z \cdotp ( \boldsymbol{u} \theta ) + \partial_z ( w \theta ) &= \boldsymbol{\nabla} \cdotp \boldsymbol{Q}_\theta ,\\ + \partial_t S + \boldsymbol{\nabla}_z \cdotp ( \boldsymbol{u} S ) + \partial_z ( w S ) &= \boldsymbol{\nabla} \cdotp \boldsymbol{Q}_S ,\\ + \rho &= \rho(S, \theta, z) , where the horizontal momentum equations and vertical hydrostatic balance equation have been written as a single three-dimensional equation. From b8cdd7c6febf9dd8b55c62beab4a77cb4196e87f Mon Sep 17 00:00:00 2001 From: Navid Constantinou Date: Tue, 12 Mar 2019 14:37:40 +1100 Subject: [PATCH 1025/1072] fixes typo and adds Angus link --- docs/README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/README.md b/docs/README.md index aafe349ebc..8870a46a26 100644 --- a/docs/README.md +++ b/docs/README.md @@ -38,11 +38,11 @@ If you are building the full generated sphinx documentation you will need the fo (.e.g `apt-get install libxml2-dev libxslt-dev`) -Before running sphinc (`make html`) you will need to issue: +Before running sphinx (`make html`) you will need to issue: ```bash pip install -r requirements.txt ``` ## Credits -The sphinx documentation of MOM6 is made possible by modifications by Angus Gibson to two packages, [sphinx-fortran](https://github.com/angus-g/sphinx-fortran) and [autodoc_doxygen](https://github.com/angus-g/sphinxcontrib-autodoc_doxygen). +The sphinx documentation of MOM6 is made possible by modifications by [Angus Gibson](https://github.com/angus-g) to two packages, [sphinx-fortran](https://github.com/angus-g/sphinx-fortran) and [autodoc_doxygen](https://github.com/angus-g/sphinxcontrib-autodoc_doxygen). From d263de4693f8bd8861ec7cd61b6d3acf5e554285 Mon Sep 17 00:00:00 2001 From: Navid Constantinou Date: Tue, 12 Mar 2019 15:56:35 +1100 Subject: [PATCH 1026/1072] some more typos and a few nablas that were left unbolded --- docs/equations/general_coordinate.rst | 6 +++--- docs/equations/overview.rst | 2 +- docs/equations/vector_invariant_eqns.rst | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/docs/equations/general_coordinate.rst b/docs/equations/general_coordinate.rst index ca2d79025b..98ccd3fc85 100644 --- a/docs/equations/general_coordinate.rst +++ b/docs/equations/general_coordinate.rst @@ -11,7 +11,7 @@ The Boussinesq hydrostatic equations of motion in general-coordinate .. math:: D_t \boldsymbol{u} + f \widehat{\boldsymbol{k}} \wedge \boldsymbol{u} + \boldsymbol{\nabla}_z \Phi + \frac{1}{\rho_o} \boldsymbol{\nabla}_z p &= \boldsymbol{\nabla} \cdotp \boldsymbol{\underline{\tau}} ,\\ \rho \partial_z \Phi + \partial_z p &= 0 ,\\ - \partial_t z_r + \nabla_r \cdotp ( z_r \boldsymbol{u} ) + \partial_r ( z_r \dot{r} ) &= 0 ,\\ - \partial_t z_r \theta + \nabla_r \cdotp ( z_r \boldsymbol{u} \theta ) + \partial_r ( z_r \dot{r} \theta ) &= \boldsymbol{\nabla} \cdotp \boldsymbol{Q}_\theta ,\\ - \partial_t z_r S + \nabla_r \cdotp ( z_r \boldsymbol{u} S ) + \partial_r ( z_r \dot{r} S ) &= \boldsymbol{\nabla} \cdotp \boldsymbol{Q}_S ,\\ + \partial_t z_r + \boldsymbol{\nabla}_r \cdotp ( z_r \boldsymbol{u} ) + \partial_r ( z_r \dot{r} ) &= 0 ,\\ + \partial_t z_r \theta + \boldsymbol{\nabla}_r \cdotp ( z_r \boldsymbol{u} \theta ) + \partial_r ( z_r \dot{r} \theta ) &= \boldsymbol{\nabla} \cdotp \boldsymbol{Q}_\theta ,\\ + \partial_t z_r S + \boldsymbol{\nabla}_r \cdotp ( z_r \boldsymbol{u} S ) + \partial_r ( z_r \dot{r} S ) &= \boldsymbol{\nabla} \cdotp \boldsymbol{Q}_S ,\\ \rho &= \rho(S, \theta, z) . diff --git a/docs/equations/overview.rst b/docs/equations/overview.rst index b6f8d60627..de7a4e484d 100644 --- a/docs/equations/overview.rst +++ b/docs/equations/overview.rst @@ -4,7 +4,7 @@ Equations The model equations are the layer-integrated vector-invariant form of the hydrostatic primitive equations (either Boussinesq or non-Boussinesq). -We present the equations starting from the hydrostatic Boussinesq equation is +We present the equations starting from the hydrostatic Boussinesq equation in height coordinates and progress through vector-invariant and general-coordinate equations to the final equations used in the A.L.E. algorithm. diff --git a/docs/equations/vector_invariant_eqns.rst b/docs/equations/vector_invariant_eqns.rst index 50b00ad92c..f57eb8bafa 100644 --- a/docs/equations/vector_invariant_eqns.rst +++ b/docs/equations/vector_invariant_eqns.rst @@ -3,9 +3,9 @@ Vector Invariant Equations ========================== -MOM6 solve the momentum equations written in vector-invariant form. +MOM6 solves the momentum equations written in vector-invariant form. -An identity allows the total derivative of velocity to be written in the vector-invariant form: +A vector identity allows the total derivative of velocity to be written in the vector-invariant form: .. math:: D_t \boldsymbol{u} &= \partial_t \boldsymbol{u} + \boldsymbol{v} \cdotp \boldsymbol{\nabla} \boldsymbol{u} \\ From 37378cf7226600eba81f0ced8bc345dec7cdea1f Mon Sep 17 00:00:00 2001 From: Navid Constantinou Date: Tue, 12 Mar 2019 16:08:53 +1100 Subject: [PATCH 1027/1072] adds parentheses in general-coordinate versions of temp and sal --- docs/equations/general_coordinate.rst | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/equations/general_coordinate.rst b/docs/equations/general_coordinate.rst index 98ccd3fc85..91b91e3f35 100644 --- a/docs/equations/general_coordinate.rst +++ b/docs/equations/general_coordinate.rst @@ -12,6 +12,6 @@ The Boussinesq hydrostatic equations of motion in general-coordinate D_t \boldsymbol{u} + f \widehat{\boldsymbol{k}} \wedge \boldsymbol{u} + \boldsymbol{\nabla}_z \Phi + \frac{1}{\rho_o} \boldsymbol{\nabla}_z p &= \boldsymbol{\nabla} \cdotp \boldsymbol{\underline{\tau}} ,\\ \rho \partial_z \Phi + \partial_z p &= 0 ,\\ \partial_t z_r + \boldsymbol{\nabla}_r \cdotp ( z_r \boldsymbol{u} ) + \partial_r ( z_r \dot{r} ) &= 0 ,\\ - \partial_t z_r \theta + \boldsymbol{\nabla}_r \cdotp ( z_r \boldsymbol{u} \theta ) + \partial_r ( z_r \dot{r} \theta ) &= \boldsymbol{\nabla} \cdotp \boldsymbol{Q}_\theta ,\\ - \partial_t z_r S + \boldsymbol{\nabla}_r \cdotp ( z_r \boldsymbol{u} S ) + \partial_r ( z_r \dot{r} S ) &= \boldsymbol{\nabla} \cdotp \boldsymbol{Q}_S ,\\ + \partial_t (z_r \theta) + \boldsymbol{\nabla}_r \cdotp ( z_r \boldsymbol{u} \theta ) + \partial_r ( z_r \dot{r} \theta ) &= \boldsymbol{\nabla} \cdotp \boldsymbol{Q}_\theta ,\\ + \partial_t (z_r S) + \boldsymbol{\nabla}_r \cdotp ( z_r \boldsymbol{u} S ) + \partial_r ( z_r \dot{r} S ) &= \boldsymbol{\nabla} \cdotp \boldsymbol{Q}_S ,\\ \rho &= \rho(S, \theta, z) . From 319ed39e19e3b2ccc3685c0d2ee17fb68496f501 Mon Sep 17 00:00:00 2001 From: Navid Constantinou Date: Tue, 12 Mar 2019 16:12:47 +1100 Subject: [PATCH 1028/1072] adds parentheses in general-coordinate versions of temp and sal --- docs/equations/ALE-algorithm.rst | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/equations/ALE-algorithm.rst b/docs/equations/ALE-algorithm.rst index 2234fd40b8..43b601c98a 100644 --- a/docs/equations/ALE-algorithm.rst +++ b/docs/equations/ALE-algorithm.rst @@ -8,8 +8,8 @@ motion in general-coordinate :math:`r` are D_t \boldsymbol{u} + f \widehat{\boldsymbol{k}} \wedge \boldsymbol{u} + \boldsymbol{\nabla}_z \Phi + \frac{1}{\rho_o} \boldsymbol{\nabla}_z p &= \boldsymbol{\nabla} \cdot \boldsymbol{\underline{\tau}} ,\\ \rho \delta_k \Phi + \delta_k p &= 0 ,\\ \partial_t h + \nabla_r \cdot ( h \boldsymbol{u} ) + \delta_k ( z_r \dot{r} ) &= 0 ,\\ - \partial_t h \theta + \nabla_r \cdot ( h \boldsymbol{u} \theta ) + \delta_k ( z_r \dot{r} \theta ) &= \boldsymbol{\nabla} \cdot \boldsymbol{Q}_\theta ,\\ - \partial_t h S + \nabla_r \cdot ( h \boldsymbol{u} S ) + \delta_k ( z_r \dot{r} S ) &= \boldsymbol{\nabla} \cdot \boldsymbol{Q}_S ,\\ + \partial_t (h \theta) + \nabla_r \cdot ( h \boldsymbol{u} \theta ) + \delta_k ( z_r \dot{r} \theta ) &= \boldsymbol{\nabla} \cdot \boldsymbol{Q}_\theta ,\\ + \partial_t (h S) + \nabla_r \cdot ( h \boldsymbol{u} S ) + \delta_k ( z_r \dot{r} S ) &= \boldsymbol{\nabla} \cdot \boldsymbol{Q}_S ,\\ \rho &= \rho(S, \theta, z) . The Arbitrary-Lagrangian-Eulerian algorithm we use is quasi-Lagrangian in From 8256a11729aa930f10447e4c5f22654b61cd90bf Mon Sep 17 00:00:00 2001 From: Navid Constantinou Date: Tue, 12 Mar 2019 16:29:58 +1100 Subject: [PATCH 1029/1072] fixes notation in mom_hor_visc module documentation --- .../lateral/MOM_hor_visc.F90 | 22 +++++++++---------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index a980704d21..370cd4faaa 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1709,7 +1709,7 @@ end subroutine hor_visc_end !! !! In general, the horizontal stress tensor can be written as !! \f[ -!! {\bf \sigma} = +!! \boldsymbol{\sigma} = !! \begin{pmatrix} !! \frac{1}{2} \left( \sigma_D + \sigma_T \right) & \frac{1}{2} \sigma_S \\\\ !! \frac{1}{2} \sigma_S & \frac{1}{2} \left( \sigma_D - \sigma_T \right) @@ -1738,7 +1738,7 @@ end subroutine hor_visc_end !! calculations of the strain tensor in the code. Therefore the horizontal stress !! tensor can be considered to be !! \f[ -!! {\bf \sigma} = +!! \boldsymbol{\sigma} = !! \begin{pmatrix} !! \frac{1}{2} \sigma_T & \frac{1}{2} \sigma_S \\\\ !! \frac{1}{2} \sigma_S & - \frac{1}{2} \sigma_T @@ -1758,7 +1758,7 @@ end subroutine hor_visc_end !! !! The accelerations resulting form the divergence of the stress tensor are !! \f{eqnarray*}{ -!! \hat{\bf x} \cdot \left( \nabla \cdot {\bf \sigma} \right) +!! \widehat{\boldsymbol x} \cdotp \left( \boldsymbol{\nabla}\cdotp \boldsymbol{\sigma} \right) !! & = & !! \partial_x \left( \frac{1}{2} \sigma_T \right) !! + \partial_y \left( \frac{1}{2} \sigma_S \right) @@ -1767,7 +1767,7 @@ end subroutine hor_visc_end !! \partial_x \left( \kappa_h \dot{e}_T \right) !! + \partial_y \left( \kappa_h \dot{e}_S \right) !! \\\\ -!! \hat{\bf y} \cdot \left( \nabla \cdot {\bf \sigma} \right) +!! \widehat{\boldsymbol y} \cdotp \left( \boldsymbol{\nabla}\cdotp \boldsymbol{\sigma} \right) !! & = & !! \partial_x \left( \frac{1}{2} \sigma_S \right) !! + \partial_y \left( \frac{1}{2} \sigma_T \right) @@ -1780,12 +1780,12 @@ end subroutine hor_visc_end !! !! The form of the Laplacian viscosity in general coordinates is: !! \f{eqnarray*}{ -!! \hat{\bf x} \cdot \left( \nabla \cdot \sigma \right) +!! \widehat{\boldsymbol x} \cdotp \left( \boldsymbol{\nabla}\cdotp \sigma \right) !! & = & !! \frac{1}{h} \left[ \partial_x \left( \kappa_h h \dot{e}_T \right) !! + \partial_y \left( \kappa_h h \dot{e}_S \right) \right] !! \\\\ -!! \hat{\bf y} \cdot \left( \nabla \cdot \sigma \right) +!! \widehat{\boldsymbol y} \cdotp \left( \boldsymbol{\nabla}\cdotp \sigma \right) !! & = & !! \frac{1}{h} \left[ \partial_x \left( \kappa_h h \dot{e}_S \right) !! - \partial_y \left( \kappa_h h \dot{e}_T \right) \right] @@ -1805,7 +1805,7 @@ end subroutine hor_visc_end !! latitude, \f$\kappa_{\phi}(x,y) = \kappa_{\pi/2} |\sin(\phi)|^n\f$. !! - A dynamic Smagorinsky viscosity, \f$\kappa_{Sm}(x,y,t) = C_{Sm} \Delta^2 \sqrt{\dot{e}_T^2 + \dot{e}_S^2}\f$. !! - A dynamic Leith viscosity, \f$\kappa_{Lth}(x,y,t) = -!! C_{Lth} \Delta^3 \sqrt{|\nabla \zeta|^2 + |\nabla \dot{e}_D|^2}\f$. +!! C_{Lth} \Delta^3 \sqrt{|\boldsymbol{\nabla}\zeta|^2 + |\boldsymbol{\nabla}\dot{e}_D|^2}\f$. !! !! A maximum stable viscosity, \f$\kappa_{max}(x,y)\f$ is calculated based on the !! grid-spacing and time-step and used to clip calculated viscosities. @@ -1887,7 +1887,7 @@ end subroutine hor_visc_end !! \f$n_2 = 0\f$ and the cross terms vanish. The accelerations in this aligned limit !! with constant coefficients become !! \f{eqnarray*}{ -!! \hat{\bf x} \cdot \nabla \cdot {\bf \sigma} +!! \widehat{\boldsymbol x} \cdotp \boldsymbol{\nabla}\cdotp \boldsymbol{\sigma} !! & = & !! \partial_x \left( \left( \kappa_h + \frac{1}{2} \kappa_a \right) \dot{e}_T \right) !! + \partial_y \left( \kappa_h \dot{e}_S \right) @@ -1897,7 +1897,7 @@ end subroutine hor_visc_end !! + \kappa_h \partial_{yy} u !! - \frac{1}{2} \kappa_a \partial_x \left( \partial_x u + \partial_y v \right) !! \\\\ -!! \hat{\bf y} \cdot \nabla \cdot {\bf \sigma} +!! \widehat{\boldsymbol y} \cdotp \boldsymbol{\nabla}\cdotp \boldsymbol{\sigma} !! & = & !! \partial_x \left( \kappa_h \dot{e}_S \right) !! - \partial_y \left( \left( \kappa_h + \frac{1}{2} \kappa_a \right) \dot{e}_T \right) @@ -1947,7 +1947,7 @@ end subroutine hor_visc_end !! The tendency for the x-component of the divergence of stress is stored in !! variable diffu and discretized as !! \f[ -!! \hat{\bf x} \cdot \left( \nabla \cdot {\bf \sigma} \right) = +!! \widehat{\boldsymbol x} \cdotp \left( \boldsymbol{\nabla}\cdotp \boldsymbol{\sigma} \right) = !! \frac{1}{A \overline{h}^i} \left( !! \frac{1}{\Delta y} \delta_i \left( h \Delta y^2 \kappa_h \dot{e}_T \right) + !! \frac{1}{\Delta x} \delta_j \left( \tilde{h}^{ij} \Delta x^2 \kappa_h \dot{e}_S \right) @@ -1958,7 +1958,7 @@ end subroutine hor_visc_end !! The tendency for the y-component of the divergence of stress is stored in !! variable diffv and discretized as !! \f[ -!! \hat{\bf y} \cdot \left( \nabla \cdot {\bf \sigma} \right) = +!! \widehat{\boldsymbol y} \cdotp \left( \boldsymbol{\nabla}\cdotp \boldsymbol{\sigma} \right) = !! \frac{1}{A \overline{h}^j} \left( !! \frac{1}{\Delta y} \delta_i \left( \tilde{h}^{ij} \Delta y^2 A_M \dot{e}_S \right) !! - \frac{1}{\Delta x} \delta_j \left( h \Delta x^2 A_M \dot{e}_T \right) From 8a979c3a5b3e4b48ddba35256eb7dee2114e0722 Mon Sep 17 00:00:00 2001 From: Navid Constantinou Date: Tue, 19 Mar 2019 07:51:20 +1100 Subject: [PATCH 1030/1072] fixes geopotential gradient term in governing eqs. --- docs/equations/governing.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/equations/governing.rst b/docs/equations/governing.rst index ae31e9634c..2b3392a559 100644 --- a/docs/equations/governing.rst +++ b/docs/equations/governing.rst @@ -6,7 +6,7 @@ Governing equations The Boussinesq hydrostatic equations of motion in height coordinates are .. math:: - D_t \boldsymbol{u} + f \widehat{\boldsymbol{k}} \wedge \boldsymbol{u} + \boldsymbol{\nabla}_z \Phi + \frac{1}{\rho_o} \boldsymbol{\nabla}_z p &= \boldsymbol{\nabla} \cdotp \boldsymbol{\underline{\tau}} , \\ + D_t \boldsymbol{u} + f \widehat{\boldsymbol{k}} \wedge \boldsymbol{u} + \frac{\rho}{\rho_o} \boldsymbol{\nabla}_z \Phi + \frac{1}{\rho_o} \boldsymbol{\nabla}_z p &= \boldsymbol{\nabla} \cdotp \boldsymbol{\underline{\tau}} , \\ \rho \partial_z \Phi + \partial_z p &= 0 , \\ \boldsymbol{\nabla}_z \cdotp \boldsymbol{u} + \partial_z w &= 0 , \\ D_t \theta &= \boldsymbol{\nabla} \cdotp \boldsymbol{Q}_\theta , \\ From b42683d4bf17a32f31849cf0804491a4e0e62d0b Mon Sep 17 00:00:00 2001 From: Navid Constantinou Date: Tue, 19 Mar 2019 07:57:55 +1100 Subject: [PATCH 1031/1072] fixes geopotential gradient term in eqs and typo in \nabla def in notation. --- docs/equations/ALE-algorithm.rst | 4 ++-- docs/equations/general_coordinate.rst | 2 +- docs/equations/governing.rst | 2 +- docs/equations/notation.rst | 2 +- 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/docs/equations/ALE-algorithm.rst b/docs/equations/ALE-algorithm.rst index 43b601c98a..28e808f254 100644 --- a/docs/equations/ALE-algorithm.rst +++ b/docs/equations/ALE-algorithm.rst @@ -5,7 +5,7 @@ The semi-discrete, vertically integrated, Boussinesq hydrostatic equations of motion in general-coordinate :math:`r` are .. math:: - D_t \boldsymbol{u} + f \widehat{\boldsymbol{k}} \wedge \boldsymbol{u} + \boldsymbol{\nabla}_z \Phi + \frac{1}{\rho_o} \boldsymbol{\nabla}_z p &= \boldsymbol{\nabla} \cdot \boldsymbol{\underline{\tau}} ,\\ + D_t \boldsymbol{u} + f \widehat{\boldsymbol{k}} \wedge \boldsymbol{u} + \frac{\rho}{\rho_o}\boldsymbol{\nabla}_z \Phi + \frac{1}{\rho_o} \boldsymbol{\nabla}_z p &= \boldsymbol{\nabla} \cdot \boldsymbol{\underline{\tau}} ,\\ \rho \delta_k \Phi + \delta_k p &= 0 ,\\ \partial_t h + \nabla_r \cdot ( h \boldsymbol{u} ) + \delta_k ( z_r \dot{r} ) &= 0 ,\\ \partial_t (h \theta) + \nabla_r \cdot ( h \boldsymbol{u} \theta ) + \delta_k ( z_r \dot{r} \theta ) &= \boldsymbol{\nabla} \cdot \boldsymbol{Q}_\theta ,\\ @@ -17,7 +17,7 @@ that in the first (Lagrangian) phase, regardless of the current mesh (or coordin :math:`r`) we integrate the equations forward with :math:`\dot{r}=0`, i.e.: .. math:: - D_t \boldsymbol{u} + f \widehat{\boldsymbol{k}} \wedge \boldsymbol{u} + \boldsymbol{\nabla}_z \Phi + \frac{1}{\rho_o} \boldsymbol{\nabla}_z p &= \boldsymbol{\nabla} \cdot \boldsymbol{\underline{\tau}} ,\\ + D_t \boldsymbol{u} + f \widehat{\boldsymbol{k}} \wedge \boldsymbol{u} + \frac{\rho}{\rho_o}\boldsymbol{\nabla}_z \Phi + \frac{1}{\rho_o} \boldsymbol{\nabla}_z p &= \boldsymbol{\nabla} \cdot \boldsymbol{\underline{\tau}} ,\\ \rho \delta_k \Phi + \delta_k p &= 0 ,\\ \partial_t h + \nabla_r \cdot ( h \boldsymbol{u} ) &= 0 ,\\ \partial_t (h \theta) + \nabla_r \cdot ( h \boldsymbol{u} \theta ) &= \boldsymbol{\nabla} \cdot \boldsymbol{Q}_\theta ,\\ diff --git a/docs/equations/general_coordinate.rst b/docs/equations/general_coordinate.rst index 91b91e3f35..6e35dacdd1 100644 --- a/docs/equations/general_coordinate.rst +++ b/docs/equations/general_coordinate.rst @@ -9,7 +9,7 @@ The Boussinesq hydrostatic equations of motion in general-coordinate :math:`r` are .. math:: - D_t \boldsymbol{u} + f \widehat{\boldsymbol{k}} \wedge \boldsymbol{u} + \boldsymbol{\nabla}_z \Phi + \frac{1}{\rho_o} \boldsymbol{\nabla}_z p &= \boldsymbol{\nabla} \cdotp \boldsymbol{\underline{\tau}} ,\\ + D_t \boldsymbol{u} + f \widehat{\boldsymbol{k}} \wedge \boldsymbol{u} + \frac{\rho}{\rho_o}\boldsymbol{\nabla}_z \Phi + \frac{1}{\rho_o} \boldsymbol{\nabla}_z p &= \boldsymbol{\nabla} \cdotp \boldsymbol{\underline{\tau}} ,\\ \rho \partial_z \Phi + \partial_z p &= 0 ,\\ \partial_t z_r + \boldsymbol{\nabla}_r \cdotp ( z_r \boldsymbol{u} ) + \partial_r ( z_r \dot{r} ) &= 0 ,\\ \partial_t (z_r \theta) + \boldsymbol{\nabla}_r \cdotp ( z_r \boldsymbol{u} \theta ) + \partial_r ( z_r \dot{r} \theta ) &= \boldsymbol{\nabla} \cdotp \boldsymbol{Q}_\theta ,\\ diff --git a/docs/equations/governing.rst b/docs/equations/governing.rst index 2b3392a559..5b37e12118 100644 --- a/docs/equations/governing.rst +++ b/docs/equations/governing.rst @@ -33,7 +33,7 @@ The non-divergence of flow allows a total derivative to be re-written in flux fo The above equations of motion can thus be written as: .. math:: - D_t \boldsymbol{u} + f \widehat{\boldsymbol{k}} \wedge \boldsymbol{u} + \boldsymbol{\nabla}_z \Phi + \frac{1}{\rho_o} \boldsymbol{\nabla}_z p &= \boldsymbol{\nabla} \cdotp \boldsymbol{\underline{\tau}} ,\\ + D_t \boldsymbol{u} + f \widehat{\boldsymbol{k}} \wedge \boldsymbol{u} + \frac{\rho}{\rho_o}\boldsymbol{\nabla}_z \Phi + \frac{1}{\rho_o} \boldsymbol{\nabla}_z p &= \boldsymbol{\nabla} \cdotp \boldsymbol{\underline{\tau}} ,\\ \rho \partial_z \Phi + \partial_z p &= 0 ,\\ \boldsymbol{\nabla}_z \cdotp \boldsymbol{u} + \partial_z w &= 0 ,\\ \partial_t \theta + \boldsymbol{\nabla}_z \cdotp ( \boldsymbol{u} \theta ) + \partial_z ( w \theta ) &= \boldsymbol{\nabla} \cdotp \boldsymbol{Q}_\theta ,\\ diff --git a/docs/equations/notation.rst b/docs/equations/notation.rst index 6a1337b2a4..17e320c131 100644 --- a/docs/equations/notation.rst +++ b/docs/equations/notation.rst @@ -35,7 +35,7 @@ component of velocity normal to the vertical. The gradient operator without a suffix is three dimensional: .. math:: - \boldsymbol{\nabla} = ( \boldsymbol{\nabla}_z, \boldsymbol{\nabla}_z ) . + \boldsymbol{\nabla} = ( \boldsymbol{\nabla}_z, \partial_z ) . but a suffix indicates a lateral gradient along a surface of constant property indicated by the suffix: From f9f0327f8fec3eba6ac81157134336f37bb69c82 Mon Sep 17 00:00:00 2001 From: Navid Constantinou Date: Tue, 19 Mar 2019 08:39:09 +1100 Subject: [PATCH 1032/1072] undo changes in MOM_hor_visc.F90 doc --- .../lateral/MOM_hor_visc.F90 | 22 +++++++++---------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 370cd4faaa..a980704d21 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1709,7 +1709,7 @@ end subroutine hor_visc_end !! !! In general, the horizontal stress tensor can be written as !! \f[ -!! \boldsymbol{\sigma} = +!! {\bf \sigma} = !! \begin{pmatrix} !! \frac{1}{2} \left( \sigma_D + \sigma_T \right) & \frac{1}{2} \sigma_S \\\\ !! \frac{1}{2} \sigma_S & \frac{1}{2} \left( \sigma_D - \sigma_T \right) @@ -1738,7 +1738,7 @@ end subroutine hor_visc_end !! calculations of the strain tensor in the code. Therefore the horizontal stress !! tensor can be considered to be !! \f[ -!! \boldsymbol{\sigma} = +!! {\bf \sigma} = !! \begin{pmatrix} !! \frac{1}{2} \sigma_T & \frac{1}{2} \sigma_S \\\\ !! \frac{1}{2} \sigma_S & - \frac{1}{2} \sigma_T @@ -1758,7 +1758,7 @@ end subroutine hor_visc_end !! !! The accelerations resulting form the divergence of the stress tensor are !! \f{eqnarray*}{ -!! \widehat{\boldsymbol x} \cdotp \left( \boldsymbol{\nabla}\cdotp \boldsymbol{\sigma} \right) +!! \hat{\bf x} \cdot \left( \nabla \cdot {\bf \sigma} \right) !! & = & !! \partial_x \left( \frac{1}{2} \sigma_T \right) !! + \partial_y \left( \frac{1}{2} \sigma_S \right) @@ -1767,7 +1767,7 @@ end subroutine hor_visc_end !! \partial_x \left( \kappa_h \dot{e}_T \right) !! + \partial_y \left( \kappa_h \dot{e}_S \right) !! \\\\ -!! \widehat{\boldsymbol y} \cdotp \left( \boldsymbol{\nabla}\cdotp \boldsymbol{\sigma} \right) +!! \hat{\bf y} \cdot \left( \nabla \cdot {\bf \sigma} \right) !! & = & !! \partial_x \left( \frac{1}{2} \sigma_S \right) !! + \partial_y \left( \frac{1}{2} \sigma_T \right) @@ -1780,12 +1780,12 @@ end subroutine hor_visc_end !! !! The form of the Laplacian viscosity in general coordinates is: !! \f{eqnarray*}{ -!! \widehat{\boldsymbol x} \cdotp \left( \boldsymbol{\nabla}\cdotp \sigma \right) +!! \hat{\bf x} \cdot \left( \nabla \cdot \sigma \right) !! & = & !! \frac{1}{h} \left[ \partial_x \left( \kappa_h h \dot{e}_T \right) !! + \partial_y \left( \kappa_h h \dot{e}_S \right) \right] !! \\\\ -!! \widehat{\boldsymbol y} \cdotp \left( \boldsymbol{\nabla}\cdotp \sigma \right) +!! \hat{\bf y} \cdot \left( \nabla \cdot \sigma \right) !! & = & !! \frac{1}{h} \left[ \partial_x \left( \kappa_h h \dot{e}_S \right) !! - \partial_y \left( \kappa_h h \dot{e}_T \right) \right] @@ -1805,7 +1805,7 @@ end subroutine hor_visc_end !! latitude, \f$\kappa_{\phi}(x,y) = \kappa_{\pi/2} |\sin(\phi)|^n\f$. !! - A dynamic Smagorinsky viscosity, \f$\kappa_{Sm}(x,y,t) = C_{Sm} \Delta^2 \sqrt{\dot{e}_T^2 + \dot{e}_S^2}\f$. !! - A dynamic Leith viscosity, \f$\kappa_{Lth}(x,y,t) = -!! C_{Lth} \Delta^3 \sqrt{|\boldsymbol{\nabla}\zeta|^2 + |\boldsymbol{\nabla}\dot{e}_D|^2}\f$. +!! C_{Lth} \Delta^3 \sqrt{|\nabla \zeta|^2 + |\nabla \dot{e}_D|^2}\f$. !! !! A maximum stable viscosity, \f$\kappa_{max}(x,y)\f$ is calculated based on the !! grid-spacing and time-step and used to clip calculated viscosities. @@ -1887,7 +1887,7 @@ end subroutine hor_visc_end !! \f$n_2 = 0\f$ and the cross terms vanish. The accelerations in this aligned limit !! with constant coefficients become !! \f{eqnarray*}{ -!! \widehat{\boldsymbol x} \cdotp \boldsymbol{\nabla}\cdotp \boldsymbol{\sigma} +!! \hat{\bf x} \cdot \nabla \cdot {\bf \sigma} !! & = & !! \partial_x \left( \left( \kappa_h + \frac{1}{2} \kappa_a \right) \dot{e}_T \right) !! + \partial_y \left( \kappa_h \dot{e}_S \right) @@ -1897,7 +1897,7 @@ end subroutine hor_visc_end !! + \kappa_h \partial_{yy} u !! - \frac{1}{2} \kappa_a \partial_x \left( \partial_x u + \partial_y v \right) !! \\\\ -!! \widehat{\boldsymbol y} \cdotp \boldsymbol{\nabla}\cdotp \boldsymbol{\sigma} +!! \hat{\bf y} \cdot \nabla \cdot {\bf \sigma} !! & = & !! \partial_x \left( \kappa_h \dot{e}_S \right) !! - \partial_y \left( \left( \kappa_h + \frac{1}{2} \kappa_a \right) \dot{e}_T \right) @@ -1947,7 +1947,7 @@ end subroutine hor_visc_end !! The tendency for the x-component of the divergence of stress is stored in !! variable diffu and discretized as !! \f[ -!! \widehat{\boldsymbol x} \cdotp \left( \boldsymbol{\nabla}\cdotp \boldsymbol{\sigma} \right) = +!! \hat{\bf x} \cdot \left( \nabla \cdot {\bf \sigma} \right) = !! \frac{1}{A \overline{h}^i} \left( !! \frac{1}{\Delta y} \delta_i \left( h \Delta y^2 \kappa_h \dot{e}_T \right) + !! \frac{1}{\Delta x} \delta_j \left( \tilde{h}^{ij} \Delta x^2 \kappa_h \dot{e}_S \right) @@ -1958,7 +1958,7 @@ end subroutine hor_visc_end !! The tendency for the y-component of the divergence of stress is stored in !! variable diffv and discretized as !! \f[ -!! \widehat{\boldsymbol y} \cdotp \left( \boldsymbol{\nabla}\cdotp \boldsymbol{\sigma} \right) = +!! \hat{\bf y} \cdot \left( \nabla \cdot {\bf \sigma} \right) = !! \frac{1}{A \overline{h}^j} \left( !! \frac{1}{\Delta y} \delta_i \left( \tilde{h}^{ij} \Delta y^2 A_M \dot{e}_S \right) !! - \frac{1}{\Delta x} \delta_j \left( h \Delta x^2 A_M \dot{e}_T \right) From 347eb0b545fccda3805e1e2dc89480bc684e6004 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 20 Mar 2019 14:17:22 -0600 Subject: [PATCH 1033/1072] Remove left spaces and add implicit none; private --- config_src/nuopc_driver/mom_cap.F90 | 3933 +++++++++---------- config_src/nuopc_driver/mom_cap_methods.F90 | 1697 ++++---- config_src/nuopc_driver/mom_cap_time.F90 | 791 ++-- config_src/nuopc_driver/time_utils.F90 | 305 +- 4 files changed, 3361 insertions(+), 3365 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index f465cb9183..7ac1f18e2b 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -308,2098 +308,2097 @@ !! !! module mom_cap_mod - use constants_mod, only: constants_init - use diag_manager_mod, only: diag_manager_init, diag_manager_end - use field_manager_mod, only: field_manager_init, field_manager_end - use fms_mod, only: fms_init, fms_end, open_namelist_file, check_nml_error - use fms_mod, only: close_file, file_exist, uppercase - use fms_io_mod, only: fms_io_exit - use mpp_domains_mod, only: domain2d, mpp_get_compute_domain, mpp_get_compute_domains - use mpp_domains_mod, only: mpp_get_ntile_count, mpp_get_pelist, mpp_get_global_domain - use mpp_domains_mod, only: mpp_get_domain_npes - use mpp_io_mod, only: mpp_open, MPP_RDONLY, MPP_ASCII, MPP_OVERWR, MPP_APPEND, mpp_close, MPP_SINGLE - use mpp_mod, only: input_nml_file, mpp_error, FATAL, NOTE, mpp_pe, mpp_npes, mpp_set_current_pelist - use mpp_mod, only: stdlog, stdout, mpp_root_pe, mpp_clock_id - use mpp_mod, only: mpp_clock_begin, mpp_clock_end, MPP_CLOCK_SYNC - use mpp_mod, only: MPP_CLOCK_DETAILED, CLOCK_COMPONENT, MAXPES - use time_interp_external_mod, only: time_interp_external_init - use time_manager_mod, only: set_calendar_type, time_type, increment_date - use time_manager_mod, only: set_time, set_date, get_time, get_date, month_name - use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR - use time_manager_mod, only: operator( <= ), operator( < ), operator( >= ) - use time_manager_mod, only: operator( + ), operator( - ), operator( / ) - use time_manager_mod, only: operator( * ), operator( /= ), operator( > ) - use time_manager_mod, only: date_to_string - use time_manager_mod, only: fms_get_calendar_type => get_calendar_type - use MOM_domains, only: MOM_infra_init, num_pes, root_pe, pe_here - use MOM_file_parser, only: get_param, log_version, param_file_type, close_param_file - use MOM_get_input, only: Get_MOM_Input, directories - use MOM_domains, only: pass_var - use MOM_error_handler, only: is_root_pe - use MOM_ocean_model, only: ice_ocean_boundary_type - use MOM_grid, only: ocean_grid_type, get_global_grid_size - use MOM_ocean_model, only: ocean_model_restart, ocean_public_type, ocean_state_type - use MOM_ocean_model, only: ocean_model_init_sfc - use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid - use mom_cap_time, only: AlarmInit - use mom_cap_methods, only: mom_import, mom_export, mom_set_geomtype +use constants_mod, only: constants_init +use diag_manager_mod, only: diag_manager_init, diag_manager_end +use field_manager_mod, only: field_manager_init, field_manager_end +use fms_mod, only: fms_init, fms_end, open_namelist_file, check_nml_error +use fms_mod, only: close_file, file_exist, uppercase +use fms_io_mod, only: fms_io_exit +use mpp_domains_mod, only: domain2d, mpp_get_compute_domain, mpp_get_compute_domains +use mpp_domains_mod, only: mpp_get_ntile_count, mpp_get_pelist, mpp_get_global_domain +use mpp_domains_mod, only: mpp_get_domain_npes +use mpp_io_mod, only: mpp_open, MPP_RDONLY, MPP_ASCII, MPP_OVERWR, MPP_APPEND, mpp_close, MPP_SINGLE +use mpp_mod, only: input_nml_file, mpp_error, FATAL, NOTE, mpp_pe, mpp_npes, mpp_set_current_pelist +use mpp_mod, only: stdlog, stdout, mpp_root_pe, mpp_clock_id +use mpp_mod, only: mpp_clock_begin, mpp_clock_end, MPP_CLOCK_SYNC +use mpp_mod, only: MPP_CLOCK_DETAILED, CLOCK_COMPONENT, MAXPES +use time_interp_external_mod, only: time_interp_external_init +use time_manager_mod, only: set_calendar_type, time_type, increment_date +use time_manager_mod, only: set_time, set_date, get_time, get_date, month_name +use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR +use time_manager_mod, only: operator( <= ), operator( < ), operator( >= ) +use time_manager_mod, only: operator( + ), operator( - ), operator( / ) +use time_manager_mod, only: operator( * ), operator( /= ), operator( > ) +use time_manager_mod, only: date_to_string +use time_manager_mod, only: fms_get_calendar_type => get_calendar_type +use MOM_domains, only: MOM_infra_init, num_pes, root_pe, pe_here +use MOM_file_parser, only: get_param, log_version, param_file_type, close_param_file +use MOM_get_input, only: Get_MOM_Input, directories +use MOM_domains, only: pass_var +use MOM_error_handler, only: is_root_pe +use MOM_ocean_model, only: ice_ocean_boundary_type +use MOM_grid, only: ocean_grid_type, get_global_grid_size +use MOM_ocean_model, only: ocean_model_restart, ocean_public_type, ocean_state_type +use MOM_ocean_model, only: ocean_model_init_sfc +use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid +use mom_cap_time, only: AlarmInit +use mom_cap_methods, only: mom_import, mom_export, mom_set_geomtype #ifdef CESMCOUPLED - use shr_file_mod, only: shr_file_setLogUnit, shr_file_getLogUnit +use shr_file_mod, only: shr_file_setLogUnit, shr_file_getLogUnit #endif - use time_utils_mod, only: esmf2fms_time - - use, intrinsic :: iso_fortran_env, only: output_unit - - use ESMF - use NUOPC - use NUOPC_Model, & - model_routine_SS => SetServices, & - model_label_Advance => label_Advance, & - model_label_DataInitialize => label_DataInitialize, & - model_label_SetRunClock => label_SetRunClock, & - model_label_Finalize => label_Finalize - - implicit none - private - - public SetServices - - type ocean_internalstate_type - type(ocean_public_type), pointer :: ocean_public_type_ptr - type(ocean_state_type), pointer :: ocean_state_type_ptr - type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr - end type - - type ocean_internalstate_wrapper - type(ocean_internalstate_type), pointer :: ptr - end type - - type fld_list_type - character(len=64) :: stdname - character(len=64) :: shortname - character(len=64) :: transferOffer - end type fld_list_type - - integer,parameter :: fldsMax = 100 - integer :: fldsToOcn_num = 0 - type (fld_list_type) :: fldsToOcn(fldsMax) - integer :: fldsFrOcn_num = 0 - type (fld_list_type) :: fldsFrOcn(fldsMax) - - integer :: debug = 0 - integer :: import_slice = 1 - integer :: export_slice = 1 - character(len=256) :: tmpstr - logical :: write_diagnostics = .false. - character(len=32) :: runtype ! run type - integer :: logunit ! stdout logging unit number - logical :: profile_memory = .true. - logical :: grid_attach_area = .false. - character(len=128) :: scalar_field_name = '' - integer :: scalar_field_count = 0 - integer :: scalar_field_idx_grid_nx = 0 - integer :: scalar_field_idx_grid_ny = 0 - character(len=*),parameter :: u_file_u = & - __FILE__ +use time_utils_mod, only: esmf2fms_time + +use, intrinsic :: iso_fortran_env, only: output_unit + +use ESMF +use NUOPC +use NUOPC_Model, & + model_routine_SS => SetServices, & + model_label_Advance => label_Advance, & + model_label_DataInitialize => label_DataInitialize, & + model_label_SetRunClock => label_SetRunClock, & + model_label_Finalize => label_Finalize + +implicit none; private + +public SetServices + +type ocean_internalstate_type + type(ocean_public_type), pointer :: ocean_public_type_ptr + type(ocean_state_type), pointer :: ocean_state_type_ptr + type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr +end type + +type ocean_internalstate_wrapper + type(ocean_internalstate_type), pointer :: ptr +end type + +type fld_list_type + character(len=64) :: stdname + character(len=64) :: shortname + character(len=64) :: transferOffer +end type fld_list_type + +integer,parameter :: fldsMax = 100 +integer :: fldsToOcn_num = 0 +type (fld_list_type) :: fldsToOcn(fldsMax) +integer :: fldsFrOcn_num = 0 +type (fld_list_type) :: fldsFrOcn(fldsMax) + +integer :: debug = 0 +integer :: import_slice = 1 +integer :: export_slice = 1 +character(len=256) :: tmpstr +logical :: write_diagnostics = .false. +character(len=32) :: runtype ! run type +integer :: logunit ! stdout logging unit number +logical :: profile_memory = .true. +logical :: grid_attach_area = .false. +character(len=128) :: scalar_field_name = '' +integer :: scalar_field_count = 0 +integer :: scalar_field_idx_grid_nx = 0 +integer :: scalar_field_idx_grid_ny = 0 +character(len=*),parameter :: u_file_u = & + __FILE__ #ifdef CESMCOUPLED - logical :: cesm_coupled = .true. - type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_MESH +logical :: cesm_coupled = .true. +type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_MESH #else - logical :: cesm_coupled = .false. - type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID +logical :: cesm_coupled = .false. +type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID #endif !======================================================================= contains !======================================================================= - !=============================================================================== - !> NUOPC SetService method is the only public entry point. - !! SetServices registers all of the user-provided subroutines - !! in the module with the NUOPC layer. - !! - !! @param gcomp an ESMF_GridComp object - !! @param rc return code - subroutine SetServices(gcomp, rc) - - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - character(len=*),parameter :: subname='(mom_cap:SetServices)' - - rc = ESMF_SUCCESS - - ! the NUOPC model component will register the generic methods - call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! switching to IPD versions - call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - userRoutine=InitializeP0, phase=0, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! set entry point for methods that require specific implementation - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p1"/), userRoutine=InitializeAdvertise, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p3"/), userRoutine=InitializeRealize, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !------------------ - ! attach specializing method(s) - !------------------ - - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_DataInitialize, & - specRoutine=DataInitialize, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & - specRoutine=ModelAdvance, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, & - specRoutine=ModelSetRunClock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & - specRoutine=ocean_model_finalize, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end subroutine SetServices - - !=============================================================================== - - !> First initialize subroutine called by NUOPC. The purpose - !! is to set which version of the Initialize Phase Definition (IPD) - !! to use. - !! - !! For this MOM cap, we are using IPDv01. - !! - !! @param gcomp an ESMF_GridComp object - !! @param importState an ESMF_State object for import fields - !! @param exportState an ESMF_State object for export fields - !! @param clock an ESMF_Clock object - !! @param rc return code - subroutine InitializeP0(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - logical :: isPresent, isSet - integer :: iostat - character(len=64) :: value, logmsg - character(len=*),parameter :: subname='(mom_cap:InitializeP0)' - - rc = ESMF_SUCCESS +!=============================================================================== +!> NUOPC SetService method is the only public entry point. +!! SetServices registers all of the user-provided subroutines +!! in the module with the NUOPC layer. +!! +!! @param gcomp an ESMF_GridComp object +!! @param rc return code +subroutine SetServices(gcomp, rc) + + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + character(len=*),parameter :: subname='(mom_cap:SetServices)' + + rc = ESMF_SUCCESS + + ! the NUOPC model component will register the generic methods + call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! switching to IPD versions + call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + userRoutine=InitializeP0, phase=0, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! set entry point for methods that require specific implementation + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv03p1"/), userRoutine=InitializeAdvertise, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv03p3"/), userRoutine=InitializeRealize, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !------------------ + ! attach specializing method(s) + !------------------ + + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_DataInitialize, & + specRoutine=DataInitialize, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & + specRoutine=ModelAdvance, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, & + specRoutine=ModelSetRunClock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & + specRoutine=ocean_model_finalize, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + +end subroutine SetServices - ! Switch to IPDv03 by filtering all other phaseMap entries - call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, & - acceptStringList=(/"IPDv03p"/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return +!=============================================================================== - write_diagnostics = .false. - call NUOPC_CompAttributeGet(gcomp, name="DumpFields", value=value, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - if (isPresent .and. isSet) write_diagnostics=(trim(value)=="true") +!> First initialize subroutine called by NUOPC. The purpose +!! is to set which version of the Initialize Phase Definition (IPD) +!! to use. +!! +!! For this MOM cap, we are using IPDv01. +!! +!! @param gcomp an ESMF_GridComp object +!! @param importState an ESMF_State object for import fields +!! @param exportState an ESMF_State object for export fields +!! @param clock an ESMF_Clock object +!! @param rc return code +subroutine InitializeP0(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + logical :: isPresent, isSet + integer :: iostat + character(len=64) :: value, logmsg + character(len=*),parameter :: subname='(mom_cap:InitializeP0)' + + rc = ESMF_SUCCESS + + ! Switch to IPDv03 by filtering all other phaseMap entries + call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, & + acceptStringList=(/"IPDv03p"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return - write(logmsg,*) write_diagnostics - call ESMF_LogWrite('mom_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + write_diagnostics = .false. + call NUOPC_CompAttributeGet(gcomp, name="DumpFields", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) write_diagnostics=(trim(value)=="true") - profile_memory = .false. - call NUOPC_CompAttributeGet(gcomp, name="ProfileMemory", value=value, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - if (isPresent .and. isSet) profile_memory=(trim(value)=="true") - write(logmsg,*) profile_memory - call ESMF_LogWrite('mom_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + write(logmsg,*) write_diagnostics + call ESMF_LogWrite('mom_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return - grid_attach_area = .false. - call NUOPC_CompAttributeGet(gcomp, name="GridAttachArea", value=value, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - if (isPresent .and. isSet) grid_attach_area=(trim(value)=="true") - write(logmsg,*) grid_attach_area - call ESMF_LogWrite('mom_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + profile_memory = .false. + call NUOPC_CompAttributeGet(gcomp, name="ProfileMemory", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) profile_memory=(trim(value)=="true") + write(logmsg,*) profile_memory + call ESMF_LogWrite('mom_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return - scalar_field_name = "" - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=value, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - if (isPresent .and. isSet) then - scalar_field_name = trim(value) - call ESMF_LogWrite('mom_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - endif + grid_attach_area = .false. + call NUOPC_CompAttributeGet(gcomp, name="GridAttachArea", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) grid_attach_area=(trim(value)=="true") + write(logmsg,*) grid_attach_area + call ESMF_LogWrite('mom_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return - scalar_field_count = 0 - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=value, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - if (isPresent .and. isSet) then - read(value, '(i)', iostat=iostat) scalar_field_count - if (iostat /= 0) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": ScalarFieldCount not an integer: "//trim(value), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - write(logmsg,*) scalar_field_count - call ESMF_LogWrite('mom_cap:ScalarFieldCount = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - endif + scalar_field_name = "" + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + scalar_field_name = trim(value) + call ESMF_LogWrite('mom_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + + scalar_field_count = 0 + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + read(value, '(i)', iostat=iostat) scalar_field_count + if (iostat /= 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ScalarFieldCount not an integer: "//trim(value), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + write(logmsg,*) scalar_field_count + call ESMF_LogWrite('mom_cap:ScalarFieldCount = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + + scalar_field_idx_grid_nx = 0 + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + read(value, '(i)', iostat=iostat) scalar_field_idx_grid_nx + if (iostat /= 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ScalarFieldIdxGridNX not an integer: "//trim(value), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + write(logmsg,*) scalar_field_idx_grid_nx + call ESMF_LogWrite('mom_cap:ScalarFieldIdxGridNX = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + + scalar_field_idx_grid_ny = 0 + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny + if (iostat /= 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ScalarFieldIdxGridNY not an integer: "//trim(value), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + write(logmsg,*) scalar_field_idx_grid_ny + call ESMF_LogWrite('mom_cap:ScalarFieldIdxGridNY = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + + call NUOPC_CompAttributeAdd(gcomp, & + attrList=(/'RestartFileToRead', 'RestartFileToWrite'/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return - scalar_field_idx_grid_nx = 0 - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=value, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - if (isPresent .and. isSet) then - read(value, '(i)', iostat=iostat) scalar_field_idx_grid_nx - if (iostat /= 0) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": ScalarFieldIdxGridNX not an integer: "//trim(value), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - write(logmsg,*) scalar_field_idx_grid_nx - call ESMF_LogWrite('mom_cap:ScalarFieldIdxGridNX = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - endif +end subroutine - scalar_field_idx_grid_ny = 0 - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=value, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - if (isPresent .and. isSet) then - read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny - if (iostat /= 0) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": ScalarFieldIdxGridNY not an integer: "//trim(value), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - write(logmsg,*) scalar_field_idx_grid_ny - call ESMF_LogWrite('mom_cap:ScalarFieldIdxGridNY = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - endif +!=============================================================================== - call NUOPC_CompAttributeAdd(gcomp, & - attrList=(/'RestartFileToRead', 'RestartFileToWrite'/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - - end subroutine - - !=============================================================================== - - !> Called by NUOPC to advertise import and export fields. "Advertise" - !! simply means that the standard names of all import and export - !! fields are supplied. The NUOPC layer uses these to match fields - !! between components in the coupled system. - !! - !! @param gcomp an ESMF_GridComp object - !! @param importState an ESMF_State object for import fields - !! @param exportState an ESMF_State object for export fields - !! @param clock an ESMF_Clock object - !! @param rc return code - subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - type(ESMF_VM) :: vm - type(ESMF_Time) :: MyTime - type(ESMF_TimeInterval) :: TINT - type (ocean_public_type), pointer :: ocean_public => NULL() - type (ocean_state_type), pointer :: ocean_state => NULL() - type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() - type(ocean_internalstate_wrapper) :: ocean_internalstate - type(ocean_grid_type), pointer :: ocean_grid => NULL() - type(time_type) :: Run_len ! length of experiment - type(time_type) :: Time - type(time_type) :: Time_restart - type(time_type) :: DT - integer :: DT_OCEAN - integer :: isc,iec,jsc,jec - integer :: year=0, month=0, day=0, hour=0, minute=0, second=0 - integer :: mpi_comm_mom - integer :: i,n - character(len=256) :: stdname, shortname - character(len=32) :: starttype ! model start type - character(len=512) :: diro - character(len=512) :: logfile - character(ESMF_MAXSTR) :: cvalue - logical :: isPresent, isPresentDiro, isPresentLogfile, isSet - logical :: existflag - integer :: userRc - character(len=512) :: restartfile ! Path/Name of restart file - character(len=*), parameter :: subname='(mom_cap:InitializeAdvertise)' +!> Called by NUOPC to advertise import and export fields. "Advertise" +!! simply means that the standard names of all import and export +!! fields are supplied. The NUOPC layer uses these to match fields +!! between components in the coupled system. +!! +!! @param gcomp an ESMF_GridComp object +!! @param importState an ESMF_State object for import fields +!! @param exportState an ESMF_State object for export fields +!! @param clock an ESMF_Clock object +!! @param rc return code +subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + type(ESMF_VM) :: vm + type(ESMF_Time) :: MyTime + type(ESMF_TimeInterval) :: TINT + type (ocean_public_type), pointer :: ocean_public => NULL() + type (ocean_state_type), pointer :: ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + type(ocean_grid_type), pointer :: ocean_grid => NULL() + type(time_type) :: Run_len ! length of experiment + type(time_type) :: Time + type(time_type) :: Time_restart + type(time_type) :: DT + integer :: DT_OCEAN + integer :: isc,iec,jsc,jec + integer :: year=0, month=0, day=0, hour=0, minute=0, second=0 + integer :: mpi_comm_mom + integer :: i,n + character(len=256) :: stdname, shortname + character(len=32) :: starttype ! model start type + character(len=512) :: diro + character(len=512) :: logfile + character(ESMF_MAXSTR) :: cvalue + logical :: isPresent, isPresentDiro, isPresentLogfile, isSet + logical :: existflag + integer :: userRc + character(len=512) :: restartfile ! Path/Name of restart file + character(len=*), parameter :: subname='(mom_cap:InitializeAdvertise)' !-------------------------------- - rc = ESMF_SUCCESS + rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' enter', ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - - allocate(Ice_ocean_boundary) - !allocate(ocean_state) ! ocean_model_init allocate this pointer - allocate(ocean_public) - allocate(ocean_internalstate%ptr) - ocean_internalstate%ptr%ice_ocean_boundary_type_ptr => Ice_ocean_boundary - ocean_internalstate%ptr%ocean_public_type_ptr => ocean_public - ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state - - call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_VMGet(VM, mpiCommunicator=mpi_comm_mom, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_ClockGet(CLOCK, currTIME=MyTime, TimeStep=TINT, RC=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_TimeGet (MyTime, YY=YEAR, MM=MONTH, DD=DAY, H=HOUR, M=MINUTE, S=SECOND, RC=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - CALL ESMF_TimeIntervalGet(TINT, S=DT_OCEAN, RC=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call fms_init(mpi_comm_mom) - call constants_init - call field_manager_init - call set_calendar_type (JULIAN) - call diag_manager_init - - ! this ocean connector will be driven at set interval - DT = set_time (DT_OCEAN, 0) - Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) - - ! rsd need to figure out how to get this without share code - !call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - !inst_name = "OCN"//trim(inst_suffix) - - ! reset shr logging to my log file - if (is_root_pe()) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & - isPresent=isPresentDiro, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, & - isPresent=isPresentLogfile, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - if (isPresentDiro .and. isPresentLogfile) then - open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) - else - logunit = output_unit - endif - else - logunit = output_unit - endif - - starttype = "" - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - if (isPresent .and. isSet) then - read(cvalue,*) starttype - else - call ESMF_LogWrite('mom_cap:start_type unset - using input.nml for restart option', & - ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - endif - - runtype = "" - if (trim(starttype) == trim('startup')) then - runtype = "initial" - else if (trim(starttype) == trim('continue') ) then - runtype = "continue" - else if (trim(starttype) == trim('branch')) then - runtype = "continue" - else if (len_trim(starttype) > 0) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": unknown starttype - "//trim(starttype), & - line=__LINE__, file=__FILE__, rcToReturn=rc) + call ESMF_LogWrite(subname//' enter', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & return - endif - if (len_trim(runtype) > 0) then - call ESMF_LogWrite('mom_cap:startup = '//trim(runtype), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - endif - - restartfile = "" - if (runtype == "initial") then - ! startup (new run) - 'n' is needed below if we don't specify input_filename in input.nml - restartfile = "n" - else if (runtype == "continue") then ! hybrid or branch or continuos runs - - ! optionally call into system-specific implementation to get restart file name - call ESMF_MethodExecute(gcomp, label="GetRestartFileToRead", & - existflag=existflag, userRc=userRc, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg="Error executing user method to get restart filename", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (ESMF_LogFoundError(rcToCheck=userRc, msg="Error in method to get restart filename", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (existflag) then - call ESMF_LogWrite('mom_cap: called user GetRestartFileToRead', ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - endif - - call NUOPC_CompAttributeGet(gcomp, name='RestartFileToRead', & - value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - if (isPresent .and. isSet) then - restartfile = trim(cvalue) - call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - else - call ESMF_LogWrite('mom_cap: restart requested, no RestartFileToRead attribute provided-will use input.nml',& - ESMF_LOGMSG_WARNING, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - endif - - end if - - ocean_public%is_ocean_pe = .true. - if (len_trim(restartfile) > 0) then - call ocean_model_init(ocean_public, ocean_state, Time, Time, input_restart_file=trim(restartfile)) - else - call ocean_model_init(ocean_public, ocean_state, Time, Time) - endif - - call ocean_model_init_sfc(ocean_state, ocean_public) - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - - allocate ( Ice_ocean_boundary% u_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% v_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% t_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% q_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% salt_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% lw_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_vis_dir (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_vis_dif (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_nir_dir (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_nir_dif (isc:iec,jsc:jec), & - Ice_ocean_boundary% lprec (isc:iec,jsc:jec), & - Ice_ocean_boundary% fprec (isc:iec,jsc:jec), & - Ice_ocean_boundary% mi (isc:iec,jsc:jec), & - Ice_ocean_boundary% p (isc:iec,jsc:jec), & - Ice_ocean_boundary% runoff (isc:iec,jsc:jec), & - Ice_ocean_boundary% calving (isc:iec,jsc:jec), & - Ice_ocean_boundary% runoff_hflx (isc:iec,jsc:jec), & - Ice_ocean_boundary% calving_hflx (isc:iec,jsc:jec), & - Ice_ocean_boundary% rofl_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% rofi_flux (isc:iec,jsc:jec)) - - Ice_ocean_boundary%u_flux = 0.0 - Ice_ocean_boundary%v_flux = 0.0 - Ice_ocean_boundary%t_flux = 0.0 - Ice_ocean_boundary%q_flux = 0.0 - Ice_ocean_boundary%salt_flux = 0.0 - Ice_ocean_boundary%lw_flux = 0.0 - Ice_ocean_boundary%sw_flux_vis_dir = 0.0 - Ice_ocean_boundary%sw_flux_vis_dif = 0.0 - Ice_ocean_boundary%sw_flux_nir_dir = 0.0 - Ice_ocean_boundary%sw_flux_nir_dif = 0.0 - Ice_ocean_boundary%lprec = 0.0 - Ice_ocean_boundary%fprec = 0.0 - Ice_ocean_boundary%mi = 0.0 - Ice_ocean_boundary%p = 0.0 - Ice_ocean_boundary%runoff = 0.0 - Ice_ocean_boundary%calving = 0.0 - Ice_ocean_boundary%runoff_hflx = 0.0 - Ice_ocean_boundary%calving_hflx = 0.0 - Ice_ocean_boundary%rofl_flux = 0.0 - Ice_ocean_boundary%rofi_flux = 0.0 - - ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state - call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) + allocate(Ice_ocean_boundary) + !allocate(ocean_state) ! ocean_model_init allocate this pointer + allocate(ocean_public) + allocate(ocean_internalstate%ptr) + ocean_internalstate%ptr%ice_ocean_boundary_type_ptr => Ice_ocean_boundary + ocean_internalstate%ptr%ocean_public_type_ptr => ocean_public + ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_VMGet(VM, mpiCommunicator=mpi_comm_mom, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(CLOCK, currTIME=MyTime, TimeStep=TINT, RC=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_TimeGet (MyTime, YY=YEAR, MM=MONTH, DD=DAY, H=HOUR, M=MINUTE, S=SECOND, RC=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + CALL ESMF_TimeIntervalGet(TINT, S=DT_OCEAN, RC=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call fms_init(mpi_comm_mom) + call constants_init + call field_manager_init + call set_calendar_type (JULIAN) + call diag_manager_init + + ! this ocean connector will be driven at set interval + DT = set_time (DT_OCEAN, 0) + Time = set_date (YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) + + ! rsd need to figure out how to get this without share code + !call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) + !inst_name = "OCN"//trim(inst_suffix) + + ! reset shr logging to my log file + if (is_root_pe()) then + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & + isPresent=isPresentDiro, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, & + isPresent=isPresentLogfile, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresentDiro .and. isPresentLogfile) then + open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) + else + logunit = output_unit + endif + else + logunit = output_unit + endif + + starttype = "" + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + read(cvalue,*) starttype + else + call ESMF_LogWrite('mom_cap:start_type unset - using input.nml for restart option', & + ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + + runtype = "" + if (trim(starttype) == trim('startup')) then + runtype = "initial" + else if (trim(starttype) == trim('continue') ) then + runtype = "continue" + else if (trim(starttype) == trim('branch')) then + runtype = "continue" + else if (len_trim(starttype) > 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": unknown starttype - "//trim(starttype), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + + if (len_trim(runtype) > 0) then + call ESMF_LogWrite('mom_cap:startup = '//trim(runtype), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + + restartfile = "" + if (runtype == "initial") then + ! startup (new run) - 'n' is needed below if we don't specify input_filename in input.nml + restartfile = "n" + else if (runtype == "continue") then ! hybrid or branch or continuos runs + + ! optionally call into system-specific implementation to get restart file name + call ESMF_MethodExecute(gcomp, label="GetRestartFileToRead", & + existflag=existflag, userRc=userRc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg="Error executing user method to get restart filename", & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (ESMF_LogFoundError(rcToCheck=userRc, msg="Error in method to get restart filename", & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (existflag) then + call ESMF_LogWrite('mom_cap: called user GetRestartFileToRead', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + + call NUOPC_CompAttributeGet(gcomp, name='RestartFileToRead', & + value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (isPresent .and. isSet) then + restartfile = trim(cvalue) + call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + else + call ESMF_LogWrite('mom_cap: restart requested, no RestartFileToRead attribute provided-will use input.nml',& + ESMF_LOGMSG_WARNING, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif + + end if + + ocean_public%is_ocean_pe = .true. + if (len_trim(restartfile) > 0) then + call ocean_model_init(ocean_public, ocean_state, Time, Time, input_restart_file=trim(restartfile)) + else + call ocean_model_init(ocean_public, ocean_state, Time, Time) + endif + + call ocean_model_init_sfc(ocean_state, ocean_public) + + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + + allocate ( Ice_ocean_boundary% u_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% v_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% t_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% q_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% salt_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% lw_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_vis_dir (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_vis_dif (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_nir_dir (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_nir_dif (isc:iec,jsc:jec), & + Ice_ocean_boundary% lprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% fprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% mi (isc:iec,jsc:jec), & + Ice_ocean_boundary% p (isc:iec,jsc:jec), & + Ice_ocean_boundary% runoff (isc:iec,jsc:jec), & + Ice_ocean_boundary% calving (isc:iec,jsc:jec), & + Ice_ocean_boundary% runoff_hflx (isc:iec,jsc:jec), & + Ice_ocean_boundary% calving_hflx (isc:iec,jsc:jec), & + Ice_ocean_boundary% rofl_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% rofi_flux (isc:iec,jsc:jec)) + + Ice_ocean_boundary%u_flux = 0.0 + Ice_ocean_boundary%v_flux = 0.0 + Ice_ocean_boundary%t_flux = 0.0 + Ice_ocean_boundary%q_flux = 0.0 + Ice_ocean_boundary%salt_flux = 0.0 + Ice_ocean_boundary%lw_flux = 0.0 + Ice_ocean_boundary%sw_flux_vis_dir = 0.0 + Ice_ocean_boundary%sw_flux_vis_dif = 0.0 + Ice_ocean_boundary%sw_flux_nir_dir = 0.0 + Ice_ocean_boundary%sw_flux_nir_dif = 0.0 + Ice_ocean_boundary%lprec = 0.0 + Ice_ocean_boundary%fprec = 0.0 + Ice_ocean_boundary%mi = 0.0 + Ice_ocean_boundary%p = 0.0 + Ice_ocean_boundary%runoff = 0.0 + Ice_ocean_boundary%calving = 0.0 + Ice_ocean_boundary%runoff_hflx = 0.0 + Ice_ocean_boundary%calving_hflx = 0.0 + Ice_ocean_boundary%rofl_flux = 0.0 + Ice_ocean_boundary%rofi_flux = 0.0 + + ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state + call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (cesm_coupled) then + if (len_trim(scalar_field_name) > 0) then + call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide") + endif + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen" , "will provide") + else + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") + !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") + end if + + !--------- import fields ------------- + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide") ! from ice + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") !-> liquid runoff + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") !-> ice runoff + !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_water" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_heat" , "will provide") + + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") + + !--------- export fields ------------- + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") + + do n = 1,fldsToOcn_num + call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)%shortname, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + enddo - if (cesm_coupled) then - if (len_trim(scalar_field_name) > 0) then - call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide") - endif - !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_vstokes" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_hstokes" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_fswpen" , "will provide") - else - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") - !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") - end if - - !--------- import fields ------------- - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide") ! from ice - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") !-> liquid runoff - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") !-> ice runoff - !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_water" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "seaice_melt_heat" , "will provide") - - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") - - !--------- export fields ------------- - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") - - do n = 1,fldsToOcn_num - call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - enddo - - do n = 1,fldsFrOcn_num - call NUOPC_Advertise(exportState, standardName=fldsFrOcn(n)%stdname, name=fldsFrOcn(n)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - enddo - - end subroutine InitializeAdvertise - -!=============================================================================== - !> Called by NUOPC to realize import and export fields. "Realizing" a field - !! means that its grid has been defined and an ESMF_Field object has been - !! created and put into the import or export State. - !! - !! @param gcomp an ESMF_GridComp object - !! @param importState an ESMF_State object for import fields - !! @param exportState an ESMF_State object for export fields - !! @param clock an ESMF_Clock object - !! @param rc return code - - subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - ! Local Variables - type(ESMF_VM) :: vm - type(ESMF_Grid) :: gridIn, gridOut - type(ESMF_Mesh) :: Emesh, EmeshTemp - type(ESMF_DeLayout) :: delayout - type(ESMF_Distgrid) :: Distgrid - type(ESMF_DistGridConnection), allocatable :: connectionList(:) - type(ESMF_StateItem_Flag) :: itemFlag - type (ocean_public_type), pointer :: ocean_public => NULL() - type (ocean_state_type), pointer :: ocean_state => NULL() - type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() - type(ocean_grid_type) , pointer :: ocean_grid - type(ocean_internalstate_wrapper) :: ocean_internalstate - integer :: npet, ntiles - integer :: nxg, nyg, cnt - integer :: isc,iec,jsc,jec - integer, allocatable :: xb(:),xe(:),yb(:),ye(:),pe(:) - integer, allocatable :: deBlockList(:,:,:) - integer, allocatable :: petMap(:) - integer, allocatable :: deLabelList(:) - integer, allocatable :: indexList(:) - integer :: ioff, joff - integer :: i, j, n, i1, j1, n1, jlast - integer :: lbnd1,ubnd1,lbnd2,ubnd2 - integer :: lbnd3,ubnd3,lbnd4,ubnd4 - integer :: nblocks_tot - logical :: found - integer(ESMF_KIND_I4), pointer :: dataPtr_mask(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_area(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_xcen(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ycen(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_xcor(:,:) - real(ESMF_KIND_R8), pointer :: dataPtr_ycor(:,:) - integer :: mpicom - integer :: localPet - integer :: lsize - integer :: ig,jg, ni,nj,k - integer, allocatable :: gindex(:) ! global index space - character(len=128) :: fldname - character(len=256) :: cvalue - character(len=*), parameter :: subname='(mom_cap:InitializeRealize)' - !-------------------------------- - - rc = ESMF_SUCCESS - - call shr_file_setLogUnit (logunit) - - !---------------------------------------------------------------------------- - ! Get pointers to ocean internal state - !---------------------------------------------------------------------------- - - call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + do n = 1,fldsFrOcn_num + call NUOPC_Advertise(exportState, standardName=fldsFrOcn(n)%stdname, name=fldsFrOcn(n)%shortname, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + enddo - Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr - ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr - ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr +end subroutine InitializeAdvertise - !---------------------------------------------------------------------------- - ! Get mpi information - !---------------------------------------------------------------------------- - - call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_VMGet(vm, petCount=npet, mpiCommunicator=mpicom, localPet=localPet, rc=rc) +!=============================================================================== +!> Called by NUOPC to realize import and export fields. "Realizing" a field +!! means that its grid has been defined and an ESMF_Field object has been +!! created and put into the import or export State. +!! +!! @param gcomp an ESMF_GridComp object +!! @param importState an ESMF_State object for import fields +!! @param exportState an ESMF_State object for export fields +!! @param clock an ESMF_Clock object +!! @param rc return code + +subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! Local Variables + type(ESMF_VM) :: vm + type(ESMF_Grid) :: gridIn, gridOut + type(ESMF_Mesh) :: Emesh, EmeshTemp + type(ESMF_DeLayout) :: delayout + type(ESMF_Distgrid) :: Distgrid + type(ESMF_DistGridConnection), allocatable :: connectionList(:) + type(ESMF_StateItem_Flag) :: itemFlag + type (ocean_public_type), pointer :: ocean_public => NULL() + type (ocean_state_type), pointer :: ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_grid_type) , pointer :: ocean_grid + type(ocean_internalstate_wrapper) :: ocean_internalstate + integer :: npet, ntiles + integer :: nxg, nyg, cnt + integer :: isc,iec,jsc,jec + integer, allocatable :: xb(:),xe(:),yb(:),ye(:),pe(:) + integer, allocatable :: deBlockList(:,:,:) + integer, allocatable :: petMap(:) + integer, allocatable :: deLabelList(:) + integer, allocatable :: indexList(:) + integer :: ioff, joff + integer :: i, j, n, i1, j1, n1, jlast + integer :: lbnd1,ubnd1,lbnd2,ubnd2 + integer :: lbnd3,ubnd3,lbnd4,ubnd4 + integer :: nblocks_tot + logical :: found + integer(ESMF_KIND_I4), pointer :: dataPtr_mask(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_area(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_xcen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ycen(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_xcor(:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ycor(:,:) + integer :: mpicom + integer :: localPet + integer :: lsize + integer :: ig,jg, ni,nj,k + integer, allocatable :: gindex(:) ! global index space + character(len=128) :: fldname + character(len=256) :: cvalue + character(len=*), parameter :: subname='(mom_cap:InitializeRealize)' + !-------------------------------- + + rc = ESMF_SUCCESS + + call shr_file_setLogUnit (logunit) + + !---------------------------------------------------------------------------- + ! Get pointers to ocean internal state + !---------------------------------------------------------------------------- + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr + ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + + !---------------------------------------------------------------------------- + ! Get mpi information + !---------------------------------------------------------------------------- + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_VMGet(vm, petCount=npet, mpiCommunicator=mpicom, localPet=localPet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !--------------------------------- + ! global mom grid size + !--------------------------------- + + call mpp_get_global_domain(ocean_public%domain, xsize=nxg, ysize=nyg) + write(tmpstr,'(a,2i6)') subname//' nxg,nyg = ',nxg,nyg + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !--------------------------------- + ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total + !--------------------------------- + + ntiles=mpp_get_ntile_count(ocean_public%domain) ! this is tiles on this pe + if (ntiles /= 1) then + rc = ESMF_FAILURE + call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !--------------------------------- - ! global mom grid size - !--------------------------------- + line=__LINE__, & + file=__FILE__)) & + return + endif + ntiles=mpp_get_domain_npes(ocean_public%domain) + write(tmpstr,'(a,1i6)') subname//' ntiles = ',ntiles + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return - call mpp_get_global_domain(ocean_public%domain, xsize=nxg, ysize=nyg) - write(tmpstr,'(a,2i6)') subname//' nxg,nyg = ',nxg,nyg - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !--------------------------------- - ! number of tiles per PET, assumed to be 1, and number of pes (tiles) total - !--------------------------------- - - ntiles=mpp_get_ntile_count(ocean_public%domain) ! this is tiles on this pe - if (ntiles /= 1) then - rc = ESMF_FAILURE - call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - endif - ntiles=mpp_get_domain_npes(ocean_public%domain) - write(tmpstr,'(a,1i6)') subname//' ntiles = ',ntiles - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - - !--------------------------------- - ! get start and end indices of each tile and their PET - !--------------------------------- - - allocate(xb(ntiles),xe(ntiles),yb(ntiles),ye(ntiles),pe(ntiles)) - call mpp_get_compute_domains(ocean_public%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye) - call mpp_get_pelist(ocean_public%domain, pe) - if (debug > 0) then - do n = 1,ntiles - write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - enddo - end if - - !--------------------------------- - ! Create either a grid or a mesh - !--------------------------------- - - !Get the ocean grid and sizes of global and computational domains - call get_ocean_grid(ocean_state, ocean_grid) - - if (geomtype == ESMF_GEOMTYPE_MESH) then - - !--------------------------------- - ! Create a MOM6 mesh - !--------------------------------- - - call get_global_grid_size(ocean_grid, ni, nj) - lsize = ( ocean_grid%iec - ocean_grid%isc + 1 ) * ( ocean_grid%jec - ocean_grid%jsc + 1 ) - - ! Create the global index space for the computational domain - allocate(gindex(lsize)) - k = 0 - do j = ocean_grid%jsc, ocean_grid%jec - jg = j + ocean_grid%jdg_offset - do i = ocean_grid%isc, ocean_grid%iec - ig = i + ocean_grid%idg_offset - k = k + 1 ! Increment position within gindex - gindex(k) = ni * (jg - 1) + ig - enddo - enddo - - DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - - ! read in the mesh - call NUOPC_CompAttributeGet(gcomp, name='mesh_ocn', value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - - EMeshTemp = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - if (localPet == 0) then - write(logunit,*)'mesh file for mom6 domain is ',trim(cvalue) - end if - - ! recreate the mesh using the above distGrid - EMesh = ESMF_MeshCreate(EMeshTemp, elementDistgrid=Distgrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - - ! realize the import and export fields using the mesh - call MOM_RealizeFields(importState, fldsToOcn_num, fldsToOcn, "Ocn import", mesh=Emesh, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call MOM_RealizeFields(exportState, fldsFrOcn_num, fldsFrOcn, "Ocn export", mesh=Emesh, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - else if (geomtype == ESMF_GEOMTYPE_GRID) then - - !--------------------------------- - ! create a MOM6 grid - !--------------------------------- - - ! generate delayout and dist_grid - - allocate(deBlockList(2,2,ntiles)) - allocate(petMap(ntiles)) - allocate(deLabelList(ntiles)) - - do n = 1, ntiles - deLabelList(n) = n - deBlockList(1,1,n) = xb(n) - deBlockList(1,2,n) = xe(n) - deBlockList(2,1,n) = yb(n) - deBlockList(2,2,n) = ye(n) - petMap(n) = pe(n) - ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side - enddo - - delayout = ESMF_DELayoutCreate(petMap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! rsd this assumes tripole grid, but sometimes in CESM a bipole - ! grid is used -- need to introduce conditional logic here - - allocate(connectionList(2)) - - ! bipolar boundary condition at top row: nyg - call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & - tileIndexB=1, positionVector=(/nxg+1, 2*nyg+1/), & - orientationVector=(/-1, -2/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! periodic boundary condition along first dimension - call ESMF_DistGridConnectionSet(connectionList(2), tileIndexA=1, & - tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nxg,nyg/), & - ! indexflag = ESMF_INDEX_DELOCAL, & - deBlockList=deBlockList, & - ! deLabelList=deLabelList, & - delayout=delayout, & - connectionList=connectionList, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - deallocate(xb,xe,yb,ye,pe) - deallocate(connectionList) - deallocate(deLabelList) - deallocate(deBlockList) - deallocate(petMap) - - call ESMF_DistGridGet(distgrid=distgrid, localDE=0, elementCount=cnt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - allocate(indexList(cnt)) - write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - write(tmpstr,'(a,4i8)') subname//' distgrid list= ',& - indexList(1),indexList(cnt),minval(indexList), maxval(indexList) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - deallocate(IndexList) - - ! create grid - - gridIn = ESMF_GridCreate(distgrid=distgrid, & - gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & - coordSys = ESMF_COORDSYS_SPH_DEG, & - rc = rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! Attach area to the Grid optionally. By default the cell areas are computed. - if(grid_attach_area) then - call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - call ESMF_GridGetCoord(gridIn, coordDim=1, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_xcen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridGetCoord(gridIn, coordDim=2, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_ycen, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_GridGetCoord(gridIn, coordDim=1, & - staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=dataPtr_xcor, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_GridGetCoord(gridIn, coordDim=2, & - staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=dataPtr_ycor, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_MASK, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_mask, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if(grid_attach_area) then - call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_area, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - ! load up area, mask, center and corner values - ! area, mask, and centers should be same size in mom and esmf grid - ! corner points may not be, need to offset corner points by 1 in i and j - ! retrieve these values directly from ocean_grid, which contains halo - ! values for j=0 and wrap-around in i. on tripole seam, decomposition - ! domains are 1 larger in j; to load corner values need to loop one extra row - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - - lbnd1 = lbound(dataPtr_mask,1) - ubnd1 = ubound(dataPtr_mask,1) - lbnd2 = lbound(dataPtr_mask,2) - ubnd2 = ubound(dataPtr_mask,2) - - lbnd3 = lbound(dataPtr_xcor,1) - ubnd3 = ubound(dataPtr_xcor,1) - lbnd4 = lbound(dataPtr_xcor,2) - ubnd4 = ubound(dataPtr_xcor,2) - - write(tmpstr,*) subname//' iscjsc = ',isc,iec,jsc,jec - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - - write(tmpstr,*) subname//' lbub12 = ',lbnd1,ubnd1,lbnd2,ubnd2 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - - write(tmpstr,*) subname//' lbub34 = ',lbnd3,ubnd3,lbnd4,ubnd4 - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - - if (iec-isc /= ubnd1-lbnd1 .or. jec-jsc /= ubnd2-lbnd2) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": fld and grid do not have the same size.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - - do j = jsc, jec - j1 = j + lbnd2 - jsc - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + ocean_grid%isc - isc - dataPtr_mask(i1,j1) = ocean_grid%mask2dT(ig,jg) - dataPtr_xcen(i1,j1) = ocean_grid%geolonT(ig,jg) - dataPtr_ycen(i1,j1) = ocean_grid%geolatT(ig,jg) - if(grid_attach_area) then - dataPtr_area(i1,j1) = ocean_grid%areaT(ig,jg) - end if - end do + !--------------------------------- + ! get start and end indices of each tile and their PET + !--------------------------------- + + allocate(xb(ntiles),xe(ntiles),yb(ntiles),ye(ntiles),pe(ntiles)) + call mpp_get_compute_domains(ocean_public%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye) + call mpp_get_pelist(ocean_public%domain, pe) + if (debug > 0) then + do n = 1,ntiles + write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + enddo + end if + + !--------------------------------- + ! Create either a grid or a mesh + !--------------------------------- + + !Get the ocean grid and sizes of global and computational domains + call get_ocean_grid(ocean_state, ocean_grid) + + if (geomtype == ESMF_GEOMTYPE_MESH) then + + !--------------------------------- + ! Create a MOM6 mesh + !--------------------------------- + + call get_global_grid_size(ocean_grid, ni, nj) + lsize = ( ocean_grid%iec - ocean_grid%isc + 1 ) * ( ocean_grid%jec - ocean_grid%jsc + 1 ) + + ! Create the global index space for the computational domain + allocate(gindex(lsize)) + k = 0 + do j = ocean_grid%jsc, ocean_grid%jec + jg = j + ocean_grid%jdg_offset + do i = ocean_grid%isc, ocean_grid%iec + ig = i + ocean_grid%idg_offset + k = k + 1 ! Increment position within gindex + gindex(k) = ni * (jg - 1) + ig + enddo + enddo + + DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + ! read in the mesh + call NUOPC_CompAttributeGet(gcomp, name='mesh_ocn', value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + EMeshTemp = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + if (localPet == 0) then + write(logunit,*)'mesh file for mom6 domain is ',trim(cvalue) + end if + + ! recreate the mesh using the above distGrid + EMesh = ESMF_MeshCreate(EMeshTemp, elementDistgrid=Distgrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + ! realize the import and export fields using the mesh + call MOM_RealizeFields(importState, fldsToOcn_num, fldsToOcn, "Ocn import", mesh=Emesh, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call MOM_RealizeFields(exportState, fldsFrOcn_num, fldsFrOcn, "Ocn export", mesh=Emesh, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + else if (geomtype == ESMF_GEOMTYPE_GRID) then + + !--------------------------------- + ! create a MOM6 grid + !--------------------------------- + + ! generate delayout and dist_grid + + allocate(deBlockList(2,2,ntiles)) + allocate(petMap(ntiles)) + allocate(deLabelList(ntiles)) + + do n = 1, ntiles + deLabelList(n) = n + deBlockList(1,1,n) = xb(n) + deBlockList(1,2,n) = xe(n) + deBlockList(2,1,n) = yb(n) + deBlockList(2,2,n) = ye(n) + petMap(n) = pe(n) + ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side + enddo + + delayout = ESMF_DELayoutCreate(petMap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! rsd this assumes tripole grid, but sometimes in CESM a bipole + ! grid is used -- need to introduce conditional logic here + + allocate(connectionList(2)) + + ! bipolar boundary condition at top row: nyg + call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & + tileIndexB=1, positionVector=(/nxg+1, 2*nyg+1/), & + orientationVector=(/-1, -2/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! periodic boundary condition along first dimension + call ESMF_DistGridConnectionSet(connectionList(2), tileIndexA=1, & + tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nxg,nyg/), & + ! indexflag = ESMF_INDEX_DELOCAL, & + deBlockList=deBlockList, & + ! deLabelList=deLabelList, & + delayout=delayout, & + connectionList=connectionList, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + deallocate(xb,xe,yb,ye,pe) + deallocate(connectionList) + deallocate(deLabelList) + deallocate(deBlockList) + deallocate(petMap) + + call ESMF_DistGridGet(distgrid=distgrid, localDE=0, elementCount=cnt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + allocate(indexList(cnt)) + write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(tmpstr,'(a,4i8)') subname//' distgrid list= ',& + indexList(1),indexList(cnt),minval(indexList), maxval(indexList) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + deallocate(IndexList) + + ! create grid + + gridIn = ESMF_GridCreate(distgrid=distgrid, & + gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & + coordSys = ESMF_COORDSYS_SPH_DEG, & + rc = rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! Attach area to the Grid optionally. By default the cell areas are computed. + if(grid_attach_area) then + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + call ESMF_GridGetCoord(gridIn, coordDim=1, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_xcen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridGetCoord(gridIn, coordDim=2, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_ycen, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridGetCoord(gridIn, coordDim=1, & + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=dataPtr_xcor, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_GridGetCoord(gridIn, coordDim=2, & + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=dataPtr_ycor, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_MASK, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_mask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if(grid_attach_area) then + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_area, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + ! load up area, mask, center and corner values + ! area, mask, and centers should be same size in mom and esmf grid + ! corner points may not be, need to offset corner points by 1 in i and j + ! retrieve these values directly from ocean_grid, which contains halo + ! values for j=0 and wrap-around in i. on tripole seam, decomposition + ! domains are 1 larger in j; to load corner values need to loop one extra row + + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + + lbnd1 = lbound(dataPtr_mask,1) + ubnd1 = ubound(dataPtr_mask,1) + lbnd2 = lbound(dataPtr_mask,2) + ubnd2 = ubound(dataPtr_mask,2) + + lbnd3 = lbound(dataPtr_xcor,1) + ubnd3 = ubound(dataPtr_xcor,1) + lbnd4 = lbound(dataPtr_xcor,2) + ubnd4 = ubound(dataPtr_xcor,2) + + write(tmpstr,*) subname//' iscjsc = ',isc,iec,jsc,jec + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + write(tmpstr,*) subname//' lbub12 = ',lbnd1,ubnd1,lbnd2,ubnd2 + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + write(tmpstr,*) subname//' lbub34 = ',lbnd3,ubnd3,lbnd4,ubnd4 + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + if (iec-isc /= ubnd1-lbnd1 .or. jec-jsc /= ubnd2-lbnd2) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": fld and grid do not have the same size.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + + do j = jsc, jec + j1 = j + lbnd2 - jsc + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + ig = i + ocean_grid%isc - isc + dataPtr_mask(i1,j1) = ocean_grid%mask2dT(ig,jg) + dataPtr_xcen(i1,j1) = ocean_grid%geolonT(ig,jg) + dataPtr_ycen(i1,j1) = ocean_grid%geolatT(ig,jg) + if(grid_attach_area) then + dataPtr_area(i1,j1) = ocean_grid%areaT(ig,jg) + end if end do - - jlast = jec - if(jec == nyg)jlast = jec+1 - - do j = jsc, jlast - j1 = j + lbnd4 - jsc - jg = j + ocean_grid%jsc - jsc - 1 - do i = isc, iec - i1 = i + lbnd3 - isc - ig = i + ocean_grid%isc - isc - 1 - dataPtr_xcor(i1,j1) = ocean_grid%geolonBu(ig,jg) - dataPtr_ycor(i1,j1) = ocean_grid%geolatBu(ig,jg) - end do + end do + + jlast = jec + if(jec == nyg)jlast = jec+1 + + do j = jsc, jlast + j1 = j + lbnd4 - jsc + jg = j + ocean_grid%jsc - jsc - 1 + do i = isc, iec + i1 = i + lbnd3 - isc + ig = i + ocean_grid%isc - isc - 1 + dataPtr_xcor(i1,j1) = ocean_grid%geolonBu(ig,jg) + dataPtr_ycor(i1,j1) = ocean_grid%geolatBu(ig,jg) end do + end do + + write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + if(grid_attach_area) then + write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + endif + + write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + write(tmpstr,*) subname//' ycen = ',minval(dataPtr_ycen),maxval(dataPtr_ycen) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + write(tmpstr,*) subname//' xcor = ',minval(dataPtr_xcor),maxval(dataPtr_xcor) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + gridOut = gridIn ! for now out same as in + + call MOM_RealizeFields(importState, fldsToOcn_num, fldsToOcn, "Ocn import", grid=gridIn, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call MOM_RealizeFields(exportState, fldsFrOcn_num, fldsFrOcn, "Ocn export", grid=gridOut, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end if + + !--------------------------------- + ! set scalar data in export state + !--------------------------------- + + if (len_trim(scalar_field_name) > 0) then + call State_SetScalar(dble(nxg),scalar_field_idx_grid_nx, exportState, localPet, & + scalar_field_name, scalar_field_count, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & + scalar_field_name, scalar_field_count, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + !--------------------------------- + ! Set module variable geomtype in mom_cap_methods + !--------------------------------- + call mom_set_geomtype(geomtype) + + !--------------------------------- + ! write out diagnostics + !--------------------------------- + + !call NUOPC_Write(exportState, fileNamePrefix='post_realize_field_ocn_export_', & + ! timeslice=1, relaxedFlag=.true., rc=rc) + !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + +end subroutine InitializeRealize - write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - - if(grid_attach_area) then - write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - endif - - write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - - write(tmpstr,*) subname//' ycen = ',minval(dataPtr_ycen),maxval(dataPtr_ycen) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - - write(tmpstr,*) subname//' xcor = ',minval(dataPtr_xcor),maxval(dataPtr_xcor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - - write(tmpstr,*) subname//' ycor = ',minval(dataPtr_ycor),maxval(dataPtr_ycor) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - - gridOut = gridIn ! for now out same as in - - call MOM_RealizeFields(importState, fldsToOcn_num, fldsToOcn, "Ocn import", grid=gridIn, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call MOM_RealizeFields(exportState, fldsFrOcn_num, fldsFrOcn, "Ocn export", grid=gridOut, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end if - - !--------------------------------- - ! set scalar data in export state - !--------------------------------- - - if (len_trim(scalar_field_name) > 0) then - call State_SetScalar(dble(nxg),scalar_field_idx_grid_nx, exportState, localPet, & - scalar_field_name, scalar_field_count, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & - scalar_field_name, scalar_field_count, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - !--------------------------------- - ! Set module variable geomtype in mom_cap_methods - !--------------------------------- - call mom_set_geomtype(geomtype) - - !--------------------------------- - ! write out diagnostics - !--------------------------------- - - !call NUOPC_Write(exportState, fileNamePrefix='post_realize_field_ocn_export_', & - ! timeslice=1, relaxedFlag=.true., rc=rc) - !if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - - end subroutine InitializeRealize - - !=============================================================================== - - subroutine DataInitialize(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc +!=============================================================================== - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_State) :: importState, exportState - type (ocean_public_type), pointer :: ocean_public => NULL() - type (ocean_state_type), pointer :: ocean_state => NULL() - type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() - type(ocean_internalstate_wrapper) :: ocean_internalstate - type(ocean_grid_type), pointer :: ocean_grid - character(240) :: msgString - integer :: fieldCount, n - type(ESMF_Field) :: field - character(len=64),allocatable :: fieldNameList(:) - character(len=*),parameter :: subname='(mom_cap:DataInitialize)' - !-------------------------------- - - ! query the Component for its clock, importState and exportState - call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, exportState=exportState, rc=rc) +subroutine DataInitialize(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_State) :: importState, exportState + type (ocean_public_type), pointer :: ocean_public => NULL() + type (ocean_state_type), pointer :: ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + type(ocean_grid_type), pointer :: ocean_grid + character(240) :: msgString + integer :: fieldCount, n + type(ESMF_Field) :: field + character(len=64),allocatable :: fieldNameList(:) + character(len=*),parameter :: subname='(mom_cap:DataInitialize)' + !-------------------------------- + + ! query the Component for its clock, importState and exportState + call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, exportState=exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr + ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + call get_ocean_grid(ocean_state, ocean_grid) + + if (cesm_coupled) then + call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + + call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + allocate(fieldNameList(fieldCount)) + call ESMF_StateGet(exportState, itemNameList=fieldNameList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + do n=1, fieldCount + call ESMF_StateGet(exportState, itemName=fieldNameList(n), field=field, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + call NUOPC_SetAttribute(field, name="Updated", value="true", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + end do + deallocate(fieldNameList) - Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr - ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr - ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr - call get_ocean_grid(ocean_state, ocean_grid) + ! check whether all Fields in the exportState are "Updated" + if (NUOPC_IsUpdated(exportState)) then + call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) - if (cesm_coupled) then - call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if - - call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) + call ESMF_LogWrite("MOM6 - Initialize-Data-Dependency SATISFIED!!!", ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + end if - allocate(fieldNameList(fieldCount)) - call ESMF_StateGet(exportState, itemNameList=fieldNameList, rc=rc) + if(write_diagnostics) then + call NUOPC_Write(exportState, fileNamePrefix='field_init_ocn_export_', & + timeslice=import_slice, relaxedFlag=.true., rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + endif - do n=1, fieldCount - call ESMF_StateGet(exportState, itemName=fieldNameList(n), field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call NUOPC_SetAttribute(field, name="Updated", value="true", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end do - deallocate(fieldNameList) - - ! check whether all Fields in the exportState are "Updated" - if (NUOPC_IsUpdated(exportState)) then - call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) - - call ESMF_LogWrite("MOM6 - Initialize-Data-Dependency SATISFIED!!!", ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if - - if(write_diagnostics) then - call NUOPC_Write(exportState, fileNamePrefix='field_init_ocn_export_', & - timeslice=import_slice, relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - end subroutine DataInitialize - - !=============================================================================== - - !> Called by NUOPC to advance the model a single timestep. - !! - !! @param gcomp an ESMF_GridComp object - !! @param rc return code - subroutine ModelAdvance(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc +end subroutine DataInitialize - ! local variables - integer :: userRc - logical :: existflag, isPresent, isSet - type(ESMF_Clock) :: clock - type(ESMF_Alarm) :: alarm - type(ESMF_State) :: importState, exportState - type(ESMF_Time) :: currTime - type(ESMF_TimeInterval) :: timeStep - type(ESMF_Time) :: startTime - type(ESMF_TimeInterval) :: time_elapsed - integer(ESMF_KIND_I8) :: n_interval, time_elapsed_sec - character(len=64) :: timestamp - type (ocean_public_type), pointer :: ocean_public => NULL() - type (ocean_state_type), pointer :: ocean_state => NULL() - type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() - type(ocean_internalstate_wrapper) :: ocean_internalstate - type(ocean_grid_type) , pointer :: ocean_grid - type(time_type) :: Time - type(time_type) :: Time_step_coupled - type(time_type) :: Time_restart_current - integer :: dth, dtm, dts - integer :: nc - type(ESMF_Time) :: MyTime - integer :: seconds, day, year, month, hour, minute - character(ESMF_MAXSTR) :: restartname, cvalue - character(240) :: msgString - character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' - !-------------------------------- - - rc = ESMF_SUCCESS - if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") - - call shr_file_setLogUnit (logunit) - - ! query the Component for its clock, importState and exportState - call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & - exportState=exportState, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out +!=============================================================================== - call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) +!> Called by NUOPC to advance the model a single timestep. +!! +!! @param gcomp an ESMF_GridComp object +!! @param rc return code +subroutine ModelAdvance(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + integer :: userRc + logical :: existflag, isPresent, isSet + type(ESMF_Clock) :: clock + type(ESMF_Alarm) :: alarm + type(ESMF_State) :: importState, exportState + type(ESMF_Time) :: currTime + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Time) :: startTime + type(ESMF_TimeInterval) :: time_elapsed + integer(ESMF_KIND_I8) :: n_interval, time_elapsed_sec + character(len=64) :: timestamp + type (ocean_public_type), pointer :: ocean_public => NULL() + type (ocean_state_type), pointer :: ocean_state => NULL() + type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL() + type(ocean_internalstate_wrapper) :: ocean_internalstate + type(ocean_grid_type) , pointer :: ocean_grid + type(time_type) :: Time + type(time_type) :: Time_step_coupled + type(time_type) :: Time_restart_current + integer :: dth, dtm, dts + integer :: nc + type(ESMF_Time) :: MyTime + integer :: seconds, day, year, month, hour, minute + character(ESMF_MAXSTR) :: restartname, cvalue + character(240) :: msgString + character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' + !-------------------------------- + + rc = ESMF_SUCCESS + if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") + + call shr_file_setLogUnit (logunit) + + ! query the Component for its clock, importState and exportState + call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & + exportState=exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr + ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + + ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep + + call ESMF_ClockPrint(clock, options="currTime", & + preString="------>Advancing OCN from: ", unit=msgString, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite(subname//trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(clock, startTime=startTime, currTime=currTime, & + timeStep=timeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_TimePrint(currTime + timeStep, & + preString="--------------------------------> to: ", & + unit=msgString, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + Time = esmf2fms_time(currTime) + Time_step_coupled = esmf2fms_time(timeStep) + + !--------------- + ! Write diagnostics for import + !--------------- + + if(write_diagnostics) then + call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', & + timeslice=import_slice, relaxedFlag=.true., rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out + import_slice = import_slice + 1 + endif + + !--------------- + ! Get ocean grid + !--------------- + + call get_ocean_grid(ocean_state, ocean_grid) + + !--------------- + ! Import data + !--------------- + + call shr_file_setLogUnit (logunit) + + if (cesm_coupled) then + call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype=runtype, rc=rc) + else + call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc=rc) + end if + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !--------------- + ! Update MOM6 + !--------------- + + if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") + call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled) + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") + + !--------------- + ! Export Data + !--------------- + + call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call shr_file_setLogUnit (logunit) + + !--------------- + ! If restart alarm is ringing - write restart file + !--------------- + + call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_AlarmRingerOff(alarm, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! call into system specific method to get desired restart filename + restartname = "" + call ESMF_MethodExecute(gcomp, label="GetRestartFileToWrite", & + existflag=existflag, userRc=userRc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg="Error executing user method to get restart filename", & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (ESMF_LogFoundError(rcToCheck=userRc, msg="Error in method to get restart filename", & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (existflag) then + call ESMF_LogWrite("mom_cap: called user GetRestartFileToWrite method", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompAttributeGet(gcomp, name='RestartFileToWrite', & + isPresent=isPresent, isSet=isSet, value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + restartname = trim(cvalue) + call ESMF_LogWrite("mom_cap: User RestartFileToWrite: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + endif + + if (len_trim(restartname) == 0) then + ! none provided, so use a default restart filename + call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, & + h=hour, m=minute, s=seconds, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & + "ocn", year, month, day, hour, minute, seconds + call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + ! TODO: address if this requirement is being met for the DA group + ! Optionally write restart files when currTime-startTime is integer multiples of restart_interval + ! if (restart_interval > 0 ) then + ! time_elapsed = currTime - startTime + ! call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + ! n_interval = time_elapsed_sec / restart_interval + ! if ((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then + ! time_restart_current = esmf2fms_time(currTime) + ! timestamp = date_to_string(time_restart_current) + ! call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=rc) + ! write(*,*) 'calling ocean_model_restart' + ! call ocean_model_restart(ocean_state, timestamp) + ! endif + ! endif + + ! write restart file(s) + call ocean_model_restart(ocean_state, restartname=restartname) + + if (is_root_pe()) then + write(logunit,*) subname//' writing restart file ',trim(restartname) + end if + endif + + !--------------- + ! Write diagnostics + !--------------- + + if (write_diagnostics) then + call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & + timeslice=export_slice, relaxedFlag=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + export_slice = export_slice + 1 + endif + + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") + +end subroutine ModelAdvance - Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr - ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr - ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr - - ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep - - call ESMF_ClockPrint(clock, options="currTime", & - preString="------>Advancing OCN from: ", unit=msgString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_LogWrite(subname//trim(msgString), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out +!=============================================================================== - call ESMF_ClockGet(clock, startTime=startTime, currTime=currTime, & - timeStep=timeStep, rc=rc) +subroutine ModelSetRunClock(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: mclock, dclock + type(ESMF_Time) :: mcurrtime, dcurrtime + type(ESMF_Time) :: mstoptime + type(ESMF_TimeInterval) :: mtimestep, dtimestep + character(len=128) :: mtimestring, dtimestring + character(len=256) :: cvalue + character(len=256) :: restart_option ! Restart option units + integer :: restart_n ! Number until restart interval + integer :: restart_ymd ! Restart date (YYYYMMDD) + type(ESMF_ALARM) :: restart_alarm + logical :: isPresent, isSet + logical :: first_time = .true. + character(len=*),parameter :: subname='mom_cap:(ModelSetRunClock) ' + !-------------------------------- + + rc = ESMF_SUCCESS + + ! query the Component for its clock, importState and exportState + call NUOPC_ModelGet(gcomp, driverClock=dclock, modelClock=mclock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(dclock, currTime=dcurrtime, timeStep=dtimestep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(mclock, currTime=mcurrtime, timeStep=mtimestep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !-------------------------------- + ! check that the current time in the model and driver are the same + !-------------------------------- + + if (mcurrtime /= dcurrtime) then + call ESMF_TimeGet(dcurrtime, timeString=dtimestring, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - call ESMF_TimePrint(currTime + timeStep, & - preString="--------------------------------> to: ", & - unit=msgString, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_TimeGet(mcurrtime, timeString=mtimestring, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - Time = esmf2fms_time(currTime) - Time_step_coupled = esmf2fms_time(timeStep) - - !--------------- - ! Write diagnostics for import - !--------------- - - if(write_diagnostics) then - call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', & - timeslice=import_slice, relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - import_slice = import_slice + 1 - endif - - !--------------- - ! Get ocean grid - !--------------- - - call get_ocean_grid(ocean_state, ocean_grid) + call ESMF_LogSetError(ESMF_RC_VAL_WRONG, & + msg=subname//": ERROR in time consistency: "//trim(dtimestring)//" != "//trim(mtimestring), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + + !-------------------------------- + ! force model clock currtime and timestep to match driver and set stoptime + !-------------------------------- + + mstoptime = mcurrtime + dtimestep + + call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (first_time) then + !-------------------------------- + ! set restart alarm + !-------------------------------- + + ! defaults + restart_n = 0 + restart_ymd = 0 + + call NUOPC_CompAttributeGet(gcomp, name="restart_option", isPresent=isPresent, & + isSet=isSet, value=restart_option, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + read(cvalue,*) restart_n + endif + call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + read(cvalue,*) restart_ymd + endif + else + restart_option = "none" + endif + + call AlarmInit(mclock, & + alarm = restart_alarm, & + option = trim(restart_option), & + opt_n = restart_n, & + opt_ymd = restart_ymd, & + RefTime = mcurrTime, & + alarmname = 'alarm_restart', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + first_time = .false. + + call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & + ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end if + + !-------------------------------- + ! Advance model clock to trigger alarms then reset model clock back to currtime + !-------------------------------- + + call ESMF_ClockAdvance(mclock,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + +end subroutine ModelSetRunClock - !--------------- - ! Import data - !--------------- - call shr_file_setLogUnit (logunit) +!=============================================================================== - if (cesm_coupled) then - call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype=runtype, rc=rc) - else - call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc=rc) - end if - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out +!> Called by NUOPC at the end of the run to clean up. +!! +!! @param gcomp an ESMF_GridComp object +!! @param rc return code +subroutine ocean_model_finalize(gcomp, rc) + + ! input arguments + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type (ocean_public_type), pointer :: ocean_public + type (ocean_state_type), pointer :: ocean_state + type(ocean_internalstate_wrapper) :: ocean_internalstate + type(TIME_TYPE) :: Time + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currTime + character(len=64) :: timestamp + character(len=*),parameter :: subname='(mom_cap:ocean_model_finalize)' + + write(*,*) 'MOM: --- finalize called ---' + rc = ESMF_SUCCESS + + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + + call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(clock, currTime=currTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + Time = esmf2fms_time(currTime) + + if (cesm_coupled) then + call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.false.) + else + call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.true.) + end if + call field_manager_end() + + call fms_io_exit() + call fms_end() + + write(*,*) 'MOM: --- completed ---' + +end subroutine ocean_model_finalize - !--------------- - ! Update MOM6 - !--------------- +!=============================================================================== - if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") - call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled) - if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") +subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_count, rc) + ! ---------------------------------------------- + ! Set scalar data from State for a particular name + ! ---------------------------------------------- - !--------------- - ! Export Data - !--------------- + real(ESMF_KIND_R8),intent(in) :: value + integer, intent(in) :: scalar_id + type(ESMF_State), intent(inout) :: State + integer, intent(in) :: mytask + character(len=*), intent(in) :: scalar_name + integer, intent(in) :: scalar_count + integer, intent(inout) :: rc - call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! local variables + type(ESMF_Field) :: field + real(ESMF_KIND_R8), pointer :: farrayptr(:,:) + character(len=*), parameter :: subname='(mom_cap:State_SetScalar)' + !-------------------------------------------------------- - call shr_file_setLogUnit (logunit) + rc = ESMF_SUCCESS - !--------------- - ! If restart alarm is ringing - write restart file - !--------------- + call ESMF_StateGet(State, itemName=trim(scalar_name), field=field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_AlarmRingerOff(alarm, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! call into system specific method to get desired restart filename - restartname = "" - call ESMF_MethodExecute(gcomp, label="GetRestartFileToWrite", & - existflag=existflag, userRc=userRc, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg="Error executing user method to get restart filename", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (ESMF_LogFoundError(rcToCheck=userRc, msg="Error in method to get restart filename", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (existflag) then - call ESMF_LogWrite("mom_cap: called user GetRestartFileToWrite method", ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_CompAttributeGet(gcomp, name='RestartFileToWrite', & - isPresent=isPresent, isSet=isSet, value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (isPresent .and. isSet) then - restartname = trim(cvalue) - call ESMF_LogWrite("mom_cap: User RestartFileToWrite: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - endif - - if (len_trim(restartname) == 0) then - ! none provided, so use a default restart filename - call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, & - h=hour, m=minute, s=seconds, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & - "ocn", year, month, day, hour, minute, seconds - call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif - - ! TODO: address if this requirement is being met for the DA group - ! Optionally write restart files when currTime-startTime is integer multiples of restart_interval - ! if (restart_interval > 0 ) then - ! time_elapsed = currTime - startTime - ! call ESMF_TimeIntervalGet(time_elapsed, s_i8=time_elapsed_sec, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - ! n_interval = time_elapsed_sec / restart_interval - ! if ((n_interval .gt. 0) .and. (n_interval*restart_interval == time_elapsed_sec)) then - ! time_restart_current = esmf2fms_time(currTime) - ! timestamp = date_to_string(time_restart_current) - ! call ESMF_LogWrite("MOM: Writing restart at "//trim(timestamp), ESMF_LOGMSG_INFO, rc=rc) - ! write(*,*) 'calling ocean_model_restart' - ! call ocean_model_restart(ocean_state, timestamp) - ! endif - ! endif - - ! write restart file(s) - call ocean_model_restart(ocean_state, restartname=restartname) - - if (is_root_pe()) then - write(logunit,*) subname//' writing restart file ',trim(restartname) - end if - endif + if (mytask == 0) then + call ESMF_FieldGet(field, farrayPtr=farrayptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - !--------------- - ! Write diagnostics - !--------------- - - if (write_diagnostics) then - call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & - timeslice=export_slice, relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - export_slice = export_slice + 1 + if (scalar_id < 0 .or. scalar_id > scalar_count) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ERROR in scalar_id", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return endif - if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM Model_ADVANCE: ") + farrayptr(scalar_id,1) = value + endif - end subroutine ModelAdvance +end subroutine State_SetScalar - !=============================================================================== - - subroutine ModelSetRunClock(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: mclock, dclock - type(ESMF_Time) :: mcurrtime, dcurrtime - type(ESMF_Time) :: mstoptime - type(ESMF_TimeInterval) :: mtimestep, dtimestep - character(len=128) :: mtimestring, dtimestring - character(len=256) :: cvalue - character(len=256) :: restart_option ! Restart option units - integer :: restart_n ! Number until restart interval - integer :: restart_ymd ! Restart date (YYYYMMDD) - type(ESMF_ALARM) :: restart_alarm - logical :: isPresent, isSet - logical :: first_time = .true. - character(len=*),parameter :: subname='mom_cap:(ModelSetRunClock) ' - !-------------------------------- - - rc = ESMF_SUCCESS - - ! query the Component for its clock, importState and exportState - call NUOPC_ModelGet(gcomp, driverClock=dclock, modelClock=mclock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_ClockGet(dclock, currTime=dcurrtime, timeStep=dtimestep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out +!=============================================================================== - call ESMF_ClockGet(mclock, currTime=mcurrtime, timeStep=mtimestep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out +subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) + + ! input/output variables + type(ESMF_State) , intent(inout) :: state + integer , intent(in) :: nfields + type(fld_list_type) , intent(inout) :: field_defs(:) + character(len=*) , intent(in) :: tag + type(ESMF_Grid) , intent(in), optional :: grid + type(ESMF_Mesh) , intent(in), optional :: mesh + integer , intent(inout) :: rc + + ! local variables + integer :: i + type(ESMF_Field) :: field + real(ESMF_KIND_R8), pointer :: fldptr1d(:) ! for mesh + real(ESMF_KIND_R8), pointer :: fldptr2d(:,:) ! for grid + character(len=*),parameter :: subname='(mom_cap:MOM_RealizeFields)' + !-------------------------------------------------------- + + rc = ESMF_SUCCESS + + do i = 1, nfields + + if (NUOPC_IsConnected(state, fieldName=field_defs(i)%shortname)) then + + if (field_defs(i)%shortname == scalar_field_name) then + + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected on root pe.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=rc) + + call SetScalarField(field, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + else + + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=rc) + + if (present(grid)) then + + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! initialize fldptr to zero + call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + fldptr2d(:,:) = 0.0 + + else if (present(mesh)) then + + field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! initialize fldptr to zero + call ESMF_FieldGet(field, farrayPtr=fldptr1d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + fldptr1d(:) = 0.0 + + end if - !-------------------------------- - ! check that the current time in the model and driver are the same - !-------------------------------- + endif - if (mcurrtime /= dcurrtime) then - call ESMF_TimeGet(dcurrtime, timeString=dtimestring, rc=rc) + ! Realize connected field + call NUOPC_Realize(state, field=field, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_TimeGet(mcurrtime, timeString=mtimestring, rc=rc) + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + else ! field is not connected + + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is not connected.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=rc) + ! remove a not connected Field from State + call ESMF_StateRemove(state, (/field_defs(i)%shortname/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_LogSetError(ESMF_RC_VAL_WRONG, & - msg=subname//": ERROR in time consistency: "//trim(dtimestring)//" != "//trim(mtimestring), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif + line=__LINE__, & + file=__FILE__)) & + return ! bail out - !-------------------------------- - ! force model clock currtime and timestep to match driver and set stoptime - !-------------------------------- - - mstoptime = mcurrtime + dtimestep - - call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (first_time) then - !-------------------------------- - ! set restart alarm - !-------------------------------- - - ! defaults - restart_n = 0 - restart_ymd = 0 - - call NUOPC_CompAttributeGet(gcomp, name="restart_option", isPresent=isPresent, & - isSet=isSet, value=restart_option, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (isPresent .and. isSet) then - call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (isPresent .and. isSet) then - read(cvalue,*) restart_n - endif - call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (isPresent .and. isSet) then - read(cvalue,*) restart_ymd - endif - else - restart_option = "none" - endif - - call AlarmInit(mclock, & - alarm = restart_alarm, & - option = trim(restart_option), & - opt_n = restart_n, & - opt_ymd = restart_ymd, & - RefTime = mcurrTime, & - alarmname = 'alarm_restart', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - first_time = .false. - - call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & - ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end if - - !-------------------------------- - ! Advance model clock to trigger alarms then reset model clock back to currtime - !-------------------------------- - - call ESMF_ClockAdvance(mclock,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end subroutine ModelSetRunClock + endif + enddo - !=============================================================================== +contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !> Called by NUOPC at the end of the run to clean up. - !! - !! @param gcomp an ESMF_GridComp object - !! @param rc return code - subroutine ocean_model_finalize(gcomp, rc) + subroutine SetScalarField(field, rc) - ! input arguments - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + ! create a field with scalar data on the root pe + type(ESMF_Field), intent(inout) :: field + integer, intent(inout) :: rc ! local variables - type (ocean_public_type), pointer :: ocean_public - type (ocean_state_type), pointer :: ocean_state - type(ocean_internalstate_wrapper) :: ocean_internalstate - type(TIME_TYPE) :: Time - type(ESMF_Clock) :: clock - type(ESMF_Time) :: currTime - character(len=64) :: timestamp - character(len=*),parameter :: subname='(mom_cap:ocean_model_finalize)' - - write(*,*) 'MOM: --- finalize called ---' + type(ESMF_Distgrid) :: distgrid + type(ESMF_Grid) :: grid + character(len=*), parameter :: subname='(mom_cap:SetScalarField)' + rc = ESMF_SUCCESS - call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + ! create a DistGrid with a single index space element, which gets mapped onto DE 0. + distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/1/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr - ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) + grid = ESMF_GridCreate(distgrid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call ESMF_ClockGet(clock, currTime=currTime, rc=rc) + ! num of scalar values + field = ESMF_FieldCreate(name=trim(scalar_field_name), grid=grid, typekind=ESMF_TYPEKIND_R8, & + ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), gridToFieldMap=(/2/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - Time = esmf2fms_time(currTime) - - if (cesm_coupled) then - call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.false.) - else - call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.true.) - end if - call field_manager_end() - - call fms_io_exit() - call fms_end() - - write(*,*) 'MOM: --- completed ---' - - end subroutine ocean_model_finalize - -!=============================================================================== - - subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_count, rc) - ! ---------------------------------------------- - ! Set scalar data from State for a particular name - ! ---------------------------------------------- - - real(ESMF_KIND_R8),intent(in) :: value - integer, intent(in) :: scalar_id - type(ESMF_State), intent(inout) :: State - integer, intent(in) :: mytask - character(len=*), intent(in) :: scalar_name - integer, intent(in) :: scalar_count - integer, intent(inout) :: rc - - ! local variables - type(ESMF_Field) :: field - real(ESMF_KIND_R8), pointer :: farrayptr(:,:) - character(len=*), parameter :: subname='(mom_cap:State_SetScalar)' - !-------------------------------------------------------- - - rc = ESMF_SUCCESS + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call ESMF_StateGet(State, itemName=trim(scalar_name), field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - if (mytask == 0) then - call ESMF_FieldGet(field, farrayPtr=farrayptr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + end subroutine SetScalarField - if (scalar_id < 0 .or. scalar_id > scalar_count) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": ERROR in scalar_id", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - - farrayptr(scalar_id,1) = value - endif - - end subroutine State_SetScalar +end subroutine MOM_RealizeFields !=============================================================================== - subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) - - ! input/output variables - type(ESMF_State) , intent(inout) :: state - integer , intent(in) :: nfields - type(fld_list_type) , intent(inout) :: field_defs(:) - character(len=*) , intent(in) :: tag - type(ESMF_Grid) , intent(in), optional :: grid - type(ESMF_Mesh) , intent(in), optional :: mesh - integer , intent(inout) :: rc - - ! local variables - integer :: i - type(ESMF_Field) :: field - real(ESMF_KIND_R8), pointer :: fldptr1d(:) ! for mesh - real(ESMF_KIND_R8), pointer :: fldptr2d(:,:) ! for grid - character(len=*),parameter :: subname='(mom_cap:MOM_RealizeFields)' - !-------------------------------------------------------- - - rc = ESMF_SUCCESS - - do i = 1, nfields - - if (NUOPC_IsConnected(state, fieldName=field_defs(i)%shortname)) then - - if (field_defs(i)%shortname == scalar_field_name) then - - call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected on root pe.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=rc) - - call SetScalarField(field, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - else - - call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=rc) - - if (present(grid)) then - - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! initialize fldptr to zero - call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - fldptr2d(:,:) = 0.0 - - else if (present(mesh)) then - - field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! initialize fldptr to zero - call ESMF_FieldGet(field, farrayPtr=fldptr1d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - fldptr1d(:) = 0.0 - - end if - - endif - - ! Realize connected field - call NUOPC_Realize(state, field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - else ! field is not connected - - call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is not connected.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=rc) - ! remove a not connected Field from State - call ESMF_StateRemove(state, (/field_defs(i)%shortname/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - endif - - enddo - - contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - subroutine SetScalarField(field, rc) - - ! create a field with scalar data on the root pe - type(ESMF_Field), intent(inout) :: field - integer, intent(inout) :: rc - - ! local variables - type(ESMF_Distgrid) :: distgrid - type(ESMF_Grid) :: grid - character(len=*), parameter :: subname='(mom_cap:SetScalarField)' - - rc = ESMF_SUCCESS - - ! create a DistGrid with a single index space element, which gets mapped onto DE 0. - distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/1/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - grid = ESMF_GridCreate(distgrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! num of scalar values - field = ESMF_FieldCreate(name=trim(scalar_field_name), grid=grid, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), gridToFieldMap=(/2/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end subroutine SetScalarField - - end subroutine MOM_RealizeFields - -!=============================================================================== - - subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname) - ! ---------------------------------------------- - ! Set up a list of field information - ! ---------------------------------------------- - integer, intent(inout) :: num - type(fld_list_type), intent(inout) :: fldlist(:) - character(len=*), intent(in) :: stdname - character(len=*), intent(in) :: transferOffer - character(len=*), optional, intent(in) :: shortname - - ! local variables - integer :: rc - character(len=*), parameter :: subname='(mom_cap:fld_list_add)' - - ! fill in the new entry - num = num + 1 - if (num > fldsMax) then - call ESMF_LogSetError(ESMF_RC_VAL_OUTOFRANGE, & - msg=trim(subname)//": ERROR number of field exceeded fldsMax: "//trim(stdname), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - - fldlist(num)%stdname = trim(stdname) - if (present(shortname)) then - fldlist(num)%shortname = trim(shortname) - else - fldlist(num)%shortname = trim(stdname) - endif - fldlist(num)%transferOffer = trim(transferOffer) - - end subroutine fld_list_add +subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname) + ! ---------------------------------------------- + ! Set up a list of field information + ! ---------------------------------------------- + integer, intent(inout) :: num + type(fld_list_type), intent(inout) :: fldlist(:) + character(len=*), intent(in) :: stdname + character(len=*), intent(in) :: transferOffer + character(len=*), optional, intent(in) :: shortname + + ! local variables + integer :: rc + character(len=*), parameter :: subname='(mom_cap:fld_list_add)' + + ! fill in the new entry + num = num + 1 + if (num > fldsMax) then + call ESMF_LogSetError(ESMF_RC_VAL_OUTOFRANGE, & + msg=trim(subname)//": ERROR number of field exceeded fldsMax: "//trim(stdname), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + + fldlist(num)%stdname = trim(stdname) + if (present(shortname)) then + fldlist(num)%shortname = trim(shortname) + else + fldlist(num)%shortname = trim(stdname) + endif + fldlist(num)%transferOffer = trim(transferOffer) + +end subroutine fld_list_add !======================================================================= #ifndef CESMCOUPLED - subroutine shr_file_setLogUnit(nunit) - integer, intent(in) :: nunit - ! do nothing for this stub - its just here to replace - ! having cppdefs in the main program - end subroutine shr_file_setLogUnit - - subroutine shr_file_getLogUnit(nunit) - integer, intent(in) :: nunit - ! do nothing for this stub - its just here to replace - ! having cppdefs in the main program - end subroutine shr_file_getLogUnit +subroutine shr_file_setLogUnit(nunit) + integer, intent(in) :: nunit + ! do nothing for this stub - its just here to replace + ! having cppdefs in the main program +end subroutine shr_file_setLogUnit + +subroutine shr_file_getLogUnit(nunit) + integer, intent(in) :: nunit + ! do nothing for this stub - its just here to replace + ! having cppdefs in the main program +end subroutine shr_file_getLogUnit #endif end module mom_cap_mod diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 65360abeee..67c064194d 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -1,886 +1,885 @@ module mom_cap_methods - ! Cap import/export methods for both NEMS and CMEPS - - use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet - use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet - use ESMF, only: ESMF_State, ESMF_StateGet - use ESMF, only: ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate - use ESMF, only: ESMF_GridComp, ESMF_Mesh, ESMF_Grid, ESMF_GridCreate - use ESMF, only: ESMF_DistGrid, ESMF_DistGridCreate - use ESMF, only: ESMF_KIND_R8, ESMF_SUCCESS, ESMF_LogFoundError - use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO, ESMF_LOGWRITE - use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE - use ESMF, only: ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND - use ESMF, only: ESMF_GEOMTYPE_FLAG, ESMF_GEOMTYPE_GRID, ESMF_GEOMTYPE_MESH - use ESMF, only: ESMF_RC_VAL_OUTOFRANGE, ESMF_INDEX_DELOCAL, ESMF_MESHLOC_ELEMENT - use ESMF, only: ESMF_TYPEKIND_R8 - use ESMF, only: operator(/=), operator(==) - use MOM_ocean_model, only: ocean_public_type, ocean_state_type - use MOM_surface_forcing, only: ice_ocean_boundary_type - use MOM_grid, only: ocean_grid_type - use MOM_domains, only: pass_var - use mpp_domains_mod, only: mpp_get_compute_domain - - ! By default make data private - implicit none - private - - ! Public member functions - public :: mom_set_geomtype - public :: mom_import - public :: mom_export - - private :: State_getImport - private :: State_setExport - - interface State_GetFldPtr - module procedure State_GetFldPtr_1d - module procedure State_GetFldPtr_2d - end interface - - integer :: import_cnt = 0 - type(ESMF_GeomType_Flag) :: geomtype +! Cap import/export methods for both NEMS and CMEPS + +use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet +use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet +use ESMF, only: ESMF_State, ESMF_StateGet +use ESMF, only: ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate +use ESMF, only: ESMF_GridComp, ESMF_Mesh, ESMF_Grid, ESMF_GridCreate +use ESMF, only: ESMF_DistGrid, ESMF_DistGridCreate +use ESMF, only: ESMF_KIND_R8, ESMF_SUCCESS, ESMF_LogFoundError +use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO, ESMF_LOGWRITE +use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE +use ESMF, only: ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND +use ESMF, only: ESMF_GEOMTYPE_FLAG, ESMF_GEOMTYPE_GRID, ESMF_GEOMTYPE_MESH +use ESMF, only: ESMF_RC_VAL_OUTOFRANGE, ESMF_INDEX_DELOCAL, ESMF_MESHLOC_ELEMENT +use ESMF, only: ESMF_TYPEKIND_R8 +use ESMF, only: operator(/=), operator(==) +use MOM_ocean_model, only: ocean_public_type, ocean_state_type +use MOM_surface_forcing, only: ice_ocean_boundary_type +use MOM_grid, only: ocean_grid_type +use MOM_domains, only: pass_var +use mpp_domains_mod, only: mpp_get_compute_domain + +! By default make data private +implicit none; private + +! Public member functions +public :: mom_set_geomtype +public :: mom_import +public :: mom_export + +private :: State_getImport +private :: State_setExport + +interface State_GetFldPtr + module procedure State_GetFldPtr_1d + module procedure State_GetFldPtr_2d +end interface + +integer :: import_cnt = 0 +type(ESMF_GeomType_Flag) :: geomtype !=============================================================================== contains !=============================================================================== - subroutine mom_set_geomtype(geomtype_in) - ! Set module variable geomtype +subroutine mom_set_geomtype(geomtype_in) + ! Set module variable geomtype - type(ESMF_GeomType_Flag), intent(in) :: geomtype_in !< mesh or grid + type(ESMF_GeomType_Flag), intent(in) :: geomtype_in !< mesh or grid - geomtype = geomtype_in + geomtype = geomtype_in - end subroutine mom_set_geomtype +end subroutine mom_set_geomtype !=============================================================================== - !> This function has a few purposes: - !! (1) it imports surface fluxes using data from the mediator; and - !! (2) it can apply restoring in SST and SSS. - - subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype, rc) - - ! Input/output variables - type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state - type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid - type(ESMF_State) , intent(inout) :: importState !< incoming data from mediator - type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing - character(len=*), optional , intent(in) :: runtype !< For cesm only, type of run - integer , intent(inout) :: rc - - ! Local Variables - integer :: i, j, ig, jg, n - integer :: isc, iec, jsc, jec - logical :: do_import - character(len=128) :: fldname - real(ESMF_KIND_R8), allocatable :: taux(:,:) - real(ESMF_KIND_R8), allocatable :: tauy(:,:) - character(len=*) , parameter :: subname = '(mom_import)' - - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! ------- - ! import_cnt is used to skip using the import state at the first count for cesm - ! ------- - - if (present(runtype)) then - import_cnt = import_cnt + 1 - if ((trim(runtype) == 'initial' .and. import_cnt <= 2)) then - do_import = .false. ! This will skip the first time import information is given - else - do_import = .true. - end if - else - do_import = .true. - end if - - if (do_import) then - ! The following are global indices without halos - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - - !---- - ! surface height pressure - !---- - call state_getimport(importState, 'inst_pres_height_surface', & - isc, iec, jsc, jec, ice_ocean_boundary%p, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! near-IR, direct shortwave (W/m2) - !---- - call state_getimport(importState, 'mean_net_sw_ir_dir_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! near-IR, diffuse shortwave (W/m2) - !---- - call state_getimport(importState, 'mean_net_sw_ir_dif_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! visible, direct shortwave (W/m2) - !---- - call state_getimport(importState, 'mean_net_sw_vis_dir_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! visible, diffuse shortwave (W/m2) - !---- - call state_getimport(importState, 'mean_net_sw_vis_dif_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! ------- - ! Net longwave radiation (W/m2) - ! ------- - call state_getimport(importState, 'mean_net_lw_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! zonal and meridional surface stress - !---- - allocate (taux(isc:iec,jsc:jec)) - allocate (tauy(isc:iec,jsc:jec)) - - call state_getimport(importState, 'mean_zonal_moment_flx', isc, iec, jsc, jec, taux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call state_getimport(importState, 'mean_merid_moment_flx', isc, iec, jsc, jec, tauy, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! rotate taux and tauy from true zonal/meridional to local coordinates - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg)*taux(i,j) & - - ocean_grid%sin_rot(ig,jg)*tauy(i,j) - ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg)*tauy(i,j) & - + ocean_grid%sin_rot(ig,jg)*taux(i,j) - end do - end do - - deallocate(taux, tauy) - - !---- - ! sensible heat flux (W/m2) - !---- - call state_getimport(importState, 'mean_sensi_heat_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%t_flux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! evaporation flux (W/m2) - !---- - call state_getimport(importState, 'mean_evap_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%q_flux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! liquid precipitation (rain) - !---- - call state_getimport(importState, 'mean_prec_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%lprec, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! frozen precipitation (snow) - !---- - call state_getimport(importState, 'mean_fprec_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%fprec, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! runoff and heat content of runoff - !---- - ! Note - preset values to 0, if field does not exist in importState, then will simply return - ! and preset value will be used - - ! liquid runoff - ice_ocean_boundary%rofl_flux (:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'Foxx_rofl', & - isc, iec, jsc, jec, ice_ocean_boundary%rofl_flux,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! ice runoff - ice_ocean_boundary%rofi_flux (:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'Foxx_rofi', & - isc, iec, jsc, jec, ice_ocean_boundary%rofi_flux,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! total runoff - ice_ocean_boundary%runoff (:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mean_runoff_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%runoff, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! heat content of runoff - ice_ocean_boundary%runoff_hflx(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mean_runoff_heat_flux', & - isc, iec, jsc, jec, ice_ocean_boundary%runoff_hflx, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! calving rate and heat flux - !---- - ! Note - preset values to 0, if field does not exist in importState, then will simply return - ! and preset value will be used - - ice_ocean_boundary%calving(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mean_calving_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%calving, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ice_ocean_boundary%calving_hflx(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mean_calving_heat_flux', & - isc, iec, jsc, jec, ice_ocean_boundary%calving_hflx, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! salt flux from ice - !---- - call state_getimport(importState, 'mean_salt_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%salt_flux,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! !---- - ! ! snow&ice melt heat flux (W/m^2) - ! !---- - ! call state_getimport(importState, 'seaice_melt_heat', & - ! isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_heat,rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - - ! !---- - ! ! snow&ice melt water flux (W/m^2) - ! !---- - ! call state_getimport(importState, 'seaice_melt_water', & - ! isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_water,rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - ! line=__LINE__, & - ! file=__FILE__)) & - ! return ! bail out - - !---- - ! mass of overlying ice - !---- - ! Note - preset values to 0, if field does not exist in importState, then will simply return - ! and preset value will be used - - ice_ocean_boundary%mi(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mass_of_overlying_ice', & - isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end if - - end subroutine mom_import +!> This function has a few purposes: +!! (1) it imports surface fluxes using data from the mediator; and +!! (2) it can apply restoring in SST and SSS. + +subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype, rc) + + ! Input/output variables + type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state + type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid + type(ESMF_State) , intent(inout) :: importState !< incoming data from mediator + type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing + character(len=*), optional , intent(in) :: runtype !< For cesm only, type of run + integer , intent(inout) :: rc + + ! Local Variables + integer :: i, j, ig, jg, n + integer :: isc, iec, jsc, jec + logical :: do_import + character(len=128) :: fldname + real(ESMF_KIND_R8), allocatable :: taux(:,:) + real(ESMF_KIND_R8), allocatable :: tauy(:,:) + character(len=*) , parameter :: subname = '(mom_import)' + + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! ------- + ! import_cnt is used to skip using the import state at the first count for cesm + ! ------- + + if (present(runtype)) then + import_cnt = import_cnt + 1 + if ((trim(runtype) == 'initial' .and. import_cnt <= 2)) then + do_import = .false. ! This will skip the first time import information is given + else + do_import = .true. + end if + else + do_import = .true. + end if + + if (do_import) then + ! The following are global indices without halos + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + + !---- + ! surface height pressure + !---- + call state_getimport(importState, 'inst_pres_height_surface', & + isc, iec, jsc, jec, ice_ocean_boundary%p, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! near-IR, direct shortwave (W/m2) + !---- + call state_getimport(importState, 'mean_net_sw_ir_dir_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! near-IR, diffuse shortwave (W/m2) + !---- + call state_getimport(importState, 'mean_net_sw_ir_dif_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! visible, direct shortwave (W/m2) + !---- + call state_getimport(importState, 'mean_net_sw_vis_dir_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! visible, diffuse shortwave (W/m2) + !---- + call state_getimport(importState, 'mean_net_sw_vis_dif_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! ------- + ! Net longwave radiation (W/m2) + ! ------- + call state_getimport(importState, 'mean_net_lw_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! zonal and meridional surface stress + !---- + allocate (taux(isc:iec,jsc:jec)) + allocate (tauy(isc:iec,jsc:jec)) + + call state_getimport(importState, 'mean_zonal_moment_flx', isc, iec, jsc, jec, taux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call state_getimport(importState, 'mean_merid_moment_flx', isc, iec, jsc, jec, tauy, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! rotate taux and tauy from true zonal/meridional to local coordinates + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg)*taux(i,j) & + - ocean_grid%sin_rot(ig,jg)*tauy(i,j) + ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg)*tauy(i,j) & + + ocean_grid%sin_rot(ig,jg)*taux(i,j) + end do + end do + + deallocate(taux, tauy) + + !---- + ! sensible heat flux (W/m2) + !---- + call state_getimport(importState, 'mean_sensi_heat_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%t_flux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! evaporation flux (W/m2) + !---- + call state_getimport(importState, 'mean_evap_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%q_flux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! liquid precipitation (rain) + !---- + call state_getimport(importState, 'mean_prec_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%lprec, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! frozen precipitation (snow) + !---- + call state_getimport(importState, 'mean_fprec_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%fprec, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! runoff and heat content of runoff + !---- + ! Note - preset values to 0, if field does not exist in importState, then will simply return + ! and preset value will be used + + ! liquid runoff + ice_ocean_boundary%rofl_flux (:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'Foxx_rofl', & + isc, iec, jsc, jec, ice_ocean_boundary%rofl_flux,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! ice runoff + ice_ocean_boundary%rofi_flux (:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'Foxx_rofi', & + isc, iec, jsc, jec, ice_ocean_boundary%rofi_flux,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! total runoff + ice_ocean_boundary%runoff (:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_runoff_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%runoff, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! heat content of runoff + ice_ocean_boundary%runoff_hflx(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_runoff_heat_flux', & + isc, iec, jsc, jec, ice_ocean_boundary%runoff_hflx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! calving rate and heat flux + !---- + ! Note - preset values to 0, if field does not exist in importState, then will simply return + ! and preset value will be used + + ice_ocean_boundary%calving(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_calving_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%calving, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ice_ocean_boundary%calving_hflx(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_calving_heat_flux', & + isc, iec, jsc, jec, ice_ocean_boundary%calving_hflx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! salt flux from ice + !---- + call state_getimport(importState, 'mean_salt_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%salt_flux,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! !---- + ! ! snow&ice melt heat flux (W/m^2) + ! !---- + ! call state_getimport(importState, 'seaice_melt_heat', & + ! isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_heat,rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + + ! !---- + ! ! snow&ice melt water flux (W/m^2) + ! !---- + ! call state_getimport(importState, 'seaice_melt_water', & + ! isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_water,rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + + !---- + ! mass of overlying ice + !---- + ! Note - preset values to 0, if field does not exist in importState, then will simply return + ! and preset value will be used + + ice_ocean_boundary%mi(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mass_of_overlying_ice', & + isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end if + +end subroutine mom_import !=============================================================================== - !> Maps outgoing ocean data to ESMF State - subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc) - - ! Input/output variables - type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state - type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid - type(ocean_state_type) , pointer :: ocean_state - type(ESMF_State) , intent(inout) :: exportState !< outgoing data - type(ESMF_Clock) , intent(in) :: clock - integer , intent(inout) :: rc - - ! Local variables - integer :: i, j, ig, jg ! indices - integer :: isc, iec, jsc, jec ! indices - integer :: iloc, jloc ! indices - integer :: iglob, jglob ! indices - integer :: n - integer :: icount - real :: slp_L, slp_R, slp_C - real :: slope, u_min, u_max - integer :: day, secs - type(ESMF_TimeInterval) :: timeStep - integer :: dt_int - real :: inv_dt_int !< The inverse of coupling time interval in s-1. - type(ESMF_StateItem_Flag) :: itemFlag - real(ESMF_KIND_R8), allocatable :: omask(:,:) - real(ESMF_KIND_R8), allocatable :: melt_potential(:,:) - real(ESMF_KIND_R8), allocatable :: ocz(:,:), ocm(:,:) - real(ESMF_KIND_R8), allocatable :: ocz_rot(:,:), ocm_rot(:,:) - real(ESMF_KIND_R8), allocatable :: ssh(:,:) - real(ESMF_KIND_R8), allocatable :: dhdx(:,:), dhdy(:,:) - real(ESMF_KIND_R8), allocatable :: dhdx_rot(:,:), dhdy_rot(:,:) - character(len=*) , parameter :: subname = '(mom_export)' - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! Use Adcroft's rule of reciprocals; it does the right thing here. - call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call ESMF_TimeIntervalGet( timeStep, s=dt_int, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (real(dt_int) > 0.0) then - inv_dt_int = 1.0 / real(dt_int) - else - inv_dt_int = 0.0 - end if - - !---------------- - ! Copy from ocean_public to exportstate. - !---------------- - - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - - ! ------- - ! ocean mask - ! ------- - - allocate(omask(isc:iec, jsc:jec)) - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - omask(i,j) = nint(ocean_grid%mask2dT(ig,jg)) - enddo - enddo - - call State_SetExport(exportState, 'ocean_mask', & - isc, iec, jsc, jec, omask, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - deallocate(omask) - - ! ------- - ! Sea surface temperature - ! ------- - call State_SetExport(exportState, 'sea_surface_temperature', & - isc, iec, jsc, jec, ocean_public%t_surf, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! ------- - ! Sea surface salinity - ! ------- - call State_SetExport(exportState, 's_surf', & - isc, iec, jsc, jec, ocean_public%s_surf, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! ------- - ! zonal and meridional currents - ! ------- - - ! rotate ocn current from tripolar grid back to lat/lon grid x,y => latlon (CCW) - ! "ocean_grid" has halos and uses local indexing. - - allocate(ocz(isc:iec, jsc:jec)) - allocate(ocm(isc:iec, jsc:jec)) - allocate(ocz_rot(isc:iec, jsc:jec)) - allocate(ocm_rot(isc:iec, jsc:jec)) - - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - ocz(i,j) = ocean_public%u_surf(i,j) - ocm(i,j) = ocean_public%v_surf(i,j) - ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) + ocean_grid%sin_rot(ig,jg)*ocm(i,j) - ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) - ocean_grid%sin_rot(ig,jg)*ocz(i,j) - end do +!> Maps outgoing ocean data to ESMF State +subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc) + + ! Input/output variables + type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state + type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid + type(ocean_state_type) , pointer :: ocean_state + type(ESMF_State) , intent(inout) :: exportState !< outgoing data + type(ESMF_Clock) , intent(in) :: clock + integer , intent(inout) :: rc + + ! Local variables + integer :: i, j, ig, jg ! indices + integer :: isc, iec, jsc, jec ! indices + integer :: iloc, jloc ! indices + integer :: iglob, jglob ! indices + integer :: n + integer :: icount + real :: slp_L, slp_R, slp_C + real :: slope, u_min, u_max + integer :: day, secs + type(ESMF_TimeInterval) :: timeStep + integer :: dt_int + real :: inv_dt_int !< The inverse of coupling time interval in s-1. + type(ESMF_StateItem_Flag) :: itemFlag + real(ESMF_KIND_R8), allocatable :: omask(:,:) + real(ESMF_KIND_R8), allocatable :: melt_potential(:,:) + real(ESMF_KIND_R8), allocatable :: ocz(:,:), ocm(:,:) + real(ESMF_KIND_R8), allocatable :: ocz_rot(:,:), ocm_rot(:,:) + real(ESMF_KIND_R8), allocatable :: ssh(:,:) + real(ESMF_KIND_R8), allocatable :: dhdx(:,:), dhdy(:,:) + real(ESMF_KIND_R8), allocatable :: dhdx_rot(:,:), dhdy_rot(:,:) + character(len=*) , parameter :: subname = '(mom_export)' + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Use Adcroft's rule of reciprocals; it does the right thing here. + call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_TimeIntervalGet( timeStep, s=dt_int, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + if (real(dt_int) > 0.0) then + inv_dt_int = 1.0 / real(dt_int) + else + inv_dt_int = 0.0 + end if + + !---------------- + ! Copy from ocean_public to exportstate. + !---------------- + + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + + ! ------- + ! ocean mask + ! ------- + + allocate(omask(isc:iec, jsc:jec)) + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + omask(i,j) = nint(ocean_grid%mask2dT(ig,jg)) + enddo + enddo + + call State_SetExport(exportState, 'ocean_mask', & + isc, iec, jsc, jec, omask, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + deallocate(omask) + + ! ------- + ! Sea surface temperature + ! ------- + call State_SetExport(exportState, 'sea_surface_temperature', & + isc, iec, jsc, jec, ocean_public%t_surf, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! ------- + ! Sea surface salinity + ! ------- + call State_SetExport(exportState, 's_surf', & + isc, iec, jsc, jec, ocean_public%s_surf, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! ------- + ! zonal and meridional currents + ! ------- + + ! rotate ocn current from tripolar grid back to lat/lon grid x,y => latlon (CCW) + ! "ocean_grid" has halos and uses local indexing. + + allocate(ocz(isc:iec, jsc:jec)) + allocate(ocm(isc:iec, jsc:jec)) + allocate(ocz_rot(isc:iec, jsc:jec)) + allocate(ocm_rot(isc:iec, jsc:jec)) + + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + ocz(i,j) = ocean_public%u_surf(i,j) + ocm(i,j) = ocean_public%v_surf(i,j) + ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) + ocean_grid%sin_rot(ig,jg)*ocm(i,j) + ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) - ocean_grid%sin_rot(ig,jg)*ocz(i,j) + end do + end do + + call State_SetExport(exportState, 'ocn_current_zonal', & + isc, iec, jsc, jec, ocz_rot, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call State_SetExport(exportState, 'ocn_current_merid', & + isc, iec, jsc, jec, ocm_rot, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + deallocate(ocz, ocm, ocz_rot, ocm_rot) + + ! ------- + ! Boundary layer depth + ! ------- + call ESMF_StateGet(exportState, 'So_bldepth', itemFlag, rc=rc) + if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then + call State_SetExport(exportState, 'So_bldepth', & + isc, iec, jsc, jec, ocean_public%obld, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + + ! ------- + ! Freezing melting potential + ! ------- + ! melt_potential, defined positive for T>Tfreeze, so need to change sign + ! Convert from J/m^2 to W/m^2 and make sure Melt_potential is always <= 0 + + allocate(melt_potential(isc:iec, jsc:jec)) + + do j = jsc,jec + do i = isc,iec + if (ocean_public%frazil(i,j) > 0.0) then + melt_potential(i,j) = ocean_public%frazil(i,j) * inv_dt_int + else + melt_potential(i,j) = -ocean_public%melt_potential(i,j) * inv_dt_int + if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 + end if + end do + end do + + call State_SetExport(exportState, 'freezing_melting_potential', & + isc, iec, jsc, jec, melt_potential, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + deallocate(melt_potential) + + ! ------- + ! Sea level + ! ------- + call ESMF_StateGet(exportState, 'sea_level', itemFlag, rc=rc) + if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then + call State_SetExport(exportState, 'sea_level', & + isc, iec, jsc, jec, ocean_public%sea_lev, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + end if + + !---------------- + ! Sea-surface zonal and meridional slopes + !---------------- + + allocate(ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) ! local indices with halos + allocate(dhdx(isc:iec, jsc:jec)) !global indices without halos + allocate(dhdy(isc:iec, jsc:jec)) !global indices without halos + allocate(dhdx_rot(isc:iec, jsc:jec)) !global indices without halos + allocate(dhdy_rot(isc:iec, jsc:jec)) !global indices without halos + + ssh = 0.0_ESMF_KIND_R8 + dhdx = 0.0_ESMF_KIND_R8 + dhdy = 0.0_ESMF_KIND_R8 + + ! Make a copy of ssh in order to do a halo update (ssh has local indexing with halos) + do j = ocean_grid%jsc, ocean_grid%jec + jloc = j + ocean_grid%jdg_offset + do i = ocean_grid%isc,ocean_grid%iec + iloc = i + ocean_grid%idg_offset + ssh(i,j) = ocean_public%sea_lev(iloc,jloc) + end do + end do + + ! Update halo of ssh so we can calculate gradients (local indexing) + call pass_var(ssh, ocean_grid%domain) + + ! d/dx ssh + ! This is a simple second-order difference + ! dhdx(i,j) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) + + do jglob = jsc, jec + j = jglob + ocean_grid%jsc - jsc + do iglob = isc,iec + i = iglob + ocean_grid%isc - isc + ! This is a PLM slope which might be less prone to the A-grid null mode + slp_L = (ssh(I,j) - ssh(I-1,j)) * ocean_grid%mask2dCu(i-1,j) + if (ocean_grid%mask2dCu(i-1,j)==0.) slp_L = 0. + slp_R = (ssh(I+1,j) - ssh(I,j)) * ocean_grid%mask2dCu(i,j) + if (ocean_grid%mask2dCu(i+1,j)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + if ( (slp_L * slp_R) > 0.0 ) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + dhdx(iglob,jglob) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) dhdx(iglob,jglob) = 0.0 end do - - call State_SetExport(exportState, 'ocn_current_zonal', & - isc, iec, jsc, jec, ocz_rot, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - call State_SetExport(exportState, 'ocn_current_merid', & - isc, iec, jsc, jec, ocm_rot, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - deallocate(ocz, ocm, ocz_rot, ocm_rot) - - ! ------- - ! Boundary layer depth - ! ------- - call ESMF_StateGet(exportState, 'So_bldepth', itemFlag, rc=rc) - if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then - call State_SetExport(exportState, 'So_bldepth', & - isc, iec, jsc, jec, ocean_public%obld, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if - - ! ------- - ! Freezing melting potential - ! ------- - ! melt_potential, defined positive for T>Tfreeze, so need to change sign - ! Convert from J/m^2 to W/m^2 and make sure Melt_potential is always <= 0 - - allocate(melt_potential(isc:iec, jsc:jec)) - - do j = jsc,jec - do i = isc,iec - if (ocean_public%frazil(i,j) > 0.0) then - melt_potential(i,j) = ocean_public%frazil(i,j) * inv_dt_int - else - melt_potential(i,j) = -ocean_public%melt_potential(i,j) * inv_dt_int - if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 - end if - end do - end do - - call State_SetExport(exportState, 'freezing_melting_potential', & - isc, iec, jsc, jec, melt_potential, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - deallocate(melt_potential) - - ! ------- - ! Sea level - ! ------- - call ESMF_StateGet(exportState, 'sea_level', itemFlag, rc=rc) - if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then - call State_SetExport(exportState, 'sea_level', & - isc, iec, jsc, jec, ocean_public%sea_lev, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - end if - - !---------------- - ! Sea-surface zonal and meridional slopes - !---------------- - - allocate(ssh(ocean_grid%isd:ocean_grid%ied,ocean_grid%jsd:ocean_grid%jed)) ! local indices with halos - allocate(dhdx(isc:iec, jsc:jec)) !global indices without halos - allocate(dhdy(isc:iec, jsc:jec)) !global indices without halos - allocate(dhdx_rot(isc:iec, jsc:jec)) !global indices without halos - allocate(dhdy_rot(isc:iec, jsc:jec)) !global indices without halos - - ssh = 0.0_ESMF_KIND_R8 - dhdx = 0.0_ESMF_KIND_R8 - dhdy = 0.0_ESMF_KIND_R8 - - ! Make a copy of ssh in order to do a halo update (ssh has local indexing with halos) - do j = ocean_grid%jsc, ocean_grid%jec - jloc = j + ocean_grid%jdg_offset - do i = ocean_grid%isc,ocean_grid%iec - iloc = i + ocean_grid%idg_offset - ssh(i,j) = ocean_public%sea_lev(iloc,jloc) - end do + end do + + ! d/dy ssh + ! This is a simple second-order difference + ! dhdy(i,j) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) + + do jglob = jsc, jec + j = jglob + ocean_grid%jsc - jsc + do iglob = isc,iec + i = iglob + ocean_grid%isc - isc + ! This is a PLM slope which might be less prone to the A-ocean_grid null mode + slp_L = ssh(i,J) - ssh(i,J-1) * ocean_grid%mask2dCv(i,j-1) + if (ocean_grid%mask2dCv(i,j-1)==0.) slp_L = 0. + slp_R = ssh(i,J+1) - ssh(i,J) * ocean_grid%mask2dCv(i,j) + if (ocean_grid%mask2dCv(i,j+1)==0.) slp_R = 0. + slp_C = 0.5 * (slp_L + slp_R) + if ((slp_L * slp_R) > 0.0) then + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + else + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 + end if + dhdy(iglob,jglob) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) + if (ocean_grid%mask2dT(i,j)==0.) dhdy(iglob,jglob) = 0.0 end do + end do + + ! rotate slopes from tripolar grid back to lat/lon grid, x,y => latlon (CCW) + ! "ocean_grid" uses has halos and uses local indexing. + + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) + ocean_grid%sin_rot(ig,jg)*dhdy(i,j) + dhdy_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) - ocean_grid%sin_rot(ig,jg)*dhdx(i,j) + end do + end do + + call State_SetExport(exportState, 'sea_surface_slope_zonal', & + isc, iec, jsc, jec, dhdx_rot, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call State_SetExport(exportState, 'sea_surface_slope_merid', & + isc, iec, jsc, jec, dhdy_rot, ocean_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + deallocate(ssh, dhdx, dhdy, dhdx_rot, dhdy_rot) + +end subroutine mom_export - ! Update halo of ssh so we can calculate gradients (local indexing) - call pass_var(ssh, ocean_grid%domain) - - ! d/dx ssh - ! This is a simple second-order difference - ! dhdx(i,j) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) - - do jglob = jsc, jec - j = jglob + ocean_grid%jsc - jsc - do iglob = isc,iec - i = iglob + ocean_grid%isc - isc - ! This is a PLM slope which might be less prone to the A-grid null mode - slp_L = (ssh(I,j) - ssh(I-1,j)) * ocean_grid%mask2dCu(i-1,j) - if (ocean_grid%mask2dCu(i-1,j)==0.) slp_L = 0. - slp_R = (ssh(I+1,j) - ssh(I,j)) * ocean_grid%mask2dCu(i,j) - if (ocean_grid%mask2dCu(i+1,j)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - if ( (slp_L * slp_R) > 0.0 ) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - dhdx(iglob,jglob) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) dhdx(iglob,jglob) = 0.0 - end do - end do +!=============================================================================== - ! d/dy ssh - ! This is a simple second-order difference - ! dhdy(i,j) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) - - do jglob = jsc, jec - j = jglob + ocean_grid%jsc - jsc - do iglob = isc,iec - i = iglob + ocean_grid%isc - isc - ! This is a PLM slope which might be less prone to the A-ocean_grid null mode - slp_L = ssh(i,J) - ssh(i,J-1) * ocean_grid%mask2dCv(i,j-1) - if (ocean_grid%mask2dCv(i,j-1)==0.) slp_L = 0. - slp_R = ssh(i,J+1) - ssh(i,J) * ocean_grid%mask2dCv(i,j) - if (ocean_grid%mask2dCv(i,j+1)==0.) slp_R = 0. - slp_C = 0.5 * (slp_L + slp_R) - if ((slp_L * slp_R) > 0.0) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) - else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 - end if - dhdy(iglob,jglob) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) - if (ocean_grid%mask2dT(i,j)==0.) dhdy(iglob,jglob) = 0.0 - end do - end do +subroutine State_GetFldPtr_1d(State, fldname, fldptr, rc) + type(ESMF_State) , intent(in) :: State + character(len=*) , intent(in) :: fldname + real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:) + integer, optional , intent(out) :: rc - ! rotate slopes from tripolar grid back to lat/lon grid, x,y => latlon (CCW) - ! "ocean_grid" uses has halos and uses local indexing. + ! local variables + type(ESMF_Field) :: lfield + integer :: lrc + character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) + ocean_grid%sin_rot(ig,jg)*dhdy(i,j) - dhdy_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) - ocean_grid%sin_rot(ig,jg)*dhdx(i,j) - end do - end do + call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call State_SetExport(exportState, 'sea_surface_slope_zonal', & - isc, iec, jsc, jec, dhdx_rot, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (present(rc)) rc = lrc - call State_SetExport(exportState, 'sea_surface_slope_merid', & - isc, iec, jsc, jec, dhdy_rot, ocean_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out +end subroutine State_GetFldPtr_1d - deallocate(ssh, dhdx, dhdy, dhdx_rot, dhdy_rot) +!=============================================================================== - end subroutine mom_export +subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc) + type(ESMF_State) , intent(in) :: State + character(len=*) , intent(in) :: fldname + real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:,:) + integer, optional , intent(out) :: rc -!=============================================================================== + ! local variables + type(ESMF_Field) :: lfield + integer :: lrc + character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' - subroutine State_GetFldPtr_1d(State, fldname, fldptr, rc) - type(ESMF_State) , intent(in) :: State - character(len=*) , intent(in) :: fldname - real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:) - integer, optional , intent(out) :: rc + call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ! local variables - type(ESMF_Field) :: lfield - integer :: lrc - character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' + if (present(rc)) rc = lrc - call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out +end subroutine State_GetFldPtr_2d - if (present(rc)) rc = lrc +!=============================================================================== - end subroutine State_GetFldPtr_1d +subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, rc) + + ! ---------------------------------------------- + ! Map import state field to output array + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fldname + integer , intent(in) :: isc + integer , intent(in) :: iec + integer , intent(in) :: jsc + integer , intent(in) :: jec + real (ESMF_KIND_R8) , intent(inout) :: output(isc:iec,jsc:jec) + logical, optional , intent(in) :: do_sum + integer , intent(out) :: rc + + ! local variables + type(ESMF_StateItem_Flag) :: itemFlag + integer :: n, i, j, i1, j1 + integer :: lbnd1,lbnd2 + real(ESMF_KIND_R8), pointer :: dataPtr1d(:) + real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) + character(len=*) , parameter :: subname='(mom_cap_methods:state_getimport)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(State, trim(fldname), itemFlag, rc=rc) + if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then + + if (geomtype == ESMF_GEOMTYPE_MESH) then + + ! get field pointer + call state_getfldptr(state, trim(fldname), dataptr1d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! determine output array + n = 0 + do j = jsc,jec + do i = isc,iec + n = n + 1 + if (present(do_sum)) then + output(i,j) = output(i,j) + dataPtr1d(n) + else + output(i,j) = dataPtr1d(n) + end if + end do + end do + + else if (geomtype == ESMF_GEOMTYPE_GRID) then + + call state_getfldptr(state, trim(fldname), dataptr2d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr2d,1) + lbnd2 = lbound(dataPtr2d,2) + + do j = jsc, jec + j1 = j + lbnd2 - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + if (present(do_sum)) then + output(i,j) = output(i,j) + dataPtr2d(i1,j1) + else + output(i,j) = dataPtr2d(i1,j1) + end if + end do + end do + + end if + + end if + +end subroutine State_GetImport !=============================================================================== - subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc) - type(ESMF_State) , intent(in) :: State - character(len=*) , intent(in) :: fldname - real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:,:) - integer, optional , intent(out) :: rc - - ! local variables - type(ESMF_Field) :: lfield - integer :: lrc - character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' - - call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - if (present(rc)) rc = lrc - - end subroutine State_GetFldPtr_2d - - !=============================================================================== - - subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, rc) - - ! ---------------------------------------------- - ! Map import state field to output array - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_State) , intent(in) :: state - character(len=*) , intent(in) :: fldname - integer , intent(in) :: isc - integer , intent(in) :: iec - integer , intent(in) :: jsc - integer , intent(in) :: jec - real (ESMF_KIND_R8) , intent(inout) :: output(isc:iec,jsc:jec) - logical, optional , intent(in) :: do_sum - integer , intent(out) :: rc - - ! local variables - type(ESMF_StateItem_Flag) :: itemFlag - integer :: n, i, j, i1, j1 - integer :: lbnd1,lbnd2 - real(ESMF_KIND_R8), pointer :: dataPtr1d(:) - real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) - character(len=*) , parameter :: subname='(mom_cap_methods:state_getimport)' - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_StateGet(State, trim(fldname), itemFlag, rc=rc) - if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then - - if (geomtype == ESMF_GEOMTYPE_MESH) then - - ! get field pointer - call state_getfldptr(state, trim(fldname), dataptr1d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! determine output array - n = 0 - do j = jsc,jec - do i = isc,iec - n = n + 1 - if (present(do_sum)) then - output(i,j) = output(i,j) + dataPtr1d(n) - else - output(i,j) = dataPtr1d(n) - end if - end do - end do - - else if (geomtype == ESMF_GEOMTYPE_GRID) then - - call state_getfldptr(state, trim(fldname), dataptr2d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - lbnd1 = lbound(dataPtr2d,1) - lbnd2 = lbound(dataPtr2d,2) - - do j = jsc, jec - j1 = j + lbnd2 - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - if (present(do_sum)) then - output(i,j) = output(i,j) + dataPtr2d(i1,j1) - else - output(i,j) = dataPtr2d(i1,j1) - end if - end do - end do - - end if - - end if - - end subroutine State_GetImport - - !=============================================================================== - - subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid, rc) - - ! ---------------------------------------------- - ! Map input array to export state - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_State) , intent(inout) :: state - character(len=*) , intent(in) :: fldname - integer , intent(in) :: isc - integer , intent(in) :: iec - integer , intent(in) :: jsc - integer , intent(in) :: jec - real (ESMF_KIND_R8) , intent(in) :: input(isc:iec,jsc:jec) - type(ocean_grid_type) , intent(in) :: ocean_grid - integer , intent(out) :: rc - - ! local variables - type(ESMF_StateItem_Flag) :: itemFlag - integer :: n, i, j, i1, j1, ig,jg - integer :: lbnd1,lbnd2 - real(ESMF_KIND_R8), pointer :: dataPtr1d(:) - real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) - character(len=*) , parameter :: subname='(mom_cap_methods:state_setexport)' - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - - ! Indexing notes: - ! input array from "ocean_public" uses local indexing without halos - ! mask from "ocean_grid" uses local indexing with halos - - call ESMF_StateGet(State, trim(fldname), itemFlag, rc=rc) - if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then - - if (geomtype == ESMF_GEOMTYPE_MESH) then - - call state_getfldptr(state, trim(fldname), dataptr1d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - n = 0 - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - n = n+1 - dataPtr1d(n) = input(i,j) * ocean_grid%mask2dT(ig,jg) - end do - end do - - else if (geomtype == ESMF_GEOMTYPE_GRID) then - - call state_getfldptr(state, trim(fldname), dataptr2d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - lbnd1 = lbound(dataPtr2d,1) - lbnd2 = lbound(dataPtr2d,2) - - do j = jsc, jec - j1 = j + lbnd2 - jsc - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + ocean_grid%isc - isc - dataPtr2d(i1,j1) = input(i,j) * ocean_grid%mask2dT(ig,jg) - end do - end do - - end if - - end if - - end subroutine State_SetExport +subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid, rc) + + ! ---------------------------------------------- + ! Map input array to export state + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State) , intent(inout) :: state + character(len=*) , intent(in) :: fldname + integer , intent(in) :: isc + integer , intent(in) :: iec + integer , intent(in) :: jsc + integer , intent(in) :: jec + real (ESMF_KIND_R8) , intent(in) :: input(isc:iec,jsc:jec) + type(ocean_grid_type) , intent(in) :: ocean_grid + integer , intent(out) :: rc + + ! local variables + type(ESMF_StateItem_Flag) :: itemFlag + integer :: n, i, j, i1, j1, ig,jg + integer :: lbnd1,lbnd2 + real(ESMF_KIND_R8), pointer :: dataPtr1d(:) + real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) + character(len=*) , parameter :: subname='(mom_cap_methods:state_setexport)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + ! Indexing notes: + ! input array from "ocean_public" uses local indexing without halos + ! mask from "ocean_grid" uses local indexing with halos + + call ESMF_StateGet(State, trim(fldname), itemFlag, rc=rc) + if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then + + if (geomtype == ESMF_GEOMTYPE_MESH) then + + call state_getfldptr(state, trim(fldname), dataptr1d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + n = 0 + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + n = n+1 + dataPtr1d(n) = input(i,j) * ocean_grid%mask2dT(ig,jg) + end do + end do + + else if (geomtype == ESMF_GEOMTYPE_GRID) then + + call state_getfldptr(state, trim(fldname), dataptr2d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr2d,1) + lbnd2 = lbound(dataPtr2d,2) + + do j = jsc, jec + j1 = j + lbnd2 - jsc + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + ig = i + ocean_grid%isc - isc + dataPtr2d(i1,j1) = input(i,j) * ocean_grid%mask2dT(ig,jg) + end do + end do + + end if + + end if + +end subroutine State_SetExport end module mom_cap_methods diff --git a/config_src/nuopc_driver/mom_cap_time.F90 b/config_src/nuopc_driver/mom_cap_time.F90 index 7da3cf842d..bd26785f54 100644 --- a/config_src/nuopc_driver/mom_cap_time.F90 +++ b/config_src/nuopc_driver/mom_cap_time.F90 @@ -8,418 +8,417 @@ ! module mom_cap_time - ! !USES: - use ESMF , only : ESMF_Time, ESMF_Clock, ESMF_Calendar, ESMF_Alarm - use ESMF , only : ESMF_TimeGet, ESMF_TimeSet - use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet - use ESMF , only : ESMF_ClockGet, ESMF_AlarmCreate - use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO - use ESMF , only : ESMF_LogSetError, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU - use ESMF , only : ESMF_RC_ARG_BAD - use ESMF , only : operator(<), operator(/=), operator(+), operator(-), operator(*) , operator(>=) - use ESMF , only : operator(<=), operator(>), operator(==) - - implicit none - private ! default private - - public :: AlarmInit ! initialize an alarm - - private :: TimeInit - private :: date2ymd - - ! Clock and alarm options - character(len=*), private, parameter :: & - optNONE = "none" , & - optNever = "never" , & - optNSteps = "nsteps" , & - optNStep = "nstep" , & - optNSeconds = "nseconds" , & - optNSecond = "nsecond" , & - optNMinutes = "nminutes" , & - optNMinute = "nminute" , & - optNHours = "nhours" , & - optNHour = "nhour" , & - optNDays = "ndays" , & - optNDay = "nday" , & - optNMonths = "nmonths" , & - optNMonth = "nmonth" , & - optNYears = "nyears" , & - optNYear = "nyear" , & - optMonthly = "monthly" , & - optYearly = "yearly" , & - optDate = "date" , & - optIfdays0 = "ifdays0" , & - optGLCCouplingPeriod = "glc_coupling_period" - - ! Module data - integer, parameter :: SecPerDay = 86400 ! Seconds per day - character(len=*), parameter :: u_FILE_u = & - __FILE__ +! !USES: +use ESMF , only : ESMF_Time, ESMF_Clock, ESMF_Calendar, ESMF_Alarm +use ESMF , only : ESMF_TimeGet, ESMF_TimeSet +use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet +use ESMF , only : ESMF_ClockGet, ESMF_AlarmCreate +use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO +use ESMF , only : ESMF_LogSetError, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU +use ESMF , only : ESMF_RC_ARG_BAD +use ESMF , only : operator(<), operator(/=), operator(+), operator(-), operator(*) , operator(>=) +use ESMF , only : operator(<=), operator(>), operator(==) + +implicit none; private + +public :: AlarmInit ! initialize an alarm + +private :: TimeInit +private :: date2ymd + +! Clock and alarm options +character(len=*), private, parameter :: & + optNONE = "none" , & + optNever = "never" , & + optNSteps = "nsteps" , & + optNStep = "nstep" , & + optNSeconds = "nseconds" , & + optNSecond = "nsecond" , & + optNMinutes = "nminutes" , & + optNMinute = "nminute" , & + optNHours = "nhours" , & + optNHour = "nhour" , & + optNDays = "ndays" , & + optNDay = "nday" , & + optNMonths = "nmonths" , & + optNMonth = "nmonth" , & + optNYears = "nyears" , & + optNYear = "nyear" , & + optMonthly = "monthly" , & + optYearly = "yearly" , & + optDate = "date" , & + optIfdays0 = "ifdays0" , & + optGLCCouplingPeriod = "glc_coupling_period" + +! Module data +integer, parameter :: SecPerDay = 86400 ! Seconds per day +character(len=*), parameter :: u_FILE_u = & + __FILE__ !=============================================================================== contains !=============================================================================== - subroutine AlarmInit( clock, alarm, option, & - opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) - - ! !DESCRIPTION: Setup an alarm in a clock - ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm - ! time. If you send an arbitrary but proper ringtime from the - ! past and the ring interval, the alarm will always go off on the - ! next clock advance and this will cause serious problems. Even - ! if it makes sense to initialize an alarm with some reference - ! time and the alarm interval, that reference time has to be - ! advance forward to be >= the current time. In the logic below - ! we set an appropriate "NextAlarm" and then we make sure to - ! advance it properly based on the ring interval. - - ! input/output variables - type(ESMF_Clock) , intent(inout) :: clock ! clock - type(ESMF_Alarm) , intent(inout) :: alarm ! alarm - character(len=*) , intent(in) :: option ! alarm option - integer , optional , intent(in) :: opt_n ! alarm freq - integer , optional , intent(in) :: opt_ymd ! alarm ymd - integer , optional , intent(in) :: opt_tod ! alarm tod (sec) - type(ESMF_Time) , optional , intent(in) :: RefTime ! ref time - character(len=*) , optional , intent(in) :: alarmname ! alarm name - integer , intent(inout) :: rc ! Return code - - ! local variables - type(ESMF_Calendar) :: cal ! calendar - integer :: lymd ! local ymd - integer :: ltod ! local tod - integer :: cyy,cmm,cdd,csec ! time info - integer :: nyy,nmm,ndd,nsec ! time info - character(len=64) :: lalarmname ! local alarm name - logical :: update_nextalarm ! update next alarm - type(ESMF_Time) :: CurrTime ! Current Time - type(ESMF_Time) :: NextAlarm ! Next restart alarm time - type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval - character(len=*), parameter :: subname = '(AlarmInit): ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - lalarmname = 'alarm_unknown' - if (present(alarmname)) lalarmname = trim(alarmname) - ltod = 0 - if (present(opt_tod)) ltod = opt_tod - lymd = -1 - if (present(opt_ymd)) lymd = opt_ymd - - ! verify parameters - if (trim(option) == optNSteps .or. trim(option) == optNStep .or. & - trim(option) == optNSeconds .or. trim(option) == optNSecond .or. & - trim(option) == optNMinutes .or. trim(option) == optNMinute .or. & - trim(option) == optNHours .or. trim(option) == optNHour .or. & - trim(option) == optNDays .or. trim(option) == optNDay .or. & - trim(option) == optNMonths .or. trim(option) == optNMonth .or. & - trim(option) == optNYears .or. trim(option) == optNYear .or. & - trim(option) == optIfdays0) then - if (.not. present(opt_n)) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//trim(option)//' requires opt_n', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return - end if - if (opt_n <= 0) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//trim(option)//' invalid opt_n', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return - end if - endif - - call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - - call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - - call ESMF_TimeGet(CurrTime, yy=nyy, mm=nmm, dd=ndd, s=nsec, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - - ! initial guess of next alarm, this will be updated below - if (present(RefTime)) then - NextAlarm = RefTime - else - NextAlarm = CurrTime - endif - - ! Determine calendar - call ESMF_ClockGet(clock, calendar=cal, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - - ! Determine inputs for call to create alarm - selectcase (trim(option)) - - case (optNONE, optNever) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - update_nextalarm = .false. - - case (optDate) - if (.not. present(opt_ymd)) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//trim(option)//' requires opt_ymd', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return - end if - if (lymd < 0 .or. ltod < 0) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//trim(option)//'opt_ymd, opt_tod invalid', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return - end if - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - call TimeInit(NextAlarm, lymd, cal, tod=ltod, desc="optDate", rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - update_nextalarm = .false. - - case (optIfdays0) - if (.not. present(opt_ymd)) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//trim(option)//' requires opt_ymd', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return - end if - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=opt_n, s=0, calendar=cal, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - update_nextalarm = .true. - - case (optNSteps, optNStep) - call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNSeconds, optNSecond) - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMinutes, optNMinute) - call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNHours, optNHour) - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNDays, optNDay) - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMonths, optNMonth) - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optMonthly) - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - update_nextalarm = .true. - - case (optNYears, optNYear) - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optYearly) - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - update_nextalarm = .true. - - case default - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//' unknown option: '//trim(option), & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) +subroutine AlarmInit( clock, alarm, option, & + opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) + + ! !DESCRIPTION: Setup an alarm in a clock + ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm + ! time. If you send an arbitrary but proper ringtime from the + ! past and the ring interval, the alarm will always go off on the + ! next clock advance and this will cause serious problems. Even + ! if it makes sense to initialize an alarm with some reference + ! time and the alarm interval, that reference time has to be + ! advance forward to be >= the current time. In the logic below + ! we set an appropriate "NextAlarm" and then we make sure to + ! advance it properly based on the ring interval. + + ! input/output variables + type(ESMF_Clock) , intent(inout) :: clock ! clock + type(ESMF_Alarm) , intent(inout) :: alarm ! alarm + character(len=*) , intent(in) :: option ! alarm option + integer , optional , intent(in) :: opt_n ! alarm freq + integer , optional , intent(in) :: opt_ymd ! alarm ymd + integer , optional , intent(in) :: opt_tod ! alarm tod (sec) + type(ESMF_Time) , optional , intent(in) :: RefTime ! ref time + character(len=*) , optional , intent(in) :: alarmname ! alarm name + integer , intent(inout) :: rc ! Return code + + ! local variables + type(ESMF_Calendar) :: cal ! calendar + integer :: lymd ! local ymd + integer :: ltod ! local tod + integer :: cyy,cmm,cdd,csec ! time info + integer :: nyy,nmm,ndd,nsec ! time info + character(len=64) :: lalarmname ! local alarm name + logical :: update_nextalarm ! update next alarm + type(ESMF_Time) :: CurrTime ! Current Time + type(ESMF_Time) :: NextAlarm ! Next restart alarm time + type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval + character(len=*), parameter :: subname = '(AlarmInit): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lalarmname = 'alarm_unknown' + if (present(alarmname)) lalarmname = trim(alarmname) + ltod = 0 + if (present(opt_tod)) ltod = opt_tod + lymd = -1 + if (present(opt_ymd)) lymd = opt_ymd + + ! verify parameters + if (trim(option) == optNSteps .or. trim(option) == optNStep .or. & + trim(option) == optNSeconds .or. trim(option) == optNSecond .or. & + trim(option) == optNMinutes .or. trim(option) == optNMinute .or. & + trim(option) == optNHours .or. trim(option) == optNHour .or. & + trim(option) == optNDays .or. trim(option) == optNDay .or. & + trim(option) == optNMonths .or. trim(option) == optNMonth .or. & + trim(option) == optNYears .or. trim(option) == optNYear .or. & + trim(option) == optIfdays0) then + if (.not. present(opt_n)) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' requires opt_n', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + if (opt_n <= 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' invalid opt_n', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + endif + + call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & return - end select - - ! -------------------------------------------------------------------------------- - ! --- AlarmInterval and NextAlarm should be set --- - ! -------------------------------------------------------------------------------- - - ! --- advance Next Alarm so it won't ring on first timestep for - ! --- most options above. go back one alarminterval just to be careful - - if (update_nextalarm) then - NextAlarm = NextAlarm - AlarmInterval - do while (NextAlarm <= CurrTime) - NextAlarm = NextAlarm + AlarmInterval - enddo - endif - - alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, ringInterval=AlarmInterval, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return - - end subroutine AlarmInit - - !=============================================================================== - - subroutine TimeInit( Time, ymd, cal, tod, desc, logunit, rc) - - ! Create the ESMF_Time object corresponding to the given input time, given in - ! YMD (Year Month Day) and TOD (Time-of-day) format. - ! Set the time by an integer as YYYYMMDD and integer seconds in the day - - ! input/output parameters: - type(ESMF_Time) , intent(inout) :: Time ! ESMF time - integer , intent(in) :: ymd ! year, month, day YYYYMMDD - type(ESMF_Calendar) , intent(in) :: cal ! ESMF calendar - integer , intent(in), optional :: tod ! time of day in seconds - character(len=*) , intent(in), optional :: desc ! description of time to set - integer , intent(in), optional :: logunit - integer , intent(out), optional :: rc - - ! local varaibles - integer :: yr, mon, day ! Year, month, day as integers - integer :: ltod ! local tod - character(len=256) :: ldesc ! local desc - character(len=*), parameter :: subname = '(TimeInit) ' - !------------------------------------------------------------------------------- - - ltod = 0 - if (present(tod)) ltod = tod - ldesc = '' - if (present(desc)) ldesc = desc - - if ( (ymd < 0) .or. (ltod < 0) .or. (ltod > SecPerDay) )then - if (present(logunit)) then - write(logunit,*) subname//': ERROR yymmdd is a negative number or '// & - 'time-of-day out of bounds', ymd, ltod - end if - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//' yymmdd is negative or time-of-day out of bounds ', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) + call ESMF_TimeGet(CurrTime, yy=nyy, mm=nmm, dd=ndd, s=nsec, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & return - end if - call date2ymd (ymd,yr,mon,day) + ! initial guess of next alarm, this will be updated below + if (present(RefTime)) then + NextAlarm = RefTime + else + NextAlarm = CurrTime + endif + + ! Determine calendar + call ESMF_ClockGet(clock, calendar=cal, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + + ! Determine inputs for call to create alarm + selectcase (trim(option)) + + case (optNONE, optNever) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .false. + + case (optDate) + if (.not. present(opt_ymd)) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' requires opt_ymd', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + if (lymd < 0 .or. ltod < 0) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//'opt_ymd, opt_tod invalid', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call TimeInit(NextAlarm, lymd, cal, tod=ltod, desc="optDate", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .false. + + case (optIfdays0) + if (.not. present(opt_ymd)) then + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' requires opt_ymd', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=opt_n, s=0, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .true. + + case (optNSteps, optNStep) + call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNSeconds, optNSecond) + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMinutes, optNMinute) + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNHours, optNHour) + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNDays, optNDay) + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMonths, optNMonth) + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optMonthly) + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .true. + + case (optNYears, optNYear) + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optYearly) + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + update_nextalarm = .true. + + case default + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//' unknown option: '//trim(option), & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + + end select + + ! -------------------------------------------------------------------------------- + ! --- AlarmInterval and NextAlarm should be set --- + ! -------------------------------------------------------------------------------- + + ! --- advance Next Alarm so it won't ring on first timestep for + ! --- most options above. go back one alarminterval just to be careful + + if (update_nextalarm) then + NextAlarm = NextAlarm - AlarmInterval + do while (NextAlarm <= CurrTime) + NextAlarm = NextAlarm + AlarmInterval + enddo + endif + + alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, ringInterval=AlarmInterval, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + +end subroutine AlarmInit - call ESMF_TimeSet( Time, yy=yr, mm=mon, dd=day, s=ltod, calendar=cal, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return +!=============================================================================== + +subroutine TimeInit( Time, ymd, cal, tod, desc, logunit, rc) + + ! Create the ESMF_Time object corresponding to the given input time, given in + ! YMD (Year Month Day) and TOD (Time-of-day) format. + ! Set the time by an integer as YYYYMMDD and integer seconds in the day + + ! input/output parameters: + type(ESMF_Time) , intent(inout) :: Time ! ESMF time + integer , intent(in) :: ymd ! year, month, day YYYYMMDD + type(ESMF_Calendar) , intent(in) :: cal ! ESMF calendar + integer , intent(in), optional :: tod ! time of day in seconds + character(len=*) , intent(in), optional :: desc ! description of time to set + integer , intent(in), optional :: logunit + integer , intent(out), optional :: rc + + ! local varaibles + integer :: yr, mon, day ! Year, month, day as integers + integer :: ltod ! local tod + character(len=256) :: ldesc ! local desc + character(len=*), parameter :: subname = '(TimeInit) ' + !------------------------------------------------------------------------------- + + ltod = 0 + if (present(tod)) ltod = tod + ldesc = '' + if (present(desc)) ldesc = desc + + if ( (ymd < 0) .or. (ltod < 0) .or. (ltod > SecPerDay) )then + if (present(logunit)) then + write(logunit,*) subname//': ERROR yymmdd is a negative number or '// & + 'time-of-day out of bounds', ymd, ltod + end if + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//' yymmdd is negative or time-of-day out of bounds ', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return + end if + + call date2ymd (ymd,yr,mon,day) + + call ESMF_TimeSet( Time, yy=yr, mm=mon, dd=day, s=ltod, calendar=cal, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return - end subroutine TimeInit +end subroutine TimeInit - !=============================================================================== +!=============================================================================== - subroutine date2ymd (date, year, month, day) +subroutine date2ymd (date, year, month, day) - ! input/output variables - integer, intent(in) :: date ! coded-date (yyyymmdd) - integer, intent(out) :: year,month,day ! calendar year,month,day + ! input/output variables + integer, intent(in) :: date ! coded-date (yyyymmdd) + integer, intent(out) :: year,month,day ! calendar year,month,day - ! local variables - integer :: tdate ! temporary date - character(*),parameter :: subName = "(date2ymd)" - !------------------------------------------------------------------------------- + ! local variables + integer :: tdate ! temporary date + character(*),parameter :: subName = "(date2ymd)" + !------------------------------------------------------------------------------- - tdate = abs(date) - year = int(tdate/10000) - if (date < 0) then - year = -year - end if - month = int( mod(tdate,10000)/ 100) - day = mod(tdate, 100) + tdate = abs(date) + year = int(tdate/10000) + if (date < 0) then + year = -year + end if + month = int( mod(tdate,10000)/ 100) + day = mod(tdate, 100) - end subroutine date2ymd +end subroutine date2ymd end module diff --git a/config_src/nuopc_driver/time_utils.F90 b/config_src/nuopc_driver/time_utils.F90 index f009a72e8e..430114840d 100644 --- a/config_src/nuopc_driver/time_utils.F90 +++ b/config_src/nuopc_driver/time_utils.F90 @@ -1,161 +1,160 @@ module time_utils_mod - use fms_mod, only: uppercase - use mpp_mod, only: mpp_error, FATAL - use time_manager_mod, only: time_type, set_time, set_date, get_date - use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR - use time_manager_mod, only: fms_get_calendar_type => get_calendar_type - use ESMF - - implicit none - private - - !-------------------- interface blocks --------------------- - interface fms2esmf_cal - module procedure fms2esmf_cal_c - module procedure fms2esmf_cal_i - end interface fms2esmf_cal - interface esmf2fms_time - module procedure esmf2fms_time_t - module procedure esmf2fms_timestep - end interface esmf2fms_time - - public fms2esmf_cal - public esmf2fms_time - public fms2esmf_time - public string_to_date - - contains - - !-------------------- module code --------------------- - - function fms2esmf_cal_c(calendar) +use fms_mod, only: uppercase +use mpp_mod, only: mpp_error, FATAL +use time_manager_mod, only: time_type, set_time, set_date, get_date +use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR +use time_manager_mod, only: fms_get_calendar_type => get_calendar_type +use ESMF + +implicit none; private + +!-------------------- interface blocks --------------------- +interface fms2esmf_cal + module procedure fms2esmf_cal_c + module procedure fms2esmf_cal_i +end interface fms2esmf_cal +interface esmf2fms_time + module procedure esmf2fms_time_t + module procedure esmf2fms_timestep +end interface esmf2fms_time + +public fms2esmf_cal +public esmf2fms_time +public fms2esmf_time +public string_to_date + +contains + +!-------------------- module code --------------------- + +function fms2esmf_cal_c(calendar) ! ! Return Value: - type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_c + type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_c ! ! Arguments: - character(len=*), intent(in) :: calendar - - select case( uppercase(trim(calendar)) ) - case( 'GREGORIAN' ) - fms2esmf_cal_c = ESMF_CALKIND_GREGORIAN - case( 'JULIAN' ) - fms2esmf_cal_c = ESMF_CALKIND_JULIAN - case( 'NOLEAP' ) - fms2esmf_cal_c = ESMF_CALKIND_NOLEAP - case( 'THIRTY_DAY' ) - fms2esmf_cal_c = ESMF_CALKIND_360DAY - case( 'NO_CALENDAR' ) - fms2esmf_cal_c = ESMF_CALKIND_NOCALENDAR - case default - call mpp_error(FATAL, & - 'ocean_solo: ocean_solo_nml entry calendar must be one of GREGORIAN|JULIAN|NOLEAP|THIRTY_DAY|NO_CALENDAR.' ) - end select - end function fms2esmf_cal_c - - function fms2esmf_cal_i(calendar) + character(len=*), intent(in) :: calendar + + select case( uppercase(trim(calendar)) ) + case( 'GREGORIAN' ) + fms2esmf_cal_c = ESMF_CALKIND_GREGORIAN + case( 'JULIAN' ) + fms2esmf_cal_c = ESMF_CALKIND_JULIAN + case( 'NOLEAP' ) + fms2esmf_cal_c = ESMF_CALKIND_NOLEAP + case( 'THIRTY_DAY' ) + fms2esmf_cal_c = ESMF_CALKIND_360DAY + case( 'NO_CALENDAR' ) + fms2esmf_cal_c = ESMF_CALKIND_NOCALENDAR + case default + call mpp_error(FATAL, & + 'ocean_solo: ocean_solo_nml entry calendar must be one of GREGORIAN|JULIAN|NOLEAP|THIRTY_DAY|NO_CALENDAR.' ) + end select +end function fms2esmf_cal_c + +function fms2esmf_cal_i(calendar) ! ! Return Value: - type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_i + type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_i ! ! Arguments: - integer, intent(in) :: calendar - - select case(calendar) - case(THIRTY_DAY_MONTHS) - fms2esmf_cal_i = ESMF_CALKIND_360DAY - case(GREGORIAN) - fms2esmf_cal_i = ESMF_CALKIND_GREGORIAN - case(JULIAN) - fms2esmf_cal_i = ESMF_CALKIND_JULIAN - case(NOLEAP) - fms2esmf_cal_i = ESMF_CALKIND_NOLEAP - case(NO_CALENDAR) - fms2esmf_cal_i = ESMF_CALKIND_NOCALENDAR - end select - end function fms2esmf_cal_i - - function esmf2fms_time_t(time) - ! Return Value - type(Time_type) :: esmf2fms_time_t - ! Input Arguments - type(ESMF_Time), intent(in) :: time - ! Local Variables - integer :: yy, mm, dd, h, m, s - type(ESMF_CALKIND_FLAG) :: calkind - - integer :: rc - - call ESMF_TimeGet(time, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, & - calkindflag=calkind, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - esmf2fms_time_t = Set_date(yy, mm, dd, h, m, s) - - end function esmf2fms_time_t - - function esmf2fms_timestep(timestep) - ! Return Value - type(Time_type) :: esmf2fms_timestep - ! Input Arguments - type(ESMF_TimeInterval), intent(in):: timestep - ! Local Variables - integer :: s - type(ESMF_CALKIND_FLAG) :: calkind - - integer :: rc - - call ESMF_TimeIntervalGet(timestep, s=s, calkindflag=calkind, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - esmf2fms_timestep = set_time(s, 0) - - end function esmf2fms_timestep - - function fms2esmf_time(time, calkind) - ! Return Value - type(ESMF_Time) :: fms2esmf_time - ! Input Arguments - type(Time_type), intent(in) :: time - type(ESMF_CALKIND_FLAG), intent(in), optional :: calkind - ! Local Variables - integer :: yy, mm, d, h, m, s - type(ESMF_CALKIND_FLAG) :: l_calkind - - integer :: rc - - if(present(calkind)) then - l_calkind = calkind - else - l_calkind = fms2esmf_cal(fms_get_calendar_type()) - endif - - call get_date(time, yy, mm, d, h, m, s) - - call ESMF_TimeSet(fms2esmf_time, yy=yy, mm=mm, d=d, h=h, m=m, s=s, & - calkindflag=l_calkind, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - end function fms2esmf_time - - function string_to_date(string, rc) - character(len=15), intent(in) :: string - integer, intent(out), optional :: rc - type(time_type) :: string_to_date - - integer :: yr,mon,day,hr,min,sec - - if(present(rc)) rc = ESMF_SUCCESS - - read(string, '(I4.4,I2.2,I2.2,".",I2.2,I2.2,I2.2)') yr, mon, day, hr, min, sec - string_to_date = set_date(yr, mon, day, hr, min, sec) - - end function string_to_date + integer, intent(in) :: calendar + + select case(calendar) + case(THIRTY_DAY_MONTHS) + fms2esmf_cal_i = ESMF_CALKIND_360DAY + case(GREGORIAN) + fms2esmf_cal_i = ESMF_CALKIND_GREGORIAN + case(JULIAN) + fms2esmf_cal_i = ESMF_CALKIND_JULIAN + case(NOLEAP) + fms2esmf_cal_i = ESMF_CALKIND_NOLEAP + case(NO_CALENDAR) + fms2esmf_cal_i = ESMF_CALKIND_NOCALENDAR + end select +end function fms2esmf_cal_i + +function esmf2fms_time_t(time) + ! Return Value + type(Time_type) :: esmf2fms_time_t + ! Input Arguments + type(ESMF_Time), intent(in) :: time + ! Local Variables + integer :: yy, mm, dd, h, m, s + type(ESMF_CALKIND_FLAG) :: calkind + + integer :: rc + + call ESMF_TimeGet(time, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, & + calkindflag=calkind, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + esmf2fms_time_t = Set_date(yy, mm, dd, h, m, s) + +end function esmf2fms_time_t + +function esmf2fms_timestep(timestep) + ! Return Value + type(Time_type) :: esmf2fms_timestep + ! Input Arguments + type(ESMF_TimeInterval), intent(in):: timestep + ! Local Variables + integer :: s + type(ESMF_CALKIND_FLAG) :: calkind + + integer :: rc + + call ESMF_TimeIntervalGet(timestep, s=s, calkindflag=calkind, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + esmf2fms_timestep = set_time(s, 0) + +end function esmf2fms_timestep + +function fms2esmf_time(time, calkind) + ! Return Value + type(ESMF_Time) :: fms2esmf_time + ! Input Arguments + type(Time_type), intent(in) :: time + type(ESMF_CALKIND_FLAG), intent(in), optional :: calkind + ! Local Variables + integer :: yy, mm, d, h, m, s + type(ESMF_CALKIND_FLAG) :: l_calkind + + integer :: rc + + if(present(calkind)) then + l_calkind = calkind + else + l_calkind = fms2esmf_cal(fms_get_calendar_type()) + endif + + call get_date(time, yy, mm, d, h, m, s) + + call ESMF_TimeSet(fms2esmf_time, yy=yy, mm=mm, d=d, h=h, m=m, s=s, & + calkindflag=l_calkind, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + +end function fms2esmf_time + +function string_to_date(string, rc) + character(len=15), intent(in) :: string + integer, intent(out), optional :: rc + type(time_type) :: string_to_date + + integer :: yr,mon,day,hr,min,sec + + if(present(rc)) rc = ESMF_SUCCESS + + read(string, '(I4.4,I2.2,I2.2,".",I2.2,I2.2,I2.2)') yr, mon, day, hr, min, sec + string_to_date = set_date(yr, mon, day, hr, min, sec) + +end function string_to_date end module time_utils_mod From ea32f96d5a068cef1db2a615fc80fa1a95ea0231 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 20 Mar 2019 16:55:43 -0600 Subject: [PATCH 1034/1072] Clean and Doxygenize --- .../nuopc_driver/MOM_surface_forcing.F90 | 324 +++++++++--------- 1 file changed, 154 insertions(+), 170 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index eebda0b8fc..91d3ed6e3d 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -55,93 +55,92 @@ module MOM_surface_forcing private apply_force_adjustments private surface_forcing_end -! surface_forcing_CS is a structure containing pointers to the forcing fields -! which may be used to drive MOM. All fluxes are positive downward. +!> Contains pointers to the forcing fields which may be used to drive MOM. +!! All fluxes are positive downward. 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. - logical :: use_temperature ! If true, temp and saln used as state variables + 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. + logical :: use_temperature !! If true, temp and saln used as state variables real :: wind_stress_multiplier !< A multiplier applied to incoming wind stress (nondim). - 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 - ! structure does not limit the water that can be - ! frozen out of the ocean and the ice-ocean heat - ! fluxes are treated explicitly. - logical :: use_limited_P_SSH ! 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. The default is true. - - 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 :: 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 + !! structure does not limit the water that can be + !! frozen out of the ocean and the ice-ocean heat + !! fluxes are treated explicitly. + logical :: use_limited_P_SSH !< 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. The default is true. + + 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. - gust => NULL(), & ! spatially varying unresolved background - ! 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) - real :: cd_tides ! drag coefficient that applies to the tides (nondimensional) - real :: utide ! constant tidal velocity to use if read_tideamp - ! is false, in 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 :: 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. - logical :: allow_flux_adjustments ! If true, use data_override to obtain flux adjustments - - 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 :: 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) - 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 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 - 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 - integer :: id_srestore = -1 ! id number for time_interp_external. - integer :: id_trestore = -1 ! id number for time_interp_external. + TKE_tidal => NULL(), & !< turbulent kinetic energy introduced to the + !! bottom boundary layer by drag on the tidal flows [W m-2] + gust => NULL(), & !< spatially varying unresolved background + !! 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] + 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 :: 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]. + logical :: allow_flux_adjustments !< If true, use data_override to obtain flux adjustments + + 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 :: 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] + 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 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 + 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 + integer :: id_srestore = -1 !< id number for time_interp_external. + integer :: id_trestore = -1 !< id number for time_interp_external. ! Diagnostics handles type(forcing_diags), public :: handles @@ -151,40 +150,39 @@ module MOM_surface_forcing 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(:,:) :: 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_water =>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(:,:) :: 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_water =>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(:,:) :: 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) + !< 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) + !! 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. @@ -197,9 +195,7 @@ module MOM_surface_forcing integer :: id_clock_forcing -!======================================================================= contains -!======================================================================= !> This subroutine translates the Ice_ocean_boundary_type into a MOM !! thermodynamic forcing type, including changes of units, sign conventions, @@ -223,34 +219,34 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, 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 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 + 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) @@ -463,11 +459,11 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & 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) + ! ! 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) - ! ! water flux due to sea ice and snow melt (kg/m2/s) + ! ! 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_water(i-i0,j-j0) @@ -590,8 +586,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, 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. @@ -607,26 +601,26 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, 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 @@ -876,8 +870,6 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) call cpu_clock_end(id_clock_forcing) end subroutine convert_IOB_to_forces -!======================================================================= - !> Adds thermodynamic flux adjustments obtained via data_override !! Component name is 'OCN' !! Available adjustments are: @@ -891,7 +883,7 @@ subroutine apply_flux_adjustments(G, CS, Time, fluxes) type(forcing), intent(inout) :: fluxes !< Surface fluxes structure ! Local variables - 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 logical :: overrode_h @@ -923,8 +915,6 @@ subroutine apply_flux_adjustments(G, CS, Time, fluxes) ! 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: @@ -937,8 +927,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 @@ -983,8 +973,6 @@ subroutine apply_force_adjustments(G, CS, Time, forces) end subroutine apply_force_adjustments -!======================================================================= - !> Save any restart files associated with the surface forcing. subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & filename_suffix) @@ -1005,8 +993,6 @@ subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & end subroutine forcing_save_restart -!======================================================================= - !> Initialize the surface forcing, including setting parameters and allocating permanent memory. subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, restore_temp) type(time_type), intent(in) :: Time !< The current model time @@ -1339,8 +1325,6 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res call cpu_clock_end(id_clock_forcing) end subroutine surface_forcing_init -!======================================================================= - !> 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 !< A pointer to the control structure returned by @@ -1359,8 +1343,6 @@ 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) @@ -1369,6 +1351,8 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) 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() From aefb2e328c89887b3b0ccffd1e3bab84a3de9381 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 21 Mar 2019 17:41:08 -0600 Subject: [PATCH 1035/1072] Remove space, doxygenize and add "use, only" --- config_src/nuopc_driver/mom_cap.F90 | 811 +++++++++++++++------------- 1 file changed, 423 insertions(+), 388 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 7ac1f18e2b..00e56ffac0 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -307,6 +307,8 @@ !! which to call `ocean_model_restart()`; no restarts written if set to 0 !! !! + +!> This module contains a set of subroutines that are required by NUOPC. module mom_cap_mod use constants_mod, only: constants_init use diag_manager_mod, only: diag_manager_init, diag_manager_end @@ -350,7 +352,30 @@ module mom_cap_mod use, intrinsic :: iso_fortran_env, only: output_unit -use ESMF +! TODO add only below. +use ESMF, only: ESMF_ClockAdvance, ESMF_ClockGet, ESMF_ClockPrint +use ESMF, only: ESMF_ClockGetAlarm, ESMF_ClockGetNextTime, ESMF_ClockAdvance +use ESMF, only: ESMF_ClockSet, ESMF_Clock, ESMF_GeomType_Flag, ESMF_LOGMSG_INFO +use ESMF, only: ESMF_Grid, ESMF_GridCreate, ESMF_GridAddCoord +use ESMF, only: ESMF_GridGetCoord, ESMF_GridAddItem, ESMF_GridGetItem +use ESMF, only: ESMF_GridComp, ESMF_GridCompSetEntryPoint, ESMF_GridCompGet +use ESMF, only: ESMF_LogFoundError, ESMF_LogWrite, ESMF_LogSetError +use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_GridCompGetInternalState +use ESMF, only: ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID, ESMF_SUCCESS +use ESMF, only: ESMF_METHOD_INITIALIZE, ESMF_MethodRemove, ESMF_State +use ESMF, only: ESMF_LOGMSG_INFO, ESMF_RC_ARG_BAD, ESMF_VM, ESMF_Time +use ESMF, only: ESMF_TimeInterval, ESMF_MAXSTR, ESMF_VMGetCurrent +use ESMF, only: ESMF_VMGet, ESMF_TimeGet, ESMF_TimeIntervalGet +use ESMF, only: ESMF_MethodExecute, ESMF_Mesh, ESMF_DeLayout, ESMF_Distgrid +use ESMF, only: ESMF_DistGridConnection, ESMF_StateItem_Flag, ESMF_KIND_I4 +use ESMF, only: ESMF_KIND_I8, ESMF_FAILURE, ESMF_DistGridCreate, ESMF_MeshCreate +use ESMF, only: ESMF_FILEFORMAT_ESMFMESH, ESMF_DELayoutCreate, ESMF_DistGridConnectionSet +use ESMF, only: ESMF_DistGridGet, ESMF_STAGGERLOC_CORNER, ESMF_GRIDITEM_MASK +use ESMF, only: ESMF_TYPEKIND_I4, ESMF_TYPEKIND_R8, ESMF_STAGGERLOC_CENTER, +use ESMF, only: ESMF_GRIDITEM_AREA, ESMF_Field, ESMF_ALARM, ESMF_VMLogMemInfo +use ESMF, only: ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_StateRemove +use ESMF, only: ESMF_FieldCreate + use NUOPC use NUOPC_Model, & model_routine_SS => SetServices, & @@ -359,20 +384,29 @@ module mom_cap_mod model_label_SetRunClock => label_SetRunClock, & model_label_Finalize => label_Finalize +! TODO GMM, where are these coming from? thye do not have an explicit fortran interface +! ESMF_GridCompGetInternalState +! +! And these? +! ESMF_LOGERR_PASSTHRU implicit none; private public SetServices +!> Internal state type with pointers to three types defined by MOM. type ocean_internalstate_type type(ocean_public_type), pointer :: ocean_public_type_ptr type(ocean_state_type), pointer :: ocean_state_type_ptr type(ice_ocean_boundary_type), pointer :: ice_ocean_boundary_type_ptr end type +!> Wrapper-derived type required to associate an internal state instance +!! with the ESMF/NUOPC component type ocean_internalstate_wrapper type(ocean_internalstate_type), pointer :: ptr end type +!> Contains field information type fld_list_type character(len=64) :: stdname character(len=64) :: shortname @@ -390,8 +424,8 @@ module mom_cap_mod integer :: export_slice = 1 character(len=256) :: tmpstr logical :: write_diagnostics = .false. -character(len=32) :: runtype ! run type -integer :: logunit ! stdout logging unit number +character(len=32) :: runtype !< run type +integer :: logunit !< stdout logging unit number logical :: profile_memory = .true. logical :: grid_attach_area = .false. character(len=128) :: scalar_field_name = '' @@ -409,11 +443,8 @@ module mom_cap_mod type(ESMF_GeomType_Flag) :: geomtype = ESMF_GEOMTYPE_GRID #endif -!======================================================================= contains -!======================================================================= -!=============================================================================== !> NUOPC SetService method is the only public entry point. !! SetServices registers all of the user-provided subroutines !! in the module with the NUOPC layer. @@ -422,8 +453,10 @@ module mom_cap_mod !! @param rc return code subroutine SetServices(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + type(ESMF_GridComp) :: gcomp !< an ESMF_GridComp object + integer, intent(out) :: rc !< return code + + ! local variables character(len=*),parameter :: subname='(mom_cap:SetServices)' rc = ESMF_SUCCESS @@ -496,8 +529,6 @@ subroutine SetServices(gcomp, rc) end subroutine SetServices -!=============================================================================== - !> First initialize subroutine called by NUOPC. The purpose !! is to set which version of the Initialize Phase Definition (IPD) !! to use. @@ -510,11 +541,13 @@ end subroutine SetServices !! @param clock an ESMF_Clock object !! @param rc return code subroutine InitializeP0(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc + type(ESMF_GridComp) :: gcomp !< ESMF_GridComp object + type(ESMF_State) :: importState, exportState !< ESMF_State object for + !! import/export fields + type(ESMF_Clock) :: clock !< ESMF_Clock object + integer, intent(out) :: rc !< return code + ! local variables logical :: isPresent, isSet integer :: iostat character(len=64) :: value, logmsg @@ -587,9 +620,9 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) scalar_field_name = trim(value) call ESMF_LogWrite('mom_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return endif scalar_field_count = 0 @@ -602,17 +635,17 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_count if (iostat /= 0) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": ScalarFieldCount not an integer: "//trim(value), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ScalarFieldCount not an integer: "//trim(value), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return endif write(logmsg,*) scalar_field_count call ESMF_LogWrite('mom_cap:ScalarFieldCount = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return endif scalar_field_idx_grid_nx = 0 @@ -625,17 +658,17 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_nx if (iostat /= 0) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": ScalarFieldIdxGridNX not an integer: "//trim(value), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ScalarFieldIdxGridNX not an integer: "//trim(value), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return endif write(logmsg,*) scalar_field_idx_grid_nx call ESMF_LogWrite('mom_cap:ScalarFieldIdxGridNX = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return endif scalar_field_idx_grid_ny = 0 @@ -648,17 +681,17 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (isPresent .and. isSet) then read(value, '(i)', iostat=iostat) scalar_field_idx_grid_ny if (iostat /= 0) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": ScalarFieldIdxGridNY not an integer: "//trim(value), & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//": ScalarFieldIdxGridNY not an integer: "//trim(value), & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return endif write(logmsg,*) scalar_field_idx_grid_ny call ESMF_LogWrite('mom_cap:ScalarFieldIdxGridNY = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return endif call NUOPC_CompAttributeAdd(gcomp, & @@ -670,8 +703,6 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) end subroutine -!=============================================================================== - !> Called by NUOPC to advertise import and export fields. "Advertise" !! simply means that the standard names of all import and export !! fields are supplied. The NUOPC layer uses these to match fields @@ -683,11 +714,13 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) !! @param clock an ESMF_Clock object !! @param rc return code subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc + type(ESMF_GridComp) :: gcomp !< ESMF_GridComp object + type(ESMF_State) :: importState, exportState !< ESMF_State object for + !! import/export fields + type(ESMF_Clock) :: clock !< ESMF_Clock object + integer, intent(out) :: rc !< return code + ! local variables type(ESMF_VM) :: vm type(ESMF_Time) :: MyTime type(ESMF_TimeInterval) :: TINT @@ -780,21 +813,21 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! reset shr logging to my log file if (is_root_pe()) then call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & - isPresent=isPresentDiro, rc=rc) + isPresent=isPresentDiro, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, & - isPresent=isPresentLogfile, rc=rc) + isPresent=isPresentLogfile, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return if (isPresentDiro .and. isPresentLogfile) then - open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) + open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) else - logunit = output_unit + logunit = output_unit endif else logunit = output_unit @@ -811,11 +844,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) read(cvalue,*) starttype else call ESMF_LogWrite('mom_cap:start_type unset - using input.nml for restart option', & - ESMF_LOGMSG_INFO, rc=rc) + ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return endif runtype = "" @@ -827,17 +860,17 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) runtype = "continue" else if (len_trim(starttype) > 0) then call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": unknown starttype - "//trim(starttype), & - line=__LINE__, file=__FILE__, rcToReturn=rc) + msg=subname//": unknown starttype - "//trim(starttype), & + line=__LINE__, file=__FILE__, rcToReturn=rc) return endif if (len_trim(runtype) > 0) then call ESMF_LogWrite('mom_cap:startup = '//trim(runtype), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return endif restartfile = "" @@ -848,43 +881,43 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! optionally call into system-specific implementation to get restart file name call ESMF_MethodExecute(gcomp, label="GetRestartFileToRead", & - existflag=existflag, userRc=userRc, rc=rc) + existflag=existflag, userRc=userRc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg="Error executing user method to get restart filename", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out if (ESMF_LogFoundError(rcToCheck=userRc, msg="Error in method to get restart filename", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out if (existflag) then - call ESMF_LogWrite('mom_cap: called user GetRestartFileToRead', ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + call ESMF_LogWrite('mom_cap: called user GetRestartFileToRead', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return endif call NUOPC_CompAttributeGet(gcomp, name='RestartFileToRead', & - value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return if (isPresent .and. isSet) then - restartfile = trim(cvalue) - call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + restartfile = trim(cvalue) + call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return else - call ESMF_LogWrite('mom_cap: restart requested, no RestartFileToRead attribute provided-will use input.nml',& - ESMF_LOGMSG_WARNING, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + call ESMF_LogWrite('mom_cap: restart requested, no RestartFileToRead attribute provided-will use input.nml',& + ESMF_LOGMSG_WARNING, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return endif end if @@ -901,25 +934,25 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) allocate ( Ice_ocean_boundary% u_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% v_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% t_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% q_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% salt_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% lw_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_vis_dir (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_vis_dif (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_nir_dir (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_nir_dif (isc:iec,jsc:jec), & - Ice_ocean_boundary% lprec (isc:iec,jsc:jec), & - Ice_ocean_boundary% fprec (isc:iec,jsc:jec), & - Ice_ocean_boundary% mi (isc:iec,jsc:jec), & - Ice_ocean_boundary% p (isc:iec,jsc:jec), & - Ice_ocean_boundary% runoff (isc:iec,jsc:jec), & - Ice_ocean_boundary% calving (isc:iec,jsc:jec), & - Ice_ocean_boundary% runoff_hflx (isc:iec,jsc:jec), & - Ice_ocean_boundary% calving_hflx (isc:iec,jsc:jec), & - Ice_ocean_boundary% rofl_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% rofi_flux (isc:iec,jsc:jec)) + Ice_ocean_boundary% v_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% t_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% q_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% salt_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% lw_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_vis_dir (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_vis_dif (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_nir_dir (isc:iec,jsc:jec), & + Ice_ocean_boundary% sw_flux_nir_dif (isc:iec,jsc:jec), & + Ice_ocean_boundary% lprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% fprec (isc:iec,jsc:jec), & + Ice_ocean_boundary% mi (isc:iec,jsc:jec), & + Ice_ocean_boundary% p (isc:iec,jsc:jec), & + Ice_ocean_boundary% runoff (isc:iec,jsc:jec), & + Ice_ocean_boundary% calving (isc:iec,jsc:jec), & + Ice_ocean_boundary% runoff_hflx (isc:iec,jsc:jec), & + Ice_ocean_boundary% calving_hflx (isc:iec,jsc:jec), & + Ice_ocean_boundary% rofl_flux (isc:iec,jsc:jec), & + Ice_ocean_boundary% rofi_flux (isc:iec,jsc:jec)) Ice_ocean_boundary%u_flux = 0.0 Ice_ocean_boundary%v_flux = 0.0 @@ -951,8 +984,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (cesm_coupled) then if (len_trim(scalar_field_name) > 0) then - call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, trim(scalar_field_name), "will_provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide") endif !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") !call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_ustokes" , "will provide") @@ -1019,7 +1052,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) end subroutine InitializeAdvertise -!=============================================================================== !> Called by NUOPC to realize import and export fields. "Realizing" a field !! means that its grid has been defined and an ESMF_Field object has been !! created and put into the import or export State. @@ -1029,12 +1061,12 @@ end subroutine InitializeAdvertise !! @param exportState an ESMF_State object for export fields !! @param clock an ESMF_Clock object !! @param rc return code - subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc + type(ESMF_GridComp) :: gcomp !< ESMF_GridComp object + type(ESMF_State) :: importState, exportState !< ESMF_State object for + !! import/export fields + type(ESMF_Clock) :: clock !< ESMF_Clock object + integer, intent(out) :: rc !< return code ! Local Variables type(ESMF_VM) :: vm @@ -1134,9 +1166,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) rc = ESMF_FAILURE call ESMF_LogWrite(subname//' ntiles must be 1', ESMF_LOGMSG_ERROR, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return endif ntiles=mpp_get_domain_npes(ocean_public%domain) write(tmpstr,'(a,1i6)') subname//' ntiles = ',ntiles @@ -1155,12 +1187,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call mpp_get_pelist(ocean_public%domain, pe) if (debug > 0) then do n = 1,ntiles - write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return enddo end if @@ -1184,55 +1216,56 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) allocate(gindex(lsize)) k = 0 do j = ocean_grid%jsc, ocean_grid%jec - jg = j + ocean_grid%jdg_offset - do i = ocean_grid%isc, ocean_grid%iec - ig = i + ocean_grid%idg_offset - k = k + 1 ! Increment position within gindex - gindex(k) = ni * (jg - 1) + ig - enddo + jg = j + ocean_grid%jdg_offset + do i = ocean_grid%isc, ocean_grid%iec + ig = i + ocean_grid%idg_offset + k = k + 1 ! Increment position within gindex + gindex(k) = ni * (jg - 1) + ig + enddo enddo DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return ! read in the mesh call NUOPC_CompAttributeGet(gcomp, name='mesh_ocn', value=cvalue, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return EMeshTemp = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return + if (localPet == 0) then - write(logunit,*)'mesh file for mom6 domain is ',trim(cvalue) + write(logunit,*)'mesh file for mom6 domain is ',trim(cvalue) end if ! recreate the mesh using the above distGrid EMesh = ESMF_MeshCreate(EMeshTemp, elementDistgrid=Distgrid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return ! realize the import and export fields using the mesh call MOM_RealizeFields(importState, fldsToOcn_num, fldsToOcn, "Ocn import", mesh=Emesh, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return call MOM_RealizeFields(exportState, fldsFrOcn_num, fldsFrOcn, "Ocn export", mesh=Emesh, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return else if (geomtype == ESMF_GEOMTYPE_GRID) then @@ -1247,26 +1280,26 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) allocate(deLabelList(ntiles)) do n = 1, ntiles - deLabelList(n) = n - deBlockList(1,1,n) = xb(n) - deBlockList(1,2,n) = xe(n) - deBlockList(2,1,n) = yb(n) - deBlockList(2,2,n) = ye(n) - petMap(n) = pe(n) - ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side + deLabelList(n) = n + deBlockList(1,1,n) = xb(n) + deBlockList(1,2,n) = xe(n) + deBlockList(2,1,n) = yb(n) + deBlockList(2,2,n) = ye(n) + petMap(n) = pe(n) + ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + ! write(tmpstr,'(a,2i8)') subname//' pe = ',n,petMap(n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + !--- assume a tile with starting index of 1 has an equivalent wraparound tile on the other side enddo delayout = ESMF_DELayoutCreate(petMap, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! rsd this assumes tripole grid, but sometimes in CESM a bipole ! grid is used -- need to introduce conditional logic here @@ -1275,32 +1308,32 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! bipolar boundary condition at top row: nyg call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & - tileIndexB=1, positionVector=(/nxg+1, 2*nyg+1/), & - orientationVector=(/-1, -2/), rc=rc) + tileIndexB=1, positionVector=(/nxg+1, 2*nyg+1/), & + orientationVector=(/-1, -2/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! periodic boundary condition along first dimension call ESMF_DistGridConnectionSet(connectionList(2), tileIndexA=1, & - tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) + tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nxg,nyg/), & - ! indexflag = ESMF_INDEX_DELOCAL, & - deBlockList=deBlockList, & - ! deLabelList=deLabelList, & - delayout=delayout, & - connectionList=connectionList, & - rc=rc) + ! indexflag = ESMF_INDEX_DELOCAL, & + deBlockList=deBlockList, & + ! deLabelList=deLabelList, & + delayout=delayout, & + connectionList=connectionList, & + rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return deallocate(xb,xe,yb,ye,pe) deallocate(connectionList) @@ -1310,113 +1343,125 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_DistGridGet(distgrid=distgrid, localDE=0, elementCount=cnt, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return + allocate(indexList(cnt)) write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return + write(tmpstr,'(a,4i8)') subname//' distgrid list= ',& - indexList(1),indexList(cnt),minval(indexList), maxval(indexList) + indexList(1),indexList(cnt),minval(indexList), maxval(indexList) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return + deallocate(IndexList) ! create grid gridIn = ESMF_GridCreate(distgrid=distgrid, & - gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & - coordSys = ESMF_COORDSYS_SPH_DEG, & - rc = rc) + gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & + coordSys = ESMF_COORDSYS_SPH_DEG, & + rc = rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! Attach area to the Grid optionally. By default the cell areas are computed. if(grid_attach_area) then - call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + endif call ESMF_GridGetCoord(gridIn, coordDim=1, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_xcen, rc=rc) + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_xcen, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_GridGetCoord(gridIn, coordDim=2, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_ycen, rc=rc) + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_ycen, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_GridGetCoord(gridIn, coordDim=1, & - staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=dataPtr_xcor, rc=rc) + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=dataPtr_xcor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return + call ESMF_GridGetCoord(gridIn, coordDim=2, & - staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=dataPtr_ycor, rc=rc) + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=dataPtr_ycor, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_MASK, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_mask, rc=rc) + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_mask, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return + if(grid_attach_area) then - call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=dataPtr_area, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=dataPtr_area, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return endif ! load up area, mask, center and corner values @@ -1448,38 +1493,38 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) if (iec-isc /= ubnd1-lbnd1 .or. jec-jsc /= ubnd2-lbnd2) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=SUBNAME//": fld and grid do not have the same size.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=SUBNAME//": fld and grid do not have the same size.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return endif do j = jsc, jec j1 = j + lbnd2 - jsc jg = j + ocean_grid%jsc - jsc do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + ocean_grid%isc - isc - dataPtr_mask(i1,j1) = ocean_grid%mask2dT(ig,jg) - dataPtr_xcen(i1,j1) = ocean_grid%geolonT(ig,jg) - dataPtr_ycen(i1,j1) = ocean_grid%geolatT(ig,jg) - if(grid_attach_area) then - dataPtr_area(i1,j1) = ocean_grid%areaT(ig,jg) - end if + i1 = i + lbnd1 - isc + ig = i + ocean_grid%isc - isc + dataPtr_mask(i1,j1) = ocean_grid%mask2dT(ig,jg) + dataPtr_xcen(i1,j1) = ocean_grid%geolonT(ig,jg) + dataPtr_ycen(i1,j1) = ocean_grid%geolatT(ig,jg) + if(grid_attach_area) then + dataPtr_area(i1,j1) = ocean_grid%areaT(ig,jg) + end if end do end do - jlast = jec + jlast = jec if(jec == nyg)jlast = jec+1 do j = jsc, jlast j1 = j + lbnd4 - jsc jg = j + ocean_grid%jsc - jsc - 1 do i = isc, iec - i1 = i + lbnd3 - isc - ig = i + ocean_grid%isc - isc - 1 - dataPtr_xcor(i1,j1) = ocean_grid%geolonBu(ig,jg) - dataPtr_ycor(i1,j1) = ocean_grid%geolatBu(ig,jg) + i1 = i + lbnd3 - isc + ig = i + ocean_grid%isc - isc - 1 + dataPtr_xcor(i1,j1) = ocean_grid%geolonBu(ig,jg) + dataPtr_ycor(i1,j1) = ocean_grid%geolatBu(ig,jg) end do end do @@ -1487,8 +1532,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) if(grid_attach_area) then - write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + write(tmpstr,*) subname//' area = ',minval(dataPtr_area),maxval(dataPtr_area) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) endif write(tmpstr,*) subname//' xcen = ',minval(dataPtr_xcen),maxval(dataPtr_xcen) @@ -1507,15 +1552,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call MOM_RealizeFields(importState, fldsToOcn_num, fldsToOcn, "Ocn import", grid=gridIn, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return call MOM_RealizeFields(exportState, fldsFrOcn_num, fldsFrOcn, "Ocn export", grid=gridOut, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return end if @@ -1525,18 +1570,19 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (len_trim(scalar_field_name) > 0) then call State_SetScalar(dble(nxg),scalar_field_idx_grid_nx, exportState, localPet, & - scalar_field_name, scalar_field_count, rc) + scalar_field_name, scalar_field_count, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return call State_SetScalar(dble(nyg),scalar_field_idx_grid_ny, exportState, localPet, & - scalar_field_name, scalar_field_count, rc) + scalar_field_name, scalar_field_count, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return + endif !--------------------------------- @@ -1557,11 +1603,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end subroutine InitializeRealize -!=============================================================================== - +!> TODO +!! +!! @param gcomp an ESMF_GridComp object +!! @param rc return code subroutine DataInitialize(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + type(ESMF_GridComp) :: gcomp !< ESMF_GridComp object + integer, intent(out) :: rc !< return code ! local variables type(ESMF_Clock) :: clock @@ -1599,9 +1647,9 @@ subroutine DataInitialize(gcomp, rc) if (cesm_coupled) then call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out end if call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) @@ -1654,20 +1702,18 @@ subroutine DataInitialize(gcomp, rc) end subroutine DataInitialize -!=============================================================================== - !> Called by NUOPC to advance the model a single timestep. !! !! @param gcomp an ESMF_GridComp object !! @param rc return code subroutine ModelAdvance(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + type(ESMF_GridComp) :: gcomp !< ESMF_GridComp object + integer, intent(out) :: rc !< return code ! local variables integer :: userRc logical :: existflag, isPresent, isSet - type(ESMF_Clock) :: clock + type(ESMF_Clock) :: clock!< ESMF Clock class definition type(ESMF_Alarm) :: alarm type(ESMF_State) :: importState, exportState type(ESMF_Time) :: currTime @@ -1691,7 +1737,6 @@ subroutine ModelAdvance(gcomp, rc) character(ESMF_MAXSTR) :: restartname, cvalue character(240) :: msgString character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' - !-------------------------------- rc = ESMF_SUCCESS if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") @@ -1815,76 +1860,77 @@ subroutine ModelAdvance(gcomp, rc) call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call ESMF_AlarmRingerOff(alarm, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! call into system specific method to get desired restart filename restartname = "" call ESMF_MethodExecute(gcomp, label="GetRestartFileToWrite", & - existflag=existflag, userRc=userRc, rc=rc) + existflag=existflag, userRc=userRc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg="Error executing user method to get restart filename", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (ESMF_LogFoundError(rcToCheck=userRc, msg="Error in method to get restart filename", & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out if (existflag) then - call ESMF_LogWrite("mom_cap: called user GetRestartFileToWrite method", ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call NUOPC_CompAttributeGet(gcomp, name='RestartFileToWrite', & - isPresent=isPresent, isSet=isSet, value=cvalue, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (isPresent .and. isSet) then - restartname = trim(cvalue) - call ESMF_LogWrite("mom_cap: User RestartFileToWrite: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - endif + call ESMF_LogWrite("mom_cap: called user GetRestartFileToWrite method", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompAttributeGet(gcomp, name='RestartFileToWrite', & + isPresent=isPresent, isSet=isSet, value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + restartname = trim(cvalue) + call ESMF_LogWrite("mom_cap: User RestartFileToWrite: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif endif if (len_trim(restartname) == 0) then - ! none provided, so use a default restart filename - call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, & - h=hour, m=minute, s=seconds, rc=rc ) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & - "ocn", year, month, day, hour, minute, seconds - call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! none provided, so use a default restart filename + call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_TimeGet (MyTime, yy=year, mm=month, dd=day, & + h=hour, m=minute, s=seconds, rc=rc ) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & + "ocn", year, month, day, hour, minute, seconds + call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out endif ! TODO: address if this requirement is being met for the DA group @@ -1920,11 +1966,11 @@ subroutine ModelAdvance(gcomp, rc) if (write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_ocn_export_', & - timeslice=export_slice, relaxedFlag=.true., rc=rc) + timeslice=export_slice, relaxedFlag=.true., rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out export_slice = export_slice + 1 endif @@ -1932,7 +1978,6 @@ subroutine ModelAdvance(gcomp, rc) end subroutine ModelAdvance -!=============================================================================== subroutine ModelSetRunClock(gcomp, rc) type(ESMF_GridComp) :: gcomp @@ -1993,8 +2038,8 @@ subroutine ModelSetRunClock(gcomp, rc) return ! bail out call ESMF_LogSetError(ESMF_RC_VAL_WRONG, & - msg=subname//": ERROR in time consistency: "//trim(dtimestring)//" != "//trim(mtimestring), & - line=__LINE__, file=__FILE__, rcToReturn=rc) + msg=subname//": ERROR in time consistency: "//trim(dtimestring)//" != "//trim(mtimestring), & + line=__LINE__, file=__FILE__, rcToReturn=rc) return endif @@ -2103,9 +2148,8 @@ end subroutine ModelSetRunClock !! @param rc return code subroutine ocean_model_finalize(gcomp, rc) - ! input arguments - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc + type(ESMF_GridComp) :: gcomp !< ESMF_GridComp object + integer, intent(out) :: rc !< return code ! local variables type (ocean_public_type), pointer :: ocean_public @@ -2156,20 +2200,16 @@ subroutine ocean_model_finalize(gcomp, rc) end subroutine ocean_model_finalize -!=============================================================================== +!> Set scalar data from state for a particula name subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_count, rc) - ! ---------------------------------------------- - ! Set scalar data from State for a particular name - ! ---------------------------------------------- - real(ESMF_KIND_R8),intent(in) :: value integer, intent(in) :: scalar_id type(ESMF_State), intent(inout) :: State integer, intent(in) :: mytask character(len=*), intent(in) :: scalar_name integer, intent(in) :: scalar_count - integer, intent(inout) :: rc + integer, intent(inout) :: rc !< return code ! local variables type(ESMF_Field) :: field @@ -2198,11 +2238,9 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ end subroutine State_SetScalar -!=============================================================================== - +!> TODO subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) - ! input/output variables type(ESMF_State) , intent(inout) :: state integer , intent(in) :: nfields type(fld_list_type) , intent(inout) :: field_defs(:) @@ -2328,23 +2366,23 @@ subroutine SetScalarField(field, rc) ! create a DistGrid with a single index space element, which gets mapped onto DE 0. distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/1/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out grid = ESMF_GridCreate(distgrid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! num of scalar values field = ESMF_FieldCreate(name=trim(scalar_field_name), grid=grid, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), gridToFieldMap=(/2/), rc=rc) + ungriddedLBound=(/1/), ungriddedUBound=(/scalar_field_count/), gridToFieldMap=(/2/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out end subroutine SetScalarField @@ -2352,10 +2390,8 @@ end subroutine MOM_RealizeFields !=============================================================================== +!> Set up list of field information subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname) - ! ---------------------------------------------- - ! Set up a list of field information - ! ---------------------------------------------- integer, intent(inout) :: num type(fld_list_type), intent(inout) :: fldlist(:) character(len=*), intent(in) :: stdname @@ -2370,8 +2406,8 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname) num = num + 1 if (num > fldsMax) then call ESMF_LogSetError(ESMF_RC_VAL_OUTOFRANGE, & - msg=trim(subname)//": ERROR number of field exceeded fldsMax: "//trim(stdname), & - line=__LINE__, file=__FILE__, rcToReturn=rc) + msg=trim(subname)//": ERROR number of field exceeded fldsMax: "//trim(stdname), & + line=__LINE__, file=__FILE__, rcToReturn=rc) return endif @@ -2385,7 +2421,6 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname) end subroutine fld_list_add -!======================================================================= #ifndef CESMCOUPLED subroutine shr_file_setLogUnit(nunit) From acf99c85c0f9e6d13ee2b2d514ea3865c435c64c Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 25 Mar 2019 16:13:52 -0600 Subject: [PATCH 1036/1072] Doxygenize --- config_src/nuopc_driver/time_utils.F90 | 58 +++++++++++++------------- 1 file changed, 30 insertions(+), 28 deletions(-) diff --git a/config_src/nuopc_driver/time_utils.F90 b/config_src/nuopc_driver/time_utils.F90 index 430114840d..e8effdd05b 100644 --- a/config_src/nuopc_driver/time_utils.F90 +++ b/config_src/nuopc_driver/time_utils.F90 @@ -1,3 +1,4 @@ +!> Set of subroutines that convert date/time between FMS and ESMF formats. module time_utils_mod use fms_mod, only: uppercase @@ -9,11 +10,13 @@ module time_utils_mod implicit none; private -!-------------------- interface blocks --------------------- +!> Converts calendar from FMS to ESMF format interface fms2esmf_cal module procedure fms2esmf_cal_c module procedure fms2esmf_cal_i end interface fms2esmf_cal + +!> Converts time from FMS to ESMF format interface esmf2fms_time module procedure esmf2fms_time_t module procedure esmf2fms_timestep @@ -26,13 +29,10 @@ module time_utils_mod contains -!-------------------- module code --------------------- - +!> Sets fms2esmf_cal_c to the corresponding ESMF calendar type function fms2esmf_cal_c(calendar) -! ! Return Value: - type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_c -! ! Arguments: - character(len=*), intent(in) :: calendar + type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_c !< ESMF calendar type + character(len=*), intent(in) :: calendar !< Type of calendar select case( uppercase(trim(calendar)) ) case( 'GREGORIAN' ) @@ -51,11 +51,10 @@ function fms2esmf_cal_c(calendar) end select end function fms2esmf_cal_c +!> Sets fms2esmf_cal_i to the corresponding ESMF calendar type function fms2esmf_cal_i(calendar) -! ! Return Value: - type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_i -! ! Arguments: - integer, intent(in) :: calendar + type(ESMF_CALKIND_FLAG) :: fms2esmf_cal_i !< ESMF calendar structure + integer, intent(in) :: calendar !< Type of calendar select case(calendar) case(THIRTY_DAY_MONTHS) @@ -71,11 +70,11 @@ function fms2esmf_cal_i(calendar) end select end function fms2esmf_cal_i +!> Converts date from ESMF format to FMS format. function esmf2fms_time_t(time) - ! Return Value - type(Time_type) :: esmf2fms_time_t - ! Input Arguments - type(ESMF_Time), intent(in) :: time + type(Time_type) :: esmf2fms_time_t !< FMS time structure + type(ESMF_Time), intent(in) :: time !< ESMF time structure + ! Local Variables integer :: yy, mm, dd, h, m, s type(ESMF_CALKIND_FLAG) :: calkind @@ -89,15 +88,15 @@ function esmf2fms_time_t(time) file=__FILE__)) & return ! bail out - esmf2fms_time_t = Set_date(yy, mm, dd, h, m, s) + esmf2fms_time_t = set_date(yy, mm, dd, h, m, s) end function esmf2fms_time_t +!> Converts time-interval from ESMF format to FMS format. function esmf2fms_timestep(timestep) - ! Return Value - type(Time_type) :: esmf2fms_timestep - ! Input Arguments - type(ESMF_TimeInterval), intent(in):: timestep + type(Time_type) :: esmf2fms_timestep !< FMS time structure + type(ESMF_TimeInterval), intent(in):: timestep !< time-interval following + !! ESMF format [s] ! Local Variables integer :: s type(ESMF_CALKIND_FLAG) :: calkind @@ -114,12 +113,12 @@ function esmf2fms_timestep(timestep) end function esmf2fms_timestep +!> Converts date from FMS format to ESMF format. function fms2esmf_time(time, calkind) - ! Return Value - type(ESMF_Time) :: fms2esmf_time - ! Input Arguments - type(Time_type), intent(in) :: time - type(ESMF_CALKIND_FLAG), intent(in), optional :: calkind + type(ESMF_Time) :: fms2esmf_time !< ESMF time structure + type(time_type), intent(in) :: time !< FMS time structure + type(ESMF_CALKIND_FLAG), intent(in), optional :: calkind !< ESMF calendar structure + ! Local Variables integer :: yy, mm, d, h, m, s type(ESMF_CALKIND_FLAG) :: l_calkind @@ -143,11 +142,14 @@ function fms2esmf_time(time, calkind) end function fms2esmf_time +!> Converts a string (I4.4,I2.2,I2.2,".",I2.2,I2.2,I2.2) that represents +!! yr, mon, day, hr, min, sec to a FMS data format. function string_to_date(string, rc) - character(len=15), intent(in) :: string - integer, intent(out), optional :: rc - type(time_type) :: string_to_date + character(len=15), intent(in) :: string !< String representing a date + integer, intent(out), optional :: rc !< ESMF error handler + type(time_type) :: string_to_date!< FMS time structure + ! Local variables integer :: yr,mon,day,hr,min,sec if(present(rc)) rc = ESMF_SUCCESS From f19bbd4761faf096404e850ae3cb029f5e820ed6 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 25 Mar 2019 16:20:20 -0600 Subject: [PATCH 1037/1072] Adding "use, only: to import ESMF modules --- config_src/nuopc_driver/time_utils.F90 | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/config_src/nuopc_driver/time_utils.F90 b/config_src/nuopc_driver/time_utils.F90 index e8effdd05b..49bad199a1 100644 --- a/config_src/nuopc_driver/time_utils.F90 +++ b/config_src/nuopc_driver/time_utils.F90 @@ -1,12 +1,19 @@ !> Set of subroutines that convert date/time between FMS and ESMF formats. module time_utils_mod -use fms_mod, only: uppercase -use mpp_mod, only: mpp_error, FATAL -use time_manager_mod, only: time_type, set_time, set_date, get_date -use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR -use time_manager_mod, only: fms_get_calendar_type => get_calendar_type -use ESMF +! FMS +use fms_mod, only: uppercase +use mpp_mod, only: mpp_error, FATAL +use time_manager_mod, only: time_type, set_time, set_date, get_date +use time_manager_mod, only: GREGORIAN, JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR +use time_manager_mod, only: fms_get_calendar_type => get_calendar_type +! ESMF +use ESMF, only: ESMF_CALKIND_FLAG, ESMF_CALKIND_GREGORIAN +use ESMF, only: ESMF_CALKIND_JULIAN, ESMF_CALKIND_NOLEAP +use ESMF, only: ESMF_CALKIND_360DAY, ESMF_CALKIND_NOCALENDAR +use ESMF, only: ESMF_Time, ESMF_TimeGet, ESMF_LogFoundError +use ESMF, only: ESMF_LOGERR_PASSTHRU,ESMF_TimeInterval +use ESMF, only: ESMF_TimeIntervalGet, ESMF_TimeSet, ESMF_SUCCESS implicit none; private From 75728019ea0c98766e36034d0e641002d079293d Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 25 Mar 2019 16:56:04 -0600 Subject: [PATCH 1038/1072] Clean code --- config_src/nuopc_driver/mom_cap.F90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 00e56ffac0..eb889e71e9 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -384,11 +384,6 @@ module mom_cap_mod model_label_SetRunClock => label_SetRunClock, & model_label_Finalize => label_Finalize -! TODO GMM, where are these coming from? thye do not have an explicit fortran interface -! ESMF_GridCompGetInternalState -! -! And these? -! ESMF_LOGERR_PASSTHRU implicit none; private public SetServices From aa4a2c0cd8966dd8a0ce72d6f73f1c235d405ab7 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 26 Mar 2019 16:32:46 -0600 Subject: [PATCH 1039/1072] Add documentation --- config_src/nuopc_driver/mom_cap_methods.F90 | 191 +++++++++----------- 1 file changed, 88 insertions(+), 103 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 67c064194d..adb3915787 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -1,7 +1,6 @@ +!> Contains import/export methods for both NEMS and CMEPS. module mom_cap_methods -! Cap import/export methods for both NEMS and CMEPS - use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet use ESMF, only: ESMF_State, ESMF_StateGet @@ -33,33 +32,31 @@ module mom_cap_methods private :: State_getImport private :: State_setExport +!> Get field pointer interface State_GetFldPtr module procedure State_GetFldPtr_1d module procedure State_GetFldPtr_2d end interface -integer :: import_cnt = 0 -type(ESMF_GeomType_Flag) :: geomtype +integer :: import_cnt = 0!< used to skip using the import state + !! at the first count for cesm +type(ESMF_GeomType_Flag) :: geomtype !< SMF type describing type of + !! geometry (mesh or grid) -!=============================================================================== contains -!=============================================================================== +!> Sets module variable geometry type subroutine mom_set_geomtype(geomtype_in) - ! Set module variable geomtype - - type(ESMF_GeomType_Flag), intent(in) :: geomtype_in !< mesh or grid + type(ESMF_GeomType_Flag), intent(in) :: geomtype_in !< ESMF type describing type of + !! geometry (mesh or grid) geomtype = geomtype_in end subroutine mom_set_geomtype -!=============================================================================== - !> This function has a few purposes: !! (1) it imports surface fluxes using data from the mediator; and !! (2) it can apply restoring in SST and SSS. - subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype, rc) ! Input/output variables @@ -68,7 +65,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, type(ESMF_State) , intent(inout) :: importState !< incoming data from mediator type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing character(len=*), optional , intent(in) :: runtype !< For cesm only, type of run - integer , intent(inout) :: rc + integer , intent(inout) :: rc !< Error handler ! Local Variables integer :: i, j, ig, jg, n @@ -79,8 +76,6 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, real(ESMF_KIND_R8), allocatable :: tauy(:,:) character(len=*) , parameter :: subname = '(mom_import)' - !----------------------------------------------------------------------- - rc = ESMF_SUCCESS ! ------- @@ -90,9 +85,9 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, if (present(runtype)) then import_cnt = import_cnt + 1 if ((trim(runtype) == 'initial' .and. import_cnt <= 2)) then - do_import = .false. ! This will skip the first time import information is given + do_import = .false. ! This will skip the first time import information is given else - do_import = .true. + do_import = .true. end if else do_import = .true. @@ -106,61 +101,61 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! surface height pressure !---- call state_getimport(importState, 'inst_pres_height_surface', & - isc, iec, jsc, jec, ice_ocean_boundary%p, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%p, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! near-IR, direct shortwave (W/m2) !---- call state_getimport(importState, 'mean_net_sw_ir_dir_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! near-IR, diffuse shortwave (W/m2) !---- call state_getimport(importState, 'mean_net_sw_ir_dif_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! visible, direct shortwave (W/m2) !---- call state_getimport(importState, 'mean_net_sw_vis_dir_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! visible, diffuse shortwave (W/m2) !---- call state_getimport(importState, 'mean_net_sw_vis_dif_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! ------- ! Net longwave radiation (W/m2) ! ------- call state_getimport(importState, 'mean_net_lw_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! zonal and meridional surface stress @@ -170,14 +165,15 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, call state_getimport(importState, 'mean_zonal_moment_flx', isc, iec, jsc, jec, taux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call state_getimport(importState, 'mean_merid_moment_flx', isc, iec, jsc, jec, tauy, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ! rotate taux and tauy from true zonal/meridional to local coordinates do j = jsc, jec @@ -335,28 +331,26 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ice_ocean_boundary%mi(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mass_of_overlying_ice', & - isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out end if end subroutine mom_import -!=============================================================================== - !> Maps outgoing ocean data to ESMF State subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc) ! Input/output variables type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid - type(ocean_state_type) , pointer :: ocean_state + type(ocean_state_type) , pointer :: ocean_state !< Ocean state type(ESMF_State) , intent(inout) :: exportState !< outgoing data - type(ESMF_Clock) , intent(in) :: clock - integer , intent(inout) :: rc + type(ESMF_Clock) , intent(in) :: clock !< ESMF clock + integer , intent(inout) :: rc !< Error handler ! Local variables integer :: i, j, ig, jg ! indices @@ -380,7 +374,6 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, real(ESMF_KIND_R8), allocatable :: dhdx(:,:), dhdy(:,:) real(ESMF_KIND_R8), allocatable :: dhdx_rot(:,:), dhdy_rot(:,:) character(len=*) , parameter :: subname = '(mom_export)' - !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -660,13 +653,12 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, end subroutine mom_export -!=============================================================================== - +!> Get field pointer 1D subroutine State_GetFldPtr_1d(State, fldname, fldptr, rc) - type(ESMF_State) , intent(in) :: State - character(len=*) , intent(in) :: fldname - real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:) - integer, optional , intent(out) :: rc + type(ESMF_State) , intent(in) :: State !< ESMF state + character(len=*) , intent(in) :: fldname !< Field name + real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:)!< Pointer to the 1D field + integer, optional , intent(out) :: rc !< Error handler ! local variables type(ESMF_Field) :: lfield @@ -688,13 +680,12 @@ subroutine State_GetFldPtr_1d(State, fldname, fldptr, rc) end subroutine State_GetFldPtr_1d -!=============================================================================== - +!> Get field pointer 2D subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc) - type(ESMF_State) , intent(in) :: State - character(len=*) , intent(in) :: fldname - real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:,:) - integer, optional , intent(out) :: rc + type(ESMF_State) , intent(in) :: State !< ESMF state + character(len=*) , intent(in) :: fldname !< Field name + real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:,:)!< Pointer to the 2D field + integer, optional , intent(out) :: rc !< Error handler ! local variables type(ESMF_Field) :: lfield @@ -716,24 +707,21 @@ subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc) end subroutine State_GetFldPtr_2d -!=============================================================================== - +!> Map import state field to output array subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, rc) - - ! ---------------------------------------------- - ! Map import state field to output array - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_State) , intent(in) :: state - character(len=*) , intent(in) :: fldname - integer , intent(in) :: isc - integer , intent(in) :: iec - integer , intent(in) :: jsc - integer , intent(in) :: jec - real (ESMF_KIND_R8) , intent(inout) :: output(isc:iec,jsc:jec) - logical, optional , intent(in) :: do_sum - integer , intent(out) :: rc + type(ESMF_State) , intent(in) :: state !< ESMF state + character(len=*) , intent(in) :: fldname !< Field name + integer , intent(in) :: isc !< The start i-index of cell centers within + !! the computational domain + integer , intent(in) :: iec !< The end i-index of cell centers within the + !! computational domain + integer , intent(in) :: jsc !< The start j-index of cell centers within + !! the computational domain + integer , intent(in) :: jec !< The end j-index of cell centers within + !! the computational domain + real (ESMF_KIND_R8) , intent(inout) :: output(isc:iec,jsc:jec)!< Output 2D array + logical, optional , intent(in) :: do_sum !< If true, sums the data + integer , intent(out) :: rc !< Error handler ! local variables type(ESMF_StateItem_Flag) :: itemFlag @@ -800,24 +788,21 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r end subroutine State_GetImport -!=============================================================================== - +!> Map input array to export state subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid, rc) - - ! ---------------------------------------------- - ! Map input array to export state - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_State) , intent(inout) :: state - character(len=*) , intent(in) :: fldname - integer , intent(in) :: isc - integer , intent(in) :: iec - integer , intent(in) :: jsc - integer , intent(in) :: jec - real (ESMF_KIND_R8) , intent(in) :: input(isc:iec,jsc:jec) - type(ocean_grid_type) , intent(in) :: ocean_grid - integer , intent(out) :: rc + type(ESMF_State) , intent(inout) :: state !< ESMF state + character(len=*) , intent(in) :: fldname !< Field name + integer , intent(in) :: isc !< The start i-index of cell centers within + !! the computational domain + integer , intent(in) :: iec !< The end i-index of cell centers within the + !! computational domain + integer , intent(in) :: jsc !< The start j-index of cell centers within + !! the computational domain + integer , intent(in) :: jec !< The end j-index of cell centers within + !! the computational domain + real (ESMF_KIND_R8) , intent(in) :: input(isc:iec,jsc:jec)!< Input 2D array + type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean horizontal grid + integer , intent(out) :: rc !< Error handler ! local variables type(ESMF_StateItem_Flag) :: itemFlag From 4b643550c999cdb6a6ed266a6501bab04a07e39b Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 26 Mar 2019 16:41:55 -0600 Subject: [PATCH 1040/1072] Replaced error handler with return code --- config_src/nuopc_driver/mom_cap_methods.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index adb3915787..036497be09 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -65,7 +65,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, type(ESMF_State) , intent(inout) :: importState !< incoming data from mediator type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing character(len=*), optional , intent(in) :: runtype !< For cesm only, type of run - integer , intent(inout) :: rc !< Error handler + integer , intent(inout) :: rc !< Return code ! Local Variables integer :: i, j, ig, jg, n @@ -350,7 +350,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, type(ocean_state_type) , pointer :: ocean_state !< Ocean state type(ESMF_State) , intent(inout) :: exportState !< outgoing data type(ESMF_Clock) , intent(in) :: clock !< ESMF clock - integer , intent(inout) :: rc !< Error handler + integer , intent(inout) :: rc !< Return code ! Local variables integer :: i, j, ig, jg ! indices @@ -658,7 +658,7 @@ subroutine State_GetFldPtr_1d(State, fldname, fldptr, rc) type(ESMF_State) , intent(in) :: State !< ESMF state character(len=*) , intent(in) :: fldname !< Field name real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:)!< Pointer to the 1D field - integer, optional , intent(out) :: rc !< Error handler + integer, optional , intent(out) :: rc !< Return code ! local variables type(ESMF_Field) :: lfield @@ -685,7 +685,7 @@ subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc) type(ESMF_State) , intent(in) :: State !< ESMF state character(len=*) , intent(in) :: fldname !< Field name real(ESMF_KIND_R8), pointer , intent(in) :: fldptr(:,:)!< Pointer to the 2D field - integer, optional , intent(out) :: rc !< Error handler + integer, optional , intent(out) :: rc !< Return code ! local variables type(ESMF_Field) :: lfield @@ -721,7 +721,7 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r !! the computational domain real (ESMF_KIND_R8) , intent(inout) :: output(isc:iec,jsc:jec)!< Output 2D array logical, optional , intent(in) :: do_sum !< If true, sums the data - integer , intent(out) :: rc !< Error handler + integer , intent(out) :: rc !< Return code ! local variables type(ESMF_StateItem_Flag) :: itemFlag @@ -802,7 +802,7 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid !! the computational domain real (ESMF_KIND_R8) , intent(in) :: input(isc:iec,jsc:jec)!< Input 2D array type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean horizontal grid - integer , intent(out) :: rc !< Error handler + integer , intent(out) :: rc !< Return code ! local variables type(ESMF_StateItem_Flag) :: itemFlag From a5b88424349444896436a91622647a33209b8df0 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 26 Mar 2019 16:46:49 -0600 Subject: [PATCH 1041/1072] Add doxumentation --- config_src/nuopc_driver/mom_cap_time.F90 | 92 ++++++++++-------------- 1 file changed, 38 insertions(+), 54 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap_time.F90 b/config_src/nuopc_driver/mom_cap_time.F90 index bd26785f54..cd7f65b88b 100644 --- a/config_src/nuopc_driver/mom_cap_time.F90 +++ b/config_src/nuopc_driver/mom_cap_time.F90 @@ -1,11 +1,9 @@ -! -! This was originally share code in CIME, but required CIME as a -! dependency to build the MOM cap. The options here for setting -! a restart alarm are useful for all caps, so a second step is to -! determine if/how these could be offered more generally in a -! shared library. For now we really want the MOM cap to only -! depend on MOM and ESMF/NUOPC. -! +!> This was originally share code in CIME, but required CIME as a +!! dependency to build the MOM cap. The options here for setting +!! a restart alarm are useful for all caps, so a second step is to +!! determine if/how these could be offered more generally in a +!! shared library. For now we really want the MOM cap to only +!! depend on MOM and ESMF/NUOPC. module mom_cap_time ! !USES: @@ -55,37 +53,31 @@ module mom_cap_time character(len=*), parameter :: u_FILE_u = & __FILE__ -!=============================================================================== contains -!=============================================================================== +!> Setup an alarm in a clock. The ringtime sent to AlarmCreate +!! MUST be the next alarm time. If you send an arbitrary but +!! proper ringtime from the past and the ring interval, the alarm +!! will always go off on the next clock advance and this will cause +!! serious problems. Even if it makes sense to initialize an alarm +!! with some reference time and the alarm interval, that reference +!! time has to be advance forward to be >= the current time. +!! In the logic below we set an appropriate "NextAlarm" and then +!! we make sure to advance it properly based on the ring interval. subroutine AlarmInit( clock, alarm, option, & opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) - - ! !DESCRIPTION: Setup an alarm in a clock - ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm - ! time. If you send an arbitrary but proper ringtime from the - ! past and the ring interval, the alarm will always go off on the - ! next clock advance and this will cause serious problems. Even - ! if it makes sense to initialize an alarm with some reference - ! time and the alarm interval, that reference time has to be - ! advance forward to be >= the current time. In the logic below - ! we set an appropriate "NextAlarm" and then we make sure to - ! advance it properly based on the ring interval. - - ! input/output variables - type(ESMF_Clock) , intent(inout) :: clock ! clock - type(ESMF_Alarm) , intent(inout) :: alarm ! alarm - character(len=*) , intent(in) :: option ! alarm option - integer , optional , intent(in) :: opt_n ! alarm freq - integer , optional , intent(in) :: opt_ymd ! alarm ymd - integer , optional , intent(in) :: opt_tod ! alarm tod (sec) - type(ESMF_Time) , optional , intent(in) :: RefTime ! ref time - character(len=*) , optional , intent(in) :: alarmname ! alarm name - integer , intent(inout) :: rc ! Return code + type(ESMF_Clock) , intent(inout) :: clock !< ESMF clock + type(ESMF_Alarm) , intent(inout) :: alarm !< ESMF alarm + character(len=*) , intent(in) :: option !< alarm option + integer , optional , intent(in) :: opt_n !< alarm freq + integer , optional , intent(in) :: opt_ymd !< alarm ymd + integer , optional , intent(in) :: opt_tod !< alarm tod (sec) + type(ESMF_Time) , optional , intent(in) :: RefTime !< ref time + character(len=*) , optional , intent(in) :: alarmname !< alarm name + integer , intent(inout) :: rc !< Return code ! local variables - type(ESMF_Calendar) :: cal ! calendar + type(ESMF_Calendar) :: cal ! calendar integer :: lymd ! local ymd integer :: ltod ! local tod integer :: cyy,cmm,cdd,csec ! time info @@ -347,22 +339,17 @@ subroutine AlarmInit( clock, alarm, option, & end subroutine AlarmInit -!=============================================================================== - +!> Creates the ESMF_Time object corresponding to the given input time, +!! given in YMD (Year Month Day) and TOD (Time-of-day) format. Sets +!! the time by an integer as YYYYMMDD and integer seconds in the day. subroutine TimeInit( Time, ymd, cal, tod, desc, logunit, rc) - - ! Create the ESMF_Time object corresponding to the given input time, given in - ! YMD (Year Month Day) and TOD (Time-of-day) format. - ! Set the time by an integer as YYYYMMDD and integer seconds in the day - - ! input/output parameters: - type(ESMF_Time) , intent(inout) :: Time ! ESMF time - integer , intent(in) :: ymd ! year, month, day YYYYMMDD - type(ESMF_Calendar) , intent(in) :: cal ! ESMF calendar - integer , intent(in), optional :: tod ! time of day in seconds - character(len=*) , intent(in), optional :: desc ! description of time to set - integer , intent(in), optional :: logunit - integer , intent(out), optional :: rc + type(ESMF_Time) , intent(inout) :: Time !< ESMF time + integer , intent(in) :: ymd !< year, month, day YYYYMMDD + type(ESMF_Calendar) , intent(in) :: cal !< ESMF calendar + integer , intent(in), optional :: tod !< time of day in [sec] + character(len=*) , intent(in), optional :: desc !< description of time to set + integer , intent(in), optional :: logunit!< Unit for stdout output + integer , intent(out), optional :: rc !< Return code ! local varaibles integer :: yr, mon, day ! Year, month, day as integers @@ -398,13 +385,10 @@ subroutine TimeInit( Time, ymd, cal, tod, desc, logunit, rc) end subroutine TimeInit -!=============================================================================== - +!> Converts a coded-date (yyyymmdd) into calendar year,month,day. subroutine date2ymd (date, year, month, day) - - ! input/output variables - integer, intent(in) :: date ! coded-date (yyyymmdd) - integer, intent(out) :: year,month,day ! calendar year,month,day + integer, intent(in) :: date !< coded-date (yyyymmdd) + integer, intent(out) :: year,month,day !< calendar year,month,day ! local variables integer :: tdate ! temporary date From c2900ac6d1c464b986e4f07d3379460b7d2d89ed Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 27 Mar 2019 09:44:35 -0600 Subject: [PATCH 1042/1072] Loads missing modules --- config_src/nuopc_driver/mom_cap.F90 | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index eb889e71e9..63679cca3d 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -352,7 +352,6 @@ module mom_cap_mod use, intrinsic :: iso_fortran_env, only: output_unit -! TODO add only below. use ESMF, only: ESMF_ClockAdvance, ESMF_ClockGet, ESMF_ClockPrint use ESMF, only: ESMF_ClockGetAlarm, ESMF_ClockGetNextTime, ESMF_ClockAdvance use ESMF, only: ESMF_ClockSet, ESMF_Clock, ESMF_GeomType_Flag, ESMF_LOGMSG_INFO @@ -360,7 +359,7 @@ module mom_cap_mod use ESMF, only: ESMF_GridGetCoord, ESMF_GridAddItem, ESMF_GridGetItem use ESMF, only: ESMF_GridComp, ESMF_GridCompSetEntryPoint, ESMF_GridCompGet use ESMF, only: ESMF_LogFoundError, ESMF_LogWrite, ESMF_LogSetError -use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_GridCompGetInternalState +use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_KIND_R8, ESMF_RC_VAL_WRONG use ESMF, only: ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID, ESMF_SUCCESS use ESMF, only: ESMF_METHOD_INITIALIZE, ESMF_MethodRemove, ESMF_State use ESMF, only: ESMF_LOGMSG_INFO, ESMF_RC_ARG_BAD, ESMF_VM, ESMF_Time @@ -371,12 +370,22 @@ module mom_cap_mod use ESMF, only: ESMF_KIND_I8, ESMF_FAILURE, ESMF_DistGridCreate, ESMF_MeshCreate use ESMF, only: ESMF_FILEFORMAT_ESMFMESH, ESMF_DELayoutCreate, ESMF_DistGridConnectionSet use ESMF, only: ESMF_DistGridGet, ESMF_STAGGERLOC_CORNER, ESMF_GRIDITEM_MASK -use ESMF, only: ESMF_TYPEKIND_I4, ESMF_TYPEKIND_R8, ESMF_STAGGERLOC_CENTER, +use ESMF, only: ESMF_TYPEKIND_I4, ESMF_TYPEKIND_R8, ESMF_STAGGERLOC_CENTER use ESMF, only: ESMF_GRIDITEM_AREA, ESMF_Field, ESMF_ALARM, ESMF_VMLogMemInfo use ESMF, only: ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_StateRemove -use ESMF, only: ESMF_FieldCreate - -use NUOPC +use ESMF, only: ESMF_FieldCreate, ESMF_LOGMSG_ERROR, ESMF_LOGMSG_WARNING +use ESMF, only: ESMF_COORDSYS_SPH_DEG, ESMF_GridCreate, ESMF_INDEX_DELOCAL +use ESMF, only: ESMF_MESHLOC_ELEMENT, ESMF_RC_VAL_OUTOFRANGE, ESMF_StateGet +use ESMF, only: ESMF_TimePrint, ESMF_AlarmSet, ESMF_FieldGet + +!TODO, where this is comming from? +! 1) ESMF_GridCompGetInternalState + +use NUOPC, only: NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize +use NUOPC, only: NUOPC_CompFilterPhaseMap, NUOPC_CompAttributeGet, NUOPC_CompAttributeAdd +use NUOPC, only: NUOPC_Advertise, NUOPC_SetAttribute, NUOPC_IsUpdated, NUOPC_Write +use NUOPC, only: NUOPC_IsConnected, NUOPC_Realize, NUOPC_CompAttributeSet +use NUOPC_Model, only: NUOPC_ModelGet use NUOPC_Model, & model_routine_SS => SetServices, & model_label_Advance => label_Advance, & From c7042b4a7cc5495c48d068cf370f006ba68d91fc Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 27 Mar 2019 09:58:19 -0600 Subject: [PATCH 1043/1072] Add more doxumentation and TODOs --- config_src/nuopc_driver/mom_cap.F90 | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 63679cca3d..dceef70804 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -378,8 +378,9 @@ module mom_cap_mod use ESMF, only: ESMF_MESHLOC_ELEMENT, ESMF_RC_VAL_OUTOFRANGE, ESMF_StateGet use ESMF, only: ESMF_TimePrint, ESMF_AlarmSet, ESMF_FieldGet -!TODO, where this is comming from? -! 1) ESMF_GridCompGetInternalState +! TODO ESMF_GridCompGetInternalState does not have an explicit Fortran interface. +!! Model does not compile with "use ESMF, only: ESMF_GridCompGetInternalState" +!! Is this okay? use NUOPC, only: NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize use NUOPC, only: NUOPC_CompFilterPhaseMap, NUOPC_CompAttributeGet, NUOPC_CompAttributeAdd @@ -2242,16 +2243,17 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ end subroutine State_SetScalar -!> TODO +!> Realize the import and export fields using either a grid or a mesh. subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) - - type(ESMF_State) , intent(inout) :: state - integer , intent(in) :: nfields - type(fld_list_type) , intent(inout) :: field_defs(:) - character(len=*) , intent(in) :: tag - type(ESMF_Grid) , intent(in), optional :: grid - type(ESMF_Mesh) , intent(in), optional :: mesh - integer , intent(inout) :: rc + type(ESMF_State) , intent(inout) :: state !< ESMF_State object for + !! import/export fields. + integer , intent(in) :: nfields !< Number of fields. + type(fld_list_type) , intent(inout) :: field_defs(:) !< Structure with field's + !! information. + character(len=*) , intent(in) :: tag !< Import or export. + type(ESMF_Grid) , intent(in), optional :: grid!< ESMF grid. + type(ESMF_Mesh) , intent(in), optional :: mesh!< ESMF mesh. + integer , intent(inout) :: rc !< Return code. ! local variables integer :: i From 7ceda76b61f9eb90d94390c4dc1b944729ec5577 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 27 Mar 2019 10:01:38 -0600 Subject: [PATCH 1044/1072] Add more doxumentation --- config_src/nuopc_driver/MOM_surface_forcing.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 91d3ed6e3d..73f96839ec 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -1,3 +1,4 @@ +!> Set of subroutines to deal with forcing fields that may be used to drive MOM. module MOM_surface_forcing ! This file is part of MOM6. See LICENSE.md for the license. From e73c579d09601d8c8d86b9cd672e3177593fa40a Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 27 Mar 2019 10:03:49 -0600 Subject: [PATCH 1045/1072] Removes unecessary comments --- config_src/nuopc_driver/mom_cap_methods.F90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 036497be09..ee713846b6 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -58,8 +58,6 @@ end subroutine mom_set_geomtype !! (1) it imports surface fluxes using data from the mediator; and !! (2) it can apply restoring in SST and SSS. subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype, rc) - - ! Input/output variables type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid type(ESMF_State) , intent(inout) :: importState !< incoming data from mediator @@ -343,8 +341,6 @@ end subroutine mom_import !> Maps outgoing ocean data to ESMF State subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc) - - ! Input/output variables type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid type(ocean_state_type) , pointer :: ocean_state !< Ocean state From d89b4b51da28b6b71176c78d066aec55b15a493d Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 27 Mar 2019 10:13:54 -0600 Subject: [PATCH 1046/1072] Updates doxumentation --- config_src/nuopc_driver/time_utils.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/nuopc_driver/time_utils.F90 b/config_src/nuopc_driver/time_utils.F90 index 49bad199a1..e995c1b697 100644 --- a/config_src/nuopc_driver/time_utils.F90 +++ b/config_src/nuopc_driver/time_utils.F90 @@ -1,4 +1,4 @@ -!> Set of subroutines that convert date/time between FMS and ESMF formats. +!> Set of time utilities for converting between FMS and ESMF time type. module time_utils_mod ! FMS From 306bcfb1afe4f118ab0539594f2e037c882a987d Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 27 Mar 2019 10:14:06 -0600 Subject: [PATCH 1047/1072] Updates doxumentation --- config_src/nuopc_driver/MOM_surface_forcing.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 73f96839ec..ad68fb887f 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -1,4 +1,4 @@ -!> Set of subroutines to deal with forcing fields that may be used to drive MOM. +!> Converts the input ESMF data (import data) to a MOM-specific data type (surface_forcing_CS). module MOM_surface_forcing ! This file is part of MOM6. See LICENSE.md for the license. From 63514abeee7f1f2334a01b2807a6e833873eee62 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 27 Mar 2019 10:42:56 -0600 Subject: [PATCH 1048/1072] Repalces end if > endif and end do > enddo --- config_src/nuopc_driver/mom_cap.F90 | 36 +++++----- config_src/nuopc_driver/mom_cap_methods.F90 | 74 ++++++++++----------- config_src/nuopc_driver/mom_cap_time.F90 | 16 ++--- 3 files changed, 63 insertions(+), 63 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index dceef70804..25bb8c69aa 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -925,7 +925,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) return endif - end if + endif ocean_public%is_ocean_pe = .true. if (len_trim(restartfile) > 0) then @@ -1002,7 +1002,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) else !call fld_list_add(fldsToOcn_num, fldsToOcn, "mass_of_overlying_sea_ice" , "will provide") !call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_lev" , "will provide") - end if + endif !--------- import fields ------------- call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide") ! from ice @@ -1199,7 +1199,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return enddo - end if + endif !--------------------------------- ! Create either a grid or a mesh @@ -1250,7 +1250,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (localPet == 0) then write(logunit,*)'mesh file for mom6 domain is ',trim(cvalue) - end if + endif ! recreate the mesh using the above distGrid EMesh = ESMF_MeshCreate(EMeshTemp, elementDistgrid=Distgrid, rc=rc) @@ -1515,9 +1515,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) dataPtr_ycen(i1,j1) = ocean_grid%geolatT(ig,jg) if(grid_attach_area) then dataPtr_area(i1,j1) = ocean_grid%areaT(ig,jg) - end if - end do - end do + endif + enddo + enddo jlast = jec if(jec == nyg)jlast = jec+1 @@ -1530,8 +1530,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ig = i + ocean_grid%isc - isc - 1 dataPtr_xcor(i1,j1) = ocean_grid%geolonBu(ig,jg) dataPtr_ycor(i1,j1) = ocean_grid%geolatBu(ig,jg) - end do - end do + enddo + enddo write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) @@ -1567,7 +1567,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return - end if + endif !--------------------------------- ! set scalar data in export state @@ -1655,7 +1655,7 @@ subroutine DataInitialize(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - end if + endif call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1682,7 +1682,7 @@ subroutine DataInitialize(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - end do + enddo deallocate(fieldNameList) ! check whether all Fields in the exportState are "Updated" @@ -1694,7 +1694,7 @@ subroutine DataInitialize(gcomp, rc) line=__LINE__, & file=__FILE__)) & return ! bail out - end if + endif if(write_diagnostics) then call NUOPC_Write(exportState, fileNamePrefix='field_init_ocn_export_', & @@ -1833,7 +1833,7 @@ subroutine ModelAdvance(gcomp, rc) call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype=runtype, rc=rc) else call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc=rc) - end if + endif if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1962,7 +1962,7 @@ subroutine ModelAdvance(gcomp, rc) if (is_root_pe()) then write(logunit,*) subname//' writing restart file ',trim(restartname) - end if + endif endif !--------------- @@ -2124,7 +2124,7 @@ subroutine ModelSetRunClock(gcomp, rc) file=__FILE__)) & return ! bail out - end if + endif !-------------------------------- ! Advance model clock to trigger alarms then reset model clock back to currtime @@ -2195,7 +2195,7 @@ subroutine ocean_model_finalize(gcomp, rc) call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.false.) else call ocean_model_end(ocean_public, ocean_State, Time, write_restart=.true.) - end if + endif call field_manager_end() call fms_io_exit() @@ -2325,7 +2325,7 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) return ! bail out fldptr1d(:) = 0.0 - end if + endif endif diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index ee713846b6..46559fb22a 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -86,10 +86,10 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, do_import = .false. ! This will skip the first time import information is given else do_import = .true. - end if + endif else do_import = .true. - end if + endif if (do_import) then ! The following are global indices without halos @@ -182,8 +182,8 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, - ocean_grid%sin_rot(ig,jg)*tauy(i,j) ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg)*tauy(i,j) & + ocean_grid%sin_rot(ig,jg)*taux(i,j) - end do - end do + enddo + enddo deallocate(taux, tauy) @@ -335,7 +335,7 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, file=__FILE__)) & return ! bail out - end if + endif end subroutine mom_import @@ -390,7 +390,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, inv_dt_int = 1.0 / real(dt_int) else inv_dt_int = 0.0 - end if + endif !---------------- ! Copy from ocean_public to exportstate. @@ -460,8 +460,8 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ocm(i,j) = ocean_public%v_surf(i,j) ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) + ocean_grid%sin_rot(ig,jg)*ocm(i,j) ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) - ocean_grid%sin_rot(ig,jg)*ocz(i,j) - end do - end do + enddo + enddo call State_SetExport(exportState, 'ocn_current_zonal', & isc, iec, jsc, jec, ocz_rot, ocean_grid, rc=rc) @@ -490,7 +490,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, line=__LINE__, & file=__FILE__)) & return ! bail out - end if + endif ! ------- ! Freezing melting potential @@ -507,9 +507,9 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, else melt_potential(i,j) = -ocean_public%melt_potential(i,j) * inv_dt_int if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 - end if - end do - end do + endif + enddo + enddo call State_SetExport(exportState, 'freezing_melting_potential', & isc, iec, jsc, jec, melt_potential, ocean_grid, rc=rc) @@ -531,7 +531,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, line=__LINE__, & file=__FILE__)) & return ! bail out - end if + endif !---------------- ! Sea-surface zonal and meridional slopes @@ -553,8 +553,8 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, do i = ocean_grid%isc,ocean_grid%iec iloc = i + ocean_grid%idg_offset ssh(i,j) = ocean_public%sea_lev(iloc,jloc) - end do - end do + enddo + enddo ! Update halo of ssh so we can calculate gradients (local indexing) call pass_var(ssh, ocean_grid%domain) @@ -583,11 +583,11 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! Extrema in the mean values require a PCM reconstruction avoid generating ! larger extreme values. slope = 0.0 - end if + endif dhdx(iglob,jglob) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) if (ocean_grid%mask2dT(i,j)==0.) dhdx(iglob,jglob) = 0.0 - end do - end do + enddo + enddo ! d/dy ssh ! This is a simple second-order difference @@ -613,11 +613,11 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! Extrema in the mean values require a PCM reconstruction avoid generating ! larger extreme values. slope = 0.0 - end if + endif dhdy(iglob,jglob) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) if (ocean_grid%mask2dT(i,j)==0.) dhdy(iglob,jglob) = 0.0 - end do - end do + enddo + enddo ! rotate slopes from tripolar grid back to lat/lon grid, x,y => latlon (CCW) ! "ocean_grid" uses has halos and uses local indexing. @@ -628,8 +628,8 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ig = i + ocean_grid%isc - isc dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) + ocean_grid%sin_rot(ig,jg)*dhdy(i,j) dhdy_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) - ocean_grid%sin_rot(ig,jg)*dhdx(i,j) - end do - end do + enddo + enddo call State_SetExport(exportState, 'sea_surface_slope_zonal', & isc, iec, jsc, jec, dhdx_rot, ocean_grid, rc=rc) @@ -751,9 +751,9 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r output(i,j) = output(i,j) + dataPtr1d(n) else output(i,j) = dataPtr1d(n) - end if - end do - end do + endif + enddo + enddo else if (geomtype == ESMF_GEOMTYPE_GRID) then @@ -774,13 +774,13 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r output(i,j) = output(i,j) + dataPtr2d(i1,j1) else output(i,j) = dataPtr2d(i1,j1) - end if - end do - end do + endif + enddo + enddo - end if + endif - end if + endif end subroutine State_GetImport @@ -833,8 +833,8 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid ig = i + ocean_grid%isc - isc n = n+1 dataPtr1d(n) = input(i,j) * ocean_grid%mask2dT(ig,jg) - end do - end do + enddo + enddo else if (geomtype == ESMF_GEOMTYPE_GRID) then @@ -854,12 +854,12 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid i1 = i + lbnd1 - isc ig = i + ocean_grid%isc - isc dataPtr2d(i1,j1) = input(i,j) * ocean_grid%mask2dT(ig,jg) - end do - end do + enddo + enddo - end if + endif - end if + endif end subroutine State_SetExport diff --git a/config_src/nuopc_driver/mom_cap_time.F90 b/config_src/nuopc_driver/mom_cap_time.F90 index cd7f65b88b..dc4f81e90e 100644 --- a/config_src/nuopc_driver/mom_cap_time.F90 +++ b/config_src/nuopc_driver/mom_cap_time.F90 @@ -114,14 +114,14 @@ subroutine AlarmInit( clock, alarm, option, & line=__LINE__, & file=__FILE__, rcToReturn=rc) return - end if + endif if (opt_n <= 0) then call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//trim(option)//' invalid opt_n', & line=__LINE__, & file=__FILE__, rcToReturn=rc) return - end if + endif endif call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) @@ -179,14 +179,14 @@ subroutine AlarmInit( clock, alarm, option, & line=__LINE__, & file=__FILE__, rcToReturn=rc) return - end if + endif if (lymd < 0 .or. ltod < 0) then call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//trim(option)//'opt_ymd, opt_tod invalid', & line=__LINE__, & file=__FILE__, rcToReturn=rc) return - end if + endif call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -206,7 +206,7 @@ subroutine AlarmInit( clock, alarm, option, & line=__LINE__, & file=__FILE__, rcToReturn=rc) return - end if + endif call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -367,13 +367,13 @@ subroutine TimeInit( Time, ymd, cal, tod, desc, logunit, rc) if (present(logunit)) then write(logunit,*) subname//': ERROR yymmdd is a negative number or '// & 'time-of-day out of bounds', ymd, ltod - end if + endif call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg=subname//' yymmdd is negative or time-of-day out of bounds ', & line=__LINE__, & file=__FILE__, rcToReturn=rc) return - end if + endif call date2ymd (ymd,yr,mon,day) @@ -399,7 +399,7 @@ subroutine date2ymd (date, year, month, day) year = int(tdate/10000) if (date < 0) then year = -year - end if + endif month = int( mod(tdate,10000)/ 100) day = mod(tdate, 100) From d3a57bc16ec0490a1fe865445efc24aaa7891562 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 9 Apr 2019 15:30:35 -0400 Subject: [PATCH 1049/1072] +Added dimensional rescaling of Coriolis parameter Changed the units of G%CoriolisBu from s-1 to T-1 for dimensional consistency testing and verified that all answers are bitwise identical for a range of values of T_RESCALE_POWER. This required several unit_scale_type arguments to be added to some routines. All answers are bitwise identical in the MOM6_examples test cases. --- src/core/MOM_CoriolisAdv.F90 | 10 ++-- src/core/MOM_barotropic.F90 | 12 ++--- src/core/MOM_dynamics_split_RK2.F90 | 10 ++-- src/core/MOM_dynamics_unsplit.F90 | 10 ++-- src/core/MOM_dynamics_unsplit_RK2.F90 | 8 +-- src/core/MOM_grid.F90 | 8 +-- src/diagnostics/MOM_diagnostics.F90 | 10 ++-- src/diagnostics/MOM_wave_structure.F90 | 4 +- src/framework/MOM_dyn_horgrid.F90 | 6 +-- src/ice_shelf/MOM_ice_shelf.F90 | 8 +-- .../MOM_fixed_initialization.F90 | 10 ++-- .../MOM_shared_initialization.F90 | 41 +++++++++----- .../MOM_state_initialization.F90 | 2 +- src/parameterizations/lateral/MOM_MEKE.F90 | 21 ++++---- .../lateral/MOM_hor_visc.F90 | 20 ++++--- .../lateral/MOM_internal_tides.F90 | 53 +++++++++++-------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 19 +++---- .../lateral/MOM_mixed_layer_restrat.F90 | 8 +-- .../vertical/MOM_CVMix_KPP.F90 | 4 +- .../vertical/MOM_bulk_mixed_layer.F90 | 8 +-- .../vertical/MOM_diapyc_energy_req.F90 | 4 +- .../vertical/MOM_energetic_PBL.F90 | 4 +- .../vertical/MOM_kappa_shear.F90 | 6 +-- .../vertical/MOM_set_diffusivity.F90 | 12 ++--- .../vertical/MOM_set_viscosity.F90 | 16 +++--- .../vertical/MOM_vert_friction.F90 | 4 +- src/user/Idealized_Hurricane.F90 | 10 ++-- src/user/Kelvin_initialization.F90 | 2 +- src/user/MOM_wave_interface.F90 | 9 ++-- src/user/Phillips_initialization.F90 | 4 +- src/user/Rossby_front_2d_initialization.F90 | 11 ++-- src/user/user_initialization.F90 | 2 +- 32 files changed, 196 insertions(+), 160 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 450d71d23e..6b4fdd8924 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -13,6 +13,7 @@ module MOM_CoriolisAdv use MOM_open_boundary, only : ocean_OBC_type, OBC_DIRECTION_E, OBC_DIRECTION_W use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_string_functions, only : uppercase +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : accel_diag_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -107,7 +108,7 @@ module MOM_CoriolisAdv contains !> Calculates the Coriolis and momentum advection contributions to the acceleration. -subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) +subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocen grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1] @@ -122,8 +123,9 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: CAv !< Meridional acceleration due to Coriolis !! and momentum advection [m s-2]. type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - type(accel_diag_ptrs), intent(inout) :: AD !< Storage for acceleration diagnostics - type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv + type(accel_diag_ptrs), intent(inout) :: AD !< Storage for acceleration diagnostics + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv ! Local variables real, dimension(SZIB_(G),SZJB_(G)) :: & @@ -410,7 +412,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) relative_vorticity = G%mask2dBu(I,J) * (dvdx(I,J) - dudy(I,J)) * & G%IareaBu(I,J) endif - absolute_vorticity = G%CoriolisBu(I,J) + relative_vorticity + absolute_vorticity = US%s_to_T*G%CoriolisBu(I,J) + relative_vorticity Ih = 0.0 if (Area_q(i,j) > 0.0) then hArea_q = (hArea_u(I,j) + hArea_u(I,j+1)) + (hArea_v(i,J) + hArea_v(i+1,J)) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index cdc5ed0251..57914ad7c4 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -821,7 +821,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do I=is-1,ie - q(I,J) = 0.25 * G%CoriolisBu(I,J) * & + q(I,J) = 0.25 * US%s_to_T*G%CoriolisBu(I,J) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & ((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)) ) @@ -1396,8 +1396,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, gtot_W(i,j) * (Datu(I-1,j)*G%IdxCu(I-1,j))) + & (gtot_N(i,j) * (Datv(i,J)*G%IdyCv(i,J)) + & gtot_S(i,j) * (Datv(i,J-1)*G%IdyCv(i,J-1)))) + & - ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))) + US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))) H_eff_dx2 = max(H_min_dyn * (G%IdxT(i,j)**2 + G%IdyT(i,j)**2), & G%IareaT(i,j) * & ((Datu(I,j)*G%IdxCu(I,j) + Datu(I-1,j)*G%IdxCu(I-1,j)) + & @@ -2364,8 +2364,8 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) Idt_max2 = 0.5 * (1.0 + 2.0*CS%bebt) * (G%IareaT(i,j) * & ((gtot_E(i,j)*Datu(I,j)*G%IdxCu(I,j) + gtot_W(i,j)*Datu(I-1,j)*G%IdxCu(I-1,j)) + & (gtot_N(i,j)*Datv(i,J)*G%IdyCv(i,J) + gtot_S(i,j)*Datv(i,J-1)*G%IdyCv(i,J-1))) + & - ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))) + US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))) if (Idt_max2 * min_max_dt2 > 1.0) min_max_dt2 = 1.0 / Idt_max2 enddo ; enddo dtbt_max = sqrt(min_max_dt2 / dgeo_de) @@ -4105,7 +4105,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, enddo ; enddo do J=js-1,je ; do I=is-1,ie if (G%mask2dT(i,j)+G%mask2dT(i,j+1)+G%mask2dT(i+1,j)+G%mask2dT(i+1,j+1)>0.) then - CS%q_D(I,J) = 0.25 * G%CoriolisBu(I,J) * & + CS%q_D(I,J) = 0.25 * US%s_to_T*G%CoriolisBu(I,J) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & ((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)) ) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 2a4eeaf21a..c87154b587 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -433,7 +433,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, Gv, CS%CoriolisAdv_CSp) + G, Gv, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") @@ -682,14 +682,14 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! diffu = horizontal viscosity terms (u_av) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u_av, v_av, h_av, CS%diffu, CS%diffv, & - MEKE, Varmix, G, GV, CS%hor_visc_CSp, OBC=CS%OBC) + MEKE, Varmix, G, GV, US, CS%hor_visc_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_horvisc) if (showCallTree) call callTree_wayPoint("done with horizontal_viscosity (step_MOM_dyn_split_RK2)") ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") @@ -1096,7 +1096,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) - call hor_visc_init(Time, G, param_file, diag, CS%hor_visc_CSp) + call hor_visc_init(Time, G, US, param_file, diag, CS%hor_visc_CSp) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & @@ -1136,7 +1136,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (.not. query_initialized(CS%diffu,"diffu",restart_CS) .or. & .not. query_initialized(CS%diffv,"diffv",restart_CS)) & call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, VarMix, & - G, GV, CS%hor_visc_CSp, OBC=CS%OBC) + G, GV, US, CS%hor_visc_CSp, OBC=CS%OBC) if (.not. query_initialized(CS%u_av,"u2", restart_CS) .or. & .not. query_initialized(CS%u_av,"v2", restart_CS)) then CS%u_av(:,:,:) = u(:,:,:) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 887a6c4f54..0995725536 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -255,7 +255,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call enable_averaging(dt,Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, Varmix, & - G, GV, CS%hor_visc_CSp) + G, GV, US, CS%hor_visc_CSp) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) @@ -300,7 +300,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta)/h_av vh + d/dx KE call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u, v, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) @@ -368,7 +368,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta(up))/h_av vh + d/dx KE(up) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(up, vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) @@ -450,7 +450,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta(upp))/h_av vh + d/dx KE(upp) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(upp, vpp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) @@ -653,7 +653,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) - call hor_visc_init(Time, G, param_file, diag, CS%hor_visc_CSp) + call hor_visc_init(Time, G, US, param_file, diag, CS%hor_visc_CSp) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index e3625dd6a3..c3525801a0 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -266,7 +266,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call enable_averaging(dt,Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) call horizontal_viscosity(u_in, v_in, h_in, CS%diffu, CS%diffv, MEKE, VarMix, & - G, GV, CS%hor_visc_CSp) + G, GV, US, CS%hor_visc_CSp) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) call pass_vector(CS%diffu, CS%diffv, G%Domain, clock=id_clock_pass) @@ -295,7 +295,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! CAu = -(f+zeta)/h_av vh + d/dx KE (function of u[n-1] and uh[n-1]) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(u_in, v_in, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) ! PFu = d/dx M(h_av,T,S) (function of h[n-1/2]) @@ -367,7 +367,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! CAu = -(f+zeta(up))/h_av vh + d/dx KE(up) (function of up[n-1/2], h[n-1/2]) call cpu_clock_begin(id_clock_Cor) call CorAdCalc(up, vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, CS%CoriolisAdv_CSp) + G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) if (associated(CS%OBC)) then call open_boundary_zero_normal_flow(CS%OBC, G, CS%CAu, CS%CAv) @@ -613,7 +613,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) - call hor_visc_init(Time, G, param_file, diag, CS%hor_visc_CSp) + call hor_visc_init(Time, G, US, param_file, diag, CS%hor_visc_CSp) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 25cd31f96b..b66aecd261 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -149,11 +149,11 @@ module MOM_grid Dblock_v, & !< Topographic depths at v-points at which the flow is blocked [Z ~> m]. Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv [Z ~> m]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - CoriolisBu !< The Coriolis parameter at corner points [s-1]. + CoriolisBu !< The Coriolis parameter at corner points [T-1 ~> s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [s-1 m-1]. - df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [s-1 m-1]. - real :: g_Earth !< The gravitational acceleration [m s-2]. + df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. + df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. + real :: g_Earth !< The gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. ! These variables are global sums that are useful for 1-d diagnostics real :: areaT_global !< Global sum of h-cell area [m2] diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index cd3c87b922..767625f1ea 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -627,10 +627,10 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & !$OMP private(f2_h,mag_beta) do j=js,je ; do i=is,ie ! Blend the equatorial deformation radius with the standard one. - f2_h = absurdly_small_freq2 + 0.25 * & + f2_h = absurdly_small_freq2 + 0.25 * US%s_to_T**2 * & ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) - mag_beta = sqrt(0.5 * ( & + mag_beta = sqrt(0.5 * US%s_to_T**2 * ( & (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & @@ -676,10 +676,10 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & !$OMP private(f2_h,mag_beta) do j=js,je ; do i=is,ie ! Blend the equatorial deformation radius with the standard one. - f2_h = absurdly_small_freq2 + 0.25 * & + f2_h = absurdly_small_freq2 + 0.25 * US%s_to_T**2 * & ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) - mag_beta = sqrt(0.5 * ( & + mag_beta = sqrt(0.5 * US%s_to_T**2 * ( & (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & @@ -1916,7 +1916,7 @@ subroutine write_static_fields(G, GV, US, tv, diag) if (id > 0) call post_data(id, G%mask2dCv, diag, .true.) id = register_static_field('ocean_model', 'Coriolis', diag%axesB1, & - 'Coriolis parameter at corner (Bu) points', 's-1', interp_method='none') + 'Coriolis parameter at corner (Bu) points', 's-1', interp_method='none', conversion=US%s_to_T) if (id > 0) call post_data(id, G%CoriolisBu, diag, .true.) id = register_static_field('ocean_model', 'dxt', diag%axesT1, & diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 28ad4c6bfc..c289c540f0 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -459,8 +459,8 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo u_strct(nzm) = (w_strct(nzm-1)- w_strct(nzm))/dz(nzm-1) ! Calculate wavenumber magnitude - f2 = G%CoriolisBu(I,J)**2 - !f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + f2 = US%s_to_T**2 * G%CoriolisBu(I,J)**2 + !f2 = 0.25*US%s_to_T**2 *((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & ! (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) Kmag2 = (freq**2 - f2) / (cn(i,j)**2 + cg_subRO**2) diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 11155d73e6..0a83ef983e 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -148,10 +148,10 @@ module MOM_dyn_horgrid Dblock_v, & !< Topographic depths at v-points at which the flow is blocked [Z ~> m]. Dopen_v !< Topographic depths at v-points at which the flow is open at width dx_Cv [Z ~> m]. real, allocatable, dimension(:,:) :: & - CoriolisBu !< The Coriolis parameter at corner points [s-1]. + CoriolisBu !< The Coriolis parameter at corner points [T-1 ~> s-1]. real, allocatable, dimension(:,:) :: & - df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [s-1 m-1]. - df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [s-1 m-1]. + df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. + df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. ! These variables are global sums that are useful for 1-d diagnostics real :: areaT_global !< Global sum of h-cell area [m2] diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index fa4d2b0581..a10a0e55d6 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -375,8 +375,8 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) ! Estimate the neutral ocean boundary layer thickness as the minimum of the ! reported ocean mixed layer thickness and the neutral Ekman depth. - absf = 0.25*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & - (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) + absf = 0.25*US%s_to_T*((abs(US%s_to_T*G%CoriolisBu(I,J)) + abs(US%s_to_T*G%CoriolisBu(I-1,J-1))) + & + (abs(US%s_to_T*G%CoriolisBu(I,J-1)) + abs(US%s_to_T*G%CoriolisBu(I-1,J)))) if (absf*state%Hml(i,j) <= VK*ustar_h) then ; hBL_neut = state%Hml(i,j) else ; hBL_neut = (VK*ustar_h) / absf ; endif hBL_neut_h_molec = ZETA_N * ((hBL_neut * ustar_h) / (5.0 * CS%Kv_molec)) @@ -1394,8 +1394,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call rescale_dyn_horgrid_bathymetry(dG, US%Z_to_m) ! Set up the Coriolis parameter, G%f, usually analytically. - call MOM_initialize_rotation(dG%CoriolisBu, dG, param_file) - ! This copies grid elements, inglucy bathyT and CoriolisBu from dG to CS%grid. + call MOM_initialize_rotation(dG%CoriolisBu, dG, param_file, US) + ! This copies grid elements, including bathyT and CoriolisBu from dG to CS%grid. call copy_dyngrid_to_MOM_grid(dG, CS%grid) call destroy_dyn_horgrid(dG) diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index c2f188bc6f..f51676bd1b 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -147,13 +147,13 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) ! Calculate the value of the Coriolis parameter at the latitude ! ! of the q grid points [s-1]. - call MOM_initialize_rotation(G%CoriolisBu, G, PF) + call MOM_initialize_rotation(G%CoriolisBu, G, PF, US=US) ! Calculate the components of grad f (beta) - call MOM_calculate_grad_Coriolis(G%dF_dx, G%dF_dy, G) + call MOM_calculate_grad_Coriolis(G%dF_dx, G%dF_dy, G, US=US) if (debug) then - call qchksum(G%CoriolisBu, "MOM_initialize_fixed: f ", G%HI) - call hchksum(G%dF_dx, "MOM_initialize_fixed: dF_dx ", G%HI) - call hchksum(G%dF_dy, "MOM_initialize_fixed: dF_dy ", G%HI) + call qchksum(G%CoriolisBu, "MOM_initialize_fixed: f ", G%HI, scale=US%s_to_T) + call hchksum(G%dF_dx, "MOM_initialize_fixed: dF_dx ", G%HI, scale=US%s_to_T) + call hchksum(G%dF_dy, "MOM_initialize_fixed: dF_dy ", G%HI, scale=US%s_to_T) endif call initialize_grid_rotation_angle(G, PF) diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 7613eae6b0..2f9b1cefcc 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -56,7 +56,7 @@ end subroutine MOM_shared_init_init !> MOM_initialize_rotation makes the appropriate call to set up the Coriolis parameter. subroutine MOM_initialize_rotation(f, G, PF, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type - real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent(out) :: f !< The Coriolis parameter [s-1] + real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent(out) :: f !< The Coriolis parameter [T-1 ~> s-1] type(param_file_type), intent(in) :: PF !< Parameter file structure type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type @@ -76,9 +76,9 @@ subroutine MOM_initialize_rotation(f, G, PF, US) " \t USER - call a user modified routine.", & default="2omegasinlat") select case (trim(config)) - case ("2omegasinlat"); call set_rotation_planetary(f, G, PF) - case ("beta"); call set_rotation_beta_plane(f, G, PF) - case ("betaplane"); call set_rotation_beta_plane(f, G, PF) + case ("2omegasinlat"); call set_rotation_planetary(f, G, PF, US) + case ("beta"); call set_rotation_beta_plane(f, G, PF, US) + case ("betaplane"); call set_rotation_beta_plane(f, G, PF, US) !case ("nonrotating") ! Note from AJA: Missing case? case default ; call MOM_error(FATAL,"MOM_initialize: "// & "Unrecognized rotation setup "//trim(config)) @@ -90,9 +90,9 @@ end subroutine MOM_initialize_rotation subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: dF_dx !< x-component of grad f + intent(out) :: dF_dx !< x-component of grad f [T-1 m-1 ~> s-1 m-1] real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: dF_dy !< y-component of grad f + intent(out) :: dF_dy !< y-component of grad f [T-1 m-1 ~> s-1 m-1] type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i,j @@ -459,20 +459,24 @@ end subroutine limit_topography subroutine set_rotation_planetary(f, G, param_file, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & - intent(out) :: f !< Coriolis parameter (vertical component) in s^-1 + intent(out) :: f !< Coriolis parameter (vertical component) [T-1 ~> s-1] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! This subroutine sets up the Coriolis parameter for a sphere character(len=30) :: mdl = "set_rotation_planetary" ! This subroutine's name. integer :: I, J - real :: PI, omega + real :: PI + real :: omega ! The planetary rotation rate [T-1 ~> s-1] + real :: T_to_s ! A time unit conversion factor call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") + T_to_s = 1.0 ; if (present(US)) T_to_s = US%T_to_s + call get_param(param_file, "set_rotation_planetary", "OMEGA", omega, & "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5) + default=7.2921e-5, scale=T_to_s) PI = 4.0*atan(1.0) do I=G%IsdB,G%IedB ; do J=G%JsdB,G%JedB @@ -488,24 +492,30 @@ end subroutine set_rotation_planetary subroutine set_rotation_beta_plane(f, G, param_file, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & - intent(out) :: f !< Coriolis parameter (vertical component) in s^-1 + intent(out) :: f !< Coriolis parameter (vertical component) [T-1 ~> s-1] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! This subroutine sets up the Coriolis parameter for a beta-plane integer :: I, J - real :: f_0, beta, y_scl, Rad_Earth, PI + real :: f_0 ! The reference value of the Coriolis parameter [T-1 ~> s-1] + real :: beta ! The meridional gradient of the Coriolis parameter [T-1 m-1 ~> s-1 m-1] + real :: y_scl, Rad_Earth + real :: T_to_s ! A time unit conversion factor + real :: PI character(len=40) :: mdl = "set_rotation_beta_plane" ! This subroutine's name. character(len=200) :: axis_units call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") + T_to_s = 1.0 ; if (present(US)) T_to_s = US%T_to_s + call get_param(param_file, mdl, "F_0", f_0, & "The reference value of the Coriolis parameter with the \n"//& - "betaplane option.", units="s-1", default=0.0) + "betaplane option.", units="s-1", default=0.0, scale=T_to_s) call get_param(param_file, mdl, "BETA", beta, & "The northward gradient of the Coriolis parameter with \n"//& - "the betaplane option.", units="m-1 s-1", default=0.0) + "the betaplane option.", units="m-1 s-1", default=0.0, scale=T_to_s) call get_param(param_file, mdl, "AXIS_UNITS", axis_units, default="degrees") PI = 4.0*atan(1.0) @@ -1159,6 +1169,7 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) type(vardesc) :: vars(nFlds) type(fieldtype) :: fields(nFlds) real :: Z_to_m_scale ! A unit conversion factor from Z to m. + real :: s_to_T_scale ! A unit conversion factor from T-1 to s-1. integer :: unit integer :: file_threading integer :: nFlds_used @@ -1176,6 +1187,7 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB Z_to_m_scale = 1.0 ; if (present(US)) Z_to_m_scale = US%Z_to_m + s_to_T_scale = 1.0 ; if (present(US)) s_to_T_scale = US%s_to_T ! vardesc is a structure defined in MOM_io.F90. The elements of ! this structure, in order, are: @@ -1247,7 +1259,8 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) do j=js,je ; do i=is,ie ; out_h(i,j) = Z_to_m_scale*G%bathyT(i,j) ; enddo ; enddo call write_field(unit, fields(5), G%Domain%mpp_domain, out_h) - call write_field(unit, fields(6), G%Domain%mpp_domain, G%CoriolisBu) + do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(i,J) = s_to_T_scale*G%CoriolisBu(I,J) ; enddo ; enddo + call write_field(unit, fields(6), G%Domain%mpp_domain, out_q) ! I think that all of these copies are holdovers from a much earlier ! ancestor code in which many of the metrics were macros that could have diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 4c7b720f67..32e7161b1e 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -415,7 +415,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & case ("phillips"); call Phillips_initialize_velocity(u, v, G, GV, US, PF, & just_read_params=just_read) case ("rossby_front"); call Rossby_front_initialize_velocity(u, v, h, & - G, GV, PF, just_read_params=just_read) + G, GV, US, PF, just_read_params=just_read) case ("soliton"); call soliton_initialize_velocity(u, v, h, G) case ("USER"); call user_initialize_velocity(u, v, G, PF, & just_read_params=just_read) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 21e06ebcef..74b3386374 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -561,7 +561,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m real :: beta, SN, bottomFac2, barotrFac2, LmixScale, Lrhines, Leady real :: I_H, KhCoeff, Kh, Ubg2, cd2, drag_rate, ldamping, src real :: EKE, EKEmin, EKEmax, resid, ResMin, ResMax, EKEerr - real :: FatH ! Coriolis parameter at h points; to compute topographic beta + real :: FatH ! Coriolis parameter at h points; to compute topographic beta [s-1] integer :: i, j, is, ie, js, je, n1, n2 real, parameter :: tolerance = 1.e-12 ! Width of EKE bracket [m2 s-2]. logical :: useSecant, debugIteration @@ -579,11 +579,12 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m ! This avoids extremes values in equilibrium solution due to bad values in SN_u, SN_v SN = min( min(SN_u(I,j) , SN_u(I-1,j)) , min(SN_v(i,J), SN_v(i,J-1)) ) - FatH = 0.25*((G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) + & + FatH = 0.25*US%s_to_T*((G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) + & (G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1))) !< Coriolis parameter at h points - beta = sqrt( ( G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j)* & + !### This expression should be recast to use a single division, but it will change answers. + beta = sqrt( ( US%s_to_T*G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j)* & (G%bathyT(i+1,j) - G%bathyT(i-1,j))/2./G%dxT(i,j) )**2. & - + ( G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & + + ( US%s_to_T*G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & *(G%bathyT(i,j+1) - G%bathyT(i,j-1))/2./G%dyT(i,j) )**2. ) I_H = GV%Rho0 * I_mass(i,j) @@ -690,7 +691,8 @@ subroutine MEKE_lengthScales(CS, MEKE, G, US, SN_u, SN_v, & real, dimension(SZI_(G),SZJ_(G)), intent(out) :: LmixScale !< Eddy mixing length [m]. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: Lrhines, Leady - real :: beta, SN, FatH + real :: beta, SN + real :: FatH ! Coriolis parameter at h points [s-1] integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -703,11 +705,12 @@ subroutine MEKE_lengthScales(CS, MEKE, G, US, SN_u, SN_v, & else SN = 0. endif - FatH = 0.25*( ( G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1) ) + & - ( G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1) ) ) ! Coriolis parameter at h points - beta = sqrt( ( G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & + FatH = 0.25*US%s_to_T* ( ( G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1) ) + & + ( G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1) ) ) ! Coriolis parameter at h points + !### This expression should be recast to use a single division, but it will change answers. + beta = sqrt( ( US%s_to_T*G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & *(G%bathyT(i+1,j) - G%bathyT(i-1,j)) /2./G%dxT(i,j) )**2. & - + ( G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & + + ( US%s_to_T*G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & *(G%bathyT(i,j+1) - G%bathyT(i,j-1))/2./G%dyT(i,j) )**2. ) endif ! Returns bottomFac2, barotrFac2 and LmixScale diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index a980704d21..5387e0fa8b 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -9,12 +9,13 @@ module MOM_hor_visc use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type +use MOM_io, only : MOM_read_data, slasher use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_MEKE_types, only : MEKE_type use MOM_open_boundary, only : ocean_OBC_type, OBC_DIRECTION_E, OBC_DIRECTION_W use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S, OBC_NONE +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type -use MOM_io, only : MOM_read_data, slasher implicit none ; private @@ -175,7 +176,7 @@ module MOM_hor_visc !! u[is-2:ie+2,js-2:je+2] !! v[is-2:ie+2,js-2:je+2] !! h[is-1:ie+1,js-1:je+1] -subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, OBC) +subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, CS, OBC) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -194,6 +195,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, !! related to Mesoscale Eddy Kinetic Energy. type(VarMix_CS), pointer :: VarMix !< Pointer to a structure with fields that !! specify the spatially variable viscosities + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(hor_visc_CS), pointer :: CS !< Pontrol structure returned by a previous !! call to hor_visc_init. type(ocean_OBC_type), optional, pointer :: OBC !< Pointer to an open boundary condition type @@ -893,12 +895,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, endif if (MEKE%backscatter_Ro_c /= 0.) then do j=js,je ; do i=is,ie - FatH = 0.25*( (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) & - +(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1))) ) + FatH = 0.25*US%s_to_T*( (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & + (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1))) ) Shear_mag = sqrt(sh_xx(i,j)*sh_xx(i,j) + & 0.25*((sh_xy(I-1,J-1)*sh_xy(I-1,J-1) + sh_xy(I,J)*sh_xy(I,J)) + & (sh_xy(I-1,J)*sh_xy(I-1,J) + sh_xy(I,J-1)*sh_xy(I,J-1)))) FatH = FatH ** MEKE%backscatter_Ro_pow ! f^n + !### Note the hard-coded dimensional constant in the following line. Shear_mag = ( ( Shear_mag ** MEKE%backscatter_Ro_pow ) + 1.e-30 ) & * MEKE%backscatter_Ro_c ! c * D^n ! The Rossby number function is g(Ro) = 1/(1+c.Ro^n) @@ -953,9 +956,10 @@ end subroutine horizontal_viscosity !> Allocates space for and calculates static variables used by horizontal_viscosity(). !! hor_visc_init calculates and stores the values of a number of metric functions that !! are used in horizontal_viscosity(). -subroutine hor_visc_init(Time, G, param_file, diag, CS) +subroutine hor_visc_init(Time, G, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< Current model time. type(ocean_grid_type), intent(inout) :: 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 !< Structure to regulate diagnostic output. @@ -1447,8 +1451,8 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) if (CS%Smagorinsky_Ah) then CS%BIHARM_CONST_xx(i,j) = Smag_bi_const * (grid_sp_h2 * grid_sp_h2) if (CS%bound_Coriolis) then - fmax = MAX(abs(G%CoriolisBu(I-1,J-1)), abs(G%CoriolisBu(I,J-1)), & - abs(G%CoriolisBu(I-1,J)), abs(G%CoriolisBu(I,J))) + fmax = US%s_to_T*MAX(abs(G%CoriolisBu(I-1,J-1)), abs(G%CoriolisBu(I,J-1)), & + abs(G%CoriolisBu(I-1,J)), abs(G%CoriolisBu(I,J))) CS%Biharm_Const2_xx(i,j) = (grid_sp_h2 * grid_sp_h2 * grid_sp_h2) * & (fmax * BoundCorConst) endif @@ -1471,7 +1475,7 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) CS%BIHARM_CONST_xy(I,J) = Smag_bi_const * (grid_sp_q2 * grid_sp_q2) if (CS%bound_Coriolis) then CS%Biharm_Const2_xy(I,J) = (grid_sp_q2 * grid_sp_q2 * grid_sp_q2) * & - (abs(G%CoriolisBu(I,J)) * BoundCorConst) + (abs(US%s_to_T*G%CoriolisBu(I,J)) * BoundCorConst) endif endif diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 4052f948a3..27115dec67 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -214,8 +214,11 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & if (CS%energized_angle <= 0) then frac_per_sector = 1.0 / real(CS%nAngle * CS%nMode * CS%nFreq) do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=js,je ; do i=is,ie - f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) + f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) + !### For rotational symmetry this should be + ! f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + ! (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) if (CS%frequency(fr)**2 > f2) & CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + & dt*frac_per_sector*(1-CS%q_itides)*TKE_itidal_input(i,j) @@ -224,8 +227,11 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & frac_per_sector = 1.0 / real(CS%nMode * CS%nFreq) a = CS%energized_angle do m=1,CS%nMode ; do fr=1,CS%nFreq ; do j=js,je ; do i=is,ie - f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) + f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) + !### For rotational symmetry this should be + ! f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + ! (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) if (CS%frequency(fr)**2 > f2) & CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + & dt*frac_per_sector**(1-CS%q_itides)*TKE_itidal_input(i,j) @@ -245,7 +251,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Apply half the refraction. do m=1,CS%nMode ; do fr=1,CS%nFreq - call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt, G, CS%nAngle, CS%use_PPMang) + call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt, G, US, CS%nAngle, CS%use_PPMang) enddo ; enddo ! Check for En<0 - for debugging, delete later @@ -271,7 +277,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Propagate the waves. do m=1,CS%NMode ; do fr=1,CS%Nfreq - call propagate(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), dt, G, CS, CS%NAngle) + call propagate(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), dt, G, US, CS, CS%NAngle) enddo ; enddo ! Check for En<0 - for debugging, delete later @@ -292,7 +298,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Apply the other half of the refraction. do m=1,CS%NMode ; do fr=1,CS%Nfreq - call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt, G, CS%NAngle, CS%use_PPMang) + call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt, G, US, CS%NAngle, CS%use_PPMang) enddo ; enddo ! Check for En<0 - for debugging, delete later @@ -421,8 +427,11 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & do j=jsd,jed ; do i=isd,ied id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging ! Calculate horizontal phase velocity magnitudes - f2 = 0.25*(G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2 + & - G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J-1)**2 ) + f2 = 0.25*US%s_to_T**2*(G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2 + & + G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J-1)**2 ) + !### For rotational symmetry this should be + ! f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + ! (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) Kmag2 = (freq2 - f2) / (cn(i,j,m)**2 + cn_subRO**2) c_phase = 0.0 if (Kmag2 > 0.0) then @@ -730,7 +739,7 @@ subroutine get_lowmode_loss(i,j,G,CS,mechanism,TKE_loss_sum) end subroutine get_lowmode_loss !> Implements refraction on the internal waves at a single frequency. -subroutine refract(En, cn, freq, dt, G, NAngle, use_PPMang) +subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -742,6 +751,7 @@ subroutine refract(En, cn, freq, dt, G, NAngle, use_PPMang) intent(in) :: cn !< Baroclinic mode speed [m s-1]. real, intent(in) :: freq !< Wave frequency [s-1]. real, intent(in) :: dt !< Time step [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: use_PPMang !< If true, use PPM for advection rather !! than upwind. ! Local variables @@ -795,24 +805,24 @@ subroutine refract(En, cn, freq, dt, G, NAngle, use_PPMang) ! Do the refraction. do i=is,ie - f2 = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + f2 = 0.25*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) - favg = 0.25*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + & - (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J))) - df2_dx = 0.5*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) - & + favg = 0.25*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + & + (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J))) + df2_dx = 0.5*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) - & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I-1,J-1)**2)) * & G%IdxT(i,j) - df_dx = 0.5*((G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1)) - & + df_dx = 0.5*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1)) - & (G%CoriolisBu(I-1,J) + G%CoriolisBu(I-1,J-1))) * & G%IdxT(i,j) dlnCn_dx = 0.5*( G%IdxCu(I,j) * (cn(i+1,j) - cn(i,j)) / & (0.5*(cn(i+1,j) + cn(i,j)) + cn_subRO) + & G%IdxCu(I-1,j) * (cn(i,j) - cn(i-1,j)) / & (0.5*(cn(i,j) + cn(i-1,j)) + cn_subRO) ) - df2_dy = 0.5*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) - & + df2_dy = 0.5*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) - & (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J-1)**2)) * & G%IdyT(i,j) - df_dy = 0.5*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) - & + df_dy = 0.5*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) - & (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J-1))) * & G%IdyT(i,j) dlnCn_dy = 0.5*( G%IdyCv(i,J) * (cn(i,j+1) - cn(i,j)) / & @@ -950,7 +960,7 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) end subroutine PPM_angular_advect !> Propagates internal waves at a single frequency. -subroutine propagate(En, cn, freq, dt, G, CS, NAngle) +subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -962,6 +972,7 @@ subroutine propagate(En, cn, freq, dt, G, CS, NAngle) intent(in) :: cn !< Baroclinic mode speed [m s-1]. real, intent(in) :: freq !< Wave frequency [s-1]. real, intent(in) :: dt !< Time step [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. ! Local variables @@ -1012,7 +1023,7 @@ subroutine propagate(En, cn, freq, dt, G, CS, NAngle) ! Fix indexing here later speed(:,:) = 0 do J=jsh-1,jeh ; do I=ish-1,ieh - f2 = G%CoriolisBu(I,J)**2 + f2 = US%s_to_T**2 * G%CoriolisBu(I,J)**2 speed(I,J) = 0.25*(cn(i,j) + cn(i+1,j) + cn(i+1,j+1) + cn(i,j+1)) * & sqrt(max(freq2 - f2, 0.0)) * Ifreq enddo ; enddo @@ -1042,12 +1053,12 @@ subroutine propagate(En, cn, freq, dt, G, CS, NAngle) enddo do j=jsh,jeh ; do I=ish-1,ieh - f2 = 0.5*(G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) + f2 = 0.5*US%s_to_T**2 * (G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) speed_x(I,j) = 0.5*(cn(i,j) + cn(i+1,j)) * G%mask2dCu(I,j) * & sqrt(max(freq2 - f2, 0.0)) * Ifreq enddo ; enddo do J=jsh-1,jeh ; do i=ish,ieh - f2 = 0.5*(G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) + f2 = 0.5*US%s_to_T**2 * (G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) speed_y(i,J) = 0.5*(cn(i,j) + cn(i,j+1)) * G%mask2dCv(i,J) * & sqrt(max(freq2 - f2, 0.0)) * Ifreq enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 3f250bc935..1182ce94e7 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -719,7 +719,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) ! Local variables real :: KhTr_Slope_Cff, KhTh_Slope_Cff, oneOrTwo, N2_filter_depth real :: KhTr_passivity_coeff - real, parameter :: absurdly_small_freq2 = 1e-34 ! A miniscule frequency + real :: absurdly_small_freq2 ! A miniscule frequency ! squared that is used to avoid division by 0 [s-2]. This ! value is roughly (pi / (the age of the universe) )^2. logical :: Gill_equatorial_Ld, use_FGNV_streamfn, use_MEKE, in_use @@ -747,6 +747,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) CS%calculate_Rd_dx = .false. CS%calculate_res_fns = .false. CS%calculate_Eady_growth_rate = .false. + absurdly_small_freq2 = 1e-34 !### Note the hard-coded dimensional parameter. ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -946,8 +947,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) do J=js-1,Jeq ; do I=is-1,Ieq CS%f2_dx2_q(I,J) = (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * & - max(G%CoriolisBu(I,J)**2, absurdly_small_freq2) - CS%beta_dx2_q(I,J) = oneOrTwo * (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * (sqrt(0.5 * & + max(US%s_to_T**2 * G%CoriolisBu(I,J)**2, absurdly_small_freq2) + CS%beta_dx2_q(I,J) = oneOrTwo * (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * (US%s_to_T * sqrt(0.5 * & ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & @@ -956,8 +957,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) do j=js,je ; do I=is-1,Ieq CS%f2_dx2_u(I,j) = (G%dxCu(I,j)**2 + G%dyCu(I,j)**2) * & - max(0.5*(G%CoriolisBu(I,J)**2+G%CoriolisBu(I,J-1)**2), absurdly_small_freq2) - CS%beta_dx2_u(I,j) = oneOrTwo * (G%dxCu(I,j)**2 + G%dyCu(I,j)**2) * (sqrt( & + max(0.5*US%s_to_T**2 * (G%CoriolisBu(I,J)**2+G%CoriolisBu(I,J-1)**2), absurdly_small_freq2) + CS%beta_dx2_u(I,j) = oneOrTwo * (G%dxCu(I,j)**2 + G%dyCu(I,j)**2) * (US%s_to_T * sqrt( & 0.25*( (((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2 + & ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + & (((G%CoriolisBu(I+1,J-1)-G%CoriolisBu(I,J-1)) * G%IdxCv(i+1,J-1))**2 + & @@ -967,8 +968,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) do J=js-1,Jeq ; do i=is,ie CS%f2_dx2_v(i,J) = (G%dxCv(i,J)**2 + G%dyCv(i,J)**2) * & - max(0.5*(G%CoriolisBu(I,J)**2+G%CoriolisBu(I-1,J)**2), absurdly_small_freq2) - CS%beta_dx2_v(i,J) = oneOrTwo * (G%dxCv(i,J)**2 + G%dyCv(i,J)**2) * (sqrt( & + max(0.5*US%s_to_T**2 * (G%CoriolisBu(I,J)**2+G%CoriolisBu(I-1,J)**2), absurdly_small_freq2) + CS%beta_dx2_v(i,J) = oneOrTwo * (G%dxCv(i,J)**2 + G%dyCv(i,J)**2) * (US%s_to_T * sqrt( & ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & 0.25*( (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & ((G%CoriolisBu(I-1,J+1)-G%CoriolisBu(I-1,J)) * G%IdyCu(I-1,j+1))**2) + & @@ -990,10 +991,10 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%f2_dx2_h(isd:ied,jsd:jed)) ; CS%f2_dx2_h(:,:) = 0.0 do j=js-1,je+1 ; do i=is-1,ie+1 CS%f2_dx2_h(i,j) = (G%dxT(i,j)**2 + G%dyT(i,j)**2) * & - max(0.25 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + max(0.25 * US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)), & absurdly_small_freq2) - CS%beta_dx2_h(i,j) = oneOrTwo * (G%dxT(i,j)**2 + G%dyT(i,j)**2) * (sqrt(0.5 * & + CS%beta_dx2_h(i,j) = oneOrTwo * (G%dxT(i,j)**2 + G%dyT(i,j)**2) * (US%s_to_T * sqrt(0.5 * & ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index d2a1abb730..eef2a2f954 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -357,7 +357,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var !$OMP do do j=js,je ; do I=is-1,ie u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) - absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) + absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & ( sqrt( 0.5 * ( G%dxCu(I,j)**2 + G%dyCu(I,j)**2 ) ) * I_l_f ) & @@ -433,7 +433,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var !$OMP do do J=js-1,je ; do i=is,ie u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) - absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & ( sqrt( 0.5 * ( G%dxCv(i,J)**2 + G%dyCv(i,J)**2 ) ) * I_l_f ) & @@ -657,7 +657,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) - absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) + absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 ! 0.41 is the von Karmen constant, 9.8696 = pi^2. @@ -705,7 +705,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_Z u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) - absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 ! 0.41 is the von Karmen constant, 9.8696 = pi^2. diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index ef0e9504ac..139754cada 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -959,8 +959,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF enddo ! things independent of position within the column - Coriolis = 0.25*( (G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) & - +(G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1)) ) + Coriolis = 0.25*US%s_to_T*( (G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) + & + (G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1)) ) surfFricVel = US%Z_to_m * uStar(i,j) ! Bullk Richardson number computed for each cell in a column, diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 9b3aee8e7d..be7d0ff08b 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -670,7 +670,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C kU_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * kU_star + & fluxes%frac_shelf_h(i,j) * (0.41*fluxes%ustar_shelf(i,j)) endif - absf_x_H = 0.25 * US%m_to_Z * h(i,0) * & !### I think this should be H_to_Z -RWH + absf_x_H = 0.25 * US%m_to_Z * US%s_to_T * h(i,0) * & !### I think this should be H_to_Z -RWH ((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) ! If the mixed layer vertical viscosity specification is changed in @@ -1355,7 +1355,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, real :: totEn_Z ! The total potential energy released by convection, [Z3 s-2 ~> m3 s-2]. real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. real :: exp_kh ! The nondimensional decay of TKE across a layer [nondim]. - real :: absf ! The absolute value of f averaged to thickness points, s-1. + real :: absf ! The absolute value of f averaged to thickness points [s-1]. real :: U_star ! The friction velocity [Z s-1 ~> m s-1]. real :: absf_Ustar ! The absolute value of f divided by U_star [Z-1 ~> m-1]. real :: wind_TKE_src ! The surface wind source of TKE [Z m2 s-3 ~> m3 s-3]. @@ -1377,8 +1377,8 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (U_Star < CS%ustar_min) U_Star = CS%ustar_min if (CS%omega_frac < 1.0) then - absf = 0.25*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & - (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) + absf = 0.25*US%s_to_T*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & + (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) if (CS%omega_frac > 0.0) & absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 53e4b29178..5c9d06e96f 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -95,8 +95,8 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) enddo ustar = 0.01*US%m_to_Z ! Change this to being an input parameter? - absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & - (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J)))) + absf = 0.25*US%s_to_T*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & + (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J)))) Kd(1) = 0.0 ; Kd(nz+1) = 0.0 do K=2,nz tmp1 = h_top(K) * h_bot(K) * GV%H_to_Z diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 5d4d70ec30..b171570f8e 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -624,8 +624,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS Bf_Unstable = min(0.0, buoy_flux(i,j)) ! Negative for unstable if (CS%omega_frac >= 1.0) then ; absf(i) = 2.0*CS%omega else - absf(i) = 0.25*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & - (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) + absf(i) = 0.25*US%s_to_T*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & + (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) if (CS%omega_frac > 0.0) & absf(i) = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf(i)**2) endif diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index a92106444e..428048665b 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -289,8 +289,8 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & nzc = nz do k=1,nzc+1 ; kc(k) = k ; kf(k) = 0.0 ; enddo endif - f2 = 0.25*((G%CoriolisBu(I,j)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) + f2 = 0.25 * US%s_to_T**2 * ((G%CoriolisBu(I,j)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) surface_pres = 0.0 ; if (associated(p_surf)) surface_pres = p_surf(i,j) ! ---------------------------------------------------- @@ -612,7 +612,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ nzc = nz do k=1,nzc+1 ; kc(k) = k ; kf(k) = 0.0 ; enddo endif - f2 = G%CoriolisBu(I,J)**2 + f2 = US%s_to_T**2 * G%CoriolisBu(I,J)**2 surface_pres = 0.0 ; if (associated(p_surf)) then surface_pres = 0.25 * ((p_surf(i,j) + p_surf(i+1,j+1)) + & (p_surf(i+1,j) + p_surf(i,j+1))) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index e4214c8d16..962a9d07c2 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1219,8 +1219,8 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ustar_h = visc%ustar_BBL(i,j) if (associated(fluxes%ustar_tidal)) & ustar_h = ustar_h + US%m_to_Z*fluxes%ustar_tidal(i,j) - absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & - (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) + absf = 0.25 * US%s_to_T * ((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & + (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) if ((ustar_h > 0.0) .and. (absf > 0.5*CS%IMax_decay*ustar_h)) then I2decay(i) = absf / ustar_h else @@ -1433,8 +1433,8 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & do i=G%isc,G%iec ! Developed in single-column mode ! Column-wise parameters. - absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & - (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) ! Non-zero on equator! + absf = 0.25*US%s_to_T*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & + (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) ! Non-zero on equator! ! u* at the bottom [m s-1]. ustar = visc%ustar_BBL(i,j) @@ -1583,8 +1583,8 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, if (CS%ML_omega_frac >= 1.0) then f_sq = 4.0*Omega2 else - f_sq = 0.25*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) + f_sq = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) if (CS%ML_omega_frac > 0.0) & f_sq = CS%ML_omega_frac*4.0*Omega2 + (1.0-CS%ML_omega_frac)*f_sq endif diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 7eba2fbac0..ffc2402267 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -625,8 +625,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! The bottom boundary layer thickness is found by solving the same ! equation as in Killworth and Edwards: (h/h_f)^2 + h/h_N = 1. - if (m==1) then ; C2f = (G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) - else ; C2f = (G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) ; endif + if (m==1) then ; C2f = US%s_to_T*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) + else ; C2f = US%s_to_T*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) ; endif if (CS%cdrag * U_bg_sq <= 0.0) then ! This avoids NaNs and overflows, and could be used in all cases, @@ -1202,7 +1202,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri (forces%tauy(i,J-1) + forces%tauy(i+1,J))) if (CS%omega_frac >= 1.0) then ; absf = 2.0*CS%omega ; else - absf = 0.5*(abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I,J-1))) + absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I,J-1))) if (CS%omega_frac > 0.0) & absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif @@ -1405,10 +1405,10 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri !visc%tbl_thick_shelf_u(I,j) = GV%H_to_Z * max(CS%Htbl_shelf_min, & ! htot(I) / (0.5 + sqrt(0.25 + & - ! (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)))**2 / & + ! (htot(i)*US%s_to_T*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)))**2 / & ! (ustar(i)*GV%Z_to_H)**2 )) ) ustar1 = ustar(i)*GV%Z_to_H - h2f2 = (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 + h2f2 = (htot(i)*US%s_to_T*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(I)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) visc%tbl_thick_shelf_u(I,j) = tbl_thick_Z @@ -1437,7 +1437,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri (forces%taux(I-1,j) + forces%taux(I,j+1))) if (CS%omega_frac >= 1.0) then ; absf = 2.0*CS%omega ; else - absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) if (CS%omega_frac > 0.0) & absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif @@ -1642,10 +1642,10 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri !visc%tbl_thick_shelf_v(i,J) = GV%H_to_Z * max(CS%Htbl_shelf_min, & ! htot(i) / (0.5 + sqrt(0.25 + & - ! (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))**2 / & + ! (htot(i)*US%s_to_T*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))**2 / & ! (ustar(i)*GV%Z_to_H)**2 )) ) ustar1 = ustar(i)*GV%Z_to_H - h2f2 = (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 + h2f2 = (htot(i)*US%s_to_T*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(i)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) visc%tbl_thick_shelf_v(i,J) = tbl_thick_Z diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index e01374b5c6..cfcd5ec6c3 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1292,11 +1292,11 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (GV%nkml>0) nk_visc(i) = real(GV%nkml+1) if (work_on_u) then u_star(I) = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) - absf(I) = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) + absf(I) = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) if (CS%dynamic_viscous_ML) nk_visc(I) = visc%nkml_visc_u(I,j) + 1 else u_star(i) = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) - absf(i) = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + absf(i) = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) if (CS%dynamic_viscous_ML) nk_visc(i) = visc%nkml_visc_v(i,J) + 1 endif h_ml(i) = h_neglect ; z_t(i) = 0.0 diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90 index c29e3beded..efd75810d6 100644 --- a/src/user/Idealized_Hurricane.F90 +++ b/src/user/Idealized_Hurricane.F90 @@ -258,8 +258,7 @@ subroutine idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) Uocn = state%u(I,j)*REL_TAU_FAC Vocn = 0.25*(state%v(i,J)+state%v(i+1,J-1)& +state%v(i+1,J)+state%v(i,J-1))*REL_TAU_FAC - f = abs(0.5*(G%CoriolisBu(I,J)+G%CoriolisBu(I,J-1)))*fbench_fac & - + fbench + f = abs(0.5*US%s_to_T*(G%CoriolisBu(I,J)+G%CoriolisBu(I,J-1)))*fbench_fac + fbench ! Calculate position as a function of time. if (CS%SCM_mode) then YY = YC + CS%dy_from_center @@ -281,8 +280,7 @@ subroutine idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) Uocn = 0.25*(state%u(I,j)+state%u(I-1,j+1)& +state%u(I-1,j)+state%u(I,j+1))*REL_TAU_FAC Vocn = state%v(i,J)*REL_TAU_FAC - f = abs(0.5*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))*fbench_fac & - + fbench + f = abs(0.5*US%s_to_T*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))*fbench_fac + fbench ! Calculate position as a function of time. if (CS%SCM_mode) then YY = YC + CS%dy_from_center @@ -487,10 +485,10 @@ subroutine SCM_idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) B = C**2 * 1.2 * exp(1.0) endif A = (CS%rad_max_wind/1000.)**B - f =G%CoriolisBu(is,js) ! f=f(x,y) but in the SCM is constant + f = US%s_to_T*G%CoriolisBu(is,js) ! f=f(x,y) but in the SCM is constant if (BR_Bench) then ! f reset to value used in generated wind for benchmark test - f = 5.5659e-05 + f = 5.5659e-05 !### A constant value in s-1. endif !/ BR ! Calculate x position as a function of time. diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 85e11435dc..6114464bf5 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -297,7 +297,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then cff = sqrt(GV%g_Earth * 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j))) - val2 = fac * exp(- 0.5 * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * y / cff) + val2 = fac * exp(- 0.5 * US%s_to_T * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * y / cff) segment%eta(I,j) = val2 * cos(omega * time_sec) segment%normal_vel_bt(I,j) = val1 * cff * sina / & (0.5*(G%bathyT(i+1,j) + G%bathyT(i,j))) * val2 diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index fedd46ab03..418cd648f8 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -1251,7 +1251,7 @@ end subroutine StokesMixing !! CHECK THAT RIGHT TIMESTEP IS PASSED IF YOU USE THIS** !! !! Not accessed in the standard code. -subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES) +subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES, US) type(ocean_grid_type), & intent(in) :: G !< Ocean grid type(verticalGrid_type), & @@ -1265,8 +1265,9 @@ subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES) intent(inout) :: v !< Velocity j-component [m s-1] type(Wave_parameters_CS), & pointer :: Waves !< Surface wave related control structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: DVel + real :: DVel ! A rescaled velocity change [m s-1 T-1 ~> m s-2] integer :: i,j,k do k = 1, G%ke @@ -1274,7 +1275,7 @@ subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES) do I = G%iscB, G%iecB DVel = 0.25*(WAVES%us_y(i,j+1,k)+WAVES%us_y(i-1,j+1,k))*G%CoriolisBu(i,j+1) + & 0.25*(WAVES%us_y(i,j,k)+WAVES%us_y(i-1,j,k))*G%CoriolisBu(i,j) - u(I,j,k) = u(I,j,k) + DVEL*DT + u(I,j,k) = u(I,j,k) + DVEL*US%s_to_T*DT enddo enddo enddo @@ -1284,7 +1285,7 @@ subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES) do i = G%isc, G%iec DVel = 0.25*(WAVES%us_x(i+1,j,k)+WAVES%us_x(i+1,j-1,k))*G%CoriolisBu(i+1,j) + & 0.25*(WAVES%us_x(i,j,k)+WAVES%us_x(i,j-1,k))*G%CoriolisBu(i,j) - v(i,J,k) = v(i,j,k) - DVEL*DT + v(i,J,k) = v(i,j,k) - DVEL*US%s_to_T*DT enddo enddo enddo diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 357396b794..adfff7949f 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -165,11 +165,11 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_p ! This uses d/d y_2 atan(y_2 / jet_width) ! u(I,j,k) = u(I,j,k+1) + (1e-3 * jet_height / & ! (jet_width * (1.0 + (y_2 / jet_width)**2))) * & -! (2.0 * GV%g_prime(K+1) / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) +! (2.0 * GV%g_prime(K+1) * US%T_to_s / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) ! This uses d/d y_2 tanh(y_2 / jet_width) u(I,j,k) = u(I,j,k+1) + (1e-3 * (jet_height / jet_width) * & (sech(y_2 / jet_width))**2 ) * & - (2.0 * GV%g_prime(K+1) / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) + (2.0 * GV%g_prime(K+1) * US%T_to_s / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) enddo ; enddo ; enddo do k=1,nz ; do j=js,je ; do I=is-1,ie diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index a3f23361f7..a32a2978b7 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -7,6 +7,7 @@ module Rossby_front_2d_initialization use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type @@ -159,9 +160,10 @@ end subroutine Rossby_front_initialize_temperature_salinity !> Initialization of u and v in the Rossby front test -subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, param_file, just_read_params) +subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: u !< i-component of velocity [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -178,7 +180,8 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, param_file, just_rea real :: dUdT ! Factor to convert dT/dy into dU/dz, g*alpha/f real :: dRho_dT real :: Dml, zi, zc, zm ! Depths [Z ~> m]. - real :: f, Ty + real :: f ! The local Coriolis parameter [T-1 ~> s-1] + real :: Ty real :: hAtU ! Interpolated layer thickness [Z ~> m]. integer :: i, j, k, is, ie, js, je, nz logical :: just_read ! If true, just read parameters but set nothing. @@ -200,9 +203,9 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, param_file, just_rea u(:,:,:) = 0.0 do j = G%jsc,G%jec ; do I = G%isc-1,G%iec+1 - f = 0.5*( G%CoriolisBu(I,j) + G%CoriolisBu(I,j-1) ) + f = 0.5* (G%CoriolisBu(I,j) + G%CoriolisBu(I,j-1) ) dUdT = 0.0 ; if (abs(f) > 0.0) & - dUdT = ( GV%g_Earth * dRho_dT ) / ( f * GV%Rho0 ) + dUdT = ( GV%g_Earth * dRho_dT ) / ( US%s_to_T * f * GV%Rho0 ) Dml = Hml( G, G%geoLatT(i,j) ) Ty = dTdy( G, T_range, G%geoLatT(i,j) ) zi = 0. diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 1de9c3664a..d79e9183bf 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -246,7 +246,7 @@ end subroutine write_user_log !! - v - Meridional velocity [m s-1]. !! - h - Layer thickness [H ~> m or kg m-2]. (Must be positive.) !! - G%bathyT - Basin depth [Z ~> m]. (Must be positive.) -!! - G%CoriolisBu - The Coriolis parameter [s-1]. +!! - G%CoriolisBu - The Coriolis parameter [T-1 ~> s-1]. !! - GV%g_prime - The reduced gravity at each interface [m2 Z-1 s-2 ~> m s-2]. !! - GV%Rlay - Layer potential density (coordinate variable) [kg m-3]. !! If ENABLE_THERMODYNAMICS is defined: From dc2e629f6f695721b8d21e3c60c1842229d058e1 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 9 Apr 2019 15:42:42 -0400 Subject: [PATCH 1050/1072] Travis: switch to mpich2 - After moving to the xanadu version of FMS, Travis-CI was failing to link due to not being able to find mpi_comm_create_group(). Attempts to use the xenial distribution introduced different problems. - This is a temporary work around. - We need to be able to build in newer distributions. --- .travis.yml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.travis.yml b/.travis.yml index f211d9f162..2886eb09bd 100644 --- a/.travis.yml +++ b/.travis.yml @@ -4,14 +4,13 @@ # This is a not a c-language project but we use the same environment. language: c dist: trusty -sudo: false addons: apt: sources: - ubuntu-toolchain-r-test packages: - - tcsh pkg-config netcdf-bin libnetcdf-dev openmpi-bin libopenmpi-dev gfortran + - tcsh pkg-config netcdf-bin libnetcdf-dev mpich2 libmpich2-dev gfortran # For saving time... cache: From 2d4161cb4390c6fbb574791164bb8e7ac70a39a5 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 10 Apr 2019 17:27:39 -0400 Subject: [PATCH 1051/1072] Fix doxygen typos --- src/parameterizations/lateral/MOM_MEKE.F90 | 2 +- src/parameterizations/vertical/MOM_bkgnd_mixing.F90 | 2 +- src/user/MOM_wave_interface.F90 | 10 +++++----- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 21e06ebcef..5d9f413f24 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -1264,7 +1264,7 @@ end subroutine MEKE_end !! !! \f$L_c\f$ is a constant and \f$\delta[L_c]\f$ is the impulse function so that the term !! \f$\frac{\delta[L_c]}{L_c}\f$ evaluates to \f$\frac{1}{L_c}\f$ when \f$L_c\f$ is non-zero -!! but is dropped if \f$L_c=0\fi$. +!! but is dropped if \f$L_c=0\f$. !! !! \f$\beta^*\f$ is the effective \f$\beta\f$ that combines both the planetary vorticity !! gradient (i.e. \f$\beta=\nabla f\f$) and the topographic \f$\beta\f$ effect, diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 7d683944a2..12ee411831 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -48,7 +48,7 @@ module MOM_bkgnd_mixing !! Bryan-Lewis profile [m] real :: bckgrnd_vdc1 !< Background diffusivity (Ledwell) when !! horiz_varying_background=.true. - real :: bckgrnd_vdc_eq !! Equatorial diffusivity (Gregg) when + real :: bckgrnd_vdc_eq !< Equatorial diffusivity (Gregg) when !! horiz_varying_background=.true. real :: bckgrnd_vdc_psim !< Max. PSI induced diffusivity (MacKinnon) when !! horiz_varying_background=.true. diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index fedd46ab03..b6c455e673 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -111,11 +111,11 @@ module MOM_wave_interface type(diag_ctrl), pointer, public :: diag !< A structure that is used to regulate the !! timing of diagnostic output. - ! An arbitrary lower-bound on the Langmuir number. Run-time parameter. - ! Langmuir number is sqrt(u_star/u_stokes). When both are small - ! but u_star is orders of magnitude smaller the Langmuir number could - ! have unintended consequences. Since both are small it can be safely capped - ! to avoid such consequences. + !> An arbitrary lower-bound on the Langmuir number. Run-time parameter. + !! Langmuir number is sqrt(u_star/u_stokes). When both are small + !! but u_star is orders of magnitude smaller the Langmuir number could + !! have unintended consequences. Since both are small it can be safely capped + !! to avoid such consequences. real :: La_min = 0.05 !>@{ Diagnostic handles From f3e4d7b282d68caf4af7904f01d68404b1b35821 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 10 Apr 2019 17:27:52 -0400 Subject: [PATCH 1052/1072] Doxygenized down sampling routine in diag_mediator - Missing documentation for APIs and types have been added. - doxygen.log should now be clean of errors. --- src/framework/MOM_diag_mediator.F90 | 280 +++++++++++++++++----------- src/framework/MOM_domains.F90 | 18 +- 2 files changed, 185 insertions(+), 113 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index d862f8c815..954bf48e90 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -69,18 +69,22 @@ module MOM_diag_mediator module procedure post_data_3d, post_data_2d, post_data_1d_k, post_data_0d end interface post_data +!> Down sample a field interface downsample_field module procedure downsample_field_2d, downsample_field_3d end interface downsample_field +!> Down sample the mask of a field interface downsample_mask module procedure downsample_mask_2d, downsample_mask_3d end interface downsample_mask +!> Down sample a diagnostic field interface downsample_diag_field module procedure downsample_diag_field_2d, downsample_diag_field_3d end interface downsample_diag_field +!> Contained for down sampled masks type, private :: diag_dsamp real, pointer, dimension(:,:) :: mask2d => null() !< Mask for 2d (x-y) axes real, pointer, dimension(:,:,:) :: mask3d => null() !< Mask for 3d axes @@ -143,25 +147,25 @@ module MOM_diag_mediator type(diag_grids_type), dimension(:), allocatable :: diag_grids !< Primarily empty, except h field end type diag_grid_storage -!> integers to encode the total cell methods +! Integers to encode the total cell methods !integer :: PPP=111 ! x:point,y:point,z:point, this kind of diagnostic is not currently present in diag_table.MOM6 !integer :: PPS=112 ! x:point,y:point,z:sum , this kind of diagnostic is not currently present in diag_table.MOM6 !integer :: PPM=113 ! x:point,y:point,z:mean , this kind of diagnostic is not currently present in diag_table.MOM6 -integer :: PSP=121 ! x:point,y:sum,z:point -integer :: PSS=122 ! x:point,y:sum,z:point -integer :: PSM=123 ! x:point,y:sum,z:mean -integer :: PMP=131 ! x:point,y:mean,z:point -integer :: PMM=133 ! x:point,y:mean,z:mean -integer :: SPP=211 ! x:sum,y:point,z:point -integer :: SPS=212 ! x:sum,y:point,z:sum -integer :: SSP=221 ! x:sum;y:sum,z:point -integer :: MPP=311 ! x:mean,y:point,z:point -integer :: MPM=313 ! x:mean,y:point,z:mean -integer :: MMP=331 ! x:mean,y:mean,z:point -integer :: MMS=332 ! x:mean,y:mean,z:sum -integer :: SSS=222 ! x:sum,y:sum,z:sum -integer :: MMM=333 ! x:mean,y:mean,z:mean -integer :: MSK=-1 ! Use the downsample method of a mask +integer :: PSP=121 !< x:point,y:sum,z:point +integer :: PSS=122 !< x:point,y:sum,z:point +integer :: PSM=123 !< x:point,y:sum,z:mean +integer :: PMP=131 !< x:point,y:mean,z:point +integer :: PMM=133 !< x:point,y:mean,z:mean +integer :: SPP=211 !< x:sum,y:point,z:point +integer :: SPS=212 !< x:sum,y:point,z:sum +integer :: SSP=221 !< x:sum;y:sum,z:point +integer :: MPP=311 !< x:mean,y:point,z:point +integer :: MPM=313 !< x:mean,y:point,z:mean +integer :: MMP=331 !< x:mean,y:mean,z:point +integer :: MMS=332 !< x:mean,y:mean,z:sum +integer :: SSS=222 !< x:sum,y:sum,z:sum +integer :: MMM=333 !< x:mean,y:mean,z:mean +integer :: MSK=-1 !< Use the downsample method of a mask !> This type is used to represent a diagnostic at the diag_mediator level. !! @@ -182,9 +186,10 @@ module MOM_diag_mediator logical :: v_extensive = .false. !< True for vertically extensive fields (vertically integrated). !! False for intensive (concentrations). integer :: xyz_method = 0 !< A 3 digit integer encoding the diagnostics cell method - !! It can be used to determine the downsample algorithm + !! It can be used to determine the downsample algorithm end type diag_type +!> Container for down sampling information type diagcs_dsamp integer :: isc !< The start i-index of cell centers within the computational domain integer :: iec !< The end i-index of cell centers within the computational domain @@ -194,14 +199,22 @@ module MOM_diag_mediator integer :: ied !< The end i-index of cell centers within the data domain integer :: jsd !< The start j-index of cell centers within the data domain integer :: jed !< The end j-index of cell centers within the data domain - integer :: isg,ieg,jsg,jeg - integer :: isgB,iegB,jsgB,jegB - + integer :: isg !< The start i-index of cell centers within the global domain + integer :: ieg !< The end i-index of cell centers within the global domain + integer :: jsg !< The start j-index of cell centers within the global domain + integer :: jeg !< The end j-index of cell centers within the global domain + integer :: isgB !< The start i-index of cell corners within the global domain + integer :: iegB !< The end i-index of cell corners within the global domain + integer :: jsgB !< The start j-index of cell corners within the global domain + integer :: jegB !< The end j-index of cell corners within the global domain + + !>@{ Axes for each location on a diagnostic grid type(axes_grp) :: axesBL, axesTL, axesCuL, axesCvL type(axes_grp) :: axesBi, axesTi, axesCui, axesCvi type(axes_grp) :: axesB1, axesT1, axesCu1, axesCv1 type(axes_grp), dimension(:), allocatable :: remap_axesTL, remap_axesBL, remap_axesCuL, remap_axesCvL type(axes_grp), dimension(:), allocatable :: remap_axesTi, remap_axesBi, remap_axesCui, remap_axesCvi + !!@} real, dimension(:,:), pointer :: mask2dT => null() !< 2D mask array for cell-center points real, dimension(:,:), pointer :: mask2dBu => null() !< 2D mask array for cell-corner points @@ -216,6 +229,7 @@ module MOM_diag_mediator real, dimension(:,:,:), pointer :: mask3dBi => null() real, dimension(:,:,:), pointer :: mask3dCui => null() real, dimension(:,:,:), pointer :: mask3dCvi => null() + !!@} end type diagcs_dsamp !> The following data type a list of diagnostic fields an their variants, @@ -515,7 +529,8 @@ subroutine set_axes_info_dsamp(G, GV, param_file, diag_cs, id_zl_native, id_zi_n type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(param_file_type), intent(in) :: param_file !< Parameter file structure type(diag_ctrl), intent(inout) :: diag_cs !< Diagnostics control structure - integer, intent(in) :: id_zl_native, id_zi_native + integer, intent(in) :: id_zl_native !< ID of native layers + integer, intent(in) :: id_zi_native !< ID of native interfaces ! Local variables integer :: id_xq, id_yq, id_zl, id_zi, id_xh, id_yh @@ -3533,11 +3548,15 @@ end subroutine downsample_diag_masks_set !> Get the diagnostics-compute indices (to be passed to send_data) based on the shape of !! the diag field (the same way they are deduced for non-downsampled fields) -subroutine downsample_diag_indices_get(fo1,fo2, dl, diag_cs,isv,iev,jsv,jev) - integer, intent(in) :: fo1,fo2 !< the sizes of the diag field in x and y - integer, intent(in) :: dl !< integer downsample level - type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output - integer, intent(out) ::isv,iev,jsv,jev !< diagnostics-compute indices (to be passed to send_data) +subroutine downsample_diag_indices_get(fo1, fo2, dl, diag_cs, isv, iev, jsv, jev) + integer, intent(in) :: fo1 !< The size of the diag field in x + integer, intent(in) :: fo2 !< The size of the diag field in y + integer, intent(in) :: dl !< Integer downsample level + type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output + integer, intent(out) :: isv !< i-start index for diagnostics + integer, intent(out) :: iev !< i-end index for diagnostics + integer, intent(out) :: jsv !< j-start index for diagnostics + integer, intent(out) :: jev !< j-end index for diagnostics ! Local variables integer :: dszi,cszi,dszj,cszj,f1,f2 character(len=500) :: mesg @@ -3602,15 +3621,18 @@ end subroutine downsample_diag_indices_get !> This subroutine allocates and computes a downsampled array from an input array !! It also determines the diagnostics-compurte indices for the downsampled array !! 3d interface -subroutine downsample_diag_field_3d(locfield, locfield_dsamp, dl, diag_cs, diag,isv,iev,jsv,jev, mask) - real, dimension(:,:,:), pointer :: locfield !< input array pointer - real, dimension(:,:,:), allocatable, intent(inout) :: locfield_dsamp !< output (downsampled) array +subroutine downsample_diag_field_3d(locfield, locfield_dsamp, dl, diag_cs, diag, isv, iev, jsv, jev, mask) + real, dimension(:,:,:), pointer :: locfield !< Input array pointer + real, dimension(:,:,:), allocatable, intent(inout) :: locfield_dsamp !< Output (downsampled) array type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post - integer, intent(in) :: dl !< integer downsample level - integer, intent(inout):: isv,iev,jsv,jev !< diagnostics-compute indices (to be passed to send_data) + integer, intent(in) :: dl !< Level of down sampling + integer, intent(inout) :: isv !< i-start index for diagnostics + integer, intent(inout) :: iev !< i-end index for diagnostics + integer, intent(inout) :: jsv !< j-start index for diagnostics + integer, intent(inout) :: jev !< j-end index for diagnostics real, optional,target, intent(in) :: mask(:,:,:) !< If present, use this real array as the data mask. - !locals + ! Locals real, dimension(:,:,:), pointer :: locmask integer :: f1,f2,isv_o,jsv_o @@ -3640,15 +3662,18 @@ end subroutine downsample_diag_field_3d !> This subroutine allocates and computes a downsampled array from an input array !! It also determines the diagnostics-compurte indices for the downsampled array !! 2d interface -subroutine downsample_diag_field_2d(locfield, locfield_dsamp, dl, diag_cs, diag,isv,iev,jsv,jev, mask) - real, dimension(:,:), pointer :: locfield !< input array pointer - real, dimension(:,:), allocatable, intent(inout) :: locfield_dsamp !< output (downsampled) array +subroutine downsample_diag_field_2d(locfield, locfield_dsamp, dl, diag_cs, diag, isv, iev, jsv, jev, mask) + real, dimension(:,:), pointer :: locfield !< Input array pointer + real, dimension(:,:), allocatable, intent(inout) :: locfield_dsamp !< Output (downsampled) array type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output - type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post - integer, intent(in) :: dl !< integer downsample level - integer, intent(out):: isv,iev,jsv,jev !< diagnostics-compute indices (to be passed to send_data) + type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post + integer, intent(in) :: dl !< Level of down sampling + integer, intent(inout) :: isv !< i-start index for diagnostics + integer, intent(inout) :: iev !< i-end index for diagnostics + integer, intent(inout) :: jsv !< j-start index for diagnostics + integer, intent(inout) :: jev !< j-end index for diagnostics real, optional,target, intent(in) :: mask(:,:) !< If present, use this real array as the data mask. - !locals + ! Locals real, dimension(:,:), pointer :: locmask integer :: f1,f2,isv_o,jsv_o @@ -3675,50 +3700,58 @@ subroutine downsample_diag_field_2d(locfield, locfield_dsamp, dl, diag_cs, diag, end subroutine downsample_diag_field_2d -!> The downsample algorithm -!! The downsample method could be deduced (before send_data call) +!> \section downsampling The down sample algorithm +!! +!! The down sample method could be deduced (before send_data call) !! from the diag%x_cell_method, diag%y_cell_method and diag%v_cell_method !! -!! This is the summary of the downsample algoritm for a diagnostic field f: -!! f(Id,Jd) = \sum_{i,j} f(Id+i,Jd+j) * weight(Id+i,Jd+j) / [ \sum_{i,j} weight(Id+i,Jd+j)] -!! i and j run from 0 to dl-1 (dl being the downsample level) -!! Id,Jd are the downsampled (coarse grid) indices run over the coarsened compute grid, -!! if and jf are the original (fine grid) indices +!! This is the summary of the down sample algoritm for a diagnostic field f: +!! \f[ +!! f(Id,Jd) = \sum_{i,j} f(Id+i,Jd+j) * weight(Id+i,Jd+j) / [ \sum_{i,j} weight(Id+i,Jd+j)] +!! \f] +!! Here, i and j run from 0 to dl-1 (dl being the down sample level). +!! Id,Jd are the down sampled (coarse grid) indices run over the coarsened compute grid, +!! if and jf are the original (fine grid) indices. !! -!!example x_cell y_cell v_cell algorithm_id impemented weight(if,jf) -!!--------------------------------------------------------------------------------------- -!!theta mean mean mean MMM =222 G%areaT(if,jf)*h(if,jf) -!!u point mean mean PMM =022 dyCu(if,jf)*h(if,jf)*delta(if,Id) -!!v mean point mean MPM =202 dxCv(if,jf)*h(if,jf)*delta(jf,Jd) -!!? point sum mean PSM =012 h(if,jf)*delta(if,Id) -!!volcello sum sum sum SSS =111 1 -!!T_dfxy_co sum sum point SSP =110 1 -!!umo point sum sum PSS =011 1*delta(if,Id) -!!vmo sum point sum SPS =101 1*delta(jf,Jd) -!!umo_2d point sum point PSP =010 1*delta(if,Id) -!!vmo_2d sum point point SPP =100 1*delta(jf,Jd) -!!? point mean point PMP =020 dyCu(if,jf)*delta(if,Id) -!!? mean point point MPP =200 dxCv(if,jf)*delta(jf,Jd) -!!w mean mean point MMP =220 G%areaT(if,jf) -!!h*theta mean mean sum MMS =221 G%areaT(if,jf) +!! \verbatim +!! Example x_cell y_cell v_cell algorithm_id implemented weight(if,jf) +!! --------------------------------------------------------------------------------------- +!! theta mean mean mean MMM =222 G%areaT(if,jf)*h(if,jf) +!! u point mean mean PMM =022 dyCu(if,jf)*h(if,jf)*delta(if,Id) +!! v mean point mean MPM =202 dxCv(if,jf)*h(if,jf)*delta(jf,Jd) +!! ? point sum mean PSM =012 h(if,jf)*delta(if,Id) +!! volcello sum sum sum SSS =111 1 +!! T_dfxy_co sum sum point SSP =110 1 +!! umo point sum sum PSS =011 1*delta(if,Id) +!! vmo sum point sum SPS =101 1*delta(jf,Jd) +!! umo_2d point sum point PSP =010 1*delta(if,Id) +!! vmo_2d sum point point SPP =100 1*delta(jf,Jd) +!! ? point mean point PMP =020 dyCu(if,jf)*delta(if,Id) +!! ? mean point point MPP =200 dxCv(if,jf)*delta(jf,Jd) +!! w mean mean point MMP =220 G%areaT(if,jf) +!! h*theta mean mean sum MMS =221 G%areaT(if,jf) !! -!!delta is the Kroneker delta +!! delta is the Kronecker delta +!! \endverbatim -!> This subroutine allocates and computes a downsampled array given an input array -!! The downsample method is based on the "cell_methods" for the diagnostics as explained +!> This subroutine allocates and computes a down sampled 3d array given an input array +!! The down sample method is based on the "cell_methods" for the diagnostics as explained !! in the above table -!! 3d interface subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, diag,isv_o,jsv_o,isv_d,iev_d,jsv_d,jev_d) - real, dimension(:,:,:) , pointer :: field_in - real, dimension(:,:,:) , allocatable :: field_out - integer , intent(in) :: dl - integer, intent(in) :: method !< sampling method - real, dimension(:,:,:), pointer :: mask - type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output - type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post - integer , intent(in) :: isv_o,jsv_o !< original indices, In practice isv_o=jsv_o=1 - integer , intent(in) :: isv_d,iev_d,jsv_d,jev_d !< dsampaed indices - !locals + real, dimension(:,:,:), pointer :: field_in !< Original field to be down sampled + real, dimension(:,:,:), allocatable :: field_out !< down sampled field + integer, intent(in) :: dl !< Level of down sampling + integer, intent(in) :: method !< Sampling method + real, dimension(:,:,:), pointer :: mask !< Mask for field + type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output + type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post + integer, intent(in) :: isv_o !< Original i-start index + integer, intent(in) :: jsv_o !< Original j-start index + integer, intent(in) :: isv_d !< i-start index of down sampled data + integer, intent(in) :: iev_d !< i-end index of down sampled data + integer, intent(in) :: jsv_d !< j-start index of down sampled data + integer, intent(in) :: jev_d !< j-end index of down sampled data + ! Locals character(len=240) :: mesg integer :: i,j,ii,jj,i0,j0,f1,f2,f_in1,f_in2 integer :: k,ks,ke @@ -3726,7 +3759,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d real :: epsilon = 1.0e-20 ks=1 ; ke =size(field_in,3) - !Allocate the downsampled field on the downsampled data domain + ! Allocate the down sampled field on the down sampled data domain ! allocate(field_out(diag_cs%dsamp(dl)%isd:diag_cs%dsamp(dl)%ied,diag_cs%dsamp(dl)%jsd:diag_cs%dsamp(dl)%jed,ks:ke)) ! allocate(field_out(1:size(field_in,1)/dl,1:size(field_in,2)/dl,ks:ke)) f_in1 = size(field_in,1) @@ -3740,7 +3773,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d endif allocate(field_out(1:f1,1:f2,ks:ke)) - !Fill the downsampled field on the downsampled diagnostics (almost always compuate) domain + ! Fill the down sampled field on the down sampled diagnostics (almost always compuate) domain if(method .eq. MMM) then do k= ks,ke ; do j=jsv_d,jev_d ; do i=isv_d,iev_d i0 = isv_o+dl*(i-isv_d) @@ -3871,31 +3904,39 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d end subroutine downsample_field_3d -subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs,diag,isv_o,jsv_o,isv_d,iev_d,jsv_d,jev_d) - real, dimension(:,:) , pointer :: field_in - real, dimension(:,:) , allocatable :: field_out - integer , intent(in) :: dl - integer, intent(in) :: method !< sampling method - real, dimension(:,:), pointer :: mask +!> This subroutine allocates and computes a down sampled 2d array given an input array +!! The down sample method is based on the "cell_methods" for the diagnostics as explained +!! in the above table +subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs, diag, & + isv_o, jsv_o, isv_d, iev_d, jsv_d, jev_d) + real, dimension(:,:), pointer :: field_in !< Original field to be down sampled + real, dimension(:,:), allocatable :: field_out !< Down sampled field + integer, intent(in) :: dl !< Level of down sampling + integer, intent(in) :: method !< Sampling method + real, dimension(:,:), pointer :: mask !< Mask for field type(diag_ctrl), intent(in) :: diag_CS !< Structure used to regulate diagnostic output - type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post - integer , intent(in) :: isv_o,jsv_o !< original indices, In practice isv_o=jsv_o=1 - integer , intent(in) :: isv_d,iev_d,jsv_d,jev_d !< dsampaed indices - !locals + type(diag_type), intent(in) :: diag !< A structure describing the diagnostic to post + integer, intent(in) :: isv_o !< Original i-start index + integer, intent(in) :: jsv_o !< Original j-start index + integer, intent(in) :: isv_d !< i-start index of down sampled data + integer, intent(in) :: iev_d !< i-end index of down sampled data + integer, intent(in) :: jsv_d !< j-start index of down sampled data + integer, intent(in) :: jev_d !< j-end index of down sampled data + ! Locals character(len=240) :: mesg integer :: i,j,ii,jj,i0,j0,f1,f2,f_in1,f_in2 real :: ave,total_weight,weight real :: epsilon = 1.0e-20 - !Allocate the downsampled field on the downsampled data domain + ! Allocate the down sampled field on the down sampled data domain ! allocate(field_out(diag_cs%dsamp(dl)%isd:diag_cs%dsamp(dl)%ied,diag_cs%dsamp(dl)%jsd:diag_cs%dsamp(dl)%jed)) ! allocate(field_out(1:size(field_in,1)/dl,1:size(field_in,2)/dl)) - !Fill the downsampled field on the downsampled diagnostics (almost always compuate) domain + ! Fill the down sampled field on the down sampled diagnostics (almost always compuate) domain f_in1 = size(field_in,1) f_in2 = size(field_in,2) f1 = f_in1/dl f2 = f_in2/dl - !Correction for the symmetric case + ! Correction for the symmetric case if (diag_cs%G%symmetric) then f1 = f1 + mod(f_in1,dl) f2 = f2 + mod(f_in2,dl) @@ -4004,19 +4045,28 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs,di end subroutine downsample_field_2d -!> Allocate and compute the downsampled masks -!! The masks are downsampled based on a minority rule, i.e., a coarse cell is open (1) +!> Allocate and compute the 2d down sampled mask +!! The masks are down sampled based on a minority rule, i.e., a coarse cell is open (1) !! if at least one of the sub-cells are open, otherwise it's closed (0) -subroutine downsample_mask_2d(field_in, field_out, dl, isc_o,jsc_o, isc_d,iec_d,jsc_d,jec_d , isd_d,ied_d,jsd_d,jed_d) - real, dimension(:,:) , intent(in) :: field_in - real, dimension(:,:) , pointer :: field_out - integer , intent(in) :: dl - integer , intent(in) :: isc_o,jsc_o - integer , intent(in) :: isc_d,iec_d,jsc_d,jec_d !< downsampled mask compute indices - integer , intent(in) :: isd_d,ied_d,jsd_d,jed_d !< downsampled mask data indices +subroutine downsample_mask_2d(field_in, field_out, dl, isc_o, jsc_o, isc_d, iec_d, jsc_d, jec_d, & + isd_d, ied_d, jsd_d, jed_d) + real, dimension(:,:), intent(in) :: field_in !< Original field to be down sampled + real, dimension(:,:), pointer :: field_out !< Down sampled field + integer, intent(in) :: dl !< Level of down sampling + integer, intent(in) :: isc_o !< Original i-start index + integer, intent(in) :: jsc_o !< Original j-start index + integer, intent(in) :: isc_d !< Computational i-start index of down sampled data + integer, intent(in) :: iec_d !< Computational i-end index of down sampled data + integer, intent(in) :: jsc_d !< Computational j-start index of down sampled data + integer, intent(in) :: jec_d !< Computational j-end index of down sampled data + integer, intent(in) :: isd_d !< Computational i-start index of down sampled data + integer, intent(in) :: ied_d !< Computational i-end index of down sampled data + integer, intent(in) :: jsd_d !< Computational j-start index of down sampled data + integer, intent(in) :: jed_d !< Computational j-end index of down sampled data + ! Locals integer :: i,j,ii,jj,i0,j0 real :: tot_non_zero - !downsampled mask = 0 unless the mask value of one of the downsampling cells is 1 + ! down sampled mask = 0 unless the mask value of one of the down sampling cells is 1 allocate(field_out(isd_d:ied_d,jsd_d:jed_d)) field_out(:,:) = 0.0 do j=jsc_d,jec_d ; do i=isc_d,iec_d @@ -4030,16 +4080,28 @@ subroutine downsample_mask_2d(field_in, field_out, dl, isc_o,jsc_o, isc_d,iec_d, enddo; enddo end subroutine downsample_mask_2d -subroutine downsample_mask_3d(field_in, field_out, dl, isc_o,jsc_o, isc_d,iec_d,jsc_d,jec_d , isd_d,ied_d,jsd_d,jed_d) - real, dimension(:,:,:) , intent(in) :: field_in - real, dimension(:,:,:) , pointer :: field_out - integer , intent(in) :: dl - integer , intent(in) :: isc_o,jsc_o - integer , intent(in) :: isc_d,iec_d,jsc_d,jec_d !< downsampled mask compute indices - integer , intent(in) :: isd_d,ied_d,jsd_d,jed_d !< downsampled mask data indices +!> Allocate and compute the 3d down sampled mask +!! The masks are down sampled based on a minority rule, i.e., a coarse cell is open (1) +!! if at least one of the sub-cells are open, otherwise it's closed (0) +subroutine downsample_mask_3d(field_in, field_out, dl, isc_o, jsc_o, isc_d, iec_d, jsc_d, jec_d, & + isd_d, ied_d, jsd_d, jed_d) + real, dimension(:,:,:), intent(in) :: field_in !< Original field to be down sampled + real, dimension(:,:,:), pointer :: field_out !< down sampled field + integer, intent(in) :: dl !< Level of down sampling + integer, intent(in) :: isc_o !< Original i-start index + integer, intent(in) :: jsc_o !< Original j-start index + integer, intent(in) :: isc_d !< Computational i-start index of down sampled data + integer, intent(in) :: iec_d !< Computational i-end index of down sampled data + integer, intent(in) :: jsc_d !< Computational j-start index of down sampled data + integer, intent(in) :: jec_d !< Computational j-end index of down sampled data + integer, intent(in) :: isd_d !< Computational i-start index of down sampled data + integer, intent(in) :: ied_d !< Computational i-end index of down sampled data + integer, intent(in) :: jsd_d !< Computational j-start index of down sampled data + integer, intent(in) :: jed_d !< Computational j-end index of down sampled data + ! Locals integer :: i,j,ii,jj,i0,j0,k,ks,ke real :: tot_non_zero - !downsampled mask = 0 unless the mask value of one of the downsampling cells is 1 + ! down sampled mask = 0 unless the mask value of one of the down sampling cells is 1 ks = lbound(field_in,3) ; ke = ubound(field_in,3) allocate(field_out(isd_d:ied_d,jsd_d:jed_d,ks:ke)) field_out(:,:,:) = 0.0 diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index 55e6e47b63..e53ec98f5c 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -1825,10 +1825,20 @@ subroutine get_domain_extent_dsamp2(Domain, isc_d2, iec_d2, jsc_d2, jec_d2,& isd_d2, ied_d2, jsd_d2, jed_d2,& isg_d2, ieg_d2, jsg_d2, jeg_d2) type(MOM_domain_type), & - intent(in) :: Domain !< The MOM domain from which to extract information - integer, intent(out) :: isc_d2, iec_d2, jsc_d2, jec_d2 - integer, intent(out) :: isd_d2, ied_d2, jsd_d2, jed_d2 - integer, intent(out) :: isg_d2, ieg_d2, jsg_d2, jeg_d2 + intent(in) :: Domain !< The MOM domain from which to extract information + integer, intent(out) :: isc_d2 !< The start i-index of the computational domain + integer, intent(out) :: iec_d2 !< The end i-index of the computational domain + integer, intent(out) :: jsc_d2 !< The start j-index of the computational domain + integer, intent(out) :: jec_d2 !< The end j-index of the computational domain + integer, intent(out) :: isd_d2 !< The start i-index of the data domain + integer, intent(out) :: ied_d2 !< The end i-index of the data domain + integer, intent(out) :: jsd_d2 !< The start j-index of the data domain + integer, intent(out) :: jed_d2 !< The end j-index of the data domain + integer, intent(out) :: isg_d2 !< The start i-index of the global domain + integer, intent(out) :: ieg_d2 !< The end i-index of the global domain + integer, intent(out) :: jsg_d2 !< The start j-index of the global domain + integer, intent(out) :: jeg_d2 !< The end j-index of the global domain + call mpp_get_compute_domain(Domain%mpp_domain_d2, isc_d2, iec_d2, jsc_d2, jec_d2) call mpp_get_data_domain(Domain%mpp_domain_d2, isd_d2, ied_d2, jsd_d2, jed_d2) call mpp_get_global_domain (Domain%mpp_domain_d2, isg_d2, ieg_d2, jsg_d2, jeg_d2) From 2eeac36eb9300e4bc365d7e7df0fba995d218983 Mon Sep 17 00:00:00 2001 From: "Jessica.Meixner" Date: Thu, 11 Apr 2019 13:30:18 +0000 Subject: [PATCH 1053/1072] update from Rocky so that NEMS can run with later ESMF beta snapshot --- config_src/nuopc_driver/mom_cap.F90 | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 25bb8c69aa..fc52b87cdd 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -817,19 +817,29 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! reset shr logging to my log file if (is_root_pe()) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, & + call NUOPC_CompAttributeGet(gcomp, name="diro", & isPresent=isPresentDiro, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return - call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, & + call NUOPC_CompAttributeGet(gcomp, name="logfile", & isPresent=isPresentLogfile, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return if (isPresentDiro .and. isPresentLogfile) then + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) else logunit = output_unit From e4ff4191788e15ddebf03e6acc80a09dd6f37043 Mon Sep 17 00:00:00 2001 From: "Jessica.Meixner" Date: Thu, 11 Apr 2019 13:36:27 +0000 Subject: [PATCH 1054/1072] remove tabs --- config_src/nuopc_driver/mom_cap.F90 | 206 ++++++------ config_src/nuopc_driver/mom_cap_methods.F90 | 332 ++++++++++---------- config_src/nuopc_driver/mom_cap_time.F90 | 170 +++++----- 3 files changed, 354 insertions(+), 354 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index fc52b87cdd..24e60388b4 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1971,7 +1971,7 @@ subroutine ModelAdvance(gcomp, rc) call ocean_model_restart(ocean_state, restartname=restartname) if (is_root_pe()) then - write(logunit,*) subname//' writing restart file ',trim(restartname) + write(logunit,*) subname//' writing restart file ',trim(restartname) endif endif @@ -2080,59 +2080,59 @@ subroutine ModelSetRunClock(gcomp, rc) restart_ymd = 0 call NUOPC_CompAttributeGet(gcomp, name="restart_option", isPresent=isPresent, & - isSet=isSet, value=restart_option, rc=rc) + isSet=isSet, value=restart_option, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out if (isPresent .and. isSet) then - call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (isPresent .and. isSet) then - read(cvalue,*) restart_n - endif - call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if (isPresent .and. isSet) then - read(cvalue,*) restart_ymd - endif + call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + read(cvalue,*) restart_n + endif + call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (isPresent .and. isSet) then + read(cvalue,*) restart_ymd + endif else - restart_option = "none" + restart_option = "none" endif call AlarmInit(mclock, & - alarm = restart_alarm, & - option = trim(restart_option), & - opt_n = restart_n, & - opt_ymd = restart_ymd, & - RefTime = mcurrTime, & - alarmname = 'alarm_restart', rc=rc) + alarm = restart_alarm, & + option = trim(restart_option), & + opt_n = restart_n, & + opt_ymd = restart_ymd, & + RefTime = mcurrTime, & + alarmname = 'alarm_restart', rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out first_time = .false. call ESMF_LogWrite(subname//" Set restart option = "//restart_option, & - ESMF_LOGMSG_INFO, rc=rc) + ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out endif @@ -2243,8 +2243,8 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ if (scalar_id < 0 .or. scalar_id > scalar_count) then call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": ERROR in scalar_id", & - line=__LINE__, file=__FILE__, rcToReturn=rc) + msg=subname//": ERROR in scalar_id", & + line=__LINE__, file=__FILE__, rcToReturn=rc) return endif @@ -2281,84 +2281,84 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) if (field_defs(i)%shortname == scalar_field_name) then - call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected on root pe.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=rc) + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected on root pe.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=rc) - call SetScalarField(field, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call SetScalarField(field, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out else - call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=rc) - - if (present(grid)) then - - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! initialize fldptr to zero - call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - fldptr2d(:,:) = 0.0 - - else if (present(mesh)) then - - field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & - name=field_defs(i)%shortname, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! initialize fldptr to zero - call ESMF_FieldGet(field, farrayPtr=fldptr1d, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - fldptr1d(:) = 0.0 - - endif + call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is connected.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=rc) + + if (present(grid)) then + + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! initialize fldptr to zero + call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + fldptr2d(:,:) = 0.0 + + else if (present(mesh)) then + + field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! initialize fldptr to zero + call ESMF_FieldGet(field, farrayPtr=fldptr1d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + fldptr1d(:) = 0.0 + + endif endif ! Realize connected field call NUOPC_Realize(state, field=field, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out else ! field is not connected call ESMF_LogWrite(subname // tag // " Field "// trim(field_defs(i)%stdname) // " is not connected.", & - ESMF_LOGMSG_INFO, & - line=__LINE__, & - file=__FILE__, & - rc=rc) + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=rc) ! remove a not connected Field from State call ESMF_StateRemove(state, (/field_defs(i)%shortname/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out endif diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 46559fb22a..d893685aec 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -175,14 +175,14 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! rotate taux and tauy from true zonal/meridional to local coordinates do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg)*taux(i,j) & - - ocean_grid%sin_rot(ig,jg)*tauy(i,j) - ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg)*tauy(i,j) & - + ocean_grid%sin_rot(ig,jg)*taux(i,j) - enddo + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg)*taux(i,j) & + - ocean_grid%sin_rot(ig,jg)*tauy(i,j) + ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg)*tauy(i,j) & + + ocean_grid%sin_rot(ig,jg)*taux(i,j) + enddo enddo deallocate(taux, tauy) @@ -191,41 +191,41 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! sensible heat flux (W/m2) !---- call state_getimport(importState, 'mean_sensi_heat_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%t_flux, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%t_flux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! evaporation flux (W/m2) !---- call state_getimport(importState, 'mean_evap_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%q_flux, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%q_flux, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! liquid precipitation (rain) !---- call state_getimport(importState, 'mean_prec_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%lprec, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%lprec, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! frozen precipitation (snow) !---- call state_getimport(importState, 'mean_fprec_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%fprec, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%fprec, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! runoff and heat content of runoff @@ -236,38 +236,38 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! liquid runoff ice_ocean_boundary%rofl_flux (:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'Foxx_rofl', & - isc, iec, jsc, jec, ice_ocean_boundary%rofl_flux,rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%rofl_flux,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! ice runoff ice_ocean_boundary%rofi_flux (:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'Foxx_rofi', & - isc, iec, jsc, jec, ice_ocean_boundary%rofi_flux,rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%rofi_flux,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! total runoff ice_ocean_boundary%runoff (:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mean_runoff_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%runoff, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%runoff, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! heat content of runoff ice_ocean_boundary%runoff_hflx(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mean_runoff_heat_flux', & - isc, iec, jsc, jec, ice_ocean_boundary%runoff_hflx, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%runoff_hflx, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! calving rate and heat flux @@ -277,29 +277,29 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ice_ocean_boundary%calving(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mean_calving_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%calving, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%calving, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out ice_ocean_boundary%calving_hflx(:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'mean_calving_heat_flux', & - isc, iec, jsc, jec, ice_ocean_boundary%calving_hflx, rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%calving_hflx, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out !---- ! salt flux from ice !---- call state_getimport(importState, 'mean_salt_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%salt_flux,rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%salt_flux,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! !---- ! ! snow&ice melt heat flux (W/m^2) @@ -406,8 +406,8 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, do j = jsc, jec jg = j + ocean_grid%jsc - jsc do i = isc, iec - ig = i + ocean_grid%isc - isc - omask(i,j) = nint(ocean_grid%mask2dT(ig,jg)) + ig = i + ocean_grid%isc - isc + omask(i,j) = nint(ocean_grid%mask2dT(ig,jg)) enddo enddo @@ -455,11 +455,11 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, do j = jsc, jec jg = j + ocean_grid%jsc - jsc do i = isc, iec - ig = i + ocean_grid%isc - isc - ocz(i,j) = ocean_public%u_surf(i,j) - ocm(i,j) = ocean_public%v_surf(i,j) - ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) + ocean_grid%sin_rot(ig,jg)*ocm(i,j) - ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) - ocean_grid%sin_rot(ig,jg)*ocz(i,j) + ig = i + ocean_grid%isc - isc + ocz(i,j) = ocean_public%u_surf(i,j) + ocm(i,j) = ocean_public%v_surf(i,j) + ocz_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocz(i,j) + ocean_grid%sin_rot(ig,jg)*ocm(i,j) + ocm_rot(i,j) = ocean_grid%cos_rot(ig,jg)*ocm(i,j) - ocean_grid%sin_rot(ig,jg)*ocz(i,j) enddo enddo @@ -485,11 +485,11 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, call ESMF_StateGet(exportState, 'So_bldepth', itemFlag, rc=rc) if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then call State_SetExport(exportState, 'So_bldepth', & - isc, iec, jsc, jec, ocean_public%obld, ocean_grid, rc=rc) + isc, iec, jsc, jec, ocean_public%obld, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out endif ! ------- @@ -502,12 +502,12 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, do j = jsc,jec do i = isc,iec - if (ocean_public%frazil(i,j) > 0.0) then - melt_potential(i,j) = ocean_public%frazil(i,j) * inv_dt_int - else - melt_potential(i,j) = -ocean_public%melt_potential(i,j) * inv_dt_int - if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 - endif + if (ocean_public%frazil(i,j) > 0.0) then + melt_potential(i,j) = ocean_public%frazil(i,j) * inv_dt_int + else + melt_potential(i,j) = -ocean_public%melt_potential(i,j) * inv_dt_int + if (melt_potential(i,j) > 0.0) melt_potential(i,j) = 0.0 + endif enddo enddo @@ -526,11 +526,11 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, call ESMF_StateGet(exportState, 'sea_level', itemFlag, rc=rc) if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then call State_SetExport(exportState, 'sea_level', & - isc, iec, jsc, jec, ocean_public%sea_lev, ocean_grid, rc=rc) + isc, iec, jsc, jec, ocean_public%sea_lev, ocean_grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + line=__LINE__, & + file=__FILE__)) & + return ! bail out endif !---------------- @@ -551,8 +551,8 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, do j = ocean_grid%jsc, ocean_grid%jec jloc = j + ocean_grid%jdg_offset do i = ocean_grid%isc,ocean_grid%iec - iloc = i + ocean_grid%idg_offset - ssh(i,j) = ocean_public%sea_lev(iloc,jloc) + iloc = i + ocean_grid%idg_offset + ssh(i,j) = ocean_public%sea_lev(iloc,jloc) enddo enddo @@ -574,15 +574,15 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, if (ocean_grid%mask2dCu(i+1,j)==0.) slp_R = 0. slp_C = 0.5 * (slp_L + slp_R) if ( (slp_L * slp_R) > 0.0 ) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + u_max = max( ssh(i-1,j), ssh(i,j), ssh(i+1,j) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 endif dhdx(iglob,jglob) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) if (ocean_grid%mask2dT(i,j)==0.) dhdx(iglob,jglob) = 0.0 @@ -604,15 +604,15 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, if (ocean_grid%mask2dCv(i,j+1)==0.) slp_R = 0. slp_C = 0.5 * (slp_L + slp_R) if ((slp_L * slp_R) > 0.0) then - ! This limits the slope so that the edge values are bounded by the - ! two cell averages spanning the edge. - u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) - slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) + ! This limits the slope so that the edge values are bounded by the + ! two cell averages spanning the edge. + u_min = min( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + u_max = max( ssh(i,j-1), ssh(i,j), ssh(i,j+1) ) + slope = sign( min( abs(slp_C), 2.*min( ssh(i,j) - u_min, u_max - ssh(i,j) ) ), slp_C ) else - ! Extrema in the mean values require a PCM reconstruction avoid generating - ! larger extreme values. - slope = 0.0 + ! Extrema in the mean values require a PCM reconstruction avoid generating + ! larger extreme values. + slope = 0.0 endif dhdy(iglob,jglob) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) if (ocean_grid%mask2dT(i,j)==0.) dhdy(iglob,jglob) = 0.0 @@ -625,9 +625,9 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, do j = jsc, jec jg = j + ocean_grid%jsc - jsc do i = isc, iec - ig = i + ocean_grid%isc - isc - dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) + ocean_grid%sin_rot(ig,jg)*dhdy(i,j) - dhdy_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) - ocean_grid%sin_rot(ig,jg)*dhdx(i,j) + ig = i + ocean_grid%isc - isc + dhdx_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdx(i,j) + ocean_grid%sin_rot(ig,jg)*dhdy(i,j) + dhdy_rot(i,j) = ocean_grid%cos_rot(ig,jg)*dhdy(i,j) - ocean_grid%sin_rot(ig,jg)*dhdx(i,j) enddo enddo @@ -735,48 +735,48 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r if (geomtype == ESMF_GEOMTYPE_MESH) then - ! get field pointer - call state_getfldptr(state, trim(fldname), dataptr1d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! determine output array - n = 0 - do j = jsc,jec - do i = isc,iec - n = n + 1 - if (present(do_sum)) then - output(i,j) = output(i,j) + dataPtr1d(n) - else - output(i,j) = dataPtr1d(n) - endif - enddo - enddo + ! get field pointer + call state_getfldptr(state, trim(fldname), dataptr1d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! determine output array + n = 0 + do j = jsc,jec + do i = isc,iec + n = n + 1 + if (present(do_sum)) then + output(i,j) = output(i,j) + dataPtr1d(n) + else + output(i,j) = dataPtr1d(n) + endif + enddo + enddo else if (geomtype == ESMF_GEOMTYPE_GRID) then - call state_getfldptr(state, trim(fldname), dataptr2d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - lbnd1 = lbound(dataPtr2d,1) - lbnd2 = lbound(dataPtr2d,2) - - do j = jsc, jec - j1 = j + lbnd2 - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - if (present(do_sum)) then - output(i,j) = output(i,j) + dataPtr2d(i1,j1) - else - output(i,j) = dataPtr2d(i1,j1) - endif - enddo - enddo + call state_getfldptr(state, trim(fldname), dataptr2d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr2d,1) + lbnd2 = lbound(dataPtr2d,2) + + do j = jsc, jec + j1 = j + lbnd2 - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + if (present(do_sum)) then + output(i,j) = output(i,j) + dataPtr2d(i1,j1) + else + output(i,j) = dataPtr2d(i1,j1) + endif + enddo + enddo endif @@ -820,42 +820,42 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid if (geomtype == ESMF_GEOMTYPE_MESH) then - call state_getfldptr(state, trim(fldname), dataptr1d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - n = 0 - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - n = n+1 - dataPtr1d(n) = input(i,j) * ocean_grid%mask2dT(ig,jg) - enddo - enddo + call state_getfldptr(state, trim(fldname), dataptr1d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + n = 0 + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + n = n+1 + dataPtr1d(n) = input(i,j) * ocean_grid%mask2dT(ig,jg) + enddo + enddo else if (geomtype == ESMF_GEOMTYPE_GRID) then - call state_getfldptr(state, trim(fldname), dataptr2d, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - lbnd1 = lbound(dataPtr2d,1) - lbnd2 = lbound(dataPtr2d,2) - - do j = jsc, jec - j1 = j + lbnd2 - jsc - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - i1 = i + lbnd1 - isc - ig = i + ocean_grid%isc - isc - dataPtr2d(i1,j1) = input(i,j) * ocean_grid%mask2dT(ig,jg) - enddo - enddo + call state_getfldptr(state, trim(fldname), dataptr2d, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + lbnd1 = lbound(dataPtr2d,1) + lbnd2 = lbound(dataPtr2d,2) + + do j = jsc, jec + j1 = j + lbnd2 - jsc + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + i1 = i + lbnd1 - isc + ig = i + ocean_grid%isc - isc + dataPtr2d(i1,j1) = input(i,j) * ocean_grid%mask2dT(ig,jg) + enddo + enddo endif diff --git a/config_src/nuopc_driver/mom_cap_time.F90 b/config_src/nuopc_driver/mom_cap_time.F90 index dc4f81e90e..3f36a131f9 100644 --- a/config_src/nuopc_driver/mom_cap_time.F90 +++ b/config_src/nuopc_driver/mom_cap_time.F90 @@ -109,18 +109,18 @@ subroutine AlarmInit( clock, alarm, option, & trim(option) == optNYears .or. trim(option) == optNYear .or. & trim(option) == optIfdays0) then if (.not. present(opt_n)) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//trim(option)//' requires opt_n', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' requires opt_n', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return endif if (opt_n <= 0) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//trim(option)//' invalid opt_n', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' invalid opt_n', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return endif endif @@ -162,157 +162,157 @@ subroutine AlarmInit( clock, alarm, option, & case (optNONE, optNever) call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return update_nextalarm = .false. case (optDate) if (.not. present(opt_ymd)) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//trim(option)//' requires opt_ymd', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' requires opt_ymd', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return endif if (lymd < 0 .or. ltod < 0) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//trim(option)//'opt_ymd, opt_tod invalid', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//'opt_ymd, opt_tod invalid', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return endif call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return call TimeInit(NextAlarm, lymd, cal, tod=ltod, desc="optDate", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return update_nextalarm = .false. case (optIfdays0) if (.not. present(opt_ymd)) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//trim(option)//' requires opt_ymd', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) - return + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg=subname//trim(option)//' requires opt_ymd', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) + return endif call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=opt_n, s=0, calendar=cal, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return update_nextalarm = .true. case (optNSteps, optNStep) call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optNSeconds, optNSecond) call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optNMinutes, optNMinute) call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optNHours, optNHour) call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optNDays, optNDay) call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optNMonths, optNMonth) call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optMonthly) call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return update_nextalarm = .true. case (optNYears, optNYear) call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optYearly) call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return + line=__LINE__, & + file=__FILE__)) & + return update_nextalarm = .true. case default call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//' unknown option: '//trim(option), & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) + msg=subname//' unknown option: '//trim(option), & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) return end select @@ -327,7 +327,7 @@ subroutine AlarmInit( clock, alarm, option, & if (update_nextalarm) then NextAlarm = NextAlarm - AlarmInterval do while (NextAlarm <= CurrTime) - NextAlarm = NextAlarm + AlarmInterval + NextAlarm = NextAlarm + AlarmInterval enddo endif @@ -365,13 +365,13 @@ subroutine TimeInit( Time, ymd, cal, tod, desc, logunit, rc) if ( (ymd < 0) .or. (ltod < 0) .or. (ltod > SecPerDay) )then if (present(logunit)) then - write(logunit,*) subname//': ERROR yymmdd is a negative number or '// & - 'time-of-day out of bounds', ymd, ltod + write(logunit,*) subname//': ERROR yymmdd is a negative number or '// & + 'time-of-day out of bounds', ymd, ltod endif call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//' yymmdd is negative or time-of-day out of bounds ', & - line=__LINE__, & - file=__FILE__, rcToReturn=rc) + msg=subname//' yymmdd is negative or time-of-day out of bounds ', & + line=__LINE__, & + file=__FILE__, rcToReturn=rc) return endif From f7f32862d5aac69fab026a1434be029b33bd0a33 Mon Sep 17 00:00:00 2001 From: John Krasting Date: Thu, 11 Apr 2019 11:38:42 -0400 Subject: [PATCH 1055/1072] Logic to flag obsolete restart fields - Added entries to the MOM restart control structure to carry a list of restart variables that are no longer used - Introduced register_restart_field_as_obsolete() subroutine - Default behavior is to bring down the model if attempting to use an old restart file --- src/framework/MOM_restart.F90 | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 4d89dccc7b..9f66871d65 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -25,6 +25,7 @@ module MOM_restart public restart_init, restart_end, restore_state, register_restart_field public save_restart, query_initialized, restart_init_end, vardesc public restart_files_exist, determine_is_new_run, is_new_run +public register_restart_field_as_obsolete !> A type for making arrays of pointers to 4-d arrays type p4d @@ -61,11 +62,17 @@ module MOM_restart character(len=32) :: var_name !< A name by which a variable may be queried. end type field_restart +type obsolete_restart + character(len=32) :: field_name !< Name of restart field that is no longer in use + character(len=32) :: replacement_name !< Name of replacement restart field, if applicable +end type obsolete_restart + !> A restart registry and the control structure for restarts type, public :: MOM_restart_CS ; private logical :: restart !< restart is set to .true. if the run has been started from a full restart !! file. Otherwise some fields must be initialized approximately. integer :: novars = 0 !< The number of restart fields that have been registered. + integer :: num_obsolete_vars = 0 !< The number of obsolete restart fields that have been registered. logical :: parallel_restartfiles !< If true, each PE writes its own restart file, !! otherwise they are combined internally. logical :: large_file_support !< If true, NetCDF 3.6 or later is being used @@ -82,6 +89,9 @@ module MOM_restart !> An array of descriptions of the registered fields type(field_restart), pointer :: restart_field(:) => NULL() + !> An array of obsolete restart fields + type(obsolete_restart), pointer :: restart_obsolete(:) => NULL() + !>@{ Pointers to the fields that have been registered for restarts type(p0d), pointer :: var_ptr0d(:) => NULL() type(p1d), pointer :: var_ptr1d(:) => NULL() @@ -112,6 +122,16 @@ module MOM_restart end interface contains +!!> Register a restart field as obsolete +subroutine register_restart_field_as_obsolete(field_name, replacement_name, CS) + character(len=32), intent(in) :: field_name !< Name of restart field that is no longer in use + character(len=32), intent(in) :: replacement_name !< Name of replacement restart field, if applicable + type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + + CS%num_obsolete_vars = CS%num_obsolete_vars+1 + CS%restart_obsolete(CS%num_obsolete_vars)%field_name = field_name + CS%restart_obsolete(CS%num_obsolete_vars)%replacement_name = replacement_name +end subroutine register_restart_field_as_obsolete !> Register a 3-d field for restarts, providing the metadata in a structure subroutine register_restart_field_ptr3d(f_ptr, var_desc, mandatory, CS) @@ -1062,6 +1082,16 @@ subroutine restore_state(filename, directory, day, G, CS) allocate(fields(nvar)) call get_file_fields(unit(n),fields(1:nvar)) + do m=1, nvar + call get_file_atts(fields(i),name=varname) + do i=1,CS%num_obsolete_vars + if (lowercase(trim(varname)) == lowercase(trim(CS%restart_obsolete(i)%field_name))) then + call MOM_error(FATAL, "MOM_restart restore_state: Attempting to use obsolete restart field "//& + trim(varname)) + endif + enddo + enddo + missing_fields = 0 do m=1,CS%novars @@ -1433,6 +1463,7 @@ subroutine restart_init(param_file, CS, restart_root) default=.true.) allocate(CS%restart_field(CS%max_fields)) + allocate(CS%restart_obsolete(CS%max_fields)) allocate(CS%var_ptr0d(CS%max_fields)) allocate(CS%var_ptr1d(CS%max_fields)) allocate(CS%var_ptr2d(CS%max_fields)) @@ -1456,6 +1487,7 @@ subroutine restart_end(CS) type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object if (associated(CS%restart_field)) deallocate(CS%restart_field) + if (associated(CS%restart_obsolete)) deallocate(CS%restart_obsolete) if (associated(CS%var_ptr0d)) deallocate(CS%var_ptr0d) if (associated(CS%var_ptr1d)) deallocate(CS%var_ptr1d) if (associated(CS%var_ptr2d)) deallocate(CS%var_ptr2d) From a2988802336ab3dbb0544d234988f2820addc124 Mon Sep 17 00:00:00 2001 From: John Krasting Date: Thu, 11 Apr 2019 11:41:13 -0400 Subject: [PATCH 1056/1072] Registering Kd_turb and Kv_turb as obsolete restart fields - Uses register_restart_field_as_obsolete subroutine --- src/parameterizations/vertical/MOM_set_viscosity.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 7eba2fbac0..9f452d1402 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -19,6 +19,7 @@ module MOM_set_visc use MOM_cvmix_conv, only : cvmix_conv_is_used use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS +use MOM_restart, only : register_restart_field_as_obsolete use MOM_safe_alloc, only : safe_alloc_ptr, safe_alloc_alloc use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type @@ -2025,6 +2026,9 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS diag%axesCv1, Time, 'Number of layers in viscous mixed layer at v points', 'm') endif + call register_restart_field_as_obsolete('Kd_turb','Kd_shear', restart_CS) + call register_restart_field_as_obsolete('Kv_turb','Kv_shear', restart_CS) + if ((US%m_to_Z_restart /= 0.0) .and. (US%m_to_Z_restart /= US%m_to_Z)) then Z_rescale = US%m_to_Z / US%m_to_Z_restart if (associated(visc%Kd_shear)) then ; if (query_initialized(visc%Kd_shear, "Kd_shear", restart_CS)) then From 2c89df5ab4847668c0eed3b69eb715110b8d8929 Mon Sep 17 00:00:00 2001 From: John Krasting Date: Fri, 12 Apr 2019 10:16:27 -0400 Subject: [PATCH 1057/1072] dOxygenize for obsolete restarts, tweak to FATAL message - Cosmetic clean up of comments - added adjustl() to string comparison - for some reason a leading whitespace was present with Intel compiler but not GNU. --- src/framework/MOM_restart.F90 | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 9f66871d65..9f1b645604 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -62,8 +62,9 @@ module MOM_restart character(len=32) :: var_name !< A name by which a variable may be queried. end type field_restart +!> A structure to store information about restart fields that are no longer used type obsolete_restart - character(len=32) :: field_name !< Name of restart field that is no longer in use + character(len=32) :: field_name !< Name of restart field that is no longer in use character(len=32) :: replacement_name !< Name of replacement restart field, if applicable end type obsolete_restart @@ -124,9 +125,9 @@ module MOM_restart contains !!> Register a restart field as obsolete subroutine register_restart_field_as_obsolete(field_name, replacement_name, CS) - character(len=32), intent(in) :: field_name !< Name of restart field that is no longer in use - character(len=32), intent(in) :: replacement_name !< Name of replacement restart field, if applicable - type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) + character(*), intent(in) :: field_name !< Name of restart field that is no longer in use + character(*), intent(in) :: replacement_name !< Name of replacement restart field, if applicable + type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object (intent in/out) CS%num_obsolete_vars = CS%num_obsolete_vars+1 CS%restart_obsolete(CS%num_obsolete_vars)%field_name = field_name @@ -1083,13 +1084,14 @@ subroutine restore_state(filename, directory, day, G, CS) call get_file_fields(unit(n),fields(1:nvar)) do m=1, nvar - call get_file_atts(fields(i),name=varname) + call get_file_atts(fields(m),name=varname) do i=1,CS%num_obsolete_vars - if (lowercase(trim(varname)) == lowercase(trim(CS%restart_obsolete(i)%field_name))) then + if (adjustl(lowercase(trim(varname))) == adjustl(lowercase(trim(CS%restart_obsolete(i)%field_name)))) then call MOM_error(FATAL, "MOM_restart restore_state: Attempting to use obsolete restart field "//& - trim(varname)) + trim(varname)//" - the new corresponding restart field is "//& + trim(CS%restart_obsolete(i)%replacement_name)) endif - enddo + enddo enddo missing_fields = 0 From 69e6d30eb35428dd84d77e4cbe7a89da3b1f3ed8 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 16 Apr 2019 13:06:02 -0400 Subject: [PATCH 1058/1072] Re-factor of Travis-CI usage - Uses stages to parallelize testing process - Adds a doxygen job that tests for doxygen errors - Reduces dependency on other repositories - No longer uses scripst from MOM6-examples/tools/tests/Travis-MOM6/ - Still uses configurations from MOM6-examples/ocean_only/ - Adds test building/using a debug executable - Adds a .testing/ directory - Uses the latest xenial image on Travis (with openmpi) Todo: - Add code coverage (needs more experiments) - Break dependence on MOM6-examples (long term project) - Add other portable tests (e.g. parameter scaling, rotation, etc) --- .testing/Makefile | 77 ++++++++ .testing/README.md | 3 + .testing/configure | 4 + .testing/linux-ubuntu-xenial-gnu.mk | 273 ++++++++++++++++++++++++++++ .testing/trailer.py | 95 ++++++++++ .travis.yml | 119 +++++++++--- 6 files changed, 543 insertions(+), 28 deletions(-) create mode 100644 .testing/Makefile create mode 100644 .testing/README.md create mode 100755 .testing/configure create mode 100644 .testing/linux-ubuntu-xenial-gnu.mk create mode 100755 .testing/trailer.py diff --git a/.testing/Makefile b/.testing/Makefile new file mode 100644 index 0000000000..d0f098e411 --- /dev/null +++ b/.testing/Makefile @@ -0,0 +1,77 @@ +# Makefile steps to run on Travis-CI +# e.g. make MEMORY_SHAPE=dynamic_symmetric REPRO=1 OPENMP=1 + +# Versions to use +FMS_COMMIT ?= xanadu +MKMF_COMMIT ?= master + +# Where to clone from +FMS_URL ?= https://github.com/NOAA-GFDL/FMS.git +MKMF_URL ?= https://github.com/NOAA-GFDL/mkmf.git +CONFIGS_URL ?= https://github.com/NOAA-GFDL/MOM6-examples.git +REGRESSIONS_URL ?= https://github.com/adcroft/Gaea-stats-MOM6-examples + +# Experiments to run +ifeq ($(MEMORY_SHAPE),"dynamic_symmetric") +EXPERIMENTS ?= unit_tests double_gyre flow_downslope/z CVmix_SCM_tests/cooling_only/EPBL circle_obcs +else +EXPERIMENTS ?= unit_tests double_gyre flow_downslope/z CVmix_SCM_tests/cooling_only/EPBL +endif + +FMS_PACKAGES ?= platform,include,memutils,constants,mpp,fms,time_manager,diag_manager,data_override,coupler/ensemble_manager.F90,axis_utils,horiz_interp,time_interp,astronomy,mosaic,random_numbers +TEMPLATE ?= .testing/linux-ubuntu-xenial-gnu.mk +MPIRUN ?= mpirun + +# MEMORY_SHAPE must be defined for this Makefile to work +MEMORY_SHAPE ?= dynamic_symmetric + +# Everything above is above is "configurable" with environment variables +SHELL = bash + +# Path where executable will be built +BUILD_PATH = build +###/$(MEMORY_SHAPE)-$(EXEC_MODE) +# Root of configurations (MOM6-examples) +EXPERIMENTS_ROOT = experiments +# Regression results +REGRESSIONS_ROOT = answers + +.PRECIOUS: %/ocean.stats + +run: $(foreach e,$(EXPERIMENTS),$(EXPERIMENTS_ROOT)/ocean_only/$(e)/ocean.stats) + +test: $(foreach e,$(EXPERIMENTS),$(REGRESSIONS_ROOT)/regressions/ocean_only/$(e)/ocean.stats.gnu) + +compile: $(BUILD_PATH)/MOM6 + +$(BUILD_PATH)/MOM6: FMS mkmf + mkdir -p $(@D) + cd $(@D); \ + ../mkmf/bin/list_paths -l ../FMS/{$(FMS_PACKAGES)} ../config_src/{$(MEMORY_SHAPE),solo_driver} ../src \ + && ../mkmf/bin/mkmf -t ../$(TEMPLATE) -c '-Duse_libMPI -Duse_netCDF -DSPMD -DUSE_LOG_DIAG_FIELD_INFO -DMAXFIELDMETHODS_=500' -p $(@F) path_names \ + && make -j NETCDF=3 $(@F) + +$(EXPERIMENTS_ROOT)/%/ocean.stats: $(EXPERIMENTS_ROOT) + mkdir -p $(@D)/RESTART + cd $(@D) ; $(MPIRUN) -n 1 $(PWD)/$(BUILD_PATH)/MOM6 + +$(REGRESSIONS_ROOT)/regressions/%/ocean.stats.gnu: $(EXPERIMENTS_ROOT)/%/ocean.stats $(REGRESSIONS_ROOT) + cp $< $@ + cd $(@D) ; git status --porcelain $(@F) + +# Targets to clone repositories needed to build +FMS: + git clone -q $(FMS_URL) + cd $@ ; git checkout -q $(FMS_COMMIT) + +mkmf: + git clone -q $(MKMF_URL) + cd $@ ; git checkout -q $(MKMF_COMMIT) + +$(EXPERIMENTS_ROOT): + mkdir -p $(@D) + cd $(@D) ; git clone --depth 1 $(CONFIGS_URL) experiments + +$(REGRESSIONS_ROOT): + mkdir -p $(@D) + cd $(@D) ; git clone --depth 1 $(REGRESSIONS_URL) answers diff --git a/.testing/README.md b/.testing/README.md new file mode 100644 index 0000000000..46b154da14 --- /dev/null +++ b/.testing/README.md @@ -0,0 +1,3 @@ +# .testing + +This directory contains scripts used when evaluating commits on Travis-CI diff --git a/.testing/configure b/.testing/configure new file mode 100755 index 0000000000..841635d6f4 --- /dev/null +++ b/.testing/configure @@ -0,0 +1,4 @@ +#!/usr/bin/env bash + +echo "Configured!" $MAKEARGS +touch build/test_${MAKEARGS//\ /_} diff --git a/.testing/linux-ubuntu-xenial-gnu.mk b/.testing/linux-ubuntu-xenial-gnu.mk new file mode 100644 index 0000000000..80abc4e48d --- /dev/null +++ b/.testing/linux-ubuntu-xenial-gnu.mk @@ -0,0 +1,273 @@ +# Template for the GNU Compiler Collection on Xenial version of Ubuntu Linux systems (used by Travis-CI) +# +# Typical use with mkmf +# mkmf -t linux-ubuntu-xenial-gnu.mk -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include + +############ +# Commands Macors +FC = mpif90 +CC = mpicc +LD = mpif90 $(MAIN_PROGRAM) + +####################### +# Build target macros +# +# Macros that modify compiler flags used in the build. Target +# macrose are usually set on the call to make: +# +# make REPRO=on NETCDF=3 +# +# Most target macros are activated when their value is non-blank. +# Some have a single value that is checked. Others will use the +# value of the macro in the compile command. + +DEBUG = # If non-blank, perform a debug build (Cannot be + # mixed with REPRO or TEST) + +REPRO = # If non-blank, erform a build that guarentees + # reprodicuibilty from run to run. Cannot be used + # with DEBUG or TEST + +TEST = # If non-blank, use the compiler options defined in + # the FFLAGS_TEST and CFLAGS_TEST macros. Cannot be + # use with REPRO or DEBUG + +VERBOSE = # If non-blank, add additional verbosity compiler + # options + +OPENMP = # If non-blank, compile with openmp enabled + +NO_OVERRIDE_LIMITS = # If non-blank, do not use the -qoverride-limits + # compiler option. Default behavior is to compile + # with -qoverride-limits. + +NETCDF = # If value is '3' and CPPDEFS contains + # '-Duse_netCDF', then the additional cpp macro + # '-Duse_LARGEFILE' is added to the CPPDEFS macro. + +INCLUDES = # A list of -I Include directories to be added to the + # the compile command. + +SSE = # The SSE options to be used to compile. If blank, + # than use the default SSE settings for the host. + # Current default is to use SSE2. + +COVERAGE = # Add the code coverage compile options. + +# Need to use at least GNU Make version 3.81 +need := 3.81 +ok := $(filter $(need),$(firstword $(sort $(MAKE_VERSION) $(need)))) +ifneq ($(need),$(ok)) +$(error Need at least make version $(need). Load module gmake/3.81) +endif + +# REPRO, DEBUG and TEST need to be mutually exclusive of each other. +# Make sure the user hasn't supplied two at the same time +ifdef REPRO +ifneq ($(DEBUG),) +$(error Options REPRO and DEBUG cannot be used together) +else ifneq ($(TEST),) +$(error Options REPRO and TEST cannot be used together) +endif +else ifdef DEBUG +ifneq ($(TEST),) +$(error Options DEBUG and TEST cannot be used together) +endif +endif + +MAKEFLAGS += --jobs=$(shell grep '^processor' /proc/cpuinfo | wc -l) + +# Macro for Fortran preprocessor +FPPFLAGS := $(INCLUDES) +# Fortran Compiler flags for the NetCDF library +FPPFLAGS += $(shell nf-config --fflags) + +# Base set of Fortran compiler flags +FFLAGS := -fcray-pointer -fdefault-double-8 -fdefault-real-8 -Waliasing -ffree-line-length-none -fno-range-check + +# Flags based on perforance target (production (OPT), reproduction (REPRO), or debug (DEBUG) +FFLAGS_OPT = -O3 +FFLAGS_REPRO = -O2 -fbounds-check +FFLAGS_DEBUG = -O0 -g -W -fbounds-check -fbacktrace -ffpe-trap=invalid,zero,overflow + +# Flags to add additional build options +FFLAGS_OPENMP = -fopenmp +FFLAGS_VERBOSE = +FFLAGS_COVERAGE = + +# Macro for C preprocessor +CPPFLAGS = $(INCLUDES) +# C Compiler flags for the NetCDF library +CPPFLAGS += $(shell nf-config --cflags) + +# Base set of C compiler flags +CFLAGS := -D__IFC + +# Flags based on perforance target (production (OPT), reproduction (REPRO), or debug (DEBUG) +CFLAGS_OPT = -O2 +CFLAGS_REPRO = -O2 +CFLAGS_DEBUG = -O0 -g + +# Flags to add additional build options +CFLAGS_OPENMP = -fopenmp +CFLAGS_VERBOSE = +CFLAGS_COVERAGE = + +# Optional Testing compile flags. Mutually exclusive from DEBUG, REPRO, and OPT +# *_TEST will match the production if no new option(s) is(are) to be tested. +FFLAGS_TEST = $(FFLAGS_OPT) +CFLAGS_TEST = $(CFLAGS_OPT) + +# Linking flags +LDFLAGS := +LDFLAGS_OPENMP := -fopenmp +LDFLAGS_VERBOSE := +LDFLAGS_COVERAGE := + +# Start with a blank LIBS +LIBS = +# NetCDF library flags +LIBS += $(shell nf-config --flibs) + +# Get compile flags based on target macros. +ifdef REPRO +CFLAGS += $(CFLAGS_REPRO) +FFLAGS += $(FFLAGS_REPRO) +else ifdef DEBUG +CFLAGS += $(CFLAGS_DEBUG) +FFLAGS += $(FFLAGS_DEBUG) +else ifdef TEST +CFLAGS += $(CFLAGS_TEST) +FFLAGS += $(FFLAGS_TEST) +else +CFLAGS += $(CFLAGS_OPT) +FFLAGS += $(FFLAGS_OPT) +endif + +ifdef OPENMP +CFLAGS += $(CFLAGS_OPENMP) +FFLAGS += $(FFLAGS_OPENMP) +LDFLAGS += $(LDFLAGS_OPENMP) +endif + +ifdef SSE +CFLAGS += $(SSE) +FFLAGS += $(SSE) +endif + +ifdef NO_OVERRIDE_LIMITS +FFLAGS += $(FFLAGS_OVERRIDE_LIMITS) +endif + +ifdef VERBOSE +CFLAGS += $(CFLAGS_VERBOSE) +FFLAGS += $(FFLAGS_VERBOSE) +LDFLAGS += $(LDFLAGS_VERBOSE) +endif + +ifeq ($(NETCDF),3) + # add the use_LARGEFILE cppdef + ifneq ($(findstring -Duse_netCDF,$(CPPDEFS)),) + CPPDEFS += -Duse_LARGEFILE + endif +endif + +ifdef COVERAGE +ifdef BUILDROOT +PROF_DIR=-prof-dir=$(BUILDROOT) +endif +CFLAGS += $(CFLAGS_COVERAGE) $(PROF_DIR) +FFLAGS += $(FFLAGS_COVERAGE) $(PROF_DIR) +LDFLAGS += $(LDFLAGS_COVERAGE) $(PROF_DIR) +endif + +LDFLAGS += $(LIBS) + +#--------------------------------------------------------------------------- +# you should never need to change any lines below. + +# see the MIPSPro F90 manual for more details on some of the file extensions +# discussed here. +# this makefile template recognizes fortran sourcefiles with extensions +# .f, .f90, .F, .F90. Given a sourcefile ., where is one of +# the above, this provides a number of default actions: + +# make .opt create an optimization report +# make .o create an object file +# make .s create an assembly listing +# make .x create an executable file, assuming standalone +# source +# make .i create a preprocessed file (for .F) +# make .i90 create a preprocessed file (for .F90) + +# The macro TMPFILES is provided to slate files like the above for removal. + +RM = rm -f +TMPFILES = .*.m *.B *.L *.i *.i90 *.l *.s *.mod *.opt + +.SUFFIXES: .F .F90 .H .L .T .f .f90 .h .i .i90 .l .o .s .opt .x + +.f.L: + $(FC) $(FFLAGS) -c -listing $*.f +.f.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f +.f.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f +.f.T: + $(FC) $(FFLAGS) -c -cif $*.f +.f.o: + $(FC) $(FFLAGS) -c $*.f +.f.s: + $(FC) $(FFLAGS) -S $*.f +.f.x: + $(FC) $(FFLAGS) -o $*.x $*.f *.o $(LDFLAGS) +.f90.L: + $(FC) $(FFLAGS) -c -listing $*.f90 +.f90.opt: + $(FC) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.f90 +.f90.l: + $(FC) $(FFLAGS) -c $(LIST) $*.f90 +.f90.T: + $(FC) $(FFLAGS) -c -cif $*.f90 +.f90.o: + $(FC) $(FFLAGS) -c $*.f90 +.f90.s: + $(FC) $(FFLAGS) -c -S $*.f90 +.f90.x: + $(FC) $(FFLAGS) -o $*.x $*.f90 *.o $(LDFLAGS) +.F.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F +.F.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F +.F.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F +.F.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F +.F.f: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F > $*.f +.F.i: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F +.F.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F +.F.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F +.F.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F *.o $(LDFLAGS) +.F90.L: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -listing $*.F90 +.F90.opt: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -opt_report_level max -opt_report_phase all -opt_report_file $*.opt $*.F90 +.F90.l: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $(LIST) $*.F90 +.F90.T: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -cif $*.F90 +.F90.f90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -EP $*.F90 > $*.f90 +.F90.i90: + $(FC) $(CPPDEFS) $(FPPFLAGS) -P $*.F90 +.F90.o: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c $*.F90 +.F90.s: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -c -S $*.F90 +.F90.x: + $(FC) $(CPPDEFS) $(FPPFLAGS) $(FFLAGS) -o $*.x $*.F90 *.o $(LDFLAGS) diff --git a/.testing/trailer.py b/.testing/trailer.py new file mode 100755 index 0000000000..80b7e72738 --- /dev/null +++ b/.testing/trailer.py @@ -0,0 +1,95 @@ +#!/usr/bin/env python + +import argparse +import os +import re +import sys + +def parseCommandLine(): + """ + Parse the command line positional and optional arguments. + This is the highest level procedure invoked from the very end of the script. + """ + + # Arguments + parser = argparse.ArgumentParser(description='''trailer.py checks Fortran files for trailing white space.''', + epilog='Written by A.Adcroft, 2017.') + parser.add_argument('files_or_dirs', type=str, nargs='+', + metavar='FILE|DIR', + help='''Fortran files or director in which to search for Fortran files (with .f, .f90, .F90 suffixes).''') + parser.add_argument('-e','--exclude_dir', type=str, action='append', + metavar='DIR', + help='''Exclude directories from search that end in DIR.''') + parser.add_argument('-l','--line_length', type=int, default=512, + help='''Maximum allowed length of a line.''') + parser.add_argument('-d','--debug', action='store_true', + help='turn on debugging information.') + args = parser.parse_args() + + global debug + debug = args.debug + + main(args) + +def main(args): + ''' + Does the actual work + ''' + if (debug): print(args) + + # Process files_or_dirs argument into list of files + all_files = [] + for a in args.files_or_dirs: + if os.path.isfile(a): all_files.append(a) + elif os.path.isdir(a): + for d,s,files in os.walk(a): + ignore = False + if args.exclude_dir is not None: + for e in args.exclude_dir: + if e+'/' in d+'/': ignore = True + if not ignore: + for f in files: + _,ext = os.path.splitext(f) + if ext in ('.f','.F','.f90','.F90'): all_files.append( os.path.join(d,f) ) + else: raise Exception('Argument '+a+' is not a file or directory! Stopping.') + if (debug): print('Found: ',all_files) + + # For each file, check for trailing white space + fail = False + for filename in all_files: + this = scan_file(filename, line_length=args.line_length) + fail = fail or this + if fail: sys.exit(1) + +def scan_file(filename, line_length=120): + '''Scans file for trailing white space''' + def msg(filename,lineno,mesg,line=None): + if line is None: print('%s, line %i: %s'%(filename,lineno,mesg)) + else: print('%s, line %i: %s "%s"'%(filename,lineno,mesg,line)) + white_space_detected = False + tabs_space_detected = False + long_line_detected = False + with open(filename) as file: + trailing_space = re.compile(r'.* +$') + tabs = re.compile(r'.*\t.*') + lineno = 0 + for line in file.readlines(): + lineno += 1 + line = line.replace('\n','') + if trailing_space.match(line) is not None: + if debug: print(filename,lineno,line,trailing_space.match(line)) + if len(line.strip())>0: msg(filename,lineno,'Trailing space detected',line) + else: msg(filename,lineno,'Blank line contains spaces') + white_space_detected = True + if tabs.match(line) is not None: + if len(line.strip())>0: msg(filename,lineno,'Tab detected',line) + else: msg(filename,lineno,'Blank line contains tabs') + tabs_space_detected = True + if len(line)>line_length: + if len(line.strip())>0: msg(filename,lineno,'Line length exceeded',line) + else: msg(filename,lineno,'Blank line exceeds line length limit') + long_line_detected = True + return white_space_detected or tabs_space_detected or long_line_detected + +# Invoke parseCommandLine(), the top-level procedure +if __name__ == '__main__': parseCommandLine() diff --git a/.travis.yml b/.travis.yml index 2886eb09bd..5c5c31a6a4 100644 --- a/.travis.yml +++ b/.travis.yml @@ -3,46 +3,109 @@ # This is a not a c-language project but we use the same environment. language: c -dist: trusty +dist: xenial addons: apt: sources: - ubuntu-toolchain-r-test packages: - - tcsh pkg-config netcdf-bin libnetcdf-dev mpich2 libmpich2-dev gfortran + - tcsh pkg-config netcdf-bin libnetcdf-dev libnetcdff-dev openmpi-bin libopenmpi-dev gfortran + - doxygen graphviz flex bison cmake + +# Stages occur sequentially. Within each stage jobs run concurrently. +stages: + - check and compile + - tests + - cleanup -# For saving time... cache: directories: - - MOM6-examples -# - build # Uncomment this line to save time building. Less robust when FMS changes version! - -# Install tools and clone the configurations repository -before_install: - - git clone https://github.com/adcroft/house_cleaning.git - # This line clones MOM6-examples when there is no cache - - test -f MOM6-examples/README.md || (rm -rf MOM6-examples && git clone https://github.com/NOAA-GFDL/MOM6-examples.git) + - build +# Compilation and testing is controlled by the "configure" and "Makefile" in +# .testing/ but they operate from the root directory. We copy them into place +# so that they can remain hidden from users. install: - # This restores all files in MOM6-examples and updates - - (cd MOM6-examples/ && git checkout . && git pull) - # Update submodules mkmf and FMS - - (cd MOM6-examples/src/ && git submodule init mkmf FMS && git submodule update mkmf FMS) + - echo "Install step" + - cp .testing/{configure,Makefile} . -# Build FMS before_script: - - bash MOM6-examples/tools/tests/Travis-MOM6/build_fms.sh - - bash MOM6-examples/tools/tests/Travis-MOM6/before_script.sh - -# Tests to run -script: - - ./house_cleaning/trailer.py -e TEOS10 src config_src - - bash MOM6-examples/tools/tests/Travis-MOM6/build_ocean_only.sh - - bash MOM6-examples/tools/tests/Travis-MOM6/build_symmetric_ocean_only.sh - - bash MOM6-examples/tools/tests/Travis-MOM6/run_tests.sh + - ls -l + - ls build +# This avoids caching files we do not need between stages before_cache: -- rm -rf build/ocn build/symocn -- (cd MOM6-examples; rm -rf ocean_only; git checkout .) -- find MOM6-examples -type l -exec rm {} \; + - rm -f build/*.o build/*.mod + +jobs: + include: + + # Checks and compilation ################################################### +# - stage: check and compile +# script: +# - echo "Blank environment - this is where we would compile if we wanted to reuse executables in multiple tests" +# #- touch build/comp_nothing + - stage: check and compile + env: JOB="Code style compliance" + script: + - ./.testing/trailer.py -e TEOS10 src config_src + - stage: check and compile + env: JOB="Doxygen" + script: + - cd docs && doxygen Doxyfile_nortd + - grep -v "config_src/solo_driver/coupler_types.F90" doxygen.log | tee doxy_errors + - test ! -s doxy_errors + - &compile-code + stage: check and compile + env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric REPRO=1" + script: + - make $MAKEARGS compile + - touch build/comp_${MAKEARGS//\ /_} + - <<: *compile-code + env: MAKEARGS="MEMORY_SHAPE=dynamic REPRO=1" + - <<: *compile-code + env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric DEBUG=1" + - <<: *compile-code + env: MAKEARGS="MEMORY_SHAPE=dynamic DEBUG=1" +# - <<: *compile-code +# env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric OPENMP=1" + + # Run tests ################################################################ + # The default "test" job is automatically invoked for each of the matrix environments + # The "test" jobs executes "./configure && make && make test" +# - stage: tests +# script: +# - echo "Placeholder for generic text using blank environment" + - &compile + stage: tests + env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric REPRO=1" + script: + - ./configure && make -j && make test + - <<: *compile + env: MAKEARGS="MEMORY_SHAPE=dynamic REPRO=1" + - <<: *compile + env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric DEBUG=1" + - <<: *compile + env: MAKEARGS="MEMORY_SHAPE=dynamic DEBUG=1" +# - <<: *compile +# env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric OPENMP=1" + + # Clean up ################################################################# + # We only want the cache directory to exist between stages so we manually + # clean out the cache, i.e. build/ + - &clean-build + stage: cleanup + script: + - rm -rf build/* + - ls -l +# - <<: *clean-build + env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric REPRO=1" + - <<: *clean-build + env: MAKEARGS="MEMORY_SHAPE=dynamic REPRO=1" + - <<: *clean-build + env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric DEBUG=1" + - <<: *clean-build + env: MAKEARGS="MEMORY_SHAPE=dynamic DEBUG=1" +# - <<: *clean-build +# env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric OPENMP=1" From 265d01bea5e5b73a16e3a50ceb44b245abf50caf Mon Sep 17 00:00:00 2001 From: John Krasting Date: Thu, 11 Apr 2019 15:00:40 -0400 Subject: [PATCH 1059/1072] Set ca13csed to zero at k>1 - Like the original cased tracer, the ca13csed tracer used in generic_BLING.F90 needs to be initialized to zero at all subsurface layers (when do_13c = .true.) --- src/tracer/MOM_generic_tracer.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 93f72b239d..2b732c5cc3 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -303,7 +303,7 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, enddo ; enddo ; enddo !jgj: Reset CASED to 0 below K=1 - if (trim(g_tracer_name) == 'cased') then + if ( (trim(g_tracer_name) == 'cased') .or. (trim(g_tracer_name) == 'ca13csed') ) then do k=2,nk ; do j=jsc,jec ; do i=isc,iec if (tr_ptr(i,j,k) /= CS%tracer_land_val) then tr_ptr(i,j,k) = 0.0 From 1175747e7f445abb8fc9cb000eea56b02783cc86 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 19 Apr 2019 14:57:05 -0400 Subject: [PATCH 1060/1072] +Remove unneeded MOM6 coupler_types.F90 files With the xanadu release of FMS, the coupler_types module within FMS has finally been properly scoped without adding unnecssary dependencies. The coupler_types.F90 files in the MOM6 config_src/solo_driver directories are no longer needed. In addition, the routines inside coupler_util.F90 files have not been used anywhere in MOM6 for some time, their functionality being provided via interfaces inside the coupler_types_mod. These 5 files have now been removed. All answers are bitwise identical. --- config_src/coupled_driver/coupler_util.F90 | 137 - config_src/ice_solo_driver/coupler_types.F90 | 3294 ----------------- config_src/ice_solo_driver/coupler_util.F90 | 144 - config_src/solo_driver/coupler_types.F90 | 3310 ------------------ config_src/solo_driver/coupler_util.F90 | 135 - 5 files changed, 7020 deletions(-) delete mode 100644 config_src/coupled_driver/coupler_util.F90 delete mode 100644 config_src/ice_solo_driver/coupler_types.F90 delete mode 100644 config_src/ice_solo_driver/coupler_util.F90 delete mode 100644 config_src/solo_driver/coupler_types.F90 delete mode 100644 config_src/solo_driver/coupler_util.F90 diff --git a/config_src/coupled_driver/coupler_util.F90 b/config_src/coupled_driver/coupler_util.F90 deleted file mode 100644 index 2c72c56cce..0000000000 --- a/config_src/coupled_driver/coupler_util.F90 +++ /dev/null @@ -1,137 +0,0 @@ -!> Provides a couple of interfaces to allow more transparent and -!! robust extraction of the various fields in the coupler types. -module coupler_util - -! This file is part of MOM6. See LICENSE.md for the license. - -use MOM_error_handler, only : MOM_error, FATAL, WARNING -use coupler_types_mod, only : coupler_2d_bc_type, ind_flux, ind_alpha -use coupler_types_mod, only : ind_csurf - -implicit none ; private - -public :: extract_coupler_values, set_coupler_values -public :: ind_flux, ind_alpha, ind_csurf - -contains - -!> Extract an array of values in a coupler bc type -subroutine extract_coupler_values(BC_struc, BC_index, BC_element, array_out, & - is, ie, js, je, conversion) - type(coupler_2d_bc_type), intent(in) :: BC_struc !< The type from which the data is being extracted. - integer, intent(in) :: BC_index !< The boundary condition number being extracted. - integer, intent(in) :: BC_element !< The element of the boundary condition being extracted. - real, dimension(:,:), intent(out) :: array_out !< The array being filled with the input values. - integer, optional, intent(in) :: is !< Start i-index - integer, optional, intent(in) :: ie !< End i-index - integer, optional, intent(in) :: js !< Start j-index - integer, optional, intent(in) :: je !< End j-index - real, optional, intent(in) :: conversion !< A number that every element is multiplied by, to - !! permit sign convention or unit conversion. - ! Local variables - real, pointer, dimension(:,:) :: Array_in - real :: conv - integer :: i, j, is0, ie0, js0, je0, i_offset, j_offset - - if ((BC_element /= ind_flux) .and. (BC_element /= ind_alpha) .and. & - (BC_element /= ind_csurf)) then - call MOM_error(FATAL,"extract_coupler_values: Unrecognized BC_element.") - endif - - ! These error messages should be made more explicit. -! if (.not.associated(BC_struc%bc(BC_index))) & - if (.not.associated(BC_struc%bc)) & - call MOM_error(FATAL,"extract_coupler_values: " // & - "The requested boundary condition is not associated.") -! if (.not.associated(BC_struc%bc(BC_index)%field(BC_element))) & - if (.not.associated(BC_struc%bc(BC_index)%field)) & - call MOM_error(FATAL,"extract_coupler_values: " // & - "The requested boundary condition element is not associated.") - if (.not.associated(BC_struc%bc(BC_index)%field(BC_element)%values)) & - call MOM_error(FATAL,"extract_coupler_values: " // & - "The requested boundary condition value array is not associated.") - - Array_in => BC_struc%bc(BC_index)%field(BC_element)%values - - if (present(is)) then ; is0 = is ; else ; is0 = LBOUND(array_out,1) ; endif - if (present(ie)) then ; ie0 = ie ; else ; ie0 = UBOUND(array_out,1) ; endif - if (present(js)) then ; js0 = js ; else ; js0 = LBOUND(array_out,2) ; endif - if (present(je)) then ; je0 = je ; else ; je0 = UBOUND(array_out,2) ; endif - - conv = 1.0 ; if (present(conversion)) conv = conversion - - if (size(Array_in,1) /= ie0 - is0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and output array or computational domain.") - if (size(Array_in,2) /= je0 - js0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and output array or computational domain.") - i_offset = lbound(Array_in,1) - is0 - j_offset = lbound(Array_in,2) - js0 - do j=js0,je0 ; do i=is0,ie0 - array_out(i,j) = conv * Array_in(i+i_offset,j+j_offset) - enddo ; enddo - -end subroutine extract_coupler_values - -!> Set an array of values in a coupler bc type -subroutine set_coupler_values(array_in, BC_struc, BC_index, BC_element, & - is, ie, js, je, conversion) - real, dimension(:,:), intent(in) :: array_in !< The array containing the values to load into the BC. - type(coupler_2d_bc_type), intent(inout) :: BC_struc !< The type from which the data is being extracted. - integer, intent(in) :: BC_index !< The boundary condition number being extracted. - integer, intent(in) :: BC_element !< The element of the boundary condition being extracted. - !! This could be ind_csurf, ind_alpha, ind_flux or ind_deposition. - integer, optional, intent(in) :: is !< Start i-index - integer, optional, intent(in) :: ie !< End i-index - integer, optional, intent(in) :: js !< Start j-index - integer, optional, intent(in) :: je !< End j-index - real, optional, intent(in) :: conversion !< A number that every element is multiplied by, to - !! permit sign convention or unit conversion. - ! Local variables - real, pointer, dimension(:,:) :: Array_out - real :: conv - integer :: i, j, is0, ie0, js0, je0, i_offset, j_offset - - if ((BC_element /= ind_flux) .and. (BC_element /= ind_alpha) .and. & - (BC_element /= ind_csurf)) then - call MOM_error(FATAL,"extract_coupler_values: Unrecognized BC_element.") - endif - - ! These error messages should be made more explicit. -! if (.not.associated(BC_struc%bc(BC_index))) & - if (.not.associated(BC_struc%bc)) & - call MOM_error(FATAL,"set_coupler_values: " // & - "The requested boundary condition is not associated.") -! if (.not.associated(BC_struc%bc(BC_index)%field(BC_element))) & - if (.not.associated(BC_struc%bc(BC_index)%field)) & - call MOM_error(FATAL,"set_coupler_values: " // & - "The requested boundary condition element is not associated.") - if (.not.associated(BC_struc%bc(BC_index)%field(BC_element)%values)) & - call MOM_error(FATAL,"set_coupler_values: " // & - "The requested boundary condition value array is not associated.") - - Array_out => BC_struc%bc(BC_index)%field(BC_element)%values - - if (present(is)) then ; is0 = is ; else ; is0 = LBOUND(array_in,1) ; endif - if (present(ie)) then ; ie0 = ie ; else ; ie0 = UBOUND(array_in,1) ; endif - if (present(js)) then ; js0 = js ; else ; js0 = LBOUND(array_in,2) ; endif - if (present(je)) then ; je0 = je ; else ; je0 = UBOUND(array_in,2) ; endif - - conv = 1.0 ; if (present(conversion)) conv = conversion - - if (size(Array_out,1) /= ie0 - is0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and input array or computational domain.") - if (size(Array_out,2) /= je0 - js0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and input array or computational domain.") - i_offset = lbound(Array_out,1) - is0 - j_offset = lbound(Array_out,2) - js0 - do j=js0,je0 ; do i=is0,ie0 - Array_out(i+i_offset,j+j_offset) = conv * array_in(i,j) - enddo ; enddo - -end subroutine set_coupler_values - -end module coupler_util diff --git a/config_src/ice_solo_driver/coupler_types.F90 b/config_src/ice_solo_driver/coupler_types.F90 deleted file mode 100644 index 99a74e085c..0000000000 --- a/config_src/ice_solo_driver/coupler_types.F90 +++ /dev/null @@ -1,3294 +0,0 @@ -module coupler_types_mod - -! This file is part of MOM6. See LICENSE.md for the license. - -! This module contains the coupler-type declarations and methods for use in -! ocean-only configurations of MOM6. It is intended that the version of -! coupler_types_mod that is avialable from FMS will conform to this version with -! the FMS city release after warsaw. - -use fms_io_mod, only: restart_file_type, register_restart_field -use fms_io_mod, only: query_initialized, restore_state -use time_manager_mod, only: time_type -use diag_manager_mod, only: register_diag_field, send_data -use data_override_mod, only: data_override -use mpp_domains_mod, only: domain2D, mpp_redistribute -use mpp_mod, only: stdout, mpp_error, FATAL, mpp_chksum - -implicit none ; private - -public coupler_type_copy, coupler_type_spawn, coupler_type_set_diags -public coupler_type_write_chksums, coupler_type_send_data, coupler_type_data_override -public coupler_type_register_restarts, coupler_type_restore_state -public coupler_type_increment_data, coupler_type_rescale_data -public coupler_type_copy_data, coupler_type_redistribute_data -public coupler_type_destructor, coupler_type_initialized -public coupler_type_extract_data, coupler_type_set_data - -public coupler_type_copy_1d_2d -public coupler_type_copy_1d_3d - -! -! 3-d fields -! -type, public :: coupler_3d_values_type - character(len=48) :: name = ' ' !< The diagnostic name for this array - real, pointer, contiguous, dimension(:,:,:) :: values => NULL() !< The pointer to the - !! array of values for this field; this - !! should be changed to allocatable - logical :: mean = .true. !< mean - logical :: override = .false. !< override - integer :: id_diag = 0 !< The diagnostic id for this array - character(len=128) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=128) :: units = ' ' !< The units for this array - integer :: id_rest = 0 !< The id of this array in the restart field - logical :: may_init = .true. !< If true, there is an internal method - !! that can be used to initialize this field - !! if it can not be read from a restart file -end type coupler_3d_values_type - -type, public :: coupler_3d_field_type - character(len=48) :: name = ' ' !< name - integer :: num_fields = 0 !< num_fields - type(coupler_3d_values_type), pointer, dimension(:) :: field => NULL() !< field - character(len=128) :: flux_type = ' ' !< flux_type - character(len=128) :: implementation = ' ' !< implementation - real, pointer, dimension(:) :: param => NULL() !< param - logical, pointer, dimension(:) :: flag => NULL() !< flag - integer :: atm_tr_index = 0 !< atm_tr_index - character(len=128) :: ice_restart_file = ' ' !< ice_restart_file - character(len=128) :: ocean_restart_file = ' ' !< ocean_restart_file - type(restart_file_type), pointer :: rest_type => NULL() !< A pointer to the restart_file_type - !! that is used for this field. - logical :: use_atm_pressure !< use_atm_pressure - logical :: use_10m_wind_speed !< use_10m_wind_speed - logical :: pass_through_ice !< pass_through_ice - real :: mol_wt = 0.0 !< mol_wt -end type coupler_3d_field_type - -type, public :: coupler_3d_bc_type - integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_3d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary - !! condition fields - logical :: set = .false. !< If true, this type has been initialized - integer :: isd, isc, iec, ied !< The i-direction data and computational domain index ranges for this type - integer :: jsd, jsc, jec, jed !< The j-direction data and computational domain index ranges for this type - integer :: ks, ke !< The k-direction index ranges for this type -end type coupler_3d_bc_type - -! -! 2-d fields -! -type, public :: coupler_2d_values_type - character(len=48) :: name = ' ' !< The diagnostic name for this array - real, pointer, contiguous, dimension(:,:) :: values => NULL() !< The pointer to the - !! array of values for this field; this - !! should be changed to allocatable - logical :: mean = .true. !< mean - logical :: override = .false. !< override - integer :: id_diag = 0 !< The diagnostic id for this array - character(len=128) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=128) :: units = ' ' !< The units for this array - integer :: id_rest = 0 !< The id of this array in the restart field - logical :: may_init = .true. !< If true, there is an internal method - !! that can be used to initialize this field - !! if it can not be read from a restart file -end type coupler_2d_values_type - -type, public :: coupler_2d_field_type - character(len=48) :: name = ' ' !< name - integer :: num_fields = 0 !< num_fields - type(coupler_2d_values_type), pointer, dimension(:) :: field => NULL() !< field - character(len=128) :: flux_type = ' ' !< flux_type - character(len=128) :: implementation = ' ' !< implementation - real, pointer, dimension(:) :: param => NULL() !< param - logical, pointer, dimension(:) :: flag => NULL() !< flag - integer :: atm_tr_index = 0 !< atm_tr_index - character(len=128) :: ice_restart_file = ' ' !< ice_restart_file - character(len=128) :: ocean_restart_file = ' ' !< ocean_restart_file - type(restart_file_type), pointer :: rest_type => NULL() !< A pointer to the restart_file_type - !! that is used for this field. - logical :: use_atm_pressure !< use_atm_pressure - logical :: use_10m_wind_speed !< use_10m_wind_speed - logical :: pass_through_ice !< pass_through_ice - real :: mol_wt = 0.0 !< mol_wt -end type coupler_2d_field_type - -type, public :: coupler_2d_bc_type - integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_2d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary - !! condition fields - logical :: set = .false. !< If true, this type has been initialized - integer :: isd, isc, iec, ied !< The i-direction data and computational domain index ranges for this type - integer :: jsd, jsc, jec, jed !< The j-direction data and computational domain index ranges for this type -end type coupler_2d_bc_type - -! -! 1-d fields -! -type, public :: coupler_1d_values_type - character(len=48) :: name = ' ' !< The diagnostic name for this array - real, pointer, dimension(:) :: values => NULL() !< The pointer to the array of values - logical :: mean = .true. !< mean - logical :: override = .false. !< override - integer :: id_diag = 0 !< The diagnostic id for this array - character(len=128) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=128) :: units = ' ' !< The units for this array - logical :: may_init = .true. !< If true, there is an internal method - !! that can be used to initialize this field - !! if it can not be read from a restart file -end type coupler_1d_values_type - -type, public :: coupler_1d_field_type - character(len=48) :: name = ' ' !< name - integer :: num_fields = 0 !< num_fields - type(coupler_1d_values_type), pointer, dimension(:) :: field => NULL() !< field - character(len=128) :: flux_type = ' ' !< flux_type - character(len=128) :: implementation = ' ' !< implementation - real, pointer, dimension(:) :: param => NULL() !< param - logical, pointer, dimension(:) :: flag => NULL() !< flag - integer :: atm_tr_index = 0 !< atm_tr_index - character(len=128) :: ice_restart_file = ' ' !< ice_restart_file - character(len=128) :: ocean_restart_file = ' ' !< ocean_restart_file - logical :: use_atm_pressure !< use_atm_pressure - logical :: use_10m_wind_speed !< use_10m_wind_speed - logical :: pass_through_ice !< pass_through_ice - real :: mol_wt = 0.0 !< mol_wt -end type coupler_1d_field_type - -type, public :: coupler_1d_bc_type - integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_1d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary - !! condition fields - logical :: set = .false. !< If true, this type has been initialized -end type coupler_1d_bc_type - -!---------------------------------------------------------------------- -! The following public parameters can help in selecting the sub-elements of a -! coupler type. There are duplicate values because different boundary -! conditions have different sub-elements. -integer, parameter, public :: ind_pcair = 1 !< The index of the atmospheric concentration -integer, parameter, public :: ind_u10 = 2 !< The index of the 10 m wind speed -integer, parameter, public :: ind_psurf = 3 !< The index of the surface atmospheric pressure -integer, parameter, public :: ind_alpha = 1 !< The index of the solubility array for a tracer -integer, parameter, public :: ind_csurf = 2 !< The index of the ocean surface concentration -integer, parameter, public :: ind_sc_no = 3 !< The index for the Schmidt number for a tracer flux -integer, parameter, public :: ind_flux = 1 !< The index for the tracer flux -integer, parameter, public :: ind_deltap= 2 !< The index for ocean-air gas partial pressure change -integer, parameter, public :: ind_kw = 3 !< The index for the piston velocity -integer, parameter, public :: ind_deposition = 1 !< The index for the atmospheric deposition flux -integer, parameter, public :: ind_runoff = 1 !< The index for a runoff flux - -!---------------------------------------------------------------------- -! Interface definitions for overloaded routines -!---------------------------------------------------------------------- - -!> This is the interface to spawn one coupler_bc_type into another and then -!! register diagnostics associated with the new type. -interface coupler_type_copy - module procedure coupler_type_copy_1d_2d, coupler_type_copy_1d_3d - module procedure coupler_type_copy_2d_2d, coupler_type_copy_2d_3d - module procedure coupler_type_copy_3d_2d, coupler_type_copy_3d_3d -end interface coupler_type_copy - -!> This is the interface to spawn one coupler_bc_type into another. -interface coupler_type_spawn - module procedure CT_spawn_1d_2d, CT_spawn_2d_2d, CT_spawn_3d_2d - module procedure CT_spawn_1d_3d, CT_spawn_2d_3d, CT_spawn_3d_3d -end interface coupler_type_spawn - -!> This is the interface to copy the field data from one coupler_bc_type -!! to another of the same rank, size and decomposition. -interface coupler_type_copy_data - module procedure CT_copy_data_2d, CT_copy_data_3d, CT_copy_data_2d_3d -end interface coupler_type_copy_data - -!> This is the interface to redistribute the field data from one coupler_bc_type -!! to another of the same rank and global size, but a different decomposition. -interface coupler_type_redistribute_data - module procedure CT_redistribute_data_2d, CT_redistribute_data_3d -end interface coupler_type_redistribute_data - -!> This is the interface to rescale the field data in a coupler_bc_type. -interface coupler_type_rescale_data - module procedure CT_rescale_data_2d, CT_rescale_data_3d -end interface coupler_type_rescale_data - -!> This is the interface to increment the field data from one coupler_bc_type -!! with the data from another. Both must have the same horizontal size and -!! decomposition, but a 2d type may be incremented by a 2d or 3d type -interface coupler_type_increment_data - module procedure CT_increment_data_2d_2d, CT_increment_data_3d_3d, CT_increment_data_2d_3d -end interface coupler_type_increment_data - -!> This is the interface to extract a field in a coupler_bc_type into an array. -interface coupler_type_extract_data - module procedure CT_extract_data_2d, CT_extract_data_3d, CT_extract_data_3d_2d -end interface coupler_type_extract_data - -!> This is the interface to set a field in a coupler_bc_type from an array. -interface coupler_type_set_data - module procedure CT_set_data_2d, CT_set_data_3d, CT_set_data_2d_3d -end interface coupler_type_set_data - -!> This is the interface to set diagnostics for the arrays in a coupler_bc_type. -interface coupler_type_set_diags - module procedure CT_set_diags_2d, CT_set_diags_3d -end interface coupler_type_set_diags - -!> This is the interface to write out checksums for the elements of a coupler_bc_type. -interface coupler_type_write_chksums - module procedure CT_write_chksums_2d, CT_write_chksums_3d -end interface coupler_type_write_chksums - -!> This is the interface to write out diagnostics of the arrays in a coupler_bc_type. -interface coupler_type_send_data - module procedure CT_send_data_2d, CT_send_data_3d -end interface coupler_type_send_data - -!> This is the interface to override the values of the arrays in a coupler_bc_type. -interface coupler_type_data_override - module procedure CT_data_override_2d, CT_data_override_3d -end interface coupler_type_data_override - -!> This is the interface to register the fields in a coupler_bc_type to be saved -!! in restart files. -interface coupler_type_register_restarts - module procedure CT_register_restarts_2d, CT_register_restarts_3d - module procedure CT_register_restarts_to_file_2d, CT_register_restarts_to_file_3d -end interface coupler_type_register_restarts - -!> This is the interface to read in the fields in a coupler_bc_type that have -!! been saved in restart files. -interface coupler_type_restore_state - module procedure CT_restore_state_2d, CT_restore_state_3d -end interface coupler_type_restore_state - -!> This function interface indicates whether a coupler_bc_type has been initialized. -interface coupler_type_initialized - module procedure CT_initialized_1d, CT_initialized_2d, CT_initialized_3d -end interface coupler_type_initialized - -!> This is the interface to deallocate any data associated with a coupler_bc_type. -interface coupler_type_destructor - module procedure CT_destructor_1d, CT_destructor_2d, CT_destructor_3d -end interface coupler_type_destructor - -contains - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 1-D to 2-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -subroutine coupler_type_copy_1d_2d(var_in, var_out, is, ie, js, je, & - diag_name, axes, time, suffix) - - type(coupler_1d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_2d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then - !! don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_1d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_1d_2d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_2d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_1d_2d - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 1-D to 3-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, kd, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var_out%bc already associated" -!! \throw FATAL, "var_out%bc([n])%field already associated" -!! \throw FATAL, "var_out%bc([n])%field([m])%values already associated" -!! \throw FATAL, "axes less than 3 elements" -subroutine coupler_type_copy_1d_3d(var_in, var_out, is, ie, js, je, kd, & - diag_name, axes, time, suffix) - - type(coupler_1d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_3d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then - !! don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_1d_3d):' - character(len=400) :: error_msg - integer :: m, n - - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_1d_3d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), (/1, kd/), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_3d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_1d_3d - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 2-D to 2-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -subroutine coupler_type_copy_2d_2d(var_in, var_out, is, ie, js, je, & - diag_name, axes, time, suffix) - - type(coupler_2d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_2d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_2d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_2d_2d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_2d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_2d_2d - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 2-D to 3-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, kd, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var_out%bc already associated" -!! \throw FATAL, "var_out%bc([n])%field already associated" -!! \throw FATAL, "var_out%bc([n])%field([m])%values already associated" -!! \throw FATAL, "axes less than 3 elements" -subroutine coupler_type_copy_2d_3d(var_in, var_out, is, ie, js, je, kd, & - diag_name, axes, time, suffix) - - type(coupler_2d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_3d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_2d_3d):' - character(len=400) :: error_msg - integer :: m, n - - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_2d_3d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), (/1, kd/), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_3d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_2d_3d - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 3-D to 2-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -subroutine coupler_type_copy_3d_2d(var_in, var_out, is, ie, js, je, & - diag_name, axes, time, suffix) - - type(coupler_3d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_2d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_3d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_3d_2d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_2d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_3d_2d - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 3-D to 3-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, kd, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var_out%bc already associated" -!! \throw FATAL, "var_out%bc([n])%field already associated" -!! \throw FATAL, "var_out%bc([n])%field([m])%values already associated" -!! \throw FATAL, "axes less than 3 elements" -subroutine coupler_type_copy_3d_3d(var_in, var_out, is, ie, js, je, kd, & - diag_name, axes, time, suffix) - - type(coupler_3d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_3d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_3d_3d):' - character(len=400) :: error_msg - integer :: m, n - - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_3d_3d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), (/1, kd/), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_3d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_3d_3d - - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 1-D to 2-D version for generic coupler_type_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var_out, idim, jdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var_out%bc already associated" -!! \throw FATAL, "var_out%bc([n])%field already associated" -!! \throw FATAL, "var_out%bc([n])%field([m])%values already associated" -subroutine CT_spawn_1d_2d(var_in, var, idim, jdim, suffix, as_needed) - - type(coupler_1d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_1d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed) ) - var%bc(n)%field(m)%values(:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_1d_2d - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 1-D to 3-D version for generic CT_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var, idim, jdim, kdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var%bc already associated" -!! \throw FATAL, "var%bc([n])%field already associated" -!! \throw FATAL, "var%bc([n])%field([m])%values already associated" -subroutine CT_spawn_1d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) - - type(coupler_1d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_3d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - integer, dimension(2), intent(in) :: kdim !< The array extents of the third dimension in - !! a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_1d_3d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - ! Store the array extents that are to be used with this bc_type. - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (kdim(1) > kdim(2)) then - write (error_msg, *) trim(error_header), ' Disordered k-dimension index bound list ', kdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - var%ks = kdim(1) ; var%ke = kdim(2) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed,var%ks:var%ke) ) - var%bc(n)%field(m)%values(:,:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_1d_3d - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 2-D to 2-D version for generic CT_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var, idim, jdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var%bc already associated" -!! \throw FATAL, "var%bc([n])%field already associated" -!! \throw FATAL, "var%bc([n])%field([m])%values already associated" -subroutine CT_spawn_2d_2d(var_in, var, idim, jdim, suffix, as_needed) - - type(coupler_2d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_2d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed) ) - var%bc(n)%field(m)%values(:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_2d_2d - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 2-D to 3-D version for generic CT_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var, idim, jdim, kdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var%bc already associated" -!! \throw FATAL, "var%bc([n])%field already associated" -!! \throw FATAL, "var%bc([n])%field([m])%values already associated" -subroutine CT_spawn_2d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) - - type(coupler_2d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_3d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - integer, dimension(2), intent(in) :: kdim !< The array extents of the third dimension in - !! a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_2d_3d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - ! Store the array extents that are to be used with this bc_type. - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (kdim(1) > kdim(2)) then - write (error_msg, *) trim(error_header), ' Disordered k-dimension index bound list ', kdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - var%ks = kdim(1) ; var%ke = kdim(2) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed,var%ks:var%ke) ) - var%bc(n)%field(m)%values(:,:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_2d_3d - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 3-D to 2-D version for generic CT_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var, idim, jdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var%bc already associated" -!! \throw FATAL, "var%bc([n])%field already associated" -!! \throw FATAL, "var%bc([n])%field([m])%values already associated" -subroutine CT_spawn_3d_2d(var_in, var, idim, jdim, suffix, as_needed) - - type(coupler_3d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_3d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed) ) - var%bc(n)%field(m)%values(:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_3d_2d - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 3-D to 3-D version for generic CT_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var, idim, jdim, kdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var%bc already associated" -!! \throw FATAL, "var%bc([n])%field already associated" -!! \throw FATAL, "var%bc([n])%field([m])%values already associated" -subroutine CT_spawn_3d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) - - type(coupler_3d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_3d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - integer, dimension(2), intent(in) :: kdim !< The array extents of the third dimension in - !! a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_3d_3d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (kdim(1) > kdim(2)) then - write (error_msg, *) trim(error_header), ' Disordered k-dimension index bound list ', kdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - var%ks = kdim(1) ; var%ke = kdim(2) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed,var%ks:var%ke) ) - var%bc(n)%field(m)%values(:,:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_3d_3d - - -!> This subroutine does a direct copy of the data in all elements of one -!! coupler_2d_bc_type into another. Both must have the same array sizes. -subroutine CT_copy_data_2d(var_in, var, halo_size, bc_index, field_index, & - exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy - type(coupler_2d_bc_type), intent(inout) :: var !< The recipient BC_type structure - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this copy. - logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose - !! value of pass_through ice matches this - logical :: copy_bc - integer :: i, j, m, n, n1, n2, halo, i_off, j_off - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_copy_data_2d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_copy_data_2d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_copy_data_2d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_copy_data_2d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_copy_data_2d: There is a j-direction computional domain size mismatch.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d: Excessive j-direction halo size for the output structure.") - - i_off = var_in%isc - var%isc ; j_off = var_in%jsc - var%jsc - endif - - do n = n1, n2 - - copy_bc = .true. - if (copy_bc .and. present(exclude_flux_type)) & - copy_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (copy_bc .and. present(only_flux_type)) & - copy_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (copy_bc .and. present(pass_through_ice)) & - copy_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.copy_bc) cycle - - do m = 1, var%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j) = var_in%bc(n)%field(m)%values(i+i_off,j+j_off) - enddo ; enddo - endif - enddo - enddo - -end subroutine CT_copy_data_2d - -!> This subroutine does a direct copy of the data in all elements of one -!! coupler_3d_bc_type into another. Both types must have the same array sizes. -subroutine CT_copy_data_3d(var_in, var, halo_size, bc_index, field_index, & - exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy - type(coupler_3d_bc_type), intent(inout) :: var !< The recipient BC_type structure - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this copy. - logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose - !! value of pass_through ice matches this - logical :: copy_bc - integer :: i, j, k, m, n, n1, n2, halo, i_off, j_off, k_off - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_copy_data_3d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_copy_data_3d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_copy_data_3d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_copy_data_3d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_copy_data_3d: There is a j-direction computional domain size mismatch.") - if ((var_in%ke-var_in%ks) /= (var%ke-var%ks)) & - call mpp_error(FATAL, "CT_copy_data_3d: There is a k-direction computional domain size mismatch.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_3d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_3d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_3d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_3d: Excessive j-direction halo size for the output structure.") - - i_off = var_in%isc - var%isc ; j_off = var_in%jsc - var%jsc ; k_off = var_in%ks - var%ks - endif - - do n = n1, n2 - - copy_bc = .true. - if (copy_bc .and. present(exclude_flux_type)) & - copy_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (copy_bc .and. present(only_flux_type)) & - copy_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (copy_bc .and. present(pass_through_ice)) & - copy_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.copy_bc) cycle - - do m = 1, var_in%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - do k=var%ks,var%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j,k) = var_in%bc(n)%field(m)%values(i+i_off,j+j_off,k+k_off) - enddo ; enddo ; enddo - endif - enddo - enddo - -end subroutine CT_copy_data_3d - -!> This subroutine does a direct copy of the data in all elements of a -!! coupler_2d_bc_type into a coupler_3d_bc_type. Both types must have the same -!! array sizes for their first two dimensions, while the extent of the 3rd dimension -!! that is being filled may be specified via optional arguments. -subroutine CT_copy_data_2d_3d(var_in, var, halo_size, bc_index, field_index, & - exclude_flux_type, only_flux_type, pass_through_ice, & - ind3_start, ind3_end) - type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy - type(coupler_3d_bc_type), intent(inout) :: var !< The recipient BC_type structure - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this copy. - logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose - !! value of pass_through ice matches this - integer, optional, intent(in) :: ind3_start !< The starting value of the 3rd - !! index of the 3d type to fill in. - integer, optional, intent(in) :: ind3_end !< The ending value of the 3rd - !! index of the 3d type to fill in. - logical :: copy_bc - integer :: i, j, k, m, n, n1, n2, halo, i_off, j_off, ks, ke - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_copy_data_2d_3d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: There is a j-direction computional domain size mismatch.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: Excessive j-direction halo size for the output structure.") - endif - - i_off = var_in%isc - var%isc ; j_off = var_in%jsc - var%jsc - do n = n1, n2 - - copy_bc = .true. - if (copy_bc .and. present(exclude_flux_type)) & - copy_bc = .not.(trim(var_in%bc(n)%flux_type) == trim(exclude_flux_type)) - if (copy_bc .and. present(only_flux_type)) & - copy_bc = (trim(var_in%bc(n)%flux_type) == trim(only_flux_type)) - if (copy_bc .and. present(pass_through_ice)) & - copy_bc = (pass_through_ice .eqv. var_in%bc(n)%pass_through_ice) - if (.not.copy_bc) cycle - - do m = 1, var_in%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - ks = var%ks ; if (present(ind3_start)) ks = max(ks, ind3_start) - ke = var%ke ; if (present(ind3_end)) ke = max(ke, ind3_end) - do k=ks,ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j,k) = var_in%bc(n)%field(m)%values(i+i_off,j+j_off) - enddo ; enddo ; enddo - endif - enddo - enddo - -end subroutine CT_copy_data_2d_3d - - -!> This subroutine redistributes the data in all elements of one coupler_2d_bc_type -!! into another, which may be on different processors with a different decomposition. -subroutine CT_redistribute_data_2d(var_in, domain_in, var_out, domain_out, complete) - type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy (intent in) - type(domain2D), intent(in) :: domain_in !< The FMS domain for the input structure - type(coupler_2d_bc_type), intent(inout) :: var_out !< The recipient BC_type structure (data intent out) - type(domain2D), intent(in) :: domain_out !< The FMS domain for the output structure - logical, optional, intent(in) :: complete !< If true, complete the updates - - real, pointer, dimension(:,:) :: null_ptr2D => NULL() - logical :: do_in, do_out, do_complete - integer :: m, n, fc, fc_in, fc_out - - do_complete = .true. ; if (present(complete)) do_complete = complete - - ! Figure out whether this PE has valid input or output fields or both. - do_in = var_in%set - do_out = var_out%set - - fc_in = 0 ; fc_out = 0 - if (do_in) then ; do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if (associated(var_in%bc(n)%field(m)%values)) fc_in = fc_in + 1 - enddo ; enddo ; endif - if (fc_in == 0) do_in = .false. - if (do_out) then ; do n = 1, var_out%num_bcs ; do m = 1, var_out%bc(n)%num_fields - if (associated(var_out%bc(n)%field(m)%values)) fc_out = fc_out + 1 - enddo ; enddo ; endif - if (fc_out == 0) do_out = .false. - - if (do_in .and. do_out) then - if (var_in%num_bcs /= var_out%num_bcs) call mpp_error(FATAL, & - "Mismatch in num_bcs in CT_copy_data_2d.") - if (fc_in /= fc_out) call mpp_error(FATAL, & - "Mismatch in the total number of fields in CT_redistribute_data_2d.") - endif - - if (.not.(do_in .or. do_out)) return - - fc = 0 - if (do_in .and. do_out) then - do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if ( associated(var_in%bc(n)%field(m)%values) .neqv. & - associated(var_out%bc(n)%field(m)%values) ) & - call mpp_error(FATAL, & - "Mismatch in which fields are associated in CT_redistribute_data_2d.") - - if ( associated(var_in%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, var_in%bc(n)%field(m)%values, & - domain_out, var_out%bc(n)%field(m)%values, & - complete=(do_complete.and.(fc==fc_in)) ) - endif - enddo ; enddo - elseif (do_in) then - do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if ( associated(var_in%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, var_in%bc(n)%field(m)%values, & - domain_out, null_ptr2D, & - complete=(do_complete.and.(fc==fc_in)) ) - endif - enddo ; enddo - elseif (do_out) then - do n = 1, var_out%num_bcs ; do m = 1, var_out%bc(n)%num_fields - if ( associated(var_out%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, null_ptr2D, & - domain_out, var_out%bc(n)%field(m)%values, & - complete=(do_complete.and.(fc==fc_out)) ) - endif - enddo ; enddo - endif - -end subroutine CT_redistribute_data_2d - -!> This subroutine redistributes the data in all elements of one coupler_2d_bc_type -!! into another, which may be on different processors with a different decomposition. -subroutine CT_redistribute_data_3d(var_in, domain_in, var_out, domain_out, complete) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy (intent in) - type(domain2D), intent(in) :: domain_in !< The FMS domain for the input structure - type(coupler_3d_bc_type), intent(inout) :: var_out !< The recipient BC_type structure (data intent out) - type(domain2D), intent(in) :: domain_out !< The FMS domain for the output structure - logical, optional, intent(in) :: complete !< If true, complete the updates - - real, pointer, dimension(:,:,:) :: null_ptr3D => NULL() - logical :: do_in, do_out, do_complete - integer :: m, n, fc, fc_in, fc_out - - do_complete = .true. ; if (present(complete)) do_complete = complete - - ! Figure out whether this PE has valid input or output fields or both. - do_in = var_in%set - do_out = var_out%set - - fc_in = 0 ; fc_out = 0 - if (do_in) then ; do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if (associated(var_in%bc(n)%field(m)%values)) fc_in = fc_in + 1 - enddo ; enddo ; endif - if (fc_in == 0) do_in = .false. - if (do_out) then ; do n = 1, var_out%num_bcs ; do m = 1, var_out%bc(n)%num_fields - if (associated(var_out%bc(n)%field(m)%values)) fc_out = fc_out + 1 - enddo ; enddo ; endif - if (fc_out == 0) do_out = .false. - - if (do_in .and. do_out) then - if (var_in%num_bcs /= var_out%num_bcs) call mpp_error(FATAL, & - "Mismatch in num_bcs in CT_copy_data_3d.") - if (fc_in /= fc_out) call mpp_error(FATAL, & - "Mismatch in the total number of fields in CT_redistribute_data_3d.") - endif - - if (.not.(do_in .or. do_out)) return - - fc = 0 - if (do_in .and. do_out) then - do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if ( associated(var_in%bc(n)%field(m)%values) .neqv. & - associated(var_out%bc(n)%field(m)%values) ) & - call mpp_error(FATAL, & - "Mismatch in which fields are associated in CT_redistribute_data_3d.") - - if ( associated(var_in%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, var_in%bc(n)%field(m)%values, & - domain_out, var_out%bc(n)%field(m)%values, & - complete=(do_complete.and.(fc==fc_in)) ) - endif - enddo ; enddo - elseif (do_in) then - do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if ( associated(var_in%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, var_in%bc(n)%field(m)%values, & - domain_out, null_ptr3D, & - complete=(do_complete.and.(fc==fc_in)) ) - endif - enddo ; enddo - elseif (do_out) then - do n = 1, var_out%num_bcs ; do m = 1, var_out%bc(n)%num_fields - if ( associated(var_out%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, null_ptr3D, & - domain_out, var_out%bc(n)%field(m)%values, & - complete=(do_complete.and.(fc==fc_out)) ) - endif - enddo ; enddo - endif - -end subroutine CT_redistribute_data_3d - - -!> This subroutine rescales the fields in the elements of a coupler_2d_bc_type -!! by multiplying by a factor scale. If scale is 0, this is a direct -!! assignment to 0, so that NaNs will not persist. -subroutine CT_rescale_data_2d(var, scale, halo_size, bc_index, field_index, & - exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_2d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being rescaled - real, intent(in) :: scale !< A scaling factor to multiply fields by - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default or - !! the full arrays if scale is 0. - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this copy. - logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose - !! value of pass_through ice matches this - logical :: do_bc - integer :: i, j, m, n, n1, n2, halo - - if (present(bc_index)) then - if (bc_index > var%num_bcs) & - call mpp_error(FATAL, "CT_rescale_data_2d: bc_index is present and exceeds var%num_bcs.") - if (present(field_index)) then ; if (field_index > var%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_rescale_data_2d: field_index is present and exceeds num_fields for" //& - trim(var%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_rescale_data_2d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_rescale_data_2d: Excessive i-direction halo size.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_rescale_data_2d: Excessive j-direction halo size.") - endif - - do n = n1, n2 - - do_bc = .true. - if (do_bc .and. present(exclude_flux_type)) & - do_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (do_bc .and. present(only_flux_type)) & - do_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (do_bc .and. present(pass_through_ice)) & - do_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.do_bc) cycle - - do m = 1, var%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - if (scale == 0.0) then - if (present(halo_size)) then - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j) = 0.0 - enddo ; enddo - else - var%bc(n)%field(m)%values(:,:) = 0.0 - endif - else - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j) = scale * var%bc(n)%field(m)%values(i,j) - enddo ; enddo - endif - endif - enddo - enddo - -end subroutine CT_rescale_data_2d - -!> This subroutine rescales the fields in the elements of a coupler_3d_bc_type -!! by multiplying by a factor scale. If scale is 0, this is a direct -!! assignment to 0, so that NaNs will not persist. -subroutine CT_rescale_data_3d(var, scale, halo_size, bc_index, field_index, & - exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_3d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being rescaled - real, intent(in) :: scale !< A scaling factor to multiply fields by - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default or - !! the full arrays if scale is 0. - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this copy. - logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose - !! value of pass_through ice matches this - logical :: do_bc - integer :: i, j, k, m, n, n1, n2, halo - - if (present(bc_index)) then - if (bc_index > var%num_bcs) & - call mpp_error(FATAL, "CT_rescale_data_2d: bc_index is present and exceeds var%num_bcs.") - if (present(field_index)) then ; if (field_index > var%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_rescale_data_2d: field_index is present and exceeds num_fields for" //& - trim(var%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_rescale_data_2d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_rescale_data_3d: Excessive i-direction halo size.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_rescale_data_3d: Excessive j-direction halo size.") - endif - - do n = n1, n2 - - do_bc = .true. - if (do_bc .and. present(exclude_flux_type)) & - do_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (do_bc .and. present(only_flux_type)) & - do_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (do_bc .and. present(pass_through_ice)) & - do_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.do_bc) cycle - - do m = 1, var%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - if (scale == 0.0) then - if (present(halo_size)) then - do k=var%ks,var%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j,k) = 0.0 - enddo ; enddo ; enddo - else - var%bc(n)%field(m)%values(:,:,:) = 0.0 - endif - else - do k=var%ks,var%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j,k) = scale * var%bc(n)%field(m)%values(i,j,k) - enddo ; enddo ; enddo - endif - endif - enddo - enddo - -end subroutine CT_rescale_data_3d - - -!> This subroutine does a direct increment of the data in all elements of one -!! coupler_2d_bc_type into another. Both must have the same array sizes. -subroutine CT_increment_data_2d_2d(var_in, var, halo_size, bc_index, field_index, & - scale_factor, scale_prev, exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to add to the other type - type(coupler_2d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being incremented - integer, optional, intent(in) :: halo_size !< The extent of the halo to increment; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this increment. - logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose - !! value of pass_through ice matches this - - real :: scale, sc_prev - logical :: increment_bc - integer :: i, j, m, n, n1, n2, halo, i_off, j_off - - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - sc_prev = 1.0 ; if (present(scale_prev)) sc_prev = scale_prev - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_increment_data_2d_2d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_increment_data_2d_2d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_increment_data_2d_2d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_increment_data_2d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_increment_data_2d: There is a j-direction computional domain size mismatch.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d: Excessive j-direction halo size for the output structure.") - - i_off = var_in%isc - var%isc ; j_off = var_in%jsc - var%jsc - endif - - do n = n1, n2 - - increment_bc = .true. - if (increment_bc .and. present(exclude_flux_type)) & - increment_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (increment_bc .and. present(only_flux_type)) & - increment_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (increment_bc .and. present(pass_through_ice)) & - increment_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.increment_bc) cycle - - do m = 1, var_in%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j) = sc_prev * var%bc(n)%field(m)%values(i,j) + & - scale * var_in%bc(n)%field(m)%values(i+i_off,j+j_off) - enddo ; enddo - endif - enddo - enddo - -end subroutine CT_increment_data_2d_2d - - -!> This subroutine does a direct increment of the data in all elements of one -!! coupler_3d_bc_type into another. Both must have the same array sizes. -subroutine CT_increment_data_3d_3d(var_in, var, halo_size, bc_index, field_index, & - scale_factor, scale_prev, exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to add to the other type - type(coupler_3d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being incremented - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this increment. - logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose - !! value of pass_through ice matches this - - real :: scale, sc_prev - logical :: increment_bc - integer :: i, j, k, m, n, n1, n2, halo, i_off, j_off, k_off - - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - sc_prev = 1.0 ; if (present(scale_prev)) sc_prev = scale_prev - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_increment_data_3d_3d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_increment_data_3d_3d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_increment_data_3d_3d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_increment_data_3d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_increment_data_3d: There is a j-direction computional domain size mismatch.") - if ((var_in%ke-var_in%ks) /= (var%ke-var%ks)) & - call mpp_error(FATAL, "CT_increment_data_3d: There is a k-direction computional domain size mismatch.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_3d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_3d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_3d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_3d: Excessive j-direction halo size for the output structure.") - - i_off = var_in%isc - var%isc ; j_off = var_in%jsc - var%jsc ; k_off = var_in%ks - var%ks - endif - - do n = n1, n2 - - increment_bc = .true. - if (increment_bc .and. present(exclude_flux_type)) & - increment_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (increment_bc .and. present(only_flux_type)) & - increment_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (increment_bc .and. present(pass_through_ice)) & - increment_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.increment_bc) cycle - - do m = 1, var_in%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - do k=var%ks,var%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j,k) = sc_prev * var%bc(n)%field(m)%values(i,j,k) + & - scale * var_in%bc(n)%field(m)%values(i+i_off,j+j_off,k+k_off) - enddo ; enddo ; enddo - endif - enddo - enddo - -end subroutine CT_increment_data_3d_3d - -!> This subroutine does increments the data in the elements of a coupler_2d_bc_type -!! with the weighed average of the elements of a coupler_3d_bc_type. Both must have -!! the same horizontal array sizes and the normalized weight array must match the -!! array sizes of the coupler_3d_bc_type. -subroutine CT_increment_data_2d_3d(var_in, weights, var, halo_size, bc_index, field_index, & - scale_factor, scale_prev, exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to add to the other type - real, dimension(:,:,:), intent(in) :: weights !< An array of normalized weights for the 3d-data to - !! increment the 2d-data. There is no renormalization, - !! so if the weights do not sum to 1 in the 3rd dimension - !! there may be adverse consequences! - type(coupler_2d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being incremented - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this increment. - logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose - !! value of pass_through ice matches this - - real :: scale, sc_prev - logical :: increment_bc - integer :: i, j, k, m, n, n1, n2, halo - integer :: io1, jo1, iow, jow, kow ! Offsets to account for different index conventions. - - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - sc_prev = 1.0 ; if (present(scale_prev)) sc_prev = scale_prev - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_increment_data_2d_3d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: There is a j-direction computional domain size mismatch.") - if ((1+var_in%ke-var_in%ks) /= size(weights,3)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: There is a k-direction size mismatch with the weights array.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: Excessive j-direction halo size for the output structure.") - - if ((1+var%iec-var%isc) == size(weights,1)) then - iow = 1 - var%isc - elseif ((1+var%ied-var%isd) == size(weights,1)) then - iow = 1 - var%isd - elseif ((1+var_in%ied-var_in%isd) == size(weights,1)) then - iow = 1 + (var_in%isc - var_in%isd) - var%isc - else - call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the i-size "//& - "of a computational or data domain.") - endif - if ((1+var%jec-var%jsc) == size(weights,2)) then - jow = 1 - var%jsc - elseif ((1+var%jed-var%jsd) == size(weights,2)) then - jow = 1 - var%jsd - elseif ((1+var_in%jed-var_in%jsd) == size(weights,2)) then - jow = 1 + (var_in%jsc - var_in%jsd) - var%jsc - else - call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the j-size "//& - "of a computational or data domain.") - endif - - io1 = var_in%isc - var%isc ; jo1 = var_in%jsc - var%jsc ; kow = 1 - var_in%ks - endif - - do n = n1, n2 - - increment_bc = .true. - if (increment_bc .and. present(exclude_flux_type)) & - increment_bc = .not.(trim(var_in%bc(n)%flux_type) == trim(exclude_flux_type)) - if (increment_bc .and. present(only_flux_type)) & - increment_bc = (trim(var_in%bc(n)%flux_type) == trim(only_flux_type)) - if (increment_bc .and. present(pass_through_ice)) & - increment_bc = (pass_through_ice .eqv. var_in%bc(n)%pass_through_ice) - if (.not.increment_bc) cycle - - do m = 1, var_in%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - do k=var_in%ks,var_in%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j) = sc_prev * var%bc(n)%field(m)%values(i,j) + & - (scale * weights(i+iow,j+jow,k+kow)) * var_in%bc(n)%field(m)%values(i+io1,j+io1,k) - enddo ; enddo ; enddo - endif - enddo - enddo - -end subroutine CT_increment_data_2d_3d - - -!> This subroutine extracts a single 2-d field from a coupler_2d_bc_type into -!! a two-dimensional array. -subroutine CT_extract_data_2d(var_in, bc_index, field_index, array_out, & - scale_factor, halo_size, idim, jdim) - type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to extract - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - real, dimension(1:,1:), intent(out) :: array_out !< The recipient array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_extract_data_2d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, halo, i_off, j_off - - if (bc_index <= 0) then - array_out(:,:) = 0.0 - return - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var_in%num_bcs.") - if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_out,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%iec-var_in%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var_in%isc) - else - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_out,1), ' does not match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var_in%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_out,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%jec-var_in%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var_in%jsc) - else - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_out,2), ' does not match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var_in%jsc-halo) - endif - - do j=var_in%jsc-halo,var_in%jec+halo ; do i=var_in%isc-halo,var_in%iec+halo - array_out(i+i_off,j+j_off) = scale * var_in%bc(bc_index)%field(field_index)%values(i,j) - enddo ; enddo - -end subroutine CT_extract_data_2d - -!> This subroutine extracts a single k-level of a 3-d field from a coupler_3d_bc_type -!! into a two-dimensional array. -subroutine CT_extract_data_3d_2d(var_in, bc_index, field_index, k_in, array_out, & - scale_factor, halo_size, idim, jdim) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to extract - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - integer, intent(in) :: k_in !< The k-index to extract - real, dimension(1:,1:), intent(out) :: array_out !< The recipient array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_extract_data_3d_2d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, k, halo, i_off, j_off - - if (bc_index <= 0) then - array_out(:,:) = 0.0 - return - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var_in%num_bcs.") - if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_out,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%iec-var_in%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var_in%isc) - else - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_out,1), ' does not match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var_in%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_out,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%jec-var_in%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var_in%jsc) - else - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_out,2), ' does not match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var_in%jsc-halo) - endif - - if ((k_in > var_in%ke) .or. (k_in < var_in%ks)) then - write (error_msg, *) trim(error_header), ' The extracted k-index of ', k_in, & - ' is outside of the valid range of ', var_in%ks, ' to ', var_in%ke - call mpp_error(FATAL, trim(error_msg)) - endif - - do j=var_in%jsc-halo,var_in%jec+halo ; do i=var_in%isc-halo,var_in%iec+halo - array_out(i+i_off,j+j_off) = scale * var_in%bc(bc_index)%field(field_index)%values(i,j,k_in) - enddo ; enddo - -end subroutine CT_extract_data_3d_2d - -!> This subroutine extracts a single 3-d field from a coupler_3d_bc_type into -!! a three-dimensional array. -subroutine CT_extract_data_3d(var_in, bc_index, field_index, array_out, & - scale_factor, halo_size, idim, jdim) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to extract - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - real, dimension(1:,1:,1:), intent(out) :: array_out !< The recipient array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_extract_data_3d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, k, halo, i_off, j_off, k_off - - if (bc_index <= 0) then - array_out(:,:,:) = 0.0 - return - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var_in%num_bcs.") - if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_out,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%iec-var_in%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var_in%isc) - else - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_out,1), ' does not match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var_in%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_out,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%jec-var_in%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var_in%jsc) - else - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_out,2), ' does not match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var_in%jsc-halo) - endif - - if (size(array_out,3) /= 1 + var_in%ke - var_in%ks) then - write (error_msg, *) trim(error_header), ' The target array with k-dimension size ', & - size(array_out,3), ' does not match the data of size ', & - (1 + var_in%ke - var_in%ks) - call mpp_error(FATAL, trim(error_msg)) - endif - k_off = 1 - var_in%ks - - do k=var_in%ks,var_in%ke ; do j=var_in%jsc-halo,var_in%jec+halo ; do i=var_in%isc-halo,var_in%iec+halo - array_out(i+i_off,j+j_off,k+k_off) = scale * var_in%bc(bc_index)%field(field_index)%values(i,j,k) - enddo ; enddo ; enddo - -end subroutine CT_extract_data_3d - - -!> This subroutine sets a single 2-d field in a coupler_3d_bc_type from -!! a two-dimensional array. -subroutine CT_set_data_2d(array_in, bc_index, field_index, var, & - scale_factor, halo_size, idim, jdim) - real, dimension(1:,1:), intent(in) :: array_in !< The source array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure with the data to set - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_set_data_2d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, halo, i_off, j_off - - if (bc_index <= 0) return - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var%num_bcs.") - if (field_index > var%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_in,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%iec-var%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var%isc) - else - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_in,1), ' does not match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_in,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%jec-var%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var%jsc) - else - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_in,2), ' does not match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var%jsc-halo) - endif - - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(bc_index)%field(field_index)%values(i,j) = scale * array_in(i+i_off,j+j_off) - enddo ; enddo - -end subroutine CT_set_data_2d - -!> This subroutine sets a one k-level of a single 3-d field in a -!! coupler_3d_bc_type from a two-dimensional array. -subroutine CT_set_data_2d_3d(array_in, bc_index, field_index, k_out, var, & - scale_factor, halo_size, idim, jdim) - real, dimension(1:,1:), intent(in) :: array_in !< The source array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - integer, intent(in) :: k_out !< The k-index to set - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure with the data to be set - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_set_data_3d_2d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, halo, i_off, j_off - - if (bc_index <= 0) return - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var%num_bcs.") - if (field_index > var%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_in,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%iec-var%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var%isc) - else - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_in,1), ' does not match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_in,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%jec-var%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var%jsc) - else - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_in,2), ' does not match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var%jsc-halo) - endif - - if ((k_out > var%ke) .or. (k_out < var%ks)) then - write (error_msg, *) trim(error_header), ' The seted k-index of ', k_out, & - ' is outside of the valid range of ', var%ks, ' to ', var%ke - call mpp_error(FATAL, trim(error_msg)) - endif - - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(bc_index)%field(field_index)%values(i,j,k_out) = scale * array_in(i+i_off,j+j_off) - enddo ; enddo - -end subroutine CT_set_data_2d_3d - -!> This subroutine sets a single 3-d field in a coupler_3d_bc_type from -!! a three-dimensional array. -subroutine CT_set_data_3d(array_in, bc_index, field_index, var, & - scale_factor, halo_size, idim, jdim) - real, dimension(1:,1:,1:), intent(in) :: array_in !< The source array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure with the data to be set - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_set_data_3d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, k, halo, i_off, j_off, k_off - - if (bc_index <= 0) return - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var%num_bcs.") - if (field_index > var%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_in,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%iec-var%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var%isc) - else - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_in,1), ' does not match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_in,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%jec-var%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var%jsc) - else - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_in,2), ' does not match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var%jsc-halo) - endif - - if (size(array_in,3) /= 1 + var%ke - var%ks) then - write (error_msg, *) trim(error_header), ' The target array with k-dimension size ', & - size(array_in,3), ' does not match the data of size ', & - (1 + var%ke - var%ks) - call mpp_error(FATAL, trim(error_msg)) - endif - k_off = 1 - var%ks - - do k=var%ks,var%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(bc_index)%field(field_index)%values(i,j,k) = scale * array_in(i+i_off,j+j_off,k+k_off) - enddo ; enddo ; enddo - -end subroutine CT_set_data_3d - - -!> This routine registers the diagnostics of a coupler_2d_bc_type. -subroutine CT_set_diags_2d(var, diag_name, axes, time) - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure for which to register diagnostics - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - - integer :: m, n - - if (diag_name == ' ') return - - if (size(axes) < 2) then - call mpp_error(FATAL, '==>Error from coupler_types_mod' //& - '(coupler_types_set_diags_3d): axes has less than 2 elements') - endif - - do n = 1, var%num_bcs - do m = 1, var%bc(n)%num_fields - var%bc(n)%field(m)%id_diag = register_diag_field(diag_name, & - var%bc(n)%field(m)%name, axes(1:2), Time, & - var%bc(n)%field(m)%long_name, var%bc(n)%field(m)%units ) - enddo - enddo - -end subroutine CT_set_diags_2d - -!> This routine registers the diagnostics of a coupler_3d_bc_type. -subroutine CT_set_diags_3d(var, diag_name, axes, time) - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure for which to register diagnostics - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - - integer :: m, n - - if (diag_name == ' ') return - - if (size(axes) < 3) then - call mpp_error(FATAL, '==>Error from coupler_types_mod' //& - '(coupler_types_set_diags_3d): axes has less than 3 elements') - endif - - do n = 1, var%num_bcs - do m = 1, var%bc(n)%num_fields - var%bc(n)%field(m)%id_diag = register_diag_field(diag_name, & - var%bc(n)%field(m)%name, axes(1:3), Time, & - var%bc(n)%field(m)%long_name, var%bc(n)%field(m)%units ) - enddo - enddo - -end subroutine CT_set_diags_3d - - -!> This subroutine writes out all diagnostics of elements of a coupler_2d_bc_type -subroutine CT_send_data_2d(var, Time) - type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure with the diagnostics to write - type(time_type), intent(in) :: time !< The current model time - - integer :: m, n - logical :: used - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - used = send_data(var%bc(n)%field(m)%id_diag, var%bc(n)%field(m)%values, Time) - enddo ; enddo - -end subroutine CT_send_data_2d - -!> This subroutine writes out all diagnostics of elements of a coupler_2d_bc_type -subroutine CT_send_data_3d(var, Time) - type(coupler_3d_bc_type), intent(in) :: var !< BC_type structure with the diagnostics to write - type(time_type), intent(in) :: time !< The current model time - - integer :: m, n - logical :: used - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - used = send_data(var%bc(n)%field(m)%id_diag, var%bc(n)%field(m)%values, Time) - enddo ; enddo - -end subroutine CT_send_data_3d - - -!> This subroutine registers the fields in a coupler_2d_bc_type to be saved -!! in restart files specified in the field table. -subroutine CT_register_restarts_2d(var, bc_rest_files, num_rest_files, mpp_domain, ocean_restart) - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to be registered for restarts - type(restart_file_type), dimension(:), pointer :: bc_rest_files !< Structures describing the restart files - integer, intent(out) :: num_rest_files !< The number of restart files to use - type(domain2D), intent(in) :: mpp_domain !< The FMS domain to use for this registration call - logical, optional, intent(in) :: ocean_restart !< If true, use the ocean restart file name. - - character(len=80), dimension(max(1,var%num_bcs)) :: rest_file_names - character(len=80) :: file_nm - logical :: ocn_rest - integer :: f, n, m - - ocn_rest = .true. ; if (present(ocean_restart)) ocn_rest = ocean_restart - - ! Determine the number and names of the restart files - num_rest_files = 0 - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - file_nm = trim(var%bc(n)%ice_restart_file) - if (ocn_rest) file_nm = trim(var%bc(n)%ocean_restart_file) - do f = 1, num_rest_files - if (trim(file_nm) == trim(rest_file_names(f))) exit - enddo - if (f>num_rest_files) then - num_rest_files = num_rest_files + 1 - rest_file_names(f) = trim(file_nm) - endif - enddo - - if (num_rest_files == 0) return - - ! Register the fields with the restart files - allocate(bc_rest_files(num_rest_files)) - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - - file_nm = trim(var%bc(n)%ice_restart_file) - if (ocn_rest) file_nm = trim(var%bc(n)%ocean_restart_file) - do f = 1, num_rest_files - if (trim(file_nm) == trim(rest_file_names(f))) exit - enddo - - var%bc(n)%rest_type => bc_rest_files(f) - do m = 1, var%bc(n)%num_fields - var%bc(n)%field(m)%id_rest = register_restart_field(bc_rest_files(f), & - rest_file_names(f), var%bc(n)%field(m)%name, var%bc(n)%field(m)%values, & - mpp_domain, mandatory=.not.var%bc(n)%field(m)%may_init ) - enddo - enddo - -end subroutine CT_register_restarts_2d - -!> This subroutine registers the fields in a coupler_2d_bc_type to be saved -!! in the specified restart file. -subroutine CT_register_restarts_to_file_2d(var, file_name, rest_file, mpp_domain, & - varname_prefix) - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to be registered for restarts - character(len=*), intent(in) :: file_name !< The name of the restart file - type(restart_file_type), pointer :: rest_file !< A (possibly associated) structure describing the restart file - type(domain2D), intent(in) :: mpp_domain !< The FMS domain to use for this registration call - character(len=*), optional, intent(in) :: varname_prefix !< A prefix for the variable name - !! in the restart file, intended to allow - !! multiple BC_type variables to use the - !! same restart files. - - character(len=128) :: var_name - integer :: n, m - - ! Register the fields with the restart file - if (.not.associated(rest_file)) allocate(rest_file) - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - - var%bc(n)%rest_type => rest_file - do m = 1, var%bc(n)%num_fields - var_name = trim(var%bc(n)%field(m)%name) - if (present(varname_prefix)) var_name = trim(varname_prefix)//trim(var_name) - var%bc(n)%field(m)%id_rest = register_restart_field(rest_file, & - file_name, var_name, var%bc(n)%field(m)%values, & - mpp_domain, mandatory=.not.var%bc(n)%field(m)%may_init ) - enddo - enddo - -end subroutine CT_register_restarts_to_file_2d - -!> This subroutine registers the fields in a coupler_3d_bc_type to be saved -!! in restart files specified in the field table. -subroutine CT_register_restarts_3d(var, bc_rest_files, num_rest_files, mpp_domain, ocean_restart) - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to be registered for restarts - type(restart_file_type), dimension(:), pointer :: bc_rest_files !< Structures describing the restart files - integer, intent(out) :: num_rest_files !< The number of restart files to use - type(domain2D), intent(in) :: mpp_domain !< The FMS domain to use for this registration call - logical, optional, intent(in) :: ocean_restart !< If true, use the ocean restart file name. - - character(len=80), dimension(max(1,var%num_bcs)) :: rest_file_names - character(len=80) :: file_nm - logical :: ocn_rest - integer :: f, n, m, id_restart - - ocn_rest = .true. ; if (present(ocean_restart)) ocn_rest = ocean_restart - - ! Determine the number and names of the restart files - num_rest_files = 0 - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - file_nm = trim(var%bc(n)%ice_restart_file) - if (ocn_rest) file_nm = trim(var%bc(n)%ocean_restart_file) - do f = 1, num_rest_files - if (trim(file_nm) == trim(rest_file_names(f))) exit - enddo - if (f>num_rest_files) then - num_rest_files = num_rest_files + 1 - rest_file_names(f) = trim(file_nm) - endif - enddo - - if (num_rest_files == 0) return - - ! Register the fields with the restart files - allocate(bc_rest_files(num_rest_files)) - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - file_nm = trim(var%bc(n)%ice_restart_file) - if (ocn_rest) file_nm = trim(var%bc(n)%ocean_restart_file) - do f = 1, num_rest_files - if (trim(file_nm) == trim(rest_file_names(f))) exit - enddo - - var%bc(n)%rest_type => bc_rest_files(f) - do m = 1, var%bc(n)%num_fields - var%bc(n)%field(m)%id_rest = register_restart_field(bc_rest_files(f), & - rest_file_names(f), var%bc(n)%field(m)%name, var%bc(n)%field(m)%values, & - mpp_domain, mandatory=.not.var%bc(n)%field(m)%may_init ) - enddo - enddo - -end subroutine CT_register_restarts_3d - -!> This subroutine registers the fields in a coupler_3d_bc_type to be saved -!! in the specified restart file. -subroutine CT_register_restarts_to_file_3d(var, file_name, rest_file, mpp_domain, & - varname_prefix) - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to be registered for restarts - character(len=*), intent(in) :: file_name !< The name of the restart file - type(restart_file_type), pointer :: rest_file !< A (possibly associated) structure describing the restart file - type(domain2D), intent(in) :: mpp_domain !< The FMS domain to use for this registration call - - character(len=*), optional, intent(in) :: varname_prefix !< A prefix for the variable name - !! in the restart file, intended to allow - !! multiple BC_type variables to use the - !! same restart files. - - character(len=128) :: var_name - integer :: n, m - - ! Register the fields with the restart file - if (.not.associated(rest_file)) allocate(rest_file) - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - - var%bc(n)%rest_type => rest_file - do m = 1, var%bc(n)%num_fields - var_name = trim(var%bc(n)%field(m)%name) - if (present(varname_prefix)) var_name = trim(varname_prefix)//trim(var_name) - var%bc(n)%field(m)%id_rest = register_restart_field(rest_file, & - file_name, var_name, var%bc(n)%field(m)%values, & - mpp_domain, mandatory=.not.var%bc(n)%field(m)%may_init ) - enddo - enddo - -end subroutine CT_register_restarts_to_file_3d - - -!> This subroutine reads in the fields in a coupler_2d_bc_type that have -!! been saved in restart files. -subroutine CT_restore_state_2d(var, directory, all_or_nothing, & - all_required, test_by_field) - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to restore from restart files - character(len=*), optional, intent(in) :: directory !< A directory where the restart files should - !! be found. The default for FMS is 'INPUT'. - logical, optional, intent(in) :: all_or_nothing !< If true and there are non-mandatory - !! restart fields, it is still an error if some - !! fields are read successfully but others are not. - logical, optional, intent(in) :: all_required !< If true, all fields must be successfully - !! read from the restart file, even if they were - !! registered as not mandatory. - logical, optional, intent(in) :: test_by_field !< If true, all or none of the variables - !! in a single field must be read successfully. - - integer :: n, m, num_fld - character(len=80) :: unset_varname - logical :: any_set, all_set, all_var_set, any_var_set, var_set - - any_set = .false. ; all_set = .true. ; num_fld = 0 ; unset_varname = "" - - do n = 1, var%num_bcs - any_var_set = .false. ; all_var_set = .true. - do m = 1, var%bc(n)%num_fields - var_set = .false. - if (var%bc(n)%field(m)%id_rest > 0) then - var_set = query_initialized(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest) - if (.not.var_set) then - call restore_state(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest, & - directory=directory, nonfatal_missing_files=.true.) - var_set = query_initialized(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest) - endif - endif - - if (.not.var_set) unset_varname = trim(var%bc(n)%field(m)%name) - if (var_set) any_set = .true. - if (all_set) all_set = var_set - if (var_set) any_var_set = .true. - if (all_var_set) all_var_set = var_set - enddo - - num_fld = num_fld + var%bc(n)%num_fields - if ((var%bc(n)%num_fields > 0) .and. present(test_by_field)) then - if (test_by_field .and. (all_var_set .neqv. any_var_set)) call mpp_error(FATAL, & - "CT_restore_state_2d: test_by_field is true, and "//& - trim(unset_varname)//" was not read but some other fields in "//& - trim(trim(var%bc(n)%name))//" were.") - endif - enddo - - if ((num_fld > 0) .and. present(all_or_nothing)) then - if (all_or_nothing .and. (all_set .neqv. any_set)) call mpp_error(FATAL, & - "CT_restore_state_2d: all_or_nothing is true, and "//& - trim(unset_varname)//" was not read but some other fields were.") - endif - - if (present(all_required)) then ; if (all_required .and. .not.all_set) then - call mpp_error(FATAL, "CT_restore_state_2d: all_required is true, but "//& - trim(unset_varname)//" was not read from its restart file.") - endif ; endif - -end subroutine CT_restore_state_2d - -!> This subroutine reads in the fields in a coupler_3d_bc_type that have -!! been saved in restart files. -subroutine CT_restore_state_3d(var, directory, all_or_nothing, & - all_required, test_by_field) - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to restore from restart files - character(len=*), optional, intent(in) :: directory !< A directory where the restart files should - !! be found. The default for FMS is 'INPUT'. - logical, optional, intent(in) :: all_or_nothing !< If true and there are non-mandatory - !! restart fields, it is still an error if some - !! fields are read successfully but others are not. - logical, optional, intent(in) :: all_required !< If true, all fields must be successfully - !! read from the restart file, even if they were - !! registered as not mandatory. - logical, optional, intent(in) :: test_by_field !< If true, all or none of the variables - !! in a single field must be read successfully. - - integer :: n, m, num_fld - character(len=80) :: unset_varname - logical :: any_set, all_set, all_var_set, any_var_set, var_set - - any_set = .false. ; all_set = .true. ; num_fld = 0 ; unset_varname = "" - - do n = 1, var%num_bcs - any_var_set = .false. ; all_var_set = .true. - do m = 1, var%bc(n)%num_fields - var_set = .false. - if (var%bc(n)%field(m)%id_rest > 0) then - var_set = query_initialized(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest) - if (.not.var_set) then - call restore_state(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest, & - directory=directory, nonfatal_missing_files=.true.) - var_set = query_initialized(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest) - endif - endif - - if (.not.var_set) unset_varname = trim(var%bc(n)%field(m)%name) - - if (var_set) any_set = .true. - if (all_set) all_set = var_set - if (var_set) any_var_set = .true. - if (all_var_set) all_var_set = var_set - enddo - - num_fld = num_fld + var%bc(n)%num_fields - if ((var%bc(n)%num_fields > 0) .and. present(test_by_field)) then - if (test_by_field .and. (all_var_set .neqv. any_var_set)) call mpp_error(FATAL, & - "CT_restore_state_3d: test_by_field is true, and "//& - trim(unset_varname)//" was not read but some other fields in "//& - trim(trim(var%bc(n)%name))//" were.") - endif - enddo - - if ((num_fld > 0) .and. present(all_or_nothing)) then - if (all_or_nothing .and. (all_set .neqv. any_set)) call mpp_error(FATAL, & - "CT_restore_state_3d: all_or_nothing is true, and "//& - trim(unset_varname)//" was not read but some other fields were.") - endif - - if (present(all_required)) then ; if (all_required .and. .not.all_set) then - call mpp_error(FATAL, "CT_restore_state_3d: all_required is true, but "//& - trim(unset_varname)//" was not read from its restart file.") - endif ; endif - -end subroutine CT_restore_state_3d - - -!> This subroutine potentially overrides the values in a coupler_2d_bc_type -subroutine CT_data_override_2d(gridname, var, Time) - character(len=3), intent(in) :: gridname !< 3-character long model grid ID - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to override - type(time_type), intent(in) :: time !< The current model time - - integer :: m, n - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - call data_override(gridname, var%bc(n)%field(m)%name, var%bc(n)%field(m)%values, Time) - enddo ; enddo - -end subroutine CT_data_override_2d - -!> This subroutine potentially overrides the values in a coupler_3d_bc_type -subroutine CT_data_override_3d(gridname, var, Time) - character(len=3), intent(in) :: gridname !< 3-character long model grid ID - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to override - type(time_type), intent(in) :: time !< The current model time - - integer :: m, n - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - call data_override(gridname, var%bc(n)%field(m)%name, var%bc(n)%field(m)%values, Time) - enddo ; enddo - -end subroutine CT_data_override_3d - - -!> This subroutine writes out checksums for the elements of a coupler_2d_bc_type -subroutine CT_write_chksums_2d(var, outunit, name_lead) - type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure for which to register diagnostics - integer, intent(in) :: outunit !< The index of a open output file - character(len=*), optional, intent(in) :: name_lead !< An optional prefix for the variable names - - character(len=120) :: var_name - integer :: m, n - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - if (present(name_lead)) then - var_name = trim(name_lead)//trim(var%bc(n)%field(m)%name) - else - var_name = trim(var%bc(n)%field(m)%name) - endif - write(outunit, '(" CHECKSUM:: ",A40," = ",Z20)') trim(var_name), & - mpp_chksum(var%bc(n)%field(m)%values(var%isc:var%iec,var%jsc:var%jec) ) - enddo ; enddo - -end subroutine CT_write_chksums_2d - -!> This subroutine writes out checksums for the elements of a coupler_3d_bc_type -subroutine CT_write_chksums_3d(var, outunit, name_lead) - type(coupler_3d_bc_type), intent(in) :: var !< BC_type structure for which to register diagnostics - integer, intent(in) :: outunit !< The index of a open output file - character(len=*), optional, intent(in) :: name_lead !< An optional prefix for the variable names - - character(len=120) :: var_name - integer :: m, n - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - if (present(name_lead)) then - var_name = trim(name_lead)//trim(var%bc(n)%field(m)%name) - else - var_name = trim(var%bc(n)%field(m)%name) - endif - write(outunit, '(" CHECKSUM:: ",A40," = ",Z20)') var_name, & - mpp_chksum(var%bc(n)%field(m)%values(var%isc:var%iec,var%jsc:var%jec,:) ) - enddo ; enddo - -end subroutine CT_write_chksums_3d - - -!> This function indicates whether a coupler_1d_bc_type has been initialized. -function CT_initialized_1d(var) - type(coupler_1d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed - logical :: CT_initialized_1d !< The return value, indicating whether this type has been initialized - - CT_initialized_1d = var%set -end function CT_initialized_1d - -!> This function indicates whether a coupler_2d_bc_type has been initialized. -function CT_initialized_2d(var) - type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed - logical :: CT_initialized_2d !< The return value, indicating whether this type has been initialized - - CT_initialized_2d = var%set -end function CT_initialized_2d - -!> This function indicates whether a coupler_3d_bc_type has been initialized. -function CT_initialized_3d(var) - type(coupler_3d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed - logical :: CT_initialized_3d !< The return value, indicating whether this type has been initialized - - CT_initialized_3d = var%set -end function CT_initialized_3d - - -!> This subroutine deallocates all data associated with a coupler_1d_bc_type -subroutine CT_destructor_1d(var) - type(coupler_1d_bc_type), intent(inout) :: var !< BC_type structure to be deconstructed - - integer :: m, n - - if (var%num_bcs > 0) then - do n = 1, var%num_bcs - do m = 1, var%bc(n)%num_fields - deallocate ( var%bc(n)%field(m)%values ) - enddo - deallocate ( var%bc(n)%field ) - enddo - deallocate ( var%bc ) - endif - - var%num_bcs = 0 ; var%set = .false. - -end subroutine CT_destructor_1d - -!> This subroutine deallocates all data associated with a coupler_2d_bc_type -subroutine CT_destructor_2d(var) - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to be deconstructed - - integer :: m, n - - if (var%num_bcs > 0) then - do n = 1, var%num_bcs - do m = 1, var%bc(n)%num_fields - deallocate ( var%bc(n)%field(m)%values ) - enddo - deallocate ( var%bc(n)%field ) - enddo - deallocate ( var%bc ) - endif - - var%num_bcs = 0 ; var%set = .false. - -end subroutine CT_destructor_2d - - -!> This subroutine deallocates all data associated with a coupler_3d_bc_type -subroutine CT_destructor_3d(var) - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to be deconstructed - - integer :: m, n - - if (var%num_bcs > 0) then - do n = 1, var%num_bcs - do m = 1, var%bc(n)%num_fields - deallocate ( var%bc(n)%field(m)%values ) - enddo - deallocate ( var%bc(n)%field ) - enddo - deallocate ( var%bc ) - endif - - var%num_bcs = 0 ; var%set = .false. - -end subroutine CT_destructor_3d - -end module coupler_types_mod diff --git a/config_src/ice_solo_driver/coupler_util.F90 b/config_src/ice_solo_driver/coupler_util.F90 deleted file mode 100644 index dde67c2976..0000000000 --- a/config_src/ice_solo_driver/coupler_util.F90 +++ /dev/null @@ -1,144 +0,0 @@ -module coupler_util - -! This file is part of MOM6. See LICENSE.md for the license. - -! This code provides a couple of interfaces to allow more transparent and -! robust extraction of the various fields in the coupler types. -use MOM_error_handler, only : MOM_error, FATAL, WARNING -use coupler_types_mod, only : coupler_2d_bc_type, ind_flux, ind_alpha -use coupler_types_mod, only : ind_csurf - -implicit none ; private - -public :: extract_coupler_values, set_coupler_values -public :: ind_flux, ind_alpha, ind_csurf - -contains - -subroutine extract_coupler_values(BC_struc, BC_index, BC_element, array_out, & - is, ie, js, je, conversion) - type(coupler_2d_bc_type), intent(in) :: BC_struc - integer, intent(in) :: BC_index, BC_element - real, dimension(:,:), intent(out) :: array_out - integer, optional, intent(in) :: is, ie, js, je - real, optional, intent(in) :: conversion -! Arguments: BC_struc - The type from which the data is being extracted. -! (in) BC_index - The boundary condition number being extracted. -! (in) BC_element - The element of the boundary condition being extracted. -! This could be ind_csurf, ind_alpha, ind_flux or ind_deposition. -! (out) array_out - The array being filled with the input values. -! (in, opt) is, ie, js, je - The i- and j- limits of array_out to be filled. -! These must match the size of the corresponding value array or an -! error message is issued. -! (in, opt) conversion - A number that every element is multiplied by, to -! permit sign convention or unit conversion. - - real, pointer, dimension(:,:) :: Array_in - real :: conv - integer :: i, j, is0, ie0, js0, je0, i_offset, j_offset - - if ((BC_element /= ind_flux) .and. (BC_element /= ind_alpha) .and. & - (BC_element /= ind_csurf)) then - call MOM_error(FATAL,"extract_coupler_values: Unrecognized BC_element.") - endif - - ! These error messages should be made more explicit. -! if (.not.associated(BC_struc%bc(BC_index))) & - if (.not.associated(BC_struc%bc)) & - call MOM_error(FATAL,"extract_coupler_values: " // & - "The requested boundary condition is not associated.") -! if (.not.associated(BC_struc%bc(BC_index)%field(BC_element))) & - if (.not.associated(BC_struc%bc(BC_index)%field)) & - call MOM_error(FATAL,"extract_coupler_values: " // & - "The requested boundary condition element is not associated.") - if (.not.associated(BC_struc%bc(BC_index)%field(BC_element)%values)) & - call MOM_error(FATAL,"extract_coupler_values: " // & - "The requested boundary condition value array is not associated.") - - Array_in => BC_struc%bc(BC_index)%field(BC_element)%values - - if (present(is)) then ; is0 = is ; else ; is0 = LBOUND(array_out,1) ; endif - if (present(ie)) then ; ie0 = ie ; else ; ie0 = UBOUND(array_out,1) ; endif - if (present(js)) then ; js0 = js ; else ; js0 = LBOUND(array_out,2) ; endif - if (present(je)) then ; je0 = je ; else ; je0 = UBOUND(array_out,2) ; endif - - conv = 1.0 ; if (present(conversion)) conv = conversion - - if (size(Array_in,1) /= ie0 - is0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and output array or computational domain.") - if (size(Array_in,2) /= je0 - js0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and output array or computational domain.") - i_offset = lbound(Array_in,1) - is0 - j_offset = lbound(Array_in,2) - js0 - do j=js0,je0 ; do i=is0,ie0 - array_out(i,j) = conv * Array_in(i+i_offset,j+j_offset) - enddo ; enddo - -end subroutine extract_coupler_values - -subroutine set_coupler_values(array_in, BC_struc, BC_index, BC_element, & - is, ie, js, je, conversion) - real, dimension(:,:), intent(in) :: array_in - type(coupler_2d_bc_type), intent(inout) :: BC_struc - integer, intent(in) :: BC_index, BC_element - integer, optional, intent(in) :: is, ie, js, je - real, optional, intent(in) :: conversion -! Arguments: array_in - The array containing the values to load into the BC. -! (out) BC_struc - The type into which the data is being loaded. -! (in) BC_index - The boundary condition number being extracted. -! (in) BC_element - The element of the boundary condition being extracted. -! This could be ind_csurf, ind_alpha, ind_flux or ind_deposition. -! (in, opt) is, ie, js, je - The i- and j- limits of array_out to be filled. -! These must match the size of the corresponding value array or an -! error message is issued. -! (in, opt) conversion - A number that every element is multiplied by, to -! permit sign convention or unit conversion. - - real, pointer, dimension(:,:) :: Array_out - real :: conv - integer :: i, j, is0, ie0, js0, je0, i_offset, j_offset - - if ((BC_element /= ind_flux) .and. (BC_element /= ind_alpha) .and. & - (BC_element /= ind_csurf)) then - call MOM_error(FATAL,"extract_coupler_values: Unrecognized BC_element.") - endif - - ! These error messages should be made more explicit. -! if (.not.associated(BC_struc%bc(BC_index))) & - if (.not.associated(BC_struc%bc)) & - call MOM_error(FATAL,"set_coupler_values: " // & - "The requested boundary condition is not associated.") -! if (.not.associated(BC_struc%bc(BC_index)%field(BC_element))) & - if (.not.associated(BC_struc%bc(BC_index)%field)) & - call MOM_error(FATAL,"set_coupler_values: " // & - "The requested boundary condition element is not associated.") - if (.not.associated(BC_struc%bc(BC_index)%field(BC_element)%values)) & - call MOM_error(FATAL,"set_coupler_values: " // & - "The requested boundary condition value array is not associated.") - - Array_out => BC_struc%bc(BC_index)%field(BC_element)%values - - if (present(is)) then ; is0 = is ; else ; is0 = LBOUND(array_in,1) ; endif - if (present(ie)) then ; ie0 = ie ; else ; ie0 = UBOUND(array_in,1) ; endif - if (present(js)) then ; js0 = js ; else ; js0 = LBOUND(array_in,2) ; endif - if (present(je)) then ; je0 = je ; else ; je0 = UBOUND(array_in,2) ; endif - - conv = 1.0 ; if (present(conversion)) conv = conversion - - if (size(Array_out,1) /= ie0 - is0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and input array or computational domain.") - if (size(Array_out,2) /= je0 - js0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and input array or computational domain.") - i_offset = lbound(Array_out,1) - is0 - j_offset = lbound(Array_out,2) - js0 - do j=js0,je0 ; do i=is0,ie0 - Array_out(i+i_offset,j+j_offset) = conv * array_in(i,j) - enddo ; enddo - -end subroutine set_coupler_values - -end module coupler_util diff --git a/config_src/solo_driver/coupler_types.F90 b/config_src/solo_driver/coupler_types.F90 deleted file mode 100644 index 10d22a8eff..0000000000 --- a/config_src/solo_driver/coupler_types.F90 +++ /dev/null @@ -1,3310 +0,0 @@ -!> This module contains the coupler-type declarations and methods for use in -!! ocean-only configurations of MOM6. -!! -!! It is intended that the version of coupler_types_mod that is avialable from -!! FMS will conform to this version with the FMS city release after warsaw. - -module coupler_types_mod - -! This file is part of MOM6. See LICENSE.md for the license. - -use fms_io_mod, only: restart_file_type, register_restart_field -use fms_io_mod, only: query_initialized, restore_state -use time_manager_mod, only: time_type -use diag_manager_mod, only: register_diag_field, send_data -use data_override_mod, only: data_override -use mpp_domains_mod, only: domain2D, mpp_redistribute -use mpp_mod, only: stdout, mpp_error, FATAL, mpp_chksum - -implicit none ; private - -public coupler_type_copy, coupler_type_spawn, coupler_type_set_diags -public coupler_type_write_chksums, coupler_type_send_data, coupler_type_data_override -public coupler_type_register_restarts, coupler_type_restore_state -public coupler_type_increment_data, coupler_type_rescale_data -public coupler_type_copy_data, coupler_type_redistribute_data -public coupler_type_destructor, coupler_type_initialized -public coupler_type_extract_data, coupler_type_set_data - -public coupler_type_copy_1d_2d -public coupler_type_copy_1d_3d - - -! -! 3-d fields -! -!> A type with a 3-d array of values and metadata -type, public :: coupler_3d_values_type - character(len=48) :: name = ' ' !< The diagnostic name for this array - real, pointer, contiguous, dimension(:,:,:) :: values => NULL() !< The pointer to the - !! array of values for this field; this - !! should be changed to allocatable - logical :: mean = .true. !< mean - logical :: override = .false. !< override - integer :: id_diag = 0 !< The diagnostic id for this array - character(len=128) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=128) :: units = ' ' !< The units for this array - integer :: id_rest = 0 !< The id of this array in the restart field - logical :: may_init = .true. !< If true, there is an internal method - !! that can be used to initialize this field - !! if it can not be read from a restart file -end type coupler_3d_values_type - -!> A field with one or more related 3-d variables and collective metadata -type, public :: coupler_3d_field_type - character(len=48) :: name = ' ' !< name - integer :: num_fields = 0 !< num_fields - type(coupler_3d_values_type), pointer, dimension(:) :: field => NULL() !< field - character(len=128) :: flux_type = ' ' !< flux_type - character(len=128) :: implementation = ' ' !< implementation - real, pointer, dimension(:) :: param => NULL() !< param - logical, pointer, dimension(:) :: flag => NULL() !< flag - integer :: atm_tr_index = 0 !< atm_tr_index - character(len=128) :: ice_restart_file = ' ' !< ice_restart_file - character(len=128) :: ocean_restart_file = ' ' !< ocean_restart_file - type(restart_file_type), pointer :: rest_type => NULL() !< A pointer to the restart_file_type - !! that is used for this field. - logical :: use_atm_pressure !< use_atm_pressure - logical :: use_10m_wind_speed !< use_10m_wind_speed - logical :: pass_through_ice !< pass_through_ice - real :: mol_wt = 0.0 !< mol_wt -end type coupler_3d_field_type - -!> A collection of 3-D boundary conditions for exchange between components -type, public :: coupler_3d_bc_type - integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_3d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary - !! condition fields - logical :: set = .false. !< If true, this type has been initialized - !>@{ The i- and j-direction data and computational domain index ranges for this type - integer :: isd, isc, iec, ied ! The i-direction data and computational domain index ranges for this type - integer :: jsd, jsc, jec, jed ! The j-direction data and computational domain index ranges for this type - !!@} - integer :: ks !< The k-direction start index for this type - integer :: ke !< The k-direction end index for this type -end type coupler_3d_bc_type - -! -! 2-d fields -! -!> A type with a 2-d array of values and metadata -type, public :: coupler_2d_values_type - character(len=48) :: name = ' ' !< The diagnostic name for this array - real, pointer, contiguous, dimension(:,:) :: values => NULL() !< The pointer to the - !! array of values for this field; this - !! should be changed to allocatable - logical :: mean = .true. !< mean - logical :: override = .false. !< override - integer :: id_diag = 0 !< The diagnostic id for this array - character(len=128) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=128) :: units = ' ' !< The units for this array - integer :: id_rest = 0 !< The id of this array in the restart field - logical :: may_init = .true. !< If true, there is an internal method - !! that can be used to initialize this field - !! if it can not be read from a restart file -end type coupler_2d_values_type - -!> A field with one or more related 2-d variables and collective metadata -type, public :: coupler_2d_field_type - character(len=48) :: name = ' ' !< name - integer :: num_fields = 0 !< num_fields - type(coupler_2d_values_type), pointer, dimension(:) :: field => NULL() !< field - character(len=128) :: flux_type = ' ' !< flux_type - character(len=128) :: implementation = ' ' !< implementation - real, pointer, dimension(:) :: param => NULL() !< param - logical, pointer, dimension(:) :: flag => NULL() !< flag - integer :: atm_tr_index = 0 !< atm_tr_index - character(len=128) :: ice_restart_file = ' ' !< ice_restart_file - character(len=128) :: ocean_restart_file = ' ' !< ocean_restart_file - type(restart_file_type), pointer :: rest_type => NULL() !< A pointer to the restart_file_type - !! that is used for this field. - logical :: use_atm_pressure !< use_atm_pressure - logical :: use_10m_wind_speed !< use_10m_wind_speed - logical :: pass_through_ice !< pass_through_ice - real :: mol_wt = 0.0 !< mol_wt -end type coupler_2d_field_type - -!> A collection of 2-D boundary conditions for exchange between components -type, public :: coupler_2d_bc_type - integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_2d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary - !! condition fields - logical :: set = .false. !< If true, this type has been initialized - !>@{ The i- and j-direction data and computational domain index ranges for this type - integer :: isd, isc, iec, ied ! The i-direction data and computational domain index ranges for this type - integer :: jsd, jsc, jec, jed ! The j-direction data and computational domain index ranges for this type - !!@} -end type coupler_2d_bc_type - -! -! 1-d fields -! -!> A type with a 1-d array of values and metadata -type, public :: coupler_1d_values_type - character(len=48) :: name = ' ' !< The diagnostic name for this array - real, pointer, dimension(:) :: values => NULL() !< The pointer to the array of values - logical :: mean = .true. !< mean - logical :: override = .false. !< override - integer :: id_diag = 0 !< The diagnostic id for this array - character(len=128) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=128) :: units = ' ' !< The units for this array - logical :: may_init = .true. !< If true, there is an internal method - !! that can be used to initialize this field - !! if it can not be read from a restart file -end type coupler_1d_values_type - -!> A field with one or more related 1-d variables and collective metadata -type, public :: coupler_1d_field_type - character(len=48) :: name = ' ' !< name - integer :: num_fields = 0 !< num_fields - type(coupler_1d_values_type), pointer, dimension(:) :: field => NULL() !< field - character(len=128) :: flux_type = ' ' !< flux_type - character(len=128) :: implementation = ' ' !< implementation - real, pointer, dimension(:) :: param => NULL() !< param - logical, pointer, dimension(:) :: flag => NULL() !< flag - integer :: atm_tr_index = 0 !< atm_tr_index - character(len=128) :: ice_restart_file = ' ' !< ice_restart_file - character(len=128) :: ocean_restart_file = ' ' !< ocean_restart_file - logical :: use_atm_pressure !< use_atm_pressure - logical :: use_10m_wind_speed !< use_10m_wind_speed - logical :: pass_through_ice !< pass_through_ice - real :: mol_wt = 0.0 !< mol_wt -end type coupler_1d_field_type - -!> A collection of 1-D boundary conditions for exchange between components -type, public :: coupler_1d_bc_type - integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_1d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary - !! condition fields - logical :: set = .false. !< If true, this type has been initialized -end type coupler_1d_bc_type - -!---------------------------------------------------------------------- -! The following public parameters can help in selecting the sub-elements of a -! coupler type. There are duplicate values because different boundary -! conditions have different sub-elements. -integer, parameter, public :: ind_pcair = 1 !< The index of the atmospheric concentration -integer, parameter, public :: ind_u10 = 2 !< The index of the 10 m wind speed -integer, parameter, public :: ind_psurf = 3 !< The index of the surface atmospheric pressure -integer, parameter, public :: ind_alpha = 1 !< The index of the solubility array for a tracer -integer, parameter, public :: ind_csurf = 2 !< The index of the ocean surface concentration -integer, parameter, public :: ind_sc_no = 3 !< The index for the Schmidt number for a tracer flux -integer, parameter, public :: ind_flux = 1 !< The index for the tracer flux -integer, parameter, public :: ind_deltap= 2 !< The index for ocean-air gas partial pressure change -integer, parameter, public :: ind_kw = 3 !< The index for the piston velocity -integer, parameter, public :: ind_deposition = 1 !< The index for the atmospheric deposition flux -integer, parameter, public :: ind_runoff = 1 !< The index for a runoff flux - -!---------------------------------------------------------------------- -! Interface definitions for overloaded routines -!---------------------------------------------------------------------- - -!> This is the interface to spawn one coupler_bc_type into another and then -!! register diagnostics associated with the new type. -interface coupler_type_copy - module procedure coupler_type_copy_1d_2d, coupler_type_copy_1d_3d - module procedure coupler_type_copy_2d_2d, coupler_type_copy_2d_3d - module procedure coupler_type_copy_3d_2d, coupler_type_copy_3d_3d -end interface coupler_type_copy - -!> This is the interface to spawn one coupler_bc_type into another. -interface coupler_type_spawn - module procedure CT_spawn_1d_2d, CT_spawn_2d_2d, CT_spawn_3d_2d - module procedure CT_spawn_1d_3d, CT_spawn_2d_3d, CT_spawn_3d_3d -end interface coupler_type_spawn - -!> This is the interface to copy the field data from one coupler_bc_type -!! to another of the same rank, size and decomposition. -interface coupler_type_copy_data - module procedure CT_copy_data_2d, CT_copy_data_3d, CT_copy_data_2d_3d -end interface coupler_type_copy_data - -!> This is the interface to redistribute the field data from one coupler_bc_type -!! to another of the same rank and global size, but a different decomposition. -interface coupler_type_redistribute_data - module procedure CT_redistribute_data_2d, CT_redistribute_data_3d -end interface coupler_type_redistribute_data - -!> This is the interface to rescale the field data in a coupler_bc_type. -interface coupler_type_rescale_data - module procedure CT_rescale_data_2d, CT_rescale_data_3d -end interface coupler_type_rescale_data - -!> This is the interface to increment the field data from one coupler_bc_type -!! with the data from another. Both must have the same horizontal size and -!! decomposition, but a 2d type may be incremented by a 2d or 3d type -interface coupler_type_increment_data - module procedure CT_increment_data_2d_2d, CT_increment_data_3d_3d, CT_increment_data_2d_3d -end interface coupler_type_increment_data - -!> This is the interface to extract a field in a coupler_bc_type into an array. -interface coupler_type_extract_data - module procedure CT_extract_data_2d, CT_extract_data_3d, CT_extract_data_3d_2d -end interface coupler_type_extract_data - -!> This is the interface to set a field in a coupler_bc_type from an array. -interface coupler_type_set_data - module procedure CT_set_data_2d, CT_set_data_3d, CT_set_data_2d_3d -end interface coupler_type_set_data - -!> This is the interface to set diagnostics for the arrays in a coupler_bc_type. -interface coupler_type_set_diags - module procedure CT_set_diags_2d, CT_set_diags_3d -end interface coupler_type_set_diags - -!> This is the interface to write out checksums for the elements of a coupler_bc_type. -interface coupler_type_write_chksums - module procedure CT_write_chksums_2d, CT_write_chksums_3d -end interface coupler_type_write_chksums - -!> This is the interface to write out diagnostics of the arrays in a coupler_bc_type. -interface coupler_type_send_data - module procedure CT_send_data_2d, CT_send_data_3d -end interface coupler_type_send_data - -!> This is the interface to override the values of the arrays in a coupler_bc_type. -interface coupler_type_data_override - module procedure CT_data_override_2d, CT_data_override_3d -end interface coupler_type_data_override - -!> This is the interface to register the fields in a coupler_bc_type to be saved -!! in restart files. -interface coupler_type_register_restarts - module procedure CT_register_restarts_2d, CT_register_restarts_3d - module procedure CT_register_restarts_to_file_2d, CT_register_restarts_to_file_3d -end interface coupler_type_register_restarts - -!> This is the interface to read in the fields in a coupler_bc_type that have -!! been saved in restart files. -interface coupler_type_restore_state - module procedure CT_restore_state_2d, CT_restore_state_3d -end interface coupler_type_restore_state - -!> This function interface indicates whether a coupler_bc_type has been initialized. -interface coupler_type_initialized - module procedure CT_initialized_1d, CT_initialized_2d, CT_initialized_3d -end interface coupler_type_initialized - -!> This is the interface to deallocate any data associated with a coupler_bc_type. -interface coupler_type_destructor - module procedure CT_destructor_1d, CT_destructor_2d, CT_destructor_3d -end interface coupler_type_destructor - -contains - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 1-D to 2-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -subroutine coupler_type_copy_1d_2d(var_in, var_out, is, ie, js, je, & - diag_name, axes, time, suffix) - - type(coupler_1d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_2d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then - !! don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_1d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_1d_2d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_2d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_1d_2d - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 1-D to 3-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, kd, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var_out%bc already associated" -!! \throw FATAL, "var_out%bc([n])%field already associated" -!! \throw FATAL, "var_out%bc([n])%field([m])%values already associated" -!! \throw FATAL, "axes less than 3 elements" -subroutine coupler_type_copy_1d_3d(var_in, var_out, is, ie, js, je, kd, & - diag_name, axes, time, suffix) - - type(coupler_1d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_3d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then - !! don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_1d_3d):' - character(len=400) :: error_msg - integer :: m, n - - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_1d_3d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), (/1, kd/), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_3d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_1d_3d - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 2-D to 2-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -subroutine coupler_type_copy_2d_2d(var_in, var_out, is, ie, js, je, & - diag_name, axes, time, suffix) - - type(coupler_2d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_2d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_2d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_2d_2d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_2d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_2d_2d - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 2-D to 3-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, kd, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var_out%bc already associated" -!! \throw FATAL, "var_out%bc([n])%field already associated" -!! \throw FATAL, "var_out%bc([n])%field([m])%values already associated" -!! \throw FATAL, "axes less than 3 elements" -subroutine coupler_type_copy_2d_3d(var_in, var_out, is, ie, js, je, kd, & - diag_name, axes, time, suffix) - - type(coupler_2d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_3d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_2d_3d):' - character(len=400) :: error_msg - integer :: m, n - - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_2d_3d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), (/1, kd/), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_3d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_2d_3d - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 3-D to 2-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -subroutine coupler_type_copy_3d_2d(var_in, var_out, is, ie, js, je, & - diag_name, axes, time, suffix) - - type(coupler_3d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_2d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_3d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_3d_2d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_2d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_3d_2d - -!####################################################################### -!> \brief Copy fields from one coupler type to another. 3-D to 3-D version for generic coupler_type_copy. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_copy(var_in, var_out, is, ie, js, je, kd, & -!! diag_name, axes, time, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var_out%bc already associated" -!! \throw FATAL, "var_out%bc([n])%field already associated" -!! \throw FATAL, "var_out%bc([n])%field([m])%values already associated" -!! \throw FATAL, "axes less than 3 elements" -subroutine coupler_type_copy_3d_3d(var_in, var_out, is, ie, js, je, kd, & - diag_name, axes, time, suffix) - - type(coupler_3d_bc_type), intent(in) :: var_in !< variable to copy information from - type(coupler_3d_bc_type), intent(inout) :: var_out !< variable to copy information to - integer, intent(in) :: is !< lower bound of first dimension - integer, intent(in) :: ie !< upper bound of first dimension - integer, intent(in) :: js !< lower bound of second dimension - integer, intent(in) :: je !< upper bound of second dimension - integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (coupler_type_copy_3d_3d):' - character(len=400) :: error_msg - integer :: m, n - - - if (var_out%num_bcs > 0) then - ! It is an error if the number of output fields exceeds zero, because it means this - ! type has already been populated. - call mpp_error(FATAL, trim(error_header) // ' Number of output fields exceeds zero') - endif - - if (var_in%num_bcs >= 0) & - call CT_spawn_3d_3d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), (/1, kd/), suffix) - - if ((var_out%num_bcs > 0) .and. (diag_name /= ' ')) & - call CT_set_diags_3d(var_out, diag_name, axes, time) - -end subroutine coupler_type_copy_3d_3d - - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 1-D to 2-D version for generic coupler_type_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var_out, idim, jdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var_out%bc already associated" -!! \throw FATAL, "var_out%bc([n])%field already associated" -!! \throw FATAL, "var_out%bc([n])%field([m])%values already associated" -subroutine CT_spawn_1d_2d(var_in, var, idim, jdim, suffix, as_needed) - - type(coupler_1d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_1d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed) ) - var%bc(n)%field(m)%values(:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_1d_2d - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 1-D to 3-D version for generic CT_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var, idim, jdim, kdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var%bc already associated" -!! \throw FATAL, "var%bc([n])%field already associated" -!! \throw FATAL, "var%bc([n])%field([m])%values already associated" -subroutine CT_spawn_1d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) - - type(coupler_1d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_3d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - integer, dimension(2), intent(in) :: kdim !< The array extents of the third dimension in - !! a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_1d_3d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - ! Store the array extents that are to be used with this bc_type. - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (kdim(1) > kdim(2)) then - write (error_msg, *) trim(error_header), ' Disordered k-dimension index bound list ', kdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - var%ks = kdim(1) ; var%ke = kdim(2) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed,var%ks:var%ke) ) - var%bc(n)%field(m)%values(:,:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_1d_3d - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 2-D to 2-D version for generic CT_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var, idim, jdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var%bc already associated" -!! \throw FATAL, "var%bc([n])%field already associated" -!! \throw FATAL, "var%bc([n])%field([m])%values already associated" -subroutine CT_spawn_2d_2d(var_in, var, idim, jdim, suffix, as_needed) - - type(coupler_2d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_2d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed) ) - var%bc(n)%field(m)%values(:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_2d_2d - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 2-D to 3-D version for generic CT_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var, idim, jdim, kdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var%bc already associated" -!! \throw FATAL, "var%bc([n])%field already associated" -!! \throw FATAL, "var%bc([n])%field([m])%values already associated" -subroutine CT_spawn_2d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) - - type(coupler_2d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_3d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - integer, dimension(2), intent(in) :: kdim !< The array extents of the third dimension in - !! a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_2d_3d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - ! Store the array extents that are to be used with this bc_type. - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (kdim(1) > kdim(2)) then - write (error_msg, *) trim(error_header), ' Disordered k-dimension index bound list ', kdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - var%ks = kdim(1) ; var%ke = kdim(2) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed,var%ks:var%ke) ) - var%bc(n)%field(m)%values(:,:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_2d_3d - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 3-D to 2-D version for generic CT_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var, idim, jdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var%bc already associated" -!! \throw FATAL, "var%bc([n])%field already associated" -!! \throw FATAL, "var%bc([n])%field([m])%values already associated" -subroutine CT_spawn_3d_2d(var_in, var, idim, jdim, suffix, as_needed) - - type(coupler_3d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_3d_2d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed) ) - var%bc(n)%field(m)%values(:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_3d_2d - -!####################################################################### -!> \brief Generate one coupler type using another as a template. 3-D to 3-D version for generic CT_spawn. -!! -!! Template: -!! -!! ~~~~~~~~~~{.f90} -!! call coupler_type_spawn(var_in, var, idim, jdim, kdim, suffix = 'something') -!! ~~~~~~~~~~ -!! -!! \throw FATAL, "Number of output fields is non-zero" -!! \throw FATAL, "var%bc already associated" -!! \throw FATAL, "var%bc([n])%field already associated" -!! \throw FATAL, "var%bc([n])%field([m])%values already associated" -subroutine CT_spawn_3d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) - - type(coupler_3d_bc_type), intent(in) :: var_in !< structure from which to copy information - type(coupler_3d_bc_type), intent(inout) :: var !< structure into which to copy information - integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of - !! the first dimension in a non-decreasing list - integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension in a non-decreasing list - integer, dimension(2), intent(in) :: kdim !< The array extents of the third dimension in - !! a non-decreasing list - character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique - logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) - !! is not set and the parent type (var_in) is set. - - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_spawn_3d_3d):' - character(len=400) :: error_msg - integer :: m, n - - if (present(as_needed)) then ; if (as_needed) then - if ((var%set) .or. (.not.var_in%set)) return - endif ; endif - - if (var%set) & - call mpp_error(FATAL, trim(error_header) // ' The output type has already been initialized.') - if (.not.var_in%set) & - call mpp_error(FATAL, trim(error_header) // ' The parent type has not been initialized.') - - var%num_bcs = var_in%num_bcs ; var%set = .true. - - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (kdim(1) > kdim(2)) then - write (error_msg, *) trim(error_header), ' Disordered k-dimension index bound list ', kdim - call mpp_error(FATAL, trim(error_msg)) - endif - var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4) - var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4) - var%ks = kdim(1) ; var%ke = kdim(2) - - if (var%num_bcs > 0) then - if (associated(var%bc)) then - call mpp_error(FATAL, trim(error_header) // ' var%bc already associated') - endif - allocate ( var%bc(var%num_bcs) ) - do n = 1, var%num_bcs - var%bc(n)%name = var_in%bc(n)%name - var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index - var%bc(n)%flux_type = var_in%bc(n)%flux_type - var%bc(n)%implementation = var_in%bc(n)%implementation - var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file - var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file - var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure - var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed - var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice - var%bc(n)%mol_wt = var_in%bc(n)%mol_wt - var%bc(n)%num_fields = var_in%bc(n)%num_fields - if (associated(var%bc(n)%field)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - allocate ( var%bc(n)%field(var%bc(n)%num_fields) ) - do m = 1, var%bc(n)%num_fields - if (present(suffix)) then - var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) - else - var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name - endif - var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name - var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units - var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init - var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean - if (associated(var%bc(n)%field(m)%values)) then - write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated' - call mpp_error(FATAL, trim(error_msg)) - endif - - ! Note that this may be allocating a zero-sized array, which is legal in Fortran. - allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed,var%ks:var%ke) ) - var%bc(n)%field(m)%values(:,:,:) = 0.0 - enddo - enddo - - endif - -end subroutine CT_spawn_3d_3d - - -!> This subroutine does a direct copy of the data in all elements of one -!! coupler_2d_bc_type into another. Both must have the same array sizes. -subroutine CT_copy_data_2d(var_in, var, halo_size, bc_index, field_index, & - exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy - type(coupler_2d_bc_type), intent(inout) :: var !< The recipient BC_type structure - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this copy. - logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose - !! value of pass_through ice matches this - logical :: copy_bc - integer :: i, j, m, n, n1, n2, halo, i_off, j_off - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_copy_data_2d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_copy_data_2d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_copy_data_2d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_copy_data_2d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_copy_data_2d: There is a j-direction computional domain size mismatch.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d: Excessive j-direction halo size for the output structure.") - - i_off = var_in%isc - var%isc ; j_off = var_in%jsc - var%jsc - endif - - do n = n1, n2 - - copy_bc = .true. - if (copy_bc .and. present(exclude_flux_type)) & - copy_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (copy_bc .and. present(only_flux_type)) & - copy_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (copy_bc .and. present(pass_through_ice)) & - copy_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.copy_bc) cycle - - do m = 1, var%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j) = var_in%bc(n)%field(m)%values(i+i_off,j+j_off) - enddo ; enddo - endif - enddo - enddo - -end subroutine CT_copy_data_2d - -!> This subroutine does a direct copy of the data in all elements of one -!! coupler_3d_bc_type into another. Both types must have the same array sizes. -subroutine CT_copy_data_3d(var_in, var, halo_size, bc_index, field_index, & - exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy - type(coupler_3d_bc_type), intent(inout) :: var !< The recipient BC_type structure - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this copy. - logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose - !! value of pass_through ice matches this - logical :: copy_bc - integer :: i, j, k, m, n, n1, n2, halo, i_off, j_off, k_off - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_copy_data_3d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_copy_data_3d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_copy_data_3d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_copy_data_3d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_copy_data_3d: There is a j-direction computional domain size mismatch.") - if ((var_in%ke-var_in%ks) /= (var%ke-var%ks)) & - call mpp_error(FATAL, "CT_copy_data_3d: There is a k-direction computional domain size mismatch.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_3d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_3d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_3d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_3d: Excessive j-direction halo size for the output structure.") - - i_off = var_in%isc - var%isc ; j_off = var_in%jsc - var%jsc ; k_off = var_in%ks - var%ks - endif - - do n = n1, n2 - - copy_bc = .true. - if (copy_bc .and. present(exclude_flux_type)) & - copy_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (copy_bc .and. present(only_flux_type)) & - copy_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (copy_bc .and. present(pass_through_ice)) & - copy_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.copy_bc) cycle - - do m = 1, var_in%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - do k=var%ks,var%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j,k) = var_in%bc(n)%field(m)%values(i+i_off,j+j_off,k+k_off) - enddo ; enddo ; enddo - endif - enddo - enddo - -end subroutine CT_copy_data_3d - -!> This subroutine does a direct copy of the data in all elements of a -!! coupler_2d_bc_type into a coupler_3d_bc_type. Both types must have the same -!! array sizes for their first two dimensions, while the extent of the 3rd dimension -!! that is being filled may be specified via optional arguments. -subroutine CT_copy_data_2d_3d(var_in, var, halo_size, bc_index, field_index, & - exclude_flux_type, only_flux_type, pass_through_ice, & - ind3_start, ind3_end) - type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy - type(coupler_3d_bc_type), intent(inout) :: var !< The recipient BC_type structure - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this copy. - logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose - !! value of pass_through ice matches this - integer, optional, intent(in) :: ind3_start !< The starting value of the 3rd - !! index of the 3d type to fill in. - integer, optional, intent(in) :: ind3_end !< The ending value of the 3rd - !! index of the 3d type to fill in. - logical :: copy_bc - integer :: i, j, k, m, n, n1, n2, halo, i_off, j_off, ks, ke - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_copy_data_2d_3d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: There is a j-direction computional domain size mismatch.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_copy_data_2d_3d: Excessive j-direction halo size for the output structure.") - endif - - i_off = var_in%isc - var%isc ; j_off = var_in%jsc - var%jsc - do n = n1, n2 - - copy_bc = .true. - if (copy_bc .and. present(exclude_flux_type)) & - copy_bc = .not.(trim(var_in%bc(n)%flux_type) == trim(exclude_flux_type)) - if (copy_bc .and. present(only_flux_type)) & - copy_bc = (trim(var_in%bc(n)%flux_type) == trim(only_flux_type)) - if (copy_bc .and. present(pass_through_ice)) & - copy_bc = (pass_through_ice .eqv. var_in%bc(n)%pass_through_ice) - if (.not.copy_bc) cycle - - do m = 1, var_in%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - ks = var%ks ; if (present(ind3_start)) ks = max(ks, ind3_start) - ke = var%ke ; if (present(ind3_end)) ke = max(ke, ind3_end) - do k=ks,ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j,k) = var_in%bc(n)%field(m)%values(i+i_off,j+j_off) - enddo ; enddo ; enddo - endif - enddo - enddo - -end subroutine CT_copy_data_2d_3d - - -!> This subroutine redistributes the data in all elements of one coupler_2d_bc_type -!! into another, which may be on different processors with a different decomposition. -subroutine CT_redistribute_data_2d(var_in, domain_in, var_out, domain_out, complete) - type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy (intent in) - type(domain2D), intent(in) :: domain_in !< The FMS domain for the input structure - type(coupler_2d_bc_type), intent(inout) :: var_out !< The recipient BC_type structure (data intent out) - type(domain2D), intent(in) :: domain_out !< The FMS domain for the output structure - logical, optional, intent(in) :: complete !< If true, complete the updates - - real, pointer, dimension(:,:) :: null_ptr2D => NULL() - logical :: do_in, do_out, do_complete - integer :: m, n, fc, fc_in, fc_out - - do_complete = .true. ; if (present(complete)) do_complete = complete - - ! Figure out whether this PE has valid input or output fields or both. - do_in = var_in%set - do_out = var_out%set - - fc_in = 0 ; fc_out = 0 - if (do_in) then ; do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if (associated(var_in%bc(n)%field(m)%values)) fc_in = fc_in + 1 - enddo ; enddo ; endif - if (fc_in == 0) do_in = .false. - if (do_out) then ; do n = 1, var_out%num_bcs ; do m = 1, var_out%bc(n)%num_fields - if (associated(var_out%bc(n)%field(m)%values)) fc_out = fc_out + 1 - enddo ; enddo ; endif - if (fc_out == 0) do_out = .false. - - if (do_in .and. do_out) then - if (var_in%num_bcs /= var_out%num_bcs) call mpp_error(FATAL, & - "Mismatch in num_bcs in CT_copy_data_2d.") - if (fc_in /= fc_out) call mpp_error(FATAL, & - "Mismatch in the total number of fields in CT_redistribute_data_2d.") - endif - - if (.not.(do_in .or. do_out)) return - - fc = 0 - if (do_in .and. do_out) then - do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if ( associated(var_in%bc(n)%field(m)%values) .neqv. & - associated(var_out%bc(n)%field(m)%values) ) & - call mpp_error(FATAL, & - "Mismatch in which fields are associated in CT_redistribute_data_2d.") - - if ( associated(var_in%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, var_in%bc(n)%field(m)%values, & - domain_out, var_out%bc(n)%field(m)%values, & - complete=(do_complete.and.(fc==fc_in)) ) - endif - enddo ; enddo - elseif (do_in) then - do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if ( associated(var_in%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, var_in%bc(n)%field(m)%values, & - domain_out, null_ptr2D, & - complete=(do_complete.and.(fc==fc_in)) ) - endif - enddo ; enddo - elseif (do_out) then - do n = 1, var_out%num_bcs ; do m = 1, var_out%bc(n)%num_fields - if ( associated(var_out%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, null_ptr2D, & - domain_out, var_out%bc(n)%field(m)%values, & - complete=(do_complete.and.(fc==fc_out)) ) - endif - enddo ; enddo - endif - -end subroutine CT_redistribute_data_2d - -!> This subroutine redistributes the data in all elements of one coupler_2d_bc_type -!! into another, which may be on different processors with a different decomposition. -subroutine CT_redistribute_data_3d(var_in, domain_in, var_out, domain_out, complete) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy (intent in) - type(domain2D), intent(in) :: domain_in !< The FMS domain for the input structure - type(coupler_3d_bc_type), intent(inout) :: var_out !< The recipient BC_type structure (data intent out) - type(domain2D), intent(in) :: domain_out !< The FMS domain for the output structure - logical, optional, intent(in) :: complete !< If true, complete the updates - - real, pointer, dimension(:,:,:) :: null_ptr3D => NULL() - logical :: do_in, do_out, do_complete - integer :: m, n, fc, fc_in, fc_out - - do_complete = .true. ; if (present(complete)) do_complete = complete - - ! Figure out whether this PE has valid input or output fields or both. - do_in = var_in%set - do_out = var_out%set - - fc_in = 0 ; fc_out = 0 - if (do_in) then ; do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if (associated(var_in%bc(n)%field(m)%values)) fc_in = fc_in + 1 - enddo ; enddo ; endif - if (fc_in == 0) do_in = .false. - if (do_out) then ; do n = 1, var_out%num_bcs ; do m = 1, var_out%bc(n)%num_fields - if (associated(var_out%bc(n)%field(m)%values)) fc_out = fc_out + 1 - enddo ; enddo ; endif - if (fc_out == 0) do_out = .false. - - if (do_in .and. do_out) then - if (var_in%num_bcs /= var_out%num_bcs) call mpp_error(FATAL, & - "Mismatch in num_bcs in CT_copy_data_3d.") - if (fc_in /= fc_out) call mpp_error(FATAL, & - "Mismatch in the total number of fields in CT_redistribute_data_3d.") - endif - - if (.not.(do_in .or. do_out)) return - - fc = 0 - if (do_in .and. do_out) then - do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if ( associated(var_in%bc(n)%field(m)%values) .neqv. & - associated(var_out%bc(n)%field(m)%values) ) & - call mpp_error(FATAL, & - "Mismatch in which fields are associated in CT_redistribute_data_3d.") - - if ( associated(var_in%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, var_in%bc(n)%field(m)%values, & - domain_out, var_out%bc(n)%field(m)%values, & - complete=(do_complete.and.(fc==fc_in)) ) - endif - enddo ; enddo - elseif (do_in) then - do n = 1, var_in%num_bcs ; do m = 1, var_in%bc(n)%num_fields - if ( associated(var_in%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, var_in%bc(n)%field(m)%values, & - domain_out, null_ptr3D, & - complete=(do_complete.and.(fc==fc_in)) ) - endif - enddo ; enddo - elseif (do_out) then - do n = 1, var_out%num_bcs ; do m = 1, var_out%bc(n)%num_fields - if ( associated(var_out%bc(n)%field(m)%values) ) then - fc = fc + 1 - call mpp_redistribute(domain_in, null_ptr3D, & - domain_out, var_out%bc(n)%field(m)%values, & - complete=(do_complete.and.(fc==fc_out)) ) - endif - enddo ; enddo - endif - -end subroutine CT_redistribute_data_3d - - -!> This subroutine rescales the fields in the elements of a coupler_2d_bc_type -!! by multiplying by a factor scale. If scale is 0, this is a direct -!! assignment to 0, so that NaNs will not persist. -subroutine CT_rescale_data_2d(var, scale, halo_size, bc_index, field_index, & - exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_2d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being rescaled - real, intent(in) :: scale !< A scaling factor to multiply fields by - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default or - !! the full arrays if scale is 0. - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this copy. - logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose - !! value of pass_through ice matches this - logical :: do_bc - integer :: i, j, m, n, n1, n2, halo - - if (present(bc_index)) then - if (bc_index > var%num_bcs) & - call mpp_error(FATAL, "CT_rescale_data_2d: bc_index is present and exceeds var%num_bcs.") - if (present(field_index)) then ; if (field_index > var%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_rescale_data_2d: field_index is present and exceeds num_fields for" //& - trim(var%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_rescale_data_2d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_rescale_data_2d: Excessive i-direction halo size.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_rescale_data_2d: Excessive j-direction halo size.") - endif - - do n = n1, n2 - - do_bc = .true. - if (do_bc .and. present(exclude_flux_type)) & - do_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (do_bc .and. present(only_flux_type)) & - do_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (do_bc .and. present(pass_through_ice)) & - do_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.do_bc) cycle - - do m = 1, var%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - if (scale == 0.0) then - if (present(halo_size)) then - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j) = 0.0 - enddo ; enddo - else - var%bc(n)%field(m)%values(:,:) = 0.0 - endif - else - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j) = scale * var%bc(n)%field(m)%values(i,j) - enddo ; enddo - endif - endif - enddo - enddo - -end subroutine CT_rescale_data_2d - -!> This subroutine rescales the fields in the elements of a coupler_3d_bc_type -!! by multiplying by a factor scale. If scale is 0, this is a direct -!! assignment to 0, so that NaNs will not persist. -subroutine CT_rescale_data_3d(var, scale, halo_size, bc_index, field_index, & - exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_3d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being rescaled - real, intent(in) :: scale !< A scaling factor to multiply fields by - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default or - !! the full arrays if scale is 0. - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this copy. - logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose - !! value of pass_through ice matches this - logical :: do_bc - integer :: i, j, k, m, n, n1, n2, halo - - if (present(bc_index)) then - if (bc_index > var%num_bcs) & - call mpp_error(FATAL, "CT_rescale_data_2d: bc_index is present and exceeds var%num_bcs.") - if (present(field_index)) then ; if (field_index > var%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_rescale_data_2d: field_index is present and exceeds num_fields for" //& - trim(var%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_rescale_data_2d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_rescale_data_3d: Excessive i-direction halo size.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_rescale_data_3d: Excessive j-direction halo size.") - endif - - do n = n1, n2 - - do_bc = .true. - if (do_bc .and. present(exclude_flux_type)) & - do_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (do_bc .and. present(only_flux_type)) & - do_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (do_bc .and. present(pass_through_ice)) & - do_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.do_bc) cycle - - do m = 1, var%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - if (scale == 0.0) then - if (present(halo_size)) then - do k=var%ks,var%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j,k) = 0.0 - enddo ; enddo ; enddo - else - var%bc(n)%field(m)%values(:,:,:) = 0.0 - endif - else - do k=var%ks,var%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j,k) = scale * var%bc(n)%field(m)%values(i,j,k) - enddo ; enddo ; enddo - endif - endif - enddo - enddo - -end subroutine CT_rescale_data_3d - - -!> This subroutine does a direct increment of the data in all elements of one -!! coupler_2d_bc_type into another. Both must have the same array sizes. -subroutine CT_increment_data_2d_2d(var_in, var, halo_size, bc_index, field_index, & - scale_factor, scale_prev, exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to add to the other type - type(coupler_2d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being incremented - integer, optional, intent(in) :: halo_size !< The extent of the halo to increment; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this increment. - logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose - !! value of pass_through ice matches this - - real :: scale, sc_prev - logical :: increment_bc - integer :: i, j, m, n, n1, n2, halo, i_off, j_off - - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - sc_prev = 1.0 ; if (present(scale_prev)) sc_prev = scale_prev - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_increment_data_2d_2d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_increment_data_2d_2d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_increment_data_2d_2d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_increment_data_2d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_increment_data_2d: There is a j-direction computional domain size mismatch.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d: Excessive j-direction halo size for the output structure.") - - i_off = var_in%isc - var%isc ; j_off = var_in%jsc - var%jsc - endif - - do n = n1, n2 - - increment_bc = .true. - if (increment_bc .and. present(exclude_flux_type)) & - increment_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (increment_bc .and. present(only_flux_type)) & - increment_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (increment_bc .and. present(pass_through_ice)) & - increment_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.increment_bc) cycle - - do m = 1, var_in%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j) = sc_prev * var%bc(n)%field(m)%values(i,j) + & - scale * var_in%bc(n)%field(m)%values(i+i_off,j+j_off) - enddo ; enddo - endif - enddo - enddo - -end subroutine CT_increment_data_2d_2d - - -!> This subroutine does a direct increment of the data in all elements of one -!! coupler_3d_bc_type into another. Both must have the same array sizes. -subroutine CT_increment_data_3d_3d(var_in, var, halo_size, bc_index, field_index, & - scale_factor, scale_prev, exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to add to the other type - type(coupler_3d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being incremented - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this increment. - logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose - !! value of pass_through ice matches this - - real :: scale, sc_prev - logical :: increment_bc - integer :: i, j, k, m, n, n1, n2, halo, i_off, j_off, k_off - - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - sc_prev = 1.0 ; if (present(scale_prev)) sc_prev = scale_prev - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_increment_data_3d_3d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_increment_data_3d_3d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_increment_data_3d_3d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_increment_data_3d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_increment_data_3d: There is a j-direction computional domain size mismatch.") - if ((var_in%ke-var_in%ks) /= (var%ke-var%ks)) & - call mpp_error(FATAL, "CT_increment_data_3d: There is a k-direction computional domain size mismatch.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_3d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_3d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_3d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_3d: Excessive j-direction halo size for the output structure.") - - i_off = var_in%isc - var%isc ; j_off = var_in%jsc - var%jsc ; k_off = var_in%ks - var%ks - endif - - do n = n1, n2 - - increment_bc = .true. - if (increment_bc .and. present(exclude_flux_type)) & - increment_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type)) - if (increment_bc .and. present(only_flux_type)) & - increment_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type)) - if (increment_bc .and. present(pass_through_ice)) & - increment_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice) - if (.not.increment_bc) cycle - - do m = 1, var_in%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - do k=var%ks,var%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j,k) = sc_prev * var%bc(n)%field(m)%values(i,j,k) + & - scale * var_in%bc(n)%field(m)%values(i+i_off,j+j_off,k+k_off) - enddo ; enddo ; enddo - endif - enddo - enddo - -end subroutine CT_increment_data_3d_3d - -!> This subroutine does increments the data in the elements of a coupler_2d_bc_type -!! with the weighed average of the elements of a coupler_3d_bc_type. Both must have -!! the same horizontal array sizes and the normalized weight array must match the -!! array sizes of the coupler_3d_bc_type. -subroutine CT_increment_data_2d_3d(var_in, weights, var, halo_size, bc_index, field_index, & - scale_factor, scale_prev, exclude_flux_type, only_flux_type, pass_through_ice) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to add to the other type - real, dimension(:,:,:), intent(in) :: weights !< An array of normalized weights for the 3d-data to - !! increment the 2d-data. There is no renormalization, - !! so if the weights do not sum to 1 in the 3rd dimension - !! there may be adverse consequences! - type(coupler_2d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being incremented - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, optional, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, optional, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types - !! of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types - !! of fluxes to include from this increment. - logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose - !! value of pass_through ice matches this - - real :: scale, sc_prev - logical :: increment_bc - integer :: i, j, k, m, n, n1, n2, halo - integer :: io1, jo1, iow, jow, kow ! Offsets to account for different index conventions. - - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - sc_prev = 1.0 ; if (present(scale_prev)) sc_prev = scale_prev - - if (present(bc_index)) then - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: bc_index is present and exceeds var_in%num_bcs.") - if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: field_index is present and exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - endif - elseif (present(field_index)) then - call mpp_error(FATAL, "CT_increment_data_2d_3d: bc_index must be present if field_index is present.") - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - - n1 = 1 ; n2 = var_in%num_bcs - if (present(bc_index)) then ; n1 = bc_index ; n2 = bc_index ; endif - - if (n2 >= n1) then - ! A more consciencious implementation would include a more descriptive error messages. - if ((var_in%iec-var_in%isc) /= (var%iec-var%isc)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: There is an i-direction computional domain size mismatch.") - if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: There is a j-direction computional domain size mismatch.") - if ((1+var_in%ke-var_in%ks) /= size(weights,3)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: There is a k-direction size mismatch with the weights array.") - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: Excessive j-direction halo size for the input structure.") - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: Excessive i-direction halo size for the output structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, "CT_increment_data_2d_3d: Excessive j-direction halo size for the output structure.") - - if ((1+var%iec-var%isc) == size(weights,1)) then - iow = 1 - var%isc - elseif ((1+var%ied-var%isd) == size(weights,1)) then - iow = 1 - var%isd - elseif ((1+var_in%ied-var_in%isd) == size(weights,1)) then - iow = 1 + (var_in%isc - var_in%isd) - var%isc - else - call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the i-size "//& - "of a computational or data domain.") - endif - if ((1+var%jec-var%jsc) == size(weights,2)) then - jow = 1 - var%jsc - elseif ((1+var%jed-var%jsd) == size(weights,2)) then - jow = 1 - var%jsd - elseif ((1+var_in%jed-var_in%jsd) == size(weights,2)) then - jow = 1 + (var_in%jsc - var_in%jsd) - var%jsc - else - call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the j-size "//& - "of a computational or data domain.") - endif - - io1 = var_in%isc - var%isc ; jo1 = var_in%jsc - var%jsc ; kow = 1 - var_in%ks - endif - - do n = n1, n2 - - increment_bc = .true. - if (increment_bc .and. present(exclude_flux_type)) & - increment_bc = .not.(trim(var_in%bc(n)%flux_type) == trim(exclude_flux_type)) - if (increment_bc .and. present(only_flux_type)) & - increment_bc = (trim(var_in%bc(n)%flux_type) == trim(only_flux_type)) - if (increment_bc .and. present(pass_through_ice)) & - increment_bc = (pass_through_ice .eqv. var_in%bc(n)%pass_through_ice) - if (.not.increment_bc) cycle - - do m = 1, var_in%bc(n)%num_fields - if (present(field_index)) then ; if (m /= field_index) cycle ; endif - if ( associated(var%bc(n)%field(m)%values) ) then - do k=var_in%ks,var_in%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(n)%field(m)%values(i,j) = sc_prev * var%bc(n)%field(m)%values(i,j) + & - (scale * weights(i+iow,j+jow,k+kow)) * var_in%bc(n)%field(m)%values(i+io1,j+io1,k) - enddo ; enddo ; enddo - endif - enddo - enddo - -end subroutine CT_increment_data_2d_3d - - -!> This subroutine extracts a single 2-d field from a coupler_2d_bc_type into -!! a two-dimensional array. -subroutine CT_extract_data_2d(var_in, bc_index, field_index, array_out, & - scale_factor, halo_size, idim, jdim) - type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to extract - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - real, dimension(1:,1:), intent(out) :: array_out !< The recipient array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_extract_data_2d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, halo, i_off, j_off - - if (bc_index <= 0) then - array_out(:,:) = 0.0 - return - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var_in%num_bcs.") - if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_out,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%iec-var_in%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var_in%isc) - else - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_out,1), ' does not match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var_in%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_out,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%jec-var_in%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var_in%jsc) - else - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_out,2), ' does not match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var_in%jsc-halo) - endif - - do j=var_in%jsc-halo,var_in%jec+halo ; do i=var_in%isc-halo,var_in%iec+halo - array_out(i+i_off,j+j_off) = scale * var_in%bc(bc_index)%field(field_index)%values(i,j) - enddo ; enddo - -end subroutine CT_extract_data_2d - -!> This subroutine extracts a single k-level of a 3-d field from a coupler_3d_bc_type -!! into a two-dimensional array. -subroutine CT_extract_data_3d_2d(var_in, bc_index, field_index, k_in, array_out, & - scale_factor, halo_size, idim, jdim) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to extract - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - integer, intent(in) :: k_in !< The k-index to extract - real, dimension(1:,1:), intent(out) :: array_out !< The recipient array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_extract_data_3d_2d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, k, halo, i_off, j_off - - if (bc_index <= 0) then - array_out(:,:) = 0.0 - return - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var_in%num_bcs.") - if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_out,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%iec-var_in%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var_in%isc) - else - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_out,1), ' does not match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var_in%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_out,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%jec-var_in%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var_in%jsc) - else - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_out,2), ' does not match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var_in%jsc-halo) - endif - - if ((k_in > var_in%ke) .or. (k_in < var_in%ks)) then - write (error_msg, *) trim(error_header), ' The extracted k-index of ', k_in, & - ' is outside of the valid range of ', var_in%ks, ' to ', var_in%ke - call mpp_error(FATAL, trim(error_msg)) - endif - - do j=var_in%jsc-halo,var_in%jec+halo ; do i=var_in%isc-halo,var_in%iec+halo - array_out(i+i_off,j+j_off) = scale * var_in%bc(bc_index)%field(field_index)%values(i,j,k_in) - enddo ; enddo - -end subroutine CT_extract_data_3d_2d - -!> This subroutine extracts a single 3-d field from a coupler_3d_bc_type into -!! a three-dimensional array. -subroutine CT_extract_data_3d(var_in, bc_index, field_index, array_out, & - scale_factor, halo_size, idim, jdim) - type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to extract - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - real, dimension(1:,1:,1:), intent(out) :: array_out !< The recipient array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_extract_data_3d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, k, halo, i_off, j_off, k_off - - if (bc_index <= 0) then - array_out(:,:,:) = 0.0 - return - endif - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var_in%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var_in%num_bcs.") - if (field_index > var_in%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var_in%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_out,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%iec-var_in%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var_in%isc) - else - if (size(array_out,1) < 2*halo + 1 + var_in%iec - var_in%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_out,1), ' does not match the data of size ', & - (2*halo + 1 + var_in%iec - var_in%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var_in%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_out,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_out,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var_in%jec-var_in%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var_in%jsc) - else - if (size(array_out,2) < 2*halo + 1 + var_in%jec - var_in%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_out,2), ' does not match the data of size ', & - (2*halo + 1 + var_in%jec - var_in%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var_in%jsc-halo) - endif - - if (size(array_out,3) /= 1 + var_in%ke - var_in%ks) then - write (error_msg, *) trim(error_header), ' The target array with k-dimension size ', & - size(array_out,3), ' does not match the data of size ', & - (1 + var_in%ke - var_in%ks) - call mpp_error(FATAL, trim(error_msg)) - endif - k_off = 1 - var_in%ks - - do k=var_in%ks,var_in%ke ; do j=var_in%jsc-halo,var_in%jec+halo ; do i=var_in%isc-halo,var_in%iec+halo - array_out(i+i_off,j+j_off,k+k_off) = scale * var_in%bc(bc_index)%field(field_index)%values(i,j,k) - enddo ; enddo ; enddo - -end subroutine CT_extract_data_3d - - -!> This subroutine sets a single 2-d field in a coupler_3d_bc_type from -!! a two-dimensional array. -subroutine CT_set_data_2d(array_in, bc_index, field_index, var, & - scale_factor, halo_size, idim, jdim) - real, dimension(1:,1:), intent(in) :: array_in !< The source array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure with the data to set - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_set_data_2d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, halo, i_off, j_off - - if (bc_index <= 0) return - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var%num_bcs.") - if (field_index > var%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_in,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%iec-var%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var%isc) - else - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_in,1), ' does not match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_in,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%jec-var%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var%jsc) - else - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_in,2), ' does not match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var%jsc-halo) - endif - - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(bc_index)%field(field_index)%values(i,j) = scale * array_in(i+i_off,j+j_off) - enddo ; enddo - -end subroutine CT_set_data_2d - -!> This subroutine sets a one k-level of a single 3-d field in a -!! coupler_3d_bc_type from a two-dimensional array. -subroutine CT_set_data_2d_3d(array_in, bc_index, field_index, k_out, var, & - scale_factor, halo_size, idim, jdim) - real, dimension(1:,1:), intent(in) :: array_in !< The source array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - integer, intent(in) :: k_out !< The k-index to set - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure with the data to be set - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_set_data_3d_2d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, halo, i_off, j_off - - if (bc_index <= 0) return - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var%num_bcs.") - if (field_index > var%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_in,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%iec-var%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var%isc) - else - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_in,1), ' does not match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_in,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%jec-var%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var%jsc) - else - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_in,2), ' does not match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var%jsc-halo) - endif - - if ((k_out > var%ke) .or. (k_out < var%ks)) then - write (error_msg, *) trim(error_header), ' The seted k-index of ', k_out, & - ' is outside of the valid range of ', var%ks, ' to ', var%ke - call mpp_error(FATAL, trim(error_msg)) - endif - - do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(bc_index)%field(field_index)%values(i,j,k_out) = scale * array_in(i+i_off,j+j_off) - enddo ; enddo - -end subroutine CT_set_data_2d_3d - -!> This subroutine sets a single 3-d field in a coupler_3d_bc_type from -!! a three-dimensional array. -subroutine CT_set_data_3d(array_in, bc_index, field_index, var, & - scale_factor, halo_size, idim, jdim) - real, dimension(1:,1:,1:), intent(in) :: array_in !< The source array for the field; its size - !! must match the size of the data being copied - !! unless idim and jdim are supplied. - integer, intent(in) :: bc_index !< The index of the boundary condition - !! that is being copied - integer, intent(in) :: field_index !< The index of the field in the - !! boundary condition that is being copied - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure with the data to be set - real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added - integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default - integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of - !! the first dimension of the output array - !! in a non-decreasing list - integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of - !! the second dimension of the output array - !! in a non-decreasing list - character(len=256), parameter :: error_header = & - '==>Error from coupler_types_mod (CT_set_data_3d):' - character(len=400) :: error_msg - - real :: scale - integer :: i, j, k, halo, i_off, j_off, k_off - - if (bc_index <= 0) return - - halo = 0 ; if (present(halo_size)) halo = halo_size - scale = 1.0 ; if (present(scale_factor)) scale = scale_factor - - if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the input structure.") - if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the input structure.") - - if (bc_index > var%num_bcs) & - call mpp_error(FATAL, trim(error_header)//" bc_index exceeds var%num_bcs.") - if (field_index > var%bc(bc_index)%num_fields) & - call mpp_error(FATAL, trim(error_header)//" field_index exceeds num_fields for" //& - trim(var%bc(bc_index)%name) ) - - ! Do error checking on the i-dimension and determine the array offsets. - if (present(idim)) then - if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then - write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,1) /= (1+idim(4)-idim(1))) then - write (error_msg, *) trim(error_header), ' The declared i-dimension size of ', & - (1+idim(4)-idim(1)), ' does not match the actual size of ', size(array_in,1) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%iec-var%isc) /= (idim(3)-idim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an i-direction computional domain size mismatch.") - if ((idim(2)-idim(1) < halo) .or. (idim(4)-idim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive i-direction halo size for the output array.") - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - (1+idim(4)-idim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - - i_off = (1-idim(1)) + (idim(2)-var%isc) - else - if (size(array_in,1) < 2*halo + 1 + var%iec - var%isc) then - write (error_msg, *) trim(error_header), ' The target array with i-dimension size ', & - size(array_in,1), ' does not match the data of size ', & - (2*halo + 1 + var%iec - var%isc) - call mpp_error(FATAL, trim(error_msg)) - endif - i_off = 1 - (var%isc-halo) - endif - - ! Do error checking on the j-dimension and determine the array offsets. - if (present(jdim)) then - if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then - write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list ', jdim - call mpp_error(FATAL, trim(error_msg)) - endif - if (size(array_in,2) /= (1+jdim(4)-jdim(1))) then - write (error_msg, *) trim(error_header), ' The declared j-dimension size of ', & - (1+jdim(4)-jdim(1)), ' does not match the actual size of ', size(array_in,2) - call mpp_error(FATAL, trim(error_msg)) - endif - if ((var%jec-var%jsc) /= (jdim(3)-jdim(2))) & - call mpp_error(FATAL, trim(error_header)//" There is an j-direction computional domain size mismatch.") - if ((jdim(2)-jdim(1) < halo) .or. (jdim(4)-jdim(3) < halo)) & - call mpp_error(FATAL, trim(error_header)//" Excessive j-direction halo size for the output array.") - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - (1+jdim(4)-jdim(1)), ' is too small to match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - - j_off = (1-jdim(1)) + (jdim(2)-var%jsc) - else - if (size(array_in,2) < 2*halo + 1 + var%jec - var%jsc) then - write (error_msg, *) trim(error_header), ' The target array with j-dimension size ', & - size(array_in,2), ' does not match the data of size ', & - (2*halo + 1 + var%jec - var%jsc) - call mpp_error(FATAL, trim(error_msg)) - endif - j_off = 1 - (var%jsc-halo) - endif - - if (size(array_in,3) /= 1 + var%ke - var%ks) then - write (error_msg, *) trim(error_header), ' The target array with k-dimension size ', & - size(array_in,3), ' does not match the data of size ', & - (1 + var%ke - var%ks) - call mpp_error(FATAL, trim(error_msg)) - endif - k_off = 1 - var%ks - - do k=var%ks,var%ke ; do j=var%jsc-halo,var%jec+halo ; do i=var%isc-halo,var%iec+halo - var%bc(bc_index)%field(field_index)%values(i,j,k) = scale * array_in(i+i_off,j+j_off,k+k_off) - enddo ; enddo ; enddo - -end subroutine CT_set_data_3d - - -!> This routine registers the diagnostics of a coupler_2d_bc_type. -subroutine CT_set_diags_2d(var, diag_name, axes, time) - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure for which to register diagnostics - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - - integer :: m, n - - if (diag_name == ' ') return - - if (size(axes) < 2) then - call mpp_error(FATAL, '==>Error from coupler_types_mod' //& - '(coupler_types_set_diags_3d): axes has less than 2 elements') - endif - - do n = 1, var%num_bcs - do m = 1, var%bc(n)%num_fields - var%bc(n)%field(m)%id_diag = register_diag_field(diag_name, & - var%bc(n)%field(m)%name, axes(1:2), Time, & - var%bc(n)%field(m)%long_name, var%bc(n)%field(m)%units ) - enddo - enddo - -end subroutine CT_set_diags_2d - -!> This routine registers the diagnostics of a coupler_3d_bc_type. -subroutine CT_set_diags_3d(var, diag_name, axes, time) - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure for which to register diagnostics - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, - !! then don't register the fields - integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration - type(time_type), intent(in) :: time !< model time variable for registering diagnostic field - - integer :: m, n - - if (diag_name == ' ') return - - if (size(axes) < 3) then - call mpp_error(FATAL, '==>Error from coupler_types_mod' //& - '(coupler_types_set_diags_3d): axes has less than 3 elements') - endif - - do n = 1, var%num_bcs - do m = 1, var%bc(n)%num_fields - var%bc(n)%field(m)%id_diag = register_diag_field(diag_name, & - var%bc(n)%field(m)%name, axes(1:3), Time, & - var%bc(n)%field(m)%long_name, var%bc(n)%field(m)%units ) - enddo - enddo - -end subroutine CT_set_diags_3d - - -!> This subroutine writes out all diagnostics of elements of a coupler_2d_bc_type -subroutine CT_send_data_2d(var, Time) - type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure with the diagnostics to write - type(time_type), intent(in) :: time !< The current model time - - integer :: m, n - logical :: used - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - used = send_data(var%bc(n)%field(m)%id_diag, var%bc(n)%field(m)%values, Time) - enddo ; enddo - -end subroutine CT_send_data_2d - -!> This subroutine writes out all diagnostics of elements of a coupler_2d_bc_type -subroutine CT_send_data_3d(var, Time) - type(coupler_3d_bc_type), intent(in) :: var !< BC_type structure with the diagnostics to write - type(time_type), intent(in) :: time !< The current model time - - integer :: m, n - logical :: used - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - used = send_data(var%bc(n)%field(m)%id_diag, var%bc(n)%field(m)%values, Time) - enddo ; enddo - -end subroutine CT_send_data_3d - - -!> This subroutine registers the fields in a coupler_2d_bc_type to be saved -!! in restart files specified in the field table. -subroutine CT_register_restarts_2d(var, bc_rest_files, num_rest_files, mpp_domain, ocean_restart) - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to be registered for restarts - type(restart_file_type), dimension(:), pointer :: bc_rest_files !< Structures describing the restart files - integer, intent(out) :: num_rest_files !< The number of restart files to use - type(domain2D), intent(in) :: mpp_domain !< The FMS domain to use for this registration call - logical, optional, intent(in) :: ocean_restart !< If true, use the ocean restart file name. - - character(len=80), dimension(max(1,var%num_bcs)) :: rest_file_names - character(len=80) :: file_nm - logical :: ocn_rest - integer :: f, n, m - - ocn_rest = .true. ; if (present(ocean_restart)) ocn_rest = ocean_restart - - ! Determine the number and names of the restart files - num_rest_files = 0 - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - file_nm = trim(var%bc(n)%ice_restart_file) - if (ocn_rest) file_nm = trim(var%bc(n)%ocean_restart_file) - do f = 1, num_rest_files - if (trim(file_nm) == trim(rest_file_names(f))) exit - enddo - if (f>num_rest_files) then - num_rest_files = num_rest_files + 1 - rest_file_names(f) = trim(file_nm) - endif - enddo - - if (num_rest_files == 0) return - - ! Register the fields with the restart files - allocate(bc_rest_files(num_rest_files)) - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - - file_nm = trim(var%bc(n)%ice_restart_file) - if (ocn_rest) file_nm = trim(var%bc(n)%ocean_restart_file) - do f = 1, num_rest_files - if (trim(file_nm) == trim(rest_file_names(f))) exit - enddo - - var%bc(n)%rest_type => bc_rest_files(f) - do m = 1, var%bc(n)%num_fields - var%bc(n)%field(m)%id_rest = register_restart_field(bc_rest_files(f), & - rest_file_names(f), var%bc(n)%field(m)%name, var%bc(n)%field(m)%values, & - mpp_domain, mandatory=.not.var%bc(n)%field(m)%may_init ) - enddo - enddo - -end subroutine CT_register_restarts_2d - -!> This subroutine registers the fields in a coupler_2d_bc_type to be saved -!! in the specified restart file. -subroutine CT_register_restarts_to_file_2d(var, file_name, rest_file, mpp_domain, & - varname_prefix) - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to be registered for restarts - character(len=*), intent(in) :: file_name !< The name of the restart file - type(restart_file_type), pointer :: rest_file !< A (possibly associated) structure describing the restart file - type(domain2D), intent(in) :: mpp_domain !< The FMS domain to use for this registration call - character(len=*), optional, intent(in) :: varname_prefix !< A prefix for the variable name - !! in the restart file, intended to allow - !! multiple BC_type variables to use the - !! same restart files. - - character(len=128) :: var_name - integer :: n, m - - ! Register the fields with the restart file - if (.not.associated(rest_file)) allocate(rest_file) - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - - var%bc(n)%rest_type => rest_file - do m = 1, var%bc(n)%num_fields - var_name = trim(var%bc(n)%field(m)%name) - if (present(varname_prefix)) var_name = trim(varname_prefix)//trim(var_name) - var%bc(n)%field(m)%id_rest = register_restart_field(rest_file, & - file_name, var_name, var%bc(n)%field(m)%values, & - mpp_domain, mandatory=.not.var%bc(n)%field(m)%may_init ) - enddo - enddo - -end subroutine CT_register_restarts_to_file_2d - -!> This subroutine registers the fields in a coupler_3d_bc_type to be saved -!! in restart files specified in the field table. -subroutine CT_register_restarts_3d(var, bc_rest_files, num_rest_files, mpp_domain, ocean_restart) - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to be registered for restarts - type(restart_file_type), dimension(:), pointer :: bc_rest_files !< Structures describing the restart files - integer, intent(out) :: num_rest_files !< The number of restart files to use - type(domain2D), intent(in) :: mpp_domain !< The FMS domain to use for this registration call - logical, optional, intent(in) :: ocean_restart !< If true, use the ocean restart file name. - - character(len=80), dimension(max(1,var%num_bcs)) :: rest_file_names - character(len=80) :: file_nm - logical :: ocn_rest - integer :: f, n, m, id_restart - - ocn_rest = .true. ; if (present(ocean_restart)) ocn_rest = ocean_restart - - ! Determine the number and names of the restart files - num_rest_files = 0 - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - file_nm = trim(var%bc(n)%ice_restart_file) - if (ocn_rest) file_nm = trim(var%bc(n)%ocean_restart_file) - do f = 1, num_rest_files - if (trim(file_nm) == trim(rest_file_names(f))) exit - enddo - if (f>num_rest_files) then - num_rest_files = num_rest_files + 1 - rest_file_names(f) = trim(file_nm) - endif - enddo - - if (num_rest_files == 0) return - - ! Register the fields with the restart files - allocate(bc_rest_files(num_rest_files)) - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - file_nm = trim(var%bc(n)%ice_restart_file) - if (ocn_rest) file_nm = trim(var%bc(n)%ocean_restart_file) - do f = 1, num_rest_files - if (trim(file_nm) == trim(rest_file_names(f))) exit - enddo - - var%bc(n)%rest_type => bc_rest_files(f) - do m = 1, var%bc(n)%num_fields - var%bc(n)%field(m)%id_rest = register_restart_field(bc_rest_files(f), & - rest_file_names(f), var%bc(n)%field(m)%name, var%bc(n)%field(m)%values, & - mpp_domain, mandatory=.not.var%bc(n)%field(m)%may_init ) - enddo - enddo - -end subroutine CT_register_restarts_3d - -!> This subroutine registers the fields in a coupler_3d_bc_type to be saved -!! in the specified restart file. -subroutine CT_register_restarts_to_file_3d(var, file_name, rest_file, mpp_domain, & - varname_prefix) - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to be registered for restarts - character(len=*), intent(in) :: file_name !< The name of the restart file - type(restart_file_type), pointer :: rest_file !< A (possibly associated) structure describing the restart file - type(domain2D), intent(in) :: mpp_domain !< The FMS domain to use for this registration call - - character(len=*), optional, intent(in) :: varname_prefix !< A prefix for the variable name - !! in the restart file, intended to allow - !! multiple BC_type variables to use the - !! same restart files. - - character(len=128) :: var_name - integer :: n, m - - ! Register the fields with the restart file - if (.not.associated(rest_file)) allocate(rest_file) - do n = 1, var%num_bcs - if (var%bc(n)%num_fields <= 0) cycle - - var%bc(n)%rest_type => rest_file - do m = 1, var%bc(n)%num_fields - var_name = trim(var%bc(n)%field(m)%name) - if (present(varname_prefix)) var_name = trim(varname_prefix)//trim(var_name) - var%bc(n)%field(m)%id_rest = register_restart_field(rest_file, & - file_name, var_name, var%bc(n)%field(m)%values, & - mpp_domain, mandatory=.not.var%bc(n)%field(m)%may_init ) - enddo - enddo - -end subroutine CT_register_restarts_to_file_3d - - -!> This subroutine reads in the fields in a coupler_2d_bc_type that have -!! been saved in restart files. -subroutine CT_restore_state_2d(var, directory, all_or_nothing, & - all_required, test_by_field) - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to restore from restart files - character(len=*), optional, intent(in) :: directory !< A directory where the restart files should - !! be found. The default for FMS is 'INPUT'. - logical, optional, intent(in) :: all_or_nothing !< If true and there are non-mandatory - !! restart fields, it is still an error if some - !! fields are read successfully but others are not. - logical, optional, intent(in) :: all_required !< If true, all fields must be successfully - !! read from the restart file, even if they were - !! registered as not mandatory. - logical, optional, intent(in) :: test_by_field !< If true, all or none of the variables - !! in a single field must be read successfully. - - integer :: n, m, num_fld - character(len=80) :: unset_varname - logical :: any_set, all_set, all_var_set, any_var_set, var_set - - any_set = .false. ; all_set = .true. ; num_fld = 0 ; unset_varname = "" - - do n = 1, var%num_bcs - any_var_set = .false. ; all_var_set = .true. - do m = 1, var%bc(n)%num_fields - var_set = .false. - if (var%bc(n)%field(m)%id_rest > 0) then - var_set = query_initialized(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest) - if (.not.var_set) then - call restore_state(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest, & - directory=directory, nonfatal_missing_files=.true.) - var_set = query_initialized(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest) - endif - endif - - if (.not.var_set) unset_varname = trim(var%bc(n)%field(m)%name) - if (var_set) any_set = .true. - if (all_set) all_set = var_set - if (var_set) any_var_set = .true. - if (all_var_set) all_var_set = var_set - enddo - - num_fld = num_fld + var%bc(n)%num_fields - if ((var%bc(n)%num_fields > 0) .and. present(test_by_field)) then - if (test_by_field .and. (all_var_set .neqv. any_var_set)) call mpp_error(FATAL, & - "CT_restore_state_2d: test_by_field is true, and "//& - trim(unset_varname)//" was not read but some other fields in "//& - trim(trim(var%bc(n)%name))//" were.") - endif - enddo - - if ((num_fld > 0) .and. present(all_or_nothing)) then - if (all_or_nothing .and. (all_set .neqv. any_set)) call mpp_error(FATAL, & - "CT_restore_state_2d: all_or_nothing is true, and "//& - trim(unset_varname)//" was not read but some other fields were.") - endif - - if (present(all_required)) then ; if (all_required .and. .not.all_set) then - call mpp_error(FATAL, "CT_restore_state_2d: all_required is true, but "//& - trim(unset_varname)//" was not read from its restart file.") - endif ; endif - -end subroutine CT_restore_state_2d - -!> This subroutine reads in the fields in a coupler_3d_bc_type that have -!! been saved in restart files. -subroutine CT_restore_state_3d(var, directory, all_or_nothing, & - all_required, test_by_field) - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to restore from restart files - character(len=*), optional, intent(in) :: directory !< A directory where the restart files should - !! be found. The default for FMS is 'INPUT'. - logical, optional, intent(in) :: all_or_nothing !< If true and there are non-mandatory - !! restart fields, it is still an error if some - !! fields are read successfully but others are not. - logical, optional, intent(in) :: all_required !< If true, all fields must be successfully - !! read from the restart file, even if they were - !! registered as not mandatory. - logical, optional, intent(in) :: test_by_field !< If true, all or none of the variables - !! in a single field must be read successfully. - - integer :: n, m, num_fld - character(len=80) :: unset_varname - logical :: any_set, all_set, all_var_set, any_var_set, var_set - - any_set = .false. ; all_set = .true. ; num_fld = 0 ; unset_varname = "" - - do n = 1, var%num_bcs - any_var_set = .false. ; all_var_set = .true. - do m = 1, var%bc(n)%num_fields - var_set = .false. - if (var%bc(n)%field(m)%id_rest > 0) then - var_set = query_initialized(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest) - if (.not.var_set) then - call restore_state(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest, & - directory=directory, nonfatal_missing_files=.true.) - var_set = query_initialized(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest) - endif - endif - - if (.not.var_set) unset_varname = trim(var%bc(n)%field(m)%name) - - if (var_set) any_set = .true. - if (all_set) all_set = var_set - if (var_set) any_var_set = .true. - if (all_var_set) all_var_set = var_set - enddo - - num_fld = num_fld + var%bc(n)%num_fields - if ((var%bc(n)%num_fields > 0) .and. present(test_by_field)) then - if (test_by_field .and. (all_var_set .neqv. any_var_set)) call mpp_error(FATAL, & - "CT_restore_state_3d: test_by_field is true, and "//& - trim(unset_varname)//" was not read but some other fields in "//& - trim(trim(var%bc(n)%name))//" were.") - endif - enddo - - if ((num_fld > 0) .and. present(all_or_nothing)) then - if (all_or_nothing .and. (all_set .neqv. any_set)) call mpp_error(FATAL, & - "CT_restore_state_3d: all_or_nothing is true, and "//& - trim(unset_varname)//" was not read but some other fields were.") - endif - - if (present(all_required)) then ; if (all_required .and. .not.all_set) then - call mpp_error(FATAL, "CT_restore_state_3d: all_required is true, but "//& - trim(unset_varname)//" was not read from its restart file.") - endif ; endif - -end subroutine CT_restore_state_3d - - -!> This subroutine potentially overrides the values in a coupler_2d_bc_type -subroutine CT_data_override_2d(gridname, var, Time) - character(len=3), intent(in) :: gridname !< 3-character long model grid ID - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to override - type(time_type), intent(in) :: time !< The current model time - - integer :: m, n - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - call data_override(gridname, var%bc(n)%field(m)%name, var%bc(n)%field(m)%values, Time) - enddo ; enddo - -end subroutine CT_data_override_2d - -!> This subroutine potentially overrides the values in a coupler_3d_bc_type -subroutine CT_data_override_3d(gridname, var, Time) - character(len=3), intent(in) :: gridname !< 3-character long model grid ID - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to override - type(time_type), intent(in) :: time !< The current model time - - integer :: m, n - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - call data_override(gridname, var%bc(n)%field(m)%name, var%bc(n)%field(m)%values, Time) - enddo ; enddo - -end subroutine CT_data_override_3d - - -!> This subroutine writes out checksums for the elements of a coupler_2d_bc_type -subroutine CT_write_chksums_2d(var, outunit, name_lead) - type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure for which to register diagnostics - integer, intent(in) :: outunit !< The index of a open output file - character(len=*), optional, intent(in) :: name_lead !< An optional prefix for the variable names - - character(len=120) :: var_name - integer :: m, n - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - if (present(name_lead)) then - var_name = trim(name_lead)//trim(var%bc(n)%field(m)%name) - else - var_name = trim(var%bc(n)%field(m)%name) - endif - write(outunit, '(" CHECKSUM:: ",A40," = ",Z20)') trim(var_name), & - mpp_chksum(var%bc(n)%field(m)%values(var%isc:var%iec,var%jsc:var%jec) ) - enddo ; enddo - -end subroutine CT_write_chksums_2d - -!> This subroutine writes out checksums for the elements of a coupler_3d_bc_type -subroutine CT_write_chksums_3d(var, outunit, name_lead) - type(coupler_3d_bc_type), intent(in) :: var !< BC_type structure for which to register diagnostics - integer, intent(in) :: outunit !< The index of a open output file - character(len=*), optional, intent(in) :: name_lead !< An optional prefix for the variable names - - character(len=120) :: var_name - integer :: m, n - - do n = 1, var%num_bcs ; do m = 1, var%bc(n)%num_fields - if (present(name_lead)) then - var_name = trim(name_lead)//trim(var%bc(n)%field(m)%name) - else - var_name = trim(var%bc(n)%field(m)%name) - endif - write(outunit, '(" CHECKSUM:: ",A40," = ",Z20)') var_name, & - mpp_chksum(var%bc(n)%field(m)%values(var%isc:var%iec,var%jsc:var%jec,:) ) - enddo ; enddo - -end subroutine CT_write_chksums_3d - - -!> This function indicates whether a coupler_1d_bc_type has been initialized. -function CT_initialized_1d(var) - type(coupler_1d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed - logical :: CT_initialized_1d !< The return value, indicating whether this type has been initialized - - CT_initialized_1d = var%set -end function CT_initialized_1d - -!> This function indicates whether a coupler_2d_bc_type has been initialized. -function CT_initialized_2d(var) - type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed - logical :: CT_initialized_2d !< The return value, indicating whether this type has been initialized - - CT_initialized_2d = var%set -end function CT_initialized_2d - -!> This function indicates whether a coupler_3d_bc_type has been initialized. -function CT_initialized_3d(var) - type(coupler_3d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed - logical :: CT_initialized_3d !< The return value, indicating whether this type has been initialized - - CT_initialized_3d = var%set -end function CT_initialized_3d - - -!> This subroutine deallocates all data associated with a coupler_1d_bc_type -subroutine CT_destructor_1d(var) - type(coupler_1d_bc_type), intent(inout) :: var !< BC_type structure to be deconstructed - - integer :: m, n - - if (var%num_bcs > 0) then - do n = 1, var%num_bcs - do m = 1, var%bc(n)%num_fields - deallocate ( var%bc(n)%field(m)%values ) - enddo - deallocate ( var%bc(n)%field ) - enddo - deallocate ( var%bc ) - endif - - var%num_bcs = 0 ; var%set = .false. - -end subroutine CT_destructor_1d - -!> This subroutine deallocates all data associated with a coupler_2d_bc_type -subroutine CT_destructor_2d(var) - type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to be deconstructed - - integer :: m, n - - if (var%num_bcs > 0) then - do n = 1, var%num_bcs - do m = 1, var%bc(n)%num_fields - deallocate ( var%bc(n)%field(m)%values ) - enddo - deallocate ( var%bc(n)%field ) - enddo - deallocate ( var%bc ) - endif - - var%num_bcs = 0 ; var%set = .false. - -end subroutine CT_destructor_2d - - -!> This subroutine deallocates all data associated with a coupler_3d_bc_type -subroutine CT_destructor_3d(var) - type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to be deconstructed - - integer :: m, n - - if (var%num_bcs > 0) then - do n = 1, var%num_bcs - do m = 1, var%bc(n)%num_fields - deallocate ( var%bc(n)%field(m)%values ) - enddo - deallocate ( var%bc(n)%field ) - enddo - deallocate ( var%bc ) - endif - - var%num_bcs = 0 ; var%set = .false. - -end subroutine CT_destructor_3d - -end module coupler_types_mod diff --git a/config_src/solo_driver/coupler_util.F90 b/config_src/solo_driver/coupler_util.F90 deleted file mode 100644 index cc63a9563d..0000000000 --- a/config_src/solo_driver/coupler_util.F90 +++ /dev/null @@ -1,135 +0,0 @@ -!> Provides a couple of interfaces to allow more transparent and -!! robust extraction of the various fields in the coupler types. -module coupler_util - -! This file is part of MOM6. See LICENSE.md for the license. - -use MOM_error_handler, only : MOM_error, FATAL, WARNING -use coupler_types_mod, only : coupler_2d_bc_type, ind_flux, ind_alpha -use coupler_types_mod, only : ind_csurf - -implicit none ; private - -public :: extract_coupler_values, set_coupler_values -public :: ind_flux, ind_alpha, ind_csurf - -contains - -!> Extract an array of values in a coupler bc type -subroutine extract_coupler_values(BC_struc, BC_index, BC_element, array_out, & - is, ie, js, je, conversion) - type(coupler_2d_bc_type), intent(in) :: BC_struc !< The type from which the data is being extracted. - integer, intent(in) :: BC_index !< The boundary condition number being extracted. - integer, intent(in) :: BC_element !< The element of the boundary condition being extracted. - real, dimension(:,:), intent(out) :: array_out !< The array being filled with the input values. - integer, optional, intent(in) :: is !< Start i-index - integer, optional, intent(in) :: ie !< End i-index - integer, optional, intent(in) :: js !< Start j-index - integer, optional, intent(in) :: je !< End j-index - real, optional, intent(in) :: conversion !< A number that every element is multiplied by, to - ! Local variables - real, pointer, dimension(:,:) :: Array_in - real :: conv - integer :: i, j, is0, ie0, js0, je0, i_offset, j_offset - - if ((BC_element /= ind_flux) .and. (BC_element /= ind_alpha) .and. & - (BC_element /= ind_csurf)) then - call MOM_error(FATAL,"extract_coupler_values: Unrecognized BC_element.") - endif - - ! These error messages should be made more explicit. -! if (.not.associated(BC_struc%bc(BC_index))) & - if (.not.associated(BC_struc%bc)) & - call MOM_error(FATAL,"extract_coupler_values: " // & - "The requested boundary condition is not associated.") -! if (.not.associated(BC_struc%bc(BC_index)%field(BC_element))) & - if (.not.associated(BC_struc%bc(BC_index)%field)) & - call MOM_error(FATAL,"extract_coupler_values: " // & - "The requested boundary condition element is not associated.") - if (.not.associated(BC_struc%bc(BC_index)%field(BC_element)%values)) & - call MOM_error(FATAL,"extract_coupler_values: " // & - "The requested boundary condition value array is not associated.") - - Array_in => BC_struc%bc(BC_index)%field(BC_element)%values - - if (present(is)) then ; is0 = is ; else ; is0 = LBOUND(array_out,1) ; endif - if (present(ie)) then ; ie0 = ie ; else ; ie0 = UBOUND(array_out,1) ; endif - if (present(js)) then ; js0 = js ; else ; js0 = LBOUND(array_out,2) ; endif - if (present(je)) then ; je0 = je ; else ; je0 = UBOUND(array_out,2) ; endif - - conv = 1.0 ; if (present(conversion)) conv = conversion - - if (size(Array_in,1) /= ie0 - is0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and output array or computational domain.") - if (size(Array_in,2) /= je0 - js0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and output array or computational domain.") - i_offset = lbound(Array_in,1) - is0 - j_offset = lbound(Array_in,2) - js0 - do j=js0,je0 ; do i=is0,ie0 - array_out(i,j) = conv * Array_in(i+i_offset,j+j_offset) - enddo ; enddo - -end subroutine extract_coupler_values - -!> Set an array of values in a coupler bc type -subroutine set_coupler_values(array_in, BC_struc, BC_index, BC_element, & - is, ie, js, je, conversion) - real, dimension(:,:), intent(in) :: array_in !< The array containing the values to load into the BC. - type(coupler_2d_bc_type), intent(inout) :: BC_struc !< The type from which the data is being extracted. - integer, intent(in) :: BC_index !< The boundary condition number being extracted. - integer, intent(in) :: BC_element !< The element of the boundary condition being extracted. - integer, optional, intent(in) :: is !< Start i-index - integer, optional, intent(in) :: ie !< End i-index - integer, optional, intent(in) :: js !< Start j-index - integer, optional, intent(in) :: je !< End j-index - real, optional, intent(in) :: conversion !< A number that every element is multiplied by, to - !! permit sign convention or unit conversion. - ! Local variables - real, pointer, dimension(:,:) :: Array_out - real :: conv - integer :: i, j, is0, ie0, js0, je0, i_offset, j_offset - - if ((BC_element /= ind_flux) .and. (BC_element /= ind_alpha) .and. & - (BC_element /= ind_csurf)) then - call MOM_error(FATAL,"extract_coupler_values: Unrecognized BC_element.") - endif - - ! These error messages should be made more explicit. -! if (.not.associated(BC_struc%bc(BC_index))) & - if (.not.associated(BC_struc%bc)) & - call MOM_error(FATAL,"set_coupler_values: " // & - "The requested boundary condition is not associated.") -! if (.not.associated(BC_struc%bc(BC_index)%field(BC_element))) & - if (.not.associated(BC_struc%bc(BC_index)%field)) & - call MOM_error(FATAL,"set_coupler_values: " // & - "The requested boundary condition element is not associated.") - if (.not.associated(BC_struc%bc(BC_index)%field(BC_element)%values)) & - call MOM_error(FATAL,"set_coupler_values: " // & - "The requested boundary condition value array is not associated.") - - Array_out => BC_struc%bc(BC_index)%field(BC_element)%values - - if (present(is)) then ; is0 = is ; else ; is0 = LBOUND(array_in,1) ; endif - if (present(ie)) then ; ie0 = ie ; else ; ie0 = UBOUND(array_in,1) ; endif - if (present(js)) then ; js0 = js ; else ; js0 = LBOUND(array_in,2) ; endif - if (present(je)) then ; je0 = je ; else ; je0 = UBOUND(array_in,2) ; endif - - conv = 1.0 ; if (present(conversion)) conv = conversion - - if (size(Array_out,1) /= ie0 - is0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and input array or computational domain.") - if (size(Array_out,2) /= je0 - js0 + 1) & - call MOM_error(FATAL,"extract_coupler_values: Mismatch in i-size " // & - "between BC array and input array or computational domain.") - i_offset = lbound(Array_out,1) - is0 - j_offset = lbound(Array_out,2) - js0 - do j=js0,je0 ; do i=is0,ie0 - Array_out(i+i_offset,j+j_offset) = conv * array_in(i,j) - enddo ; enddo - -end subroutine set_coupler_values - -end module coupler_util From 8d92e78381702383cb24b2843d0f99c15b809997 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 23 Apr 2019 17:37:25 -0400 Subject: [PATCH 1061/1072] +Added missing US arguments to nuopc_cap code Added unit_scale_type arguments to several subroutines in the nuopc_driver directory, added a unit_scale_type element to the nuopc_driver versoin of ocean_state_type, and use this argument to appropriately rescale forces%ustar for dimensional consistency testing. These changes are required to go with the dev-master-candidate-2018-04-22 updates to MOM6. With these changes, the code in origin/dev-master-candidate-2018-04-22 compiles up through the nuopc_driver version of MOM_ocean_model.o. --- config_src/nuopc_driver/MOM_ocean_model.F90 | 19 +++++++++------- .../nuopc_driver/MOM_surface_forcing.F90 | 22 +++++++++++-------- 2 files changed, 24 insertions(+), 17 deletions(-) diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 71a8933fbc..9889887b04 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -45,6 +45,7 @@ module MOM_ocean_model 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 @@ -196,6 +197,8 @@ module MOM_ocean_model 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() !< A pointer to the MOM control structure type(ice_shelf_CS), pointer :: & @@ -275,7 +278,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i 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, C_p=OS%C_p, & + 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%fluxes%C_p = OS%C_p @@ -368,7 +371,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i 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, param_file, OS%diag, & + call surface_forcing_init(Time_in, OS%grid, OS%US, param_file, OS%diag, & OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) if (OS%use_ice_shelf) then @@ -384,7 +387,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i 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, param_file, OS%Waves, OS%diag) + 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 @@ -504,12 +507,12 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & weight = 1.0 call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp) + OS%grid, OS%US, OS%forcing_CSp) if (OS%fluxes%fluxes_used) then if (do_thermo) & call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp, OS%sfc_state, & + OS%grid, OS%US, OS%forcing_CSp, OS%sfc_state, & OS%restore_salinity, OS%restore_temp) ! Add ice shelf fluxes @@ -542,7 +545,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%flux_tmp%C_p = OS%fluxes%C_p if (do_thermo) & call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & - OS%grid, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity,OS%restore_temp) + OS%grid, OS%US, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity,OS%restore_temp) if (OS%use_ice_shelf) then if (do_thermo) & @@ -568,11 +571,11 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call MOM_generic_tracer_fluxes_accumulate(OS%flux_tmp, weight) !weight of the current flux in the running average #endif endif - call set_derived_forcing_fields(OS%forces, OS%fluxes, OS%grid, OS%GV%Rho0) + 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%time, ocean_coupling_time_step, OS%waves) + call Update_Surface_Waves(OS%grid, OS%GV, OS%US, OS%time, ocean_coupling_time_step, OS%waves) endif if (OS%nstep==0) then diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index ad68fb887f..7bd705a07a 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -29,6 +29,7 @@ module MOM_surface_forcing use MOM_restart, only : restart_init_end, save_restart, restore_state use MOM_string_functions, only : uppercase use MOM_spatial_means, only : adjust_area_mean_to_zero +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface use user_revise_forcing, only : user_alter_forcing, user_revise_forcing_init use user_revise_forcing, only : user_revise_forcing_CS @@ -201,7 +202,7 @@ module MOM_surface_forcing !> 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, 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), & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive @@ -213,6 +214,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & 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 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. type(surface), intent(in) :: sfc_state !< A structure containing fields that describe the @@ -440,7 +442,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, & end if if (associated(IOB%ustar_berg)) & - fluxes%ustar_berg(i,j) = IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) + 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) @@ -590,7 +592,7 @@ 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. -subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) +subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) type(ice_ocean_boundary_type), & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive !! the ocean in a coupled model @@ -599,6 +601,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) 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 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. @@ -768,7 +771,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*tau_mag) + forces%ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0*tau_mag) enddo ; enddo elseif (wind_stagger == AGRID) then @@ -794,7 +797,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) do j=js,je ; do i=is,ie gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - forces%ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & + forces%ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) enddo ; enddo @@ -815,9 +818,9 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) if (CS%read_gust_2d) then - forces%ustar(i,j) = sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) + forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) else - forces%ustar(i,j) = sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) + forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) endif enddo ; enddo @@ -995,9 +998,10 @@ subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & end subroutine forcing_save_restart !> Initialize the surface forcing, including setting parameters and allocating permanent memory. -subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, restore_temp) +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 @@ -1271,7 +1275,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res call get_param(param_file, mdl, "ALLOW_ICEBERG_FLUX_DIAGNOSTICS", iceberg_flux_diags, & "If true, makes available diagnostics of fluxes from icebergs\n"//& "as seen by MOM6.", default=.false.) - call register_forcing_type_diags(Time, diag, CS%use_temperature, CS%handles, & + 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, & From d1ad0dcedc73d1256dde5cb2293563a34953840b Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 24 Apr 2019 10:43:37 -0400 Subject: [PATCH 1062/1072] Checksum support for Depth_list.nc This patch appends a checksum for the dependencies of the depth and area lists stored in the Depth_list.nc file, which are used to compute diagnostics based on APE. The data in Depth_list.nc depends on the grid fields, and may not be reproducible when such grids are constructed internally using compiled code within the executable. This issue was observed in the 'double_gyre' experiment when a PGI-compiled executable was tested using a Depth_list.nc file generated by a GNU-compiled executable. By appending a checksum for the grid fields used to compute Depth_list.nc, we can ensure that the data is consistent with the experiment grid data. Grid data which is read from external files, such as mosaic or topography fields, are unaffected by this issue. This patch improves the reproducibilty of standard diagnostics, such as total energy, but has no impact on the reproducibility of the internal model dynamics, which does not depend on Depth_list.nc. Checksums are computed for the G%bathyT and masked G%areaT grid fields using the FMS mpp_checksum subroutine, which require collective operations, and are stored as hex strings in global attributes of the netCDF file. Strings are used to remain consistent with FMS restart checksums, and to avoid an observed re-casting of 8-byte integers to 4-bytes by the netCDF library. Attribute names are based on the grid variable names. Two flags have been introduced to control this behavior: REQUIRE_DEPTH_LIST_CHECKSUMS (default: True) This flag will abort the run if the Depth_list.nc file is present and checksums are absent from the file. Although this could impose greater restrictions on existing runs, few runs are configured to save the depth list file (READ_DEPTH_LIST) and the default behavior is to reconstruct these lists on every run. UPDATE_DEPTH_LIST_CHECKSUMS (default: False) When REQUIRE_DEPTH_LIST_CHECKSUMS is set to false, this flag will automatically update the checksums of the Depth_list.nc file. While this can affect the reproducibility of APE diagnostics, it will ensure the reproducibility of such diagnostics in subsequent runs. --- src/diagnostics/MOM_sum_output.F90 | 132 +++++++++++++++++++++++++++++ 1 file changed, 132 insertions(+) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index cfc74b47fc..1a6cc58c1f 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -3,6 +3,7 @@ module MOM_sum_output ! This file is part of MOM6. See LICENSE.md for the license. +use iso_fortran_env, only : int64 use MOM_coms, only : sum_across_PEs, PE_here, root_PE, num_PEs, max_across_PEs use MOM_coms, only : reproducing_sum, EFP_to_real, real_to_EFP use MOM_coms, only : EFP_type, operator(+), operator(-), assignment(=) @@ -24,6 +25,7 @@ module MOM_sum_output use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type +use mpp_mod, only : mpp_chksum use netcdf @@ -39,6 +41,8 @@ module MOM_sum_output ! vary with the Boussinesq approximation, the Boussinesq variant is given first. integer, parameter :: NUM_FIELDS = 17 !< Number of diagnostic fields +character (*), parameter :: depth_chksum_attr = "bathyT_checksum" +character (*), parameter :: area_chksum_attr = "mask2dT_areaT_checksum" !> A list of depths and corresponding globally integrated ocean area at each !! depth and the ocean volume below each depth. @@ -64,6 +68,12 @@ module MOM_sum_output character(len=200) :: depth_list_file !< The name of the depth list file. real :: D_list_min_inc !< The minimum increment [Z ~> m], between the depths of the !! entries in the depth-list file, 0 by default. + logical :: require_depth_list_chksum + !< Require matching checksums in Depth_list.nc when reading + !! the file. + logical :: update_depth_list_chksum + !< Automatically update the Depth_list.nc file if the + !! checksums are missing or do not match current values. logical :: use_temperature !< If true, temperature and salinity are state variables. real :: fresh_water_input !< The total mass of fresh water added by surface fluxes !! since the last time that write_energy was called [kg]. @@ -226,6 +236,20 @@ subroutine MOM_sum_output_init(G, US, param_file, directory, ntrnc, & "The name of the depth list file.", default="Depth_list.nc") if (scan(CS%depth_list_file,'/') == 0) & CS%depth_list_file = trim(slasher(directory))//trim(CS%depth_list_file) + + call get_param(param_file, mdl, "REQUIRE_DEPTH_LIST_CHECKSUMS", & + CS%require_depth_list_chksum, & + desc="Require matching checksums in Depth_list.nc when reading\n" & + // "the file.", & + default=.true. & + ) + if (.not. CS%require_depth_list_chksum) & + call get_param(param_file, mdl, "UPDATE_DEPTH_LIST_CHECKSUMS", & + CS%update_depth_list_chksum, & + desc="Automatically update the Depth_list.nc file if the\n" & + // "checksums are missing or do not match current values.", & + default=.false. & + ) endif allocate(CS%lH(G%ke)) @@ -1203,6 +1227,10 @@ subroutine write_depth_list(G, US, CS, filename, list_size) ! Local variables real, allocatable :: tmp(:) integer :: ncid, dimid(1), Did, Aid, Vid, status, k + character(len=16) :: depth_chksum, area_chksum + + ! All ranks are required to compute the global checksum + call get_depth_list_checksums(G, depth_chksum, area_chksum) if (.not.is_root_pe()) return @@ -1248,6 +1276,15 @@ subroutine write_depth_list(G, US, CS, filename, list_size) if (status /= NF90_NOERR) call MOM_error(WARNING, & filename//" vol_below "//trim(NF90_STRERROR(status))) + ! Dependency checksums + status = NF90_PUT_ATT(ncid, NF90_GLOBAL, depth_chksum_attr, depth_chksum) + if (status /= NF90_NOERR) call MOM_error(WARNING, & + filename//" "//depth_chksum_attr//" "//trim(NF90_STRERROR(status))) + + status = NF90_PUT_ATT(ncid, NF90_GLOBAL, area_chksum_attr, area_chksum) + if (status /= NF90_NOERR) call MOM_error(WARNING, & + filename//" "//area_chksum_attr//" "//trim(NF90_STRERROR(status))) + status = NF90_ENDDEF(ncid) if (status /= NF90_NOERR) call MOM_error(WARNING, & filename//trim(NF90_STRERROR(status))) @@ -1287,6 +1324,9 @@ subroutine read_depth_list(G, US, CS, filename) real, allocatable :: tmp(:) integer :: ncid, status, varid, list_size, k integer :: ndim, len, var_dim_ids(NF90_MAX_VAR_DIMS) + character(len=16) :: depth_file_chksum, depth_grid_chksum + character(len=16) :: area_file_chksum, area_grid_chksum + integer :: depth_attr_status, area_attr_status mdl = "MOM_sum_output read_depth_list:" @@ -1296,6 +1336,62 @@ subroutine read_depth_list(G, US, CS, filename) " - "//trim(NF90_STRERROR(status))) endif + ! Check bathymetric consistency + depth_attr_status = NF90_GET_ATT(ncid, NF90_GLOBAL, depth_chksum_attr, & + depth_file_chksum) + area_attr_status = NF90_GET_ATT(ncid, NF90_GLOBAL, area_chksum_attr, & + area_file_chksum) + + if (any([depth_attr_status, area_attr_status] == NF90_ENOTATT)) then + var_msg = trim(CS%depth_list_file) // " checksums are missing;" + if (CS%require_depth_list_chksum) then + call MOM_error(FATAL, trim(var_msg) // " aborting.") + else if (CS%update_depth_list_chksum) then + call MOM_error(WARNING, trim(var_msg) // " updating file.") + call create_depth_list(G, CS) + call write_depth_list(G, US, CS, CS%depth_list_file, CS%list_size+1) + return + else + call MOM_error(WARNING, & + trim(var_msg) // " some diagnostics may not be reproducible." & + ) + end if + else + ! Validate netCDF call + if (depth_attr_status /= NF90_NOERR) then + var_msg = mdl // "Failed to read " // trim(filename) // ":" & + // depth_chksum_attr + call MOM_error(FATAL, trim(var_msg) // " - " & + // NF90_STRERROR(depth_attr_status)) + end if + + if (area_attr_status /= NF90_NOERR) then + var_msg = mdl // "Failed to read " // trim(filename) // ":" & + // area_chksum_attr + call MOM_error(FATAL, trim(var_msg) // " - " & + // NF90_STRERROR(area_attr_status)) + end if + + call get_depth_list_checksums(G, depth_grid_chksum, area_grid_chksum) + + if (depth_grid_chksum /= depth_file_chksum & + .or. area_grid_chksum /= area_file_chksum) then + var_msg = trim(CS%depth_list_file) // " checksums do not match;" + if (CS%require_depth_list_chksum) then + call MOM_error(FATAL, trim(var_msg) // " aborting.") + else if (CS%update_depth_list_chksum) then + call MOM_error(WARNING, trim(var_msg) // " updating file.") + call create_depth_list(G, CS) + call write_depth_list(G, US, CS, CS%depth_list_file, CS%list_size+1) + return + else + call MOM_error(WARNING, & + trim(var_msg) // " some diagnostics may not be reproducible." & + ) + end if + end if + endif + var_name = "depth" var_msg = trim(var_name)//" in "//trim(filename)//" - " status = NF90_INQ_VARID(ncid, var_name, varid) @@ -1363,6 +1459,42 @@ subroutine read_depth_list(G, US, CS, filename) end subroutine read_depth_list + +!> Return the checksums required to verify DEPTH_LIST_FILE contents. +!! +!! This function computes checksums for the bathymetry (G%bathyT) and masked +!! area (mask2dT * areaT) fields of the model grid G, which are used to compute +!! the depth list. A difference in checksum indicates that a different method +!! was used to compute the grid data, and that any results using the depth +!! list, such as APE, will not be reproducible. +!! +!! Checksums are saved as hexadecimal strings, in order to avoid potential +!! datatype issues with netCDF attributes. +subroutine get_depth_list_checksums(G, depth_chksum, area_chksum) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + character(len=16), intent(out) :: depth_chksum !< Depth checksum hexstring + character(len=16), intent(out) :: area_chksum !< Area checksum hexstring + + integer :: i, j + real, allocatable :: field(:,:) + + allocate(field(G%isc:G%iec, G%jsc:G%jec)) + + ! Depth checksum + do j=G%jsc,G%jec ; do i=G%isc,G%iec + field(i,j) = G%bathyT(i,j) + enddo ; enddo + write(depth_chksum, '(Z16)') mpp_chksum(field(:,:)) + + ! Area checksum + do j=G%jsc,G%jec ; do i=G%isc,G%iec + field(i,j) = G%mask2dT(i,j) * G%areaT(i,j) + enddo ; enddo + write(area_chksum, '(Z16)') mpp_chksum(field(:,:)) + + deallocate(field) +end subroutine get_depth_list_checksums + !> \namespace mom_sum_output !! !! By Robert Hallberg, April 1994 - June 2002 From f95d9ebc48b824368d0efc0296b7037364a83e35 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 24 Apr 2019 11:03:50 -0400 Subject: [PATCH 1063/1072] Further documentation of Depth_list.nc checksums Additional documentation of the parameters used to store Depth_list.nc attribute names was added. --- src/diagnostics/MOM_sum_output.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 1a6cc58c1f..652b1934c5 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -42,7 +42,11 @@ module MOM_sum_output integer, parameter :: NUM_FIELDS = 17 !< Number of diagnostic fields character (*), parameter :: depth_chksum_attr = "bathyT_checksum" + !< Checksum of G%bathyT ove the compute + !! domain character (*), parameter :: area_chksum_attr = "mask2dT_areaT_checksum" + !< Checksum of G%mask2dT * G%areaT over + !! the compute domain !> A list of depths and corresponding globally integrated ocean area at each !! depth and the ocean volume below each depth. From ce93243bfc5c0544255397f5f2e7175ec6062872 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 24 Apr 2019 11:06:54 -0400 Subject: [PATCH 1064/1072] Depth list documentation typo fix --- src/diagnostics/MOM_sum_output.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 652b1934c5..93f44a2bcc 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -42,7 +42,7 @@ module MOM_sum_output integer, parameter :: NUM_FIELDS = 17 !< Number of diagnostic fields character (*), parameter :: depth_chksum_attr = "bathyT_checksum" - !< Checksum of G%bathyT ove the compute + !< Checksum of G%bathyT over the compute !! domain character (*), parameter :: area_chksum_attr = "mask2dT_areaT_checksum" !< Checksum of G%mask2dT * G%areaT over From 087813d627ac0173b35f4f7d9fd58b530ddef64e Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 24 Apr 2019 16:17:02 -0400 Subject: [PATCH 1065/1072] Masked depth; style conformance The depth checksum is now replaced with masked depth, mask2dT * bathyT, and the calculation of the depth list has also been updated to use the masked depth. Various style conformance changes, such as contraction of do and if terminations (enddo, endif) and reduction of whitespace in various multiline function call, has also been applied. Finally, the attribute name docstrings were updated for clarity. --- src/diagnostics/MOM_sum_output.F90 | 61 ++++++++++++++---------------- 1 file changed, 29 insertions(+), 32 deletions(-) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 93f44a2bcc..b9d1b018c6 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -41,12 +41,14 @@ module MOM_sum_output ! vary with the Boussinesq approximation, the Boussinesq variant is given first. integer, parameter :: NUM_FIELDS = 17 !< Number of diagnostic fields -character (*), parameter :: depth_chksum_attr = "bathyT_checksum" - !< Checksum of G%bathyT over the compute +character (*), parameter :: depth_chksum_attr = "mask2dT_bathyT_checksum" + !< Checksum attribute name of + !! G%mask2dT * G%bathyT over the compute !! domain character (*), parameter :: area_chksum_attr = "mask2dT_areaT_checksum" - !< Checksum of G%mask2dT * G%areaT over - !! the compute domain + !< Checksum attribute of name of + !! G%mask2dT * G%areaT over the compute + !! domain !> A list of depths and corresponding globally integrated ocean area at each !! depth and the ocean volume below each depth. @@ -242,18 +244,15 @@ subroutine MOM_sum_output_init(G, US, param_file, directory, ntrnc, & CS%depth_list_file = trim(slasher(directory))//trim(CS%depth_list_file) call get_param(param_file, mdl, "REQUIRE_DEPTH_LIST_CHECKSUMS", & - CS%require_depth_list_chksum, & - desc="Require matching checksums in Depth_list.nc when reading\n" & - // "the file.", & - default=.true. & - ) + CS%require_depth_list_chksum, & + "Require that matching checksums be in Depth_list.nc\n" \\ & + "when reading the file.", default=.true.) if (.not. CS%require_depth_list_chksum) & call get_param(param_file, mdl, "UPDATE_DEPTH_LIST_CHECKSUMS", & - CS%update_depth_list_chksum, & - desc="Automatically update the Depth_list.nc file if the\n" & - // "checksums are missing or do not match current values.", & - default=.false. & - ) + CS%update_depth_list_chksum, & + "Automatically update the Depth_list.nc file if the\n" \\ & + "checksums are missing or do not match current values.", & + default=.false.) endif allocate(CS%lH(G%ke)) @@ -1129,8 +1128,8 @@ subroutine create_depth_list(G, CS) i_global = i + G%idg_offset - (G%isg-1) list_pos = (j_global-1)*G%Domain%niglobal + i_global - Dlist(list_pos) = G%bathyT(i,j) - Arealist(list_pos) = G%mask2dT(i,j)*G%areaT(i,j) + Dlist(list_pos) = G%mask2dT(i,j) * G%bathyT(i,j) + Arealist(list_pos) = G%mask2dT(i,j) * G%areaT(i,j) enddo ; enddo ! These sums reproduce across PEs because the arrays are only nonzero on one PE. @@ -1350,31 +1349,30 @@ subroutine read_depth_list(G, US, CS, filename) var_msg = trim(CS%depth_list_file) // " checksums are missing;" if (CS%require_depth_list_chksum) then call MOM_error(FATAL, trim(var_msg) // " aborting.") - else if (CS%update_depth_list_chksum) then + elseif (CS%update_depth_list_chksum) then call MOM_error(WARNING, trim(var_msg) // " updating file.") call create_depth_list(G, CS) call write_depth_list(G, US, CS, CS%depth_list_file, CS%list_size+1) return else call MOM_error(WARNING, & - trim(var_msg) // " some diagnostics may not be reproducible." & - ) - end if + trim(var_msg) // " some diagnostics may not be reproducible.") + endif else ! Validate netCDF call if (depth_attr_status /= NF90_NOERR) then var_msg = mdl // "Failed to read " // trim(filename) // ":" & // depth_chksum_attr - call MOM_error(FATAL, trim(var_msg) // " - " & - // NF90_STRERROR(depth_attr_status)) - end if + call MOM_error(FATAL, & + trim(var_msg) // " - " // NF90_STRERROR(depth_attr_status)) + endif if (area_attr_status /= NF90_NOERR) then var_msg = mdl // "Failed to read " // trim(filename) // ":" & // area_chksum_attr - call MOM_error(FATAL, trim(var_msg) // " - " & - // NF90_STRERROR(area_attr_status)) - end if + call MOM_error(FATAL, & + trim(var_msg) // " - " // NF90_STRERROR(area_attr_status)) + endif call get_depth_list_checksums(G, depth_grid_chksum, area_grid_chksum) @@ -1383,17 +1381,16 @@ subroutine read_depth_list(G, US, CS, filename) var_msg = trim(CS%depth_list_file) // " checksums do not match;" if (CS%require_depth_list_chksum) then call MOM_error(FATAL, trim(var_msg) // " aborting.") - else if (CS%update_depth_list_chksum) then + elseif (CS%update_depth_list_chksum) then call MOM_error(WARNING, trim(var_msg) // " updating file.") call create_depth_list(G, CS) call write_depth_list(G, US, CS, CS%depth_list_file, CS%list_size+1) return else call MOM_error(WARNING, & - trim(var_msg) // " some diagnostics may not be reproducible." & - ) - end if - end if + trim(var_msg) // " some diagnostics may not be reproducible.") + endif + endif endif var_name = "depth" @@ -1486,7 +1483,7 @@ subroutine get_depth_list_checksums(G, depth_chksum, area_chksum) ! Depth checksum do j=G%jsc,G%jec ; do i=G%isc,G%iec - field(i,j) = G%bathyT(i,j) + field(i,j) = G%mask2dT(i,j) * G%bathyT(i,j) enddo ; enddo write(depth_chksum, '(Z16)') mpp_chksum(field(:,:)) From 61a96a8a40b7c69da598efb4a67a3f71f5ba12bd Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 24 Apr 2019 16:33:33 -0400 Subject: [PATCH 1066/1072] Token bugfix --- src/diagnostics/MOM_sum_output.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index b9d1b018c6..0757b8751e 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -245,12 +245,12 @@ subroutine MOM_sum_output_init(G, US, param_file, directory, ntrnc, & call get_param(param_file, mdl, "REQUIRE_DEPTH_LIST_CHECKSUMS", & CS%require_depth_list_chksum, & - "Require that matching checksums be in Depth_list.nc\n" \\ & + "Require that matching checksums be in Depth_list.nc\n" // & "when reading the file.", default=.true.) if (.not. CS%require_depth_list_chksum) & call get_param(param_file, mdl, "UPDATE_DEPTH_LIST_CHECKSUMS", & CS%update_depth_list_chksum, & - "Automatically update the Depth_list.nc file if the\n" \\ & + "Automatically update the Depth_list.nc file if the\n" // & "checksums are missing or do not match current values.", & default=.false.) endif From 6c32b9177c34c1355cef4923763b4990faad33e3 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Thu, 25 Apr 2019 17:47:42 +0000 Subject: [PATCH 1067/1072] gitlab: specify MOM6-examples and script commits - There is no source code change in this commit. - The switch to the xanadu version of FMS and coupler moves source code between repositories, and therefore requires new build paths which are wired into the testing scripts. This commit checks out a specific version of the gitlab testing scripts along with a xanadu commit of MOM6-examples (which is on branch xanadu-fms). - Once the dev/gfdl branch of MOM6-examples has been rolled forward to xanadu we will return the commit used for gitlab testing to the HEAD of dev/gfdl. --- .gitlab-ci.yml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index cdacb620b0..3f90330986 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -32,8 +32,9 @@ setup: - git clone --recursive http://gitlab.gfdl.noaa.gov/ogrp/Gaea-stats-MOM6-examples.git tests && cd tests # Install / update testing scripts - git clone https://github.com/adcroft/MRS.git MRS + - (cd MRS ; git checkout 9badc63acefbf038) # Update MOM6-examples and submodules - - (cd MOM6-examples && git checkout . && git checkout dev/gfdl && git pull && git submodule init && git submodule update) + - (cd MOM6-examples && git checkout . && git checkout dev/gfdl && git pull && git checkout cf73a9ad63f8ccf7 && git submodule init && git submodule update) - (cd MOM6-examples/src/MOM6 && git submodule update) - test -d MOM6-examples/src/LM3 || make -f MRS/Makefile.clone clone_gfdl -s - make -f MRS/Makefile.clone MOM6-examples/.datasets -s @@ -73,7 +74,7 @@ gnu:ice-ocean-nolibs: - time tar zxf $CACHE_DIR/tests_$CI_PIPELINE_ID.tgz && cd tests - make -f MRS/Makefile.build build/gnu/env && cd build/gnu # mkdir -p build/gnu/repro/symmetric_dynamic/ocean_only && cd build/gnu/repro/symmetric_dynamic/ocean_only - - ../../MOM6-examples/src/mkmf/bin/list_paths -l ../../../config_src/{coupled_driver,dynamic} ../../../src ../../MOM6-examples/src/{FMS,coupler,SIS2,icebergs,ice_ocean_extras,land_null,atmos_null} + - ../../MOM6-examples/src/mkmf/bin/list_paths -l ../../../config_src/{coupled_driver,dynamic} ../../../src ../../MOM6-examples/src/{FMS,coupler,SIS2,icebergs,ice_param,land_null,atmos_null} - ../../MOM6-examples/src/mkmf/bin/mkmf -t ../../MOM6-examples/src/mkmf/templates/ncrc-gnu.mk -p MOM6 -c"-Duse_libMPI -Duse_netCDF -D_USE_LEGACY_LAND_ -Duse_AM3_physics" path_names - time (source ./env ; make NETCDF=3 REPRO=1 MOM6 -s -j) From 9a1422f67b407c839e7afda18bac01baf9fe8049 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 25 Apr 2019 15:02:54 -0400 Subject: [PATCH 1068/1072] Revert masking of depth Using the masked depth (mask2dT * bathyT) was observed to change energy values within floating point precision, so the changes have been reverted. This may be revised at a later time, when we are prepared to update the energy stats to the new values in the regression tests. The depth checksum attribute has also been renamed to reflect this change. This will allow us to re-define the variable as masked at some later date, and can distinguish between the masked and unmasked checksums during testing. --- src/diagnostics/MOM_sum_output.F90 | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 0757b8751e..548e34434a 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -41,10 +41,9 @@ module MOM_sum_output ! vary with the Boussinesq approximation, the Boussinesq variant is given first. integer, parameter :: NUM_FIELDS = 17 !< Number of diagnostic fields -character (*), parameter :: depth_chksum_attr = "mask2dT_bathyT_checksum" - !< Checksum attribute name of - !! G%mask2dT * G%bathyT over the compute - !! domain +character (*), parameter :: depth_chksum_attr = "bathyT_checksum" + !< Checksum attribute name of G%bathyT + !! over the compute domain character (*), parameter :: area_chksum_attr = "mask2dT_areaT_checksum" !< Checksum attribute of name of !! G%mask2dT * G%areaT over the compute @@ -75,10 +74,10 @@ module MOM_sum_output real :: D_list_min_inc !< The minimum increment [Z ~> m], between the depths of the !! entries in the depth-list file, 0 by default. logical :: require_depth_list_chksum - !< Require matching checksums in Depth_list.nc when reading + !< Require matching checksums in Depth_list.nc when reading !! the file. logical :: update_depth_list_chksum - !< Automatically update the Depth_list.nc file if the + !< Automatically update the Depth_list.nc file if the !! checksums are missing or do not match current values. logical :: use_temperature !< If true, temperature and salinity are state variables. real :: fresh_water_input !< The total mass of fresh water added by surface fluxes @@ -1128,7 +1127,7 @@ subroutine create_depth_list(G, CS) i_global = i + G%idg_offset - (G%isg-1) list_pos = (j_global-1)*G%Domain%niglobal + i_global - Dlist(list_pos) = G%mask2dT(i,j) * G%bathyT(i,j) + Dlist(list_pos) = G%bathyT(i,j) Arealist(list_pos) = G%mask2dT(i,j) * G%areaT(i,j) enddo ; enddo From 0b33904ebd015aac1478c816437f95412c2fb632 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 25 Apr 2019 17:07:40 -0400 Subject: [PATCH 1069/1072] Bugfix: Checksum the unmasked depth --- src/diagnostics/MOM_sum_output.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 548e34434a..eb4214ea10 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -1482,7 +1482,7 @@ subroutine get_depth_list_checksums(G, depth_chksum, area_chksum) ! Depth checksum do j=G%jsc,G%jec ; do i=G%isc,G%iec - field(i,j) = G%mask2dT(i,j) * G%bathyT(i,j) + field(i,j) = G%bathyT(i,j) enddo ; enddo write(depth_chksum, '(Z16)') mpp_chksum(field(:,:)) From 97afc59e33fa45d8c2e2725d1cfb7e1260a7b5b3 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 3 May 2019 15:36:20 -0400 Subject: [PATCH 1070/1072] MEKE: Prevent div-by-zero by bathyT in beta calc The calculation of beta in the MEKE module had an explicit division by zero when computing the lateral topography derivatives, which were raising floating point exceptions in the debug builds. This occurs in the MEKE_equilibrium and MEKE_lengthScales functions. This issue was not observed in the production tests due to MEKE_TOPOGRAPHIC_BETA always being set to zero. When FPEs are disabled, the 0 * (1./0.) operation produces a NaN which is passed to a max() function, which ignores the NaN and always returns the other value. We resolve this by explicitly checking for zero values in bathyT and setting the topographic beta to zero when this term is zero. While this could potentially change the value of the Rhines scale, these values only occur over land, which are in general masked, and should not affect the calculation. The unoptimized expressions were retained, but recommended changes which reduce the number of divisions were included in comments. No value changes were observed in our test suite, and the patch should be bitwise reproducible. Minor changes: - We do not calculate the topographic beta term if the scaling factor, MEKE_TOPOGRAPHIC_BETA is zero - the default value of beta was unset in MEKE_lengthScales was unset when CS%use_old_lscale is True, so we set this to zero. - Minor whitespace and index syntax changes --- src/parameterizations/lateral/MOM_MEKE.F90 | 61 +++++++++++++++++----- 1 file changed, 48 insertions(+), 13 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index e170087180..87e78efe45 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -562,6 +562,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m real :: I_H, KhCoeff, Kh, Ubg2, cd2, drag_rate, ldamping, src real :: EKE, EKEmin, EKEmax, resid, ResMin, ResMax, EKEerr real :: FatH ! Coriolis parameter at h points; to compute topographic beta [s-1] + real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [s-1 m-1] integer :: i, j, is, ie, js, je, n1, n2 real, parameter :: tolerance = 1.e-12 ! Width of EKE bracket [m2 s-2]. logical :: useSecant, debugIteration @@ -581,11 +582,26 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m FatH = 0.25*US%s_to_T*((G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) + & (G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1))) !< Coriolis parameter at h points - !### This expression should be recast to use a single division, but it will change answers. - beta = sqrt( ( US%s_to_T*G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j)* & - (G%bathyT(i+1,j) - G%bathyT(i-1,j))/2./G%dxT(i,j) )**2. & - + ( US%s_to_T*G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & - *(G%bathyT(i,j+1) - G%bathyT(i,j-1))/2./G%dyT(i,j) )**2. ) + + ! If bathyT is zero, then a division by zero FPE will be raised. In this + ! case, we apply Adcroft's rule of reciprocals and set the term to zero. + ! Since zero-bathymetry cells are masked, this should not affect values. + if (CS%MEKE_topographic_beta == 0. .or. G%bathyT(i,j) == 0.) then + beta_topo_x = 0. ; beta_topo_y = 0. + else + !### These expressions should be recast to use a single division, but it will change answers. + !beta_topo_x = CS%MEKE_topographic_beta * FatH & + ! * 0.5 * (G%bathyT(i+1,j) - G%bathyT(i-1,j)) * G%IdxT(i,j) / G%bathyT(i,j) + !beta_topo_y = CS%MEKE_topographic_beta * FatH & + ! * 0.5 * (G%bathyT(i,j+1) - G%bathyT(i,j-1)) * G&IdxT(i,j) / G%bathyT(i,j) + beta_topo_x = CS%MEKE_topographic_beta * FatH / G%bathyT(i,j) & + * (G%bathyT(i+1,j) - G%bathyT(i-1,j)) / 2. / G%dxT(i,j) + beta_topo_y = CS%MEKE_topographic_beta * FatH / G%bathyT(i,j) & + * (G%bathyT(i,j+1) - G%bathyT(i,j-1)) / 2. / G%dyT(i,j) + endif + + beta = sqrt((US%s_to_T * G%dF_dx(i,j) - beta_topo_x)**2 & + + ((US%s_to_T * G%dF_dy(i,j) - beta_topo_y)**2)) I_H = GV%Rho0 * I_mass(i,j) @@ -693,6 +709,7 @@ subroutine MEKE_lengthScales(CS, MEKE, G, US, SN_u, SN_v, & real, dimension(SZI_(G),SZJ_(G)) :: Lrhines, Leady real :: beta, SN real :: FatH ! Coriolis parameter at h points [s-1] + real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [s-1 m-1] integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -701,17 +718,35 @@ subroutine MEKE_lengthScales(CS, MEKE, G, US, SN_u, SN_v, & do j=js,je ; do i=is,ie if (.not.CS%use_old_lscale) then if (CS%aEady > 0.) then - SN = 0.25*( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)) ) + SN = 0.25*( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)) ) else SN = 0. endif - FatH = 0.25*US%s_to_T* ( ( G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1) ) + & - ( G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1) ) ) ! Coriolis parameter at h points - !### This expression should be recast to use a single division, but it will change answers. - beta = sqrt( ( US%s_to_T*G%dF_dx(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & - *(G%bathyT(i+1,j) - G%bathyT(i-1,j)) /2./G%dxT(i,j) )**2. & - + ( US%s_to_T*G%dF_dy(i,j) - CS%MEKE_topographic_beta*FatH/G%bathyT(i,j) & - *(G%bathyT(i,j+1) - G%bathyT(i,j-1))/2./G%dyT(i,j) )**2. ) + FatH = 0.25*US%s_to_T* ( ( G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1) ) + & + ( G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J-1) ) ) ! Coriolis parameter at h points + + ! If bathyT is zero, then a division by zero FPE will be raised. In this + ! case, we apply Adcroft's rule of reciprocals and set the term to zero. + ! Since zero-bathymetry cells are masked, this should not affect values. + if (CS%MEKE_topographic_beta == 0. .or. G%bathyT(i,j) == 0.0) then + beta_topo_x = 0. ; beta_topo_y = 0. + else + !### These expressions should be recast to use a single division, but it will change answers. + !beta_topo_x = CS%MEKE_topographic_beta * FatH & + ! * 0.5 * (G%bathyT(i+1,j) - G%bathyT(i-1,j)) * G%IdxT(i,j) / G%bathyT(i,j) + !beta_topo_y = CS%MEKE_topographic_beta * FatH & + ! * 0.5 * (G%bathyT(i,j+1) - G%bathyT(i,j-1)) * G&IdxT(i,j) / G%bathyT(i,j) + beta_topo_x = CS%MEKE_topographic_beta * FatH / G%bathyT(i,j) & + * (G%bathyT(i+1,j) - G%bathyT(i-1,j)) / 2. / G%dxT(i,j) + beta_topo_y = CS%MEKE_topographic_beta * FatH / G%bathyT(i,j) & + * (G%bathyT(i,j+1) - G%bathyT(i,j-1)) / 2. / G%dyT(i,j) + endif + + beta = sqrt((US%s_to_T * G%dF_dx(i,j) - beta_topo_x)**2 & + + ((US%s_to_T * G%dF_dy(i,j) - beta_topo_y)**2)) + + else + beta = 0. endif ! Returns bottomFac2, barotrFac2 and LmixScale call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & From af65692778d876ca00db48f7ee77288beb9b7b0c Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 3 May 2019 16:16:24 -0400 Subject: [PATCH 1071/1072] Add FMS/coupler_types.F90 to build Travis-CI build path --- .testing/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.testing/Makefile b/.testing/Makefile index d0f098e411..ee561375a3 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -18,7 +18,7 @@ else EXPERIMENTS ?= unit_tests double_gyre flow_downslope/z CVmix_SCM_tests/cooling_only/EPBL endif -FMS_PACKAGES ?= platform,include,memutils,constants,mpp,fms,time_manager,diag_manager,data_override,coupler/ensemble_manager.F90,axis_utils,horiz_interp,time_interp,astronomy,mosaic,random_numbers +FMS_PACKAGES ?= platform,include,memutils,constants,mpp,fms,time_manager,diag_manager,data_override,coupler/coupler_types.F90,coupler/ensemble_manager.F90,axis_utils,horiz_interp,time_interp,astronomy,mosaic,random_numbers TEMPLATE ?= .testing/linux-ubuntu-xenial-gnu.mk MPIRUN ?= mpirun From 8486c045c187a772a09a5bd66a37c6bc2659b7cf Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 3 May 2019 16:31:11 -0400 Subject: [PATCH 1072/1072] Use xanadu-fms version of MRS in gitlab pipeline --- .gitlab-ci.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 3f90330986..7ad78049f3 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -32,9 +32,9 @@ setup: - git clone --recursive http://gitlab.gfdl.noaa.gov/ogrp/Gaea-stats-MOM6-examples.git tests && cd tests # Install / update testing scripts - git clone https://github.com/adcroft/MRS.git MRS - - (cd MRS ; git checkout 9badc63acefbf038) + - (cd MRS ; git checkout xanadu-fms) # Update MOM6-examples and submodules - - (cd MOM6-examples && git checkout . && git checkout dev/gfdl && git pull && git checkout cf73a9ad63f8ccf7 && git submodule init && git submodule update) + - (cd MOM6-examples && git checkout . && git checkout dev/gfdl && git pull && git submodule init && git submodule update) - (cd MOM6-examples/src/MOM6 && git submodule update) - test -d MOM6-examples/src/LM3 || make -f MRS/Makefile.clone clone_gfdl -s - make -f MRS/Makefile.clone MOM6-examples/.datasets -s